diff --git a/src/admm_methods.F b/src/admm_methods.F index ae37bedd55..1c0d54f146 100644 --- a/src/admm_methods.F +++ b/src/admm_methods.F @@ -195,7 +195,7 @@ SUBROUTINE admm_mo_calc_rho_aux(qs_env) IF (dft_control%nspins == 1) THEN admm_env%gsi(3) = admm_env%gsi(1) ELSE - admm_env%gsi(3) = (admm_env%gsi(1)+admm_env%gsi(2))/2.0_dp + admm_env%gsi(3) = (admm_env%gsi(1) + admm_env%gsi(2))/2.0_dp END IF CALL qs_rho_set(rho_aux_fit, rho_r_valid=.TRUE., rho_g_valid=.TRUE.) @@ -657,7 +657,7 @@ SUBROUTINE purify_dm_cauchy(admm_env, mo_set, density_matrix, ispin, blocked) CALL cp_fm_set_all(admm_env%M_purify(ispin)%matrix, 0.0_dp) pole = 0.0_dp DO i = 1, nao_aux_fit - pole = Heaviside(admm_env%eigvals_P_to_be_purified(ispin)%eigvals%data(i)-0.5_dp) + pole = Heaviside(admm_env%eigvals_P_to_be_purified(ispin)%eigvals%data(i) - 0.5_dp) CALL cp_fm_set_element(admm_env%M_purify(ispin)%matrix, i, i, pole) END DO CALL cp_fm_upper_to_full(admm_env%M_purify(ispin)%matrix, admm_env%work_aux_aux) @@ -762,17 +762,17 @@ SUBROUTINE merge_ks_matrix_cauchy(qs_env) pole = 0.0_dp DO i = 1, nao_aux_fit DO j = i, nao_aux_fit - eig_diff = (admm_env%eigvals_P_to_be_purified(ispin)%eigvals%data(i)- & + eig_diff = (admm_env%eigvals_P_to_be_purified(ispin)%eigvals%data(i) - & admm_env%eigvals_P_to_be_purified(ispin)%eigvals%data(j)) ! *** two eigenvalues could be the degenerated. In that case use 2nd order formula for the poles IF (ABS(eig_diff) == 0.0_dp) THEN - pole = delta(admm_env%eigvals_P_to_be_purified(ispin)%eigvals%data(i)-0.5_dp) + pole = delta(admm_env%eigvals_P_to_be_purified(ispin)%eigvals%data(i) - 0.5_dp) CALL cp_fm_set_element(admm_env%M_purify(ispin)%matrix, i, j, pole) ELSE - pole = 1.0_dp/(admm_env%eigvals_P_to_be_purified(ispin)%eigvals%data(i)- & + pole = 1.0_dp/(admm_env%eigvals_P_to_be_purified(ispin)%eigvals%data(i) - & admm_env%eigvals_P_to_be_purified(ispin)%eigvals%data(j)) - tmp = Heaviside(admm_env%eigvals_P_to_be_purified(ispin)%eigvals%data(i)-0.5_dp) - tmp = tmp-Heaviside(admm_env%eigvals_P_to_be_purified(ispin)%eigvals%data(j)-0.5_dp) + tmp = Heaviside(admm_env%eigvals_P_to_be_purified(ispin)%eigvals%data(i) - 0.5_dp) + tmp = tmp - Heaviside(admm_env%eigvals_P_to_be_purified(ispin)%eigvals%data(j) - 0.5_dp) pole = tmp*pole CALL cp_fm_set_element(admm_env%M_purify(ispin)%matrix, i, j, pole) END IF @@ -1053,7 +1053,7 @@ SUBROUTINE merge_mo_derivs_diag(ispin, admm_env, mo_set, mo_coeff, mo_coeff_aux_ pole = 0.0_dp DO i = 1, nmo DO j = i, nmo - eig_diff = (admm_env%eigvals_lambda(ispin)%eigvals%data(i)- & + eig_diff = (admm_env%eigvals_lambda(ispin)%eigvals%data(i) - & admm_env%eigvals_lambda(ispin)%eigvals%data(j)) ! *** two eigenvalues could be the degenerated. In that case use 2nd order formula for the poles IF (ABS(eig_diff) < 0.0001_dp) THEN @@ -1062,12 +1062,12 @@ SUBROUTINE merge_mo_derivs_diag(ispin, admm_env, mo_set, mo_coeff, mo_coeff_aux_ tmp72 = tmp52/admm_env%eigvals_lambda(ispin)%eigvals%data(j)*eig_diff tmp92 = tmp72/admm_env%eigvals_lambda(ispin)%eigvals%data(j)*eig_diff - pole = -0.5_dp*tmp32+3.0_dp/8.0_dp*tmp52-5.0_dp/16.0_dp*tmp72+35.0_dp/128.0_dp*tmp92 + pole = -0.5_dp*tmp32 + 3.0_dp/8.0_dp*tmp52 - 5.0_dp/16.0_dp*tmp72 + 35.0_dp/128.0_dp*tmp92 CALL cp_fm_set_element(admm_env%M(ispin)%matrix, i, j, pole) ELSE pole = 1.0_dp/SQRT(admm_env%eigvals_lambda(ispin)%eigvals%data(i)) - pole = pole-1.0_dp/SQRT(admm_env%eigvals_lambda(ispin)%eigvals%data(j)) - pole = pole/(admm_env%eigvals_lambda(ispin)%eigvals%data(i)- & + pole = pole - 1.0_dp/SQRT(admm_env%eigvals_lambda(ispin)%eigvals%data(j)) + pole = pole/(admm_env%eigvals_lambda(ispin)%eigvals%data(i) - & admm_env%eigvals_lambda(ispin)%eigvals%data(j)) CALL cp_fm_set_element(admm_env%M(ispin)%matrix, i, j, pole) END IF @@ -1279,11 +1279,11 @@ SUBROUTINE merge_ks_matrix_none(qs_env) CALL calc_spin_dep_aux_exch_ener(qs_env=qs_env, admm_env=admm_env, ener_k_ispin=ener_k(ispin), & ener_x_ispin=ener_x(ispin), ispin=ispin) admm_env%lambda_merlot(ispin) = 2.0_dp*(admm_env%gsi(ispin))**2* & - (ener_k(ispin)+ener_x(ispin))/(admm_env%n_large_basis(ispin)) + (ener_k(ispin) + ener_x(ispin))/(admm_env%n_large_basis(ispin)) ELSE admm_env%lambda_merlot(ispin) = 2.0_dp*(admm_env%gsi(ispin))**2* & - (energy%ex+energy%exc_aux_fit)/(admm_env%n_large_basis(ispin)) + (energy%ex + energy%exc_aux_fit)/(admm_env%n_large_basis(ispin)) ENDIF ELSE IF (admm_env%charge_constrain .AND. & @@ -1295,12 +1295,12 @@ SUBROUTINE merge_ks_matrix_none(qs_env) CALL calc_spin_dep_aux_exch_ener(qs_env=qs_env, admm_env=admm_env, ener_k_ispin=ener_k(ispin), & ener_x_ispin=ener_x(ispin), ispin=ispin) admm_env%lambda_merlot(ispin) = & - (trace_tmp+2.0_dp/3.0_dp*((admm_env%gsi(ispin))**(2.0_dp/3.0_dp))*ener_x(ispin)- & + (trace_tmp + 2.0_dp/3.0_dp*((admm_env%gsi(ispin))**(2.0_dp/3.0_dp))*ener_x(ispin) - & ((admm_env%gsi(ispin))**(2.0_dp/3.0_dp))*trace_tmp_two)/(admm_env%n_large_basis(ispin)) ELSE - admm_env%lambda_merlot(ispin) = (trace_tmp+(admm_env%gsi(ispin))**(2.0_dp/3.0_dp)* & - (2.0_dp/3.0_dp*energy%exc_aux_fit-trace_tmp_two))/ & + admm_env%lambda_merlot(ispin) = (trace_tmp + (admm_env%gsi(ispin))**(2.0_dp/3.0_dp)* & + (2.0_dp/3.0_dp*energy%exc_aux_fit - trace_tmp_two))/ & (admm_env%n_large_basis(ispin)) END IF END IF @@ -1363,8 +1363,8 @@ SUBROUTINE merge_ks_matrix_none(qs_env) energy%exc_aux_fit = 0.0_dp energy%ex = 0.0_dp DO ispin = 1, dft_control%nspins - energy%exc_aux_fit = energy%exc_aux_fit+(admm_env%gsi(ispin))**2.0_dp*ener_x(ispin) - energy%ex = energy%ex+(admm_env%gsi(ispin))**2.0_dp*ener_k(ispin) + energy%exc_aux_fit = energy%exc_aux_fit + (admm_env%gsi(ispin))**2.0_dp*ener_x(ispin) + energy%ex = energy%ex + (admm_env%gsi(ispin))**2.0_dp*ener_k(ispin) END DO ELSE energy%exc_aux_fit = (admm_env%gsi(1))**2.0_dp*energy%exc_aux_fit @@ -1375,7 +1375,7 @@ SUBROUTINE merge_ks_matrix_none(qs_env) IF (dft_control%nspins == 2) THEN energy%exc_aux_fit = 0.0_dp DO ispin = 1, dft_control%nspins - energy%exc_aux_fit = energy%exc_aux_fit+(admm_env%gsi(ispin))**(2.0_dp/3.0_dp)*ener_x(ispin) + energy%exc_aux_fit = energy%exc_aux_fit + (admm_env%gsi(ispin))**(2.0_dp/3.0_dp)*ener_x(ispin) END DO ELSE energy%exc_aux_fit = (admm_env%gsi(1))**(2.0_dp/3.0_dp)*energy%exc_aux_fit @@ -2071,7 +2071,7 @@ SUBROUTINE calculate_dm_mo_no_diag(admm_env, mo_set, density_matrix, overlap_mat ! Calculate number of electrons in the original density matrix, transposing doesn't matter ! since both matrices are symmetric CALL dbcsr_dot(density_matrix_large, overlap_matrix_large, admm_env%n_large_basis(ispin)) - admm_env%n_large_basis(3) = admm_env%n_large_basis(3)+admm_env%n_large_basis(ispin) + admm_env%n_large_basis(3) = admm_env%n_large_basis(3) + admm_env%n_large_basis(ispin) ! Calculate number of electrons in the auxiliary density matrix CALL dbcsr_dot(density_matrix, overlap_matrix, nel_tmp_aux) admm_env%gsi(ispin) = admm_env%n_large_basis(ispin)/nel_tmp_aux diff --git a/src/almo_scf.F b/src/almo_scf.F index 47889dc811..4da9098229 100644 --- a/src/almo_scf.F +++ b/src/almo_scf.F @@ -285,8 +285,8 @@ SUBROUTINE almo_scf_init(qs_env, almo_scf_env, calc_forces) DO idomain = 1, ndomains nelec = almo_scf_env%nocc_of_domain(idomain, 1) multip = almo_scf_env%multiplicity_of_domain(idomain) - nelec_a = (nelec+multip-1)/2 - nelec_b = nelec-nelec_a + nelec_a = (nelec + multip - 1)/2 + nelec_b = nelec - nelec_a almo_scf_env%nocc_of_domain(idomain, 1) = nelec_a IF (nelec_a .NE. nelec_b) THEN IF (nspins .EQ. 1) THEN @@ -305,14 +305,14 @@ SUBROUTINE almo_scf_init(qs_env, almo_scf_env, calc_forces) !! Add a number of added_mos equal to the number of atoms in domain !! (since fragments were computed this way with smearing) almo_scf_env%nocc_of_domain(idomain, :) = almo_scf_env%nocc_of_domain(idomain, :) & - +(almo_scf_env%last_atom_of_domain(idomain) & - -almo_scf_env%first_atom_of_domain(idomain)+1) + + (almo_scf_env%last_atom_of_domain(idomain) & + - almo_scf_env%first_atom_of_domain(idomain) + 1) END IF ENDDO DO ispin = 1, nspins ! take care of the full virtual subspace almo_scf_env%nvirt_full_of_domain(:, ispin) = & - almo_scf_env%nbasis_of_domain(:)- & + almo_scf_env%nbasis_of_domain(:) - & almo_scf_env%nocc_of_domain(:, ispin) ! and the truncated virtual subspace SELECT CASE (almo_scf_env%deloc_truncate_virt) @@ -326,7 +326,7 @@ SUBROUTINE almo_scf_init(qs_env, almo_scf_env, calc_forces) MIN(almo_scf_env%deloc_virt_per_domain, & almo_scf_env%nvirt_full_of_domain(idomain, ispin)) almo_scf_env%nvirt_disc_of_domain(idomain, ispin) = & - almo_scf_env%nvirt_full_of_domain(idomain, ispin)- & + almo_scf_env%nvirt_full_of_domain(idomain, ispin) - & almo_scf_env%nvirt_of_domain(idomain, ispin) ENDDO CASE (virt_occ_size) @@ -335,7 +335,7 @@ SUBROUTINE almo_scf_init(qs_env, almo_scf_env, calc_forces) MIN(almo_scf_env%nocc_of_domain(idomain, ispin), & almo_scf_env%nvirt_full_of_domain(idomain, ispin)) almo_scf_env%nvirt_disc_of_domain(idomain, ispin) = & - almo_scf_env%nvirt_full_of_domain(idomain, ispin)- & + almo_scf_env%nvirt_full_of_domain(idomain, ispin) - & almo_scf_env%nvirt_of_domain(idomain, ispin) ENDDO CASE DEFAULT @@ -351,7 +351,7 @@ SUBROUTINE almo_scf_init(qs_env, almo_scf_env, calc_forces) DO idomain = 1, ndomains DO iao = 1, almo_scf_env%nbasis_of_domain(idomain) almo_scf_env%domain_index_of_ao(ao) = idomain - ao = ao+1 + ao = ao + 1 ENDDO ENDDO @@ -401,7 +401,7 @@ SUBROUTINE almo_scf_init(qs_env, almo_scf_env, calc_forces) CPABORT("Forces for perturbative methods are NYI. Change DELOCALIZE_METHOD") ENDIF ! switch to ASPC after a certain number of exact steps is done - IF (almo_scf_env%almo_history%istore .GT. (almo_scf_env%almo_history%nstore+1)) THEN + IF (almo_scf_env%almo_history%istore .GT. (almo_scf_env%almo_history%nstore + 1)) THEN IF (almo_scf_env%opt_block_diag_pcg%eps_error_early .GT. 0.0_dp) THEN almo_scf_env%opt_block_diag_pcg%eps_error = almo_scf_env%opt_block_diag_pcg%eps_error_early almo_scf_env%opt_block_diag_pcg%early_stopping_on = .TRUE. @@ -426,7 +426,7 @@ SUBROUTINE almo_scf_init(qs_env, almo_scf_env, calc_forces) almo_scf_env%opt_block_diag_diis%early_stopping_on = .FALSE. almo_scf_env%opt_block_diag_pcg%early_stopping_on = .FALSE. ENDIF - IF (almo_scf_env%xalmo_history%istore .GT. (almo_scf_env%xalmo_history%nstore+1)) THEN + IF (almo_scf_env%xalmo_history%istore .GT. (almo_scf_env%xalmo_history%nstore + 1)) THEN IF (almo_scf_env%opt_xalmo_pcg%eps_error_early .GT. 0.0_dp) THEN almo_scf_env%opt_xalmo_pcg%eps_error = almo_scf_env%opt_xalmo_pcg%eps_error_early almo_scf_env%opt_xalmo_pcg%early_stopping_on = .TRUE. @@ -639,9 +639,9 @@ SUBROUTINE almo_scf_initial_guess(qs_env, almo_scf_env) ! extrapolation DO iaspc = 1, naspc - istore = MOD(almo_scf_env%almo_history%istore-iaspc, almo_scf_env%almo_history%nstore)+1 - alpha = (-1.0_dp)**(iaspc+1)*REAL(iaspc, KIND=dp)* & - binomial(2*naspc, naspc-iaspc)/binomial(2*naspc-2, naspc-1) + istore = MOD(almo_scf_env%almo_history%istore - iaspc, almo_scf_env%almo_history%nstore) + 1 + alpha = (-1.0_dp)**(iaspc + 1)*REAL(iaspc, KIND=dp)* & + binomial(2*naspc, naspc - iaspc)/binomial(2*naspc - 2, naspc - 1) IF (unit_nr > 0) THEN WRITE (unit_nr, FMT="(T3,A2,I0,A4,F10.6)") & "B(", iaspc, ") = ", alpha @@ -776,11 +776,11 @@ SUBROUTINE almo_scf_store_extrapolation_data(almo_scf_env) IF (almo_scf_env%almo_history%nstore > 0) THEN - almo_scf_env%almo_history%istore = almo_scf_env%almo_history%istore+1 + almo_scf_env%almo_history%istore = almo_scf_env%almo_history%istore + 1 DO ispin = 1, SIZE(almo_scf_env%matrix_t_blk) - istore = MOD(almo_scf_env%almo_history%istore-1, almo_scf_env%almo_history%nstore)+1 + istore = MOD(almo_scf_env%almo_history%istore - 1, almo_scf_env%almo_history%nstore) + 1 IF (almo_scf_env%almo_history%istore == 1) THEN CALL dbcsr_create(almo_scf_env%almo_history%matrix_t(ispin), & @@ -830,11 +830,11 @@ SUBROUTINE almo_scf_store_extrapolation_data(almo_scf_env) IF (almo_scf_env%xalmo_history%nstore > 0 .AND. & delocalization_uses_extrapolation) THEN - almo_scf_env%xalmo_history%istore = almo_scf_env%xalmo_history%istore+1 + almo_scf_env%xalmo_history%istore = almo_scf_env%xalmo_history%istore + 1 DO ispin = 1, SIZE(almo_scf_env%matrix_t) - istore = MOD(almo_scf_env%xalmo_history%istore-1, almo_scf_env%xalmo_history%nstore)+1 + istore = MOD(almo_scf_env%xalmo_history%istore - 1, almo_scf_env%xalmo_history%nstore) + 1 IF (almo_scf_env%xalmo_history%istore == 1) THEN CALL dbcsr_create(almo_scf_env%xalmo_history%matrix_t(ispin), & @@ -1073,16 +1073,16 @@ SUBROUTINE almo_scf_print_job_info(almo_scf_env, unit_nr) IF (idomain .EQ. 1) THEN index1_prev = 1 ELSE - index1_prev = almo_scf_env%domain_map(1)%index1(idomain-1) + index1_prev = almo_scf_env%domain_map(1)%index1(idomain - 1) ENDIF SELECT CASE (almo_scf_env%deloc_method) CASE (almo_deloc_none) nneighbors(idomain) = 0 CASE (almo_deloc_x, almo_deloc_scf, almo_deloc_x_then_scf) - nneighbors(idomain) = almo_scf_env%ndomains-1 ! minus self + nneighbors(idomain) = almo_scf_env%ndomains - 1 ! minus self CASE (almo_deloc_xalmo_1diag, almo_deloc_xalmo_x, almo_deloc_xalmo_scf) - nneighbors(idomain) = almo_scf_env%domain_map(1)%index1(idomain)-index1_prev-1 ! minus self + nneighbors(idomain) = almo_scf_env%domain_map(1)%index1(idomain) - index1_prev - 1 ! minus self CASE DEFAULT nneighbors(idomain) = -1 END SELECT @@ -1143,13 +1143,13 @@ SUBROUTINE almo_scf_print_job_info(almo_scf_env, unit_nr) IF (idomain .EQ. 1) THEN index1_prev = 1 ELSE - index1_prev = almo_scf_env%domain_map(1)%index1(idomain-1) + index1_prev = almo_scf_env%domain_map(1)%index1(idomain - 1) ENDIF WRITE (unit_nr, '(T2,I10,":")') idomain WRITE (unit_nr, '(T12,11I6)') & almo_scf_env%domain_map(1)%pairs & - (index1_prev:almo_scf_env%domain_map(1)%index1(idomain)-1, 1) ! includes self + (index1_prev:almo_scf_env%domain_map(1)%index1(idomain) - 1, 1) ! includes self ENDDO ! cycle over domains diff --git a/src/almo_scf_diis_types.F b/src/almo_scf_diis_types.F index a6f2d3adf5..0ea302b8c7 100644 --- a/src/almo_scf_diis_types.F +++ b/src/almo_scf_diis_types.F @@ -258,7 +258,7 @@ SUBROUTINE almo_scf_diis_push(diis_env, var, err, d_var, d_err) ! update the buffer length old_buffer_length = diis_env%buffer_length - diis_env%buffer_length = diis_env%buffer_length+1 + diis_env%buffer_length = diis_env%buffer_length + 1 IF (diis_env%buffer_length .GT. diis_env%max_buffer_length) & diis_env%buffer_length = diis_env%max_buffer_length @@ -287,15 +287,15 @@ SUBROUTINE almo_scf_diis_push(diis_env, var, err, d_var, d_err) ! resize B matrix and update its elements ndomains = SIZE(diis_env%m_b) IF (old_buffer_length .LT. diis_env%buffer_length) THEN - ALLOCATE (m_b_tmp(diis_env%buffer_length+1, diis_env%buffer_length+1)) + ALLOCATE (m_b_tmp(diis_env%buffer_length + 1, diis_env%buffer_length + 1)) DO idomain = 1, ndomains IF (diis_env%m_b(idomain)%domain .GT. 0) THEN m_b_tmp(:, :) = 0.0_dp m_b_tmp(1:diis_env%buffer_length, 1:diis_env%buffer_length) = & diis_env%m_b(idomain)%mdata(:, :) DEALLOCATE (diis_env%m_b(idomain)%mdata) - ALLOCATE (diis_env%m_b(idomain)%mdata(diis_env%buffer_length+1, & - diis_env%buffer_length+1)) + ALLOCATE (diis_env%m_b(idomain)%mdata(diis_env%buffer_length + 1, & + diis_env%buffer_length + 1)) diis_env%m_b(idomain)%mdata(:, :) = m_b_tmp(:, :) ENDIF ENDDO @@ -303,8 +303,8 @@ SUBROUTINE almo_scf_diis_push(diis_env, var, err, d_var, d_err) ENDIF DO idomain = 1, ndomains IF (diis_env%m_b(idomain)%domain .GT. 0) THEN - diis_env%m_b(idomain)%mdata(1, in_point+1) = -1.0_dp - diis_env%m_b(idomain)%mdata(in_point+1, 1) = -1.0_dp + diis_env%m_b(idomain)%mdata(1, in_point + 1) = -1.0_dp + diis_env%m_b(idomain)%mdata(in_point + 1, 1) = -1.0_dp DO irow = 1, diis_env%buffer_length IF (diis_env%diis_env_type .EQ. diis_env_dbcsr) THEN trace0 = almo_scf_diis_error_overlap(diis_env, & @@ -314,14 +314,14 @@ SUBROUTINE almo_scf_diis_push(diis_env, var, err, d_var, d_err) d_A=diis_env%d_err(irow, idomain), & d_B=diis_env%d_err(in_point, idomain)) ENDIF - diis_env%m_b(idomain)%mdata(irow+1, in_point+1) = trace0 - diis_env%m_b(idomain)%mdata(in_point+1, irow+1) = trace0 + diis_env%m_b(idomain)%mdata(irow + 1, in_point + 1) = trace0 + diis_env%m_b(idomain)%mdata(in_point + 1, irow + 1) = trace0 ENDDO ! loop over prev errors ENDIF ENDDO ! loop over domains ! update the insertion point for the next "PUSH" - diis_env%in_point = diis_env%in_point+1 + diis_env%in_point = diis_env%in_point + 1 IF (diis_env%in_point .GT. diis_env%max_buffer_length) diis_env%in_point = 1 CALL timestop(handle) @@ -376,8 +376,8 @@ SUBROUTINE almo_scf_diis_extrapolate(diis_env, extr_var, d_extr_var) ENDIF ! Prepare data - ALLOCATE (eigenvalues(diis_env%buffer_length+1)) - ALLOCATE (m_b_copy(diis_env%buffer_length+1, diis_env%buffer_length+1)) + ALLOCATE (eigenvalues(diis_env%buffer_length + 1)) + ALLOCATE (m_b_copy(diis_env%buffer_length + 1, diis_env%buffer_length + 1)) ndomains = SIZE(diis_env%m_b) @@ -390,15 +390,15 @@ SUBROUTINE almo_scf_diis_extrapolate(diis_env, extr_var, d_extr_var) ! Query the optimal workspace for dsyev LWORK = -1 ALLOCATE (WORK(MAX(1, LWORK))) - CALL DSYEV('V', 'L', diis_env%buffer_length+1, m_b_copy, & - diis_env%buffer_length+1, eigenvalues, WORK, LWORK, INFO) + CALL DSYEV('V', 'L', diis_env%buffer_length + 1, m_b_copy, & + diis_env%buffer_length + 1, eigenvalues, WORK, LWORK, INFO) LWORK = INT(WORK(1)) DEALLOCATE (WORK) ! Allocate the workspace and solve the eigenproblem ALLOCATE (WORK(MAX(1, LWORK))) - CALL DSYEV('V', 'L', diis_env%buffer_length+1, m_b_copy, & - diis_env%buffer_length+1, eigenvalues, WORK, LWORK, INFO) + CALL DSYEV('V', 'L', diis_env%buffer_length + 1, m_b_copy, & + diis_env%buffer_length + 1, eigenvalues, WORK, LWORK, INFO) IF (INFO .NE. 0) THEN CPABORT("DSYEV failed") END IF @@ -411,8 +411,8 @@ SUBROUTINE almo_scf_diis_extrapolate(diis_env, extr_var, d_extr_var) !! tmp1(:,1)=-1.0_dp*m_b_copy(1,:)/eigenvalues(:) !! coeff=MATMUL(m_b_copy,tmp1) !! DEALLOCATE(tmp1) - ALLOCATE (tmp1(diis_env%buffer_length+1)) - ALLOCATE (coeff(diis_env%buffer_length+1)) + ALLOCATE (tmp1(diis_env%buffer_length + 1)) + ALLOCATE (coeff(diis_env%buffer_length + 1)) tmp1(:) = -1.0_dp*m_b_copy(1, :)/eigenvalues(:) coeff(:) = MATMUL(m_b_copy, tmp1) DEALLOCATE (tmp1) @@ -430,8 +430,8 @@ SUBROUTINE almo_scf_diis_extrapolate(diis_env, extr_var, d_extr_var) CALL dbcsr_set(extr_var, 0.0_dp) DO im = 1, diis_env%buffer_length CALL dbcsr_add(extr_var, diis_env%m_var(im), & - 1.0_dp, coeff(im+1)) - checksum = checksum+coeff(im+1) + 1.0_dp, coeff(im + 1)) + checksum = checksum + coeff(im + 1) ENDDO ELSE IF (diis_env%diis_env_type .EQ. diis_env_domain) THEN CALL copy_submatrices(diis_env%d_var(1, idomain), & @@ -440,9 +440,9 @@ SUBROUTINE almo_scf_diis_extrapolate(diis_env, extr_var, d_extr_var) CALL set_submatrices(d_extr_var(idomain), 0.0_dp) DO im = 1, diis_env%buffer_length CALL add_submatrices(1.0_dp, d_extr_var(idomain), & - coeff(im+1), diis_env%d_var(im, idomain), & + coeff(im + 1), diis_env%d_var(im, idomain), & 'N') - checksum = checksum+coeff(im+1) + checksum = checksum + coeff(im + 1) ENDDO ENDIF !WRITE(*,*) checksum diff --git a/src/almo_scf_methods.F b/src/almo_scf_methods.F index 1aa765ad17..a01e3b4a55 100644 --- a/src/almo_scf_methods.F +++ b/src/almo_scf_methods.F @@ -815,7 +815,7 @@ SUBROUTINE almo_scf_ks_xx_to_tv_xx(almo_scf_env) subm_t(idomain)) !! Copy occupied eigenvalues if smearing requested IF (almo_scf_env%smear) THEN - almo_scf_env%mo_energies(1+SUM(almo_scf_env%nocc_of_domain(:idomain-1, ispin)) & + almo_scf_env%mo_energies(1 + SUM(almo_scf_env%nocc_of_domain(:idomain - 1, ispin)) & :SUM(almo_scf_env%nocc_of_domain(:idomain, ispin)), ispin) & = eigenvalues(1:almo_scf_env%nocc_of_domain(idomain, ispin)) END IF @@ -986,7 +986,7 @@ SUBROUTINE almo_scf_ks_blk_to_tv_blk(almo_scf_env) !! (which is still a reasonable smearing in most cases...) IF (almo_scf_env%smear) THEN DO orbital = 1, nocc_of_block - almo_scf_env%mo_energies(SUM(almo_scf_env%nocc_of_domain(:iblock_row-1, ispin))+orbital, & + almo_scf_env%mo_energies(SUM(almo_scf_env%nocc_of_domain(:iblock_row - 1, ispin)) + orbital, & ispin) = eigenvalues(orbital) END DO END IF @@ -998,14 +998,14 @@ SUBROUTINE almo_scf_ks_blk_to_tv_blk(almo_scf_env) NULLIFY (p_new_block) CALL dbcsr_reserve_block2d(matrix_v_blk_orthog, iblock_row, iblock_col, p_new_block) CPASSERT(ASSOCIATED(p_new_block)) - p_new_block(:, :) = data_copy(:, (nocc_of_block+1):(nocc_of_block+nvirt_of_block)) + p_new_block(:, :) = data_copy(:, (nocc_of_block + 1):(nocc_of_block + nvirt_of_block)) ! virtual energies NULLIFY (p_new_block) CALL dbcsr_reserve_block2d(almo_scf_env%matrix_evv_full(ispin), iblock_row, iblock_col, p_new_block) CPASSERT(ASSOCIATED(p_new_block)) p_new_block(:, :) = 0.0_dp DO orbital = 1, nvirt_of_block - p_new_block(orbital, orbital) = eigenvalues(nocc_of_block+orbital) + p_new_block(orbital, orbital) = eigenvalues(nocc_of_block + orbital) ENDDO ENDIF @@ -1218,7 +1218,7 @@ SUBROUTINE almo_scf_p_blk_to_t_blk(almo_scf_env, ionic) nocc_of_block = SIZE(p_new_block, 2) CPASSERT(ASSOCIATED(p_new_block)) CPASSERT(nocc_of_block .GT. 0) - p_new_block(:, :) = data_copy(:, iblock_size-nocc_of_block+1:) + p_new_block(:, :) = data_copy(:, iblock_size - nocc_of_block + 1:) DEALLOCATE (WORK) DEALLOCATE (data_copy) @@ -1322,15 +1322,15 @@ SUBROUTINE almo_scf_t_rescaling(matrix_t, mo_energies, mu_of_domain, real_ne_of_ !! Apply Fermi-Dirac smearing for each domain and store associated occupations for the whole system DO idomain = 1, ndomains - CALL FermiFixed(occupation_numbers(1+neigenval_used:nocc_of_domain(idomain)+neigenval_used), & + CALL FermiFixed(occupation_numbers(1 + neigenval_used:nocc_of_domain(idomain) + neigenval_used), & mu_of_domain(idomain), & kTS, & - mo_energies(1+neigenval_used:nocc_of_domain(idomain)+neigenval_used), & + mo_energies(1 + neigenval_used:nocc_of_domain(idomain) + neigenval_used), & real_ne_of_domain(idomain), & smear_e_temp, & 1.0_dp) !! Warning, maxocc is set to 1 since we don't want to interfere with the spin_factor rescaling - spin_kTS = spin_kTS+kTS !! Add up electronic entropy contributions - neigenval_used = neigenval_used+nocc_of_domain(idomain) !! Update eigenvalues index offset + spin_kTS = spin_kTS + kTS !! Add up electronic entropy contributions + neigenval_used = neigenval_used + nocc_of_domain(idomain) !! Update eigenvalues index offset END DO rescaling_factors(:) = SQRT(occupation_numbers) !! scale = sqrt(occupation_number) @@ -2320,14 +2320,14 @@ SUBROUTINE construct_domain_preconditioner(matrix_main, subm_s_inv, subm_s_inv_h IF (idomain .EQ. 1) THEN index1_start = 1 ELSE - index1_start = map%index1(idomain-1) + index1_start = map%index1(idomain - 1) ENDIF - index1_end = map%index1(idomain)-1 + index1_end = map%index1(idomain) - 1 n_domain_mos = 0 DO row = index1_start, index1_end neighbor = map%pairs(row, 1) - n_domain_mos = n_domain_mos+nmos(neighbor) + n_domain_mos = n_domain_mos + nmos(neighbor) ENDDO naos = subm_main(idomain)%nrows @@ -2831,7 +2831,7 @@ SUBROUTINE pseudo_invert_matrix(A, Ainv, N, method, range1, range2, range1_thr, END IF ! complete the matrix DO ii = 1, N - DO jj = ii+1, N + DO jj = ii + 1, N Ainv(ii, jj) = Ainv(jj, ii) ENDDO !WRITE(*,'(100F13.9)') Ainv(ii,:) @@ -2882,11 +2882,11 @@ SUBROUTINE pseudo_invert_matrix(A, Ainv, N, method, range1, range2, range1_thr, IF ((jj .LE. range2) .AND. (eigenvalues(jj) .LT. range1_thr)) THEN temp1(jj, :) = temp2(:, jj)*0.0_dp IF (PRESENT(bad_modes_projector_down)) temp3(jj, :) = Ainv(:, jj)*1.0_dp - range1_eiv = range1_eiv+1 + range1_eiv = range1_eiv + 1 ELSE - temp1(jj, :) = temp2(:, jj)/(eigenvalues(jj)+my_shift) + temp1(jj, :) = temp2(:, jj)/(eigenvalues(jj) + my_shift) IF (PRESENT(bad_modes_projector_down)) temp3(jj, :) = Ainv(:, jj)*0.0_dp - range2_eiv = range2_eiv+1 + range2_eiv = range2_eiv + 1 ENDIF ENDDO ELSE @@ -2895,15 +2895,15 @@ SUBROUTINE pseudo_invert_matrix(A, Ainv, N, method, range1, range2, range1_thr, IF (jj .LE. range1) THEN temp1(jj, :) = temp2(:, jj)*0.0_dp IF (PRESENT(bad_modes_projector_down)) temp3(jj, :) = Ainv(:, jj)*1.0_dp - range1_eiv = range1_eiv+1 + range1_eiv = range1_eiv + 1 ELSE IF (jj .LE. range2) THEN temp1(jj, :) = temp2(:, jj)*1.0_dp IF (PRESENT(bad_modes_projector_down)) temp3(jj, :) = Ainv(:, jj)*1.0_dp - range2_eiv = range2_eiv+1 + range2_eiv = range2_eiv + 1 ELSE - temp1(jj, :) = temp2(:, jj)/(eigenvalues(jj)+my_shift) + temp1(jj, :) = temp2(:, jj)/(eigenvalues(jj) + my_shift) IF (PRESENT(bad_modes_projector_down)) temp3(jj, :) = Ainv(:, jj)*0.0_dp - range3_eiv = range3_eiv+1 + range3_eiv = range3_eiv + 1 ENDIF ENDDO ELSE IF (use_thr_only) THEN @@ -2911,11 +2911,11 @@ SUBROUTINE pseudo_invert_matrix(A, Ainv, N, method, range1, range2, range1_thr, IF (eigenvalues(jj) .LT. range1_thr) THEN temp1(jj, :) = temp2(:, jj)*0.0_dp IF (PRESENT(bad_modes_projector_down)) temp3(jj, :) = Ainv(:, jj)*1.0_dp - range1_eiv = range1_eiv+1 + range1_eiv = range1_eiv + 1 ELSE - temp1(jj, :) = temp2(:, jj)/(eigenvalues(jj)+my_shift) + temp1(jj, :) = temp2(:, jj)/(eigenvalues(jj) + my_shift) IF (PRESENT(bad_modes_projector_down)) temp3(jj, :) = Ainv(:, jj)*0.0_dp - range2_eiv = range2_eiv+1 + range2_eiv = range2_eiv + 1 ENDIF ENDDO ELSE ! no ranges, no thresholds @@ -3075,9 +3075,9 @@ SUBROUTINE pseudo_matrix_power(A, Apow, power, N, range1, range1_thr, shift) DO jj = 1, N IF ((jj .LE. range1) .AND. (eigenvalues(jj) .LT. range1_thr)) THEN temp1(jj, :) = temp2(:, jj)*0.0_dp - range1_eiv = range1_eiv+1 + range1_eiv = range1_eiv + 1 ELSE - temp1(jj, :) = temp2(:, jj)*((eigenvalues(jj)+my_shift)**power) + temp1(jj, :) = temp2(:, jj)*((eigenvalues(jj) + my_shift)**power) ENDIF ENDDO ELSE @@ -3085,9 +3085,9 @@ SUBROUTINE pseudo_matrix_power(A, Apow, power, N, range1, range1_thr, shift) DO jj = 1, N IF (jj .LE. range1) THEN temp1(jj, :) = temp2(:, jj)*0.0_dp - range1_eiv = range1_eiv+1 + range1_eiv = range1_eiv + 1 ELSE - temp1(jj, :) = temp2(:, jj)*((eigenvalues(jj)+my_shift)**power) + temp1(jj, :) = temp2(:, jj)*((eigenvalues(jj) + my_shift)**power) ENDIF ENDDO ELSE @@ -3096,14 +3096,14 @@ SUBROUTINE pseudo_matrix_power(A, Apow, power, N, range1, range1_thr, shift) IF (eigenvalues(jj) .LT. range1_thr) THEN temp1(jj, :) = temp2(:, jj)*0.0_dp - range1_eiv = range1_eiv+1 + range1_eiv = range1_eiv + 1 ELSE - temp1(jj, :) = temp2(:, jj)*((eigenvalues(jj)+my_shift)**power) + temp1(jj, :) = temp2(:, jj)*((eigenvalues(jj) + my_shift)**power) ENDIF ENDDO ELSE DO jj = 1, N - temp1(jj, :) = temp2(:, jj)*((eigenvalues(jj)+my_shift)**power) + temp1(jj, :) = temp2(:, jj)*((eigenvalues(jj) + my_shift)**power) ENDDO ENDIF ENDIF @@ -3158,8 +3158,8 @@ SUBROUTINE distribute_domains(almo_scf_env) DO idomain = 1, ndomains least_loaded = MINLOC(cpu_load, 1) - cpu_load(least_loaded) = cpu_load(least_loaded)+domain_load(idomain) - almo_scf_env%cpu_of_domain(index0(idomain)) = least_loaded-1 + cpu_load(least_loaded) = cpu_load(least_loaded) + domain_load(idomain) + almo_scf_env%cpu_of_domain(index0(idomain)) = least_loaded - 1 ENDDO DEALLOCATE (cpu_load) @@ -3339,9 +3339,9 @@ SUBROUTINE xalmo_initial_guess(m_guess, m_t_in, m_t0, m_quench_t, & ! extrapolation DO iaspc = 1, naspc - istore = MOD(xalmo_history%istore-iaspc, xalmo_history%nstore)+1 - alpha = (-1.0_dp)**(iaspc+1)*REAL(iaspc, KIND=dp)* & - binomial(2*naspc, naspc-iaspc)/binomial(2*naspc-2, naspc-1) + istore = MOD(xalmo_history%istore - iaspc, xalmo_history%nstore) + 1 + alpha = (-1.0_dp)**(iaspc + 1)*REAL(iaspc, KIND=dp)* & + binomial(2*naspc, naspc - iaspc)/binomial(2*naspc - 2, naspc - 1) IF (unit_nr > 0) THEN WRITE (unit_nr, FMT="(T3,A2,I0,A4,F10.6)") & "B(", iaspc, ") = ", alpha diff --git a/src/almo_scf_optimizer.F b/src/almo_scf_optimizer.F index 52f2072b62..3ee0042d40 100644 --- a/src/almo_scf_optimizer.F +++ b/src/almo_scf_optimizer.F @@ -190,7 +190,7 @@ SUBROUTINE almo_scf_block_diagonal(qs_env, almo_scf_env, optimizer) t1 = m_walltime() DO - iscf = iscf+1 + iscf = iscf + 1 ! obtain projected KS matrix and the DIIS-error vector CALL almo_scf_ks_to_ks_blk(almo_scf_env) @@ -254,7 +254,7 @@ SUBROUTINE almo_scf_block_diagonal(qs_env, almo_scf_env, optimizer) CALL dbcsr_add(almo_scf_env%matrix_ks_blk(ispin), & matrix_mixing_old_blk(ispin), & true_mixing_fraction, & - 1.0_dp-true_mixing_fraction) + 1.0_dp - true_mixing_fraction) END DO ENDIF ENDIF @@ -377,7 +377,7 @@ SUBROUTINE almo_scf_block_diagonal(qs_env, almo_scf_env, optimizer) ENDIF ! prepare_to_exit - energy_diff = energy_new-energy_old + energy_diff = energy_new - energy_old energy_old = energy_new almo_scf_env%almo_scf_energy = energy_new @@ -386,7 +386,7 @@ SUBROUTINE almo_scf_block_diagonal(qs_env, almo_scf_env, optimizer) IF (unit_nr > 0) THEN WRITE (unit_nr, '(T2,A13,I6,F23.10,E14.5,F14.9,F9.2)') "ALMO SCF DIIS", & iscf, & - energy_new, energy_diff, error_norm, t2-t1 + energy_new, energy_diff, error_norm, t2 - t1 ENDIF t1 = m_walltime() @@ -547,7 +547,7 @@ SUBROUTINE almo_scf_xalmo_eigensolver(qs_env, almo_scf_env, optimizer) t1 = m_walltime() DO - iscf = iscf+1 + iscf = iscf + 1 ! obtain projected KS matrix and the DIIS-error vector CALL almo_scf_ks_to_ks_xx(almo_scf_env) @@ -594,7 +594,7 @@ SUBROUTINE almo_scf_xalmo_eigensolver(qs_env, almo_scf_env, optimizer) CALL add_submatrices( & almo_scf_env%mixing_fraction, & almo_scf_env%domain_ks_xx(:, ispin), & - 1.0_dp-almo_scf_env%mixing_fraction, & + 1.0_dp - almo_scf_env%mixing_fraction, & submatrix_mixing_old_blk(:, ispin), & 'N') END DO @@ -678,7 +678,7 @@ SUBROUTINE almo_scf_xalmo_eigensolver(qs_env, almo_scf_env, optimizer) !! RS-WARNING: If smearing ALMO is requested, electronic entropy contribution should probably be included here - denergy_tot = denergy_tot+denergy_spin(ispin) + denergy_tot = denergy_tot + denergy_spin(ispin) ! RZK-warning Energy correction can be evaluated using matrix_x ! as shown in the attempt below and in the PCG procedure. @@ -751,7 +751,7 @@ SUBROUTINE almo_scf_xalmo_eigensolver(qs_env, almo_scf_env, optimizer) WRITE (unit_nr, '(T2,A35,F25.10)') "ENERGY LOWERING:", & denergy_tot WRITE (unit_nr, '(T2,A35,F25.10)') "CORRECTED ENERGY:", & - almo_scf_env%almo_scf_energy+denergy_tot + almo_scf_env%almo_scf_energy + denergy_tot WRITE (unit_nr, *) ENDIF CALL almo_scf_update_ks_energy(qs_env, & @@ -789,7 +789,7 @@ SUBROUTINE almo_scf_xalmo_eigensolver(qs_env, almo_scf_env, optimizer) ELSE ! not a perturbative treatment - energy_diff = energy_new-energy_old + energy_diff = energy_new - energy_old energy_old = energy_new almo_scf_env%almo_scf_energy = energy_new @@ -798,7 +798,7 @@ SUBROUTINE almo_scf_xalmo_eigensolver(qs_env, almo_scf_env, optimizer) IF (unit_nr > 0) THEN WRITE (unit_nr, '(T2,A,I6,F20.9,E11.3,E11.3,E11.3,F8.2)') "ALMO SCF", & iscf, & - energy_new, energy_diff, error_norm, error_norm_0, t2-t1 + energy_new, energy_diff, error_norm, error_norm_0, t2 - t1 ENDIF t1 = m_walltime() @@ -1243,7 +1243,7 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, & ! calculate objective function Tr(F_0 R) IF (ispin .EQ. 1) energy_new = 0.0_dp CALL dbcsr_dot(matrix_t_out(ispin), FTsiginv(ispin), energy_ispin) - energy_new = energy_new+energy_ispin*spin_factor + energy_new = energy_new + energy_ispin*spin_factor ENDIF IF (penalty_occ_vol) THEN @@ -1299,7 +1299,7 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, & WRITE (unit_nr, *) "energy, penalty: ", energy_new, penalty_func_new ENDIF ! this is not pure energy anymore - energy_new = energy_new+penalty_func_new + energy_new = energy_new + penalty_func_new ENDIF ENDDO ! ispin @@ -1452,7 +1452,7 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, & IF (.NOT. line_search) THEN line_search = .TRUE. - line_search_iteration = line_search_iteration+1 + line_search_iteration = line_search_iteration + 1 ELSE @@ -1465,11 +1465,11 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, & DO ispin = 1, nspins CALL dbcsr_dot(grad(ispin), step(ispin), tempreal) - line_search_error = line_search_error+tempreal + line_search_error = line_search_error + tempreal CALL dbcsr_dot(grad(ispin), grad(ispin), tempreal) - denom = denom+tempreal + denom = denom + tempreal CALL dbcsr_dot(step(ispin), step(ispin), tempreal) - denom2 = denom2+tempreal + denom2 = denom2 + tempreal ENDDO ! ispin @@ -1479,7 +1479,7 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, & IF (ABS(line_search_error) .GT. optimizer%lin_search_eps_error) THEN line_search = .TRUE. - line_search_iteration = line_search_iteration+1 + line_search_iteration = line_search_iteration + 1 ELSE line_search = .FALSE. line_search_iteration = 0 @@ -1494,12 +1494,12 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, & IF (.NOT. line_search) THEN line_search = .TRUE. - line_search_iteration = line_search_iteration+1 + line_search_iteration = line_search_iteration + 1 ELSE IF (line_search_iteration .EQ. fixed_line_search_niter) THEN line_search = .FALSE. line_search_iteration = 0 - line_search_iteration = line_search_iteration+1 + line_search_iteration = line_search_iteration + 1 ENDIF ENDIF @@ -1510,7 +1510,7 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, & IF (line_search) THEN energy_diff = 0.0_dp ELSE - energy_diff = energy_new-energy_old + energy_diff = energy_new - energy_old energy_old = energy_new ENDIF @@ -1521,7 +1521,7 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, & ! WRITE(unit_nr,*) "....updating step direction...." !ENDIF - cg_iteration = cg_iteration+1 + cg_iteration = cg_iteration + 1 ! save the previous step DO ispin = 1, nspins @@ -1721,7 +1721,7 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, & g0 = 0.0_dp DO ispin = 1, nspins CALL dbcsr_dot(grad(ispin), step(ispin), tempreal) - g0 = g0+tempreal + g0 = g0 + tempreal ENDDO ! ispin IF (iteration .EQ. 0) THEN step_size = optimizer%lin_search_step_size_guess @@ -1744,11 +1744,11 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, & g1 = 0.0_dp DO ispin = 1, nspins CALL dbcsr_dot(grad(ispin), step(ispin), tempreal) - g1 = g1+tempreal + g1 = g1 + tempreal ENDDO ! ispin ! we have accumulated some points along this direction ! use only the most recent g0 (quadratic approximation) - appr_sec_der = (g1-g0)/step_size + appr_sec_der = (g1 - g0)/step_size !IF (unit_nr > 0) THEN ! WRITE (unit_nr, '(A2,7F12.5)') & ! "EG", e0, e1, g0, g1, appr_sec_der, step_size, -g1/appr_sec_der @@ -1761,8 +1761,8 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, & ! if the next iteration is also line_search ! use e1 and the calculated g1 as e0 and g0 e1 = energy_new - appr_sec_der = 2.0*((e1-e0)/step_size-g0)/step_size - g1 = appr_sec_der*step_size+g0 + appr_sec_der = 2.0*((e1 - e0)/step_size - g0)/step_size + g1 = appr_sec_der*step_size + g0 !IF (unit_nr > 0) THEN ! WRITE (unit_nr, '(A2,7F12.5)') & ! "EG", e0, e1, g0, g1, appr_sec_der, step_size, -g1/appr_sec_der @@ -1772,7 +1772,7 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, & e0 = e1 g0 = g1 ENDIF - next_step_size_guess = next_step_size_guess+step_size + next_step_size_guess = next_step_size_guess + step_size ENDIF ! update theta @@ -1794,10 +1794,10 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, & WRITE (unit_nr, '(T2,A13,I6,F23.10,E14.5,F14.9,F9.2)') & iter_type, iteration, & energy_new, energy_diff, grad_norm, & - t2-t1 + t2 - t1 IF (penalty_occ_vol) THEN WRITE (unit_nr, '(T2,A19,F23.10)') & - "Energy component:", energy_new-penalty_func_new + "Energy component:", energy_new - penalty_func_new WRITE (unit_nr, '(T2,A19,F23.10)') & "Penalty component:", penalty_func_new ENDIF @@ -1805,7 +1805,7 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, & IF (my_special_case .EQ. xalmo_case_block_diag) THEN IF (penalty_occ_vol) THEN - almo_scf_env%almo_scf_energy = energy_new-penalty_func_new + almo_scf_env%almo_scf_energy = energy_new - penalty_func_new ELSE almo_scf_env%almo_scf_energy = energy_new ENDIF @@ -1813,7 +1813,7 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, & t1 = m_walltime() - iteration = iteration+1 + iteration = iteration + 1 IF (prepare_to_exit) EXIT ENDDO ! inner SCF loop @@ -1822,7 +1822,7 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, & outer_prepare_to_exit = .TRUE. ENDIF - outer_iteration = outer_iteration+1 + outer_iteration = outer_iteration + 1 IF (outer_prepare_to_exit) EXIT ENDDO ! outer SCF loop @@ -1904,7 +1904,7 @@ SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, & WRITE (unit_nr, '(T2,A35,F25.10)') "ENERGY LOWERING:", & energy_new WRITE (unit_nr, '(T2,A35,F25.10)') "CORRECTED ENERGY:", & - almo_scf_env%almo_scf_energy+energy_new + almo_scf_env%almo_scf_energy + energy_new WRITE (unit_nr, *) ENDIF CALL almo_scf_update_ks_energy(qs_env, & @@ -2058,7 +2058,7 @@ SUBROUTINE xalmo_analysis(detailed_analysis, eps_filter, m_T_in, m_T0_in, & CALL dbcsr_add(m_X, m_T_in(ispin), -1.0_dp, 1.0_dp) CALL dbcsr_dot(m_X, Fvo0, energy_ispin) - energy_out = energy_out+energy_ispin*spin_factor + energy_out = energy_out + energy_ispin*spin_factor IF (detailed_analysis) THEN @@ -2243,8 +2243,8 @@ SUBROUTINE split_v_blk(almo_scf_env) CALL dbcsr_reserve_block2d(almo_scf_env%matrix_v_disc_blk(ispin), & iblock_row, iblock_col, p_new_block) CPASSERT(ASSOCIATED(p_new_block)) - CPASSERT(retained_v+discarded_v .EQ. iblock_col_size) - p_new_block(:, :) = data_p(:, (retained_v+1):iblock_col_size) + CPASSERT(retained_v + discarded_v .EQ. iblock_col_size) + p_new_block(:, :) = data_p(:, (retained_v + 1):iblock_col_size) NULLIFY (p_new_block) CALL dbcsr_reserve_block2d(almo_scf_env%matrix_v_blk(ispin), & @@ -2733,7 +2733,7 @@ SUBROUTINE harris_foulkes_correction(almo_scf_env) ENDIF ! safe_mode t2cholesky = m_walltime() IF (unit_nr > 0) THEN - WRITE (unit_nr, *) "Cholesky+inverse wall-time: ", t2cholesky-t1cholesky + WRITE (unit_nr, *) "Cholesky+inverse wall-time: ", t2cholesky - t1cholesky ENDIF CALL timestop(handle2) ELSE @@ -2979,7 +2979,7 @@ SUBROUTINE harris_foulkes_correction(almo_scf_env) filter_eps=almo_scf_env%eps_filter) delta_obj_function = fun0 CALL dbcsr_dot(sigma_oo_curr_inv, sigma_oo_curr, obj_function) - delta_obj_function = obj_function-delta_obj_function + delta_obj_function = obj_function - delta_obj_function IF (line_search) THEN fun1 = obj_function ELSE @@ -2995,7 +2995,7 @@ SUBROUTINE harris_foulkes_correction(almo_scf_env) IF ((.NOT. md_in_k_space) .AND. & (iteration .GE. MAX(0, almo_scf_env%opt_k_prec_iter_start) .AND. & - MOD(iteration-almo_scf_env%opt_k_prec_iter_start, & + MOD(iteration - almo_scf_env%opt_k_prec_iter_start, & almo_scf_env%opt_k_prec_iter_freq) .EQ. 0)) THEN !IF ((iteration.eq.0).AND.(.NOT.md_in_k_space)) THEN @@ -3041,7 +3041,7 @@ SUBROUTINE harris_foulkes_correction(almo_scf_env) reset_conjugator = .FALSE. ! first check if manual reset is active IF (iteration .LT. MAX(almo_scf_env%opt_k_conj_iter_start, 1) .OR. & - MOD(iteration-almo_scf_env%opt_k_conj_iter_start, & + MOD(iteration - almo_scf_env%opt_k_conj_iter_start, & almo_scf_env%opt_k_conj_iter_freq) .EQ. 0) THEN reset_conjugator = .TRUE. @@ -3154,7 +3154,7 @@ SUBROUTINE harris_foulkes_correction(almo_scf_env) CALL dbcsr_dot(tmp_k_blk, step, numer) tau = -1.0_dp*numer/denom CALL dbcsr_dot(prev_step, grad, numer) - beta = tau-kappa*numer/denom + beta = tau - kappa*numer/denom CASE (cg_zero) beta = 0.0_dp CASE DEFAULT @@ -3213,11 +3213,11 @@ SUBROUTINE harris_foulkes_correction(almo_scf_env) safety_multiplier = 1.0E+1_dp ! must be more than one num_threshold = MAX(EPSILON(1.0_dp), & safety_multiplier*(almo_scf_env%eps_filter**2)*almo_scf_env%ndomains) - IF (ABS(fun1-fun0-gfun0*step_size) .LT. num_threshold) THEN + IF (ABS(fun1 - fun0 - gfun0*step_size) .LT. num_threshold) THEN IF (unit_nr > 0) THEN WRITE (unit_nr, '(T3,A,1X,E17.7)') & "Numerical accuracy is too low to observe non-linear behavior", & - ABS(fun1-fun0-gfun0*step_size) + ABS(fun1 - fun0 - gfun0*step_size) WRITE (unit_nr, '(T3,A,1X,E17.7,A,1X,E12.3)') "Error computing ", & ABS(gfun0), & " is smaller than the threshold", num_threshold @@ -3238,9 +3238,9 @@ SUBROUTINE harris_foulkes_correction(almo_scf_env) ! find the minimum assuming quadratic form ! use f0, f1, g0 - step_size_quadratic_approx = -(gfun0*step_size*step_size)/(2.0_dp*(fun1-fun0-gfun0*step_size)) + step_size_quadratic_approx = -(gfun0*step_size*step_size)/(2.0_dp*(fun1 - fun0 - gfun0*step_size)) ! use f0, f1, g1 - step_size_quadratic_approx2 = -(fun1-fun0-step_size*gfun1/2.0_dp)/(gfun1-(fun1-fun0)/step_size) + step_size_quadratic_approx2 = -(fun1 - fun0 - step_size*gfun1/2.0_dp)/(gfun1 - (fun1 - fun0)/step_size) IF ((step_size_quadratic_approx .LT. 0.0_dp) .AND. & (step_size_quadratic_approx2 .LT. 0.0_dp)) THEN @@ -3263,7 +3263,7 @@ SUBROUTINE harris_foulkes_correction(almo_scf_env) ! check accuracy of the quadratic approximation IF (use_quadratic_approximation) THEN - quadratic_approx_error = ABS(step_size_quadratic_approx- & + quadratic_approx_error = ABS(step_size_quadratic_approx - & step_size_quadratic_approx2)/step_size_quadratic_approx IF (quadratic_approx_error .GT. quadratic_approx_error_threshold) THEN IF (unit_nr > 0) THEN @@ -3282,14 +3282,14 @@ SUBROUTINE harris_foulkes_correction(almo_scf_env) ! if quadratic approximation is not accurate enough ! try to find the minimum assuming cubic form ! aa*x**3 + bb*x**2 + cc*x + dd = f(x) - bb = (-step_size*gfun1+3.0_dp*(fun1-fun0)-2.0_dp*step_size*gfun0)/(step_size*step_size) - aa = (gfun1-2.0_dp*step_size*bb-gfun0)/(3.0_dp*step_size*step_size) + bb = (-step_size*gfun1 + 3.0_dp*(fun1 - fun0) - 2.0_dp*step_size*gfun0)/(step_size*step_size) + aa = (gfun1 - 2.0_dp*step_size*bb - gfun0)/(3.0_dp*step_size*step_size) - IF (ABS(gfun1-2.0_dp*step_size*bb-gfun0) .LT. num_threshold) THEN + IF (ABS(gfun1 - 2.0_dp*step_size*bb - gfun0) .LT. num_threshold) THEN IF (unit_nr > 0) THEN WRITE (unit_nr, '(T3,A,1X,E17.7)') & "Numerical accuracy is too low to observe cubic behavior", & - ABS(gfun1-2.0_dp*step_size*bb-gfun0) + ABS(gfun1 - 2.0_dp*step_size*bb - gfun0) ENDIF use_cubic_approximation = .FALSE. use_quadratic_approximation = .TRUE. @@ -3334,7 +3334,7 @@ SUBROUTINE harris_foulkes_correction(almo_scf_env) IF (unit_nr > 0) THEN WRITE (unit_nr, '(T3,A)') "Use quadratic approximation" ENDIF - step_size = (step_size_quadratic_approx+step_size_quadratic_approx2)*0.5_dp + step_size = (step_size_quadratic_approx + step_size_quadratic_approx2)*0.5_dp ENDIF ! one more check on the step size @@ -3396,19 +3396,19 @@ SUBROUTINE harris_foulkes_correction(almo_scf_env) WRITE (unit_nr, '(T6,A,1X,I5,1X,E12.3,E16.7,F15.9,F15.9,F15.9,E12.3,F15.9,F15.9,F8.3)') & "K iter CG", iteration, time_step, time_step*iteration, & energy_correction(ispin), obj_function, delta_obj_function, grad_norm, & - kin_energy, kin_energy+obj_function, beta + kin_energy, kin_energy + obj_function, beta ELSE IF (line_search .OR. prepare_to_exit) THEN WRITE (unit_nr, '(T6,A,1X,I3,1X,E12.3,F16.10,F16.10,E12.3,E12.3,E12.3,F8.3,F8.3,F10.3)') & "K iter CG", iteration, step_size, & energy_correction(ispin), delta_obj_function, grad_norm, & - gfun0, line_search_error, beta, conjugacy_error, t2a-t1a + gfun0, line_search_error, beta, conjugacy_error, t2a - t1a !(flop1+flop2)/(1.0E6_dp*(t2-t1)) ELSE WRITE (unit_nr, '(T6,A,1X,I3,1X,E12.3,F16.10,F16.10,E12.3,E12.3,E12.3,F8.3,F8.3,F10.3)') & "K iter LS", iteration, step_size, & energy_correction(ispin), delta_obj_function, grad_norm, & - gfun1, line_search_error, beta, conjugacy_error, t2a-t1a + gfun1, line_search_error, beta, conjugacy_error, t2a - t1a !(flop1+flop2)/(1.0E6_dp*(t2-t1)) ENDIF ENDIF @@ -3420,7 +3420,7 @@ SUBROUTINE harris_foulkes_correction(almo_scf_env) prepare_to_exit = .TRUE. ENDIF ! opt_k_max_iter .ne. 0 - IF (.NOT. line_search) iteration = iteration+1 + IF (.NOT. line_search) iteration = iteration + 1 IF (prepare_to_exit) EXIT @@ -3590,7 +3590,7 @@ SUBROUTINE harris_foulkes_correction(almo_scf_env) ENDIF - outer_opt_k_iteration = outer_opt_k_iteration+1 + outer_opt_k_iteration = outer_opt_k_iteration + 1 IF (outer_opt_k_prepare_to_exit) EXIT ENDDO ! outer loop for k @@ -3711,7 +3711,7 @@ SUBROUTINE harris_foulkes_correction(almo_scf_env) energy_correction(ispin) WRITE (unit_nr, *) ENDIF - energy_correction_final = energy_correction_final+energy_correction(ispin) + energy_correction_final = energy_correction_final + energy_correction(ispin) !!! print out the results of decomposition analysis !!IF (unit_nr>0) THEN @@ -3865,7 +3865,7 @@ SUBROUTINE harris_foulkes_correction(almo_scf_env) matrix_p_almo_scf_converged(ispin), & energy_correction(ispin)) - energy_correction_final = energy_correction_final+energy_correction(ispin) + energy_correction_final = energy_correction_final + energy_correction(ispin) IF (unit_nr > 0) THEN WRITE (unit_nr, *) @@ -3890,8 +3890,8 @@ SUBROUTINE harris_foulkes_correction(almo_scf_env) WRITE (unit_nr, '(T2,A,F18.9,F18.9,F18.9,F12.6)') "ETOT", & almo_scf_env%almo_scf_energy, & energy_correction_final, & - almo_scf_env%almo_scf_energy+energy_correction_final, & - t2-t1 + almo_scf_env%almo_scf_energy + energy_correction_final, & + t2 - t1 WRITE (unit_nr, *) ENDIF @@ -5311,17 +5311,17 @@ SUBROUTINE print_mathematica_matrix(matrix, filename) CALL dbcsr_get_block_p(matrix_asym, row, col, block_p, found) IF (found) THEN - H(vert_offset+1:vert_offset+ao_block_sizes(row), & - hori_offset+1:hori_offset+mo_block_sizes(col)) & + H(vert_offset + 1:vert_offset + ao_block_sizes(row), & + hori_offset + 1:hori_offset + mo_block_sizes(col)) & = block_p(:, :) ENDIF - vert_offset = vert_offset+ao_block_sizes(row) + vert_offset = vert_offset + ao_block_sizes(row) ENDDO - hori_offset = hori_offset+mo_block_sizes(col) + hori_offset = hori_offset + mo_block_sizes(col) ENDDO ! loop over electron blocks @@ -5922,16 +5922,16 @@ SUBROUTINE compute_cg_beta(beta, numer, denom, reset_conjugator, conjugator, & CALL dbcsr_dot(m_tmp_no_1, prev_minus_prec_grad(i), num) CALL dbcsr_dot(m_tmp_no_1, step(i), num2) CALL dbcsr_dot(prev_step(i), grad(i), num3) - my_numer2 = my_numer2+num2 - my_numer3 = my_numer3+num3 + my_numer2 = my_numer2 + num2 + my_numer3 = my_numer3 + num3 CASE (cg_zero) num = 0.0_dp den = 1.0_dp CASE DEFAULT CPABORT("illegal conjugator") END SELECT - my_numer = my_numer+num - my_denom = my_denom+den + my_numer = my_numer + num + my_denom = my_denom + den CALL dbcsr_release(m_tmp_no_1) @@ -5947,7 +5947,7 @@ SUBROUTINE compute_cg_beta(beta, numer, denom, reset_conjugator, conjugator, & CASE (cg_hager_zhang) kappa = -2.0_dp*my_numer/my_denom tau = -1.0_dp*my_numer2/my_denom - beta = tau-kappa*my_numer3/my_denom + beta = tau - kappa*my_numer3/my_denom CASE (cg_zero) beta = 0.0_dp CASE DEFAULT @@ -6319,8 +6319,8 @@ SUBROUTINE newton_grad_to_step(optimizer, m_grad, m_delta, m_s, m_ks, & CALL dbcsr_dot(m_residue(ispin), m_zet(ispin), numer_ispin) CALL dbcsr_dot(m_step(ispin), m_Hstep(ispin), denom_ispin) - numer = numer+numer_ispin - denom = denom+denom_ispin + numer = numer + numer_ispin + denom = denom + denom_ispin ENDDO !ispin @@ -6419,11 +6419,11 @@ SUBROUTINE newton_grad_to_step(optimizer, m_grad, m_delta, m_s, m_ks, & WRITE (unit_nr, '(T6,A9,I6,F14.5,F14.5,F15.10,F9.2)') & iter_type, iteration, & alpha, beta, residue_norm, & - t2-t1 + t2 - t1 ENDIF t1 = m_walltime() - iteration = iteration+1 + iteration = iteration + 1 IF (prepare_to_exit) EXIT ENDDO ! inner loop @@ -6432,7 +6432,7 @@ SUBROUTINE newton_grad_to_step(optimizer, m_grad, m_delta, m_s, m_ks, & outer_prepare_to_exit = .TRUE. ENDIF - outer_iteration = outer_iteration+1 + outer_iteration = outer_iteration + 1 IF (outer_prepare_to_exit) EXIT ENDDO ! outer loop @@ -6447,7 +6447,7 @@ SUBROUTINE newton_grad_to_step(optimizer, m_grad, m_delta, m_s, m_ks, & CALL dbcsr_copy(m_zet(ispin), m_grad(ispin)) CALL dbcsr_dot(m_delta(ispin), m_zet(ispin), alpha) WRITE (unit_nr, *) "trace(grad.delta): ", alpha - alpha = -1.0_dp/(penalty_occ_vol_pf2(ispin)*alpha-1.0_dp) + alpha = -1.0_dp/(penalty_occ_vol_pf2(ispin)*alpha - 1.0_dp) WRITE (unit_nr, *) "correction alpha: ", alpha CALL dbcsr_scale(m_delta(ispin), alpha) @@ -6716,7 +6716,7 @@ SUBROUTINE apply_hessian(m_x_in, m_x_out, m_ks, m_s, m_siginv, & 0.0_dp, m_tmp_no_2, & retain_sparsity=.TRUE.) CALL dbcsr_add(m_x_out(ispin), m_tmp_no_2, & - 1.0_dp, -4.0_dp*penalty_prefactor_local+1.0_dp) + 1.0_dp, -4.0_dp*penalty_prefactor_local + 1.0_dp) #endif ! ! F_vv.X.S_oo @@ -6992,12 +6992,12 @@ SUBROUTINE hessian_diag_apply(matrix_grad, matrix_step, matrix_S_ao, & CALL dbcsr_get_block_p(quench_t, & row, col, block_p, found) IF (found) THEN - ao_domain_sizes(col) = ao_domain_sizes(col)+ao_blk_sizes(row) + ao_domain_sizes(col) = ao_domain_sizes(col) + ao_blk_sizes(row) ENDIF ENDDO - H_size = H_size+ao_domain_sizes(col)*mo_block_sizes(col) + H_size = H_size + ao_domain_sizes(col)*mo_block_sizes(col) ENDDO @@ -7043,8 +7043,8 @@ SUBROUTINE hessian_diag_apply(matrix_grad, matrix_step, matrix_S_ao, & block_row, block_col, block_p, found) IF (found) THEN ! copy the block into the submatrix - F_ao_block(ao_vert_offset+1:ao_vert_offset+ao_block_sizes(block_row), & - ao_hori_offset+1:ao_hori_offset+ao_block_sizes(block_col)) & + F_ao_block(ao_vert_offset + 1:ao_vert_offset + ao_block_sizes(block_row), & + ao_hori_offset + 1:ao_hori_offset + ao_block_sizes(block_col)) & = block_p(:, :) ENDIF @@ -7052,18 +7052,18 @@ SUBROUTINE hessian_diag_apply(matrix_grad, matrix_step, matrix_S_ao, & block_row, block_col, block_p, found) IF (found) THEN ! copy the block into the submatrix - S_ao_block(ao_vert_offset+1:ao_vert_offset+ao_block_sizes(block_row), & - ao_hori_offset+1:ao_hori_offset+ao_block_sizes(block_col)) & + S_ao_block(ao_vert_offset + 1:ao_vert_offset + ao_block_sizes(block_row), & + ao_hori_offset + 1:ao_hori_offset + ao_block_sizes(block_col)) & = block_p(:, :) ENDIF - ao_hori_offset = ao_hori_offset+ao_block_sizes(block_col) + ao_hori_offset = ao_hori_offset + ao_block_sizes(block_col) ENDIF ENDDO - ao_vert_offset = ao_vert_offset+ao_block_sizes(block_row) + ao_vert_offset = ao_vert_offset + ao_block_sizes(block_row) ENDIF @@ -7105,10 +7105,10 @@ SUBROUTINE hessian_diag_apply(matrix_grad, matrix_step, matrix_S_ao, & lev2_hori_offset = 0 DO orb_i = 1, mo_block_sizes(col) IF (orb_i .EQ. orb_j .AND. row .EQ. col) THEN - H(lev1_vert_offset+lev2_vert_offset+1:lev1_vert_offset+lev2_vert_offset+ao_domain_sizes(row), & - lev1_hori_offset+lev2_hori_offset+1:lev1_hori_offset+lev2_hori_offset+ao_domain_sizes(col)) & + H(lev1_vert_offset + lev2_vert_offset + 1:lev1_vert_offset + lev2_vert_offset + ao_domain_sizes(row), & + lev1_hori_offset + lev2_hori_offset + 1:lev1_hori_offset + lev2_hori_offset + ao_domain_sizes(col)) & != -penalty_prefactor_local*S_ao_block(:,:) - = F_ao_block(:, :)+S_ao_block(:, :) + = F_ao_block(:, :) + S_ao_block(:, :) !=S_ao_block(:,:) !RZK-warning =F_ao_block(:,:)+( 1.0_dp + penalty_prefactor_local )*S_ao_block(:,:) ! =S_mo_block(orb_j,orb_i)*F_ao_block(:,:)& @@ -7118,15 +7118,15 @@ SUBROUTINE hessian_diag_apply(matrix_grad, matrix_step, matrix_S_ao, & !WRITE(*,*) row, col, orb_j, orb_i, lev1_vert_offset+lev2_vert_offset+1, ao_domain_sizes(row),& ! lev1_hori_offset+lev2_hori_offset+1, ao_domain_sizes(col), S_mo_block(orb_j,orb_i) - lev2_hori_offset = lev2_hori_offset+ao_domain_sizes(col) + lev2_hori_offset = lev2_hori_offset + ao_domain_sizes(col) ENDDO - lev2_vert_offset = lev2_vert_offset+ao_domain_sizes(row) + lev2_vert_offset = lev2_vert_offset + ao_domain_sizes(row) ENDDO - lev1_hori_offset = lev1_hori_offset+ao_domain_sizes(col)*mo_block_sizes(col) + lev1_hori_offset = lev1_hori_offset + ao_domain_sizes(col)*mo_block_sizes(col) DEALLOCATE (F_ao_block) DEALLOCATE (S_ao_block) @@ -7135,7 +7135,7 @@ SUBROUTINE hessian_diag_apply(matrix_grad, matrix_step, matrix_S_ao, & ENDDO ! col fragment - lev1_vert_offset = lev1_vert_offset+ao_domain_sizes(row)*mo_block_sizes(row) + lev1_vert_offset = lev1_vert_offset + ao_domain_sizes(row)*mo_block_sizes(row) ENDDO ! row fragment @@ -7338,8 +7338,8 @@ SUBROUTINE hessian_diag_apply(matrix_grad, matrix_step, matrix_S_ao, & IF (found) THEN ! copy the data into the vector, column by column DO orb_i = 1, mo_block_sizes(col) - Grad_vec(lev1_vert_offset+ao_domain_sizes(col)*(orb_i-1)+lev2_vert_offset+1: & - lev1_vert_offset+ao_domain_sizes(col)*(orb_i-1)+lev2_vert_offset+ao_block_sizes(row)) & + Grad_vec(lev1_vert_offset + ao_domain_sizes(col)*(orb_i - 1) + lev2_vert_offset + 1: & + lev1_vert_offset + ao_domain_sizes(col)*(orb_i - 1) + lev2_vert_offset + ao_block_sizes(row)) & = block_p(:, orb_i) !WRITE(*,*) "GRAD: ", row, col, orb_i, lev1_vert_offset+ao_domain_sizes(col)*(orb_i-1)+lev2_vert_offset+1, ao_block_sizes(row) ENDDO @@ -7357,13 +7357,13 @@ SUBROUTINE hessian_diag_apply(matrix_grad, matrix_step, matrix_S_ao, & !S-1.G ENDDO !S-1.G ENDIF - lev2_vert_offset = lev2_vert_offset+ao_block_sizes(row) + lev2_vert_offset = lev2_vert_offset + ao_block_sizes(row) ENDIF ENDDO - lev1_vert_offset = lev1_vert_offset+ao_domain_sizes(col)*mo_block_sizes(col) + lev1_vert_offset = lev1_vert_offset + ao_domain_sizes(col)*mo_block_sizes(col) ENDDO ! loop over electron blocks @@ -7425,7 +7425,7 @@ SUBROUTINE hessian_diag_apply(matrix_grad, matrix_step, matrix_S_ao, & test(jj, :) = Hinv(:, jj)/eigenvalues(jj) ELSE test(jj, :) = Hinv(:, jj)*0.0_dp - zero_neg_eiv = zero_neg_eiv+1 + zero_neg_eiv = zero_neg_eiv + 1 ENDIF ENDDO WRITE (unit_nr, *) 'ZERO OR NEGATIVE EIGENVALUES: ', zero_neg_eiv @@ -7480,12 +7480,12 @@ SUBROUTINE hessian_diag_apply(matrix_grad, matrix_step, matrix_S_ao, & ALLOCATE (test(H_size, H_size)) test(:, :) = MATMUL(Hinv, H) DO ii = 1, H_size - test(ii, ii) = test(ii, ii)-1.0_dp + test(ii, ii) = test(ii, ii) - 1.0_dp ENDDO test_error = 0.0_dp DO ii = 1, H_size DO jj = 1, H_size - test_error = test_error+test(jj, ii)*test(jj, ii) + test_error = test_error + test(jj, ii)*test(jj, ii) ENDDO ENDDO WRITE (unit_nr, *) "Hessian inversion error: ", SQRT(test_error) @@ -7500,7 +7500,7 @@ SUBROUTINE hessian_diag_apply(matrix_grad, matrix_step, matrix_S_ao, & ALLOCATE (tmpr(H_size)) tmpr(:) = MATMUL(H, Step_vec) - tmp(:) = tmpr(:)+Grad_vec(:) + tmp(:) = tmpr(:) + Grad_vec(:) DEALLOCATE (tmpr) WRITE (unit_nr, *) "NEWTOV step error: ", MAXVAL(ABS(tmp)) @@ -7538,17 +7538,17 @@ SUBROUTINE hessian_diag_apply(matrix_grad, matrix_step, matrix_S_ao, & ! copy the data column by column DO orb_i = 1, mo_block_sizes(col) p_new_block(:, orb_i) = & - Step_vec(lev1_vert_offset+ao_domain_sizes(col)*(orb_i-1)+lev2_vert_offset+1: & - lev1_vert_offset+ao_domain_sizes(col)*(orb_i-1)+lev2_vert_offset+ao_block_sizes(row)) + Step_vec(lev1_vert_offset + ao_domain_sizes(col)*(orb_i - 1) + lev2_vert_offset + 1: & + lev1_vert_offset + ao_domain_sizes(col)*(orb_i - 1) + lev2_vert_offset + ao_block_sizes(row)) ENDDO - lev2_vert_offset = lev2_vert_offset+ao_block_sizes(row) + lev2_vert_offset = lev2_vert_offset + ao_block_sizes(row) ENDIF ENDDO - lev1_vert_offset = lev1_vert_offset+ao_domain_sizes(col)*mo_block_sizes(col) + lev1_vert_offset = lev1_vert_offset + ao_domain_sizes(col)*mo_block_sizes(col) ENDDO ! loop over electron blocks diff --git a/src/almo_scf_qs.F b/src/almo_scf_qs.F index 7506b9afd0..d70c60e471 100644 --- a/src/almo_scf_qs.F +++ b/src/almo_scf_qs.F @@ -187,7 +187,7 @@ SUBROUTINE matrix_almo_create(matrix_new, matrix_qs, almo_scf_env, & block_sizes_new(:) = 0 DO iatom = 1, natoms block_sizes_new(almo_scf_env%domain_index_of_atom(iatom)) = & - block_sizes_new(almo_scf_env%domain_index_of_atom(iatom))+ & + block_sizes_new(almo_scf_env%domain_index_of_atom(iatom)) + & blk_sizes(iatom) ENDDO DO imol = 1, nmols @@ -723,7 +723,7 @@ SUBROUTINE almo_dm_to_qs_ks(qs_env, matrix_p, energy_total, mat_distr_aos, smear !! Add electronic entropy contribution if smearing is requested !! Previous QS entropy is replaced by the sum of the entropy for each spin IF (smearing) THEN - energy%total = energy%total-energy%kTS+entropic_term + energy%total = energy%total - energy%kTS + entropic_term END IF energy_total = energy%total @@ -831,7 +831,7 @@ SUBROUTINE almo_scf_update_ks_energy(qs_env, energy, energy_singles_corr) qs_energy%total = energy ENDIF - qs_energy%total = qs_energy%total+qs_energy%singles_corr + qs_energy%total = qs_energy%total + qs_energy%singles_corr END SUBROUTINE almo_scf_update_ks_energy @@ -962,7 +962,7 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env) iatom=iatom2, jatom=jatom2, inode=inode2, nnode=nnode2) !WRITE(*,*) "GET INFO: ",iatom2, jatom2, inode2, nnode2 IF (inode2 == 1) THEN - local_list_length = local_list_length+nnode2 + local_list_length = local_list_length + nnode2 END IF END DO CALL neighbor_list_iterator_release(nl_iterator) @@ -975,9 +975,9 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env) DO WHILE (neighbor_list_iterate(nl_iterator2) == 0) CALL get_iterator_info(nl_iterator2, & iatom=iatom2, jatom=jatom2) - local_list(2*local_list_length+1) = iatom2 - local_list(2*local_list_length+2) = jatom2 - local_list_length = local_list_length+1 + local_list(2*local_list_length + 1) = iatom2 + local_list(2*local_list_length + 2) = jatom2 + local_list_length = local_list_length + 1 ENDDO ! end loop over pairs of atoms CALL neighbor_list_iterator_release(nl_iterator2) @@ -988,10 +988,10 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env) ! fourth, create a global list list_offset_cpu(1) = 0 DO iNode = 2, nNodes - list_offset_cpu(iNode) = list_offset_cpu(iNode-1)+ & - list_length_cpu(iNode-1) + list_offset_cpu(iNode) = list_offset_cpu(iNode - 1) + & + list_length_cpu(iNode - 1) ENDDO - global_list_length = list_offset_cpu(nNodes)+list_length_cpu(nNodes) + global_list_length = list_offset_cpu(nNodes) + list_length_cpu(nNodes) ! fifth, communicate all list data ALLOCATE (global_list(global_list_length)) @@ -1005,15 +1005,15 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env) current_number_neighbors(:) = 0 global_list_length = global_list_length/2 DO ipair = 1, global_list_length - iatom2 = global_list(2*(ipair-1)+1) - jatom2 = global_list(2*(ipair-1)+2) + iatom2 = global_list(2*(ipair - 1) + 1) + jatom2 = global_list(2*(ipair - 1) + 2) idomain2 = almo_scf_env%domain_index_of_atom(iatom2) jdomain2 = almo_scf_env%domain_index_of_atom(jatom2) ! add to the list - current_number_neighbors(idomain2) = current_number_neighbors(idomain2)+1 + current_number_neighbors(idomain2) = current_number_neighbors(idomain2) + 1 ! add j,i with i,j IF (idomain2 .NE. jdomain2) THEN - current_number_neighbors(jdomain2) = current_number_neighbors(jdomain2)+1 + current_number_neighbors(jdomain2) = current_number_neighbors(jdomain2) + 1 ENDIF ENDDO max_domain_neighbors = MAXVAL(current_number_neighbors) @@ -1025,8 +1025,8 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env) domain_neighbor_list_excessive(ipair, 1) = ipair ENDDO DO ipair = 1, global_list_length - iatom2 = global_list(2*(ipair-1)+1) - jatom2 = global_list(2*(ipair-1)+2) + iatom2 = global_list(2*(ipair - 1) + 1) + jatom2 = global_list(2*(ipair - 1) + 2) idomain2 = almo_scf_env%domain_index_of_atom(iatom2) jdomain2 = almo_scf_env%domain_index_of_atom(jatom2) already_listed = .FALSE. @@ -1038,11 +1038,11 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env) ENDDO IF (.NOT. already_listed) THEN ! add to the list - current_number_neighbors(idomain2) = current_number_neighbors(idomain2)+1 + current_number_neighbors(idomain2) = current_number_neighbors(idomain2) + 1 domain_neighbor_list_excessive(idomain2, current_number_neighbors(idomain2)) = jdomain2 ! add j,i with i,j IF (idomain2 .NE. jdomain2) THEN - current_number_neighbors(jdomain2) = current_number_neighbors(jdomain2)+1 + current_number_neighbors(jdomain2) = current_number_neighbors(jdomain2) + 1 domain_neighbor_list_excessive(jdomain2, current_number_neighbors(jdomain2)) = idomain2 ENDIF ENDIF @@ -1133,9 +1133,9 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env) IF (domain_map_local_entries .GE. max_domain_neighbors*almo_scf_env%ndomains) THEN CPABORT("weird... max_domain_neighbors is exceeded") ENDIF - almo_scf_env%domain_map(ispin)%pairs(domain_map_local_entries+1, 1) = iblock_row - almo_scf_env%domain_map(ispin)%pairs(domain_map_local_entries+1, 2) = iblock_col - domain_map_local_entries = domain_map_local_entries+1 + almo_scf_env%domain_map(ispin)%pairs(domain_map_local_entries + 1, 1) = iblock_row + almo_scf_env%domain_map(ispin)%pairs(domain_map_local_entries + 1, 2) = iblock_col + domain_map_local_entries = domain_map_local_entries + 1 ENDIF @@ -1198,7 +1198,7 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env) s0 = -LOG10(ABS(almo_scf_env%quencher_s0)) s1 = -LOG10(ABS(almo_scf_env%quencher_s1)) IF (overlap .EQ. 0.0_dp) THEN - overlap = -LOG10(ABS(almo_scf_env%eps_filter))+100.0_dp + overlap = -LOG10(ABS(almo_scf_env%eps_filter)) + 100.0_dp ELSE overlap = -LOG10(overlap) ENDIF @@ -1223,7 +1223,7 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env) !WRITE(*,'(A15,2I7,3F8.3,E11.3)') "INTRA-BLOCKS: ",& ! iblock_col, iblock_row, s0, s1, overlap, p_new_block(1,1) ELSE - p_new_block(:, :) = 1.0_dp/(1.0_dp+EXP(-(s0-s1)/(s0-overlap)-(s0-s1)/(overlap-s1))) + p_new_block(:, :) = 1.0_dp/(1.0_dp + EXP(-(s0 - s1)/(s0 - overlap) - (s0 - s1)/(overlap - s1))) !WRITE(*,'(A15,2I7,3F8.3,E11.3)') "INTER-BLOCKS: ",& ! iblock_col, iblock_row, s0, s1, overlap, p_new_block(1,1) ENDIF @@ -1232,9 +1232,9 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env) IF (domain_map_local_entries .GE. max_domain_neighbors*almo_scf_env%ndomains) THEN CPABORT("weird... max_domain_neighbors is exceeded") ENDIF - almo_scf_env%domain_map(ispin)%pairs(domain_map_local_entries+1, 1) = iblock_row - almo_scf_env%domain_map(ispin)%pairs(domain_map_local_entries+1, 2) = iblock_col - domain_map_local_entries = domain_map_local_entries+1 + almo_scf_env%domain_map(ispin)%pairs(domain_map_local_entries + 1, 1) = iblock_row + almo_scf_env%domain_map(ispin)%pairs(domain_map_local_entries + 1, 2) = iblock_col + domain_map_local_entries = domain_map_local_entries + 1 ENDIF ENDIF @@ -1263,7 +1263,7 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env) DO iatom = first_atom_of_molecule(domain_row), last_atom_of_molecule(domain_row) DO jatom = first_atom_of_molecule(domain_col), last_atom_of_molecule(domain_col) rab(:) = pbc(particle_set(iatom)%r(:), particle_set(jatom)%r(:), cell) - trial_distance_squared = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + trial_distance_squared = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) IF (trial_distance_squared .LT. distance_squared) THEN distance_squared = trial_distance_squared contact_atom_1 = iatom @@ -1297,7 +1297,7 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env) ! ao domains are atomic / electron groups are atomic ! compute distance between atoms: domain_row and domain_col rab(:) = pbc(particle_set(domain_row)%r(:), particle_set(domain_col)%r(:), cell) - distance = SQRT(rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3)) + distance = SQRT(rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3)) contact_atom_1 = domain_row contact_atom_2 = domain_col @@ -1327,9 +1327,9 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env) ! the element specific radii ! compute inner and outer cutoff radii - r0 = almo_scf_env%quencher_r0_factor*(contact1_radius+contact2_radius) + r0 = almo_scf_env%quencher_r0_factor*(contact1_radius + contact2_radius) !+almo_scf_env%quencher_r0_shift - r1 = almo_scf_env%quencher_r1_factor*(contact1_radius+contact2_radius) + r1 = almo_scf_env%quencher_r1_factor*(contact1_radius + contact2_radius) !+almo_scf_env%quencher_r1_shift IF (r0 .LT. 0.0_dp) THEN @@ -1356,7 +1356,7 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env) ELSE ! remove the intermediate values from the quencher temporarily CPABORT("") - p_new_block(:, :) = 1.0_dp/(1.0_dp+EXP((r1-r0)/(r0-distance)+(r1-r0)/(r1-distance))) + p_new_block(:, :) = 1.0_dp/(1.0_dp + EXP((r1 - r0)/(r0 - distance) + (r1 - r0)/(r1 - distance))) !WRITE(*,'(A15,2I7,5F8.3,E11.3)') "INTER-BLOCKS: ",& ! iblock_col, iblock_row, contact1_radius,& ! contact2_radius, r0, r1, distance, p_new_block(1,1) @@ -1366,9 +1366,9 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env) IF (domain_map_local_entries .GE. max_domain_neighbors*almo_scf_env%ndomains) THEN CPABORT("weird... max_domain_neighbors is exceeded") ENDIF - almo_scf_env%domain_map(ispin)%pairs(domain_map_local_entries+1, 1) = iblock_row - almo_scf_env%domain_map(ispin)%pairs(domain_map_local_entries+1, 2) = iblock_col - domain_map_local_entries = domain_map_local_entries+1 + almo_scf_env%domain_map(ispin)%pairs(domain_map_local_entries + 1, 1) = iblock_row + almo_scf_env%domain_map(ispin)%pairs(domain_map_local_entries + 1, 2) = iblock_col + domain_map_local_entries = domain_map_local_entries + 1 ENDIF ENDIF @@ -1404,16 +1404,16 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env) ! second, create offset_for_cpu(1) = 0 DO iNode = 2, nNodes - offset_for_cpu(iNode) = offset_for_cpu(iNode-1)+ & - domain_entries_cpu(iNode-1) + offset_for_cpu(iNode) = offset_for_cpu(iNode - 1) + & + domain_entries_cpu(iNode - 1) ENDDO - global_entries = offset_for_cpu(nNodes)+domain_entries_cpu(nNodes) + global_entries = offset_for_cpu(nNodes) + domain_entries_cpu(nNodes) ! communicate all entries ALLOCATE (domain_map_global(global_entries)) ALLOCATE (domain_map_local(2*domain_map_local_entries)) DO ientry = 1, domain_map_local_entries - domain_map_local(2*(ientry-1)+1) = almo_scf_env%domain_map(ispin)%pairs(ientry, 1) + domain_map_local(2*(ientry - 1) + 1) = almo_scf_env%domain_map(ispin)%pairs(ientry, 1) domain_map_local(2*ientry) = almo_scf_env%domain_map(ispin)%pairs(ientry, 2) ENDDO CALL mp_allgather(domain_map_local, domain_map_global, & @@ -1445,7 +1445,7 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env) ! get the center grid1 = domain_map_global(2*ientry) ! get the neighbor - ineig = domain_map_global(2*(ientry-1)+1) + ineig = domain_map_global(2*(ientry - 1) + 1) ! check boundaries IF (domain_grid(grid1, 0) .GT. max_neig) THEN ! this neighbor will overstep the boundaries @@ -1475,7 +1475,7 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env) ENDIF ENDDO IF (delayed_increment) THEN - domain_grid(grid1, 0) = domain_grid(grid1, 0)+1 + domain_grid(grid1, 0) = domain_grid(grid1, 0) + 1 ELSE ! should not be here - all records must be inserted CPABORT("all records must be inserted") @@ -1487,10 +1487,10 @@ SUBROUTINE almo_scf_construct_quencher(qs_env, almo_scf_env) ientry = 1 DO idomain = 1, almo_scf_env%ndomains - DO ineig = 1, domain_grid(idomain, 0)-1 + DO ineig = 1, domain_grid(idomain, 0) - 1 almo_scf_env%domain_map(ispin)%pairs(ientry, 1) = domain_grid(idomain, ineig) almo_scf_env%domain_map(ispin)%pairs(ientry, 2) = idomain - ientry = ientry+1 + ientry = ientry + 1 ENDDO almo_scf_env%domain_map(ispin)%index1(idomain) = ientry ENDDO diff --git a/src/aobasis/ai_angmom.F b/src/aobasis/ai_angmom.F index 8791dd8918..6076a1034f 100644 --- a/src/aobasis/ai_angmom.F +++ b/src/aobasis/ai_angmom.F @@ -81,8 +81,8 @@ SUBROUTINE angmom(la_max, npgfa, zeta, rpgfa, la_min, & ! zetp : Reciprocal of the sum of the exponents of orbital a and b. ! *** Calculate the distance between the centers a and b *** - rab = rbc-rac - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab = rbc - rac + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) dab = SQRT(rab2) ! *** Loop over all pairs of primitive Gaussian-type functions *** @@ -103,21 +103,21 @@ SUBROUTINE angmom(la_max, npgfa, zeta, rpgfa, la_min, & ! *** Screening *** - IF (rpgfa(ipgf)+rpgfb(jpgf) < dab) THEN - DO j = nb+1, nb+ncoset(lb_max) - DO i = na+1, na+ncoset(la_max) + IF (rpgfa(ipgf) + rpgfb(jpgf) < dab) THEN + DO j = nb + 1, nb + ncoset(lb_max) + DO i = na + 1, na + ncoset(la_max) angab(i, j, 1) = 0.0_dp angab(i, j, 2) = 0.0_dp angab(i, j, 3) = 0.0_dp END DO END DO - nb = nb+ncoset(lb_max) + nb = nb + ncoset(lb_max) CYCLE END IF ! *** Calculate some prefactors *** - zetp = 1.0_dp/(zeta(ipgf)+zetb(jpgf)) + zetp = 1.0_dp/(zeta(ipgf) + zetb(jpgf)) f0 = (pi*zetp)**1.5_dp f1 = zetb(jpgf)*zetp @@ -151,9 +151,9 @@ SUBROUTINE angmom(la_max, npgfa, zeta, rpgfa, la_min, & ! *** Calculate the basic two-center angular momentum integral [s|L|s] *** s(1, 1) = f0*EXP(-zeta(ipgf)*f1*rab2) - as(1, 1, 1) = 2._dp*zeta(ipgf)*f1*(rac(2)*rbc(3)-rac(3)*rbc(2))*s(1, 1) - as(1, 1, 2) = 2._dp*zeta(ipgf)*f1*(rac(3)*rbc(1)-rac(1)*rbc(3))*s(1, 1) - as(1, 1, 3) = 2._dp*zeta(ipgf)*f1*(rac(1)*rbc(2)-rac(2)*rbc(1))*s(1, 1) + as(1, 1, 1) = 2._dp*zeta(ipgf)*f1*(rac(2)*rbc(3) - rac(3)*rbc(2))*s(1, 1) + as(1, 1, 2) = 2._dp*zeta(ipgf)*f1*(rac(3)*rbc(1) - rac(1)*rbc(3))*s(1, 1) + as(1, 1, 3) = 2._dp*zeta(ipgf)*f1*(rac(1)*rbc(2) - rac(2)*rbc(1))*s(1, 1) ! *** Recurrence steps: [s|L|s] -> [a|L|b] *** @@ -169,15 +169,15 @@ SUBROUTINE angmom(la_max, npgfa, zeta, rpgfa, la_min, & s(2, 1) = rap(1)*s(1, 1) s(3, 1) = rap(2)*s(1, 1) s(4, 1) = rap(3)*s(1, 1) - as(2, 1, 1) = rap(1)*as(1, 1, 1)+bc1(1)*s(1, 1) - as(2, 1, 2) = rap(1)*as(1, 1, 2)+bc1(2)*s(1, 1) - as(2, 1, 3) = rap(1)*as(1, 1, 3)+bc1(3)*s(1, 1) - as(3, 1, 1) = rap(2)*as(1, 1, 1)+bc2(1)*s(1, 1) - as(3, 1, 2) = rap(2)*as(1, 1, 2)+bc2(2)*s(1, 1) - as(3, 1, 3) = rap(2)*as(1, 1, 3)+bc2(3)*s(1, 1) - as(4, 1, 1) = rap(3)*as(1, 1, 1)+bc3(1)*s(1, 1) - as(4, 1, 2) = rap(3)*as(1, 1, 2)+bc3(2)*s(1, 1) - as(4, 1, 3) = rap(3)*as(1, 1, 3)+bc3(3)*s(1, 1) + as(2, 1, 1) = rap(1)*as(1, 1, 1) + bc1(1)*s(1, 1) + as(2, 1, 2) = rap(1)*as(1, 1, 2) + bc1(2)*s(1, 1) + as(2, 1, 3) = rap(1)*as(1, 1, 3) + bc1(3)*s(1, 1) + as(3, 1, 1) = rap(2)*as(1, 1, 1) + bc2(1)*s(1, 1) + as(3, 1, 2) = rap(2)*as(1, 1, 2) + bc2(2)*s(1, 1) + as(3, 1, 3) = rap(2)*as(1, 1, 3) + bc2(3)*s(1, 1) + as(4, 1, 1) = rap(3)*as(1, 1, 1) + bc3(1)*s(1, 1) + as(4, 1, 2) = rap(3)*as(1, 1, 2) + bc3(2)*s(1, 1) + as(4, 1, 3) = rap(3)*as(1, 1, 3) + bc3(3)*s(1, 1) ! *** [a|s] = (Pi - Ai)*[a-1i|s] + f2*Ni(a-1i)*[a-2i|s] *** ! *** [a|Ln|s] = (Pi - Ai)*[a-1i|Ln|s] + f2*Ni(a-1i)*[a-2i|Ln|s] *** @@ -187,72 +187,72 @@ SUBROUTINE angmom(la_max, npgfa, zeta, rpgfa, la_min, & ! *** Increase the angular momentum component z of function a *** - s(coset(0, 0, la), 1) = rap(3)*s(coset(0, 0, la-1), 1)+ & - f2*REAL(la-1, dp)*s(coset(0, 0, la-2), 1) - as(coset(0, 0, la), 1, 1) = rap(3)*as(coset(0, 0, la-1), 1, 1)+ & - f2*REAL(la-1, dp)*as(coset(0, 0, la-2), 1, 1)+ & - bc3(1)*s(coset(0, 0, la-1), 1) - as(coset(0, 0, la), 1, 2) = rap(3)*as(coset(0, 0, la-1), 1, 2)+ & - f2*REAL(la-1, dp)*as(coset(0, 0, la-2), 1, 2)+ & - bc3(2)*s(coset(0, 0, la-1), 1) - as(coset(0, 0, la), 1, 3) = rap(3)*as(coset(0, 0, la-1), 1, 3)+ & - f2*REAL(la-1, dp)*as(coset(0, 0, la-2), 1, 3)+ & - bc3(3)*s(coset(0, 0, la-1), 1) + s(coset(0, 0, la), 1) = rap(3)*s(coset(0, 0, la - 1), 1) + & + f2*REAL(la - 1, dp)*s(coset(0, 0, la - 2), 1) + as(coset(0, 0, la), 1, 1) = rap(3)*as(coset(0, 0, la - 1), 1, 1) + & + f2*REAL(la - 1, dp)*as(coset(0, 0, la - 2), 1, 1) + & + bc3(1)*s(coset(0, 0, la - 1), 1) + as(coset(0, 0, la), 1, 2) = rap(3)*as(coset(0, 0, la - 1), 1, 2) + & + f2*REAL(la - 1, dp)*as(coset(0, 0, la - 2), 1, 2) + & + bc3(2)*s(coset(0, 0, la - 1), 1) + as(coset(0, 0, la), 1, 3) = rap(3)*as(coset(0, 0, la - 1), 1, 3) + & + f2*REAL(la - 1, dp)*as(coset(0, 0, la - 2), 1, 3) + & + bc3(3)*s(coset(0, 0, la - 1), 1) ! *** Increase the angular momentum component y of function a *** - az = la-1 + az = la - 1 s(coset(0, 1, az), 1) = rap(2)*s(coset(0, 0, az), 1) - as(coset(0, 1, az), 1, 1) = rap(2)*as(coset(0, 0, az), 1, 1)+ & + as(coset(0, 1, az), 1, 1) = rap(2)*as(coset(0, 0, az), 1, 1) + & bc2(1)*s(coset(0, 0, az), 1) - as(coset(0, 1, az), 1, 2) = rap(2)*as(coset(0, 0, az), 1, 2)+ & + as(coset(0, 1, az), 1, 2) = rap(2)*as(coset(0, 0, az), 1, 2) + & bc2(2)*s(coset(0, 0, az), 1) - as(coset(0, 1, az), 1, 3) = rap(2)*as(coset(0, 0, az), 1, 3)+ & + as(coset(0, 1, az), 1, 3) = rap(2)*as(coset(0, 0, az), 1, 3) + & bc2(3)*s(coset(0, 0, az), 1) DO ay = 2, la - az = la-ay - s(coset(0, ay, az), 1) = rap(2)*s(coset(0, ay-1, az), 1)+ & - f2*REAL(ay-1, dp)*s(coset(0, ay-2, az), 1) - as(coset(0, ay, az), 1, 1) = rap(2)*as(coset(0, ay-1, az), 1, 1)+ & - f2*REAL(ay-1, dp)*as(coset(0, ay-2, az), 1, 1)+ & - bc2(1)*s(coset(0, ay-1, az), 1) - as(coset(0, ay, az), 1, 2) = rap(2)*as(coset(0, ay-1, az), 1, 2)+ & - f2*REAL(ay-1, dp)*as(coset(0, ay-2, az), 1, 2)+ & - bc2(2)*s(coset(0, ay-1, az), 1) - as(coset(0, ay, az), 1, 3) = rap(2)*as(coset(0, ay-1, az), 1, 3)+ & - f2*REAL(ay-1, dp)*as(coset(0, ay-2, az), 1, 3)+ & - bc2(3)*s(coset(0, ay-1, az), 1) + az = la - ay + s(coset(0, ay, az), 1) = rap(2)*s(coset(0, ay - 1, az), 1) + & + f2*REAL(ay - 1, dp)*s(coset(0, ay - 2, az), 1) + as(coset(0, ay, az), 1, 1) = rap(2)*as(coset(0, ay - 1, az), 1, 1) + & + f2*REAL(ay - 1, dp)*as(coset(0, ay - 2, az), 1, 1) + & + bc2(1)*s(coset(0, ay - 1, az), 1) + as(coset(0, ay, az), 1, 2) = rap(2)*as(coset(0, ay - 1, az), 1, 2) + & + f2*REAL(ay - 1, dp)*as(coset(0, ay - 2, az), 1, 2) + & + bc2(2)*s(coset(0, ay - 1, az), 1) + as(coset(0, ay, az), 1, 3) = rap(2)*as(coset(0, ay - 1, az), 1, 3) + & + f2*REAL(ay - 1, dp)*as(coset(0, ay - 2, az), 1, 3) + & + bc2(3)*s(coset(0, ay - 1, az), 1) END DO ! *** Increase the angular momentum component x of function a *** - DO ay = 0, la-1 - az = la-1-ay + DO ay = 0, la - 1 + az = la - 1 - ay s(coset(1, ay, az), 1) = rap(1)*s(coset(0, ay, az), 1) - as(coset(1, ay, az), 1, 1) = rap(1)*as(coset(0, ay, az), 1, 1)+ & + as(coset(1, ay, az), 1, 1) = rap(1)*as(coset(0, ay, az), 1, 1) + & bc1(1)*s(coset(0, ay, az), 1) - as(coset(1, ay, az), 1, 2) = rap(1)*as(coset(0, ay, az), 1, 2)+ & + as(coset(1, ay, az), 1, 2) = rap(1)*as(coset(0, ay, az), 1, 2) + & bc1(2)*s(coset(0, ay, az), 1) - as(coset(1, ay, az), 1, 3) = rap(1)*as(coset(0, ay, az), 1, 3)+ & + as(coset(1, ay, az), 1, 3) = rap(1)*as(coset(0, ay, az), 1, 3) + & bc1(3)*s(coset(0, ay, az), 1) END DO DO ax = 2, la - f3 = f2*REAL(ax-1, dp) - DO ay = 0, la-ax - az = la-ax-ay - s(coset(ax, ay, az), 1) = rap(1)*s(coset(ax-1, ay, az), 1)+ & - f3*s(coset(ax-2, ay, az), 1) - as(coset(ax, ay, az), 1, 1) = rap(1)*as(coset(ax-1, ay, az), 1, 1)+ & - f3*as(coset(ax-2, ay, az), 1, 1)+ & - bc1(1)*s(coset(ax-1, ay, az), 1) - as(coset(ax, ay, az), 1, 2) = rap(1)*as(coset(ax-1, ay, az), 1, 2)+ & - f3*as(coset(ax-2, ay, az), 1, 2)+ & - bc1(2)*s(coset(ax-1, ay, az), 1) - as(coset(ax, ay, az), 1, 3) = rap(1)*as(coset(ax-1, ay, az), 1, 3)+ & - f3*as(coset(ax-2, ay, az), 1, 3)+ & - bc1(3)*s(coset(ax-1, ay, az), 1) + f3 = f2*REAL(ax - 1, dp) + DO ay = 0, la - ax + az = la - ax - ay + s(coset(ax, ay, az), 1) = rap(1)*s(coset(ax - 1, ay, az), 1) + & + f3*s(coset(ax - 2, ay, az), 1) + as(coset(ax, ay, az), 1, 1) = rap(1)*as(coset(ax - 1, ay, az), 1, 1) + & + f3*as(coset(ax - 2, ay, az), 1, 1) + & + bc1(1)*s(coset(ax - 1, ay, az), 1) + as(coset(ax, ay, az), 1, 2) = rap(1)*as(coset(ax - 1, ay, az), 1, 2) + & + f3*as(coset(ax - 2, ay, az), 1, 2) + & + bc1(2)*s(coset(ax - 1, ay, az), 1) + as(coset(ax, ay, az), 1, 3) = rap(1)*as(coset(ax - 1, ay, az), 1, 3) + & + f3*as(coset(ax - 2, ay, az), 1, 3) + & + bc1(3)*s(coset(ax - 1, ay, az), 1) END DO END DO @@ -273,7 +273,7 @@ SUBROUTINE angmom(la_max, npgfa, zeta, rpgfa, la_min, & ! *** Horizontal recurrence steps *** - rbp(:) = rap(:)-rab(:) + rbp(:) = rap(:) - rab(:) ! *** [a|L|p] = [a+1i|Lm|s] - (Bi - Ai)*[a|Lm|s] *** ! *** + [a+1k|s] + (Ak - Ck)*[a|s] eps(i,m,k) @@ -281,42 +281,42 @@ SUBROUTINE angmom(la_max, npgfa, zeta, rpgfa, la_min, & IF (lb_max == 1) THEN la_start = la_min ELSE - la_start = MAX(0, la_min-1) + la_start = MAX(0, la_min - 1) END IF - DO la = la_start, la_max-1 + DO la = la_start, la_max - 1 DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay - s(coset(ax, ay, az), 2) = s(coset(ax+1, ay, az), 1)- & + DO ay = 0, la - ax + az = la - ax - ay + s(coset(ax, ay, az), 2) = s(coset(ax + 1, ay, az), 1) - & rab(1)*s(coset(ax, ay, az), 1) - s(coset(ax, ay, az), 3) = s(coset(ax, ay+1, az), 1)- & + s(coset(ax, ay, az), 3) = s(coset(ax, ay + 1, az), 1) - & rab(2)*s(coset(ax, ay, az), 1) - s(coset(ax, ay, az), 4) = s(coset(ax, ay, az+1), 1)- & + s(coset(ax, ay, az), 4) = s(coset(ax, ay, az + 1), 1) - & rab(3)*s(coset(ax, ay, az), 1) - as(coset(ax, ay, az), 2, 1) = as(coset(ax+1, ay, az), 1, 1)- & + as(coset(ax, ay, az), 2, 1) = as(coset(ax + 1, ay, az), 1, 1) - & rab(1)*as(coset(ax, ay, az), 1, 1) - as(coset(ax, ay, az), 3, 1) = as(coset(ax, ay+1, az), 1, 1)- & + as(coset(ax, ay, az), 3, 1) = as(coset(ax, ay + 1, az), 1, 1) - & rab(2)*as(coset(ax, ay, az), 1, 1) & - -s(coset(ax, ay, az+1), 1)-rac(3)*s(coset(ax, ay, az), 1) - as(coset(ax, ay, az), 4, 1) = as(coset(ax, ay, az+1), 1, 1)- & + - s(coset(ax, ay, az + 1), 1) - rac(3)*s(coset(ax, ay, az), 1) + as(coset(ax, ay, az), 4, 1) = as(coset(ax, ay, az + 1), 1, 1) - & rab(3)*as(coset(ax, ay, az), 1, 1) & - +s(coset(ax, ay+1, az), 1)+rac(2)*s(coset(ax, ay, az), 1) - as(coset(ax, ay, az), 2, 2) = as(coset(ax+1, ay, az), 1, 2)- & + + s(coset(ax, ay + 1, az), 1) + rac(2)*s(coset(ax, ay, az), 1) + as(coset(ax, ay, az), 2, 2) = as(coset(ax + 1, ay, az), 1, 2) - & rab(1)*as(coset(ax, ay, az), 1, 2) & - +s(coset(ax, ay, az+1), 1)+rac(3)*s(coset(ax, ay, az), 1) - as(coset(ax, ay, az), 3, 2) = as(coset(ax, ay+1, az), 1, 2)- & + + s(coset(ax, ay, az + 1), 1) + rac(3)*s(coset(ax, ay, az), 1) + as(coset(ax, ay, az), 3, 2) = as(coset(ax, ay + 1, az), 1, 2) - & rab(2)*as(coset(ax, ay, az), 1, 2) - as(coset(ax, ay, az), 4, 2) = as(coset(ax, ay, az+1), 1, 2)- & + as(coset(ax, ay, az), 4, 2) = as(coset(ax, ay, az + 1), 1, 2) - & rab(3)*as(coset(ax, ay, az), 1, 2) & - -s(coset(ax+1, ay, az), 1)-rac(1)*s(coset(ax, ay, az), 1) - as(coset(ax, ay, az), 2, 3) = as(coset(ax+1, ay, az), 1, 3)- & + - s(coset(ax + 1, ay, az), 1) - rac(1)*s(coset(ax, ay, az), 1) + as(coset(ax, ay, az), 2, 3) = as(coset(ax + 1, ay, az), 1, 3) - & rab(1)*as(coset(ax, ay, az), 1, 3) & - -s(coset(ax, ay+1, az), 1)-rac(2)*s(coset(ax, ay, az), 1) - as(coset(ax, ay, az), 3, 3) = as(coset(ax, ay+1, az), 1, 3)- & + - s(coset(ax, ay + 1, az), 1) - rac(2)*s(coset(ax, ay, az), 1) + as(coset(ax, ay, az), 3, 3) = as(coset(ax, ay + 1, az), 1, 3) - & rab(2)*as(coset(ax, ay, az), 1, 3) & - +s(coset(ax+1, ay, az), 1)+rac(1)*s(coset(ax, ay, az), 1) - as(coset(ax, ay, az), 4, 3) = as(coset(ax, ay, az+1), 1, 3)- & + + s(coset(ax + 1, ay, az), 1) + rac(1)*s(coset(ax, ay, az), 1) + as(coset(ax, ay, az), 4, 3) = as(coset(ax, ay, az + 1), 1, 3) - & rab(3)*as(coset(ax, ay, az), 1, 3) END DO END DO @@ -331,85 +331,85 @@ SUBROUTINE angmom(la_max, npgfa, zeta, rpgfa, la_min, & DO ax = 0, la_max fx = f2*REAL(ax, dp) - DO ay = 0, la_max-ax + DO ay = 0, la_max - ax fy = f2*REAL(ay, dp) - az = la_max-ax-ay + az = la_max - ax - ay fz = f2*REAL(az, dp) IF (ax == 0) THEN s(coset(ax, ay, az), 2) = rbp(1)*s(coset(ax, ay, az), 1) - as(coset(ax, ay, az), 2, 1) = rbp(1)*as(coset(ax, ay, az), 1, 1)+ & + as(coset(ax, ay, az), 2, 1) = rbp(1)*as(coset(ax, ay, az), 1, 1) + & ac1(1)*s(coset(ax, ay, az), 1) - as(coset(ax, ay, az), 2, 2) = rbp(1)*as(coset(ax, ay, az), 1, 2)+ & + as(coset(ax, ay, az), 2, 2) = rbp(1)*as(coset(ax, ay, az), 1, 2) + & ac1(2)*s(coset(ax, ay, az), 1) - as(coset(ax, ay, az), 2, 3) = rbp(1)*as(coset(ax, ay, az), 1, 3)+ & + as(coset(ax, ay, az), 2, 3) = rbp(1)*as(coset(ax, ay, az), 1, 3) + & ac1(3)*s(coset(ax, ay, az), 1) ELSE - s(coset(ax, ay, az), 2) = rbp(1)*s(coset(ax, ay, az), 1)+ & - fx*s(coset(ax-1, ay, az), 1) - as(coset(ax, ay, az), 2, 1) = rbp(1)*as(coset(ax, ay, az), 1, 1)+ & - fx*as(coset(ax-1, ay, az), 1, 1)+ & + s(coset(ax, ay, az), 2) = rbp(1)*s(coset(ax, ay, az), 1) + & + fx*s(coset(ax - 1, ay, az), 1) + as(coset(ax, ay, az), 2, 1) = rbp(1)*as(coset(ax, ay, az), 1, 1) + & + fx*as(coset(ax - 1, ay, az), 1, 1) + & ac1(1)*s(coset(ax, ay, az), 1) - as(coset(ax, ay, az), 2, 2) = rbp(1)*as(coset(ax, ay, az), 1, 2)+ & - fx*as(coset(ax-1, ay, az), 1, 2)+ & + as(coset(ax, ay, az), 2, 2) = rbp(1)*as(coset(ax, ay, az), 1, 2) + & + fx*as(coset(ax - 1, ay, az), 1, 2) + & ac1(2)*s(coset(ax, ay, az), 1) - as(coset(ax, ay, az), 2, 3) = rbp(1)*as(coset(ax, ay, az), 1, 3)+ & - fx*as(coset(ax-1, ay, az), 1, 3)+ & + as(coset(ax, ay, az), 2, 3) = rbp(1)*as(coset(ax, ay, az), 1, 3) + & + fx*as(coset(ax - 1, ay, az), 1, 3) + & ac1(3)*s(coset(ax, ay, az), 1) END IF - IF (az > 0) as(coset(ax, ay, az), 2, 2) = as(coset(ax, ay, az), 2, 2)+ & - f2*REAL(az, dp)*s(coset(ax, ay, az-1), 1) - IF (ay > 0) as(coset(ax, ay, az), 2, 3) = as(coset(ax, ay, az), 2, 3)- & - f2*REAL(ay, dp)*s(coset(ax, ay-1, az), 1) + IF (az > 0) as(coset(ax, ay, az), 2, 2) = as(coset(ax, ay, az), 2, 2) + & + f2*REAL(az, dp)*s(coset(ax, ay, az - 1), 1) + IF (ay > 0) as(coset(ax, ay, az), 2, 3) = as(coset(ax, ay, az), 2, 3) - & + f2*REAL(ay, dp)*s(coset(ax, ay - 1, az), 1) IF (ay == 0) THEN s(coset(ax, ay, az), 3) = rbp(2)*s(coset(ax, ay, az), 1) - as(coset(ax, ay, az), 3, 1) = rbp(2)*as(coset(ax, ay, az), 1, 1)+ & + as(coset(ax, ay, az), 3, 1) = rbp(2)*as(coset(ax, ay, az), 1, 1) + & ac2(1)*s(coset(ax, ay, az), 1) - as(coset(ax, ay, az), 3, 2) = rbp(2)*as(coset(ax, ay, az), 1, 2)+ & + as(coset(ax, ay, az), 3, 2) = rbp(2)*as(coset(ax, ay, az), 1, 2) + & ac2(2)*s(coset(ax, ay, az), 1) - as(coset(ax, ay, az), 3, 3) = rbp(2)*as(coset(ax, ay, az), 1, 3)+ & + as(coset(ax, ay, az), 3, 3) = rbp(2)*as(coset(ax, ay, az), 1, 3) + & ac2(3)*s(coset(ax, ay, az), 1) ELSE - s(coset(ax, ay, az), 3) = rbp(2)*s(coset(ax, ay, az), 1)+ & - fy*s(coset(ax, ay-1, az), 1) - as(coset(ax, ay, az), 3, 1) = rbp(2)*as(coset(ax, ay, az), 1, 1)+ & - fy*as(coset(ax, ay-1, az), 1, 1)+ & + s(coset(ax, ay, az), 3) = rbp(2)*s(coset(ax, ay, az), 1) + & + fy*s(coset(ax, ay - 1, az), 1) + as(coset(ax, ay, az), 3, 1) = rbp(2)*as(coset(ax, ay, az), 1, 1) + & + fy*as(coset(ax, ay - 1, az), 1, 1) + & ac2(1)*s(coset(ax, ay, az), 1) - as(coset(ax, ay, az), 3, 2) = rbp(2)*as(coset(ax, ay, az), 1, 2)+ & - fy*as(coset(ax, ay-1, az), 1, 2)+ & + as(coset(ax, ay, az), 3, 2) = rbp(2)*as(coset(ax, ay, az), 1, 2) + & + fy*as(coset(ax, ay - 1, az), 1, 2) + & ac2(2)*s(coset(ax, ay, az), 1) - as(coset(ax, ay, az), 3, 3) = rbp(2)*as(coset(ax, ay, az), 1, 3)+ & - fy*as(coset(ax, ay-1, az), 1, 3)+ & + as(coset(ax, ay, az), 3, 3) = rbp(2)*as(coset(ax, ay, az), 1, 3) + & + fy*as(coset(ax, ay - 1, az), 1, 3) + & ac2(3)*s(coset(ax, ay, az), 1) END IF - IF (az > 0) as(coset(ax, ay, az), 3, 1) = as(coset(ax, ay, az), 3, 1)- & - f2*REAL(az, dp)*s(coset(ax, ay, az-1), 1) - IF (ax > 0) as(coset(ax, ay, az), 3, 3) = as(coset(ax, ay, az), 3, 3)+ & - f2*REAL(ax, dp)*s(coset(ax-1, ay, az), 1) + IF (az > 0) as(coset(ax, ay, az), 3, 1) = as(coset(ax, ay, az), 3, 1) - & + f2*REAL(az, dp)*s(coset(ax, ay, az - 1), 1) + IF (ax > 0) as(coset(ax, ay, az), 3, 3) = as(coset(ax, ay, az), 3, 3) + & + f2*REAL(ax, dp)*s(coset(ax - 1, ay, az), 1) IF (az == 0) THEN s(coset(ax, ay, az), 4) = rbp(3)*s(coset(ax, ay, az), 1) - as(coset(ax, ay, az), 4, 1) = rbp(3)*as(coset(ax, ay, az), 1, 1)+ & + as(coset(ax, ay, az), 4, 1) = rbp(3)*as(coset(ax, ay, az), 1, 1) + & ac3(1)*s(coset(ax, ay, az), 1) - as(coset(ax, ay, az), 4, 2) = rbp(3)*as(coset(ax, ay, az), 1, 2)+ & + as(coset(ax, ay, az), 4, 2) = rbp(3)*as(coset(ax, ay, az), 1, 2) + & ac3(2)*s(coset(ax, ay, az), 1) - as(coset(ax, ay, az), 4, 3) = rbp(3)*as(coset(ax, ay, az), 1, 3)+ & + as(coset(ax, ay, az), 4, 3) = rbp(3)*as(coset(ax, ay, az), 1, 3) + & ac3(3)*s(coset(ax, ay, az), 1) ELSE - s(coset(ax, ay, az), 4) = rbp(3)*s(coset(ax, ay, az), 1)+ & - fz*s(coset(ax, ay, az-1), 1) - as(coset(ax, ay, az), 4, 1) = rbp(3)*as(coset(ax, ay, az), 1, 1)+ & - fz*as(coset(ax, ay, az-1), 1, 1)+ & + s(coset(ax, ay, az), 4) = rbp(3)*s(coset(ax, ay, az), 1) + & + fz*s(coset(ax, ay, az - 1), 1) + as(coset(ax, ay, az), 4, 1) = rbp(3)*as(coset(ax, ay, az), 1, 1) + & + fz*as(coset(ax, ay, az - 1), 1, 1) + & ac3(1)*s(coset(ax, ay, az), 1) - as(coset(ax, ay, az), 4, 2) = rbp(3)*as(coset(ax, ay, az), 1, 2)+ & - fz*as(coset(ax, ay, az-1), 1, 2)+ & + as(coset(ax, ay, az), 4, 2) = rbp(3)*as(coset(ax, ay, az), 1, 2) + & + fz*as(coset(ax, ay, az - 1), 1, 2) + & ac3(2)*s(coset(ax, ay, az), 1) - as(coset(ax, ay, az), 4, 3) = rbp(3)*as(coset(ax, ay, az), 1, 3)+ & - fz*as(coset(ax, ay, az-1), 1, 3)+ & + as(coset(ax, ay, az), 4, 3) = rbp(3)*as(coset(ax, ay, az), 1, 3) + & + fz*as(coset(ax, ay, az - 1), 1, 3) + & ac3(3)*s(coset(ax, ay, az), 1) END IF - IF (ay > 0) as(coset(ax, ay, az), 4, 1) = as(coset(ax, ay, az), 4, 1)+ & - f2*REAL(ay, dp)*s(coset(ax, ay-1, az), 1) - IF (ax > 0) as(coset(ax, ay, az), 4, 2) = as(coset(ax, ay, az), 4, 2)- & - f2*REAL(ax, dp)*s(coset(ax-1, ay, az), 1) + IF (ay > 0) as(coset(ax, ay, az), 4, 1) = as(coset(ax, ay, az), 4, 1) + & + f2*REAL(ay, dp)*s(coset(ax, ay - 1, az), 1) + IF (ax > 0) as(coset(ax, ay, az), 4, 2) = as(coset(ax, ay, az), 4, 2) - & + f2*REAL(ax, dp)*s(coset(ax - 1, ay, az), 1) END DO END DO @@ -425,76 +425,76 @@ SUBROUTINE angmom(la_max, npgfa, zeta, rpgfa, la_min, & IF (lb == lb_max) THEN la_start = la_min ELSE - la_start = MAX(0, la_min-1) + la_start = MAX(0, la_min - 1) END IF - DO la = la_start, la_max-1 + DO la = la_start, la_max - 1 DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay ! *** Shift of angular momentum component z from a to b *** s(coset(ax, ay, az), coset(0, 0, lb)) = & - s(coset(ax, ay, az+1), coset(0, 0, lb-1))- & - rab(3)*s(coset(ax, ay, az), coset(0, 0, lb-1)) + s(coset(ax, ay, az + 1), coset(0, 0, lb - 1)) - & + rab(3)*s(coset(ax, ay, az), coset(0, 0, lb - 1)) as(coset(ax, ay, az), coset(0, 0, lb), 1) = & - as(coset(ax, ay, az+1), coset(0, 0, lb-1), 1)- & - rab(3)*as(coset(ax, ay, az), coset(0, 0, lb-1), 1) & - +s(coset(ax, ay+1, az), coset(0, 0, lb-1)) & - +rac(2)*s(coset(ax, ay, az), coset(0, 0, lb-1)) + as(coset(ax, ay, az + 1), coset(0, 0, lb - 1), 1) - & + rab(3)*as(coset(ax, ay, az), coset(0, 0, lb - 1), 1) & + + s(coset(ax, ay + 1, az), coset(0, 0, lb - 1)) & + + rac(2)*s(coset(ax, ay, az), coset(0, 0, lb - 1)) as(coset(ax, ay, az), coset(0, 0, lb), 2) = & - as(coset(ax, ay, az+1), coset(0, 0, lb-1), 2)- & - rab(3)*as(coset(ax, ay, az), coset(0, 0, lb-1), 2) & - -s(coset(ax+1, ay, az), coset(0, 0, lb-1)) & - -rac(1)*s(coset(ax, ay, az), coset(0, 0, lb-1)) + as(coset(ax, ay, az + 1), coset(0, 0, lb - 1), 2) - & + rab(3)*as(coset(ax, ay, az), coset(0, 0, lb - 1), 2) & + - s(coset(ax + 1, ay, az), coset(0, 0, lb - 1)) & + - rac(1)*s(coset(ax, ay, az), coset(0, 0, lb - 1)) as(coset(ax, ay, az), coset(0, 0, lb), 3) = & - as(coset(ax, ay, az+1), coset(0, 0, lb-1), 3)- & - rab(3)*as(coset(ax, ay, az), coset(0, 0, lb-1), 3) + as(coset(ax, ay, az + 1), coset(0, 0, lb - 1), 3) - & + rab(3)*as(coset(ax, ay, az), coset(0, 0, lb - 1), 3) ! *** Shift of angular momentum component y from a to b *** DO by = 1, lb - bz = lb-by + bz = lb - by s(coset(ax, ay, az), coset(0, by, bz)) = & - s(coset(ax, ay+1, az), coset(0, by-1, bz))- & - rab(2)*s(coset(ax, ay, az), coset(0, by-1, bz)) + s(coset(ax, ay + 1, az), coset(0, by - 1, bz)) - & + rab(2)*s(coset(ax, ay, az), coset(0, by - 1, bz)) as(coset(ax, ay, az), coset(0, by, bz), 1) = & - as(coset(ax, ay+1, az), coset(0, by-1, bz), 1)- & - rab(2)*as(coset(ax, ay, az), coset(0, by-1, bz), 1) & - -s(coset(ax, ay, az+1), coset(0, by-1, bz)) & - -rac(3)*s(coset(ax, ay, az), coset(0, by-1, bz)) + as(coset(ax, ay + 1, az), coset(0, by - 1, bz), 1) - & + rab(2)*as(coset(ax, ay, az), coset(0, by - 1, bz), 1) & + - s(coset(ax, ay, az + 1), coset(0, by - 1, bz)) & + - rac(3)*s(coset(ax, ay, az), coset(0, by - 1, bz)) as(coset(ax, ay, az), coset(0, by, bz), 2) = & - as(coset(ax, ay+1, az), coset(0, by-1, bz), 2)- & - rab(2)*as(coset(ax, ay, az), coset(0, by-1, bz), 2) + as(coset(ax, ay + 1, az), coset(0, by - 1, bz), 2) - & + rab(2)*as(coset(ax, ay, az), coset(0, by - 1, bz), 2) as(coset(ax, ay, az), coset(0, by, bz), 3) = & - as(coset(ax, ay+1, az), coset(0, by-1, bz), 3)- & - rab(2)*as(coset(ax, ay, az), coset(0, by-1, bz), 3) & - +s(coset(ax+1, ay, az), coset(0, by-1, bz)) & - +rac(1)*s(coset(ax, ay, az), coset(0, by-1, bz)) + as(coset(ax, ay + 1, az), coset(0, by - 1, bz), 3) - & + rab(2)*as(coset(ax, ay, az), coset(0, by - 1, bz), 3) & + + s(coset(ax + 1, ay, az), coset(0, by - 1, bz)) & + + rac(1)*s(coset(ax, ay, az), coset(0, by - 1, bz)) END DO ! *** Shift of angular momentum component x from a to b *** DO bx = 1, lb - DO by = 0, lb-bx - bz = lb-bx-by + DO by = 0, lb - bx + bz = lb - bx - by s(coset(ax, ay, az), coset(bx, by, bz)) = & - s(coset(ax+1, ay, az), coset(bx-1, by, bz))- & - rab(1)*s(coset(ax, ay, az), coset(bx-1, by, bz)) + s(coset(ax + 1, ay, az), coset(bx - 1, by, bz)) - & + rab(1)*s(coset(ax, ay, az), coset(bx - 1, by, bz)) as(coset(ax, ay, az), coset(bx, by, bz), 1) = & - as(coset(ax+1, ay, az), coset(bx-1, by, bz), 1)- & - rab(1)*as(coset(ax, ay, az), coset(bx-1, by, bz), 1) + as(coset(ax + 1, ay, az), coset(bx - 1, by, bz), 1) - & + rab(1)*as(coset(ax, ay, az), coset(bx - 1, by, bz), 1) as(coset(ax, ay, az), coset(bx, by, bz), 2) = & - as(coset(ax+1, ay, az), coset(bx-1, by, bz), 2)- & - rab(1)*as(coset(ax, ay, az), coset(bx-1, by, bz), 2) & - +s(coset(ax, ay, az+1), coset(bx-1, by, bz)) & - +rac(3)*s(coset(ax, ay, az), coset(bx-1, by, bz)) + as(coset(ax + 1, ay, az), coset(bx - 1, by, bz), 2) - & + rab(1)*as(coset(ax, ay, az), coset(bx - 1, by, bz), 2) & + + s(coset(ax, ay, az + 1), coset(bx - 1, by, bz)) & + + rac(3)*s(coset(ax, ay, az), coset(bx - 1, by, bz)) as(coset(ax, ay, az), coset(bx, by, bz), 3) = & - as(coset(ax+1, ay, az), coset(bx-1, by, bz), 3)- & - rab(1)*as(coset(ax, ay, az), coset(bx-1, by, bz), 3) & - -s(coset(ax, ay+1, az), coset(bx-1, by, bz)) & - -rac(2)*s(coset(ax, ay, az), coset(bx-1, by, bz)) + as(coset(ax + 1, ay, az), coset(bx - 1, by, bz), 3) - & + rab(1)*as(coset(ax, ay, az), coset(bx - 1, by, bz), 3) & + - s(coset(ax, ay + 1, az), coset(bx - 1, by, bz)) & + - rac(2)*s(coset(ax, ay, az), coset(bx - 1, by, bz)) END DO END DO @@ -513,263 +513,263 @@ SUBROUTINE angmom(la_max, npgfa, zeta, rpgfa, la_min, & DO ax = 0, la_max fx = f2*REAL(ax, dp) - DO ay = 0, la_max-ax + DO ay = 0, la_max - ax fy = f2*REAL(ay, dp) - az = la_max-ax-ay + az = la_max - ax - ay fz = f2*REAL(az, dp) ! *** Increase the angular momentum component z of function b *** - f3 = f2*REAL(lb-1, dp) + f3 = f2*REAL(lb - 1, dp) IF (az == 0) THEN s(coset(ax, ay, az), coset(0, 0, lb)) = & - rbp(3)*s(coset(ax, ay, az), coset(0, 0, lb-1))+ & - f3*s(coset(ax, ay, az), coset(0, 0, lb-2)) + rbp(3)*s(coset(ax, ay, az), coset(0, 0, lb - 1)) + & + f3*s(coset(ax, ay, az), coset(0, 0, lb - 2)) as(coset(ax, ay, az), coset(0, 0, lb), 1) = & - rbp(3)*as(coset(ax, ay, az), coset(0, 0, lb-1), 1)+ & - f3*as(coset(ax, ay, az), coset(0, 0, lb-2), 1)+ & - ac3(1)*s(coset(ax, ay, az), coset(0, 0, lb-1)) + rbp(3)*as(coset(ax, ay, az), coset(0, 0, lb - 1), 1) + & + f3*as(coset(ax, ay, az), coset(0, 0, lb - 2), 1) + & + ac3(1)*s(coset(ax, ay, az), coset(0, 0, lb - 1)) as(coset(ax, ay, az), coset(0, 0, lb), 2) = & - rbp(3)*as(coset(ax, ay, az), coset(0, 0, lb-1), 2)+ & - f3*as(coset(ax, ay, az), coset(0, 0, lb-2), 2)+ & - ac3(2)*s(coset(ax, ay, az), coset(0, 0, lb-1)) + rbp(3)*as(coset(ax, ay, az), coset(0, 0, lb - 1), 2) + & + f3*as(coset(ax, ay, az), coset(0, 0, lb - 2), 2) + & + ac3(2)*s(coset(ax, ay, az), coset(0, 0, lb - 1)) as(coset(ax, ay, az), coset(0, 0, lb), 3) = & - rbp(3)*as(coset(ax, ay, az), coset(0, 0, lb-1), 3)+ & - f3*as(coset(ax, ay, az), coset(0, 0, lb-2), 3)+ & - ac3(3)*s(coset(ax, ay, az), coset(0, 0, lb-1)) + rbp(3)*as(coset(ax, ay, az), coset(0, 0, lb - 1), 3) + & + f3*as(coset(ax, ay, az), coset(0, 0, lb - 2), 3) + & + ac3(3)*s(coset(ax, ay, az), coset(0, 0, lb - 1)) ELSE s(coset(ax, ay, az), coset(0, 0, lb)) = & - rbp(3)*s(coset(ax, ay, az), coset(0, 0, lb-1))+ & - fz*s(coset(ax, ay, az-1), coset(0, 0, lb-1))+ & - f3*s(coset(ax, ay, az), coset(0, 0, lb-2)) + rbp(3)*s(coset(ax, ay, az), coset(0, 0, lb - 1)) + & + fz*s(coset(ax, ay, az - 1), coset(0, 0, lb - 1)) + & + f3*s(coset(ax, ay, az), coset(0, 0, lb - 2)) as(coset(ax, ay, az), coset(0, 0, lb), 1) = & - rbp(3)*as(coset(ax, ay, az), coset(0, 0, lb-1), 1)+ & - fz*as(coset(ax, ay, az-1), coset(0, 0, lb-1), 1)+ & - f3*as(coset(ax, ay, az), coset(0, 0, lb-2), 1)+ & - ac3(1)*s(coset(ax, ay, az), coset(0, 0, lb-1)) + rbp(3)*as(coset(ax, ay, az), coset(0, 0, lb - 1), 1) + & + fz*as(coset(ax, ay, az - 1), coset(0, 0, lb - 1), 1) + & + f3*as(coset(ax, ay, az), coset(0, 0, lb - 2), 1) + & + ac3(1)*s(coset(ax, ay, az), coset(0, 0, lb - 1)) as(coset(ax, ay, az), coset(0, 0, lb), 2) = & - rbp(3)*as(coset(ax, ay, az), coset(0, 0, lb-1), 2)+ & - fz*as(coset(ax, ay, az-1), coset(0, 0, lb-1), 2)+ & - f3*as(coset(ax, ay, az), coset(0, 0, lb-2), 2)+ & - ac3(2)*s(coset(ax, ay, az), coset(0, 0, lb-1)) + rbp(3)*as(coset(ax, ay, az), coset(0, 0, lb - 1), 2) + & + fz*as(coset(ax, ay, az - 1), coset(0, 0, lb - 1), 2) + & + f3*as(coset(ax, ay, az), coset(0, 0, lb - 2), 2) + & + ac3(2)*s(coset(ax, ay, az), coset(0, 0, lb - 1)) as(coset(ax, ay, az), coset(0, 0, lb), 3) = & - rbp(3)*as(coset(ax, ay, az), coset(0, 0, lb-1), 3)+ & - fz*as(coset(ax, ay, az-1), coset(0, 0, lb-1), 3)+ & - f3*as(coset(ax, ay, az), coset(0, 0, lb-2), 3)+ & - ac3(3)*s(coset(ax, ay, az), coset(0, 0, lb-1)) + rbp(3)*as(coset(ax, ay, az), coset(0, 0, lb - 1), 3) + & + fz*as(coset(ax, ay, az - 1), coset(0, 0, lb - 1), 3) + & + f3*as(coset(ax, ay, az), coset(0, 0, lb - 2), 3) + & + ac3(3)*s(coset(ax, ay, az), coset(0, 0, lb - 1)) END IF IF (ay > 0) as(coset(ax, ay, az), coset(0, 0, lb), 1) = & - as(coset(ax, ay, az), coset(0, 0, lb), 1)+ & - f2*REAL(ay, dp)*s(coset(ax, ay-1, az), coset(0, 0, lb-1)) + as(coset(ax, ay, az), coset(0, 0, lb), 1) + & + f2*REAL(ay, dp)*s(coset(ax, ay - 1, az), coset(0, 0, lb - 1)) IF (ax > 0) as(coset(ax, ay, az), coset(0, 0, lb), 2) = & - as(coset(ax, ay, az), coset(0, 0, lb), 2)- & - f2*REAL(ax, dp)*s(coset(ax-1, ay, az), coset(0, 0, lb-1)) + as(coset(ax, ay, az), coset(0, 0, lb), 2) - & + f2*REAL(ax, dp)*s(coset(ax - 1, ay, az), coset(0, 0, lb - 1)) ! *** Increase the angular momentum component y of function b *** IF (ay == 0) THEN - bz = lb-1 + bz = lb - 1 s(coset(ax, ay, az), coset(0, 1, bz)) = & rbp(2)*s(coset(ax, ay, az), coset(0, 0, bz)) as(coset(ax, ay, az), coset(0, 1, bz), 1) = & - rbp(2)*as(coset(ax, ay, az), coset(0, 0, bz), 1)+ & + rbp(2)*as(coset(ax, ay, az), coset(0, 0, bz), 1) + & ac2(1)*s(coset(ax, ay, az), coset(0, 0, bz)) as(coset(ax, ay, az), coset(0, 1, bz), 2) = & - rbp(2)*as(coset(ax, ay, az), coset(0, 0, bz), 2)+ & + rbp(2)*as(coset(ax, ay, az), coset(0, 0, bz), 2) + & ac2(2)*s(coset(ax, ay, az), coset(0, 0, bz)) as(coset(ax, ay, az), coset(0, 1, bz), 3) = & - rbp(2)*as(coset(ax, ay, az), coset(0, 0, bz), 3)+ & + rbp(2)*as(coset(ax, ay, az), coset(0, 0, bz), 3) + & ac2(3)*s(coset(ax, ay, az), coset(0, 0, bz)) IF (az > 0) as(coset(ax, ay, az), coset(0, 1, bz), 1) = & - as(coset(ax, ay, az), coset(0, 1, bz), 1)- & - f2*REAL(az, dp)*s(coset(ax, ay, az-1), coset(0, 0, bz)) + as(coset(ax, ay, az), coset(0, 1, bz), 1) - & + f2*REAL(az, dp)*s(coset(ax, ay, az - 1), coset(0, 0, bz)) IF (ax > 0) as(coset(ax, ay, az), coset(0, 1, bz), 3) = & - as(coset(ax, ay, az), coset(0, 1, bz), 3)+ & - f2*REAL(ax, dp)*s(coset(ax-1, ay, az), coset(0, 0, bz)) + as(coset(ax, ay, az), coset(0, 1, bz), 3) + & + f2*REAL(ax, dp)*s(coset(ax - 1, ay, az), coset(0, 0, bz)) DO by = 2, lb - bz = lb-by - f3 = f2*REAL(by-1, dp) + bz = lb - by + f3 = f2*REAL(by - 1, dp) s(coset(ax, ay, az), coset(0, by, bz)) = & - rbp(2)*s(coset(ax, ay, az), coset(0, by-1, bz))+ & - f3*s(coset(ax, ay, az), coset(0, by-2, bz)) + rbp(2)*s(coset(ax, ay, az), coset(0, by - 1, bz)) + & + f3*s(coset(ax, ay, az), coset(0, by - 2, bz)) as(coset(ax, ay, az), coset(0, by, bz), 1) = & - rbp(2)*as(coset(ax, ay, az), coset(0, by-1, bz), 1)+ & - f3*as(coset(ax, ay, az), coset(0, by-2, bz), 1)+ & - ac2(1)*s(coset(ax, ay, az), coset(0, by-1, bz)) + rbp(2)*as(coset(ax, ay, az), coset(0, by - 1, bz), 1) + & + f3*as(coset(ax, ay, az), coset(0, by - 2, bz), 1) + & + ac2(1)*s(coset(ax, ay, az), coset(0, by - 1, bz)) as(coset(ax, ay, az), coset(0, by, bz), 2) = & - rbp(2)*as(coset(ax, ay, az), coset(0, by-1, bz), 2)+ & - f3*as(coset(ax, ay, az), coset(0, by-2, bz), 2)+ & - ac2(2)*s(coset(ax, ay, az), coset(0, by-1, bz)) + rbp(2)*as(coset(ax, ay, az), coset(0, by - 1, bz), 2) + & + f3*as(coset(ax, ay, az), coset(0, by - 2, bz), 2) + & + ac2(2)*s(coset(ax, ay, az), coset(0, by - 1, bz)) as(coset(ax, ay, az), coset(0, by, bz), 3) = & - rbp(2)*as(coset(ax, ay, az), coset(0, by-1, bz), 3)+ & - f3*as(coset(ax, ay, az), coset(0, by-2, bz), 3)+ & - ac2(3)*s(coset(ax, ay, az), coset(0, by-1, bz)) + rbp(2)*as(coset(ax, ay, az), coset(0, by - 1, bz), 3) + & + f3*as(coset(ax, ay, az), coset(0, by - 2, bz), 3) + & + ac2(3)*s(coset(ax, ay, az), coset(0, by - 1, bz)) IF (az > 0) as(coset(ax, ay, az), coset(0, by, bz), 1) = & - as(coset(ax, ay, az), coset(0, by, bz), 1)- & - f2*REAL(az, dp)*s(coset(ax, ay, az-1), coset(0, by-1, bz)) + as(coset(ax, ay, az), coset(0, by, bz), 1) - & + f2*REAL(az, dp)*s(coset(ax, ay, az - 1), coset(0, by - 1, bz)) IF (ax > 0) as(coset(ax, ay, az), coset(0, by, bz), 3) = & - as(coset(ax, ay, az), coset(0, by, bz), 3)+ & - f2*REAL(ax, dp)*s(coset(ax-1, ay, az), coset(0, by-1, bz)) + as(coset(ax, ay, az), coset(0, by, bz), 3) + & + f2*REAL(ax, dp)*s(coset(ax - 1, ay, az), coset(0, by - 1, bz)) END DO ELSE - bz = lb-1 + bz = lb - 1 s(coset(ax, ay, az), coset(0, 1, bz)) = & - rbp(2)*s(coset(ax, ay, az), coset(0, 0, bz))+ & - fy*s(coset(ax, ay-1, az), coset(0, 0, bz)) + rbp(2)*s(coset(ax, ay, az), coset(0, 0, bz)) + & + fy*s(coset(ax, ay - 1, az), coset(0, 0, bz)) as(coset(ax, ay, az), coset(0, 1, bz), 1) = & - rbp(2)*as(coset(ax, ay, az), coset(0, 0, bz), 1)+ & - fy*as(coset(ax, ay-1, az), coset(0, 0, bz), 1)+ & + rbp(2)*as(coset(ax, ay, az), coset(0, 0, bz), 1) + & + fy*as(coset(ax, ay - 1, az), coset(0, 0, bz), 1) + & ac2(1)*s(coset(ax, ay, az), coset(0, 0, bz)) as(coset(ax, ay, az), coset(0, 1, bz), 2) = & - rbp(2)*as(coset(ax, ay, az), coset(0, 0, bz), 2)+ & - fy*as(coset(ax, ay-1, az), coset(0, 0, bz), 2)+ & + rbp(2)*as(coset(ax, ay, az), coset(0, 0, bz), 2) + & + fy*as(coset(ax, ay - 1, az), coset(0, 0, bz), 2) + & ac2(2)*s(coset(ax, ay, az), coset(0, 0, bz)) as(coset(ax, ay, az), coset(0, 1, bz), 3) = & - rbp(2)*as(coset(ax, ay, az), coset(0, 0, bz), 3)+ & - fy*as(coset(ax, ay-1, az), coset(0, 0, bz), 3)+ & + rbp(2)*as(coset(ax, ay, az), coset(0, 0, bz), 3) + & + fy*as(coset(ax, ay - 1, az), coset(0, 0, bz), 3) + & ac2(3)*s(coset(ax, ay, az), coset(0, 0, bz)) IF (az > 0) as(coset(ax, ay, az), coset(0, 1, bz), 1) = & - as(coset(ax, ay, az), coset(0, 1, bz), 1)- & - f2*REAL(az, dp)*s(coset(ax, ay, az-1), coset(0, 0, bz)) + as(coset(ax, ay, az), coset(0, 1, bz), 1) - & + f2*REAL(az, dp)*s(coset(ax, ay, az - 1), coset(0, 0, bz)) IF (ax > 0) as(coset(ax, ay, az), coset(0, 1, bz), 3) = & - as(coset(ax, ay, az), coset(0, 1, bz), 3)+ & - f2*REAL(ax, dp)*s(coset(ax-1, ay, az), coset(0, 0, bz)) + as(coset(ax, ay, az), coset(0, 1, bz), 3) + & + f2*REAL(ax, dp)*s(coset(ax - 1, ay, az), coset(0, 0, bz)) DO by = 2, lb - bz = lb-by - f3 = f2*REAL(by-1, dp) + bz = lb - by + f3 = f2*REAL(by - 1, dp) s(coset(ax, ay, az), coset(0, by, bz)) = & - rbp(2)*s(coset(ax, ay, az), coset(0, by-1, bz))+ & - fy*s(coset(ax, ay-1, az), coset(0, by-1, bz))+ & - f3*s(coset(ax, ay, az), coset(0, by-2, bz)) + rbp(2)*s(coset(ax, ay, az), coset(0, by - 1, bz)) + & + fy*s(coset(ax, ay - 1, az), coset(0, by - 1, bz)) + & + f3*s(coset(ax, ay, az), coset(0, by - 2, bz)) as(coset(ax, ay, az), coset(0, by, bz), 1) = & - rbp(2)*as(coset(ax, ay, az), coset(0, by-1, bz), 1)+ & - fy*as(coset(ax, ay-1, az), coset(0, by-1, bz), 1)+ & - f3*as(coset(ax, ay, az), coset(0, by-2, bz), 1)+ & - ac2(1)*s(coset(ax, ay, az), coset(0, by-1, bz)) + rbp(2)*as(coset(ax, ay, az), coset(0, by - 1, bz), 1) + & + fy*as(coset(ax, ay - 1, az), coset(0, by - 1, bz), 1) + & + f3*as(coset(ax, ay, az), coset(0, by - 2, bz), 1) + & + ac2(1)*s(coset(ax, ay, az), coset(0, by - 1, bz)) as(coset(ax, ay, az), coset(0, by, bz), 2) = & - rbp(2)*as(coset(ax, ay, az), coset(0, by-1, bz), 2)+ & - fy*as(coset(ax, ay-1, az), coset(0, by-1, bz), 2)+ & - f3*as(coset(ax, ay, az), coset(0, by-2, bz), 2)+ & - ac2(2)*s(coset(ax, ay, az), coset(0, by-1, bz)) + rbp(2)*as(coset(ax, ay, az), coset(0, by - 1, bz), 2) + & + fy*as(coset(ax, ay - 1, az), coset(0, by - 1, bz), 2) + & + f3*as(coset(ax, ay, az), coset(0, by - 2, bz), 2) + & + ac2(2)*s(coset(ax, ay, az), coset(0, by - 1, bz)) as(coset(ax, ay, az), coset(0, by, bz), 3) = & - rbp(2)*as(coset(ax, ay, az), coset(0, by-1, bz), 3)+ & - fy*as(coset(ax, ay-1, az), coset(0, by-1, bz), 3)+ & - f3*as(coset(ax, ay, az), coset(0, by-2, bz), 3)+ & - ac2(3)*s(coset(ax, ay, az), coset(0, by-1, bz)) + rbp(2)*as(coset(ax, ay, az), coset(0, by - 1, bz), 3) + & + fy*as(coset(ax, ay - 1, az), coset(0, by - 1, bz), 3) + & + f3*as(coset(ax, ay, az), coset(0, by - 2, bz), 3) + & + ac2(3)*s(coset(ax, ay, az), coset(0, by - 1, bz)) IF (az > 0) as(coset(ax, ay, az), coset(0, by, bz), 1) = & - as(coset(ax, ay, az), coset(0, by, bz), 1)- & - f2*REAL(az, dp)*s(coset(ax, ay, az-1), coset(0, by-1, bz)) + as(coset(ax, ay, az), coset(0, by, bz), 1) - & + f2*REAL(az, dp)*s(coset(ax, ay, az - 1), coset(0, by - 1, bz)) IF (ax > 0) as(coset(ax, ay, az), coset(0, by, bz), 3) = & - as(coset(ax, ay, az), coset(0, by, bz), 3)+ & - f2*REAL(ax, dp)*s(coset(ax-1, ay, az), coset(0, by-1, bz)) + as(coset(ax, ay, az), coset(0, by, bz), 3) + & + f2*REAL(ax, dp)*s(coset(ax - 1, ay, az), coset(0, by - 1, bz)) END DO END IF ! *** Increase the angular momentum component x of function b *** IF (ax == 0) THEN - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by s(coset(ax, ay, az), coset(1, by, bz)) = & rbp(1)*s(coset(ax, ay, az), coset(0, by, bz)) as(coset(ax, ay, az), coset(1, by, bz), 1) = & - rbp(1)*as(coset(ax, ay, az), coset(0, by, bz), 1)+ & + rbp(1)*as(coset(ax, ay, az), coset(0, by, bz), 1) + & ac1(1)*s(coset(ax, ay, az), coset(0, by, bz)) as(coset(ax, ay, az), coset(1, by, bz), 2) = & - rbp(1)*as(coset(ax, ay, az), coset(0, by, bz), 2)+ & + rbp(1)*as(coset(ax, ay, az), coset(0, by, bz), 2) + & ac1(2)*s(coset(ax, ay, az), coset(0, by, bz)) as(coset(ax, ay, az), coset(1, by, bz), 3) = & - rbp(1)*as(coset(ax, ay, az), coset(0, by, bz), 3)+ & + rbp(1)*as(coset(ax, ay, az), coset(0, by, bz), 3) + & ac1(3)*s(coset(ax, ay, az), coset(0, by, bz)) IF (az > 0) as(coset(ax, ay, az), coset(1, by, bz), 2) = & - as(coset(ax, ay, az), coset(1, by, bz), 2)+ & - f2*REAL(az, dp)*s(coset(ax, ay, az-1), coset(0, by, bz)) + as(coset(ax, ay, az), coset(1, by, bz), 2) + & + f2*REAL(az, dp)*s(coset(ax, ay, az - 1), coset(0, by, bz)) IF (ay > 0) as(coset(ax, ay, az), coset(1, by, bz), 3) = & - as(coset(ax, ay, az), coset(1, by, bz), 3)- & - f2*REAL(ay, dp)*s(coset(ax, ay-1, az), coset(0, by, bz)) + as(coset(ax, ay, az), coset(1, by, bz), 3) - & + f2*REAL(ay, dp)*s(coset(ax, ay - 1, az), coset(0, by, bz)) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by s(coset(ax, ay, az), coset(bx, by, bz)) = & - rbp(1)*s(coset(ax, ay, az), coset(bx-1, by, bz))+ & - f3*s(coset(ax, ay, az), coset(bx-2, by, bz)) + rbp(1)*s(coset(ax, ay, az), coset(bx - 1, by, bz)) + & + f3*s(coset(ax, ay, az), coset(bx - 2, by, bz)) as(coset(ax, ay, az), coset(bx, by, bz), 1) = & - rbp(1)*as(coset(ax, ay, az), coset(bx-1, by, bz), 1)+ & - f3*as(coset(ax, ay, az), coset(bx-2, by, bz), 1)+ & - ac1(1)*s(coset(ax, ay, az), coset(bx-1, by, bz)) + rbp(1)*as(coset(ax, ay, az), coset(bx - 1, by, bz), 1) + & + f3*as(coset(ax, ay, az), coset(bx - 2, by, bz), 1) + & + ac1(1)*s(coset(ax, ay, az), coset(bx - 1, by, bz)) as(coset(ax, ay, az), coset(bx, by, bz), 2) = & - rbp(1)*as(coset(ax, ay, az), coset(bx-1, by, bz), 2)+ & - f3*as(coset(ax, ay, az), coset(bx-2, by, bz), 2)+ & - ac1(2)*s(coset(ax, ay, az), coset(bx-1, by, bz)) + rbp(1)*as(coset(ax, ay, az), coset(bx - 1, by, bz), 2) + & + f3*as(coset(ax, ay, az), coset(bx - 2, by, bz), 2) + & + ac1(2)*s(coset(ax, ay, az), coset(bx - 1, by, bz)) as(coset(ax, ay, az), coset(bx, by, bz), 3) = & - rbp(1)*as(coset(ax, ay, az), coset(bx-1, by, bz), 3)+ & - f3*as(coset(ax, ay, az), coset(bx-2, by, bz), 3)+ & - ac1(3)*s(coset(ax, ay, az), coset(bx-1, by, bz)) + rbp(1)*as(coset(ax, ay, az), coset(bx - 1, by, bz), 3) + & + f3*as(coset(ax, ay, az), coset(bx - 2, by, bz), 3) + & + ac1(3)*s(coset(ax, ay, az), coset(bx - 1, by, bz)) IF (az > 0) as(coset(ax, ay, az), coset(bx, by, bz), 2) = & - as(coset(ax, ay, az), coset(bx, by, bz), 2)+ & - f2*REAL(az, dp)*s(coset(ax, ay, az-1), coset(bx-1, by, bz)) + as(coset(ax, ay, az), coset(bx, by, bz), 2) + & + f2*REAL(az, dp)*s(coset(ax, ay, az - 1), coset(bx - 1, by, bz)) IF (ay > 0) as(coset(ax, ay, az), coset(bx, by, bz), 3) = & - as(coset(ax, ay, az), coset(bx, by, bz), 3)- & - f2*REAL(ay, dp)*s(coset(ax, ay-1, az), coset(bx-1, by, bz)) + as(coset(ax, ay, az), coset(bx, by, bz), 3) - & + f2*REAL(ay, dp)*s(coset(ax, ay - 1, az), coset(bx - 1, by, bz)) END DO END DO ELSE - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by s(coset(ax, ay, az), coset(1, by, bz)) = & - rbp(1)*s(coset(ax, ay, az), coset(0, by, bz))+ & - fx*s(coset(ax-1, ay, az), coset(0, by, bz)) + rbp(1)*s(coset(ax, ay, az), coset(0, by, bz)) + & + fx*s(coset(ax - 1, ay, az), coset(0, by, bz)) as(coset(ax, ay, az), coset(1, by, bz), 1) = & - rbp(1)*as(coset(ax, ay, az), coset(0, by, bz), 1)+ & - fx*as(coset(ax-1, ay, az), coset(0, by, bz), 1)+ & + rbp(1)*as(coset(ax, ay, az), coset(0, by, bz), 1) + & + fx*as(coset(ax - 1, ay, az), coset(0, by, bz), 1) + & ac1(1)*s(coset(ax, ay, az), coset(0, by, bz)) as(coset(ax, ay, az), coset(1, by, bz), 2) = & - rbp(1)*as(coset(ax, ay, az), coset(0, by, bz), 2)+ & - fx*as(coset(ax-1, ay, az), coset(0, by, bz), 2)+ & + rbp(1)*as(coset(ax, ay, az), coset(0, by, bz), 2) + & + fx*as(coset(ax - 1, ay, az), coset(0, by, bz), 2) + & ac1(2)*s(coset(ax, ay, az), coset(0, by, bz)) as(coset(ax, ay, az), coset(1, by, bz), 3) = & - rbp(1)*as(coset(ax, ay, az), coset(0, by, bz), 3)+ & - fx*as(coset(ax-1, ay, az), coset(0, by, bz), 3)+ & + rbp(1)*as(coset(ax, ay, az), coset(0, by, bz), 3) + & + fx*as(coset(ax - 1, ay, az), coset(0, by, bz), 3) + & ac1(3)*s(coset(ax, ay, az), coset(0, by, bz)) IF (az > 0) as(coset(ax, ay, az), coset(1, by, bz), 2) = & - as(coset(ax, ay, az), coset(1, by, bz), 2)+ & - f2*REAL(az, dp)*s(coset(ax, ay, az-1), coset(0, by, bz)) + as(coset(ax, ay, az), coset(1, by, bz), 2) + & + f2*REAL(az, dp)*s(coset(ax, ay, az - 1), coset(0, by, bz)) IF (ay > 0) as(coset(ax, ay, az), coset(1, by, bz), 3) = & - as(coset(ax, ay, az), coset(1, by, bz), 3)- & - f2*REAL(ay, dp)*s(coset(ax, ay-1, az), coset(0, by, bz)) + as(coset(ax, ay, az), coset(1, by, bz), 3) - & + f2*REAL(ay, dp)*s(coset(ax, ay - 1, az), coset(0, by, bz)) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by s(coset(ax, ay, az), coset(bx, by, bz)) = & - rbp(1)*s(coset(ax, ay, az), coset(bx-1, by, bz))+ & - fx*s(coset(ax-1, ay, az), coset(bx-1, by, bz))+ & - f3*s(coset(ax, ay, az), coset(bx-2, by, bz)) + rbp(1)*s(coset(ax, ay, az), coset(bx - 1, by, bz)) + & + fx*s(coset(ax - 1, ay, az), coset(bx - 1, by, bz)) + & + f3*s(coset(ax, ay, az), coset(bx - 2, by, bz)) as(coset(ax, ay, az), coset(bx, by, bz), 1) = & - rbp(1)*as(coset(ax, ay, az), coset(bx-1, by, bz), 1)+ & - fx*as(coset(ax-1, ay, az), coset(bx-1, by, bz), 1)+ & - f3*as(coset(ax, ay, az), coset(bx-2, by, bz), 1)+ & - ac1(1)*s(coset(ax, ay, az), coset(bx-1, by, bz)) + rbp(1)*as(coset(ax, ay, az), coset(bx - 1, by, bz), 1) + & + fx*as(coset(ax - 1, ay, az), coset(bx - 1, by, bz), 1) + & + f3*as(coset(ax, ay, az), coset(bx - 2, by, bz), 1) + & + ac1(1)*s(coset(ax, ay, az), coset(bx - 1, by, bz)) as(coset(ax, ay, az), coset(bx, by, bz), 2) = & - rbp(1)*as(coset(ax, ay, az), coset(bx-1, by, bz), 2)+ & - fx*as(coset(ax-1, ay, az), coset(bx-1, by, bz), 2)+ & - f3*as(coset(ax, ay, az), coset(bx-2, by, bz), 2)+ & - ac1(2)*s(coset(ax, ay, az), coset(bx-1, by, bz)) + rbp(1)*as(coset(ax, ay, az), coset(bx - 1, by, bz), 2) + & + fx*as(coset(ax - 1, ay, az), coset(bx - 1, by, bz), 2) + & + f3*as(coset(ax, ay, az), coset(bx - 2, by, bz), 2) + & + ac1(2)*s(coset(ax, ay, az), coset(bx - 1, by, bz)) as(coset(ax, ay, az), coset(bx, by, bz), 3) = & - rbp(1)*as(coset(ax, ay, az), coset(bx-1, by, bz), 3)+ & - fx*as(coset(ax-1, ay, az), coset(bx-1, by, bz), 3)+ & - f3*as(coset(ax, ay, az), coset(bx-2, by, bz), 3)+ & - ac1(3)*s(coset(ax, ay, az), coset(bx-1, by, bz)) + rbp(1)*as(coset(ax, ay, az), coset(bx - 1, by, bz), 3) + & + fx*as(coset(ax - 1, ay, az), coset(bx - 1, by, bz), 3) + & + f3*as(coset(ax, ay, az), coset(bx - 2, by, bz), 3) + & + ac1(3)*s(coset(ax, ay, az), coset(bx - 1, by, bz)) IF (az > 0) as(coset(ax, ay, az), coset(bx, by, bz), 2) = & - as(coset(ax, ay, az), coset(bx, by, bz), 2)+ & - f2*REAL(az, dp)*s(coset(ax, ay, az-1), coset(bx-1, by, bz)) + as(coset(ax, ay, az), coset(bx, by, bz), 2) + & + f2*REAL(az, dp)*s(coset(ax, ay, az - 1), coset(bx - 1, by, bz)) IF (ay > 0) as(coset(ax, ay, az), coset(bx, by, bz), 3) = & - as(coset(ax, ay, az), coset(bx, by, bz), 3)- & - f2*REAL(ay, dp)*s(coset(ax, ay-1, az), coset(bx-1, by, bz)) + as(coset(ax, ay, az), coset(bx, by, bz), 3) - & + f2*REAL(ay, dp)*s(coset(ax, ay - 1, az), coset(bx - 1, by, bz)) END DO END DO END IF @@ -787,7 +787,7 @@ SUBROUTINE angmom(la_max, npgfa, zeta, rpgfa, la_min, & ! *** Vertical recurrence steps: [s|L|s] -> [s|L|b] *** - rbp(:) = (f1-1.0_dp)*rab(:) + rbp(:) = (f1 - 1.0_dp)*rab(:) ! *** [s|p] = (Pi - Bi)*[s|s] *** ! *** [s|L|p] = (Pi - Bi)*[s|L|s] + xa/(xa+xb)*(AC x 1i)*[s|s] *** @@ -795,15 +795,15 @@ SUBROUTINE angmom(la_max, npgfa, zeta, rpgfa, la_min, & s(1, 2) = rbp(1)*s(1, 1) s(1, 3) = rbp(2)*s(1, 1) s(1, 4) = rbp(3)*s(1, 1) - as(1, 2, 1) = rbp(1)*as(1, 1, 1)+ac1(1)*s(1, 1) - as(1, 2, 2) = rbp(1)*as(1, 1, 2)+ac1(2)*s(1, 1) - as(1, 2, 3) = rbp(1)*as(1, 1, 3)+ac1(3)*s(1, 1) - as(1, 3, 1) = rbp(2)*as(1, 1, 1)+ac2(1)*s(1, 1) - as(1, 3, 2) = rbp(2)*as(1, 1, 2)+ac2(2)*s(1, 1) - as(1, 3, 3) = rbp(2)*as(1, 1, 3)+ac2(3)*s(1, 1) - as(1, 4, 1) = rbp(3)*as(1, 1, 1)+ac3(1)*s(1, 1) - as(1, 4, 2) = rbp(3)*as(1, 1, 2)+ac3(2)*s(1, 1) - as(1, 4, 3) = rbp(3)*as(1, 1, 3)+ac3(3)*s(1, 1) + as(1, 2, 1) = rbp(1)*as(1, 1, 1) + ac1(1)*s(1, 1) + as(1, 2, 2) = rbp(1)*as(1, 1, 2) + ac1(2)*s(1, 1) + as(1, 2, 3) = rbp(1)*as(1, 1, 3) + ac1(3)*s(1, 1) + as(1, 3, 1) = rbp(2)*as(1, 1, 1) + ac2(1)*s(1, 1) + as(1, 3, 2) = rbp(2)*as(1, 1, 2) + ac2(2)*s(1, 1) + as(1, 3, 3) = rbp(2)*as(1, 1, 3) + ac2(3)*s(1, 1) + as(1, 4, 1) = rbp(3)*as(1, 1, 1) + ac3(1)*s(1, 1) + as(1, 4, 2) = rbp(3)*as(1, 1, 2) + ac3(2)*s(1, 1) + as(1, 4, 3) = rbp(3)*as(1, 1, 3) + ac3(3)*s(1, 1) ! *** [s|b] = (Pi - Bi)*[s|b-1i] + f2*Ni(b-1i)*[s|b-2i] *** ! *** [s|L|b] = (Pi - Bi)*[s|L|b-1i] + f2*Ni(b-1i)*[s|L|b-2i] *** @@ -813,72 +813,72 @@ SUBROUTINE angmom(la_max, npgfa, zeta, rpgfa, la_min, & ! *** Increase the angular momentum component z of function b *** - s(1, coset(0, 0, lb)) = rbp(3)*s(1, coset(0, 0, lb-1))+ & - f2*REAL(lb-1, dp)*s(1, coset(0, 0, lb-2)) - as(1, coset(0, 0, lb), 1) = rbp(3)*as(1, coset(0, 0, lb-1), 1)+ & - f2*REAL(lb-1, dp)*as(1, coset(0, 0, lb-2), 1)+ & - ac3(1)*s(1, coset(0, 0, lb-1)) - as(1, coset(0, 0, lb), 2) = rbp(3)*as(1, coset(0, 0, lb-1), 2)+ & - f2*REAL(lb-1, dp)*as(1, coset(0, 0, lb-2), 2)+ & - ac3(2)*s(1, coset(0, 0, lb-1)) - as(1, coset(0, 0, lb), 3) = rbp(3)*as(1, coset(0, 0, lb-1), 3)+ & - f2*REAL(lb-1, dp)*as(1, coset(0, 0, lb-2), 3)+ & - ac3(3)*s(1, coset(0, 0, lb-1)) + s(1, coset(0, 0, lb)) = rbp(3)*s(1, coset(0, 0, lb - 1)) + & + f2*REAL(lb - 1, dp)*s(1, coset(0, 0, lb - 2)) + as(1, coset(0, 0, lb), 1) = rbp(3)*as(1, coset(0, 0, lb - 1), 1) + & + f2*REAL(lb - 1, dp)*as(1, coset(0, 0, lb - 2), 1) + & + ac3(1)*s(1, coset(0, 0, lb - 1)) + as(1, coset(0, 0, lb), 2) = rbp(3)*as(1, coset(0, 0, lb - 1), 2) + & + f2*REAL(lb - 1, dp)*as(1, coset(0, 0, lb - 2), 2) + & + ac3(2)*s(1, coset(0, 0, lb - 1)) + as(1, coset(0, 0, lb), 3) = rbp(3)*as(1, coset(0, 0, lb - 1), 3) + & + f2*REAL(lb - 1, dp)*as(1, coset(0, 0, lb - 2), 3) + & + ac3(3)*s(1, coset(0, 0, lb - 1)) ! *** Increase the angular momentum component y of function b *** - bz = lb-1 + bz = lb - 1 s(1, coset(0, 1, bz)) = rbp(2)*s(1, coset(0, 0, bz)) - as(1, coset(0, 1, bz), 1) = rbp(2)*as(1, coset(0, 0, bz), 1)+ & + as(1, coset(0, 1, bz), 1) = rbp(2)*as(1, coset(0, 0, bz), 1) + & ac2(1)*s(1, coset(0, 0, bz)) - as(1, coset(0, 1, bz), 2) = rbp(2)*as(1, coset(0, 0, bz), 2)+ & + as(1, coset(0, 1, bz), 2) = rbp(2)*as(1, coset(0, 0, bz), 2) + & ac2(2)*s(1, coset(0, 0, bz)) - as(1, coset(0, 1, bz), 3) = rbp(2)*as(1, coset(0, 0, bz), 3)+ & + as(1, coset(0, 1, bz), 3) = rbp(2)*as(1, coset(0, 0, bz), 3) + & ac2(3)*s(1, coset(0, 0, bz)) DO by = 2, lb - bz = lb-by - s(1, coset(0, by, bz)) = rbp(2)*s(1, coset(0, by-1, bz))+ & - f2*REAL(by-1, dp)*s(1, coset(0, by-2, bz)) - as(1, coset(0, by, bz), 1) = rbp(2)*as(1, coset(0, by-1, bz), 1)+ & - f2*REAL(by-1, dp)*as(1, coset(0, by-2, bz), 1)+ & - ac2(1)*s(1, coset(0, by-1, bz)) - as(1, coset(0, by, bz), 2) = rbp(2)*as(1, coset(0, by-1, bz), 2)+ & - f2*REAL(by-1, dp)*as(1, coset(0, by-2, bz), 2)+ & - ac2(2)*s(1, coset(0, by-1, bz)) - as(1, coset(0, by, bz), 3) = rbp(2)*as(1, coset(0, by-1, bz), 3)+ & - f2*REAL(by-1, dp)*as(1, coset(0, by-2, bz), 3)+ & - ac2(3)*s(1, coset(0, by-1, bz)) + bz = lb - by + s(1, coset(0, by, bz)) = rbp(2)*s(1, coset(0, by - 1, bz)) + & + f2*REAL(by - 1, dp)*s(1, coset(0, by - 2, bz)) + as(1, coset(0, by, bz), 1) = rbp(2)*as(1, coset(0, by - 1, bz), 1) + & + f2*REAL(by - 1, dp)*as(1, coset(0, by - 2, bz), 1) + & + ac2(1)*s(1, coset(0, by - 1, bz)) + as(1, coset(0, by, bz), 2) = rbp(2)*as(1, coset(0, by - 1, bz), 2) + & + f2*REAL(by - 1, dp)*as(1, coset(0, by - 2, bz), 2) + & + ac2(2)*s(1, coset(0, by - 1, bz)) + as(1, coset(0, by, bz), 3) = rbp(2)*as(1, coset(0, by - 1, bz), 3) + & + f2*REAL(by - 1, dp)*as(1, coset(0, by - 2, bz), 3) + & + ac2(3)*s(1, coset(0, by - 1, bz)) END DO ! *** Increase the angular momentum component x of function b *** - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by s(1, coset(1, by, bz)) = rbp(1)*s(1, coset(0, by, bz)) - as(1, coset(1, by, bz), 1) = rbp(1)*as(1, coset(0, by, bz), 1)+ & + as(1, coset(1, by, bz), 1) = rbp(1)*as(1, coset(0, by, bz), 1) + & ac1(1)*s(1, coset(0, by, bz)) - as(1, coset(1, by, bz), 2) = rbp(1)*as(1, coset(0, by, bz), 2)+ & + as(1, coset(1, by, bz), 2) = rbp(1)*as(1, coset(0, by, bz), 2) + & ac1(2)*s(1, coset(0, by, bz)) - as(1, coset(1, by, bz), 3) = rbp(1)*as(1, coset(0, by, bz), 3)+ & + as(1, coset(1, by, bz), 3) = rbp(1)*as(1, coset(0, by, bz), 3) + & ac1(3)*s(1, coset(0, by, bz)) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by - s(1, coset(bx, by, bz)) = rbp(1)*s(1, coset(bx-1, by, bz))+ & - f3*s(1, coset(bx-2, by, bz)) - as(1, coset(bx, by, bz), 1) = rbp(1)*as(1, coset(bx-1, by, bz), 1)+ & - f3*as(1, coset(bx-2, by, bz), 1)+ & - ac1(1)*s(1, coset(bx-1, by, bz)) - as(1, coset(bx, by, bz), 2) = rbp(1)*as(1, coset(bx-1, by, bz), 2)+ & - f3*as(1, coset(bx-2, by, bz), 2)+ & - ac1(2)*s(1, coset(bx-1, by, bz)) - as(1, coset(bx, by, bz), 3) = rbp(1)*as(1, coset(bx-1, by, bz), 3)+ & - f3*as(1, coset(bx-2, by, bz), 3)+ & - ac1(3)*s(1, coset(bx-1, by, bz)) + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by + s(1, coset(bx, by, bz)) = rbp(1)*s(1, coset(bx - 1, by, bz)) + & + f3*s(1, coset(bx - 2, by, bz)) + as(1, coset(bx, by, bz), 1) = rbp(1)*as(1, coset(bx - 1, by, bz), 1) + & + f3*as(1, coset(bx - 2, by, bz), 1) + & + ac1(1)*s(1, coset(bx - 1, by, bz)) + as(1, coset(bx, by, bz), 2) = rbp(1)*as(1, coset(bx - 1, by, bz), 2) + & + f3*as(1, coset(bx - 2, by, bz), 2) + & + ac1(2)*s(1, coset(bx - 1, by, bz)) + as(1, coset(bx, by, bz), 3) = rbp(1)*as(1, coset(bx - 1, by, bz), 3) + & + f3*as(1, coset(bx - 2, by, bz), 3) + & + ac1(3)*s(1, coset(bx - 1, by, bz)) END DO END DO @@ -890,17 +890,17 @@ SUBROUTINE angmom(la_max, npgfa, zeta, rpgfa, la_min, & DO j = 1, ncoset(lb_max) DO i = 1, ncoset(la_max) - angab(na+i, nb+j, 1) = as(i, j, 1) - angab(na+i, nb+j, 2) = as(i, j, 2) - angab(na+i, nb+j, 3) = as(i, j, 3) + angab(na + i, nb + j, 1) = as(i, j, 1) + angab(na + i, nb + j, 2) = as(i, j, 2) + angab(na + i, nb + j, 3) = as(i, j, 3) END DO END DO - nb = nb+ncoset(lb_max) + nb = nb + ncoset(lb_max) END DO - na = na+ncoset(la_max) + na = na + ncoset(la_max) END DO diff --git a/src/aobasis/ai_contraction.F b/src/aobasis/ai_contraction.F index b8f487b219..5eaf5c3759 100644 --- a/src/aobasis/ai_contraction.F +++ b/src/aobasis/ai_contraction.F @@ -430,21 +430,21 @@ SUBROUTINE block_add_ab(dir, sab, na, nb, qab, ia, ib, trans) IF (dir == "IN" .OR. dir == "in") THEN ! QAB(block) <= SAB - ja = ia+na-1 - jb = ib+nb-1 + ja = ia + na - 1 + jb = ib + nb - 1 IF (my_trans) THEN - qab(ib:jb, ia:ja) = qab(ib:jb, ia:ja)+sab(1:nb, 1:na) + qab(ib:jb, ia:ja) = qab(ib:jb, ia:ja) + sab(1:nb, 1:na) ELSE - qab(ia:ja, ib:jb) = qab(ia:ja, ib:jb)+sab(1:na, 1:nb) + qab(ia:ja, ib:jb) = qab(ia:ja, ib:jb) + sab(1:na, 1:nb) END IF ELSEIF (dir == "OUT" .OR. dir == "out") THEN ! SAB <= QAB(block) - ja = ia+na-1 - jb = ib+nb-1 + ja = ia + na - 1 + jb = ib + nb - 1 IF (my_trans) THEN - sab(1:nb, 1:na) = sab(1:nb, 1:na)+qab(ib:jb, ia:ja) + sab(1:nb, 1:na) = sab(1:nb, 1:na) + qab(ib:jb, ia:ja) ELSE - sab(1:na, 1:nb) = sab(1:na, 1:nb)+qab(ia:ja, ib:jb) + sab(1:na, 1:nb) = sab(1:na, 1:nb) + qab(ia:ja, ib:jb) END IF ELSE CPABORT("") diff --git a/src/aobasis/ai_coulomb.F b/src/aobasis/ai_coulomb.F index 769a0edc71..e7e310da6c 100644 --- a/src/aobasis/ai_coulomb.F +++ b/src/aobasis/ai_coulomb.F @@ -111,7 +111,7 @@ SUBROUTINE coulomb2(la_max, npgfa, zeta, rpgfa, la_min, lc_max, npgfc, zetc, rpg vac_plus = 0.0_dp END IF - nmax = la_max+lc_max+1 + nmax = la_max + lc_max + 1 ! *** Calculate the distance of the centers a and c *** @@ -130,13 +130,13 @@ SUBROUTINE coulomb2(la_max, npgfa, zeta, rpgfa, la_min, lc_max, npgfc, zetc, rpg ! *** Screening *** - IF (rpgfa(ipgf)+rpgfc(jpgf) < dac) THEN - DO j = nc+ncoset(lc_min-1)+1, nc+ncoset(lc_max) - DO i = na+ncoset(la_min-1)+1, na+ncoset(la_max-maxder_local) + IF (rpgfa(ipgf) + rpgfc(jpgf) < dac) THEN + DO j = nc + ncoset(lc_min - 1) + 1, nc + ncoset(lc_max) + DO i = na + ncoset(la_min - 1) + 1, na + ncoset(la_max - maxder_local) vac(i, j) = 0.0_dp END DO END DO - nc = nc+ncoset(lc_max) + nc = nc + ncoset(lc_max) CYCLE END IF @@ -144,7 +144,7 @@ SUBROUTINE coulomb2(la_max, npgfa, zeta, rpgfa, la_min, lc_max, npgfc, zetc, rpg zetp = 1.0_dp/zeta(ipgf) zetq = 1.0_dp/zetc(jpgf) - zetw = 1.0_dp/(zeta(ipgf)+zetc(jpgf)) + zetw = 1.0_dp/(zeta(ipgf) + zetc(jpgf)) rho = zeta(ipgf)*zetc(jpgf)*zetw @@ -154,12 +154,12 @@ SUBROUTINE coulomb2(la_max, npgfa, zeta, rpgfa, la_min, lc_max, npgfc, zetc, rpg t = rho*rac2 - CALL fgamma(nmax-1, t, f) + CALL fgamma(nmax - 1, t, f) ! *** Calculate the basic two-center Coulomb integrals [s||s]{n} *** DO n = 1, nmax - v(1, 1, n) = f0*f(n-1) + v(1, 1, n) = f0*f(n - 1) END DO ! *** Vertical recurrence steps: [s||s] -> [s||c] *** @@ -173,10 +173,10 @@ SUBROUTINE coulomb2(la_max, npgfa, zeta, rpgfa, la_min, lc_max, npgfc, zetc, rpg ! *** [s||p]{n} = (Wi - Ci)*[s||s]{n+1} (i = x,y,z) *** - DO n = 1, nmax-1 - v(1, 2, n) = rcw(1)*v(1, 1, n+1) - v(1, 3, n) = rcw(2)*v(1, 1, n+1) - v(1, 4, n) = rcw(3)*v(1, 1, n+1) + DO n = 1, nmax - 1 + v(1, 2, n) = rcw(1)*v(1, 1, n + 1) + v(1, 3, n) = rcw(2)*v(1, 1, n + 1) + v(1, 4, n) = rcw(3)*v(1, 1, n + 1) END DO ! ** [s||c]{n} = (Wi - Ci)*[s||c-1i]{n+1} + *** @@ -185,43 +185,43 @@ SUBROUTINE coulomb2(la_max, npgfa, zeta, rpgfa, la_min, lc_max, npgfc, zetc, rpg DO lc = 2, lc_max - DO n = 1, nmax-lc + DO n = 1, nmax - lc ! **** Increase the angular momentum component z of c *** v(1, coset(0, 0, lc), n) = & - rcw(3)*v(1, coset(0, 0, lc-1), n+1)+ & - f1*REAL(lc-1, dp)*(v(1, coset(0, 0, lc-2), n)+ & - f2*v(1, coset(0, 0, lc-2), n+1)) + rcw(3)*v(1, coset(0, 0, lc - 1), n + 1) + & + f1*REAL(lc - 1, dp)*(v(1, coset(0, 0, lc - 2), n) + & + f2*v(1, coset(0, 0, lc - 2), n + 1)) ! *** Increase the angular momentum component y of c *** - cz = lc-1 - v(1, coset(0, 1, cz), n) = rcw(2)*v(1, coset(0, 0, cz), n+1) + cz = lc - 1 + v(1, coset(0, 1, cz), n) = rcw(2)*v(1, coset(0, 0, cz), n + 1) DO cy = 2, lc - cz = lc-cy + cz = lc - cy v(1, coset(0, cy, cz), n) = & - rcw(2)*v(1, coset(0, cy-1, cz), n+1)+ & - f1*REAL(cy-1, dp)*(v(1, coset(0, cy-2, cz), n)+ & - f2*v(1, coset(0, cy-2, cz), n+1)) + rcw(2)*v(1, coset(0, cy - 1, cz), n + 1) + & + f1*REAL(cy - 1, dp)*(v(1, coset(0, cy - 2, cz), n) + & + f2*v(1, coset(0, cy - 2, cz), n + 1)) END DO ! *** Increase the angular momentum component x of c *** - DO cy = 0, lc-1 - cz = lc-1-cy - v(1, coset(1, cy, cz), n) = rcw(1)*v(1, coset(0, cy, cz), n+1) + DO cy = 0, lc - 1 + cz = lc - 1 - cy + v(1, coset(1, cy, cz), n) = rcw(1)*v(1, coset(0, cy, cz), n + 1) END DO DO cx = 2, lc - f6 = f1*REAL(cx-1, dp) - DO cy = 0, lc-cx - cz = lc-cx-cy + f6 = f1*REAL(cx - 1, dp) + DO cy = 0, lc - cx + cz = lc - cx - cy v(1, coset(cx, cy, cz), n) = & - rcw(1)*v(1, coset(cx-1, cy, cz), n+1)+ & - f6*(v(1, coset(cx-2, cy, cz), n)+ & - f2*v(1, coset(cx-2, cy, cz), n+1)) + rcw(1)*v(1, coset(cx - 1, cy, cz), n + 1) + & + f6*(v(1, coset(cx - 2, cy, cz), n) + & + f2*v(1, coset(cx - 2, cy, cz), n + 1)) END DO END DO @@ -243,10 +243,10 @@ SUBROUTINE coulomb2(la_max, npgfa, zeta, rpgfa, la_min, lc_max, npgfc, zetc, rpg ! *** [p||s]{n} = (Wi - Ai)*[s||s]{n+1} (i = x,y,z) *** - DO n = 1, nmax-1 - v(2, 1, n) = raw(1)*v(1, 1, n+1) - v(3, 1, n) = raw(2)*v(1, 1, n+1) - v(4, 1, n) = raw(3)*v(1, 1, n+1) + DO n = 1, nmax - 1 + v(2, 1, n) = raw(1)*v(1, 1, n + 1) + v(3, 1, n) = raw(2)*v(1, 1, n + 1) + v(4, 1, n) = raw(3)*v(1, 1, n + 1) END DO ! *** [a||s]{n} = (Wi - Ai)*[a-1i||s]{n+1} + *** @@ -255,43 +255,43 @@ SUBROUTINE coulomb2(la_max, npgfa, zeta, rpgfa, la_min, lc_max, npgfc, zetc, rpg DO la = 2, la_max - DO n = 1, nmax-la + DO n = 1, nmax - la ! *** Increase the angular momentum component z of a *** v(coset(0, 0, la), 1, n) = & - raw(3)*v(coset(0, 0, la-1), 1, n+1)+ & - f3*REAL(la-1, dp)*(v(coset(0, 0, la-2), 1, n)+ & - f4*v(coset(0, 0, la-2), 1, n+1)) + raw(3)*v(coset(0, 0, la - 1), 1, n + 1) + & + f3*REAL(la - 1, dp)*(v(coset(0, 0, la - 2), 1, n) + & + f4*v(coset(0, 0, la - 2), 1, n + 1)) ! *** Increase the angular momentum component y of a *** - az = la-1 - v(coset(0, 1, az), 1, n) = raw(2)*v(coset(0, 0, az), 1, n+1) + az = la - 1 + v(coset(0, 1, az), 1, n) = raw(2)*v(coset(0, 0, az), 1, n + 1) DO ay = 2, la - az = la-ay + az = la - ay v(coset(0, ay, az), 1, n) = & - raw(2)*v(coset(0, ay-1, az), 1, n+1)+ & - f3*REAL(ay-1, dp)*(v(coset(0, ay-2, az), 1, n)+ & - f4*v(coset(0, ay-2, az), 1, n+1)) + raw(2)*v(coset(0, ay - 1, az), 1, n + 1) + & + f3*REAL(ay - 1, dp)*(v(coset(0, ay - 2, az), 1, n) + & + f4*v(coset(0, ay - 2, az), 1, n + 1)) END DO ! *** Increase the angular momentum component x of a *** - DO ay = 0, la-1 - az = la-1-ay - v(coset(1, ay, az), 1, n) = raw(1)*v(coset(0, ay, az), 1, n+1) + DO ay = 0, la - 1 + az = la - 1 - ay + v(coset(1, ay, az), 1, n) = raw(1)*v(coset(0, ay, az), 1, n + 1) END DO DO ax = 2, la - f6 = f3*REAL(ax-1, dp) - DO ay = 0, la-ax - az = la-ax-ay + f6 = f3*REAL(ax - 1, dp) + DO ay = 0, la - ax + az = la - ax - ay v(coset(ax, ay, az), 1, n) = & - raw(1)*v(coset(ax-1, ay, az), 1, n+1)+ & - f6*(v(coset(ax-2, ay, az), 1, n)+ & - f4*v(coset(ax-2, ay, az), 1, n+1)) + raw(1)*v(coset(ax - 1, ay, az), 1, n + 1) + & + f6*(v(coset(ax - 2, ay, az), 1, n) + & + f4*v(coset(ax - 2, ay, az), 1, n + 1)) END DO END DO @@ -302,13 +302,13 @@ SUBROUTINE coulomb2(la_max, npgfa, zeta, rpgfa, la_min, lc_max, npgfc, zetc, rpg DO lc = 1, lc_max DO cx = 0, lc - DO cy = 0, lc-cx - cz = lc-cx-cy + DO cy = 0, lc - cx + cz = lc - cx - cy coc = coset(cx, cy, cz) - cocx = coset(MAX(0, cx-1), cy, cz) - cocy = coset(cx, MAX(0, cy-1), cz) - cocz = coset(cx, cy, MAX(0, cz-1)) + cocx = coset(MAX(0, cx - 1), cy, cz) + cocy = coset(cx, MAX(0, cy - 1), cz) + cocz = coset(cx, cy, MAX(0, cz - 1)) fcx = f5*REAL(cx, dp) fcy = f5*REAL(cy, dp) @@ -317,10 +317,10 @@ SUBROUTINE coulomb2(la_max, npgfa, zeta, rpgfa, la_min, lc_max, npgfc, zetc, rpg ! *** [p||c]{n} = (Wi - Ai)*[s||c]{n+1} + *** ! *** f5*Ni(c)*[s||c-1i]{n+1} *** - DO n = 1, nmax-1-lc - v(2, coc, n) = raw(1)*v(1, coc, n+1)+fcx*v(1, cocx, n+1) - v(3, coc, n) = raw(2)*v(1, coc, n+1)+fcy*v(1, cocy, n+1) - v(4, coc, n) = raw(3)*v(1, coc, n+1)+fcz*v(1, cocz, n+1) + DO n = 1, nmax - 1 - lc + v(2, coc, n) = raw(1)*v(1, coc, n + 1) + fcx*v(1, cocx, n + 1) + v(3, coc, n) = raw(2)*v(1, coc, n + 1) + fcy*v(1, cocy, n + 1) + v(4, coc, n) = raw(3)*v(1, coc, n + 1) + fcz*v(1, cocz, n + 1) END DO ! *** [a||c]{n} = (Wi - Ai)*[a-1i||c]{n+1} + *** @@ -330,50 +330,50 @@ SUBROUTINE coulomb2(la_max, npgfa, zeta, rpgfa, la_min, lc_max, npgfc, zetc, rpg DO la = 2, la_max - DO n = 1, nmax-la-lc + DO n = 1, nmax - la - lc ! *** Increase the angular momentum component z of a *** v(coset(0, 0, la), coc, n) = & - raw(3)*v(coset(0, 0, la-1), coc, n+1)+ & - f3*REAL(la-1, dp)*(v(coset(0, 0, la-2), coc, n)+ & - f4*v(coset(0, 0, la-2), coc, n+1))+ & - fcz*v(coset(0, 0, la-1), cocz, n+1) + raw(3)*v(coset(0, 0, la - 1), coc, n + 1) + & + f3*REAL(la - 1, dp)*(v(coset(0, 0, la - 2), coc, n) + & + f4*v(coset(0, 0, la - 2), coc, n + 1)) + & + fcz*v(coset(0, 0, la - 1), cocz, n + 1) ! *** Increase the angular momentum component y of a *** - az = la-1 + az = la - 1 v(coset(0, 1, az), coc, n) = & - raw(2)*v(coset(0, 0, az), coc, n+1)+ & - fcy*v(coset(0, 0, az), cocy, n+1) + raw(2)*v(coset(0, 0, az), coc, n + 1) + & + fcy*v(coset(0, 0, az), cocy, n + 1) DO ay = 2, la - az = la-ay + az = la - ay v(coset(0, ay, az), coc, n) = & - raw(2)*v(coset(0, ay-1, az), coc, n+1)+ & - f3*REAL(ay-1, dp)*(v(coset(0, ay-2, az), coc, n)+ & - f4*v(coset(0, ay-2, az), coc, n+1))+ & - fcy*v(coset(0, ay-1, az), cocy, n+1) + raw(2)*v(coset(0, ay - 1, az), coc, n + 1) + & + f3*REAL(ay - 1, dp)*(v(coset(0, ay - 2, az), coc, n) + & + f4*v(coset(0, ay - 2, az), coc, n + 1)) + & + fcy*v(coset(0, ay - 1, az), cocy, n + 1) END DO ! *** Increase the angular momentum component x of a *** - DO ay = 0, la-1 - az = la-1-ay + DO ay = 0, la - 1 + az = la - 1 - ay v(coset(1, ay, az), coc, n) = & - raw(1)*v(coset(0, ay, az), coc, n+1)+ & - fcx*v(coset(0, ay, az), cocx, n+1) + raw(1)*v(coset(0, ay, az), coc, n + 1) + & + fcx*v(coset(0, ay, az), cocx, n + 1) END DO DO ax = 2, la - f6 = f3*REAL(ax-1, dp) - DO ay = 0, la-ax - az = la-ax-ay + f6 = f3*REAL(ax - 1, dp) + DO ay = 0, la - ax + az = la - ax - ay v(coset(ax, ay, az), coc, n) = & - raw(1)*v(coset(ax-1, ay, az), coc, n+1)+ & - f6*(v(coset(ax-2, ay, az), coc, n)+ & - f4*v(coset(ax-2, ay, az), coc, n+1))+ & - fcx*v(coset(ax-1, ay, az), cocx, n+1) + raw(1)*v(coset(ax - 1, ay, az), coc, n + 1) + & + f6*(v(coset(ax - 2, ay, az), coc, n) + & + f4*v(coset(ax - 2, ay, az), coc, n + 1)) + & + fcx*v(coset(ax - 1, ay, az), cocx, n + 1) END DO END DO @@ -388,26 +388,26 @@ SUBROUTINE coulomb2(la_max, npgfa, zeta, rpgfa, la_min, lc_max, npgfc, zetc, rpg END IF - DO j = ncoset(lc_min-1)+1, ncoset(lc_max) - DO i = ncoset(la_min-1)+1, ncoset(la_max-maxder_local) - vac(na+i, nc+j) = v(i, j, 1) + DO j = ncoset(lc_min - 1) + 1, ncoset(lc_max) + DO i = ncoset(la_min - 1) + 1, ncoset(la_max - maxder_local) + vac(na + i, nc + j) = v(i, j, 1) END DO END DO IF (PRESENT(maxder)) THEN - DO j = ncoset(lc_min-1)+1, ncoset(lc_max) + DO j = ncoset(lc_min - 1) + 1, ncoset(lc_max) DO i = 1, ncoset(la_max) - vac_plus(nap+i, nc+j) = v(i, j, 1) + vac_plus(nap + i, nc + j) = v(i, j, 1) END DO END DO END IF - nc = nc+ncoset(lc_max) + nc = nc + ncoset(lc_max) END DO - na = na+ncoset(la_max-maxder_local) - nap = nap+ncoset(la_max) + na = na + ncoset(la_max - maxder_local) + nap = nap + ncoset(la_max) END DO @@ -468,7 +468,7 @@ SUBROUTINE coulomb2_new(la_max, npgfa, zeta, la_min, lc_max, npgfc, zetc, lc_min vac_plus = 0.0_dp END IF - nmax = la_max+lc_max+1 + nmax = la_max + lc_max + 1 ! *** Calculate the distance of the centers a and c *** @@ -490,7 +490,7 @@ SUBROUTINE coulomb2_new(la_max, npgfa, zeta, la_min, lc_max, npgfc, zetc, lc_min zetp = 1.0_dp/zeta(ipgf) zetq = 1.0_dp/zetc(jpgf) - zetw = 1.0_dp/(zeta(ipgf)+zetc(jpgf)) + zetw = 1.0_dp/(zeta(ipgf) + zetc(jpgf)) rho = zeta(ipgf)*zetc(jpgf)*zetw @@ -500,12 +500,12 @@ SUBROUTINE coulomb2_new(la_max, npgfa, zeta, la_min, lc_max, npgfc, zetc, lc_min t = rho*rac2 - CALL fgamma(nmax-1, t, f) + CALL fgamma(nmax - 1, t, f) ! *** Calculate the basic two-center Coulomb integrals [s||s]{n} *** DO n = 1, nmax - v(1, 1, n) = f0*f(n-1) + v(1, 1, n) = f0*f(n - 1) END DO ! *** Vertical recurrence steps: [s||s] -> [s||c] *** @@ -519,10 +519,10 @@ SUBROUTINE coulomb2_new(la_max, npgfa, zeta, la_min, lc_max, npgfc, zetc, lc_min ! *** [s||p]{n} = (Wi - Ci)*[s||s]{n+1} (i = x,y,z) *** - DO n = 1, nmax-1 - v(1, 2, n) = rcw(1)*v(1, 1, n+1) - v(1, 3, n) = rcw(2)*v(1, 1, n+1) - v(1, 4, n) = rcw(3)*v(1, 1, n+1) + DO n = 1, nmax - 1 + v(1, 2, n) = rcw(1)*v(1, 1, n + 1) + v(1, 3, n) = rcw(2)*v(1, 1, n + 1) + v(1, 4, n) = rcw(3)*v(1, 1, n + 1) END DO ! ** [s||c]{n} = (Wi - Ci)*[s||c-1i]{n+1} + *** @@ -531,43 +531,43 @@ SUBROUTINE coulomb2_new(la_max, npgfa, zeta, la_min, lc_max, npgfc, zetc, lc_min DO lc = 2, lc_max - DO n = 1, nmax-lc + DO n = 1, nmax - lc ! **** Increase the angular momentum component z of c *** v(1, coset(0, 0, lc), n) = & - rcw(3)*v(1, coset(0, 0, lc-1), n+1)+ & - f1*REAL(lc-1, dp)*(v(1, coset(0, 0, lc-2), n)+ & - f2*v(1, coset(0, 0, lc-2), n+1)) + rcw(3)*v(1, coset(0, 0, lc - 1), n + 1) + & + f1*REAL(lc - 1, dp)*(v(1, coset(0, 0, lc - 2), n) + & + f2*v(1, coset(0, 0, lc - 2), n + 1)) ! *** Increase the angular momentum component y of c *** - cz = lc-1 - v(1, coset(0, 1, cz), n) = rcw(2)*v(1, coset(0, 0, cz), n+1) + cz = lc - 1 + v(1, coset(0, 1, cz), n) = rcw(2)*v(1, coset(0, 0, cz), n + 1) DO cy = 2, lc - cz = lc-cy + cz = lc - cy v(1, coset(0, cy, cz), n) = & - rcw(2)*v(1, coset(0, cy-1, cz), n+1)+ & - f1*REAL(cy-1, dp)*(v(1, coset(0, cy-2, cz), n)+ & - f2*v(1, coset(0, cy-2, cz), n+1)) + rcw(2)*v(1, coset(0, cy - 1, cz), n + 1) + & + f1*REAL(cy - 1, dp)*(v(1, coset(0, cy - 2, cz), n) + & + f2*v(1, coset(0, cy - 2, cz), n + 1)) END DO ! *** Increase the angular momentum component x of c *** - DO cy = 0, lc-1 - cz = lc-1-cy - v(1, coset(1, cy, cz), n) = rcw(1)*v(1, coset(0, cy, cz), n+1) + DO cy = 0, lc - 1 + cz = lc - 1 - cy + v(1, coset(1, cy, cz), n) = rcw(1)*v(1, coset(0, cy, cz), n + 1) END DO DO cx = 2, lc - f6 = f1*REAL(cx-1, dp) - DO cy = 0, lc-cx - cz = lc-cx-cy + f6 = f1*REAL(cx - 1, dp) + DO cy = 0, lc - cx + cz = lc - cx - cy v(1, coset(cx, cy, cz), n) = & - rcw(1)*v(1, coset(cx-1, cy, cz), n+1)+ & - f6*(v(1, coset(cx-2, cy, cz), n)+ & - f2*v(1, coset(cx-2, cy, cz), n+1)) + rcw(1)*v(1, coset(cx - 1, cy, cz), n + 1) + & + f6*(v(1, coset(cx - 2, cy, cz), n) + & + f2*v(1, coset(cx - 2, cy, cz), n + 1)) END DO END DO @@ -589,10 +589,10 @@ SUBROUTINE coulomb2_new(la_max, npgfa, zeta, la_min, lc_max, npgfc, zetc, lc_min ! *** [p||s]{n} = (Wi - Ai)*[s||s]{n+1} (i = x,y,z) *** - DO n = 1, nmax-1 - v(2, 1, n) = raw(1)*v(1, 1, n+1) - v(3, 1, n) = raw(2)*v(1, 1, n+1) - v(4, 1, n) = raw(3)*v(1, 1, n+1) + DO n = 1, nmax - 1 + v(2, 1, n) = raw(1)*v(1, 1, n + 1) + v(3, 1, n) = raw(2)*v(1, 1, n + 1) + v(4, 1, n) = raw(3)*v(1, 1, n + 1) END DO ! *** [a||s]{n} = (Wi - Ai)*[a-1i||s]{n+1} + *** @@ -601,43 +601,43 @@ SUBROUTINE coulomb2_new(la_max, npgfa, zeta, la_min, lc_max, npgfc, zetc, lc_min DO la = 2, la_max - DO n = 1, nmax-la + DO n = 1, nmax - la ! *** Increase the angular momentum component z of a *** v(coset(0, 0, la), 1, n) = & - raw(3)*v(coset(0, 0, la-1), 1, n+1)+ & - f3*REAL(la-1, dp)*(v(coset(0, 0, la-2), 1, n)+ & - f4*v(coset(0, 0, la-2), 1, n+1)) + raw(3)*v(coset(0, 0, la - 1), 1, n + 1) + & + f3*REAL(la - 1, dp)*(v(coset(0, 0, la - 2), 1, n) + & + f4*v(coset(0, 0, la - 2), 1, n + 1)) ! *** Increase the angular momentum component y of a *** - az = la-1 - v(coset(0, 1, az), 1, n) = raw(2)*v(coset(0, 0, az), 1, n+1) + az = la - 1 + v(coset(0, 1, az), 1, n) = raw(2)*v(coset(0, 0, az), 1, n + 1) DO ay = 2, la - az = la-ay + az = la - ay v(coset(0, ay, az), 1, n) = & - raw(2)*v(coset(0, ay-1, az), 1, n+1)+ & - f3*REAL(ay-1, dp)*(v(coset(0, ay-2, az), 1, n)+ & - f4*v(coset(0, ay-2, az), 1, n+1)) + raw(2)*v(coset(0, ay - 1, az), 1, n + 1) + & + f3*REAL(ay - 1, dp)*(v(coset(0, ay - 2, az), 1, n) + & + f4*v(coset(0, ay - 2, az), 1, n + 1)) END DO ! *** Increase the angular momentum component x of a *** - DO ay = 0, la-1 - az = la-1-ay - v(coset(1, ay, az), 1, n) = raw(1)*v(coset(0, ay, az), 1, n+1) + DO ay = 0, la - 1 + az = la - 1 - ay + v(coset(1, ay, az), 1, n) = raw(1)*v(coset(0, ay, az), 1, n + 1) END DO DO ax = 2, la - f6 = f3*REAL(ax-1, dp) - DO ay = 0, la-ax - az = la-ax-ay + f6 = f3*REAL(ax - 1, dp) + DO ay = 0, la - ax + az = la - ax - ay v(coset(ax, ay, az), 1, n) = & - raw(1)*v(coset(ax-1, ay, az), 1, n+1)+ & - f6*(v(coset(ax-2, ay, az), 1, n)+ & - f4*v(coset(ax-2, ay, az), 1, n+1)) + raw(1)*v(coset(ax - 1, ay, az), 1, n + 1) + & + f6*(v(coset(ax - 2, ay, az), 1, n) + & + f4*v(coset(ax - 2, ay, az), 1, n + 1)) END DO END DO @@ -648,13 +648,13 @@ SUBROUTINE coulomb2_new(la_max, npgfa, zeta, la_min, lc_max, npgfc, zetc, lc_min DO lc = 1, lc_max DO cx = 0, lc - DO cy = 0, lc-cx - cz = lc-cx-cy + DO cy = 0, lc - cx + cz = lc - cx - cy coc = coset(cx, cy, cz) - cocx = coset(MAX(0, cx-1), cy, cz) - cocy = coset(cx, MAX(0, cy-1), cz) - cocz = coset(cx, cy, MAX(0, cz-1)) + cocx = coset(MAX(0, cx - 1), cy, cz) + cocy = coset(cx, MAX(0, cy - 1), cz) + cocz = coset(cx, cy, MAX(0, cz - 1)) fcx = f5*REAL(cx, dp) fcy = f5*REAL(cy, dp) @@ -663,10 +663,10 @@ SUBROUTINE coulomb2_new(la_max, npgfa, zeta, la_min, lc_max, npgfc, zetc, lc_min ! *** [p||c]{n} = (Wi - Ai)*[s||c]{n+1} + *** ! *** f5*Ni(c)*[s||c-1i]{n+1} *** - DO n = 1, nmax-1-lc - v(2, coc, n) = raw(1)*v(1, coc, n+1)+fcx*v(1, cocx, n+1) - v(3, coc, n) = raw(2)*v(1, coc, n+1)+fcy*v(1, cocy, n+1) - v(4, coc, n) = raw(3)*v(1, coc, n+1)+fcz*v(1, cocz, n+1) + DO n = 1, nmax - 1 - lc + v(2, coc, n) = raw(1)*v(1, coc, n + 1) + fcx*v(1, cocx, n + 1) + v(3, coc, n) = raw(2)*v(1, coc, n + 1) + fcy*v(1, cocy, n + 1) + v(4, coc, n) = raw(3)*v(1, coc, n + 1) + fcz*v(1, cocz, n + 1) END DO ! *** [a||c]{n} = (Wi - Ai)*[a-1i||c]{n+1} + *** @@ -676,50 +676,50 @@ SUBROUTINE coulomb2_new(la_max, npgfa, zeta, la_min, lc_max, npgfc, zetc, lc_min DO la = 2, la_max - DO n = 1, nmax-la-lc + DO n = 1, nmax - la - lc ! *** Increase the angular momentum component z of a *** v(coset(0, 0, la), coc, n) = & - raw(3)*v(coset(0, 0, la-1), coc, n+1)+ & - f3*REAL(la-1, dp)*(v(coset(0, 0, la-2), coc, n)+ & - f4*v(coset(0, 0, la-2), coc, n+1))+ & - fcz*v(coset(0, 0, la-1), cocz, n+1) + raw(3)*v(coset(0, 0, la - 1), coc, n + 1) + & + f3*REAL(la - 1, dp)*(v(coset(0, 0, la - 2), coc, n) + & + f4*v(coset(0, 0, la - 2), coc, n + 1)) + & + fcz*v(coset(0, 0, la - 1), cocz, n + 1) ! *** Increase the angular momentum component y of a *** - az = la-1 + az = la - 1 v(coset(0, 1, az), coc, n) = & - raw(2)*v(coset(0, 0, az), coc, n+1)+ & - fcy*v(coset(0, 0, az), cocy, n+1) + raw(2)*v(coset(0, 0, az), coc, n + 1) + & + fcy*v(coset(0, 0, az), cocy, n + 1) DO ay = 2, la - az = la-ay + az = la - ay v(coset(0, ay, az), coc, n) = & - raw(2)*v(coset(0, ay-1, az), coc, n+1)+ & - f3*REAL(ay-1, dp)*(v(coset(0, ay-2, az), coc, n)+ & - f4*v(coset(0, ay-2, az), coc, n+1))+ & - fcy*v(coset(0, ay-1, az), cocy, n+1) + raw(2)*v(coset(0, ay - 1, az), coc, n + 1) + & + f3*REAL(ay - 1, dp)*(v(coset(0, ay - 2, az), coc, n) + & + f4*v(coset(0, ay - 2, az), coc, n + 1)) + & + fcy*v(coset(0, ay - 1, az), cocy, n + 1) END DO ! *** Increase the angular momentum component x of a *** - DO ay = 0, la-1 - az = la-1-ay + DO ay = 0, la - 1 + az = la - 1 - ay v(coset(1, ay, az), coc, n) = & - raw(1)*v(coset(0, ay, az), coc, n+1)+ & - fcx*v(coset(0, ay, az), cocx, n+1) + raw(1)*v(coset(0, ay, az), coc, n + 1) + & + fcx*v(coset(0, ay, az), cocx, n + 1) END DO DO ax = 2, la - f6 = f3*REAL(ax-1, dp) - DO ay = 0, la-ax - az = la-ax-ay + f6 = f3*REAL(ax - 1, dp) + DO ay = 0, la - ax + az = la - ax - ay v(coset(ax, ay, az), coc, n) = & - raw(1)*v(coset(ax-1, ay, az), coc, n+1)+ & - f6*(v(coset(ax-2, ay, az), coc, n)+ & - f4*v(coset(ax-2, ay, az), coc, n+1))+ & - fcx*v(coset(ax-1, ay, az), cocx, n+1) + raw(1)*v(coset(ax - 1, ay, az), coc, n + 1) + & + f6*(v(coset(ax - 2, ay, az), coc, n) + & + f4*v(coset(ax - 2, ay, az), coc, n + 1)) + & + fcx*v(coset(ax - 1, ay, az), cocx, n + 1) END DO END DO @@ -734,27 +734,27 @@ SUBROUTINE coulomb2_new(la_max, npgfa, zeta, la_min, lc_max, npgfc, zetc, lc_min END IF - DO j = ncoset(lc_min-1)+1, ncoset(lc_max-maxder_local) - DO i = ncoset(la_min-1)+1, ncoset(la_max-maxder_local) - vac(na+i, nc+j) = v(i, j, 1) + DO j = ncoset(lc_min - 1) + 1, ncoset(lc_max - maxder_local) + DO i = ncoset(la_min - 1) + 1, ncoset(la_max - maxder_local) + vac(na + i, nc + j) = v(i, j, 1) END DO END DO IF (PRESENT(maxder)) THEN DO j = 1, ncoset(lc_max) DO i = 1, ncoset(la_max) - vac_plus(nap+i, ncp+j) = v(i, j, 1) + vac_plus(nap + i, ncp + j) = v(i, j, 1) END DO END DO END IF - nc = nc+ncoset(lc_max-maxder_local) - ncp = ncp+ncoset(lc_max) + nc = nc + ncoset(lc_max - maxder_local) + ncp = ncp + ncoset(lc_max) END DO - na = na+ncoset(la_max-maxder_local) - nap = nap+ncoset(la_max) + na = na + ncoset(la_max - maxder_local) + nap = nap + ncoset(la_max) END DO @@ -834,7 +834,7 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg maxder_local = maxder END IF - nmax = la_max+lb_max+lc_max+1 + nmax = la_max + lb_max + lc_max + 1 ! *** Calculate the distances of the centers a, b and c *** @@ -853,9 +853,9 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg DO ipgf = 1, npgfa ! *** Screening *** - IF (rpgfa(ipgf)+rpgfc < dac) THEN - na = na+ncoset(la_max-maxder_local) - nap = nap+ncoset(la_max) + IF (rpgfa(ipgf) + rpgfc < dac) THEN + na = na + ncoset(la_max - maxder_local) + nap = nap + ncoset(la_max) CYCLE END IF @@ -865,17 +865,17 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg ! *** Screening *** IF ( & - (rpgfb(jpgf)+rpgfc < dbc) .OR. & - (rpgfa(ipgf)+rpgfb(jpgf) < dab)) THEN - nb = nb+ncoset(lb_max) + (rpgfb(jpgf) + rpgfc < dbc) .OR. & + (rpgfa(ipgf) + rpgfb(jpgf) < dab)) THEN + nb = nb + ncoset(lb_max) CYCLE END IF ! *** Calculate some prefactors *** - zetp = 1.0_dp/(zeta(ipgf)+zetb(jpgf)) + zetp = 1.0_dp/(zeta(ipgf) + zetb(jpgf)) zetq = 1.0_dp/zetc - zetw = 1.0_dp/(zeta(ipgf)+zetb(jpgf)+zetc) + zetw = 1.0_dp/(zeta(ipgf) + zetb(jpgf) + zetc) f0 = 2.0_dp*SQRT(pi**5*zetw)*zetp*zetq f1 = zetb(jpgf)*zetp @@ -885,19 +885,19 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg f0 = f0*EXP(-zeta(ipgf)*f1*rab2) rap(:) = f1*rab(:) - rcp(:) = rap(:)-rac(:) + rcp(:) = rap(:) - rac(:) rpw(:) = f4*rcp(:) ! *** Calculate the incomplete Gamma function *** - t = -f4*(rcp(1)*rcp(1)+rcp(2)*rcp(2)+rcp(3)*rcp(3))/zetp + t = -f4*(rcp(1)*rcp(1) + rcp(2)*rcp(2) + rcp(3)*rcp(3))/zetp - CALL fgamma(nmax-1, t, f) + CALL fgamma(nmax - 1, t, f) ! *** Calculate the basic three-center Coulomb integrals [ss||s]{n} *** DO n = 1, nmax - v(1, 1, 1, n) = f0*f(n-1) + v(1, 1, 1, n) = f0*f(n - 1) END DO ! *** Recurrence steps: [ss||s] -> [as||s] *** @@ -909,10 +909,10 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg ! *** [ps||s]{n} = (Pi - Ai)*[ss||s]{n} + *** ! *** (Wi - Pi)*[ss||s]{n+1} (i = x,y,z) *** - DO n = 1, nmax-1 - v(2, 1, 1, n) = rap(1)*v(1, 1, 1, n)+rpw(1)*v(1, 1, 1, n+1) - v(3, 1, 1, n) = rap(2)*v(1, 1, 1, n)+rpw(2)*v(1, 1, 1, n+1) - v(4, 1, 1, n) = rap(3)*v(1, 1, 1, n)+rpw(3)*v(1, 1, 1, n+1) + DO n = 1, nmax - 1 + v(2, 1, 1, n) = rap(1)*v(1, 1, 1, n) + rpw(1)*v(1, 1, 1, n + 1) + v(3, 1, 1, n) = rap(2)*v(1, 1, 1, n) + rpw(2)*v(1, 1, 1, n + 1) + v(4, 1, 1, n) = rap(3)*v(1, 1, 1, n) + rpw(3)*v(1, 1, 1, n + 1) END DO ! *** [as||s]{n} = (Pi - Ai)*[(a-1i)s||s]{n} + *** @@ -922,50 +922,50 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg DO la = 2, la_max - DO n = 1, nmax-la + DO n = 1, nmax - la ! *** Increase the angular momentum component z of a *** v(coset(0, 0, la), 1, 1, n) = & - rap(3)*v(coset(0, 0, la-1), 1, 1, n)+ & - rpw(3)*v(coset(0, 0, la-1), 1, 1, n+1)+ & - f2*REAL(la-1, dp)*(v(coset(0, 0, la-2), 1, 1, n)+ & - f4*v(coset(0, 0, la-2), 1, 1, n+1)) + rap(3)*v(coset(0, 0, la - 1), 1, 1, n) + & + rpw(3)*v(coset(0, 0, la - 1), 1, 1, n + 1) + & + f2*REAL(la - 1, dp)*(v(coset(0, 0, la - 2), 1, 1, n) + & + f4*v(coset(0, 0, la - 2), 1, 1, n + 1)) ! *** Increase the angular momentum component y of a *** - az = la-1 + az = la - 1 v(coset(0, 1, az), 1, 1, n) = & - rap(2)*v(coset(0, 0, az), 1, 1, n)+ & - rpw(2)*v(coset(0, 0, az), 1, 1, n+1) + rap(2)*v(coset(0, 0, az), 1, 1, n) + & + rpw(2)*v(coset(0, 0, az), 1, 1, n + 1) DO ay = 2, la - az = la-ay + az = la - ay v(coset(0, ay, az), 1, 1, n) = & - rap(2)*v(coset(0, ay-1, az), 1, 1, n)+ & - rpw(2)*v(coset(0, ay-1, az), 1, 1, n+1)+ & - f2*REAL(ay-1, dp)*(v(coset(0, ay-2, az), 1, 1, n)+ & - f4*v(coset(0, ay-2, az), 1, 1, n+1)) + rap(2)*v(coset(0, ay - 1, az), 1, 1, n) + & + rpw(2)*v(coset(0, ay - 1, az), 1, 1, n + 1) + & + f2*REAL(ay - 1, dp)*(v(coset(0, ay - 2, az), 1, 1, n) + & + f4*v(coset(0, ay - 2, az), 1, 1, n + 1)) END DO ! *** Increase the angular momentum component x of a *** - DO ay = 0, la-1 - az = la-1-ay + DO ay = 0, la - 1 + az = la - 1 - ay v(coset(1, ay, az), 1, 1, n) = & - rap(1)*v(coset(0, ay, az), 1, 1, n)+ & - rpw(1)*v(coset(0, ay, az), 1, 1, n+1) + rap(1)*v(coset(0, ay, az), 1, 1, n) + & + rpw(1)*v(coset(0, ay, az), 1, 1, n + 1) END DO DO ax = 2, la - f3 = f2*REAL(ax-1, dp) - DO ay = 0, la-ax - az = la-ax-ay + f3 = f2*REAL(ax - 1, dp) + DO ay = 0, la - ax + az = la - ax - ay v(coset(ax, ay, az), 1, 1, n) = & - rap(1)*v(coset(ax-1, ay, az), 1, 1, n)+ & - rpw(1)*v(coset(ax-1, ay, az), 1, 1, n+1)+ & - f3*(v(coset(ax-2, ay, az), 1, 1, n)+ & - f4*v(coset(ax-2, ay, az), 1, 1, n+1)) + rap(1)*v(coset(ax - 1, ay, az), 1, 1, n) + & + rpw(1)*v(coset(ax - 1, ay, az), 1, 1, n + 1) + & + f3*(v(coset(ax - 2, ay, az), 1, 1, n) + & + f4*v(coset(ax - 2, ay, az), 1, 1, n + 1)) END DO END DO @@ -979,25 +979,25 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg ! *** Horizontal recurrence steps *** - rbp(:) = rap(:)-rab(:) + rbp(:) = rap(:) - rab(:) ! *** [ap||s]{n} = [(a+1i)s||s]{n} - (Bi - Ai)*[as||s]{n} *** - la_start = MAX(0, la_min-1) + la_start = MAX(0, la_min - 1) - DO la = la_start, la_max-1 - DO n = 1, nmax-la-1 + DO la = la_start, la_max - 1 + DO n = 1, nmax - la - 1 DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay v(coset(ax, ay, az), 2, 1, n) = & - v(coset(ax+1, ay, az), 1, 1, n)- & + v(coset(ax + 1, ay, az), 1, 1, n) - & rab(1)*v(coset(ax, ay, az), 1, 1, n) v(coset(ax, ay, az), 3, 1, n) = & - v(coset(ax, ay+1, az), 1, 1, n)- & + v(coset(ax, ay + 1, az), 1, 1, n) - & rab(2)*v(coset(ax, ay, az), 1, 1, n) v(coset(ax, ay, az), 4, 1, n) = & - v(coset(ax, ay, az+1), 1, 1, n)- & + v(coset(ax, ay, az + 1), 1, 1, n) - & rab(3)*v(coset(ax, ay, az), 1, 1, n) END DO END DO @@ -1011,48 +1011,48 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg ! *** f2*Ni(a)*( [(a-1i)s||s]{n} + *** ! *** f4*[(a-1i)s||s]{n+1}) *** - DO n = 1, nmax-la_max-1 + DO n = 1, nmax - la_max - 1 DO ax = 0, la_max fx = f2*REAL(ax, dp) - DO ay = 0, la_max-ax + DO ay = 0, la_max - ax fy = f2*REAL(ay, dp) - az = la_max-ax-ay + az = la_max - ax - ay fz = f2*REAL(az, dp) IF (ax == 0) THEN v(coset(ax, ay, az), 2, 1, n) = & - rbp(1)*v(coset(ax, ay, az), 1, 1, n)+ & - rpw(1)*v(coset(ax, ay, az), 1, 1, n+1) + rbp(1)*v(coset(ax, ay, az), 1, 1, n) + & + rpw(1)*v(coset(ax, ay, az), 1, 1, n + 1) ELSE v(coset(ax, ay, az), 2, 1, n) = & - rbp(1)*v(coset(ax, ay, az), 1, 1, n)+ & - rpw(1)*v(coset(ax, ay, az), 1, 1, n+1)+ & - fx*(v(coset(ax-1, ay, az), 1, 1, n)+ & - f4*v(coset(ax-1, ay, az), 1, 1, n+1)) + rbp(1)*v(coset(ax, ay, az), 1, 1, n) + & + rpw(1)*v(coset(ax, ay, az), 1, 1, n + 1) + & + fx*(v(coset(ax - 1, ay, az), 1, 1, n) + & + f4*v(coset(ax - 1, ay, az), 1, 1, n + 1)) END IF IF (ay == 0) THEN v(coset(ax, ay, az), 3, 1, n) = & - rbp(2)*v(coset(ax, ay, az), 1, 1, n)+ & - rpw(2)*v(coset(ax, ay, az), 1, 1, n+1) + rbp(2)*v(coset(ax, ay, az), 1, 1, n) + & + rpw(2)*v(coset(ax, ay, az), 1, 1, n + 1) ELSE v(coset(ax, ay, az), 3, 1, n) = & - rbp(2)*v(coset(ax, ay, az), 1, 1, n)+ & - rpw(2)*v(coset(ax, ay, az), 1, 1, n+1)+ & - fy*(v(coset(ax, ay-1, az), 1, 1, n)+ & - f4*v(coset(ax, ay-1, az), 1, 1, n+1)) + rbp(2)*v(coset(ax, ay, az), 1, 1, n) + & + rpw(2)*v(coset(ax, ay, az), 1, 1, n + 1) + & + fy*(v(coset(ax, ay - 1, az), 1, 1, n) + & + f4*v(coset(ax, ay - 1, az), 1, 1, n + 1)) END IF IF (az == 0) THEN v(coset(ax, ay, az), 4, 1, n) = & - rbp(3)*v(coset(ax, ay, az), 1, 1, n)+ & - rpw(3)*v(coset(ax, ay, az), 1, 1, n+1) + rbp(3)*v(coset(ax, ay, az), 1, 1, n) + & + rpw(3)*v(coset(ax, ay, az), 1, 1, n + 1) ELSE v(coset(ax, ay, az), 4, 1, n) = & - rbp(3)*v(coset(ax, ay, az), 1, 1, n)+ & - rpw(3)*v(coset(ax, ay, az), 1, 1, n+1)+ & - fz*(v(coset(ax, ay, az-1), 1, 1, n)+ & - f4*v(coset(ax, ay, az-1), 1, 1, n+1)) + rbp(3)*v(coset(ax, ay, az), 1, 1, n) + & + rpw(3)*v(coset(ax, ay, az), 1, 1, n + 1) + & + fz*(v(coset(ax, ay, az - 1), 1, 1, n) + & + f4*v(coset(ax, ay, az - 1), 1, 1, n + 1)) END IF END DO @@ -1068,37 +1068,37 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg ! *** [ab||s]{n} = [(a+1i)(b-1i)||s]{n} - *** ! *** (Bi - Ai)*[a(b-1i)||s]{n} *** - la_start = MAX(0, la_min-1) + la_start = MAX(0, la_min - 1) - DO la = la_start, la_max-1 - DO n = 1, nmax-la-lb + DO la = la_start, la_max - 1 + DO n = 1, nmax - la - lb DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay ! *** Shift of angular momentum component z from a to b *** v(coset(ax, ay, az), coset(0, 0, lb), 1, n) = & - v(coset(ax, ay, az+1), coset(0, 0, lb-1), 1, n)- & - rab(3)*v(coset(ax, ay, az), coset(0, 0, lb-1), 1, n) + v(coset(ax, ay, az + 1), coset(0, 0, lb - 1), 1, n) - & + rab(3)*v(coset(ax, ay, az), coset(0, 0, lb - 1), 1, n) ! *** Shift of angular momentum component y from a to b *** DO by = 1, lb - bz = lb-by + bz = lb - by v(coset(ax, ay, az), coset(0, by, bz), 1, n) = & - v(coset(ax, ay+1, az), coset(0, by-1, bz), 1, n)- & - rab(2)*v(coset(ax, ay, az), coset(0, by-1, bz), 1, n) + v(coset(ax, ay + 1, az), coset(0, by - 1, bz), 1, n) - & + rab(2)*v(coset(ax, ay, az), coset(0, by - 1, bz), 1, n) END DO ! *** Shift of angular momentum component x from a to b *** DO bx = 1, lb - DO by = 0, lb-bx - bz = lb-bx-by + DO by = 0, lb - bx + bz = lb - bx - by v(coset(ax, ay, az), coset(bx, by, bz), 1, n) = & - v(coset(ax+1, ay, az), coset(bx-1, by, bz), 1, n)- & - rab(1)*v(coset(ax, ay, az), coset(bx-1, by, bz), 1, n) + v(coset(ax + 1, ay, az), coset(bx - 1, by, bz), 1, n) - & + rab(1)*v(coset(ax, ay, az), coset(bx - 1, by, bz), 1, n) END DO END DO @@ -1116,115 +1116,115 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg ! *** f2*Ni(b-1i)*( [a(b-2i)||s]{n} + *** ! *** f4*[a(b-2i)||s]{n+1}) *** - DO n = 1, nmax-la_max-lb + DO n = 1, nmax - la_max - lb DO ax = 0, la_max fx = f2*REAL(ax, dp) - DO ay = 0, la_max-ax + DO ay = 0, la_max - ax fy = f2*REAL(ay, dp) - az = la_max-ax-ay + az = la_max - ax - ay fz = f2*REAL(az, dp) ! *** Shift of angular momentum component z from a to b *** - f3 = f2*REAL(lb-1, dp) + f3 = f2*REAL(lb - 1, dp) IF (az == 0) THEN v(coset(ax, ay, az), coset(0, 0, lb), 1, n) = & - rbp(3)*v(coset(ax, ay, az), coset(0, 0, lb-1), 1, n)+ & - rpw(3)*v(coset(ax, ay, az), coset(0, 0, lb-1), 1, n+1)+ & - f3*(v(coset(ax, ay, az), coset(0, 0, lb-2), 1, n)+ & - f4*v(coset(ax, ay, az), coset(0, 0, lb-2), 1, n+1)) + rbp(3)*v(coset(ax, ay, az), coset(0, 0, lb - 1), 1, n) + & + rpw(3)*v(coset(ax, ay, az), coset(0, 0, lb - 1), 1, n + 1) + & + f3*(v(coset(ax, ay, az), coset(0, 0, lb - 2), 1, n) + & + f4*v(coset(ax, ay, az), coset(0, 0, lb - 2), 1, n + 1)) ELSE v(coset(ax, ay, az), coset(0, 0, lb), 1, n) = & - rbp(3)*v(coset(ax, ay, az), coset(0, 0, lb-1), 1, n)+ & - rpw(3)*v(coset(ax, ay, az), coset(0, 0, lb-1), 1, n+1)+ & - fz*(v(coset(ax, ay, az-1), coset(0, 0, lb-1), 1, n)+ & - f4*v(coset(ax, ay, az-1), coset(0, 0, lb-1), 1, n+1))+ & - f3*(v(coset(ax, ay, az), coset(0, 0, lb-2), 1, n)+ & - f4*v(coset(ax, ay, az), coset(0, 0, lb-2), 1, n+1)) + rbp(3)*v(coset(ax, ay, az), coset(0, 0, lb - 1), 1, n) + & + rpw(3)*v(coset(ax, ay, az), coset(0, 0, lb - 1), 1, n + 1) + & + fz*(v(coset(ax, ay, az - 1), coset(0, 0, lb - 1), 1, n) + & + f4*v(coset(ax, ay, az - 1), coset(0, 0, lb - 1), 1, n + 1)) + & + f3*(v(coset(ax, ay, az), coset(0, 0, lb - 2), 1, n) + & + f4*v(coset(ax, ay, az), coset(0, 0, lb - 2), 1, n + 1)) END IF ! *** Shift of angular momentum component y from a to b *** IF (ay == 0) THEN - bz = lb-1 + bz = lb - 1 v(coset(ax, ay, az), coset(0, 1, bz), 1, n) = & - rbp(2)*v(coset(ax, ay, az), coset(0, 0, bz), 1, n)+ & - rpw(2)*v(coset(ax, ay, az), coset(0, 0, bz), 1, n+1) + rbp(2)*v(coset(ax, ay, az), coset(0, 0, bz), 1, n) + & + rpw(2)*v(coset(ax, ay, az), coset(0, 0, bz), 1, n + 1) DO by = 2, lb - bz = lb-by - f3 = f2*REAL(by-1, dp) + bz = lb - by + f3 = f2*REAL(by - 1, dp) v(coset(ax, ay, az), coset(0, by, bz), 1, n) = & - rbp(2)*v(coset(ax, ay, az), coset(0, by-1, bz), 1, n)+ & - rpw(2)*v(coset(ax, ay, az), coset(0, by-1, bz), 1, n+1)+ & - f3*(v(coset(ax, ay, az), coset(0, by-2, bz), 1, n)+ & - f4*v(coset(ax, ay, az), coset(0, by-2, bz), 1, n+1)) + rbp(2)*v(coset(ax, ay, az), coset(0, by - 1, bz), 1, n) + & + rpw(2)*v(coset(ax, ay, az), coset(0, by - 1, bz), 1, n + 1) + & + f3*(v(coset(ax, ay, az), coset(0, by - 2, bz), 1, n) + & + f4*v(coset(ax, ay, az), coset(0, by - 2, bz), 1, n + 1)) END DO ELSE - bz = lb-1 + bz = lb - 1 v(coset(ax, ay, az), coset(0, 1, bz), 1, n) = & - rbp(2)*v(coset(ax, ay, az), coset(0, 0, bz), 1, n)+ & - rpw(2)*v(coset(ax, ay, az), coset(0, 0, bz), 1, n+1)+ & - fy*(v(coset(ax, ay-1, az), coset(0, 0, bz), 1, n)+ & - f4*v(coset(ax, ay-1, az), coset(0, 0, bz), 1, n+1)) + rbp(2)*v(coset(ax, ay, az), coset(0, 0, bz), 1, n) + & + rpw(2)*v(coset(ax, ay, az), coset(0, 0, bz), 1, n + 1) + & + fy*(v(coset(ax, ay - 1, az), coset(0, 0, bz), 1, n) + & + f4*v(coset(ax, ay - 1, az), coset(0, 0, bz), 1, n + 1)) DO by = 2, lb - bz = lb-by - f3 = f2*REAL(by-1, dp) + bz = lb - by + f3 = f2*REAL(by - 1, dp) v(coset(ax, ay, az), coset(0, by, bz), 1, n) = & - rbp(2)*v(coset(ax, ay, az), coset(0, by-1, bz), 1, n)+ & - rpw(2)*v(coset(ax, ay, az), coset(0, by-1, bz), 1, n+1)+ & - fy*(v(coset(ax, ay-1, az), coset(0, by-1, bz), 1, n)+ & - f4*v(coset(ax, ay-1, az), & - coset(0, by-1, bz), 1, n+1))+ & - f3*(v(coset(ax, ay, az), coset(0, by-2, bz), 1, n)+ & - f4*v(coset(ax, ay, az), coset(0, by-2, bz), 1, n+1)) + rbp(2)*v(coset(ax, ay, az), coset(0, by - 1, bz), 1, n) + & + rpw(2)*v(coset(ax, ay, az), coset(0, by - 1, bz), 1, n + 1) + & + fy*(v(coset(ax, ay - 1, az), coset(0, by - 1, bz), 1, n) + & + f4*v(coset(ax, ay - 1, az), & + coset(0, by - 1, bz), 1, n + 1)) + & + f3*(v(coset(ax, ay, az), coset(0, by - 2, bz), 1, n) + & + f4*v(coset(ax, ay, az), coset(0, by - 2, bz), 1, n + 1)) END DO END IF ! *** Shift of angular momentum component x from a to b *** IF (ax == 0) THEN - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by v(coset(ax, ay, az), coset(1, by, bz), 1, n) = & - rbp(1)*v(coset(ax, ay, az), coset(0, by, bz), 1, n)+ & - rpw(1)*v(coset(ax, ay, az), coset(0, by, bz), 1, n+1) + rbp(1)*v(coset(ax, ay, az), coset(0, by, bz), 1, n) + & + rpw(1)*v(coset(ax, ay, az), coset(0, by, bz), 1, n + 1) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by v(coset(ax, ay, az), coset(bx, by, bz), 1, n) = & - rbp(1)*v(coset(ax, ay, az), coset(bx-1, by, bz), 1, n)+ & + rbp(1)*v(coset(ax, ay, az), coset(bx - 1, by, bz), 1, n) + & rpw(1)*v(coset(ax, ay, az), & - coset(bx-1, by, bz), 1, n+1)+ & - f3*(v(coset(ax, ay, az), coset(bx-2, by, bz), 1, n)+ & - f4*v(coset(ax, ay, az), coset(bx-2, by, bz), 1, n+1)) + coset(bx - 1, by, bz), 1, n + 1) + & + f3*(v(coset(ax, ay, az), coset(bx - 2, by, bz), 1, n) + & + f4*v(coset(ax, ay, az), coset(bx - 2, by, bz), 1, n + 1)) END DO END DO ELSE - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by v(coset(ax, ay, az), coset(1, by, bz), 1, n) = & - rbp(1)*v(coset(ax, ay, az), coset(0, by, bz), 1, n)+ & - rpw(1)*v(coset(ax, ay, az), coset(0, by, bz), 1, n+1)+ & - fx*(v(coset(ax-1, ay, az), coset(0, by, bz), 1, n)+ & - f4*v(coset(ax-1, ay, az), coset(0, by, bz), 1, n+1)) + rbp(1)*v(coset(ax, ay, az), coset(0, by, bz), 1, n) + & + rpw(1)*v(coset(ax, ay, az), coset(0, by, bz), 1, n + 1) + & + fx*(v(coset(ax - 1, ay, az), coset(0, by, bz), 1, n) + & + f4*v(coset(ax - 1, ay, az), coset(0, by, bz), 1, n + 1)) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by v(coset(ax, ay, az), coset(bx, by, bz), 1, n) = & - rbp(1)*v(coset(ax, ay, az), coset(bx-1, by, bz), 1, n)+ & + rbp(1)*v(coset(ax, ay, az), coset(bx - 1, by, bz), 1, n) + & rpw(1)*v(coset(ax, ay, az), & - coset(bx-1, by, bz), 1, n+1)+ & - fx*(v(coset(ax-1, ay, az), & - coset(bx-1, by, bz), 1, n)+ & - f4*v(coset(ax-1, ay, az), & - coset(bx-1, by, bz), 1, n+1))+ & - f3*(v(coset(ax, ay, az), coset(bx-2, by, bz), 1, n)+ & - f4*v(coset(ax, ay, az), coset(bx-2, by, bz), 1, n+1)) + coset(bx - 1, by, bz), 1, n + 1) + & + fx*(v(coset(ax - 1, ay, az), & + coset(bx - 1, by, bz), 1, n) + & + f4*v(coset(ax - 1, ay, az), & + coset(bx - 1, by, bz), 1, n + 1)) + & + f3*(v(coset(ax, ay, az), coset(bx - 2, by, bz), 1, n) + & + f4*v(coset(ax, ay, az), coset(bx - 2, by, bz), 1, n + 1)) END DO END DO END IF @@ -1243,15 +1243,15 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg ! *** Vertical recurrence steps: [ss||s] -> [sb||s] *** - rbp(:) = rap(:)-rab(:) + rbp(:) = rap(:) - rab(:) ! *** [sp||s]{n} = (Pi - Bi)*[ss||s]{n} + *** ! *** (Wi - Pi)*[ss||s]{n+1} *** - DO n = 1, nmax-1 - v(1, 2, 1, n) = rbp(1)*v(1, 1, 1, n)+rpw(1)*v(1, 1, 1, n+1) - v(1, 3, 1, n) = rbp(2)*v(1, 1, 1, n)+rpw(2)*v(1, 1, 1, n+1) - v(1, 4, 1, n) = rbp(3)*v(1, 1, 1, n)+rpw(3)*v(1, 1, 1, n+1) + DO n = 1, nmax - 1 + v(1, 2, 1, n) = rbp(1)*v(1, 1, 1, n) + rpw(1)*v(1, 1, 1, n + 1) + v(1, 3, 1, n) = rbp(2)*v(1, 1, 1, n) + rpw(2)*v(1, 1, 1, n + 1) + v(1, 4, 1, n) = rbp(3)*v(1, 1, 1, n) + rpw(3)*v(1, 1, 1, n + 1) END DO ! *** [sb||s]{n} = (Pi - Bi)*[s(b-1i)||s]{n} + *** @@ -1261,50 +1261,50 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg DO lb = 2, lb_max - DO n = 1, nmax-lb + DO n = 1, nmax - lb ! *** Increase the angular momentum component z of b *** v(1, coset(0, 0, lb), 1, n) = & - rbp(3)*v(1, coset(0, 0, lb-1), 1, n)+ & - rpw(3)*v(1, coset(0, 0, lb-1), 1, n+1)+ & - f2*REAL(lb-1, dp)*(v(1, coset(0, 0, lb-2), 1, n)+ & - f4*v(1, coset(0, 0, lb-2), 1, n+1)) + rbp(3)*v(1, coset(0, 0, lb - 1), 1, n) + & + rpw(3)*v(1, coset(0, 0, lb - 1), 1, n + 1) + & + f2*REAL(lb - 1, dp)*(v(1, coset(0, 0, lb - 2), 1, n) + & + f4*v(1, coset(0, 0, lb - 2), 1, n + 1)) ! *** Increase the angular momentum component y of b *** - bz = lb-1 + bz = lb - 1 v(1, coset(0, 1, bz), 1, n) = & - rbp(2)*v(1, coset(0, 0, bz), 1, n)+ & - rpw(2)*v(1, coset(0, 0, bz), 1, n+1) + rbp(2)*v(1, coset(0, 0, bz), 1, n) + & + rpw(2)*v(1, coset(0, 0, bz), 1, n + 1) DO by = 2, lb - bz = lb-by + bz = lb - by v(1, coset(0, by, bz), 1, n) = & - rbp(2)*v(1, coset(0, by-1, bz), 1, n)+ & - rpw(2)*v(1, coset(0, by-1, bz), 1, n+1)+ & - f2*REAL(by-1, dp)*(v(1, coset(0, by-2, bz), 1, n)+ & - f4*v(1, coset(0, by-2, bz), 1, n+1)) + rbp(2)*v(1, coset(0, by - 1, bz), 1, n) + & + rpw(2)*v(1, coset(0, by - 1, bz), 1, n + 1) + & + f2*REAL(by - 1, dp)*(v(1, coset(0, by - 2, bz), 1, n) + & + f4*v(1, coset(0, by - 2, bz), 1, n + 1)) END DO ! *** Increase the angular momentum component x of b *** - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by v(1, coset(1, by, bz), 1, n) = & - rbp(1)*v(1, coset(0, by, bz), 1, n)+ & - rpw(1)*v(1, coset(0, by, bz), 1, n+1) + rbp(1)*v(1, coset(0, by, bz), 1, n) + & + rpw(1)*v(1, coset(0, by, bz), 1, n + 1) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by v(1, coset(bx, by, bz), 1, n) = & - rbp(1)*v(1, coset(bx-1, by, bz), 1, n)+ & - rpw(1)*v(1, coset(bx-1, by, bz), 1, n+1)+ & - f3*(v(1, coset(bx-2, by, bz), 1, n)+ & - f4*v(1, coset(bx-2, by, bz), 1, n+1)) + rbp(1)*v(1, coset(bx - 1, by, bz), 1, n) + & + rpw(1)*v(1, coset(bx - 1, by, bz), 1, n + 1) + & + f3*(v(1, coset(bx - 2, by, bz), 1, n) + & + f4*v(1, coset(bx - 2, by, bz), 1, n + 1)) END DO END DO @@ -1326,14 +1326,14 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg f6 = 0.5_dp*zetw f7 = 0.5_dp*zetq - rcw(:) = rcp(:)+rpw(:) + rcw(:) = rcp(:) + rpw(:) ! *** [ss||p]{n} = (Wi - Ci)*[ss||s]{n+1} (i = x,y,z) *** - DO n = 1, nmax-1 - v(1, 1, 2, n) = rcw(1)*v(1, 1, 1, n+1) - v(1, 1, 3, n) = rcw(2)*v(1, 1, 1, n+1) - v(1, 1, 4, n) = rcw(3)*v(1, 1, 1, n+1) + DO n = 1, nmax - 1 + v(1, 1, 2, n) = rcw(1)*v(1, 1, 1, n + 1) + v(1, 1, 3, n) = rcw(2)*v(1, 1, 1, n + 1) + v(1, 1, 4, n) = rcw(3)*v(1, 1, 1, n + 1) END DO ! *** [ss||c]{n} = (Wi - Ci)*[ss||c-1i]{n+1} + *** @@ -1342,42 +1342,42 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg DO lc = 2, lc_max - DO n = 1, nmax-lc + DO n = 1, nmax - lc ! *** Increase the angular momentum component z of c *** v(1, 1, coset(0, 0, lc), n) = & - rcw(3)*v(1, 1, coset(0, 0, lc-1), n+1)+ & - f7*REAL(lc-1, dp)*(v(1, 1, coset(0, 0, lc-2), n)+ & - f5*v(1, 1, coset(0, 0, lc-2), n+1)) + rcw(3)*v(1, 1, coset(0, 0, lc - 1), n + 1) + & + f7*REAL(lc - 1, dp)*(v(1, 1, coset(0, 0, lc - 2), n) + & + f5*v(1, 1, coset(0, 0, lc - 2), n + 1)) ! *** Increase the angular momentum component y of c *** - cz = lc-1 - v(1, 1, coset(0, 1, cz), n) = rcw(2)*v(1, 1, coset(0, 0, cz), n+1) + cz = lc - 1 + v(1, 1, coset(0, 1, cz), n) = rcw(2)*v(1, 1, coset(0, 0, cz), n + 1) DO cy = 2, lc - cz = lc-cy + cz = lc - cy v(1, 1, coset(0, cy, cz), n) = & - rcw(2)*v(1, 1, coset(0, cy-1, cz), n+1)+ & - f7*REAL(cy-1, dp)*(v(1, 1, coset(0, cy-2, cz), n)+ & - f5*v(1, 1, coset(0, cy-2, cz), n+1)) + rcw(2)*v(1, 1, coset(0, cy - 1, cz), n + 1) + & + f7*REAL(cy - 1, dp)*(v(1, 1, coset(0, cy - 2, cz), n) + & + f5*v(1, 1, coset(0, cy - 2, cz), n + 1)) END DO ! *** Increase the angular momentum component x of c *** - DO cy = 0, lc-1 - cz = lc-1-cy - v(1, 1, coset(1, cy, cz), n) = rcw(1)*v(1, 1, coset(0, cy, cz), n+1) + DO cy = 0, lc - 1 + cz = lc - 1 - cy + v(1, 1, coset(1, cy, cz), n) = rcw(1)*v(1, 1, coset(0, cy, cz), n + 1) END DO DO cx = 2, lc - DO cy = 0, lc-cx - cz = lc-cx-cy + DO cy = 0, lc - cx + cz = lc - cx - cy v(1, 1, coset(cx, cy, cz), n) = & - rcw(1)*v(1, 1, coset(cx-1, cy, cz), n+1)+ & - f7*REAL(cx-1, dp)*(v(1, 1, coset(cx-2, cy, cz), n)+ & - f5*v(1, 1, coset(cx-2, cy, cz), n+1)) + rcw(1)*v(1, 1, coset(cx - 1, cy, cz), n + 1) + & + f7*REAL(cx - 1, dp)*(v(1, 1, coset(cx - 2, cy, cz), n) + & + f5*v(1, 1, coset(cx - 2, cy, cz), n + 1)) END DO END DO @@ -1390,13 +1390,13 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg DO lc = 1, lc_max DO cx = 0, lc - DO cy = 0, lc-cx - cz = lc-cx-cy + DO cy = 0, lc - cx + cz = lc - cx - cy coc = coset(cx, cy, cz) - cocx = coset(MAX(0, cx-1), cy, cz) - cocy = coset(cx, MAX(0, cy-1), cz) - cocz = coset(cx, cy, MAX(0, cz-1)) + cocx = coset(MAX(0, cx - 1), cy, cz) + cocy = coset(cx, MAX(0, cy - 1), cz) + cocz = coset(cx, cy, MAX(0, cz - 1)) fcx = f6*REAL(cx, dp) fcy = f6*REAL(cy, dp) @@ -1412,16 +1412,16 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg ! *** (Wi - Pi)*[ss||c]{n+1} + *** ! *** f6*Ni(c)*[ss||c-1i]{n+1} (i = x,y,z) *** - DO n = 1, nmax-1-lc - v(2, 1, coc, n) = rap(1)*v(1, 1, coc, n)+ & - rpw(1)*v(1, 1, coc, n+1)+ & - fcx*v(1, 1, cocx, n+1) - v(3, 1, coc, n) = rap(2)*v(1, 1, coc, n)+ & - rpw(2)*v(1, 1, coc, n+1)+ & - fcy*v(1, 1, cocy, n+1) - v(4, 1, coc, n) = rap(3)*v(1, 1, coc, n)+ & - rpw(3)*v(1, 1, coc, n+1)+ & - fcz*v(1, 1, cocz, n+1) + DO n = 1, nmax - 1 - lc + v(2, 1, coc, n) = rap(1)*v(1, 1, coc, n) + & + rpw(1)*v(1, 1, coc, n + 1) + & + fcx*v(1, 1, cocx, n + 1) + v(3, 1, coc, n) = rap(2)*v(1, 1, coc, n) + & + rpw(2)*v(1, 1, coc, n + 1) + & + fcy*v(1, 1, cocy, n + 1) + v(4, 1, coc, n) = rap(3)*v(1, 1, coc, n) + & + rpw(3)*v(1, 1, coc, n + 1) + & + fcz*v(1, 1, cocz, n + 1) END DO ! *** [as||c]{n} = (Pi - Ai)*[(a-1i)s||c]{n} + *** @@ -1432,56 +1432,56 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg DO la = 2, la_max - DO n = 1, nmax-la-lc + DO n = 1, nmax - la - lc ! *** Increase the angular momentum component z of a *** v(coset(0, 0, la), 1, coc, n) = & - rap(3)*v(coset(0, 0, la-1), 1, coc, n)+ & - rpw(3)*v(coset(0, 0, la-1), 1, coc, n+1)+ & - f2*REAL(la-1, dp)*(v(coset(0, 0, la-2), 1, coc, n)+ & - f4*v(coset(0, 0, la-2), 1, coc, n+1))+ & - fcz*v(coset(0, 0, la-1), 1, cocz, n+1) + rap(3)*v(coset(0, 0, la - 1), 1, coc, n) + & + rpw(3)*v(coset(0, 0, la - 1), 1, coc, n + 1) + & + f2*REAL(la - 1, dp)*(v(coset(0, 0, la - 2), 1, coc, n) + & + f4*v(coset(0, 0, la - 2), 1, coc, n + 1)) + & + fcz*v(coset(0, 0, la - 1), 1, cocz, n + 1) ! *** Increase the angular momentum component y of a *** - az = la-1 + az = la - 1 v(coset(0, 1, az), 1, coc, n) = & - rap(2)*v(coset(0, 0, az), 1, coc, n)+ & - rpw(2)*v(coset(0, 0, az), 1, coc, n+1)+ & - fcy*v(coset(0, 0, az), 1, cocy, n+1) + rap(2)*v(coset(0, 0, az), 1, coc, n) + & + rpw(2)*v(coset(0, 0, az), 1, coc, n + 1) + & + fcy*v(coset(0, 0, az), 1, cocy, n + 1) DO ay = 2, la - f3 = f2*REAL(ay-1, dp) - az = la-ay + f3 = f2*REAL(ay - 1, dp) + az = la - ay v(coset(0, ay, az), 1, coc, n) = & - rap(2)*v(coset(0, ay-1, az), 1, coc, n)+ & - rpw(2)*v(coset(0, ay-1, az), 1, coc, n+1)+ & - f3*(v(coset(0, ay-2, az), 1, coc, n)+ & - f4*v(coset(0, ay-2, az), 1, coc, n+1))+ & - fcy*v(coset(0, ay-1, az), 1, cocy, n+1) + rap(2)*v(coset(0, ay - 1, az), 1, coc, n) + & + rpw(2)*v(coset(0, ay - 1, az), 1, coc, n + 1) + & + f3*(v(coset(0, ay - 2, az), 1, coc, n) + & + f4*v(coset(0, ay - 2, az), 1, coc, n + 1)) + & + fcy*v(coset(0, ay - 1, az), 1, cocy, n + 1) END DO ! *** Increase the angular momentum component x of a *** - DO ay = 0, la-1 - az = la-1-ay + DO ay = 0, la - 1 + az = la - 1 - ay v(coset(1, ay, az), 1, coc, n) = & - rap(1)*v(coset(0, ay, az), 1, coc, n)+ & - rpw(1)*v(coset(0, ay, az), 1, coc, n+1)+ & - fcx*v(coset(0, ay, az), 1, cocx, n+1) + rap(1)*v(coset(0, ay, az), 1, coc, n) + & + rpw(1)*v(coset(0, ay, az), 1, coc, n + 1) + & + fcx*v(coset(0, ay, az), 1, cocx, n + 1) END DO DO ax = 2, la - f3 = f2*REAL(ax-1, dp) - DO ay = 0, la-ax - az = la-ax-ay + f3 = f2*REAL(ax - 1, dp) + DO ay = 0, la - ax + az = la - ax - ay v(coset(ax, ay, az), 1, coc, n) = & - rap(1)*v(coset(ax-1, ay, az), 1, coc, n)+ & - rpw(1)*v(coset(ax-1, ay, az), 1, coc, n+1)+ & - f3*(v(coset(ax-2, ay, az), 1, coc, n)+ & - f4*v(coset(ax-2, ay, az), 1, coc, n+1))+ & - fcx*v(coset(ax-1, ay, az), 1, cocx, n+1) + rap(1)*v(coset(ax - 1, ay, az), 1, coc, n) + & + rpw(1)*v(coset(ax - 1, ay, az), 1, coc, n + 1) + & + f3*(v(coset(ax - 2, ay, az), 1, coc, n) + & + f4*v(coset(ax - 2, ay, az), 1, coc, n + 1)) + & + fcx*v(coset(ax - 1, ay, az), 1, cocx, n + 1) END DO END DO @@ -1497,21 +1497,21 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg ! *** [ap||c]{n} = [(a+1i)s||c]{n} - (Bi - Ai)*[as||c]{n} *** - la_start = MAX(0, la_min-1) + la_start = MAX(0, la_min - 1) - DO la = la_start, la_max-1 - DO n = 1, nmax-la-1-lc + DO la = la_start, la_max - 1 + DO n = 1, nmax - la - 1 - lc DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay v(coset(ax, ay, az), 2, coc, n) = & - v(coset(ax+1, ay, az), 1, coc, n)- & + v(coset(ax + 1, ay, az), 1, coc, n) - & rab(1)*v(coset(ax, ay, az), 1, coc, n) v(coset(ax, ay, az), 3, coc, n) = & - v(coset(ax, ay+1, az), 1, coc, n)- & + v(coset(ax, ay + 1, az), 1, coc, n) - & rab(2)*v(coset(ax, ay, az), 1, coc, n) v(coset(ax, ay, az), 4, coc, n) = & - v(coset(ax, ay, az+1), 1, coc, n)- & + v(coset(ax, ay, az + 1), 1, coc, n) - & rab(3)*v(coset(ax, ay, az), 1, coc, n) END DO END DO @@ -1526,54 +1526,54 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg ! *** f4*[(a-1i)s||c]{n+1}) + *** ! *** f6*Ni(c)*[(as||c-1i]{n+1}) *** - DO n = 1, nmax-la_max-1-lc + DO n = 1, nmax - la_max - 1 - lc DO ax = 0, la_max fx = f2*REAL(ax, dp) - DO ay = 0, la_max-ax + DO ay = 0, la_max - ax fy = f2*REAL(ay, dp) - az = la_max-ax-ay + az = la_max - ax - ay fz = f2*REAL(az, dp) IF (ax == 0) THEN v(coset(ax, ay, az), 2, coc, n) = & - rbp(1)*v(coset(ax, ay, az), 1, coc, n)+ & - rpw(1)*v(coset(ax, ay, az), 1, coc, n+1)+ & - fcx*v(coset(ax, ay, az), 1, cocx, n+1) + rbp(1)*v(coset(ax, ay, az), 1, coc, n) + & + rpw(1)*v(coset(ax, ay, az), 1, coc, n + 1) + & + fcx*v(coset(ax, ay, az), 1, cocx, n + 1) ELSE v(coset(ax, ay, az), 2, coc, n) = & - rbp(1)*v(coset(ax, ay, az), 1, coc, n)+ & - rpw(1)*v(coset(ax, ay, az), 1, coc, n+1)+ & - fx*(v(coset(ax-1, ay, az), 1, coc, n)+ & - f4*v(coset(ax-1, ay, az), 1, coc, n+1))+ & - fcx*v(coset(ax, ay, az), 1, cocx, n+1) + rbp(1)*v(coset(ax, ay, az), 1, coc, n) + & + rpw(1)*v(coset(ax, ay, az), 1, coc, n + 1) + & + fx*(v(coset(ax - 1, ay, az), 1, coc, n) + & + f4*v(coset(ax - 1, ay, az), 1, coc, n + 1)) + & + fcx*v(coset(ax, ay, az), 1, cocx, n + 1) END IF IF (ay == 0) THEN v(coset(ax, ay, az), 3, coc, n) = & - rbp(2)*v(coset(ax, ay, az), 1, coc, n)+ & - rpw(2)*v(coset(ax, ay, az), 1, coc, n+1)+ & - fcy*v(coset(ax, ay, az), 1, cocy, n+1) + rbp(2)*v(coset(ax, ay, az), 1, coc, n) + & + rpw(2)*v(coset(ax, ay, az), 1, coc, n + 1) + & + fcy*v(coset(ax, ay, az), 1, cocy, n + 1) ELSE v(coset(ax, ay, az), 3, coc, n) = & - rbp(2)*v(coset(ax, ay, az), 1, coc, n)+ & - rpw(2)*v(coset(ax, ay, az), 1, coc, n+1)+ & - fy*(v(coset(ax, ay-1, az), 1, coc, n)+ & - f4*v(coset(ax, ay-1, az), 1, coc, n+1))+ & - fcy*v(coset(ax, ay, az), 1, cocy, n+1) + rbp(2)*v(coset(ax, ay, az), 1, coc, n) + & + rpw(2)*v(coset(ax, ay, az), 1, coc, n + 1) + & + fy*(v(coset(ax, ay - 1, az), 1, coc, n) + & + f4*v(coset(ax, ay - 1, az), 1, coc, n + 1)) + & + fcy*v(coset(ax, ay, az), 1, cocy, n + 1) END IF IF (az == 0) THEN v(coset(ax, ay, az), 4, coc, n) = & - rbp(3)*v(coset(ax, ay, az), 1, coc, n)+ & - rpw(3)*v(coset(ax, ay, az), 1, coc, n+1)+ & - fcz*v(coset(ax, ay, az), 1, cocz, n+1) + rbp(3)*v(coset(ax, ay, az), 1, coc, n) + & + rpw(3)*v(coset(ax, ay, az), 1, coc, n + 1) + & + fcz*v(coset(ax, ay, az), 1, cocz, n + 1) ELSE v(coset(ax, ay, az), 4, coc, n) = & - rbp(3)*v(coset(ax, ay, az), 1, coc, n)+ & - rpw(3)*v(coset(ax, ay, az), 1, coc, n+1)+ & - fz*(v(coset(ax, ay, az-1), 1, coc, n)+ & - f4*v(coset(ax, ay, az-1), 1, coc, n+1))+ & - fcz*v(coset(ax, ay, az), 1, cocz, n+1) + rbp(3)*v(coset(ax, ay, az), 1, coc, n) + & + rpw(3)*v(coset(ax, ay, az), 1, coc, n + 1) + & + fz*(v(coset(ax, ay, az - 1), 1, coc, n) + & + f4*v(coset(ax, ay, az - 1), 1, coc, n + 1)) + & + fcz*v(coset(ax, ay, az), 1, cocz, n + 1) END IF END DO @@ -1589,43 +1589,43 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg ! *** [ab||c]{n} = [(a+1i)(b-1i)||c]{n} - *** ! *** (Bi - Ai)*[a(b-1i)||c]{n} *** - la_start = MAX(0, la_min-1) + la_start = MAX(0, la_min - 1) - DO la = la_start, la_max-1 - DO n = 1, nmax-la-lb-lc + DO la = la_start, la_max - 1 + DO n = 1, nmax - la - lb - lc DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay ! *** Shift of angular momentum component z *** v(coset(ax, ay, az), coset(0, 0, lb), coc, n) = & - v(coset(ax, ay, az+1), & - coset(0, 0, lb-1), coc, n)- & + v(coset(ax, ay, az + 1), & + coset(0, 0, lb - 1), coc, n) - & rab(3)*v(coset(ax, ay, az), & - coset(0, 0, lb-1), coc, n) + coset(0, 0, lb - 1), coc, n) ! *** Shift of angular momentum component y *** DO by = 1, lb - bz = lb-by + bz = lb - by v(coset(ax, ay, az), coset(0, by, bz), coc, n) = & - v(coset(ax, ay+1, az), & - coset(0, by-1, bz), coc, n)- & + v(coset(ax, ay + 1, az), & + coset(0, by - 1, bz), coc, n) - & rab(2)*v(coset(ax, ay, az), & - coset(0, by-1, bz), coc, n) + coset(0, by - 1, bz), coc, n) END DO ! *** Shift of angular momentum component x *** DO bx = 1, lb - DO by = 0, lb-bx - bz = lb-bx-by + DO by = 0, lb - bx + bz = lb - bx - by v(coset(ax, ay, az), coset(bx, by, bz), coc, n) = & - v(coset(ax+1, ay, az), & - coset(bx-1, by, bz), coc, n)- & + v(coset(ax + 1, ay, az), & + coset(bx - 1, by, bz), coc, n) - & rab(1)*v(coset(ax, ay, az), & - coset(bx-1, by, bz), coc, n) + coset(bx - 1, by, bz), coc, n) END DO END DO @@ -1644,172 +1644,172 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg ! *** f4*[a(b-2i)||c]{n+1}) + *** ! *** f6*Ni(c)*[a(b-1i)||c-1i]{n+1}) *** - DO n = 1, nmax-la_max-lb-lc + DO n = 1, nmax - la_max - lb - lc DO ax = 0, la_max fx = f2*REAL(ax, dp) - DO ay = 0, la_max-ax + DO ay = 0, la_max - ax fy = f2*REAL(ay, dp) - az = la_max-ax-ay + az = la_max - ax - ay fz = f2*REAL(az, dp) ! *** Shift of angular momentum component z from a to b *** - f3 = f2*REAL(lb-1, dp) + f3 = f2*REAL(lb - 1, dp) IF (az == 0) THEN v(coset(ax, ay, az), coset(0, 0, lb), coc, n) = & rbp(3)*v(coset(ax, ay, az), & - coset(0, 0, lb-1), coc, n)+ & + coset(0, 0, lb - 1), coc, n) + & rpw(3)*v(coset(ax, ay, az), & - coset(0, 0, lb-1), coc, n+1)+ & + coset(0, 0, lb - 1), coc, n + 1) + & f3*(v(coset(ax, ay, az), & - coset(0, 0, lb-2), coc, n)+ & + coset(0, 0, lb - 2), coc, n) + & f4*v(coset(ax, ay, az), & - coset(0, 0, lb-2), coc, n+1))+ & + coset(0, 0, lb - 2), coc, n + 1)) + & fcz*v(coset(ax, ay, az), & - coset(0, 0, lb-1), cocz, n+1) + coset(0, 0, lb - 1), cocz, n + 1) ELSE v(coset(ax, ay, az), coset(0, 0, lb), coc, n) = & rbp(3)*v(coset(ax, ay, az), & - coset(0, 0, lb-1), coc, n)+ & + coset(0, 0, lb - 1), coc, n) + & rpw(3)*v(coset(ax, ay, az), & - coset(0, 0, lb-1), coc, n+1)+ & - fz*(v(coset(ax, ay, az-1), & - coset(0, 0, lb-1), coc, n)+ & - f4*v(coset(ax, ay, az-1), & - coset(0, 0, lb-1), coc, n+1))+ & + coset(0, 0, lb - 1), coc, n + 1) + & + fz*(v(coset(ax, ay, az - 1), & + coset(0, 0, lb - 1), coc, n) + & + f4*v(coset(ax, ay, az - 1), & + coset(0, 0, lb - 1), coc, n + 1)) + & f3*(v(coset(ax, ay, az), & - coset(0, 0, lb-2), coc, n)+ & + coset(0, 0, lb - 2), coc, n) + & f4*v(coset(ax, ay, az), & - coset(0, 0, lb-2), coc, n+1))+ & + coset(0, 0, lb - 2), coc, n + 1)) + & fcz*v(coset(ax, ay, az), & - coset(0, 0, lb-1), cocz, n+1) + coset(0, 0, lb - 1), cocz, n + 1) END IF ! *** Shift of angular momentum component y from a to b *** IF (ay == 0) THEN - bz = lb-1 + bz = lb - 1 v(coset(ax, ay, az), coset(0, 1, bz), coc, n) = & rbp(2)*v(coset(ax, ay, az), & - coset(0, 0, bz), coc, n)+ & + coset(0, 0, bz), coc, n) + & rpw(2)*v(coset(ax, ay, az), & - coset(0, 0, bz), coc, n+1)+ & + coset(0, 0, bz), coc, n + 1) + & fcy*v(coset(ax, ay, az), & - coset(0, 0, bz), cocy, n+1) + coset(0, 0, bz), cocy, n + 1) DO by = 2, lb - bz = lb-by - f3 = f2*REAL(by-1, dp) + bz = lb - by + f3 = f2*REAL(by - 1, dp) v(coset(ax, ay, az), coset(0, by, bz), coc, n) = & rbp(2)*v(coset(ax, ay, az), & - coset(0, by-1, bz), coc, n)+ & + coset(0, by - 1, bz), coc, n) + & rpw(2)*v(coset(ax, ay, az), & - coset(0, by-1, bz), coc, n+1)+ & + coset(0, by - 1, bz), coc, n + 1) + & f3*(v(coset(ax, ay, az), & - coset(0, by-2, bz), coc, n)+ & + coset(0, by - 2, bz), coc, n) + & f4*v(coset(ax, ay, az), & - coset(0, by-2, bz), coc, n+1))+ & + coset(0, by - 2, bz), coc, n + 1)) + & fcy*v(coset(ax, ay, az), & - coset(0, by-1, bz), cocy, n+1) + coset(0, by - 1, bz), cocy, n + 1) END DO ELSE - bz = lb-1 + bz = lb - 1 v(coset(ax, ay, az), coset(0, 1, bz), coc, n) = & rbp(2)*v(coset(ax, ay, az), & - coset(0, 0, bz), coc, n)+ & + coset(0, 0, bz), coc, n) + & rpw(2)*v(coset(ax, ay, az), & - coset(0, 0, bz), coc, n+1)+ & - fy*(v(coset(ax, ay-1, az), & - coset(0, 0, bz), coc, n)+ & - f4*v(coset(ax, ay-1, az), & - coset(0, 0, bz), coc, n+1))+ & + coset(0, 0, bz), coc, n + 1) + & + fy*(v(coset(ax, ay - 1, az), & + coset(0, 0, bz), coc, n) + & + f4*v(coset(ax, ay - 1, az), & + coset(0, 0, bz), coc, n + 1)) + & fcy*v(coset(ax, ay, az), & - coset(0, 0, bz), cocy, n+1) + coset(0, 0, bz), cocy, n + 1) DO by = 2, lb - bz = lb-by - f3 = f2*REAL(by-1, dp) + bz = lb - by + f3 = f2*REAL(by - 1, dp) v(coset(ax, ay, az), coset(0, by, bz), coc, n) = & rbp(2)*v(coset(ax, ay, az), & - coset(0, by-1, bz), coc, n)+ & + coset(0, by - 1, bz), coc, n) + & rpw(2)*v(coset(ax, ay, az), & - coset(0, by-1, bz), coc, n+1)+ & - fy*(v(coset(ax, ay-1, az), & - coset(0, by-1, bz), coc, n)+ & - f4*v(coset(ax, ay-1, az), & - coset(0, by-1, bz), coc, n+1))+ & + coset(0, by - 1, bz), coc, n + 1) + & + fy*(v(coset(ax, ay - 1, az), & + coset(0, by - 1, bz), coc, n) + & + f4*v(coset(ax, ay - 1, az), & + coset(0, by - 1, bz), coc, n + 1)) + & f3*(v(coset(ax, ay, az), & - coset(0, by-2, bz), coc, n)+ & + coset(0, by - 2, bz), coc, n) + & f4*v(coset(ax, ay, az), & - coset(0, by-2, bz), coc, n+1))+ & + coset(0, by - 2, bz), coc, n + 1)) + & fcy*v(coset(ax, ay, az), & - coset(0, by-1, bz), cocy, n+1) + coset(0, by - 1, bz), cocy, n + 1) END DO END IF ! *** Shift of angular momentum component x from a to b *** IF (ax == 0) THEN - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by v(coset(ax, ay, az), coset(1, by, bz), coc, n) = & rbp(1)*v(coset(ax, ay, az), & - coset(0, by, bz), coc, n)+ & + coset(0, by, bz), coc, n) + & rpw(1)*v(coset(ax, ay, az), & - coset(0, by, bz), coc, n+1)+ & + coset(0, by, bz), coc, n + 1) + & fcx*v(coset(ax, ay, az), & - coset(0, by, bz), cocx, n+1) + coset(0, by, bz), cocx, n + 1) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by v(coset(ax, ay, az), coset(bx, by, bz), coc, n) = & rbp(1)*v(coset(ax, ay, az), & - coset(bx-1, by, bz), coc, n)+ & + coset(bx - 1, by, bz), coc, n) + & rpw(1)*v(coset(ax, ay, az), & - coset(bx-1, by, bz), coc, n+1)+ & + coset(bx - 1, by, bz), coc, n + 1) + & f3*(v(coset(ax, ay, az), & - coset(bx-2, by, bz), coc, n)+ & + coset(bx - 2, by, bz), coc, n) + & f4*v(coset(ax, ay, az), & - coset(bx-2, by, bz), coc, n+1))+ & + coset(bx - 2, by, bz), coc, n + 1)) + & fcx*v(coset(ax, ay, az), & - coset(bx-1, by, bz), cocx, n+1) + coset(bx - 1, by, bz), cocx, n + 1) END DO END DO ELSE - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by v(coset(ax, ay, az), coset(1, by, bz), coc, n) = & rbp(1)*v(coset(ax, ay, az), & - coset(0, by, bz), coc, n)+ & + coset(0, by, bz), coc, n) + & rpw(1)*v(coset(ax, ay, az), & - coset(0, by, bz), coc, n+1)+ & - fx*(v(coset(ax-1, ay, az), & - coset(0, by, bz), coc, n)+ & - f4*v(coset(ax-1, ay, az), & - coset(0, by, bz), coc, n+1))+ & + coset(0, by, bz), coc, n + 1) + & + fx*(v(coset(ax - 1, ay, az), & + coset(0, by, bz), coc, n) + & + f4*v(coset(ax - 1, ay, az), & + coset(0, by, bz), coc, n + 1)) + & fcx*v(coset(ax, ay, az), & - coset(0, by, bz), cocx, n+1) + coset(0, by, bz), cocx, n + 1) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by v(coset(ax, ay, az), coset(bx, by, bz), coc, n) = & rbp(1)*v(coset(ax, ay, az), & - coset(bx-1, by, bz), coc, n)+ & + coset(bx - 1, by, bz), coc, n) + & rpw(1)*v(coset(ax, ay, az), & - coset(bx-1, by, bz), coc, n+1)+ & - fx*(v(coset(ax-1, ay, az), & - coset(bx-1, by, bz), coc, n)+ & - f4*v(coset(ax-1, ay, az), & - coset(bx-1, by, bz), coc, n+1))+ & + coset(bx - 1, by, bz), coc, n + 1) + & + fx*(v(coset(ax - 1, ay, az), & + coset(bx - 1, by, bz), coc, n) + & + f4*v(coset(ax - 1, ay, az), & + coset(bx - 1, by, bz), coc, n + 1)) + & f3*(v(coset(ax, ay, az), & - coset(bx-2, by, bz), coc, n)+ & + coset(bx - 2, by, bz), coc, n) + & f4*v(coset(ax, ay, az), & - coset(bx-2, by, bz), coc, n+1))+ & + coset(bx - 2, by, bz), coc, n + 1)) + & fcx*v(coset(ax, ay, az), & - coset(bx-1, by, bz), cocx, n+1) + coset(bx - 1, by, bz), cocx, n + 1) END DO END DO END IF @@ -1831,16 +1831,16 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg ! *** (Wi - Pi)*[ss||c]{n+1} + *** ! *** f6*Ni(c)**[ss||c-1i]{n+1} *** - DO n = 1, nmax-1-lc - v(1, 2, coc, n) = rbp(1)*v(1, 1, coc, n)+ & - rpw(1)*v(1, 1, coc, n+1)+ & - fcx*v(1, 1, cocx, n+1) - v(1, 3, coc, n) = rbp(2)*v(1, 1, coc, n)+ & - rpw(2)*v(1, 1, coc, n+1)+ & - fcy*v(1, 1, cocy, n+1) - v(1, 4, coc, n) = rbp(3)*v(1, 1, coc, n)+ & - rpw(3)*v(1, 1, coc, n+1)+ & - fcz*v(1, 1, cocz, n+1) + DO n = 1, nmax - 1 - lc + v(1, 2, coc, n) = rbp(1)*v(1, 1, coc, n) + & + rpw(1)*v(1, 1, coc, n + 1) + & + fcx*v(1, 1, cocx, n + 1) + v(1, 3, coc, n) = rbp(2)*v(1, 1, coc, n) + & + rpw(2)*v(1, 1, coc, n + 1) + & + fcy*v(1, 1, cocy, n + 1) + v(1, 4, coc, n) = rbp(3)*v(1, 1, coc, n) + & + rpw(3)*v(1, 1, coc, n + 1) + & + fcz*v(1, 1, cocz, n + 1) END DO ! *** [sb||c]{n} = (Pi - Bi)*[s(b-1i)||c]{n} + *** @@ -1851,56 +1851,56 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg DO lb = 2, lb_max - DO n = 1, nmax-lb-lc + DO n = 1, nmax - lb - lc ! *** Increase the angular momentum component z of b *** v(1, coset(0, 0, lb), coc, n) = & - rbp(3)*v(1, coset(0, 0, lb-1), coc, n)+ & - rpw(3)*v(1, coset(0, 0, lb-1), coc, n+1)+ & - f2*REAL(lb-1, dp)*(v(1, coset(0, 0, lb-2), coc, n)+ & - f4*v(1, coset(0, 0, lb-2), coc, n+1))+ & - fcz*v(1, coset(0, 0, lb-1), cocz, n+1) + rbp(3)*v(1, coset(0, 0, lb - 1), coc, n) + & + rpw(3)*v(1, coset(0, 0, lb - 1), coc, n + 1) + & + f2*REAL(lb - 1, dp)*(v(1, coset(0, 0, lb - 2), coc, n) + & + f4*v(1, coset(0, 0, lb - 2), coc, n + 1)) + & + fcz*v(1, coset(0, 0, lb - 1), cocz, n + 1) ! *** Increase the angular momentum component y of b *** - bz = lb-1 + bz = lb - 1 v(1, coset(0, 1, bz), coc, n) = & - rbp(2)*v(1, coset(0, 0, bz), coc, n)+ & - rpw(2)*v(1, coset(0, 0, bz), coc, n+1)+ & - fcy*v(1, coset(0, 0, bz), cocy, n+1) + rbp(2)*v(1, coset(0, 0, bz), coc, n) + & + rpw(2)*v(1, coset(0, 0, bz), coc, n + 1) + & + fcy*v(1, coset(0, 0, bz), cocy, n + 1) DO by = 2, lb - f3 = f2*REAL(by-1, dp) - bz = lb-by + f3 = f2*REAL(by - 1, dp) + bz = lb - by v(1, coset(0, by, bz), coc, n) = & - rbp(2)*v(1, coset(0, by-1, bz), coc, n)+ & - rpw(2)*v(1, coset(0, by-1, bz), coc, n+1)+ & - f3*(v(1, coset(0, by-2, bz), coc, n)+ & - f4*v(1, coset(0, by-2, bz), coc, n+1))+ & - fcy*v(1, coset(0, by-1, bz), cocy, n+1) + rbp(2)*v(1, coset(0, by - 1, bz), coc, n) + & + rpw(2)*v(1, coset(0, by - 1, bz), coc, n + 1) + & + f3*(v(1, coset(0, by - 2, bz), coc, n) + & + f4*v(1, coset(0, by - 2, bz), coc, n + 1)) + & + fcy*v(1, coset(0, by - 1, bz), cocy, n + 1) END DO ! *** Increase the angular momentum component x of b *** - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by v(1, coset(1, by, bz), coc, n) = & - rbp(1)*v(1, coset(0, by, bz), coc, n)+ & - rpw(1)*v(1, coset(0, by, bz), coc, n+1)+ & - fcx*v(1, coset(0, by, bz), cocx, n+1) + rbp(1)*v(1, coset(0, by, bz), coc, n) + & + rpw(1)*v(1, coset(0, by, bz), coc, n + 1) + & + fcx*v(1, coset(0, by, bz), cocx, n + 1) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by v(1, coset(bx, by, bz), coc, n) = & - rbp(1)*v(1, coset(bx-1, by, bz), coc, n)+ & - rpw(1)*v(1, coset(bx-1, by, bz), coc, n+1)+ & - f3*(v(1, coset(bx-2, by, bz), coc, n)+ & - f4*v(1, coset(bx-2, by, bz), coc, n+1))+ & - fcx*v(1, coset(bx-1, by, bz), cocx, n+1) + rbp(1)*v(1, coset(bx - 1, by, bz), coc, n) + & + rpw(1)*v(1, coset(bx - 1, by, bz), coc, n + 1) + & + f3*(v(1, coset(bx - 2, by, bz), coc, n) + & + f4*v(1, coset(bx - 2, by, bz), coc, n + 1)) + & + fcx*v(1, coset(bx - 1, by, bz), cocx, n + 1) END DO END DO @@ -1922,33 +1922,33 @@ SUBROUTINE coulomb3(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, zetb, rpg ! *** Add the contribution of the current pair *** ! *** of primitive Gaussian-type functions *** - DO k = ncoset(lc_min-1)+1, ncoset(lc_max) - kk = k-ncoset(lc_min-1) - DO j = ncoset(lb_min-1)+1, ncoset(lb_max) - DO i = ncoset(la_min-1)+1, ncoset(la_max-maxder_local) - vabc(na+i, nb+j) = vabc(na+i, nb+j)+gccc(kk)*v(i, j, k, 1) - int_abc(na+i, nb+j, kk) = v(i, j, k, 1) + DO k = ncoset(lc_min - 1) + 1, ncoset(lc_max) + kk = k - ncoset(lc_min - 1) + DO j = ncoset(lb_min - 1) + 1, ncoset(lb_max) + DO i = ncoset(la_min - 1) + 1, ncoset(la_max - maxder_local) + vabc(na + i, nb + j) = vabc(na + i, nb + j) + gccc(kk)*v(i, j, k, 1) + int_abc(na + i, nb + j, kk) = v(i, j, k, 1) END DO END DO END DO IF (PRESENT(maxder)) THEN - DO k = ncoset(lc_min-1)+1, ncoset(lc_max) - kk = k-ncoset(lc_min-1) + DO k = ncoset(lc_min - 1) + 1, ncoset(lc_max) + kk = k - ncoset(lc_min - 1) DO j = 1, ncoset(lb_max) DO i = 1, ncoset(la_max) - vabc_plus(nap+i, nb+j) = vabc_plus(nap+i, nb+j)+gccc(kk)*v(i, j, k, 1) + vabc_plus(nap + i, nb + j) = vabc_plus(nap + i, nb + j) + gccc(kk)*v(i, j, k, 1) END DO END DO END DO END IF - nb = nb+ncoset(lb_max) + nb = nb + ncoset(lb_max) END DO - na = na+ncoset(la_max-maxder_local) - nap = nap+ncoset(la_max) + na = na + ncoset(la_max - maxder_local) + nap = nap + ncoset(la_max) END DO diff --git a/src/aobasis/ai_coulomb_test.F b/src/aobasis/ai_coulomb_test.F index e25b001c74..7629542534 100644 --- a/src/aobasis/ai_coulomb_test.F +++ b/src/aobasis/ai_coulomb_test.F @@ -112,7 +112,7 @@ SUBROUTINE eri_test(iw) rc = (/0.0_dp, 0.3_dp, 0.3_dp/) rd = (/0.7_dp, 0.2_dp, 0.1_dp/) - rac2 = SUM((ra-rc)**2) + rac2 = SUM((ra - rc)**2) rpgf = 1.e10_dp ! Performance test of coulomb2 routine @@ -125,15 +125,15 @@ SUBROUTINE eri_test(iw) lc_max = l lc_min = l ll = ncoset(l) - ALLOCATE (f(0:2*l+2), v(npgfa*ll, npgfc*ll, 2*l+1), vac(npgfa*ll, npgfc*ll)) + ALLOCATE (f(0:2*l + 2), v(npgfa*ll, npgfc*ll, 2*l + 1), vac(npgfa*ll, npgfc*ll)) vac = 0._dp - ii = MAX(100/(l+1)**2, 1) + ii = MAX(100/(l + 1)**2, 1) tstart = m_walltime() DO i = 1, ii CALL coulomb2(la_max, npgfa, zeta, rpgf, la_min, lc_max, npgfc, zetc, rpgf, lc_min, rc, rac2, vac, v, f) END DO tend = m_walltime() - t = tend-tstart+threshold + t = tend - tstart + threshold perf = REAL(ii*nco(l)**2, KIND=dp)*1.e-6_dp*REAL(npgfa*npgfc, KIND=dp)/t WRITE (iw, '(A,T40,A,T66,F15.3)') " Performance [Mintegrals/s] ", i2c(l), perf DEALLOCATE (f, v, vac) diff --git a/src/aobasis/ai_derivatives.F b/src/aobasis/ai_derivatives.F index e88b20c5e1..93dcea1c82 100644 --- a/src/aobasis/ai_derivatives.F +++ b/src/aobasis/ai_derivatives.F @@ -112,16 +112,16 @@ SUBROUTINE dabdr(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, rpgfb, lb_mi ! *** Screening *** - IF (rpgfa(ipgf)+rpgfb(jpgf) < dab) THEN - DO j = nb+ncoset(lb_min-1)+1, nb+ncoset(lb_max) - DO i = na+ncoset(la_min-1)+1, na+ncoset(la_max) + IF (rpgfa(ipgf) + rpgfb(jpgf) < dab) THEN + DO j = nb + ncoset(lb_min - 1) + 1, nb + ncoset(lb_max) + DO i = na + ncoset(la_min - 1) + 1, na + ncoset(la_max) dabdx(i, j) = 0.0_dp dabdy(i, j) = 0.0_dp dabdz(i, j) = 0.0_dp END DO END DO - nb = nb+ncoset(lb_max) - ndb = ndb+ncoset(lb_max+1) + nb = nb + ncoset(lb_max) + ndb = ndb + ncoset(lb_max + 1) CYCLE END IF @@ -131,17 +131,17 @@ SUBROUTINE dabdr(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, rpgfb, lb_mi IF (la == 0) THEN - coa = na+1 - coapx = nda+2 - coapy = nda+3 - coapz = nda+4 + coa = na + 1 + coapx = nda + 2 + coapy = nda + 3 + coapz = nda + 4 DO lb = 0, lb_max !lb_min,lb_max DO bx = 0, lb - DO by = 0, lb-bx - bz = lb-bx-by - cob = nb+coset(bx, by, bz) - codb = ndb+coset(bx, by, bz) + DO by = 0, lb - bx + bz = lb - bx - by + cob = nb + coset(bx, by, bz) + codb = ndb + coset(bx, by, bz) dabdx(coa, cob) = fa*ab(coapx, codb) dabdy(coa, cob) = fa*ab(coapy, codb) dabdz(coa, cob) = fa*ab(coapz, codb) @@ -152,16 +152,16 @@ SUBROUTINE dabdr(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, rpgfb, lb_mi ELSE DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay - coa = na+coset(ax, ay, az) - coamx = nda+coset(MAX(0, ax-1), ay, az) - coamy = nda+coset(ax, MAX(0, ay-1), az) - coamz = nda+coset(ax, ay, MAX(0, az-1)) - coapx = nda+coset(ax+1, ay, az) - coapy = nda+coset(ax, ay+1, az) - coapz = nda+coset(ax, ay, az+1) + coa = na + coset(ax, ay, az) + coamx = nda + coset(MAX(0, ax - 1), ay, az) + coamy = nda + coset(ax, MAX(0, ay - 1), az) + coamz = nda + coset(ax, ay, MAX(0, az - 1)) + coapx = nda + coset(ax + 1, ay, az) + coapy = nda + coset(ax, ay + 1, az) + coapz = nda + coset(ax, ay, az + 1) fx = REAL(ax, dp) fy = REAL(ay, dp) @@ -169,13 +169,13 @@ SUBROUTINE dabdr(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, rpgfb, lb_mi DO lb = 0, lb_max !lb_min,lb_max DO bx = 0, lb - DO by = 0, lb-bx - bz = lb-bx-by - cob = nb+coset(bx, by, bz) - codb = ndb+coset(bx, by, bz) - dabdx(coa, cob) = fa*ab(coapx, codb)-fx*ab(coamx, codb) - dabdy(coa, cob) = fa*ab(coapy, codb)-fy*ab(coamy, codb) - dabdz(coa, cob) = fa*ab(coapz, codb)-fz*ab(coamz, codb) + DO by = 0, lb - bx + bz = lb - bx - by + cob = nb + coset(bx, by, bz) + codb = ndb + coset(bx, by, bz) + dabdx(coa, cob) = fa*ab(coapx, codb) - fx*ab(coamx, codb) + dabdy(coa, cob) = fa*ab(coapy, codb) - fy*ab(coamy, codb) + dabdz(coa, cob) = fa*ab(coapz, codb) - fz*ab(coamz, codb) END DO END DO END DO @@ -187,13 +187,13 @@ SUBROUTINE dabdr(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, rpgfb, lb_mi END DO - nb = nb+ncoset(lb_max) - ndb = ndb+ncoset(lb_max+1) + nb = nb + ncoset(lb_max) + ndb = ndb + ncoset(lb_max + 1) END DO - na = na+ncoset(la_max) - nda = nda+ncoset(la_max+1) + na = na + ncoset(la_max) + nda = nda + ncoset(la_max + 1) END DO @@ -259,16 +259,16 @@ SUBROUTINE adbdr(la_max, npgfa, rpgfa, la_min, lb_max, npgfb, zetb, rpgfb, lb_mi ! *** Screening *** - IF (rpgfa(ipgf)+rpgfb(jpgf) < dab) THEN - DO j = nb+ncoset(lb_min-1)+1, nb+ncoset(lb_max) - DO i = na+ncoset(la_min-1)+1, na+ncoset(la_max) + IF (rpgfa(ipgf) + rpgfb(jpgf) < dab) THEN + DO j = nb + ncoset(lb_min - 1) + 1, nb + ncoset(lb_max) + DO i = na + ncoset(la_min - 1) + 1, na + ncoset(la_max) adbdx(i, j) = 0.0_dp adbdy(i, j) = 0.0_dp adbdz(i, j) = 0.0_dp END DO END DO - nb = nb+ncoset(lb_max) - ndb = ndb+ncoset(lb_max+1) + nb = nb + ncoset(lb_max) + ndb = ndb + ncoset(lb_max + 1) CYCLE END IF @@ -278,17 +278,17 @@ SUBROUTINE adbdr(la_max, npgfa, rpgfa, la_min, lb_max, npgfb, zetb, rpgfb, lb_mi IF (lb == 0) THEN - cob = nb+1 - cobpx = ndb+2 - cobpy = ndb+3 - cobpz = ndb+4 + cob = nb + 1 + cobpx = ndb + 2 + cobpy = ndb + 3 + cobpz = ndb + 4 DO la = 0, la_max !la_min,la_max DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay - coa = na+coset(ax, ay, az) - coda = nda+coset(ax, ay, az) + DO ay = 0, la - ax + az = la - ax - ay + coa = na + coset(ax, ay, az) + coda = nda + coset(ax, ay, az) adbdx(coa, cob) = fb*ab(coda, cobpx) adbdy(coa, cob) = fb*ab(coda, cobpy) adbdz(coa, cob) = fb*ab(coda, cobpz) @@ -298,16 +298,16 @@ SUBROUTINE adbdr(la_max, npgfa, rpgfa, la_min, lb_max, npgfb, zetb, rpgfb, lb_mi ELSE DO bx = 0, lb - DO by = 0, lb-bx - bz = lb-bx-by + DO by = 0, lb - bx + bz = lb - bx - by - cob = nb+coset(bx, by, bz) - cobmx = ndb+coset(MAX(0, bx-1), by, bz) - cobmy = ndb+coset(bx, MAX(0, by-1), bz) - cobmz = ndb+coset(bx, by, MAX(0, bz-1)) - cobpx = ndb+coset(bx+1, by, bz) - cobpy = ndb+coset(bx, by+1, bz) - cobpz = ndb+coset(bx, by, bz+1) + cob = nb + coset(bx, by, bz) + cobmx = ndb + coset(MAX(0, bx - 1), by, bz) + cobmy = ndb + coset(bx, MAX(0, by - 1), bz) + cobmz = ndb + coset(bx, by, MAX(0, bz - 1)) + cobpx = ndb + coset(bx + 1, by, bz) + cobpy = ndb + coset(bx, by + 1, bz) + cobpz = ndb + coset(bx, by, bz + 1) fx = REAL(bx, dp) fy = REAL(by, dp) @@ -315,13 +315,13 @@ SUBROUTINE adbdr(la_max, npgfa, rpgfa, la_min, lb_max, npgfb, zetb, rpgfb, lb_mi DO la = 0, la_max !la_min,la_max DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay - coa = na+coset(ax, ay, az) - coda = nda+coset(ax, ay, az) - adbdx(coa, cob) = fb*ab(coda, cobpx)-fx*ab(coda, cobmx) - adbdy(coa, cob) = fb*ab(coda, cobpy)-fy*ab(coda, cobmy) - adbdz(coa, cob) = fb*ab(coda, cobpz)-fz*ab(coda, cobmz) + DO ay = 0, la - ax + az = la - ax - ay + coa = na + coset(ax, ay, az) + coda = nda + coset(ax, ay, az) + adbdx(coa, cob) = fb*ab(coda, cobpx) - fx*ab(coda, cobmx) + adbdy(coa, cob) = fb*ab(coda, cobpy) - fy*ab(coda, cobmy) + adbdz(coa, cob) = fb*ab(coda, cobpz) - fz*ab(coda, cobmz) END DO END DO END DO @@ -333,13 +333,13 @@ SUBROUTINE adbdr(la_max, npgfa, rpgfa, la_min, lb_max, npgfb, zetb, rpgfb, lb_mi END DO - nb = nb+ncoset(lb_max) - ndb = ndb+ncoset(lb_max+1) + nb = nb + ncoset(lb_max) + ndb = ndb + ncoset(lb_max + 1) END DO - na = na+ncoset(la_max) - nda = nda+ncoset(la_max+1) + na = na + ncoset(la_max) + nda = nda + ncoset(la_max + 1) END DO @@ -397,17 +397,17 @@ SUBROUTINE dabdr_noscreen(la_max, npgfa, zeta, lb_max, npgfb, ab, dabdx, dabdy, IF (la == 0) THEN - coa = na+1 - coapx = nda+2 - coapy = nda+3 - coapz = nda+4 + coa = na + 1 + coapx = nda + 2 + coapy = nda + 3 + coapz = nda + 4 DO lb = 0, lb_max !lb_min,lb_max DO bx = 0, lb - DO by = 0, lb-bx - bz = lb-bx-by - cob = nb+coset(bx, by, bz) - codb = ndb+coset(bx, by, bz) + DO by = 0, lb - bx + bz = lb - bx - by + cob = nb + coset(bx, by, bz) + codb = ndb + coset(bx, by, bz) dabdx(coa, cob) = fa*ab(coapx, codb) dabdy(coa, cob) = fa*ab(coapy, codb) dabdz(coa, cob) = fa*ab(coapz, codb) @@ -418,16 +418,16 @@ SUBROUTINE dabdr_noscreen(la_max, npgfa, zeta, lb_max, npgfb, ab, dabdx, dabdy, ELSE DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay - coa = na+coset(ax, ay, az) - coamx = nda+coset(MAX(0, ax-1), ay, az) - coamy = nda+coset(ax, MAX(0, ay-1), az) - coamz = nda+coset(ax, ay, MAX(0, az-1)) - coapx = nda+coset(ax+1, ay, az) - coapy = nda+coset(ax, ay+1, az) - coapz = nda+coset(ax, ay, az+1) + coa = na + coset(ax, ay, az) + coamx = nda + coset(MAX(0, ax - 1), ay, az) + coamy = nda + coset(ax, MAX(0, ay - 1), az) + coamz = nda + coset(ax, ay, MAX(0, az - 1)) + coapx = nda + coset(ax + 1, ay, az) + coapy = nda + coset(ax, ay + 1, az) + coapz = nda + coset(ax, ay, az + 1) fx = REAL(ax, dp) fy = REAL(ay, dp) @@ -435,13 +435,13 @@ SUBROUTINE dabdr_noscreen(la_max, npgfa, zeta, lb_max, npgfb, ab, dabdx, dabdy, DO lb = 0, lb_max !lb_min,lb_max DO bx = 0, lb - DO by = 0, lb-bx - bz = lb-bx-by - cob = nb+coset(bx, by, bz) - codb = ndb+coset(bx, by, bz) - dabdx(coa, cob) = fa*ab(coapx, codb)-fx*ab(coamx, codb) - dabdy(coa, cob) = fa*ab(coapy, codb)-fy*ab(coamy, codb) - dabdz(coa, cob) = fa*ab(coapz, codb)-fz*ab(coamz, codb) + DO by = 0, lb - bx + bz = lb - bx - by + cob = nb + coset(bx, by, bz) + codb = ndb + coset(bx, by, bz) + dabdx(coa, cob) = fa*ab(coapx, codb) - fx*ab(coamx, codb) + dabdy(coa, cob) = fa*ab(coapy, codb) - fy*ab(coamy, codb) + dabdz(coa, cob) = fa*ab(coapz, codb) - fz*ab(coamz, codb) END DO END DO END DO @@ -453,13 +453,13 @@ SUBROUTINE dabdr_noscreen(la_max, npgfa, zeta, lb_max, npgfb, ab, dabdx, dabdy, END DO - nb = nb+ncoset(lb_max) - ndb = ndb+ncoset(lb_max+1) + nb = nb + ncoset(lb_max) + ndb = ndb + ncoset(lb_max + 1) END DO - na = na+ncoset(la_max) - nda = nda+ncoset(la_max+1) + na = na + ncoset(la_max) + nda = nda + ncoset(la_max + 1) END DO diff --git a/src/aobasis/ai_elec_field.F b/src/aobasis/ai_elec_field.F index dbfe06d14e..9f2e70d2cd 100644 --- a/src/aobasis/ai_elec_field.F +++ b/src/aobasis/ai_elec_field.F @@ -103,7 +103,7 @@ SUBROUTINE efg(la_max, la_min, npgfa, rpgfa, zeta, & ! *** Calculate the distance of the centers a and c *** - rab2 = rab(1)**2+rab(2)**2+rab(3)**2 + rab2 = rab(1)**2 + rab(2)**2 + rab(3)**2 dab = SQRT(rab2) ! *** Loop over all pairs of primitive Gaussian-type functions *** @@ -118,9 +118,9 @@ SUBROUTINE efg(la_max, la_min, npgfa, rpgfa, zeta, & ! *** Screening *** - IF (rpgfa(ipgf)+rpgfb(jpgf) < dab) THEN - DO j = nb+1, nb+ncoset(lb_max) - DO i = na+1, na+ncoset(la_max) + IF (rpgfa(ipgf) + rpgfb(jpgf) < dab) THEN + DO j = nb + 1, nb + ncoset(lb_max) + DO i = na + 1, na + ncoset(la_max) vab(i, j, 1) = 0.0_dp vab(i, j, 2) = 0.0_dp vab(i, j, 3) = 0.0_dp @@ -129,7 +129,7 @@ SUBROUTINE efg(la_max, la_min, npgfa, rpgfa, zeta, & vab(i, j, 6) = 0.0_dp ENDDO ENDDO - nb = nb+ncoset(lb_max) + nb = nb + ncoset(lb_max) CYCLE ENDIF @@ -137,171 +137,171 @@ SUBROUTINE efg(la_max, la_min, npgfa, rpgfa, zeta, & za = zeta(ipgf) zb = zetb(jpgf) - zet = za+zb + zet = za + zb xhi = za*zb/zet rap = zb*rab/zet rbp = -za*rab/zet - rcp = -(za*rac+zb*rbc)/zet + rcp = -(za*rac + zb*rbc)/zet f0 = 2.0_dp*SQRT(zet/pi)*(pi/zet)**(1.5_dp)*EXP(-xhi*rab2) ! *** Calculate the recurrence relation - CALL os_rr_coul(rap, la_max+2, rbp, lb_max+2, rcp, zet, ldrr1, ldrr2, rr) + CALL os_rr_coul(rap, la_max + 2, rbp, lb_max + 2, rcp, zet, ldrr1, ldrr2, rr) ! *** Calculate the primitive electric field gradient integrals *** DO lb = lb_min, lb_max DO bx = 0, lb - DO by = 0, lb-bx - bz = lb-bx-by + DO by = 0, lb - bx + bz = lb - bx - by cob = coset(bx, by, bz) - cobm1x = coset(MAX(bx-1, 0), by, bz) - cobm1y = coset(bx, MAX(by-1, 0), bz) - cobm1z = coset(bx, by, MAX(bz-1, 0)) - cobm2x = coset(MAX(bx-2, 0), by, bz) - cobm2y = coset(bx, MAX(by-2, 0), bz) - cobm2z = coset(bx, by, MAX(bz-2, 0)) - cobmxy = coset(MAX(bx-1, 0), MAX(by-1, 0), bz) - cobmxz = coset(MAX(bx-1, 0), by, MAX(bz-1, 0)) - cobmyz = coset(bx, MAX(by-1, 0), MAX(bz-1, 0)) - cobp1x = coset(bx+1, by, bz) - cobp1y = coset(bx, by+1, bz) - cobp1z = coset(bx, by, bz+1) - cobp2x = coset(bx+2, by, bz) - cobp2y = coset(bx, by+2, bz) - cobp2z = coset(bx, by, bz+2) - cobpxy = coset(bx+1, by+1, bz) - cobpxz = coset(bx+1, by, bz+1) - cobpyz = coset(bx, by+1, bz+1) - cobmxpy = coset(MAX(bx-1, 0), by+1, bz) - cobmxpz = coset(MAX(bx-1, 0), by, bz+1) - cobmypx = coset(bx+1, MAX(by-1, 0), bz) - cobmypz = coset(bx, MAX(by-1, 0), bz+1) - cobmzpx = coset(bx+1, by, MAX(bz-1, 0)) - cobmzpy = coset(bx, by+1, MAX(bz-1, 0)) - mb = nb+cob + cobm1x = coset(MAX(bx - 1, 0), by, bz) + cobm1y = coset(bx, MAX(by - 1, 0), bz) + cobm1z = coset(bx, by, MAX(bz - 1, 0)) + cobm2x = coset(MAX(bx - 2, 0), by, bz) + cobm2y = coset(bx, MAX(by - 2, 0), bz) + cobm2z = coset(bx, by, MAX(bz - 2, 0)) + cobmxy = coset(MAX(bx - 1, 0), MAX(by - 1, 0), bz) + cobmxz = coset(MAX(bx - 1, 0), by, MAX(bz - 1, 0)) + cobmyz = coset(bx, MAX(by - 1, 0), MAX(bz - 1, 0)) + cobp1x = coset(bx + 1, by, bz) + cobp1y = coset(bx, by + 1, bz) + cobp1z = coset(bx, by, bz + 1) + cobp2x = coset(bx + 2, by, bz) + cobp2y = coset(bx, by + 2, bz) + cobp2z = coset(bx, by, bz + 2) + cobpxy = coset(bx + 1, by + 1, bz) + cobpxz = coset(bx + 1, by, bz + 1) + cobpyz = coset(bx, by + 1, bz + 1) + cobmxpy = coset(MAX(bx - 1, 0), by + 1, bz) + cobmxpz = coset(MAX(bx - 1, 0), by, bz + 1) + cobmypx = coset(bx + 1, MAX(by - 1, 0), bz) + cobmypz = coset(bx, MAX(by - 1, 0), bz + 1) + cobmzpx = coset(bx + 1, by, MAX(bz - 1, 0)) + cobmzpy = coset(bx, by + 1, MAX(bz - 1, 0)) + mb = nb + cob DO la = la_min, la_max DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay coa = coset(ax, ay, az) - coap1x = coset(ax+1, ay, az) - coap1y = coset(ax, ay+1, az) - coap1z = coset(ax, ay, az+1) - coap2x = coset(ax+2, ay, az) - coap2y = coset(ax, ay+2, az) - coap2z = coset(ax, ay, az+2) - coapxy = coset(ax+1, ay+1, az) - coapxz = coset(ax+1, ay, az+1) - coapyz = coset(ax, ay+1, az+1) - coam1x = coset(MAX(ax-1, 0), ay, az) - coam1y = coset(ax, MAX(ay-1, 0), az) - coam1z = coset(ax, ay, MAX(az-1, 0)) - coam2x = coset(MAX(ax-2, 0), ay, az) - coam2y = coset(ax, MAX(ay-2, 0), az) - coam2z = coset(ax, ay, MAX(az-2, 0)) - coamxy = coset(MAX(ax-1, 0), MAX(ay-1, 0), az) - coamxz = coset(MAX(ax-1, 0), ay, MAX(az-1, 0)) - coamyz = coset(ax, MAX(ay-1, 0), MAX(az-1, 0)) - coamxpy = coset(MAX(ax-1, 0), ay+1, az) - coamxpz = coset(MAX(ax-1, 0), ay, az+1) - coamypx = coset(ax+1, MAX(ay-1, 0), az) - coamypz = coset(ax, MAX(ay-1, 0), az+1) - coamzpx = coset(ax+1, ay, MAX(az-1, 0)) - coamzpy = coset(ax, ay+1, MAX(az-1, 0)) - ma = na+coa + coap1x = coset(ax + 1, ay, az) + coap1y = coset(ax, ay + 1, az) + coap1z = coset(ax, ay, az + 1) + coap2x = coset(ax + 2, ay, az) + coap2y = coset(ax, ay + 2, az) + coap2z = coset(ax, ay, az + 2) + coapxy = coset(ax + 1, ay + 1, az) + coapxz = coset(ax + 1, ay, az + 1) + coapyz = coset(ax, ay + 1, az + 1) + coam1x = coset(MAX(ax - 1, 0), ay, az) + coam1y = coset(ax, MAX(ay - 1, 0), az) + coam1z = coset(ax, ay, MAX(az - 1, 0)) + coam2x = coset(MAX(ax - 2, 0), ay, az) + coam2y = coset(ax, MAX(ay - 2, 0), az) + coam2z = coset(ax, ay, MAX(az - 2, 0)) + coamxy = coset(MAX(ax - 1, 0), MAX(ay - 1, 0), az) + coamxz = coset(MAX(ax - 1, 0), ay, MAX(az - 1, 0)) + coamyz = coset(ax, MAX(ay - 1, 0), MAX(az - 1, 0)) + coamxpy = coset(MAX(ax - 1, 0), ay + 1, az) + coamxpz = coset(MAX(ax - 1, 0), ay, az + 1) + coamypx = coset(ax + 1, MAX(ay - 1, 0), az) + coamypz = coset(ax, MAX(ay - 1, 0), az + 1) + coamzpx = coset(ax + 1, ay, MAX(az - 1, 0)) + coamzpy = coset(ax, ay + 1, MAX(az - 1, 0)) + ma = na + coa ! ! (a|xx|b) - dum = 4.0_dp*(za**2*rr(0, coap2x, cob)+zb**2*rr(0, coa, cobp2x) & - & +2.0_dp*za*zb*rr(0, coap1x, cobp1x)) & - -2.0_dp*rr(0, coa, cob)*(za*REAL(2*ax+1, dp)+zb*REAL(2*bx+1, dp)) - IF (ax .GT. 1) dum = dum+REAL(ax*(ax-1), dp)*rr(0, coam2x, cob) - IF (bx .GT. 1) dum = dum+REAL(bx*(bx-1), dp)*rr(0, coa, cobm2x) - IF (ax .GT. 0) dum = dum-4.0_dp*zb*REAL(ax, dp)*rr(0, coam1x, cobp1x) - IF (bx .GT. 0) dum = dum-4.0_dp*za*REAL(bx, dp)*rr(0, coap1x, cobm1x) - IF (ax .GT. 0 .AND. bx .GT. 0) dum = dum+2.0_dp*REAL(ax*bx, dp)*rr(0, coam1x, cobm1x) + dum = 4.0_dp*(za**2*rr(0, coap2x, cob) + zb**2*rr(0, coa, cobp2x) & + & + 2.0_dp*za*zb*rr(0, coap1x, cobp1x)) & + - 2.0_dp*rr(0, coa, cob)*(za*REAL(2*ax + 1, dp) + zb*REAL(2*bx + 1, dp)) + IF (ax .GT. 1) dum = dum + REAL(ax*(ax - 1), dp)*rr(0, coam2x, cob) + IF (bx .GT. 1) dum = dum + REAL(bx*(bx - 1), dp)*rr(0, coa, cobm2x) + IF (ax .GT. 0) dum = dum - 4.0_dp*zb*REAL(ax, dp)*rr(0, coam1x, cobp1x) + IF (bx .GT. 0) dum = dum - 4.0_dp*za*REAL(bx, dp)*rr(0, coap1x, cobm1x) + IF (ax .GT. 0 .AND. bx .GT. 0) dum = dum + 2.0_dp*REAL(ax*bx, dp)*rr(0, coam1x, cobm1x) dumxx = f0*dum ! ! (a|yy|b) - dum = 4.0_dp*(za**2*rr(0, coap2y, cob)+zb**2*rr(0, coa, cobp2y) & - & +2.0_dp*za*zb*rr(0, coap1y, cobp1y)) & - -2.0_dp*rr(0, coa, cob)*(za*REAL(2*ay+1, dp)+zb*REAL(2*by+1, dp)) - IF (ay .GT. 1) dum = dum+REAL(ay*(ay-1), dp)*rr(0, coam2y, cob) - IF (by .GT. 1) dum = dum+REAL(by*(by-1), dp)*rr(0, coa, cobm2y) - IF (ay .GT. 0) dum = dum-4.0_dp*zb*REAL(ay, dp)*rr(0, coam1y, cobp1y) - IF (by .GT. 0) dum = dum-4.0_dp*za*REAL(by, dp)*rr(0, coap1y, cobm1y) - IF (ay .GT. 0 .AND. by .GT. 0) dum = dum+2.0_dp*REAL(ay*by, dp)*rr(0, coam1y, cobm1y) + dum = 4.0_dp*(za**2*rr(0, coap2y, cob) + zb**2*rr(0, coa, cobp2y) & + & + 2.0_dp*za*zb*rr(0, coap1y, cobp1y)) & + - 2.0_dp*rr(0, coa, cob)*(za*REAL(2*ay + 1, dp) + zb*REAL(2*by + 1, dp)) + IF (ay .GT. 1) dum = dum + REAL(ay*(ay - 1), dp)*rr(0, coam2y, cob) + IF (by .GT. 1) dum = dum + REAL(by*(by - 1), dp)*rr(0, coa, cobm2y) + IF (ay .GT. 0) dum = dum - 4.0_dp*zb*REAL(ay, dp)*rr(0, coam1y, cobp1y) + IF (by .GT. 0) dum = dum - 4.0_dp*za*REAL(by, dp)*rr(0, coap1y, cobm1y) + IF (ay .GT. 0 .AND. by .GT. 0) dum = dum + 2.0_dp*REAL(ay*by, dp)*rr(0, coam1y, cobm1y) dumyy = f0*dum ! ! (a|zz|b) - dum = 4.0_dp*(za**2*rr(0, coap2z, cob)+zb**2*rr(0, coa, cobp2z) & - & +2.0_dp*za*zb*rr(0, coap1z, cobp1z)) & - -2.0_dp*rr(0, coa, cob)*(za*REAL(2*az+1, dp)+zb*REAL(2*bz+1, dp)) - IF (az .GT. 1) dum = dum+REAL(az*(az-1), dp)*rr(0, coam2z, cob) - IF (bz .GT. 1) dum = dum+REAL(bz*(bz-1), dp)*rr(0, coa, cobm2z) - IF (az .GT. 0) dum = dum-4.0_dp*zb*REAL(az, dp)*rr(0, coam1z, cobp1z) - IF (bz .GT. 0) dum = dum-4.0_dp*za*REAL(bz, dp)*rr(0, coap1z, cobm1z) - IF (az .GT. 0 .AND. bz .GT. 0) dum = dum+2.0_dp*REAL(az*bz, dp)*rr(0, coam1z, cobm1z) + dum = 4.0_dp*(za**2*rr(0, coap2z, cob) + zb**2*rr(0, coa, cobp2z) & + & + 2.0_dp*za*zb*rr(0, coap1z, cobp1z)) & + - 2.0_dp*rr(0, coa, cob)*(za*REAL(2*az + 1, dp) + zb*REAL(2*bz + 1, dp)) + IF (az .GT. 1) dum = dum + REAL(az*(az - 1), dp)*rr(0, coam2z, cob) + IF (bz .GT. 1) dum = dum + REAL(bz*(bz - 1), dp)*rr(0, coa, cobm2z) + IF (az .GT. 0) dum = dum - 4.0_dp*zb*REAL(az, dp)*rr(0, coam1z, cobp1z) + IF (bz .GT. 0) dum = dum - 4.0_dp*za*REAL(bz, dp)*rr(0, coap1z, cobm1z) + IF (az .GT. 0 .AND. bz .GT. 0) dum = dum + 2.0_dp*REAL(az*bz, dp)*rr(0, coam1z, cobm1z) dumzz = f0*dum ! ! (a|xy|b) - dum = 4.0_dp*(za**2*rr(0, coapxy, cob)+zb**2*rr(0, coa, cobpxy) & - & +za*zb*(rr(0, coap1x, cobp1y)+rr(0, coap1y, cobp1x))) - IF (ax .GT. 0) dum = dum-2.0_dp*REAL(ax, dp)* & - & (za*rr(0, coamxpy, cob)+zb*rr(0, coam1x, cobp1y)) - IF (ay .GT. 0) dum = dum-2.0_dp*REAL(ay, dp)* & - & (za*rr(0, coamypx, cob)+zb*rr(0, coam1y, cobp1x)) - IF (ax .GT. 0 .AND. ay .GT. 0) dum = dum+REAL(ax*ay, dp)*rr(0, coamxy, cob) - IF (bx .GT. 0) dum = dum-2.0_dp*REAL(bx, dp)* & - & (zb*rr(0, coa, cobmxpy)+za*rr(0, coap1y, cobm1x)) - IF (by .GT. 0) dum = dum-2.0_dp*REAL(by, dp)* & - & (zb*rr(0, coa, cobmypx)+za*rr(0, coap1x, cobm1y)) - IF (bx .GT. 0 .AND. by .GT. 0) dum = dum+REAL(bx*by, dp)*rr(0, coa, cobmxy) - IF (ax .GT. 0 .AND. by .GT. 0) dum = dum+REAL(ax*by, dp)*rr(0, coam1x, cobm1y) - IF (ay .GT. 0 .AND. bx .GT. 0) dum = dum+REAL(ay*bx, dp)*rr(0, coam1y, cobm1x) + dum = 4.0_dp*(za**2*rr(0, coapxy, cob) + zb**2*rr(0, coa, cobpxy) & + & + za*zb*(rr(0, coap1x, cobp1y) + rr(0, coap1y, cobp1x))) + IF (ax .GT. 0) dum = dum - 2.0_dp*REAL(ax, dp)* & + & (za*rr(0, coamxpy, cob) + zb*rr(0, coam1x, cobp1y)) + IF (ay .GT. 0) dum = dum - 2.0_dp*REAL(ay, dp)* & + & (za*rr(0, coamypx, cob) + zb*rr(0, coam1y, cobp1x)) + IF (ax .GT. 0 .AND. ay .GT. 0) dum = dum + REAL(ax*ay, dp)*rr(0, coamxy, cob) + IF (bx .GT. 0) dum = dum - 2.0_dp*REAL(bx, dp)* & + & (zb*rr(0, coa, cobmxpy) + za*rr(0, coap1y, cobm1x)) + IF (by .GT. 0) dum = dum - 2.0_dp*REAL(by, dp)* & + & (zb*rr(0, coa, cobmypx) + za*rr(0, coap1x, cobm1y)) + IF (bx .GT. 0 .AND. by .GT. 0) dum = dum + REAL(bx*by, dp)*rr(0, coa, cobmxy) + IF (ax .GT. 0 .AND. by .GT. 0) dum = dum + REAL(ax*by, dp)*rr(0, coam1x, cobm1y) + IF (ay .GT. 0 .AND. bx .GT. 0) dum = dum + REAL(ay*bx, dp)*rr(0, coam1y, cobm1x) dumxy = f0*dum ! ! (a|xz|b) - dum = 4.0_dp*(za**2*rr(0, coapxz, cob)+zb**2*rr(0, coa, cobpxz) & - & +za*zb*(rr(0, coap1x, cobp1z)+rr(0, coap1z, cobp1x))) - IF (ax .GT. 0) dum = dum-2.0_dp*REAL(ax, dp)* & - & (za*rr(0, coamxpz, cob)+zb*rr(0, coam1x, cobp1z)) - IF (az .GT. 0) dum = dum-2.0_dp*REAL(az, dp)* & - & (za*rr(0, coamzpx, cob)+zb*rr(0, coam1z, cobp1x)) - IF (ax .GT. 0 .AND. az .GT. 0) dum = dum+REAL(ax*az, dp)*rr(0, coamxz, cob) - IF (bx .GT. 0) dum = dum-2.0_dp*REAL(bx, dp)* & - & (zb*rr(0, coa, cobmxpz)+za*rr(0, coap1z, cobm1x)) - IF (bz .GT. 0) dum = dum-2.0_dp*REAL(bz, dp)* & - & (zb*rr(0, coa, cobmzpx)+za*rr(0, coap1x, cobm1z)) - IF (bx .GT. 0 .AND. bz .GT. 0) dum = dum+REAL(bx*bz, dp)*rr(0, coa, cobmxz) - IF (ax .GT. 0 .AND. bz .GT. 0) dum = dum+REAL(ax*bz, dp)*rr(0, coam1x, cobm1z) - IF (az .GT. 0 .AND. bx .GT. 0) dum = dum+REAL(az*bx, dp)*rr(0, coam1z, cobm1x) + dum = 4.0_dp*(za**2*rr(0, coapxz, cob) + zb**2*rr(0, coa, cobpxz) & + & + za*zb*(rr(0, coap1x, cobp1z) + rr(0, coap1z, cobp1x))) + IF (ax .GT. 0) dum = dum - 2.0_dp*REAL(ax, dp)* & + & (za*rr(0, coamxpz, cob) + zb*rr(0, coam1x, cobp1z)) + IF (az .GT. 0) dum = dum - 2.0_dp*REAL(az, dp)* & + & (za*rr(0, coamzpx, cob) + zb*rr(0, coam1z, cobp1x)) + IF (ax .GT. 0 .AND. az .GT. 0) dum = dum + REAL(ax*az, dp)*rr(0, coamxz, cob) + IF (bx .GT. 0) dum = dum - 2.0_dp*REAL(bx, dp)* & + & (zb*rr(0, coa, cobmxpz) + za*rr(0, coap1z, cobm1x)) + IF (bz .GT. 0) dum = dum - 2.0_dp*REAL(bz, dp)* & + & (zb*rr(0, coa, cobmzpx) + za*rr(0, coap1x, cobm1z)) + IF (bx .GT. 0 .AND. bz .GT. 0) dum = dum + REAL(bx*bz, dp)*rr(0, coa, cobmxz) + IF (ax .GT. 0 .AND. bz .GT. 0) dum = dum + REAL(ax*bz, dp)*rr(0, coam1x, cobm1z) + IF (az .GT. 0 .AND. bx .GT. 0) dum = dum + REAL(az*bx, dp)*rr(0, coam1z, cobm1x) dumxz = f0*dum ! ! (a|yz|b) - dum = 4.0_dp*(za**2*rr(0, coapyz, cob)+zb**2*rr(0, coa, cobpyz) & - & +za*zb*(rr(0, coap1y, cobp1z)+rr(0, coap1z, cobp1y))) - IF (ay .GT. 0) dum = dum-2.0_dp*REAL(ay, dp)* & - & (za*rr(0, coamypz, cob)+zb*rr(0, coam1y, cobp1z)) - IF (az .GT. 0) dum = dum-2.0_dp*REAL(az, dp)* & - & (za*rr(0, coamzpy, cob)+zb*rr(0, coam1z, cobp1y)) - IF (ay .GT. 0 .AND. az .GT. 0) dum = dum+REAL(ay*az, dp)*rr(0, coamyz, cob) - IF (by .GT. 0) dum = dum-2.0_dp*REAL(by, dp)* & - & (zb*rr(0, coa, cobmypz)+za*rr(0, coap1z, cobm1y)) - IF (bz .GT. 0) dum = dum-2.0_dp*REAL(bz, dp)* & - & (zb*rr(0, coa, cobmzpy)+za*rr(0, coap1y, cobm1z)) - IF (by .GT. 0 .AND. bz .GT. 0) dum = dum+REAL(by*bz, dp)*rr(0, coa, cobmyz) - IF (ay .GT. 0 .AND. bz .GT. 0) dum = dum+REAL(ay*bz, dp)*rr(0, coam1y, cobm1z) - IF (az .GT. 0 .AND. by .GT. 0) dum = dum+REAL(az*by, dp)*rr(0, coam1z, cobm1y) + dum = 4.0_dp*(za**2*rr(0, coapyz, cob) + zb**2*rr(0, coa, cobpyz) & + & + za*zb*(rr(0, coap1y, cobp1z) + rr(0, coap1z, cobp1y))) + IF (ay .GT. 0) dum = dum - 2.0_dp*REAL(ay, dp)* & + & (za*rr(0, coamypz, cob) + zb*rr(0, coam1y, cobp1z)) + IF (az .GT. 0) dum = dum - 2.0_dp*REAL(az, dp)* & + & (za*rr(0, coamzpy, cob) + zb*rr(0, coam1z, cobp1y)) + IF (ay .GT. 0 .AND. az .GT. 0) dum = dum + REAL(ay*az, dp)*rr(0, coamyz, cob) + IF (by .GT. 0) dum = dum - 2.0_dp*REAL(by, dp)* & + & (zb*rr(0, coa, cobmypz) + za*rr(0, coap1z, cobm1y)) + IF (bz .GT. 0) dum = dum - 2.0_dp*REAL(bz, dp)* & + & (zb*rr(0, coa, cobmzpy) + za*rr(0, coap1y, cobm1z)) + IF (by .GT. 0 .AND. bz .GT. 0) dum = dum + REAL(by*bz, dp)*rr(0, coa, cobmyz) + IF (ay .GT. 0 .AND. bz .GT. 0) dum = dum + REAL(ay*bz, dp)*rr(0, coam1y, cobm1z) + IF (az .GT. 0 .AND. by .GT. 0) dum = dum + REAL(az*by, dp)*rr(0, coam1z, cobm1y) dumyz = f0*dum ! ! - vab(ma, mb, 1) = (2.0_dp*dumxx-dumyy-dumzz)/3.0_dp !xx + vab(ma, mb, 1) = (2.0_dp*dumxx - dumyy - dumzz)/3.0_dp !xx vab(ma, mb, 2) = dumxy !xy vab(ma, mb, 3) = dumxz !xz - vab(ma, mb, 4) = (2.0_dp*dumyy-dumzz-dumxx)/3.0_dp !yy + vab(ma, mb, 4) = (2.0_dp*dumyy - dumzz - dumxx)/3.0_dp !yy vab(ma, mb, 5) = dumyz !yz - vab(ma, mb, 6) = (2.0_dp*dumzz-dumxx-dumyy)/3.0_dp !zz + vab(ma, mb, 6) = (2.0_dp*dumzz - dumxx - dumyy)/3.0_dp !zz ENDDO ENDDO ENDDO !la @@ -310,11 +310,11 @@ SUBROUTINE efg(la_max, la_min, npgfa, rpgfa, zeta, & ENDDO ENDDO !lb - nb = nb+ncoset(lb_max) + nb = nb + ncoset(lb_max) ENDDO - na = na+ncoset(la_max) + na = na + ncoset(la_max) ENDDO diff --git a/src/aobasis/ai_eri_debug.F b/src/aobasis/ai_eri_debug.F index 38d7083f47..e1dd45f5a4 100644 --- a/src/aobasis/ai_eri_debug.F +++ b/src/aobasis/ai_eri_debug.F @@ -66,26 +66,26 @@ SUBROUTINE init_os(ya, yb, yc, yd, rA, rB, rC, rD) C = rC D = rD - xsi = xa+xb - eta = xc+xd + xsi = xa + xb + eta = xc + xd - P = (xa*A+xb*B)/xsi - Q = (xc*C+xd*D)/eta - W = (xsi*P+eta*Q)/(xsi+eta) + P = (xa*A + xb*B)/xsi + Q = (xc*C + xd*D)/eta + W = (xsi*P + eta*Q)/(xsi + eta) - rho = xsi*eta/(xsi+eta) + rho = xsi*eta/(xsi + eta) - T = rho*SUM((P-Q)**2) + T = rho*SUM((P - Q)**2) fm = fgamma_ref(4*lmax, T) - eab = -xa*xb/xsi*SUM((A-B)**2) + eab = -xa*xb/xsi*SUM((A - B)**2) kab = SQRT(2._dp)*pi**1.25_dp/xsi*EXP(eab) - ecd = -xc*xd/eta*SUM((C-D)**2) + ecd = -xc*xd/eta*SUM((C - D)**2) kcd = SQRT(2._dp)*pi**1.25_dp/eta*EXP(ecd) - I0M = kab*kcd/SQRT(xsi+eta)*fm + I0M = kab*kcd/SQRT(xsi + eta)*fm END SUBROUTINE init_os @@ -120,56 +120,56 @@ RECURSIVE FUNCTION os(an, bn, cn, dn, mi) RESULT(IABCD) IF (ANY(cn < 0)) RETURN IF (ANY(dn < 0)) RETURN - IF (SUM(an+bn+cn+dn) == 0) THEN + IF (SUM(an + bn + cn + dn) == 0) THEN IABCD = I0M(m) RETURN END IF IF (dn(1) > 0) THEN - IABCD = os(an, bn, cn+i1, dn-i1)-(D(1)-C(1))*os(an, bn, cn, dn-i1) + IABCD = os(an, bn, cn + i1, dn - i1) - (D(1) - C(1))*os(an, bn, cn, dn - i1) ELSEIF (dn(2) > 0) THEN - IABCD = os(an, bn, cn+i2, dn-i2)-(D(2)-C(2))*os(an, bn, cn, dn-i2) + IABCD = os(an, bn, cn + i2, dn - i2) - (D(2) - C(2))*os(an, bn, cn, dn - i2) ELSEIF (dn(3) > 0) THEN - IABCD = os(an, bn, cn+i3, dn-i3)-(D(3)-C(3))*os(an, bn, cn, dn-i3) + IABCD = os(an, bn, cn + i3, dn - i3) - (D(3) - C(3))*os(an, bn, cn, dn - i3) ELSE IF (bn(1) > 0) THEN - IABCD = os(an+i1, bn-i1, cn, dn)-(B(1)-A(1))*os(an, bn-i1, cn, dn) + IABCD = os(an + i1, bn - i1, cn, dn) - (B(1) - A(1))*os(an, bn - i1, cn, dn) ELSEIF (bn(2) > 0) THEN - IABCD = os(an+i2, bn-i2, cn, dn)-(B(2)-A(2))*os(an, bn-i2, cn, dn) + IABCD = os(an + i2, bn - i2, cn, dn) - (B(2) - A(2))*os(an, bn - i2, cn, dn) ELSEIF (bn(3) > 0) THEN - IABCD = os(an+i3, bn-i3, cn, dn)-(B(3)-A(3))*os(an, bn-i3, cn, dn) + IABCD = os(an + i3, bn - i3, cn, dn) - (B(3) - A(3))*os(an, bn - i3, cn, dn) ELSE IF (cn(1) > 0) THEN - IABCD = ((Q(1)-C(1))+xsi/eta*(P(1)-A(1)))*os(an, bn, cn-i1, dn)+ & - 0.5_dp*an(1)/eta*os(an-i1, bn, cn-i1, dn)+ & - 0.5_dp*(cn(1)-1)/eta*os(an, bn, cn-i1-i1, dn)- & - xsi/eta*os(an+i1, bn, cn-i1, dn) + IABCD = ((Q(1) - C(1)) + xsi/eta*(P(1) - A(1)))*os(an, bn, cn - i1, dn) + & + 0.5_dp*an(1)/eta*os(an - i1, bn, cn - i1, dn) + & + 0.5_dp*(cn(1) - 1)/eta*os(an, bn, cn - i1 - i1, dn) - & + xsi/eta*os(an + i1, bn, cn - i1, dn) ELSEIF (cn(2) > 0) THEN - IABCD = ((Q(2)-C(2))+xsi/eta*(P(2)-A(2)))*os(an, bn, cn-i2, dn)+ & - 0.5_dp*an(2)/eta*os(an-i2, bn, cn-i2, dn)+ & - 0.5_dp*(cn(2)-1)/eta*os(an, bn, cn-i2-i2, dn)- & - xsi/eta*os(an+i2, bn, cn-i2, dn) + IABCD = ((Q(2) - C(2)) + xsi/eta*(P(2) - A(2)))*os(an, bn, cn - i2, dn) + & + 0.5_dp*an(2)/eta*os(an - i2, bn, cn - i2, dn) + & + 0.5_dp*(cn(2) - 1)/eta*os(an, bn, cn - i2 - i2, dn) - & + xsi/eta*os(an + i2, bn, cn - i2, dn) ELSEIF (cn(3) > 0) THEN - IABCD = ((Q(3)-C(3))+xsi/eta*(P(3)-A(3)))*os(an, bn, cn-i3, dn)+ & - 0.5_dp*an(3)/eta*os(an-i3, bn, cn-i3, dn)+ & - 0.5_dp*(cn(3)-1)/eta*os(an, bn, cn-i3-i3, dn)- & - xsi/eta*os(an+i3, bn, cn-i3, dn) + IABCD = ((Q(3) - C(3)) + xsi/eta*(P(3) - A(3)))*os(an, bn, cn - i3, dn) + & + 0.5_dp*an(3)/eta*os(an - i3, bn, cn - i3, dn) + & + 0.5_dp*(cn(3) - 1)/eta*os(an, bn, cn - i3 - i3, dn) - & + xsi/eta*os(an + i3, bn, cn - i3, dn) ELSE IF (an(1) > 0) THEN - IABCD = (P(1)-A(1))*os(an-i1, bn, cn, dn, m)+ & - (W(1)-P(1))*os(an-i1, bn, cn, dn, m+1)+ & - 0.5_dp*(an(1)-1)/xsi*os(an-i1-i1, bn, cn, dn, m)- & - 0.5_dp*(an(1)-1)/xsi*rho/xsi*os(an-i1-i1, bn, cn, dn, m+1) + IABCD = (P(1) - A(1))*os(an - i1, bn, cn, dn, m) + & + (W(1) - P(1))*os(an - i1, bn, cn, dn, m + 1) + & + 0.5_dp*(an(1) - 1)/xsi*os(an - i1 - i1, bn, cn, dn, m) - & + 0.5_dp*(an(1) - 1)/xsi*rho/xsi*os(an - i1 - i1, bn, cn, dn, m + 1) ELSEIF (an(2) > 0) THEN - IABCD = (P(2)-A(2))*os(an-i2, bn, cn, dn, m)+ & - (W(2)-P(2))*os(an-i2, bn, cn, dn, m+1)+ & - 0.5_dp*(an(2)-1)/xsi*os(an-i2-i2, bn, cn, dn, m)- & - 0.5_dp*(an(2)-1)/xsi*rho/xsi*os(an-i2-i2, bn, cn, dn, m+1) + IABCD = (P(2) - A(2))*os(an - i2, bn, cn, dn, m) + & + (W(2) - P(2))*os(an - i2, bn, cn, dn, m + 1) + & + 0.5_dp*(an(2) - 1)/xsi*os(an - i2 - i2, bn, cn, dn, m) - & + 0.5_dp*(an(2) - 1)/xsi*rho/xsi*os(an - i2 - i2, bn, cn, dn, m + 1) ELSEIF (an(3) > 0) THEN - IABCD = (P(3)-A(3))*os(an-i3, bn, cn, dn, m)+ & - (W(3)-P(3))*os(an-i3, bn, cn, dn, m+1)+ & - 0.5_dp*(an(3)-1)/xsi*os(an-i3-i3, bn, cn, dn, m)- & - 0.5_dp*(an(3)-1)/xsi*rho/xsi*os(an-i3-i3, bn, cn, dn, m+1) + IABCD = (P(3) - A(3))*os(an - i3, bn, cn, dn, m) + & + (W(3) - P(3))*os(an - i3, bn, cn, dn, m + 1) + & + 0.5_dp*(an(3) - 1)/xsi*os(an - i3 - i3, bn, cn, dn, m) - & + 0.5_dp*(an(3) - 1)/xsi*rho/xsi*os(an - i3 - i3, bn, cn, dn, m + 1) ELSE CPABORT("I(0000)") END IF diff --git a/src/aobasis/ai_fermi_contact.F b/src/aobasis/ai_fermi_contact.F index bb1ecc6cf7..b2fa0857bb 100644 --- a/src/aobasis/ai_fermi_contact.F +++ b/src/aobasis/ai_fermi_contact.F @@ -86,8 +86,8 @@ SUBROUTINE fermi_contact(la_max, la_min, npgfa, rpgfa, zeta, & ! *** Calculate some prefactors *** - dac2 = rac(1)**2+rac(2)**2+rac(3)**2 - dbc2 = rbc(1)**2+rbc(2)**2+rbc(3)**2 + dac2 = rac(1)**2 + rac(2)**2 + rac(3)**2 + dbc2 = rbc(1)**2 + rbc(2)**2 + rbc(3)**2 ! *** Loop over all pairs of primitive Gaussian-type functions *** @@ -101,19 +101,19 @@ SUBROUTINE fermi_contact(la_max, la_min, npgfa, rpgfa, zeta, & ! *** Screening *** - IF (rpgfa(ipgf)+rpgfb(jpgf) < dab) THEN - DO j = nb+1, nb+ncoset(lb_max) - DO i = na+1, na+ncoset(la_max) + IF (rpgfa(ipgf) + rpgfb(jpgf) < dab) THEN + DO j = nb + 1, nb + ncoset(lb_max) + DO i = na + 1, na + ncoset(la_max) fcab(i, j) = 0.0_dp ENDDO ENDDO - nb = nb+ncoset(lb_max) + nb = nb + ncoset(lb_max) CYCLE ENDIF ! *** Calculate some prefactors *** - f0 = 4.0_dp/3.0_dp*pi*EXP(-zeta(ipgf)*dac2-zetb(jpgf)*dbc2) + f0 = 4.0_dp/3.0_dp*pi*EXP(-zeta(ipgf)*dac2 - zetb(jpgf)*dbc2) ! *** Calculate the primitive Fermi contact integrals *** @@ -121,10 +121,10 @@ SUBROUTINE fermi_contact(la_max, la_min, npgfa, rpgfa, zeta, & DO bx = 0, lb fbx = 1.0_dp IF (bx .GT. 0) fbx = (rbc(1))**bx - DO by = 0, lb-bx - bz = lb-bx-by + DO by = 0, lb - bx + bz = lb - bx - by cob = coset(bx, by, bz) - mb = nb+cob + mb = nb + cob fby = 1.0_dp IF (by .GT. 0) fby = (rbc(2))**by fbz = 1.0_dp @@ -133,10 +133,10 @@ SUBROUTINE fermi_contact(la_max, la_min, npgfa, rpgfa, zeta, & DO ax = 0, la fax = fbx IF (ax .GT. 0) fax = fbx*(rac(1))**ax - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay coa = coset(ax, ay, az) - ma = na+coa + ma = na + coa fay = fby IF (ay .GT. 0) fay = fby*(rac(2))**ay faz = fbz @@ -152,11 +152,11 @@ SUBROUTINE fermi_contact(la_max, la_min, npgfa, rpgfa, zeta, & ENDDO ENDDO !lb - nb = nb+ncoset(lb_max) + nb = nb + ncoset(lb_max) ENDDO - na = na+ncoset(la_max) + na = na + ncoset(la_max) ENDDO diff --git a/src/aobasis/ai_kinetic.F b/src/aobasis/ai_kinetic.F index c06410b190..37cafc71b3 100644 --- a/src/aobasis/ai_kinetic.F +++ b/src/aobasis/ai_kinetic.F @@ -80,31 +80,31 @@ SUBROUTINE kinetic(la_max, la_min, npgfa, rpgfa, zeta, & ! Distance of the centers a and b - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) tab = SQRT(rab2) ! Maximum l for auxiliary integrals IF (PRESENT(kab)) THEN - lma = la_max+1 - lmb = lb_max+1 + lma = la_max + 1 + lmb = lb_max + 1 END IF IF (PRESENT(dab)) THEN - lma = la_max+2 - lmb = lb_max+1 - idx = coset(1, 0, 0)-coset(0, 0, 0) - idy = coset(0, 1, 0)-coset(0, 0, 0) - idz = coset(0, 0, 1)-coset(0, 0, 0) + lma = la_max + 2 + lmb = lb_max + 1 + idx = coset(1, 0, 0) - coset(0, 0, 0) + idy = coset(0, 1, 0) - coset(0, 0, 0) + idz = coset(0, 0, 1) - coset(0, 0, 0) END IF - ldrr = MAX(lma, lmb)+1 + ldrr = MAX(lma, lmb) + 1 ! Allocate space for auxiliary integrals - ALLOCATE (rr(0:ldrr-1, 0:ldrr-1, 3), tt(0:ldrr-1, 0:ldrr-1, 3)) + ALLOCATE (rr(0:ldrr - 1, 0:ldrr - 1, 3), tt(0:ldrr - 1, 0:ldrr - 1, 3)) ! Number of integrals, check size of arrays - ofa = ncoset(la_min-1) - ofb = ncoset(lb_min-1) - na = ncoset(la_max)-ofa - nb = ncoset(lb_max)-ofb + ofa = ncoset(la_min - 1) + ofb = ncoset(lb_min - 1) + na = ncoset(la_max) - ofa + nb = ncoset(lb_max) - ofb IF (PRESENT(kab)) THEN CPASSERT((SIZE(kab, 1) >= na*npgfa)) CPASSERT((SIZE(kab, 2) >= nb*npgfb)) @@ -121,17 +121,17 @@ SUBROUTINE kinetic(la_max, la_min, npgfa, rpgfa, zeta, & mb = 0 DO jpgf = 1, npgfb ! Distance Screening - IF (rpgfa(ipgf)+rpgfb(jpgf) < tab) THEN - IF (PRESENT(kab)) kab(ma+1:ma+na, mb+1:mb+nb) = 0.0_dp - IF (PRESENT(dab)) dab(ma+1:ma+na, mb+1:mb+nb, 1:3) = 0.0_dp - mb = mb+nb + IF (rpgfa(ipgf) + rpgfb(jpgf) < tab) THEN + IF (PRESENT(kab)) kab(ma + 1:ma + na, mb + 1:mb + nb) = 0.0_dp + IF (PRESENT(dab)) dab(ma + 1:ma + na, mb + 1:mb + nb, 1:3) = 0.0_dp + mb = mb + nb CYCLE ENDIF ! Calculate some prefactors a = zeta(ipgf) b = zetb(jpgf) - zet = a+b + zet = a + b xhi = a*b/zet rap = b*rab/zet rbp = -a*rab/zet @@ -143,70 +143,70 @@ SUBROUTINE kinetic(la_max, la_min, npgfa, rpgfa, zeta, & CALL os_rr_ovlp(rap, lma, rbp, lmb, zet, ldrr, rr) ! kinetic energy auxiliary integrals, overlap of [da/dx|db/dx] - DO la = 0, lma-1 - DO lb = 0, lmb-1 - tt(la, lb, 1) = 4.0_dp*a*b*rr(la+1, lb+1, 1) - tt(la, lb, 2) = 4.0_dp*a*b*rr(la+1, lb+1, 2) - tt(la, lb, 3) = 4.0_dp*a*b*rr(la+1, lb+1, 3) + DO la = 0, lma - 1 + DO lb = 0, lmb - 1 + tt(la, lb, 1) = 4.0_dp*a*b*rr(la + 1, lb + 1, 1) + tt(la, lb, 2) = 4.0_dp*a*b*rr(la + 1, lb + 1, 2) + tt(la, lb, 3) = 4.0_dp*a*b*rr(la + 1, lb + 1, 3) IF (la > 0 .AND. lb > 0) THEN - tt(la, lb, 1) = tt(la, lb, 1)+REAL(la*lb, dp)*rr(la-1, lb-1, 1) - tt(la, lb, 2) = tt(la, lb, 2)+REAL(la*lb, dp)*rr(la-1, lb-1, 2) - tt(la, lb, 3) = tt(la, lb, 3)+REAL(la*lb, dp)*rr(la-1, lb-1, 3) + tt(la, lb, 1) = tt(la, lb, 1) + REAL(la*lb, dp)*rr(la - 1, lb - 1, 1) + tt(la, lb, 2) = tt(la, lb, 2) + REAL(la*lb, dp)*rr(la - 1, lb - 1, 2) + tt(la, lb, 3) = tt(la, lb, 3) + REAL(la*lb, dp)*rr(la - 1, lb - 1, 3) END IF IF (la > 0) THEN - tt(la, lb, 1) = tt(la, lb, 1)-2.0_dp*REAL(la, dp)*b*rr(la-1, lb+1, 1) - tt(la, lb, 2) = tt(la, lb, 2)-2.0_dp*REAL(la, dp)*b*rr(la-1, lb+1, 2) - tt(la, lb, 3) = tt(la, lb, 3)-2.0_dp*REAL(la, dp)*b*rr(la-1, lb+1, 3) + tt(la, lb, 1) = tt(la, lb, 1) - 2.0_dp*REAL(la, dp)*b*rr(la - 1, lb + 1, 1) + tt(la, lb, 2) = tt(la, lb, 2) - 2.0_dp*REAL(la, dp)*b*rr(la - 1, lb + 1, 2) + tt(la, lb, 3) = tt(la, lb, 3) - 2.0_dp*REAL(la, dp)*b*rr(la - 1, lb + 1, 3) END IF IF (lb > 0) THEN - tt(la, lb, 1) = tt(la, lb, 1)-2.0_dp*REAL(lb, dp)*a*rr(la+1, lb-1, 1) - tt(la, lb, 2) = tt(la, lb, 2)-2.0_dp*REAL(lb, dp)*a*rr(la+1, lb-1, 2) - tt(la, lb, 3) = tt(la, lb, 3)-2.0_dp*REAL(lb, dp)*a*rr(la+1, lb-1, 3) + tt(la, lb, 1) = tt(la, lb, 1) - 2.0_dp*REAL(lb, dp)*a*rr(la + 1, lb - 1, 1) + tt(la, lb, 2) = tt(la, lb, 2) - 2.0_dp*REAL(lb, dp)*a*rr(la + 1, lb - 1, 2) + tt(la, lb, 3) = tt(la, lb, 3) - 2.0_dp*REAL(lb, dp)*a*rr(la + 1, lb - 1, 3) END IF END DO END DO DO lb = lb_min, lb_max DO bx = 0, lb - DO by = 0, lb-bx - bz = lb-bx-by - cob = coset(bx, by, bz)-ofb - ib = mb+cob + DO by = 0, lb - bx + bz = lb - bx - by + cob = coset(bx, by, bz) - ofb + ib = mb + cob DO la = la_min, la_max DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay - coa = coset(ax, ay, az)-ofa - ia = ma+coa + DO ay = 0, la - ax + az = la - ax - ay + coa = coset(ax, ay, az) - ofa + ia = ma + coa ! integrals IF (PRESENT(kab)) THEN - kab(ia, ib) = f0*(tt(ax, bx, 1)*rr(ay, by, 2)*rr(az, bz, 3)+ & - rr(ax, bx, 1)*tt(ay, by, 2)*rr(az, bz, 3)+ & + kab(ia, ib) = f0*(tt(ax, bx, 1)*rr(ay, by, 2)*rr(az, bz, 3) + & + rr(ax, bx, 1)*tt(ay, by, 2)*rr(az, bz, 3) + & rr(ax, bx, 1)*rr(ay, by, 2)*tt(az, bz, 3)) END IF ! first derivatives IF (PRESENT(dab)) THEN ! dx - dsx = 2.0_dp*a*rr(ax+1, bx, 1) - IF (ax > 0) dsx = dsx-REAL(ax, dp)*rr(ax-1, bx, 1) - dtx = 2.0_dp*a*tt(ax+1, bx, 1) - IF (ax > 0) dtx = dtx-REAL(ax, dp)*tt(ax-1, bx, 1) - dab(ia, ib, idx) = dtx*rr(ay, by, 2)*rr(az, bz, 3)+ & - dsx*(tt(ay, by, 2)*rr(az, bz, 3)+rr(ay, by, 2)*tt(az, bz, 3)) + dsx = 2.0_dp*a*rr(ax + 1, bx, 1) + IF (ax > 0) dsx = dsx - REAL(ax, dp)*rr(ax - 1, bx, 1) + dtx = 2.0_dp*a*tt(ax + 1, bx, 1) + IF (ax > 0) dtx = dtx - REAL(ax, dp)*tt(ax - 1, bx, 1) + dab(ia, ib, idx) = dtx*rr(ay, by, 2)*rr(az, bz, 3) + & + dsx*(tt(ay, by, 2)*rr(az, bz, 3) + rr(ay, by, 2)*tt(az, bz, 3)) ! dy - dsy = 2.0_dp*a*rr(ay+1, by, 2) - IF (ay > 0) dsy = dsy-REAL(ay, dp)*rr(ay-1, by, 2) - dty = 2.0_dp*a*tt(ay+1, by, 2) - IF (ay > 0) dty = dty-REAL(ay, dp)*tt(ay-1, by, 2) - dab(ia, ib, idy) = dty*rr(ax, bx, 1)*rr(az, bz, 3)+ & - dsy*(tt(ax, bx, 1)*rr(az, bz, 3)+rr(ax, bx, 1)*tt(az, bz, 3)) + dsy = 2.0_dp*a*rr(ay + 1, by, 2) + IF (ay > 0) dsy = dsy - REAL(ay, dp)*rr(ay - 1, by, 2) + dty = 2.0_dp*a*tt(ay + 1, by, 2) + IF (ay > 0) dty = dty - REAL(ay, dp)*tt(ay - 1, by, 2) + dab(ia, ib, idy) = dty*rr(ax, bx, 1)*rr(az, bz, 3) + & + dsy*(tt(ax, bx, 1)*rr(az, bz, 3) + rr(ax, bx, 1)*tt(az, bz, 3)) ! dz - dsz = 2.0_dp*a*rr(az+1, bz, 3) - IF (az > 0) dsz = dsz-REAL(az, dp)*rr(az-1, bz, 3) - dtz = 2.0_dp*a*tt(az+1, bz, 3) - IF (az > 0) dtz = dtz-REAL(az, dp)*tt(az-1, bz, 3) - dab(ia, ib, idz) = dtz*rr(ax, bx, 1)*rr(ay, by, 2)+ & - dsz*(tt(ax, bx, 1)*rr(ay, by, 2)+rr(ax, bx, 1)*tt(ay, by, 2)) + dsz = 2.0_dp*a*rr(az + 1, bz, 3) + IF (az > 0) dsz = dsz - REAL(az, dp)*rr(az - 1, bz, 3) + dtz = 2.0_dp*a*tt(az + 1, bz, 3) + IF (az > 0) dtz = dtz - REAL(az, dp)*tt(az - 1, bz, 3) + dab(ia, ib, idz) = dtz*rr(ax, bx, 1)*rr(ay, by, 2) + & + dsz*(tt(ax, bx, 1)*rr(ay, by, 2) + rr(ax, bx, 1)*tt(ay, by, 2)) ! scale dab(ia, ib, 1:3) = f0*dab(ia, ib, 1:3) END IF @@ -218,9 +218,9 @@ SUBROUTINE kinetic(la_max, la_min, npgfa, rpgfa, zeta, & ENDDO ENDDO !lb - mb = mb+nb + mb = mb + nb END DO - ma = ma+na + ma = ma + na END DO DEALLOCATE (rr, tt) diff --git a/src/aobasis/ai_moments.F b/src/aobasis/ai_moments.F index 302b47b2f1..0858a83ab2 100644 --- a/src/aobasis/ai_moments.F +++ b/src/aobasis/ai_moments.F @@ -173,15 +173,15 @@ SUBROUTINE cossin(la_max_set, npgfa, zeta, rpgfa, la_min_set, & REAL(KIND=dp), & DIMENSION(ncoset(la_max_set+1), ncoset(lb_max)) :: sc, ss - rab = rbc-rac + rab = rbc - rac rab2 = SUM(rab**2) dab = SQRT(rab2) - k2 = kvec(1)*kvec(1)+kvec(2)*kvec(2)+kvec(3)*kvec(3) + k2 = kvec(1)*kvec(1) + kvec(2)*kvec(2) + kvec(3)*kvec(3) IF (PRESENT(dcosab)) THEN da_max = 1 - la_max = la_max_set+1 - la_min = MAX(0, la_min_set-1) + la_max = la_max_set + 1 + la_min = MAX(0, la_min_set - 1) dscos = 0.0_dp dssin = 0.0_dp ELSE @@ -192,7 +192,7 @@ SUBROUTINE cossin(la_max_set, npgfa, zeta, rpgfa, la_min_set, & ! initialize all matrix elements to zero IF (PRESENT(dcosab)) THEN - na = ncoset(la_max-1)*npgfa + na = ncoset(la_max - 1)*npgfa ELSE na = ncoset(la_max)*npgfa END IF @@ -216,20 +216,20 @@ SUBROUTINE cossin(la_max_set, npgfa, zeta, rpgfa, la_min_set, & sc = 0.0_dp ! *** Screening *** - IF (rpgfa(ipgf)+rpgfb(jpgf) < dab) THEN - nb = nb+ncoset(lb_max) + IF (rpgfa(ipgf) + rpgfb(jpgf) < dab) THEN + nb = nb + ncoset(lb_max) CYCLE END IF ! *** Calculate some prefactors *** - zetp = 1.0_dp/(zeta(ipgf)+zetb(jpgf)) + zetp = 1.0_dp/(zeta(ipgf) + zetb(jpgf)) f0 = (pi*zetp)**1.5_dp f1 = zetb(jpgf)*zetp f2 = 0.5_dp*zetp - kdp = zetp*DOT_PRODUCT(kvec, zeta(ipgf)*rac+zetb(jpgf)*rbc) + kdp = zetp*DOT_PRODUCT(kvec, zeta(ipgf)*rac + zetb(jpgf)*rbc) ! *** Calculate the basic two-center cos/sin integral [s|cos/sin|s] *** @@ -247,12 +247,12 @@ SUBROUTINE cossin(la_max_set, npgfa, zeta, rpgfa, la_min_set, & ! *** [p|O|s] = (Pi - Ai)*[s|O|s] +[s|dO|s] (i = x,y,z) *** - sc(2, 1) = rap(1)*sc(1, 1)-f2*kvec(1)*ss(1, 1) - sc(3, 1) = rap(2)*sc(1, 1)-f2*kvec(2)*ss(1, 1) - sc(4, 1) = rap(3)*sc(1, 1)-f2*kvec(3)*ss(1, 1) - ss(2, 1) = rap(1)*ss(1, 1)+f2*kvec(1)*sc(1, 1) - ss(3, 1) = rap(2)*ss(1, 1)+f2*kvec(2)*sc(1, 1) - ss(4, 1) = rap(3)*ss(1, 1)+f2*kvec(3)*sc(1, 1) + sc(2, 1) = rap(1)*sc(1, 1) - f2*kvec(1)*ss(1, 1) + sc(3, 1) = rap(2)*sc(1, 1) - f2*kvec(2)*ss(1, 1) + sc(4, 1) = rap(3)*sc(1, 1) - f2*kvec(3)*ss(1, 1) + ss(2, 1) = rap(1)*ss(1, 1) + f2*kvec(1)*sc(1, 1) + ss(3, 1) = rap(2)*ss(1, 1) + f2*kvec(2)*sc(1, 1) + ss(4, 1) = rap(3)*ss(1, 1) + f2*kvec(3)*sc(1, 1) ! *** [a|O|s] = (Pi - Ai)*[a-1i|O|s] + f2*Ni(a-1i)*[a-2i|s] *** ! *** + [a-1i|dO|s] *** @@ -261,51 +261,51 @@ SUBROUTINE cossin(la_max_set, npgfa, zeta, rpgfa, la_min_set, & ! *** Increase the angular momentum component z of function a *** - sc(coset(0, 0, la), 1) = rap(3)*sc(coset(0, 0, la-1), 1)+ & - f2*REAL(la-1, dp)*sc(coset(0, 0, la-2), 1)- & - f2*kvec(3)*ss(coset(0, 0, la-1), 1) - ss(coset(0, 0, la), 1) = rap(3)*ss(coset(0, 0, la-1), 1)+ & - f2*REAL(la-1, dp)*ss(coset(0, 0, la-2), 1)+ & - f2*kvec(3)*sc(coset(0, 0, la-1), 1) + sc(coset(0, 0, la), 1) = rap(3)*sc(coset(0, 0, la - 1), 1) + & + f2*REAL(la - 1, dp)*sc(coset(0, 0, la - 2), 1) - & + f2*kvec(3)*ss(coset(0, 0, la - 1), 1) + ss(coset(0, 0, la), 1) = rap(3)*ss(coset(0, 0, la - 1), 1) + & + f2*REAL(la - 1, dp)*ss(coset(0, 0, la - 2), 1) + & + f2*kvec(3)*sc(coset(0, 0, la - 1), 1) ! *** Increase the angular momentum component y of function a *** - az = la-1 - sc(coset(0, 1, az), 1) = rap(2)*sc(coset(0, 0, az), 1)- & + az = la - 1 + sc(coset(0, 1, az), 1) = rap(2)*sc(coset(0, 0, az), 1) - & f2*kvec(2)*ss(coset(0, 0, az), 1) - ss(coset(0, 1, az), 1) = rap(2)*ss(coset(0, 0, az), 1)+ & + ss(coset(0, 1, az), 1) = rap(2)*ss(coset(0, 0, az), 1) + & f2*kvec(2)*sc(coset(0, 0, az), 1) DO ay = 2, la - az = la-ay - sc(coset(0, ay, az), 1) = rap(2)*sc(coset(0, ay-1, az), 1)+ & - f2*REAL(ay-1, dp)*sc(coset(0, ay-2, az), 1)- & - f2*kvec(2)*ss(coset(0, ay-1, az), 1) - ss(coset(0, ay, az), 1) = rap(2)*ss(coset(0, ay-1, az), 1)+ & - f2*REAL(ay-1, dp)*ss(coset(0, ay-2, az), 1)+ & - f2*kvec(2)*sc(coset(0, ay-1, az), 1) + az = la - ay + sc(coset(0, ay, az), 1) = rap(2)*sc(coset(0, ay - 1, az), 1) + & + f2*REAL(ay - 1, dp)*sc(coset(0, ay - 2, az), 1) - & + f2*kvec(2)*ss(coset(0, ay - 1, az), 1) + ss(coset(0, ay, az), 1) = rap(2)*ss(coset(0, ay - 1, az), 1) + & + f2*REAL(ay - 1, dp)*ss(coset(0, ay - 2, az), 1) + & + f2*kvec(2)*sc(coset(0, ay - 1, az), 1) END DO ! *** Increase the angular momentum component x of function a *** - DO ay = 0, la-1 - az = la-1-ay - sc(coset(1, ay, az), 1) = rap(1)*sc(coset(0, ay, az), 1)- & + DO ay = 0, la - 1 + az = la - 1 - ay + sc(coset(1, ay, az), 1) = rap(1)*sc(coset(0, ay, az), 1) - & f2*kvec(1)*ss(coset(0, ay, az), 1) - ss(coset(1, ay, az), 1) = rap(1)*ss(coset(0, ay, az), 1)+ & + ss(coset(1, ay, az), 1) = rap(1)*ss(coset(0, ay, az), 1) + & f2*kvec(1)*sc(coset(0, ay, az), 1) END DO DO ax = 2, la - f3 = f2*REAL(ax-1, dp) - DO ay = 0, la-ax - az = la-ax-ay - sc(coset(ax, ay, az), 1) = rap(1)*sc(coset(ax-1, ay, az), 1)+ & - f3*sc(coset(ax-2, ay, az), 1)- & - f2*kvec(1)*ss(coset(ax-1, ay, az), 1) - ss(coset(ax, ay, az), 1) = rap(1)*ss(coset(ax-1, ay, az), 1)+ & - f3*ss(coset(ax-2, ay, az), 1)+ & - f2*kvec(1)*sc(coset(ax-1, ay, az), 1) + f3 = f2*REAL(ax - 1, dp) + DO ay = 0, la - ax + az = la - ax - ay + sc(coset(ax, ay, az), 1) = rap(1)*sc(coset(ax - 1, ay, az), 1) + & + f3*sc(coset(ax - 2, ay, az), 1) - & + f2*kvec(1)*ss(coset(ax - 1, ay, az), 1) + ss(coset(ax, ay, az), 1) = rap(1)*ss(coset(ax - 1, ay, az), 1) + & + f3*ss(coset(ax - 2, ay, az), 1) + & + f2*kvec(1)*sc(coset(ax - 1, ay, az), 1) END DO END DO @@ -324,31 +324,31 @@ SUBROUTINE cossin(la_max_set, npgfa, zeta, rpgfa, la_min_set, & ! *** Horizontal recurrence steps *** - rbp(:) = rap(:)-rab(:) + rbp(:) = rap(:) - rab(:) ! *** [a|O|p] = [a+1i|O|s] - (Bi - Ai)*[a|O|s] *** IF (lb_max == 1) THEN la_start = la_min ELSE - la_start = MAX(0, la_min-1) + la_start = MAX(0, la_min - 1) END IF - DO la = la_start, la_max-1 + DO la = la_start, la_max - 1 DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay - sc(coset(ax, ay, az), 2) = sc(coset(ax+1, ay, az), 1)- & + DO ay = 0, la - ax + az = la - ax - ay + sc(coset(ax, ay, az), 2) = sc(coset(ax + 1, ay, az), 1) - & rab(1)*sc(coset(ax, ay, az), 1) - sc(coset(ax, ay, az), 3) = sc(coset(ax, ay+1, az), 1)- & + sc(coset(ax, ay, az), 3) = sc(coset(ax, ay + 1, az), 1) - & rab(2)*sc(coset(ax, ay, az), 1) - sc(coset(ax, ay, az), 4) = sc(coset(ax, ay, az+1), 1)- & + sc(coset(ax, ay, az), 4) = sc(coset(ax, ay, az + 1), 1) - & rab(3)*sc(coset(ax, ay, az), 1) - ss(coset(ax, ay, az), 2) = ss(coset(ax+1, ay, az), 1)- & + ss(coset(ax, ay, az), 2) = ss(coset(ax + 1, ay, az), 1) - & rab(1)*ss(coset(ax, ay, az), 1) - ss(coset(ax, ay, az), 3) = ss(coset(ax, ay+1, az), 1)- & + ss(coset(ax, ay, az), 3) = ss(coset(ax, ay + 1, az), 1) - & rab(2)*ss(coset(ax, ay, az), 1) - ss(coset(ax, ay, az), 4) = ss(coset(ax, ay, az+1), 1)- & + ss(coset(ax, ay, az), 4) = ss(coset(ax, ay, az + 1), 1) - & rab(3)*ss(coset(ax, ay, az), 1) END DO END DO @@ -361,47 +361,47 @@ SUBROUTINE cossin(la_max_set, npgfa, zeta, rpgfa, la_min_set, & DO ax = 0, la_max fx = f2*REAL(ax, dp) - DO ay = 0, la_max-ax + DO ay = 0, la_max - ax fy = f2*REAL(ay, dp) - az = la_max-ax-ay + az = la_max - ax - ay fz = f2*REAL(az, dp) IF (ax == 0) THEN - sc(coset(ax, ay, az), 2) = rbp(1)*sc(coset(ax, ay, az), 1)- & + sc(coset(ax, ay, az), 2) = rbp(1)*sc(coset(ax, ay, az), 1) - & f2*kvec(1)*ss(coset(ax, ay, az), 1) - ss(coset(ax, ay, az), 2) = rbp(1)*ss(coset(ax, ay, az), 1)+ & + ss(coset(ax, ay, az), 2) = rbp(1)*ss(coset(ax, ay, az), 1) + & f2*kvec(1)*sc(coset(ax, ay, az), 1) ELSE - sc(coset(ax, ay, az), 2) = rbp(1)*sc(coset(ax, ay, az), 1)+ & - fx*sc(coset(ax-1, ay, az), 1)- & + sc(coset(ax, ay, az), 2) = rbp(1)*sc(coset(ax, ay, az), 1) + & + fx*sc(coset(ax - 1, ay, az), 1) - & f2*kvec(1)*ss(coset(ax, ay, az), 1) - ss(coset(ax, ay, az), 2) = rbp(1)*ss(coset(ax, ay, az), 1)+ & - fx*ss(coset(ax-1, ay, az), 1)+ & + ss(coset(ax, ay, az), 2) = rbp(1)*ss(coset(ax, ay, az), 1) + & + fx*ss(coset(ax - 1, ay, az), 1) + & f2*kvec(1)*sc(coset(ax, ay, az), 1) END IF IF (ay == 0) THEN - sc(coset(ax, ay, az), 3) = rbp(2)*sc(coset(ax, ay, az), 1)- & + sc(coset(ax, ay, az), 3) = rbp(2)*sc(coset(ax, ay, az), 1) - & f2*kvec(2)*ss(coset(ax, ay, az), 1) - ss(coset(ax, ay, az), 3) = rbp(2)*ss(coset(ax, ay, az), 1)+ & + ss(coset(ax, ay, az), 3) = rbp(2)*ss(coset(ax, ay, az), 1) + & f2*kvec(2)*sc(coset(ax, ay, az), 1) ELSE - sc(coset(ax, ay, az), 3) = rbp(2)*sc(coset(ax, ay, az), 1)+ & - fy*sc(coset(ax, ay-1, az), 1)- & + sc(coset(ax, ay, az), 3) = rbp(2)*sc(coset(ax, ay, az), 1) + & + fy*sc(coset(ax, ay - 1, az), 1) - & f2*kvec(2)*ss(coset(ax, ay, az), 1) - ss(coset(ax, ay, az), 3) = rbp(2)*ss(coset(ax, ay, az), 1)+ & - fy*ss(coset(ax, ay-1, az), 1)+ & + ss(coset(ax, ay, az), 3) = rbp(2)*ss(coset(ax, ay, az), 1) + & + fy*ss(coset(ax, ay - 1, az), 1) + & f2*kvec(2)*sc(coset(ax, ay, az), 1) END IF IF (az == 0) THEN - sc(coset(ax, ay, az), 4) = rbp(3)*sc(coset(ax, ay, az), 1)- & + sc(coset(ax, ay, az), 4) = rbp(3)*sc(coset(ax, ay, az), 1) - & f2*kvec(3)*ss(coset(ax, ay, az), 1) - ss(coset(ax, ay, az), 4) = rbp(3)*ss(coset(ax, ay, az), 1)+ & + ss(coset(ax, ay, az), 4) = rbp(3)*ss(coset(ax, ay, az), 1) + & f2*kvec(3)*sc(coset(ax, ay, az), 1) ELSE - sc(coset(ax, ay, az), 4) = rbp(3)*sc(coset(ax, ay, az), 1)+ & - fz*sc(coset(ax, ay, az-1), 1)- & + sc(coset(ax, ay, az), 4) = rbp(3)*sc(coset(ax, ay, az), 1) + & + fz*sc(coset(ax, ay, az - 1), 1) - & f2*kvec(3)*ss(coset(ax, ay, az), 1) - ss(coset(ax, ay, az), 4) = rbp(3)*ss(coset(ax, ay, az), 1)+ & - fz*ss(coset(ax, ay, az-1), 1)+ & + ss(coset(ax, ay, az), 4) = rbp(3)*ss(coset(ax, ay, az), 1) + & + fz*ss(coset(ax, ay, az - 1), 1) + & f2*kvec(3)*sc(coset(ax, ay, az), 1) END IF END DO @@ -418,46 +418,46 @@ SUBROUTINE cossin(la_max_set, npgfa, zeta, rpgfa, la_min_set, & IF (lb == lb_max) THEN la_start = la_min ELSE - la_start = MAX(0, la_min-1) + la_start = MAX(0, la_min - 1) END IF - DO la = la_start, la_max-1 + DO la = la_start, la_max - 1 DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay ! *** Shift of angular momentum component z from a to b *** sc(coset(ax, ay, az), coset(0, 0, lb)) = & - sc(coset(ax, ay, az+1), coset(0, 0, lb-1))- & - rab(3)*sc(coset(ax, ay, az), coset(0, 0, lb-1)) + sc(coset(ax, ay, az + 1), coset(0, 0, lb - 1)) - & + rab(3)*sc(coset(ax, ay, az), coset(0, 0, lb - 1)) ss(coset(ax, ay, az), coset(0, 0, lb)) = & - ss(coset(ax, ay, az+1), coset(0, 0, lb-1))- & - rab(3)*ss(coset(ax, ay, az), coset(0, 0, lb-1)) + ss(coset(ax, ay, az + 1), coset(0, 0, lb - 1)) - & + rab(3)*ss(coset(ax, ay, az), coset(0, 0, lb - 1)) ! *** Shift of angular momentum component y from a to b *** DO by = 1, lb - bz = lb-by + bz = lb - by sc(coset(ax, ay, az), coset(0, by, bz)) = & - sc(coset(ax, ay+1, az), coset(0, by-1, bz))- & - rab(2)*sc(coset(ax, ay, az), coset(0, by-1, bz)) + sc(coset(ax, ay + 1, az), coset(0, by - 1, bz)) - & + rab(2)*sc(coset(ax, ay, az), coset(0, by - 1, bz)) ss(coset(ax, ay, az), coset(0, by, bz)) = & - ss(coset(ax, ay+1, az), coset(0, by-1, bz))- & - rab(2)*ss(coset(ax, ay, az), coset(0, by-1, bz)) + ss(coset(ax, ay + 1, az), coset(0, by - 1, bz)) - & + rab(2)*ss(coset(ax, ay, az), coset(0, by - 1, bz)) END DO ! *** Shift of angular momentum component x from a to b *** DO bx = 1, lb - DO by = 0, lb-bx - bz = lb-bx-by + DO by = 0, lb - bx + bz = lb - bx - by sc(coset(ax, ay, az), coset(bx, by, bz)) = & - sc(coset(ax+1, ay, az), coset(bx-1, by, bz))- & - rab(1)*sc(coset(ax, ay, az), coset(bx-1, by, bz)) + sc(coset(ax + 1, ay, az), coset(bx - 1, by, bz)) - & + rab(1)*sc(coset(ax, ay, az), coset(bx - 1, by, bz)) ss(coset(ax, ay, az), coset(bx, by, bz)) = & - ss(coset(ax+1, ay, az), coset(bx-1, by, bz))- & - rab(1)*ss(coset(ax, ay, az), coset(bx-1, by, bz)) + ss(coset(ax + 1, ay, az), coset(bx - 1, by, bz)) - & + rab(1)*ss(coset(ax, ay, az), coset(bx - 1, by, bz)) END DO END DO @@ -472,141 +472,141 @@ SUBROUTINE cossin(la_max_set, npgfa, zeta, rpgfa, la_min_set, & DO ax = 0, la_max fx = f2*REAL(ax, dp) - DO ay = 0, la_max-ax + DO ay = 0, la_max - ax fy = f2*REAL(ay, dp) - az = la_max-ax-ay + az = la_max - ax - ay fz = f2*REAL(az, dp) ! *** Increase the angular momentum component z of function b *** - f3 = f2*REAL(lb-1, dp) + f3 = f2*REAL(lb - 1, dp) IF (az == 0) THEN sc(coset(ax, ay, az), coset(0, 0, lb)) = & - rbp(3)*sc(coset(ax, ay, az), coset(0, 0, lb-1))+ & - f3*sc(coset(ax, ay, az), coset(0, 0, lb-2))- & - f2*kvec(3)*ss(coset(ax, ay, az), coset(0, 0, lb-1)) + rbp(3)*sc(coset(ax, ay, az), coset(0, 0, lb - 1)) + & + f3*sc(coset(ax, ay, az), coset(0, 0, lb - 2)) - & + f2*kvec(3)*ss(coset(ax, ay, az), coset(0, 0, lb - 1)) ss(coset(ax, ay, az), coset(0, 0, lb)) = & - rbp(3)*ss(coset(ax, ay, az), coset(0, 0, lb-1))+ & - f3*ss(coset(ax, ay, az), coset(0, 0, lb-2))+ & - f2*kvec(3)*sc(coset(ax, ay, az), coset(0, 0, lb-1)) + rbp(3)*ss(coset(ax, ay, az), coset(0, 0, lb - 1)) + & + f3*ss(coset(ax, ay, az), coset(0, 0, lb - 2)) + & + f2*kvec(3)*sc(coset(ax, ay, az), coset(0, 0, lb - 1)) ELSE sc(coset(ax, ay, az), coset(0, 0, lb)) = & - rbp(3)*sc(coset(ax, ay, az), coset(0, 0, lb-1))+ & - fz*sc(coset(ax, ay, az-1), coset(0, 0, lb-1))+ & - f3*sc(coset(ax, ay, az), coset(0, 0, lb-2))- & - f2*kvec(3)*ss(coset(ax, ay, az), coset(0, 0, lb-1)) + rbp(3)*sc(coset(ax, ay, az), coset(0, 0, lb - 1)) + & + fz*sc(coset(ax, ay, az - 1), coset(0, 0, lb - 1)) + & + f3*sc(coset(ax, ay, az), coset(0, 0, lb - 2)) - & + f2*kvec(3)*ss(coset(ax, ay, az), coset(0, 0, lb - 1)) ss(coset(ax, ay, az), coset(0, 0, lb)) = & - rbp(3)*ss(coset(ax, ay, az), coset(0, 0, lb-1))+ & - fz*ss(coset(ax, ay, az-1), coset(0, 0, lb-1))+ & - f3*ss(coset(ax, ay, az), coset(0, 0, lb-2))+ & - f2*kvec(3)*sc(coset(ax, ay, az), coset(0, 0, lb-1)) + rbp(3)*ss(coset(ax, ay, az), coset(0, 0, lb - 1)) + & + fz*ss(coset(ax, ay, az - 1), coset(0, 0, lb - 1)) + & + f3*ss(coset(ax, ay, az), coset(0, 0, lb - 2)) + & + f2*kvec(3)*sc(coset(ax, ay, az), coset(0, 0, lb - 1)) END IF ! *** Increase the angular momentum component y of function b *** IF (ay == 0) THEN - bz = lb-1 + bz = lb - 1 sc(coset(ax, ay, az), coset(0, 1, bz)) = & - rbp(2)*sc(coset(ax, ay, az), coset(0, 0, bz))- & + rbp(2)*sc(coset(ax, ay, az), coset(0, 0, bz)) - & f2*kvec(2)*ss(coset(ax, ay, az), coset(0, 0, bz)) ss(coset(ax, ay, az), coset(0, 1, bz)) = & - rbp(2)*ss(coset(ax, ay, az), coset(0, 0, bz))+ & + rbp(2)*ss(coset(ax, ay, az), coset(0, 0, bz)) + & f2*kvec(2)*sc(coset(ax, ay, az), coset(0, 0, bz)) DO by = 2, lb - bz = lb-by - f3 = f2*REAL(by-1, dp) + bz = lb - by + f3 = f2*REAL(by - 1, dp) sc(coset(ax, ay, az), coset(0, by, bz)) = & - rbp(2)*sc(coset(ax, ay, az), coset(0, by-1, bz))+ & - f3*sc(coset(ax, ay, az), coset(0, by-2, bz))- & - f2*kvec(2)*ss(coset(ax, ay, az), coset(0, by-1, bz)) + rbp(2)*sc(coset(ax, ay, az), coset(0, by - 1, bz)) + & + f3*sc(coset(ax, ay, az), coset(0, by - 2, bz)) - & + f2*kvec(2)*ss(coset(ax, ay, az), coset(0, by - 1, bz)) ss(coset(ax, ay, az), coset(0, by, bz)) = & - rbp(2)*ss(coset(ax, ay, az), coset(0, by-1, bz))+ & - f3*ss(coset(ax, ay, az), coset(0, by-2, bz))+ & - f2*kvec(2)*sc(coset(ax, ay, az), coset(0, by-1, bz)) + rbp(2)*ss(coset(ax, ay, az), coset(0, by - 1, bz)) + & + f3*ss(coset(ax, ay, az), coset(0, by - 2, bz)) + & + f2*kvec(2)*sc(coset(ax, ay, az), coset(0, by - 1, bz)) END DO ELSE - bz = lb-1 + bz = lb - 1 sc(coset(ax, ay, az), coset(0, 1, bz)) = & - rbp(2)*sc(coset(ax, ay, az), coset(0, 0, bz))+ & - fy*sc(coset(ax, ay-1, az), coset(0, 0, bz))- & + rbp(2)*sc(coset(ax, ay, az), coset(0, 0, bz)) + & + fy*sc(coset(ax, ay - 1, az), coset(0, 0, bz)) - & f2*kvec(2)*ss(coset(ax, ay, az), coset(0, 0, bz)) ss(coset(ax, ay, az), coset(0, 1, bz)) = & - rbp(2)*ss(coset(ax, ay, az), coset(0, 0, bz))+ & - fy*ss(coset(ax, ay-1, az), coset(0, 0, bz))+ & + rbp(2)*ss(coset(ax, ay, az), coset(0, 0, bz)) + & + fy*ss(coset(ax, ay - 1, az), coset(0, 0, bz)) + & f2*kvec(2)*sc(coset(ax, ay, az), coset(0, 0, bz)) DO by = 2, lb - bz = lb-by - f3 = f2*REAL(by-1, dp) + bz = lb - by + f3 = f2*REAL(by - 1, dp) sc(coset(ax, ay, az), coset(0, by, bz)) = & - rbp(2)*sc(coset(ax, ay, az), coset(0, by-1, bz))+ & - fy*sc(coset(ax, ay-1, az), coset(0, by-1, bz))+ & - f3*sc(coset(ax, ay, az), coset(0, by-2, bz))- & - f2*kvec(2)*ss(coset(ax, ay, az), coset(0, by-1, bz)) + rbp(2)*sc(coset(ax, ay, az), coset(0, by - 1, bz)) + & + fy*sc(coset(ax, ay - 1, az), coset(0, by - 1, bz)) + & + f3*sc(coset(ax, ay, az), coset(0, by - 2, bz)) - & + f2*kvec(2)*ss(coset(ax, ay, az), coset(0, by - 1, bz)) ss(coset(ax, ay, az), coset(0, by, bz)) = & - rbp(2)*ss(coset(ax, ay, az), coset(0, by-1, bz))+ & - fy*ss(coset(ax, ay-1, az), coset(0, by-1, bz))+ & - f3*ss(coset(ax, ay, az), coset(0, by-2, bz))+ & - f2*kvec(2)*sc(coset(ax, ay, az), coset(0, by-1, bz)) + rbp(2)*ss(coset(ax, ay, az), coset(0, by - 1, bz)) + & + fy*ss(coset(ax, ay - 1, az), coset(0, by - 1, bz)) + & + f3*ss(coset(ax, ay, az), coset(0, by - 2, bz)) + & + f2*kvec(2)*sc(coset(ax, ay, az), coset(0, by - 1, bz)) END DO END IF ! *** Increase the angular momentum component x of function b *** IF (ax == 0) THEN - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by sc(coset(ax, ay, az), coset(1, by, bz)) = & - rbp(1)*sc(coset(ax, ay, az), coset(0, by, bz))- & + rbp(1)*sc(coset(ax, ay, az), coset(0, by, bz)) - & f2*kvec(1)*ss(coset(ax, ay, az), coset(0, by, bz)) ss(coset(ax, ay, az), coset(1, by, bz)) = & - rbp(1)*ss(coset(ax, ay, az), coset(0, by, bz))+ & + rbp(1)*ss(coset(ax, ay, az), coset(0, by, bz)) + & f2*kvec(1)*sc(coset(ax, ay, az), coset(0, by, bz)) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by sc(coset(ax, ay, az), coset(bx, by, bz)) = & rbp(1)*sc(coset(ax, ay, az), & - coset(bx-1, by, bz))+ & - f3*sc(coset(ax, ay, az), coset(bx-2, by, bz))- & - f2*kvec(1)*ss(coset(ax, ay, az), coset(bx-1, by, bz)) + coset(bx - 1, by, bz)) + & + f3*sc(coset(ax, ay, az), coset(bx - 2, by, bz)) - & + f2*kvec(1)*ss(coset(ax, ay, az), coset(bx - 1, by, bz)) ss(coset(ax, ay, az), coset(bx, by, bz)) = & rbp(1)*ss(coset(ax, ay, az), & - coset(bx-1, by, bz))+ & - f3*ss(coset(ax, ay, az), coset(bx-2, by, bz))+ & - f2*kvec(1)*sc(coset(ax, ay, az), coset(bx-1, by, bz)) + coset(bx - 1, by, bz)) + & + f3*ss(coset(ax, ay, az), coset(bx - 2, by, bz)) + & + f2*kvec(1)*sc(coset(ax, ay, az), coset(bx - 1, by, bz)) END DO END DO ELSE - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by sc(coset(ax, ay, az), coset(1, by, bz)) = & - rbp(1)*sc(coset(ax, ay, az), coset(0, by, bz))+ & - fx*sc(coset(ax-1, ay, az), coset(0, by, bz))- & + rbp(1)*sc(coset(ax, ay, az), coset(0, by, bz)) + & + fx*sc(coset(ax - 1, ay, az), coset(0, by, bz)) - & f2*kvec(1)*ss(coset(ax, ay, az), coset(0, by, bz)) ss(coset(ax, ay, az), coset(1, by, bz)) = & - rbp(1)*ss(coset(ax, ay, az), coset(0, by, bz))+ & - fx*ss(coset(ax-1, ay, az), coset(0, by, bz))+ & + rbp(1)*ss(coset(ax, ay, az), coset(0, by, bz)) + & + fx*ss(coset(ax - 1, ay, az), coset(0, by, bz)) + & f2*kvec(1)*sc(coset(ax, ay, az), coset(0, by, bz)) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by sc(coset(ax, ay, az), coset(bx, by, bz)) = & rbp(1)*sc(coset(ax, ay, az), & - coset(bx-1, by, bz))+ & - fx*sc(coset(ax-1, ay, az), coset(bx-1, by, bz))+ & - f3*sc(coset(ax, ay, az), coset(bx-2, by, bz))- & - f2*kvec(1)*ss(coset(ax, ay, az), coset(bx-1, by, bz)) + coset(bx - 1, by, bz)) + & + fx*sc(coset(ax - 1, ay, az), coset(bx - 1, by, bz)) + & + f3*sc(coset(ax, ay, az), coset(bx - 2, by, bz)) - & + f2*kvec(1)*ss(coset(ax, ay, az), coset(bx - 1, by, bz)) ss(coset(ax, ay, az), coset(bx, by, bz)) = & rbp(1)*ss(coset(ax, ay, az), & - coset(bx-1, by, bz))+ & - fx*ss(coset(ax-1, ay, az), coset(bx-1, by, bz))+ & - f3*ss(coset(ax, ay, az), coset(bx-2, by, bz))+ & - f2*kvec(1)*sc(coset(ax, ay, az), coset(bx-1, by, bz)) + coset(bx - 1, by, bz)) + & + fx*ss(coset(ax - 1, ay, az), coset(bx - 1, by, bz)) + & + f3*ss(coset(ax, ay, az), coset(bx - 2, by, bz)) + & + f2*kvec(1)*sc(coset(ax, ay, az), coset(bx - 1, by, bz)) END DO END DO END IF @@ -624,16 +624,16 @@ SUBROUTINE cossin(la_max_set, npgfa, zeta, rpgfa, la_min_set, & ! *** Vertical recurrence steps: [s|O|s] -> [s|O|b] *** - rbp(:) = (f1-1.0_dp)*rab(:) + rbp(:) = (f1 - 1.0_dp)*rab(:) ! *** [s|O|p] = (Pi - Bi)*[s|O|s] + [s|dO|s] *** - sc(1, 2) = rbp(1)*sc(1, 1)-f2*kvec(1)*ss(1, 1) - sc(1, 3) = rbp(2)*sc(1, 1)-f2*kvec(2)*ss(1, 1) - sc(1, 4) = rbp(3)*sc(1, 1)-f2*kvec(3)*ss(1, 1) - ss(1, 2) = rbp(1)*ss(1, 1)+f2*kvec(1)*sc(1, 1) - ss(1, 3) = rbp(2)*ss(1, 1)+f2*kvec(2)*sc(1, 1) - ss(1, 4) = rbp(3)*ss(1, 1)+f2*kvec(3)*sc(1, 1) + sc(1, 2) = rbp(1)*sc(1, 1) - f2*kvec(1)*ss(1, 1) + sc(1, 3) = rbp(2)*sc(1, 1) - f2*kvec(2)*ss(1, 1) + sc(1, 4) = rbp(3)*sc(1, 1) - f2*kvec(3)*ss(1, 1) + ss(1, 2) = rbp(1)*ss(1, 1) + f2*kvec(1)*sc(1, 1) + ss(1, 3) = rbp(2)*ss(1, 1) + f2*kvec(2)*sc(1, 1) + ss(1, 4) = rbp(3)*ss(1, 1) + f2*kvec(3)*sc(1, 1) ! *** [s|O|b] = (Pi - Bi)*[s|O|b-1i] + f2*Ni(b-1i)*[s|O|b-2i] *** ! *** + [s|dO|b-1i] *** @@ -642,51 +642,51 @@ SUBROUTINE cossin(la_max_set, npgfa, zeta, rpgfa, la_min_set, & ! *** Increase the angular momentum component z of function b *** - sc(1, coset(0, 0, lb)) = rbp(3)*sc(1, coset(0, 0, lb-1))+ & - f2*REAL(lb-1, dp)*sc(1, coset(0, 0, lb-2))- & - f2*kvec(3)*ss(1, coset(0, 0, lb-1)) - ss(1, coset(0, 0, lb)) = rbp(3)*ss(1, coset(0, 0, lb-1))+ & - f2*REAL(lb-1, dp)*ss(1, coset(0, 0, lb-2))+ & - f2*kvec(3)*sc(1, coset(0, 0, lb-1)) + sc(1, coset(0, 0, lb)) = rbp(3)*sc(1, coset(0, 0, lb - 1)) + & + f2*REAL(lb - 1, dp)*sc(1, coset(0, 0, lb - 2)) - & + f2*kvec(3)*ss(1, coset(0, 0, lb - 1)) + ss(1, coset(0, 0, lb)) = rbp(3)*ss(1, coset(0, 0, lb - 1)) + & + f2*REAL(lb - 1, dp)*ss(1, coset(0, 0, lb - 2)) + & + f2*kvec(3)*sc(1, coset(0, 0, lb - 1)) ! *** Increase the angular momentum component y of function b *** - bz = lb-1 - sc(1, coset(0, 1, bz)) = rbp(2)*sc(1, coset(0, 0, bz))- & + bz = lb - 1 + sc(1, coset(0, 1, bz)) = rbp(2)*sc(1, coset(0, 0, bz)) - & f2*kvec(2)*ss(1, coset(0, 0, bz)) - ss(1, coset(0, 1, bz)) = rbp(2)*ss(1, coset(0, 0, bz))+ & + ss(1, coset(0, 1, bz)) = rbp(2)*ss(1, coset(0, 0, bz)) + & f2*kvec(2)*sc(1, coset(0, 0, bz)) DO by = 2, lb - bz = lb-by - sc(1, coset(0, by, bz)) = rbp(2)*sc(1, coset(0, by-1, bz))+ & - f2*REAL(by-1, dp)*sc(1, coset(0, by-2, bz))- & - f2*kvec(2)*ss(1, coset(0, by-1, bz)) - ss(1, coset(0, by, bz)) = rbp(2)*ss(1, coset(0, by-1, bz))+ & - f2*REAL(by-1, dp)*ss(1, coset(0, by-2, bz))+ & - f2*kvec(2)*sc(1, coset(0, by-1, bz)) + bz = lb - by + sc(1, coset(0, by, bz)) = rbp(2)*sc(1, coset(0, by - 1, bz)) + & + f2*REAL(by - 1, dp)*sc(1, coset(0, by - 2, bz)) - & + f2*kvec(2)*ss(1, coset(0, by - 1, bz)) + ss(1, coset(0, by, bz)) = rbp(2)*ss(1, coset(0, by - 1, bz)) + & + f2*REAL(by - 1, dp)*ss(1, coset(0, by - 2, bz)) + & + f2*kvec(2)*sc(1, coset(0, by - 1, bz)) END DO ! *** Increase the angular momentum component x of function b *** - DO by = 0, lb-1 - bz = lb-1-by - sc(1, coset(1, by, bz)) = rbp(1)*sc(1, coset(0, by, bz))- & + DO by = 0, lb - 1 + bz = lb - 1 - by + sc(1, coset(1, by, bz)) = rbp(1)*sc(1, coset(0, by, bz)) - & f2*kvec(1)*ss(1, coset(0, by, bz)) - ss(1, coset(1, by, bz)) = rbp(1)*ss(1, coset(0, by, bz))+ & + ss(1, coset(1, by, bz)) = rbp(1)*ss(1, coset(0, by, bz)) + & f2*kvec(1)*sc(1, coset(0, by, bz)) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by - sc(1, coset(bx, by, bz)) = rbp(1)*sc(1, coset(bx-1, by, bz))+ & - f3*sc(1, coset(bx-2, by, bz))- & - f2*kvec(1)*ss(1, coset(bx-1, by, bz)) - ss(1, coset(bx, by, bz)) = rbp(1)*ss(1, coset(bx-1, by, bz))+ & - f3*ss(1, coset(bx-2, by, bz))+ & - f2*kvec(1)*sc(1, coset(bx-1, by, bz)) + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by + sc(1, coset(bx, by, bz)) = rbp(1)*sc(1, coset(bx - 1, by, bz)) + & + f3*sc(1, coset(bx - 2, by, bz)) - & + f2*kvec(1)*ss(1, coset(bx - 1, by, bz)) + ss(1, coset(bx, by, bz)) = rbp(1)*ss(1, coset(bx - 1, by, bz)) + & + f3*ss(1, coset(bx - 2, by, bz)) + & + f2*kvec(1)*sc(1, coset(bx - 1, by, bz)) END DO END DO @@ -696,10 +696,10 @@ SUBROUTINE cossin(la_max_set, npgfa, zeta, rpgfa, la_min_set, & END IF - DO j = ncoset(lb_min-1)+1, ncoset(lb_max) - DO i = ncoset(la_min_set-1)+1, ncoset(la_max_set) - cosab(na+i, nb+j) = sc(i, j) - sinab(na+i, nb+j) = ss(i, j) + DO j = ncoset(lb_min - 1) + 1, ncoset(lb_max) + DO i = ncoset(la_min_set - 1) + 1, ncoset(la_max_set) + cosab(na + i, nb + j) = sc(i, j) + sinab(na + i, nb + j) = ss(i, j) END DO END DO @@ -711,42 +711,42 @@ SUBROUTINE cossin(la_max_set, npgfa, zeta, rpgfa, la_min_set, & lb_start = lb_min END IF - DO da = 0, da_max-1 + DO da = 0, da_max - 1 ftz = 2.0_dp*zeta(ipgf) DO dax = 0, da - DO day = 0, da-dax - daz = da-dax-day - cda = coset(dax, day, daz)-1 - cdax = coset(dax+1, day, daz)-1 - cday = coset(dax, day+1, daz)-1 - cdaz = coset(dax, day, daz+1)-1 + DO day = 0, da - dax + daz = da - dax - day + cda = coset(dax, day, daz) - 1 + cdax = coset(dax + 1, day, daz) - 1 + cday = coset(dax, day + 1, daz) - 1 + cdaz = coset(dax, day, daz + 1) - 1 !*** [da/dAi|O|b] = 2*zeta*[a+1i|O|b] - Ni(a)[a-1i|O|b] *** - DO la = la_start, la_max-da-1 + DO la = la_start, la_max - da - 1 DO ax = 0, la fax = REAL(ax, dp) - DO ay = 0, la-ax + DO ay = 0, la - ax fay = REAL(ay, dp) - az = la-ax-ay + az = la - ax - ay faz = REAL(az, dp) coa = coset(ax, ay, az) - coamx = coset(ax-1, ay, az) - coamy = coset(ax, ay-1, az) - coamz = coset(ax, ay, az-1) - coapx = coset(ax+1, ay, az) - coapy = coset(ax, ay+1, az) - coapz = coset(ax, ay, az+1) + coamx = coset(ax - 1, ay, az) + coamy = coset(ax, ay - 1, az) + coamz = coset(ax, ay, az - 1) + coapx = coset(ax + 1, ay, az) + coapy = coset(ax, ay + 1, az) + coapz = coset(ax, ay, az + 1) DO lb = lb_start, lb_max DO bx = 0, lb - DO by = 0, lb-bx - bz = lb-bx-by + DO by = 0, lb - bx + bz = lb - bx - by cob = coset(bx, by, bz) - dscos(coa, cob, cdax) = ftz*sc(coapx, cob)-fax*sc(coamx, cob) - dscos(coa, cob, cday) = ftz*sc(coapy, cob)-fay*sc(coamy, cob) - dscos(coa, cob, cdaz) = ftz*sc(coapz, cob)-faz*sc(coamz, cob) - dssin(coa, cob, cdax) = ftz*ss(coapx, cob)-fax*ss(coamx, cob) - dssin(coa, cob, cday) = ftz*ss(coapy, cob)-fay*ss(coamy, cob) - dssin(coa, cob, cdaz) = ftz*ss(coapz, cob)-faz*ss(coamz, cob) + dscos(coa, cob, cdax) = ftz*sc(coapx, cob) - fax*sc(coamx, cob) + dscos(coa, cob, cday) = ftz*sc(coapy, cob) - fay*sc(coamy, cob) + dscos(coa, cob, cdaz) = ftz*sc(coapz, cob) - faz*sc(coamz, cob) + dssin(coa, cob, cdax) = ftz*ss(coapx, cob) - fax*ss(coamx, cob) + dssin(coa, cob, cday) = ftz*ss(coapy, cob) - fay*ss(coamy, cob) + dssin(coa, cob, cdaz) = ftz*ss(coapz, cob) - faz*ss(coamz, cob) END DO END DO END DO @@ -762,18 +762,18 @@ SUBROUTINE cossin(la_max_set, npgfa, zeta, rpgfa, la_min_set, & DO k = 1, 3 DO j = 1, ncoset(lb_max) DO i = 1, ncoset(la_max_set) - dcosab(na+i, nb+j, k) = dscos(i, j, k) - dsinab(na+i, nb+j, k) = dssin(i, j, k) + dcosab(na + i, nb + j, k) = dscos(i, j, k) + dsinab(na + i, nb + j, k) = dssin(i, j, k) END DO END DO END DO END IF - nb = nb+ncoset(lb_max) + nb = nb + ncoset(lb_max) END DO - na = na+ncoset(la_max_set) + na = na + ncoset(la_max_set) END DO @@ -816,7 +816,7 @@ SUBROUTINE moment(la_max, npgfa, zeta, rpgfa, la_min, & REAL(KIND=dp), DIMENSION(ncoset(la_max), ncoset(& lb_max), ncoset(lc_max)) :: s - rab = rbc-rac + rab = rbc - rac rab2 = SUM(rab**2) dab = SQRT(rab2) @@ -833,21 +833,21 @@ SUBROUTINE moment(la_max, npgfa, zeta, rpgfa, la_min, & s = 0.0_dp ! *** Screening *** - IF (rpgfa(ipgf)+rpgfb(jpgf) < dab) THEN - DO k = 1, ncoset(lc_max)-1 - DO j = nb+1, nb+ncoset(lb_max) - DO i = na+1, na+ncoset(la_max) + IF (rpgfa(ipgf) + rpgfb(jpgf) < dab) THEN + DO k = 1, ncoset(lc_max) - 1 + DO j = nb + 1, nb + ncoset(lb_max) + DO i = na + 1, na + ncoset(la_max) mab(i, j, k) = 0.0_dp END DO END DO END DO - nb = nb+ncoset(lb_max) + nb = nb + ncoset(lb_max) CYCLE END IF ! *** Calculate some prefactors *** - zetp = 1.0_dp/(zeta(ipgf)+zetb(jpgf)) + zetp = 1.0_dp/(zeta(ipgf) + zetb(jpgf)) f0 = (pi*zetp)**1.5_dp f1 = zetb(jpgf)*zetp @@ -855,7 +855,7 @@ SUBROUTINE moment(la_max, npgfa, zeta, rpgfa, la_min, & ! *** Calculate the basic two-center moment integral [s|M|s] *** - rpc = zetp*(zeta(ipgf)*rac+zetb(jpgf)*rbc) + rpc = zetp*(zeta(ipgf)*rac + zetb(jpgf)*rbc) s(1, 1, 1) = f0*EXP(-zeta(ipgf)*f1*rab2) DO l = 2, ncoset(lc_max) lx = indco(1, l) @@ -863,23 +863,23 @@ SUBROUTINE moment(la_max, npgfa, zeta, rpgfa, la_min, & lz = indco(3, l) l2 = 0 IF (lz > 0) THEN - l1 = coset(lx, ly, lz-1) - IF (lz > 1) l2 = coset(lx, ly, lz-2) - ni = lz-1 + l1 = coset(lx, ly, lz - 1) + IF (lz > 1) l2 = coset(lx, ly, lz - 2) + ni = lz - 1 i = 3 ELSE IF (ly > 0) THEN - l1 = coset(lx, ly-1, lz) - IF (ly > 1) l2 = coset(lx, ly-2, lz) - ni = ly-1 + l1 = coset(lx, ly - 1, lz) + IF (ly > 1) l2 = coset(lx, ly - 2, lz) + ni = ly - 1 i = 2 ELSE IF (lx > 0) THEN - l1 = coset(lx-1, ly, lz) - IF (lx > 1) l2 = coset(lx-2, ly, lz) - ni = lx-1 + l1 = coset(lx - 1, ly, lz) + IF (lx > 1) l2 = coset(lx - 2, ly, lz) + ni = lx - 1 i = 1 END IF s(1, 1, l) = rpc(i)*s(1, 1, l1) - IF (l2 > 0) s(1, 1, l) = s(1, 1, l)+f2*REAL(ni, dp)*s(1, 1, l2) + IF (l2 > 0) s(1, 1, l) = s(1, 1, l) + f2*REAL(ni, dp)*s(1, 1, l2) END DO ! *** Recurrence steps: [s|M|s] -> [a|M|b] *** @@ -890,17 +890,17 @@ SUBROUTINE moment(la_max, npgfa, zeta, rpgfa, la_min, & ly = indco(2, l) lz = indco(3, l) IF (lx > 0) THEN - lx1 = coset(lx-1, ly, lz) + lx1 = coset(lx - 1, ly, lz) ELSE lx1 = -1 END IF IF (ly > 0) THEN - ly1 = coset(lx, ly-1, lz) + ly1 = coset(lx, ly - 1, lz) ELSE ly1 = -1 END IF IF (lz > 0) THEN - lz1 = coset(lx, ly, lz-1) + lz1 = coset(lx, ly, lz - 1) ELSE lz1 = -1 END IF @@ -919,9 +919,9 @@ SUBROUTINE moment(la_max, npgfa, zeta, rpgfa, la_min, & s(2, 1, l) = rap(1)*s(1, 1, l) s(3, 1, l) = rap(2)*s(1, 1, l) s(4, 1, l) = rap(3)*s(1, 1, l) - IF (lx1 > 0) s(2, 1, l) = s(2, 1, l)+f2x*s(1, 1, lx1) - IF (ly1 > 0) s(3, 1, l) = s(3, 1, l)+f2y*s(1, 1, ly1) - IF (lz1 > 0) s(4, 1, l) = s(4, 1, l)+f2z*s(1, 1, lz1) + IF (lx1 > 0) s(2, 1, l) = s(2, 1, l) + f2x*s(1, 1, lx1) + IF (ly1 > 0) s(3, 1, l) = s(3, 1, l) + f2y*s(1, 1, ly1) + IF (lz1 > 0) s(4, 1, l) = s(4, 1, l) + f2z*s(1, 1, lz1) ! *** [a|M|s] = (Pi - Ai)*[a-1i|M|s] + f2*Ni(a-1i)*[a-2i|M|s] *** ! *** + f2*Ni(m-1i)*[a-1i|M-1i|s] *** @@ -930,43 +930,43 @@ SUBROUTINE moment(la_max, npgfa, zeta, rpgfa, la_min, & ! *** Increase the angular momentum component z of function a *** - s(coset(0, 0, la), 1, l) = rap(3)*s(coset(0, 0, la-1), 1, l)+ & - f2*REAL(la-1, dp)*s(coset(0, 0, la-2), 1, l) - IF (lz1 > 0) s(coset(0, 0, la), 1, l) = s(coset(0, 0, la), 1, l)+ & - f2z*s(coset(0, 0, la-1), 1, lz1) + s(coset(0, 0, la), 1, l) = rap(3)*s(coset(0, 0, la - 1), 1, l) + & + f2*REAL(la - 1, dp)*s(coset(0, 0, la - 2), 1, l) + IF (lz1 > 0) s(coset(0, 0, la), 1, l) = s(coset(0, 0, la), 1, l) + & + f2z*s(coset(0, 0, la - 1), 1, lz1) ! *** Increase the angular momentum component y of function a *** - az = la-1 + az = la - 1 s(coset(0, 1, az), 1, l) = rap(2)*s(coset(0, 0, az), 1, l) - IF (ly1 > 0) s(coset(0, 1, az), 1, l) = s(coset(0, 1, az), 1, l)+ & + IF (ly1 > 0) s(coset(0, 1, az), 1, l) = s(coset(0, 1, az), 1, l) + & f2y*s(coset(0, 0, az), 1, ly1) DO ay = 2, la - az = la-ay - s(coset(0, ay, az), 1, l) = rap(2)*s(coset(0, ay-1, az), 1, l)+ & - f2*REAL(ay-1, dp)*s(coset(0, ay-2, az), 1, l) - IF (ly1 > 0) s(coset(0, ay, az), 1, l) = s(coset(0, ay, az), 1, l)+ & - f2y*s(coset(0, ay-1, az), 1, ly1) + az = la - ay + s(coset(0, ay, az), 1, l) = rap(2)*s(coset(0, ay - 1, az), 1, l) + & + f2*REAL(ay - 1, dp)*s(coset(0, ay - 2, az), 1, l) + IF (ly1 > 0) s(coset(0, ay, az), 1, l) = s(coset(0, ay, az), 1, l) + & + f2y*s(coset(0, ay - 1, az), 1, ly1) END DO ! *** Increase the angular momentum component x of function a *** - DO ay = 0, la-1 - az = la-1-ay + DO ay = 0, la - 1 + az = la - 1 - ay s(coset(1, ay, az), 1, l) = rap(1)*s(coset(0, ay, az), 1, l) - IF (lx1 > 0) s(coset(1, ay, az), 1, l) = s(coset(1, ay, az), 1, l)+ & + IF (lx1 > 0) s(coset(1, ay, az), 1, l) = s(coset(1, ay, az), 1, l) + & f2x*s(coset(0, ay, az), 1, lx1) END DO DO ax = 2, la - f3 = f2*REAL(ax-1, dp) - DO ay = 0, la-ax - az = la-ax-ay - s(coset(ax, ay, az), 1, l) = rap(1)*s(coset(ax-1, ay, az), 1, l)+ & - f3*s(coset(ax-2, ay, az), 1, l) - IF (lx1 > 0) s(coset(ax, ay, az), 1, l) = s(coset(ax, ay, az), 1, l)+ & - f2x*s(coset(ax-1, ay, az), 1, lx1) + f3 = f2*REAL(ax - 1, dp) + DO ay = 0, la - ax + az = la - ax - ay + s(coset(ax, ay, az), 1, l) = rap(1)*s(coset(ax - 1, ay, az), 1, l) + & + f3*s(coset(ax - 2, ay, az), 1, l) + IF (lx1 > 0) s(coset(ax, ay, az), 1, l) = s(coset(ax, ay, az), 1, l) + & + f2x*s(coset(ax - 1, ay, az), 1, lx1) END DO END DO @@ -984,25 +984,25 @@ SUBROUTINE moment(la_max, npgfa, zeta, rpgfa, la_min, & ! *** Horizontal recurrence steps *** - rbp(:) = rap(:)-rab(:) + rbp(:) = rap(:) - rab(:) ! *** [a|M|p] = [a+1i|M|s] - (Bi - Ai)*[a|M|s] *** IF (lb_max == 1) THEN la_start = la_min ELSE - la_start = MAX(0, la_min-1) + la_start = MAX(0, la_min - 1) END IF - DO la = la_start, la_max-1 + DO la = la_start, la_max - 1 DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay - s(coset(ax, ay, az), 2, l) = s(coset(ax+1, ay, az), 1, l)- & + DO ay = 0, la - ax + az = la - ax - ay + s(coset(ax, ay, az), 2, l) = s(coset(ax + 1, ay, az), 1, l) - & rab(1)*s(coset(ax, ay, az), 1, l) - s(coset(ax, ay, az), 3, l) = s(coset(ax, ay+1, az), 1, l)- & + s(coset(ax, ay, az), 3, l) = s(coset(ax, ay + 1, az), 1, l) - & rab(2)*s(coset(ax, ay, az), 1, l) - s(coset(ax, ay, az), 4, l) = s(coset(ax, ay, az+1), 1, l)- & + s(coset(ax, ay, az), 4, l) = s(coset(ax, ay, az + 1), 1, l) - & rab(3)*s(coset(ax, ay, az), 1, l) END DO END DO @@ -1015,33 +1015,33 @@ SUBROUTINE moment(la_max, npgfa, zeta, rpgfa, la_min, & DO ax = 0, la_max fx = f2*REAL(ax, dp) - DO ay = 0, la_max-ax + DO ay = 0, la_max - ax fy = f2*REAL(ay, dp) - az = la_max-ax-ay + az = la_max - ax - ay fz = f2*REAL(az, dp) IF (ax == 0) THEN s(coset(ax, ay, az), 2, l) = rbp(1)*s(coset(ax, ay, az), 1, l) ELSE - s(coset(ax, ay, az), 2, l) = rbp(1)*s(coset(ax, ay, az), 1, l)+ & - fx*s(coset(ax-1, ay, az), 1, l) + s(coset(ax, ay, az), 2, l) = rbp(1)*s(coset(ax, ay, az), 1, l) + & + fx*s(coset(ax - 1, ay, az), 1, l) END IF - IF (lx1 > 0) s(coset(ax, ay, az), 2, l) = s(coset(ax, ay, az), 2, l)+ & + IF (lx1 > 0) s(coset(ax, ay, az), 2, l) = s(coset(ax, ay, az), 2, l) + & f2x*s(coset(ax, ay, az), 1, lx1) IF (ay == 0) THEN s(coset(ax, ay, az), 3, l) = rbp(2)*s(coset(ax, ay, az), 1, l) ELSE - s(coset(ax, ay, az), 3, l) = rbp(2)*s(coset(ax, ay, az), 1, l)+ & - fy*s(coset(ax, ay-1, az), 1, l) + s(coset(ax, ay, az), 3, l) = rbp(2)*s(coset(ax, ay, az), 1, l) + & + fy*s(coset(ax, ay - 1, az), 1, l) END IF - IF (ly1 > 0) s(coset(ax, ay, az), 3, l) = s(coset(ax, ay, az), 3, l)+ & + IF (ly1 > 0) s(coset(ax, ay, az), 3, l) = s(coset(ax, ay, az), 3, l) + & f2y*s(coset(ax, ay, az), 1, ly1) IF (az == 0) THEN s(coset(ax, ay, az), 4, l) = rbp(3)*s(coset(ax, ay, az), 1, l) ELSE - s(coset(ax, ay, az), 4, l) = rbp(3)*s(coset(ax, ay, az), 1, l)+ & - fz*s(coset(ax, ay, az-1), 1, l) + s(coset(ax, ay, az), 4, l) = rbp(3)*s(coset(ax, ay, az), 1, l) + & + fz*s(coset(ax, ay, az - 1), 1, l) END IF - IF (lz1 > 0) s(coset(ax, ay, az), 4, l) = s(coset(ax, ay, az), 4, l)+ & + IF (lz1 > 0) s(coset(ax, ay, az), 4, l) = s(coset(ax, ay, az), 4, l) + & f2z*s(coset(ax, ay, az), 1, lz1) END DO END DO @@ -1057,37 +1057,37 @@ SUBROUTINE moment(la_max, npgfa, zeta, rpgfa, la_min, & IF (lb == lb_max) THEN la_start = la_min ELSE - la_start = MAX(0, la_min-1) + la_start = MAX(0, la_min - 1) END IF - DO la = la_start, la_max-1 + DO la = la_start, la_max - 1 DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay ! *** Shift of angular momentum component z from a to b *** s(coset(ax, ay, az), coset(0, 0, lb), l) = & - s(coset(ax, ay, az+1), coset(0, 0, lb-1), l)- & - rab(3)*s(coset(ax, ay, az), coset(0, 0, lb-1), l) + s(coset(ax, ay, az + 1), coset(0, 0, lb - 1), l) - & + rab(3)*s(coset(ax, ay, az), coset(0, 0, lb - 1), l) ! *** Shift of angular momentum component y from a to b *** DO by = 1, lb - bz = lb-by + bz = lb - by s(coset(ax, ay, az), coset(0, by, bz), l) = & - s(coset(ax, ay+1, az), coset(0, by-1, bz), l)- & - rab(2)*s(coset(ax, ay, az), coset(0, by-1, bz), l) + s(coset(ax, ay + 1, az), coset(0, by - 1, bz), l) - & + rab(2)*s(coset(ax, ay, az), coset(0, by - 1, bz), l) END DO ! *** Shift of angular momentum component x from a to b *** DO bx = 1, lb - DO by = 0, lb-bx - bz = lb-bx-by + DO by = 0, lb - bx + bz = lb - bx - by s(coset(ax, ay, az), coset(bx, by, bz), l) = & - s(coset(ax+1, ay, az), coset(bx-1, by, bz), l)- & - rab(1)*s(coset(ax, ay, az), coset(bx-1, by, bz), l) + s(coset(ax + 1, ay, az), coset(bx - 1, by, bz), l) - & + rab(1)*s(coset(ax, ay, az), coset(bx - 1, by, bz), l) END DO END DO @@ -1102,113 +1102,113 @@ SUBROUTINE moment(la_max, npgfa, zeta, rpgfa, la_min, & DO ax = 0, la_max fx = f2*REAL(ax, dp) - DO ay = 0, la_max-ax + DO ay = 0, la_max - ax fy = f2*REAL(ay, dp) - az = la_max-ax-ay + az = la_max - ax - ay fz = f2*REAL(az, dp) ! *** Shift of angular momentum component z from a to b *** - f3 = f2*REAL(lb-1, dp) + f3 = f2*REAL(lb - 1, dp) IF (az == 0) THEN s(coset(ax, ay, az), coset(0, 0, lb), l) = & - rbp(3)*s(coset(ax, ay, az), coset(0, 0, lb-1), l)+ & - f3*s(coset(ax, ay, az), coset(0, 0, lb-2), l) + rbp(3)*s(coset(ax, ay, az), coset(0, 0, lb - 1), l) + & + f3*s(coset(ax, ay, az), coset(0, 0, lb - 2), l) ELSE s(coset(ax, ay, az), coset(0, 0, lb), l) = & - rbp(3)*s(coset(ax, ay, az), coset(0, 0, lb-1), l)+ & - fz*s(coset(ax, ay, az-1), coset(0, 0, lb-1), l)+ & - f3*s(coset(ax, ay, az), coset(0, 0, lb-2), l) + rbp(3)*s(coset(ax, ay, az), coset(0, 0, lb - 1), l) + & + fz*s(coset(ax, ay, az - 1), coset(0, 0, lb - 1), l) + & + f3*s(coset(ax, ay, az), coset(0, 0, lb - 2), l) END IF IF (lz1 > 0) s(coset(ax, ay, az), coset(0, 0, lb), l) = & - s(coset(ax, ay, az), coset(0, 0, lb), l)+ & - f2z*s(coset(ax, ay, az), coset(0, 0, lb-1), lz1) + s(coset(ax, ay, az), coset(0, 0, lb), l) + & + f2z*s(coset(ax, ay, az), coset(0, 0, lb - 1), lz1) ! *** Shift of angular momentum component y from a to b *** IF (ay == 0) THEN - bz = lb-1 + bz = lb - 1 s(coset(ax, ay, az), coset(0, 1, bz), l) = & rbp(2)*s(coset(ax, ay, az), coset(0, 0, bz), l) IF (ly1 > 0) s(coset(ax, ay, az), coset(0, 1, bz), l) = & - s(coset(ax, ay, az), coset(0, 1, bz), l)+ & + s(coset(ax, ay, az), coset(0, 1, bz), l) + & f2y*s(coset(ax, ay, az), coset(0, 0, bz), ly1) DO by = 2, lb - bz = lb-by - f3 = f2*REAL(by-1, dp) + bz = lb - by + f3 = f2*REAL(by - 1, dp) s(coset(ax, ay, az), coset(0, by, bz), l) = & - rbp(2)*s(coset(ax, ay, az), coset(0, by-1, bz), l)+ & - f3*s(coset(ax, ay, az), coset(0, by-2, bz), l) + rbp(2)*s(coset(ax, ay, az), coset(0, by - 1, bz), l) + & + f3*s(coset(ax, ay, az), coset(0, by - 2, bz), l) IF (ly1 > 0) s(coset(ax, ay, az), coset(0, by, bz), l) = & - s(coset(ax, ay, az), coset(0, by, bz), l)+ & - f2y*s(coset(ax, ay, az), coset(0, by-1, bz), ly1) + s(coset(ax, ay, az), coset(0, by, bz), l) + & + f2y*s(coset(ax, ay, az), coset(0, by - 1, bz), ly1) END DO ELSE - bz = lb-1 + bz = lb - 1 s(coset(ax, ay, az), coset(0, 1, bz), l) = & - rbp(2)*s(coset(ax, ay, az), coset(0, 0, bz), l)+ & - fy*s(coset(ax, ay-1, az), coset(0, 0, bz), l) + rbp(2)*s(coset(ax, ay, az), coset(0, 0, bz), l) + & + fy*s(coset(ax, ay - 1, az), coset(0, 0, bz), l) IF (ly1 > 0) s(coset(ax, ay, az), coset(0, 1, bz), l) = & - s(coset(ax, ay, az), coset(0, 1, bz), l)+ & + s(coset(ax, ay, az), coset(0, 1, bz), l) + & f2y*s(coset(ax, ay, az), coset(0, 0, bz), ly1) DO by = 2, lb - bz = lb-by - f3 = f2*REAL(by-1, dp) + bz = lb - by + f3 = f2*REAL(by - 1, dp) s(coset(ax, ay, az), coset(0, by, bz), l) = & - rbp(2)*s(coset(ax, ay, az), coset(0, by-1, bz), l)+ & - fy*s(coset(ax, ay-1, az), coset(0, by-1, bz), l)+ & - f3*s(coset(ax, ay, az), coset(0, by-2, bz), l) + rbp(2)*s(coset(ax, ay, az), coset(0, by - 1, bz), l) + & + fy*s(coset(ax, ay - 1, az), coset(0, by - 1, bz), l) + & + f3*s(coset(ax, ay, az), coset(0, by - 2, bz), l) IF (ly1 > 0) s(coset(ax, ay, az), coset(0, by, bz), l) = & - s(coset(ax, ay, az), coset(0, by, bz), l)+ & - f2y*s(coset(ax, ay, az), coset(0, by-1, bz), ly1) + s(coset(ax, ay, az), coset(0, by, bz), l) + & + f2y*s(coset(ax, ay, az), coset(0, by - 1, bz), ly1) END DO END IF ! *** Shift of angular momentum component x from a to b *** IF (ax == 0) THEN - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by s(coset(ax, ay, az), coset(1, by, bz), l) = & rbp(1)*s(coset(ax, ay, az), coset(0, by, bz), l) IF (lx1 > 0) s(coset(ax, ay, az), coset(1, by, bz), l) = & - s(coset(ax, ay, az), coset(1, by, bz), l)+ & + s(coset(ax, ay, az), coset(1, by, bz), l) + & f2x*s(coset(ax, ay, az), coset(0, by, bz), lx1) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by s(coset(ax, ay, az), coset(bx, by, bz), l) = & - rbp(1)*s(coset(ax, ay, az), coset(bx-1, by, bz), l)+ & - f3*s(coset(ax, ay, az), coset(bx-2, by, bz), l) + rbp(1)*s(coset(ax, ay, az), coset(bx - 1, by, bz), l) + & + f3*s(coset(ax, ay, az), coset(bx - 2, by, bz), l) IF (lx1 > 0) s(coset(ax, ay, az), coset(bx, by, bz), l) = & - s(coset(ax, ay, az), coset(bx, by, bz), l)+ & - f2x*s(coset(ax, ay, az), coset(bx-1, by, bz), lx1) + s(coset(ax, ay, az), coset(bx, by, bz), l) + & + f2x*s(coset(ax, ay, az), coset(bx - 1, by, bz), lx1) END DO END DO ELSE - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by s(coset(ax, ay, az), coset(1, by, bz), l) = & - rbp(1)*s(coset(ax, ay, az), coset(0, by, bz), l)+ & - fx*s(coset(ax-1, ay, az), coset(0, by, bz), l) + rbp(1)*s(coset(ax, ay, az), coset(0, by, bz), l) + & + fx*s(coset(ax - 1, ay, az), coset(0, by, bz), l) IF (lx1 > 0) s(coset(ax, ay, az), coset(1, by, bz), l) = & - s(coset(ax, ay, az), coset(1, by, bz), l)+ & + s(coset(ax, ay, az), coset(1, by, bz), l) + & f2x*s(coset(ax, ay, az), coset(0, by, bz), lx1) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by s(coset(ax, ay, az), coset(bx, by, bz), l) = & - rbp(1)*s(coset(ax, ay, az), coset(bx-1, by, bz), l)+ & - fx*s(coset(ax-1, ay, az), coset(bx-1, by, bz), l)+ & - f3*s(coset(ax, ay, az), coset(bx-2, by, bz), l) + rbp(1)*s(coset(ax, ay, az), coset(bx - 1, by, bz), l) + & + fx*s(coset(ax - 1, ay, az), coset(bx - 1, by, bz), l) + & + f3*s(coset(ax, ay, az), coset(bx - 2, by, bz), l) IF (lx1 > 0) s(coset(ax, ay, az), coset(bx, by, bz), l) = & - s(coset(ax, ay, az), coset(bx, by, bz), l)+ & - f2x*s(coset(ax, ay, az), coset(bx-1, by, bz), lx1) + s(coset(ax, ay, az), coset(bx, by, bz), l) + & + f2x*s(coset(ax, ay, az), coset(bx - 1, by, bz), lx1) END DO END DO END IF @@ -1226,16 +1226,16 @@ SUBROUTINE moment(la_max, npgfa, zeta, rpgfa, la_min, & ! *** Vertical recurrence steps: [s|M|s] -> [s|M|b] *** - rbp(:) = (f1-1.0_dp)*rab(:) + rbp(:) = (f1 - 1.0_dp)*rab(:) ! *** [s|M|p] = (Pi - Bi)*[s|M|s] + f2*Ni(m)*[s|M-1i|s] *** s(1, 2, l) = rbp(1)*s(1, 1, l) s(1, 3, l) = rbp(2)*s(1, 1, l) s(1, 4, l) = rbp(3)*s(1, 1, l) - IF (lx1 > 0) s(1, 2, l) = s(1, 2, l)+f2x*s(1, 1, lx1) - IF (ly1 > 0) s(1, 3, l) = s(1, 3, l)+f2y*s(1, 1, ly1) - IF (lz1 > 0) s(1, 4, l) = s(1, 4, l)+f2z*s(1, 1, lz1) + IF (lx1 > 0) s(1, 2, l) = s(1, 2, l) + f2x*s(1, 1, lx1) + IF (ly1 > 0) s(1, 3, l) = s(1, 3, l) + f2y*s(1, 1, ly1) + IF (lz1 > 0) s(1, 4, l) = s(1, 4, l) + f2z*s(1, 1, lz1) ! *** [s|M|b] = (Pi - Bi)*[s|M|b-1i] + f2*Ni(b-1i)*[s|M|b-2i] *** ! *** + f2*Ni(m)*[s|M-1i|b-1i] *** @@ -1244,43 +1244,43 @@ SUBROUTINE moment(la_max, npgfa, zeta, rpgfa, la_min, & ! *** Increase the angular momentum component z of function b *** - s(1, coset(0, 0, lb), l) = rbp(3)*s(1, coset(0, 0, lb-1), l)+ & - f2*REAL(lb-1, dp)*s(1, coset(0, 0, lb-2), l) - IF (lz1 > 0) s(1, coset(0, 0, lb), l) = s(1, coset(0, 0, lb), l)+ & - f2z*s(1, coset(0, 0, lb-1), lz1) + s(1, coset(0, 0, lb), l) = rbp(3)*s(1, coset(0, 0, lb - 1), l) + & + f2*REAL(lb - 1, dp)*s(1, coset(0, 0, lb - 2), l) + IF (lz1 > 0) s(1, coset(0, 0, lb), l) = s(1, coset(0, 0, lb), l) + & + f2z*s(1, coset(0, 0, lb - 1), lz1) ! *** Increase the angular momentum component y of function b *** - bz = lb-1 + bz = lb - 1 s(1, coset(0, 1, bz), l) = rbp(2)*s(1, coset(0, 0, bz), l) - IF (ly1 > 0) s(1, coset(0, 1, bz), l) = s(1, coset(0, 1, bz), l)+ & + IF (ly1 > 0) s(1, coset(0, 1, bz), l) = s(1, coset(0, 1, bz), l) + & f2y*s(1, coset(0, 0, bz), ly1) DO by = 2, lb - bz = lb-by - s(1, coset(0, by, bz), l) = rbp(2)*s(1, coset(0, by-1, bz), l)+ & - f2*REAL(by-1, dp)*s(1, coset(0, by-2, bz), l) - IF (ly1 > 0) s(1, coset(0, by, bz), l) = s(1, coset(0, by, bz), l)+ & - f2y*s(1, coset(0, by-1, bz), ly1) + bz = lb - by + s(1, coset(0, by, bz), l) = rbp(2)*s(1, coset(0, by - 1, bz), l) + & + f2*REAL(by - 1, dp)*s(1, coset(0, by - 2, bz), l) + IF (ly1 > 0) s(1, coset(0, by, bz), l) = s(1, coset(0, by, bz), l) + & + f2y*s(1, coset(0, by - 1, bz), ly1) END DO ! *** Increase the angular momentum component x of function b *** - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by s(1, coset(1, by, bz), l) = rbp(1)*s(1, coset(0, by, bz), l) - IF (lx1 > 0) s(1, coset(1, by, bz), l) = s(1, coset(1, by, bz), l)+ & + IF (lx1 > 0) s(1, coset(1, by, bz), l) = s(1, coset(1, by, bz), l) + & f2x*s(1, coset(0, by, bz), lx1) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by - s(1, coset(bx, by, bz), l) = rbp(1)*s(1, coset(bx-1, by, bz), l)+ & - f3*s(1, coset(bx-2, by, bz), l) - IF (lx1 > 0) s(1, coset(bx, by, bz), l) = s(1, coset(bx, by, bz), l)+ & - f2x*s(1, coset(bx-1, by, bz), lx1) + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by + s(1, coset(bx, by, bz), l) = rbp(1)*s(1, coset(bx - 1, by, bz), l) + & + f3*s(1, coset(bx - 2, by, bz), l) + IF (lx1 > 0) s(1, coset(bx, by, bz), l) = s(1, coset(bx, by, bz), l) + & + f2x*s(1, coset(bx - 1, by, bz), lx1) END DO END DO @@ -1295,16 +1295,16 @@ SUBROUTINE moment(la_max, npgfa, zeta, rpgfa, la_min, & DO k = 2, ncoset(lc_max) DO j = 1, ncoset(lb_max) DO i = 1, ncoset(la_max) - mab(na+i, nb+j, k-1) = s(i, j, k) + mab(na + i, nb + j, k - 1) = s(i, j, k) END DO END DO END DO - nb = nb+ncoset(lb_max) + nb = nb + ncoset(lb_max) END DO - na = na+ncoset(la_max) + na = na + ncoset(la_max) END DO @@ -1348,15 +1348,15 @@ SUBROUTINE diffop(la_max, npgfa, zeta, rpgfa, la_min, & rab2 = SUM(rab**2) dab = SQRT(rab2) - lda_min = MAX(0, la_min-1) - ldb_min = MAX(0, lb_min-1) - lmax = MAX(la_max+1, lb_max+1) - lds = ncoset(lmax+1) + lda_min = MAX(0, la_min - 1) + ldb_min = MAX(0, lb_min - 1) + lmax = MAX(la_max + 1, lb_max + 1) + lds = ncoset(lmax + 1) ALLOCATE (s(lds, lds, ncoset(1))) sab = 0.0_dp s = 0.0_dp - CALL overlap(la_max+1, lda_min, npgfa, rpgfa, zeta, & - lb_max+1, ldb_min, npgfb, rpgfb, zetb, & + CALL overlap(la_max + 1, lda_min, npgfa, rpgfa, zeta, & + lb_max + 1, ldb_min, npgfb, rpgfb, zetb, & rab, dab, sab, 0, .FALSE., s, lds) CALL dabdr(la_max, npgfa, zeta, rpgfa, la_min, & @@ -1411,13 +1411,13 @@ SUBROUTINE diff_momop(la_max, npgfa, zeta, rpgfa, la_min, & REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: difmab_tmp REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: mab - rab = rbc-rac + rab = rbc - rac rab2 = SUM(rab**2) dab = SQRT(rab2) - lda_min = MAX(0, la_min-1) - ldb_min = MAX(0, lb_min-1) - lmax = MAX(la_max+1, lb_max+1) + lda_min = MAX(0, la_min - 1) + ldb_min = MAX(0, lb_min - 1) + lmax = MAX(la_max + 1, lb_max + 1) lda = ncoset(la_max)*npgfa ldb = ncoset(lb_max)*npgfb ALLOCATE (difmab_tmp(lda, ldb, 3)) @@ -1425,16 +1425,16 @@ SUBROUTINE diff_momop(la_max, npgfa, zeta, rpgfa, la_min, & IF (PRESENT(mab_ext)) THEN mab => mab_ext ELSE - ALLOCATE (mab(npgfa*ncoset(la_max+1), npgfb*ncoset(lb_max+1), & - ncoset(order)-1)) + ALLOCATE (mab(npgfa*ncoset(la_max + 1), npgfb*ncoset(lb_max + 1), & + ncoset(order) - 1)) mab = 0.0_dp ! *** Calculate the primitive overlap integrals *** - CALL moment(la_max+1, npgfa, zeta, rpgfa, lda_min, & - lb_max+1, npgfb, zetb, rpgfb, & + CALL moment(la_max + 1, npgfa, zeta, rpgfa, lda_min, & + lb_max + 1, npgfb, zetb, rpgfb, & order, rac, rbc, mab) END IF - DO imom = 1, ncoset(order)-1 + DO imom = 1, ncoset(order) - 1 difmab_tmp = 0.0_dp CALL adbdr(la_max, npgfa, rpgfa, la_min, & lb_max, npgfb, zetb, rpgfb, lb_min, & @@ -1498,20 +1498,20 @@ SUBROUTINE dipole_force(la_max, npgfa, zeta, rpgfa, la_min, & CPASSERT(order == 1) - rab = rbc-rac + rab = rbc - rac rab2 = SUM(rab**2) dab = SQRT(rab2) - lda_min = MAX(0, la_min-1) - ldb_min = MAX(0, lb_min-1) - lmax = MAX(la_max+1, lb_max+1) + lda_min = MAX(0, la_min - 1) + ldb_min = MAX(0, lb_min - 1) + lmax = MAX(la_max + 1, lb_max + 1) lda = ncoset(la_max)*npgfa ldb = ncoset(lb_max)*npgfb ALLOCATE (difmab(lda, ldb, 3)) - ALLOCATE (mab(npgfa*ncoset(la_max+1), npgfb*ncoset(lb_max+1), 3)) + ALLOCATE (mab(npgfa*ncoset(la_max + 1), npgfb*ncoset(lb_max + 1), 3)) mab = 0.0_dp - CALL moment(la_max+1, npgfa, zeta, rpgfa, lda_min, & - lb_max+1, npgfb, zetb, rpgfb, 1, rac, rbc, mab) + CALL moment(la_max + 1, npgfa, zeta, rpgfa, lda_min, & + lb_max + 1, npgfb, zetb, rpgfb, 1, rac, rbc, mab) DO imom = 1, 3 difmab = 0.0_dp @@ -1521,16 +1521,16 @@ SUBROUTINE dipole_force(la_max, npgfa, zeta, rpgfa, la_min, & DO ipgf = 1, npgfa nb = 0 DO jpgf = 1, npgfb - DO j = nb+ncoset(lb_min-1)+1, nb+ncoset(lb_max) - DO i = na+ncoset(la_min-1)+1, na+ncoset(la_max) - forceb(imom, 1) = forceb(imom, 1)+pab(i, j)*difmab(i, j, 1) - forceb(imom, 2) = forceb(imom, 2)+pab(i, j)*difmab(i, j, 2) - forceb(imom, 3) = forceb(imom, 3)+pab(i, j)*difmab(i, j, 3) + DO j = nb + ncoset(lb_min - 1) + 1, nb + ncoset(lb_max) + DO i = na + ncoset(la_min - 1) + 1, na + ncoset(la_max) + forceb(imom, 1) = forceb(imom, 1) + pab(i, j)*difmab(i, j, 1) + forceb(imom, 2) = forceb(imom, 2) + pab(i, j)*difmab(i, j, 2) + forceb(imom, 3) = forceb(imom, 3) + pab(i, j)*difmab(i, j, 3) END DO END DO - nb = nb+ncoset(lb_max) + nb = nb + ncoset(lb_max) END DO - na = na+ncoset(la_max) + na = na + ncoset(la_max) END DO difmab = 0.0_dp @@ -1540,16 +1540,16 @@ SUBROUTINE dipole_force(la_max, npgfa, zeta, rpgfa, la_min, & DO ipgf = 1, npgfa nb = 0 DO jpgf = 1, npgfb - DO j = nb+ncoset(lb_min-1)+1, nb+ncoset(lb_max) - DO i = na+ncoset(la_min-1)+1, na+ncoset(la_max) - forcea(imom, 1) = forcea(imom, 1)+pab(i, j)*difmab(i, j, 1) - forcea(imom, 2) = forcea(imom, 2)+pab(i, j)*difmab(i, j, 2) - forcea(imom, 3) = forcea(imom, 3)+pab(i, j)*difmab(i, j, 3) + DO j = nb + ncoset(lb_min - 1) + 1, nb + ncoset(lb_max) + DO i = na + ncoset(la_min - 1) + 1, na + ncoset(la_max) + forcea(imom, 1) = forcea(imom, 1) + pab(i, j)*difmab(i, j, 1) + forcea(imom, 2) = forcea(imom, 2) + pab(i, j)*difmab(i, j, 2) + forcea(imom, 3) = forcea(imom, 3) + pab(i, j)*difmab(i, j, 3) END DO END DO - nb = nb+ncoset(lb_max) + nb = nb + ncoset(lb_max) END DO - na = na+ncoset(la_max) + na = na + ncoset(la_max) END DO END DO diff --git a/src/aobasis/ai_onecenter.F b/src/aobasis/ai_onecenter.F index 1b2e0c7c79..46c1c73cbe 100644 --- a/src/aobasis/ai_onecenter.F +++ b/src/aobasis/ai_onecenter.F @@ -74,12 +74,12 @@ SUBROUTINE sg_overlap(smat, l, pa, pb) CPASSERT(.NOT. (n > SIZE(smat, 1) .OR. m > SIZE(smat, 2))) - spi = SQRT(pi)/2.0_dp**(l+2)*dfac(2*l+1) - el = REAL(l, dp)+1.5_dp + spi = SQRT(pi)/2.0_dp**(l + 2)*dfac(2*l + 1) + el = REAL(l, dp) + 1.5_dp DO iq = 1, m DO ip = 1, n - smat(ip, iq) = spi/(pa(ip)+pb(iq))**el + smat(ip, iq) = spi/(pa(ip) + pb(iq))**el END DO END DO @@ -113,10 +113,10 @@ SUBROUTINE sg_kinetic(kmat, l, pa, pb) CPASSERT(.NOT. (n > SIZE(kmat, 1) .OR. m > SIZE(kmat, 2))) - spi = dfac(2*l+3)*SQRT(pi)/2.0_dp**(l+2) + spi = dfac(2*l + 3)*SQRT(pi)/2.0_dp**(l + 2) DO iq = 1, m DO ip = 1, n - kmat(ip, iq) = spi*pa(ip)*pb(iq)/(pa(ip)+pb(iq))**(l+2.5_dp) + kmat(ip, iq) = spi*pa(ip)*pb(iq)/(pa(ip) + pb(iq))**(l + 2.5_dp) END DO END DO @@ -153,7 +153,7 @@ SUBROUTINE sg_nuclear(umat, l, pa, pb) tld = 0.5_dp*fac(l) DO iq = 1, m DO ip = 1, n - umat(ip, iq) = tld/(pa(ip)+pb(iq))**(l+1) + umat(ip, iq) = tld/(pa(ip) + pb(iq))**(l + 1) END DO END DO @@ -191,15 +191,15 @@ SUBROUTINE sg_kinnuc(umat, l, pa, pb) tld = 0.5_dp*fac(l) DO iq = 1, m DO ip = 1, n - ppq = pa(ip)+pb(iq) + ppq = pa(ip) + pb(iq) pq = pa(ip)*pb(iq) - umat(ip, iq) = tld/ppq**l*(4.0_dp/ppq**2*pq*REAL(l+1, dp)+1.0_dp) + umat(ip, iq) = tld/ppq**l*(4.0_dp/ppq**2*pq*REAL(l + 1, dp) + 1.0_dp) END DO END DO ELSE DO iq = 1, m DO ip = 1, n - ppq = pa(ip)+pb(iq) + ppq = pa(ip) + pb(iq) pq = pa(ip)*pb(iq) umat(ip, iq) = 2.0_dp*pq/ppq**2 END DO @@ -252,12 +252,12 @@ SUBROUTINE sg_erf(upmat, l, a, pa, pb) CPASSERT(.NOT. (n > SIZE(upmat, 1) .OR. m > SIZE(upmat, 2))) a2 = a*a - tld = a/2._dp**(l+1) + tld = a/2._dp**(l + 1) DO iq = 1, m DO ip = 1, n - pq = pa(ip)+pb(iq) + pq = pa(ip) + pb(iq) z = a2/pq - upmat(ip, iq) = tld/(1._dp+z)**(l+0.5_dp)/pq**(l+1.5_dp) + upmat(ip, iq) = tld/(1._dp + z)**(l + 0.5_dp)/pq**(l + 1.5_dp) END DO END DO @@ -269,49 +269,49 @@ SUBROUTINE sg_erf(upmat, l, a, pa, pb) ! nothing left to do CASE (1) DO ip = 1, n - pq = pa(ip)+pb(iq) + pq = pa(ip) + pb(iq) z = a2/pq - fpol = 2.0_dp*z+3.0_dp + fpol = 2.0_dp*z + 3.0_dp upmat(ip, iq) = upmat(ip, iq)*fpol END DO CASE (2) DO ip = 1, n - pq = pa(ip)+pb(iq) + pq = pa(ip) + pb(iq) z = a2/pq - fpol = 8.0_dp*z*z+20.0_dp*z+15.0_dp + fpol = 8.0_dp*z*z + 20.0_dp*z + 15.0_dp upmat(ip, iq) = upmat(ip, iq)*fpol END DO CASE (3) DO ip = 1, n - pq = pa(ip)+pb(iq) + pq = pa(ip) + pb(iq) z = a2/pq - fpol = 16.0_dp*z*z*z+56.0_dp*z*z+70.0_dp*z+35.0_dp + fpol = 16.0_dp*z*z*z + 56.0_dp*z*z + 70.0_dp*z + 35.0_dp fpol = 3._dp*fpol upmat(ip, iq) = upmat(ip, iq)*fpol END DO CASE (4) DO ip = 1, n - pq = pa(ip)+pb(iq) + pq = pa(ip) + pb(iq) z = a2/pq - fpol = 128.0_dp*z*z*z*z+576.0_dp*z*z*z+1008.0_dp*z*z+840.0_dp*z+315.0_dp + fpol = 128.0_dp*z*z*z*z + 576.0_dp*z*z*z + 1008.0_dp*z*z + 840.0_dp*z + 315.0_dp fpol = 3._dp*fpol upmat(ip, iq) = upmat(ip, iq)*fpol END DO CASE (5) DO ip = 1, n - pq = pa(ip)+pb(iq) + pq = pa(ip) + pb(iq) z = a2/pq - fpol = 256.0_dp*z*z*z*z*z+1408.0_dp*z*z*z*z+3168.0_dp*z*z*z+3696.0_dp*z*z+2310.0_dp*z+693.0_dp + fpol = 256.0_dp*z*z*z*z*z + 1408.0_dp*z*z*z*z + 3168.0_dp*z*z*z + 3696.0_dp*z*z + 2310.0_dp*z + 693.0_dp fpol = 15._dp*fpol upmat(ip, iq) = upmat(ip, iq)*fpol END DO CASE (6) DO ip = 1, n - pq = pa(ip)+pb(iq) + pq = pa(ip) + pb(iq) z = a2/pq z2 = z*z - fpol = 1024.0_dp*z2*z2*z2+6656.0_dp*z*z2*z2+18304.0_dp*z2*z2+27456.0_dp*z2*z+ & - 24024.0_dp*z2+12012.0_dp*z+3003.0_dp + fpol = 1024.0_dp*z2*z2*z2 + 6656.0_dp*z*z2*z2 + 18304.0_dp*z2*z2 + 27456.0_dp*z2*z + & + 24024.0_dp*z2 + 12012.0_dp*z + 3003.0_dp fpol = 45._dp*fpol upmat(ip, iq) = upmat(ip, iq)*fpol END DO @@ -354,9 +354,9 @@ SUBROUTINE sg_proj_ol(spmat, l, p, k, rc) CPASSERT(SIZE(spmat) >= SIZE(p)) - pf = 2._dp**(l+k+1)*gamma1(l+k+1)/rc**(l+2*k+1.5_dp)/SQRT(gamma1(l+2*k+1)) + pf = 2._dp**(l + k + 1)*gamma1(l + k + 1)/rc**(l + 2*k + 1.5_dp)/SQRT(gamma1(l + 2*k + 1)) orc = 1._dp/(rc*rc) - spmat(:) = pf/(2._dp*p(:)+orc)**(l+k+1.5_dp) + spmat(:) = pf/(2._dp*p(:) + orc)**(l + k + 1.5_dp) END SUBROUTINE sg_proj_ol @@ -396,11 +396,11 @@ SUBROUTINE sg_gpot(vpmat, k, rc, l, pa, pb) CPASSERT(.NOT. (n > SIZE(vpmat, 1) .OR. m > SIZE(vpmat, 2))) - tld = gamma1(l+k+1)*rc**(2*l+3)*2._dp**(l+k+0.5) + tld = gamma1(l + k + 1)*rc**(2*l + 3)*2._dp**(l + k + 0.5) DO iq = 1, m DO ip = 1, n - vpmat(ip, iq) = tld/(1._dp+2._dp*rc*rc*(pa(ip)+pb(iq)))**(l+k+1.5_dp) + vpmat(ip, iq) = tld/(1._dp + 2._dp*rc*rc*(pa(ip) + pb(iq)))**(l + k + 1.5_dp) END DO END DO @@ -438,10 +438,10 @@ SUBROUTINE sg_conf(gmat, rc, k, l, pa, pb) CPASSERT(.NOT. (n > SIZE(gmat, 1) .OR. m > SIZE(gmat, 2))) - tld = 0.5_dp/rc**(2*k)*gamma1(l+k+1) + tld = 0.5_dp/rc**(2*k)*gamma1(l + k + 1) DO iq = 1, m DO ip = 1, n - gmat(ip, iq) = tld/(pa(ip)+pb(iq))**(l+k+1.5_dp) + gmat(ip, iq) = tld/(pa(ip) + pb(iq))**(l + k + 1.5_dp) END DO END DO @@ -480,34 +480,34 @@ SUBROUTINE sg_coulomb(eri, nu, pa, lab, pc, lcd) na = SIZE(pa) nc = SIZE(pc) ss = 2.0_dp*SQRT(2.0_dp/pi) - slab = SQRT(pi)*dfac(2*lab+1)/2.0_dp**(lab+2) - slcd = SQRT(pi)*dfac(2*lcd+1)/2.0_dp**(lcd+2) + slab = SQRT(pi)*dfac(2*lab + 1)/2.0_dp**(lab + 2) + slcd = SQRT(pi)*dfac(2*lcd + 1)/2.0_dp**(lcd + 2) jab = 0 DO ia = 1, na p = pa(ia) DO ib = ia, na - jab = jab+1 + jab = jab + 1 q = pa(ib) - xab = 0.5_dp*(p+q) - sab = slab/(p+q)**(lab+1.5_dp) - vab1 = vgau(2*lab-nu+1, xab) - vab2 = vgau(2*lab+2, xab) - vab3 = vgau(2*lab+nu+2, xab) + xab = 0.5_dp*(p + q) + sab = slab/(p + q)**(lab + 1.5_dp) + vab1 = vgau(2*lab - nu + 1, xab) + vab2 = vgau(2*lab + 2, xab) + vab3 = vgau(2*lab + nu + 2, xab) jcd = 0 DO ic = 1, nc r = pc(ic) DO id = ic, nc - jcd = jcd+1 + jcd = jcd + 1 s = pc(id) - xcd = 0.5_dp*(r+s) - scd = slcd/(r+s)**(lcd+1.5_dp) - vcd1 = vgau(2*lcd+nu+2, xcd) - vcd2 = vgau(2*lcd+2, xcd) - vcd3 = vgau(2*lcd-nu+1, xcd) - cc1 = cgau(2*lab-nu+1, 2*lcd+nu+2, xab/xcd) - cc2 = cgau(2*lcd-nu+1, 2*lab+nu+2, xcd/xab) + xcd = 0.5_dp*(r + s) + scd = slcd/(r + s)**(lcd + 1.5_dp) + vcd1 = vgau(2*lcd + nu + 2, xcd) + vcd2 = vgau(2*lcd + 2, xcd) + vcd3 = vgau(2*lcd - nu + 1, xcd) + cc1 = cgau(2*lab - nu + 1, 2*lcd + nu + 2, xab/xcd) + cc2 = cgau(2*lcd - nu + 1, 2*lab + nu + 2, xcd/xab) - eri(jab, jcd) = ss*sab*scd/(vab2*vcd2)*(cc1*vab1*vcd1+cc2*vab3*vcd3) + eri(jab, jcd) = ss*sab*scd/(vab2*vcd2)*(cc1*vab1*vcd1 + cc2*vab3*vcd3) END DO END DO @@ -555,46 +555,46 @@ SUBROUTINE sg_exchange(eri, nu, pa, lac, pb, lbd) na = SIZE(pa) nb = SIZE(pb) ss = 2.0_dp*SQRT(2.0_dp/pi) - slac = SQRT(pi)*dfac(2*lac+1)/2.0_dp**(lac+2) - slbd = SQRT(pi)*dfac(2*lbd+1)/2.0_dp**(lbd+2) + slac = SQRT(pi)*dfac(2*lac + 1)/2.0_dp**(lac + 2) + slbd = SQRT(pi)*dfac(2*lbd + 1)/2.0_dp**(lbd + 2) jac = 0 DO ia = 1, na p = pa(ia) DO ic = ia, na - jac = jac+1 + jac = jac + 1 q = pa(ic) - xac = 0.5_dp*(p+q) - sac = slac/(p+q)**(lac+1.5_dp) - vpq = vgau(2*lac+2, xac) + xac = 0.5_dp*(p + q) + sac = slac/(p + q)**(lac + 1.5_dp) + vpq = vgau(2*lac + 2, xac) jbd = 0 DO ib = 1, nb r = pb(ib) - xab = 0.5_dp*(p+r) - xbc = 0.5_dp*(q+r) + xab = 0.5_dp*(p + r) + xbc = 0.5_dp*(q + r) DO id = ib, nb - jbd = jbd+1 + jbd = jbd + 1 s = pb(id) - xbd = 0.5_dp*(r+s) - xcd = 0.5_dp*(q+s) - xad = 0.5_dp*(p+s) - sbd = slbd/(r+s)**(lbd+1.5_dp) - vrs = vgau(2*lbd+2, xbd) - v1pr = vgau(lac+lbd-nu+1, xab) - v1qs = vgau(lac+lbd-nu+1, xcd) - v1ps = vgau(lac+lbd-nu+1, xad) - v1qr = vgau(lac+lbd-nu+1, xbc) - v2qs = vgau(lac+lbd+nu+2, xcd) - v2pr = vgau(lac+lbd+nu+2, xab) - v2qr = vgau(lac+lbd+nu+2, xbc) - v2ps = vgau(lac+lbd+nu+2, xad) - cc1 = cgau(lac+lbd-nu+1, lac+lbd+nu+2, xab/xcd) - cc2 = cgau(lac+lbd-nu+1, lac+lbd+nu+2, xcd/xab) - cc3 = cgau(lac+lbd-nu+1, lac+lbd+nu+2, xad/xbc) - cc4 = cgau(lac+lbd-nu+1, lac+lbd+nu+2, xbc/xad) + xbd = 0.5_dp*(r + s) + xcd = 0.5_dp*(q + s) + xad = 0.5_dp*(p + s) + sbd = slbd/(r + s)**(lbd + 1.5_dp) + vrs = vgau(2*lbd + 2, xbd) + v1pr = vgau(lac + lbd - nu + 1, xab) + v1qs = vgau(lac + lbd - nu + 1, xcd) + v1ps = vgau(lac + lbd - nu + 1, xad) + v1qr = vgau(lac + lbd - nu + 1, xbc) + v2qs = vgau(lac + lbd + nu + 2, xcd) + v2pr = vgau(lac + lbd + nu + 2, xab) + v2qr = vgau(lac + lbd + nu + 2, xbc) + v2ps = vgau(lac + lbd + nu + 2, xad) + cc1 = cgau(lac + lbd - nu + 1, lac + lbd + nu + 2, xab/xcd) + cc2 = cgau(lac + lbd - nu + 1, lac + lbd + nu + 2, xcd/xab) + cc3 = cgau(lac + lbd - nu + 1, lac + lbd + nu + 2, xad/xbc) + cc4 = cgau(lac + lbd - nu + 1, lac + lbd + nu + 2, xbc/xad) ee = 0.5_dp*ss*sac*sbd/(vpq*vrs) - eri(jac, jbd) = ee*(v1pr*v2qs*cc1+v1qs*v2pr*cc2+ & - v1ps*v2qr*cc3+v1qr*v2ps*cc4) + eri(jac, jbd) = ee*(v1pr*v2qs*cc1 + v1qs*v2pr*cc2 + & + v1ps*v2qr*cc3 + v1qr*v2ps*cc4) END DO END DO @@ -640,7 +640,7 @@ SUBROUTINE sg_erfc(umat, l, a, pa, pb) tld = 0.5_dp*fac(l) DO iq = 1, m DO ip = 1, n - umat(ip, iq) = tld/(pa(ip)+pb(iq))**(l+1)-umat(ip, iq) + umat(ip, iq) = tld/(pa(ip) + pb(iq))**(l + 1) - umat(ip, iq) END DO END DO @@ -659,7 +659,7 @@ FUNCTION vgau(n, x) RESULT(v) REAL(KIND=dp), INTENT(IN) :: x REAL(KIND=dp) :: v - v = dfac(n-1)/x**(0.5_dp*(n+1)) + v = dfac(n - 1)/x**(0.5_dp*(n + 1)) END FUNCTION vgau @@ -678,10 +678,10 @@ FUNCTION cgau(a, b, t) RESULT(c) INTEGER :: l c = 0.0_dp - DO l = 0, (a-1)/2 - c = c+(t/(1.0_dp+t))**l*dfac(2*l+b-1)/dfac(2*l) + DO l = 0, (a - 1)/2 + c = c + (t/(1.0_dp + t))**l*dfac(2*l + b - 1)/dfac(2*l) END DO - c = c*(1.0_dp+t)**(-0.5_dp*(b+1))/dfac(b-1) + c = c*(1.0_dp + t)**(-0.5_dp*(b + 1))/dfac(b - 1) END FUNCTION cgau @@ -720,7 +720,7 @@ SUBROUTINE sto_overlap(smat, na, pa, nb, pb) vq = vsto(2*nb(iq), pb(iq)) DO ip = 1, n vp = vsto(2*na(ip), pa(ip)) - vpq = vsto(na(ip)+nb(iq), 0.5_dp*(pa(ip)+pb(iq))) + vpq = vsto(na(ip) + nb(iq), 0.5_dp*(pa(ip) + pb(iq))) smat(ip, iq) = vpq/SQRT(vp*vq) END DO END DO @@ -767,12 +767,12 @@ SUBROUTINE sto_kinetic(kmat, l, na, pa, nb, pb) wq = wsto(l, nb(iq), pb(iq)) DO ip = 1, n vp = vsto(2*na(ip), pa(ip)) - vpq = vsto(na(ip)+nb(iq), 0.5_dp*(pa(ip)+pb(iq))) - vpq1 = vsto(na(ip)+nb(iq)-1, 0.5_dp*(pa(ip)+pb(iq))) - vpq2 = vsto(na(ip)+nb(iq)-2, 0.5_dp*(pa(ip)+pb(iq))) + vpq = vsto(na(ip) + nb(iq), 0.5_dp*(pa(ip) + pb(iq))) + vpq1 = vsto(na(ip) + nb(iq) - 1, 0.5_dp*(pa(ip) + pb(iq))) + vpq2 = vsto(na(ip) + nb(iq) - 2, 0.5_dp*(pa(ip) + pb(iq))) wp = wsto(l, na(ip), pa(ip)) kmat(ip, iq) = 0.5_dp*pa(ip)*pb(iq)/SQRT(vp*vq)* & - (vpq-(wp+wq)*vpq1+wp*wq*vpq2) + (vpq - (wp + wq)*vpq1 + wp*wq*vpq2) END DO END DO @@ -813,7 +813,7 @@ SUBROUTINE sto_nuclear(umat, na, pa, nb, pb) vq = vsto(2*nb(iq), pb(iq)) DO ip = 1, n vp = vsto(2*na(ip), pa(ip)) - vpq1 = vsto(na(ip)+nb(iq)-1, 0.5_dp*(pa(ip)+pb(iq))) + vpq1 = vsto(na(ip) + nb(iq) - 1, 0.5_dp*(pa(ip) + pb(iq))) umat(ip, iq) = 2._dp/SQRT(vp*vq)*vpq1 END DO END DO @@ -857,10 +857,10 @@ SUBROUTINE sto_conf(gmat, rc, k, na, pa, nb, pb) DO iq = 1, m DO ip = 1, n - gmat(ip, iq) = (2._dp*pa(ip))**(na(ip)+0.5_dp)/SQRT(fac(2*na(ip))) & - *(2._dp*pb(iq))**(nb(iq)+0.5_dp)/SQRT(fac(2*nb(iq))) & - /rc**(2*k)/(pa(ip)+pb(iq))**(na(ip)+nb(iq)+2*k+1) & - *gamma0(na(ip)+nb(iq)+2*k+1) + gmat(ip, iq) = (2._dp*pa(ip))**(na(ip) + 0.5_dp)/SQRT(fac(2*na(ip))) & + *(2._dp*pb(iq))**(nb(iq) + 0.5_dp)/SQRT(fac(2*nb(iq))) & + /rc**(2*k)/(pa(ip) + pb(iq))**(na(ip) + nb(iq) + 2*k + 1) & + *gamma0(na(ip) + nb(iq) + 2*k + 1) END DO END DO @@ -879,7 +879,7 @@ FUNCTION vsto(n, x) RESULT(v) REAL(KIND=dp), INTENT(IN) :: x REAL(KIND=dp) :: v - v = fac(n)/x**(n+1) + v = fac(n)/x**(n + 1) END FUNCTION vsto @@ -895,7 +895,7 @@ FUNCTION wsto(n, m, x) RESULT(w) REAL(KIND=dp), INTENT(IN) :: x REAL(KIND=dp) :: w - w = 2._dp*REAL(m-n-1, dp)/x + w = 2._dp*REAL(m - n - 1, dp)/x END FUNCTION wsto !------------------------------------------------------------------------------ @@ -968,7 +968,7 @@ SUBROUTINE num_kinetic(kmat, l, ra, dra, rb, drb, r, wr) DO iq = 1, m DO ip = 1, n kmat(ip, iq) = 0.5_dp*SUM(wr(:)*dra(:, ip)*drb(:, iq) & - +wr(:)*REAL(l*(l+1), dp)*ra(:, ip)*rb(:, iq)/r(:)**2) + + wr(:)*REAL(l*(l + 1), dp)*ra(:, ip)*rb(:, iq)/r(:)**2) END DO END DO @@ -1045,7 +1045,7 @@ SUBROUTINE num_kinnuc(umat, l, ra, dra, rb, drb, r, wr) DO iq = 1, m DO ip = 1, n umat(ip, iq) = SUM(wr(:)*dra(:, ip)*drb(:, iq)/r(:) & - +wr(:)*REAL(l*(l+1), dp)*ra(:, ip)*rb(:, iq)/r(:)**3) + + wr(:)*REAL(l*(l + 1), dp)*ra(:, ip)*rb(:, iq)/r(:)**3) END DO END DO @@ -1085,7 +1085,7 @@ SUBROUTINE num_erf(upmat, a, ra, rb, r, wr) DO ip = 1, n upmat(ip, iq) = 0._dp DO k = 1, SIZE(r) - upmat(ip, iq) = upmat(ip, iq)+ & + upmat(ip, iq) = upmat(ip, iq) + & (wr(k)*ra(k, ip)*rb(k, iq)*erf(a*r(k))/r(k)) ENDDO END DO @@ -1132,8 +1132,8 @@ SUBROUTINE num_proj_ol(spmat, l, ra, k, rc, r, wr) ALLOCATE (pro(n)) - pf = SQRT(2._dp)/SQRT(gamma1(l+2*k+1))/rc**(l+2*k+1.5_dp) - pro(:) = pf*r(:)**(l+2*k)*EXP(-0.5_dp*(r(:)/rc)**2) + pf = SQRT(2._dp)/SQRT(gamma1(l + 2*k + 1))/rc**(l + 2*k + 1.5_dp) + pro(:) = pf*r(:)**(l + 2*k)*EXP(-0.5_dp*(r(:)/rc)**2) DO ip = 1, n spmat(ip) = SUM(wr(:)*pro(:)*ra(:, ip)) diff --git a/src/aobasis/ai_oneelectron.F b/src/aobasis/ai_oneelectron.F index fc47545f7d..cfeeab0632 100644 --- a/src/aobasis/ai_oneelectron.F +++ b/src/aobasis/ai_oneelectron.F @@ -148,32 +148,32 @@ SUBROUTINE os_3center(la_max_set, la_min_set, npgfa, rpgfa, zeta, & db_max = 0 END IF - la_max = la_max_set+da_max - la_min = MAX(0, la_min_set-da_max) + la_max = la_max_set + da_max + la_min = MAX(0, la_min_set - da_max) - lb_max = lb_max_set+db_max - lb_min = MAX(0, lb_min_set-db_max) + lb_max = lb_max_set + db_max + lb_min = MAX(0, lb_min_set - db_max) - mmax = la_max+lb_max + mmax = la_max + lb_max ! precalculate indices for horizontal recursion ALLOCATE (iiap(ncoset(mmax), 3)) DO ma = 0, mmax DO iax = 0, ma - DO iay = 0, ma-iax - iaz = ma-iax-iay + DO iay = 0, ma - iax + iaz = ma - iax - iay ia = coset(iax, iay, iaz) jj(1) = iax; jj(2) = iay; jj(3) = iaz jjp = jj - jjp(1) = jjp(1)+1 + jjp(1) = jjp(1) + 1 iap = coset(jjp(1), jjp(2), jjp(3)) iiap(ia, 1) = iap jjp = jj - jjp(2) = jjp(2)+1 + jjp(2) = jjp(2) + 1 iap = coset(jjp(1), jjp(2), jjp(3)) iiap(ia, 2) = iap jjp = jj - jjp(3) = jjp(3)+1 + jjp(3) = jjp(3) + 1 iap = coset(jjp(1), jjp(2), jjp(3)) iiap(ia, 3) = iap END DO @@ -187,8 +187,8 @@ SUBROUTINE os_3center(la_max_set, la_min_set, npgfa, rpgfa, zeta, & DO ipgf = 1, npgfa ! *** Screening *** - IF (rpgfa(ipgf)+rpgfc < dac) THEN - na = na+ncoset(la_max_set) + IF (rpgfa(ipgf) + rpgfc < dac) THEN + na = na + ncoset(la_max_set) CYCLE END IF @@ -197,21 +197,21 @@ SUBROUTINE os_3center(la_max_set, la_min_set, npgfa, rpgfa, zeta, & DO jpgf = 1, npgfb ! *** Screening *** - IF ((rpgfb(jpgf)+rpgfc < dbc) .OR. & - (rpgfa(ipgf)+rpgfb(jpgf) < dab)) THEN - nb = nb+ncoset(lb_max_set) + IF ((rpgfb(jpgf) + rpgfc < dbc) .OR. & + (rpgfa(ipgf) + rpgfb(jpgf) < dab)) THEN + nb = nb + ncoset(lb_max_set) CYCLE END IF ! *** Calculate some prefactors *** - rho = zeta(ipgf)+zetb(jpgf) + rho = zeta(ipgf) + zetb(jpgf) pai(:) = zetb(jpgf)/rho*rab(:) pbi(:) = -zeta(ipgf)/rho*rab(:) - pci(:) = -(zeta(ipgf)*rac(:)+zetb(jpgf)*rbc(:))/rho + pci(:) = -(zeta(ipgf)*rac(:) + zetb(jpgf)*rbc(:))/rho orho = 0.5_dp/rho - ij = (ipgf-1)*npgfb+jpgf - s(1, 1, 1:mmax+1) = auxint(0:mmax, ij) + ij = (ipgf - 1)*npgfb + jpgf + s(1, 1, 1:mmax + 1) = auxint(0:mmax, ij) IF (la_max > 0) THEN ! *** Recurrence steps: [s|c|s] -> [a|c|s] *** @@ -221,90 +221,90 @@ SUBROUTINE os_3center(la_max_set, la_min_set, npgfa, rpgfa, zeta, & ! *** Ni(a-1i)/2(a+b)*[a-2i|c|s](m+1) *** DO llr = 1, mmax IF (llr == 1) THEN - DO m = 0, mmax-llr - s1 = s(1, 1, m+1) - s2 = s(1, 1, m+2) - s(2, 1, m+1) = pai(1)*s1-pci(1)*s2 ! [px|o|s] - s(3, 1, m+1) = pai(2)*s1-pci(2)*s2 ! [py|o|s] - s(4, 1, m+1) = pai(3)*s1-pci(3)*s2 ! [pz|o|s] + DO m = 0, mmax - llr + s1 = s(1, 1, m + 1) + s2 = s(1, 1, m + 2) + s(2, 1, m + 1) = pai(1)*s1 - pci(1)*s2 ! [px|o|s] + s(3, 1, m + 1) = pai(2)*s1 - pci(2)*s2 ! [py|o|s] + s(4, 1, m + 1) = pai(3)*s1 - pci(3)*s2 ! [pz|o|s] END DO ELSE IF (llr == 2) THEN - DO m = 0, mmax-llr - s1 = s(1, 1, m+1)-s(1, 1, m+2) - s(5, 1, m+1) = pai(1)*s(2, 1, m+1)-pci(1)*s(2, 1, m+2)+orho*s1 ! [dx2|o|s] - s(6, 1, m+1) = pai(1)*s(3, 1, m+1)-pci(1)*s(3, 1, m+2) ! [dxy|o|s] - s(7, 1, m+1) = pai(1)*s(4, 1, m+1)-pci(1)*s(4, 1, m+2) ! [dxz|o|s] - s(8, 1, m+1) = pai(2)*s(3, 1, m+1)-pci(2)*s(3, 1, m+2)+orho*s1 ! [dy2|o|s] - s(9, 1, m+1) = pai(2)*s(4, 1, m+1)-pci(2)*s(4, 1, m+2) ! [dyz|o|s] - s(10, 1, m+1) = pai(3)*s(4, 1, m+1)-pci(3)*s(4, 1, m+2)+orho*s1 ! [dz2|o|s] + DO m = 0, mmax - llr + s1 = s(1, 1, m + 1) - s(1, 1, m + 2) + s(5, 1, m + 1) = pai(1)*s(2, 1, m + 1) - pci(1)*s(2, 1, m + 2) + orho*s1 ! [dx2|o|s] + s(6, 1, m + 1) = pai(1)*s(3, 1, m + 1) - pci(1)*s(3, 1, m + 2) ! [dxy|o|s] + s(7, 1, m + 1) = pai(1)*s(4, 1, m + 1) - pci(1)*s(4, 1, m + 2) ! [dxz|o|s] + s(8, 1, m + 1) = pai(2)*s(3, 1, m + 1) - pci(2)*s(3, 1, m + 2) + orho*s1 ! [dy2|o|s] + s(9, 1, m + 1) = pai(2)*s(4, 1, m + 1) - pci(2)*s(4, 1, m + 2) ! [dyz|o|s] + s(10, 1, m + 1) = pai(3)*s(4, 1, m + 1) - pci(3)*s(4, 1, m + 2) + orho*s1 ! [dz2|o|s] END DO ELSE IF (llr == 3) THEN - DO m = 0, mmax-llr - s(11, 1, m+1) = pai(1)*s(5, 1, m+1)-pci(1)*s(5, 1, m+2) & ! [fx3 |o|s] - +2._dp*orho*(s(2, 1, m+1)-s(2, 1, m+2)) - s(12, 1, m+1) = pai(1)*s(6, 1, m+1)-pci(1)*s(6, 1, m+2) & ! [fx2y|o|s] - +orho*(s(3, 1, m+1)-s(3, 1, m+2)) - s(13, 1, m+1) = pai(1)*s(7, 1, m+1)-pci(1)*s(7, 1, m+2) & ! [fx2z|o|s] - +orho*(s(4, 1, m+1)-s(4, 1, m+2)) - s(14, 1, m+1) = pai(2)*s(6, 1, m+1)-pci(2)*s(6, 1, m+2) & ! [fxy2|o|s] - +orho*(s(2, 1, m+1)-s(2, 1, m+2)) - s(15, 1, m+1) = pai(1)*s(9, 1, m+1)-pci(1)*s(9, 1, m+2) ! [fxyz|o|s] - s(16, 1, m+1) = pai(3)*s(7, 1, m+1)-pci(3)*s(7, 1, m+2) & ! [fxz2|o|s] - +orho*(s(2, 1, m+1)-s(2, 1, m+2)) - s(17, 1, m+1) = pai(2)*s(8, 1, m+1)-pci(2)*s(8, 1, m+2) & ! [fy3 |o|s] - +2._dp*orho*(s(3, 1, m+1)-s(3, 1, m+2)) - s(18, 1, m+1) = pai(2)*s(9, 1, m+1)-pci(2)*s(9, 1, m+2) & ! [fy2z|o|s] - +orho*(s(4, 1, m+1)-s(4, 1, m+2)) - s(19, 1, m+1) = pai(3)*s(9, 1, m+1)-pci(3)*s(9, 1, m+2) & ! [fyz2|o|s] - +orho*(s(3, 1, m+1)-s(3, 1, m+2)) - s(20, 1, m+1) = pai(3)*s(10, 1, m+1)-pci(3)*s(10, 1, m+2) & ! [fz3 |o|s] - +2._dp*orho*(s(4, 1, m+1)-s(4, 1, m+2)) + DO m = 0, mmax - llr + s(11, 1, m + 1) = pai(1)*s(5, 1, m + 1) - pci(1)*s(5, 1, m + 2) & ! [fx3 |o|s] + + 2._dp*orho*(s(2, 1, m + 1) - s(2, 1, m + 2)) + s(12, 1, m + 1) = pai(1)*s(6, 1, m + 1) - pci(1)*s(6, 1, m + 2) & ! [fx2y|o|s] + + orho*(s(3, 1, m + 1) - s(3, 1, m + 2)) + s(13, 1, m + 1) = pai(1)*s(7, 1, m + 1) - pci(1)*s(7, 1, m + 2) & ! [fx2z|o|s] + + orho*(s(4, 1, m + 1) - s(4, 1, m + 2)) + s(14, 1, m + 1) = pai(2)*s(6, 1, m + 1) - pci(2)*s(6, 1, m + 2) & ! [fxy2|o|s] + + orho*(s(2, 1, m + 1) - s(2, 1, m + 2)) + s(15, 1, m + 1) = pai(1)*s(9, 1, m + 1) - pci(1)*s(9, 1, m + 2) ! [fxyz|o|s] + s(16, 1, m + 1) = pai(3)*s(7, 1, m + 1) - pci(3)*s(7, 1, m + 2) & ! [fxz2|o|s] + + orho*(s(2, 1, m + 1) - s(2, 1, m + 2)) + s(17, 1, m + 1) = pai(2)*s(8, 1, m + 1) - pci(2)*s(8, 1, m + 2) & ! [fy3 |o|s] + + 2._dp*orho*(s(3, 1, m + 1) - s(3, 1, m + 2)) + s(18, 1, m + 1) = pai(2)*s(9, 1, m + 1) - pci(2)*s(9, 1, m + 2) & ! [fy2z|o|s] + + orho*(s(4, 1, m + 1) - s(4, 1, m + 2)) + s(19, 1, m + 1) = pai(3)*s(9, 1, m + 1) - pci(3)*s(9, 1, m + 2) & ! [fyz2|o|s] + + orho*(s(3, 1, m + 1) - s(3, 1, m + 2)) + s(20, 1, m + 1) = pai(3)*s(10, 1, m + 1) - pci(3)*s(10, 1, m + 2) & ! [fz3 |o|s] + + 2._dp*orho*(s(4, 1, m + 1) - s(4, 1, m + 2)) END DO ELSE IF (llr == 4) THEN - DO m = 0, mmax-llr - s(21, 1, m+1) = pai(1)*s(11, 1, m+1)-pci(1)*s(11, 1, m+2) & ! [gx4 |s|s] - +3._dp*orho*(s(5, 1, m+1)-s(5, 1, m+2)) - s(22, 1, m+1) = pai(1)*s(12, 1, m+1)-pci(1)*s(12, 1, m+2) & ! [gx3y |s|s] - +2._dp*orho*(s(6, 1, m+1)-s(6, 1, m+2)) - s(23, 1, m+1) = pai(1)*s(13, 1, m+1)-pci(1)*s(13, 1, m+2) & ! [gx3z |s|s] - +2._dp*orho*(s(7, 1, m+1)-s(7, 1, m+2)) - s(24, 1, m+1) = pai(1)*s(14, 1, m+1)-pci(1)*s(14, 1, m+2) & ! [gx2y2|s|s] - +orho*(s(8, 1, m+1)-s(8, 1, m+2)) - s(25, 1, m+1) = pai(1)*s(15, 1, m+1)-pci(1)*s(15, 1, m+2) & ! [gx2yz|s|s] - +orho*(s(9, 1, m+1)-s(9, 1, m+2)) - s(26, 1, m+1) = pai(1)*s(16, 1, m+1)-pci(1)*s(16, 1, m+2) & ! [gx2z2|s|s] - +orho*(s(10, 1, m+1)-s(10, 1, m+2)) - s(27, 1, m+1) = pai(1)*s(17, 1, m+1)-pci(1)*s(17, 1, m+2) ! [gxy3 |s|s] - s(28, 1, m+1) = pai(1)*s(18, 1, m+1)-pci(1)*s(18, 1, m+2) ! [gxy2z|s|s] - s(29, 1, m+1) = pai(1)*s(19, 1, m+1)-pci(1)*s(19, 1, m+2) ! [gxyz2|s|s] - s(30, 1, m+1) = pai(1)*s(20, 1, m+1)-pci(1)*s(20, 1, m+2) ! [gxz3 |s|s] - s(31, 1, m+1) = pai(2)*s(17, 1, m+1)-pci(2)*s(17, 1, m+2) & ! [gy4 |s|s] - +3._dp*orho*(s(8, 1, m+1)-s(8, 1, m+2)) - s(32, 1, m+1) = pai(2)*s(18, 1, m+1)-pci(2)*s(18, 1, m+2) & ! [gy3z |s|s] - +2._dp*orho*(s(9, 1, m+1)-s(9, 1, m+2)) - s(33, 1, m+1) = pai(2)*s(19, 1, m+1)-pci(2)*s(19, 1, m+2) & ! [gy2z2|s|s] - +orho*(s(10, 1, m+1)-s(10, 1, m+2)) - s(34, 1, m+1) = pai(2)*s(20, 1, m+1)-pci(2)*s(20, 1, m+2) ! [gyz3 |s|s] - s(35, 1, m+1) = pai(3)*s(20, 1, m+1)-pci(3)*s(20, 1, m+2) & ! [gz4 |s|s] - +3._dp*orho*(s(10, 1, m+1)-s(10, 1, m+2)) + DO m = 0, mmax - llr + s(21, 1, m + 1) = pai(1)*s(11, 1, m + 1) - pci(1)*s(11, 1, m + 2) & ! [gx4 |s|s] + + 3._dp*orho*(s(5, 1, m + 1) - s(5, 1, m + 2)) + s(22, 1, m + 1) = pai(1)*s(12, 1, m + 1) - pci(1)*s(12, 1, m + 2) & ! [gx3y |s|s] + + 2._dp*orho*(s(6, 1, m + 1) - s(6, 1, m + 2)) + s(23, 1, m + 1) = pai(1)*s(13, 1, m + 1) - pci(1)*s(13, 1, m + 2) & ! [gx3z |s|s] + + 2._dp*orho*(s(7, 1, m + 1) - s(7, 1, m + 2)) + s(24, 1, m + 1) = pai(1)*s(14, 1, m + 1) - pci(1)*s(14, 1, m + 2) & ! [gx2y2|s|s] + + orho*(s(8, 1, m + 1) - s(8, 1, m + 2)) + s(25, 1, m + 1) = pai(1)*s(15, 1, m + 1) - pci(1)*s(15, 1, m + 2) & ! [gx2yz|s|s] + + orho*(s(9, 1, m + 1) - s(9, 1, m + 2)) + s(26, 1, m + 1) = pai(1)*s(16, 1, m + 1) - pci(1)*s(16, 1, m + 2) & ! [gx2z2|s|s] + + orho*(s(10, 1, m + 1) - s(10, 1, m + 2)) + s(27, 1, m + 1) = pai(1)*s(17, 1, m + 1) - pci(1)*s(17, 1, m + 2) ! [gxy3 |s|s] + s(28, 1, m + 1) = pai(1)*s(18, 1, m + 1) - pci(1)*s(18, 1, m + 2) ! [gxy2z|s|s] + s(29, 1, m + 1) = pai(1)*s(19, 1, m + 1) - pci(1)*s(19, 1, m + 2) ! [gxyz2|s|s] + s(30, 1, m + 1) = pai(1)*s(20, 1, m + 1) - pci(1)*s(20, 1, m + 2) ! [gxz3 |s|s] + s(31, 1, m + 1) = pai(2)*s(17, 1, m + 1) - pci(2)*s(17, 1, m + 2) & ! [gy4 |s|s] + + 3._dp*orho*(s(8, 1, m + 1) - s(8, 1, m + 2)) + s(32, 1, m + 1) = pai(2)*s(18, 1, m + 1) - pci(2)*s(18, 1, m + 2) & ! [gy3z |s|s] + + 2._dp*orho*(s(9, 1, m + 1) - s(9, 1, m + 2)) + s(33, 1, m + 1) = pai(2)*s(19, 1, m + 1) - pci(2)*s(19, 1, m + 2) & ! [gy2z2|s|s] + + orho*(s(10, 1, m + 1) - s(10, 1, m + 2)) + s(34, 1, m + 1) = pai(2)*s(20, 1, m + 1) - pci(2)*s(20, 1, m + 2) ! [gyz3 |s|s] + s(35, 1, m + 1) = pai(3)*s(20, 1, m + 1) - pci(3)*s(20, 1, m + 2) & ! [gz4 |s|s] + + 3._dp*orho*(s(10, 1, m + 1) - s(10, 1, m + 2)) END DO ELSE DO irx = 0, llr - DO iry = 0, llr-irx - irz = llr-irx-iry + DO iry = 0, llr - irx + irz = llr - irx - iry irr(1) = irx; irr(2) = iry; irr(3) = irz ixx = MAXLOC(irr) ix = ixx(1) ir = coset(irx, iry, irz) irm = irr - irm(ix) = irm(ix)-1 + irm(ix) = irm(ix) - 1 aai = REAL(MAX(irm(ix), 0), dp)*orho ir1 = coset(irm(1), irm(2), irm(3)) - irm(ix) = irm(ix)-1 + irm(ix) = irm(ix) - 1 ir2 = coset(irm(1), irm(2), irm(3)) - DO m = 0, mmax-llr - s(ir, 1, m+1) = pai(ix)*s(ir1, 1, m+1)-pci(ix)*s(ir1, 1, m+2) & - +aai*(s(ir2, 1, m+1)-s(ir2, 1, m+2)) + DO m = 0, mmax - llr + s(ir, 1, m + 1) = pai(ix)*s(ir1, 1, m + 1) - pci(ix)*s(ir1, 1, m + 2) & + + aai*(s(ir2, 1, m + 1) - s(ir2, 1, m + 2)) END DO END DO END DO @@ -316,19 +316,19 @@ SUBROUTINE os_3center(la_max_set, la_min_set, npgfa, rpgfa, zeta, & DO mb = 1, lb_max DO ibx = 0, mb - DO iby = 0, mb-ibx - ibz = mb-ibx-iby + DO iby = 0, mb - ibx + ibz = mb - ibx - iby ib = coset(ibx, iby, ibz) ii(1) = ibx; ii(2) = iby; ii(3) = ibz ixx = MAXLOC(ii) ix = ixx(1) abx = -rab(ix) iim = ii - iim(ix) = iim(ix)-1 + iim(ix) = iim(ix) - 1 ibm = coset(iim(1), iim(2), iim(3)) - DO ia = 1, ncoset(mmax-mb) + DO ia = 1, ncoset(mmax - mb) iap = iiap(ia, ix) - s(ia, ib, 1) = s(iap, ibm, 1)+abx*s(ia, ibm, 1) + s(ia, ib, 1) = s(iap, ibm, 1) + abx*s(ia, ibm, 1) END DO END DO END DO @@ -343,62 +343,62 @@ SUBROUTINE os_3center(la_max_set, la_min_set, npgfa, rpgfa, zeta, & ! *** Ni(b-1i)/2(a+b)*[s|c|b-2i](m+1) *** DO llr = 1, lb_max IF (llr == 1) THEN - DO m = 0, lb_max-llr - s1 = s(1, 1, m+1) - s2 = s(1, 1, m+2) - s(1, 2, m+1) = pbi(1)*s1-pci(1)*s2 ! [px|o|s] - s(1, 3, m+1) = pbi(2)*s1-pci(2)*s2 ! [py|o|s] - s(1, 4, m+1) = pbi(3)*s1-pci(3)*s2 ! [pz|o|s] + DO m = 0, lb_max - llr + s1 = s(1, 1, m + 1) + s2 = s(1, 1, m + 2) + s(1, 2, m + 1) = pbi(1)*s1 - pci(1)*s2 ! [px|o|s] + s(1, 3, m + 1) = pbi(2)*s1 - pci(2)*s2 ! [py|o|s] + s(1, 4, m + 1) = pbi(3)*s1 - pci(3)*s2 ! [pz|o|s] END DO ELSE IF (llr == 2) THEN - DO m = 0, lb_max-llr - s1 = s(1, 1, m+1)-s(1, 1, m+2) - s(1, 5, m+1) = pbi(1)*s(1, 2, m+1)-pci(1)*s(1, 2, m+2)+orho*s1 ! [dx2|o|s] - s(1, 6, m+1) = pbi(1)*s(1, 3, m+1)-pci(1)*s(1, 3, m+2) ! [dxy|o|s] - s(1, 7, m+1) = pbi(1)*s(1, 4, m+1)-pci(1)*s(1, 4, m+2) ! [dxz|o|s] - s(1, 8, m+1) = pbi(2)*s(1, 3, m+1)-pci(2)*s(1, 3, m+2)+orho*s1 ! [dy2|o|s] - s(1, 9, m+1) = pbi(2)*s(1, 4, m+1)-pci(2)*s(1, 4, m+2) ! [dyz|o|s] - s(1, 10, m+1) = pbi(3)*s(1, 4, m+1)-pci(3)*s(1, 4, m+2)+orho*s1 ! [dz2|o|s] + DO m = 0, lb_max - llr + s1 = s(1, 1, m + 1) - s(1, 1, m + 2) + s(1, 5, m + 1) = pbi(1)*s(1, 2, m + 1) - pci(1)*s(1, 2, m + 2) + orho*s1 ! [dx2|o|s] + s(1, 6, m + 1) = pbi(1)*s(1, 3, m + 1) - pci(1)*s(1, 3, m + 2) ! [dxy|o|s] + s(1, 7, m + 1) = pbi(1)*s(1, 4, m + 1) - pci(1)*s(1, 4, m + 2) ! [dxz|o|s] + s(1, 8, m + 1) = pbi(2)*s(1, 3, m + 1) - pci(2)*s(1, 3, m + 2) + orho*s1 ! [dy2|o|s] + s(1, 9, m + 1) = pbi(2)*s(1, 4, m + 1) - pci(2)*s(1, 4, m + 2) ! [dyz|o|s] + s(1, 10, m + 1) = pbi(3)*s(1, 4, m + 1) - pci(3)*s(1, 4, m + 2) + orho*s1 ! [dz2|o|s] END DO ELSE IF (llr == 3) THEN - DO m = 0, lb_max-llr - s(1, 11, m+1) = pbi(1)*s(1, 5, m+1)-pci(1)*s(1, 5, m+2) & ! [fx3 |o|s] - +2._dp*orho*(s(1, 2, m+1)-s(1, 2, m+2)) - s(1, 12, m+1) = pbi(1)*s(1, 6, m+1)-pci(1)*s(1, 6, m+2) & ! [fx2y|o|s] - +orho*(s(1, 3, m+1)-s(1, 3, m+2)) - s(1, 13, m+1) = pbi(1)*s(1, 7, m+1)-pci(1)*s(1, 7, m+2) & ! [fx2z|o|s] - +orho*(s(1, 4, m+1)-s(1, 4, m+2)) - s(1, 14, m+1) = pbi(2)*s(1, 6, m+1)-pci(2)*s(1, 6, m+2) & ! [fxy2|o|s] - +orho*(s(1, 2, m+1)-s(1, 2, m+2)) - s(1, 15, m+1) = pbi(1)*s(1, 9, m+1)-pci(1)*s(1, 9, m+2) ! [fxyz|o|s] - s(1, 16, m+1) = pbi(3)*s(1, 7, m+1)-pci(3)*s(1, 7, m+2) & ! [fxz2|o|s] - +orho*(s(1, 2, m+1)-s(1, 2, m+2)) - s(1, 17, m+1) = pbi(2)*s(1, 8, m+1)-pci(2)*s(1, 8, m+2) & ! [fy3 |o|s] - +2._dp*orho*(s(1, 3, m+1)-s(1, 3, m+2)) - s(1, 18, m+1) = pbi(2)*s(1, 9, m+1)-pci(2)*s(1, 9, m+2) & ! [fy2z|o|s] - +orho*(s(1, 4, m+1)-s(1, 4, m+2)) - s(1, 19, m+1) = pbi(3)*s(1, 9, m+1)-pci(3)*s(1, 9, m+2) & ! [fyz2|o|s] - +orho*(s(1, 3, m+1)-s(1, 3, m+2)) - s(1, 20, m+1) = pbi(3)*s(1, 10, m+1)-pci(3)*s(1, 10, m+2) & ! [fz3 |o|s] - +2._dp*orho*(s(1, 4, m+1)-s(1, 4, m+2)) + DO m = 0, lb_max - llr + s(1, 11, m + 1) = pbi(1)*s(1, 5, m + 1) - pci(1)*s(1, 5, m + 2) & ! [fx3 |o|s] + + 2._dp*orho*(s(1, 2, m + 1) - s(1, 2, m + 2)) + s(1, 12, m + 1) = pbi(1)*s(1, 6, m + 1) - pci(1)*s(1, 6, m + 2) & ! [fx2y|o|s] + + orho*(s(1, 3, m + 1) - s(1, 3, m + 2)) + s(1, 13, m + 1) = pbi(1)*s(1, 7, m + 1) - pci(1)*s(1, 7, m + 2) & ! [fx2z|o|s] + + orho*(s(1, 4, m + 1) - s(1, 4, m + 2)) + s(1, 14, m + 1) = pbi(2)*s(1, 6, m + 1) - pci(2)*s(1, 6, m + 2) & ! [fxy2|o|s] + + orho*(s(1, 2, m + 1) - s(1, 2, m + 2)) + s(1, 15, m + 1) = pbi(1)*s(1, 9, m + 1) - pci(1)*s(1, 9, m + 2) ! [fxyz|o|s] + s(1, 16, m + 1) = pbi(3)*s(1, 7, m + 1) - pci(3)*s(1, 7, m + 2) & ! [fxz2|o|s] + + orho*(s(1, 2, m + 1) - s(1, 2, m + 2)) + s(1, 17, m + 1) = pbi(2)*s(1, 8, m + 1) - pci(2)*s(1, 8, m + 2) & ! [fy3 |o|s] + + 2._dp*orho*(s(1, 3, m + 1) - s(1, 3, m + 2)) + s(1, 18, m + 1) = pbi(2)*s(1, 9, m + 1) - pci(2)*s(1, 9, m + 2) & ! [fy2z|o|s] + + orho*(s(1, 4, m + 1) - s(1, 4, m + 2)) + s(1, 19, m + 1) = pbi(3)*s(1, 9, m + 1) - pci(3)*s(1, 9, m + 2) & ! [fyz2|o|s] + + orho*(s(1, 3, m + 1) - s(1, 3, m + 2)) + s(1, 20, m + 1) = pbi(3)*s(1, 10, m + 1) - pci(3)*s(1, 10, m + 2) & ! [fz3 |o|s] + + 2._dp*orho*(s(1, 4, m + 1) - s(1, 4, m + 2)) END DO ELSE DO irx = 0, llr - DO iry = 0, llr-irx - irz = llr-irx-iry + DO iry = 0, llr - irx + irz = llr - irx - iry irr(1) = irx; irr(2) = iry; irr(3) = irz ixx = MAXLOC(irr) ix = ixx(1) ir = coset(irx, iry, irz) irm = irr - irm(ix) = irm(ix)-1 + irm(ix) = irm(ix) - 1 aai = REAL(MAX(irm(ix), 0), dp) ir1 = coset(irm(1), irm(2), irm(3)) - irm(ix) = irm(ix)-1 + irm(ix) = irm(ix) - 1 ir2 = coset(irm(1), irm(2), irm(3)) - DO m = 0, lb_max-llr - s(1, ir, m+1) = pbi(ix)*s(1, ir1, m+1)-pci(ix)*s(1, ir1, m+2) & - +aai*orho*(s(1, ir2, m+1)-s(1, ir2, m+2)) + DO m = 0, lb_max - llr + s(1, ir, m + 1) = pbi(ix)*s(1, ir1, m + 1) - pci(ix)*s(1, ir1, m + 2) & + + aai*orho*(s(1, ir2, m + 1) - s(1, ir2, m + 2)) END DO END DO END DO @@ -408,45 +408,45 @@ SUBROUTINE os_3center(la_max_set, la_min_set, npgfa, rpgfa, zeta, & END IF ! *** Store the primitive three-center overlap integrals *** - DO j = ncoset(lb_min_set-1)+1, ncoset(lb_max_set) - DO i = ncoset(la_min_set-1)+1, ncoset(la_max_set) - vab(na+i, nb+j) = vab(na+i, nb+j)+s(i, j, 1) + DO j = ncoset(lb_min_set - 1) + 1, ncoset(lb_max_set) + DO i = ncoset(la_min_set - 1) + 1, ncoset(la_max_set) + vab(na + i, nb + j) = vab(na + i, nb + j) + s(i, j, 1) END DO END DO ! *** Calculate the requested derivatives with respect *** ! *** to the nuclear coordinates of the atomic center a *** - DO da = 0, da_max-1 + DO da = 0, da_max - 1 ftz = 2.0_dp*zeta(ipgf) DO dax = 0, da - DO day = 0, da-dax - daz = da-dax-day + DO day = 0, da - dax + daz = da - dax - day cda = coset(dax, day, daz) - cdax = coset(dax+1, day, daz) - cday = coset(dax, day+1, daz) - cdaz = coset(dax, day, daz+1) + cdax = coset(dax + 1, day, daz) + cday = coset(dax, day + 1, daz) + cdaz = coset(dax, day, daz + 1) ! *** [da/dAi|c|b] = 2*zeta*[a+1i|c|b] - Ni(a)[a-1i|c|b] *** - DO la = la_min_set, la_max-da-1 + DO la = la_min_set, la_max - da - 1 DO ax = 0, la fax = REAL(ax, dp) - DO ay = 0, la-ax + DO ay = 0, la - ax fay = REAL(ay, dp) - az = la-ax-ay + az = la - ax - ay faz = REAL(az, dp) coa = coset(ax, ay, az) - coamx = coset(ax-1, ay, az) - coamy = coset(ax, ay-1, az) - coamz = coset(ax, ay, az-1) - coapx = coset(ax+1, ay, az) - coapy = coset(ax, ay+1, az) - coapz = coset(ax, ay, az+1) - DO cob = ncoset(lb_min_set-1)+1, ncoset(lb_max_set) - fs(coa, cob, cdax) = ftz*s(coapx, cob, cda)-fax*s(coamx, cob, cda) - fs(coa, cob, cday) = ftz*s(coapy, cob, cda)-fay*s(coamy, cob, cda) - fs(coa, cob, cdaz) = ftz*s(coapz, cob, cda)-faz*s(coamz, cob, cda) + coamx = coset(ax - 1, ay, az) + coamy = coset(ax, ay - 1, az) + coamz = coset(ax, ay, az - 1) + coapx = coset(ax + 1, ay, az) + coapy = coset(ax, ay + 1, az) + coapz = coset(ax, ay, az + 1) + DO cob = ncoset(lb_min_set - 1) + 1, ncoset(lb_max_set) + fs(coa, cob, cdax) = ftz*s(coapx, cob, cda) - fax*s(coamx, cob, cda) + fs(coa, cob, cday) = ftz*s(coapy, cob, cda) - fay*s(coamy, cob, cda) + fs(coa, cob, cdaz) = ftz*s(coapz, cob, cda) - faz*s(coamz, cob, cda) END DO END DO END DO @@ -459,11 +459,11 @@ SUBROUTINE os_3center(la_max_set, la_min_set, npgfa, rpgfa, zeta, & ! *** Calculate the force contribution for the atomic center a *** IF (calculate_force_a) THEN - DO j = ncoset(lb_min_set-1)+1, ncoset(lb_max_set) - DO i = ncoset(la_min_set-1)+1, ncoset(la_max_set) - force_a(1) = force_a(1)+pab(na+i, nb+j)*fs(i, j, 2) - force_a(2) = force_a(2)+pab(na+i, nb+j)*fs(i, j, 3) - force_a(3) = force_a(3)+pab(na+i, nb+j)*fs(i, j, 4) + DO j = ncoset(lb_min_set - 1) + 1, ncoset(lb_max_set) + DO i = ncoset(la_min_set - 1) + 1, ncoset(la_max_set) + force_a(1) = force_a(1) + pab(na + i, nb + j)*fs(i, j, 2) + force_a(2) = force_a(2) + pab(na + i, nb + j)*fs(i, j, 3) + force_a(3) = force_a(3) + pab(na + i, nb + j)*fs(i, j, 4) END DO END DO END IF @@ -471,36 +471,36 @@ SUBROUTINE os_3center(la_max_set, la_min_set, npgfa, rpgfa, zeta, & ! *** Calculate the requested derivatives with respect *** ! *** to the nuclear coordinates of the atomic center b *** - DO db = 0, db_max-1 + DO db = 0, db_max - 1 ftz = 2.0_dp*zetb(jpgf) DO dbx = 0, db - DO dby = 0, db-dbx - dbz = db-dbx-dby + DO dby = 0, db - dbx + dbz = db - dbx - dby cdb = coset(dbx, dby, dbz) - cdbx = coset(dbx+1, dby, dbz) - cdby = coset(dbx, dby+1, dbz) - cdbz = coset(dbx, dby, dbz+1) + cdbx = coset(dbx + 1, dby, dbz) + cdby = coset(dbx, dby + 1, dbz) + cdbz = coset(dbx, dby, dbz + 1) ! *** [a|c|db/dBi] = 2*zetb*[a|c|b+1i] - Ni(b)[a|c|b-1i] *** - DO lb = lb_min_set, lb_max-db-1 + DO lb = lb_min_set, lb_max - db - 1 DO bx = 0, lb fbx = REAL(bx, dp) - DO by = 0, lb-bx + DO by = 0, lb - bx fby = REAL(by, dp) - bz = lb-bx-by + bz = lb - bx - by fbz = REAL(bz, dp) cob = coset(bx, by, bz) - cobmx = coset(bx-1, by, bz) - cobmy = coset(bx, by-1, bz) - cobmz = coset(bx, by, bz-1) - cobpx = coset(bx+1, by, bz) - cobpy = coset(bx, by+1, bz) - cobpz = coset(bx, by, bz+1) - DO coa = ncoset(la_min_set-1)+1, ncoset(la_max_set) - fs(coa, cob, cdbx) = ftz*s(coa, cobpx, cdb)-fbx*s(coa, cobmx, cdb) - fs(coa, cob, cdby) = ftz*s(coa, cobpy, cdb)-fby*s(coa, cobmy, cdb) - fs(coa, cob, cdbz) = ftz*s(coa, cobpz, cdb)-fbz*s(coa, cobmz, cdb) + cobmx = coset(bx - 1, by, bz) + cobmy = coset(bx, by - 1, bz) + cobmz = coset(bx, by, bz - 1) + cobpx = coset(bx + 1, by, bz) + cobpy = coset(bx, by + 1, bz) + cobpz = coset(bx, by, bz + 1) + DO coa = ncoset(la_min_set - 1) + 1, ncoset(la_max_set) + fs(coa, cob, cdbx) = ftz*s(coa, cobpx, cdb) - fbx*s(coa, cobmx, cdb) + fs(coa, cob, cdby) = ftz*s(coa, cobpy, cdb) - fby*s(coa, cobmy, cdb) + fs(coa, cob, cdbz) = ftz*s(coa, cobpz, cdb) - fbz*s(coa, cobmz, cdb) END DO END DO END DO @@ -513,20 +513,20 @@ SUBROUTINE os_3center(la_max_set, la_min_set, npgfa, rpgfa, zeta, & ! *** Calculate the force contribution for the atomic center b *** IF (calculate_force_b) THEN - DO j = ncoset(lb_min_set-1)+1, ncoset(lb_max_set) - DO i = ncoset(la_min_set-1)+1, ncoset(la_max_set) - force_b(1) = force_b(1)+pab(na+i, nb+j)*fs(i, j, 2) - force_b(2) = force_b(2)+pab(na+i, nb+j)*fs(i, j, 3) - force_b(3) = force_b(3)+pab(na+i, nb+j)*fs(i, j, 4) + DO j = ncoset(lb_min_set - 1) + 1, ncoset(lb_max_set) + DO i = ncoset(la_min_set - 1) + 1, ncoset(la_max_set) + force_b(1) = force_b(1) + pab(na + i, nb + j)*fs(i, j, 2) + force_b(2) = force_b(2) + pab(na + i, nb + j)*fs(i, j, 3) + force_b(3) = force_b(3) + pab(na + i, nb + j)*fs(i, j, 4) END DO END DO END IF - nb = nb+ncoset(lb_max_set) + nb = nb + ncoset(lb_max_set) END DO - na = na+ncoset(la_max_set) + na = na + ncoset(la_max_set) END DO @@ -577,19 +577,19 @@ SUBROUTINE os_2center(la_max_set, la_min_set, npgfa, rpgfa, zeta, & da_max = 0 END IF - la_max = la_max_set+da_max - la_min = MAX(0, la_min_set-da_max) + la_max = la_max_set + da_max + la_min = MAX(0, la_min_set - da_max) mmax = la_max - ALLOCATE (s(ncoset(mmax), mmax+1)) + ALLOCATE (s(ncoset(mmax), mmax + 1)) na = 0 DO ipgf = 1, npgfa - IF (rpgfa(ipgf)+rpgfc < dac) THEN - na = na+ncoset(la_max_set) + IF (rpgfa(ipgf) + rpgfc < dac) THEN + na = na + ncoset(la_max_set) CYCLE END IF - s(1, 1:mmax+1) = auxint(0:mmax, ipgf) + s(1, 1:mmax + 1) = auxint(0:mmax, ipgf) IF (la_max > 0) THEN ! Recurrence steps: [s|c] -> [a|c] ! [a|c](m) = (Ci - Ai)*[a-1i|c](m+1) + @@ -601,69 +601,69 @@ SUBROUTINE os_2center(la_max_set, la_min_set, npgfa, rpgfa, zeta, & DO llr = 1, mmax IF (llr == 1) THEN - DO m = 0, mmax-llr - s1 = s(1, m+2) - s(2, m+1) = -rac(1)*s1 ! [px|o] - s(3, m+1) = -rac(2)*s1 ! [py|o] - s(4, m+1) = -rac(3)*s1 ! [pz|o] + DO m = 0, mmax - llr + s1 = s(1, m + 2) + s(2, m + 1) = -rac(1)*s1 ! [px|o] + s(3, m + 1) = -rac(2)*s1 ! [py|o] + s(4, m + 1) = -rac(3)*s1 ! [pz|o] END DO ELSE IF (llr == 2) THEN - DO m = 0, mmax-llr - s1 = s(1, m+1)-s(1, m+2) - s(5, m+1) = -rac(1)*s(2, m+2)+orho*s1 ! [dx2|o] - s(6, m+1) = -rac(1)*s(3, m+2) ! [dxy|o] - s(7, m+1) = -rac(1)*s(4, m+2) ! [dxz|o] - s(8, m+1) = -rac(2)*s(3, m+2)+orho*s1 ! [dy2|o] - s(9, m+1) = -rac(2)*s(4, m+2) ! [dyz|o] - s(10, m+1) = -rac(3)*s(4, m+2)+orho*s1 ! [dz2|o] + DO m = 0, mmax - llr + s1 = s(1, m + 1) - s(1, m + 2) + s(5, m + 1) = -rac(1)*s(2, m + 2) + orho*s1 ! [dx2|o] + s(6, m + 1) = -rac(1)*s(3, m + 2) ! [dxy|o] + s(7, m + 1) = -rac(1)*s(4, m + 2) ! [dxz|o] + s(8, m + 1) = -rac(2)*s(3, m + 2) + orho*s1 ! [dy2|o] + s(9, m + 1) = -rac(2)*s(4, m + 2) ! [dyz|o] + s(10, m + 1) = -rac(3)*s(4, m + 2) + orho*s1 ! [dz2|o] END DO ELSE IF (llr == 3) THEN - DO m = 0, mmax-llr - s(11, m+1) = -rac(1)*s(5, m+2)+2._dp*orho*(s(2, m+1)-s(2, m+2)) ! [fx3 |o] - s(12, m+1) = -rac(1)*s(6, m+2)+orho*(s(3, m+1)-s(3, m+2)) ! [fx2y|o] - s(13, m+1) = -rac(1)*s(7, m+2)+orho*(s(4, m+1)-s(4, m+2)) ! [fx2z|o] - s(14, m+1) = -rac(2)*s(6, m+2)+orho*(s(2, m+1)-s(2, m+2)) ! [fxy2|o] - s(15, m+1) = -rac(1)*s(9, m+2) ! [fxyz|o] - s(16, m+1) = -rac(3)*s(7, m+2)+orho*(s(2, m+1)-s(2, m+2)) ! [fxz2|o] - s(17, m+1) = -rac(2)*s(8, m+2)+2._dp*orho*(s(3, m+1)-s(3, m+2)) ! [fy3 |o] - s(18, m+1) = -rac(2)*s(9, m+2)+orho*(s(4, m+1)-s(4, m+2)) ! [fy2z|o] - s(19, m+1) = -rac(3)*s(9, m+2)+orho*(s(3, m+1)-s(3, m+2)) ! [fyz2|o] - s(20, m+1) = -rac(3)*s(10, m+2)+2._dp*orho*(s(4, m+1)-s(4, m+2)) ! [fz3 |o] + DO m = 0, mmax - llr + s(11, m + 1) = -rac(1)*s(5, m + 2) + 2._dp*orho*(s(2, m + 1) - s(2, m + 2)) ! [fx3 |o] + s(12, m + 1) = -rac(1)*s(6, m + 2) + orho*(s(3, m + 1) - s(3, m + 2)) ! [fx2y|o] + s(13, m + 1) = -rac(1)*s(7, m + 2) + orho*(s(4, m + 1) - s(4, m + 2)) ! [fx2z|o] + s(14, m + 1) = -rac(2)*s(6, m + 2) + orho*(s(2, m + 1) - s(2, m + 2)) ! [fxy2|o] + s(15, m + 1) = -rac(1)*s(9, m + 2) ! [fxyz|o] + s(16, m + 1) = -rac(3)*s(7, m + 2) + orho*(s(2, m + 1) - s(2, m + 2)) ! [fxz2|o] + s(17, m + 1) = -rac(2)*s(8, m + 2) + 2._dp*orho*(s(3, m + 1) - s(3, m + 2)) ! [fy3 |o] + s(18, m + 1) = -rac(2)*s(9, m + 2) + orho*(s(4, m + 1) - s(4, m + 2)) ! [fy2z|o] + s(19, m + 1) = -rac(3)*s(9, m + 2) + orho*(s(3, m + 1) - s(3, m + 2)) ! [fyz2|o] + s(20, m + 1) = -rac(3)*s(10, m + 2) + 2._dp*orho*(s(4, m + 1) - s(4, m + 2)) ! [fz3 |o] END DO ELSE IF (llr == 4) THEN - DO m = 0, mmax-llr - s(21, m+1) = -rac(1)*s(11, m+2)+3._dp*orho*(s(5, m+1)-s(5, m+2)) ! [gx4 |s] - s(22, m+1) = -rac(1)*s(12, m+2)+2._dp*orho*(s(6, m+1)-s(6, m+2)) ! [gx3y |s] - s(23, m+1) = -rac(1)*s(13, m+2)+2._dp*orho*(s(7, m+1)-s(7, m+2)) ! [gx3z |s] - s(24, m+1) = -rac(1)*s(14, m+2)+orho*(s(8, m+1)-s(8, m+2)) ! [gx2y2|s] - s(25, m+1) = -rac(1)*s(15, m+2)+orho*(s(9, m+1)-s(9, m+2)) ! [gx2yz|s] - s(26, m+1) = -rac(1)*s(16, m+2)+orho*(s(10, m+1)-s(10, m+2)) ! [gx2z2|s] - s(27, m+1) = -rac(1)*s(17, m+2) ! [gxy3 |s] - s(28, m+1) = -rac(1)*s(18, m+2) ! [gxy2z|s] - s(29, m+1) = -rac(1)*s(19, m+2) ! [gxyz2|s] - s(30, m+1) = -rac(1)*s(20, m+2) ! [gxz3 |s] - s(31, m+1) = -rac(2)*s(17, m+2)+3._dp*orho*(s(8, m+1)-s(8, m+2)) ! [gy4 |s] - s(32, m+1) = -rac(2)*s(18, m+2)+2._dp*orho*(s(9, m+1)-s(9, m+2)) ! [gy3z |s] - s(33, m+1) = -rac(2)*s(19, m+2)+orho*(s(10, m+1)-s(10, m+2)) ! [gy2z2|s] - s(34, m+1) = -rac(2)*s(20, m+2) ! [gyz3 |s] - s(35, m+1) = -rac(3)*s(20, m+2)+3._dp*orho*(s(10, m+1)-s(10, m+2)) ! [gz4 |s] + DO m = 0, mmax - llr + s(21, m + 1) = -rac(1)*s(11, m + 2) + 3._dp*orho*(s(5, m + 1) - s(5, m + 2)) ! [gx4 |s] + s(22, m + 1) = -rac(1)*s(12, m + 2) + 2._dp*orho*(s(6, m + 1) - s(6, m + 2)) ! [gx3y |s] + s(23, m + 1) = -rac(1)*s(13, m + 2) + 2._dp*orho*(s(7, m + 1) - s(7, m + 2)) ! [gx3z |s] + s(24, m + 1) = -rac(1)*s(14, m + 2) + orho*(s(8, m + 1) - s(8, m + 2)) ! [gx2y2|s] + s(25, m + 1) = -rac(1)*s(15, m + 2) + orho*(s(9, m + 1) - s(9, m + 2)) ! [gx2yz|s] + s(26, m + 1) = -rac(1)*s(16, m + 2) + orho*(s(10, m + 1) - s(10, m + 2)) ! [gx2z2|s] + s(27, m + 1) = -rac(1)*s(17, m + 2) ! [gxy3 |s] + s(28, m + 1) = -rac(1)*s(18, m + 2) ! [gxy2z|s] + s(29, m + 1) = -rac(1)*s(19, m + 2) ! [gxyz2|s] + s(30, m + 1) = -rac(1)*s(20, m + 2) ! [gxz3 |s] + s(31, m + 1) = -rac(2)*s(17, m + 2) + 3._dp*orho*(s(8, m + 1) - s(8, m + 2)) ! [gy4 |s] + s(32, m + 1) = -rac(2)*s(18, m + 2) + 2._dp*orho*(s(9, m + 1) - s(9, m + 2)) ! [gy3z |s] + s(33, m + 1) = -rac(2)*s(19, m + 2) + orho*(s(10, m + 1) - s(10, m + 2)) ! [gy2z2|s] + s(34, m + 1) = -rac(2)*s(20, m + 2) ! [gyz3 |s] + s(35, m + 1) = -rac(3)*s(20, m + 2) + 3._dp*orho*(s(10, m + 1) - s(10, m + 2)) ! [gz4 |s] END DO ELSE DO irx = 0, llr - DO iry = 0, llr-irx - irz = llr-irx-iry + DO iry = 0, llr - irx + irz = llr - irx - iry irr(1) = irx; irr(2) = iry; irr(3) = irz ixx = MAXLOC(irr) ix = ixx(1) ir = coset(irx, iry, irz) irm = irr - irm(ix) = irm(ix)-1 + irm(ix) = irm(ix) - 1 aai = REAL(MAX(irm(ix), 0), dp)*orho ir1 = coset(irm(1), irm(2), irm(3)) - irm(ix) = irm(ix)-1 + irm(ix) = irm(ix) - 1 ir2 = coset(irm(1), irm(2), irm(3)) - DO m = 0, mmax-llr - s(ir, m+1) = -rac(ix)*s(ir1, m+2)+aai*(s(ir2, m+1)-s(ir2, m+2)) + DO m = 0, mmax - llr + s(ir, m + 1) = -rac(ix)*s(ir1, m + 2) + aai*(s(ir2, m + 1) - s(ir2, m + 2)) END DO END DO END DO @@ -673,8 +673,8 @@ SUBROUTINE os_2center(la_max_set, la_min_set, npgfa, rpgfa, zeta, & END IF ! Store the primitive three-center overlap integrals - DO i = ncoset(la_min_set-1)+1, ncoset(la_max_set) - va(na+i) = va(na+i)+s(i, 1) + DO i = ncoset(la_min_set - 1) + 1, ncoset(la_max_set) + va(na + i) = va(na + i) + s(i, 1) END DO ! Calculate the requested derivatives with respect *** @@ -685,26 +685,26 @@ SUBROUTINE os_2center(la_max_set, la_min_set, npgfa, rpgfa, zeta, & DO la = la_min_set, la_max_set DO ax = 0, la fax = REAL(ax, dp) - DO ay = 0, la-ax + DO ay = 0, la - ax fay = REAL(ay, dp) - az = la-ax-ay + az = la - ax - ay faz = REAL(az, dp) coa = coset(ax, ay, az) - coamx = coset(ax-1, ay, az) - coamy = coset(ax, ay-1, az) - coamz = coset(ax, ay, az-1) - coapx = coset(ax+1, ay, az) - coapy = coset(ax, ay+1, az) - coapz = coset(ax, ay, az+1) - dva(na+coa, 1) = dva(na+coa, 1)+ftz*s(coapx, 1)-fax*s(coamx, 1) - dva(na+coa, 2) = dva(na+coa, 2)+ftz*s(coapy, 1)-fay*s(coamy, 1) - dva(na+coa, 3) = dva(na+coa, 3)+ftz*s(coapz, 1)-faz*s(coamz, 1) + coamx = coset(ax - 1, ay, az) + coamy = coset(ax, ay - 1, az) + coamz = coset(ax, ay, az - 1) + coapx = coset(ax + 1, ay, az) + coapy = coset(ax, ay + 1, az) + coapz = coset(ax, ay, az + 1) + dva(na + coa, 1) = dva(na + coa, 1) + ftz*s(coapx, 1) - fax*s(coamx, 1) + dva(na + coa, 2) = dva(na + coa, 2) + ftz*s(coapy, 1) - fay*s(coamy, 1) + dva(na + coa, 3) = dva(na + coa, 3) + ftz*s(coapz, 1) - faz*s(coamz, 1) END DO END DO END DO END IF - na = na+ncoset(la_max_set) + na = na + ncoset(la_max_set) END DO diff --git a/src/aobasis/ai_operator_ra2m.F b/src/aobasis/ai_operator_ra2m.F index ace0b576fe..a3036ef380 100644 --- a/src/aobasis/ai_operator_ra2m.F +++ b/src/aobasis/ai_operator_ra2m.F @@ -98,23 +98,23 @@ SUBROUTINE operator_ra2m(la_max, la_min, npgfa, zeta, & ! Distance of the centers a and b - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) tab = SQRT(rab2) ! Maximum l for auxiliary integrals - lma = la_max+2*m + lma = la_max + 2*m lmb = lb_max - IF (calculate_forces) lma = lma+1 - ldrr = MAX(lma, lmb)+1 + IF (calculate_forces) lma = lma + 1 + ldrr = MAX(lma, lmb) + 1 ! Allocate space for auxiliary integrals - ALLOCATE (rr(0:ldrr-1, 0:ldrr-1, 3)) + ALLOCATE (rr(0:ldrr - 1, 0:ldrr - 1, 3)) ! Number of integrals, check size of arrays - ofa = ncoset(la_min-1) - ofb = ncoset(lb_min-1) - na = ncoset(la_max)-ofa - nb = ncoset(lb_max)-ofb + ofa = ncoset(la_min - 1) + ofb = ncoset(lb_min - 1) + na = ncoset(la_max) - ofa + nb = ncoset(lb_max) - ofb CPASSERT((SIZE(sab, 1) >= na*npgfa)) CPASSERT((SIZE(sab, 2) >= nb*npgfb)) @@ -127,7 +127,7 @@ SUBROUTINE operator_ra2m(la_max, la_min, npgfa, zeta, & ! Calculate some prefactors a = zeta(ipgf) b = zetb(jpgf) - zet = a+b + zet = a + b xhi = a*b/zet rap = b*rab/zet rbp = -a*rab/zet @@ -140,37 +140,37 @@ SUBROUTINE operator_ra2m(la_max, la_min, npgfa, zeta, & DO lb = lb_min, lb_max DO bx = 0, lb - DO by = 0, lb-bx - bz = lb-bx-by - cob = coset(bx, by, bz)-ofb - ib = mb+cob + DO by = 0, lb - bx + bz = lb - bx - by + cob = coset(bx, by, bz) - ofb + ib = mb + cob DO la = la_min, la_max DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay - coa = coset(ax, ay, az)-ofa - ia = ma+coa + DO ay = 0, la - ax + az = la - ax - ay + coa = coset(ax, ay, az) - ofa + ia = ma + coa DO i = 0, m DO j = 0, m DO k = 0, m - IF (i+j+k /= m) CYCLE + IF (i + j + k /= m) CYCLE prefac = fac(m)/fac(i)/fac(j)/fac(k) - sab(ia, ib) = sab(ia, ib)+prefac*f0 & - *rr(ax+2*i, bx, 1)*rr(ay+2*j, by, 2)*rr(az+2*k, bz, 3) + sab(ia, ib) = sab(ia, ib) + prefac*f0 & + *rr(ax + 2*i, bx, 1)*rr(ay + 2*j, by, 2)*rr(az + 2*k, bz, 3) IF (calculate_forces) THEN ! (da|b) = 2*a*(a+1|b) - N(a)*(a-1|b) ! dx - dumx = 2.0_dp*a*rr(ax+2*i+1, bx, 1) - IF (ax+2*i > 0) dumx = dumx-REAL(ax+2*i, dp)*rr(ax+2*i-1, bx, 1) - dsab(ia, ib, 1) = dsab(ia, ib, 1)+prefac*f0*dumx*rr(ay+2*j, by, 2)*rr(az+2*k, bz, 3) + dumx = 2.0_dp*a*rr(ax + 2*i + 1, bx, 1) + IF (ax + 2*i > 0) dumx = dumx - REAL(ax + 2*i, dp)*rr(ax + 2*i - 1, bx, 1) + dsab(ia, ib, 1) = dsab(ia, ib, 1) + prefac*f0*dumx*rr(ay + 2*j, by, 2)*rr(az + 2*k, bz, 3) ! dy - dumy = 2.0_dp*a*rr(ay+2*j+1, by, 2) - IF (ay+2*j > 0) dumy = dumy-REAL(ay+2*j, dp)*rr(ay+2*j-1, by, 2) - dsab(ia, ib, 2) = dsab(ia, ib, 2)+prefac*f0*rr(ax+2*i, bx, 1)*dumy*rr(az+2*k, bz, 3) + dumy = 2.0_dp*a*rr(ay + 2*j + 1, by, 2) + IF (ay + 2*j > 0) dumy = dumy - REAL(ay + 2*j, dp)*rr(ay + 2*j - 1, by, 2) + dsab(ia, ib, 2) = dsab(ia, ib, 2) + prefac*f0*rr(ax + 2*i, bx, 1)*dumy*rr(az + 2*k, bz, 3) ! dz - dumz = 2.0_dp*a*rr(az+2*k+1, bz, 3) - IF (az+2*k > 0) dumz = dumz-REAL(az+2*k, dp)*rr(az+2*k-1, bz, 3) - dsab(ia, ib, 3) = dsab(ia, ib, 3)+prefac*f0*rr(ax+2*i, bx, 1)*rr(ay+2*j, by, 2)*dumz + dumz = 2.0_dp*a*rr(az + 2*k + 1, bz, 3) + IF (az + 2*k > 0) dumz = dumz - REAL(az + 2*k, dp)*rr(az + 2*k - 1, bz, 3) + dsab(ia, ib, 3) = dsab(ia, ib, 3) + prefac*f0*rr(ax + 2*i, bx, 1)*rr(ay + 2*j, by, 2)*dumz ENDIF ENDDO ENDDO @@ -183,9 +183,9 @@ SUBROUTINE operator_ra2m(la_max, la_min, npgfa, zeta, & ENDDO ENDDO !lb - mb = mb+nb + mb = mb + nb END DO - ma = ma+na + ma = ma + na END DO DEALLOCATE (rr) diff --git a/src/aobasis/ai_operators_r12.F b/src/aobasis/ai_operators_r12.F index 6a3dbb56a8..17f23b9e57 100644 --- a/src/aobasis/ai_operators_r12.F +++ b/src/aobasis/ai_operators_r12.F @@ -139,7 +139,7 @@ SUBROUTINE operator2(cps_operator2, la_max, npgfa, zeta, la_min, lc_max, npgfc, vac_plus = 0.0_dp END IF - nmax = la_max+lc_max+1 + nmax = la_max + lc_max + 1 ! *** Calculate the distance of the centers a and c *** @@ -161,7 +161,7 @@ SUBROUTINE operator2(cps_operator2, la_max, npgfa, zeta, la_min, lc_max, npgfc, zetp = 1.0_dp/zeta(ipgf) zetq = 1.0_dp/zetc(jpgf) - zetw = 1.0_dp/(zeta(ipgf)+zetc(jpgf)) + zetw = 1.0_dp/(zeta(ipgf) + zetc(jpgf)) rho = zeta(ipgf)*zetc(jpgf)*zetw @@ -180,10 +180,10 @@ SUBROUTINE operator2(cps_operator2, la_max, npgfa, zeta, la_min, lc_max, npgfc, ! *** [s||p]{n} = (Wi - Ci)*[s||s]{n+1} (i = x,y,z) *** - DO n = 1, nmax-1 - v(1, 2, n) = rcw(1)*v(1, 1, n+1) - v(1, 3, n) = rcw(2)*v(1, 1, n+1) - v(1, 4, n) = rcw(3)*v(1, 1, n+1) + DO n = 1, nmax - 1 + v(1, 2, n) = rcw(1)*v(1, 1, n + 1) + v(1, 3, n) = rcw(2)*v(1, 1, n + 1) + v(1, 4, n) = rcw(3)*v(1, 1, n + 1) END DO ! ** [s||c]{n} = (Wi - Ci)*[s||c-1i]{n+1} + *** @@ -192,43 +192,43 @@ SUBROUTINE operator2(cps_operator2, la_max, npgfa, zeta, la_min, lc_max, npgfc, DO lc = 2, lc_max - DO n = 1, nmax-lc + DO n = 1, nmax - lc ! **** Increase the angular momentum component z of c *** v(1, coset(0, 0, lc), n) = & - rcw(3)*v(1, coset(0, 0, lc-1), n+1)+ & - f1*REAL(lc-1, dp)*(v(1, coset(0, 0, lc-2), n)+ & - f2*v(1, coset(0, 0, lc-2), n+1)) + rcw(3)*v(1, coset(0, 0, lc - 1), n + 1) + & + f1*REAL(lc - 1, dp)*(v(1, coset(0, 0, lc - 2), n) + & + f2*v(1, coset(0, 0, lc - 2), n + 1)) ! *** Increase the angular momentum component y of c *** - cz = lc-1 - v(1, coset(0, 1, cz), n) = rcw(2)*v(1, coset(0, 0, cz), n+1) + cz = lc - 1 + v(1, coset(0, 1, cz), n) = rcw(2)*v(1, coset(0, 0, cz), n + 1) DO cy = 2, lc - cz = lc-cy + cz = lc - cy v(1, coset(0, cy, cz), n) = & - rcw(2)*v(1, coset(0, cy-1, cz), n+1)+ & - f1*REAL(cy-1, dp)*(v(1, coset(0, cy-2, cz), n)+ & - f2*v(1, coset(0, cy-2, cz), n+1)) + rcw(2)*v(1, coset(0, cy - 1, cz), n + 1) + & + f1*REAL(cy - 1, dp)*(v(1, coset(0, cy - 2, cz), n) + & + f2*v(1, coset(0, cy - 2, cz), n + 1)) END DO ! *** Increase the angular momentum component x of c *** - DO cy = 0, lc-1 - cz = lc-1-cy - v(1, coset(1, cy, cz), n) = rcw(1)*v(1, coset(0, cy, cz), n+1) + DO cy = 0, lc - 1 + cz = lc - 1 - cy + v(1, coset(1, cy, cz), n) = rcw(1)*v(1, coset(0, cy, cz), n + 1) END DO DO cx = 2, lc - f6 = f1*REAL(cx-1, dp) - DO cy = 0, lc-cx - cz = lc-cx-cy + f6 = f1*REAL(cx - 1, dp) + DO cy = 0, lc - cx + cz = lc - cx - cy v(1, coset(cx, cy, cz), n) = & - rcw(1)*v(1, coset(cx-1, cy, cz), n+1)+ & - f6*(v(1, coset(cx-2, cy, cz), n)+ & - f2*v(1, coset(cx-2, cy, cz), n+1)) + rcw(1)*v(1, coset(cx - 1, cy, cz), n + 1) + & + f6*(v(1, coset(cx - 2, cy, cz), n) + & + f2*v(1, coset(cx - 2, cy, cz), n + 1)) END DO END DO @@ -250,10 +250,10 @@ SUBROUTINE operator2(cps_operator2, la_max, npgfa, zeta, la_min, lc_max, npgfc, ! *** [p||s]{n} = (Wi - Ai)*[s||s]{n+1} (i = x,y,z) *** - DO n = 1, nmax-1 - v(2, 1, n) = raw(1)*v(1, 1, n+1) - v(3, 1, n) = raw(2)*v(1, 1, n+1) - v(4, 1, n) = raw(3)*v(1, 1, n+1) + DO n = 1, nmax - 1 + v(2, 1, n) = raw(1)*v(1, 1, n + 1) + v(3, 1, n) = raw(2)*v(1, 1, n + 1) + v(4, 1, n) = raw(3)*v(1, 1, n + 1) END DO ! *** [a||s]{n} = (Wi - Ai)*[a-1i||s]{n+1} + *** @@ -262,43 +262,43 @@ SUBROUTINE operator2(cps_operator2, la_max, npgfa, zeta, la_min, lc_max, npgfc, DO la = 2, la_max - DO n = 1, nmax-la + DO n = 1, nmax - la ! *** Increase the angular momentum component z of a *** v(coset(0, 0, la), 1, n) = & - raw(3)*v(coset(0, 0, la-1), 1, n+1)+ & - f3*REAL(la-1, dp)*(v(coset(0, 0, la-2), 1, n)+ & - f4*v(coset(0, 0, la-2), 1, n+1)) + raw(3)*v(coset(0, 0, la - 1), 1, n + 1) + & + f3*REAL(la - 1, dp)*(v(coset(0, 0, la - 2), 1, n) + & + f4*v(coset(0, 0, la - 2), 1, n + 1)) ! *** Increase the angular momentum component y of a *** - az = la-1 - v(coset(0, 1, az), 1, n) = raw(2)*v(coset(0, 0, az), 1, n+1) + az = la - 1 + v(coset(0, 1, az), 1, n) = raw(2)*v(coset(0, 0, az), 1, n + 1) DO ay = 2, la - az = la-ay + az = la - ay v(coset(0, ay, az), 1, n) = & - raw(2)*v(coset(0, ay-1, az), 1, n+1)+ & - f3*REAL(ay-1, dp)*(v(coset(0, ay-2, az), 1, n)+ & - f4*v(coset(0, ay-2, az), 1, n+1)) + raw(2)*v(coset(0, ay - 1, az), 1, n + 1) + & + f3*REAL(ay - 1, dp)*(v(coset(0, ay - 2, az), 1, n) + & + f4*v(coset(0, ay - 2, az), 1, n + 1)) END DO ! *** Increase the angular momentum component x of a *** - DO ay = 0, la-1 - az = la-1-ay - v(coset(1, ay, az), 1, n) = raw(1)*v(coset(0, ay, az), 1, n+1) + DO ay = 0, la - 1 + az = la - 1 - ay + v(coset(1, ay, az), 1, n) = raw(1)*v(coset(0, ay, az), 1, n + 1) END DO DO ax = 2, la - f6 = f3*REAL(ax-1, dp) - DO ay = 0, la-ax - az = la-ax-ay + f6 = f3*REAL(ax - 1, dp) + DO ay = 0, la - ax + az = la - ax - ay v(coset(ax, ay, az), 1, n) = & - raw(1)*v(coset(ax-1, ay, az), 1, n+1)+ & - f6*(v(coset(ax-2, ay, az), 1, n)+ & - f4*v(coset(ax-2, ay, az), 1, n+1)) + raw(1)*v(coset(ax - 1, ay, az), 1, n + 1) + & + f6*(v(coset(ax - 2, ay, az), 1, n) + & + f4*v(coset(ax - 2, ay, az), 1, n + 1)) END DO END DO @@ -309,13 +309,13 @@ SUBROUTINE operator2(cps_operator2, la_max, npgfa, zeta, la_min, lc_max, npgfc, DO lc = 1, lc_max DO cx = 0, lc - DO cy = 0, lc-cx - cz = lc-cx-cy + DO cy = 0, lc - cx + cz = lc - cx - cy coc = coset(cx, cy, cz) - cocx = coset(MAX(0, cx-1), cy, cz) - cocy = coset(cx, MAX(0, cy-1), cz) - cocz = coset(cx, cy, MAX(0, cz-1)) + cocx = coset(MAX(0, cx - 1), cy, cz) + cocy = coset(cx, MAX(0, cy - 1), cz) + cocz = coset(cx, cy, MAX(0, cz - 1)) fcx = f5*REAL(cx, dp) fcy = f5*REAL(cy, dp) @@ -324,10 +324,10 @@ SUBROUTINE operator2(cps_operator2, la_max, npgfa, zeta, la_min, lc_max, npgfc, ! *** [p||c]{n} = (Wi - Ai)*[s||c]{n+1} + *** ! *** f5*Ni(c)*[s||c-1i]{n+1} *** - DO n = 1, nmax-1-lc - v(2, coc, n) = raw(1)*v(1, coc, n+1)+fcx*v(1, cocx, n+1) - v(3, coc, n) = raw(2)*v(1, coc, n+1)+fcy*v(1, cocy, n+1) - v(4, coc, n) = raw(3)*v(1, coc, n+1)+fcz*v(1, cocz, n+1) + DO n = 1, nmax - 1 - lc + v(2, coc, n) = raw(1)*v(1, coc, n + 1) + fcx*v(1, cocx, n + 1) + v(3, coc, n) = raw(2)*v(1, coc, n + 1) + fcy*v(1, cocy, n + 1) + v(4, coc, n) = raw(3)*v(1, coc, n + 1) + fcz*v(1, cocz, n + 1) END DO ! *** [a||c]{n} = (Wi - Ai)*[a-1i||c]{n+1} + *** @@ -337,50 +337,50 @@ SUBROUTINE operator2(cps_operator2, la_max, npgfa, zeta, la_min, lc_max, npgfc, DO la = 2, la_max - DO n = 1, nmax-la-lc + DO n = 1, nmax - la - lc ! *** Increase the angular momentum component z of a *** v(coset(0, 0, la), coc, n) = & - raw(3)*v(coset(0, 0, la-1), coc, n+1)+ & - f3*REAL(la-1, dp)*(v(coset(0, 0, la-2), coc, n)+ & - f4*v(coset(0, 0, la-2), coc, n+1))+ & - fcz*v(coset(0, 0, la-1), cocz, n+1) + raw(3)*v(coset(0, 0, la - 1), coc, n + 1) + & + f3*REAL(la - 1, dp)*(v(coset(0, 0, la - 2), coc, n) + & + f4*v(coset(0, 0, la - 2), coc, n + 1)) + & + fcz*v(coset(0, 0, la - 1), cocz, n + 1) ! *** Increase the angular momentum component y of a *** - az = la-1 + az = la - 1 v(coset(0, 1, az), coc, n) = & - raw(2)*v(coset(0, 0, az), coc, n+1)+ & - fcy*v(coset(0, 0, az), cocy, n+1) + raw(2)*v(coset(0, 0, az), coc, n + 1) + & + fcy*v(coset(0, 0, az), cocy, n + 1) DO ay = 2, la - az = la-ay + az = la - ay v(coset(0, ay, az), coc, n) = & - raw(2)*v(coset(0, ay-1, az), coc, n+1)+ & - f3*REAL(ay-1, dp)*(v(coset(0, ay-2, az), coc, n)+ & - f4*v(coset(0, ay-2, az), coc, n+1))+ & - fcy*v(coset(0, ay-1, az), cocy, n+1) + raw(2)*v(coset(0, ay - 1, az), coc, n + 1) + & + f3*REAL(ay - 1, dp)*(v(coset(0, ay - 2, az), coc, n) + & + f4*v(coset(0, ay - 2, az), coc, n + 1)) + & + fcy*v(coset(0, ay - 1, az), cocy, n + 1) END DO ! *** Increase the angular momentum component x of a *** - DO ay = 0, la-1 - az = la-1-ay + DO ay = 0, la - 1 + az = la - 1 - ay v(coset(1, ay, az), coc, n) = & - raw(1)*v(coset(0, ay, az), coc, n+1)+ & - fcx*v(coset(0, ay, az), cocx, n+1) + raw(1)*v(coset(0, ay, az), coc, n + 1) + & + fcx*v(coset(0, ay, az), cocx, n + 1) END DO DO ax = 2, la - f6 = f3*REAL(ax-1, dp) - DO ay = 0, la-ax - az = la-ax-ay + f6 = f3*REAL(ax - 1, dp) + DO ay = 0, la - ax + az = la - ax - ay v(coset(ax, ay, az), coc, n) = & - raw(1)*v(coset(ax-1, ay, az), coc, n+1)+ & - f6*(v(coset(ax-2, ay, az), coc, n)+ & - f4*v(coset(ax-2, ay, az), coc, n+1))+ & - fcx*v(coset(ax-1, ay, az), cocx, n+1) + raw(1)*v(coset(ax - 1, ay, az), coc, n + 1) + & + f6*(v(coset(ax - 2, ay, az), coc, n) + & + f4*v(coset(ax - 2, ay, az), coc, n + 1)) + & + fcx*v(coset(ax - 1, ay, az), cocx, n + 1) END DO END DO @@ -395,27 +395,27 @@ SUBROUTINE operator2(cps_operator2, la_max, npgfa, zeta, la_min, lc_max, npgfc, END IF - DO j = ncoset(lc_min-1)+1, ncoset(lc_max-maxder_local) - DO i = ncoset(la_min-1)+1, ncoset(la_max-maxder_local) - vac(na+i, nc+j) = v(i, j, 1) + DO j = ncoset(lc_min - 1) + 1, ncoset(lc_max - maxder_local) + DO i = ncoset(la_min - 1) + 1, ncoset(la_max - maxder_local) + vac(na + i, nc + j) = v(i, j, 1) END DO END DO IF (PRESENT(maxder)) THEN DO j = 1, ncoset(lc_max) DO i = 1, ncoset(la_max) - vac_plus(nap+i, ncp+j) = v(i, j, 1) + vac_plus(nap + i, ncp + j) = v(i, j, 1) END DO END DO END IF - nc = nc+ncoset(lc_max-maxder_local) - ncp = ncp+ncoset(lc_max) + nc = nc + ncoset(lc_max - maxder_local) + ncp = ncp + ncoset(lc_max) END DO - na = na+ncoset(la_max-maxder_local) - nap = nap+ncoset(la_max) + na = na + ncoset(la_max - maxder_local) + nap = nap + ncoset(la_max) END DO @@ -458,12 +458,12 @@ SUBROUTINE cps_coulomb2(v, nmax, zetp, zetq, zetw, rho, rac2, omega, r_cutoff) ! *** Calculate the incomplete Gamma/Boys function *** t = rho*rac2 - CALL fgamma(nmax-1, t, f) + CALL fgamma(nmax - 1, t, f) ! *** Calculate the basic two-center integrals [s||s]{n} *** DO n = 1, nmax - v(1, 1, n) = f0*f(n-1) + v(1, 1, n) = f0*f(n - 1) END DO DEALLOCATE (f) @@ -497,19 +497,19 @@ SUBROUTINE cps_verf2(v, nmax, zetp, zetq, zetw, rho, rac2, omega, r_cutoff) MARK_USED(r_cutoff) ALLOCATE (f(0:nmax)) - comega = omega**2/(omega**2+rho) + comega = omega**2/(omega**2 + rho) f0 = 2.0_dp*SQRT(pi**5*zetw*comega)*zetp*zetq ! *** Calculate the incomplete Gamma/Boys function *** t = rho*rac2 arg = comega*t - CALL fgamma(nmax-1, arg, f) + CALL fgamma(nmax - 1, arg, f) ! *** Calculate the basic two-center integrals [s||s]{n} *** DO n = 1, nmax - v(1, 1, n) = f0*f(n-1)*comega**(n-1) + v(1, 1, n) = f0*f(n - 1)*comega**(n - 1) END DO DEALLOCATE (f) @@ -544,7 +544,7 @@ SUBROUTINE cps_verfc2(v, nmax, zetp, zetq, zetw, rho, rac2, omega, r_cutoff) MARK_USED(r_cutoff) ALLOCATE (fv(0:nmax), fverf(0:nmax)) - comega = omega**2/(omega**2+rho) + comega = omega**2/(omega**2 + rho) f0 = 2.0_dp*SQRT(pi**5*zetw)*zetp*zetq ! *** Calculate the incomplete Gamma/Boys function *** @@ -552,13 +552,13 @@ SUBROUTINE cps_verfc2(v, nmax, zetp, zetq, zetw, rho, rac2, omega, r_cutoff) t = rho*rac2 argerf = comega*t - CALL fgamma(nmax-1, t, fv) - CALL fgamma(nmax-1, argerf, fverf) + CALL fgamma(nmax - 1, t, fv) + CALL fgamma(nmax - 1, argerf, fverf) ! *** Calculate the basic two-center integrals [s||s]{n} *** DO n = 1, nmax - v(1, 1, n) = f0*(fv(n-1)-SQRT(comega)*comega**(n-1)*fverf(n-1)) + v(1, 1, n) = f0*(fv(n - 1) - SQRT(comega)*comega**(n - 1)*fverf(n - 1)) END DO DEALLOCATE (fv, fverf) @@ -596,26 +596,26 @@ SUBROUTINE cps_vgauss2(v, nmax, zetp, zetq, zetw, rho, rac2, omega, r_cutoff) dummy = zetp dummy = zetq - eta = rho/(rho+omega) - tau = omega/(rho+omega) + eta = rho/(rho + omega) + tau = omega/(rho + omega) ! *** Calculate the incomplete Gamma/Boys function *** t = rho*rac2 arg = eta*t - CALL fgamma(nmax-1, arg, f) + CALL fgamma(nmax - 1, arg, f) - expT = EXP(-omega/(omega+rho)*t) - f0 = 2.0_dp*SQRT(pi**5*zetw**3)/(rho+omega)*expT + expT = EXP(-omega/(omega + rho)*t) + f0 = 2.0_dp*SQRT(pi**5*zetw**3)/(rho + omega)*expT ! *** Calculate the basic two-center integrals [s||s]{n} *** v(1, 1, 1:nmax) = 0.0_dp DO n = 1, nmax - fsign = (-1.0_dp)**(n-1) - DO j = 0, n-1 - v(1, 1, n) = v(1, 1, n)+f0*fsign* & - fac(n-1)/fac(n-j-1)/fac(j)*(-tau)**(n-j-1)*(-eta)**j*f(j) + fsign = (-1.0_dp)**(n - 1) + DO j = 0, n - 1 + v(1, 1, n) = v(1, 1, n) + f0*fsign* & + fac(n - 1)/fac(n - j - 1)/fac(j)*(-tau)**(n - j - 1)*(-eta)**j*f(j) ENDDO ENDDO @@ -654,15 +654,15 @@ SUBROUTINE cps_gauss2(v, nmax, zetp, zetq, zetw, rho, rac2, omega, r_cutoff) dummy = zetp dummy = zetq - tau = omega/(rho+omega) + tau = omega/(rho + omega) t = rho*rac2 expT = EXP(-tau*t) - f0 = pi**3*SQRT(zetw**3/(rho+omega)**3)*expT + f0 = pi**3*SQRT(zetw**3/(rho + omega)**3)*expT ! *** Calculate the basic two-center integrals [s||s]{n} *** DO n = 1, nmax - v(1, 1, n) = f0*tau**(n-1) + v(1, 1, n) = f0*tau**(n - 1) END DO DEALLOCATE (f) @@ -698,7 +698,7 @@ SUBROUTINE cps_truncated2(v, nmax, zetp, zetq, zetw, rho, rac2, omega, r_cutoff) MARK_USED(omega) - ALLOCATE (f(nmax+1)) !t_c_g0 needs to start at index 1 + ALLOCATE (f(nmax + 1)) !t_c_g0 needs to start at index 1 r = r_cutoff*SQRT(rho) t = rho*rac2 diff --git a/src/aobasis/ai_os_rr.F b/src/aobasis/ai_os_rr.F index 1bc3a81063..3c7d15cd2b 100644 --- a/src/aobasis/ai_os_rr.F +++ b/src/aobasis/ai_os_rr.F @@ -57,12 +57,12 @@ SUBROUTINE os_rr_ovlp(rap, la_max, rbp, lb_max, zet, ldrr, rr) rr(1, 0, 2) = rap(2) rr(1, 0, 3) = rap(3) ! - DO la = 1, la_max-1 - lap1 = la+1 - lam1 = la-1 - rr(lap1, 0, 1) = REAL(la, dp)*g*rr(lam1, 0, 1)+rap(1)*rr(la, 0, 1) - rr(lap1, 0, 2) = REAL(la, dp)*g*rr(lam1, 0, 2)+rap(2)*rr(la, 0, 2) - rr(lap1, 0, 3) = REAL(la, dp)*g*rr(lam1, 0, 3)+rap(3)*rr(la, 0, 3) + DO la = 1, la_max - 1 + lap1 = la + 1 + lam1 = la - 1 + rr(lap1, 0, 1) = REAL(la, dp)*g*rr(lam1, 0, 1) + rap(1)*rr(la, 0, 1) + rr(lap1, 0, 2) = REAL(la, dp)*g*rr(lam1, 0, 2) + rap(2)*rr(la, 0, 2) + rr(lap1, 0, 3) = REAL(la, dp)*g*rr(lam1, 0, 3) + rap(3)*rr(la, 0, 3) ENDDO ENDIF ! @@ -74,23 +74,23 @@ SUBROUTINE os_rr_ovlp(rap, la_max, rbp, lb_max, zet, ldrr, rr) rr(0, 1, 3) = rbp(3) ! DO la = 1, la_max - lam1 = la-1 - rr(la, 1, 1) = REAL(la, dp)*g*rr(lam1, 0, 1)+rbp(1)*rr(la, 0, 1) - rr(la, 1, 2) = REAL(la, dp)*g*rr(lam1, 0, 2)+rbp(2)*rr(la, 0, 2) - rr(la, 1, 3) = REAL(la, dp)*g*rr(lam1, 0, 3)+rbp(3)*rr(la, 0, 3) + lam1 = la - 1 + rr(la, 1, 1) = REAL(la, dp)*g*rr(lam1, 0, 1) + rbp(1)*rr(la, 0, 1) + rr(la, 1, 2) = REAL(la, dp)*g*rr(lam1, 0, 2) + rbp(2)*rr(la, 0, 2) + rr(la, 1, 3) = REAL(la, dp)*g*rr(lam1, 0, 3) + rbp(3)*rr(la, 0, 3) ENDDO ! - DO lb = 1, lb_max-1 - lbp1 = lb+1 - lbm1 = lb-1 - rr(0, lbp1, 1) = REAL(lb, dp)*g*rr(0, lbm1, 1)+rbp(1)*rr(0, lb, 1) - rr(0, lbp1, 2) = REAL(lb, dp)*g*rr(0, lbm1, 2)+rbp(2)*rr(0, lb, 2) - rr(0, lbp1, 3) = REAL(lb, dp)*g*rr(0, lbm1, 3)+rbp(3)*rr(0, lb, 3) + DO lb = 1, lb_max - 1 + lbp1 = lb + 1 + lbm1 = lb - 1 + rr(0, lbp1, 1) = REAL(lb, dp)*g*rr(0, lbm1, 1) + rbp(1)*rr(0, lb, 1) + rr(0, lbp1, 2) = REAL(lb, dp)*g*rr(0, lbm1, 2) + rbp(2)*rr(0, lb, 2) + rr(0, lbp1, 3) = REAL(lb, dp)*g*rr(0, lbm1, 3) + rbp(3)*rr(0, lb, 3) DO la = 1, la_max - lam1 = la-1 - rr(la, lbp1, 1) = g*(REAL(la, dp)*rr(lam1, lb, 1)+REAL(lb, dp)*rr(la, lbm1, 1))+rbp(1)*rr(la, lb, 1) - rr(la, lbp1, 2) = g*(REAL(la, dp)*rr(lam1, lb, 2)+REAL(lb, dp)*rr(la, lbm1, 2))+rbp(2)*rr(la, lb, 2) - rr(la, lbp1, 3) = g*(REAL(la, dp)*rr(lam1, lb, 3)+REAL(lb, dp)*rr(la, lbm1, 3))+rbp(3)*rr(la, lb, 3) + lam1 = la - 1 + rr(la, lbp1, 1) = g*(REAL(la, dp)*rr(lam1, lb, 1) + REAL(lb, dp)*rr(la, lbm1, 1)) + rbp(1)*rr(la, lb, 1) + rr(la, lbp1, 2) = g*(REAL(la, dp)*rr(lam1, lb, 2) + REAL(lb, dp)*rr(la, lbm1, 2)) + rbp(2)*rr(la, lb, 2) + rr(la, lbp1, 3) = g*(REAL(la, dp)*rr(lam1, lb, 3) + REAL(lb, dp)*rr(la, lbm1, 3)) + rbp(3)*rr(la, lb, 3) ENDDO ENDDO ENDIF @@ -131,12 +131,12 @@ SUBROUTINE os_rr_coul(rap, la_max, rbp, lb_max, rcp, zet, ldrr1, ldrr2, rr) cob2y, cob2z, la, lb, m, mmax REAL(dp) :: g, rcp2, t - mmax = la_max+lb_max + mmax = la_max + lb_max g = 0.5_dp/zet ! ! rr(0:mmax) should be initialized before ! - rcp2 = rcp(1)**2+rcp(2)**2+rcp(3)**2 + rcp2 = rcp(1)**2 + rcp(2)**2 + rcp(3)**2 t = zet*rcp2 CALL fgamma(mmax, t, rr(0:mmax, 1, 1)) ! @@ -144,40 +144,40 @@ SUBROUTINE os_rr_coul(rap, la_max, rbp, lb_max, rcp, zet, ldrr1, ldrr2, rr) ! DO la = 1, la_max DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay coa = coset(ax, ay, az) - coa1x = coset(MAX(ax-1, 0), ay, az) - coa1y = coset(ax, MAX(ay-1, 0), az) - coa1z = coset(ax, ay, MAX(az-1, 0)) - coa2x = coset(MAX(ax-2, 0), ay, az) - coa2y = coset(ax, MAX(ay-2, 0), az) - coa2z = coset(ax, ay, MAX(az-2, 0)) + coa1x = coset(MAX(ax - 1, 0), ay, az) + coa1y = coset(ax, MAX(ay - 1, 0), az) + coa1z = coset(ax, ay, MAX(az - 1, 0)) + coa2x = coset(MAX(ax - 2, 0), ay, az) + coa2y = coset(ax, MAX(ay - 2, 0), az) + coa2z = coset(ax, ay, MAX(az - 2, 0)) IF (az .GT. 0) THEN - DO m = 0, mmax-la - rr(m, coa, 1) = rap(3)*rr(m, coa1z, 1)-rcp(3)*rr(m+1, coa1z, 1) + DO m = 0, mmax - la + rr(m, coa, 1) = rap(3)*rr(m, coa1z, 1) - rcp(3)*rr(m + 1, coa1z, 1) ENDDO IF (az .GT. 1) THEN - DO m = 0, mmax-la - rr(m, coa, 1) = rr(m, coa, 1)+g*REAL(az-1, dp)*(rr(m, coa2z, 1)-rr(m+1, coa2z, 1)) + DO m = 0, mmax - la + rr(m, coa, 1) = rr(m, coa, 1) + g*REAL(az - 1, dp)*(rr(m, coa2z, 1) - rr(m + 1, coa2z, 1)) ENDDO ENDIF ELSEIF (ay .GT. 0) THEN - DO m = 0, mmax-la - rr(m, coa, 1) = rap(2)*rr(m, coa1y, 1)-rcp(2)*rr(m+1, coa1y, 1) + DO m = 0, mmax - la + rr(m, coa, 1) = rap(2)*rr(m, coa1y, 1) - rcp(2)*rr(m + 1, coa1y, 1) ENDDO IF (ay .GT. 1) THEN - DO m = 0, mmax-la - rr(m, coa, 1) = rr(m, coa, 1)+g*REAL(ay-1, dp)*(rr(m, coa2y, 1)-rr(m+1, coa2y, 1)) + DO m = 0, mmax - la + rr(m, coa, 1) = rr(m, coa, 1) + g*REAL(ay - 1, dp)*(rr(m, coa2y, 1) - rr(m + 1, coa2y, 1)) ENDDO ENDIF ELSEIF (ax .GT. 0) THEN - DO m = 0, mmax-la - rr(m, coa, 1) = rap(1)*rr(m, coa1x, 1)-rcp(1)*rr(m+1, coa1x, 1) + DO m = 0, mmax - la + rr(m, coa, 1) = rap(1)*rr(m, coa1x, 1) - rcp(1)*rr(m + 1, coa1x, 1) ENDDO IF (ax .GT. 1) THEN - DO m = 0, mmax-la - rr(m, coa, 1) = rr(m, coa, 1)+g*REAL(ax-1, dp)*(rr(m, coa2x, 1)-rr(m+1, coa2x, 1)) + DO m = 0, mmax - la + rr(m, coa, 1) = rr(m, coa, 1) + g*REAL(ax - 1, dp)*(rr(m, coa2x, 1) - rr(m + 1, coa2x, 1)) ENDDO ENDIF ELSE @@ -191,66 +191,66 @@ SUBROUTINE os_rr_coul(rap, la_max, rbp, lb_max, rcp, zet, ldrr1, ldrr2, rr) ! DO la = 0, la_max DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay coa = coset(ax, ay, az) - coa1x = coset(MAX(ax-1, 0), ay, az) - coa1y = coset(ax, MAX(ay-1, 0), az) - coa1z = coset(ax, ay, MAX(az-1, 0)) - coa2x = coset(MAX(ax-2, 0), ay, az) - coa2y = coset(ax, MAX(ay-2, 0), az) - coa2z = coset(ax, ay, MAX(az-2, 0)) + coa1x = coset(MAX(ax - 1, 0), ay, az) + coa1y = coset(ax, MAX(ay - 1, 0), az) + coa1z = coset(ax, ay, MAX(az - 1, 0)) + coa2x = coset(MAX(ax - 2, 0), ay, az) + coa2y = coset(ax, MAX(ay - 2, 0), az) + coa2z = coset(ax, ay, MAX(az - 2, 0)) DO lb = 1, lb_max DO bx = 0, lb - DO by = 0, lb-bx - bz = lb-bx-by + DO by = 0, lb - bx + bz = lb - bx - by cob = coset(bx, by, bz) - cob1x = coset(MAX(bx-1, 0), by, bz) - cob1y = coset(bx, MAX(by-1, 0), bz) - cob1z = coset(bx, by, MAX(bz-1, 0)) - cob2x = coset(MAX(bx-2, 0), by, bz) - cob2y = coset(bx, MAX(by-2, 0), bz) - cob2z = coset(bx, by, MAX(bz-2, 0)) + cob1x = coset(MAX(bx - 1, 0), by, bz) + cob1y = coset(bx, MAX(by - 1, 0), bz) + cob1z = coset(bx, by, MAX(bz - 1, 0)) + cob2x = coset(MAX(bx - 2, 0), by, bz) + cob2y = coset(bx, MAX(by - 2, 0), bz) + cob2z = coset(bx, by, MAX(bz - 2, 0)) IF (bz .GT. 0) THEN - DO m = 0, mmax-la-lb - rr(m, coa, cob) = rbp(3)*rr(m, coa, cob1z)-rcp(3)*rr(m+1, coa, cob1z) + DO m = 0, mmax - la - lb + rr(m, coa, cob) = rbp(3)*rr(m, coa, cob1z) - rcp(3)*rr(m + 1, coa, cob1z) ENDDO IF (bz .GT. 1) THEN - DO m = 0, mmax-la-lb - rr(m, coa, cob) = rr(m, coa, cob)+g*REAL(bz-1, dp)*(rr(m, coa, cob2z)-rr(m+1, coa, cob2z)) + DO m = 0, mmax - la - lb + rr(m, coa, cob) = rr(m, coa, cob) + g*REAL(bz - 1, dp)*(rr(m, coa, cob2z) - rr(m + 1, coa, cob2z)) ENDDO ENDIF IF (az .GT. 0) THEN - DO m = 0, mmax-la-lb - rr(m, coa, cob) = rr(m, coa, cob)+g*REAL(az, dp)*(rr(m, coa1z, cob1z)-rr(m+1, coa1z, cob1z)) + DO m = 0, mmax - la - lb + rr(m, coa, cob) = rr(m, coa, cob) + g*REAL(az, dp)*(rr(m, coa1z, cob1z) - rr(m + 1, coa1z, cob1z)) ENDDO ENDIF ELSEIF (by .GT. 0) THEN - DO m = 0, mmax-la-lb - rr(m, coa, cob) = rbp(2)*rr(m, coa, cob1y)-rcp(2)*rr(m+1, coa, cob1y) + DO m = 0, mmax - la - lb + rr(m, coa, cob) = rbp(2)*rr(m, coa, cob1y) - rcp(2)*rr(m + 1, coa, cob1y) ENDDO IF (by .GT. 1) THEN - DO m = 0, mmax-la-lb - rr(m, coa, cob) = rr(m, coa, cob)+g*REAL(by-1, dp)*(rr(m, coa, cob2y)-rr(m+1, coa, cob2y)) + DO m = 0, mmax - la - lb + rr(m, coa, cob) = rr(m, coa, cob) + g*REAL(by - 1, dp)*(rr(m, coa, cob2y) - rr(m + 1, coa, cob2y)) ENDDO ENDIF IF (ay .GT. 0) THEN - DO m = 0, mmax-la-lb - rr(m, coa, cob) = rr(m, coa, cob)+g*REAL(ay, dp)*(rr(m, coa1y, cob1y)-rr(m+1, coa1y, cob1y)) + DO m = 0, mmax - la - lb + rr(m, coa, cob) = rr(m, coa, cob) + g*REAL(ay, dp)*(rr(m, coa1y, cob1y) - rr(m + 1, coa1y, cob1y)) ENDDO ENDIF ELSEIF (bx .GT. 0) THEN - DO m = 0, mmax-la-lb - rr(m, coa, cob) = rbp(1)*rr(m, coa, cob1x)-rcp(1)*rr(m+1, coa, cob1x) + DO m = 0, mmax - la - lb + rr(m, coa, cob) = rbp(1)*rr(m, coa, cob1x) - rcp(1)*rr(m + 1, coa, cob1x) ENDDO IF (bx .GT. 1) THEN - DO m = 0, mmax-la-lb - rr(m, coa, cob) = rr(m, coa, cob)+g*REAL(bx-1, dp)*(rr(m, coa, cob2x)-rr(m+1, coa, cob2x)) + DO m = 0, mmax - la - lb + rr(m, coa, cob) = rr(m, coa, cob) + g*REAL(bx - 1, dp)*(rr(m, coa, cob2x) - rr(m + 1, coa, cob2x)) ENDDO ENDIF IF (ax .GT. 0) THEN - DO m = 0, mmax-la-lb - rr(m, coa, cob) = rr(m, coa, cob)+g*REAL(ax, dp)*(rr(m, coa1x, cob1x)-rr(m+1, coa1x, cob1x)) + DO m = 0, mmax - la - lb + rr(m, coa, cob) = rr(m, coa, cob) + g*REAL(ax, dp)*(rr(m, coa1x, cob1x) - rr(m + 1, coa1x, cob1x)) ENDDO ENDIF ELSE diff --git a/src/aobasis/ai_overlap.F b/src/aobasis/ai_overlap.F index 4304a167ad..e73de346ff 100644 --- a/src/aobasis/ai_overlap.F +++ b/src/aobasis/ai_overlap.F @@ -107,17 +107,17 @@ SUBROUTINE overlap(la_max_set, la_min_set, npgfa, rpgfa, zeta, & IF (PRESENT(sdab) .OR. calculate_force_a) THEN IF (da_max_set == 0) THEN da_max = 1 - la_max = la_max_set+1 - la_min = MAX(0, la_min_set-1) + la_max = la_max_set + 1 + la_min = MAX(0, la_min_set - 1) ELSE da_max = da_max_set - la_max = la_max_set+da_max_set+1 - la_min = MAX(0, la_min_set-da_max_set-1) + la_max = la_max_set + da_max_set + 1 + la_min = MAX(0, la_min_set - da_max_set - 1) END IF ELSE da_max = da_max_set - la_max = la_max_set+da_max_set - la_min = MAX(0, la_min_set-da_max_set) + la_max = la_max_set + da_max_set + la_min = MAX(0, la_min_set - da_max_set) END IF lb_max = lb_max_set @@ -136,29 +136,29 @@ SUBROUTINE overlap(la_max_set, la_min_set, npgfa, rpgfa, zeta, & ! *** Screening *** - IF (rpgfa(ipgf)+rpgfb(jpgf) < dab) THEN - DO j = nb+1, nb+ncoset(lb_max_set) - DO i = na+1, na+ncoset(la_max_set) + IF (rpgfa(ipgf) + rpgfb(jpgf) < dab) THEN + DO j = nb + 1, nb + ncoset(lb_max_set) + DO i = na + 1, na + ncoset(la_max_set) sab(i, j) = 0.0_dp END DO END DO IF (return_derivatives) THEN DO k = 2, ncoset(da_max_set) - jstart = (k-1)*SIZE(sab, 1) - DO j = jstart+nb+1, jstart+nb+ncoset(lb_max_set) - DO i = na+1, na+ncoset(la_max_set) + jstart = (k - 1)*SIZE(sab, 1) + DO j = jstart + nb + 1, jstart + nb + ncoset(lb_max_set) + DO i = na + 1, na + ncoset(la_max_set) sab(i, j) = 0.0_dp END DO END DO END DO END IF - nb = nb+ncoset(lb_max_set) + nb = nb + ncoset(lb_max_set) CYCLE END IF ! *** Calculate some prefactors *** - zetp = 1.0_dp/(zeta(ipgf)+zetb(jpgf)) + zetp = 1.0_dp/(zeta(ipgf) + zetb(jpgf)) f0 = SQRT((pi*zetp)**3) f1 = zetb(jpgf)*zetp @@ -188,12 +188,12 @@ SUBROUTINE overlap(la_max_set, la_min_set, npgfa, rpgfa, zeta, & f3 = f2*s(1, 1, 1) - s(5, 1, 1) = rap(1)*s(2, 1, 1)+f3 ! [dx2|s] + s(5, 1, 1) = rap(1)*s(2, 1, 1) + f3 ! [dx2|s] s(6, 1, 1) = rap(1)*s(3, 1, 1) ! [dxy|s] s(7, 1, 1) = rap(1)*s(4, 1, 1) ! [dxz|s] - s(8, 1, 1) = rap(2)*s(3, 1, 1)+f3 ! [dy2|s] + s(8, 1, 1) = rap(2)*s(3, 1, 1) + f3 ! [dy2|s] s(9, 1, 1) = rap(2)*s(4, 1, 1) ! [dyz|s] - s(10, 1, 1) = rap(3)*s(4, 1, 1)+f3 ! [dz2|s] + s(10, 1, 1) = rap(3)*s(4, 1, 1) + f3 ! [dz2|s] IF (la_max > 2) THEN @@ -201,16 +201,16 @@ SUBROUTINE overlap(la_max_set, la_min_set, npgfa, rpgfa, zeta, & f3 = 2.0_dp*f2 - s(11, 1, 1) = rap(1)*s(5, 1, 1)+f3*s(2, 1, 1) ! [fx3 |s] - s(12, 1, 1) = rap(1)*s(6, 1, 1)+f2*s(3, 1, 1) ! [fx2y|s] - s(13, 1, 1) = rap(1)*s(7, 1, 1)+f2*s(4, 1, 1) ! [fx2z|s] + s(11, 1, 1) = rap(1)*s(5, 1, 1) + f3*s(2, 1, 1) ! [fx3 |s] + s(12, 1, 1) = rap(1)*s(6, 1, 1) + f2*s(3, 1, 1) ! [fx2y|s] + s(13, 1, 1) = rap(1)*s(7, 1, 1) + f2*s(4, 1, 1) ! [fx2z|s] s(14, 1, 1) = rap(1)*s(8, 1, 1) ! [fxy2|s] s(15, 1, 1) = rap(1)*s(9, 1, 1) ! [fxyz|s] s(16, 1, 1) = rap(1)*s(10, 1, 1) ! [fxz2|s] - s(17, 1, 1) = rap(2)*s(8, 1, 1)+f3*s(3, 1, 1) ! [fy3 |s] - s(18, 1, 1) = rap(2)*s(9, 1, 1)+f2*s(4, 1, 1) ! [fy2z|s] + s(17, 1, 1) = rap(2)*s(8, 1, 1) + f3*s(3, 1, 1) ! [fy3 |s] + s(18, 1, 1) = rap(2)*s(9, 1, 1) + f2*s(4, 1, 1) ! [fy2z|s] s(19, 1, 1) = rap(2)*s(10, 1, 1) ! [fyz2|s] - s(20, 1, 1) = rap(3)*s(10, 1, 1)+f3*s(4, 1, 1) ! [fz3 |s] + s(20, 1, 1) = rap(3)*s(10, 1, 1) + f3*s(4, 1, 1) ! [fz3 |s] IF (la_max > 3) THEN @@ -218,21 +218,21 @@ SUBROUTINE overlap(la_max_set, la_min_set, npgfa, rpgfa, zeta, & f4 = 3.0_dp*f2 - s(21, 1, 1) = rap(1)*s(11, 1, 1)+f4*s(5, 1, 1) ! [gx4 |s] - s(22, 1, 1) = rap(1)*s(12, 1, 1)+f3*s(6, 1, 1) ! [gx3y |s] - s(23, 1, 1) = rap(1)*s(13, 1, 1)+f3*s(7, 1, 1) ! [gx3z |s] - s(24, 1, 1) = rap(1)*s(14, 1, 1)+f2*s(8, 1, 1) ! [gx2y2|s] - s(25, 1, 1) = rap(1)*s(15, 1, 1)+f2*s(9, 1, 1) ! [gx2yz|s] - s(26, 1, 1) = rap(1)*s(16, 1, 1)+f2*s(10, 1, 1) ! [gx2z2|s] + s(21, 1, 1) = rap(1)*s(11, 1, 1) + f4*s(5, 1, 1) ! [gx4 |s] + s(22, 1, 1) = rap(1)*s(12, 1, 1) + f3*s(6, 1, 1) ! [gx3y |s] + s(23, 1, 1) = rap(1)*s(13, 1, 1) + f3*s(7, 1, 1) ! [gx3z |s] + s(24, 1, 1) = rap(1)*s(14, 1, 1) + f2*s(8, 1, 1) ! [gx2y2|s] + s(25, 1, 1) = rap(1)*s(15, 1, 1) + f2*s(9, 1, 1) ! [gx2yz|s] + s(26, 1, 1) = rap(1)*s(16, 1, 1) + f2*s(10, 1, 1) ! [gx2z2|s] s(27, 1, 1) = rap(1)*s(17, 1, 1) ! [gxy3 |s] s(28, 1, 1) = rap(1)*s(18, 1, 1) ! [gxy2z|s] s(29, 1, 1) = rap(1)*s(19, 1, 1) ! [gxyz2|s] s(30, 1, 1) = rap(1)*s(20, 1, 1) ! [gxz3 |s] - s(31, 1, 1) = rap(2)*s(17, 1, 1)+f4*s(8, 1, 1) ! [gy4 |s] - s(32, 1, 1) = rap(2)*s(18, 1, 1)+f3*s(9, 1, 1) ! [gy3z |s] - s(33, 1, 1) = rap(2)*s(19, 1, 1)+f2*s(10, 1, 1) ! [gy2z2|s] + s(31, 1, 1) = rap(2)*s(17, 1, 1) + f4*s(8, 1, 1) ! [gy4 |s] + s(32, 1, 1) = rap(2)*s(18, 1, 1) + f3*s(9, 1, 1) ! [gy3z |s] + s(33, 1, 1) = rap(2)*s(19, 1, 1) + f2*s(10, 1, 1) ! [gy2z2|s] s(34, 1, 1) = rap(2)*s(20, 1, 1) ! [gyz3 |s] - s(35, 1, 1) = rap(3)*s(20, 1, 1)+f4*s(10, 1, 1) ! [gz4 |s] + s(35, 1, 1) = rap(3)*s(20, 1, 1) + f4*s(10, 1, 1) ! [gz4 |s] ! *** [a|s] = (Pi - Ai)*[a-1i|s] + f2*Ni(a-1i)*[a-2i|s] *** @@ -241,33 +241,33 @@ SUBROUTINE overlap(la_max_set, la_min_set, npgfa, rpgfa, zeta, & ! *** Increase the angular momentum component z of a *** s(coset(0, 0, la), 1, 1) = & - rap(3)*s(coset(0, 0, la-1), 1, 1)+ & - f2*REAL(la-1, dp)*s(coset(0, 0, la-2), 1, 1) + rap(3)*s(coset(0, 0, la - 1), 1, 1) + & + f2*REAL(la - 1, dp)*s(coset(0, 0, la - 2), 1, 1) ! *** Increase the angular momentum component y of a *** - az = la-1 + az = la - 1 s(coset(0, 1, az), 1, 1) = rap(2)*s(coset(0, 0, az), 1, 1) DO ay = 2, la - az = la-ay + az = la - ay s(coset(0, ay, az), 1, 1) = & - rap(2)*s(coset(0, ay-1, az), 1, 1)+ & - f2*REAL(ay-1, dp)*s(coset(0, ay-2, az), 1, 1) + rap(2)*s(coset(0, ay - 1, az), 1, 1) + & + f2*REAL(ay - 1, dp)*s(coset(0, ay - 2, az), 1, 1) END DO ! *** Increase the angular momentum component x of a *** - DO ay = 0, la-1 - az = la-1-ay + DO ay = 0, la - 1 + az = la - 1 - ay s(coset(1, ay, az), 1, 1) = rap(1)*s(coset(0, ay, az), 1, 1) END DO DO ax = 2, la - f3 = f2*REAL(ax-1, dp) - DO ay = 0, la-ax - az = la-ax-ay + f3 = f2*REAL(ax - 1, dp) + DO ay = 0, la - ax + az = la - ax - ay s(coset(ax, ay, az), 1, 1) = & - rap(1)*s(coset(ax-1, ay, az), 1, 1)+ & - f3*s(coset(ax-2, ay, az), 1, 1) + rap(1)*s(coset(ax - 1, ay, az), 1, 1) + & + f3*s(coset(ax - 2, ay, az), 1, 1) END DO END DO @@ -291,27 +291,27 @@ SUBROUTINE overlap(la_max_set, la_min_set, npgfa, rpgfa, zeta, & ! *** Horizontal recurrence steps *** - rbp(:) = rap(:)-rab(:) + rbp(:) = rap(:) - rab(:) ! *** [a|p] = [a+1i|s] - (Bi - Ai)*[a|s] *** IF (lb_max == 1) THEN la_start = la_min ELSE - la_start = MAX(0, la_min-1) + la_start = MAX(0, la_min - 1) END IF - DO la = la_start, la_max-1 + DO la = la_start, la_max - 1 DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay coa = coset(ax, ay, az) - coapx = coset(ax+1, ay, az) - coapy = coset(ax, ay+1, az) - coapz = coset(ax, ay, az+1) - s(coa, 2, 1) = s(coapx, 1, 1)-rab(1)*s(coa, 1, 1) - s(coa, 3, 1) = s(coapy, 1, 1)-rab(2)*s(coa, 1, 1) - s(coa, 4, 1) = s(coapz, 1, 1)-rab(3)*s(coa, 1, 1) + coapx = coset(ax + 1, ay, az) + coapy = coset(ax, ay + 1, az) + coapz = coset(ax, ay, az + 1) + s(coa, 2, 1) = s(coapx, 1, 1) - rab(1)*s(coa, 1, 1) + s(coa, 3, 1) = s(coapy, 1, 1) - rab(2)*s(coa, 1, 1) + s(coa, 4, 1) = s(coapz, 1, 1) - rab(3)*s(coa, 1, 1) END DO END DO END DO @@ -322,17 +322,17 @@ SUBROUTINE overlap(la_max_set, la_min_set, npgfa, rpgfa, zeta, & DO ax = 0, la_max fax = f2*REAL(ax, dp) - DO ay = 0, la_max-ax + DO ay = 0, la_max - ax fay = f2*REAL(ay, dp) - az = la_max-ax-ay + az = la_max - ax - ay faz = f2*REAL(az, dp) coa = coset(ax, ay, az) - coamx = coset(ax-1, ay, az) - coamy = coset(ax, ay-1, az) - coamz = coset(ax, ay, az-1) - s(coa, 2, 1) = rbp(1)*s(coa, 1, 1)+fax*s(coamx, 1, 1) - s(coa, 3, 1) = rbp(2)*s(coa, 1, 1)+fay*s(coamy, 1, 1) - s(coa, 4, 1) = rbp(3)*s(coa, 1, 1)+faz*s(coamz, 1, 1) + coamx = coset(ax - 1, ay, az) + coamy = coset(ax, ay - 1, az) + coamz = coset(ax, ay, az - 1) + s(coa, 2, 1) = rbp(1)*s(coa, 1, 1) + fax*s(coamx, 1, 1) + s(coa, 3, 1) = rbp(2)*s(coa, 1, 1) + fay*s(coamy, 1, 1) + s(coa, 4, 1) = rbp(3)*s(coa, 1, 1) + faz*s(coamz, 1, 1) END DO END DO @@ -347,41 +347,41 @@ SUBROUTINE overlap(la_max_set, la_min_set, npgfa, rpgfa, zeta, & IF (lb == lb_max) THEN la_start = la_min ELSE - la_start = MAX(0, la_min-1) + la_start = MAX(0, la_min - 1) END IF - DO la = la_start, la_max-1 + DO la = la_start, la_max - 1 DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay coa = coset(ax, ay, az) - coapx = coset(ax+1, ay, az) - coapy = coset(ax, ay+1, az) - coapz = coset(ax, ay, az+1) + coapx = coset(ax + 1, ay, az) + coapy = coset(ax, ay + 1, az) + coapz = coset(ax, ay, az + 1) ! *** Shift of angular momentum component z from a to b *** cob = coset(0, 0, lb) - cobmz = coset(0, 0, lb-1) - s(coa, cob, 1) = s(coapz, cobmz, 1)-rab(3)*s(coa, cobmz, 1) + cobmz = coset(0, 0, lb - 1) + s(coa, cob, 1) = s(coapz, cobmz, 1) - rab(3)*s(coa, cobmz, 1) ! *** Shift of angular momentum component y from a to b *** DO by = 1, lb - bz = lb-by + bz = lb - by cob = coset(0, by, bz) - cobmy = coset(0, by-1, bz) - s(coa, cob, 1) = s(coapy, cobmy, 1)-rab(2)*s(coa, cobmy, 1) + cobmy = coset(0, by - 1, bz) + s(coa, cob, 1) = s(coapy, cobmy, 1) - rab(2)*s(coa, cobmy, 1) END DO ! *** Shift of angular momentum component x from a to b *** DO bx = 1, lb - DO by = 0, lb-bx - bz = lb-bx-by + DO by = 0, lb - bx + bz = lb - bx - by cob = coset(bx, by, bz) - cobmx = coset(bx-1, by, bz) - s(coa, cob, 1) = s(coapx, cobmx, 1)-rab(1)*s(coa, cobmx, 1) + cobmx = coset(bx - 1, by, bz) + s(coa, cob, 1) = s(coapx, cobmx, 1) - rab(1)*s(coa, cobmx, 1) END DO END DO @@ -396,61 +396,61 @@ SUBROUTINE overlap(la_max_set, la_min_set, npgfa, rpgfa, zeta, & DO ax = 0, la_max fax = f2*REAL(ax, dp) - DO ay = 0, la_max-ax + DO ay = 0, la_max - ax fay = f2*REAL(ay, dp) - az = la_max-ax-ay + az = la_max - ax - ay faz = f2*REAL(az, dp) coa = coset(ax, ay, az) - coamx = coset(ax-1, ay, az) - coamy = coset(ax, ay-1, az) - coamz = coset(ax, ay, az-1) + coamx = coset(ax - 1, ay, az) + coamy = coset(ax, ay - 1, az) + coamz = coset(ax, ay, az - 1) ! *** Increase the angular momentum component z of b *** - f3 = f2*REAL(lb-1, dp) + f3 = f2*REAL(lb - 1, dp) cob = coset(0, 0, lb) - cobmz = coset(0, 0, lb-1) - cobm2z = coset(0, 0, lb-2) - s(coa, cob, 1) = rbp(3)*s(coa, cobmz, 1)+ & - faz*s(coamz, cobmz, 1)+ & + cobmz = coset(0, 0, lb - 1) + cobm2z = coset(0, 0, lb - 2) + s(coa, cob, 1) = rbp(3)*s(coa, cobmz, 1) + & + faz*s(coamz, cobmz, 1) + & f3*s(coa, cobm2z, 1) ! *** Increase the angular momentum component y of b *** - bz = lb-1 + bz = lb - 1 cob = coset(0, 1, bz) cobmy = coset(0, 0, bz) - s(coa, cob, 1) = rbp(2)*s(coa, cobmy, 1)+ & + s(coa, cob, 1) = rbp(2)*s(coa, cobmy, 1) + & fay*s(coamy, cobmy, 1) DO by = 2, lb - bz = lb-by - f3 = f2*REAL(by-1, dp) + bz = lb - by + f3 = f2*REAL(by - 1, dp) cob = coset(0, by, bz) - cobmy = coset(0, by-1, bz) - cobm2y = coset(0, by-2, bz) - s(coa, cob, 1) = rbp(2)*s(coa, cobmy, 1)+ & - fay*s(coamy, cobmy, 1)+ & + cobmy = coset(0, by - 1, bz) + cobm2y = coset(0, by - 2, bz) + s(coa, cob, 1) = rbp(2)*s(coa, cobmy, 1) + & + fay*s(coamy, cobmy, 1) + & f3*s(coa, cobm2y, 1) END DO ! *** Increase the angular momentum component x of b *** - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by cob = coset(1, by, bz) cobmx = coset(0, by, bz) - s(coa, cob, 1) = rbp(1)*s(coa, cobmx, 1)+ & + s(coa, cob, 1) = rbp(1)*s(coa, cobmx, 1) + & fax*s(coamx, cobmx, 1) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by cob = coset(bx, by, bz) - cobmx = coset(bx-1, by, bz) - cobm2x = coset(bx-2, by, bz) - s(coa, cob, 1) = rbp(1)*s(coa, cobmx, 1)+ & - fax*s(coamx, cobmx, 1)+ & + cobmx = coset(bx - 1, by, bz) + cobm2x = coset(bx - 2, by, bz) + s(coa, cob, 1) = rbp(1)*s(coa, cobmx, 1) + & + fax*s(coamx, cobmx, 1) + & f3*s(coa, cobm2x, 1) END DO END DO @@ -468,7 +468,7 @@ SUBROUTINE overlap(la_max_set, la_min_set, npgfa, rpgfa, zeta, & ! *** Vertical recurrence steps: [s|s] -> [s|b] *** - rbp(:) = (f1-1.0_dp)*rab(:) + rbp(:) = (f1 - 1.0_dp)*rab(:) ! *** [s|p] = (Pi - Bi)*[s|s] *** @@ -482,12 +482,12 @@ SUBROUTINE overlap(la_max_set, la_min_set, npgfa, rpgfa, zeta, & f3 = f2*s(1, 1, 1) - s(1, 5, 1) = rbp(1)*s(1, 2, 1)+f3 ! [s|dx2] + s(1, 5, 1) = rbp(1)*s(1, 2, 1) + f3 ! [s|dx2] s(1, 6, 1) = rbp(1)*s(1, 3, 1) ! [s|dxy] s(1, 7, 1) = rbp(1)*s(1, 4, 1) ! [s|dxz] - s(1, 8, 1) = rbp(2)*s(1, 3, 1)+f3 ! [s|dy2] + s(1, 8, 1) = rbp(2)*s(1, 3, 1) + f3 ! [s|dy2] s(1, 9, 1) = rbp(2)*s(1, 4, 1) ! [s|dyz] - s(1, 10, 1) = rbp(3)*s(1, 4, 1)+f3 ! [s|dz2] + s(1, 10, 1) = rbp(3)*s(1, 4, 1) + f3 ! [s|dz2] ! *** [s|b] = (Pi - Bi)*[s|b-1i] + f2*Ni(b-1i)*[s|b-2i] *** @@ -496,33 +496,33 @@ SUBROUTINE overlap(la_max_set, la_min_set, npgfa, rpgfa, zeta, & ! *** Increase the angular momentum component z of b *** s(1, coset(0, 0, lb), 1) = & - rbp(3)*s(1, coset(0, 0, lb-1), 1)+ & - f2*REAL(lb-1, dp)*s(1, coset(0, 0, lb-2), 1) + rbp(3)*s(1, coset(0, 0, lb - 1), 1) + & + f2*REAL(lb - 1, dp)*s(1, coset(0, 0, lb - 2), 1) ! *** Increase the angular momentum component y of b *** - bz = lb-1 + bz = lb - 1 s(1, coset(0, 1, bz), 1) = rbp(2)*s(1, coset(0, 0, bz), 1) DO by = 2, lb - bz = lb-by + bz = lb - by s(1, coset(0, by, bz), 1) = & - rbp(2)*s(1, coset(0, by-1, bz), 1)+ & - f2*REAL(by-1, dp)*s(1, coset(0, by-2, bz), 1) + rbp(2)*s(1, coset(0, by - 1, bz), 1) + & + f2*REAL(by - 1, dp)*s(1, coset(0, by - 2, bz), 1) END DO ! *** Increase the angular momentum component x of b *** - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by s(1, coset(1, by, bz), 1) = rbp(1)*s(1, coset(0, by, bz), 1) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by s(1, coset(bx, by, bz), 1) = & - rbp(1)*s(1, coset(bx-1, by, bz), 1)+ & - f3*s(1, coset(bx-2, by, bz), 1) + rbp(1)*s(1, coset(bx - 1, by, bz), 1) + & + f3*s(1, coset(bx - 2, by, bz), 1) END DO END DO @@ -538,7 +538,7 @@ SUBROUTINE overlap(la_max_set, la_min_set, npgfa, rpgfa, zeta, & DO j = 1, ncoset(lb_max_set) DO i = 1, ncoset(la_max_set) - sab(na+i, nb+j) = s(i, j, 1) + sab(na + i, nb + j) = s(i, j, 1) END DO END DO @@ -553,42 +553,42 @@ SUBROUTINE overlap(la_max_set, la_min_set, npgfa, rpgfa, zeta, & lb_start = lb_min_set END IF - DO da = 0, da_max-1 + DO da = 0, da_max - 1 ftz = 2.0_dp*zeta(ipgf) DO dax = 0, da - DO day = 0, da-dax - daz = da-dax-day + DO day = 0, da - dax + daz = da - dax - day cda = coset(dax, day, daz) - cdax = coset(dax+1, day, daz) - cday = coset(dax, day+1, daz) - cdaz = coset(dax, day, daz+1) + cdax = coset(dax + 1, day, daz) + cday = coset(dax, day + 1, daz) + cdaz = coset(dax, day, daz + 1) ! *** [da/dAi|b] = 2*zeta*[a+1i|b] - Ni(a)[a-1i|b] *** - DO la = la_start, la_max-da-1 + DO la = la_start, la_max - da - 1 DO ax = 0, la fax = REAL(ax, dp) - DO ay = 0, la-ax + DO ay = 0, la - ax fay = REAL(ay, dp) - az = la-ax-ay + az = la - ax - ay faz = REAL(az, dp) coa = coset(ax, ay, az) - coamx = coset(ax-1, ay, az) - coamy = coset(ax, ay-1, az) - coamz = coset(ax, ay, az-1) - coapx = coset(ax+1, ay, az) - coapy = coset(ax, ay+1, az) - coapz = coset(ax, ay, az+1) + coamx = coset(ax - 1, ay, az) + coamy = coset(ax, ay - 1, az) + coamz = coset(ax, ay, az - 1) + coapx = coset(ax + 1, ay, az) + coapy = coset(ax, ay + 1, az) + coapz = coset(ax, ay, az + 1) DO lb = lb_start, lb_max_set DO bx = 0, lb - DO by = 0, lb-bx - bz = lb-bx-by + DO by = 0, lb - bx + bz = lb - bx - by cob = coset(bx, by, bz) - s(coa, cob, cdax) = ftz*s(coapx, cob, cda)- & + s(coa, cob, cdax) = ftz*s(coapx, cob, cda) - & fax*s(coamx, cob, cda) - s(coa, cob, cday) = ftz*s(coapy, cob, cda)- & + s(coa, cob, cday) = ftz*s(coapy, cob, cda) - & fay*s(coamy, cob, cda) - s(coa, cob, cdaz) = ftz*s(coapz, cob, cda)- & + s(coa, cob, cdaz) = ftz*s(coapz, cob, cda) - & faz*s(coamz, cob, cda) END DO END DO @@ -606,11 +606,11 @@ SUBROUTINE overlap(la_max_set, la_min_set, npgfa, rpgfa, zeta, & IF (return_derivatives) THEN DO k = 2, ncoset(da_max_set) - jstart = (k-1)*SIZE(sab, 1) + jstart = (k - 1)*SIZE(sab, 1) DO j = 1, ncoset(lb_max_set) - jk = jstart+j + jk = jstart + j DO i = 1, ncoset(la_max_set) - sab(na+i, nb+jk) = s(i, j, k) + sab(na + i, nb + jk) = s(i, j, k) END DO END DO END DO @@ -620,9 +620,9 @@ SUBROUTINE overlap(la_max_set, la_min_set, npgfa, rpgfa, zeta, & IF (calculate_force_a) THEN DO k = 1, 3 - DO j = ncoset(lb_min_set-1)+1, ncoset(lb_max_set) - DO i = ncoset(la_min_set-1)+1, ncoset(la_max_set) - force_a(k) = force_a(k)+pab(na+i, nb+j)*s(i, j, k+1) + DO j = ncoset(lb_min_set - 1) + 1, ncoset(lb_max_set) + DO i = ncoset(la_min_set - 1) + 1, ncoset(la_max_set) + force_a(k) = force_a(k) + pab(na + i, nb + j)*s(i, j, k + 1) END DO END DO END DO @@ -633,22 +633,22 @@ SUBROUTINE overlap(la_max_set, la_min_set, npgfa, rpgfa, zeta, & ! *** the kinetic energy integrals if requested *** IF (PRESENT(sdab)) THEN - sdab(nda+1, nb+1, 1) = s(1, 1, 1) + sdab(nda + 1, nb + 1, 1) = s(1, 1, 1) DO k = 2, 4 DO j = 1, ncoset(lb_max_set) - DO i = 1, ncoset(la_max-1) - sdab(nda+i, nb+j, k) = s(i, j, k) + DO i = 1, ncoset(la_max - 1) + sdab(nda + i, nb + j, k) = s(i, j, k) END DO END DO END DO END IF - nb = nb+ncoset(lb_max_set) + nb = nb + ncoset(lb_max_set) END DO - na = na+ncoset(la_max_set) - nda = nda+ncoset(la_max-1) + na = na + ncoset(la_max_set) + nda = nda + ncoset(la_max - 1) END DO @@ -699,7 +699,7 @@ SUBROUTINE overlap_ab(la_max, la_min, npgfa, rpgfa, zeta, & ! Distance of the centers a and b - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) tab = SQRT(rab2) ! Maximum l for auxiliary integrals @@ -708,23 +708,23 @@ SUBROUTINE overlap_ab(la_max, la_min, npgfa, rpgfa, zeta, & lmb = lb_max END IF IF (PRESENT(dab)) THEN - lma = la_max+1 + lma = la_max + 1 lmb = lb_max END IF IF (PRESENT(ddab)) THEN - lma = la_max+1 - lmb = lb_max+1 + lma = la_max + 1 + lmb = lb_max + 1 END IF - ldrr = MAX(lma, lmb)+1 + ldrr = MAX(lma, lmb) + 1 ! Allocate space for auxiliary integrals - ALLOCATE (rr(0:ldrr-1, 0:ldrr-1, 3)) + ALLOCATE (rr(0:ldrr - 1, 0:ldrr - 1, 3)) ! Number of integrals, check size of arrays - ofa = ncoset(la_min-1) - ofb = ncoset(lb_min-1) - na = ncoset(la_max)-ofa - nb = ncoset(lb_max)-ofb + ofa = ncoset(la_min - 1) + ofb = ncoset(lb_min - 1) + na = ncoset(la_max) - ofa + nb = ncoset(lb_max) - ofb IF (PRESENT(sab)) THEN CPASSERT((SIZE(sab, 1) >= na*npgfa)) CPASSERT((SIZE(sab, 2) >= nb*npgfb)) @@ -746,18 +746,18 @@ SUBROUTINE overlap_ab(la_max, la_min, npgfa, rpgfa, zeta, & mb = 0 DO jpgf = 1, npgfb ! Distance Screening - IF (rpgfa(ipgf)+rpgfb(jpgf) < tab) THEN - IF (PRESENT(sab)) sab(ma+1:ma+na, mb+1:mb+nb) = 0.0_dp - IF (PRESENT(dab)) dab(ma+1:ma+na, mb+1:mb+nb, 1:3) = 0.0_dp - IF (PRESENT(ddab)) ddab(ma+1:ma+na, mb+1:mb+nb, 1:6) = 0.0_dp - mb = mb+nb + IF (rpgfa(ipgf) + rpgfb(jpgf) < tab) THEN + IF (PRESENT(sab)) sab(ma + 1:ma + na, mb + 1:mb + nb) = 0.0_dp + IF (PRESENT(dab)) dab(ma + 1:ma + na, mb + 1:mb + nb, 1:3) = 0.0_dp + IF (PRESENT(ddab)) ddab(ma + 1:ma + na, mb + 1:mb + nb, 1:6) = 0.0_dp + mb = mb + nb CYCLE ENDIF ! Calculate some prefactors a = zeta(ipgf) b = zetb(jpgf) - zet = a+b + zet = a + b xhi = a*b/zet rap = b*rab/zet rbp = -a*rab/zet @@ -770,16 +770,16 @@ SUBROUTINE overlap_ab(la_max, la_min, npgfa, rpgfa, zeta, & DO lb = lb_min, lb_max DO bx = 0, lb - DO by = 0, lb-bx - bz = lb-bx-by - cob = coset(bx, by, bz)-ofb - ib = mb+cob + DO by = 0, lb - bx + bz = lb - bx - by + cob = coset(bx, by, bz) - ofb + ib = mb + cob DO la = la_min, la_max DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay - coa = coset(ax, ay, az)-ofa - ia = ma+coa + DO ay = 0, la - ax + az = la - ax - ay + coa = coset(ax, ay, az) - ofa + ia = ma + coa ! integrals IF (PRESENT(sab)) THEN sab(ia, ib) = f0*rr(ax, bx, 1)*rr(ay, by, 2)*rr(az, bz, 3) @@ -788,16 +788,16 @@ SUBROUTINE overlap_ab(la_max, la_min, npgfa, rpgfa, zeta, & IF (PRESENT(dab)) THEN ! (da|b) = 2*a*(a+1|b) - N(a)*(a-1|b) ! dx - dumx = 2.0_dp*a*rr(ax+1, bx, 1) - IF (ax > 0) dumx = dumx-REAL(ax, dp)*rr(ax-1, bx, 1) + dumx = 2.0_dp*a*rr(ax + 1, bx, 1) + IF (ax > 0) dumx = dumx - REAL(ax, dp)*rr(ax - 1, bx, 1) dab(ia, ib, 1) = f0*dumx*rr(ay, by, 2)*rr(az, bz, 3) ! dy - dumy = 2.0_dp*a*rr(ay+1, by, 2) - IF (ay > 0) dumy = dumy-REAL(ay, dp)*rr(ay-1, by, 2) + dumy = 2.0_dp*a*rr(ay + 1, by, 2) + IF (ay > 0) dumy = dumy - REAL(ay, dp)*rr(ay - 1, by, 2) dab(ia, ib, 2) = f0*rr(ax, bx, 1)*dumy*rr(az, bz, 3) ! dz - dumz = 2.0_dp*a*rr(az+1, bz, 3) - IF (az > 0) dumz = dumz-REAL(az, dp)*rr(az-1, bz, 3) + dumz = 2.0_dp*a*rr(az + 1, bz, 3) + IF (az > 0) dumz = dumz - REAL(az, dp)*rr(az - 1, bz, 3) dab(ia, ib, 3) = f0*rr(ax, bx, 1)*rr(ay, by, 2)*dumz END IF ! 2nd derivatives @@ -805,119 +805,119 @@ SUBROUTINE overlap_ab(la_max, la_min, npgfa, rpgfa, zeta, & ! (dda|b) = -4*a*b*(a+1|b+1) + 2*a*N(b)*(a+1|b-1) ! + 2*b*N(a)*(a-1|b+1) - N(a)*N(b)*(a-1|b-1) ! dx dx - apbp = f0*rr(ax+1, bx+1, 1)*rr(ay, by, 2)*rr(az, bz, 3) + apbp = f0*rr(ax + 1, bx + 1, 1)*rr(ay, by, 2)*rr(az, bz, 3) IF (bx > 0) THEN - apbm = f0*rr(ax+1, bx-1, 1)*rr(ay, by, 2)*rr(az, bz, 3) + apbm = f0*rr(ax + 1, bx - 1, 1)*rr(ay, by, 2)*rr(az, bz, 3) ELSE apbm = 0.0_dp END IF IF (ax > 0) THEN - ambp = f0*rr(ax-1, bx+1, 1)*rr(ay, by, 2)*rr(az, bz, 3) + ambp = f0*rr(ax - 1, bx + 1, 1)*rr(ay, by, 2)*rr(az, bz, 3) ELSE ambp = 0.0_dp END IF IF (ax > 0 .AND. bx > 0) THEN - ambm = f0*rr(ax-1, bx-1, 1)*rr(ay, by, 2)*rr(az, bz, 3) + ambm = f0*rr(ax - 1, bx - 1, 1)*rr(ay, by, 2)*rr(az, bz, 3) ELSE ambm = 0.0_dp END IF - ddab(ia, ib, 1) = -4.0_dp*a*b*apbm+2.0_dp*a*REAL(bx, dp)*apbm & - +2.0_dp*b*REAL(ax, dp)*ambp-REAL(ax, dp)*REAL(bx, dp)*ambm + ddab(ia, ib, 1) = -4.0_dp*a*b*apbm + 2.0_dp*a*REAL(bx, dp)*apbm & + + 2.0_dp*b*REAL(ax, dp)*ambp - REAL(ax, dp)*REAL(bx, dp)*ambm ! dx dy - apbp = f0*rr(ax+1, bx, 1)*rr(ay, by+1, 2)*rr(az, bz, 3) + apbp = f0*rr(ax + 1, bx, 1)*rr(ay, by + 1, 2)*rr(az, bz, 3) IF (by > 0) THEN - apbm = f0*rr(ax+1, bx, 1)*rr(ay, by-1, 2)*rr(az, bz, 3) + apbm = f0*rr(ax + 1, bx, 1)*rr(ay, by - 1, 2)*rr(az, bz, 3) ELSE apbm = 0.0_dp END IF IF (ax > 0) THEN - ambp = f0*rr(ax-1, bx, 1)*rr(ay, by+1, 2)*rr(az, bz, 3) + ambp = f0*rr(ax - 1, bx, 1)*rr(ay, by + 1, 2)*rr(az, bz, 3) ELSE ambp = 0.0_dp END IF IF (ax > 0 .AND. by > 0) THEN - ambm = f0*rr(ax-1, bx, 1)*rr(ay, by-1, 2)*rr(az, bz, 3) + ambm = f0*rr(ax - 1, bx, 1)*rr(ay, by - 1, 2)*rr(az, bz, 3) ELSE ambm = 0.0_dp END IF - ddab(ia, ib, 2) = -4.0_dp*a*b*apbm+2.0_dp*a*REAL(by, dp)*apbm & - +2.0_dp*b*REAL(ax, dp)*ambp-REAL(ax, dp)*REAL(by, dp)*ambm + ddab(ia, ib, 2) = -4.0_dp*a*b*apbm + 2.0_dp*a*REAL(by, dp)*apbm & + + 2.0_dp*b*REAL(ax, dp)*ambp - REAL(ax, dp)*REAL(by, dp)*ambm ! dx dz - apbp = f0*rr(ax+1, bx, 1)*rr(ay, by, 2)*rr(az, bz+1, 3) + apbp = f0*rr(ax + 1, bx, 1)*rr(ay, by, 2)*rr(az, bz + 1, 3) IF (bz > 0) THEN - apbm = f0*rr(ax+1, bx, 1)*rr(ay, by, 2)*rr(az, bz-1, 3) + apbm = f0*rr(ax + 1, bx, 1)*rr(ay, by, 2)*rr(az, bz - 1, 3) ELSE apbm = 0.0_dp END IF IF (ax > 0) THEN - ambp = f0*rr(ax-1, bx, 1)*rr(ay, by, 2)*rr(az, bz+1, 3) + ambp = f0*rr(ax - 1, bx, 1)*rr(ay, by, 2)*rr(az, bz + 1, 3) ELSE ambp = 0.0_dp END IF IF (ax > 0 .AND. bz > 0) THEN - ambm = f0*rr(ax-1, bx, 1)*rr(ay, by, 2)*rr(az, bz-1, 3) + ambm = f0*rr(ax - 1, bx, 1)*rr(ay, by, 2)*rr(az, bz - 1, 3) ELSE ambm = 0.0_dp END IF - ddab(ia, ib, 3) = -4.0_dp*a*b*apbm+2.0_dp*a*REAL(bz, dp)*apbm & - +2.0_dp*b*REAL(ax, dp)*ambp-REAL(ax, dp)*REAL(bz, dp)*ambm + ddab(ia, ib, 3) = -4.0_dp*a*b*apbm + 2.0_dp*a*REAL(bz, dp)*apbm & + + 2.0_dp*b*REAL(ax, dp)*ambp - REAL(ax, dp)*REAL(bz, dp)*ambm ! dy dy - apbp = f0*rr(ax, bx, 1)*rr(ay+1, by+1, 2)*rr(az, bz, 3) + apbp = f0*rr(ax, bx, 1)*rr(ay + 1, by + 1, 2)*rr(az, bz, 3) IF (by > 0) THEN - apbm = f0*rr(ax, bx, 1)*rr(ay+1, by-1, 2)*rr(az, bz, 3) + apbm = f0*rr(ax, bx, 1)*rr(ay + 1, by - 1, 2)*rr(az, bz, 3) ELSE apbm = 0.0_dp END IF IF (ay > 0) THEN - ambp = f0*rr(ax, bx, 1)*rr(ay-1, by+1, 2)*rr(az, bz, 3) + ambp = f0*rr(ax, bx, 1)*rr(ay - 1, by + 1, 2)*rr(az, bz, 3) ELSE ambp = 0.0_dp END IF IF (ay > 0 .AND. by > 0) THEN - ambm = f0*rr(ax, bx, 1)*rr(ay-1, by-1, 2)*rr(az, bz, 3) + ambm = f0*rr(ax, bx, 1)*rr(ay - 1, by - 1, 2)*rr(az, bz, 3) ELSE ambm = 0.0_dp END IF - ddab(ia, ib, 4) = -4.0_dp*a*b*apbm+2.0_dp*a*REAL(by, dp)*apbm & - +2.0_dp*b*REAL(ay, dp)*ambp-REAL(ay, dp)*REAL(by, dp)*ambm + ddab(ia, ib, 4) = -4.0_dp*a*b*apbm + 2.0_dp*a*REAL(by, dp)*apbm & + + 2.0_dp*b*REAL(ay, dp)*ambp - REAL(ay, dp)*REAL(by, dp)*ambm ! dy dz - apbp = f0*rr(ax, bx, 1)*rr(ay+1, by, 2)*rr(az, bz+1, 3) + apbp = f0*rr(ax, bx, 1)*rr(ay + 1, by, 2)*rr(az, bz + 1, 3) IF (bz > 0) THEN - apbm = f0*rr(ax, bx, 1)*rr(ay+1, by, 2)*rr(az, bz-1, 3) + apbm = f0*rr(ax, bx, 1)*rr(ay + 1, by, 2)*rr(az, bz - 1, 3) ELSE apbm = 0.0_dp END IF IF (ay > 0) THEN - ambp = f0*rr(ax, bx, 1)*rr(ay-1, by, 2)*rr(az, bz+1, 3) + ambp = f0*rr(ax, bx, 1)*rr(ay - 1, by, 2)*rr(az, bz + 1, 3) ELSE ambp = 0.0_dp END IF IF (ay > 0 .AND. bz > 0) THEN - ambm = f0*rr(ax, bx, 1)*rr(ay-1, by, 2)*rr(az, bz-1, 3) + ambm = f0*rr(ax, bx, 1)*rr(ay - 1, by, 2)*rr(az, bz - 1, 3) ELSE ambm = 0.0_dp END IF - ddab(ia, ib, 5) = -4.0_dp*a*b*apbm+2.0_dp*a*REAL(bz, dp)*apbm & - +2.0_dp*b*REAL(ay, dp)*ambp-REAL(ay, dp)*REAL(bz, dp)*ambm + ddab(ia, ib, 5) = -4.0_dp*a*b*apbm + 2.0_dp*a*REAL(bz, dp)*apbm & + + 2.0_dp*b*REAL(ay, dp)*ambp - REAL(ay, dp)*REAL(bz, dp)*ambm ! dz dz - apbp = f0*rr(ax, bx, 1)*rr(ay, by, 2)*rr(az+1, bz+1, 3) + apbp = f0*rr(ax, bx, 1)*rr(ay, by, 2)*rr(az + 1, bz + 1, 3) IF (bz > 0) THEN - apbm = f0*rr(ax, bx, 1)*rr(ay, by, 2)*rr(az+1, bz-1, 3) + apbm = f0*rr(ax, bx, 1)*rr(ay, by, 2)*rr(az + 1, bz - 1, 3) ELSE apbm = 0.0_dp END IF IF (az > 0) THEN - ambp = f0*rr(ax, bx, 1)*rr(ay, by, 2)*rr(az-1, bz+1, 3) + ambp = f0*rr(ax, bx, 1)*rr(ay, by, 2)*rr(az - 1, bz + 1, 3) ELSE ambp = 0.0_dp END IF IF (az > 0 .AND. bz > 0) THEN - ambm = f0*rr(ax, bx, 1)*rr(ay, by, 2)*rr(az-1, bz-1, 3) + ambm = f0*rr(ax, bx, 1)*rr(ay, by, 2)*rr(az - 1, bz - 1, 3) ELSE ambm = 0.0_dp END IF - ddab(ia, ib, 6) = -4.0_dp*a*b*apbm+2.0_dp*a*REAL(bz, dp)*apbm & - +2.0_dp*b*REAL(az, dp)*ambp-REAL(az, dp)*REAL(bz, dp)*ambm + ddab(ia, ib, 6) = -4.0_dp*a*b*apbm + 2.0_dp*a*REAL(bz, dp)*apbm & + + 2.0_dp*b*REAL(az, dp)*ambp - REAL(az, dp)*REAL(bz, dp)*ambm END IF ! ENDDO @@ -927,9 +927,9 @@ SUBROUTINE overlap_ab(la_max, la_min, npgfa, rpgfa, zeta, & ENDDO ENDDO !lb - mb = mb+nb + mb = mb + nb END DO - ma = ma+na + ma = ma + na END DO DEALLOCATE (rr) @@ -994,30 +994,30 @@ SUBROUTINE overlap_aab(la1_max, la1_min, npgfa1, rpgfa1, zeta1, & ! Distance of the centers a and b - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) tab = SQRT(rab2) ! Maximum l for auxiliary integrals IF (PRESENT(saab) .OR. PRESENT(saba)) THEN - lma = la1_max+la2_max + lma = la1_max + la2_max lmb = lb_max END IF IF (PRESENT(daab) .OR. PRESENT(daba)) THEN - lma = la1_max+la2_max+1 + lma = la1_max + la2_max + 1 lmb = lb_max END IF - ldrr = MAX(lma, lmb)+1 + ldrr = MAX(lma, lmb) + 1 ! Allocate space for auxiliary integrals - ALLOCATE (rr(0:ldrr-1, 0:ldrr-1, 3)) + ALLOCATE (rr(0:ldrr - 1, 0:ldrr - 1, 3)) ! Number of integrals, check size of arrays - ofa1 = ncoset(la1_min-1) - ofa2 = ncoset(la2_min-1) - ofb = ncoset(lb_min-1) - na1 = ncoset(la1_max)-ofa1 - na2 = ncoset(la2_max)-ofa2 - nb = ncoset(lb_max)-ofb + ofa1 = ncoset(la1_min - 1) + ofa2 = ncoset(la2_min - 1) + ofb = ncoset(lb_min - 1) + na1 = ncoset(la1_max) - ofa1 + na2 = ncoset(la2_max) - ofa2 + nb = ncoset(lb_max) - ofb IF (PRESENT(saab)) THEN CPASSERT((SIZE(saab, 1) >= na1*npgfa1)) CPASSERT((SIZE(saab, 2) >= na2*npgfa2)) @@ -1050,19 +1050,19 @@ SUBROUTINE overlap_aab(la1_max, la1_min, npgfa1, rpgfa1, zeta1, & mb = 0 DO jpgf = 1, npgfb ! Distance Screening - IF (rpgfa+rpgfb(jpgf) < tab) THEN - IF (PRESENT(saab)) saab(ma1+1:ma1+na1, ma2+1:ma2+na2, mb+1:mb+nb) = 0.0_dp - IF (PRESENT(daab)) daab(ma1+1:ma1+na1, ma2+1:ma2+na2, mb+1:mb+nb, 1:3) = 0.0_dp - IF (PRESENT(saba)) saba(ma1+1:ma1+na1, mb+1:mb+nb, ma2+1:ma2+na2) = 0.0_dp - IF (PRESENT(daba)) daba(ma1+1:ma1+na1, mb+1:mb+nb, ma2+1:ma2+na2, 1:3) = 0.0_dp - mb = mb+nb + IF (rpgfa + rpgfb(jpgf) < tab) THEN + IF (PRESENT(saab)) saab(ma1 + 1:ma1 + na1, ma2 + 1:ma2 + na2, mb + 1:mb + nb) = 0.0_dp + IF (PRESENT(daab)) daab(ma1 + 1:ma1 + na1, ma2 + 1:ma2 + na2, mb + 1:mb + nb, 1:3) = 0.0_dp + IF (PRESENT(saba)) saba(ma1 + 1:ma1 + na1, mb + 1:mb + nb, ma2 + 1:ma2 + na2) = 0.0_dp + IF (PRESENT(daba)) daba(ma1 + 1:ma1 + na1, mb + 1:mb + nb, ma2 + 1:ma2 + na2, 1:3) = 0.0_dp + mb = mb + nb CYCLE ENDIF ! Calculate some prefactors - a = zeta1(i1pgf)+zeta2(i2pgf) + a = zeta1(i1pgf) + zeta2(i2pgf) b = zetb(jpgf) - zet = a+b + zet = a + b xhi = a*b/zet rap = b*rab/zet rbp = -a*rab/zet @@ -1075,64 +1075,64 @@ SUBROUTINE overlap_aab(la1_max, la1_min, npgfa1, rpgfa1, zeta1, & DO lb = lb_min, lb_max DO bx = 0, lb - DO by = 0, lb-bx - bz = lb-bx-by - cob = coset(bx, by, bz)-ofb - ib = mb+cob + DO by = 0, lb - bx + bz = lb - bx - by + cob = coset(bx, by, bz) - ofb + ib = mb + cob DO la2 = la2_min, la2_max DO ax2 = 0, la2 - DO ay2 = 0, la2-ax2 - az2 = la2-ax2-ay2 - coa2 = coset(ax2, ay2, az2)-ofa2 - ia2 = ma2+coa2 + DO ay2 = 0, la2 - ax2 + az2 = la2 - ax2 - ay2 + coa2 = coset(ax2, ay2, az2) - ofa2 + ia2 = ma2 + coa2 DO la1 = la1_min, la1_max DO ax1 = 0, la1 - DO ay1 = 0, la1-ax1 - az1 = la1-ax1-ay1 - coa1 = coset(ax1, ay1, az1)-ofa1 - ia1 = ma1+coa1 + DO ay1 = 0, la1 - ax1 + az1 = la1 - ax1 - ay1 + coa1 = coset(ax1, ay1, az1) - ofa1 + ia1 = ma1 + coa1 ! integrals IF (PRESENT(saab)) THEN - saab(ia1, ia2, ib) = f0*rr(ax1+ax2, bx, 1)*rr(ay1+ay2, by, 2)*rr(az1+az2, bz, 3) + saab(ia1, ia2, ib) = f0*rr(ax1 + ax2, bx, 1)*rr(ay1 + ay2, by, 2)*rr(az1 + az2, bz, 3) END IF IF (PRESENT(saba)) THEN - saba(ia1, ib, ia2) = f0*rr(ax1+ax2, bx, 1)*rr(ay1+ay2, by, 2)*rr(az1+az2, bz, 3) + saba(ia1, ib, ia2) = f0*rr(ax1 + ax2, bx, 1)*rr(ay1 + ay2, by, 2)*rr(az1 + az2, bz, 3) END IF ! first derivatives IF (PRESENT(daab)) THEN - ax = ax1+ax2 - ay = ay1+ay2 - az = az1+az2 + ax = ax1 + ax2 + ay = ay1 + ay2 + az = az1 + az2 ! (da|b) = 2*a*(a+1|b) - N(a)*(a-1|b) ! dx - dumx = 2.0_dp*a*rr(ax+1, bx, 1) - IF (ax > 0) dumx = dumx-REAL(ax, dp)*rr(ax-1, bx, 1) + dumx = 2.0_dp*a*rr(ax + 1, bx, 1) + IF (ax > 0) dumx = dumx - REAL(ax, dp)*rr(ax - 1, bx, 1) daab(ia1, ia2, ib, 1) = f0*dumx*rr(ay, by, 2)*rr(az, bz, 3) ! dy - dumy = 2.0_dp*a*rr(ay+1, by, 2) - IF (ay > 0) dumy = dumy-REAL(ay, dp)*rr(ay-1, by, 2) + dumy = 2.0_dp*a*rr(ay + 1, by, 2) + IF (ay > 0) dumy = dumy - REAL(ay, dp)*rr(ay - 1, by, 2) daab(ia1, ia2, ib, 2) = f0*rr(ax, bx, 1)*dumy*rr(az, bz, 3) ! dz - dumz = 2.0_dp*a*rr(az+1, bz, 3) - IF (az > 0) dumz = dumz-REAL(az, dp)*rr(az-1, bz, 3) + dumz = 2.0_dp*a*rr(az + 1, bz, 3) + IF (az > 0) dumz = dumz - REAL(az, dp)*rr(az - 1, bz, 3) daab(ia1, ia2, ib, 3) = f0*rr(ax, bx, 1)*rr(ay, by, 2)*dumz END IF IF (PRESENT(daba)) THEN - ax = ax1+ax2 - ay = ay1+ay2 - az = az1+az2 + ax = ax1 + ax2 + ay = ay1 + ay2 + az = az1 + az2 ! (da|b) = 2*a*(a+1|b) - N(a)*(a-1|b) ! dx - dumx = 2.0_dp*a*rr(ax+1, bx, 1) - IF (ax > 0) dumx = dumx-REAL(ax, dp)*rr(ax-1, bx, 1) + dumx = 2.0_dp*a*rr(ax + 1, bx, 1) + IF (ax > 0) dumx = dumx - REAL(ax, dp)*rr(ax - 1, bx, 1) daba(ia1, ib, ia2, 1) = f0*dumx*rr(ay, by, 2)*rr(az, bz, 3) ! dy - dumy = 2.0_dp*a*rr(ay+1, by, 2) - IF (ay > 0) dumy = dumy-REAL(ay, dp)*rr(ay-1, by, 2) + dumy = 2.0_dp*a*rr(ay + 1, by, 2) + IF (ay > 0) dumy = dumy - REAL(ay, dp)*rr(ay - 1, by, 2) daba(ia1, ib, ia2, 2) = f0*rr(ax, bx, 1)*dumy*rr(az, bz, 3) ! dz - dumz = 2.0_dp*a*rr(az+1, bz, 3) - IF (az > 0) dumz = dumz-REAL(az, dp)*rr(az-1, bz, 3) + dumz = 2.0_dp*a*rr(az + 1, bz, 3) + IF (az > 0) dumz = dumz - REAL(az, dp)*rr(az - 1, bz, 3) daba(ia1, ib, ia2, 3) = f0*rr(ax, bx, 1)*rr(ay, by, 2)*dumz END IF ! @@ -1146,11 +1146,11 @@ SUBROUTINE overlap_aab(la1_max, la1_min, npgfa1, rpgfa1, zeta1, & ENDDO ENDDO !lb - mb = mb+nb + mb = mb + nb END DO - ma2 = ma2+na2 + ma2 = ma2 + na2 END DO - ma1 = ma1+na1 + ma1 = ma1 + na1 END DO DEALLOCATE (rr) @@ -1209,30 +1209,30 @@ SUBROUTINE overlap_abb(la_max, la_min, npgfa, rpgfa, zeta, & ! Distance of the centers a and b - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) tab = SQRT(rab2) ! Maximum l for auxiliary integrals IF (PRESENT(sabb)) THEN lma = la_max - lmb = lb1_max+lb2_max + lmb = lb1_max + lb2_max END IF IF (PRESENT(dabb)) THEN - lma = la_max+1 - lmb = lb1_max+lb2_max + lma = la_max + 1 + lmb = lb1_max + lb2_max END IF - ldrr = MAX(lma, lmb)+1 + ldrr = MAX(lma, lmb) + 1 ! Allocate space for auxiliary integrals - ALLOCATE (rr(0:ldrr-1, 0:ldrr-1, 3)) + ALLOCATE (rr(0:ldrr - 1, 0:ldrr - 1, 3)) ! Number of integrals, check size of arrays - ofa = ncoset(la_min-1) - ofb1 = ncoset(lb1_min-1) - ofb2 = ncoset(lb2_min-1) - na = ncoset(la_max)-ofa - nb1 = ncoset(lb1_max)-ofb1 - nb2 = ncoset(lb2_max)-ofb2 + ofa = ncoset(la_min - 1) + ofb1 = ncoset(lb1_min - 1) + ofb2 = ncoset(lb2_min - 1) + na = ncoset(la_max) - ofa + nb1 = ncoset(lb1_max) - ofb1 + nb2 = ncoset(lb2_max) - ofb2 IF (PRESENT(sabb)) THEN CPASSERT((SIZE(sabb, 1) >= na*npgfa)) CPASSERT((SIZE(sabb, 2) >= nb1*npgfb1)) @@ -1254,17 +1254,17 @@ SUBROUTINE overlap_abb(la_max, la_min, npgfa, rpgfa, zeta, & DO j2pgf = 1, npgfb2 ! Distance Screening rpgfb = MIN(rpgfb1(j1pgf), rpgfb2(j2pgf)) - IF (rpgfa(ipgf)+rpgfb < tab) THEN - IF (PRESENT(sabb)) sabb(ma+1:ma+na, mb1+1:mb1+nb1, mb2+1:mb2+nb2) = 0.0_dp - IF (PRESENT(dabb)) dabb(ma+1:ma+na, mb1+1:mb1+nb1, mb2+1:mb2+nb2, 1:3) = 0.0_dp - mb2 = mb2+nb2 + IF (rpgfa(ipgf) + rpgfb < tab) THEN + IF (PRESENT(sabb)) sabb(ma + 1:ma + na, mb1 + 1:mb1 + nb1, mb2 + 1:mb2 + nb2) = 0.0_dp + IF (PRESENT(dabb)) dabb(ma + 1:ma + na, mb1 + 1:mb1 + nb1, mb2 + 1:mb2 + nb2, 1:3) = 0.0_dp + mb2 = mb2 + nb2 CYCLE ENDIF ! Calculate some prefactors a = zeta(ipgf) - b = zetb1(j1pgf)+zetb2(j2pgf) - zet = a+b + b = zetb1(j1pgf) + zetb2(j2pgf) + zet = a + b xhi = a*b/zet rap = b*rab/zet rbp = -a*rab/zet @@ -1277,43 +1277,43 @@ SUBROUTINE overlap_abb(la_max, la_min, npgfa, rpgfa, zeta, & DO lb2 = lb2_min, lb2_max DO bx2 = 0, lb2 - DO by2 = 0, lb2-bx2 - bz2 = lb2-bx2-by2 - cob2 = coset(bx2, by2, bz2)-ofb2 - ib2 = mb2+cob2 + DO by2 = 0, lb2 - bx2 + bz2 = lb2 - bx2 - by2 + cob2 = coset(bx2, by2, bz2) - ofb2 + ib2 = mb2 + cob2 DO lb1 = lb1_min, lb1_max DO bx1 = 0, lb1 - DO by1 = 0, lb1-bx1 - bz1 = lb1-bx1-by1 - cob1 = coset(bx1, by1, bz1)-ofb1 - ib1 = mb1+cob1 + DO by1 = 0, lb1 - bx1 + bz1 = lb1 - bx1 - by1 + cob1 = coset(bx1, by1, bz1) - ofb1 + ib1 = mb1 + cob1 DO la = la_min, la_max DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay - coa = coset(ax, ay, az)-ofa - ia = ma+coa + DO ay = 0, la - ax + az = la - ax - ay + coa = coset(ax, ay, az) - ofa + ia = ma + coa ! integrals IF (PRESENT(sabb)) THEN - sabb(ia, ib1, ib2) = f0*rr(ax, bx1+bx2, 1)*rr(ay, by1+by2, 2)*rr(az, bz1+bz2, 3) + sabb(ia, ib1, ib2) = f0*rr(ax, bx1 + bx2, 1)*rr(ay, by1 + by2, 2)*rr(az, bz1 + bz2, 3) END IF ! first derivatives IF (PRESENT(dabb)) THEN - bx = bx1+bx2 - by = by1+by2 - bz = bz1+bz2 + bx = bx1 + bx2 + by = by1 + by2 + bz = bz1 + bz2 ! (da|b) = 2*a*(a+1|b) - N(a)*(a-1|b) ! dx - dumx = 2.0_dp*a*rr(ax+1, bx, 1) - IF (ax > 0) dumx = dumx-REAL(ax, dp)*rr(ax-1, bx, 1) + dumx = 2.0_dp*a*rr(ax + 1, bx, 1) + IF (ax > 0) dumx = dumx - REAL(ax, dp)*rr(ax - 1, bx, 1) dabb(ia, ib1, ib2, 1) = f0*dumx*rr(ay, by, 2)*rr(az, bz, 3) ! dy - dumy = 2.0_dp*a*rr(ay+1, by, 2) - IF (ay > 0) dumy = dumy-REAL(ay, dp)*rr(ay-1, by, 2) + dumy = 2.0_dp*a*rr(ay + 1, by, 2) + IF (ay > 0) dumy = dumy - REAL(ay, dp)*rr(ay - 1, by, 2) dabb(ia, ib1, ib2, 2) = f0*rr(ax, bx, 1)*dumy*rr(az, bz, 3) ! dz - dumz = 2.0_dp*a*rr(az+1, bz, 3) - IF (az > 0) dumz = dumz-REAL(az, dp)*rr(az-1, bz, 3) + dumz = 2.0_dp*a*rr(az + 1, bz, 3) + IF (az > 0) dumz = dumz - REAL(az, dp)*rr(az - 1, bz, 3) dabb(ia, ib1, ib2, 3) = f0*rr(ax, bx, 1)*rr(ay, by, 2)*dumz END IF ! @@ -1327,11 +1327,11 @@ SUBROUTINE overlap_abb(la_max, la_min, npgfa, rpgfa, zeta, & ENDDO ENDDO !lb2 - mb2 = mb2+nb2 + mb2 = mb2 + nb2 END DO - mb1 = mb1+nb1 + mb1 = mb1 + nb1 END DO - ma = ma+na + ma = ma + na END DO DEALLOCATE (rr) @@ -1398,32 +1398,32 @@ SUBROUTINE overlap_aaab(la1_max, la1_min, npgfa1, rpgfa1, zeta1, & ! Distance of the centers a and b - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) tab = SQRT(rab2) ! Maximum l for auxiliary integrals IF (PRESENT(saaab)) THEN - lma = la1_max+la2_max+la3_max + lma = la1_max + la2_max + la3_max lmb = lb_max END IF IF (PRESENT(daaab)) THEN - lma = la1_max+la2_max+la3_max+1 + lma = la1_max + la2_max + la3_max + 1 lmb = lb_max END IF - ldrr = MAX(lma, lmb)+1 + ldrr = MAX(lma, lmb) + 1 ! Allocate space for auxiliary integrals - ALLOCATE (rr(0:ldrr-1, 0:ldrr-1, 3)) + ALLOCATE (rr(0:ldrr - 1, 0:ldrr - 1, 3)) ! Number of integrals, check size of arrays - ofa1 = ncoset(la1_min-1) - ofa2 = ncoset(la2_min-1) - ofa3 = ncoset(la3_min-1) - ofb = ncoset(lb_min-1) - na1 = ncoset(la1_max)-ofa1 - na2 = ncoset(la2_max)-ofa2 - na3 = ncoset(la3_max)-ofa3 - nb = ncoset(lb_max)-ofb + ofa1 = ncoset(la1_min - 1) + ofa2 = ncoset(la2_min - 1) + ofa3 = ncoset(la3_min - 1) + ofb = ncoset(lb_min - 1) + na1 = ncoset(la1_max) - ofa1 + na2 = ncoset(la2_max) - ofa2 + na3 = ncoset(la3_max) - ofa3 + nb = ncoset(lb_max) - ofb IF (PRESENT(saaab)) THEN CPASSERT((SIZE(saaab, 1) >= na1*npgfa1)) CPASSERT((SIZE(saaab, 2) >= na2*npgfa2)) @@ -1449,17 +1449,17 @@ SUBROUTINE overlap_aaab(la1_max, la1_min, npgfa1, rpgfa1, zeta1, & mb = 0 DO jpgf = 1, npgfb ! Distance Screening - IF (rpgfa+rpgfb(jpgf) < tab) THEN - IF (PRESENT(saaab)) saaab(ma1+1:ma1+na1, ma2+1:ma2+na2, ma3+1:ma3+na3, mb+1:mb+nb) = 0.0_dp - IF (PRESENT(daaab)) daaab(ma1+1:ma1+na1, ma2+1:ma2+na2, ma3+1:ma3+na3, mb+1:mb+nb, 1:3) = 0.0_dp - mb = mb+nb + IF (rpgfa + rpgfb(jpgf) < tab) THEN + IF (PRESENT(saaab)) saaab(ma1 + 1:ma1 + na1, ma2 + 1:ma2 + na2, ma3 + 1:ma3 + na3, mb + 1:mb + nb) = 0.0_dp + IF (PRESENT(daaab)) daaab(ma1 + 1:ma1 + na1, ma2 + 1:ma2 + na2, ma3 + 1:ma3 + na3, mb + 1:mb + nb, 1:3) = 0.0_dp + mb = mb + nb CYCLE ENDIF ! Calculate some prefactors - a = zeta1(i1pgf)+zeta2(i2pgf)+zeta3(i3pgf) + a = zeta1(i1pgf) + zeta2(i2pgf) + zeta3(i3pgf) b = zetb(jpgf) - zet = a+b + zet = a + b xhi = a*b/zet rap = b*rab/zet rbp = -a*rab/zet @@ -1472,50 +1472,50 @@ SUBROUTINE overlap_aaab(la1_max, la1_min, npgfa1, rpgfa1, zeta1, & DO lb = lb_min, lb_max DO bx = 0, lb - DO by = 0, lb-bx - bz = lb-bx-by - cob = coset(bx, by, bz)-ofb - ib = mb+cob + DO by = 0, lb - bx + bz = lb - bx - by + cob = coset(bx, by, bz) - ofb + ib = mb + cob DO la3 = la3_min, la3_max DO ax3 = 0, la3 - DO ay3 = 0, la3-ax3 - az3 = la3-ax3-ay3 - coa3 = coset(ax3, ay3, az3)-ofa3 - ia3 = ma3+coa3 + DO ay3 = 0, la3 - ax3 + az3 = la3 - ax3 - ay3 + coa3 = coset(ax3, ay3, az3) - ofa3 + ia3 = ma3 + coa3 DO la2 = la2_min, la2_max DO ax2 = 0, la2 - DO ay2 = 0, la2-ax2 - az2 = la2-ax2-ay2 - coa2 = coset(ax2, ay2, az2)-ofa2 - ia2 = ma2+coa2 + DO ay2 = 0, la2 - ax2 + az2 = la2 - ax2 - ay2 + coa2 = coset(ax2, ay2, az2) - ofa2 + ia2 = ma2 + coa2 DO la1 = la1_min, la1_max DO ax1 = 0, la1 - DO ay1 = 0, la1-ax1 - az1 = la1-ax1-ay1 - coa1 = coset(ax1, ay1, az1)-ofa1 - ia1 = ma1+coa1 + DO ay1 = 0, la1 - ax1 + az1 = la1 - ax1 - ay1 + coa1 = coset(ax1, ay1, az1) - ofa1 + ia1 = ma1 + coa1 ! integrals IF (PRESENT(saaab)) THEN - saaab(ia1, ia2, ia3, ib) = f0*rr(ax1+ax2+ax3, bx, 1)* & - rr(ay1+ay2+ay3, by, 2)*rr(az1+az2+az3, bz, 3) + saaab(ia1, ia2, ia3, ib) = f0*rr(ax1 + ax2 + ax3, bx, 1)* & + rr(ay1 + ay2 + ay3, by, 2)*rr(az1 + az2 + az3, bz, 3) END IF ! first derivatives IF (PRESENT(daaab)) THEN - ax = ax1+ax2+ax3 - ay = ay1+ay2+ay3 - az = az1+az2+az3 + ax = ax1 + ax2 + ax3 + ay = ay1 + ay2 + ay3 + az = az1 + az2 + az3 ! (da|b) = 2*a*(a+1|b) - N(a)*(a-1|b) ! dx - dumx = 2.0_dp*a*rr(ax+1, bx, 1) - IF (ax > 0) dumx = dumx-REAL(ax, dp)*rr(ax-1, bx, 1) + dumx = 2.0_dp*a*rr(ax + 1, bx, 1) + IF (ax > 0) dumx = dumx - REAL(ax, dp)*rr(ax - 1, bx, 1) daaab(ia1, ia2, ia3, ib, 1) = f0*dumx*rr(ay, by, 2)*rr(az, bz, 3) ! dy - dumy = 2.0_dp*a*rr(ay+1, by, 2) - IF (ay > 0) dumy = dumy-REAL(ay, dp)*rr(ay-1, by, 2) + dumy = 2.0_dp*a*rr(ay + 1, by, 2) + IF (ay > 0) dumy = dumy - REAL(ay, dp)*rr(ay - 1, by, 2) daaab(ia1, ia2, ia3, ib, 2) = f0*rr(ax, bx, 1)*dumy*rr(az, bz, 3) ! dz - dumz = 2.0_dp*a*rr(az+1, bz, 3) - IF (az > 0) dumz = dumz-REAL(az, dp)*rr(az-1, bz, 3) + dumz = 2.0_dp*a*rr(az + 1, bz, 3) + IF (az > 0) dumz = dumz - REAL(az, dp)*rr(az - 1, bz, 3) daaab(ia1, ia2, ia3, ib, 3) = f0*rr(ax, bx, 1)*rr(ay, by, 2)*dumz END IF ! @@ -1532,13 +1532,13 @@ SUBROUTINE overlap_aaab(la1_max, la1_min, npgfa1, rpgfa1, zeta1, & ENDDO ENDDO !lb - mb = mb+nb + mb = mb + nb END DO - ma3 = ma3+na3 + ma3 = ma3 + na3 END DO - ma2 = ma2+na2 + ma2 = ma2 + na2 END DO - ma1 = ma1+na1 + ma1 = ma1 + na1 END DO DEALLOCATE (rr) @@ -1604,32 +1604,32 @@ SUBROUTINE overlap_aabb(la1_max, la1_min, npgfa1, rpgfa1, zeta1, & ! Distance of the centers a and b - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) tab = SQRT(rab2) ! Maximum l for auxiliary integrals IF (PRESENT(saabb)) THEN - lma = la1_max+la2_max - lmb = lb1_max+lb2_max + lma = la1_max + la2_max + lmb = lb1_max + lb2_max END IF IF (PRESENT(daabb)) THEN - lma = la1_max+la2_max+1 - lmb = lb1_max+lb2_max + lma = la1_max + la2_max + 1 + lmb = lb1_max + lb2_max END IF - ldrr = MAX(lma, lmb)+1 + ldrr = MAX(lma, lmb) + 1 ! Allocate space for auxiliary integrals - ALLOCATE (rr(0:ldrr-1, 0:ldrr-1, 3)) + ALLOCATE (rr(0:ldrr - 1, 0:ldrr - 1, 3)) ! Number of integrals, check size of arrays - ofa1 = ncoset(la1_min-1) - ofa2 = ncoset(la2_min-1) - ofb1 = ncoset(lb1_min-1) - ofb2 = ncoset(lb2_min-1) - na1 = ncoset(la1_max)-ofa1 - na2 = ncoset(la2_max)-ofa2 - nb1 = ncoset(lb1_max)-ofb1 - nb2 = ncoset(lb2_max)-ofb2 + ofa1 = ncoset(la1_min - 1) + ofa2 = ncoset(la2_min - 1) + ofb1 = ncoset(lb1_min - 1) + ofb2 = ncoset(lb2_min - 1) + na1 = ncoset(la1_max) - ofa1 + na2 = ncoset(la2_max) - ofa2 + nb1 = ncoset(lb1_max) - ofb1 + nb2 = ncoset(lb2_max) - ofb2 IF (PRESENT(saabb)) THEN CPASSERT((SIZE(saabb, 1) >= na1*npgfa1)) CPASSERT((SIZE(saabb, 2) >= na2*npgfa2)) @@ -1656,17 +1656,17 @@ SUBROUTINE overlap_aabb(la1_max, la1_min, npgfa1, rpgfa1, zeta1, & DO j2pgf = 1, npgfb2 rpgfb = MIN(rpgfb1(j1pgf), rpgfb2(j2pgf)) ! Distance Screening - IF (rpgfa+rpgfb < tab) THEN - IF (PRESENT(saabb)) saabb(ma1+1:ma1+na1, ma2+1:ma2+na2, mb1+1:mb1+nb1, mb2+1:mb2+nb2) = 0.0_dp - IF (PRESENT(daabb)) daabb(ma1+1:ma1+na1, ma2+1:ma2+na2, mb1+1:mb1+nb1, mb2+1:mb2+nb2, 1:3) = 0.0_dp - mb2 = mb2+nb2 + IF (rpgfa + rpgfb < tab) THEN + IF (PRESENT(saabb)) saabb(ma1 + 1:ma1 + na1, ma2 + 1:ma2 + na2, mb1 + 1:mb1 + nb1, mb2 + 1:mb2 + nb2) = 0.0_dp + IF (PRESENT(daabb)) daabb(ma1 + 1:ma1 + na1, ma2 + 1:ma2 + na2, mb1 + 1:mb1 + nb1, mb2 + 1:mb2 + nb2, 1:3) = 0.0_dp + mb2 = mb2 + nb2 CYCLE ENDIF ! Calculate some prefactors - a = zeta1(i1pgf)+zeta2(i2pgf) - b = zetb1(j1pgf)+zetb2(j2pgf) - zet = a+b + a = zeta1(i1pgf) + zeta2(i2pgf) + b = zetb1(j1pgf) + zetb2(j2pgf) + zet = a + b xhi = a*b/zet rap = b*rab/zet rbp = -a*rab/zet @@ -1679,53 +1679,53 @@ SUBROUTINE overlap_aabb(la1_max, la1_min, npgfa1, rpgfa1, zeta1, & DO lb2 = lb2_min, lb2_max DO bx2 = 0, lb2 - DO by2 = 0, lb2-bx2 - bz2 = lb2-bx2-by2 - cob2 = coset(bx2, by2, bz2)-ofb2 - ib2 = mb2+cob2 + DO by2 = 0, lb2 - bx2 + bz2 = lb2 - bx2 - by2 + cob2 = coset(bx2, by2, bz2) - ofb2 + ib2 = mb2 + cob2 DO lb1 = lb1_min, lb1_max DO bx1 = 0, lb1 - DO by1 = 0, lb1-bx1 - bz1 = lb1-bx1-by1 - cob1 = coset(bx1, by1, bz1)-ofb1 - ib1 = mb1+cob1 + DO by1 = 0, lb1 - bx1 + bz1 = lb1 - bx1 - by1 + cob1 = coset(bx1, by1, bz1) - ofb1 + ib1 = mb1 + cob1 DO la2 = la2_min, la2_max DO ax2 = 0, la2 - DO ay2 = 0, la2-ax2 - az2 = la2-ax2-ay2 - coa2 = coset(ax2, ay2, az2)-ofa2 - ia2 = ma2+coa2 + DO ay2 = 0, la2 - ax2 + az2 = la2 - ax2 - ay2 + coa2 = coset(ax2, ay2, az2) - ofa2 + ia2 = ma2 + coa2 DO la1 = la1_min, la1_max DO ax1 = 0, la1 - DO ay1 = 0, la1-ax1 - az1 = la1-ax1-ay1 - coa1 = coset(ax1, ay1, az1)-ofa1 - ia1 = ma1+coa1 + DO ay1 = 0, la1 - ax1 + az1 = la1 - ax1 - ay1 + coa1 = coset(ax1, ay1, az1) - ofa1 + ia1 = ma1 + coa1 ! integrals IF (PRESENT(saabb)) THEN - saabb(ia1, ia2, ib1, ib2) = f0*rr(ax1+ax2, bx1+bx2, 1)* & - rr(ay1+ay2, by1+by2, 2)*rr(az1+az2, bz1+bz2, 3) + saabb(ia1, ia2, ib1, ib2) = f0*rr(ax1 + ax2, bx1 + bx2, 1)* & + rr(ay1 + ay2, by1 + by2, 2)*rr(az1 + az2, bz1 + bz2, 3) END IF ! first derivatives IF (PRESENT(daabb)) THEN - ax = ax1+ax2 - ay = ay1+ay2 - az = az1+az2 - bx = bx1+bx2 - by = by1+by2 - bz = bz1+bz2 + ax = ax1 + ax2 + ay = ay1 + ay2 + az = az1 + az2 + bx = bx1 + bx2 + by = by1 + by2 + bz = bz1 + bz2 ! (da|b) = 2*a*(a+1|b) - N(a)*(a-1|b) ! dx - dumx = 2.0_dp*a*rr(ax+1, bx, 1) - IF (ax > 0) dumx = dumx-REAL(ax, dp)*rr(ax-1, bx, 1) + dumx = 2.0_dp*a*rr(ax + 1, bx, 1) + IF (ax > 0) dumx = dumx - REAL(ax, dp)*rr(ax - 1, bx, 1) daabb(ia1, ia2, ib1, ib2, 1) = f0*dumx*rr(ay, by, 2)*rr(az, bz, 3) ! dy - dumy = 2.0_dp*a*rr(ay+1, by, 2) - IF (ay > 0) dumy = dumy-REAL(ay, dp)*rr(ay-1, by, 2) + dumy = 2.0_dp*a*rr(ay + 1, by, 2) + IF (ay > 0) dumy = dumy - REAL(ay, dp)*rr(ay - 1, by, 2) daabb(ia1, ia2, ib1, ib2, 2) = f0*rr(ax, bx, 1)*dumy*rr(az, bz, 3) ! dz - dumz = 2.0_dp*a*rr(az+1, bz, 3) - IF (az > 0) dumz = dumz-REAL(az, dp)*rr(az-1, bz, 3) + dumz = 2.0_dp*a*rr(az + 1, bz, 3) + IF (az > 0) dumz = dumz - REAL(az, dp)*rr(az - 1, bz, 3) daabb(ia1, ia2, ib1, ib2, 3) = f0*rr(ax, bx, 1)*rr(ay, by, 2)*dumz END IF ! @@ -1742,13 +1742,13 @@ SUBROUTINE overlap_aabb(la1_max, la1_min, npgfa1, rpgfa1, zeta1, & ENDDO ENDDO !lb2 - mb2 = mb2+nb2 + mb2 = mb2 + nb2 END DO - mb1 = mb1+nb1 + mb1 = mb1 + nb1 END DO - ma2 = ma2+na2 + ma2 = ma2 + na2 END DO - ma1 = ma1+na1 + ma1 = ma1 + na1 END DO DEALLOCATE (rr) @@ -1814,32 +1814,32 @@ SUBROUTINE overlap_abbb(la_max, la_min, npgfa, rpgfa, zeta, & ! Distance of the centers a and b - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) tab = SQRT(rab2) ! Maximum l for auxiliary integrals IF (PRESENT(sabbb)) THEN lma = la_max - lmb = lb1_max+lb2_max+lb3_max + lmb = lb1_max + lb2_max + lb3_max END IF IF (PRESENT(dabbb)) THEN - lma = la_max+1 - lmb = lb1_max+lb2_max+lb3_max + lma = la_max + 1 + lmb = lb1_max + lb2_max + lb3_max END IF - ldrr = MAX(lma, lmb)+1 + ldrr = MAX(lma, lmb) + 1 ! Allocate space for auxiliary integrals - ALLOCATE (rr(0:ldrr-1, 0:ldrr-1, 3)) + ALLOCATE (rr(0:ldrr - 1, 0:ldrr - 1, 3)) ! Number of integrals, check size of arrays - ofa = ncoset(la_min-1) - ofb1 = ncoset(lb1_min-1) - ofb2 = ncoset(lb2_min-1) - ofb3 = ncoset(lb3_min-1) - na = ncoset(la_max)-ofa - nb1 = ncoset(lb1_max)-ofb1 - nb2 = ncoset(lb2_max)-ofb2 - nb3 = ncoset(lb3_max)-ofb3 + ofa = ncoset(la_min - 1) + ofb1 = ncoset(lb1_min - 1) + ofb2 = ncoset(lb2_min - 1) + ofb3 = ncoset(lb3_min - 1) + na = ncoset(la_max) - ofa + nb1 = ncoset(lb1_max) - ofb1 + nb2 = ncoset(lb2_max) - ofb2 + nb3 = ncoset(lb3_max) - ofb3 IF (PRESENT(sabbb)) THEN CPASSERT((SIZE(sabbb, 1) >= na*npgfa)) CPASSERT((SIZE(sabbb, 2) >= nb1*npgfb1)) @@ -1865,17 +1865,17 @@ SUBROUTINE overlap_abbb(la_max, la_min, npgfa, rpgfa, zeta, & DO j3pgf = 1, npgfb3 ! Distance Screening rpgfb = MIN(rpgfb1(j1pgf), rpgfb2(j2pgf), rpgfb3(j3pgf)) - IF (rpgfa(ipgf)+rpgfb < tab) THEN - IF (PRESENT(sabbb)) sabbb(ma+1:ma+na, mb1+1:mb1+nb1, mb2+1:mb2+nb2, mb3+1:mb3+nb3) = 0.0_dp - IF (PRESENT(dabbb)) dabbb(ma+1:ma+na, mb1+1:mb1+nb1, mb2+1:mb2+nb2, mb3+1:mb3+nb3, 1:3) = 0.0_dp - mb3 = mb3+nb3 + IF (rpgfa(ipgf) + rpgfb < tab) THEN + IF (PRESENT(sabbb)) sabbb(ma + 1:ma + na, mb1 + 1:mb1 + nb1, mb2 + 1:mb2 + nb2, mb3 + 1:mb3 + nb3) = 0.0_dp + IF (PRESENT(dabbb)) dabbb(ma + 1:ma + na, mb1 + 1:mb1 + nb1, mb2 + 1:mb2 + nb2, mb3 + 1:mb3 + nb3, 1:3) = 0.0_dp + mb3 = mb3 + nb3 CYCLE ENDIF ! Calculate some prefactors a = zeta(ipgf) - b = zetb1(j1pgf)+zetb2(j2pgf)+zetb3(j3pgf) - zet = a+b + b = zetb1(j1pgf) + zetb2(j2pgf) + zetb3(j3pgf) + zet = a + b xhi = a*b/zet rap = b*rab/zet rbp = -a*rab/zet @@ -1888,50 +1888,50 @@ SUBROUTINE overlap_abbb(la_max, la_min, npgfa, rpgfa, zeta, & DO lb3 = lb3_min, lb3_max DO bx3 = 0, lb3 - DO by3 = 0, lb3-bx3 - bz3 = lb3-bx3-by3 - cob3 = coset(bx3, by3, bz3)-ofb3 - ib3 = mb3+cob3 + DO by3 = 0, lb3 - bx3 + bz3 = lb3 - bx3 - by3 + cob3 = coset(bx3, by3, bz3) - ofb3 + ib3 = mb3 + cob3 DO lb2 = lb2_min, lb2_max DO bx2 = 0, lb2 - DO by2 = 0, lb2-bx2 - bz2 = lb2-bx2-by2 - cob2 = coset(bx2, by2, bz2)-ofb2 - ib2 = mb2+cob2 + DO by2 = 0, lb2 - bx2 + bz2 = lb2 - bx2 - by2 + cob2 = coset(bx2, by2, bz2) - ofb2 + ib2 = mb2 + cob2 DO lb1 = lb1_min, lb1_max DO bx1 = 0, lb1 - DO by1 = 0, lb1-bx1 - bz1 = lb1-bx1-by1 - cob1 = coset(bx1, by1, bz1)-ofb1 - ib1 = mb1+cob1 + DO by1 = 0, lb1 - bx1 + bz1 = lb1 - bx1 - by1 + cob1 = coset(bx1, by1, bz1) - ofb1 + ib1 = mb1 + cob1 DO la = la_min, la_max DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay - coa = coset(ax, ay, az)-ofa - ia = ma+coa + DO ay = 0, la - ax + az = la - ax - ay + coa = coset(ax, ay, az) - ofa + ia = ma + coa ! integrals IF (PRESENT(sabbb)) THEN - sabbb(ia, ib1, ib2, ib3) = f0*rr(ax, bx1+bx2+bx3, 1)* & - rr(ay, by1+by2+by3, 2)*rr(az, bz1+bz2+bz3, 3) + sabbb(ia, ib1, ib2, ib3) = f0*rr(ax, bx1 + bx2 + bx3, 1)* & + rr(ay, by1 + by2 + by3, 2)*rr(az, bz1 + bz2 + bz3, 3) END IF ! first derivatives IF (PRESENT(dabbb)) THEN - bx = bx1+bx2+bx3 - by = by1+by2+by3 - bz = bz1+bz2+bz3 + bx = bx1 + bx2 + bx3 + by = by1 + by2 + by3 + bz = bz1 + bz2 + bz3 ! (da|b) = 2*a*(a+1|b) - N(a)*(a-1|b) ! dx - dumx = 2.0_dp*a*rr(ax+1, bx, 1) - IF (ax > 0) dumx = dumx-REAL(ax, dp)*rr(ax-1, bx, 1) + dumx = 2.0_dp*a*rr(ax + 1, bx, 1) + IF (ax > 0) dumx = dumx - REAL(ax, dp)*rr(ax - 1, bx, 1) dabbb(ia, ib1, ib2, ib3, 1) = f0*dumx*rr(ay, by, 2)*rr(az, bz, 3) ! dy - dumy = 2.0_dp*a*rr(ay+1, by, 2) - IF (ay > 0) dumy = dumy-REAL(ay, dp)*rr(ay-1, by, 2) + dumy = 2.0_dp*a*rr(ay + 1, by, 2) + IF (ay > 0) dumy = dumy - REAL(ay, dp)*rr(ay - 1, by, 2) dabbb(ia, ib1, ib2, ib3, 2) = f0*rr(ax, bx, 1)*dumy*rr(az, bz, 3) ! dz - dumz = 2.0_dp*a*rr(az+1, bz, 3) - IF (az > 0) dumz = dumz-REAL(az, dp)*rr(az-1, bz, 3) + dumz = 2.0_dp*a*rr(az + 1, bz, 3) + IF (az > 0) dumz = dumz - REAL(az, dp)*rr(az - 1, bz, 3) dabbb(ia, ib1, ib2, ib3, 3) = f0*rr(ax, bx, 1)*rr(ay, by, 2)*dumz END IF ! @@ -1948,13 +1948,13 @@ SUBROUTINE overlap_abbb(la_max, la_min, npgfa, rpgfa, zeta, & ENDDO ENDDO !lb3 - mb3 = mb3+nb3 + mb3 = mb3 + nb3 END DO - mb2 = mb2+nb2 + mb2 = mb2 + nb2 END DO - mb1 = mb1+nb1 + mb1 = mb1 + nb1 END DO - ma = ma+na + ma = ma + na END DO DEALLOCATE (rr) @@ -2050,7 +2050,7 @@ SUBROUTINE overlap_ab_sp(la, zeta, lb, zetb, alat, sab) nsb = nso(lb) zm = MIN(zeta, zetb) - nmax = NINT(1.81_dp*alat*SQRT(zm)+1.0_dp) + nmax = NINT(1.81_dp*alat*SQRT(zm) + 1.0_dp) ALLOCATE (fun(-nmax:nmax, 0:la), gun(-nmax:nmax, 0:lb), & fexp(-nmax:nmax), gexp(-nmax:nmax), gval(-nmax:nmax)) @@ -2068,10 +2068,10 @@ SUBROUTINE overlap_ab_sp(la, zeta, lb, zetb, alat, sab) fun(:, l) = CMPLX(0.0_dp, 0.5_dp*oa*gval(:), KIND=dp) ELSEIF (l == 2) THEN fun(:, l) = CMPLX(-(0.5_dp*oa*gval(:))**2, 0.0_dp, KIND=dp) - fun(:, l) = fun(:, l)+CMPLX(0.5_dp*oa, 0.0_dp, KIND=dp) + fun(:, l) = fun(:, l) + CMPLX(0.5_dp*oa, 0.0_dp, KIND=dp) ELSEIF (l == 3) THEN fun(:, l) = CMPLX(0.0_dp, -(0.5_dp*oa*gval(:))**3, KIND=dp) - fun(:, l) = fun(:, l)+CMPLX(0.0_dp, 0.75_dp*oa*oa*gval(:), KIND=dp) + fun(:, l) = fun(:, l) + CMPLX(0.0_dp, 0.75_dp*oa*oa*gval(:), KIND=dp) ELSE CPABORT("l value too high") END IF @@ -2083,10 +2083,10 @@ SUBROUTINE overlap_ab_sp(la, zeta, lb, zetb, alat, sab) gun(:, l) = CMPLX(0.0_dp, 0.5_dp*ob*gval(:), KIND=dp) ELSEIF (l == 2) THEN gun(:, l) = CMPLX(-(0.5_dp*ob*gval(:))**2, 0.0_dp, KIND=dp) - gun(:, l) = gun(:, l)+CMPLX(0.5_dp*ob, 0.0_dp, KIND=dp) + gun(:, l) = gun(:, l) + CMPLX(0.5_dp*ob, 0.0_dp, KIND=dp) ELSEIF (l == 3) THEN gun(:, l) = CMPLX(0.0_dp, -(0.5_dp*ob*gval(:))**3, KIND=dp) - gun(:, l) = gun(:, l)+CMPLX(0.0_dp, 0.75_dp*ob*ob*gval(:), KIND=dp) + gun(:, l) = gun(:, l) + CMPLX(0.0_dp, 0.75_dp*ob*ob*gval(:), KIND=dp) ELSE CPABORT("l value too high") END IF @@ -2100,16 +2100,16 @@ SUBROUTINE overlap_ab_sp(la, zeta, lb, zetb, alat, sab) END DO END DO - na = ncoset(la-1) - nb = ncoset(lb-1) + na = ncoset(la - 1) + nb = ncoset(lb - 1) DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay - ia = coset(ax, ay, az)-na + DO ay = 0, la - ax + az = la - ax - ay + ia = coset(ax, ay, az) - na DO bx = 0, lb - DO by = 0, lb-bx - bz = lb-bx-by - ib = coset(bx, by, bz)-nb + DO by = 0, lb - bx + bz = lb - bx - by + ib = coset(bx, by, bz) - nb cab(ia, ib) = fgsum(ax, bx)*fgsum(ay, by)*fgsum(az, bz) END DO END DO diff --git a/src/aobasis/ai_overlap3.F b/src/aobasis/ai_overlap3.F index 0f56e402b5..d919f19d0d 100644 --- a/src/aobasis/ai_overlap3.F +++ b/src/aobasis/ai_overlap3.F @@ -142,12 +142,12 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & IF (PRESENT(sdabc)) lai = 1 IF (PRESENT(sabdc)) lci = 1 - la_max = la_max_set+lai - la_min = MAX(0, la_min_set-lai) + la_max = la_max_set + lai + la_min = MAX(0, la_min_set - lai) lb_max = lb_max_set lb_min = lb_min_set - lc_max = lc_max_set+lci - lc_min = MAX(0, lc_min_set-lci) + lc_max = lc_max_set + lci + lc_min = MAX(0, lc_min_set - lci) ALLOCATE (s(ncoset(la_max), ncoset(lb_max), ncoset(lc_max))) s = 0._dp @@ -170,8 +170,8 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & DO jpgf = 1, npgfb ! *** Screening *** - IF (rpgfa(ipgf)+rpgfb(jpgf) < dab) THEN - nb = nb+ncoset(lb_max_set) + IF (rpgfa(ipgf) + rpgfb(jpgf) < dab) THEN + nb = nb + ncoset(lb_max_set) CYCLE END IF @@ -180,24 +180,24 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & DO kpgf = 1, npgfc ! *** Screening *** - IF ((rpgfb(jpgf)+rpgfc(kpgf) < dbc) .OR. & - (rpgfa(ipgf)+rpgfc(kpgf) < dac)) THEN - nc = nc+ncoset(lc_max_set) - ndc = ndc+ncoset(lc_max_set) + IF ((rpgfb(jpgf) + rpgfc(kpgf) < dbc) .OR. & + (rpgfa(ipgf) + rpgfc(kpgf) < dac)) THEN + nc = nc + ncoset(lc_max_set) + ndc = ndc + ncoset(lc_max_set) CYCLE END IF ! *** Calculate some prefactors *** - zetg = 1.0_dp/(zeta(ipgf)+zetb(jpgf)+zetc(kpgf)) - zetp = 1.0_dp/(zeta(ipgf)+zetb(jpgf)) + zetg = 1.0_dp/(zeta(ipgf) + zetb(jpgf) + zetc(kpgf)) + zetp = 1.0_dp/(zeta(ipgf) + zetb(jpgf)) f0 = (pi*zetg)**1.5_dp f1 = zetb(jpgf)*zetp f2 = 0.5_dp*zetg - rcp(:) = f1*rab(:)-rac(:) - rcp2 = rcp(1)*rcp(1)+rcp(2)*rcp(2)+rcp(3)*rcp(3) + rcp(:) = f1*rab(:) - rac(:) + rcp2 = rcp(1)*rcp(1) + rcp(2)*rcp(2) + rcp(3)*rcp(3) ! *** Calculate the basic three-center overlap integral [s|s|s] *** - s(1, 1, 1) = f0*EXP(-(zeta(ipgf)*f1*dab*dab+zetc(kpgf)*zetg*rcp2/zetp)) + s(1, 1, 1) = f0*EXP(-(zeta(ipgf)*f1*dab*dab + zetc(kpgf)*zetg*rcp2/zetp)) ! *** Recurrence steps: [s|s|s] -> [a|s|s] *** @@ -205,7 +205,7 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & ! *** Vertical recurrence steps: [s|s|s] -> [a|s|s] *** - rag(:) = zetg*(zetb(jpgf)*rab(:)+zetc(kpgf)*rac(:)) + rag(:) = zetg*(zetb(jpgf)*rab(:) + zetc(kpgf)*rac(:)) ! *** [p|s|s] = (Gi - Ai)*[s|s|s] (i = x,y,z) *** @@ -219,33 +219,33 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & ! *** Increase the angular momentum component z of function a *** - s(coset(0, 0, la), 1, 1) = rag(3)*s(coset(0, 0, la-1), 1, 1)+ & - f2*REAL(la-1, dp)*s(coset(0, 0, la-2), 1, 1) + s(coset(0, 0, la), 1, 1) = rag(3)*s(coset(0, 0, la - 1), 1, 1) + & + f2*REAL(la - 1, dp)*s(coset(0, 0, la - 2), 1, 1) ! *** Increase the angular momentum component y of function a *** - az = la-1 + az = la - 1 s(coset(0, 1, az), 1, 1) = rag(2)*s(coset(0, 0, az), 1, 1) DO ay = 2, la - az = la-ay - s(coset(0, ay, az), 1, 1) = rag(2)*s(coset(0, ay-1, az), 1, 1)+ & - f2*REAL(ay-1, dp)*s(coset(0, ay-2, az), 1, 1) + az = la - ay + s(coset(0, ay, az), 1, 1) = rag(2)*s(coset(0, ay - 1, az), 1, 1) + & + f2*REAL(ay - 1, dp)*s(coset(0, ay - 2, az), 1, 1) END DO ! *** Increase the angular momentum component x of function a *** - DO ay = 0, la-1 - az = la-1-ay + DO ay = 0, la - 1 + az = la - 1 - ay s(coset(1, ay, az), 1, 1) = rag(1)*s(coset(0, ay, az), 1, 1) END DO DO ax = 2, la - f3 = f2*REAL(ax-1, dp) - DO ay = 0, la-ax - az = la-ax-ay - s(coset(ax, ay, az), 1, 1) = rag(1)*s(coset(ax-1, ay, az), 1, 1)+ & - f3*s(coset(ax-2, ay, az), 1, 1) + f3 = f2*REAL(ax - 1, dp) + DO ay = 0, la - ax + az = la - ax - ay + s(coset(ax, ay, az), 1, 1) = rag(1)*s(coset(ax - 1, ay, az), 1, 1) + & + f3*s(coset(ax - 2, ay, az), 1, 1) END DO END DO @@ -257,27 +257,27 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & ! *** Horizontal recurrence steps *** - rbg(:) = rag(:)-rab(:) + rbg(:) = rag(:) - rab(:) ! *** [a|s|p] = [a+1i|s|s] - (Bi - Ai)*[a|s|s] *** IF (lb_max == 1) THEN la_start = la_min ELSE - la_start = MAX(0, la_min-1) + la_start = MAX(0, la_min - 1) END IF - DO la = la_start, la_max-1 + DO la = la_start, la_max - 1 DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay coa = coset(ax, ay, az) - coax = coset(ax+1, ay, az) - coay = coset(ax, ay+1, az) - coaz = coset(ax, ay, az+1) - s(coset(ax, ay, az), 2, 1) = s(coax, 1, 1)-rab(1)*s(coa, 1, 1) - s(coset(ax, ay, az), 3, 1) = s(coay, 1, 1)-rab(2)*s(coa, 1, 1) - s(coset(ax, ay, az), 4, 1) = s(coaz, 1, 1)-rab(3)*s(coa, 1, 1) + coax = coset(ax + 1, ay, az) + coay = coset(ax, ay + 1, az) + coaz = coset(ax, ay, az + 1) + s(coset(ax, ay, az), 2, 1) = s(coax, 1, 1) - rab(1)*s(coa, 1, 1) + s(coset(ax, ay, az), 3, 1) = s(coay, 1, 1) - rab(2)*s(coa, 1, 1) + s(coset(ax, ay, az), 4, 1) = s(coaz, 1, 1) - rab(3)*s(coa, 1, 1) END DO END DO END DO @@ -288,25 +288,25 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & DO ax = 0, la_max fx = f2*REAL(ax, dp) - DO ay = 0, la_max-ax + DO ay = 0, la_max - ax fy = f2*REAL(ay, dp) - az = la_max-ax-ay + az = la_max - ax - ay fz = f2*REAL(az, dp) coa = coset(ax, ay, az) IF (ax == 0) THEN s(coa, 2, 1) = rbg(1)*s(coa, 1, 1) ELSE - s(coa, 2, 1) = rbg(1)*s(coa, 1, 1)+fx*s(coset(ax-1, ay, az), 1, 1) + s(coa, 2, 1) = rbg(1)*s(coa, 1, 1) + fx*s(coset(ax - 1, ay, az), 1, 1) END IF IF (ay == 0) THEN s(coa, 3, 1) = rbg(2)*s(coa, 1, 1) ELSE - s(coa, 3, 1) = rbg(2)*s(coa, 1, 1)+fy*s(coset(ax, ay-1, az), 1, 1) + s(coa, 3, 1) = rbg(2)*s(coa, 1, 1) + fy*s(coset(ax, ay - 1, az), 1, 1) END IF IF (az == 0) THEN s(coa, 4, 1) = rbg(3)*s(coa, 1, 1) ELSE - s(coa, 4, 1) = rbg(3)*s(coa, 1, 1)+fz*s(coset(ax, ay, az-1), 1, 1) + s(coa, 4, 1) = rbg(3)*s(coa, 1, 1) + fz*s(coset(ax, ay, az - 1), 1, 1) END IF END DO END DO @@ -322,42 +322,42 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & IF (lb == lb_max) THEN la_start = la_min ELSE - la_start = MAX(0, la_min-1) + la_start = MAX(0, la_min - 1) END IF - DO la = la_start, la_max-1 + DO la = la_start, la_max - 1 DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay coa = coset(ax, ay, az) - coax = coset(ax+1, ay, az) - coay = coset(ax, ay+1, az) - coaz = coset(ax, ay, az+1) + coax = coset(ax + 1, ay, az) + coay = coset(ax, ay + 1, az) + coaz = coset(ax, ay, az + 1) ! *** Shift of angular momentum component z from a to b *** s(coa, coset(0, 0, lb), 1) = & - s(coaz, coset(0, 0, lb-1), 1)- & - rab(3)*s(coa, coset(0, 0, lb-1), 1) + s(coaz, coset(0, 0, lb - 1), 1) - & + rab(3)*s(coa, coset(0, 0, lb - 1), 1) ! *** Shift of angular momentum component y from a to b *** DO by = 1, lb - bz = lb-by + bz = lb - by s(coa, coset(0, by, bz), 1) = & - s(coay, coset(0, by-1, bz), 1)- & - rab(2)*s(coa, coset(0, by-1, bz), 1) + s(coay, coset(0, by - 1, bz), 1) - & + rab(2)*s(coa, coset(0, by - 1, bz), 1) END DO ! *** Shift of angular momentum component x from a to b *** DO bx = 1, lb - DO by = 0, lb-bx - bz = lb-bx-by + DO by = 0, lb - bx + bz = lb - bx - by s(coa, coset(bx, by, bz), 1) = & - s(coax, coset(bx-1, by, bz), 1)- & - rab(1)*s(coa, coset(bx-1, by, bz), 1) + s(coax, coset(bx - 1, by, bz), 1) - & + rab(1)*s(coa, coset(bx - 1, by, bz), 1) END DO END DO @@ -373,91 +373,91 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & DO ax = 0, la_max fx = f2*REAL(ax, dp) - DO ay = 0, la_max-ax + DO ay = 0, la_max - ax fy = f2*REAL(ay, dp) - az = la_max-ax-ay + az = la_max - ax - ay fz = f2*REAL(az, dp) coa = coset(ax, ay, az) - f3 = f2*REAL(lb-1, dp) + f3 = f2*REAL(lb - 1, dp) ! *** Shift of angular momentum component z from a to b *** IF (az == 0) THEN s(coa, coset(0, 0, lb), 1) = & - rbg(3)*s(coa, coset(0, 0, lb-1), 1)+ & - f3*s(coa, coset(0, 0, lb-2), 1) + rbg(3)*s(coa, coset(0, 0, lb - 1), 1) + & + f3*s(coa, coset(0, 0, lb - 2), 1) ELSE - coaz = coset(ax, ay, az-1) + coaz = coset(ax, ay, az - 1) s(coa, coset(0, 0, lb), 1) = & - rbg(3)*s(coa, coset(0, 0, lb-1), 1)+ & - fz*s(coaz, coset(0, 0, lb-1), 1)+ & - f3*s(coa, coset(0, 0, lb-2), 1) + rbg(3)*s(coa, coset(0, 0, lb - 1), 1) + & + fz*s(coaz, coset(0, 0, lb - 1), 1) + & + f3*s(coa, coset(0, 0, lb - 2), 1) END IF ! *** Shift of angular momentum component y from a to b *** IF (ay == 0) THEN - bz = lb-1 + bz = lb - 1 s(coa, coset(0, 1, bz), 1) = & rbg(2)*s(coa, coset(0, 0, bz), 1) DO by = 2, lb - bz = lb-by - f3 = f2*REAL(by-1, dp) + bz = lb - by + f3 = f2*REAL(by - 1, dp) s(coa, coset(0, by, bz), 1) = & - rbg(2)*s(coa, coset(0, by-1, bz), 1)+ & - f3*s(coa, coset(0, by-2, bz), 1) + rbg(2)*s(coa, coset(0, by - 1, bz), 1) + & + f3*s(coa, coset(0, by - 2, bz), 1) END DO ELSE - coay = coset(ax, ay-1, az) - bz = lb-1 + coay = coset(ax, ay - 1, az) + bz = lb - 1 s(coa, coset(0, 1, bz), 1) = & - rbg(2)*s(coa, coset(0, 0, bz), 1)+ & + rbg(2)*s(coa, coset(0, 0, bz), 1) + & fy*s(coay, coset(0, 0, bz), 1) DO by = 2, lb - bz = lb-by - f3 = f2*REAL(by-1, dp) + bz = lb - by + f3 = f2*REAL(by - 1, dp) s(coa, coset(0, by, bz), 1) = & - rbg(2)*s(coa, coset(0, by-1, bz), 1)+ & - fy*s(coay, coset(0, by-1, bz), 1)+ & - f3*s(coa, coset(0, by-2, bz), 1) + rbg(2)*s(coa, coset(0, by - 1, bz), 1) + & + fy*s(coay, coset(0, by - 1, bz), 1) + & + f3*s(coa, coset(0, by - 2, bz), 1) END DO END IF ! *** Shift of angular momentum component x from a to b *** IF (ax == 0) THEN - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by s(coa, coset(1, by, bz), 1) = & rbg(1)*s(coa, coset(0, by, bz), 1) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by s(coa, coset(bx, by, bz), 1) = & - rbg(1)*s(coa, coset(bx-1, by, bz), 1)+ & - f3*s(coa, coset(bx-2, by, bz), 1) + rbg(1)*s(coa, coset(bx - 1, by, bz), 1) + & + f3*s(coa, coset(bx - 2, by, bz), 1) END DO END DO ELSE - coax = coset(ax-1, ay, az) - DO by = 0, lb-1 - bz = lb-1-by + coax = coset(ax - 1, ay, az) + DO by = 0, lb - 1 + bz = lb - 1 - by s(coa, coset(1, by, bz), 1) = & - rbg(1)*s(coa, coset(0, by, bz), 1)+ & + rbg(1)*s(coa, coset(0, by, bz), 1) + & fx*s(coax, coset(0, by, bz), 1) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by s(coa, coset(bx, by, bz), 1) = & - rbg(1)*s(coa, coset(bx-1, by, bz), 1)+ & - fx*s(coax, coset(bx-1, by, bz), 1)+ & - f3*s(coa, coset(bx-2, by, bz), 1) + rbg(1)*s(coa, coset(bx - 1, by, bz), 1) + & + fx*s(coax, coset(bx - 1, by, bz), 1) + & + f3*s(coa, coset(bx - 2, by, bz), 1) END DO END DO END IF @@ -475,7 +475,7 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & ! *** Vertical recurrence steps: [s|s|s] -> [s|s|b] *** - rbg(:) = -zetg*(zeta(ipgf)*rab(:)-zetc(kpgf)*rbc(:)) + rbg(:) = -zetg*(zeta(ipgf)*rab(:) - zetc(kpgf)*rbc(:)) ! *** [s|s|p] = (Gi - Bi)*[s|s|s] *** @@ -489,34 +489,34 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & ! *** Increase the angular momentum component z of function b *** - s(1, coset(0, 0, lb), 1) = rbg(3)*s(1, coset(0, 0, lb-1), 1)+ & - f2*REAL(lb-1, dp)*s(1, coset(0, 0, lb-2), 1) + s(1, coset(0, 0, lb), 1) = rbg(3)*s(1, coset(0, 0, lb - 1), 1) + & + f2*REAL(lb - 1, dp)*s(1, coset(0, 0, lb - 2), 1) ! *** Increase the angular momentum component y of function b *** - bz = lb-1 + bz = lb - 1 s(1, coset(0, 1, bz), 1) = rbg(2)*s(1, coset(0, 0, bz), 1) DO by = 2, lb - bz = lb-by + bz = lb - by s(1, coset(0, by, bz), 1) = & - rbg(2)*s(1, coset(0, by-1, bz), 1)+ & - f2*REAL(by-1, dp)*s(1, coset(0, by-2, bz), 1) + rbg(2)*s(1, coset(0, by - 1, bz), 1) + & + f2*REAL(by - 1, dp)*s(1, coset(0, by - 2, bz), 1) END DO ! *** Increase the angular momentum component x of function b *** - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by s(1, coset(1, by, bz), 1) = rbg(1)*s(1, coset(0, by, bz), 1) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by - s(1, coset(bx, by, bz), 1) = rbg(1)*s(1, coset(bx-1, by, bz), 1)+ & - f3*s(1, coset(bx-2, by, bz), 1) + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by + s(1, coset(bx, by, bz), 1) = rbg(1)*s(1, coset(bx - 1, by, bz), 1) + & + f3*s(1, coset(bx - 2, by, bz), 1) END DO END DO @@ -532,7 +532,7 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & ! *** Vertical recurrence steps: [s|s|s] -> [s|c|s] *** - rcg(:) = -zetg*(zeta(ipgf)*rac(:)+zetb(jpgf)*rbc(:)) + rcg(:) = -zetg*(zeta(ipgf)*rac(:) + zetb(jpgf)*rbc(:)) ! *** [s|p|s] = (Gi - Ci)*[s|s|s] (i = x,y,z) *** @@ -546,33 +546,33 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & ! *** Increase the angular momentum component z of function c *** - s(1, 1, coset(0, 0, lc)) = rcg(3)*s(1, 1, coset(0, 0, lc-1))+ & - f2*REAL(lc-1, dp)*s(1, 1, coset(0, 0, lc-2)) + s(1, 1, coset(0, 0, lc)) = rcg(3)*s(1, 1, coset(0, 0, lc - 1)) + & + f2*REAL(lc - 1, dp)*s(1, 1, coset(0, 0, lc - 2)) ! *** Increase the angular momentum component y of function c *** - cz = lc-1 + cz = lc - 1 s(1, 1, coset(0, 1, cz)) = rcg(2)*s(1, 1, coset(0, 0, cz)) DO cy = 2, lc - cz = lc-cy - s(1, 1, coset(0, cy, cz)) = rcg(2)*s(1, 1, coset(0, cy-1, cz))+ & - f2*REAL(cy-1, dp)*s(1, 1, coset(0, cy-2, cz)) + cz = lc - cy + s(1, 1, coset(0, cy, cz)) = rcg(2)*s(1, 1, coset(0, cy - 1, cz)) + & + f2*REAL(cy - 1, dp)*s(1, 1, coset(0, cy - 2, cz)) END DO ! *** Increase the angular momentum component x of function c *** - DO cy = 0, lc-1 - cz = lc-1-cy + DO cy = 0, lc - 1 + cz = lc - 1 - cy s(1, 1, coset(1, cy, cz)) = rcg(1)*s(1, 1, coset(0, cy, cz)) END DO DO cx = 2, lc - f3 = f2*REAL(cx-1, dp) - DO cy = 0, lc-cx - cz = lc-cx-cy - s(1, 1, coset(cx, cy, cz)) = rcg(1)*s(1, 1, coset(cx-1, cy, cz))+ & - f3*s(1, 1, coset(cx-2, cy, cz)) + f3 = f2*REAL(cx - 1, dp) + DO cy = 0, lc - cx + cz = lc - cx - cy + s(1, 1, coset(cx, cy, cz)) = rcg(1)*s(1, 1, coset(cx - 1, cy, cz)) + & + f3*s(1, 1, coset(cx - 2, cy, cz)) END DO END DO @@ -583,13 +583,13 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & DO lc = 1, lc_max DO cx = 0, lc - DO cy = 0, lc-cx - cz = lc-cx-cy + DO cy = 0, lc - cx + cz = lc - cx - cy coc = coset(cx, cy, cz) - cocx = coset(MAX(0, cx-1), cy, cz) - cocy = coset(cx, MAX(0, cy-1), cz) - cocz = coset(cx, cy, MAX(0, cz-1)) + cocx = coset(MAX(0, cx - 1), cy, cz) + cocy = coset(cx, MAX(0, cy - 1), cz) + cocz = coset(cx, cy, MAX(0, cz - 1)) fcx = f2*REAL(cx, dp) fcy = f2*REAL(cy, dp) @@ -601,13 +601,13 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & ! *** Vertical recurrence steps: [s|c|s] -> [a|c|s] *** - rag(:) = rcg(:)+rac(:) + rag(:) = rcg(:) + rac(:) ! *** [p|c|s] = (Gi - Ai)*[s|c|s] + f2*Ni(c)*[s|c-1i|s] *** - s(2, 1, coc) = rag(1)*s(1, 1, coc)+fcx*s(1, 1, cocx) - s(3, 1, coc) = rag(2)*s(1, 1, coc)+fcy*s(1, 1, cocy) - s(4, 1, coc) = rag(3)*s(1, 1, coc)+fcz*s(1, 1, cocz) + s(2, 1, coc) = rag(1)*s(1, 1, coc) + fcx*s(1, 1, cocx) + s(3, 1, coc) = rag(2)*s(1, 1, coc) + fcy*s(1, 1, cocy) + s(4, 1, coc) = rag(3)*s(1, 1, coc) + fcz*s(1, 1, cocz) ! *** [a|c|s] = (Gi - Ai)*[a-1i|c|s] + *** ! *** f2*Ni(a-1i)*[a-2i|c|s] + *** @@ -618,42 +618,42 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & ! *** Increase the angular momentum component z of a *** s(coset(0, 0, la), 1, coc) = & - rag(3)*s(coset(0, 0, la-1), 1, coc)+ & - f2*REAL(la-1, dp)*s(coset(0, 0, la-2), 1, coc)+ & - fcz*s(coset(0, 0, la-1), 1, cocz) + rag(3)*s(coset(0, 0, la - 1), 1, coc) + & + f2*REAL(la - 1, dp)*s(coset(0, 0, la - 2), 1, coc) + & + fcz*s(coset(0, 0, la - 1), 1, cocz) ! *** Increase the angular momentum component y of a *** - az = la-1 + az = la - 1 s(coset(0, 1, az), 1, coc) = & - rag(2)*s(coset(0, 0, az), 1, coc)+ & + rag(2)*s(coset(0, 0, az), 1, coc) + & fcy*s(coset(0, 0, az), 1, cocy) DO ay = 2, la - az = la-ay + az = la - ay s(coset(0, ay, az), 1, coc) = & - rag(2)*s(coset(0, ay-1, az), 1, coc)+ & - f2*REAL(ay-1, dp)*s(coset(0, ay-2, az), 1, coc)+ & - fcy*s(coset(0, ay-1, az), 1, cocy) + rag(2)*s(coset(0, ay - 1, az), 1, coc) + & + f2*REAL(ay - 1, dp)*s(coset(0, ay - 2, az), 1, coc) + & + fcy*s(coset(0, ay - 1, az), 1, cocy) END DO ! *** Increase the angular momentum component x of a *** - DO ay = 0, la-1 - az = la-1-ay + DO ay = 0, la - 1 + az = la - 1 - ay s(coset(1, ay, az), 1, coc) = & - rag(1)*s(coset(0, ay, az), 1, coc)+ & + rag(1)*s(coset(0, ay, az), 1, coc) + & fcx*s(coset(0, ay, az), 1, cocx) END DO DO ax = 2, la - f3 = f2*REAL(ax-1, dp) - DO ay = 0, la-ax - az = la-ax-ay + f3 = f2*REAL(ax - 1, dp) + DO ay = 0, la - ax + az = la - ax - ay s(coset(ax, ay, az), 1, coc) = & - rag(1)*s(coset(ax-1, ay, az), 1, coc)+ & - f3*s(coset(ax-2, ay, az), 1, coc)+ & - fcx*s(coset(ax-1, ay, az), 1, cocx) + rag(1)*s(coset(ax - 1, ay, az), 1, coc) + & + f3*s(coset(ax - 2, ay, az), 1, coc) + & + fcx*s(coset(ax - 1, ay, az), 1, cocx) END DO END DO @@ -665,27 +665,27 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & ! *** Horizontal recurrence steps *** - rbg(:) = rag(:)-rab(:) + rbg(:) = rag(:) - rab(:) ! *** [a|c|p] = [a+1i|c|s] - (Bi - Ai)*[a|c|s] *** IF (lb_max == 1) THEN la_start = la_min ELSE - la_start = MAX(0, la_min-1) + la_start = MAX(0, la_min - 1) END IF - DO la = la_start, la_max-1 + DO la = la_start, la_max - 1 DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay coa = coset(ax, ay, az) - coax = coset(ax+1, ay, az) - coay = coset(ax, ay+1, az) - coaz = coset(ax, ay, az+1) - s(coa, 2, coc) = s(coax, 1, coc)-rab(1)*s(coa, 1, coc) - s(coa, 3, coc) = s(coay, 1, coc)-rab(2)*s(coa, 1, coc) - s(coa, 4, coc) = s(coaz, 1, coc)-rab(3)*s(coa, 1, coc) + coax = coset(ax + 1, ay, az) + coay = coset(ax, ay + 1, az) + coaz = coset(ax, ay, az + 1) + s(coa, 2, coc) = s(coax, 1, coc) - rab(1)*s(coa, 1, coc) + s(coa, 3, coc) = s(coay, 1, coc) - rab(2)*s(coa, 1, coc) + s(coa, 4, coc) = s(coaz, 1, coc) - rab(3)*s(coa, 1, coc) END DO END DO END DO @@ -698,33 +698,33 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & DO ax = 0, la_max fx = f2*REAL(ax, dp) - DO ay = 0, la_max-ax + DO ay = 0, la_max - ax fy = f2*REAL(ay, dp) - az = la_max-ax-ay + az = la_max - ax - ay fz = f2*REAL(az, dp) coa = coset(ax, ay, az) IF (ax == 0) THEN - s(coa, 2, coc) = rbg(1)*s(coa, 1, coc)+ & + s(coa, 2, coc) = rbg(1)*s(coa, 1, coc) + & fcx*s(coa, 1, cocx) ELSE - s(coa, 2, coc) = rbg(1)*s(coa, 1, coc)+ & - fx*s(coset(ax-1, ay, az), 1, coc)+ & + s(coa, 2, coc) = rbg(1)*s(coa, 1, coc) + & + fx*s(coset(ax - 1, ay, az), 1, coc) + & fcx*s(coa, 1, cocx) END IF IF (ay == 0) THEN - s(coa, 3, coc) = rbg(2)*s(coa, 1, coc)+ & + s(coa, 3, coc) = rbg(2)*s(coa, 1, coc) + & fcy*s(coa, 1, cocy) ELSE - s(coa, 3, coc) = rbg(2)*s(coa, 1, coc)+ & - fy*s(coset(ax, ay-1, az), 1, coc)+ & + s(coa, 3, coc) = rbg(2)*s(coa, 1, coc) + & + fy*s(coset(ax, ay - 1, az), 1, coc) + & fcy*s(coa, 1, cocy) END IF IF (az == 0) THEN - s(coa, 4, coc) = rbg(3)*s(coa, 1, coc)+ & + s(coa, 4, coc) = rbg(3)*s(coa, 1, coc) + & fcz*s(coa, 1, cocz) ELSE - s(coa, 4, coc) = rbg(3)*s(coa, 1, coc)+ & - fz*s(coset(ax, ay, az-1), 1, coc)+ & + s(coa, 4, coc) = rbg(3)*s(coa, 1, coc) + & + fz*s(coset(ax, ay, az - 1), 1, coc) + & fcz*s(coa, 1, cocz) END IF END DO @@ -741,45 +741,45 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & IF (lb == lb_max) THEN la_start = la_min ELSE - la_start = MAX(0, la_min-1) + la_start = MAX(0, la_min - 1) END IF - DO la = la_start, la_max-1 + DO la = la_start, la_max - 1 DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay coa = coset(ax, ay, az) - coax = coset(ax+1, ay, az) - coay = coset(ax, ay+1, az) - coaz = coset(ax, ay, az+1) + coax = coset(ax + 1, ay, az) + coay = coset(ax, ay + 1, az) + coaz = coset(ax, ay, az + 1) ! *** Shift of angular momentum *** ! *** component z from a to b *** s(coa, coset(0, 0, lb), coc) = & - s(coaz, coset(0, 0, lb-1), coc)- & - rab(3)*s(coa, coset(0, 0, lb-1), coc) + s(coaz, coset(0, 0, lb - 1), coc) - & + rab(3)*s(coa, coset(0, 0, lb - 1), coc) ! *** Shift of angular momentum *** ! *** component y from a to b *** DO by = 1, lb - bz = lb-by + bz = lb - by s(coa, coset(0, by, bz), coc) = & - s(coay, coset(0, by-1, bz), coc)- & - rab(2)*s(coa, coset(0, by-1, bz), coc) + s(coay, coset(0, by - 1, bz), coc) - & + rab(2)*s(coa, coset(0, by - 1, bz), coc) END DO ! *** Shift of angular momentum *** ! *** component x from a to b *** DO bx = 1, lb - DO by = 0, lb-bx - bz = lb-bx-by + DO by = 0, lb - bx + bz = lb - bx - by s(coa, coset(bx, by, bz), coc) = & - s(coax, coset(bx-1, by, bz), coc)- & - rab(1)*s(coa, coset(bx-1, by, bz), coc) + s(coax, coset(bx - 1, by, bz), coc) - & + rab(1)*s(coa, coset(bx - 1, by, bz), coc) END DO END DO @@ -796,64 +796,64 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & DO ax = 0, la_max fx = f2*REAL(ax, dp) - DO ay = 0, la_max-ax + DO ay = 0, la_max - ax fy = f2*REAL(ay, dp) - az = la_max-ax-ay + az = la_max - ax - ay fz = f2*REAL(az, dp) coa = coset(ax, ay, az) - coax = coset(MAX(0, ax-1), ay, az) - coay = coset(ax, MAX(0, ay-1), az) - coaz = coset(ax, ay, MAX(0, az-1)) + coax = coset(MAX(0, ax - 1), ay, az) + coay = coset(ax, MAX(0, ay - 1), az) + coaz = coset(ax, ay, MAX(0, az - 1)) - f3 = f2*REAL(lb-1, dp) + f3 = f2*REAL(lb - 1, dp) ! *** Shift of angular momentum *** ! *** component z from a to b *** IF (az == 0) THEN s(coa, coset(0, 0, lb), coc) = & - rbg(3)*s(coa, coset(0, 0, lb-1), coc)+ & - f3*s(coa, coset(0, 0, lb-2), coc)+ & - fcz*s(coa, coset(0, 0, lb-1), cocz) + rbg(3)*s(coa, coset(0, 0, lb - 1), coc) + & + f3*s(coa, coset(0, 0, lb - 2), coc) + & + fcz*s(coa, coset(0, 0, lb - 1), cocz) ELSE s(coa, coset(0, 0, lb), coc) = & - rbg(3)*s(coa, coset(0, 0, lb-1), coc)+ & - fz*s(coaz, coset(0, 0, lb-1), coc)+ & - f3*s(coa, coset(0, 0, lb-2), coc)+ & - fcz*s(coa, coset(0, 0, lb-1), cocz) + rbg(3)*s(coa, coset(0, 0, lb - 1), coc) + & + fz*s(coaz, coset(0, 0, lb - 1), coc) + & + f3*s(coa, coset(0, 0, lb - 2), coc) + & + fcz*s(coa, coset(0, 0, lb - 1), cocz) END IF ! *** Shift of angular momentum *** ! *** component y from a to b *** IF (ay == 0) THEN - bz = lb-1 + bz = lb - 1 s(coa, coset(0, 1, bz), coc) = & - rbg(2)*s(coa, coset(0, 0, bz), coc)+ & + rbg(2)*s(coa, coset(0, 0, bz), coc) + & fcy*s(coa, coset(0, 0, bz), cocy) DO by = 2, lb - bz = lb-by - f3 = f2*REAL(by-1, dp) + bz = lb - by + f3 = f2*REAL(by - 1, dp) s(coa, coset(0, by, bz), coc) = & - rbg(2)*s(coa, coset(0, by-1, bz), coc)+ & - f3*s(coa, coset(0, by-2, bz), coc)+ & - fcy*s(coa, coset(0, by-1, bz), cocy) + rbg(2)*s(coa, coset(0, by - 1, bz), coc) + & + f3*s(coa, coset(0, by - 2, bz), coc) + & + fcy*s(coa, coset(0, by - 1, bz), cocy) END DO ELSE - bz = lb-1 + bz = lb - 1 s(coa, coset(0, 1, bz), coc) = & - rbg(2)*s(coa, coset(0, 0, bz), coc)+ & - fy*s(coay, coset(0, 0, bz), coc)+ & + rbg(2)*s(coa, coset(0, 0, bz), coc) + & + fy*s(coay, coset(0, 0, bz), coc) + & fcy*s(coa, coset(0, 0, bz), cocy) DO by = 2, lb - bz = lb-by - f3 = f2*REAL(by-1, dp) + bz = lb - by + f3 = f2*REAL(by - 1, dp) s(coa, coset(0, by, bz), coc) = & - rbg(2)*s(coa, coset(0, by-1, bz), coc)+ & - fy*s(coay, coset(0, by-1, bz), coc)+ & - f3*s(coa, coset(0, by-2, bz), coc)+ & - fcy*s(coa, coset(0, by-1, bz), cocy) + rbg(2)*s(coa, coset(0, by - 1, bz), coc) + & + fy*s(coay, coset(0, by - 1, bz), coc) + & + f3*s(coa, coset(0, by - 2, bz), coc) + & + fcy*s(coa, coset(0, by - 1, bz), cocy) END DO END IF @@ -861,39 +861,39 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & ! *** component x from a to b *** IF (ax == 0) THEN - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by s(coa, coset(1, by, bz), coc) = & - rbg(1)*s(coa, coset(0, by, bz), coc)+ & + rbg(1)*s(coa, coset(0, by, bz), coc) + & fcx*s(coa, coset(0, by, bz), cocx) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by s(coa, coset(bx, by, bz), coc) = & - rbg(1)*s(coa, coset(bx-1, by, bz), coc)+ & - f3*s(coa, coset(bx-2, by, bz), coc)+ & - fcx*s(coa, coset(bx-1, by, bz), cocx) + rbg(1)*s(coa, coset(bx - 1, by, bz), coc) + & + f3*s(coa, coset(bx - 2, by, bz), coc) + & + fcx*s(coa, coset(bx - 1, by, bz), cocx) END DO END DO ELSE - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by s(coa, coset(1, by, bz), coc) = & - rbg(1)*s(coa, coset(0, by, bz), coc)+ & - fx*s(coax, coset(0, by, bz), coc)+ & + rbg(1)*s(coa, coset(0, by, bz), coc) + & + fx*s(coax, coset(0, by, bz), coc) + & fcx*s(coa, coset(0, by, bz), cocx) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by s(coa, coset(bx, by, bz), coc) = & - rbg(1)*s(coa, coset(bx-1, by, bz), coc)+ & - fx*s(coax, coset(bx-1, by, bz), coc)+ & - f3*s(coa, coset(bx-2, by, bz), coc)+ & - fcx*s(coa, coset(bx-1, by, bz), cocx) + rbg(1)*s(coa, coset(bx - 1, by, bz), coc) + & + fx*s(coax, coset(bx - 1, by, bz), coc) + & + f3*s(coa, coset(bx - 2, by, bz), coc) + & + fcx*s(coa, coset(bx - 1, by, bz), cocx) END DO END DO END IF @@ -911,13 +911,13 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & ! *** Vertical recurrence steps: [s|c|s] -> [s|c|b] *** - rbg(:) = rcg(:)+rbc(:) + rbg(:) = rcg(:) + rbc(:) ! *** [s|c|p] = (Gi - Bi)*[s|c|s] + f2*Ni(c)*[s|c-1i|s] *** - s(1, 2, coc) = rbg(1)*s(1, 1, coc)+fcx*s(1, 1, cocx) - s(1, 3, coc) = rbg(2)*s(1, 1, coc)+fcy*s(1, 1, cocy) - s(1, 4, coc) = rbg(3)*s(1, 1, coc)+fcz*s(1, 1, cocz) + s(1, 2, coc) = rbg(1)*s(1, 1, coc) + fcx*s(1, 1, cocx) + s(1, 3, coc) = rbg(2)*s(1, 1, coc) + fcy*s(1, 1, cocy) + s(1, 4, coc) = rbg(3)*s(1, 1, coc) + fcz*s(1, 1, cocz) ! *** [s|c|b] = (Gi - Bi)*[s|c|b-1i] + *** ! *** f2*Ni(b-1i)*[s|c|b-2i] *** @@ -928,42 +928,42 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & ! *** Increase the angular momentum component z of b *** s(1, coset(0, 0, lb), coc) = & - rbg(3)*s(1, coset(0, 0, lb-1), coc)+ & - f2*REAL(lb-1, dp)*s(1, coset(0, 0, lb-2), coc)+ & - fcz*s(1, coset(0, 0, lb-1), cocz) + rbg(3)*s(1, coset(0, 0, lb - 1), coc) + & + f2*REAL(lb - 1, dp)*s(1, coset(0, 0, lb - 2), coc) + & + fcz*s(1, coset(0, 0, lb - 1), cocz) ! *** Increase the angular momentum component y of b *** - bz = lb-1 + bz = lb - 1 s(1, coset(0, 1, bz), coc) = & - rbg(2)*s(1, coset(0, 0, bz), coc)+ & + rbg(2)*s(1, coset(0, 0, bz), coc) + & fcy*s(1, coset(0, 0, bz), cocy) DO by = 2, lb - bz = lb-by + bz = lb - by s(1, coset(0, by, bz), coc) = & - rbg(2)*s(1, coset(0, by-1, bz), coc)+ & - f2*REAL(by-1, dp)*s(1, coset(0, by-2, bz), coc)+ & - fcy*s(1, coset(0, by-1, bz), cocy) + rbg(2)*s(1, coset(0, by - 1, bz), coc) + & + f2*REAL(by - 1, dp)*s(1, coset(0, by - 2, bz), coc) + & + fcy*s(1, coset(0, by - 1, bz), cocy) END DO ! *** Increase the angular momentum component x of b *** - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by s(1, coset(1, by, bz), coc) = & - rbg(1)*s(1, coset(0, by, bz), coc)+ & + rbg(1)*s(1, coset(0, by, bz), coc) + & fcx*s(1, coset(0, by, bz), cocx) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by s(1, coset(bx, by, bz), coc) = & - rbg(1)*s(1, coset(bx-1, by, bz), coc)+ & - f3*s(1, coset(bx-2, by, bz), coc)+ & - fcx*s(1, coset(bx-1, by, bz), cocx) + rbg(1)*s(1, coset(bx - 1, by, bz), coc) + & + f3*s(1, coset(bx - 2, by, bz), coc) + & + fcx*s(1, coset(bx - 1, by, bz), cocx) END DO END DO @@ -982,10 +982,10 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & ! *** Store integrals - DO k = ncoset(lc_min_set-1)+1, ncoset(lc_max_set) - DO j = ncoset(lb_min_set-1)+1, ncoset(lb_max_set) - DO i = ncoset(la_min_set-1)+1, ncoset(la_max_set) - sabc(na+i, nb+j, nc+k) = s(i, j, k) + DO k = ncoset(lc_min_set - 1) + 1, ncoset(lc_max_set) + DO j = ncoset(lb_min_set - 1) + 1, ncoset(lb_max_set) + DO i = ncoset(la_min_set - 1) + 1, ncoset(la_max_set) + sabc(na + i, nb + j, nc + k) = s(i, j, k) END DO END DO END DO @@ -1006,7 +1006,7 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & DO l = 1, ncoset(lc_max_set) DO j = 1, ncoset(lb_max_set) DO i = 1, ncoset(la_max_set) - sdabc(nda+i, nb+j, nc+l, k) = sda(i, j, l, k) + sdabc(nda + i, nb + j, nc + l, k) = sda(i, j, l, k) END DO END DO ENDDO @@ -1018,22 +1018,22 @@ SUBROUTINE overlap3(la_max_set, npgfa, zeta, rpgfa, la_min_set, & DO l = 1, ncoset(lc_max_set) DO j = 1, ncoset(lb_max_set) DO i = 1, ncoset(la_max_set) - sabdc(na+i, nb+j, ndc+l, k) = sdc(i, j, l, k) + sabdc(na + i, nb + j, ndc + l, k) = sdc(i, j, l, k) END DO END DO ENDDO END DO END IF - nc = nc+ncoset(lc_max_set) - ndc = ndc+ncoset(lc_max_set) + nc = nc + ncoset(lc_max_set) + ndc = ndc + ncoset(lc_max_set) END DO - nb = nb+ncoset(lb_max) + nb = nb + ncoset(lb_max) END DO - na = na+ncoset(la_max_set) - nda = nda+ncoset(la_max_set) + na = na + ncoset(la_max_set) + nda = nda + ncoset(la_max_set) END DO DEALLOCATE (s) @@ -1097,50 +1097,50 @@ SUBROUTINE derivatives_overlap3(la_max_set, la_min_set, lb_max_set, lb_min_set, DO la = la_min_set, la_max_set DO ax = 0, la fax = REAL(ax, dp) - DO ay = 0, la-ax + DO ay = 0, la - ax fay = REAL(ay, dp) - az = la-ax-ay + az = la - ax - ay faz = REAL(az, dp) coa = coset(ax, ay, az) - coamx = coset(ax-1, ay, az) - coamy = coset(ax, ay-1, az) - coamz = coset(ax, ay, az-1) - coapx = coset(ax+1, ay, az) - coapy = coset(ax, ay+1, az) - coapz = coset(ax, ay, az+1) + coamx = coset(ax - 1, ay, az) + coamy = coset(ax, ay - 1, az) + coamz = coset(ax, ay, az - 1) + coapx = coset(ax + 1, ay, az) + coapy = coset(ax, ay + 1, az) + coapz = coset(ax, ay, az + 1) DO lb = lb_min_set, lb_max_set DO bx = 0, lb - DO by = 0, lb-bx - bz = lb-bx-by + DO by = 0, lb - bx + bz = lb - bx - by cob = coset(bx, by, bz) DO lc = lc_min_set, lc_max_set DO cx = 0, lc fcx = REAL(cx, dp) - DO cy = 0, lc-cx + DO cy = 0, lc - cx fcy = REAL(cy, dp) - cz = lc-cx-cy + cz = lc - cx - cy fcz = REAL(cz, dp) coc = coset(cx, cy, cz) - cocmx = coset(cx-1, cy, cz) - cocmy = coset(cx, cy-1, cz) - cocmz = coset(cx, cy, cz-1) - cocpx = coset(cx+1, cy, cz) - cocpy = coset(cx, cy+1, cz) - cocpz = coset(cx, cy, cz+1) + cocmx = coset(cx - 1, cy, cz) + cocmy = coset(cx, cy - 1, cz) + cocmz = coset(cx, cy, cz - 1) + cocpx = coset(cx + 1, cy, cz) + cocpy = coset(cx, cy + 1, cz) + cocpz = coset(cx, cy, cz + 1) IF (ASSOCIATED(sda)) THEN - sda(coa, cob, coc, devx) = fexpa*s(coapx, cob, coc)- & + sda(coa, cob, coc, devx) = fexpa*s(coapx, cob, coc) - & fax*s(coamx, cob, coc) - sda(coa, cob, coc, devy) = fexpa*s(coapy, cob, coc)- & + sda(coa, cob, coc, devy) = fexpa*s(coapy, cob, coc) - & fay*s(coamy, cob, coc) - sda(coa, cob, coc, devz) = fexpa*s(coapz, cob, coc)- & + sda(coa, cob, coc, devz) = fexpa*s(coapz, cob, coc) - & faz*s(coamz, cob, coc) ENDIF IF (ASSOCIATED(sdc)) THEN - sdc(coa, cob, coc, devx) = fexpc*s(coa, cob, cocpx)- & + sdc(coa, cob, coc, devx) = fexpc*s(coa, cob, cocpx) - & fcx*s(coa, cob, cocmx) - sdc(coa, cob, coc, devy) = fexpc*s(coa, cob, cocpy)- & + sdc(coa, cob, coc, devy) = fexpc*s(coa, cob, cocpy) - & fcy*s(coa, cob, cocmy) - sdc(coa, cob, coc, devz) = fexpc*s(coa, cob, cocpz)- & + sdc(coa, cob, coc, devz) = fexpc*s(coa, cob, cocpz) - & fcz*s(coa, cob, cocmz) ENDIF ENDDO diff --git a/src/aobasis/ai_overlap3_debug.F b/src/aobasis/ai_overlap3_debug.F index db7c97d7d6..5d21182c07 100644 --- a/src/aobasis/ai_overlap3_debug.F +++ b/src/aobasis/ai_overlap3_debug.F @@ -56,16 +56,16 @@ SUBROUTINE init_os_overlap3(ya, yb, yc, rA, rB, rC) B = rB C = rC - xsi = xa+xb + xsi = xa + xb zeta = xa*xb/xsi - P = (xa*A+xb*B)/xsi - G = (xsi*P+xc*C)/(xsi+xc) + P = (xa*A + xb*B)/xsi + G = (xsi*P + xc*C)/(xsi + xc) - ss = (pi/xsi)**(3._dp/2._dp)*EXP(-zeta*SUM((A-B)**2)) + ss = (pi/xsi)**(3._dp/2._dp)*EXP(-zeta*SUM((A - B)**2)) - fpc = EXP(-xsi*xc/(xsi+xc)*SUM((P-C)**2)) - sss = (xsi/(xsi+xc))**(3._dp/2._dp)*ss*fpc + fpc = EXP(-xsi*xc/(xsi + xc)*SUM((P - C)**2)) + sss = (xsi/(xsi + xc))**(3._dp/2._dp)*ss*fpc END SUBROUTINE init_os_overlap3 @@ -90,34 +90,34 @@ RECURSIVE FUNCTION os_overlap3(an, cn, bn) RESULT(IACB) IF (ANY(bn < 0)) RETURN IF (ANY(cn < 0)) RETURN - IF (SUM(an+cn+bn) == 0) THEN + IF (SUM(an + cn + bn) == 0) THEN IACB = sss RETURN END IF IF (bn(1) > 0) THEN - IACB = os_overlap3(an, cn+i1, bn-i1)+(C(1)-B(1))*os_overlap3(an, cn, bn-i1) + IACB = os_overlap3(an, cn + i1, bn - i1) + (C(1) - B(1))*os_overlap3(an, cn, bn - i1) ELSEIF (bn(2) > 0) THEN - IACB = os_overlap3(an, cn+i2, bn-i2)+(C(2)-B(2))*os_overlap3(an, cn, bn-i2) + IACB = os_overlap3(an, cn + i2, bn - i2) + (C(2) - B(2))*os_overlap3(an, cn, bn - i2) ELSEIF (bn(3) > 0) THEN - IACB = os_overlap3(an, cn+i3, bn-i3)+(C(3)-B(3))*os_overlap3(an, cn, bn-i3) + IACB = os_overlap3(an, cn + i3, bn - i3) + (C(3) - B(3))*os_overlap3(an, cn, bn - i3) ELSE IF (cn(1) > 0) THEN - IACB = os_overlap3(an+i1, cn-i1, bn)+(A(1)-C(1))*os_overlap3(an, cn-i1, bn) + IACB = os_overlap3(an + i1, cn - i1, bn) + (A(1) - C(1))*os_overlap3(an, cn - i1, bn) ELSEIF (cn(2) > 0) THEN - IACB = os_overlap3(an+i2, cn-i2, bn)+(A(2)-C(2))*os_overlap3(an, cn-i2, bn) + IACB = os_overlap3(an + i2, cn - i2, bn) + (A(2) - C(2))*os_overlap3(an, cn - i2, bn) ELSEIF (cn(3) > 0) THEN - IACB = os_overlap3(an+i3, cn-i3, bn)+(A(3)-C(3))*os_overlap3(an, cn-i3, bn) + IACB = os_overlap3(an + i3, cn - i3, bn) + (A(3) - C(3))*os_overlap3(an, cn - i3, bn) ELSE IF (an(1) > 0) THEN - IACB = (G(1)-A(1))*os_overlap3(an-i1, cn, bn)+ & - 0.5_dp*(an(1)-1)/(xsi+xc)*os_overlap3(an-i1-i1, cn, bn) + IACB = (G(1) - A(1))*os_overlap3(an - i1, cn, bn) + & + 0.5_dp*(an(1) - 1)/(xsi + xc)*os_overlap3(an - i1 - i1, cn, bn) ELSEIF (an(2) > 0) THEN - IACB = (G(2)-A(2))*os_overlap3(an-i2, cn, bn)+ & - 0.5_dp*(an(2)-1)/(xsi+xc)*os_overlap3(an-i2-i2, cn, bn) + IACB = (G(2) - A(2))*os_overlap3(an - i2, cn, bn) + & + 0.5_dp*(an(2) - 1)/(xsi + xc)*os_overlap3(an - i2 - i2, cn, bn) ELSEIF (an(3) > 0) THEN - IACB = (G(3)-A(3))*os_overlap3(an-i3, cn, bn)+ & - 0.5_dp*(an(3)-1)/(xsi+xc)*os_overlap3(an-i3-i3, cn, bn) + IACB = (G(3) - A(3))*os_overlap3(an - i3, cn, bn) + & + 0.5_dp*(an(3) - 1)/(xsi + xc)*os_overlap3(an - i3 - i3, cn, bn) ELSE CPABORT("I(0000)") ENDIF diff --git a/src/aobasis/ai_overlap_aabb.F b/src/aobasis/ai_overlap_aabb.F index 845f124cf3..174a7314db 100644 --- a/src/aobasis/ai_overlap_aabb.F +++ b/src/aobasis/ai_overlap_aabb.F @@ -123,8 +123,8 @@ SUBROUTINE overlap_aabb(la_max_set1, la_min_set1, npgfa1, rpgfa1, zeta1, & IF (asets_equal) THEN jpgf_start = ipgf - DO i = 1, jpgf_start-1 - ncoa2 = ncoa2+ncoset(la_max_set2) + DO i = 1, jpgf_start - 1 + ncoa2 = ncoa2 + ncoset(la_max_set2) ENDDO ELSE jpgf_start = 1 @@ -133,9 +133,9 @@ SUBROUTINE overlap_aabb(la_max_set1, la_min_set1, npgfa1, rpgfa1, zeta1, & DO jpgf = jpgf_start, npgfa2 ncob1 = 0 - zeta = zeta1(ipgf)+zeta2(jpgf) - la_max = la_max_set1+la_max_set2 - la_min = la_min_set1+la_min_set2 + zeta = zeta1(ipgf) + zeta2(jpgf) + la_max = la_max_set1 + la_max_set2 + la_min = la_min_set1 + la_min_set2 DO kpgf = 1, npgfb1 @@ -143,8 +143,8 @@ SUBROUTINE overlap_aabb(la_max_set1, la_min_set1, npgfa1, rpgfa1, zeta1, & IF (bsets_equal) THEN lpgf_start = kpgf - DO i = 1, lpgf_start-1 - ncob2 = ncob2+ncoset(lb_max_set2) + DO i = 1, lpgf_start - 1 + ncob2 = ncob2 + ncoset(lb_max_set2) ENDDO ELSE lpgf_start = 1 @@ -153,37 +153,37 @@ SUBROUTINE overlap_aabb(la_max_set1, la_min_set1, npgfa1, rpgfa1, zeta1, & DO lpgf = lpgf_start, npgfb2 ! *** Screening *** - IF ((rpgfa1(ipgf)+rpgfb1(kpgf) < dab) .OR. & - (rpgfa2(jpgf)+rpgfb1(kpgf) < dab) .OR. & - (rpgfa1(ipgf)+rpgfb2(lpgf) < dab) .OR. & - (rpgfa2(jpgf)+rpgfb2(lpgf) < dab)) THEN - DO jb = ncoset(lb_min_set2-1)+1, ncoset(lb_max_set2) - DO ib = ncoset(lb_min_set1-1)+1, ncoset(lb_max_set1) - DO ja = ncoset(la_min_set2-1)+1, ncoset(la_max_set2) - DO ia = ncoset(la_min_set1-1)+1, ncoset(la_max_set1) - saabb(ncoa1+ia, ncoa2+ja, ncob1+ib, ncob2+jb) = 0._dp - IF (asets_equal) saabb(ncoa2+ja, ncoa1+ia, ncob1+ib, ncob2+jb) = 0._dp - IF (bsets_equal) saabb(ncoa1+ia, ncoa2+ja, ncob2+jb, ncob1+ib) = 0._dp + IF ((rpgfa1(ipgf) + rpgfb1(kpgf) < dab) .OR. & + (rpgfa2(jpgf) + rpgfb1(kpgf) < dab) .OR. & + (rpgfa1(ipgf) + rpgfb2(lpgf) < dab) .OR. & + (rpgfa2(jpgf) + rpgfb2(lpgf) < dab)) THEN + DO jb = ncoset(lb_min_set2 - 1) + 1, ncoset(lb_max_set2) + DO ib = ncoset(lb_min_set1 - 1) + 1, ncoset(lb_max_set1) + DO ja = ncoset(la_min_set2 - 1) + 1, ncoset(la_max_set2) + DO ia = ncoset(la_min_set1 - 1) + 1, ncoset(la_max_set1) + saabb(ncoa1 + ia, ncoa2 + ja, ncob1 + ib, ncob2 + jb) = 0._dp + IF (asets_equal) saabb(ncoa2 + ja, ncoa1 + ia, ncob1 + ib, ncob2 + jb) = 0._dp + IF (bsets_equal) saabb(ncoa1 + ia, ncoa2 + ja, ncob2 + jb, ncob1 + ib) = 0._dp IF (asets_equal .AND. bsets_equal) THEN - saabb(ncoa2+ja, ncoa1+ia, ncob1+ib, ncob2+jb) = 0._dp - saabb(ncoa1+ia, ncoa2+ja, ncob2+jb, ncob1+ib) = 0._dp - saabb(ncoa2+ja, ncoa1+ia, ncob2+jb, ncob1+ib) = 0._dp + saabb(ncoa2 + ja, ncoa1 + ia, ncob1 + ib, ncob2 + jb) = 0._dp + saabb(ncoa1 + ia, ncoa2 + ja, ncob2 + jb, ncob1 + ib) = 0._dp + saabb(ncoa2 + ja, ncoa1 + ia, ncob2 + jb, ncob1 + ib) = 0._dp ENDIF ENDDO ENDDO ENDDO ENDDO - ncob2 = ncob2+ncoset(lb_max_set2) + ncob2 = ncob2 + ncoset(lb_max_set2) CYCLE END IF - zetb = zetb1(kpgf)+zetb2(lpgf) - lb_max = lb_max_set1+lb_max_set2 - lb_min = lb_min_set1+lb_min_set2 + zetb = zetb1(kpgf) + zetb2(lpgf) + lb_max = lb_max_set1 + lb_max_set2 + lb_min = lb_min_set1 + lb_min_set2 ! *** Calculate some prefactors *** - zetp = 1.0_dp/(zeta+zetb) + zetp = 1.0_dp/(zeta + zetb) f0 = SQRT((pi*zetp)**3) f1 = zetb*zetp @@ -213,12 +213,12 @@ SUBROUTINE overlap_aabb(la_max_set1, la_min_set1, npgfa1, rpgfa1, zeta1, & f3 = f2*s(1, 1) - s(5, 1) = rap(1)*s(2, 1)+f3 ! [dx2|s] + s(5, 1) = rap(1)*s(2, 1) + f3 ! [dx2|s] s(6, 1) = rap(1)*s(3, 1) ! [dxy|s] s(7, 1) = rap(1)*s(4, 1) ! [dxz|s] - s(8, 1) = rap(2)*s(3, 1)+f3 ! [dy2|s] + s(8, 1) = rap(2)*s(3, 1) + f3 ! [dy2|s] s(9, 1) = rap(2)*s(4, 1) ! [dyz|s] - s(10, 1) = rap(3)*s(4, 1)+f3 ! [dz2|s] + s(10, 1) = rap(3)*s(4, 1) + f3 ! [dz2|s] IF (la_max > 2) THEN @@ -226,16 +226,16 @@ SUBROUTINE overlap_aabb(la_max_set1, la_min_set1, npgfa1, rpgfa1, zeta1, & f3 = 2.0_dp*f2 - s(11, 1) = rap(1)*s(5, 1)+f3*s(2, 1) ! [fx3 |s] - s(12, 1) = rap(1)*s(6, 1)+f2*s(3, 1) ! [fx2y|s] - s(13, 1) = rap(1)*s(7, 1)+f2*s(4, 1) ! [fx2z|s] + s(11, 1) = rap(1)*s(5, 1) + f3*s(2, 1) ! [fx3 |s] + s(12, 1) = rap(1)*s(6, 1) + f2*s(3, 1) ! [fx2y|s] + s(13, 1) = rap(1)*s(7, 1) + f2*s(4, 1) ! [fx2z|s] s(14, 1) = rap(1)*s(8, 1) ! [fxy2|s] s(15, 1) = rap(1)*s(9, 1) ! [fxyz|s] s(16, 1) = rap(1)*s(10, 1) ! [fxz2|s] - s(17, 1) = rap(2)*s(8, 1)+f3*s(3, 1) ! [fy3 |s] - s(18, 1) = rap(2)*s(9, 1)+f2*s(4, 1) ! [fy2z|s] + s(17, 1) = rap(2)*s(8, 1) + f3*s(3, 1) ! [fy3 |s] + s(18, 1) = rap(2)*s(9, 1) + f2*s(4, 1) ! [fy2z|s] s(19, 1) = rap(2)*s(10, 1) ! [fyz2|s] - s(20, 1) = rap(3)*s(10, 1)+f3*s(4, 1) ! [fz3 |s] + s(20, 1) = rap(3)*s(10, 1) + f3*s(4, 1) ! [fz3 |s] IF (la_max > 3) THEN @@ -243,21 +243,21 @@ SUBROUTINE overlap_aabb(la_max_set1, la_min_set1, npgfa1, rpgfa1, zeta1, & f4 = 3.0_dp*f2 - s(21, 1) = rap(1)*s(11, 1)+f4*s(5, 1) ! [gx4 |s] - s(22, 1) = rap(1)*s(12, 1)+f3*s(6, 1) ! [gx3y |s] - s(23, 1) = rap(1)*s(13, 1)+f3*s(7, 1) ! [gx3z |s] - s(24, 1) = rap(1)*s(14, 1)+f2*s(8, 1) ! [gx2y2|s] - s(25, 1) = rap(1)*s(15, 1)+f2*s(9, 1) ! [gx2yz|s] - s(26, 1) = rap(1)*s(16, 1)+f2*s(10, 1) ! [gx2z2|s] + s(21, 1) = rap(1)*s(11, 1) + f4*s(5, 1) ! [gx4 |s] + s(22, 1) = rap(1)*s(12, 1) + f3*s(6, 1) ! [gx3y |s] + s(23, 1) = rap(1)*s(13, 1) + f3*s(7, 1) ! [gx3z |s] + s(24, 1) = rap(1)*s(14, 1) + f2*s(8, 1) ! [gx2y2|s] + s(25, 1) = rap(1)*s(15, 1) + f2*s(9, 1) ! [gx2yz|s] + s(26, 1) = rap(1)*s(16, 1) + f2*s(10, 1) ! [gx2z2|s] s(27, 1) = rap(1)*s(17, 1) ! [gxy3 |s] s(28, 1) = rap(1)*s(18, 1) ! [gxy2z|s] s(29, 1) = rap(1)*s(19, 1) ! [gxyz2|s] s(30, 1) = rap(1)*s(20, 1) ! [gxz3 |s] - s(31, 1) = rap(2)*s(17, 1)+f4*s(8, 1) ! [gy4 |s] - s(32, 1) = rap(2)*s(18, 1)+f3*s(9, 1) ! [gy3z |s] - s(33, 1) = rap(2)*s(19, 1)+f2*s(10, 1) ! [gy2z2|s] + s(31, 1) = rap(2)*s(17, 1) + f4*s(8, 1) ! [gy4 |s] + s(32, 1) = rap(2)*s(18, 1) + f3*s(9, 1) ! [gy3z |s] + s(33, 1) = rap(2)*s(19, 1) + f2*s(10, 1) ! [gy2z2|s] s(34, 1) = rap(2)*s(20, 1) ! [gyz3 |s] - s(35, 1) = rap(3)*s(20, 1)+f4*s(10, 1) ! [gz4 |s] + s(35, 1) = rap(3)*s(20, 1) + f4*s(10, 1) ! [gz4 |s] ! *** [a|s] = (Pi - Ai)*[a-1i|s] + f2*Ni(a-1i)*[a-2i|s] *** @@ -266,33 +266,33 @@ SUBROUTINE overlap_aabb(la_max_set1, la_min_set1, npgfa1, rpgfa1, zeta1, & ! *** Increase the angular momentum component z of a *** s(coset(0, 0, la), 1) = & - rap(3)*s(coset(0, 0, la-1), 1)+ & - f2*REAL(la-1, dp)*s(coset(0, 0, la-2), 1) + rap(3)*s(coset(0, 0, la - 1), 1) + & + f2*REAL(la - 1, dp)*s(coset(0, 0, la - 2), 1) ! *** Increase the angular momentum component y of a *** - az = la-1 + az = la - 1 s(coset(0, 1, az), 1) = rap(2)*s(coset(0, 0, az), 1) DO ay = 2, la - az = la-ay + az = la - ay s(coset(0, ay, az), 1) = & - rap(2)*s(coset(0, ay-1, az), 1)+ & - f2*REAL(ay-1, dp)*s(coset(0, ay-2, az), 1) + rap(2)*s(coset(0, ay - 1, az), 1) + & + f2*REAL(ay - 1, dp)*s(coset(0, ay - 2, az), 1) END DO ! *** Increase the angular momentum component x of a *** - DO ay = 0, la-1 - az = la-1-ay + DO ay = 0, la - 1 + az = la - 1 - ay s(coset(1, ay, az), 1) = rap(1)*s(coset(0, ay, az), 1) END DO DO ax = 2, la - f3 = f2*REAL(ax-1, dp) - DO ay = 0, la-ax - az = la-ax-ay + f3 = f2*REAL(ax - 1, dp) + DO ay = 0, la - ax + az = la - ax - ay s(coset(ax, ay, az), 1) = & - rap(1)*s(coset(ax-1, ay, az), 1)+ & - f3*s(coset(ax-2, ay, az), 1) + rap(1)*s(coset(ax - 1, ay, az), 1) + & + f3*s(coset(ax - 2, ay, az), 1) END DO END DO @@ -316,27 +316,27 @@ SUBROUTINE overlap_aabb(la_max_set1, la_min_set1, npgfa1, rpgfa1, zeta1, & ! *** Horizontal recurrence steps *** - rbp(:) = rap(:)-rab(:) + rbp(:) = rap(:) - rab(:) ! *** [a|p] = [a+1i|s] - (Bi - Ai)*[a|s] *** IF (lb_max == 1) THEN la_start = la_min ELSE - la_start = MAX(0, la_min-1) + la_start = MAX(0, la_min - 1) END IF - DO la = la_start, la_max-1 + DO la = la_start, la_max - 1 DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay coa = coset(ax, ay, az) - coapx = coset(ax+1, ay, az) - coapy = coset(ax, ay+1, az) - coapz = coset(ax, ay, az+1) - s(coa, 2) = s(coapx, 1)-rab(1)*s(coa, 1) - s(coa, 3) = s(coapy, 1)-rab(2)*s(coa, 1) - s(coa, 4) = s(coapz, 1)-rab(3)*s(coa, 1) + coapx = coset(ax + 1, ay, az) + coapy = coset(ax, ay + 1, az) + coapz = coset(ax, ay, az + 1) + s(coa, 2) = s(coapx, 1) - rab(1)*s(coa, 1) + s(coa, 3) = s(coapy, 1) - rab(2)*s(coa, 1) + s(coa, 4) = s(coapz, 1) - rab(3)*s(coa, 1) END DO END DO END DO @@ -347,17 +347,17 @@ SUBROUTINE overlap_aabb(la_max_set1, la_min_set1, npgfa1, rpgfa1, zeta1, & DO ax = 0, la_max fax = f2*REAL(ax, dp) - DO ay = 0, la_max-ax + DO ay = 0, la_max - ax fay = f2*REAL(ay, dp) - az = la_max-ax-ay + az = la_max - ax - ay faz = f2*REAL(az, dp) coa = coset(ax, ay, az) - coamx = coset(ax-1, ay, az) - coamy = coset(ax, ay-1, az) - coamz = coset(ax, ay, az-1) - s(coa, 2) = rbp(1)*s(coa, 1)+fax*s(coamx, 1) - s(coa, 3) = rbp(2)*s(coa, 1)+fay*s(coamy, 1) - s(coa, 4) = rbp(3)*s(coa, 1)+faz*s(coamz, 1) + coamx = coset(ax - 1, ay, az) + coamy = coset(ax, ay - 1, az) + coamz = coset(ax, ay, az - 1) + s(coa, 2) = rbp(1)*s(coa, 1) + fax*s(coamx, 1) + s(coa, 3) = rbp(2)*s(coa, 1) + fay*s(coamy, 1) + s(coa, 4) = rbp(3)*s(coa, 1) + faz*s(coamz, 1) END DO END DO @@ -372,41 +372,41 @@ SUBROUTINE overlap_aabb(la_max_set1, la_min_set1, npgfa1, rpgfa1, zeta1, & IF (lb == lb_max) THEN la_start = la_min ELSE - la_start = MAX(0, la_min-1) + la_start = MAX(0, la_min - 1) END IF - DO la = la_start, la_max-1 + DO la = la_start, la_max - 1 DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay coa = coset(ax, ay, az) - coapx = coset(ax+1, ay, az) - coapy = coset(ax, ay+1, az) - coapz = coset(ax, ay, az+1) + coapx = coset(ax + 1, ay, az) + coapy = coset(ax, ay + 1, az) + coapz = coset(ax, ay, az + 1) ! *** Shift of angular momentum component z from a to b *** cob = coset(0, 0, lb) - cobmz = coset(0, 0, lb-1) - s(coa, cob) = s(coapz, cobmz)-rab(3)*s(coa, cobmz) + cobmz = coset(0, 0, lb - 1) + s(coa, cob) = s(coapz, cobmz) - rab(3)*s(coa, cobmz) ! *** Shift of angular momentum component y from a to b *** DO by = 1, lb - bz = lb-by + bz = lb - by cob = coset(0, by, bz) - cobmy = coset(0, by-1, bz) - s(coa, cob) = s(coapy, cobmy)-rab(2)*s(coa, cobmy) + cobmy = coset(0, by - 1, bz) + s(coa, cob) = s(coapy, cobmy) - rab(2)*s(coa, cobmy) END DO ! *** Shift of angular momentum component x from a to b *** DO bx = 1, lb - DO by = 0, lb-bx - bz = lb-bx-by + DO by = 0, lb - bx + bz = lb - bx - by cob = coset(bx, by, bz) - cobmx = coset(bx-1, by, bz) - s(coa, cob) = s(coapx, cobmx)-rab(1)*s(coa, cobmx) + cobmx = coset(bx - 1, by, bz) + s(coa, cob) = s(coapx, cobmx) - rab(1)*s(coa, cobmx) END DO END DO @@ -421,61 +421,61 @@ SUBROUTINE overlap_aabb(la_max_set1, la_min_set1, npgfa1, rpgfa1, zeta1, & DO ax = 0, la_max fax = f2*REAL(ax, dp) - DO ay = 0, la_max-ax + DO ay = 0, la_max - ax fay = f2*REAL(ay, dp) - az = la_max-ax-ay + az = la_max - ax - ay faz = f2*REAL(az, dp) coa = coset(ax, ay, az) - coamx = coset(ax-1, ay, az) - coamy = coset(ax, ay-1, az) - coamz = coset(ax, ay, az-1) + coamx = coset(ax - 1, ay, az) + coamy = coset(ax, ay - 1, az) + coamz = coset(ax, ay, az - 1) ! *** Increase the angular momentum component z of b *** - f3 = f2*REAL(lb-1, dp) + f3 = f2*REAL(lb - 1, dp) cob = coset(0, 0, lb) - cobmz = coset(0, 0, lb-1) - cobm2z = coset(0, 0, lb-2) - s(coa, cob) = rbp(3)*s(coa, cobmz)+ & - faz*s(coamz, cobmz)+ & + cobmz = coset(0, 0, lb - 1) + cobm2z = coset(0, 0, lb - 2) + s(coa, cob) = rbp(3)*s(coa, cobmz) + & + faz*s(coamz, cobmz) + & f3*s(coa, cobm2z) ! *** Increase the angular momentum component y of b *** - bz = lb-1 + bz = lb - 1 cob = coset(0, 1, bz) cobmy = coset(0, 0, bz) - s(coa, cob) = rbp(2)*s(coa, cobmy)+ & + s(coa, cob) = rbp(2)*s(coa, cobmy) + & fay*s(coamy, cobmy) DO by = 2, lb - bz = lb-by - f3 = f2*REAL(by-1, dp) + bz = lb - by + f3 = f2*REAL(by - 1, dp) cob = coset(0, by, bz) - cobmy = coset(0, by-1, bz) - cobm2y = coset(0, by-2, bz) - s(coa, cob) = rbp(2)*s(coa, cobmy)+ & - fay*s(coamy, cobmy)+ & + cobmy = coset(0, by - 1, bz) + cobm2y = coset(0, by - 2, bz) + s(coa, cob) = rbp(2)*s(coa, cobmy) + & + fay*s(coamy, cobmy) + & f3*s(coa, cobm2y) END DO ! *** Increase the angular momentum component x of b *** - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by cob = coset(1, by, bz) cobmx = coset(0, by, bz) - s(coa, cob) = rbp(1)*s(coa, cobmx)+ & + s(coa, cob) = rbp(1)*s(coa, cobmx) + & fax*s(coamx, cobmx) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by cob = coset(bx, by, bz) - cobmx = coset(bx-1, by, bz) - cobm2x = coset(bx-2, by, bz) - s(coa, cob) = rbp(1)*s(coa, cobmx)+ & - fax*s(coamx, cobmx)+ & + cobmx = coset(bx - 1, by, bz) + cobm2x = coset(bx - 2, by, bz) + s(coa, cob) = rbp(1)*s(coa, cobmx) + & + fax*s(coamx, cobmx) + & f3*s(coa, cobm2x) END DO END DO @@ -493,7 +493,7 @@ SUBROUTINE overlap_aabb(la_max_set1, la_min_set1, npgfa1, rpgfa1, zeta1, & ! *** Vertical recurrence steps: [s|s] -> [s|b] *** - rbp(:) = (f1-1.0_dp)*rab(:) + rbp(:) = (f1 - 1.0_dp)*rab(:) ! *** [s|p] = (Pi - Bi)*[s|s] *** @@ -507,12 +507,12 @@ SUBROUTINE overlap_aabb(la_max_set1, la_min_set1, npgfa1, rpgfa1, zeta1, & f3 = f2*s(1, 1) - s(1, 5) = rbp(1)*s(1, 2)+f3 ! [s|dx2] + s(1, 5) = rbp(1)*s(1, 2) + f3 ! [s|dx2] s(1, 6) = rbp(1)*s(1, 3) ! [s|dxy] s(1, 7) = rbp(1)*s(1, 4) ! [s|dxz] - s(1, 8) = rbp(2)*s(1, 3)+f3 ! [s|dy2] + s(1, 8) = rbp(2)*s(1, 3) + f3 ! [s|dy2] s(1, 9) = rbp(2)*s(1, 4) ! [s|dyz] - s(1, 10) = rbp(3)*s(1, 4)+f3 ! [s|dz2] + s(1, 10) = rbp(3)*s(1, 4) + f3 ! [s|dz2] ! *** [s|b] = (Pi - Bi)*[s|b-1i] + f2*Ni(b-1i)*[s|b-2i] *** @@ -521,33 +521,33 @@ SUBROUTINE overlap_aabb(la_max_set1, la_min_set1, npgfa1, rpgfa1, zeta1, & ! *** Increase the angular momentum component z of b *** s(1, coset(0, 0, lb)) = & - rbp(3)*s(1, coset(0, 0, lb-1))+ & - f2*REAL(lb-1, dp)*s(1, coset(0, 0, lb-2)) + rbp(3)*s(1, coset(0, 0, lb - 1)) + & + f2*REAL(lb - 1, dp)*s(1, coset(0, 0, lb - 2)) ! *** Increase the angular momentum component y of b *** - bz = lb-1 + bz = lb - 1 s(1, coset(0, 1, bz)) = rbp(2)*s(1, coset(0, 0, bz)) DO by = 2, lb - bz = lb-by + bz = lb - by s(1, coset(0, by, bz)) = & - rbp(2)*s(1, coset(0, by-1, bz))+ & - f2*REAL(by-1, dp)*s(1, coset(0, by-2, bz)) + rbp(2)*s(1, coset(0, by - 1, bz)) + & + f2*REAL(by - 1, dp)*s(1, coset(0, by - 2, bz)) END DO ! *** Increase the angular momentum component x of b *** - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by s(1, coset(1, by, bz)) = rbp(1)*s(1, coset(0, by, bz)) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by s(1, coset(bx, by, bz)) = & - rbp(1)*s(1, coset(bx-1, by, bz))+ & - f3*s(1, coset(bx-2, by, bz)) + rbp(1)*s(1, coset(bx - 1, by, bz)) + & + f3*s(1, coset(bx - 2, by, bz)) END DO END DO @@ -560,29 +560,29 @@ SUBROUTINE overlap_aabb(la_max_set1, la_min_set1, npgfa1, rpgfa1, zeta1, & END IF ! *** Store the primitive overlap integrals *** - DO jb = ncoset(lb_min_set2-1)+1, ncoset(lb_max_set2) + DO jb = ncoset(lb_min_set2 - 1) + 1, ncoset(lb_max_set2) njb(1:3) = indco(1:3, jb) - DO ib = ncoset(lb_min_set1-1)+1, ncoset(lb_max_set1) + DO ib = ncoset(lb_min_set1 - 1) + 1, ncoset(lb_max_set1) nib(1:3) = indco(1:3, ib) - nbb(1:3) = nib+njb - DO ja = ncoset(la_min_set2-1)+1, ncoset(la_max_set2) + nbb(1:3) = nib + njb + DO ja = ncoset(la_min_set2 - 1) + 1, ncoset(la_max_set2) nja(1:3) = indco(1:3, ja) - DO ia = ncoset(la_min_set1-1)+1, ncoset(la_max_set1) + DO ia = ncoset(la_min_set1 - 1) + 1, ncoset(la_max_set1) nia(1:3) = indco(1:3, ia) - naa(1:3) = nia+nja + naa(1:3) = nia + nja ! now loop over all elements of s - DO j = ncoset(lb_min-1)+1, ncoset(lb_max) + DO j = ncoset(lb_min - 1) + 1, ncoset(lb_max) nb(1:3) = indco(1:3, j) - DO i = ncoset(la_min-1)+1, ncoset(la_max) + DO i = ncoset(la_min - 1) + 1, ncoset(la_max) na(1:3) = indco(1:3, i) IF (ALL(na == naa) .AND. ALL(nb == nbb)) THEN - saabb(ncoa1+ia, ncoa2+ja, ncob1+ib, ncob2+jb) = s(i, j) - IF (asets_equal) saabb(ncoa2+ja, ncoa1+ia, ncob1+ib, ncob2+jb) = s(i, j) - IF (bsets_equal) saabb(ncoa1+ia, ncoa2+ja, ncob2+jb, ncob1+ib) = s(i, j) + saabb(ncoa1 + ia, ncoa2 + ja, ncob1 + ib, ncob2 + jb) = s(i, j) + IF (asets_equal) saabb(ncoa2 + ja, ncoa1 + ia, ncob1 + ib, ncob2 + jb) = s(i, j) + IF (bsets_equal) saabb(ncoa1 + ia, ncoa2 + ja, ncob2 + jb, ncob1 + ib) = s(i, j) IF (asets_equal .AND. bsets_equal) THEN - saabb(ncoa2+ja, ncoa1+ia, ncob1+ib, ncob2+jb) = s(i, j) - saabb(ncoa1+ia, ncoa2+ja, ncob2+jb, ncob1+ib) = s(i, j) - saabb(ncoa2+ja, ncoa1+ia, ncob2+jb, ncob1+ib) = s(i, j) + saabb(ncoa2 + ja, ncoa1 + ia, ncob1 + ib, ncob2 + jb) = s(i, j) + saabb(ncoa1 + ia, ncoa2 + ja, ncob2 + jb, ncob1 + ib) = s(i, j) + saabb(ncoa2 + ja, ncoa1 + ia, ncob2 + jb, ncob1 + ib) = s(i, j) ENDIF ENDIF END DO @@ -592,19 +592,19 @@ SUBROUTINE overlap_aabb(la_max_set1, la_min_set1, npgfa1, rpgfa1, zeta1, & END DO END DO - ncob2 = ncob2+ncoset(lb_max_set2) + ncob2 = ncob2 + ncoset(lb_max_set2) END DO - ncob1 = ncob1+ncoset(lb_max_set1) + ncob1 = ncob1 + ncoset(lb_max_set1) END DO - ncoa2 = ncoa2+ncoset(la_max_set2) + ncoa2 = ncoa2 + ncoset(la_max_set2) END DO - ncoa1 = ncoa1+ncoset(la_max_set1) + ncoa1 = ncoa1 + ncoset(la_max_set1) END DO diff --git a/src/aobasis/ai_overlap_debug.F b/src/aobasis/ai_overlap_debug.F index b4383c1c16..eb67bb8399 100644 --- a/src/aobasis/ai_overlap_debug.F +++ b/src/aobasis/ai_overlap_debug.F @@ -50,12 +50,12 @@ SUBROUTINE init_os_overlap2(ya, yb, rA, rB) A = rA B = rB - xsi = xa+xb + xsi = xa + xb zeta = xa*xb/xsi - P = (xa*A+xb*B)/xsi + P = (xa*A + xb*B)/xsi - ss = (pi/xsi)**(3._dp/2._dp)*EXP(-zeta*SUM((A-B)**2)) + ss = (pi/xsi)**(3._dp/2._dp)*EXP(-zeta*SUM((A - B)**2)) END SUBROUTINE init_os_overlap2 @@ -78,27 +78,27 @@ RECURSIVE FUNCTION os_overlap2(an, bn) RESULT(IAB) IF (ANY(an < 0)) RETURN IF (ANY(bn < 0)) RETURN - IF (SUM(an+bn) == 0) THEN + IF (SUM(an + bn) == 0) THEN IAB = ss RETURN END IF IF (bn(1) > 0) THEN - IAB = os_overlap2(an+i1, bn-i1)+(A(1)-B(1))*os_overlap2(an, bn-i1) + IAB = os_overlap2(an + i1, bn - i1) + (A(1) - B(1))*os_overlap2(an, bn - i1) ELSEIF (bn(2) > 0) THEN - IAB = os_overlap2(an+i2, bn-i2)+(A(2)-B(2))*os_overlap2(an, bn-i2) + IAB = os_overlap2(an + i2, bn - i2) + (A(2) - B(2))*os_overlap2(an, bn - i2) ELSEIF (bn(3) > 0) THEN - IAB = os_overlap2(an+i3, bn-i3)+(A(3)-B(3))*os_overlap2(an, bn-i3) + IAB = os_overlap2(an + i3, bn - i3) + (A(3) - B(3))*os_overlap2(an, bn - i3) ELSE IF (an(1) > 0) THEN - IAB = (P(1)-A(1))*os_overlap2(an-i1, bn)+ & - 0.5_dp*(an(1)-1)/xsi*os_overlap2(an-i1-i1, bn) + IAB = (P(1) - A(1))*os_overlap2(an - i1, bn) + & + 0.5_dp*(an(1) - 1)/xsi*os_overlap2(an - i1 - i1, bn) ELSEIF (an(2) > 0) THEN - IAB = (P(2)-A(2))*os_overlap2(an-i2, bn)+ & - 0.5_dp*(an(2)-1)/xsi*os_overlap2(an-i2-i2, bn) + IAB = (P(2) - A(2))*os_overlap2(an - i2, bn) + & + 0.5_dp*(an(2) - 1)/xsi*os_overlap2(an - i2 - i2, bn) ELSEIF (an(3) > 0) THEN - IAB = (P(3)-A(3))*os_overlap2(an-i3, bn)+ & - 0.5_dp*(an(3)-1)/xsi*os_overlap2(an-i3-i3, bn) + IAB = (P(3) - A(3))*os_overlap2(an - i3, bn) + & + 0.5_dp*(an(3) - 1)/xsi*os_overlap2(an - i3 - i3, bn) ELSE CPABORT("I(0000)") ENDIF diff --git a/src/aobasis/ai_overlap_ppl.F b/src/aobasis/ai_overlap_ppl.F index a5a8eefbad..90a69fdc36 100644 --- a/src/aobasis/ai_overlap_ppl.F +++ b/src/aobasis/ai_overlap_ppl.F @@ -124,11 +124,11 @@ SUBROUTINE ppl_integral(la_max_set, la_min_set, npgfa, rpgfa, zeta, & CPASSERT(PRESENT(force_a)) CPASSERT(PRESENT(force_b)) CPASSERT(PRESENT(fs)) - mmax = la_max_set+lb_max_set+2 + mmax = la_max_set + lb_max_set + 2 force_a(:) = 0.0_dp force_b(:) = 0.0_dp ELSE - mmax = la_max_set+lb_max_set + mmax = la_max_set + lb_max_set END IF ALLOCATE (auxint(0:mmax, npgfa*npgfb)) @@ -138,14 +138,14 @@ SUBROUTINE ppl_integral(la_max_set, la_min_set, npgfa, rpgfa, zeta, & DO ipgf = 1, npgfa ! *** Screening *** - IF (rpgfa(ipgf)+rpgfc < dac) CYCLE + IF (rpgfa(ipgf) + rpgfc < dac) CYCLE DO jpgf = 1, npgfb ! *** Screening *** - IF ((rpgfb(jpgf)+rpgfc < dbc) .OR. & - (rpgfa(ipgf)+rpgfb(jpgf) < dab)) CYCLE - ij = (ipgf-1)*npgfb+jpgf - rho = zeta(ipgf)+zetb(jpgf) - pci(:) = -(zeta(ipgf)*rac(:)+zetb(jpgf)*rbc(:))/rho + IF ((rpgfb(jpgf) + rpgfc < dbc) .OR. & + (rpgfa(ipgf) + rpgfb(jpgf) < dab)) CYCLE + ij = (ipgf - 1)*npgfb + jpgf + rho = zeta(ipgf) + zetb(jpgf) + pci(:) = -(zeta(ipgf)*rac(:) + zetb(jpgf)*rbc(:))/rho sab = EXP(-(zeta(ipgf)*zetb(jpgf)/rho*dab*dab)) t = rho*SUM(pci(:)*pci(:)) @@ -224,7 +224,7 @@ SUBROUTINE ppl_integral_ri(la_max_set, la_min_set, npgfa, rpgfa, zeta, & debug = .FALSE. IF (PRESENT(dva)) THEN - mmax = la_max_set+1 + mmax = la_max_set + 1 ELSE mmax = la_max_set END IF @@ -234,7 +234,7 @@ SUBROUTINE ppl_integral_ri(la_max_set, la_min_set, npgfa, rpgfa, zeta, & ! *** Calculate auxiliary integrals *** DO ipgf = 1, npgfa - IF (rpgfa(ipgf)+rpgfc < dac) CYCLE + IF (rpgfa(ipgf) + rpgfc < dac) CYCLE rho = zeta(ipgf) t = rho*dac*dac @@ -260,40 +260,40 @@ SUBROUTINE ppl_integral_ri(la_max_set, la_min_set, npgfa, rpgfa, zeta, & iw = 6 na = 0 DO ipgf = 1, npgfa - IF (rpgfa(ipgf)+rpgfc < dac) THEN - na = na+ncoset(la_max_set) + IF (rpgfa(ipgf) + rpgfc < dac) THEN + na = na + ncoset(la_max_set) CYCLE END IF rho = zeta(ipgf) - DO i = ncoset(la_min_set-1)+1, ncoset(la_max_set) - oref = va(na+i) + DO i = ncoset(la_min_set - 1) + 1, ncoset(la_max_set) + oref = va(na + i) ani(1:3) = indco(1:3, i) oint = ppl_ri_test(rho, ani, rac, nexp_ppl, nct_ppl, alpha_ppl, cexp_ppl) ! test - IF (ABS(oint-oref) > 1.0e-12_dp) THEN + IF (ABS(oint - oref) > 1.0e-12_dp) THEN WRITE (iw, '(A,3i2,i5,F10.4,2G24.12)') "PPL int error ", ani, la_max_set, dac, oint, oref END IF IF (PRESENT(dva)) THEN - anp = ani+(/1, 0, 0/) - anm = ani-(/1, 0, 0/) + anp = ani + (/1, 0, 0/) + anm = ani - (/1, 0, 0/) doint(1) = 2._dp*rho*ppl_ri_test(rho, anp, rac, nexp_ppl, nct_ppl, alpha_ppl, cexp_ppl) & - -ani(1)*ppl_ri_test(rho, anm, rac, nexp_ppl, nct_ppl, alpha_ppl, cexp_ppl) - anp = ani+(/0, 1, 0/) - anm = ani-(/0, 1, 0/) + - ani(1)*ppl_ri_test(rho, anm, rac, nexp_ppl, nct_ppl, alpha_ppl, cexp_ppl) + anp = ani + (/0, 1, 0/) + anm = ani - (/0, 1, 0/) doint(2) = 2._dp*rho*ppl_ri_test(rho, anp, rac, nexp_ppl, nct_ppl, alpha_ppl, cexp_ppl) & - -ani(2)*ppl_ri_test(rho, anm, rac, nexp_ppl, nct_ppl, alpha_ppl, cexp_ppl) - anp = ani+(/0, 0, 1/) - anm = ani-(/0, 0, 1/) + - ani(2)*ppl_ri_test(rho, anm, rac, nexp_ppl, nct_ppl, alpha_ppl, cexp_ppl) + anp = ani + (/0, 0, 1/) + anm = ani - (/0, 0, 1/) doint(3) = 2._dp*rho*ppl_ri_test(rho, anp, rac, nexp_ppl, nct_ppl, alpha_ppl, cexp_ppl) & - -ani(3)*ppl_ri_test(rho, anm, rac, nexp_ppl, nct_ppl, alpha_ppl, cexp_ppl) - doref(1:3) = dva(na+i, 1:3) - IF (ANY(ABS(doint-doref) > 1.0e-6_dp)) THEN + - ani(3)*ppl_ri_test(rho, anm, rac, nexp_ppl, nct_ppl, alpha_ppl, cexp_ppl) + doref(1:3) = dva(na + i, 1:3) + IF (ANY(ABS(doint - doref) > 1.0e-6_dp)) THEN WRITE (iw, '(A,3i2,i5,F10.4,2G24.12)') " PPL dint error ", & ani, la_max_set, dac, SUM(ABS(doint)), SUM(ABS(doref)) END IF END IF END DO - na = na+ncoset(la_max_set) + na = na + ncoset(la_max_set) END DO END IF @@ -334,29 +334,29 @@ FUNCTION ppl_ri_test(rho, ani, rac, nexp_ppl, nct_ppl, alpha_ppl, cexp_ppl) RESU cn = cexp_ppl(ni, iexp) SELECT CASE (ni) CASE (1) - oint = oint+cn*os_overlap2(ani, (/0, 0, 0/)) + oint = oint + cn*os_overlap2(ani, (/0, 0, 0/)) CASE (2) - oint = oint+cn*os_overlap2(ani, (/2, 0, 0/)) - oint = oint+cn*os_overlap2(ani, (/0, 2, 0/)) - oint = oint+cn*os_overlap2(ani, (/0, 0, 2/)) + oint = oint + cn*os_overlap2(ani, (/2, 0, 0/)) + oint = oint + cn*os_overlap2(ani, (/0, 2, 0/)) + oint = oint + cn*os_overlap2(ani, (/0, 0, 2/)) CASE (3) - oint = oint+cn*os_overlap2(ani, (/4, 0, 0/)) - oint = oint+cn*os_overlap2(ani, (/0, 4, 0/)) - oint = oint+cn*os_overlap2(ani, (/0, 0, 4/)) - oint = oint+2.0_dp*cn*os_overlap2(ani, (/2, 2, 0/)) - oint = oint+2.0_dp*cn*os_overlap2(ani, (/0, 2, 2/)) - oint = oint+2.0_dp*cn*os_overlap2(ani, (/2, 0, 2/)) + oint = oint + cn*os_overlap2(ani, (/4, 0, 0/)) + oint = oint + cn*os_overlap2(ani, (/0, 4, 0/)) + oint = oint + cn*os_overlap2(ani, (/0, 0, 4/)) + oint = oint + 2.0_dp*cn*os_overlap2(ani, (/2, 2, 0/)) + oint = oint + 2.0_dp*cn*os_overlap2(ani, (/0, 2, 2/)) + oint = oint + 2.0_dp*cn*os_overlap2(ani, (/2, 0, 2/)) CASE (4) - oint = oint+cn*os_overlap2(ani, (/6, 0, 0/)) - oint = oint+cn*os_overlap2(ani, (/0, 6, 0/)) - oint = oint+cn*os_overlap2(ani, (/0, 0, 6/)) - oint = oint+3.0_dp*cn*os_overlap2(ani, (/4, 2, 0/)) - oint = oint+3.0_dp*cn*os_overlap2(ani, (/4, 0, 2/)) - oint = oint+3.0_dp*cn*os_overlap2(ani, (/2, 4, 0/)) - oint = oint+3.0_dp*cn*os_overlap2(ani, (/0, 4, 2/)) - oint = oint+3.0_dp*cn*os_overlap2(ani, (/2, 0, 4/)) - oint = oint+3.0_dp*cn*os_overlap2(ani, (/0, 2, 4/)) - oint = oint+6.0_dp*cn*os_overlap2(ani, (/2, 2, 2/)) + oint = oint + cn*os_overlap2(ani, (/6, 0, 0/)) + oint = oint + cn*os_overlap2(ani, (/0, 6, 0/)) + oint = oint + cn*os_overlap2(ani, (/0, 0, 6/)) + oint = oint + 3.0_dp*cn*os_overlap2(ani, (/4, 2, 0/)) + oint = oint + 3.0_dp*cn*os_overlap2(ani, (/4, 0, 2/)) + oint = oint + 3.0_dp*cn*os_overlap2(ani, (/2, 4, 0/)) + oint = oint + 3.0_dp*cn*os_overlap2(ani, (/0, 4, 2/)) + oint = oint + 3.0_dp*cn*os_overlap2(ani, (/2, 0, 4/)) + oint = oint + 3.0_dp*cn*os_overlap2(ani, (/0, 2, 4/)) + oint = oint + 6.0_dp*cn*os_overlap2(ani, (/2, 2, 2/)) CASE DEFAULT CPABORT("OVERLAP_PPL") END SELECT @@ -392,18 +392,18 @@ SUBROUTINE ppl_aux(auxint, mmax, t, rho, nexp_ppl, cexp_ppl, zetc) REAL(KIND=dp), DIMENSION(0:mmax) :: expder CPASSERT(nexp_ppl > 0) - q = rho+zetc + q = rho + zetc polder = 0._dp pmax = 0 IF (nexp_ppl > 0) THEN - polder(0) = polder(0)+cexp_ppl(1) + polder(0) = polder(0) + cexp_ppl(1) pmax = 0 END IF IF (nexp_ppl > 1) THEN q2 = q*q a2 = 0.5_dp/q2*cexp_ppl(2) - polder(0) = polder(0)+a2*(2._dp*rho*t+3._dp*q) - polder(1) = polder(1)-a2*2._dp*rho + polder(0) = polder(0) + a2*(2._dp*rho*t + 3._dp*q) + polder(1) = polder(1) - a2*2._dp*rho pmax = 1 END IF IF (nexp_ppl > 2) THEN @@ -411,9 +411,9 @@ SUBROUTINE ppl_aux(auxint, mmax, t, rho, nexp_ppl, cexp_ppl, zetc) rho2 = rho*rho t2 = t*t a3 = 0.25_dp/q4*cexp_ppl(3) - polder(0) = polder(0)+a3*(4._dp*rho2*t2+20._dp*rho*t*q+15._dp*q2) - polder(1) = polder(1)-a3*(8._dp*rho2*t+20._dp*rho*q) - polder(2) = polder(2)+a3*8._dp*rho2 + polder(0) = polder(0) + a3*(4._dp*rho2*t2 + 20._dp*rho*t*q + 15._dp*q2) + polder(1) = polder(1) - a3*(8._dp*rho2*t + 20._dp*rho*q) + polder(2) = polder(2) + a3*8._dp*rho2 pmax = 2 END IF IF (nexp_ppl > 3) THEN @@ -421,10 +421,10 @@ SUBROUTINE ppl_aux(auxint, mmax, t, rho, nexp_ppl, cexp_ppl, zetc) rho3 = rho2*rho t3 = t2*t a4 = 0.125_dp/q6*cexp_ppl(4) - polder(0) = polder(0)+a4*(8._dp*rho3*t3+84._dp*rho2*t2*q+210._dp*rho*t*q2+105._dp*q*q2) - polder(1) = polder(1)-a4*(24._dp*rho3*t2+168._dp*rho2*t*q+210._dp*rho*q2) - polder(2) = polder(2)+a4*(48._dp*rho3*t+168._dp*rho2*q) - polder(3) = polder(3)-a4*48_dp*rho3 + polder(0) = polder(0) + a4*(8._dp*rho3*t3 + 84._dp*rho2*t2*q + 210._dp*rho*t*q2 + 105._dp*q*q2) + polder(1) = polder(1) - a4*(24._dp*rho3*t2 + 168._dp*rho2*t*q + 210._dp*rho*q2) + polder(2) = polder(2) + a4*(48._dp*rho3*t + 168._dp*rho2*q) + polder(3) = polder(3) - a4*48_dp*rho3 pmax = 3 END IF IF (nexp_ppl > 4) THEN @@ -436,14 +436,14 @@ SUBROUTINE ppl_aux(auxint, mmax, t, rho, nexp_ppl, cexp_ppl, zetc) IF (mmax >= 0) expder(0) = cc DO i = 1, mmax - expder(i) = f*expder(i-1) + expder(i) = f*expder(i - 1) END DO DO i = 0, mmax DO j = 0, MIN(i, pmax) kp = j - ke = i-j - auxint(i) = auxint(i)+expder(ke)*polder(kp)*choose(i, j) + ke = i - j + auxint(i) = auxint(i) + expder(ke)*polder(kp)*choose(i, j) END DO END DO @@ -460,7 +460,7 @@ FUNCTION choose(n, k) REAL(KIND=dp) :: choose IF (n >= k) THEN - choose = REAL(NINT(fac(n)/(fac(k)*fac(n-k))), KIND=dp) + choose = REAL(NINT(fac(n)/(fac(k)*fac(n - k))), KIND=dp) ELSE choose = 0.0_dp ENDIF diff --git a/src/aobasis/ai_spin_orbit.F b/src/aobasis/ai_spin_orbit.F index 8b24f139cf..5fd050326b 100644 --- a/src/aobasis/ai_spin_orbit.F +++ b/src/aobasis/ai_spin_orbit.F @@ -96,7 +96,7 @@ SUBROUTINE pso(la_max, la_min, npgfa, rpgfa, zeta, lb_max, lb_min, npgfb, rpgfb, ! *** Calculate the distance of the centers a and c *** - rab2 = rab(1)**2+rab(2)**2+rab(3)**2 + rab2 = rab(1)**2 + rab(2)**2 + rab(3)**2 dab = SQRT(rab2) ! *** Loop over all pairs of primitive Gaussian-type functions *** @@ -111,59 +111,59 @@ SUBROUTINE pso(la_max, la_min, npgfa, rpgfa, zeta, lb_max, lb_min, npgfb, rpgfb, ! *** Screening *** - IF (rpgfa(ipgf)+rpgfb(jpgf) < dab) THEN - DO j = nb+1, nb+ncoset(lb_max) - DO i = na+1, na+ncoset(la_max) + IF (rpgfa(ipgf) + rpgfb(jpgf) < dab) THEN + DO j = nb + 1, nb + ncoset(lb_max) + DO i = na + 1, na + ncoset(la_max) vab(i, j, 1) = 0.0_dp vab(i, j, 2) = 0.0_dp vab(i, j, 3) = 0.0_dp ENDDO ENDDO - nb = nb+ncoset(lb_max) + nb = nb + ncoset(lb_max) CYCLE ENDIF ! *** Calculate some prefactors *** zetab = zeta(ipgf)*zetb(jpgf) - zet = zeta(ipgf)+zetb(jpgf) + zet = zeta(ipgf) + zetb(jpgf) xhi = zetab/zet rap = zetb(jpgf)*rab/zet rbp = -zeta(ipgf)*rab/zet - rcp = -(zeta(ipgf)*rac+zetb(jpgf)*rbc)/zet + rcp = -(zeta(ipgf)*rac + zetb(jpgf)*rbc)/zet f0 = 2.0_dp*SQRT(zet/pi)*(pi/zet)**(1.5_dp)*EXP(-xhi*rab2) ! *** Calculate the recurrence relation *** - CALL os_rr_coul(rap, la_max+1, rbp, lb_max+1, rcp, zet, ldrr1, ldrr2, rr) + CALL os_rr_coul(rap, la_max + 1, rbp, lb_max + 1, rcp, zet, ldrr1, ldrr2, rr) ! *** Calculate the primitive Fermi contact integrals *** DO lb = lb_min, lb_max DO bx = 0, lb - DO by = 0, lb-bx - bz = lb-bx-by + DO by = 0, lb - bx + bz = lb - bx - by cob = coset(bx, by, bz) - cobm1x = coset(MAX(bx-1, 0), by, bz) - cobm1y = coset(bx, MAX(by-1, 0), bz) - cobm1z = coset(bx, by, MAX(bz-1, 0)) - cobp1x = coset(bx+1, by, bz) - cobp1y = coset(bx, by+1, bz) - cobp1z = coset(bx, by, bz+1) - mb = nb+cob + cobm1x = coset(MAX(bx - 1, 0), by, bz) + cobm1y = coset(bx, MAX(by - 1, 0), bz) + cobm1z = coset(bx, by, MAX(bz - 1, 0)) + cobp1x = coset(bx + 1, by, bz) + cobp1y = coset(bx, by + 1, bz) + cobp1z = coset(bx, by, bz + 1) + mb = nb + cob DO la = la_min, la_max DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay coa = coset(ax, ay, az) - coam1x = coset(MAX(ax-1, 0), ay, az) - coam1y = coset(ax, MAX(ay-1, 0), az) - coam1z = coset(ax, ay, MAX(az-1, 0)) - coap1x = coset(ax+1, ay, az) - coap1y = coset(ax, ay+1, az) - coap1z = coset(ax, ay, az+1) - ma = na+coa + coam1x = coset(MAX(ax - 1, 0), ay, az) + coam1y = coset(ax, MAX(ay - 1, 0), az) + coam1z = coset(ax, ay, MAX(az - 1, 0)) + coap1x = coset(ax + 1, ay, az) + coap1y = coset(ax, ay + 1, az) + coap1z = coset(ax, ay, az + 1) + ma = na + coa ! ! ! (a|pso_x|b) = (4*zeta*zetb*(a+y||b+z) @@ -173,15 +173,15 @@ SUBROUTINE pso(la_max, la_min, npgfa, rpgfa, zeta, lb_max, lb_min, npgfb, rpgfb, ! -2*zeta*Ny(b)*(a+z||b-y)-2*zetb*Nz(a)*(a-z||b+y) ! +Nz(a)*Ny(b)*(a-z||b-y)) dum1 = 4.0_dp*zeta(ipgf)*zetb(jpgf)*rr(0, coap1y, cobp1z) - IF (bz .GT. 0) dum1 = dum1-2.0_dp*zeta(ipgf)*REAL(bz, dp)*rr(0, coap1y, cobm1z) - IF (ay .GT. 0) dum1 = dum1-2.0_dp*zetb(jpgf)*REAL(ay, dp)*rr(0, coam1y, cobp1z) - IF (ay .GT. 0 .AND. bz .GT. 0) dum1 = dum1+REAL(ay, dp)*REAL(bz, dp)*rr(0, coam1y, cobm1z) + IF (bz .GT. 0) dum1 = dum1 - 2.0_dp*zeta(ipgf)*REAL(bz, dp)*rr(0, coap1y, cobm1z) + IF (ay .GT. 0) dum1 = dum1 - 2.0_dp*zetb(jpgf)*REAL(ay, dp)*rr(0, coam1y, cobp1z) + IF (ay .GT. 0 .AND. bz .GT. 0) dum1 = dum1 + REAL(ay, dp)*REAL(bz, dp)*rr(0, coam1y, cobm1z) ! dum2 = 4.0_dp*zeta(ipgf)*zetb(jpgf)*rr(0, coap1z, cobp1y) - IF (by .GT. 0) dum2 = dum2-2.0_dp*zeta(ipgf)*REAL(by, dp)*rr(0, coap1z, cobm1y) - IF (az .GT. 0) dum2 = dum2-2.0_dp*zetb(jpgf)*REAL(az, dp)*rr(0, coam1z, cobp1y) - IF (az .GT. 0 .AND. by .GT. 0) dum2 = dum2+REAL(az, dp)*REAL(by, dp)*rr(0, coam1z, cobm1y) - vab(ma, mb, 1) = f0*(dum1-dum2) + IF (by .GT. 0) dum2 = dum2 - 2.0_dp*zeta(ipgf)*REAL(by, dp)*rr(0, coap1z, cobm1y) + IF (az .GT. 0) dum2 = dum2 - 2.0_dp*zetb(jpgf)*REAL(az, dp)*rr(0, coam1z, cobp1y) + IF (az .GT. 0 .AND. by .GT. 0) dum2 = dum2 + REAL(az, dp)*REAL(by, dp)*rr(0, coam1z, cobm1y) + vab(ma, mb, 1) = f0*(dum1 - dum2) ! ! ! (a|pso_y|b) = (4*zeta*zetb*(a+z||b+x) @@ -191,15 +191,15 @@ SUBROUTINE pso(la_max, la_min, npgfa, rpgfa, zeta, lb_max, lb_min, npgfb, rpgfb, ! -2*zeta*Nz(b)*(a+x||b-z)-2*zetb*Nx(a)*(a-x||b+z) ! +Nx(a)*Nz(b)*(a-x||b-z)) dum1 = 4.0_dp*zeta(ipgf)*zetb(jpgf)*rr(0, coap1z, cobp1x) - IF (bx .GT. 0) dum1 = dum1-2.0_dp*zeta(ipgf)*REAL(bx, dp)*rr(0, coap1z, cobm1x) - IF (az .GT. 0) dum1 = dum1-2.0_dp*zetb(jpgf)*REAL(az, dp)*rr(0, coam1z, cobp1x) - IF (az .GT. 0 .AND. bx .GT. 0) dum1 = dum1+REAL(az, dp)*REAL(bx, dp)*rr(0, coam1z, cobm1x) + IF (bx .GT. 0) dum1 = dum1 - 2.0_dp*zeta(ipgf)*REAL(bx, dp)*rr(0, coap1z, cobm1x) + IF (az .GT. 0) dum1 = dum1 - 2.0_dp*zetb(jpgf)*REAL(az, dp)*rr(0, coam1z, cobp1x) + IF (az .GT. 0 .AND. bx .GT. 0) dum1 = dum1 + REAL(az, dp)*REAL(bx, dp)*rr(0, coam1z, cobm1x) ! dum2 = 4.0_dp*zeta(ipgf)*zetb(jpgf)*rr(0, coap1x, cobp1z) - IF (bz .GT. 0) dum2 = dum2-2.0_dp*zeta(ipgf)*REAL(bz, dp)*rr(0, coap1x, cobm1z) - IF (ax .GT. 0) dum2 = dum2-2.0_dp*zetb(jpgf)*REAL(ax, dp)*rr(0, coam1x, cobp1z) - IF (ax .GT. 0 .AND. bz .GT. 0) dum2 = dum2+REAL(ax, dp)*REAL(bz, dp)*rr(0, coam1x, cobm1z) - vab(ma, mb, 2) = f0*(dum1-dum2) + IF (bz .GT. 0) dum2 = dum2 - 2.0_dp*zeta(ipgf)*REAL(bz, dp)*rr(0, coap1x, cobm1z) + IF (ax .GT. 0) dum2 = dum2 - 2.0_dp*zetb(jpgf)*REAL(ax, dp)*rr(0, coam1x, cobp1z) + IF (ax .GT. 0 .AND. bz .GT. 0) dum2 = dum2 + REAL(ax, dp)*REAL(bz, dp)*rr(0, coam1x, cobm1z) + vab(ma, mb, 2) = f0*(dum1 - dum2) ! ! ! (a|pso_z|b) = (4*zeta*zetb*(a+x||b+y) @@ -209,15 +209,15 @@ SUBROUTINE pso(la_max, la_min, npgfa, rpgfa, zeta, lb_max, lb_min, npgfb, rpgfb, ! -2*zeta*Nx(b)*(a+y||b-x)-2*zetb*Ny(a)*(a-y||b+x) ! +Ny(a)*Nx(b)*(a-y||b-x)) dum1 = 4.0_dp*zeta(ipgf)*zetb(jpgf)*rr(0, coap1x, cobp1y) - IF (by .GT. 0) dum1 = dum1-2.0_dp*zeta(ipgf)*REAL(by, dp)*rr(0, coap1x, cobm1y) - IF (ax .GT. 0) dum1 = dum1-2.0_dp*zetb(jpgf)*REAL(ax, dp)*rr(0, coam1x, cobp1y) - IF (ax .GT. 0 .AND. by .GT. 0) dum1 = dum1+REAL(ax, dp)*REAL(by, dp)*rr(0, coam1x, cobm1y) + IF (by .GT. 0) dum1 = dum1 - 2.0_dp*zeta(ipgf)*REAL(by, dp)*rr(0, coap1x, cobm1y) + IF (ax .GT. 0) dum1 = dum1 - 2.0_dp*zetb(jpgf)*REAL(ax, dp)*rr(0, coam1x, cobp1y) + IF (ax .GT. 0 .AND. by .GT. 0) dum1 = dum1 + REAL(ax, dp)*REAL(by, dp)*rr(0, coam1x, cobm1y) ! dum2 = 4.0_dp*zeta(ipgf)*zetb(jpgf)*rr(0, coap1y, cobp1x) - IF (bx .GT. 0) dum2 = dum2-2.0_dp*zeta(ipgf)*REAL(bx, dp)*rr(0, coap1y, cobm1x) - IF (ay .GT. 0) dum2 = dum2-2.0_dp*zetb(jpgf)*REAL(ay, dp)*rr(0, coam1y, cobp1x) - IF (ay .GT. 0 .AND. bx .GT. 0) dum2 = dum2+REAL(ay, dp)*REAL(bx, dp)*rr(0, coam1y, cobm1x) - vab(ma, mb, 3) = f0*(dum1-dum2) + IF (bx .GT. 0) dum2 = dum2 - 2.0_dp*zeta(ipgf)*REAL(bx, dp)*rr(0, coap1y, cobm1x) + IF (ay .GT. 0) dum2 = dum2 - 2.0_dp*zetb(jpgf)*REAL(ay, dp)*rr(0, coam1y, cobp1x) + IF (ay .GT. 0 .AND. bx .GT. 0) dum2 = dum2 + REAL(ay, dp)*REAL(bx, dp)*rr(0, coam1y, cobm1x) + vab(ma, mb, 3) = f0*(dum1 - dum2) ! ENDDO ENDDO @@ -227,11 +227,11 @@ SUBROUTINE pso(la_max, la_min, npgfa, rpgfa, zeta, lb_max, lb_min, npgfb, rpgfb, ENDDO ENDDO !lb - nb = nb+ncoset(lb_max) + nb = nb + ncoset(lb_max) ENDDO - na = na+ncoset(la_max) + na = na + ncoset(la_max) ENDDO diff --git a/src/aobasis/ai_verfc.F b/src/aobasis/ai_verfc.F index d6342251c9..c5285cf30e 100644 --- a/src/aobasis/ai_verfc.F +++ b/src/aobasis/ai_verfc.F @@ -180,16 +180,16 @@ SUBROUTINE verfc(la_max1, npgfa, zeta, rpgfa, la_min1, lb_max1, npgfb, zetb, rpg pVp = 0.0_dp ! pVp matrices requires angular momentum quantum numbers l+1 and l-1 - la_max = la_max1+1 + la_max = la_max1 + 1 IF (PRESENT(maxder)) THEN IF (maxder > 0) THEN la_max = la_max1 END IF END IF - lb_max = lb_max1+1 + lb_max = lb_max1 + 1 - la_min = MAX(0, la_min1-1) - lb_min = MAX(0, lb_min1-1) + la_min = MAX(0, la_min1 - 1) + lb_min = MAX(0, lb_min1 - 1) ELSE do_dkh = .FALSE. la_max = la_max1 @@ -198,7 +198,7 @@ SUBROUTINE verfc(la_max1, npgfa, zeta, rpgfa, la_min1, lb_max1, npgfb, zetb, rpg lb_min = lb_min1 END IF - nmax = la_max+lb_max+1 + nmax = la_max + lb_max + 1 maxder_local = 0 IF (PRESENT(maxder)) maxder_local = maxder @@ -220,16 +220,16 @@ SUBROUTINE verfc(la_max1, npgfa, zeta, rpgfa, la_min1, lb_max1, npgfb, zetb, rpg IF (do_dkh) THEN IF (dkh_erfc) THEN - IF (rpgfa(ipgf)+rpgfc < dac) THEN - na = na+ncoset(la_max1-maxder_local) !JT - nap = nap+ncoset(la_max1) !JT + IF (rpgfa(ipgf) + rpgfc < dac) THEN + na = na + ncoset(la_max1 - maxder_local) !JT + nap = nap + ncoset(la_max1) !JT CYCLE END IF END IF ELSE - IF (rpgfa(ipgf)+rpgfc < dac) THEN - na = na+ncoset(la_max1-maxder_local) !JT - nap = nap+ncoset(la_max1) !JT + IF (rpgfa(ipgf) + rpgfc < dac) THEN + na = na + ncoset(la_max1 - maxder_local) !JT + nap = nap + ncoset(la_max1) !JT CYCLE END IF END IF @@ -241,24 +241,24 @@ SUBROUTINE verfc(la_max1, npgfa, zeta, rpgfa, la_min1, lb_max1, npgfb, zetb, rpg ! *** Screening *** IF (do_dkh) THEN IF (dkh_erfc) THEN - IF ((rpgfb(jpgf)+rpgfc < dbc) .OR. & - (rpgfa(ipgf)+rpgfb(jpgf) < dab)) THEN - nb = nb+ncoset(lb_max1) !JT + IF ((rpgfb(jpgf) + rpgfc < dbc) .OR. & + (rpgfa(ipgf) + rpgfb(jpgf) < dab)) THEN + nb = nb + ncoset(lb_max1) !JT CYCLE END IF END IF ELSE - IF ((rpgfb(jpgf)+rpgfc < dbc) .OR. & - (rpgfa(ipgf)+rpgfb(jpgf) < dab)) THEN - nb = nb+ncoset(lb_max1) !JT + IF ((rpgfb(jpgf) + rpgfc < dbc) .OR. & + (rpgfa(ipgf) + rpgfb(jpgf) < dab)) THEN + nb = nb + ncoset(lb_max1) !JT CYCLE END IF END IF ! *** Calculate some prefactors *** - zetp = 1.0_dp/(zeta(ipgf)+zetb(jpgf)) + zetp = 1.0_dp/(zeta(ipgf) + zetb(jpgf)) zetq = 1.0_dp/zetc - zetw = 1.0_dp/(zeta(ipgf)+zetb(jpgf)+zetc) + zetw = 1.0_dp/(zeta(ipgf) + zetb(jpgf) + zetc) f1 = zetb(jpgf)*zetp f2 = 0.5_dp*zetp @@ -270,33 +270,33 @@ SUBROUTINE verfc(la_max1, npgfa, zeta, rpgfa, la_min1, lb_max1, npgfb, zetb, rpg ferf = 2.0_dp*SQRT(pi**5*zetw)*zetp*zetq*f0 rap(:) = f1*rab(:) - rcp(:) = rap(:)-rac(:) + rcp(:) = rap(:) - rac(:) rpw(:) = f4*rcp(:) ! *** Calculate the incomplete Gamma function values *** - rcp2 = rcp(1)*rcp(1)+rcp(2)*rcp(2)+rcp(3)*rcp(3) + rcp2 = rcp(1)*rcp(1) + rcp(2)*rcp(2) + rcp(3)*rcp(3) t = rcp2/zetp - CALL fgamma(nmax-1, t, f) + CALL fgamma(nmax - 1, t, f) ! *** Calculate the basic nuclear attraction integrals [s|A(0)|s]{n} *** DO n = 1, nmax - vnuc(1, 1, n) = fnuc*f(n-1) + vnuc(1, 1, n) = fnuc*f(n - 1) END DO ! *** Calculate the incomplete Gamma function values *** t = -f4*rcp2/zetp - CALL fgamma(nmax-1, t, f) + CALL fgamma(nmax - 1, t, f) ! *** Calculate the basic three-center Coulomb integrals [ss||s]{n} *** DO n = 1, nmax - verf(1, 1, n) = ferf*f(n-1) + verf(1, 1, n) = ferf*f(n - 1) END DO ! *** Recurrence steps: [s|A(0)|s] -> [a|A(0)|b] *** @@ -312,13 +312,13 @@ SUBROUTINE verfc(la_max1, npgfa, zeta, rpgfa, la_min1, lb_max1, npgfb, zetb, rpg ! *** [ps||s]{n} = (Pi - Ai)*[ss||s]{n} + *** ! *** (Wi - Pi)*[ss||s]{n+1} (i = x,y,z) *** - DO n = 1, nmax-1 - vnuc(2, 1, n) = rap(1)*vnuc(1, 1, n)-rcp(1)*vnuc(1, 1, n+1) - verf(2, 1, n) = rap(1)*verf(1, 1, n)+rpw(1)*verf(1, 1, n+1) - vnuc(3, 1, n) = rap(2)*vnuc(1, 1, n)-rcp(2)*vnuc(1, 1, n+1) - verf(3, 1, n) = rap(2)*verf(1, 1, n)+rpw(2)*verf(1, 1, n+1) - vnuc(4, 1, n) = rap(3)*vnuc(1, 1, n)-rcp(3)*vnuc(1, 1, n+1) - verf(4, 1, n) = rap(3)*verf(1, 1, n)+rpw(3)*verf(1, 1, n+1) + DO n = 1, nmax - 1 + vnuc(2, 1, n) = rap(1)*vnuc(1, 1, n) - rcp(1)*vnuc(1, 1, n + 1) + verf(2, 1, n) = rap(1)*verf(1, 1, n) + rpw(1)*verf(1, 1, n + 1) + vnuc(3, 1, n) = rap(2)*vnuc(1, 1, n) - rcp(2)*vnuc(1, 1, n + 1) + verf(3, 1, n) = rap(2)*verf(1, 1, n) + rpw(2)*verf(1, 1, n + 1) + vnuc(4, 1, n) = rap(3)*vnuc(1, 1, n) - rcp(3)*vnuc(1, 1, n + 1) + verf(4, 1, n) = rap(3)*verf(1, 1, n) + rpw(3)*verf(1, 1, n + 1) END DO ! *** [a|A(0)|s]{n} = (Pi - Ai)*[a-1i|A(0)|s]{n} - *** @@ -332,71 +332,71 @@ SUBROUTINE verfc(la_max1, npgfa, zeta, rpgfa, la_min1, lb_max1, npgfb, zetb, rpg DO la = 2, la_max - DO n = 1, nmax-la + DO n = 1, nmax - la ! *** Increase the angular momentum component z of function a *** vnuc(coset(0, 0, la), 1, n) = & - rap(3)*vnuc(coset(0, 0, la-1), 1, n)- & - rcp(3)*vnuc(coset(0, 0, la-1), 1, n+1)+ & - f2*REAL(la-1, dp)*(vnuc(coset(0, 0, la-2), 1, n)- & - vnuc(coset(0, 0, la-2), 1, n+1)) + rap(3)*vnuc(coset(0, 0, la - 1), 1, n) - & + rcp(3)*vnuc(coset(0, 0, la - 1), 1, n + 1) + & + f2*REAL(la - 1, dp)*(vnuc(coset(0, 0, la - 2), 1, n) - & + vnuc(coset(0, 0, la - 2), 1, n + 1)) verf(coset(0, 0, la), 1, n) = & - rap(3)*verf(coset(0, 0, la-1), 1, n)+ & - rpw(3)*verf(coset(0, 0, la-1), 1, n+1)+ & - f2*REAL(la-1, dp)*(verf(coset(0, 0, la-2), 1, n)+ & - f4*verf(coset(0, 0, la-2), 1, n+1)) + rap(3)*verf(coset(0, 0, la - 1), 1, n) + & + rpw(3)*verf(coset(0, 0, la - 1), 1, n + 1) + & + f2*REAL(la - 1, dp)*(verf(coset(0, 0, la - 2), 1, n) + & + f4*verf(coset(0, 0, la - 2), 1, n + 1)) ! *** Increase the angular momentum component y of function a *** - az = la-1 + az = la - 1 vnuc(coset(0, 1, az), 1, n) = & - rap(2)*vnuc(coset(0, 0, az), 1, n)- & - rcp(2)*vnuc(coset(0, 0, az), 1, n+1) + rap(2)*vnuc(coset(0, 0, az), 1, n) - & + rcp(2)*vnuc(coset(0, 0, az), 1, n + 1) verf(coset(0, 1, az), 1, n) = & - rap(2)*verf(coset(0, 0, az), 1, n)+ & - rpw(2)*verf(coset(0, 0, az), 1, n+1) + rap(2)*verf(coset(0, 0, az), 1, n) + & + rpw(2)*verf(coset(0, 0, az), 1, n + 1) DO ay = 2, la - az = la-ay + az = la - ay vnuc(coset(0, ay, az), 1, n) = & - rap(2)*vnuc(coset(0, ay-1, az), 1, n)- & - rcp(2)*vnuc(coset(0, ay-1, az), 1, n+1)+ & - f2*REAL(ay-1, dp)*(vnuc(coset(0, ay-2, az), 1, n)- & - vnuc(coset(0, ay-2, az), 1, n+1)) + rap(2)*vnuc(coset(0, ay - 1, az), 1, n) - & + rcp(2)*vnuc(coset(0, ay - 1, az), 1, n + 1) + & + f2*REAL(ay - 1, dp)*(vnuc(coset(0, ay - 2, az), 1, n) - & + vnuc(coset(0, ay - 2, az), 1, n + 1)) verf(coset(0, ay, az), 1, n) = & - rap(2)*verf(coset(0, ay-1, az), 1, n)+ & - rpw(2)*verf(coset(0, ay-1, az), 1, n+1)+ & - f2*REAL(ay-1, dp)*(verf(coset(0, ay-2, az), 1, n)+ & - f4*verf(coset(0, ay-2, az), 1, n+1)) + rap(2)*verf(coset(0, ay - 1, az), 1, n) + & + rpw(2)*verf(coset(0, ay - 1, az), 1, n + 1) + & + f2*REAL(ay - 1, dp)*(verf(coset(0, ay - 2, az), 1, n) + & + f4*verf(coset(0, ay - 2, az), 1, n + 1)) END DO ! *** Increase the angular momentum component x of function a *** - DO ay = 0, la-1 - az = la-1-ay + DO ay = 0, la - 1 + az = la - 1 - ay vnuc(coset(1, ay, az), 1, n) = & - rap(1)*vnuc(coset(0, ay, az), 1, n)- & - rcp(1)*vnuc(coset(0, ay, az), 1, n+1) + rap(1)*vnuc(coset(0, ay, az), 1, n) - & + rcp(1)*vnuc(coset(0, ay, az), 1, n + 1) verf(coset(1, ay, az), 1, n) = & - rap(1)*verf(coset(0, ay, az), 1, n)+ & - rpw(1)*verf(coset(0, ay, az), 1, n+1) + rap(1)*verf(coset(0, ay, az), 1, n) + & + rpw(1)*verf(coset(0, ay, az), 1, n + 1) END DO DO ax = 2, la - f3 = f2*REAL(ax-1, dp) - DO ay = 0, la-ax - az = la-ax-ay + f3 = f2*REAL(ax - 1, dp) + DO ay = 0, la - ax + az = la - ax - ay vnuc(coset(ax, ay, az), 1, n) = & - rap(1)*vnuc(coset(ax-1, ay, az), 1, n)- & - rcp(1)*vnuc(coset(ax-1, ay, az), 1, n+1)+ & - f3*(vnuc(coset(ax-2, ay, az), 1, n)- & - vnuc(coset(ax-2, ay, az), 1, n+1)) + rap(1)*vnuc(coset(ax - 1, ay, az), 1, n) - & + rcp(1)*vnuc(coset(ax - 1, ay, az), 1, n + 1) + & + f3*(vnuc(coset(ax - 2, ay, az), 1, n) - & + vnuc(coset(ax - 2, ay, az), 1, n + 1)) verf(coset(ax, ay, az), 1, n) = & - rap(1)*verf(coset(ax-1, ay, az), 1, n)+ & - rpw(1)*verf(coset(ax-1, ay, az), 1, n+1)+ & - f3*(verf(coset(ax-2, ay, az), 1, n)+ & - f4*verf(coset(ax-2, ay, az), 1, n+1)) + rap(1)*verf(coset(ax - 1, ay, az), 1, n) + & + rpw(1)*verf(coset(ax - 1, ay, az), 1, n + 1) + & + f3*(verf(coset(ax - 2, ay, az), 1, n) + & + f4*verf(coset(ax - 2, ay, az), 1, n + 1)) END DO END DO @@ -411,35 +411,35 @@ SUBROUTINE verfc(la_max1, npgfa, zeta, rpgfa, la_min1, lb_max1, npgfb, zetb, rpg ! *** Horizontal recurrence steps *** - rbp(:) = rap(:)-rab(:) + rbp(:) = rap(:) - rab(:) ! *** [a||A(0)|p]{n} = [a+1i|A(0)|s]{n} - (Bi - Ai)*[a|A(0)|s]{n} *** ! *** [ap||s]{n} = [(a+1i)s||s]{n} - (Bi - Ai)*[as||s]{n} *** - la_start = MAX(0, la_min-1) + la_start = MAX(0, la_min - 1) - DO la = la_start, la_max-1 - DO n = 1, nmax-la-1 + DO la = la_start, la_max - 1 + DO n = 1, nmax - la - 1 DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay vnuc(coset(ax, ay, az), 2, n) = & - vnuc(coset(ax+1, ay, az), 1, n)- & + vnuc(coset(ax + 1, ay, az), 1, n) - & rab(1)*vnuc(coset(ax, ay, az), 1, n) verf(coset(ax, ay, az), 2, n) = & - verf(coset(ax+1, ay, az), 1, n)- & + verf(coset(ax + 1, ay, az), 1, n) - & rab(1)*verf(coset(ax, ay, az), 1, n) vnuc(coset(ax, ay, az), 3, n) = & - vnuc(coset(ax, ay+1, az), 1, n)- & + vnuc(coset(ax, ay + 1, az), 1, n) - & rab(2)*vnuc(coset(ax, ay, az), 1, n) verf(coset(ax, ay, az), 3, n) = & - verf(coset(ax, ay+1, az), 1, n)- & + verf(coset(ax, ay + 1, az), 1, n) - & rab(2)*verf(coset(ax, ay, az), 1, n) vnuc(coset(ax, ay, az), 4, n) = & - vnuc(coset(ax, ay, az+1), 1, n)- & + vnuc(coset(ax, ay, az + 1), 1, n) - & rab(3)*vnuc(coset(ax, ay, az), 1, n) verf(coset(ax, ay, az), 4, n) = & - verf(coset(ax, ay, az+1), 1, n)- & + verf(coset(ax, ay, az + 1), 1, n) - & rab(3)*verf(coset(ax, ay, az), 1, n) END DO END DO @@ -457,72 +457,72 @@ SUBROUTINE verfc(la_max1, npgfa, zeta, rpgfa, la_min1, lb_max1, npgfb, zetb, rpg ! *** f2*Ni(a)*( [(a-1i)s||s]{n} + *** ! *** f4*[(a-1i)s||s]{n+1}) *** - DO n = 1, nmax-la_max-1 + DO n = 1, nmax - la_max - 1 DO ax = 0, la_max fx = f2*REAL(ax, dp) - DO ay = 0, la_max-ax + DO ay = 0, la_max - ax fy = f2*REAL(ay, dp) - az = la_max-ax-ay + az = la_max - ax - ay fz = f2*REAL(az, dp) IF (ax == 0) THEN vnuc(coset(ax, ay, az), 2, n) = & - rbp(1)*vnuc(coset(ax, ay, az), 1, n)- & - rcp(1)*vnuc(coset(ax, ay, az), 1, n+1) + rbp(1)*vnuc(coset(ax, ay, az), 1, n) - & + rcp(1)*vnuc(coset(ax, ay, az), 1, n + 1) verf(coset(ax, ay, az), 2, n) = & - rbp(1)*verf(coset(ax, ay, az), 1, n)+ & - rpw(1)*verf(coset(ax, ay, az), 1, n+1) + rbp(1)*verf(coset(ax, ay, az), 1, n) + & + rpw(1)*verf(coset(ax, ay, az), 1, n + 1) ELSE vnuc(coset(ax, ay, az), 2, n) = & - rbp(1)*vnuc(coset(ax, ay, az), 1, n)- & - rcp(1)*vnuc(coset(ax, ay, az), 1, n+1)+ & - fx*(vnuc(coset(ax-1, ay, az), 1, n)- & - vnuc(coset(ax-1, ay, az), 1, n+1)) + rbp(1)*vnuc(coset(ax, ay, az), 1, n) - & + rcp(1)*vnuc(coset(ax, ay, az), 1, n + 1) + & + fx*(vnuc(coset(ax - 1, ay, az), 1, n) - & + vnuc(coset(ax - 1, ay, az), 1, n + 1)) verf(coset(ax, ay, az), 2, n) = & - rbp(1)*verf(coset(ax, ay, az), 1, n)+ & - rpw(1)*verf(coset(ax, ay, az), 1, n+1)+ & - fx*(verf(coset(ax-1, ay, az), 1, n)+ & - f4*verf(coset(ax-1, ay, az), 1, n+1)) + rbp(1)*verf(coset(ax, ay, az), 1, n) + & + rpw(1)*verf(coset(ax, ay, az), 1, n + 1) + & + fx*(verf(coset(ax - 1, ay, az), 1, n) + & + f4*verf(coset(ax - 1, ay, az), 1, n + 1)) END IF IF (ay == 0) THEN vnuc(coset(ax, ay, az), 3, n) = & - rbp(2)*vnuc(coset(ax, ay, az), 1, n)- & - rcp(2)*vnuc(coset(ax, ay, az), 1, n+1) + rbp(2)*vnuc(coset(ax, ay, az), 1, n) - & + rcp(2)*vnuc(coset(ax, ay, az), 1, n + 1) verf(coset(ax, ay, az), 3, n) = & - rbp(2)*verf(coset(ax, ay, az), 1, n)+ & - rpw(2)*verf(coset(ax, ay, az), 1, n+1) + rbp(2)*verf(coset(ax, ay, az), 1, n) + & + rpw(2)*verf(coset(ax, ay, az), 1, n + 1) ELSE vnuc(coset(ax, ay, az), 3, n) = & - rbp(2)*vnuc(coset(ax, ay, az), 1, n)- & - rcp(2)*vnuc(coset(ax, ay, az), 1, n+1)+ & - fy*(vnuc(coset(ax, ay-1, az), 1, n)- & - vnuc(coset(ax, ay-1, az), 1, n+1)) + rbp(2)*vnuc(coset(ax, ay, az), 1, n) - & + rcp(2)*vnuc(coset(ax, ay, az), 1, n + 1) + & + fy*(vnuc(coset(ax, ay - 1, az), 1, n) - & + vnuc(coset(ax, ay - 1, az), 1, n + 1)) verf(coset(ax, ay, az), 3, n) = & - rbp(2)*verf(coset(ax, ay, az), 1, n)+ & - rpw(2)*verf(coset(ax, ay, az), 1, n+1)+ & - fy*(verf(coset(ax, ay-1, az), 1, n)+ & - f4*verf(coset(ax, ay-1, az), 1, n+1)) + rbp(2)*verf(coset(ax, ay, az), 1, n) + & + rpw(2)*verf(coset(ax, ay, az), 1, n + 1) + & + fy*(verf(coset(ax, ay - 1, az), 1, n) + & + f4*verf(coset(ax, ay - 1, az), 1, n + 1)) END IF IF (az == 0) THEN vnuc(coset(ax, ay, az), 4, n) = & - rbp(3)*vnuc(coset(ax, ay, az), 1, n)- & - rcp(3)*vnuc(coset(ax, ay, az), 1, n+1) + rbp(3)*vnuc(coset(ax, ay, az), 1, n) - & + rcp(3)*vnuc(coset(ax, ay, az), 1, n + 1) verf(coset(ax, ay, az), 4, n) = & - rbp(3)*verf(coset(ax, ay, az), 1, n)+ & - rpw(3)*verf(coset(ax, ay, az), 1, n+1) + rbp(3)*verf(coset(ax, ay, az), 1, n) + & + rpw(3)*verf(coset(ax, ay, az), 1, n + 1) ELSE vnuc(coset(ax, ay, az), 4, n) = & - rbp(3)*vnuc(coset(ax, ay, az), 1, n)- & - rcp(3)*vnuc(coset(ax, ay, az), 1, n+1)+ & - fz*(vnuc(coset(ax, ay, az-1), 1, n)- & - vnuc(coset(ax, ay, az-1), 1, n+1)) + rbp(3)*vnuc(coset(ax, ay, az), 1, n) - & + rcp(3)*vnuc(coset(ax, ay, az), 1, n + 1) + & + fz*(vnuc(coset(ax, ay, az - 1), 1, n) - & + vnuc(coset(ax, ay, az - 1), 1, n + 1)) verf(coset(ax, ay, az), 4, n) = & - rbp(3)*verf(coset(ax, ay, az), 1, n)+ & - rpw(3)*verf(coset(ax, ay, az), 1, n+1)+ & - fz*(verf(coset(ax, ay, az-1), 1, n)+ & - f4*verf(coset(ax, ay, az-1), 1, n+1)) + rbp(3)*verf(coset(ax, ay, az), 1, n) + & + rpw(3)*verf(coset(ax, ay, az), 1, n + 1) + & + fz*(verf(coset(ax, ay, az - 1), 1, n) + & + f4*verf(coset(ax, ay, az - 1), 1, n + 1)) END IF END DO @@ -541,46 +541,46 @@ SUBROUTINE verfc(la_max1, npgfa, zeta, rpgfa, la_min1, lb_max1, npgfb, zetb, rpg ! *** [ab||s]{n} = [(a+1i)(b-1i)||s]{n} - *** ! *** (Bi - Ai)*[a(b-1i)||s]{n} *** - la_start = MAX(0, la_min-1) + la_start = MAX(0, la_min - 1) - DO la = la_start, la_max-1 - DO n = 1, nmax-la-lb + DO la = la_start, la_max - 1 + DO n = 1, nmax - la - lb DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay ! *** Shift of angular momentum component z from a to b *** vnuc(coset(ax, ay, az), coset(0, 0, lb), n) = & - vnuc(coset(ax, ay, az+1), coset(0, 0, lb-1), n)- & - rab(3)*vnuc(coset(ax, ay, az), coset(0, 0, lb-1), n) + vnuc(coset(ax, ay, az + 1), coset(0, 0, lb - 1), n) - & + rab(3)*vnuc(coset(ax, ay, az), coset(0, 0, lb - 1), n) verf(coset(ax, ay, az), coset(0, 0, lb), n) = & - verf(coset(ax, ay, az+1), coset(0, 0, lb-1), n)- & - rab(3)*verf(coset(ax, ay, az), coset(0, 0, lb-1), n) + verf(coset(ax, ay, az + 1), coset(0, 0, lb - 1), n) - & + rab(3)*verf(coset(ax, ay, az), coset(0, 0, lb - 1), n) ! *** Shift of angular momentum component y from a to b *** DO by = 1, lb - bz = lb-by + bz = lb - by vnuc(coset(ax, ay, az), coset(0, by, bz), n) = & - vnuc(coset(ax, ay+1, az), coset(0, by-1, bz), n)- & - rab(2)*vnuc(coset(ax, ay, az), coset(0, by-1, bz), n) + vnuc(coset(ax, ay + 1, az), coset(0, by - 1, bz), n) - & + rab(2)*vnuc(coset(ax, ay, az), coset(0, by - 1, bz), n) verf(coset(ax, ay, az), coset(0, by, bz), n) = & - verf(coset(ax, ay+1, az), coset(0, by-1, bz), n)- & - rab(2)*verf(coset(ax, ay, az), coset(0, by-1, bz), n) + verf(coset(ax, ay + 1, az), coset(0, by - 1, bz), n) - & + rab(2)*verf(coset(ax, ay, az), coset(0, by - 1, bz), n) END DO ! *** Shift of angular momentum component x from a to b *** DO bx = 1, lb - DO by = 0, lb-bx - bz = lb-bx-by + DO by = 0, lb - bx + bz = lb - bx - by vnuc(coset(ax, ay, az), coset(bx, by, bz), n) = & - vnuc(coset(ax+1, ay, az), coset(bx-1, by, bz), n)- & - rab(1)*vnuc(coset(ax, ay, az), coset(bx-1, by, bz), n) + vnuc(coset(ax + 1, ay, az), coset(bx - 1, by, bz), n) - & + rab(1)*vnuc(coset(ax, ay, az), coset(bx - 1, by, bz), n) verf(coset(ax, ay, az), coset(bx, by, bz), n) = & - verf(coset(ax+1, ay, az), coset(bx-1, by, bz), n)- & - rab(1)*verf(coset(ax, ay, az), coset(bx-1, by, bz), n) + verf(coset(ax + 1, ay, az), coset(bx - 1, by, bz), n) - & + rab(1)*verf(coset(ax, ay, az), coset(bx - 1, by, bz), n) END DO END DO @@ -604,170 +604,170 @@ SUBROUTINE verfc(la_max1, npgfa, zeta, rpgfa, la_min1, lb_max1, npgfb, zetb, rpg ! *** f2*Ni(b-1i)*( [a(b-2i)||s]{n} + *** ! *** f4*[a(b-2i)||s]{n+1}) *** - DO n = 1, nmax-la_max-lb + DO n = 1, nmax - la_max - lb DO ax = 0, la_max fx = f2*REAL(ax, dp) - DO ay = 0, la_max-ax + DO ay = 0, la_max - ax fy = f2*REAL(ay, dp) - az = la_max-ax-ay + az = la_max - ax - ay fz = f2*REAL(az, dp) ! *** Shift of angular momentum component z from a to b *** - f3 = f2*REAL(lb-1, dp) + f3 = f2*REAL(lb - 1, dp) IF (az == 0) THEN vnuc(coset(ax, ay, az), coset(0, 0, lb), n) = & - rbp(3)*vnuc(coset(ax, ay, az), coset(0, 0, lb-1), n)- & - rcp(3)*vnuc(coset(ax, ay, az), coset(0, 0, lb-1), n+1)+ & - f3*(vnuc(coset(ax, ay, az), coset(0, 0, lb-2), n)- & - vnuc(coset(ax, ay, az), coset(0, 0, lb-2), n+1)) + rbp(3)*vnuc(coset(ax, ay, az), coset(0, 0, lb - 1), n) - & + rcp(3)*vnuc(coset(ax, ay, az), coset(0, 0, lb - 1), n + 1) + & + f3*(vnuc(coset(ax, ay, az), coset(0, 0, lb - 2), n) - & + vnuc(coset(ax, ay, az), coset(0, 0, lb - 2), n + 1)) verf(coset(ax, ay, az), coset(0, 0, lb), n) = & - rbp(3)*verf(coset(ax, ay, az), coset(0, 0, lb-1), n)+ & - rpw(3)*verf(coset(ax, ay, az), coset(0, 0, lb-1), n+1)+ & - f3*(verf(coset(ax, ay, az), coset(0, 0, lb-2), n)+ & - f4*verf(coset(ax, ay, az), coset(0, 0, lb-2), n+1)) + rbp(3)*verf(coset(ax, ay, az), coset(0, 0, lb - 1), n) + & + rpw(3)*verf(coset(ax, ay, az), coset(0, 0, lb - 1), n + 1) + & + f3*(verf(coset(ax, ay, az), coset(0, 0, lb - 2), n) + & + f4*verf(coset(ax, ay, az), coset(0, 0, lb - 2), n + 1)) ELSE vnuc(coset(ax, ay, az), coset(0, 0, lb), n) = & - rbp(3)*vnuc(coset(ax, ay, az), coset(0, 0, lb-1), n)- & - rcp(3)*vnuc(coset(ax, ay, az), coset(0, 0, lb-1), n+1)+ & - fz*(vnuc(coset(ax, ay, az-1), coset(0, 0, lb-1), n)- & - vnuc(coset(ax, ay, az-1), coset(0, 0, lb-1), n+1))+ & - f3*(vnuc(coset(ax, ay, az), coset(0, 0, lb-2), n)- & - vnuc(coset(ax, ay, az), coset(0, 0, lb-2), n+1)) + rbp(3)*vnuc(coset(ax, ay, az), coset(0, 0, lb - 1), n) - & + rcp(3)*vnuc(coset(ax, ay, az), coset(0, 0, lb - 1), n + 1) + & + fz*(vnuc(coset(ax, ay, az - 1), coset(0, 0, lb - 1), n) - & + vnuc(coset(ax, ay, az - 1), coset(0, 0, lb - 1), n + 1)) + & + f3*(vnuc(coset(ax, ay, az), coset(0, 0, lb - 2), n) - & + vnuc(coset(ax, ay, az), coset(0, 0, lb - 2), n + 1)) verf(coset(ax, ay, az), coset(0, 0, lb), n) = & - rbp(3)*verf(coset(ax, ay, az), coset(0, 0, lb-1), n)+ & - rpw(3)*verf(coset(ax, ay, az), coset(0, 0, lb-1), n+1)+ & - fz*(verf(coset(ax, ay, az-1), coset(0, 0, lb-1), n)+ & - f4*verf(coset(ax, ay, az-1), coset(0, 0, lb-1), n+1))+ & - f3*(verf(coset(ax, ay, az), coset(0, 0, lb-2), n)+ & - f4*verf(coset(ax, ay, az), coset(0, 0, lb-2), n+1)) + rbp(3)*verf(coset(ax, ay, az), coset(0, 0, lb - 1), n) + & + rpw(3)*verf(coset(ax, ay, az), coset(0, 0, lb - 1), n + 1) + & + fz*(verf(coset(ax, ay, az - 1), coset(0, 0, lb - 1), n) + & + f4*verf(coset(ax, ay, az - 1), coset(0, 0, lb - 1), n + 1)) + & + f3*(verf(coset(ax, ay, az), coset(0, 0, lb - 2), n) + & + f4*verf(coset(ax, ay, az), coset(0, 0, lb - 2), n + 1)) END IF ! *** Shift of angular momentum component y from a to b *** IF (ay == 0) THEN - bz = lb-1 + bz = lb - 1 vnuc(coset(ax, ay, az), coset(0, 1, bz), n) = & - rbp(2)*vnuc(coset(ax, ay, az), coset(0, 0, bz), n)- & - rcp(2)*vnuc(coset(ax, ay, az), coset(0, 0, bz), n+1) + rbp(2)*vnuc(coset(ax, ay, az), coset(0, 0, bz), n) - & + rcp(2)*vnuc(coset(ax, ay, az), coset(0, 0, bz), n + 1) verf(coset(ax, ay, az), coset(0, 1, bz), n) = & - rbp(2)*verf(coset(ax, ay, az), coset(0, 0, bz), n)+ & - rpw(2)*verf(coset(ax, ay, az), coset(0, 0, bz), n+1) + rbp(2)*verf(coset(ax, ay, az), coset(0, 0, bz), n) + & + rpw(2)*verf(coset(ax, ay, az), coset(0, 0, bz), n + 1) DO by = 2, lb - bz = lb-by - f3 = f2*REAL(by-1, dp) + bz = lb - by + f3 = f2*REAL(by - 1, dp) vnuc(coset(ax, ay, az), coset(0, by, bz), n) = & - rbp(2)*vnuc(coset(ax, ay, az), coset(0, by-1, bz), n)- & - rcp(2)*vnuc(coset(ax, ay, az), coset(0, by-1, bz), n+1)+ & - f3*(vnuc(coset(ax, ay, az), coset(0, by-2, bz), n)- & - vnuc(coset(ax, ay, az), coset(0, by-2, bz), n+1)) + rbp(2)*vnuc(coset(ax, ay, az), coset(0, by - 1, bz), n) - & + rcp(2)*vnuc(coset(ax, ay, az), coset(0, by - 1, bz), n + 1) + & + f3*(vnuc(coset(ax, ay, az), coset(0, by - 2, bz), n) - & + vnuc(coset(ax, ay, az), coset(0, by - 2, bz), n + 1)) verf(coset(ax, ay, az), coset(0, by, bz), n) = & - rbp(2)*verf(coset(ax, ay, az), coset(0, by-1, bz), n)+ & - rpw(2)*verf(coset(ax, ay, az), coset(0, by-1, bz), n+1)+ & - f3*(verf(coset(ax, ay, az), coset(0, by-2, bz), n)+ & - f4*verf(coset(ax, ay, az), coset(0, by-2, bz), n+1)) + rbp(2)*verf(coset(ax, ay, az), coset(0, by - 1, bz), n) + & + rpw(2)*verf(coset(ax, ay, az), coset(0, by - 1, bz), n + 1) + & + f3*(verf(coset(ax, ay, az), coset(0, by - 2, bz), n) + & + f4*verf(coset(ax, ay, az), coset(0, by - 2, bz), n + 1)) END DO ELSE - bz = lb-1 + bz = lb - 1 vnuc(coset(ax, ay, az), coset(0, 1, bz), n) = & - rbp(2)*vnuc(coset(ax, ay, az), coset(0, 0, bz), n)- & - rcp(2)*vnuc(coset(ax, ay, az), coset(0, 0, bz), n+1)+ & - fy*(vnuc(coset(ax, ay-1, az), coset(0, 0, bz), n)- & - vnuc(coset(ax, ay-1, az), coset(0, 0, bz), n+1)) + rbp(2)*vnuc(coset(ax, ay, az), coset(0, 0, bz), n) - & + rcp(2)*vnuc(coset(ax, ay, az), coset(0, 0, bz), n + 1) + & + fy*(vnuc(coset(ax, ay - 1, az), coset(0, 0, bz), n) - & + vnuc(coset(ax, ay - 1, az), coset(0, 0, bz), n + 1)) verf(coset(ax, ay, az), coset(0, 1, bz), n) = & - rbp(2)*verf(coset(ax, ay, az), coset(0, 0, bz), n)+ & - rpw(2)*verf(coset(ax, ay, az), coset(0, 0, bz), n+1)+ & - fy*(verf(coset(ax, ay-1, az), coset(0, 0, bz), n)+ & - f4*verf(coset(ax, ay-1, az), coset(0, 0, bz), n+1)) + rbp(2)*verf(coset(ax, ay, az), coset(0, 0, bz), n) + & + rpw(2)*verf(coset(ax, ay, az), coset(0, 0, bz), n + 1) + & + fy*(verf(coset(ax, ay - 1, az), coset(0, 0, bz), n) + & + f4*verf(coset(ax, ay - 1, az), coset(0, 0, bz), n + 1)) DO by = 2, lb - bz = lb-by - f3 = f2*REAL(by-1, dp) + bz = lb - by + f3 = f2*REAL(by - 1, dp) vnuc(coset(ax, ay, az), coset(0, by, bz), n) = & - rbp(2)*vnuc(coset(ax, ay, az), coset(0, by-1, bz), n)- & - rcp(2)*vnuc(coset(ax, ay, az), coset(0, by-1, bz), n+1)+ & - fy*(vnuc(coset(ax, ay-1, az), coset(0, by-1, bz), n)- & - vnuc(coset(ax, ay-1, az), coset(0, by-1, bz), n+1))+ & - f3*(vnuc(coset(ax, ay, az), coset(0, by-2, bz), n)- & - vnuc(coset(ax, ay, az), coset(0, by-2, bz), n+1)) + rbp(2)*vnuc(coset(ax, ay, az), coset(0, by - 1, bz), n) - & + rcp(2)*vnuc(coset(ax, ay, az), coset(0, by - 1, bz), n + 1) + & + fy*(vnuc(coset(ax, ay - 1, az), coset(0, by - 1, bz), n) - & + vnuc(coset(ax, ay - 1, az), coset(0, by - 1, bz), n + 1)) + & + f3*(vnuc(coset(ax, ay, az), coset(0, by - 2, bz), n) - & + vnuc(coset(ax, ay, az), coset(0, by - 2, bz), n + 1)) verf(coset(ax, ay, az), coset(0, by, bz), n) = & - rbp(2)*verf(coset(ax, ay, az), coset(0, by-1, bz), n)+ & - rpw(2)*verf(coset(ax, ay, az), coset(0, by-1, bz), n+1)+ & - fy*(verf(coset(ax, ay-1, az), coset(0, by-1, bz), n)+ & - f4*verf(coset(ax, ay-1, az), & - coset(0, by-1, bz), n+1))+ & - f3*(verf(coset(ax, ay, az), coset(0, by-2, bz), n)+ & - f4*verf(coset(ax, ay, az), coset(0, by-2, bz), n+1)) + rbp(2)*verf(coset(ax, ay, az), coset(0, by - 1, bz), n) + & + rpw(2)*verf(coset(ax, ay, az), coset(0, by - 1, bz), n + 1) + & + fy*(verf(coset(ax, ay - 1, az), coset(0, by - 1, bz), n) + & + f4*verf(coset(ax, ay - 1, az), & + coset(0, by - 1, bz), n + 1)) + & + f3*(verf(coset(ax, ay, az), coset(0, by - 2, bz), n) + & + f4*verf(coset(ax, ay, az), coset(0, by - 2, bz), n + 1)) END DO END IF ! *** Shift of angular momentum component x from a to b *** IF (ax == 0) THEN - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by vnuc(coset(ax, ay, az), coset(1, by, bz), n) = & - rbp(1)*vnuc(coset(ax, ay, az), coset(0, by, bz), n)- & - rcp(1)*vnuc(coset(ax, ay, az), coset(0, by, bz), n+1) + rbp(1)*vnuc(coset(ax, ay, az), coset(0, by, bz), n) - & + rcp(1)*vnuc(coset(ax, ay, az), coset(0, by, bz), n + 1) verf(coset(ax, ay, az), coset(1, by, bz), n) = & - rbp(1)*verf(coset(ax, ay, az), coset(0, by, bz), n)+ & - rpw(1)*verf(coset(ax, ay, az), coset(0, by, bz), n+1) + rbp(1)*verf(coset(ax, ay, az), coset(0, by, bz), n) + & + rpw(1)*verf(coset(ax, ay, az), coset(0, by, bz), n + 1) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by vnuc(coset(ax, ay, az), coset(bx, by, bz), n) = & - rbp(1)*vnuc(coset(ax, ay, az), coset(bx-1, by, bz), n)- & + rbp(1)*vnuc(coset(ax, ay, az), coset(bx - 1, by, bz), n) - & rcp(1)*vnuc(coset(ax, ay, az), & - coset(bx-1, by, bz), n+1)+ & - f3*(vnuc(coset(ax, ay, az), coset(bx-2, by, bz), n)- & - vnuc(coset(ax, ay, az), coset(bx-2, by, bz), n+1)) + coset(bx - 1, by, bz), n + 1) + & + f3*(vnuc(coset(ax, ay, az), coset(bx - 2, by, bz), n) - & + vnuc(coset(ax, ay, az), coset(bx - 2, by, bz), n + 1)) verf(coset(ax, ay, az), coset(bx, by, bz), n) = & - rbp(1)*verf(coset(ax, ay, az), coset(bx-1, by, bz), n)+ & + rbp(1)*verf(coset(ax, ay, az), coset(bx - 1, by, bz), n) + & rpw(1)*verf(coset(ax, ay, az), & - coset(bx-1, by, bz), n+1)+ & - f3*(verf(coset(ax, ay, az), coset(bx-2, by, bz), n)+ & - f4*verf(coset(ax, ay, az), coset(bx-2, by, bz), n+1)) + coset(bx - 1, by, bz), n + 1) + & + f3*(verf(coset(ax, ay, az), coset(bx - 2, by, bz), n) + & + f4*verf(coset(ax, ay, az), coset(bx - 2, by, bz), n + 1)) END DO END DO ELSE - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by vnuc(coset(ax, ay, az), coset(1, by, bz), n) = & - rbp(1)*vnuc(coset(ax, ay, az), coset(0, by, bz), n)- & - rcp(1)*vnuc(coset(ax, ay, az), coset(0, by, bz), n+1)+ & - fx*(vnuc(coset(ax-1, ay, az), coset(0, by, bz), n)- & - vnuc(coset(ax-1, ay, az), coset(0, by, bz), n+1)) + rbp(1)*vnuc(coset(ax, ay, az), coset(0, by, bz), n) - & + rcp(1)*vnuc(coset(ax, ay, az), coset(0, by, bz), n + 1) + & + fx*(vnuc(coset(ax - 1, ay, az), coset(0, by, bz), n) - & + vnuc(coset(ax - 1, ay, az), coset(0, by, bz), n + 1)) verf(coset(ax, ay, az), coset(1, by, bz), n) = & - rbp(1)*verf(coset(ax, ay, az), coset(0, by, bz), n)+ & - rpw(1)*verf(coset(ax, ay, az), coset(0, by, bz), n+1)+ & - fx*(verf(coset(ax-1, ay, az), coset(0, by, bz), n)+ & - f4*verf(coset(ax-1, ay, az), coset(0, by, bz), n+1)) + rbp(1)*verf(coset(ax, ay, az), coset(0, by, bz), n) + & + rpw(1)*verf(coset(ax, ay, az), coset(0, by, bz), n + 1) + & + fx*(verf(coset(ax - 1, ay, az), coset(0, by, bz), n) + & + f4*verf(coset(ax - 1, ay, az), coset(0, by, bz), n + 1)) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by vnuc(coset(ax, ay, az), coset(bx, by, bz), n) = & - rbp(1)*vnuc(coset(ax, ay, az), coset(bx-1, by, bz), n)- & + rbp(1)*vnuc(coset(ax, ay, az), coset(bx - 1, by, bz), n) - & rcp(1)*vnuc(coset(ax, ay, az), & - coset(bx-1, by, bz), n+1)+ & - fx*(vnuc(coset(ax-1, ay, az), coset(bx-1, by, bz), n)- & - vnuc(coset(ax-1, ay, az), & - coset(bx-1, by, bz), n+1))+ & - f3*(vnuc(coset(ax, ay, az), coset(bx-2, by, bz), n)- & - vnuc(coset(ax, ay, az), coset(bx-2, by, bz), n+1)) + coset(bx - 1, by, bz), n + 1) + & + fx*(vnuc(coset(ax - 1, ay, az), coset(bx - 1, by, bz), n) - & + vnuc(coset(ax - 1, ay, az), & + coset(bx - 1, by, bz), n + 1)) + & + f3*(vnuc(coset(ax, ay, az), coset(bx - 2, by, bz), n) - & + vnuc(coset(ax, ay, az), coset(bx - 2, by, bz), n + 1)) verf(coset(ax, ay, az), coset(bx, by, bz), n) = & - rbp(1)*verf(coset(ax, ay, az), coset(bx-1, by, bz), n)+ & + rbp(1)*verf(coset(ax, ay, az), coset(bx - 1, by, bz), n) + & rpw(1)*verf(coset(ax, ay, az), & - coset(bx-1, by, bz), n+1)+ & - fx*(verf(coset(ax-1, ay, az), & - coset(bx-1, by, bz), n)+ & - f4*verf(coset(ax-1, ay, az), & - coset(bx-1, by, bz), n+1))+ & - f3*(verf(coset(ax, ay, az), coset(bx-2, by, bz), n)+ & - f4*verf(coset(ax, ay, az), coset(bx-2, by, bz), n+1)) + coset(bx - 1, by, bz), n + 1) + & + fx*(verf(coset(ax - 1, ay, az), & + coset(bx - 1, by, bz), n) + & + f4*verf(coset(ax - 1, ay, az), & + coset(bx - 1, by, bz), n + 1)) + & + f3*(verf(coset(ax, ay, az), coset(bx - 2, by, bz), n) + & + f4*verf(coset(ax, ay, az), coset(bx - 2, by, bz), n + 1)) END DO END DO END IF @@ -787,20 +787,20 @@ SUBROUTINE verfc(la_max1, npgfa, zeta, rpgfa, la_min1, lb_max1, npgfb, zetb, rpg ! *** Vertical recurrence steps: [s|A(0)|s] -> [s|A(0)|b] *** ! *** [ss||s] -> [sb||s] *** - rbp(:) = rap(:)-rab(:) + rbp(:) = rap(:) - rab(:) ! *** [s|A(0)|p]{n} = (Pi - Bi)*[s|A(0)|s]{n} - *** ! *** (Pi - Ci)*[s|A(0)|s]{n+1} *** ! *** [sp||s]{n} = (Pi - Bi)*[ss||s]{n} + *** ! *** (Wi - Pi)*[ss||s]{n+1} *** - DO n = 1, nmax-1 - vnuc(1, 2, n) = rbp(1)*vnuc(1, 1, n)-rcp(1)*vnuc(1, 1, n+1) - verf(1, 2, n) = rbp(1)*verf(1, 1, n)+rpw(1)*verf(1, 1, n+1) - vnuc(1, 3, n) = rbp(2)*vnuc(1, 1, n)-rcp(2)*vnuc(1, 1, n+1) - verf(1, 3, n) = rbp(2)*verf(1, 1, n)+rpw(2)*verf(1, 1, n+1) - vnuc(1, 4, n) = rbp(3)*vnuc(1, 1, n)-rcp(3)*vnuc(1, 1, n+1) - verf(1, 4, n) = rbp(3)*verf(1, 1, n)+rpw(3)*verf(1, 1, n+1) + DO n = 1, nmax - 1 + vnuc(1, 2, n) = rbp(1)*vnuc(1, 1, n) - rcp(1)*vnuc(1, 1, n + 1) + verf(1, 2, n) = rbp(1)*verf(1, 1, n) + rpw(1)*verf(1, 1, n + 1) + vnuc(1, 3, n) = rbp(2)*vnuc(1, 1, n) - rcp(2)*vnuc(1, 1, n + 1) + verf(1, 3, n) = rbp(2)*verf(1, 1, n) + rpw(2)*verf(1, 1, n + 1) + vnuc(1, 4, n) = rbp(3)*vnuc(1, 1, n) - rcp(3)*vnuc(1, 1, n + 1) + verf(1, 4, n) = rbp(3)*verf(1, 1, n) + rpw(3)*verf(1, 1, n + 1) END DO ! *** [s|A(0)|b]{n} = (Pi - Bi)*[s|A(0)|b-1i]{n} - *** @@ -814,71 +814,71 @@ SUBROUTINE verfc(la_max1, npgfa, zeta, rpgfa, la_min1, lb_max1, npgfb, zetb, rpg DO lb = 2, lb_max - DO n = 1, nmax-lb + DO n = 1, nmax - lb ! *** Increase the angular momentum component z of function b *** vnuc(1, coset(0, 0, lb), n) = & - rbp(3)*vnuc(1, coset(0, 0, lb-1), n)- & - rcp(3)*vnuc(1, coset(0, 0, lb-1), n+1)+ & - f2*REAL(lb-1, dp)*(vnuc(1, coset(0, 0, lb-2), n)- & - vnuc(1, coset(0, 0, lb-2), n+1)) + rbp(3)*vnuc(1, coset(0, 0, lb - 1), n) - & + rcp(3)*vnuc(1, coset(0, 0, lb - 1), n + 1) + & + f2*REAL(lb - 1, dp)*(vnuc(1, coset(0, 0, lb - 2), n) - & + vnuc(1, coset(0, 0, lb - 2), n + 1)) verf(1, coset(0, 0, lb), n) = & - rbp(3)*verf(1, coset(0, 0, lb-1), n)+ & - rpw(3)*verf(1, coset(0, 0, lb-1), n+1)+ & - f2*REAL(lb-1, dp)*(verf(1, coset(0, 0, lb-2), n)+ & - f4*verf(1, coset(0, 0, lb-2), n+1)) + rbp(3)*verf(1, coset(0, 0, lb - 1), n) + & + rpw(3)*verf(1, coset(0, 0, lb - 1), n + 1) + & + f2*REAL(lb - 1, dp)*(verf(1, coset(0, 0, lb - 2), n) + & + f4*verf(1, coset(0, 0, lb - 2), n + 1)) ! *** Increase the angular momentum component y of function b *** - bz = lb-1 + bz = lb - 1 vnuc(1, coset(0, 1, bz), n) = & - rbp(2)*vnuc(1, coset(0, 0, bz), n)- & - rcp(2)*vnuc(1, coset(0, 0, bz), n+1) + rbp(2)*vnuc(1, coset(0, 0, bz), n) - & + rcp(2)*vnuc(1, coset(0, 0, bz), n + 1) verf(1, coset(0, 1, bz), n) = & - rbp(2)*verf(1, coset(0, 0, bz), n)+ & - rpw(2)*verf(1, coset(0, 0, bz), n+1) + rbp(2)*verf(1, coset(0, 0, bz), n) + & + rpw(2)*verf(1, coset(0, 0, bz), n + 1) DO by = 2, lb - bz = lb-by + bz = lb - by vnuc(1, coset(0, by, bz), n) = & - rbp(2)*vnuc(1, coset(0, by-1, bz), n)- & - rcp(2)*vnuc(1, coset(0, by-1, bz), n+1)+ & - f2*REAL(by-1, dp)*(vnuc(1, coset(0, by-2, bz), n)- & - vnuc(1, coset(0, by-2, bz), n+1)) + rbp(2)*vnuc(1, coset(0, by - 1, bz), n) - & + rcp(2)*vnuc(1, coset(0, by - 1, bz), n + 1) + & + f2*REAL(by - 1, dp)*(vnuc(1, coset(0, by - 2, bz), n) - & + vnuc(1, coset(0, by - 2, bz), n + 1)) verf(1, coset(0, by, bz), n) = & - rbp(2)*verf(1, coset(0, by-1, bz), n)+ & - rpw(2)*verf(1, coset(0, by-1, bz), n+1)+ & - f2*REAL(by-1, dp)*(verf(1, coset(0, by-2, bz), n)+ & - f4*verf(1, coset(0, by-2, bz), n+1)) + rbp(2)*verf(1, coset(0, by - 1, bz), n) + & + rpw(2)*verf(1, coset(0, by - 1, bz), n + 1) + & + f2*REAL(by - 1, dp)*(verf(1, coset(0, by - 2, bz), n) + & + f4*verf(1, coset(0, by - 2, bz), n + 1)) END DO ! *** Increase the angular momentum component x of function b *** - DO by = 0, lb-1 - bz = lb-1-by + DO by = 0, lb - 1 + bz = lb - 1 - by vnuc(1, coset(1, by, bz), n) = & - rbp(1)*vnuc(1, coset(0, by, bz), n)- & - rcp(1)*vnuc(1, coset(0, by, bz), n+1) + rbp(1)*vnuc(1, coset(0, by, bz), n) - & + rcp(1)*vnuc(1, coset(0, by, bz), n + 1) verf(1, coset(1, by, bz), n) = & - rbp(1)*verf(1, coset(0, by, bz), n)+ & - rpw(1)*verf(1, coset(0, by, bz), n+1) + rbp(1)*verf(1, coset(0, by, bz), n) + & + rpw(1)*verf(1, coset(0, by, bz), n + 1) END DO DO bx = 2, lb - f3 = f2*REAL(bx-1, dp) - DO by = 0, lb-bx - bz = lb-bx-by + f3 = f2*REAL(bx - 1, dp) + DO by = 0, lb - bx + bz = lb - bx - by vnuc(1, coset(bx, by, bz), n) = & - rbp(1)*vnuc(1, coset(bx-1, by, bz), n)- & - rcp(1)*vnuc(1, coset(bx-1, by, bz), n+1)+ & - f3*(vnuc(1, coset(bx-2, by, bz), n)- & - vnuc(1, coset(bx-2, by, bz), n+1)) + rbp(1)*vnuc(1, coset(bx - 1, by, bz), n) - & + rcp(1)*vnuc(1, coset(bx - 1, by, bz), n + 1) + & + f3*(vnuc(1, coset(bx - 2, by, bz), n) - & + vnuc(1, coset(bx - 2, by, bz), n + 1)) verf(1, coset(bx, by, bz), n) = & - rbp(1)*verf(1, coset(bx-1, by, bz), n)+ & - rpw(1)*verf(1, coset(bx-1, by, bz), n+1)+ & - f3*(verf(1, coset(bx-2, by, bz), n)+ & - f4*verf(1, coset(bx-2, by, bz), n+1)) + rbp(1)*verf(1, coset(bx - 1, by, bz), n) + & + rpw(1)*verf(1, coset(bx - 1, by, bz), n + 1) + & + f3*(verf(1, coset(bx - 2, by, bz), n) + & + f4*verf(1, coset(bx - 2, by, bz), n + 1)) END DO END DO @@ -896,20 +896,20 @@ SUBROUTINE verfc(la_max1, npgfa, zeta, rpgfa, la_min1, lb_max1, npgfb, zetb, rpg !JT IF (do_dkh) THEN DO j = 1, ncoset(lb_max1) - DO i = ncoset(la_min1-1)+1, ncoset(la_max1-maxder_local) - vnabc(na+i, nb+j) = vnabc(na+i, nb+j)+cerf*verf(i, j, 1) + DO i = ncoset(la_min1 - 1) + 1, ncoset(la_max1 - maxder_local) + vnabc(na + i, nb + j) = vnabc(na + i, nb + j) + cerf*verf(i, j, 1) END DO END DO DO j = 1, ncoset(lb_max1) - DO i = ncoset(la_min1-1)+1, ncoset(la_max1-maxder_local) - vabc(na+i, nb+j) = vabc(na+i, nb+j)-zc*vnuc(i, j, 1) + DO i = ncoset(la_min1 - 1) + 1, ncoset(la_max1 - maxder_local) + vabc(na + i, nb + j) = vabc(na + i, nb + j) - zc*vnuc(i, j, 1) END DO END DO ELSE DO j = 1, ncoset(lb_max1) !JT - DO i = ncoset(la_min1-1)+1, ncoset(la_max1-maxder_local) !JT - vabc(na+i, nb+j) = vabc(na+i, nb+j)- & - zc*vnuc(i, j, 1)+cerf*verf(i, j, 1) + DO i = ncoset(la_min1 - 1) + 1, ncoset(la_max1 - maxder_local) !JT + vabc(na + i, nb + j) = vabc(na + i, nb + j) - & + zc*vnuc(i, j, 1) + cerf*verf(i, j, 1) END DO END DO END IF @@ -918,8 +918,8 @@ SUBROUTINE verfc(la_max1, npgfa, zeta, rpgfa, la_min1, lb_max1, npgfb, zetb, rpg IF (PRESENT(maxder)) THEN DO j = 1, ncoset(lb_max1) !JT DO i = 1, ncoset(la_max1) !JT - vabc_plus(nap+i, nb+j) = vabc_plus(nap+i, nb+j)- & - zc*vnuc(i, j, 1)+cerf*verf(i, j, 1) + vabc_plus(nap + i, nb + j) = vabc_plus(nap + i, nb + j) - & + zc*vnuc(i, j, 1) + cerf*verf(i, j, 1) END DO END DO END IF @@ -945,56 +945,56 @@ SUBROUTINE verfc(la_max1, npgfa, zeta, rpgfa, la_min1, lb_max1, npgfb, zetb, rpg DO la = 0, la_max1 DO ax = 0, la fax = REAL(ax, dp) - DO ay = 0, la-ax + DO ay = 0, la - ax fay = REAL(ay, dp) - az = la-ax-ay + az = la - ax - ay faz = REAL(az, dp) pVpa = coset(ax, ay, az) - coamx = coset(ax-1, ay, az) - coamy = coset(ax, ay-1, az) - coamz = coset(ax, ay, az-1) - coapx = coset(ax+1, ay, az) - coapy = coset(ax, ay+1, az) - coapz = coset(ax, ay, az+1) + coamx = coset(ax - 1, ay, az) + coamy = coset(ax, ay - 1, az) + coamz = coset(ax, ay, az - 1) + coapx = coset(ax + 1, ay, az) + coapy = coset(ax, ay + 1, az) + coapz = coset(ax, ay, az + 1) DO lb = 0, lb_max1 DO bx = 0, lb fbx = REAL(bx, dp) - DO by = 0, lb-bx + DO by = 0, lb - bx fby = REAL(by, dp) - bz = lb-bx-by + bz = lb - bx - by fbz = REAL(bz, dp) pVpb = coset(bx, by, bz) - cobmx = coset(bx-1, by, bz) - cobmy = coset(bx, by-1, bz) - cobmz = coset(bx, by, bz-1) - cobpx = coset(bx+1, by, bz) - cobpy = coset(bx, by+1, bz) - cobpz = coset(bx, by, bz+1) + cobmx = coset(bx - 1, by, bz) + cobmy = coset(bx, by - 1, bz) + cobmz = coset(bx, by, bz - 1) + cobpx = coset(bx + 1, by, bz) + cobpy = coset(bx, by + 1, bz) + cobpz = coset(bx, by, bz + 1) IF (dkh_erfc) THEN - pVp(pVpa, pVpb) = ftaz*ftbz*(-zc*vnuc(coapx, cobpx, 1)+cerf*verf(coapx, cobpx, 1))- & - ftaz*fbx*(-zc*vnuc(coapx, cobmx, 1)+cerf*verf(coapx, cobmx, 1))- & - ftbz*fax*(-zc*vnuc(coamx, cobpx, 1)+cerf*verf(coamx, cobpx, 1))+ & - fax*fbx*(-zc*vnuc(coamx, cobmx, 1)+cerf*verf(coamx, cobmx, 1))+ & - ftaz*ftbz*(-zc*vnuc(coapy, cobpy, 1)+cerf*verf(coapy, cobpy, 1))- & - ftaz*fby*(-zc*vnuc(coapy, cobmy, 1)+cerf*verf(coapy, cobmy, 1))- & - ftbz*fay*(-zc*vnuc(coamy, cobpy, 1)+cerf*verf(coamy, cobpy, 1))+ & - fay*fby*(-zc*vnuc(coamy, cobmy, 1)+cerf*verf(coamy, cobmy, 1))+ & - ftaz*ftbz*(-zc*vnuc(coapz, cobpz, 1)+cerf*verf(coapz, cobpz, 1))- & - ftaz*fbz*(-zc*vnuc(coapz, cobmz, 1)+cerf*verf(coapz, cobmz, 1))- & - ftbz*faz*(-zc*vnuc(coamz, cobpz, 1)+cerf*verf(coamz, cobpz, 1))+ & - faz*fbz*(-zc*vnuc(coamz, cobmz, 1)+cerf*verf(coamz, cobmz, 1)) + pVp(pVpa, pVpb) = ftaz*ftbz*(-zc*vnuc(coapx, cobpx, 1) + cerf*verf(coapx, cobpx, 1)) - & + ftaz*fbx*(-zc*vnuc(coapx, cobmx, 1) + cerf*verf(coapx, cobmx, 1)) - & + ftbz*fax*(-zc*vnuc(coamx, cobpx, 1) + cerf*verf(coamx, cobpx, 1)) + & + fax*fbx*(-zc*vnuc(coamx, cobmx, 1) + cerf*verf(coamx, cobmx, 1)) + & + ftaz*ftbz*(-zc*vnuc(coapy, cobpy, 1) + cerf*verf(coapy, cobpy, 1)) - & + ftaz*fby*(-zc*vnuc(coapy, cobmy, 1) + cerf*verf(coapy, cobmy, 1)) - & + ftbz*fay*(-zc*vnuc(coamy, cobpy, 1) + cerf*verf(coamy, cobpy, 1)) + & + fay*fby*(-zc*vnuc(coamy, cobmy, 1) + cerf*verf(coamy, cobmy, 1)) + & + ftaz*ftbz*(-zc*vnuc(coapz, cobpz, 1) + cerf*verf(coapz, cobpz, 1)) - & + ftaz*fbz*(-zc*vnuc(coapz, cobmz, 1) + cerf*verf(coapz, cobmz, 1)) - & + ftbz*faz*(-zc*vnuc(coamz, cobpz, 1) + cerf*verf(coamz, cobpz, 1)) + & + faz*fbz*(-zc*vnuc(coamz, cobmz, 1) + cerf*verf(coamz, cobmz, 1)) ELSE - pVp(pVpa, pVpb) = ftaz*ftbz*(-zc*vnuc(coapx, cobpx, 1))- & - ftaz*fbx*(-zc*vnuc(coapx, cobmx, 1))- & - ftbz*fax*(-zc*vnuc(coamx, cobpx, 1))+ & - fax*fbx*(-zc*vnuc(coamx, cobmx, 1))+ & - ftaz*ftbz*(-zc*vnuc(coapy, cobpy, 1))- & - ftaz*fby*(-zc*vnuc(coapy, cobmy, 1))- & - ftbz*fay*(-zc*vnuc(coamy, cobpy, 1))+ & - fay*fby*(-zc*vnuc(coamy, cobmy, 1))+ & - ftaz*ftbz*(-zc*vnuc(coapz, cobpz, 1))- & - ftaz*fbz*(-zc*vnuc(coapz, cobmz, 1))- & - ftbz*faz*(-zc*vnuc(coamz, cobpz, 1))+ & + pVp(pVpa, pVpb) = ftaz*ftbz*(-zc*vnuc(coapx, cobpx, 1)) - & + ftaz*fbx*(-zc*vnuc(coapx, cobmx, 1)) - & + ftbz*fax*(-zc*vnuc(coamx, cobpx, 1)) + & + fax*fbx*(-zc*vnuc(coamx, cobmx, 1)) + & + ftaz*ftbz*(-zc*vnuc(coapy, cobpy, 1)) - & + ftaz*fby*(-zc*vnuc(coapy, cobmy, 1)) - & + ftbz*fay*(-zc*vnuc(coamy, cobpy, 1)) + & + fay*fby*(-zc*vnuc(coamy, cobmy, 1)) + & + ftaz*ftbz*(-zc*vnuc(coapz, cobpz, 1)) - & + ftaz*fbz*(-zc*vnuc(coapz, cobmz, 1)) - & + ftbz*faz*(-zc*vnuc(coamz, cobpz, 1)) + & faz*fbz*(-zc*vnuc(coamz, cobmz, 1)) END IF END DO @@ -1005,18 +1005,18 @@ SUBROUTINE verfc(la_max1, npgfa, zeta, rpgfa, la_min1, lb_max1, npgfb, zetb, rpg END DO DO j = 1, ncoset(lb_max1) - DO i = ncoset(la_min1-1)+1, ncoset(la_max1-maxder_local) - pVp_sum(na+i, nb+j) = pVp_sum(na+i, nb+j)+pVp(i, j) + DO i = ncoset(la_min1 - 1) + 1, ncoset(la_max1 - maxder_local) + pVp_sum(na + i, nb + j) = pVp_sum(na + i, nb + j) + pVp(i, j) END DO END DO END IF !JTe - nb = nb+ncoset(lb_max1) !JT + nb = nb + ncoset(lb_max1) !JT END DO - na = na+ncoset(la_max1-maxder_local) !JT - nap = nap+ncoset(la_max1) !JT + na = na + ncoset(la_max1 - maxder_local) !JT + nap = nap + ncoset(la_max1) !JT END DO diff --git a/src/aobasis/ao_util.F b/src/aobasis/ao_util.F index be3aae6a86..5ce56f635e 100644 --- a/src/aobasis/ao_util.F +++ b/src/aobasis/ao_util.F @@ -217,21 +217,21 @@ FUNCTION exp_radius(l, alpha, threshold, prefactor, epsin) RESULT(radius) END IF rlow = r - rhigh = 2.0_dp*rlow+1.0_dp + rhigh = 2.0_dp*rlow + 1.0_dp iter = 0 DO - iter = iter+1 + iter = iter + 1 IF (iter .GT. maxiter) THEN CPABORT("Maximum number of iterations exceeded") END IF g = d*rhigh**l*EXP(-a*rhigh**2) IF (g < t) EXIT rlow = rhigh - rhigh = 2.0_dp*rlow+1.0_dp + rhigh = 2.0_dp*rlow + 1.0_dp ENDDO DO iter = 1, maxiter - rmid = (rlow+rhigh)*0.5_dp + rmid = (rlow + rhigh)*0.5_dp ar2 = a*rmid*rmid g = d*rmid**l*EXP(-ar2) IF (g .LT. t) THEN @@ -239,7 +239,7 @@ FUNCTION exp_radius(l, alpha, threshold, prefactor, epsin) RESULT(radius) ELSE rlow = rmid ENDIF - IF (ABS(rhigh-rlow) .LT. epsiter) THEN + IF (ABS(rhigh - rlow) .LT. epsiter) THEN radius = rhigh RETURN ENDIF @@ -299,15 +299,15 @@ FUNCTION exp_radius_very_extended(la_min, la_max, lb_min, lb_max, pab, o1, o2, r prefactor_local = cutoff DO lxa = 0, la_max DO lxb = 0, lb_max - DO lya = 0, la_max-lxa - DO lyb = 0, lb_max-lxb - DO lza = MAX(la_min-lxa-lya, 0), la_max-lxa-lya - DO lzb = MAX(lb_min-lxb-lyb, 0), lb_max-lxb-lyb + DO lya = 0, la_max - lxa + DO lyb = 0, lb_max - lxb + DO lza = MAX(la_min - lxa - lya, 0), la_max - lxa - lya + DO lzb = MAX(lb_min - lxb - lyb, 0), lb_max - lxb - lyb la = (/lxa, lya, lza/) lb = (/lxb, lyb, lzb/) ico = coset(lxa, lya, lza) jco = coset(lxb, lyb, lzb) - prefactor_local = MAX(ABS(pab(o1+ico, o2+jco)), prefactor_local) + prefactor_local = MAX(ABS(pab(o1 + ico, o2 + jco)), prefactor_local) ENDDO ENDDO ENDDO @@ -324,35 +324,35 @@ FUNCTION exp_radius_very_extended(la_min, la_max, lb_min, lb_max, pab, o1, o2, r ! the Gaussians a and b are both on the z - axis, but at the same ! distance as the original a and b ! - rad_a = SQRT(SUM((ra-rp)**2)) - rad_b = SQRT(SUM((rb-rp)**2)) + rad_a = SQRT(SUM((ra - rp)**2)) + rad_b = SQRT(SUM((rb - rp)**2)) - polycoef(0:la_max+lb_max) = 0.0_dp + polycoef(0:la_max + lb_max) = 0.0_dp DO lxa = 0, la_max DO lxb = 0, lb_max - coef(0:la_max+lb_max) = 0.0_dp + coef(0:la_max + lb_max) = 0.0_dp bini = 1.0_dp s1 = 1.0_dp DO i = 0, lxa binj = 1.0_dp s2 = 1.0_dp DO j = 0, lxb - coef(lxa+lxb-i-j) = coef(lxa+lxb-i-j)+bini*binj*s1*s2 - binj = (binj*(lxb-j))/(j+1) + coef(lxa + lxb - i - j) = coef(lxa + lxb - i - j) + bini*binj*s1*s2 + binj = (binj*(lxb - j))/(j + 1) s2 = s2*(rad_b) ENDDO - bini = (bini*(lxa-i))/(i+1) + bini = (bini*(lxa - i))/(i + 1) s1 = s1*(rad_a) ENDDO - DO i = 0, lxa+lxb + DO i = 0, lxa + lxb polycoef(i) = MAX(polycoef(i), coef(i)) ENDDO ENDDO ENDDO - polycoef(0:la_max+lb_max) = polycoef(0:la_max+lb_max)*prefactor_local + polycoef(0:la_max + lb_max) = polycoef(0:la_max + lb_max)*prefactor_local radius = 0.0_dp - DO i = 0, la_max+lb_max + DO i = 0, la_max + lb_max radius = MAX(radius, exp_radius(i, zetp, eps, polycoef(i), epsin_local)) ENDDO @@ -377,11 +377,11 @@ FUNCTION gaussint_sph(alpha, l) IF ((l/2)*2 == l) THEN !even l: - gaussint_sph = ROOTPI*0.5_dp**(l/2+2)*dfac(l+1) & - /SQRT(alpha)**(l+3) + gaussint_sph = ROOTPI*0.5_dp**(l/2 + 2)*dfac(l + 1) & + /SQRT(alpha)**(l + 3) ELSE !odd l: - gaussint_sph = 0.5_dp*fac((l+1)/2)/SQRT(alpha)**(l+3) + gaussint_sph = 0.5_dp*fac((l + 1)/2)/SQRT(alpha)**(l + 3) ENDIF END FUNCTION gaussint_sph @@ -417,50 +417,50 @@ PURE FUNCTION trace_r_AxB(A, lda, B, ldb, m, n) CASE (0) DO i2 = 1, n DO i1 = 1, m, 4 - t1 = t1+A(i1, i2)*B(i1, i2) - t2 = t2+A(i1+1, i2)*B(i1+1, i2) - t3 = t3+A(i1+2, i2)*B(i1+2, i2) - t4 = t4+A(i1+3, i2)*B(i1+3, i2) + t1 = t1 + A(i1, i2)*B(i1, i2) + t2 = t2 + A(i1 + 1, i2)*B(i1 + 1, i2) + t3 = t3 + A(i1 + 2, i2)*B(i1 + 2, i2) + t4 = t4 + A(i1 + 3, i2)*B(i1 + 3, i2) ENDDO ENDDO CASE (1) - mminus3 = m-3 + mminus3 = m - 3 DO i2 = 1, n DO i1 = 1, mminus3, 4 - t1 = t1+A(i1, i2)*B(i1, i2) - t2 = t2+A(i1+1, i2)*B(i1+1, i2) - t3 = t3+A(i1+2, i2)*B(i1+2, i2) - t4 = t4+A(i1+3, i2)*B(i1+3, i2) + t1 = t1 + A(i1, i2)*B(i1, i2) + t2 = t2 + A(i1 + 1, i2)*B(i1 + 1, i2) + t3 = t3 + A(i1 + 2, i2)*B(i1 + 2, i2) + t4 = t4 + A(i1 + 3, i2)*B(i1 + 3, i2) ENDDO - t1 = t1+A(m, i2)*B(m, i2) + t1 = t1 + A(m, i2)*B(m, i2) ENDDO CASE (2) - mminus3 = m-3 + mminus3 = m - 3 DO i2 = 1, n DO i1 = 1, mminus3, 4 - t1 = t1+A(i1, i2)*B(i1, i2) - t2 = t2+A(i1+1, i2)*B(i1+1, i2) - t3 = t3+A(i1+2, i2)*B(i1+2, i2) - t4 = t4+A(i1+3, i2)*B(i1+3, i2) + t1 = t1 + A(i1, i2)*B(i1, i2) + t2 = t2 + A(i1 + 1, i2)*B(i1 + 1, i2) + t3 = t3 + A(i1 + 2, i2)*B(i1 + 2, i2) + t4 = t4 + A(i1 + 3, i2)*B(i1 + 3, i2) ENDDO - t1 = t1+A(m-1, i2)*B(m-1, i2) - t2 = t2+A(m, i2)*B(m, i2) + t1 = t1 + A(m - 1, i2)*B(m - 1, i2) + t2 = t2 + A(m, i2)*B(m, i2) ENDDO CASE (3) - mminus3 = m-3 + mminus3 = m - 3 DO i2 = 1, n DO i1 = 1, mminus3, 4 - t1 = t1+A(i1, i2)*B(i1, i2) - t2 = t2+A(i1+1, i2)*B(i1+1, i2) - t3 = t3+A(i1+2, i2)*B(i1+2, i2) - t4 = t4+A(i1+3, i2)*B(i1+3, i2) + t1 = t1 + A(i1, i2)*B(i1, i2) + t2 = t2 + A(i1 + 1, i2)*B(i1 + 1, i2) + t3 = t3 + A(i1 + 2, i2)*B(i1 + 2, i2) + t4 = t4 + A(i1 + 3, i2)*B(i1 + 3, i2) ENDDO - t1 = t1+A(m-2, i2)*B(m-2, i2) - t2 = t2+A(m-1, i2)*B(m-1, i2) - t3 = t3+A(m, i2)*B(m, i2) + t1 = t1 + A(m - 2, i2)*B(m - 2, i2) + t2 = t2 + A(m - 1, i2)*B(m - 1, i2) + t3 = t3 + A(m, i2)*B(m, i2) ENDDO END SELECT - trace_r_AxB = t1+t2+t3+t4 + trace_r_AxB = t1 + t2 + t3 + t4 END FUNCTION trace_r_AxB @@ -525,15 +525,15 @@ SUBROUTINE transform_c2s(CPC_co, CPC_so, maxl, lm1, lm2) DO l = 0, lm2 DO is2 = 1, nso(l) DO ic2 = 1, nco(l) - lx = indco(1, ic2+ncoset(l-1)) - ly = indco(2, ic2+ncoset(l-1)) - lz = indco(3, ic2+ncoset(l-1)) - work(ic1, is2+nsoset(l-1)) = & - work(ic1, is2+nsoset(l-1))+ & - CPC_co(ic1, ic2+ncoset(l-1))* & + lx = indco(1, ic2 + ncoset(l - 1)) + ly = indco(2, ic2 + ncoset(l - 1)) + lz = indco(3, ic2 + ncoset(l - 1)) + work(ic1, is2 + nsoset(l - 1)) = & + work(ic1, is2 + nsoset(l - 1)) + & + CPC_co(ic1, ic2 + ncoset(l - 1))* & orbtramat(l)%c2s(is2, ic2)* & - SQRT(fourpi/dfac(2*l+1)* & - dfac(2*lx-1)*dfac(2*ly-1)*dfac(2*lz-1)) + SQRT(fourpi/dfac(2*l + 1)* & + dfac(2*lx - 1)*dfac(2*ly - 1)*dfac(2*lz - 1)) ! write(*,*) 'dfac 1', dfac(2*lx-1)*dfac(2*ly-1)*dfac(2*lz-1) ENDDO ENDDO @@ -544,15 +544,15 @@ SUBROUTINE transform_c2s(CPC_co, CPC_so, maxl, lm1, lm2) DO l = 0, lm1 DO is1 = 1, nso(l) DO ic1 = 1, nco(l) - lx = indco(1, ic1+ncoset(l-1)) - ly = indco(2, ic1+ncoset(l-1)) - lz = indco(3, ic1+ncoset(l-1)) - CPC_so(is1+nsoset(l-1), is2) = & - CPC_so(is1+nsoset(l-1), is2)+ & - work(ic1+ncoset(l-1), is2)* & + lx = indco(1, ic1 + ncoset(l - 1)) + ly = indco(2, ic1 + ncoset(l - 1)) + lz = indco(3, ic1 + ncoset(l - 1)) + CPC_so(is1 + nsoset(l - 1), is2) = & + CPC_so(is1 + nsoset(l - 1), is2) + & + work(ic1 + ncoset(l - 1), is2)* & orbtramat(l)%c2s(is1, ic1)* & - SQRT(fourpi/dfac(2*l+1)* & - dfac(2*lx-1)*dfac(2*ly-1)*dfac(2*lz-1)) + SQRT(fourpi/dfac(2*l + 1)* & + dfac(2*lx - 1)*dfac(2*ly - 1)*dfac(2*lz - 1)) ! write(*,*) 'dfac 2', dfac(2*lx-1)*dfac(2*ly-1)*dfac(2*lz-1) ENDDO ENDDO @@ -636,16 +636,16 @@ SUBROUTINE transform_s2c(matso, matco, maxl, lm1, lm2) DO is1 = 1, ns1 DO l = 0, lm2 DO ico = 1, nco(l) - ic2 = ncoset(l-1)+ico - lx = indco(1, ico+ncoset(l-1)) - ly = indco(2, ico+ncoset(l-1)) - lz = indco(3, ico+ncoset(l-1)) + ic2 = ncoset(l - 1) + ico + lx = indco(1, ico + ncoset(l - 1)) + ly = indco(2, ico + ncoset(l - 1)) + lz = indco(3, ico + ncoset(l - 1)) DO iso = 1, nso(l) - is2 = nsoset(l-1)+iso - matsc(is1, ic2) = matsc(is1, ic2)+ & + is2 = nsoset(l - 1) + iso + matsc(is1, ic2) = matsc(is1, ic2) + & matso(is1, is2)*orbtramat(l)%s2c(iso, ico)* & - SQRT((fourpi)/dfac(2*l+1)* & - dfac(2*lx-1)*dfac(2*ly-1)*dfac(2*lz-1)) + SQRT((fourpi)/dfac(2*l + 1)* & + dfac(2*lx - 1)*dfac(2*ly - 1)*dfac(2*lz - 1)) ENDDO ! iso ENDDO ! ico ENDDO ! l @@ -655,16 +655,16 @@ SUBROUTINE transform_s2c(matso, matco, maxl, lm1, lm2) DO ic2 = 1, nc2 DO l = 0, lm1 DO ico = 1, nco(l) - ic1 = ncoset(l-1)+ico - lx = indco(1, ico+ncoset(l-1)) - ly = indco(2, ico+ncoset(l-1)) - lz = indco(3, ico+ncoset(l-1)) + ic1 = ncoset(l - 1) + ico + lx = indco(1, ico + ncoset(l - 1)) + ly = indco(2, ico + ncoset(l - 1)) + lz = indco(3, ico + ncoset(l - 1)) DO iso = 1, nso(l) - is1 = nsoset(l-1)+iso - matco(ic1, ic2) = matco(ic1, ic2)+ & + is1 = nsoset(l - 1) + iso + matco(ic1, ic2) = matco(ic1, ic2) + & matsc(is1, ic2)*orbtramat(l)%s2c(iso, ico)* & - SQRT((fourpi)/dfac(2*l+1)* & - dfac(2*lx-1)*dfac(2*ly-1)*dfac(2*lz-1)) + SQRT((fourpi)/dfac(2*l + 1)* & + dfac(2*lx - 1)*dfac(2*ly - 1)*dfac(2*lz - 1)) ENDDO ! iso ENDDO ! ico ENDDO ! l @@ -716,14 +716,14 @@ SUBROUTINE sph2cart_mat(mat, ld_mat, sd_mat, n, lmax1, lmax2) mat_aux(5, idx_l2, :) & = -s_root5o16pi*mat(7, idx_l2, :) & - +s_root15o16pi*mat(9, idx_l2, :) + + s_root15o16pi*mat(9, idx_l2, :) mat_aux(6, idx_l2, :) & = s_root15o4pi*mat(5, idx_l2, :) mat_aux(7, idx_l2, :) & = -s_root5o16pi*mat(7, idx_l2, :) & - -s_root15o16pi*mat(9, idx_l2, :) + - s_root15o16pi*mat(9, idx_l2, :) mat_aux(8, idx_l2, :) & = -s_root15o4pi*mat(8, idx_l2, :) @@ -738,30 +738,30 @@ SUBROUTINE sph2cart_mat(mat, ld_mat, sd_mat, n, lmax1, lmax2) mat_aux(11, idx_l2, :) & = -s_root21o32pi*mat(14, idx_l2, :) & - +s_root35o32pi*mat(16, idx_l2, :) + + s_root35o32pi*mat(16, idx_l2, :) mat_aux(12, idx_l2, :) & = -s_3root35o32pi*mat(10, idx_l2, :) & - +s_root21o32pi*mat(12, idx_l2, :) + + s_root21o32pi*mat(12, idx_l2, :) mat_aux(13, idx_l2, :) & = s_root21o32pi*mat(14, idx_l2, :) & - +s_3root35o32pi*mat(16, idx_l2, :) + + s_3root35o32pi*mat(16, idx_l2, :) mat_aux(14, idx_l2, :) & = s_root35o32pi*mat(10, idx_l2, :) & - +s_root21o32pi*mat(12, idx_l2, :) + + s_root21o32pi*mat(12, idx_l2, :) mat_aux(15, idx_l2, :) & = -s_3root7o16pi*mat(13, idx_l2, :) & - +s_root105o16pi*mat(15, idx_l2, :) + + s_root105o16pi*mat(15, idx_l2, :) mat_aux(16, idx_l2, :) & = s_root105o4pi*mat(11, idx_l2, :) mat_aux(17, idx_l2, :) & = -s_3root7o16pi*mat(13, idx_l2, :) & - -s_root105o16pi*mat(15, idx_l2, :) + - s_root105o16pi*mat(15, idx_l2, :) mat_aux(18, idx_l2, :) & = -s_4root21o32pi*mat(14, idx_l2, :) @@ -794,14 +794,14 @@ SUBROUTINE sph2cart_mat(mat, ld_mat, sd_mat, n, lmax1, lmax2) mat(idx_l1, 5, :) & = -s_root5o16pi*mat_aux(idx_l1, 7, :) & - +s_root15o16pi*mat_aux(idx_l1, 9, :) + + s_root15o16pi*mat_aux(idx_l1, 9, :) mat(idx_l1, 6, :) & = s_root15o4pi*mat_aux(idx_l1, 5, :) mat(idx_l1, 7, :) & = -s_root5o16pi*mat_aux(idx_l1, 7, :) & - -s_root15o16pi*mat_aux(idx_l1, 9, :) + - s_root15o16pi*mat_aux(idx_l1, 9, :) mat(idx_l1, 8, :) & = -s_root15o4pi*mat_aux(idx_l1, 8, :) @@ -816,30 +816,30 @@ SUBROUTINE sph2cart_mat(mat, ld_mat, sd_mat, n, lmax1, lmax2) mat(idx_l1, 11, :) & = -s_root21o32pi*mat_aux(idx_l1, 14, :) & - +s_root35o32pi*mat_aux(idx_l1, 16, :) + + s_root35o32pi*mat_aux(idx_l1, 16, :) mat(idx_l1, 12, :) & = -s_3root35o32pi*mat_aux(idx_l1, 10, :) & - +s_root21o32pi*mat_aux(idx_l1, 12, :) + + s_root21o32pi*mat_aux(idx_l1, 12, :) mat(idx_l1, 13, :) & = s_root21o32pi*mat_aux(idx_l1, 14, :) & - +s_3root35o32pi*mat_aux(idx_l1, 16, :) + + s_3root35o32pi*mat_aux(idx_l1, 16, :) mat(idx_l1, 14, :) & = s_root35o32pi*mat_aux(idx_l1, 10, :) & - +s_root21o32pi*mat_aux(idx_l1, 12, :) + + s_root21o32pi*mat_aux(idx_l1, 12, :) mat(idx_l1, 15, :) & = -s_3root7o16pi*mat_aux(idx_l1, 13, :) & - +s_root105o16pi*mat_aux(idx_l1, 15, :) + + s_root105o16pi*mat_aux(idx_l1, 15, :) mat(idx_l1, 16, :) & = s_root105o4pi*mat_aux(idx_l1, 11, :) mat(idx_l1, 17, :) & = -s_3root7o16pi*mat_aux(idx_l1, 13, :) & - -s_root105o16pi*mat_aux(idx_l1, 15, :) + - s_root105o16pi*mat_aux(idx_l1, 15, :) mat(idx_l1, 18, :) & = -s_4root21o32pi*mat_aux(idx_l1, 14, :) @@ -905,47 +905,47 @@ SUBROUTINE cart2sph_mat(mat, ld_mat, sd_mat, n, lmax1, lmax2) mat_aux(7, idx_l2, :) & = -0.5_dp*root4pio5*mat(5, idx_l2, :) & - -0.5_dp*root4pio5*mat(7, idx_l2, :) & - +root4pio5*mat(10, idx_l2, :) + - 0.5_dp*root4pio5*mat(7, idx_l2, :) & + + root4pio5*mat(10, idx_l2, :) mat_aux(8, idx_l2, :) & = -root4pio15*mat(8, idx_l2, :) mat_aux(9, idx_l2, :) & = 0.5_dp*root4pio15*mat(5, idx_l2, :) & - -0.5_dp*root4pio15*mat(7, idx_l2, :) + - 0.5_dp*root4pio15*mat(7, idx_l2, :) IF (lmax1 == 2) CYCLE mat_aux(10, idx_l2, :) & = -s_3root35o32pi*mat(12, idx_l2, :) & - +s_root35o32pi*mat(14, idx_l2, :) + + s_root35o32pi*mat(14, idx_l2, :) mat_aux(11, idx_l2, :) & = s_root105o4pi*mat(16, idx_l2, :) mat_aux(12, idx_l2, :) & = s_root21o32pi*mat(12, idx_l2, :) & - +s_root21o32pi*mat(14, idx_l2, :) & - -s_4root21o32pi*mat(19, idx_l2, :) + + s_root21o32pi*mat(14, idx_l2, :) & + - s_4root21o32pi*mat(19, idx_l2, :) mat_aux(13, idx_l2, :) & = -s_3root7o16pi*mat(15, idx_l2, :) & - -s_3root7o16pi*mat(17, idx_l2, :) & - +s_2root7o16pi*mat(20, idx_l2, :) + - s_3root7o16pi*mat(17, idx_l2, :) & + + s_2root7o16pi*mat(20, idx_l2, :) mat_aux(14, idx_l2, :) & = s_root21o32pi*mat(11, idx_l2, :) & - +s_root21o32pi*mat(13, idx_l2, :) & - -s_4root21o32pi*mat(18, idx_l2, :) + + s_root21o32pi*mat(13, idx_l2, :) & + - s_4root21o32pi*mat(18, idx_l2, :) mat_aux(15, idx_l2, :) & = s_root105o16pi*mat(15, idx_l2, :) & - -s_root105o16pi*mat(17, idx_l2, :) + - s_root105o16pi*mat(17, idx_l2, :) mat_aux(16, idx_l2, :) & = -s_root35o32pi*mat(11, idx_l2, :) & - +s_3root35o32pi*mat(13, idx_l2, :) + + s_3root35o32pi*mat(13, idx_l2, :) ENDDO @@ -975,47 +975,47 @@ SUBROUTINE cart2sph_mat(mat, ld_mat, sd_mat, n, lmax1, lmax2) mat(idx_lm1, 7, :) & = -0.5_dp*root4pio5*mat_aux(idx_lm1, 5, :) & - -0.5_dp*root4pio5*mat_aux(idx_lm1, 7, :) & - +root4pio5*mat_aux(idx_lm1, 10, :) + - 0.5_dp*root4pio5*mat_aux(idx_lm1, 7, :) & + + root4pio5*mat_aux(idx_lm1, 10, :) mat(idx_lm1, 8, :) & = -root4pio15*mat_aux(idx_lm1, 8, :) mat(idx_lm1, 9, :) & = 0.5_dp*root4pio15*mat_aux(idx_lm1, 5, :) & - -0.5_dp*root4pio15*mat_aux(idx_lm1, 7, :) + - 0.5_dp*root4pio15*mat_aux(idx_lm1, 7, :) IF (lmax2 == 2) CYCLE mat(idx_lm1, 10, :) & = -s_3root35o32pi*mat_aux(idx_lm1, 12, :) & - +s_root35o32pi*mat_aux(idx_lm1, 14, :) + + s_root35o32pi*mat_aux(idx_lm1, 14, :) mat(idx_lm1, 11, :) & = s_root105o4pi*mat_aux(idx_lm1, 16, :) mat(idx_lm1, 12, :) & = s_root21o32pi*mat_aux(idx_lm1, 12, :) & - +s_root21o32pi*mat_aux(idx_lm1, 14, :) & - -s_4root21o32pi*mat_aux(idx_lm1, 19, :) + + s_root21o32pi*mat_aux(idx_lm1, 14, :) & + - s_4root21o32pi*mat_aux(idx_lm1, 19, :) mat(idx_lm1, 13, :) & = -s_3root7o16pi*mat_aux(idx_lm1, 15, :) & - -s_3root7o16pi*mat_aux(idx_lm1, 17, :) & - +s_2root7o16pi*mat_aux(idx_lm1, 20, :) + - s_3root7o16pi*mat_aux(idx_lm1, 17, :) & + + s_2root7o16pi*mat_aux(idx_lm1, 20, :) mat(idx_lm1, 14, :) & = s_root21o32pi*mat_aux(idx_lm1, 11, :) & - +s_root21o32pi*mat_aux(idx_lm1, 13, :) & - -s_4root21o32pi*mat_aux(idx_lm1, 18, :) + + s_root21o32pi*mat_aux(idx_lm1, 13, :) & + - s_4root21o32pi*mat_aux(idx_lm1, 18, :) mat(idx_lm1, 15, :) & = s_root105o16pi*mat_aux(idx_lm1, 15, :) & - -s_root105o16pi*mat_aux(idx_lm1, 17, :) + - s_root105o16pi*mat_aux(idx_lm1, 17, :) mat(idx_lm1, 16, :) & = -s_root35o32pi*mat_aux(idx_lm1, 11, :) & - +s_3root35o32pi*mat_aux(idx_lm1, 13, :) + + s_3root35o32pi*mat_aux(idx_lm1, 13, :) ENDDO diff --git a/src/aobasis/aux_basis_set.F b/src/aobasis/aux_basis_set.F index ba151866d7..10507e212f 100644 --- a/src/aobasis/aux_basis_set.F +++ b/src/aobasis/aux_basis_set.F @@ -82,7 +82,7 @@ SUBROUTINE create_aux_basis(aux_basis, bsname, nsets, lmin, lmax, nl, npgf, zet) DO iset = 1, nsets aux_basis%nshell(iset) = 0 DO l = lmin(iset), lmax(iset) - aux_basis%nshell(iset) = aux_basis%nshell(iset)+nl(l, iset) + aux_basis%nshell(iset) = aux_basis%nshell(iset) + nl(l, iset) END DO END DO maxpgf = MAXVAL(npgf(1:nsets)) @@ -98,9 +98,9 @@ SUBROUTINE create_aux_basis(aux_basis, bsname, nsets, lmin, lmax, nl, npgf, zet) ns = 0 DO l = lmin(iset), lmax(iset) DO i = 1, nl(l, iset) - ns = ns+1 + ns = ns + 1 aux_basis%l(ns, iset) = l - aux_basis%n(ns, iset) = l+i + aux_basis%n(ns, iset) = l + i END DO END DO END DO @@ -114,11 +114,11 @@ SUBROUTINE create_aux_basis(aux_basis, bsname, nsets, lmin, lmax, nl, npgf, zet) ALLOCATE (so(nx, nx)) CPASSERT(nx >= nl(l, iset)) DO i = 1, nx - za = (2.0_dp*zet(i, iset))**(0.25_dp*(2*l+3)) + za = (2.0_dp*zet(i, iset))**(0.25_dp*(2*l + 3)) DO j = i, nx - zb = (2.0_dp*zet(j, iset))**(0.25_dp*(2*l+3)) - zetab = zet(i, iset)+zet(j, iset) - so(i, j) = za*zb/zetab**(l+1.5_dp) + zb = (2.0_dp*zet(j, iset))**(0.25_dp*(2*l + 3)) + zetab = zet(i, iset) + zet(j, iset) + so(i, j) = za*zb/zetab**(l + 1.5_dp) so(j, i) = so(i, j) END DO END DO @@ -127,18 +127,18 @@ SUBROUTINE create_aux_basis(aux_basis, bsname, nsets, lmin, lmax, nl, npgf, zet) CPASSERT(info == 0) CALL dtrtri("U", "N", nx, so, nx, info) CPASSERT(info == 0) - DO i = ns+1, ns+nl(l, iset) - DO j = 1, i-ns - aux_basis%gcc(j, i, iset) = so(j, i-ns) + DO i = ns + 1, ns + nl(l, iset) + DO j = 1, i - ns + aux_basis%gcc(j, i, iset) = so(j, i - ns) END DO END DO IF (nl(l, iset) < nx) THEN - i = ns+nl(l, iset) - DO j = nl(l, iset)+1, nx + i = ns + nl(l, iset) + DO j = nl(l, iset) + 1, nx aux_basis%gcc(j, i, iset) = 1.0_dp END DO END IF - ns = ns+nl(l, iset) + ns = ns + nl(l, iset) DEALLOCATE (so) END DO END DO @@ -159,16 +159,16 @@ SUBROUTINE create_aux_basis(aux_basis, bsname, nsets, lmin, lmax, nl, npgf, zet) aux_basis%nsgf_set(iset) = 0 DO ishell = 1, aux_basis%nshell(iset) lshell = aux_basis%l(ishell, iset) - aux_basis%first_cgf(ishell, iset) = ncgf+1 - ncgf = ncgf+nco(lshell) + aux_basis%first_cgf(ishell, iset) = ncgf + 1 + ncgf = ncgf + nco(lshell) aux_basis%last_cgf(ishell, iset) = ncgf aux_basis%ncgf_set(iset) = & - aux_basis%ncgf_set(iset)+nco(lshell) - aux_basis%first_sgf(ishell, iset) = nsgf+1 - nsgf = nsgf+nso(lshell) + aux_basis%ncgf_set(iset) + nco(lshell) + aux_basis%first_sgf(ishell, iset) = nsgf + 1 + nsgf = nsgf + nso(lshell) aux_basis%last_sgf(ishell, iset) = nsgf aux_basis%nsgf_set(iset) = & - aux_basis%nsgf_set(iset)+nso(lshell) + aux_basis%nsgf_set(iset) + nso(lshell) END DO maxco = MAX(maxco, npgf(iset)*ncoset(lmax(iset))) END DO @@ -188,8 +188,8 @@ SUBROUTINE create_aux_basis(aux_basis, bsname, nsets, lmin, lmax, nl, npgf, zet) DO iset = 1, nsets DO ishell = 1, aux_basis%nshell(iset) lshell = aux_basis%l(ishell, iset) - DO ico = ncoset(lshell-1)+1, ncoset(lshell) - ncgf = ncgf+1 + DO ico = ncoset(lshell - 1) + 1, ncoset(lshell) + ncgf = ncgf + 1 aux_basis%lx(ncgf) = indco(1, ico) aux_basis%ly(ncgf) = indco(2, ico) aux_basis%lz(ncgf) = indco(3, ico) @@ -199,7 +199,7 @@ SUBROUTINE create_aux_basis(aux_basis, bsname, nsets, lmin, lmax, nl, npgf, zet) aux_basis%lz(ncgf)/)) END DO DO m = -lshell, lshell - nsgf = nsgf+1 + nsgf = nsgf + 1 aux_basis%m(nsgf) = m aux_basis%sgf_symbol(nsgf) = & sgf_symbol(aux_basis%n(ishell, iset), lshell, m) diff --git a/src/aobasis/basis_set_container_types.F b/src/aobasis/basis_set_container_types.F index d6f5dcecba..f24d8602c1 100644 --- a/src/aobasis/basis_set_container_types.F +++ b/src/aobasis/basis_set_container_types.F @@ -196,11 +196,11 @@ SUBROUTINE remove_basis_from_container(container, inum, basis_type) END IF END IF ! shift other basis sets - DO i = ibas+1, SIZE(container) + DO i = ibas + 1, SIZE(container) IF (container(i)%basis_type_nr == 0) CYCLE - container(i-1)%basis_type = container(i)%basis_type - container(i-1)%basis_set => container(i)%basis_set - container(i-1)%basis_type_nr = container(i)%basis_type_nr + container(i - 1)%basis_type = container(i)%basis_type + container(i - 1)%basis_set => container(i)%basis_set + container(i - 1)%basis_type_nr = container(i)%basis_type_nr container(i)%basis_type = "" container(i)%basis_type_nr = 0 NULLIFY (container(i)%basis_set) diff --git a/src/aobasis/basis_set_types.F b/src/aobasis/basis_set_types.F index 98e2cb660e..fd11250c14 100644 --- a/src/aobasis/basis_set_types.F +++ b/src/aobasis/basis_set_types.F @@ -339,7 +339,7 @@ SUBROUTINE create_primitive_basis_set(basis_set, pbasis) mpgf = SUM(basis_set%npgf) lm = MAXVAL(basis_set%lmax) - ALLOCATE (zet(mpgf, 0:lm), zeta(mpgf, lm+1), nindex(mpgf), nprim(0:lm)) + ALLOCATE (zet(mpgf, 0:lm), zeta(mpgf, lm + 1), nindex(mpgf), nprim(0:lm)) zet = 0.0_dp zeta = 0.0_dp DO l = 0, lm @@ -347,7 +347,7 @@ SUBROUTINE create_primitive_basis_set(basis_set, pbasis) DO iset = 1, basis_set%nset IF (basis_set%lmin(iset) <= l .AND. basis_set%lmax(iset) >= l) THEN DO ipgf = 1, basis_set%npgf(iset) - ip = ip+1 + ip = ip + 1 zet(ip, l) = basis_set%zet(ipgf, iset) END DO END IF @@ -363,14 +363,14 @@ SUBROUTINE create_primitive_basis_set(basis_set, pbasis) ip = 0 zet0 = 0.0_dp DO i = 1, nprim(l) - IF (ABS(zet0-zet(i, l)) > 1.e-6_dp) THEN - ip = ip+1 - zeta(ip, l+1) = zet(i, l) + IF (ABS(zet0 - zet(i, l)) > 1.e-6_dp) THEN + ip = ip + 1 + zeta(ip, l + 1) = zet(i, l) END IF END DO nprim(l) = ip ! - zeta(1:ip, l+1) = -zeta(1:ip, l+1) + zeta(1:ip, l + 1) = -zeta(1:ip, l + 1) END DO CALL allocate_gto_basis_set(pbasis) @@ -379,20 +379,20 @@ SUBROUTINE create_primitive_basis_set(basis_set, pbasis) pbasis%kind_radius = basis_set%kind_radius pbasis%short_kind_radius = basis_set%short_kind_radius pbasis%norm_type = basis_set%norm_type - nset = lm+1 + nset = lm + 1 pbasis%nset = nset ALLOCATE (pbasis%lmax(nset), pbasis%lmin(nset), pbasis%npgf(nset), pbasis%nshell(nset)) DO iset = 1, nset - pbasis%lmax(iset) = iset-1 - pbasis%lmin(iset) = iset-1 - pbasis%npgf(iset) = nprim(iset-1) - pbasis%nshell(iset) = nprim(iset-1) + pbasis%lmax(iset) = iset - 1 + pbasis%lmin(iset) = iset - 1 + pbasis%npgf(iset) = nprim(iset - 1) + pbasis%nshell(iset) = nprim(iset - 1) END DO pbasis%ncgf = 0 pbasis%nsgf = 0 DO l = 0, lm - pbasis%ncgf = pbasis%ncgf+nprim(l)*((l+1)*(l+2))/2 - pbasis%nsgf = pbasis%nsgf+nprim(l)*(2*l+1) + pbasis%ncgf = pbasis%ncgf + nprim(l)*((l + 1)*(l + 2))/2 + pbasis%nsgf = pbasis%nsgf + nprim(l)*(2*l + 1) END DO mpgf = MAXVAL(nprim) ALLOCATE (pbasis%zet(mpgf, nset)) @@ -400,9 +400,9 @@ SUBROUTINE create_primitive_basis_set(basis_set, pbasis) ALLOCATE (pbasis%l(mpgf, nset), pbasis%n(mpgf, nset)) DO iset = 1, nset - DO ip = 1, nprim(iset-1) - pbasis%l(ip, iset) = iset-1 - pbasis%n(ip, iset) = iset+ip-1 + DO ip = 1, nprim(iset - 1) + pbasis%l(ip, iset) = iset - 1 + pbasis%n(ip, iset) = iset + ip - 1 END DO END DO @@ -417,13 +417,13 @@ SUBROUTINE create_primitive_basis_set(basis_set, pbasis) ncgf = 0 nsgf = 0 DO iset = 1, nset - l = iset-1 - pbasis%ncgf_set(iset) = nprim(l)*((l+1)*(l+2))/2 - pbasis%nsgf_set(iset) = nprim(l)*(2*l+1) + l = iset - 1 + pbasis%ncgf_set(iset) = nprim(l)*((l + 1)*(l + 2))/2 + pbasis%nsgf_set(iset) = nprim(l)*(2*l + 1) DO ishell = 1, pbasis%nshell(iset) lshell = pbasis%l(ishell, iset) - DO ico = ncoset(lshell-1)+1, ncoset(lshell) - ncgf = ncgf+1 + DO ico = ncoset(lshell - 1) + 1, ncoset(lshell) + ncgf = ncgf + 1 pbasis%lx(ncgf) = indco(1, ico) pbasis%ly(ncgf) = indco(2, ico) pbasis%lz(ncgf) = indco(3, ico) @@ -431,7 +431,7 @@ SUBROUTINE create_primitive_basis_set(basis_set, pbasis) cgf_symbol(pbasis%n(ishell, iset), (/pbasis%lx(ncgf), pbasis%ly(ncgf), pbasis%lz(ncgf)/)) END DO DO m = -lshell, lshell - nsgf = nsgf+1 + nsgf = nsgf + 1 pbasis%m(nsgf) = m pbasis%sgf_symbol(nsgf) = sgf_symbol(pbasis%n(ishell, iset), lshell, m) END DO @@ -458,11 +458,11 @@ SUBROUTINE create_primitive_basis_set(basis_set, pbasis) DO iset = 1, nset DO ishell = 1, pbasis%nshell(iset) lshell = pbasis%l(ishell, iset) - pbasis%first_cgf(ishell, iset) = nc+1 - nc = nc+nco(lshell) + pbasis%first_cgf(ishell, iset) = nc + 1 + nc = nc + nco(lshell) pbasis%last_cgf(ishell, iset) = nc - pbasis%first_sgf(ishell, iset) = ns+1 - ns = ns+nso(lshell) + pbasis%first_sgf(ishell, iset) = ns + 1 + ns = ns + nso(lshell) pbasis%last_sgf(ishell, iset) = ns END DO maxco = MAX(maxco, pbasis%npgf(iset)*ncoset(pbasis%lmax(iset))) @@ -513,39 +513,39 @@ SUBROUTINE combine_basis_sets(basis_set, basis_set_add) bout => basis_set bout%name = bout%name//bad%name - bout%nset = bout%nset+bad%nset - bout%ncgf = bout%ncgf+bad%ncgf - bout%nsgf = bout%nsgf+bad%nsgf + bout%nset = bout%nset + bad%nset + bout%ncgf = bout%ncgf + bad%ncgf + bout%nsgf = bout%nsgf + bad%nsgf nset = bout%nset ncgf = bout%ncgf nsgf = bout%nsgf nsetn = bad%nset - nseto = nset-nsetn + nseto = nset - nsetn CALL reallocate(bout%set_radius, 1, nset) ! to be defined later CALL reallocate(bout%lmax, 1, nset) CALL reallocate(bout%lmin, 1, nset) CALL reallocate(bout%npgf, 1, nset) CALL reallocate(bout%nshell, 1, nset) - bout%lmax(nseto+1:nset) = bad%lmax(1:nsetn) - bout%lmin(nseto+1:nset) = bad%lmin(1:nsetn) - bout%npgf(nseto+1:nset) = bad%npgf(1:nsetn) - bout%nshell(nseto+1:nset) = bad%nshell(1:nsetn) + bout%lmax(nseto + 1:nset) = bad%lmax(1:nsetn) + bout%lmin(nseto + 1:nset) = bad%lmin(1:nsetn) + bout%npgf(nseto + 1:nset) = bad%npgf(1:nsetn) + bout%nshell(nseto + 1:nset) = bad%nshell(1:nsetn) CALL reallocate(bout%ncgf_set, 1, nset) CALL reallocate(bout%nsgf_set, 1, nset) - bout%ncgf_set(nseto+1:nset) = bad%ncgf_set(1:nsetn) - bout%nsgf_set(nseto+1:nset) = bad%nsgf_set(1:nsetn) + bout%ncgf_set(nseto + 1:nset) = bad%ncgf_set(1:nsetn) + bout%nsgf_set(nseto + 1:nset) = bad%nsgf_set(1:nsetn) nsgfn = bad%nsgf - nsgfo = nsgf-nsgfn + nsgfo = nsgf - nsgfn ncgfn = bad%ncgf - ncgfo = ncgf-ncgfn + ncgfo = ncgf - ncgfn ALLOCATE (cgf_symbol(ncgf), sgf_symbol(nsgf)) cgf_symbol(1:ncgfo) = bout%cgf_symbol(1:ncgfo) - cgf_symbol(ncgfo+1:ncgf) = bad%cgf_symbol(1:ncgfn) + cgf_symbol(ncgfo + 1:ncgf) = bad%cgf_symbol(1:ncgfn) sgf_symbol(1:nsgfo) = bout%sgf_symbol(1:nsgfo) - sgf_symbol(nsgfo+1:nsgf) = bad%sgf_symbol(1:nsgfn) + sgf_symbol(nsgfo + 1:nsgf) = bad%sgf_symbol(1:nsgfn) DEALLOCATE (bout%cgf_symbol, bout%sgf_symbol) ALLOCATE (bout%cgf_symbol(ncgf), bout%sgf_symbol(nsgf)) bout%cgf_symbol = cgf_symbol @@ -556,16 +556,16 @@ SUBROUTINE combine_basis_sets(basis_set, basis_set_add) CALL reallocate(bout%ly, 1, ncgf) CALL reallocate(bout%lz, 1, ncgf) CALL reallocate(bout%m, 1, nsgf) - bout%lx(ncgfo+1:ncgf) = bad%lx(1:ncgfn) - bout%ly(ncgfo+1:ncgf) = bad%ly(1:ncgfn) - bout%lz(ncgfo+1:ncgf) = bad%lz(1:ncgfn) - bout%m(nsgfo+1:nsgf) = bad%m(1:nsgfn) + bout%lx(ncgfo + 1:ncgf) = bad%lx(1:ncgfn) + bout%ly(ncgfo + 1:ncgf) = bad%ly(1:ncgfn) + bout%lz(ncgfo + 1:ncgf) = bad%lz(1:ncgfn) + bout%m(nsgfo + 1:nsgf) = bad%m(1:nsgfn) maxpgf = MAXVAL(bout%npgf) CALL reallocate(bout%zet, 1, maxpgf, 1, nset) nc = SIZE(bad%zet, 1) DO iset = 1, nsetn - bout%zet(1:nc, nseto+iset) = bad%zet(1:nc, iset) + bout%zet(1:nc, nseto + iset) = bad%zet(1:nc, iset) END DO maxshell = MAXVAL(bout%nshell) @@ -573,8 +573,8 @@ SUBROUTINE combine_basis_sets(basis_set, basis_set_add) CALL reallocate(bout%n, 1, maxshell, 1, nset) nc = SIZE(bad%l, 1) DO iset = 1, nsetn - bout%l(1:nc, nseto+iset) = bad%l(1:nc, iset) - bout%n(1:nc, nseto+iset) = bad%n(1:nc, iset) + bout%l(1:nc, nseto + iset) = bad%l(1:nc, iset) + bout%n(1:nc, nseto + iset) = bad%n(1:nc, iset) END DO CALL reallocate(bout%first_cgf, 1, maxshell, 1, nset) @@ -586,11 +586,11 @@ SUBROUTINE combine_basis_sets(basis_set, basis_set_add) DO iset = 1, nset DO ishell = 1, bout%nshell(iset) lshell = bout%l(ishell, iset) - bout%first_cgf(ishell, iset) = nc+1 - nc = nc+nco(lshell) + bout%first_cgf(ishell, iset) = nc + 1 + nc = nc + nco(lshell) bout%last_cgf(ishell, iset) = nc - bout%first_sgf(ishell, iset) = ns+1 - ns = ns+nso(lshell) + bout%first_sgf(ishell, iset) = ns + 1 + ns = ns + nso(lshell) bout%last_sgf(ishell, iset) = ns END DO END DO @@ -599,7 +599,7 @@ SUBROUTINE combine_basis_sets(basis_set, basis_set_add) nc = SIZE(bad%gcc, 1) ns = SIZE(bad%gcc, 2) DO iset = 1, nsetn - bout%gcc(1:nc, 1:ns, nseto+iset) = bad%gcc(1:nc, 1:ns, iset) + bout%gcc(1:nc, 1:ns, nseto + iset) = bad%gcc(1:nc, 1:ns, iset) END DO ! these arrays are determined later using initialization calls @@ -743,7 +743,7 @@ SUBROUTINE get_gto_basis_set(gto_basis_set, name, aliases, norm_type, kind_radiu END IF DO iset = 1, gto_basis_set%nset maxco = MAX(maxco, gto_basis_set%npgf(iset)* & - ncoset(gto_basis_set%lmax(iset)+nder)) + ncoset(gto_basis_set%lmax(iset) + nder)) END DO END IF IF (PRESENT(maxl)) THEN @@ -781,7 +781,7 @@ SUBROUTINE get_gto_basis_set(gto_basis_set, name, aliases, norm_type, kind_radiu IF (PRESENT(nco_sum)) THEN nco_sum = 0 DO iset = 1, gto_basis_set%nset - nco_sum = nco_sum+gto_basis_set%npgf(iset)* & + nco_sum = nco_sum + gto_basis_set%npgf(iset)* & ncoset(gto_basis_set%lmax(iset)) END DO END IF @@ -874,7 +874,7 @@ SUBROUTINE init_cphi_and_sphi(gto_basis_set) DO ipgf = 1, gto_basis_set%npgf(iset) gto_basis_set%cphi(ico, icgf) = gto_basis_set%norm_cgf(icgf)* & gto_basis_set%gcc(ipgf, ishell, iset) - ico = ico+n + ico = ico + n END DO END DO END DO @@ -913,14 +913,14 @@ SUBROUTINE init_cphi_and_sphi(gto_basis_set) lmin = gto_basis_set%lmin(iset) lmax = gto_basis_set%lmax(iset) npgf = gto_basis_set%npgf(iset) - nn = ncoset(lmax)-ncoset(lmin-1) + nn = ncoset(lmax) - ncoset(lmin - 1) DO ishell = 1, gto_basis_set%nshell(iset) first_sgf = gto_basis_set%first_sgf(ishell, iset) last_sgf = gto_basis_set%last_sgf(ishell, iset) DO ipgf = 1, npgf - nn1 = (ipgf-1)*ncoset(lmax)+ncoset(lmin-1)+1 + nn1 = (ipgf - 1)*ncoset(lmax) + ncoset(lmin - 1) + 1 nn2 = ipgf*ncoset(lmax) - n1 = (ipgf-1)*nn+1 + n1 = (ipgf - 1)*nn + 1 n2 = ipgf*nn gto_basis_set%scon(n1:n2, first_sgf:last_sgf) = gto_basis_set%sphi(nn1:nn2, first_sgf:last_sgf) END DO @@ -967,8 +967,8 @@ SUBROUTINE init_norm_cgf_aux(gto_basis_set) END DO ALLOCATE (gaa(n, n)) - ALLOCATE (vv(ncoset(ll), ncoset(ll), ll+ll+1)) - ALLOCATE (ff(0:ll+ll)) + ALLOCATE (vv(ncoset(ll), ncoset(ll), ll + ll + 1)) + ALLOCATE (ff(0:ll + ll)) DO iset = 1, gto_basis_set%nset lmax = gto_basis_set%lmax(iset) @@ -993,10 +993,10 @@ SUBROUTINE init_norm_cgf_aux(gto_basis_set) jco = coset(lx, ly, lz) DO jpgf = 1, npgfa gccb = gto_basis_set%gcc(jpgf, ishell, iset) - fnorm = fnorm+gcca*gccb*gaa(ico, jco) - jco = jco+n + fnorm = fnorm + gcca*gccb*gaa(ico, jco) + jco = jco + n END DO - ico = ico+n + ico = ico + n END DO gto_basis_set%norm_cgf(icgf) = 1.0_dp/SQRT(fnorm) END DO @@ -1061,7 +1061,7 @@ SUBROUTINE init_norm_cgf_orb(gto_basis_set) l = gto_basis_set%l(ishell, iset) - expzet = 0.5_dp*REAL(2*l+3, dp) + expzet = 0.5_dp*REAL(2*l + 3, dp) fnorm = 0.0_dp @@ -1071,7 +1071,7 @@ SUBROUTINE init_norm_cgf_orb(gto_basis_set) DO jpgf = 1, gto_basis_set%npgf(iset) gccb = gto_basis_set%gcc(jpgf, ishell, iset) zetb = gto_basis_set%zet(jpgf, iset) - fnorm = fnorm+gcca*gccb/(zeta+zetb)**expzet + fnorm = fnorm + gcca*gccb/(zeta + zetb)**expzet END DO END DO @@ -1082,7 +1082,7 @@ SUBROUTINE init_norm_cgf_orb(gto_basis_set) lx = gto_basis_set%lx(icgf) ly = gto_basis_set%ly(icgf) lz = gto_basis_set%lz(icgf) - prefac = dfac(2*lx-1)*dfac(2*ly-1)*dfac(2*lz-1) + prefac = dfac(2*lx - 1)*dfac(2*ly - 1)*dfac(2*lz - 1) gto_basis_set%norm_cgf(icgf) = 1.0_dp/SQRT(prefac*fnorm) END DO @@ -1112,7 +1112,7 @@ SUBROUTINE init_norm_cgf_orb_den(gto_basis_set) DO iset = 1, gto_basis_set%nset DO ishell = 1, gto_basis_set%nshell(iset) l = gto_basis_set%l(ishell, iset) - expzet = 0.5_dp*REAL(2*l+3, dp) + expzet = 0.5_dp*REAL(2*l + 3, dp) prefac = (1.0_dp/pi)**1.5_dp DO ipgf = 1, gto_basis_set%npgf(iset) gcca = gto_basis_set%gcc(ipgf, ishell, iset) @@ -1195,7 +1195,7 @@ SUBROUTINE normalise_gcc_orb(gto_basis_set) DO iset = 1, gto_basis_set%nset DO ishell = 1, gto_basis_set%nshell(iset) l = gto_basis_set%l(ishell, iset) - expzet = 0.25_dp*REAL(2*l+3, dp) + expzet = 0.25_dp*REAL(2*l + 3, dp) prefac = 2.0_dp**l*(2.0_dp/pi)**0.75_dp DO ipgf = 1, gto_basis_set%npgf(iset) gcca = gto_basis_set%gcc(ipgf, ishell, iset) @@ -1340,15 +1340,15 @@ SUBROUTINE read_gto_basis_set1(element_symbol, basis_set_name, gto_basis_set, & line2 = " "//line//" " symbol2 = " "//TRIM(symbol)//" " bsname2 = " "//TRIM(bsname)//" " - strlen1 = LEN_TRIM(symbol2)+1 - strlen2 = LEN_TRIM(bsname2)+1 + strlen1 = LEN_TRIM(symbol2) + 1 + strlen2 = LEN_TRIM(bsname2) + 1 IF ((INDEX(line2, symbol2(:strlen1)) > 0) .AND. & (INDEX(line2, bsname2(:strlen2)) > 0)) match = .TRUE. IF (match) THEN ! copy all names into aliases field i = INDEX(line2, symbol2(:strlen1)) - i = i+1+INDEX(line2(i+1:), " ") + i = i + 1 + INDEX(line2(i + 1:), " ") gto_basis_set%aliases = line2(i:) NULLIFY (gcc, l, lmax, lmin, n, npgf, nshell, zet) @@ -1378,9 +1378,9 @@ SUBROUTINE read_gto_basis_set1(element_symbol, basis_set_name, gto_basis_set, & END IF nshell(iset) = 0 DO lshell = lmin(iset), lmax(iset) - nmin = n(1, iset)+lshell-lmin(iset) + nmin = n(1, iset) + lshell - lmin(iset) CALL parser_get_object(parser, ishell) - nshell(iset) = nshell(iset)+ishell + nshell(iset) = nshell(iset) + ishell IF (nshell(iset) > maxshell) THEN maxshell = nshell(iset) CALL reallocate(n, 1, maxshell, 1, nset) @@ -1388,8 +1388,8 @@ SUBROUTINE read_gto_basis_set1(element_symbol, basis_set_name, gto_basis_set, & CALL reallocate(gcc, 1, maxpgf, 1, maxshell, 1, nset) END IF DO i = 1, ishell - n(nshell(iset)-ishell+i, iset) = nmin+i-1 - l(nshell(iset)-ishell+i, iset) = lshell + n(nshell(iset) - ishell + i, iset) = nmin + i - 1 + l(nshell(iset) - ishell + i, iset) = lshell END DO END DO DO ipgf = 1, npgf(iset) @@ -1455,16 +1455,16 @@ SUBROUTINE read_gto_basis_set1(element_symbol, basis_set_name, gto_basis_set, & gto_basis_set%nsgf_set(iset) = 0 DO ishell = 1, nshell(iset) lshell = gto_basis_set%l(ishell, iset) - gto_basis_set%first_cgf(ishell, iset) = ncgf+1 - ncgf = ncgf+nco(lshell) + gto_basis_set%first_cgf(ishell, iset) = ncgf + 1 + ncgf = ncgf + nco(lshell) gto_basis_set%last_cgf(ishell, iset) = ncgf gto_basis_set%ncgf_set(iset) = & - gto_basis_set%ncgf_set(iset)+nco(lshell) - gto_basis_set%first_sgf(ishell, iset) = nsgf+1 - nsgf = nsgf+nso(lshell) + gto_basis_set%ncgf_set(iset) + nco(lshell) + gto_basis_set%first_sgf(ishell, iset) = nsgf + 1 + nsgf = nsgf + nso(lshell) gto_basis_set%last_sgf(ishell, iset) = nsgf gto_basis_set%nsgf_set(iset) = & - gto_basis_set%nsgf_set(iset)+nso(lshell) + gto_basis_set%nsgf_set(iset) + nso(lshell) END DO maxco = MAX(maxco, npgf(iset)*ncoset(lmax(iset))) END DO @@ -1490,8 +1490,8 @@ SUBROUTINE read_gto_basis_set1(element_symbol, basis_set_name, gto_basis_set, & DO iset = 1, nset DO ishell = 1, nshell(iset) lshell = gto_basis_set%l(ishell, iset) - DO ico = ncoset(lshell-1)+1, ncoset(lshell) - ncgf = ncgf+1 + DO ico = ncoset(lshell - 1) + 1, ncoset(lshell) + ncgf = ncgf + 1 gto_basis_set%lx(ncgf) = indco(1, ico) gto_basis_set%ly(ncgf) = indco(2, ico) gto_basis_set%lz(ncgf) = indco(3, ico) @@ -1501,7 +1501,7 @@ SUBROUTINE read_gto_basis_set1(element_symbol, basis_set_name, gto_basis_set, & gto_basis_set%lz(ncgf)/)) END DO DO m = -lshell, lshell - nsgf = nsgf+1 + nsgf = nsgf + 1 gto_basis_set%m(nsgf) = m gto_basis_set%sgf_symbol(nsgf) = & sgf_symbol(n(ishell, iset), lshell, m) @@ -1679,10 +1679,10 @@ SUBROUTINE read_gto_basis_set2(element_symbol, basis_type, gto_basis_set, & END IF nshell(iset) = 0 DO lshell = lmin(iset), lmax(iset) - nmin = n(1, iset)+lshell-lmin(iset) + nmin = n(1, iset) + lshell - lmin(iset) READ (line_att, *) ishell CALL remove_word(line_att) - nshell(iset) = nshell(iset)+ishell + nshell(iset) = nshell(iset) + ishell IF (nshell(iset) > maxshell) THEN maxshell = nshell(iset) CALL reallocate(n, 1, maxshell, 1, nset) @@ -1690,8 +1690,8 @@ SUBROUTINE read_gto_basis_set2(element_symbol, basis_type, gto_basis_set, & CALL reallocate(gcc, 1, maxpgf, 1, maxshell, 1, nset) END IF DO i = 1, ishell - n(nshell(iset)-ishell+i, iset) = nmin+i-1 - l(nshell(iset)-ishell+i, iset) = lshell + n(nshell(iset) - ishell + i, iset) = nmin + i - 1 + l(nshell(iset) - ishell + i, iset) = lshell END DO END DO IF (LEN_TRIM(line_att) /= 0) & @@ -1759,16 +1759,16 @@ SUBROUTINE read_gto_basis_set2(element_symbol, basis_type, gto_basis_set, & gto_basis_set%nsgf_set(iset) = 0 DO ishell = 1, nshell(iset) lshell = gto_basis_set%l(ishell, iset) - gto_basis_set%first_cgf(ishell, iset) = ncgf+1 - ncgf = ncgf+nco(lshell) + gto_basis_set%first_cgf(ishell, iset) = ncgf + 1 + ncgf = ncgf + nco(lshell) gto_basis_set%last_cgf(ishell, iset) = ncgf gto_basis_set%ncgf_set(iset) = & - gto_basis_set%ncgf_set(iset)+nco(lshell) - gto_basis_set%first_sgf(ishell, iset) = nsgf+1 - nsgf = nsgf+nso(lshell) + gto_basis_set%ncgf_set(iset) + nco(lshell) + gto_basis_set%first_sgf(ishell, iset) = nsgf + 1 + nsgf = nsgf + nso(lshell) gto_basis_set%last_sgf(ishell, iset) = nsgf gto_basis_set%nsgf_set(iset) = & - gto_basis_set%nsgf_set(iset)+nso(lshell) + gto_basis_set%nsgf_set(iset) + nso(lshell) END DO maxco = MAX(maxco, npgf(iset)*ncoset(lmax(iset))) END DO @@ -1794,8 +1794,8 @@ SUBROUTINE read_gto_basis_set2(element_symbol, basis_type, gto_basis_set, & DO iset = 1, nset DO ishell = 1, nshell(iset) lshell = gto_basis_set%l(ishell, iset) - DO ico = ncoset(lshell-1)+1, ncoset(lshell) - ncgf = ncgf+1 + DO ico = ncoset(lshell - 1) + 1, ncoset(lshell) + ncgf = ncgf + 1 gto_basis_set%lx(ncgf) = indco(1, ico) gto_basis_set%ly(ncgf) = indco(2, ico) gto_basis_set%lz(ncgf) = indco(3, ico) @@ -1805,7 +1805,7 @@ SUBROUTINE read_gto_basis_set2(element_symbol, basis_type, gto_basis_set, & gto_basis_set%lz(ncgf)/)) END DO DO m = -lshell, lshell - nsgf = nsgf+1 + nsgf = nsgf + 1 gto_basis_set%m(nsgf) = m gto_basis_set%sgf_symbol(nsgf) = & sgf_symbol(n(ishell, iset), lshell, m) @@ -2044,7 +2044,7 @@ SUBROUTINE write_orb_basis_set(orb_basis_set, output_unit, header) DO ishell = 1, orb_basis_set%nshell(iset) WRITE (UNIT=output_unit, FMT="(A)") "" DO ico = 1, nco(orb_basis_set%l(ishell, iset)) - icgf = icgf+1 + icgf = icgf + 1 WRITE (UNIT=output_unit, & FMT="(T25,I3,4X,I4,3X,A12,(T51,2F15.6))") & iset, ishell, orb_basis_set%cgf_symbol(icgf), & @@ -2158,7 +2158,7 @@ SUBROUTINE get_sto_basis_set(sto_basis_set, name, nshell, symbol, nq, lq, zet, m IF (PRESENT(numsto)) THEN numsto = 0 DO iset = 1, sto_basis_set%nshell - numsto = numsto+2*sto_basis_set%lq(iset)+1 + numsto = numsto + 2*sto_basis_set%lq(iset) + 1 END DO END IF ELSE @@ -2314,8 +2314,8 @@ SUBROUTINE read_sto_basis_set(element_symbol, basis_set_name, sto_basis_set, par line2 = " "//line//" " symbol2 = " "//TRIM(symbol)//" " bsname2 = " "//TRIM(bsname)//" " - strlen1 = LEN_TRIM(symbol2)+1 - strlen2 = LEN_TRIM(bsname2)+1 + strlen1 = LEN_TRIM(symbol2) + 1 + strlen2 = LEN_TRIM(bsname2) + 1 IF ((INDEX(line2, symbol2(:strlen1)) > 0) .AND. & (INDEX(line2, bsname2(:strlen2)) > 0)) match = .TRUE. @@ -2337,7 +2337,7 @@ SUBROUTINE read_sto_basis_set(element_symbol, basis_set_name, sto_basis_set, par sto_basis_set%zet(iset) = zet WRITE (nlsym, "(I2,A)") nq, TRIM(lsym) sto_basis_set%symbol(iset) = TRIM(nlsym) - SELECT CASE (TRIM (lsym)) + SELECT CASE (TRIM(lsym)) CASE ("S", "s") sto_basis_set%lq(iset) = 0 CASE ("P", "p") @@ -2460,7 +2460,7 @@ SUBROUTINE create_gto_from_sto_basis(sto_basis_set, gto_basis_set, ngauss, ortho gto_basis_set%lmin(iset) = lq(iset) gto_basis_set%npgf(iset) = ng gto_basis_set%nshell(iset) = 1 - gto_basis_set%n(1, iset) = lq(iset)+1 + gto_basis_set%n(1, iset) = lq(iset) + 1 gto_basis_set%l(1, iset) = lq(iset) DO ipgf = 1, ng gto_basis_set%gcc(ipgf, 1, iset) = gcc(ipgf) @@ -2472,7 +2472,7 @@ SUBROUTINE create_gto_from_sto_basis(sto_basis_set, gto_basis_set, ngauss, ortho mxf = 0 DO iset = 1, nset l = gto_basis_set%l(1, iset) - mxf(l) = mxf(l)+1 + mxf(l) = mxf(l) + 1 END DO m = MAXVAL(mxf) IF (m > 1) THEN @@ -2493,8 +2493,8 @@ SUBROUTINE create_gto_from_sto_basis(sto_basis_set, gto_basis_set, ngauss, ortho mxf = 0 DO iset = 1, nset l = gto_basis_set%l(1, iset) - mxf(l) = mxf(l)+1 - i1 = mxf(l)*ng-ng+1 + mxf(l) = mxf(l) + 1 + i1 = mxf(l)*ng - ng + 1 i2 = mxf(l)*ng zll(i1:i2, l) = zal(1:ng, iset) gto_basis_set%gcc(i1:i2, 1, iset) = gal(1:ng, iset) @@ -2505,7 +2505,7 @@ SUBROUTINE create_gto_from_sto_basis(sto_basis_set, gto_basis_set, ngauss, ortho END DO DO iset = 1, nset l = gto_basis_set%l(1, iset) - DO jset = 1, iset-1 + DO jset = 1, iset - 1 IF (gto_basis_set%l(1, iset) == l) THEN m = mxf(l)*ng CALL orthofun(gto_basis_set%zet(1:m, iset), gto_basis_set%gcc(1:m, 1, iset), & @@ -2535,16 +2535,16 @@ SUBROUTINE create_gto_from_sto_basis(sto_basis_set, gto_basis_set, ngauss, ortho gto_basis_set%ncgf_set(iset) = 0 gto_basis_set%nsgf_set(iset) = 0 lshell = gto_basis_set%l(1, iset) - gto_basis_set%first_cgf(1, iset) = ncgf+1 - ncgf = ncgf+nco(lshell) + gto_basis_set%first_cgf(1, iset) = ncgf + 1 + ncgf = ncgf + nco(lshell) gto_basis_set%last_cgf(1, iset) = ncgf gto_basis_set%ncgf_set(iset) = & - gto_basis_set%ncgf_set(iset)+nco(lshell) - gto_basis_set%first_sgf(1, iset) = nsgf+1 - nsgf = nsgf+nso(lshell) + gto_basis_set%ncgf_set(iset) + nco(lshell) + gto_basis_set%first_sgf(1, iset) = nsgf + 1 + nsgf = nsgf + nso(lshell) gto_basis_set%last_sgf(1, iset) = nsgf gto_basis_set%nsgf_set(iset) = & - gto_basis_set%nsgf_set(iset)+nso(lshell) + gto_basis_set%nsgf_set(iset) + nso(lshell) ngs = gto_basis_set%npgf(iset) maxco = MAX(maxco, ngs*ncoset(lshell)) END DO @@ -2568,9 +2568,9 @@ SUBROUTINE create_gto_from_sto_basis(sto_basis_set, gto_basis_set, ngauss, ortho DO iset = 1, nset lshell = gto_basis_set%l(1, iset) - np = lshell+1 - DO ico = ncoset(lshell-1)+1, ncoset(lshell) - ncgf = ncgf+1 + np = lshell + 1 + DO ico = ncoset(lshell - 1) + 1, ncoset(lshell) + ncgf = ncgf + 1 gto_basis_set%lx(ncgf) = indco(1, ico) gto_basis_set%ly(ncgf) = indco(2, ico) gto_basis_set%lz(ncgf) = indco(3, ico) @@ -2580,7 +2580,7 @@ SUBROUTINE create_gto_from_sto_basis(sto_basis_set, gto_basis_set, ngauss, ortho gto_basis_set%lz(ncgf)/)) END DO DO m = -lshell, lshell - nsgf = nsgf+1 + nsgf = nsgf + 1 gto_basis_set%m(nsgf) = m gto_basis_set%sgf_symbol(nsgf) = sgf_symbol(np, lshell, m) END DO @@ -2607,7 +2607,7 @@ SUBROUTINE orthofun(zet, co, cr, l) CALL aovlp(l, zet, cr, cr, ss) cr(:) = cr(:)/SQRT(ss) CALL aovlp(l, zet, co, cr, ss) - co(:) = co(:)-ss*cr(:) + co(:) = co(:) - ss*cr(:) CALL aovlp(l, zet, co, co, ss) co(:) = co(:)/SQRT(ss) @@ -2638,7 +2638,7 @@ SUBROUTINE aovlp(l, zet, ca, cb, ss) ai = (2.0_dp*zet(i)/pi)**0.75_dp DO j = 1, m aj = (2.0_dp*zet(j)/pi)**0.75_dp - ab = 1._dp/(zet(i)+zet(j)) + ab = 1._dp/(zet(i) + zet(j)) s00 = ai*aj*(pi*ab)**1.50_dp IF (l == 0) THEN sss = s00 @@ -2647,7 +2647,7 @@ SUBROUTINE aovlp(l, zet, ca, cb, ss) ELSE CPABORT("aovlp lvalue") END IF - ss = ss+sss*ca(i)*cb(j) + ss = ss + sss*ca(i)*cb(j) END DO END DO @@ -2676,7 +2676,7 @@ FUNCTION srules(z, ne, n, l) s = 0.0_dp ! The complete shell - l1 = MIN(l+1, 4) + l1 = MIN(l + 1, 4) nn = MIN(n, 7) IF (l1 == 1) l2 = 2 IF (l1 == 2) l2 = 1 @@ -2686,32 +2686,32 @@ FUNCTION srules(z, ne, n, l) ! Rule b) 0.35 (1s 0.3) from each other electron in the same shell IF (n == 1) THEN m = ne(1, 1) - s = s+0.3_dp*REAL(m-1, dp) + s = s + 0.3_dp*REAL(m - 1, dp) ELSE - m = ne(l1, nn)+ne(l2, nn) - s = s+0.35_dp*REAL(m-1, dp) + m = ne(l1, nn) + ne(l2, nn) + s = s + 0.35_dp*REAL(m - 1, dp) END IF ! Rule c) if (s,p) shell 0.85 from each electron with n-1, and 1.0 ! from all electrons further in - IF (l1+l2 == 3) THEN + IF (l1 + l2 == 3) THEN IF (nn > 1) THEN - m1 = ne(1, nn-1)+ne(2, nn-1)+ne(3, nn-1)+ne(4, nn-1) + m1 = ne(1, nn - 1) + ne(2, nn - 1) + ne(3, nn - 1) + ne(4, nn - 1) m2 = 0 - DO i = 1, nn-2 - m2 = m2+ne(1, i)+ne(2, i)+ne(3, i)+ne(4, I) + DO i = 1, nn - 2 + m2 = m2 + ne(1, i) + ne(2, i) + ne(3, i) + ne(4, I) END DO - s = s+0.85_dp*REAL(m1, dp)+1._dp*REAL(m2, dp) + s = s + 0.85_dp*REAL(m1, dp) + 1._dp*REAL(m2, dp) END IF ELSE ! Rule d) if (d,f) shell 1.0 from each electron inside m = 0 - DO i = 1, nn-1 - m = m+ne(1, i)+ne(2, i)+ne(3, i)+ne(4, i) + DO i = 1, nn - 1 + m = m + ne(1, i) + ne(2, i) + ne(3, i) + ne(4, i) END DO - s = s+1._dp*REAL(m, dp) + s = s + 1._dp*REAL(m, dp) END IF ! Slater exponent is (Z-S)/NS - srules = (REAL(z, dp)-s)/xns(nn) + srules = (REAL(z, dp) - s)/xns(nn) END FUNCTION srules ! ************************************************************************************************** diff --git a/src/aobasis/orbital_pointers.F b/src/aobasis/orbital_pointers.F index 7ea5faf3ff..a601d0baa2 100644 --- a/src/aobasis/orbital_pointers.F +++ b/src/aobasis/orbital_pointers.F @@ -100,7 +100,7 @@ SUBROUTINE create_orbital_pointers(maxl) nco(-1) = 0 DO l = 0, maxl - nco(l) = (l+1)*(l+2)/2 + nco(l) = (l + 1)*(l + 2)/2 END DO ! *** Number of Cartesian orbitals up to l *** @@ -110,7 +110,7 @@ SUBROUTINE create_orbital_pointers(maxl) ncoset(-1) = 0 DO l = 0, maxl - ncoset(l) = ncoset(l-1)+nco(l) + ncoset(l) = ncoset(l - 1) + nco(l) END DO ! *** Build the Cartesian orbital pointer and the shell orbital pointer *** @@ -130,10 +130,10 @@ SUBROUTINE create_orbital_pointers(maxl) DO lx = 0, maxl DO ly = 0, maxl DO lz = 0, maxl - l = lx+ly+lz + l = lx + ly + lz IF (l > maxl) CYCLE - co(lx, ly, lz) = 1+(l-lx)*(l-lx+1)/2+lz - coset(lx, ly, lz) = ncoset(l-1)+co(lx, ly, lz) + co(lx, ly, lz) = 1 + (l - lx)*(l - lx + 1)/2 + lz + coset(lx, ly, lz) = ncoset(l - 1) + co(lx, ly, lz) END DO END DO END DO @@ -144,8 +144,8 @@ SUBROUTINE create_orbital_pointers(maxl) DO l = 0, maxl DO lx = 0, l - DO ly = 0, l-lx - lz = l-lx-ly + DO ly = 0, l - lx + lz = l - lx - ly indco(1:3, coset(lx, ly, lz)) = (/lx, ly, lz/) END DO END DO @@ -158,7 +158,7 @@ SUBROUTINE create_orbital_pointers(maxl) nso(-1) = 0 DO l = 0, maxl - nso(l) = 2*l+1 + nso(l) = 2*l + 1 END DO ! *** Number of spherical orbitals up to l *** @@ -167,7 +167,7 @@ SUBROUTINE create_orbital_pointers(maxl) nsoset(-1) = 0 DO l = 0, maxl - nsoset(l) = nsoset(l-1)+nso(l) + nsoset(l) = nsoset(l - 1) + nso(l) END DO ALLOCATE (indso(2, nsoset(maxl))) @@ -180,7 +180,7 @@ SUBROUTINE create_orbital_pointers(maxl) iso = 0 DO l = 0, maxl DO m = -l, l - iso = iso+1 + iso = iso + 1 indso(1:2, iso) = (/l, m/) indso_inv(l, m) = iso END DO @@ -191,8 +191,8 @@ SUBROUTINE create_orbital_pointers(maxl) soset(:, :) = 0 DO l = 0, maxl DO m = -l, l - so(l, m) = nso(l)-(l-m) - soset(l, m) = nsoset(l-1)+nso(l)-(l-m) + so(l, m) = nso(l) - (l - m) + soset(l, m) = nsoset(l - 1) + nso(l) - (l - m) END DO END DO diff --git a/src/aobasis/orbital_symbols.F b/src/aobasis/orbital_symbols.F index 3bdbfbb493..200d399905 100644 --- a/src/aobasis/orbital_symbols.F +++ b/src/aobasis/orbital_symbols.F @@ -69,14 +69,14 @@ FUNCTION cgf_symbol(n, lxyz) RESULT(symbol) DO i = 1, 3 IF (lxyz(i) > 0) THEN symbol(ipos:ipos) = xyz(i) - ipos = ipos+1 + ipos = ipos + 1 IF (lxyz(i) > 1) THEN IF (lxyz(i) < 10) THEN WRITE (symbol(ipos:ipos), "(I1)") lxyz(i) - ipos = ipos+1 + ipos = ipos + 1 ELSE IF (lxyz(i) < 100) THEN - WRITE (symbol(ipos:ipos+1), "(I2)") lxyz(i) - ipos = ipos+2 + WRITE (symbol(ipos:ipos + 1), "(I2)") lxyz(i) + ipos = ipos + 2 ELSE CPABORT("Invalid magnetic quantum number specified") END IF @@ -124,7 +124,7 @@ FUNCTION sgf_symbol(n, l, m) RESULT(symbol) IF ((l >= 0) .AND. (l <= 11)) THEN symbol(i:i) = l_sym(l) - i = i+1 + i = i + 1 ELSE CPABORT("Invalid angular momentum quantum number specified") END IF @@ -136,9 +136,9 @@ FUNCTION sgf_symbol(n, l, m) RESULT(symbol) IF (m == 0) THEN WRITE (symbol(i:i), "(I1)") m ELSE IF (ABS(m) < 10) THEN - WRITE (symbol(i:i+1), "(SP,I2)") m + WRITE (symbol(i:i + 1), "(SP,I2)") m ELSE IF (ABS(m) < 100) THEN - WRITE (symbol(i:i+2), "(SP,I3)") m + WRITE (symbol(i:i + 2), "(SP,I3)") m END IF END IF ELSE diff --git a/src/aobasis/orbital_transformation_matrices.F b/src/aobasis/orbital_transformation_matrices.F index ace956d584..be01e9136a 100644 --- a/src/aobasis/orbital_transformation_matrices.F +++ b/src/aobasis/orbital_transformation_matrices.F @@ -128,37 +128,37 @@ SUBROUTINE create_spherical_harmonics(maxl) ! *** (c2s, formula 15) *** DO lx = 0, l - DO ly = 0, l-lx - lz = l-lx-ly + DO ly = 0, l - lx + lz = l - lx - ly ic = co(lx, ly, lz) DO m = -l, l - is = l+m+1 + is = l + m + 1 ma = ABS(m) - j = lx+ly-ma + j = lx + ly - ma IF ((j >= 0) .AND. (MODULO(j, 2) == 0)) THEN j = j/2 s1 = 0.0_dp - DO i = 0, (l-ma)/2 + DO i = 0, (l - ma)/2 s2 = 0.0_dp DO k = 0, j - IF (((m < 0) .AND. (MODULO(ABS(ma-lx), 2) == 1)) .OR. & - ((m > 0) .AND. (MODULO(ABS(ma-lx), 2) == 0))) THEN - expo = (ma-lx+2*k)/2 + IF (((m < 0) .AND. (MODULO(ABS(ma - lx), 2) == 1)) .OR. & + ((m > 0) .AND. (MODULO(ABS(ma - lx), 2) == 0))) THEN + expo = (ma - lx + 2*k)/2 s = (-1.0_dp)**expo*SQRT(2.0_dp) ELSE IF ((m == 0) .AND. (MODULO(lx, 2) == 0)) THEN - expo = k-lx/2 + expo = k - lx/2 s = (-1.0_dp)**expo ELSE s = 0.0_dp END IF - s2 = s2+binomial(j, k)*binomial(ma, lx-2*k)*s + s2 = s2 + binomial(j, k)*binomial(ma, lx - 2*k)*s END DO - s1 = s1+binomial(l, i)*binomial(i, j)* & - (-1.0_dp)**i*fac(2*l-2*i)/fac(l-ma-2*i)*s2 + s1 = s1 + binomial(l, i)*binomial(i, j)* & + (-1.0_dp)**i*fac(2*l - 2*i)/fac(l - ma - 2*i)*s2 END DO orbtramat(l)%c2s(is, ic) = & - SQRT((fac(2*lx)*fac(2*ly)*fac(2*lz)*fac(l)*fac(l-ma))/ & - (fac(lx)*fac(ly)*fac(lz)*fac(2*l)*fac(l+ma)))*s1/ & + SQRT((fac(2*lx)*fac(2*ly)*fac(2*lz)*fac(l)*fac(l - ma))/ & + (fac(lx)*fac(ly)*fac(lz)*fac(2*l)*fac(l + ma)))*s1/ & (2.0_dp**l*fac(l)) ELSE orbtramat(l)%c2s(is, ic) = 0.0_dp @@ -172,18 +172,18 @@ SUBROUTINE create_spherical_harmonics(maxl) ! *** (s2c = s*TRANSPOSE(c2s), formulas 18 and 19) *** DO lx1 = 0, l - DO ly1 = 0, l-lx1 - lz1 = l-lx1-ly1 + DO ly1 = 0, l - lx1 + lz1 = l - lx1 - ly1 ic1 = co(lx1, ly1, lz1) s1 = SQRT((fac(lx1)*fac(ly1)*fac(lz1))/ & (fac(2*lx1)*fac(2*ly1)*fac(2*lz1))) DO lx2 = 0, l - DO ly2 = 0, l-lx2 - lz2 = l-lx2-ly2 + DO ly2 = 0, l - lx2 + lz2 = l - lx2 - ly2 ic2 = co(lx2, ly2, lz2) - lx = lx1+lx2 - ly = ly1+ly2 - lz = lz1+lz2 + lx = lx1 + lx2 + ly = ly1 + ly2 + lz = lz1 + lz2 IF ((MODULO(lx, 2) == 0) .AND. & (MODULO(ly, 2) == 0) .AND. & (MODULO(lz, 2) == 0)) THEN @@ -192,7 +192,7 @@ SUBROUTINE create_spherical_harmonics(maxl) s = fac(lx)*fac(ly)*fac(lz)*s1*s2/ & (fac(lx/2)*fac(ly/2)*fac(lz/2)) DO is = 1, nso(l) - orbtramat(l)%s2c(is, ic1) = orbtramat(l)%s2c(is, ic1)+ & + orbtramat(l)%s2c(is, ic1) = orbtramat(l)%s2c(is, ic1) + & s*orbtramat(l)%c2s(is, ic2) END DO END IF @@ -203,19 +203,19 @@ SUBROUTINE create_spherical_harmonics(maxl) ! *** Build up the real spherical harmonics *** - s = SQRT(0.25_dp*dfac(2*l+1)/pi) + s = SQRT(0.25_dp*dfac(2*l + 1)/pi) DO lx = 0, l - DO ly = 0, l-lx - lz = l-lx-ly + DO ly = 0, l - lx + lz = l - lx - ly ic = co(lx, ly, lz) DO m = -l, l - is = l+m+1 + is = l + m + 1 !MK s2 = (-1.0_dp)**m*s !-> alternative S(lm) definition orbtramat(l)%slm(is, ic) = & s*orbtramat(l)%c2s(is, ic)/ & !MK s2*orbtramat(l)%c2s(is,ic)/& - SQRT(dfac(2*lx-1)*dfac(2*ly-1)*dfac(2*lz-1)) + SQRT(dfac(2*lx - 1)*dfac(2*ly - 1)*dfac(2*lz - 1)) END DO END DO END DO @@ -224,22 +224,22 @@ SUBROUTINE create_spherical_harmonics(maxl) ! *** for unnormalized functions *** nc = nco(l) ns = nso(l) - lx1 = ncoset(l-1)+1 - ly1 = nsoset(l-1)+1 + lx1 = ncoset(l - 1) + 1 + ly1 = nsoset(l - 1) + 1 lx2 = ncoset(l) ly2 = nsoset(l) s2c_tramat(ly1:ly2, lx1:lx2) = orbtramat(l)%s2c(1:ns, 1:nc) c2s_tramat(ly1:ly2, lx1:lx2) = orbtramat(l)%c2s(1:ns, 1:nc) - s1 = 8.0_dp*pi*fac(l+1)/fac(2*l+2) + s1 = 8.0_dp*pi*fac(l + 1)/fac(2*l + 2) DO lx = 0, l - DO ly = 0, l-lx - lz = l-lx-ly + DO ly = 0, l - lx + lz = l - lx - ly s2 = fac(2*lx)*fac(2*ly)*fac(2*lz)/(fac(lx)*fac(ly)*fac(lz)) s = SQRT(s1*s2) - ic = ncoset(l-1)+co(lx, ly, lz) + ic = ncoset(l - 1) + co(lx, ly, lz) DO m = -l, l - is = nsoset(l-1)+l+m+1 + is = nsoset(l - 1) + l + m + 1 s2c_tramat(is, ic) = s2c_tramat(is, ic)*s c2s_tramat(is, ic) = c2s_tramat(is, ic)/s END DO @@ -271,7 +271,7 @@ SUBROUTINE deallocate_spherical_harmonics() IF (current_maxl > -1) THEN - DO l = 0, SIZE(orbtramat, 1)-1 + DO l = 0, SIZE(orbtramat, 1) - 1 DEALLOCATE (orbtramat(l)%c2s) @@ -392,23 +392,23 @@ SUBROUTINE write_matrix(matrix, l, lunit, headline) DO ic = 1, nc, 6 from = ic - to = MIN(nc, from+5) + to = MIN(nc, from + 5) i = 1 DO lx = l, 0, -1 - DO ly = l-lx, 0, -1 - lz = l-lx-ly + DO ly = l - lx, 0, -1 + lz = l - lx - ly jc = co(lx, ly, lz) IF ((jc >= from) .AND. (jc <= to)) THEN symbol = cgf_symbol(1, (/lx, ly, lz/)) WRITE (UNIT=string(i:), FMT="(A)") TRIM(symbol(3:12)) - i = i+12 + i = i + 12 END IF END DO END DO WRITE (UNIT=lunit, FMT="(/,T13,A)") TRIM(string) symbol = "" DO m = -l, l - is = l+m+1 + is = l + m + 1 symbol = sgf_symbol(1, l, m) WRITE (UNIT=lunit, FMT="(T4,A4,6(1X,F11.6))") & symbol(3:6), (matrix(is, jc), jc=from, to) diff --git a/src/aobasis/soft_basis_set.F b/src/aobasis/soft_basis_set.F index f72422ad95..5d43219d93 100644 --- a/src/aobasis/soft_basis_set.F +++ b/src/aobasis/soft_basis_set.F @@ -107,7 +107,7 @@ SUBROUTINE create_soft_basis(orb_basis, soft_basis, eps_fit, rc, paw_atom, & DO iset = 1, nset ! iset minzet = orb_basis%zet(orb_basis%npgf(iset), iset) - DO ipgf = orb_basis%npgf(iset)-1, 1, -1 + DO ipgf = orb_basis%npgf(iset) - 1, 1, -1 IF (orb_basis%zet(ipgf, iset) < minzet) THEN minzet = orb_basis%zet(ipgf, iset) ENDIF @@ -115,7 +115,7 @@ SUBROUTINE create_soft_basis(orb_basis, soft_basis, eps_fit, rc, paw_atom, & radius = exp_radius(orb_basis%lmax(iset), minzet, eps_fit, 1.0_dp) ! The soft basis contains this set - iset_s = iset_s+1 + iset_s = iset_s + 1 nshell(iset_s) = orb_basis%nshell(iset) lmax(iset_s) = orb_basis%lmax(iset) lmin(iset_s) = orb_basis%lmin(iset) @@ -159,7 +159,7 @@ SUBROUTINE create_soft_basis(orb_basis, soft_basis, eps_fit, rc, paw_atom, & ENDIF ! The soft basis contains this exponent - ipgf_s = ipgf_s+1 + ipgf_s = ipgf_s + 1 zet(ipgf_s, iset_s) = orb_basis%zet(ipgf, iset) lshell_old = orb_basis%l(1, iset) @@ -235,16 +235,16 @@ SUBROUTINE create_soft_basis(orb_basis, soft_basis, eps_fit, rc, paw_atom, & soft_basis%nsgf_set(iset) = 0 DO ishell = 1, nshell(iset) lshell = soft_basis%l(ishell, iset) - soft_basis%first_cgf(ishell, iset) = ncgf+1 - ncgf = ncgf+nco(lshell) + soft_basis%first_cgf(ishell, iset) = ncgf + 1 + ncgf = ncgf + nco(lshell) soft_basis%last_cgf(ishell, iset) = ncgf soft_basis%ncgf_set(iset) = & - soft_basis%ncgf_set(iset)+nco(lshell) - soft_basis%first_sgf(ishell, iset) = nsgf+1 - nsgf = nsgf+nso(lshell) + soft_basis%ncgf_set(iset) + nco(lshell) + soft_basis%first_sgf(ishell, iset) = nsgf + 1 + nsgf = nsgf + nso(lshell) soft_basis%last_sgf(ishell, iset) = nsgf soft_basis%nsgf_set(iset) = & - soft_basis%nsgf_set(iset)+nso(lshell) + soft_basis%nsgf_set(iset) + nso(lshell) END DO maxco = MAX(maxco, npgf(iset)*ncoset(lmax(iset))) END DO @@ -268,8 +268,8 @@ SUBROUTINE create_soft_basis(orb_basis, soft_basis, eps_fit, rc, paw_atom, & DO iset = 1, nset_s DO ishell = 1, nshell(iset) lshell = soft_basis%l(ishell, iset) - DO ico = ncoset(lshell-1)+1, ncoset(lshell) - ncgf = ncgf+1 + DO ico = ncoset(lshell - 1) + 1, ncoset(lshell) + ncgf = ncgf + 1 soft_basis%lx(ncgf) = indco(1, ico) soft_basis%ly(ncgf) = indco(2, ico) soft_basis%lz(ncgf) = indco(3, ico) @@ -279,7 +279,7 @@ SUBROUTINE create_soft_basis(orb_basis, soft_basis, eps_fit, rc, paw_atom, & soft_basis%lz(ncgf)/)) END DO DO m = -lshell, lshell - nsgf = nsgf+1 + nsgf = nsgf + 1 soft_basis%m(nsgf) = m soft_basis%sgf_symbol(nsgf) = & sgf_symbol(n(ishell, iset), lshell, m) diff --git a/src/aobasis/sto_ng.F b/src/aobasis/sto_ng.F index 404c2ad9a5..36461a7359 100644 --- a/src/aobasis/sto_ng.F +++ b/src/aobasis/sto_ng.F @@ -68,7 +68,7 @@ SUBROUTINE get_sto_ng(zeta, n, nq, lq, alpha, coef) CPASSERT(nq >= 1) CPASSERT(lq >= 0) - m = (nq*(nq-1))/2+lq+1 + m = (nq*(nq - 1))/2 + lq + 1 SELECT CASE (m) CASE (1) ! 1s SELECT CASE (n) diff --git a/src/arnoldi/arnoldi_api.F b/src/arnoldi/arnoldi_api.F index ed202d51e1..cf27c3297f 100644 --- a/src/arnoldi/arnoldi_api.F +++ b/src/arnoldi/arnoldi_api.F @@ -341,7 +341,7 @@ SUBROUTINE arnoldi_conjugate_gradient(matrix_a, vec_x, matrix_p, converged, thre CALL dbcsr_iterator_next_block(dbcsr_iter, i, j, xvec) nb = rb_size(i) no = rb_offset(i) - xvec(1:nb, 1) = vec_x(no:no+nb-1) + xvec(1:nb, 1) = vec_x(no:no + nb - 1) END DO CALL dbcsr_iterator_stop(dbcsr_iter) @@ -368,7 +368,7 @@ SUBROUTINE arnoldi_conjugate_gradient(matrix_a, vec_x, matrix_p, converged, thre CALL dbcsr_iterator_next_block(dbcsr_iter, i, j, xvec) nb = rb_size(i) no = rb_offset(i) - vec_x(no:no+nb-1) = xvec(1:nb, 1) + vec_x(no:no + nb - 1) = xvec(1:nb, 1) END DO CALL dbcsr_iterator_stop(dbcsr_iter) control => get_control(my_arnoldi) @@ -528,7 +528,7 @@ FUNCTION vec_dot_vec(avec, bvec, mpgrp) RESULT(adotb) CALL dbcsr_iterator_next_block(dbcsr_iter, i, j, av) CALL dbcsr_get_block_p(bvec, i, j, bv, found) IF (found .AND. SIZE(bv) > 0) THEN - adotb = adotb+DOT_PRODUCT(av(:, 1), bv(:, 1)) + adotb = adotb + DOT_PRODUCT(av(:, 1), bv(:, 1)) END IF END DO CALL dbcsr_iterator_stop(dbcsr_iter) diff --git a/src/arnoldi/arnoldi_geev.F b/src/arnoldi/arnoldi_geev.F index bd45978b2f..8532cd5567 100644 --- a/src/arnoldi/arnoldi_geev.F +++ b/src/arnoldi/arnoldi_geev.F @@ -57,15 +57,15 @@ SUBROUTINE arnoldi_zheevd(jobvr, matrix, ndim, evals, revec) CHARACTER(LEN=*), PARAMETER :: routineN = 'arnoldi_zheevd', routineP = moduleN//':'//routineN INTEGER :: i, info, liwork, lrwork, lwork, & - iwork(3+5*ndim) - COMPLEX(real_8) :: work(2*ndim+ndim**2), & + iwork(3 + 5*ndim) + COMPLEX(real_8) :: work(2*ndim + ndim**2), & tmp_array(ndim, ndim) - REAL(real_8) :: rwork(1+5*ndim+2*ndim**2) + REAL(real_8) :: rwork(1 + 5*ndim + 2*ndim**2) tmp_array(:, :) = matrix(:, :) - lwork = 2*ndim+ndim**2 - lrwork = 1+5*ndim+2*ndim**2 - liwork = 3+5*ndim + lwork = 2*ndim + ndim**2 + lrwork = 1 + 5*ndim + 2*ndim**2 + liwork = 3 + 5*ndim CALL zheevd(jobvr, 'U', ndim, tmp_array, evals, ndim, work, lwork, rwork, lrwork, iwork, liwork, info) @@ -93,15 +93,15 @@ SUBROUTINE arnoldi_cheevd(jobvr, matrix, ndim, evals, revec) CHARACTER(LEN=*), PARAMETER :: routineN = 'arnoldi_cheevd', routineP = moduleN//':'//routineN INTEGER :: i, info, liwork, lrwork, lwork, & - iwork(3+5*ndim) - COMPLEX(real_4) :: work(2*ndim+ndim**2), & + iwork(3 + 5*ndim) + COMPLEX(real_4) :: work(2*ndim + ndim**2), & tmp_array(ndim, ndim) - REAL(real_4) :: rwork(1+5*ndim+2*ndim**2) + REAL(real_4) :: rwork(1 + 5*ndim + 2*ndim**2) tmp_array(:, :) = matrix(:, :) - lwork = 2*ndim+ndim**2 - lrwork = 1+5*ndim+2*ndim**2 - liwork = 3+5*ndim + lwork = 2*ndim + ndim**2 + lrwork = 1 + 5*ndim + 2*ndim**2 + liwork = 3 + 5*ndim CALL zheevd(jobvr, 'U', ndim, tmp_array, evals, ndim, work, lwork, rwork, lrwork, iwork, liwork, info) @@ -128,13 +128,13 @@ SUBROUTINE arnoldi_dsyevd(jobvr, matrix, ndim, evals, revec) CHARACTER(LEN=*), PARAMETER :: routineN = 'arnoldi_dsyevd', routineP = moduleN//':'//routineN - INTEGER :: i, info, liwork, lwork, iwork(3+5*ndim) + INTEGER :: i, info, liwork, lwork, iwork(3 + 5*ndim) REAL(real_8) :: tmp_array(ndim, ndim), & - work(1+6*ndim+2*ndim**2) + work(1 + 6*ndim + 2*ndim**2) REAL(real_8), DIMENSION(ndim) :: eval - lwork = 1+6*ndim+2*ndim**2 - liwork = 3+5*ndim + lwork = 1 + 6*ndim + 2*ndim**2 + liwork = 3 + 5*ndim tmp_array(:, :) = matrix(:, :) CALL dsyevd(jobvr, "U", ndim, tmp_array, ndim, eval, work, lwork, iwork, liwork, info) @@ -163,14 +163,14 @@ SUBROUTINE arnoldi_ssyevd(jobvr, matrix, ndim, evals, revec) CHARACTER(LEN=*), PARAMETER :: routineN = 'arnoldi_ssyevd', routineP = moduleN//':'//routineN - INTEGER :: i, info, liwork, lwork, iwork(3+5*ndim) + INTEGER :: i, info, liwork, lwork, iwork(3 + 5*ndim) REAL(real_4) :: tmp_array(ndim, ndim), & - work(1+6*ndim+2*ndim**2) + work(1 + 6*ndim + 2*ndim**2) REAL(real_4), DIMENSION(ndim) :: eval MARK_USED(jobvr) !the argument has to be here for the template to work - lwork = 1+6*ndim+2*ndim**2 - liwork = 3+5*ndim + lwork = 1 + 6*ndim + 2*ndim**2 + liwork = 3 + 5*ndim tmp_array(:, :) = matrix(:, :) CALL ssyevd("V", "U", ndim, tmp_array, ndim, eval, work, lwork, iwork, liwork, info) @@ -211,9 +211,9 @@ SUBROUTINE arnoldi_sstev(jobvl, jobvr, matrix, ndim, evals, revec, levec) levec(1, 1) = CMPLX(0.0, 0.0, real_4) info = 0 diag(ndim) = matrix(ndim, ndim) - DO i = 1, ndim-1 + DO i = 1, ndim - 1 diag(i) = matrix(i, i) - offdiag(i) = matrix(i+1, i) + offdiag(i) = matrix(i + 1, i) END DO CALL sstev(jobvr, ndim, diag, offdiag, evec_r, ndim, work, info) @@ -253,9 +253,9 @@ SUBROUTINE arnoldi_dstev(jobvl, jobvr, matrix, ndim, evals, revec, levec) levec(1, 1) = CMPLX(0.0, 0.0, real_8) info = 0 diag(ndim) = matrix(ndim, ndim) - DO i = 1, ndim-1 + DO i = 1, ndim - 1 diag(i) = matrix(i, i) - offdiag(i) = matrix(i+1, i) + offdiag(i) = matrix(i + 1, i) END DO @@ -314,14 +314,14 @@ SUBROUTINE arnoldi_sgeev(jobvl, jobvr, matrix, ndim, evals, revec, levec) evec_r(:, i) = evec_r(:, i)/SQRT(DOT_PRODUCT(evec_r(:, i), evec_r(:, i))) revec(:, i) = CMPLX(evec_r(:, i), REAL(0.0, real_4), real_4) levec(:, i) = CMPLX(evec_l(:, i), REAL(0.0, real_4), real_4) - i = i+1 + i = i + 1 ELSE IF (eval2(i) .GT. EPSILON(REAL(0.0, real_4))) THEN - norm = SQRT(SUM(evec_r(:, i)**2.0_real_4)+SUM(evec_r(:, i+1)**2.0_real_4)) - revec(:, i) = CMPLX(evec_r(:, i), evec_r(:, i+1), real_4)/norm - revec(:, i+1) = CMPLX(evec_r(:, i), -evec_r(:, i+1), real_4)/norm - levec(:, i) = CMPLX(evec_l(:, i), evec_l(:, i+1), real_4) - levec(:, i+1) = CMPLX(evec_l(:, i), -evec_l(:, i+1), real_4) - i = i+2 + norm = SQRT(SUM(evec_r(:, i)**2.0_real_4) + SUM(evec_r(:, i + 1)**2.0_real_4)) + revec(:, i) = CMPLX(evec_r(:, i), evec_r(:, i + 1), real_4)/norm + revec(:, i + 1) = CMPLX(evec_r(:, i), -evec_r(:, i + 1), real_4)/norm + levec(:, i) = CMPLX(evec_l(:, i), evec_l(:, i + 1), real_4) + levec(:, i + 1) = CMPLX(evec_l(:, i), -evec_l(:, i + 1), real_4) + i = i + 2 ELSE CPABORT('something went wrong while sorting the EV in arnoldi_geev') END IF @@ -382,14 +382,14 @@ SUBROUTINE arnoldi_dgeev(jobvl, jobvr, matrix, ndim, evals, revec, levec) evec_r(:, i) = evec_r(:, i)/SQRT(DOT_PRODUCT(evec_r(:, i), evec_r(:, i))) revec(:, i) = CMPLX(evec_r(:, i), REAL(0.0, real_8), real_8) levec(:, i) = CMPLX(evec_l(:, i), REAL(0.0, real_8), real_8) - i = i+1 + i = i + 1 ELSE IF (eval2(i) .GT. EPSILON(REAL(0.0, real_8))) THEN - norm = SQRT(SUM(evec_r(:, i)**2.0_real_8)+SUM(evec_r(:, i+1)**2.0_real_8)) - revec(:, i) = CMPLX(evec_r(:, i), evec_r(:, i+1), real_8)/norm - revec(:, i+1) = CMPLX(evec_r(:, i), -evec_r(:, i+1), real_8)/norm - levec(:, i) = CMPLX(evec_l(:, i), evec_l(:, i+1), real_8) - levec(:, i+1) = CMPLX(evec_l(:, i), -evec_l(:, i+1), real_8) - i = i+2 + norm = SQRT(SUM(evec_r(:, i)**2.0_real_8) + SUM(evec_r(:, i + 1)**2.0_real_8)) + revec(:, i) = CMPLX(evec_r(:, i), evec_r(:, i + 1), real_8)/norm + revec(:, i + 1) = CMPLX(evec_r(:, i), -evec_r(:, i + 1), real_8)/norm + levec(:, i) = CMPLX(evec_l(:, i), evec_l(:, i + 1), real_8) + levec(:, i + 1) = CMPLX(evec_l(:, i), -evec_l(:, i + 1), real_8) + i = i + 2 ELSE CPABORT('something went wrong while sorting the EV in arnoldi_geev') END IF diff --git a/src/atom_admm_methods.F b/src/atom_admm_methods.F index 51eaacea93..8f1c5b26b3 100644 --- a/src/atom_admm_methods.F +++ b/src/atom_admm_methods.F @@ -99,7 +99,7 @@ SUBROUTINE atom_admm(atom_info, admm_section, iw) i_val=xc_funct_no_shortcut) ifun = 0 DO - ifun = ifun+1 + ifun = ifun + 1 xc_fun => section_vals_get_subs_vals2(xc_fun_section, i_section=ifun) IF (.NOT. ASSOCIATED(xc_fun)) EXIT CALL section_vals_remove_values(xc_fun) @@ -191,7 +191,7 @@ SUBROUTINE atom_admm(atom_info, admm_section, iw) ref_energy = atom_trace(ref_k, ref_orbs%pmata) ref_k = 0.0_dp CALL eeri_contract(ref_k, ref_int%eeri, ref_orbs%pmatb, ref_basis%nbas) - ref_energy = ref_energy+atom_trace(ref_k, ref_orbs%pmatb) + ref_energy = ref_energy + atom_trace(ref_k, ref_orbs%pmatb) CASE (do_rohf_atom) CPABORT("ADMM not available") CASE DEFAULT @@ -257,12 +257,12 @@ SUBROUTINE atom_admm(atom_info, admm_section, iw) atom%state%maxl_occ, atom%state%maxn_occ) CALL atom_denmat(admm1_orbs%pmatb, admm1_orbs%wfnb, admm_basis%nbas, atom%state%occb, & atom%state%maxl_occ, atom%state%maxn_occ) - admm1_orbs%pmat = admm1_orbs%pmata+admm1_orbs%pmatb + admm1_orbs%pmat = admm1_orbs%pmata + admm1_orbs%pmatb CALL atom_denmat(admm2_orbs%pmata, admm2_orbs%wfna, admm_basis%nbas, atom%state%occa, & atom%state%maxl_occ, atom%state%maxn_occ) CALL atom_denmat(admm2_orbs%pmatb, admm2_orbs%wfnb, admm_basis%nbas, atom%state%occb, & atom%state%maxl_occ, atom%state%maxn_occ) - admm2_orbs%pmat = admm2_orbs%pmata+admm2_orbs%pmatb + admm2_orbs%pmat = admm2_orbs%pmata + admm2_orbs%pmatb elref = atom_trace(ref_int%ovlp, ref_orbs%pmata) el2 = atom_trace(admm_int%ovlp, admm2_orbs%pmata) xsi = elref/el2 @@ -273,7 +273,7 @@ SUBROUTINE atom_admm(atom_info, admm_section, iw) xsi = elref/el2 admmq_orbs%pmatb = xsi*admm2_orbs%pmatb admmq_orbs%wfnb = SQRT(xsi)*admm2_orbs%wfnb - admmq_orbs%pmat = admmq_orbs%pmata+admmq_orbs%pmatb + admmq_orbs%pmat = admmq_orbs%pmata + admmq_orbs%pmatb el1 = atom_trace(admm_int%ovlp, admm1_orbs%pmat) el2 = atom_trace(admm_int%ovlp, admm2_orbs%pmat) elq = atom_trace(admm_int%ovlp, admmq_orbs%pmat) @@ -284,19 +284,19 @@ SUBROUTINE atom_admm(atom_info, admm_section, iw) admm1_k_energy = atom_trace(admm1_k, admm1_orbs%pmata) admm1_k = 0.0_dp CALL eeri_contract(admm1_k, admm_int%eeri, admm1_orbs%pmatb, admm_basis%nbas) - admm1_k_energy = admm1_k_energy+atom_trace(admm1_k, admm1_orbs%pmatb) + admm1_k_energy = admm1_k_energy + atom_trace(admm1_k, admm1_orbs%pmatb) admm2_k = 0.0_dp CALL eeri_contract(admm2_k, admm_int%eeri, admm2_orbs%pmata, admm_basis%nbas) admm2_k_energy = atom_trace(admm2_k, admm2_orbs%pmata) admm2_k = 0.0_dp CALL eeri_contract(admm2_k, admm_int%eeri, admm2_orbs%pmatb, admm_basis%nbas) - admm2_k_energy = admm2_k_energy+atom_trace(admm2_k, admm2_orbs%pmatb) + admm2_k_energy = admm2_k_energy + atom_trace(admm2_k, admm2_orbs%pmatb) admmq_k = 0.0_dp CALL eeri_contract(admmq_k, admm_int%eeri, admmq_orbs%pmata, admm_basis%nbas) admmq_k_energy = atom_trace(admmq_k, admmq_orbs%pmata) admmq_k = 0.0_dp CALL eeri_contract(admmq_k, admm_int%eeri, admmq_orbs%pmatb, admm_basis%nbas) - admmq_k_energy = admmq_k_energy+atom_trace(admmq_k, admmq_orbs%pmatb) + admmq_k_energy = admmq_k_energy + atom_trace(admmq_k, admmq_orbs%pmatb) END IF DEALLOCATE (lamat) ! @@ -355,54 +355,54 @@ SUBROUTINE atom_admm(atom_info, admm_section, iw) WRITE (iw, "(' Norm of ADMM Basis projection ',T61,F20.10)") el2/elref WRITE (iw, "(' Reference Exchange Energy [Hartree]',T61,F20.10)") ref_energy ! ADMM1 - dxk = ref_energy-admm1_k_energy + dxk = ref_energy - admm1_k_energy WRITE (iw, "(A,F20.10,T60,A,F13.10)") " ADMM1 METHOD: Energy ", admm1_k_energy, & " Error: ", dxk - dxc = fexc_pbex_ref-fexc_pbex_admm1 + dxc = fexc_pbex_ref - fexc_pbex_admm1 WRITE (iw, "(T10,A,F12.6,F12.3,'%',T60,A,F13.10)") "PBEX Correction ", dxc, dxc/dxk*100._dp, & - " Error: ", dxk-dxc - dxc = fexc_optx_ref-fexc_optx_admm1 + " Error: ", dxk - dxc + dxc = fexc_optx_ref - fexc_optx_admm1 WRITE (iw, "(T10,A,F12.6,F12.3,'%',T60,A,F13.10)") "OPTX Correction ", dxc, dxc/dxk*100._dp, & - " Error: ", dxk-dxc + " Error: ", dxk - dxc dxc = dfexc_admm1 WRITE (iw, "(T10,A,F12.6,F12.3,'%',T60,A,F13.10)") "LINX Correction ", dxc, dxc/dxk*100._dp, & - " Error: ", dxk-dxc + " Error: ", dxk - dxc ! ADMM2 - dxk = ref_energy-admm2_k_energy + dxk = ref_energy - admm2_k_energy WRITE (iw, "(A,F20.10,T60,A,F13.10)") " ADMM2 METHOD: Energy ", admm2_k_energy, & " Error: ", dxk - dxc = fexc_pbex_ref-fexc_pbex_admm2 + dxc = fexc_pbex_ref - fexc_pbex_admm2 WRITE (iw, "(T10,A,F12.6,F12.3,'%',T60,A,F13.10)") "PBEX Correction ", dxc, dxc/dxk*100._dp, & - " Error: ", dxk-dxc - dxc = fexc_optx_ref-fexc_optx_admm2 + " Error: ", dxk - dxc + dxc = fexc_optx_ref - fexc_optx_admm2 WRITE (iw, "(T10,A,F12.6,F12.3,'%',T60,A,F13.10)") "OPTX Correction ", dxc, dxc/dxk*100._dp, & - " Error: ", dxk-dxc + " Error: ", dxk - dxc dxc = dfexc_admm2 WRITE (iw, "(T10,A,F12.6,F12.3,'%',T60,A,F13.10)") "LINX Correction ", dxc, dxc/dxk*100._dp, & - " Error: ", dxk-dxc + " Error: ", dxk - dxc ! ADMMQ - dxk = ref_energy-admmq_k_energy + dxk = ref_energy - admmq_k_energy WRITE (iw, "(A,F20.10,T60,A,F13.10)") " ADMMQ METHOD: Energy ", admmq_k_energy, & " Error: ", dxk - dxc = fexc_pbex_ref-fexc_pbex_admmq + dxc = fexc_pbex_ref - fexc_pbex_admmq WRITE (iw, "(T10,A,F12.6,F12.3,'%',T60,A,F13.10)") "PBEX Correction ", dxc, dxc/dxk*100._dp, & - " Error: ", dxk-dxc - dxc = fexc_optx_ref-fexc_optx_admmq + " Error: ", dxk - dxc + dxc = fexc_optx_ref - fexc_optx_admmq WRITE (iw, "(T10,A,F12.6,F12.3,'%',T60,A,F13.10)") "OPTX Correction ", dxc, dxc/dxk*100._dp, & - " Error: ", dxk-dxc + " Error: ", dxk - dxc dxc = dfexc_admmq WRITE (iw, "(T10,A,F12.6,F12.3,'%',T60,A,F13.10)") "LINX Correction ", dxc, dxc/dxk*100._dp, & - " Error: ", dxk-dxc + " Error: ", dxk - dxc ! ADMMS - dxk = ref_energy-admmq_k_energy + dxk = ref_energy - admmq_k_energy WRITE (iw, "(A,F20.10,T60,A,F13.10)") " ADMMS METHOD: Energy ", admmq_k_energy, & " Error: ", dxk - dxc = fexc_pbex_ref-fexc_pbex_admmq*xsi**(2._dp/3._dp) + dxc = fexc_pbex_ref - fexc_pbex_admmq*xsi**(2._dp/3._dp) WRITE (iw, "(T10,A,F12.6,F12.3,'%',T60,A,F13.10)") "PBEX Correction ", dxc, dxc/dxk*100._dp, & - " Error: ", dxk-dxc - dxc = fexc_optx_ref-fexc_optx_admmq*xsi**(2._dp/3._dp) + " Error: ", dxk - dxc + dxc = fexc_optx_ref - fexc_optx_admmq*xsi**(2._dp/3._dp) WRITE (iw, "(T10,A,F12.6,F12.3,'%',T60,A,F13.10)") "OPTX Correction ", dxc, dxc/dxk*100._dp, & - " Error: ", dxk-dxc + " Error: ", dxk - dxc END IF ! DEALLOCATE (admm1_k, admm2_k, admmq_k) @@ -457,7 +457,7 @@ SUBROUTINE lowdin_matrix(wfn, lamat, ovlp) DO j = 1, n lamat(i, j) = 0.0_dp DO k = 1, n - lamat(i, j) = lamat(i, j)+vmat(i, k)*w(k)*vmat(j, k) + lamat(i, j) = lamat(i, j) + vmat(i, k)*w(k)*vmat(j, k) END DO END DO END DO diff --git a/src/atom_basis.F b/src/atom_basis.F index ffc1b2bfb5..887a547cdd 100644 --- a/src/atom_basis.F +++ b/src/atom_basis.F @@ -123,7 +123,7 @@ SUBROUTINE atom_basis_opt(atom_section) maxn = 0 CALL section_vals_val_get(atom_section, "CALCULATE_STATES", i_vals=cn) DO in = 1, MIN(SIZE(cn), 4) - maxn(in-1) = cn(in) + maxn(in - 1) = cn(in) END DO DO in = 0, lmat maxn(in) = MIN(maxn(in), ae_basis%nbas(in)) @@ -185,7 +185,7 @@ SUBROUTINE atom_basis_opt(atom_section) ! get and set the core occupations CALL section_vals_val_get(atom_section, "CORE", c_vals=tmpstringlist) CALL atom_set_occupation(tmpstringlist, state%core, pocc) - zcore = zval-NINT(SUM(state%core)) + zcore = zval - NINT(SUM(state%core)) CALL set_atom(atom_info(in, im)%atom, zcore=zcore, pp_calc=.TRUE.) had_pp = .TRUE. CALL set_atom(atom_info(in, im)%atom, basis=pp_basis, potential=p_pot) diff --git a/src/atom_electronic_structure.F b/src/atom_electronic_structure.F index 21a3ff59f6..152772d508 100644 --- a/src/atom_electronic_structure.F +++ b/src/atom_electronic_structure.F @@ -225,18 +225,18 @@ SUBROUTINE calculate_atom_restricted(atom, iw, noguess, converged) CASE DEFAULT CPABORT("") CASE (do_nonrel_atom) - hcore%op = atom%integrals%kin-atom%zcore*atom%integrals%core + hcore%op = atom%integrals%kin - atom%zcore*atom%integrals%core CASE (do_zoramp_atom, do_sczoramp_atom) - hcore%op = atom%integrals%kin+atom%integrals%tzora-atom%zcore*atom%integrals%core + hcore%op = atom%integrals%kin + atom%integrals%tzora - atom%zcore*atom%integrals%core CASE (do_dkh0_atom, do_dkh1_atom, do_dkh2_atom, do_dkh3_atom) hcore%op = atom%integrals%hdkh END SELECT CASE (gth_pseudo, upf_pseudo, sgp_pseudo, ecp_pseudo) - hcore%op = atom%integrals%kin+atom%integrals%core+atom%integrals%hnl + hcore%op = atom%integrals%kin + atom%integrals%core + atom%integrals%hnl END SELECT ! add confinement potential (not included in relativistic transformations) IF (atom%potential%confinement) THEN - hcore%op = hcore%op+atom%potential%acon*atom%integrals%conf + hcore%op = hcore%op + atom%potential%acon*atom%integrals%conf END IF NULLIFY (fmat, jmat, kmat, xcmat) @@ -256,13 +256,13 @@ SUBROUTINE calculate_atom_restricted(atom, iw, noguess, converged) ! initial guess ALLOCATE (tmp_dens(SIZE(density%op))) CALL slater_density(density%op, tmp_dens, atom%z, atom%state, atom%basis%grid) - density%op = density%op+tmp_dens + density%op = density%op + tmp_dens DEALLOCATE (tmp_dens) CALL coulomb_potential_numeric(cpot%op, density%op, density%grid) CALL numpot_matrix(jmat%op, cpot%op, atom%basis, 0) CALL wigner_slater_functional(density%op, cpot%op) CALL numpot_matrix(xcmat%op, cpot%op, atom%basis, 0) - fmat%op = hcore%op+jmat%op+xcmat%op + fmat%op = hcore%op + jmat%op + xcmat%op CALL atom_solve(fmat%op, atom%integrals%utrans, atom%orbitals%wfn, atom%orbitals%ener, & atom%basis%nbas, atom%integrals%nne, atom%state%maxl_calc) END IF @@ -283,7 +283,7 @@ SUBROUTINE calculate_atom_restricted(atom, iw, noguess, converged) atom%energy%eband = 0._dp DO l = 0, lmat DO i = 1, MIN(SIZE(atom%state%occupation, 2), SIZE(atom%orbitals%ener, 1)) - atom%energy%eband = atom%energy%eband+atom%orbitals%ener(i, l)*atom%state%occupation(l, i) + atom%energy%eband = atom%energy%eband + atom%orbitals%ener(i, l)*atom%state%occupation(l, i) END DO END DO @@ -298,7 +298,7 @@ SUBROUTINE calculate_atom_restricted(atom, iw, noguess, converged) atom%energy%eploc = atom_trace(atom%integrals%core, atom%orbitals%pmat) atom%energy%epnl = atom_trace(atom%integrals%hnl, atom%orbitals%pmat) END SELECT - atom%energy%epseudo = atom%energy%eploc+atom%energy%epnl + atom%energy%epseudo = atom%energy%eploc + atom%energy%epnl ! Core energy atom%energy%ecore = atom_trace(hcore%op, atom%orbitals%pmat) @@ -368,19 +368,19 @@ SUBROUTINE calculate_atom_restricted(atom, iw, noguess, converged) atom%energy%elsd = 0._dp ! Total energy - atom%energy%etot = atom%energy%ecore+atom%energy%ecoulomb+atom%energy%eexchange+atom%energy%exc + atom%energy%etot = atom%energy%ecore + atom%energy%ecoulomb + atom%energy%eexchange + atom%energy%exc ! Potential energy - atom%energy%epot = atom%energy%etot-atom%energy%ekin + atom%energy%epot = atom%energy%etot - atom%energy%ekin ! Total HF/KS matrix - fmat%op = hcore%op+jmat%op+kmat%op+xcmat%op + fmat%op = hcore%op + jmat%op + kmat%op + xcmat%op ! calculate error matrix CALL err_matrix(jmat%op, deps, fmat%op, atom%orbitals%pmat, atom%integrals%utrans, & atom%integrals%uptrans, atom%basis%nbas, atom%integrals%nne) - iter = iter+1 + iter = iter + 1 IF (iw > 0) THEN IF (need_zmp) THEN @@ -518,9 +518,9 @@ SUBROUTINE calculate_atom_unrestricted(atom, iw, noguess, converged) END SELECT ! set alpha and beta occupations - IF (SUM(ABS(atom%state%occa)+ABS(atom%state%occb)) == 0.0_dp) THEN + IF (SUM(ABS(atom%state%occa) + ABS(atom%state%occb)) == 0.0_dp) THEN DO l = 0, 3 - nm = REAL((2*l+1), KIND=dp) + nm = REAL((2*l + 1), KIND=dp) DO k = 1, 10 ne = atom%state%occupation(l, k) IF (ne == 0._dp) THEN !empty shell @@ -530,10 +530,10 @@ SUBROUTINE calculate_atom_unrestricted(atom, iw, noguess, converged) atom%state%occb(l, k) = nm ELSEIF (atom%state%multiplicity == -2) THEN !High spin case atom%state%occa(l, k) = MIN(ne, nm) - atom%state%occb(l, k) = MAX(0._dp, ne-nm) + atom%state%occb(l, k) = MAX(0._dp, ne - nm) ELSE - atom%state%occa(l, k) = 0.5_dp*(ne+atom%state%multiplicity-1._dp) - atom%state%occb(l, k) = ne-atom%state%occa(l, k) + atom%state%occa(l, k) = 0.5_dp*(ne + atom%state%multiplicity - 1._dp) + atom%state%occb(l, k) = ne - atom%state%occa(l, k) END IF END DO END DO @@ -557,24 +557,24 @@ SUBROUTINE calculate_atom_unrestricted(atom, iw, noguess, converged) CASE DEFAULT CPABORT("") CASE (do_nonrel_atom) - hcore%op = atom%integrals%kin-atom%zcore*atom%integrals%core + hcore%op = atom%integrals%kin - atom%zcore*atom%integrals%core CASE (do_zoramp_atom, do_sczoramp_atom) - hcore%op = atom%integrals%kin+atom%integrals%tzora-atom%zcore*atom%integrals%core + hcore%op = atom%integrals%kin + atom%integrals%tzora - atom%zcore*atom%integrals%core CASE (do_dkh0_atom, do_dkh1_atom, do_dkh2_atom, do_dkh3_atom) hcore%op = atom%integrals%hdkh END SELECT CASE (gth_pseudo) - hcore%op = atom%integrals%kin+atom%integrals%core+atom%integrals%hnl + hcore%op = atom%integrals%kin + atom%integrals%core + atom%integrals%hnl IF (atom%potential%gth_pot%lsdpot) THEN lsdpot = .TRUE. hlsd%op = atom%integrals%clsd END IF CASE (upf_pseudo, sgp_pseudo, ecp_pseudo) - hcore%op = atom%integrals%kin+atom%integrals%core+atom%integrals%hnl + hcore%op = atom%integrals%kin + atom%integrals%core + atom%integrals%hnl END SELECT ! add confinement potential (not included in relativistic transformations) IF (atom%potential%confinement) THEN - hcore%op = hcore%op+atom%potential%acon*atom%integrals%conf + hcore%op = hcore%op + atom%potential%acon*atom%integrals%conf END IF NULLIFY (fmata, fmatb, jmat, kmata, kmatb, xcmata, xcmatb) @@ -595,21 +595,21 @@ SUBROUTINE calculate_atom_unrestricted(atom, iw, noguess, converged) IF (doguess) THEN ! initial guess CALL slater_density(rhoa%op, rhob%op, atom%z, atom%state, atom%basis%grid) - density%op = rhoa%op+rhob%op + density%op = rhoa%op + rhob%op CALL coulomb_potential_numeric(cpot%op, density%op, density%grid) CALL numpot_matrix(jmat%op, cpot%op, atom%basis, 0) ! alpha spin density%op = 2._dp*rhoa%op CALL wigner_slater_functional(density%op, cpot%op) CALL numpot_matrix(xcmata%op, cpot%op, atom%basis, 0) - fmata%op = hcore%op+hlsd%op+jmat%op+xcmata%op + fmata%op = hcore%op + hlsd%op + jmat%op + xcmata%op CALL atom_solve(fmata%op, atom%integrals%utrans, atom%orbitals%wfna, atom%orbitals%enera, & atom%basis%nbas, atom%integrals%nne, atom%state%maxl_calc) ! beta spin density%op = 2._dp*rhob%op CALL wigner_slater_functional(density%op, cpot%op) CALL numpot_matrix(xcmatb%op, cpot%op, atom%basis, 0) - fmatb%op = hcore%op-hlsd%op+jmat%op+xcmatb%op + fmatb%op = hcore%op - hlsd%op + jmat%op + xcmatb%op CALL atom_solve(fmatb%op, atom%integrals%utrans, atom%orbitals%wfnb, atom%orbitals%enerb, & atom%basis%nbas, atom%integrals%nne, atom%state%maxl_calc) END IF @@ -617,7 +617,7 @@ SUBROUTINE calculate_atom_unrestricted(atom, iw, noguess, converged) atom%state%maxl_occ, atom%state%maxn_occ) CALL atom_denmat(atom%orbitals%pmatb, atom%orbitals%wfnb, atom%basis%nbas, atom%state%occb, & atom%state%maxl_occ, atom%state%maxn_occ) - atom%orbitals%pmat = atom%orbitals%pmata+atom%orbitals%pmatb + atom%orbitals%pmat = atom%orbitals%pmata + atom%orbitals%pmatb ! wavefunction history NULLIFY (historya%dmat, historya%hmat) @@ -636,8 +636,8 @@ SUBROUTINE calculate_atom_unrestricted(atom, iw, noguess, converged) atom%energy%eband = 0._dp DO l = 0, 3 DO i = 1, MIN(SIZE(atom%state%occupation, 2), SIZE(atom%orbitals%ener, 1)) - atom%energy%eband = atom%energy%eband+atom%orbitals%enera(i, l)*atom%state%occa(l, i) - atom%energy%eband = atom%energy%eband+atom%orbitals%enerb(i, l)*atom%state%occb(l, i) + atom%energy%eband = atom%energy%eband + atom%orbitals%enera(i, l)*atom%state%occa(l, i) + atom%energy%eband = atom%energy%eband + atom%orbitals%enerb(i, l)*atom%state%occb(l, i) END DO END DO @@ -652,7 +652,7 @@ SUBROUTINE calculate_atom_unrestricted(atom, iw, noguess, converged) atom%energy%eploc = atom_trace(atom%integrals%core, atom%orbitals%pmat) atom%energy%epnl = atom_trace(atom%integrals%hnl, atom%orbitals%pmat) END SELECT - atom%energy%epseudo = atom%energy%eploc+atom%energy%epnl + atom%energy%epseudo = atom%energy%eploc + atom%energy%epnl ! Core energy atom%energy%ecore = atom_trace(hcore%op, atom%orbitals%pmat) @@ -699,7 +699,7 @@ SUBROUTINE calculate_atom_unrestricted(atom, iw, noguess, converged) CALL exchange_numeric(kmata%op, atom%state, atom%state%occa, atom%orbitals%wfna, atom%basis) CALL exchange_numeric(kmatb%op, atom%state, atom%state%occb, atom%orbitals%wfnb, atom%basis) END SELECT - atom%energy%eexchange = hf_frac*(atom_trace(kmata%op, atom%orbitals%pmata)+ & + atom%energy%eexchange = hf_frac*(atom_trace(kmata%op, atom%orbitals%pmata) + & atom_trace(kmatb%op, atom%orbitals%pmatb)) kmata%op = 2._dp*hf_frac*kmata%op kmatb%op = 2._dp*hf_frac*kmatb%op @@ -721,23 +721,23 @@ SUBROUTINE calculate_atom_unrestricted(atom, iw, noguess, converged) END IF IF (lsdpot) THEN - atom%energy%elsd = atom_trace(hlsd%op, atom%orbitals%pmata)- & + atom%energy%elsd = atom_trace(hlsd%op, atom%orbitals%pmata) - & atom_trace(hlsd%op, atom%orbitals%pmatb) - atom%energy%epseudo = atom%energy%epseudo+atom%energy%elsd - atom%energy%ecore = atom%energy%ecore+atom%energy%elsd + atom%energy%epseudo = atom%energy%epseudo + atom%energy%elsd + atom%energy%ecore = atom%energy%ecore + atom%energy%elsd ELSE atom%energy%elsd = 0._dp END IF ! Total energy - atom%energy%etot = atom%energy%ecore+atom%energy%ecoulomb+atom%energy%eexchange+atom%energy%exc + atom%energy%etot = atom%energy%ecore + atom%energy%ecoulomb + atom%energy%eexchange + atom%energy%exc ! Potential energy - atom%energy%epot = atom%energy%etot-atom%energy%ekin + atom%energy%epot = atom%energy%etot - atom%energy%ekin ! Total HF/KS matrix - fmata%op = hcore%op+hlsd%op+jmat%op+kmata%op+xcmata%op - fmatb%op = hcore%op-hlsd%op+jmat%op+kmatb%op+xcmatb%op + fmata%op = hcore%op + hlsd%op + jmat%op + kmata%op + xcmata%op + fmatb%op = hcore%op - hlsd%op + jmat%op + kmatb%op + xcmatb%op ! calculate error matrix CALL err_matrix(xcmata%op, depsa, fmata%op, atom%orbitals%pmata, atom%integrals%utrans, & @@ -746,7 +746,7 @@ SUBROUTINE calculate_atom_unrestricted(atom, iw, noguess, converged) atom%integrals%uptrans, atom%basis%nbas, atom%integrals%nne) deps = 2._dp*MAX(depsa, depsb) - iter = iter+1 + iter = iter + 1 IF (iw > 0) THEN CALL atom_print_iteration(iter, deps, atom%energy%etot, iw) @@ -778,7 +778,7 @@ SUBROUTINE calculate_atom_unrestricted(atom, iw, noguess, converged) atom%basis%nbas, atom%integrals%nne, atom%state%maxl_calc) CALL atom_denmat(atom%orbitals%pmatb, atom%orbitals%wfnb, atom%basis%nbas, atom%state%occb, & atom%state%maxl_occ, atom%state%maxn_occ) - atom%orbitals%pmat = atom%orbitals%pmata+atom%orbitals%pmatb + atom%orbitals%pmat = atom%orbitals%pmata + atom%orbitals%pmatb END DO !SCF Loop diff --git a/src/atom_energy.F b/src/atom_energy.F index dd1eaf92ad..d413c2b8d5 100644 --- a/src/atom_energy.F +++ b/src/atom_energy.F @@ -163,7 +163,7 @@ SUBROUTINE atom_energy_opt(atom_section) maxn = 0 CALL section_vals_val_get(atom_section, "CALCULATE_STATES", i_vals=cn) DO in = 1, MIN(SIZE(cn), 4) - maxn(in-1) = cn(in) + maxn(in - 1) = cn(in) END DO DO in = 0, lmat maxn(in) = MIN(maxn(in), ae_basis%nbas(in)) @@ -257,7 +257,7 @@ SUBROUTINE atom_energy_opt(atom_section) ! get and set the core occupations CALL section_vals_val_get(atom_section, "CORE", c_vals=tmpstringlist) CALL atom_set_occupation(tmpstringlist, state%core, pocc) - zcore = zval-NINT(SUM(state%core)) + zcore = zval - NINT(SUM(state%core)) CALL set_atom(atom_info(in, im)%atom, zcore=zcore, pp_calc=.TRUE.) ELSE state%core = 0._dp @@ -520,14 +520,14 @@ SUBROUTINE atom_response_basis(atom, delta, nder, iw) s1 = SIZE(atom%orbitals%wfn, 1) s2 = SIZE(atom%orbitals%wfn, 2) ALLOCATE (wfn(s1, s2, 0:lmat, -nder:nder)) - s2 = MAXVAL(state%maxn_occ)+nder + s2 = MAXVAL(state%maxn_occ) + nder ALLOCATE (rbasis(s1, s2, 0:lmat)) rbasis = 0._dp DO ider = -nder, nder dene = REAL(ider, KIND=dp)*delta CPASSERT(fhomo > ABS(dene)) - state%occupation(lhomo, nhomo) = fhomo+dene + state%occupation(lhomo, nhomo) = fhomo + dene CALL calculate_atom(atom, iw=0, noguess=.TRUE.) wfn(:, :, :, ider) = atom%orbitals%wfn state%occupation(lhomo, nhomo) = fhomo @@ -543,24 +543,24 @@ SUBROUTINE atom_response_basis(atom, delta, nder, iw) i = MAX(state%maxn_occ(l), 1) SELECT CASE (ider) CASE (1) - rbasis(:, i+1, l) = 0.5_dp*(wfn(:, i, l, 1)-wfn(:, i, l, -1))/delta + rbasis(:, i + 1, l) = 0.5_dp*(wfn(:, i, l, 1) - wfn(:, i, l, -1))/delta CASE (2) - rbasis(:, i+2, l) = 0.25_dp*(wfn(:, i, l, 2)-2._dp*wfn(:, i, l, 0)+wfn(:, i, l, -2))/delta**2 + rbasis(:, i + 2, l) = 0.25_dp*(wfn(:, i, l, 2) - 2._dp*wfn(:, i, l, 0) + wfn(:, i, l, -2))/delta**2 CASE (3) - rbasis(:, i+3, l) = 0.125_dp*(wfn(:, i, l, 3)-3._dp*wfn(:, i, l, 1) & - +3._dp*wfn(:, i, l, -1)-wfn(:, i, l, -3))/delta**3 + rbasis(:, i + 3, l) = 0.125_dp*(wfn(:, i, l, 3) - 3._dp*wfn(:, i, l, 1) & + + 3._dp*wfn(:, i, l, -1) - wfn(:, i, l, -3))/delta**3 CASE DEFAULT CPABORT("") END SELECT END DO ! orthogonalization, use gram-schmidt in order to keep the natural order (semi-core, valence, response) of the wfn. - n = state%maxn_occ(l)+nder + n = state%maxn_occ(l) + nder m = atom%basis%nbas(l) DO i = 1, n - DO j = 1, i-1 + DO j = 1, i - 1 o = DOT_PRODUCT(rbasis(1:m, j, l), RESHAPE(MATMUL(ovlp(1:m, 1:m, l), rbasis(1:m, i:i, l)), (/m/))) - rbasis(1:m, i, l) = rbasis(1:m, i, l)-o*rbasis(1:m, j, l) + rbasis(1:m, i, l) = rbasis(1:m, i, l) - o*rbasis(1:m, j, l) ENDDO o = DOT_PRODUCT(rbasis(1:m, i, l), RESHAPE(MATMUL(ovlp(1:m, 1:m, l), rbasis(1:m, i:i, l)), (/m/))) rbasis(1:m, i, l) = rbasis(1:m, i, l)/SQRT(o) @@ -570,7 +570,7 @@ SUBROUTINE atom_response_basis(atom, delta, nder, iw) ALLOCATE (amat(n, n)) amat(1:n, 1:n) = MATMUL(TRANSPOSE(rbasis(1:m, 1:n, l)), MATMUL(ovlp(1:m, 1:m, l), rbasis(1:m, 1:n, l))) DO i = 1, n - amat(i, i) = amat(i, i)-1._dp + amat(i, i) = amat(i, i) - 1._dp END DO IF (MAXVAL(ABS(amat)) > 1.e-12) THEN WRITE (iw, '(/,A,G20.10)') " Orthogonality error ", MAXVAL(ABS(amat)) @@ -581,9 +581,9 @@ SUBROUTINE atom_response_basis(atom, delta, nder, iw) WRITE (iw, '(/,A,T30,I3)') " Angular momentum :", l WRITE (iw, '(/,A,I0,A,I0,A)') " Exponent Coef.(Quickstep Normalization), first ", & - n-nder, " valence ", nder, " response" - expzet = 0.25_dp*REAL(2*l+3, dp) - prefac = SQRT(SQRT(pi)/2._dp**(l+2)*dfac(2*l+1)) + n - nder, " valence ", nder, " response" + expzet = 0.25_dp*REAL(2*l + 3, dp) + prefac = SQRT(SQRT(pi)/2._dp**(l + 2)*dfac(2*l + 1)) DO i = 1, m zeta = (2._dp*atom%basis%am(i, l))**expzet WRITE (iw, '(4X,F20.10,4X,15ES20.6)') atom%basis%am(i, l), ((prefac*rbasis(i, k, l)/zeta), k=1, n) @@ -756,11 +756,11 @@ SUBROUTINE atom_write_upf(atom, iw) rp(:) = atom%basis%grid%rad ef(:) = EXP(-0.5_dp*rp*rp/(rl*rl)) DO i = 1, pot%nl(l) - pf = rl**(l+0.5_dp*(4._dp*i-1._dp)) - j = l+2*i-1 + pf = rl**(l + 0.5_dp*(4._dp*i - 1._dp)) + j = l + 2*i - 1 pf = SQRT(2._dp)/(pf*SQRT(gamma1(j))) - beta(:) = pf*rp**(l+2*i-2)*ef - ibeta = ibeta+1 + beta(:) = pf*rp**(l + 2*i - 2)*ef + ibeta = ibeta + 1 CALL compose(string, "' beta = 0._dp DO k = 1, atom%basis%nbas(l) - beta(:) = beta(:)+atom%orbitals%wfn(k, i, l)*atom%basis%bf(:, k, l) + beta(:) = beta(:) + atom%orbitals%wfn(k, i, l)*atom%basis%bf(:, k, l) END DO beta(:) = beta*atom%basis%grid%rad IF (up) THEN diff --git a/src/atom_fit.F b/src/atom_fit.F index b19dcc964f..cfc5dbc7b3 100644 --- a/src/atom_fit.F +++ b/src/atom_fit.F @@ -154,10 +154,10 @@ SUBROUTINE atom_fit_density(atom, num_gto, norder, iunit, powell_section, result END IF IF (PRESENT(results)) THEN - CPASSERT(SIZE(results) >= num_gto+2) + CPASSERT(SIZE(results) >= num_gto + 2) results(1) = x(1) results(2) = x(2) - results(3:2+num_gto) = co(1:num_gto) + results(3:2 + num_gto) = co(1:num_gto) END IF DEALLOCATE (co) @@ -211,13 +211,13 @@ SUBROUTINE atom_fit_basis(atom_info, basis, pptype, iunit, powell_section) DO i = 1, basis%nprim(l) mult = .FALSE. DO k = 1, ll - IF (ABS(basis%am(i, l)-x(k)) < 1.e-6_dp) THEN + IF (ABS(basis%am(i, l) - x(k)) < 1.e-6_dp) THEN mult = .TRUE. xtob(i, l) = k END IF END DO IF (.NOT. mult) THEN - ll = ll+1 + ll = ll + 1 x(ll) = basis%am(i, l) xtob(i, l) = ll END IF @@ -225,7 +225,7 @@ SUBROUTINE atom_fit_basis(atom_info, basis, pptype, iunit, powell_section) END DO ostate%nvar = ll DO i = 1, ostate%nvar - x(i) = SQRT(LOG(1._dp+x(i))) + x(i) = SQRT(LOG(1._dp + x(i))) END DO penalty = .TRUE. END IF @@ -239,14 +239,14 @@ SUBROUTINE atom_fit_basis(atom_info, basis, pptype, iunit, powell_section) ll = 0 DO l = 0, lmat DO i = 1, basis%nbas(l) - ll = ll+1 + ll = ll + 1 x(ll) = basis%as(i, l) xtob(i, l) = ll END DO END DO ostate%nvar = ll DO i = 1, ostate%nvar - x(i) = SQRT(LOG(1._dp+x(i))) + x(i) = SQRT(LOG(1._dp + x(i))) END DO END SELECT @@ -304,7 +304,7 @@ SUBROUTINE atom_fit_basis(atom_info, basis, pptype, iunit, powell_section) basis%am = 0._dp DO l = 0, lmat DO i = 1, basis%nbas(l) - ll = i-1+basis%start(l) + ll = i - 1 + basis%start(l) basis%am(i, l) = x(1)*x(1)*(x(2)*x(2))**(ll) END DO END DO @@ -314,7 +314,7 @@ SUBROUTINE atom_fit_basis(atom_info, basis, pptype, iunit, powell_section) DO l = 0, lmat DO i = 1, basis%nprim(l) al = x(xtob(i, l))**2 - basis%am(i, l) = EXP(al)-1._dp + basis%am(i, l) = EXP(al) - 1._dp END DO END DO END IF @@ -329,9 +329,9 @@ SUBROUTINE atom_fit_basis(atom_info, basis, pptype, iunit, powell_section) rk = basis%grid%rad(k) ear = EXP(-al*basis%grid%rad(k)**2) basis%bf(k, i, l) = rk**l*ear - basis%dbf(k, i, l) = (REAL(l, dp)*rk**(l-1)-2._dp*al*rk**(l+1))*ear - basis%ddbf(k, i, l) = (REAL(l*(l-1), dp)*rk**(l-2)- & - 2._dp*al*REAL(2*l+1, dp)*rk**(l)+4._dp*al*rk**(l+2))*ear + basis%dbf(k, i, l) = (REAL(l, dp)*rk**(l - 1) - 2._dp*al*rk**(l + 1))*ear + basis%ddbf(k, i, l) = (REAL(l*(l - 1), dp)*rk**(l - 2) - & + 2._dp*al*REAL(2*l + 1, dp)*rk**(l) + 4._dp*al*rk**(l + 2))*ear END DO END DO END DO @@ -339,7 +339,7 @@ SUBROUTINE atom_fit_basis(atom_info, basis, pptype, iunit, powell_section) DO l = 0, lmat DO i = 1, basis%nbas(l) al = x(xtob(i, l))**2 - basis%as(i, l) = EXP(al)-1._dp + basis%as(i, l) = EXP(al) - 1._dp END DO END DO basis%bf = 0._dp @@ -353,11 +353,11 @@ SUBROUTINE atom_fit_basis(atom_info, basis, pptype, iunit, powell_section) pf = (2._dp*al)**nl*SQRT(2._dp*al/fac(2*nl)) DO k = 1, nr rk = basis%grid%rad(k) - ear = rk**(nl-1)*EXP(-al*rk) + ear = rk**(nl - 1)*EXP(-al*rk) basis%bf(k, i, l) = pf*ear - basis%dbf(k, i, l) = pf*(REAL(nl-1, dp)/rk-al)*ear - basis%ddbf(k, i, l) = pf*(REAL((nl-2)*(nl-1), dp)/rk/rk & - -al*REAL(2*(nl-1), dp)/rk+al*al)*ear + basis%dbf(k, i, l) = pf*(REAL(nl - 1, dp)/rk - al)*ear + basis%ddbf(k, i, l) = pf*(REAL((nl - 2)*(nl - 1), dp)/rk/rk & + - al*REAL(2*(nl - 1), dp)/rk + al*al)*ear END DO END DO END DO @@ -395,7 +395,7 @@ SUBROUTINE atom_fit_basis(atom_info, basis, pptype, iunit, powell_section) basis%am = 0._dp DO l = 0, lmat DO i = 1, basis%nbas(l) - ll = i-1+basis%start(l) + ll = i - 1 + basis%start(l) basis%am(i, l) = x(1)*x(1)*(x(2)*x(2))**(ll) END DO END DO @@ -405,7 +405,7 @@ SUBROUTINE atom_fit_basis(atom_info, basis, pptype, iunit, powell_section) DO l = 0, lmat DO i = 1, basis%nprim(l) al = x(xtob(i, l))**2 - basis%am(i, l) = EXP(al)-1._dp + basis%am(i, l) = EXP(al) - 1._dp END DO END DO END IF @@ -420,9 +420,9 @@ SUBROUTINE atom_fit_basis(atom_info, basis, pptype, iunit, powell_section) rk = basis%grid%rad(k) ear = EXP(-al*basis%grid%rad(k)**2) basis%bf(k, i, l) = rk**l*ear - basis%dbf(k, i, l) = (REAL(l, dp)*rk**(l-1)-2._dp*al*rk**(l+1))*ear - basis%ddbf(k, i, l) = (REAL(l*(l-1), dp)*rk**(l-2)- & - 2._dp*al*REAL(2*l+1, dp)*rk**(l)+4._dp*al*rk**(l+2))*ear + basis%dbf(k, i, l) = (REAL(l, dp)*rk**(l - 1) - 2._dp*al*rk**(l + 1))*ear + basis%ddbf(k, i, l) = (REAL(l*(l - 1), dp)*rk**(l - 2) - & + 2._dp*al*REAL(2*l + 1, dp)*rk**(l) + 4._dp*al*rk**(l + 2))*ear END DO END DO END DO @@ -430,7 +430,7 @@ SUBROUTINE atom_fit_basis(atom_info, basis, pptype, iunit, powell_section) DO l = 0, lmat DO i = 1, basis%nprim(l) al = x(xtob(i, l))**2 - basis%as(i, l) = EXP(al)-1._dp + basis%as(i, l) = EXP(al) - 1._dp END DO END DO basis%bf = 0._dp @@ -444,11 +444,11 @@ SUBROUTINE atom_fit_basis(atom_info, basis, pptype, iunit, powell_section) pf = (2._dp*al)**nl*SQRT(2._dp*al/fac(2*nl)) DO k = 1, nr rk = basis%grid%rad(k) - ear = rk**(nl-1)*EXP(-al*rk) + ear = rk**(nl - 1)*EXP(-al*rk) basis%bf(k, i, l) = pf*ear - basis%dbf(k, i, l) = pf*(REAL(nl-1, dp)/rk-al)*ear - basis%ddbf(k, i, l) = pf*(REAL((nl-2)*(nl-1), dp)/rk/rk & - -al*REAL(2*(nl-1), dp)/rk+al*al)*ear + basis%dbf(k, i, l) = pf*(REAL(nl - 1, dp)/rk - al)*ear + basis%ddbf(k, i, l) = pf*(REAL((nl - 2)*(nl - 1), dp)/rk/rk & + - al*REAL(2*(nl - 1), dp)/rk + al*al)*ear END DO END DO END DO @@ -622,66 +622,66 @@ SUBROUTINE atom_fit_pseudo(atom_info, atom_refs, ppot, iunit, powell_section) DO l = 0, lmat np = atom%state%maxn_calc(l) DO k = 1, np - CALL atom_orbital_max(rmax, atom_refs(i, j)%atom%orbitals%wfn(:, ncore(l)+k, l), & + CALL atom_orbital_max(rmax, atom_refs(i, j)%atom%orbitals%wfn(:, ncore(l) + k, l), & rcov, l, atom_refs(i, j)%atom%basis) atom%orbitals%rcmax(k, l, 1) = MAX(rcov, rmax) - CALL atom_orbital_charge(charge, atom_refs(i, j)%atom%orbitals%wfn(:, ncore(l)+k, l), & + CALL atom_orbital_charge(charge, atom_refs(i, j)%atom%orbitals%wfn(:, ncore(l) + k, l), & atom%orbitals%rcmax(k, l, 1), l, atom_refs(i, j)%atom%basis) - atom%orbitals%refene(k, l, 1) = atom_refs(i, j)%atom%orbitals%ener(ncore(l)+k, l) + atom%orbitals%refene(k, l, 1) = atom_refs(i, j)%atom%orbitals%ener(ncore(l) + k, l) atom%orbitals%refchg(k, l, 1) = charge IF (k > atom%state%maxn_occ(l)) THEN - IF (k <= atom%state%maxn_occ(l)+1) THEN + IF (k <= atom%state%maxn_occ(l) + 1) THEN atom%orbitals%wrefene(k, l, 1) = w_virt atom%orbitals%wrefchg(k, l, 1) = w_virt/100._dp atom%orbitals%crefene(k, l, 1) = t_virt atom%orbitals%reftype(k, l, 1) = "U1" - ntarget = ntarget+2 - wtot = wtot+atom%weight*(w_virt+w_virt/100._dp) + ntarget = ntarget + 2 + wtot = wtot + atom%weight*(w_virt + w_virt/100._dp) ELSE atom%orbitals%wrefene(k, l, 1) = w_virt/100._dp atom%orbitals%wrefchg(k, l, 1) = 0._dp atom%orbitals%crefene(k, l, 1) = t_virt*10._dp atom%orbitals%reftype(k, l, 1) = "U2" - ntarget = ntarget+1 - wtot = wtot+atom%weight*w_virt/100._dp + ntarget = ntarget + 1 + wtot = wtot + atom%weight*w_virt/100._dp END IF ELSEIF (k < atom%state%maxn_occ(l)) THEN atom%orbitals%wrefene(k, l, 1) = w_semi atom%orbitals%wrefchg(k, l, 1) = w_semi/100._dp atom%orbitals%crefene(k, l, 1) = t_semi atom%orbitals%reftype(k, l, 1) = "SC" - ntarget = ntarget+2 - wtot = wtot+atom%weight*(w_semi+w_semi/100._dp) + ntarget = ntarget + 2 + wtot = wtot + atom%weight*(w_semi + w_semi/100._dp) ELSE - IF (ABS(atom%state%occupation(l, k)-REAL(4*l+2, KIND=dp)) < 0.01_dp .AND. & + IF (ABS(atom%state%occupation(l, k) - REAL(4*l + 2, KIND=dp)) < 0.01_dp .AND. & ABS(atom%orbitals%refene(k, l, 1)) > semicore_level) THEN ! full shell semicore atom%orbitals%wrefene(k, l, 1) = w_semi atom%orbitals%wrefchg(k, l, 1) = w_semi/100._dp atom%orbitals%crefene(k, l, 1) = t_semi atom%orbitals%reftype(k, l, 1) = "SC" - wtot = wtot+atom%weight*(w_semi+w_semi/100._dp) + wtot = wtot + atom%weight*(w_semi + w_semi/100._dp) ELSE atom%orbitals%wrefene(k, l, 1) = w_valence atom%orbitals%wrefchg(k, l, 1) = w_valence/100._dp atom%orbitals%crefene(k, l, 1) = t_valence atom%orbitals%reftype(k, l, 1) = "VA" - wtot = wtot+atom%weight*(w_valence+w_valence/100._dp) + wtot = wtot + atom%weight*(w_valence + w_valence/100._dp) END IF IF (l == 0) THEN atom%orbitals%tpsir0(k, 1) = t_psir0 atom%orbitals%wpsir0(k, 1) = w_psir0 - wtot = wtot+atom%weight*w_psir0 + wtot = wtot + atom%weight*w_psir0 END IF - ntarget = ntarget+2 + ntarget = ntarget + 2 END IF END DO DO k = 1, np - atom%orbitals%refnod(k, l, 1) = REAL(k-1, KIND=dp) + atom%orbitals%refnod(k, l, 1) = REAL(k - 1, KIND=dp) ! we only enforce 0-nodes for the first state IF (k == 1 .AND. atom%state%occupation(l, k) /= 0._dp) THEN atom%orbitals%wrefnod(k, l, 1) = w_node - wtot = wtot+atom%weight*w_node + wtot = wtot + atom%weight*w_node END IF END DO END DO @@ -692,77 +692,77 @@ SUBROUTINE atom_fit_pseudo(atom_info, atom_refs, ppot, iunit, powell_section) DO l = 0, lmat np = atom%state%maxn_calc(l) DO k = 1, np - CALL atom_orbital_max(rmax, atom_refs(i, j)%atom%orbitals%wfna(:, ncore(l)+k, l), & + CALL atom_orbital_max(rmax, atom_refs(i, j)%atom%orbitals%wfna(:, ncore(l) + k, l), & rcov, l, atom_refs(i, j)%atom%basis) atom%orbitals%rcmax(k, l, 1) = MAX(rcov, rmax) - CALL atom_orbital_max(rmax, atom_refs(i, j)%atom%orbitals%wfnb(:, ncore(l)+k, l), & + CALL atom_orbital_max(rmax, atom_refs(i, j)%atom%orbitals%wfnb(:, ncore(l) + k, l), & rcov, l, atom_refs(i, j)%atom%basis) atom%orbitals%rcmax(k, l, 2) = MAX(rcov, rmax) - CALL atom_orbital_charge(charge, atom_refs(i, j)%atom%orbitals%wfna(:, ncore(l)+k, l), & + CALL atom_orbital_charge(charge, atom_refs(i, j)%atom%orbitals%wfna(:, ncore(l) + k, l), & atom%orbitals%rcmax(k, l, 1), l, atom_refs(i, j)%atom%basis) - atom%orbitals%refene(k, l, 1) = atom_refs(i, j)%atom%orbitals%enera(ncore(l)+k, l) + atom%orbitals%refene(k, l, 1) = atom_refs(i, j)%atom%orbitals%enera(ncore(l) + k, l) atom%orbitals%refchg(k, l, 1) = charge - CALL atom_orbital_charge(charge, atom_refs(i, j)%atom%orbitals%wfnb(:, ncore(l)+k, l), & + CALL atom_orbital_charge(charge, atom_refs(i, j)%atom%orbitals%wfnb(:, ncore(l) + k, l), & atom%orbitals%rcmax(k, l, 1), l, atom_refs(i, j)%atom%basis) - atom%orbitals%refene(k, l, 2) = atom_refs(i, j)%atom%orbitals%enerb(ncore(l)+k, l) + atom%orbitals%refene(k, l, 2) = atom_refs(i, j)%atom%orbitals%enerb(ncore(l) + k, l) atom%orbitals%refchg(k, l, 2) = charge ! the following assignments could be further specialized IF (k > atom%state%maxn_occ(l)) THEN - IF (k <= atom%state%maxn_occ(l)+1) THEN + IF (k <= atom%state%maxn_occ(l) + 1) THEN atom%orbitals%wrefene(k, l, 1:2) = w_virt atom%orbitals%wrefchg(k, l, 1:2) = w_virt/100._dp atom%orbitals%crefene(k, l, 1:2) = t_virt atom%orbitals%reftype(k, l, 1:2) = "U1" - ntarget = ntarget+4 - wtot = wtot+atom%weight*2._dp*(w_virt+w_virt/100._dp) + ntarget = ntarget + 4 + wtot = wtot + atom%weight*2._dp*(w_virt + w_virt/100._dp) ELSE atom%orbitals%wrefene(k, l, 1:2) = w_virt/100._dp atom%orbitals%wrefchg(k, l, 1:2) = 0._dp atom%orbitals%crefene(k, l, 1:2) = t_virt*10.0_dp atom%orbitals%reftype(k, l, 1:2) = "U2" - wtot = wtot+atom%weight*2._dp*w_virt/100._dp - ntarget = ntarget+2 + wtot = wtot + atom%weight*2._dp*w_virt/100._dp + ntarget = ntarget + 2 END IF ELSEIF (k < atom%state%maxn_occ(l)) THEN atom%orbitals%wrefene(k, l, 1:2) = w_semi atom%orbitals%wrefchg(k, l, 1:2) = w_semi/100._dp atom%orbitals%crefene(k, l, 1:2) = t_semi atom%orbitals%reftype(k, l, 1:2) = "SC" - ntarget = ntarget+4 - wtot = wtot+atom%weight*2._dp*(w_semi+w_semi/100._dp) + ntarget = ntarget + 4 + wtot = wtot + atom%weight*2._dp*(w_semi + w_semi/100._dp) ELSE - IF (ABS(atom%state%occupation(l, k)-REAL(2*l+1, KIND=dp)) < 0.01_dp .AND. & + IF (ABS(atom%state%occupation(l, k) - REAL(2*l + 1, KIND=dp)) < 0.01_dp .AND. & ABS(atom%orbitals%refene(k, l, 1)) > semicore_level) THEN atom%orbitals%wrefene(k, l, 1:2) = w_semi atom%orbitals%wrefchg(k, l, 1:2) = w_semi/100._dp atom%orbitals%crefene(k, l, 1:2) = t_semi atom%orbitals%reftype(k, l, 1:2) = "SC" - wtot = wtot+atom%weight*2._dp*(w_semi+w_semi/100._dp) + wtot = wtot + atom%weight*2._dp*(w_semi + w_semi/100._dp) ELSE atom%orbitals%wrefene(k, l, 1:2) = w_valence atom%orbitals%wrefchg(k, l, 1:2) = w_valence/100._dp atom%orbitals%crefene(k, l, 1:2) = t_valence atom%orbitals%reftype(k, l, 1:2) = "VA" - wtot = wtot+atom%weight*2._dp*(w_valence+w_valence/100._dp) + wtot = wtot + atom%weight*2._dp*(w_valence + w_valence/100._dp) END IF - ntarget = ntarget+4 + ntarget = ntarget + 4 IF (l == 0) THEN atom%orbitals%tpsir0(k, 1:2) = t_psir0 atom%orbitals%wpsir0(k, 1:2) = w_psir0 - wtot = wtot+atom%weight*2._dp*w_psir0 + wtot = wtot + atom%weight*2._dp*w_psir0 END IF END IF END DO DO k = 1, np - atom%orbitals%refnod(k, l, 1:2) = REAL(k-1, KIND=dp) + atom%orbitals%refnod(k, l, 1:2) = REAL(k - 1, KIND=dp) ! we only enforce 0-nodes for the first state IF (k == 1 .AND. atom%state%occa(l, k) /= 0._dp) THEN atom%orbitals%wrefnod(k, l, 1) = w_node - wtot = wtot+atom%weight*w_node + wtot = wtot + atom%weight*w_node END IF IF (k == 1 .AND. atom%state%occb(l, k) /= 0._dp) THEN atom%orbitals%wrefnod(k, l, 2) = w_node - wtot = wtot+atom%weight*w_node + wtot = wtot + atom%weight*w_node END IF END DO END DO @@ -777,8 +777,8 @@ SUBROUTINE atom_fit_pseudo(atom_info, atom_refs, ppot, iunit, powell_section) DO i1 = 1, SIZE(atom_info, 1) DO i2 = 1, SIZE(atom_info, 1) IF ((j1 > j2) .OR. (j1 == j2 .AND. i1 >= i2)) CYCLE - dener(2, j1, j2, i1, i2) = dener(2, j1, j1, i1, i1)-dener(2, j2, j2, i2, i2) - wtot = wtot+w_ener + dener(2, j1, j2, i1, i2) = dener(2, j1, j1, i1, i1) - dener(2, j2, j2, i2, i2) + wtot = wtot + w_ener END DO END DO END DO @@ -811,7 +811,7 @@ SUBROUTINE atom_fit_pseudo(atom_info, atom_refs, ppot, iunit, powell_section) DO k = 1, np oc = atom%state%occupation(l, k) eig = atom%orbitals%ener(k, l) - deig = eig-atom%orbitals%refene(k, l, 1) + deig = eig - atom%orbitals%refene(k, l, 1) peig = pval(1, k, l, j, i)/afun*100._dp IF (pval(5, k, l, j, i) > 0.5_dp) THEN pc1 = " X" @@ -820,7 +820,7 @@ SUBROUTINE atom_fit_pseudo(atom_info, atom_refs, ppot, iunit, powell_section) END IF CALL atom_orbital_charge(charge, atom%orbitals%wfn(:, k, l), & atom%orbitals%rcmax(k, l, 1), l, atom%basis) - drho = charge-atom%orbitals%refchg(k, l, 1) + drho = charge - atom%orbitals%refchg(k, l, 1) pchg = pval(2, k, l, j, i)/afun*100._dp IF (pval(6, k, l, j, i) > 0.5_dp) THEN pc2 = " X" @@ -842,7 +842,7 @@ SUBROUTINE atom_fit_pseudo(atom_info, atom_refs, ppot, iunit, powell_section) DO k = 1, np oc = atom%state%occa(l, k) eig = atom%orbitals%enera(k, l) - deig = eig-atom%orbitals%refene(k, l, 1) + deig = eig - atom%orbitals%refene(k, l, 1) peig = pval(1, k, l, j, i)/afun*100._dp IF (pval(5, k, l, j, i) > 0.5_dp) THEN pc1 = " X" @@ -851,7 +851,7 @@ SUBROUTINE atom_fit_pseudo(atom_info, atom_refs, ppot, iunit, powell_section) END IF CALL atom_orbital_charge( & charge, atom%orbitals%wfna(:, k, l), atom%orbitals%rcmax(k, l, 1), l, atom%basis) - drho = charge-atom%orbitals%refchg(k, l, 1) + drho = charge - atom%orbitals%refchg(k, l, 1) pchg = pval(2, k, l, j, i)/afun*100._dp IF (pval(6, k, l, j, i) > 0.5_dp) THEN pc2 = " X" @@ -863,7 +863,7 @@ SUBROUTINE atom_fit_pseudo(atom_info, atom_refs, ppot, iunit, powell_section) l, k, "alpha", oc, eig*evolt, pct, deig*evolt, pc1, drho, pc2 oc = atom%state%occb(l, k) eig = atom%orbitals%enerb(k, l) - deig = eig-atom%orbitals%refene(k, l, 2) + deig = eig - atom%orbitals%refene(k, l, 2) peig = pval(3, k, l, j, i)/afun*100._dp IF (pval(7, k, l, j, i) > 0.5_dp) THEN pc1 = " X" @@ -872,7 +872,7 @@ SUBROUTINE atom_fit_pseudo(atom_info, atom_refs, ppot, iunit, powell_section) END IF CALL atom_orbital_charge( & charge, atom%orbitals%wfnb(:, k, l), atom%orbitals%rcmax(k, l, 2), l, atom%basis) - drho = charge-atom%orbitals%refchg(k, l, 2) + drho = charge - atom%orbitals%refchg(k, l, 2) pchg = pval(4, k, l, j, i)/afun*100._dp IF (pval(8, k, l, j, i) > 0.5_dp) THEN pc2 = " X" @@ -902,7 +902,7 @@ SUBROUTINE atom_fit_pseudo(atom_info, atom_refs, ppot, iunit, powell_section) IF (ABS(dener(2, j1, j1, i1, i1)) < 0.000001_dp) CYCLE IF (ABS(dener(1, j2, j2, i2, i2)) < 0.000001_dp) CYCLE IF (ABS(dener(2, j2, j2, i2, i2)) < 0.000001_dp) CYCLE - de = dener(2, j1, j2, i1, i2)-dener(1, j1, j2, i1, i2) + de = dener(2, j1, j2, i1, i2) - dener(1, j1, j2, i1, i2) WRITE (iunit, '(i6,i6,i10,i6,5X,F16.6,F19.6,F12.6)') & j1, i1, j2, i2, dener(2, j1, j2, i1, i2), de, t_ener END DO @@ -953,7 +953,7 @@ SUBROUTINE atom_fit_pseudo(atom_info, atom_refs, ppot, iunit, powell_section) END DO - dx = SQRT(SUM((ostate%xopt(:)-xi(:))**2)/REAL(ostate%nvar, KIND=dp)) + dx = SQRT(SUM((ostate%xopt(:) - xi(:))**2)/REAL(ostate%nvar, KIND=dp)) IF (iunit > 0) THEN WRITE (iunit, '(" POWELL| RMS average of variables",T69,F12.10)') dx END IF @@ -990,7 +990,7 @@ SUBROUTINE atom_fit_pseudo(atom_info, atom_refs, ppot, iunit, powell_section) DO k = 1, np oc = atom%state%occupation(l, k) eig = atom%orbitals%ener(k, l) - deig = eig-atom%orbitals%refene(k, l, 1) + deig = eig - atom%orbitals%refene(k, l, 1) peig = pval(1, k, l, j, i)/afun*100._dp IF (pval(5, k, l, j, i) > 0.5_dp) THEN pc1 = " X" @@ -999,7 +999,7 @@ SUBROUTINE atom_fit_pseudo(atom_info, atom_refs, ppot, iunit, powell_section) END IF CALL atom_orbital_charge( & charge, atom%orbitals%wfn(:, k, l), atom%orbitals%rcmax(k, l, 1), l, atom%basis) - drho = charge-atom%orbitals%refchg(k, l, 1) + drho = charge - atom%orbitals%refchg(k, l, 1) pchg = pval(2, k, l, j, i)/afun*100._dp IF (pval(6, k, l, j, i) > 0.5_dp) THEN pc2 = " X" @@ -1019,7 +1019,7 @@ SUBROUTINE atom_fit_pseudo(atom_info, atom_refs, ppot, iunit, powell_section) IF (ABS(pv) > ABS(atom%orbitals%tpsir0(k, 1))) THEN pv = 0.0_dp ELSE - pv = 10._dp*(ABS(pv)-ABS(atom%orbitals%tpsir0(k, 1))) + pv = 10._dp*(ABS(pv) - ABS(atom%orbitals%tpsir0(k, 1))) END IF pchg = atom%weight*atom%orbitals%wpsir0(k, 1)*pv*pv/afun ELSE @@ -1037,7 +1037,7 @@ SUBROUTINE atom_fit_pseudo(atom_info, atom_refs, ppot, iunit, powell_section) DO k = 1, np oc = atom%state%occa(l, k) eig = atom%orbitals%enera(k, l) - deig = eig-atom%orbitals%refene(k, l, 1) + deig = eig - atom%orbitals%refene(k, l, 1) peig = pval(1, k, l, j, i)/afun*100._dp IF (pval(5, k, l, j, i) > 0.5_dp) THEN pc1 = " X" @@ -1046,7 +1046,7 @@ SUBROUTINE atom_fit_pseudo(atom_info, atom_refs, ppot, iunit, powell_section) END IF CALL atom_orbital_charge( & charge, atom%orbitals%wfna(:, k, l), atom%orbitals%rcmax(k, l, 1), l, atom%basis) - drho = charge-atom%orbitals%refchg(k, l, 1) + drho = charge - atom%orbitals%refchg(k, l, 1) pchg = pval(2, k, l, j, i)/afun*100._dp IF (pval(6, k, l, j, i) > 0.5_dp) THEN pc2 = " X" @@ -1058,7 +1058,7 @@ SUBROUTINE atom_fit_pseudo(atom_info, atom_refs, ppot, iunit, powell_section) l, k, " alpha", oc, eig*evolt, pct, deig*evolt, pc1, drho, pc2 oc = atom%state%occb(l, k) eig = atom%orbitals%enerb(k, l) - deig = eig-atom%orbitals%refene(k, l, 2) + deig = eig - atom%orbitals%refene(k, l, 2) peig = pval(3, k, l, j, i)/afun*100._dp IF (pval(7, k, l, j, i) > 0.5_dp) THEN pc1 = " X" @@ -1067,7 +1067,7 @@ SUBROUTINE atom_fit_pseudo(atom_info, atom_refs, ppot, iunit, powell_section) END IF CALL atom_orbital_charge( & charge, atom%orbitals%wfnb(:, k, l), atom%orbitals%rcmax(k, l, 2), l, atom%basis) - drho = charge-atom%orbitals%refchg(k, l, 2) + drho = charge - atom%orbitals%refchg(k, l, 2) pchg = pval(4, k, l, j, i)/afun*100._dp IF (pval(8, k, l, j, i) > 0.5_dp) THEN pc2 = " X" @@ -1087,7 +1087,7 @@ SUBROUTINE atom_fit_pseudo(atom_info, atom_refs, ppot, iunit, powell_section) IF (ABS(pv) > ABS(atom%orbitals%tpsir0(k, 1))) THEN pv = 0.0_dp ELSE - pv = 10._dp*(ABS(pv)-ABS(atom%orbitals%tpsir0(k, 1))) + pv = 10._dp*(ABS(pv) - ABS(atom%orbitals%tpsir0(k, 1))) END IF pchg = atom%weight*atom%orbitals%wpsir0(k, 1)*pv*pv/afun ELSE @@ -1101,7 +1101,7 @@ SUBROUTINE atom_fit_pseudo(atom_info, atom_refs, ppot, iunit, powell_section) IF (ABS(pv) > ABS(atom%orbitals%tpsir0(k, 2))) THEN pv = 0.0_dp ELSE - pv = 10._dp*(ABS(pv)-ABS(atom%orbitals%tpsir0(k, 2))) + pv = 10._dp*(ABS(pv) - ABS(atom%orbitals%tpsir0(k, 2))) END IF pchg = atom%weight*atom%orbitals%wpsir0(k, 2)*pv*pv/afun ELSE @@ -1127,7 +1127,7 @@ SUBROUTINE atom_fit_pseudo(atom_info, atom_refs, ppot, iunit, powell_section) IF (ABS(dener(2, j1, j1, i1, i1)) < 0.000001_dp) CYCLE IF (ABS(dener(1, j2, j2, i2, i2)) < 0.000001_dp) CYCLE IF (ABS(dener(2, j2, j2, i2, i2)) < 0.000001_dp) CYCLE - de = dener(2, j1, j2, i1, i2)-dener(1, j1, j2, i1, i2) + de = dener(2, j1, j2, i1, i2) - dener(1, j1, j2, i1, i2) WRITE (iunit, '(i6,i6,i10,i6,5X,F16.6,F19.6,F12.6)') j1, i1, j2, i2, dener(2, j1, j2, i1, i2), de, t_ener END DO END DO @@ -1221,7 +1221,7 @@ SUBROUTINE opt_nlcc_param(atom_info, atom_refs, gthpot, iunit, preopt_nlcc) CALL atom_denmat(dmb%op, aref%orbitals%wfnb, & atom%basis%nbas, atom%state%core, & aref%state%maxl_occ, aref%state%maxn_occ) - denmat%op = 0.5_dp*(dma%op+dmb%op) + denmat%op = 0.5_dp*(dma%op + dmb%op) CALL release_opmat(dma) CALL release_opmat(dmb) CASE (do_rohf_atom) @@ -1230,9 +1230,9 @@ SUBROUTINE opt_nlcc_param(atom_info, atom_refs, gthpot, iunit, preopt_nlcc) CPABORT("") END SELECT - im = im+1 + im = im + 1 CALL atom_density(den%op, denmat%op, atom%basis, aref%state%maxl_occ, typ="RHO") - density%op = density%op+den%op + density%op = density%op + den%op zcore = integrate_grid(den%op, atom%basis%grid) zcore = fourpi*zcore NULLIFY (den1, den2) @@ -1334,24 +1334,24 @@ SUBROUTINE density_fit(density, atom, n, aval, cval, co, aerr) zval = integrate_grid(density%op, atom%basis%grid) ! allocate vectors and matrices for overlaps - ALLOCATE (tval(n+1, 1), uval(n), smat(n+1, n+1)) + ALLOCATE (tval(n + 1, 1), uval(n), smat(n + 1, n + 1)) DO i = 1, n uval(i) = (pi/pe(i))**1.5_dp tval(i, 1) = integrate_grid(density%op, bf(:, i), atom%basis%grid) END DO - tval(n+1, 1) = zval + tval(n + 1, 1) = zval DO iq = 1, n DO ip = 1, n - smat(ip, iq) = (pi/(pe(ip)+pe(iq)))**1.5_dp + smat(ip, iq) = (pi/(pe(ip) + pe(iq)))**1.5_dp END DO END DO - smat(1:n, n+1) = uval(1:n) - smat(n+1, 1:n) = uval(1:n) - smat(n+1, n+1) = 0._dp + smat(1:n, n + 1) = uval(1:n) + smat(n + 1, 1:n) = uval(1:n) + smat(n + 1, n + 1) = 0._dp - ALLOCATE (ipiv(n+1)) - CALL lapack_sgesv(n+1, 1, smat, n+1, ipiv, tval, n+1, info) + ALLOCATE (ipiv(n + 1)) + CALL lapack_sgesv(n + 1, 1, smat, n + 1, ipiv, tval, n + 1, info) DEALLOCATE (ipiv) CPASSERT(info == 0) co(1:n) = tval(1:n, 1) @@ -1359,10 +1359,10 @@ SUBROUTINE density_fit(density, atom, n, aval, cval, co, aerr) ! calculate density den(:) = 0._dp DO i = 1, n - den(:) = den(:)+co(i)*bf(:, i) + den(:) = den(:) + co(i)*bf(:, i) END DO den(:) = den(:)*fourpi - den(:) = (den(:)-density%op(:))**2 + den(:) = (den(:) - density%op(:))**2 aerr = SQRT(integrate_grid(den, atom%basis%grid)) DEALLOCATE (pe, bf, den) @@ -1444,7 +1444,7 @@ SUBROUTINE basis_fit(atom_info, basis, pptype, afun, iw, penalty) CALL set_atom(atom, basis=basis) CALL set_atom(atom, integrals=atint) CALL calculate_atom(atom, iw) - afun = afun+atom%energy%etot*atom%weight + afun = afun + atom%energy%etot*atom%weight END IF END IF END DO @@ -1453,10 +1453,10 @@ SUBROUTINE basis_fit(atom_info, basis, pptype, afun, iw, penalty) ! penalty IF (penalty) THEN DO l = 0, lmat - DO i = 1, basis%nbas(l)-1 - amin = MINVAL(ABS(basis%am(i, l)-basis%am(i+1:basis%nbas(l), l))) + DO i = 1, basis%nbas(l) - 1 + amin = MINVAL(ABS(basis%am(i, l) - basis%am(i + 1:basis%nbas(l), l))) amin = amin/basis%am(i, l) - afun = afun+10._dp*EXP(-(20._dp*amin)**4) + afun = afun + 10._dp*EXP(-(20._dp*amin)**4) END DO END DO END IF @@ -1523,7 +1523,7 @@ SUBROUTINE pseudo_fit(atom_info, wfn_guess, ppot, afun, wtot, pval, dener, wen, IF (.NOT. converged) THEN CALL calculate_atom(atom, 0, noguess=.FALSE., converged=shift) IF (.NOT. shift) THEN - atom%orbitals%ener(:, :) = 1.5_dp*atom%orbitals%ener(:, :)+0.5_dp + atom%orbitals%ener(:, :) = 1.5_dp*atom%orbitals%ener(:, :) + 0.5_dp END IF END IF dener(1, j, j, i, i) = atom%energy%etot @@ -1534,25 +1534,25 @@ SUBROUTINE pseudo_fit(atom_info, wfn_guess, ppot, afun, wtot, pval, dener, wen, !no spin polarization rcov = atom%orbitals%rcmax(k, l, 1) tv = atom%orbitals%crefene(k, l, 1) - de = ABS(atom%orbitals%ener(k, l)-atom%orbitals%refene(k, l, 1)) + de = ABS(atom%orbitals%ener(k, l) - atom%orbitals%refene(k, l, 1)) fde = get_error_value(de, tv) IF (fde < 1.e-8) pval(5, k, l, j, i) = 1._dp pv = atom%weight*atom%orbitals%wrefene(k, l, 1)*fde - afun = afun+pv + afun = afun + pv pval(1, k, l, j, i) = pv IF (atom%orbitals%wrefchg(k, l, 1) > 0._dp) THEN CALL atom_orbital_charge(charge, atom%orbitals%wfn(:, k, l), rcov, l, atom%basis) - de = ABS(charge-atom%orbitals%refchg(k, l, 1)) + de = ABS(charge - atom%orbitals%refchg(k, l, 1)) fde = get_error_value(de, 25._dp*tv) IF (fde < 1.e-8) pval(6, k, l, j, i) = 1._dp pv = atom%weight*atom%orbitals%wrefchg(k, l, 1)*fde - afun = afun+pv + afun = afun + pv pval(2, k, l, j, i) = pv END IF IF (atom%orbitals%wrefnod(k, l, 1) > 0._dp) THEN CALL atom_orbital_nodes(node, atom%orbitals%wfn(:, k, l), 2._dp*rcov, l, atom%basis) - afun = afun+atom%weight*atom%orbitals%wrefnod(k, l, 1)* & - ABS(REAL(node, dp)-atom%orbitals%refnod(k, l, 1)) + afun = afun + atom%weight*atom%orbitals%wrefnod(k, l, 1)* & + ABS(REAL(node, dp) - atom%orbitals%refnod(k, l, 1)) END IF IF (l == 0) THEN IF (atom%orbitals%wpsir0(k, 1) > 0._dp) THEN @@ -1561,13 +1561,13 @@ SUBROUTINE pseudo_fit(atom_info, wfn_guess, ppot, afun, wtot, pval, dener, wen, IF (ABS(pv) > ABS(atom%orbitals%tpsir0(k, 1))) THEN pv = 0.0_dp ELSE - pv = 10._dp*(ABS(pv)-ABS(atom%orbitals%tpsir0(k, 1))) + pv = 10._dp*(ABS(pv) - ABS(atom%orbitals%tpsir0(k, 1))) END IF pv = atom%weight*atom%orbitals%wpsir0(k, 1)*pv*pv ELSE pv = atom%weight*atom%orbitals%wpsir0(k, 1)*pv*pv*100._dp END IF - afun = afun+pv + afun = afun + pv END IF END IF ELSE @@ -1575,46 +1575,46 @@ SUBROUTINE pseudo_fit(atom_info, wfn_guess, ppot, afun, wtot, pval, dener, wen, rcov1 = atom%orbitals%rcmax(k, l, 1) rcov2 = atom%orbitals%rcmax(k, l, 2) tv = atom%orbitals%crefene(k, l, 1) - de = ABS(atom%orbitals%enera(k, l)-atom%orbitals%refene(k, l, 1)) + de = ABS(atom%orbitals%enera(k, l) - atom%orbitals%refene(k, l, 1)) fde = get_error_value(de, tv) IF (fde < 1.e-8) pval(5, k, l, j, i) = 1._dp pv = atom%weight*atom%orbitals%wrefene(k, l, 1)*fde - afun = afun+pv + afun = afun + pv pval(1, k, l, j, i) = pv tv = atom%orbitals%crefene(k, l, 2) - de = ABS(atom%orbitals%enerb(k, l)-atom%orbitals%refene(k, l, 2)) + de = ABS(atom%orbitals%enerb(k, l) - atom%orbitals%refene(k, l, 2)) fde = get_error_value(de, tv) IF (fde < 1.e-8) pval(7, k, l, j, i) = 1._dp pv = atom%weight*atom%orbitals%wrefene(k, l, 2)*fde - afun = afun+pv + afun = afun + pv pval(3, k, l, j, i) = pv IF (atom%orbitals%wrefchg(k, l, 1) > 0._dp) THEN CALL atom_orbital_charge(charge, atom%orbitals%wfna(:, k, l), rcov1, l, atom%basis) - de = ABS(charge-atom%orbitals%refchg(k, l, 1)) + de = ABS(charge - atom%orbitals%refchg(k, l, 1)) fde = get_error_value(de, 25._dp*tv) IF (fde < 1.e-8) pval(6, k, l, j, i) = 1._dp pv = atom%weight*atom%orbitals%wrefchg(k, l, 1)*fde - afun = afun+pv + afun = afun + pv pval(2, k, l, j, i) = pv END IF IF (atom%orbitals%wrefchg(k, l, 2) > 0._dp) THEN CALL atom_orbital_charge(charge, atom%orbitals%wfnb(:, k, l), rcov2, l, atom%basis) - de = ABS(charge-atom%orbitals%refchg(k, l, 2)) + de = ABS(charge - atom%orbitals%refchg(k, l, 2)) fde = get_error_value(de, 25._dp*tv) IF (fde < 1.e-8) pval(8, k, l, j, i) = 1._dp pv = atom%weight*atom%orbitals%wrefchg(k, l, 2)*fde - afun = afun+pv + afun = afun + pv pval(4, k, l, j, i) = pv END IF IF (atom%orbitals%wrefnod(k, l, 1) > 0._dp) THEN CALL atom_orbital_nodes(node, atom%orbitals%wfna(:, k, l), 2._dp*rcov1, l, atom%basis) - afun = afun+atom%weight*atom%orbitals%wrefnod(k, l, 1)* & - ABS(REAL(node, dp)-atom%orbitals%refnod(k, l, 1)) + afun = afun + atom%weight*atom%orbitals%wrefnod(k, l, 1)* & + ABS(REAL(node, dp) - atom%orbitals%refnod(k, l, 1)) END IF IF (atom%orbitals%wrefnod(k, l, 2) > 0._dp) THEN CALL atom_orbital_nodes(node, atom%orbitals%wfnb(:, k, l), 2._dp*rcov2, l, atom%basis) - afun = afun+atom%weight*atom%orbitals%wrefnod(k, l, 2)* & - ABS(REAL(node, dp)-atom%orbitals%refnod(k, l, 2)) + afun = afun + atom%weight*atom%orbitals%wrefnod(k, l, 2)* & + ABS(REAL(node, dp) - atom%orbitals%refnod(k, l, 2)) END IF IF (l == 0) THEN IF (atom%orbitals%wpsir0(k, 1) > 0._dp) THEN @@ -1623,13 +1623,13 @@ SUBROUTINE pseudo_fit(atom_info, wfn_guess, ppot, afun, wtot, pval, dener, wen, IF (ABS(pv) > ABS(atom%orbitals%tpsir0(k, 1))) THEN pv = 0.0_dp ELSE - pv = 10._dp*(ABS(pv)-ABS(atom%orbitals%tpsir0(k, 1))) + pv = 10._dp*(ABS(pv) - ABS(atom%orbitals%tpsir0(k, 1))) END IF pv = atom%weight*atom%orbitals%wpsir0(k, 1)*pv*pv ELSE pv = atom%weight*atom%orbitals%wpsir0(k, 1)*pv*pv*100._dp END IF - afun = afun+pv + afun = afun + pv END IF IF (atom%orbitals%wpsir0(k, 2) > 0._dp) THEN CALL atom_wfnr0(pv, atom%orbitals%wfnb(:, k, l), atom%basis) @@ -1637,13 +1637,13 @@ SUBROUTINE pseudo_fit(atom_info, wfn_guess, ppot, afun, wtot, pval, dener, wen, IF (ABS(pv) > ABS(atom%orbitals%tpsir0(k, 2))) THEN pv = 0.0_dp ELSE - pv = 10._dp*(ABS(pv)-ABS(atom%orbitals%tpsir0(k, 2))) + pv = 10._dp*(ABS(pv) - ABS(atom%orbitals%tpsir0(k, 2))) END IF pv = atom%weight*atom%orbitals%wpsir0(k, 2)*pv*pv ELSE pv = atom%weight*atom%orbitals%wpsir0(k, 2)*pv*pv*100._dp END IF - afun = afun+pv + afun = afun + pv END IF END IF ENDIF @@ -1657,12 +1657,12 @@ SUBROUTINE pseudo_fit(atom_info, wfn_guess, ppot, afun, wtot, pval, dener, wen, DO j1 = 1, SIZE(atom_info, 2) DO j2 = 1, SIZE(atom_info, 2) DO i1 = 1, SIZE(atom_info, 1) - DO i2 = i1+1, SIZE(atom_info, 1) + DO i2 = i1 + 1, SIZE(atom_info, 1) IF ((j1 > j2) .OR. (j1 == j2 .AND. i1 >= i2)) CYCLE - dener(1, j1, j2, i1, i2) = dener(1, j1, j1, i1, i1)-dener(1, j2, j2, i2, i2) - de = ABS(dener(2, j1, j2, i1, i2)-dener(1, j1, j2, i1, i2)) + dener(1, j1, j2, i1, i2) = dener(1, j1, j1, i1, i1) - dener(1, j2, j2, i2, i2) + de = ABS(dener(2, j1, j2, i1, i2) - dener(1, j1, j2, i1, i2)) fde = get_error_value(de, ten) - afun = afun+wen*fde + afun = afun + wen*fde END DO END DO END DO @@ -1687,7 +1687,7 @@ FUNCTION get_error_value(fval, ftarget) RESULT(errval) IF (fval <= ftarget) THEN errval = 0.0_dp ELSE - errval = (fval-ftarget)/MAX(ftarget, 1.e-10_dp) + errval = (fval - ftarget)/MAX(ftarget, 1.e-10_dp) errval = errval*errval END IF @@ -1714,10 +1714,10 @@ SUBROUTINE get_pseudo_param(pvec, nval, gthpot, noopt_nlcc) pvec = 0 ival = 0 DO j = 1, gthpot%nexp_lsd - ival = ival+1 + ival = ival + 1 pvec(ival) = rcpro(-1, gthpot%alpha_lsd(j)) DO i = 1, gthpot%nct_lsd(j) - ival = ival+1 + ival = ival + 1 pvec(ival) = gthpot%cval_lsd(i, j) END DO END DO @@ -1726,32 +1726,32 @@ SUBROUTINE get_pseudo_param(pvec, nval, gthpot, noopt_nlcc) ival = 1 pvec(ival) = rcpro(-1, gthpot%rc) DO i = 1, gthpot%ncl - ival = ival+1 + ival = ival + 1 pvec(ival) = gthpot%cl(i) END DO IF (gthpot%lpotextended) THEN DO j = 1, gthpot%nexp_lpot - ival = ival+1 + ival = ival + 1 pvec(ival) = rcpro(-1, gthpot%alpha_lpot(j)) DO i = 1, gthpot%nct_lpot(j) - ival = ival+1 + ival = ival + 1 pvec(ival) = gthpot%cval_lpot(i, j) END DO END DO END IF IF (gthpot%nlcc .AND. (.NOT. noopt_nlcc)) THEN DO j = 1, gthpot%nexp_nlcc - ival = ival+1 + ival = ival + 1 pvec(ival) = rcpro(-1, gthpot%alpha_nlcc(j)) DO i = 1, gthpot%nct_nlcc(j) - ival = ival+1 + ival = ival + 1 pvec(ival) = gthpot%cval_nlcc(i, j) END DO END DO END IF DO l = 0, lmat IF (gthpot%nl(l) > 0) THEN - ival = ival+1 + ival = ival + 1 pvec(ival) = rcpro(-1, gthpot%rcnl(l)) END IF END DO @@ -1760,7 +1760,7 @@ SUBROUTINE get_pseudo_param(pvec, nval, gthpot, noopt_nlcc) n = gthpot%nl(l) DO i = 1, n DO j = i, n - ival = ival+1 + ival = ival + 1 pvec(ival) = gthpot%hnl(i, j, l) END DO END DO @@ -1790,10 +1790,10 @@ SUBROUTINE put_pseudo_param(pvec, gthpot, noopt_nlcc) IF (gthpot%lsdpot) THEN ival = 0 DO j = 1, gthpot%nexp_lsd - ival = ival+1 + ival = ival + 1 gthpot%alpha_lsd(j) = rcpro(1, pvec(ival)) DO i = 1, gthpot%nct_lsd(j) - ival = ival+1 + ival = ival + 1 gthpot%cval_lsd(i, j) = pvec(ival) END DO END DO @@ -1801,32 +1801,32 @@ SUBROUTINE put_pseudo_param(pvec, gthpot, noopt_nlcc) ival = 1 gthpot%rc = rcpro(1, pvec(ival)) DO i = 1, gthpot%ncl - ival = ival+1 + ival = ival + 1 gthpot%cl(i) = pvec(ival) END DO IF (gthpot%lpotextended) THEN DO j = 1, gthpot%nexp_lpot - ival = ival+1 + ival = ival + 1 gthpot%alpha_lpot(j) = rcpro(1, pvec(ival)) DO i = 1, gthpot%nct_lpot(j) - ival = ival+1 + ival = ival + 1 gthpot%cval_lpot(i, j) = pvec(ival) END DO END DO END IF IF (gthpot%nlcc .AND. (.NOT. noopt_nlcc)) THEN DO j = 1, gthpot%nexp_nlcc - ival = ival+1 + ival = ival + 1 gthpot%alpha_nlcc(j) = rcpro(1, pvec(ival)) DO i = 1, gthpot%nct_nlcc(j) - ival = ival+1 + ival = ival + 1 gthpot%cval_nlcc(i, j) = pvec(ival) END DO END DO END IF DO l = 0, lmat IF (gthpot%nl(l) > 0) THEN - ival = ival+1 + ival = ival + 1 gthpot%rcnl(l) = rcpro(1, pvec(ival)) END IF END DO @@ -1835,7 +1835,7 @@ SUBROUTINE put_pseudo_param(pvec, gthpot, noopt_nlcc) n = gthpot%nl(l) DO i = 1, n DO j = i, n - ival = ival+1 + ival = ival + 1 gthpot%hnl(i, j, l) = pvec(ival) END DO END DO @@ -1867,7 +1867,7 @@ FUNCTION rcpro(id, xval) RESULT(yval) ELSE IF (id == -1) THEN x1 = SQRT(xval/2.0_dp) CPASSERT(x1 <= 1._dp) - x2 = 0.5_dp*LOG((1._dp+x1)/(1._dp-x1)) + x2 = 0.5_dp*LOG((1._dp + x1)/(1._dp - x1)) yval = x2/0.1_dp ELSE CPABORT("wrong id") @@ -1902,7 +1902,7 @@ SUBROUTINE atom_fit_kgpot(atom, num_gau, num_pol, iunit, powell_section, results CPASSERT(num_pol*num_gau > 0) - ALLOCATE (co(num_pol+1, num_gau), x(num_pol*num_gau+num_gau)) + ALLOCATE (co(num_pol + 1, num_gau), x(num_pol*num_gau + num_gau)) co = 0._dp ! calculate density @@ -1916,11 +1916,11 @@ SUBROUTINE atom_fit_kgpot(atom, num_gau, num_pol, iunit, powell_section, results ! initiallize parameter ostate%nf = 0 - ostate%nvar = num_pol*num_gau+num_gau + ostate%nvar = num_pol*num_gau + num_gau DO i = 1, num_gau - co(1, i) = 0.5_dp+REAL(i-1, KIND=dp) + co(1, i) = 0.5_dp + REAL(i - 1, KIND=dp) co(2, i) = 1.0_dp - DO j = 3, num_pol+1 + DO j = 3, num_pol + 1 co(j, i) = 0.1_dp END DO END DO @@ -1975,7 +1975,7 @@ SUBROUTINE atom_fit_kgpot(atom, num_gau, num_pol, iunit, powell_section, results WRITE (iunit, '(" Optimized local potential of approximated nonadditive kinetic energy functional")') DO ig = 1, num_gau WRITE (iunit, '(I2,T15,"Gaussian polynomial expansion",T66,"Rc=",F12.4)') ig, co(1, ig) - WRITE (iunit, '(T15,"Coefficients",T33,4F12.4)') (co(1+ip, ig), ip=1, num_pol) + WRITE (iunit, '(T15,"Coefficients",T33,4F12.4)') (co(1 + ip, ig), ip=1, num_pol) END DO END IF @@ -1983,7 +1983,7 @@ SUBROUTINE atom_fit_kgpot(atom, num_gau, num_pol, iunit, powell_section, results WRITE (iw, *) ptable(atom%z)%symbol WRITE (iw, *) num_gau, num_pol DO ig = 1, num_gau - WRITE (iw, '(T10,F12.4,6X,4F12.4)') (co(ip, ig), ip=1, num_pol+1) + WRITE (iw, '(T10,F12.4,6X,4F12.4)') (co(ip, ig), ip=1, num_pol + 1) END DO CALL close_file(unit_number=iw) @@ -2024,12 +2024,12 @@ SUBROUTINE kgpot_fit(kgpot, ng, np, cval, aerr) rc = kgpot%grid%rad(i)/cval(1, ig) pc = 0.0_dp DO ip = 1, np - pc = pc+cval(ip+1, ig)*rc**(2*ip-2) + pc = pc + cval(ip + 1, ig)*rc**(2*ip - 2) END DO - pval(i) = pval(i)+pc*EXP(-0.5_dp*rc*rc) + pval(i) = pval(i) + pc*EXP(-0.5_dp*rc*rc) END DO END DO - pval(1:n) = (pval(1:n)-kgpot%op(1:n))**2 + pval(1:n) = (pval(1:n) - kgpot%op(1:n))**2 aerr = fourpi*SUM(pval(1:n)*kgpot%grid%wr(1:n)) DEALLOCATE (pval) @@ -2052,11 +2052,11 @@ SUBROUTINE getvar(xvar, cvar, np, ng) ii = 0 DO ig = 1, ng - ii = ii+1 + ii = ii + 1 cvar(1, ig) = xvar(ii) DO ip = 1, np - ii = ii+1 - cvar(ip+1, ig) = xvar(ii)**2 + ii = ii + 1 + cvar(ip + 1, ig) = xvar(ii)**2 END DO END DO @@ -2078,11 +2078,11 @@ SUBROUTINE putvar(xvar, cvar, np, ng) ii = 0 DO ig = 1, ng - ii = ii+1 + ii = ii + 1 xvar(ii) = cvar(1, ig) DO ip = 1, np - ii = ii+1 - xvar(ii) = SQRT(ABS(cvar(ip+1, ig))) + ii = ii + 1 + xvar(ii) = SQRT(ABS(cvar(ip + 1, ig))) END DO END DO diff --git a/src/atom_grb.F b/src/atom_grb.F index 235638658a..cc8c4b0dd2 100644 --- a/src/atom_grb.F +++ b/src/atom_grb.F @@ -172,7 +172,7 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw) basis%am = 0._dp DO l = 0, lmat DO i = 1, basis%nbas(l) - ll = i-1 + ll = i - 1 basis%am(i, l) = aval*cval**(ll) END DO END DO @@ -199,9 +199,9 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw) rk = basis%grid%rad(k) ear = EXP(-al*basis%grid%rad(k)**2) basis%bf(k, i, l) = rk**l*ear - basis%dbf(k, i, l) = (REAL(l, dp)*rk**(l-1)-2._dp*al*rk**(l+1))*ear - basis%ddbf(k, i, l) = (REAL(l*(l-1), dp)*rk**(l-2)- & - 2._dp*al*REAL(2*l+1, dp)*rk**(l)+4._dp*al*rk**(l+2))*ear + basis%dbf(k, i, l) = (REAL(l, dp)*rk**(l - 1) - 2._dp*al*rk**(l + 1))*ear + basis%ddbf(k, i, l) = (REAL(l*(l - 1), dp)*rk**(l - 2) - & + 2._dp*al*REAL(2*l + 1, dp)*rk**(l) + 4._dp*al*rk**(l + 2))*ear END DO END DO END DO @@ -242,7 +242,7 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw) s1 = SIZE(atom%orbitals%wfn, 1) s2 = SIZE(atom%orbitals%wfn, 2) ALLOCATE (wfn(s1, s2, 0:lmat, -nder:nder)) - s2 = MAXVAL(state%maxn_occ)+nder + s2 = MAXVAL(state%maxn_occ) + nder ALLOCATE (rbasis(s1, s2, 0:lmat), qbasis(s1, s2, 0:lmat)) rbasis = 0._dp qbasis = 0._dp @@ -263,13 +263,13 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw) DO ider = -nder, nder dene = REAL(ider, KIND=dp)*delta CPASSERT(fhomo > ABS(dene)) - state%occupation(lhomo, nhomo) = fhomo+dene + state%occupation(lhomo, nhomo) = fhomo + dene CALL calculate_atom(atom, iw=0, noguess=.TRUE.) wfn(:, :, :, ider) = atom%orbitals%wfn state%occupation(lhomo, nhomo) = fhomo END DO IF (iw > 0) THEN - WRITE (iw, '(A,T76,I5)') " Total number of electronic structure calculations ", 2*nder+1 + WRITE (iw, '(A,T76,I5)') " Total number of electronic structure calculations ", 2*nder + 1 END IF ovlp => atom%integrals%ovlp @@ -287,24 +287,24 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw) i = MAX(state%maxn_occ(l), 1) SELECT CASE (ider) CASE (1) - rbasis(:, i+1, l) = 0.5_dp*(wfn(:, i, l, 1)-wfn(:, i, l, -1))/delta + rbasis(:, i + 1, l) = 0.5_dp*(wfn(:, i, l, 1) - wfn(:, i, l, -1))/delta CASE (2) - rbasis(:, i+2, l) = 0.25_dp*(wfn(:, i, l, 2)-2._dp*wfn(:, i, l, 0)+wfn(:, i, l, -2))/delta**2 + rbasis(:, i + 2, l) = 0.25_dp*(wfn(:, i, l, 2) - 2._dp*wfn(:, i, l, 0) + wfn(:, i, l, -2))/delta**2 CASE (3) - rbasis(:, i+3, l) = 0.125_dp*(wfn(:, i, l, 3)-3._dp*wfn(:, i, l, 1) & - +3._dp*wfn(:, i, l, -1)-wfn(:, i, l, -3))/delta**3 + rbasis(:, i + 3, l) = 0.125_dp*(wfn(:, i, l, 3) - 3._dp*wfn(:, i, l, 1) & + + 3._dp*wfn(:, i, l, -1) - wfn(:, i, l, -3))/delta**3 CASE DEFAULT CPABORT("") END SELECT END DO ! orthogonalization, use gram-schmidt in order to keep the natural order (semi-core, valence, response) of the wfn. - n = state%maxn_occ(l)+nder + n = state%maxn_occ(l) + nder m = atom%basis%nbas(l) DO i = 1, n - DO j = 1, i-1 + DO j = 1, i - 1 o = DOT_PRODUCT(rbasis(1:m, j, l), RESHAPE(MATMUL(ovlp(1:m, 1:m, l), rbasis(1:m, i:i, l)), (/m/))) - rbasis(1:m, i, l) = rbasis(1:m, i, l)-o*rbasis(1:m, j, l) + rbasis(1:m, i, l) = rbasis(1:m, i, l) - o*rbasis(1:m, j, l) ENDDO o = DOT_PRODUCT(rbasis(1:m, i, l), RESHAPE(MATMUL(ovlp(1:m, 1:m, l), rbasis(1:m, i:i, l)), (/m/))) rbasis(1:m, i, l) = rbasis(1:m, i, l)/SQRT(o) @@ -314,7 +314,7 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw) ALLOCATE (amat(n, n)) amat(1:n, 1:n) = MATMUL(TRANSPOSE(rbasis(1:m, 1:n, l)), MATMUL(ovlp(1:m, 1:m, l), rbasis(1:m, 1:n, l))) DO i = 1, n - amat(i, i) = amat(i, i)-1._dp + amat(i, i) = amat(i, i) - 1._dp END DO IF (MAXVAL(ABS(amat)) > 1.e-12) THEN IF (iw > 0) WRITE (iw, '(A,G20.10)') " Orthogonality error ", MAXVAL(ABS(amat)) @@ -322,8 +322,8 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw) DEALLOCATE (amat) ! Quickstep normalization - expzet = 0.25_dp*REAL(2*l+3, dp) - prefac = SQRT(SQRT(pi)/2._dp**(l+2)*dfac(2*l+1)) + expzet = 0.25_dp*REAL(2*l + 3, dp) + prefac = SQRT(SQRT(pi)/2._dp**(l + 2)*dfac(2*l + 1)) DO i = 1, m zeta = (2._dp*atom%basis%am(i, l))**expzet qbasis(i, 1:n, l) = rbasis(i, 1:n, l)*prefac/zeta @@ -352,7 +352,7 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw) basis_vrb%nprim = basis%nprim basis_vrb%nbas = 0 DO l = 0, state%maxl_occ - basis_vrb%nbas(l) = state%maxn_occ(l)+ider + basis_vrb%nbas(l) = state%maxn_occ(l) + ider END DO m = MAXVAL(basis_vrb%nprim) n = MAXVAL(basis_vrb%nbas) @@ -382,12 +382,12 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw) rk = basis_vrb%grid%rad(k) ear = EXP(-al*basis_vrb%grid%rad(k)**2) DO j = 1, basis_vrb%nbas(l) - basis_vrb%bf(k, j, l) = basis_vrb%bf(k, j, l)+rk**l*ear*basis_vrb%cm(i, j, l) + basis_vrb%bf(k, j, l) = basis_vrb%bf(k, j, l) + rk**l*ear*basis_vrb%cm(i, j, l) basis_vrb%dbf(k, j, l) = basis_vrb%dbf(k, j, l) & - +(REAL(l, dp)*rk**(l-1)-2._dp*al*rk**(l+1))*ear*basis_vrb%cm(i, j, l) - basis_vrb%ddbf(k, j, l) = basis_vrb%ddbf(k, j, l)+ & - (REAL(l*(l-1), dp)*rk**(l-2)-2._dp*al*REAL(2*l+1, dp)*rk**(l)+ & - 4._dp*al*rk**(l+2))*ear*basis_vrb%cm(i, j, l) + + (REAL(l, dp)*rk**(l - 1) - 2._dp*al*rk**(l + 1))*ear*basis_vrb%cm(i, j, l) + basis_vrb%ddbf(k, j, l) = basis_vrb%ddbf(k, j, l) + & + (REAL(l*(l - 1), dp)*rk**(l - 2) - 2._dp*al*REAL(2*l + 1, dp)*rk**(l) + & + 4._dp*al*rk**(l + 2))*ear*basis_vrb%cm(i, j, l) END DO END DO END DO @@ -430,19 +430,19 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw) rmax = basis%grid%rad(n) DEALLOCATE (rho) ! optimize exponents - lval = maxl+1 - zval = SQRT(REAL(2*lval+2, dp))*REAL(lval+1, dp)/(2._dp*rmax) + lval = maxl + 1 + zval = SQRT(REAL(2*lval + 2, dp))*REAL(lval + 1, dp)/(2._dp*rmax) aval = atom%basis%am(1, 0) cval = 2.5_dp rconf = atom%potential%scon CALL atom_fit_pol(zval, rconf, lval, aval, cval, num_gto, iw, powell_section) ! calculate contractions DO i = 1, num_gto - alp(i) = aval*cval**(i-1) + alp(i) = aval*cval**(i - 1) END DO ALLOCATE (rho(num_gto)) - DO l = maxl+1, MIN(maxl+num_gto, 7) - zval = SQRT(REAL(2*l+2, dp))*REAL(l+1, dp)/(2._dp*rmax) + DO l = maxl + 1, MIN(maxl + num_gto, 7) + zval = SQRT(REAL(2*l + 2, dp))*REAL(l + 1, dp)/(2._dp*rmax) CALL hydrogenic(zval, rconf, l, alp, num_gto, rho, pbasis(:, :, l)) IF (iw > 0) WRITE (iw, '(T5,A,i5,T66,A,F10.4)') & " Polarization basis set contraction for lval=", l, "zval=", zval @@ -456,11 +456,11 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw) next_bas(0:lmat) = 0 IF (num_bas(1) == -1) THEN DO l = 0, maxl - next_bas(l) = maxl-l+1 + next_bas(l) = maxl - l + 1 END DO ELSE n = MIN(SIZE(num_bas, 1), 4) - next_bas(0:n-1) = num_bas(1:n) + next_bas(0:n - 1) = num_bas(1:n) END IF next_prim = 0 DO l = 0, lmat @@ -476,14 +476,14 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw) basis_vrb => vbasis(0)%basis amin = atom%basis%aval/atom%basis%cval**1.5_dp DO i = 1, n - ale(i) = amin*atom%basis%cval**(i-1) + ale(i) = amin*atom%basis%cval**(i - 1) END DO ebasis = 0._dp ALLOCATE (rho(n)) rconf = 2.0_dp*atom%potential%scon DO l = 0, lmat IF (next_bas(l) < 1) CYCLE - zval = SQRT(REAL(2*l+2, dp))*REAL(l+1, dp)/(2._dp*rmax) + zval = SQRT(REAL(2*l + 2, dp))*REAL(l + 1, dp)/(2._dp*rmax) CALL hydrogenic(zval, rconf, l, ale, n, rho, ebasis(:, :, l)) IF (iw > 0) WRITE (iw, '(T5,A,i5,T66,A,F10.4)') & " Extension basis set contraction for lval=", l, "zval=", zval @@ -507,10 +507,10 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw) basis_vrb%eps_eig = basis_ref%eps_eig basis_vrb%geometrical = .FALSE. basis_vrb%basis_type = CGTO_BASIS - basis_vrb%nprim = basis%nprim+next_prim + basis_vrb%nprim = basis%nprim + next_prim basis_vrb%nbas = 0 DO l = 0, state%maxl_occ - basis_vrb%nbas(l) = state%maxn_occ(l)+ider+next_bas(l) + basis_vrb%nbas(l) = state%maxn_occ(l) + ider + next_bas(l) END DO m = MAXVAL(basis_vrb%nprim) ALLOCATE (basis_vrb%am(m, 0:lmat)) @@ -519,7 +519,7 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw) basis_vrb%am(1:m, :) = basis%am(1:m, :) n = SIZE(ale, 1) DO l = 0, state%maxl_occ - basis_vrb%am(m+1:m+n, l) = ale(1:n) + basis_vrb%am(m + 1:m + n, l) = ale(1:n) END DO ! contractions m = MAXVAL(basis_vrb%nprim) @@ -528,9 +528,9 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw) basis_vrb%cm = 0.0_dp DO l = 0, state%maxl_occ m = basis%nprim(l) - n = state%maxn_occ(l)+ider + n = state%maxn_occ(l) + ider basis_vrb%cm(1:m, 1:n, l) = rbasis(1:m, 1:n, l) - basis_vrb%cm(m+1:m+next_prim(l), n+1:n+next_bas(l), l) = ebasis(1:next_prim(l), 1:next_bas(l), l) + basis_vrb%cm(m + 1:m + next_prim(l), n + 1:n + next_bas(l), l) = ebasis(1:next_prim(l), 1:next_bas(l), l) END DO ! initialize basis function on a radial grid @@ -549,12 +549,12 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw) rk = basis_vrb%grid%rad(k) ear = EXP(-al*basis_vrb%grid%rad(k)**2) DO j = 1, basis_vrb%nbas(l) - basis_vrb%bf(k, j, l) = basis_vrb%bf(k, j, l)+rk**l*ear*basis_vrb%cm(i, j, l) + basis_vrb%bf(k, j, l) = basis_vrb%bf(k, j, l) + rk**l*ear*basis_vrb%cm(i, j, l) basis_vrb%dbf(k, j, l) = basis_vrb%dbf(k, j, l) & - +(REAL(l, dp)*rk**(l-1)-2._dp*al*rk**(l+1))*ear*basis_vrb%cm(i, j, l) - basis_vrb%ddbf(k, j, l) = basis_vrb%ddbf(k, j, l)+ & - (REAL(l*(l-1), dp)*rk**(l-2)-2._dp*al*REAL(2*l+1, dp)*rk**(l)+ & - 4._dp*al*rk**(l+2))*ear*basis_vrb%cm(i, j, l) + + (REAL(l, dp)*rk**(l - 1) - 2._dp*al*rk**(l + 1))*ear*basis_vrb%cm(i, j, l) + basis_vrb%ddbf(k, j, l) = basis_vrb%ddbf(k, j, l) + & + (REAL(l*(l - 1), dp)*rk**(l - 2) - 2._dp*al*REAL(2*l + 1, dp)*rk**(l) + & + 4._dp*al*rk**(l + 2))*ear*basis_vrb%cm(i, j, l) END DO END DO END DO @@ -574,7 +574,7 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw) cradx = crad*1.20_dp CALL atom_basis_condnum(basis_vrb, cradx, cnum) IF (iw > 0) WRITE (iw, '(T5,A,F15.3,T50,A,F14.4)') " Lattice constant:", cradx, "Condition number:", cnum - vbasis(nder+1+ider)%basis => basis_vrb + vbasis(nder + 1 + ider)%basis => basis_vrb END DO CALL deallocate_orbital_pointers CALL deallocate_spherical_harmonics @@ -583,7 +583,7 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw) energy_ref = atom_ref%energy%etot IF (iw > 0) WRITE (iw, '(/,A,A)') " Basis set tests " IF (iw > 0) WRITE (iw, '(T10,A,T59,F22.9)') " Reference Energy [a.u.] ", energy_ref - DO ider = 0, 2*nder+1 + DO ider = 0, 2*nder + 1 ! generate an atom type NULLIFY (atom_test) CALL create_atom_type(atom_test) @@ -611,12 +611,12 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw) IF (ider <= nder) THEN energy_vb(ider) = atom_test%energy%etot IF (iw > 0) WRITE (iw, '(T10,A,i1,A,T40,F13.9,T59,F22.9)') " GRB (VB)", ider, " Energy [a.u.] ", & - energy_ref-energy_vb(ider), energy_vb(ider) + energy_ref - energy_vb(ider), energy_vb(ider) ELSE - i = ider-nder-1 + i = ider - nder - 1 energy_ex(i) = atom_test%energy%etot IF (iw > 0) WRITE (iw, '(T10,A,i1,A,T40,F13.9,T59,F22.9)') " GRB (EX)", i, " Energy [a.u.] ", & - energy_ref-energy_ex(i), energy_ex(i) + energy_ref - energy_ex(i), energy_ex(i) END IF CALL atom_int_release(atint) CALL atom_ppint_release(atint) @@ -627,8 +627,8 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw) ! Quickstep normalization polarization basis DO l = 0, 7 - expzet = 0.25_dp*REAL(2*l+3, dp) - prefac = SQRT(SQRT(pi)/2._dp**(l+2)*dfac(2*l+1)) + expzet = 0.25_dp*REAL(2*l + 3, dp) + prefac = SQRT(SQRT(pi)/2._dp**(l + 2)*dfac(2*l + 1)) DO i = 1, num_pol zeta = (2._dp*alp(i))**expzet pbasis(i, 1:num_pol, l) = pbasis(i, 1:num_pol, l)*prefac/zeta @@ -636,8 +636,8 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw) END DO ! Quickstep normalization extended basis DO l = 0, lmat - expzet = 0.25_dp*REAL(2*l+3, dp) - prefac = SQRT(SQRT(pi)/2._dp**(l+2)*dfac(2*l+1)) + expzet = 0.25_dp*REAL(2*l + 3, dp) + prefac = SQRT(SQRT(pi)/2._dp**(l + 2)*dfac(2*l + 1)) DO i = 1, next_prim(l) zeta = (2._dp*ale(i))**expzet ebasis(i, 1:next_bas(l), l) = ebasis(i, 1:next_bas(l), l)*prefac/zeta @@ -664,12 +664,12 @@ SUBROUTINE atom_grb_construction(atom_info, atom_section, iw) END DO ! polarization basis maxl = atom_ref%state%maxl_occ - DO l = maxl+1, MIN(maxl+num_pol, 7) + DO l = maxl + 1, MIN(maxl + num_pol, 7) nbas = 0 - DO i = maxl+1, l - nbas(i) = l-i+1 + DO i = maxl + 1, l + nbas(i) = l - i + 1 END DO - i = l-maxl + i = l - maxl basline(1) = "" WRITE (basline(1), "(T2,A,T5,A,I1)") ADJUSTL(ptable(atom_ref%z)%symbol), TRIM(ADJUSTL(basname))//"-POL-", i CALL grb_print_basis(header=basline, nprim=num_pol, nbas=nbas, al=alp, gcc=pbasis, iunit=iunit) @@ -798,34 +798,34 @@ SUBROUTINE basis_label(label, np, nb) label(i:i) = "(" DO l = 0, lmax IF (np(l) > 0) THEN - i = i+1 + i = i + 1 IF (np(l) > 9) THEN - WRITE (label(i:i+1), "(I2)") np(l) - i = i+2 + WRITE (label(i:i + 1), "(I2)") np(l) + i = i + 2 ELSE WRITE (label(i:i), "(I1)") np(l) - i = i+1 + i = i + 1 END IF label(i:i) = lq(l) END IF END DO - i = i+1 - label(i:i+6) = ") --> [" - i = i+6 + i = i + 1 + label(i:i + 6) = ") --> [" + i = i + 6 DO l = 0, lmax IF (nb(l) > 0) THEN - i = i+1 + i = i + 1 IF (nb(l) > 9) THEN - WRITE (label(i:i+1), "(I2)") nb(l) - i = i+2 + WRITE (label(i:i + 1), "(I2)") nb(l) + i = i + 2 ELSE WRITE (label(i:i), "(I1)") nb(l) - i = i+1 + i = i + 1 END IF label(i:i) = lq(l) END IF END DO - i = i+1 + i = i + 1 label(i:i) = "]" END SUBROUTINE basis_label @@ -990,7 +990,7 @@ SUBROUTINE atom_fit_grb(atom, basis, iunit, powell_section) basis%am = 0._dp DO l = 0, lmat DO i = 1, basis%nbas(l) - ll = i-1+basis%start(l) + ll = i - 1 + basis%start(l) basis%am(i, l) = x(1)*x(1)*(x(2)*x(2))**(ll) END DO END DO @@ -1007,9 +1007,9 @@ SUBROUTINE atom_fit_grb(atom, basis, iunit, powell_section) rk = basis%grid%rad(k) ear = EXP(-al*basis%grid%rad(k)**2) basis%bf(k, i, l) = rk**l*ear - basis%dbf(k, i, l) = (REAL(l, dp)*rk**(l-1)-2._dp*al*rk**(l+1))*ear - basis%ddbf(k, i, l) = (REAL(l*(l-1), dp)*rk**(l-2)- & - 2._dp*al*REAL(2*l+1, dp)*rk**(l)+4._dp*al*rk**(l+2))*ear + basis%dbf(k, i, l) = (REAL(l, dp)*rk**(l - 1) - 2._dp*al*rk**(l + 1))*ear + basis%ddbf(k, i, l) = (REAL(l*(l - 1), dp)*rk**(l - 2) - & + 2._dp*al*REAL(2*l + 1, dp)*rk**(l) + 4._dp*al*rk**(l + 2))*ear END DO END DO END DO @@ -1042,7 +1042,7 @@ SUBROUTINE atom_fit_grb(atom, basis, iunit, powell_section) basis%am = 0._dp DO l = 0, lmat DO i = 1, basis%nbas(l) - ll = i-1+basis%start(l) + ll = i - 1 + basis%start(l) basis%am(i, l) = x(1)*x(1)*(x(2)*x(2))**(ll) END DO END DO @@ -1059,9 +1059,9 @@ SUBROUTINE atom_fit_grb(atom, basis, iunit, powell_section) rk = basis%grid%rad(k) ear = EXP(-al*basis%grid%rad(k)**2) basis%bf(k, i, l) = rk**l*ear - basis%dbf(k, i, l) = (REAL(l, dp)*rk**(l-1)-2._dp*al*rk**(l+1))*ear - basis%ddbf(k, i, l) = (REAL(l*(l-1), dp)*rk**(l-2)- & - 2._dp*al*REAL(2*l+1, dp)*rk**(l)+4._dp*al*rk**(l+2))*ear + basis%dbf(k, i, l) = (REAL(l, dp)*rk**(l - 1) - 2._dp*al*rk**(l + 1))*ear + basis%ddbf(k, i, l) = (REAL(l*(l - 1), dp)*rk**(l - 2) - & + 2._dp*al*REAL(2*l + 1, dp)*rk**(l) + 4._dp*al*rk**(l + 2))*ear END DO END DO END DO @@ -1153,7 +1153,7 @@ SUBROUTINE atom_fit_pol(zval, rconf, lval, aval, cval, nbas, iunit, powell_secti aval = x(1)*x(1) cval = x(2)*x(2) DO i = 1, nbas - am(i) = aval*cval**(i-1) + am(i) = aval*cval**(i - 1) END DO CALL hydrogenic(zval, rconf, lval, am, nbas, ener, orb) ostate%f = ener(1) @@ -1237,7 +1237,7 @@ SUBROUTINE hydrogenic(zval, rconf, lval, am, nbas, ener, orb) k = 10 CALL sg_conf(confmat, rconf, k, lval, am(1:n), am(1:n)) ! Hamiltionian - hmat(1:n, 1:n) = tmat(1:n, 1:n)-zval*potmat(1:n, 1:n)+cf*confmat(1:n, 1:n) + hmat(1:n, 1:n) = tmat(1:n, 1:n) - zval*potmat(1:n, 1:n) + cf*confmat(1:n, 1:n) ! solve lwork = 100*n ALLOCATE (w(n), work(lwork)) diff --git a/src/atom_kind_orbitals.F b/src/atom_kind_orbitals.F index e24fe1b65b..79c9639601 100644 --- a/src/atom_kind_orbitals.F +++ b/src/atom_kind_orbitals.F @@ -226,12 +226,12 @@ SUBROUTINE calculate_atomic_orbitals(atomic_kind, qs_kind, agrid, iunit, pmat, f basis%nbas = 0 DO i = 1, nset DO j = lmin(i), MIN(lmax(i), lmat) - basis%nprim(j) = basis%nprim(j)+npgf(i) + basis%nprim(j) = basis%nprim(j) + npgf(i) END DO DO j = 1, nshell(i) l = ls(j, i) IF (l <= lmat) THEN - basis%nbas(l) = basis%nbas(l)+1 + basis%nbas(l) = basis%nbas(l) + 1 k = basis%nbas(l) CPASSERT(k <= 100) set_index(l, k) = i @@ -252,17 +252,17 @@ SUBROUTINE calculate_atomic_orbitals(atomic_kind, qs_kind, agrid, iunit, pmat, f DO i = 1, nset IF (j >= lmin(i) .AND. j <= lmax(i)) THEN DO ipgf = 1, npgf(i) - basis%am(nj+ipgf, j) = zet(ipgf, i) + basis%am(nj + ipgf, j) = zet(ipgf, i) END DO DO ii = 1, nshell(i) IF (ls(ii, i) == j) THEN - ns = ns+1 + ns = ns + 1 DO ipgf = 1, npgf(i) - basis%cm(nj+ipgf, ns, j) = gcc(ipgf, ii, i) + basis%cm(nj + ipgf, ns, j) = gcc(ipgf, ii, i) END DO END IF END DO - nj = nj+npgf(i) + nj = nj + npgf(i) END IF END DO END DO @@ -306,21 +306,21 @@ SUBROUTINE calculate_atomic_orbitals(atomic_kind, qs_kind, agrid, iunit, pmat, f rk = basis%grid%rad(k) ear = EXP(-al*basis%grid%rad(k)**2) basis%bf(k, i, l) = rk**l*ear - basis%dbf(k, i, l) = (REAL(l, dp)*rk**(l-1)-2._dp*al*rk**(l+1))*ear - basis%ddbf(k, i, l) = (REAL(l*(l-1), dp)*rk**(l-2)- & - 2._dp*al*REAL(2*l+1, dp)*rk**(l)+4._dp*al*rk**(l+2))*ear + basis%dbf(k, i, l) = (REAL(l, dp)*rk**(l - 1) - 2._dp*al*rk**(l + 1))*ear + basis%ddbf(k, i, l) = (REAL(l*(l - 1), dp)*rk**(l - 2) - & + 2._dp*al*REAL(2*l + 1, dp)*rk**(l) + 4._dp*al*rk**(l + 2))*ear END DO ELSEIF (basis%basis_type == CGTO_BASIS) THEN DO k = 1, nr rk = basis%grid%rad(k) ear = EXP(-al*basis%grid%rad(k)**2) DO j = 1, basis%nbas(l) - basis%bf(k, j, l) = basis%bf(k, j, l)+rk**l*ear*basis%cm(i, j, l) + basis%bf(k, j, l) = basis%bf(k, j, l) + rk**l*ear*basis%cm(i, j, l) basis%dbf(k, j, l) = basis%dbf(k, j, l) & - +(REAL(l, dp)*rk**(l-1)-2._dp*al*rk**(l+1))*ear*basis%cm(i, j, l) - basis%ddbf(k, j, l) = basis%ddbf(k, j, l)+ & - (REAL(l*(l-1), dp)*rk**(l-2)-2._dp*al*REAL(2*l+1, dp)*rk**(l)+ & - 4._dp*al*rk**(l+2))*ear*basis%cm(i, j, l) + + (REAL(l, dp)*rk**(l - 1) - 2._dp*al*rk**(l + 1))*ear*basis%cm(i, j, l) + basis%ddbf(k, j, l) = basis%ddbf(k, j, l) + & + (REAL(l*(l - 1), dp)*rk**(l - 2) - 2._dp*al*REAL(2*l + 1, dp)*rk**(l) + & + 4._dp*al*rk**(l + 2))*ear*basis%cm(i, j, l) END DO END DO ELSE @@ -361,8 +361,8 @@ SUBROUTINE calculate_atomic_orbitals(atomic_kind, qs_kind, agrid, iunit, pmat, f atom%state%core(0:lmat, 1:7) = REAL(ncore(0:lmat, 1:7), dp) atom%state%occ = 0._dp IF (uks) THEN - atom%state%occ(0:lmat, 1:7) = REAL(ncalc(0:lmat, 1:7), dp)+ & - edelta(0:lmat, 1:7, 1)+edelta(0:lmat, 1:7, 2) + atom%state%occ(0:lmat, 1:7) = REAL(ncalc(0:lmat, 1:7), dp) + & + edelta(0:lmat, 1:7, 1) + edelta(0:lmat, 1:7, 2) ELSE atom%state%occ(0:lmat, 1:7) = REAL(ncalc(0:lmat, 1:7), dp) END IF @@ -371,24 +371,24 @@ SUBROUTINE calculate_atomic_orbitals(atomic_kind, qs_kind, agrid, iunit, pmat, f k = 0 DO i = 1, 7 IF (ncalc(l, i) > 0) THEN - k = k+1 + k = k + 1 IF (uks) THEN - atom%state%occupation(l, k) = REAL(ncalc(l, i), dp)+ & - edelta(l, i, 1)+edelta(l, i, 2) - atom%state%occa(l, k) = 0.5_dp*REAL(ncalc(l, i), dp)+edelta(l, i, 1) - atom%state%occb(l, k) = 0.5_dp*REAL(ncalc(l, i), dp)+edelta(l, i, 2) + atom%state%occupation(l, k) = REAL(ncalc(l, i), dp) + & + edelta(l, i, 1) + edelta(l, i, 2) + atom%state%occa(l, k) = 0.5_dp*REAL(ncalc(l, i), dp) + edelta(l, i, 1) + atom%state%occb(l, k) = 0.5_dp*REAL(ncalc(l, i), dp) + edelta(l, i, 2) ELSE atom%state%occupation(l, k) = REAL(ncalc(l, i), dp) END IF END IF END DO - ok = REAL(2*l+1, KIND=dp) + ok = REAL(2*l + 1, KIND=dp) IF (uks) THEN DO i = 1, 7 atom%state%occ(l, i) = MIN(atom%state%occ(l, i), 2.0_dp*ok) atom%state%occa(l, i) = MIN(atom%state%occa(l, i), ok) atom%state%occb(l, i) = MIN(atom%state%occb(l, i), ok) - atom%state%occupation(l, i) = atom%state%occa(l, i)+atom%state%occb(l, i) + atom%state%occupation(l, i) = atom%state%occa(l, i) + atom%state%occb(l, i) END DO ELSE DO i = 1, 7 @@ -398,7 +398,7 @@ SUBROUTINE calculate_atomic_orbitals(atomic_kind, qs_kind, agrid, iunit, pmat, f END IF END DO IF (uks) THEN - atom%state%multiplicity = NINT(ABS(SUM(atom%state%occa-atom%state%occb))+1) + atom%state%multiplicity = NINT(ABS(SUM(atom%state%occa - atom%state%occb)) + 1) ELSE atom%state%multiplicity = -1 END IF @@ -415,15 +415,15 @@ SUBROUTINE calculate_atomic_orbitals(atomic_kind, qs_kind, agrid, iunit, pmat, f DO k = 1, 7 IF (uks) THEN IF (atom%state%occa(l, k) > 0.0_dp) THEN - nocc(1) = nocc(1)+2*l+1 + nocc(1) = nocc(1) + 2*l + 1 END IF IF (atom%state%occb(l, k) > 0.0_dp) THEN - nocc(2) = nocc(2)+2*l+1 + nocc(2) = nocc(2) + 2*l + 1 END IF ELSE IF (atom%state%occupation(l, k) > 0.0_dp) THEN - nocc(1) = nocc(1)+2*l+1 - nocc(2) = nocc(2)+2*l+1 + nocc(1) = nocc(1) + 2*l + 1 + nocc(2) = nocc(2) + 2*l + 1 END IF END IF END DO @@ -465,25 +465,25 @@ SUBROUTINE calculate_atomic_orbitals(atomic_kind, qs_kind, agrid, iunit, pmat, f ll = 2*l DO k1 = 1, atom%basis%nbas(l) DO k2 = 1, atom%basis%nbas(l) - scal = SQRT(atom%integrals%ovlp(k1, k1, l)*atom%integrals%ovlp(k2, k2, l))/REAL(2*l+1, KIND=dp) + scal = SQRT(atom%integrals%ovlp(k1, k1, l)*atom%integrals%ovlp(k2, k2, l))/REAL(2*l + 1, KIND=dp) i = first_sgf(shell_index(l, k1), set_index(l, k1)) j = first_sgf(shell_index(l, k2), set_index(l, k2)) IF (uks) THEN DO m = 0, ll - pmat(i+m, j+m, 1) = atom%orbitals%pmata(k1, k2, l)*scal - pmat(i+m, j+m, 2) = atom%orbitals%pmatb(k1, k2, l)*scal + pmat(i + m, j + m, 1) = atom%orbitals%pmata(k1, k2, l)*scal + pmat(i + m, j + m, 2) = atom%orbitals%pmatb(k1, k2, l)*scal END DO ELSE DO m = 0, ll - pmat(i+m, j+m, 1) = atom%orbitals%pmat(k1, k2, l)*scal + pmat(i + m, j + m, 1) = atom%orbitals%pmat(k1, k2, l)*scal END DO END IF END DO END DO ENDDO IF (uks) THEN - pmat(:, :, 1) = pmat(:, :, 1)+pmat(:, :, 2) - pmat(:, :, 2) = pmat(:, :, 1)-2.0_dp*pmat(:, :, 2) + pmat(:, :, 1) = pmat(:, :, 1) + pmat(:, :, 2) + pmat(:, :, 2) = pmat(:, :, 1) - 2.0_dp*pmat(:, :, 2) END IF END IF @@ -503,7 +503,7 @@ SUBROUTINE calculate_atomic_orbitals(atomic_kind, qs_kind, agrid, iunit, pmat, f i = first_sgf(shell_index(l, k1), set_index(l, k1)) j = first_sgf(shell_index(l, k2), set_index(l, k2)) DO m = 0, ll - fmat(i+m, j+m, 1) = atom%fmat%op(k1, k2, l)/scal + fmat(i + m, j + m, 1) = atom%fmat%op(k1, k2, l)/scal END DO END DO END DO @@ -527,11 +527,11 @@ SUBROUTINE calculate_atomic_orbitals(atomic_kind, qs_kind, agrid, iunit, pmat, f DO l = 0, lmat DO i = 1, atom%state%maxn_occ(l) IF (atom%state%occupation(l, i) > 0.0_dp) THEN - ii = ii+1 + ii = ii + 1 wfninfo(1, ii) = atom%state%occupation(l, i) wfninfo(2, ii) = REAL(l, dp) DO j = 1, atom%basis%nbas(l) - wavefunction(:, ii) = wavefunction(:, ii)+ & + wavefunction(:, ii) = wavefunction(:, ii) + & atom%orbitals%wfn(j, i, l)*basis%bf(:, j, l) END DO END IF @@ -679,7 +679,7 @@ SUBROUTINE calculate_atomic_density(density, atomic_kind, qs_kind, ngto, iunit, basis%am = 0._dp DO l = 0, lmat DO i = 1, basis%nbas(l) - ll = i-1+starti(l) + ll = i - 1 + starti(l) basis%am(i, l) = aval*cval**(ll) END DO END DO @@ -705,9 +705,9 @@ SUBROUTINE calculate_atomic_density(density, atomic_kind, qs_kind, ngto, iunit, rk = basis%grid%rad(k) ear = EXP(-al*basis%grid%rad(k)**2) basis%bf(k, i, l) = rk**l*ear - basis%dbf(k, i, l) = (REAL(l, dp)*rk**(l-1)-2._dp*al*rk**(l+1))*ear - basis%ddbf(k, i, l) = (REAL(l*(l-1), dp)*rk**(l-2)- & - 2._dp*al*REAL(2*l+1, dp)*rk**(l)+4._dp*al*rk**(l+2))*ear + basis%dbf(k, i, l) = (REAL(l, dp)*rk**(l - 1) - 2._dp*al*rk**(l + 1))*ear + basis%ddbf(k, i, l) = (REAL(l*(l - 1), dp)*rk**(l - 2) - & + 2._dp*al*REAL(2*l + 1, dp)*rk**(l) + 4._dp*al*rk**(l + 2))*ear END DO END DO END DO @@ -732,21 +732,21 @@ SUBROUTINE calculate_atomic_density(density, atomic_kind, qs_kind, ngto, iunit, CALL set_pseudo_state(econf, z, ncalc, ncore, nelem) ELSE DO l = 0, MIN(lmat, UBOUND(ptable(z)%e_conv, 1)) - ll = 2*(2*l+1) + ll = 2*(2*l + 1) nn = ptable(z)%e_conv(l) ii = 0 DO - ii = ii+1 + ii = ii + 1 IF (nn <= ll) THEN nelem(l, ii) = nn EXIT ELSE nelem(l, ii) = ll - nn = nn-ll + nn = nn - ll END IF END DO END DO - ncalc = nelem-ncore + ncalc = nelem - ncore END IF IF (qs_kind%ghost .OR. qs_kind%floating) THEN @@ -767,7 +767,7 @@ SUBROUTINE calculate_atomic_density(density, atomic_kind, qs_kind, ngto, iunit, k = 0 DO i = 1, 7 IF (ncalc(l, i) > 0) THEN - k = k+1 + k = k + 1 atom%state%occupation(l, k) = REAL(ncalc(l, i), dp) END IF END DO @@ -808,7 +808,7 @@ SUBROUTINE calculate_atomic_density(density, atomic_kind, qs_kind, ngto, iunit, cc = results(2) DO i = 1, ngto density(i, 1) = xx*cc**i - density(i, 2) = results(2+i) + density(i, 2) = results(2 + i) END DO ! clean up @@ -942,12 +942,12 @@ SUBROUTINE calculate_atomic_relkin(atomic_kind, qs_kind, rel_control, rtmat) basis%nbas = 0 DO i = 1, nset DO j = lmin(i), MIN(lmax(i), lmat) - basis%nprim(j) = basis%nprim(j)+npgf(i) + basis%nprim(j) = basis%nprim(j) + npgf(i) END DO DO j = 1, nshell(i) l = ls(j, i) IF (l <= lmat) THEN - basis%nbas(l) = basis%nbas(l)+1 + basis%nbas(l) = basis%nbas(l) + 1 k = basis%nbas(l) CPASSERT(k <= 100) set_index(l, k) = i @@ -968,17 +968,17 @@ SUBROUTINE calculate_atomic_relkin(atomic_kind, qs_kind, rel_control, rtmat) DO i = 1, nset IF (j >= lmin(i) .AND. j <= lmax(i)) THEN DO ipgf = 1, npgf(i) - basis%am(nj+ipgf, j) = zet(ipgf, i) + basis%am(nj + ipgf, j) = zet(ipgf, i) END DO DO ii = 1, nshell(i) IF (ls(ii, i) == j) THEN - ns = ns+1 + ns = ns + 1 DO ipgf = 1, npgf(i) - basis%cm(nj+ipgf, ns, j) = gcc(ipgf, ii, i) + basis%cm(nj + ipgf, ns, j) = gcc(ipgf, ii, i) END DO END IF END DO - nj = nj+npgf(i) + nj = nj + npgf(i) END IF END DO END DO @@ -986,7 +986,7 @@ SUBROUTINE calculate_atomic_relkin(atomic_kind, qs_kind, rel_control, rtmat) ! Normalization as used in the atomic code ! We have to undo the Quickstep normalization DO j = 0, lmat - prefac = 2.0_dp*SQRT(pi/dfac(2*j+1)) + prefac = 2.0_dp*SQRT(pi/dfac(2*j + 1)) DO ipgf = 1, basis%nprim(j) DO ii = 1, basis%nbas(j) basis%cm(ipgf, ii, j) = prefac*basis%cm(ipgf, ii, j) @@ -1011,12 +1011,12 @@ SUBROUTINE calculate_atomic_relkin(atomic_kind, qs_kind, rel_control, rtmat) rk = basis%grid%rad(k) ear = EXP(-al*basis%grid%rad(k)**2) DO j = 1, basis%nbas(l) - basis%bf(k, j, l) = basis%bf(k, j, l)+rk**l*ear*basis%cm(i, j, l) + basis%bf(k, j, l) = basis%bf(k, j, l) + rk**l*ear*basis%cm(i, j, l) basis%dbf(k, j, l) = basis%dbf(k, j, l) & - +(REAL(l, dp)*rk**(l-1)-2._dp*al*rk**(l+1))*ear*basis%cm(i, j, l) - basis%ddbf(k, j, l) = basis%ddbf(k, j, l)+ & - (REAL(l*(l-1), dp)*rk**(l-2)-2._dp*al*REAL(2*l+1, dp)* & - rk**(l)+4._dp*al*rk**(l+2))*ear*basis%cm(i, j, l) + + (REAL(l, dp)*rk**(l - 1) - 2._dp*al*rk**(l + 1))*ear*basis%cm(i, j, l) + basis%ddbf(k, j, l) = basis%ddbf(k, j, l) + & + (REAL(l*(l - 1), dp)*rk**(l - 2) - 2._dp*al*REAL(2*l + 1, dp)* & + rk**(l) + 4._dp*al*rk**(l + 2))*ear*basis%cm(i, j, l) END DO END DO END DO @@ -1036,21 +1036,21 @@ SUBROUTINE calculate_atomic_relkin(atomic_kind, qs_kind, rel_control, rtmat) ncore = 0 ncalc = 0 DO l = 0, MIN(lmat, UBOUND(ptable(z)%e_conv, 1)) - ll = 2*(2*l+1) + ll = 2*(2*l + 1) nn = ptable(z)%e_conv(l) ii = 0 DO - ii = ii+1 + ii = ii + 1 IF (nn <= ll) THEN nelem(l, ii) = nn EXIT ELSE nelem(l, ii) = ll - nn = nn-ll + nn = nn - ll END IF END DO END DO - ncalc = nelem-ncore + ncalc = nelem - ncore IF (qs_kind%ghost .OR. qs_kind%floating) THEN nelem = 0 @@ -1070,7 +1070,7 @@ SUBROUTINE calculate_atomic_relkin(atomic_kind, qs_kind, rel_control, rtmat) k = 0 DO i = 1, 7 IF (ncalc(l, i) > 0) THEN - k = k+1 + k = k + 1 atom%state%occupation(l, k) = REAL(ncalc(l, i), dp) END IF END DO @@ -1123,12 +1123,12 @@ SUBROUTINE calculate_atomic_relkin(atomic_kind, qs_kind, rel_control, rtmat) CPABORT("") CASE (do_zoramp_atom, do_sczoramp_atom) DO m = 0, ll - rtmat(i+m, j+m) = integrals%tzora(k1, k2, l) + rtmat(i + m, j + m) = integrals%tzora(k1, k2, l) END DO CASE (do_dkh0_atom, do_dkh1_atom, do_dkh2_atom, do_dkh3_atom) DO m = 0, ll - rtmat(i+m, j+m) = integrals%hdkh(k1, k2, l)-integrals%kin(k1, k2, l)+ & - atom%zcore*integrals%core(k1, k2, l) + rtmat(i + m, j + m) = integrals%hdkh(k1, k2, l) - integrals%kin(k1, k2, l) + & + atom%zcore*integrals%core(k1, k2, l) END DO END SELECT END DO @@ -1136,7 +1136,7 @@ SUBROUTINE calculate_atomic_relkin(atomic_kind, qs_kind, rel_control, rtmat) ENDDO DO k1 = 1, nsgf DO k2 = k1, nsgf - rtmat(k1, k2) = 0.5_dp*(rtmat(k1, k2)+rtmat(k2, k1)) + rtmat(k1, k2) = 0.5_dp*(rtmat(k1, k2) + rtmat(k2, k1)) rtmat(k2, k1) = rtmat(k1, k2) END DO END DO @@ -1201,7 +1201,7 @@ SUBROUTINE gth_potential_conversion(gth_potential, gth_atompot) gth_atompot%cl(:) = 0._dp IF (ac > 0._dp) THEN DO i = 1, ne - gth_atompot%cl(i) = ce(i)/(2._dp*ac)**(i-1) + gth_atompot%cl(i) = ce(i)/(2._dp*ac)**(i - 1) END DO END IF !extended type @@ -1228,7 +1228,7 @@ SUBROUTINE gth_potential_conversion(gth_potential, gth_atompot) DO j = 1, nexp_lpot ac = alpha_lpot(j) DO i = 1, 4 - gth_atompot%cval_lpot(i, j) = cval_lpot(i, j)/(2._dp*ac)**(i-1) + gth_atompot%cval_lpot(i, j) = cval_lpot(i, j)/(2._dp*ac)**(i - 1) END DO END DO END IF @@ -1245,7 +1245,7 @@ SUBROUTINE gth_potential_conversion(gth_potential, gth_atompot) DO j = 1, nexp_lpot ac = alpha_lsd(j) DO i = 1, 4 - gth_atompot%cval_lsd(i, j) = cval_lsd(i, j)/(2._dp*ac)**(i-1) + gth_atompot%cval_lsd(i, j) = cval_lsd(i, j)/(2._dp*ac)**(i - 1) END DO END DO END IF diff --git a/src/atom_operators.F b/src/atom_operators.F index 8c39c29b9b..dd8dfadf3f 100644 --- a/src/atom_operators.F +++ b/src/atom_operators.F @@ -122,15 +122,15 @@ SUBROUTINE atom_int_setup(integrals, basis, potential, & ELSEIF (potential%conf_type == barrier_conf) THEN om = potential%rcon ron = potential%scon - rc = ron+om + rc = ron + om DO i = 1, m IF (basis%grid%rad(i) < ron) THEN cpot(i) = 0.0_dp ELSEIF (basis%grid%rad(i) < rc) THEN - x = (basis%grid%rad(i)-ron)/om - x = 1._dp-x - cpot(i) = -6._dp*x**5+15._dp*x**4-10._dp*x**3+1._dp - x = (rc-basis%grid%rad(i))**2/om/(basis%grid%rad(i)-ron) + x = (basis%grid%rad(i) - ron)/om + x = 1._dp - x + cpot(i) = -6._dp*x**5 + 15._dp*x**4 - 10._dp*x**3 + 1._dp + x = (rc - basis%grid%rad(i))**2/om/(basis%grid%rad(i) - ron) cpot(i) = cpot(i)*x ELSE cpot(i) = 1.0_dp @@ -157,17 +157,17 @@ SUBROUTINE atom_int_setup(integrals, basis, potential, & ll = 0 DO l1 = 0, lmat n1 = integrals%n(l1) - nn1 = (n1*(n1+1))/2 + nn1 = (n1*(n1 + 1))/2 DO l2 = 0, l1 n2 = integrals%n(l2) - nn2 = (n2*(n2+1))/2 + nn2 = (n2*(n2 + 1))/2 IF (integrals%all_nu) THEN nx = MIN(2*l1, 2*l2) ELSE nx = 0 END IF DO nu = 0, nx, 2 - ll = ll+1 + ll = ll + 1 CPASSERT(ll <= SIZE(integrals%ceri)) ALLOCATE (integrals%ceri(ll)%int(nn1, nn2)) integrals%ceri(ll)%int = 0._dp @@ -181,12 +181,12 @@ SUBROUTINE atom_int_setup(integrals, basis, potential, & ll = 0 DO l1 = 0, lmat n1 = integrals%n(l1) - nn1 = (n1*(n1+1))/2 + nn1 = (n1*(n1 + 1))/2 DO l2 = 0, l1 n2 = integrals%n(l2) - nn2 = (n2*(n2+1))/2 - DO nu = ABS(l1-l2), l1+l2, 2 - ll = ll+1 + nn2 = (n2*(n2 + 1))/2 + DO nu = ABS(l1 - l2), l1 + l2, 2 + ll = ll + 1 CPASSERT(ll <= SIZE(integrals%eeri)) ALLOCATE (integrals%eeri(ll)%int(nn1, nn2)) integrals%eeri(ll)%int = 0._dp @@ -214,21 +214,21 @@ SUBROUTINE atom_int_setup(integrals, basis, potential, & ll = 0 DO l1 = 0, lmat n1 = integrals%n(l1) - nn1 = (n1*(n1+1))/2 + nn1 = (n1*(n1 + 1))/2 m1 = basis%nprim(l1) - mm1 = (m1*(m1+1))/2 + mm1 = (m1*(m1 + 1))/2 DO l2 = 0, l1 n2 = integrals%n(l2) - nn2 = (n2*(n2+1))/2 + nn2 = (n2*(n2 + 1))/2 m2 = basis%nprim(l2) - mm2 = (m2*(m2+1))/2 + mm2 = (m2*(m2 + 1))/2 IF (integrals%all_nu) THEN nx = MIN(2*l1, 2*l2) ELSE nx = 0 END IF DO nu = 0, nx, 2 - ll = ll+1 + ll = ll + 1 CPASSERT(ll <= SIZE(integrals%ceri)) ALLOCATE (integrals%ceri(ll)%int(nn1, nn2)) integrals%ceri(ll)%int = 0._dp @@ -247,16 +247,16 @@ SUBROUTINE atom_int_setup(integrals, basis, potential, & ll = 0 DO l1 = 0, lmat n1 = integrals%n(l1) - nn1 = (n1*(n1+1))/2 + nn1 = (n1*(n1 + 1))/2 m1 = basis%nprim(l1) - mm1 = (m1*(m1+1))/2 + mm1 = (m1*(m1 + 1))/2 DO l2 = 0, l1 n2 = integrals%n(l2) - nn2 = (n2*(n2+1))/2 + nn2 = (n2*(n2 + 1))/2 m2 = basis%nprim(l2) - mm2 = (m2*(m2+1))/2 - DO nu = ABS(l1-l2), l1+l2, 2 - ll = ll+1 + mm2 = (m2*(m2 + 1))/2 + DO nu = ABS(l1 - l2), l1 + l2, 2 + ll = ll + 1 CPASSERT(ll <= SIZE(integrals%eeri)) ALLOCATE (integrals%eeri(ll)%int(nn1, nn2)) integrals%eeri(ll)%int = 0._dp @@ -303,7 +303,7 @@ SUBROUTINE atom_int_setup(integrals, basis, potential, & ii = 0 DO i = 1, n IF (w(i) > basis%eps_eig) THEN - ii = ii+1 + ii = ii + 1 integrals%utrans(1:n, ii, l) = omat(1:n, i)/SQRT(w(i)) END IF END DO @@ -387,17 +387,17 @@ SUBROUTINE atom_ppint_setup(integrals, basis, potential) integrals%core(1:n, 1:n, l) = -potential%gth_pot%zion*omat(1:n, 1:n) DO i = 1, potential%gth_pot%ncl omat = 0._dp - CALL sg_gpot(omat(1:n, 1:n), i-1, potential%gth_pot%rc, l, basis%am(1:n, l), basis%am(1:n, l)) - integrals%core(1:n, 1:n, l) = integrals%core(1:n, 1:n, l)+ & + CALL sg_gpot(omat(1:n, 1:n), i - 1, potential%gth_pot%rc, l, basis%am(1:n, l), basis%am(1:n, l)) + integrals%core(1:n, 1:n, l) = integrals%core(1:n, 1:n, l) + & potential%gth_pot%cl(i)*omat(1:n, 1:n) END DO IF (potential%gth_pot%lpotextended) THEN DO k = 1, potential%gth_pot%nexp_lpot DO i = 1, potential%gth_pot%nct_lpot(k) omat = 0._dp - CALL sg_gpot(omat(1:n, 1:n), i-1, potential%gth_pot%alpha_lpot(k), l, & + CALL sg_gpot(omat(1:n, 1:n), i - 1, potential%gth_pot%alpha_lpot(k), l, & basis%am(1:n, l), basis%am(1:n, l)) - integrals%core(1:n, 1:n, l) = integrals%core(1:n, 1:n, l)+ & + integrals%core(1:n, 1:n, l) = integrals%core(1:n, 1:n, l) + & potential%gth_pot%cval_lpot(i, k)*omat(1:n, 1:n) END DO END DO @@ -406,9 +406,9 @@ SUBROUTINE atom_ppint_setup(integrals, basis, potential) DO k = 1, potential%gth_pot%nexp_lsd DO i = 1, potential%gth_pot%nct_lsd(k) omat = 0._dp - CALL sg_gpot(omat(1:n, 1:n), i-1, potential%gth_pot%alpha_lsd(k), l, & + CALL sg_gpot(omat(1:n, 1:n), i - 1, potential%gth_pot%alpha_lsd(k), l, & basis%am(1:n, l), basis%am(1:n, l)) - integrals%clsd(1:n, 1:n, l) = integrals%clsd(1:n, 1:n, l)+ & + integrals%clsd(1:n, 1:n, l) = integrals%clsd(1:n, 1:n, l) + & potential%gth_pot%cval_lsd(i, k)*omat(1:n, 1:n) END DO END DO @@ -417,7 +417,7 @@ SUBROUTINE atom_ppint_setup(integrals, basis, potential) spmat = 0._dp m = potential%gth_pot%nl(l) DO i = 1, m - CALL sg_proj_ol(spmat(1:n, i), l, basis%am(1:n, l), i-1, potential%gth_pot%rcnl(l)) + CALL sg_proj_ol(spmat(1:n, i), l, basis%am(1:n, l), i - 1, potential%gth_pot%rcnl(l)) END DO integrals%hnl(1:n, 1:n, l) = MATMUL(spmat(1:n, 1:m), & MATMUL(potential%gth_pot%hnl(1:m, 1:m, l), TRANSPOSE(spmat(1:n, 1:m)))) @@ -460,7 +460,7 @@ SUBROUTINE atom_ppint_setup(integrals, basis, potential) CALL contract2(integrals%core(1:n, 1:n, l), omat(1:m, 1:m), basis%cm(1:m, 1:n, l)) DO i = 1, potential%gth_pot%ncl omat = 0._dp - CALL sg_gpot(omat(1:m, 1:m), i-1, potential%gth_pot%rc, l, basis%am(1:m, l), basis%am(1:m, l)) + CALL sg_gpot(omat(1:m, 1:m), i - 1, potential%gth_pot%rc, l, basis%am(1:m, l), basis%am(1:m, l)) omat(1:m, 1:m) = potential%gth_pot%cl(i)*omat(1:m, 1:m) CALL contract2add(integrals%core(1:n, 1:n, l), omat(1:m, 1:m), basis%cm(1:m, 1:n, l)) END DO @@ -468,7 +468,7 @@ SUBROUTINE atom_ppint_setup(integrals, basis, potential) DO k = 1, potential%gth_pot%nexp_lpot DO i = 1, potential%gth_pot%nct_lpot(k) omat = 0._dp - CALL sg_gpot(omat(1:m, 1:m), i-1, potential%gth_pot%alpha_lpot(k), l, & + CALL sg_gpot(omat(1:m, 1:m), i - 1, potential%gth_pot%alpha_lpot(k), l, & basis%am(1:m, l), basis%am(1:m, l)) omat(1:m, 1:m) = potential%gth_pot%cval_lpot(i, k)*omat(1:m, 1:m) CALL contract2add(integrals%core(1:n, 1:n, l), omat(1:m, 1:m), basis%cm(1:m, 1:n, l)) @@ -479,7 +479,7 @@ SUBROUTINE atom_ppint_setup(integrals, basis, potential) DO k = 1, potential%gth_pot%nexp_lsd DO i = 1, potential%gth_pot%nct_lsd(k) omat = 0._dp - CALL sg_gpot(omat(1:m, 1:m), i-1, potential%gth_pot%alpha_lsd(k), l, & + CALL sg_gpot(omat(1:m, 1:m), i - 1, potential%gth_pot%alpha_lsd(k), l, & basis%am(1:m, l), basis%am(1:m, l)) omat(1:m, 1:m) = potential%gth_pot%cval_lsd(i, k)*omat(1:m, 1:m) CALL contract2add(integrals%clsd(1:n, 1:n, l), omat(1:m, 1:m), basis%cm(1:m, 1:n, l)) @@ -490,7 +490,7 @@ SUBROUTINE atom_ppint_setup(integrals, basis, potential) spmat = 0._dp k = potential%gth_pot%nl(l) DO i = 1, k - CALL sg_proj_ol(xmat(1:m), l, basis%am(1:m, l), i-1, potential%gth_pot%rcnl(l)) + CALL sg_proj_ol(xmat(1:m), l, basis%am(1:m, l), i - 1, potential%gth_pot%rcnl(l)) spmat(1:n, i) = MATMUL(TRANSPOSE(basis%cm(1:m, 1:n, l)), xmat(1:m)) END DO IF (k > 0) THEN @@ -531,15 +531,15 @@ SUBROUTINE atom_ppint_setup(integrals, basis, potential) cpot(i) = potential%gth_pot%zion*erfc(alpha*rad(i))/rad(i) END DO DO i = 1, potential%gth_pot%ncl - ii = 2*(i-1) - cpot(1:m) = cpot(1:m)+potential%gth_pot%cl(i)*(rad/rc)**ii*EXP(-0.5_dp*(rad/rc)**2) + ii = 2*(i - 1) + cpot(1:m) = cpot(1:m) + potential%gth_pot%cl(i)*(rad/rc)**ii*EXP(-0.5_dp*(rad/rc)**2) END DO IF (potential%gth_pot%lpotextended) THEN DO k = 1, potential%gth_pot%nexp_lpot al = potential%gth_pot%alpha_lpot(k) DO i = 1, potential%gth_pot%nct_lpot(k) - ii = 2*(i-1) - cpot(1:m) = cpot(1:m)+potential%gth_pot%cval_lpot(i, k)*(rad/al)**ii*EXP(-0.5_dp*(rad/al)**2) + ii = 2*(i - 1) + cpot(1:m) = cpot(1:m) + potential%gth_pot%cval_lpot(i, k)*(rad/al)**ii*EXP(-0.5_dp*(rad/al)**2) END DO END DO END IF @@ -550,7 +550,7 @@ SUBROUTINE atom_ppint_setup(integrals, basis, potential) omat = 0._dp CALL sto_nuclear(omat(1:n, 1:n), basis%ns(1:n, l), basis%as(1:n, l), & basis%ns(1:n, l), basis%as(1:n, l)) - integrals%core(1:n, 1:n, l) = integrals%core(1:n, 1:n, l)-potential%gth_pot%zion*omat(1:n, 1:n) + integrals%core(1:n, 1:n, l) = integrals%core(1:n, 1:n, l) - potential%gth_pot%zion*omat(1:n, 1:n) DEALLOCATE (omat) END DO @@ -559,8 +559,8 @@ SUBROUTINE atom_ppint_setup(integrals, basis, potential) DO k = 1, potential%gth_pot%nexp_lsd al = potential%gth_pot%alpha_lsd(k) DO i = 1, potential%gth_pot%nct_lsd(k) - ii = 2*(i-1) - cpot(:) = cpot+potential%gth_pot%cval_lsd(i, k)*(rad/al)**ii*EXP(-0.5_dp*(rad/al)**2) + ii = 2*(i - 1) + cpot(:) = cpot + potential%gth_pot%cval_lsd(i, k)*(rad/al)**ii*EXP(-0.5_dp*(rad/al)**2) END DO END DO CALL numpot_matrix(integrals%clsd, cpot, basis, 0) @@ -574,7 +574,7 @@ SUBROUTINE atom_ppint_setup(integrals, basis, potential) k = potential%gth_pot%nl(l) DO i = 1, k rc = potential%gth_pot%rcnl(l) - cpot(:) = sqrt2/SQRT(gamma1(l+2*i-1))*rad**(l+2*i-2)*EXP(-0.5_dp*(rad/rc)**2)/rc**(l+2*i-0.5_dp) + cpot(:) = sqrt2/SQRT(gamma1(l + 2*i - 1))*rad**(l + 2*i - 2)*EXP(-0.5_dp*(rad/rc)**2)/rc**(l + 2*i - 0.5_dp) DO j = 1, basis%nbas(l) spmat(j, i) = integrate_grid(cpot, basis%bf(:, j, l), basis%grid) END DO @@ -610,7 +610,7 @@ SUBROUTINE atom_ppint_setup(integrals, basis, potential) DO k = 1, potential%ecp_pot%nloc n = potential%ecp_pot%nrloc(k) alpha = potential%ecp_pot%bloc(k) - cpot(:) = cpot+potential%ecp_pot%aloc(k)*rad**(n-2)*EXP(-alpha*rad**2) + cpot(:) = cpot + potential%ecp_pot%aloc(k)*rad**(n - 2)*EXP(-alpha*rad**2) END DO CALL numpot_matrix(integrals%core, cpot, basis, 0) ! non local pseudopotential @@ -619,7 +619,7 @@ SUBROUTINE atom_ppint_setup(integrals, basis, potential) DO k = 1, potential%ecp_pot%npot(l) n = potential%ecp_pot%nrpot(k, l) alpha = potential%ecp_pot%bpot(k, l) - cpot(:) = cpot+potential%ecp_pot%apot(k, l)*rad**(n-2)*EXP(-alpha*rad**2) + cpot(:) = cpot + potential%ecp_pot%apot(k, l)*rad**(n - 2)*EXP(-alpha*rad**2) END DO DO i = 1, basis%nbas(l) DO j = i, basis%nbas(l) @@ -683,7 +683,7 @@ SUBROUTINE upfint_setup(integrals, basis, potential) IF (la == lb) THEN DO k1 = 1, gbasis%nbas(la) DO k2 = 1, gbasis%nbas(la) - integrals%hnl(k1, k2, la) = integrals%hnl(k1, k2, la)+ & + integrals%hnl(k1, k2, la) = integrals%hnl(k1, k2, la) + & spmat(k1, i)*potential%upf_pot%dion(i, j)*spmat(k2, j) END DO END DO @@ -695,13 +695,13 @@ SUBROUTINE upfint_setup(integrals, basis, potential) ! semi local pseudopotential DO la = 0, potential%upf_pot%l_max IF (la == potential%upf_pot%l_local) CYCLE - m = SIZE(potential%upf_pot%vsemi(:, la+1)) + m = SIZE(potential%upf_pot%vsemi(:, la + 1)) ALLOCATE (spot(m)) - spot(:) = potential%upf_pot%vsemi(:, la+1)-potential%upf_pot%vlocal(:) + spot(:) = potential%upf_pot%vsemi(:, la + 1) - potential%upf_pot%vlocal(:) n = basis%nbas(la) DO i = 1, n DO j = i, n - integrals%core(i, j, la) = integrals%core(i, j, la)+ & + integrals%core(i, j, la) = integrals%core(i, j, la) + & integrate_grid(spot(:), & gbasis%bf(:, i, la), gbasis%bf(:, j, la), gbasis%grid) integrals%core(j, i, la) = integrals%core(i, j, la) @@ -747,10 +747,10 @@ SUBROUTINE sgpint_setup(integrals, basis, potential) zval = potential%sgp_pot%zion DO i = 1, m rc = rad(i)/potential%sgp_pot%ac_local/SQRT(2.0_dp) - cpot(i) = cpot(i)-zval/rad(i)*erf(rc) + cpot(i) = cpot(i) - zval/rad(i)*erf(rc) END DO DO i = 1, potential%sgp_pot%n_local - cpot(:) = cpot(:)+potential%sgp_pot%c_local(i)*EXP(-potential%sgp_pot%a_local(i)*rad(:)**2) + cpot(:) = cpot(:) + potential%sgp_pot%c_local(i)*EXP(-potential%sgp_pot%a_local(i)*rad(:)**2) END DO CALL numpot_matrix(integrals%core, cpot, basis, 0) DEALLOCATE (cpot) @@ -772,7 +772,7 @@ SUBROUTINE sgpint_setup(integrals, basis, potential) DO j = 1, n a = potential%sgp_pot%a_nonlocal(j) c = potential%sgp_pot%c_nonlocal(j, i, l) - pgauss(:) = pgauss(:)+c*EXP(-a*rad(:)**2)*rad(:)**l + pgauss(:) = pgauss(:) + c*EXP(-a*rad(:)**2)*rad(:)**l END DO DO ia = 1, na qmat(ia, i) = SUM(basis%bf(:, ia, l)*pgauss(:)*basis%grid%wr(:)) @@ -782,7 +782,7 @@ SUBROUTINE sgpint_setup(integrals, basis, potential) DO j = i, na DO ia = 1, n integrals%hnl(i, j, l) = integrals%hnl(i, j, l) & - +qmat(i, ia)*qmat(j, ia)*potential%sgp_pot%h_nonlocal(ia, l) + + qmat(i, ia)*qmat(j, ia)*potential%sgp_pot%h_nonlocal(ia, l) END DO integrals%hnl(j, i, l) = integrals%hnl(i, j, l) END DO @@ -854,12 +854,12 @@ SUBROUTINE atom_relint_setup(integrals, basis, reltyp, zcore, alpha) ALLOCATE (modpot(1:m), cpot(1:m)) CALL calculate_model_potential(modpot, basis%grid, zcore) ! Zora potential - cpot(1:m) = modpot(1:m)/(4._dp*c_light_au*c_light_au-2._dp*modpot(1:m)) + cpot(1:m) = modpot(1:m)/(4._dp*c_light_au*c_light_au - 2._dp*modpot(1:m)) cpot(1:m) = cpot(1:m)/basis%grid%rad2(1:m) CALL numpot_matrix(integrals%tzora, cpot, basis, 0) DO l = 0, lmat nl = basis%nbas(l) - integrals%tzora(1:nl, 1:nl, l) = REAL(l*(l+1), dp)*integrals%tzora(1:nl, 1:nl, l) + integrals%tzora(1:nl, 1:nl, l) = REAL(l*(l + 1), dp)*integrals%tzora(1:nl, 1:nl, l) END DO cpot(1:m) = cpot(1:m)*basis%grid%rad2(1:m) CALL numpot_matrix(integrals%tzora, cpot, basis, 2) @@ -867,19 +867,19 @@ SUBROUTINE atom_relint_setup(integrals, basis, reltyp, zcore, alpha) ! scaled ZORA IF (reltyp == do_sczoramp_atom) THEN ALLOCATE (hmat(n, n, 0:lmat), wfn(n, n, 0:lmat), ener(n, 0:lmat), pvp(n, n, 0:lmat), sps(n, n)) - hmat(:, :, :) = integrals%kin+integrals%tzora + hmat(:, :, :) = integrals%kin + integrals%tzora ! model potential CALL numpot_matrix(hmat, modpot, basis, 0) ! eigenvalues and eigenvectors CALL atom_solve(hmat, integrals%utrans, wfn, ener, basis%nbas, integrals%nne, lmat) ! relativistic kinetic energy - cpot(1:m) = c_light_au*c_light_au/(2._dp*c_light_au*c_light_au-modpot(1:m))**2 + cpot(1:m) = c_light_au*c_light_au/(2._dp*c_light_au*c_light_au - modpot(1:m))**2 cpot(1:m) = cpot(1:m)/basis%grid%rad2(1:m) pvp = 0.0_dp CALL numpot_matrix(pvp, cpot, basis, 0) DO l = 0, lmat nl = basis%nbas(l) - pvp(1:nl, 1:nl, l) = REAL(l*(l+1), dp)*pvp(1:nl, 1:nl, l) + pvp(1:nl, 1:nl, l) = REAL(l*(l + 1), dp)*pvp(1:nl, 1:nl, l) END DO cpot(1:m) = cpot(1:m)*basis%grid%rad2(1:m) CALL numpot_matrix(pvp, cpot, basis, 2) @@ -890,7 +890,7 @@ SUBROUTINE atom_relint_setup(integrals, basis, reltyp, zcore, alpha) DO i = 1, integrals%nne(l) IF (ener(i, l) < 0._dp) THEN ascal = SUM(wfn(1:nl, i, l)*MATMUL(pvp(1:nl, 1:nl, l), wfn(1:nl, i, l))) - ener(i, l) = ener(i, l)*ascal/(1.0_dp+ascal) + ener(i, l) = ener(i, l)*ascal/(1.0_dp + ascal) ELSE ener(i, l) = 0.0_dp END IF @@ -903,7 +903,7 @@ SUBROUTINE atom_relint_setup(integrals, basis, reltyp, zcore, alpha) DO i = 1, integrals%nne(l) DO k1 = 1, nl DO k2 = 1, nl - hmat(k1, k2, l) = hmat(k1, k2, l)+ener(i, l)*wfn(k1, i, l)*wfn(k2, i, l) + hmat(k1, k2, l) = hmat(k1, k2, l) + ener(i, l)*wfn(k1, i, l)*wfn(k2, i, l) END DO END DO END DO @@ -911,7 +911,7 @@ SUBROUTINE atom_relint_setup(integrals, basis, reltyp, zcore, alpha) sps(1:nl, 1:nl) = MATMUL(integrals%ovlp(1:nl, 1:nl, l), & MATMUL(hmat(1:nl, 1:nl, l), integrals%ovlp(1:nl, 1:nl, l))) ! add scaling correction to tzora - integrals%tzora(1:nl, 1:nl, l) = integrals%tzora(1:nl, 1:nl, l)-sps(1:nl, 1:nl) + integrals%tzora(1:nl, 1:nl, l) = integrals%tzora(1:nl, 1:nl, l) - sps(1:nl, 1:nl) END DO DEALLOCATE (hmat, wfn, ener, pvp, sps) @@ -1017,7 +1017,7 @@ SUBROUTINE dkh_integrals(integrals, basis, order, sp, tp, vp, pvp) CPABORT("") CASE (GTO_BASIS) CPASSERT(n == m) - integrals%hdkh(1:n, 1:n, l) = tp(1:n, 1:n, l)+vp(1:n, 1:n, l) + integrals%hdkh(1:n, 1:n, l) = tp(1:n, 1:n, l) + vp(1:n, 1:n, l) CASE (CGTO_BASIS) CALL contract2(integrals%hdkh(1:n, 1:n, l), tp(1:m, 1:m, l), basis%cm(1:m, 1:n, l)) CALL contract2add(integrals%hdkh(1:n, 1:n, l), vp(1:m, 1:m, l), basis%cm(1:m, 1:n, l)) @@ -1222,9 +1222,9 @@ SUBROUTINE calculate_model_potential(modpot, grid, zcore) DO l = 0, MIN(lmat, UBOUND(ptable(z)%e_conv, 1)) IF (ptable(z)%e_conv(l) /= 0) THEN state%maxl_occ = l - ll = 2*(2*l+1) + ll = 2*(2*l + 1) DO i = 1, SIZE(state%occ, 2) - ii = ptable(z)%e_conv(l)-(i-1)*ll + ii = ptable(z)%e_conv(l) - (i - 1)*ll IF (ii <= ll) THEN state%occ(l, i) = ii EXIT @@ -1240,11 +1240,11 @@ SUBROUTINE calculate_model_potential(modpot, grid, zcore) ! Coulomb potential CALL slater_density(rho, pot, NINT(zcore), state, grid) CALL coulomb_potential_numeric(pot, rho, grid) - modpot = modpot+pot + modpot = modpot + pot ! XC potential CALL wigner_slater_functional(rho, pot) - modpot = modpot+pot + modpot = modpot + pot DEALLOCATE (rho, pot) diff --git a/src/atom_optimization.F b/src/atom_optimization.F index 29727124d6..0404c1d9fa 100644 --- a/src/atom_optimization.F +++ b/src/atom_optimization.F @@ -73,7 +73,7 @@ SUBROUTINE atom_history_init(history, optimization, matrix) history%hpos = 0 history%damping = damp history%eps_diis = eps - ALLOCATE (history%dmat(ndiis+1, ndiis+1)) + ALLOCATE (history%dmat(ndiis + 1, ndiis + 1)) ALLOCATE (history%hmat(ndiis)) n1 = SIZE(matrix, 1) @@ -112,8 +112,8 @@ SUBROUTINE atom_history_update(history, pmat, fmat, emat, energy, error) INTEGER :: nlen, nmax, nnow nmax = history%max_history - nlen = MIN(history%hlen+1, nmax) - nnow = history%hpos+1 + nlen = MIN(history%hlen + 1, nmax) + nnow = history%hpos + 1 IF (nnow > nmax) nnow = 1 history%hmat(nnow)%energy = energy @@ -196,40 +196,40 @@ SUBROUTINE atom_opt_fmat(fmat, history, err) ! DIIS rcond = 1.e-10_dp lwork = 25*nmax - ALLOCATE (vec(nmax+1, 2), s(nmax+1), work(lwork)) + ALLOCATE (vec(nmax + 1, 2), s(nmax + 1), work(lwork)) nlen = history%hlen vec = 0._dp - vec(nlen+1, 1) = 1._dp - history%dmat(1:nlen, nlen+1) = 1._dp - history%dmat(nlen+1, 1:nlen) = 1._dp - history%dmat(nlen+1, nlen+1) = 0._dp + vec(nlen + 1, 1) = 1._dp + history%dmat(1:nlen, nlen + 1) = 1._dp + history%dmat(nlen + 1, 1:nlen) = 1._dp + history%dmat(nlen + 1, nlen + 1) = 0._dp DO i = 1, nlen - na = nnow+1-i - IF (na < 1) na = nmax+na + na = nnow + 1 - i + IF (na < 1) na = nmax + na DO j = i, nlen - nb = nnow+1-j - IF (nb < 1) nb = nmax+nb + nb = nnow + 1 - j + IF (nb < 1) nb = nmax + nb t = SUM(history%hmat(na)%emat*history%hmat(nb)%emat) history%dmat(i, j) = t history%dmat(j, i) = t END DO END DO - CALL lapack_sgelss(nlen+1, nlen+1, 1, history%dmat, nmax+1, vec, nmax+1, s, & + CALL lapack_sgelss(nlen + 1, nlen + 1, 1, history%dmat, nmax + 1, vec, nmax + 1, s, & rcond, rank, work, lwork, info) CPASSERT(info == 0) fmat = 0._dp DO i = 1, nlen - na = nnow+1-i - IF (na < 1) na = nmax+na - fmat = fmat+vec(i, 1)*history%hmat(na)%fmat + na = nnow + 1 - i + IF (na < 1) na = nmax + na + fmat = fmat + vec(i, 1)*history%hmat(na)%fmat END DO DEALLOCATE (vec, s, work) ELSE ! damping - nm = nnow-1 + nm = nnow - 1 IF (nm < 1) nm = history%max_history - fmat = a*history%hmat(nnow)%fmat+(1._dp-a)*history%hmat(nm)%fmat + fmat = a*history%hmat(nnow)%fmat + (1._dp - a)*history%hmat(nm)%fmat END IF ELSEIF (history%hlen == 1) THEN fmat = history%hmat(nnow)%fmat diff --git a/src/atom_output.F b/src/atom_output.F index a8d6cc83ab..c6506e4ff1 100644 --- a/src/atom_output.F +++ b/src/atom_output.F @@ -95,7 +95,7 @@ SUBROUTINE atom_print_state(state, iw) WRITE (iw, '(/,T2,A)') "Electronic structure" WRITE (iw, '(T5,A,T71,F10.2)') "Total number of core electrons", SUM(state%core) WRITE (iw, '(T5,A,T71,F10.2)') "Total number of valence electrons", SUM(state%occ) - WRITE (iw, '(T5,A,T71,F10.2)') "Total number of electrons", SUM(state%occ+state%core) + WRITE (iw, '(T5,A,T71,F10.2)') "Total number of electrons", SUM(state%occ + state%core) SELECT CASE (state%multiplicity) CASE (-1) WRITE (iw, '(T5,A,T68,A)') "Multiplicity", "not specified" @@ -133,7 +133,7 @@ SUBROUTINE atom_print_state(state, iw) mc = mm(l) CPASSERT(SUM(state%occ(l, 1:mc)) == 0) WRITE (iw, ADVANCE="no", FMT='(A5,T9,A1,10F6.2)') label(l), "[", (state%core(l, j), j=1, mc) - WRITE (iw, FMT='(A1,F5.2,10F6.2)') "]", (state%occ(l, j), j=mc+1, mc+mo) + WRITE (iw, FMT='(A1,F5.2,10F6.2)') "]", (state%occ(l, j), j=mc + 1, mc + mo) END IF END DO ELSE @@ -597,7 +597,7 @@ SUBROUTINE atom_print_method(atom, iw) IF (iw > 0) THEN ifun = 0 DO - ifun = ifun+1 + ifun = ifun + 1 xc_fun => section_vals_get_subs_vals2(xc_fun_section, i_section=ifun) IF (.NOT. ASSOCIATED(xc_fun)) EXIT IF (TRIM(xc_fun%section%name) /= "LIBXC") THEN @@ -795,14 +795,14 @@ SUBROUTINE atom_write_pseudo_param(gthpot, iunit) n = 0 DO i = lmat, 0, -1 IF (gthpot%nl(i) > 0) THEN - n = i+1 + n = i + 1 EXIT END IF END DO WRITE (iw, '(I8)') n - DO i = 0, n-1 + DO i = 0, n - 1 WRITE (iw, '(F20.14,I8,5F20.14)') gthpot%rcnl(i), gthpot%nl(i), (gthpot%hnl(1, k, i), k=1, gthpot%nl(i)) - SELECT CASE (gthpot%nl (i)) + SELECT CASE (gthpot%nl(i)) CASE (2) WRITE (iw, '(T49,F20.14)') gthpot%hnl(2, 2, i) CASE (3) diff --git a/src/atom_pseudo.F b/src/atom_pseudo.F index 1d2c03bc7b..146d59c0d1 100644 --- a/src/atom_pseudo.F +++ b/src/atom_pseudo.F @@ -158,7 +158,7 @@ SUBROUTINE atom_pseudo_opt(atom_section) maxn = 0 CALL section_vals_val_get(atom_section, "CALCULATE_STATES", i_vals=cn) DO in = 1, MIN(SIZE(cn), 4) - maxn(in-1) = cn(in) + maxn(in - 1) = cn(in) END DO DO in = 0, lmat maxn(in) = MIN(maxn(in), ae_basis%nbas(in)) @@ -223,7 +223,7 @@ SUBROUTINE atom_pseudo_opt(atom_section) DO k = 0, state%maxl_calc ads = 2 IF (state%maxn_occ(k) == 0) ads = 1 - state%maxn_calc(k) = MAX(maxn(k), state%maxn_occ(k)+ads) + state%maxn_calc(k) = MAX(maxn(k), state%maxn_occ(k) + ads) state%maxn_calc(k) = MIN(state%maxn_calc(k), ae_basis%nbas(k)) END DO state%core = 0._dp @@ -234,7 +234,7 @@ SUBROUTINE atom_pseudo_opt(atom_section) state%occa = 0._dp state%occb = 0._dp DO l = 0, lmat - nm = REAL((2*l+1), KIND=dp) + nm = REAL((2*l + 1), KIND=dp) DO k = 1, 10 ne = state%occupation(l, k) IF (ne == 0._dp) THEN !empty shell @@ -244,10 +244,10 @@ SUBROUTINE atom_pseudo_opt(atom_section) state%occb(l, k) = nm ELSEIF (state%multiplicity == -2) THEN !High spin case state%occa(l, k) = MIN(ne, nm) - state%occb(l, k) = MAX(0._dp, ne-nm) + state%occb(l, k) = MAX(0._dp, ne - nm) ELSE - state%occa(l, k) = 0.5_dp*(ne+state%multiplicity-1._dp) - state%occb(l, k) = ne-state%occa(l, k) + state%occa(l, k) = 0.5_dp*(ne + state%multiplicity - 1._dp) + state%occb(l, k) = ne - state%occa(l, k) END IF END DO END DO @@ -256,20 +256,20 @@ SUBROUTINE atom_pseudo_opt(atom_section) ! set occupations for pseudopotential calculation CALL section_vals_val_get(atom_section, "CORE", c_vals=tmpstringlist) CALL atom_set_occupation(tmpstringlist, statepp%core, pocc) - zcore = zval-NINT(SUM(statepp%core)) + zcore = zval - NINT(SUM(statepp%core)) CALL set_atom(atom_info(in, im)%atom, zcore=zcore, pp_calc=.TRUE.) - statepp%occ = state%occ-statepp%core + statepp%occ = state%occ - statepp%core statepp%occupation = 0._dp DO l = 0, lmat k = 0 DO i = 1, 10 IF (statepp%occ(l, i) /= 0._dp) THEN - k = k+1 + k = k + 1 statepp%occupation(l, k) = state%occ(l, i) IF (state%multiplicity /= -1) THEN - statepp%occa(l, k) = state%occa(l, i)-statepp%core(l, i)/2 - statepp%occb(l, k) = state%occb(l, i)-statepp%core(l, i)/2 + statepp%occa(l, k) = state%occa(l, i) - statepp%core(l, i)/2 + statepp%occb(l, k) = state%occb(l, i) - statepp%core(l, i)/2 END IF END IF END DO @@ -281,7 +281,7 @@ SUBROUTINE atom_pseudo_opt(atom_section) statepp%maxn_calc = 0 maxn = get_maxn_occ(statepp%core) DO k = 0, statepp%maxl_calc - statepp%maxn_calc(k) = state%maxn_calc(k)-maxn(k) + statepp%maxn_calc(k) = state%maxn_calc(k) - maxn(k) statepp%maxn_calc(k) = MIN(statepp%maxn_calc(k), pp_basis%nbas(k)) END DO statepp%multiplicity = state%multiplicity diff --git a/src/atom_sgp.F b/src/atom_sgp.F index 1ec5b1522a..16d6cfe11d 100644 --- a/src/atom_sgp.F +++ b/src/atom_sgp.F @@ -140,11 +140,11 @@ SUBROUTINE sgp_construction(sgp_pot, ecp_pot, upf_pot, error) error = 0.0_dp IF (sgp_pot%has_local) THEN n = MIN(3, UBOUND(core%op, 3)) - error(1) = MAXVAL(ABS(core%op(:, :, 0:n)-score%op(:, :, 0:n))) + error(1) = MAXVAL(ABS(core%op(:, :, 0:n) - score%op(:, :, 0:n))) END IF IF (sgp_pot%has_nonlocal) THEN n = MIN(3, UBOUND(hnl%op, 3)) - error(2) = MAXVAL(ABS(hnl%op(:, :, 0:n)-shnl%op(:, :, 0:n))) + error(2) = MAXVAL(ABS(hnl%op(:, :, 0:n) - shnl%op(:, :, 0:n))) END IF IF (sgp_pot%has_nlcc) THEN IF (is_upf) THEN @@ -152,9 +152,9 @@ SUBROUTINE sgp_construction(sgp_pot, ecp_pot, upf_pot, error) ALLOCATE (cgauss(n)) cgauss = 0.0_dp DO i = 1, sgp_pot%n_nlcc - cgauss(:) = cgauss(:)+sgp_pot%c_nlcc(i)*EXP(-sgp_pot%a_nlcc(i)*upf_pot%r(:)**2) + cgauss(:) = cgauss(:) + sgp_pot%c_nlcc(i)*EXP(-sgp_pot%a_nlcc(i)*upf_pot%r(:)**2) END DO - errcc = SUM((cgauss(:)-upf_pot%rho_nlcc(:))**2*upf_pot%r(:)**2*upf_pot%rab(:)) + errcc = SUM((cgauss(:) - upf_pot%rho_nlcc(:))**2*upf_pot%r(:)**2*upf_pot%rab(:)) errcc = SQRT(errcc/REAL(n, KIND=dp)) DEALLOCATE (cgauss) ELSE @@ -280,7 +280,7 @@ SUBROUTINE atom_sgp_construction(atom_info, input_section, iw) ! IF (sgp_pot%has_local) THEN n = MIN(3, UBOUND(core%op, 3)) - errcc = MAXVAL(ABS(core%op(:, :, 0:n)-score%op(:, :, 0:n))) + errcc = MAXVAL(ABS(core%op(:, :, 0:n) - score%op(:, :, 0:n))) IF (iw > 0) THEN WRITE (iw, '(" Local part of pseudopotential")') WRITE (iw, '(" Number of basis functions ",T77,i4)') sgp_pot%n_local @@ -288,7 +288,7 @@ SUBROUTINE atom_sgp_construction(atom_info, input_section, iw) END IF END IF IF (sgp_pot%has_nonlocal) THEN - errcc = MAXVAL(ABS(hnl%op-shnl%op)) + errcc = MAXVAL(ABS(hnl%op - shnl%op)) IF (iw > 0) THEN WRITE (iw, '(" Nonlocal part of pseudopotential")') WRITE (iw, '(" Max. l-quantum number",T77,i4)') sgp_pot%lmax @@ -302,9 +302,9 @@ SUBROUTINE atom_sgp_construction(atom_info, input_section, iw) ALLOCATE (cgauss(n)) cgauss = 0.0_dp DO i = 1, sgp_pot%n_nlcc - cgauss(:) = cgauss(:)+sgp_pot%c_nlcc(i)*EXP(-sgp_pot%a_nlcc(i)*upf_pot%r(:)**2) + cgauss(:) = cgauss(:) + sgp_pot%c_nlcc(i)*EXP(-sgp_pot%a_nlcc(i)*upf_pot%r(:)**2) END DO - errcc = SUM((cgauss(:)-upf_pot%rho_nlcc(:))**2*upf_pot%r(:)**2*upf_pot%rab(:)) + errcc = SUM((cgauss(:) - upf_pot%rho_nlcc(:))**2*upf_pot%r(:)**2*upf_pot%rab(:)) errcc = SQRT(errcc/REAL(n, KIND=dp)) DEALLOCATE (cgauss) ELSE @@ -377,7 +377,7 @@ SUBROUTINE ecp_sgp_constr(ecp_pot, sgp_pot, basis) ALLOCATE (tmat(nl, nl), cmat(nl, nl)) al = 0.0_dp DO ir = 1, nl - al(ir) = 80.0_dp*0.60_dp**(ir-1) + al(ir) = 80.0_dp*0.60_dp**(ir - 1) END DO ! sgp_pot%a_nonlocal(1:nl) = al(1:nl) @@ -392,7 +392,7 @@ SUBROUTINE ecp_sgp_constr(ecp_pot, sgp_pot, basis) DO k = 1, ecp_pot%npot(l) n = ecp_pot%nrpot(k, l) alpha = ecp_pot%bpot(k, l) - cpot(:) = cpot+ecp_pot%apot(k, l)*rad**(n-2)*EXP(-alpha*rad**2) + cpot(:) = cpot + ecp_pot%apot(k, l)*rad**(n - 2)*EXP(-alpha*rad**2) END DO DO i = 1, na DO j = i, na @@ -403,7 +403,7 @@ SUBROUTINE ecp_sgp_constr(ecp_pot, sgp_pot, basis) ! overlap basis with projectors DO i = 1, nl pgauss(:) = EXP(-al(i)*rad(:)**2)*rad(:)**l - eee = rootpi/(2._dp**(l+2)*dfac(2*l+1))/(2._dp*al(i))**(l+1.5_dp) + eee = rootpi/(2._dp**(l + 2)*dfac(2*l + 1))/(2._dp*al(i))**(l + 1.5_dp) pgauss(:) = pgauss(:)/SQRT(eee) DO ia = 1, na qmat(ia, i) = SUM(basis%bf(:, ia, l)*pgauss(:)*basis%grid%wr(:)) @@ -414,12 +414,12 @@ SUBROUTINE ecp_sgp_constr(ecp_pot, sgp_pot, basis) smat(1:nl, 1:nl) = MATMUL(TRANSPOSE(qmat(1:na, 1:nl)), qmat(1:na, 1:nl)) CALL get_pseudo_inverse_diag(smat(1:nl, 1:nl), sinv(1:nl, 1:nl), 1.e-10_dp) cmat(1:nl, 1:nl) = MATMUL(sinv(1:nl, 1:nl), MATMUL(tmat(1:nl, 1:nl), sinv(1:nl, 1:nl))) - cmat(1:nl, 1:nl) = (cmat(1:nl, 1:nl)+TRANSPOSE(cmat(1:nl, 1:nl)))*0.5_dp + cmat(1:nl, 1:nl) = (cmat(1:nl, 1:nl) + TRANSPOSE(cmat(1:nl, 1:nl)))*0.5_dp CALL diamat_all(cmat(1:nl, 1:nl), cl(1:nl), .TRUE.) ! ! get back unnormalized Gaussians DO i = 1, nl - ei = rootpi/(2._dp**(l+2)*dfac(2*l+1))/(2._dp*al(i))**(l+1.5_dp) + ei = rootpi/(2._dp**(l + 2)*dfac(2*l + 1))/(2._dp*al(i))**(l + 1.5_dp) cmat(i, 1:nl) = cmat(i, 1:nl)/SQRT(ei) END DO sgp_pot%h_nonlocal(1:nl, l) = cl(1:nl) @@ -492,7 +492,7 @@ SUBROUTINE upf_sgp_constr(upf_pot, sgp_pot, basis) vgauss(ir) = -zval/upf_pot%r(ir)*erf(rc) END IF END DO - vloc(:) = upf_pot%vlocal(:)-vgauss(:) + vloc(:) = upf_pot%vlocal(:) - vgauss(:) ! CALL atom_basis_gridrep(basis, gbasis, upf_pot%r, upf_pot%rab) ! @@ -511,7 +511,7 @@ SUBROUTINE upf_sgp_constr(upf_pot, sgp_pot, basis) DO IF (ostate%state == 2) THEN DO ir = 1, nl - al(ir) = x(1)*x(2)**(ir-1) + al(ir) = x(1)*x(2)**(ir - 1) END DO CALL pplocal_error(nl, al, cl, vloc, vgauss, gbasis, upf_pot%r, ww, 1, ostate%f) END IF @@ -521,7 +521,7 @@ SUBROUTINE upf_sgp_constr(upf_pot, sgp_pot, basis) ostate%state = 8 CALL powell_optimize(ostate%nvar, x, ostate) DO ir = 1, nl - al(ir) = x(1)*x(2)**(ir-1) + al(ir) = x(1)*x(2)**(ir - 1) END DO CALL pplocal_error(nl, al, cl, vloc, vgauss, gbasis, upf_pot%r, ww, 1, errloc) ! @@ -567,7 +567,7 @@ SUBROUTINE upf_sgp_constr(upf_pot, sgp_pot, basis) ALLOCATE (tmat(nl, nl), cmat(nl, nl)) al = 0.0_dp DO ir = 1, nl - al(ir) = 10.0_dp*0.60_dp**(ir-1) + al(ir) = 10.0_dp*0.60_dp**(ir - 1) END DO ! sgp_pot%a_nonlocal(1:nl) = al(1:nl) @@ -580,7 +580,7 @@ SUBROUTINE upf_sgp_constr(upf_pot, sgp_pot, basis) na = gbasis%nbas(la) ALLOCATE (score(na, na), qmat(na, nl)) ! Reference matrix - vloc(:) = upf_pot%vsemi(:, la+1)-upf_pot%vlocal(:) + vloc(:) = upf_pot%vsemi(:, la + 1) - upf_pot%vlocal(:) DO ia = 1, na DO ib = ia, na score(ia, ib) = SUM(vloc(:)*gbasis%bf(:, ia, la)*gbasis%bf(:, ib, la)*ww(:)) @@ -590,7 +590,7 @@ SUBROUTINE upf_sgp_constr(upf_pot, sgp_pot, basis) ! overlap basis with projectors DO ir = 1, nl pgauss(:) = EXP(-al(ir)*upf_pot%r(:)**2)*upf_pot%r(:)**la - eee = rootpi/(2._dp**(la+2)*dfac(2*la+1))/(2._dp*al(ir))**(la+1.5_dp) + eee = rootpi/(2._dp**(la + 2)*dfac(2*la + 1))/(2._dp*al(ir))**(la + 1.5_dp) pgauss(:) = pgauss(:)/SQRT(eee) DO ia = 1, na qmat(ia, ir) = SUM(gbasis%bf(:, ia, la)*pgauss(:)*ww) @@ -601,12 +601,12 @@ SUBROUTINE upf_sgp_constr(upf_pot, sgp_pot, basis) smat(1:nl, 1:nl) = MATMUL(TRANSPOSE(qmat(1:na, 1:nl)), qmat(1:na, 1:nl)) CALL get_pseudo_inverse_diag(smat(1:nl, 1:nl), sinv(1:nl, 1:nl), 1.e-10_dp) cmat(1:nl, 1:nl) = MATMUL(sinv(1:nl, 1:nl), MATMUL(tmat(1:nl, 1:nl), sinv(1:nl, 1:nl))) - cmat(1:nl, 1:nl) = (cmat(1:nl, 1:nl)+TRANSPOSE(cmat(1:nl, 1:nl)))*0.5_dp + cmat(1:nl, 1:nl) = (cmat(1:nl, 1:nl) + TRANSPOSE(cmat(1:nl, 1:nl)))*0.5_dp CALL diamat_all(cmat(1:nl, 1:nl), cl(1:nl), .TRUE.) ! ! get back unnormalized Gaussians DO ir = 1, nl - ei = rootpi/(2._dp**(la+2)*dfac(2*la+1))/(2._dp*al(ir))**(la+1.5_dp) + ei = rootpi/(2._dp**(la + 2)*dfac(2*la + 1))/(2._dp*al(ir))**(la + 1.5_dp) cmat(ir, 1:nl) = cmat(ir, 1:nl)/SQRT(ei) END DO sgp_pot%h_nonlocal(1:nl, la) = cl(1:nl) @@ -631,7 +631,7 @@ SUBROUTINE upf_sgp_constr(upf_pot, sgp_pot, basis) al = 0.0_dp cl = 0.0_dp DO ir = 1, nl - al(ir) = 10.0_dp*0.60_dp**(ir-1) + al(ir) = 10.0_dp*0.60_dp**(ir - 1) END DO ! sgp_pot%lmax = MAXVAL(upf_pot%lbeta(:)) @@ -662,7 +662,7 @@ SUBROUTINE upf_sgp_constr(upf_pot, sgp_pot, basis) cpa = SUM(pproa(:)*gbasis%bf(:, ia, la)*ww(:)) DO ib = ia, na cpb = SUM(pprob(:)*gbasis%bf(:, ib, la)*ww(:)) - score(ia, ib) = score(ia, ib)+cpa*eee*cpb + score(ia, ib) = score(ia, ib) + cpa*eee*cpb score(ib, ia) = score(ia, ib) END DO END DO @@ -671,7 +671,7 @@ SUBROUTINE upf_sgp_constr(upf_pot, sgp_pot, basis) ! overlap basis with projectors DO ir = 1, nl pgauss(:) = EXP(-al(ir)*upf_pot%r(:)**2)*upf_pot%r(:)**la - eee = rootpi/(2._dp**(la+2)*dfac(2*la+1))/(2._dp*al(ir))**(la+1.5_dp) + eee = rootpi/(2._dp**(la + 2)*dfac(2*la + 1))/(2._dp*al(ir))**(la + 1.5_dp) pgauss(:) = pgauss(:)/SQRT(eee) DO ia = 1, na qmat(ia, ir) = SUM(gbasis%bf(:, ia, la)*pgauss(:)*ww) @@ -682,12 +682,12 @@ SUBROUTINE upf_sgp_constr(upf_pot, sgp_pot, basis) smat(1:nl, 1:nl) = MATMUL(TRANSPOSE(qmat(1:na, 1:nl)), qmat(1:na, 1:nl)) CALL get_pseudo_inverse_diag(smat(1:nl, 1:nl), sinv(1:nl, 1:nl), 1.e-10_dp) cmat(1:nl, 1:nl) = MATMUL(sinv(1:nl, 1:nl), MATMUL(tmat(1:nl, 1:nl), sinv(1:nl, 1:nl))) - cmat(1:nl, 1:nl) = (cmat(1:nl, 1:nl)+TRANSPOSE(cmat(1:nl, 1:nl)))*0.5_dp + cmat(1:nl, 1:nl) = (cmat(1:nl, 1:nl) + TRANSPOSE(cmat(1:nl, 1:nl)))*0.5_dp CALL diamat_all(cmat(1:nl, 1:nl), cl(1:nl), .TRUE.) ! ! get back unnormalized Gaussians DO ir = 1, nl - ei = rootpi/(2._dp**(la+2)*dfac(2*la+1))/(2._dp*al(ir))**(la+1.5_dp) + ei = rootpi/(2._dp**(la + 2)*dfac(2*la + 1))/(2._dp*al(ir))**(la + 1.5_dp) cmat(ir, 1:nl) = cmat(ir, 1:nl)/SQRT(ei) END DO sgp_pot%h_nonlocal(1:nl, la) = cl(1:nl) @@ -720,7 +720,7 @@ SUBROUTINE upf_sgp_constr(upf_pot, sgp_pot, basis) al = 0.0_dp cl = 0.0_dp DO ir = 1, nl - al(ir) = 10.0_dp*0.6_dp**(ir-1) + al(ir) = 10.0_dp*0.6_dp**(ir - 1) END DO ! calculate integrals smat = 0.0_dp @@ -735,9 +735,9 @@ SUBROUTINE upf_sgp_constr(upf_pot, sgp_pot, basis) cl(1:nl) = MATMUL(sinv(1:nl, 1:nl), tv(1:nl)) cgauss = 0.0_dp DO ir = 1, nl - cgauss(:) = cgauss(:)+cl(ir)*EXP(-al(ir)*upf_pot%r(:)**2) + cgauss(:) = cgauss(:) + cl(ir)*EXP(-al(ir)*upf_pot%r(:)**2) END DO - errcc = SUM((cgauss-ccharge)**2*ww) + errcc = SUM((cgauss - ccharge)**2*ww) ALLOCATE (sgp_pot%a_local(nl), sgp_pot%c_local(nl)) sgp_pot%n_nlcc = nl sgp_pot%a_nlcc(1:nl) = al(1:nl) @@ -809,10 +809,10 @@ SUBROUTINE upfints(core, hnl, basis, upf_pot, cutpotu, ac_local) zval = upf_pot%zion DO i = 1, n IF (upf_pot%r(i) < 1.e-12_dp) THEN - spot(i) = spot(i)+sqrt2*zval/rootpi/ac_local + spot(i) = spot(i) + sqrt2*zval/rootpi/ac_local ELSE rc = upf_pot%r(i)/ac_local/sqrt2 - spot(i) = spot(i)+zval/upf_pot%r(i)*erf(rc) + spot(i) = spot(i) + zval/upf_pot%r(i)*erf(rc) END IF END DO spot(:) = spot(:)*cutpotu(:) @@ -841,7 +841,7 @@ SUBROUTINE upfints(core, hnl, basis, upf_pot, cutpotu, ac_local) IF (la == lb) THEN DO k1 = 1, gbasis%nbas(la) DO k2 = 1, gbasis%nbas(la) - hnl(k1, k2, la) = hnl(k1, k2, la)+spmat(k1, i)*upf_pot%dion(i, j)*spmat(k2, j) + hnl(k1, k2, la) = hnl(k1, k2, la) + spmat(k1, i)*upf_pot%dion(i, j)*spmat(k2, j) END DO END DO END IF @@ -852,14 +852,14 @@ SUBROUTINE upfints(core, hnl, basis, upf_pot, cutpotu, ac_local) ! semi local pseudopotential DO la = 0, upf_pot%l_max IF (la == upf_pot%l_local) CYCLE - m = SIZE(upf_pot%vsemi(:, la+1)) + m = SIZE(upf_pot%vsemi(:, la + 1)) ALLOCATE (spot(m)) - spot(:) = upf_pot%vsemi(:, la+1)-upf_pot%vlocal(:) + spot(:) = upf_pot%vsemi(:, la + 1) - upf_pot%vlocal(:) spot(:) = spot(:)*cutpotu(:) n = basis%nbas(la) DO i = 1, n DO j = i, n - hnl(i, j, la) = hnl(i, j, la)+ & + hnl(i, j, la) = hnl(i, j, la) + & integrate_grid(spot(:), & gbasis%bf(:, i, la), gbasis%bf(:, j, la), gbasis%grid) hnl(j, i, la) = hnl(i, j, la) @@ -905,7 +905,7 @@ SUBROUTINE ecpints(hnl, basis, ecp_pot) DO k = 1, ecp_pot%npot(l) n = ecp_pot%nrpot(k, l) alpha = ecp_pot%bpot(k, l) - cpot(:) = cpot(:)+ecp_pot%apot(k, l)*rad(:)**(n-2)*EXP(-alpha*rad(:)**2) + cpot(:) = cpot(:) + ecp_pot%apot(k, l)*rad(:)**(n - 2)*EXP(-alpha*rad(:)**2) END DO DO i = 1, basis%nbas(l) DO j = i, basis%nbas(l) @@ -950,7 +950,7 @@ SUBROUTINE sgpints(core, hnl, basis, sgp_pot, cutpots) core = 0._dp cpot = 0.0_dp DO i = 1, sgp_pot%n_local - cpot(:) = cpot(:)+sgp_pot%c_local(i)*EXP(-sgp_pot%a_local(i)*rad(:)**2) + cpot(:) = cpot(:) + sgp_pot%c_local(i)*EXP(-sgp_pot%a_local(i)*rad(:)**2) END DO cpot(:) = cpot(:)*cutpots(:) CALL numpot_matrix(core, cpot, basis, 0) @@ -974,7 +974,7 @@ SUBROUTINE sgpints(core, hnl, basis, sgp_pot, cutpots) DO j = 1, n a = sgp_pot%a_nonlocal(j) c = sgp_pot%c_nonlocal(j, i, l) - pgauss(:) = pgauss(:)+c*EXP(-a*rad(:)**2)*rad(:)**l + pgauss(:) = pgauss(:) + c*EXP(-a*rad(:)**2)*rad(:)**l END DO pgauss(:) = pgauss(:)*cutpots(:) DO ia = 1, na @@ -985,7 +985,7 @@ SUBROUTINE sgpints(core, hnl, basis, sgp_pot, cutpots) DO i = 1, na DO j = i, na DO ia = 1, n - hnl(i, j, l) = hnl(i, j, l)+qmat(i, ia)*qmat(j, ia)*sgp_pot%h_nonlocal(ia, l) + hnl(i, j, l) = hnl(i, j, l) + qmat(i, ia)*qmat(j, ia)*sgp_pot%h_nonlocal(ia, l) END DO hnl(j, i, l) = hnl(i, j, l) END DO @@ -1021,8 +1021,8 @@ SUBROUTINE erffit(ac, vlocal, r, z) CPASSERT(SIZE(vlocal) == m) IF (r(1) > r(m)) THEN DO i = 1, m - vpot(m-i+1) = vlocal(i) - rval(m-i+1) = r(i) + vpot(m - i + 1) = vlocal(i) + rval(m - i + 1) = r(i) END DO ELSE vpot(1:m) = vlocal(1:m) @@ -1041,10 +1041,10 @@ SUBROUTINE erffit(ac, vlocal, r, z) e2 = 1.e20_dp epot = 0.0_dp DO i = 0, 20 - an = a1+i*0.025_dp + an = a1 + i*0.025_dp rc = 1._dp/(an*SQRT(2.0_dp)) DO j = m1, m - epot(j) = vpot(j)+z/rval(j)*erf(rval(j)*rc) + epot(j) = vpot(j) + z/rval(j)*erf(rval(j)*rc) END DO en = SUM(ABS(epot(m1:m)*rval(m1:m)**2)) IF (en < e2) THEN @@ -1125,9 +1125,9 @@ SUBROUTINE pplocal_error(nl, al, cl, vloc, vgauss, gbasis, rad, ww, method, errl END DO END DO DO ir = 1, nl - tv(ir) = tv(ir)+accurate_dot_product(rmat, gmat(:, :, ir)) + tv(ir) = tv(ir) + accurate_dot_product(rmat, gmat(:, :, ir)) DO ix = ir, nl - smat(ir, ix) = smat(ir, ix)+accurate_dot_product(gmat(:, :, ix), gmat(:, :, ir)) + smat(ir, ix) = smat(ir, ix) + accurate_dot_product(gmat(:, :, ix), gmat(:, :, ir)) smat(ix, ir) = smat(ir, ix) END DO END DO @@ -1140,9 +1140,9 @@ SUBROUTINE pplocal_error(nl, al, cl, vloc, vgauss, gbasis, rad, ww, method, errl ! vgauss = 0.0_dp DO ir = 1, nl - vgauss(:) = vgauss(:)+cl(ir)*EXP(-al(ir)*rad(:)**2) + vgauss(:) = vgauss(:) + cl(ir)*EXP(-al(ir)*rad(:)**2) END DO - errloc = SUM((vgauss-vloc)**2*ww) + errloc = SUM((vgauss - vloc)**2*ww) ! DEALLOCATE (tv, smat, sinv) ! @@ -1171,10 +1171,10 @@ SUBROUTINE cutpot(pot, r, rcut, rsmooth) rab = r(i) IF (rab > rcut) THEN pot(i) = 0.0_dp - ELSE IF (rab > rcut-rsmooth) THEN - rx = rab-(rcut-rsmooth) + ELSE IF (rab > rcut - rsmooth) THEN + rx = rab - (rcut - rsmooth) x = rx/rsmooth - pot(i) = -6._dp*x**5+15._dp*x**4-10._dp*x**3+1._dp + pot(i) = -6._dp*x**5 + 15._dp*x**4 - 10._dp*x**3 + 1._dp END IF END DO diff --git a/src/atom_types.F b/src/atom_types.F index cc87e98d47..ecb1e91c7c 100644 --- a/src/atom_types.F +++ b/src/atom_types.F @@ -424,7 +424,7 @@ SUBROUTINE init_atom_basis(basis, basis_section, zval, btyp) ELSE basis%nbas = 0 DO i = 1, SIZE(num_gto) - basis%nbas(i-1) = num_gto(i) + basis%nbas(i - 1) = num_gto(i) END DO basis%nprim = basis%nbas m = MAXVAL(basis%nbas) @@ -468,9 +468,9 @@ SUBROUTINE init_atom_basis(basis, basis_section, zval, btyp) rk = basis%grid%rad(k) ear = EXP(-al*basis%grid%rad(k)**2) basis%bf(k, i, l) = rk**l*ear - basis%dbf(k, i, l) = (REAL(l, dp)*rk**(l-1)-2._dp*al*rk**(l+1))*ear - basis%ddbf(k, i, l) = (REAL(l*(l-1), dp)*rk**(l-2)- & - 2._dp*al*REAL(2*l+1, dp)*rk**(l)+4._dp*al*rk**(l+2))*ear + basis%dbf(k, i, l) = (REAL(l, dp)*rk**(l - 1) - 2._dp*al*rk**(l + 1))*ear + basis%ddbf(k, i, l) = (REAL(l*(l - 1), dp)*rk**(l - 2) - & + 2._dp*al*REAL(2*l + 1, dp)*rk**(l) + 4._dp*al*rk**(l + 2))*ear END DO END DO END DO @@ -487,13 +487,13 @@ SUBROUTINE init_atom_basis(basis, basis_section, zval, btyp) CALL Clementi_geobas(zval, cval, aval, basis%nbas, starti) ELSEIF (btyp == "AA") THEN CALL Clementi_geobas(zval, cval, aval, basis%nbas, starti) - amax = cval**(basis%nbas(0)-1) + amax = cval**(basis%nbas(0) - 1) basis%nbas(0) = NINT((LOG(amax)/LOG(1.6_dp))) cval = 1.6_dp starti = 0 - basis%nbas(1) = basis%nbas(0)-4 - basis%nbas(2) = basis%nbas(0)-8 - basis%nbas(3) = basis%nbas(0)-12 + basis%nbas(1) = basis%nbas(0) - 4 + basis%nbas(2) = basis%nbas(0) - 8 + basis%nbas(3) = basis%nbas(0) - 12 IF (lmat > 3) basis%nbas(4:lmat) = 0 ELSEIF (btyp == "AP") THEN CALL Clementi_geobas(zval, cval, aval, basis%nbas, starti) @@ -509,14 +509,14 @@ SUBROUTINE init_atom_basis(basis, basis_section, zval, btyp) ELSE basis%nbas = 0 DO i = 1, SIZE(num_gto) - basis%nbas(i-1) = num_gto(i) + basis%nbas(i - 1) = num_gto(i) END DO basis%nprim = basis%nbas NULLIFY (sindex) CALL section_vals_val_get(basis_section, "START_INDEX", i_vals=sindex) starti = 0 DO i = 1, SIZE(sindex) - starti(i-1) = sindex(i) + starti(i - 1) = sindex(i) CPASSERT(sindex(i) >= 0) END DO CALL section_vals_val_get(basis_section, "GEOMETRICAL_FACTOR", r_val=cval) @@ -527,7 +527,7 @@ SUBROUTINE init_atom_basis(basis, basis_section, zval, btyp) basis%am = 0._dp DO l = 0, lmat DO i = 1, basis%nbas(l) - ll = i-1+starti(l) + ll = i - 1 + starti(l) basis%am(i, l) = aval*cval**(ll) END DO END DO @@ -553,9 +553,9 @@ SUBROUTINE init_atom_basis(basis, basis_section, zval, btyp) rk = basis%grid%rad(k) ear = EXP(-al*basis%grid%rad(k)**2) basis%bf(k, i, l) = rk**l*ear - basis%dbf(k, i, l) = (REAL(l, dp)*rk**(l-1)-2._dp*al*rk**(l+1))*ear - basis%ddbf(k, i, l) = (REAL(l*(l-1), dp)*rk**(l-2)- & - 2._dp*al*REAL(2*l+1, dp)*rk**(l)+4._dp*al*rk**(l+2))*ear + basis%dbf(k, i, l) = (REAL(l, dp)*rk**(l - 1) - 2._dp*al*rk**(l + 1))*ear + basis%ddbf(k, i, l) = (REAL(l*(l - 1), dp)*rk**(l - 2) - & + 2._dp*al*REAL(2*l + 1, dp)*rk**(l) + 4._dp*al*rk**(l + 2))*ear END DO END DO END DO @@ -583,11 +583,11 @@ SUBROUTINE init_atom_basis(basis, basis_section, zval, btyp) rk = basis%grid%rad(k) ear = EXP(-al*basis%grid%rad(k)**2) DO j = 1, basis%nbas(l) - basis%bf(k, j, l) = basis%bf(k, j, l)+rk**l*ear*basis%cm(i, j, l) + basis%bf(k, j, l) = basis%bf(k, j, l) + rk**l*ear*basis%cm(i, j, l) basis%dbf(k, j, l) = basis%dbf(k, j, l) & - +(REAL(l, dp)*rk**(l-1)-2._dp*al*rk**(l+1))*ear*basis%cm(i, j, l) - basis%ddbf(k, j, l) = basis%ddbf(k, j, l)+ & - (REAL(l*(l-1), dp)*rk**(l-2)-2._dp*al*REAL(2*l+1, dp)*rk**(l)+4._dp*al*rk**(l+2))* & + + (REAL(l, dp)*rk**(l - 1) - 2._dp*al*rk**(l + 1))*ear*basis%cm(i, j, l) + basis%ddbf(k, j, l) = basis%ddbf(k, j, l) + & + (REAL(l*(l - 1), dp)*rk**(l - 2) - 2._dp*al*REAL(2*l + 1, dp)*rk**(l) + 4._dp*al*rk**(l + 2))* & ear*basis%cm(i, j, l) END DO END DO @@ -602,7 +602,7 @@ SUBROUTINE init_atom_basis(basis, basis_section, zval, btyp) ELSE basis%nbas = 0 DO i = 1, SIZE(num_slater) - basis%nbas(i-1) = num_slater(i) + basis%nbas(i - 1) = num_slater(i) END DO basis%nprim = basis%nbas m = MAXVAL(basis%nbas) @@ -664,11 +664,11 @@ SUBROUTINE init_atom_basis(basis, basis_section, zval, btyp) pf = (2._dp*al)**nl*SQRT(2._dp*al/fac(2*nl)) DO k = 1, nr rk = basis%grid%rad(k) - ear = rk**(nl-1)*EXP(-al*rk) + ear = rk**(nl - 1)*EXP(-al*rk) basis%bf(k, i, l) = pf*ear - basis%dbf(k, i, l) = pf*(REAL(nl-1, dp)/rk-al)*ear - basis%ddbf(k, i, l) = pf*(REAL((nl-2)*(nl-1), dp)/rk/rk & - -al*REAL(2*(nl-1), dp)/rk+al*al)*ear + basis%dbf(k, i, l) = pf*(REAL(nl - 1, dp)/rk - al)*ear + basis%ddbf(k, i, l) = pf*(REAL((nl - 2)*(nl - 1), dp)/rk/rk & + - al*REAL(2*(nl - 1), dp)/rk + al*al)*ear END DO END DO END DO @@ -740,9 +740,9 @@ SUBROUTINE init_atom_basis_default_pp(basis) rk = basis%grid%rad(k) ear = EXP(-al*basis%grid%rad(k)**2) basis%bf(k, i, l) = rk**l*ear - basis%dbf(k, i, l) = (REAL(l, dp)*rk**(l-1)-2._dp*al*rk**(l+1))*ear - basis%ddbf(k, i, l) = (REAL(l*(l-1), dp)*rk**(l-2)- & - 2._dp*al*REAL(2*l+1, dp)*rk**(l)+4._dp*al*rk**(l+2))*ear + basis%dbf(k, i, l) = (REAL(l, dp)*rk**(l - 1) - 2._dp*al*rk**(l + 1))*ear + basis%ddbf(k, i, l) = (REAL(l*(l - 1), dp)*rk**(l - 2) - & + 2._dp*al*REAL(2*l + 1, dp)*rk**(l) + 4._dp*al*rk**(l + 2))*ear END DO END DO END DO @@ -777,26 +777,26 @@ SUBROUTINE atom_basis_gridrep(basis, gbasis, r, rab) IF (ASSOCIATED(basis%am)) THEN n1 = SIZE(basis%am, 1) n2 = SIZE(basis%am, 2) - ALLOCATE (gbasis%am(n1, 0:n2-1)) + ALLOCATE (gbasis%am(n1, 0:n2 - 1)) gbasis%am = basis%am END IF IF (ASSOCIATED(basis%cm)) THEN n1 = SIZE(basis%cm, 1) n2 = SIZE(basis%cm, 2) n3 = SIZE(basis%cm, 3) - ALLOCATE (gbasis%cm(n1, n2, 0:n3-1)) + ALLOCATE (gbasis%cm(n1, n2, 0:n3 - 1)) gbasis%cm = basis%cm END IF IF (ASSOCIATED(basis%as)) THEN n1 = SIZE(basis%as, 1) n2 = SIZE(basis%as, 2) - ALLOCATE (gbasis%as(n1, 0:n2-1)) + ALLOCATE (gbasis%as(n1, 0:n2 - 1)) gbasis%as = basis%as END IF IF (ASSOCIATED(basis%ns)) THEN n1 = SIZE(basis%ns, 1) n2 = SIZE(basis%ns, 2) - ALLOCATE (gbasis%ns(n1, 0:n2-1)) + ALLOCATE (gbasis%ns(n1, 0:n2 - 1)) gbasis%ns = basis%ns END IF gbasis%eps_eig = basis%eps_eig @@ -840,9 +840,9 @@ SUBROUTINE atom_basis_gridrep(basis, gbasis, r, rab) rk = gbasis%grid%rad(k) ear = EXP(-al*gbasis%grid%rad(k)**2) gbasis%bf(k, i, l) = rk**l*ear - gbasis%dbf(k, i, l) = (REAL(l, dp)*rk**(l-1)-2._dp*al*rk**(l+1))*ear - gbasis%ddbf(k, i, l) = (REAL(l*(l-1), dp)*rk**(l-2)- & - 2._dp*al*REAL(2*l+1, dp)*rk**(l)+4._dp*al*rk**(l+2))*ear + gbasis%dbf(k, i, l) = (REAL(l, dp)*rk**(l - 1) - 2._dp*al*rk**(l + 1))*ear + gbasis%ddbf(k, i, l) = (REAL(l*(l - 1), dp)*rk**(l - 2) - & + 2._dp*al*REAL(2*l + 1, dp)*rk**(l) + 4._dp*al*rk**(l + 2))*ear END DO END DO END DO @@ -854,11 +854,11 @@ SUBROUTINE atom_basis_gridrep(basis, gbasis, r, rab) rk = gbasis%grid%rad(k) ear = EXP(-al*gbasis%grid%rad(k)**2) DO j = 1, gbasis%nbas(l) - gbasis%bf(k, j, l) = gbasis%bf(k, j, l)+rk**l*ear*gbasis%cm(i, j, l) + gbasis%bf(k, j, l) = gbasis%bf(k, j, l) + rk**l*ear*gbasis%cm(i, j, l) gbasis%dbf(k, j, l) = gbasis%dbf(k, j, l) & - +(REAL(l, dp)*rk**(l-1)-2._dp*al*rk**(l+1))*ear*gbasis%cm(i, j, l) - gbasis%ddbf(k, j, l) = gbasis%ddbf(k, j, l)+ & - (REAL(l*(l-1), dp)*rk**(l-2)-2._dp*al*REAL(2*l+1, dp)*rk**(l)+4._dp*al*rk**(l+2))* & + + (REAL(l, dp)*rk**(l - 1) - 2._dp*al*rk**(l + 1))*ear*gbasis%cm(i, j, l) + gbasis%ddbf(k, j, l) = gbasis%ddbf(k, j, l) + & + (REAL(l*(l - 1), dp)*rk**(l - 2) - 2._dp*al*REAL(2*l + 1, dp)*rk**(l) + 4._dp*al*rk**(l + 2))* & ear*gbasis%cm(i, j, l) END DO END DO @@ -872,11 +872,11 @@ SUBROUTINE atom_basis_gridrep(basis, gbasis, r, rab) pf = (2._dp*al)**nl*SQRT(2._dp*al/fac(2*nl)) DO k = 1, nr rk = gbasis%grid%rad(k) - ear = rk**(nl-1)*EXP(-al*rk) + ear = rk**(nl - 1)*EXP(-al*rk) gbasis%bf(k, i, l) = pf*ear - gbasis%dbf(k, i, l) = pf*(REAL(nl-1, dp)/rk-al)*ear - gbasis%ddbf(k, i, l) = pf*(REAL((nl-2)*(nl-1), dp)/rk/rk & - -al*REAL(2*(nl-1), dp)/rk+al*al)*ear + gbasis%dbf(k, i, l) = pf*(REAL(nl - 1, dp)/rk - al)*ear + gbasis%ddbf(k, i, l) = pf*(REAL((nl - 2)*(nl - 1), dp)/rk/rk & + - al*REAL(2*(nl - 1), dp)/rk + al*al)*ear END DO END DO END DO @@ -2090,12 +2090,12 @@ SUBROUTINE read_basis_set(element_symbol, basis, basis_set_name, basis_set_file, CPASSERT(npgf(iset) <= maxpri) nshell(iset) = 0 DO lshell = lmin(iset), lmax(iset) - nmin = n(iset)+lshell-lmin(iset) + nmin = n(iset) + lshell - lmin(iset) READ (line_att, *) ishell CALL remove_word(line_att) - nshell(iset) = nshell(iset)+ishell + nshell(iset) = nshell(iset) + ishell DO i = 1, ishell - l(nshell(iset)-ishell+i, iset) = lshell + l(nshell(iset) - ishell + i, iset) = lshell END DO END DO CPASSERT(LEN_TRIM(line_att) == 0) @@ -2122,8 +2122,8 @@ SUBROUTINE read_basis_set(element_symbol, basis, basis_set_name, basis_set_file, line2 = " "//line//" " symbol2 = " "//TRIM(symbol)//" " bsname2 = " "//TRIM(bsname)//" " - strlen1 = LEN_TRIM(symbol2)+1 - strlen2 = LEN_TRIM(bsname2)+1 + strlen1 = LEN_TRIM(symbol2) + 1 + strlen2 = LEN_TRIM(bsname2) + 1 IF ((INDEX(line2, symbol2(:strlen1)) > 0) .AND. & (INDEX(line2, bsname2(:strlen2)) > 0)) match = .TRUE. @@ -2140,11 +2140,11 @@ SUBROUTINE read_basis_set(element_symbol, basis, basis_set_name, basis_set_file, CPASSERT(npgf(iset) <= maxpri) nshell(iset) = 0 DO lshell = lmin(iset), lmax(iset) - nmin = n(iset)+lshell-lmin(iset) + nmin = n(iset) + lshell - lmin(iset) CALL parser_get_object(parser, ishell) - nshell(iset) = nshell(iset)+ishell + nshell(iset) = nshell(iset) + ishell DO i = 1, ishell - l(nshell(iset)-ishell+i, iset) = lshell + l(nshell(iset) - ishell + i, iset) = lshell END DO END DO DO ipgf = 1, npgf(iset) @@ -2173,11 +2173,11 @@ SUBROUTINE read_basis_set(element_symbol, basis, basis_set_name, basis_set_file, basis%nbas = 0 DO i = 1, nset DO j = lmin(i), MIN(lmax(i), lmat) - basis%nprim(j) = basis%nprim(j)+npgf(i) + basis%nprim(j) = basis%nprim(j) + npgf(i) END DO DO j = 1, nshell(i) k = l(j, i) - IF (k <= lmat) basis%nbas(k) = basis%nbas(k)+1 + IF (k <= lmat) basis%nbas(k) = basis%nbas(k) + 1 END DO END DO @@ -2194,25 +2194,25 @@ SUBROUTINE read_basis_set(element_symbol, basis, basis_set_name, basis_set_file, DO i = 1, nset IF (j >= lmin(i) .AND. j <= lmax(i)) THEN DO ipgf = 1, npgf(i) - basis%am(nj+ipgf, j) = zet(ipgf, i) + basis%am(nj + ipgf, j) = zet(ipgf, i) END DO DO ii = 1, nshell(i) IF (l(ii, i) == j) THEN - ns = ns+1 + ns = ns + 1 DO ipgf = 1, npgf(i) - basis%cm(nj+ipgf, ns, j) = gcc(ipgf, ii, i) + basis%cm(nj + ipgf, ns, j) = gcc(ipgf, ii, i) END DO END IF END DO - nj = nj+npgf(i) + nj = nj + npgf(i) END IF END DO END DO ! Normalization DO j = 0, lmat - expzet = 0.25_dp*REAL(2*j+3, dp) - prefac = SQRT(SQRT(pi)/2._dp**(j+2)*dfac(2*j+1)) + expzet = 0.25_dp*REAL(2*j + 3, dp) + prefac = SQRT(SQRT(pi)/2._dp**(j + 2)*dfac(2*j + 1)) DO ipgf = 1, basis%nprim(j) DO ii = 1, basis%nbas(j) gcca = basis%cm(ipgf, ii, j) @@ -2442,7 +2442,7 @@ SUBROUTINE read_gth_potential(element_symbol, potential, pseudo_name, pseudo_fil READ (line_att, *) elec_conf(l) CALL remove_word(line_att) DO WHILE (LEN_TRIM(line_att) /= 0) - l = l+1 + l = l + 1 READ (line_att, *) elec_conf(l) CALL remove_word(line_att) END DO @@ -2528,7 +2528,7 @@ SUBROUTINE read_gth_potential(element_symbol, potential, pseudo_name, pseudo_fil CALL remove_word(line_att) IF (nlmax > 0) THEN ! Load the parameter for nlmax non-local projectors - DO l = 0, nlmax-1 + DO l = 0, nlmax - 1 is_ok = cp_sll_val_next(list, val) CPASSERT(is_ok) CALL val_get(val, c_val=line_att) @@ -2548,7 +2548,7 @@ SUBROUTINE read_gth_potential(element_symbol, potential, pseudo_name, pseudo_fil READ (line_att, *) potential%hnl(i, i, l) CALL remove_word(line_att) END IF - DO j = i+1, potential%nl(l) + DO j = i + 1, potential%nl(l) READ (line_att, *) potential%hnl(i, j, l) potential%hnl(j, i, l) = potential%hnl(i, j, l) CALL remove_word(line_att) @@ -2572,8 +2572,8 @@ SUBROUTINE read_gth_potential(element_symbol, potential, pseudo_name, pseudo_fil line2 = " "//line//" " symbol2 = " "//TRIM(symbol)//" " apname2 = " "//TRIM(apname)//" " - strlen1 = LEN_TRIM(symbol2)+1 - strlen2 = LEN_TRIM(apname2)+1 + strlen1 = LEN_TRIM(symbol2) + 1 + strlen2 = LEN_TRIM(apname2) + 1 IF ((INDEX(line2, symbol2(:strlen1)) > 0) .AND. & (INDEX(line2, apname2(:strlen2)) > 0)) match = .TRUE. @@ -2583,7 +2583,7 @@ SUBROUTINE read_gth_potential(element_symbol, potential, pseudo_name, pseudo_fil l = 0 CALL parser_get_object(parser, elec_conf(l), newline=.TRUE.) DO WHILE (parser_test_next_token(parser) == "INT") - l = l+1 + l = l + 1 CALL parser_get_object(parser, elec_conf(l)) END DO potential%econf(0:lmat) = elec_conf(0:lmat) @@ -2648,7 +2648,7 @@ SUBROUTINE read_gth_potential(element_symbol, potential, pseudo_name, pseudo_fil CALL parser_get_object(parser, nlmax) IF (nlmax > 0) THEN ! Load the parameter for n non-local projectors - DO l = 0, nlmax-1 + DO l = 0, nlmax - 1 CALL parser_get_object(parser, potential%rcnl(l), newline=.TRUE.) CALL parser_get_object(parser, potential%nl(l)) DO i = 1, potential%nl(l) @@ -2657,7 +2657,7 @@ SUBROUTINE read_gth_potential(element_symbol, potential, pseudo_name, pseudo_fil ELSE CALL parser_get_object(parser, potential%hnl(i, i, l), newline=.TRUE.) END IF - DO j = i+1, potential%nl(l) + DO j = i + 1, potential%nl(l) CALL parser_get_object(parser, potential%hnl(i, j, l)) potential%hnl(j, i, l) = potential%hnl(i, j, l) END DO @@ -2736,7 +2736,7 @@ SUBROUTINE read_ecp_potential(element_symbol, potential, pseudo_name, pseudo_fil CALL remove_word(line_att) ! read number of electrons READ (line_att, *) nel - potential%zion = REAL(ncore-nel, KIND=dp) + potential%zion = REAL(ncore - nel, KIND=dp) ! local potential (mandatory block) is_ok = cp_sll_val_next(list, val) CPASSERT(is_ok) @@ -2745,7 +2745,7 @@ SUBROUTINE read_ecp_potential(element_symbol, potential, pseudo_name, pseudo_fil IF (.NOT. cp_sll_val_next(list, val)) EXIT CALL val_get(val, c_val=line_att) IF (INDEX(line_att, element_symbol) == 0) THEN - potential%nloc = potential%nloc+1 + potential%nloc = potential%nloc + 1 ic = potential%nloc READ (line_att, *) potential%nrloc(ic), potential%bloc(ic), potential%aloc(ic) ELSE @@ -2756,11 +2756,11 @@ SUBROUTINE read_ecp_potential(element_symbol, potential, pseudo_name, pseudo_fil DO CALL val_get(val, c_val=line_att) IF (INDEX(line_att, element_symbol) == 0) THEN - potential%npot(l) = potential%npot(l)+1 + potential%npot(l) = potential%npot(l) + 1 ic = potential%npot(l) READ (line_att, *) potential%nrpot(ic, l), potential%bpot(ic, l), potential%apot(ic, l) ELSE - potential%lmax = potential%lmax+1 + potential%lmax = potential%lmax + 1 l = potential%lmax END IF IF (.NOT. cp_sll_val_next(list, val)) EXIT @@ -2781,14 +2781,14 @@ SUBROUTINE read_ecp_potential(element_symbol, potential, pseudo_name, pseudo_fil CPASSERT(TRIM(line) == "NELEC") ! read number of electrons CALL parser_get_object(parser, nel) - potential%zion = REAL(ncore-nel, KIND=dp) + potential%zion = REAL(ncore - nel, KIND=dp) ! read local potential flag line " ul" CALL parser_get_object(parser, line, newline=.TRUE.) ! read local potential DO i = 1, 10 CALL parser_read_line(parser, 1) IF (parser_test_next_token(parser) == "STR") EXIT - potential%nloc = potential%nloc+1 + potential%nloc = potential%nloc + 1 ic = potential%nloc CALL parser_get_object(parser, potential%nrloc(ic)) CALL parser_get_object(parser, potential%bloc(ic)) @@ -2799,11 +2799,11 @@ SUBROUTINE read_ecp_potential(element_symbol, potential, pseudo_name, pseudo_fil CALL parser_get_object(parser, symbol) IF (symbol == element_symbol) THEN ! new l block - potential%lmax = potential%lmax+1 + potential%lmax = potential%lmax + 1 DO i = 1, 10 CALL parser_read_line(parser, 1) IF (parser_test_next_token(parser) == "STR") EXIT - potential%npot(l) = potential%npot(l)+1 + potential%npot(l) = potential%npot(l) + 1 ic = potential%npot(l) CALL parser_get_object(parser, potential%nrpot(ic, l)) CALL parser_get_object(parser, potential%bpot(ic, l)) @@ -2833,32 +2833,32 @@ SUBROUTINE read_ecp_potential(element_symbol, potential, pseudo_name, pseudo_fil CASE DEFAULT CPABORT("Unknown Core State") CASE (2) - potential%econf(0:3) = potential%econf(0:3)-ptable(2)%e_conv(0:3) + potential%econf(0:3) = potential%econf(0:3) - ptable(2)%e_conv(0:3) CASE (10) - potential%econf(0:3) = potential%econf(0:3)-ptable(10)%e_conv(0:3) + potential%econf(0:3) = potential%econf(0:3) - ptable(10)%e_conv(0:3) CASE (18) - potential%econf(0:3) = potential%econf(0:3)-ptable(18)%e_conv(0:3) + potential%econf(0:3) = potential%econf(0:3) - ptable(18)%e_conv(0:3) CASE (28) - potential%econf(0:3) = potential%econf(0:3)-ptable(18)%e_conv(0:3) - potential%econf(2) = potential%econf(2)-10 + potential%econf(0:3) = potential%econf(0:3) - ptable(18)%e_conv(0:3) + potential%econf(2) = potential%econf(2) - 10 CASE (36) - potential%econf(0:3) = potential%econf(0:3)-ptable(36)%e_conv(0:3) + potential%econf(0:3) = potential%econf(0:3) - ptable(36)%e_conv(0:3) CASE (46) - potential%econf(0:3) = potential%econf(0:3)-ptable(36)%e_conv(0:3) - potential%econf(2) = potential%econf(2)-10 + potential%econf(0:3) = potential%econf(0:3) - ptable(36)%e_conv(0:3) + potential%econf(2) = potential%econf(2) - 10 CASE (54) - potential%econf(0:3) = potential%econf(0:3)-ptable(54)%e_conv(0:3) + potential%econf(0:3) = potential%econf(0:3) - ptable(54)%e_conv(0:3) CASE (60) - potential%econf(0:3) = potential%econf(0:3)-ptable(36)%e_conv(0:3) - potential%econf(2) = potential%econf(2)-10 - potential%econf(3) = potential%econf(3)-14 + potential%econf(0:3) = potential%econf(0:3) - ptable(36)%e_conv(0:3) + potential%econf(2) = potential%econf(2) - 10 + potential%econf(3) = potential%econf(3) - 14 CASE (68) - potential%econf(0:3) = potential%econf(0:3)-ptable(54)%e_conv(0:3) - potential%econf(3) = potential%econf(3)-14 + potential%econf(0:3) = potential%econf(0:3) - ptable(54)%e_conv(0:3) + potential%econf(3) = potential%econf(3) - 14 CASE (78) - potential%econf(0:3) = potential%econf(0:3)-ptable(54)%e_conv(0:3) - potential%econf(2) = potential%econf(2)-10 - potential%econf(3) = potential%econf(3)-14 + potential%econf(0:3) = potential%econf(0:3) - ptable(54)%e_conv(0:3) + potential%econf(2) = potential%econf(2) - 10 + potential%econf(3) = potential%econf(3) - 14 END SELECT ! CPASSERT(ALL(potential%econf >= 0)) @@ -2880,9 +2880,9 @@ FUNCTION atom_compare_grids(grid1, grid2) RESULT(is_equal) is_equal = .TRUE. IF (grid1%nr == grid2%nr) THEN DO i = 1, grid2%nr - dr = ABS(grid1%rad(i)-grid2%rad(i)) - dw = ABS(grid1%wr(i)-grid2%wr(i)) - IF (dr+dw > 1.0e-12_dp) THEN + dr = ABS(grid1%rad(i) - grid2%rad(i)) + dw = ABS(grid1%wr(i) - grid2%wr(i)) + IF (dr + dw > 1.0e-12_dp) THEN is_equal = .FALSE. EXIT END IF diff --git a/src/atom_upf.F b/src/atom_upf.F index ad505288a7..958996e502 100644 --- a/src/atom_upf.F +++ b/src/atom_upf.F @@ -117,7 +117,7 @@ SUBROUTINE atom_read_upf(pot, upf_filename, read_header) ! Ignore json potentials as SIRIUS will parse those on its own. l = LEN_TRIM(pot%filename) - IF (pot%filename(l-4:l) == '.json') RETURN + IF (pot%filename(l - 4:l) == '.json') RETURN CALL atom_read_upf_v2(pot, upf_filename, readall) @@ -126,39 +126,39 @@ SUBROUTINE atom_read_upf(pot, upf_filename, read_header) symbol = ADJUSTL(TRIM(pot%symbol)) CALL get_ptable_info(symbol, number=ncore) pot%econf(0:3) = ptable(ncore)%e_conv(0:3) - nel = NINT(ncore-pot%zion) + nel = NINT(ncore - pot%zion) SELECT CASE (nel) CASE DEFAULT CPABORT("Unknown Core State") CASE (0) ! no core electron CASE (2) - pot%econf(0:3) = pot%econf(0:3)-ptable(2)%e_conv(0:3) + pot%econf(0:3) = pot%econf(0:3) - ptable(2)%e_conv(0:3) CASE (10) - pot%econf(0:3) = pot%econf(0:3)-ptable(10)%e_conv(0:3) + pot%econf(0:3) = pot%econf(0:3) - ptable(10)%e_conv(0:3) CASE (18) - pot%econf(0:3) = pot%econf(0:3)-ptable(18)%e_conv(0:3) + pot%econf(0:3) = pot%econf(0:3) - ptable(18)%e_conv(0:3) CASE (28) - pot%econf(0:3) = pot%econf(0:3)-ptable(18)%e_conv(0:3) - pot%econf(2) = pot%econf(2)-10 + pot%econf(0:3) = pot%econf(0:3) - ptable(18)%e_conv(0:3) + pot%econf(2) = pot%econf(2) - 10 CASE (36) - pot%econf(0:3) = pot%econf(0:3)-ptable(36)%e_conv(0:3) + pot%econf(0:3) = pot%econf(0:3) - ptable(36)%e_conv(0:3) CASE (46) - pot%econf(0:3) = pot%econf(0:3)-ptable(36)%e_conv(0:3) - pot%econf(2) = pot%econf(2)-10 + pot%econf(0:3) = pot%econf(0:3) - ptable(36)%e_conv(0:3) + pot%econf(2) = pot%econf(2) - 10 CASE (54) - pot%econf(0:3) = pot%econf(0:3)-ptable(54)%e_conv(0:3) + pot%econf(0:3) = pot%econf(0:3) - ptable(54)%e_conv(0:3) CASE (60) - pot%econf(0:3) = pot%econf(0:3)-ptable(36)%e_conv(0:3) - pot%econf(2) = pot%econf(2)-10 - pot%econf(3) = pot%econf(3)-14 + pot%econf(0:3) = pot%econf(0:3) - ptable(36)%e_conv(0:3) + pot%econf(2) = pot%econf(2) - 10 + pot%econf(3) = pot%econf(3) - 14 CASE (68) - pot%econf(0:3) = pot%econf(0:3)-ptable(54)%e_conv(0:3) - pot%econf(3) = pot%econf(3)-14 + pot%econf(0:3) = pot%econf(0:3) - ptable(54)%e_conv(0:3) + pot%econf(3) = pot%econf(3) - 14 CASE (78) - pot%econf(0:3) = pot%econf(0:3)-ptable(54)%e_conv(0:3) - pot%econf(2) = pot%econf(2)-10 - pot%econf(3) = pot%econf(3)-14 + pot%econf(0:3) = pot%econf(0:3) - ptable(54)%e_conv(0:3) + pot%econf(2) = pot%econf(2) - 10 + pot%econf(3) = pot%econf(3) - 14 END SELECT ! CPASSERT(ALL(pot%econf >= 0)) @@ -299,7 +299,7 @@ SUBROUTINE upf_info_section(parser, pot) line = TRIM(parser%buffer%input_lines(iline)) CALL parser_get_object(parser, string) IF (string(1:10) == "") EXIT - icount = icount+1 + icount = icount + 1 IF (icount > pot%maxinfo) CYCLE pot%info(icount) = line END DO @@ -483,7 +483,7 @@ SUBROUTINE upf_mesh_section(parser, pot) CPASSERT(.NOT. at_end) ELSE IF (parser_test_next_token(parser) == "FLT") THEN CALL parser_get_object(parser, pot%r(icount)) - icount = icount+1 + icount = icount + 1 END IF IF (icount > ms) EXIT END DO @@ -520,7 +520,7 @@ SUBROUTINE upf_mesh_section(parser, pot) CPASSERT(.NOT. at_end) ELSE IF (parser_test_next_token(parser) == "FLT") THEN CALL parser_get_object(parser, pot%rab(icount)) - icount = icount+1 + icount = icount + 1 END IF IF (icount > ms) EXIT END DO @@ -583,7 +583,7 @@ SUBROUTINE upf_nlcc_section(parser, pot, options) CPASSERT(.NOT. at_end) ELSE IF (parser_test_next_token(parser) == "FLT") THEN CALL parser_get_object(parser, pot%rho_nlcc(icount)) - icount = icount+1 + icount = icount + 1 END IF IF (icount > ms) EXIT END DO @@ -645,7 +645,7 @@ SUBROUTINE upf_local_section(parser, pot, options) CPASSERT(.NOT. at_end) ELSE IF (parser_test_next_token(parser) == "FLT") THEN CALL parser_get_object(parser, pot%vlocal(icount)) - icount = icount+1 + icount = icount + 1 END IF IF (icount > ms) EXIT END DO @@ -688,7 +688,7 @@ SUBROUTINE upf_nonlocal_section(parser, pot) CALL parser_get_object(parser, string, lower_to_upper=.TRUE.) IF (string(1:8) == " ms) EXIT END DO @@ -769,10 +769,10 @@ SUBROUTINE upf_nonlocal_section(parser, pot) CALL parser_get_next_line(parser, 1, at_end) CPASSERT(.NOT. at_end) ELSE IF (parser_test_next_token(parser) == "FLT") THEN - i1 = (icount-1)/nbeta+1 - i2 = MOD(icount-1, nbeta)+1 + i1 = (icount - 1)/nbeta + 1 + i2 = MOD(icount - 1, nbeta) + 1 CALL parser_get_object(parser, pot%dion(i1, i2)) - icount = icount+1 + icount = icount + 1 END IF IF (icount > ms) EXIT END DO @@ -804,7 +804,7 @@ SUBROUTINE upf_semilocal_section(parser, pot) m = pot%mesh_size lmax = pot%l_max - ALLOCATE (pot%vsemi(m, lmax+1)) + ALLOCATE (pot%vsemi(m, lmax + 1)) pot%vsemi = 0.0_dp ib = 0 @@ -814,10 +814,10 @@ SUBROUTINE upf_semilocal_section(parser, pot) CALL parser_get_object(parser, string, lower_to_upper=.TRUE.) IF (string(1:7) == " found") END SELECT END DO - i1 = la+1 + i1 = la + 1 icount = 1 DO IF (parser_test_next_token(parser) == "EOL") THEN @@ -848,7 +848,7 @@ SUBROUTINE upf_semilocal_section(parser, pot) CPASSERT(.NOT. at_end) ELSE IF (parser_test_next_token(parser) == "FLT") THEN CALL parser_get_object(parser, pot%vsemi(icount, i1)) - icount = icount+1 + icount = icount + 1 END IF IF (icount > ms) EXIT END DO diff --git a/src/atom_utils.F b/src/atom_utils.F index 528a2b6177..3831a2afbf 100644 --- a/src/atom_utils.F +++ b/src/atom_utils.F @@ -125,8 +125,8 @@ SUBROUTINE atom_set_occupation(ostring, occupation, wfnocc, multiplicity) IF (INDEX(ostring(is), "(") /= 0) THEN i1 = INDEX(ostring(is), "(") i2 = INDEX(ostring(is), ")") - CPASSERT((i2-i1-1 > 0) .AND. (i2-i1-1 < 3)) - elem = ostring(is) (i1+1:i2-1) + CPASSERT((i2 - i1 - 1 > 0) .AND. (i2 - i1 - 1 < 3)) + elem = ostring(is) (i1 + 1:i2 - 1) IF (INDEX(elem, "HS") /= 0) THEN mult = -2 !High spin ELSE IF (INDEX(elem, "LS") /= 0) THEN @@ -134,23 +134,23 @@ SUBROUTINE atom_set_occupation(ostring, occupation, wfnocc, multiplicity) ELSE READ (elem, *) mult END IF - is = is+1 + is = is + 1 END IF END IF IF (is <= no) THEN - IF (INDEX(ostring(is), "CORE") /= 0) is = is+1 !Pseudopotential detected + IF (INDEX(ostring(is), "CORE") /= 0) is = is + 1 !Pseudopotential detected END IF IF (is <= no) THEN - IF (INDEX(ostring(is), "none") /= 0) is = is+1 !no electrons, used with CORE + IF (INDEX(ostring(is), "none") /= 0) is = is + 1 !no electrons, used with CORE END IF IF (is <= no) THEN IF (INDEX(ostring(is), "[") /= 0) THEN ! core occupation from element [XX] i1 = INDEX(ostring(is), "[") i2 = INDEX(ostring(is), "]") - CPASSERT((i2-i1-1 > 0) .AND. (i2-i1-1 < 3)) - elem = ostring(is) (i1+1:i2-1) + CPASSERT((i2 - i1 - 1 > 0) .AND. (i2 - i1 - 1 < 3)) + elem = ostring(is) (i1 + 1:i2 - 1) ielem = 0 DO k = 1, nelem IF (elem == ptable(k)%symbol) THEN @@ -160,15 +160,15 @@ SUBROUTINE atom_set_occupation(ostring, occupation, wfnocc, multiplicity) END DO CPASSERT(ielem /= 0) DO l = 0, MIN(lmat, UBOUND(ptable(ielem)%e_conv, 1)) - el = 2._dp*(2._dp*REAL(l, dp)+1._dp) + el = 2._dp*(2._dp*REAL(l, dp) + 1._dp) e0 = ptable(ielem)%e_conv(l) DO k = 1, 10 occupation(l, k) = MIN(el, e0) - e0 = e0-el + e0 = e0 - el IF (e0 <= 0._dp) EXIT END DO END DO - is = is+1 + is = is + 1 END IF END IF @@ -180,42 +180,42 @@ SUBROUTINE atom_set_occupation(ostring, occupation, wfnocc, multiplicity) jp = INDEX(pstring, "P") jd = INDEX(pstring, "D") jf = INDEX(pstring, "F") - CPASSERT(js+jp+jd+jf > 0) + CPASSERT(js + jp + jd + jf > 0) IF (js > 0) THEN - CPASSERT(jp+jd+jf == 0) - READ (pstring(1:js-1), *) n - READ (pstring(js+1:), *) oo + CPASSERT(jp + jd + jf == 0) + READ (pstring(1:js - 1), *) n + READ (pstring(js + 1:), *) oo CPASSERT(n > 0) CPASSERT(oo >= 0._dp) CPASSERT(occupation(0, n) == 0) occupation(0, n) = oo END IF IF (jp > 0) THEN - CPASSERT(js+jd+jf == 0) - READ (pstring(1:jp-1), *) n - READ (pstring(jp+1:), *) oo + CPASSERT(js + jd + jf == 0) + READ (pstring(1:jp - 1), *) n + READ (pstring(jp + 1:), *) oo CPASSERT(n > 1) CPASSERT(oo >= 0._dp) - CPASSERT(occupation(1, n-1) == 0) - occupation(1, n-1) = oo + CPASSERT(occupation(1, n - 1) == 0) + occupation(1, n - 1) = oo END IF IF (jd > 0) THEN - CPASSERT(js+jp+jf == 0) - READ (pstring(1:jd-1), *) n - READ (pstring(jd+1:), *) oo + CPASSERT(js + jp + jf == 0) + READ (pstring(1:jd - 1), *) n + READ (pstring(jd + 1:), *) oo CPASSERT(n > 2) CPASSERT(oo >= 0._dp) - CPASSERT(occupation(2, n-2) == 0) - occupation(2, n-2) = oo + CPASSERT(occupation(2, n - 2) == 0) + occupation(2, n - 2) = oo END IF IF (jf > 0) THEN - CPASSERT(js+jp+jd == 0) - READ (pstring(1:jf-1), *) n - READ (pstring(jf+1:), *) oo + CPASSERT(js + jp + jd == 0) + READ (pstring(1:jf - 1), *) n + READ (pstring(jf + 1:), *) oo CPASSERT(n > 3) CPASSERT(oo >= 0._dp) - CPASSERT(occupation(3, n-3) == 0) - occupation(3, n-3) = oo + CPASSERT(occupation(3, n - 3) == 0) + occupation(3, n - 3) = oo END IF END DO @@ -225,7 +225,7 @@ SUBROUTINE atom_set_occupation(ostring, occupation, wfnocc, multiplicity) k = 0 DO i = 1, 10 IF (occupation(l, i) /= 0._dp) THEN - k = k+1 + k = k + 1 wfnocc(l, k) = occupation(l, i) END IF END DO @@ -236,10 +236,10 @@ SUBROUTINE atom_set_occupation(ostring, occupation, wfnocc, multiplicity) ! count open shells js = 0 DO l = 0, lmat - k = 2*(2*l+1) + k = 2*(2*l + 1) DO i = 1, 10 IF (wfnocc(l, i) /= 0._dp .AND. wfnocc(l, i) /= REAL(k, dp)) THEN - js = js+1 + js = js + 1 i1 = l i2 = i END IF @@ -255,10 +255,10 @@ SUBROUTINE atom_set_occupation(ostring, occupation, wfnocc, multiplicity) l = i1 i = i2 k = NINT(wfnocc(l, i)) - IF (k > (2*l+1)) k = 2*(2*l+1)-k - IF (mult == -2) mult = k+1 - IF (mult == -3) mult = MOD(k, 2)+1 - CPASSERT(MOD(k+1-mult, 2) == 0) + IF (k > (2*l + 1)) k = 2*(2*l + 1) - k + IF (mult == -2) mult = k + 1 + IF (mult == -3) mult = MOD(k, 2) + 1 + CPASSERT(MOD(k + 1 - mult, 2) == 0) END IF IF (js > 1 .AND. mult /= -2) THEN CPASSERT(mult == -2) @@ -306,7 +306,7 @@ FUNCTION get_maxn_occ(occupation) RESULT(maxn) maxn = 0 DO l = 0, lmat DO k = 1, 10 - IF (occupation(l, k) /= 0._dp) maxn(l) = maxn(l)+1 + IF (occupation(l, k) /= 0._dp) maxn(l) = maxn(l) + 1 END DO END DO @@ -341,7 +341,7 @@ SUBROUTINE atom_denmat(pmat, wfn, nbas, occ, maxl, maxn) DO i = 1, MIN(n, maxn(l)) DO k = 1, nbas(l) DO j = 1, nbas(l) - pmat(j, k, l) = pmat(j, k, l)+occ(l, i)*wfn(j, i, l)*wfn(k, i, l) + pmat(j, k, l) = pmat(j, k, l) + occ(l, i)*wfn(j, i, l)*wfn(k, i, l) END DO END DO END DO @@ -392,19 +392,19 @@ SUBROUTINE atom_density(density, pmat, basis, maxl, typ, rr) ff = pmat(i, j, l) IF (i /= j) ff = 2._dp*pmat(i, j, l) IF (my_typ == "RHO") THEN - density(:) = density(:)+ff*basis%bf(:, i, l)*basis%bf(:, j, l) + density(:) = density(:) + ff*basis%bf(:, i, l)*basis%bf(:, j, l) ELSE IF (my_typ == "DER") THEN - density(:) = density(:)+ff*basis%dbf(:, i, l)*basis%bf(:, j, l) & - +ff*basis%bf(:, i, l)*basis%dbf(:, j, l) + density(:) = density(:) + ff*basis%dbf(:, i, l)*basis%bf(:, j, l) & + + ff*basis%bf(:, i, l)*basis%dbf(:, j, l) ELSE IF (my_typ == "KIN") THEN - density(:) = density(:)+0.5_dp*ff*( & - basis%dbf(:, i, l)*basis%dbf(:, j, l)+ & - REAL(l*(l+1), dp)*basis%bf(:, i, l)*basis%bf(:, j, l)/rr(:)) + density(:) = density(:) + 0.5_dp*ff*( & + basis%dbf(:, i, l)*basis%dbf(:, j, l) + & + REAL(l*(l + 1), dp)*basis%bf(:, i, l)*basis%bf(:, j, l)/rr(:)) ELSE IF (my_typ == "LAP") THEN - density(:) = density(:)+ff*basis%ddbf(:, i, l)*basis%bf(:, j, l) & - +ff*basis%bf(:, i, l)*basis%ddbf(:, j, l) & - +2._dp*ff*basis%dbf(:, i, l)*basis%bf(:, j, l)/rr(:) & - +2._dp*ff*basis%bf(:, i, l)*basis%dbf(:, j, l)/rr(:) + density(:) = density(:) + ff*basis%ddbf(:, i, l)*basis%bf(:, j, l) & + + ff*basis%bf(:, i, l)*basis%ddbf(:, j, l) & + + 2._dp*ff*basis%dbf(:, i, l)*basis%bf(:, j, l)/rr(:) & + + 2._dp*ff*basis%bf(:, i, l)*basis%dbf(:, j, l)/rr(:) ELSE CPABORT("") END IF @@ -557,11 +557,11 @@ SUBROUTINE atom_read_external_density(density, atom, iw) DO ir = 1, nr READ (extunit, *) rr, density(ir) - IF (ABS(rr-atom%basis%grid%rad(ir)) .GT. atom%zmpgrid_tol) THEN + IF (ABS(rr - atom%basis%grid%rad(ir)) .GT. atom%zmpgrid_tol) THEN IF (iw > 0) WRITE (iw, fmt="(' ZMP | ERROR! Grid points do not coincide: ')") IF (iw > 0) WRITE (iw, fmt='(" ZMP |",T20,"R_out[bohr]",T36,"R_in[bohr]",T61,"R_diff[bohr]")') IF (iw > 0) WRITE (iw, fmt='(" ZMP |",T14,E24.15,T39,E24.15,T64,E24.15)') & - rr, atom%basis%grid%rad(ir), ABS(rr-atom%basis%grid%rad(ir)) + rr, atom%basis%grid%rad(ir), ABS(rr - atom%basis%grid%rad(ir)) CPABORT("") ENDIF ENDDO @@ -646,11 +646,11 @@ SUBROUTINE atom_read_external_vxc(vxc, atom, iw) ENDIF DO ir = 1, nr READ (extunit, *) rr, vxc(ir) - IF (ABS(rr-atom%basis%grid%rad(ir)) .GT. atom%zmpvxcgrid_tol) THEN + IF (ABS(rr - atom%basis%grid%rad(ir)) .GT. atom%zmpvxcgrid_tol) THEN IF (iw > 0) WRITE (iw, fmt="(' ZMP | ERROR! Grid points do not coincide: ')") IF (iw > 0) WRITE (iw, fmt='(" ZMP |",T20,"R_out[bohr]",T36,"R_in[bohr]",T61,"R_diff[bohr]")') IF (iw > 0) WRITE (iw, fmt='(" ZMP |",T14,E24.15,T39,E24.15,T64,E24.15)') & - rr, atom%basis%grid%rad(ir), ABS(rr-atom%basis%grid%rad(ir)) + rr, atom%basis%grid%rad(ir), ABS(rr - atom%basis%grid%rad(ir)) CPABORT("") ENDIF ENDDO @@ -687,7 +687,7 @@ SUBROUTINE atom_orbital_charge(charge, wfn, rcov, l, basis) DO i = 1, n DO j = 1, n ff = wfn(i)*wfn(j) - den(1:m) = den(1:m)+ff*basis%bf(1:m, i, l)*basis%bf(1:m, j, l) + den(1:m) = den(1:m) + ff*basis%bf(1:m, i, l)*basis%bf(1:m, j, l) END DO END DO DO i = 1, m @@ -743,20 +743,20 @@ SUBROUTINE atom_core_density(corden, potential, typ, rr) DO j = 1, potential%gth_pot%nct_nlcc(i) cval = potential%gth_pot%cval_nlcc(j, i) IF (my_typ == "RHO") THEN - corden(:) = corden(:)+fe(:)*rc**(2*j-2)*cval + corden(:) = corden(:) + fe(:)*rc**(2*j - 2)*cval ELSE IF (my_typ == "DER") THEN - corden(:) = corden(:)-fe(:)*rc**(2*j-1)*cval/a + corden(:) = corden(:) - fe(:)*rc**(2*j - 1)*cval/a IF (j > 1) THEN - corden(:) = corden(:)+REAL(2*j-2, dp)*fe(:)*rc**(2*j-3)*cval/a + corden(:) = corden(:) + REAL(2*j - 2, dp)*fe(:)*rc**(2*j - 3)*cval/a END IF ELSE IF (my_typ == "LAP") THEN fb = 2._dp*cval/a - corden(:) = corden(:)-fb*fe(:)/rr(:)*rc**(2*j-1) - corden(:) = corden(:)+fe(:)*rc**(2*j)*cval/a2 + corden(:) = corden(:) - fb*fe(:)/rr(:)*rc**(2*j - 1) + corden(:) = corden(:) + fe(:)*rc**(2*j)*cval/a2 IF (j > 1) THEN - corden(:) = corden(:)+fb*REAL(2*j-2, dp)*fe(:)/rr(:)*rc**(2*j-3) - corden(:) = corden(:)+REAL((2*j-2)*(2*j-3), dp)*fe(:)*rc**(2*j-4)*cval/a2 - corden(:) = corden(:)-REAL(2*j-2, dp)*fe(:)*rc**(2*j-2)*cval/a2 + corden(:) = corden(:) + fb*REAL(2*j - 2, dp)*fe(:)/rr(:)*rc**(2*j - 3) + corden(:) = corden(:) + REAL((2*j - 2)*(2*j - 3), dp)*fe(:)*rc**(2*j - 4)*cval/a2 + corden(:) = corden(:) - REAL(2*j - 2, dp)*fe(:)*rc**(2*j - 2)*cval/a2 END IF ELSE CPABORT("") @@ -774,7 +774,7 @@ SUBROUTINE atom_core_density(corden, potential, typ, rr) ALLOCATE (rhoc(m), rval(m)) IF (reverse) THEN DO i = 1, m - rval(i) = rr(m-i+1) + rval(i) = rr(m - i + 1) END DO ELSE rval(1:m) = rr(1:m) @@ -793,11 +793,11 @@ SUBROUTINE atom_core_density(corden, potential, typ, rr) END IF IF (reverse) THEN DO i = 1, m - rval(i) = rr(m-i+1) - corden(i) = corden(i)+rhoc(m-i+1) + rval(i) = rr(m - i + 1) + corden(i) = corden(i) + rhoc(m - i + 1) END DO ELSE - corden(1:m) = corden(1:m)+rhoc(1:m) + corden(1:m) = corden(1:m) + rhoc(1:m) END IF DEALLOCATE (rhoc, rval) END IF @@ -838,7 +838,7 @@ SUBROUTINE atom_local_potential(locpot, gthpot, rr) n = gthpot%ncl fe(:) = EXP(-0.5_dp*rc(:)*rc(:)) DO i = 1, n - locpot(:) = locpot(:)+fe(:)*rc**(2*i-2)*gthpot%cl(i) + locpot(:) = locpot(:) + fe(:)*rc**(2*i - 2)*gthpot%cl(i) END DO IF (gthpot%lpotextended) THEN DO j = 1, gthpot%nexp_lpot @@ -847,7 +847,7 @@ SUBROUTINE atom_local_potential(locpot, gthpot, rr) fe(:) = EXP(-0.5_dp*rc(:)*rc(:)) n = gthpot%nct_lpot(j) DO i = 1, n - locpot(:) = locpot(:)+fe(:)*rc**(2*i-2)*gthpot%cval_lpot(i, j) + locpot(:) = locpot(:) + fe(:)*rc**(2*i - 2)*gthpot%cval_lpot(i, j) END DO END DO END IF @@ -883,12 +883,12 @@ SUBROUTINE atom_orbital_max(rmax, wfn, rcov, l, basis) dorb = 0._dp DO i = 1, n ff = wfn(i) - dorb(1:m) = dorb(1:m)+ff*basis%dbf(1:m, i, l) + dorb(1:m) = dorb(1:m) + ff*basis%dbf(1:m, i, l) END DO rmax = -1._dp - DO i = 1, m-1 + DO i = 1, m - 1 IF (basis%grid%rad(i) < 2*rcov) THEN - IF (dorb(i)*dorb(i+1) < 0._dp) THEN + IF (dorb(i)*dorb(i + 1) < 0._dp) THEN rmax = MAX(rmax, basis%grid%rad(i)) END IF END IF @@ -926,11 +926,11 @@ SUBROUTINE atom_orbital_nodes(node, wfn, rcov, l, basis) orb = 0._dp DO i = 1, n ff = wfn(i) - orb(1:m) = orb(1:m)+ff*basis%bf(1:m, i, l) + orb(1:m) = orb(1:m) + ff*basis%bf(1:m, i, l) END DO - DO i = 1, m-1 + DO i = 1, m - 1 IF (basis%grid%rad(i) < rcov) THEN - IF (orb(i)*orb(i+1) < 0._dp) node = node+1 + IF (orb(i)*orb(i + 1) < 0._dp) node = node + 1 END IF END DO DEALLOCATE (orb) @@ -956,7 +956,7 @@ SUBROUTINE atom_wfnr0(value, wfn, basis) m = MAXVAL(MINLOC(basis%grid%rad)) n = basis%nbas(0) DO i = 1, n - value = value+wfn(i)*basis%bf(m, i, 0) + value = value + wfn(i)*basis%bf(m, i, 0) END DO END SUBROUTINE atom_wfnr0 @@ -1130,9 +1130,9 @@ SUBROUTINE coulomb_potential_numeric(cpot, density, grid) ! test that grid is decreasing CPASSERT(r(1) > r(nc)) DO i = 1, nc - cpot(i) = int1/r(i)+int2 - int1 = int1-fourpi*density(i)*wr(i) - int2 = int2+fourpi*density(i)*wr(i)/r(i) + cpot(i) = int1/r(i) + int2 + int1 = int1 - fourpi*density(i)*wr(i) + int2 = int2 + fourpi*density(i)*wr(i)/r(i) END DO END SUBROUTINE coulomb_potential_numeric @@ -1180,24 +1180,24 @@ SUBROUTINE coulomb_potential_analytic(cpot, pmat, basis, grid, maxl) IF (i /= j) ff = 2._dp*ff a = basis%am(i, l) b = basis%am(j, l) - sab = SQRT(a+b) - oab = rootpi/(a+b)**(l+1.5_dp)*ff + sab = SQRT(a + b) + oab = rootpi/(a + b)**(l + 1.5_dp)*ff z(:) = sab*grid%rad(:) DO k = 1, SIZE(erfa) erfa(k) = oab*erf(z(k))/grid%rad(k) END DO - expa(:) = EXP(-z(:)**2)*ff/(a+b)**(l+1) + expa(:) = EXP(-z(:)**2)*ff/(a + b)**(l + 1) SELECT CASE (l) CASE DEFAULT CPABORT("") CASE (0) - cpot(:) = cpot(:)+0.25_dp*erfa(:) + cpot(:) = cpot(:) + 0.25_dp*erfa(:) CASE (1) - cpot(:) = cpot(:)+0.375_dp*erfa(:)-0.25_dp*expa(:) + cpot(:) = cpot(:) + 0.375_dp*erfa(:) - 0.25_dp*expa(:) CASE (2) - cpot(:) = cpot(:)+0.9375_dp*erfa(:)-expa(:)*(0.875_dp+0.25_dp*z(:)**2) + cpot(:) = cpot(:) + 0.9375_dp*erfa(:) - expa(:)*(0.875_dp + 0.25_dp*z(:)**2) CASE (3) - cpot(:) = cpot(:)+3.28125_dp*erfa(:)-expa(:)*(3.5625_dp+1.375_dp*z(:)**2+0.25*z(:)**4) + cpot(:) = cpot(:) + 3.28125_dp*erfa(:) - expa(:)*(3.5625_dp + 1.375_dp*z(:)**2 + 0.25*z(:)**4) END SELECT END DO END DO @@ -1215,24 +1215,24 @@ SUBROUTINE coulomb_potential_analytic(cpot, pmat, basis, grid, maxl) IF (i /= j) ff = 2._dp*ff a = basis%am(i, l) b = basis%am(j, l) - sab = SQRT(a+b) - oab = rootpi/(a+b)**(l+1.5_dp)*ff + sab = SQRT(a + b) + oab = rootpi/(a + b)**(l + 1.5_dp)*ff z(:) = sab*grid%rad(:) DO k = 1, SIZE(erfa) erfa(k) = oab*erf(z(k))/grid%rad(k) END DO - expa(:) = EXP(-z(:)**2)*ff/(a+b)**(l+1) + expa(:) = EXP(-z(:)**2)*ff/(a + b)**(l + 1) SELECT CASE (l) CASE DEFAULT CPABORT("") CASE (0) - cpot(:) = cpot(:)+0.25_dp*erfa(:) + cpot(:) = cpot(:) + 0.25_dp*erfa(:) CASE (1) - cpot(:) = cpot(:)+0.375_dp*erfa(:)-0.25_dp*expa(:) + cpot(:) = cpot(:) + 0.375_dp*erfa(:) - 0.25_dp*expa(:) CASE (2) - cpot(:) = cpot(:)+0.9375_dp*erfa(:)-expa(:)*(0.875_dp+0.25_dp*z(:)**2) + cpot(:) = cpot(:) + 0.9375_dp*erfa(:) - expa(:)*(0.875_dp + 0.25_dp*z(:)**2) CASE (3) - cpot(:) = cpot(:)+3.28125_dp*erfa(:)-expa(:)*(3.5625_dp+1.375_dp*z(:)**2+0.25*z(:)**4) + cpot(:) = cpot(:) + 3.28125_dp*erfa(:) - expa(:)*(3.5625_dp + 1.375_dp*z(:)**2 + 0.25*z(:)**4) END SELECT END DO END DO @@ -1291,11 +1291,11 @@ SUBROUTINE exchange_numeric(kmat, state, occ, wfn, basis) orb = 0._dp DO i = 1, norb DO k = 1, nbas - orb(:, i) = orb(:, i)+wfn(k, i, lbc)*basis%bf(:, k, lbc) + orb(:, i) = orb(:, i) + wfn(k, i, lbc)*basis%bf(:, k, lbc) END DO END DO - DO nu = ABS(lad-lbc), lad+lbc, 2 - almn = arho(-lad+lbc+nu)*arho(lad-lbc+nu)*arho(lad+lbc-nu)/(REAL(lad+lbc+nu+1, dp)*arho(lad+lbc+nu)) + DO nu = ABS(lad - lbc), lad + lbc, 2 + almn = arho(-lad + lbc + nu)*arho(lad - lbc + nu)*arho(lad + lbc - nu)/(REAL(lad + lbc + nu + 1, dp)*arho(lad + lbc + nu)) almn = -0.5_dp*almn DO ia = 1, basis%nbas(lad) @@ -1303,7 +1303,7 @@ SUBROUTINE exchange_numeric(kmat, state, occ, wfn, basis) nai(:) = orb(:, i)*basis%bf(:, ia, lad) CALL potential_numeric(cpot, nai, nu, basis%grid) DO ib = 1, basis%nbas(lad) - kmat(ia, ib, lad) = kmat(ia, ib, lad)+almn*occ(lbc, i)* & + kmat(ia, ib, lad) = kmat(ia, ib, lad) + almn*occ(lbc, i)* & integrate_grid(cpot, orb(:, i), basis%bf(:, ib, lad), basis%grid) END DO END DO @@ -1368,11 +1368,11 @@ SUBROUTINE exchange_semi_analytic(kmat, state, occ, wfn, basis) orb = 0._dp DO i = 1, norb DO k = 1, nbas - orb(:, i) = orb(:, i)+wfn(k, i, lbc)*basis%bf(:, k, lbc) + orb(:, i) = orb(:, i) + wfn(k, i, lbc)*basis%bf(:, k, lbc) END DO END DO - DO nu = ABS(lad-lbc), lad+lbc, 2 - almn = arho(-lad+lbc+nu)*arho(lad-lbc+nu)*arho(lad+lbc-nu)/(REAL(lad+lbc+nu+1, dp)*arho(lad+lbc+nu)) + DO nu = ABS(lad - lbc), lad + lbc, 2 + almn = arho(-lad + lbc + nu)*arho(lad - lbc + nu)*arho(lad + lbc - nu)/(REAL(lad + lbc + nu + 1, dp)*arho(lad + lbc + nu)) almn = -0.5_dp*almn ! calculate potential for basis function pair (lad,lbc) pot = 0._dp @@ -1381,10 +1381,10 @@ SUBROUTINE exchange_semi_analytic(kmat, state, occ, wfn, basis) DO i = 1, norb cpot = 0._dp DO k = 1, nbas - cpot(:) = cpot(:)+pot(:, ia, k)*wfn(k, i, lbc) + cpot(:) = cpot(:) + pot(:, ia, k)*wfn(k, i, lbc) END DO DO ib = 1, basis%nbas(lad) - kmat(ia, ib, lad) = kmat(ia, ib, lad)+almn*occ(lbc, i)* & + kmat(ia, ib, lad) = kmat(ia, ib, lad) + almn*occ(lbc, i)* & integrate_grid(cpot, orb(:, i), basis%bf(:, ib, lad), basis%grid) END DO END DO @@ -1428,14 +1428,14 @@ SUBROUTINE potential_numeric(cpot, density, nu, grid) int1 = integrate_grid(density, r**nu, grid) int2 = 0._dp - cpot(nc:) = int1/r(nc:)**(nu+1) + cpot(nc:) = int1/r(nc:)**(nu + 1) ! test that grid is decreasing CPASSERT(r(1) > r(nc)) DO i = 1, nc - cpot(i) = int1/r(i)**(nu+1)+int2*r(i)**nu - int1 = int1-r(i)**(nu)*density(i)*wr(i) - int2 = int2+density(i)*wr(i)/r(i)**(nu+1) + cpot(i) = int1/r(i)**(nu + 1) + int2*r(i)**nu + int1 = int1 - r(i)**(nu)*density(i)*wr(i) + int2 = int2 + density(i)*wr(i)/r(i)**(nu + 1) END DO END SUBROUTINE potential_numeric @@ -1465,7 +1465,7 @@ SUBROUTINE potential_analytic(cpot, la, lb, nu, basis) m = SIZE(cpot, 1) ALLOCATE (erfa(1:m), expa(1:m), z(1:m)) - ll = la+lb + ll = la + lb cpot = 0._dp @@ -1477,14 +1477,14 @@ SUBROUTINE potential_analytic(cpot, la, lb, nu, basis) DO j = 1, basis%nbas(lb) a = basis%am(i, la) b = basis%am(j, lb) - sab = SQRT(a+b) - oab = dfac(ll+nu+1)*rootpi/(sab**(ll+2))/(2._dp**((ll+nu)/2+2)) + sab = SQRT(a + b) + oab = dfac(ll + nu + 1)*rootpi/(sab**(ll + 2))/(2._dp**((ll + nu)/2 + 2)) z(:) = sab*basis%grid%rad(:) DO k = 1, SIZE(erfa) - erfa(k) = oab*erf(z(k))/z(k)**(nu+1) + erfa(k) = oab*erf(z(k))/z(k)**(nu + 1) END DO cpot(:, i, j) = erfa(:) - expa(:) = EXP(-z(:)**2)/(sab**(ll+2))/(2._dp**((ll+nu)/2+2)) + expa(:) = EXP(-z(:)**2)/(sab**(ll + 2))/(2._dp**((ll + nu)/2 + 2)) SELECT CASE (ll) CASE DEFAULT CPABORT("") @@ -1492,62 +1492,62 @@ SUBROUTINE potential_analytic(cpot, la, lb, nu, basis) CPASSERT(nu == 0) CASE (1) CPASSERT(nu == 1) - cpot(:, i, j) = cpot(:, i, j)-6._dp*expa(:)/z(:) + cpot(:, i, j) = cpot(:, i, j) - 6._dp*expa(:)/z(:) CASE (2) SELECT CASE (nu) CASE DEFAULT CPABORT("") CASE (0) - cpot(:, i, j) = cpot(:, i, j)-2._dp*expa(:) + cpot(:, i, j) = cpot(:, i, j) - 2._dp*expa(:) CASE (2) - cpot(:, i, j) = cpot(:, i, j)-expa(:)*(20._dp+30._dp/z(:)**2) + cpot(:, i, j) = cpot(:, i, j) - expa(:)*(20._dp + 30._dp/z(:)**2) END SELECT CASE (3) SELECT CASE (nu) CASE DEFAULT CPABORT("") CASE (1) - cpot(:, i, j) = cpot(:, i, j)-expa(:)*(12._dp*z(:)+30._dp/z(:)) + cpot(:, i, j) = cpot(:, i, j) - expa(:)*(12._dp*z(:) + 30._dp/z(:)) CASE (3) - cpot(:, i, j) = cpot(:, i, j)-expa(:)*(56._dp*z(:)+140._dp/z(:)+210._dp*z(:)**3) + cpot(:, i, j) = cpot(:, i, j) - expa(:)*(56._dp*z(:) + 140._dp/z(:) + 210._dp*z(:)**3) END SELECT CASE (4) SELECT CASE (nu) CASE DEFAULT CPABORT("") CASE (0) - cpot(:, i, j) = cpot(:, i, j)-expa(:)*(4._dp*z(:)**2+14._dp) + cpot(:, i, j) = cpot(:, i, j) - expa(:)*(4._dp*z(:)**2 + 14._dp) CASE (2) - cpot(:, i, j) = cpot(:, i, j)-expa(:)*(40._dp*z(:)**2+140._dp+210._dp/z(:)**2) + cpot(:, i, j) = cpot(:, i, j) - expa(:)*(40._dp*z(:)**2 + 140._dp + 210._dp/z(:)**2) CASE (4) - cpot(:, i, j) = cpot(:, i, j)-expa(:)*(144._dp*z(:)**2+504._dp+1260._dp/z(:)**2+1890._dp/z(:)**4) + cpot(:, i, j) = cpot(:, i, j) - expa(:)*(144._dp*z(:)**2 + 504._dp + 1260._dp/z(:)**2 + 1890._dp/z(:)**4) END SELECT CASE (5) SELECT CASE (nu) CASE DEFAULT CPABORT("") CASE (1) - cpot(:, i, j) = cpot(:, i, j)-expa(:)*(24._dp*z(:)**3+108._dp*z(:)+210._dp/z(:)) + cpot(:, i, j) = cpot(:, i, j) - expa(:)*(24._dp*z(:)**3 + 108._dp*z(:) + 210._dp/z(:)) CASE (3) - cpot(:, i, j) = cpot(:, i, j)-expa(:)*(112._dp*z(:)**3+504._dp*z(:)+1260._dp/z(:)+1890._dp/z(:)**3) + cpot(:, i, j) = cpot(:, i, j) - expa(:)*(112._dp*z(:)**3 + 504._dp*z(:) + 1260._dp/z(:) + 1890._dp/z(:)**3) CASE (5) - cpot(:, i, j) = cpot(:, i, j)-expa(:)*(352._dp*z(:)**3+1584._dp*z(:)+5544._dp/z(:)+ & - 13860._dp/z(:)**3+20790._dp/z(:)**5) + cpot(:, i, j) = cpot(:, i, j) - expa(:)*(352._dp*z(:)**3 + 1584._dp*z(:) + 5544._dp/z(:) + & + 13860._dp/z(:)**3 + 20790._dp/z(:)**5) END SELECT CASE (6) SELECT CASE (nu) CASE DEFAULT CPABORT("") CASE (0) - cpot(:, i, j) = cpot(:, i, j)-expa(:)*(8._dp*z(:)**4+44._dp*z(:)**2+114._dp) + cpot(:, i, j) = cpot(:, i, j) - expa(:)*(8._dp*z(:)**4 + 44._dp*z(:)**2 + 114._dp) CASE (2) - cpot(:, i, j) = cpot(:, i, j)-expa(:)*(80._dp*z(:)**4+440._dp*z(:)**2+1260._dp+1896._dp/z(:)**2) + cpot(:, i, j) = cpot(:, i, j) - expa(:)*(80._dp*z(:)**4 + 440._dp*z(:)**2 + 1260._dp + 1896._dp/z(:)**2) CASE (4) - cpot(:, i, j) = cpot(:, i, j)-expa(:)*(288._dp*z(:)**4+1584._dp*z(:)**2+5544._dp+ & - 13860._dp/z(:)**2+20790._dp/z(:)**4) + cpot(:, i, j) = cpot(:, i, j) - expa(:)*(288._dp*z(:)**4 + 1584._dp*z(:)**2 + 5544._dp + & + 13860._dp/z(:)**2 + 20790._dp/z(:)**4) CASE (6) - cpot(:, i, j) = cpot(:, i, j)-expa(:)*(832._dp*z(:)**4+4576._dp*z(:)**2+20592._dp+ & - 72072._dp/z(:)**2+180180._dp/z(:)**4+270270._dp/z(:)**6) + cpot(:, i, j) = cpot(:, i, j) - expa(:)*(832._dp*z(:)**4 + 4576._dp*z(:)**2 + 20592._dp + & + 72072._dp/z(:)**2 + 180180._dp/z(:)**4 + 270270._dp/z(:)**6) END SELECT END SELECT END DO @@ -1557,13 +1557,13 @@ SUBROUTINE potential_analytic(cpot, la, lb, nu, basis) DO j = 1, basis%nprim(lb) a = basis%am(i, la) b = basis%am(j, lb) - sab = SQRT(a+b) - oab = dfac(ll+nu+1)*rootpi/sab**(ll+2)/2._dp**((ll+nu)/2+2) + sab = SQRT(a + b) + oab = dfac(ll + nu + 1)*rootpi/sab**(ll + 2)/2._dp**((ll + nu)/2 + 2) z(:) = sab*basis%grid%rad(:) DO k = 1, SIZE(erfa) - erfa(k) = oab*erf(z(k))/z(k)**(nu+1) + erfa(k) = oab*erf(z(k))/z(k)**(nu + 1) END DO - expa(:) = EXP(-z(:)**2)/sab**(ll+2)/2._dp**((ll+nu)/2+2) + expa(:) = EXP(-z(:)**2)/sab**(ll + 2)/2._dp**((ll + nu)/2 + 2) SELECT CASE (ll) CASE DEFAULT CPABORT("") @@ -1571,67 +1571,67 @@ SUBROUTINE potential_analytic(cpot, la, lb, nu, basis) CPASSERT(nu == 0) CASE (1) CPASSERT(nu == 1) - erfa(:) = erfa(:)-6._dp*expa(:)/z(:) + erfa(:) = erfa(:) - 6._dp*expa(:)/z(:) CASE (2) SELECT CASE (nu) CASE DEFAULT CPABORT("") CASE (0) - erfa(:) = erfa(:)-2._dp*expa(:) + erfa(:) = erfa(:) - 2._dp*expa(:) CASE (2) - erfa(:) = erfa(:)-expa(:)*(20._dp+30._dp/z(:)**2) + erfa(:) = erfa(:) - expa(:)*(20._dp + 30._dp/z(:)**2) END SELECT CASE (3) SELECT CASE (nu) CASE DEFAULT CPABORT("") CASE (1) - erfa(:) = erfa(:)-expa(:)*(12._dp*z(:)+30._dp/z(:)) + erfa(:) = erfa(:) - expa(:)*(12._dp*z(:) + 30._dp/z(:)) CASE (3) - erfa(:) = erfa(:)-expa(:)*(56._dp*z(:)+140._dp/z(:)+210._dp*z(:)**3) + erfa(:) = erfa(:) - expa(:)*(56._dp*z(:) + 140._dp/z(:) + 210._dp*z(:)**3) END SELECT CASE (4) SELECT CASE (nu) CASE DEFAULT CPABORT("") CASE (0) - erfa(:) = erfa(:)-expa(:)*(4._dp*z(:)**2+14._dp) + erfa(:) = erfa(:) - expa(:)*(4._dp*z(:)**2 + 14._dp) CASE (2) - erfa(:) = erfa(:)-expa(:)*(40._dp*z(:)**2+140._dp+210._dp/z(:)**2) + erfa(:) = erfa(:) - expa(:)*(40._dp*z(:)**2 + 140._dp + 210._dp/z(:)**2) CASE (4) - erfa(:) = erfa(:)-expa(:)*(144._dp*z(:)**2+504._dp+1260._dp/z(:)**2+1890._dp/z(:)**4) + erfa(:) = erfa(:) - expa(:)*(144._dp*z(:)**2 + 504._dp + 1260._dp/z(:)**2 + 1890._dp/z(:)**4) END SELECT CASE (5) SELECT CASE (nu) CASE DEFAULT CPABORT("") CASE (1) - erfa(:) = erfa(:)-expa(:)*(24._dp*z(:)**3+108._dp*z(:)+210._dp/z(:)) + erfa(:) = erfa(:) - expa(:)*(24._dp*z(:)**3 + 108._dp*z(:) + 210._dp/z(:)) CASE (3) - erfa(:) = erfa(:)-expa(:)*(112._dp*z(:)**3+504._dp*z(:)+1260._dp/z(:)+1890._dp/z(:)**3) + erfa(:) = erfa(:) - expa(:)*(112._dp*z(:)**3 + 504._dp*z(:) + 1260._dp/z(:) + 1890._dp/z(:)**3) CASE (5) - erfa(:) = erfa(:)-expa(:)*(352._dp*z(:)**3+1584._dp*z(:)+5544._dp/z(:)+ & - 13860._dp/z(:)**3+20790._dp/z(:)**5) + erfa(:) = erfa(:) - expa(:)*(352._dp*z(:)**3 + 1584._dp*z(:) + 5544._dp/z(:) + & + 13860._dp/z(:)**3 + 20790._dp/z(:)**5) END SELECT CASE (6) SELECT CASE (nu) CASE DEFAULT CPABORT("") CASE (0) - erfa(:) = erfa(:)-expa(:)*(8._dp*z(:)**4+44._dp*z(:)**2+114._dp) + erfa(:) = erfa(:) - expa(:)*(8._dp*z(:)**4 + 44._dp*z(:)**2 + 114._dp) CASE (2) - erfa(:) = erfa(:)-expa(:)*(80._dp*z(:)**4+440._dp*z(:)**2+1260._dp+1896._dp/z(:)**2) + erfa(:) = erfa(:) - expa(:)*(80._dp*z(:)**4 + 440._dp*z(:)**2 + 1260._dp + 1896._dp/z(:)**2) CASE (4) - erfa(:) = erfa(:)-expa(:)*(288._dp*z(:)**4+1584._dp*z(:)**2+5544._dp+ & - 13860._dp/z(:)**2+20790._dp/z(:)**4) + erfa(:) = erfa(:) - expa(:)*(288._dp*z(:)**4 + 1584._dp*z(:)**2 + 5544._dp + & + 13860._dp/z(:)**2 + 20790._dp/z(:)**4) CASE (6) - erfa(:) = erfa(:)-expa(:)*(832._dp*z(:)**4+4576._dp*z(:)**2+20592._dp+ & - 72072._dp/z(:)**2+180180._dp/z(:)**4+270270._dp/z(:)**6) + erfa(:) = erfa(:) - expa(:)*(832._dp*z(:)**4 + 4576._dp*z(:)**2 + 20592._dp + & + 72072._dp/z(:)**2 + 180180._dp/z(:)**4 + 270270._dp/z(:)**6) END SELECT END SELECT DO k = 1, basis%nbas(la) DO l = 1, basis%nbas(lb) - cpot(:, k, l) = cpot(:, k, l)+erfa(:)*basis%cm(i, k, la)*basis%cm(j, l, lb) + cpot(:, k, l) = cpot(:, k, l) + erfa(:)*basis%cm(i, k, la)*basis%cm(j, l, lb) END DO END DO END DO @@ -1686,7 +1686,7 @@ SUBROUTINE numpot_matrix(imat, cpot, basis, derivatives) n = basis%nbas(l) DO i = 1, n DO j = i, n - imat(i, j, l) = imat(i, j, l)+ & + imat(i, j, l) = imat(i, j, l) + & integrate_grid(cpot, basis%bf(:, i, l), basis%bf(:, j, l), basis%grid) imat(j, i, l) = imat(i, j, l) END DO @@ -1697,9 +1697,9 @@ SUBROUTINE numpot_matrix(imat, cpot, basis, derivatives) n = basis%nbas(l) DO i = 1, n DO j = i, n - imat(i, j, l) = imat(i, j, l)+ & + imat(i, j, l) = imat(i, j, l) + & integrate_grid(cpot, basis%dbf(:, i, l), basis%bf(:, j, l), basis%grid) - imat(i, j, l) = imat(i, j, l)+ & + imat(i, j, l) = imat(i, j, l) + & integrate_grid(cpot, basis%bf(:, i, l), basis%dbf(:, j, l), basis%grid) imat(j, i, l) = imat(i, j, l) END DO @@ -1710,7 +1710,7 @@ SUBROUTINE numpot_matrix(imat, cpot, basis, derivatives) n = basis%nbas(l) DO i = 1, n DO j = i, n - imat(i, j, l) = imat(i, j, l)+ & + imat(i, j, l) = imat(i, j, l) + & integrate_grid(cpot, basis%dbf(:, i, l), basis%dbf(:, j, l), basis%grid) imat(j, i, l) = imat(i, j, l) END DO @@ -1758,25 +1758,25 @@ SUBROUTINE ceri_contract(jmat, erint, pmat, nsize, all_nu) n1 = nsize(l1) DO l2 = 0, l1 n2 = nsize(l2) - ll = ll+1 + ll = ll + 1 ij1 = 0 DO i1 = 1, n1 DO j1 = i1, n1 - ij1 = ij1+1 + ij1 = ij1 + 1 f1 = 1._dp IF (i1 /= j1) f1 = 2._dp ij2 = 0 DO i2 = 1, n2 DO j2 = i2, n2 - ij2 = ij2+1 + ij2 = ij2 + 1 f2 = 1._dp IF (i2 /= j2) f2 = 2._dp eint = erint(ll)%int(ij1, ij2) IF (l1 == l2) THEN - jmat(i1, j1, l1) = jmat(i1, j1, l1)+f2*pmat(i2, j2, l2)*eint + jmat(i1, j1, l1) = jmat(i1, j1, l1) + f2*pmat(i2, j2, l2)*eint ELSE - jmat(i1, j1, l1) = jmat(i1, j1, l1)+f2*pmat(i2, j2, l2)*eint - jmat(i2, j2, l2) = jmat(i2, j2, l2)+f1*pmat(i1, j1, l1)*eint + jmat(i1, j1, l1) = jmat(i1, j1, l1) + f2*pmat(i2, j2, l2)*eint + jmat(i2, j2, l2) = jmat(i2, j2, l2) + f1*pmat(i1, j1, l1)*eint END IF END DO END DO @@ -1784,7 +1784,7 @@ SUBROUTINE ceri_contract(jmat, erint, pmat, nsize, all_nu) END DO IF (have_all_nu) THEN ! skip integral blocks with nu/=0 - ll = ll+l2 + ll = ll + l2 END IF END DO END DO @@ -1833,28 +1833,28 @@ SUBROUTINE eeri_contract(kmat, erint, pmat, nsize) n1 = nsize(l1) DO l2 = 0, l1 n2 = nsize(l2) - DO nu = ABS(l1-l2), l1+l2, 2 - almn = arho(-l1+l2+nu)*arho(l1-l2+nu)*arho(l1+l2-nu)/(REAL(l1+l2+nu+1, dp)*arho(l1+l2+nu)) + DO nu = ABS(l1 - l2), l1 + l2, 2 + almn = arho(-l1 + l2 + nu)*arho(l1 - l2 + nu)*arho(l1 + l2 - nu)/(REAL(l1 + l2 + nu + 1, dp)*arho(l1 + l2 + nu)) almn = -0.5_dp*almn - ll = ll+1 + ll = ll + 1 ij1 = 0 DO i1 = 1, n1 DO j1 = i1, n1 - ij1 = ij1+1 + ij1 = ij1 + 1 f1 = 1._dp IF (i1 /= j1) f1 = 2._dp ij2 = 0 DO i2 = 1, n2 DO j2 = i2, n2 - ij2 = ij2+1 + ij2 = ij2 + 1 f2 = 1._dp IF (i2 /= j2) f2 = 2._dp eint = erint(ll)%int(ij1, ij2) IF (l1 == l2) THEN - kmat(i1, j1, l1) = kmat(i1, j1, l1)+f2*almn*pmat(i2, j2, l2)*eint + kmat(i1, j1, l1) = kmat(i1, j1, l1) + f2*almn*pmat(i2, j2, l2)*eint ELSE - kmat(i1, j1, l1) = kmat(i1, j1, l1)+f2*almn*pmat(i2, j2, l2)*eint - kmat(i2, j2, l2) = kmat(i2, j2, l2)+f1*almn*pmat(i1, j1, l1)*eint + kmat(i1, j1, l1) = kmat(i1, j1, l1) + f2*almn*pmat(i2, j2, l2)*eint + kmat(i2, j2, l2) = kmat(i2, j2, l2) + f1*almn*pmat(i1, j1, l1)*eint END IF END DO END DO @@ -1910,7 +1910,7 @@ SUBROUTINE err_matrix(emat, demax, kmat, pmat, umat, upmat, nval, nbs) tpmat(1:m, 1:m) = MATMUL(TRANSPOSE(umat(1:n, 1:m, l)), MATMUL(pmat(1:n, 1:n, l), umat(1:n, 1:m, l))) tpmat(1:m, 1:m) = MATMUL(upmat(1:m, 1:m, l), MATMUL(tpmat(1:m, 1:m), upmat(1:m, 1:m, l))) - emat(1:m, 1:m, l) = MATMUL(tkmat(1:m, 1:m), tpmat(1:m, 1:m))-MATMUL(tpmat(1:m, 1:m), tkmat(1:m, 1:m)) + emat(1:m, 1:m, l) = MATMUL(tkmat(1:m, 1:m), tpmat(1:m, 1:m)) - MATMUL(tpmat(1:m, 1:m), tkmat(1:m, 1:m)) DEALLOCATE (tkmat, tpmat) END IF @@ -1952,20 +1952,20 @@ SUBROUTINE slater_density(density1, density2, zcore, state, grid) DO l = 0, lmat mo = state%maxn_occ(l) IF (SUM(state%core(l, :)) == 0) THEN - CPASSERT(ns >= l+mo) + CPASSERT(ns >= l + mo) DO counter = 1, mo - ne(l+1, l+counter) = NINT(state%occ(l, counter)) + ne(l + 1, l + counter) = NINT(state%occ(l, counter)) ENDDO ELSE mc = mm(l) ! number of levels in the core CPASSERT(SUM(state%occ(l, 1:mc)) == 0) - CPASSERT(ns >= l+mc) + CPASSERT(ns >= l + mc) DO counter = 1, mc - ne(l+1, l+counter) = NINT(state%core(l, counter)) + ne(l + 1, l + counter) = NINT(state%core(l, counter)) ENDDO - CPASSERT(ns >= l+mc+mo) - DO counter = mc+1, mc+mo - ne(l+1, l+counter) = NINT(state%occ(l, counter)) + CPASSERT(ns >= l + mc + mo) + DO counter = mc + 1, mc + mo + ne(l + 1, l + counter) = NINT(state%occ(l, counter)) ENDDO END IF END DO @@ -1975,14 +1975,14 @@ SUBROUTINE slater_density(density1, density2, zcore, state, grid) DO l = 0, state%maxl_occ DO i = 1, SIZE(state%occ, 2) IF (state%occ(l, i) > 0._dp) THEN - n = i+l + n = i + l a = srules(zcore, ne, n, l) - pf = 1._dp/SQRT(fac(2*n))*(2._dp*a)**(n+0.5_dp) + pf = 1._dp/SQRT(fac(2*n))*(2._dp*a)**(n + 0.5_dp) IF (state%multiplicity == -1) THEN - density1(:) = density1(:)+state%occ(l, i)/fourpi*(grid%rad(:)**(n-1)*EXP(-a*grid%rad(:))*pf)**2 + density1(:) = density1(:) + state%occ(l, i)/fourpi*(grid%rad(:)**(n - 1)*EXP(-a*grid%rad(:))*pf)**2 ELSE - density1(:) = density1(:)+state%occa(l, i)/fourpi*(grid%rad(:)**(n-1)*EXP(-a*grid%rad(:))*pf)**2 - density2(:) = density2(:)+state%occb(l, i)/fourpi*(grid%rad(:)**(n-1)*EXP(-a*grid%rad(:))*pf)**2 + density1(:) = density1(:) + state%occa(l, i)/fourpi*(grid%rad(:)**(n - 1)*EXP(-a*grid%rad(:))*pf)**2 + density2(:) = density2(:) + state%occb(l, i)/fourpi*(grid%rad(:)**(n - 1)*EXP(-a*grid%rad(:))*pf)**2 END IF END IF END DO @@ -2016,9 +2016,9 @@ SUBROUTINE wigner_slater_functional(rho, vxc) ex = -0.7385588_dp*rho(i)**0.333333333_dp vx = 1.333333333_dp*ex rs = (3._dp/fourpi/rho(i))**0.333333333_dp - ec = -0.88_dp/(rs+7.8_dp) - vc = ec*(1._dp+rs/(3._dp*(rs+7.8_dp))) - vxc(i) = vx+vc + ec = -0.88_dp/(rs + 7.8_dp) + vc = ec*(1._dp + rs/(3._dp*(rs + 7.8_dp))) + vxc(i) = vx + vc END IF END DO @@ -2099,8 +2099,8 @@ SUBROUTINE get_rho0(atom, rho0) m0 = MAXVAL(MINLOC(atom%basis%grid%rad)) IF (m0 == nr) THEN - m1 = m0-1 - m2 = m0-2 + m1 = m0 - 1 + m2 = m0 - 2 ELSE IF (m0 == 1) THEN m1 = 2 m2 = 3 @@ -2110,8 +2110,8 @@ SUBROUTINE get_rho0(atom, rho0) r0 = atom%basis%grid%rad(m0) r1 = atom%basis%grid%rad(m1) r2 = atom%basis%grid%rad(m2) - w0 = r1/(r1-r0) - w1 = 1-w0 + w0 = r1/(r1 - r0) + w1 = 1 - w0 IF (spinpol) THEN ALLOCATE (rho(nr, 2)) @@ -2120,10 +2120,10 @@ SUBROUTINE get_rho0(atom, rho0) IF (nlcc) THEN xfun = 0.0_dp CALL atom_core_density(xfun(:), atom%potential, typ="RHO", rr=atom%basis%grid%rad) - rho(:, 1) = rho(:, 1)+0.5_dp*xfun(:) - rho(:, 2) = rho(:, 2)+0.5_dp*xfun(:) + rho(:, 1) = rho(:, 1) + 0.5_dp*xfun(:) + rho(:, 2) = rho(:, 2) + 0.5_dp*xfun(:) END IF - rho(:, 1) = rho(:, 1)+rho(:, 2) + rho(:, 1) = rho(:, 1) + rho(:, 2) ELSE ALLOCATE (rho(nr, 1)) CALL atom_density(rho(:, 1), atom%orbitals%pmat, atom%basis, atom%state%maxl_occ, typ="RHO") @@ -2135,7 +2135,7 @@ SUBROUTINE get_rho0(atom, rho0) d1 = rho(m1, 1) d2 = rho(m2, 1) - rho0 = w0*d0+w1*d1 + rho0 = w0*d0 + w1*d1 rho0 = MAX(rho0, 0.0_dp) DEALLOCATE (rho) @@ -2167,7 +2167,7 @@ SUBROUTINE atom_condnumber(basis, crad, iw) CALL init_spherical_harmonics(lmat, 0) cnum = 0.0_dp DO i = 1, 9 - ci = 2.0_dp*(0.85_dp+i*0.05_dp) + ci = 2.0_dp*(0.85_dp + i*0.05_dp) rad(i) = crad*ci CALL atom_basis_condnum(basis, rad(i), cnum(i)) WRITE (iw, '(A,F15.3,T50,A,F14.4)') " Lattice constant:", & @@ -2208,13 +2208,13 @@ SUBROUTINE atom_completeness(basis, zv, iw) nelem = 0 nelem(0:3) = ptable(zv)%e_conv(0:3) DO l = 0, lmat - ll = 2*(2*l+1) + ll = 2*(2*l + 1) DO i = 1, 7 IF (nelem(l) >= ll) THEN - ne(l+1, i) = ll - nelem(l) = nelem(l)-ll + ne(l + 1, i) = ll + nelem(l) = nelem(l) - ll ELSE IF (nelem(l) > 0) THEN - ne(l+1, i) = nelem(l) + ne(l + 1, i) = nelem(l) nelem(l) = 0 ELSE EXIT @@ -2225,13 +2225,13 @@ SUBROUTINE atom_completeness(basis, zv, iw) nlmin = 1 nlmax = 1 DO l = 0, lmat - nlmin(l) = l+1 + nlmin(l) = l + 1 DO i = 1, 7 - IF (ne(l+1, i) > 0) THEN - nlmax(l) = i+l + IF (ne(l + 1, i) > 0) THEN + nlmax(l) = i + l END IF END DO - nlmax(l) = MAX(nlmax(l), nlmin(l)+1) + nlmax(l) = MAX(nlmax(l), nlmin(l) + 1) END DO ! Slater exponents @@ -2239,15 +2239,15 @@ SUBROUTINE atom_completeness(basis, zv, iw) DO l = 0, lmat sse(1) = 0.05_dp sse(2) = 10.0_dp - DO i = l+1, 7 - sexp(l+1, i) = srules(zv, ne, i, l) - IF (ne(l+1, i-l) > 0) THEN - sse(1) = MAX(sse(1), sexp(l+1, i)) - sse(2) = MIN(sse(2), sexp(l+1, i)) + DO i = l + 1, 7 + sexp(l + 1, i) = srules(zv, ne, i, l) + IF (ne(l + 1, i - l) > 0) THEN + sse(1) = MAX(sse(1), sexp(l + 1, i)) + sse(2) = MIN(sse(2), sexp(l + 1, i)) END IF END DO DO i = 1, 10 - snl(l, i) = ABS(2._dp*sse(1)-0.5_dp*sse(2))/9._dp*REAL(i-1, KIND=dp)+0.5_dp*MIN(sse(1), sse(2)) + snl(l, i) = ABS(2._dp*sse(1) - 0.5_dp*sse(2))/9._dp*REAL(i - 1, KIND=dp) + 0.5_dp*MIN(sse(1), sse(2)) END DO END DO @@ -2263,13 +2263,13 @@ SUBROUTINE atom_completeness(basis, zv, iw) al = snl(l, i) nl = nlmin(l) pf = (2._dp*al)**nl*SQRT(2._dp*al/fac(2*nl)) - sfun(1:nr) = pf*basis%grid%rad(1:nr)**(nl-1)*EXP(-al*basis%grid%rad(1:nr)) + sfun(1:nr) = pf*basis%grid%rad(1:nr)**(nl - 1)*EXP(-al*basis%grid%rad(1:nr)) DO j = 1, basis%nbas(l) sint(i, 1, j, l) = SUM(sfun(1:nr)*basis%bf(1:nr, j, l)*basis%grid%wr(1:nr)) END DO nl = nlmax(l) pf = (2._dp*al)**nl*SQRT(2._dp*al/fac(2*nl)) - sfun(1:nr) = pf*basis%grid%rad(1:nr)**(nl-1)*EXP(-al*basis%grid%rad(1:nr)) + sfun(1:nr) = pf*basis%grid%rad(1:nr)**(nl - 1)*EXP(-al*basis%grid%rad(1:nr)) DO j = 1, basis%nbas(l) sint(i, 2, j, l) = SUM(sfun(1:nr)*basis%bf(1:nr, j, l)*basis%grid%wr(1:nr)) END DO @@ -2347,7 +2347,7 @@ SUBROUTINE atom_basis_condnum(basis, rad, cnum) ! total number of basis functions nbas = 0 DO l = 0, lmat - nbas = nbas+basis%nbas(l)*(2*l+1) + nbas = nbas + basis%nbas(l)*(2*l + 1) END DO ALLOCATE (smat(nbas, nbas), ibptr(nbas, 0:lmat)) @@ -2356,8 +2356,8 @@ SUBROUTINE atom_basis_condnum(basis, rad, cnum) na = 0 DO l = 0, lmat DO ia = 1, basis%nbas(l) - ibptr(ia, l) = na+1 - na = na+(2*l+1) + ibptr(ia, l) = na + 1 + na = na + (2*l + 1) END DO END DO @@ -2366,12 +2366,12 @@ SUBROUTINE atom_basis_condnum(basis, rad, cnum) basis%basis_type == CGTO_BASIS) THEN DO la = 0, lmat na = basis%nprim(la) - nna = 2*la+1 + nna = 2*la + 1 IF (na == 0) CYCLE zeta => basis%am(:, la) DO lb = 0, lmat nb = basis%nprim(lb) - nnb = 2*lb+1 + nnb = 2*lb + 1 IF (nb == 0) CYCLE zetb => basis%am(:, lb) DO ia = 1, na @@ -2382,21 +2382,21 @@ SUBROUTINE atom_basis_condnum(basis, rad, cnum) r1 = exp_radius(la, zeta(ia), reps, 1.0_dp) r2 = exp_radius(lb, zetb(ib), reps, 1.0_dp) rmax = MAX(2._dp*r1, 2._dp*r2) - imax = INT(rmax/rad)+1 + imax = INT(rmax/rad) + 1 END IF IF (imax > 1) THEN CALL overlap_ab_sp(la, zeta(ia), lb, zetb(ib), rad, sab) IF (basis%basis_type == GTO_BASIS) THEN ja = ibptr(ia, la) jb = ibptr(ib, lb) - smat(ja:ja+nna-1, jb:jb+nnb-1) = smat(ja:ja+nna-1, jb:jb+nnb-1)+sab(1:nna, 1:nnb) + smat(ja:ja + nna - 1, jb:jb + nnb - 1) = smat(ja:ja + nna - 1, jb:jb + nnb - 1) + sab(1:nna, 1:nnb) ELSEIF (basis%basis_type == CGTO_BASIS) THEN DO ka = 1, basis%nbas(la) DO kb = 1, basis%nbas(lb) ja = ibptr(ka, la) jb = ibptr(kb, lb) - smat(ja:ja+nna-1, jb:jb+nnb-1) = smat(ja:ja+nna-1, jb:jb+nnb-1)+ & - sab(1:nna, 1:nnb)*basis%cm(ia, ka, la)*basis%cm(ib, kb, lb) + smat(ja:ja + nna - 1, jb:jb + nnb - 1) = smat(ja:ja + nna - 1, jb:jb + nnb - 1) + & + sab(1:nna, 1:nnb)*basis%cm(ia, ka, la)*basis%cm(ib, kb, lb) END DO END DO END IF @@ -2411,14 +2411,14 @@ SUBROUTINE atom_basis_condnum(basis, rad, cnum) IF (basis%basis_type == GTO_BASIS) THEN ja = ibptr(ia, la) jb = ibptr(ib, lb) - smat(ja:ja+nna-1, jb:jb+nnb-1) = smat(ja:ja+nna-1, jb:jb+nnb-1)+sab(1:nna, 1:nnb) + smat(ja:ja + nna - 1, jb:jb + nnb - 1) = smat(ja:ja + nna - 1, jb:jb + nnb - 1) + sab(1:nna, 1:nnb) ELSEIF (basis%basis_type == CGTO_BASIS) THEN DO ka = 1, basis%nbas(la) DO kb = 1, basis%nbas(lb) ja = ibptr(ka, la) jb = ibptr(kb, lb) - smat(ja:ja+nna-1, jb:jb+nnb-1) = & - smat(ja:ja+nna-1, jb:jb+nnb-1)+ & + smat(ja:ja + nna - 1, jb:jb + nnb - 1) = & + smat(ja:ja + nna - 1, jb:jb + nnb - 1) + & sab(1:nna, 1:nnb)*basis%cm(ia, ka, la)*basis%cm(ib, kb, lb) END DO END DO @@ -2497,7 +2497,7 @@ SUBROUTINE contract2add(int, omat, cm) n = SIZE(int, 1) m = SIZE(omat, 1) - INT(1:n, 1:n) = INT(1:n, 1:n)+MATMUL(TRANSPOSE(cm(1:m, 1:n)), MATMUL(omat(1:m, 1:m), cm(1:m, 1:n))) + INT(1:n, 1:n) = INT(1:n, 1:n) + MATMUL(TRANSPOSE(cm(1:m, 1:n)), MATMUL(omat(1:m, 1:m), cm(1:m, 1:n))) CALL timestop(handle) @@ -2569,7 +2569,7 @@ SUBROUTINE ipack(mat, vec, n) ij = 0 DO i = 1, n DO j = i, n - ij = ij+1 + ij = ij + 1 vec(ij) = mat(i, j) END DO END DO @@ -2592,7 +2592,7 @@ SUBROUTINE iunpack(mat, vec, n) ij = 0 DO i = 1, n DO j = i, n - ij = ij+1 + ij = ij + 1 mat(i, j) = vec(ij) mat(j, i) = vec(ij) END DO diff --git a/src/atom_xc.F b/src/atom_xc.F index 6c6856b3a9..602880849d 100644 --- a/src/atom_xc.F +++ b/src/atom_xc.F @@ -98,14 +98,14 @@ SUBROUTINE calculate_atom_zmp(ext_density, atom, lprint, xcmat) !Vxc2 rho_dum = rho(:, 1)*int1/z - deltarho = rho_dum-ext_density + deltarho = rho_dum - ext_density int2 = integrate_grid(deltarho, atom%basis%grid) CALL coulomb_potential_numeric(vxc2, deltarho, atom%basis%grid) vxc2 = vxc2*atom%lambda !Vxc - vxc = vxc1+vxc2 + vxc = vxc1 + vxc2 atom%energy%exc = fourpi*integrate_grid(vxc, rho(:, 1), atom%basis%grid) atom%rho_diff_integral = fourpi*int2 @@ -343,7 +343,7 @@ SUBROUTINE calculate_atom_vxc_lda(xcmat, atom, xc_section) n1 = SIZE(xcmat%op, 1) n2 = SIZE(xcmat%op, 2) n3 = SIZE(xcmat%op, 3) - ALLOCATE (taumat(n1, n2, 0:n3-1)) + ALLOCATE (taumat(n1, n2, 0:n3 - 1)) taumat = 0._dp xcpot(:, 1, 1) = 0.5_dp*xcpot(:, 1, 1) @@ -351,7 +351,7 @@ SUBROUTINE calculate_atom_vxc_lda(xcmat, atom, xc_section) xcpot(:, 1, 1) = xcpot(:, 1, 1)/atom%basis%grid%rad2(:) CALL numpot_matrix(taumat, xcpot(:, 1, 1), atom%basis, 0) DO l = 0, 3 - xcmat%op(:, :, l) = xcmat%op(:, :, l)+REAL(l*(l+1), dp)*taumat(:, :, l) + xcmat%op(:, :, l) = xcmat%op(:, :, l) + REAL(l*(l + 1), dp)*taumat(:, :, l) END DO DEALLOCATE (tau) @@ -483,8 +483,8 @@ SUBROUTINE calculate_atom_vxc_lsd(xcmata, xcmatb, atom, xc_section) IF (nlcc) THEN xfun = 0.0_dp CALL atom_core_density(xfun(:), atom%potential, typ="RHO", rr=atom%basis%grid%rad) - rho(:, 1) = rho(:, 1)+0.5_dp*xfun(:) - rho(:, 2) = rho(:, 2)+0.5_dp*xfun(:) + rho(:, 1) = rho(:, 1) + 0.5_dp*xfun(:) + rho(:, 2) = rho(:, 2) + 0.5_dp*xfun(:) END IF END IF IF (needs%norm_drho_spin) THEN @@ -494,8 +494,8 @@ SUBROUTINE calculate_atom_vxc_lsd(xcmata, xcmatb, atom, xc_section) IF (nlcc) THEN xfun = 0.0_dp CALL atom_core_density(xfun(:), atom%potential, typ="DER", rr=atom%basis%grid%rad) - drho(:, 1) = drho(:, 1)+0.5_dp*xfun(:) - drho(:, 2) = drho(:, 2)+0.5_dp*xfun(:) + drho(:, 1) = drho(:, 1) + 0.5_dp*xfun(:) + drho(:, 2) = drho(:, 2) + 0.5_dp*xfun(:) END IF END IF IF (needs%tau_spin) THEN @@ -514,8 +514,8 @@ SUBROUTINE calculate_atom_vxc_lsd(xcmata, xcmatb, atom, xc_section) IF (nlcc) THEN xfun = 0.0_dp CALL atom_core_density(xfun(:), atom%potential, typ="LAP", rr=atom%basis%grid%rad) - lap(:, 1) = lap(:, 1)+0.5_dp*xfun(:) - lap(:, 2) = lap(:, 2)+0.5_dp*xfun(:) + lap(:, 1) = lap(:, 1) + 0.5_dp*xfun(:) + lap(:, 2) = lap(:, 2) + 0.5_dp*xfun(:) END IF END IF @@ -566,7 +566,7 @@ SUBROUTINE calculate_atom_vxc_lsd(xcmata, xcmatb, atom, xc_section) n1 = SIZE(xcmata%op, 1) n2 = SIZE(xcmata%op, 2) n3 = SIZE(xcmata%op, 3) - ALLOCATE (taumat(n1, n2, 0:n3-1)) + ALLOCATE (taumat(n1, n2, 0:n3 - 1)) deriv => xc_dset_get_derivative(deriv_set, "(tau_a)", allocate_deriv=.FALSE.) CALL xc_derivative_get(deriv, deriv_data=xcpot) @@ -576,7 +576,7 @@ SUBROUTINE calculate_atom_vxc_lsd(xcmata, xcmatb, atom, xc_section) xcpot(:, 1, 1) = xcpot(:, 1, 1)/atom%basis%grid%rad2(:) CALL numpot_matrix(taumat, xcpot(:, 1, 1), atom%basis, 0) DO l = 0, 3 - xcmata%op(:, :, l) = xcmata%op(:, :, l)+REAL(l*(l+1), dp)*taumat(:, :, l) + xcmata%op(:, :, l) = xcmata%op(:, :, l) + REAL(l*(l + 1), dp)*taumat(:, :, l) END DO deriv => xc_dset_get_derivative(deriv_set, "(tau_b)", allocate_deriv=.FALSE.) @@ -587,7 +587,7 @@ SUBROUTINE calculate_atom_vxc_lsd(xcmata, xcmatb, atom, xc_section) xcpot(:, 1, 1) = xcpot(:, 1, 1)/atom%basis%grid%rad2(:) CALL numpot_matrix(taumat, xcpot(:, 1, 1), atom%basis, 0) DO l = 0, 3 - xcmatb%op(:, :, l) = xcmatb%op(:, :, l)+REAL(l*(l+1), dp)*taumat(:, :, l) + xcmatb%op(:, :, l) = xcmatb%op(:, :, l) + REAL(l*(l + 1), dp)*taumat(:, :, l) END DO DEALLOCATE (tau) @@ -619,8 +619,8 @@ SUBROUTINE calculate_atom_vxc_lsd(xcmata, xcmatb, atom, xc_section) IF (nlcc) THEN xfun(:) = 0.0_dp CALL atom_core_density(xfun(:), atom%potential, typ="RHO", rr=atom%basis%grid%rad) - rho(:, 1) = rho(:, 1)+0.5_dp*xfun(:) - rho(:, 2) = rho(:, 2)+0.5_dp*xfun(:) + rho(:, 1) = rho(:, 1) + 0.5_dp*xfun(:) + rho(:, 2) = rho(:, 2) + 0.5_dp*xfun(:) END IF CALL lsd_pade(rho(:, 1), rho(:, 2), exc, vxca, vxcb) @@ -759,7 +759,7 @@ SUBROUTINE atom_vxc_lda(basis, pmat, maxl, xc_section, fexc, xcmat) n1 = SIZE(xcmat, 1) n2 = SIZE(xcmat, 2) n3 = SIZE(xcmat, 3) - ALLOCATE (taumat(n1, n2, 0:n3-1)) + ALLOCATE (taumat(n1, n2, 0:n3 - 1)) taumat = 0._dp xcpot(:, 1, 1) = 0.5_dp*xcpot(:, 1, 1) @@ -767,7 +767,7 @@ SUBROUTINE atom_vxc_lda(basis, pmat, maxl, xc_section, fexc, xcmat) xcpot(:, 1, 1) = xcpot(:, 1, 1)/basis%grid%rad2(:) CALL numpot_matrix(taumat, xcpot(:, 1, 1), basis, 0) DO l = 0, 3 - xcmat(:, :, l) = xcmat(:, :, l)+REAL(l*(l+1), dp)*taumat(:, :, l) + xcmat(:, :, l) = xcmat(:, :, l) + REAL(l*(l + 1), dp)*taumat(:, :, l) END DO DEALLOCATE (tau) @@ -933,7 +933,7 @@ SUBROUTINE atom_vxc_lsd(basis, pmata, pmatb, maxl, xc_section, fexc, xcmata, xcm n1 = SIZE(xcmata, 1) n2 = SIZE(xcmata, 2) n3 = SIZE(xcmata, 3) - ALLOCATE (taumat(n1, n2, 0:n3-1)) + ALLOCATE (taumat(n1, n2, 0:n3 - 1)) deriv => xc_dset_get_derivative(deriv_set, "(tau_a)", allocate_deriv=.FALSE.) CALL xc_derivative_get(deriv, deriv_data=xcpot) @@ -943,7 +943,7 @@ SUBROUTINE atom_vxc_lsd(basis, pmata, pmatb, maxl, xc_section, fexc, xcmata, xcm xcpot(:, 1, 1) = xcpot(:, 1, 1)/basis%grid%rad2(:) CALL numpot_matrix(taumat, xcpot(:, 1, 1), basis, 0) DO l = 0, 3 - xcmata(:, :, l) = xcmata(:, :, l)+REAL(l*(l+1), dp)*taumat(:, :, l) + xcmata(:, :, l) = xcmata(:, :, l) + REAL(l*(l + 1), dp)*taumat(:, :, l) END DO deriv => xc_dset_get_derivative(deriv_set, "(tau_b)", allocate_deriv=.FALSE.) @@ -954,7 +954,7 @@ SUBROUTINE atom_vxc_lsd(basis, pmata, pmatb, maxl, xc_section, fexc, xcmata, xcm xcpot(:, 1, 1) = xcpot(:, 1, 1)/basis%grid%rad2(:) CALL numpot_matrix(taumat, xcpot(:, 1, 1), basis, 0) DO l = 0, 3 - xcmatb(:, :, l) = xcmatb(:, :, l)+REAL(l*(l+1), dp)*taumat(:, :, l) + xcmatb(:, :, l) = xcmatb(:, :, l) + REAL(l*(l + 1), dp)*taumat(:, :, l) END DO DEALLOCATE (tau) @@ -1019,9 +1019,9 @@ SUBROUTINE atom_dpot_lda(basis0, pmat0, basis1, pmat1, maxl, functional, dfexc, ! ALLOCATE (delta(nr)) fx = 4.0_dp/3.0_dp - delta(1:nr) = fs*(rho0(1:nr)**fx-rho1(1:nr)**fx) + delta(1:nr) = fs*(rho0(1:nr)**fx - rho1(1:nr)**fx) - SELECT CASE (TRIM (functional)) + SELECT CASE (TRIM(functional)) CASE ("LINX") IF (PRESENT(linxpar)) THEN a = linxpar(1) @@ -1038,7 +1038,7 @@ SUBROUTINE atom_dpot_lda(basis0, pmat0, basis1, pmat1, maxl, functional, dfexc, pot0(ir) = 0._dp END IF END DO - pot1(1:nr) = 1._dp+(a*pot0(1:nr)**2)/(1._dp+b*pot0(1:nr)**2) + pot1(1:nr) = 1._dp + (a*pot0(1:nr)**2)/(1._dp + b*pot0(1:nr)**2) pot1(1:nr) = pot1(1:nr)*delta(1:nr) dfexc = fourpi*integrate_grid(pot1(1:nr), basis0%grid) DEALLOCATE (pot0, pot1) @@ -1120,7 +1120,7 @@ SUBROUTINE fill_rho_set(rho_set, nspins, needs, rho, drho, tau, lap, na) ! Give the total density IF (needs%rho) THEN DO ia = 1, na - rho_set%rho(ia, 1, 1) = rho(ia, 1)+rho(ia, 2) + rho_set%rho(ia, 1, 1) = rho(ia, 1) + rho(ia, 2) END DO rho_set%owns%rho = .TRUE. rho_set%has%rho = .TRUE. @@ -1128,7 +1128,7 @@ SUBROUTINE fill_rho_set(rho_set, nspins, needs, rho, drho, tau, lap, na) ! Give the norm of the total gradient of the density IF (needs%norm_drho) THEN DO ia = 1, na - rho_set%norm_drho(ia, 1, 1) = drho(ia, 1)+drho(ia, 2) + rho_set%norm_drho(ia, 1, 1) = drho(ia, 1) + drho(ia, 2) END DO rho_set%owns%norm_drho = .TRUE. rho_set%has%norm_drho = .TRUE. @@ -1167,7 +1167,7 @@ SUBROUTINE fill_rho_set(rho_set, nspins, needs, rho, drho, tau, lap, na) IF (needs%tau) THEN IF (nspins == 2) THEN DO ia = 1, na - rho_set%tau(ia, 1, 1) = tau(ia, 1)+tau(ia, 2) + rho_set%tau(ia, 1, 1) = tau(ia, 1) + tau(ia, 2) END DO rho_set%owns%tau = .TRUE. rho_set%has%tau = .TRUE. @@ -1193,7 +1193,7 @@ SUBROUTINE fill_rho_set(rho_set, nspins, needs, rho, drho, tau, lap, na) IF (needs%laplace_rho) THEN IF (nspins == 2) THEN DO ia = 1, na - rho_set%laplace_rho(ia, 1, 1) = lap(ia, 1)+lap(ia, 2) + rho_set%laplace_rho(ia, 1, 1) = lap(ia, 1) + lap(ia, 2) END DO rho_set%owns%laplace_rho = .TRUE. rho_set%has%laplace_rho = .TRUE. @@ -1247,16 +1247,16 @@ SUBROUTINE lda_pade(rho, exc, vxc) DO i = 1, n IF (rho(i) > 1.e-20_dp) THEN rs = rsfac*rho(i)**(-f13) - p = a0+(a1+(a2+a3*rs)*rs)*rs - q = (b1+(b2+(b3+b4*rs)*rs)*rs)*rs + p = a0 + (a1 + (a2 + a3*rs)*rs)*rs + q = (b1 + (b2 + (b3 + b4*rs)*rs)*rs)*rs epade = -p/q - dpv = a1+(2.0_dp*a2+3.0_dp*a3*rs)*rs - dq = b1+(2.0_dp*b2+(3.0_dp*b3+4.0_dp*b4*rs)*rs)*rs - depade = f13*rs*(dpv*q-p*dq)/(q*q) + dpv = a1 + (2.0_dp*a2 + 3.0_dp*a3*rs)*rs + dq = b1 + (2.0_dp*b2 + (3.0_dp*b3 + 4.0_dp*b4*rs)*rs)*rs + depade = f13*rs*(dpv*q - p*dq)/(q*q) exc(i) = epade*rho(i) - vxc(i) = epade+depade + vxc(i) = epade + depade END IF END DO @@ -1303,11 +1303,11 @@ SUBROUTINE lsd_pade(rhoa, rhob, exc, vxca, vxcb) vxcb(1:n) = 0._dp DO i = 1, n - rhoab = rhoa(i)+rhob(i) + rhoab = rhoa(i) + rhob(i) IF (rhoab > 1.e-20_dp) THEN rs = rsfac*rhoab**(-f13) - x = (rhoa(i)-rhob(i))/rhoab + x = (rhoa(i) - rhob(i))/rhoab IF (x < -1.0_dp) THEN fx1 = 1.0_dp fx2 = -f43*fxfac*2.0_dp**f13 @@ -1315,34 +1315,34 @@ SUBROUTINE lsd_pade(rhoa, rhob, exc, vxca, vxcb) fx1 = 1.0_dp fx2 = f43*fxfac*2.0_dp**f13 ELSE - fx1 = ((1.0_dp+x)**f43+(1.0_dp-x)**f43-2.0_dp)*fxfac - fx2 = ((1.0_dp+x)**f13-(1.0_dp-x)**f13)*fxfac*f43 + fx1 = ((1.0_dp + x)**f43 + (1.0_dp - x)**f43 - 2.0_dp)*fxfac + fx2 = ((1.0_dp + x)**f13 - (1.0_dp - x)**f13)*fxfac*f43 END IF - fa0 = a0+fx1*da0 - fa1 = a1+fx1*da1 - fa2 = a2+fx1*da2 - fa3 = a3+fx1*da3 - fb1 = b1+fx1*db1 - fb2 = b2+fx1*db2 - fb3 = b3+fx1*db3 - fb4 = b4+fx1*db4 - - p = fa0+(fa1+(fa2+fa3*rs)*rs)*rs - q = (fb1+(fb2+(fb3+fb4*rs)*rs)*rs)*rs - dpv = fa1+(2.0_dp*fa2+3.0_dp*fa3*rs)*rs - dq = fb1+(2.0_dp*fb2+(3.0_dp*fb3+ & - 4.0_dp*fb4*rs)*rs)*rs - xp = da0+(da1+(da2+da3*rs)*rs)*rs - xq = (db1+(db2+(db3+db4*rs)*rs)*rs)*rs - - dr = (dpv*q-p*dq)/(q*q) - dx = 2.0_dp*(xp*q-p*xq)/(q*q)*fx2/rhoab - dc = f13*rs*dr-p/q + fa0 = a0 + fx1*da0 + fa1 = a1 + fx1*da1 + fa2 = a2 + fx1*da2 + fa3 = a3 + fx1*da3 + fb1 = b1 + fx1*db1 + fb2 = b2 + fx1*db2 + fb3 = b3 + fx1*db3 + fb4 = b4 + fx1*db4 + + p = fa0 + (fa1 + (fa2 + fa3*rs)*rs)*rs + q = (fb1 + (fb2 + (fb3 + fb4*rs)*rs)*rs)*rs + dpv = fa1 + (2.0_dp*fa2 + 3.0_dp*fa3*rs)*rs + dq = fb1 + (2.0_dp*fb2 + (3.0_dp*fb3 + & + 4.0_dp*fb4*rs)*rs)*rs + xp = da0 + (da1 + (da2 + da3*rs)*rs)*rs + xq = (db1 + (db2 + (db3 + db4*rs)*rs)*rs)*rs + + dr = (dpv*q - p*dq)/(q*q) + dx = 2.0_dp*(xp*q - p*xq)/(q*q)*fx2/rhoab + dc = f13*rs*dr - p/q exc(i) = -p/q*rhoab - vxca(i) = dc-dx*rhob(i) - vxcb(i) = dc+dx*rhoa(i) + vxca(i) = dc - dx*rhob(i) + vxcb(i) = dc + dx*rhoa(i) END IF END DO diff --git a/src/atomic_charges.F b/src/atomic_charges.F index 4e2f7f8881..475edea1fb 100644 --- a/src/atomic_charges.F +++ b/src/atomic_charges.F @@ -96,19 +96,19 @@ SUBROUTINE print_atomic_charges(particle_set, qs_kind_set, scr, title, electroni CASE (0) IF (title == "RESP charges:") THEN WRITE (scr, '(T3,A4,2X,I6,A2,A2,F12.6)') "RESP", iatom, " ", element_symbol, atomic_charges(iatom) - total_charge = total_charge+atomic_charges(iatom) + total_charge = total_charge + atomic_charges(iatom) ELSE WRITE (scr, '(I6,A2,A2,F12.6)') iatom, " ", element_symbol, atomic_charges(iatom) - total_charge = total_charge+atomic_charges(iatom) + total_charge = total_charge + atomic_charges(iatom) ENDIF CASE (1) - WRITE (scr, '(I6,A2,A2,F12.6)') iatom, " ", element_symbol, zeff-electronic_charges(iatom, 1) - total_charge = total_charge+zeff-electronic_charges(iatom, 1) + WRITE (scr, '(I6,A2,A2,F12.6)') iatom, " ", element_symbol, zeff - electronic_charges(iatom, 1) + total_charge = total_charge + zeff - electronic_charges(iatom, 1) CASE DEFAULT WRITE (scr, '(I6,A2,A2,2F12.6)') iatom, " ", element_symbol, & - zeff-(electronic_charges(iatom, 1)+electronic_charges(iatom, 2)), & - (electronic_charges(iatom, 1)-electronic_charges(iatom, 2)) - total_charge = total_charge+zeff-(electronic_charges(iatom, 1)+electronic_charges(iatom, 2)) + zeff - (electronic_charges(iatom, 1) + electronic_charges(iatom, 2)), & + (electronic_charges(iatom, 1) - electronic_charges(iatom, 2)) + total_charge = total_charge + zeff - (electronic_charges(iatom, 1) + electronic_charges(iatom, 2)) END SELECT ENDDO IF (title == "RESP charges:") THEN @@ -214,7 +214,7 @@ SUBROUTINE print_bond_orders(particle_set, scr, bond_orders) WRITE (scr, '(T2,A,T20,A,T40,A)') " Type Atom 1 ", " Type Atom 2 ", " Bond Order " DO iatom = 1, natom CALL get_atomic_kind(atomic_kind=particle_set(iatom)%atomic_kind, element_symbol=el1) - DO jatom = iatom+1, natom + DO jatom = iatom + 1, natom CALL get_atomic_kind(atomic_kind=particle_set(jatom)%atomic_kind, element_symbol=el2) IF (bond_orders(iatom, jatom) > 0.1_dp) THEN WRITE (scr, '(T6,A2,I6,T24,A2,I6,T40,F12.6)') el1, iatom, el2, jatom, bond_orders(iatom, jatom) diff --git a/src/atoms_input.F b/src/atoms_input.F index 173ec99216..d797db9eda 100644 --- a/src/atoms_input.F +++ b/src/atoms_input.F @@ -135,19 +135,19 @@ SUBROUTINE read_atoms_input(topology, overwrite, subsys_section, save_mem) EXIT END IF END DO - end_c = LEN(line_att)+1 + end_c = LEN(line_att) + 1 DO j = start_c, LEN(line_att) IF (line_att(j:j) == ' ') THEN end_c = j EXIT END IF END DO - IF (LEN_TRIM(line_att(start_c:end_c-1)) == 0) & + IF (LEN_TRIM(line_att(start_c:end_c - 1)) == 0) & CPABORT("incorrectly formatted line in coord section'"//line_att//"'") IF (wrd == 1) THEN - atom_info%id_atmname(iatom) = str2id(s2s(line_att(start_c:end_c-1))) + atom_info%id_atmname(iatom) = str2id(s2s(line_att(start_c:end_c - 1))) ELSE - READ (line_att(start_c:end_c-1), *) atom_info%r(wrd-1, iatom) + READ (line_att(start_c:end_c - 1), *) atom_info%r(wrd - 1, iatom) END IF start_c = end_c END DO @@ -186,14 +186,14 @@ SUBROUTINE read_atoms_input(topology, overwrite, subsys_section, save_mem) EXIT END IF END DO - end_c = LEN(line_att)+1 + end_c = LEN(line_att) + 1 DO j = start_c, LEN(line_att) IF (line_att(j:j) == ' ') THEN end_c = j EXIT END IF END DO - IF (LEN_TRIM(line_att(start_c:end_c-1)) == 0) & + IF (LEN_TRIM(line_att(start_c:end_c - 1)) == 0) & CALL cp_abort(__LOCATION__, & "Incorrectly formatted input line for atom "// & TRIM(ADJUSTL(cp_to_string(iatom)))// & @@ -201,10 +201,10 @@ SUBROUTINE read_atoms_input(topology, overwrite, subsys_section, save_mem) TRIM(line_att)//"> ") SELECT CASE (wrd) CASE (1) - atom_info%id_atmname(iatom) = str2id(s2s(line_att(start_c:end_c-1))) + atom_info%id_atmname(iatom) = str2id(s2s(line_att(start_c:end_c - 1))) CASE (2:4) - CALL read_float_object(line_att(start_c:end_c-1), & - atom_info%r(wrd-1, iatom), error_message) + CALL read_float_object(line_att(start_c:end_c - 1), & + atom_info%r(wrd - 1, iatom), error_message) IF (LEN_TRIM(error_message) /= 0) & CALL cp_abort(__LOCATION__, & "Incorrectly formatted input line for atom "// & @@ -212,12 +212,12 @@ SUBROUTINE read_atoms_input(topology, overwrite, subsys_section, save_mem) " found in COORD section. "//TRIM(error_message)// & " Input line: <"//TRIM(line_att)//"> ") CASE (5) - READ (line_att(start_c:end_c-1), *) strtmp + READ (line_att(start_c:end_c - 1), *) strtmp atom_info%id_molname(iatom) = str2id(strtmp) atom_info%id_resname(iatom) = atom_info%id_molname(iatom) topology%molname_generated = .FALSE. CASE (6) - READ (line_att(start_c:end_c-1), *) strtmp + READ (line_att(start_c:end_c - 1), *) strtmp atom_info%id_resname(iatom) = str2id(strtmp) END SELECT start_c = end_c @@ -334,22 +334,22 @@ SUBROUTINE read_shell_coord_input(particle_set, shell_particle_set, cell, & EXIT END IF END DO - end_c = LEN(line_att)+1 + end_c = LEN(line_att) + 1 DO j = start_c, LEN(line_att) IF (line_att(j:j) == ' ') THEN end_c = j EXIT END IF END DO - IF (wrd /= 5 .AND. end_c >= LEN(line_att)+1) & + IF (wrd /= 5 .AND. end_c >= LEN(line_att) + 1) & CPABORT("incorrectly formatted line in coord section'"//line_att//"'") IF (wrd == 1) THEN - at_name(ishell) = line_att(start_c:end_c-1) + at_name(ishell) = line_att(start_c:end_c - 1) CALL uppercase(at_name(ishell)) ELSE IF (wrd == 5) THEN - READ (line_att(start_c:end_c-1), *) at_index(ishell) + READ (line_att(start_c:end_c - 1), *) at_index(ishell) ELSE - READ (line_att(start_c:end_c-1), *) r(wrd-1, ishell) + READ (line_att(start_c:end_c - 1), *) r(wrd - 1, ishell) END IF start_c = end_c END DO @@ -384,22 +384,22 @@ SUBROUTINE read_shell_coord_input(particle_set, shell_particle_set, cell, & EXIT END IF END DO - end_c = LEN(line_att)+1 + end_c = LEN(line_att) + 1 DO j = start_c, LEN(line_att) IF (line_att(j:j) == ' ') THEN end_c = j EXIT END IF END DO - IF (wrd /= 5 .AND. end_c >= LEN(line_att)+1) & + IF (wrd /= 5 .AND. end_c >= LEN(line_att) + 1) & CPABORT("incorrectly formatted line in coord section'"//line_att//"'") IF (wrd == 1) THEN - at_name_c(ishell) = line_att(start_c:end_c-1) + at_name_c(ishell) = line_att(start_c:end_c - 1) CALL uppercase(at_name_c(ishell)) ELSE IF (wrd == 5) THEN - READ (line_att(start_c:end_c-1), *) at_index_c(ishell) + READ (line_att(start_c:end_c - 1), *) at_index_c(ishell) ELSE - READ (line_att(start_c:end_c-1), *) rc(wrd-1, ishell) + READ (line_att(start_c:end_c - 1), *) rc(wrd - 1, ishell) END IF start_c = end_c END DO @@ -426,11 +426,11 @@ SUBROUTINE read_shell_coord_input(particle_set, shell_particle_set, cell, & shell_particle_set(sh_index)%atom_index = at_index(ishell) IF (PRESENT(core_particle_set) .AND. .NOT. explicit) THEN - core_particle_set(sh_index)%r(1) = (mass_com*particle_set(at_index(ishell))%r(1)- & + core_particle_set(sh_index)%r(1) = (mass_com*particle_set(at_index(ishell))%r(1) - & shell%mass_shell*shell_particle_set(sh_index)%r(1))/shell%mass_core - core_particle_set(sh_index)%r(2) = (mass_com*particle_set(at_index(ishell))%r(2)- & + core_particle_set(sh_index)%r(2) = (mass_com*particle_set(at_index(ishell))%r(2) - & shell%mass_shell*shell_particle_set(sh_index)%r(2))/shell%mass_core - core_particle_set(sh_index)%r(3) = (mass_com*particle_set(at_index(ishell))%r(3)- & + core_particle_set(sh_index)%r(3) = (mass_com*particle_set(at_index(ishell))%r(3) - & shell%mass_shell*shell_particle_set(sh_index)%r(3))/shell%mass_core core_particle_set(sh_index)%atom_index = at_index(ishell) rab = pbc(shell_particle_set(sh_index)%r, core_particle_set(sh_index)%r, cell) @@ -448,7 +448,7 @@ SUBROUTINE read_shell_coord_input(particle_set, shell_particle_set, cell, & rab = pbc(shell_particle_set(sh_index)%r, particle_set(at_index(ishell))%r, cell) END IF - dab = SQRT(rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3)) + dab = SQRT(rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3)) IF (shell%max_dist > 0.0_dp .AND. shell%max_dist < dab) THEN IF (output_unit > 0) THEN WRITE (output_unit, *) "WARNING : shell and core for atom ", at_index(ishell), " seem to be too distant. " diff --git a/src/auto_basis.F b/src/auto_basis.F index 1542484285..c3a28a237b 100644 --- a/src/auto_basis.F +++ b/src/auto_basis.F @@ -103,18 +103,18 @@ SUBROUTINE create_ri_aux_basis_set(ri_aux_basis_set, qs_kind, basis_cntrl) IF (z > 18) linc = 2 SELECT CASE (basis_cntrl) CASE (0) - laux = MAX(2*lval, lmax+linc) + laux = MAX(2*lval, lmax + linc) CASE (1) - laux = MAX(2*lval, lmax+linc) + laux = MAX(2*lval, lmax + linc) CASE (2) - laux = MAX(2*lval, lmax+linc+1) + laux = MAX(2*lval, lmax + linc + 1) CASE (3) - laux = MAX(2*lmax, lmax+linc+2) + laux = MAX(2*lmax, lmax + linc + 2) CASE DEFAULT CPABORT("Invalid value of control variable") END SELECT ! - DO l = 2*lmax+1, laux + DO l = 2*lmax + 1, laux xv = peff(2*lmax) pmin(l) = xv pmax(l) = xv @@ -130,35 +130,35 @@ SUBROUTINE create_ri_aux_basis_set(ri_aux_basis_set, qs_kind, basis_cntrl) pend(l) = peff(l) bval(l) = bv(l) END IF - xv = LOG(pend(l)/pmin(l))/LOG(bval(l))+1.e-10_dp + xv = LOG(pend(l)/pmin(l))/LOG(bval(l)) + 1.e-10_dp nval(l) = MAX(CEILING(xv), 0) END DO ! first set include valence only nsets = 1 ls1(1) = 0 ls2(1) = lval - DO l = lval+1, laux - IF (nval(l) < nval(lval)-1) EXIT + DO l = lval + 1, laux + IF (nval(l) < nval(lval) - 1) EXIT ls2(1) = l END DO ! second set up to 2*lval IF (laux > ls2(1)) THEN - IF (lval == 0 .OR. 2*lval <= ls2(1)+1) THEN + IF (lval == 0 .OR. 2*lval <= ls2(1) + 1) THEN nsets = 2 - ls1(2) = ls2(1)+1 + ls1(2) = ls2(1) + 1 ls2(2) = laux ELSE nsets = 2 - ls1(2) = ls2(1)+1 + ls1(2) = ls2(1) + 1 ls2(2) = MIN(2*lval, laux) lx = ls2(2) - DO l = lx+1, laux - IF (nval(l) < nval(lx)-1) EXIT + DO l = lx + 1, laux + IF (nval(l) < nval(lx) - 1) EXIT ls2(2) = l END DO IF (laux > ls2(2)) THEN nsets = 3 - ls1(3) = ls2(2)+1 + ls1(3) = ls2(2) + 1 ls2(3) = laux END IF END IF @@ -173,7 +173,7 @@ SUBROUTINE create_ri_aux_basis_set(ri_aux_basis_set, qs_kind, basis_cntrl) amin(i) = MIN(amin(i), pmin(j)) bmin(i) = MIN(bmin(i), bval(j)) END DO - xv = LOG(amax(i)/amin(i))/LOG(bmin(i))+1.e-10_dp + xv = LOG(amax(i)/amin(i))/LOG(bmin(i)) + 1.e-10_dp npgf(i) = MAX(CEILING(xv), 0) END DO nx = MAXVAL(npgf(1:nsets)) @@ -182,8 +182,8 @@ SUBROUTINE create_ri_aux_basis_set(ri_aux_basis_set, qs_kind, basis_cntrl) nl = 0 DO i = 1, nsets DO j = 1, npgf(i) - jj = npgf(i)-j+1 - zet(jj, i) = amin(i)*bmin(i)**(j-1) + jj = npgf(i) - j + 1 + zet(jj, i) = amin(i)*bmin(i)**(j - 1) END DO DO l = ls1(i), ls2(i) nl(l, i) = nval(l) @@ -255,22 +255,22 @@ SUBROUTINE create_lri_aux_basis_set(lri_aux_basis_set, qs_kind, basis_cntrl, exa IF (z > 18) linc = 2 SELECT CASE (basis_cntrl) CASE (0) - laux = MAX(2*lval, lmax+linc) - laux = MIN(laux, 2+linc) + laux = MAX(2*lval, lmax + linc) + laux = MIN(laux, 2 + linc) CASE (1) - laux = MAX(2*lval, lmax+linc) - laux = MIN(laux, 3+linc) + laux = MAX(2*lval, lmax + linc) + laux = MIN(laux, 3 + linc) CASE (2) - laux = MAX(2*lval, lmax+linc+1) - laux = MIN(laux, 4+linc) + laux = MAX(2*lval, lmax + linc + 1) + laux = MIN(laux, 4 + linc) CASE (3) - laux = MAX(2*lval, lmax+linc+1) - laux = MIN(laux, 4+linc) + laux = MAX(2*lval, lmax + linc + 1) + laux = MIN(laux, 4 + linc) CASE DEFAULT CPABORT("Invalid value of control variable") END SELECT ! - DO l = 2*lmax+1, laux + DO l = 2*lmax + 1, laux pmin(l) = pmin(2*lmax) pmax(l) = pmax(2*lmax) peff(l) = peff(2*lmax) @@ -278,29 +278,29 @@ SUBROUTINE create_lri_aux_basis_set(lri_aux_basis_set, qs_kind, basis_cntrl, exa ! IF (exact_1c_terms) THEN DO l = 0, laux - IF (l <= lval+1) THEN - pend(l) = zmax(l)+1.0_dp - bval(l) = bv(basis_cntrl+1) + IF (l <= lval + 1) THEN + pend(l) = zmax(l) + 1.0_dp + bval(l) = bv(basis_cntrl + 1) ELSE pend(l) = 2.0_dp*peff(l) - bval(l) = bx(basis_cntrl+1) + bval(l) = bx(basis_cntrl + 1) END IF pmin(l) = zmin(l) - xv = LOG(pend(l)/pmin(l))/LOG(bval(l))+1.e-10_dp + xv = LOG(pend(l)/pmin(l))/LOG(bval(l)) + 1.e-10_dp nval(l) = MAX(CEILING(xv), 0) bval(l) = (pend(l)/pmin(l))**(1._dp/nval(l)) END DO ELSE DO l = 0, laux - IF (l <= lval+1) THEN + IF (l <= lval + 1) THEN pend(l) = pmax(l) - bval(l) = bv(basis_cntrl+1) + bval(l) = bv(basis_cntrl + 1) pmin(l) = zmin(l) ELSE pend(l) = 4.0_dp*peff(l) - bval(l) = bx(basis_cntrl+1) + bval(l) = bx(basis_cntrl + 1) END IF - xv = LOG(pend(l)/pmin(l))/LOG(bval(l))+1.e-10_dp + xv = LOG(pend(l)/pmin(l))/LOG(bval(l)) + 1.e-10_dp nval(l) = MAX(CEILING(xv), 0) bval(l) = (pend(l)/pmin(l))**(1._dp/nval(l)) END DO @@ -308,8 +308,8 @@ SUBROUTINE create_lri_aux_basis_set(lri_aux_basis_set, qs_kind, basis_cntrl, exa ! lm = MIN(2*lval, 3) n1 = MAXVAL(nval(0:lm)) - n2 = MAXVAL(nval(lm+1:laux)) - nsets = n1+n2 + n2 = MAXVAL(nval(lm + 1:laux)) + nsets = n1 + n2 ALLOCATE (zet(1, nsets)) zet = 0.0_dp nl = 0 @@ -318,18 +318,18 @@ SUBROUTINE create_lri_aux_basis_set(lri_aux_basis_set, qs_kind, basis_cntrl, exa ls1(i) = 0 ls2(i) = lm npgf(i) = 1 - zet(1, i) = pmin(j)*bval(j)**(i-1) + zet(1, i) = pmin(j)*bval(j)**(i - 1) DO l = 0, lm nl(l, i) = 1 END DO END DO - j = lm+1 - DO i = n1+1, nsets - ls1(i) = lm+1 + j = lm + 1 + DO i = n1 + 1, nsets + ls1(i) = lm + 1 ls2(i) = laux npgf(i) = 1 - zet(1, i) = pmin(j)*bval(j)**(i-n1-1) - DO l = lm+1, laux + zet(1, i) = pmin(j)*bval(j)**(i - n1 - 1) + DO l = lm + 1, laux nl(l, i) = 1 END DO END DO @@ -396,8 +396,8 @@ SUBROUTINE create_aux_fit_basis_set(aux_fit_basis, qs_kind, basis_cntrl) nx = econf(l) DO IF (nx > 0) THEN - nval(l) = nval(l)+1 - nx = nx-2*(2*l+1) + nval(l) = nval(l) + 1 + nx = nx - 2*(2*l + 1) ELSE EXIT END IF @@ -408,27 +408,27 @@ SUBROUTINE create_aux_fit_basis_set(aux_fit_basis, qs_kind, basis_cntrl) CASE (0) laux = lval DO l = 0, lval - nfun(l) = nfun(l)+1 + nfun(l) = nfun(l) + 1 END DO CASE (1) - laux = MIN(lval+1, lmax) + laux = MIN(lval + 1, lmax) DO l = 0, lval - nfun(l) = nfun(l)+1 + nfun(l) = nfun(l) + 1 END DO IF (laux > lval) nfun(laux) = 1 CASE (2) - laux = MIN(lval+1, lmax) + laux = MIN(lval + 1, lmax) DO l = 0, lval - nfun(l) = nfun(l)+2 + nfun(l) = nfun(l) + 2 END DO IF (laux > lval) nfun(laux) = 1 CASE (3) - laux = MIN(lval+2, lmax) + laux = MIN(lval + 2, lmax) DO l = 0, lval - nfun(l) = nfun(l)+3 + nfun(l) = nfun(l) + 3 END DO - IF (laux > lval) nfun(lval+1) = 2 - IF (laux > lval+1) nfun(laux) = 1 + IF (laux > lval) nfun(lval + 1) = 2 + IF (laux > lval + 1) nfun(laux) = 1 CASE DEFAULT CPABORT("Invalid value of control variable") END SELECT @@ -436,24 +436,24 @@ SUBROUTINE create_aux_fit_basis_set(aux_fit_basis, qs_kind, basis_cntrl) nsets = 0 maxpgf = 0 DO l = 0, lval - z1 = MAX(zmin(l), 0.10_dp+l*0.025_dp) + z1 = MAX(zmin(l), 0.10_dp + l*0.025_dp) z2 = zmax(l) mx = CEILING(LOG(z2/z1)/LOG(5.0_dp)) IF (nval(l) > 1) THEN - nsets = nsets+2 + nsets = nsets + 2 maxpgf = MAX(maxpgf, nval(l), mx, 3) ELSEIF (nval(l) == 1) THEN - nsets = nsets+1 + nsets = nsets + 1 maxpgf = MAX(maxpgf, mx, 3) END IF - DO i = nval(l)+1, nfun(l) + DO i = nval(l) + 1, nfun(l) maxpgf = MAX(maxpgf, mx, 1) - nsets = nsets+1 + nsets = nsets + 1 END DO END DO - DO l = lval+1, laux + DO l = lval + 1, laux maxpgf = MAX(maxpgf, 1) - nsets = nsets+nfun(l) + nsets = nsets + nfun(l) END DO ! ALLOCATE (zet(maxpgf, nsets)) @@ -463,7 +463,7 @@ SUBROUTINE create_aux_fit_basis_set(aux_fit_basis, qs_kind, basis_cntrl) DO l = 0, laux amet = 2.50_dp ! optimize exponensts - z1 = MAX(zmin(l), 0.20_dp+l*0.025_dp) + z1 = MAX(zmin(l), 0.20_dp + l*0.025_dp) z2 = zmax(l) mx = CEILING(LOG(z2/z1)/LOG(4.0_dp)) IF (nval(l) > 1) THEN @@ -490,7 +490,7 @@ SUBROUTINE create_aux_fit_basis_set(aux_fit_basis, qs_kind, basis_cntrl) IF (ostate%state == 2) THEN afit(1) = xval(1) DO i = 2, nx - afit(i) = afit(i-1)*xval(i) + afit(i) = afit(i - 1)*xval(i) END DO CALL overlap_maximum(l, np, nf, zval, gcval, nx, afit, amet, ostate%f) CALL neb_potential(xval, ostate%nvar, ostate%f) @@ -502,46 +502,46 @@ SUBROUTINE create_aux_fit_basis_set(aux_fit_basis, qs_kind, basis_cntrl) CALL powell_optimize(ostate%nvar, xval, ostate) afit(1) = xval(1) DO i = 2, nx - afit(i) = afit(i-1)*xval(i) + afit(i) = afit(i - 1)*xval(i) END DO DEALLOCATE (zval, gcval) ! IF (nval(l) > 1) THEN ! split set - iset = iset+1 + iset = iset + 1 lset(iset) = l - npgf(iset) = nx-1 - nl(l, iset) = nval(l)-1 - zet(1:nx-1, iset) = afit(1:nx-1) + npgf(iset) = nx - 1 + nl(l, iset) = nval(l) - 1 + zet(1:nx - 1, iset) = afit(1:nx - 1) ! new set - iset = iset+1 + iset = iset + 1 lset(iset) = l - npgf(iset) = nx-1 + npgf(iset) = nx - 1 nl(l, iset) = 1 - zet(1:nx-1, iset) = afit(2:nx) - DO i = 1, nfun(l)-2 - iset = iset+1 + zet(1:nx - 1, iset) = afit(2:nx) + DO i = 1, nfun(l) - 2 + iset = iset + 1 lset(iset) = l npgf(iset) = 1 - zet(1, iset) = afit(nx-i+1) + zet(1, iset) = afit(nx - i + 1) nl(l, iset) = 1 END DO ELSEIF (nval(l) == 1) THEN - iset = iset+1 + iset = iset + 1 lset(iset) = l npgf(iset) = nx zet(1:nx, iset) = afit(1:nx) nl(l, iset) = 1 - DO i = 1, nfun(l)-1 - iset = iset+1 + DO i = 1, nfun(l) - 1 + iset = iset + 1 lset(iset) = l npgf(iset) = 1 - zet(1, iset) = afit(nx-i+1) + zet(1, iset) = afit(nx - i + 1) nl(l, iset) = 1 END DO ELSE DO i = 1, nfun(l) - iset = iset+1 + iset = iset + 1 lset(iset) = l npgf(iset) = 1 zet(1, iset) = afit(i) @@ -612,22 +612,22 @@ SUBROUTINE get_basis_keyfigures(basis_set, lmax, zmin, zmax, zeff) ! zeff DO ishell = 1, nshell(iset) l = lshell(ishell, iset) - kval = fac(l+1)**2*2._dp**(2*l+1)/fac(2*l+2) + kval = fac(l + 1)**2*2._dp**(2*l + 1)/fac(2*l + 2) rexp = 0.0_dp rno = 0.0_dp DO i = 1, npgf(iset) gcca = gcc(i, ishell, iset) DO j = 1, npgf(iset) - zeta = zet(i, iset)+zet(j, iset) + zeta = zet(i, iset) + zet(j, iset) gccb = gcc(j, ishell, iset) - rint = 0.5_dp*fac(l+1)/zeta**(l+2) - rexp = rexp+gcca*gccb*rint - rint = rootpi*0.5_dp**(l+2)*dfac(2*l+1)/zeta**(l+1.5_dp) - rno = rno+gcca*gccb*rint + rint = 0.5_dp*fac(l + 1)/zeta**(l + 2) + rexp = rexp + gcca*gccb*rint + rint = rootpi*0.5_dp**(l + 2)*dfac(2*l + 1)/zeta**(l + 1.5_dp) + rno = rno + gcca*gccb*rint END DO END DO rexp = rexp/rno - aeff = (fac(l+1)/dfac(2*l+1))**2*2._dp**(2*l+1)/(pi*rexp**2) + aeff = (fac(l + 1)/dfac(2*l + 1))**2*2._dp**(2*l + 1)/(pi*rexp**2) zeff(l) = MAX(zeff(l), aeff) END DO END DO @@ -660,10 +660,10 @@ SUBROUTINE get_basis_products(lmax, zmin, zmax, zeff, pmin, pmax, peff) DO l1 = 0, lmax DO l2 = l1, lmax - DO la = l2-l1, l2+l1 - pmax(la) = MAX(pmax(la), zmax(l1)+zmax(l2)) - pmin(la) = MIN(pmin(la), zmin(l1)+zmin(l2)) - peff(la) = MAX(peff(la), zeff(l1)+zeff(l2)) + DO la = l2 - l1, l2 + l1 + pmax(la) = MAX(pmax(la), zmax(l1) + zmax(l2)) + pmin(la) = MIN(pmin(la), zmin(l1) + zmin(l2)) + peff(la) = MAX(peff(la), zeff(l1) + zeff(l2)) END DO END DO END DO @@ -701,10 +701,10 @@ SUBROUTINE overlap_maximum(lm, npgf, nfun, zet, gcc, nfit, afit, amet, eval) fij = 0.0_dp DO ia = 1, npgf DO ib = 1, npgf - p = zet(ia)+zet(ib)+amet - intab = 0.5_dp/p**(lm+1.5_dp)*gamma1(lm+1) + p = zet(ia) + zet(ib) + amet + intab = 0.5_dp/p**(lm + 1.5_dp)*gamma1(lm + 1) DO i = 1, nfun - fij = fij+gcc(ia, i)*gcc(ib, i)*intab + fij = fij + gcc(ia, i)*gcc(ib, i)*intab END DO END DO END DO @@ -714,10 +714,10 @@ SUBROUTINE overlap_maximum(lm, npgf, nfun, zet, gcc, nfit, afit, amet, eval) fx = 0.0_dp DO ia = 1, npgf DO ib = 1, nfit - p = zet(ia)+afit(ib)+amet - intab = 0.5_dp/p**(lm+1.5_dp)*gamma1(lm+1) + p = zet(ia) + afit(ib) + amet + intab = 0.5_dp/p**(lm + 1.5_dp)*gamma1(lm + 1) DO i = 1, nfun - fx(ib, i) = fx(ib, i)+gcc(ia, i)*intab + fx(ib, i) = fx(ib, i) + gcc(ia, i)*intab END DO END DO END DO @@ -726,8 +726,8 @@ SUBROUTINE overlap_maximum(lm, npgf, nfun, zet, gcc, nfit, afit, amet, eval) ALLOCATE (xx(nfit, nfit), x2(nfit, nfit)) DO ia = 1, nfit DO ib = 1, nfit - p = afit(ia)+afit(ib)+amet - xx(ia, ib) = 0.5_dp/p**(lm+1.5_dp)*gamma1(lm+1) + p = afit(ia) + afit(ib) + amet + xx(ia, ib) = 0.5_dp/p**(lm + 1.5_dp)*gamma1(lm + 1) END DO END DO @@ -739,15 +739,15 @@ SUBROUTINE overlap_maximum(lm, npgf, nfun, zet, gcc, nfit, afit, amet, eval) ! value t*xx*t xij = 0.0_dp DO i = 1, nfun - xij = xij+DOT_PRODUCT(tx(:, i), MATMUL(xx, tx(:, i))) + xij = xij + DOT_PRODUCT(tx(:, i), MATMUL(xx, tx(:, i))) END DO ! value t*fx fxij = 0.0_dp DO i = 1, nfun - fxij = fxij+DOT_PRODUCT(tx(:, i), fx(:, i)) + fxij = fxij + DOT_PRODUCT(tx(:, i), fx(:, i)) END DO ! - eval = fij-2.0_dp*fxij+xij + eval = fij - 2.0_dp*fxij + xij ELSE ! error in solving for max overlap eval = 1.0e10_dp @@ -773,7 +773,7 @@ SUBROUTINE neb_potential(x, n, eval) DO i = 2, n IF (x(i) < 1.5_dp) THEN - eval = eval+10.0_dp*(1.5_dp-x(i))**2 + eval = eval + 10.0_dp*(1.5_dp - x(i))**2 END IF END DO @@ -820,9 +820,9 @@ SUBROUTINE get_basis_functions(basis_set, lin, np, nf, zval, gcval) DO ishell = 1, nshell(iset) l = lshell(ishell, iset) IF (l == lin) THEN - nf = nf+1 + nf = nf + 1 IF (toadd) THEN - np = np+npgf(iset) + np = np + npgf(iset) toadd = .FALSE. END IF END IF @@ -839,12 +839,12 @@ SUBROUTINE get_basis_functions(basis_set, lin, np, nf, zval, gcval) DO ishell = 1, nshell(iset) l = lshell(ishell, iset) IF (l == lin) THEN - jf = jf+1 + jf = jf + 1 IF (toadd) THEN - j1 = jp+1 - j2 = jp+npgf(iset) + j1 = jp + 1 + j2 = jp + npgf(iset) zval(j1:j2) = zet(1:npgf(iset), iset) - jp = jp+npgf(iset) + jp = jp + npgf(iset) toadd = .FALSE. END IF gcval(j1:j2, jf) = gcc(1:npgf(iset), ishell, iset) diff --git a/src/base/machine.F b/src/base/machine.F index dea37d22a2..5c379a7b5f 100644 --- a/src/base/machine.F +++ b/src/base/machine.F @@ -11,75 +11,74 @@ !> \author APSI & JGH ! ************************************************************************************************** MODULE machine - USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_INT - USE ISO_FORTRAN_ENV, ONLY: input_unit,& - output_unit - USE kinds, ONLY: default_string_length,& - dp,& - int_8 - USE machine_internal, ONLY: & - m_abort, m_chdir, m_flush_internal=>m_flush, m_getcwd, m_getlog, m_getpid, & - m_hostnm, m_memory, m_memory_details, m_memory_max, m_mov, m_procrun - - !$ USE OMP_LIB, ONLY: omp_get_max_threads, omp_get_thread_num, omp_get_num_threads, OMP_GET_WTIME - - IMPLICIT NONE - - ! Except for some error handling code, all code should - ! get a unit number from the print keys or from the logger, in order - ! to guarantee correct output behavior, - ! for example in farming or path integral runs - ! default_input_unit should never be used - ! but we need to know what it is, as we should not try to open it for output - INTEGER, PUBLIC, PARAMETER :: default_output_unit = output_unit, & - default_input_unit = input_unit + USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_INT + USE ISO_FORTRAN_ENV, ONLY: input_unit, & + output_unit + USE kinds, ONLY: default_string_length, & + dp, & + int_8 + USE machine_internal, ONLY: & + m_abort, m_chdir, m_flush_internal => m_flush, m_getcwd, m_getlog, m_getpid, & + m_hostnm, m_memory, m_memory_details, m_memory_max, m_mov, m_procrun + +!$ USE OMP_LIB, ONLY: omp_get_max_threads, omp_get_thread_num, omp_get_num_threads, OMP_GET_WTIME + + IMPLICIT NONE + + ! Except for some error handling code, all code should + ! get a unit number from the print keys or from the logger, in order + ! to guarantee correct output behavior, + ! for example in farming or path integral runs + ! default_input_unit should never be used + ! but we need to know what it is, as we should not try to open it for output + INTEGER, PUBLIC, PARAMETER :: default_output_unit = output_unit, & + default_input_unit = input_unit #include "machine_cpuid.h" - ! Enumerates the target architectures or instruction set extensions. - ! A feature is present if within range for the respective architecture. - ! For example, to check for MACHINE_X86_AVX the following is true: - ! MACHINE_X86_AVX <= m_cpuid() and MACHINE_X86 >= m_cpuid(). - ! For example, to check for MACHINE_ARM_SOME the following is true: - ! MACHINE_ARM_SOME <= m_cpuid() and MACHINE_ARM >= m_cpuid(). - INTEGER, PUBLIC, PARAMETER :: & - MACHINE_CPU_GENERIC = CP_MACHINE_CPU_GENERIC, & - MACHINE_X86_SSE4 = CP_MACHINE_X86_SSE4, & - MACHINE_X86_AVX = CP_MACHINE_X86_AVX, & - MACHINE_X86_AVX2 = CP_MACHINE_X86_AVX2, & - MACHINE_X86_AVX512 = CP_MACHINE_X86_AVX512, & - MACHINE_X86 = MACHINE_X86_AVX512 ! marks end of range + ! Enumerates the target architectures or instruction set extensions. + ! A feature is present if within range for the respective architecture. + ! For example, to check for MACHINE_X86_AVX the following is true: + ! MACHINE_X86_AVX <= m_cpuid() and MACHINE_X86 >= m_cpuid(). + ! For example, to check for MACHINE_ARM_SOME the following is true: + ! MACHINE_ARM_SOME <= m_cpuid() and MACHINE_ARM >= m_cpuid(). + INTEGER, PUBLIC, PARAMETER :: & + MACHINE_CPU_GENERIC = CP_MACHINE_CPU_GENERIC, & + MACHINE_X86_SSE4 = CP_MACHINE_X86_SSE4, & + MACHINE_X86_AVX = CP_MACHINE_X86_AVX, & + MACHINE_X86_AVX2 = CP_MACHINE_X86_AVX2, & + MACHINE_X86_AVX512 = CP_MACHINE_X86_AVX512, & + MACHINE_X86 = MACHINE_X86_AVX512 ! marks end of range ! other arch to be added as needed e.g., !MACHINE_ARM_SOME = 2000 !MACHINE_ARM_ELSE = 2001 !MACHINE_ARM = MACHINE_ARM_ELSE !MACHINE_PWR_???? = 3000 - PRIVATE - - PUBLIC :: m_walltime, m_datum, m_hostnm, m_flush, m_flush_internal,& - m_getcwd, m_getlog, m_getpid, m_procrun, m_abort,& - m_chdir, m_mov, m_memory, m_memory_details, m_memory_max, m_energy,& - m_cpuinfo, m_cpuid_static, m_cpuid, m_cpuid_name - - INTERFACE - ! ********************************************************************************************** - !> \brief Target architecture or instruction set extension according to compiler target flags. - !> \return cpuid according to MACHINE_* integer-parameter. - !> \par History - !> 04.2019 created [Hans Pabst] - ! ********************************************************************************************** - PURE FUNCTION m_cpuid_static() BIND(C) - IMPORT :: C_INT - INTEGER(C_INT) :: m_cpuid_static - END FUNCTION m_cpuid_static - END INTERFACE - - ! should only be set according to the state in &GLOBAL - LOGICAL, SAVE, PUBLIC :: flush_should_flush=.FALSE. + PRIVATE + + PUBLIC :: m_walltime, m_datum, m_hostnm, m_flush, m_flush_internal, & + m_getcwd, m_getlog, m_getpid, m_procrun, m_abort, & + m_chdir, m_mov, m_memory, m_memory_details, m_memory_max, m_energy, & + m_cpuinfo, m_cpuid_static, m_cpuid, m_cpuid_name + + INTERFACE + ! ********************************************************************************************** + !> \brief Target architecture or instruction set extension according to compiler target flags. + !> \return cpuid according to MACHINE_* integer-parameter. + !> \par History + !> 04.2019 created [Hans Pabst] + ! ********************************************************************************************** + PURE FUNCTION m_cpuid_static() BIND(C) + IMPORT :: C_INT + INTEGER(C_INT) :: m_cpuid_static + END FUNCTION m_cpuid_static + END INTERFACE + + ! should only be set according to the state in &GLOBAL + LOGICAL, SAVE, PUBLIC :: flush_should_flush = .FALSE. CONTAINS - ! ************************************************************************************************** !> \brief flushes units if the &GLOBAL flag is set accordingly !> \param lunit ... @@ -88,11 +87,11 @@ END FUNCTION m_cpuid_static !> \note !> flushing might degrade performance significantly (30% and more) ! ************************************************************************************************** -SUBROUTINE m_flush(lunit) + SUBROUTINE m_flush(lunit) INTEGER, INTENT(IN) :: lunit - IF (flush_should_flush) CALL m_flush_internal(lunit) -END SUBROUTINE + IF (flush_should_flush) CALL m_flush_internal(lunit) + END SUBROUTINE ! ************************************************************************************************** !> \brief returns time from a real-time clock, protected against rolling !> early/easily @@ -103,7 +102,7 @@ SUBROUTINE m_flush(lunit) !> same implementation for all machines. !> might still roll, if not called multiple times per count_max/count_rate ! ************************************************************************************************** -FUNCTION m_walltime() RESULT (wt) + FUNCTION m_walltime() RESULT(wt) #if defined(__LIBXSMM) USE libxsmm, ONLY: libxsmm_timer_tick, libxsmm_timer_duration #endif @@ -116,70 +115,70 @@ FUNCTION m_walltime() RESULT (wt) INTEGER(KIND=int_8) :: count INTEGER(KIND=int_8), SAVE :: count_max, count_rate, cycles = -1, & last_count - !$ IF (.FALSE.) THEN +!$ IF (.FALSE.) THEN ! count lies in [0,count_max] and increases monotonically - IF (cycles == -1) THEN ! get parameters of system_clock and initialise - CALL SYSTEM_CLOCK(count_rate=count_rate,count_max=count_max) - cycles = 0 - last_count = 0 - ENDIF - - CALL SYSTEM_CLOCK(count=count) - - ! protect against non-standard cases where time might be non-monotonous, - ! but it is unlikely that the clock cycled (e.g. underlying system clock adjustments) - ! i.e. if count is smaller than last_count by only a small fraction of count_max, - ! we use last_count instead - ! if count is smaller, we assume that the clock cycled. - IF (count \brief reads /proc/cpuinfo if it exists (i.e. Linux) to return relevant info !> \param model_name as obtained from the 'model name' field, UNKNOWN otherwise ! ************************************************************************************************** -SUBROUTINE m_cpuinfo(model_name) + SUBROUTINE m_cpuinfo(model_name) CHARACTER(LEN=default_string_length) :: model_name - INTEGER, PARAMETER :: bufferlen = 2048 + INTEGER, PARAMETER :: bufferlen = 2048 CHARACTER(LEN=bufferlen) :: buffer INTEGER :: i, icol, iline, imod, stat - model_name="UNKNOWN" - buffer="" - OPEN(121245,FILE="/proc/cpuinfo",ACTION="READ",STATUS="OLD",ACCESS="STREAM",IOSTAT=stat) - IF (stat==0) THEN - DO i=1,bufferlen - READ(121245,END=999) buffer(I:I) - ENDDO -999 CLOSE(121245) - imod=INDEX(buffer,"model name") - IF (imod>0) THEN - icol=imod-1+INDEX(buffer(imod:),":") - iline=icol-1+INDEX(buffer(icol:),NEW_LINE('A')) - IF (iline==icol-1) iline=bufferlen+1 - model_name=buffer(icol+1:iline-1) - ENDIF - ENDIF -END SUBROUTINE m_cpuinfo + model_name = "UNKNOWN" + buffer = "" + OPEN (121245, FILE="/proc/cpuinfo", ACTION="READ", STATUS="OLD", ACCESS="STREAM", IOSTAT=stat) + IF (stat == 0) THEN + DO i = 1, bufferlen + READ (121245, END=999) buffer(I:I) + ENDDO +999 CLOSE (121245) + imod = INDEX(buffer, "model name") + IF (imod > 0) THEN + icol = imod - 1 + INDEX(buffer(imod:), ":") + iline = icol - 1 + INDEX(buffer(icol:), NEW_LINE('A')) + IF (iline == icol - 1) iline = bufferlen + 1 + model_name = buffer(icol + 1:iline - 1) + ENDIF + ENDIF + END SUBROUTINE m_cpuinfo ! ************************************************************************************************** !> \brief Target architecture or instruction set extension according to CPU-check at runtime. @@ -187,19 +186,19 @@ END SUBROUTINE m_cpuinfo !> \par History !> 04.2019 created [Hans Pabst] ! ************************************************************************************************** -PURE FUNCTION m_cpuid() RESULT (cpuid) + PURE FUNCTION m_cpuid() RESULT(cpuid) #if defined(__LIBXSMM) - USE libxsmm, ONLY: libxsmm_get_target_archid, LIBXSMM_X86_SSE4 + USE libxsmm, ONLY: libxsmm_get_target_archid, LIBXSMM_X86_SSE4 #endif - INTEGER :: cpuid + INTEGER :: cpuid #if defined(__LIBXSMM) - cpuid = libxsmm_get_target_archid() - cpuid = MERGE(MIN(MACHINE_X86_SSE4 + cpuid - LIBXSMM_X86_SSE4, MACHINE_X86), & - MACHINE_CPU_GENERIC, LIBXSMM_X86_SSE4 .LE. cpuid) + cpuid = libxsmm_get_target_archid() + cpuid = MERGE(MIN(MACHINE_X86_SSE4 + cpuid - LIBXSMM_X86_SSE4, MACHINE_X86), & + MACHINE_CPU_GENERIC, LIBXSMM_X86_SSE4 .LE. cpuid) #else - cpuid = m_cpuid_static() + cpuid = m_cpuid_static() #endif -END FUNCTION m_cpuid + END FUNCTION m_cpuid ! ************************************************************************************************** !> \brief Determine name of target architecture for a given CPUID. @@ -208,7 +207,7 @@ END FUNCTION m_cpuid !> \par History !> 06.2019 created [Hans Pabst] ! ************************************************************************************************** -FUNCTION m_cpuid_name(cpuid) + FUNCTION m_cpuid_name(cpuid) INTEGER :: cpuid CHARACTER(len=default_string_length), POINTER :: m_cpuid_name @@ -216,21 +215,21 @@ FUNCTION m_cpuid_name(cpuid) name_unknown = "unknown", name_x86_avx = "x86_avx", name_x86_avx2 = "x86_avx2", & name_x86_avx512 = "x86_avx512", name_x86_sse4 = "x86_sse4" - SELECT CASE (cpuid) - CASE (MACHINE_CPU_GENERIC) - m_cpuid_name => name_generic - CASE (MACHINE_X86_SSE4) - m_cpuid_name => name_x86_sse4 - CASE (MACHINE_X86_AVX) - m_cpuid_name => name_x86_avx - CASE (MACHINE_X86_AVX2) - m_cpuid_name => name_x86_avx2 - CASE (MACHINE_X86_AVX512) - m_cpuid_name => name_x86_avx512 - CASE DEFAULT - m_cpuid_name => name_unknown - END SELECT -END FUNCTION m_cpuid_name + SELECT CASE (cpuid) + CASE (MACHINE_CPU_GENERIC) + m_cpuid_name => name_generic + CASE (MACHINE_X86_SSE4) + m_cpuid_name => name_x86_sse4 + CASE (MACHINE_X86_AVX) + m_cpuid_name => name_x86_avx + CASE (MACHINE_X86_AVX2) + m_cpuid_name => name_x86_avx2 + CASE (MACHINE_X86_AVX512) + m_cpuid_name => name_x86_avx512 + CASE DEFAULT + m_cpuid_name => name_unknown + END SELECT + END FUNCTION m_cpuid_name ! ************************************************************************************************** !> \brief returns the energy used since some time in the past. @@ -240,18 +239,18 @@ END FUNCTION m_cpuid_name !> \par History !> 09.2013 created [Joost VandeVondele, Ole Schuett] ! ************************************************************************************************** -FUNCTION m_energy() RESULT (wt) - REAL(KIND=dp) :: wt + FUNCTION m_energy() RESULT(wt) + REAL(KIND=dp) :: wt #if defined(__CRAY_PM_ENERGY) - wt = read_energy("/sys/cray/pm_counters/energy") + wt = read_energy("/sys/cray/pm_counters/energy") #elif defined(__CRAY_PM_ACCEL_ENERGY) - wt = read_energy("/sys/cray/pm_counters/accel_energy") + wt = read_energy("/sys/cray/pm_counters/accel_energy") #else - wt = 0.0 ! fallback default + wt = 0.0 ! fallback default #endif -END FUNCTION m_energy + END FUNCTION m_energy #if defined(__CRAY_PM_ACCEL_ENERGY) || defined(__CRAY_PM_ENERGY) ! ************************************************************************************************** @@ -261,7 +260,7 @@ END FUNCTION m_energy !> \par History !> 09.2013 created [Joost VandeVondele, Ole Schuett] ! ************************************************************************************************** -FUNCTION read_energy(filename) RESULT (wt) + FUNCTION read_energy(filename) RESULT(wt) CHARACTER(LEN=*) :: filename REAL(KIND=dp) :: wt @@ -269,38 +268,37 @@ FUNCTION read_energy(filename) RESULT (wt) INTEGER :: i, iostat INTEGER(KIND=int_8) :: raw - OPEN(121245,FILE=filename,ACTION="READ",STATUS="OLD",ACCESS="STREAM") - DO I=1,80 - READ(121245,END=999) DATA(I:I) - ENDDO -999 CLOSE(121245) - DATA(I:80)="" - READ(DATA,*,IOSTAT=iostat) raw - IF (iostat.NE.0) THEN - wt=0.0_dp - ELSE - ! convert from J to kJ - wt=raw/1000.0_dp - ENDIF -END FUNCTION read_energy + OPEN (121245, FILE=filename, ACTION="READ", STATUS="OLD", ACCESS="STREAM") + DO I = 1, 80 + READ (121245, END=999) DATA(I:I) + ENDDO +999 CLOSE (121245) + DATA(I:80) = "" + READ (DATA, *, IOSTAT=iostat) raw + IF (iostat .NE. 0) THEN + wt = 0.0_dp + ELSE + ! convert from J to kJ + wt = raw/1000.0_dp + ENDIF + END FUNCTION read_energy #endif - ! ************************************************************************************************** !> \brief returns a datum in human readable format using a standard Fortran routine !> \param cal_date ... !> \par History !> 10.2009 created [Joost VandeVondele] ! ************************************************************************************************** -SUBROUTINE m_datum(cal_date) + SUBROUTINE m_datum(cal_date) CHARACTER(len=*), INTENT(OUT) :: cal_date CHARACTER(len=10) :: time CHARACTER(len=8) :: date - CALL DATE_AND_TIME(date=date, time=time) - cal_date=date(1:4)//"-"//date(5:6)//"-"//date(7:8)//" "//time(1:2)//":"//time(3:4)//":"//time(5:10) + CALL DATE_AND_TIME(date=date, time=time) + cal_date = date(1:4)//"-"//date(5:6)//"-"//date(7:8)//" "//time(1:2)//":"//time(3:4)//":"//time(5:10) -END SUBROUTINE m_datum + END SUBROUTINE m_datum END MODULE machine diff --git a/src/base/machine_posix.f90 b/src/base/machine_posix.f90 index 481f6b545c..e602565b28 100644 --- a/src/base/machine_posix.f90 +++ b/src/base/machine_posix.f90 @@ -7,8 +7,8 @@ !> \brief Implementation of machine interface based on Fortran 2003 and POSIX !> \author Ole Schuett ! ***************************************************************************** - USE kinds, ONLY: dp, int_8, default_path_length,& - default_string_length + USE kinds, ONLY: dp, int_8, default_path_length, & + default_string_length USE ISO_C_BINDING, ONLY: C_INT, C_NULL_CHAR, C_CHAR, C_PTR, C_NULL_PTR, C_ASSOCIATED, C_F_POINTER IMPLICIT NONE @@ -19,133 +19,129 @@ m_abort, m_chdir, m_mov, & m_memory_details, m_procrun - INTEGER(KIND=int_8), PUBLIC, SAVE :: m_memory_max=0 + INTEGER(KIND=int_8), PUBLIC, SAVE :: m_memory_max = 0 -CONTAINS + CONTAINS ! ***************************************************************************** !> \brief Can be used to get a nice core ! ************************************************************************************************** SUBROUTINE m_abort() - INTERFACE - SUBROUTINE abort() BIND(C,name="abort") - END SUBROUTINE - END INTERFACE + INTERFACE + SUBROUTINE abort() BIND(C, name="abort") + END SUBROUTINE + END INTERFACE - CALL abort() + CALL abort() END SUBROUTINE m_abort - ! ************************************************************************************************** !> \brief Flush a given unit !> \param lunit ... ! ************************************************************************************************** SUBROUTINE m_flush(lunit) - INTEGER, INTENT(IN) :: lunit + INTEGER, INTENT(IN) :: lunit - FLUSH(lunit) + FLUSH (lunit) END SUBROUTINE m_flush - ! ************************************************************************************************** !> \brief Returns if a process is running on the local machine !> 1 if yes and 0 if not !> \param pid ... !> \return ... ! ************************************************************************************************** - FUNCTION m_procrun(pid) RESULT (run_on) - INTEGER, INTENT(IN) :: pid - INTEGER :: run_on + FUNCTION m_procrun(pid) RESULT(run_on) + INTEGER, INTENT(IN) :: pid + INTEGER :: run_on #if defined(__MINGW) - run_on = 0 + run_on = 0 #else - INTEGER :: istat - - INTERFACE - FUNCTION kill(pid, sig) BIND(C,name="kill") RESULT(errno) - IMPORT - INTEGER(KIND=C_INT),VALUE :: pid, sig - INTEGER(KIND=C_INT) :: errno - END FUNCTION - END INTERFACE - - ! If sig is 0, then no signal is sent, but error checking is still - ! performed; this can be used to check for the existence of a process - ! ID or process group ID. - - istat = kill(pid=pid, sig=0) - IF(istat == 0) THEN - run_on = 1 ! no error, process exists - ELSE - run_on = 0 ! error, process probably does not exist - ENDIF + INTEGER :: istat + + INTERFACE + FUNCTION kill(pid, sig) BIND(C, name="kill") RESULT(errno) + IMPORT + INTEGER(KIND=C_INT), VALUE :: pid, sig + INTEGER(KIND=C_INT) :: errno + END FUNCTION + END INTERFACE + + ! If sig is 0, then no signal is sent, but error checking is still + ! performed; this can be used to check for the existence of a process + ! ID or process group ID. + + istat = kill(pid=pid, sig=0) + IF (istat == 0) THEN + run_on = 1 ! no error, process exists + ELSE + run_on = 0 ! error, process probably does not exist + ENDIF #endif END FUNCTION m_procrun - ! ************************************************************************************************** !> \brief Returns the total amount of memory [bytes] in use, if known, zero otherwise !> \param mem ... ! ************************************************************************************************** SUBROUTINE m_memory(mem) - INTEGER(KIND=int_8), OPTIONAL, INTENT(OUT) :: mem - INTEGER(KIND=int_8) :: mem_local + INTEGER(KIND=int_8), OPTIONAL, INTENT(OUT) :: mem + INTEGER(KIND=int_8) :: mem_local - ! - ! __NO_STATM_ACCESS can be used to disable the stuff, if getpagesize - ! lead to linking errors or /proc/self/statm can not be opened - ! + ! + ! __NO_STATM_ACCESS can be used to disable the stuff, if getpagesize + ! lead to linking errors or /proc/self/statm can not be opened + ! #if defined(__NO_STATM_ACCESS) - mem_local=0 + mem_local = 0 #else - INTEGER(KIND=int_8) :: m1,m2,m3 - CHARACTER(LEN=80) :: DATA - INTEGER :: iostat,i - - ! the size of a page, might not be available everywhere - INTERFACE - FUNCTION getpagesize() BIND(C,name="getpagesize") RESULT(RES) - IMPORT - INTEGER(C_INT) :: RES - END FUNCTION - END INTERFACE - - ! - ! reading from statm - ! - mem_local=-1 - DATA="" - OPEN(121245,FILE="/proc/self/statm",ACTION="READ",STATUS="OLD",ACCESS="STREAM") - DO I=1,80 - READ(121245,END=999) DATA(I:I) - ENDDO -999 CLOSE(121245) - DATA(I:80)="" - ! m1 = total - ! m2 = resident - ! m3 = shared - READ(DATA,*,IOSTAT=iostat) m1,m2,m3 - IF (iostat.NE.0) THEN - mem_local=0 - ELSE - mem_local=m2 + INTEGER(KIND=int_8) :: m1, m2, m3 + CHARACTER(LEN=80) :: DATA + INTEGER :: iostat, i + + ! the size of a page, might not be available everywhere + INTERFACE + FUNCTION getpagesize() BIND(C, name="getpagesize") RESULT(RES) + IMPORT + INTEGER(C_INT) :: RES + END FUNCTION + END INTERFACE + + ! + ! reading from statm + ! + mem_local = -1 + DATA = "" + OPEN (121245, FILE="/proc/self/statm", ACTION="READ", STATUS="OLD", ACCESS="STREAM") + DO I = 1, 80 + READ (121245, END=999) DATA(I:I) + ENDDO +999 CLOSE (121245) + DATA(I:80) = "" + ! m1 = total + ! m2 = resident + ! m3 = shared + READ (DATA, *, IOSTAT=iostat) m1, m2, m3 + IF (iostat .NE. 0) THEN + mem_local = 0 + ELSE + mem_local = m2 #if defined(__STATM_TOTAL) - mem_local=m1 + mem_local = m1 #endif #if defined(__STATM_RESIDENT) - mem_local=m2 + mem_local = m2 #endif - mem_local=mem_local*getpagesize() - ENDIF + mem_local = mem_local*getpagesize() + ENDIF #endif - m_memory_max=MAX(mem_local,m_memory_max) - IF (PRESENT(mem)) mem=mem_local + m_memory_max = MAX(mem_local, m_memory_max) + IF (PRESENT(mem)) mem = mem_local END SUBROUTINE m_memory - ! ************************************************************************************************** !> \brief get more detailed memory info, all units are bytes. !> the only 'useful' option is MemLikelyFree which is an estimate of remaining memory @@ -160,46 +156,44 @@ END SUBROUTINE m_memory !> \param SReclaimable ... !> \param MemLikelyFree ... ! ************************************************************************************************** - SUBROUTINE m_memory_details(MemTotal,MemFree,Buffers,Cached,Slab,SReclaimable,MemLikelyFree) + SUBROUTINE m_memory_details(MemTotal, MemFree, Buffers, Cached, Slab, SReclaimable, MemLikelyFree) - INTEGER(kind=int_8), OPTIONAL :: MemTotal,MemFree,Buffers,Cached,Slab,SReclaimable,MemLikelyFree + INTEGER(kind=int_8), OPTIONAL :: MemTotal, MemFree, Buffers, Cached, Slab, SReclaimable, MemLikelyFree - INTEGER, PARAMETER :: Nbuffer=10000 + INTEGER, PARAMETER :: Nbuffer = 10000 CHARACTER(LEN=Nbuffer) :: meminfo - INTEGER :: i - MemTotal=0 - MemFree=0 - Buffers=0 - Cached=0 - Slab=0 - SReclaimable=0 - MemLikelyFree=0 - meminfo="" - - OPEN(UNIT=8123,file="/proc/meminfo",ACCESS="STREAM",ERR=901) - i=0 + MemTotal = 0 + MemFree = 0 + Buffers = 0 + Cached = 0 + Slab = 0 + SReclaimable = 0 + MemLikelyFree = 0 + meminfo = "" + + OPEN (UNIT=8123, file="/proc/meminfo", ACCESS="STREAM", ERR=901) + i = 0 DO - i=i+1 - IF (i>Nbuffer) EXIT - READ(8123,END=900,ERR=900) meminfo(i:i) + i = i + 1 + IF (i > Nbuffer) EXIT + READ (8123, END=900, ERR=900) meminfo(i:i) ENDDO - 900 CONTINUE - meminfo(i:Nbuffer)="" - 901 CONTINUE - CLOSE(8123,ERR=902) - 902 CONTINUE - MemTotal=get_field_value_in_bytes('MemTotal:') - MemFree=get_field_value_in_bytes('MemFree:') - Buffers=get_field_value_in_bytes('Buffers:') - Cached=get_field_value_in_bytes('Cached:') - Slab=get_field_value_in_bytes('Slab:') - SReclaimable=get_field_value_in_bytes('SReclaimable:') +900 CONTINUE + meminfo(i:Nbuffer) = "" +901 CONTINUE + CLOSE (8123, ERR=902) +902 CONTINUE + MemTotal = get_field_value_in_bytes('MemTotal:') + MemFree = get_field_value_in_bytes('MemFree:') + Buffers = get_field_value_in_bytes('Buffers:') + Cached = get_field_value_in_bytes('Cached:') + Slab = get_field_value_in_bytes('Slab:') + SReclaimable = get_field_value_in_bytes('SReclaimable:') ! opinions here vary but this might work - MemLikelyFree=MemFree+Buffers+Cached+SReclaimable - + MemLikelyFree = MemFree + Buffers + Cached + SReclaimable CONTAINS @@ -208,193 +202,187 @@ SUBROUTINE m_memory_details(MemTotal,MemFree,Buffers,Cached,Slab,SReclaimable,Me !> \param field ... !> \return ... ! ************************************************************************************************** - INTEGER(int_8) FUNCTION get_field_value_in_bytes(field) - CHARACTER(LEN=*) :: field - INTEGER :: start - INTEGER(KIND=int_8) :: value - get_field_value_in_bytes=0 - start=INDEX(meminfo,field) - IF (start.NE.0) THEN - start=start+LEN_TRIM(field) - IF (start.LT.Nbuffer) THEN - READ(meminfo(start:),*,ERR=999,END=999) value - ! XXXXXXX convert from Kb to bytes XXXXXXXX - get_field_value_in_bytes=value*1024 - 999 CONTINUE - ENDIF + INTEGER(int_8) FUNCTION get_field_value_in_bytes(field) + CHARACTER(LEN=*) :: field + INTEGER :: start + INTEGER(KIND=int_8) :: value + get_field_value_in_bytes = 0 + start = INDEX(meminfo, field) + IF (start .NE. 0) THEN + start = start + LEN_TRIM(field) + IF (start .LT. Nbuffer) THEN + READ (meminfo(start:), *, ERR=999, END=999) value + ! XXXXXXX convert from Kb to bytes XXXXXXXX + get_field_value_in_bytes = value*1024 +999 CONTINUE ENDIF - END FUNCTION + ENDIF + END FUNCTION END SUBROUTINE m_memory_details - ! ************************************************************************************************** !> \brief ... !> \param source ... !> \param TARGET ... ! ************************************************************************************************** - SUBROUTINE m_mov(source,TARGET) - - CHARACTER(LEN=*), INTENT(IN) :: source, TARGET - - INTEGER :: istat - - INTERFACE - FUNCTION unlink(path) BIND(C,name="unlink") RESULT(errno) - IMPORT - CHARACTER(KIND=C_CHAR), DIMENSION(*) :: path - INTEGER(KIND=C_INT) :: errno - END FUNCTION - END INTERFACE - - INTERFACE - FUNCTION rename(src, dest) BIND(C,name="rename") RESULT(errno) - IMPORT - CHARACTER(KIND=C_CHAR), DIMENSION(*) :: src, dest - INTEGER(KIND=C_INT) :: errno - END FUNCTION - END INTERFACE - - IF (TARGET==source) THEN - WRITE(*,*) "Warning: m_mov ",TRIM(TARGET)," equals ", TRIM(source) - RETURN - ENDIF - - ! first remove target (needed on windows / mingw) - istat = unlink(TRIM(TARGET)//c_null_char) - ! ignore istat of unlink - - ! now move - istat = rename(TRIM(source)//c_null_char, TRIM(TARGET)//c_null_char) - IF (istat .NE. 0) THEN - WRITE(*,*) "Trying to move "//TRIM(source)//" to "//TRIM(TARGET)//"." - WRITE(*,*) "rename returned status: ",istat - WRITE(*,*) "Problem moving file" - CALL m_abort() - ENDIF - END SUBROUTINE m_mov + SUBROUTINE m_mov(source, TARGET) + + CHARACTER(LEN=*), INTENT(IN) :: source, TARGET + INTEGER :: istat + + INTERFACE + FUNCTION unlink(path) BIND(C, name="unlink") RESULT(errno) + IMPORT + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: path + INTEGER(KIND=C_INT) :: errno + END FUNCTION + END INTERFACE + + INTERFACE + FUNCTION rename(src, dest) BIND(C, name="rename") RESULT(errno) + IMPORT + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: src, dest + INTEGER(KIND=C_INT) :: errno + END FUNCTION + END INTERFACE + + IF (TARGET == source) THEN + WRITE (*, *) "Warning: m_mov ", TRIM(TARGET), " equals ", TRIM(source) + RETURN + ENDIF + + ! first remove target (needed on windows / mingw) + istat = unlink(TRIM(TARGET)//c_null_char) + ! ignore istat of unlink + + ! now move + istat = rename(TRIM(source)//c_null_char, TRIM(TARGET)//c_null_char) + IF (istat .NE. 0) THEN + WRITE (*, *) "Trying to move "//TRIM(source)//" to "//TRIM(TARGET)//"." + WRITE (*, *) "rename returned status: ", istat + WRITE (*, *) "Problem moving file" + CALL m_abort() + ENDIF + END SUBROUTINE m_mov ! ************************************************************************************************** !> \brief ... !> \param hname ... ! ************************************************************************************************** SUBROUTINE m_hostnm(hname) - CHARACTER(len=*), INTENT(OUT) :: hname + CHARACTER(len=*), INTENT(OUT) :: hname #if defined(__MINGW) - ! While there is a gethostname in the Windows (POSIX) API, it requires that winsocks is - ! initialised prior to using it via WSAStartup(..), respectively cleaned up at the end via WSACleanup(). - hname = "" + ! While there is a gethostname in the Windows (POSIX) API, it requires that winsocks is + ! initialised prior to using it via WSAStartup(..), respectively cleaned up at the end via WSACleanup(). + hname = "" #else - INTEGER :: istat, i - CHARACTER(len=default_path_length) :: buf - - INTERFACE - FUNCTION gethostname(buf, buflen) BIND(C,name="gethostname") RESULT(errno) - IMPORT - CHARACTER(KIND=C_CHAR), DIMENSION(*) :: buf - INTEGER(KIND=C_INT), VALUE :: buflen - INTEGER(KIND=C_INT) :: errno - END FUNCTION - END INTERFACE - - istat = gethostname(buf, LEN(buf)) - IF(istat /= 0) THEN - WRITE (*,*) "m_hostnm failed" - CALL m_abort() - ENDIF - i = INDEX(buf, c_null_char) -1 - hname = buf(1:i) + INTEGER :: istat, i + CHARACTER(len=default_path_length) :: buf + + INTERFACE + FUNCTION gethostname(buf, buflen) BIND(C, name="gethostname") RESULT(errno) + IMPORT + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: buf + INTEGER(KIND=C_INT), VALUE :: buflen + INTEGER(KIND=C_INT) :: errno + END FUNCTION + END INTERFACE + + istat = gethostname(buf, LEN(buf)) + IF (istat /= 0) THEN + WRITE (*, *) "m_hostnm failed" + CALL m_abort() + ENDIF + i = INDEX(buf, c_null_char) - 1 + hname = buf(1:i) #endif END SUBROUTINE m_hostnm - ! ************************************************************************************************** !> \brief ... !> \param curdir ... ! ************************************************************************************************** SUBROUTINE m_getcwd(curdir) - CHARACTER(len=*), INTENT(OUT) :: curdir - TYPE(C_PTR) :: stat - INTEGER :: i - CHARACTER(len=default_path_length), TARGET :: tmp - - INTERFACE - FUNCTION getcwd(buf, buflen) BIND(C,name="getcwd") RESULT(stat) - IMPORT - CHARACTER(KIND=C_CHAR), DIMENSION(*) :: buf - INTEGER(KIND=C_INT), VALUE :: buflen - TYPE(C_PTR) :: stat - END FUNCTION - END INTERFACE - - stat = getcwd(tmp, LEN(tmp)) - IF(.NOT. C_ASSOCIATED(stat)) THEN - WRITE (*,*) "m_getcwd failed" - CALL m_abort() - ENDIF - i = INDEX(tmp, c_null_char) -1 - curdir = tmp(1:i) + CHARACTER(len=*), INTENT(OUT) :: curdir + TYPE(C_PTR) :: stat + INTEGER :: i + CHARACTER(len=default_path_length), TARGET :: tmp + + INTERFACE + FUNCTION getcwd(buf, buflen) BIND(C, name="getcwd") RESULT(stat) + IMPORT + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: buf + INTEGER(KIND=C_INT), VALUE :: buflen + TYPE(C_PTR) :: stat + END FUNCTION + END INTERFACE + + stat = getcwd(tmp, LEN(tmp)) + IF (.NOT. C_ASSOCIATED(stat)) THEN + WRITE (*, *) "m_getcwd failed" + CALL m_abort() + ENDIF + i = INDEX(tmp, c_null_char) - 1 + curdir = tmp(1:i) END SUBROUTINE m_getcwd - ! ************************************************************************************************** !> \brief ... !> \param dir ... !> \param ierror ... ! ************************************************************************************************** - SUBROUTINE m_chdir(dir,ierror) - CHARACTER(len=*), INTENT(IN) :: dir - INTEGER, INTENT(OUT) :: ierror - - INTERFACE - FUNCTION chdir(path) BIND(C,name="chdir") RESULT(errno) - IMPORT - CHARACTER(KIND=C_CHAR), DIMENSION(*) :: path - INTEGER(KIND=C_INT) :: errno - END FUNCTION - END INTERFACE - - ierror = chdir(TRIM(dir)//c_null_char) - END SUBROUTINE m_chdir + SUBROUTINE m_chdir(dir, ierror) + CHARACTER(len=*), INTENT(IN) :: dir + INTEGER, INTENT(OUT) :: ierror + + INTERFACE + FUNCTION chdir(path) BIND(C, name="chdir") RESULT(errno) + IMPORT + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: path + INTEGER(KIND=C_INT) :: errno + END FUNCTION + END INTERFACE + ierror = chdir(TRIM(dir)//c_null_char) + END SUBROUTINE m_chdir ! ************************************************************************************************** !> \brief ... !> \param user ... ! ************************************************************************************************** SUBROUTINE m_getlog(user) - CHARACTER(len=*), INTENT(OUT) :: user - INTEGER :: status - - ! on a posix system LOGNAME should be defined - CALL get_environment_variable("LOGNAME", value=user, status=status) - ! nope, check alternative - IF (status/=0) & - CALL get_environment_variable("USER", value=user, status=status) - ! nope, check alternative - IF (status/=0) & - CALL get_environment_variable("USERNAME", value=user, status=status) - ! fall back - IF (status/=0) & - user="" + CHARACTER(len=*), INTENT(OUT) :: user + INTEGER :: status + + ! on a posix system LOGNAME should be defined + CALL get_environment_variable("LOGNAME", value=user, status=status) + ! nope, check alternative + IF (status /= 0) & + CALL get_environment_variable("USER", value=user, status=status) + ! nope, check alternative + IF (status /= 0) & + CALL get_environment_variable("USERNAME", value=user, status=status) + ! fall back + IF (status /= 0) & + user = "" END SUBROUTINE m_getlog - ! ************************************************************************************************** !> \brief ... !> \param pid ... ! ************************************************************************************************** SUBROUTINE m_getpid(pid) - INTEGER, INTENT(OUT) :: pid + INTEGER, INTENT(OUT) :: pid - INTERFACE - FUNCTION getpid() BIND(C,name="getpid") RESULT(pid) - IMPORT - INTEGER(KIND=C_INT) :: pid - END FUNCTION - END INTERFACE + INTERFACE + FUNCTION getpid() BIND(C, name="getpid") RESULT(pid) + IMPORT + INTEGER(KIND=C_INT) :: pid + END FUNCTION + END INTERFACE - pid = getpid() + pid = getpid() END SUBROUTINE m_getpid diff --git a/src/basis_set_output.F b/src/basis_set_output.F index 73f4daaac8..0515908239 100644 --- a/src/basis_set_output.F +++ b/src/basis_set_output.F @@ -67,7 +67,7 @@ SUBROUTINE print_basis_set_file(qs_env, base_section) TYPE(qs_kind_type), POINTER :: qs_kind IF (ncalls > 0) RETURN - ncalls = ncalls+1 + ncalls = ncalls + 1 logger => cp_get_default_logger() ounit = cp_logger_get_default_io_unit(logger) @@ -165,7 +165,7 @@ SUBROUTINE basis_out(basis, element_symbol, bname, iunit) lset = 0 DO ishell = 1, nshell(iset) ll = l(ishell, iset) - lset(ll) = lset(ll)+1 + lset(ll) = lset(ll) + 1 END DO WRITE (iunit, "(I5,2I3,I5,2X,10(I3))") n(1, iset), lmin(iset), lmax(iset), npgf(iset), & (lset(ll), ll=lmin(iset), lmax(iset)) diff --git a/src/beta_gamma_psi.F b/src/beta_gamma_psi.F index 358ad066f5..0eb6a5194b 100644 --- a/src/beta_gamma_psi.F +++ b/src/beta_gamma_psi.F @@ -5,16 +5,16 @@ ! ************************************************************************************************** MODULE beta_gamma_psi - ! not tested in the case where dp would stand for single precision - + ! not tested in the case where dp would stand for single precision + USE kinds, ONLY: dp #include "./base/base_uses.f90" - IMPLICIT NONE + IMPLICIT NONE - PRIVATE + PRIVATE - PUBLIC :: erf1, gamln, psi + PUBLIC :: erf1, gamln, psi CONTAINS @@ -23,7 +23,7 @@ MODULE beta_gamma_psi !> \param i ... !> \return ... ! ************************************************************************************************** -FUNCTION ipmpar (i) RESULT(fn_val) + FUNCTION ipmpar(i) RESULT(fn_val) !----------------------------------------------------------------------- ! IPMPAR PROVIDES THE INTEGER MACHINE CONSTANTS FOR THE COMPUTER @@ -78,39 +78,39 @@ FUNCTION ipmpar (i) RESULT(fn_val) INTEGER, INTENT(IN) :: i INTEGER :: fn_val -SELECT CASE(i) - CASE( 1) - fn_val = RADIX(i) - CASE( 2) - fn_val = DIGITS(i) - CASE( 3) - fn_val = HUGE(i) - CASE( 4) - fn_val = RADIX(1.0) - CASE( 5) - fn_val = DIGITS(1.0) - CASE( 6) - fn_val = MINEXPONENT(1.0) - CASE( 7) - fn_val = MAXEXPONENT(1.0) - CASE( 8) - fn_val = DIGITS(1.0e0_dp) - CASE( 9) - fn_val = MINEXPONENT(1.0e0_dp) - CASE(10) - fn_val = MAXEXPONENT(1.0e0_dp) - CASE DEFAULT - CPABORT("unknown case") -END SELECT - -END FUNCTION ipmpar + SELECT CASE (i) + CASE (1) + fn_val = RADIX(i) + CASE (2) + fn_val = DIGITS(i) + CASE (3) + fn_val = HUGE(i) + CASE (4) + fn_val = RADIX(1.0) + CASE (5) + fn_val = DIGITS(1.0) + CASE (6) + fn_val = MINEXPONENT(1.0) + CASE (7) + fn_val = MAXEXPONENT(1.0) + CASE (8) + fn_val = DIGITS(1.0e0_dp) + CASE (9) + fn_val = MINEXPONENT(1.0e0_dp) + CASE (10) + fn_val = MAXEXPONENT(1.0e0_dp) + CASE DEFAULT + CPABORT("unknown case") + END SELECT + + END FUNCTION ipmpar ! ************************************************************************************************** !> \brief ... !> \param i ... !> \return ... ! ************************************************************************************************** -FUNCTION dpmpar (i) RESULT(fn_val) + FUNCTION dpmpar(i) RESULT(fn_val) !----------------------------------------------------------------------- ! DPMPAR PROVIDES THE DOUBLE PRECISION MACHINE CONSTANTS FOR @@ -133,22 +133,22 @@ FUNCTION dpmpar (i) RESULT(fn_val) ! Local variable -SELECT CASE (i) - CASE (1) - fn_val = EPSILON(one) - CASE (2) - fn_val = TINY(one) - CASE (3) - fn_val = HUGE(one) -END SELECT + SELECT CASE (i) + CASE (1) + fn_val = EPSILON(one) + CASE (2) + fn_val = TINY(one) + CASE (3) + fn_val = HUGE(one) + END SELECT -END FUNCTION dpmpar + END FUNCTION dpmpar ! ************************************************************************************************** !> \brief ... !> \return ... ! ************************************************************************************************** -FUNCTION epsln () RESULT(fn_val) + FUNCTION epsln() RESULT(fn_val) !-------------------------------------------------------------------- ! THE EVALUATION OF LN(EPS) WHERE EPS IS THE SMALLEST NUMBER ! SUCH THAT 1.0 + EPS .GT. 1.0 . L IS A DUMMY ARGUMENT. @@ -159,16 +159,16 @@ FUNCTION epsln () RESULT(fn_val) ! Local variable -fn_val = LOG( EPSILON(one) ) + fn_val = LOG(EPSILON(one)) -END FUNCTION epsln + END FUNCTION epsln ! ************************************************************************************************** !> \brief ... !> \param l ... !> \return ... ! ************************************************************************************************** -FUNCTION exparg (l) RESULT(fn_val) + FUNCTION exparg(l) RESULT(fn_val) !-------------------------------------------------------------------- ! IF L = 0 THEN EXPARG(L) = THE LARGEST POSITIVE W FOR WHICH ! EXP(W) CAN BE COMPUTED. @@ -185,19 +185,19 @@ FUNCTION exparg (l) RESULT(fn_val) ! Local variable -IF (l == 0) THEN - fn_val = LOG( HUGE(one) ) -ELSE - fn_val = LOG( TINY(one) ) -END IF + IF (l == 0) THEN + fn_val = LOG(HUGE(one)) + ELSE + fn_val = LOG(TINY(one)) + END IF -END FUNCTION exparg + END FUNCTION exparg ! ************************************************************************************************** !> \brief ... !> \return ... ! ************************************************************************************************** -FUNCTION depsln () RESULT(fn_val) + FUNCTION depsln() RESULT(fn_val) !-------------------------------------------------------------------- ! THE EVALUATION OF LN(EPS) WHERE EPS IS THE SMALLEST NUMBER ! SUCH THAT 1.e0_dp + EPS .GT. 1.e0_dp . L IS A DUMMY ARGUMENT. @@ -208,16 +208,16 @@ FUNCTION depsln () RESULT(fn_val) ! Local variable -fn_val = LOG( EPSILON(one) ) + fn_val = LOG(EPSILON(one)) -END FUNCTION depsln + END FUNCTION depsln ! ************************************************************************************************** !> \brief ... !> \param l ... !> \return ... ! ************************************************************************************************** -FUNCTION dxparg (l) RESULT(fn_val) + FUNCTION dxparg(l) RESULT(fn_val) !-------------------------------------------------------------------- ! IF L = 0 THEN DXPARG(L) = THE LARGEST POSITIVE W FOR WHICH ! DEXP(W) CAN BE COMPUTED. @@ -234,20 +234,20 @@ FUNCTION dxparg (l) RESULT(fn_val) ! Local variable -IF (l == 0) THEN - fn_val = LOG( HUGE(one) ) -ELSE - fn_val = LOG( TINY(one) ) -END IF + IF (l == 0) THEN + fn_val = LOG(HUGE(one)) + ELSE + fn_val = LOG(TINY(one)) + END IF -END FUNCTION dxparg + END FUNCTION dxparg ! ************************************************************************************************** !> \brief ... !> \param a ... !> \return ... ! ************************************************************************************************** -FUNCTION alnrel(a) RESULT(fn_val) + FUNCTION alnrel(a) RESULT(fn_val) !----------------------------------------------------------------------- ! EVALUATION OF THE FUNCTION LN(1 + A) !----------------------------------------------------------------------- @@ -263,78 +263,78 @@ FUNCTION alnrel(a) RESULT(fn_val) !-------------------------- -IF (ABS(a) <= 0.375e0_dp) THEN - t = a/(a + two) - t2 = t*t - w = (((p3*t2 + p2)*t2 + p1)*t2 + one)/ (((q3*t2 + q2)*t2 + q1)*t2 + one) - fn_val = two*t*w -ELSE - x = one + a - IF (a < zero) x = (a + half) + half - fn_val = LOG(x) -END IF + IF (ABS(a) <= 0.375e0_dp) THEN + t = a/(a + two) + t2 = t*t + w = (((p3*t2 + p2)*t2 + p1)*t2 + one)/(((q3*t2 + q2)*t2 + q1)*t2 + one) + fn_val = two*t*w + ELSE + x = one + a + IF (a < zero) x = (a + half) + half + fn_val = LOG(x) + END IF -END FUNCTION alnrel + END FUNCTION alnrel ! ************************************************************************************************** !> \brief ... !> \param x ... !> \return ... ! ************************************************************************************************** -FUNCTION erf1(x) RESULT(fn_val) + FUNCTION erf1(x) RESULT(fn_val) !----------------------------------------------------------------------- ! EVALUATION OF THE REAL ERROR FUNCTION !----------------------------------------------------------------------- REAL(dp), INTENT(IN) :: x REAL(dp) :: fn_val - REAL(dp), PARAMETER :: a(5) = (/ .771058495001320e-04_dp, -.133733772997339e-02_dp, & - .323076579225834e-01_dp, .479137145607681e-01_dp, .128379167095513e+00_dp /), & - b(3) = (/ .301048631703895e-02_dp, .538971687740286e-01_dp,.375795757275549e+00_dp /), & - c = .564189583547756e0_dp, p(8) = (/-1.36864857382717e-07_dp, 5.64195517478974e-01_dp, & - 7.21175825088309e+00_dp, 4.31622272220567e+01_dp, 1.52989285046940e+02_dp,& - 3.39320816734344e+02_dp, 4.51918953711873e+02_dp, 3.00459261020162e+02_dp /) - REAL(dp), PARAMETER :: q(8) = (/ 1.00000000000000e+00_dp, 1.27827273196294e+01_dp, & - 7.70001529352295e+01_dp, 2.77585444743988e+02_dp,6.38980264465631e+02_dp, & - 9.31354094850610e+02_dp, 7.90950925327898e+02_dp, 3.00459260956983e+02_dp /), r(5) = (/ & - 2.10144126479064e+00_dp, 2.62370141675169e+01_dp, 2.13688200555087e+01_dp, & - 4.65807828718470e+00_dp, 2.82094791773523e-01_dp /), s(4) = (/ 9.41537750555460e+01_dp, & - 1.87114811799590e+02_dp, 9.90191814623914e+01_dp, 1.80124575948747e+01_dp /) + REAL(dp), PARAMETER :: a(5) = (/.771058495001320e-04_dp, -.133733772997339e-02_dp, & + .323076579225834e-01_dp, .479137145607681e-01_dp, .128379167095513e+00_dp/), & + b(3) = (/.301048631703895e-02_dp, .538971687740286e-01_dp, .375795757275549e+00_dp/), & + c = .564189583547756e0_dp, p(8) = (/-1.36864857382717e-07_dp, 5.64195517478974e-01_dp, & + 7.21175825088309e+00_dp, 4.31622272220567e+01_dp, 1.52989285046940e+02_dp, & + 3.39320816734344e+02_dp, 4.51918953711873e+02_dp, 3.00459261020162e+02_dp/) + REAL(dp), PARAMETER :: q(8) = (/1.00000000000000e+00_dp, 1.27827273196294e+01_dp, & + 7.70001529352295e+01_dp, 2.77585444743988e+02_dp, 6.38980264465631e+02_dp, & + 9.31354094850610e+02_dp, 7.90950925327898e+02_dp, 3.00459260956983e+02_dp/), r(5) = (/ & + 2.10144126479064e+00_dp, 2.62370141675169e+01_dp, 2.13688200555087e+01_dp, & + 4.65807828718470e+00_dp, 2.82094791773523e-01_dp/), s(4) = (/9.41537750555460e+01_dp, & + 1.87114811799590e+02_dp, 9.90191814623914e+01_dp, 1.80124575948747e+01_dp/) REAL(dp) :: ax, bot, t, top, x2 -ax = ABS(x) -IF (ax < 0.5e0_dp) THEN - t = x*x - top = ((((a(1)*t + a(2))*t + a(3))*t + a(4))*t + a(5)) + 1.0e0_dp - bot = ((b(1)*t + b(2))*t + b(3))*t + 1.0e0_dp - fn_val = x*(top/bot) - RETURN - -ELSE IF (ax < 4.0e0_dp) THEN - top = ((((((p(1)*ax + p(2))*ax + p(3))*ax + p(4))*ax + p(5))*ax & - + p(6))*ax + p(7))*ax + p(8) - bot = ((((((q(1)*ax + q(2))*ax + q(3))*ax + q(4))*ax + q(5))*ax & - + q(6))*ax + q(7))*ax + q(8) - fn_val = 0.5e0_dp + (0.5e0_dp - EXP(-x*x)*top/bot) - IF (x < 0.0e0_dp) fn_val = -fn_val - RETURN - -ELSE IF (ax < 5.8e0_dp) THEN - x2 = x*x - t = 1.0e0_dp/x2 - top = (((r(1)*t + r(2))*t + r(3))*t + r(4))*t + r(5) - bot = (((s(1)*t + s(2))*t + s(3))*t + s(4))*t + 1.0e0_dp - fn_val = (c - top/(x2*bot)) / ax - fn_val = 0.5e0_dp + (0.5e0_dp - EXP(-x2)*fn_val) - IF (x < 0.0e0_dp) fn_val = -fn_val - RETURN - -ELSE - fn_val = SIGN(1.0e0_dp,x) -END IF - -END FUNCTION erf1 + ax = ABS(x) + IF (ax < 0.5e0_dp) THEN + t = x*x + top = ((((a(1)*t + a(2))*t + a(3))*t + a(4))*t + a(5)) + 1.0e0_dp + bot = ((b(1)*t + b(2))*t + b(3))*t + 1.0e0_dp + fn_val = x*(top/bot) + RETURN + + ELSE IF (ax < 4.0e0_dp) THEN + top = ((((((p(1)*ax + p(2))*ax + p(3))*ax + p(4))*ax + p(5))*ax & + + p(6))*ax + p(7))*ax + p(8) + bot = ((((((q(1)*ax + q(2))*ax + q(3))*ax + q(4))*ax + q(5))*ax & + + q(6))*ax + q(7))*ax + q(8) + fn_val = 0.5e0_dp + (0.5e0_dp - EXP(-x*x)*top/bot) + IF (x < 0.0e0_dp) fn_val = -fn_val + RETURN + + ELSE IF (ax < 5.8e0_dp) THEN + x2 = x*x + t = 1.0e0_dp/x2 + top = (((r(1)*t + r(2))*t + r(3))*t + r(4))*t + r(5) + bot = (((s(1)*t + s(2))*t + s(3))*t + s(4))*t + 1.0e0_dp + fn_val = (c - top/(x2*bot))/ax + fn_val = 0.5e0_dp + (0.5e0_dp - EXP(-x2)*fn_val) + IF (x < 0.0e0_dp) fn_val = -fn_val + RETURN + + ELSE + fn_val = SIGN(1.0e0_dp, x) + END IF + + END FUNCTION erf1 ! ************************************************************************************************** !> \brief ... @@ -342,7 +342,7 @@ END FUNCTION erf1 !> \param x ... !> \return ... ! ************************************************************************************************** -FUNCTION erfc1 (ind, x) RESULT(fn_val) + FUNCTION erfc1(ind, x) RESULT(fn_val) !----------------------------------------------------------------------- ! EVALUATION OF THE COMPLEMENTARY ERROR FUNCTION @@ -353,128 +353,128 @@ FUNCTION erfc1 (ind, x) RESULT(fn_val) REAL(dp), INTENT(IN) :: x REAL(dp) :: fn_val - REAL(dp), PARAMETER :: a(5) = (/ .771058495001320e-04_dp, -.133733772997339e-02_dp, & - .323076579225834e-01_dp, .479137145607681e-01_dp, .128379167095513e+00_dp /), & - b(3) = (/ .301048631703895e-02_dp, .538971687740286e-01_dp,.375795757275549e+00_dp /), & - c = .564189583547756e0_dp, p(8) = (/-1.36864857382717e-07_dp, 5.64195517478974e-01_dp, & - 7.21175825088309e+00_dp, 4.31622272220567e+01_dp, 1.52989285046940e+02_dp,& - 3.39320816734344e+02_dp, 4.51918953711873e+02_dp, 3.00459261020162e+02_dp /) - REAL(dp), PARAMETER :: q(8) = (/ 1.00000000000000e+00_dp, 1.27827273196294e+01_dp, & - 7.70001529352295e+01_dp, 2.77585444743988e+02_dp,6.38980264465631e+02_dp, & - 9.31354094850610e+02_dp, 7.90950925327898e+02_dp, 3.00459260956983e+02_dp /), r(5) = (/ & - 2.10144126479064e+00_dp, 2.62370141675169e+01_dp, 2.13688200555087e+01_dp, & - 4.65807828718470e+00_dp, 2.82094791773523e-01_dp /), s(4) = (/ 9.41537750555460e+01_dp, & - 1.87114811799590e+02_dp, 9.90191814623914e+01_dp, 1.80124575948747e+01_dp /) + REAL(dp), PARAMETER :: a(5) = (/.771058495001320e-04_dp, -.133733772997339e-02_dp, & + .323076579225834e-01_dp, .479137145607681e-01_dp, .128379167095513e+00_dp/), & + b(3) = (/.301048631703895e-02_dp, .538971687740286e-01_dp, .375795757275549e+00_dp/), & + c = .564189583547756e0_dp, p(8) = (/-1.36864857382717e-07_dp, 5.64195517478974e-01_dp, & + 7.21175825088309e+00_dp, 4.31622272220567e+01_dp, 1.52989285046940e+02_dp, & + 3.39320816734344e+02_dp, 4.51918953711873e+02_dp, 3.00459261020162e+02_dp/) + REAL(dp), PARAMETER :: q(8) = (/1.00000000000000e+00_dp, 1.27827273196294e+01_dp, & + 7.70001529352295e+01_dp, 2.77585444743988e+02_dp, 6.38980264465631e+02_dp, & + 9.31354094850610e+02_dp, 7.90950925327898e+02_dp, 3.00459260956983e+02_dp/), r(5) = (/ & + 2.10144126479064e+00_dp, 2.62370141675169e+01_dp, 2.13688200555087e+01_dp, & + 4.65807828718470e+00_dp, 2.82094791773523e-01_dp/), s(4) = (/9.41537750555460e+01_dp, & + 1.87114811799590e+02_dp, 9.90191814623914e+01_dp, 1.80124575948747e+01_dp/) REAL(dp) :: ax, bot, e, t, top, w -ax = ABS(x) -IF (ax <= 0.5e0_dp) THEN - t = x*x - top = ((((a(1)*t + a(2))*t + a(3))*t + a(4))*t + a(5)) + 1.0e0_dp - bot = ((b(1)*t + b(2))*t + b(3))*t + 1.0e0_dp - fn_val = 0.5e0_dp + (0.5e0_dp - x*(top/bot)) - IF (ind /= 0) fn_val = EXP(t) * fn_val - RETURN -ENDIF + ax = ABS(x) + IF (ax <= 0.5e0_dp) THEN + t = x*x + top = ((((a(1)*t + a(2))*t + a(3))*t + a(4))*t + a(5)) + 1.0e0_dp + bot = ((b(1)*t + b(2))*t + b(3))*t + 1.0e0_dp + fn_val = 0.5e0_dp + (0.5e0_dp - x*(top/bot)) + IF (ind /= 0) fn_val = EXP(t)*fn_val + RETURN + ENDIF ! 0.5 < ABS(X) <= 4 -IF (ax <= 4.0e0_dp) THEN -top = ((((((p(1)*ax + p(2))*ax + p(3))*ax + p(4))*ax + p(5))*ax & - + p(6))*ax + p(7))*ax + p(8) -bot = ((((((q(1)*ax + q(2))*ax + q(3))*ax + q(4))*ax + q(5))*ax & - + q(6))*ax + q(7))*ax + q(8) -fn_val = top/bot -ELSE + IF (ax <= 4.0e0_dp) THEN + top = ((((((p(1)*ax + p(2))*ax + p(3))*ax + p(4))*ax + p(5))*ax & + + p(6))*ax + p(7))*ax + p(8) + bot = ((((((q(1)*ax + q(2))*ax + q(3))*ax + q(4))*ax + q(5))*ax & + + q(6))*ax + q(7))*ax + q(8) + fn_val = top/bot + ELSE ! ABS(X) > 4 -IF (x <= -5.6e0_dp) THEN + IF (x <= -5.6e0_dp) THEN ! LIMIT VALUE FOR LARGE NEGATIVE X - fn_val = 2.0e0_dp - IF (ind /= 0) fn_val = 2.0e0_dp*EXP(x*x) - RETURN -ENDIF -IF (ind==0.AND.(x > 100.0e0_dp.OR.x*x > -dxparg(1))) THEN - ! LIMIT VALUE FOR LARGE POSITIVE X - ! WHEN IND = 0 - fn_val = 0.0e0_dp - RETURN -ENDIF - -t = (1.0e0_dp/x)**2 -top = (((r(1)*t + r(2))*t + r(3))*t + r(4))*t + r(5) -bot = (((s(1)*t + s(2))*t + s(3))*t + s(4))*t + 1.0e0_dp -fn_val = (c - t*top/bot)/ax -ENDIF + fn_val = 2.0e0_dp + IF (ind /= 0) fn_val = 2.0e0_dp*EXP(x*x) + RETURN + ENDIF + IF (ind == 0 .AND. (x > 100.0e0_dp .OR. x*x > -dxparg(1))) THEN + ! LIMIT VALUE FOR LARGE POSITIVE X + ! WHEN IND = 0 + fn_val = 0.0e0_dp + RETURN + ENDIF + + t = (1.0e0_dp/x)**2 + top = (((r(1)*t + r(2))*t + r(3))*t + r(4))*t + r(5) + bot = (((s(1)*t + s(2))*t + s(3))*t + s(4))*t + 1.0e0_dp + fn_val = (c - t*top/bot)/ax + ENDIF ! FINAL ASSEMBLY -IF (ind /= 0) THEN - IF (x < 0.0e0_dp) fn_val = 2.0e0_dp*EXP(x*x) - fn_val - RETURN -END IF -w = x * x -t = w -e = w - t -fn_val = ((0.5e0_dp + (0.5e0_dp - e)) * EXP(-t)) * fn_val -IF (x < 0.0e0_dp) fn_val = 2.0e0_dp - fn_val + IF (ind /= 0) THEN + IF (x < 0.0e0_dp) fn_val = 2.0e0_dp*EXP(x*x) - fn_val + RETURN + END IF + w = x*x + t = w + e = w - t + fn_val = ((0.5e0_dp + (0.5e0_dp - e))*EXP(-t))*fn_val + IF (x < 0.0e0_dp) fn_val = 2.0e0_dp - fn_val -END FUNCTION erfc1 + END FUNCTION erfc1 ! ************************************************************************************************** !> \brief ... !> \param a ... !> \return ... ! ************************************************************************************************** -FUNCTION gam1(a) RESULT(fn_val) + FUNCTION gam1(a) RESULT(fn_val) !----------------------------------------------------------------------- ! COMPUTATION OF 1/GAMMA(A+1) - 1 FOR -0.5 <= A <= 1.5 !----------------------------------------------------------------------- REAL(dp), INTENT(IN) :: a REAL(dp) :: fn_val - REAL(dp), PARAMETER :: p(7) = (/ .577215664901533e+00_dp, -.409078193005776e+00_dp,& - -.230975380857675e+00_dp, .597275330452234e-01_dp, .766968181649490e-02_dp, & - -.514889771323592e-02_dp, .589597428611429e-03_dp /), q(5) = (/ .100000000000000e+01_dp, & - .427569613095214e+00_dp, .158451672430138e+00_dp, .261132021441447e-01_dp, & - .423244297896961e-02_dp /) - REAL(dp), PARAMETER :: r(9) = (/ -.422784335098468e+00_dp, -.771330383816272e+00_dp, & - -.244757765222226e+00_dp, .118378989872749e+00_dp, .930357293360349e-03_dp,& - -.118290993445146e-01_dp, .223047661158249e-02_dp, .266505979058923e-03_dp, & - -.132674909766242e-03_dp /), s1 = .273076135303957e+00_dp, s2 = .559398236957378e-01_dp + REAL(dp), PARAMETER :: p(7) = (/.577215664901533e+00_dp, -.409078193005776e+00_dp, & + -.230975380857675e+00_dp, .597275330452234e-01_dp, .766968181649490e-02_dp, & + -.514889771323592e-02_dp, .589597428611429e-03_dp/), q(5) = (/.100000000000000e+01_dp, & + .427569613095214e+00_dp, .158451672430138e+00_dp, .261132021441447e-01_dp, & + .423244297896961e-02_dp/), r(9) = (/-.422784335098468e+00_dp, -.771330383816272e+00_dp, & + -.244757765222226e+00_dp, .118378989872749e+00_dp, .930357293360349e-03_dp, & + -.118290993445146e-01_dp, .223047661158249e-02_dp, .266505979058923e-03_dp, & + -.132674909766242e-03_dp/) + REAL(dp), PARAMETER :: s1 = .273076135303957e+00_dp, s2 = .559398236957378e-01_dp REAL(dp) :: bot, d, t, top, w -t = a -d = a - 0.5e0_dp -IF (d > 0.0e0_dp) t = d - 0.5e0_dp - -IF (t > 0.e0_dp) THEN - top = (((((p(7)*t + p(6))*t + p(5))*t + p(4))*t + p(3))*t + p(2))*t + p(1) - bot = (((q(5)*t + q(4))*t + q(3))*t + q(2))*t + 1.0e0_dp - w = top/bot - IF (d > 0.0e0_dp) THEN - fn_val = (t/a)*((w - 0.5e0_dp) - 0.5e0_dp) - ELSE - fn_val = a*w - END IF -ELSE IF (t < 0.e0_dp) THEN - top = (((((((r(9)*t + r(8))*t + r(7))*t + r(6))*t + r(5))*t & - + r(4))*t + r(3))*t + r(2))*t + r(1) - bot = (s2*t + s1)*t + 1.0e0_dp - w = top/bot - IF (d > 0.0e0_dp) THEN - fn_val = t*w/a - ELSE - fn_val = a*((w + 0.5e0_dp) + 0.5e0_dp) - END IF -ELSE - fn_val = 0.0e0_dp -END IF - -END FUNCTION gam1 + t = a + d = a - 0.5e0_dp + IF (d > 0.0e0_dp) t = d - 0.5e0_dp + + IF (t > 0.e0_dp) THEN + top = (((((p(7)*t + p(6))*t + p(5))*t + p(4))*t + p(3))*t + p(2))*t + p(1) + bot = (((q(5)*t + q(4))*t + q(3))*t + q(2))*t + 1.0e0_dp + w = top/bot + IF (d > 0.0e0_dp) THEN + fn_val = (t/a)*((w - 0.5e0_dp) - 0.5e0_dp) + ELSE + fn_val = a*w + END IF + ELSE IF (t < 0.e0_dp) THEN + top = (((((((r(9)*t + r(8))*t + r(7))*t + r(6))*t + r(5))*t & + + r(4))*t + r(3))*t + r(2))*t + r(1) + bot = (s2*t + s1)*t + 1.0e0_dp + w = top/bot + IF (d > 0.0e0_dp) THEN + fn_val = t*w/a + ELSE + fn_val = a*((w + 0.5e0_dp) + 0.5e0_dp) + END IF + ELSE + fn_val = 0.0e0_dp + END IF + + END FUNCTION gam1 ! ************************************************************************************************** !> \brief ... @@ -482,7 +482,7 @@ END FUNCTION gam1 !> \param b ... !> \return ... ! ************************************************************************************************** -FUNCTION algdiv (a, b) RESULT(fn_val) + FUNCTION algdiv(a, b) RESULT(fn_val) !----------------------------------------------------------------------- ! COMPUTATION OF LN(GAMMA(B)/GAMMA(A+B)) WHEN B >= 8 @@ -503,51 +503,51 @@ FUNCTION algdiv (a, b) RESULT(fn_val) REAL(dp) :: c, d, h, s11, s3, s5, s7, s9, t, u, v, & w, x, x2 -IF (a > b) THEN - h = b/a - c = 1.0e0_dp/(1.0e0_dp + h) - x = h/(1.0e0_dp + h) - d = a + (b - 0.5e0_dp) -ELSE - h = a/b - c = h/(1.0e0_dp + h) - x = 1.0e0_dp/(1.0e0_dp + h) - d = b + (a - 0.5e0_dp) -END IF + IF (a > b) THEN + h = b/a + c = 1.0e0_dp/(1.0e0_dp + h) + x = h/(1.0e0_dp + h) + d = a + (b - 0.5e0_dp) + ELSE + h = a/b + c = h/(1.0e0_dp + h) + x = 1.0e0_dp/(1.0e0_dp + h) + d = b + (a - 0.5e0_dp) + END IF ! SET SN = (1 - X**N)/(1 - X) -x2 = x*x -s3 = 1.0e0_dp + (x + x2) -s5 = 1.0e0_dp + (x + x2*s3) -s7 = 1.0e0_dp + (x + x2*s5) -s9 = 1.0e0_dp + (x + x2*s7) -s11 = 1.0e0_dp + (x + x2*s9) + x2 = x*x + s3 = 1.0e0_dp + (x + x2) + s5 = 1.0e0_dp + (x + x2*s3) + s7 = 1.0e0_dp + (x + x2*s5) + s9 = 1.0e0_dp + (x + x2*s7) + s11 = 1.0e0_dp + (x + x2*s9) ! SET W = DEL(B) - DEL(A + B) -t = (1.0e0_dp/b)**2 -w = ((((c5*s11*t + c4*s9)*t + c3*s7)*t + c2*s5)*t + c1*s3)*t + c0 -w = w*(c/b) + t = (1.0e0_dp/b)**2 + w = ((((c5*s11*t + c4*s9)*t + c3*s7)*t + c2*s5)*t + c1*s3)*t + c0 + w = w*(c/b) ! COMBINE THE RESULTS -u = d*alnrel(a/b) -v = a*(LOG(b) - 1.0e0_dp) -IF (u > v) THEN - fn_val = (w - v) - u -ELSE - fn_val = (w - u) - v -END IF + u = d*alnrel(a/b) + v = a*(LOG(b) - 1.0e0_dp) + IF (u > v) THEN + fn_val = (w - v) - u + ELSE + fn_val = (w - u) - v + END IF -END FUNCTION algdiv + END FUNCTION algdiv ! ************************************************************************************************** !> \brief ... !> \param x ... !> \return ... ! ************************************************************************************************** -FUNCTION rexp (x) RESULT(fn_val) + FUNCTION rexp(x) RESULT(fn_val) !----------------------------------------------------------------------- ! EVALUATION OF THE FUNCTION EXP(X) - 1 !----------------------------------------------------------------------- @@ -560,23 +560,23 @@ FUNCTION rexp (x) RESULT(fn_val) REAL(dp) :: e -IF (ABS(x) < 0.15e0_dp) THEN - fn_val = x*(((p2*x + p1)*x + 1.0e0_dp)/((((q4*x + q3)*x + q2)*x + q1)*x + 1.0e0_dp)) - RETURN -END IF - -IF (x < 0.0e0_dp) THEN - IF (x > -37.0e0_dp) THEN - fn_val = (EXP(x) - 0.5e0_dp) - 0.5e0_dp - ELSE - fn_val = -1.0e0_dp - ENDIF -ELSE - e = EXP(x) - fn_val = e*(0.5e0_dp + (0.5e0_dp - 1.0e0_dp/e)) -ENDIF + IF (ABS(x) < 0.15e0_dp) THEN + fn_val = x*(((p2*x + p1)*x + 1.0e0_dp)/((((q4*x + q3)*x + q2)*x + q1)*x + 1.0e0_dp)) + RETURN + END IF + + IF (x < 0.0e0_dp) THEN + IF (x > -37.0e0_dp) THEN + fn_val = (EXP(x) - 0.5e0_dp) - 0.5e0_dp + ELSE + fn_val = -1.0e0_dp + ENDIF + ELSE + e = EXP(x) + fn_val = e*(0.5e0_dp + (0.5e0_dp - 1.0e0_dp/e)) + ENDIF -END FUNCTION rexp + END FUNCTION rexp ! ************************************************************************************************** !> \brief ... @@ -588,7 +588,7 @@ END FUNCTION rexp !> \param eps ... !> \param ierr ... ! ************************************************************************************************** -SUBROUTINE bgrat (a, b, x, y, w, eps, ierr) + SUBROUTINE bgrat(a, b, x, y, w, eps, ierr) !----------------------------------------------------------------------- ! ASYMPTOTIC EXPANSION FOR IX(A,B) WHEN A IS LARGER THAN B. ! THE RESULT OF THE EXPANSION IS ADDED TO W. IT IS ASSUMED @@ -608,75 +608,75 @@ SUBROUTINE bgrat (a, b, x, y, w, eps, ierr) j, l, lnx, n2, nu, q, r, s, sum, t, & t2, tol, u, v, z -bm1 = (b - half) - half -nu = a + half*bm1 -IF (y > 0.375e0_dp) THEN - lnx = LOG(x) -ELSE - lnx = alnrel(-y) -ENDIF -z = -nu*lnx -IF (b*z == zero) THEN - ! THE EXPANSION CANNOT BE COMPUTED - ierr = 1 - RETURN -ENDIF + bm1 = (b - half) - half + nu = a + half*bm1 + IF (y > 0.375e0_dp) THEN + lnx = LOG(x) + ELSE + lnx = alnrel(-y) + ENDIF + z = -nu*lnx + IF (b*z == zero) THEN + ! THE EXPANSION CANNOT BE COMPUTED + ierr = 1 + RETURN + ENDIF ! COMPUTATION OF THE EXPANSION ! SET R = EXP(-Z)*Z**B/GAMMA(B) -r = b*(one + gam1(b))*EXP(b*LOG(z)) -r = r*EXP(a*lnx)*EXP(half*bm1*lnx) -u = algdiv(b,a) + b*LOG(nu) -u = r*EXP(-u) -IF (u == zero) THEN - ! THE EXPANSION CANNOT BE COMPUTED - ierr = 1 - RETURN -ENDIF -CALL grat1 (b, z, r, q=q, eps=eps) - -tol = 15.0e0_dp*eps -v = quarter*(one/nu)**2 -t2 = quarter*lnx*lnx -l = w/u -j = q/r -sum = j -t = one -cn = one -n2 = zero -DO n = 1,30 - bp2n = b + n2 - j = (bp2n*(bp2n + one)*j + (z + bp2n + one)*t)*v - n2 = n2 + 2.0e0_dp - t = t*t2 - cn = cn/(n2*(n2 + one)) - c(n) = cn - s = zero - IF (.NOT.(n == 1)) THEN - coef = b - n - DO i = 1, n-1 - s = s + coef*c(i)*d(n-i) - coef = coef + b - END DO - ENDIF - d(n) = bm1*cn + s/n - dj = d(n)*j - sum = sum + dj - IF (sum <= zero) THEN - ! THE EXPANSION CANNOT BE COMPUTED - ierr = 1 - RETURN - ENDIF - IF (ABS(dj) <= tol*(sum + l)) EXIT -END DO + r = b*(one + gam1(b))*EXP(b*LOG(z)) + r = r*EXP(a*lnx)*EXP(half*bm1*lnx) + u = algdiv(b, a) + b*LOG(nu) + u = r*EXP(-u) + IF (u == zero) THEN + ! THE EXPANSION CANNOT BE COMPUTED + ierr = 1 + RETURN + ENDIF + CALL grat1(b, z, r, q=q, eps=eps) + + tol = 15.0e0_dp*eps + v = quarter*(one/nu)**2 + t2 = quarter*lnx*lnx + l = w/u + j = q/r + sum = j + t = one + cn = one + n2 = zero + DO n = 1, 30 + bp2n = b + n2 + j = (bp2n*(bp2n + one)*j + (z + bp2n + one)*t)*v + n2 = n2 + 2.0e0_dp + t = t*t2 + cn = cn/(n2*(n2 + one)) + c(n) = cn + s = zero + IF (.NOT. (n == 1)) THEN + coef = b - n + DO i = 1, n - 1 + s = s + coef*c(i)*d(n - i) + coef = coef + b + END DO + ENDIF + d(n) = bm1*cn + s/n + dj = d(n)*j + sum = sum + dj + IF (sum <= zero) THEN + ! THE EXPANSION CANNOT BE COMPUTED + ierr = 1 + RETURN + ENDIF + IF (ABS(dj) <= tol*(sum + l)) EXIT + END DO ! ADD THE RESULTS TO W -ierr = 0 -w = w + u*sum + ierr = 0 + w = w + u*sum -END SUBROUTINE bgrat + END SUBROUTINE bgrat ! ************************************************************************************************** !> \brief ... @@ -687,7 +687,7 @@ END SUBROUTINE bgrat !> \param q ... !> \param eps ... ! ************************************************************************************************** -SUBROUTINE grat1 (a, x, r, p, q, eps) + SUBROUTINE grat1(a, x, r, p, q, eps) !----------------------------------------------------------------------- ! EVALUATION OF P(A,X) AND Q(A,X) WHERE A <= 1 AND ! THE INPUT ARGUMENT R HAS THE VALUE E**(-X)*X**A/GAMMA(A) @@ -703,96 +703,96 @@ SUBROUTINE grat1 (a, x, r, p, q, eps) REAL(dp) :: a2n, a2nm1, an, b2n, b2nm1, c, g, h, j, & l, pp, qq, sum, t, tol, w, z -IF (a*x == zero) THEN - IF (x <= a) THEN - pp = zero - qq = one - ELSE - pp = one - qq = zero - ENDIF - IF (PRESENT(p)) p = pp - IF (PRESENT(q)) q = qq - RETURN -ENDIF -IF (a == half) THEN -IF (x < quarter) THEN - pp = erf1(SQRT(x)) - qq = half + (half - pp) - ELSE - qq = erfc1(0,SQRT(x)) - pp = half + (half - qq) - END IF - IF (PRESENT(p)) p = pp - IF (PRESENT(q)) q = qq - RETURN -ENDIF -IF (x < 1.1e0_dp) THEN - ! TAYLOR SERIES FOR P(A,X)/X**A - - an = three - c = x - sum = x/(a + three) - tol = three*eps/(a + one) - an = an + one - c = -c*(x/an) - t = c/(a + an) - sum = sum + t - DO WHILE (ABS(t) > tol) - an = an + one - c = -c*(x/an) - t = c/(a + an) - sum = sum + t - END DO - j = a*x*((sum/6.0e0_dp - half/(a + two))*x + one/(a + one)) - - z = a*LOG(x) - h = gam1(a) - g = one + h - IF ((x < quarter.AND.z > -.13394e0_dp).OR.a < x/2.59e0_dp) THEN - l = rexp(z) - qq = ((half + (half + l))*j - l)*g - h - IF (qq <= zero) THEN - pp = one - qq = zero - ELSE - pp = half + (half - qq) - ENDIF - ELSE - w = EXP(z) - pp = w*g*(half + (half - j)) - qq = half + (half - pp) - ENDIF -ELSE - ! CONTINUED FRACTION EXPANSION - - tol = 8.0e0_dp*eps - a2nm1 = one - a2n = one - b2nm1 = x - b2n = x + (one - a) - c = one - DO - a2nm1 = x*a2n + c*a2nm1 - b2nm1 = x*b2n + c*b2nm1 - c = c + one - a2n = a2nm1 + (c - a)*a2n - b2n = b2nm1 + (c - a)*b2n - a2nm1 = a2nm1/b2n - b2nm1 = b2nm1/b2n - a2n = a2n/b2n - b2n = one - IF (ABS(a2n - a2nm1/b2nm1) < tol*a2n) EXIT - END DO - - qq = r*a2n - pp = half + (half - qq) -ENDIF - -IF (PRESENT(p)) p = pp -IF (PRESENT(q)) q = qq - -END SUBROUTINE grat1 + IF (a*x == zero) THEN + IF (x <= a) THEN + pp = zero + qq = one + ELSE + pp = one + qq = zero + ENDIF + IF (PRESENT(p)) p = pp + IF (PRESENT(q)) q = qq + RETURN + ENDIF + IF (a == half) THEN + IF (x < quarter) THEN + pp = erf1(SQRT(x)) + qq = half + (half - pp) + ELSE + qq = erfc1(0, SQRT(x)) + pp = half + (half - qq) + END IF + IF (PRESENT(p)) p = pp + IF (PRESENT(q)) q = qq + RETURN + ENDIF + IF (x < 1.1e0_dp) THEN + ! TAYLOR SERIES FOR P(A,X)/X**A + + an = three + c = x + sum = x/(a + three) + tol = three*eps/(a + one) + an = an + one + c = -c*(x/an) + t = c/(a + an) + sum = sum + t + DO WHILE (ABS(t) > tol) + an = an + one + c = -c*(x/an) + t = c/(a + an) + sum = sum + t + END DO + j = a*x*((sum/6.0e0_dp - half/(a + two))*x + one/(a + one)) + + z = a*LOG(x) + h = gam1(a) + g = one + h + IF ((x < quarter .AND. z > -.13394e0_dp) .OR. a < x/2.59e0_dp) THEN + l = rexp(z) + qq = ((half + (half + l))*j - l)*g - h + IF (qq <= zero) THEN + pp = one + qq = zero + ELSE + pp = half + (half - qq) + ENDIF + ELSE + w = EXP(z) + pp = w*g*(half + (half - j)) + qq = half + (half - pp) + ENDIF + ELSE + ! CONTINUED FRACTION EXPANSION + + tol = 8.0e0_dp*eps + a2nm1 = one + a2n = one + b2nm1 = x + b2n = x + (one - a) + c = one + DO + a2nm1 = x*a2n + c*a2nm1 + b2nm1 = x*b2n + c*b2nm1 + c = c + one + a2n = a2nm1 + (c - a)*a2n + b2n = b2nm1 + (c - a)*b2n + a2nm1 = a2nm1/b2n + b2nm1 = b2nm1/b2n + a2n = a2n/b2n + b2n = one + IF (ABS(a2n - a2nm1/b2nm1) < tol*a2n) EXIT + END DO + + qq = r*a2n + pp = half + (half - qq) + ENDIF + + IF (PRESENT(p)) p = pp + IF (PRESENT(q)) q = qq + + END SUBROUTINE grat1 ! ************************************************************************************************** !> \brief ... @@ -800,7 +800,7 @@ END SUBROUTINE grat1 !> \param x ... !> \return ... ! ************************************************************************************************** -FUNCTION esum (mu, x) RESULT(fn_val) + FUNCTION esum(mu, x) RESULT(fn_val) !----------------------------------------------------------------------- ! EVALUATION OF EXP(MU + X) !----------------------------------------------------------------------- @@ -810,32 +810,32 @@ FUNCTION esum (mu, x) RESULT(fn_val) REAL(dp) :: w -IF (x > 0.0e0_dp) THEN - IF (mu > 0.OR.mu+x<0.0_dp) THEN - w = mu - fn_val = EXP(w)*EXP(x) - ELSE - w=mu+x - fn_val = EXP(w) - ENDIF -ELSE - IF (mu < 0.OR.mu+x<0.0_dp) THEN - w = mu - fn_val = EXP(w)*EXP(x) - ELSE - w=mu+x - fn_val = EXP(w) - ENDIF -ENDIF - -END FUNCTION esum + IF (x > 0.0e0_dp) THEN + IF (mu > 0 .OR. mu + x < 0.0_dp) THEN + w = mu + fn_val = EXP(w)*EXP(x) + ELSE + w = mu + x + fn_val = EXP(w) + ENDIF + ELSE + IF (mu < 0 .OR. mu + x < 0.0_dp) THEN + w = mu + fn_val = EXP(w)*EXP(x) + ELSE + w = mu + x + fn_val = EXP(w) + ENDIF + ENDIF + + END FUNCTION esum ! ************************************************************************************************** !> \brief ... !> \param x ... !> \return ... ! ************************************************************************************************** -FUNCTION rlog1(x) RESULT(fn_val) + FUNCTION rlog1(x) RESULT(fn_val) !----------------------------------------------------------------------- ! EVALUATION OF THE FUNCTION X - LN(1 + X) !----------------------------------------------------------------------- @@ -851,44 +851,44 @@ FUNCTION rlog1(x) RESULT(fn_val) REAL(dp) :: r, t, u, up2, w, w1 -IF (x < -0.39e0_dp .OR. x > 0.57e0_dp) THEN - w = (x + 0.5e0_dp) + 0.5e0_dp - fn_val = x - LOG(w) - RETURN -ENDIF + IF (x < -0.39e0_dp .OR. x > 0.57e0_dp) THEN + w = (x + 0.5e0_dp) + 0.5e0_dp + fn_val = x - LOG(w) + RETURN + ENDIF ! ARGUMENT REDUCTION -IF (x < -0.18e0_dp) THEN - u = (x + 0.3e0_dp)/0.7e0_dp - up2 = u + 2.0e0_dp - w1 = a - u*0.3e0_dp -ELSEIF (x > 0.18e0_dp) THEN - t = 0.75e0_dp*x - u = t - 0.25e0_dp - up2 = t + 1.75e0_dp - w1 = b + u/3.0e0_dp -ELSE - u = x - up2 = u + 2.0e0_dp - w1 = 0.0e0_dp -ENDIF + IF (x < -0.18e0_dp) THEN + u = (x + 0.3e0_dp)/0.7e0_dp + up2 = u + 2.0e0_dp + w1 = a - u*0.3e0_dp + ELSEIF (x > 0.18e0_dp) THEN + t = 0.75e0_dp*x + u = t - 0.25e0_dp + up2 = t + 1.75e0_dp + w1 = b + u/3.0e0_dp + ELSE + u = x + up2 = u + 2.0e0_dp + w1 = 0.0e0_dp + ENDIF ! SERIES EXPANSION -r = u/up2 -t = r*r -w = ((p2*t + p1)*t + p0)/((q2*t + q1)*t + 1.0e0_dp) -fn_val = r*(u - 2.0e0_dp*t*w) + w1 + r = u/up2 + t = r*r + w = ((p2*t + p1)*t + p0)/((q2*t + q1)*t + 1.0e0_dp) + fn_val = r*(u - 2.0e0_dp*t*w) + w1 -END FUNCTION rlog1 + END FUNCTION rlog1 ! ************************************************************************************************** !> \brief ... !> \param a ... !> \return ... ! ************************************************************************************************** -FUNCTION gamln (a) RESULT(fn_val) + FUNCTION gamln(a) RESULT(fn_val) !----------------------------------------------------------------------- ! EVALUATION OF LN(GAMMA(A)) FOR POSITIVE A !----------------------------------------------------------------------- @@ -908,34 +908,34 @@ FUNCTION gamln (a) RESULT(fn_val) INTEGER :: i, n REAL(dp) :: t, w -IF (a <= 0.8e0_dp) THEN - fn_val = gamln1(a) - LOG(a) -ELSEIF (a <= 2.25e0_dp) THEN - t = (a - 0.5e0_dp) - 0.5e0_dp - fn_val = gamln1(t) -ELSEIF (a < 10.0e0_dp) THEN - n = INT(a - 1.25e0_dp) - t = a - w = 1.0e0_dp - DO i = 1, n - t = t - 1.0e0_dp - w = t*w - END DO - fn_val = gamln1(t - 1.0e0_dp) + LOG(w) -ELSE - t = (1.0e0_dp/a)**2 - w = (((((c5*t + c4)*t + c3)*t + c2)*t + c1)*t + c0)/a - fn_val = (d + w) + (a - 0.5e0_dp)*(LOG(a) - 1.0e0_dp) -ENDIF - -END FUNCTION gamln + IF (a <= 0.8e0_dp) THEN + fn_val = gamln1(a) - LOG(a) + ELSEIF (a <= 2.25e0_dp) THEN + t = (a - 0.5e0_dp) - 0.5e0_dp + fn_val = gamln1(t) + ELSEIF (a < 10.0e0_dp) THEN + n = INT(a - 1.25e0_dp) + t = a + w = 1.0e0_dp + DO i = 1, n + t = t - 1.0e0_dp + w = t*w + END DO + fn_val = gamln1(t - 1.0e0_dp) + LOG(w) + ELSE + t = (1.0e0_dp/a)**2 + w = (((((c5*t + c4)*t + c3)*t + c2)*t + c1)*t + c0)/a + fn_val = (d + w) + (a - 0.5e0_dp)*(LOG(a) - 1.0e0_dp) + ENDIF + + END FUNCTION gamln ! ************************************************************************************************** !> \brief ... !> \param a ... !> \return ... ! ************************************************************************************************** -FUNCTION gamln1 (a) RESULT(fn_val) + FUNCTION gamln1(a) RESULT(fn_val) !----------------------------------------------------------------------- ! EVALUATION OF LN(GAMMA(1 + A)) FOR -0.2 .LE. A .LE. 1.25 !----------------------------------------------------------------------- @@ -955,25 +955,25 @@ FUNCTION gamln1 (a) RESULT(fn_val) REAL(dp) :: w, x -IF (a < 0.6e0_dp) THEN - w = ((((((p6*a + p5)*a + p4)*a + p3)*a + p2)*a + p1)*a + p0)/ & - ((((((q6*a + q5)*a + q4)*a + q3)*a + q2)*a + q1)*a + 1.0e0_dp) - fn_val = -a*w -ELSE - x = (a - 0.5e0_dp) - 0.5e0_dp - w = (((((r5*x + r4)*x + r3)*x + r2)*x + r1)*x + r0)/ & - (((((s5*x + s4)*x + s3)*x + s2)*x + s1)*x + 1.0e0_dp) - fn_val = x*w -ENDIF + IF (a < 0.6e0_dp) THEN + w = ((((((p6*a + p5)*a + p4)*a + p3)*a + p2)*a + p1)*a + p0)/ & + ((((((q6*a + q5)*a + q4)*a + q3)*a + q2)*a + q1)*a + 1.0e0_dp) + fn_val = -a*w + ELSE + x = (a - 0.5e0_dp) - 0.5e0_dp + w = (((((r5*x + r4)*x + r3)*x + r2)*x + r1)*x + r0)/ & + (((((s5*x + s4)*x + s3)*x + s2)*x + s1)*x + 1.0e0_dp) + fn_val = x*w + ENDIF -END FUNCTION gamln1 + END FUNCTION gamln1 ! ************************************************************************************************** !> \brief ... !> \param xx ... !> \return ... ! ************************************************************************************************** -FUNCTION psi(xx) RESULT(fn_val) + FUNCTION psi(xx) RESULT(fn_val) !--------------------------------------------------------------------- ! EVALUATION OF THE DIGAMMA FUNCTION @@ -996,14 +996,14 @@ FUNCTION psi(xx) RESULT(fn_val) REAL(dp) :: fn_val REAL(dp), PARAMETER :: dx0 = 1.461632144968362341262659542325721325e0_dp, p1(7) = (/ & - .895385022981970e-02_dp, .477762828042627e+01_dp, .142441585084029e+03_dp, & - .118645200713425e+04_dp, .363351846806499e+04_dp,.413810161269013e+04_dp, & - .130560269827897e+04_dp /), p2(4) = (/ -.212940445131011e+01_dp, -.701677227766759e+01_dp,& - -.448616543918019e+01_dp,-.648157123766197e+00_dp /), piov4 = .785398163397448e0_dp, q1(6)& - = (/ .448452573429826e+02_dp, .520752771467162e+03_dp, .221000799247830e+04_dp, & - .364127349079381e+04_dp, .190831076596300e+04_dp,.691091682714533e-05_dp /) - REAL(dp), PARAMETER :: q2(4) = (/ .322703493791143e+02_dp, .892920700481861e+02_dp, & - .546117738103215e+02_dp, .777788548522962e+01_dp /) + .895385022981970e-02_dp, .477762828042627e+01_dp, .142441585084029e+03_dp, & + .118645200713425e+04_dp, .363351846806499e+04_dp, .413810161269013e+04_dp, & + .130560269827897e+04_dp/), p2(4) = (/-.212940445131011e+01_dp, -.701677227766759e+01_dp, & + -.448616543918019e+01_dp, -.648157123766197e+00_dp/), piov4 = .785398163397448e0_dp, q1(6)& + = (/.448452573429826e+02_dp, .520752771467162e+03_dp, .221000799247830e+04_dp, & + .364127349079381e+04_dp, .190831076596300e+04_dp, .691091682714533e-05_dp/) + REAL(dp), PARAMETER :: q2(4) = (/.322703493791143e+02_dp, .892920700481861e+02_dp, & + .546117738103215e+02_dp, .777788548522962e+01_dp/) INTEGER :: i, m, n, nq REAL(dp) :: aug, den, sgn, upper, w, x, xmax1, xmx0, & @@ -1032,125 +1032,125 @@ FUNCTION psi(xx) RESULT(fn_val) ! MAY BE REPRESENTED BY 1/X. !--------------------------------------------------------------------- -xmax1 = ipmpar(3) -xmax1 = MIN(xmax1, 1.0e0_dp/dpmpar(1)) -xsmall = 1.e-9_dp + xmax1 = ipmpar(3) + xmax1 = MIN(xmax1, 1.0e0_dp/dpmpar(1)) + xsmall = 1.e-9_dp !--------------------------------------------------------------------- -x = xx -aug = 0.0e0_dp -IF (x < 0.5e0_dp) THEN + x = xx + aug = 0.0e0_dp + IF (x < 0.5e0_dp) THEN !--------------------------------------------------------------------- ! X .LT. 0.5, USE REFLECTION FORMULA ! PSI(1-X) = PSI(X) + PI * COTAN(PI*X) !--------------------------------------------------------------------- -IF (ABS(x) <= xsmall) THEN - IF (x == 0.0e0_dp) THEN - ! ERROR RETURN - fn_val = 0.0e0_dp - RETURN - ENDIF + IF (ABS(x) <= xsmall) THEN + IF (x == 0.0e0_dp) THEN + ! ERROR RETURN + fn_val = 0.0e0_dp + RETURN + ENDIF !--------------------------------------------------------------------- ! 0 .LT. ABS(X) .LE. XSMALL. USE 1/X AS A SUBSTITUTE ! FOR PI*COTAN(PI*X) !--------------------------------------------------------------------- - aug = -1.0e0_dp / x - x = 1.0e0_dp - x -ELSE + aug = -1.0e0_dp/x + x = 1.0e0_dp - x + ELSE !--------------------------------------------------------------------- ! REDUCTION OF ARGUMENT FOR COTAN !--------------------------------------------------------------------- -w = - x -sgn = piov4 -IF (w <= 0.0e0_dp) THEN - w = - w - sgn = -sgn -ENDIF + w = -x + sgn = piov4 + IF (w <= 0.0e0_dp) THEN + w = -w + sgn = -sgn + ENDIF !--------------------------------------------------------------------- ! MAKE AN ERROR EXIT IF X .LE. -XMAX1 !--------------------------------------------------------------------- -IF (w >= xmax1) THEN - ! ERROR RETURN - fn_val = 0.0e0_dp - RETURN -ENDIF -nq = INT(w) -w = w - nq -nq = INT(w*4.0e0_dp) -w = 4.0e0_dp * (w - nq * .25e0_dp) + IF (w >= xmax1) THEN + ! ERROR RETURN + fn_val = 0.0e0_dp + RETURN + ENDIF + nq = INT(w) + w = w - nq + nq = INT(w*4.0e0_dp) + w = 4.0e0_dp*(w - nq*.25e0_dp) !--------------------------------------------------------------------- ! W IS NOW RELATED TO THE FRACTIONAL PART OF 4.0 * X. ! ADJUST ARGUMENT TO CORRESPOND TO VALUES IN FIRST ! QUADRANT AND DETERMINE SIGN !--------------------------------------------------------------------- -n = nq / 2 -IF ((n+n) /= nq) w = 1.0e0_dp - w -z = piov4 * w -m = n / 2 -IF ((m+m) /= n) sgn = - sgn + n = nq/2 + IF ((n + n) /= nq) w = 1.0e0_dp - w + z = piov4*w + m = n/2 + IF ((m + m) /= n) sgn = -sgn !--------------------------------------------------------------------- ! DETERMINE FINAL VALUE FOR -PI*COTAN(PI*X) !--------------------------------------------------------------------- -n = (nq + 1) / 2 -m = n / 2 -m = m + m -IF (m /= n) THEN - aug = sgn * ((SIN(z) / COS(z)) * 4.0e0_dp) -ELSE - !--------------------------------------------------------------------- - ! CHECK FOR SINGULARITY - !--------------------------------------------------------------------- - IF (z == 0.0e0_dp) THEN - ! ERROR RETURN - fn_val = 0.0e0_dp - RETURN - ENDIF + n = (nq + 1)/2 + m = n/2 + m = m + m + IF (m /= n) THEN + aug = sgn*((SIN(z)/COS(z))*4.0e0_dp) + ELSE + !--------------------------------------------------------------------- + ! CHECK FOR SINGULARITY + !--------------------------------------------------------------------- + IF (z == 0.0e0_dp) THEN + ! ERROR RETURN + fn_val = 0.0e0_dp + RETURN + ENDIF !--------------------------------------------------------------------- ! USE COS/SIN AS A SUBSTITUTE FOR COTAN, AND ! SIN/COS AS A SUBSTITUTE FOR TAN !--------------------------------------------------------------------- - aug = sgn * ((COS(z) / SIN(z)) * 4.0e0_dp) -ENDIF -x = 1.0e0_dp - x -ENDIF -ENDIF -IF (x <= 3.0e0_dp) THEN + aug = sgn*((COS(z)/SIN(z))*4.0e0_dp) + ENDIF + x = 1.0e0_dp - x + ENDIF + ENDIF + IF (x <= 3.0e0_dp) THEN !--------------------------------------------------------------------- ! 0.5 .LE. X .LE. 3.0 !--------------------------------------------------------------------- - den = x - upper = p1(1) * x - - DO i = 1, 5 - den = (den + q1(i)) * x - upper = (upper + p1(i+1)) * x - END DO - - den = (upper + p1(7)) / (den + q1(6)) - xmx0 = x - dx0 - fn_val = den * xmx0 + aug - RETURN -ENDIF + den = x + upper = p1(1)*x + + DO i = 1, 5 + den = (den + q1(i))*x + upper = (upper + p1(i + 1))*x + END DO + + den = (upper + p1(7))/(den + q1(6)) + xmx0 = x - dx0 + fn_val = den*xmx0 + aug + RETURN + ENDIF !--------------------------------------------------------------------- ! IF X .GE. XMAX1, PSI = LN(X) !--------------------------------------------------------------------- -IF (x < xmax1) THEN + IF (x < xmax1) THEN !--------------------------------------------------------------------- ! 3.0 .LT. X .LT. XMAX1 !--------------------------------------------------------------------- -w = 1.0e0_dp / (x * x) -den = w -upper = p2(1) * w + w = 1.0e0_dp/(x*x) + den = w + upper = p2(1)*w -DO i = 1, 3 - den = (den + q2(i)) * w - upper = (upper + p2(i+1)) * w -END DO + DO i = 1, 3 + den = (den + q2(i))*w + upper = (upper + p2(i + 1))*w + END DO -aug = upper / (den + q2(4)) - 0.5e0_dp / x + aug -ENDIF -fn_val = aug + LOG(x) + aug = upper/(den + q2(4)) - 0.5e0_dp/x + aug + ENDIF + fn_val = aug + LOG(x) -END FUNCTION psi + END FUNCTION psi ! ************************************************************************************************** !> \brief ... @@ -1158,7 +1158,7 @@ END FUNCTION psi !> \param b0 ... !> \return ... ! ************************************************************************************************** -FUNCTION betaln (a0, b0) RESULT(fn_val) + FUNCTION betaln(a0, b0) RESULT(fn_val) !----------------------------------------------------------------------- ! EVALUATION OF THE LOGARITHM OF THE BETA FUNCTION !----------------------------------------------------------------------- @@ -1174,90 +1174,90 @@ FUNCTION betaln (a0, b0) RESULT(fn_val) !-------------------------- -a = MIN(a0,b0) -b = MAX(a0,b0) + a = MIN(a0, b0) + b = MAX(a0, b0) !----------------------------------------------------------------------- ! PROCEDURE WHEN A .GE. 8 !----------------------------------------------------------------------- -IF (a >= 8.0e0_dp) THEN - w = bcorr(a,b) - h = a/b - c = h/(1.0e0_dp + h) - u = -(a - 0.5e0_dp)*LOG(c) - v = b*alnrel(h) - IF (u > v) THEN - fn_val = (((-0.5e0_dp*LOG(b) + e) + w) - v) - u - ELSE - fn_val = (((-0.5e0_dp*LOG(b) + e) + w) - u) - v - ENDIF + IF (a >= 8.0e0_dp) THEN + w = bcorr(a, b) + h = a/b + c = h/(1.0e0_dp + h) + u = -(a - 0.5e0_dp)*LOG(c) + v = b*alnrel(h) + IF (u > v) THEN + fn_val = (((-0.5e0_dp*LOG(b) + e) + w) - v) - u + ELSE + fn_val = (((-0.5e0_dp*LOG(b) + e) + w) - u) - v + ENDIF !----------------------------------------------------------------------- ! PROCEDURE WHEN A .LT. 1 !----------------------------------------------------------------------- -ELSEIF (a < 1.0e0_dp) THEN - IF (b < 8.0e0_dp) THEN - fn_val = gamln(a) + (gamln(b) - gamln(a + b)) - ELSE - fn_val = gamln(a) + algdiv(a,b) - ENDIF + ELSEIF (a < 1.0e0_dp) THEN + IF (b < 8.0e0_dp) THEN + fn_val = gamln(a) + (gamln(b) - gamln(a + b)) + ELSE + fn_val = gamln(a) + algdiv(a, b) + ENDIF !----------------------------------------------------------------------- ! PROCEDURE WHEN 1 .LE. A .LT. 8 !----------------------------------------------------------------------- -ELSEIF (a <= 2.0e0_dp) THEN - IF (b <= 2.0e0_dp) THEN - fn_val = gamln(a) + gamln(b) - gsumln(a,b) - RETURN - ENDIF - w = 0.0e0_dp - IF (b < 8.0e0_dp) THEN - ! REDUCTION OF B WHEN B .LT. 8 - - n = INT(b - 1.0e0_dp) - z = 1.0e0_dp - DO i = 1,n - b = b - 1.0e0_dp - z = z * (b/(a + b)) - END DO - fn_val = w + LOG(z) + (gamln(a) + (gamln(b) - gsumln(a,b))) - RETURN - ENDIF - fn_val = gamln(a) + algdiv(a,b) + ELSEIF (a <= 2.0e0_dp) THEN + IF (b <= 2.0e0_dp) THEN + fn_val = gamln(a) + gamln(b) - gsumln(a, b) + RETURN + ENDIF + w = 0.0e0_dp + IF (b < 8.0e0_dp) THEN + ! REDUCTION OF B WHEN B .LT. 8 + + n = INT(b - 1.0e0_dp) + z = 1.0e0_dp + DO i = 1, n + b = b - 1.0e0_dp + z = z*(b/(a + b)) + END DO + fn_val = w + LOG(z) + (gamln(a) + (gamln(b) - gsumln(a, b))) + RETURN + ENDIF + fn_val = gamln(a) + algdiv(a, b) ! REDUCTION OF A WHEN B .LE. 1000 -ELSEIF (b <= 1000.0e0_dp) THEN - n = INT(a - 1.0e0_dp) - w = 1.0e0_dp - DO i = 1, n - a = a - 1.0e0_dp - h = a/b - w = w * (h/(1.0e0_dp + h)) - END DO - w = LOG(w) - IF (b >= 8.0e0_dp) THEN - fn_val = w + gamln(a) + algdiv(a,b) - RETURN - ENDIF - - ! REDUCTION OF B WHEN B .LT. 8 - - n = INT(b - 1.0e0_dp) - z = 1.0e0_dp - DO i = 1,n - b = b - 1.0e0_dp - z = z * (b/(a + b)) - END DO - fn_val = w + LOG(z) + (gamln(a) + (gamln(b) - gsumln(a,b))) -ELSE + ELSEIF (b <= 1000.0e0_dp) THEN + n = INT(a - 1.0e0_dp) + w = 1.0e0_dp + DO i = 1, n + a = a - 1.0e0_dp + h = a/b + w = w*(h/(1.0e0_dp + h)) + END DO + w = LOG(w) + IF (b >= 8.0e0_dp) THEN + fn_val = w + gamln(a) + algdiv(a, b) + RETURN + ENDIF + + ! REDUCTION OF B WHEN B .LT. 8 + + n = INT(b - 1.0e0_dp) + z = 1.0e0_dp + DO i = 1, n + b = b - 1.0e0_dp + z = z*(b/(a + b)) + END DO + fn_val = w + LOG(z) + (gamln(a) + (gamln(b) - gsumln(a, b))) + ELSE ! REDUCTION OF A WHEN B .GT. 1000 - n = INT(a - 1.0e0_dp) - w = 1.0e0_dp - DO i = 1,n - a = a - 1.0e0_dp - w = w * (a/(1.0e0_dp + a/b)) - END DO - fn_val = (LOG(w) - n*LOG(b)) + (gamln(a) + algdiv(a,b)) -ENDIF + n = INT(a - 1.0e0_dp) + w = 1.0e0_dp + DO i = 1, n + a = a - 1.0e0_dp + w = w*(a/(1.0e0_dp + a/b)) + END DO + fn_val = (LOG(w) - n*LOG(b)) + (gamln(a) + algdiv(a, b)) + ENDIF -END FUNCTION betaln + END FUNCTION betaln ! ************************************************************************************************** !> \brief ... @@ -1265,7 +1265,7 @@ END FUNCTION betaln !> \param b ... !> \return ... ! ************************************************************************************************** -FUNCTION gsumln (a, b) RESULT(fn_val) + FUNCTION gsumln(a, b) RESULT(fn_val) !----------------------------------------------------------------------- ! EVALUATION OF THE FUNCTION LN(GAMMA(A + B)) ! FOR 1 .LE. A .LE. 2 AND 1 .LE. B .LE. 2 @@ -1275,15 +1275,15 @@ FUNCTION gsumln (a, b) RESULT(fn_val) REAL(dp) :: x -x = a + b - 2.e0_dp -IF (x <= 0.25e0_dp) THEN - fn_val = gamln1(1.0e0_dp + x) -ELSEIF (x <= 1.25e0_dp) THEN - fn_val = gamln1(x) + alnrel(x) -ELSE - fn_val = gamln1(x - 1.0e0_dp) + LOG(x*(1.0e0_dp + x)) -ENDIF -END FUNCTION gsumln + x = a + b - 2.e0_dp + IF (x <= 0.25e0_dp) THEN + fn_val = gamln1(1.0e0_dp + x) + ELSEIF (x <= 1.25e0_dp) THEN + fn_val = gamln1(x) + alnrel(x) + ELSE + fn_val = gamln1(x - 1.0e0_dp) + LOG(x*(1.0e0_dp + x)) + ENDIF + END FUNCTION gsumln ! ************************************************************************************************** !> \brief ... @@ -1291,7 +1291,7 @@ END FUNCTION gsumln !> \param b0 ... !> \return ... ! ************************************************************************************************** -FUNCTION bcorr (a0, b0) RESULT(fn_val) + FUNCTION bcorr(a0, b0) RESULT(fn_val) !----------------------------------------------------------------------- ! EVALUATION OF DEL(A0) + DEL(B0) - DEL(A0 + B0) WHERE @@ -1309,34 +1309,34 @@ FUNCTION bcorr (a0, b0) RESULT(fn_val) REAL(dp) :: a, b, c, h, s11, s3, s5, s7, s9, t, w, & x, x2 -a = MIN(a0, b0) -b = MAX(a0, b0) + a = MIN(a0, b0) + b = MAX(a0, b0) -h = a/b -c = h/(1.0e0_dp + h) -x = 1.0e0_dp/(1.0e0_dp + h) -x2 = x*x + h = a/b + c = h/(1.0e0_dp + h) + x = 1.0e0_dp/(1.0e0_dp + h) + x2 = x*x ! SET SN = (1 - X**N)/(1 - X) -s3 = 1.0e0_dp + (x + x2) -s5 = 1.0e0_dp + (x + x2*s3) -s7 = 1.0e0_dp + (x + x2*s5) -s9 = 1.0e0_dp + (x + x2*s7) -s11 = 1.0e0_dp + (x + x2*s9) + s3 = 1.0e0_dp + (x + x2) + s5 = 1.0e0_dp + (x + x2*s3) + s7 = 1.0e0_dp + (x + x2*s5) + s9 = 1.0e0_dp + (x + x2*s7) + s11 = 1.0e0_dp + (x + x2*s9) ! SET W = DEL(B) - DEL(A + B) -t = (1.0e0_dp/b)**2 -w = ((((c5*s11*t + c4*s9)*t + c3*s7)*t + c2*s5)*t + c1*s3)*t + c0 -w = w*(c/b) + t = (1.0e0_dp/b)**2 + w = ((((c5*s11*t + c4*s9)*t + c3*s7)*t + c2*s5)*t + c1*s3)*t + c0 + w = w*(c/b) ! COMPUTE DEL(A) + W -t = (1.0e0_dp/a)**2 -fn_val = (((((c5*t + c4)*t + c3)*t + c2)*t + c1)*t + c0)/a + w -RETURN -END FUNCTION bcorr + t = (1.0e0_dp/a)**2 + fn_val = (((((c5*t + c4)*t + c3)*t + c2)*t + c1)*t + c0)/a + w + RETURN + END FUNCTION bcorr ! ************************************************************************************************** !> \brief ... @@ -1348,7 +1348,7 @@ END FUNCTION bcorr !> \param w1 ... !> \param ierr ... ! ************************************************************************************************** -SUBROUTINE bratio (a, b, x, y, w, w1, ierr) + SUBROUTINE bratio(a, b, x, y, w, w1, ierr) !----------------------------------------------------------------------- ! EVALUATION OF THE INCOMPLETE BETA FUNCTION IX(A,B) @@ -1392,182 +1392,182 @@ SUBROUTINE bratio (a, b, x, y, w, w1, ierr) ! ****** EPS IS A MACHINE DEPENDENT CONSTANT. EPS IS THE SMALLEST ! FLOATING POINT NUMBER FOR WHICH 1.0 + EPS .GT. 1.0 -eps = dpmpar(1) - -w = 0.0e0_dp -w1 = 0.0e0_dp -IF (a < 0.0e0_dp .OR. b < 0.0e0_dp) THEN - ierr = 1 - RETURN -ENDIF -IF (a == 0.0e0_dp .AND. b == 0.0e0_dp) THEN - ierr = 2 - RETURN -ENDIF -IF (x < 0.0e0_dp .OR. x > 1.0e0_dp) THEN - ierr = 3 - RETURN -ENDIF -IF (y < 0.0e0_dp .OR. y > 1.0e0_dp) THEN - ierr = 4 - RETURN -ENDIF -z = ((x + y) - 0.5e0_dp) - 0.5e0_dp -IF (ABS(z) > 3.0e0_dp*eps) THEN - ierr = 5 - RETURN -ENDIF - -ierr = 0 - -IF (x == 0.0e0_dp .OR. a == 0.0e0_dp) THEN - IF (x == 0.0e0_dp .AND. a == 0.0e0_dp) THEN - ierr = 6 - ELSE + eps = dpmpar(1) + w = 0.0e0_dp - w1 = 1.0e0_dp - ENDIF - RETURN -ENDIF - -IF (y == 0.0e0_dp .OR. b == 0.0e0_dp) THEN - IF (y == 0.0e0_dp .AND. b == 0.0e0_dp) THEN - ierr = 7 - ELSE - w = 1.0e0_dp w1 = 0.0e0_dp - ENDIF - RETURN -ENDIF + IF (a < 0.0e0_dp .OR. b < 0.0e0_dp) THEN + ierr = 1 + RETURN + ENDIF + IF (a == 0.0e0_dp .AND. b == 0.0e0_dp) THEN + ierr = 2 + RETURN + ENDIF + IF (x < 0.0e0_dp .OR. x > 1.0e0_dp) THEN + ierr = 3 + RETURN + ENDIF + IF (y < 0.0e0_dp .OR. y > 1.0e0_dp) THEN + ierr = 4 + RETURN + ENDIF + z = ((x + y) - 0.5e0_dp) - 0.5e0_dp + IF (ABS(z) > 3.0e0_dp*eps) THEN + ierr = 5 + RETURN + ENDIF + + ierr = 0 -eps = MAX(eps, 1.e-15_dp) -IF (MAX(a,b) < 1.e-3_dp*eps) THEN + IF (x == 0.0e0_dp .OR. a == 0.0e0_dp) THEN + IF (x == 0.0e0_dp .AND. a == 0.0e0_dp) THEN + ierr = 6 + ELSE + w = 0.0e0_dp + w1 = 1.0e0_dp + ENDIF + RETURN + ENDIF + + IF (y == 0.0e0_dp .OR. b == 0.0e0_dp) THEN + IF (y == 0.0e0_dp .AND. b == 0.0e0_dp) THEN + ierr = 7 + ELSE + w = 1.0e0_dp + w1 = 0.0e0_dp + ENDIF + RETURN + ENDIF + + eps = MAX(eps, 1.e-15_dp) + IF (MAX(a, b) < 1.e-3_dp*eps) THEN ! PROCEDURE FOR A AND B .LT. 1.E-3*EPS - w = b/(a + b) - w1 = a/(a + b) - RETURN -ENDIF - -ind = 0 -a0 = a -b0 = b -x0 = x -y0 = y -IF (MIN(a0, b0) > 1.0e0_dp) GO TO 30 + w = b/(a + b) + w1 = a/(a + b) + RETURN + ENDIF + + ind = 0 + a0 = a + b0 = b + x0 = x + y0 = y + IF (MIN(a0, b0) > 1.0e0_dp) GO TO 30 ! PROCEDURE FOR A0 .LE. 1 OR B0 .LE. 1 -IF (x > 0.5e0_dp) THEN - ind = 1 - a0 = b - b0 = a - x0 = y - y0 = x -ENDIF - -IF (b0 < MIN(eps,eps*a0)) GO TO 80 -IF (a0 < MIN(eps,eps*b0) .AND. b0*x0 <= 1.0e0_dp) GO TO 90 -IF (MAX(a0, b0) > 1.0e0_dp) GO TO 20 -IF (a0 >= MIN(0.2e0_dp, b0)) GO TO 100 -IF (x0**a0 <= 0.9e0_dp) GO TO 100 -IF (x0 >= 0.3e0_dp) GO TO 110 -n = 20 -GO TO 130 - -20 IF (b0 <= 1.0e0_dp) GO TO 100 -IF (x0 >= 0.3e0_dp) GO TO 110 -IF (x0 < 0.1e0_dp.AND.(x0*b0)**a0 <= 0.7e0_dp) GO TO 100 -IF (b0 > 15.0e0_dp) GO TO 131 -n = 20 -GO TO 130 + IF (x > 0.5e0_dp) THEN + ind = 1 + a0 = b + b0 = a + x0 = y + y0 = x + ENDIF + + IF (b0 < MIN(eps, eps*a0)) GO TO 80 + IF (a0 < MIN(eps, eps*b0) .AND. b0*x0 <= 1.0e0_dp) GO TO 90 + IF (MAX(a0, b0) > 1.0e0_dp) GO TO 20 + IF (a0 >= MIN(0.2e0_dp, b0)) GO TO 100 + IF (x0**a0 <= 0.9e0_dp) GO TO 100 + IF (x0 >= 0.3e0_dp) GO TO 110 + n = 20 + GO TO 130 + +20 IF (b0 <= 1.0e0_dp) GO TO 100 + IF (x0 >= 0.3e0_dp) GO TO 110 + IF (x0 < 0.1e0_dp .AND. (x0*b0)**a0 <= 0.7e0_dp) GO TO 100 + IF (b0 > 15.0e0_dp) GO TO 131 + n = 20 + GO TO 130 ! PROCEDURE FOR A0 .GT. 1 AND B0 .GT. 1 -30 IF (a > b) THEN - lambda = (a + b)*y - b -ELSE - lambda = a - (a + b)*x -ENDIF - -IF (lambda < 0.0e0_dp) THEN - ind = 1 - a0 = b - b0 = a - x0 = y - y0 = x - lambda = ABS(lambda) -ENDIF - -IF (b0 < 40.0e0_dp .AND. b0*x0 <= 0.7e0_dp) GO TO 100 -IF (b0 < 40.0e0_dp) GO TO 140 -IF (a0 > b0) GO TO 50 -IF (a0 <= 100.0e0_dp) GO TO 120 -IF (lambda > 0.03e0_dp*a0) GO TO 120 -GO TO 180 -50 IF (b0 <= 100.0e0_dp) GO TO 120 -IF (lambda > 0.03e0_dp*b0) GO TO 120 -GO TO 180 +30 IF (a > b) THEN + lambda = (a + b)*y - b + ELSE + lambda = a - (a + b)*x + ENDIF + + IF (lambda < 0.0e0_dp) THEN + ind = 1 + a0 = b + b0 = a + x0 = y + y0 = x + lambda = ABS(lambda) + ENDIF + + IF (b0 < 40.0e0_dp .AND. b0*x0 <= 0.7e0_dp) GO TO 100 + IF (b0 < 40.0e0_dp) GO TO 140 + IF (a0 > b0) GO TO 50 + IF (a0 <= 100.0e0_dp) GO TO 120 + IF (lambda > 0.03e0_dp*a0) GO TO 120 + GO TO 180 +50 IF (b0 <= 100.0e0_dp) GO TO 120 + IF (lambda > 0.03e0_dp*b0) GO TO 120 + GO TO 180 ! EVALUATION OF THE APPROPRIATE ALGORITHM -80 w = fpser(a0, b0, x0, eps) -w1 = 0.5e0_dp + (0.5e0_dp - w) -GO TO 220 - -90 w1 = apser(a0, b0, x0, eps) -w = 0.5e0_dp + (0.5e0_dp - w1) -GO TO 220 - -100 w = bpser(a0, b0, x0, eps) -w1 = 0.5e0_dp + (0.5e0_dp - w) -GO TO 220 - -110 w1 = bpser(b0, a0, y0, eps) -w = 0.5e0_dp + (0.5e0_dp - w1) -GO TO 220 - -120 w = bfrac(a0, b0, x0, y0, lambda, 15.0e0_dp*eps) -w1 = 0.5e0_dp + (0.5e0_dp - w) -GO TO 220 - -130 w1 = bup(b0, a0, y0, x0, n, eps) -b0 = b0 + n -131 CALL bgrat (b0, a0, y0, x0, w1, eps, ierr1) -IF (ierr1 > 0) CPABORT("Error in BGRAT") -w = 0.5e0_dp + (0.5e0_dp - w1) -GO TO 220 - -140 n = INT(b0) -b0 = b0 - n -IF (b0 /= 0.0e0_dp) GO TO 141 -n = n - 1 -b0 = 1.0e0_dp -141 w = bup(b0, a0, y0, x0, n, eps) -IF (x0 > 0.7e0_dp) GO TO 150 -w = w + bpser(a0, b0, x0, eps) -w1 = 0.5e0_dp + (0.5e0_dp - w) -GO TO 220 - -150 IF (a0 > 15.0e0_dp) GO TO 151 -n = 20 -w = w + bup(a0, b0, x0, y0, n, eps) -a0 = a0 + n -151 CALL bgrat (a0, b0, x0, y0, w, eps, ierr1) -w1 = 0.5e0_dp + (0.5e0_dp - w) -GO TO 220 - -180 w = basym(a0, b0, lambda, 100.0e0_dp*eps) -w1 = 0.5e0_dp + (0.5e0_dp - w) -GO TO 220 +80 w = fpser(a0, b0, x0, eps) + w1 = 0.5e0_dp + (0.5e0_dp - w) + GO TO 220 + +90 w1 = apser(a0, b0, x0, eps) + w = 0.5e0_dp + (0.5e0_dp - w1) + GO TO 220 + +100 w = bpser(a0, b0, x0, eps) + w1 = 0.5e0_dp + (0.5e0_dp - w) + GO TO 220 + +110 w1 = bpser(b0, a0, y0, eps) + w = 0.5e0_dp + (0.5e0_dp - w1) + GO TO 220 + +120 w = bfrac(a0, b0, x0, y0, lambda, 15.0e0_dp*eps) + w1 = 0.5e0_dp + (0.5e0_dp - w) + GO TO 220 + +130 w1 = bup(b0, a0, y0, x0, n, eps) + b0 = b0 + n +131 CALL bgrat(b0, a0, y0, x0, w1, eps, ierr1) + IF (ierr1 > 0) CPABORT("Error in BGRAT") + w = 0.5e0_dp + (0.5e0_dp - w1) + GO TO 220 + +140 n = INT(b0) + b0 = b0 - n + IF (b0 /= 0.0e0_dp) GO TO 141 + n = n - 1 + b0 = 1.0e0_dp +141 w = bup(b0, a0, y0, x0, n, eps) + IF (x0 > 0.7e0_dp) GO TO 150 + w = w + bpser(a0, b0, x0, eps) + w1 = 0.5e0_dp + (0.5e0_dp - w) + GO TO 220 + +150 IF (a0 > 15.0e0_dp) GO TO 151 + n = 20 + w = w + bup(a0, b0, x0, y0, n, eps) + a0 = a0 + n +151 CALL bgrat(a0, b0, x0, y0, w, eps, ierr1) + w1 = 0.5e0_dp + (0.5e0_dp - w) + GO TO 220 + +180 w = basym(a0, b0, lambda, 100.0e0_dp*eps) + w1 = 0.5e0_dp + (0.5e0_dp - w) + GO TO 220 ! TERMINATION OF THE PROCEDURE -220 IF (ind == 0) RETURN -t = w -w = w1 -w1 = t +220 IF (ind == 0) RETURN + t = w + w = w1 + w1 = t -END SUBROUTINE bratio + END SUBROUTINE bratio ! ************************************************************************************************** !> \brief ... @@ -1577,7 +1577,7 @@ END SUBROUTINE bratio !> \param eps ... !> \return ... ! ************************************************************************************************** -FUNCTION fpser (a, b, x, eps) RESULT(fn_val) + FUNCTION fpser(a, b, x, eps) RESULT(fn_val) !----------------------------------------------------------------------- ! EVALUATION OF I (A,B) @@ -1593,35 +1593,35 @@ FUNCTION fpser (a, b, x, eps) RESULT(fn_val) ! SET FPSER = X**A -fn_val = 1.0e0_dp -IF (a > 1.e-3_dp*eps) THEN - fn_val = 0.0e0_dp - t = a*LOG(x) - IF (t < dxparg(1)) RETURN - fn_val = EXP(t) -ENDIF + fn_val = 1.0e0_dp + IF (a > 1.e-3_dp*eps) THEN + fn_val = 0.0e0_dp + t = a*LOG(x) + IF (t < dxparg(1)) RETURN + fn_val = EXP(t) + ENDIF ! NOTE THAT 1/B(A,B) = B -fn_val = (b/a)*fn_val -tol = eps/a -an = a + 1.0e0_dp -t = x -s = t/an -an = an + 1.0e0_dp -t = x*t -c = t/an -s = s + c -DO WHILE (ABS(c) > tol) - an = an + 1.0e0_dp - t = x*t - c = t/an - s = s + c -ENDDO - -fn_val = fn_val*(1.0e0_dp + a*s) - -END FUNCTION fpser + fn_val = (b/a)*fn_val + tol = eps/a + an = a + 1.0e0_dp + t = x + s = t/an + an = an + 1.0e0_dp + t = x*t + c = t/an + s = s + c + DO WHILE (ABS(c) > tol) + an = an + 1.0e0_dp + t = x*t + c = t/an + s = s + c + ENDDO + + fn_val = fn_val*(1.0e0_dp + a*s) + + END FUNCTION fpser ! ************************************************************************************************** !> \brief ... @@ -1631,7 +1631,7 @@ END FUNCTION fpser !> \param eps ... !> \return ... ! ************************************************************************************************** -FUNCTION apser (a, b, x, eps) RESULT(fn_val) + FUNCTION apser(a, b, x, eps) RESULT(fn_val) !----------------------------------------------------------------------- ! APSER YIELDS THE INCOMPLETE BETA RATIO I(SUB(1-X))(B,A) FOR ! A .LE. MIN(EPS,EPS*B), B*X .LE. 1, AND X .LE. 0.5. USED WHEN @@ -1644,30 +1644,30 @@ FUNCTION apser (a, b, x, eps) RESULT(fn_val) REAL(dp) :: aj, bx, c, j, s, t, tol -bx = b*x -t = x - bx -IF (b*eps > 2.e-2_dp) THEN - c = LOG(bx) + g + t -ELSE - c = LOG(x) + psi(b) + g + t -ENDIF - -tol = 5.0e0_dp*eps*ABS(c) -j = 1.0e0_dp -s = 0.0e0_dp -j = j + 1.0e0_dp -t = t*(x - bx/j) -aj = t/j -s = s + aj -DO WHILE (ABS(aj) > tol) - t = t*(x - bx/j) - aj = t/j - s = s + aj -ENDDO - -fn_val = -a*(c + s) - -END FUNCTION apser + bx = b*x + t = x - bx + IF (b*eps > 2.e-2_dp) THEN + c = LOG(bx) + g + t + ELSE + c = LOG(x) + psi(b) + g + t + ENDIF + + tol = 5.0e0_dp*eps*ABS(c) + j = 1.0e0_dp + s = 0.0e0_dp + j = j + 1.0e0_dp + t = t*(x - bx/j) + aj = t/j + s = s + aj + DO WHILE (ABS(aj) > tol) + t = t*(x - bx/j) + aj = t/j + s = s + aj + ENDDO + + fn_val = -a*(c + s) + + END FUNCTION apser ! ************************************************************************************************** !> \brief ... @@ -1677,7 +1677,7 @@ END FUNCTION apser !> \param eps ... !> \return ... ! ************************************************************************************************** -FUNCTION bpser (a, b, x, eps) RESULT(fn_val) + FUNCTION bpser(a, b, x, eps) RESULT(fn_val) !----------------------------------------------------------------------- ! POWER SERIES EXPANSION FOR EVALUATING IX(A,B) WHEN B .LE. 1 ! OR B*X .LE. 0.7. EPS IS THE TOLERANCE USED. @@ -1688,86 +1688,86 @@ FUNCTION bpser (a, b, x, eps) RESULT(fn_val) INTEGER :: i, m REAL(dp) :: a0, apb, b0, c, n, sum, t, tol, u, w, z -fn_val = 0.0e0_dp -IF (x == 0.0e0_dp) RETURN + fn_val = 0.0e0_dp + IF (x == 0.0e0_dp) RETURN !----------------------------------------------------------------------- ! COMPUTE THE FACTOR X**A/(A*BETA(A,B)) !----------------------------------------------------------------------- -a0 = MIN(a,b) -b0 = MAX(a,b) -IF (a0 >= 1.0e0_dp) THEN - z = a*LOG(x) - betaln(a,b) - fn_val = EXP(z)/a -ELSEIF (b0 >= 8.0e0_dp) THEN - u = gamln1(a0) + algdiv(a0,b0) - z = a*LOG(x) - u - fn_val = (a0/a)*EXP(z) -ELSEIF (b0 > 1.0e0_dp) THEN + a0 = MIN(a, b) + b0 = MAX(a, b) + IF (a0 >= 1.0e0_dp) THEN + z = a*LOG(x) - betaln(a, b) + fn_val = EXP(z)/a + ELSEIF (b0 >= 8.0e0_dp) THEN + u = gamln1(a0) + algdiv(a0, b0) + z = a*LOG(x) - u + fn_val = (a0/a)*EXP(z) + ELSEIF (b0 > 1.0e0_dp) THEN ! PROCEDURE FOR A0 .LT. 1 AND 1 .LT. B0 .LT. 8 - u = gamln1(a0) - m = INT(b0 - 1.0e0_dp) - IF (m >= 1) THEN - c = 1.0e0_dp - DO i = 1, m - b0 = b0 - 1.0e0_dp - c = c*(b0/(a0 + b0)) - END DO - u = LOG(c) + u - ENDIF - - z = a*LOG(x) - u - b0 = b0 - 1.0e0_dp - apb = a0 + b0 - IF (apb > 1.0e0_dp) THEN - u = a0 + b0 - 1.e0_dp - t = (1.0e0_dp + gam1(u))/apb - ELSE - t = 1.0e0_dp + gam1(apb) - ENDIF - fn_val = EXP(z)*(a0/a)*(1.0e0_dp + gam1(b0))/t -ELSE - - ! PROCEDURE FOR A0 .LT. 1 AND B0 .LE. 1 - - fn_val = x**a - IF (fn_val == 0.0e0_dp) RETURN - - apb = a + b - IF (apb > 1.0e0_dp) THEN - u = a + b - 1.e0_dp - z = (1.0e0_dp + gam1(u))/apb - ELSE - z = 1.0e0_dp + gam1(apb) - ENDIF - - c = (1.0e0_dp + gam1(a))*(1.0e0_dp + gam1(b))/z - fn_val = fn_val*c*(b/apb) -ENDIF + u = gamln1(a0) + m = INT(b0 - 1.0e0_dp) + IF (m >= 1) THEN + c = 1.0e0_dp + DO i = 1, m + b0 = b0 - 1.0e0_dp + c = c*(b0/(a0 + b0)) + END DO + u = LOG(c) + u + ENDIF + + z = a*LOG(x) - u + b0 = b0 - 1.0e0_dp + apb = a0 + b0 + IF (apb > 1.0e0_dp) THEN + u = a0 + b0 - 1.e0_dp + t = (1.0e0_dp + gam1(u))/apb + ELSE + t = 1.0e0_dp + gam1(apb) + ENDIF + fn_val = EXP(z)*(a0/a)*(1.0e0_dp + gam1(b0))/t + ELSE + + ! PROCEDURE FOR A0 .LT. 1 AND B0 .LE. 1 + + fn_val = x**a + IF (fn_val == 0.0e0_dp) RETURN + + apb = a + b + IF (apb > 1.0e0_dp) THEN + u = a + b - 1.e0_dp + z = (1.0e0_dp + gam1(u))/apb + ELSE + z = 1.0e0_dp + gam1(apb) + ENDIF + + c = (1.0e0_dp + gam1(a))*(1.0e0_dp + gam1(b))/z + fn_val = fn_val*c*(b/apb) + ENDIF ! PROCEDURE FOR A0 .LT. 1 AND B0 .GE. 8 -IF (fn_val == 0.0e0_dp .OR. a <= 0.1e0_dp*eps) RETURN + IF (fn_val == 0.0e0_dp .OR. a <= 0.1e0_dp*eps) RETURN !----------------------------------------------------------------------- ! COMPUTE THE SERIES !----------------------------------------------------------------------- -sum = 0.0e0_dp -n = 0.0e0_dp -c = 1.0e0_dp -tol = eps/a -n = n + 1.0e0_dp -c = c*(0.5e0_dp + (0.5e0_dp - b/n))*x -w = c/(a + n) -sum = sum + w -DO WHILE (ABS(w) > tol) - n = n + 1.0e0_dp - c = c*(0.5e0_dp + (0.5e0_dp - b/n))*x - w = c/(a + n) - sum = sum + w -END DO -fn_val = fn_val*(1.0e0_dp + a*sum) - -END FUNCTION bpser + sum = 0.0e0_dp + n = 0.0e0_dp + c = 1.0e0_dp + tol = eps/a + n = n + 1.0e0_dp + c = c*(0.5e0_dp + (0.5e0_dp - b/n))*x + w = c/(a + n) + sum = sum + w + DO WHILE (ABS(w) > tol) + n = n + 1.0e0_dp + c = c*(0.5e0_dp + (0.5e0_dp - b/n))*x + w = c/(a + n) + sum = sum + w + END DO + fn_val = fn_val*(1.0e0_dp + a*sum) + + END FUNCTION bpser ! ************************************************************************************************** !> \brief ... @@ -1779,7 +1779,7 @@ END FUNCTION bpser !> \param eps ... !> \return ... ! ************************************************************************************************** -FUNCTION bup (a, b, x, y, n, eps) RESULT(fn_val) + FUNCTION bup(a, b, x, y, n, eps) RESULT(fn_val) !----------------------------------------------------------------------- ! EVALUATION OF IX(A,B) - IX(A+N,B) WHERE N IS A POSITIVE INTEGER. ! EPS IS THE TOLERANCE USED. @@ -1795,75 +1795,75 @@ FUNCTION bup (a, b, x, y, n, eps) RESULT(fn_val) ! OBTAIN THE SCALING FACTOR EXP(-MU) AND ! EXP(MU)*(X**A*Y**B/BETA(A,B))/A -apb = a + b -ap1 = a + 1.0e0_dp -mu = 0 -d = 1.0e0_dp -IF (.NOT.(n == 1 .OR. a < 1.0e0_dp.OR.apb < 1.1e0_dp*ap1)) THEN - mu = INT(ABS(dxparg(1))) - k = INT(dxparg(0)) - IF (k < mu) mu = k - t = mu - d = EXP(-t) -ENDIF - -fn_val = brcmp1(mu,a,b,x,y)/a -IF (n == 1 .OR. fn_val == 0.0e0_dp) RETURN -nm1 = n - 1 -w = d + apb = a + b + ap1 = a + 1.0e0_dp + mu = 0 + d = 1.0e0_dp + IF (.NOT. (n == 1 .OR. a < 1.0e0_dp .OR. apb < 1.1e0_dp*ap1)) THEN + mu = INT(ABS(dxparg(1))) + k = INT(dxparg(0)) + IF (k < mu) mu = k + t = mu + d = EXP(-t) + ENDIF + + fn_val = brcmp1(mu, a, b, x, y)/a + IF (n == 1 .OR. fn_val == 0.0e0_dp) RETURN + nm1 = n - 1 + w = d ! LET K BE THE INDEX OF THE MAXIMUM TERM -k = 0 -IF (b > 1.0e0_dp) THEN - IF (y <= 1.e-4_dp) THEN - k = nm1 - DO i = 1,k - l = i - 1 - d = ((apb + l)/(ap1 + l))*x*d - w = w + d - END DO - IF (k == nm1) THEN - fn_val = fn_val*w - RETURN - ENDIF - ELSE - r = (b - 1.0e0_dp)*x/y - a - IF (r >= 1.0e0_dp) THEN - k = nm1 - t = nm1 - IF (r < t) k = INT(r) + k = 0 + IF (b > 1.0e0_dp) THEN + IF (y <= 1.e-4_dp) THEN + k = nm1 + DO i = 1, k + l = i - 1 + d = ((apb + l)/(ap1 + l))*x*d + w = w + d + END DO + IF (k == nm1) THEN + fn_val = fn_val*w + RETURN + ENDIF + ELSE + r = (b - 1.0e0_dp)*x/y - a + IF (r >= 1.0e0_dp) THEN + k = nm1 + t = nm1 + IF (r < t) k = INT(r) ! ADD THE INCREASING TERMS OF THE SERIES - DO i = 1,k - l = i - 1 - d = ((apb + l)/(ap1 + l))*x*d - w = w + d - END DO - IF (k == nm1) THEN - fn_val = fn_val*w - RETURN + DO i = 1, k + l = i - 1 + d = ((apb + l)/(ap1 + l))*x*d + w = w + d + END DO + IF (k == nm1) THEN + fn_val = fn_val*w + RETURN + ENDIF + ENDIF + ENDIF ENDIF - ENDIF - ENDIF -ENDIF ! ADD THE REMAINING TERMS OF THE SERIES -kp1 = k + 1 -DO i = kp1,nm1 - l = i - 1 - d = ((apb + l)/(ap1 + l))*x*d - w = w + d - IF (d <= eps*w) EXIT -END DO + kp1 = k + 1 + DO i = kp1, nm1 + l = i - 1 + d = ((apb + l)/(ap1 + l))*x*d + w = w + d + IF (d <= eps*w) EXIT + END DO ! TERMINATE THE PROCEDURE -fn_val = fn_val*w + fn_val = fn_val*w -END FUNCTION bup + END FUNCTION bup ! ************************************************************************************************** !> \brief ... @@ -1875,7 +1875,7 @@ END FUNCTION bup !> \param eps ... !> \return ... ! ************************************************************************************************** -FUNCTION bfrac (a, b, x, y, lambda, eps) RESULT(fn_val) + FUNCTION bfrac(a, b, x, y, lambda, eps) RESULT(fn_val) !----------------------------------------------------------------------- ! CONTINUED FRACTION EXPANSION FOR IX(A,B) WHEN A,B .GT. 1. ! IT IS ASSUMED THAT LAMBDA = (A + B)*Y - B. @@ -1886,66 +1886,66 @@ FUNCTION bfrac (a, b, x, y, lambda, eps) RESULT(fn_val) REAL(dp) :: alpha, an, anp1, beta, bn, bnp1, c, c0, & c1, e, n, p, r, r0, s, t, w, yp1 -fn_val = brcomp(a,b,x,y) -IF (fn_val == 0.0e0_dp) RETURN + fn_val = brcomp(a, b, x, y) + IF (fn_val == 0.0e0_dp) RETURN -c = 1.0e0_dp + lambda -c0 = b/a -c1 = 1.0e0_dp + 1.0e0_dp/a -yp1 = y + 1.0e0_dp + c = 1.0e0_dp + lambda + c0 = b/a + c1 = 1.0e0_dp + 1.0e0_dp/a + yp1 = y + 1.0e0_dp -n = 0.0e0_dp -p = 1.0e0_dp -s = a + 1.0e0_dp -an = 0.0e0_dp -bn = 1.0e0_dp -anp1 = 1.0e0_dp -bnp1 = c/c1 -r = c1/c + n = 0.0e0_dp + p = 1.0e0_dp + s = a + 1.0e0_dp + an = 0.0e0_dp + bn = 1.0e0_dp + anp1 = 1.0e0_dp + bnp1 = c/c1 + r = c1/c ! CONTINUED FRACTION CALCULATION -DO WHILE(.TRUE.) -n = n + 1.0e0_dp -t = n/a -w = n*(b - n)*x -e = a/s -alpha = (p*(p + c0)*e*e)*(w*x) -IF (alpha <= 0.0e0_dp) THEN + DO WHILE (.TRUE.) + n = n + 1.0e0_dp + t = n/a + w = n*(b - n)*x + e = a/s + alpha = (p*(p + c0)*e*e)*(w*x) + IF (alpha <= 0.0e0_dp) THEN ! TERMINATION - fn_val = fn_val*r - RETURN -ENDIF -e = (1.0e0_dp + t)/(c1 + t + t) -beta = n + w/s + e*(c + n*yp1) -p = 1.0e0_dp + t -s = s + 2.0e0_dp + fn_val = fn_val*r + RETURN + ENDIF + e = (1.0e0_dp + t)/(c1 + t + t) + beta = n + w/s + e*(c + n*yp1) + p = 1.0e0_dp + t + s = s + 2.0e0_dp ! UPDATE AN, BN, ANP1, AND BNP1 -t = alpha*an + beta*anp1 -an = anp1 -anp1 = t -t = alpha*bn + beta*bnp1 -bn = bnp1 -bnp1 = t -r0 = r -r = anp1/bnp1 -IF (ABS(r - r0) <= eps*r) THEN + t = alpha*an + beta*anp1 + an = anp1 + anp1 = t + t = alpha*bn + beta*bnp1 + bn = bnp1 + bnp1 = t + r0 = r + r = anp1/bnp1 + IF (ABS(r - r0) <= eps*r) THEN ! TERMINATION - fn_val = fn_val*r - RETURN -ENDIF + fn_val = fn_val*r + RETURN + ENDIF ! RESCALE AN, BN, ANP1, AND BNP1 -an = an/bnp1 -bn = bn/bnp1 -anp1 = r -bnp1 = 1.0e0_dp -ENDDO + an = an/bnp1 + bn = bn/bnp1 + anp1 = r + bnp1 = 1.0e0_dp + ENDDO -END FUNCTION bfrac + END FUNCTION bfrac ! ************************************************************************************************** !> \brief ... @@ -1955,7 +1955,7 @@ END FUNCTION bfrac !> \param y ... !> \return ... ! ************************************************************************************************** -FUNCTION brcomp (a, b, x, y) RESULT(fn_val) + FUNCTION brcomp(a, b, x, y) RESULT(fn_val) !----------------------------------------------------------------------- ! EVALUATION OF X**A*Y**B/BETA(A,B) !----------------------------------------------------------------------- @@ -1972,119 +1972,117 @@ FUNCTION brcomp (a, b, x, y) RESULT(fn_val) ! CONST = 1/SQRT(2*PI) !----------------- -fn_val = 0.0e0_dp -IF (x == 0.0e0_dp .OR. y == 0.0e0_dp) RETURN -a0 = MIN(a,b) -IF (a0 >= 8.0e0_dp) THEN + fn_val = 0.0e0_dp + IF (x == 0.0e0_dp .OR. y == 0.0e0_dp) RETURN + a0 = MIN(a, b) + IF (a0 >= 8.0e0_dp) THEN !----------------------------------------------------------------------- ! PROCEDURE FOR A .GE. 8 AND B .GE. 8 !----------------------------------------------------------------------- - IF (a > b) THEN - h = b/a - x0 = 1.0e0_dp/(1.0e0_dp + h) - y0 = h/(1.0e0_dp + h) - lambda = (a + b)*y - b - ELSE - h = a/b - x0 = h/(1.0e0_dp + h) - y0 = 1.0e0_dp/(1.0e0_dp + h) - lambda = a - (a + b)*x - ENDIF - - e = -lambda/a - IF (ABS(e) > 0.6e0_dp) THEN - u = e - LOG(x/x0) - ELSE - u = rlog1(e) - ENDIF - - e = lambda/b - IF (ABS(e) > 0.6e0_dp) THEN - v = e - LOG(y/y0) - ELSE - v = rlog1(e) - ENDIF - - z = EXP(-(a*u + b*v)) - fn_val = const*SQRT(b*x0)*z*EXP(-bcorr(a,b)) - RETURN -ENDIF - -IF (x > 0.375e0_dp) THEN - IF (y > 0.375e0_dp) THEN - lnx = LOG(x) - lny = LOG(y) - ELSE - lnx = alnrel(-y) - lny = LOG(y) - ENDIF -ELSE - lnx = LOG(x) - lny = alnrel(-x) -ENDIF - -z = a*lnx + b*lny -IF (a0 >= 1.0e0_dp) THEN - z = z - betaln(a,b) - fn_val = EXP(z) - RETURN -ENDIF + IF (a > b) THEN + h = b/a + x0 = 1.0e0_dp/(1.0e0_dp + h) + y0 = h/(1.0e0_dp + h) + lambda = (a + b)*y - b + ELSE + h = a/b + x0 = h/(1.0e0_dp + h) + y0 = 1.0e0_dp/(1.0e0_dp + h) + lambda = a - (a + b)*x + ENDIF + + e = -lambda/a + IF (ABS(e) > 0.6e0_dp) THEN + u = e - LOG(x/x0) + ELSE + u = rlog1(e) + ENDIF + + e = lambda/b + IF (ABS(e) > 0.6e0_dp) THEN + v = e - LOG(y/y0) + ELSE + v = rlog1(e) + ENDIF + + z = EXP(-(a*u + b*v)) + fn_val = const*SQRT(b*x0)*z*EXP(-bcorr(a, b)) + RETURN + ENDIF + + IF (x > 0.375e0_dp) THEN + IF (y > 0.375e0_dp) THEN + lnx = LOG(x) + lny = LOG(y) + ELSE + lnx = alnrel(-y) + lny = LOG(y) + ENDIF + ELSE + lnx = LOG(x) + lny = alnrel(-x) + ENDIF + + z = a*lnx + b*lny + IF (a0 >= 1.0e0_dp) THEN + z = z - betaln(a, b) + fn_val = EXP(z) + RETURN + ENDIF !----------------------------------------------------------------------- ! PROCEDURE FOR A .LT. 1 OR B .LT. 1 !----------------------------------------------------------------------- -b0 = MAX(a,b) -IF (b0 >= 8.0e0_dp) THEN + b0 = MAX(a, b) + IF (b0 >= 8.0e0_dp) THEN ! ALGORITHM FOR B0 .GE. 8 - u = gamln1(a0) + algdiv(a0,b0) - fn_val = a0*EXP(z - u) -ENDIF -IF (b0 <= 1.0e0_dp) THEN + u = gamln1(a0) + algdiv(a0, b0) + fn_val = a0*EXP(z - u) + ENDIF + IF (b0 <= 1.0e0_dp) THEN ! ALGORITHM FOR B0 .LE. 1 - fn_val = EXP(z) - IF (fn_val == 0.0e0_dp) RETURN + fn_val = EXP(z) + IF (fn_val == 0.0e0_dp) RETURN - apb = a + b - IF (apb > 1.0e0_dp) THEN - u = a + b - 1.e0_dp - z = (1.0e0_dp + gam1(u))/apb - ELSE - z = 1.0e0_dp + gam1(apb) - ENDIF + apb = a + b + IF (apb > 1.0e0_dp) THEN + u = a + b - 1.e0_dp + z = (1.0e0_dp + gam1(u))/apb + ELSE + z = 1.0e0_dp + gam1(apb) + ENDIF - c = (1.0e0_dp + gam1(a))*(1.0e0_dp + gam1(b))/z - fn_val = fn_val*(a0*c)/(1.0e0_dp + a0/b0) - RETURN -ENDIF + c = (1.0e0_dp + gam1(a))*(1.0e0_dp + gam1(b))/z + fn_val = fn_val*(a0*c)/(1.0e0_dp + a0/b0) + RETURN + ENDIF ! ALGORITHM FOR 1 .LT. B0 .LT. 8 -u = gamln1(a0) -n = INT(b0 - 1.0e0_dp) -IF (n >= 1) THEN - c = 1.0e0_dp - DO i = 1, n - b0 = b0 - 1.0e0_dp - c = c*(b0/(a0 + b0)) - END DO - u = LOG(c) + u -ENDIF - -z = z - u -b0 = b0 - 1.0e0_dp -apb = a0 + b0 -IF (apb > 1.0e0_dp) THEN - u = a0 + b0 - 1.e0_dp - t = (1.0e0_dp + gam1(u))/apb -ELSE - t = 1.0e0_dp + gam1(apb) -ENDIF -fn_val = a0*EXP(z)*(1.0e0_dp + gam1(b0))/t - + u = gamln1(a0) + n = INT(b0 - 1.0e0_dp) + IF (n >= 1) THEN + c = 1.0e0_dp + DO i = 1, n + b0 = b0 - 1.0e0_dp + c = c*(b0/(a0 + b0)) + END DO + u = LOG(c) + u + ENDIF + z = z - u + b0 = b0 - 1.0e0_dp + apb = a0 + b0 + IF (apb > 1.0e0_dp) THEN + u = a0 + b0 - 1.e0_dp + t = (1.0e0_dp + gam1(u))/apb + ELSE + t = 1.0e0_dp + gam1(apb) + ENDIF + fn_val = a0*EXP(z)*(1.0e0_dp + gam1(b0))/t -END FUNCTION brcomp + END FUNCTION brcomp ! ************************************************************************************************** !> \brief ... @@ -2095,7 +2093,7 @@ END FUNCTION brcomp !> \param y ... !> \return ... ! ************************************************************************************************** -FUNCTION brcmp1 (mu, a, b, x, y) RESULT(fn_val) + FUNCTION brcmp1(mu, a, b, x, y) RESULT(fn_val) !----------------------------------------------------------------------- ! EVALUATION OF EXP(MU) * (X**A*Y**B/BETA(A,B)) !----------------------------------------------------------------------- @@ -2113,114 +2111,114 @@ FUNCTION brcmp1 (mu, a, b, x, y) RESULT(fn_val) ! CONST = 1/SQRT(2*PI) !----------------- -a0 = MIN(a,b) -IF (a0 >= 8.0e0_dp) THEN + a0 = MIN(a, b) + IF (a0 >= 8.0e0_dp) THEN !----------------------------------------------------------------------- ! PROCEDURE FOR A .GE. 8 AND B .GE. 8 !----------------------------------------------------------------------- - IF (a > b) THEN - h = b/a - x0 = 1.0e0_dp/(1.0e0_dp + h) - y0 = h/(1.0e0_dp + h) - lambda = (a + b)*y - b - ENDIF - h = a/b - x0 = h/(1.0e0_dp + h) - y0 = 1.0e0_dp/(1.0e0_dp + h) - lambda = a - (a + b)*x - - e = -lambda/a - IF (ABS(e) > 0.6e0_dp) THEN - u = e - LOG(x/x0) - ELSE - u = rlog1(e) - ENDIF - - e = lambda/b - IF (ABS(e) <= 0.6e0_dp) THEN - v = rlog1(e) - ELSE - v = e - LOG(y/y0) - ENDIF - - z = esum(mu,-(a*u + b*v)) - fn_val = const*SQRT(b*x0)*z*EXP(-bcorr(a,b)) -ENDIF - -IF (x > 0.375e0_dp) THEN - IF (y > 0.375e0_dp) THEN - lnx = LOG(x) - lny = LOG(y) - ELSE - lnx = alnrel(-y) - lny = LOG(y) - ENDIF -ELSE - lnx = LOG(x) - lny = alnrel(-x) -ENDIF -z = a*lnx + b*lny -IF (a0 >= 1.0e0_dp) THEN - z = z - betaln(a,b) - fn_val = esum(mu,z) - RETURN -ENDIF + IF (a > b) THEN + h = b/a + x0 = 1.0e0_dp/(1.0e0_dp + h) + y0 = h/(1.0e0_dp + h) + lambda = (a + b)*y - b + ENDIF + h = a/b + x0 = h/(1.0e0_dp + h) + y0 = 1.0e0_dp/(1.0e0_dp + h) + lambda = a - (a + b)*x + + e = -lambda/a + IF (ABS(e) > 0.6e0_dp) THEN + u = e - LOG(x/x0) + ELSE + u = rlog1(e) + ENDIF + + e = lambda/b + IF (ABS(e) <= 0.6e0_dp) THEN + v = rlog1(e) + ELSE + v = e - LOG(y/y0) + ENDIF + + z = esum(mu, -(a*u + b*v)) + fn_val = const*SQRT(b*x0)*z*EXP(-bcorr(a, b)) + ENDIF + + IF (x > 0.375e0_dp) THEN + IF (y > 0.375e0_dp) THEN + lnx = LOG(x) + lny = LOG(y) + ELSE + lnx = alnrel(-y) + lny = LOG(y) + ENDIF + ELSE + lnx = LOG(x) + lny = alnrel(-x) + ENDIF + z = a*lnx + b*lny + IF (a0 >= 1.0e0_dp) THEN + z = z - betaln(a, b) + fn_val = esum(mu, z) + RETURN + ENDIF !----------------------------------------------------------------------- ! PROCEDURE FOR A .LT. 1 OR B .LT. 1 !----------------------------------------------------------------------- -b0 = MAX(a,b) -IF (b0 >= 8.0e0_dp) THEN + b0 = MAX(a, b) + IF (b0 >= 8.0e0_dp) THEN ! ALGORITHM FOR B0 .GE. 8 - u = gamln1(a0) + algdiv(a0,b0) - fn_val = a0*esum(mu,z - u) - RETURN -ENDIF -IF (b0 <= 1.0e0_dp) THEN + u = gamln1(a0) + algdiv(a0, b0) + fn_val = a0*esum(mu, z - u) + RETURN + ENDIF + IF (b0 <= 1.0e0_dp) THEN ! ALGORITHM FOR B0 .LE. 1 - fn_val = esum(mu,z) - IF (fn_val == 0.0e0_dp) RETURN + fn_val = esum(mu, z) + IF (fn_val == 0.0e0_dp) RETURN - apb = a + b - IF (apb > 1.0e0_dp) THEN - u = a + b - 1.e0_dp - z = (1.0e0_dp + gam1(u))/apb - ELSE - z = 1.0e0_dp + gam1(apb) - ENDIF + apb = a + b + IF (apb > 1.0e0_dp) THEN + u = a + b - 1.e0_dp + z = (1.0e0_dp + gam1(u))/apb + ELSE + z = 1.0e0_dp + gam1(apb) + ENDIF - c = (1.0e0_dp + gam1(a))*(1.0e0_dp + gam1(b))/z - fn_val = fn_val*(a0*c)/(1.0e0_dp + a0/b0) - RETURN -ENDIF + c = (1.0e0_dp + gam1(a))*(1.0e0_dp + gam1(b))/z + fn_val = fn_val*(a0*c)/(1.0e0_dp + a0/b0) + RETURN + ENDIF ! ALGORITHM FOR 1 .LT. B0 .LT. 8 -u = gamln1(a0) -n = INT(b0 - 1.0e0_dp) -IF (n >= 1) THEN - c = 1.0e0_dp - DO i = 1, n - b0 = b0 - 1.0e0_dp - c = c*(b0/(a0 + b0)) - END DO - u = LOG(c) + u -ENDIF - -z = z - u -b0 = b0 - 1.0e0_dp -apb = a0 + b0 -IF (apb > 1.0e0_dp) THEN - u = a0 + b0 - 1.e0_dp - t = (1.0e0_dp + gam1(u))/apb -ELSE - t = 1.0e0_dp + gam1(apb) -ENDIF -fn_val = a0*esum(mu,z)*(1.0e0_dp + gam1(b0))/t - -END FUNCTION brcmp1 + u = gamln1(a0) + n = INT(b0 - 1.0e0_dp) + IF (n >= 1) THEN + c = 1.0e0_dp + DO i = 1, n + b0 = b0 - 1.0e0_dp + c = c*(b0/(a0 + b0)) + END DO + u = LOG(c) + u + ENDIF + + z = z - u + b0 = b0 - 1.0e0_dp + apb = a0 + b0 + IF (apb > 1.0e0_dp) THEN + u = a0 + b0 - 1.e0_dp + t = (1.0e0_dp + gam1(u))/apb + ELSE + t = 1.0e0_dp + gam1(apb) + ENDIF + fn_val = a0*esum(mu, z)*(1.0e0_dp + gam1(b0))/t + + END FUNCTION brcmp1 ! ************************************************************************************************** !> \brief ... @@ -2230,7 +2228,7 @@ END FUNCTION brcmp1 !> \param eps ... !> \return ... ! ************************************************************************************************** -FUNCTION basym (a, b, lambda, eps) RESULT(fn_val) + FUNCTION basym(a, b, lambda, eps) RESULT(fn_val) !----------------------------------------------------------------------- ! ASYMPTOTIC EXPANSION FOR IX(A,B) FOR LARGE A AND B. ! LAMBDA = (A + B)*Y - B AND EPS IS THE TOLERANCE USED. @@ -2259,84 +2257,84 @@ FUNCTION basym (a, b, lambda, eps) RESULT(fn_val) ! E1 = 2**(-3/2) !------------------------ -fn_val = 0.0e0_dp -IF (a >= b) THEN - h = b/a - r0 = 1.0e0_dp/(1.0e0_dp + h) - r1 = (b - a)/a - w0 = 1.0e0_dp/SQRT(b*(1.0e0_dp + h)) -ELSE - h = a/b - r0 = 1.0e0_dp/(1.0e0_dp + h) - r1 = (b - a)/b - w0 = 1.0e0_dp/SQRT(a*(1.0e0_dp + h)) -ENDIF - -20 f = a*rlog1(-lambda/a) + b*rlog1(lambda/b) -t = EXP(-f) -IF (t == 0.0e0_dp) RETURN -z0 = SQRT(f) -z = 0.5e0_dp*(z0/e1) -z2 = f + f - -a0(1) = (2.0e0_dp/3.0e0_dp)*r1 -c(1) = - 0.5e0_dp*a0(1) -d(1) = - c(1) -j0 = (0.5e0_dp/e0)*erfc1(1,z0) -j1 = e1 -sum = j0 + d(1)*w0*j1 - -s = 1.0e0_dp -h2 = h*h -hn = 1.0e0_dp -w = w0 -znm1 = z -zn = z2 -DO n = 2, num, 2 - hn = h2*hn - a0(n) = 2.0e0_dp*r0*(1.0e0_dp + h*hn)/(n + 2.0e0_dp) - np1 = n + 1 - s = s + hn - a0(np1) = 2.0e0_dp*r1*s/(n + 3.0e0_dp) - - DO i = n, np1 - r = -0.5e0_dp*(i + 1.0e0_dp) - b0(1) = r*a0(1) - DO m = 2, i - bsum = 0.0e0_dp - mm1 = m - 1 - DO j = 1, mm1 - mmj = m - j - bsum = bsum + (j*r - mmj)*a0(j)*b0(mmj) + fn_val = 0.0e0_dp + IF (a >= b) THEN + h = b/a + r0 = 1.0e0_dp/(1.0e0_dp + h) + r1 = (b - a)/a + w0 = 1.0e0_dp/SQRT(b*(1.0e0_dp + h)) + ELSE + h = a/b + r0 = 1.0e0_dp/(1.0e0_dp + h) + r1 = (b - a)/b + w0 = 1.0e0_dp/SQRT(a*(1.0e0_dp + h)) + ENDIF + +20 f = a*rlog1(-lambda/a) + b*rlog1(lambda/b) + t = EXP(-f) + IF (t == 0.0e0_dp) RETURN + z0 = SQRT(f) + z = 0.5e0_dp*(z0/e1) + z2 = f + f + + a0(1) = (2.0e0_dp/3.0e0_dp)*r1 + c(1) = -0.5e0_dp*a0(1) + d(1) = -c(1) + j0 = (0.5e0_dp/e0)*erfc1(1, z0) + j1 = e1 + sum = j0 + d(1)*w0*j1 + + s = 1.0e0_dp + h2 = h*h + hn = 1.0e0_dp + w = w0 + znm1 = z + zn = z2 + DO n = 2, num, 2 + hn = h2*hn + a0(n) = 2.0e0_dp*r0*(1.0e0_dp + h*hn)/(n + 2.0e0_dp) + np1 = n + 1 + s = s + hn + a0(np1) = 2.0e0_dp*r1*s/(n + 3.0e0_dp) + + DO i = n, np1 + r = -0.5e0_dp*(i + 1.0e0_dp) + b0(1) = r*a0(1) + DO m = 2, i + bsum = 0.0e0_dp + mm1 = m - 1 + DO j = 1, mm1 + mmj = m - j + bsum = bsum + (j*r - mmj)*a0(j)*b0(mmj) + END DO + b0(m) = r*a0(m) + bsum/m + END DO + c(i) = b0(i)/(i + 1.0e0_dp) + + dsum = 0.0e0_dp + im1 = i - 1 + DO j = 1, im1 + imj = i - j + dsum = dsum + d(imj)*c(j) + END DO + d(i) = -(dsum + c(i)) + END DO + + j0 = e1*znm1 + (n - 1.0e0_dp)*j0 + j1 = e1*zn + n*j1 + znm1 = z2*znm1 + zn = z2*zn + w = w0*w + t0 = d(n)*w*j0 + w = w0*w + t1 = d(np1)*w*j1 + sum = sum + (t0 + t1) + IF ((ABS(t0) + ABS(t1)) <= eps*sum) EXIT END DO - b0(m) = r*a0(m) + bsum/m - END DO - c(i) = b0(i)/(i + 1.0e0_dp) - - dsum = 0.0e0_dp - im1 = i - 1 - DO j = 1, im1 - imj = i - j - dsum = dsum + d(imj)*c(j) - END DO - d(i) = -(dsum + c(i)) - END DO - - j0 = e1*znm1 + (n - 1.0e0_dp)*j0 - j1 = e1*zn + n*j1 - znm1 = z2*znm1 - zn = z2*zn - w = w0*w - t0 = d(n)*w*j0 - w = w0*w - t1 = d(np1)*w*j1 - sum = sum + (t0 + t1) - IF ((ABS(t0) + ABS(t1)) <= eps*sum) EXIT -END DO - -u = EXP(-bcorr(a,b)) -fn_val = e0*t*u*sum - -END FUNCTION basym + + u = EXP(-bcorr(a, b)) + fn_val = e0*t*u*sum + + END FUNCTION basym END MODULE beta_gamma_psi diff --git a/src/bse.F b/src/bse.F index 9b7750d436..5eae55fa61 100644 --- a/src/bse.F +++ b/src/bse.F @@ -232,9 +232,9 @@ SUBROUTINE compute_AZ(AZ, Z_vectors, B_iaQ_bse_local, B_bar_ijQ_bse_local, B_abQ DO i_occ = 1, homo DO a_virt = 1, virtual - eigen_diff = Eigenval(a_virt+homo)-Eigenval(i_occ) + eigen_diff = Eigenval(a_virt + homo) - Eigenval(i_occ) - AZ(i_occ, a_virt, :) = AZ(i_occ, a_virt, :)+Z_vectors(i_occ, a_virt, :)*eigen_diff + AZ(i_occ, a_virt, :) = AZ(i_occ, a_virt, :) + Z_vectors(i_occ, a_virt, :)*eigen_diff END DO END DO @@ -277,7 +277,7 @@ SUBROUTINE compute_v_ia_jb_part(AZ, Z_vectors, B_iaQ_bse_local, RI_vector, local DO i_occ = 1, homo DO a_virt = 1, virtual - RI_vector(LLL, i_Z_vector) = RI_vector(LLL, i_Z_vector)+ & + RI_vector(LLL, i_Z_vector) = RI_vector(LLL, i_Z_vector) + & Z_vectors(i_occ, a_virt, i_Z_vector)* & B_iaQ_bse_local(i_occ, a_virt, LLL) @@ -292,7 +292,7 @@ SUBROUTINE compute_v_ia_jb_part(AZ, Z_vectors, B_iaQ_bse_local, RI_vector, local DO i_occ = 1, homo DO a_virt = 1, virtual - AZ(i_occ, a_virt, i_Z_vector) = AZ(i_occ, a_virt, i_Z_vector)+ & + AZ(i_occ, a_virt, i_Z_vector) = AZ(i_occ, a_virt, i_Z_vector) + & RI_vector(LLL, i_Z_vector)* & B_iaQ_bse_local(i_occ, a_virt, LLL) @@ -332,7 +332,7 @@ SUBROUTINE initial_guess_Z_vectors(Z_vectors, Eigenval, num_Z_vectors, homo, vir DO i_occ = 1, homo DO a_virt = 1, virtual - eigen_diff_ia(i_occ, a_virt) = Eigenval(a_virt+homo)-Eigenval(i_occ) + eigen_diff_ia(i_occ, a_virt) = Eigenval(a_virt + homo) - Eigenval(i_occ) END DO END DO @@ -422,7 +422,7 @@ SUBROUTINE mult_B_with_W_and_fill_local_3c_arrays(fm_mat_S_ij_bse, fm_mat_S_ab_b DO iiB = 1, nrow_local i_global = row_indices(iiB) IF (j_global == i_global .AND. i_global <= dimen_RI) THEN - fm_mat_Q_static_bse_gemm%local_data(iiB, jjB) = fm_mat_Q_static_bse_gemm%local_data(iiB, jjB)+1.0_dp + fm_mat_Q_static_bse_gemm%local_data(iiB, jjB) = fm_mat_Q_static_bse_gemm%local_data(iiB, jjB) + 1.0_dp END IF END DO END DO @@ -504,7 +504,7 @@ SUBROUTINE allocate_and_fill_local_array(B_local, fm_mat_S, gd_array, & ALLOCATE (mepos_from_RI_index(dimen_RI)) mepos_from_RI_index = 0 - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 CALL get_group_dist(gd_array, pos=imepos, starts=start_RI, ends=end_RI) @@ -517,12 +517,12 @@ SUBROUTINE allocate_and_fill_local_array(B_local, fm_mat_S, gd_array, & ALLOCATE (B_local(small_size, big_size, 1:size_RI)) - ALLOCATE (num_entries_send(0:para_env%num_pe-1)) - ALLOCATE (num_entries_rec(0:para_env%num_pe-1)) + ALLOCATE (num_entries_send(0:para_env%num_pe - 1)) + ALLOCATE (num_entries_rec(0:para_env%num_pe - 1)) ALLOCATE (req_array(1:para_env%num_pe, 4)) - ALLOCATE (entry_counter(0:para_env%num_pe-1)) + ALLOCATE (entry_counter(0:para_env%num_pe - 1)) CALL cp_fm_get_info(matrix=fm_mat_S, & nrow_local=nrow_local, & @@ -534,7 +534,7 @@ SUBROUTINE allocate_and_fill_local_array(B_local, fm_mat_S, gd_array, & ! communicate not all due to huge memory overhead, since for every number in fm_mat_S, we store ! three additional ones (RI index, first MO index, second MO index!!) - DO i_comm = 0, num_comm_cycles-1 + DO i_comm = 0, num_comm_cycles - 1 num_entries_send = 0 num_entries_rec = 0 @@ -548,17 +548,17 @@ SUBROUTINE allocate_and_fill_local_array(B_local, fm_mat_S, gd_array, & imepos = mepos_from_RI_index(RI_index) - num_entries_send(imepos) = num_entries_send(imepos)+nrow_local + num_entries_send(imepos) = num_entries_send(imepos) + nrow_local END DO CALL mp_alltoall(num_entries_send, num_entries_rec, 1, para_env%group) - ALLOCATE (buffer_rec(0:para_env%num_pe-1)) - ALLOCATE (buffer_send(0:para_env%num_pe-1)) + ALLOCATE (buffer_rec(0:para_env%num_pe - 1)) + ALLOCATE (buffer_send(0:para_env%num_pe - 1)) ! allocate data message and corresponding indices - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 ALLOCATE (buffer_rec(imepos)%msg(num_entries_rec(imepos))) buffer_rec(imepos)%msg = 0.0_dp @@ -588,10 +588,10 @@ SUBROUTINE allocate_and_fill_local_array(B_local, fm_mat_S, gd_array, & DO iiB = 1, nrow_local combi_index = row_indices(iiB) - level_small_size = MAX(1, combi_index-1)/big_size+1 - level_big_size = combi_index-(level_small_size-1)*big_size + level_small_size = MAX(1, combi_index - 1)/big_size + 1 + level_big_size = combi_index - (level_small_size - 1)*big_size - entry_counter(imepos) = entry_counter(imepos)+1 + entry_counter(imepos) = entry_counter(imepos) + 1 buffer_send(imepos)%msg(entry_counter(imepos)) = fm_mat_S%local_data(iiB, jjB) @@ -610,11 +610,11 @@ SUBROUTINE allocate_and_fill_local_array(B_local, fm_mat_S, gd_array, & CALL timestop(handle1) ! fill B_local - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 DO i_entry = 1, num_entries_rec(imepos) - RI_index = buffer_rec(imepos)%indx(i_entry, 1)-start_RI+1 + RI_index = buffer_rec(imepos)%indx(i_entry, 1) - start_RI + 1 level_small_size = buffer_rec(imepos)%indx(i_entry, 2) level_big_size = buffer_rec(imepos)%indx(i_entry, 3) @@ -626,7 +626,7 @@ SUBROUTINE allocate_and_fill_local_array(B_local, fm_mat_S, gd_array, & END DO - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 DEALLOCATE (buffer_send(imepos)%msg) DEALLOCATE (buffer_send(imepos)%indx) DEALLOCATE (buffer_rec(imepos)%msg) diff --git a/src/bsse.F b/src/bsse.F index 6212b05b64..41fa39b81a 100644 --- a/src/bsse.F +++ b/src/bsse.F @@ -99,7 +99,7 @@ SUBROUTINE do_bsse_calculation(force_env, globenv) ! Number of configurations num_of_conf = 0 DO k = 1, Num_of_frag - num_of_conf = num_of_conf+FACT(Num_of_frag)/(FACT(k)*FACT(Num_of_frag-k)) + num_of_conf = num_of_conf + FACT(Num_of_frag)/(FACT(k)*FACT(Num_of_frag - k)) END DO ALLOCATE (conf(num_of_conf, Num_of_frag)) ALLOCATE (Em(num_of_conf)) @@ -121,7 +121,7 @@ SUBROUTINE do_bsse_calculation(force_env, globenv) CALL cp_iterate(logger%iter_info, last=.FALSE., iter_nr=istart) ! Evaluating the energy of the N-body cluster terms - DO i = istart+1, num_of_conf + DO i = istart + 1, num_of_conf CALL cp_iterate(logger%iter_info, last=(i == num_of_conf), iter_nr=i) CALL eval_bsse_energy(conf(i, :), Em(i), force_env, n_frags, & root_section, globenv, should_stop) @@ -184,8 +184,8 @@ SUBROUTINE eval_bsse_energy(conf, Em, force_env, n_frags, root_section, & ELSE my_energy = 0.0_dp DO k = 1, Num_of_sub_frag - Num_of_sub_conf = Num_of_sub_conf+ & - FACT(Num_of_sub_frag)/(FACT(k)*FACT(Num_of_sub_frag-k)) + Num_of_sub_conf = Num_of_sub_conf + & + FACT(Num_of_sub_frag)/(FACT(k)*FACT(Num_of_sub_frag - k)) END DO ALLOCATE (conf_loc(Num_of_sub_conf, Num_of_sub_frag)) ALLOCATE (Em_loc(Num_of_sub_conf)) @@ -202,7 +202,7 @@ SUBROUTINE eval_bsse_energy(conf, Em, force_env, n_frags, root_section, & k = COUNT(conf == 1) DO i = 1, Num_of_sub_conf j = COUNT(conf_loc(i, :) == 1) - my_energy = my_energy+(-1.0_dp)**(k+j)*Em_loc(i) + my_energy = my_energy + (-1.0_dp)**(k + j)*Em_loc(i) END DO Em = my_energy DEALLOCATE (Em_loc) @@ -279,12 +279,12 @@ SUBROUTINE eval_bsse_energy_low(force_env, conf, conf_loc, n_frags, & IF (n_rep /= 0) THEN DO ir = 1, n_rep CALL section_vals_val_get(n_frags, "LIST", i_rep_section=i, i_rep_val=ir, i_vals=tmplist) - CALL reallocate(atom_index, 1, isize+SIZE(tmplist)) - atom_index(isize+1:isize+SIZE(tmplist)) = tmplist + CALL reallocate(atom_index, 1, isize + SIZE(tmplist)) + atom_index(isize + 1:isize + SIZE(tmplist)) = tmplist isize = SIZE(atom_index) END DO END IF - my_conf(i) = isize-old_size + my_conf(i) = isize - old_size CPASSERT(conf(i) /= 0) END IF END DO @@ -304,7 +304,7 @@ SUBROUTINE eval_bsse_energy_low(force_env, conf, conf_loc, n_frags, & END DO DO i = 1, SIZE(conf_loc) IF (my_conf(i) /= 0 .AND. conf_loc(i) == 0) THEN - DO j = SUM(my_conf(1:i-1))+1, SUM(my_conf(1:i)) + DO j = SUM(my_conf(1:i - 1)) + 1, SUM(my_conf(1:i)) atom_type(j) = TRIM(atom_type(j))//"_ghost" END DO END IF @@ -497,13 +497,13 @@ SUBROUTINE dump_bsse_results(conf, Em, num_of_frag, bsse_section) WRITE (UNIT=iw, FMT="(T2,A,T80,A)") "-", "-" DO i = 1, SIZE(conf, 1) IF (i .GT. 1) THEN - IF (SUM(conf(i-1, :)) == 1 .AND. SUM(conf(i, :)) /= 1) THEN + IF (SUM(conf(i - 1, :)) == 1 .AND. SUM(conf(i, :)) /= 1) THEN WRITE (UNIT=iw, FMT="(T2,A,T80,A)") "-", "-" END IF END IF WRITE (UNIT=iw, FMT="(T2,A,T24,I3,A,F16.6,T80,A)") "-", SUM(conf(i, :)), "-body contribution:", Em(i), "-" END DO - WRITE (UNIT=iw, FMT="(T2,A,T20,A,F16.6,T80,A)") "-", "BSSE-free interaction energy:", SUM(Em(Num_of_frag+1:)), "-" + WRITE (UNIT=iw, FMT="(T2,A,T20,A,F16.6,T80,A)") "-", "BSSE-free interaction energy:", SUM(Em(Num_of_frag + 1:)), "-" WRITE (UNIT=iw, FMT="(T2,A)") REPEAT("-", 79) END IF @@ -552,17 +552,17 @@ RECURSIVE SUBROUTINE build_Nbody_conf(ldown, lup, conf, k, my_ind) INTEGER :: i, kloc, my_ind0 - kloc = k-1 + kloc = k - 1 my_ind0 = my_ind IF (kloc /= 0) THEN DO i = ldown, lup - CALL build_Nbody_conf(i+1, lup, conf, kloc, my_ind) - conf(my_ind0+1:my_ind, i) = 1 + CALL build_Nbody_conf(i + 1, lup, conf, kloc, my_ind) + conf(my_ind0 + 1:my_ind, i) = 1 my_ind0 = my_ind END DO ELSE DO i = ldown, lup - my_ind = my_ind+1 + my_ind = my_ind + 1 conf(my_ind, i) = 1 END DO END IF @@ -580,7 +580,7 @@ RECURSIVE FUNCTION FACT(num) RESULT(my_fact) IF (num <= 1) THEN my_fact = 1 ELSE - my_fact = num*FACT(num-1) + my_fact = num*FACT(num - 1) END IF END FUNCTION FACT @@ -601,7 +601,7 @@ SUBROUTINE make_plan_conf(main_conf, conf) ind = 0 DO i = 1, SIZE(main_conf) IF (main_conf(i) /= 0) THEN - ind = ind+1 + ind = ind + 1 tmp_conf(:, i) = conf(:, ind) END IF END DO diff --git a/src/cell_methods.F b/src/cell_methods.F index 2b64d35ca5..5107780f4d 100644 --- a/src/cell_methods.F +++ b/src/cell_methods.F @@ -466,7 +466,7 @@ SUBROUTINE cif_get_real(parser, r) CALL parser_get_object(parser, s_tag) iln = LEN_TRIM(s_tag) - IF (INDEX(s_tag, "(") /= 0) iln = INDEX(s_tag, "(")-1 + IF (INDEX(s_tag, "(") /= 0) iln = INDEX(s_tag, "(") - 1 READ (s_tag(1:iln), *) r END SUBROUTINE cif_get_real diff --git a/src/colvar_methods.F b/src/colvar_methods.F index 3212ee45e8..037f398cfd 100644 --- a/src/colvar_methods.F +++ b/src/colvar_methods.F @@ -280,9 +280,9 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) ! INDEX LIST DO k = 1, n_var CALL section_vals_val_get(coordination_section, "ATOMS_FROM", i_rep_val=k, i_vals=iatms) - CALL reallocate(colvar%coord_param%i_at_from, 1, ndim+SIZE(iatms)) - colvar%coord_param%i_at_from(ndim+1:ndim+SIZE(iatms)) = iatms - ndim = ndim+SIZE(iatms) + CALL reallocate(colvar%coord_param%i_at_from, 1, ndim + SIZE(iatms)) + colvar%coord_param%i_at_from(ndim + 1:ndim + SIZE(iatms)) = iatms + ndim = ndim + SIZE(iatms) END DO colvar%coord_param%n_atoms_from = ndim colvar%coord_param%use_kinds_from = .FALSE. @@ -292,9 +292,9 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) CPASSERT(n_var > 0) DO k = 1, n_var CALL section_vals_val_get(coordination_section, "KINDS_FROM", i_rep_val=k, c_vals=c_kinds) - CALL reallocate(colvar%coord_param%c_kinds_from, 1, ndim+SIZE(c_kinds)) - colvar%coord_param%c_kinds_from(ndim+1:ndim+SIZE(c_kinds)) = c_kinds - ndim = ndim+SIZE(c_kinds) + CALL reallocate(colvar%coord_param%c_kinds_from, 1, ndim + SIZE(c_kinds)) + colvar%coord_param%c_kinds_from(ndim + 1:ndim + SIZE(c_kinds)) = c_kinds + ndim = ndim + SIZE(c_kinds) END DO colvar%coord_param%n_atoms_from = 0 colvar%coord_param%use_kinds_from = .TRUE. @@ -310,9 +310,9 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) ! INDEX LIST DO k = 1, n_var CALL section_vals_val_get(coordination_section, "ATOMS_TO", i_rep_val=k, i_vals=iatms) - CALL reallocate(colvar%coord_param%i_at_to, 1, ndim+SIZE(iatms)) - colvar%coord_param%i_at_to(ndim+1:ndim+SIZE(iatms)) = iatms - ndim = ndim+SIZE(iatms) + CALL reallocate(colvar%coord_param%i_at_to, 1, ndim + SIZE(iatms)) + colvar%coord_param%i_at_to(ndim + 1:ndim + SIZE(iatms)) = iatms + ndim = ndim + SIZE(iatms) END DO colvar%coord_param%n_atoms_to = ndim colvar%coord_param%use_kinds_to = .FALSE. @@ -322,9 +322,9 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) CPASSERT(n_var > 0) DO k = 1, n_var CALL section_vals_val_get(coordination_section, "KINDS_TO", i_rep_val=k, c_vals=c_kinds) - CALL reallocate(colvar%coord_param%c_kinds_to, 1, ndim+SIZE(c_kinds)) - colvar%coord_param%c_kinds_to(ndim+1:ndim+SIZE(c_kinds)) = c_kinds - ndim = ndim+SIZE(c_kinds) + CALL reallocate(colvar%coord_param%c_kinds_to, 1, ndim + SIZE(c_kinds)) + colvar%coord_param%c_kinds_to(ndim + 1:ndim + SIZE(c_kinds)) = c_kinds + ndim = ndim + SIZE(c_kinds) END DO colvar%coord_param%n_atoms_to = 0 colvar%coord_param%use_kinds_to = .TRUE. @@ -347,9 +347,9 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) ! INDEX LIST DO k = 1, n_var CALL section_vals_val_get(coordination_section, "ATOMS_TO_B", i_rep_val=k, i_vals=iatms) - CALL reallocate(colvar%coord_param%i_at_to_b, 1, ndim+SIZE(iatms)) - colvar%coord_param%i_at_to_b(ndim+1:ndim+SIZE(iatms)) = iatms - ndim = ndim+SIZE(iatms) + CALL reallocate(colvar%coord_param%i_at_to_b, 1, ndim + SIZE(iatms)) + colvar%coord_param%i_at_to_b(ndim + 1:ndim + SIZE(iatms)) = iatms + ndim = ndim + SIZE(iatms) END DO colvar%coord_param%n_atoms_to_b = ndim colvar%coord_param%use_kinds_to_b = .FALSE. @@ -359,9 +359,9 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) CPASSERT(n_var_k > 0) DO k = 1, n_var_k CALL section_vals_val_get(coordination_section, "KINDS_TO_B", i_rep_val=k, c_vals=c_kinds) - CALL reallocate(colvar%coord_param%c_kinds_to_b, 1, ndim+SIZE(c_kinds)) - colvar%coord_param%c_kinds_to_b(ndim+1:ndim+SIZE(c_kinds)) = c_kinds - ndim = ndim+SIZE(c_kinds) + CALL reallocate(colvar%coord_param%c_kinds_to_b, 1, ndim + SIZE(c_kinds)) + colvar%coord_param%c_kinds_to_b(ndim + 1:ndim + SIZE(c_kinds)) = c_kinds + ndim = ndim + SIZE(c_kinds) END DO colvar%coord_param%n_atoms_to_b = 0 colvar%coord_param%use_kinds_to_b = .TRUE. @@ -430,9 +430,9 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) ndim = 0 DO k = 1, n_var CALL section_vals_val_get(qparm_section, "ATOMS_FROM", i_rep_val=k, i_vals=iatms) - CALL reallocate(colvar%qparm_param%i_at_from, 1, ndim+SIZE(iatms)) - colvar%qparm_param%i_at_from(ndim+1:ndim+SIZE(iatms)) = iatms - ndim = ndim+SIZE(iatms) + CALL reallocate(colvar%qparm_param%i_at_from, 1, ndim + SIZE(iatms)) + colvar%qparm_param%i_at_from(ndim + 1:ndim + SIZE(iatms)) = iatms + ndim = ndim + SIZE(iatms) END DO colvar%qparm_param%n_atoms_from = ndim ! This section can be repeated @@ -440,9 +440,9 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) ndim = 0 DO k = 1, n_var CALL section_vals_val_get(qparm_section, "ATOMS_TO", i_rep_val=k, i_vals=iatms) - CALL reallocate(colvar%qparm_param%i_at_to, 1, ndim+SIZE(iatms)) - colvar%qparm_param%i_at_to(ndim+1:ndim+SIZE(iatms)) = iatms - ndim = ndim+SIZE(iatms) + CALL reallocate(colvar%qparm_param%i_at_to, 1, ndim + SIZE(iatms)) + colvar%qparm_param%i_at_to(ndim + 1:ndim + SIZE(iatms)) = iatms + ndim = ndim + SIZE(iatms) END DO colvar%qparm_param%n_atoms_to = ndim ELSE IF (my_subsection(9)) THEN @@ -497,9 +497,9 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) ! INDEX LIST DO k = 1, n_var CALL section_vals_val_get(path_section, "ATOMS", i_rep_val=k, i_vals=iatms) - CALL reallocate(colvar%reaction_path_param%i_rmsd, 1, ndim+SIZE(iatms)) - colvar%reaction_path_param%i_rmsd(ndim+1:ndim+SIZE(iatms)) = iatms - ndim = ndim+SIZE(iatms) + CALL reallocate(colvar%reaction_path_param%i_rmsd, 1, ndim + SIZE(iatms)) + colvar%reaction_path_param%i_rmsd(ndim + 1:ndim + SIZE(iatms)) = iatms + ndim = ndim + SIZE(iatms) END DO colvar%reaction_path_param%n_components = ndim ELSE @@ -625,16 +625,16 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) DO i = 1, ncol isize = SIZE(colvar%combine_cvs_param%c_parameters) CALL section_vals_val_get(combine_section, "PARAMETERS", c_vals=my_par, i_rep_val=i) - CALL reallocate(colvar%combine_cvs_param%c_parameters, 1, isize+SIZE(my_par)) - colvar%combine_cvs_param%c_parameters(isize+1:isize+SIZE(my_par)) = my_par + CALL reallocate(colvar%combine_cvs_param%c_parameters, 1, isize + SIZE(my_par)) + colvar%combine_cvs_param%c_parameters(isize + 1:isize + SIZE(my_par)) = my_par END DO ALLOCATE (colvar%combine_cvs_param%v_parameters(0)) CALL section_vals_val_get(combine_section, "VALUES", n_rep_val=ncol) DO i = 1, ncol isize = SIZE(colvar%combine_cvs_param%v_parameters) CALL section_vals_val_get(combine_section, "VALUES", r_vals=my_vals, i_rep_val=i) - CALL reallocate(colvar%combine_cvs_param%v_parameters, 1, isize+SIZE(my_vals)) - colvar%combine_cvs_param%v_parameters(isize+1:isize+SIZE(my_vals)) = my_vals + CALL reallocate(colvar%combine_cvs_param%v_parameters, 1, isize + SIZE(my_vals)) + colvar%combine_cvs_param%v_parameters(isize + 1:isize + SIZE(my_vals)) = my_vals END DO ! Info on derivative evaluation CALL section_vals_val_get(combine_section, "DX", r_val=colvar%combine_cvs_param%dx) @@ -655,9 +655,9 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) ! INDEX LIST DO k = 1, n_var CALL section_vals_val_get(population_section, "ATOMS_FROM", i_rep_val=k, i_vals=iatms) - CALL reallocate(colvar%population_param%i_at_from, 1, ndim+SIZE(iatms)) - colvar%population_param%i_at_from(ndim+1:ndim+SIZE(iatms)) = iatms - ndim = ndim+SIZE(iatms) + CALL reallocate(colvar%population_param%i_at_from, 1, ndim + SIZE(iatms)) + colvar%population_param%i_at_from(ndim + 1:ndim + SIZE(iatms)) = iatms + ndim = ndim + SIZE(iatms) END DO colvar%population_param%n_atoms_from = ndim colvar%population_param%use_kinds_from = .FALSE. @@ -667,9 +667,9 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) CPASSERT(n_var > 0) DO k = 1, n_var CALL section_vals_val_get(population_section, "KINDS_FROM", i_rep_val=k, c_vals=c_kinds) - CALL reallocate(colvar%population_param%c_kinds_from, 1, ndim+SIZE(c_kinds)) - colvar%population_param%c_kinds_from(ndim+1:ndim+SIZE(c_kinds)) = c_kinds - ndim = ndim+SIZE(c_kinds) + CALL reallocate(colvar%population_param%c_kinds_from, 1, ndim + SIZE(c_kinds)) + colvar%population_param%c_kinds_from(ndim + 1:ndim + SIZE(c_kinds)) = c_kinds + ndim = ndim + SIZE(c_kinds) END DO colvar%population_param%n_atoms_from = 0 colvar%population_param%use_kinds_from = .TRUE. @@ -685,9 +685,9 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) ! INDEX LIST DO k = 1, n_var CALL section_vals_val_get(population_section, "ATOMS_TO", i_rep_val=k, i_vals=iatms) - CALL reallocate(colvar%population_param%i_at_to, 1, ndim+SIZE(iatms)) - colvar%population_param%i_at_to(ndim+1:ndim+SIZE(iatms)) = iatms - ndim = ndim+SIZE(iatms) + CALL reallocate(colvar%population_param%i_at_to, 1, ndim + SIZE(iatms)) + colvar%population_param%i_at_to(ndim + 1:ndim + SIZE(iatms)) = iatms + ndim = ndim + SIZE(iatms) END DO colvar%population_param%n_atoms_to = ndim colvar%population_param%use_kinds_to = .FALSE. @@ -697,9 +697,9 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) CPASSERT(n_var > 0) DO k = 1, n_var CALL section_vals_val_get(population_section, "KINDS_TO", i_rep_val=k, c_vals=c_kinds) - CALL reallocate(colvar%population_param%c_kinds_to, 1, ndim+SIZE(c_kinds)) - colvar%population_param%c_kinds_to(ndim+1:ndim+SIZE(c_kinds)) = c_kinds - ndim = ndim+SIZE(c_kinds) + CALL reallocate(colvar%population_param%c_kinds_to, 1, ndim + SIZE(c_kinds)) + colvar%population_param%c_kinds_to(ndim + 1:ndim + SIZE(c_kinds)) = c_kinds + ndim = ndim + SIZE(c_kinds) END DO colvar%population_param%n_atoms_to = 0 colvar%population_param%use_kinds_to = .TRUE. @@ -764,9 +764,9 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) ! INDEX LIST DO k = 1, n_var CALL section_vals_val_get(gyration_section, "ATOMS", i_rep_val=k, i_vals=iatms) - CALL reallocate(colvar%gyration_param%i_at, 1, ndim+SIZE(iatms)) - colvar%gyration_param%i_at(ndim+1:ndim+SIZE(iatms)) = iatms - ndim = ndim+SIZE(iatms) + CALL reallocate(colvar%gyration_param%i_at, 1, ndim + SIZE(iatms)) + colvar%gyration_param%i_at(ndim + 1:ndim + SIZE(iatms)) = iatms + ndim = ndim + SIZE(iatms) END DO colvar%gyration_param%n_atoms = ndim colvar%gyration_param%use_kinds = .FALSE. @@ -776,9 +776,9 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) CPASSERT(n_var > 0) DO k = 1, n_var CALL section_vals_val_get(gyration_section, "KINDS", i_rep_val=k, c_vals=c_kinds) - CALL reallocate(colvar%gyration_param%c_kinds, 1, ndim+SIZE(c_kinds)) - colvar%gyration_param%c_kinds(ndim+1:ndim+SIZE(c_kinds)) = c_kinds - ndim = ndim+SIZE(c_kinds) + CALL reallocate(colvar%gyration_param%c_kinds, 1, ndim + SIZE(c_kinds)) + colvar%gyration_param%c_kinds(ndim + 1:ndim + SIZE(c_kinds)) = c_kinds + ndim = ndim + SIZE(c_kinds) END DO colvar%gyration_param%n_atoms = 0 colvar%gyration_param%use_kinds = .TRUE. @@ -820,9 +820,9 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) ! INDEX LIST DO k = 1, n_var CALL section_vals_val_get(rmsd_section, "ATOMS", i_rep_val=k, i_vals=iatms) - CALL reallocate(colvar%rmsd_param%i_rmsd, 1, ndim+SIZE(iatms)) - colvar%rmsd_param%i_rmsd(ndim+1:ndim+SIZE(iatms)) = iatms - ndim = ndim+SIZE(iatms) + CALL reallocate(colvar%rmsd_param%i_rmsd, 1, ndim + SIZE(iatms)) + colvar%rmsd_param%i_rmsd(ndim + 1:ndim + SIZE(iatms)) = iatms + ndim = ndim + SIZE(iatms) END DO colvar%rmsd_param%n_atoms = ndim ELSE @@ -835,9 +835,9 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) ! INDEX LIST DO k = 1, n_var CALL section_vals_val_get(rmsd_section, "ATOMS", i_rep_val=k, i_vals=iatms) - CALL reallocate(colvar%rmsd_param%i_rmsd, 1, ndim+SIZE(iatms)) - colvar%rmsd_param%i_rmsd(ndim+1:ndim+SIZE(iatms)) = iatms - ndim = ndim+SIZE(iatms) + CALL reallocate(colvar%rmsd_param%i_rmsd, 1, ndim + SIZE(iatms)) + colvar%rmsd_param%i_rmsd(ndim + 1:ndim + SIZE(iatms)) = iatms + ndim = ndim + SIZE(iatms) END DO colvar%rmsd_param%n_atoms = ndim ELSE @@ -849,9 +849,9 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) ! INDEX LIST DO k = 1, n_var CALL section_vals_val_get(rmsd_section, "WEIGHTS", i_rep_val=k, r_vals=wei) - CALL reallocate(weights, 1, ndim+SIZE(wei)) - weights(ndim+1:ndim+SIZE(wei)) = wei - ndim = ndim+SIZE(wei) + CALL reallocate(weights, 1, ndim + SIZE(wei)) + weights(ndim + 1:ndim + SIZE(wei)) = wei + ndim = ndim + SIZE(wei) END DO IF (ndim /= colvar%rmsd_param%n_atoms) & CALL cp_abort(__LOCATION__, "CV RMSD: list of atoms and list of "// & @@ -939,7 +939,7 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) IF (ndim <= 3) & CPABORT("CV Ring Puckering: Ring size has to be 4 or larger. ") ii = colvar%ring_puckering_param%iq - IF (ABS(ii) == 1 .OR. ii < -(ndim-1)/2 .OR. ii > ndim/2) & + IF (ABS(ii) == 1 .OR. ii < -(ndim - 1)/2 .OR. ii > ndim/2) & CPABORT("CV Ring Puckering: Invalid coordinate number.") ELSE IF (my_subsection(23)) THEN ! Minimum Distance @@ -959,9 +959,9 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) ! INDEX LIST DO k = 1, n_var CALL section_vals_val_get(mindist_section, "ATOMS_FROM", i_rep_val=k, i_vals=iatms) - CALL reallocate(colvar%mindist_param%i_coord_from, 1, ndim+SIZE(iatms)) - colvar%mindist_param%i_coord_from(ndim+1:ndim+SIZE(iatms)) = iatms - ndim = ndim+SIZE(iatms) + CALL reallocate(colvar%mindist_param%i_coord_from, 1, ndim + SIZE(iatms)) + colvar%mindist_param%i_coord_from(ndim + 1:ndim + SIZE(iatms)) = iatms + ndim = ndim + SIZE(iatms) END DO colvar%mindist_param%n_coord_from = ndim colvar%mindist_param%use_kinds_from = .FALSE. @@ -971,9 +971,9 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) CPASSERT(n_var > 0) DO k = 1, n_var CALL section_vals_val_get(mindist_section, "KINDS_FROM", i_rep_val=k, c_vals=c_kinds) - CALL reallocate(colvar%mindist_param%k_coord_from, 1, ndim+SIZE(c_kinds)) - colvar%mindist_param%k_coord_from(ndim+1:ndim+SIZE(c_kinds)) = c_kinds - ndim = ndim+SIZE(c_kinds) + CALL reallocate(colvar%mindist_param%k_coord_from, 1, ndim + SIZE(c_kinds)) + colvar%mindist_param%k_coord_from(ndim + 1:ndim + SIZE(c_kinds)) = c_kinds + ndim = ndim + SIZE(c_kinds) END DO colvar%mindist_param%n_coord_from = 0 colvar%mindist_param%use_kinds_from = .TRUE. @@ -989,9 +989,9 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) ! INDEX LIST DO k = 1, n_var CALL section_vals_val_get(mindist_section, "ATOMS_TO", i_rep_val=k, i_vals=iatms) - CALL reallocate(colvar%mindist_param%i_coord_to, 1, ndim+SIZE(iatms)) - colvar%mindist_param%i_coord_to(ndim+1:ndim+SIZE(iatms)) = iatms - ndim = ndim+SIZE(iatms) + CALL reallocate(colvar%mindist_param%i_coord_to, 1, ndim + SIZE(iatms)) + colvar%mindist_param%i_coord_to(ndim + 1:ndim + SIZE(iatms)) = iatms + ndim = ndim + SIZE(iatms) END DO colvar%mindist_param%n_coord_to = ndim colvar%mindist_param%use_kinds_to = .FALSE. @@ -1001,9 +1001,9 @@ RECURSIVE SUBROUTINE colvar_read(colvar, icol, colvar_section, para_env) CPASSERT(n_var > 0) DO k = 1, n_var CALL section_vals_val_get(mindist_section, "KINDS_TO", i_rep_val=k, c_vals=c_kinds) - CALL reallocate(colvar%mindist_param%k_coord_to, 1, ndim+SIZE(c_kinds)) - colvar%mindist_param%k_coord_to(ndim+1:ndim+SIZE(c_kinds)) = c_kinds - ndim = ndim+SIZE(c_kinds) + CALL reallocate(colvar%mindist_param%k_coord_to, 1, ndim + SIZE(c_kinds)) + colvar%mindist_param%k_coord_to(ndim + 1:ndim + SIZE(c_kinds)) = c_kinds + ndim = ndim + SIZE(c_kinds) END DO colvar%mindist_param%n_coord_to = 0 colvar%mindist_param%use_kinds_to = .TRUE. @@ -1413,9 +1413,9 @@ SUBROUTINE read_hydronium_colvars(section, colvar, colvar_id, n_oxygens, n_hydro ndim = 0 DO k = 1, n_var CALL section_vals_val_get(section, "OXYGENS", i_vals=iatms) - CALL reallocate(i_oxygens, 1, ndim+SIZE(iatms)) - i_oxygens(ndim+1:ndim+SIZE(iatms)) = iatms - ndim = ndim+SIZE(iatms) + CALL reallocate(i_oxygens, 1, ndim + SIZE(iatms)) + i_oxygens(ndim + 1:ndim + SIZE(iatms)) = iatms + ndim = ndim + SIZE(iatms) END DO n_oxygens = ndim @@ -1423,9 +1423,9 @@ SUBROUTINE read_hydronium_colvars(section, colvar, colvar_id, n_oxygens, n_hydro ndim = 0 DO k = 1, n_var CALL section_vals_val_get(section, "HYDROGENS", i_vals=iatms) - CALL reallocate(i_hydrogens, 1, ndim+SIZE(iatms)) - i_hydrogens(ndim+1:ndim+SIZE(iatms)) = iatms - ndim = ndim+SIZE(iatms) + CALL reallocate(i_hydrogens, 1, ndim + SIZE(iatms)) + i_hydrogens(ndim + 1:ndim + SIZE(iatms)) = iatms + ndim = ndim + SIZE(iatms) END DO n_hydrogens = ndim @@ -1493,9 +1493,9 @@ SUBROUTINE read_acid_hydronium_colvars(section, colvar, colvar_id, n_oxygens_wat ndim = 0 DO k = 1, n_var CALL section_vals_val_get(section, "OXYGENS_WATER", i_vals=iatms) - CALL reallocate(i_oxygens_water, 1, ndim+SIZE(iatms)) - i_oxygens_water(ndim+1:ndim+SIZE(iatms)) = iatms - ndim = ndim+SIZE(iatms) + CALL reallocate(i_oxygens_water, 1, ndim + SIZE(iatms)) + i_oxygens_water(ndim + 1:ndim + SIZE(iatms)) = iatms + ndim = ndim + SIZE(iatms) END DO n_oxygens_water = ndim @@ -1503,9 +1503,9 @@ SUBROUTINE read_acid_hydronium_colvars(section, colvar, colvar_id, n_oxygens_wat ndim = 0 DO k = 1, n_var CALL section_vals_val_get(section, "OXYGENS_ACID", i_vals=iatms) - CALL reallocate(i_oxygens_acid, 1, ndim+SIZE(iatms)) - i_oxygens_acid(ndim+1:ndim+SIZE(iatms)) = iatms - ndim = ndim+SIZE(iatms) + CALL reallocate(i_oxygens_acid, 1, ndim + SIZE(iatms)) + i_oxygens_acid(ndim + 1:ndim + SIZE(iatms)) = iatms + ndim = ndim + SIZE(iatms) END DO n_oxygens_acid = ndim @@ -1513,9 +1513,9 @@ SUBROUTINE read_acid_hydronium_colvars(section, colvar, colvar_id, n_oxygens_wat ndim = 0 DO k = 1, n_var CALL section_vals_val_get(section, "HYDROGENS", i_vals=iatms) - CALL reallocate(i_hydrogens, 1, ndim+SIZE(iatms)) - i_hydrogens(ndim+1:ndim+SIZE(iatms)) = iatms - ndim = ndim+SIZE(iatms) + CALL reallocate(i_hydrogens, 1, ndim + SIZE(iatms)) + i_hydrogens(ndim + 1:ndim + SIZE(iatms)) = iatms + ndim = ndim + SIZE(iatms) END DO n_hydrogens = ndim @@ -1588,20 +1588,20 @@ SUBROUTINE colvar_check_points(colvar, section) NULLIFY (colvar%points(i)%atoms) NULLIFY (colvar%points(i)%weights) CALL section_vals_val_get(point_sections, "TYPE", i_rep_section=i, i_val=colvar%points(i)%type_id) - SELECT CASE (colvar%points (i)%type_id) + SELECT CASE (colvar%points(i)%type_id) CASE (do_clv_geo_center) ! Define a point through a list of atoms.. CALL section_vals_val_get(point_sections, "ATOMS", i_rep_section=i, n_rep_val=nrep, i_vals=atoms) DO irep = 1, nrep CALL section_vals_val_get(point_sections, "ATOMS", i_rep_section=i, i_rep_val=irep, i_vals=atoms) - natoms = natoms+SIZE(atoms) + natoms = natoms + SIZE(atoms) END DO ALLOCATE (colvar%points(i)%atoms(natoms)) natoms = 0 DO irep = 1, nrep CALL section_vals_val_get(point_sections, "ATOMS", i_rep_section=i, i_rep_val=irep, i_vals=atoms) - colvar%points(i)%atoms(natoms+1:) = atoms(:) - natoms = natoms+SIZE(atoms) + colvar%points(i)%atoms(natoms + 1:) = atoms(:) + natoms = natoms + SIZE(atoms) END DO ! Define weights of the list ALLOCATE (colvar%points(i)%weights(natoms)) @@ -1611,8 +1611,8 @@ SUBROUTINE colvar_check_points(colvar, section) DO irep = 1, nrep CALL section_vals_val_get(point_sections, "WEIGHTS", i_rep_section=i, i_rep_val=irep, & r_vals=weights) - colvar%points(i)%weights(nweights+1:) = weights(:) - nweights = nweights+SIZE(weights) + colvar%points(i)%weights(nweights + 1:) = weights(:) + nweights = nweights + SIZE(weights) END DO CPASSERT(natoms == nweights) END IF @@ -1946,7 +1946,7 @@ SUBROUTINE put_derivative(colvar, i, fi) IF (colvar%use_points) THEN CALL eval_point_der(colvar%points, i, colvar%dsdr, fi) ELSE - colvar%dsdr(:, i) = colvar%dsdr(:, i)+fi + colvar%dsdr(:, i) = colvar%dsdr(:, i) + fi END IF END SUBROUTINE put_derivative @@ -1999,11 +1999,11 @@ SUBROUTINE xyz_diag_colvar(colvar, cell, subsys, particles) ENDIF IF (colvar%xyz_diag_param%use_pbc) THEN - ss = MATMUL(cell%h_inv, xpi-r0) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, xpi - r0) + ss = ss - NINT(ss) xi = MATMUL(cell%hmat, ss) ELSE - xi = xpi-r0 + xi = xpi - r0 END IF IF (.NOT. colvar%xyz_diag_param%use_absolute_position) THEN @@ -2027,7 +2027,7 @@ SUBROUTINE xyz_diag_colvar(colvar, cell, subsys, particles) ! do_clv_xyz END SELECT - r = xi(1)**2+xi(2)**2+xi(3)**2 + r = xi(1)**2 + xi(2)**2 + xi(3)**2 fi(:) = 2.0_dp*xi ELSE SELECT CASE (colvar%xyz_diag_param%component) @@ -2100,14 +2100,14 @@ SUBROUTINE xyz_outerdiag_colvar(colvar, cell, subsys, particles) IF (ALL(colvar%xyz_outerdiag_param%r0(:, k) == HUGE(0.0_dp))) r0 = xpi IF (colvar%xyz_outerdiag_param%use_pbc) THEN - ss = MATMUL(cell%h_inv, xpi-r0) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, xpi - r0) + ss = ss - NINT(ss) xi(:, k) = MATMUL(cell%hmat, ss) ELSE - xi(:, k) = xpi-r0 + xi(:, k) = xpi - r0 END IF - SELECT CASE (colvar%xyz_outerdiag_param%components (k)) + SELECT CASE (colvar%xyz_outerdiag_param%components(k)) CASE (do_clv_x) xi(2, k) = 0.0_dp xi(3, k) = 0.0_dp @@ -2132,8 +2132,8 @@ SUBROUTINE xyz_outerdiag_colvar(colvar, cell, subsys, particles) fi = 0.0_dp DO i = 1, 3 DO l = 1, 3 - IF (xi(l, 1) /= 0.0_dp) fi(l, 1) = fi(l, 1)+xi(i, 2) - r = r+xi(l, 1)*xi(i, 2) + IF (xi(l, 1) /= 0.0_dp) fi(l, 1) = fi(l, 1) + xi(i, 2) + r = r + xi(l, 1)*xi(i, 2) END DO IF (xi(i, 2) /= 0.0_dp) fi(i, 2) = SUM(xi(:, 1)) END DO @@ -2355,34 +2355,34 @@ SUBROUTINE plane_distance_colvar(colvar, cell, subsys, particles) CALL get_coordinates(colvar, j, rj, my_particles) CALL get_coordinates(colvar, k, rk, my_particles) CALL get_coordinates(colvar, l, rl, my_particles) - xpij = ri-rj - xpkj = rk-rj - xpl = rl-(ri+rj+rk)/3.0_dp + xpij = ri - rj + xpkj = rk - rj + xpl = rl - (ri + rj + rk)/3.0_dp IF (colvar%plane_distance_param%use_pbc) THEN ! xpij - ss = MATMUL(cell%h_inv, ri-rj) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, ri - rj) + ss = ss - NINT(ss) xpij = MATMUL(cell%hmat, ss) ! xpkj - ss = MATMUL(cell%h_inv, rk-rj) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, rk - rj) + ss = ss - NINT(ss) xpkj = MATMUL(cell%hmat, ss) ! xpl - ss = MATMUL(cell%h_inv, rl-(ri+rj+rk)/3.0_dp) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, rl - (ri + rj + rk)/3.0_dp) + ss = ss - NINT(ss) xpl = MATMUL(cell%hmat, ss) END IF ! xpn - xpn(1) = xpij(2)*xpkj(3)-xpij(3)*xpkj(2) - xpn(2) = xpij(3)*xpkj(1)-xpij(1)*xpkj(3) - xpn(3) = xpij(1)*xpkj(2)-xpij(2)*xpkj(1) + xpn(1) = xpij(2)*xpkj(3) - xpij(3)*xpkj(2) + xpn(2) = xpij(3)*xpkj(1) - xpij(1)*xpkj(3) + xpn(3) = xpij(1)*xpkj(2) - xpij(2)*xpkj(1) a = DOT_PRODUCT(xpn, xpn) b = DOT_PRODUCT(xpl, xpn) r12 = SQRT(a) colvar%ss = b/r12 - dsdxpn(1) = xpl(1)/r12-b*xpn(1)/(r12*a) - dsdxpn(2) = xpl(2)/r12-b*xpn(2)/(r12*a) - dsdxpn(3) = xpl(3)/r12-b*xpn(3)/(r12*a) + dsdxpn(1) = xpl(1)/r12 - b*xpn(1)/(r12*a) + dsdxpn(2) = xpl(2)/r12 - b*xpn(2)/(r12*a) + dsdxpn(3) = xpl(3)/r12 - b*xpn(3)/(r12*a) ! dxpndxi(1, 1) = 0.0_dp dxpndxi(1, 2) = 1.0_dp*xpkj(3) @@ -2395,13 +2395,13 @@ SUBROUTINE plane_distance_colvar(colvar, cell, subsys, particles) dxpndxi(3, 3) = 0.0_dp ! dxpndxj(1, 1) = 0.0_dp - dxpndxj(1, 2) = -1.0_dp*xpkj(3)+xpij(3) - dxpndxj(1, 3) = -1.0_dp*xpij(2)+xpkj(2) - dxpndxj(2, 1) = -1.0_dp*xpij(3)+xpkj(3) + dxpndxj(1, 2) = -1.0_dp*xpkj(3) + xpij(3) + dxpndxj(1, 3) = -1.0_dp*xpij(2) + xpkj(2) + dxpndxj(2, 1) = -1.0_dp*xpij(3) + xpkj(3) dxpndxj(2, 2) = 0.0_dp - dxpndxj(2, 3) = -1.0_dp*xpkj(1)+xpij(1) - dxpndxj(3, 1) = -1.0_dp*xpkj(2)+xpij(2) - dxpndxj(3, 2) = -1.0_dp*xpij(1)+xpkj(1) + dxpndxj(2, 3) = -1.0_dp*xpkj(1) + xpij(1) + dxpndxj(3, 1) = -1.0_dp*xpkj(2) + xpij(2) + dxpndxj(3, 2) = -1.0_dp*xpij(1) + xpkj(1) dxpndxj(3, 3) = 0.0_dp ! dxpndxk(1, 1) = 0.0_dp @@ -2414,9 +2414,9 @@ SUBROUTINE plane_distance_colvar(colvar, cell, subsys, particles) dxpndxk(3, 2) = 1.0_dp*xpij(1) dxpndxk(3, 3) = 0.0_dp ! - fi(:) = MATMUL(dsdxpn, dxpndxi)-xpn/(3.0_dp*r12) - fj(:) = MATMUL(dsdxpn, dxpndxj)-xpn/(3.0_dp*r12) - fk(:) = MATMUL(dsdxpn, dxpndxk)-xpn/(3.0_dp*r12) + fi(:) = MATMUL(dsdxpn, dxpndxi) - xpn/(3.0_dp*r12) + fj(:) = MATMUL(dsdxpn, dxpndxj) - xpn/(3.0_dp*r12) + fk(:) = MATMUL(dsdxpn, dxpndxk) - xpn/(3.0_dp*r12) fl(:) = xpn/r12 ! Transfer derivatives on atoms CALL put_derivative(colvar, 1, fi) @@ -2479,19 +2479,19 @@ SUBROUTINE plane_plane_angle_colvar(colvar, cell, subsys, particles) CALL get_coordinates(colvar, k1, rk1, my_particles) ! xpij - ss = MATMUL(cell%h_inv, ri1-rj1) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, ri1 - rj1) + ss = ss - NINT(ss) xpij1 = MATMUL(cell%hmat, ss) ! xpkj - ss = MATMUL(cell%h_inv, rk1-rj1) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, rk1 - rj1) + ss = ss - NINT(ss) xpkj1 = MATMUL(cell%hmat, ss) ! xpn - xpn1(1) = xpij1(2)*xpkj1(3)-xpij1(3)*xpkj1(2) - xpn1(2) = xpij1(3)*xpkj1(1)-xpij1(1)*xpkj1(3) - xpn1(3) = xpij1(1)*xpkj1(2)-xpij1(2)*xpkj1(1) + xpn1(1) = xpij1(2)*xpkj1(3) - xpij1(3)*xpkj1(2) + xpn1(2) = xpij1(3)*xpkj1(1) - xpij1(1)*xpkj1(3) + xpn1(3) = xpij1(1)*xpkj1(2) - xpij1(2)*xpkj1(1) ELSE xpn1 = colvar%plane_plane_angle_param%plane1%normal_vec END IF @@ -2511,19 +2511,19 @@ SUBROUTINE plane_plane_angle_colvar(colvar, cell, subsys, particles) CALL get_coordinates(colvar, k2, rk2, my_particles) ! xpij - ss = MATMUL(cell%h_inv, ri2-rj2) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, ri2 - rj2) + ss = ss - NINT(ss) xpij2 = MATMUL(cell%hmat, ss) ! xpkj - ss = MATMUL(cell%h_inv, rk2-rj2) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, rk2 - rj2) + ss = ss - NINT(ss) xpkj2 = MATMUL(cell%hmat, ss) ! xpn - xpn2(1) = xpij2(2)*xpkj2(3)-xpij2(3)*xpkj2(2) - xpn2(2) = xpij2(3)*xpkj2(1)-xpij2(1)*xpkj2(3) - xpn2(3) = xpij2(1)*xpkj2(2)-xpij2(2)*xpkj2(1) + xpn2(1) = xpij2(2)*xpkj2(3) - xpij2(3)*xpkj2(2) + xpn2(2) = xpij2(3)*xpkj2(1) - xpij2(1)*xpkj2(3) + xpn2(3) = xpij2(1)*xpkj2(2) - xpij2(2)*xpkj2(1) ELSE xpn2 = colvar%plane_plane_angle_param%plane2%normal_vec END IF @@ -2539,7 +2539,7 @@ SUBROUTINE plane_plane_angle_colvar(colvar, cell, subsys, particles) t = MIN(1.0_dp, ABS(t))*SIGN(1.0_dp, t) colvar%ss = ACOS(t) - IF ((ABS(colvar%ss) .LT. tolerance_acos) .OR. (ABS(colvar%ss-pi) .LT. tolerance_acos)) THEN + IF ((ABS(colvar%ss) .LT. tolerance_acos) .OR. (ABS(colvar%ss - pi) .LT. tolerance_acos)) THEN fmod = 0.0_dp ELSE fmod = -1.0_dp/SIN(colvar%ss) @@ -2550,7 +2550,7 @@ SUBROUTINE plane_plane_angle_colvar(colvar, cell, subsys, particles) IF (colvar%plane_plane_angle_param%plane1%type_of_def == plane_def_atoms) THEN dprod12_dxpn = xpn2 dnorm_dxpn = 1.0_dp/norm1*xpn1 - dt_dxpn = (dprod12_dxpn*d-prod_12*dnorm_dxpn*norm2)/d**2 + dt_dxpn = (dprod12_dxpn*d - prod_12*dnorm_dxpn*norm2)/d**2 dsdxpn(1) = fmod*dt_dxpn(1) dsdxpn(2) = fmod*dt_dxpn(2) @@ -2567,13 +2567,13 @@ SUBROUTINE plane_plane_angle_colvar(colvar, cell, subsys, particles) dxpndxi(3, 3) = 0.0_dp ! dxpndxj(1, 1) = 0.0_dp - dxpndxj(1, 2) = -1.0_dp*xpkj1(3)+xpij1(3) - dxpndxj(1, 3) = -1.0_dp*xpij1(2)+xpkj1(2) - dxpndxj(2, 1) = -1.0_dp*xpij1(3)+xpkj1(3) + dxpndxj(1, 2) = -1.0_dp*xpkj1(3) + xpij1(3) + dxpndxj(1, 3) = -1.0_dp*xpij1(2) + xpkj1(2) + dxpndxj(2, 1) = -1.0_dp*xpij1(3) + xpkj1(3) dxpndxj(2, 2) = 0.0_dp - dxpndxj(2, 3) = -1.0_dp*xpkj1(1)+xpij1(1) - dxpndxj(3, 1) = -1.0_dp*xpkj1(2)+xpij1(2) - dxpndxj(3, 2) = -1.0_dp*xpij1(1)+xpkj1(1) + dxpndxj(2, 3) = -1.0_dp*xpkj1(1) + xpij1(1) + dxpndxj(3, 1) = -1.0_dp*xpkj1(2) + xpij1(2) + dxpndxj(3, 2) = -1.0_dp*xpij1(1) + xpkj1(1) dxpndxj(3, 3) = 0.0_dp ! dxpndxk(1, 1) = 0.0_dp @@ -2591,9 +2591,9 @@ SUBROUTINE plane_plane_angle_colvar(colvar, cell, subsys, particles) fk = MATMUL(dsdxpn, dxpndxk) ! Transfer derivatives on atoms - CALL put_derivative(colvar, np+1, fi) - CALL put_derivative(colvar, np+2, fj) - CALL put_derivative(colvar, np+3, fk) + CALL put_derivative(colvar, np + 1, fi) + CALL put_derivative(colvar, np + 2, fj) + CALL put_derivative(colvar, np + 3, fk) np = 3 END IF @@ -2601,7 +2601,7 @@ SUBROUTINE plane_plane_angle_colvar(colvar, cell, subsys, particles) IF (colvar%plane_plane_angle_param%plane2%type_of_def == plane_def_atoms) THEN dprod12_dxpn = xpn1 dnorm_dxpn = 1.0_dp/norm2*xpn2 - dt_dxpn = (dprod12_dxpn*d-prod_12*dnorm_dxpn*norm1)/d**2 + dt_dxpn = (dprod12_dxpn*d - prod_12*dnorm_dxpn*norm1)/d**2 dsdxpn(1) = fmod*dt_dxpn(1) dsdxpn(2) = fmod*dt_dxpn(2) @@ -2618,13 +2618,13 @@ SUBROUTINE plane_plane_angle_colvar(colvar, cell, subsys, particles) dxpndxi(3, 3) = 0.0_dp ! dxpndxj(1, 1) = 0.0_dp - dxpndxj(1, 2) = -1.0_dp*xpkj1(3)+xpij1(3) - dxpndxj(1, 3) = -1.0_dp*xpij1(2)+xpkj1(2) - dxpndxj(2, 1) = -1.0_dp*xpij1(3)+xpkj1(3) + dxpndxj(1, 2) = -1.0_dp*xpkj1(3) + xpij1(3) + dxpndxj(1, 3) = -1.0_dp*xpij1(2) + xpkj1(2) + dxpndxj(2, 1) = -1.0_dp*xpij1(3) + xpkj1(3) dxpndxj(2, 2) = 0.0_dp - dxpndxj(2, 3) = -1.0_dp*xpkj1(1)+xpij1(1) - dxpndxj(3, 1) = -1.0_dp*xpkj1(2)+xpij1(2) - dxpndxj(3, 2) = -1.0_dp*xpij1(1)+xpkj1(1) + dxpndxj(2, 3) = -1.0_dp*xpkj1(1) + xpij1(1) + dxpndxj(3, 1) = -1.0_dp*xpkj1(2) + xpij1(2) + dxpndxj(3, 2) = -1.0_dp*xpij1(1) + xpkj1(1) dxpndxj(3, 3) = 0.0_dp ! dxpndxk(1, 1) = 0.0_dp @@ -2642,9 +2642,9 @@ SUBROUTINE plane_plane_angle_colvar(colvar, cell, subsys, particles) fk = MATMUL(dsdxpn, dxpndxk) ! Transfer derivatives on atoms - CALL put_derivative(colvar, np+1, fi) - CALL put_derivative(colvar, np+2, fj) - CALL put_derivative(colvar, np+3, fk) + CALL put_derivative(colvar, np + 1, fi) + CALL put_derivative(colvar, np + 2, fj) + CALL put_derivative(colvar, np + 3, fk) END IF END SUBROUTINE plane_plane_angle_colvar @@ -2695,12 +2695,12 @@ SUBROUTINE rotation_colvar(colvar, cell, subsys, particles) i = colvar%rotation_param%i_at2_bond2 CALL get_coordinates(colvar, i, xp2b2, my_particles) ! xij - ss = MATMUL(cell%h_inv, xp1b1-xp2b1) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, xp1b1 - xp2b1) + ss = ss - NINT(ss) xij = MATMUL(cell%hmat, ss) ! xkj - ss = MATMUL(cell%h_inv, xp1b2-xp2b2) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, xp1b2 - xp2b2) + ss = ss - NINT(ss) xkj = MATMUL(cell%hmat, ss) ! evaluation of the angle.. a = SQRT(DOT_PRODUCT(xij, xij)) @@ -2710,15 +2710,15 @@ SUBROUTINE rotation_colvar(colvar, cell, subsys, particles) t2 = 1.0_dp/(a*b**3.0_dp) t3 = DOT_PRODUCT(xij, xkj) colvar%ss = ACOS(t3*t0) - IF ((ABS(colvar%ss) .LT. tolerance_acos) .OR. (ABS(colvar%ss-pi) .LT. tolerance_acos)) THEN + IF ((ABS(colvar%ss) .LT. tolerance_acos) .OR. (ABS(colvar%ss - pi) .LT. tolerance_acos)) THEN fmod = 0.0_dp ELSE fmod = -1.0_dp/SIN(colvar%ss) ENDIF - dp1b1 = xkj(:)*t0-xij(:)*t1*t3 - dp2b1 = -xkj(:)*t0+xij(:)*t1*t3 - dp1b2 = xij(:)*t0-xkj(:)*t2*t3 - dp2b2 = -xij(:)*t0+xkj(:)*t2*t3 + dp1b1 = xkj(:)*t0 - xij(:)*t1*t3 + dp2b1 = -xkj(:)*t0 + xij(:)*t1*t3 + dp1b2 = xij(:)*t0 - xkj(:)*t2*t3 + dp2b2 = -xij(:)*t0 + xkj(:)*t2*t3 xdum = dp1b1*fmod idum = colvar%rotation_param%i_at1_bond1 @@ -2776,28 +2776,28 @@ SUBROUTINE dfunct_colvar(colvar, cell, subsys, particles) CALL get_coordinates(colvar, i, xpi, my_particles) CALL get_coordinates(colvar, j, xpj, my_particles) IF (colvar%dfunct_param%use_pbc) THEN - ss = MATMUL(cell%h_inv, xpi-xpj) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, xpi - xpj) + ss = ss - NINT(ss) xij = MATMUL(cell%hmat, ss) ELSE - xij = xpi-xpj + xij = xpi - xpj END IF - r12 = SQRT(xij(1)**2+xij(2)**2+xij(3)**2) + r12 = SQRT(xij(1)**2 + xij(2)**2 + xij(3)**2) ! Second bond k = colvar%dfunct_param%i_at_dfunct(3) l = colvar%dfunct_param%i_at_dfunct(4) CALL get_coordinates(colvar, k, xpk, my_particles) CALL get_coordinates(colvar, l, xpl, my_particles) IF (colvar%dfunct_param%use_pbc) THEN - ss = MATMUL(cell%h_inv, xpk-xpl) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, xpk - xpl) + ss = ss - NINT(ss) xkl = MATMUL(cell%hmat, ss) ELSE - xkl = xpk-xpl + xkl = xpk - xpl END IF - r34 = SQRT(xkl(1)**2+xkl(2)**2+xkl(3)**2) + r34 = SQRT(xkl(1)**2 + xkl(2)**2 + xkl(3)**2) ! - colvar%ss = r12+colvar%dfunct_param%coeff*r34 + colvar%ss = r12 + colvar%dfunct_param%coeff*r34 fi(:) = xij/r12 fj(:) = -xij/r12 fk(:) = colvar%dfunct_param%coeff*xkl/r34 @@ -2850,12 +2850,12 @@ SUBROUTINE angle_colvar(colvar, cell, subsys, particles) CALL get_coordinates(colvar, j, rj, my_particles) CALL get_coordinates(colvar, k, rk, my_particles) ! xij - ss = MATMUL(cell%h_inv, ri-rj) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, ri - rj) + ss = ss - NINT(ss) xij = MATMUL(cell%hmat, ss) ! xkj - ss = MATMUL(cell%h_inv, rk-rj) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, rk - rj) + ss = ss - NINT(ss) xkj = MATMUL(cell%hmat, ss) ! Evaluation of the angle.. a = SQRT(DOT_PRODUCT(xij, xij)) @@ -2865,14 +2865,14 @@ SUBROUTINE angle_colvar(colvar, cell, subsys, particles) t2 = 1.0_dp/(a*b**3.0_dp) t3 = DOT_PRODUCT(xij, xkj) colvar%ss = ACOS(t3*t0) - IF ((ABS(colvar%ss) .LT. tolerance_acos) .OR. (ABS(colvar%ss-pi) .LT. tolerance_acos)) THEN + IF ((ABS(colvar%ss) .LT. tolerance_acos) .OR. (ABS(colvar%ss - pi) .LT. tolerance_acos)) THEN fmod = 0.0_dp ELSE fmod = -1.0_dp/SIN(colvar%ss) ENDIF - fi(:) = xkj(:)*t0-xij(:)*t1*t3 - fj(:) = -xkj(:)*t0+xij(:)*t1*t3-xij(:)*t0+xkj(:)*t2*t3 - fk(:) = xij(:)*t0-xkj(:)*t2*t3 + fi(:) = xkj(:)*t0 - xij(:)*t1*t3 + fj(:) = -xkj(:)*t0 + xij(:)*t1*t3 - xij(:)*t0 + xkj(:)*t2*t3 + fk(:) = xij(:)*t0 - xkj(:)*t2*t3 fi = fi*fmod fj = fj*fmod fk = fk*fmod @@ -2919,8 +2919,8 @@ SUBROUTINE dist_colvar(colvar, cell, subsys, particles) j = colvar%dist_param%j_at CALL get_coordinates(colvar, i, xpi, my_particles) CALL get_coordinates(colvar, j, xpj, my_particles) - ss = MATMUL(cell%h_inv, xpi-xpj) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, xpi - xpj) + ss = ss - NINT(ss) xij = MATMUL(cell%hmat, ss) SELECT CASE (colvar%dist_param%axis_id) CASE (do_clv_x) @@ -2941,7 +2941,7 @@ SUBROUTINE dist_colvar(colvar, cell, subsys, particles) CASE DEFAULT !do_clv_xyz END SELECT - r12 = SQRT(xij(1)**2+xij(2)**2+xij(3)**2) + r12 = SQRT(xij(1)**2 + xij(2)**2 + xij(3)**2) colvar%ss = r12 fi(:) = xij/r12 @@ -3000,51 +3000,51 @@ SUBROUTINE torsion_colvar(colvar, cell, subsys, particles, no_riemann_sheet_op) ENDDO o0 = colvar%torsion_param%o0 ! ba - ss = MATMUL(cell%h_inv, rr(:, 2)-rr(:, 1)) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, rr(:, 2) - rr(:, 1)) + ss = ss - NINT(ss) ss = MATMUL(cell%hmat, ss) xba = ss(1) yba = ss(2) zba = ss(3) ! cb - ss = MATMUL(cell%h_inv, rr(:, 3)-rr(:, 2)) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, rr(:, 3) - rr(:, 2)) + ss = ss - NINT(ss) ss = MATMUL(cell%hmat, ss) xcb = ss(1) ycb = ss(2) zcb = ss(3) ! dc - ss = MATMUL(cell%h_inv, rr(:, 4)-rr(:, 3)) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, rr(:, 4) - rr(:, 3)) + ss = ss - NINT(ss) ss = MATMUL(cell%hmat, ss) xdc = ss(1) ydc = ss(2) zdc = ss(3) ! - xt = yba*zcb-ycb*zba - yt = zba*xcb-zcb*xba - zt = xba*ycb-xcb*yba - xu = ycb*zdc-ydc*zcb - yu = zcb*xdc-zdc*xcb - zu = xcb*ydc-xdc*ycb - xtu = yt*zu-yu*zt - ytu = zt*xu-zu*xt - ztu = xt*yu-xu*yt - rt2 = xt*xt+yt*yt+zt*zt - ru2 = xu*xu+yu*yu+zu*zu + xt = yba*zcb - ycb*zba + yt = zba*xcb - zcb*xba + zt = xba*ycb - xcb*yba + xu = ycb*zdc - ydc*zcb + yu = zcb*xdc - zdc*xcb + zu = xcb*ydc - xdc*ycb + xtu = yt*zu - yu*zt + ytu = zt*xu - zu*xt + ztu = xt*yu - xu*yt + rt2 = xt*xt + yt*yt + zt*zt + ru2 = xu*xu + yu*yu + zu*zu rtru = SQRT(rt2*ru2) IF (rtru .NE. 0.0_dp) THEN - rcb = SQRT(xcb*xcb+ycb*ycb+zcb*zcb) - cosine = (xt*xu+yt*yu+zt*zu)/rtru - sine = (xcb*xtu+ycb*ytu+zcb*ztu)/(rcb*rtru) + rcb = SQRT(xcb*xcb + ycb*ycb + zcb*zcb) + cosine = (xt*xu + yt*yu + zt*zu)/rtru + sine = (xcb*xtu + ycb*ytu + zcb*ztu)/(rcb*rtru) cosine = MIN(1.0_dp, MAX(-1.0_dp, cosine)) angle = ACOS(cosine) IF (sine .LT. 0.0_dp) angle = -angle ! dt = angle ! [rad] - dt = MOD(2.0E4_dp*pi+dt-o0, 2.0_dp*pi) - IF (dt .GT. pi) dt = dt-2.0_dp*pi - dt = o0+dt + dt = MOD(2.0E4_dp*pi + dt - o0, 2.0_dp*pi) + IF (dt .GT. pi) dt = dt - 2.0_dp*pi + dt = o0 + dt colvar%torsion_param%o0 = dt ! ! calculate improper energy and master chain rule term @@ -3055,42 +3055,42 @@ SUBROUTINE torsion_colvar(colvar, cell, subsys, particles, no_riemann_sheet_op) ! chain rule terms for first derivative components ! ! ca - ss = MATMUL(cell%h_inv, rr(:, 3)-rr(:, 1)) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, rr(:, 3) - rr(:, 1)) + ss = ss - NINT(ss) ss = MATMUL(cell%hmat, ss) xca = ss(1) yca = ss(2) zca = ss(3) ! db - ss = MATMUL(cell%h_inv, rr(:, 4)-rr(:, 2)) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, rr(:, 4) - rr(:, 2)) + ss = ss - NINT(ss) ss = MATMUL(cell%hmat, ss) xdb = ss(1) ydb = ss(2) zdb = ss(3) ! - dedxt = dedphi*(yt*zcb-ycb*zt)/(rt2*rcb) - dedyt = dedphi*(zt*xcb-zcb*xt)/(rt2*rcb) - dedzt = dedphi*(xt*ycb-xcb*yt)/(rt2*rcb) - dedxu = -dedphi*(yu*zcb-ycb*zu)/(ru2*rcb) - dedyu = -dedphi*(zu*xcb-zcb*xu)/(ru2*rcb) - dedzu = -dedphi*(xu*ycb-xcb*yu)/(ru2*rcb) + dedxt = dedphi*(yt*zcb - ycb*zt)/(rt2*rcb) + dedyt = dedphi*(zt*xcb - zcb*xt)/(rt2*rcb) + dedzt = dedphi*(xt*ycb - xcb*yt)/(rt2*rcb) + dedxu = -dedphi*(yu*zcb - ycb*zu)/(ru2*rcb) + dedyu = -dedphi*(zu*xcb - zcb*xu)/(ru2*rcb) + dedzu = -dedphi*(xu*ycb - xcb*yu)/(ru2*rcb) ! ! compute first derivative components for this angle ! - dedxia = zcb*dedyt-ycb*dedzt - dedyia = xcb*dedzt-zcb*dedxt - dedzia = ycb*dedxt-xcb*dedyt - dedzia = ycb*dedxt-xcb*dedyt - dedxib = yca*dedzt-zca*dedyt+zdc*dedyu-ydc*dedzu - dedyib = zca*dedxt-xca*dedzt+xdc*dedzu-zdc*dedxu - dedzib = xca*dedyt-yca*dedxt+ydc*dedxu-xdc*dedyu - dedxic = zba*dedyt-yba*dedzt+ydb*dedzu-zdb*dedyu - dedyic = xba*dedzt-zba*dedxt+zdb*dedxu-xdb*dedzu - dedzic = yba*dedxt-xba*dedyt+xdb*dedyu-ydb*dedxu - dedxid = zcb*dedyu-ycb*dedzu - dedyid = xcb*dedzu-zcb*dedxu - dedzid = ycb*dedxu-xcb*dedyu + dedxia = zcb*dedyt - ycb*dedzt + dedyia = xcb*dedzt - zcb*dedxt + dedzia = ycb*dedxt - xcb*dedyt + dedzia = ycb*dedxt - xcb*dedyt + dedxib = yca*dedzt - zca*dedyt + zdc*dedyu - ydc*dedzu + dedyib = zca*dedxt - xca*dedzt + xdc*dedzu - zdc*dedxu + dedzib = xca*dedyt - yca*dedxt + ydc*dedxu - xdc*dedyu + dedxic = zba*dedyt - yba*dedzt + ydb*dedzu - zdb*dedyu + dedyic = xba*dedzt - zba*dedxt + zdb*dedxu - xdb*dedzu + dedzic = yba*dedxt - xba*dedyt + xdb*dedyu - ydb*dedxu + dedxid = zcb*dedyu - ycb*dedzu + dedyid = xcb*dedzu - zcb*dedxu + dedzid = ycb*dedxu - xcb*dedyu ENDIF ! colvar%ss = e @@ -3194,17 +3194,17 @@ SUBROUTINE qparm_colvar(colvar, cell, subsys, particles) ! determine how many cells must be included in each direction ! based on rcut - xij(:) = xpj(:)-xpi(:) + xij(:) = xpj(:) - xpi(:) ss = MATMUL(cell%h_inv, xij) ! these are fractional coordinates of the closest periodic image ! lie in the [-0.5,0.5] interval - ss0 = ss-NINT(ss) + ss0 = ss - NINT(ss) DO idim = 1, 3 shift(:) = 0.0_dp shift(idim) = 1.0_dp xij_shift = MATMUL(cell%hmat, shift) rij_shift = SQRT(DOT_PRODUCT(xij_shift, xij_shift)) - ncells(idim) = FLOOR(rcut/rij_shift-0.5) + ncells(idim) = FLOOR(rcut/rij_shift - 0.5) ENDDO !idim !IF (mm.eq.0) WRITE(*,'(A8,3I3,A3,I10)') "Ncells:", ncells, "J:", j @@ -3217,7 +3217,7 @@ SUBROUTINE qparm_colvar(colvar, cell, subsys, particles) shift(1) = REAL(aa, KIND=dp) shift(2) = REAL(bb, KIND=dp) shift(3) = REAL(cc, KIND=dp) - xij = MATMUL(cell%hmat, ss0(:)+shift(:)) + xij = MATMUL(cell%hmat, ss0(:) + shift(:)) rij = SQRT(DOT_PRODUCT(xij, xij)) !IF (rij > rcut) THEN ! IF (mm.EQ.0) WRITE(*,'(A8,4F10.5)') " --", shift, rij @@ -3238,7 +3238,7 @@ SUBROUTINE qparm_colvar(colvar, cell, subsys, particles) ELSE IF (i == j) CYCLE jloop - xij(:) = xpj(:)-xpi(:) + xij(:) = xpj(:) - xpi(:) rij = SQRT(DOT_PRODUCT(xij, xij)) IF (rij > rcut) CYCLE @@ -3266,19 +3266,19 @@ SUBROUTINE qparm_colvar(colvar, cell, subsys, particles) d_nbond_dxi(:) = d_nbond_dxi(:)/nbond re_qlm = re_qlm/nbond - d_re_qlm_dxi(:) = d_re_qlm_dxi(:)/nbond-d_nbond_dxi(:)*re_qlm + d_re_qlm_dxi(:) = d_re_qlm_dxi(:)/nbond - d_nbond_dxi(:)*re_qlm im_qlm = im_qlm/nbond - d_im_qlm_dxi(:) = d_im_qlm_dxi(:)/nbond-d_nbond_dxi(:)*im_qlm + d_im_qlm_dxi(:) = d_im_qlm_dxi(:)/nbond - d_nbond_dxi(:)*im_qlm - ql = ql+fact*(re_qlm*re_qlm+im_qlm*im_qlm) + ql = ql + fact*(re_qlm*re_qlm + im_qlm*im_qlm) d_ql_dxi(:) = d_ql_dxi(:) & - +fact*2.0_dp*(re_qlm*d_re_qlm_dxi(:)+im_qlm*d_im_qlm_dxi(:)) + + fact*2.0_dp*(re_qlm*d_re_qlm_dxi(:) + im_qlm*d_im_qlm_dxi(:)) ENDDO ! loop over m - pre_fac = (4.0_dp*pi)/(2.0_dp*l+1) + pre_fac = (4.0_dp*pi)/(2.0_dp*l + 1) !WRITE(*,'(A8,2F10.5)') " si = ", SQRT(pre_fac*ql) - qparm = qparm+SQRT(pre_fac*ql) + qparm = qparm + SQRT(pre_fac*ql) ftmp(:) = 0.5_dp*SQRT(pre_fac/ql)*d_ql_dxi(:) ! multiply by -1 because aparently we have to save the force, not the gradient ftmp(:) = -1.0_dp*ftmp(:) @@ -3338,16 +3338,16 @@ SUBROUTINE accumulate_qlm_over_neigbors(xij, rij, rcut, r1cut, & bond = 1.0_dp exp_fac = 0.0_dp ELSE - exp0 = EXP((r1cut-rcut)/(rij-rcut)-(r1cut-rcut)/(r1cut-rij)) - bond = 1.0_dp/(1.0_dp+exp0) - exp_fac = ((rcut-r1cut)/(rij-rcut)**2+(rcut-r1cut)/(r1cut-rij)**2)*exp0/(1.0_dp+exp0)**2 + exp0 = EXP((r1cut - rcut)/(rij - rcut) - (r1cut - rcut)/(r1cut - rij)) + bond = 1.0_dp/(1.0_dp + exp0) + exp_fac = ((rcut - r1cut)/(rij - rcut)**2 + (rcut - r1cut)/(r1cut - rij)**2)*exp0/(1.0_dp + exp0)**2 ENDIF ENDIF IF (bond > 1.0_dp) THEN CPABORT("bond > 1.0_dp") END IF ! compute continuous bond order - nbond = nbond+bond + nbond = nbond + bond IF (ABS(xij(1)) .LT. denominator_tolerance & .AND. ABS(xij(2)) .LT. denominator_tolerance) THEN fi = 0.0_dp @@ -3362,11 +3362,11 @@ SUBROUTINE accumulate_qlm_over_neigbors(xij, rij, rcut, r1cut, & ! legendre works correctly only for positive m plm = legendre(costheta, ll, mm) dplm = dlegendre(costheta, ll, mm) - IF ((ll+ABS(mm)) > maxfac) THEN + IF ((ll + ABS(mm)) > maxfac) THEN CPABORT("(l+m) > maxfac") END IF ! use absolute m to compenstate for the defficiency of legendre - sqrt_c1 = SQRT(((2*ll+1)*fac(ll-ABS(mm)))/(4*pi*fac(ll+ABS(mm)))) + sqrt_c1 = SQRT(((2*ll + 1)*fac(ll - ABS(mm)))/(4*pi*fac(ll + ABS(mm)))) pre_fac = bond*sqrt_c1 dylm = pre_fac*dplm !WHY? IF (plm < 0.0_dp) THEN @@ -3375,29 +3375,29 @@ SUBROUTINE accumulate_qlm_over_neigbors(xij, rij, rcut, r1cut, & !WHY? dylm = pre_fac*dplm !WHY? ENDIF - re_qlm = re_qlm+pre_fac*plm*COS(mm*fi) - im_qlm = im_qlm+pre_fac*plm*SIN(mm*fi) + re_qlm = re_qlm + pre_fac*plm*COS(mm*fi) + im_qlm = im_qlm + pre_fac*plm*SIN(mm*fi) !WRITE(*,'(A8,2I4,F10.5)') " Qlm = ", mm, j, bond !WRITE(*,'(A8,2I4,2F10.5)') " Qlm = ", mm, j, re_qlm, im_qlm dcosTheta(:) = xij(:)*xij(3)/(rij**3) - dcosTheta(3) = dcosTheta(3)-1.0_dp/rij + dcosTheta(3) = dcosTheta(3) - 1.0_dp/rij ! use tangent half-angle formula to compute d_fi/d_xi ! http://math.stackexchange.com/questions/989877/continuous-differentiability-of-atan2 ! +/- sign changed because xij = xj - xi - dfi(1) = xij(2)/(xij(1)**2+xij(2)**2) - dfi(2) = -xij(1)/(xij(1)**2+xij(2)**2) + dfi(1) = xij(2)/(xij(1)**2 + xij(2)**2) + dfi(2) = -xij(1)/(xij(1)**2 + xij(2)**2) dfi(3) = 0.0_dp d_re_qlm_dxi(:) = d_re_qlm_dxi(:) & - +exp_fac*sqrt_c1*plm*COS(mm*fi)*xij(:)/rij & - +dylm*dcosTheta(:)*COS(mm*fi) & - +pre_fac*plm*mm*(-1.0_dp)*SIN(mm*fi)*dfi(:) + + exp_fac*sqrt_c1*plm*COS(mm*fi)*xij(:)/rij & + + dylm*dcosTheta(:)*COS(mm*fi) & + + pre_fac*plm*mm*(-1.0_dp)*SIN(mm*fi)*dfi(:) d_im_qlm_dxi(:) = d_im_qlm_dxi(:) & - +exp_fac*sqrt_c1*plm*SIN(mm*fi)*xij(:)/rij & - +dylm*dcosTheta(:)*SIN(mm*fi) & - +pre_fac*plm*mm*(+1.0_dp)*COS(mm*fi)*dfi(:) - d_nbond_dxi(:) = d_nbond_dxi(:)+exp_fac*xij(:)/rij + + exp_fac*sqrt_c1*plm*SIN(mm*fi)*xij(:)/rij & + + dylm*dcosTheta(:)*SIN(mm*fi) & + + pre_fac*plm*mm*(+1.0_dp)*COS(mm*fi)*dfi(:) + d_nbond_dxi(:) = d_nbond_dxi(:) + exp_fac*xij(:)/rij END SUBROUTINE accumulate_qlm_over_neigbors @@ -3482,22 +3482,22 @@ SUBROUTINE hydronium_shell_colvar(colvar, cell, subsys, particles) rji = pbc(rpj, rpi, cell) drji = SQRT(SUM(rji**2)) rrel = drji/roh - num = (1.0_dp-rrel**poh) - invden = 1.0_dp/(1.0_dp-rrel**qoh) - IF (ABS(1.0_dp-rrel) > 1.0E-6_dp) THEN - noh(ii) = noh(ii)+num*invden - fscalar = ((-poh*(rrel**(poh-1))*invden) & - +num*(invden)**2*qoh*(rrel**(qoh-1)))/(drji*roh) + num = (1.0_dp - rrel**poh) + invden = 1.0_dp/(1.0_dp - rrel**qoh) + IF (ABS(1.0_dp - rrel) > 1.0E-6_dp) THEN + noh(ii) = noh(ii) + num*invden + fscalar = ((-poh*(rrel**(poh - 1))*invden) & + + num*(invden)**2*qoh*(rrel**(qoh - 1)))/(drji*roh) dnoh(1:3, jj, ii) = rji(1:3)*fscalar ELSE !correct limit if rji --> roh - noh(ii) = noh(ii)+REAL(poh, dp)/REAL(qoh, dp) - fscalar = REAL(poh*(poh-qoh), dp)/(REAL(2*qoh, dp)*roh*drji) + noh(ii) = noh(ii) + REAL(poh, dp)/REAL(qoh, dp) + fscalar = REAL(poh*(poh - qoh), dp)/(REAL(2*qoh, dp)*roh*drji) dnoh(1:3, jj, ii) = rji(1:3)*fscalar ENDIF END DO - M(ii) = 1.0_dp-(1.0_dp-(noh(ii)/nh)**pm)/ & - (1.0_dp-(noh(ii)/nh)**qm) + M(ii) = 1.0_dp - (1.0_dp - (noh(ii)/nh)**pm)/ & + (1.0_dp - (noh(ii)/nh)**qm) ! Computing no ( ii ) DO jj = 1, n_oxygens @@ -3507,17 +3507,17 @@ SUBROUTINE hydronium_shell_colvar(colvar, cell, subsys, particles) rji = pbc(rpj, rpi, cell) drji = SQRT(SUM(rji**2)) rrel = drji/roo - num = (1.0_dp-rrel**poo) - invden = 1.0_dp/(1.0_dp-rrel**qoo) - IF (ABS(1.0_dp-rrel) > 1.0E-6_dp) THEN - noo(ii) = noo(ii)+num*invden - fscalar = ((-poo*(rrel**(poo-1))*invden) & - +num*(invden)**2*qoo*(rrel**(qoo-1)))/(drji*roo) + num = (1.0_dp - rrel**poo) + invden = 1.0_dp/(1.0_dp - rrel**qoo) + IF (ABS(1.0_dp - rrel) > 1.0E-6_dp) THEN + noo(ii) = noo(ii) + num*invden + fscalar = ((-poo*(rrel**(poo - 1))*invden) & + + num*(invden)**2*qoo*(rrel**(qoo - 1)))/(drji*roo) dnoo(1:3, jj, ii) = rji(1:3)*fscalar ELSE !correct limit if rji --> roo - noo(ii) = noo(ii)+REAL(poo, dp)/REAL(qoo, dp) - fscalar = REAL(poo*(poo-qoo), dp)/(REAL(2*qoo, dp)*roo*drji) + noo(ii) = noo(ii) + REAL(poo, dp)/REAL(qoo, dp) + fscalar = REAL(poo*(poo - qoo), dp)/(REAL(2*qoo, dp)*roo*drji) dnoo(1:3, jj, ii) = rji(1:3)*fscalar ENDIF END DO @@ -3527,27 +3527,27 @@ SUBROUTINE hydronium_shell_colvar(colvar, cell, subsys, particles) qtot = 0._dp DO ii = 1, n_oxygens qloc(ii) = EXP(lambda*M(ii)*noo(ii)) - qtot = qtot+qloc(ii) + qtot = qtot + qloc(ii) END DO ! compute forces DO ii = 1, n_oxygens ! Computing f_OH DO jj = 1, n_hydrogens - dM(1:3, jj, ii) = (pm*((noh(ii)/nh)**(pm-1))*dnoh(1:3, jj, ii))/nh/ & - (1.0_dp-(noh(ii)/nh)**qm)- & - (1.0_dp-(noh(ii)/nh)**pm)/ & - ((1.0_dp-(noh(ii)/nh)**qm)**2)* & - qm*dnoh(1:3, jj, ii)*(noh(ii)/nh)**(qm-1)/nh - - colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii)+qloc(ii)*dM(1:3, jj, ii)*noo(ii)/qtot - colvar%dsdr(1:3, n_oxygens+jj) = colvar%dsdr(1:3, n_oxygens+jj) & - -qloc(ii)*dM(1:3, jj, ii)*noo(ii)/qtot + dM(1:3, jj, ii) = (pm*((noh(ii)/nh)**(pm - 1))*dnoh(1:3, jj, ii))/nh/ & + (1.0_dp - (noh(ii)/nh)**qm) - & + (1.0_dp - (noh(ii)/nh)**pm)/ & + ((1.0_dp - (noh(ii)/nh)**qm)**2)* & + qm*dnoh(1:3, jj, ii)*(noh(ii)/nh)**(qm - 1)/nh + + colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) + qloc(ii)*dM(1:3, jj, ii)*noo(ii)/qtot + colvar%dsdr(1:3, n_oxygens + jj) = colvar%dsdr(1:3, n_oxygens + jj) & + - qloc(ii)*dM(1:3, jj, ii)*noo(ii)/qtot END DO ! Computing f_OO DO jj = 1, n_oxygens - colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii)+qloc(ii)*M(ii)*dnoo(1:3, jj, ii)/qtot + colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) + qloc(ii)*M(ii)*dnoo(1:3, jj, ii)/qtot colvar%dsdr(1:3, jj) = colvar%dsdr(1:3, jj) & - -qloc(ii)*M(ii)*dnoo(1:3, jj, ii)/qtot + - qloc(ii)*M(ii)*dnoo(1:3, jj, ii)/qtot END DO END DO @@ -3654,17 +3654,17 @@ SUBROUTINE hydronium_dist_colvar(colvar, cell, subsys, particles) rji = pbc(rpj, rpi, cell) drji = SQRT(SUM(rji**2)) rrel = drji/roh - num = (1.0_dp-rrel**poh) - invden = 1.0_dp/(1.0_dp-rrel**qoh) - IF (ABS(1.0_dp-rrel) > 1.0E-6_dp) THEN - noh(ii) = noh(ii)+num*invden - fscalar = ((-poh*(rrel**(poh-1))*invden) & - +num*(invden)**2*qoh*(rrel**(qoh-1)))/(drji*roh) + num = (1.0_dp - rrel**poh) + invden = 1.0_dp/(1.0_dp - rrel**qoh) + IF (ABS(1.0_dp - rrel) > 1.0E-6_dp) THEN + noh(ii) = noh(ii) + num*invden + fscalar = ((-poh*(rrel**(poh - 1))*invden) & + + num*(invden)**2*qoh*(rrel**(qoh - 1)))/(drji*roh) dnoh(1:3, jj, ii) = rji(1:3)*fscalar ELSE !correct limit if rji --> roh - noh(ii) = noh(ii)+REAL(poh, dp)/REAL(qoh, dp) - fscalar = REAL(poh*(poh-qoh), dp)/(REAL(2*qoh, dp)*roh*drji) + noh(ii) = noh(ii) + REAL(poh, dp)/REAL(qoh, dp) + fscalar = REAL(poh*(poh - qoh), dp)/(REAL(2*qoh, dp)*roh*drji) dnoh(1:3, jj, ii) = rji(1:3)*fscalar ENDIF END DO @@ -3672,27 +3672,27 @@ SUBROUTINE hydronium_dist_colvar(colvar, cell, subsys, particles) !*** Calculate M, dM, exp(lambda*M) and sum_[exp(lambda*M)] DO ii = 1, n_oxygens - num = 1.0_dp-(noh(ii)/nh)**pm - invden = 1.0_dp/(1.0_dp-(noh(ii)/nh)**qm) - M(ii) = 1.0_dp-num*invden - dM(ii) = (pm*(noh(ii)/nh)**(pm-1)*invden-qm*num*(invden**2)* & - (noh(ii)/nh)**(qm-1))/nh + num = 1.0_dp - (noh(ii)/nh)**pm + invden = 1.0_dp/(1.0_dp - (noh(ii)/nh)**qm) + M(ii) = 1.0_dp - num*invden + dM(ii) = (pm*(noh(ii)/nh)**(pm - 1)*invden - qm*num*(invden**2)* & + (noh(ii)/nh)**(qm - 1))/nh expfac_noh(ii) = EXP(lambda*noh(ii)) dexpfac_noh(ii) = lambda*expfac_noh(ii) - sum_expfac_noh = sum_expfac_noh+expfac_noh(ii) + sum_expfac_noh = sum_expfac_noh + expfac_noh(ii) END DO !*** Calculate F, dF, exp(lambda*F) and sum_[exp(lambda*F)] DO ii = 1, n_oxygens i = colvar%hydronium_dist_param%i_oxygens(ii) - num = 1.0_dp-(noh(ii)/nn)**pf - invden = 1.0_dp/(1.0_dp-(noh(ii)/nn)**qf) + num = 1.0_dp - (noh(ii)/nn)**pf + invden = 1.0_dp/(1.0_dp - (noh(ii)/nn)**qf) F(ii) = num*invden - dF(ii) = (-pf*(noh(ii)/nn)**(pf-1)*invden+qf*num*(invden**2)* & - (noh(ii)/nn)**(qf-1))/nn + dF(ii) = (-pf*(noh(ii)/nn)**(pf - 1)*invden + qf*num*(invden**2)* & + (noh(ii)/nn)**(qf - 1))/nn expfac_F(ii) = EXP(lambda*F(ii)) dexpfac_F(ii) = lambda*expfac_F(ii) - sum_expfac_F = sum_expfac_F+expfac_F(ii) + sum_expfac_F = sum_expfac_F + expfac_F(ii) END DO !*** Calculation numerator of rion @@ -3705,11 +3705,11 @@ SUBROUTINE hydronium_dist_colvar(colvar, cell, subsys, particles) rpk(:) = my_particles(k)%r(1:3) rki = pbc(rpk, rpi, cell) drki = SQRT(SUM(rki**2)) - expfac_F_rki(ii) = expfac_F_rki(ii)+drki*expfac_F(kk) + expfac_F_rki(ii) = expfac_F_rki(ii) + drki*expfac_F(kk) ddist_rki(1:3, kk, ii) = rki(1:3)/drki dexpfac_F_rki(kk, ii) = drki*dexpfac_F(kk) ENDDO - rion_num = rion_num+M(ii)*expfac_noh(ii)*expfac_F_rki(ii) + rion_num = rion_num + M(ii)*expfac_noh(ii)*expfac_F_rki(ii) ENDDO !*** Final H3O+/OH- distance @@ -3722,33 +3722,33 @@ SUBROUTINE hydronium_dist_colvar(colvar, cell, subsys, particles) DO ii = 1, n_oxygens DO jj = 1, n_hydrogens colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) & - +dM(ii)*dnoh(1:3, jj, ii)*expfac_noh(ii) & + + dM(ii)*dnoh(1:3, jj, ii)*expfac_noh(ii) & *expfac_F_rki(ii)/rion_den - colvar%dsdr(1:3, offsetH+jj) = colvar%dsdr(1:3, offsetH+jj) & - -dM(ii)*dnoh(1:3, jj, ii)*expfac_noh(ii) & - *expfac_F_rki(ii)/rion_den + colvar%dsdr(1:3, offsetH + jj) = colvar%dsdr(1:3, offsetH + jj) & + - dM(ii)*dnoh(1:3, jj, ii)*expfac_noh(ii) & + *expfac_F_rki(ii)/rion_den colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) & - +M(ii)*dexpfac_noh(ii)*dnoh(1:3, jj, ii) & + + M(ii)*dexpfac_noh(ii)*dnoh(1:3, jj, ii) & *expfac_F_rki(ii)/rion_den - colvar%dsdr(1:3, offsetH+jj) = colvar%dsdr(1:3, offsetH+jj) & - -M(ii)*dexpfac_noh(ii)*dnoh(1:3, jj, ii) & - *expfac_F_rki(ii)/rion_den + colvar%dsdr(1:3, offsetH + jj) = colvar%dsdr(1:3, offsetH + jj) & + - M(ii)*dexpfac_noh(ii)*dnoh(1:3, jj, ii) & + *expfac_F_rki(ii)/rion_den ENDDO DO kk = 1, n_oxygens IF (ii == kk) CYCLE colvar%dsdr(1:3, kk) = colvar%dsdr(1:3, kk) & - -M(ii)*expfac_noh(ii)*ddist_rki(1:3, kk, ii) & + - M(ii)*expfac_noh(ii)*ddist_rki(1:3, kk, ii) & *expfac_F(kk)/rion_den colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) & - +M(ii)*expfac_noh(ii)*ddist_rki(1:3, kk, ii) & + + M(ii)*expfac_noh(ii)*ddist_rki(1:3, kk, ii) & *expfac_F(kk)/rion_den DO jj = 1, n_hydrogens colvar%dsdr(1:3, kk) = colvar%dsdr(1:3, kk) & - +M(ii)*expfac_noh(ii)*dexpfac_F_rki(kk, ii) & + + M(ii)*expfac_noh(ii)*dexpfac_F_rki(kk, ii) & *dF(kk)*dnoh(1:3, jj, kk)/rion_den - colvar%dsdr(1:3, offsetH+jj) = colvar%dsdr(1:3, offsetH+jj) & - -M(ii)*expfac_noh(ii)*dexpfac_F_rki(kk, ii) & - *dF(kk)*dnoh(1:3, jj, kk)/rion_den + colvar%dsdr(1:3, offsetH + jj) = colvar%dsdr(1:3, offsetH + jj) & + - M(ii)*expfac_noh(ii)*dexpfac_F_rki(kk, ii) & + *dF(kk)*dnoh(1:3, jj, kk)/rion_den ENDDO ENDDO ENDDO @@ -3756,17 +3756,17 @@ SUBROUTINE hydronium_dist_colvar(colvar, cell, subsys, particles) DO ii = 1, n_oxygens DO jj = 1, n_hydrogens colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) & - -rion_num*sum_expfac_F*dexpfac_noh(ii) & + - rion_num*sum_expfac_F*dexpfac_noh(ii) & *dnoh(1:3, jj, ii)/(rion_den**2) - colvar%dsdr(1:3, offsetH+jj) = colvar%dsdr(1:3, offsetH+jj) & - +rion_num*sum_expfac_F*dexpfac_noh(ii) & - *dnoh(1:3, jj, ii)/(rion_den**2) + colvar%dsdr(1:3, offsetH + jj) = colvar%dsdr(1:3, offsetH + jj) & + + rion_num*sum_expfac_F*dexpfac_noh(ii) & + *dnoh(1:3, jj, ii)/(rion_den**2) colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) & - -rion_num*sum_expfac_noh*dexpfac_F(ii)*dF(ii) & + - rion_num*sum_expfac_noh*dexpfac_F(ii)*dF(ii) & *dnoh(1:3, jj, ii)/(rion_den**2) - colvar%dsdr(1:3, offsetH+jj) = colvar%dsdr(1:3, offsetH+jj) & - +rion_num*sum_expfac_noh*dexpfac_F(ii)*dF(ii) & - *dnoh(1:3, jj, ii)/(rion_den**2) + colvar%dsdr(1:3, offsetH + jj) = colvar%dsdr(1:3, offsetH + jj) & + + rion_num*sum_expfac_noh*dexpfac_F(ii)*dF(ii) & + *dnoh(1:3, jj, ii)/(rion_den**2) ENDDO ENDDO @@ -3861,23 +3861,23 @@ SUBROUTINE acid_hyd_dist_colvar(colvar, cell, subsys, particles) rji = pbc(rpj, rpi, cell) drji = SQRT(SUM(rji**2)) rrel = drji/rwoh - num = 1.0_dp-rrel**pwoh - invden = 1.0_dp/(1.0_dp-rrel**qwoh) - IF (ABS(1.0_dp-rrel) > 1.0E-6_dp) THEN - nwoh(ii) = nwoh(ii)+num*invden - fscalar = (-pwoh*(rrel**(pwoh-1))*invden & - +num*(invden**2)*qwoh*(rrel**(qwoh-1)))/(drji*rwoh) + num = 1.0_dp - rrel**pwoh + invden = 1.0_dp/(1.0_dp - rrel**qwoh) + IF (ABS(1.0_dp - rrel) > 1.0E-6_dp) THEN + nwoh(ii) = nwoh(ii) + num*invden + fscalar = (-pwoh*(rrel**(pwoh - 1))*invden & + + num*(invden**2)*qwoh*(rrel**(qwoh - 1)))/(drji*rwoh) dnwoh(1:3, jj, ii) = rji(1:3)*fscalar ELSE !correct limit if rji --> rwoh - nwoh(ii) = nwoh(ii)+REAL(pwoh, dp)/REAL(qwoh, dp) - fscalar = REAL(pwoh*(pwoh-qwoh), dp)/(REAL(2*qwoh, dp)*rwoh*drji) + nwoh(ii) = nwoh(ii) + REAL(pwoh, dp)/REAL(qwoh, dp) + fscalar = REAL(pwoh*(pwoh - qwoh), dp)/(REAL(2*qwoh, dp)*rwoh*drji) dnwoh(1:3, jj, ii) = rji(1:3)*fscalar ENDIF ENDDO expfac(ii) = EXP(lambda*nwoh(ii)) dexpfac(ii) = lambda*expfac(ii) - rion_den = rion_den+expfac(ii) + rion_den = rion_den + expfac(ii) ENDDO ! Calculate nominator of rion @@ -3889,7 +3889,7 @@ SUBROUTINE acid_hyd_dist_colvar(colvar, cell, subsys, particles) rpi(:) = my_particles(i)%r(1:3) rik = pbc(rpi, rpk, cell) drik = SQRT(SUM(rik**2)) - rion_num = rion_num+drik*expfac(ii) + rion_num = rion_num + drik*expfac(ii) ddist_rik(1:3, ii, kk) = rik(1:3)/drik dexpfac_rik(ii, kk) = drik*dexpfac(ii) ENDDO @@ -3905,23 +3905,23 @@ SUBROUTINE acid_hyd_dist_colvar(colvar, cell, subsys, particles) rjk = pbc(rpj, rpk, cell) drjk = SQRT(SUM(rjk**2)) rrel = drjk/raoh - num = 1.0_dp-rrel**paoh - invden = 1.0_dp/(1.0_dp-rrel**qaoh) - IF (ABS(1.0_dp-rrel) > 1.0E-6_dp) THEN - naoh = naoh+num*invden - fscalar = (-paoh*(rrel**(paoh-1))*invden & - +num*(invden**2)*qaoh*(rrel**(qaoh-1)))/(drjk*raoh) + num = 1.0_dp - rrel**paoh + invden = 1.0_dp/(1.0_dp - rrel**qaoh) + IF (ABS(1.0_dp - rrel) > 1.0E-6_dp) THEN + naoh = naoh + num*invden + fscalar = (-paoh*(rrel**(paoh - 1))*invden & + + num*(invden**2)*qaoh*(rrel**(qaoh - 1)))/(drjk*raoh) dnaoh(1:3, jj, kk) = rjk(1:3)*fscalar ELSE !correct limit if rjk --> raoh - naoh = naoh+REAL(paoh, dp)/REAL(qaoh, dp) - fscalar = REAL(paoh*(paoh-qaoh), dp)/(REAL(2*qaoh, dp)*raoh*drjk) + naoh = naoh + REAL(paoh, dp)/REAL(qaoh, dp) + fscalar = REAL(paoh*(paoh - qaoh), dp)/(REAL(2*qaoh, dp)*raoh*drjk) dnaoh(1:3, jj, kk) = rjk(1:3)*fscalar ENDIF ENDDO ENDDO - num_cut = 1.0_dp-(naoh/nc)**pcut - invden_cut = 1.0_dp/(1.0_dp-(naoh/nc)**qcut) + num_cut = 1.0_dp - (naoh/nc)**pcut + invden_cut = 1.0_dp/(1.0_dp - (naoh/nc)**qcut) fcut = num_cut*invden_cut !Final distance acid - hydronium @@ -3930,16 +3930,16 @@ SUBROUTINE acid_hyd_dist_colvar(colvar, cell, subsys, particles) colvar%ss = rion !Derivatives of fcut - dfcut = ((-pcut*(naoh/nc)**(pcut-1)*invden_cut) & - +num_cut*(invden_cut**2)*qcut*(naoh/nc)**(qcut-1))/nc + dfcut = ((-pcut*(naoh/nc)**(pcut - 1)*invden_cut) & + + num_cut*(invden_cut**2)*qcut*(naoh/nc)**(qcut - 1))/nc offsetO = n_oxygens_water - offsetH = n_oxygens_water+n_oxygens_acid + offsetH = n_oxygens_water + n_oxygens_acid DO kk = 1, n_oxygens_acid DO jj = 1, n_hydrogens - colvar%dsdr(1:3, offsetO+kk) = colvar%dsdr(1:3, offsetO+kk) & - +dfcut*dnaoh(1:3, jj, kk)*fbrace - colvar%dsdr(1:3, offsetH+jj) = colvar%dsdr(1:3, offsetH+jj) & - -dfcut*dnaoh(1:3, jj, kk)*fbrace + colvar%dsdr(1:3, offsetO + kk) = colvar%dsdr(1:3, offsetO + kk) & + + dfcut*dnaoh(1:3, jj, kk)*fbrace + colvar%dsdr(1:3, offsetH + jj) = colvar%dsdr(1:3, offsetH + jj) & + - dfcut*dnaoh(1:3, jj, kk)*fbrace ENDDO ENDDO @@ -3947,15 +3947,15 @@ SUBROUTINE acid_hyd_dist_colvar(colvar, cell, subsys, particles) !***nominator DO kk = 1, n_oxygens_acid DO ii = 1, n_oxygens_water - colvar%dsdr(1:3, offsetO+kk) = colvar%dsdr(1:3, offsetO+kk) & - +fcut*ddist_rik(1:3, ii, kk)*expfac(ii)/rion_den/2.0_dp + colvar%dsdr(1:3, offsetO + kk) = colvar%dsdr(1:3, offsetO + kk) & + + fcut*ddist_rik(1:3, ii, kk)*expfac(ii)/rion_den/2.0_dp colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) & - -fcut*ddist_rik(1:3, ii, kk)*expfac(ii)/rion_den/2.0_dp + - fcut*ddist_rik(1:3, ii, kk)*expfac(ii)/rion_den/2.0_dp DO jj = 1, n_hydrogens colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) & - +fcut*dexpfac_rik(ii, kk)*dnwoh(1:3, jj, ii)/rion_den/2.0_dp - colvar%dsdr(1:3, offsetH+jj) = colvar%dsdr(1:3, offsetH+jj) & - -fcut*dexpfac_rik(ii, kk)*dnwoh(1:3, jj, ii)/rion_den/2.0_dp + + fcut*dexpfac_rik(ii, kk)*dnwoh(1:3, jj, ii)/rion_den/2.0_dp + colvar%dsdr(1:3, offsetH + jj) = colvar%dsdr(1:3, offsetH + jj) & + - fcut*dexpfac_rik(ii, kk)*dnwoh(1:3, jj, ii)/rion_den/2.0_dp ENDDO ENDDO ENDDO @@ -3963,9 +3963,9 @@ SUBROUTINE acid_hyd_dist_colvar(colvar, cell, subsys, particles) DO ii = 1, n_oxygens_water DO jj = 1, n_hydrogens colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) & - -fcut*rion_num*dexpfac(ii)*dnwoh(1:3, jj, ii)/2.0_dp/(rion_den**2) - colvar%dsdr(1:3, offsetH+jj) = colvar%dsdr(1:3, offsetH+jj) & - +fcut*rion_num*dexpfac(ii)*dnwoh(1:3, jj, ii)/2.0_dp/(rion_den**2) + - fcut*rion_num*dexpfac(ii)*dnwoh(1:3, jj, ii)/2.0_dp/(rion_den**2) + colvar%dsdr(1:3, offsetH + jj) = colvar%dsdr(1:3, offsetH + jj) & + + fcut*rion_num*dexpfac(ii)*dnwoh(1:3, jj, ii)/2.0_dp/(rion_den**2) ENDDO ENDDO @@ -4029,7 +4029,7 @@ SUBROUTINE acid_hyd_shell_colvar(colvar, cell, subsys, particles) ALLOCATE (M(n_oxygens_water)) ALLOCATE (dM(n_oxygens_water)) ALLOCATE (noo(n_oxygens_water)) - ALLOCATE (dnoo(3, n_oxygens_water+n_oxygens_acid, n_oxygens_water)) + ALLOCATE (dnoo(3, n_oxygens_water + n_oxygens_acid, n_oxygens_water)) ALLOCATE (qloc(n_oxygens_water)) nwoh(:) = 0._dp naoh = 0._dp @@ -4060,17 +4060,17 @@ SUBROUTINE acid_hyd_shell_colvar(colvar, cell, subsys, particles) rji = pbc(rpj, rpi, cell) drji = SQRT(SUM(rji**2)) rrel = drji/rwoh - num = 1.0_dp-rrel**pwoh - invden = 1.0_dp/(1.0_dp-rrel**qwoh) - IF (ABS(1.0_dp-rrel) > 1.0E-6_dp) THEN - nwoh(ii) = nwoh(ii)+num*invden - fscalar = (-pwoh*(rrel**(pwoh-1))*invden & - +num*(invden**2)*qwoh*(rrel**(qwoh-1)))/(drji*rwoh) + num = 1.0_dp - rrel**pwoh + invden = 1.0_dp/(1.0_dp - rrel**qwoh) + IF (ABS(1.0_dp - rrel) > 1.0E-6_dp) THEN + nwoh(ii) = nwoh(ii) + num*invden + fscalar = (-pwoh*(rrel**(pwoh - 1))*invden & + + num*(invden**2)*qwoh*(rrel**(qwoh - 1)))/(drji*rwoh) dnwoh(1:3, jj, ii) = rji(1:3)*fscalar ELSE !correct limit if rji --> rwoh - nwoh(ii) = nwoh(ii)+REAL(pwoh, dp)/REAL(qwoh, dp) - fscalar = REAL(pwoh*(pwoh-qwoh), dp)/(REAL(2*qwoh, dp)*rwoh*drji) + nwoh(ii) = nwoh(ii) + REAL(pwoh, dp)/REAL(qwoh, dp) + fscalar = REAL(pwoh*(pwoh - qwoh), dp)/(REAL(2*qwoh, dp)*rwoh*drji) dnwoh(1:3, jj, ii) = rji(1:3)*fscalar ENDIF ENDDO @@ -4078,41 +4078,41 @@ SUBROUTINE acid_hyd_shell_colvar(colvar, cell, subsys, particles) ! calculate M function DO ii = 1, n_oxygens_water - num = 1.0_dp-(nwoh(ii)/nh)**pm - invden = 1.0_dp/(1.0_dp-(nwoh(ii)/nh)**qm) - M(ii) = 1.0_dp-num*invden - dM(ii) = (pm*(nwoh(ii)/nh)**(pm-1)*invden-qm*num*(invden**2)* & - (nwoh(ii)/nh)**(qm-1))/nh + num = 1.0_dp - (nwoh(ii)/nh)**pm + invden = 1.0_dp/(1.0_dp - (nwoh(ii)/nh)**qm) + M(ii) = 1.0_dp - num*invden + dM(ii) = (pm*(nwoh(ii)/nh)**(pm - 1)*invden - qm*num*(invden**2)* & + (nwoh(ii)/nh)**(qm - 1))/nh ENDDO ! Computing noo(i) DO ii = 1, n_oxygens_water i = colvar%acid_hyd_shell_param%i_oxygens_water(ii) rpi(:) = my_particles(i)%r(1:3) - DO kk = 1, n_oxygens_water+n_oxygens_acid + DO kk = 1, n_oxygens_water + n_oxygens_acid IF (ii == kk) CYCLE IF (kk <= n_oxygens_water) THEN k = colvar%acid_hyd_shell_param%i_oxygens_water(kk) rpk(:) = my_particles(k)%r(1:3) ELSE - tt = kk-n_oxygens_water + tt = kk - n_oxygens_water k = colvar%acid_hyd_shell_param%i_oxygens_acid(tt) rpk(:) = my_particles(k)%r(1:3) ENDIF rki = pbc(rpk, rpi, cell) drki = SQRT(SUM(rki**2)) rrel = drki/roo - num = 1.0_dp-rrel**poo - invden = 1.0_dp/(1.0_dp-rrel**qoo) - IF (ABS(1.0_dp-rrel) > 1.0E-6_dp) THEN - noo(ii) = noo(ii)+num*invden - fscalar = (-poo*(rrel**(poo-1))*invden & - +num*(invden**2)*qoo*(rrel**(qoo-1)))/(drki*roo) + num = 1.0_dp - rrel**poo + invden = 1.0_dp/(1.0_dp - rrel**qoo) + IF (ABS(1.0_dp - rrel) > 1.0E-6_dp) THEN + noo(ii) = noo(ii) + num*invden + fscalar = (-poo*(rrel**(poo - 1))*invden & + + num*(invden**2)*qoo*(rrel**(qoo - 1)))/(drki*roo) dnoo(1:3, kk, ii) = rki(1:3)*fscalar ELSE !correct limit if rki --> roo - noo(ii) = noo(ii)+REAL(poo, dp)/REAL(qoo, dp) - fscalar = REAL(poo*(poo-qoo), dp)/(REAL(2*qoo, dp)*roo*drki) + noo(ii) = noo(ii) + REAL(poo, dp)/REAL(qoo, dp) + fscalar = REAL(poo*(poo - qoo), dp)/(REAL(2*qoo, dp)*roo*drki) dnoo(1:3, kk, ii) = rki(1:3)*fscalar ENDIF ENDDO @@ -4128,44 +4128,44 @@ SUBROUTINE acid_hyd_shell_colvar(colvar, cell, subsys, particles) rjk = pbc(rpj, rpk, cell) drjk = SQRT(SUM(rjk**2)) rrel = drjk/raoh - num = 1.0_dp-rrel**paoh - invden = 1.0_dp/(1.0_dp-rrel**qaoh) - IF (ABS(1.0_dp-rrel) > 1.0E-6_dp) THEN - naoh = naoh+num*invden - fscalar = (-paoh*(rrel**(paoh-1))*invden & - +num*(invden**2)*qaoh*(rrel**(qaoh-1)))/(drjk*raoh) + num = 1.0_dp - rrel**paoh + invden = 1.0_dp/(1.0_dp - rrel**qaoh) + IF (ABS(1.0_dp - rrel) > 1.0E-6_dp) THEN + naoh = naoh + num*invden + fscalar = (-paoh*(rrel**(paoh - 1))*invden & + + num*(invden**2)*qaoh*(rrel**(qaoh - 1)))/(drjk*raoh) dnaoh(1:3, jj, kk) = rjk(1:3)*fscalar ELSE !correct limit if rjk --> raoh - naoh = naoh+REAL(paoh, dp)/REAL(qaoh, dp) - fscalar = REAL(paoh*(paoh-qaoh), dp)/(REAL(2*qaoh, dp)*raoh*drjk) + naoh = naoh + REAL(paoh, dp)/REAL(qaoh, dp) + fscalar = REAL(paoh*(paoh - qaoh), dp)/(REAL(2*qaoh, dp)*raoh*drjk) dnaoh(1:3, jj, kk) = rjk(1:3)*fscalar ENDIF ENDDO ENDDO - num_cut = 1.0_dp-(naoh/nc)**pcut - invden_cut = 1.0_dp/(1.0_dp-(naoh/nc)**qcut) + num_cut = 1.0_dp - (naoh/nc)**pcut + invden_cut = 1.0_dp/(1.0_dp - (naoh/nc)**qcut) fcut = num_cut*invden_cut ! Final value: number of oxygens in 1st shell of hydronium DO ii = 1, n_oxygens_water qloc(ii) = EXP(lambda*M(ii)*noo(ii)) - qtot = qtot+qloc(ii) + qtot = qtot + qloc(ii) ENDDO qsol = LOG(qtot)/lambda colvar%ss = fcut*qsol ! Derivatives of fcut - dfcut = ((-pcut*(naoh/nc)**(pcut-1)*invden_cut) & - +num_cut*(invden_cut**2)*qcut*(naoh/nc)**(qcut-1))/nc + dfcut = ((-pcut*(naoh/nc)**(pcut - 1)*invden_cut) & + + num_cut*(invden_cut**2)*qcut*(naoh/nc)**(qcut - 1))/nc offsetO = n_oxygens_water - offsetH = n_oxygens_water+n_oxygens_acid + offsetH = n_oxygens_water + n_oxygens_acid DO kk = 1, n_oxygens_acid DO jj = 1, n_hydrogens - colvar%dsdr(1:3, offsetO+kk) = colvar%dsdr(1:3, offsetO+kk) & - +dfcut*dnaoh(1:3, jj, kk)*qsol - colvar%dsdr(1:3, offsetH+jj) = colvar%dsdr(1:3, offsetH+jj) & - -dfcut*dnaoh(1:3, jj, kk)*qsol + colvar%dsdr(1:3, offsetO + kk) = colvar%dsdr(1:3, offsetO + kk) & + + dfcut*dnaoh(1:3, jj, kk)*qsol + colvar%dsdr(1:3, offsetH + jj) = colvar%dsdr(1:3, offsetH + jj) & + - dfcut*dnaoh(1:3, jj, kk)*qsol ENDDO ENDDO @@ -4175,18 +4175,18 @@ SUBROUTINE acid_hyd_shell_colvar(colvar, cell, subsys, particles) fscalar = fcut*qloc(ii)*dM(ii)*noo(ii)/qtot DO jj = 1, n_hydrogens colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) & - +fscalar*dnwoh(1:3, jj, ii) - colvar%dsdr(1:3, offsetH+jj) = colvar%dsdr(1:3, offsetH+jj) & - -fscalar*dnwoh(1:3, jj, ii) + + fscalar*dnwoh(1:3, jj, ii) + colvar%dsdr(1:3, offsetH + jj) = colvar%dsdr(1:3, offsetH + jj) & + - fscalar*dnwoh(1:3, jj, ii) ENDDO ENDDO !*** noo derivatives DO ii = 1, n_oxygens_water fscalar = fcut*qloc(ii)*M(ii)/qtot - DO kk = 1, n_oxygens_water+n_oxygens_acid + DO kk = 1, n_oxygens_water + n_oxygens_acid IF (ii == kk) CYCLE - colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii)+fscalar*dnoo(1:3, kk, ii) - colvar%dsdr(1:3, kk) = colvar%dsdr(1:3, kk)-fscalar*dnoo(1:3, kk, ii) + colvar%dsdr(1:3, ii) = colvar%dsdr(1:3, ii) + fscalar*dnoo(1:3, kk, ii) + colvar%dsdr(1:3, kk) = colvar%dsdr(1:3, kk) - fscalar*dnoo(1:3, kk, ii) ENDDO ENDDO @@ -4253,27 +4253,27 @@ SUBROUTINE coord_colvar(colvar, cell, subsys, particles) CALL get_coordinates(colvar, j, xpj, my_particles) ! define coordination of atom A with itself to be 0. also fixes rij==0 for the force calculation IF (i .EQ. j) CYCLE - ss = MATMUL(cell%h_inv, xpi(:)-xpj(:)) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, xpi(:) - xpj(:)) + ss = ss - NINT(ss) xij = MATMUL(cell%hmat, ss) - rij = SQRT(xij(1)**2+xij(2)**2+xij(3)**2) + rij = SQRT(xij(1)**2 + xij(2)**2 + xij(3)**2) IF (rij < 1.0e-8_dp) CYCLE rdist_ij = rij/r_0_a - IF (ABS(1.0_dp-rdist_ij) > EPSILON(0.0_dp)*1.0E+4_dp) THEN - num_ij = (1.0_dp-rdist_ij**p_a) - invden_ij = 1.0_dp/(1.0_dp-rdist_ij**q_a) + IF (ABS(1.0_dp - rdist_ij) > EPSILON(0.0_dp)*1.0E+4_dp) THEN + num_ij = (1.0_dp - rdist_ij**p_a) + invden_ij = 1.0_dp/(1.0_dp - rdist_ij**q_a) func_ij = num_ij*invden_ij IF (rij < 1.0E-8_dp) THEN ! provide the correct limit of the derivative dfunc_ij = 0.0_dp ELSE - dfunc_ij = (-p_a*rdist_ij**(p_a-1)*invden_ij & - +num_ij*(invden_ij)**2*q_a*rdist_ij**(q_a-1))/(rij*r_0_a) + dfunc_ij = (-p_a*rdist_ij**(p_a - 1)*invden_ij & + + num_ij*(invden_ij)**2*q_a*rdist_ij**(q_a - 1))/(rij*r_0_a) END IF ELSE ! Provide the correct limit for function value and derivative func_ij = REAL(p_a, KIND=dp)/REAL(q_a, KIND=dp) - dfunc_ij = REAL(p_a, KIND=dp)*REAL((-q_a+p_a), KIND=dp)/(REAL(2*q_a, KIND=dp)*r_0_a) + dfunc_ij = REAL(p_a, KIND=dp)*REAL((-q_a + p_a), KIND=dp)/(REAL(2*q_a, KIND=dp)*r_0_a) END IF IF (n_atoms_to_b /= 0) THEN func_k = 0.0_dp @@ -4281,42 +4281,42 @@ SUBROUTINE coord_colvar(colvar, cell, subsys, particles) k = colvar%coord_param%i_at_to_b(kk) IF (k .EQ. j) CYCLE CALL get_coordinates(colvar, k, xpk, my_particles) - ss = MATMUL(cell%h_inv, xpj(:)-xpk(:)) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, xpj(:) - xpk(:)) + ss = ss - NINT(ss) xjk = MATMUL(cell%hmat, ss) - rjk = SQRT(xjk(1)**2+xjk(2)**2+xjk(3)**2) + rjk = SQRT(xjk(1)**2 + xjk(2)**2 + xjk(3)**2) IF (rjk < 1.0e-8_dp) CYCLE rdist_jk = rjk/r_0_b - IF (ABS(1.0_dp-rdist_jk) > EPSILON(0.0_dp)*1.0E+4_dp) THEN - num_jk = (1.0_dp-rdist_jk**p_b) - invden_jk = 1.0_dp/(1.0_dp-rdist_jk**q_b) + IF (ABS(1.0_dp - rdist_jk) > EPSILON(0.0_dp)*1.0E+4_dp) THEN + num_jk = (1.0_dp - rdist_jk**p_b) + invden_jk = 1.0_dp/(1.0_dp - rdist_jk**q_b) func_jk = num_jk*invden_jk IF (rjk < 1.0E-8_dp) THEN ! provide the correct limit of the derivative dfunc_jk = 0.0_dp ELSE - dfunc_jk = (-p_b*rdist_jk**(p_b-1)*invden_jk & - +num_jk*(invden_jk)**2*q_b*rdist_jk**(q_b-1))/(rjk*r_0_b) + dfunc_jk = (-p_b*rdist_jk**(p_b - 1)*invden_jk & + + num_jk*(invden_jk)**2*q_b*rdist_jk**(q_b - 1))/(rjk*r_0_b) END IF ELSE ! Provide the correct limit for function value and derivative func_jk = REAL(p_b, KIND=dp)/REAL(q_b, KIND=dp) - dfunc_jk = REAL(p_b, KIND=dp)*REAL((-q_b+p_b), KIND=dp)/(REAL(2*q_b, KIND=dp)*r_0_b) + dfunc_jk = REAL(p_b, KIND=dp)*REAL((-q_b + p_b), KIND=dp)/(REAL(2*q_b, KIND=dp)*r_0_b) ENDIF - func_k = func_k+func_jk + func_k = func_k + func_jk ftmp_k = -func_ij*dfunc_jk*xjk - CALL put_derivative(colvar, n_atoms_from+n_atoms_to_a+kk, ftmp_k) + CALL put_derivative(colvar, n_atoms_from + n_atoms_to_a + kk, ftmp_k) - ftmp_j = -dfunc_ij*xij*func_jk+func_ij*dfunc_jk*xjk - CALL put_derivative(colvar, n_atoms_from+jj, ftmp_j) + ftmp_j = -dfunc_ij*xij*func_jk + func_ij*dfunc_jk*xjk + CALL put_derivative(colvar, n_atoms_from + jj, ftmp_j) END DO ELSE func_k = 1.0_dp dfunc_jk = 0.0_dp ftmp_j = -dfunc_ij*xij - CALL put_derivative(colvar, n_atoms_from+jj, ftmp_j) + CALL put_derivative(colvar, n_atoms_from + jj, ftmp_j) END IF - ncoord = ncoord+func_ij*func_k + ncoord = ncoord + func_ij*func_k ftmp_i = dfunc_ij*xij*func_k CALL put_derivative(colvar, ii, ftmp_i) ENDDO @@ -4392,29 +4392,29 @@ SUBROUTINE mindist_colvar(colvar, cell, subsys, particles) jj = colvar%mindist_param%i_coord_to(j) rpj = my_particles(jj)%r(1:3) rij = pbc(rpj, rpi, cell) - r12 = SQRT(rij(1)*rij(1)+rij(2)*rij(2)+rij(3)*rij(3)) + r12 = SQRT(rij(1)*rij(1) + rij(2)*rij(2) + rij(3)*rij(3)) rfact = r12/r_cut - num_n = 1.0_dp-rfact**p - den_n = 1.0_dp-rfact**q + num_n = 1.0_dp - rfact**p + den_n = 1.0_dp - rfact**q inv_den_n = 1.0_dp/den_n IF (ABS(inv_den_n) < 1.e-10_dp) THEN inv_den_n = 1.e-10_dp num_n = ABS(num_n) END IF - fscalar = (-p*rfact**(p-1)+num_n*q*rfact**(q-1)*inv_den_n)*inv_den_n/(r_cut*r12) + fscalar = (-p*rfact**(p - 1) + num_n*q*rfact**(q - 1)*inv_den_n)*inv_den_n/(r_cut*r12) dnLcoord(1, i, j) = rij(1)*fscalar dnLcoord(2, i, j) = rij(2)*fscalar dnLcoord(3, i, j) = rij(3)*fscalar - nLcoord(i) = nLcoord(i)+num_n*inv_den_n + nLcoord(i) = nLcoord(i) + num_n*inv_den_n END DO expnL(i) = EXP(lambda*nLcoord(i)) !dbg ! write(*,*) ii,nLcoord(i),expnL(i) !dbg - den_Q = den_Q+expnL(i) + den_Q = den_Q + expnL(i) END DO inv_den_Q = 1.0_dp/den_Q @@ -4430,14 +4430,14 @@ SUBROUTINE mindist_colvar(colvar, cell, subsys, particles) jj = colvar%mindist_param%i_coord_from(j) rpj = my_particles(jj)%r(1:3) rij = pbc(rpj, rpi, cell) - r12 = SQRT(rij(1)*rij(1)+rij(2)*rij(2)+rij(3)*rij(3)) + r12 = SQRT(rij(1)*rij(1) + rij(2)*rij(2) + rij(3)*rij(3)) !dbg ! write(*,*) ii,jj,rpi(1:3),rpj(1:3),rij(1:3),r12 !dbg - num_Q = num_Q+r12*expnL(j) + num_Q = num_Q + r12*expnL(j) - sum_rij(j) = sum_rij(j)+r12 + sum_rij(j) = sum_rij(j) + r12 dqfunc_dr(1, i, j) = expnL(j)*rij(1)/r12 dqfunc_dr(2, i, j) = expnL(j)*rij(2)/r12 dqfunc_dr(3, i, j) = expnL(j)*rij(3)/r12 @@ -4456,7 +4456,7 @@ SUBROUTINE mindist_colvar(colvar, cell, subsys, particles) !dbg DO i = 1, n_coord_from - dqfunc_dnL(i) = lambda*expnL(i)*inv_den_Q*(sum_rij(i)-num_Q*inv_den_Q) + dqfunc_dnL(i) = lambda*expnL(i)*inv_den_Q*(sum_rij(i) - num_Q*inv_den_Q) END DO !Compute Forces @@ -4467,7 +4467,7 @@ SUBROUTINE mindist_colvar(colvar, cell, subsys, particles) ftemp_i(3) = dqfunc_dr(3, i, j) CALL put_derivative(colvar, i, ftemp_i) - CALL put_derivative(colvar, j+n_dist_from, -ftemp_i) + CALL put_derivative(colvar, j + n_dist_from, -ftemp_i) END DO END DO @@ -4477,8 +4477,8 @@ SUBROUTINE mindist_colvar(colvar, cell, subsys, particles) ftemp_i(2) = dqfunc_dnL(i)*dnLcoord(2, i, j) ftemp_i(3) = dqfunc_dnL(i)*dnLcoord(3, i, j) - CALL put_derivative(colvar, i+n_dist_from, ftemp_i) - CALL put_derivative(colvar, j+n_dist_from+n_coord_from, -ftemp_i) + CALL put_derivative(colvar, i + n_dist_from, ftemp_i) + CALL put_derivative(colvar, j + n_dist_from + n_coord_from, -ftemp_i) END DO END DO @@ -4540,14 +4540,14 @@ SUBROUTINE combine_colvar(colvar, cell, subsys, particles) ! Evaluate the combination of the COLVARs CALL initf(1) - ndim = SIZE(colvar%combine_cvs_param%c_parameters)+ & + ndim = SIZE(colvar%combine_cvs_param%c_parameters) + & SIZE(colvar%combine_cvs_param%variables) ALLOCATE (my_par(ndim)) my_par(1:SIZE(colvar%combine_cvs_param%variables)) = colvar%combine_cvs_param%variables - my_par(SIZE(colvar%combine_cvs_param%variables)+1:) = colvar%combine_cvs_param%c_parameters + my_par(SIZE(colvar%combine_cvs_param%variables) + 1:) = colvar%combine_cvs_param%c_parameters ALLOCATE (my_val(ndim)) my_val(1:SIZE(colvar%combine_cvs_param%variables)) = ss_vals - my_val(SIZE(colvar%combine_cvs_param%variables)+1:) = colvar%combine_cvs_param%v_parameters + my_val(SIZE(colvar%combine_cvs_param%variables) + 1:) = colvar%combine_cvs_param%v_parameters CALL parsef(1, TRIM(colvar%combine_cvs_param%function), my_par) colvar%ss = evalf(1, my_val) DO i = 1, ncolv @@ -4572,7 +4572,7 @@ SUBROUTINE combine_colvar(colvar, cell, subsys, particles) ii = 0 DO i = 1, ncolv DO j = 1, colvar%combine_cvs_param%colvar_p(i)%colvar%n_atom_s - ii = ii+1 + ii = ii + 1 fi(:, ii) = colvar%combine_cvs_param%colvar_p(i)%colvar%dsdr(:, j)*dss_vals(i) END DO END DO @@ -4677,8 +4677,8 @@ SUBROUTINE rpath_colvar(colvar, cell, particles) ALLOCATE (ds1(ncolv, 2)) DO k = istart, iend - s1v(1, k) = REAL(k, kind=dp)*step_size*EXP(-lambda*DOT_PRODUCT(ss_vals(:)-f_vals(:, k), ss_vals(:)-f_vals(:, k))) - s1v(2, k) = EXP(-lambda*DOT_PRODUCT(ss_vals(:)-f_vals(:, k), ss_vals(:)-f_vals(:, k))) + s1v(1, k) = REAL(k, kind=dp)*step_size*EXP(-lambda*DOT_PRODUCT(ss_vals(:) - f_vals(:, k), ss_vals(:) - f_vals(:, k))) + s1v(2, k) = EXP(-lambda*DOT_PRODUCT(ss_vals(:) - f_vals(:, k), ss_vals(:) - f_vals(:, k))) DO j = 1, ncolv ds1v(j, 1, k) = f_vals(j, k)*s1v(1, k) ds1v(j, 2, k) = f_vals(j, k)*s1v(2, k) @@ -4691,16 +4691,16 @@ SUBROUTINE rpath_colvar(colvar, cell, particles) END DO END DO - colvar%ss = s1(1)/s1(2)/REAL(nconf-1, dp) + colvar%ss = s1(1)/s1(2)/REAL(nconf - 1, dp) ALLOCATE (fi(3, colvar%n_atom_s)) ii = 0 DO i = 1, ncolv DO j = 1, colvar%reaction_path_param%colvar_p(i)%colvar%n_atom_s - ii = ii+1 + ii = ii + 1 fi(:, ii) = colvar%reaction_path_param%colvar_p(i)%colvar%dsdr(:, j)*lambda* & - (ds1(i, 1)/s1(2)/REAL(nconf-1, dp)-colvar%ss*ds1(i, 2)/s1(2))*2.0_dp + (ds1(i, 1)/s1(2)/REAL(nconf - 1, dp) - colvar%ss*ds1(i, 2)/s1(2))*2.0_dp END DO END DO @@ -4760,10 +4760,10 @@ SUBROUTINE rpath_dist_rmsd(colvar, particles) ALLOCATE (ds1v(3, rmsd_atom, 2, nconf)) ALLOCATE (ds1(3, rmsd_atom, 2)) DO i = 1, natom - ii = (i-1)*3 - r0(ii+1) = particles(i)%r(1) - r0(ii+2) = particles(i)%r(2) - r0(ii+3) = particles(i)%r(3) + ii = (i - 1)*3 + r0(ii + 1) = particles(i)%r(1) + r0(ii + 2) = particles(i)%r(2) + r0(ii + 3) = particles(i)%r(3) END DO DO iat = 1, rmsd_atom @@ -4773,10 +4773,10 @@ SUBROUTINE rpath_dist_rmsd(colvar, particles) DO ik = 1, nconf DO i = 1, natom - ii = (i-1)*3 - r(ii+1) = path_conf(ii+1, ik) - r(ii+2) = path_conf(ii+2, ik) - r(ii+3) = path_conf(ii+3, ik) + ii = (i - 1)*3 + r(ii + 1) = path_conf(ii + 1, ik) + r(ii + 2) = path_conf(ii + 2, ik) + r(ii + 3) = path_conf(ii + 3, ik) END DO CALL rmsd3(particles, r, r0, output_unit=-1, my_val=my_rmsd, rotate=.TRUE.) @@ -4784,23 +4784,23 @@ SUBROUTINE rpath_dist_rmsd(colvar, particles) sum_exp = 0.0_dp DO iat = 1, rmsd_atom i = iatom(iat) - ii = (i-1)*3 - vec_dif(iat) = (riat(1, iat)-r(ii+1))**2+(riat(2, iat)-r(ii+2))**2 & - +(riat(3, iat)-r(ii+3))**2 - sum_exp = sum_exp+vec_dif(iat) + ii = (i - 1)*3 + vec_dif(iat) = (riat(1, iat) - r(ii + 1))**2 + (riat(2, iat) - r(ii + 2))**2 & + + (riat(3, iat) - r(ii + 3))**2 + sum_exp = sum_exp + vec_dif(iat) END DO - s1v(1, ik) = REAL(ik-1, dp)*EXP(-lambda*sum_exp) + s1v(1, ik) = REAL(ik - 1, dp)*EXP(-lambda*sum_exp) s1v(2, ik) = EXP(-lambda*sum_exp) DO iat = 1, rmsd_atom i = iatom(iat) - ii = (i-1)*3 - ds1v(1, iat, 1, ik) = r(ii+1)*s1v(1, ik) - ds1v(1, iat, 2, ik) = r(ii+1)*s1v(2, ik) - ds1v(2, iat, 1, ik) = r(ii+2)*s1v(1, ik) - ds1v(2, iat, 2, ik) = r(ii+2)*s1v(2, ik) - ds1v(3, iat, 1, ik) = r(ii+3)*s1v(1, ik) - ds1v(3, iat, 2, ik) = r(ii+3)*s1v(2, ik) + ii = (i - 1)*3 + ds1v(1, iat, 1, ik) = r(ii + 1)*s1v(1, ik) + ds1v(1, iat, 2, ik) = r(ii + 1)*s1v(2, ik) + ds1v(2, iat, 1, ik) = r(ii + 2)*s1v(1, ik) + ds1v(2, iat, 2, ik) = r(ii + 2)*s1v(2, ik) + ds1v(3, iat, 1, ik) = r(ii + 3)*s1v(1, ik) + ds1v(3, iat, 2, ik) = r(ii + 3)*s1v(2, ik) END DO END DO @@ -4814,14 +4814,14 @@ SUBROUTINE rpath_dist_rmsd(colvar, particles) END DO END DO - colvar%ss = s1(1)/s1(2)/REAL(nconf-1, dp) + colvar%ss = s1(1)/s1(2)/REAL(nconf - 1, dp) ALLOCATE (fi(3, rmsd_atom)) DO iat = 1, rmsd_atom - fi(1, iat) = 2.0_dp*lambda/s1(2)/REAL(nconf-1, dp)*(ds1(1, iat, 1)-ds1(1, iat, 2)*s1(1)/s1(2)) - fi(2, iat) = 2.0_dp*lambda/s1(2)/REAL(nconf-1, dp)*(ds1(2, iat, 1)-ds1(2, iat, 2)*s1(1)/s1(2)) - fi(3, iat) = 2.0_dp*lambda/s1(2)/REAL(nconf-1, dp)*(ds1(3, iat, 1)-ds1(3, iat, 2)*s1(1)/s1(2)) + fi(1, iat) = 2.0_dp*lambda/s1(2)/REAL(nconf - 1, dp)*(ds1(1, iat, 1) - ds1(1, iat, 2)*s1(1)/s1(2)) + fi(2, iat) = 2.0_dp*lambda/s1(2)/REAL(nconf - 1, dp)*(ds1(2, iat, 1) - ds1(2, iat, 2)*s1(1)/s1(2)) + fi(3, iat) = 2.0_dp*lambda/s1(2)/REAL(nconf - 1, dp)*(ds1(3, iat, 1) - ds1(3, iat, 2)*s1(1)/s1(2)) CALL put_derivative(colvar, iat, fi(:, iat)) END DO @@ -4878,10 +4878,10 @@ SUBROUTINE rpath_rmsd(colvar, particles) ALLOCATE (weight(natom)) DO i = 1, natom - ii = (i-1)*3 - r0(ii+1) = particles(i)%r(1) - r0(ii+2) = particles(i)%r(2) - r0(ii+3) = particles(i)%r(3) + ii = (i - 1)*3 + r0(ii + 1) = particles(i)%r(1) + r0(ii + 2) = particles(i)%r(2) + r0(ii + 3) = particles(i)%r(3) END DO DO iat = 1, rmsd_atom @@ -4898,16 +4898,16 @@ SUBROUTINE rpath_rmsd(colvar, particles) DO ik = 1, nconf DO i = 1, natom - ii = (i-1)*3 - r(ii+1) = path_conf(ii+1, ik) - r(ii+2) = path_conf(ii+2, ik) - r(ii+3) = path_conf(ii+3, ik) + ii = (i - 1)*3 + r(ii + 1) = path_conf(ii + 1, ik) + r(ii + 2) = path_conf(ii + 2, ik) + r(ii + 3) = path_conf(ii + 3, ik) END DO CALL rmsd3(particles, r0, r, output_unit=-1, weights=weight, my_val=my_rmsd, & rotate=.FALSE., drmsd3=drmsd) - s1v(1, ik) = REAL(ik-1, dp)*EXP(-lambda*my_rmsd) + s1v(1, ik) = REAL(ik - 1, dp)*EXP(-lambda*my_rmsd) s1v(2, ik) = EXP(-lambda*my_rmsd) DO iat = 1, rmsd_atom i = iatom(iat) @@ -4930,14 +4930,14 @@ SUBROUTINE rpath_rmsd(colvar, particles) END DO END DO - colvar%ss = s1(1)/s1(2)/REAL(nconf-1, dp) + colvar%ss = s1(1)/s1(2)/REAL(nconf - 1, dp) ALLOCATE (fi(3, rmsd_atom)) DO iat = 1, rmsd_atom - fi(1, iat) = -lambda/s1(2)/REAL(nconf-1, dp)*(ds1(1, iat, 1)-ds1(1, iat, 2)*s1(1)/s1(2)) - fi(2, iat) = -lambda/s1(2)/REAL(nconf-1, dp)*(ds1(2, iat, 1)-ds1(2, iat, 2)*s1(1)/s1(2)) - fi(3, iat) = -lambda/s1(2)/REAL(nconf-1, dp)*(ds1(3, iat, 1)-ds1(3, iat, 2)*s1(1)/s1(2)) + fi(1, iat) = -lambda/s1(2)/REAL(nconf - 1, dp)*(ds1(1, iat, 1) - ds1(1, iat, 2)*s1(1)/s1(2)) + fi(2, iat) = -lambda/s1(2)/REAL(nconf - 1, dp)*(ds1(2, iat, 1) - ds1(2, iat, 2)*s1(1)/s1(2)) + fi(3, iat) = -lambda/s1(2)/REAL(nconf - 1, dp)*(ds1(3, iat, 1) - ds1(3, iat, 2)*s1(1)/s1(2)) CALL put_derivative(colvar, iat, fi(:, iat)) END DO @@ -5036,7 +5036,7 @@ SUBROUTINE dpath_colvar(colvar, cell, particles) ALLOCATE (ds1(ncolv)) DO k = istart, iend - s1v(k) = EXP(-lambda*DOT_PRODUCT(ss_vals(:)-f_vals(:, k), ss_vals(:)-f_vals(:, k))) + s1v(k) = EXP(-lambda*DOT_PRODUCT(ss_vals(:) - f_vals(:, k), ss_vals(:) - f_vals(:, k))) DO j = 1, ncolv ds1v(j, k) = f_vals(j, k)*s1v(k) END DO @@ -5053,9 +5053,9 @@ SUBROUTINE dpath_colvar(colvar, cell, particles) ii = 0 DO i = 1, ncolv DO j = 1, colvar%reaction_path_param%colvar_p(i)%colvar%n_atom_s - ii = ii+1 + ii = ii + 1 fi(:, ii) = colvar%reaction_path_param%colvar_p(i)%colvar%dsdr(:, j)* & - 2.0_dp*(ss_vals(i)-ds1(i)/s1) + 2.0_dp*(ss_vals(i) - ds1(i)/s1) END DO END DO @@ -5114,10 +5114,10 @@ SUBROUTINE dpath_dist_rmsd(colvar, particles) ALLOCATE (ds1v(3, rmsd_atom, nconf)) ALLOCATE (ds1(3, rmsd_atom)) DO i = 1, natom - ii = (i-1)*3 - r0(ii+1) = particles(i)%r(1) - r0(ii+2) = particles(i)%r(2) - r0(ii+3) = particles(i)%r(3) + ii = (i - 1)*3 + r0(ii + 1) = particles(i)%r(1) + r0(ii + 2) = particles(i)%r(2) + r0(ii + 3) = particles(i)%r(3) END DO DO iat = 1, rmsd_atom @@ -5127,10 +5127,10 @@ SUBROUTINE dpath_dist_rmsd(colvar, particles) DO ik = 1, nconf DO i = 1, natom - ii = (i-1)*3 - r(ii+1) = path_conf(ii+1, ik) - r(ii+2) = path_conf(ii+2, ik) - r(ii+3) = path_conf(ii+3, ik) + ii = (i - 1)*3 + r(ii + 1) = path_conf(ii + 1, ik) + r(ii + 2) = path_conf(ii + 2, ik) + r(ii + 3) = path_conf(ii + 3, ik) END DO CALL rmsd3(particles, r, r0, output_unit=-1, rotate=.TRUE.) @@ -5138,12 +5138,12 @@ SUBROUTINE dpath_dist_rmsd(colvar, particles) sum_exp = 0.0_dp DO iat = 1, rmsd_atom i = iatom(iat) - ii = (i-1)*3 - vec_dif(iat) = (riat(1, iat)-r(ii+1))**2+(riat(2, iat)-r(ii+2))**2+(riat(3, iat)-r(ii+3))**2 - sum_exp = sum_exp+vec_dif(iat) - dvec_dif(1, iat) = r(ii+1) - dvec_dif(2, iat) = r(ii+2) - dvec_dif(3, iat) = r(ii+3) + ii = (i - 1)*3 + vec_dif(iat) = (riat(1, iat) - r(ii + 1))**2 + (riat(2, iat) - r(ii + 2))**2 + (riat(3, iat) - r(ii + 3))**2 + sum_exp = sum_exp + vec_dif(iat) + dvec_dif(1, iat) = r(ii + 1) + dvec_dif(2, iat) = r(ii + 2) + dvec_dif(3, iat) = r(ii + 3) END DO s1v(ik) = EXP(-lambda*sum_exp) DO iat = 1, rmsd_atom @@ -5164,7 +5164,7 @@ SUBROUTINE dpath_dist_rmsd(colvar, particles) ALLOCATE (fi(3, rmsd_atom)) DO iat = 1, rmsd_atom - fi(:, iat) = 2.0_dp*(riat(:, iat)-ds1(:, iat)/s1) + fi(:, iat) = 2.0_dp*(riat(:, iat) - ds1(:, iat)/s1) CALL put_derivative(colvar, iat, fi(:, iat)) END DO @@ -5220,10 +5220,10 @@ SUBROUTINE dpath_rmsd(colvar, particles) ALLOCATE (weight(natom)) DO i = 1, natom - ii = (i-1)*3 - r0(ii+1) = particles(i)%r(1) - r0(ii+2) = particles(i)%r(2) - r0(ii+3) = particles(i)%r(3) + ii = (i - 1)*3 + r0(ii + 1) = particles(i)%r(1) + r0(ii + 2) = particles(i)%r(2) + r0(ii + 3) = particles(i)%r(3) END DO DO iat = 1, rmsd_atom @@ -5240,10 +5240,10 @@ SUBROUTINE dpath_rmsd(colvar, particles) DO ik = 1, nconf DO i = 1, natom - ii = (i-1)*3 - r(ii+1) = path_conf(ii+1, ik) - r(ii+2) = path_conf(ii+2, ik) - r(ii+3) = path_conf(ii+3, ik) + ii = (i - 1)*3 + r(ii + 1) = path_conf(ii + 1, ik) + r(ii + 2) = path_conf(ii + 2, ik) + r(ii + 3) = path_conf(ii + 3, ik) END DO CALL rmsd3(particles, r0, r, output_unit=-1, weights=weight, my_val=my_rmsd, & @@ -5351,28 +5351,28 @@ SUBROUTINE population_colvar(colvar, cell, subsys, particles) DO jj = 1, n_atoms_to i = colvar%population_param%i_at_to(jj) CALL get_coordinates(colvar, i, xpj, my_particles) - ss = MATMUL(cell%h_inv, xpi(:)-xpj(:)) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, xpi(:) - xpj(:)) + ss = ss - NINT(ss) xij = MATMUL(cell%hmat, ss) - r12 = SQRT(xij(1)**2+xij(2)**2+xij(3)**2) + r12 = SQRT(xij(1)**2 + xij(2)**2 + xij(3)**2) IF (r12 < 1.0e-8_dp) CYCLE rdist = r12/r_0 - num = (1.0_dp-rdist**nncrd) - invden = 1.0_dp/(1.0_dp-rdist**ndcrd) + num = (1.0_dp - rdist**nncrd) + invden = 1.0_dp/(1.0_dp - rdist**ndcrd) func_coord = num*invden - dfunc_coord = (-nncrd*rdist**(nncrd-1)*invden & - +num*(invden)**2*ndcrd*rdist**(ndcrd-1))/(r12*r_0) + dfunc_coord = (-nncrd*rdist**(nncrd - 1)*invden & + + num*(invden)**2*ndcrd*rdist**(ndcrd - 1))/(r12*r_0) - ncoord = ncoord+func_coord + ncoord = ncoord + func_coord ftmp_coord(1, jj) = dfunc_coord*xij(1) ftmp_coord(2, jj) = dfunc_coord*xij(2) ftmp_coord(3, jj) = dfunc_coord*xij(3) END DO - func = EXP(-(ncoord-n_0)**2/(2.0_dp*sigma*sigma)) - dfunc = -func*(ncoord-n_0)/(sigma*sigma) + func = EXP(-(ncoord - n_0)**2/(2.0_dp*sigma*sigma)) + dfunc = -func*(ncoord - n_0)/(sigma*sigma) - population = population+norm*func + population = population + norm*func DO jj = 1, n_atoms_to ftmp(1) = ftmp_coord(1, jj)*dfunc ftmp(2) = ftmp_coord(2, jj)*dfunc @@ -5381,7 +5381,7 @@ SUBROUTINE population_colvar(colvar, cell, subsys, particles) ftmp(1) = -ftmp_coord(1, jj)*dfunc ftmp(2) = -ftmp_coord(2, jj)*dfunc ftmp(3) = -ftmp_coord(3, jj)*dfunc - CALL put_derivative(colvar, n_atoms_from+jj, ftmp) + CALL put_derivative(colvar, n_atoms_from + jj, ftmp) ENDDO ncoord = 0.0_dp ENDDO @@ -5434,8 +5434,8 @@ SUBROUTINE gyration_radius_colvar(colvar, cell, subsys, particles) i = colvar%gyration_param%i_at(ii) CALL get_coordinates(colvar, i, xpi, my_particles) CALL get_mass(colvar, i, mi, my_particles) - xpcom(:) = xpcom(:)+xpi(:)*mi - mass_tot = mass_tot+mi + xpcom(:) = xpcom(:) + xpi(:)*mi + mass_tot = mass_tot + mi END DO xpcom(:) = xpcom(:)/mass_tot @@ -5445,12 +5445,12 @@ SUBROUTINE gyration_radius_colvar(colvar, cell, subsys, particles) DO ii = 1, n_atoms i = colvar%gyration_param%i_at(ii) CALL get_coordinates(colvar, i, xpi, my_particles) - ss = MATMUL(cell%h_inv, xpi(:)-xpcom(:)) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, xpi(:) - xpcom(:)) + ss = ss - NINT(ss) dxi = MATMUL(cell%hmat, ss) - dri2 = (dxi(1)**2+dxi(2)**2+dxi(3)**2) - func = func+dri2 - dfunc(:) = dfunc(:)+dxi(:) + dri2 = (dxi(1)**2 + dxi(2)**2 + dxi(3)**2) + func = func + dri2 + dfunc(:) = dfunc(:) + dxi(:) END DO gyration = SQRT(inv_n*func) @@ -5458,12 +5458,12 @@ SUBROUTINE gyration_radius_colvar(colvar, cell, subsys, particles) i = colvar%gyration_param%i_at(ii) CALL get_coordinates(colvar, i, xpi, my_particles) CALL get_mass(colvar, i, mi, my_particles) - ss = MATMUL(cell%h_inv, xpi(:)-xpcom(:)) - ss = ss-NINT(ss) + ss = MATMUL(cell%h_inv, xpi(:) - xpcom(:)) + ss = ss - NINT(ss) dxi = MATMUL(cell%hmat, ss) - ftmp(1) = dxi(1)-dfunc(1)*mi/mass_tot - ftmp(2) = dxi(2)-dfunc(2)*mi/mass_tot - ftmp(3) = dxi(3)-dfunc(3)*mi/mass_tot + ftmp(1) = dxi(1) - dfunc(1)*mi/mass_tot + ftmp(2) = dxi(2) - dfunc(2)*mi/mass_tot + ftmp(3) = dxi(3) - dfunc(3)*mi/mass_tot ftmp(:) = ftmp(:)*inv_n/gyration CALL put_derivative(colvar, ii, ftmp) END DO @@ -5545,10 +5545,10 @@ SUBROUTINE rmsd_colvar_low(colvar, subsys, particles) weights => colvar%rmsd_param%weights DO i = 1, natom - ii = (i-1)*3 - r(ii+1) = my_particles(i)%r(1) - r(ii+2) = my_particles(i)%r(2) - r(ii+3) = my_particles(i)%r(3) + ii = (i - 1)*3 + r(ii + 1) = my_particles(i)%r(1) + r(ii + 2) = my_particles(i)%r(2) + r(ii + 3) = my_particles(i)%r(3) END DO r0(:, :) = colvar%rmsd_param%r_ref rmsd = 0.0_dp @@ -5559,20 +5559,20 @@ SUBROUTINE rmsd_colvar_low(colvar, subsys, particles) CALL rmsd3(my_particles, r, r0(:, 2), output_unit=-1, weights=weights, & my_val=rmsd(2), rotate=.FALSE., drmsd3=drmsd(:, :, 2)) - f1 = 1.0_dp/(rmsd(1)+rmsd(2)) + f1 = 1.0_dp/(rmsd(1) + rmsd(2)) ! (rmsdA-rmsdB)/(rmsdA+rmsdB) - cv_val = (rmsd(1)-rmsd(2))*f1 + cv_val = (rmsd(1) - rmsd(2))*f1 ! (rmsdA+rmsdB)^-1-(rmsdA-rmsdB)/(rmsdA+rmsdB)^2 - der(1) = f1-cv_val*f1 + der(1) = f1 - cv_val*f1 ! -(rmsdA+rmsdB)^-1-(rmsdA-rmsdB)/(rmsdA+rmsdB)^2 - der(2) = -f1-cv_val*f1 + der(2) = -f1 - cv_val*f1 DO i = 1, colvar%rmsd_param%n_atoms ii = colvar%rmsd_param%i_rmsd(i) IF (weights(ii) > 0.0_dp) THEN - ftmp(1) = der(1)*drmsd(1, ii, 1)+der(2)*drmsd(1, ii, 2) - ftmp(2) = der(1)*drmsd(2, ii, 1)+der(2)*drmsd(2, ii, 2) - ftmp(3) = der(1)*drmsd(3, ii, 1)+der(2)*drmsd(3, ii, 2) + ftmp(1) = der(1)*drmsd(1, ii, 1) + der(2)*drmsd(1, ii, 2) + ftmp(2) = der(1)*drmsd(2, ii, 1) + der(2)*drmsd(2, ii, 2) + ftmp(3) = der(1)*drmsd(3, ii, 1) + der(2)*drmsd(3, ii, 2) CALL put_derivative(colvar, i, ftmp) END IF END DO @@ -5658,21 +5658,21 @@ SUBROUTINE ring_puckering_colvar(colvar, cell, subsys, particles) !compute origin position r0 = 0.0_dp DO ii = 1, nring - r0(:) = r0(:)+r(:, ii) + r0(:) = r0(:) + r(:, ii) END DO kr = 1._dp/REAL(nring, KIND=dp) r0(:) = r0(:)*kr DO ii = 1, nring - r(:, ii) = r(:, ii)-r0(:) + r(:, ii) = r(:, ii) - r0(:) END DO ! orientation vectors rp = 0._dp rpp = 0._dp DO ii = 1, nring - cosj(ii) = COS(twopi*(ii-1)*kr) - sinj(ii) = SIN(twopi*(ii-1)*kr) - rp(:) = rp(:)+r(:, ii)*sinj(ii) - rpp(:) = rpp(:)+r(:, ii)*cosj(ii) + cosj(ii) = COS(twopi*(ii - 1)*kr) + sinj(ii) = SIN(twopi*(ii - 1)*kr) + rp(:) = rp(:) + r(:, ii)*sinj(ii) + rpp(:) = rpp(:) + r(:, ii)*cosj(ii) END DO nv = vector_product(rp, rpp) nv = nv/SQRT(SUM(nv**2)) @@ -5684,14 +5684,14 @@ SUBROUTINE ring_puckering_colvar(colvar, cell, subsys, particles) uv = 0._dp uv(i) = 1._dp uv = vector_product(uv, rpp)/rpxpp - dnvp(:, i) = uv-nv*SUM(uv*nv) + dnvp(:, i) = uv - nv*SUM(uv*nv) uv = 0._dp uv(i) = 1._dp uv = vector_product(rp, uv)/rpxpp - dnvpp(:, i) = uv-nv*SUM(uv*nv) + dnvpp(:, i) = uv - nv*SUM(uv*nv) END DO DO ii = 1, nring - nforce(:, :, ii) = dnvp(:, :)*sinj(ii)+dnvpp(:, :)*cosj(ii) + nforce(:, :, ii) = dnvp(:, :)*sinj(ii) + dnvpp(:, :)*cosj(ii) END DO ! molecular z-coordinate @@ -5708,7 +5708,7 @@ SUBROUTINE ring_puckering_colvar(colvar, cell, subsys, particles) END IF DO i = 1, 3 DO j = 1, 3 - zforce(ii, jj, i) = zforce(ii, jj, i)+r(j, ii)*nforce(j, i, jj) + zforce(ii, jj, i) = zforce(ii, jj, i) + r(j, ii)*nforce(j, i, jj) END DO END DO END DO @@ -5720,7 +5720,7 @@ SUBROUTINE ring_puckering_colvar(colvar, cell, subsys, particles) DO ii = 1, nring ftmp = 0._dp DO jj = 1, nring - ftmp(:) = ftmp(:)+zforce(jj, ii, :)*z(jj) + ftmp(:) = ftmp(:) + zforce(jj, ii, :)*z(jj) END DO ftmp = ftmp/svar CALL put_derivative(colvar, ii, ftmp) @@ -5733,9 +5733,9 @@ SUBROUTINE ring_puckering_colvar(colvar, cell, subsys, particles) svar = 0._dp DO ii = 1, nring IF (MOD(ii, 2) == 0) THEN - svar = svar-z(ii) + svar = svar - z(ii) ELSE - svar = svar+z(ii) + svar = svar + z(ii) END IF END DO svar = svar*SQRT(kr) @@ -5743,45 +5743,45 @@ SUBROUTINE ring_puckering_colvar(colvar, cell, subsys, particles) ftmp = 0._dp DO jj = 1, nring IF (MOD(jj, 2) == 0) THEN - ftmp(:) = ftmp(:)-zforce(jj, ii, :)*SQRT(kr) + ftmp(:) = ftmp(:) - zforce(jj, ii, :)*SQRT(kr) ELSE - ftmp(:) = ftmp(:)+zforce(jj, ii, :)*SQRT(kr) + ftmp(:) = ftmp(:) + zforce(jj, ii, :)*SQRT(kr) END IF END DO CALL put_derivative(colvar, ii, -ftmp) END DO ELSE - CPASSERT(m <= (nring-1)/2) + CPASSERT(m <= (nring - 1)/2) a = 0._dp b = 0._dp DO ii = 1, nring - a = a+z(ii)*COS(twopi*m*(ii-1)*kr) - b = b-z(ii)*SIN(twopi*m*(ii-1)*kr) + a = a + z(ii)*COS(twopi*m*(ii - 1)*kr) + b = b - z(ii)*SIN(twopi*m*(ii - 1)*kr) END DO a = a*SQRT(2._dp*kr) b = b*SQRT(2._dp*kr) IF (colvar%ring_puckering_param%iq > 0) THEN ! puckering amplitude - svar = SQRT(a*a+b*b) + svar = SQRT(a*a + b*b) da = a/svar db = b/svar ELSE ! puckering phase angle at = ATAN2(a, b) IF (at > pi/2._dp) THEN - svar = 2.5_dp*pi-at + svar = 2.5_dp*pi - at ELSE - svar = 0.5_dp*pi-at + svar = 0.5_dp*pi - at END IF - da = -b/(a*a+b*b) - db = a/(a*a+b*b) + da = -b/(a*a + b*b) + db = a/(a*a + b*b) END IF DO jj = 1, nring ftmp = 0._dp DO ii = 1, nring - ds = da*COS(twopi*m*(ii-1)*kr) - ds = ds-db*SIN(twopi*m*(ii-1)*kr) - ftmp(:) = ftmp(:)+ds*SQRT(2._dp*kr)*zforce(ii, jj, :) + ds = da*COS(twopi*m*(ii - 1)*kr) + ds = ds - db*SIN(twopi*m*(ii - 1)*kr) + ftmp(:) = ftmp(:) + ds*SQRT(2._dp*kr)*zforce(ii, jj, :) END DO CALL put_derivative(colvar, jj, ftmp) END DO @@ -5832,7 +5832,7 @@ RECURSIVE FUNCTION rec_eval_grid(iw1, ncol, f_vals, v_count, & k = 1 IF (v_count .LT. ncol) THEN - count1 = v_count+1 + count1 = v_count + 1 DO i = p_bounds(1, count1), p_bounds(2, count1) gp(count1) = REAL(i, KIND=dp)*grid_sp(count1) k = rec_eval_grid(iw1, ncol, f_vals, count1, gp, grid_sp, step_size, & @@ -5840,17 +5840,17 @@ RECURSIVE FUNCTION rec_eval_grid(iw1, ncol, f_vals, v_count, & END DO ELSE IF (v_count == ncol .AND. ifunc == 1) THEN DO i = istart, iend - s1v(1, i) = REAL(i, kind=dp)*step_size*EXP(-lambda*DOT_PRODUCT(gp(:)-f_vals(:, i), & - gp(:)-f_vals(:, i))) - s1v(2, i) = EXP(-lambda*DOT_PRODUCT(gp(:)-f_vals(:, i), gp(:)-f_vals(:, i))) + s1v(1, i) = REAL(i, kind=dp)*step_size*EXP(-lambda*DOT_PRODUCT(gp(:) - f_vals(:, i), & + gp(:) - f_vals(:, i))) + s1v(2, i) = EXP(-lambda*DOT_PRODUCT(gp(:) - f_vals(:, i), gp(:) - f_vals(:, i))) END DO DO i = 1, 2 s1(i) = accurate_sum(s1v(i, :)) END DO - WRITE (iw1, '(5F10.5)') gp(:), s1(1)/s1(2)/REAL(nconf-1, dp) + WRITE (iw1, '(5F10.5)') gp(:), s1(1)/s1(2)/REAL(nconf - 1, dp) ELSE IF (v_count == ncol .AND. ifunc == 2) THEN DO i = istart, iend - s1v(1, i) = EXP(-lambda*DOT_PRODUCT(gp(:)-f_vals(:, i), gp(:)-f_vals(:, i))) + s1v(1, i) = EXP(-lambda*DOT_PRODUCT(gp(:) - f_vals(:, i), gp(:) - f_vals(:, i))) END DO s1(1) = accurate_sum(s1v(1, :)) @@ -5905,7 +5905,7 @@ SUBROUTINE read_frames(frame_section, para_env, nr_frames, r_ref, n_atoms) DO j = 1, natom CALL section_vals_val_get(coord_section, "_DEFAULT_KEYWORD_", & i_rep_val=j, r_vals=rptr) - r_ref((j-1)*3+1:(j-1)*3+3, i) = rptr(1:3) + r_ref((j - 1)*3 + 1:(j - 1)*3 + 3, i) = rptr(1:3) END DO ! natom ELSE CALL section_vals_val_get(frame_section, "COORD_FILE_NAME", i_rep_section=i, c_val=filename) @@ -5932,9 +5932,9 @@ SUBROUTINE read_frames(frame_section, para_env, nr_frames, r_ref, n_atoms) " Error in XYZ format for COORD_A (CV rmsd). Very probably the"// & " line with title is missing or is empty. Please check the XYZ file and rerun your job!") READ (parser%input_line, *) dummy_char, rptr(1:3) - r_ref((j-1)*3+1, i) = cp_unit_to_cp2k(rptr(1), "angstrom") - r_ref((j-1)*3+2, i) = cp_unit_to_cp2k(rptr(2), "angstrom") - r_ref((j-1)*3+3, i) = cp_unit_to_cp2k(rptr(3), "angstrom") + r_ref((j - 1)*3 + 1, i) = cp_unit_to_cp2k(rptr(1), "angstrom") + r_ref((j - 1)*3 + 2, i) = cp_unit_to_cp2k(rptr(2), "angstrom") + r_ref((j - 1)*3 + 3, i) = cp_unit_to_cp2k(rptr(3), "angstrom") END DO ! natom CALL parser_release(parser) DEALLOCATE (rptr) @@ -5998,33 +5998,33 @@ SUBROUTINE Wc_colvar(colvar, cell, subsys, particles, qs_env) nwca = 0 nwcd = 0 DO j = 1, SIZE(wc(1)%WannierHamDiag) - x = distance(rOd-wc(1)%centres(:, j)) - y = distance(rOa-wc(1)%centres(:, j)) + x = distance(rOd - wc(1)%centres(:, j)) + y = distance(rOa - wc(1)%centres(:, j)) IF (x < rcut) THEN - nwcd = nwcd+1 + nwcd = nwcd + 1 wcdi(nwcd) = j CYCLE ENDIF IF (y < rcut) THEN - nwca = nwca+1 + nwca = nwca + 1 wcai(nwca) = j ENDIF ENDDO - dmin = distance(rH-wc(1)%centres(:, wcdi(1))) - amin = distance(rH-wc(1)%centres(:, wcai(1))) + dmin = distance(rH - wc(1)%centres(:, wcdi(1))) + amin = distance(rH - wc(1)%centres(:, wcai(1))) idmin = wcdi(1) iamin = wcai(1) !dmin constains the smallest numer, amin the next smallest DO i = 2, nwcd - x = distance(rH-wc(1)%centres(:, wcdi(i))) + x = distance(rH - wc(1)%centres(:, wcdi(i))) IF (x < dmin) THEN dmin = x idmin = wcdi(i) ENDIF ENDDO DO i = 2, nwca - x = distance(rH-wc(1)%centres(:, wcai(i))) + x = distance(rH - wc(1)%centres(:, wcai(i))) IF (x < amin) THEN amin = x iamin = wcai(i) @@ -6036,7 +6036,7 @@ SUBROUTINE Wc_colvar(colvar, cell, subsys, particles, qs_env) ! CALL put_derivative(colvar, 3, zero) ! write(*,'(2(i0,1x),4(f16.8,1x))')idmin,iamin,wc(1)%WannierHamDiag(idmin),wc(1)%WannierHamDiag(iamin),dmin,amin - colvar%ss = wc(1)%WannierHamDiag(idmin)-wc(1)%WannierHamDiag(iamin) + colvar%ss = wc(1)%WannierHamDiag(idmin) - wc(1)%WannierHamDiag(iamin) DEALLOCATE (wcai) DEALLOCATE (wcdi) @@ -6050,7 +6050,7 @@ REAL(dp) FUNCTION distance(rij) REAL(dp), INTENT(in) :: rij(3) s = MATMUL(cell%h_inv, rij) - s = s-NINT(s) + s = s - NINT(s) xv = MATMUL(cell%hmat, s) distance = SQRT(DOT_PRODUCT(xv, xv)) END FUNCTION distance @@ -6116,40 +6116,40 @@ SUBROUTINE HBP_colvar(colvar, cell, subsys, particles, qs_env) nwca = 0 nwcd = 0 DO j = 1, SIZE(wc(1)%WannierHamDiag) - x = distance(rOd-wc(1)%centres(:, j)) - y = distance(rOa-wc(1)%centres(:, j)) + x = distance(rOd - wc(1)%centres(:, j)) + y = distance(rOa - wc(1)%centres(:, j)) IF (x < rcut) THEN - nwcd = nwcd+1 + nwcd = nwcd + 1 wcdi(nwcd) = j CYCLE ENDIF IF (y < rcut) THEN - nwca = nwca+1 + nwca = nwca + 1 wcai(nwca) = j ENDIF ENDDO - dmin = distance(rH-wc(1)%centres(:, wcdi(1))) - amin = distance(rH-wc(1)%centres(:, wcai(1))) + dmin = distance(rH - wc(1)%centres(:, wcdi(1))) + amin = distance(rH - wc(1)%centres(:, wcai(1))) idmin = wcdi(1) iamin = wcai(1) !dmin constains the smallest numer, amin the next smallest DO i = 2, nwcd - x = distance(rH-wc(1)%centres(:, wcdi(i))) + x = distance(rH - wc(1)%centres(:, wcdi(i))) IF (x < dmin) THEN dmin = x idmin = wcdi(i) ENDIF ENDDO DO i = 2, nwca - x = distance(rH-wc(1)%centres(:, wcai(i))) + x = distance(rH - wc(1)%centres(:, wcai(i))) IF (x < amin) THEN amin = x iamin = wcai(i) ENDIF ENDDO - colvar%HBP%ewc(il) = colvar%HBP%shift+wc(1)%WannierHamDiag(idmin)-wc(1)%WannierHamDiag(iamin) - colvar%ss = colvar%ss+colvar%HBP%shift+wc(1)%WannierHamDiag(idmin)-wc(1)%WannierHamDiag(iamin) + colvar%HBP%ewc(il) = colvar%HBP%shift + wc(1)%WannierHamDiag(idmin) - wc(1)%WannierHamDiag(iamin) + colvar%ss = colvar%ss + colvar%HBP%shift + wc(1)%WannierHamDiag(idmin) - wc(1)%WannierHamDiag(iamin) ENDDO IF (output_unit > 0) THEN DO il = 1, colvar%HBP%nPoints @@ -6170,7 +6170,7 @@ REAL(dp) FUNCTION distance(rij) REAL(dp), INTENT(in) :: rij(3) s = MATMUL(cell%h_inv, rij) - s = s-NINT(s) + s = s - NINT(s) xv = MATMUL(cell%hmat, s) distance = SQRT(DOT_PRODUCT(xv, xv)) END FUNCTION distance diff --git a/src/colvar_utils.F b/src/colvar_utils.F index 7fe139a352..753fdfcc3f 100644 --- a/src/colvar_utils.F +++ b/src/colvar_utils.F @@ -101,7 +101,7 @@ FUNCTION number_of_colvar(force_env, only_intra_colvar, unique) RESULT(ntot) DO ikind = 1, molecule_kinds%n_els molecule_kind => molecule_kind_set(ikind) CALL get_molecule_kind(molecule_kind, ncolv=ncolv) - ntot = ntot+ncolv%ntot + ntot = ntot + ncolv%ntot END DO ELSE MOL: DO imol = 1, SIZE(molecule_set) @@ -110,13 +110,13 @@ FUNCTION number_of_colvar(force_env, only_intra_colvar, unique) RESULT(ntot) CALL get_molecule_kind(molecule_kind, & ncolv=ncolv) - ntot = ntot+ncolv%ntot + ntot = ntot + ncolv%ntot END DO MOL END IF ! Intermolecular Colvar IF (.NOT. skip_inter_colvar) THEN IF (ASSOCIATED(gci)) THEN - ntot = ntot+gci%ncolv%ntot + ntot = ntot + gci%ncolv%ntot END IF END IF CALL timestop(handle) @@ -320,9 +320,9 @@ SUBROUTINE eval_colvar(force_env, coords, cvalues, Bmatrix, MassI, Amatrix) CPASSERT(ASSOCIATED(MassI)) CPASSERT(SIZE(MassI) == natom*3) DO i = 1, natom - MassI((i-1)*3+1) = 1.0_dp/particle_set(i)%atomic_kind%mass - MassI((i-1)*3+2) = 1.0_dp/particle_set(i)%atomic_kind%mass - MassI((i-1)*3+3) = 1.0_dp/particle_set(i)%atomic_kind%mass + MassI((i - 1)*3 + 1) = 1.0_dp/particle_set(i)%atomic_kind%mass + MassI((i - 1)*3 + 2) = 1.0_dp/particle_set(i)%atomic_kind%mass + MassI((i - 1)*3 + 3) = 1.0_dp/particle_set(i)%atomic_kind%mass END DO END IF CALL timestop(handle) @@ -347,12 +347,12 @@ FUNCTION get_colvar_offset(i, molecule_set) RESULT(offset) TYPE(molecule_type), POINTER :: molecule offset = 0 - DO j = 1, i-1 + DO j = 1, i - 1 molecule => molecule_set(j) molecule_kind => molecule%molecule_kind CALL get_molecule_kind(molecule_kind, & ncolv=ncolv) - offset = offset+ncolv%ntot + offset = offset + ncolv%ntot END DO END FUNCTION get_colvar_offset @@ -477,8 +477,8 @@ SUBROUTINE eval_colv_low(colv_list, fixd_list, lcolv, particle_set, coords, & ival = offset DO iconst = 1, SIZE(colv_list) - n_tot = n_tot+1 - ival = ival+1 + n_tot = n_tot + 1 + ival = ival + 1 ! Update colvar IF (PRESENT(coords)) THEN CALL colvar_eval_mol_f(lcolv(iconst)%colvar, cell, particles=particle_set, & @@ -492,10 +492,10 @@ SUBROUTINE eval_colv_low(colv_list, fixd_list, lcolv, particle_set, coords, & ! Build the Wilson-Eliashevich Matrix IF (PRESENT(Bmatrix)) THEN DO iatm = 1, SIZE(lcolv(iconst)%colvar%i_atom) - ind = (lcolv(iconst)%colvar%i_atom(iatm)-1)*3 - Bmatrix(ind+1, ival) = lcolv(iconst)%colvar%dsdr(1, iatm) - Bmatrix(ind+2, ival) = lcolv(iconst)%colvar%dsdr(2, iatm) - Bmatrix(ind+3, ival) = lcolv(iconst)%colvar%dsdr(3, iatm) + ind = (lcolv(iconst)%colvar%i_atom(iatm) - 1)*3 + Bmatrix(ind + 1, ival) = lcolv(iconst)%colvar%dsdr(1, iatm) + Bmatrix(ind + 2, ival) = lcolv(iconst)%colvar%dsdr(2, iatm) + Bmatrix(ind + 3, ival) = lcolv(iconst)%colvar%dsdr(3, iatm) END DO END IF END DO @@ -551,10 +551,10 @@ SUBROUTINE get_clv_force(force_env, forces, coords, nsize_xyz, nsize_int, cvalue DO j = 1, i tmp = 0.0_dp DO k = 1, nsize_xyz - tmp = tmp+Bmatrix(k, j)*MassI(k)*Bmatrix(k, i) + tmp = tmp + Bmatrix(k, j)*MassI(k)*Bmatrix(k, i) END DO - Mmatrix((i-1)*nsize_int+j) = tmp - Mmatrix((j-1)*nsize_int+i) = tmp + Mmatrix((i - 1)*nsize_int + j) = tmp + Mmatrix((j - 1)*nsize_int + i) = tmp END DO END DO DEALLOCATE (MassI) @@ -594,8 +594,8 @@ SUBROUTINE post_process_colvar(colvar, particles) name_kind = TRIM(particles(i)%atomic_kind%name) CALL uppercase(name_kind) IF (TRIM(colvar%coord_param%c_kinds_from(j)) == name_kind) THEN - CALL reallocate(colvar%coord_param%i_at_from, 1, colvar%coord_param%n_atoms_from+1) - colvar%coord_param%n_atoms_from = colvar%coord_param%n_atoms_from+1 + CALL reallocate(colvar%coord_param%i_at_from, 1, colvar%coord_param%n_atoms_from + 1) + colvar%coord_param%n_atoms_from = colvar%coord_param%n_atoms_from + 1 colvar%coord_param%i_at_from(colvar%coord_param%n_atoms_from) = i END IF END DO @@ -612,8 +612,8 @@ SUBROUTINE post_process_colvar(colvar, particles) name_kind = TRIM(particles(i)%atomic_kind%name) CALL uppercase(name_kind) IF (TRIM(colvar%coord_param%c_kinds_to(j)) == name_kind) THEN - CALL reallocate(colvar%coord_param%i_at_to, 1, colvar%coord_param%n_atoms_to+1) - colvar%coord_param%n_atoms_to = colvar%coord_param%n_atoms_to+1 + CALL reallocate(colvar%coord_param%i_at_to, 1, colvar%coord_param%n_atoms_to + 1) + colvar%coord_param%n_atoms_to = colvar%coord_param%n_atoms_to + 1 colvar%coord_param%i_at_to(colvar%coord_param%n_atoms_to) = i END IF END DO @@ -630,8 +630,8 @@ SUBROUTINE post_process_colvar(colvar, particles) name_kind = TRIM(particles(i)%atomic_kind%name) CALL uppercase(name_kind) IF (TRIM(colvar%coord_param%c_kinds_to_b(j)) == name_kind) THEN - CALL reallocate(colvar%coord_param%i_at_to_b, 1, colvar%coord_param%n_atoms_to_b+1) - colvar%coord_param%n_atoms_to_b = colvar%coord_param%n_atoms_to_b+1 + CALL reallocate(colvar%coord_param%i_at_to_b, 1, colvar%coord_param%n_atoms_to_b + 1) + colvar%coord_param%n_atoms_to_b = colvar%coord_param%n_atoms_to_b + 1 colvar%coord_param%i_at_to_b(colvar%coord_param%n_atoms_to_b) = i END IF END DO @@ -656,8 +656,8 @@ SUBROUTINE post_process_colvar(colvar, particles) name_kind = TRIM(particles(i)%atomic_kind%name) CALL uppercase(name_kind) IF (TRIM(colvar%mindist_param%k_coord_from(j)) == name_kind) THEN - CALL reallocate(colvar%mindist_param%i_coord_from, 1, colvar%mindist_param%n_coord_from+1) - colvar%mindist_param%n_coord_from = colvar%mindist_param%n_coord_from+1 + CALL reallocate(colvar%mindist_param%i_coord_from, 1, colvar%mindist_param%n_coord_from + 1) + colvar%mindist_param%n_coord_from = colvar%mindist_param%n_coord_from + 1 colvar%mindist_param%i_coord_from(colvar%mindist_param%n_coord_from) = i END IF END DO @@ -674,8 +674,8 @@ SUBROUTINE post_process_colvar(colvar, particles) name_kind = TRIM(particles(i)%atomic_kind%name) CALL uppercase(name_kind) IF (TRIM(colvar%mindist_param%k_coord_to(j)) == name_kind) THEN - CALL reallocate(colvar%mindist_param%i_coord_to, 1, colvar%mindist_param%n_coord_to+1) - colvar%mindist_param%n_coord_to = colvar%mindist_param%n_coord_to+1 + CALL reallocate(colvar%mindist_param%i_coord_to, 1, colvar%mindist_param%n_coord_to + 1) + colvar%mindist_param%n_coord_to = colvar%mindist_param%n_coord_to + 1 colvar%mindist_param%i_coord_to(colvar%mindist_param%n_coord_to) = i END IF END DO @@ -700,8 +700,8 @@ SUBROUTINE post_process_colvar(colvar, particles) name_kind = TRIM(particles(i)%atomic_kind%name) CALL uppercase(name_kind) IF (TRIM(colvar%population_param%c_kinds_from(j)) == name_kind) THEN - CALL reallocate(colvar%population_param%i_at_from, 1, colvar%population_param%n_atoms_from+1) - colvar%population_param%n_atoms_from = colvar%population_param%n_atoms_from+1 + CALL reallocate(colvar%population_param%i_at_from, 1, colvar%population_param%n_atoms_from + 1) + colvar%population_param%n_atoms_from = colvar%population_param%n_atoms_from + 1 colvar%population_param%i_at_from(colvar%population_param%n_atoms_from) = i END IF END DO @@ -718,8 +718,8 @@ SUBROUTINE post_process_colvar(colvar, particles) name_kind = TRIM(particles(i)%atomic_kind%name) CALL uppercase(name_kind) IF (TRIM(colvar%population_param%c_kinds_to(j)) == name_kind) THEN - CALL reallocate(colvar%population_param%i_at_to, 1, colvar%population_param%n_atoms_to+1) - colvar%population_param%n_atoms_to = colvar%population_param%n_atoms_to+1 + CALL reallocate(colvar%population_param%i_at_to, 1, colvar%population_param%n_atoms_to + 1) + colvar%population_param%n_atoms_to = colvar%population_param%n_atoms_to + 1 colvar%population_param%i_at_to(colvar%population_param%n_atoms_to) = i END IF END DO @@ -745,8 +745,8 @@ SUBROUTINE post_process_colvar(colvar, particles) name_kind = TRIM(particles(i)%atomic_kind%name) CALL uppercase(name_kind) IF (TRIM(colvar%gyration_param%c_kinds(j)) == name_kind) THEN - CALL reallocate(colvar%gyration_param%i_at, 1, colvar%gyration_param%n_atoms+1) - colvar%gyration_param%n_atoms = colvar%gyration_param%n_atoms+1 + CALL reallocate(colvar%gyration_param%i_at, 1, colvar%gyration_param%n_atoms + 1) + colvar%gyration_param%n_atoms = colvar%gyration_param%n_atoms + 1 colvar%gyration_param%i_at(colvar%gyration_param%n_atoms) = i END IF END DO diff --git a/src/common/bessel_lib.F b/src/common/bessel_lib.F index 28c23a4cf0..e51132a99c 100644 --- a/src/common/bessel_lib.F +++ b/src/common/bessel_lib.F @@ -47,18 +47,18 @@ FUNCTION bessj0(x) IF (ABS(x) < 8.0_dp) THEN y = x*x - bessj0 = (r1+y*(r2+y*(r3+y*(r4+y* & - (r5+y*r6)))))/(s1+y*(s2+y*(s3+y* & - (s4+y*(s5+y*s6))))) + bessj0 = (r1 + y*(r2 + y*(r3 + y*(r4 + y* & + (r5 + y*r6)))))/(s1 + y*(s2 + y*(s3 + y* & + (s4 + y*(s5 + y*s6))))) ELSE ax = ABS(x) z = 8.0_dp/ax y = z*z - xx = ax-0.785398164_dp + xx = ax - 0.785398164_dp bessj0 = SQRT(0.636619772_dp/ax)*(COS(xx)* & - (p1+y*(p2+y*(p3+y*(p4+y*p5)))) & - -z*SIN(xx)*(q1+y*(q2+y*(q3+y* & - (q4+y*q5))))) + (p1 + y*(p2 + y*(p3 + y*(p4 + y*p5)))) & + - z*SIN(xx)*(q1 + y*(q2 + y*(q3 + y* & + (q4 + y*q5))))) END IF END FUNCTION bessj0 @@ -85,18 +85,18 @@ FUNCTION bessj1(x) IF (ABS(x) < 8.0_dp) THEN y = x*x - bessj1 = x*(r1+y*(r2+y*(r3+y*(r4+y* & - (r5+y*r6)))))/(s1+y*(s2+y*(s3+ & - y*(s4+y*(s5+y*s6))))) + bessj1 = x*(r1 + y*(r2 + y*(r3 + y*(r4 + y* & + (r5 + y*r6)))))/(s1 + y*(s2 + y*(s3 + & + y*(s4 + y*(s5 + y*s6))))) ELSE ax = ABS(x) z = 8.0_dp/ax y = z*z - xx = ax-2.356194491_dp + xx = ax - 2.356194491_dp bessj1 = SQRT(0.636619772_dp/ax)*(COS(xx)* & - (p1+y*(p2+y*(p3+y*(p4+y*p5)))) & - -z*SIN(xx)*(q1+y*(q2+y*(q3+y* & - (q4+y*q5)))))*SIGN(1.0_dp, x) + (p1 + y*(p2 + y*(p3 + y*(p4 + y*p5)))) & + - z*SIN(xx)*(q1 + y*(q2 + y*(q3 + y* & + (q4 + y*q5)))))*SIGN(1.0_dp, x) END IF END FUNCTION bessj1 @@ -119,12 +119,12 @@ FUNCTION bessk0(x) IF (x < 2.0_dp) THEN y = x*x/4.0_dp - bessk0 = (-LOG(x/2.0_dp)*bessi0(x))+(p1+y* & - (p2+y*(p3+y*(p4+y*(p5+y*(p6+y*p7)))))) + bessk0 = (-LOG(x/2.0_dp)*bessi0(x)) + (p1 + y* & + (p2 + y*(p3 + y*(p4 + y*(p5 + y*(p6 + y*p7)))))) ELSE y = (2.0_dp/x) - bessk0 = (EXP(-x)/SQRT(x))*(q1+y*(q2+y* & - (q3+y*(q4+y*(q5+y*(q6+y*q7)))))) + bessk0 = (EXP(-x)/SQRT(x))*(q1 + y*(q2 + y* & + (q3 + y*(q4 + y*(q5 + y*(q6 + y*q7)))))) END IF END FUNCTION bessk0 @@ -148,13 +148,13 @@ FUNCTION bessk1(x) IF (x < 2.0_dp) THEN y = x*x/4.0_dp - bessk1 = (LOG(x/2.0_dp)*bessi1(x))+(1.0_dp/x)* & - (p1+y*(p2+y*(p3+y*(p4+y*(p5+y* & - (p6+y*p7)))))) + bessk1 = (LOG(x/2.0_dp)*bessi1(x)) + (1.0_dp/x)* & + (p1 + y*(p2 + y*(p3 + y*(p4 + y*(p5 + y* & + (p6 + y*p7)))))) ELSE y = 2.0_dp/x - bessk1 = (EXP(-x)/SQRT(x))*(q1+y*(q2+y* & - (q3+y*(q4+y*(q5+y*(q6+y*q7)))))) + bessk1 = (EXP(-x)/SQRT(x))*(q1 + y*(q2 + y* & + (q3 + y*(q4 + y*(q5 + y*(q6 + y*q7)))))) END IF END FUNCTION bessk1 @@ -179,14 +179,14 @@ FUNCTION bessi0(x) IF (ABS(x) < 3.75_dp) THEN y = (x/3.75_dp)**2 - bessi0 = p1+y*(p2+y*(p3+y*(p4+y* & - (p5+y*(p6+y*p7))))) + bessi0 = p1 + y*(p2 + y*(p3 + y*(p4 + y* & + (p5 + y*(p6 + y*p7))))) ELSE ax = ABS(x) y = 3.75_dp/ax - bessi0 = (EXP(ax)/SQRT(ax))*(q1+y*(q2+y* & - (q3+y*(q4+y*(q5+y*(q6+y*(q7+y* & - (q8+y*q9)))))))) + bessi0 = (EXP(ax)/SQRT(ax))*(q1 + y*(q2 + y* & + (q3 + y*(q4 + y*(q5 + y*(q6 + y*(q7 + y* & + (q8 + y*q9)))))))) END IF END FUNCTION bessi0 @@ -211,14 +211,14 @@ FUNCTION bessi1(x) IF (ABS(x) < 3.75_dp) THEN y = (x/3.75_dp)**2 - bessi1 = p1+y*(p2+y*(p3+y*(p4+y* & - (p5+y*(p6+y*p7))))) + bessi1 = p1 + y*(p2 + y*(p3 + y*(p4 + y* & + (p5 + y*(p6 + y*p7))))) ELSE ax = ABS(x) y = 3.75_dp/ax - bessi1 = (EXP(ax)/SQRT(ax))*(q1+y*(q2+y* & - (q3+y*(q4+y*(q5+y*(q6+y*(q7+y* & - (q8+y*q9)))))))) + bessi1 = (EXP(ax)/SQRT(ax))*(q1 + y*(q2 + y* & + (q3 + y*(q4 + y*(q5 + y*(q6 + y*(q7 + y* & + (q8 + y*q9)))))))) IF (x < 0.0_dp) bessi1 = -bessi1 END IF @@ -247,7 +247,7 @@ FUNCTION bessel0(x, l) REAL(KIND=dp), DIMENSION(4) :: trig IF (x > REAL(l, KIND=dp)) THEN - arg = x-0.5_dp*REAL(l, KIND=dp)*pi + arg = x - 0.5_dp*REAL(l, KIND=dp)*pi trig(1) = SIN(arg)/x trig(2) = COS(arg)/x trig(3) = -trig(1) @@ -257,16 +257,16 @@ FUNCTION bessel0(x, l) xsq = 0.5_dp/x fact = 1._dp DO k = 1, l - ii = MOD(k, 4)+1 - fact = fac(k+l)/fac(k)/fac(l-k)*xsq**k - bessel0 = bessel0+fact*trig(ii) + ii = MOD(k, 4) + 1 + fact = fac(k + l)/fac(k)/fac(l - k)*xsq**k + bessel0 = bessel0 + fact*trig(ii) END DO END IF ELSE ! Taylor expansion for small arguments isvar = 1 DO il = 1, l - isvar = isvar*(2*il+1) + isvar = isvar*(2*il + 1) END DO IF (l /= 0._dp) THEN fact = x**l/REAL(isvar, KIND=dp) @@ -275,11 +275,11 @@ FUNCTION bessel0(x, l) END IF bessel0 = fact xsq = -0.5_dp*x*x - isvar = 2*l+1 + isvar = 2*l + 1 DO i = 1, 1000 - isvar = isvar+2 + isvar = isvar + 2 fact = fact*xsq/REAL(i*isvar, KIND=dp) - bessel0 = bessel0+fact + bessel0 = bessel0 + fact IF (ABS(fact) < tol) EXIT ENDDO IF (ABS(fact) > tol) CPABORT("BESSEL0 NOT CONVERGED") diff --git a/src/common/cg_test.F b/src/common/cg_test.F index 44569245de..70467a2c90 100644 --- a/src/common/cg_test.F +++ b/src/common/cg_test.F @@ -69,10 +69,10 @@ SUBROUTINE clebsch_gordon_test() tstart = m_walltime() CALL clebsch_gordon_init(l) tend = m_walltime() - tend = tend-tstart + tend = tend - tstart WRITE (iw, '(T30,A,T71,F10.3)') " Time for Clebsch-Gordon Table [s] ", tend - lp = (l**4+6*l**3+15*l**2+18*l+8)/8 - lp = 2*lp*(l+1) + lp = (l**4 + 6*l**3 + 15*l**2 + 18*l + 8)/8 + lp = 2*lp*(l + 1) WRITE (iw, '(T30,A,T71,I10)') " Size of Clebsch-Gordon Table ", lp WRITE (iw, '(/,A)') " Start Test for Complex Spherical Harmonics " @@ -83,14 +83,14 @@ SUBROUTINE clebsch_gordon_test() DO m2 = -l2, l2 CALL y_lm(lebedev_grid(ll)%r, a2, l2, m2) CALL clebsch_gordon(l1, m1, l2, m2, cga) - DO lp = MOD(l1+l2, 2), l1+l2, 2 - mp = m1+m2 + DO lp = MOD(l1 + l2, 2), l1 + l2, 2 + mp = m1 + m2 IF (lp < ABS(mp)) CYCLE CALL y_lm(lebedev_grid(ll)%r, a3, lp, mp) cn = REAL(SUM(a1*a2*CONJG(a3)*wa), KIND=dp) - il = lp/2+1 + il = lp/2 + 1 ca = cga(il) - IF (ABS(ca-cn) > 1.e-10_dp) THEN + IF (ABS(ca - cn) > 1.e-10_dp) THEN WRITE (*, '(A,3I5,A,F20.12)') " l ", l1, l2, lp, " A ", ca WRITE (*, '(A,3I5,A,F20.12)') " m ", m1, m2, mp, " N ", cn WRITE (*, *) @@ -110,8 +110,8 @@ SUBROUTINE clebsch_gordon_test() DO m2 = -l2, l2 CALL y_lm(lebedev_grid(ll)%r, b2, l2, m2) CALL clebsch_gordon(l1, m1, l2, m2, rga) - mp = m1+m2 - mm = m1-m2 + mp = m1 + m2 + mm = m1 - m2 IF (m1*m2 < 0 .OR. (m1*m2 == 0 .AND. (m1 < 0 .OR. m2 < 0))) THEN mp = -ABS(mp) mm = -ABS(mm) @@ -119,13 +119,13 @@ SUBROUTINE clebsch_gordon_test() mp = ABS(mp) mm = ABS(mm) END IF - DO lp = MOD(l1+l2, 2), l1+l2, 2 + DO lp = MOD(l1 + l2, 2), l1 + l2, 2 IF (ABS(mp) <= lp) THEN CALL y_lm(lebedev_grid(ll)%r, b3, lp, mp) cn = SUM(b1*b2*b3*wa) - il = lp/2+1 + il = lp/2 + 1 ca = rga(il, 1) - IF (ABS(ca-cn) > 1.e-10_dp) THEN + IF (ABS(ca - cn) > 1.e-10_dp) THEN WRITE (*, '(A,3I5,A,F20.12)') " l ", l1, l2, lp, " A ", ca WRITE (*, '(A,3I5,A,F20.12)') " m ", m1, m2, mp, " N ", cn WRITE (*, *) @@ -134,9 +134,9 @@ SUBROUTINE clebsch_gordon_test() IF (mp /= mm .AND. ABS(mm) <= lp) THEN CALL y_lm(lebedev_grid(ll)%r, b3, lp, mm) cn = SUM(b1*b2*b3*wa) - il = lp/2+1 + il = lp/2 + 1 ca = rga(il, 2) - IF (ABS(ca-cn) > 1.e-10_dp) THEN + IF (ABS(ca - cn) > 1.e-10_dp) THEN WRITE (*, '(A,3I5,A,F20.12)') " l ", l1, l2, lp, " A ", ca WRITE (*, '(A,3I5,A,F20.12)') " m ", m1, m2, mm, " N ", cn WRITE (*, *) diff --git a/src/common/cp_error_handling.F b/src/common/cp_error_handling.F index f9e108ac4f..9a3a9432d2 100644 --- a/src/common/cp_error_handling.F +++ b/src/common/cp_error_handling.F @@ -81,7 +81,7 @@ SUBROUTINE cp_warn_handler(location, message) INTEGER :: unit_nr !$OMP MASTER - warning_counter = warning_counter+1 + warning_counter = warning_counter + 1 !$OMP END MASTER unit_nr = cp_logger_get_default_io_unit() @@ -104,16 +104,16 @@ SUBROUTINE delay_non_master() ! we (ab)use the logger to determine the first MPI rank unit_nr = cp_logger_get_default_io_unit() IF (unit_nr <= 0) & - wait_time = wait_time+1.0_dp ! rank-0 gets a head start of one second. + wait_time = wait_time + 1.0_dp ! rank-0 gets a head start of one second. !$ IF (omp_get_thread_num() /= 0) & -!$ wait_time = wait_time+1.0_dp ! master threads gets another second +!$ wait_time = wait_time + 1.0_dp ! master threads gets another second ! sleep IF (wait_time > 0.0_dp) THEN t1 = m_walltime() DO - IF (m_walltime()-t1 > wait_time .OR. t1 < 0) EXIT + IF (m_walltime() - t1 > wait_time .OR. t1 < 0) EXIT ENDDO ENDIF @@ -133,7 +133,7 @@ SUBROUTINE print_abort_message(message, location, output_unit) CHARACTER(LEN=*), PARAMETER :: img = " ___ "//" / \ "//" [ABORT] "//" \___/ "// & " | "//" O/| "//" /| | "//" / \ " INTEGER, PARAMETER :: img_height = 8, img_width = 9, screen_width = 80, & - txt_width = screen_width-img_width-5 + txt_width = screen_width - img_width - 5 CHARACTER(LEN=screen_width) :: msg_line INTEGER :: a, b, c, fill, i, img_start, indent, & @@ -144,43 +144,43 @@ SUBROUTINE print_abort_message(message, location, output_unit) a = 1; b = -1; msg_height = 0 DO WHILE (b < LEN_TRIM(message)) b = next_linebreak(message, a, txt_width) - a = b+1 - msg_height = msg_height+1 + a = b + 1 + msg_height = msg_height + 1 ENDDO ! calculate message and image starting lines IF (img_height > msg_height) THEN - msg_start = (img_height-msg_height)/2+1 + msg_start = (img_height - msg_height)/2 + 1 img_start = 1 ELSE msg_start = 1 - img_start = msg_height-img_height+2 + img_start = msg_height - img_height + 2 ENDIF ! print empty line WRITE (UNIT=output_unit, FMT="(A)") "" ! print opening line - WRITE (UNIT=output_unit, FMT="(T2,A)") REPEAT("*", screen_width-1) + WRITE (UNIT=output_unit, FMT="(T2,A)") REPEAT("*", screen_width - 1) ! print body a = 1; b = -1; c = 1 - DO i = 1, MAX(img_height-1, msg_height) + DO i = 1, MAX(img_height - 1, msg_height) WRITE (UNIT=output_unit, FMT="(A)", advance='no') " *" IF (i < img_start) THEN WRITE (UNIT=output_unit, FMT="(A)", advance='no') REPEAT(" ", img_width) ELSE - WRITE (UNIT=output_unit, FMT="(A)", advance='no') img(c:c+img_width-1) - c = c+img_width + WRITE (UNIT=output_unit, FMT="(A)", advance='no') img(c:c + img_width - 1) + c = c + img_width ENDIF IF (i < msg_start) THEN - WRITE (UNIT=output_unit, FMT="(A)", advance='no') REPEAT(" ", txt_width+2) + WRITE (UNIT=output_unit, FMT="(A)", advance='no') REPEAT(" ", txt_width + 2) ELSE b = next_linebreak(message, a, txt_width) msg_line = message(a:b) - a = b+1 - fill = (txt_width-LEN_TRIM(msg_line))/2+1 - indent = txt_width-LEN_TRIM(msg_line)-fill+2 + a = b + 1 + fill = (txt_width - LEN_TRIM(msg_line))/2 + 1 + indent = txt_width - LEN_TRIM(msg_line) - fill + 2 WRITE (UNIT=output_unit, FMT="(A)", advance='no') REPEAT(" ", indent) WRITE (UNIT=output_unit, FMT="(A)", advance='no') TRIM(msg_line) WRITE (UNIT=output_unit, FMT="(A)", advance='no') REPEAT(" ", fill) @@ -190,14 +190,14 @@ SUBROUTINE print_abort_message(message, location, output_unit) ! print location line WRITE (UNIT=output_unit, FMT="(A)", advance='no') " *" - WRITE (UNIT=output_unit, FMT="(A)", advance='no') img(c:c+img_width-1) - indent = txt_width-LEN_TRIM(location)+1 + WRITE (UNIT=output_unit, FMT="(A)", advance='no') img(c:c + img_width - 1) + indent = txt_width - LEN_TRIM(location) + 1 WRITE (UNIT=output_unit, FMT="(A)", advance='no') REPEAT(" ", indent) WRITE (UNIT=output_unit, FMT="(A)", advance='no') TRIM(location) WRITE (UNIT=output_unit, FMT="(A)", advance='yes') " *" ! print closing line - WRITE (UNIT=output_unit, FMT="(T2,A)") REPEAT("*", screen_width-1) + WRITE (UNIT=output_unit, FMT="(T2,A)") REPEAT("*", screen_width - 1) ! print empty line WRITE (UNIT=output_unit, FMT="(A)") "" @@ -220,14 +220,14 @@ FUNCTION next_linebreak(message, pos, rowlen) RESULT(ibreak) INTEGER :: i, n n = LEN_TRIM(message) - IF (n-pos <= rowlen) THEN + IF (n - pos <= rowlen) THEN ibreak = n ! remaining message shorter than line ELSE - i = INDEX(message(pos+1:pos+1+rowlen), " ", BACK=.TRUE.) + i = INDEX(message(pos + 1:pos + 1 + rowlen), " ", BACK=.TRUE.) IF (i == 0) THEN - ibreak = pos+rowlen-1 ! no space found, break mid-word + ibreak = pos + rowlen - 1 ! no space found, break mid-word ELSE - ibreak = pos+i ! break at space closest to rowlen + ibreak = pos + i ! break at space closest to rowlen ENDIF ENDIF END FUNCTION next_linebreak diff --git a/src/common/cp_iter_types.F b/src/common/cp_iter_types.F index cc35882286..7b6ac49021 100644 --- a/src/common/cp_iter_types.F +++ b/src/common/cp_iter_types.F @@ -102,7 +102,7 @@ SUBROUTINE cp_iteration_info_create(iteration_info, project_name) IF (stat /= 0) & CPABORT(routineP//" could not allocate iteration_info") - last_it_info_id = last_it_info_id+1 + last_it_info_id = last_it_info_id + 1 iteration_info%id_nr = last_it_info_id iteration_info%ref_count = 1 iteration_info%print_level = 2 @@ -146,7 +146,7 @@ SUBROUTINE cp_iteration_info_retain(iteration_info) IF (iteration_info%ref_count <= 0) THEN CPABORT(routineP//" iteration_info%ref_counf<=0") END IF - iteration_info%ref_count = iteration_info%ref_count+1 + iteration_info%ref_count = iteration_info%ref_count + 1 END SUBROUTINE cp_iteration_info_retain ! ************************************************************************************************** @@ -164,7 +164,7 @@ SUBROUTINE cp_iteration_info_release(iteration_info) IF (iteration_info%ref_count <= 0) THEN CPABORT(routineP//" iteration_info%ref_counf<=0") END IF - iteration_info%ref_count = iteration_info%ref_count-1 + iteration_info%ref_count = iteration_info%ref_count - 1 IF (iteration_info%ref_count == 0) THEN IF (ASSOCIATED(iteration_info%iteration)) THEN DEALLOCATE (iteration_info%iteration) diff --git a/src/common/cp_log_handling.F b/src/common/cp_log_handling.F index a14329f8f5..c28f04f357 100644 --- a/src/common/cp_log_handling.F +++ b/src/common/cp_log_handling.F @@ -194,12 +194,12 @@ SUBROUTINE cp_add_default_logger(logger) CHARACTER(len=*), PARAMETER :: routineN = 'cp_add_default_logger', & routineP = moduleN//':'//routineN - IF (stack_pointer+1 > max_stack_pointer) THEN + IF (stack_pointer + 1 > max_stack_pointer) THEN CALL cp_abort(__LOCATION__, routineP// & "too many default loggers, increase max_stack_pointer in "//moduleN) ENDIF - stack_pointer = stack_pointer+1 + stack_pointer = stack_pointer + 1 NULLIFY (default_logger_stack(stack_pointer)%cp_default_logger) default_logger_stack(stack_pointer)%cp_default_logger => logger @@ -214,14 +214,14 @@ END SUBROUTINE cp_add_default_logger !> \author Joost VandeVondele ! ************************************************************************************************** SUBROUTINE cp_rm_default_logger() - IF (stack_pointer-1 < 0) THEN + IF (stack_pointer - 1 < 0) THEN CALL cp_abort(__LOCATION__, moduleN//":cp_rm_default_logger"// & "can not destroy default logger "//moduleN) ENDIF CALL cp_logger_release(default_logger_stack(stack_pointer)%cp_default_logger) NULLIFY (default_logger_stack(stack_pointer)%cp_default_logger) - stack_pointer = stack_pointer-1 + stack_pointer = stack_pointer - 1 END SUBROUTINE cp_rm_default_logger @@ -309,7 +309,7 @@ SUBROUTINE cp_logger_create(logger, para_env, print_level, & NULLIFY (logger%para_env) NULLIFY (logger%iter_info) logger%ref_count = 1 - last_logger_id_nr = last_logger_id_nr+1 + last_logger_id_nr = last_logger_id_nr + 1 logger%id_nr = last_logger_id_nr IF (PRESENT(template_logger)) THEN @@ -353,7 +353,7 @@ SUBROUTINE cp_logger_create(logger, para_env, print_level, & CPABORT(routineP//" para env not associated") IF (logger%para_env%ref_count < 1) & CPABORT(routineP//" para_env%ref_count<1") - logger%para_env%ref_count = logger%para_env%ref_count+1 + logger%para_env%ref_count = logger%para_env%ref_count + 1 IF (PRESENT(print_level)) logger%print_level = print_level @@ -421,7 +421,7 @@ SUBROUTINE cp_logger_retain(logger) CPABORT(routineP//" logger not associated") IF (logger%ref_count < 1) & CPABORT(routineP//" logger%ref_count<1") - logger%ref_count = logger%ref_count+1 + logger%ref_count = logger%ref_count + 1 END SUBROUTINE cp_logger_retain ! ************************************************************************************************** @@ -440,7 +440,7 @@ SUBROUTINE cp_logger_release(logger) IF (ASSOCIATED(logger)) THEN IF (logger%ref_count < 1) & CPABORT(routineP//" logger%ref_count<1") - logger%ref_count = logger%ref_count-1 + logger%ref_count = logger%ref_count - 1 IF (logger%ref_count == 0) THEN IF (logger%close_global_unit_on_dealloc .AND. & logger%default_global_unit_nr >= 0) THEN @@ -692,7 +692,7 @@ SUBROUTINE my_cp_para_env_release(para_env) IF (para_env%ref_count < 1) THEN CPABORT(routineP//" para_env%ref_count<1") END IF - para_env%ref_count = para_env%ref_count-1 + para_env%ref_count = para_env%ref_count - 1 IF (para_env%ref_count < 1) THEN IF (para_env%owns_group) THEN CALL mp_comm_free(para_env%group) diff --git a/src/common/cp_min_heap.F b/src/common/cp_min_heap.F index 68103b43d7..c4bd074315 100644 --- a/src/common/cp_min_heap.F +++ b/src/common/cp_min_heap.F @@ -72,7 +72,7 @@ ELEMENTAL FUNCTION get_right_child(n) RESULT(child) INTEGER, INTENT(IN) :: n INTEGER :: child - child = 2*n+1 + child = 2*n + 1 END FUNCTION get_right_child ! ************************************************************************************************** @@ -203,10 +203,10 @@ SUBROUTINE cp_heap_pop(heap, key, value, found) IF (found) THEN IF (heap%n .GT. 1) THEN CALL cp_heap_copy_node(heap, 1, heap%n) - heap%n = heap%n-1 + heap%n = heap%n - 1 CALL bubble_down(heap, 1) ELSE - heap%n = heap%n-1 + heap%n = heap%n - 1 ENDIF ENDIF END SUBROUTINE cp_heap_pop @@ -327,7 +327,7 @@ SUBROUTINE bubble_down(heap, first) smallest = left_child ENDIF ENDIF - right_child = left_child+1 + right_child = left_child + 1 IF (right_child .LE. heap%n) THEN right_child_value = get_value(heap, right_child) IF (right_child_value .LT. min_value) THEN diff --git a/src/common/cp_para_env.F b/src/common/cp_para_env.F index 3b1c46f8d2..cd0013a888 100644 --- a/src/common/cp_para_env.F +++ b/src/common/cp_para_env.F @@ -83,7 +83,7 @@ SUBROUTINE cp_para_env_retain(para_env) CPASSERT(ASSOCIATED(para_env)) CPASSERT(para_env%ref_count > 0) - para_env%ref_count = para_env%ref_count+1 + para_env%ref_count = para_env%ref_count + 1 END SUBROUTINE cp_para_env_retain ! ************************************************************************************************** @@ -105,7 +105,7 @@ SUBROUTINE cp_para_env_release(para_env) IF (ASSOCIATED(para_env)) THEN CPASSERT(para_env%ref_count > 0) - para_env%ref_count = para_env%ref_count-1 + para_env%ref_count = para_env%ref_count - 1 IF (para_env%ref_count < 1) THEN IF (para_env%owns_group) THEN CALL mp_comm_free(para_env%group) @@ -200,7 +200,7 @@ SUBROUTINE cp_cart_release(cart) IF (ASSOCIATED(cart)) THEN CPASSERT(cart%ref_count > 0) - cart%ref_count = cart%ref_count-1 + cart%ref_count = cart%ref_count - 1 IF (cart%ref_count == 0) THEN IF (cart%owns_group) THEN CALL mp_comm_free(cart%group) diff --git a/src/common/cp_result_methods.F b/src/common/cp_result_methods.F index 571ba115f0..848ab4ea31 100644 --- a/src/common/cp_result_methods.F +++ b/src/common/cp_result_methods.F @@ -72,12 +72,12 @@ SUBROUTINE put_result_r1(results, description, values) isize = SIZE(results%result_label) jsize = SIZE(values) - CALL reallocate(results%result_label, 1, isize+1) - CALL cp_result_value_p_reallocate(results%result_value, 1, isize+1) + CALL reallocate(results%result_label, 1, isize + 1) + CALL cp_result_value_p_reallocate(results%result_value, 1, isize + 1) - results%result_label(isize+1) = description - CALL cp_result_value_init(results%result_value(isize+1)%value, result_type_real, jsize) - results%result_value(isize+1)%value%real_type = values + results%result_label(isize + 1) = description + CALL cp_result_value_init(results%result_value(isize + 1)%value, result_type_real, jsize) + results%result_value(isize + 1)%value%real_type = values END SUBROUTINE put_result_r1 @@ -108,12 +108,12 @@ SUBROUTINE put_result_r2(results, description, values) isize = SIZE(results%result_label) jsize = SIZE(values, 1)*SIZE(values, 2) - CALL reallocate(results%result_label, 1, isize+1) - CALL cp_result_value_p_reallocate(results%result_value, 1, isize+1) + CALL reallocate(results%result_label, 1, isize + 1) + CALL cp_result_value_p_reallocate(results%result_value, 1, isize + 1) - results%result_label(isize+1) = description - CALL cp_result_value_init(results%result_value(isize+1)%value, result_type_real, jsize) - results%result_value(isize+1)%value%real_type = RESHAPE(values, (/jsize/)) + results%result_label(isize + 1) = description + CALL cp_result_value_init(results%result_value(isize + 1)%value, result_type_real, jsize) + results%result_value(isize + 1)%value%real_type = RESHAPE(values, (/jsize/)) END SUBROUTINE put_result_r2 @@ -178,7 +178,7 @@ SUBROUTINE get_result_r1(results, description, values, nval, n_rep, n_entries) CPASSERT(SIZE(results%result_label) == nlist) nrep = 0 DO i = 1, nlist - IF (TRIM(results%result_label(i)) == TRIM(description)) nrep = nrep+1 + IF (TRIM(results%result_label(i)) == TRIM(description)) nrep = nrep + 1 END DO IF (PRESENT(n_rep)) THEN @@ -208,14 +208,14 @@ SUBROUTINE get_result_r1(results, description, values, nval, n_rep, n_entries) k = 0 DO i = 1, nlist IF (TRIM(results%result_label(i)) == TRIM(description)) THEN - k = k+1 + k = k + 1 IF (PRESENT(nval)) THEN IF (k == nval) THEN values = results%result_value(i)%value%real_type EXIT END IF ELSE - values((k-1)*size_res+1:k*size_res) = results%result_value(i)%value%real_type + values((k - 1)*size_res + 1:k*size_res) = results%result_value(i)%value%real_type END IF END IF END DO @@ -252,7 +252,7 @@ SUBROUTINE get_result_r2(results, description, values, nval, n_rep, n_entries) CPASSERT(SIZE(results%result_label) == nlist) nrep = 0 DO i = 1, nlist - IF (TRIM(results%result_label(i)) == TRIM(description)) nrep = nrep+1 + IF (TRIM(results%result_label(i)) == TRIM(description)) nrep = nrep + 1 END DO IF (PRESENT(n_rep)) THEN @@ -282,15 +282,15 @@ SUBROUTINE get_result_r2(results, description, values, nval, n_rep, n_entries) k = 0 DO i = 1, nlist IF (TRIM(results%result_label(i)) == TRIM(description)) THEN - k = k+1 + k = k + 1 IF (PRESENT(nval)) THEN IF (k == nval) THEN values = RESHAPE(results%result_value(i)%value%real_type, (/SIZE(values, 1), SIZE(values, 2)/)) EXIT END IF ELSE - values((k-1)*size_res+1:k*size_res, :) = RESHAPE(results%result_value(i)%value%real_type, & - (/SIZE(values, 1), SIZE(values, 2)/)) + values((k - 1)*size_res + 1:k*size_res, :) = RESHAPE(results%result_value(i)%value%real_type, & + (/SIZE(values, 1), SIZE(values, 2)/)) END IF END IF END DO @@ -325,20 +325,20 @@ SUBROUTINE get_nreps(results, description, n_rep, n_entries, type_in_use) IF (PRESENT(n_rep)) THEN n_rep = 0 DO i = 1, nlist - IF (TRIM(results%result_label(i)) == TRIM(description)) n_rep = n_rep+1 + IF (TRIM(results%result_label(i)) == TRIM(description)) n_rep = n_rep + 1 END DO END IF IF (PRESENT(n_entries)) THEN n_entries = 0 DO i = 1, nlist IF (TRIM(results%result_label(i)) == TRIM(description)) THEN - SELECT CASE (results%result_value (i)%value%type_in_use) + SELECT CASE (results%result_value(i)%value%type_in_use) CASE (result_type_real) - n_entries = n_entries+SIZE(results%result_value(i)%value%real_type) + n_entries = n_entries + SIZE(results%result_value(i)%value%real_type) CASE (result_type_integer) - n_entries = n_entries+SIZE(results%result_value(i)%value%integer_type) + n_entries = n_entries + SIZE(results%result_value(i)%value%integer_type) CASE (result_type_logical) - n_entries = n_entries+SIZE(results%result_value(i)%value%logical_type) + n_entries = n_entries + SIZE(results%result_value(i)%value%logical_type) CASE DEFAULT ! Type not implemented in cp_result_type CPABORT("") @@ -387,26 +387,26 @@ SUBROUTINE cp_results_erase(results, description, nval) nlist = SIZE(results%result_value) nrep = 0 DO i = 1, nlist - IF (TRIM(results%result_label(i)) == TRIM(description)) nrep = nrep+1 + IF (TRIM(results%result_label(i)) == TRIM(description)) nrep = nrep + 1 END DO IF (nrep .NE. 0) THEN k = 0 entry_deleted = 0 DO i = 1, nlist IF (TRIM(results%result_label(i)) == TRIM(description)) THEN - k = k+1 + k = k + 1 IF (PRESENT(nval)) THEN IF (nval == k) THEN - entry_deleted = entry_deleted+1 + entry_deleted = entry_deleted + 1 EXIT END IF ELSE - entry_deleted = entry_deleted+1 + entry_deleted = entry_deleted + 1 END IF END IF END DO - CPASSERT(nlist-entry_deleted >= 0) - new_size = nlist-entry_deleted + CPASSERT(nlist - entry_deleted >= 0) + new_size = nlist - entry_deleted NULLIFY (clean_results) CALL cp_result_create(clean_results) CALL cp_result_clean(clean_results) @@ -419,7 +419,7 @@ SUBROUTINE cp_results_erase(results, description, nval) k = 0 DO i = 1, nlist IF (TRIM(results%result_label(i)) /= TRIM(description)) THEN - k = k+1 + k = k + 1 clean_results%result_label(k) = results%result_label(i) CALL cp_result_value_copy(clean_results%result_value(k)%value, & results%result_value(i)%value) @@ -483,7 +483,7 @@ SUBROUTINE cp_results_mp_bcast(results, source, para_env) END IF DO i = 1, nlist CALL mp_bcast(results%result_label(i), source, para_env%group) - SELECT CASE (results%result_value (i)%value%type_in_use) + SELECT CASE (results%result_value(i)%value%type_in_use) CASE (result_type_real) CALL mp_bcast(results%result_value(i)%value%real_type, source, para_env%group) CASE (result_type_integer) diff --git a/src/common/cp_result_types.F b/src/common/cp_result_types.F index 33c1432a4e..ed287fe41b 100644 --- a/src/common/cp_result_types.F +++ b/src/common/cp_result_types.F @@ -126,7 +126,7 @@ SUBROUTINE cp_result_release(results) CALL timeset(routineN, handle) IF (ASSOCIATED(results)) THEN CPASSERT(results%ref_count > 0) - results%ref_count = results%ref_count-1 + results%ref_count = results%ref_count - 1 IF (results%ref_count == 0) THEN ! Description IF (ASSOCIATED(results%result_label)) THEN @@ -190,7 +190,7 @@ SUBROUTINE cp_result_retain(results) CPASSERT(ASSOCIATED(results)) CPASSERT(results%ref_count > 0) - results%ref_count = results%ref_count+1 + results%ref_count = results%ref_count + 1 END SUBROUTINE cp_result_retain ! ************************************************************************************************** diff --git a/src/common/cp_units.F b/src/common/cp_units.F index 6f63bc534e..61aef6ac19 100644 --- a/src/common/cp_units.F +++ b/src/common/cp_units.F @@ -184,25 +184,25 @@ SUBROUTINE cp_unit_create(unit, string) next_power = 1 DO WHILE (i_low < len_string) IF (string(i_low:i_low) /= ' ') EXIT - i_low = i_low+1 + i_low = i_low + 1 END DO i_high = i_low DO WHILE (i_high <= len_string) IF (string(i_high:i_high) == ' ' .OR. string(i_high:i_high) == '^' .OR. & string(i_high:i_high) == '*' .OR. string(i_high:i_high) == '/') EXIT - i_high = i_high+1 + i_high = i_high + 1 END DO DO IF (i_high <= i_low .OR. i_low > len_string) EXIT - i_unit = i_unit+1 + i_unit = i_unit + 1 IF (i_unit > cp_unit_max_kinds) THEN CPABORT("Maximum number of combined units exceeded") EXIT END IF ! read unit - unit_string = string(i_low:i_high-1) + unit_string = string(i_low:i_high - 1) CALL uppercase(unit_string) - SELECT CASE (TRIM (unit_string)) + SELECT CASE (TRIM(unit_string)) CASE ("INTERNAL_CP2K") unit_id(i_unit) = cp_units_none kind_id(i_unit) = cp_ukind_undef @@ -364,35 +364,35 @@ SUBROUTINE cp_unit_create(unit, string) "au unit without specifing its kind not accepted, use "// & "(au_e, au_f, au_t, au_temp, au_l, au_m, au_p, au_pot)") CASE default - CPABORT("Unknown unit: "//string(i_low:i_high-1)) + CPABORT("Unknown unit: "//string(i_low:i_high - 1)) END SELECT power(i_unit) = next_power ! parse op i_low = i_high DO WHILE (i_low <= len_string) IF (string(i_low:i_low) /= ' ') EXIT - i_low = i_low+1 + i_low = i_low + 1 END DO i_high = i_low DO WHILE (i_high <= len_string) IF (string(i_high:i_high) == ' ' .OR. string(i_high:i_high) == '^' .OR. & string(i_high:i_high) == '*' .OR. string(i_high:i_high) == '/') EXIT - i_high = i_high+1 + i_high = i_high + 1 END DO IF (i_high < i_low .OR. i_low > len_string) EXIT IF (i_high <= len_string) THEN IF (string(i_low:i_high) == '^') THEN - i_low = i_high+1 + i_low = i_high + 1 DO WHILE (i_low <= len_string) IF (string(i_low:i_low) /= ' ') EXIT - i_low = i_low+1 + i_low = i_low + 1 END DO i_high = i_low DO WHILE (i_high <= len_string) - SELECT CASE (string (i_high:i_high)) + SELECT CASE (string(i_high:i_high)) CASE ('+', '-', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9') - i_high = i_high+1 + i_high = i_high + 1 CASE default EXIT END SELECT @@ -401,21 +401,21 @@ SUBROUTINE cp_unit_create(unit, string) CPABORT("an integer number is expected after a '^'") EXIT END IF - formatstr = "(i"//cp_to_string(i_high-i_low+1)//")" - READ (string(i_low:i_high-1), formatstr) & + formatstr = "(i"//cp_to_string(i_high - i_low + 1)//")" + READ (string(i_low:i_high - 1), formatstr) & next_power power(i_unit) = power(i_unit)*next_power ! next op i_low = i_high DO WHILE (i_low < len_string) IF (string(i_low:i_low) /= ' ') EXIT - i_low = i_low+1 + i_low = i_low + 1 END DO i_high = i_low DO WHILE (i_high <= len_string) IF (string(i_high:i_high) == ' ' .OR. string(i_high:i_high) == '^' .OR. & string(i_high:i_high) == '*' .OR. string(i_high:i_high) == '/') EXIT - i_high = i_high+1 + i_high = i_high + 1 END DO END IF ENDIF @@ -424,16 +424,16 @@ SUBROUTINE cp_unit_create(unit, string) IF (i_high <= len_string) THEN IF (string(i_low:i_high) == "*" .OR. string(i_low:i_high) == '/') THEN IF (string(i_low:i_high) == '/') next_power = -1 - i_low = i_high+1 + i_low = i_high + 1 DO WHILE (i_low <= len_string) IF (string(i_low:i_low) /= ' ') EXIT - i_low = i_low+1 + i_low = i_low + 1 END DO i_high = i_low DO WHILE (i_high <= len_string) IF (string(i_high:i_high) == ' ' .OR. string(i_high:i_high) == '^' .OR. & string(i_high:i_high) == '*' .OR. string(i_high:i_high) == '/') EXIT - i_high = i_high+1 + i_high = i_high + 1 END DO END IF ENDIF @@ -469,15 +469,15 @@ SUBROUTINE cp_unit_create2(unit, kind_id, unit_id, power) CPASSERT(SIZE(unit_id) <= cp_unit_max_kinds) ALLOCATE (unit) unit%ref_count = 1 - last_unit_id = last_unit_id+1 + last_unit_id = last_unit_id + 1 unit%id_nr = last_unit_id unit%kind_id(1:SIZE(kind_id)) = kind_id - unit%kind_id(SIZE(kind_id)+1:) = cp_ukind_none + unit%kind_id(SIZE(kind_id) + 1:) = cp_ukind_none unit%unit_id(1:SIZE(unit_id)) = unit_id unit%unit_id(SIZE(unit_id):) = cp_units_none IF (PRESENT(power)) THEN unit%power(1:SIZE(power)) = power - unit%power(SIZE(power)+1:) = 0 + unit%power(SIZE(power) + 1:) = 0 DO i = 1, SIZE(unit%power) IF (unit%power(i) == 0) THEN unit%kind_id(i) = cp_ukind_none @@ -503,11 +503,11 @@ SUBROUTINE cp_unit_create2(unit, kind_id, unit_id, power) max_kind = unit%kind_id(i) max_pos = i repeat = .FALSE. - DO j = i+1, SIZE(unit%kind_id) + DO j = i + 1, SIZE(unit%kind_id) IF (unit%kind_id(j) >= max_kind) THEN IF (unit%kind_id(j) /= 0 .AND. unit%kind_id(j) == max_kind .AND. & unit%unit_id(j) == unit%unit_id(max_pos)) THEN - unit%power(max_pos) = unit%power(max_pos)+unit%power(j) + unit%power(max_pos) = unit%power(max_pos) + unit%power(j) unit%kind_id(j) = cp_ukind_none unit%unit_id(j) = cp_units_none unit%power(j) = 0 @@ -528,7 +528,7 @@ SUBROUTINE cp_unit_create2(unit, kind_id, unit_id, power) END DO IF (.NOT. repeat) EXIT END DO - IF (max_kind /= 0) unit%n_kinds = unit%n_kinds+1 + IF (max_kind /= 0) unit%n_kinds = unit%n_kinds + 1 ! put the max at pos i IF (max_pos /= i) THEN unit%kind_id(max_pos) = unit%kind_id(i) @@ -560,7 +560,7 @@ SUBROUTINE cp_unit_retain(unit) CPASSERT(ASSOCIATED(unit)) CPASSERT(unit%ref_count > 0) - unit%ref_count = unit%ref_count+1 + unit%ref_count = unit%ref_count + 1 END SUBROUTINE cp_unit_retain ! ************************************************************************************************** @@ -578,7 +578,7 @@ SUBROUTINE cp_unit_release(unit) IF (ASSOCIATED(unit)) THEN CPASSERT(unit%ref_count > 0) - unit%ref_count = unit%ref_count-1 + unit%ref_count = unit%ref_count - 1 IF (unit%ref_count == 0) THEN DEALLOCATE (unit) END IF @@ -1062,8 +1062,8 @@ FUNCTION cp_basic_unit_desc(basic_kind, basic_unit, power, accept_undefined) & END SELECT IF (my_power /= 1) THEN a = LEN_TRIM(res) - CPASSERT(LEN(res)-a >= 3) - WRITE (res(a+1:), "('^',i3)") my_power + CPASSERT(LEN(res) - a >= 3) + WRITE (res(a + 1:), "('^',i3)") my_power CALL compress(res, .TRUE.) END IF END FUNCTION cp_basic_unit_desc @@ -1110,12 +1110,12 @@ FUNCTION cp_unit_desc(unit, defaults, accept_undefined) & END IF IF (i > 1) THEN res(pos:pos) = "*" - pos = pos+1 + pos = pos + 1 END IF res(pos:) = TRIM(cp_basic_unit_desc(basic_kind=unit%kind_id(i), & basic_unit=my_unit, accept_undefined=my_accept_undefined, & power=unit%power(i))) - pos = LEN_TRIM(res)+1 + pos = LEN_TRIM(res) + 1 END DO END FUNCTION cp_unit_desc @@ -1305,7 +1305,7 @@ SUBROUTINE cp_unit_set_create(unit_set, name) CPASSERT(.NOT. ASSOCIATED(unit_set)) ALLOCATE (unit_set) unit_set%ref_count = 1 - last_unit_set_id = last_unit_set_id+1 + last_unit_set_id = last_unit_set_id + 1 unit_set%id_nr = last_unit_set_id my_name = name CALL uppercase(my_name) @@ -1378,7 +1378,7 @@ SUBROUTINE cp_unit_set_retain(unit_set) CPASSERT(ASSOCIATED(unit_set)) CPASSERT(unit_set%ref_count > 0) - unit_set%ref_count = unit_set%ref_count+1 + unit_set%ref_count = unit_set%ref_count + 1 END SUBROUTINE cp_unit_set_retain ! ************************************************************************************************** @@ -1396,7 +1396,7 @@ SUBROUTINE cp_unit_set_release(unit_set) IF (ASSOCIATED(unit_set)) THEN CPASSERT(unit_set%ref_count > 0) - unit_set%ref_count = unit_set%ref_count-1 + unit_set%ref_count = unit_set%ref_count - 1 IF (unit_set%ref_count == 0) THEN DO i = 1, SIZE(unit_set%units) CALL cp_unit_release(unit_set%units(i)%unit) diff --git a/src/common/distribution_1d_types.F b/src/common/distribution_1d_types.F index 4a2683b52f..47c06fbbc5 100644 --- a/src/common/distribution_1d_types.F +++ b/src/common/distribution_1d_types.F @@ -112,7 +112,7 @@ SUBROUTINE distribution_1d_create(distribution_1d, para_env, listbased_distribut IF (PRESENT(n_lists)) my_n_lists = n_lists ALLOCATE (distribution_1d) - distribution_1d_last_id_nr = distribution_1d_last_id_nr+1 + distribution_1d_last_id_nr = distribution_1d_last_id_nr + 1 distribution_1d%id_nr = distribution_1d_last_id_nr distribution_1d%ref_count = 1 @@ -162,7 +162,7 @@ SUBROUTINE distribution_1d_retain(distribution_1d) CPASSERT(ASSOCIATED(distribution_1d)) CPASSERT(distribution_1d%ref_count > 0) - distribution_1d%ref_count = distribution_1d%ref_count+1 + distribution_1d%ref_count = distribution_1d%ref_count + 1 END SUBROUTINE distribution_1d_retain ! ************************************************************************************************** @@ -184,7 +184,7 @@ SUBROUTINE distribution_1d_release(distribution_1d) IF (ASSOCIATED(distribution_1d)) THEN CPASSERT(distribution_1d%ref_count > 0) - distribution_1d%ref_count = distribution_1d%ref_count-1 + distribution_1d%ref_count = distribution_1d%ref_count - 1 IF (distribution_1d%ref_count == 0) THEN DEALLOCATE (distribution_1d%n_el) diff --git a/src/common/eigenvalueproblems.F b/src/common/eigenvalueproblems.F index a3d7d342c2..91be4bbfab 100644 --- a/src/common/eigenvalueproblems.F +++ b/src/common/eigenvalueproblems.F @@ -63,7 +63,7 @@ SUBROUTINE diagonalise_ssyev(matrix, mysize, storageform, eigenvalues, & CHARACTER :: uplo INTEGER :: info, lda, lwork - REAL(KIND=dp) :: work(3*mysize-1) + REAL(KIND=dp) :: work(3*mysize - 1) IF (storageform(1:5) == "Lower" .OR. & storageform(1:5) == "LOWER" .OR. & @@ -78,7 +78,7 @@ SUBROUTINE diagonalise_ssyev(matrix, mysize, storageform, eigenvalues, & END IF lda = SIZE(matrix, 1) - lwork = 3*mysize-1 + lwork = 3*mysize - 1 eigenvectors = matrix @@ -113,8 +113,8 @@ SUBROUTINE diagonalise_chpev(matrix, mysize, storageform, eigenvalues, & CHARACTER :: uplo INTEGER :: info - COMPLEX(KIND=dp) :: work(2*mysize-1) - REAL(KIND=dp) :: rwork(3*mysize-2) + COMPLEX(KIND=dp) :: work(2*mysize - 1) + REAL(KIND=dp) :: rwork(3*mysize - 2) IF (storageform(1:5) == "Lower" .OR. & storageform(1:5) == "LOWER" .OR. & @@ -156,9 +156,9 @@ SUBROUTINE cp2k_sgesvd(matrix, svalues, mrow, ncol, uvec, vtvec) CHARACTER, PARAMETER :: jobu = "A", jobvt = "A" INTEGER :: info, lda, ldu, ldvt, lwork - REAL(KIND=dp) :: work(25*(mrow+ncol)) + REAL(KIND=dp) :: work(25*(mrow + ncol)) - lwork = 25*(mrow+ncol) + lwork = 25*(mrow + ncol) lda = SIZE(matrix, 1) ldu = SIZE(uvec, 1) ldvt = SIZE(vtvec, 1) @@ -191,10 +191,10 @@ SUBROUTINE cp2k_cgesvd(matrix, svalues, mrow, ncol, uvec, vtvec) CHARACTER, PARAMETER :: jobu = "A", jobvt = "A" INTEGER :: info, lda, ldu, ldvt, lwork - COMPLEX(KIND=dp) :: work(25*(mrow+ncol)) - REAL(KIND=dp) :: rwork(25*(mrow+ncol)) + COMPLEX(KIND=dp) :: work(25*(mrow + ncol)) + REAL(KIND=dp) :: rwork(25*(mrow + ncol)) - lwork = 25*(mrow+ncol) + lwork = 25*(mrow + ncol) lda = SIZE(matrix, 1) ldu = SIZE(uvec, 1) ldvt = SIZE(vtvec, 1) diff --git a/src/common/fparser.F b/src/common/fparser.F index 599fa6fd6e..c6adde9a3b 100644 --- a/src/common/fparser.F +++ b/src/common/fparser.F @@ -211,28 +211,28 @@ FUNCTION evalf(i, Val) RESULT(res) DP = 1 SP = 0 DO IP = 1, Comp(i)%ByteCodeSize - SELECT CASE (Comp (i)%ByteCode (IP)) + SELECT CASE (Comp(i)%ByteCode(IP)) - CASE (cImmed); SP = SP+1; Comp(i)%Stack(SP) = Comp(i)%Immed(DP); DP = DP+1 + CASE (cImmed); SP = SP + 1; Comp(i)%Stack(SP) = Comp(i)%Immed(DP); DP = DP + 1 CASE (cNeg); Comp(i)%Stack(SP) = -Comp(i)%Stack(SP) - CASE (cAdd); Comp(i)%Stack(SP-1) = Comp(i)%Stack(SP-1)+Comp(i)%Stack(SP); SP = SP-1 - CASE (cSub); Comp(i)%Stack(SP-1) = Comp(i)%Stack(SP-1)-Comp(i)%Stack(SP); SP = SP-1 - CASE (cMul); Comp(i)%Stack(SP-1) = Comp(i)%Stack(SP-1)*Comp(i)%Stack(SP); SP = SP-1 + CASE (cAdd); Comp(i)%Stack(SP - 1) = Comp(i)%Stack(SP - 1) + Comp(i)%Stack(SP); SP = SP - 1 + CASE (cSub); Comp(i)%Stack(SP - 1) = Comp(i)%Stack(SP - 1) - Comp(i)%Stack(SP); SP = SP - 1 + CASE (cMul); Comp(i)%Stack(SP - 1) = Comp(i)%Stack(SP - 1)*Comp(i)%Stack(SP); SP = SP - 1 CASE (cDiv); IF (Comp(i)%Stack(SP) == 0._rn) THEN; EvalErrType = 1; res = zero; RETURN; ENDIF - Comp(i)%Stack(SP-1) = Comp(i)%Stack(SP-1)/Comp(i)%Stack(SP); SP = SP-1 + Comp(i)%Stack(SP - 1) = Comp(i)%Stack(SP - 1)/Comp(i)%Stack(SP); SP = SP - 1 CASE (cPow) ! Fixing for possible Negative floating-point value raised to a real power - IF (Comp(i)%Stack(SP-1) < 0.0_rn) THEN + IF (Comp(i)%Stack(SP - 1) < 0.0_rn) THEN ipow = FLOOR(Comp(i)%Stack(SP)) IF (MOD(Comp(i)%Stack(SP), REAL(ipow, KIND=rn)) == 0.0_rn) THEN - Comp(i)%Stack(SP-1) = Comp(i)%Stack(SP-1)**ipow + Comp(i)%Stack(SP - 1) = Comp(i)%Stack(SP - 1)**ipow ELSE CPABORT("Negative floating-point value raised to a real power!") END IF ELSE - Comp(i)%Stack(SP-1) = Comp(i)%Stack(SP-1)**Comp(i)%Stack(SP) + Comp(i)%Stack(SP - 1) = Comp(i)%Stack(SP - 1)**Comp(i)%Stack(SP) END IF - SP = SP-1 + SP = SP - 1 CASE (cAbs); Comp(i)%Stack(SP) = ABS(Comp(i)%Stack(SP)) CASE (cExp); Comp(i)%Stack(SP) = EXP(Comp(i)%Stack(SP)) CASE (cLog10); IF (Comp(i)%Stack(SP) <= 0._rn) THEN; EvalErrType = 3; res = zero; RETURN; ENDIF @@ -256,7 +256,7 @@ FUNCTION evalf(i, Val) RESULT(res) CASE (cAtan); Comp(i)%Stack(SP) = ATAN(Comp(i)%Stack(SP)) CASE (cErf); Comp(i)%Stack(SP) = ERF(Comp(i)%Stack(SP)) CASE (cErfc); Comp(i)%Stack(SP) = ERFC(Comp(i)%Stack(SP)) - CASE DEFAULT; SP = SP+1; Comp(i)%Stack(SP) = Val(Comp(i)%ByteCode(IP)-VarBegin+1) + CASE DEFAULT; SP = SP + 1; Comp(i)%Stack(SP) = Val(Comp(i)%ByteCode(IP) - VarBegin + 1) END SELECT END DO EvalErrType = 0 @@ -298,41 +298,41 @@ SUBROUTINE CheckSyntax(Func, FuncStr, Var) ! Check for valid operand (must appear) !-- -------- --------- --------- --------- --------- --------- --------- ------- IF (c == '-' .OR. c == '+') THEN ! Check for leading - or + - j = j+1 + j = j + 1 IF (j > lFunc) CALL ParseErrMsg(j, FuncStr, 'Missing operand') c = Func(j:j) IF (ANY(c == Ops)) CALL ParseErrMsg(j, FuncStr, 'Multiple operators') END IF n = MathFunctionIndex(Func(j:)) IF (n > 0) THEN ! Check for math function - j = j+LEN_TRIM(Funcs(n)) + j = j + LEN_TRIM(Funcs(n)) IF (j > lFunc) CALL ParseErrMsg(j, FuncStr, 'Missing function argument') c = Func(j:j) IF (c /= '(') CALL ParseErrMsg(j, FuncStr, 'Missing opening parenthesis') END IF IF (c == '(') THEN ! Check for opening parenthesis - ParCnt = ParCnt+1 - j = j+1 + ParCnt = ParCnt + 1 + j = j + 1 CYCLE step END IF IF (SCAN(c, '0123456789.') > 0) THEN ! Check for number r = RealNum(Func(j:), ib, in, err) - IF (err) CALL ParseErrMsg(j, FuncStr, 'Invalid number format: '//Func(j+ib-1:j+in-2)) - j = j+in-1 + IF (err) CALL ParseErrMsg(j, FuncStr, 'Invalid number format: '//Func(j + ib - 1:j + in - 2)) + j = j + in - 1 IF (j > lFunc) EXIT c = Func(j:j) ELSE ! Check for variable n = VariableIndex(Func(j:), Var, ib, in) - IF (n == 0) CALL ParseErrMsg(j, FuncStr, 'Invalid element: '//Func(j+ib-1:j+in-2)) - j = j+in-1 + IF (n == 0) CALL ParseErrMsg(j, FuncStr, 'Invalid element: '//Func(j + ib - 1:j + in - 2)) + j = j + in - 1 IF (j > lFunc) EXIT c = Func(j:j) END IF DO WHILE (c == ')') ! Check for closing parenthesis - ParCnt = ParCnt-1 + ParCnt = ParCnt - 1 IF (ParCnt < 0) CALL ParseErrMsg(j, FuncStr, 'Mismatched parenthesis') - IF (Func(j-1:j-1) == '(') CALL ParseErrMsg(j-1, FuncStr, 'Empty parentheses') - j = j+1 + IF (Func(j - 1:j - 1) == '(') CALL ParseErrMsg(j - 1, FuncStr, 'Empty parentheses') + j = j + 1 IF (j > lFunc) EXIT c = Func(j:j) END DO @@ -341,8 +341,8 @@ SUBROUTINE CheckSyntax(Func, FuncStr, Var) !-- -------- --------- --------- --------- --------- --------- --------- ------- IF (j > lFunc) EXIT IF (ANY(c == Ops)) THEN ! Check for multiple operators - IF (j+1 > lFunc) CALL ParseErrMsg(j, FuncStr) - IF (ANY(Func(j+1:j+1) == Ops)) CALL ParseErrMsg(j+1, FuncStr, 'Multiple operators') + IF (j + 1 > lFunc) CALL ParseErrMsg(j, FuncStr) + IF (ANY(Func(j + 1:j + 1) == Ops)) CALL ParseErrMsg(j + 1, FuncStr, 'Multiple operators') ELSE ! Check for next operand CALL ParseErrMsg(j, FuncStr, 'Missing operator') END IF @@ -350,7 +350,7 @@ SUBROUTINE CheckSyntax(Func, FuncStr, Var) ! Now, we have an operand and an operator: the next loop will check for another ! operand (must appear) !-- -------- --------- --------- --------- --------- --------- --------- ------- - j = j+1 + j = j + 1 END DO step IF (ParCnt > 0) CALL ParseErrMsg(j, FuncStr, 'Missing )') END SUBROUTINE CheckSyntax @@ -407,7 +407,7 @@ SUBROUTINE ParseErrMsg(j, FuncStr, Msg) IF ((j > LBOUND(ipos, DIM=1)) .AND. (j <= UBOUND(ipos, DIM=1))) THEN WRITE (*, '(A)') REPEAT(" ", ipos(j))//"?" ELSE - WRITE (*, '(A)') REPEAT(" ", SIZE(ipos)+1)//"?" + WRITE (*, '(A)') REPEAT(" ", SIZE(ipos) + 1)//"?" END IF CPABORT(TRIM(message)) @@ -503,7 +503,7 @@ FUNCTION VariableIndex(str, Var, ibegin, inext) RESULT(n) IF (SCAN(str(in:in), '+-*/^) ') > 0) EXIT END DO DO j = 1, SIZE(Var) - IF (str(ib:in-1) == Var(j)) THEN + IF (str(ib:in - 1) == Var(j)) THEN n = INT(j, KIND=is) ! Variable name found EXIT END IF @@ -532,11 +532,11 @@ SUBROUTINE RemoveSpaces(str) k = 1 DO WHILE (str(k:lstr) /= ' ') IF (str(k:k) == ' ') THEN - str(k:lstr) = str(k+1:lstr)//' ' ! Move 1 character to left - ipos(k:lstr) = (/ipos(k+1:lstr), 0/) ! Move 1 element to left - k = k-1 + str(k:lstr) = str(k + 1:lstr)//' ' ! Move 1 character to left + ipos(k:lstr) = (/ipos(k + 1:lstr), 0/) ! Move 1 element to left + k = k - 1 END IF - k = k+1 + k = k + 1 END DO END SUBROUTINE RemoveSpaces ! @@ -560,8 +560,8 @@ SUBROUTINE Replace(ca, cb, str) !----- -------- --------- --------- --------- --------- --------- --------- ------- lca = LEN(ca) - DO j = 1, LEN_TRIM(str)-lca+1 - IF (str(j:j+lca-1) == ca) str(j:j+lca-1) = cb + DO j = 1, LEN_TRIM(str) - lca + 1 + IF (str(j:j + lca - 1) == ca) str(j:j + lca - 1) = cb END DO END SUBROUTINE Replace ! @@ -621,7 +621,7 @@ SUBROUTINE AddCompiledByte(i, b) ! Value of byte to be added !----- -------- --------- --------- --------- --------- --------- --------- ------- - Comp(i)%ByteCodeSize = Comp(i)%ByteCodeSize+1 + Comp(i)%ByteCodeSize = Comp(i)%ByteCodeSize + 1 IF (ASSOCIATED(Comp(i)%ByteCode)) Comp(i)%ByteCode(Comp(i)%ByteCodeSize) = b END SUBROUTINE AddCompiledByte ! @@ -649,12 +649,12 @@ FUNCTION MathItemIndex(i, F, Var) RESULT(n) n = 0 IF (SCAN(F(1:1), '0123456789.') > 0) THEN ! Check for begin of a number - Comp(i)%ImmedSize = Comp(i)%ImmedSize+1 + Comp(i)%ImmedSize = Comp(i)%ImmedSize + 1 IF (ASSOCIATED(Comp(i)%Immed)) Comp(i)%Immed(Comp(i)%ImmedSize) = RealNum(F) n = cImmed ELSE ! Check for a variable n = VariableIndex(F, Var) - IF (n > 0) n = VarBegin+n-1_is + IF (n > 0) n = VarBegin + n - 1_is END IF END FUNCTION MathItemIndex ! @@ -682,11 +682,11 @@ FUNCTION CompletelyEnclosed(F, b, e) RESULT(res) res = .FALSE. IF (F(b:b) == '(' .AND. F(e:e) == ')') THEN k = 0 - DO j = b+1, e-1 + DO j = b + 1, e - 1 IF (F(j:j) == '(') THEN - k = k+1 + k = k + 1 ELSEIF (F(j:j) == ')') THEN - k = k-1 + k = k - 1 END IF IF (k < 0) EXIT END DO @@ -727,36 +727,36 @@ RECURSIVE SUBROUTINE CompileSubstr(i, F, b, e, Var) IF (F(b:b) == '+') THEN ! Case 1: F(b:e) = '+...' ! WRITE(*,*)'1. F(b:e) = "+..."' - CALL CompileSubstr(i, F, b+1, e, Var) + CALL CompileSubstr(i, F, b + 1, e, Var) RETURN ELSEIF (CompletelyEnclosed(F, b, e)) THEN ! Case 2: F(b:e) = '(...)' ! WRITE(*,*)'2. F(b:e) = "(...)"' - CALL CompileSubstr(i, F, b+1, e-1, Var) + CALL CompileSubstr(i, F, b + 1, e - 1, Var) RETURN ELSEIF (SCAN(F(b:b), calpha) > 0) THEN n = MathFunctionIndex(F(b:e)) IF (n > 0) THEN - b2 = b+INDEX(F(b:e), '(')-1 + b2 = b + INDEX(F(b:e), '(') - 1 IF (CompletelyEnclosed(F, b2, e)) THEN ! Case 3: F(b:e) = 'fcn(...)' ! WRITE(*,*)'3. F(b:e) = "fcn(...)"' - CALL CompileSubstr(i, F, b2+1, e-1, Var) + CALL CompileSubstr(i, F, b2 + 1, e - 1, Var) CALL AddCompiledByte(i, n) RETURN END IF END IF ELSEIF (F(b:b) == '-') THEN - IF (CompletelyEnclosed(F, b+1, e)) THEN ! Case 4: F(b:e) = '-(...)' + IF (CompletelyEnclosed(F, b + 1, e)) THEN ! Case 4: F(b:e) = '-(...)' ! WRITE(*,*)'4. F(b:e) = "-(...)"' - CALL CompileSubstr(i, F, b+2, e-1, Var) + CALL CompileSubstr(i, F, b + 2, e - 1, Var) CALL AddCompiledByte(i, cNeg) RETURN - ELSEIF (SCAN(F(b+1:b+1), calpha) > 0) THEN - n = MathFunctionIndex(F(b+1:e)) + ELSEIF (SCAN(F(b + 1:b + 1), calpha) > 0) THEN + n = MathFunctionIndex(F(b + 1:e)) IF (n > 0) THEN - b2 = b+INDEX(F(b+1:e), '(') + b2 = b + INDEX(F(b + 1:e), '(') IF (CompletelyEnclosed(F, b2, e)) THEN ! Case 5: F(b:e) = '-fcn(...)' ! WRITE(*,*)'5. F(b:e) = "-fcn(...)"' - CALL CompileSubstr(i, F, b2+1, e-1, Var) + CALL CompileSubstr(i, F, b2 + 1, e - 1, Var) CALL AddCompiledByte(i, n) CALL AddCompiledByte(i, cNeg) RETURN @@ -771,22 +771,22 @@ RECURSIVE SUBROUTINE CompileSubstr(i, F, b, e, Var) k = 0 DO j = e, b, -1 IF (F(j:j) == ')') THEN - k = k+1 + k = k + 1 ELSEIF (F(j:j) == '(') THEN - k = k-1 + k = k - 1 END IF IF (k == 0 .AND. F(j:j) == Ops(io) .AND. IsBinaryOp(j, F)) THEN IF (ANY(F(j:j) == Ops(cMul:cPow)) .AND. F(b:b) == '-') THEN ! Case 6: F(b:e) = '-...Op...' with Op > - ! WRITE(*,*)'6. F(b:e) = "-...Op..." with Op > -' - CALL CompileSubstr(i, F, b+1, e, Var) + CALL CompileSubstr(i, F, b + 1, e, Var) CALL AddCompiledByte(i, cNeg) RETURN ELSE ! Case 7: F(b:e) = '...BinOp...' ! WRITE(*,*)'7. Binary operator',F(j:j) - CALL CompileSubstr(i, F, b, j-1, Var) - CALL CompileSubstr(i, F, j+1, e, Var) + CALL CompileSubstr(i, F, b, j - 1, Var) + CALL CompileSubstr(i, F, j + 1, e, Var) CALL AddCompiledByte(i, OperatorIndex(Ops(io))) - Comp(i)%StackPtr = Comp(i)%StackPtr-1 + Comp(i)%StackPtr = Comp(i)%StackPtr - 1 RETURN END IF END IF @@ -796,12 +796,12 @@ RECURSIVE SUBROUTINE CompileSubstr(i, F, b, e, Var) ! Check for remaining items, i.e. variables or explicit numbers !----- -------- --------- --------- --------- --------- --------- --------- ------- b2 = b - IF (F(b:b) == '-') b2 = b2+1 + IF (F(b:b) == '-') b2 = b2 + 1 n = MathItemIndex(i, F(b2:e), Var) ! WRITE(*,*)'8. AddCompiledByte ',n CALL AddCompiledByte(i, n) - Comp(i)%StackPtr = Comp(i)%StackPtr+1 - IF (Comp(i)%StackPtr > Comp(i)%StackSize) Comp(i)%StackSize = Comp(i)%StackSize+1 + Comp(i)%StackPtr = Comp(i)%StackPtr + 1 + IF (Comp(i)%StackPtr > Comp(i)%StackSize) Comp(i)%StackSize = Comp(i)%StackSize + 1 IF (b2 > b) CALL AddCompiledByte(i, cNeg) END SUBROUTINE CompileSubstr ! @@ -833,14 +833,14 @@ FUNCTION IsBinaryOp(j, F) RESULT(res) IF (F(j:j) == '+' .OR. F(j:j) == '-') THEN ! Plus or minus sign: IF (j == 1) THEN ! - leading unary operator ? res = .FALSE. - ELSEIF (SCAN(F(j-1:j-1), '+-*/^(') > 0) THEN ! - other unary operator ? + ELSEIF (SCAN(F(j - 1:j - 1), '+-*/^(') > 0) THEN ! - other unary operator ? res = .FALSE. - ELSEIF (SCAN(F(j+1:j+1), '0123456789') > 0 .AND. & ! - in exponent of real number ? - SCAN(F(j-1:j-1), 'eEdD') > 0) THEN + ELSEIF (SCAN(F(j + 1:j + 1), '0123456789') > 0 .AND. & ! - in exponent of real number ? + SCAN(F(j - 1:j - 1), 'eEdD') > 0) THEN Dflag = .FALSE.; Pflag = .FALSE. - k = j-1 + k = j - 1 DO WHILE (k > 1) ! step to the left in mantissa - k = k-1 + k = k - 1 IF (SCAN(F(k:k), '0123456789') > 0) THEN Dflag = .TRUE. ELSEIF (F(k:k) == '.') THEN @@ -899,9 +899,9 @@ FUNCTION RealNum(str, ibegin, inext, error) RESULT(res) ib = 1 in = 1 DO WHILE (in <= LEN_TRIM(str)) - SELECT CASE (str (in:in)) + SELECT CASE (str(in:in)) CASE (' ') ! Only leading blanks permitted - ib = ib+1 + ib = ib + 1 IF (InMan .OR. Eflag .OR. InExp) EXIT CASE ('+', '-') ! Permitted only IF (Bflag) THEN @@ -937,13 +937,13 @@ FUNCTION RealNum(str, ibegin, inext, error) RESULT(res) CASE DEFAULT EXIT ! STOP at all other characters END SELECT - in = in+1 + in = in + 1 END DO - err = (ib > in-1) .OR. (.NOT. DInMan) .OR. ((Eflag .OR. InExp) .AND. .NOT. DInExp) + err = (ib > in - 1) .OR. (.NOT. DInMan) .OR. ((Eflag .OR. InExp) .AND. .NOT. DInExp) IF (err) THEN res = 0.0_rn ELSE - READ (str(ib:in-1), *, IOSTAT=istat) res + READ (str(ib:in - 1), *, IOSTAT=istat) res err = istat /= 0 END IF IF (PRESENT(ibegin)) ibegin = ib @@ -1008,30 +1008,30 @@ FUNCTION evalfd(id_fun, ipar, vals, h, err) RESULT(derivative) IF (h /= 0._rn) THEN xval = vals(ipar) hh = h - vals(ipar) = xval+hh + vals(ipar) = xval + hh funcp = evalf(id_fun, vals) - vals(ipar) = xval-hh + vals(ipar) = xval - hh funcm = evalf(id_fun, vals) - a(1, 1) = (funcp-funcm)/(2.0_rn*hh) + a(1, 1) = (funcp - funcm)/(2.0_rn*hh) err = big_error DO i = 2, ntab hh = hh/con - vals(ipar) = xval+hh + vals(ipar) = xval + hh funcp = evalf(id_fun, vals) - vals(ipar) = xval-hh + vals(ipar) = xval - hh funcm = evalf(id_fun, vals) - a(1, i) = (funcp-funcm)/(2.0_rn*hh) + a(1, i) = (funcp - funcm)/(2.0_rn*hh) fac = con2 DO j = 2, i - a(j, i) = (a(j-1, i)*fac-a(j-1, i-1))/(fac-1.0_rn) + a(j, i) = (a(j - 1, i)*fac - a(j - 1, i - 1))/(fac - 1.0_rn) fac = con2*fac - errt = MAX(ABS(a(j, i)-a(j-1, i)), ABS(a(j, i)-a(j-1, i-1))) + errt = MAX(ABS(a(j, i) - a(j - 1, i)), ABS(a(j, i) - a(j - 1, i - 1))) IF (errt .LE. err) THEN err = errt derivative = a(j, i) ENDIF END DO - IF (ABS(a(i, i)-a(i-1, i-1)) .GE. safe*err) RETURN + IF (ABS(a(i, i) - a(i - 1, i - 1)) .GE. safe*err) RETURN END DO ELSE CPABORT("DX provided equals zero!") diff --git a/src/common/gamma.F b/src/common/gamma.F index d2d3cd13a5..76bed553b7 100644 --- a/src/common/gamma.F +++ b/src/common/gamma.F @@ -91,10 +91,10 @@ SUBROUTINE create_md_ftable(nmax, tmin, tmax, tdelta) CPABORT("Invalid arguments") END IF - n = nmax+6 + n = nmax + 6 itabmin = FLOOR(tmin/tdelta) - itabmax = CEILING((tmax-tmin)/tdelta) + itabmax = CEILING((tmax - tmin)/tdelta) ALLOCATE (ftable(0:n, itabmin:itabmax)) ftable = 0.0_dp @@ -170,7 +170,7 @@ SUBROUTINE fgamma_0(nmax, t, f) ! *** Special cases: t = 0 *** DO n = 0, nmax - f(n) = 1.0_dp/REAL(2*n+1, dp) + f(n) = 1.0_dp/REAL(2*n + 1, dp) END DO ELSE IF (t <= 12.0_dp) THEN @@ -193,8 +193,8 @@ SUBROUTINE fgamma_0(nmax, t, f) tmp = 1.0_dp DO k = 1, 6 - tmp = tmp*(ttab-t) - f(nmax) = f(nmax)+ftable(nmax+k, itab)*tmp*ifac(k) + tmp = tmp*(ttab - t) + f(nmax) = f(nmax) + ftable(nmax + k, itab)*tmp*ifac(k) END DO expt = EXP(-t) @@ -202,8 +202,8 @@ SUBROUTINE fgamma_0(nmax, t, f) ! *** Use the downward recursion relation to *** ! *** generate the remaining F_n(t) values *** - DO n = nmax-1, 0, -1 - f(n) = (2.0_dp*t*f(n+1)+expt)/REAL(2*n+1, dp) + DO n = nmax - 1, 0, -1 + f(n) = (2.0_dp*t*f(n + 1) + expt)/REAL(2*n + 1, dp) END DO ELSE @@ -214,30 +214,30 @@ SUBROUTINE fgamma_0(nmax, t, f) ! *** 12 < t <= 15 -> Four term polynom expansion *** - g = 0.4999489092_dp-0.2473631686_dp/t+ & - 0.321180909_dp/t**2-0.3811559346_dp/t**3 - f(0) = 0.5_dp*SQRT(pi/t)-g*EXP(-t)/t + g = 0.4999489092_dp - 0.2473631686_dp/t + & + 0.321180909_dp/t**2 - 0.3811559346_dp/t**3 + f(0) = 0.5_dp*SQRT(pi/t) - g*EXP(-t)/t ELSE IF (t <= 18.0_dp) THEN ! *** 15 < t <= 18 -> Three term polynom expansion *** - g = 0.4998436875_dp-0.24249438_dp/t+0.24642845_dp/t**2 - f(0) = 0.5_dp*SQRT(pi/t)-g*EXP(-t)/t + g = 0.4998436875_dp - 0.24249438_dp/t + 0.24642845_dp/t**2 + f(0) = 0.5_dp*SQRT(pi/t) - g*EXP(-t)/t ELSE IF (t <= 24.0_dp) THEN ! *** 18 < t <= 24 -> Two term polynom expansion *** - g = 0.499093162_dp-0.2152832_dp/t - f(0) = 0.5_dp*SQRT(pi/t)-g*EXP(-t)/t + g = 0.499093162_dp - 0.2152832_dp/t + f(0) = 0.5_dp*SQRT(pi/t) - g*EXP(-t)/t ELSE IF (t <= 30.0_dp) THEN ! *** 24 < t <= 30 -> One term polynom expansion *** g = 0.49_dp - f(0) = 0.5_dp*SQRT(pi/t)-g*EXP(-t)/t + f(0) = 0.5_dp*SQRT(pi/t) - g*EXP(-t)/t ELSE @@ -247,7 +247,7 @@ SUBROUTINE fgamma_0(nmax, t, f) END IF - IF (t > REAL(2*nmax+36, dp)) THEN + IF (t > REAL(2*nmax + 36, dp)) THEN expt = 0.0_dp ELSE expt = EXP(-t) @@ -257,7 +257,7 @@ SUBROUTINE fgamma_0(nmax, t, f) ! *** generate the remaining F_n(t) values *** DO n = 1, nmax - f(n) = 0.5_dp*(REAL(2*n-1, dp)*f(n-1)-expt)/t + f(n) = 0.5_dp*(REAL(2*n - 1, dp)*f(n - 1) - expt)/t END DO END IF @@ -300,7 +300,7 @@ SUBROUTINE fgamma_1(nmax, t, f) ! *** Special cases: t = 0 *** DO n = 0, nmax - f(i, n) = 1.0_dp/REAL(2*n+1, dp) + f(i, n) = 1.0_dp/REAL(2*n + 1, dp) END DO ELSE IF (t(i) <= 12.0_dp) THEN @@ -323,8 +323,8 @@ SUBROUTINE fgamma_1(nmax, t, f) tmp = 1.0_dp DO k = 1, 6 - tmp = tmp*(ttab-t(i)) - f(i, nmax) = f(i, nmax)+ftable(nmax+k, itab)*tmp*ifac(k) + tmp = tmp*(ttab - t(i)) + f(i, nmax) = f(i, nmax) + ftable(nmax + k, itab)*tmp*ifac(k) END DO expt = EXP(-t(i)) @@ -332,8 +332,8 @@ SUBROUTINE fgamma_1(nmax, t, f) ! *** Use the downward recursion relation to *** ! *** generate the remaining F_n(t) values *** - DO n = nmax-1, 0, -1 - f(i, n) = (2.0_dp*t(i)*f(i, n+1)+expt)/REAL(2*n+1, dp) + DO n = nmax - 1, 0, -1 + f(i, n) = (2.0_dp*t(i)*f(i, n + 1) + expt)/REAL(2*n + 1, dp) END DO ELSE @@ -344,30 +344,30 @@ SUBROUTINE fgamma_1(nmax, t, f) ! *** 12 < t <= 15 -> Four term polynom expansion *** - g = 0.4999489092_dp-0.2473631686_dp/t(i)+ & - 0.321180909_dp/t(i)**2-0.3811559346_dp/t(i)**3 - f(i, 0) = 0.5_dp*SQRT(pi/t(i))-g*EXP(-t(i))/t(i) + g = 0.4999489092_dp - 0.2473631686_dp/t(i) + & + 0.321180909_dp/t(i)**2 - 0.3811559346_dp/t(i)**3 + f(i, 0) = 0.5_dp*SQRT(pi/t(i)) - g*EXP(-t(i))/t(i) ELSE IF (t(i) <= 18.0_dp) THEN ! *** 15 < t <= 18 -> Three term polynom expansion *** - g = 0.4998436875_dp-0.24249438_dp/t(i)+0.24642845_dp/t(i)**2 - f(i, 0) = 0.5_dp*SQRT(pi/t(i))-g*EXP(-t(i))/t(i) + g = 0.4998436875_dp - 0.24249438_dp/t(i) + 0.24642845_dp/t(i)**2 + f(i, 0) = 0.5_dp*SQRT(pi/t(i)) - g*EXP(-t(i))/t(i) ELSE IF (t(i) <= 24.0_dp) THEN ! *** 18 < t <= 24 -> Two term polynom expansion *** - g = 0.499093162_dp-0.2152832_dp/t(i) - f(i, 0) = 0.5_dp*SQRT(pi/t(i))-g*EXP(-t(i))/t(i) + g = 0.499093162_dp - 0.2152832_dp/t(i) + f(i, 0) = 0.5_dp*SQRT(pi/t(i)) - g*EXP(-t(i))/t(i) ELSE IF (t(i) <= 30.0_dp) THEN ! *** 24 < t <= 30 -> One term polynom expansion *** g = 0.49_dp - f(i, 0) = 0.5_dp*SQRT(pi/t(i))-g*EXP(-t(i))/t(i) + f(i, 0) = 0.5_dp*SQRT(pi/t(i)) - g*EXP(-t(i))/t(i) ELSE @@ -377,7 +377,7 @@ SUBROUTINE fgamma_1(nmax, t, f) END IF - IF (t(i) > REAL(2*nmax+36, dp)) THEN + IF (t(i) > REAL(2*nmax + 36, dp)) THEN expt = 0.0_dp ELSE expt = EXP(-t(i)) @@ -387,7 +387,7 @@ SUBROUTINE fgamma_1(nmax, t, f) ! *** generate the remaining F_n(t) values *** DO n = 1, nmax - f(i, n) = 0.5_dp*(REAL(2*n-1, dp)*f(i, n-1)-expt)/t(i) + f(i, n) = 0.5_dp*(REAL(2*n - 1, dp)*f(i, n - 1) - expt)/t(i) END DO END IF @@ -446,17 +446,17 @@ FUNCTION fgamma_ref(nmax, t) RESULT(f) ! *** Special case: t = 0 => analytic expression *** DO n = 0, nmax - f(n) = 1.0_dp/REAL(2*n+1, dp) + f(n) = 1.0_dp/REAL(2*n + 1, dp) END DO ELSE IF (t <= 50.0_dp) THEN ! *** Initialize ratios of Bessel functions *** - r(kmax+10) = 0.0_dp + r(kmax + 10) = 0.0_dp - DO j = kmax+9, 1, -1 - r(j) = -t/(REAL(4*j+2, dp)-t*r(j+1)) + DO j = kmax + 9, 1, -1 + r(j) = -t/(REAL(4*j + 2, dp) - t*r(j + 1)) END DO factor = 2.0_dp*SINH(0.5_dp*t)*EXP(-0.5_dp*t)/t @@ -465,14 +465,14 @@ FUNCTION fgamma_ref(nmax, t) RESULT(f) ! *** Initialize iteration *** - sumtot = factor/REAL(2*n+1, dp) + sumtot = factor/REAL(2*n + 1, dp) term = 1.0_dp ! *** Begin the summation and recursion *** DO k = 1, kmax - term = term*REAL(2*n-2*k+1, dp)/REAL(2*n+2*k+1, dp) + term = term*REAL(2*n - 2*k + 1, dp)/REAL(2*n + 2*k + 1, dp) ! *** Product of Bessel function quotients *** @@ -482,7 +482,7 @@ FUNCTION fgamma_ref(nmax, t) RESULT(f) p = p*r(j) END DO - sumterm = factor*term*p*REAL(2*k+1, dp)/REAL(2*n+1, dp) + sumterm = factor*term*p*REAL(2*k + 1, dp)/REAL(2*n + 1, dp) IF (ABS(sumterm) < eps) THEN @@ -500,7 +500,7 @@ FUNCTION fgamma_ref(nmax, t) RESULT(f) ! *** Add the current term to the sum and continue the iteration *** - sumtot = sumtot+sumterm + sumtot = sumtot + sumterm END IF @@ -522,7 +522,7 @@ FUNCTION fgamma_ref(nmax, t) RESULT(f) expt = EXP(-t) DO n = 1, nmax - f(n) = 0.5_dp*(REAL(2*n-1, dp)*f(n-1)-expt)/t + f(n) = 0.5_dp*(REAL(2*n - 1, dp)*f(n - 1) - expt)/t END DO END IF diff --git a/src/common/glob_matching.F b/src/common/glob_matching.F index 043c438908..b512f43541 100644 --- a/src/common/glob_matching.F +++ b/src/common/glob_matching.F @@ -59,24 +59,24 @@ RECURSIVE FUNCTION string_match(string, pattern) RESULT(match) ! Split off a piece of the pattern ! DO WHILE (p <= ptrim) - SELECT CASE (pattern (p:p)) + SELECT CASE (pattern(p:p)) CASE (star) IF (ll .NE. 0) EXIT method = 1 CASE (question) IF (ll .NE. 0) EXIT method = 2 - start = start+1 + start = start + 1 CASE (backslash) - p = p+1 - ll = ll+1 + p = p + 1 + ll = ll + 1 literal(ll:ll) = pattern(p:p) CASE default - ll = ll+1 + ll = ll + 1 literal(ll:ll) = pattern(p:p) END SELECT - p = p+1 + p = p + 1 ENDDO ! @@ -93,8 +93,8 @@ RECURSIVE FUNCTION string_match(string, pattern) RESULT(match) ! The string matches a literal part? ! IF (ll > 0) THEN - IF (string(start:MIN(strim, start+ll-1)) == literal(1:ll)) THEN - start = start+ll + IF (string(start:MIN(strim, start + ll - 1)) == literal(1:ll)) THEN + start = start + ll match = string_match(string(start:), pattern(p:)) ENDIF ENDIF @@ -111,14 +111,14 @@ RECURSIVE FUNCTION string_match(string, pattern) RESULT(match) DO WHILE (start <= strim) k = INDEX(string(start:), literal(1:ll)) IF (k > 0) THEN - start = start+k+ll-1 + start = start + k + ll - 1 match = string_match(string(start:), pattern(p:)) IF (match) THEN EXIT ENDIF ENDIF - start = start+1 + start = start + 1 ENDDO ENDIF ENDIF @@ -127,8 +127,8 @@ RECURSIVE FUNCTION string_match(string, pattern) RESULT(match) ! ! Scan the whole of the remaining string ... ! - IF (string(start:MIN(strim, start+ll-1)) == literal(1:ll)) THEN - match = string_match(string(start+ll:), pattern(p:)) + IF (string(start:MIN(strim, start + ll - 1)) == literal(1:ll)) THEN + match = string_match(string(start + ll:), pattern(p:)) ENDIF ENDIF RETURN diff --git a/src/common/kahan_sum.F b/src/common/kahan_sum.F index 70faa05b58..e2d86e693d 100644 --- a/src/common/kahan_sum.F +++ b/src/common/kahan_sum.F @@ -72,17 +72,17 @@ PURE FUNCTION kahan_sum_s1(array, mask) RESULT(ks) IF (PRESENT(mask)) THEN DO i1 = 1, SIZE(array, 1) IF (mask(i1)) THEN - y = array(i1)-c - t = ks+y - c = (t-ks)-y + y = array(i1) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO ELSE DO i1 = 1, SIZE(array, 1) - y = array(i1)-c - t = ks+y - c = (t-ks)-y + y = array(i1) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDIF @@ -107,17 +107,17 @@ PURE FUNCTION kahan_sum_d1(array, mask) RESULT(ks) IF (PRESENT(mask)) THEN DO i1 = 1, SIZE(array, 1) IF (mask(i1)) THEN - y = array(i1)-c - t = ks+y - c = (t-ks)-y + y = array(i1) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO ELSE DO i1 = 1, SIZE(array, 1) - y = array(i1)-c - t = ks+y - c = (t-ks)-y + y = array(i1) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDIF @@ -140,9 +140,9 @@ PURE FUNCTION kahan_dot_product_d1(array1, array2) RESULT(ks) n = SIZE(array1) DO i = 1, n - y = array1(i)*array2(i)-c - t = ks+y - c = (t-ks)-y + y = array1(i)*array2(i) - c + t = ks + y + c = (t - ks) - y ks = t END DO END FUNCTION kahan_dot_product_d1 @@ -166,17 +166,17 @@ PURE FUNCTION kahan_sum_c1(array, mask) RESULT(ks) IF (PRESENT(mask)) THEN DO i1 = 1, SIZE(array, 1) IF (mask(i1)) THEN - y = array(i1)-c - t = ks+y - c = (t-ks)-y + y = array(i1) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO ELSE DO i1 = 1, SIZE(array, 1) - y = array(i1)-c - t = ks+y - c = (t-ks)-y + y = array(i1) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDIF @@ -201,17 +201,17 @@ PURE FUNCTION kahan_sum_z1(array, mask) RESULT(ks) IF (PRESENT(mask)) THEN DO i1 = 1, SIZE(array, 1) IF (mask(i1)) THEN - y = array(i1)-c - t = ks+y - c = (t-ks)-y + y = array(i1) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO ELSE DO i1 = 1, SIZE(array, 1) - y = array(i1)-c - t = ks+y - c = (t-ks)-y + y = array(i1) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDIF @@ -237,9 +237,9 @@ PURE FUNCTION kahan_sum_s2(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2)) THEN - y = array(i1, i2)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -247,9 +247,9 @@ PURE FUNCTION kahan_sum_s2(array, mask) RESULT(ks) ELSE DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO @@ -275,9 +275,9 @@ PURE FUNCTION kahan_dot_product_s2(array1, array2) RESULT(ks) n2 = SIZE(array1, 2) DO i2 = 1, n2 DO i1 = 1, n1 - y = REAL(array1(i1, i2), dp)*REAL(array2(i1, i2), dp)-c - t = ks+y - c = (t-ks)-y + y = REAL(array1(i1, i2), dp)*REAL(array2(i1, i2), dp) - c + t = ks + y + c = (t - ks) - y ks = t END DO END DO @@ -303,9 +303,9 @@ PURE FUNCTION kahan_sum_d2(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2)) THEN - y = array(i1, i2)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -313,9 +313,9 @@ PURE FUNCTION kahan_sum_d2(array, mask) RESULT(ks) ELSE DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO @@ -341,9 +341,9 @@ PURE FUNCTION kahan_dot_product_d2(array1, array2) RESULT(ks) n2 = SIZE(array1, 2) DO i2 = 1, n2 DO i1 = 1, n1 - y = array1(i1, i2)*array2(i1, i2)-c - t = ks+y - c = (t-ks)-y + y = array1(i1, i2)*array2(i1, i2) - c + t = ks + y + c = (t - ks) - y ks = t END DO END DO @@ -369,9 +369,9 @@ PURE FUNCTION kahan_sum_c2(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2)) THEN - y = array(i1, i2)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -379,9 +379,9 @@ PURE FUNCTION kahan_sum_c2(array, mask) RESULT(ks) ELSE DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO @@ -408,9 +408,9 @@ PURE FUNCTION kahan_sum_z2(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2)) THEN - y = array(i1, i2)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -418,9 +418,9 @@ PURE FUNCTION kahan_sum_z2(array, mask) RESULT(ks) ELSE DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO @@ -446,9 +446,9 @@ PURE FUNCTION kahan_dot_product_z2(array1, array2) RESULT(ks) n2 = SIZE(array1, 2) DO i2 = 1, n2 DO i1 = 1, n1 - y = array1(i1, i2)*array2(i1, i2)-c - t = ks+y - c = (t-ks)-y + y = array1(i1, i2)*array2(i1, i2) - c + t = ks + y + c = (t - ks) - y ks = t END DO END DO @@ -475,9 +475,9 @@ PURE FUNCTION kahan_sum_s3(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2, i3)) THEN - y = array(i1, i2, i3)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -487,9 +487,9 @@ PURE FUNCTION kahan_sum_s3(array, mask) RESULT(ks) DO i3 = 1, SIZE(array, 3) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2, i3)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO @@ -518,9 +518,9 @@ PURE FUNCTION kahan_sum_d3(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2, i3)) THEN - y = array(i1, i2, i3)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -530,9 +530,9 @@ PURE FUNCTION kahan_sum_d3(array, mask) RESULT(ks) DO i3 = 1, SIZE(array, 3) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2, i3)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO @@ -561,9 +561,9 @@ PURE FUNCTION kahan_dot_product_d3(array1, array2) RESULT(ks) DO i3 = 1, n3 DO i2 = 1, n2 DO i1 = 1, n1 - y = array1(i1, i2, i3)*array2(i1, i2, i3)-c - t = ks+y - c = (t-ks)-y + y = array1(i1, i2, i3)*array2(i1, i2, i3) - c + t = ks + y + c = (t - ks) - y ks = t END DO END DO @@ -594,9 +594,9 @@ PURE FUNCTION kahan_dot_product_masked_d3(array1, array2, mask, th) RESULT(ks) DO i2 = LBOUND(mask, 2), UBOUND(mask, 2) DO i1 = LBOUND(mask, 1), UBOUND(mask, 1) IF (mask(i1, i2, i3) .GT. th) THEN - y = array1(i1, i2, i3)*array2(i1, i2, i3)-c - t = ks+y - c = (t-ks)-y + y = array1(i1, i2, i3)*array2(i1, i2, i3) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -625,9 +625,9 @@ PURE FUNCTION kahan_sum_c3(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2, i3)) THEN - y = array(i1, i2, i3)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -637,9 +637,9 @@ PURE FUNCTION kahan_sum_c3(array, mask) RESULT(ks) DO i3 = 1, SIZE(array, 3) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2, i3)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO @@ -668,9 +668,9 @@ PURE FUNCTION kahan_sum_z3(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2, i3)) THEN - y = array(i1, i2, i3)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -680,9 +680,9 @@ PURE FUNCTION kahan_sum_z3(array, mask) RESULT(ks) DO i3 = 1, SIZE(array, 3) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2, i3)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO @@ -713,9 +713,9 @@ PURE FUNCTION kahan_sum_s4(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2, i3, i4)) THEN - y = array(i1, i2, i3, i4)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -727,9 +727,9 @@ PURE FUNCTION kahan_sum_s4(array, mask) RESULT(ks) DO i3 = 1, SIZE(array, 3) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2, i3, i4)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO @@ -761,9 +761,9 @@ PURE FUNCTION kahan_sum_d4(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2, i3, i4)) THEN - y = array(i1, i2, i3, i4)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -775,9 +775,9 @@ PURE FUNCTION kahan_sum_d4(array, mask) RESULT(ks) DO i3 = 1, SIZE(array, 3) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2, i3, i4)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO @@ -810,9 +810,9 @@ PURE FUNCTION kahan_sum_c4(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2, i3, i4)) THEN - y = array(i1, i2, i3, i4)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -824,9 +824,9 @@ PURE FUNCTION kahan_sum_c4(array, mask) RESULT(ks) DO i3 = 1, SIZE(array, 3) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2, i3, i4)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO @@ -859,9 +859,9 @@ PURE FUNCTION kahan_sum_z4(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2, i3, i4)) THEN - y = array(i1, i2, i3, i4)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -873,9 +873,9 @@ PURE FUNCTION kahan_sum_z4(array, mask) RESULT(ks) DO i3 = 1, SIZE(array, 3) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2, i3, i4)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO @@ -909,9 +909,9 @@ PURE FUNCTION kahan_sum_s5(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2, i3, i4, i5)) THEN - y = array(i1, i2, i3, i4, i5)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -925,9 +925,9 @@ PURE FUNCTION kahan_sum_s5(array, mask) RESULT(ks) DO i3 = 1, SIZE(array, 3) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2, i3, i4, i5)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO @@ -962,9 +962,9 @@ PURE FUNCTION kahan_sum_d5(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2, i3, i4, i5)) THEN - y = array(i1, i2, i3, i4, i5)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -978,9 +978,9 @@ PURE FUNCTION kahan_sum_d5(array, mask) RESULT(ks) DO i3 = 1, SIZE(array, 3) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2, i3, i4, i5)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO @@ -1015,9 +1015,9 @@ PURE FUNCTION kahan_sum_c5(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2, i3, i4, i5)) THEN - y = array(i1, i2, i3, i4, i5)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -1031,9 +1031,9 @@ PURE FUNCTION kahan_sum_c5(array, mask) RESULT(ks) DO i3 = 1, SIZE(array, 3) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2, i3, i4, i5)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO @@ -1068,9 +1068,9 @@ PURE FUNCTION kahan_sum_z5(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2, i3, i4, i5)) THEN - y = array(i1, i2, i3, i4, i5)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -1084,9 +1084,9 @@ PURE FUNCTION kahan_sum_z5(array, mask) RESULT(ks) DO i3 = 1, SIZE(array, 3) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2, i3, i4, i5)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO @@ -1122,9 +1122,9 @@ PURE FUNCTION kahan_sum_s6(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2, i3, i4, i5, i6)) THEN - y = array(i1, i2, i3, i4, i5, i6)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5, i6) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -1140,9 +1140,9 @@ PURE FUNCTION kahan_sum_s6(array, mask) RESULT(ks) DO i3 = 1, SIZE(array, 3) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2, i3, i4, i5, i6)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5, i6) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO @@ -1179,9 +1179,9 @@ PURE FUNCTION kahan_sum_d6(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2, i3, i4, i5, i6)) THEN - y = array(i1, i2, i3, i4, i5, i6)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5, i6) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -1197,9 +1197,9 @@ PURE FUNCTION kahan_sum_d6(array, mask) RESULT(ks) DO i3 = 1, SIZE(array, 3) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2, i3, i4, i5, i6)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5, i6) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO @@ -1236,9 +1236,9 @@ PURE FUNCTION kahan_sum_c6(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2, i3, i4, i5, i6)) THEN - y = array(i1, i2, i3, i4, i5, i6)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5, i6) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -1254,9 +1254,9 @@ PURE FUNCTION kahan_sum_c6(array, mask) RESULT(ks) DO i3 = 1, SIZE(array, 3) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2, i3, i4, i5, i6)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5, i6) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO @@ -1293,9 +1293,9 @@ PURE FUNCTION kahan_sum_z6(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2, i3, i4, i5, i6)) THEN - y = array(i1, i2, i3, i4, i5, i6)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5, i6) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -1311,9 +1311,9 @@ PURE FUNCTION kahan_sum_z6(array, mask) RESULT(ks) DO i3 = 1, SIZE(array, 3) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2, i3, i4, i5, i6)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5, i6) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO @@ -1351,9 +1351,9 @@ PURE FUNCTION kahan_sum_s7(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2, i3, i4, i5, i6, i7)) THEN - y = array(i1, i2, i3, i4, i5, i6, i7)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5, i6, i7) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -1371,9 +1371,9 @@ PURE FUNCTION kahan_sum_s7(array, mask) RESULT(ks) DO i3 = 1, SIZE(array, 3) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2, i3, i4, i5, i6, i7)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5, i6, i7) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO @@ -1412,9 +1412,9 @@ PURE FUNCTION kahan_sum_d7(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2, i3, i4, i5, i6, i7)) THEN - y = array(i1, i2, i3, i4, i5, i6, i7)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5, i6, i7) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -1432,9 +1432,9 @@ PURE FUNCTION kahan_sum_d7(array, mask) RESULT(ks) DO i3 = 1, SIZE(array, 3) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2, i3, i4, i5, i6, i7)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5, i6, i7) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO @@ -1473,9 +1473,9 @@ PURE FUNCTION kahan_sum_c7(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2, i3, i4, i5, i6, i7)) THEN - y = array(i1, i2, i3, i4, i5, i6, i7)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5, i6, i7) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -1493,9 +1493,9 @@ PURE FUNCTION kahan_sum_c7(array, mask) RESULT(ks) DO i3 = 1, SIZE(array, 3) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2, i3, i4, i5, i6, i7)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5, i6, i7) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO @@ -1534,9 +1534,9 @@ PURE FUNCTION kahan_sum_z7(array, mask) RESULT(ks) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) IF (mask(i1, i2, i3, i4, i5, i6, i7)) THEN - y = array(i1, i2, i3, i4, i5, i6, i7)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5, i6, i7) - c + t = ks + y + c = (t - ks) - y ks = t END IF ENDDO @@ -1554,9 +1554,9 @@ PURE FUNCTION kahan_sum_z7(array, mask) RESULT(ks) DO i3 = 1, SIZE(array, 3) DO i2 = 1, SIZE(array, 2) DO i1 = 1, SIZE(array, 1) - y = array(i1, i2, i3, i4, i5, i6, i7)-c - t = ks+y - c = (t-ks)-y + y = array(i1, i2, i3, i4, i5, i6, i7) - c + t = ks + y + c = (t - ks) - y ks = t ENDDO ENDDO diff --git a/src/common/lebedev.F b/src/common/lebedev.F index cd0604cfed..af27e431db 100644 --- a/src/common/lebedev.F +++ b/src/common/lebedev.F @@ -190,8 +190,8 @@ SUBROUTINE load_sub_grid(subsystem, lgnum, np) -one, zero, zero/), (/3, na1/)) nlgp = na1 CASE ("A2") - lebedev_grid(lgnum)%w(nlgp+1:nlgp+na2) = w(1) - lebedev_grid(lgnum)%r(1:3, nlgp+1:nlgp+na2) = & + lebedev_grid(lgnum)%w(nlgp + 1:nlgp + na2) = w(1) + lebedev_grid(lgnum)%r(1:3, nlgp + 1:nlgp + na2) = & RESHAPE((/zero, rs2, rs2, & zero, rs2, -rs2, & zero, -rs2, rs2, & @@ -204,10 +204,10 @@ SUBROUTINE load_sub_grid(subsystem, lgnum, np) rs2, -rs2, zero, & -rs2, rs2, zero, & -rs2, -rs2, zero/), (/3, na2/)) - nlgp = nlgp+na2 + nlgp = nlgp + na2 CASE ("A3") - lebedev_grid(lgnum)%w(nlgp+1:nlgp+na3) = w(1) - lebedev_grid(lgnum)%r(1:3, nlgp+1:nlgp+na3) = & + lebedev_grid(lgnum)%w(nlgp + 1:nlgp + na3) = w(1) + lebedev_grid(lgnum)%r(1:3, nlgp + 1:nlgp + na3) = & RESHAPE((/rs3, rs3, rs3, & rs3, rs3, -rs3, & rs3, -rs3, rs3, & @@ -216,13 +216,13 @@ SUBROUTINE load_sub_grid(subsystem, lgnum, np) -rs3, rs3, -rs3, & -rs3, -rs3, rs3, & -rs3, -rs3, -rs3/), (/3, na3/)) - nlgp = nlgp+na3 + nlgp = nlgp + na3 CASE ("B") DO i = 1, np x = r(i) - y = rs2*SQRT(one-x**2) - lebedev_grid(lgnum)%w(nlgp+nb*(i-1)+1:nlgp+nb*i) = w(i) - lebedev_grid(lgnum)%r(1:3, nlgp+nb*(i-1)+1:nlgp+nb*i) = & + y = rs2*SQRT(one - x**2) + lebedev_grid(lgnum)%w(nlgp + nb*(i - 1) + 1:nlgp + nb*i) = w(i) + lebedev_grid(lgnum)%r(1:3, nlgp + nb*(i - 1) + 1:nlgp + nb*i) = & RESHAPE((/x, y, y, & x, y, -y, & x, -y, y, & @@ -248,13 +248,13 @@ SUBROUTINE load_sub_grid(subsystem, lgnum, np) -y, y, -x, & -y, -y, -x/), (/3, nb/)) END DO - nlgp = nlgp+nb*np + nlgp = nlgp + nb*np CASE ("C") DO i = 1, np x = r(i) - y = SQRT(one-x**2) - lebedev_grid(lgnum)%w(nlgp+nc*(i-1)+1:nlgp+nc*i) = w(i) - lebedev_grid(lgnum)%r(1:3, nlgp+nc*(i-1)+1:nlgp+nc*i) = & + y = SQRT(one - x**2) + lebedev_grid(lgnum)%w(nlgp + nc*(i - 1) + 1:nlgp + nc*i) = w(i) + lebedev_grid(lgnum)%r(1:3, nlgp + nc*(i - 1) + 1:nlgp + nc*i) = & RESHAPE((/x, y, zero, & x, -y, zero, & -x, y, zero, & @@ -280,16 +280,16 @@ SUBROUTINE load_sub_grid(subsystem, lgnum, np) zero, -y, x, & zero, -y, -x/), (/3, nc/)) END DO - nlgp = nlgp+nc*np + nlgp = nlgp + nc*np CASE ("D") IF (MODULO(np, 3) == 0) THEN DO i = 1, np, 3 - j = (i+2)/3 + j = (i + 2)/3 x = r(i) - y = r(i+1) - z = r(i+2) - lebedev_grid(lgnum)%w(nlgp+nd*(j-1)+1:nlgp+nd*j) = w(j) - lebedev_grid(lgnum)%r(1:3, nlgp+nd*(j-1)+1:nlgp+nd*j) = & + y = r(i + 1) + z = r(i + 2) + lebedev_grid(lgnum)%w(nlgp + nd*(j - 1) + 1:nlgp + nd*j) = w(j) + lebedev_grid(lgnum)%r(1:3, nlgp + nd*(j - 1) + 1:nlgp + nd*j) = & RESHAPE((/x, y, z, x, y, -z, x, -y, z, -x, y, z, & x, -y, -z, -x, y, -z, -x, -y, z, -x, -y, -z, & x, z, y, x, z, -y, x, -z, y, -x, z, y, & @@ -306,7 +306,7 @@ SUBROUTINE load_sub_grid(subsystem, lgnum, np) ELSE CPABORT("Subsytem D: np is not modulo 3 (check argument #3)") END IF - nlgp = nlgp+nd*np/3 + nlgp = nlgp + nd*np/3 CASE DEFAULT CALL cp_abort(__LOCATION__, & "The invalid subsystem <"//TRIM(subsystem)//"> was "// & @@ -420,7 +420,7 @@ SUBROUTINE init_lebedev_grids() CALL load_sub_grid("A3", 4, 0) w(1) = 1.0_dp/35.0_dp - r(1) = rs2*SQRT(1.0_dp+rs3) + r(1) = rs2*SQRT(1.0_dp + rs3) CALL load_sub_grid("C", 4, 1) ! *** 5. l = 11 (50 points) *** diff --git a/src/common/mathconstants.F b/src/common/mathconstants.F index 0df83d6043..2aafcd9741 100644 --- a/src/common/mathconstants.F +++ b/src/common/mathconstants.F @@ -56,7 +56,7 @@ MODULE mathconstants 0.16117375710961183490E-23_dp, 0.64469502843844733962E-25_dp, 0.24795962632247974601E-26_dp, & 0.91836898637955461484E-28_dp, 0.32798892370698379102E-29_dp, 0.11309962886447716932E-30_dp, & 0.37699876288159056439E-32_dp/) - REAL(KIND=dp), PARAMETER, DIMENSION(-1:2*maxfac+1) :: dfac = (/ & + REAL(KIND=dp), PARAMETER, DIMENSION(-1:2*maxfac + 1) :: dfac = (/ & 0.10000000000000000000E+01_dp, 0.10000000000000000000E+01_dp, 0.10000000000000000000E+01_dp, & 0.20000000000000000000E+01_dp, 0.30000000000000000000E+01_dp, 0.80000000000000000000E+01_dp, & 0.15000000000000000000E+02_dp, 0.48000000000000000000E+02_dp, 0.10500000000000000000E+03_dp, & diff --git a/src/common/mathlib.F b/src/common/mathlib.F index d1de7799e2..1966c09fc5 100644 --- a/src/common/mathlib.F +++ b/src/common/mathlib.F @@ -118,20 +118,20 @@ FUNCTION pswitch(x, a, b, order) RESULT(fx) END IF ELSE ! renormalized coordinate - u = (x-a)/(b-a) + u = (x - a)/(b - a) SELECT CASE (order) CASE (0) u2 = u*u u3 = u2*u - fx = 1._dp-10._dp*u3+15._dp*u2*u2-6._dp*u2*u3 + fx = 1._dp - 10._dp*u3 + 15._dp*u2*u2 - 6._dp*u2*u3 CASE (1) u2 = u*u - fx = -30._dp*u2+60._dp*u*u2-30._dp*u2*u2 - fx = fx/(b-a) + fx = -30._dp*u2 + 60._dp*u*u2 - 30._dp*u2*u2 + fx = fx/(b - a) CASE (2) u2 = u*u - fx = -60._dp*u+180._dp*u2-120._dp*u*u2 - fx = fx/(b-a)**2 + fx = -60._dp*u + 180._dp*u2 - 120._dp*u*u2 + fx = fx/(b - a)**2 CASE DEFAULT CPABORT('order not defined') END SELECT @@ -207,7 +207,7 @@ FUNCTION binomial(n, k) RESULT(n_over_k) REAL(KIND=dp) :: n_over_k IF ((k >= 0) .AND. (k <= n)) THEN - n_over_k = fac(n)/(fac(n-k)*fac(k)) + n_over_k = fac(n)/(fac(n - k)*fac(k)) ELSE n_over_k = 0.0_dp END IF @@ -261,7 +261,7 @@ SUBROUTINE build_rotmat(phi, a, rotmat) REAL(KIND=dp) :: cosp, cost, length_of_a, sinp REAL(KIND=dp), DIMENSION(3) :: d - length_of_a = SQRT(a(1)*a(1)+a(2)*a(2)+a(3)*a(3)) + length_of_a = SQRT(a(1)*a(1) + a(2)*a(2) + a(3)*a(3)) ! Check the length of the vector a IF (length_of_a > eps_geo) THEN @@ -269,17 +269,17 @@ SUBROUTINE build_rotmat(phi, a, rotmat) cosp = COS(phi) sinp = SIN(phi) - cost = 1.0_dp-cosp - - rotmat(1, 1) = d(1)*d(1)*cost+cosp - rotmat(1, 2) = d(1)*d(2)*cost-d(3)*sinp - rotmat(1, 3) = d(1)*d(3)*cost+d(2)*sinp - rotmat(2, 1) = d(2)*d(1)*cost+d(3)*sinp - rotmat(2, 2) = d(2)*d(2)*cost+cosp - rotmat(2, 3) = d(2)*d(3)*cost-d(1)*sinp - rotmat(3, 1) = d(3)*d(1)*cost-d(2)*sinp - rotmat(3, 2) = d(3)*d(2)*cost+d(1)*sinp - rotmat(3, 3) = d(3)*d(3)*cost+cosp + cost = 1.0_dp - cosp + + rotmat(1, 1) = d(1)*d(1)*cost + cosp + rotmat(1, 2) = d(1)*d(2)*cost - d(3)*sinp + rotmat(1, 3) = d(1)*d(3)*cost + d(2)*sinp + rotmat(2, 1) = d(2)*d(1)*cost + d(3)*sinp + rotmat(2, 2) = d(2)*d(2)*cost + cosp + rotmat(2, 3) = d(2)*d(3)*cost - d(1)*sinp + rotmat(3, 1) = d(3)*d(1)*cost - d(2)*sinp + rotmat(3, 2) = d(3)*d(2)*cost + d(1)*sinp + rotmat(3, 3) = d(3)*d(3)*cost + cosp ELSE CALL unit_matrix(rotmat) END IF @@ -298,9 +298,9 @@ FUNCTION det_3x3_1(a) RESULT(det_a) REAL(KIND=dp), DIMENSION(3, 3), INTENT(IN) :: a REAL(KIND=dp) :: det_a - det_a = a(1, 1)*(a(2, 2)*a(3, 3)-a(2, 3)*a(3, 2))+ & - a(1, 2)*(a(2, 3)*a(3, 1)-a(2, 1)*a(3, 3))+ & - a(1, 3)*(a(2, 1)*a(3, 2)-a(2, 2)*a(3, 1)) + det_a = a(1, 1)*(a(2, 2)*a(3, 3) - a(2, 3)*a(3, 2)) + & + a(1, 2)*(a(2, 3)*a(3, 1) - a(2, 1)*a(3, 3)) + & + a(1, 3)*(a(2, 1)*a(3, 2) - a(2, 2)*a(3, 1)) END FUNCTION det_3x3_1 @@ -318,9 +318,9 @@ FUNCTION det_3x3_2(a1, a2, a3) RESULT(det_a) REAL(KIND=dp), DIMENSION(3), INTENT(IN) :: a1, a2, a3 REAL(KIND=dp) :: det_a - det_a = a1(1)*(a2(2)*a3(3)-a3(2)*a2(3))+ & - a2(1)*(a3(2)*a1(3)-a1(2)*a3(3))+ & - a3(1)*(a1(2)*a2(3)-a2(2)*a1(3)) + det_a = a1(1)*(a2(2)*a3(3) - a3(2)*a2(3)) + & + a2(1)*(a3(2)*a1(3) - a1(2)*a3(3)) + & + a3(1)*(a1(2)*a2(3) - a2(2)*a1(3)) END FUNCTION det_3x3_2 @@ -381,11 +381,11 @@ SUBROUTINE diamat_all(a, eigval, dac) ! Get the optimal work storage size IF (divide_and_conquer) THEN - lwork = 2*n**2+6*n+1 - liwork = 5*n+3 + lwork = 2*n**2 + 6*n + 1 + liwork = 5*n + 3 ELSE nb = ilaenv(1, "DSYTRD", "U", n, -1, -1, -1) - lwork = (nb+2)*n + lwork = (nb + 2)*n END IF ! Allocate work storage @@ -493,17 +493,17 @@ FUNCTION inv_3x3(a) RESULT(a_inv) det_a = 1.0_dp/det_3x3(a) - a_inv(1, 1) = (a(2, 2)*a(3, 3)-a(3, 2)*a(2, 3))*det_a - a_inv(2, 1) = (a(2, 3)*a(3, 1)-a(3, 3)*a(2, 1))*det_a - a_inv(3, 1) = (a(2, 1)*a(3, 2)-a(3, 1)*a(2, 2))*det_a + a_inv(1, 1) = (a(2, 2)*a(3, 3) - a(3, 2)*a(2, 3))*det_a + a_inv(2, 1) = (a(2, 3)*a(3, 1) - a(3, 3)*a(2, 1))*det_a + a_inv(3, 1) = (a(2, 1)*a(3, 2) - a(3, 1)*a(2, 2))*det_a - a_inv(1, 2) = (a(1, 3)*a(3, 2)-a(3, 3)*a(1, 2))*det_a - a_inv(2, 2) = (a(1, 1)*a(3, 3)-a(3, 1)*a(1, 3))*det_a - a_inv(3, 2) = (a(1, 2)*a(3, 1)-a(3, 2)*a(1, 1))*det_a + a_inv(1, 2) = (a(1, 3)*a(3, 2) - a(3, 3)*a(1, 2))*det_a + a_inv(2, 2) = (a(1, 1)*a(3, 3) - a(3, 1)*a(1, 3))*det_a + a_inv(3, 2) = (a(1, 2)*a(3, 1) - a(3, 2)*a(1, 1))*det_a - a_inv(1, 3) = (a(1, 2)*a(2, 3)-a(2, 2)*a(1, 3))*det_a - a_inv(2, 3) = (a(1, 3)*a(2, 1)-a(2, 3)*a(1, 1))*det_a - a_inv(3, 3) = (a(1, 1)*a(2, 2)-a(2, 1)*a(1, 2))*det_a + a_inv(1, 3) = (a(1, 2)*a(2, 3) - a(2, 2)*a(1, 3))*det_a + a_inv(2, 3) = (a(1, 3)*a(2, 1) - a(2, 3)*a(1, 1))*det_a + a_inv(3, 3) = (a(1, 1)*a(2, 2) - a(2, 1)*a(1, 2))*det_a END FUNCTION inv_3x3 @@ -580,12 +580,12 @@ SUBROUTINE invmat_symm(a, cholesky_triangle) END IF IF (my_triangle == "U") THEN - DO i = 1, n-1 - a(i+1:n, i) = a(i, i+1:n) + DO i = 1, n - 1 + a(i + 1:n, i) = a(i, i + 1:n) ENDDO ELSE - DO i = 1, n-1 - a(i, i+1:n) = a(i+1:n, i) + DO i = 1, n - 1 + a(i, i + 1:n) = a(i + 1:n, i) ENDDO ENDIF @@ -744,7 +744,7 @@ SUBROUTINE invert_matrix_d(a, a_inverse, eval_error, option, improve) old_eval_error = eval_error eval_error = MAXVAL(ferr) - IF (ABS(eval_error-old_eval_error) <= EPSILON(1.0_dp)) EXIT + IF (ABS(eval_error - old_eval_error) <= EPSILON(1.0_dp)) EXIT END DO ENDIF @@ -901,7 +901,7 @@ SUBROUTINE invert_matrix_z(a, a_inverse, eval_error, option) old_eval_error = eval_error eval_error = MAXVAL(ferr) - IF (ABS(eval_error-old_eval_error) <= EPSILON(1.0_dp)) EXIT + IF (ABS(eval_error - old_eval_error) <= EPSILON(1.0_dp)) EXIT END DO @@ -1086,16 +1086,16 @@ FUNCTION reflect_vector(a, b) RESULT(a_mirror) REAL(KIND=dp) :: length_of_b, scapro REAL(KIND=dp), DIMENSION(3) :: d - length_of_b = SQRT(b(1)*b(1)+b(2)*b(2)+b(3)*b(3)) + length_of_b = SQRT(b(1)*b(1) + b(2)*b(2) + b(3)*b(3)) IF (length_of_b > eps_geo) THEN d(:) = b(:)/length_of_b ! Calculate the mirror image a_mirror of the vector a - scapro = a(1)*d(1)+a(2)*d(2)+a(3)*d(3) + scapro = a(1)*d(1) + a(2)*d(2) + a(3)*d(3) - a_mirror(:) = a(:)-2.0_dp*scapro*d(:) + a_mirror(:) = a(:) - 2.0_dp*scapro*d(:) ELSE @@ -1126,7 +1126,7 @@ FUNCTION rotate_vector(a, phi, b) RESULT(a_rot) REAL(KIND=dp) :: length_of_b REAL(KIND=dp), DIMENSION(3, 3) :: rotmat - length_of_b = SQRT(b(1)*b(1)+b(2)*b(2)+b(3)*b(3)) + length_of_b = SQRT(b(1)*b(1) + b(2)*b(2) + b(3)*b(3)) IF (length_of_b > eps_geo) THEN ! Build up the rotation matrix rotmat @@ -1202,20 +1202,20 @@ SUBROUTINE symmetrize_matrix(a, option) n = MIN(SIZE(a, 1), SIZE(a, 2)) IF (option == "lower_to_upper") THEN - DO i = 1, n-1 - a(i, i+1:n) = a(i+1:n, i) + DO i = 1, n - 1 + a(i, i + 1:n) = a(i + 1:n, i) END DO ELSE IF (option == "upper_to_lower") THEN - DO i = 1, n-1 - a(i+1:n, i) = a(i, i+1:n) + DO i = 1, n - 1 + a(i + 1:n, i) = a(i, i + 1:n) END DO ELSE IF (option == "anti_lower_to_upper") THEN - DO i = 1, n-1 - a(i, i+1:n) = -a(i+1:n, i) + DO i = 1, n - 1 + a(i, i + 1:n) = -a(i + 1:n, i) END DO ELSE IF (option == "anti_upper_to_lower") THEN - DO i = 1, n-1 - a(i+1:n, i) = -a(i, i+1:n) + DO i = 1, n - 1 + a(i + 1:n, i) = -a(i, i + 1:n) END DO ELSE CPABORT("Invalid option <"//TRIM(option)//"> was specified for parameter #2") @@ -1263,9 +1263,9 @@ PURE FUNCTION vector_product(a, b) RESULT(c) REAL(KIND=dp), DIMENSION(3), INTENT(IN) :: a, b REAL(KIND=dp), DIMENSION(3) :: c - c(1) = a(2)*b(3)-a(3)*b(2) - c(2) = a(3)*b(1)-a(1)*b(3) - c(3) = a(1)*b(2)-a(2)*b(1) + c(1) = a(2)*b(3) - a(3)*b(2) + c(2) = a(3)*b(1) - a(1)*b(3) + c(3) = a(1)*b(2) - a(2)*b(1) END FUNCTION vector_product @@ -1349,17 +1349,17 @@ FUNCTION ei(x) END IF IF (x < fpmin) THEN - ei = LOG(x)+euler + ei = LOG(x) + euler ELSE IF (x <= -LOG(EPS)) THEN sum1 = 0._dp fact = 1._dp DO k = 1, maxit fact = fact*x/REAL(k, dp) term = fact/REAL(k, dp) - sum1 = sum1+term + sum1 = sum1 + term IF (term < eps*sum1) EXIT END DO - ei = sum1+LOG(x)+euler + ei = sum1 + LOG(x) + euler ELSE sum1 = 0._dp term = 1._dp @@ -1368,13 +1368,13 @@ FUNCTION ei(x) term = term*REAL(k, dp)/x IF (term < eps) EXIT IF (term < prev) THEN - sum1 = sum1+term + sum1 = sum1 + term ELSE - sum1 = sum1-prev + sum1 = sum1 - prev EXIT END IF END DO - ei = EXP(x)*(1._dp+sum1)/x + ei = EXP(x)*(1._dp + sum1)/x END IF END FUNCTION ei @@ -1389,15 +1389,15 @@ FUNCTION matmul_3x3(mat1, mat2) REAL(KIND=dp), DIMENSION(3, 3), INTENT(IN) :: mat1, mat2 REAL(KIND=dp), DIMENSION(3, 3) :: matmul_3x3 - matmul_3x3(1, 1) = mat1(1, 1)*mat2(1, 1)+mat1(1, 2)*mat2(2, 1)+mat1(1, 3)*mat2(3, 1) - matmul_3x3(1, 2) = mat1(1, 1)*mat2(1, 2)+mat1(1, 2)*mat2(2, 2)+mat1(1, 3)*mat2(3, 2) - matmul_3x3(1, 3) = mat1(1, 1)*mat2(1, 3)+mat1(1, 2)*mat2(2, 3)+mat1(1, 3)*mat2(3, 3) - matmul_3x3(2, 1) = mat1(2, 1)*mat2(1, 1)+mat1(2, 2)*mat2(2, 1)+mat1(2, 3)*mat2(3, 1) - matmul_3x3(2, 2) = mat1(2, 1)*mat2(1, 2)+mat1(2, 2)*mat2(2, 2)+mat1(2, 3)*mat2(3, 2) - matmul_3x3(2, 3) = mat1(2, 1)*mat2(1, 3)+mat1(2, 2)*mat2(2, 3)+mat1(2, 3)*mat2(3, 3) - matmul_3x3(3, 1) = mat1(3, 1)*mat2(1, 1)+mat1(3, 2)*mat2(2, 1)+mat1(3, 3)*mat2(3, 1) - matmul_3x3(3, 2) = mat1(3, 1)*mat2(1, 2)+mat1(3, 2)*mat2(2, 2)+mat1(3, 3)*mat2(3, 2) - matmul_3x3(3, 3) = mat1(3, 1)*mat2(1, 3)+mat1(3, 2)*mat2(2, 3)+mat1(3, 3)*mat2(3, 3) + matmul_3x3(1, 1) = mat1(1, 1)*mat2(1, 1) + mat1(1, 2)*mat2(2, 1) + mat1(1, 3)*mat2(3, 1) + matmul_3x3(1, 2) = mat1(1, 1)*mat2(1, 2) + mat1(1, 2)*mat2(2, 2) + mat1(1, 3)*mat2(3, 2) + matmul_3x3(1, 3) = mat1(1, 1)*mat2(1, 3) + mat1(1, 2)*mat2(2, 3) + mat1(1, 3)*mat2(3, 3) + matmul_3x3(2, 1) = mat1(2, 1)*mat2(1, 1) + mat1(2, 2)*mat2(2, 1) + mat1(2, 3)*mat2(3, 1) + matmul_3x3(2, 2) = mat1(2, 1)*mat2(1, 2) + mat1(2, 2)*mat2(2, 2) + mat1(2, 3)*mat2(3, 2) + matmul_3x3(2, 3) = mat1(2, 1)*mat2(1, 3) + mat1(2, 2)*mat2(2, 3) + mat1(2, 3)*mat2(3, 3) + matmul_3x3(3, 1) = mat1(3, 1)*mat2(1, 1) + mat1(3, 2)*mat2(2, 1) + mat1(3, 3)*mat2(3, 1) + matmul_3x3(3, 2) = mat1(3, 1)*mat2(1, 2) + mat1(3, 2)*mat2(2, 2) + mat1(3, 3)*mat2(3, 2) + matmul_3x3(3, 3) = mat1(3, 1)*mat2(1, 3) + mat1(3, 2)*mat2(2, 3) + mat1(3, 3)*mat2(3, 3) END FUNCTION matmul_3x3 ! ************************************************************************************************** @@ -1411,9 +1411,9 @@ SUBROUTINE matvec_3x3(res, mat, vec) REAL(KIND=dp), DIMENSION(3, 3), INTENT(IN) :: mat REAL(KIND=dp), DIMENSION(3), INTENT(IN) :: vec - res(1) = mat(1, 1)*vec(1)+mat(1, 2)*vec(2)+mat(1, 3)*vec(3) - res(2) = mat(2, 1)*vec(1)+mat(2, 2)*vec(2)+mat(2, 3)*vec(3) - res(3) = mat(3, 1)*vec(1)+mat(3, 2)*vec(2)+mat(3, 3)*vec(3) + res(1) = mat(1, 1)*vec(1) + mat(1, 2)*vec(2) + mat(1, 3)*vec(3) + res(2) = mat(2, 1)*vec(1) + mat(2, 2)*vec(2) + mat(2, 3)*vec(3) + res(3) = mat(3, 1)*vec(1) + mat(3, 2)*vec(2) + mat(3, 3)*vec(3) END SUBROUTINE matvec_3x3 ! ************************************************************************************************** @@ -1428,8 +1428,8 @@ FUNCTION dotprod_3d(vec1, vec2) dotprod_3d = & vec1(1)*vec2(1) & - +vec1(2)*vec2(2) & - +vec1(3)*vec2(3) + + vec1(2)*vec2(2) & + + vec1(3)*vec2(3) END FUNCTION dotprod_3d ! ************************************************************************************************** @@ -1473,7 +1473,7 @@ FUNCTION expint(n, x) INTEGER :: i, ii, nm1 REAL(dp) :: a, b, c, d, del, fact, h, psi - nm1 = n-1 + nm1 = n - 1 IF (n .LT. 0 .OR. x .LT. 0.0_dp .OR. (x .EQ. 0.0_dp .AND. (n .EQ. 0 .OR. n .EQ. 1))) THEN CPABORT("Invalid argument") @@ -1482,18 +1482,18 @@ FUNCTION expint(n, x) ELSE IF (x .EQ. 0.0_dp) THEN !Another special case. expint = 1.0_dp/nm1 ELSE IF (x .GT. 1.0_dp) THEN !Lentz's algorithm (5.2). - b = x+n + b = x + n c = 1.0_dp/FPMIN d = 1.0_dp/b h = d DO i = 1, MAXIT - a = -i*(nm1+i) - b = b+2.0_dp - d = 1.0_dp/(a*d+b) - c = b+a/c + a = -i*(nm1 + i) + b = b + 2.0_dp + d = 1.0_dp/(a*d + b) + c = b + a/c del = c*d h = h*del - IF (ABS(del-1.0_dp) .LT. EPS) THEN + IF (ABS(del - 1.0_dp) .LT. EPS) THEN expint = h*EXP(-x) RETURN END IF @@ -1503,21 +1503,21 @@ FUNCTION expint(n, x) IF (nm1 .NE. 0) THEN !Set first term. expint = 1.0_dp/nm1 ELSE - expint = -LOG(x)-euler + expint = -LOG(x) - euler END IF fact = 1.0_dp DO i = 1, MAXIT fact = -fact*x/i IF (i .NE. nm1) THEN - del = -fact/(i-nm1) + del = -fact/(i - nm1) ELSE psi = -euler !Compute I(n). DO ii = 1, nm1 - psi = psi+1.0_dp/ii + psi = psi + 1.0_dp/ii END DO - del = fact*(-LOG(x)+psi) + del = fact*(-LOG(x) + psi) END IF - expint = expint+del + expint = expint + del IF (ABS(del) .LT. ABS(expint)*EPS) RETURN END DO CPABORT("series failed in expint") @@ -1579,8 +1579,8 @@ SUBROUTINE diag(n, a, d, v) REAL(KIND=dp), DIMENSION(n) :: b, z a_max = 0.0_dp - DO ip = 1, n-1 - a_max = MAX(a_max, MAXVAL(ABS(a(ip, ip+1:n)))) + DO ip = 1, n - 1 + a_max = MAX(a_max, MAXVAL(ABS(a(ip, ip + 1:n)))) b(ip) = a(ip, ip) ! get_diag(a) END DO b(n) = a(n, n) @@ -1594,45 +1594,45 @@ SUBROUTINE diag(n, a, d, v) IF (a_max < a_eps*d_min) RETURN tresh = MERGE(a_max, 0.0_dp, (i < 4)) z = 0.0_dp - DO ip = 1, n-1 - DO iq = ip+1, n + DO ip = 1, n - 1 + DO iq = ip + 1, n dip = d(ip) diq = d(iq) apq = a(ip, iq) g = 100.0_dp*ABS(apq) IF (tresh < ABS(apq)) THEN - h = diq-dip - IF ((ABS(h)+g) .NE. ABS(h)) THEN + h = diq - dip + IF ((ABS(h) + g) .NE. ABS(h)) THEN theta = 0.5_dp*h/apq - t = 1.0_dp/(ABS(theta)+SQRT(1.0_dp+theta**2)) + t = 1.0_dp/(ABS(theta) + SQRT(1.0_dp + theta**2)) IF (theta < 0.0_dp) t = -t ELSE t = apq/h END IF - c = 1.0_dp/SQRT(1.0_dp+t**2) + c = 1.0_dp/SQRT(1.0_dp + t**2) s = t*c - tau = s/(1.0_dp+c) + tau = s/(1.0_dp + c) h = t*apq - z(ip) = z(ip)-h - z(iq) = z(iq)+h - d(ip) = dip-h - d(iq) = diq+h + z(ip) = z(ip) - h + z(iq) = z(iq) + h + d(ip) = dip - h + d(iq) = diq + h a(ip, iq) = 0.0_dp - CALL jrotate(a(1:ip-1, ip), a(1:ip-1, iq), s, tau) - CALL jrotate(a(ip, ip+1:iq-1), a(ip+1:iq-1, iq), s, tau) - CALL jrotate(a(ip, iq+1:n), a(iq, iq+1:n), s, tau) + CALL jrotate(a(1:ip - 1, ip), a(1:ip - 1, iq), s, tau) + CALL jrotate(a(ip, ip + 1:iq - 1), a(ip + 1:iq - 1, iq), s, tau) + CALL jrotate(a(ip, iq + 1:n), a(iq, iq + 1:n), s, tau) CALL jrotate(v(:, ip), v(:, iq), s, tau) ELSE IF ((4 < i) .AND. & - ((ABS(dip)+g) == ABS(dip)) .AND. & - ((ABS(diq)+g) == ABS(diq))) THEN + ((ABS(dip) + g) == ABS(dip)) .AND. & + ((ABS(diq) + g) == ABS(diq))) THEN a(ip, iq) = 0.0_dp END IF END DO END DO - b = b+z + b = b + z a_max = 0.0_dp - DO ip = 1, n-1 - a_max = MAX(a_max, MAXVAL(ABS(a(ip, ip+1:n)))) + DO ip = 1, n - 1 + a_max = MAX(a_max, MAXVAL(ABS(a(ip, ip + 1:n)))) END DO END DO WRITE (*, '(/,T2,A,/)') 'Too many iterations in jacobi' @@ -1655,11 +1655,11 @@ SUBROUTINE jrotate(a, b, ss, tt) REAL(KIND=dp) :: u, v - u = 1.0_dp-ss*tt + u = 1.0_dp - ss*tt v = ss/u - a = a*u-b*ss - b = b*(u+ss*v)+a*v + a = a*u - b*ss + b = b*(u + ss*v) + a*v END SUBROUTINE jrotate @@ -1680,8 +1680,8 @@ SUBROUTINE eigsrt(n, d, v) INTEGER :: i, j - DO i = 1, n-1 - j = SUM(MINLOC(d(i:n)))+i-1 + DO i = 1, n - 1 + j = SUM(MINLOC(d(i:n))) + i - 1 IF (j /= i) THEN CALL swap(d(i), d(j)) CALL swap(v(:, i), v(:, j)) @@ -1771,7 +1771,7 @@ SUBROUTINE erfc_cutoff(eps, omg, r_cutoff) DO iter = 1, iterMAX delta_r = f0/fprime0 - r0 = r0-delta_r + r0 = r0 - delta_r CALL eval_transc_func(r0, eps, omg, f0, fprime0) IF (ABS(delta_r) .LT. abstol .OR. ABS(f0) .LT. soltol) EXIT END DO @@ -1792,8 +1792,8 @@ SUBROUTINE eval_transc_func(r, eps, omega, fn, df) REAL(dp), INTENT(in) :: r, eps, omega REAL(dp), INTENT(out) :: fn, df - fn = erfc(omega*r)-r*eps - df = -omega*2*EXP(-omega**2*r**2)/SQRT(pi)-eps + fn = erfc(omega*r) - r*eps + df = -omega*2*EXP(-omega**2*r**2)/SQRT(pi) - eps END SUBROUTINE eval_transc_func END SUBROUTINE erfc_cutoff diff --git a/src/common/parallel_rng_types.F b/src/common/parallel_rng_types.F index c04b4a6f4a..57f12713bb 100644 --- a/src/common/parallel_rng_types.F +++ b/src/common/parallel_rng_types.F @@ -273,34 +273,34 @@ SUBROUTINE check_rng(output_unit, ionode) CALL write_rng_stream(g3, output_unit) END IF - sum = next_random_number(g2)+next_random_number(g3) + sum = next_random_number(g2) + next_random_number(g3) CALL advance_rng_state(g1, 5, 3) - sum = sum+next_random_number(g1) + sum = sum + next_random_number(g1) CALL reset_rng_stream(g1) DO i = 1, 35 CALL advance_rng_state(g1, 0, 1) END DO - sum = sum+next_random_number(g1) + sum = sum + next_random_number(g1) CALL reset_rng_stream(g1) sumi = 0 DO i = 1, 35 - sumi = sumi+next_random_number(g1, 1, 10) + sumi = sumi + next_random_number(g1, 1, 10) END DO - sum = sum+sumi/100.0_dp + sum = sum + sumi/100.0_dp sum3 = 0.0_dp DO i = 1, 100 - sum3 = sum3+next_random_number(g3) + sum3 = sum3 + next_random_number(g3) END DO - sum = sum+sum3/10.0_dp + sum = sum + sum3/10.0_dp CALL reset_rng_stream(g3) DO i = 1, 5 - sum = sum+next_random_number(g3) + sum = sum + next_random_number(g3) END DO CALL reset_rng_stream(g3) @@ -308,27 +308,27 @@ SUBROUTINE check_rng(output_unit, ionode) CALL reset_to_next_rng_substream(g3) END DO DO i = 1, 5 - sum = sum+next_random_number(g3) + sum = sum + next_random_number(g3) END DO CALL reset_rng_substream(g3) DO i = 1, 5 - sum = sum+next_random_number(g3) + sum = sum + next_random_number(g3) END DO CALL reset_to_next_rng_substream(g2) sum3 = 0.0_dp DO i = 1, 100000 - sum3 = sum3+next_random_number(g2) + sum3 = sum3 + next_random_number(g2) END DO - sum = sum+sum3/10000.0_dp + sum = sum + sum3/10000.0_dp CALL set_rng_stream(g3, antithetic=.TRUE.) sum3 = 0.0_dp DO i = 1, 100000 - sum3 = sum3+next_random_number(g3) + sum3 = sum3 + next_random_number(g3) END DO - sum = sum+sum3/10000.0_dp + sum = sum + sum3/10000.0_dp IF (ionode) THEN WRITE (UNIT=output_unit, FMT="(/,T2,A)") & @@ -371,34 +371,34 @@ SUBROUTINE check_rng(output_unit, ionode) CALL write_rng_stream(cantor, output_unit) END IF - sum = sum+next_random_number(poisson)+ & - next_random_number(laplace)+ & - next_random_number(galois)+ & + sum = sum + next_random_number(poisson) + & + next_random_number(laplace) + & + next_random_number(galois) + & next_random_number(cantor) CALL advance_rng_state(galois, -127, 0) - sum = sum+next_random_number(galois) + sum = sum + next_random_number(galois) CALL reset_to_next_rng_substream(galois) CALL set_rng_stream(galois, extended_precision=.TRUE.) sum3 = 0.0_dp DO i = 1, 100000 - sum3 = sum3+next_random_number(galois) + sum3 = sum3 + next_random_number(galois) END DO - sum = sum+sum3/10000.0_dp + sum = sum + sum3/10000.0_dp CALL set_rng_stream(galois, antithetic=.TRUE.) sum3 = 0.0_dp DO i = 1, 100000 - sum3 = sum3+next_random_number(galois) + sum3 = sum3 + next_random_number(galois) END DO - sum = sum+sum3/10000.0_dp + sum = sum + sum3/10000.0_dp CALL set_rng_stream(galois, antithetic=.FALSE.) CALL set_rng_stream(galois, extended_precision=.FALSE.) - sum = sum+next_random_number(poisson)+ & - next_random_number(laplace)+ & - next_random_number(galois)+ & + sum = sum + next_random_number(poisson) + & + next_random_number(laplace) + & + next_random_number(galois) + & next_random_number(cantor) IF (ionode) THEN @@ -937,18 +937,18 @@ SUBROUTINE mat_vec_mod_m(a, s, v, m) DO j = 1, 3 a2 = a(i, j) c = v(i) - v(i) = a2*s(j)+c + v(i) = a2*s(j) + c IF ((v(i) >= two53) .OR. (v(i) <= -two53)) THEN a1 = INT(a2/two17) - a2 = a2-a1*two17 + a2 = a2 - a1*two17 v(i) = a1*s(j) a1 = INT(v(i)/m) - v(i) = v(i)-a1*m - v(i) = v(i)*two17+a2*s(j)+c + v(i) = v(i) - a1*m + v(i) = v(i)*two17 + a2*s(j) + c END IF a1 = INT(v(i)/m) - v(i) = v(i)-a1*m - IF (v(i) < 0.0_dp) v(i) = v(i)+m + v(i) = v(i) - a1*m + IF (v(i) < 0.0_dp) v(i) = v(i) + m END DO END DO @@ -981,7 +981,7 @@ FUNCTION next_integer_random_number(rng_stream, low, high) RESULT(u) CPASSERT(rng_stream%distribution_type == UNIFORM) r = next_real_random_number(rng_stream) - u = low+INT(r*REAL(high-low+1, dp)) + u = low + INT(r*REAL(high - low + 1, dp)) END FUNCTION next_integer_random_number @@ -1020,13 +1020,13 @@ FUNCTION next_real_random_number(rng_stream, variance) RESULT(u) ELSE DO IF (rng_stream%extended_precision) THEN - u1 = 2.0_dp*rn53(rng_stream)-1.0_dp - u2 = 2.0_dp*rn53(rng_stream)-1.0_dp + u1 = 2.0_dp*rn53(rng_stream) - 1.0_dp + u2 = 2.0_dp*rn53(rng_stream) - 1.0_dp ELSE - u1 = 2.0_dp*rn32(rng_stream)-1.0_dp - u2 = 2.0_dp*rn32(rng_stream)-1.0_dp + u1 = 2.0_dp*rn32(rng_stream) - 1.0_dp + u2 = 2.0_dp*rn32(rng_stream) - 1.0_dp END IF - r = u1*u1+u2*u2 + r = u1*u1 + u2*u2 IF ((r > 0.0_dp) .AND. (r < 1.0_dp)) EXIT END DO ! Box-Muller transformation @@ -1279,20 +1279,20 @@ FUNCTION rn32(rng_stream) RESULT(u) ! ------------------------------------------------------------------------- ! Component 1 - p1 = a12*rng_stream%cg(2, 1)-a13n*rng_stream%cg(1, 1) + p1 = a12*rng_stream%cg(2, 1) - a13n*rng_stream%cg(1, 1) k = INT(p1/m1) - p1 = p1-k*m1 - IF (p1 < 0.0_dp) p1 = p1+m1 + p1 = p1 - k*m1 + IF (p1 < 0.0_dp) p1 = p1 + m1 rng_stream%cg(1, 1) = rng_stream%cg(2, 1) rng_stream%cg(2, 1) = rng_stream%cg(3, 1) rng_stream%cg(3, 1) = p1 ! Component 2 - p2 = a21*rng_stream%cg(3, 2)-a23n*rng_stream%cg(1, 2) + p2 = a21*rng_stream%cg(3, 2) - a23n*rng_stream%cg(1, 2) k = INT(p2/m2) - p2 = p2-k*m2 - IF (p2 < 0.0_dp) p2 = p2+m2 + p2 = p2 - k*m2 + IF (p2 < 0.0_dp) p2 = p2 + m2 rng_stream%cg(1, 2) = rng_stream%cg(2, 2) rng_stream%cg(2, 2) = rng_stream%cg(3, 2) rng_stream%cg(3, 2) = p2 @@ -1300,12 +1300,12 @@ FUNCTION rn32(rng_stream) RESULT(u) ! Combination IF (p1 > p2) THEN - u = (p1-p2)*norm + u = (p1 - p2)*norm ELSE - u = (p1-p2+m1)*norm + u = (p1 - p2 + m1)*norm END IF - IF (rng_stream%antithetic) u = 1.0_dp-u + IF (rng_stream%antithetic) u = 1.0_dp - u END FUNCTION rn32 @@ -1328,11 +1328,11 @@ FUNCTION rn53(rng_stream) RESULT(u) ! Note: rn32 returns 1 - u in the antithetic case IF (rng_stream%antithetic) THEN - u = u+(rn32(rng_stream)-1.0_dp)*fact - IF (u < 0.0_dp) u = u+1.0_dp + u = u + (rn32(rng_stream) - 1.0_dp)*fact + IF (u < 0.0_dp) u = u + 1.0_dp ELSE - u = u+rn32(rng_stream)*fact - IF (u >= 1.0_dp) u = u-1.0_dp + u = u + rn32(rng_stream)*fact + IF (u >= 1.0_dp) u = u - 1.0_dp END IF END FUNCTION rn53 diff --git a/src/common/powell.F b/src/common/powell.F index 76701afe99..1284ddaabc 100644 --- a/src/common/powell.F +++ b/src/common/powell.F @@ -9,30 +9,30 @@ MODULE powell USE mathconstants, ONLY: twopi #include "../base/base_uses.f90" - IMPLICIT NONE + IMPLICIT NONE CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'powell' - TYPE opt_state_type - INTEGER :: state - INTEGER :: nvar - INTEGER :: iprint - INTEGER :: unit - INTEGER :: maxfun - REAL(dp) :: rhobeg, rhoend - REAL(dp), DIMENSION(:), POINTER :: w - REAL(dp), DIMENSION(:), POINTER :: xopt - ! local variables - INTEGER :: np, nh, nptm, nftest, idz, itest, nf, nfm, nfmm, & - nfsav, knew, kopt, ksave, ktemp - REAL(dp) :: rhosq, recip, reciq, fbeg, fopt, diffa, xoptsq, & - rho, delta, dsq, dnorm, ratio, temp, tempq, beta, & - dx, vquad, diff, diffc, diffb, fsave, detrat, hdiag, & - distsq, gisq, gqsq, f, bstep, alpha, dstep - END TYPE opt_state_type - - PRIVATE - PUBLIC :: powell_optimize, opt_state_type + TYPE opt_state_type + INTEGER :: state + INTEGER :: nvar + INTEGER :: iprint + INTEGER :: unit + INTEGER :: maxfun + REAL(dp) :: rhobeg, rhoend + REAL(dp), DIMENSION(:), POINTER :: w + REAL(dp), DIMENSION(:), POINTER :: xopt + ! local variables + INTEGER :: np, nh, nptm, nftest, idz, itest, nf, nfm, nfmm, & + nfsav, knew, kopt, ksave, ktemp + REAL(dp) :: rhosq, recip, reciq, fbeg, fopt, diffa, xoptsq, & + rho, delta, dsq, dnorm, ratio, temp, tempq, beta, & + dx, vquad, diff, diffc, diffb, fsave, detrat, hdiag, & + distsq, gisq, gqsq, f, bstep, alpha, dstep + END TYPE opt_state_type + + PRIVATE + PUBLIC :: powell_optimize, opt_state_type !****************************************************************************** @@ -45,7 +45,7 @@ MODULE powell !> \param x ... !> \param optstate ... ! ************************************************************************************************** - SUBROUTINE powell_optimize (n,x,optstate) + SUBROUTINE powell_optimize(n, x, optstate) INTEGER :: n REAL(dp), DIMENSION(*) :: x TYPE(opt_state_type) :: optstate @@ -55,48 +55,48 @@ SUBROUTINE powell_optimize (n,x,optstate) INTEGER :: handle, npt - CALL timeset(routineN,handle) - - SELECT CASE (optstate%state) - CASE (0) - npt=2*n+1 - ALLOCATE(optstate%w((npt+13)*(npt+n)+3*n*(n+3)/2)) - ALLOCATE(optstate%xopt(n)) - ! Initialize w - optstate%w = 0.0_dp - optstate%state = 1 - CALL newuoa (n, x, optstate) - CASE (1,2) - CALL newuoa (n, x, optstate) - CASE (3) - IF(optstate%unit > 0) THEN - WRITE(optstate%unit,*) "POWELL| Exceeding maximum number of steps" - ENDIF - optstate%state = -1 - CASE (4) - IF(optstate%unit > 0) THEN - WRITE(optstate%unit,*) "POWELL| Error in trust region" - ENDIF - optstate%state = -1 - CASE (5) - IF(optstate%unit > 0) THEN - WRITE(optstate%unit,*) "POWELL| N out of range" - ENDIF - optstate%state = -1 - CASE (6,7) - optstate%state = -1 - CASE (8) - x(1:n) = optstate%xopt(1:n) - DEALLOCATE(optstate%w) - DEALLOCATE(optstate%xopt) - optstate%state = -1 - CASE DEFAULT - CPABORT("") - END SELECT - - CALL timestop(handle) - - END SUBROUTINE powell_optimize + CALL timeset(routineN, handle) + + SELECT CASE (optstate%state) + CASE (0) + npt = 2*n + 1 + ALLOCATE (optstate%w((npt + 13)*(npt + n) + 3*n*(n + 3)/2)) + ALLOCATE (optstate%xopt(n)) + ! Initialize w + optstate%w = 0.0_dp + optstate%state = 1 + CALL newuoa(n, x, optstate) + CASE (1, 2) + CALL newuoa(n, x, optstate) + CASE (3) + IF (optstate%unit > 0) THEN + WRITE (optstate%unit, *) "POWELL| Exceeding maximum number of steps" + ENDIF + optstate%state = -1 + CASE (4) + IF (optstate%unit > 0) THEN + WRITE (optstate%unit, *) "POWELL| Error in trust region" + ENDIF + optstate%state = -1 + CASE (5) + IF (optstate%unit > 0) THEN + WRITE (optstate%unit, *) "POWELL| N out of range" + ENDIF + optstate%state = -1 + CASE (6, 7) + optstate%state = -1 + CASE (8) + x(1:n) = optstate%xopt(1:n) + DEALLOCATE (optstate%w) + DEALLOCATE (optstate%xopt) + optstate%state = -1 + CASE DEFAULT + CPABORT("") + END SELECT + + CALL timestop(handle) + + END SUBROUTINE powell_optimize !****************************************************************************** ! ************************************************************************************************** !> \brief ... @@ -104,7 +104,7 @@ END SUBROUTINE powell_optimize !> \param x ... !> \param optstate ... ! ************************************************************************************************** - SUBROUTINE newuoa (n,x,optstate) + SUBROUTINE newuoa(n, x, optstate) INTEGER :: n REAL(dp), DIMENSION(*) :: x @@ -115,79 +115,78 @@ SUBROUTINE newuoa (n,x,optstate) ndim, np, npt, nptm REAL(dp) :: rhobeg, rhoend - maxfun = optstate%maxfun - rhobeg = optstate%rhobeg - rhoend = optstate%rhoend - - ! - ! This subroutine seeks the least value of a function of many variab - ! by a trust region method that forms quadratic models by interpolat - ! There can be some freedom in the interpolation conditions, which i - ! taken up by minimizing the Frobenius norm of the change to the sec - ! derivative of the quadratic model, beginning with a zero matrix. T - ! arguments of the subroutine are as follows. - ! - ! N must be set to the number of variables and must be at least two. - ! NPT is the number of interpolation conditions. Its value must be i - ! interval [N+2,(N+1)(N+2)/2]. - ! Initial values of the variables must be set in X(1),X(2),...,X(N). - ! will be changed to the values that give the least calculated F. - ! RHOBEG and RHOEND must be set to the initial and final values of a - ! region radius, so both must be positive with RHOEND<=RHOBEG. Typ - ! RHOBEG should be about one tenth of the greatest expected change - ! variable, and RHOEND should indicate the accuracy that is requir - ! the final values of the variables. - ! The value of IPRINT should be set to 0, 1, 2 or 3, which controls - ! amount of printing. Specifically, there is no output if IPRINT=0 - ! there is output only at the return if IPRINT=1. Otherwise, each - ! value of RHO is printed, with the best vector of variables so fa - ! the corresponding value of the objective function. Further, each - ! value of F with its variables are output if IPRINT=3. - ! MAXFUN must be set to an upper bound on the number of calls of CAL - ! The array W will be used for working space. Its length must be at - ! (NPT+13)*(NPT+N)+3*N*(N+3)/2. - ! - ! SUBROUTINE CALFUN (N,X,F) must be provided by the user. It must se - ! the value of the objective function for the variables X(1),X(2),.. - ! - ! Partition the working space array, so that different parts of it c - ! treated separately by the subroutine that performs the main calcul - ! - np=n+1 - npt=2*n+1 - nptm=npt-np - IF (npt < n+2 .OR. npt > ((n+2)*np)/2) THEN - optstate%state = 5 - RETURN - END IF - ndim=npt+n - ixb=1 - ixo=ixb+n - ixn=ixo+n - ixp=ixn+n - ifv=ixp+n*npt - igq=ifv+npt - ihq=igq+n - ipq=ihq+(n*np)/2 - ibmat=ipq+npt - izmat=ibmat+ndim*n - id=izmat+npt*nptm - ivl=id+n - iw=ivl+ndim - ! - ! The above settings provide a partition of W for subroutine NEWUOB. - ! The partition requires the first NPT*(NPT+N)+5*N*(N+3)/2 elements - ! W plus the space that is needed by the last array of NEWUOB. - ! - CALL newuob (n,npt,x,rhobeg,rhoend,maxfun,optstate%w(ixb:),optstate%w(ixo:),& - optstate%w(ixn:),optstate%w(ixp:),optstate%w(ifv:),optstate%w(igq:),optstate%w(ihq:),& - optstate%w(ipq:),optstate%w(ibmat:),optstate%w(izmat:),ndim,optstate%w(id:),& - optstate%w(ivl:),optstate%w(iw:),optstate) - - optstate%xopt(1:n) = optstate%w(ixb:ixb+n-1) + optstate%w(ixo:ixo+n-1) - - - END SUBROUTINE newuoa + maxfun = optstate%maxfun + rhobeg = optstate%rhobeg + rhoend = optstate%rhoend + + ! + ! This subroutine seeks the least value of a function of many variab + ! by a trust region method that forms quadratic models by interpolat + ! There can be some freedom in the interpolation conditions, which i + ! taken up by minimizing the Frobenius norm of the change to the sec + ! derivative of the quadratic model, beginning with a zero matrix. T + ! arguments of the subroutine are as follows. + ! + ! N must be set to the number of variables and must be at least two. + ! NPT is the number of interpolation conditions. Its value must be i + ! interval [N+2,(N+1)(N+2)/2]. + ! Initial values of the variables must be set in X(1),X(2),...,X(N). + ! will be changed to the values that give the least calculated F. + ! RHOBEG and RHOEND must be set to the initial and final values of a + ! region radius, so both must be positive with RHOEND<=RHOBEG. Typ + ! RHOBEG should be about one tenth of the greatest expected change + ! variable, and RHOEND should indicate the accuracy that is requir + ! the final values of the variables. + ! The value of IPRINT should be set to 0, 1, 2 or 3, which controls + ! amount of printing. Specifically, there is no output if IPRINT=0 + ! there is output only at the return if IPRINT=1. Otherwise, each + ! value of RHO is printed, with the best vector of variables so fa + ! the corresponding value of the objective function. Further, each + ! value of F with its variables are output if IPRINT=3. + ! MAXFUN must be set to an upper bound on the number of calls of CAL + ! The array W will be used for working space. Its length must be at + ! (NPT+13)*(NPT+N)+3*N*(N+3)/2. + ! + ! SUBROUTINE CALFUN (N,X,F) must be provided by the user. It must se + ! the value of the objective function for the variables X(1),X(2),.. + ! + ! Partition the working space array, so that different parts of it c + ! treated separately by the subroutine that performs the main calcul + ! + np = n + 1 + npt = 2*n + 1 + nptm = npt - np + IF (npt < n + 2 .OR. npt > ((n + 2)*np)/2) THEN + optstate%state = 5 + RETURN + END IF + ndim = npt + n + ixb = 1 + ixo = ixb + n + ixn = ixo + n + ixp = ixn + n + ifv = ixp + n*npt + igq = ifv + npt + ihq = igq + n + ipq = ihq + (n*np)/2 + ibmat = ipq + npt + izmat = ibmat + ndim*n + id = izmat + npt*nptm + ivl = id + n + iw = ivl + ndim + ! + ! The above settings provide a partition of W for subroutine NEWUOB. + ! The partition requires the first NPT*(NPT+N)+5*N*(N+3)/2 elements + ! W plus the space that is needed by the last array of NEWUOB. + ! + CALL newuob(n, npt, x, rhobeg, rhoend, maxfun, optstate%w(ixb:), optstate%w(ixo:), & + optstate%w(ixn:), optstate%w(ixp:), optstate%w(ifv:), optstate%w(igq:), optstate%w(ihq:), & + optstate%w(ipq:), optstate%w(ibmat:), optstate%w(izmat:), ndim, optstate%w(id:), & + optstate%w(ivl:), optstate%w(iw:), optstate) + + optstate%xopt(1:n) = optstate%w(ixb:ixb + n - 1) + optstate%w(ixo:ixo + n - 1) + + END SUBROUTINE newuoa !****************************************************************************** ! ************************************************************************************************** @@ -214,34 +213,34 @@ END SUBROUTINE newuoa !> \param w ... !> \param opt ... ! ************************************************************************************************** - SUBROUTINE newuob (n,npt,x,rhobeg,rhoend,maxfun,xbase,& - xopt,xnew,xpt,fval,gq,hq,pq,bmat,zmat,ndim,d,vlag,w,opt) - - INTEGER, INTENT(inout) :: n, npt - REAL(dp), DIMENSION(1:n), INTENT(inout) :: x - REAL(dp), INTENT(inout) :: rhobeg, rhoend - INTEGER, INTENT(inout) :: maxfun - REAL(dp), DIMENSION(*), INTENT(inout) :: xbase, xopt, xnew - REAL(dp), DIMENSION(npt, *), & - INTENT(inout) :: xpt - REAL(dp), DIMENSION(*), INTENT(inout) :: fval, gq, hq, pq - INTEGER, INTENT(inout) :: ndim - REAL(dp), DIMENSION(npt, *), & - INTENT(inout) :: zmat - REAL(dp), DIMENSION(ndim, *), & - INTENT(inout) :: bmat - REAL(dp), DIMENSION(*), INTENT(inout) :: d, vlag, w - TYPE(opt_state_type) :: opt - - INTEGER :: i, idz, ih, ip, ipt, itemp, & - itest, j, jp, jpt, k, knew, & - kopt, ksave, ktemp, nf, nfm, & - nfmm, nfsav, nftest, nh, np, & - nptm - REAL(dp) :: alpha, beta, bstep, bsum, crvmin, delta, detrat, diff, diffa, & - diffb, diffc, distsq, dnorm, dsq, dstep, dx, f, fbeg, fopt, fsave, & - gisq, gqsq, half, hdiag, one, ratio, recip, reciq, rho, rhosq, sum, & - suma, sumb, sumz, temp, tempq, tenth, vquad, xipt, xjpt, xoptsq, zero + SUBROUTINE newuob(n, npt, x, rhobeg, rhoend, maxfun, xbase, & + xopt, xnew, xpt, fval, gq, hq, pq, bmat, zmat, ndim, d, vlag, w, opt) + + INTEGER, INTENT(inout) :: n, npt + REAL(dp), DIMENSION(1:n), INTENT(inout) :: x + REAL(dp), INTENT(inout) :: rhobeg, rhoend + INTEGER, INTENT(inout) :: maxfun + REAL(dp), DIMENSION(*), INTENT(inout) :: xbase, xopt, xnew + REAL(dp), DIMENSION(npt, *), & + INTENT(inout) :: xpt + REAL(dp), DIMENSION(*), INTENT(inout) :: fval, gq, hq, pq + INTEGER, INTENT(inout) :: ndim + REAL(dp), DIMENSION(npt, *), & + INTENT(inout) :: zmat + REAL(dp), DIMENSION(ndim, *), & + INTENT(inout) :: bmat + REAL(dp), DIMENSION(*), INTENT(inout) :: d, vlag, w + TYPE(opt_state_type) :: opt + + INTEGER :: i, idz, ih, ip, ipt, itemp, & + itest, j, jp, jpt, k, knew, & + kopt, ksave, ktemp, nf, nfm, & + nfmm, nfsav, nftest, nh, np, & + nptm + REAL(dp) :: alpha, beta, bstep, bsum, crvmin, delta, detrat, diff, diffa, & + diffb, diffc, distsq, dnorm, dsq, dstep, dx, f, fbeg, fopt, fsave, & + gisq, gqsq, half, hdiag, one, ratio, recip, reciq, rho, rhosq, sum, & + suma, sumb, sumz, temp, tempq, tenth, vquad, xipt, xjpt, xoptsq, zero ! ! The arguments N, NPT, X, RHOBEG, RHOEND, IPRINT and MAXFUN are ide @@ -269,742 +268,742 @@ SUBROUTINE newuob (n,npt,x,rhobeg,rhoend,maxfun,xbase,& ! The array W will be used for working space. Its length must be at ! 10*NDIM = 10*(NPT+N). - IF ( opt%state == 1 ) THEN - ! initialize all variable that will be stored - np = 0 - nh = 0 - nptm = 0 - nftest = 0 - idz = 0 - itest = 0 - nf = 0 - nfm = 0 - nfmm = 0 - nfsav = 0 - knew = 0 - kopt = 0 - ksave = 0 - ktemp = 0 - rhosq = 0._dp - recip = 0._dp - reciq = 0._dp - fbeg = 0._dp - fopt = 0._dp - diffa = 0._dp - xoptsq = 0._dp - rho = 0._dp - delta = 0._dp - dsq = 0._dp - dnorm = 0._dp - ratio = 0._dp - temp = 0._dp - tempq = 0._dp - beta = 0._dp - dx = 0._dp - vquad = 0._dp - diff = 0._dp - diffc = 0._dp - diffb = 0._dp - fsave = 0._dp - detrat = 0._dp - hdiag = 0._dp - distsq = 0._dp - gisq = 0._dp - gqsq = 0._dp - f = 0._dp - bstep = 0._dp - alpha = 0._dp - dstep = 0._dp - ! - END IF - - ipt = 0 - jpt = 0 - xipt = 0._dp - xjpt = 0._dp - - half=0.5_dp - one=1.0_dp - tenth=0.1_dp - zero=0.0_dp - np=n+1 - nh=(n*np)/2 - nptm=npt-np - nftest=MAX(maxfun,1) - - IF ( opt%state == 2 ) GOTO 1000 - ! - ! Set the initial elements of XPT, BMAT, HQ, PQ and ZMAT to zero. - ! - DO j=1,n - xbase(j)=x(j) - DO k=1,npt - xpt(k,j)=zero - END DO - DO i=1,ndim - bmat(i,j)=zero - END DO - END DO - DO ih=1,nh - hq(ih)=zero - END DO - DO k=1,npt - pq(k)=zero - DO j=1,nptm - zmat(k,j)=zero - END DO - END DO - ! - ! Begin the initialization procedure. NF becomes one more than the n - ! of function values so far. The coordinates of the displacement of - ! next initial interpolation point from XBASE are set in XPT(NF,.). - ! - rhosq=rhobeg*rhobeg - recip=one/rhosq - reciq=SQRT(half)/rhosq - nf=0 -50 nfm=nf - nfmm=nf-n - nf=nf+1 - IF (nfm <= 2*n) THEN - IF (nfm >= 1 .AND. nfm <= N) THEN - xpt(nf,nfm)=rhobeg - ELSE IF (nfm > n) THEN - xpt(nf,nfmm)=-rhobeg - END IF - ELSE - itemp=(nfmm-1)/n - jpt=nfm-itemp*n-n - ipt=jpt+itemp - IF (ipt > n) THEN - itemp=jpt - jpt=ipt-n - ipt=itemp - END IF - xipt=rhobeg - IF (fval(ipt+np) < fval(ipt+1)) xipt=-xipt - XJPT=RHOBEG - IF (fval(jpt+np) < fval(jpt+1)) xjpt=-xjpt - xpt(nf,ipt)=xipt - xpt(nf,jpt)=xjpt - END IF - ! - ! Calculate the next value of F, label 70 being reached immediately - ! after this calculation. The least function value so far and its in - ! are required. - ! - DO j=1,n - x(j)=xpt(nf,j)+xbase(j) - END DO - GOTO 310 -70 fval(nf)=f - IF (nf == 1) THEN - fbeg=f - fopt=f - kopt=1 - ELSE IF (f < fopt) THEN - fopt=f - kopt=nf - END IF - ! - ! Set the nonzero initial elements of BMAT and the quadratic model i - ! the cases when NF is at most 2*N+1. - ! - IF (NFM <= 2*N) THEN - IF (nfm >= 1 .AND. nfm <= n) THEN - gq(nfm)=(f-fbeg)/rhobeg - IF (npt < nf+n) THEN - bmat(1,nfm)=-one/rhobeg - bmat(nf,nfm)=one/rhobeg - bmat(npt+nfm,nfm)=-half*rhosq - END IF - ELSE IF (nfm > n) THEN - bmat(nf-n,nfmm)=half/rhobeg - bmat(nf,nfmm)=-half/rhobeg - zmat(1,nfmm)=-reciq-reciq - zmat(nf-n,nfmm)=reciq - zmat(nf,nfmm)=reciq - ih=(nfmm*(nfmm+1))/2 - temp=(fbeg-f)/rhobeg - hq(ih)=(gq(nfmm)-temp)/rhobeg - gq(nfmm)=half*(gq(nfmm)+temp) - END IF - ! - ! Set the off-diagonal second derivatives of the Lagrange functions - ! the initial quadratic model. - ! - ELSE - ih=(ipt*(ipt-1))/2+jpt - IF (xipt < zero) ipt=ipt+n - IF (xjpt < zero) jpt=jpt+n - zmat(1,nfmm)=recip - zmat(nf,nfmm)=recip - zmat(ipt+1,nfmm)=-recip - zmat(jpt+1,nfmm)=-recip - hq(ih)=(fbeg-fval(ipt+1)-fval(jpt+1)+f)/(xipt*xjpt) - END IF - IF (nf < npt) GOTO 50 - ! - ! Begin the iterative procedure, because the initial model is comple - ! - rho=rhobeg - delta=rho - idz=1 - diffa=zero - diffb=zero - itest=0 - xoptsq=zero - DO i=1,n - xopt(i)=xpt(kopt,i) - xoptsq=xoptsq+xopt(i)**2 - END DO -90 nfsav=nf - ! - ! Generate the next trust region step and test its length. Set KNEW - ! to -1 if the purpose of the next F will be to improve the model. - ! -100 knew=0 - CALL trsapp (n,npt,xopt,xpt,gq,hq,pq,delta,d,w,w(np),w(np+n),w(np+2*n),crvmin) - dsq=zero - DO i=1,n - dsq=dsq+d(i)**2 - END DO - dnorm=MIN(delta,SQRT(dsq)) - IF (dnorm < half*rho) THEN - knew=-1 - delta=tenth*delta - ratio=-1.0_dp - IF (delta <= 1.5_dp*rho) delta=rho - IF (nf <= nfsav+2) GOTO 460 - temp=0.125_dp*crvmin*rho*rho - IF (temp <= MAX(diffa,diffb,diffc)) GOTO 460 - GOTO 490 - END IF - ! - ! Shift XBASE if XOPT may be too far from XBASE. First make the chan - ! to BMAT that do not depend on ZMAT. - ! -120 IF (dsq <= 1.0e-3_dp*xoptsq) THEN - tempq=0.25_dp*xoptsq - DO k=1,npt - sum=zero - DO i=1,n - sum=sum+xpt(k,i)*xopt(i) - END DO - temp=pq(k)*sum - sum=sum-half*xoptsq - w(npt+k)=sum - DO i=1,n - gq(i)=gq(i)+temp*xpt(k,i) - xpt(k,i)=xpt(k,i)-half*xopt(i) - vlag(i)=bmat(k,i) - w(i)=sum*xpt(k,i)+tempq*xopt(i) - ip=npt+i - DO j=1,i - bmat(ip,j)=bmat(ip,j)+vlag(i)*w(j)+w(i)*vlag(j) - END DO - END DO - END DO - ! - ! Then the revisions of BMAT that depend on ZMAT are calculated. - ! - DO k=1,nptm - sumz=zero - DO i=1,npt - sumz=sumz+zmat(i,k) - w(i)=w(npt+i)*zmat(i,k) - END DO - DO j=1,n - sum=tempq*sumz*xopt(j) - DO i=1,npt - sum=sum+w(i)*xpt(i,j) - vlag(j)=sum - IF (k < idz) sum=-sum - END DO - DO i=1,npt - bmat(i,j)=bmat(i,j)+sum*zmat(i,k) - END DO - END DO - DO i=1,n - ip=i+npt - temp=vlag(i) - IF (k < idz) temp=-temp - DO j=1,i - bmat(ip,j)=bmat(ip,j)+temp*vlag(j) - END DO - END DO - END DO - ! - ! The following instructions complete the shift of XBASE, including - ! the changes to the parameters of the quadratic model. - ! - ih=0 - DO j=1,n - w(j)=zero - DO k=1,npt - w(j)=w(j)+pq(k)*xpt(k,j) - xpt(k,j)=xpt(k,j)-half*xopt(j) - END DO - DO i=1,j - ih=ih+1 - IF (i < j) gq(j)=gq(j)+hq(ih)*xopt(i) - gq(i)=gq(i)+hq(ih)*xopt(j) - hq(ih)=hq(ih)+w(i)*xopt(j)+xopt(i)*w(j) - bmat(npt+i,j)=bmat(npt+j,i) - END DO - END DO - DO j=1,n - xbase(j)=xbase(j)+xopt(j) - xopt(j)=zero - END DO - xoptsq=zero - END IF - ! - ! Pick the model step if KNEW is positive. A different choice of D - ! may be made later, if the choice of D by BIGLAG causes substantial - ! cancellation in DENOM. - ! - IF (knew > 0) THEN - CALL biglag (n,npt,xopt,xpt,bmat,zmat,idz,ndim,knew,dstep, & - d,alpha,vlag,vlag(npt+1),w,w(np),w(np+n)) - END IF - ! - ! Calculate VLAG and BETA for the current choice of D. The first NPT - ! components of W_check will be held in W. - ! - DO k=1,npt - suma=zero - sumb=zero - sum=zero - DO j=1,n - suma=suma+xpt(k,j)*d(j) - sumb=sumb+xpt(k,j)*xopt(j) - sum=sum+bmat(k,j)*d(j) - END DO - w(k)=suma*(half*suma+sumb) - vlag(k)=sum - END DO - beta=zero - DO k=1,nptm - sum=zero - DO i=1,npt - sum=sum+zmat(i,k)*w(i) - END DO - IF (k < idz) THEN - beta=beta+sum*sum - sum=-sum - ELSE - beta=beta-sum*sum - END IF - DO i=1,npt - vlag(i)=vlag(i)+sum*zmat(i,k) - END DO - END DO - bsum=zero - dx=zero - DO j=1,n - sum=zero - DO i=1,npt - sum=sum+w(i)*bmat(i,j) - END DO - bsum=bsum+sum*d(j) - jp=npt+j - DO k=1,n - sum=sum+bmat(jp,k)*d(k) - END DO - vlag(jp)=sum - bsum=bsum+sum*d(j) - dx=dx+d(j)*xopt(j) - END DO - beta=dx*dx+dsq*(xoptsq+dx+dx+half*dsq)+beta-bsum - vlag(kopt)=vlag(kopt)+one - ! - ! If KNEW is positive and if the cancellation in DENOM is unacceptab - ! then BIGDEN calculates an alternative model step, XNEW being used - ! working space. - ! - IF (knew > 0) THEN - temp=one+alpha*beta/vlag(knew)**2 - IF (ABS(temp) <= 0.8_dp) THEN - CALL bigden (n,npt,xopt,xpt,bmat,zmat,idz,ndim,kopt, & - knew,d,w,vlag,beta,xnew,w(ndim+1),w(6*ndim+1)) - END IF - END IF - ! - ! Calculate the next value of the objective function. - ! -290 DO i=1,n - xnew(i)=xopt(i)+d(i) - x(i)=xbase(i)+xnew(i) - END DO - nf=nf+1 -310 IF (nf > nftest) THEN - ! return to many steps - nf=nf-1 - opt%state = 3 - CALL get_state - GOTO 530 - END IF - - CALL get_state - - opt%state = 2 - - RETURN - -1000 CONTINUE - - CALL set_state - - IF (nf <= npt) GOTO 70 - IF (knew == -1) THEN - opt%state = 6 - CALL get_state - GOTO 530 - END IF - ! - ! Use the quadratic model to predict the change in F due to the step - ! and set DIFF to the error of this prediction. - ! - vquad=zero - ih=0 - DO j=1,n - vquad=vquad+d(j)*gq(j) - DO i=1,j - ih=ih+1 - temp=d(i)*xnew(j)+d(j)*xopt(i) - IF (i == j) temp=half*temp - vquad=vquad+temp*hq(ih) - END DO - END DO - DO k=1,npt - vquad=vquad+pq(k)*w(k) - END DO - diff=f-fopt-vquad - diffc=diffb - diffb=diffa - diffa=ABS(diff) - IF (dnorm > rho) nfsav=nf - ! - ! Update FOPT and XOPT if the new F is the least value of the object - ! function so far. The branch when KNEW is positive occurs if D is n - ! a trust region step. - ! - fsave=fopt - IF (f < fopt) THEN - fopt=f - xoptsq=zero - DO i=1,n - xopt(i)=xnew(i) - xoptsq=xoptsq+xopt(i)**2 - END DO - END IF - ksave=knew - IF (knew > 0) GOTO 410 - ! - ! Pick the next value of DELTA after a trust region step. - ! - IF (vquad >= zero) THEN - ! Return because a trust region step has failed to reduce Q - opt%state = 4 - CALL get_state - GOTO 530 - END IF - ratio=(f-fsave)/vquad - IF (ratio <= tenth) THEN - delta=half*dnorm - ELSE IF (ratio <= 0.7_dp) THEN - delta=MAX(half*delta,dnorm) - ELSE - delta=MAX(half*delta,dnorm+dnorm) - END IF - IF (delta <= 1.5_dp*rho) delta=rho - ! - ! Set KNEW to the index of the next interpolation point to be delete - ! - rhosq=MAX(tenth*delta,rho)**2 - ktemp=0 - detrat=zero - IF (f >= fsave) THEN - ktemp=kopt - detrat=one - END IF - DO k=1,npt - hdiag=zero - DO j=1,nptm - temp=one - IF (j < idz) temp=-one - hdiag=hdiag+temp*zmat(k,j)**2 - END DO - temp=ABS(beta*hdiag+vlag(k)**2) - distsq=zero - DO j=1,n - distsq=distsq+(xpt(k,j)-xopt(j))**2 - END DO - IF (distsq > rhosq) temp=temp*(distsq/rhosq)**3 - IF (temp > detrat .AND. k /= ktemp) THEN - detrat=temp - knew=k - END IF - END DO - IF (knew == 0) GOTO 460 - ! - ! Update BMAT, ZMAT and IDZ, so that the KNEW-th interpolation point - ! can be moved. Begin the updating of the quadratic model, starting - ! with the explicit second derivative term. - ! -410 CALL update (n,npt,bmat,zmat,idz,ndim,vlag,beta,knew,w) - fval(knew)=f - ih=0 - DO i=1,n - temp=pq(knew)*xpt(knew,i) - DO j=1,i - ih=ih+1 - hq(ih)=hq(ih)+temp*xpt(knew,j) - END DO - END DO - pq(knew)=zero - ! - ! Update the other second derivative parameters, and then the gradie - ! vector of the model. Also include the new interpolation point. - ! - DO j=1,nptm - temp=diff*zmat(knew,j) - IF (j < idz) temp=-temp - DO k=1,npt - pq(k)=pq(k)+temp*zmat(k,j) - END DO - END DO - gqsq=zero - DO i=1,n - gq(i)=gq(i)+diff*bmat(knew,i) - gqsq=gqsq+gq(i)**2 - xpt(knew,i)=xnew(i) - END DO - ! - ! If a trust region step makes a small change to the objective funct - ! then calculate the gradient of the least Frobenius norm interpolan - ! XBASE, and store it in W, using VLAG for a vector of right hand si - ! - IF (ksave == 0 .AND. delta == rho) THEN - IF (ABS(ratio) > 1.0e-2_dp) THEN - itest=0 - ELSE - DO k=1,npt - vlag(k)=fval(k)-fval(kopt) - END DO - gisq=zero - DO i=1,n - sum=zero - DO k=1,npt - sum=sum+bmat(k,i)*vlag(k) - END DO - gisq=gisq+sum*sum - w(i)=sum - END DO - ! - ! Test whether to replace the new quadratic model by the least Frobe - ! norm interpolant, making the replacement if the test is satisfied. - ! - itest=itest+1 - IF (gqsq < 1.0e2_dp*gisq) itest=0 - IF (itest >= 3) THEN - DO i=1,n - gq(i)=w(i) - END DO - DO ih=1,nh - hq(ih)=zero - END DO - DO j=1,nptm - w(j)=zero - DO k=1,npt - w(j)=w(j)+vlag(k)*zmat(k,j) - END DO - IF (j < idz) w(j)=-w(j) - END DO - DO k=1,npt - pq(k)=zero - DO j=1,nptm - pq(k)=pq(k)+zmat(k,j)*w(j) - END DO - END DO - itest=0 - END IF - END IF - END IF - IF (f < fsave) kopt=knew - ! - ! If a trust region step has provided a sufficient decrease in F, th - ! branch for another trust region calculation. The case KSAVE>0 occu - ! when the new function value was calculated by a model step. - ! - IF (f <= fsave+tenth*vquad) GOTO 100 - IF (ksave > 0) GOTO 100 - ! - ! Alternatively, find out if the interpolation points are close enou - ! to the best point so far. - ! - knew=0 -460 distsq=4.0_dp*delta*delta - DO k=1,npt - sum=zero - DO j=1,n - sum=sum+(xpt(k,j)-xopt(j))**2 - END DO - IF (sum > distsq) THEN - knew=k - distsq=sum - END IF - END DO - ! - ! If KNEW is positive, then set DSTEP, and branch back for the next - ! iteration, which will generate a "model step". - ! - IF (knew > 0) THEN - dstep=MAX(MIN(tenth*SQRT(distsq),half*delta),rho) - dsq=dstep*dstep - GOTO 120 - END IF - IF (ratio > zero) GOTO 100 - IF (MAX(delta,dnorm) > rho) GOTO 100 - ! - ! The calculations with the current value of RHO are complete. Pick - ! next values of RHO and DELTA. - ! -490 IF (rho > rhoend) THEN - delta=half*rho - ratio=rho/rhoend - IF (ratio <= 16.0_dp) THEN - rho=rhoend - ELSE IF (ratio <= 250.0_dp) THEN - rho=SQRT(ratio)*rhoend - ELSE - rho=tenth*rho - END IF - delta=MAX(delta,rho) - GOTO 90 - END IF - ! - ! Return from the calculation, after another Newton-Raphson step, if - ! it is too short to have been tried before. - ! - IF (knew == -1) GOTO 290 - opt%state = 7 - CALL get_state -530 IF (fopt <= f) THEN - DO i=1,n - x(i)=xbase(i)+xopt(i) - END DO - f=fopt - END IF - - CALL get_state - - !****************************************************************************** - CONTAINS - !****************************************************************************** + IF (opt%state == 1) THEN + ! initialize all variable that will be stored + np = 0 + nh = 0 + nptm = 0 + nftest = 0 + idz = 0 + itest = 0 + nf = 0 + nfm = 0 + nfmm = 0 + nfsav = 0 + knew = 0 + kopt = 0 + ksave = 0 + ktemp = 0 + rhosq = 0._dp + recip = 0._dp + reciq = 0._dp + fbeg = 0._dp + fopt = 0._dp + diffa = 0._dp + xoptsq = 0._dp + rho = 0._dp + delta = 0._dp + dsq = 0._dp + dnorm = 0._dp + ratio = 0._dp + temp = 0._dp + tempq = 0._dp + beta = 0._dp + dx = 0._dp + vquad = 0._dp + diff = 0._dp + diffc = 0._dp + diffb = 0._dp + fsave = 0._dp + detrat = 0._dp + hdiag = 0._dp + distsq = 0._dp + gisq = 0._dp + gqsq = 0._dp + f = 0._dp + bstep = 0._dp + alpha = 0._dp + dstep = 0._dp + ! + END IF + + ipt = 0 + jpt = 0 + xipt = 0._dp + xjpt = 0._dp + + half = 0.5_dp + one = 1.0_dp + tenth = 0.1_dp + zero = 0.0_dp + np = n + 1 + nh = (n*np)/2 + nptm = npt - np + nftest = MAX(maxfun, 1) + + IF (opt%state == 2) GOTO 1000 + ! + ! Set the initial elements of XPT, BMAT, HQ, PQ and ZMAT to zero. + ! + DO j = 1, n + xbase(j) = x(j) + DO k = 1, npt + xpt(k, j) = zero + END DO + DO i = 1, ndim + bmat(i, j) = zero + END DO + END DO + DO ih = 1, nh + hq(ih) = zero + END DO + DO k = 1, npt + pq(k) = zero + DO j = 1, nptm + zmat(k, j) = zero + END DO + END DO + ! + ! Begin the initialization procedure. NF becomes one more than the n + ! of function values so far. The coordinates of the displacement of + ! next initial interpolation point from XBASE are set in XPT(NF,.). + ! + rhosq = rhobeg*rhobeg + recip = one/rhosq + reciq = SQRT(half)/rhosq + nf = 0 +50 nfm = nf + nfmm = nf - n + nf = nf + 1 + IF (nfm <= 2*n) THEN + IF (nfm >= 1 .AND. nfm <= N) THEN + xpt(nf, nfm) = rhobeg + ELSE IF (nfm > n) THEN + xpt(nf, nfmm) = -rhobeg + END IF + ELSE + itemp = (nfmm - 1)/n + jpt = nfm - itemp*n - n + ipt = jpt + itemp + IF (ipt > n) THEN + itemp = jpt + jpt = ipt - n + ipt = itemp + END IF + xipt = rhobeg + IF (fval(ipt + np) < fval(ipt + 1)) xipt = -xipt + XJPT = RHOBEG + IF (fval(jpt + np) < fval(jpt + 1)) xjpt = -xjpt + xpt(nf, ipt) = xipt + xpt(nf, jpt) = xjpt + END IF + ! + ! Calculate the next value of F, label 70 being reached immediately + ! after this calculation. The least function value so far and its in + ! are required. + ! + DO j = 1, n + x(j) = xpt(nf, j) + xbase(j) + END DO + GOTO 310 +70 fval(nf) = f + IF (nf == 1) THEN + fbeg = f + fopt = f + kopt = 1 + ELSE IF (f < fopt) THEN + fopt = f + kopt = nf + END IF + ! + ! Set the nonzero initial elements of BMAT and the quadratic model i + ! the cases when NF is at most 2*N+1. + ! + IF (NFM <= 2*N) THEN + IF (nfm >= 1 .AND. nfm <= n) THEN + gq(nfm) = (f - fbeg)/rhobeg + IF (npt < nf + n) THEN + bmat(1, nfm) = -one/rhobeg + bmat(nf, nfm) = one/rhobeg + bmat(npt + nfm, nfm) = -half*rhosq + END IF + ELSE IF (nfm > n) THEN + bmat(nf - n, nfmm) = half/rhobeg + bmat(nf, nfmm) = -half/rhobeg + zmat(1, nfmm) = -reciq - reciq + zmat(nf - n, nfmm) = reciq + zmat(nf, nfmm) = reciq + ih = (nfmm*(nfmm + 1))/2 + temp = (fbeg - f)/rhobeg + hq(ih) = (gq(nfmm) - temp)/rhobeg + gq(nfmm) = half*(gq(nfmm) + temp) + END IF + ! + ! Set the off-diagonal second derivatives of the Lagrange functions + ! the initial quadratic model. + ! + ELSE + ih = (ipt*(ipt - 1))/2 + jpt + IF (xipt < zero) ipt = ipt + n + IF (xjpt < zero) jpt = jpt + n + zmat(1, nfmm) = recip + zmat(nf, nfmm) = recip + zmat(ipt + 1, nfmm) = -recip + zmat(jpt + 1, nfmm) = -recip + hq(ih) = (fbeg - fval(ipt + 1) - fval(jpt + 1) + f)/(xipt*xjpt) + END IF + IF (nf < npt) GOTO 50 + ! + ! Begin the iterative procedure, because the initial model is comple + ! + rho = rhobeg + delta = rho + idz = 1 + diffa = zero + diffb = zero + itest = 0 + xoptsq = zero + DO i = 1, n + xopt(i) = xpt(kopt, i) + xoptsq = xoptsq + xopt(i)**2 + END DO +90 nfsav = nf + ! + ! Generate the next trust region step and test its length. Set KNEW + ! to -1 if the purpose of the next F will be to improve the model. + ! +100 knew = 0 + CALL trsapp(n, npt, xopt, xpt, gq, hq, pq, delta, d, w, w(np), w(np + n), w(np + 2*n), crvmin) + dsq = zero + DO i = 1, n + dsq = dsq + d(i)**2 + END DO + dnorm = MIN(delta, SQRT(dsq)) + IF (dnorm < half*rho) THEN + knew = -1 + delta = tenth*delta + ratio = -1.0_dp + IF (delta <= 1.5_dp*rho) delta = rho + IF (nf <= nfsav + 2) GOTO 460 + temp = 0.125_dp*crvmin*rho*rho + IF (temp <= MAX(diffa, diffb, diffc)) GOTO 460 + GOTO 490 + END IF + ! + ! Shift XBASE if XOPT may be too far from XBASE. First make the chan + ! to BMAT that do not depend on ZMAT. + ! +120 IF (dsq <= 1.0e-3_dp*xoptsq) THEN + tempq = 0.25_dp*xoptsq + DO k = 1, npt + sum = zero + DO i = 1, n + sum = sum + xpt(k, i)*xopt(i) + END DO + temp = pq(k)*sum + sum = sum - half*xoptsq + w(npt + k) = sum + DO i = 1, n + gq(i) = gq(i) + temp*xpt(k, i) + xpt(k, i) = xpt(k, i) - half*xopt(i) + vlag(i) = bmat(k, i) + w(i) = sum*xpt(k, i) + tempq*xopt(i) + ip = npt + i + DO j = 1, i + bmat(ip, j) = bmat(ip, j) + vlag(i)*w(j) + w(i)*vlag(j) + END DO + END DO + END DO + ! + ! Then the revisions of BMAT that depend on ZMAT are calculated. + ! + DO k = 1, nptm + sumz = zero + DO i = 1, npt + sumz = sumz + zmat(i, k) + w(i) = w(npt + i)*zmat(i, k) + END DO + DO j = 1, n + sum = tempq*sumz*xopt(j) + DO i = 1, npt + sum = sum + w(i)*xpt(i, j) + vlag(j) = sum + IF (k < idz) sum = -sum + END DO + DO i = 1, npt + bmat(i, j) = bmat(i, j) + sum*zmat(i, k) + END DO + END DO + DO i = 1, n + ip = i + npt + temp = vlag(i) + IF (k < idz) temp = -temp + DO j = 1, i + bmat(ip, j) = bmat(ip, j) + temp*vlag(j) + END DO + END DO + END DO + ! + ! The following instructions complete the shift of XBASE, including + ! the changes to the parameters of the quadratic model. + ! + ih = 0 + DO j = 1, n + w(j) = zero + DO k = 1, npt + w(j) = w(j) + pq(k)*xpt(k, j) + xpt(k, j) = xpt(k, j) - half*xopt(j) + END DO + DO i = 1, j + ih = ih + 1 + IF (i < j) gq(j) = gq(j) + hq(ih)*xopt(i) + gq(i) = gq(i) + hq(ih)*xopt(j) + hq(ih) = hq(ih) + w(i)*xopt(j) + xopt(i)*w(j) + bmat(npt + i, j) = bmat(npt + j, i) + END DO + END DO + DO j = 1, n + xbase(j) = xbase(j) + xopt(j) + xopt(j) = zero + END DO + xoptsq = zero + END IF + ! + ! Pick the model step if KNEW is positive. A different choice of D + ! may be made later, if the choice of D by BIGLAG causes substantial + ! cancellation in DENOM. + ! + IF (knew > 0) THEN + CALL biglag(n, npt, xopt, xpt, bmat, zmat, idz, ndim, knew, dstep, & + d, alpha, vlag, vlag(npt + 1), w, w(np), w(np + n)) + END IF + ! + ! Calculate VLAG and BETA for the current choice of D. The first NPT + ! components of W_check will be held in W. + ! + DO k = 1, npt + suma = zero + sumb = zero + sum = zero + DO j = 1, n + suma = suma + xpt(k, j)*d(j) + sumb = sumb + xpt(k, j)*xopt(j) + sum = sum + bmat(k, j)*d(j) + END DO + w(k) = suma*(half*suma + sumb) + vlag(k) = sum + END DO + beta = zero + DO k = 1, nptm + sum = zero + DO i = 1, npt + sum = sum + zmat(i, k)*w(i) + END DO + IF (k < idz) THEN + beta = beta + sum*sum + sum = -sum + ELSE + beta = beta - sum*sum + END IF + DO i = 1, npt + vlag(i) = vlag(i) + sum*zmat(i, k) + END DO + END DO + bsum = zero + dx = zero + DO j = 1, n + sum = zero + DO i = 1, npt + sum = sum + w(i)*bmat(i, j) + END DO + bsum = bsum + sum*d(j) + jp = npt + j + DO k = 1, n + sum = sum + bmat(jp, k)*d(k) + END DO + vlag(jp) = sum + bsum = bsum + sum*d(j) + dx = dx + d(j)*xopt(j) + END DO + beta = dx*dx + dsq*(xoptsq + dx + dx + half*dsq) + beta - bsum + vlag(kopt) = vlag(kopt) + one + ! + ! If KNEW is positive and if the cancellation in DENOM is unacceptab + ! then BIGDEN calculates an alternative model step, XNEW being used + ! working space. + ! + IF (knew > 0) THEN + temp = one + alpha*beta/vlag(knew)**2 + IF (ABS(temp) <= 0.8_dp) THEN + CALL bigden(n, npt, xopt, xpt, bmat, zmat, idz, ndim, kopt, & + knew, d, w, vlag, beta, xnew, w(ndim + 1), w(6*ndim + 1)) + END IF + END IF + ! + ! Calculate the next value of the objective function. + ! +290 DO i = 1, n + xnew(i) = xopt(i) + d(i) + x(i) = xbase(i) + xnew(i) + END DO + nf = nf + 1 +310 IF (nf > nftest) THEN + ! return to many steps + nf = nf - 1 + opt%state = 3 + CALL get_state + GOTO 530 + END IF + + CALL get_state + + opt%state = 2 + + RETURN + +1000 CONTINUE + + CALL set_state + + IF (nf <= npt) GOTO 70 + IF (knew == -1) THEN + opt%state = 6 + CALL get_state + GOTO 530 + END IF + ! + ! Use the quadratic model to predict the change in F due to the step + ! and set DIFF to the error of this prediction. + ! + vquad = zero + ih = 0 + DO j = 1, n + vquad = vquad + d(j)*gq(j) + DO i = 1, j + ih = ih + 1 + temp = d(i)*xnew(j) + d(j)*xopt(i) + IF (i == j) temp = half*temp + vquad = vquad + temp*hq(ih) + END DO + END DO + DO k = 1, npt + vquad = vquad + pq(k)*w(k) + END DO + diff = f - fopt - vquad + diffc = diffb + diffb = diffa + diffa = ABS(diff) + IF (dnorm > rho) nfsav = nf + ! + ! Update FOPT and XOPT if the new F is the least value of the object + ! function so far. The branch when KNEW is positive occurs if D is n + ! a trust region step. + ! + fsave = fopt + IF (f < fopt) THEN + fopt = f + xoptsq = zero + DO i = 1, n + xopt(i) = xnew(i) + xoptsq = xoptsq + xopt(i)**2 + END DO + END IF + ksave = knew + IF (knew > 0) GOTO 410 + ! + ! Pick the next value of DELTA after a trust region step. + ! + IF (vquad >= zero) THEN + ! Return because a trust region step has failed to reduce Q + opt%state = 4 + CALL get_state + GOTO 530 + END IF + ratio = (f - fsave)/vquad + IF (ratio <= tenth) THEN + delta = half*dnorm + ELSE IF (ratio <= 0.7_dp) THEN + delta = MAX(half*delta, dnorm) + ELSE + delta = MAX(half*delta, dnorm + dnorm) + END IF + IF (delta <= 1.5_dp*rho) delta = rho + ! + ! Set KNEW to the index of the next interpolation point to be delete + ! + rhosq = MAX(tenth*delta, rho)**2 + ktemp = 0 + detrat = zero + IF (f >= fsave) THEN + ktemp = kopt + detrat = one + END IF + DO k = 1, npt + hdiag = zero + DO j = 1, nptm + temp = one + IF (j < idz) temp = -one + hdiag = hdiag + temp*zmat(k, j)**2 + END DO + temp = ABS(beta*hdiag + vlag(k)**2) + distsq = zero + DO j = 1, n + distsq = distsq + (xpt(k, j) - xopt(j))**2 + END DO + IF (distsq > rhosq) temp = temp*(distsq/rhosq)**3 + IF (temp > detrat .AND. k /= ktemp) THEN + detrat = temp + knew = k + END IF + END DO + IF (knew == 0) GOTO 460 + ! + ! Update BMAT, ZMAT and IDZ, so that the KNEW-th interpolation point + ! can be moved. Begin the updating of the quadratic model, starting + ! with the explicit second derivative term. + ! +410 CALL update(n, npt, bmat, zmat, idz, ndim, vlag, beta, knew, w) + fval(knew) = f + ih = 0 + DO i = 1, n + temp = pq(knew)*xpt(knew, i) + DO j = 1, i + ih = ih + 1 + hq(ih) = hq(ih) + temp*xpt(knew, j) + END DO + END DO + pq(knew) = zero + ! + ! Update the other second derivative parameters, and then the gradie + ! vector of the model. Also include the new interpolation point. + ! + DO j = 1, nptm + temp = diff*zmat(knew, j) + IF (j < idz) temp = -temp + DO k = 1, npt + pq(k) = pq(k) + temp*zmat(k, j) + END DO + END DO + gqsq = zero + DO i = 1, n + gq(i) = gq(i) + diff*bmat(knew, i) + gqsq = gqsq + gq(i)**2 + xpt(knew, i) = xnew(i) + END DO + ! + ! If a trust region step makes a small change to the objective funct + ! then calculate the gradient of the least Frobenius norm interpolan + ! XBASE, and store it in W, using VLAG for a vector of right hand si + ! + IF (ksave == 0 .AND. delta == rho) THEN + IF (ABS(ratio) > 1.0e-2_dp) THEN + itest = 0 + ELSE + DO k = 1, npt + vlag(k) = fval(k) - fval(kopt) + END DO + gisq = zero + DO i = 1, n + sum = zero + DO k = 1, npt + sum = sum + bmat(k, i)*vlag(k) + END DO + gisq = gisq + sum*sum + w(i) = sum + END DO + ! + ! Test whether to replace the new quadratic model by the least Frobe + ! norm interpolant, making the replacement if the test is satisfied. + ! + itest = itest + 1 + IF (gqsq < 1.0e2_dp*gisq) itest = 0 + IF (itest >= 3) THEN + DO i = 1, n + gq(i) = w(i) + END DO + DO ih = 1, nh + hq(ih) = zero + END DO + DO j = 1, nptm + w(j) = zero + DO k = 1, npt + w(j) = w(j) + vlag(k)*zmat(k, j) + END DO + IF (j < idz) w(j) = -w(j) + END DO + DO k = 1, npt + pq(k) = zero + DO j = 1, nptm + pq(k) = pq(k) + zmat(k, j)*w(j) + END DO + END DO + itest = 0 + END IF + END IF + END IF + IF (f < fsave) kopt = knew + ! + ! If a trust region step has provided a sufficient decrease in F, th + ! branch for another trust region calculation. The case KSAVE>0 occu + ! when the new function value was calculated by a model step. + ! + IF (f <= fsave + tenth*vquad) GOTO 100 + IF (ksave > 0) GOTO 100 + ! + ! Alternatively, find out if the interpolation points are close enou + ! to the best point so far. + ! + knew = 0 +460 distsq = 4.0_dp*delta*delta + DO k = 1, npt + sum = zero + DO j = 1, n + sum = sum + (xpt(k, j) - xopt(j))**2 + END DO + IF (sum > distsq) THEN + knew = k + distsq = sum + END IF + END DO + ! + ! If KNEW is positive, then set DSTEP, and branch back for the next + ! iteration, which will generate a "model step". + ! + IF (knew > 0) THEN + dstep = MAX(MIN(tenth*SQRT(distsq), half*delta), rho) + dsq = dstep*dstep + GOTO 120 + END IF + IF (ratio > zero) GOTO 100 + IF (MAX(delta, dnorm) > rho) GOTO 100 + ! + ! The calculations with the current value of RHO are complete. Pick + ! next values of RHO and DELTA. + ! +490 IF (rho > rhoend) THEN + delta = half*rho + ratio = rho/rhoend + IF (ratio <= 16.0_dp) THEN + rho = rhoend + ELSE IF (ratio <= 250.0_dp) THEN + rho = SQRT(ratio)*rhoend + ELSE + rho = tenth*rho + END IF + delta = MAX(delta, rho) + GOTO 90 + END IF + ! + ! Return from the calculation, after another Newton-Raphson step, if + ! it is too short to have been tried before. + ! + IF (knew == -1) GOTO 290 + opt%state = 7 + CALL get_state +530 IF (fopt <= f) THEN + DO i = 1, n + x(i) = xbase(i) + xopt(i) + END DO + f = fopt + END IF + + CALL get_state + + !****************************************************************************** + CONTAINS + !****************************************************************************** ! ************************************************************************************************** !> \brief ... ! ************************************************************************************************** - SUBROUTINE get_state() - opt%np = np - opt%nh = nh - opt%nptm = nptm - opt%nftest = nftest - opt%idz = idz - opt%itest = itest - opt%nf = nf - opt%nfm = nfm - opt%nfmm = nfmm - opt%nfsav = nfsav - opt%knew = knew - opt%kopt = kopt - opt%ksave = ksave - opt%ktemp = ktemp - opt%rhosq = rhosq - opt%recip = recip - opt%reciq = reciq - opt%fbeg = fbeg - opt%fopt = fopt - opt%diffa = diffa - opt%xoptsq = xoptsq - opt%rho = rho - opt%delta = delta - opt%dsq = dsq - opt%dnorm = dnorm - opt%ratio = ratio - opt%temp = temp - opt%tempq = tempq - opt%beta = beta - opt%dx = dx - opt%vquad = vquad - opt%diff = diff - opt%diffc = diffc - opt%diffb = diffb - opt%fsave = fsave - opt%detrat = detrat - opt%hdiag = hdiag - opt%distsq = distsq - opt%gisq = gisq - opt%gqsq = gqsq - opt%f = f - opt%bstep = bstep - opt%alpha = alpha - opt%dstep = dstep - END SUBROUTINE get_state - - !****************************************************************************** + SUBROUTINE get_state() + opt%np = np + opt%nh = nh + opt%nptm = nptm + opt%nftest = nftest + opt%idz = idz + opt%itest = itest + opt%nf = nf + opt%nfm = nfm + opt%nfmm = nfmm + opt%nfsav = nfsav + opt%knew = knew + opt%kopt = kopt + opt%ksave = ksave + opt%ktemp = ktemp + opt%rhosq = rhosq + opt%recip = recip + opt%reciq = reciq + opt%fbeg = fbeg + opt%fopt = fopt + opt%diffa = diffa + opt%xoptsq = xoptsq + opt%rho = rho + opt%delta = delta + opt%dsq = dsq + opt%dnorm = dnorm + opt%ratio = ratio + opt%temp = temp + opt%tempq = tempq + opt%beta = beta + opt%dx = dx + opt%vquad = vquad + opt%diff = diff + opt%diffc = diffc + opt%diffb = diffb + opt%fsave = fsave + opt%detrat = detrat + opt%hdiag = hdiag + opt%distsq = distsq + opt%gisq = gisq + opt%gqsq = gqsq + opt%f = f + opt%bstep = bstep + opt%alpha = alpha + opt%dstep = dstep + END SUBROUTINE get_state + + !****************************************************************************** ! ************************************************************************************************** !> \brief ... ! ************************************************************************************************** - SUBROUTINE set_state() - np = opt%np - nh = opt%nh - nptm = opt%nptm - nftest = opt%nftest - idz = opt%idz - itest = opt%itest - nf = opt%nf - nfm = opt%nfm - nfmm = opt%nfmm - nfsav = opt%nfsav - knew = opt%knew - kopt = opt%kopt - ksave = opt%ksave - ktemp = opt%ktemp - rhosq = opt%rhosq - recip = opt%recip - reciq = opt%reciq - fbeg = opt%fbeg - fopt = opt%fopt - diffa = opt%diffa - xoptsq = opt%xoptsq - rho = opt%rho - delta = opt%delta - dsq = opt%dsq - dnorm = opt%dnorm - ratio = opt%ratio - temp = opt%temp - tempq = opt%tempq - beta = opt%beta - dx = opt%dx - vquad = opt%vquad - diff = opt%diff - diffc = opt%diffc - diffb = opt%diffb - fsave = opt%fsave - detrat = opt%detrat - hdiag = opt%hdiag - distsq = opt%distsq - gisq = opt%gisq - gqsq = opt%gqsq - f = opt%f - bstep = opt%bstep - alpha = opt%alpha - dstep = opt%dstep - END SUBROUTINE set_state - - END SUBROUTINE newuob + SUBROUTINE set_state() + np = opt%np + nh = opt%nh + nptm = opt%nptm + nftest = opt%nftest + idz = opt%idz + itest = opt%itest + nf = opt%nf + nfm = opt%nfm + nfmm = opt%nfmm + nfsav = opt%nfsav + knew = opt%knew + kopt = opt%kopt + ksave = opt%ksave + ktemp = opt%ktemp + rhosq = opt%rhosq + recip = opt%recip + reciq = opt%reciq + fbeg = opt%fbeg + fopt = opt%fopt + diffa = opt%diffa + xoptsq = opt%xoptsq + rho = opt%rho + delta = opt%delta + dsq = opt%dsq + dnorm = opt%dnorm + ratio = opt%ratio + temp = opt%temp + tempq = opt%tempq + beta = opt%beta + dx = opt%dx + vquad = opt%vquad + diff = opt%diff + diffc = opt%diffc + diffb = opt%diffb + fsave = opt%fsave + detrat = opt%detrat + hdiag = opt%hdiag + distsq = opt%distsq + gisq = opt%gisq + gqsq = opt%gqsq + f = opt%f + bstep = opt%bstep + alpha = opt%alpha + dstep = opt%dstep + END SUBROUTINE set_state + + END SUBROUTINE newuob !****************************************************************************** @@ -1028,8 +1027,8 @@ END SUBROUTINE newuob !> \param wvec ... !> \param prod ... ! ************************************************************************************************** - SUBROUTINE bigden (n,npt,xopt,xpt,bmat,zmat,idz,ndim,kopt,& - knew,d,w,vlag,beta,s,wvec,prod) + SUBROUTINE bigden(n, npt, xopt, xpt, bmat, zmat, idz, ndim, kopt, & + knew, d, w, vlag, beta, s, wvec, prod) INTEGER, INTENT(inout) :: n, npt REAL(dp), DIMENSION(*), INTENT(inout) :: xopt @@ -1050,7 +1049,7 @@ SUBROUTINE bigden (n,npt,xopt,xpt,bmat,zmat,idz,ndim,kopt,& INTEGER :: i, ip, isave, iterc, iu, j, jc, k, ksav, & nptm, nw REAL(dp) :: alpha, angle, dd, denmax, denold, densav, diff, ds, dstemp, dtest, ss, ssden, & - sstemp, step, sum, sumold, tau, temp, tempa, tempb, tempc, xoptd, xopts, xoptsq + sstemp, step, sum, sumold, tau, temp, tempa, tempb, tempc, xoptd, xopts, xoptsq REAL(dp), DIMENSION(9) :: den, denex, par ! @@ -1078,325 +1077,325 @@ SUBROUTINE bigden (n,npt,xopt,xpt,bmat,zmat,idz,ndim,kopt,& ! shifted to the new position XOPT+D. ! - nptm=npt-n-1 - ! - ! Store the first NPT elements of the KNEW-th column of H in W(N+1) - ! to W(N+NPT). - ! - DO k=1,npt - w(n+k)=zero - END DO - DO j=1,nptm - temp=zmat(knew,j) - IF (j < idz) temp=-temp - DO k=1,npt - w(n+k)=w(n+k)+temp*zmat(k,j) - END DO - END DO - alpha=w(n+knew) - ! - ! The initial search direction D is taken from the last call of BIGL - ! and the initial S is set below, usually to the direction from X_OP - ! to X_KNEW, but a different direction to an interpolation point may - ! be chosen, in order to prevent S from being nearly parallel to D. - ! - dd=zero - ds=zero - ss=zero - xoptsq=zero - DO i=1,n - dd=dd+d(i)**2 - s(i)=xpt(knew,i)-xopt(i) - ds=ds+d(i)*s(i) - ss=ss+s(i)**2 - xoptsq=xoptsq+xopt(i)**2 - END DO - IF (ds*ds > 0.99_dp*dd*ss) THEN - ksav=knew - dtest=ds*ds/ss - DO k=1,npt - IF (k /= kopt) THEN - dstemp=zero - sstemp=zero - DO i=1,n - diff=xpt(k,i)-xopt(i) - dstemp=dstemp+d(i)*diff - sstemp=sstemp+diff*diff - END DO - IF (dstemp*dstemp/sstemp < dtest) THEN - ksav=k - dtest=dstemp*dstemp/sstemp - ds=dstemp - ss=sstemp - END IF - END IF - END DO - DO i=1,n - s(i)=xpt(ksav,i)-xopt(i) - END DO - END IF - ssden=dd*ss-ds*ds - iterc=0 - densav=zero - ! - ! Begin the iteration by overwriting S with a vector that has the - ! required length and direction. - ! - mainloop : DO - iterc=iterc+1 - temp=one/SQRT(ssden) - xoptd=zero - xopts=zero - DO i=1,n - s(i)=temp*(dd*s(i)-ds*d(i)) - xoptd=xoptd+xopt(i)*d(i) - xopts=xopts+xopt(i)*s(i) - END DO - ! - ! Set the coefficients of the first two terms of BETA. - ! - tempa=half*xoptd*xoptd - tempb=half*xopts*xopts - den(1)=dd*(xoptsq+half*dd)+tempa+tempb - den(2)=two*xoptd*dd - den(3)=two*xopts*dd - den(4)=tempa-tempb - den(5)=xoptd*xopts - DO i=6,9 - den(i)=zero - END DO - ! - ! Put the coefficients of Wcheck in WVEC. - ! - DO k=1,npt - tempa=zero - tempb=zero - tempc=zero - DO i=1,n - tempa=tempa+xpt(k,i)*d(i) - tempb=tempb+xpt(k,i)*s(i) - tempc=tempc+xpt(k,i)*xopt(i) - END DO - wvec(k,1)=quart*(tempa*tempa+tempb*tempb) - wvec(k,2)=tempa*tempc - wvec(k,3)=tempb*tempc - wvec(k,4)=quart*(tempa*tempa-tempb*tempb) - wvec(k,5)=half*tempa*tempb - END DO - DO i=1,n - ip=i+npt - wvec(ip,1)=zero - wvec(ip,2)=d(i) - wvec(ip,3)=s(i) - wvec(ip,4)=zero - wvec(ip,5)=zero - END DO - ! - ! Put the coefficents of THETA*Wcheck in PROD. - ! - DO jc=1,5 - nw=npt - IF (jc == 2 .OR. jc == 3) nw=ndim - DO k=1,npt - prod(k,jc)=zero - END DO - DO j=1,nptm - sum=zero - DO k=1,npt - sum=sum+zmat(k,j)*wvec(k,jc) - END DO - IF (j < idz) sum=-sum - DO k=1,npt - prod(k,jc)=prod(k,jc)+sum*zmat(k,j) - END DO - END DO - IF (nw == ndim) THEN - DO k=1,npt - sum=zero - DO j=1,n - sum=sum+bmat(k,j)*wvec(npt+j,jc) - END DO - prod(k,jc)=prod(k,jc)+sum - END DO - END IF - DO j=1,n - sum=zero - DO i=1,nw - sum=sum+bmat(i,j)*wvec(i,jc) - END DO - prod(npt+j,jc)=sum - END DO - END DO - ! - ! Include in DEN the part of BETA that depends on THETA. - ! - DO k=1,ndim - sum=zero - DO I=1,5 - par(i)=half*prod(k,i)*wvec(k,i) - sum=sum+par(i) - END DO - den(1)=den(1)-par(1)-sum - tempa=prod(k,1)*wvec(k,2)+prod(k,2)*wvec(k,1) - tempb=prod(k,2)*wvec(k,4)+prod(k,4)*wvec(k,2) - tempc=prod(k,3)*wvec(k,5)+prod(k,5)*wvec(k,3) - den(2)=den(2)-tempa-half*(tempb+tempc) - den(6)=den(6)-half*(tempb-tempc) - tempa=prod(k,1)*wvec(k,3)+prod(k,3)*wvec(k,1) - tempb=prod(k,2)*wvec(k,5)+prod(k,5)*wvec(k,2) - tempc=prod(k,3)*wvec(k,4)+prod(k,4)*wvec(k,3) - den(3)=den(3)-tempa-half*(tempb-tempc) - den(7)=den(7)-half*(tempb+tempc) - tempa=prod(k,1)*wvec(k,4)+prod(k,4)*wvec(k,1) - den(4)=den(4)-tempa-par(2)+par(3) - tempa=prod(k,1)*wvec(k,5)+prod(k,5)*wvec(k,1) - tempb=prod(k,2)*wvec(k,3)+prod(k,3)*wvec(k,2) - den(5)=den(5)-tempa-half*tempb - den(8)=den(8)-par(4)+par(5) - tempa=prod(k,4)*wvec(k,5)+prod(k,5)*wvec(k,4) - den(9)=den(9)-half*tempa - END DO - ! - ! Extend DEN so that it holds all the coefficients of DENOM. - ! - sum=zero - DO i=1,5 - par(i)=half*prod(knew,i)**2 - sum=sum+par(i) - END DO - denex(1)=alpha*den(1)+par(1)+sum - tempa=two*prod(knew,1)*prod(knew,2) - tempb=prod(knew,2)*prod(knew,4) - tempc=prod(knew,3)*prod(knew,5) - denex(2)=alpha*den(2)+tempa+tempb+tempc - denex(6)=alpha*den(6)+tempb-tempc - tempa=two*prod(knew,1)*prod(knew,3) - tempb=prod(knew,2)*prod(knew,5) - tempc=prod(knew,3)*prod(knew,4) - denex(3)=alpha*den(3)+tempa+tempb-tempc - denex(7)=alpha*den(7)+tempb+tempc - tempa=two*prod(knew,1)*prod(knew,4) - denex(4)=alpha*den(4)+tempa+par(2)-par(3) - tempa=two*prod(knew,1)*prod(knew,5) - denex(5)=alpha*den(5)+tempa+prod(knew,2)*prod(knew,3) - denex(8)=alpha*den(8)+par(4)-par(5) - denex(9)=alpha*den(9)+prod(knew,4)*prod(knew,5) - ! - ! Seek the value of the angle that maximizes the modulus of DENOM. - ! - sum=denex(1)+denex(2)+denex(4)+denex(6)+denex(8) - denold=sum - denmax=sum - isave=0 - iu=49 - temp=twopi/REAL(IU+1,dp) - par(1)=one - DO i=1,iu - angle=REAL(i,dp)*temp - par(2)=COS(angle) - par(3)=SIN(angle) - DO j=4,8,2 - par(j)=par(2)*par(j-2)-par(3)*par(j-1) - par(j+1)=par(2)*par(j-1)+par(3)*par(j-2) - END DO - sumold=sum - sum=zero - DO j=1,9 - sum=sum+denex(j)*par(j) - END DO - IF (ABS(sum) > ABS(denmax)) THEN - denmax=sum - isave=i - tempa=sumold - ELSE IF (i == isave+1) THEN - tempb=sum - END IF - END DO - IF (isave == 0) tempa=sum - IF (isave == iu) tempb=denold - step=zero - IF (tempa /= tempb) THEN - tempa=tempa-denmax - tempb=tempb-denmax - step=half*(tempa-tempb)/(tempa+tempb) - END IF - angle=temp*(REAL(isave,dp)+step) - ! - ! Calculate the new parameters of the denominator, the new VLAG vect - ! and the new D. Then test for convergence. - ! - par(2)=COS(angle) - par(3)=SIN(angle) - DO j=4,8,2 - par(j)=par(2)*par(j-2)-par(3)*par(j-1) - par(j+1)=par(2)*par(j-1)+par(3)*par(j-2) - END DO - beta=zero - denmax=zero - DO j=1,9 - beta=beta+den(j)*par(j) - denmax=denmax+denex(j)*par(j) - END DO - DO k=1,ndim - vlag(k)=zero - DO j=1,5 - vlag(k)=vlag(k)+prod(k,j)*par(j) - END DO - END DO - tau=vlag(knew) - dd=zero - tempa=zero - tempb=zero - DO i=1,n - d(i)=par(2)*d(i)+par(3)*s(i) - w(i)=xopt(i)+d(i) - dd=dd+d(i)**2 - tempa=tempa+d(i)*w(i) - tempb=tempb+w(i)*w(i) - END DO - IF (iterc >= n) EXIT mainloop - IF (iterc >= 1) densav=MAX(densav,denold) - IF (ABS(denmax) <= 1.1_dp*ABS(densav)) EXIT mainloop - densav=denmax - ! - ! Set S to half the gradient of the denominator with respect to D. - ! Then branch for the next iteration. - ! - DO i=1,n - temp=tempa*xopt(i)+tempb*d(i)-vlag(npt+i) - s(i)=tau*bmat(knew,i)+alpha*temp - END DO - DO k=1,npt - sum=zero - DO j=1,n - sum=sum+xpt(k,j)*w(j) - END DO - temp=(tau*w(n+k)-alpha*vlag(k))*sum - DO i=1,n - s(i)=s(i)+temp*xpt(k,i) - END DO - END DO - ss=zero - ds=zero - DO i=1,n - ss=ss+s(i)**2 - ds=ds+d(i)*s(i) - END DO - ssden=dd*ss-ds*ds - IF (ssden < 1.0e-8_dp*dd*ss) EXIT mainloop - END DO mainloop - ! - ! Set the vector W before the RETURN from the subroutine. - ! - DO k=1,ndim - w(k)=zero - DO j=1,5 - w(k)=w(k)+wvec(k,j)*par(j) - END DO - END DO - vlag(kopt)=vlag(kopt)+one - - END SUBROUTINE bigden + nptm = npt - n - 1 + ! + ! Store the first NPT elements of the KNEW-th column of H in W(N+1) + ! to W(N+NPT). + ! + DO k = 1, npt + w(n + k) = zero + END DO + DO j = 1, nptm + temp = zmat(knew, j) + IF (j < idz) temp = -temp + DO k = 1, npt + w(n + k) = w(n + k) + temp*zmat(k, j) + END DO + END DO + alpha = w(n + knew) + ! + ! The initial search direction D is taken from the last call of BIGL + ! and the initial S is set below, usually to the direction from X_OP + ! to X_KNEW, but a different direction to an interpolation point may + ! be chosen, in order to prevent S from being nearly parallel to D. + ! + dd = zero + ds = zero + ss = zero + xoptsq = zero + DO i = 1, n + dd = dd + d(i)**2 + s(i) = xpt(knew, i) - xopt(i) + ds = ds + d(i)*s(i) + ss = ss + s(i)**2 + xoptsq = xoptsq + xopt(i)**2 + END DO + IF (ds*ds > 0.99_dp*dd*ss) THEN + ksav = knew + dtest = ds*ds/ss + DO k = 1, npt + IF (k /= kopt) THEN + dstemp = zero + sstemp = zero + DO i = 1, n + diff = xpt(k, i) - xopt(i) + dstemp = dstemp + d(i)*diff + sstemp = sstemp + diff*diff + END DO + IF (dstemp*dstemp/sstemp < dtest) THEN + ksav = k + dtest = dstemp*dstemp/sstemp + ds = dstemp + ss = sstemp + END IF + END IF + END DO + DO i = 1, n + s(i) = xpt(ksav, i) - xopt(i) + END DO + END IF + ssden = dd*ss - ds*ds + iterc = 0 + densav = zero + ! + ! Begin the iteration by overwriting S with a vector that has the + ! required length and direction. + ! + mainloop: DO + iterc = iterc + 1 + temp = one/SQRT(ssden) + xoptd = zero + xopts = zero + DO i = 1, n + s(i) = temp*(dd*s(i) - ds*d(i)) + xoptd = xoptd + xopt(i)*d(i) + xopts = xopts + xopt(i)*s(i) + END DO + ! + ! Set the coefficients of the first two terms of BETA. + ! + tempa = half*xoptd*xoptd + tempb = half*xopts*xopts + den(1) = dd*(xoptsq + half*dd) + tempa + tempb + den(2) = two*xoptd*dd + den(3) = two*xopts*dd + den(4) = tempa - tempb + den(5) = xoptd*xopts + DO i = 6, 9 + den(i) = zero + END DO + ! + ! Put the coefficients of Wcheck in WVEC. + ! + DO k = 1, npt + tempa = zero + tempb = zero + tempc = zero + DO i = 1, n + tempa = tempa + xpt(k, i)*d(i) + tempb = tempb + xpt(k, i)*s(i) + tempc = tempc + xpt(k, i)*xopt(i) + END DO + wvec(k, 1) = quart*(tempa*tempa + tempb*tempb) + wvec(k, 2) = tempa*tempc + wvec(k, 3) = tempb*tempc + wvec(k, 4) = quart*(tempa*tempa - tempb*tempb) + wvec(k, 5) = half*tempa*tempb + END DO + DO i = 1, n + ip = i + npt + wvec(ip, 1) = zero + wvec(ip, 2) = d(i) + wvec(ip, 3) = s(i) + wvec(ip, 4) = zero + wvec(ip, 5) = zero + END DO + ! + ! Put the coefficents of THETA*Wcheck in PROD. + ! + DO jc = 1, 5 + nw = npt + IF (jc == 2 .OR. jc == 3) nw = ndim + DO k = 1, npt + prod(k, jc) = zero + END DO + DO j = 1, nptm + sum = zero + DO k = 1, npt + sum = sum + zmat(k, j)*wvec(k, jc) + END DO + IF (j < idz) sum = -sum + DO k = 1, npt + prod(k, jc) = prod(k, jc) + sum*zmat(k, j) + END DO + END DO + IF (nw == ndim) THEN + DO k = 1, npt + sum = zero + DO j = 1, n + sum = sum + bmat(k, j)*wvec(npt + j, jc) + END DO + prod(k, jc) = prod(k, jc) + sum + END DO + END IF + DO j = 1, n + sum = zero + DO i = 1, nw + sum = sum + bmat(i, j)*wvec(i, jc) + END DO + prod(npt + j, jc) = sum + END DO + END DO + ! + ! Include in DEN the part of BETA that depends on THETA. + ! + DO k = 1, ndim + sum = zero + DO I = 1, 5 + par(i) = half*prod(k, i)*wvec(k, i) + sum = sum + par(i) + END DO + den(1) = den(1) - par(1) - sum + tempa = prod(k, 1)*wvec(k, 2) + prod(k, 2)*wvec(k, 1) + tempb = prod(k, 2)*wvec(k, 4) + prod(k, 4)*wvec(k, 2) + tempc = prod(k, 3)*wvec(k, 5) + prod(k, 5)*wvec(k, 3) + den(2) = den(2) - tempa - half*(tempb + tempc) + den(6) = den(6) - half*(tempb - tempc) + tempa = prod(k, 1)*wvec(k, 3) + prod(k, 3)*wvec(k, 1) + tempb = prod(k, 2)*wvec(k, 5) + prod(k, 5)*wvec(k, 2) + tempc = prod(k, 3)*wvec(k, 4) + prod(k, 4)*wvec(k, 3) + den(3) = den(3) - tempa - half*(tempb - tempc) + den(7) = den(7) - half*(tempb + tempc) + tempa = prod(k, 1)*wvec(k, 4) + prod(k, 4)*wvec(k, 1) + den(4) = den(4) - tempa - par(2) + par(3) + tempa = prod(k, 1)*wvec(k, 5) + prod(k, 5)*wvec(k, 1) + tempb = prod(k, 2)*wvec(k, 3) + prod(k, 3)*wvec(k, 2) + den(5) = den(5) - tempa - half*tempb + den(8) = den(8) - par(4) + par(5) + tempa = prod(k, 4)*wvec(k, 5) + prod(k, 5)*wvec(k, 4) + den(9) = den(9) - half*tempa + END DO + ! + ! Extend DEN so that it holds all the coefficients of DENOM. + ! + sum = zero + DO i = 1, 5 + par(i) = half*prod(knew, i)**2 + sum = sum + par(i) + END DO + denex(1) = alpha*den(1) + par(1) + sum + tempa = two*prod(knew, 1)*prod(knew, 2) + tempb = prod(knew, 2)*prod(knew, 4) + tempc = prod(knew, 3)*prod(knew, 5) + denex(2) = alpha*den(2) + tempa + tempb + tempc + denex(6) = alpha*den(6) + tempb - tempc + tempa = two*prod(knew, 1)*prod(knew, 3) + tempb = prod(knew, 2)*prod(knew, 5) + tempc = prod(knew, 3)*prod(knew, 4) + denex(3) = alpha*den(3) + tempa + tempb - tempc + denex(7) = alpha*den(7) + tempb + tempc + tempa = two*prod(knew, 1)*prod(knew, 4) + denex(4) = alpha*den(4) + tempa + par(2) - par(3) + tempa = two*prod(knew, 1)*prod(knew, 5) + denex(5) = alpha*den(5) + tempa + prod(knew, 2)*prod(knew, 3) + denex(8) = alpha*den(8) + par(4) - par(5) + denex(9) = alpha*den(9) + prod(knew, 4)*prod(knew, 5) + ! + ! Seek the value of the angle that maximizes the modulus of DENOM. + ! + sum = denex(1) + denex(2) + denex(4) + denex(6) + denex(8) + denold = sum + denmax = sum + isave = 0 + iu = 49 + temp = twopi/REAL(IU + 1, dp) + par(1) = one + DO i = 1, iu + angle = REAL(i, dp)*temp + par(2) = COS(angle) + par(3) = SIN(angle) + DO j = 4, 8, 2 + par(j) = par(2)*par(j - 2) - par(3)*par(j - 1) + par(j + 1) = par(2)*par(j - 1) + par(3)*par(j - 2) + END DO + sumold = sum + sum = zero + DO j = 1, 9 + sum = sum + denex(j)*par(j) + END DO + IF (ABS(sum) > ABS(denmax)) THEN + denmax = sum + isave = i + tempa = sumold + ELSE IF (i == isave + 1) THEN + tempb = sum + END IF + END DO + IF (isave == 0) tempa = sum + IF (isave == iu) tempb = denold + step = zero + IF (tempa /= tempb) THEN + tempa = tempa - denmax + tempb = tempb - denmax + step = half*(tempa - tempb)/(tempa + tempb) + END IF + angle = temp*(REAL(isave, dp) + step) + ! + ! Calculate the new parameters of the denominator, the new VLAG vect + ! and the new D. Then test for convergence. + ! + par(2) = COS(angle) + par(3) = SIN(angle) + DO j = 4, 8, 2 + par(j) = par(2)*par(j - 2) - par(3)*par(j - 1) + par(j + 1) = par(2)*par(j - 1) + par(3)*par(j - 2) + END DO + beta = zero + denmax = zero + DO j = 1, 9 + beta = beta + den(j)*par(j) + denmax = denmax + denex(j)*par(j) + END DO + DO k = 1, ndim + vlag(k) = zero + DO j = 1, 5 + vlag(k) = vlag(k) + prod(k, j)*par(j) + END DO + END DO + tau = vlag(knew) + dd = zero + tempa = zero + tempb = zero + DO i = 1, n + d(i) = par(2)*d(i) + par(3)*s(i) + w(i) = xopt(i) + d(i) + dd = dd + d(i)**2 + tempa = tempa + d(i)*w(i) + tempb = tempb + w(i)*w(i) + END DO + IF (iterc >= n) EXIT mainloop + IF (iterc >= 1) densav = MAX(densav, denold) + IF (ABS(denmax) <= 1.1_dp*ABS(densav)) EXIT mainloop + densav = denmax + ! + ! Set S to half the gradient of the denominator with respect to D. + ! Then branch for the next iteration. + ! + DO i = 1, n + temp = tempa*xopt(i) + tempb*d(i) - vlag(npt + i) + s(i) = tau*bmat(knew, i) + alpha*temp + END DO + DO k = 1, npt + sum = zero + DO j = 1, n + sum = sum + xpt(k, j)*w(j) + END DO + temp = (tau*w(n + k) - alpha*vlag(k))*sum + DO i = 1, n + s(i) = s(i) + temp*xpt(k, i) + END DO + END DO + ss = zero + ds = zero + DO i = 1, n + ss = ss + s(i)**2 + ds = ds + d(i)*s(i) + END DO + ssden = dd*ss - ds*ds + IF (ssden < 1.0e-8_dp*dd*ss) EXIT mainloop + END DO mainloop + ! + ! Set the vector W before the RETURN from the subroutine. + ! + DO k = 1, ndim + w(k) = zero + DO j = 1, 5 + w(k) = w(k) + wvec(k, j)*par(j) + END DO + END DO + vlag(kopt) = vlag(kopt) + one + + END SUBROUTINE bigden !****************************************************************************** ! ************************************************************************************************** @@ -1419,8 +1418,8 @@ END SUBROUTINE bigden !> \param s ... !> \param w ... ! ************************************************************************************************** - SUBROUTINE biglag (n,npt,xopt,xpt,bmat,zmat,idz,ndim,knew,& - delta,d,alpha,hcol,gc,gd,s,w) + SUBROUTINE biglag(n, npt, xopt, xpt, bmat, zmat, idz, ndim, knew, & + delta, d, alpha, hcol, gc, gd, s, w) INTEGER, INTENT(inout) :: n, npt REAL(dp), DIMENSION(*), INTENT(inout) :: xopt REAL(dp), DIMENSION(npt, *), INTENT(inout) :: xpt @@ -1461,170 +1460,170 @@ SUBROUTINE biglag (n,npt,xopt,xpt,bmat,zmat,idz,ndim,knew,& ! the KNEW-th Lagrange function. ! - delsq=delta*delta - nptm=npt-n-1 - ! - ! Set the first NPT components of HCOL to the leading elements of th - ! KNEW-th column of H. - ! - iterc=0 - DO k=1,npt - hcol(k)=zero - END DO - DO j=1,nptm - temp=zmat(knew,j) - IF (j < idz) temp=-temp - DO k=1,npt - hcol(k)=hcol(k)+temp*zmat(k,j) - END DO - END DO - alpha=hcol(knew) - ! - ! Set the unscaled initial direction D. Form the gradient of LFUNC a - ! XOPT, and multiply D by the second derivative matrix of LFUNC. - ! - dd=zero - DO i=1,n - d(i)=xpt(knew,i)-xopt(i) - gc(i)=bmat(knew,i) - gd(i)=zero - dd=dd+d(i)**2 - END DO - DO k=1,npt - temp=zero - sum=zero - DO j=1,n - temp=temp+xpt(k,j)*xopt(j) - sum=sum+xpt(k,j)*d(j) - END DO - temp=hcol(k)*temp - sum=hcol(k)*sum - DO i=1,n - gc(i)=gc(i)+temp*xpt(k,i) - gd(i)=gd(i)+sum*xpt(k,i) - END DO - END DO - ! - ! Scale D and GD, with a sign change if required. Set S to another - ! vector in the initial two dimensional subspace. - ! - gg=zero - sp=zero - dhd=zero - DO i=1,n - gg=gg+gc(i)**2 - sp=sp+d(i)*gc(i) - dhd=dhd+d(i)*gd(i) - END DO - scale=delta/SQRT(dd) - IF (sp*dhd < zero) scale=-scale - temp=zero - IF (sp*sp > 0.99_dp*dd*gg) temp=one - tau=scale*(ABS(sp)+half*scale*ABS(dhd)) - IF (gg*delsq < 0.01_dp*tau*tau) temp=one - DO i=1,n - d(i)=scale*d(i) - gd(i)=scale*gd(i) - s(i)=gc(i)+temp*gd(i) - END DO - ! - ! Begin the iteration by overwriting S with a vector that has the - ! required length and direction, except that termination occurs if - ! the given D and S are nearly parallel. - ! - mainloop : DO - iterc=iterc+1 - dd=zero - sp=zero - ss=zero - DO i=1,n - dd=dd+d(i)**2 - sp=sp+d(i)*s(i) - ss=ss+s(i)**2 - END DO - temp=dd*ss-sp*sp - IF (temp <= 1.0e-8_dp*dd*ss) EXIT mainloop - denom=SQRT(temp) - DO i=1,n - s(i)=(dd*s(i)-sp*d(i))/denom - w(i)=zero - END DO - ! - ! Calculate the coefficients of the objective function on the circle - ! beginning with the multiplication of S by the second derivative ma - ! - DO k=1,npt - sum=zero - DO j=1,n - sum=sum+xpt(k,j)*s(j) - END DO - sum=hcol(k)*sum - DO i=1,n - w(i)=w(i)+sum*xpt(k,i) - END DO - END DO - cf1=zero - cf2=zero - cf3=zero - cf4=zero - cf5=zero - DO i=1,n - cf1=cf1+s(i)*w(i) - cf2=cf2+d(i)*gc(i) - cf3=cf3+s(i)*gc(i) - cf4=cf4+d(i)*gd(i) - cf5=cf5+s(i)*gd(i) - END DO - cf1=half*cf1 - cf4=half*cf4-cf1 - ! - ! Seek the value of the angle that maximizes the modulus of TAU. - ! - taubeg=cf1+cf2+cf4 - taumax=taubeg - tauold=taubeg - isave=0 - iu=49 - temp=twopi/REAL(iu+1,DP) - DO i=1,iu - angle=REAL(i,dp)*temp - cth=COS(angle) - sth=SIN(angle) - tau=cf1+(cf2+cf4*cth)*cth+(cf3+cf5*cth)*sth - IF (ABS(tau) > ABS(taumax)) THEN - taumax=tau - isave=i - tempa=tauold - ELSE IF (i == isave+1) THEN - tempb=taU - END IF - tauold=tau - END DO - IF (isave == 0) tempa=tau - IF (isave == iu) tempb=taubeg - step=zero - IF (tempa /= tempb) THEN - tempa=tempa-taumax - tempb=tempb-taumax - step=half*(tempa-tempb)/(tempa+tempb) - END IF - angle=temp*(REAL(isave,DP)+step) - ! - ! Calculate the new D and GD. Then test for convergence. - ! - cth=COS(angle) - sth=SIN(angle) - tau=cf1+(cf2+cf4*cth)*cth+(cf3+cf5*cth)*sth - DO i=1,n - d(i)=cth*d(i)+sth*s(i) - gd(i)=cth*gd(i)+sth*w(i) - s(i)=gc(i)+gd(i) - END DO - IF (ABS(tau) <= 1.1_dp*ABS(taubeg)) EXIT mainloop - IF (iterc >= n) EXIT mainloop - END DO mainloop - - END SUBROUTINE biglag + delsq = delta*delta + nptm = npt - n - 1 + ! + ! Set the first NPT components of HCOL to the leading elements of th + ! KNEW-th column of H. + ! + iterc = 0 + DO k = 1, npt + hcol(k) = zero + END DO + DO j = 1, nptm + temp = zmat(knew, j) + IF (j < idz) temp = -temp + DO k = 1, npt + hcol(k) = hcol(k) + temp*zmat(k, j) + END DO + END DO + alpha = hcol(knew) + ! + ! Set the unscaled initial direction D. Form the gradient of LFUNC a + ! XOPT, and multiply D by the second derivative matrix of LFUNC. + ! + dd = zero + DO i = 1, n + d(i) = xpt(knew, i) - xopt(i) + gc(i) = bmat(knew, i) + gd(i) = zero + dd = dd + d(i)**2 + END DO + DO k = 1, npt + temp = zero + sum = zero + DO j = 1, n + temp = temp + xpt(k, j)*xopt(j) + sum = sum + xpt(k, j)*d(j) + END DO + temp = hcol(k)*temp + sum = hcol(k)*sum + DO i = 1, n + gc(i) = gc(i) + temp*xpt(k, i) + gd(i) = gd(i) + sum*xpt(k, i) + END DO + END DO + ! + ! Scale D and GD, with a sign change if required. Set S to another + ! vector in the initial two dimensional subspace. + ! + gg = zero + sp = zero + dhd = zero + DO i = 1, n + gg = gg + gc(i)**2 + sp = sp + d(i)*gc(i) + dhd = dhd + d(i)*gd(i) + END DO + scale = delta/SQRT(dd) + IF (sp*dhd < zero) scale = -scale + temp = zero + IF (sp*sp > 0.99_dp*dd*gg) temp = one + tau = scale*(ABS(sp) + half*scale*ABS(dhd)) + IF (gg*delsq < 0.01_dp*tau*tau) temp = one + DO i = 1, n + d(i) = scale*d(i) + gd(i) = scale*gd(i) + s(i) = gc(i) + temp*gd(i) + END DO + ! + ! Begin the iteration by overwriting S with a vector that has the + ! required length and direction, except that termination occurs if + ! the given D and S are nearly parallel. + ! + mainloop: DO + iterc = iterc + 1 + dd = zero + sp = zero + ss = zero + DO i = 1, n + dd = dd + d(i)**2 + sp = sp + d(i)*s(i) + ss = ss + s(i)**2 + END DO + temp = dd*ss - sp*sp + IF (temp <= 1.0e-8_dp*dd*ss) EXIT mainloop + denom = SQRT(temp) + DO i = 1, n + s(i) = (dd*s(i) - sp*d(i))/denom + w(i) = zero + END DO + ! + ! Calculate the coefficients of the objective function on the circle + ! beginning with the multiplication of S by the second derivative ma + ! + DO k = 1, npt + sum = zero + DO j = 1, n + sum = sum + xpt(k, j)*s(j) + END DO + sum = hcol(k)*sum + DO i = 1, n + w(i) = w(i) + sum*xpt(k, i) + END DO + END DO + cf1 = zero + cf2 = zero + cf3 = zero + cf4 = zero + cf5 = zero + DO i = 1, n + cf1 = cf1 + s(i)*w(i) + cf2 = cf2 + d(i)*gc(i) + cf3 = cf3 + s(i)*gc(i) + cf4 = cf4 + d(i)*gd(i) + cf5 = cf5 + s(i)*gd(i) + END DO + cf1 = half*cf1 + cf4 = half*cf4 - cf1 + ! + ! Seek the value of the angle that maximizes the modulus of TAU. + ! + taubeg = cf1 + cf2 + cf4 + taumax = taubeg + tauold = taubeg + isave = 0 + iu = 49 + temp = twopi/REAL(iu + 1, DP) + DO i = 1, iu + angle = REAL(i, dp)*temp + cth = COS(angle) + sth = SIN(angle) + tau = cf1 + (cf2 + cf4*cth)*cth + (cf3 + cf5*cth)*sth + IF (ABS(tau) > ABS(taumax)) THEN + taumax = tau + isave = i + tempa = tauold + ELSE IF (i == isave + 1) THEN + tempb = taU + END IF + tauold = tau + END DO + IF (isave == 0) tempa = tau + IF (isave == iu) tempb = taubeg + step = zero + IF (tempa /= tempb) THEN + tempa = tempa - taumax + tempb = tempb - taumax + step = half*(tempa - tempb)/(tempa + tempb) + END IF + angle = temp*(REAL(isave, DP) + step) + ! + ! Calculate the new D and GD. Then test for convergence. + ! + cth = COS(angle) + sth = SIN(angle) + tau = cf1 + (cf2 + cf4*cth)*cth + (cf3 + cf5*cth)*sth + DO i = 1, n + d(i) = cth*d(i) + sth*s(i) + gd(i) = cth*gd(i) + sth*w(i) + s(i) = gc(i) + gd(i) + END DO + IF (ABS(tau) <= 1.1_dp*ABS(taubeg)) EXIT mainloop + IF (iterc >= n) EXIT mainloop + END DO mainloop + + END SUBROUTINE biglag !****************************************************************************** ! ************************************************************************************************** @@ -1644,25 +1643,25 @@ END SUBROUTINE biglag !> \param hs ... !> \param crvmin ... ! ************************************************************************************************** - SUBROUTINE trsapp (n,npt,xopt,xpt,gq,hq,pq,delta,step,d,g,hd,hs,crvmin) - - INTEGER, INTENT(INOUT) :: n, npt - REAL(dp), DIMENSION(*), INTENT(INOUT) :: xopt - REAL(dp), DIMENSION(npt, *), & - INTENT(INOUT) :: xpt - REAL(dp), DIMENSION(*), INTENT(INOUT) :: gq, hq, pq - REAL(dp), INTENT(INOUT) :: delta - REAL(dp), DIMENSION(*), INTENT(INOUT) :: step, d, g, hd, hs - REAL(dp), INTENT(INOUT) :: crvmin - - REAL(dp), PARAMETER :: half = 0.5_dp, zero = 0.0_dp - - INTEGER :: i, isave, iterc, itermax, & - itersw, iu, j - LOGICAL :: jump1, jump2 - REAL(dp) :: alpha, angle, angtest, bstep, cf, cth, dd, delsq, dg, dhd, & - dhs, ds, gg, ggbeg, ggsav, qadd, qbeg, qmin, qnew, qred, qsav, ratio, & - reduc, sg, sgk, shs, ss, sth, temp, tempa, tempb + SUBROUTINE trsapp(n, npt, xopt, xpt, gq, hq, pq, delta, step, d, g, hd, hs, crvmin) + + INTEGER, INTENT(INOUT) :: n, npt + REAL(dp), DIMENSION(*), INTENT(INOUT) :: xopt + REAL(dp), DIMENSION(npt, *), & + INTENT(INOUT) :: xpt + REAL(dp), DIMENSION(*), INTENT(INOUT) :: gq, hq, pq + REAL(dp), INTENT(INOUT) :: delta + REAL(dp), DIMENSION(*), INTENT(INOUT) :: step, d, g, hd, hs + REAL(dp), INTENT(INOUT) :: crvmin + + REAL(dp), PARAMETER :: half = 0.5_dp, zero = 0.0_dp + + INTEGER :: i, isave, iterc, itermax, & + itersw, iu, j + LOGICAL :: jump1, jump2 + REAL(dp) :: alpha, angle, angtest, bstep, cf, cth, dd, delsq, dg, dhd, & + dhs, ds, gg, ggbeg, ggsav, qadd, qbeg, qmin, qnew, qred, qsav, ratio, & + reduc, sg, sgk, shs, ss, sth, temp, tempa, tempb ! ! N is the number of variables of a quadratic objective function, Q @@ -1684,229 +1683,229 @@ SUBROUTINE trsapp (n,npt,xopt,xpt,gq,hq,pq,delta,step,d,g,hd,hs,crvmin) ! Initialization, which includes setting HD to H times XOPT. ! - delsq=delta*delta - iterc=0 - itermax=n - itersw=itermax - DO i=1,n - d(i)=xopt(i) - END DO - CALL updatehd - ! - ! Prepare for the first line search. - ! - qred=zero - dd=zero - DO i=1,n - step(i)=zero - hs(i)=zero - g(i)=gq(i)+hd(i) - d(i)=-g(i) - dd=dd+d(i)**2 - END DO - crvmin=zero - IF (dd == zero) RETURN - ds=zero - ss=zero - gg=dd - ggbeg=gg - ! - ! Calculate the step to the trust region boundary and the product HD - ! - jump1 = .FALSE. - jump2 = .FALSE. - mainloop : DO - IF ( .NOT. jump2 ) THEN - IF ( .NOT. jump1 ) THEN - iterc=iterc+1 - temp=delsq-ss - bstep=temp/(ds+SQRT(ds*ds+dd*temp)) - CALL updatehd - END IF - jump1 = .FALSE. - IF (iterc <= itersw) THEN - dhd=zero - DO j=1,n - dhd=dhd+d(j)*hd(j) - END DO - ! - ! Update CRVMIN and set the step-length ALPHA. - ! - alpha=bstep - IF (dhd > zero) THEN - temp=dhd/dd - IF (iterc == 1) crvmin=temp - crvmin=MIN(crvmin,temp) - alpha=MIN(alpha,gg/dhd) - END IF - qadd=alpha*(gg-half*alpha*dhd) - qred=qred+qadd - ! - ! Update STEP and HS. - ! - ggsav=gg - gg=zero - DO i=1,n - step(i)=step(i)+alpha*d(i) - hs(i)=hs(i)+alpha*hd(i) - gg=gg+(g(i)+hs(i))**2 - END DO - ! - ! Begin another conjugate direction iteration if required. - ! - IF (alpha < bstep) THEN - IF (qadd <= 0.01_dp*qred) EXIT mainloop - IF (gg <= 1.0e-4_dp*ggbeg) EXIT mainloop - IF (iterc == itermax) EXIT mainloop - temp=gg/ggsav - dd=zero - ds=zero - ss=zero - DO i=1,n - d(i)=temp*d(i)-g(i)-hs(i) - dd=dd+d(i)**2 - ds=ds+d(i)*step(I) - ss=ss+step(i)**2 - END DO - IF (ds <= zero) EXIT mainloop - IF (ss < delsq) CYCLE mainloop - END IF - crvmin=zero - itersw=iterc - jump2 = .TRUE. - IF (gg <= 1.0e-4_dp*ggbeg) EXIT mainloop - ELSE - jump2 = .FALSE. - END IF - END IF - ! - ! Test whether an alternative iteration is required. - ! + delsq = delta*delta + iterc = 0 + itermax = n + itersw = itermax + DO i = 1, n + d(i) = xopt(i) + END DO + CALL updatehd + ! + ! Prepare for the first line search. + ! + qred = zero + dd = zero + DO i = 1, n + step(i) = zero + hs(i) = zero + g(i) = gq(i) + hd(i) + d(i) = -g(i) + dd = dd + d(i)**2 + END DO + crvmin = zero + IF (dd == zero) RETURN + ds = zero + ss = zero + gg = dd + ggbeg = gg + ! + ! Calculate the step to the trust region boundary and the product HD + ! + jump1 = .FALSE. + jump2 = .FALSE. + mainloop: DO + IF (.NOT. jump2) THEN + IF (.NOT. jump1) THEN + iterc = iterc + 1 + temp = delsq - ss + bstep = temp/(ds + SQRT(ds*ds + dd*temp)) + CALL updatehd + END IF + jump1 = .FALSE. + IF (iterc <= itersw) THEN + dhd = zero + DO j = 1, n + dhd = dhd + d(j)*hd(j) + END DO + ! + ! Update CRVMIN and set the step-length ALPHA. + ! + alpha = bstep + IF (dhd > zero) THEN + temp = dhd/dd + IF (iterc == 1) crvmin = temp + crvmin = MIN(crvmin, temp) + alpha = MIN(alpha, gg/dhd) + END IF + qadd = alpha*(gg - half*alpha*dhd) + qred = qred + qadd + ! + ! Update STEP and HS. + ! + ggsav = gg + gg = zero + DO i = 1, n + step(i) = step(i) + alpha*d(i) + hs(i) = hs(i) + alpha*hd(i) + gg = gg + (g(i) + hs(i))**2 + END DO + ! + ! Begin another conjugate direction iteration if required. + ! + IF (alpha < bstep) THEN + IF (qadd <= 0.01_dp*qred) EXIT mainloop + IF (gg <= 1.0e-4_dp*ggbeg) EXIT mainloop + IF (iterc == itermax) EXIT mainloop + temp = gg/ggsav + dd = zero + ds = zero + ss = zero + DO i = 1, n + d(i) = temp*d(i) - g(i) - hs(i) + dd = dd + d(i)**2 + ds = ds + d(i)*step(I) + ss = ss + step(i)**2 + END DO + IF (ds <= zero) EXIT mainloop + IF (ss < delsq) CYCLE mainloop + END IF + crvmin = zero + itersw = iterc + jump2 = .TRUE. + IF (gg <= 1.0e-4_dp*ggbeg) EXIT mainloop + ELSE + jump2 = .FALSE. + END IF + END IF + ! + ! Test whether an alternative iteration is required. + ! !!!! IF (gg <= 1.0e-4_dp*ggbeg) EXIT mainloop - IF (jump2) THEN - sg=zero - shs=zero - DO i=1,n - sg=sg+step(i)*g(i) - shs=shs+step(i)*hs(i) - END DO - sgk=sg+shs - angtest=sgk/SQRT(gg*delsq) - IF (angtest <= -0.99_dp) EXIT mainloop - ! - ! Begin the alternative iteration by calculating D and HD and some - ! scalar products. - ! - iterc=iterc+1 - temp=SQRT(delsq*gg-sgk*sgk) - tempa=delsq/temp - tempb=sgk/temp - DO i=1,n - d(i)=tempa*(g(i)+hs(i))-tempb*step(i) - END DO - CALL updatehd - IF (iterc <= itersw) THEN - jump1 = .TRUE. - CYCLE mainloop - END IF - END IF - dg=zero - dhd=zero - dhs=zero - DO i=1,n - dg=dg+d(i)*g(i) - dhd=dhd+hd(i)*d(i) - dhs=dhs+hd(i)*step(i) - END DO - ! - ! Seek the value of the angle that minimizes Q. - ! - cf=half*(shs-dhd) - qbeg=sg+cf - qsav=qbeg - qmin=qbeg - isave=0 - iu=49 - temp=twopi/REAL(iu+1,dp) - DO i=1,iu - angle=REAL(i,dp)*temp - cth=COS(angle) - sth=SIN(angle) - qnew=(sg+cf*cth)*cth+(dg+dhs*cth)*sth - IF (qnew < qmin) THEN - qmin=qnew - isave=i - tempa=qsav - ELSE IF (i == isave+1) THEN - tempb=qnew - END IF - qsav=qnew - END DO - IF (isave == zero) tempa=qnew - IF (isave == iu) tempb=qbeg - angle=zero - IF (tempa /= tempb) THEN - tempa=tempa-qmin - tempb=tempb-qmin - angle=half*(tempa-tempb)/(tempa+tempb) - END IF - angle=temp*(REAL(isave,DP)+angle) - ! - ! Calculate the new STEP and HS. Then test for convergence. - ! - cth=COS(angle) - sth=SIN(angle) - reduc=qbeg-(sg+cf*cth)*cth-(dg+dhs*cth)*sth - gg=zero - DO i=1,n - step(i)=cth*step(i)+sth*d(i) - hs(i)=cth*hs(i)+sth*hd(i) - gg=gg+(g(i)+hs(i))**2 - END DO - qred=qred+reduc - ratio=reduc/qred - IF (iterc < itermax .AND. ratio > 0.01_dp) THEN - jump2 = .TRUE. - ELSE - EXIT mainloop - END IF - - IF (gg <= 1.0e-4_dp*ggbeg) EXIT mainloop - - END DO mainloop - - !******************************************************************************* - CONTAINS + IF (jump2) THEN + sg = zero + shs = zero + DO i = 1, n + sg = sg + step(i)*g(i) + shs = shs + step(i)*hs(i) + END DO + sgk = sg + shs + angtest = sgk/SQRT(gg*delsq) + IF (angtest <= -0.99_dp) EXIT mainloop + ! + ! Begin the alternative iteration by calculating D and HD and some + ! scalar products. + ! + iterc = iterc + 1 + temp = SQRT(delsq*gg - sgk*sgk) + tempa = delsq/temp + tempb = sgk/temp + DO i = 1, n + d(i) = tempa*(g(i) + hs(i)) - tempb*step(i) + END DO + CALL updatehd + IF (iterc <= itersw) THEN + jump1 = .TRUE. + CYCLE mainloop + END IF + END IF + dg = zero + dhd = zero + dhs = zero + DO i = 1, n + dg = dg + d(i)*g(i) + dhd = dhd + hd(i)*d(i) + dhs = dhs + hd(i)*step(i) + END DO + ! + ! Seek the value of the angle that minimizes Q. + ! + cf = half*(shs - dhd) + qbeg = sg + cf + qsav = qbeg + qmin = qbeg + isave = 0 + iu = 49 + temp = twopi/REAL(iu + 1, dp) + DO i = 1, iu + angle = REAL(i, dp)*temp + cth = COS(angle) + sth = SIN(angle) + qnew = (sg + cf*cth)*cth + (dg + dhs*cth)*sth + IF (qnew < qmin) THEN + qmin = qnew + isave = i + tempa = qsav + ELSE IF (i == isave + 1) THEN + tempb = qnew + END IF + qsav = qnew + END DO + IF (isave == zero) tempa = qnew + IF (isave == iu) tempb = qbeg + angle = zero + IF (tempa /= tempb) THEN + tempa = tempa - qmin + tempb = tempb - qmin + angle = half*(tempa - tempb)/(tempa + tempb) + END IF + angle = temp*(REAL(isave, DP) + angle) + ! + ! Calculate the new STEP and HS. Then test for convergence. + ! + cth = COS(angle) + sth = SIN(angle) + reduc = qbeg - (sg + cf*cth)*cth - (dg + dhs*cth)*sth + gg = zero + DO i = 1, n + step(i) = cth*step(i) + sth*d(i) + hs(i) = cth*hs(i) + sth*hd(i) + gg = gg + (g(i) + hs(i))**2 + END DO + qred = qred + reduc + ratio = reduc/qred + IF (iterc < itermax .AND. ratio > 0.01_dp) THEN + jump2 = .TRUE. + ELSE + EXIT mainloop + END IF + + IF (gg <= 1.0e-4_dp*ggbeg) EXIT mainloop + + END DO mainloop + + !******************************************************************************* + CONTAINS ! ************************************************************************************************** !> \brief ... ! ************************************************************************************************** - SUBROUTINE updatehd + SUBROUTINE updatehd INTEGER :: i, ih, j, k - DO i=1,n - hd(i)=zero - END DO - DO k=1,npt - temp=zero - DO j=1,n - temp=temp+xpt(k,j)*d(j) + DO i = 1, n + hd(i) = zero END DO - temp=temp*pq(k) - DO i=1,n - hd(i)=hd(i)+temp*xpt(k,i) + DO k = 1, npt + temp = zero + DO j = 1, n + temp = temp + xpt(k, j)*d(j) + END DO + temp = temp*pq(k) + DO i = 1, n + hd(i) = hd(i) + temp*xpt(k, i) + END DO END DO - END DO - ih=0 - DO j=1,n - DO i=1,j - ih=ih+1 - IF (i < j) hd(j)=hd(j)+hq(ih)*d(i) - hd(i)=hd(i)+hq(ih)*d(j) + ih = 0 + DO j = 1, n + DO i = 1, j + ih = ih + 1 + IF (i < j) hd(j) = hd(j) + hq(ih)*d(i) + hd(i) = hd(i) + hq(ih)*d(j) + END DO END DO - END DO - END SUBROUTINE updatehd + END SUBROUTINE updatehd - END SUBROUTINE trsapp + END SUBROUTINE trsapp !****************************************************************************** ! ************************************************************************************************** @@ -1922,7 +1921,7 @@ END SUBROUTINE trsapp !> \param knew ... !> \param w ... ! ************************************************************************************************** - SUBROUTINE update (n,npt,bmat,zmat,idz,ndim,vlag,beta,knew,w) + SUBROUTINE update(n, npt, bmat, zmat, idz, ndim, vlag, beta, knew, w) INTEGER, INTENT(IN) :: n, npt, ndim INTEGER, INTENT(INOUT) :: idz @@ -1946,106 +1945,106 @@ SUBROUTINE update (n,npt,bmat,zmat,idz,ndim,vlag,beta,knew,w) ! The vector W is used for working space. ! - nptm=npt-n-1 - ! - ! Apply the rotations that put zeros in the KNEW-th row of ZMAT. - ! - jl=1 - DO j=2,nptm - IF (j == idz) THEN - jl=idz - ELSE IF (zmat(knew,j) /= zero) THEN - temp=SQRT(zmat(knew,jl)**2+zmat(knew,j)**2) - tempa=zmat(knew,jl)/temp - tempb=zmat(knew,j)/temp - DO I=1,NPT - temp=tempa*zmat(i,jl)+tempb*zmat(i,j) - zmat(i,j)=tempa*zmat(i,j)-tempb*zmat(i,jl) - zmat(i,jl)=temp - END DO - zmat(knew,j)=zero - END IF - END DO - ! - ! Put the first NPT components of the KNEW-th column of HLAG into W, - ! and calculate the parameters of the updating formula. - ! - tempa=zmat(knew,1) - IF (idz >= 2) tempa=-tempa - IF (jl > 1) tempb=zmat(knew,jl) - DO i=1,npt - w(i)=tempa*zmat(i,1) - IF (jl > 1) w(i)=w(i)+tempb*zmat(i,jl) - END DO - alpha=w(knew) - tau=vlag(knew) - tausq=tau*tau - denom=alpha*beta+tausq - vlag(knew)=vlag(knew)-one - ! - ! Complete the updating of ZMAT when there is only one nonzero eleme - ! in the KNEW-th row of the new matrix ZMAT, but, if IFLAG is set to - ! then the first column of ZMAT will be exchanged with another one l - ! - iflag=0 - IF (JL == 1) THEN - temp=SQRT(ABS(denom)) - tempb=tempa/temp - tempa=tau/temp - DO i=1,npt - zmat(i,1)=tempa*zmat(i,1)-tempb*vlag(i) - END DO - IF (idz == 1 .AND. temp < zero) idz=2 - IF (idz >= 2 .AND. temp >= zero) iflag=1 - ELSE - ! - ! Complete the updating of ZMAT in the alternative case. - ! - ja=1 - IF (beta >= zero) ja=jl - jb=jl+1-ja - temp=zmat(knew,jb)/denom - tempa=temp*beta - tempb=temp*tau - temp=zmat(knew,ja) - scala=one/SQRT(ABS(beta)*temp*temp+tausq) - scalb=scala*SQRT(ABS(denom)) - DO i=1,npt - zmat(i,ja)=scala*(tau*zmat(i,ja)-temp*vlag(i)) - zmat(i,jb)=scalb*(zmat(i,jb)-tempa*w(i)-tempb*vlag(i)) - END DO - IF (denom <= zero) THEN - IF (beta < zero) idz=idz+1 - IF (beta >= zero) iflag=1 - END IF - END IF - ! - ! IDZ is reduced in the following case, and usually the first column - ! of ZMAT is exchanged with a later one. - ! - IF (iflag == 1) THEN - idz=idz-1 - DO i=1,npt - temp=zmat(i,1) - zmat(i,1)=zmat(i,idz) - zmat(i,idz)=temp - END DO - END IF - ! - ! Finally, update the matrix BMAT. - ! - DO j=1,n - jp=npt+j - w(jp)=bmat(knew,j) - tempa=(alpha*vlag(jp)-tau*w(jp))/denom - tempb=(-beta*w(jp)-tau*vlag(jp))/denom - DO i=1,jp - bmat(i,j)=bmat(i,j)+tempa*vlag(i)+tempb*w(i) - IF (i > npt) bmat(jp,i-npt)=bmat(i,j) - END DO - END DO - - END SUBROUTINE update + nptm = npt - n - 1 + ! + ! Apply the rotations that put zeros in the KNEW-th row of ZMAT. + ! + jl = 1 + DO j = 2, nptm + IF (j == idz) THEN + jl = idz + ELSE IF (zmat(knew, j) /= zero) THEN + temp = SQRT(zmat(knew, jl)**2 + zmat(knew, j)**2) + tempa = zmat(knew, jl)/temp + tempb = zmat(knew, j)/temp + DO I = 1, NPT + temp = tempa*zmat(i, jl) + tempb*zmat(i, j) + zmat(i, j) = tempa*zmat(i, j) - tempb*zmat(i, jl) + zmat(i, jl) = temp + END DO + zmat(knew, j) = zero + END IF + END DO + ! + ! Put the first NPT components of the KNEW-th column of HLAG into W, + ! and calculate the parameters of the updating formula. + ! + tempa = zmat(knew, 1) + IF (idz >= 2) tempa = -tempa + IF (jl > 1) tempb = zmat(knew, jl) + DO i = 1, npt + w(i) = tempa*zmat(i, 1) + IF (jl > 1) w(i) = w(i) + tempb*zmat(i, jl) + END DO + alpha = w(knew) + tau = vlag(knew) + tausq = tau*tau + denom = alpha*beta + tausq + vlag(knew) = vlag(knew) - one + ! + ! Complete the updating of ZMAT when there is only one nonzero eleme + ! in the KNEW-th row of the new matrix ZMAT, but, if IFLAG is set to + ! then the first column of ZMAT will be exchanged with another one l + ! + iflag = 0 + IF (JL == 1) THEN + temp = SQRT(ABS(denom)) + tempb = tempa/temp + tempa = tau/temp + DO i = 1, npt + zmat(i, 1) = tempa*zmat(i, 1) - tempb*vlag(i) + END DO + IF (idz == 1 .AND. temp < zero) idz = 2 + IF (idz >= 2 .AND. temp >= zero) iflag = 1 + ELSE + ! + ! Complete the updating of ZMAT in the alternative case. + ! + ja = 1 + IF (beta >= zero) ja = jl + jb = jl + 1 - ja + temp = zmat(knew, jb)/denom + tempa = temp*beta + tempb = temp*tau + temp = zmat(knew, ja) + scala = one/SQRT(ABS(beta)*temp*temp + tausq) + scalb = scala*SQRT(ABS(denom)) + DO i = 1, npt + zmat(i, ja) = scala*(tau*zmat(i, ja) - temp*vlag(i)) + zmat(i, jb) = scalb*(zmat(i, jb) - tempa*w(i) - tempb*vlag(i)) + END DO + IF (denom <= zero) THEN + IF (beta < zero) idz = idz + 1 + IF (beta >= zero) iflag = 1 + END IF + END IF + ! + ! IDZ is reduced in the following case, and usually the first column + ! of ZMAT is exchanged with a later one. + ! + IF (iflag == 1) THEN + idz = idz - 1 + DO i = 1, npt + temp = zmat(i, 1) + zmat(i, 1) = zmat(i, idz) + zmat(i, idz) = temp + END DO + END IF + ! + ! Finally, update the matrix BMAT. + ! + DO j = 1, n + jp = npt + j + w(jp) = bmat(knew, j) + tempa = (alpha*vlag(jp) - tau*w(jp))/denom + tempb = (-beta*w(jp) - tau*vlag(jp))/denom + DO i = 1, jp + bmat(i, j) = bmat(i, j) + tempa*vlag(i) + tempb*w(i) + IF (i > npt) bmat(jp, i - npt) = bmat(i, j) + END DO + END DO + + END SUBROUTINE update END MODULE powell diff --git a/src/common/print_messages.F b/src/common/print_messages.F index 52db606ac1..adc64d67d5 100644 --- a/src/common/print_messages.F +++ b/src/common/print_messages.F @@ -88,7 +88,7 @@ SUBROUTINE print_message(message, output_unit, declev, before, after) ! Calculate number of rows - nrow = msglen/(rowlen+1)+1 + nrow = msglen/(rowlen + 1) + 1 ! Calculate appropriate row length @@ -112,16 +112,16 @@ SUBROUTINE print_message(message, output_unit, declev, before, after) IF (i == 0) THEN ibreak = ipos2 ELSE - ibreak = ipos1+i-2 + ibreak = ipos1 + i - 2 END IF ELSE ibreak = ipos2 END IF - maxrowlen = MAX(maxrowlen, ibreak-ipos1+1) + maxrowlen = MAX(maxrowlen, ibreak - ipos1 + 1) - ipos1 = ibreak+2 - ipos2 = MIN(msglen, ipos1+rowlen-1) + ipos1 = ibreak + 2 + ipos2 = MIN(msglen, ipos1 + rowlen - 1) ! When the last row is processed, exit loop @@ -132,8 +132,8 @@ SUBROUTINE print_message(message, output_unit, declev, before, after) ! Generate the first set of star rows IF (decoration_level > 1) THEN - DO i = 1, decoration_level-1 - WRITE (UNIT=output_unit, FMT="(T2,A)") REPEAT("*", maxrowlen+8) + DO i = 1, decoration_level - 1 + WRITE (UNIT=output_unit, FMT="(T2,A)") REPEAT("*", maxrowlen + 8) END DO END IF @@ -148,7 +148,7 @@ SUBROUTINE print_message(message, output_unit, declev, before, after) IF (i == 0) THEN ibreak = ipos2 ELSE - ibreak = ipos1+i-2 + ibreak = ipos1 + i - 2 END IF ELSE ibreak = ipos2 @@ -158,11 +158,11 @@ SUBROUTINE print_message(message, output_unit, declev, before, after) WRITE (UNIT=output_unit, FMT="(T2,A)") message(ipos1:ibreak) ELSE IF (decoration_level > 0) THEN WRITE (UNIT=output_unit, FMT="(T2,A)") & - "*** "//message(ipos1:ibreak)//REPEAT(" ", ipos1+maxrowlen-ibreak)//"***" + "*** "//message(ipos1:ibreak)//REPEAT(" ", ipos1 + maxrowlen - ibreak)//"***" END IF - ipos1 = ibreak+2 - ipos2 = MIN(msglen, ipos1+rowlen-1) + ipos1 = ibreak + 2 + ipos2 = MIN(msglen, ipos1 + rowlen - 1) ! When the last row is processed, exit loop @@ -172,8 +172,8 @@ SUBROUTINE print_message(message, output_unit, declev, before, after) ! Generate the second set star rows IF (decoration_level > 1) THEN - DO i = 1, decoration_level-1 - WRITE (UNIT=output_unit, FMT="(T2,A)") REPEAT("*", maxrowlen+8) + DO i = 1, decoration_level - 1 + WRITE (UNIT=output_unit, FMT="(T2,A)") REPEAT("*", maxrowlen + 8) END DO END IF diff --git a/src/common/reference_manager.F b/src/common/reference_manager.F index 9e40cec01a..ab27cb7010 100644 --- a/src/common/reference_manager.F +++ b/src/common/reference_manager.F @@ -26,53 +26,53 @@ MODULE reference_manager USE util, ONLY: sort #include "../base/base_uses.f90" - IMPLICIT NONE + IMPLICIT NONE - PUBLIC :: print_reference, print_all_references, cite_reference - PUBLIC :: collect_citations_from_ranks + PUBLIC :: print_reference, print_all_references, cite_reference + PUBLIC :: collect_citations_from_ranks - INTEGER, PUBLIC, PARAMETER :: print_format_isi=101, & - print_format_journal=102, & - print_format_html=103 + INTEGER, PUBLIC, PARAMETER :: print_format_isi = 101, & + print_format_journal = 102, & + print_format_html = 103 - PRIVATE + PRIVATE CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'reference_manager' - ! maximum number of reference that can be added - INTEGER, PARAMETER :: max_reference=1024 + ! maximum number of reference that can be added + INTEGER, PARAMETER :: max_reference = 1024 - ! storage of a reference - INTEGER, PARAMETER :: doi_length=128 - INTEGER, PARAMETER :: ISI_length=128 + ! storage of a reference + INTEGER, PARAMETER :: doi_length = 128 + INTEGER, PARAMETER :: ISI_length = 128 - ! the way we store a reference, should remain fully private + ! the way we store a reference, should remain fully private ! ************************************************************************************************** - TYPE reference_type - PRIVATE - ! the reference in a format as returned by the web of science - CHARACTER(LEN=ISI_length), DIMENSION(:), POINTER :: ISI_record - ! the doi only, i.e. without "https://dx.doi.org/" - CHARACTER(LEN=doi_length) :: DOI - ! has this reference been cited in the program run - LOGICAL :: is_cited - ! this is a citation key for output in the reference lists - CHARACTER(LEN=ISI_length) :: citation_key - END TYPE reference_type + TYPE reference_type + PRIVATE + ! the reference in a format as returned by the web of science + CHARACTER(LEN=ISI_length), DIMENSION(:), POINTER :: ISI_record + ! the doi only, i.e. without "https://dx.doi.org/" + CHARACTER(LEN=doi_length) :: DOI + ! has this reference been cited in the program run + LOGICAL :: is_cited + ! this is a citation key for output in the reference lists + CHARACTER(LEN=ISI_length) :: citation_key + END TYPE reference_type - ! useful to build arrays + ! useful to build arrays ! ************************************************************************************************** - TYPE reference_p_type - TYPE(reference_type), POINTER :: ref - END TYPE + TYPE reference_p_type + TYPE(reference_type), POINTER :: ref + END TYPE - ! thebibliography - INTEGER, SAVE :: nbib=0 - TYPE(reference_p_type), DIMENSION(max_reference) :: thebib + ! thebibliography + INTEGER, SAVE :: nbib = 0 + TYPE(reference_p_type), DIMENSION(max_reference) :: thebib - PUBLIC :: add_reference, & ! use this one only in bibliography.F - remove_all_references, & ! use only in f77_interface.F - get_citation_key ! a string key describing the reference (e.g. Kohn1965b) + PUBLIC :: add_reference, & ! use this one only in bibliography.F + remove_all_references, & ! use only in f77_interface.F + get_citation_key ! a string key describing the reference (e.g. Kohn1965b) CONTAINS @@ -82,15 +82,15 @@ MODULE reference_manager !> \par History !> XX.2007 created [ ] ! ************************************************************************************************** - SUBROUTINE cite_reference(key) + SUBROUTINE cite_reference(key) INTEGER, INTENT(IN) :: key - IF (key<1 .OR. key>max_reference) CPABORT("citation key out of range") + IF (key < 1 .OR. key > max_reference) CPABORT("citation key out of range") - ! set as cited - thebib(key)%ref%is_cited=.TRUE. + ! set as cited + thebib(key)%ref%is_cited = .TRUE. - END SUBROUTINE + END SUBROUTINE ! ************************************************************************************************** !> \brief Checks for each reference if any mpi-rank has marked it for citation. @@ -98,19 +98,19 @@ SUBROUTINE cite_reference(key) !> \par History !> 12.2013 created [Ole Schuett] ! ************************************************************************************************** - SUBROUTINE collect_citations_from_ranks(para_env) + SUBROUTINE collect_citations_from_ranks(para_env) TYPE(cp_para_env_type), POINTER :: para_env INTEGER :: i, t - DO i=1, nbib - t = 0 - IF(thebib(i)%ref%is_cited) t=1 - CALL mp_max(t, para_env%group) - thebib(i)%ref%is_cited = (t==1) - ENDDO + DO i = 1, nbib + t = 0 + IF (thebib(i)%ref%is_cited) t = 1 + CALL mp_max(t, para_env%group) + thebib(i)%ref%is_cited = (t == 1) + ENDDO - END SUBROUTINE collect_citations_from_ranks + END SUBROUTINE collect_citations_from_ranks ! ************************************************************************************************** !> \brief add a reference to the bibliography @@ -126,7 +126,7 @@ END SUBROUTINE collect_citations_from_ranks !> that can convert e.g. bibtex or endnote files to the ISI format !> - DOI: provide the DOI without a link. The link will be automatically created as needed. ! ************************************************************************************************** - SUBROUTINE add_reference(key,ISI_record,DOI) + SUBROUTINE add_reference(key, ISI_record, DOI) INTEGER, INTENT(OUT) :: key CHARACTER(LEN=*), DIMENSION(:) :: ISI_record CHARACTER(LEN=*) :: DOI @@ -138,73 +138,73 @@ SUBROUTINE add_reference(key,ISI_record,DOI) INTEGER :: commaloc, i, ires, line, match, mylen, & nlines - IF (nbib+1>max_reference) CPABORT("increase max_reference") - nbib=nbib+1 - key =nbib - - ! initialize reference to zero - ALLOCATE(thebib(key)%ref) - NULLIFY(thebib(key)%ref%ISI_record) - thebib(key)%ref%DOI="" - thebib(key)%ref%is_cited=.FALSE. - - ! Assign DOI - thebib(key)%ref%DOI=DOI - - ! Assign ISI_record - nlines=SIZE(ISI_record,1) - ALLOCATE(thebib(key)%ref%ISI_record(nlines)) - thebib(key)%ref%ISI_record=ISI_record - - ! construct a citation_key - line=1 - author=get_next_author(thebib(key)%ref%ISI_record,line) - commaloc=INDEX(author,',') - IF (commaloc.GT.0) author=author(1:commaloc-1) - year=get_year(thebib(key)%ref%ISI_record) - citation_key=TRIM(author)//TRIM(year) - IF (citation_key=="") citation_key="unknown" - - ! avoid special characters in names, just remove them - mylen=LEN_TRIM(citation_key) - ires=0 - DO I=1,mylen - IF (INDEX("0123456789thequickbrownfoxjumpsoverthelazydogTHEQUICKBROWNFOXJUMPSOVERTHELAZYDOG",citation_key(i:i)).NE.0) THEN - ires=ires+1 - tmp=citation_key(i:i) - citation_key(ires:ires)=tmp - ENDIF - ENDDO - citation_key(ires+1:)="" - - ! avoid duplicates, search through the list for matches - mylen=LEN_TRIM(citation_key) - match=0 - DO I=1,nbib-1 - IF (thebib(I)%ref%citation_key(1:mylen)==citation_key(1:mylen)) match=match+1 - ENDDO - IF (match>0) citation_key=citation_key(1:mylen)//CHAR(ICHAR('a')+match) - - ! finally store it - thebib(key)%ref%citation_key=citation_key - - END SUBROUTINE add_reference + IF (nbib + 1 > max_reference) CPABORT("increase max_reference") + nbib = nbib + 1 + key = nbib + + ! initialize reference to zero + ALLOCATE (thebib(key)%ref) + NULLIFY (thebib(key)%ref%ISI_record) + thebib(key)%ref%DOI = "" + thebib(key)%ref%is_cited = .FALSE. + + ! Assign DOI + thebib(key)%ref%DOI = DOI + + ! Assign ISI_record + nlines = SIZE(ISI_record, 1) + ALLOCATE (thebib(key)%ref%ISI_record(nlines)) + thebib(key)%ref%ISI_record = ISI_record + + ! construct a citation_key + line = 1 + author = get_next_author(thebib(key)%ref%ISI_record, line) + commaloc = INDEX(author, ',') + IF (commaloc .GT. 0) author = author(1:commaloc - 1) + year = get_year(thebib(key)%ref%ISI_record) + citation_key = TRIM(author)//TRIM(year) + IF (citation_key == "") citation_key = "unknown" + + ! avoid special characters in names, just remove them + mylen = LEN_TRIM(citation_key) + ires = 0 + DO I = 1, mylen + IF (INDEX("0123456789thequickbrownfoxjumpsoverthelazydogTHEQUICKBROWNFOXJUMPSOVERTHELAZYDOG", citation_key(i:i)) .NE. 0) THEN + ires = ires + 1 + tmp = citation_key(i:i) + citation_key(ires:ires) = tmp + ENDIF + ENDDO + citation_key(ires + 1:) = "" + + ! avoid duplicates, search through the list for matches + mylen = LEN_TRIM(citation_key) + match = 0 + DO I = 1, nbib - 1 + IF (thebib(I)%ref%citation_key(1:mylen) == citation_key(1:mylen)) match = match + 1 + ENDDO + IF (match > 0) citation_key = citation_key(1:mylen)//CHAR(ICHAR('a') + match) + + ! finally store it + thebib(key)%ref%citation_key = citation_key + + END SUBROUTINE add_reference ! ************************************************************************************************** !> \brief deallocate the bibliography !> \par History !> 08.2007 Joost VandeVondele [ ] ! ************************************************************************************************** - SUBROUTINE remove_all_references() + SUBROUTINE remove_all_references() INTEGER :: i - DO i=1,nbib - IF (ASSOCIATED(thebib(i)%ref%ISI_record)) DEALLOCATE(thebib(i)%ref%ISI_record) - thebib(i)%ref%DOI="" + DO i = 1, nbib + IF (ASSOCIATED(thebib(i)%ref%ISI_record)) DEALLOCATE (thebib(i)%ref%ISI_record) + thebib(i)%ref%DOI = "" - DEALLOCATE(thebib(i)%ref) - ENDDO - END SUBROUTINE remove_all_references + DEALLOCATE (thebib(i)%ref) + ENDDO + END SUBROUTINE remove_all_references !****f* reference_manager/print_all_references * ! ************************************************************************************************** @@ -220,7 +220,7 @@ END SUBROUTINE remove_all_references !> \par History !> 08.2007 Joost VandeVondele [ ] ! ************************************************************************************************** - SUBROUTINE print_all_references(cited_only,sorted,FORMAT,unit,list) + SUBROUTINE print_all_references(cited_only, sorted, FORMAT, unit, list) LOGICAL, INTENT(IN) :: cited_only, sorted INTEGER, INTENT(IN) :: FORMAT, unit INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: list @@ -234,73 +234,73 @@ SUBROUTINE print_all_references(cited_only,sorted,FORMAT,unit,list) ! we'll sort the references wrt to the publication year ! the most recent first, publications without a year get last - IF (PRESENT(list)) THEN - nref=SIZE(list) - ELSE - nref=nbib - ENDIF - - ALLOCATE(ival(nref)) - ALLOCATE(irank(nref)) - ALLOCATE(indx(nref)) - - IF (PRESENT(list)) THEN - indx(:)=list - ELSE - DO I=1,nref - indx(I)=I - ENDDO - ENDIF - - DO I=1,nref - irank(I)=I - ENDDO - - IF (sorted) THEN - DO I=1,nref - ival(I)=-get_epoch(thebib(indx(I))%ref%ISI_record) - ENDDO - ELSE - DO I=1,nref - ival(I)=indx(I) - ENDDO - ENDIF - CALL sort(ival,nref,irank) - - IF (FORMAT.EQ.print_format_html) THEN - WRITE(unit,'(A)') '' - ENDIF - DO I=1,nref - irecord=indx(irank(I)) - IF (.NOT. cited_only .OR. thebib(irecord)%ref%is_cited) THEN - SELECT CASE(FORMAT) - CASE(print_format_isi) - CASE(print_format_journal) - WRITE(unit,'(A)') "" - CASE(print_format_html) - WRITE(unit,'(A)') "' - CASE DEFAULT - CPABORT("print_reference: wrong format") - END SELECT - ENDIF - ENDDO - IF (FORMAT.EQ.print_format_html) THEN - WRITE(unit,'(A)') "
"//'['//TRIM(thebib(irecord)%ref%citation_key)//']'//"" - CASE DEFAULT - CPABORT("print_reference: wrong format") - END SELECT - - CALL print_reference(irecord,FORMAT,unit) - - SELECT CASE(FORMAT) - CASE(print_format_isi) - CASE(print_format_journal) - WRITE(unit,'(A)') "" - CASE(print_format_html) - WRITE(unit,'(A)') '
" - ENDIF - - END SUBROUTINE print_all_references + IF (PRESENT(list)) THEN + nref = SIZE(list) + ELSE + nref = nbib + ENDIF + + ALLOCATE (ival(nref)) + ALLOCATE (irank(nref)) + ALLOCATE (indx(nref)) + + IF (PRESENT(list)) THEN + indx(:) = list + ELSE + DO I = 1, nref + indx(I) = I + ENDDO + ENDIF + + DO I = 1, nref + irank(I) = I + ENDDO + + IF (sorted) THEN + DO I = 1, nref + ival(I) = -get_epoch(thebib(indx(I))%ref%ISI_record) + ENDDO + ELSE + DO I = 1, nref + ival(I) = indx(I) + ENDDO + ENDIF + CALL sort(ival, nref, irank) + + IF (FORMAT .EQ. print_format_html) THEN + WRITE (unit, '(A)') '' + ENDIF + DO I = 1, nref + irecord = indx(irank(I)) + IF (.NOT. cited_only .OR. thebib(irecord)%ref%is_cited) THEN + SELECT CASE (FORMAT) + CASE (print_format_isi) + CASE (print_format_journal) + WRITE (unit, '(A)') "" + CASE (print_format_html) + WRITE (unit, '(A)') "' + CASE DEFAULT + CPABORT("print_reference: wrong format") + END SELECT + ENDIF + ENDDO + IF (FORMAT .EQ. print_format_html) THEN + WRITE (unit, '(A)') "
"//'['//TRIM(thebib(irecord)%ref%citation_key)//']'//"" + CASE DEFAULT + CPABORT("print_reference: wrong format") + END SELECT + + CALL print_reference(irecord, FORMAT, unit) + + SELECT CASE (FORMAT) + CASE (print_format_isi) + CASE (print_format_journal) + WRITE (unit, '(A)') "" + CASE (print_format_html) + WRITE (unit, '(A)') '
" + ENDIF + + END SUBROUTINE print_all_references !****f* reference_manager/print_reference * ! ************************************************************************************************** @@ -311,7 +311,7 @@ END SUBROUTINE print_all_references !> \par History !> 08.2007 Joost VandeVondele [ ] ! ************************************************************************************************** - SUBROUTINE print_reference(key,FORMAT,unit) + SUBROUTINE print_reference(key, FORMAT, unit) INTEGER, INTENT(IN) :: key, FORMAT, unit CHARACTER(len=*), PARAMETER :: routineN = 'print_reference', & @@ -319,21 +319,21 @@ SUBROUTINE print_reference(key,FORMAT,unit) INTEGER :: I - IF (key<1 .OR. key>max_reference) CPABORT("citation key out of range") + IF (key < 1 .OR. key > max_reference) CPABORT("citation key out of range") - SELECT CASE(FORMAT) - CASE(print_format_isi) - DO I=1,SIZE(thebib(key)%ref%ISI_record) - WRITE(unit,'(T2,A)') TRIM(thebib(key)%ref%ISI_record(I)) - ENDDO - CASE(print_format_journal) - CALL print_reference_journal(key,unit) - CASE(print_format_html) - CALL print_reference_html(key,unit) - CASE DEFAULT - CPABORT("print_reference: wrong format") - END SELECT - END SUBROUTINE print_reference + SELECT CASE (FORMAT) + CASE (print_format_isi) + DO I = 1, SIZE(thebib(key)%ref%ISI_record) + WRITE (unit, '(T2,A)') TRIM(thebib(key)%ref%ISI_record(I)) + ENDDO + CASE (print_format_journal) + CALL print_reference_journal(key, unit) + CASE (print_format_html) + CALL print_reference_html(key, unit) + CASE DEFAULT + CPABORT("print_reference: wrong format") + END SELECT + END SUBROUTINE print_reference ! ************************************************************************************************** !> \brief prints a reference in a journal style citation format, @@ -343,7 +343,7 @@ END SUBROUTINE print_reference !> \par History !> 08.2007 created [Joost VandeVondele] ! ************************************************************************************************** - SUBROUTINE print_reference_journal(key,unit) + SUBROUTINE print_reference_journal(key, unit) INTEGER, INTENT(IN) :: key, unit CHARACTER(len=*), PARAMETER :: routineN = 'print_reference_journal', & @@ -355,65 +355,65 @@ SUBROUTINE print_reference_journal(key,unit) ! write the author list - WRITE(unit,'(T2,A)',ADVANCE="NO") "" - line=1 ; iauthor=0 ; ipos_line=2 - author=get_next_author(thebib(key)%ref%ISI_record,line) - DO WHILE (author.NE."") - iauthor=iauthor+1 - IF (ipos_line+LEN_TRIM(author)>71) THEN - WRITE(unit,'(A)') ";" - WRITE(unit,'(T2,A)',ADVANCE="NO") "" - ipos_line=2 - ELSE - IF (iauthor.NE.1) WRITE(unit,'(A)',ADVANCE="NO") "; " - ipos_line=ipos_line+2 - ENDIF - WRITE(unit,'(A)',ADVANCE="NO") TRIM(author) - ipos_line=ipos_line+LEN_TRIM(author) - author=get_next_author(thebib(key)%ref%ISI_record,line) - ENDDO - IF (iauthor>0) THEN - WRITE(unit,'(A)',ADVANCE="NO") ". " - ipos_line=ipos_line+2 - ENDIF - - ! Journal, volume (issue), pages (year). - journal=TRIM(get_source(thebib(key)%ref%ISI_record)) - IF (get_volume(thebib(key)%ref%ISI_record).NE."") THEN - journal=TRIM(journal)//", "//get_volume(thebib(key)%ref%ISI_record) - IF (get_issue(thebib(key)%ref%ISI_record).NE."") THEN - journal=TRIM(journal)//" ("//TRIM(get_issue(thebib(key)%ref%ISI_record))//")" - ENDIF - END IF - journal=TRIM(journal)//", "//get_pages(thebib(key)%ref%ISI_record) - IF (get_year(thebib(key)%ref%ISI_record).NE."") THEN - journal=TRIM(journal)//" ("//TRIM(get_year(thebib(key)%ref%ISI_record))//")." - ENDIF - IF (ipos_line+LEN_TRIM(journal)>71) THEN - WRITE(unit,'(A)') "" - WRITE(unit,'(T2,A)',ADVANCE="NO") "" - ipos_line=2 - ENDIF - WRITE(unit,'(A)',ADVANCE="NO") TRIM(journal) - - WRITE(unit,'(T2,A)') "" - ! Title - line=1 ; ititle=0 - title=get_next_title(thebib(key)%ref%ISI_record,line) - DO WHILE (title.NE."") - ititle=ititle+1 - IF (ititle.NE.1) WRITE(unit,'(A)') "" - WRITE(unit,'(T2,A)', ADVANCE="NO") TRIM(title) - title=get_next_title(thebib(key)%ref%ISI_record,line) - ENDDO - IF (ititle>0) WRITE(unit,'(A)') "." - - ! DOI - IF (thebib(key)%ref%DOI .NE. "") THEN - WRITE(unit,'(T2,A)') "https://dx.doi.org/"//TRIM(thebib(key)%ref%DOI) - ENDIF - - END SUBROUTINE print_reference_journal + WRITE (unit, '(T2,A)', ADVANCE="NO") "" + line = 1; iauthor = 0; ipos_line = 2 + author = get_next_author(thebib(key)%ref%ISI_record, line) + DO WHILE (author .NE. "") + iauthor = iauthor + 1 + IF (ipos_line + LEN_TRIM(author) > 71) THEN + WRITE (unit, '(A)') ";" + WRITE (unit, '(T2,A)', ADVANCE="NO") "" + ipos_line = 2 + ELSE + IF (iauthor .NE. 1) WRITE (unit, '(A)', ADVANCE="NO") "; " + ipos_line = ipos_line + 2 + ENDIF + WRITE (unit, '(A)', ADVANCE="NO") TRIM(author) + ipos_line = ipos_line + LEN_TRIM(author) + author = get_next_author(thebib(key)%ref%ISI_record, line) + ENDDO + IF (iauthor > 0) THEN + WRITE (unit, '(A)', ADVANCE="NO") ". " + ipos_line = ipos_line + 2 + ENDIF + + ! Journal, volume (issue), pages (year). + journal = TRIM(get_source(thebib(key)%ref%ISI_record)) + IF (get_volume(thebib(key)%ref%ISI_record) .NE. "") THEN + journal = TRIM(journal)//", "//get_volume(thebib(key)%ref%ISI_record) + IF (get_issue(thebib(key)%ref%ISI_record) .NE. "") THEN + journal = TRIM(journal)//" ("//TRIM(get_issue(thebib(key)%ref%ISI_record))//")" + ENDIF + END IF + journal = TRIM(journal)//", "//get_pages(thebib(key)%ref%ISI_record) + IF (get_year(thebib(key)%ref%ISI_record) .NE. "") THEN + journal = TRIM(journal)//" ("//TRIM(get_year(thebib(key)%ref%ISI_record))//")." + ENDIF + IF (ipos_line + LEN_TRIM(journal) > 71) THEN + WRITE (unit, '(A)') "" + WRITE (unit, '(T2,A)', ADVANCE="NO") "" + ipos_line = 2 + ENDIF + WRITE (unit, '(A)', ADVANCE="NO") TRIM(journal) + + WRITE (unit, '(T2,A)') "" + ! Title + line = 1; ititle = 0 + title = get_next_title(thebib(key)%ref%ISI_record, line) + DO WHILE (title .NE. "") + ititle = ititle + 1 + IF (ititle .NE. 1) WRITE (unit, '(A)') "" + WRITE (unit, '(T2,A)', ADVANCE="NO") TRIM(title) + title = get_next_title(thebib(key)%ref%ISI_record, line) + ENDDO + IF (ititle > 0) WRITE (unit, '(A)') "." + + ! DOI + IF (thebib(key)%ref%DOI .NE. "") THEN + WRITE (unit, '(T2,A)') "https://dx.doi.org/"//TRIM(thebib(key)%ref%DOI) + ENDIF + + END SUBROUTINE print_reference_journal ! ************************************************************************************************** !> \brief prints a reference in a journal style citation format, @@ -424,7 +424,7 @@ END SUBROUTINE print_reference_journal !> \par History !> 08.2007 created [Joost VandeVondele] ! ************************************************************************************************** - SUBROUTINE print_reference_html(key,unit) + SUBROUTINE print_reference_html(key, unit) INTEGER, INTENT(IN) :: key, unit CHARACTER(LEN=ISI_length) :: author, title @@ -433,51 +433,51 @@ SUBROUTINE print_reference_html(key,unit) ! write the author list - WRITE(unit,'(T2,A,I0,A)',ADVANCE="NO") '' - line=1 ; iauthor=0 - author=get_next_author(thebib(key)%ref%ISI_record,line) - DO WHILE (author.NE."") - iauthor=iauthor+1 - IF (iauthor.NE.1) WRITE(unit,'(A)',ADVANCE="NO") "; " - WRITE(unit,'(A)',ADVANCE="NO") TRIM(author) - author=get_next_author(thebib(key)%ref%ISI_record,line) - ENDDO - IF (iauthor>0) WRITE(unit,'(A)') ".
" - - ! DOI - IF (thebib(key)%ref%DOI .NE. "") THEN - WRITE(unit,'(T2,A)',ADVANCE="NO") '' - ENDIF - ! Journal, volume (issue), pages (year). - journal=TRIM(get_source(thebib(key)%ref%ISI_record)) - IF (get_volume(thebib(key)%ref%ISI_record).NE."") THEN - journal=TRIM(journal)//", "//get_volume(thebib(key)%ref%ISI_record) - IF (get_issue(thebib(key)%ref%ISI_record).NE."") THEN - journal=TRIM(journal)//" ("//TRIM(get_issue(thebib(key)%ref%ISI_record))//")" - ENDIF - END IF - journal=TRIM(journal)//", "//get_pages(thebib(key)%ref%ISI_record) - IF (get_year(thebib(key)%ref%ISI_record).NE."") THEN - journal=TRIM(journal)//" ("//TRIM(get_year(thebib(key)%ref%ISI_record))//")." - ENDIF - WRITE(unit,'(A)',ADVANCE="NO") TRIM(journal) - IF (thebib(key)%ref%DOI .NE. "") THEN - WRITE(unit,'(A)',ADVANCE="NO") '' - ENDIF - WRITE(unit,'(A)') "
" - - ! Title - line=1 ; ititle=0 - title=get_next_title(thebib(key)%ref%ISI_record,line) - DO WHILE (title.NE."") - ititle=ititle+1 - IF (ititle.NE.1) WRITE(unit,'(A)') "" - WRITE(unit,'(T2,A)', ADVANCE="NO") TRIM(title) - title=get_next_title(thebib(key)%ref%ISI_record,line) - ENDDO - IF (ititle>0) WRITE(unit,'(A)') "." - - END SUBROUTINE print_reference_html + WRITE (unit, '(T2,A,I0,A)', ADVANCE="NO") '' + line = 1; iauthor = 0 + author = get_next_author(thebib(key)%ref%ISI_record, line) + DO WHILE (author .NE. "") + iauthor = iauthor + 1 + IF (iauthor .NE. 1) WRITE (unit, '(A)', ADVANCE="NO") "; " + WRITE (unit, '(A)', ADVANCE="NO") TRIM(author) + author = get_next_author(thebib(key)%ref%ISI_record, line) + ENDDO + IF (iauthor > 0) WRITE (unit, '(A)') ".
" + + ! DOI + IF (thebib(key)%ref%DOI .NE. "") THEN + WRITE (unit, '(T2,A)', ADVANCE="NO") '' + ENDIF + ! Journal, volume (issue), pages (year). + journal = TRIM(get_source(thebib(key)%ref%ISI_record)) + IF (get_volume(thebib(key)%ref%ISI_record) .NE. "") THEN + journal = TRIM(journal)//", "//get_volume(thebib(key)%ref%ISI_record) + IF (get_issue(thebib(key)%ref%ISI_record) .NE. "") THEN + journal = TRIM(journal)//" ("//TRIM(get_issue(thebib(key)%ref%ISI_record))//")" + ENDIF + END IF + journal = TRIM(journal)//", "//get_pages(thebib(key)%ref%ISI_record) + IF (get_year(thebib(key)%ref%ISI_record) .NE. "") THEN + journal = TRIM(journal)//" ("//TRIM(get_year(thebib(key)%ref%ISI_record))//")." + ENDIF + WRITE (unit, '(A)', ADVANCE="NO") TRIM(journal) + IF (thebib(key)%ref%DOI .NE. "") THEN + WRITE (unit, '(A)', ADVANCE="NO") '' + ENDIF + WRITE (unit, '(A)') "
" + + ! Title + line = 1; ititle = 0 + title = get_next_title(thebib(key)%ref%ISI_record, line) + DO WHILE (title .NE. "") + ititle = ititle + 1 + IF (ititle .NE. 1) WRITE (unit, '(A)') "" + WRITE (unit, '(T2,A)', ADVANCE="NO") TRIM(title) + title = get_next_title(thebib(key)%ref%ISI_record, line) + ENDDO + IF (ititle > 0) WRITE (unit, '(A)') "." + + END SUBROUTINE print_reference_html ! ************************************************************************************************** !> \brief returns the corresponding fields from an ISI record. @@ -490,7 +490,7 @@ END SUBROUTINE print_reference_html !> \par History !> 08.2007 created [Joost VandeVondele] ! ************************************************************************************************** - FUNCTION get_next_author(ISI_record,iline_start) RESULT(res) + FUNCTION get_next_author(ISI_record, iline_start) RESULT(res) CHARACTER(LEN=ISI_length), DIMENSION(:), POINTER :: ISI_record INTEGER, INTENT(INOUT) :: iline_start CHARACTER(LEN=ISI_length) :: res @@ -498,25 +498,25 @@ FUNCTION get_next_author(ISI_record,iline_start) RESULT(res) INTEGER :: I, N LOGICAL :: in_au_section - res="" - in_au_section=.FALSE. - N=SIZE(ISI_record,1) - IF (iline_start>N) RETURN - line_loop: DO I=1,N - IF (ISI_record(I)(1:3)=="AU ") in_au_section=.TRUE. - IF (in_au_section .AND. (ISI_record(I)(1:3)/="AU " .AND. ISI_record(I)(1:3)/=" ")) in_au_section=.FALSE. - IF (in_au_section) THEN - IF (I>=iline_start) THEN - iline_start=I+1 - res=ISI_record(I)(4:) - EXIT line_loop - ENDIF - ENDIF - ENDDO line_loop + res = "" + in_au_section = .FALSE. + N = SIZE(ISI_record, 1) + IF (iline_start > N) RETURN + line_loop: DO I = 1, N + IF (ISI_record(I) (1:3) == "AU ") in_au_section = .TRUE. + IF (in_au_section .AND. (ISI_record(I) (1:3) /= "AU " .AND. ISI_record(I) (1:3) /= " ")) in_au_section = .FALSE. + IF (in_au_section) THEN + IF (I >= iline_start) THEN + iline_start = I + 1 + res = ISI_record(I) (4:) + EXIT line_loop + ENDIF + ENDIF + ENDDO line_loop - ! We might want to fixup the initials, adding a dot after each of them + ! We might want to fixup the initials, adding a dot after each of them - END FUNCTION get_next_author + END FUNCTION get_next_author ! ************************************************************************************************** !> \brief ... @@ -524,7 +524,7 @@ END FUNCTION get_next_author !> \param iline_start ... !> \return ... ! ************************************************************************************************** - FUNCTION get_next_title(ISI_record,iline_start) RESULT(res) + FUNCTION get_next_title(ISI_record, iline_start) RESULT(res) CHARACTER(LEN=ISI_length), DIMENSION(:), POINTER :: ISI_record INTEGER, INTENT(INOUT) :: iline_start CHARACTER(LEN=ISI_length) :: res @@ -532,192 +532,192 @@ FUNCTION get_next_title(ISI_record,iline_start) RESULT(res) INTEGER :: I, N LOGICAL :: in_ti_section - res="" + res = "" - in_ti_section=.FALSE. - N=SIZE(ISI_record,1) - IF (iline_start>N) RETURN - line_loop: DO I=1,N - IF (ISI_record(I)(1:3)=="TI ") in_ti_section=.TRUE. - IF (in_ti_section .AND. (ISI_record(I)(1:3)/="TI " .AND. ISI_record(I)(1:3)/=" ")) in_ti_section=.FALSE. - IF (in_ti_section) THEN - IF (I>=iline_start) THEN - iline_start=I+1 - res=ISI_record(I)(4:) - EXIT line_loop - ENDIF - ENDIF - ENDDO line_loop + in_ti_section = .FALSE. + N = SIZE(ISI_record, 1) + IF (iline_start > N) RETURN + line_loop: DO I = 1, N + IF (ISI_record(I) (1:3) == "TI ") in_ti_section = .TRUE. + IF (in_ti_section .AND. (ISI_record(I) (1:3) /= "TI " .AND. ISI_record(I) (1:3) /= " ")) in_ti_section = .FALSE. + IF (in_ti_section) THEN + IF (I >= iline_start) THEN + iline_start = I + 1 + res = ISI_record(I) (4:) + EXIT line_loop + ENDIF + ENDIF + ENDDO line_loop - END FUNCTION get_next_title + END FUNCTION get_next_title ! ************************************************************************************************** !> \brief ... !> \param ISI_record ... !> \return ... ! ************************************************************************************************** - FUNCTION get_source(ISI_record) RESULT(res) + FUNCTION get_source(ISI_record) RESULT(res) CHARACTER(LEN=ISI_length), DIMENSION(:), POINTER :: ISI_record CHARACTER(LEN=4*ISI_length) :: res INTEGER :: I, J, N - N=SIZE(ISI_record,1) - res="" - DO I=1,N - IF (ISI_record(I)(1:3)=="SO ") THEN - res=ISI_record(I)(4:) - DO J=I+1,N - IF (ISI_record(J)(1:3)==" ") THEN - res=TRIM(res)//" "//ISI_record(J)(4:) - ELSE - EXIT - ENDIF - ENDDO - EXIT - ENDIF - ENDDO - END FUNCTION get_source + N = SIZE(ISI_record, 1) + res = "" + DO I = 1, N + IF (ISI_record(I) (1:3) == "SO ") THEN + res = ISI_record(I) (4:) + DO J = I + 1, N + IF (ISI_record(J) (1:3) == " ") THEN + res = TRIM(res)//" "//ISI_record(J) (4:) + ELSE + EXIT + ENDIF + ENDDO + EXIT + ENDIF + ENDDO + END FUNCTION get_source ! ************************************************************************************************** !> \brief ... !> \param ISI_record ... !> \return ... ! ************************************************************************************************** - FUNCTION get_year(ISI_record) RESULT(res) + FUNCTION get_year(ISI_record) RESULT(res) CHARACTER(LEN=ISI_length), DIMENSION(:), POINTER :: ISI_record CHARACTER(LEN=ISI_length) :: res INTEGER :: I, N - N=SIZE(ISI_record,1) - res="" - DO I=1,N - IF (ISI_record(I)(1:3)=="PY ") res=ISI_record(I)(4:) - ENDDO - END FUNCTION get_year + N = SIZE(ISI_record, 1) + res = "" + DO I = 1, N + IF (ISI_record(I) (1:3) == "PY ") res = ISI_record(I) (4:) + ENDDO + END FUNCTION get_year ! ************************************************************************************************** !> \brief ... !> \param ISI_record ... !> \return ... ! ************************************************************************************************** - FUNCTION get_month(ISI_record) RESULT(res) + FUNCTION get_month(ISI_record) RESULT(res) CHARACTER(LEN=ISI_length), DIMENSION(:), POINTER :: ISI_record CHARACTER(LEN=ISI_length) :: res INTEGER :: I, N - N=SIZE(ISI_record,1) - res="" - DO I=1,N - IF (ISI_record(I)(1:3)=="PD ") res=ISI_record(I)(4:6) - ENDDO - END FUNCTION get_month + N = SIZE(ISI_record, 1) + res = "" + DO I = 1, N + IF (ISI_record(I) (1:3) == "PD ") res = ISI_record(I) (4:6) + ENDDO + END FUNCTION get_month ! ************************************************************************************************** !> \brief ... !> \param ISI_record ... !> \return ... ! ************************************************************************************************** - FUNCTION get_day(ISI_record) RESULT(res) + FUNCTION get_day(ISI_record) RESULT(res) CHARACTER(LEN=ISI_length), DIMENSION(:), POINTER :: ISI_record CHARACTER(LEN=ISI_length) :: res INTEGER :: D, I, N - N=SIZE(ISI_record,1) - res="" - DO I=1,N - IF (ISI_record(I)(1:3)=="PD ") res=ISI_record(I)(7:) - ENDDO - ! PD can be e.g. OCT-NOV or OCT or OCT 27 - ! if res can't be read as an integer, it is not a day, and we bail out - READ(res,*,ERR=998,END=998) D - ! if the day is not in the expected range, we assume it is a parse error - IF (D<0 .OR. D>31) res="" - RETURN -998 CONTINUE - res="" - END FUNCTION get_day + N = SIZE(ISI_record, 1) + res = "" + DO I = 1, N + IF (ISI_record(I) (1:3) == "PD ") res = ISI_record(I) (7:) + ENDDO + ! PD can be e.g. OCT-NOV or OCT or OCT 27 + ! if res can't be read as an integer, it is not a day, and we bail out + READ (res, *, ERR=998, END=998) D + ! if the day is not in the expected range, we assume it is a parse error + IF (D < 0 .OR. D > 31) res = "" + RETURN +998 CONTINUE + res = "" + END FUNCTION get_day ! ************************************************************************************************** !> \brief ... !> \param ISI_record ... !> \return ... ! ************************************************************************************************** - FUNCTION get_volume(ISI_record) RESULT(res) + FUNCTION get_volume(ISI_record) RESULT(res) CHARACTER(LEN=ISI_length), DIMENSION(:), POINTER :: ISI_record CHARACTER(LEN=ISI_length) :: res INTEGER :: I, N - N=SIZE(ISI_record,1) - res="" - DO I=1,N - IF (ISI_record(I)(1:3)=="VL ") res=ISI_record(I)(4:) - ENDDO - END FUNCTION get_volume + N = SIZE(ISI_record, 1) + res = "" + DO I = 1, N + IF (ISI_record(I) (1:3) == "VL ") res = ISI_record(I) (4:) + ENDDO + END FUNCTION get_volume ! ************************************************************************************************** !> \brief ... !> \param ISI_record ... !> \return ... ! ************************************************************************************************** - FUNCTION get_issue(ISI_record) RESULT(res) + FUNCTION get_issue(ISI_record) RESULT(res) CHARACTER(LEN=ISI_length), DIMENSION(:), POINTER :: ISI_record CHARACTER(LEN=ISI_length) :: res INTEGER :: I, N - N=SIZE(ISI_record,1) - res="" - DO I=1,N - IF (ISI_record(I)(1:3)=="IS ") res=ISI_record(I)(4:) - ENDDO - END FUNCTION get_issue + N = SIZE(ISI_record, 1) + res = "" + DO I = 1, N + IF (ISI_record(I) (1:3) == "IS ") res = ISI_record(I) (4:) + ENDDO + END FUNCTION get_issue ! ************************************************************************************************** !> \brief ... !> \param ISI_record ... !> \return ... ! ************************************************************************************************** - FUNCTION get_pages(ISI_record) RESULT(res) + FUNCTION get_pages(ISI_record) RESULT(res) CHARACTER(LEN=ISI_length), DIMENSION(:), POINTER :: ISI_record CHARACTER(LEN=ISI_length) :: res CHARACTER(LEN=ISI_length) :: ar, bp, ep INTEGER :: I, N - N=SIZE(ISI_record,1) - res="" - bp="" - ep="" - ar="" - - DO I=1,N - IF (ISI_record(I)(1:3)=="BP ") bp=ISI_record(I)(4:) - IF (ISI_record(I)(1:3)=="EP ") ep=ISI_record(I)(4:) - IF (ISI_record(I)(1:3)=="AR ") ar=ISI_record(I)(4:) - ENDDO - IF (bp.NE."") THEN - res=bp - IF (ep.NE."") res=TRIM(res)//"-"//ep - ENDIF - IF (res.EQ."".AND.ar.NE."") res=ar - END FUNCTION get_pages + N = SIZE(ISI_record, 1) + res = "" + bp = "" + ep = "" + ar = "" + + DO I = 1, N + IF (ISI_record(I) (1:3) == "BP ") bp = ISI_record(I) (4:) + IF (ISI_record(I) (1:3) == "EP ") ep = ISI_record(I) (4:) + IF (ISI_record(I) (1:3) == "AR ") ar = ISI_record(I) (4:) + ENDDO + IF (bp .NE. "") THEN + res = bp + IF (ep .NE. "") res = TRIM(res)//"-"//ep + ENDIF + IF (res .EQ. "" .AND. ar .NE. "") res = ar + END FUNCTION get_pages ! ************************************************************************************************** !> \brief ... !> \param key ... !> \return ... ! ************************************************************************************************** - FUNCTION get_citation_key(key) RESULT(res) + FUNCTION get_citation_key(key) RESULT(res) INTEGER :: key CHARACTER(LEN=default_string_length) :: res - res=thebib(key)%ref%citation_key - END FUNCTION get_citation_key + res = thebib(key)%ref%citation_key + END FUNCTION get_citation_key ! ! This returns something epoch like, but can only be used to order the records @@ -728,7 +728,7 @@ END FUNCTION get_citation_key !> \param ISI_record ... !> \return ... ! ************************************************************************************************** - FUNCTION get_epoch(ISI_record) RESULT(res) + FUNCTION get_epoch(ISI_record) RESULT(res) CHARACTER(LEN=ISI_length), DIMENSION(:), POINTER :: ISI_record INTEGER :: res @@ -737,48 +737,48 @@ FUNCTION get_epoch(ISI_record) RESULT(res) ! read year - tmp=get_year(ISI_record) - READ(tmp,*,IOSTAT=istat) year - IF (istat.NE.0) year=1900 - - ! read day - tmp=get_day(ISI_record) - READ(tmp,*,IOSTAT=istat) day - IF (istat.NE.0) day=0 - - ! read month - tmp=get_month(ISI_record) - SELECT CASE(tmp) - CASE("JAN") - month=1 - CASE("FEB") - month=2 - CASE("MAR") - month=3 - CASE("APR") - month=4 - CASE("MAY") - month=5 - CASE("JUN") - month=6 - CASE("JUL") - month=7 - CASE("AUG") - month=8 - CASE("SEP") - month=9 - CASE("OCT") - month=10 - CASE("NOV") - month=11 - CASE("DEC") - month=12 - CASE DEFAULT - month=0 - END SELECT - - res=day+31*month+12*31*(year-1900) - - END FUNCTION get_epoch + tmp = get_year(ISI_record) + READ (tmp, *, IOSTAT=istat) year + IF (istat .NE. 0) year = 1900 + + ! read day + tmp = get_day(ISI_record) + READ (tmp, *, IOSTAT=istat) day + IF (istat .NE. 0) day = 0 + + ! read month + tmp = get_month(ISI_record) + SELECT CASE (tmp) + CASE ("JAN") + month = 1 + CASE ("FEB") + month = 2 + CASE ("MAR") + month = 3 + CASE ("APR") + month = 4 + CASE ("MAY") + month = 5 + CASE ("JUN") + month = 6 + CASE ("JUL") + month = 7 + CASE ("AUG") + month = 8 + CASE ("SEP") + month = 9 + CASE ("OCT") + month = 10 + CASE ("NOV") + month = 11 + CASE ("DEC") + month = 12 + CASE DEFAULT + month = 0 + END SELECT + + res = day + 31*month + 12*31*(year - 1900) + + END FUNCTION get_epoch END MODULE reference_manager diff --git a/src/common/sort_m.f90 b/src/common/sort_m.f90 index ca5de3673b..f0a40ba2b1 100644 --- a/src/common/sort_m.f90 +++ b/src/common/sort_m.f90 @@ -1,4 +1,4 @@ - isize = iend-istart+1 + isize = iend - istart + 1 ! Initialize the INDEX array only for the first row.. IF (j == 1) THEN DO i = 1, isize @@ -10,7 +10,7 @@ ALLOCATE (work(isize), work2(isize), tmp_index(isize), bck_index(isize)) ind = 0 DO i = istart, iend - ind = ind+1 + ind = ind + 1 work(ind) = matrix(j, i) bck_index(ind) = INDEX(i) END DO @@ -21,21 +21,21 @@ ! Copy into global INDEX array with a proper mapping ind = 0 DO i = istart, iend - ind = ind+1 + ind = ind + 1 INDEX(i) = bck_index(tmp_index(ind)) matrix(j, i) = work(ind) END DO ! Reorder the rest of the array according the present reordering - DO k = j+1, jsize + DO k = j + 1, jsize ind = 0 DO i = istart, iend - ind = ind+1 + ind = ind + 1 work2(ind) = matrix(k, i) END DO ind = 0 DO i = istart, iend - ind = ind+1 + ind = ind + 1 matrix(k, i) = work2(tmp_index(ind)) END DO END DO @@ -46,19 +46,19 @@ item = work(1) ind = 0 DO i = istart, iend - ind = ind+1 + ind = ind + 1 IF (item /= work(ind)) THEN - kend = i-1 + kend = i - 1 IF (kstart /= kend) THEN - CALL sort(matrix, kstart, kend, j+1, jsize, INDEX) + CALL sort(matrix, kstart, kend, j + 1, jsize, INDEX) END IF item = work(ind) kstart = i END IF END DO - kend = i-1 + kend = i - 1 IF (kstart /= kend) THEN - CALL sort(matrix, kstart, kend, j+1, jsize, INDEX) + CALL sort(matrix, kstart, kend, j + 1, jsize, INDEX) END IF END IF DEALLOCATE (work, work2, tmp_index, bck_index) diff --git a/src/common/spherical_harmonics.F b/src/common/spherical_harmonics.F index 17d68dc624..3ec364ba85 100644 --- a/src/common/spherical_harmonics.F +++ b/src/common/spherical_harmonics.F @@ -80,9 +80,9 @@ SUBROUTINE clebsch_gordon_complex(l1, m1, l2, m2, clm) INTEGER :: icase, ind, l, lm, lp, n - l = l1+l2 + l = l1 + l2 IF (l > lmax) CALL clebsch_gordon_init(l) - n = l/2+1 + n = l/2 + 1 IF (n > SIZE(clm)) CPABORT("Array too small") IF ((m1 >= 0 .AND. m2 >= 0) .OR. (m1 < 0 .AND. m2 < 0)) THEN @@ -93,7 +93,7 @@ SUBROUTINE clebsch_gordon_complex(l1, m1, l2, m2, clm) ind = order(l1, m1, l2, m2) DO lp = MOD(l, 2), l, 2 - lm = lp/2+1 + lm = lp/2 + 1 clm(lm) = cg_table(ind, lm, icase) END DO @@ -117,9 +117,9 @@ SUBROUTINE clebsch_gordon_real(l1, m1, l2, m2, rlm) INTEGER :: icase1, icase2, ind, l, lm, lp, mm(2), n REAL(KIND=dp) :: xsi - l = l1+l2 + l = l1 + l2 IF (l > lmax) CALL clebsch_gordon_init(l) - n = l/2+1 + n = l/2 + 1 IF (n > SIZE(rlm, 1)) CPABORT("Array too small") ind = order(l1, m1, l2, m2) @@ -133,7 +133,7 @@ SUBROUTINE clebsch_gordon_real(l1, m1, l2, m2, rlm) END IF DO lp = MOD(l, 2), l, 2 - lm = lp/2+1 + lm = lp/2 + 1 xsi = get_factor(m1, m2, mm(1)) rlm(lm, 1) = xsi*cg_table(ind, lm, icase1) xsi = get_factor(m1, m2, mm(2)) @@ -154,8 +154,8 @@ FUNCTION getm(m1, m2) RESULT(m) INTEGER :: mm, mp - mp = m1+m2 - mm = m1-m2 + mp = m1 + m2 + mm = m1 - m2 IF (m1*m2 < 0 .OR. (m1*m2 == 0 .AND. (m1 < 0 .OR. m2 < 0))) THEN mp = -ABS(mp) mm = -ABS(mm) @@ -197,16 +197,16 @@ FUNCTION get_factor(m1, m2, m) RESULT(f) ELSE f = 0.0_dp END IF - ELSE IF (ABS(mx)+ABS(my) == m) THEN + ELSE IF (ABS(mx) + ABS(my) == m) THEN f = osq2 IF (mx < 0) f = -osq2 - ELSE IF (ABS(mx)+ABS(my) == -m) THEN + ELSE IF (ABS(mx) + ABS(my) == -m) THEN f = osq2 - ELSE IF (ABS(mx)-ABS(my) == -m) THEN + ELSE IF (ABS(mx) - ABS(my) == -m) THEN IF (mx*my > 0) WRITE (*, '(A,3I6)') " 2) Illegal Case ", m1, m2, m IF (mx > 0) f = -osq2 IF (mx < 0) f = osq2 - ELSE IF (ABS(mx)-ABS(my) == m) THEN + ELSE IF (ABS(mx) - ABS(my) == m) THEN IF (mx*my < 0) WRITE (*, '(A,3I6)') " 3) Illegal Case ", m1, m2, m f = osq2 ELSE @@ -255,25 +255,25 @@ SUBROUTINE clebsch_gordon_init(l) DEALLOCATE (cg_table) END IF ! maximum size of table - n = (l**4+6*l**3+15*l**2+18*l+8)/8 - m = l+1 + n = (l**4 + 6*l**3 + 15*l**2 + 18*l + 8)/8 + m = l + 1 ALLOCATE (cg_table(n, m, 2)) lmax = l DO l1 = 0, lmax DO m1 = 0, l1 - iy = (l1*(l1+1))/2+m1+1 + iy = (l1*(l1 + 1))/2 + m1 + 1 DO l2 = l1, lmax ml = 0 IF (l1 == l2) ml = m1 DO m2 = ml, l2 - ix = (l2*(l2+1))/2+m2+1 - i1 = (ix*(ix-1))/2+iy - DO lp = MOD(l1+l2, 2), l1+l2, 2 - i2 = lp/2+1 - mp = m2+m1 + ix = (l2*(l2 + 1))/2 + m2 + 1 + i1 = (ix*(ix - 1))/2 + iy + DO lp = MOD(l1 + l2, 2), l1 + l2, 2 + i2 = lp/2 + 1 + mp = m2 + m1 cg_table(i1, i2, 1) = cgc(l1, m1, l2, m2, lp, mp) - mp = ABS(m2-m1) + mp = ABS(m2 - m1) IF (m2 >= m1) THEN cg_table(i1, i2, 2) = cgc(l1, m1, lp, mp, l2, m2) ELSE @@ -328,26 +328,26 @@ FUNCTION cgc(l1, m1, l2, m2, lp, mp) mb = m2 END IF - IF (MOD(la+lb+lp, 2) == 0 .AND. la+lb >= lp .AND. lp >= lb-la & - .AND. lb-mb >= 0) THEN - ll = (2*lp+1)*(2*la+1)*(2*lb+1) + IF (MOD(la + lb + lp, 2) == 0 .AND. la + lb >= lp .AND. lp >= lb - la & + .AND. lb - mb >= 0) THEN + ll = (2*lp + 1)*(2*la + 1)*(2*lb + 1) pref = 1.0_dp/SQRT(4.0_dp*pi)*0.5_dp*SQRT(REAL(ll, dp)* & - (sfac(lp-mp)/sfac(lp+mp))* & - (sfac(la-ma)/sfac(la+ma))*(sfac(lb-mb)/sfac(lb+mb))) - s = (la+lb+lp)/2 - tmin = MAX(0, -lb+la-mp) - tmax = MIN(lb+la-mp, lp-mp, la-ma) - f1 = REAL(2*(-1)**(s-lb-ma), KIND=dp)*(sfac(lb+mb)/sfac(lb-mb))* & - sfac(la+ma)/(sfac(s-lp)*sfac(s-lb))*sfac(2*s-2*la)/sfac(s-la)* & - (sfac(s)/sfac(2*s+1)) + (sfac(lp - mp)/sfac(lp + mp))* & + (sfac(la - ma)/sfac(la + ma))*(sfac(lb - mb)/sfac(lb + mb))) + s = (la + lb + lp)/2 + tmin = MAX(0, -lb + la - mp) + tmax = MIN(lb + la - mp, lp - mp, la - ma) + f1 = REAL(2*(-1)**(s - lb - ma), KIND=dp)*(sfac(lb + mb)/sfac(lb - mb))* & + sfac(la + ma)/(sfac(s - lp)*sfac(s - lb))*sfac(2*s - 2*la)/sfac(s - la)* & + (sfac(s)/sfac(2*s + 1)) f2 = 0.0_dp DO t = tmin, tmax - z1 = lp+mp+t - z2 = la+lb-mp-t - z3 = lp-mp-t - z4 = lb-la+mp+t - z5 = la-ma-t - f2 = f2+(-1)**t*(sfac(z1)/(sfac(t)*sfac(z3)))*(sfac(z2)/(sfac(z4)*sfac(z5))) + z1 = lp + mp + t + z2 = la + lb - mp - t + z3 = lp - mp - t + z4 = lb - la + mp + t + z5 = la - ma - t + f2 = f2 + (-1)**t*(sfac(z1)/(sfac(t)*sfac(z3)))*(sfac(z2)/(sfac(z4)*sfac(z5))) END DO cgc = pref*f1*f2 ELSE @@ -369,7 +369,7 @@ FUNCTION sfac(n) RESULT(fval) IF (n > maxfac) THEN fval = fac(maxfac) - DO i = maxfac+1, n + DO i = maxfac + 1, n fval = REAL(i, dp)*fval END DO ELSE IF (n >= 0) THEN @@ -393,11 +393,11 @@ FUNCTION order(l1, m1, l2, m2) RESULT(ind) INTEGER :: i1, i2, ix, iy - i1 = (l1*(l1+1))/2+ABS(m1)+1 - i2 = (l2*(l2+1))/2+ABS(m2)+1 + i1 = (l1*(l1 + 1))/2 + ABS(m1) + 1 + i2 = (l2*(l2 + 1))/2 + ABS(m2) + 1 ix = MAX(i1, i2) iy = MIN(i1, i2) - ind = (ix*(ix-1))/2+iy + ind = (ix*(ix - 1))/2 + iy END FUNCTION order ! Calculation of Spherical Harmonics @@ -455,13 +455,13 @@ SUBROUTINE rvy_lm(r, y, l, m) CPABORT("l = 2 and m value out of bounds") CASE (2) pf = SQRT(15.0_dp/(16.0_dp*pi)) - y(:) = pf*(r(1, :)*r(1, :)-r(2, :)*r(2, :)) + y(:) = pf*(r(1, :)*r(1, :) - r(2, :)*r(2, :)) CASE (1) pf = SQRT(15.0_dp/(4.0_dp*pi)) y(:) = pf*r(3, :)*r(1, :) CASE (0) pf = SQRT(5.0_dp/(16.0_dp*pi)) - y(:) = pf*(3.0_dp*r(3, :)*r(3, :)-1.0_dp) + y(:) = pf*(3.0_dp*r(3, :)*r(3, :) - 1.0_dp) CASE (-1) pf = SQRT(15.0_dp/(4.0_dp*pi)) y(:) = pf*r(3, :)*r(2, :) @@ -475,39 +475,39 @@ SUBROUTINE rvy_lm(r, y, l, m) CPABORT("l = 3 and m value out of bounds") CASE (3) pf = SQRT(35.0_dp/(32.0_dp*pi)) - y(:) = pf*r(1, :)*(r(1, :)**2-3.0_dp*r(2, :)**2) + y(:) = pf*r(1, :)*(r(1, :)**2 - 3.0_dp*r(2, :)**2) CASE (2) pf = SQRT(105.0_dp/(16.0_dp*pi)) - y(:) = pf*r(3, :)*(r(1, :)**2-r(2, :)**2) + y(:) = pf*r(3, :)*(r(1, :)**2 - r(2, :)**2) CASE (1) pf = SQRT(21.0_dp/(32.0_dp*pi)) - y(:) = pf*r(1, :)*(5.0_dp*r(3, :)*r(3, :)-1.0_dp) + y(:) = pf*r(1, :)*(5.0_dp*r(3, :)*r(3, :) - 1.0_dp) CASE (0) pf = SQRT(7.0_dp/(16.0_dp*pi)) - y(:) = pf*r(3, :)*(5.0_dp*r(3, :)*r(3, :)-3.0_dp) + y(:) = pf*r(3, :)*(5.0_dp*r(3, :)*r(3, :) - 3.0_dp) CASE (-1) pf = SQRT(21.0_dp/(32.0_dp*pi)) - y(:) = pf*r(2, :)*(5.0_dp*r(3, :)*r(3, :)-1.0_dp) + y(:) = pf*r(2, :)*(5.0_dp*r(3, :)*r(3, :) - 1.0_dp) CASE (-2) pf = SQRT(105.0_dp/(16.0_dp*pi)) y(:) = pf*2.0_dp*r(1, :)*r(2, :)*r(3, :) CASE (-3) pf = SQRT(35.0_dp/(32.0_dp*pi)) - y(:) = pf*r(2, :)*(3.0_dp*r(1, :)**2-r(2, :)**2) + y(:) = pf*r(2, :)*(3.0_dp*r(1, :)**2 - r(2, :)**2) END SELECT CASE DEFAULT IF (m < -l .OR. m > l) CPABORT("m value out of bounds") - lpm = fac(l+ABS(m)) - lmm = fac(l-ABS(m)) + lpm = fac(l + ABS(m)) + lmm = fac(l - ABS(m)) IF (m == 0) THEN t = 4.0_dp*pi ELSE t = 2.0_dp*pi END IF IF (ABS(lpm) < EPSILON(1.0_dp)) THEN - pf = REAL(2*l+1, KIND=dp)/t + pf = REAL(2*l + 1, KIND=dp)/t ELSE - pf = (REAL(2*l+1, KIND=dp)*lmm)/(t*lpm) + pf = (REAL(2*l + 1, KIND=dp)*lmm)/(t*lpm) ENDIF pf = SQRT(pf) DO i = 1, SIZE(r, 2) @@ -517,7 +517,7 @@ SUBROUTINE rvy_lm(r, y, l, m) IF (m == 0) THEN y(i) = pf*plm ELSE - rxy = SQRT(r(1, i)**2+r(2, i)**2) + rxy = SQRT(r(1, i)**2 + r(2, i)**2) IF (rxy < EPSILON(1.0_dp)) THEN y(i) = 0.0_dp ELSE @@ -587,13 +587,13 @@ SUBROUTINE rry_lm(r, y, l, m) CPABORT("l = 2 and m value out of bounds") CASE (2) pf = SQRT(15.0_dp/(16.0_dp*pi)) - y = pf*(r(1)*r(1)-r(2)*r(2)) + y = pf*(r(1)*r(1) - r(2)*r(2)) CASE (1) pf = SQRT(15.0_dp/(4.0_dp*pi)) y = pf*r(3)*r(1) CASE (0) pf = SQRT(5.0_dp/(16.0_dp*pi)) - y = pf*(3.0_dp*r(3)*r(3)-1.0_dp) + y = pf*(3.0_dp*r(3)*r(3) - 1.0_dp) CASE (-1) pf = SQRT(15.0_dp/(4.0_dp*pi)) y = pf*r(3)*r(2) @@ -607,39 +607,39 @@ SUBROUTINE rry_lm(r, y, l, m) CPABORT("l = 3 and m value out of bounds") CASE (3) pf = SQRT(35.0_dp/(32.0_dp*pi)) - y = pf*r(1)*(r(1)**2-3.0_dp*r(2)**2) + y = pf*r(1)*(r(1)**2 - 3.0_dp*r(2)**2) CASE (2) pf = SQRT(105.0_dp/(16.0_dp*pi)) - y = pf*r(3)*(r(1)**2-r(2)**2) + y = pf*r(3)*(r(1)**2 - r(2)**2) CASE (1) pf = SQRT(21.0_dp/(32.0_dp*pi)) - y = pf*r(1)*(5.0_dp*r(3)*r(3)-1.0_dp) + y = pf*r(1)*(5.0_dp*r(3)*r(3) - 1.0_dp) CASE (0) pf = SQRT(7.0_dp/(16.0_dp*pi)) - y = pf*r(3)*(5.0_dp*r(3)*r(3)-3.0_dp) + y = pf*r(3)*(5.0_dp*r(3)*r(3) - 3.0_dp) CASE (-1) pf = SQRT(21.0_dp/(32.0_dp*pi)) - y = pf*r(2)*(5.0_dp*r(3)*r(3)-1.0_dp) + y = pf*r(2)*(5.0_dp*r(3)*r(3) - 1.0_dp) CASE (-2) pf = SQRT(105.0_dp/(16.0_dp*pi)) y = pf*2.0_dp*r(1)*r(2)*r(3) CASE (-3) pf = SQRT(35.0_dp/(32.0_dp*pi)) - y = pf*r(2)*(3.0_dp*r(1)**2-r(2)**2) + y = pf*r(2)*(3.0_dp*r(1)**2 - r(2)**2) END SELECT CASE DEFAULT IF (m < -l .OR. m > l) CPABORT("m value out of bounds") - lpm = fac(l+ABS(m)) - lmm = fac(l-ABS(m)) + lpm = fac(l + ABS(m)) + lmm = fac(l - ABS(m)) IF (m == 0) THEN t = 4.0_dp*pi ELSE t = 2.0_dp*pi END IF IF (ABS(lpm) < EPSILON(1.0_dp)) THEN - pf = REAL(2*l+1, KIND=dp)/t + pf = REAL(2*l + 1, KIND=dp)/t ELSE - pf = (REAL(2*l+1, KIND=dp)*lmm)/(t*lpm) + pf = (REAL(2*l + 1, KIND=dp)*lmm)/(t*lpm) ENDIF pf = SQRT(pf) z = r(3) @@ -647,7 +647,7 @@ SUBROUTINE rry_lm(r, y, l, m) IF (m == 0) THEN y = pf*plm ELSE - rxy = SQRT(r(1)**2+r(2)**2) + rxy = SQRT(r(1)**2 + r(2)**2) IF (rxy < EPSILON(1.0_dp)) THEN y = 0.0_dp ELSE @@ -728,7 +728,7 @@ SUBROUTINE cvy_lm(r, y, l, m) CASE (2) pf = SQRT(15.0_dp/(32.0_dp*pi)) DO i = 1, n - yp = (r(1, i)*r(1, i)-r(2, i)*r(2, i)) + yp = (r(1, i)*r(1, i) - r(2, i)*r(2, i)) ym = 2.0_dp*r(1, i)*r(2, i) y(i) = pf*CMPLX(yp, ym, KIND=dp) END DO @@ -741,7 +741,7 @@ SUBROUTINE cvy_lm(r, y, l, m) END DO CASE (0) pf = SQRT(5.0_dp/(16.0_dp*pi)) - y(:) = pf*(3.0_dp*r(3, :)*r(3, :)-1.0_dp) + y(:) = pf*(3.0_dp*r(3, :)*r(3, :) - 1.0_dp) CASE (-1) pf = SQRT(15.0_dp/(8.0_dp*pi)) DO i = 1, n @@ -752,7 +752,7 @@ SUBROUTINE cvy_lm(r, y, l, m) CASE (-2) pf = SQRT(15.0_dp/(32.0_dp*pi)) DO i = 1, n - yp = (r(1, i)*r(1, i)-r(2, i)*r(2, i)) + yp = (r(1, i)*r(1, i) - r(2, i)*r(2, i)) ym = 2.0_dp*r(1, i)*r(2, i) y(i) = pf*CMPLX(yp, -ym, KIND=dp) END DO @@ -764,58 +764,58 @@ SUBROUTINE cvy_lm(r, y, l, m) CASE (3) pf = SQRT(35.0_dp/(64.0_dp*pi)) DO i = 1, n - yp = r(1, i)*(r(1, i)**2-3.0_dp*r(2, i)**2) - ym = r(2, i)*(3.0_dp*r(1, i)**2-r(2, i)**2) + yp = r(1, i)*(r(1, i)**2 - 3.0_dp*r(2, i)**2) + ym = r(2, i)*(3.0_dp*r(1, i)**2 - r(2, i)**2) y(i) = pf*CMPLX(yp, ym, KIND=dp) END DO CASE (2) pf = SQRT(105.0_dp/(32.0_dp*pi)) DO i = 1, n - yp = r(3, i)*(r(1, i)**2-r(2, i)**2) + yp = r(3, i)*(r(1, i)**2 - r(2, i)**2) ym = 2.0_dp*r(1, i)*r(2, i)*r(3, i) y(i) = pf*CMPLX(yp, ym, KIND=dp) END DO CASE (1) pf = SQRT(21.0_dp/(64.0_dp*pi)) DO i = 1, n - yp = r(1, i)*(5.0_dp*r(3, i)*r(3, i)-1.0_dp) - ym = r(2, i)*(5.0_dp*r(3, i)*r(3, i)-1.0_dp) + yp = r(1, i)*(5.0_dp*r(3, i)*r(3, i) - 1.0_dp) + ym = r(2, i)*(5.0_dp*r(3, i)*r(3, i) - 1.0_dp) y(i) = pf*CMPLX(yp, ym, KIND=dp) END DO CASE (0) pf = SQRT(7.0_dp/(16.0_dp*pi)) - y(:) = pf*r(3, :)*(5.0_dp*r(3, :)*r(3, :)-3.0_dp) + y(:) = pf*r(3, :)*(5.0_dp*r(3, :)*r(3, :) - 3.0_dp) CASE (-1) pf = SQRT(21.0_dp/(64.0_dp*pi)) DO i = 1, n - yp = r(1, i)*(5.0_dp*r(3, i)*r(3, i)-1.0_dp) - ym = r(2, i)*(5.0_dp*r(3, i)*r(3, i)-1.0_dp) + yp = r(1, i)*(5.0_dp*r(3, i)*r(3, i) - 1.0_dp) + ym = r(2, i)*(5.0_dp*r(3, i)*r(3, i) - 1.0_dp) y(i) = pf*CMPLX(yp, -ym, KIND=dp) END DO CASE (-2) pf = SQRT(105.0_dp/(32.0_dp*pi)) DO i = 1, n - yp = r(3, i)*(r(1, i)**2-r(2, i)**2) + yp = r(3, i)*(r(1, i)**2 - r(2, i)**2) ym = 2.0_dp*r(1, i)*r(2, i)*r(3, i) y(i) = pf*CMPLX(yp, -ym, KIND=dp) END DO CASE (-3) pf = SQRT(35.0_dp/(64.0_dp*pi)) DO i = 1, n - yp = r(1, i)*(r(1, i)**2-3.0_dp*r(2, i)**2) - ym = r(2, i)*(3.0_dp*r(1, i)**2-r(2, i)**2) + yp = r(1, i)*(r(1, i)**2 - 3.0_dp*r(2, i)**2) + ym = r(2, i)*(3.0_dp*r(1, i)**2 - r(2, i)**2) y(i) = pf*CMPLX(yp, -ym, KIND=dp) END DO END SELECT CASE DEFAULT IF (m < -l .OR. m > l) CPABORT("m value out of bounds") - lpm = fac(l+ABS(m)) - lmm = fac(l-ABS(m)) + lpm = fac(l + ABS(m)) + lmm = fac(l - ABS(m)) t = 4.0_dp*pi IF (ABS(lpm) < EPSILON(1.0_dp)) THEN - pf = REAL(2*l+1, KIND=dp)/t + pf = REAL(2*l + 1, KIND=dp)/t ELSE - pf = (REAL(2*l+1, KIND=dp)*lmm)/(t*lpm) + pf = (REAL(2*l + 1, KIND=dp)*lmm)/(t*lpm) ENDIF pf = SQRT(pf) DO i = 1, n @@ -824,7 +824,7 @@ SUBROUTINE cvy_lm(r, y, l, m) IF (m == 0) THEN y(i) = pf*plm ELSE - rxy = SQRT(r(1, i)**2+r(2, i)**2) + rxy = SQRT(r(1, i)**2 + r(2, i)**2) IF (rxy < EPSILON(1.0_dp)) THEN y(i) = 0.0_dp ELSE @@ -903,7 +903,7 @@ SUBROUTINE ccy_lm(r, y, l, m) CPABORT("l = 2 and m value out of bounds") CASE (2) pf = SQRT(15.0_dp/(32.0_dp*pi)) - yp = (r(1)*r(1)-r(2)*r(2)) + yp = (r(1)*r(1) - r(2)*r(2)) ym = 2.0_dp*r(1)*r(2) y = pf*CMPLX(yp, ym, KIND=dp) CASE (1) @@ -913,7 +913,7 @@ SUBROUTINE ccy_lm(r, y, l, m) y = pf*CMPLX(yp, ym, KIND=dp) CASE (0) pf = SQRT(5.0_dp/(16.0_dp*pi)) - y = pf*(3.0_dp*r(3)*r(3)-1.0_dp) + y = pf*(3.0_dp*r(3)*r(3) - 1.0_dp) CASE (-1) pf = SQRT(15.0_dp/(8.0_dp*pi)) yp = r(3)*r(1) @@ -921,7 +921,7 @@ SUBROUTINE ccy_lm(r, y, l, m) y = pf*CMPLX(yp, -ym, KIND=dp) CASE (-2) pf = SQRT(15.0_dp/(32.0_dp*pi)) - yp = (r(1)*r(1)-r(2)*r(2)) + yp = (r(1)*r(1) - r(2)*r(2)) ym = 2.0_dp*r(1)*r(2) y = pf*CMPLX(yp, -ym, KIND=dp) END SELECT @@ -931,47 +931,47 @@ SUBROUTINE ccy_lm(r, y, l, m) CPABORT("l = 3 and m value out of bounds") CASE (3) pf = SQRT(35.0_dp/(64.0_dp*pi)) - yp = r(1)*(r(1)**2-3.0_dp*r(2)**2) - ym = r(2)*(3.0_dp*r(1)**2-r(2)**2) + yp = r(1)*(r(1)**2 - 3.0_dp*r(2)**2) + ym = r(2)*(3.0_dp*r(1)**2 - r(2)**2) y = pf*CMPLX(yp, ym, KIND=dp) CASE (2) pf = SQRT(105.0_dp/(32.0_dp*pi)) - yp = r(3)*(r(1)**2-r(2)**2) + yp = r(3)*(r(1)**2 - r(2)**2) ym = 2.0_dp*r(1)*r(2)*r(3) y = pf*CMPLX(yp, ym, KIND=dp) CASE (1) pf = SQRT(21.0_dp/(64.0_dp*pi)) - yp = r(1)*(5.0_dp*r(3)*r(3)-1.0_dp) - ym = r(2)*(5.0_dp*r(3)*r(3)-1.0_dp) + yp = r(1)*(5.0_dp*r(3)*r(3) - 1.0_dp) + ym = r(2)*(5.0_dp*r(3)*r(3) - 1.0_dp) y = pf*CMPLX(yp, ym, KIND=dp) CASE (0) pf = SQRT(7.0_dp/(16.0_dp*pi)) - y = pf*r(3)*(5.0_dp*r(3)*r(3)-3.0_dp) + y = pf*r(3)*(5.0_dp*r(3)*r(3) - 3.0_dp) CASE (-1) pf = SQRT(21.0_dp/(64.0_dp*pi)) - yp = r(1)*(5.0_dp*r(3)*r(3)-1.0_dp) - ym = r(2)*(5.0_dp*r(3)*r(3)-1.0_dp) + yp = r(1)*(5.0_dp*r(3)*r(3) - 1.0_dp) + ym = r(2)*(5.0_dp*r(3)*r(3) - 1.0_dp) y = pf*CMPLX(yp, -ym, KIND=dp) CASE (-2) pf = SQRT(105.0_dp/(32.0_dp*pi)) - yp = r(3)*(r(1)**2-r(2)**2) + yp = r(3)*(r(1)**2 - r(2)**2) ym = 2.0_dp*r(1)*r(2)*r(3) y = pf*CMPLX(yp, -ym, KIND=dp) CASE (-3) pf = SQRT(35.0_dp/(64.0_dp*pi)) - yp = r(1)*(r(1)**2-3.0_dp*r(2)**2) - ym = r(2)*(3.0_dp*r(1)**2-r(2)**2) + yp = r(1)*(r(1)**2 - 3.0_dp*r(2)**2) + ym = r(2)*(3.0_dp*r(1)**2 - r(2)**2) y = pf*CMPLX(yp, -ym, KIND=dp) END SELECT CASE DEFAULT IF (m < -l .OR. m > l) CPABORT("m value out of bounds") - lpm = fac(l+ABS(m)) - lmm = fac(l-ABS(m)) + lpm = fac(l + ABS(m)) + lmm = fac(l - ABS(m)) t = 4.0_dp*pi IF (ABS(lpm) < EPSILON(1.0_dp)) THEN - pf = REAL(2*l+1, KIND=dp)/t + pf = REAL(2*l + 1, KIND=dp)/t ELSE - pf = (REAL(2*l+1, KIND=dp)*lmm)/(t*lpm) + pf = (REAL(2*l + 1, KIND=dp)*lmm)/(t*lpm) ENDIF pf = SQRT(pf) z = r(3) @@ -979,7 +979,7 @@ SUBROUTINE ccy_lm(r, y, l, m) IF (m == 0) THEN y = pf*plm ELSE - rxy = SQRT(r(1)**2+r(2)**2) + rxy = SQRT(r(1)**2 + r(2)**2) IF (rxy < EPSILON(1.0_dp)) THEN y = 0.0_dp ELSE @@ -1083,13 +1083,13 @@ SUBROUTINE dry_lm(c, dy, l, m) dy(1) = pf*2.0_dp*st*ct*COS(2._dp*p) CASE (1) pf = SQRT(15.0_dp/(4.0_dp*pi)) - dy(1) = pf*cp*(ct*ct-st*st) + dy(1) = pf*cp*(ct*ct - st*st) CASE (0) pf = SQRT(5.0_dp/(16.0_dp*pi)) dy(1) = -pf*6.0_dp*ct*st CASE (-1) pf = SQRT(15.0_dp/(4.0_dp*pi)) - dy(1) = pf*sp*(ct*ct-st*st) + dy(1) = pf*sp*(ct*ct - st*st) CASE (-2) pf = SQRT(15.0_dp/(16.0_dp*pi)) dy(1) = pf*2.0_dp*st*ct*SIN(2._dp*p) @@ -1106,13 +1106,13 @@ SUBROUTINE dry_lm(c, dy, l, m) dy(1) = pf*2.0_dp*COS(2._dp*p)*ct*st CASE (1) pf = SQRT(21.0_dp/(32.0_dp*pi)) - dy(1) = pf*cp*(ct*(5.0_dp*ct-1.0_dp)-5.0_dp*st*st) + dy(1) = pf*cp*(ct*(5.0_dp*ct - 1.0_dp) - 5.0_dp*st*st) CASE (0) pf = SQRT(7.0_dp/(16.0_dp*pi)) - dy(1) = pf*r(3)*(3.0_dp-15.0_dp*ct*ct)*st + dy(1) = pf*r(3)*(3.0_dp - 15.0_dp*ct*ct)*st CASE (-1) pf = SQRT(21.0_dp/(32.0_dp*pi)) - dy(1) = pf*sp*(ct*(5.0_dp*ct-1.0_dp)-5.0_dp*st*st) + dy(1) = pf*sp*(ct*(5.0_dp*ct - 1.0_dp) - 5.0_dp*st*st) CASE (-2) pf = SQRT(105.0_dp/(16.0_dp*pi)) dy(1) = pf*2.0_dp*SIN(2._dp*p)*ct*st @@ -1122,17 +1122,17 @@ SUBROUTINE dry_lm(c, dy, l, m) END SELECT CASE DEFAULT IF (m < -l .OR. m > l) CPABORT("m value out of bounds") - lpm = fac(l+ABS(m)) - lmm = fac(l-ABS(m)) + lpm = fac(l + ABS(m)) + lmm = fac(l - ABS(m)) IF (m == 0) THEN tt = 4.0_dp*pi ELSE tt = 2.0_dp*pi END IF IF (ABS(lpm) < EPSILON(1.0_dp)) THEN - pf = REAL(2*l+1, KIND=dp)/tt + pf = REAL(2*l + 1, KIND=dp)/tt ELSE - pf = (REAL(2*l+1, KIND=dp)*lmm)/(tt*lpm) + pf = (REAL(2*l + 1, KIND=dp)*lmm)/(tt*lpm) ENDIF pf = SQRT(pf) z = ct @@ -1140,7 +1140,7 @@ SUBROUTINE dry_lm(c, dy, l, m) IF (m == 0) THEN y = pf*dplm ELSE - rxy = SQRT(r(1)**2+r(2)**2) + rxy = SQRT(r(1)**2 + r(2)**2) IF (rxy < EPSILON(1.0_dp)) THEN y = 0.0_dp ELSE @@ -1220,93 +1220,93 @@ FUNCTION legendre(x, l, m) RESULT(plm) CASE (0) plm = 1.0_dp CASE (1) - SELECT CASE (ABS (m)) + SELECT CASE (ABS(m)) CASE DEFAULT CPABORT("l = 1 and m value out of bounds") CASE (1) - plm = SQRT(1.0_dp-x*x) + plm = SQRT(1.0_dp - x*x) CASE (0) plm = x END SELECT CASE (2) - SELECT CASE (ABS (m)) + SELECT CASE (ABS(m)) CASE DEFAULT CPABORT("l = 2 and m value out of bounds") CASE (2) - plm = 3.0_dp*(1.0_dp-x*x) + plm = 3.0_dp*(1.0_dp - x*x) CASE (1) - plm = 3.0_dp*x*SQRT(1.0_dp-x*x) + plm = 3.0_dp*x*SQRT(1.0_dp - x*x) CASE (0) - plm = 1.5_dp*x*x-0.5_dp + plm = 1.5_dp*x*x - 0.5_dp END SELECT CASE (3) - SELECT CASE (ABS (m)) + SELECT CASE (ABS(m)) CASE DEFAULT CPABORT("l = 3 and m value out of bounds") CASE (3) - plm = 15.0_dp*(1.0_dp-x*x)**1.5_dp + plm = 15.0_dp*(1.0_dp - x*x)**1.5_dp CASE (2) - plm = 15.0_dp*x*(1.0_dp-x*x) + plm = 15.0_dp*x*(1.0_dp - x*x) CASE (1) - plm = (7.5_dp*x*x-1.5_dp)*SQRT(1.0_dp-x*x) + plm = (7.5_dp*x*x - 1.5_dp)*SQRT(1.0_dp - x*x) CASE (0) - plm = 2.5_dp*x**3-1.5_dp*x + plm = 2.5_dp*x**3 - 1.5_dp*x END SELECT CASE (4) - SELECT CASE (ABS (m)) + SELECT CASE (ABS(m)) CASE DEFAULT CPABORT("l = 4 and m value out of bounds") CASE (4) - plm = 105.0_dp*(1.0_dp-x*x)**2 + plm = 105.0_dp*(1.0_dp - x*x)**2 CASE (3) - plm = 105.0_dp*x*(1.0_dp-x*x)**1.5_dp + plm = 105.0_dp*x*(1.0_dp - x*x)**1.5_dp CASE (2) - plm = (52.5_dp*x*x-7.5_dp)*(1.0_dp-x*x) + plm = (52.5_dp*x*x - 7.5_dp)*(1.0_dp - x*x) CASE (1) - plm = (17.5_dp*x**3-7.5_dp*x)*SQRT(1.0_dp-x*x) + plm = (17.5_dp*x**3 - 7.5_dp*x)*SQRT(1.0_dp - x*x) CASE (0) - plm = 4.375_dp*x**4-3.75_dp*x**2+0.375_dp + plm = 4.375_dp*x**4 - 3.75_dp*x**2 + 0.375_dp END SELECT CASE (5) - SELECT CASE (ABS (m)) + SELECT CASE (ABS(m)) CASE DEFAULT CPABORT("l = 5 and m value out of bounds") CASE (5) - plm = 945.0_dp*(1.0_dp-x*x)**2.5_dp + plm = 945.0_dp*(1.0_dp - x*x)**2.5_dp CASE (4) - plm = 945.0_dp*x*(1.0_dp-x*x)**2 + plm = 945.0_dp*x*(1.0_dp - x*x)**2 CASE (3) - plm = -(-472.5_dp*x*x+52.5_dp)*(1.0_dp-x*x)**1.5_dp + plm = -(-472.5_dp*x*x + 52.5_dp)*(1.0_dp - x*x)**1.5_dp CASE (2) - plm = (157.5_dp*x**3-52.5_dp*x)*(1.0_dp-x*x) + plm = (157.5_dp*x**3 - 52.5_dp*x)*(1.0_dp - x*x) CASE (1) - plm = -(-39.375_dp*x**4+26.25_dp*x*x- & - 1.875_dp)*SQRT(1.0_dp-x*x) + plm = -(-39.375_dp*x**4 + 26.25_dp*x*x - & + 1.875_dp)*SQRT(1.0_dp - x*x) CASE (0) - plm = 7.875_dp*x**5-8.75_dp*x**3+1.875_dp*x + plm = 7.875_dp*x**5 - 8.75_dp*x**3 + 1.875_dp*x END SELECT CASE (6) - SELECT CASE (ABS (m)) + SELECT CASE (ABS(m)) CASE DEFAULT CPABORT("l = 6 and m value out of bounds") CASE (6) - plm = 10395.0_dp*(1.0_dp-x*x)**3 + plm = 10395.0_dp*(1.0_dp - x*x)**3 CASE (5) - plm = 10395.0_dp*x*(1.0_dp-x*x)**2.5_dp + plm = 10395.0_dp*x*(1.0_dp - x*x)**2.5_dp CASE (4) - plm = (5197.5_dp*x*x-472.5_dp)*(1.0_dp-x*x)**2 + plm = (5197.5_dp*x*x - 472.5_dp)*(1.0_dp - x*x)**2 CASE (3) - plm = -(-1732.5_dp*x**3+472.5_dp*x)* & - (1.0_dp-x*x)**1.5_dp + plm = -(-1732.5_dp*x**3 + 472.5_dp*x)* & + (1.0_dp - x*x)**1.5_dp CASE (2) - plm = (433.125_dp*x**4-236.25_dp*x**2+ & - 13.125_dp)*(1.0_dp-x*x) + plm = (433.125_dp*x**4 - 236.25_dp*x**2 + & + 13.125_dp)*(1.0_dp - x*x) CASE (1) - plm = -(-86.625_dp*x**5+78.75_dp*x**3- & - 13.125_dp*x)*SQRT(1.0_dp-x*x) + plm = -(-86.625_dp*x**5 + 78.75_dp*x**3 - & + 13.125_dp*x)*SQRT(1.0_dp - x*x) CASE (0) - plm = 14.4375_dp*x**6-19.6875_dp*x**4+ & - 6.5625_dp*x**2-0.3125_dp + plm = 14.4375_dp*x**6 - 19.6875_dp*x**4 + & + 6.5625_dp*x**2 - 0.3125_dp END SELECT CASE DEFAULT mm = ABS(m) @@ -1314,23 +1314,23 @@ FUNCTION legendre(x, l, m) RESULT(plm) ! use recurence from numerical recipies pmm = 1.0_dp IF (mm > 0) THEN - somx2 = SQRT((1.0_dp-x)*(1.0_dp+x)) + somx2 = SQRT((1.0_dp - x)*(1.0_dp + x)) fact = 1.0_dp DO im = 1, mm pmm = pmm*fact*somx2 - fact = fact+2.0_dp + fact = fact + 2.0_dp END DO END IF IF (l == mm) THEN plm = pmm ELSE - pmmp1 = x*REAL(2*mm+1, KIND=dp)*pmm - IF (l == mm+1) THEN + pmmp1 = x*REAL(2*mm + 1, KIND=dp)*pmm + IF (l == mm + 1) THEN plm = pmmp1 ELSE - DO il = mm+2, l - pll = (x*REAL(2*il-1, KIND=dp)*pmmp1- & - REAL(il+mm-1, KIND=dp)*pmm)/REAL(il-mm, KIND=dp) + DO il = mm + 2, l + pll = (x*REAL(2*il - 1, KIND=dp)*pmmp1 - & + REAL(il + mm - 1, KIND=dp)*pmm)/REAL(il - mm, KIND=dp) pmm = pmmp1 pmmp1 = pll END DO @@ -1362,108 +1362,108 @@ FUNCTION dlegendre(x, l, m) RESULT(dplm) CASE (0) dplm = 0.0_dp CASE (1) - SELECT CASE (ABS (m)) + SELECT CASE (ABS(m)) CASE DEFAULT CPABORT("l = 1 and m value out of bounds") CASE (1) - dplm = -x/SQRT(1.0_dp-x*x) + dplm = -x/SQRT(1.0_dp - x*x) CASE (0) dplm = 1.0_dp END SELECT CASE (2) - SELECT CASE (ABS (m)) + SELECT CASE (ABS(m)) CASE DEFAULT CPABORT("l = 2 and m value out of bounds") CASE (2) dplm = -6.0_dp*x CASE (1) - dplm = 3.0_dp*SQRT(1.0_dp-x*x)-3.0_dp*x*x/SQRT(1.0_dp-x*x) + dplm = 3.0_dp*SQRT(1.0_dp - x*x) - 3.0_dp*x*x/SQRT(1.0_dp - x*x) CASE (0) dplm = 3.0_dp*x END SELECT CASE (3) - SELECT CASE (ABS (m)) + SELECT CASE (ABS(m)) CASE DEFAULT CPABORT("l = 3 and m value out of bounds") CASE (3) - dplm = -45.0_dp*SQRT(1.0_dp-x*x)*x + dplm = -45.0_dp*SQRT(1.0_dp - x*x)*x CASE (2) - dplm = 15.0_dp*(1.0_dp-x*x)-30.0_dp*x*x + dplm = 15.0_dp*(1.0_dp - x*x) - 30.0_dp*x*x CASE (1) - dplm = 15.0_dp*x*SQRT(1.0_dp-x*x)-(x*(7.5_dp*x*x-1.5_dp))/SQRT(1.0_dp-x*x) + dplm = 15.0_dp*x*SQRT(1.0_dp - x*x) - (x*(7.5_dp*x*x - 1.5_dp))/SQRT(1.0_dp - x*x) CASE (0) - dplm = 7.5_dp*x*x-1.5_dp + dplm = 7.5_dp*x*x - 1.5_dp END SELECT CASE (4) - SELECT CASE (ABS (m)) + SELECT CASE (ABS(m)) CASE DEFAULT CPABORT("l = 4 and m value out of bounds") CASE (4) - dplm = -420*x*(1-x*x) + dplm = -420*x*(1 - x*x) CASE (3) - dplm = 105.0_dp*((1.0_dp-x*x)**1.5_dp-3.0_dp*x*x*(1.0_dp-x*x)**0.5_dp) + dplm = 105.0_dp*((1.0_dp - x*x)**1.5_dp - 3.0_dp*x*x*(1.0_dp - x*x)**0.5_dp) CASE (2) - dplm = 105.0_dp*x*(1.0_dp-x*x)-2.0_dp*x*(52.5_dp*x*x-7.5_dp) + dplm = 105.0_dp*x*(1.0_dp - x*x) - 2.0_dp*x*(52.5_dp*x*x - 7.5_dp) CASE (1) - IF (ABS(x)-1.0_dp < EPSILON(1.0_dp)) THEN + IF (ABS(x) - 1.0_dp < EPSILON(1.0_dp)) THEN dplm = 0.0_dp ELSE - dplm = (17.5_dp*3.0_dp*x**2-7.5_dp)*SQRT(1.0_dp-x*x)- & - x*(17.5_dp*x**3-7.5_dp*x)/SQRT(1.0_dp-x*x) + dplm = (17.5_dp*3.0_dp*x**2 - 7.5_dp)*SQRT(1.0_dp - x*x) - & + x*(17.5_dp*x**3 - 7.5_dp*x)/SQRT(1.0_dp - x*x) END IF CASE (0) - dplm = 4.375_dp*4.0_dp*x**3-3.75_dp*2.0_dp*x + dplm = 4.375_dp*4.0_dp*x**3 - 3.75_dp*2.0_dp*x END SELECT CASE (5) - SELECT CASE (ABS (m)) + SELECT CASE (ABS(m)) CASE DEFAULT CPABORT("l = 5 and m value out of bounds") CASE (5) - dplm = -945.0_dp*5.0_dp*x*(1.0_dp-x*x)**1.5_dp + dplm = -945.0_dp*5.0_dp*x*(1.0_dp - x*x)**1.5_dp CASE (4) - dplm = 945.0_dp*((1.0_dp-x*x)**2-2.0_dp*x*x*(1.0_dp-x*x)) + dplm = 945.0_dp*((1.0_dp - x*x)**2 - 2.0_dp*x*x*(1.0_dp - x*x)) CASE (3) - dplm = 945.0_dp*x*(1.0_dp-x*x)**1.5_dp- & - 3.0_dp*x*(472.5_dp*x*x-52.5_dp)*(1.0_dp-x*x)**0.5_dp + dplm = 945.0_dp*x*(1.0_dp - x*x)**1.5_dp - & + 3.0_dp*x*(472.5_dp*x*x - 52.5_dp)*(1.0_dp - x*x)**0.5_dp CASE (2) - dplm = (3.0_dp*157.5_dp*x**2-52.5_dp)*(1.0_dp-x*x)- & - (157.5_dp*x**3-52.5_dp*x)*(-2.0_dp*x) + dplm = (3.0_dp*157.5_dp*x**2 - 52.5_dp)*(1.0_dp - x*x) - & + (157.5_dp*x**3 - 52.5_dp*x)*(-2.0_dp*x) CASE (1) - IF (ABS(x)-1.0_dp < EPSILON(1.0_dp)) THEN + IF (ABS(x) - 1.0_dp < EPSILON(1.0_dp)) THEN dplm = 0.0_dp ELSE - dplm = -(-39.375_dp*4.0_dp*x*x*x+2.0_dp*26.25_dp*x)*SQRT(1.0_dp-x*x)+ & - x*(-39.375_dp*x**4+26.25_dp*x*x-1.875_dp)/SQRT(1.0_dp-x*x) + dplm = -(-39.375_dp*4.0_dp*x*x*x + 2.0_dp*26.25_dp*x)*SQRT(1.0_dp - x*x) + & + x*(-39.375_dp*x**4 + 26.25_dp*x*x - 1.875_dp)/SQRT(1.0_dp - x*x) END IF CASE (0) - dplm = 5.0_dp*7.875_dp*x**4-3.0_dp*8.75_dp*x**2+1.875_dp + dplm = 5.0_dp*7.875_dp*x**4 - 3.0_dp*8.75_dp*x**2 + 1.875_dp END SELECT CASE (6) - SELECT CASE (ABS (m)) + SELECT CASE (ABS(m)) CASE DEFAULT CPABORT("l = 6 and m value out of bounds") CASE (6) - dplm = -10395.0_dp*6.0_dp*x*(1.0_dp-x*x)**2 + dplm = -10395.0_dp*6.0_dp*x*(1.0_dp - x*x)**2 CASE (5) - dplm = 10395.0_dp*((1.0_dp-x*x)**2.5_dp-5.0_dp*x*x*(1.0_dp-x*x)**1.5_dp) + dplm = 10395.0_dp*((1.0_dp - x*x)**2.5_dp - 5.0_dp*x*x*(1.0_dp - x*x)**1.5_dp) CASE (4) - dplm = 2.0_dp*5197.5_dp*x*(1.0_dp-x*x)**2- & - 4.0_dp*x*(5197.5_dp*x*x-472.5_dp)*(1.0_dp-x*x) + dplm = 2.0_dp*5197.5_dp*x*(1.0_dp - x*x)**2 - & + 4.0_dp*x*(5197.5_dp*x*x - 472.5_dp)*(1.0_dp - x*x) CASE (3) - dplm = -(-3.0_dp*1732.5_dp*x*x+472.5_dp)*(1.0_dp-x*x)**1.5_dp+ & - (-1732.5_dp*x**3+472.5_dp*x)*3.0_dp*x*(1.0_dp-x*x)**0.5_dp + dplm = -(-3.0_dp*1732.5_dp*x*x + 472.5_dp)*(1.0_dp - x*x)**1.5_dp + & + (-1732.5_dp*x**3 + 472.5_dp*x)*3.0_dp*x*(1.0_dp - x*x)**0.5_dp CASE (2) - dplm = (433.125_dp*4.0_dp*x**3-2.0_dp*236.25_dp*x)*(1.0_dp-x*x)- & - 2.0_dp*x*(433.125_dp*x**4-236.25_dp*x**2+13.125_dp) + dplm = (433.125_dp*4.0_dp*x**3 - 2.0_dp*236.25_dp*x)*(1.0_dp - x*x) - & + 2.0_dp*x*(433.125_dp*x**4 - 236.25_dp*x**2 + 13.125_dp) CASE (1) - IF (ABS(x)-1.0_dp < EPSILON(1.0_dp)) THEN + IF (ABS(x) - 1.0_dp < EPSILON(1.0_dp)) THEN dplm = 0.0_dp ELSE - dplm = -(-5.0_dp*86.625_dp*x**4+3.0_dp*78.75_dp**2-13.125_dp)*SQRT(1.0_dp-x*x)+ & - x*(-86.625_dp*x**5+78.75_dp*x**3-13.125_dp*x)/SQRT(1.0_dp-x*x) + dplm = -(-5.0_dp*86.625_dp*x**4 + 3.0_dp*78.75_dp**2 - 13.125_dp)*SQRT(1.0_dp - x*x) + & + x*(-86.625_dp*x**5 + 78.75_dp*x**3 - 13.125_dp*x)/SQRT(1.0_dp - x*x) END IF CASE (0) - dplm = 14.4375_dp*6.0_dp*x**5-19.6875_dp*4.0_dp*x**3+ & + dplm = 14.4375_dp*6.0_dp*x**5 - 19.6875_dp*4.0_dp*x**3 + & 6.5625_dp*2.0_dp*x END SELECT CASE DEFAULT @@ -1471,11 +1471,11 @@ FUNCTION dlegendre(x, l, m) RESULT(dplm) IF (mm > l) CPABORT("m out of bounds") !From Wikipedia: dPlm(x) = -(l+1)x/(x^2-1)*Plm(x) + (l-m+1)/(x^2-1)Pl+1m(x) - IF (ABS(x)-1.0_dp < EPSILON(1.0_dp)) THEN + IF (ABS(x) - 1.0_dp < EPSILON(1.0_dp)) THEN dplm = 0.0_dp ELSE - dplm = -REAL(l+1, dp)*x/(x**2-1.0_dp)*legendre(x, l, m) & - +REAL(l-m+1, dp)/(x**2-1.0_dp)*legendre(x, l+1, m) + dplm = -REAL(l + 1, dp)*x/(x**2 - 1.0_dp)*legendre(x, l, m) & + + REAL(l - m + 1, dp)/(x**2 - 1.0_dp)*legendre(x, l + 1, m) END IF END SELECT @@ -1495,7 +1495,7 @@ FUNCTION dPof1(x, l) CHARACTER(len=*), PARAMETER :: routineN = 'dPof1', routineP = moduleN//':'//routineN - IF (ABS(x)-1.0_dp > EPSILON(1.0_dp)) THEN + IF (ABS(x) - 1.0_dp > EPSILON(1.0_dp)) THEN CPABORT("|x| is not 1") END IF IF (x > 0.0_dp) THEN @@ -1556,7 +1556,7 @@ FUNCTION choose(n, k) REAL(KIND=dp) :: choose IF (n >= k) THEN - choose = REAL(NINT(fac(n)/(fac(k)*fac(n-k))), KIND=dp) + choose = REAL(NINT(fac(n)/(fac(k)*fac(n - k))), KIND=dp) ELSE choose = 0.0_dp ENDIF @@ -1590,20 +1590,20 @@ FUNCTION cosn(n, c, s) IF (i == 0) THEN j = n IF (j == 0) THEN - cosn = cosn+choose(n, j) + cosn = cosn + choose(n, j) ELSE IF (MOD(j/2, 2) == 0) THEN - cosn = cosn+choose(n, j)*s**j + cosn = cosn + choose(n, j)*s**j ELSE - cosn = cosn-choose(n, j)*s**j + cosn = cosn - choose(n, j)*s**j END IF ELSE - j = n-i + j = n - i IF (j == 0) THEN - cosn = cosn+choose(n, j)*c**i + cosn = cosn + choose(n, j)*c**i ELSE IF (MOD(j/2, 2) == 0) THEN - cosn = cosn+choose(n, j)*c**i*s**j + cosn = cosn + choose(n, j)*c**i*s**j ELSE - cosn = cosn-choose(n, j)*c**i*s**j + cosn = cosn - choose(n, j)*c**i*s**j END IF END IF END DO @@ -1635,11 +1635,11 @@ FUNCTION dcosn_dcp(n, c, s) IF (i == 0) THEN dcosn_dcp = dcosn_dcp ELSE - j = n-i + j = n - i IF (MOD(j/2, 2) == 0) THEN - dcosn_dcp = dcosn_dcp+choose(n, j)*REAL(i, dp)*c**(i-1)*s**j + dcosn_dcp = dcosn_dcp + choose(n, j)*REAL(i, dp)*c**(i - 1)*s**j ELSE - dcosn_dcp = dcosn_dcp-choose(n, j)*REAL(i, dp)*c**(i-1)*s**j + dcosn_dcp = dcosn_dcp - choose(n, j)*REAL(i, dp)*c**(i - 1)*s**j END IF END IF END DO @@ -1667,14 +1667,14 @@ FUNCTION dcosn_dsp(n, c, s) dcosn_dsp = 0.0_dp ELSE DO i = n, 0, -2 - j = n-i + j = n - i IF (j == 0) THEN dcosn_dsp = dcosn_dsp ELSE IF (MOD(j/2, 2) == 0) THEN - dcosn_dsp = dcosn_dsp+choose(n, j)*REAL(j, dp)*s**(j-1)*c**i + dcosn_dsp = dcosn_dsp + choose(n, j)*REAL(j, dp)*s**(j - 1)*c**i ELSE - dcosn_dsp = dcosn_dsp-choose(n, j)*REAL(j, dp)*s**(j-1)*c**i + dcosn_dsp = dcosn_dsp - choose(n, j)*REAL(j, dp)*s**(j - 1)*c**i END IF END IF END DO @@ -1705,23 +1705,23 @@ FUNCTION sinn(n, c, s) IF (MOD(n, 2) == 0) THEN sinn = 0.0_dp ELSE - sinn = s*(-1.0_dp)**INT((n-1)/2) + sinn = s*(-1.0_dp)**INT((n - 1)/2) END IF ELSE - DO i = n-1, 0, -2 + DO i = n - 1, 0, -2 IF (i == 0) THEN j = n IF (MOD(j/2, 2) == 0) THEN - sinn = sinn+choose(n, j)*s**j + sinn = sinn + choose(n, j)*s**j ELSE - sinn = sinn-choose(n, j)*s**j + sinn = sinn - choose(n, j)*s**j END IF ELSE - j = n-i + j = n - i IF (MOD(j/2, 2) == 0) THEN - sinn = sinn+choose(n, j)*c**i*s**j + sinn = sinn + choose(n, j)*c**i*s**j ELSE - sinn = sinn-choose(n, j)*c**i*s**j + sinn = sinn - choose(n, j)*c**i*s**j END IF END IF END DO @@ -1749,15 +1749,15 @@ FUNCTION dsinn_dcp(n, c, s) IF (c < EPSILON(1.0_dp) .OR. s < EPSILON(1.0_dp)) THEN dsinn_dcp = 0.0_dp ELSE - DO i = n-1, 0, -2 + DO i = n - 1, 0, -2 IF (i == 0) THEN dsinn_dcp = dsinn_dcp ELSE - j = n-i + j = n - i IF (MOD(j/2, 2) == 0) THEN - dsinn_dcp = dsinn_dcp+choose(n, j)*REAL(i, dp)*c**(i-1)*s**j + dsinn_dcp = dsinn_dcp + choose(n, j)*REAL(i, dp)*c**(i - 1)*s**j ELSE - dsinn_dcp = dsinn_dcp-choose(n, j)*REAL(i, dp)*c**(i-1)*s**j + dsinn_dcp = dsinn_dcp - choose(n, j)*REAL(i, dp)*c**(i - 1)*s**j END IF END IF END DO @@ -1785,15 +1785,15 @@ FUNCTION dsinn_dsp(n, c, s) IF (c < EPSILON(1.0_dp) .OR. s < EPSILON(1.0_dp)) THEN dsinn_dsp = 0.0_dp ELSE - DO i = n-1, 0, -2 - j = n-i + DO i = n - 1, 0, -2 + j = n - i IF (j == 0) THEN dsinn_dsp = dsinn_dsp ELSE IF (MOD(j/2, 2) == 0) THEN - dsinn_dsp = dsinn_dsp+choose(n, j)*c**i*REAL(j, dp)*s**(j-1) + dsinn_dsp = dsinn_dsp + choose(n, j)*c**i*REAL(j, dp)*s**(j - 1) ELSE - dsinn_dsp = dsinn_dsp-choose(n, j)*c**i*REAL(j, dp)*s**(j-1) + dsinn_dsp = dsinn_dsp - choose(n, j)*c**i*REAL(j, dp)*s**(j - 1) END IF END IF END DO diff --git a/src/common/splines.F b/src/common/splines.F index b22557ee14..f6cbfccba4 100644 --- a/src/common/splines.F +++ b/src/common/splines.F @@ -55,7 +55,7 @@ FUNCTION spline3(x, y, xnew) RESULT(ynew) REAL(dp) :: ynew(SIZE(xnew)) INTEGER :: i, ip - REAL(dp) :: c(0:4, SIZE(x)-1) + REAL(dp) :: c(0:4, SIZE(x) - 1) ! get spline parameters: 2nd derivs at ends determined by cubic interpolation CALL spline3pars(x, y, [2, 2], [0._dp, 0._dp], c) @@ -82,7 +82,7 @@ SUBROUTINE spline3ders(x, y, xnew, ynew, dynew, d2ynew) REAL(dp), INTENT(out), OPTIONAL :: ynew(:), dynew(:), d2ynew(:) INTEGER :: i, ip - REAL(dp) :: c(0:4, SIZE(x)-1) + REAL(dp) :: c(0:4, SIZE(x) - 1) CALL spline3pars(x, y, [2, 2], [0._dp, 0._dp], c) @@ -145,7 +145,7 @@ SUBROUTINE spline3pars(xi, yi, bctype, bcval, c) IF (bctype(1) < 1 .OR. bctype(1) > 2) CALL stop_error("spline3pars error: bctype /= 1 or 2.") IF (bctype(2) < 1 .OR. bctype(2) > 2) CALL stop_error("spline3pars error: bctype /= 1 or 2.") IF (SIZE(c, 1) /= 5) CALL stop_error("spline3pars error: size(c,1) /= 5.") - IF (SIZE(c, 2) /= SIZE(xi)-1) CALL stop_error("spline3pars error: size(c,2) /= size(xi)-1.") + IF (SIZE(c, 2) /= SIZE(xi) - 1) CALL stop_error("spline3pars error: size(c,2) /= size(xi)-1.") IF (SIZE(xi) /= SIZE(yi)) CALL stop_error("spline3pars error: size(xi) /= size(yi)") ! To get rid of compiler warnings: @@ -154,8 +154,8 @@ SUBROUTINE spline3pars(xi, yi, bctype, bcval, c) ! initializations n = SIZE(xi) - DO i = 1, n-1 - hi(i) = xi(i+1)-xi(i) + DO i = 1, n - 1 + hi(i) = xi(i + 1) - xi(i) END DO ! compute interpolating-cubic 2nd derivs at ends, if required @@ -167,7 +167,7 @@ SUBROUTINE spline3pars(xi, yi, bctype, bcval, c) x0 = xe(1) ! center at end DO i = 1, 4 DO j = 1, 4 - Ae(i, j) = (xe(i)-x0)**(j-1) + Ae(i, j) = (xe(i) - x0)**(j - 1) END DO END DO Ae(:, 1) = 1 ! set 0^0 = 1 @@ -180,12 +180,12 @@ SUBROUTINE spline3pars(xi, yi, bctype, bcval, c) ! right end IF (bctype(2) == 2) THEN IF (n < 4) CALL stop_error("spline3pars error: n < 4") - xe = xi(n-3:n) - ye = yi(n-3:n) + xe = xi(n - 3:n) + ye = yi(n - 3:n) x0 = xe(4) ! center at end DO i = 1, 4 DO j = 1, 4 - Ae(i, j) = (xe(i)-x0)**(j-1) + Ae(i, j) = (xe(i) - x0)**(j - 1) END DO END DO Ae(:, 1) = 1 ! set 0^0 = 1 @@ -209,40 +209,40 @@ SUBROUTINE spline3pars(xi, yi, bctype, bcval, c) As(4, 1) = 6/hi(1)**2 bs(1) = d2p1 ! internal knot conditions - DO i = 2, n-1 - i2 = 2*(i-1) - As(5, i2-1) = 1/hi(i-1) - As(4, i2) = 2/hi(i-1) - As(3, i2+1) = 2/hi(i) - As(2, i2+2) = 1/hi(i) - As(5, i2) = 1/hi(i-1)**2 - As(4, i2+1) = -1/hi(i)**2 - bs(i2) = (yi(i+1)-yi(i))/hi(i)-(yi(i)-yi(i-1))/hi(i-1) - bs(i2+1) = 0 + DO i = 2, n - 1 + i2 = 2*(i - 1) + As(5, i2 - 1) = 1/hi(i - 1) + As(4, i2) = 2/hi(i - 1) + As(3, i2 + 1) = 2/hi(i) + As(2, i2 + 2) = 1/hi(i) + As(5, i2) = 1/hi(i - 1)**2 + As(4, i2 + 1) = -1/hi(i)**2 + bs(i2) = (yi(i + 1) - yi(i))/hi(i) - (yi(i) - yi(i - 1))/hi(i - 1) + bs(i2 + 1) = 0 END DO ! right end condition - As(4, 2*(n-1)) = 6/hi(n-1)**2 - bs(2*(n-1)) = d2pn + As(4, 2*(n - 1)) = 6/hi(n - 1)**2 + bs(2*(n - 1)) = d2pn ! solve spline equations -- LAPACK band form bmat(:, 1) = bs - CALL lapack_sgbsv(2*(n-1), 1, 2, 1, As, 5, ipiv2, bmat, 2*(n-1), info) + CALL lapack_sgbsv(2*(n - 1), 1, 2, 1, As, 5, ipiv2, bmat, 2*(n - 1), info) IF (info /= 0) CALL stop_error("spline3pars error: dgbsv error.") cs = bmat(:, 1) ! transform to (x-x0)^(i-1) basis and return - DO i = 1, n-1 + DO i = 1, n - 1 ! coefficients in spline basis: c1 = yi(i) - c2 = yi(i+1) - c3 = cs(2*i-1) + c2 = yi(i + 1) + c3 = cs(2*i - 1) c4 = cs(2*i) ! coefficients in (x-x0)^(i-1) basis c(0, i) = xi(i) c(1, i) = c1 - c(2, i) = -(c1-c2+2*c3+c4)/hi(i) + c(2, i) = -(c1 - c2 + 2*c3 + c4)/hi(i) c(3, i) = 3*c3/hi(i)**2 - c(4, i) = (-c3+c4)/hi(i)**3 + c(4, i) = (-c3 + c4)/hi(i)**3 END DO END SUBROUTINE @@ -276,7 +276,7 @@ SUBROUTINE spline3valder(x, xi, c, val, der) ! initialize, check input parameters n = SIZE(xi) IF (SIZE(c, 1) /= 5) CALL stop_error("spline3 error: size(c,1) /= 5.") - IF (SIZE(c, 2) /= SIZE(xi)-1) CALL stop_error("spline3 error: size(c,2) /= size(xi)-1.") + IF (SIZE(c, 2) /= SIZE(xi) - 1) CALL stop_error("spline3 error: size(c,2) /= size(xi)-1.") ! find interval containing x i1 = iix(x, xi) ! return value and derivative @@ -325,13 +325,13 @@ INTEGER FUNCTION iix(x, xi) RESULT(i1) ELSEIF (x <= xi(3)) THEN ! second element i1 = 2 ELSEIF (x >= xi(n)) THEN ! right end - i1 = n-1 + i1 = n - 1 ELSE ! bisection: xi(i1) <= x < xi(i2) i1 = 3; i2 = n DO - IF (i2-i1 == 1) EXIT - ic = i1+(i2-i1)/2 + IF (i2 - i1 == 1) EXIT + ic = i1 + (i2 - i1)/2 IF (x >= xi(ic)) THEN i1 = ic ELSE @@ -353,8 +353,8 @@ INTEGER FUNCTION iixmin(x, xi, i_min) RESULT(ip) REAL(dp), INTENT(in) :: x, xi(:) INTEGER, INTENT(in) :: i_min - IF (i_min >= 1 .AND. i_min <= SIZE(xi)-1) THEN - ip = iix(x, xi(i_min:))+i_min-1 + IF (i_min >= 1 .AND. i_min <= SIZE(xi) - 1) THEN + ip = iix(x, xi(i_min:)) + i_min - 1 ELSE ip = iix(x, xi) END IF @@ -389,10 +389,10 @@ FUNCTION iixun(x, n, x1, xn) ! final point of mesh ! compute index - i = INT((x-x1)/(xn-x1)*(n-1))+1 + i = INT((x - x1)/(xn - x1)*(n - 1)) + 1 ! reset if ouside 1..n IF (i < 1) i = 1 - IF (i > n-1) i = n-1 + IF (i > n - 1) i = n - 1 iixun = i END FUNCTION @@ -432,10 +432,10 @@ FUNCTION iixexp(x, n, x1, alpha, beta) ! mesh parameter ! compute index - i = INT(LOG((x-x1)/alpha+1)/beta)+1 + i = INT(LOG((x - x1)/alpha + 1)/beta) + 1 ! reset if outside 1..n IF (i < 1) i = 1 - IF (i > n-1) i = n-1 + IF (i > n - 1) i = n - 1 iixexp = i END FUNCTION @@ -457,8 +457,8 @@ FUNCTION poly3(x, c) ! point at which to evaluate polynomial ! coefficients: poly = \sum_{i=1}^4 c(i) (x-c(0))^(i-1) - dx = x-c(0) - poly3 = c(1)+c(2)*dx+c(3)*dx**2+c(4)*dx**3 + dx = x - c(0) + poly3 = c(1) + c(2)*dx + c(3)*dx**2 + c(4)*dx**3 END FUNCTION !--------------------------------------------------------------------------------------------------! @@ -479,8 +479,8 @@ FUNCTION dpoly3(x, c) ! point at which to evaluate polynomial ! coefficients: poly = \sum_{i=1}^4 c(i) (x-c(0))^(i-1) - dx = x-c(0) - dpoly3 = c(2)+2*c(3)*dx+3*c(4)*dx**2 + dx = x - c(0) + dpoly3 = c(2) + 2*c(3)*dx + 3*c(4)*dx**2 END FUNCTION !--------------------------------------------------------------------------------------------------! @@ -501,8 +501,8 @@ FUNCTION d2poly3(x, c) ! point at which to evaluate polynomial ! coefficients: poly = \sum_{i=1}^4 c(i) (x-c(0))^(i-1) - dx = x-c(0) - d2poly3 = 2*c(3)+6*c(4)*dx + dx = x - c(0) + d2poly3 = 2*c(3) + 6*c(4)*dx END FUNCTION !--------------------------------------------------------------------------------------------------! diff --git a/src/common/string_table.F b/src/common/string_table.F index 0d1a9dea09..9905c4c70d 100644 --- a/src/common/string_table.F +++ b/src/common/string_table.F @@ -73,7 +73,7 @@ FUNCTION str2id(str) RESULT(id) INTEGER :: index, ipos TYPE(hash_element_type), POINTER :: this - inserted_strings = inserted_strings+1 + inserted_strings = inserted_strings + 1 ! index is the index in the array, ipos is the Nth element of the linked list index = joaat_hash(str) ipos = 0 @@ -83,7 +83,7 @@ FUNCTION str2id(str) RESULT(id) ! str was not in the linked list, add it now ALLOCATE (this%str) this%str = str - actual_strings = actual_strings+1 + actual_strings = actual_strings + 1 EXIT ELSE IF (this%str == str) THEN @@ -91,7 +91,7 @@ FUNCTION str2id(str) RESULT(id) EXIT ELSE IF (.NOT. ASSOCIATED(this%next)) ALLOCATE (this%next) - ipos = ipos+1 + ipos = ipos + 1 this => this%next ENDIF ENDIF @@ -116,7 +116,7 @@ FUNCTION id2str(id) RESULT(str) INTEGER :: i, index, ipos TYPE(hash_element_type), POINTER :: this - index = IAND(id, 2**Nbit-1) + index = IAND(id, 2**Nbit - 1) ipos = ISHFT(id, -Nbit) this => hash_table(index) DO i = 1, ipos @@ -151,7 +151,7 @@ END FUNCTION s2s !> of other procedures of this module. The scope of this table is global ! ************************************************************************************************** SUBROUTINE string_table_allocate() - ALLOCATE (hash_table(0:hash_table_size-1)) + ALLOCATE (hash_table(0:hash_table_size - 1)) actual_strings = 0 inserted_strings = 0 END SUBROUTINE string_table_allocate @@ -174,15 +174,15 @@ SUBROUTINE string_table_deallocate(iw) ipos_max = 0 ilist = 0 - DO i = 0, hash_table_size-1 + DO i = 0, hash_table_size - 1 ipos = 1 IF (ASSOCIATED(hash_table(i)%str)) THEN DEALLOCATE (hash_table(i)%str) - ilist = ilist+1 + ilist = ilist + 1 ENDIF this => hash_table(i)%next DO WHILE (ASSOCIATED(this)) - ipos = ipos+1 + ipos = ipos + 1 next => this%next IF (ASSOCIATED(this%str)) DEALLOCATE (this%str) DEALLOCATE (this) @@ -218,20 +218,20 @@ FUNCTION joaat_hash(key) RESULT(hash_index) CHARACTER(LEN=*), INTENT(IN) :: key INTEGER :: hash_index - INTEGER(KIND=int_8), PARAMETER :: b32 = 2_int_8**32-1_int_8 + INTEGER(KIND=int_8), PARAMETER :: b32 = 2_int_8**32 - 1_int_8 INTEGER :: i INTEGER(KIND=int_8) :: hash hash = 0_int_8 DO i = 1, LEN(key) - hash = IAND(hash+ICHAR(key(i:i)), b32) - hash = IAND(hash+IAND(ISHFT(hash, 10), b32), b32) + hash = IAND(hash + ICHAR(key(i:i)), b32) + hash = IAND(hash + IAND(ISHFT(hash, 10), b32), b32) hash = IAND(IEOR(hash, IAND(ISHFT(hash, -6), b32)), b32) ENDDO - hash = IAND(hash+IAND(ISHFT(hash, 3), b32), b32) + hash = IAND(hash + IAND(ISHFT(hash, 3), b32), b32) hash = IAND(IEOR(hash, IAND(ISHFT(hash, -11), b32)), b32) - hash = IAND(hash+IAND(ISHFT(hash, 15), b32), b32) + hash = IAND(hash + IAND(ISHFT(hash, 15), b32), b32) ! hash is the real 32bit hash value of the string, ! hash_index is an index in the hash_table hash_index = INT(MOD(hash, INT(hash_table_size, KIND=int_8))) diff --git a/src/common/string_utilities.F b/src/common/string_utilities.F index c905f4aa4f..7b8e0ef450 100644 --- a/src/common/string_utilities.F +++ b/src/common/string_utilities.F @@ -126,7 +126,7 @@ FUNCTION typo_match(string, typo_string) RESULT(match) tmp(i:i) = kind tmp(j:j) = kind IF (i == j .AND. LEN_TRIM(tmp) > 2) tmp(i:i) = star - IF (pattern_match(string=string, pattern=tmp)) match = match+1 + IF (pattern_match(string=string, pattern=tmp)) match = match + 1 ENDDO ENDDO IF (LEN_TRIM(string) .LE. 4) THEN @@ -140,12 +140,12 @@ FUNCTION typo_match(string, typo_string) RESULT(match) tmp2(i:i) = kind tmp2(j:j) = kind IF (i == j .AND. LEN_TRIM(tmp2) > 2) tmp2(i:i) = star - IF (pattern_match(string=typo_string, pattern=tmp2)) match = match+1 + IF (pattern_match(string=typo_string, pattern=tmp2)) match = match + 1 ENDDO ENDDO IF (match > 0) THEN ! bonus points for small differences in length - IF (ABS(LEN_TRIM(string)-LEN_TRIM(typo_string)) < 3) match = match+2 + IF (ABS(LEN_TRIM(string) - LEN_TRIM(typo_string)) < 3) match = match + 2 ENDIF END FUNCTION typo_match @@ -1632,13 +1632,13 @@ SUBROUTINE compress(string, full) IF (string(i:i) /= " ") THEN tmp = string(i:i) string(z:z) = tmp - z = z+1 + z = z + 1 END IF ELSE - IF ((string(i:i) /= " ") .OR. (string(z-1:z-1) /= " ")) THEN + IF ((string(i:i) /= " ") .OR. (string(z - 1:z - 1) /= " ")) THEN tmp = string(i:i) string(z:z) = tmp - z = z+1 + z = z + 1 END IF END IF END DO @@ -1702,11 +1702,11 @@ SUBROUTINE remove_word(string) i = 1 ! possibly clean white spaces DO WHILE (string(i:i) == " ") - i = i+1 + i = i + 1 END DO ! now remove the word DO WHILE (string(i:i) /= " ") - i = i+1 + i = i + 1 END DO string = string(i:) @@ -1746,17 +1746,17 @@ FUNCTION substitute_special_xml_tokens(inp_string, ltu) RESULT(out_string) i = 0 j = 1 string_loop: DO - i = i+1 + i = i + 1 IF (i > LEN_TRIM(string)) EXIT string_loop IF (string(i:i) == "<") THEN ! Detect valid HTML tags and keep them ientry = 0 ilen = INDEX(string(i:), ">") - IF ((ilen > 2) .AND. (ilen <= maxlen_tag_name+3)) THEN - IF (string(i+1:i+1) == "/") THEN - tag_name(1:) = string(i+2:i+ilen-2) + IF ((ilen > 2) .AND. (ilen <= maxlen_tag_name + 3)) THEN + IF (string(i + 1:i + 1) == "/") THEN + tag_name(1:) = string(i + 2:i + ilen - 2) ELSE - tag_name(1:) = string(i+1:i+ilen-2) + tag_name(1:) = string(i + 1:i + ilen - 2) END IF CALL lowercase(tag_name) tag_loop: DO k = 1, SIZE(html_tag_table) @@ -1766,49 +1766,49 @@ FUNCTION substitute_special_xml_tokens(inp_string, ltu) RESULT(out_string) END IF END DO tag_loop IF (ientry > 0) THEN ! HTML tag found in table - IF (string(i+1:i+1) == "/") THEN - out_string(j:j+ilen+7) = "</"//TRIM(tag_name)//">" + IF (string(i + 1:i + 1) == "/") THEN + out_string(j:j + ilen + 7) = "</"//TRIM(tag_name)//">" ELSE - out_string(j:j+ilen+7) = "<"//TRIM(tag_name)//">" + out_string(j:j + ilen + 7) = "<"//TRIM(tag_name)//">" END IF - i = i+ilen-1 - j = j+ilen+8 + i = i + ilen - 1 + j = j + ilen + 8 END IF END IF ! HTML tag not found in table IF (ientry == 0) THEN - out_string(j:j+4) = "<" - j = j+5 + out_string(j:j + 4) = "<" + j = j + 5 END IF ELSE IF (string(i:i) == ">") THEN - out_string(j:j+4) = ">" - j = j+5 + out_string(j:j + 4) = ">" + j = j + 5 ELSE IF (string(i:i) == "&") THEN ! Substitute HTML entity names by the corresponding entity number ientry = 0 ilen = INDEX(string(i:), ";") IF ((ilen > 2) .AND. (ilen <= maxlen_entity_name)) THEN - entity_name(1:) = string(i:i+ilen-1) + entity_name(1:) = string(i:i + ilen - 1) entity_loop: DO k = 1, SIZE(html_entity_table), 2 IF (entity_name == html_entity_table(k)) THEN - ientry = k+1 + ientry = k + 1 EXIT entity_loop END IF END DO entity_loop - i = i+ilen-1 + i = i + ilen - 1 IF (ientry > 0) THEN ! HTML entity found in table ilen = LEN_TRIM(html_entity_table(ientry)) - out_string(j:j+ilen-1) = TRIM(ADJUSTL(html_entity_table(ientry))) - j = j+ilen + out_string(j:j + ilen - 1) = TRIM(ADJUSTL(html_entity_table(ientry))) + j = j + ilen END IF END IF IF (ientry == 0) THEN - out_string(j:j+4) = "&" - j = j+5 + out_string(j:j + 4) = "&" + j = j + 5 END IF ELSE out_string(j:j) = string(i:i) - j = j+1 + j = j + 1 END IF END DO string_loop @@ -1839,7 +1839,7 @@ SUBROUTINE write_html_tables(output_unit) WRITE (UNIT=output_unit, FMT="(T3,A)") & "", & " &"//TRIM(html_entity_table(i) (2:))//"", & - " &"//TRIM(html_entity_table(i+1) (2:))//"", & + " &"//TRIM(html_entity_table(i + 1) (2:))//"", & "" END DO @@ -1862,7 +1862,7 @@ SUBROUTINE lowercase(string) DO i = 1, LEN_TRIM(string) iascii = ICHAR(string(i:i)) IF ((iascii >= 65) .AND. (iascii <= 90)) THEN - string(i:i) = CHAR(iascii+32) + string(i:i) = CHAR(iascii + 32) END IF END DO @@ -1883,7 +1883,7 @@ SUBROUTINE uppercase(string) DO i = 1, LEN_TRIM(string) iascii = ICHAR(string(i:i)) IF ((iascii >= 97) .AND. (iascii <= 122)) THEN - string(i:i) = CHAR(iascii-32) + string(i:i) = CHAR(iascii - 32) END IF END DO @@ -1905,7 +1905,7 @@ SUBROUTINE xstring(string, ia, ib) ib = LEN_TRIM(string) IF (ib > 0) THEN DO WHILE (string(ia:ia) == ' ') - ia = ia+1 + ia = ia + 1 END DO END IF diff --git a/src/common/structure_factors.F b/src/common/structure_factors.F index 2cafc52f1e..69033d0981 100644 --- a/src/common/structure_factors.F +++ b/src/common/structure_factors.F @@ -101,9 +101,9 @@ SUBROUTINE structure_factor_allocate(bds, nparts, exp_igr, & CHARACTER(len=*), PARAMETER :: routineN = 'structure_factor_allocate', & routineP = moduleN//':'//routineN - ALLOCATE (exp_igr%ex(bds(1, 1):bds(2, 1)+1, nparts)) - ALLOCATE (exp_igr%ey(bds(1, 2):bds(2, 2)+1, nparts)) - ALLOCATE (exp_igr%ez(bds(1, 3):bds(2, 3)+1, nparts)) + ALLOCATE (exp_igr%ex(bds(1, 1):bds(2, 1) + 1, nparts)) + ALLOCATE (exp_igr%ey(bds(1, 2):bds(2, 2) + 1, nparts)) + ALLOCATE (exp_igr%ez(bds(1, 3):bds(2, 3) + 1, nparts)) NULLIFY (exp_igr%centre) exp_igr%lb(1) = LBOUND(exp_igr%ex, 1) @@ -118,14 +118,14 @@ SUBROUTINE structure_factor_allocate(bds, nparts, exp_igr, & IF (PRESENT(allocate_shell_e)) THEN IF (allocate_shell_e) THEN - ALLOCATE (exp_igr%shell_ex(bds(1, 1):bds(2, 1)+1, nshell)) - ALLOCATE (exp_igr%shell_ey(bds(1, 2):bds(2, 2)+1, nshell)) - ALLOCATE (exp_igr%shell_ez(bds(1, 3):bds(2, 3)+1, nshell)) + ALLOCATE (exp_igr%shell_ex(bds(1, 1):bds(2, 1) + 1, nshell)) + ALLOCATE (exp_igr%shell_ey(bds(1, 2):bds(2, 2) + 1, nshell)) + ALLOCATE (exp_igr%shell_ez(bds(1, 3):bds(2, 3) + 1, nshell)) NULLIFY (exp_igr%shell_centre) - ALLOCATE (exp_igr%core_ex(bds(1, 1):bds(2, 1)+1, nshell)) - ALLOCATE (exp_igr%core_ey(bds(1, 2):bds(2, 2)+1, nshell)) - ALLOCATE (exp_igr%core_ez(bds(1, 3):bds(2, 3)+1, nshell)) + ALLOCATE (exp_igr%core_ex(bds(1, 1):bds(2, 1) + 1, nshell)) + ALLOCATE (exp_igr%core_ey(bds(1, 2):bds(2, 2) + 1, nshell)) + ALLOCATE (exp_igr%core_ez(bds(1, 3):bds(2, 3) + 1, nshell)) NULLIFY (exp_igr%core_centre) IF (PRESENT(allocate_shell_centre)) THEN @@ -171,7 +171,7 @@ SUBROUTINE structure_factor_evaluate(delta, lb, ex, ey, ez) n1 = UBOUND(ez, 1) ! delta is in scaled coordinates - vec(:) = twopi*(delta(:)+0.5_dp) + vec(:) = twopi*(delta(:) + 0.5_dp) ex(l0) = 1.0_dp ey(m0) = 1.0_dp @@ -183,22 +183,22 @@ SUBROUTINE structure_factor_evaluate(delta, lb, ex, ey, ez) fp = CMPLX(COS(vec(1)), -SIN(vec(1)), KIND=dp) fm = CONJG(fp) DO j = 1, -l0 - ex(j+l0) = ex(j+l0-1)*fp - ex(-j+l1) = ex(-j+l1+1)*fm + ex(j + l0) = ex(j + l0 - 1)*fp + ex(-j + l1) = ex(-j + l1 + 1)*fm END DO fp = CMPLX(COS(vec(2)), -SIN(vec(2)), KIND=dp) fm = CONJG(fp) DO j = 1, -m0 - ey(j+m0) = ey(j+m0-1)*fp - ey(-j+m1) = ey(-j+m1+1)*fm + ey(j + m0) = ey(j + m0 - 1)*fp + ey(-j + m1) = ey(-j + m1 + 1)*fm END DO fp = CMPLX(COS(vec(3)), -SIN(vec(3)), KIND=dp) fm = CONJG(fp) DO j = 1, -n0 - ez(j+n0) = ez(j+n0-1)*fp - ez(-j+n1) = ez(-j+n1+1)*fm + ez(j + n0) = ez(j + n0 - 1)*fp + ez(-j + n1) = ez(-j + n1 + 1)*fm END DO END SUBROUTINE structure_factor_evaluate diff --git a/src/common/t_c_g0.F b/src/common/t_c_g0.F index 31a4d33ea3..11e14b614b 100644 --- a/src/common/t_c_g0.F +++ b/src/common/t_c_g0.F @@ -81,17 +81,17 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) REAL(KIND=dp) :: lower, TG1, TG2, upper, X1, X2 use_gamma = .FALSE. - upper = R**2+11.0_dp*R+50.0_dp - lower = R**2-11.0_dp*R+0.0_dp + upper = R**2 + 11.0_dp*R + 50.0_dp + lower = R**2 - 11.0_dp*R + 0.0_dp IF (T > upper) THEN - RES(1:NDERIV+1) = 0.0_dp + RES(1:NDERIV + 1) = 0.0_dp RETURN ENDIF IF (R <= 11.0_dp) THEN X2 = R/11.0_dp - upper = R**2+11.0_dp*R+50.0_dp + upper = R**2 + 11.0_dp*R + 50.0_dp lower = 0.0_dp - X1 = (T-lower)/(upper-lower) + X1 = (T - lower)/(upper - lower) IF (X1 <= 0.500000000000000000E+00_dp) THEN IF (X2 <= 0.500000000000000000E+00_dp) THEN IF (X2 <= 0.250000000000000000E+00_dp) THEN @@ -103,33 +103,33 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X1 <= 0.625000000000000000E-01_dp) THEN IF (X2 <= 0.156250000000000000E-01_dp) THEN IF (X1 <= 0.312500000000000000E-01_dp) THEN - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.156250000000000000E-01_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.156250000000000000E-01_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 1)) ELSE - TG1 = (2*X1-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.156250000000000000E-01_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.156250000000000000E-01_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 2)) ENDIF ELSE IF (X1 <= 0.312500000000000000E-01_dp) THEN - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.468750000000000000E-01_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.468750000000000000E-01_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 3)) ELSE - TG1 = (2*X1-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.468750000000000000E-01_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.468750000000000000E-01_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 4)) ENDIF ENDIF ELSE IF (X2 <= 0.156250000000000000E-01_dp) THEN - TG1 = (2*X1-0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.156250000000000000E-01_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.156250000000000000E-01_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 5)) ELSE - TG1 = (2*X1-0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.468750000000000000E-01_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.468750000000000000E-01_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 6)) ENDIF ENDIF @@ -137,33 +137,33 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X1 <= 0.625000000000000000E-01_dp) THEN IF (X2 <= 0.468750000000000000E-01_dp) THEN IF (X1 <= 0.312500000000000000E-01_dp) THEN - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.781250000000000000E-01_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.781250000000000000E-01_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 7)) ELSE - TG1 = (2*X1-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.781250000000000000E-01_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.781250000000000000E-01_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 8)) ENDIF ELSE IF (X1 <= 0.312500000000000000E-01_dp) THEN - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.109375000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.109375000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 9)) ELSE - TG1 = (2*X1-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.109375000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.109375000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 10)) ENDIF ENDIF ELSE IF (X2 <= 0.468750000000000000E-01_dp) THEN - TG1 = (2*X1-0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.781250000000000000E-01_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.781250000000000000E-01_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 11)) ELSE - TG1 = (2*X1-0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.109375000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.109375000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 12)) ENDIF ENDIF @@ -171,22 +171,22 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) ELSE IF (X2 <= 0.312500000000000000E-01_dp) THEN IF (X1 <= 0.187500000000000000E+00_dp) THEN - TG1 = (2*X1-0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 13)) ELSE - TG1 = (2*X1-0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 14)) ENDIF ELSE IF (X1 <= 0.187500000000000000E+00_dp) THEN - TG1 = (2*X1-0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 15)) ELSE - TG1 = (2*X1-0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 16)) ENDIF ENDIF @@ -197,33 +197,33 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X1 <= 0.625000000000000000E-01_dp) THEN IF (X2 <= 0.781250000000000000E-01_dp) THEN IF (X1 <= 0.312500000000000000E-01_dp) THEN - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.140625000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.140625000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 17)) ELSE - TG1 = (2*X1-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.140625000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.140625000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 18)) ENDIF ELSE IF (X1 <= 0.312500000000000000E-01_dp) THEN - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.171875000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.171875000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 19)) ELSE - TG1 = (2*X1-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.171875000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.171875000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 20)) ENDIF ENDIF ELSE IF (X2 <= 0.781250000000000000E-01_dp) THEN - TG1 = (2*X1-0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.140625000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.140625000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 21)) ELSE - TG1 = (2*X1-0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.171875000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.171875000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 22)) ENDIF ENDIF @@ -231,33 +231,33 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X1 <= 0.625000000000000000E-01_dp) THEN IF (X2 <= 0.109375000000000000E+00_dp) THEN IF (X1 <= 0.312500000000000000E-01_dp) THEN - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.203125000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.203125000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 23)) ELSE - TG1 = (2*X1-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.203125000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.203125000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 24)) ENDIF ELSE IF (X1 <= 0.312500000000000000E-01_dp) THEN - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.234375000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.234375000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 25)) ELSE - TG1 = (2*X1-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.234375000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.234375000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 26)) ENDIF ENDIF ELSE IF (X2 <= 0.109375000000000000E+00_dp) THEN - TG1 = (2*X1-0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.203125000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.203125000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 27)) ELSE - TG1 = (2*X1-0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.234375000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.234375000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 28)) ENDIF ENDIF @@ -265,29 +265,29 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) ELSE IF (X1 <= 0.187500000000000000E+00_dp) THEN IF (X2 <= 0.937500000000000000E-01_dp) THEN - TG1 = (2*X1-0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 29)) ELSE - TG1 = (2*X1-0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 30)) ENDIF ELSE - TG1 = (2*X1-0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 31)) ENDIF ENDIF ENDIF ELSE IF (X1 <= 0.375000000000000000E+00_dp) THEN - TG1 = (2*X1-0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 32)) ELSE - TG1 = (2*X1-0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 33)) ENDIF ENDIF @@ -299,27 +299,27 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X1 <= 0.625000000000000000E-01_dp) THEN IF (X1 <= 0.312500000000000000E-01_dp) THEN IF (X2 <= 0.140625000000000000E+00_dp) THEN - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.265625000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.265625000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 34)) ELSE - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.296875000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.296875000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 35)) ENDIF ELSE - TG1 = (2*X1-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.281250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.281250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 36)) ENDIF ELSE IF (X1 <= 0.937500000000000000E-01_dp) THEN - TG1 = (2*X1-0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.281250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.281250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 37)) ELSE - TG1 = (2*X1-0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.281250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.281250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 38)) ENDIF ENDIF @@ -327,33 +327,33 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X1 <= 0.625000000000000000E-01_dp) THEN IF (X1 <= 0.312500000000000000E-01_dp) THEN IF (X2 <= 0.171875000000000000E+00_dp) THEN - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.328125000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.328125000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 39)) ELSE - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.359375000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.359375000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 40)) ENDIF ELSE - TG1 = (2*X1-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.343750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.343750000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 41)) ENDIF ELSE - TG1 = (2*X1-0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.343750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.343750000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 42)) ENDIF ENDIF ELSE IF (X1 <= 0.187500000000000000E+00_dp) THEN - TG1 = (2*X1-0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 43)) ELSE - TG1 = (2*X1-0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 44)) ENDIF ENDIF @@ -363,55 +363,55 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X2 <= 0.218750000000000000E+00_dp) THEN IF (X1 <= 0.312500000000000000E-01_dp) THEN IF (X2 <= 0.203125000000000000E+00_dp) THEN - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.390625000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.390625000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 45)) ELSE - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.421875000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.421875000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 46)) ENDIF ELSE - TG1 = (2*X1-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 47)) ENDIF ELSE IF (X1 <= 0.312500000000000000E-01_dp) THEN IF (X2 <= 0.234375000000000000E+00_dp) THEN - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.453125000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.453125000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 48)) ELSE - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.484375000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.484375000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 49)) ENDIF ELSE - TG1 = (2*X1-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.468750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.468750000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 50)) ENDIF ENDIF ELSE IF (X2 <= 0.218750000000000000E+00_dp) THEN - TG1 = (2*X1-0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 51)) ELSE - TG1 = (2*X1-0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.468750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.468750000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 52)) ENDIF ENDIF ELSE IF (X1 <= 0.187500000000000000E+00_dp) THEN - TG1 = (2*X1-0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 53)) ELSE - TG1 = (2*X1-0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 54)) ENDIF ENDIF @@ -419,17 +419,17 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) ELSE IF (X1 <= 0.375000000000000000E+00_dp) THEN IF (X1 <= 0.312500000000000000E+00_dp) THEN - TG1 = (2*X1-0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.375000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.375000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 55)) ELSE - TG1 = (2*X1-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.375000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.375000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 56)) ENDIF ELSE - TG1 = (2*X1-0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.375000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.375000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 57)) ENDIF ENDIF @@ -442,39 +442,39 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X2 <= 0.312500000000000000E+00_dp) THEN IF (X1 <= 0.312500000000000000E-01_dp) THEN IF (X2 <= 0.281250000000000000E+00_dp) THEN - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.531250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.531250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 58)) ELSE - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.593750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.593750000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 59)) ENDIF ELSE IF (X2 <= 0.281250000000000000E+00_dp) THEN - TG1 = (2*X1-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.531250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.531250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 60)) ELSE - TG1 = (2*X1-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.593750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.593750000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 61)) ENDIF ENDIF ELSE IF (X1 <= 0.312500000000000000E-01_dp) THEN IF (X2 <= 0.343750000000000000E+00_dp) THEN - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.656250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.656250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 62)) ELSE - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.718750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.718750000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 63)) ENDIF ELSE - TG1 = (2*X1-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 64)) ENDIF ENDIF @@ -482,33 +482,33 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X1 <= 0.312500000000000000E-01_dp) THEN IF (X2 <= 0.437500000000000000E+00_dp) THEN IF (X1 <= 0.156250000000000000E-01_dp) THEN - TG1 = (2*X1-0.156250000000000000E-01_dp)*0.640000000000000000E+02_dp - TG2 = (2*X2-0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.156250000000000000E-01_dp)*0.640000000000000000E+02_dp + TG2 = (2*X2 - 0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 65)) ELSE - TG1 = (2*X1-0.468750000000000000E-01_dp)*0.640000000000000000E+02_dp - TG2 = (2*X2-0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.468750000000000000E-01_dp)*0.640000000000000000E+02_dp + TG2 = (2*X2 - 0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 66)) ENDIF ELSE IF (X1 <= 0.156250000000000000E-01_dp) THEN - TG1 = (2*X1-0.156250000000000000E-01_dp)*0.640000000000000000E+02_dp - TG2 = (2*X2-0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.156250000000000000E-01_dp)*0.640000000000000000E+02_dp + TG2 = (2*X2 - 0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 67)) ELSE - TG1 = (2*X1-0.468750000000000000E-01_dp)*0.640000000000000000E+02_dp - TG2 = (2*X2-0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.468750000000000000E-01_dp)*0.640000000000000000E+02_dp + TG2 = (2*X2 - 0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 68)) ENDIF ENDIF ELSE IF (X2 <= 0.437500000000000000E+00_dp) THEN - TG1 = (2*X1-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 69)) ELSE - TG1 = (2*X1-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 70)) ENDIF ENDIF @@ -517,44 +517,44 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X2 <= 0.375000000000000000E+00_dp) THEN IF (X2 <= 0.312500000000000000E+00_dp) THEN IF (X1 <= 0.937500000000000000E-01_dp) THEN - TG1 = (2*X1-0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 71)) ELSE - TG1 = (2*X1-0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 72)) ENDIF ELSE IF (X1 <= 0.937500000000000000E-01_dp) THEN - TG1 = (2*X1-0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 73)) ELSE - TG1 = (2*X1-0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 74)) ENDIF ENDIF ELSE IF (X1 <= 0.937500000000000000E-01_dp) THEN IF (X2 <= 0.437500000000000000E+00_dp) THEN - TG1 = (2*X1-0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 75)) ELSE - TG1 = (2*X1-0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 76)) ENDIF ELSE IF (X2 <= 0.437500000000000000E+00_dp) THEN - TG1 = (2*X1-0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 77)) ELSE - TG1 = (2*X1-0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 78)) ENDIF ENDIF @@ -564,56 +564,56 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X2 <= 0.375000000000000000E+00_dp) THEN IF (X1 <= 0.187500000000000000E+00_dp) THEN IF (X2 <= 0.312500000000000000E+00_dp) THEN - TG1 = (2*X1-0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 79)) ELSE IF (X1 <= 0.156250000000000000E+00_dp) THEN - TG1 = (2*X1-0.281250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.281250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 80)) ELSE - TG1 = (2*X1-0.343750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.343750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 81)) ENDIF ENDIF ELSE IF (X2 <= 0.312500000000000000E+00_dp) THEN - TG1 = (2*X1-0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 82)) ELSE - TG1 = (2*X1-0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 83)) ENDIF ENDIF ELSE IF (X1 <= 0.187500000000000000E+00_dp) THEN IF (X2 <= 0.437500000000000000E+00_dp) THEN - TG1 = (2*X1-0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 84)) ELSE IF (X1 <= 0.156250000000000000E+00_dp) THEN - TG1 = (2*X1-0.281250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.281250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 85)) ELSE - TG1 = (2*X1-0.343750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.343750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 86)) ENDIF ENDIF ELSE IF (X1 <= 0.218750000000000000E+00_dp) THEN - TG1 = (2*X1-0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 87)) ELSE - TG1 = (2*X1-0.468750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.468750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 88)) ENDIF ENDIF @@ -623,39 +623,39 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X1 <= 0.375000000000000000E+00_dp) THEN IF (X2 <= 0.375000000000000000E+00_dp) THEN IF (X1 <= 0.312500000000000000E+00_dp) THEN - TG1 = (2*X1-0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 89)) ELSE - TG1 = (2*X1-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 90)) ENDIF ELSE IF (X1 <= 0.312500000000000000E+00_dp) THEN IF (X1 <= 0.281250000000000000E+00_dp) THEN - TG1 = (2*X1-0.531250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.531250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 91)) ELSE - TG1 = (2*X1-0.593750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.593750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 92)) ENDIF ELSE - TG1 = (2*X1-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 93)) ENDIF ENDIF ELSE IF (X1 <= 0.437500000000000000E+00_dp) THEN - TG1 = (2*X1-0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.750000000000000000E+00_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.750000000000000000E+00_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 94)) ELSE - TG1 = (2*X1-0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.750000000000000000E+00_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.750000000000000000E+00_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 95)) ENDIF ENDIF @@ -669,55 +669,55 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X1 <= 0.156250000000000000E-01_dp) THEN IF (X1 <= 0.781250000000000000E-02_dp) THEN IF (X2 <= 0.750000000000000000E+00_dp) THEN - TG1 = (2*X1-0.781250000000000000E-02_dp)*0.128000000000000000E+03_dp - TG2 = (2*X2-0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.781250000000000000E-02_dp)*0.128000000000000000E+03_dp + TG2 = (2*X2 - 0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 96)) ELSE - TG1 = (2*X1-0.781250000000000000E-02_dp)*0.128000000000000000E+03_dp - TG2 = (2*X2-0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.781250000000000000E-02_dp)*0.128000000000000000E+03_dp + TG2 = (2*X2 - 0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 97)) ENDIF ELSE IF (X2 <= 0.750000000000000000E+00_dp) THEN - TG1 = (2*X1-0.234375000000000000E-01_dp)*0.128000000000000000E+03_dp - TG2 = (2*X2-0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.234375000000000000E-01_dp)*0.128000000000000000E+03_dp + TG2 = (2*X2 - 0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 98)) ELSE - TG1 = (2*X1-0.234375000000000000E-01_dp)*0.128000000000000000E+03_dp - TG2 = (2*X2-0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.234375000000000000E-01_dp)*0.128000000000000000E+03_dp + TG2 = (2*X2 - 0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 99)) ENDIF ENDIF ELSE IF (X2 <= 0.750000000000000000E+00_dp) THEN - TG1 = (2*X1-0.468750000000000000E-01_dp)*0.640000000000000000E+02_dp - TG2 = (2*X2-0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.468750000000000000E-01_dp)*0.640000000000000000E+02_dp + TG2 = (2*X2 - 0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 100)) ELSE - TG1 = (2*X1-0.468750000000000000E-01_dp)*0.640000000000000000E+02_dp - TG2 = (2*X2-0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.468750000000000000E-01_dp)*0.640000000000000000E+02_dp + TG2 = (2*X2 - 0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 101)) ENDIF ENDIF ELSE IF (X2 <= 0.750000000000000000E+00_dp) THEN IF (X2 <= 0.625000000000000000E+00_dp) THEN - TG1 = (2*X1-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 102)) ELSE - TG1 = (2*X1-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 103)) ENDIF ELSE IF (X1 <= 0.468750000000000000E-01_dp) THEN - TG1 = (2*X1-0.781250000000000000E-01_dp)*0.640000000000000000E+02_dp - TG2 = (2*X2-0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.781250000000000000E-01_dp)*0.640000000000000000E+02_dp + TG2 = (2*X2 - 0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 104)) ELSE - TG1 = (2*X1-0.109375000000000000E+00_dp)*0.640000000000000000E+02_dp - TG2 = (2*X2-0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.109375000000000000E+00_dp)*0.640000000000000000E+02_dp + TG2 = (2*X2 - 0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 105)) ENDIF ENDIF @@ -726,33 +726,33 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X2 <= 0.750000000000000000E+00_dp) THEN IF (X2 <= 0.625000000000000000E+00_dp) THEN IF (X1 <= 0.937500000000000000E-01_dp) THEN - TG1 = (2*X1-0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 106)) ELSE - TG1 = (2*X1-0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 107)) ENDIF ELSE IF (X1 <= 0.937500000000000000E-01_dp) THEN - TG1 = (2*X1-0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 108)) ELSE - TG1 = (2*X1-0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 109)) ENDIF ENDIF ELSE IF (X1 <= 0.937500000000000000E-01_dp) THEN - TG1 = (2*X1-0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 110)) ELSE - TG1 = (2*X1-0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 111)) ENDIF ENDIF @@ -762,44 +762,44 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X2 <= 0.625000000000000000E+00_dp) THEN IF (X1 <= 0.187500000000000000E+00_dp) THEN IF (X1 <= 0.156250000000000000E+00_dp) THEN - TG1 = (2*X1-0.281250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.281250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 112)) ELSE - TG1 = (2*X1-0.343750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.343750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 113)) ENDIF ELSE IF (X1 <= 0.218750000000000000E+00_dp) THEN - TG1 = (2*X1-0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 114)) ELSE - TG1 = (2*X1-0.468750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.468750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 115)) ENDIF ENDIF ELSE IF (X1 <= 0.187500000000000000E+00_dp) THEN IF (X1 <= 0.156250000000000000E+00_dp) THEN - TG1 = (2*X1-0.281250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.281250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 116)) ELSE - TG1 = (2*X1-0.343750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.343750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 117)) ENDIF ELSE IF (X1 <= 0.218750000000000000E+00_dp) THEN - TG1 = (2*X1-0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 118)) ELSE - TG1 = (2*X1-0.468750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.468750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 119)) ENDIF ENDIF @@ -807,28 +807,28 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) ELSE IF (X1 <= 0.187500000000000000E+00_dp) THEN IF (X2 <= 0.875000000000000000E+00_dp) THEN - TG1 = (2*X1-0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 120)) ELSE - TG1 = (2*X1-0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 121)) ENDIF ELSE IF (X2 <= 0.875000000000000000E+00_dp) THEN IF (X1 <= 0.218750000000000000E+00_dp) THEN - TG1 = (2*X1-0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 122)) ELSE - TG1 = (2*X1-0.468750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.468750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 123)) ENDIF ELSE - TG1 = (2*X1-0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 124)) ENDIF ENDIF @@ -840,38 +840,38 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X1 <= 0.312500000000000000E+00_dp) THEN IF (X2 <= 0.625000000000000000E+00_dp) THEN IF (X1 <= 0.281250000000000000E+00_dp) THEN - TG1 = (2*X1-0.531250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.531250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 125)) ELSE - TG1 = (2*X1-0.593750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.593750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 126)) ENDIF ELSE IF (X1 <= 0.281250000000000000E+00_dp) THEN - TG1 = (2*X1-0.531250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.531250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 127)) ELSE - TG1 = (2*X1-0.593750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.593750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 128)) ENDIF ENDIF ELSE IF (X2 <= 0.625000000000000000E+00_dp) THEN - TG1 = (2*X1-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 129)) ELSE IF (X1 <= 0.343750000000000000E+00_dp) THEN - TG1 = (2*X1-0.656250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.656250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 130)) ELSE - TG1 = (2*X1-0.718750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.718750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 131)) ENDIF ENDIF @@ -880,39 +880,39 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X1 <= 0.312500000000000000E+00_dp) THEN IF (X2 <= 0.875000000000000000E+00_dp) THEN IF (X1 <= 0.281250000000000000E+00_dp) THEN - TG1 = (2*X1-0.531250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.531250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 132)) ELSE - TG1 = (2*X1-0.593750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.593750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 133)) ENDIF ELSE IF (X1 <= 0.281250000000000000E+00_dp) THEN - TG1 = (2*X1-0.531250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.531250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 134)) ELSE - TG1 = (2*X1-0.593750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.593750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 135)) ENDIF ENDIF ELSE IF (X2 <= 0.875000000000000000E+00_dp) THEN IF (X1 <= 0.343750000000000000E+00_dp) THEN - TG1 = (2*X1-0.656250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.656250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 136)) ELSE - TG1 = (2*X1-0.718750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.718750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 137)) ENDIF ELSE - TG1 = (2*X1-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 138)) ENDIF ENDIF @@ -921,38 +921,38 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X2 <= 0.750000000000000000E+00_dp) THEN IF (X1 <= 0.437500000000000000E+00_dp) THEN IF (X2 <= 0.625000000000000000E+00_dp) THEN - TG1 = (2*X1-0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 139)) ELSE - TG1 = (2*X1-0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 140)) ENDIF ELSE - TG1 = (2*X1-0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 141)) ENDIF ELSE IF (X1 <= 0.437500000000000000E+00_dp) THEN IF (X2 <= 0.875000000000000000E+00_dp) THEN - TG1 = (2*X1-0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 142)) ELSE - TG1 = (2*X1-0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 143)) ENDIF ELSE IF (X2 <= 0.875000000000000000E+00_dp) THEN - TG1 = (2*X1-0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 144)) ELSE - TG1 = (2*X1-0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 145)) ENDIF ENDIF @@ -965,57 +965,57 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X2 <= 0.500000000000000000E+00_dp) THEN IF (X1 <= 0.625000000000000000E+00_dp) THEN IF (X2 <= 0.250000000000000000E+00_dp) THEN - TG1 = (2*X1-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.250000000000000000E+00_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.250000000000000000E+00_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 146)) ELSE - TG1 = (2*X1-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.750000000000000000E+00_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.750000000000000000E+00_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 147)) ENDIF ELSE - TG1 = (2*X1-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.500000000000000000E+00_dp)*0.200000000000000000E+01_dp + TG1 = (2*X1 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.500000000000000000E+00_dp)*0.200000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 148)) ENDIF ELSE IF (X1 <= 0.625000000000000000E+00_dp) THEN IF (X2 <= 0.750000000000000000E+00_dp) THEN IF (X1 <= 0.562500000000000000E+00_dp) THEN - TG1 = (2*X1-0.106250000000000000E+01_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.106250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 149)) ELSE - TG1 = (2*X1-0.118750000000000000E+01_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.118750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 150)) ENDIF ELSE IF (X1 <= 0.562500000000000000E+00_dp) THEN - TG1 = (2*X1-0.106250000000000000E+01_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.106250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 151)) ELSE - TG1 = (2*X1-0.118750000000000000E+01_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.118750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 152)) ENDIF ENDIF ELSE IF (X1 <= 0.687500000000000000E+00_dp) THEN - TG1 = (2*X1-0.131250000000000000E+01_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.150000000000000000E+01_dp)*0.200000000000000000E+01_dp + TG1 = (2*X1 - 0.131250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.150000000000000000E+01_dp)*0.200000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 153)) ELSE - TG1 = (2*X1-0.143750000000000000E+01_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.150000000000000000E+01_dp)*0.200000000000000000E+01_dp + TG1 = (2*X1 - 0.143750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.150000000000000000E+01_dp)*0.200000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 154)) ENDIF ENDIF ENDIF ELSE - TG1 = (2*X1-0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp - TG2 = (2*X2-0.100000000000000000E+01_dp)*0.100000000000000000E+01_dp + TG1 = (2*X1 - 0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG2 = (2*X2 - 0.100000000000000000E+01_dp)*0.100000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 155)) ENDIF ENDIF @@ -1025,40 +1025,40 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) RETURN ENDIF X2 = 11.0_dp/R - X1 = (T-lower)/(upper-lower) + X1 = (T - lower)/(upper - lower) IF (X1 <= 0.500000000000000000E+00_dp) THEN IF (X1 <= 0.250000000000000000E+00_dp) THEN IF (X2 <= 0.500000000000000000E+00_dp) THEN IF (X1 <= 0.125000000000000000E+00_dp) THEN IF (X2 <= 0.250000000000000000E+00_dp) THEN - TG1 = (2*X1-0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.250000000000000000E+00_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.250000000000000000E+00_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 156)) ELSE - TG1 = (2*X1-0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.750000000000000000E+00_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.750000000000000000E+00_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 157)) ENDIF ELSE - TG1 = (2*X1-0.375000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.500000000000000000E+00_dp)*0.200000000000000000E+01_dp + TG1 = (2*X1 - 0.375000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.500000000000000000E+00_dp)*0.200000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 158)) ENDIF ELSE IF (X1 <= 0.125000000000000000E+00_dp) THEN IF (X2 <= 0.750000000000000000E+00_dp) THEN IF (X2 <= 0.625000000000000000E+00_dp) THEN - TG1 = (2*X1-0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 159)) ELSE IF (X1 <= 0.625000000000000000E-01_dp) THEN - TG1 = (2*X1-0.625000000000000000E-01_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.625000000000000000E-01_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 160)) ELSE - TG1 = (2*X1-0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 161)) ENDIF ENDIF @@ -1067,17 +1067,17 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X2 <= 0.875000000000000000E+00_dp) THEN IF (X1 <= 0.312500000000000000E-01_dp) THEN IF (X2 <= 0.812500000000000000E+00_dp) THEN - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.156250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.156250000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 162)) ELSE - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.168750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.168750000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 163)) ENDIF ELSE - TG1 = (2*X1-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 164)) ENDIF ELSE @@ -1085,17 +1085,17 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X2 <= 0.937500000000000000E+00_dp) THEN IF (X1 <= 0.156250000000000000E-01_dp) THEN IF (X2 <= 0.906250000000000000E+00_dp) THEN - TG1 = (2*X1-0.156250000000000000E-01_dp)*0.640000000000000000E+02_dp - TG2 = (2*X2-0.178125000000000000E+01_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.156250000000000000E-01_dp)*0.640000000000000000E+02_dp + TG2 = (2*X2 - 0.178125000000000000E+01_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 165)) ELSE - TG1 = (2*X1-0.156250000000000000E-01_dp)*0.640000000000000000E+02_dp - TG2 = (2*X2-0.184375000000000000E+01_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.156250000000000000E-01_dp)*0.640000000000000000E+02_dp + TG2 = (2*X2 - 0.184375000000000000E+01_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 166)) ENDIF ELSE - TG1 = (2*X1-0.468750000000000000E-01_dp)*0.640000000000000000E+02_dp - TG2 = (2*X2-0.181250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.468750000000000000E-01_dp)*0.640000000000000000E+02_dp + TG2 = (2*X2 - 0.181250000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 167)) ENDIF ELSE @@ -1103,55 +1103,55 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X2 <= 0.968750000000000000E+00_dp) THEN IF (X1 <= 0.781250000000000000E-02_dp) THEN IF (X2 <= 0.953125000000000000E+00_dp) THEN - TG1 = (2*X1-0.781250000000000000E-02_dp)*0.128000000000000000E+03_dp - TG2 = (2*X2-0.189062500000000000E+01_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.781250000000000000E-02_dp)*0.128000000000000000E+03_dp + TG2 = (2*X2 - 0.189062500000000000E+01_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 168)) ELSE - TG1 = (2*X1-0.781250000000000000E-02_dp)*0.128000000000000000E+03_dp - TG2 = (2*X2-0.192187500000000000E+01_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.781250000000000000E-02_dp)*0.128000000000000000E+03_dp + TG2 = (2*X2 - 0.192187500000000000E+01_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 169)) ENDIF ELSE - TG1 = (2*X1-0.234375000000000000E-01_dp)*0.128000000000000000E+03_dp - TG2 = (2*X2-0.190625000000000000E+01_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.234375000000000000E-01_dp)*0.128000000000000000E+03_dp + TG2 = (2*X2 - 0.190625000000000000E+01_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 170)) ENDIF ELSE IF (X1 <= 0.781250000000000000E-02_dp) THEN IF (X2 <= 0.984375000000000000E+00_dp) THEN - TG1 = (2*X1-0.781250000000000000E-02_dp)*0.128000000000000000E+03_dp - TG2 = (2*X2-0.195312500000000000E+01_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.781250000000000000E-02_dp)*0.128000000000000000E+03_dp + TG2 = (2*X2 - 0.195312500000000000E+01_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 171)) ELSE - TG1 = (2*X1-0.781250000000000000E-02_dp)*0.128000000000000000E+03_dp - TG2 = (2*X2-0.198437500000000000E+01_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.781250000000000000E-02_dp)*0.128000000000000000E+03_dp + TG2 = (2*X2 - 0.198437500000000000E+01_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 172)) ENDIF ELSE IF (X2 <= 0.984375000000000000E+00_dp) THEN - TG1 = (2*X1-0.234375000000000000E-01_dp)*0.128000000000000000E+03_dp - TG2 = (2*X2-0.195312500000000000E+01_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.234375000000000000E-01_dp)*0.128000000000000000E+03_dp + TG2 = (2*X2 - 0.195312500000000000E+01_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 173)) ELSE - TG1 = (2*X1-0.234375000000000000E-01_dp)*0.128000000000000000E+03_dp - TG2 = (2*X2-0.198437500000000000E+01_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.234375000000000000E-01_dp)*0.128000000000000000E+03_dp + TG2 = (2*X2 - 0.198437500000000000E+01_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 174)) ENDIF ENDIF ENDIF ELSE IF (X2 <= 0.968750000000000000E+00_dp) THEN - TG1 = (2*X1-0.468750000000000000E-01_dp)*0.640000000000000000E+02_dp - TG2 = (2*X2-0.190625000000000000E+01_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.468750000000000000E-01_dp)*0.640000000000000000E+02_dp + TG2 = (2*X2 - 0.190625000000000000E+01_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 175)) ELSE IF (X1 <= 0.234375000000000000E-01_dp) THEN - TG1 = (2*X1-0.390625000000000000E-01_dp)*0.128000000000000000E+03_dp - TG2 = (2*X2-0.196875000000000000E+01_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.390625000000000000E-01_dp)*0.128000000000000000E+03_dp + TG2 = (2*X2 - 0.196875000000000000E+01_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 176)) ELSE - TG1 = (2*X1-0.546875000000000000E-01_dp)*0.128000000000000000E+03_dp - TG2 = (2*X2-0.196875000000000000E+01_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.546875000000000000E-01_dp)*0.128000000000000000E+03_dp + TG2 = (2*X2 - 0.196875000000000000E+01_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 177)) ENDIF ENDIF @@ -1159,23 +1159,23 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) ENDIF ELSE IF (X2 <= 0.937500000000000000E+00_dp) THEN - TG1 = (2*X1-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.181250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.181250000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 178)) ELSE IF (X1 <= 0.468750000000000000E-01_dp) THEN IF (X2 <= 0.968750000000000000E+00_dp) THEN - TG1 = (2*X1-0.781250000000000000E-01_dp)*0.640000000000000000E+02_dp - TG2 = (2*X2-0.190625000000000000E+01_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.781250000000000000E-01_dp)*0.640000000000000000E+02_dp + TG2 = (2*X2 - 0.190625000000000000E+01_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 179)) ELSE - TG1 = (2*X1-0.781250000000000000E-01_dp)*0.640000000000000000E+02_dp - TG2 = (2*X2-0.196875000000000000E+01_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.781250000000000000E-01_dp)*0.640000000000000000E+02_dp + TG2 = (2*X2 - 0.196875000000000000E+01_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 180)) ENDIF ELSE - TG1 = (2*X1-0.109375000000000000E+00_dp)*0.640000000000000000E+02_dp - TG2 = (2*X2-0.193750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.109375000000000000E+00_dp)*0.640000000000000000E+02_dp + TG2 = (2*X2 - 0.193750000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 181)) ENDIF ENDIF @@ -1183,23 +1183,23 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) ENDIF ELSE IF (X2 <= 0.875000000000000000E+00_dp) THEN - TG1 = (2*X1-0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 182)) ELSE IF (X1 <= 0.937500000000000000E-01_dp) THEN IF (X2 <= 0.937500000000000000E+00_dp) THEN - TG1 = (2*X1-0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.181250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.181250000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 183)) ELSE - TG1 = (2*X1-0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.193750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.193750000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 184)) ENDIF ELSE - TG1 = (2*X1-0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 185)) ENDIF ENDIF @@ -1207,23 +1207,23 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) ENDIF ELSE IF (X2 <= 0.750000000000000000E+00_dp) THEN - TG1 = (2*X1-0.375000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.375000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 186)) ELSE IF (X1 <= 0.187500000000000000E+00_dp) THEN IF (X2 <= 0.875000000000000000E+00_dp) THEN - TG1 = (2*X1-0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 187)) ELSE - TG1 = (2*X1-0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 188)) ENDIF ELSE - TG1 = (2*X1-0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 189)) ENDIF ENDIF @@ -1233,50 +1233,50 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X1 <= 0.375000000000000000E+00_dp) THEN IF (X1 <= 0.312500000000000000E+00_dp) THEN IF (X1 <= 0.281250000000000000E+00_dp) THEN - TG1 = (2*X1-0.531250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.100000000000000000E+01_dp)*0.100000000000000000E+01_dp + TG1 = (2*X1 - 0.531250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.100000000000000000E+01_dp)*0.100000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 190)) ELSE - TG1 = (2*X1-0.593750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.100000000000000000E+01_dp)*0.100000000000000000E+01_dp + TG1 = (2*X1 - 0.593750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.100000000000000000E+01_dp)*0.100000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 191)) ENDIF ELSE IF (X2 <= 0.500000000000000000E+00_dp) THEN - TG1 = (2*X1-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.500000000000000000E+00_dp)*0.200000000000000000E+01_dp + TG1 = (2*X1 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.500000000000000000E+00_dp)*0.200000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 192)) ELSE - TG1 = (2*X1-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.150000000000000000E+01_dp)*0.200000000000000000E+01_dp + TG1 = (2*X1 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.150000000000000000E+01_dp)*0.200000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 193)) ENDIF ENDIF ELSE IF (X1 <= 0.437500000000000000E+00_dp) THEN IF (X2 <= 0.500000000000000000E+00_dp) THEN - TG1 = (2*X1-0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.500000000000000000E+00_dp)*0.200000000000000000E+01_dp + TG1 = (2*X1 - 0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.500000000000000000E+00_dp)*0.200000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 194)) ELSE IF (X1 <= 0.406250000000000000E+00_dp) THEN - TG1 = (2*X1-0.781250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.150000000000000000E+01_dp)*0.200000000000000000E+01_dp + TG1 = (2*X1 - 0.781250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.150000000000000000E+01_dp)*0.200000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 195)) ELSE - TG1 = (2*X1-0.843750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.150000000000000000E+01_dp)*0.200000000000000000E+01_dp + TG1 = (2*X1 - 0.843750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.150000000000000000E+01_dp)*0.200000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 196)) ENDIF ENDIF ELSE IF (X2 <= 0.500000000000000000E+00_dp) THEN - TG1 = (2*X1-0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.500000000000000000E+00_dp)*0.200000000000000000E+01_dp + TG1 = (2*X1 - 0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.500000000000000000E+00_dp)*0.200000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 197)) ELSE - TG1 = (2*X1-0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.150000000000000000E+01_dp)*0.200000000000000000E+01_dp + TG1 = (2*X1 - 0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.150000000000000000E+01_dp)*0.200000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 198)) ENDIF ENDIF @@ -1287,50 +1287,50 @@ SUBROUTINE t_c_g0_n(RES, use_gamma, R, T, NDERIV) IF (X1 <= 0.625000000000000000E+00_dp) THEN IF (X2 <= 0.500000000000000000E+00_dp) THEN IF (X1 <= 0.562500000000000000E+00_dp) THEN - TG1 = (2*X1-0.106250000000000000E+01_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.500000000000000000E+00_dp)*0.200000000000000000E+01_dp + TG1 = (2*X1 - 0.106250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.500000000000000000E+00_dp)*0.200000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 199)) ELSE - TG1 = (2*X1-0.118750000000000000E+01_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.500000000000000000E+00_dp)*0.200000000000000000E+01_dp + TG1 = (2*X1 - 0.118750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.500000000000000000E+00_dp)*0.200000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 200)) ENDIF ELSE IF (X1 <= 0.562500000000000000E+00_dp) THEN - TG1 = (2*X1-0.106250000000000000E+01_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.150000000000000000E+01_dp)*0.200000000000000000E+01_dp + TG1 = (2*X1 - 0.106250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.150000000000000000E+01_dp)*0.200000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 201)) ELSE - TG1 = (2*X1-0.118750000000000000E+01_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.150000000000000000E+01_dp)*0.200000000000000000E+01_dp + TG1 = (2*X1 - 0.118750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.150000000000000000E+01_dp)*0.200000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 202)) ENDIF ENDIF ELSE IF (X2 <= 0.500000000000000000E+00_dp) THEN IF (X1 <= 0.687500000000000000E+00_dp) THEN - TG1 = (2*X1-0.131250000000000000E+01_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.500000000000000000E+00_dp)*0.200000000000000000E+01_dp + TG1 = (2*X1 - 0.131250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.500000000000000000E+00_dp)*0.200000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 203)) ELSE - TG1 = (2*X1-0.143750000000000000E+01_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.500000000000000000E+00_dp)*0.200000000000000000E+01_dp + TG1 = (2*X1 - 0.143750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.500000000000000000E+00_dp)*0.200000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 204)) ENDIF ELSE - TG1 = (2*X1-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.150000000000000000E+01_dp)*0.200000000000000000E+01_dp + TG1 = (2*X1 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.150000000000000000E+01_dp)*0.200000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 205)) ENDIF ENDIF ELSE IF (X1 <= 0.875000000000000000E+00_dp) THEN - TG1 = (2*X1-0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.100000000000000000E+01_dp)*0.100000000000000000E+01_dp + TG1 = (2*X1 - 0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.100000000000000000E+01_dp)*0.100000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 206)) ELSE - TG1 = (2*X1-0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.100000000000000000E+01_dp)*0.100000000000000000E+01_dp + TG1 = (2*X1 - 0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.100000000000000000E+01_dp)*0.100000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 207)) ENDIF ENDIF @@ -1357,14 +1357,14 @@ SUBROUTINE init(Nder, iunit, mepos, group) nderiv_init = Nder IF (ALLOCATED(C0)) DEALLOCATE (C0) ! round up to a multiple of 32 to give some generous alignment for each C0 - ALLOCATE (C0(32*((31+(Nder+1)*(degree+1)*(degree+2)/2)/32), patches)) + ALLOCATE (C0(32*((31 + (Nder + 1)*(degree + 1)*(degree + 2)/2)/32), patches)) ! init mpi'ed buffers to silence warnings under valgrind C0 = 1.0E99_dp IF (mepos == 0) THEN - ALLOCATE (chunk((nderiv_max+1)*(degree+1)*(degree+2)/2)) + ALLOCATE (chunk((nderiv_max + 1)*(degree + 1)*(degree + 2)/2)) DO I = 1, patches READ (iunit, *) chunk - C0(1:(Nder+1)*(degree+1)*(degree+2)/2, I) = chunk(1:(Nder+1)*(degree+1)*(degree+2)/2) + C0(1:(Nder + 1)*(degree + 1)*(degree + 2)/2, I) = chunk(1:(Nder + 1)*(degree + 1)*(degree + 2)/2) ENDDO DEALLOCATE (chunk) END IF @@ -1400,46 +1400,46 @@ SUBROUTINE PD2VAL(RES, NDERIV, TG1, TG2, C0) T2(0) = 1.0_dp T1(1) = SQRT2*TG1 T2(1) = SQRT2*TG2 - T1(2) = 2*TG1*T1(1)-SQRT2 - T2(2) = 2*TG2*T2(1)-SQRT2 - T1(3) = 2*TG1*T1(2)-T1(1) - T2(3) = 2*TG2*T2(2)-T2(1) - T1(4) = 2*TG1*T1(3)-T1(2) - T2(4) = 2*TG2*T2(3)-T2(2) - T1(5) = 2*TG1*T1(4)-T1(3) - T2(5) = 2*TG2*T2(4)-T2(3) - T1(6) = 2*TG1*T1(5)-T1(4) - T2(6) = 2*TG2*T2(5)-T2(4) - T1(7) = 2*TG1*T1(6)-T1(5) - T2(7) = 2*TG2*T2(6)-T2(5) - T1(8) = 2*TG1*T1(7)-T1(6) - T2(8) = 2*TG2*T2(7)-T2(6) - T1(9) = 2*TG1*T1(8)-T1(7) - T2(9) = 2*TG2*T2(8)-T2(7) - T1(10) = 2*TG1*T1(9)-T1(8) - T2(10) = 2*TG2*T2(9)-T2(8) - T1(11) = 2*TG1*T1(10)-T1(9) - T2(11) = 2*TG2*T2(10)-T2(9) - T1(12) = 2*TG1*T1(11)-T1(10) - T2(12) = 2*TG2*T2(11)-T2(10) - T1(13) = 2*TG1*T1(12)-T1(11) - T2(13) = 2*TG2*T2(12)-T2(11) - DO K = 1, NDERIV+1 + T1(2) = 2*TG1*T1(1) - SQRT2 + T2(2) = 2*TG2*T2(1) - SQRT2 + T1(3) = 2*TG1*T1(2) - T1(1) + T2(3) = 2*TG2*T2(2) - T2(1) + T1(4) = 2*TG1*T1(3) - T1(2) + T2(4) = 2*TG2*T2(3) - T2(2) + T1(5) = 2*TG1*T1(4) - T1(3) + T2(5) = 2*TG2*T2(4) - T2(3) + T1(6) = 2*TG1*T1(5) - T1(4) + T2(6) = 2*TG2*T2(5) - T2(4) + T1(7) = 2*TG1*T1(6) - T1(5) + T2(7) = 2*TG2*T2(6) - T2(5) + T1(8) = 2*TG1*T1(7) - T1(6) + T2(8) = 2*TG2*T2(7) - T2(6) + T1(9) = 2*TG1*T1(8) - T1(7) + T2(9) = 2*TG2*T2(8) - T2(7) + T1(10) = 2*TG1*T1(9) - T1(8) + T2(10) = 2*TG2*T2(9) - T2(8) + T1(11) = 2*TG1*T1(10) - T1(9) + T2(11) = 2*TG2*T2(10) - T2(9) + T1(12) = 2*TG1*T1(11) - T1(10) + T2(12) = 2*TG2*T2(11) - T2(10) + T1(13) = 2*TG1*T1(12) - T1(11) + T2(13) = 2*TG2*T2(12) - T2(11) + DO K = 1, NDERIV + 1 RES(K) = 0.0_dp - RES(K) = RES(K)+DOT_PRODUCT(T1(0:13), C0(1:14, K))*T2(0) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:12), C0(15:27, K))*T2(1) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:11), C0(28:39, K))*T2(2) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:10), C0(40:50, K))*T2(3) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:9), C0(51:60, K))*T2(4) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:8), C0(61:69, K))*T2(5) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:7), C0(70:77, K))*T2(6) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:6), C0(78:84, K))*T2(7) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:5), C0(85:90, K))*T2(8) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:4), C0(91:95, K))*T2(9) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:3), C0(96:99, K))*T2(10) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:2), C0(100:102, K))*T2(11) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:1), C0(103:104, K))*T2(12) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:0), C0(105:105, K))*T2(13) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:13), C0(1:14, K))*T2(0) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:12), C0(15:27, K))*T2(1) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:11), C0(28:39, K))*T2(2) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:10), C0(40:50, K))*T2(3) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:9), C0(51:60, K))*T2(4) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:8), C0(61:69, K))*T2(5) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:7), C0(70:77, K))*T2(6) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:6), C0(78:84, K))*T2(7) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:5), C0(85:90, K))*T2(8) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:4), C0(91:95, K))*T2(9) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:3), C0(96:99, K))*T2(10) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:2), C0(100:102, K))*T2(11) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:1), C0(103:104, K))*T2(12) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:0), C0(105:105, K))*T2(13) ENDDO END SUBROUTINE PD2VAL diff --git a/src/common/t_sh_p_s_c.F b/src/common/t_sh_p_s_c.F index 10f225ca52..55650b5140 100644 --- a/src/common/t_sh_p_s_c.F +++ b/src/common/t_sh_p_s_c.F @@ -58,8 +58,8 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) REAL(KIND=dp) :: lower, TG1, TG2, X1, X2 IF (T <= 81.0_dp) THEN - X2 = 1/(1+R) - X1 = 1/(1+SQRT(T)) + X2 = 1/(1 + R) + X1 = 1/(1 + SQRT(T)) IF (X2 <= 0.500000000000000000E+00_dp) THEN IF (X2 <= 0.250000000000000000E+00_dp) THEN IF (X1 <= 0.550000000000000044E+00_dp) THEN @@ -67,41 +67,41 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) IF (X1 <= 0.212500000000000022E+00_dp) THEN IF (X2 <= 0.125000000000000000E+00_dp) THEN IF (X2 <= 0.625000000000000000E-01_dp) THEN - TG1 = (2*X1-0.312500000000000000E+00_dp)*0.888888888888888751E+01_dp - TG2 = (2*X2-0.625000000000000000E-01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E+00_dp)*0.888888888888888751E+01_dp + TG2 = (2*X2 - 0.625000000000000000E-01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 1)) ELSE IF (X1 <= 0.156250000000000000E+00_dp) THEN IF (X2 <= 0.937500000000000000E-01_dp) THEN IF (X1 <= 0.128124999999999989E+00_dp) THEN - TG1 = (2*X1-0.228124999999999994E+00_dp)*0.355555555555555785E+02_dp - TG2 = (2*X2-0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.228124999999999994E+00_dp)*0.355555555555555785E+02_dp + TG2 = (2*X2 - 0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 2)) ELSE - TG1 = (2*X1-0.284374999999999989E+00_dp)*0.355555555555555429E+02_dp - TG2 = (2*X2-0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.284374999999999989E+00_dp)*0.355555555555555429E+02_dp + TG2 = (2*X2 - 0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 3)) ENDIF ELSE IF (X1 <= 0.128124999999999989E+00_dp) THEN IF (X2 <= 0.109375000000000000E+00_dp) THEN - TG1 = (2*X1-0.228124999999999994E+00_dp)*0.355555555555555785E+02_dp - TG2 = (2*X2-0.203125000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.228124999999999994E+00_dp)*0.355555555555555785E+02_dp + TG2 = (2*X2 - 0.203125000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 4)) ELSE - TG1 = (2*X1-0.228124999999999994E+00_dp)*0.355555555555555785E+02_dp - TG2 = (2*X2-0.234375000000000000E+00_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.228124999999999994E+00_dp)*0.355555555555555785E+02_dp + TG2 = (2*X2 - 0.234375000000000000E+00_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 5)) ENDIF ELSE - TG1 = (2*X1-0.284374999999999989E+00_dp)*0.355555555555555429E+02_dp - TG2 = (2*X2-0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.284374999999999989E+00_dp)*0.355555555555555429E+02_dp + TG2 = (2*X2 - 0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 6)) ENDIF ENDIF ELSE - TG1 = (2*X1-0.368750000000000022E+00_dp)*0.177777777777777715E+02_dp - TG2 = (2*X2-0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.368750000000000022E+00_dp)*0.177777777777777715E+02_dp + TG2 = (2*X2 - 0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 7)) ENDIF ENDIF @@ -110,39 +110,39 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) IF (X1 <= 0.156250000000000000E+00_dp) THEN IF (X2 <= 0.156250000000000000E+00_dp) THEN IF (X1 <= 0.128124999999999989E+00_dp) THEN - TG1 = (2*X1-0.228124999999999994E+00_dp)*0.355555555555555785E+02_dp - TG2 = (2*X2-0.281250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.228124999999999994E+00_dp)*0.355555555555555785E+02_dp + TG2 = (2*X2 - 0.281250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 8)) ELSE - TG1 = (2*X1-0.284374999999999989E+00_dp)*0.355555555555555429E+02_dp - TG2 = (2*X2-0.281250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.284374999999999989E+00_dp)*0.355555555555555429E+02_dp + TG2 = (2*X2 - 0.281250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 9)) ENDIF ELSE IF (X1 <= 0.128124999999999989E+00_dp) THEN IF (X1 <= 0.114062499999999997E+00_dp) THEN - TG1 = (2*X1-0.214062499999999989E+00_dp)*0.711111111111111569E+02_dp - TG2 = (2*X2-0.343750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.214062499999999989E+00_dp)*0.711111111111111569E+02_dp + TG2 = (2*X2 - 0.343750000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 10)) ELSE - TG1 = (2*X1-0.242187500000000000E+00_dp)*0.711111111111111569E+02_dp - TG2 = (2*X2-0.343750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.242187500000000000E+00_dp)*0.711111111111111569E+02_dp + TG2 = (2*X2 - 0.343750000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 11)) ENDIF ELSE - TG1 = (2*X1-0.284374999999999989E+00_dp)*0.355555555555555429E+02_dp - TG2 = (2*X2-0.343750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.284374999999999989E+00_dp)*0.355555555555555429E+02_dp + TG2 = (2*X2 - 0.343750000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 12)) ENDIF ENDIF ELSE IF (X2 <= 0.156250000000000000E+00_dp) THEN - TG1 = (2*X1-0.368750000000000022E+00_dp)*0.177777777777777715E+02_dp - TG2 = (2*X2-0.281250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.368750000000000022E+00_dp)*0.177777777777777715E+02_dp + TG2 = (2*X2 - 0.281250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 13)) ELSE - TG1 = (2*X1-0.368750000000000022E+00_dp)*0.177777777777777715E+02_dp - TG2 = (2*X2-0.343750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.368750000000000022E+00_dp)*0.177777777777777715E+02_dp + TG2 = (2*X2 - 0.343750000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 14)) ENDIF ENDIF @@ -151,38 +151,38 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) IF (X1 <= 0.128124999999999989E+00_dp) THEN IF (X2 <= 0.218750000000000000E+00_dp) THEN IF (X1 <= 0.114062499999999997E+00_dp) THEN - TG1 = (2*X1-0.214062499999999989E+00_dp)*0.711111111111111569E+02_dp - TG2 = (2*X2-0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.214062499999999989E+00_dp)*0.711111111111111569E+02_dp + TG2 = (2*X2 - 0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 15)) ELSE - TG1 = (2*X1-0.242187500000000000E+00_dp)*0.711111111111111569E+02_dp - TG2 = (2*X2-0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.242187500000000000E+00_dp)*0.711111111111111569E+02_dp + TG2 = (2*X2 - 0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 16)) ENDIF ELSE - TG1 = (2*X1-0.228124999999999994E+00_dp)*0.355555555555555785E+02_dp - TG2 = (2*X2-0.468750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.228124999999999994E+00_dp)*0.355555555555555785E+02_dp + TG2 = (2*X2 - 0.468750000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 17)) ENDIF ELSE IF (X2 <= 0.218750000000000000E+00_dp) THEN - TG1 = (2*X1-0.284374999999999989E+00_dp)*0.355555555555555429E+02_dp - TG2 = (2*X2-0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.284374999999999989E+00_dp)*0.355555555555555429E+02_dp + TG2 = (2*X2 - 0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 18)) ELSE - TG1 = (2*X1-0.284374999999999989E+00_dp)*0.355555555555555429E+02_dp - TG2 = (2*X2-0.468750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.284374999999999989E+00_dp)*0.355555555555555429E+02_dp + TG2 = (2*X2 - 0.468750000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 19)) ENDIF ENDIF ELSE IF (X2 <= 0.218750000000000000E+00_dp) THEN - TG1 = (2*X1-0.368750000000000022E+00_dp)*0.177777777777777715E+02_dp - TG2 = (2*X2-0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.368750000000000022E+00_dp)*0.177777777777777715E+02_dp + TG2 = (2*X2 - 0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 20)) ELSE - TG1 = (2*X1-0.368750000000000022E+00_dp)*0.177777777777777715E+02_dp - TG2 = (2*X2-0.468750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.368750000000000022E+00_dp)*0.177777777777777715E+02_dp + TG2 = (2*X2 - 0.468750000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 21)) ENDIF ENDIF @@ -190,28 +190,28 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) ENDIF ELSE IF (X2 <= 0.125000000000000000E+00_dp) THEN - TG1 = (2*X1-0.537500000000000089E+00_dp)*0.888888888888888928E+01_dp - TG2 = (2*X2-0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.537500000000000089E+00_dp)*0.888888888888888928E+01_dp + TG2 = (2*X2 - 0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 22)) ELSE IF (X2 <= 0.187500000000000000E+00_dp) THEN IF (X1 <= 0.268750000000000044E+00_dp) THEN - TG1 = (2*X1-0.481250000000000067E+00_dp)*0.177777777777777715E+02_dp - TG2 = (2*X2-0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.481250000000000067E+00_dp)*0.177777777777777715E+02_dp + TG2 = (2*X2 - 0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 23)) ELSE - TG1 = (2*X1-0.593750000000000000E+00_dp)*0.177777777777777892E+02_dp - TG2 = (2*X2-0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.593750000000000000E+00_dp)*0.177777777777777892E+02_dp + TG2 = (2*X2 - 0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 24)) ENDIF ELSE IF (X1 <= 0.268750000000000044E+00_dp) THEN - TG1 = (2*X1-0.481250000000000067E+00_dp)*0.177777777777777715E+02_dp - TG2 = (2*X2-0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.481250000000000067E+00_dp)*0.177777777777777715E+02_dp + TG2 = (2*X2 - 0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 25)) ELSE - TG1 = (2*X1-0.593750000000000000E+00_dp)*0.177777777777777892E+02_dp - TG2 = (2*X2-0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.593750000000000000E+00_dp)*0.177777777777777892E+02_dp + TG2 = (2*X2 - 0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 26)) ENDIF ENDIF @@ -219,29 +219,29 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) ENDIF ELSE IF (X2 <= 0.125000000000000000E+00_dp) THEN - TG1 = (2*X1-0.875000000000000000E+00_dp)*0.444444444444444375E+01_dp - TG2 = (2*X2-0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.875000000000000000E+00_dp)*0.444444444444444375E+01_dp + TG2 = (2*X2 - 0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 27)) ELSE IF (X2 <= 0.187500000000000000E+00_dp) THEN - TG1 = (2*X1-0.875000000000000000E+00_dp)*0.444444444444444375E+01_dp - TG2 = (2*X2-0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.875000000000000000E+00_dp)*0.444444444444444375E+01_dp + TG2 = (2*X2 - 0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 28)) ELSE - TG1 = (2*X1-0.875000000000000000E+00_dp)*0.444444444444444375E+01_dp - TG2 = (2*X2-0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.875000000000000000E+00_dp)*0.444444444444444375E+01_dp + TG2 = (2*X2 - 0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 29)) ENDIF ENDIF ENDIF ELSE IF (X2 <= 0.125000000000000000E+00_dp) THEN - TG1 = (2*X1-0.155000000000000004E+01_dp)*0.222222222222222232E+01_dp - TG2 = (2*X2-0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.155000000000000004E+01_dp)*0.222222222222222232E+01_dp + TG2 = (2*X2 - 0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 30)) ELSE - TG1 = (2*X1-0.155000000000000004E+01_dp)*0.222222222222222232E+01_dp - TG2 = (2*X2-0.375000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.155000000000000004E+01_dp)*0.222222222222222232E+01_dp + TG2 = (2*X2 - 0.375000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 31)) ENDIF ENDIF @@ -253,67 +253,67 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) IF (X2 <= 0.375000000000000000E+00_dp) THEN IF (X1 <= 0.128124999999999989E+00_dp) THEN IF (X2 <= 0.312500000000000000E+00_dp) THEN - TG1 = (2*X1-0.228124999999999994E+00_dp)*0.355555555555555785E+02_dp - TG2 = (2*X2-0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.228124999999999994E+00_dp)*0.355555555555555785E+02_dp + TG2 = (2*X2 - 0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 32)) ELSE - TG1 = (2*X1-0.228124999999999994E+00_dp)*0.355555555555555785E+02_dp - TG2 = (2*X2-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.228124999999999994E+00_dp)*0.355555555555555785E+02_dp + TG2 = (2*X2 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 33)) ENDIF ELSE IF (X2 <= 0.312500000000000000E+00_dp) THEN IF (X2 <= 0.281250000000000000E+00_dp) THEN - TG1 = (2*X1-0.284374999999999989E+00_dp)*0.355555555555555429E+02_dp - TG2 = (2*X2-0.531250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.284374999999999989E+00_dp)*0.355555555555555429E+02_dp + TG2 = (2*X2 - 0.531250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 34)) ELSE - TG1 = (2*X1-0.284374999999999989E+00_dp)*0.355555555555555429E+02_dp - TG2 = (2*X2-0.593750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.284374999999999989E+00_dp)*0.355555555555555429E+02_dp + TG2 = (2*X2 - 0.593750000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 35)) ENDIF ELSE - TG1 = (2*X1-0.284374999999999989E+00_dp)*0.355555555555555429E+02_dp - TG2 = (2*X2-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.284374999999999989E+00_dp)*0.355555555555555429E+02_dp + TG2 = (2*X2 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 36)) ENDIF ENDIF ELSE - TG1 = (2*X1-0.256249999999999978E+00_dp)*0.177777777777777786E+02_dp - TG2 = (2*X2-0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.256249999999999978E+00_dp)*0.177777777777777786E+02_dp + TG2 = (2*X2 - 0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 37)) ENDIF ELSE IF (X2 <= 0.375000000000000000E+00_dp) THEN IF (X2 <= 0.312500000000000000E+00_dp) THEN IF (X1 <= 0.184375000000000011E+00_dp) THEN - TG1 = (2*X1-0.340625000000000011E+00_dp)*0.355555555555555429E+02_dp - TG2 = (2*X2-0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.340625000000000011E+00_dp)*0.355555555555555429E+02_dp + TG2 = (2*X2 - 0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 38)) ELSE - TG1 = (2*X1-0.396875000000000033E+00_dp)*0.355555555555555429E+02_dp - TG2 = (2*X2-0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.396875000000000033E+00_dp)*0.355555555555555429E+02_dp + TG2 = (2*X2 - 0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 39)) ENDIF ELSE IF (X1 <= 0.184375000000000011E+00_dp) THEN - TG1 = (2*X1-0.340625000000000011E+00_dp)*0.355555555555555429E+02_dp - TG2 = (2*X2-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.340625000000000011E+00_dp)*0.355555555555555429E+02_dp + TG2 = (2*X2 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 40)) ELSE - TG1 = (2*X1-0.396875000000000033E+00_dp)*0.355555555555555429E+02_dp - TG2 = (2*X2-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.396875000000000033E+00_dp)*0.355555555555555429E+02_dp + TG2 = (2*X2 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 41)) ENDIF ENDIF ELSE IF (X1 <= 0.184375000000000011E+00_dp) THEN - TG1 = (2*X1-0.340625000000000011E+00_dp)*0.355555555555555429E+02_dp - TG2 = (2*X2-0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.340625000000000011E+00_dp)*0.355555555555555429E+02_dp + TG2 = (2*X2 - 0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 42)) ELSE - TG1 = (2*X1-0.396875000000000033E+00_dp)*0.355555555555555429E+02_dp - TG2 = (2*X2-0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.396875000000000033E+00_dp)*0.355555555555555429E+02_dp + TG2 = (2*X2 - 0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 43)) ENDIF ENDIF @@ -322,33 +322,33 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) IF (X2 <= 0.375000000000000000E+00_dp) THEN IF (X2 <= 0.312500000000000000E+00_dp) THEN IF (X1 <= 0.268750000000000044E+00_dp) THEN - TG1 = (2*X1-0.481250000000000067E+00_dp)*0.177777777777777715E+02_dp - TG2 = (2*X2-0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.481250000000000067E+00_dp)*0.177777777777777715E+02_dp + TG2 = (2*X2 - 0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 44)) ELSE - TG1 = (2*X1-0.593750000000000000E+00_dp)*0.177777777777777892E+02_dp - TG2 = (2*X2-0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.593750000000000000E+00_dp)*0.177777777777777892E+02_dp + TG2 = (2*X2 - 0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 45)) ENDIF ELSE IF (X1 <= 0.268750000000000044E+00_dp) THEN - TG1 = (2*X1-0.481250000000000067E+00_dp)*0.177777777777777715E+02_dp - TG2 = (2*X2-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.481250000000000067E+00_dp)*0.177777777777777715E+02_dp + TG2 = (2*X2 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 46)) ELSE - TG1 = (2*X1-0.593750000000000000E+00_dp)*0.177777777777777892E+02_dp - TG2 = (2*X2-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.593750000000000000E+00_dp)*0.177777777777777892E+02_dp + TG2 = (2*X2 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 47)) ENDIF ENDIF ELSE IF (X1 <= 0.268750000000000044E+00_dp) THEN - TG1 = (2*X1-0.481250000000000067E+00_dp)*0.177777777777777715E+02_dp - TG2 = (2*X2-0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.481250000000000067E+00_dp)*0.177777777777777715E+02_dp + TG2 = (2*X2 - 0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 48)) ELSE - TG1 = (2*X1-0.593750000000000000E+00_dp)*0.177777777777777892E+02_dp - TG2 = (2*X2-0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.593750000000000000E+00_dp)*0.177777777777777892E+02_dp + TG2 = (2*X2 - 0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 49)) ENDIF ENDIF @@ -356,33 +356,33 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) ELSE IF (X2 <= 0.375000000000000000E+00_dp) THEN IF (X1 <= 0.437500000000000000E+00_dp) THEN - TG1 = (2*X1-0.762499999999999956E+00_dp)*0.888888888888888928E+01_dp - TG2 = (2*X2-0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.762499999999999956E+00_dp)*0.888888888888888928E+01_dp + TG2 = (2*X2 - 0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 50)) ELSE - TG1 = (2*X1-0.987500000000000044E+00_dp)*0.888888888888888573E+01_dp - TG2 = (2*X2-0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.987500000000000044E+00_dp)*0.888888888888888573E+01_dp + TG2 = (2*X2 - 0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 51)) ENDIF ELSE IF (X2 <= 0.437500000000000000E+00_dp) THEN IF (X1 <= 0.437500000000000000E+00_dp) THEN - TG1 = (2*X1-0.762499999999999956E+00_dp)*0.888888888888888928E+01_dp - TG2 = (2*X2-0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.762499999999999956E+00_dp)*0.888888888888888928E+01_dp + TG2 = (2*X2 - 0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 52)) ELSE - TG1 = (2*X1-0.987500000000000044E+00_dp)*0.888888888888888573E+01_dp - TG2 = (2*X2-0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.987500000000000044E+00_dp)*0.888888888888888573E+01_dp + TG2 = (2*X2 - 0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 53)) ENDIF ELSE IF (X1 <= 0.437500000000000000E+00_dp) THEN - TG1 = (2*X1-0.762499999999999956E+00_dp)*0.888888888888888928E+01_dp - TG2 = (2*X2-0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.762499999999999956E+00_dp)*0.888888888888888928E+01_dp + TG2 = (2*X2 - 0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 54)) ELSE - TG1 = (2*X1-0.987500000000000044E+00_dp)*0.888888888888888573E+01_dp - TG2 = (2*X2-0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.987500000000000044E+00_dp)*0.888888888888888573E+01_dp + TG2 = (2*X2 - 0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 55)) ENDIF ENDIF @@ -391,27 +391,27 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) ELSE IF (X2 <= 0.375000000000000000E+00_dp) THEN IF (X2 <= 0.312500000000000000E+00_dp) THEN - TG1 = (2*X1-0.155000000000000004E+01_dp)*0.222222222222222232E+01_dp - TG2 = (2*X2-0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.155000000000000004E+01_dp)*0.222222222222222232E+01_dp + TG2 = (2*X2 - 0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 56)) ELSE - TG1 = (2*X1-0.155000000000000004E+01_dp)*0.222222222222222232E+01_dp - TG2 = (2*X2-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.155000000000000004E+01_dp)*0.222222222222222232E+01_dp + TG2 = (2*X2 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 57)) ENDIF ELSE IF (X2 <= 0.437500000000000000E+00_dp) THEN - TG1 = (2*X1-0.155000000000000004E+01_dp)*0.222222222222222232E+01_dp - TG2 = (2*X2-0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.155000000000000004E+01_dp)*0.222222222222222232E+01_dp + TG2 = (2*X2 - 0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 58)) ELSE IF (X1 <= 0.775000000000000022E+00_dp) THEN - TG1 = (2*X1-0.132500000000000018E+01_dp)*0.444444444444444464E+01_dp - TG2 = (2*X2-0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.132500000000000018E+01_dp)*0.444444444444444464E+01_dp + TG2 = (2*X2 - 0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 59)) ELSE - TG1 = (2*X1-0.177499999999999991E+01_dp)*0.444444444444444464E+01_dp - TG2 = (2*X2-0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.177499999999999991E+01_dp)*0.444444444444444464E+01_dp + TG2 = (2*X2 - 0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 60)) ENDIF ENDIF @@ -424,39 +424,39 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) IF (X1 <= 0.212500000000000022E+00_dp) THEN IF (X2 <= 0.750000000000000000E+00_dp) THEN IF (X1 <= 0.156250000000000000E+00_dp) THEN - TG1 = (2*X1-0.256249999999999978E+00_dp)*0.177777777777777786E+02_dp - TG2 = (2*X2-0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.256249999999999978E+00_dp)*0.177777777777777786E+02_dp + TG2 = (2*X2 - 0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 61)) ELSE - TG1 = (2*X1-0.368750000000000022E+00_dp)*0.177777777777777715E+02_dp - TG2 = (2*X2-0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.368750000000000022E+00_dp)*0.177777777777777715E+02_dp + TG2 = (2*X2 - 0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 62)) ENDIF ELSE - TG1 = (2*X1-0.312500000000000000E+00_dp)*0.888888888888888751E+01_dp - TG2 = (2*X2-0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.312500000000000000E+00_dp)*0.888888888888888751E+01_dp + TG2 = (2*X2 - 0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 63)) ENDIF ELSE IF (X2 <= 0.750000000000000000E+00_dp) THEN IF (X2 <= 0.625000000000000000E+00_dp) THEN IF (X1 <= 0.268750000000000044E+00_dp) THEN - TG1 = (2*X1-0.481250000000000067E+00_dp)*0.177777777777777715E+02_dp - TG2 = (2*X2-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.481250000000000067E+00_dp)*0.177777777777777715E+02_dp + TG2 = (2*X2 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 64)) ELSE - TG1 = (2*X1-0.593750000000000000E+00_dp)*0.177777777777777892E+02_dp - TG2 = (2*X2-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.593750000000000000E+00_dp)*0.177777777777777892E+02_dp + TG2 = (2*X2 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 65)) ENDIF ELSE - TG1 = (2*X1-0.537500000000000089E+00_dp)*0.888888888888888928E+01_dp - TG2 = (2*X2-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.537500000000000089E+00_dp)*0.888888888888888928E+01_dp + TG2 = (2*X2 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 66)) ENDIF ELSE - TG1 = (2*X1-0.537500000000000089E+00_dp)*0.888888888888888928E+01_dp - TG2 = (2*X2-0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.537500000000000089E+00_dp)*0.888888888888888928E+01_dp + TG2 = (2*X2 - 0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 67)) ENDIF ENDIF @@ -464,33 +464,33 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) IF (X2 <= 0.750000000000000000E+00_dp) THEN IF (X2 <= 0.625000000000000000E+00_dp) THEN IF (X1 <= 0.437500000000000000E+00_dp) THEN - TG1 = (2*X1-0.762499999999999956E+00_dp)*0.888888888888888928E+01_dp - TG2 = (2*X2-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.762499999999999956E+00_dp)*0.888888888888888928E+01_dp + TG2 = (2*X2 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 68)) ELSE - TG1 = (2*X1-0.987500000000000044E+00_dp)*0.888888888888888573E+01_dp - TG2 = (2*X2-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.987500000000000044E+00_dp)*0.888888888888888573E+01_dp + TG2 = (2*X2 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 69)) ENDIF ELSE IF (X1 <= 0.437500000000000000E+00_dp) THEN - TG1 = (2*X1-0.762499999999999956E+00_dp)*0.888888888888888928E+01_dp - TG2 = (2*X2-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.762499999999999956E+00_dp)*0.888888888888888928E+01_dp + TG2 = (2*X2 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 70)) ELSE - TG1 = (2*X1-0.987500000000000044E+00_dp)*0.888888888888888573E+01_dp - TG2 = (2*X2-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.987500000000000044E+00_dp)*0.888888888888888573E+01_dp + TG2 = (2*X2 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 71)) ENDIF ENDIF ELSE IF (X1 <= 0.437500000000000000E+00_dp) THEN - TG1 = (2*X1-0.762499999999999956E+00_dp)*0.888888888888888928E+01_dp - TG2 = (2*X2-0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.762499999999999956E+00_dp)*0.888888888888888928E+01_dp + TG2 = (2*X2 - 0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 72)) ELSE - TG1 = (2*X1-0.987500000000000044E+00_dp)*0.888888888888888573E+01_dp - TG2 = (2*X2-0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.987500000000000044E+00_dp)*0.888888888888888573E+01_dp + TG2 = (2*X2 - 0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 73)) ENDIF ENDIF @@ -499,33 +499,33 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) IF (X2 <= 0.750000000000000000E+00_dp) THEN IF (X2 <= 0.625000000000000000E+00_dp) THEN IF (X1 <= 0.775000000000000022E+00_dp) THEN - TG1 = (2*X1-0.132500000000000018E+01_dp)*0.444444444444444464E+01_dp - TG2 = (2*X2-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.132500000000000018E+01_dp)*0.444444444444444464E+01_dp + TG2 = (2*X2 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 74)) ELSE - TG1 = (2*X1-0.177499999999999991E+01_dp)*0.444444444444444464E+01_dp - TG2 = (2*X2-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.177499999999999991E+01_dp)*0.444444444444444464E+01_dp + TG2 = (2*X2 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 75)) ENDIF ELSE IF (X1 <= 0.775000000000000022E+00_dp) THEN - TG1 = (2*X1-0.132500000000000018E+01_dp)*0.444444444444444464E+01_dp - TG2 = (2*X2-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.132500000000000018E+01_dp)*0.444444444444444464E+01_dp + TG2 = (2*X2 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 76)) ELSE - TG1 = (2*X1-0.177499999999999991E+01_dp)*0.444444444444444464E+01_dp - TG2 = (2*X2-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.177499999999999991E+01_dp)*0.444444444444444464E+01_dp + TG2 = (2*X2 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 77)) ENDIF ENDIF ELSE IF (X2 <= 0.875000000000000000E+00_dp) THEN - TG1 = (2*X1-0.155000000000000004E+01_dp)*0.222222222222222232E+01_dp - TG2 = (2*X2-0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.155000000000000004E+01_dp)*0.222222222222222232E+01_dp + TG2 = (2*X2 - 0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 78)) ELSE - TG1 = (2*X1-0.155000000000000004E+01_dp)*0.222222222222222232E+01_dp - TG2 = (2*X2-0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.155000000000000004E+01_dp)*0.222222222222222232E+01_dp + TG2 = (2*X2 - 0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 79)) ENDIF ENDIF @@ -533,34 +533,34 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) ENDIF ELSE X1 = SQRT(81.0_dp/T) - lower = (SQRT(T)-SQRT(eps))/n + lower = (SQRT(T) - SQRT(eps))/n IF (R >= lower) THEN X2 = lower/R IF (X2 <= 0.500000000000000000E+00_dp) THEN IF (X1 <= 0.500000000000000000E+00_dp) THEN IF (X2 <= 0.250000000000000000E+00_dp) THEN - TG1 = (2*X1-0.500000000000000000E+00_dp)*0.200000000000000000E+01_dp - TG2 = (2*X2-0.250000000000000000E+00_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.500000000000000000E+00_dp)*0.200000000000000000E+01_dp + TG2 = (2*X2 - 0.250000000000000000E+00_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 80)) ELSE IF (X2 <= 0.375000000000000000E+00_dp) THEN IF (X1 <= 0.250000000000000000E+00_dp) THEN - TG1 = (2*X1-0.250000000000000000E+00_dp)*0.400000000000000000E+01_dp - TG2 = (2*X2-0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.250000000000000000E+00_dp)*0.400000000000000000E+01_dp + TG2 = (2*X2 - 0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 81)) ELSE IF (X2 <= 0.312500000000000000E+00_dp) THEN - TG1 = (2*X1-0.750000000000000000E+00_dp)*0.400000000000000000E+01_dp - TG2 = (2*X2-0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.750000000000000000E+00_dp)*0.400000000000000000E+01_dp + TG2 = (2*X2 - 0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 82)) ELSE IF (X1 <= 0.375000000000000000E+00_dp) THEN - TG1 = (2*X1-0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 83)) ELSE - TG1 = (2*X1-0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 84)) ENDIF ENDIF @@ -569,33 +569,33 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) IF (X1 <= 0.250000000000000000E+00_dp) THEN IF (X2 <= 0.437500000000000000E+00_dp) THEN IF (X1 <= 0.125000000000000000E+00_dp) THEN - TG1 = (2*X1-0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 85)) ELSE - TG1 = (2*X1-0.375000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.375000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 86)) ENDIF ELSE IF (X1 <= 0.125000000000000000E+00_dp) THEN IF (X2 <= 0.468750000000000000E+00_dp) THEN - TG1 = (2*X1-0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.906250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.906250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 87)) ELSE - TG1 = (2*X1-0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.968750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.968750000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 88)) ENDIF ELSE IF (X2 <= 0.468750000000000000E+00_dp) THEN - TG1 = (2*X1-0.375000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.906250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.375000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.906250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 89)) ELSE - TG1 = (2*X1-0.375000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.968750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.375000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.968750000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 90)) ENDIF ENDIF @@ -604,22 +604,22 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) IF (X2 <= 0.437500000000000000E+00_dp) THEN IF (X2 <= 0.406250000000000000E+00_dp) THEN IF (X1 <= 0.375000000000000000E+00_dp) THEN - TG1 = (2*X1-0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.781250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.781250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 91)) ELSE - TG1 = (2*X1-0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.781250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.781250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 92)) ENDIF ELSE - TG1 = (2*X1-0.750000000000000000E+00_dp)*0.400000000000000000E+01_dp - TG2 = (2*X2-0.843750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.750000000000000000E+00_dp)*0.400000000000000000E+01_dp + TG2 = (2*X2 - 0.843750000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 93)) ENDIF ELSE - TG1 = (2*X1-0.750000000000000000E+00_dp)*0.400000000000000000E+01_dp - TG2 = (2*X2-0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.750000000000000000E+00_dp)*0.400000000000000000E+01_dp + TG2 = (2*X2 - 0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 94)) ENDIF ENDIF @@ -628,28 +628,28 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) ELSE IF (X2 <= 0.250000000000000000E+00_dp) THEN IF (X2 <= 0.125000000000000000E+00_dp) THEN - TG1 = (2*X1-0.150000000000000000E+01_dp)*0.200000000000000000E+01_dp - TG2 = (2*X2-0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.150000000000000000E+01_dp)*0.200000000000000000E+01_dp + TG2 = (2*X2 - 0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 95)) ELSE IF (X2 <= 0.187500000000000000E+00_dp) THEN IF (X1 <= 0.750000000000000000E+00_dp) THEN - TG1 = (2*X1-0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp - TG2 = (2*X2-0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG2 = (2*X2 - 0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 96)) ELSE IF (X1 <= 0.875000000000000000E+00_dp) THEN - TG1 = (2*X1-0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 97)) ELSE IF (X2 <= 0.156250000000000000E+00_dp) THEN - TG1 = (2*X1-0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.281250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.281250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 98)) ELSE - TG1 = (2*X1-0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.343750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.343750000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 99)) ENDIF ENDIF @@ -657,33 +657,33 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) ELSE IF (X1 <= 0.750000000000000000E+00_dp) THEN IF (X1 <= 0.625000000000000000E+00_dp) THEN - TG1 = (2*X1-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 100)) ELSE - TG1 = (2*X1-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 101)) ENDIF ELSE IF (X1 <= 0.875000000000000000E+00_dp) THEN IF (X2 <= 0.218750000000000000E+00_dp) THEN - TG1 = (2*X1-0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 102)) ELSE - TG1 = (2*X1-0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.468750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.468750000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 103)) ENDIF ELSE IF (X2 <= 0.218750000000000000E+00_dp) THEN - TG1 = (2*X1-0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.406250000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 104)) ELSE - TG1 = (2*X1-0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.468750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.468750000000000000E+00_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 105)) ENDIF ENDIF @@ -695,49 +695,49 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) IF (X1 <= 0.750000000000000000E+00_dp) THEN IF (X2 <= 0.312500000000000000E+00_dp) THEN IF (X1 <= 0.625000000000000000E+00_dp) THEN - TG1 = (2*X1-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 106)) ELSE - TG1 = (2*X1-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 107)) ENDIF ELSE IF (X1 <= 0.625000000000000000E+00_dp) THEN - TG1 = (2*X1-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 108)) ELSE - TG1 = (2*X1-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 109)) ENDIF ENDIF ELSE IF (X2 <= 0.312500000000000000E+00_dp) THEN IF (X1 <= 0.875000000000000000E+00_dp) THEN - TG1 = (2*X1-0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 110)) ELSE - TG1 = (2*X1-0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 111)) ENDIF ELSE IF (X1 <= 0.875000000000000000E+00_dp) THEN - TG1 = (2*X1-0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 112)) ELSE IF (X1 <= 0.937500000000000000E+00_dp) THEN - TG1 = (2*X1-0.181250000000000000E+01_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.181250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 113)) ELSE - TG1 = (2*X1-0.193750000000000000E+01_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.193750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 114)) ENDIF ENDIF @@ -746,17 +746,17 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) ELSE IF (X1 <= 0.750000000000000000E+00_dp) THEN IF (X1 <= 0.625000000000000000E+00_dp) THEN - TG1 = (2*X1-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 115)) ELSE IF (X2 <= 0.437500000000000000E+00_dp) THEN - TG1 = (2*X1-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 116)) ELSE - TG1 = (2*X1-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 117)) ENDIF ENDIF @@ -764,33 +764,33 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) IF (X1 <= 0.875000000000000000E+00_dp) THEN IF (X2 <= 0.437500000000000000E+00_dp) THEN IF (X1 <= 0.812500000000000000E+00_dp) THEN - TG1 = (2*X1-0.156250000000000000E+01_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.156250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 118)) ELSE - TG1 = (2*X1-0.168750000000000000E+01_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.168750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 119)) ENDIF ELSE - TG1 = (2*X1-0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 120)) ENDIF ELSE IF (X2 <= 0.437500000000000000E+00_dp) THEN IF (X1 <= 0.937500000000000000E+00_dp) THEN - TG1 = (2*X1-0.181250000000000000E+01_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.181250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 121)) ELSE - TG1 = (2*X1-0.193750000000000000E+01_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.193750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 122)) ENDIF ELSE - TG1 = (2*X1-0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 123)) ENDIF ENDIF @@ -802,45 +802,45 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) IF (X1 <= 0.500000000000000000E+00_dp) THEN IF (X2 <= 0.750000000000000000E+00_dp) THEN IF (X1 <= 0.250000000000000000E+00_dp) THEN - TG1 = (2*X1-0.250000000000000000E+00_dp)*0.400000000000000000E+01_dp - TG2 = (2*X2-0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.250000000000000000E+00_dp)*0.400000000000000000E+01_dp + TG2 = (2*X2 - 0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 124)) ELSE IF (X2 <= 0.625000000000000000E+00_dp) THEN IF (X1 <= 0.375000000000000000E+00_dp) THEN - TG1 = (2*X1-0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 125)) ELSE - TG1 = (2*X1-0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 126)) ENDIF ELSE IF (X1 <= 0.375000000000000000E+00_dp) THEN IF (X2 <= 0.687500000000000000E+00_dp) THEN - TG1 = (2*X1-0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.131250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.131250000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 127)) ELSE - TG1 = (2*X1-0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.143750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.143750000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 128)) ENDIF ELSE IF (X2 <= 0.687500000000000000E+00_dp) THEN IF (X1 <= 0.437500000000000000E+00_dp) THEN - TG1 = (2*X1-0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.131250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.812500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.131250000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 129)) ELSE - TG1 = (2*X1-0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.131250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.937500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.131250000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 130)) ENDIF ELSE - TG1 = (2*X1-0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.143750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.143750000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 131)) ENDIF ENDIF @@ -850,22 +850,22 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) IF (X1 <= 0.250000000000000000E+00_dp) THEN IF (X2 <= 0.875000000000000000E+00_dp) THEN IF (X1 <= 0.125000000000000000E+00_dp) THEN - TG1 = (2*X1-0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.125000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 132)) ELSE IF (X2 <= 0.812500000000000000E+00_dp) THEN - TG1 = (2*X1-0.375000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.156250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.375000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.156250000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 133)) ELSE IF (X1 <= 0.187500000000000000E+00_dp) THEN - TG1 = (2*X1-0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.168750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.168750000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 134)) ELSE - TG1 = (2*X1-0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.168750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.168750000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 135)) ENDIF ENDIF @@ -874,17 +874,17 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) IF (X1 <= 0.125000000000000000E+00_dp) THEN IF (X2 <= 0.937500000000000000E+00_dp) THEN IF (X1 <= 0.625000000000000000E-01_dp) THEN - TG1 = (2*X1-0.625000000000000000E-01_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.181250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.625000000000000000E-01_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.181250000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 136)) ELSE IF (X2 <= 0.906250000000000000E+00_dp) THEN - TG1 = (2*X1-0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.178125000000000000E+01_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.178125000000000000E+01_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 137)) ELSE - TG1 = (2*X1-0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.184375000000000000E+01_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.184375000000000000E+01_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 138)) ENDIF ENDIF @@ -892,45 +892,45 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) IF (X1 <= 0.625000000000000000E-01_dp) THEN IF (X2 <= 0.968750000000000000E+00_dp) THEN IF (X1 <= 0.312500000000000000E-01_dp) THEN - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.190625000000000000E+01_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.190625000000000000E+01_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 139)) ELSE - TG1 = (2*X1-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.190625000000000000E+01_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.190625000000000000E+01_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 140)) ENDIF ELSE IF (X1 <= 0.312500000000000000E-01_dp) THEN IF (X2 <= 0.984375000000000000E+00_dp) THEN - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.195312500000000000E+01_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.195312500000000000E+01_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 141)) ELSE - TG1 = (2*X1-0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.198437500000000000E+01_dp)*0.640000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.198437500000000000E+01_dp)*0.640000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 142)) ENDIF ELSE - TG1 = (2*X1-0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.196875000000000000E+01_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.937500000000000000E-01_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.196875000000000000E+01_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 143)) ENDIF ENDIF ELSE IF (X2 <= 0.968750000000000000E+00_dp) THEN IF (X1 <= 0.937500000000000000E-01_dp) THEN - TG1 = (2*X1-0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.190625000000000000E+01_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.156250000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.190625000000000000E+01_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 144)) ELSE - TG1 = (2*X1-0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp - TG2 = (2*X2-0.190625000000000000E+01_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.218750000000000000E+00_dp)*0.320000000000000000E+02_dp + TG2 = (2*X2 - 0.190625000000000000E+01_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 145)) ENDIF ELSE - TG1 = (2*X1-0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.196875000000000000E+01_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.187500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.196875000000000000E+01_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 146)) ENDIF ENDIF @@ -939,22 +939,22 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) IF (X2 <= 0.937500000000000000E+00_dp) THEN IF (X1 <= 0.187500000000000000E+00_dp) THEN IF (X2 <= 0.906250000000000000E+00_dp) THEN - TG1 = (2*X1-0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.178125000000000000E+01_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.178125000000000000E+01_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 147)) ELSE - TG1 = (2*X1-0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.184375000000000000E+01_dp)*0.320000000000000000E+02_dp + TG1 = (2*X1 - 0.312500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.184375000000000000E+01_dp)*0.320000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 148)) ENDIF ELSE - TG1 = (2*X1-0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.181250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.437500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.181250000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 149)) ENDIF ELSE - TG1 = (2*X1-0.375000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.193750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.375000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.193750000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 150)) ENDIF ENDIF @@ -964,33 +964,33 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) IF (X1 <= 0.375000000000000000E+00_dp) THEN IF (X2 <= 0.812500000000000000E+00_dp) THEN IF (X1 <= 0.312500000000000000E+00_dp) THEN - TG1 = (2*X1-0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.156250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.562500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.156250000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 151)) ELSE - TG1 = (2*X1-0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.156250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.687500000000000000E+00_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.156250000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 152)) ENDIF ELSE - TG1 = (2*X1-0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.168750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.625000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.168750000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 153)) ENDIF ELSE IF (X2 <= 0.812500000000000000E+00_dp) THEN - TG1 = (2*X1-0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.156250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.156250000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 154)) ELSE - TG1 = (2*X1-0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.168750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.875000000000000000E+00_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.168750000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 155)) ENDIF ENDIF ELSE - TG1 = (2*X1-0.750000000000000000E+00_dp)*0.400000000000000000E+01_dp - TG2 = (2*X2-0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.750000000000000000E+00_dp)*0.400000000000000000E+01_dp + TG2 = (2*X2 - 0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 156)) ENDIF ENDIF @@ -1001,45 +1001,45 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) IF (X2 <= 0.625000000000000000E+00_dp) THEN IF (X1 <= 0.625000000000000000E+00_dp) THEN IF (X2 <= 0.562500000000000000E+00_dp) THEN - TG1 = (2*X1-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.106250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.106250000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 157)) ELSE IF (X1 <= 0.562500000000000000E+00_dp) THEN - TG1 = (2*X1-0.106250000000000000E+01_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.118750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.106250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.118750000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 158)) ELSE - TG1 = (2*X1-0.118750000000000000E+01_dp)*0.160000000000000000E+02_dp - TG2 = (2*X2-0.118750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.118750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG2 = (2*X2 - 0.118750000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 159)) ENDIF ENDIF ELSE IF (X2 <= 0.562500000000000000E+00_dp) THEN - TG1 = (2*X1-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.106250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.106250000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 160)) ELSE - TG1 = (2*X1-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.118750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.118750000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 161)) ENDIF ENDIF ELSE IF (X1 <= 0.625000000000000000E+00_dp) THEN IF (X2 <= 0.687500000000000000E+00_dp) THEN - TG1 = (2*X1-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.131250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.131250000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 162)) ELSE - TG1 = (2*X1-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.143750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.143750000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 163)) ENDIF ELSE - TG1 = (2*X1-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 164)) ENDIF ENDIF @@ -1047,33 +1047,33 @@ SUBROUTINE trunc_CS_poly_n20(RES, R, T, NDERIV) IF (X2 <= 0.625000000000000000E+00_dp) THEN IF (X1 <= 0.875000000000000000E+00_dp) THEN IF (X2 <= 0.562500000000000000E+00_dp) THEN - TG1 = (2*X1-0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.106250000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.106250000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 165)) ELSE - TG1 = (2*X1-0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.118750000000000000E+01_dp)*0.160000000000000000E+02_dp + TG1 = (2*X1 - 0.162500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.118750000000000000E+01_dp)*0.160000000000000000E+02_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 166)) ENDIF ELSE - TG1 = (2*X1-0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp - TG2 = (2*X2-0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.187500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG2 = (2*X2 - 0.112500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 167)) ENDIF ELSE - TG1 = (2*X1-0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp - TG2 = (2*X2-0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp + TG1 = (2*X1 - 0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG2 = (2*X2 - 0.137500000000000000E+01_dp)*0.800000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 168)) ENDIF ENDIF ELSE IF (X1 <= 0.750000000000000000E+00_dp) THEN - TG1 = (2*X1-0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp - TG2 = (2*X2-0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.125000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG2 = (2*X2 - 0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 169)) ELSE - TG1 = (2*X1-0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp - TG2 = (2*X2-0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG1 = (2*X1 - 0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp + TG2 = (2*X2 - 0.175000000000000000E+01_dp)*0.400000000000000000E+01_dp CALL PD2VAL(RES, NDERIV, TG1, TG2, C0(1, 170)) ENDIF ENDIF @@ -1107,14 +1107,14 @@ SUBROUTINE INIT(Nder, iunit, mepos, group) nderiv_init = Nder IF (ALLOCATED(C0)) DEALLOCATE (C0) ! round up to a multiple of 32 to give some generous alignment for each C0 - ALLOCATE (C0(32*((31+(Nder+1)*(degree+1)*(degree+2)/2)/32), patches)) + ALLOCATE (C0(32*((31 + (Nder + 1)*(degree + 1)*(degree + 2)/2)/32), patches)) ! valgrind workaround C0 = HUGE(0.0_dp) IF (mepos == 0) THEN - ALLOCATE (chunk((nderiv_max+1)*(degree+1)*(degree+2)/2)) + ALLOCATE (chunk((nderiv_max + 1)*(degree + 1)*(degree + 2)/2)) DO I = 1, patches READ (iunit, *) chunk - C0(1:(Nder+1)*(degree+1)*(degree+2)/2, I) = chunk(1:(Nder+1)*(degree+1)*(degree+2)/2) + C0(1:(Nder + 1)*(degree + 1)*(degree + 2)/2, I) = chunk(1:(Nder + 1)*(degree + 1)*(degree + 2)/2) ENDDO DEALLOCATE (chunk) END IF @@ -1150,52 +1150,52 @@ SUBROUTINE PD2VAL(RES, NDERIV, TG1, TG2, C0) T2(0) = 1.0_dp T1(1) = SQRT2*TG1 T2(1) = SQRT2*TG2 - T1(2) = 2*TG1*T1(1)-SQRT2 - T2(2) = 2*TG2*T2(1)-SQRT2 - T1(3) = 2*TG1*T1(2)-T1(1) - T2(3) = 2*TG2*T2(2)-T2(1) - T1(4) = 2*TG1*T1(3)-T1(2) - T2(4) = 2*TG2*T2(3)-T2(2) - T1(5) = 2*TG1*T1(4)-T1(3) - T2(5) = 2*TG2*T2(4)-T2(3) - T1(6) = 2*TG1*T1(5)-T1(4) - T2(6) = 2*TG2*T2(5)-T2(4) - T1(7) = 2*TG1*T1(6)-T1(5) - T2(7) = 2*TG2*T2(6)-T2(5) - T1(8) = 2*TG1*T1(7)-T1(6) - T2(8) = 2*TG2*T2(7)-T2(6) - T1(9) = 2*TG1*T1(8)-T1(7) - T2(9) = 2*TG2*T2(8)-T2(7) - T1(10) = 2*TG1*T1(9)-T1(8) - T2(10) = 2*TG2*T2(9)-T2(8) - T1(11) = 2*TG1*T1(10)-T1(9) - T2(11) = 2*TG2*T2(10)-T2(9) - T1(12) = 2*TG1*T1(11)-T1(10) - T2(12) = 2*TG2*T2(11)-T2(10) - T1(13) = 2*TG1*T1(12)-T1(11) - T2(13) = 2*TG2*T2(12)-T2(11) - T1(14) = 2*TG1*T1(13)-T1(12) - T2(14) = 2*TG2*T2(13)-T2(12) - T1(15) = 2*TG1*T1(14)-T1(13) - T2(15) = 2*TG2*T2(14)-T2(13) - DO K = 1, NDERIV+1 + T1(2) = 2*TG1*T1(1) - SQRT2 + T2(2) = 2*TG2*T2(1) - SQRT2 + T1(3) = 2*TG1*T1(2) - T1(1) + T2(3) = 2*TG2*T2(2) - T2(1) + T1(4) = 2*TG1*T1(3) - T1(2) + T2(4) = 2*TG2*T2(3) - T2(2) + T1(5) = 2*TG1*T1(4) - T1(3) + T2(5) = 2*TG2*T2(4) - T2(3) + T1(6) = 2*TG1*T1(5) - T1(4) + T2(6) = 2*TG2*T2(5) - T2(4) + T1(7) = 2*TG1*T1(6) - T1(5) + T2(7) = 2*TG2*T2(6) - T2(5) + T1(8) = 2*TG1*T1(7) - T1(6) + T2(8) = 2*TG2*T2(7) - T2(6) + T1(9) = 2*TG1*T1(8) - T1(7) + T2(9) = 2*TG2*T2(8) - T2(7) + T1(10) = 2*TG1*T1(9) - T1(8) + T2(10) = 2*TG2*T2(9) - T2(8) + T1(11) = 2*TG1*T1(10) - T1(9) + T2(11) = 2*TG2*T2(10) - T2(9) + T1(12) = 2*TG1*T1(11) - T1(10) + T2(12) = 2*TG2*T2(11) - T2(10) + T1(13) = 2*TG1*T1(12) - T1(11) + T2(13) = 2*TG2*T2(12) - T2(11) + T1(14) = 2*TG1*T1(13) - T1(12) + T2(14) = 2*TG2*T2(13) - T2(12) + T1(15) = 2*TG1*T1(14) - T1(13) + T2(15) = 2*TG2*T2(14) - T2(13) + DO K = 1, NDERIV + 1 RES(K) = 0.0_dp - RES(K) = RES(K)+DOT_PRODUCT(T1(0:15), C0(1:16, K))*T2(0) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:14), C0(17:31, K))*T2(1) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:13), C0(32:45, K))*T2(2) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:12), C0(46:58, K))*T2(3) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:11), C0(59:70, K))*T2(4) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:10), C0(71:81, K))*T2(5) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:9), C0(82:91, K))*T2(6) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:8), C0(92:100, K))*T2(7) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:7), C0(101:108, K))*T2(8) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:6), C0(109:115, K))*T2(9) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:5), C0(116:121, K))*T2(10) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:4), C0(122:126, K))*T2(11) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:3), C0(127:130, K))*T2(12) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:2), C0(131:133, K))*T2(13) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:1), C0(134:135, K))*T2(14) - RES(K) = RES(K)+DOT_PRODUCT(T1(0:0), C0(136:136, K))*T2(15) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:15), C0(1:16, K))*T2(0) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:14), C0(17:31, K))*T2(1) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:13), C0(32:45, K))*T2(2) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:12), C0(46:58, K))*T2(3) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:11), C0(59:70, K))*T2(4) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:10), C0(71:81, K))*T2(5) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:9), C0(82:91, K))*T2(6) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:8), C0(92:100, K))*T2(7) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:7), C0(101:108, K))*T2(8) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:6), C0(109:115, K))*T2(9) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:5), C0(116:121, K))*T2(10) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:4), C0(122:126, K))*T2(11) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:3), C0(127:130, K))*T2(12) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:2), C0(131:133, K))*T2(13) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:1), C0(134:135, K))*T2(14) + RES(K) = RES(K) + DOT_PRODUCT(T1(0:0), C0(136:136, K))*T2(15) ENDDO END SUBROUTINE PD2VAL END MODULE t_sh_p_s_c diff --git a/src/common/timings.F b/src/common/timings.F index 4524105a88..8e3174bfd4 100644 --- a/src/common/timings.F +++ b/src/common/timings.F @@ -159,7 +159,7 @@ SUBROUTINE timer_env_retain(timer_env) CPABORT("timer_env_retain: not associated") IF (timer_env%ref_count < 0) & CPABORT("timer_env_retain: negativ ref_count") - timer_env%ref_count = timer_env%ref_count+1 + timer_env%ref_count = timer_env%ref_count + 1 END SUBROUTINE timer_env_retain ! ************************************************************************************************** @@ -178,7 +178,7 @@ SUBROUTINE timer_env_release(timer_env) CPABORT("timer_env_release: not associated") IF (timer_env%ref_count < 0) & CPABORT("timer_env_release: negativ ref_count") - timer_env%ref_count = timer_env%ref_count-1 + timer_env%ref_count = timer_env%ref_count - 1 IF (timer_env%ref_count > 0) RETURN ! No more references left - let's tear down this timer_env... @@ -248,9 +248,9 @@ SUBROUTINE timeset_handler(routineN, handle) ! update routine r_stats r_stat => list_get(timer_env%routine_stats, routine_id) stack_size = list_size(timer_env%callstack) - r_stat%total_calls = r_stat%total_calls+1 - r_stat%active_calls = r_stat%active_calls+1 - r_stat%stackdepth_accu = r_stat%stackdepth_accu+stack_size+1 + r_stat%total_calls = r_stat%total_calls + 1 + r_stat%active_calls = r_stat%active_calls + 1 + r_stat%stackdepth_accu = r_stat%stackdepth_accu + stack_size + 1 ! add routine to callstack cs_entry%routine_id = routine_id @@ -259,14 +259,14 @@ SUBROUTINE timeset_handler(routineN, handle) !..if debug mode echo the subroutine name IF ((timer_env%trace_all .OR. r_stat%trace) .AND. & (r_stat%total_calls < timer_env%trace_max)) THEN - WRITE (sformat, *) "(A,A,", MAX(1, 3*stack_size-4), "X,I4,1X,I6,1X,A,A)" - WRITE (mystring, sformat) timer_env%trace_str, ">>", stack_size+1, & + WRITE (sformat, *) "(A,A,", MAX(1, 3*stack_size - 4), "X,I4,1X,I6,1X,A,A)" + WRITE (mystring, sformat) timer_env%trace_str, ">>", stack_size + 1, & r_stat%total_calls, TRIM(r_stat%routineN), " start" CALL cuda_mem_info(gpumem_free, gpumem_total) CALL m_memory(cpumem) WRITE (line, '(A,A,I0,A,A,I0,A)') TRIM(mystring), & - " Hostmem: ", (cpumem+1024*1024-1)/(1024*1024), " MB", & - " GPUmem: ", (gpumem_total-gpumem_free)/(1024*1024), " MB" + " Hostmem: ", (cpumem + 1024*1024 - 1)/(1024*1024), " MB", & + " GPUmem: ", (gpumem_total - gpumem_free)/(1024*1024), " MB" WRITE (timer_env%trace_unit, *) TRIM(line) CALL m_flush(timer_env%trace_unit) END IF @@ -329,28 +329,28 @@ SUBROUTINE timestop_handler(handle) wt_now = m_walltime() en_now = m_energy() ! add the elapsed time for this timeset/timestop to the time accumulator - wt_elapsed = wt_now-cs_entry%walltime_start - en_elapsed = en_now-cs_entry%energy_start + wt_elapsed = wt_now - cs_entry%walltime_start + en_elapsed = en_now - cs_entry%energy_start ENDIF - r_stat%active_calls = r_stat%active_calls-1 + r_stat%active_calls = r_stat%active_calls - 1 ! if we're the last instance in the stack, we do the accounting of the total time IF (r_stat%active_calls == 0) THEN - r_stat%incl_walltime_accu = r_stat%incl_walltime_accu+wt_elapsed - r_stat%incl_energy_accu = r_stat%incl_energy_accu+en_elapsed + r_stat%incl_walltime_accu = r_stat%incl_walltime_accu + wt_elapsed + r_stat%incl_energy_accu = r_stat%incl_energy_accu + en_elapsed ENDIF ! exclusive time we always sum, since children will correct this time with their total time - r_stat%excl_walltime_accu = r_stat%excl_walltime_accu+wt_elapsed - r_stat%excl_energy_accu = r_stat%excl_energy_accu+en_elapsed + r_stat%excl_walltime_accu = r_stat%excl_walltime_accu + wt_elapsed + r_stat%excl_energy_accu = r_stat%excl_energy_accu + en_elapsed stack_size = list_size(timer_env%callstack) IF (stack_size > 0) THEN prev_cs_entry = list_peek(timer_env%callstack) prev_stat => list_get(timer_env%routine_stats, prev_cs_entry%routine_id) ! we fixup the clock of the caller - prev_stat%excl_walltime_accu = prev_stat%excl_walltime_accu-wt_elapsed - prev_stat%excl_energy_accu = prev_stat%excl_energy_accu-en_elapsed + prev_stat%excl_walltime_accu = prev_stat%excl_walltime_accu - wt_elapsed + prev_stat%excl_energy_accu = prev_stat%excl_energy_accu - en_elapsed !update callgraph routine_tuple = (/prev_cs_entry%routine_id, routine_id/) @@ -362,22 +362,22 @@ SUBROUTINE timestop_handler(handle) c_stat%incl_energy_accu = 0.0_dp CALL callgraph_set(timer_env%callgraph, routine_tuple, c_stat) END IF - c_stat%total_calls = c_stat%total_calls+1 - c_stat%incl_walltime_accu = c_stat%incl_walltime_accu+wt_elapsed - c_stat%incl_energy_accu = c_stat%incl_energy_accu+en_elapsed + c_stat%total_calls = c_stat%total_calls + 1 + c_stat%incl_walltime_accu = c_stat%incl_walltime_accu + wt_elapsed + c_stat%incl_energy_accu = c_stat%incl_energy_accu + en_elapsed ENDIF !..if debug mode echo the subroutine name IF ((timer_env%trace_all .OR. r_stat%trace) .AND. & (r_stat%total_calls < timer_env%trace_max)) THEN - WRITE (sformat, *) "(A,A,", MAX(1, 3*stack_size-4), "X,I4,1X,I6,1X,A,F12.3)" - WRITE (mystring, sformat) timer_env%trace_str, "<<", stack_size+1, & + WRITE (sformat, *) "(A,A,", MAX(1, 3*stack_size - 4), "X,I4,1X,I6,1X,A,F12.3)" + WRITE (mystring, sformat) timer_env%trace_str, "<<", stack_size + 1, & r_stat%total_calls, TRIM(r_stat%routineN), wt_elapsed CALL cuda_mem_info(gpumem_free, gpumem_total) CALL m_memory(cpumem) WRITE (line, '(A,A,I0,A,A,I0,A)') TRIM(mystring), & - " Hostmem: ", (cpumem+1024*1024-1)/(1024*1024), " MB", & - " GPUmem: ", (gpumem_total-gpumem_free)/(1024*1024), " MB" + " Hostmem: ", (cpumem + 1024*1024 - 1)/(1024*1024), " MB", & + " GPUmem: ", (gpumem_total - gpumem_free)/(1024*1024), " MB" WRITE (timer_env%trace_unit, *) TRIM(line) CALL m_flush(timer_env%trace_unit) ENDIF @@ -486,7 +486,7 @@ FUNCTION routine_name2id(routineN) RESULT(routine_id) END IF ! register routine_name_dsl with new routine_id - routine_id = routine_map_size(timer_env%routine_names)+1 + routine_id = routine_map_size(timer_env%routine_names) + 1 CALL routine_map_set(timer_env%routine_names, routineN, routine_id) ALLOCATE (r_stat) diff --git a/src/common/util.F b/src/common/util.F index 5b20d18956..9a91200c59 100644 --- a/src/common/util.F +++ b/src/common/util.F @@ -70,9 +70,9 @@ PURE FUNCTION locate(array, x) RESULT(x_index) n = SIZE(array) IF (x > array(n)) RETURN jl = 0 - ju = n+1 - DO WHILE (ju-jl > 1) - jm = (ju+jl)/2 + ju = n + 1 + DO WHILE (ju - jl > 1) + jm = (ju + jl)/2 IF (x >= array(jm)) THEN jl = jm ELSE @@ -103,7 +103,7 @@ SUBROUTINE sort_unique1(arr, unique) ALLOCATE (wrk(n)) CALL sort(arr, n, wrk) DO i = 2, n - IF (arr(i) == arr(i-1)) THEN + IF (arr(i) == arr(i - 1)) THEN unique = .FALSE. EXIT END IF @@ -215,8 +215,8 @@ PURE FUNCTION get_limit(m, n, me) RESULT(nlim) REAL(KIND=dp) :: part part = REAL(m, KIND=dp)/REAL(n, KIND=dp) - nl = NINT(REAL(me, KIND=dp)*part)+1 - nu = NINT(REAL(me+1, KIND=dp)*part) + nl = NINT(REAL(me, KIND=dp)*part) + 1 + nu = NINT(REAL(me + 1, KIND=dp)*part) nlim(1) = MAX(1, nl) nlim(2) = MIN(m, nu) @@ -256,7 +256,7 @@ PURE SUBROUTINE find_boundary1(num_array, ntot, first, last, search) found = .TRUE. ELSE IF (found) THEN - last = i-1 + last = i - 1 EXIT END IF found = .FALSE. @@ -305,7 +305,7 @@ PURE SUBROUTINE find_boundary2(num_array1, num_array2, ntot, first, last, search found = .TRUE. ELSE IF (found) THEN - last = i-1 + last = i - 1 EXIT END IF found = .FALSE. diff --git a/src/common/whittaker.F b/src/common/whittaker.F index 0cf764dd89..1b03a6e424 100644 --- a/src/common/whittaker.F +++ b/src/common/whittaker.F @@ -57,7 +57,7 @@ SUBROUTINE whittaker_c0a(wc, r, expa, erfa, alpha, l1, l2, n) INTEGER :: i, k, l REAL(dp) :: t1, x, y - l = l1+l2 + l = l1 + l2 IF (MOD(l, 2) /= 0) THEN CPABORT("Total angular momentum has to be even") @@ -72,18 +72,18 @@ SUBROUTINE whittaker_c0a(wc, r, expa, erfa, alpha, l1, l2, n) DO i = 1, n x = r(i) IF (t1*x < epsilon) THEN - wc(i) = x**l1*(x**2/(3._dp+y)-alpha*x**4/(5._dp+y)+ & - alpha**2*x**6/(14._dp+2._dp*y)- & - alpha**3*x**8/(54._dp+6._dp*y)+ & - alpha**4*x**10/(256._dp+24._dp*y)- & - alpha**5*x**12/120._dp/(13._dp+y)) + wc(i) = x**l1*(x**2/(3._dp + y) - alpha*x**4/(5._dp + y) + & + alpha**2*x**6/(14._dp + 2._dp*y) - & + alpha**3*x**8/(54._dp + 6._dp*y) + & + alpha**4*x**10/(256._dp + 24._dp*y) - & + alpha**5*x**12/120._dp/(13._dp + y)) ELSE - wc(i) = -rootpi*erfa(i)*alpha*dfac(l+1) + wc(i) = -rootpi*erfa(i)*alpha*dfac(l + 1) DO k = 0, l/2 - wc(i) = wc(i)+expa(i)*x**(2*k+1)*t1**(2*k+3)* & - dfac(l+1)/dfac(2*k+1)*2**(k+1) + wc(i) = wc(i) + expa(i)*x**(2*k + 1)*t1**(2*k + 3)* & + dfac(l + 1)/dfac(2*k + 1)*2**(k + 1) END DO - wc(i) = -wc(i)/2._dp**(l/2+2)/t1**(l+5)/x**(l2+1) + wc(i) = -wc(i)/2._dp**(l/2 + 2)/t1**(l + 5)/x**(l2 + 1) END IF END DO @@ -134,12 +134,12 @@ SUBROUTINE whittaker_c0(wc, r, expa, erfa, alpha, l, n) t1 = SQRT(alpha) DO i = 1, n x = r(i) - wc(i) = -rootpi*erfa(i)*alpha*dfac(l+1) + wc(i) = -rootpi*erfa(i)*alpha*dfac(l + 1) DO k = 0, l/2 - wc(i) = wc(i)+expa(i)*x**(2*k+1)*t1**(2*k+3)* & - dfac(l+1)/dfac(2*k+1)*2**(k+1) + wc(i) = wc(i) + expa(i)*x**(2*k + 1)*t1**(2*k + 3)* & + dfac(l + 1)/dfac(2*k + 1)*2**(k + 1) END DO - wc(i) = -wc(i)/2._dp**(l/2+2)/t1**(l+5) + wc(i) = -wc(i)/2._dp**(l/2 + 2)/t1**(l + 5) END DO CASE (0) @@ -152,7 +152,7 @@ SUBROUTINE whittaker_c0(wc, r, expa, erfa, alpha, l, n) t5 = x**2 t7 = expa(i) t13 = erfa(i) - t18 = -1._dp/t2/t1*(2._dp*x*t7*t1-t11*t13)/4._dp + t18 = -1._dp/t2/t1*(2._dp*x*t7*t1 - t11*t13)/4._dp wc(i) = t18 END DO @@ -167,7 +167,7 @@ SUBROUTINE whittaker_c0(wc, r, expa, erfa, alpha, l, n) t6 = x**2 t9 = expa(i) t19 = erfa(i) - t25 = -1._dp/t3/t1*(4._dp*t6*x*t9*t2*t1+6._dp*x*t9*t1-3*t17*t19)/8._dp + t25 = -1._dp/t3/t1*(4._dp*t6*x*t9*t2*t1 + 6._dp*x*t9*t1 - 3*t17*t19)/8._dp wc(i) = t25 END DO @@ -184,7 +184,7 @@ SUBROUTINE whittaker_c0(wc, r, expa, erfa, alpha, l, n) t8 = t7**2 t11 = expa(i) t25 = erfa(i) - t31 = -1._dp/t4/t3*(8._dp*t8*x*t11*t4*t1+20._dp*t7*x*t11*t3+30._dp*x*t11*t1- & + t31 = -1._dp/t4/t3*(8._dp*t8*x*t11*t4*t1 + 20._dp*t7*x*t11*t3 + 30._dp*x*t11*t1 - & 15._dp*t23*t25)/16._dp wc(i) = t31 END DO @@ -204,8 +204,8 @@ SUBROUTINE whittaker_c0(wc, r, expa, erfa, alpha, l, n) t3 = t1**2 t6 = expa(i) t30 = erfa(i) - t39 = -(16._dp*t3*t2*t6*t11*t8+56._dp*t3*x*t6*t10*t17+140._dp*t2*t6*t10*t8+ & - 210._dp*x*t6*t17-105._dp*t28*t30*alpha)/t11/t17/32._dp + t39 = -(16._dp*t3*t2*t6*t11*t8 + 56._dp*t3*x*t6*t10*t17 + 140._dp*t2*t6*t10*t8 + & + 210._dp*x*t6*t17 - 105._dp*t28*t30*alpha)/t11/t17/32._dp wc(i) = t39 END DO @@ -226,8 +226,8 @@ SUBROUTINE whittaker_c0(wc, r, expa, erfa, alpha, l, n) t16 = t1*x t28 = t11*t8 t36 = erfa(i) - t45 = -(32._dp*t3*x*t6*t12*t10+144._dp*t2*t16*t6*t12*t8+504._dp*t2*x*t6*t11*t10+ & - 1260._dp*t16*t6*t28+1890._dp*x*t6*t10-945._dp*t34*t36*alpha)/t12/t28/64._dp + t45 = -(32._dp*t3*x*t6*t12*t10 + 144._dp*t2*t16*t6*t12*t8 + 504._dp*t2*x*t6*t11*t10 + & + 1260._dp*t16*t6*t28 + 1890._dp*x*t6*t10 - 945._dp*t34*t36*alpha)/t12/t28/64._dp wc(i) = t45 END DO @@ -249,9 +249,9 @@ SUBROUTINE whittaker_c0(wc, r, expa, erfa, alpha, l, n) t4 = t3**2 t7 = expa(i) t41 = erfa(i) - t50 = -(64._dp*t4*t2*t7*t13*t12+352._dp*t4*x*t7*t13*t19+ & - 1584._dp*t3*t2*t7*t13*t9+5544._dp*t3*x*t7*t30+ & - 13860._dp*t2*t7*t12+20790._dp*x*t7*t19-10395._dp*t39*t41*alpha)/ & + t50 = -(64._dp*t4*t2*t7*t13*t12 + 352._dp*t4*x*t7*t13*t19 + & + 1584._dp*t3*t2*t7*t13*t9 + 5544._dp*t3*x*t7*t30 + & + 13860._dp*t2*t7*t12 + 20790._dp*x*t7*t19 - 10395._dp*t39*t41*alpha)/ & t13/t30/128._dp wc(i) = t50 END DO @@ -276,9 +276,9 @@ SUBROUTINE whittaker_c0(wc, r, expa, erfa, alpha, l, n) t21 = t12*t9 t46 = erfa(i) t51 = t14**2 - t56 = -(128._dp*t4*t3*t7*t13*t14+832._dp*t4*t18*t7*t14*t21+ & - 4576._dp*t4*x*t7*t14*t11+20592._dp*t2*t18*t7*t14*t9+72072._dp*t3*t7*t13+ & - 180180._dp*t18*t7*t21+270270._dp*x*t7*t11-135135._dp*t44*t46*alpha)/ & + t56 = -(128._dp*t4*t3*t7*t13*t14 + 832._dp*t4*t18*t7*t14*t21 + & + 4576._dp*t4*x*t7*t14*t11 + 20592._dp*t2*t18*t7*t14*t9 + 72072._dp*t3*t7*t13 + & + 180180._dp*t18*t7*t21 + 270270._dp*x*t7*t11 - 135135._dp*t44*t46*alpha)/ & t51/t9/256._dp wc(i) = t56 END DO @@ -304,10 +304,10 @@ SUBROUTINE whittaker_c0(wc, r, expa, erfa, alpha, l, n) t8 = expa(i) t18 = t3*x t52 = erfa(i) - t61 = -(256._dp*t5*t4*t8*t14*t10+1920._dp*t5*t18*t8*t13*t22+ & - 12480._dp*t5*t2*t8*t13*t28+68640._dp*t5*x*t8*t13*t21+ & - 308880._dp*t4*t8*t13*t10+1081080._dp*t18*t8*t22+ & - 2702700._dp*t2*t8*t28+4054050._dp*x*t8*t21- & + t61 = -(256._dp*t5*t4*t8*t14*t10 + 1920._dp*t5*t18*t8*t13*t22 + & + 12480._dp*t5*t2*t8*t13*t28 + 68640._dp*t5*x*t8*t13*t21 + & + 308880._dp*t4*t8*t13*t10 + 1081080._dp*t18*t8*t22 + & + 2702700._dp*t2*t8*t28 + 4054050._dp*x*t8*t21 - & 2027025._dp*t50*t52*alpha)/t14/t21/512._dp wc(i) = t61 END DO @@ -365,9 +365,9 @@ SUBROUTINE whittaker_ci(wc, r, expa, alpha, l, n) x = r(i) wc(i) = 0._dp DO k = 0, l/2 - wc(i) = wc(i)+alpha**k*x**(2*k)*fac(l/2)/fac(k) + wc(i) = wc(i) + alpha**k*x**(2*k)*fac(l/2)/fac(k) END DO - wc(i) = 0.5_dp*wc(i)/alpha**(l/2+1)*expa(i) + wc(i) = 0.5_dp*wc(i)/alpha**(l/2 + 1)*expa(i) END DO CASE (0) @@ -388,7 +388,7 @@ SUBROUTINE whittaker_ci(wc, r, expa, alpha, l, n) t1 = x**2 t2 = alpha*t1 t3 = expa(i) - t9 = t3*(t2+1)/t6/2._dp + t9 = t3*(t2 + 1)/t6/2._dp wc(i) = t9 END DO @@ -401,7 +401,7 @@ SUBROUTINE whittaker_ci(wc, r, expa, alpha, l, n) t2 = alpha*t1 t3 = expa(i) t4 = t1**2 - t13 = t3*(t4*t5+2._dp*t2+2._dp)/t5/alpha/2._dp + t13 = t3*(t4*t5 + 2._dp*t2 + 2._dp)/t5/alpha/2._dp wc(i) = t13 END DO @@ -415,7 +415,7 @@ SUBROUTINE whittaker_ci(wc, r, expa, alpha, l, n) t2 = alpha*t1 t3 = expa(i) t4 = t1**2 - t17 = t3*(t4*t1*t6*alpha+3._dp*t4*t6+6._dp*t2+6._dp)/t14/2._dp + t17 = t3*(t4*t1*t6*alpha + 3._dp*t4*t6 + 6._dp*t2 + 6._dp)/t14/2._dp wc(i) = t17 END DO @@ -430,7 +430,7 @@ SUBROUTINE whittaker_ci(wc, r, expa, alpha, l, n) t3 = expa(i) t4 = t1**2 t5 = t4**2 - t21 = t3*(t5*t7+4._dp*t4*t1*t6*alpha+12._dp*t4*t6+24._dp*t2+24._dp)/t7/alpha/2._dp + t21 = t3*(t5*t7 + 4._dp*t4*t1*t6*alpha + 12._dp*t4*t6 + 24._dp*t2 + 24._dp)/t7/alpha/2._dp wc(i) = t21 END DO @@ -445,8 +445,8 @@ SUBROUTINE whittaker_ci(wc, r, expa, alpha, l, n) t3 = expa(i) t4 = t1**2 t5 = t4**2 - t25 = t3*(t5*t1*t8*alpha+5._dp*t5*t8+20._dp*t4*t1*t7*alpha+60._dp*t4*t7+ & - 120._dp*t2+120._dp)/t8/t7/2._dp + t25 = t3*(t5*t1*t8*alpha + 5._dp*t5*t8 + 20._dp*t4*t1*t7*alpha + 60._dp*t4*t7 + & + 120._dp*t2 + 120._dp)/t8/t7/2._dp wc(i) = t25 END DO @@ -462,8 +462,8 @@ SUBROUTINE whittaker_ci(wc, r, expa, alpha, l, n) t3 = expa(i) t4 = t1**2 t5 = t4**2 - t29 = t3*(t5*t4*t8*t7+6._dp*t5*t1*t8*alpha+30._dp*t5*t8+120._dp*t4*t1*t18+ & - 360._dp*t4*t7+720._dp*t2+720._dp)/t8/t18/2._dp + t29 = t3*(t5*t4*t8*t7 + 6._dp*t5*t1*t8*alpha + 30._dp*t5*t8 + 120._dp*t4*t1*t18 + & + 360._dp*t4*t7 + 720._dp*t2 + 720._dp)/t8/t18/2._dp wc(i) = t29 END DO @@ -481,8 +481,8 @@ SUBROUTINE whittaker_ci(wc, r, expa, alpha, l, n) t4 = t1**2 t5 = t4*t1 t6 = t4**2 - t33 = t3*(t6*t5*t10*t9+7*t6*t4*t10*t8+42._dp*t6*t1*t10*alpha+ & - 210._dp*t6*t10+840._dp*t5*t9+2520._dp*t4*t8+5040._dp*t2+5040._dp)/t30/2._dp + t33 = t3*(t6*t5*t10*t9 + 7*t6*t4*t10*t8 + 42._dp*t6*t1*t10*alpha + & + 210._dp*t6*t10 + 840._dp*t5*t9 + 2520._dp*t4*t8 + 5040._dp*t2 + 5040._dp)/t30/2._dp wc(i) = t33 END DO diff --git a/src/common/xml_parser.F b/src/common/xml_parser.F index a4336785e6..ab2a37110d 100644 --- a/src/common/xml_parser.F +++ b/src/common/xml_parser.F @@ -407,7 +407,7 @@ SUBROUTINE xml_get(info, tag, endtag, attribs, no_attribs, & kspace = INDEX(info%line, ' ') kend = INDEX(info%line, '>') DO WHILE (kend .LE. 0) - info%lineno = info%lineno+1 + info%lineno = info%lineno + 1 READ (info%lun, '(a)', iostat=ierr) nextline IF (ierr .EQ. 0) THEN info%line = TRIM(info%line)//' '//ADJUSTL(nextline) @@ -432,20 +432,20 @@ SUBROUTINE xml_get(info, tag, endtag, attribs, no_attribs, & ! IF (info%line(1:3) .EQ. '-->') THEN endtag = .TRUE. - tag = info%line(4:kend-1) + tag = info%line(4:kend - 1) ELSE IF (info%line(1:2) .EQ. '') IF (kend .GE. 1) THEN - kend = kend+1 ! To go beyond the ">" character + kend = kend + 1 ! To go beyond the ">" character endtag = .TRUE. ELSE kend = INDEX(info%line, '>') @@ -480,17 +480,17 @@ SUBROUTINE xml_get(info, tag, endtag, attribs, no_attribs, & ENDIF ENDIF IF (kend .GE. 1) THEN - info%line = ADJUSTL(info%line(kend+1:)) + info%line = ADJUSTL(info%line(kend + 1:)) ENDIF EXIT ENDIF - idxat = idxat+1 + idxat = idxat + 1 IF (idxat .LE. SIZE(attribs, 2)) THEN no_attribs = idxat - attribs(1, idxat) = ADJUSTL(info%line(1:keq-1)) ! Use adjustl() to avoid + attribs(1, idxat) = ADJUSTL(info%line(1:keq - 1)) ! Use adjustl() to avoid ! multiple spaces, etc - info%line = ADJUSTL(info%line(keq+1:)) + info%line = ADJUSTL(info%line(keq + 1:)) ! ! We have almost found the start of the attribute's value @@ -504,7 +504,7 @@ SUBROUTINE xml_get(info, tag, endtag, attribs, no_attribs, & RETURN ENDIF - ksecond = INDEX(info%line(kfirst+1:), '"')+kfirst + ksecond = INDEX(info%line(kfirst + 1:), '"') + kfirst IF (ksecond .LT. 1) THEN CALL xml_report_errors('XML_GET - malformed attribute-value pair: ', & TRIM(info%line), info%lineno) @@ -513,8 +513,8 @@ SUBROUTINE xml_get(info, tag, endtag, attribs, no_attribs, & RETURN ENDIF - attribs(2, idxat) = info%line(kfirst+1:ksecond-1) - info%line = ADJUSTL(info%line(ksecond+1:)) + attribs(2, idxat) = info%line(kfirst + 1:ksecond - 1) + info%line = ADJUSTL(info%line(ksecond + 1:)) ENDIF IF (idxat .GT. SIZE(attribs, 2)) THEN @@ -539,11 +539,11 @@ SUBROUTINE xml_get(info, tag, endtag, attribs, no_attribs, & ELSE kend = INDEX(info%line, '<') ENDIF - idxdat = idxdat+1 + idxdat = idxdat + 1 IF (idxdat .LE. SIZE(DATA)) THEN no_data = idxdat IF (kend .GE. 1) THEN - DATA(idxdat) = info%line(1:kend-1) + DATA(idxdat) = info%line(1:kend - 1) info%line = info%line(kend:) ELSE DATA(idxdat) = info%line @@ -561,7 +561,7 @@ SUBROUTINE xml_get(info, tag, endtag, attribs, no_attribs, & IF (kend .GE. 1) THEN EXIT ELSE - info%lineno = info%lineno+1 + info%lineno = info%lineno + 1 READ (info%lun, '(a)', iostat=ierr) info%line IF (ierr .LT. 0) THEN CALL xml_report_details('XML_GET - end of file found - LU-number: ', & @@ -658,7 +658,7 @@ SUBROUTINE xml_put_open_tag_(info, tag, attribs, no_attribs) ENDIF ENDDO WRITE (info%lun, '(a)') '>' - info%level = info%level+1 + info%level = info%level + 1 END SUBROUTINE xml_put_open_tag_ @@ -743,7 +743,7 @@ SUBROUTINE xml_put_close_tag_(info, tag) CHARACTER(len=300), PARAMETER :: indent = ' ' - info%level = info%level-1 + info%level = info%level - 1 WRITE (info%lun, '(4a)') & indent(1:3*info%level), '' @@ -765,7 +765,7 @@ SUBROUTINE xml_compress_(DATA, no_data) empty = .TRUE. DO i = 1, no_data IF (LEN_TRIM(DATA(i)) .NE. 0 .OR. .NOT. empty) THEN - j = j+1 + j = j + 1 DATA(j) = ADJUSTL(DATA(i)) empty = .FALSE. ENDIF @@ -777,7 +777,7 @@ SUBROUTINE xml_compress_(DATA, no_data) IF (LEN_TRIM(DATA(i)) .NE. 0) THEN EXIT ELSE - no_data = no_data-1 + no_data = no_data - 1 ENDIF ENDDO @@ -804,8 +804,8 @@ SUBROUTINE xml_replace_entities_(DATA, no_data) pos = INDEX(DATA(i) (j:), TRIM(entities(2, k))) IF (pos .GT. 0) THEN found = .TRUE. - j = j+pos-1 - j2 = j+LEN_TRIM(entities(2, k)) + j = j + pos - 1 + j2 = j + LEN_TRIM(entities(2, k)) DATA(i) (j:) = TRIM(entities(1, k))//DATA(i) (j2:) j = j2 ENDIF diff --git a/src/commutator_rkinetic.F b/src/commutator_rkinetic.F index c38c31c4fd..965ed2e8cd 100644 --- a/src/commutator_rkinetic.F +++ b/src/commutator_rkinetic.F @@ -184,27 +184,27 @@ SUBROUTINE build_com_tr_matrix(matrix_tr, qs_kind_set, basis_type, sab_nl) row=irow, col=icol, BLOCK=kz_block, found=found) CPASSERT(found) - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) tab = SQRT(rab2) trans = do_symmetric .AND. (iatom > jatom) DO iset = 1, nseta - ncoa = npgfa(iset)*(ncoset(la_max(iset))-ncoset(la_min(iset)-1)) + ncoa = npgfa(iset)*(ncoset(la_max(iset)) - ncoset(la_min(iset) - 1)) sgfa = first_sgfa(1, iset) DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < tab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < tab) CYCLE - ncob = npgfb(jset)*(ncoset(lb_max(jset))-ncoset(lb_min(jset)-1)) + ncob = npgfb(jset)*(ncoset(lb_max(jset)) - ncoset(lb_min(jset) - 1)) sgfb = first_sgfb(1, jset) ! calclulate integrals - ltab = MAX(npgfa(iset)*ncoset(la_max(iset)+1), npgfb(jset)*ncoset(lb_max(jset)+1)) + ltab = MAX(npgfa(iset)*ncoset(la_max(iset) + 1), npgfb(jset)*ncoset(lb_max(jset) + 1)) ALLOCATE (tkab(ltab, ltab)) - CALL kinetic(la_max(iset)+1, la_min(iset), npgfa(iset), rpgfa(:, iset), zeta(:, iset), & - lb_max(jset)+1, lb_min(jset), npgfb(jset), rpgfb(:, jset), zetb(:, jset), & + CALL kinetic(la_max(iset) + 1, la_min(iset), npgfa(iset), rpgfa(:, iset), zeta(:, iset), & + lb_max(jset) + 1, lb_min(jset), npgfb(jset), rpgfb(:, jset), zetb(:, jset), & rab, tkab) ! commutator CALL comab_opr(la_max(iset), npgfa(iset), rpgfa(:, iset), la_min(iset), & @@ -301,8 +301,8 @@ SUBROUTINE comab_opr(la_max, npgfa, rpgfa, la_min, lb_max, npgfb, rpgfb, lb_min, comabr = 0.0_dp - ofa = ncoset(la_min-1) - ofb = ncoset(lb_min-1) + ofa = ncoset(la_min - 1) + ofb = ncoset(lb_min - 1) na = 0 nap = 0 @@ -310,29 +310,29 @@ SUBROUTINE comab_opr(la_max, npgfa, rpgfa, la_min, lb_max, npgfb, rpgfb, lb_min, nb = 0 nbp = 0 DO jpgf = 1, npgfb - IF (rpgfa(ipgf)+rpgfb(jpgf) > dab) THEN + IF (rpgfa(ipgf) + rpgfb(jpgf) > dab) THEN DO la = la_min, la_max DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay - coa = na+coset(ax, ay, az)-ofa - coap = nap+coset(ax, ay, az)-ofa - coapx = nap+coset(ax+1, ay, az)-ofa - coapy = nap+coset(ax, ay+1, az)-ofa - coapz = nap+coset(ax, ay, az+1)-ofa + DO ay = 0, la - ax + az = la - ax - ay + coa = na + coset(ax, ay, az) - ofa + coap = nap + coset(ax, ay, az) - ofa + coapx = nap + coset(ax + 1, ay, az) - ofa + coapy = nap + coset(ax, ay + 1, az) - ofa + coapz = nap + coset(ax, ay, az + 1) - ofa DO lb = lb_min, lb_max DO bx = 0, lb - DO by = 0, lb-bx - bz = lb-bx-by - cob = nb+coset(bx, by, bz)-ofb - cobp = nbp+coset(bx, by, bz)-ofb - cobpx = nbp+coset(bx+1, by, bz)-ofb - cobpy = nbp+coset(bx, by+1, bz)-ofb - cobpz = nbp+coset(bx, by, bz+1)-ofb + DO by = 0, lb - bx + bz = lb - bx - by + cob = nb + coset(bx, by, bz) - ofb + cobp = nbp + coset(bx, by, bz) - ofb + cobpx = nbp + coset(bx + 1, by, bz) - ofb + cobpy = nbp + coset(bx, by + 1, bz) - ofb + cobpz = nbp + coset(bx, by, bz + 1) - ofb ! [a|[O,ri]|b] = [a|O|b+1i] - [a+1i|O|b] - comabr(coa, cob, 1) = ab(coap, cobpx)-ab(coapx, cobp) - comabr(coa, cob, 2) = ab(coap, cobpy)-ab(coapy, cobp) - comabr(coa, cob, 3) = ab(coap, cobpz)-ab(coapz, cobp) + comabr(coa, cob, 1) = ab(coap, cobpx) - ab(coapx, cobp) + comabr(coa, cob, 2) = ab(coap, cobpy) - ab(coapy, cobp) + comabr(coa, cob, 3) = ab(coap, cobpz) - ab(coapz, cobp) END DO END DO END DO @@ -340,11 +340,11 @@ SUBROUTINE comab_opr(la_max, npgfa, rpgfa, la_min, lb_max, npgfb, rpgfb, lb_min, END DO END DO END IF - nb = nb+ncoset(lb_max)-ofb - nbp = nbp+ncoset(lb_max+1)-ofb + nb = nb + ncoset(lb_max) - ofb + nbp = nbp + ncoset(lb_max + 1) - ofb END DO - na = na+ncoset(la_max)-ofa - nap = nap+ncoset(la_max+1)-ofa + na = na + ncoset(la_max) - ofa + nap = nap + ncoset(la_max + 1) - ofa END DO END SUBROUTINE comab_opr diff --git a/src/commutator_rpnl.F b/src/commutator_rpnl.F index 4a7e93d735..f4c45d09f6 100644 --- a/src/commutator_rpnl.F +++ b/src/commutator_rpnl.F @@ -117,10 +117,10 @@ SUBROUTINE build_com_rpnl(matrix_rv, qs_kind_set, sab_orb, sap_ppnl, eps_ppnl) maxppnl=maxppnl) maxl = MAX(maxlgto, maxlppnl) - CALL init_orbital_pointers(maxl+1) + CALL init_orbital_pointers(maxl + 1) ldsab = MAX(maxco, ncoset(maxlppnl), maxsgf, maxppnl) - ldai = ncoset(maxl+1) + ldai = ncoset(maxl + 1) !sap_int needs to be shared as multiple threads need to access this ALLOCATE (sap_int(nkind*nkind)) @@ -179,7 +179,7 @@ SUBROUTINE build_com_rpnl(matrix_rv, qs_kind_set, sab_orb, sap_ppnl, eps_ppnl) DO WHILE (neighbor_list_iterate(nl_iterator, mepos=mepos) == 0) CALL get_iterator_info(nl_iterator, mepos=mepos, ikind=ikind, jkind=kkind, iatom=iatom, & jatom=katom, nlist=nlist, ilist=ilist, nnode=nneighbor, inode=jneighbor, cell=cell_c, r=rac) - iac = ikind+nkind*(kkind-1) + iac = ikind + nkind*(kkind - 1) IF (.NOT. ASSOCIATED(basis_set(ikind)%gto_basis_set)) CYCLE gpot = ASSOCIATED(gpotential(kkind)%gth_potential) spot = ASSOCIATED(spotential(kkind)%sgp_potential) @@ -251,8 +251,8 @@ SUBROUTINE build_com_rpnl(matrix_rv, qs_kind_set, sab_orb, sap_ppnl, eps_ppnl) nprjc = nprj_ppnl(l)*nco(l) IF (nprjc == 0) CYCLE rprjc(1) = ppnl_radius - IF (set_radius_a(iset)+rprjc(1) < dac) CYCLE - lc_max = l+2*(nprj_ppnl(l)-1) + IF (set_radius_a(iset) + rprjc(1) < dac) CYCLE + lc_max = l + 2*(nprj_ppnl(l) - 1) lc_min = l zetc(1) = alpha_ppnl(l) ncoc = ncoset(lc_max) @@ -266,7 +266,7 @@ SUBROUTINE build_com_rpnl(matrix_rv, qs_kind_set, sab_orb, sap_ppnl, eps_ppnl) CALL dgemm("N", "N", ncoa, nprjc, ncoc, 1.0_dp, sab(1, 1, i), ldsab, & cprj(1, prjc), SIZE(cprj, 1), 0.0_dp, work(1, 1, i), ldsab) END DO - prjc = prjc+nprjc + prjc = prjc + nprjc END DO DO i = 1, maxder ! Contraction step (basis functions) @@ -308,7 +308,7 @@ SUBROUTINE build_com_rpnl(matrix_rv, qs_kind_set, sab_orb, sap_ppnl, eps_ppnl) jatom=jatom, nlist=nlist, ilist=ilist, nnode=nnode, inode=inode, cell=cell_b, r=rab) IF (.NOT. ASSOCIATED(basis_set(ikind)%gto_basis_set)) CYCLE IF (.NOT. ASSOCIATED(basis_set(jkind)%gto_basis_set)) CYCLE - iab = ikind+nkind*(jkind-1) + iab = ikind + nkind*(jkind - 1) ! *** Create matrix blocks for a new matrix block column *** IF (iatom <= jatom) THEN @@ -325,8 +325,8 @@ SUBROUTINE build_com_rpnl(matrix_rv, qs_kind_set, sab_orb, sap_ppnl, eps_ppnl) ! loop over all kinds for projector atom IF (ASSOCIATED(x_block) .AND. ASSOCIATED(y_block) .AND. ASSOCIATED(z_block)) THEN DO kkind = 1, nkind - iac = ikind+nkind*(kkind-1) - ibc = jkind+nkind*(kkind-1) + iac = ikind + nkind*(kkind - 1) + ibc = jkind + nkind*(kkind - 1) IF (.NOT. ASSOCIATED(sap_int(iac)%alist)) CYCLE IF (.NOT. ASSOCIATED(sap_int(ibc)%alist)) CYCLE CALL get_alist(sap_int(iac), alist_ac, iatom) @@ -336,7 +336,7 @@ SUBROUTINE build_com_rpnl(matrix_rv, qs_kind_set, sab_orb, sap_ppnl, eps_ppnl) DO kac = 1, alist_ac%nclist DO kbc = 1, alist_bc%nclist IF (alist_ac%clist(kac)%catom /= alist_bc%clist(kbc)%catom) CYCLE - IF (ALL(cell_b+alist_bc%clist(kbc)%cell-alist_ac%clist(kac)%cell == 0)) THEN + IF (ALL(cell_b + alist_bc%clist(kbc)%cell - alist_ac%clist(kac)%cell == 0)) THEN IF (alist_ac%clist(kac)%maxac*alist_bc%clist(kbc)%maxach < eps_ppnl) CYCLE acint => alist_ac%clist(kac)%acint bcint => alist_bc%clist(kbc)%acint diff --git a/src/constraint.F b/src/constraint.F index 89887a356c..7ae82b3dbe 100644 --- a/src/constraint.F +++ b/src/constraint.F @@ -135,7 +135,7 @@ SUBROUTINE shake_control(gci, local_molecules, molecule_set, molecule_kind_set, max_sigma = -1.0E+10_dp Shake_Inter_Loop: DO WHILE ((ABS(max_sigma) >= shake_tol) .AND. (ishake_ext <= Max_Shake_Iter)) max_sigma = 0.0_dp - ishake_ext = ishake_ext+1 + ishake_ext = ishake_ext + 1 ! Intramolecular Constraints MOL: DO ikind = 1, nkind nmol_per_kind = local_molecules%n_el(ikind) @@ -151,7 +151,7 @@ SUBROUTINE shake_control(gci, local_molecules, molecule_set, molecule_kind_set, int_max_sigma = -1.0E+10_dp Shake_Intra_Loop: DO WHILE ((ABS(int_max_sigma) >= shake_tol) .AND. (ishake_int <= Max_Shake_Iter)) int_max_sigma = 0.0_dp - ishake_int = ishake_int+1 + ishake_int = ishake_int + 1 ! 3x3 IF (n3x3con /= 0) & CALL shake_3x3_int(molecule, particle_set, pos, vel, dt, ishake_int, & @@ -261,7 +261,7 @@ SUBROUTINE rattle_control(gci, local_molecules, molecule_set, molecule_kind_set, max_sigma = -1.0E+10_dp Rattle_Inter_Loop: DO WHILE (ABS(max_sigma) >= rattle_tol) max_sigma = 0.0_dp - irattle_ext = irattle_ext+1 + irattle_ext = irattle_ext + 1 ! Intramolecular Constraints MOL: DO ikind = 1, nkind nmol_per_kind = local_molecules%n_el(ikind) @@ -276,7 +276,7 @@ SUBROUTINE rattle_control(gci, local_molecules, molecule_set, molecule_kind_set, int_max_sigma = -1.0E+10_dp Rattle_Intra_Loop: DO WHILE (ABS(int_max_sigma) >= rattle_tol) int_max_sigma = 0.0_dp - irattle_int = irattle_int+1 + irattle_int = irattle_int + 1 ! 3x3 IF (n3x3con /= 0) & CALL rattle_3x3_int(molecule, particle_set, vel, dt) @@ -394,7 +394,7 @@ SUBROUTINE shake_roll_control(gci, local_molecules, molecule_set, & max_sigma = -1.0E+10_dp Shake_Inter_Loop: DO WHILE (ABS(max_sigma) >= shake_tol) max_sigma = 0.0_dp - ishake_ext = ishake_ext+1 + ishake_ext = ishake_ext + 1 ! Intramolecular Constraints MOL: DO ikind = 1, nkind nmol_per_kind = local_molecules%n_el(ikind) @@ -410,7 +410,7 @@ SUBROUTINE shake_roll_control(gci, local_molecules, molecule_set, & int_max_sigma = -1.0E+10_dp Shake_Roll_Intra_Loop: DO WHILE (ABS(int_max_sigma) >= shake_tol) int_max_sigma = 0.0_dp - ishake_int = ishake_int+1 + ishake_int = ishake_int + 1 ! 3x3 IF (n3x3con /= 0) & CALL shake_roll_3x3_int(molecule, particle_set, pos, vel, r_shake, & @@ -542,7 +542,7 @@ SUBROUTINE rattle_roll_control(gci, local_molecules, molecule_set, & max_sigma = -1.0E+10_dp Rattle_Inter_Loop: DO WHILE (ABS(max_sigma) >= rattle_tol) max_sigma = 0.0_dp - irattle_ext = irattle_ext+1 + irattle_ext = irattle_ext + 1 ! Intramolecular Constraints MOL: DO ikind = 1, nkind nmol_per_kind = local_molecules%n_el(ikind) @@ -558,7 +558,7 @@ SUBROUTINE rattle_roll_control(gci, local_molecules, molecule_set, & irattle_int = 0 Rattle_Roll_Intramolecular: DO WHILE (ABS(int_max_sigma) >= rattle_tol) int_max_sigma = 0.0_dp - irattle_int = irattle_int+1 + irattle_int = irattle_int + 1 ! 3x3 IF (n3x3con /= 0) & CALL rattle_roll_3x3_int(molecule, particle_set, vel, r_rattle, dt, & @@ -662,21 +662,21 @@ SUBROUTINE dump_lagrange_mult(dump_lm, log_unit, local_molecules, molecule_set, molecule => molecule_set(i) ! Collective Variables DO j = 1, ncolv%ntot - lagr(my_index+1) = molecule%lci%lcolv(j)%lambda - my_index = my_index+1 + lagr(my_index + 1) = molecule%lci%lcolv(j)%lambda + my_index = my_index + 1 END DO ! 3x3 DO j = 1, n3x3con - lagr(my_index+1:my_index+3) = molecule%lci%lg3x3(j)%lambda(:) - my_index = my_index+3 + lagr(my_index + 1:my_index + 3) = molecule%lci%lg3x3(j)%lambda(:) + my_index = my_index + 3 END DO ! 4x6 DO j = 1, n4x6con - lagr(my_index+1:my_index+6) = molecule%lci%lg4x6(j)%lambda(:) - my_index = my_index+6 + lagr(my_index + 1:my_index + 6) = molecule%lci%lg4x6(j)%lambda(:) + my_index = my_index + 6 END DO ELSE - my_index = my_index+ncolv%ntot+3*n3x3con+6*n4x6con + my_index = my_index + ncolv%ntot + 3*n3x3con + 6*n4x6con END IF END DO END DO MOL @@ -684,21 +684,21 @@ SUBROUTINE dump_lagrange_mult(dump_lm, log_unit, local_molecules, molecule_set, END IF ! Intermolecular constraints IF (do_ext_constraint) THEN - CALL reallocate(lagr, 1, SIZE(lagr)+gci%ntot) + CALL reallocate(lagr, 1, SIZE(lagr) + gci%ntot) ! Collective Variables DO j = 1, gci%ncolv%ntot - lagr(my_index+1) = gci%lcolv(j)%lambda - my_index = my_index+1 + lagr(my_index + 1) = gci%lcolv(j)%lambda + my_index = my_index + 1 END DO ! 3x3 DO j = 1, gci%ng3x3 - lagr(my_index+1:my_index+3) = gci%lg3x3(j)%lambda(:) - my_index = my_index+3 + lagr(my_index + 1:my_index + 3) = gci%lg3x3(j)%lambda(:) + my_index = my_index + 3 END DO ! 4x6 DO j = 1, gci%ng4x6 - lagr(my_index+1:my_index+6) = gci%lg4x6(j)%lambda(:) - my_index = my_index+6 + lagr(my_index + 1:my_index + 6) = gci%lg4x6(j)%lambda(:) + my_index = my_index + 6 END DO END IF IF (log_unit > 0) THEN @@ -711,7 +711,7 @@ SUBROUTINE dump_lagrange_mult(dump_lm, log_unit, local_molecules, molecule_set, END IF WRITE (log_unit, FMT='(A,T40,4F15.9)') TRIM(label), lagr(1:MIN(4, SIZE(lagr))) DO j = 5, SIZE(lagr), 4 - WRITE (log_unit, FMT='(T40,4F15.9)') lagr(j:MIN(j+3, SIZE(lagr))) + WRITE (log_unit, FMT='(T40,4F15.9)') lagr(j:MIN(j + 3, SIZE(lagr))) END DO END IF DEALLOCATE (lagr) diff --git a/src/constraint_3x3.F b/src/constraint_3x3.F index b888a18e7f..30bc3e5235 100644 --- a/src/constraint_3x3.F +++ b/src/constraint_3x3.F @@ -382,38 +382,38 @@ SUBROUTINE shake_3x3_low(fixd_list, g3x3_list, lg3x3, first_atom, ng3x3, & dtby2 = dt*.5_dp DO iconst = 1, ng3x3 IF (g3x3_list(iconst)%restraint%active) CYCLE - index_a = g3x3_list(iconst)%a+first_atom-1 - index_b = g3x3_list(iconst)%b+first_atom-1 - index_c = g3x3_list(iconst)%c+first_atom-1 + index_a = g3x3_list(iconst)%a + first_atom - 1 + index_b = g3x3_list(iconst)%b + first_atom - 1 + index_c = g3x3_list(iconst)%c + first_atom - 1 IF (ishake == 1) THEN - r0_12(:) = pos(:, index_a)-pos(:, index_b) - r0_13(:) = pos(:, index_a)-pos(:, index_c) - r0_23(:) = pos(:, index_b)-pos(:, index_c) + r0_12(:) = pos(:, index_a) - pos(:, index_b) + r0_13(:) = pos(:, index_a) - pos(:, index_c) + r0_23(:) = pos(:, index_b) - pos(:, index_c) atomic_kind => particle_set(index_a)%atomic_kind imass1 = 1.0_dp/atomic_kind%mass atomic_kind => particle_set(index_b)%atomic_kind imass2 = 1.0_dp/atomic_kind%mass atomic_kind => particle_set(index_c)%atomic_kind imass3 = 1.0_dp/atomic_kind%mass - lg3x3(iconst)%fa = -2.0_dp*(lg3x3(iconst)%ra_old- & + lg3x3(iconst)%fa = -2.0_dp*(lg3x3(iconst)%ra_old - & lg3x3(iconst)%rb_old) - lg3x3(iconst)%fb = -2.0_dp*(lg3x3(iconst)%ra_old- & + lg3x3(iconst)%fb = -2.0_dp*(lg3x3(iconst)%ra_old - & lg3x3(iconst)%rc_old) - lg3x3(iconst)%fc = -2.0_dp*(lg3x3(iconst)%rb_old- & + lg3x3(iconst)%fc = -2.0_dp*(lg3x3(iconst)%rb_old - & lg3x3(iconst)%rc_old) ! Check for fixed atom constraints CALL check_fixed_atom_cns_g3x3(imass1, imass2, imass3, & index_a, index_b, index_c, fixd_list, lg3x3(iconst)) ! construct matrix - amat(1, 1) = (imass1+imass2)*DOTPROD_3D(r0_12, lg3x3(iconst)%fa) + amat(1, 1) = (imass1 + imass2)*DOTPROD_3D(r0_12, lg3x3(iconst)%fa) amat(1, 2) = imass1*DOTPROD_3D(r0_12, lg3x3(iconst)%fb) amat(1, 3) = -imass2*DOTPROD_3D(r0_12, lg3x3(iconst)%fc) amat(2, 1) = imass1*DOTPROD_3D(r0_13, lg3x3(iconst)%fa) - amat(2, 2) = (imass1+imass3)*DOTPROD_3D(r0_13, lg3x3(iconst)%fb) + amat(2, 2) = (imass1 + imass3)*DOTPROD_3D(r0_13, lg3x3(iconst)%fb) amat(2, 3) = imass3*DOTPROD_3D(r0_13, lg3x3(iconst)%fc) amat(3, 1) = -imass2*DOTPROD_3D(r0_23, lg3x3(iconst)%fa) amat(3, 2) = imass3*DOTPROD_3D(r0_23, lg3x3(iconst)%fb) - amat(3, 3) = (imass3+imass2)*DOTPROD_3D(r0_23, lg3x3(iconst)%fc) + amat(3, 3) = (imass3 + imass2)*DOTPROD_3D(r0_23, lg3x3(iconst)%fc) ! Store values lg3x3(iconst)%r0_12 = r0_12 lg3x3(iconst)%r0_13 = r0_13 @@ -432,53 +432,53 @@ SUBROUTINE shake_3x3_low(fixd_list, g3x3_list, lg3x3, first_atom, ng3x3, & imass3 = lg3x3(iconst)%imass3 END IF ! Iterate until convergence - vec = lg3x3(iconst)%lambda(1)*lg3x3(iconst)%fa*(imass1+imass2)+ & - lg3x3(iconst)%lambda(2)*imass1*lg3x3(iconst)%fb- & + vec = lg3x3(iconst)%lambda(1)*lg3x3(iconst)%fa*(imass1 + imass2) + & + lg3x3(iconst)%lambda(2)*imass1*lg3x3(iconst)%fb - & lg3x3(iconst)%lambda(3)*imass2*lg3x3(iconst)%fc bvec(1, 1) = g3x3_list(iconst)%dab*g3x3_list(iconst)%dab & - -dtsqby2*dtsqby2*DOTPROD_3D(vec, vec)-DOTPROD_3D(r0_12, r0_12) - vec = lg3x3(iconst)%lambda(1)*lg3x3(iconst)%fa*imass1+ & - lg3x3(iconst)%lambda(2)*(imass1+imass3)*lg3x3(iconst)%fb+ & + - dtsqby2*dtsqby2*DOTPROD_3D(vec, vec) - DOTPROD_3D(r0_12, r0_12) + vec = lg3x3(iconst)%lambda(1)*lg3x3(iconst)%fa*imass1 + & + lg3x3(iconst)%lambda(2)*(imass1 + imass3)*lg3x3(iconst)%fb + & lg3x3(iconst)%lambda(3)*imass3*lg3x3(iconst)%fc bvec(2, 1) = g3x3_list(iconst)%dac*g3x3_list(iconst)%dac & - -dtsqby2*dtsqby2*DOTPROD_3D(vec, vec)-DOTPROD_3D(r0_13, r0_13) - vec = -lg3x3(iconst)%lambda(1)*lg3x3(iconst)%fa*imass2+ & - lg3x3(iconst)%lambda(2)*imass3*lg3x3(iconst)%fb+ & - lg3x3(iconst)%lambda(3)*(imass2+imass3)*lg3x3(iconst)%fc + - dtsqby2*dtsqby2*DOTPROD_3D(vec, vec) - DOTPROD_3D(r0_13, r0_13) + vec = -lg3x3(iconst)%lambda(1)*lg3x3(iconst)%fa*imass2 + & + lg3x3(iconst)%lambda(2)*imass3*lg3x3(iconst)%fb + & + lg3x3(iconst)%lambda(3)*(imass2 + imass3)*lg3x3(iconst)%fc bvec(3, 1) = g3x3_list(iconst)%dbc*g3x3_list(iconst)%dbc & - -dtsqby2*dtsqby2*DOTPROD_3D(vec, vec)-DOTPROD_3D(r0_23, r0_23) + - dtsqby2*dtsqby2*DOTPROD_3D(vec, vec) - DOTPROD_3D(r0_23, r0_23) bvec = bvec*idtsq ! get lambda atemp = amat CALL solve_system(atemp, 3, bvec) lg3x3(iconst)%lambda(:) = bvec(:, 1) - lg3x3(iconst)%del_lambda(:) = lg3x3(iconst)%lambda(:)- & + lg3x3(iconst)%del_lambda(:) = lg3x3(iconst)%lambda(:) - & lg3x3(iconst)%lambda_old(:) lg3x3(iconst)%lambda_old(:) = lg3x3(iconst)%lambda(:) - fc1 = lg3x3(iconst)%del_lambda(1)*lg3x3(iconst)%fa+ & + fc1 = lg3x3(iconst)%del_lambda(1)*lg3x3(iconst)%fa + & lg3x3(iconst)%del_lambda(2)*lg3x3(iconst)%fb - fc2 = -lg3x3(iconst)%del_lambda(1)*lg3x3(iconst)%fa+ & + fc2 = -lg3x3(iconst)%del_lambda(1)*lg3x3(iconst)%fa + & lg3x3(iconst)%del_lambda(3)*lg3x3(iconst)%fc - fc3 = -lg3x3(iconst)%del_lambda(2)*lg3x3(iconst)%fb- & + fc3 = -lg3x3(iconst)%del_lambda(2)*lg3x3(iconst)%fb - & lg3x3(iconst)%del_lambda(3)*lg3x3(iconst)%fc - r1(:) = pos(:, index_a)+imass1*dtsqby2*fc1(:) - r2(:) = pos(:, index_b)+imass2*dtsqby2*fc2(:) - r3(:) = pos(:, index_c)+imass3*dtsqby2*fc3(:) - v1(:) = vel(:, index_a)+imass1*dtby2*fc1(:) - v2(:) = vel(:, index_b)+imass2*dtby2*fc2(:) - v3(:) = vel(:, index_c)+imass3*dtby2*fc3(:) - r12 = r1-r2 - r13 = r1-r3 - r23 = r2-r3 + r1(:) = pos(:, index_a) + imass1*dtsqby2*fc1(:) + r2(:) = pos(:, index_b) + imass2*dtsqby2*fc2(:) + r3(:) = pos(:, index_c) + imass3*dtsqby2*fc3(:) + v1(:) = vel(:, index_a) + imass1*dtby2*fc1(:) + v2(:) = vel(:, index_b) + imass2*dtby2*fc2(:) + v3(:) = vel(:, index_c) + imass3*dtby2*fc3(:) + r12 = r1 - r2 + r13 = r1 - r3 + r23 = r2 - r3 ! compute the tolerance: - sigma = DOT_PRODUCT(r12, r12)-g3x3_list(iconst)%dab* & + sigma = DOT_PRODUCT(r12, r12) - g3x3_list(iconst)%dab* & g3x3_list(iconst)%dab max_sigma = MAX(max_sigma, ABS(sigma)) - sigma = DOT_PRODUCT(r13, r13)-g3x3_list(iconst)%dac* & + sigma = DOT_PRODUCT(r13, r13) - g3x3_list(iconst)%dac* & g3x3_list(iconst)%dac max_sigma = MAX(max_sigma, ABS(sigma)) - sigma = DOT_PRODUCT(r23, r23)-g3x3_list(iconst)%dbc* & + sigma = DOT_PRODUCT(r23, r23) - g3x3_list(iconst)%dbc* & g3x3_list(iconst)%dbc max_sigma = MAX(max_sigma, ABS(sigma)) ! update positions with full multiplier @@ -541,24 +541,24 @@ SUBROUTINE shake_roll_3x3_low(fixd_list, g3x3_list, lg3x3, first_atom, ng3x3, & dtby2 = dt*.5_dp DO iconst = 1, ng3x3 IF (g3x3_list(iconst)%restraint%active) CYCLE - index_a = g3x3_list(iconst)%a+first_atom-1 - index_b = g3x3_list(iconst)%b+first_atom-1 - index_c = g3x3_list(iconst)%c+first_atom-1 + index_a = g3x3_list(iconst)%a + first_atom - 1 + index_b = g3x3_list(iconst)%b + first_atom - 1 + index_c = g3x3_list(iconst)%c + first_atom - 1 IF (ishake == 1) THEN - r0_12(:) = pos(:, index_a)-pos(:, index_b) - r0_13(:) = pos(:, index_a)-pos(:, index_c) - r0_23(:) = pos(:, index_b)-pos(:, index_c) + r0_12(:) = pos(:, index_a) - pos(:, index_b) + r0_13(:) = pos(:, index_a) - pos(:, index_c) + r0_23(:) = pos(:, index_b) - pos(:, index_c) atomic_kind => particle_set(index_a)%atomic_kind imass1 = 1.0_dp/atomic_kind%mass atomic_kind => particle_set(index_b)%atomic_kind imass2 = 1.0_dp/atomic_kind%mass atomic_kind => particle_set(index_c)%atomic_kind imass3 = 1.0_dp/atomic_kind%mass - lg3x3(iconst)%fa = -2.0_dp*(lg3x3(iconst)%ra_old- & + lg3x3(iconst)%fa = -2.0_dp*(lg3x3(iconst)%ra_old - & lg3x3(iconst)%rb_old) - lg3x3(iconst)%fb = -2.0_dp*(lg3x3(iconst)%ra_old- & + lg3x3(iconst)%fb = -2.0_dp*(lg3x3(iconst)%ra_old - & lg3x3(iconst)%rc_old) - lg3x3(iconst)%fc = -2.0_dp*(lg3x3(iconst)%rb_old- & + lg3x3(iconst)%fc = -2.0_dp*(lg3x3(iconst)%rb_old - & lg3x3(iconst)%rc_old) ! Check for fixed atom constraints CALL check_fixed_atom_cns_g3x3(imass1, imass2, imass3, & @@ -568,15 +568,15 @@ SUBROUTINE shake_roll_3x3_low(fixd_list, g3x3_list, lg3x3, first_atom, ng3x3, & CALL matvec_3x3(f_roll2, r_shake, lg3x3(iconst)%fb) CALL matvec_3x3(f_roll3, r_shake, lg3x3(iconst)%fc) ! construct matrix - amat(1, 1) = (imass1+imass2)*DOTPROD_3D(r0_12, f_roll1) + amat(1, 1) = (imass1 + imass2)*DOTPROD_3D(r0_12, f_roll1) amat(1, 2) = imass1*DOTPROD_3D(r0_12, f_roll2) amat(1, 3) = -imass2*DOTPROD_3D(r0_12, f_roll3) amat(2, 1) = imass1*DOTPROD_3D(r0_13, f_roll1) - amat(2, 2) = (imass1+imass3)*DOTPROD_3D(r0_13, f_roll2) + amat(2, 2) = (imass1 + imass3)*DOTPROD_3D(r0_13, f_roll2) amat(2, 3) = imass3*DOTPROD_3D(r0_13, f_roll3) amat(3, 1) = -imass2*DOTPROD_3D(r0_23, f_roll1) amat(3, 2) = imass3*DOTPROD_3D(r0_23, f_roll2) - amat(3, 3) = (imass3+imass2)*DOTPROD_3D(r0_23, f_roll3) + amat(3, 3) = (imass3 + imass2)*DOTPROD_3D(r0_23, f_roll3) ! Store values lg3x3(iconst)%r0_12 = r0_12 lg3x3(iconst)%r0_13 = r0_13 @@ -601,61 +601,61 @@ SUBROUTINE shake_roll_3x3_low(fixd_list, g3x3_list, lg3x3, first_atom, ng3x3, & imass3 = lg3x3(iconst)%imass3 END IF ! Iterate until convergence - vec = lg3x3(iconst)%lambda(1)*f_roll1*(imass1+imass2)+ & - lg3x3(iconst)%lambda(2)*imass1*f_roll2- & + vec = lg3x3(iconst)%lambda(1)*f_roll1*(imass1 + imass2) + & + lg3x3(iconst)%lambda(2)*imass1*f_roll2 - & lg3x3(iconst)%lambda(3)*imass2*f_roll3 bvec(1, 1) = g3x3_list(iconst)%dab*g3x3_list(iconst)%dab & - -dtsqby2*dtsqby2*DOTPROD_3D(vec, vec)-DOTPROD_3D(r0_12, r0_12) - vec = lg3x3(iconst)%lambda(1)*f_roll1*imass1+ & - lg3x3(iconst)%lambda(2)*(imass1+imass3)*f_roll2+ & + - dtsqby2*dtsqby2*DOTPROD_3D(vec, vec) - DOTPROD_3D(r0_12, r0_12) + vec = lg3x3(iconst)%lambda(1)*f_roll1*imass1 + & + lg3x3(iconst)%lambda(2)*(imass1 + imass3)*f_roll2 + & lg3x3(iconst)%lambda(3)*imass3*f_roll3 bvec(2, 1) = g3x3_list(iconst)%dac*g3x3_list(iconst)%dac & - -dtsqby2*dtsqby2*DOTPROD_3D(vec, vec)-DOTPROD_3D(r0_13, r0_13) - vec = -lg3x3(iconst)%lambda(1)*f_roll1*imass2+ & - lg3x3(iconst)%lambda(2)*imass3*f_roll2+ & - lg3x3(iconst)%lambda(3)*(imass2+imass3)*f_roll3 + - dtsqby2*dtsqby2*DOTPROD_3D(vec, vec) - DOTPROD_3D(r0_13, r0_13) + vec = -lg3x3(iconst)%lambda(1)*f_roll1*imass2 + & + lg3x3(iconst)%lambda(2)*imass3*f_roll2 + & + lg3x3(iconst)%lambda(3)*(imass2 + imass3)*f_roll3 bvec(3, 1) = g3x3_list(iconst)%dbc*g3x3_list(iconst)%dbc & - -dtsqby2*dtsqby2*DOTPROD_3D(vec, vec)-DOTPROD_3D(r0_23, r0_23) + - dtsqby2*dtsqby2*DOTPROD_3D(vec, vec) - DOTPROD_3D(r0_23, r0_23) bvec = bvec*idtsq ! get lambda atemp = amat CALL solve_system(atemp, 3, bvec) lg3x3(iconst)%lambda(:) = bvec(:, 1) - lg3x3(iconst)%del_lambda(:) = lg3x3(iconst)%lambda(:)- & + lg3x3(iconst)%del_lambda(:) = lg3x3(iconst)%lambda(:) - & lg3x3(iconst)%lambda_old(:) lg3x3(iconst)%lambda_old(:) = lg3x3(iconst)%lambda(:) - fc1 = lg3x3(iconst)%del_lambda(1)*lg3x3(iconst)%fa+ & + fc1 = lg3x3(iconst)%del_lambda(1)*lg3x3(iconst)%fa + & lg3x3(iconst)%del_lambda(2)*lg3x3(iconst)%fb - fc2 = -lg3x3(iconst)%del_lambda(1)*lg3x3(iconst)%fa+ & + fc2 = -lg3x3(iconst)%del_lambda(1)*lg3x3(iconst)%fa + & lg3x3(iconst)%del_lambda(3)*lg3x3(iconst)%fc - fc3 = -lg3x3(iconst)%del_lambda(2)*lg3x3(iconst)%fb- & + fc3 = -lg3x3(iconst)%del_lambda(2)*lg3x3(iconst)%fb - & lg3x3(iconst)%del_lambda(3)*lg3x3(iconst)%fc CALL MATVEC_3x3(vec, r_shake, fc1) - r1(:) = pos(:, index_a)+imass1*dtsqby2*vec + r1(:) = pos(:, index_a) + imass1*dtsqby2*vec CALL MATVEC_3x3(vec, r_shake, fc2) - r2(:) = pos(:, index_b)+imass2*dtsqby2*vec + r2(:) = pos(:, index_b) + imass2*dtsqby2*vec CALL MATVEC_3x3(vec, r_shake, fc3) - r3(:) = pos(:, index_c)+imass3*dtsqby2*vec + r3(:) = pos(:, index_c) + imass3*dtsqby2*vec CALL MATVEC_3x3(vec, v_shake, fc1) - v1(:) = vel(:, index_a)+imass1*dtby2*vec + v1(:) = vel(:, index_a) + imass1*dtby2*vec CALL MATVEC_3x3(vec, v_shake, fc2) - v2(:) = vel(:, index_b)+imass2*dtby2*vec + v2(:) = vel(:, index_b) + imass2*dtby2*vec CALL MATVEC_3x3(vec, v_shake, fc3) - v3(:) = vel(:, index_c)+imass3*dtby2*vec - r12 = r1-r2 - r13 = r1-r3 - r23 = r2-r3 + v3(:) = vel(:, index_c) + imass3*dtby2*vec + r12 = r1 - r2 + r13 = r1 - r3 + r23 = r2 - r3 ! compute the tolerance: - sigma = DOT_PRODUCT(r12, r12)-g3x3_list(iconst)%dab* & + sigma = DOT_PRODUCT(r12, r12) - g3x3_list(iconst)%dab* & g3x3_list(iconst)%dab max_sigma = MAX(max_sigma, ABS(sigma)) - sigma = DOT_PRODUCT(r13, r13)-g3x3_list(iconst)%dac* & + sigma = DOT_PRODUCT(r13, r13) - g3x3_list(iconst)%dac* & g3x3_list(iconst)%dac max_sigma = MAX(max_sigma, ABS(sigma)) - sigma = DOT_PRODUCT(r23, r23)-g3x3_list(iconst)%dbc* & + sigma = DOT_PRODUCT(r23, r23) - g3x3_list(iconst)%dbc* & g3x3_list(iconst)%dbc max_sigma = MAX(max_sigma, ABS(sigma)) @@ -710,15 +710,15 @@ SUBROUTINE rattle_roll_3x3_low(fixd_list, g3x3_list, lg3x3, first_atom, & dtby2 = dt*.5_dp DO iconst = 1, SIZE(g3x3_list) IF (g3x3_list(iconst)%restraint%active) CYCLE - index_a = g3x3_list(iconst)%a+first_atom-1 - index_b = g3x3_list(iconst)%b+first_atom-1 - index_c = g3x3_list(iconst)%c+first_atom-1 - v12(:) = vel(:, index_a)-vel(:, index_b) - v13(:) = vel(:, index_a)-vel(:, index_c) - v23(:) = vel(:, index_b)-vel(:, index_c) - r12(:) = particle_set(index_a)%r(:)-particle_set(index_b)%r(:) - r13(:) = particle_set(index_a)%r(:)-particle_set(index_c)%r(:) - r23(:) = particle_set(index_b)%r(:)-particle_set(index_c)%r(:) + index_a = g3x3_list(iconst)%a + first_atom - 1 + index_b = g3x3_list(iconst)%b + first_atom - 1 + index_c = g3x3_list(iconst)%c + first_atom - 1 + v12(:) = vel(:, index_a) - vel(:, index_b) + v13(:) = vel(:, index_a) - vel(:, index_c) + v23(:) = vel(:, index_b) - vel(:, index_c) + r12(:) = particle_set(index_a)%r(:) - particle_set(index_b)%r(:) + r13(:) = particle_set(index_a)%r(:) - particle_set(index_c)%r(:) + r23(:) = particle_set(index_b)%r(:) - particle_set(index_c)%r(:) atomic_kind => particle_set(index_a)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) imass1 = 1.0_dp/mass @@ -740,23 +740,23 @@ SUBROUTINE rattle_roll_3x3_low(fixd_list, g3x3_list, lg3x3, first_atom, & CALL MATVEC_3x3(f_roll3, r_rattle, lg3x3(iconst)%fc) ! construct matrix - amat(1, 1) = (imass1+imass2)*DOTPROD_3D(r12, f_roll1) + amat(1, 1) = (imass1 + imass2)*DOTPROD_3D(r12, f_roll1) amat(1, 2) = imass1*DOTPROD_3D(r12, f_roll2) amat(1, 3) = -imass2*DOTPROD_3D(r12, f_roll3) amat(2, 1) = imass1*DOTPROD_3D(r13, f_roll1) - amat(2, 2) = (imass1+imass3)*DOTPROD_3D(r13, f_roll2) + amat(2, 2) = (imass1 + imass3)*DOTPROD_3D(r13, f_roll2) amat(2, 3) = imass3*DOTPROD_3D(r13, f_roll3) amat(3, 1) = -imass2*DOTPROD_3D(r23, f_roll1) amat(3, 2) = imass3*DOTPROD_3D(r23, f_roll2) - amat(3, 3) = (imass2+imass3)*DOTPROD_3D(r23, f_roll3) + amat(3, 3) = (imass2 + imass3)*DOTPROD_3D(r23, f_roll3) ! construct solution vector CALL matvec_3x3(vec, veps, r12) - bvec(1, 1) = DOTPROD_3D(r12, v12+vec) + bvec(1, 1) = DOTPROD_3D(r12, v12 + vec) CALL matvec_3x3(vec, veps, r13) - bvec(2, 1) = DOTPROD_3D(r13, v13+vec) + bvec(2, 1) = DOTPROD_3D(r13, v13 + vec) CALL matvec_3x3(vec, veps, r23) - bvec(3, 1) = DOTPROD_3D(r23, v23+vec) + bvec(3, 1) = DOTPROD_3D(r23, v23 + vec) bvec = -bvec*2.0_dp*idt ! get lambda @@ -764,15 +764,15 @@ SUBROUTINE rattle_roll_3x3_low(fixd_list, g3x3_list, lg3x3, first_atom, & lambda(:) = bvec(:, 1) lg3x3(iconst)%lambda(:) = lambda - fc1 = lambda(1)*f_roll1+ & + fc1 = lambda(1)*f_roll1 + & lambda(2)*f_roll2 - fc2 = -lambda(1)*f_roll1+ & + fc2 = -lambda(1)*f_roll1 + & lambda(3)*f_roll3 - fc3 = -lambda(2)*f_roll2- & + fc3 = -lambda(2)*f_roll2 - & lambda(3)*f_roll3 - vel(:, index_a) = vel(:, index_a)+imass1*dtby2*fc1(:) - vel(:, index_b) = vel(:, index_b)+imass2*dtby2*fc2(:) - vel(:, index_c) = vel(:, index_c)+imass3*dtby2*fc3(:) + vel(:, index_a) = vel(:, index_a) + imass1*dtby2*fc1(:) + vel(:, index_b) = vel(:, index_b) + imass2*dtby2*fc2(:) + vel(:, index_c) = vel(:, index_c) + imass3*dtby2*fc3(:) END DO END SUBROUTINE rattle_roll_3x3_low @@ -811,15 +811,15 @@ SUBROUTINE rattle_3x3_low(fixd_list, g3x3_list, lg3x3, first_atom, & dtby2 = dt*.5_dp DO iconst = 1, SIZE(g3x3_list) IF (g3x3_list(iconst)%restraint%active) CYCLE - index_a = g3x3_list(iconst)%a+first_atom-1 - index_b = g3x3_list(iconst)%b+first_atom-1 - index_c = g3x3_list(iconst)%c+first_atom-1 - v12(:) = vel(:, index_a)-vel(:, index_b) - v13(:) = vel(:, index_a)-vel(:, index_c) - v23(:) = vel(:, index_b)-vel(:, index_c) - r12(:) = particle_set(index_a)%r(:)-particle_set(index_b)%r(:) - r13(:) = particle_set(index_a)%r(:)-particle_set(index_c)%r(:) - r23(:) = particle_set(index_b)%r(:)-particle_set(index_c)%r(:) + index_a = g3x3_list(iconst)%a + first_atom - 1 + index_b = g3x3_list(iconst)%b + first_atom - 1 + index_c = g3x3_list(iconst)%c + first_atom - 1 + v12(:) = vel(:, index_a) - vel(:, index_b) + v13(:) = vel(:, index_a) - vel(:, index_c) + v23(:) = vel(:, index_b) - vel(:, index_c) + r12(:) = particle_set(index_a)%r(:) - particle_set(index_b)%r(:) + r13(:) = particle_set(index_a)%r(:) - particle_set(index_c)%r(:) + r23(:) = particle_set(index_b)%r(:) - particle_set(index_c)%r(:) atomic_kind => particle_set(index_a)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) imass1 = 1.0_dp/mass @@ -836,15 +836,15 @@ SUBROUTINE rattle_3x3_low(fixd_list, g3x3_list, lg3x3, first_atom, & CALL check_fixed_atom_cns_g3x3(imass1, imass2, imass3, & index_a, index_b, index_c, fixd_list, lg3x3(iconst)) ! construct matrix - amat(1, 1) = (imass1+imass2)*DOTPROD_3D(r12, lg3x3(iconst)%fa) + amat(1, 1) = (imass1 + imass2)*DOTPROD_3D(r12, lg3x3(iconst)%fa) amat(1, 2) = imass1*DOTPROD_3D(r12, lg3x3(iconst)%fb) amat(1, 3) = -imass2*DOTPROD_3D(r12, lg3x3(iconst)%fc) amat(2, 1) = imass1*DOTPROD_3D(r13, lg3x3(iconst)%fa) - amat(2, 2) = (imass1+imass3)*DOTPROD_3D(r13, lg3x3(iconst)%fb) + amat(2, 2) = (imass1 + imass3)*DOTPROD_3D(r13, lg3x3(iconst)%fb) amat(2, 3) = imass3*DOTPROD_3D(r13, lg3x3(iconst)%fc) amat(3, 1) = -imass2*DOTPROD_3D(r23, lg3x3(iconst)%fa) amat(3, 2) = imass3*DOTPROD_3D(r23, lg3x3(iconst)%fb) - amat(3, 3) = (imass2+imass3)*DOTPROD_3D(r23, lg3x3(iconst)%fc) + amat(3, 3) = (imass2 + imass3)*DOTPROD_3D(r23, lg3x3(iconst)%fc) ! construct solution vector bvec(1, 1) = DOTPROD_3D(r12, v12) @@ -856,15 +856,15 @@ SUBROUTINE rattle_3x3_low(fixd_list, g3x3_list, lg3x3, first_atom, & CALL solve_system(amat, 3, bvec) lg3x3(iconst)%lambda(:) = bvec(:, 1) - fc1 = lg3x3(iconst)%lambda(1)*lg3x3(iconst)%fa+ & + fc1 = lg3x3(iconst)%lambda(1)*lg3x3(iconst)%fa + & lg3x3(iconst)%lambda(2)*lg3x3(iconst)%fb - fc2 = -lg3x3(iconst)%lambda(1)*lg3x3(iconst)%fa+ & + fc2 = -lg3x3(iconst)%lambda(1)*lg3x3(iconst)%fa + & lg3x3(iconst)%lambda(3)*lg3x3(iconst)%fc - fc3 = -lg3x3(iconst)%lambda(2)*lg3x3(iconst)%fb- & + fc3 = -lg3x3(iconst)%lambda(2)*lg3x3(iconst)%fb - & lg3x3(iconst)%lambda(3)*lg3x3(iconst)%fc - vel(:, index_a) = vel(:, index_a)+imass1*dtby2*fc1(:) - vel(:, index_b) = vel(:, index_b)+imass2*dtby2*fc2(:) - vel(:, index_c) = vel(:, index_c)+imass3*dtby2*fc3(:) + vel(:, index_a) = vel(:, index_a) + imass1*dtby2*fc1(:) + vel(:, index_b) = vel(:, index_b) + imass2*dtby2*fc2(:) + vel(:, index_c) = vel(:, index_c) + imass3*dtby2*fc3(:) END DO END SUBROUTINE rattle_3x3_low diff --git a/src/constraint_4x6.F b/src/constraint_4x6.F index 3f83740063..e4d0a2aed7 100644 --- a/src/constraint_4x6.F +++ b/src/constraint_4x6.F @@ -380,17 +380,17 @@ SUBROUTINE shake_4x6_low(fixd_list, g4x6_list, lg4x6, ng4x6, first_atom, & dtby2 = dt*.5_dp DO iconst = 1, ng4x6 IF (g4x6_list(iconst)%restraint%active) CYCLE - index_a = g4x6_list(iconst)%a+first_atom-1 - index_b = g4x6_list(iconst)%b+first_atom-1 - index_c = g4x6_list(iconst)%c+first_atom-1 - index_d = g4x6_list(iconst)%d+first_atom-1 + index_a = g4x6_list(iconst)%a + first_atom - 1 + index_b = g4x6_list(iconst)%b + first_atom - 1 + index_c = g4x6_list(iconst)%c + first_atom - 1 + index_d = g4x6_list(iconst)%d + first_atom - 1 IF (ishake == 1) THEN - r0_12(:) = pos(:, index_a)-pos(:, index_b) - r0_13(:) = pos(:, index_a)-pos(:, index_c) - r0_14(:) = pos(:, index_a)-pos(:, index_d) - r0_23(:) = pos(:, index_b)-pos(:, index_c) - r0_24(:) = pos(:, index_b)-pos(:, index_d) - r0_34(:) = pos(:, index_c)-pos(:, index_d) + r0_12(:) = pos(:, index_a) - pos(:, index_b) + r0_13(:) = pos(:, index_a) - pos(:, index_c) + r0_14(:) = pos(:, index_a) - pos(:, index_d) + r0_23(:) = pos(:, index_b) - pos(:, index_c) + r0_24(:) = pos(:, index_b) - pos(:, index_d) + r0_34(:) = pos(:, index_c) - pos(:, index_d) atomic_kind => particle_set(index_a)%atomic_kind imass1 = 1.0_dp/atomic_kind%mass atomic_kind => particle_set(index_b)%atomic_kind @@ -399,23 +399,23 @@ SUBROUTINE shake_4x6_low(fixd_list, g4x6_list, lg4x6, ng4x6, first_atom, & imass3 = 1.0_dp/atomic_kind%mass atomic_kind => particle_set(index_d)%atomic_kind imass4 = 1.0_dp/atomic_kind%mass - lg4x6(iconst)%fa = -2.0_dp*(lg4x6(iconst)%ra_old- & + lg4x6(iconst)%fa = -2.0_dp*(lg4x6(iconst)%ra_old - & lg4x6(iconst)%rb_old) - lg4x6(iconst)%fb = -2.0_dp*(lg4x6(iconst)%ra_old- & + lg4x6(iconst)%fb = -2.0_dp*(lg4x6(iconst)%ra_old - & lg4x6(iconst)%rc_old) - lg4x6(iconst)%fc = -2.0_dp*(lg4x6(iconst)%ra_old- & + lg4x6(iconst)%fc = -2.0_dp*(lg4x6(iconst)%ra_old - & lg4x6(iconst)%rd_old) - lg4x6(iconst)%fd = -2.0_dp*(lg4x6(iconst)%rb_old- & + lg4x6(iconst)%fd = -2.0_dp*(lg4x6(iconst)%rb_old - & lg4x6(iconst)%rc_old) - lg4x6(iconst)%fe = -2.0_dp*(lg4x6(iconst)%rb_old- & + lg4x6(iconst)%fe = -2.0_dp*(lg4x6(iconst)%rb_old - & lg4x6(iconst)%rd_old) - lg4x6(iconst)%ff = -2.0_dp*(lg4x6(iconst)%rc_old- & + lg4x6(iconst)%ff = -2.0_dp*(lg4x6(iconst)%rc_old - & lg4x6(iconst)%rd_old) ! Check for fixed atom constraints CALL check_fixed_atom_cns_g4x6(imass1, imass2, imass3, imass4, & index_a, index_b, index_c, index_d, fixd_list, lg4x6(iconst)) ! construct matrix - amat(1, 1) = (imass1+imass2)*DOTPROD_3D(r0_12, lg4x6(iconst)%fa) + amat(1, 1) = (imass1 + imass2)*DOTPROD_3D(r0_12, lg4x6(iconst)%fa) amat(1, 2) = imass1*DOTPROD_3D(r0_12, lg4x6(iconst)%fb) amat(1, 3) = imass1*DOTPROD_3D(r0_12, lg4x6(iconst)%fc) amat(1, 4) = -imass2*DOTPROD_3D(r0_12, lg4x6(iconst)%fd) @@ -423,7 +423,7 @@ SUBROUTINE shake_4x6_low(fixd_list, g4x6_list, lg4x6, ng4x6, first_atom, & amat(1, 6) = 0.0_dp amat(2, 1) = imass1*DOTPROD_3D(r0_13, lg4x6(iconst)%fa) - amat(2, 2) = (imass1+imass3)*DOTPROD_3D(r0_13, lg4x6(iconst)%fb) + amat(2, 2) = (imass1 + imass3)*DOTPROD_3D(r0_13, lg4x6(iconst)%fb) amat(2, 3) = imass1*DOTPROD_3D(r0_13, lg4x6(iconst)%fc) amat(2, 4) = imass3*DOTPROD_3D(r0_13, lg4x6(iconst)%fd) amat(2, 5) = 0.0_dp @@ -431,7 +431,7 @@ SUBROUTINE shake_4x6_low(fixd_list, g4x6_list, lg4x6, ng4x6, first_atom, & amat(3, 1) = imass1*DOTPROD_3D(r0_14, lg4x6(iconst)%fa) amat(3, 2) = imass1*DOTPROD_3D(r0_14, lg4x6(iconst)%fb) - amat(3, 3) = (imass1+imass4)*DOTPROD_3D(r0_14, lg4x6(iconst)%fc) + amat(3, 3) = (imass1 + imass4)*DOTPROD_3D(r0_14, lg4x6(iconst)%fc) amat(3, 4) = 0.0_dp amat(3, 5) = imass4*DOTPROD_3D(r0_14, lg4x6(iconst)%fe) amat(3, 6) = imass4*DOTPROD_3D(r0_14, lg4x6(iconst)%ff) @@ -439,7 +439,7 @@ SUBROUTINE shake_4x6_low(fixd_list, g4x6_list, lg4x6, ng4x6, first_atom, & amat(4, 1) = -imass2*DOTPROD_3D(r0_23, lg4x6(iconst)%fa) amat(4, 2) = imass3*DOTPROD_3D(r0_23, lg4x6(iconst)%fb) amat(4, 3) = 0.0_dp - amat(4, 4) = (imass3+imass2)*DOTPROD_3D(r0_23, lg4x6(iconst)%fd) + amat(4, 4) = (imass3 + imass2)*DOTPROD_3D(r0_23, lg4x6(iconst)%fd) amat(4, 5) = imass2*DOTPROD_3D(r0_23, lg4x6(iconst)%fe) amat(4, 6) = -imass3*DOTPROD_3D(r0_23, lg4x6(iconst)%ff) @@ -447,7 +447,7 @@ SUBROUTINE shake_4x6_low(fixd_list, g4x6_list, lg4x6, ng4x6, first_atom, & amat(5, 2) = 0.0_dp amat(5, 3) = imass4*DOTPROD_3D(r0_24, lg4x6(iconst)%fc) amat(5, 4) = imass2*DOTPROD_3D(r0_24, lg4x6(iconst)%fd) - amat(5, 5) = (imass4+imass2)*DOTPROD_3D(r0_24, lg4x6(iconst)%fe) + amat(5, 5) = (imass4 + imass2)*DOTPROD_3D(r0_24, lg4x6(iconst)%fe) amat(5, 6) = imass4*DOTPROD_3D(r0_24, lg4x6(iconst)%ff) amat(6, 1) = 0.0_dp @@ -455,7 +455,7 @@ SUBROUTINE shake_4x6_low(fixd_list, g4x6_list, lg4x6, ng4x6, first_atom, & amat(6, 3) = imass4*DOTPROD_3D(r0_34, lg4x6(iconst)%fc) amat(6, 4) = -imass3*DOTPROD_3D(r0_34, lg4x6(iconst)%fd) amat(6, 5) = imass4*DOTPROD_3D(r0_34, lg4x6(iconst)%fe) - amat(6, 6) = (imass3+imass4)*DOTPROD_3D(r0_34, lg4x6(iconst)%ff) + amat(6, 6) = (imass3 + imass4)*DOTPROD_3D(r0_34, lg4x6(iconst)%ff) ! Store values lg4x6(iconst)%r0_12 = r0_12 lg4x6(iconst)%r0_13 = r0_13 @@ -486,101 +486,101 @@ SUBROUTINE shake_4x6_low(fixd_list, g4x6_list, lg4x6, ng4x6, first_atom, & END IF ! Iterate until convergence: - vec = lg4x6(iconst)%lambda(1)*lg4x6(iconst)%fa*(imass1+imass2)+ & - lg4x6(iconst)%lambda(2)*imass1*lg4x6(iconst)%fb+ & - lg4x6(iconst)%lambda(3)*imass1*lg4x6(iconst)%fc- & - lg4x6(iconst)%lambda(4)*imass2*lg4x6(iconst)%fd- & + vec = lg4x6(iconst)%lambda(1)*lg4x6(iconst)%fa*(imass1 + imass2) + & + lg4x6(iconst)%lambda(2)*imass1*lg4x6(iconst)%fb + & + lg4x6(iconst)%lambda(3)*imass1*lg4x6(iconst)%fc - & + lg4x6(iconst)%lambda(4)*imass2*lg4x6(iconst)%fd - & lg4x6(iconst)%lambda(5)*imass2*lg4x6(iconst)%fe bvec(1, 1) = g4x6_list(iconst)%dab*g4x6_list(iconst)%dab & - -dtsqby2*dtsqby2*DOTPROD_3D(vec, vec)-DOTPROD_3D(r0_12, r0_12) - vec = lg4x6(iconst)%lambda(2)*lg4x6(iconst)%fb*(imass1+imass3)+ & - lg4x6(iconst)%lambda(1)*imass1*lg4x6(iconst)%fa+ & - lg4x6(iconst)%lambda(3)*imass1*lg4x6(iconst)%fc+ & - lg4x6(iconst)%lambda(4)*imass3*lg4x6(iconst)%fd- & + - dtsqby2*dtsqby2*DOTPROD_3D(vec, vec) - DOTPROD_3D(r0_12, r0_12) + vec = lg4x6(iconst)%lambda(2)*lg4x6(iconst)%fb*(imass1 + imass3) + & + lg4x6(iconst)%lambda(1)*imass1*lg4x6(iconst)%fa + & + lg4x6(iconst)%lambda(3)*imass1*lg4x6(iconst)%fc + & + lg4x6(iconst)%lambda(4)*imass3*lg4x6(iconst)%fd - & lg4x6(iconst)%lambda(6)*imass3*lg4x6(iconst)%ff bvec(2, 1) = g4x6_list(iconst)%dac*g4x6_list(iconst)%dac & - -dtsqby2*dtsqby2*DOTPROD_3D(vec, vec)-DOTPROD_3D(r0_13, r0_13) - vec = lg4x6(iconst)%lambda(3)*lg4x6(iconst)%fc*(imass1+imass4)+ & - lg4x6(iconst)%lambda(1)*imass1*lg4x6(iconst)%fa+ & - lg4x6(iconst)%lambda(2)*imass1*lg4x6(iconst)%fb+ & - lg4x6(iconst)%lambda(5)*imass4*lg4x6(iconst)%fe+ & + - dtsqby2*dtsqby2*DOTPROD_3D(vec, vec) - DOTPROD_3D(r0_13, r0_13) + vec = lg4x6(iconst)%lambda(3)*lg4x6(iconst)%fc*(imass1 + imass4) + & + lg4x6(iconst)%lambda(1)*imass1*lg4x6(iconst)%fa + & + lg4x6(iconst)%lambda(2)*imass1*lg4x6(iconst)%fb + & + lg4x6(iconst)%lambda(5)*imass4*lg4x6(iconst)%fe + & lg4x6(iconst)%lambda(6)*imass4*lg4x6(iconst)%ff bvec(3, 1) = g4x6_list(iconst)%dad*g4x6_list(iconst)%dad & - -dtsqby2*dtsqby2*DOTPROD_3D(vec, vec)-DOTPROD_3D(r0_14, r0_14) - vec = lg4x6(iconst)%lambda(4)*lg4x6(iconst)%fd*(imass2+imass3)- & - lg4x6(iconst)%lambda(1)*imass2*lg4x6(iconst)%fa+ & - lg4x6(iconst)%lambda(2)*imass3*lg4x6(iconst)%fb+ & - lg4x6(iconst)%lambda(5)*imass2*lg4x6(iconst)%fe- & + - dtsqby2*dtsqby2*DOTPROD_3D(vec, vec) - DOTPROD_3D(r0_14, r0_14) + vec = lg4x6(iconst)%lambda(4)*lg4x6(iconst)%fd*(imass2 + imass3) - & + lg4x6(iconst)%lambda(1)*imass2*lg4x6(iconst)%fa + & + lg4x6(iconst)%lambda(2)*imass3*lg4x6(iconst)%fb + & + lg4x6(iconst)%lambda(5)*imass2*lg4x6(iconst)%fe - & lg4x6(iconst)%lambda(6)*imass3*lg4x6(iconst)%ff bvec(4, 1) = g4x6_list(iconst)%dbc*g4x6_list(iconst)%dbc & - -dtsqby2*dtsqby2*DOTPROD_3D(vec, vec)-DOTPROD_3D(r0_23, r0_23) - vec = lg4x6(iconst)%lambda(5)*lg4x6(iconst)%fe*(imass2+imass4)- & - lg4x6(iconst)%lambda(1)*imass2*lg4x6(iconst)%fa+ & - lg4x6(iconst)%lambda(3)*imass4*lg4x6(iconst)%fc+ & - lg4x6(iconst)%lambda(4)*imass2*lg4x6(iconst)%fd+ & + - dtsqby2*dtsqby2*DOTPROD_3D(vec, vec) - DOTPROD_3D(r0_23, r0_23) + vec = lg4x6(iconst)%lambda(5)*lg4x6(iconst)%fe*(imass2 + imass4) - & + lg4x6(iconst)%lambda(1)*imass2*lg4x6(iconst)%fa + & + lg4x6(iconst)%lambda(3)*imass4*lg4x6(iconst)%fc + & + lg4x6(iconst)%lambda(4)*imass2*lg4x6(iconst)%fd + & lg4x6(iconst)%lambda(6)*imass4*lg4x6(iconst)%ff bvec(5, 1) = g4x6_list(iconst)%dbd*g4x6_list(iconst)%dbd & - -dtsqby2*dtsqby2*DOTPROD_3D(vec, vec)-DOTPROD_3D(r0_24, r0_24) - vec = lg4x6(iconst)%lambda(6)*lg4x6(iconst)%ff*(imass3+imass4)- & - lg4x6(iconst)%lambda(2)*imass3*lg4x6(iconst)%fb+ & - lg4x6(iconst)%lambda(3)*imass4*lg4x6(iconst)%fc- & - lg4x6(iconst)%lambda(4)*imass3*lg4x6(iconst)%fd+ & + - dtsqby2*dtsqby2*DOTPROD_3D(vec, vec) - DOTPROD_3D(r0_24, r0_24) + vec = lg4x6(iconst)%lambda(6)*lg4x6(iconst)%ff*(imass3 + imass4) - & + lg4x6(iconst)%lambda(2)*imass3*lg4x6(iconst)%fb + & + lg4x6(iconst)%lambda(3)*imass4*lg4x6(iconst)%fc - & + lg4x6(iconst)%lambda(4)*imass3*lg4x6(iconst)%fd + & lg4x6(iconst)%lambda(5)*imass4*lg4x6(iconst)%fe bvec(6, 1) = g4x6_list(iconst)%dcd*g4x6_list(iconst)%dcd & - -dtsqby2*dtsqby2*DOTPROD_3D(vec, vec)-DOTPROD_3D(r0_34, r0_34) + - dtsqby2*dtsqby2*DOTPROD_3D(vec, vec) - DOTPROD_3D(r0_34, r0_34) bvec = bvec*idtsq ! get lambda atemp = amat CALL solve_system(atemp, 6, bvec) lg4x6(iconst)%lambda(:) = bvec(:, 1) - lg4x6(iconst)%del_lambda(:) = lg4x6(iconst)%lambda(:)- & + lg4x6(iconst)%del_lambda(:) = lg4x6(iconst)%lambda(:) - & lg4x6(iconst)%lambda_old(:) lg4x6(iconst)%lambda_old(:) = lg4x6(iconst)%lambda(:) - fc1 = lg4x6(iconst)%del_lambda(1)*lg4x6(iconst)%fa+ & - lg4x6(iconst)%del_lambda(2)*lg4x6(iconst)%fb+ & + fc1 = lg4x6(iconst)%del_lambda(1)*lg4x6(iconst)%fa + & + lg4x6(iconst)%del_lambda(2)*lg4x6(iconst)%fb + & lg4x6(iconst)%del_lambda(3)*lg4x6(iconst)%fc - fc2 = -lg4x6(iconst)%del_lambda(1)*lg4x6(iconst)%fa+ & - lg4x6(iconst)%del_lambda(4)*lg4x6(iconst)%fd+ & + fc2 = -lg4x6(iconst)%del_lambda(1)*lg4x6(iconst)%fa + & + lg4x6(iconst)%del_lambda(4)*lg4x6(iconst)%fd + & lg4x6(iconst)%del_lambda(5)*lg4x6(iconst)%fe - fc3 = -lg4x6(iconst)%del_lambda(2)*lg4x6(iconst)%fb- & - lg4x6(iconst)%del_lambda(4)*lg4x6(iconst)%fd+ & + fc3 = -lg4x6(iconst)%del_lambda(2)*lg4x6(iconst)%fb - & + lg4x6(iconst)%del_lambda(4)*lg4x6(iconst)%fd + & lg4x6(iconst)%del_lambda(6)*lg4x6(iconst)%ff - fc4 = -lg4x6(iconst)%del_lambda(3)*lg4x6(iconst)%fc- & - lg4x6(iconst)%del_lambda(5)*lg4x6(iconst)%fe- & + fc4 = -lg4x6(iconst)%del_lambda(3)*lg4x6(iconst)%fc - & + lg4x6(iconst)%del_lambda(5)*lg4x6(iconst)%fe - & lg4x6(iconst)%del_lambda(6)*lg4x6(iconst)%ff - r1(:) = pos(:, index_a)+imass1*dtsqby2*fc1(:) - r2(:) = pos(:, index_b)+imass2*dtsqby2*fc2(:) - r3(:) = pos(:, index_c)+imass3*dtsqby2*fc3(:) - r4(:) = pos(:, index_d)+imass4*dtsqby2*fc4(:) - v1(:) = vel(:, index_a)+imass1*dtby2*fc1(:) - v2(:) = vel(:, index_b)+imass2*dtby2*fc2(:) - v3(:) = vel(:, index_c)+imass3*dtby2*fc3(:) - v4(:) = vel(:, index_d)+imass4*dtby2*fc4(:) - r12 = r1-r2 - r13 = r1-r3 - r14 = r1-r4 - r23 = r2-r3 - r24 = r2-r4 - r34 = r3-r4 + r1(:) = pos(:, index_a) + imass1*dtsqby2*fc1(:) + r2(:) = pos(:, index_b) + imass2*dtsqby2*fc2(:) + r3(:) = pos(:, index_c) + imass3*dtsqby2*fc3(:) + r4(:) = pos(:, index_d) + imass4*dtsqby2*fc4(:) + v1(:) = vel(:, index_a) + imass1*dtby2*fc1(:) + v2(:) = vel(:, index_b) + imass2*dtby2*fc2(:) + v3(:) = vel(:, index_c) + imass3*dtby2*fc3(:) + v4(:) = vel(:, index_d) + imass4*dtby2*fc4(:) + r12 = r1 - r2 + r13 = r1 - r3 + r14 = r1 - r4 + r23 = r2 - r3 + r24 = r2 - r4 + r34 = r3 - r4 ! compute the tolerance: - sigma = DOT_PRODUCT(r12, r12)-g4x6_list(iconst)%dab* & + sigma = DOT_PRODUCT(r12, r12) - g4x6_list(iconst)%dab* & g4x6_list(iconst)%dab max_sigma = MAX(max_sigma, ABS(sigma)) - sigma = DOT_PRODUCT(r13, r13)-g4x6_list(iconst)%dac* & + sigma = DOT_PRODUCT(r13, r13) - g4x6_list(iconst)%dac* & g4x6_list(iconst)%dac max_sigma = MAX(max_sigma, ABS(sigma)) - sigma = DOT_PRODUCT(r14, r14)-g4x6_list(iconst)%dad* & + sigma = DOT_PRODUCT(r14, r14) - g4x6_list(iconst)%dad* & g4x6_list(iconst)%dad max_sigma = MAX(max_sigma, ABS(sigma)) - sigma = DOT_PRODUCT(r23, r23)-g4x6_list(iconst)%dbc* & + sigma = DOT_PRODUCT(r23, r23) - g4x6_list(iconst)%dbc* & g4x6_list(iconst)%dbc max_sigma = MAX(max_sigma, ABS(sigma)) - sigma = DOT_PRODUCT(r24, r24)-g4x6_list(iconst)%dbd* & + sigma = DOT_PRODUCT(r24, r24) - g4x6_list(iconst)%dbd* & g4x6_list(iconst)%dbd max_sigma = MAX(max_sigma, ABS(sigma)) - sigma = DOT_PRODUCT(r34, r34)-g4x6_list(iconst)%dcd* & + sigma = DOT_PRODUCT(r34, r34) - g4x6_list(iconst)%dcd* & g4x6_list(iconst)%dcd max_sigma = MAX(max_sigma, ABS(sigma)) @@ -644,17 +644,17 @@ SUBROUTINE shake_roll_4x6_low(fixd_list, g4x6_list, lg4x6, ng4x6, first_atom, & dtby2 = dt*.5_dp DO iconst = 1, ng4x6 IF (g4x6_list(iconst)%restraint%active) CYCLE - index_a = g4x6_list(iconst)%a+first_atom-1 - index_b = g4x6_list(iconst)%b+first_atom-1 - index_c = g4x6_list(iconst)%c+first_atom-1 - index_d = g4x6_list(iconst)%d+first_atom-1 + index_a = g4x6_list(iconst)%a + first_atom - 1 + index_b = g4x6_list(iconst)%b + first_atom - 1 + index_c = g4x6_list(iconst)%c + first_atom - 1 + index_d = g4x6_list(iconst)%d + first_atom - 1 IF (ishake == 1) THEN - r0_12(:) = pos(:, index_a)-pos(:, index_b) - r0_13(:) = pos(:, index_a)-pos(:, index_c) - r0_23(:) = pos(:, index_b)-pos(:, index_c) - r0_14(:) = pos(:, index_a)-pos(:, index_d) - r0_24(:) = pos(:, index_b)-pos(:, index_d) - r0_34(:) = pos(:, index_c)-pos(:, index_d) + r0_12(:) = pos(:, index_a) - pos(:, index_b) + r0_13(:) = pos(:, index_a) - pos(:, index_c) + r0_23(:) = pos(:, index_b) - pos(:, index_c) + r0_14(:) = pos(:, index_a) - pos(:, index_d) + r0_24(:) = pos(:, index_b) - pos(:, index_d) + r0_34(:) = pos(:, index_c) - pos(:, index_d) atomic_kind => particle_set(index_a)%atomic_kind imass1 = 1.0_dp/atomic_kind%mass atomic_kind => particle_set(index_b)%atomic_kind @@ -663,17 +663,17 @@ SUBROUTINE shake_roll_4x6_low(fixd_list, g4x6_list, lg4x6, ng4x6, first_atom, & imass3 = 1.0_dp/atomic_kind%mass atomic_kind => particle_set(index_d)%atomic_kind imass4 = 1.0_dp/atomic_kind%mass - lg4x6(iconst)%fa = -2.0_dp*(lg4x6(iconst)%ra_old- & + lg4x6(iconst)%fa = -2.0_dp*(lg4x6(iconst)%ra_old - & lg4x6(iconst)%rb_old) - lg4x6(iconst)%fb = -2.0_dp*(lg4x6(iconst)%ra_old- & + lg4x6(iconst)%fb = -2.0_dp*(lg4x6(iconst)%ra_old - & lg4x6(iconst)%rc_old) - lg4x6(iconst)%fc = -2.0_dp*(lg4x6(iconst)%ra_old- & + lg4x6(iconst)%fc = -2.0_dp*(lg4x6(iconst)%ra_old - & lg4x6(iconst)%rd_old) - lg4x6(iconst)%fd = -2.0_dp*(lg4x6(iconst)%rb_old- & + lg4x6(iconst)%fd = -2.0_dp*(lg4x6(iconst)%rb_old - & lg4x6(iconst)%rc_old) - lg4x6(iconst)%fe = -2.0_dp*(lg4x6(iconst)%rb_old- & + lg4x6(iconst)%fe = -2.0_dp*(lg4x6(iconst)%rb_old - & lg4x6(iconst)%rd_old) - lg4x6(iconst)%ff = -2.0_dp*(lg4x6(iconst)%rc_old- & + lg4x6(iconst)%ff = -2.0_dp*(lg4x6(iconst)%rc_old - & lg4x6(iconst)%rd_old) ! Check for fixed atom constraints CALL check_fixed_atom_cns_g4x6(imass1, imass2, imass3, imass4, & @@ -687,7 +687,7 @@ SUBROUTINE shake_roll_4x6_low(fixd_list, g4x6_list, lg4x6, ng4x6, first_atom, & CALL matvec_3x3(f_roll6, r_shake, lg4x6(iconst)%ff) ! construct matrix - amat(1, 1) = (imass1+imass2)*DOTPROD_3D(r0_12, f_roll1) + amat(1, 1) = (imass1 + imass2)*DOTPROD_3D(r0_12, f_roll1) amat(1, 2) = imass1*DOTPROD_3D(r0_12, f_roll2) amat(1, 3) = imass1*DOTPROD_3D(r0_12, f_roll3) amat(1, 4) = -imass2*DOTPROD_3D(r0_12, f_roll4) @@ -695,7 +695,7 @@ SUBROUTINE shake_roll_4x6_low(fixd_list, g4x6_list, lg4x6, ng4x6, first_atom, & amat(1, 6) = 0.0_dp amat(2, 1) = imass1*DOTPROD_3D(r0_13, f_roll1) - amat(2, 2) = (imass1+imass3)*DOTPROD_3D(r0_13, f_roll2) + amat(2, 2) = (imass1 + imass3)*DOTPROD_3D(r0_13, f_roll2) amat(2, 3) = imass1*DOTPROD_3D(r0_13, f_roll3) amat(2, 4) = imass3*DOTPROD_3D(r0_13, f_roll4) amat(2, 5) = 0.0_dp @@ -703,7 +703,7 @@ SUBROUTINE shake_roll_4x6_low(fixd_list, g4x6_list, lg4x6, ng4x6, first_atom, & amat(3, 1) = imass1*DOTPROD_3D(r0_14, f_roll1) amat(3, 2) = imass1*DOTPROD_3D(r0_14, f_roll2) - amat(3, 3) = (imass1+imass4)*DOTPROD_3D(r0_14, f_roll3) + amat(3, 3) = (imass1 + imass4)*DOTPROD_3D(r0_14, f_roll3) amat(3, 4) = 0.0_dp amat(3, 5) = imass4*DOTPROD_3D(r0_14, f_roll5) amat(3, 6) = imass4*DOTPROD_3D(r0_14, f_roll6) @@ -711,7 +711,7 @@ SUBROUTINE shake_roll_4x6_low(fixd_list, g4x6_list, lg4x6, ng4x6, first_atom, & amat(4, 1) = -imass2*DOTPROD_3D(r0_23, f_roll1) amat(4, 2) = imass3*DOTPROD_3D(r0_23, f_roll2) amat(4, 3) = 0.0_dp - amat(4, 4) = (imass3+imass2)*DOTPROD_3D(r0_23, f_roll4) + amat(4, 4) = (imass3 + imass2)*DOTPROD_3D(r0_23, f_roll4) amat(4, 5) = imass2*DOTPROD_3D(r0_23, f_roll5) amat(4, 6) = -imass3*DOTPROD_3D(r0_23, f_roll6) @@ -719,7 +719,7 @@ SUBROUTINE shake_roll_4x6_low(fixd_list, g4x6_list, lg4x6, ng4x6, first_atom, & amat(5, 2) = 0.0_dp amat(5, 3) = imass4*DOTPROD_3D(r0_24, f_roll3) amat(5, 4) = imass2*DOTPROD_3D(r0_24, f_roll4) - amat(5, 5) = (imass4+imass2)*DOTPROD_3D(r0_24, f_roll5) + amat(5, 5) = (imass4 + imass2)*DOTPROD_3D(r0_24, f_roll5) amat(5, 6) = imass4*DOTPROD_3D(r0_24, f_roll6) amat(6, 1) = 0.0_dp @@ -727,7 +727,7 @@ SUBROUTINE shake_roll_4x6_low(fixd_list, g4x6_list, lg4x6, ng4x6, first_atom, & amat(6, 3) = imass4*DOTPROD_3D(r0_34, f_roll3) amat(6, 4) = -imass3*DOTPROD_3D(r0_34, f_roll4) amat(6, 5) = imass4*DOTPROD_3D(r0_34, f_roll5) - amat(6, 6) = (imass3+imass4)*DOTPROD_3D(r0_34, f_roll6) + amat(6, 6) = (imass3 + imass4)*DOTPROD_3D(r0_34, f_roll6) ! Store values lg4x6(iconst)%r0_12 = r0_12 lg4x6(iconst)%r0_13 = r0_13 @@ -770,110 +770,110 @@ SUBROUTINE shake_roll_4x6_low(fixd_list, g4x6_list, lg4x6, ng4x6, first_atom, & END IF ! Iterate until convergence: - vec = lg4x6(iconst)%lambda(1)*f_roll1*(imass1+imass2)+ & - lg4x6(iconst)%lambda(2)*imass1*f_roll2+ & - lg4x6(iconst)%lambda(3)*imass1*f_roll3- & - lg4x6(iconst)%lambda(4)*imass2*f_roll4- & + vec = lg4x6(iconst)%lambda(1)*f_roll1*(imass1 + imass2) + & + lg4x6(iconst)%lambda(2)*imass1*f_roll2 + & + lg4x6(iconst)%lambda(3)*imass1*f_roll3 - & + lg4x6(iconst)%lambda(4)*imass2*f_roll4 - & lg4x6(iconst)%lambda(5)*imass2*f_roll5 bvec(1, 1) = g4x6_list(iconst)%dab*g4x6_list(iconst)%dab & - -dtsqby2*dtsqby2*DOTPROD_3D(vec, vec)-DOTPROD_3D(r0_12, r0_12) - vec = lg4x6(iconst)%lambda(2)*f_roll2*(imass1+imass3)+ & - lg4x6(iconst)%lambda(1)*imass1*f_roll1+ & - lg4x6(iconst)%lambda(3)*imass1*f_roll3+ & - lg4x6(iconst)%lambda(4)*imass3*f_roll4- & + - dtsqby2*dtsqby2*DOTPROD_3D(vec, vec) - DOTPROD_3D(r0_12, r0_12) + vec = lg4x6(iconst)%lambda(2)*f_roll2*(imass1 + imass3) + & + lg4x6(iconst)%lambda(1)*imass1*f_roll1 + & + lg4x6(iconst)%lambda(3)*imass1*f_roll3 + & + lg4x6(iconst)%lambda(4)*imass3*f_roll4 - & lg4x6(iconst)%lambda(6)*imass3*f_roll6 bvec(2, 1) = g4x6_list(iconst)%dac*g4x6_list(iconst)%dac & - -dtsqby2*dtsqby2*DOTPROD_3D(vec, vec)-DOTPROD_3D(r0_13, r0_13) - vec = lg4x6(iconst)%lambda(3)*f_roll3*(imass1+imass4)+ & - lg4x6(iconst)%lambda(1)*imass1*f_roll1+ & - lg4x6(iconst)%lambda(2)*imass1*f_roll2+ & - lg4x6(iconst)%lambda(5)*imass4*f_roll5+ & + - dtsqby2*dtsqby2*DOTPROD_3D(vec, vec) - DOTPROD_3D(r0_13, r0_13) + vec = lg4x6(iconst)%lambda(3)*f_roll3*(imass1 + imass4) + & + lg4x6(iconst)%lambda(1)*imass1*f_roll1 + & + lg4x6(iconst)%lambda(2)*imass1*f_roll2 + & + lg4x6(iconst)%lambda(5)*imass4*f_roll5 + & lg4x6(iconst)%lambda(6)*imass4*f_roll6 bvec(3, 1) = g4x6_list(iconst)%dad*g4x6_list(iconst)%dad & - -dtsqby2*dtsqby2*DOTPROD_3D(vec, vec)-DOTPROD_3D(r0_14, r0_14) - vec = lg4x6(iconst)%lambda(4)*f_roll4*(imass2+imass3)- & - lg4x6(iconst)%lambda(1)*imass2*f_roll1+ & - lg4x6(iconst)%lambda(2)*imass3*f_roll2+ & - lg4x6(iconst)%lambda(5)*imass2*f_roll5- & + - dtsqby2*dtsqby2*DOTPROD_3D(vec, vec) - DOTPROD_3D(r0_14, r0_14) + vec = lg4x6(iconst)%lambda(4)*f_roll4*(imass2 + imass3) - & + lg4x6(iconst)%lambda(1)*imass2*f_roll1 + & + lg4x6(iconst)%lambda(2)*imass3*f_roll2 + & + lg4x6(iconst)%lambda(5)*imass2*f_roll5 - & lg4x6(iconst)%lambda(6)*imass3*f_roll6 bvec(4, 1) = g4x6_list(iconst)%dbc*g4x6_list(iconst)%dbc & - -dtsqby2*dtsqby2*DOTPROD_3D(vec, vec)-DOTPROD_3D(r0_23, r0_23) - vec = lg4x6(iconst)%lambda(5)*f_roll5*(imass2+imass4)- & - lg4x6(iconst)%lambda(1)*imass2*f_roll1+ & - lg4x6(iconst)%lambda(3)*imass4*f_roll3+ & - lg4x6(iconst)%lambda(4)*imass2*f_roll4+ & + - dtsqby2*dtsqby2*DOTPROD_3D(vec, vec) - DOTPROD_3D(r0_23, r0_23) + vec = lg4x6(iconst)%lambda(5)*f_roll5*(imass2 + imass4) - & + lg4x6(iconst)%lambda(1)*imass2*f_roll1 + & + lg4x6(iconst)%lambda(3)*imass4*f_roll3 + & + lg4x6(iconst)%lambda(4)*imass2*f_roll4 + & lg4x6(iconst)%lambda(6)*imass4*f_roll6 bvec(5, 1) = g4x6_list(iconst)%dbd*g4x6_list(iconst)%dbd & - -dtsqby2*dtsqby2*DOTPROD_3D(vec, vec)-DOTPROD_3D(r0_24, r0_24) - vec = lg4x6(iconst)%lambda(6)*f_roll6*(imass3+imass4)- & - lg4x6(iconst)%lambda(2)*imass3*f_roll2+ & - lg4x6(iconst)%lambda(3)*imass4*f_roll3- & - lg4x6(iconst)%lambda(4)*imass3*f_roll4+ & + - dtsqby2*dtsqby2*DOTPROD_3D(vec, vec) - DOTPROD_3D(r0_24, r0_24) + vec = lg4x6(iconst)%lambda(6)*f_roll6*(imass3 + imass4) - & + lg4x6(iconst)%lambda(2)*imass3*f_roll2 + & + lg4x6(iconst)%lambda(3)*imass4*f_roll3 - & + lg4x6(iconst)%lambda(4)*imass3*f_roll4 + & lg4x6(iconst)%lambda(5)*imass4*f_roll5 bvec(6, 1) = g4x6_list(iconst)%dcd*g4x6_list(iconst)%dcd & - -dtsqby2*dtsqby2*DOTPROD_3D(vec, vec)-DOTPROD_3D(r0_34, r0_34) + - dtsqby2*dtsqby2*DOTPROD_3D(vec, vec) - DOTPROD_3D(r0_34, r0_34) bvec = bvec*idtsq ! get lambda atemp = amat CALL solve_system(atemp, 6, bvec) lg4x6(iconst)%lambda(:) = bvec(:, 1) - lg4x6(iconst)%del_lambda(:) = lg4x6(iconst)%lambda(:)- & + lg4x6(iconst)%del_lambda(:) = lg4x6(iconst)%lambda(:) - & lg4x6(iconst)%lambda_old(:) lg4x6(iconst)%lambda_old(:) = lg4x6(iconst)%lambda(:) - fc1 = lg4x6(iconst)%del_lambda(1)*lg4x6(iconst)%fa+ & - lg4x6(iconst)%del_lambda(2)*lg4x6(iconst)%fb+ & + fc1 = lg4x6(iconst)%del_lambda(1)*lg4x6(iconst)%fa + & + lg4x6(iconst)%del_lambda(2)*lg4x6(iconst)%fb + & lg4x6(iconst)%del_lambda(3)*lg4x6(iconst)%fc - fc2 = -lg4x6(iconst)%del_lambda(1)*lg4x6(iconst)%fa+ & - lg4x6(iconst)%del_lambda(4)*lg4x6(iconst)%fd+ & + fc2 = -lg4x6(iconst)%del_lambda(1)*lg4x6(iconst)%fa + & + lg4x6(iconst)%del_lambda(4)*lg4x6(iconst)%fd + & lg4x6(iconst)%del_lambda(5)*lg4x6(iconst)%fe - fc3 = -lg4x6(iconst)%del_lambda(2)*lg4x6(iconst)%fb- & - lg4x6(iconst)%del_lambda(4)*lg4x6(iconst)%fd+ & + fc3 = -lg4x6(iconst)%del_lambda(2)*lg4x6(iconst)%fb - & + lg4x6(iconst)%del_lambda(4)*lg4x6(iconst)%fd + & lg4x6(iconst)%del_lambda(6)*lg4x6(iconst)%ff - fc4 = -lg4x6(iconst)%del_lambda(3)*lg4x6(iconst)%fc- & - lg4x6(iconst)%del_lambda(5)*lg4x6(iconst)%fe- & + fc4 = -lg4x6(iconst)%del_lambda(3)*lg4x6(iconst)%fc - & + lg4x6(iconst)%del_lambda(5)*lg4x6(iconst)%fe - & lg4x6(iconst)%del_lambda(6)*lg4x6(iconst)%ff CALL MATVEC_3x3(vec, r_shake, fc1) - r1(:) = pos(:, index_a)+imass1*dtsqby2*vec + r1(:) = pos(:, index_a) + imass1*dtsqby2*vec CALL MATVEC_3x3(vec, r_shake, fc2) - r2(:) = pos(:, index_b)+imass2*dtsqby2*vec + r2(:) = pos(:, index_b) + imass2*dtsqby2*vec CALL MATVEC_3x3(vec, r_shake, fc3) - r3(:) = pos(:, index_c)+imass3*dtsqby2*vec + r3(:) = pos(:, index_c) + imass3*dtsqby2*vec CALL MATVEC_3x3(vec, r_shake, fc4) - r4(:) = pos(:, index_d)+imass4*dtsqby2*vec + r4(:) = pos(:, index_d) + imass4*dtsqby2*vec CALL MATVEC_3x3(vec, r_shake, fc1) - v1(:) = vel(:, index_a)+imass1*dtby2*vec + v1(:) = vel(:, index_a) + imass1*dtby2*vec CALL MATVEC_3x3(vec, r_shake, fc2) - v2(:) = vel(:, index_b)+imass2*dtby2*vec + v2(:) = vel(:, index_b) + imass2*dtby2*vec CALL MATVEC_3x3(vec, r_shake, fc3) - v3(:) = vel(:, index_c)+imass3*dtby2*vec + v3(:) = vel(:, index_c) + imass3*dtby2*vec CALL MATVEC_3x3(vec, r_shake, fc4) - v4(:) = vel(:, index_d)+imass4*dtby2*vec - - r12 = r1-r2 - r13 = r1-r3 - r23 = r2-r3 - r14 = r1-r4 - r24 = r2-r4 - r34 = r3-r4 + v4(:) = vel(:, index_d) + imass4*dtby2*vec + + r12 = r1 - r2 + r13 = r1 - r3 + r23 = r2 - r3 + r14 = r1 - r4 + r24 = r2 - r4 + r34 = r3 - r4 ! compute the tolerance: - sigma = DOT_PRODUCT(r12, r12)-g4x6_list(iconst)%dab* & + sigma = DOT_PRODUCT(r12, r12) - g4x6_list(iconst)%dab* & g4x6_list(iconst)%dab max_sigma = MAX(max_sigma, ABS(sigma)) - sigma = DOT_PRODUCT(r13, r13)-g4x6_list(iconst)%dac* & + sigma = DOT_PRODUCT(r13, r13) - g4x6_list(iconst)%dac* & g4x6_list(iconst)%dac max_sigma = MAX(max_sigma, ABS(sigma)) - sigma = DOT_PRODUCT(r14, r14)-g4x6_list(iconst)%dad* & + sigma = DOT_PRODUCT(r14, r14) - g4x6_list(iconst)%dad* & g4x6_list(iconst)%dad max_sigma = MAX(max_sigma, ABS(sigma)) - sigma = DOT_PRODUCT(r23, r23)-g4x6_list(iconst)%dbc* & + sigma = DOT_PRODUCT(r23, r23) - g4x6_list(iconst)%dbc* & g4x6_list(iconst)%dbc max_sigma = MAX(max_sigma, ABS(sigma)) - sigma = DOT_PRODUCT(r24, r24)-g4x6_list(iconst)%dbd* & + sigma = DOT_PRODUCT(r24, r24) - g4x6_list(iconst)%dbd* & g4x6_list(iconst)%dbd max_sigma = MAX(max_sigma, ABS(sigma)) - sigma = DOT_PRODUCT(r34, r34)-g4x6_list(iconst)%dcd* & + sigma = DOT_PRODUCT(r34, r34) - g4x6_list(iconst)%dcd* & g4x6_list(iconst)%dcd max_sigma = MAX(max_sigma, ABS(sigma)) @@ -928,23 +928,23 @@ SUBROUTINE rattle_4x6_low(fixd_list, g4x6_list, lg4x6, first_atom, & dtby2 = dt*.5_dp DO iconst = 1, SIZE(g4x6_list) IF (g4x6_list(iconst)%restraint%active) CYCLE - index_a = g4x6_list(iconst)%a+first_atom-1 - index_b = g4x6_list(iconst)%b+first_atom-1 - index_c = g4x6_list(iconst)%c+first_atom-1 - index_d = g4x6_list(iconst)%d+first_atom-1 - v12(:) = vel(:, index_a)-vel(:, index_b) - v13(:) = vel(:, index_a)-vel(:, index_c) - v14(:) = vel(:, index_a)-vel(:, index_d) - v23(:) = vel(:, index_b)-vel(:, index_c) - v24(:) = vel(:, index_b)-vel(:, index_d) - v34(:) = vel(:, index_c)-vel(:, index_d) - - r12(:) = particle_set(index_a)%r(:)-particle_set(index_b)%r(:) - r13(:) = particle_set(index_a)%r(:)-particle_set(index_c)%r(:) - r14(:) = particle_set(index_a)%r(:)-particle_set(index_d)%r(:) - r23(:) = particle_set(index_b)%r(:)-particle_set(index_c)%r(:) - r24(:) = particle_set(index_b)%r(:)-particle_set(index_d)%r(:) - r34(:) = particle_set(index_c)%r(:)-particle_set(index_d)%r(:) + index_a = g4x6_list(iconst)%a + first_atom - 1 + index_b = g4x6_list(iconst)%b + first_atom - 1 + index_c = g4x6_list(iconst)%c + first_atom - 1 + index_d = g4x6_list(iconst)%d + first_atom - 1 + v12(:) = vel(:, index_a) - vel(:, index_b) + v13(:) = vel(:, index_a) - vel(:, index_c) + v14(:) = vel(:, index_a) - vel(:, index_d) + v23(:) = vel(:, index_b) - vel(:, index_c) + v24(:) = vel(:, index_b) - vel(:, index_d) + v34(:) = vel(:, index_c) - vel(:, index_d) + + r12(:) = particle_set(index_a)%r(:) - particle_set(index_b)%r(:) + r13(:) = particle_set(index_a)%r(:) - particle_set(index_c)%r(:) + r14(:) = particle_set(index_a)%r(:) - particle_set(index_d)%r(:) + r23(:) = particle_set(index_b)%r(:) - particle_set(index_c)%r(:) + r24(:) = particle_set(index_b)%r(:) - particle_set(index_d)%r(:) + r34(:) = particle_set(index_c)%r(:) - particle_set(index_d)%r(:) atomic_kind => particle_set(index_a)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) imass1 = 1.0_dp/mass @@ -967,7 +967,7 @@ SUBROUTINE rattle_4x6_low(fixd_list, g4x6_list, lg4x6, first_atom, & CALL check_fixed_atom_cns_g4x6(imass1, imass2, imass3, imass4, & index_a, index_b, index_c, index_d, fixd_list, lg4x6(iconst)) ! construct matrix - amat(1, 1) = (imass1+imass2)*DOTPROD_3D(r12, lg4x6(iconst)%fa) + amat(1, 1) = (imass1 + imass2)*DOTPROD_3D(r12, lg4x6(iconst)%fa) amat(1, 2) = imass1*DOTPROD_3D(r12, lg4x6(iconst)%fb) amat(1, 3) = imass1*DOTPROD_3D(r12, lg4x6(iconst)%fc) amat(1, 4) = -imass2*DOTPROD_3D(r12, lg4x6(iconst)%fd) @@ -975,7 +975,7 @@ SUBROUTINE rattle_4x6_low(fixd_list, g4x6_list, lg4x6, first_atom, & amat(1, 6) = 0.0_dp amat(2, 1) = imass1*DOTPROD_3D(r13, lg4x6(iconst)%fa) - amat(2, 2) = (imass1+imass3)*DOTPROD_3D(r13, lg4x6(iconst)%fb) + amat(2, 2) = (imass1 + imass3)*DOTPROD_3D(r13, lg4x6(iconst)%fb) amat(2, 3) = imass1*DOTPROD_3D(r13, lg4x6(iconst)%fc) amat(2, 4) = imass3*DOTPROD_3D(r13, lg4x6(iconst)%fd) amat(2, 5) = 0.0_dp @@ -983,7 +983,7 @@ SUBROUTINE rattle_4x6_low(fixd_list, g4x6_list, lg4x6, first_atom, & amat(3, 1) = imass1*DOTPROD_3D(r14, lg4x6(iconst)%fa) amat(3, 2) = imass1*DOTPROD_3D(r14, lg4x6(iconst)%fb) - amat(3, 3) = (imass1+imass4)*DOTPROD_3D(r14, lg4x6(iconst)%fc) + amat(3, 3) = (imass1 + imass4)*DOTPROD_3D(r14, lg4x6(iconst)%fc) amat(3, 4) = 0.0_dp amat(3, 5) = imass4*DOTPROD_3D(r14, lg4x6(iconst)%fe) amat(3, 6) = imass4*DOTPROD_3D(r14, lg4x6(iconst)%ff) @@ -991,7 +991,7 @@ SUBROUTINE rattle_4x6_low(fixd_list, g4x6_list, lg4x6, first_atom, & amat(4, 1) = -imass2*DOTPROD_3D(r23, lg4x6(iconst)%fa) amat(4, 2) = imass3*DOTPROD_3D(r23, lg4x6(iconst)%fb) amat(4, 3) = 0.0_dp - amat(4, 4) = (imass3+imass2)*DOTPROD_3D(r23, lg4x6(iconst)%fd) + amat(4, 4) = (imass3 + imass2)*DOTPROD_3D(r23, lg4x6(iconst)%fd) amat(4, 5) = imass2*DOTPROD_3D(r23, lg4x6(iconst)%fe) amat(4, 6) = -imass3*DOTPROD_3D(r23, lg4x6(iconst)%ff) @@ -999,7 +999,7 @@ SUBROUTINE rattle_4x6_low(fixd_list, g4x6_list, lg4x6, first_atom, & amat(5, 2) = 0.0_dp amat(5, 3) = imass4*DOTPROD_3D(r24, lg4x6(iconst)%fc) amat(5, 4) = imass2*DOTPROD_3D(r24, lg4x6(iconst)%fd) - amat(5, 5) = (imass4+imass2)*DOTPROD_3D(r24, lg4x6(iconst)%fe) + amat(5, 5) = (imass4 + imass2)*DOTPROD_3D(r24, lg4x6(iconst)%fe) amat(5, 6) = imass4*DOTPROD_3D(r24, lg4x6(iconst)%ff) amat(6, 1) = 0.0_dp @@ -1007,7 +1007,7 @@ SUBROUTINE rattle_4x6_low(fixd_list, g4x6_list, lg4x6, first_atom, & amat(6, 3) = imass4*DOTPROD_3D(r34, lg4x6(iconst)%fc) amat(6, 4) = -imass3*DOTPROD_3D(r34, lg4x6(iconst)%fd) amat(6, 5) = imass4*DOTPROD_3D(r34, lg4x6(iconst)%fe) - amat(6, 6) = (imass3+imass4)*DOTPROD_3D(r34, lg4x6(iconst)%ff) + amat(6, 6) = (imass3 + imass4)*DOTPROD_3D(r34, lg4x6(iconst)%ff) ! construct solution vector bvec(1, 1) = DOTPROD_3D(r12, v12) @@ -1022,22 +1022,22 @@ SUBROUTINE rattle_4x6_low(fixd_list, g4x6_list, lg4x6, first_atom, & CALL solve_system(amat, 6, bvec) lg4x6(iconst)%lambda(:) = bvec(:, 1) - fc1 = lg4x6(iconst)%lambda(1)*lg4x6(iconst)%fa+ & - lg4x6(iconst)%lambda(2)*lg4x6(iconst)%fb+ & + fc1 = lg4x6(iconst)%lambda(1)*lg4x6(iconst)%fa + & + lg4x6(iconst)%lambda(2)*lg4x6(iconst)%fb + & lg4x6(iconst)%lambda(3)*lg4x6(iconst)%fc - fc2 = -lg4x6(iconst)%lambda(1)*lg4x6(iconst)%fa+ & - lg4x6(iconst)%lambda(4)*lg4x6(iconst)%fd+ & + fc2 = -lg4x6(iconst)%lambda(1)*lg4x6(iconst)%fa + & + lg4x6(iconst)%lambda(4)*lg4x6(iconst)%fd + & lg4x6(iconst)%lambda(5)*lg4x6(iconst)%fe - fc3 = -lg4x6(iconst)%lambda(2)*lg4x6(iconst)%fb- & - lg4x6(iconst)%lambda(4)*lg4x6(iconst)%fd+ & + fc3 = -lg4x6(iconst)%lambda(2)*lg4x6(iconst)%fb - & + lg4x6(iconst)%lambda(4)*lg4x6(iconst)%fd + & lg4x6(iconst)%lambda(6)*lg4x6(iconst)%ff - fc4 = -lg4x6(iconst)%lambda(3)*lg4x6(iconst)%fc- & - lg4x6(iconst)%lambda(5)*lg4x6(iconst)%fe- & + fc4 = -lg4x6(iconst)%lambda(3)*lg4x6(iconst)%fc - & + lg4x6(iconst)%lambda(5)*lg4x6(iconst)%fe - & lg4x6(iconst)%lambda(6)*lg4x6(iconst)%ff - vel(:, index_a) = vel(:, index_a)+imass1*dtby2*fc1(:) - vel(:, index_b) = vel(:, index_b)+imass2*dtby2*fc2(:) - vel(:, index_c) = vel(:, index_c)+imass3*dtby2*fc3(:) - vel(:, index_d) = vel(:, index_d)+imass4*dtby2*fc4(:) + vel(:, index_a) = vel(:, index_a) + imass1*dtby2*fc1(:) + vel(:, index_b) = vel(:, index_b) + imass2*dtby2*fc2(:) + vel(:, index_c) = vel(:, index_c) + imass3*dtby2*fc3(:) + vel(:, index_d) = vel(:, index_d) + imass4*dtby2*fc4(:) END DO END SUBROUTINE rattle_4x6_low @@ -1085,23 +1085,23 @@ SUBROUTINE rattle_roll_4x6_low(fixd_list, g4x6_list, lg4x6, first_atom, & dtby2 = dt*.5_dp DO iconst = 1, SIZE(g4x6_list) IF (g4x6_list(iconst)%restraint%active) CYCLE - index_a = g4x6_list(iconst)%a+first_atom-1 - index_b = g4x6_list(iconst)%b+first_atom-1 - index_c = g4x6_list(iconst)%c+first_atom-1 - index_d = g4x6_list(iconst)%d+first_atom-1 - v12(:) = vel(:, index_a)-vel(:, index_b) - v13(:) = vel(:, index_a)-vel(:, index_c) - v14(:) = vel(:, index_a)-vel(:, index_d) - v23(:) = vel(:, index_b)-vel(:, index_c) - v24(:) = vel(:, index_b)-vel(:, index_d) - v34(:) = vel(:, index_c)-vel(:, index_d) - - r12(:) = particle_set(index_a)%r(:)-particle_set(index_b)%r(:) - r13(:) = particle_set(index_a)%r(:)-particle_set(index_c)%r(:) - r14(:) = particle_set(index_a)%r(:)-particle_set(index_d)%r(:) - r23(:) = particle_set(index_b)%r(:)-particle_set(index_c)%r(:) - r24(:) = particle_set(index_b)%r(:)-particle_set(index_d)%r(:) - r34(:) = particle_set(index_c)%r(:)-particle_set(index_d)%r(:) + index_a = g4x6_list(iconst)%a + first_atom - 1 + index_b = g4x6_list(iconst)%b + first_atom - 1 + index_c = g4x6_list(iconst)%c + first_atom - 1 + index_d = g4x6_list(iconst)%d + first_atom - 1 + v12(:) = vel(:, index_a) - vel(:, index_b) + v13(:) = vel(:, index_a) - vel(:, index_c) + v14(:) = vel(:, index_a) - vel(:, index_d) + v23(:) = vel(:, index_b) - vel(:, index_c) + v24(:) = vel(:, index_b) - vel(:, index_d) + v34(:) = vel(:, index_c) - vel(:, index_d) + + r12(:) = particle_set(index_a)%r(:) - particle_set(index_b)%r(:) + r13(:) = particle_set(index_a)%r(:) - particle_set(index_c)%r(:) + r14(:) = particle_set(index_a)%r(:) - particle_set(index_d)%r(:) + r23(:) = particle_set(index_b)%r(:) - particle_set(index_c)%r(:) + r24(:) = particle_set(index_b)%r(:) - particle_set(index_d)%r(:) + r34(:) = particle_set(index_c)%r(:) - particle_set(index_d)%r(:) atomic_kind => particle_set(index_a)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) imass1 = 1.0_dp/mass @@ -1131,7 +1131,7 @@ SUBROUTINE rattle_roll_4x6_low(fixd_list, g4x6_list, lg4x6, first_atom, & CALL MATVEC_3x3(f_roll5, r_rattle, lg4x6(iconst)%fe) CALL MATVEC_3x3(f_roll6, r_rattle, lg4x6(iconst)%ff) ! construct matrix - amat(1, 1) = (imass1+imass2)*DOTPROD_3D(r12, f_roll1) + amat(1, 1) = (imass1 + imass2)*DOTPROD_3D(r12, f_roll1) amat(1, 2) = imass1*DOTPROD_3D(r12, f_roll2) amat(1, 3) = imass1*DOTPROD_3D(r12, f_roll3) amat(1, 4) = -imass2*DOTPROD_3D(r12, f_roll4) @@ -1139,7 +1139,7 @@ SUBROUTINE rattle_roll_4x6_low(fixd_list, g4x6_list, lg4x6, first_atom, & amat(1, 6) = 0.0_dp amat(2, 1) = imass1*DOTPROD_3D(r13, f_roll1) - amat(2, 2) = (imass1+imass3)*DOTPROD_3D(r13, f_roll2) + amat(2, 2) = (imass1 + imass3)*DOTPROD_3D(r13, f_roll2) amat(2, 3) = imass1*DOTPROD_3D(r13, f_roll3) amat(2, 4) = imass3*DOTPROD_3D(r13, f_roll4) amat(2, 5) = 0.0_dp @@ -1147,7 +1147,7 @@ SUBROUTINE rattle_roll_4x6_low(fixd_list, g4x6_list, lg4x6, first_atom, & amat(3, 1) = imass1*DOTPROD_3D(r14, f_roll1) amat(3, 2) = imass1*DOTPROD_3D(r14, f_roll2) - amat(3, 3) = (imass1+imass4)*DOTPROD_3D(r14, f_roll3) + amat(3, 3) = (imass1 + imass4)*DOTPROD_3D(r14, f_roll3) amat(3, 4) = 0.0_dp amat(3, 5) = imass4*DOTPROD_3D(r14, f_roll5) amat(3, 6) = imass4*DOTPROD_3D(r14, f_roll6) @@ -1155,7 +1155,7 @@ SUBROUTINE rattle_roll_4x6_low(fixd_list, g4x6_list, lg4x6, first_atom, & amat(4, 1) = -imass2*DOTPROD_3D(r23, f_roll1) amat(4, 2) = imass3*DOTPROD_3D(r23, f_roll2) amat(4, 3) = 0.0_dp - amat(4, 4) = (imass3+imass2)*DOTPROD_3D(r23, f_roll4) + amat(4, 4) = (imass3 + imass2)*DOTPROD_3D(r23, f_roll4) amat(4, 5) = imass2*DOTPROD_3D(r23, f_roll5) amat(4, 6) = -imass3*DOTPROD_3D(r23, f_roll6) @@ -1163,7 +1163,7 @@ SUBROUTINE rattle_roll_4x6_low(fixd_list, g4x6_list, lg4x6, first_atom, & amat(5, 2) = 0.0_dp amat(5, 3) = imass4*DOTPROD_3D(r24, f_roll3) amat(5, 4) = imass2*DOTPROD_3D(r24, f_roll4) - amat(5, 5) = (imass4+imass2)*DOTPROD_3D(r24, f_roll5) + amat(5, 5) = (imass4 + imass2)*DOTPROD_3D(r24, f_roll5) amat(5, 6) = imass4*DOTPROD_3D(r24, f_roll6) amat(6, 1) = 0.0_dp @@ -1171,21 +1171,21 @@ SUBROUTINE rattle_roll_4x6_low(fixd_list, g4x6_list, lg4x6, first_atom, & amat(6, 3) = imass4*DOTPROD_3D(r34, f_roll3) amat(6, 4) = -imass3*DOTPROD_3D(r34, f_roll4) amat(6, 5) = imass4*DOTPROD_3D(r34, f_roll5) - amat(6, 6) = (imass3+imass4)*DOTPROD_3D(r34, f_roll6) + amat(6, 6) = (imass3 + imass4)*DOTPROD_3D(r34, f_roll6) ! construct solution vector CALL matvec_3x3(vec, veps, r12) - bvec(1, 1) = DOTPROD_3D(r12, v12+vec) + bvec(1, 1) = DOTPROD_3D(r12, v12 + vec) CALL matvec_3x3(vec, veps, r13) - bvec(2, 1) = DOTPROD_3D(r13, v13+vec) + bvec(2, 1) = DOTPROD_3D(r13, v13 + vec) CALL matvec_3x3(vec, veps, r14) - bvec(3, 1) = DOTPROD_3D(r14, v14+vec) + bvec(3, 1) = DOTPROD_3D(r14, v14 + vec) CALL matvec_3x3(vec, veps, r23) - bvec(4, 1) = DOTPROD_3D(r23, v23+vec) + bvec(4, 1) = DOTPROD_3D(r23, v23 + vec) CALL matvec_3x3(vec, veps, r24) - bvec(5, 1) = DOTPROD_3D(r24, v24+vec) + bvec(5, 1) = DOTPROD_3D(r24, v24 + vec) CALL matvec_3x3(vec, veps, r34) - bvec(6, 1) = DOTPROD_3D(r34, v34+vec) + bvec(6, 1) = DOTPROD_3D(r34, v34 + vec) bvec = -bvec*2.0_dp*idt ! get lambda @@ -1193,22 +1193,22 @@ SUBROUTINE rattle_roll_4x6_low(fixd_list, g4x6_list, lg4x6, first_atom, & lambda(:) = bvec(:, 1) lg4x6(iconst)%lambda(:) = lambda - fc1 = lambda(1)*f_roll1+ & - lambda(2)*f_roll2+ & + fc1 = lambda(1)*f_roll1 + & + lambda(2)*f_roll2 + & lambda(3)*f_roll3 - fc2 = -lambda(1)*f_roll1+ & - lambda(4)*f_roll4+ & + fc2 = -lambda(1)*f_roll1 + & + lambda(4)*f_roll4 + & lambda(5)*f_roll5 - fc3 = -lambda(2)*f_roll2- & - lambda(4)*f_roll4+ & + fc3 = -lambda(2)*f_roll2 - & + lambda(4)*f_roll4 + & lambda(6)*f_roll6 - fc4 = -lambda(3)*f_roll3- & - lambda(5)*f_roll5- & + fc4 = -lambda(3)*f_roll3 - & + lambda(5)*f_roll5 - & lambda(6)*f_roll6 - vel(:, index_a) = vel(:, index_a)+imass1*dtby2*fc1(:) - vel(:, index_b) = vel(:, index_b)+imass2*dtby2*fc2(:) - vel(:, index_c) = vel(:, index_c)+imass3*dtby2*fc3(:) - vel(:, index_d) = vel(:, index_d)+imass4*dtby2*fc4(:) + vel(:, index_a) = vel(:, index_a) + imass1*dtby2*fc1(:) + vel(:, index_b) = vel(:, index_b) + imass2*dtby2*fc2(:) + vel(:, index_c) = vel(:, index_c) + imass3*dtby2*fc3(:) + vel(:, index_d) = vel(:, index_d) + imass4*dtby2*fc4(:) END DO END SUBROUTINE rattle_roll_4x6_low diff --git a/src/constraint_clv.F b/src/constraint_clv.F index 6cfddb390c..9e36d50c3f 100644 --- a/src/constraint_clv.F +++ b/src/constraint_clv.F @@ -524,7 +524,7 @@ SUBROUTINE shake_colv_low(fixd_list, colv_list, lcolv, & fdotf_sum = eval_Jac_colvar(lcolv(iconst)%colvar, & lcolv(iconst)%colvar_old, imass=imass) del_lam = 2.0_dp*lcolv(iconst)%sigma/(dt*dt*fdotf_sum) - lcolv(iconst)%lambda = lcolv(iconst)%lambda+del_lam + lcolv(iconst)%lambda = lcolv(iconst)%lambda + del_lam ! Update positions CALL update_con_colv(pos, dtsqby2, lcolv(iconst), & @@ -579,7 +579,7 @@ SUBROUTINE shake_update_colv_low(colv_list, dt, motion_section) IF (value /= 0.0_dp) THEN CALL section_vals_val_get(collective_sections, "TARGET", r_val=clv_target, & i_rep_section=irep) - new_clv_target = clv_target+value*dt + new_clv_target = clv_target + value*dt ! Check limits.. CALL section_vals_val_get(collective_sections, "TARGET_LIMIT", explicit=explicit, & i_rep_section=irep) @@ -674,7 +674,7 @@ SUBROUTINE rattle_colv_low(fixd_list, colv_list, lcolv, & fdotf_sum = eval_Jac_colvar(lcolv(iconst)%colvar_old, & lcolv(iconst)%colvar_old, imass=imass) del_lam = 2.0_dp*lcolv(iconst)%sigma/(dt*fdotf_sum) - lcolv(iconst)%lambda = lcolv(iconst)%lambda+del_lam + lcolv(iconst)%lambda = lcolv(iconst)%lambda + del_lam ! Update velocities CALL update_con_colv(vel, dtby2, lcolv(iconst), & @@ -757,7 +757,7 @@ SUBROUTINE shake_roll_colv_low(fixd_list, colv_list, lcolv, & lcolv(iconst)%colvar_old, roll=.TRUE., rmat=r_shake, & imass=imass) del_lam = 2.0_dp*lcolv(iconst)%sigma/(dt*dt*fdotf_sum) - lcolv(iconst)%lambda = lcolv(iconst)%lambda+del_lam + lcolv(iconst)%lambda = lcolv(iconst)%lambda + del_lam ! Update positions CALL update_con_colv(pos, dtsqby2, lcolv(iconst), & @@ -841,7 +841,7 @@ SUBROUTINE rattle_roll_colv_low(fixd_list, colv_list, lcolv, & lcolv(iconst)%colvar_old, roll=.TRUE., & rmat=r_rattle, imass=imass) del_lam = 2.0_dp*lcolv(iconst)%sigma/(dt*fdotf_sum) - lcolv(iconst)%lambda = lcolv(iconst)%lambda+del_lam + lcolv(iconst)%lambda = lcolv(iconst)%lambda + del_lam ! Update velocities CALL update_con_colv(vel, dtby2, lcolv(iconst), & lambda=del_lam, & @@ -904,7 +904,7 @@ SUBROUTINE update_con_colv(wrk, fac, lcolv, lambda, roll, rmat, imass) ELSE f_roll = lcolv%colvar_old%dsdr(:, iatm) END IF - wrk(:, ind) = wrk(:, ind)-imass(ind)*fac*lambda*f_roll + wrk(:, ind) = wrk(:, ind) - imass(ind)*fac*lambda*f_roll END DO END SUBROUTINE update_con_colv @@ -953,7 +953,7 @@ FUNCTION eval_Jac_colvar(colvar, colvar_old, roll, rmat, imass) RESULT(res) ELSE tmp2 = colvar_old%dsdr(1:3, i) END IF - res = res+DOT_PRODUCT(tmp1, tmp2)*imass(iatom) + res = res + DOT_PRODUCT(tmp1, tmp2)*imass(iatom) END DO END FUNCTION eval_Jac_colvar @@ -1005,12 +1005,12 @@ FUNCTION rattle_con_eval(colvar, vel, roll, veps, rmat, particles) RESULT(res) pos = particles(ind)%r CALL matvec_3x3(f_roll, rmat, colvar%dsdr(:, iatm)) CALL matvec_3x3(tmp, veps, pos) - v_roll = vel(:, ind)+tmp + v_roll = vel(:, ind) + tmp ELSE f_roll = colvar%dsdr(:, iatm) v_roll = vel(:, ind) END IF - res = res+DOT_PRODUCT(f_roll, v_roll) + res = res + DOT_PRODUCT(f_roll, v_roll) END DO END FUNCTION rattle_con_eval diff --git a/src/constraint_fxd.F b/src/constraint_fxd.F index 1eab9c49e7..6176d10069 100644 --- a/src/constraint_fxd.F +++ b/src/constraint_fxd.F @@ -116,7 +116,7 @@ SUBROUTINE fix_atom_control(force_env, w) shell_particle_set => shell_particles%els CPASSERT((SIZE(shell_particle_set) == nshell)) END IF - nparticle = natom+nshell + nparticle = natom + nshell molecule_kind_set => molecule_kinds%els nkind = molecule_kinds%n_els @@ -124,7 +124,7 @@ SUBROUTINE fix_atom_control(force_env, w) DO ikind = 1, nkind molecule_kind => molecule_kind_set(ikind) CALL get_molecule_kind(molecule_kind, nfixd=nfixed_atoms) - my_atm_fixed = my_atm_fixed+nfixed_atoms + my_atm_fixed = my_atm_fixed + nfixed_atoms END DO IF (my_atm_fixed /= 0) THEN @@ -141,7 +141,7 @@ SUBROUTINE fix_atom_control(force_env, w) force(:, iparticle) = particle_set(iparticle)%f(:) ELSE force(:, iparticle) = core_particle_set(shell_index)%f(:) - force(:, natom+shell_index) = shell_particle_set(shell_index)%f(:) + force(:, natom + shell_index) = shell_particle_set(shell_index)%f(:) END IF END DO END DO @@ -161,7 +161,7 @@ SUBROUTINE fix_atom_control(force_env, w) shell_index = particle_set(iparticle)%shell_index ! Select constraint type IF (PRESENT(w)) THEN - SELECT CASE (fixd_list (ii)%itype) + SELECT CASE (fixd_list(ii)%itype) CASE (use_perd_x) w(1, iparticle) = 0.0_dp CASE (use_perd_y) @@ -181,47 +181,47 @@ SUBROUTINE fix_atom_control(force_env, w) w(:, iparticle) = 0.0_dp END SELECT ELSE - SELECT CASE (fixd_list (ii)%itype) + SELECT CASE (fixd_list(ii)%itype) CASE (use_perd_x) force(1, iparticle) = 0.0_dp IF (shell_index /= 0) THEN - force(1, natom+shell_index) = 0.0_dp + force(1, natom + shell_index) = 0.0_dp END IF CASE (use_perd_y) force(2, iparticle) = 0.0_dp IF (shell_index /= 0) THEN - force(2, natom+shell_index) = 0.0_dp + force(2, natom + shell_index) = 0.0_dp END IF CASE (use_perd_z) force(3, iparticle) = 0.0_dp IF (shell_index /= 0) THEN - force(3, natom+shell_index) = 0.0_dp + force(3, natom + shell_index) = 0.0_dp END IF CASE (use_perd_xy) force(1, iparticle) = 0.0_dp force(2, iparticle) = 0.0_dp IF (shell_index /= 0) THEN - force(1, natom+shell_index) = 0.0_dp - force(2, natom+shell_index) = 0.0_dp + force(1, natom + shell_index) = 0.0_dp + force(2, natom + shell_index) = 0.0_dp END IF CASE (use_perd_xz) force(1, iparticle) = 0.0_dp force(3, iparticle) = 0.0_dp IF (shell_index /= 0) THEN - force(1, natom+shell_index) = 0.0_dp - force(3, natom+shell_index) = 0.0_dp + force(1, natom + shell_index) = 0.0_dp + force(3, natom + shell_index) = 0.0_dp END IF CASE (use_perd_yz) force(2, iparticle) = 0.0_dp force(3, iparticle) = 0.0_dp IF (shell_index /= 0) THEN - force(2, natom+shell_index) = 0.0_dp - force(3, natom+shell_index) = 0.0_dp + force(2, natom + shell_index) = 0.0_dp + force(3, natom + shell_index) = 0.0_dp END IF CASE (use_perd_xyz) force(:, iparticle) = 0.0_dp IF (shell_index /= 0) THEN - force(:, natom+shell_index) = 0.0_dp + force(:, natom + shell_index) = 0.0_dp END IF END SELECT END IF @@ -237,7 +237,7 @@ SUBROUTINE fix_atom_control(force_env, w) particle_set(iparticle)%f(:) = force(:, iparticle) ELSE core_particle_set(shell_index)%f(:) = force(:, iparticle) - shell_particle_set(shell_index)%f(:) = force(:, natom+shell_index) + shell_particle_set(shell_index)%f(:) = force(:, natom + shell_index) END IF END DO DEALLOCATE (force) @@ -444,7 +444,7 @@ SUBROUTINE create_local_fixd_list(lfixd_list, nkind, molecule_kind_set, & molecule_kind => molecule_kind_set(ikind) CALL get_molecule_kind(molecule_kind, fixd_list=fixd_list) IF (ASSOCIATED(fixd_list)) THEN - nsize = nsize+SIZE(fixd_list) + nsize = nsize + SIZE(fixd_list) END IF END DO IF (nsize /= 0) THEN @@ -458,7 +458,7 @@ SUBROUTINE create_local_fixd_list(lfixd_list, nkind, molecule_kind_set, & CALL get_molecule_kind(molecule_kind, fixd_list=fixd_list) IF (ASSOCIATED(fixd_list)) THEN DO i = 1, SIZE(fixd_list) - nsize = nsize+1 + nsize = nsize + 1 work0(nsize) = i kind_index_all(nsize) = ikind fixed_atom_all(nsize) = fixd_list(i)%fixd @@ -471,7 +471,7 @@ SUBROUTINE create_local_fixd_list(lfixd_list, nkind, molecule_kind_set, & ! Sort the local particles nparticle_local_all = 0 DO i = 1, SIZE(local_particles%n_el) - nparticle_local_all = nparticle_local_all+local_particles%n_el(i) + nparticle_local_all = nparticle_local_all + local_particles%n_el(i) END DO ALLOCATE (local_particle_all(nparticle_local_all)) ALLOCATE (work2(nparticle_local_all)) @@ -479,7 +479,7 @@ SUBROUTINE create_local_fixd_list(lfixd_list, nkind, molecule_kind_set, & DO i = 1, SIZE(local_particles%n_el) nparticle_local = local_particles%n_el(i) DO iparticle_local = 1, nparticle_local - nparticle_local_all = nparticle_local_all+1 + nparticle_local_all = nparticle_local_all + 1 iparticle = local_particles%list(i)%array(iparticle_local) local_particle_all(nparticle_local_all) = iparticle END DO @@ -491,13 +491,13 @@ SUBROUTINE create_local_fixd_list(lfixd_list, nkind, molecule_kind_set, & jsize = 1 Loop_count: DO isize = 1, nparticle_local_all DO WHILE (local_particle_all(isize) > fixed_atom_all(jsize)) - jsize = jsize+1 + jsize = jsize + 1 IF (jsize > nsize) THEN jsize = nsize EXIT Loop_count END IF END DO - IF (local_particle_all(isize) == fixed_atom_all(jsize)) ncnst = ncnst+1 + IF (local_particle_all(isize) == fixed_atom_all(jsize)) ncnst = ncnst + 1 END DO Loop_count ! Allocate local fixed atom array @@ -508,14 +508,14 @@ SUBROUTINE create_local_fixd_list(lfixd_list, nkind, molecule_kind_set, & jsize = 1 Loop_fill: DO isize = 1, nparticle_local_all DO WHILE (local_particle_all(isize) > fixed_atom_all(jsize)) - jsize = jsize+1 + jsize = jsize + 1 IF (jsize > nsize) THEN jsize = nsize EXIT Loop_fill END IF END DO IF (local_particle_all(isize) == fixed_atom_all(jsize)) THEN - ncnst = ncnst+1 + ncnst = ncnst + 1 lfixd_list(ncnst)%ifixd_index = work0(work1(jsize)) lfixd_list(ncnst)%ikind = kind_index_all(work1(jsize)) END IF diff --git a/src/constraint_util.F b/src/constraint_util.F index f734f8f245..09f9f8ce21 100644 --- a/src/constraint_util.F +++ b/src/constraint_util.F @@ -164,22 +164,22 @@ SUBROUTINE getold_low(n3x3con, n4x6con, colv_list, g3x3_list, g4x6_list, fixd_li END IF ! 3x3 constraints DO iconst = 1, n3x3con - index = g3x3_list(iconst)%a+first_atom-1 + index = g3x3_list(iconst)%a + first_atom - 1 lg3x3(iconst)%ra_old = particle_set(index)%r - index = g3x3_list(iconst)%b+first_atom-1 + index = g3x3_list(iconst)%b + first_atom - 1 lg3x3(iconst)%rb_old = particle_set(index)%r - index = g3x3_list(iconst)%c+first_atom-1 + index = g3x3_list(iconst)%c + first_atom - 1 lg3x3(iconst)%rc_old = particle_set(index)%r ENDDO ! 4x6 constraints DO iconst = 1, n4x6con - index = g4x6_list(iconst)%a+first_atom-1 + index = g4x6_list(iconst)%a + first_atom - 1 lg4x6(iconst)%ra_old = particle_set(index)%r - index = g4x6_list(iconst)%b+first_atom-1 + index = g4x6_list(iconst)%b + first_atom - 1 lg4x6(iconst)%rb_old = particle_set(index)%r - index = g4x6_list(iconst)%c+first_atom-1 + index = g4x6_list(iconst)%c + first_atom - 1 lg4x6(iconst)%rc_old = particle_set(index)%r - index = g4x6_list(iconst)%d+first_atom-1 + index = g4x6_list(iconst)%d + first_atom - 1 lg4x6(iconst)%rd_old = particle_set(index)%r ENDDO @@ -258,11 +258,11 @@ SUBROUTINE pv_constraint(gci, local_molecules, molecule_set, molecule_kind_set, END IF CALL mp_sum(pv, group) ! Symmetrize PV - pv(1, 2) = 0.5_dp*(pv(1, 2)+pv(2, 1)) + pv(1, 2) = 0.5_dp*(pv(1, 2) + pv(2, 1)) pv(2, 1) = pv(1, 2) - pv(1, 3) = 0.5_dp*(pv(1, 3)+pv(3, 1)) + pv(1, 3) = 0.5_dp*(pv(1, 3) + pv(3, 1)) pv(3, 1) = pv(1, 3) - pv(3, 2) = 0.5_dp*(pv(3, 2)+pv(2, 3)) + pv(3, 2) = 0.5_dp*(pv(3, 2) + pv(2, 3)) pv(2, 3) = pv(3, 2) ! Store in virial type virial%pv_constraint = pv @@ -318,52 +318,52 @@ SUBROUTINE pv_constraint_low(ng3x3, ng4x6, g3x3_list, g4x6_list, colv_list, & ! pv gets updated with FULL multiplier lambda_3x3 = lg3x3(iconst)%lambda - fc1 = lambda_3x3(1)*lg3x3(iconst)%fa+ & + fc1 = lambda_3x3(1)*lg3x3(iconst)%fa + & lambda_3x3(2)*lg3x3(iconst)%fb - fc2 = -lambda_3x3(1)*lg3x3(iconst)%fa+ & + fc2 = -lambda_3x3(1)*lg3x3(iconst)%fa + & lambda_3x3(3)*lg3x3(iconst)%fc - fc3 = -lambda_3x3(2)*lg3x3(iconst)%fb- & + fc3 = -lambda_3x3(2)*lg3x3(iconst)%fb - & lambda_3x3(3)*lg3x3(iconst)%fc - index_a = g3x3_list(iconst)%a+first_atom-1 - index_b = g3x3_list(iconst)%b+first_atom-1 - index_c = g3x3_list(iconst)%c+first_atom-1 + index_a = g3x3_list(iconst)%a + first_atom - 1 + index_b = g3x3_list(iconst)%b + first_atom - 1 + index_c = g3x3_list(iconst)%c + first_atom - 1 !pv(1,1) - pv(1, 1) = pv(1, 1)+fc1(1)*particle_set(index_a)%r(1) - pv(1, 1) = pv(1, 1)+fc2(1)*particle_set(index_b)%r(1) - pv(1, 1) = pv(1, 1)+fc3(1)*particle_set(index_c)%r(1) + pv(1, 1) = pv(1, 1) + fc1(1)*particle_set(index_a)%r(1) + pv(1, 1) = pv(1, 1) + fc2(1)*particle_set(index_b)%r(1) + pv(1, 1) = pv(1, 1) + fc3(1)*particle_set(index_c)%r(1) !pv(1,2) - pv(1, 2) = pv(1, 2)+fc1(1)*particle_set(index_a)%r(2) - pv(1, 2) = pv(1, 2)+fc2(1)*particle_set(index_b)%r(2) - pv(1, 2) = pv(1, 2)+fc3(1)*particle_set(index_c)%r(2) + pv(1, 2) = pv(1, 2) + fc1(1)*particle_set(index_a)%r(2) + pv(1, 2) = pv(1, 2) + fc2(1)*particle_set(index_b)%r(2) + pv(1, 2) = pv(1, 2) + fc3(1)*particle_set(index_c)%r(2) !pv(1,3) - pv(1, 3) = pv(1, 3)+fc1(1)*particle_set(index_a)%r(3) - pv(1, 3) = pv(1, 3)+fc2(1)*particle_set(index_b)%r(3) - pv(1, 3) = pv(1, 3)+fc3(1)*particle_set(index_c)%r(3) + pv(1, 3) = pv(1, 3) + fc1(1)*particle_set(index_a)%r(3) + pv(1, 3) = pv(1, 3) + fc2(1)*particle_set(index_b)%r(3) + pv(1, 3) = pv(1, 3) + fc3(1)*particle_set(index_c)%r(3) !pv(2,1) - pv(2, 1) = pv(2, 1)+fc1(2)*particle_set(index_a)%r(1) - pv(2, 1) = pv(2, 1)+fc2(2)*particle_set(index_b)%r(1) - pv(2, 1) = pv(2, 1)+fc3(2)*particle_set(index_c)%r(1) + pv(2, 1) = pv(2, 1) + fc1(2)*particle_set(index_a)%r(1) + pv(2, 1) = pv(2, 1) + fc2(2)*particle_set(index_b)%r(1) + pv(2, 1) = pv(2, 1) + fc3(2)*particle_set(index_c)%r(1) !pv(2,2) - pv(2, 2) = pv(2, 2)+fc1(2)*particle_set(index_a)%r(2) - pv(2, 2) = pv(2, 2)+fc2(2)*particle_set(index_b)%r(2) - pv(2, 2) = pv(2, 2)+fc3(2)*particle_set(index_c)%r(2) + pv(2, 2) = pv(2, 2) + fc1(2)*particle_set(index_a)%r(2) + pv(2, 2) = pv(2, 2) + fc2(2)*particle_set(index_b)%r(2) + pv(2, 2) = pv(2, 2) + fc3(2)*particle_set(index_c)%r(2) !pv(2,3) - pv(2, 3) = pv(2, 3)+fc1(2)*particle_set(index_a)%r(3) - pv(2, 3) = pv(2, 3)+fc2(2)*particle_set(index_b)%r(3) - pv(2, 3) = pv(2, 3)+fc3(2)*particle_set(index_c)%r(3) + pv(2, 3) = pv(2, 3) + fc1(2)*particle_set(index_a)%r(3) + pv(2, 3) = pv(2, 3) + fc2(2)*particle_set(index_b)%r(3) + pv(2, 3) = pv(2, 3) + fc3(2)*particle_set(index_c)%r(3) !pv(3,1) - pv(3, 1) = pv(3, 1)+fc1(3)*particle_set(index_a)%r(1) - pv(3, 1) = pv(3, 1)+fc2(3)*particle_set(index_b)%r(1) - pv(3, 1) = pv(3, 1)+fc3(3)*particle_set(index_c)%r(1) + pv(3, 1) = pv(3, 1) + fc1(3)*particle_set(index_a)%r(1) + pv(3, 1) = pv(3, 1) + fc2(3)*particle_set(index_b)%r(1) + pv(3, 1) = pv(3, 1) + fc3(3)*particle_set(index_c)%r(1) !pv(3,2) - pv(3, 2) = pv(3, 2)+fc1(3)*particle_set(index_a)%r(2) - pv(3, 2) = pv(3, 2)+fc2(3)*particle_set(index_b)%r(2) - pv(3, 2) = pv(3, 2)+fc3(3)*particle_set(index_c)%r(2) + pv(3, 2) = pv(3, 2) + fc1(3)*particle_set(index_a)%r(2) + pv(3, 2) = pv(3, 2) + fc2(3)*particle_set(index_b)%r(2) + pv(3, 2) = pv(3, 2) + fc3(3)*particle_set(index_c)%r(2) !pv(3,3) - pv(3, 3) = pv(3, 3)+fc1(3)*particle_set(index_a)%r(3) - pv(3, 3) = pv(3, 3)+fc2(3)*particle_set(index_b)%r(3) - pv(3, 3) = pv(3, 3)+fc3(3)*particle_set(index_c)%r(3) + pv(3, 3) = pv(3, 3) + fc1(3)*particle_set(index_a)%r(3) + pv(3, 3) = pv(3, 3) + fc2(3)*particle_set(index_b)%r(3) + pv(3, 3) = pv(3, 3) + fc3(3)*particle_set(index_c)%r(3) END DO ! 4x6 @@ -371,68 +371,68 @@ SUBROUTINE pv_constraint_low(ng3x3, ng4x6, g3x3_list, g4x6_list, colv_list, & ! pv gets updated with FULL multiplier lambda_4x6 = lg4x6(iconst)%lambda - fc1 = lambda_4x6(1)*lg4x6(iconst)%fa+ & - lambda_4x6(2)*lg4x6(iconst)%fb+ & + fc1 = lambda_4x6(1)*lg4x6(iconst)%fa + & + lambda_4x6(2)*lg4x6(iconst)%fb + & lambda_4x6(3)*lg4x6(iconst)%fc - fc2 = -lambda_4x6(1)*lg4x6(iconst)%fa+ & - lambda_4x6(4)*lg4x6(iconst)%fd+ & + fc2 = -lambda_4x6(1)*lg4x6(iconst)%fa + & + lambda_4x6(4)*lg4x6(iconst)%fd + & lambda_4x6(5)*lg4x6(iconst)%fe - fc3 = -lambda_4x6(2)*lg4x6(iconst)%fb- & - lambda_4x6(4)*lg4x6(iconst)%fd+ & + fc3 = -lambda_4x6(2)*lg4x6(iconst)%fb - & + lambda_4x6(4)*lg4x6(iconst)%fd + & lambda_4x6(6)*lg4x6(iconst)%ff - fc4 = -lambda_4x6(3)*lg4x6(iconst)%fc- & - lambda_4x6(5)*lg4x6(iconst)%fe- & + fc4 = -lambda_4x6(3)*lg4x6(iconst)%fc - & + lambda_4x6(5)*lg4x6(iconst)%fe - & lambda_4x6(6)*lg4x6(iconst)%ff - index_a = g4x6_list(iconst)%a+first_atom-1 - index_b = g4x6_list(iconst)%b+first_atom-1 - index_c = g4x6_list(iconst)%c+first_atom-1 - index_d = g4x6_list(iconst)%d+first_atom-1 + index_a = g4x6_list(iconst)%a + first_atom - 1 + index_b = g4x6_list(iconst)%b + first_atom - 1 + index_c = g4x6_list(iconst)%c + first_atom - 1 + index_d = g4x6_list(iconst)%d + first_atom - 1 !pv(1,1) - pv(1, 1) = pv(1, 1)+fc1(1)*particle_set(index_a)%r(1) - pv(1, 1) = pv(1, 1)+fc2(1)*particle_set(index_b)%r(1) - pv(1, 1) = pv(1, 1)+fc3(1)*particle_set(index_c)%r(1) - pv(1, 1) = pv(1, 1)+fc4(1)*particle_set(index_d)%r(1) + pv(1, 1) = pv(1, 1) + fc1(1)*particle_set(index_a)%r(1) + pv(1, 1) = pv(1, 1) + fc2(1)*particle_set(index_b)%r(1) + pv(1, 1) = pv(1, 1) + fc3(1)*particle_set(index_c)%r(1) + pv(1, 1) = pv(1, 1) + fc4(1)*particle_set(index_d)%r(1) !pv(1,2) - pv(1, 2) = pv(1, 2)+fc1(1)*particle_set(index_a)%r(2) - pv(1, 2) = pv(1, 2)+fc2(1)*particle_set(index_b)%r(2) - pv(1, 2) = pv(1, 2)+fc3(1)*particle_set(index_c)%r(2) - pv(1, 2) = pv(1, 2)+fc4(1)*particle_set(index_d)%r(2) + pv(1, 2) = pv(1, 2) + fc1(1)*particle_set(index_a)%r(2) + pv(1, 2) = pv(1, 2) + fc2(1)*particle_set(index_b)%r(2) + pv(1, 2) = pv(1, 2) + fc3(1)*particle_set(index_c)%r(2) + pv(1, 2) = pv(1, 2) + fc4(1)*particle_set(index_d)%r(2) !pv(1,3) - pv(1, 3) = pv(1, 3)+fc1(1)*particle_set(index_a)%r(3) - pv(1, 3) = pv(1, 3)+fc2(1)*particle_set(index_b)%r(3) - pv(1, 3) = pv(1, 3)+fc3(1)*particle_set(index_c)%r(3) - pv(1, 3) = pv(1, 3)+fc4(1)*particle_set(index_d)%r(3) + pv(1, 3) = pv(1, 3) + fc1(1)*particle_set(index_a)%r(3) + pv(1, 3) = pv(1, 3) + fc2(1)*particle_set(index_b)%r(3) + pv(1, 3) = pv(1, 3) + fc3(1)*particle_set(index_c)%r(3) + pv(1, 3) = pv(1, 3) + fc4(1)*particle_set(index_d)%r(3) !pv(2,1) - pv(2, 1) = pv(2, 1)+fc1(2)*particle_set(index_a)%r(1) - pv(2, 1) = pv(2, 1)+fc2(2)*particle_set(index_b)%r(1) - pv(2, 1) = pv(2, 1)+fc3(2)*particle_set(index_c)%r(1) - pv(2, 1) = pv(2, 1)+fc4(2)*particle_set(index_d)%r(1) + pv(2, 1) = pv(2, 1) + fc1(2)*particle_set(index_a)%r(1) + pv(2, 1) = pv(2, 1) + fc2(2)*particle_set(index_b)%r(1) + pv(2, 1) = pv(2, 1) + fc3(2)*particle_set(index_c)%r(1) + pv(2, 1) = pv(2, 1) + fc4(2)*particle_set(index_d)%r(1) !pv(2,2) - pv(2, 2) = pv(2, 2)+fc1(2)*particle_set(index_a)%r(2) - pv(2, 2) = pv(2, 2)+fc2(2)*particle_set(index_b)%r(2) - pv(2, 2) = pv(2, 2)+fc3(2)*particle_set(index_c)%r(2) - pv(2, 2) = pv(2, 2)+fc4(2)*particle_set(index_d)%r(2) + pv(2, 2) = pv(2, 2) + fc1(2)*particle_set(index_a)%r(2) + pv(2, 2) = pv(2, 2) + fc2(2)*particle_set(index_b)%r(2) + pv(2, 2) = pv(2, 2) + fc3(2)*particle_set(index_c)%r(2) + pv(2, 2) = pv(2, 2) + fc4(2)*particle_set(index_d)%r(2) !pv(2,3) - pv(2, 3) = pv(2, 3)+fc1(2)*particle_set(index_a)%r(3) - pv(2, 3) = pv(2, 3)+fc2(2)*particle_set(index_b)%r(3) - pv(2, 3) = pv(2, 3)+fc3(2)*particle_set(index_c)%r(3) - pv(2, 3) = pv(2, 3)+fc4(2)*particle_set(index_d)%r(3) + pv(2, 3) = pv(2, 3) + fc1(2)*particle_set(index_a)%r(3) + pv(2, 3) = pv(2, 3) + fc2(2)*particle_set(index_b)%r(3) + pv(2, 3) = pv(2, 3) + fc3(2)*particle_set(index_c)%r(3) + pv(2, 3) = pv(2, 3) + fc4(2)*particle_set(index_d)%r(3) !pv(3,1) - pv(3, 1) = pv(3, 1)+fc1(3)*particle_set(index_a)%r(1) - pv(3, 1) = pv(3, 1)+fc2(3)*particle_set(index_b)%r(1) - pv(3, 1) = pv(3, 1)+fc3(3)*particle_set(index_c)%r(1) - pv(3, 1) = pv(3, 1)+fc4(3)*particle_set(index_d)%r(1) + pv(3, 1) = pv(3, 1) + fc1(3)*particle_set(index_a)%r(1) + pv(3, 1) = pv(3, 1) + fc2(3)*particle_set(index_b)%r(1) + pv(3, 1) = pv(3, 1) + fc3(3)*particle_set(index_c)%r(1) + pv(3, 1) = pv(3, 1) + fc4(3)*particle_set(index_d)%r(1) !pv(3,2) - pv(3, 2) = pv(3, 2)+fc1(3)*particle_set(index_a)%r(2) - pv(3, 2) = pv(3, 2)+fc2(3)*particle_set(index_b)%r(2) - pv(3, 2) = pv(3, 2)+fc3(3)*particle_set(index_c)%r(2) - pv(3, 2) = pv(3, 2)+fc4(3)*particle_set(index_d)%r(2) + pv(3, 2) = pv(3, 2) + fc1(3)*particle_set(index_a)%r(2) + pv(3, 2) = pv(3, 2) + fc2(3)*particle_set(index_b)%r(2) + pv(3, 2) = pv(3, 2) + fc3(3)*particle_set(index_c)%r(2) + pv(3, 2) = pv(3, 2) + fc4(3)*particle_set(index_d)%r(2) !pv(3,3) - pv(3, 3) = pv(3, 3)+fc1(3)*particle_set(index_a)%r(3) - pv(3, 3) = pv(3, 3)+fc2(3)*particle_set(index_b)%r(3) - pv(3, 3) = pv(3, 3)+fc3(3)*particle_set(index_c)%r(3) - pv(3, 3) = pv(3, 3)+fc4(3)*particle_set(index_d)%r(3) + pv(3, 3) = pv(3, 3) + fc1(3)*particle_set(index_a)%r(3) + pv(3, 3) = pv(3, 3) + fc2(3)*particle_set(index_b)%r(3) + pv(3, 3) = pv(3, 3) + fc3(3)*particle_set(index_c)%r(3) + pv(3, 3) = pv(3, 3) + fc4(3)*particle_set(index_d)%r(3) END DO END SUBROUTINE pv_constraint_low @@ -462,7 +462,7 @@ SUBROUTINE pv_colv_eval(pv, lcolv, particle_set) DO i = 1, 3 tmp = lambda*particle_set(ind)%r(i) DO j = 1, 3 - pv(j, i) = pv(j, i)+f(j)*tmp + pv(j, i) = pv(j, i) + f(j)*tmp END DO END DO END DO @@ -500,12 +500,12 @@ SUBROUTINE check_tol(roll_tol, iroll, char, matrix, veps) roll_tol = -1.E10_dp ELSE roll_tol = 0.0_dp - diff_shake = ABS(matrix_old-matrix) + diff_shake = ABS(matrix_old - matrix) local_tol = MAXVAL(diff_shake) roll_tol = MAX(roll_tol, local_tol) matrix_old = matrix END IF - iroll = iroll+1 + iroll = iroll + 1 CASE ('RATTLE') IF (iroll == 1) THEN veps_old = veps @@ -513,12 +513,12 @@ SUBROUTINE check_tol(roll_tol, iroll, char, matrix, veps) ELSE roll_tol = 0.0_dp ! compute tolerance on veps - diff_rattle = ABS(veps-veps_old) + diff_rattle = ABS(veps - veps_old) local_tol = MAXVAL(diff_rattle) roll_tol = MAX(roll_tol, local_tol) veps_old = veps END IF - iroll = iroll+1 + iroll = iroll + 1 END SELECT END SUBROUTINE check_tol diff --git a/src/constraint_vsite.F b/src/constraint_vsite.F index 08f4efadef..3cf90f6c4a 100644 --- a/src/constraint_vsite.F +++ b/src/constraint_vsite.F @@ -170,14 +170,14 @@ SUBROUTINE shake_vsite_low(vsite_list, nvsite, first_atom, pos) DO iconst = 1, nvsite IF (vsite_list(iconst)%restraint%active) CYCLE - index_a = vsite_list(iconst)%a+first_atom-1 - index_b = vsite_list(iconst)%b+first_atom-1 - index_c = vsite_list(iconst)%c+first_atom-1 - index_d = vsite_list(iconst)%d+first_atom-1 - - r1(:) = pos(:, index_b)-pos(:, index_c) - r2(:) = pos(:, index_d)-pos(:, index_c) - pos(:, index_a) = pos(:, index_c)+vsite_list(iconst)%wbc*r1(:)+ & + index_a = vsite_list(iconst)%a + first_atom - 1 + index_b = vsite_list(iconst)%b + first_atom - 1 + index_c = vsite_list(iconst)%c + first_atom - 1 + index_d = vsite_list(iconst)%d + first_atom - 1 + + r1(:) = pos(:, index_b) - pos(:, index_c) + r2(:) = pos(:, index_d) - pos(:, index_c) + pos(:, index_a) = pos(:, index_c) + vsite_list(iconst)%wbc*r1(:) + & vsite_list(iconst)%wdc*r2(:) END DO END SUBROUTINE shake_vsite_low @@ -205,18 +205,18 @@ SUBROUTINE force_vsite_int(molecule, particle_set) DO iconst = 1, nvsite IF (vsite_list(iconst)%restraint%active) CYCLE - index_a = vsite_list(iconst)%a+first_atom-1 - index_b = vsite_list(iconst)%b+first_atom-1 - index_c = vsite_list(iconst)%c+first_atom-1 - index_d = vsite_list(iconst)%d+first_atom-1 + index_a = vsite_list(iconst)%a + first_atom - 1 + index_b = vsite_list(iconst)%b + first_atom - 1 + index_c = vsite_list(iconst)%c + first_atom - 1 + index_d = vsite_list(iconst)%d + first_atom - 1 wb = vsite_list(iconst)%wbc wd = vsite_list(iconst)%wdc - wc = 1.0_dp-vsite_list(iconst)%wbc-vsite_list(iconst)%wdc + wc = 1.0_dp - vsite_list(iconst)%wbc - vsite_list(iconst)%wdc - particle_set(index_b)%f(:) = particle_set(index_b)%f(:)+wb*particle_set(index_a)%f(:) - particle_set(index_c)%f(:) = particle_set(index_c)%f(:)+wc*particle_set(index_a)%f(:) - particle_set(index_d)%f(:) = particle_set(index_d)%f(:)+wd*particle_set(index_a)%f(:) + particle_set(index_b)%f(:) = particle_set(index_b)%f(:) + wb*particle_set(index_a)%f(:) + particle_set(index_c)%f(:) = particle_set(index_c)%f(:) + wc*particle_set(index_a)%f(:) + particle_set(index_d)%f(:) = particle_set(index_d)%f(:) + wd*particle_set(index_a)%f(:) particle_set(index_a)%f(:) = 0.0_dp END DO @@ -245,18 +245,18 @@ SUBROUTINE force_vsite_ext(gci, particle_set) DO iconst = 1, nvsite IF (vsite_list(iconst)%restraint%active) CYCLE - index_a = vsite_list(iconst)%a+first_atom-1 - index_b = vsite_list(iconst)%b+first_atom-1 - index_c = vsite_list(iconst)%c+first_atom-1 - index_d = vsite_list(iconst)%d+first_atom-1 + index_a = vsite_list(iconst)%a + first_atom - 1 + index_b = vsite_list(iconst)%b + first_atom - 1 + index_c = vsite_list(iconst)%c + first_atom - 1 + index_d = vsite_list(iconst)%d + first_atom - 1 wb = vsite_list(iconst)%wbc wd = vsite_list(iconst)%wdc - wc = 1.0_dp-vsite_list(iconst)%wbc-vsite_list(iconst)%wdc + wc = 1.0_dp - vsite_list(iconst)%wbc - vsite_list(iconst)%wdc - particle_set(index_b)%f(:) = particle_set(index_b)%f(:)+wb*particle_set(index_a)%f(:) - particle_set(index_c)%f(:) = particle_set(index_c)%f(:)+wc*particle_set(index_a)%f(:) - particle_set(index_d)%f(:) = particle_set(index_d)%f(:)+wd*particle_set(index_a)%f(:) + particle_set(index_b)%f(:) = particle_set(index_b)%f(:) + wb*particle_set(index_a)%f(:) + particle_set(index_c)%f(:) = particle_set(index_c)%f(:) + wc*particle_set(index_a)%f(:) + particle_set(index_d)%f(:) = particle_set(index_d)%f(:) + wd*particle_set(index_a)%f(:) particle_set(index_a)%f(:) = 0.0_dp END DO END SUBROUTINE force_vsite_ext diff --git a/src/core_ae.F b/src/core_ae.F index abb5eea1b5..e3fa40286c 100644 --- a/src/core_ae.F +++ b/src/core_ae.F @@ -149,12 +149,12 @@ SUBROUTINE build_core_ae(matrix_h, matrix_p, force, virial, calculate_forces, us CALL get_qs_kind_set(qs_kind_set, & maxco=maxco, maxlgto=maxl, maxsgf=maxsgf, maxnset=maxnset) - CALL init_orbital_pointers(maxl+nder+1) + CALL init_orbital_pointers(maxl + nder + 1) ldsab = MAX(maxco, maxsgf) - ldai = ncoset(maxl+nder+1) + ldai = ncoset(maxl + nder + 1) ALLOCATE (hab(ldsab, ldsab, maxnset*maxnset), work(ldsab, ldsab)) - ALLOCATE (verf(ldai, ldai, 2*maxl+nder+1), vnuc(ldai, ldai, 2*maxl+nder+1), ff(0:2*maxl+nder)) + ALLOCATE (verf(ldai, ldai, 2*maxl + nder + 1), vnuc(ldai, ldai, 2*maxl + nder + 1), ff(0:2*maxl + nder)) IF (calculate_forces) THEN ALLOCATE (pab(maxco, maxco, maxnset*maxnset)) END IF @@ -242,7 +242,7 @@ SUBROUTINE build_core_ae(matrix_h, matrix_p, force, virial, calculate_forces, us DO jset = 1, nsetb ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) - nij = jset+(iset-1)*maxnset + nij = jset + (iset - 1)*maxnset IF (iatom <= jatom) THEN CALL dgemm("N", "N", ncoa, nsgfb(jset), nsgfa(iset), & 1.0_dp, sphi_a(1, sgfa), SIZE(sphi_a, 1), & @@ -283,34 +283,34 @@ SUBROUTINE build_core_ae(matrix_h, matrix_p, force, virial, calculate_forces, us DO WHILE (nl_sub_iterate(ap_iterator) == 0) CALL get_iterator_info(ap_iterator, jatom=katom, r=rac) dac = SQRT(SUM(rac*rac)) - rbc(:) = rac(:)-rab(:) + rbc(:) = rac(:) - rab(:) dbc = SQRT(SUM(rbc*rbc)) - IF ((MAXVAL(set_radius_a(:))+core_radius < dac) .OR. & - (MAXVAL(set_radius_b(:))+core_radius < dbc)) THEN + IF ((MAXVAL(set_radius_a(:)) + core_radius < dac) .OR. & + (MAXVAL(set_radius_b(:)) + core_radius < dbc)) THEN CYCLE END IF DO iset = 1, nseta - IF (set_radius_a(iset)+core_radius < dac) CYCLE + IF (set_radius_a(iset) + core_radius < dac) CYCLE ncoa = npgfa(iset)*ncoset(la_max(iset)) sgfa = first_sgfa(1, iset) DO jset = 1, nsetb - IF (set_radius_b(jset)+core_radius < dbc) CYCLE + IF (set_radius_b(jset) + core_radius < dbc) CYCLE ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE rab2 = dab*dab rac2 = dac*dac rbc2 = dbc*dbc - nij = jset+(iset-1)*maxnset + nij = jset + (iset - 1)*maxnset ! *** Calculate the GTH pseudo potential forces *** IF (calculate_forces) THEN - na_plus = npgfa(iset)*ncoset(la_max(iset)+nder) + na_plus = npgfa(iset)*ncoset(la_max(iset) + nder) nb_plus = npgfb(jset)*ncoset(lb_max(jset)) ALLOCATE (habd(na_plus, nb_plus)) habd = 0._dp CALL verfc( & - la_max(iset)+nder, npgfa(iset), zeta(:, iset), rpgfa(:, iset), la_min(iset), & + la_max(iset) + nder, npgfa(iset), zeta(:, iset), rpgfa(:, iset), la_min(iset), & lb_max(jset), npgfb(jset), zetb(:, jset), rpgfb(:, jset), lb_min(jset), & alpha_c, core_radius, zeta_c, core_charge, & rab, rab2, rac, rac2, rbc2, hab(:, :, nij), verf, vnuc, ff(0:), & @@ -326,20 +326,20 @@ SUBROUTINE build_core_ae(matrix_h, matrix_p, force, virial, calculate_forces, us DEALLOCATE (habd) atom_c = atom_of_kind(katom) - force(ikind)%all_potential(1, atom_a) = force(ikind)%all_potential(1, atom_a)+f0*force_a(1) - force(ikind)%all_potential(2, atom_a) = force(ikind)%all_potential(2, atom_a)+f0*force_a(2) - force(ikind)%all_potential(3, atom_a) = force(ikind)%all_potential(3, atom_a)+f0*force_a(3) + force(ikind)%all_potential(1, atom_a) = force(ikind)%all_potential(1, atom_a) + f0*force_a(1) + force(ikind)%all_potential(2, atom_a) = force(ikind)%all_potential(2, atom_a) + f0*force_a(2) + force(ikind)%all_potential(3, atom_a) = force(ikind)%all_potential(3, atom_a) + f0*force_a(3) - force(jkind)%all_potential(1, atom_b) = force(jkind)%all_potential(1, atom_b)+f0*force_b(1) - force(jkind)%all_potential(2, atom_b) = force(jkind)%all_potential(2, atom_b)+f0*force_b(2) - force(jkind)%all_potential(3, atom_b) = force(jkind)%all_potential(3, atom_b)+f0*force_b(3) + force(jkind)%all_potential(1, atom_b) = force(jkind)%all_potential(1, atom_b) + f0*force_b(1) + force(jkind)%all_potential(2, atom_b) = force(jkind)%all_potential(2, atom_b) + f0*force_b(2) + force(jkind)%all_potential(3, atom_b) = force(jkind)%all_potential(3, atom_b) + f0*force_b(3) force(kkind)%all_potential(1, atom_c) = force(kkind)%all_potential(1, atom_c) & - -f0*force_a(1)-f0*force_b(1) + - f0*force_a(1) - f0*force_b(1) force(kkind)%all_potential(2, atom_c) = force(kkind)%all_potential(2, atom_c) & - -f0*force_a(2)-f0*force_b(2) + - f0*force_a(2) - f0*force_b(2) force(kkind)%all_potential(3, atom_c) = force(kkind)%all_potential(3, atom_c) & - -f0*force_a(3)-f0*force_b(3) + - f0*force_a(3) - f0*force_b(3) IF (use_virial) THEN CALL virial_pair_force(virial%pv_virial, f0, force_a, rac) @@ -363,7 +363,7 @@ SUBROUTINE build_core_ae(matrix_h, matrix_p, force, virial, calculate_forces, us DO jset = 1, nsetb ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) - nij = jset+(iset-1)*maxnset + nij = jset + (iset - 1)*maxnset CALL dgemm("N", "N", ncoa, nsgfb(jset), ncob, & 1.0_dp, hab(1, 1, nij), SIZE(hab, 1), & sphi_b(1, sgfb), SIZE(sphi_b, 1), & @@ -406,7 +406,7 @@ SUBROUTINE build_core_ae(matrix_h, matrix_p, force, virial, calculate_forces, us END IF END IF IF (calculate_forces .AND. use_virial) THEN - virial%pv_ppl = virial%pv_virial-pv_loc + virial%pv_ppl = virial%pv_virial - pv_loc END IF CALL timestop(handle) @@ -453,47 +453,47 @@ SUBROUTINE verfc_force(habd, pab, fa, fb, nder, la_max, la_min, npgfa, zeta, lb_ fb = 0.0_dp na = ncoset(la_max) - nap = ncoset(la_max+nder) + nap = ncoset(la_max + nder) nb = ncoset(lb_max) DO ipgfa = 1, npgfa zax2 = zeta(ipgfa)*2.0_dp DO ipgfb = 1, npgfb zbx2 = zetb(ipgfb)*2.0_dp - DO ic_a = ncoset(la_min-1)+1, ncoset(la_max) + DO ic_a = ncoset(la_min - 1) + 1, ncoset(la_max) la(1:3) = indco(1:3, ic_a) - icap1 = coset(la(1)+1, la(2), la(3)) - icap2 = coset(la(1), la(2)+1, la(3)) - icap3 = coset(la(1), la(2), la(3)+1) - icam1 = coset(la(1)-1, la(2), la(3)) - icam2 = coset(la(1), la(2)-1, la(3)) - icam3 = coset(la(1), la(2), la(3)-1) - icoa = ic_a+(ipgfa-1)*na - icax = (ipgfa-1)*nap - - DO ic_b = ncoset(lb_min-1)+1, ncoset(lb_max) + icap1 = coset(la(1) + 1, la(2), la(3)) + icap2 = coset(la(1), la(2) + 1, la(3)) + icap3 = coset(la(1), la(2), la(3) + 1) + icam1 = coset(la(1) - 1, la(2), la(3)) + icam2 = coset(la(1), la(2) - 1, la(3)) + icam3 = coset(la(1), la(2), la(3) - 1) + icoa = ic_a + (ipgfa - 1)*na + icax = (ipgfa - 1)*nap + + DO ic_b = ncoset(lb_min - 1) + 1, ncoset(lb_max) lb(1:3) = indco(1:3, ic_b) - icbm1 = coset(lb(1)-1, lb(2), lb(3)) - icbm2 = coset(lb(1), lb(2)-1, lb(3)) - icbm3 = coset(lb(1), lb(2), lb(3)-1) - icob = ic_b+(ipgfb-1)*nb - icbx = (ipgfb-1)*nb - - fa(1) = fa(1)-pab(icoa, icob)*(-zax2*habd(icap1+icax, icob)+ & - REAL(la(1), KIND=dp)*habd(icam1+icax, icob)) - fa(2) = fa(2)-pab(icoa, icob)*(-zax2*habd(icap2+icax, icob)+ & - REAL(la(2), KIND=dp)*habd(icam2+icax, icob)) - fa(3) = fa(3)-pab(icoa, icob)*(-zax2*habd(icap3+icax, icob)+ & - REAL(la(3), KIND=dp)*habd(icam3+icax, icob)) - - fb(1) = fb(1)-pab(icoa, icob)*( & - -zbx2*(habd(icap1+icax, icob)-rab(1)*habd(ic_a+icax, icob))+ & - REAL(lb(1), KIND=dp)*habd(ic_a+icax, icbm1+icbx)) - fb(2) = fb(2)-pab(icoa, icob)*( & - -zbx2*(habd(icap2+icax, icob)-rab(2)*habd(ic_a+icax, icob))+ & - REAL(lb(2), KIND=dp)*habd(ic_a+icax, icbm2+icbx)) - fb(3) = fb(3)-pab(icoa, icob)*( & - -zbx2*(habd(icap3+icax, icob)-rab(3)*habd(ic_a+icax, icob))+ & - REAL(lb(3), KIND=dp)*habd(ic_a+icax, icbm3+icbx)) + icbm1 = coset(lb(1) - 1, lb(2), lb(3)) + icbm2 = coset(lb(1), lb(2) - 1, lb(3)) + icbm3 = coset(lb(1), lb(2), lb(3) - 1) + icob = ic_b + (ipgfb - 1)*nb + icbx = (ipgfb - 1)*nb + + fa(1) = fa(1) - pab(icoa, icob)*(-zax2*habd(icap1 + icax, icob) + & + REAL(la(1), KIND=dp)*habd(icam1 + icax, icob)) + fa(2) = fa(2) - pab(icoa, icob)*(-zax2*habd(icap2 + icax, icob) + & + REAL(la(2), KIND=dp)*habd(icam2 + icax, icob)) + fa(3) = fa(3) - pab(icoa, icob)*(-zax2*habd(icap3 + icax, icob) + & + REAL(la(3), KIND=dp)*habd(icam3 + icax, icob)) + + fb(1) = fb(1) - pab(icoa, icob)*( & + -zbx2*(habd(icap1 + icax, icob) - rab(1)*habd(ic_a + icax, icob)) + & + REAL(lb(1), KIND=dp)*habd(ic_a + icax, icbm1 + icbx)) + fb(2) = fb(2) - pab(icoa, icob)*( & + -zbx2*(habd(icap2 + icax, icob) - rab(2)*habd(ic_a + icax, icob)) + & + REAL(lb(2), KIND=dp)*habd(ic_a + icax, icbm2 + icbx)) + fb(3) = fb(3) - pab(icoa, icob)*( & + -zbx2*(habd(icap3 + icax, icob) - rab(3)*habd(ic_a + icax, icob)) + & + REAL(lb(3), KIND=dp)*habd(ic_a + icax, icbm3 + icbx)) END DO ! ic_b END DO ! ic_a diff --git a/src/core_ppl.F b/src/core_ppl.F index 1f25e369e5..930ab0d297 100644 --- a/src/core_ppl.F +++ b/src/core_ppl.F @@ -164,10 +164,10 @@ SUBROUTINE build_core_ppl(matrix_h, matrix_p, force, virial, calculate_forces, u basis_type=basis_type) maxl = MAX(maxlgto, maxlppl) - CALL init_orbital_pointers(2*maxl+2*nder+1) + CALL init_orbital_pointers(2*maxl + 2*nder + 1) ldsab = MAX(maxco, ncoset(maxlppl), maxsgf, maxlppl) - ldai = ncoset(maxl+nder+1) + ldai = ncoset(maxl + nder + 1) ALLOCATE (basis_set_list(nkind)) DO ikind = 1, nkind @@ -214,8 +214,8 @@ SUBROUTINE build_core_ppl(matrix_h, matrix_p, force, virial, calculate_forces, u !$ mepos = omp_get_thread_num() ALLOCATE (hab(ldsab, ldsab, maxnset, maxnset), work(ldsab, ldsab*maxder)) - ldai = ncoset(2*maxlgto+2*nder) - ALLOCATE (ppl_work(ldai, ldai, MAX(maxder, 2*maxlgto+2*nder+1))) + ldai = ncoset(2*maxlgto + 2*nder) + ALLOCATE (ppl_work(ldai, ldai, MAX(maxder, 2*maxlgto + 2*nder + 1))) IF (calculate_forces) THEN ALLOCATE (pab(maxco, maxco, maxnset, maxnset)) ldai = ncoset(maxlgto) @@ -336,11 +336,11 @@ SUBROUTINE build_core_ppl(matrix_h, matrix_p, force, virial, calculate_forces, u CALL get_potential(potential=gth_potential, & nexp_lpot=nexp_lpot, alpha_lpot=alpha_lpot, nct_lpot=nct_lpot, cval_lpot=cval_lpot) CPASSERT(nexp_lpot < nexp_max) - nexp_ppl = nexp_lpot+1 - alpha_ppl(2:nexp_lpot+1) = alpha_lpot(1:nexp_lpot) - nct_ppl(2:nexp_lpot+1) = nct_lpot(1:nexp_lpot) + nexp_ppl = nexp_lpot + 1 + alpha_ppl(2:nexp_lpot + 1) = alpha_lpot(1:nexp_lpot) + nct_ppl(2:nexp_lpot + 1) = nct_lpot(1:nexp_lpot) DO i = 1, nexp_lpot - cval_ppl(1:nct_lpot(i), i+1) = cval_lpot(1:nct_lpot(i), i) + cval_ppl(1:nct_lpot(i), i + 1) = cval_lpot(1:nct_lpot(i), i) END DO END IF ELSE IF (ASSOCIATED(sgp_potential)) THEN @@ -350,7 +350,7 @@ SUBROUTINE build_core_ppl(matrix_h, matrix_p, force, virial, calculate_forces, u IF (SUM(ABS(aloc(1:nloc))) < 1.0e-12_dp) CYCLE nexp_ppl = nloc CPASSERT(nexp_ppl <= nexp_max) - nct_ppl(1:nloc) = nrloc(1:nloc)-1 + nct_ppl(1:nloc) = nrloc(1:nloc) - 1 alpha_ppl(1:nloc) = bloc(1:nloc) cval_ppl(1, 1:nloc) = aloc(1:nloc) ELSE @@ -372,22 +372,22 @@ SUBROUTINE build_core_ppl(matrix_h, matrix_p, force, virial, calculate_forces, u CALL get_iterator_info(ap_iterator, mepos=mepos, jatom=katom, r=rac) dac = SQRT(SUM(rac*rac)) - rbc(:) = rac(:)-rab(:) + rbc(:) = rac(:) - rab(:) dbc = SQRT(SUM(rbc*rbc)) - IF ((MAXVAL(set_radius_a(:))+ppl_radius < dac) .OR. & - (MAXVAL(set_radius_b(:))+ppl_radius < dbc)) THEN + IF ((MAXVAL(set_radius_a(:)) + ppl_radius < dac) .OR. & + (MAXVAL(set_radius_b(:)) + ppl_radius < dbc)) THEN CYCLE END IF DO iset = 1, nseta - IF (set_radius_a(iset)+ppl_radius < dac) CYCLE + IF (set_radius_a(iset) + ppl_radius < dac) CYCLE ncoa = npgfa(iset)*ncoset(la_max(iset)) sgfa = first_sgfa(1, iset) DO jset = 1, nsetb - IF (set_radius_b(jset)+ppl_radius < dbc) CYCLE + IF (set_radius_b(jset) + ppl_radius < dbc) CYCLE ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE ! *** Calculate the GTH pseudo potential forces *** IF (calculate_forces) THEN @@ -406,19 +406,19 @@ SUBROUTINE build_core_ppl(matrix_h, matrix_p, force, virial, calculate_forces, u atom_c = atom_of_kind(katom) !$OMP CRITICAL(force_critical) - force(ikind)%gth_ppl(1, atom_a) = force(ikind)%gth_ppl(1, atom_a)+f0*force_a(1) - force(ikind)%gth_ppl(2, atom_a) = force(ikind)%gth_ppl(2, atom_a)+f0*force_a(2) - force(ikind)%gth_ppl(3, atom_a) = force(ikind)%gth_ppl(3, atom_a)+f0*force_a(3) - force(kkind)%gth_ppl(1, atom_c) = force(kkind)%gth_ppl(1, atom_c)-f0*force_a(1) - force(kkind)%gth_ppl(2, atom_c) = force(kkind)%gth_ppl(2, atom_c)-f0*force_a(2) - force(kkind)%gth_ppl(3, atom_c) = force(kkind)%gth_ppl(3, atom_c)-f0*force_a(3) - - force(jkind)%gth_ppl(1, atom_b) = force(jkind)%gth_ppl(1, atom_b)+f0*force_b(1) - force(jkind)%gth_ppl(2, atom_b) = force(jkind)%gth_ppl(2, atom_b)+f0*force_b(2) - force(jkind)%gth_ppl(3, atom_b) = force(jkind)%gth_ppl(3, atom_b)+f0*force_b(3) - force(kkind)%gth_ppl(1, atom_c) = force(kkind)%gth_ppl(1, atom_c)-f0*force_b(1) - force(kkind)%gth_ppl(2, atom_c) = force(kkind)%gth_ppl(2, atom_c)-f0*force_b(2) - force(kkind)%gth_ppl(3, atom_c) = force(kkind)%gth_ppl(3, atom_c)-f0*force_b(3) + force(ikind)%gth_ppl(1, atom_a) = force(ikind)%gth_ppl(1, atom_a) + f0*force_a(1) + force(ikind)%gth_ppl(2, atom_a) = force(ikind)%gth_ppl(2, atom_a) + f0*force_a(2) + force(ikind)%gth_ppl(3, atom_a) = force(ikind)%gth_ppl(3, atom_a) + f0*force_a(3) + force(kkind)%gth_ppl(1, atom_c) = force(kkind)%gth_ppl(1, atom_c) - f0*force_a(1) + force(kkind)%gth_ppl(2, atom_c) = force(kkind)%gth_ppl(2, atom_c) - f0*force_a(2) + force(kkind)%gth_ppl(3, atom_c) = force(kkind)%gth_ppl(3, atom_c) - f0*force_a(3) + + force(jkind)%gth_ppl(1, atom_b) = force(jkind)%gth_ppl(1, atom_b) + f0*force_b(1) + force(jkind)%gth_ppl(2, atom_b) = force(jkind)%gth_ppl(2, atom_b) + f0*force_b(2) + force(jkind)%gth_ppl(3, atom_b) = force(jkind)%gth_ppl(3, atom_b) + f0*force_b(3) + force(kkind)%gth_ppl(1, atom_c) = force(kkind)%gth_ppl(1, atom_c) - f0*force_b(1) + force(kkind)%gth_ppl(2, atom_c) = force(kkind)%gth_ppl(2, atom_c) - f0*force_b(2) + force(kkind)%gth_ppl(3, atom_c) = force(kkind)%gth_ppl(3, atom_c) - f0*force_b(3) IF (use_virial) THEN CALL virial_pair_force(virial%pv_virial, f0, force_a, rac) @@ -498,7 +498,7 @@ SUBROUTINE build_core_ppl(matrix_h, matrix_p, force, virial, calculate_forces, u END IF IF (calculate_forces .AND. use_virial) THEN - virial%pv_ppl = virial%pv_virial-pv_loc + virial%pv_ppl = virial%pv_virial - pv_loc END IF CALL timestop(handle) @@ -650,11 +650,11 @@ SUBROUTINE build_core_ppl_ri(lri_ppl_coef, force, virial, calculate_forces, use_ CALL get_potential(potential=gth_potential, & nexp_lpot=nexp_lpot, alpha_lpot=alpha_lpot, nct_lpot=nct_lpot, cval_lpot=cval_lpot) CPASSERT(nexp_lpot < nexp_max) - nexp_ppl = nexp_lpot+1 - alpha_ppl(2:nexp_lpot+1) = alpha_lpot(1:nexp_lpot) - nct_ppl(2:nexp_lpot+1) = nct_lpot(1:nexp_lpot) + nexp_ppl = nexp_lpot + 1 + alpha_ppl(2:nexp_lpot + 1) = alpha_lpot(1:nexp_lpot) + nct_ppl(2:nexp_lpot + 1) = nct_lpot(1:nexp_lpot) DO i = 1, nexp_lpot - cval_ppl(1:nct_lpot(i), i+1) = cval_lpot(1:nct_lpot(i), i) + cval_ppl(1:nct_lpot(i), i + 1) = cval_lpot(1:nct_lpot(i), i) END DO END IF ELSE IF (ASSOCIATED(sgp_potential)) THEN @@ -664,7 +664,7 @@ SUBROUTINE build_core_ppl_ri(lri_ppl_coef, force, virial, calculate_forces, use_ IF (SUM(ABS(aloc(1:nloc))) < 1.0e-12_dp) CYCLE nexp_ppl = nloc CPASSERT(nexp_ppl <= nexp_max) - nct_ppl(1:nloc) = nrloc(1:nloc)-1 + nct_ppl(1:nloc) = nrloc(1:nloc) - 1 alpha_ppl(1:nloc) = bloc(1:nloc) cval_ppl(1, 1:nloc) = aloc(1:nloc) ELSE @@ -680,12 +680,12 @@ SUBROUTINE build_core_ppl_ri(lri_ppl_coef, force, virial, calculate_forces, use_ END IF dac = SQRT(SUM(rac*rac)) - IF ((MAXVAL(set_radius_a(:))+ppl_radius < dac)) CYCLE + IF ((MAXVAL(set_radius_a(:)) + ppl_radius < dac)) CYCLE IF (calculate_forces) force_a = 0.0_dp work(1:nfun) = 0.0_dp DO iset = 1, nseta - IF (set_radius_a(iset)+ppl_radius < dac) CYCLE + IF (set_radius_a(iset) + ppl_radius < dac) CYCLE ! integrals IF (calculate_forces) THEN va = 0.0_dp @@ -703,28 +703,28 @@ SUBROUTINE build_core_ppl_ri(lri_ppl_coef, force, virial, calculate_forces, use_ END IF ! contraction sgfa = first_sgfa(1, iset) - sgfb = sgfa+nsgfa(iset)-1 + sgfb = sgfa + nsgfa(iset) - 1 ncoa = npgfa(iset)*ncoset(la_max(iset)) bcon => sphi_a(1:ncoa, sgfa:sgfb) work(sgfa:sgfb) = MATMUL(TRANSPOSE(bcon), va(1:ncoa)) IF (calculate_forces) THEN dvas(1:nsgfa(iset), 1:3) = MATMUL(TRANSPOSE(bcon), dva(1:ncoa, 1:3)) - force_a(1) = force_a(1)+SUM(lri_ppl_coef(ikind)%acoef(atom_a, sgfa:sgfb)*dvas(1:nsgfa(iset), 1)) - force_a(2) = force_a(2)+SUM(lri_ppl_coef(ikind)%acoef(atom_a, sgfa:sgfb)*dvas(1:nsgfa(iset), 2)) - force_a(3) = force_a(3)+SUM(lri_ppl_coef(ikind)%acoef(atom_a, sgfa:sgfb)*dvas(1:nsgfa(iset), 3)) + force_a(1) = force_a(1) + SUM(lri_ppl_coef(ikind)%acoef(atom_a, sgfa:sgfb)*dvas(1:nsgfa(iset), 1)) + force_a(2) = force_a(2) + SUM(lri_ppl_coef(ikind)%acoef(atom_a, sgfa:sgfb)*dvas(1:nsgfa(iset), 2)) + force_a(3) = force_a(3) + SUM(lri_ppl_coef(ikind)%acoef(atom_a, sgfa:sgfb)*dvas(1:nsgfa(iset), 3)) END IF END DO !$OMP CRITICAL(int_critical) - lri_ppl_coef(ikind)%v_int(atom_a, 1:nfun) = lri_ppl_coef(ikind)%v_int(atom_a, 1:nfun)+work(1:nfun) + lri_ppl_coef(ikind)%v_int(atom_a, 1:nfun) = lri_ppl_coef(ikind)%v_int(atom_a, 1:nfun) + work(1:nfun) !$OMP END CRITICAL(int_critical) IF (calculate_forces) THEN !$OMP CRITICAL(force_critical) - force(ikind)%gth_ppl(1, atom_a) = force(ikind)%gth_ppl(1, atom_a)+force_a(1) - force(ikind)%gth_ppl(2, atom_a) = force(ikind)%gth_ppl(2, atom_a)+force_a(2) - force(ikind)%gth_ppl(3, atom_a) = force(ikind)%gth_ppl(3, atom_a)+force_a(3) - force(kkind)%gth_ppl(1, atom_c) = force(kkind)%gth_ppl(1, atom_c)-force_a(1) - force(kkind)%gth_ppl(2, atom_c) = force(kkind)%gth_ppl(2, atom_c)-force_a(2) - force(kkind)%gth_ppl(3, atom_c) = force(kkind)%gth_ppl(3, atom_c)-force_a(3) + force(ikind)%gth_ppl(1, atom_a) = force(ikind)%gth_ppl(1, atom_a) + force_a(1) + force(ikind)%gth_ppl(2, atom_a) = force(ikind)%gth_ppl(2, atom_a) + force_a(2) + force(ikind)%gth_ppl(3, atom_a) = force(ikind)%gth_ppl(3, atom_a) + force_a(3) + force(kkind)%gth_ppl(1, atom_c) = force(kkind)%gth_ppl(1, atom_c) - force_a(1) + force(kkind)%gth_ppl(2, atom_c) = force(kkind)%gth_ppl(2, atom_c) - force_a(2) + force(kkind)%gth_ppl(3, atom_c) = force(kkind)%gth_ppl(3, atom_c) - force_a(3) IF (use_virial) THEN CALL virial_pair_force(virial%pv_virial, 1.0_dp, force_a, rac) END IF diff --git a/src/core_ppnl.F b/src/core_ppnl.F index e70c01bd4a..1730102a61 100644 --- a/src/core_ppnl.F +++ b/src/core_ppnl.F @@ -181,10 +181,10 @@ SUBROUTINE build_core_ppnl(matrix_h, matrix_p, force, virial, calculate_forces, basis_type=basis_type) maxl = MAX(maxlgto, maxlppnl) - CALL init_orbital_pointers(maxl+nder+1) + CALL init_orbital_pointers(maxl + nder + 1) ldsab = MAX(maxco, ncoset(maxlppnl), maxsgf, maxppnl) - ldai = ncoset(maxl+nder+1) + ldai = ncoset(maxl + nder + 1) !sap_int needs to be shared as multiple threads need to access this ALLOCATE (sap_int(nkind*nkind)) @@ -233,14 +233,14 @@ SUBROUTINE build_core_ppnl(matrix_h, matrix_p, force, virial, calculate_forces, ALLOCATE (sab(ldsab, ldsab*maxder), work(ldsab, ldsab*maxder)) sab = 0.0_dp - ALLOCATE (ai_work(ldai, ldai, ncoset(nder+1))) + ALLOCATE (ai_work(ldai, ldai, ncoset(nder + 1))) ai_work = 0.0_dp DO WHILE (neighbor_list_iterate(nl_iterator, mepos=mepos) == 0) CALL get_iterator_info(nl_iterator, mepos=mepos, ikind=ikind, jkind=kkind, iatom=iatom, & jatom=katom, nlist=nlist, ilist=ilist, nnode=nneighbor, & inode=jneighbor, cell=cell_c, r=rac) - iac = ikind+nkind*(kkind-1) + iac = ikind + nkind*(kkind - 1) IF (.NOT. ASSOCIATED(basis_set(ikind)%gto_basis_set)) CYCLE ! get definition of basis set first_sgfa => basis_set(ikind)%gto_basis_set%first_sgf @@ -330,8 +330,8 @@ SUBROUTINE build_core_ppnl(matrix_h, matrix_p, force, virial, calculate_forces, nprjc = nprj_ppnl(l)*nco(l) IF (nprjc == 0) CYCLE rprjc(1) = ppnl_radius - IF (set_radius_a(iset)+rprjc(1) < dac) CYCLE - lc_max = l+2*(nprj_ppnl(l)-1) + IF (set_radius_a(iset) + rprjc(1) < dac) CYCLE + lc_max = l + 2*(nprj_ppnl(l) - 1) lc_min = l zetc(1) = alpha_ppnl(l) ncoc = ncoset(lc_max) @@ -341,14 +341,14 @@ SUBROUTINE build_core_ppnl(matrix_h, matrix_p, force, virial, calculate_forces, lc_max, lc_min, 1, rprjc, zetc, rac, dac, sab, nder, .TRUE., ai_work, ldai) ! *** Transformation step projector functions (cartesian->spherical) *** DO i = 1, maxder - first_col = (i-1)*ldsab - CALL dgemm("N", "N", ncoa, nprjc, ncoc, 1.0_dp, sab(1, first_col+1), SIZE(sab, 1), & - cprj(1, prjc), SIZE(cprj, 1), 0.0_dp, work(1, first_col+prjc), ldsab) + first_col = (i - 1)*ldsab + CALL dgemm("N", "N", ncoa, nprjc, ncoc, 1.0_dp, sab(1, first_col + 1), SIZE(sab, 1), & + cprj(1, prjc), SIZE(cprj, 1), 0.0_dp, work(1, first_col + prjc), ldsab) END DO - prjc = prjc+nprjc + prjc = prjc + nprjc END DO DO i = 1, maxder - first_col = (i-1)*ldsab+1 + first_col = (i - 1)*ldsab + 1 ! *** Contraction step (basis functions) *** CALL dgemm("T", "N", nsgf_seta(iset), nppnl, ncoa, 1.0_dp, sphi_a(1, sgfa), SIZE(sphi_a, 1), & work(1, first_col), ldsab, 0.0_dp, clist%acint(sgfa, 1, i), nsgfa) @@ -362,7 +362,7 @@ SUBROUTINE build_core_ppnl(matrix_h, matrix_p, force, virial, calculate_forces, CALL overlap(la_max(iset), la_min(iset), npgfa(iset), rpgfa(:, iset), zeta(:, iset), & lppnl, 0, nnl, radp, a_nl, rac, dac, sab, nder, .TRUE., ai_work, ldai) DO i = 1, maxder - first_col = (i-1)*ldsab+1 + first_col = (i - 1)*ldsab + 1 ! *** Transformation step projector functions (cartesian->spherical) *** CALL dgemm("N", "N", ncoa, nppnl, nprjc, 1.0_dp, sab(1, first_col), ldsab, & cprj(1, 1), SIZE(cprj, 1), 0.0_dp, work(1, 1), ldsab) @@ -370,7 +370,7 @@ SUBROUTINE build_core_ppnl(matrix_h, matrix_p, force, virial, calculate_forces, CALL dgemm("T", "N", nsgf_seta(iset), nppnl, ncoa, 1.0_dp, sphi_a(1, sgfa), SIZE(sphi_a, 1), & work(1, 1), ldsab, 0.0_dp, clist%acint(sgfa, 1, i), nsgfa) ! *** Multiply with interaction matrix(h) *** - ncoc = sgfa+nsgf_seta(iset)-1 + ncoc = sgfa + nsgf_seta(iset) - 1 DO j = 1, nppnl clist%achint(sgfa:ncoc, j, i) = clist%acint(sgfa:ncoc, j, i)*hprj(j) END DO @@ -410,7 +410,7 @@ SUBROUTINE build_core_ppnl(matrix_h, matrix_p, force, virial, calculate_forces, jatom=jatom, nlist=nlist, ilist=ilist, nnode=nnode, inode=inode, cell=cell_b, r=rab) IF (.NOT. ASSOCIATED(basis_set(ikind)%gto_basis_set)) CYCLE IF (.NOT. ASSOCIATED(basis_set(jkind)%gto_basis_set)) CYCLE - iab = ikind+nkind*(jkind-1) + iab = ikind + nkind*(jkind - 1) atom_a = atom_of_kind(iatom) atom_b = atom_of_kind(jatom) @@ -445,8 +445,8 @@ SUBROUTINE build_core_ppnl(matrix_h, matrix_p, force, virial, calculate_forces, ! loop over all kinds for projector atom IF (ASSOCIATED(h_block)) THEN DO kkind = 1, nkind - iac = ikind+nkind*(kkind-1) - ibc = jkind+nkind*(kkind-1) + iac = ikind + nkind*(kkind - 1) + ibc = jkind + nkind*(kkind - 1) IF (.NOT. ASSOCIATED(sap_int(iac)%alist)) CYCLE IF (.NOT. ASSOCIATED(sap_int(ibc)%alist)) CYCLE CALL get_alist(sap_int(iac), alist_ac, iatom) @@ -456,7 +456,7 @@ SUBROUTINE build_core_ppnl(matrix_h, matrix_p, force, virial, calculate_forces, DO kac = 1, alist_ac%nclist DO kbc = 1, alist_bc%nclist IF (alist_ac%clist(kac)%catom /= alist_bc%clist(kbc)%catom) CYCLE - IF (ALL(cell_b+alist_bc%clist(kbc)%cell-alist_ac%clist(kac)%cell == 0)) THEN + IF (ALL(cell_b + alist_bc%clist(kbc)%cell - alist_ac%clist(kac)%cell == 0)) THEN IF (alist_ac%clist(kac)%maxac*alist_bc%clist(kbc)%maxach < eps_ppnl) CYCLE acint => alist_ac%clist(kac)%acint bcint => alist_bc%clist(kbc)%acint @@ -479,7 +479,7 @@ SUBROUTINE build_core_ppnl(matrix_h, matrix_p, force, virial, calculate_forces, katom = alist_ac%clist(kac)%catom atom_c = atom_of_kind(katom) DO i = 1, 3 - j = i+1 + j = i + 1 IF (iatom <= jatom) THEN fa(i) = SUM(p_block(1:na, 1:nb)* & MATMUL(acint(1:na, 1:np, j), TRANSPOSE(bchint(1:nb, 1:np, 1)))) @@ -492,10 +492,10 @@ SUBROUTINE build_core_ppnl(matrix_h, matrix_p, force, virial, calculate_forces, MATMUL(bcint(1:nb, 1:np, j), TRANSPOSE(achint(1:na, 1:np, 1)))) END IF !$OMP CRITICAL(force_critical) - force(ikind)%gth_ppnl(i, atom_a) = force(ikind)%gth_ppnl(i, atom_a)+f0*fa(i) - force(kkind)%gth_ppnl(i, atom_c) = force(kkind)%gth_ppnl(i, atom_c)-f0*fa(i) - force(jkind)%gth_ppnl(i, atom_b) = force(jkind)%gth_ppnl(i, atom_b)+f0*fb(i) - force(kkind)%gth_ppnl(i, atom_c) = force(kkind)%gth_ppnl(i, atom_c)-f0*fb(i) + force(ikind)%gth_ppnl(i, atom_a) = force(ikind)%gth_ppnl(i, atom_a) + f0*fa(i) + force(kkind)%gth_ppnl(i, atom_c) = force(kkind)%gth_ppnl(i, atom_c) - f0*fa(i) + force(jkind)%gth_ppnl(i, atom_b) = force(jkind)%gth_ppnl(i, atom_b) + f0*fb(i) + force(kkind)%gth_ppnl(i, atom_c) = force(kkind)%gth_ppnl(i, atom_c) - f0*fb(i) !$OMP END CRITICAL(force_critical) END DO @@ -538,7 +538,7 @@ SUBROUTINE build_core_ppnl(matrix_h, matrix_p, force, virial, calculate_forces, END IF IF (calculate_forces .AND. use_virial) THEN - virial%pv_ppnl = virial%pv_virial-pv_loc + virial%pv_ppnl = virial%pv_virial - pv_loc END IF END IF !ppnl_present diff --git a/src/cp2k_debug.F b/src/cp2k_debug.F index 8f8e36e288..b163cf1933 100644 --- a/src/cp2k_debug.F +++ b/src/cp2k_debug.F @@ -197,10 +197,10 @@ SUBROUTINE cp2k_debug_energy_and_forces(force_env) WRITE (UNIT=iw, FMT="(/,(T2,A))") & "DEBUG| Difference pv_virial" WRITE (UNIT=iw, FMT="((T2,A,3F16.10))") & - ("DEBUG|", virial_numerical%pv_virial(i, 1:3)-virial_analytical%pv_virial(i, 1:3), i=1, 3) + ("DEBUG|", virial_numerical%pv_virial(i, 1:3) - virial_analytical%pv_virial(i, 1:3), i=1, 3) WRITE (UNIT=iw, FMT="(T2,A,T40,F16.10,/)") & "DEBUG| Sum of differences:", & - SUM(ABS(virial_numerical%pv_virial(:, :)-virial_analytical%pv_virial(:, :))) + SUM(ABS(virial_numerical%pv_virial(:, :) - virial_analytical%pv_virial(:, :))) END IF ! Check and abort on failure @@ -209,7 +209,7 @@ SUBROUTINE cp2k_debug_energy_and_forces(force_env) err(:) = 0.0_dp DO k = 1, 3 IF (ABS(virial_analytical%pv_virial(i, k)) >= eps_no_error_check) THEN - err(k) = 100.0_dp*(virial_numerical%pv_virial(i, k)-virial_analytical%pv_virial(i, k))/ & + err(k) = 100.0_dp*(virial_numerical%pv_virial(i, k) - virial_analytical%pv_virial(i, k))/ & virial_analytical%pv_virial(i, k) END IF END DO @@ -259,7 +259,7 @@ SUBROUTINE cp2k_debug_energy_and_forces(force_env) numer_energy = 0.0_dp std_value = particles(ip)%r(k) DO j = 1, 2 - particles(ip)%r(k) = std_value-(-1.0_dp)**j*dx + particles(ip)%r(k) = std_value - (-1.0_dp)**j*dx SELECT CASE (force_env%in_use) CASE (use_qs_force) CALL get_qs_env(force_env%qs_env, qs_kind_set=qs_kind_set) @@ -275,11 +275,11 @@ SUBROUTINE cp2k_debug_energy_and_forces(force_env) CALL force_env_get(force_env, potential_energy=numer_energy(j)) END DO particles(ip)%r(k) = std_value - numer_forces(ip, k) = -0.5_dp*(numer_energy(1)-numer_energy(2))/dx + numer_forces(ip, k) = -0.5_dp*(numer_energy(1) - numer_energy(2))/dx IF (iw > 0) THEN WRITE (UNIT=iw, FMT="(T2,A,T17,A,F7.4,A,T34,A,F7.4,A,T52,A,T68,A)") & - "DEBUG| Atom", "E("//ACHAR(119+k)//" +", dx, ")", & - "E("//ACHAR(119+k)//" -", dx, ")", & + "DEBUG| Atom", "E("//ACHAR(119 + k)//" +", dx, ")", & + "E("//ACHAR(119 + k)//" -", dx, ")", & "f(numerical)", "f(analytical)" WRITE (UNIT=iw, FMT="(T2,A,I5,4(1X,F16.8))") & "DEBUG|", ip, numer_energy(1:2), numer_forces(ip, k), analyt_forces(ip, k) @@ -291,7 +291,7 @@ SUBROUTINE cp2k_debug_energy_and_forces(force_env) DO k = 1, 3 ! Calculate percentage but ignore very small force values IF (ABS(analyt_forces(ip, k)) >= eps_no_error_check) THEN - err(k) = 100.0_dp*(numer_forces(ip, k)-analyt_forces(ip, k))/analyt_forces(ip, k) + err(k) = 100.0_dp*(numer_forces(ip, k) - analyt_forces(ip, k))/analyt_forces(ip, k) END IF ! Increase error tolerance for small force values IF (ABS(analyt_forces(ip, k)) <= 0.0001_dp) my_maxerr(k) = 5.0_dp*my_maxerr(k) @@ -300,13 +300,13 @@ SUBROUTINE cp2k_debug_energy_and_forces(force_env) WRITE (UNIT=iw, FMT="(/,T2,A)") & "DEBUG| Atom Coordinate f(numerical) f(analytical) Difference Error [%]" DO k = 1, 3 - difference = analyt_forces(ip, k)-numer_forces(ip, k) + difference = analyt_forces(ip, k) - numer_forces(ip, k) IF (ABS(analyt_forces(ip, k)) >= eps_no_error_check) THEN WRITE (UNIT=iw, FMT="(T2,A,I5,T19,A1,T26,F14.8,T42,F14.8,T57,F12.8,T71,F10.2)") & - "DEBUG|", ip, ACHAR(119+k), numer_forces(ip, k), analyt_forces(ip, k), difference, err(k) + "DEBUG|", ip, ACHAR(119 + k), numer_forces(ip, k), analyt_forces(ip, k), difference, err(k) ELSE WRITE (UNIT=iw, FMT="(T2,A,I5,T19,A1,T26,F14.8,T42,F14.8,T57,F12.8,T80,A1)") & - "DEBUG|", ip, ACHAR(119+k), numer_forces(ip, k), analyt_forces(ip, k), difference, "-" + "DEBUG|", ip, ACHAR(119 + k), numer_forces(ip, k), analyt_forces(ip, k), difference, "-" END IF END DO END IF @@ -330,16 +330,16 @@ SUBROUTINE cp2k_debug_energy_and_forces(force_env) DO ip = 1, np err(1:3) = 0.0_dp DO k = 1, 3 - difference = analyt_forces(ip, k)-numer_forces(ip, k) + difference = analyt_forces(ip, k) - numer_forces(ip, k) IF (ABS(analyt_forces(ip, k)) >= eps_no_error_check) THEN - err(k) = 100_dp*(numer_forces(ip, k)-analyt_forces(ip, k))/analyt_forces(ip, k) + err(k) = 100_dp*(numer_forces(ip, k) - analyt_forces(ip, k))/analyt_forces(ip, k) WRITE (UNIT=iw, FMT="(T2,A,I5,T19,A1,T26,F14.8,T42,F14.8,T57,F12.8,T71,F10.2)") & - "DEBUG|", ip, ACHAR(119+k), numer_forces(ip, k), analyt_forces(ip, k), difference, err(k) + "DEBUG|", ip, ACHAR(119 + k), numer_forces(ip, k), analyt_forces(ip, k), difference, err(k) ELSE WRITE (UNIT=iw, FMT="(T2,A,I5,T19,A1,T26,F14.8,T42,F14.8,T57,F12.8,T80,A1)") & - "DEBUG|", ip, ACHAR(119+k), numer_forces(ip, k), analyt_forces(ip, k), difference, "-" + "DEBUG|", ip, ACHAR(119 + k), numer_forces(ip, k), analyt_forces(ip, k), difference, "-" END IF - sum_of_differences = sum_of_differences+ABS(difference) + sum_of_differences = sum_of_differences + ABS(difference) END DO END DO WRITE (UNIT=iw, FMT="(T2,A,T57,F12.8)") & @@ -377,21 +377,21 @@ SUBROUTINE cp2k_debug_energy_and_forces(force_env) CALL force_env_calc_energy_force(force_env, calc_force=.FALSE.) CALL force_env_get(force_env, potential_energy=numer_energy(j)) END DO - dipole_numer(k) = 0.5_dp*(numer_energy(1)-numer_energy(2))/de + dipole_numer(k) = 0.5_dp*(numer_energy(1) - numer_energy(2))/de END DO IF (iw > 0) THEN WRITE (UNIT=iw, FMT="(/,(T2,A))") & "DEBUG|========================= DIPOLE MOMENTS ================================", & "DEBUG| Coordinate D(numerical) D(analytical) Difference Error [%]" DO k = 1, 3 - dd = dipole_moment(k)-dipole_numer(k) + dd = dipole_moment(k) - dipole_numer(k) IF (ABS(dipole_moment(k)) > eps_no_error_check) THEN derr = 100._dp*dd/dipole_moment(k) WRITE (UNIT=iw, FMT="(T13,A1,T21,F16.8,T38,F16.8,T56,G12.3,T72,F9.3)") & - ACHAR(119+k), dipole_numer(k), dipole_moment(k), dd, derr + ACHAR(119 + k), dipole_numer(k), dipole_moment(k), dd, derr ELSE WRITE (UNIT=iw, FMT="(T13,A1,T21,F16.8,T38,F16.8,T56,G12.3)") & - ACHAR(119+k), dipole_numer(k), dipole_moment(k), dd + ACHAR(119 + k), dipole_numer(k), dipole_moment(k), dd END IF END DO WRITE (UNIT=iw, FMT="((T2,A))") & @@ -434,7 +434,7 @@ SUBROUTINE cp2k_debug_energy_and_forces(force_env) CALL force_env_calc_energy_force(force_env, calc_force=.FALSE., linres=.TRUE.) CALL get_results(results, description=description, values=dipn(1:3, j)) END DO - polar_numeric(1:3, k) = 0.5_dp*(dipn(1:3, 2)-dipn(1:3, 1))/de + polar_numeric(1:3, k) = 0.5_dp*(dipn(1:3, 2) - dipn(1:3, 1))/de END DO IF (iw > 0) THEN WRITE (UNIT=iw, FMT="(/,(T2,A))") & @@ -442,14 +442,14 @@ SUBROUTINE cp2k_debug_energy_and_forces(force_env) "DEBUG| Coordinates P(numerical) P(analytical) Difference Error [%]" DO k = 1, 3 DO j = 1, 3 - dd = polar_analytic(k, j)-polar_numeric(k, j) + dd = polar_analytic(k, j) - polar_numeric(k, j) IF (ABS(polar_analytic(k, j)) > eps_no_error_check) THEN derr = 100._dp*dd/polar_analytic(k, j) WRITE (UNIT=iw, FMT="(T12,A1,A1,T21,F16.8,T38,F16.8,T56,G12.3,T72,F9.3)") & - ACHAR(119+k), ACHAR(119+j), polar_numeric(k, j), polar_analytic(k, j), dd, derr + ACHAR(119 + k), ACHAR(119 + j), polar_numeric(k, j), polar_analytic(k, j), dd, derr ELSE WRITE (UNIT=iw, FMT="(T12,A1,A1,T21,F16.8,T38,F16.8,T56,G12.3)") & - ACHAR(119+k), ACHAR(119+j), polar_numeric(k, j), polar_analytic(k, j), dd + ACHAR(119 + k), ACHAR(119 + j), polar_numeric(k, j), polar_analytic(k, j), dd END IF END DO END DO diff --git a/src/cp_control_types.F b/src/cp_control_types.F index ced3d973ac..b0cdb9d31a 100644 --- a/src/cp_control_types.F +++ b/src/cp_control_types.F @@ -582,7 +582,7 @@ SUBROUTINE mulliken_control_release(mulliken_restraint_control) CPASSERT(ASSOCIATED(mulliken_restraint_control)) CPASSERT(mulliken_restraint_control%ref_count > 0) - mulliken_restraint_control%ref_count = mulliken_restraint_control%ref_count-1 + mulliken_restraint_control%ref_count = mulliken_restraint_control%ref_count - 1 IF (mulliken_restraint_control%ref_count == 0) THEN IF (ASSOCIATED(mulliken_restraint_control%atoms)) & DEALLOCATE (mulliken_restraint_control%atoms) @@ -608,7 +608,7 @@ SUBROUTINE mulliken_control_retain(mulliken_restraint_control) CPASSERT(ASSOCIATED(mulliken_restraint_control)) - mulliken_restraint_control%ref_count = mulliken_restraint_control%ref_count+1 + mulliken_restraint_control%ref_count = mulliken_restraint_control%ref_count + 1 END SUBROUTINE mulliken_control_retain ! ************************************************************************************************** @@ -652,7 +652,7 @@ SUBROUTINE ddapc_control_release(ddapc_restraint_control) CPASSERT(ASSOCIATED(ddapc_restraint_control)) CPASSERT(ddapc_restraint_control%ref_count > 0) - ddapc_restraint_control%ref_count = ddapc_restraint_control%ref_count-1 + ddapc_restraint_control%ref_count = ddapc_restraint_control%ref_count - 1 IF (ddapc_restraint_control%ref_count == 0) THEN IF (ASSOCIATED(ddapc_restraint_control%atoms)) & DEALLOCATE (ddapc_restraint_control%atoms) @@ -680,7 +680,7 @@ SUBROUTINE ddapc_control_retain(ddapc_restraint_control) CPASSERT(ASSOCIATED(ddapc_restraint_control)) - ddapc_restraint_control%ref_count = ddapc_restraint_control%ref_count+1 + ddapc_restraint_control%ref_count = ddapc_restraint_control%ref_count + 1 END SUBROUTINE ddapc_control_retain ! ************************************************************************************************** @@ -719,7 +719,7 @@ SUBROUTINE s2_control_release(s2_restraint_control) CPASSERT(ASSOCIATED(s2_restraint_control)) CPASSERT(s2_restraint_control%ref_count > 0) - s2_restraint_control%ref_count = s2_restraint_control%ref_count-1 + s2_restraint_control%ref_count = s2_restraint_control%ref_count - 1 IF (s2_restraint_control%ref_count == 0) THEN s2_restraint_control%ref_count = 0 s2_restraint_control%strength = 0.0_dp @@ -741,7 +741,7 @@ SUBROUTINE s2_control_retain(s2_restraint_control) routineP = moduleN//':'//routineN CPASSERT(ASSOCIATED(s2_restraint_control)) - s2_restraint_control%ref_count = s2_restraint_control%ref_count+1 + s2_restraint_control%ref_count = s2_restraint_control%ref_count + 1 END SUBROUTINE s2_control_retain ! ************************************************************************************************** @@ -760,7 +760,7 @@ SUBROUTINE dft_control_create(dft_control) CPASSERT(.NOT. ASSOCIATED(dft_control)) ALLOCATE (dft_control) dft_control%ref_count = 1 - last_dft_control_id = last_dft_control_id+1 + last_dft_control_id = last_dft_control_id + 1 dft_control%id_nr = last_dft_control_id NULLIFY (dft_control%xas_control) NULLIFY (dft_control%xas_tdp_control) @@ -794,7 +794,7 @@ SUBROUTINE dft_control_retain(dft_control) CPASSERT(ASSOCIATED(dft_control)) CPASSERT(dft_control%ref_count > 0) - dft_control%ref_count = dft_control%ref_count+1 + dft_control%ref_count = dft_control%ref_count + 1 END SUBROUTINE dft_control_retain ! ************************************************************************************************** @@ -812,7 +812,7 @@ SUBROUTINE dft_control_release(dft_control) IF (ASSOCIATED(dft_control)) THEN CPASSERT(dft_control%ref_count > 0) - dft_control%ref_count = dft_control%ref_count-1 + dft_control%ref_count = dft_control%ref_count - 1 IF (dft_control%ref_count == 0) THEN CALL qs_control_release(dft_control%qs_control) CALL tddfpt_control_release(dft_control%tddfpt_control) @@ -1223,7 +1223,7 @@ SUBROUTINE sccs_control_release(sccs_control) IF (ASSOCIATED(sccs_control)) THEN CPASSERT(sccs_control%ref_count > 0) - sccs_control%ref_count = sccs_control%ref_count-1 + sccs_control%ref_count = sccs_control%ref_count - 1 IF (sccs_control%ref_count == 0) THEN DEALLOCATE (sccs_control) END IF diff --git a/src/cp_control_utils.F b/src/cp_control_utils.F index d44d9b8d31..0bbcce6e6d 100644 --- a/src/cp_control_utils.F +++ b/src/cp_control_utils.F @@ -181,7 +181,7 @@ SUBROUTINE read_dft_control(dft_control, dft_section) CALL section_vals_val_get(dft_section, "AUTO_BASIS", i_rep_val=irep, c_vals=tmpstringlist) IF (SIZE(tmpstringlist) == 2) THEN CALL uppercase(tmpstringlist(2)) - SELECT CASE (tmpstringlist (2)) + SELECT CASE (tmpstringlist(2)) CASE ("X") isize = -1 CASE ("SMALL") @@ -196,7 +196,7 @@ SUBROUTINE read_dft_control(dft_control, dft_section) CPWARN("Unknown basis size in AUTO_BASIS keyword:"//TRIM(tmpstringlist(1))) END SELECT ! - SELECT CASE (tmpstringlist (1)) + SELECT CASE (tmpstringlist(1)) CASE ("X") CASE ("RI_AUX") dft_control%auto_basis_ri_aux = isize @@ -564,14 +564,14 @@ SUBROUTINE read_mgrid_section(qs_control, dft_section) IF (qs_control%commensurate_mgrids) qs_control%progression_factor = 4.0_dp qs_control%e_cutoff(1) = qs_control%cutoff DO igrid_level = 2, ngrid_level - qs_control%e_cutoff(igrid_level) = qs_control%e_cutoff(igrid_level-1) & + qs_control%e_cutoff(igrid_level) = qs_control%e_cutoff(igrid_level - 1) & /qs_control%progression_factor END DO END IF ! check that multigrids are ordered DO igrid_level = 2, ngrid_level IF (qs_control%e_cutoff(igrid_level) > & - qs_control%e_cutoff(igrid_level-1)) THEN + qs_control%e_cutoff(igrid_level - 1)) THEN CPABORT("Multi-grids not ordered") END IF END DO @@ -829,7 +829,7 @@ SUBROUTINE read_qs_section(qs_control, qs_section) jj = 0 DO k = 1, n_rep CALL section_vals_val_get(mull_section, "ATOMS", i_rep_val=k, i_vals=tmplist) - jj = jj+SIZE(tmplist) + jj = jj + SIZE(tmplist) END DO qs_control%mulliken_restraint_control%natoms = jj IF (qs_control%mulliken_restraint_control%natoms < 1) & @@ -839,7 +839,7 @@ SUBROUTINE read_qs_section(qs_control, qs_section) DO k = 1, n_rep CALL section_vals_val_get(mull_section, "ATOMS", i_rep_val=k, i_vals=tmplist) DO j = 1, SIZE(tmplist) - jj = jj+1 + jj = jj + 1 qs_control%mulliken_restraint_control%atoms(jj) = tmplist(j) END DO END DO @@ -1814,7 +1814,7 @@ SUBROUTINE read_ddapc_section(qs_control, qs_section, ddapc_restraint_section) CALL section_vals_val_get(ddapc_section, "ATOMS", i_rep_section=i, & i_rep_val=k, i_vals=tmplist) DO j = 1, SIZE(tmplist) - jj = jj+1 + jj = jj + 1 END DO END DO IF (jj < 1) CPABORT("Need at least 1 atom to use ddapc contraints") @@ -1827,7 +1827,7 @@ SUBROUTINE read_ddapc_section(qs_control, qs_section, ddapc_restraint_section) CALL section_vals_val_get(ddapc_section, "ATOMS", i_rep_section=i, & i_rep_val=k, i_vals=tmplist) DO j = 1, SIZE(tmplist) - jj = jj+1 + jj = jj + 1 ddapc_restraint_control%atoms(jj) = tmplist(j) END DO END DO @@ -1844,7 +1844,7 @@ SUBROUTINE read_ddapc_section(qs_control, qs_section, ddapc_restraint_section) CALL section_vals_val_get(ddapc_section, "COEFF", i_rep_section=i, & i_rep_val=k, r_vals=rtmplist) DO j = 1, SIZE(rtmplist) - jj = jj+1 + jj = jj + 1 IF (jj > ddapc_restraint_control%natoms) & CPABORT("Need the same number of coeff as there are atoms ") ddapc_restraint_control%coeff(jj) = rtmplist(j) @@ -1856,7 +1856,7 @@ SUBROUTINE read_ddapc_section(qs_control, qs_section, ddapc_restraint_section) k = 0 DO i = 1, SIZE(qs_control%ddapc_restraint_control) IF (qs_control%ddapc_restraint_control(i)%ddapc_restraint_control%functional_form == & - do_ddapc_constraint) k = k+1 + do_ddapc_constraint) k = k + 1 END DO IF (k == 2) CALL cp_abort(__LOCATION__, & "Only a single constraint possible yet, try to use restraints instead ") @@ -1934,14 +1934,14 @@ SUBROUTINE read_efield_sections(dft_control, efield_section) DO WHILE (.TRUE.) READ (unit_nr, *, iostat=io) IF (io /= 0) EXIT - n = n+1 + n = n + 1 END DO REWIND (unit_nr) - ALLOCATE (efield%envelop_r_vars(n+1)) + ALLOCATE (efield%envelop_r_vars(n + 1)) !Store the timestep of the list in the first entry of the r_vars CALL section_vals_val_get(tmp_section, "TIMESTEP", r_val=efield%envelop_r_vars(1)) !Read the file - DO j = 2, n+1 + DO j = 2, n + 1 READ (unit_nr, *) efield%envelop_r_vars(j) efield%envelop_r_vars(j) = cp_unit_to_cp2k(efield%envelop_r_vars(j), "volt/m") END DO diff --git a/src/cp_dbcsr_cp2k_link.F b/src/cp_dbcsr_cp2k_link.F index 30efeaaac7..b2df35fd7f 100644 --- a/src/cp_dbcsr_cp2k_link.F +++ b/src/cp_dbcsr_cp2k_link.F @@ -490,29 +490,29 @@ SUBROUTINE cp_dbcsr_alloc_block_from_nbl(matrix, sab_orb, desymmetrize) new_atom_b = .FALSE. CYCLE END IF - IF (blk_cnt+nadd .GT. SIZE(rows)) THEN - ALLOCATE (tmp(blk_cnt+nadd)) + IF (blk_cnt + nadd .GT. SIZE(rows)) THEN + ALLOCATE (tmp(blk_cnt + nadd)) tmp(1:blk_cnt) = rows(1:blk_cnt) DEALLOCATE (rows) - ALLOCATE (rows((blk_cnt+nadd)*2)) + ALLOCATE (rows((blk_cnt + nadd)*2)) rows(1:blk_cnt) = tmp(1:blk_cnt) tmp(1:blk_cnt) = cols(1:blk_cnt) DEALLOCATE (cols) - ALLOCATE (cols((blk_cnt+nadd)*2)) + ALLOCATE (cols((blk_cnt + nadd)*2)) cols(1:blk_cnt) = tmp(1:blk_cnt) DEALLOCATE (tmp) ENDIF IF (alloc_full) THEN - blk_cnt = blk_cnt+1 + blk_cnt = blk_cnt + 1 rows(blk_cnt) = iatom cols(blk_cnt) = jatom IF (iatom /= jatom) THEN - blk_cnt = blk_cnt+1 + blk_cnt = blk_cnt + 1 rows(blk_cnt) = jatom cols(blk_cnt) = iatom END IF ELSE - blk_cnt = blk_cnt+1 + blk_cnt = blk_cnt + 1 IF (symmetry == dbcsr_type_no_symmetry) THEN rows(blk_cnt) = iatom cols(blk_cnt) = jatom @@ -664,7 +664,7 @@ SUBROUTINE cp_dbcsr_to_csr_screening(ks_env, csr_sparsity) CPASSERT(found) ! Distance between atoms a and b - dab = SQRT(rab(1)**2+rab(2)**2+rab(3)**2) + dab = SQRT(rab(1)**2 + rab(2)**2 + rab(3)**2) ! iterate over pairs of primitive GTOs i,j, get their radii r_i, r_j according ! to eps_pgf_orb. Define all matrix elements as non-zero to which a @@ -678,7 +678,7 @@ SUBROUTINE cp_dbcsr_to_csr_screening(ks_env, csr_sparsity) DO jshell = 1, nshell_b(jset) gto_loop: DO ipgf = 1, npgf_a(iset) DO jpgf = 1, npgf_b(jset) - IF (rpgfa(ipgf, iset)+rpgfb(jpgf, jset) .GE. dab) THEN + IF (rpgfa(ipgf, iset) + rpgfb(jpgf, jset) .GE. dab) THEN ! more selective screening with radius calculated for each primitive GTO r_a = exp_radius(l_a(ishell, iset), & zet_a(ipgf, iset), & @@ -688,23 +688,23 @@ SUBROUTINE cp_dbcsr_to_csr_screening(ks_env, csr_sparsity) zet_b(jpgf, jset), & eps_pgf_orb, & gcc_b(jpgf, jshell, jset)) - IF (r_a+r_b .GE. dab) THEN + IF (r_a + r_b .GE. dab) THEN IF (irow .EQ. iatom) THEN - screen_blk(isgf+1:isgf+nso(l_a(ishell, iset)), & - jsgf+1:jsgf+nso(l_b(jshell, jset))) = 1.0_dp + screen_blk(isgf + 1:isgf + nso(l_a(ishell, iset)), & + jsgf + 1:jsgf + nso(l_b(jshell, jset))) = 1.0_dp ELSE - screen_blk(jsgf+1:jsgf+nso(l_b(jshell, jset)), & - isgf+1:isgf+nso(l_a(ishell, iset))) = 1.0_dp + screen_blk(jsgf + 1:jsgf + nso(l_b(jshell, jset)), & + isgf + 1:isgf + nso(l_a(ishell, iset))) = 1.0_dp ENDIF EXIT gto_loop ENDIF ENDIF ENDDO ENDDO gto_loop - jsgf = jsgf+nso(l_b(jshell, jset)) + jsgf = jsgf + nso(l_b(jshell, jset)) ENDDO ENDDO - isgf = isgf+nso(l_a(ishell, iset)) + isgf = isgf + nso(l_a(ishell, iset)) ENDDO ENDDO ENDDO diff --git a/src/cp_dbcsr_output.F b/src/cp_dbcsr_output.F index 905595a217..489e82f1f2 100644 --- a/src/cp_dbcsr_output.F +++ b/src/cp_dbcsr_output.F @@ -193,7 +193,7 @@ SUBROUTINE cp_dbcsr_write_sparse_matrix(sparse_matrix, before, after, qs_env, pa CALL mp_sum(matrix, group) - SELECT CASE (dbcsr_get_matrix_type (sparse_matrix)) + SELECT CASE (dbcsr_get_matrix_type(sparse_matrix)) CASE (dbcsr_type_symmetric) CALL symmetrize_matrix(matrix, "upper_to_lower") print_sym = .TRUE. @@ -295,12 +295,12 @@ SUBROUTINE copy_repl_dbcsr_to_repl_fm(sparse_matrix, fm) r_offset(1) = 1 DO row = 2, nblkrows_total - r_offset(row) = r_offset(row-1)+row_blk_size(row-1) + r_offset(row) = r_offset(row - 1) + row_blk_size(row - 1) ENDDO nr = SUM(row_blk_size) c_offset(1) = 1 DO col = 2, nblkcols_total - c_offset(col) = c_offset(col-1)+col_blk_size(col-1) + c_offset(col) = c_offset(col - 1) + col_blk_size(col - 1) ENDDO nc = SUM(col_blk_size) !< @@ -314,7 +314,7 @@ SUBROUTINE copy_repl_dbcsr_to_repl_fm(sparse_matrix, fm) CALL dbcsr_iterator_next_block(iter, row, col, DATA, blk) DO j = 1, SIZE(DATA, 2) DO i = 1, SIZE(DATA, 1) - fm(r_offset(row)+i-1, c_offset(col)+j-1) = DATA(i, j) + fm(r_offset(row) + i - 1, c_offset(col) + j - 1) = DATA(i, j) ENDDO ENDDO ENDDO @@ -407,11 +407,11 @@ SUBROUTINE write_matrix_sym(matrix, matrix_name, before, after, qs_env, para_env ! *** Write the variable format strings *** ndigits = after - width = before+ndigits+3 + width = before + ndigits + 3 ncol = INT(56/width) - right = MAX((ndigits-2), 1) - left = width-right-5 + right = MAX((ndigits - 2), 1) + left = width - right - 5 WRITE (UNIT=fmtstr1(11:12), FMT="(I2)") ncol WRITE (UNIT=fmtstr1(14:15), FMT="(I2)") left @@ -419,18 +419,18 @@ SUBROUTINE write_matrix_sym(matrix, matrix_name, before, after, qs_env, para_env IF (omit_headers) THEN WRITE (UNIT=fmtstr2(6:7), FMT="(I2)") ncol - WRITE (UNIT=fmtstr2(13:14), FMT="(I2)") width-1 + WRITE (UNIT=fmtstr2(13:14), FMT="(I2)") width - 1 WRITE (UNIT=fmtstr2(16:17), FMT="(I2)") ndigits ELSE WRITE (UNIT=fmtstr2(22:23), FMT="(I2)") ncol - WRITE (UNIT=fmtstr2(29:30), FMT="(I2)") width-1 + WRITE (UNIT=fmtstr2(29:30), FMT="(I2)") width - 1 WRITE (UNIT=fmtstr2(32:33), FMT="(I2)") ndigits END IF ! *** Write the matrix in the selected format *** DO icol = first_col, last_col, ncol from = icol - to = MIN((from+ncol-1), last_col) + to = MIN((from + ncol - 1), last_col) IF (.NOT. omit_headers) THEN WRITE (UNIT=output_unit, FMT=fmtstr1) (jcol, jcol=from, to) ENDIF @@ -458,8 +458,8 @@ SUBROUTINE write_matrix_sym(matrix, matrix_name, before, after, qs_env, para_env (matrix(irow, jcol), jcol=from, to) END IF END IF - isgf = isgf+1 - irow = irow+1 + isgf = isgf + 1 + irow = irow + 1 END DO END DO END DO @@ -478,7 +478,7 @@ SUBROUTINE write_matrix_sym(matrix, matrix_name, before, after, qs_env, para_env (matrix(irow, jcol), jcol=from, to) END IF END IF - irow = irow+1 + irow = irow + 1 END DO IF ((irow >= first_row) .AND. (irow <= last_row)) THEN WRITE (UNIT=output_unit, FMT="(A)") @@ -550,11 +550,11 @@ SUBROUTINE write_matrix_gen(matrix, matrix_name, before, after, para_env, & ! *** Write the variable format strings *** ndigits = after - width = before+ndigits+3 + width = before + ndigits + 3 ncol = INT(56/width) - right = MAX((ndigits-2), 1) - left = width-right-5 + right = MAX((ndigits - 2), 1) + left = width - right - 5 WRITE (UNIT=fmtstr1(11:12), FMT="(I2)") ncol WRITE (UNIT=fmtstr1(14:15), FMT="(I2)") left @@ -562,18 +562,18 @@ SUBROUTINE write_matrix_gen(matrix, matrix_name, before, after, para_env, & IF (omit_headers) THEN WRITE (UNIT=fmtstr2(6:7), FMT="(I2)") ncol - WRITE (UNIT=fmtstr2(13:14), FMT="(I2)") width-1 + WRITE (UNIT=fmtstr2(13:14), FMT="(I2)") width - 1 WRITE (UNIT=fmtstr2(16:17), FMT="(I2)") ndigits ELSE WRITE (UNIT=fmtstr2(22:23), FMT="(I2)") ncol - WRITE (UNIT=fmtstr2(29:30), FMT="(I2)") width-1 + WRITE (UNIT=fmtstr2(29:30), FMT="(I2)") width - 1 WRITE (UNIT=fmtstr2(32:33), FMT="(I2)") ndigits ENDIF ! *** Write the matrix in the selected format *** DO icol = first_col, last_col, ncol from = icol - to = MIN((from+ncol-1), last_col) + to = MIN((from + ncol - 1), last_col) IF (.NOT. omit_headers) THEN WRITE (UNIT=output_unit, FMT=fmtstr1) (jcol, jcol=from, to) END IF @@ -632,7 +632,7 @@ SUBROUTINE cp_dbcsr_write_matrix_dist(matrix, output_unit, para_env) group = para_env%group ionode = para_env%ionode - mype = para_env%mepos+1 + mype = para_env%mepos + 1 npe = para_env%num_pe ! *** Allocate work storage *** @@ -672,7 +672,7 @@ SUBROUTINE cp_dbcsr_write_matrix_dist(matrix, output_unit, para_env) IF (matrix_type == dbcsr_type_symmetric .OR. & matrix_type == dbcsr_type_antisymmetric) THEN - nblock_tot = INT(natom, KIND=int_8)*INT(natom+1, KIND=int_8)/2 + nblock_tot = INT(natom, KIND=int_8)*INT(natom + 1, KIND=int_8)/2 ELSE nblock_tot = INT(natom, KIND=int_8)**2 END IF @@ -686,7 +686,7 @@ SUBROUTINE cp_dbcsr_write_matrix_dist(matrix, output_unit, para_env) IF (full_output) THEN WRITE (UNIT=output_unit, FMT="(/,T3,A,/,/,(I9,T27,I10,T55,I10))") & "Process Number of matrix blocks Number of matrix elements", & - (ipe-1, nblock(ipe), nelement(ipe), ipe=1, npe) + (ipe - 1, nblock(ipe), nelement(ipe), ipe=1, npe) WRITE (UNIT=output_unit, FMT="(/,T7,A3,T27,I10,T55,I10)") & "Sum", nblock_sum, nelement_sum WRITE (UNIT=output_unit, FMT="(/,T7,A3,T27,I10,A,F5.1,A,T55,I10,A,F5.1,A)") & @@ -695,10 +695,10 @@ SUBROUTINE cp_dbcsr_write_matrix_dist(matrix, output_unit, para_env) WRITE (UNIT=output_unit, FMT="(T15,A,T68,I13)") "Number of non-zero blocks:", nblock_sum WRITE (UNIT=output_unit, FMT="(T15,A,T75,F6.2)") "Percentage non-zero blocks:", occupation WRITE (UNIT=output_unit, FMT="(T15,A,T68,I13)") "Average number of blocks per CPU:", & - (nblock_sum+npe-1)/npe + (nblock_sum + npe - 1)/npe WRITE (UNIT=output_unit, FMT="(T15,A,T68,I13)") "Maximum number of blocks per CPU:", nblock_max WRITE (UNIT=output_unit, FMT="(T15,A,T68,I13)") "Average number of matrix elements per CPU:", & - (nelement_sum+npe-1)/npe + (nelement_sum + npe - 1)/npe WRITE (UNIT=output_unit, FMT="(T15,A,T68,I13)") "Maximum number of matrix elements per CPU:", & nelement_max ENDIF diff --git a/src/cp_ddapc_forces.F b/src/cp_ddapc_forces.F index b963f14c85..35fe27508f 100644 --- a/src/cp_ddapc_forces.F +++ b/src/cp_ddapc_forces.F @@ -119,9 +119,9 @@ RECURSIVE SUBROUTINE ewald_ddapc_force(qs_env, coeff, apply_qmmm_periodic, & alpha = SQRT(ABS(LOG(eps*rcut*tol)))/rcut galpha = 1.0_dp/(4.0_dp*alpha*alpha) tol1 = SQRT(-LOG(eps*rcut*(2.0_dp*tol*alpha)**2)) - nmax1 = NINT(0.25_dp+cell%hmat(1, 1)*alpha*tol1/pi) - nmax2 = NINT(0.25_dp+cell%hmat(2, 2)*alpha*tol1/pi) - nmax3 = NINT(0.25_dp+cell%hmat(3, 3)*alpha*tol1/pi) + nmax1 = NINT(0.25_dp + cell%hmat(1, 1)*alpha*tol1/pi) + nmax2 = NINT(0.25_dp + cell%hmat(2, 2)*alpha*tol1/pi) + nmax3 = NINT(0.25_dp + cell%hmat(3, 3)*alpha*tol1/pi) rmax1 = CEILING(rcut/cell%hmat(1, 1)) rmax2 = CEILING(rcut/cell%hmat(2, 2)) @@ -136,18 +136,18 @@ RECURSIVE SUBROUTINE ewald_ddapc_force(qs_env, coeff, apply_qmmm_periodic, & DO iparticle1 = 1, SIZE(particle_set) !NB parallelization IF (MOD(iparticle1, para_env%num_pe) /= para_env%mepos) CYCLE - ip1 = (iparticle1-1)*SIZE(radii) - q1t = SUM(charges(ip1+1:ip1+SIZE(radii))) + ip1 = (iparticle1 - 1)*SIZE(radii) + q1t = SUM(charges(ip1 + 1:ip1 + SIZE(radii))) DO iparticle2 = 1, iparticle1 ij_fac = 1.0_dp IF (iparticle1 == iparticle2) ij_fac = 0.5_dp - ip2 = (iparticle2-1)*SIZE(radii) - q2t = SUM(charges(ip2+1:ip2+SIZE(radii))) + ip2 = (iparticle2 - 1)*SIZE(radii) + q2t = SUM(charges(ip2 + 1:ip2 + SIZE(radii))) ! ! Real-Space Contribution ! - rvec = particle_set(iparticle1)%r-particle_set(iparticle2)%r + rvec = particle_set(iparticle1)%r - particle_set(iparticle2)%r IF (iparticle1 /= iparticle2) THEN ra = rvec r2tmp = DOT_PRODUCT(ra, ra) @@ -155,30 +155,30 @@ RECURSIVE SUBROUTINE ewald_ddapc_force(qs_env, coeff, apply_qmmm_periodic, & r = SQRT(r2tmp) t1 = erfc(alpha*r)/r drvec = ra/r*q1t*q2t*factor - t2 = -2.0_dp*alpha*EXP(-alpha*alpha*r*r)/(r*rootpi)-t1/r - d_el(1:3, iparticle1) = d_el(1:3, iparticle1)-t2*drvec - d_el(1:3, iparticle2) = d_el(1:3, iparticle2)+t2*drvec + t2 = -2.0_dp*alpha*EXP(-alpha*alpha*r*r)/(r*rootpi) - t1/r + d_el(1:3, iparticle1) = d_el(1:3, iparticle1) - t2*drvec + d_el(1:3, iparticle2) = d_el(1:3, iparticle2) + t2*drvec END IF END IF DO r1 = -rmax1, rmax1 DO r2 = -rmax2, rmax2 DO r3 = -rmax3, rmax3 IF ((r1 == 0) .AND. (r2 == 0) .AND. (r3 == 0)) CYCLE - ra(1) = rvec(1)+cell%hmat(1, 1)*r1 - ra(2) = rvec(2)+cell%hmat(2, 2)*r2 - ra(3) = rvec(3)+cell%hmat(3, 3)*r3 + ra(1) = rvec(1) + cell%hmat(1, 1)*r1 + ra(2) = rvec(2) + cell%hmat(2, 2)*r2 + ra(3) = rvec(3) + cell%hmat(3, 3)*r3 r2tmp = DOT_PRODUCT(ra, ra) IF (r2tmp <= rcut2) THEN r = SQRT(r2tmp) t1 = erfc(alpha*r)/r drvec = ra/r*q1t*q2t*factor*ij_fac - t2 = -2.0_dp*alpha*EXP(-alpha*alpha*r*r)/(r*rootpi)-t1/r - d_el(1, iparticle1) = d_el(1, iparticle1)-t2*drvec(1) - d_el(2, iparticle1) = d_el(2, iparticle1)-t2*drvec(2) - d_el(3, iparticle1) = d_el(3, iparticle1)-t2*drvec(3) - d_el(1, iparticle2) = d_el(1, iparticle2)+t2*drvec(1) - d_el(2, iparticle2) = d_el(2, iparticle2)+t2*drvec(2) - d_el(3, iparticle2) = d_el(3, iparticle2)+t2*drvec(3) + t2 = -2.0_dp*alpha*EXP(-alpha*alpha*r*r)/(r*rootpi) - t1/r + d_el(1, iparticle1) = d_el(1, iparticle1) - t2*drvec(1) + d_el(2, iparticle1) = d_el(2, iparticle1) - t2*drvec(2) + d_el(3, iparticle1) = d_el(3, iparticle1) - t2*drvec(3) + d_el(1, iparticle2) = d_el(1, iparticle2) + t2*drvec(1) + d_el(2, iparticle2) = d_el(2, iparticle2) + t2*drvec(2) + d_el(3, iparticle2) = d_el(3, iparticle2) + t2*drvec(3) END IF END DO END DO @@ -197,23 +197,23 @@ RECURSIVE SUBROUTINE ewald_ddapc_force(qs_env, coeff, apply_qmmm_periodic, & gsqi = fs/gsq t1 = fac*gsqi*EXP(-galpha*gsq) t2 = -SIN(DOT_PRODUCT(gvec, rvec))*t1*q1t*q2t*factor*fourpi - d_el(1:3, iparticle1) = d_el(1:3, iparticle1)-t2*gvec - d_el(1:3, iparticle2) = d_el(1:3, iparticle2)+t2*gvec + d_el(1:3, iparticle1) = d_el(1:3, iparticle1) - t2*gvec + d_el(1:3, iparticle2) = d_el(1:3, iparticle2) + t2*gvec END DO END DO END DO ELSE gvec = Eval_d_Interp_Spl3_pbc(rvec, coeff)*q1t*q2t*factor*fourpi - d_el(1:3, iparticle1) = d_el(1:3, iparticle1)-gvec - d_el(1:3, iparticle2) = d_el(1:3, iparticle2)+gvec + d_el(1:3, iparticle1) = d_el(1:3, iparticle1) - gvec + d_el(1:3, iparticle2) = d_el(1:3, iparticle2) + gvec END IF IF (iparticle1 /= iparticle2) THEN ra = rvec r = SQRT(DOT_PRODUCT(ra, ra)) t2 = -1.0_dp/(r*r)*factor drvec = ra/r*q1t*q2t - d_el(1:3, iparticle1) = d_el(1:3, iparticle1)+t2*drvec - d_el(1:3, iparticle2) = d_el(1:3, iparticle2)-t2*drvec + d_el(1:3, iparticle1) = d_el(1:3, iparticle1) + t2*drvec + d_el(1:3, iparticle2) = d_el(1:3, iparticle2) - t2*drvec END IF END DO ! iparticle2 END DO ! iparticle1 @@ -283,7 +283,7 @@ SUBROUTINE cp_decpl_ddapc_forces(qs_env, M, charges, dq, d_el, particle_set) DO iatom = 1, natom ikind = kind_of(iatom) i = atom_of_kind(iatom) - force(ikind)%ch_pulay(1:3, i) = force(ikind)%ch_pulay(1:3, i)+chf(1:3, iatom)+d_el(1:3, iatom) + force(ikind)%ch_pulay(1:3, i) = force(ikind)%ch_pulay(1:3, i) + chf(1:3, iatom) + d_el(1:3, iatom) END DO DEALLOCATE (atom_of_kind) DEALLOCATE (kind_of) @@ -348,29 +348,29 @@ SUBROUTINE evaluate_restraint_functional(ddapc_restraint_control, n_gauss, uv, & order_p = 0.0_dp DO I = 1, ddapc_restraint_control%natoms - ind = (ddapc_restraint_control%atoms(I)-1)*n_gauss - order_p = order_p+ddapc_restraint_control%coeff(I)*SUM(charges(ind+1:ind+n_gauss)) + ind = (ddapc_restraint_control%atoms(I) - 1)*n_gauss + order_p = order_p + ddapc_restraint_control%coeff(I)*SUM(charges(ind + 1:ind + n_gauss)) ENDDO ddapc_restraint_control%ddapc_order_p = order_p SELECT CASE (ddapc_restraint_control%functional_form) CASE (do_ddapc_restraint) ! the restraint energy - energy_res = ddapc_restraint_control%strength*(order_p-ddapc_restraint_control%target)**2.0_dp + energy_res = ddapc_restraint_control%strength*(order_p - ddapc_restraint_control%target)**2.0_dp ! derivative of the energy - dE = 2.0_dp*ddapc_restraint_control%strength*(order_p-ddapc_restraint_control%target) + dE = 2.0_dp*ddapc_restraint_control%strength*(order_p - ddapc_restraint_control%target) DO I = 1, ddapc_restraint_control%natoms - ind = (ddapc_restraint_control%atoms(I)-1)*n_gauss - uv(ind+1:ind+n_gauss) = dE*ddapc_restraint_control%coeff(I) + ind = (ddapc_restraint_control%atoms(I) - 1)*n_gauss + uv(ind + 1:ind + n_gauss) = dE*ddapc_restraint_control%coeff(I) ENDDO CASE (do_ddapc_constraint) - energy_res = ddapc_restraint_control%strength*(order_p-ddapc_restraint_control%target) + energy_res = ddapc_restraint_control%strength*(order_p - ddapc_restraint_control%target) ! derivative of the energy DO I = 1, ddapc_restraint_control%natoms - ind = (ddapc_restraint_control%atoms(I)-1)*n_gauss - uv(ind+1:ind+n_gauss) = ddapc_restraint_control%strength*ddapc_restraint_control%coeff(I) + ind = (ddapc_restraint_control%atoms(I) - 1)*n_gauss + uv(ind + 1:ind + n_gauss) = ddapc_restraint_control%strength*ddapc_restraint_control%coeff(I) ENDDO CASE DEFAULT @@ -443,7 +443,7 @@ SUBROUTINE restraint_functional_force(qs_env, ddapc_restraint_control, dq, charg DO iatom = 1, natom ikind = kind_of(iatom) i = atom_of_kind(iatom) - force(ikind)%ch_pulay(1:3, i) = force(ikind)%ch_pulay(1:3, i)+chf(1:3, iatom) + force(ikind)%ch_pulay(1:3, i) = force(ikind)%ch_pulay(1:3, i) + chf(1:3, iatom) END DO DEALLOCATE (atom_of_kind) DEALLOCATE (kind_of) @@ -510,15 +510,15 @@ SUBROUTINE solvation_ddapc_force(qs_env, solvation_section, particle_set, & CASE (weight_type_unit) R0 = 0.0_dp DO i = 1, SIZE(list) - R0 = R0+particle_set(list(i))%r + R0 = R0 + particle_set(list(i))%r END DO R0 = R0/REAL(SIZE(list), KIND=dp) CASE (weight_type_mass) R0 = 0.0_dp mass = 0.0_dp DO i = 1, SIZE(list) - R0 = R0+particle_set(list(i))%r*particle_set(list(i))%atomic_kind%mass - mass = mass+particle_set(list(i))%atomic_kind%mass + R0 = R0 + particle_set(list(i))%r*particle_set(list(i))%atomic_kind%mass + mass = mass + particle_set(list(i))%atomic_kind%mass END DO R0 = R0/mass END SELECT @@ -534,28 +534,28 @@ SUBROUTINE solvation_ddapc_force(qs_env, solvation_section, particle_set, & d_el = 0.0_dp ! Determining the single atomic contribution to the dielectric dipole DO i = 1, SIZE(particle_set) - rvec = particle_set(i)%r-center + rvec = particle_set(i)%r - center r2s = DOT_PRODUCT(rvec, rvec) r1s = SQRT(r2s) LocP(:, i) = 0.0_dp IF (r1s /= 0.0_dp) THEN DO l = 0, lmax - LocP(l, i) = (r1s**l*REAL(l+1, KIND=dp)*(eps_in-eps_out))/ & - (Rs**(2*l+1)*eps_in*(REAL(l, KIND=dp)*eps_in+REAL(l+1, KIND=dp)*eps_out)) + LocP(l, i) = (r1s**l*REAL(l + 1, KIND=dp)*(eps_in - eps_out))/ & + (Rs**(2*l + 1)*eps_in*(REAL(l, KIND=dp)*eps_in + REAL(l + 1, KIND=dp)*eps_out)) END DO END IF pos(i) = r1s END DO ! Computes the full derivatives of the interaction energy DO iparticle1 = 1, SIZE(particle_set) - ip1 = (iparticle1-1)*SIZE(radii) - q1t = SUM(charges(ip1+1:ip1+SIZE(radii))) + ip1 = (iparticle1 - 1)*SIZE(radii) + q1t = SUM(charges(ip1 + 1:ip1 + SIZE(radii))) DO iparticle2 = 1, iparticle1 - ip2 = (iparticle2-1)*SIZE(radii) - q2t = SUM(charges(ip2+1:ip2+SIZE(radii))) + ip2 = (iparticle2 - 1)*SIZE(radii) + q2t = SUM(charges(ip2 + 1:ip2 + SIZE(radii))) ! - r1 = particle_set(iparticle1)%r-center - r2 = particle_set(iparticle2)%r-center + r1 = particle_set(iparticle1)%r - center + r2 = particle_set(iparticle2)%r - center pos1 = pos(iparticle1) pos2 = pos(iparticle2) factor1 = 0.0_dp @@ -568,21 +568,21 @@ SUBROUTINE solvation_ddapc_force(qs_env, solvation_section, particle_set, & ptcos = DOT_PRODUCT(r1, r2) mycos = ptcos/(pos1*pos2) IF (ABS(mycos) > 1.0_dp) mycos = SIGN(1.0_dp, mycos) - dcos1 = (r2*(pos1*pos2)-pos2*dpos1*ptcos)/(pos1*pos2)**2 - dcos2 = (r1*(pos1*pos2)-pos1*dpos2*ptcos)/(pos1*pos2)**2 + dcos1 = (r2*(pos1*pos2) - pos2*dpos1*ptcos)/(pos1*pos2)**2 + dcos2 = (r1*(pos1*pos2) - pos1*dpos2*ptcos)/(pos1*pos2)**2 DO l = 1, lmax lr = REAL(l, KIND=dp) - factor1 = factor1+lr*LocP(l, iparticle2)*pos1**(l-1)*legendre(mycos, l, 0)*dpos1 & - +LocP(l, iparticle2)*pos1**l*dlegendre(mycos, l, 0)*dcos1 - factor2 = factor2+lr*LocP(l, iparticle1)*pos2**(l-1)*legendre(mycos, l, 0)*dpos2 & - +LocP(l, iparticle1)*pos2**l*dlegendre(mycos, l, 0)*dcos2 + factor1 = factor1 + lr*LocP(l, iparticle2)*pos1**(l - 1)*legendre(mycos, l, 0)*dpos1 & + + LocP(l, iparticle2)*pos1**l*dlegendre(mycos, l, 0)*dcos1 + factor2 = factor2 + lr*LocP(l, iparticle1)*pos2**(l - 1)*legendre(mycos, l, 0)*dpos2 & + + LocP(l, iparticle1)*pos2**l*dlegendre(mycos, l, 0)*dcos2 END DO END IF factor1 = factor1*q1t*q2t factor2 = factor2*q1t*q2t - d_el(1:3, iparticle1) = d_el(1:3, iparticle1)+0.5_dp*factor1 - d_el(1:3, iparticle2) = d_el(1:3, iparticle2)+0.5_dp*factor2 + d_el(1:3, iparticle1) = d_el(1:3, iparticle1) + 0.5_dp*factor1 + d_el(1:3, iparticle2) = d_el(1:3, iparticle2) + 0.5_dp*factor2 END DO END DO DEALLOCATE (pos) diff --git a/src/cp_ddapc_methods.F b/src/cp_ddapc_methods.F index 67d3f643f1..63ab7b679b 100644 --- a/src/cp_ddapc_methods.F +++ b/src/cp_ddapc_methods.F @@ -91,7 +91,7 @@ SUBROUTINE ddapc_eval_gfunc(gfunc, w, gcut, rho_tot_g, radii) DO ig = s_dim, e_dim g2 = rho_tot_g%pw_grid%gsq(ig) IF (g2 > gcut2) EXIT - w(ig) = fourpi*(g2-gcut2)**2/(g2*gcut2) + w(ig) = fourpi*(g2 - gcut2)**2/(g2*gcut2) END DO CALL timestop(handle) END SUBROUTINE ddapc_eval_gfunc @@ -151,7 +151,7 @@ SUBROUTINE build_b_vector(bv, gfunc, w, particle_set, radii, rho_tot_g, gcut) my_bv(ig) = w(ig)*REAL(CONJG(rho_tot_g%cc(ig))*phase, KIND=dp) END DO DO igauss = 1, SIZE(radii) - idim = (iparticle-1)*SIZE(radii)+igauss + idim = (iparticle - 1)*SIZE(radii) + igauss DO ig = s_dim, igmax my_bvw(ig) = my_bv(ig)*gfunc(ig, igauss) END DO @@ -163,7 +163,7 @@ SUBROUTINE build_b_vector(bv, gfunc, w, particle_set, radii, rho_tot_g, gcut) ELSE DO iparticle = 1, SIZE(particle_set) DO igauss = 1, SIZE(radii) - idim = (iparticle-1)*SIZE(radii)+igauss + idim = (iparticle - 1)*SIZE(radii) + igauss bv(idim) = 0.0_dp END DO END DO @@ -233,15 +233,15 @@ SUBROUTINE build_A_matrix(Am, gfunc, w, particle_set, radii, rho_tot_g, gcut, g_ DO iparticle2 = iparticle1, SIZE(particle_set) DO ig = s_dim, igmax !NB replace explicit dot product and cosine with cos(A+B) formula - much faster - my_Am(ig) = (g_dot_rvec_cos(ig-s_dim+1, iparticle1)*g_dot_rvec_cos(ig-s_dim+1, iparticle2)+ & - g_dot_rvec_sin(ig-s_dim+1, iparticle1)*g_dot_rvec_sin(ig-s_dim+1, iparticle2)) + my_Am(ig) = (g_dot_rvec_cos(ig - s_dim + 1, iparticle1)*g_dot_rvec_cos(ig - s_dim + 1, iparticle2) + & + g_dot_rvec_sin(ig - s_dim + 1, iparticle1)*g_dot_rvec_sin(ig - s_dim + 1, iparticle2)) END DO DO igauss1 = 1, SIZE(radii) - idim1 = (iparticle1-1)*SIZE(radii)+igauss1 + idim1 = (iparticle1 - 1)*SIZE(radii) + igauss1 istart_g = 1 IF (iparticle2 == iparticle1) istart_g = igauss1 DO igauss2 = istart_g, SIZE(radii) - idim2 = (iparticle2-1)*SIZE(radii)+igauss2 + idim2 = (iparticle2 - 1)*SIZE(radii) + igauss2 my_Amw(s_dim:igmax) = my_Am(s_dim:igmax)*gfunc_sq(s_dim:igmax, igauss1, igauss2) !NB no loss of accuracy in my test cases !tmp = accurate_sum(my_Amw) @@ -317,7 +317,7 @@ SUBROUTINE build_der_b_vector(dbv, gfunc, w, particle_set, radii, rho_tot_g, gcu my_dbv(:, ig) = w(ig)*REAL(CONJG(rho_tot_g%cc(ig))*dphase, KIND=dp)*gvec(:) END DO DO igauss = 1, SIZE(radii) - idim = (iparticle-1)*SIZE(radii)+igauss + idim = (iparticle - 1)*SIZE(radii) + igauss DO ig = s_dim, igmax my_dbvw(ig) = my_dbv(1, ig)*gfunc(ig, igauss) END DO @@ -338,7 +338,7 @@ SUBROUTINE build_der_b_vector(dbv, gfunc, w, particle_set, radii, rho_tot_g, gcu DO iparticle = 1, SIZE(particle_set) IF (iparticle /= iparticle0) CYCLE DO igauss = 1, SIZE(radii) - idim = (iparticle-1)*SIZE(radii)+igauss + idim = (iparticle - 1)*SIZE(radii) + igauss dbv(idim, 1:3) = 0.0_dp END DO END DO @@ -404,7 +404,7 @@ SUBROUTINE build_der_A_matrix_rows(dAm, gfunc, w, particle_set, radii, & Nr = SIZE(radii) Np = SIZE(particle_set) - Ng = igmax-s_dim+1 + Ng = igmax - s_dim + 1 IF (igmax .GE. s_dim) THEN ALLOCATE (lhs(nparticles*Nr, Ng)) ALLOCATE (rhs(Ng, Np*Nr)) @@ -413,26 +413,26 @@ SUBROUTINE build_der_A_matrix_rows(dAm, gfunc, w, particle_set, radii, & ! rhs has all parts that depend on iparticle2 DO iparticle2 = 1, Np DO igauss2 = 1, Nr - rhs(1:Ng, (iparticle2-1)*Nr+igauss2) = g_dot_rvec_sin(1:Ng, iparticle2)*gfunc(s_dim:igmax, igauss2) + rhs(1:Ng, (iparticle2 - 1)*Nr + igauss2) = g_dot_rvec_sin(1:Ng, iparticle2)*gfunc(s_dim:igmax, igauss2) END DO END DO DO icomp = 1, 3 ! create lhs, which has all parts that depend on iparticle1 DO ipp = 1, nparticles - iparticle1 = iparticle0+ipp-1 + iparticle1 = iparticle0 + ipp - 1 DO ig = s_dim, igmax - lhs((ipp-1)*Nr+1:(ipp-1)*Nr+Nr, ig-s_dim+1) = w(ig)*rho_tot_g%pw_grid%g(icomp, ig)* & - gfunc(ig, 1:Nr)*g_dot_rvec_cos(ig-s_dim+1, iparticle1) + lhs((ipp - 1)*Nr + 1:(ipp - 1)*Nr + Nr, ig - s_dim + 1) = w(ig)*rho_tot_g%pw_grid%g(icomp, ig)* & + gfunc(ig, 1:Nr)*g_dot_rvec_cos(ig - s_dim + 1, iparticle1) END DO END DO ! ipp ! do main multiply CALL DGEMM('N', 'N', nparticles*Nr, Np*Nr, Ng, 1.0D0, lhs(1, 1), nparticles*Nr, rhs(1, 1), & - Ng, 0.0D0, dAm((iparticle0-1)*Nr+1, 1, icomp), Np*Nr) + Ng, 0.0D0, dAm((iparticle0 - 1)*Nr + 1, 1, icomp), Np*Nr) ! do extra multiplies to compensate for missing factor of 2 DO ipp = 1, nparticles - iparticle1 = iparticle0+ipp-1 - CALL DGEMM('N', 'N', Nr, Nr, Ng, 1.0D0, lhs((ipp-1)*Nr+1, 1), nparticles*Nr, rhs(1, (iparticle1-1)*Nr+1), & - Ng, 1.0D0, dAm((iparticle1-1)*Nr+1, (iparticle1-1)*Nr+1, icomp), Np*Nr) + iparticle1 = iparticle0 + ipp - 1 + CALL DGEMM('N', 'N', Nr, Nr, Ng, 1.0D0, lhs((ipp - 1)*Nr + 1, 1), nparticles*Nr, rhs(1, (iparticle1 - 1)*Nr + 1), & + Ng, 1.0D0, dAm((iparticle1 - 1)*Nr + 1, (iparticle1 - 1)*Nr + 1, icomp), Np*Nr) END DO ! now extra columns to account for factor of 2 in some rhs columns END DO ! icomp @@ -441,26 +441,26 @@ SUBROUTINE build_der_A_matrix_rows(dAm, gfunc, w, particle_set, radii, & ! rhs has all parts that depend on iparticle2 DO iparticle2 = 1, Np DO igauss2 = 1, Nr - rhs(1:Ng, (iparticle2-1)*Nr+igauss2) = -g_dot_rvec_cos(1:Ng, iparticle2)*gfunc(s_dim:igmax, igauss2) + rhs(1:Ng, (iparticle2 - 1)*Nr + igauss2) = -g_dot_rvec_cos(1:Ng, iparticle2)*gfunc(s_dim:igmax, igauss2) END DO END DO DO icomp = 1, 3 ! create lhs, which has all parts that depend on iparticle1 DO ipp = 1, nparticles - iparticle1 = iparticle0+ipp-1 + iparticle1 = iparticle0 + ipp - 1 DO ig = s_dim, igmax - lhs((ipp-1)*Nr+1:(ipp-1)*Nr+Nr, ig-s_dim+1) = w(ig)*rho_tot_g%pw_grid%g(icomp, ig)*gfunc(ig, 1:Nr)* & - g_dot_rvec_sin(ig-s_dim+1, iparticle1) + lhs((ipp - 1)*Nr + 1:(ipp - 1)*Nr + Nr, ig - s_dim + 1) = w(ig)*rho_tot_g%pw_grid%g(icomp, ig)*gfunc(ig, 1:Nr)* & + g_dot_rvec_sin(ig - s_dim + 1, iparticle1) END DO ENDDO ! do main multiply CALL DGEMM('N', 'N', nparticles*Nr, Np*Nr, Ng, 1.0D0, lhs(1, 1), nparticles*Nr, rhs(1, 1), & - Ng, 1.0D0, dAm((iparticle0-1)*Nr+1, 1, icomp), Np*Nr) + Ng, 1.0D0, dAm((iparticle0 - 1)*Nr + 1, 1, icomp), Np*Nr) ! do extra multiples to compensate for missing factor of 2 DO ipp = 1, nparticles - iparticle1 = iparticle0+ipp-1 - CALL DGEMM('N', 'N', Nr, Nr, Ng, 1.0D0, lhs((ipp-1)*Nr+1, 1), nparticles*Nr, rhs(1, (iparticle1-1)*Nr+1), & - Ng, 1.0D0, dAm((iparticle1-1)*Nr+1, (iparticle1-1)*Nr+1, icomp), Np*Nr) + iparticle1 = iparticle0 + ipp - 1 + CALL DGEMM('N', 'N', Nr, Nr, Ng, 1.0D0, lhs((ipp - 1)*Nr + 1, 1), nparticles*Nr, rhs(1, (iparticle1 - 1)*Nr + 1), & + Ng, 1.0D0, dAm((iparticle1 - 1)*Nr + 1, (iparticle1 - 1)*Nr + 1, icomp), Np*Nr) END DO END DO @@ -516,15 +516,15 @@ SUBROUTINE prep_g_dot_rvec_sin_cos(rho_tot_g, particle_set, gcut, g_dot_rvec_sin ENDDO IF (igmax .GE. s_dim) THEN - ALLOCATE (g_dot_rvec_sin(1:igmax-s_dim+1, SIZE(particle_set))) - ALLOCATE (g_dot_rvec_cos(1:igmax-s_dim+1, SIZE(particle_set))) + ALLOCATE (g_dot_rvec_sin(1:igmax - s_dim + 1, SIZE(particle_set))) + ALLOCATE (g_dot_rvec_cos(1:igmax - s_dim + 1, SIZE(particle_set))) DO iparticle = 1, SIZE(particle_set) rvec = particle_set(iparticle)%r DO ig = s_dim, igmax g_dot_rvec = DOT_PRODUCT(rho_tot_g%pw_grid%g(:, ig), rvec) - g_dot_rvec_sin(ig-s_dim+1, iparticle) = SIN(g_dot_rvec) - g_dot_rvec_cos(ig-s_dim+1, iparticle) = COS(g_dot_rvec) + g_dot_rvec_sin(ig - s_dim + 1, iparticle) = SIN(g_dot_rvec) + g_dot_rvec_cos(ig - s_dim + 1, iparticle) = COS(g_dot_rvec) END DO END DO END IF @@ -672,9 +672,9 @@ RECURSIVE SUBROUTINE ewald_ddapc_pot(cp_para_env, coeff, factor, cell, multipole alpha = SQRT(ABS(LOG(eps*rcut*tol)))/rcut galpha = 1.0_dp/(4.0_dp*alpha*alpha) tol1 = SQRT(-LOG(eps*rcut*(2.0_dp*tol*alpha)**2)) - nmax1 = NINT(0.25_dp+cell%hmat(1, 1)*alpha*tol1/pi) - nmax2 = NINT(0.25_dp+cell%hmat(2, 2)*alpha*tol1/pi) - nmax3 = NINT(0.25_dp+cell%hmat(3, 3)*alpha*tol1/pi) + nmax1 = NINT(0.25_dp + cell%hmat(1, 1)*alpha*tol1/pi) + nmax2 = NINT(0.25_dp + cell%hmat(2, 2)*alpha*tol1/pi) + nmax3 = NINT(0.25_dp + cell%hmat(3, 3)*alpha*tol1/pi) rmax1 = CEILING(rcut/cell%hmat(1, 1)) rmax2 = CEILING(rcut/cell%hmat(2, 2)) @@ -684,7 +684,7 @@ RECURSIVE SUBROUTINE ewald_ddapc_pot(cp_para_env, coeff, factor, cell, multipole fvec = twopi/(/cell%hmat(1, 1), cell%hmat(2, 2), cell%hmat(3, 3)/) ew_neut = -fac*pi/alpha**2 ! - ewmdim = SIZE(particle_set)*(SIZE(particle_set)+1)/2 + ewmdim = SIZE(particle_set)*(SIZE(particle_set) + 1)/2 ndim = SIZE(particle_set)*SIZE(radii) ALLOCATE (EwM(ewmdim)) ALLOCATE (M(ndim, ndim)) @@ -694,20 +694,20 @@ RECURSIVE SUBROUTINE ewald_ddapc_pot(cp_para_env, coeff, factor, cell, multipole !NB zero EwM so mp_sum(EwM) will give right answer EwM = 0.0_dp DO iparticle1 = 1, SIZE(particle_set) - ip1 = (iparticle1-1)*SIZE(radii) + ip1 = (iparticle1 - 1)*SIZE(radii) DO iparticle2 = 1, iparticle1 ij_fac = 1.0_dp IF (iparticle1 == iparticle2) ij_fac = 0.5_dp - ip2 = (iparticle2-1)*SIZE(radii) - idim = idim+1 + ip2 = (iparticle2 - 1)*SIZE(radii) + idim = idim + 1 !NB parallelization, done here so indexing is right IF (MOD(iparticle1, cp_para_env%num_pe) /= cp_para_env%mepos) CYCLE ! ! Real-Space Contribution ! my_val = 0.0_dp - rvec = particle_set(iparticle1)%r-particle_set(iparticle2)%r + rvec = particle_set(iparticle1)%r - particle_set(iparticle2)%r r_ewald = 0.0_dp IF (iparticle1 /= iparticle2) THEN ra = rvec @@ -722,14 +722,14 @@ RECURSIVE SUBROUTINE ewald_ddapc_pot(cp_para_env, coeff, factor, cell, multipole DO r2 = -rmax2, rmax2 DO r3 = -rmax3, rmax3 IF ((r1 == 0) .AND. (r2 == 0) .AND. (r3 == 0)) CYCLE - ra(1) = rvec(1)+cell%hmat(1, 1)*r1 - ra(2) = rvec(2)+cell%hmat(2, 2)*r2 - ra(3) = rvec(3)+cell%hmat(3, 3)*r3 + ra(1) = rvec(1) + cell%hmat(1, 1)*r1 + ra(2) = rvec(2) + cell%hmat(2, 2)*r2 + ra(3) = rvec(3) + cell%hmat(3, 3)*r3 r2tmp = DOT_PRODUCT(ra, ra) IF (r2tmp <= rcut2) THEN r = SQRT(r2tmp) t1 = erfc(alpha*r)/r - r_ewald = r_ewald+t1*ij_fac + r_ewald = r_ewald + t1*ij_fac END IF END DO END DO @@ -748,7 +748,7 @@ RECURSIVE SUBROUTINE ewald_ddapc_pot(cp_para_env, coeff, factor, cell, multipole gsq = DOT_PRODUCT(gvec, gvec) gsqi = fs/gsq t1 = fac*gsqi*EXP(-galpha*gsq) - g_ewald = g_ewald+t1*COS(DOT_PRODUCT(gvec, rvec)) + g_ewald = g_ewald + t1*COS(DOT_PRODUCT(gvec, rvec)) END DO END DO END DO @@ -758,12 +758,12 @@ RECURSIVE SUBROUTINE ewald_ddapc_pot(cp_para_env, coeff, factor, cell, multipole ! ! G-EWALD, R-EWALD ! - g_ewald = r_ewald+fourpi*g_ewald + g_ewald = r_ewald + fourpi*g_ewald ! ! Self Contribution ! IF (iparticle1 == iparticle2) THEN - g_ewald = g_ewald-2.0_dp*alpha*oorootpi + g_ewald = g_ewald - 2.0_dp*alpha*oorootpi END IF ! IF (iparticle1 /= iparticle2) THEN @@ -771,30 +771,30 @@ RECURSIVE SUBROUTINE ewald_ddapc_pot(cp_para_env, coeff, factor, cell, multipole r = SQRT(DOT_PRODUCT(ra, ra)) my_val = factor/r END IF - EwM(idim) = my_val-factor*g_ewald + EwM(idim) = my_val - factor*g_ewald END DO ! iparticle2 END DO ! iparticle1 !NB sum over parallelized contributions of different nodes CALL mp_sum(EwM, cp_para_env%group) idim = 0 DO iparticle2 = 1, SIZE(particle_set) - ip2 = (iparticle2-1)*SIZE(radii) - idimo = (iparticle2-1) - idimo = idimo*(idimo+1)/2 + ip2 = (iparticle2 - 1)*SIZE(radii) + idimo = (iparticle2 - 1) + idimo = idimo*(idimo + 1)/2 DO igauss2 = 1, SIZE(radii) - idim2 = ip2+igauss2 + idim2 = ip2 + igauss2 rc2 = radii(igauss2) rc22 = rc2*rc2 DO iparticle1 = 1, iparticle2 - ip1 = (iparticle1-1)*SIZE(radii) - idim = idimo+iparticle1 + ip1 = (iparticle1 - 1)*SIZE(radii) + idim = idimo + iparticle1 istart_g = 1 IF (iparticle1 == iparticle2) istart_g = igauss2 DO igauss1 = istart_g, SIZE(radii) - idim1 = ip1+igauss1 + idim1 = ip1 + igauss1 rc1 = radii(igauss1) rc12 = rc1*rc1 - M(idim1, idim2) = EwM(idim)-factor*ew_neut-factor*fac3*(rc12+rc22) + M(idim1, idim2) = EwM(idim) - factor*ew_neut - factor*fac3*(rc12 + rc22) M(idim2, idim1) = M(idim1, idim2) END DO END DO @@ -857,15 +857,15 @@ SUBROUTINE solvation_ddapc_pot(solvation_section, particle_set, M, radii) CASE (weight_type_unit) R0 = 0.0_dp DO i = 1, SIZE(list) - R0 = R0+particle_set(list(i))%r + R0 = R0 + particle_set(list(i))%r END DO R0 = R0/REAL(SIZE(list), KIND=dp) CASE (weight_type_mass) R0 = 0.0_dp mass = 0.0_dp DO i = 1, SIZE(list) - R0 = R0+particle_set(list(i))%r*particle_set(list(i))%atomic_kind%mass - mass = mass+particle_set(list(i))%atomic_kind%mass + R0 = R0 + particle_set(list(i))%r*particle_set(list(i))%atomic_kind%mass + mass = mass + particle_set(list(i))%atomic_kind%mass END DO R0 = R0/mass END SELECT @@ -886,7 +886,7 @@ SUBROUTINE solvation_ddapc_pot(solvation_section, particle_set, M, radii) ALLOCATE (cost(SIZE(particle_set), SIZE(particle_set))) ! Determining the single atomic contribution to the dielectric dipole DO i = 1, SIZE(particle_set) - rvec = particle_set(i)%r-center + rvec = particle_set(i)%r - center r2 = DOT_PRODUCT(rvec, rvec) r1 = SQRT(r2) IF (r1 >= Rs) THEN @@ -899,12 +899,12 @@ SUBROUTINE solvation_ddapc_pot(solvation_section, particle_set, M, radii) LocP(:, i) = 0.0_dp IF (r1 /= 0.0_dp) THEN DO l = 0, lmax - LocP(l, i) = (r1**l*REAL(l+1, KIND=dp)*(eps_in-eps_out))/ & - (Rs**(2*l+1)*eps_in*(REAL(l, KIND=dp)*eps_in+REAL(l+1, KIND=dp)*eps_out)) + LocP(l, i) = (r1**l*REAL(l + 1, KIND=dp)*(eps_in - eps_out))/ & + (Rs**(2*l + 1)*eps_in*(REAL(l, KIND=dp)*eps_in + REAL(l + 1, KIND=dp)*eps_out)) END DO ELSE ! limit for r->0 - LocP(0, i) = (eps_in-eps_out)/(Rs*eps_in*eps_out) + LocP(0, i) = (eps_in - eps_out)/(Rs*eps_in*eps_out) END IF pos(i) = r1 END DO @@ -914,10 +914,10 @@ SUBROUTINE solvation_ddapc_pot(solvation_section, particle_set, M, radii) DO j = 1, i factor = 0.0_dp IF (pos(i)*pos(j) /= 0.0_dp) THEN - mycos = DOT_PRODUCT(particle_set(i)%r-center, particle_set(j)%r-center)/(pos(i)*pos(j)) + mycos = DOT_PRODUCT(particle_set(i)%r - center, particle_set(j)%r - center)/(pos(i)*pos(j)) IF (ABS(mycos) > 1.0_dp) mycos = SIGN(1.0_dp, mycos) DO l = 0, lmax - factor = factor+LocP(l, i)*pos(j)**l*legendre(mycos, l, 0) + factor = factor + LocP(l, i)*pos(j)**l*legendre(mycos, l, 0) END DO ELSE factor = LocP(0, i) @@ -929,15 +929,15 @@ SUBROUTINE solvation_ddapc_pot(solvation_section, particle_set, M, radii) ! Computes the full potential energy matrix idim = 0 DO iparticle2 = 1, SIZE(particle_set) - ip2 = (iparticle2-1)*SIZE(radii) + ip2 = (iparticle2 - 1)*SIZE(radii) DO igauss2 = 1, SIZE(radii) - idim2 = ip2+igauss2 + idim2 = ip2 + igauss2 DO iparticle1 = 1, iparticle2 - ip1 = (iparticle1-1)*SIZE(radii) + ip1 = (iparticle1 - 1)*SIZE(radii) istart_g = 1 IF (iparticle1 == iparticle2) istart_g = igauss2 DO igauss1 = istart_g, SIZE(radii) - idim1 = ip1+igauss1 + idim1 = ip1 + igauss1 M(idim1, idim2) = cost(iparticle1, iparticle2) M(idim2, idim1) = M(idim1, idim2) END DO diff --git a/src/cp_ddapc_types.F b/src/cp_ddapc_types.F index 7746f66ee1..f0d8bf9231 100644 --- a/src/cp_ddapc_types.F +++ b/src/cp_ddapc_types.F @@ -117,7 +117,7 @@ SUBROUTINE cp_ddapc_create(cp_para_env, cp_ddapc_env, cp_ddapc_ewald, & CALL timeset(routineN, handle) ALLOCATE (cp_ddapc_env) cp_ddapc_env%ref_count = 1 - last_cp_ddapc_id = last_cp_ddapc_id+1 + last_cp_ddapc_id = last_cp_ddapc_id + 1 cp_ddapc_env%id_nr = last_cp_ddapc_id NULLIFY (cp_ddapc_env%AmI, & cp_ddapc_env%Md, & @@ -162,7 +162,7 @@ SUBROUTINE cp_ddapc_create(cp_para_env, cp_ddapc_env, cp_ddapc_ewald, & !NB parallelized ewald_ddapc_pot() needs cp_para_env CALL ewald_ddapc_pot(cp_para_env, cp_ddapc_ewald%coeff_mm, -1.0_dp, super_cell, param_section, & particle_set, cp_ddapc_env%Mr, radii) - cp_ddapc_env%Mt = cp_ddapc_env%Md+cp_ddapc_env%Mr + cp_ddapc_env%Mt = cp_ddapc_env%Md + cp_ddapc_env%Mr END IF END IF END IF @@ -190,7 +190,7 @@ SUBROUTINE cp_ddapc_retain(cp_ddapc_env) CPASSERT(ASSOCIATED(cp_ddapc_env)) CPASSERT(cp_ddapc_env%ref_count > 0) - cp_ddapc_env%ref_count = cp_ddapc_env%ref_count+1 + cp_ddapc_env%ref_count = cp_ddapc_env%ref_count + 1 END SUBROUTINE cp_ddapc_retain ! ************************************************************************************************** @@ -208,7 +208,7 @@ SUBROUTINE cp_ddapc_release(cp_ddapc_env) IF (ASSOCIATED(cp_ddapc_env)) THEN CPASSERT(cp_ddapc_env%ref_count > 0) - cp_ddapc_env%ref_count = cp_ddapc_env%ref_count-1 + cp_ddapc_env%ref_count = cp_ddapc_env%ref_count - 1 IF (cp_ddapc_env%ref_count == 0) THEN IF (ASSOCIATED(cp_ddapc_env%AmI)) THEN DEALLOCATE (cp_ddapc_env%AmI) @@ -402,12 +402,12 @@ SUBROUTINE eval_lg(multipole_section, hmat, deth, LG, gx, gy, gz) alpha = SQRT(ABS(LOG(eps*rcut*tol)))/rcut galpha = 1.0_dp/(4.0_dp*alpha*alpha) tol1 = SQRT(-LOG(eps*rcut*(2.0_dp*tol*alpha)**2)) - nmax1 = NINT(0.25_dp+hmat(1, 1)*alpha*tol1/pi) - nmax2 = NINT(0.25_dp+hmat(2, 2)*alpha*tol1/pi) - nmax3 = NINT(0.25_dp+hmat(3, 3)*alpha*tol1/pi) + nmax1 = NINT(0.25_dp + hmat(1, 1)*alpha*tol1/pi) + nmax2 = NINT(0.25_dp + hmat(2, 2)*alpha*tol1/pi) + nmax3 = NINT(0.25_dp + hmat(3, 3)*alpha*tol1/pi) fac = 1.e0_dp/deth fvec = 2.0_dp*pi/(/hmat(1, 1), hmat(2, 2), hmat(3, 3)/) - ndim = (nmax1+1)*(2*nmax2+1)*(2*nmax3+1)-1 + ndim = (nmax1 + 1)*(2*nmax2 + 1)*(2*nmax3 + 1) - 1 ALLOCATE (LG(ndim)) ALLOCATE (gx(ndim)) ALLOCATE (gy(ndim)) @@ -418,12 +418,12 @@ SUBROUTINE eval_lg(multipole_section, hmat, deth, LG, gx, gy, gz) DO k2 = -nmax2, nmax2 DO k3 = -nmax3, nmax3 IF (k1 == 0 .AND. k2 == 0 .AND. k3 == 0) CYCLE - i = i+1 + i = i + 1 fs = 2.0_dp; IF (k1 == 0) fs = 1.0_dp gx(i) = fvec(1)*REAL(k1, KIND=dp) gy(i) = fvec(2)*REAL(k2, KIND=dp) gz(i) = fvec(3)*REAL(k3, KIND=dp) - gsq = gx(i)*gx(i)+gy(i)*gy(i)+gz(i)*gz(i) + gsq = gx(i)*gx(i) + gy(i)*gy(i) + gz(i)*gz(i) gsqi = fs/gsq LG(i) = fac*gsqi*EXP(-galpha*gsq) END DO diff --git a/src/cp_ddapc_util.F b/src/cp_ddapc_util.F index 13613deecc..a88cff6238 100644 --- a/src/cp_ddapc_util.F +++ b/src/cp_ddapc_util.F @@ -157,7 +157,7 @@ SUBROUTINE cp_ddapc_init(qs_env) CALL section_vals_val_get(density_fit_section, "PFACTOR", r_val=pfact) ALLOCATE (radii(num_gauss)) DO i = 1, num_gauss - radii(i) = rcmin*pfact**(i-1) + radii(i) = rcmin*pfact**(i - 1) END DO END IF CALL section_vals_val_get(density_fit_section, "GCUT", r_val=gcut) @@ -331,7 +331,7 @@ RECURSIVE SUBROUTINE get_ddapc(qs_env, calc_force, density_fit_section, & CALL section_vals_val_get(density_fit_section, "PFACTOR", r_val=pfact) ALLOCATE (radii(num_gauss)) DO i = 1, num_gauss - radii(i) = rcmin*pfact**(i-1) + radii(i) = rcmin*pfact**(i - 1) END DO END IF IF (PRESENT(out_radii)) THEN @@ -357,15 +357,15 @@ RECURSIVE SUBROUTINE get_ddapc(qs_env, calc_force, density_fit_section, & CALL build_b_vector(bv, cp_ddapc_env%gfunc, cp_ddapc_env%w, & particle_set, radii, rho_tot_g, gcut); bv(:) = bv(:)/Vol CALL mp_sum(bv, rho_tot_g%pw_grid%para%group) - c1 = DOT_PRODUCT(cv, MATMUL(cp_ddapc_env%AmI, bv))-ch_dens + c1 = DOT_PRODUCT(cv, MATMUL(cp_ddapc_env%AmI, bv)) - ch_dens c1 = c1/cp_ddapc_env%c0 - qv(:) = -MATMUL(cp_ddapc_env%AmI, (bv-c1*cv)) + qv(:) = -MATMUL(cp_ddapc_env%AmI, (bv - c1*cv)) j = 0 qtot = 0.0_dp DO i = 1, ndim, num_gauss - j = j+1 + j = j + 1 DO ii = 1, num_gauss - qtot(j) = qtot(j)+qv((i-1)+ii) + qtot(j) = qtot(j) + qv((i - 1) + ii) END DO END DO IF (PRESENT(qout1)) THEN @@ -415,7 +415,7 @@ RECURSIVE SUBROUTINE get_ddapc(qs_env, calc_force, density_fit_section, & !NB do build_der_A_matrix_rows in blocks, for more efficient use of DGEMM #define NPSET 100 DO iparticle0 = 1, SIZE(particle_set), NPSET - nparticles = MIN(NPSET, SIZE(particle_set)-iparticle0+1) + nparticles = MIN(NPSET, SIZE(particle_set) - iparticle0 + 1) !NB each dAm is supposed to have one block of rows and one block of columns !NB for derivatives with respect to each atom. build_der_A_matrix_rows() !NB just returns rows, since dAm is symmetric, and missing columns can be @@ -429,7 +429,7 @@ RECURSIVE SUBROUTINE get_ddapc(qs_env, calc_force, density_fit_section, & !NB that contributions to dqv are distributed over the nodes. !NB also get rid of zeroing of dAm and division by Vol**2 - it's slow, and can be done !NB more quickly later, to a scalar or vector rather than a matrix - DO iparticle = iparticle0, iparticle0+nparticles-1 + DO iparticle = iparticle0, iparticle0 + nparticles - 1 IF (debug_this_module) THEN CALL debug_der_A_matrix(dAm, particle_set, radii, rho_tot_g, & gcut, iparticle, Vol, qs_env) @@ -446,13 +446,13 @@ RECURSIVE SUBROUTINE get_ddapc(qs_env, calc_force, density_fit_section, & END IF DO j = 1, 3 !NB dAmj is actually pretty sparse - one block of cols + one block of rows - use this here: - pmin = (iparticle-1)*SIZE(radii)+1 + pmin = (iparticle - 1)*SIZE(radii) + 1 pmax = iparticle*SIZE(radii) !NB multiply by block of columns that aren't explicitly in dAm, but can be reconstructured !NB as transpose of relevant block of rows IF (pmin > 1) THEN - dAmj_qv(:pmin-1) = MATMUL(TRANSPOSE(dAm(pmin:pmax, :pmin-1, j)), qv(pmin:pmax)) - cvT_AmI_dAmj(:pmin-1) = MATMUL(TRANSPOSE(dAm(pmin:pmax, :pmin-1, j)), cvT_AmI(pmin:pmax)) + dAmj_qv(:pmin - 1) = MATMUL(TRANSPOSE(dAm(pmin:pmax, :pmin - 1, j)), qv(pmin:pmax)) + cvT_AmI_dAmj(:pmin - 1) = MATMUL(TRANSPOSE(dAm(pmin:pmax, :pmin - 1, j)), cvT_AmI(pmin:pmax)) ENDIF !NB multiply by block of rows that are explicitly in dAm dAmj_qv(pmin:pmax) = MATMUL(dAm(pmin:pmax, :, j), qv(:)) @@ -460,16 +460,16 @@ RECURSIVE SUBROUTINE get_ddapc(qs_env, calc_force, density_fit_section, & !NB multiply by block of columns that aren't explicitly in dAm, but can be reconstructured !NB as transpose of relevant block of rows IF (pmax < SIZE(particle_set)*SIZE(radii)) THEN - dAmj_qv(pmax+1:) = MATMUL(TRANSPOSE(dAm(pmin:pmax, pmax+1:, j)), qv(pmin:pmax)) - cvT_AmI_dAmj(pmax+1:) = MATMUL(TRANSPOSE(dAm(pmin:pmax, pmax+1:, j)), cvT_AmI(pmin:pmax)) + dAmj_qv(pmax + 1:) = MATMUL(TRANSPOSE(dAm(pmin:pmax, pmax + 1:, j)), qv(pmin:pmax)) + cvT_AmI_dAmj(pmax + 1:) = MATMUL(TRANSPOSE(dAm(pmin:pmax, pmax + 1:, j)), cvT_AmI(pmin:pmax)) ENDIF dAmj_qv(:) = dAmj_qv(:)/(Vol*Vol) cvT_AmI_dAmj(:) = cvT_AmI_dAmj(:)/(Vol*Vol) - c3 = DOT_PRODUCT(cvT_AmI_dAmj, AmI_bv)-DOT_PRODUCT(cvT_AmI, dbv(:, j))-c1*DOT_PRODUCT(cvT_AmI_dAmj, AmI_cv) - tv(:, iparticle, j) = -(dAmj_qv(:)+dbv(:, j)+c3/cp_ddapc_env%c0*cv) + c3 = DOT_PRODUCT(cvT_AmI_dAmj, AmI_bv) - DOT_PRODUCT(cvT_AmI, dbv(:, j)) - c1*DOT_PRODUCT(cvT_AmI_dAmj, AmI_cv) + tv(:, iparticle, j) = -(dAmj_qv(:) + dbv(:, j) + c3/cp_ddapc_env%c0*cv) END DO ! j !NB zero relevant parts of dAm here - dAm((iparticle-1)*SIZE(radii)+1:iparticle*SIZE(radii), :, :) = 0.0_dp + dAm((iparticle - 1)*SIZE(radii) + 1:iparticle*SIZE(radii), :, :) = 0.0_dp !! dAm(:,(iparticle-1)*SIZE(radii)+1:iparticle*SIZE(radii),:) = 0.0_dp END DO ! iparticle END DO ! iparticle0 @@ -576,30 +576,30 @@ SUBROUTINE restraint_functional_potential(v_hartree_gspace, & sfac = -1.0_dp/Vol fac = DOT_PRODUCT(cv, MATMUL(AmI, cv)) fac2 = DOT_PRODUCT(cv, MATMUL(AmI, uv)) - cv(:) = uv-cv*fac2/fac + cv(:) = uv - cv*fac2/fac cv(:) = MATMUL(AmI, cv) - IF (g_hartree%pw_grid%have_g0) g_hartree%cc(1) = g_hartree%cc(1)+sfac*fac2/fac + IF (g_hartree%pw_grid%have_g0) g_hartree%cc(1) = g_hartree%cc(1) + sfac*fac2/fac DO ig = g_hartree%pw_grid%first_gne0, g_hartree%pw_grid%ngpts_cut_local g2 = g_hartree%pw_grid%gsq(ig) - w = 4.0_dp*pi*(g2-gcut2)**2.0_dp/(g2*gcut2) + w = 4.0_dp*pi*(g2 - gcut2)**2.0_dp/(g2*gcut2) IF (g2 > gcut2) EXIT gvec = g_hartree%pw_grid%g(:, ig) g_corr = 0.0_dp idim = 0 DO iparticle = 1, SIZE(particle_set) DO igauss = 1, SIZE(radii) - idim = idim+1 + idim = idim + 1 rc = radii(igauss) rc2 = rc*rc rvec = particle_set(iparticle)%r arg = DOT_PRODUCT(gvec, rvec) phase = CMPLX(COS(arg), -SIN(arg), KIND=dp) gfunc = EXP(-g2*rc2/4.0_dp) - g_corr = g_corr+gfunc*cv(idim)*phase + g_corr = g_corr + gfunc*cv(idim)*phase END DO END DO g_corr = g_corr*w - g_hartree%cc(ig) = g_hartree%cc(ig)+sfac*g_corr/Vol + g_hartree%cc(ig) = g_hartree%cc(ig) + sfac*g_corr/Vol END DO CALL timestop(handle) END SUBROUTINE restraint_functional_potential @@ -648,30 +648,30 @@ SUBROUTINE modify_hartree_pot(v_hartree_gspace, density_fit_section, & sfac = -1.0_dp/Vol fac = DOT_PRODUCT(cv, MATMUL(AmI, cv)) fac2 = DOT_PRODUCT(cv, MATMUL(AmI, uv)) - cv(:) = uv-cv*fac2/fac + cv(:) = uv - cv*fac2/fac cv(:) = MATMUL(AmI, cv) - IF (g_hartree%pw_grid%have_g0) g_hartree%cc(1) = g_hartree%cc(1)+sfac*fac2/fac + IF (g_hartree%pw_grid%have_g0) g_hartree%cc(1) = g_hartree%cc(1) + sfac*fac2/fac DO ig = g_hartree%pw_grid%first_gne0, g_hartree%pw_grid%ngpts_cut_local g2 = g_hartree%pw_grid%gsq(ig) - w = 4.0_dp*pi*(g2-gcut2)**2.0_dp/(g2*gcut2) + w = 4.0_dp*pi*(g2 - gcut2)**2.0_dp/(g2*gcut2) IF (g2 > gcut2) EXIT gvec = g_hartree%pw_grid%g(:, ig) g_corr = 0.0_dp idim = 0 DO iparticle = 1, SIZE(particle_set) DO igauss = 1, SIZE(radii) - idim = idim+1 + idim = idim + 1 rc = radii(igauss) rc2 = rc*rc rvec = particle_set(iparticle)%r arg = DOT_PRODUCT(gvec, rvec) phase = CMPLX(COS(arg), -SIN(arg), KIND=dp) gfunc = EXP(-g2*rc2/4.0_dp) - g_corr = g_corr+gfunc*cv(idim)*phase + g_corr = g_corr + gfunc*cv(idim)*phase END DO END DO g_corr = g_corr*w - g_hartree%cc(ig) = g_hartree%cc(ig)+sfac*g_corr/Vol + g_hartree%cc(ig) = g_hartree%cc(ig) + sfac*g_corr/Vol END DO CALL timestop(handle) END SUBROUTINE modify_hartree_pot @@ -722,18 +722,18 @@ SUBROUTINE debug_der_b_vector(dbv, particle_set, radii, & DO i = 1, 3 bv1(:) = 0.0_dp bv2(:) = 0.0_dp - particle_set(iparticle)%r(i) = rvec(i)+dx + particle_set(iparticle)%r(i) = rvec(i) + dx CALL build_b_vector(bv1, cp_ddapc_env%gfunc, cp_ddapc_env%w, & particle_set, radii, rho_tot_g, gcut); bv1(:) = bv1(:)/Vol CALL mp_sum(bv1, rho_tot_g%pw_grid%para%group) - particle_set(iparticle)%r(i) = rvec(i)-dx + particle_set(iparticle)%r(i) = rvec(i) - dx CALL build_b_vector(bv2, cp_ddapc_env%gfunc, cp_ddapc_env%w, & particle_set, radii, rho_tot_g, gcut); bv2(:) = bv2(:)/Vol CALL mp_sum(bv2, rho_tot_g%pw_grid%para%group) - ddbv(:) = (bv1(:)-bv2(:))/(2.0_dp*dx) + ddbv(:) = (bv1(:) - bv2(:))/(2.0_dp*dx) DO kk = 1, SIZE(ddbv) IF (ddbv(kk) .GT. 1.0E-8_dp) THEN - v0 = ABS(dbv(kk, i)-ddbv(kk))/ddbv(kk)*100.0_dp + v0 = ABS(dbv(kk, i) - ddbv(kk))/ddbv(kk)*100.0_dp WRITE (*, *) "Error % on B ::", v0 IF (v0 .GT. 0.1_dp) THEN WRITE (*, '(A,2I5,2F15.9)') "ERROR IN DERIVATIVE OF B VECTOR, IPARTICLE, ICOORD:", iparticle, i, & @@ -800,21 +800,21 @@ SUBROUTINE debug_der_A_matrix(dAm, particle_set, radii, & DO i = 1, 3 Am1 = 0.0_dp Am2 = 0.0_dp - particle_set(iparticle)%r(i) = rvec(i)+dx + particle_set(iparticle)%r(i) = rvec(i) + dx CALL build_A_matrix(Am1, cp_ddapc_env%gfunc, cp_ddapc_env%w, & particle_set, radii, rho_tot_g, gcut, g_dot_rvec_sin, g_dot_rvec_cos) Am1(:, :) = Am1(:, :)/(Vol*Vol) CALL mp_sum(Am1, rho_tot_g%pw_grid%para%group) - particle_set(iparticle)%r(i) = rvec(i)-dx + particle_set(iparticle)%r(i) = rvec(i) - dx CALL build_A_matrix(Am2, cp_ddapc_env%gfunc, cp_ddapc_env%w, & particle_set, radii, rho_tot_g, gcut, g_dot_rvec_sin, g_dot_rvec_cos) Am2(:, :) = Am2(:, :)/(Vol*Vol) CALL mp_sum(Am2, rho_tot_g%pw_grid%para%group) - ddAm(:, :) = (Am1-Am2)/(2.0_dp*dx) + ddAm(:, :) = (Am1 - Am2)/(2.0_dp*dx) DO kk = 1, SIZE(ddAm, 1) DO ll = 1, SIZE(ddAm, 2) IF (ddAm(kk, ll) .GT. 1.0E-8_dp) THEN - v0 = ABS(dAm(kk, ll, i)-ddAm(kk, ll))/ddAm(kk, ll)*100.0_dp + v0 = ABS(dAm(kk, ll, i) - ddAm(kk, ll))/ddAm(kk, ll)*100.0_dp WRITE (*, *) "Error % on A ::", v0, Am1(kk, ll), Am2(kk, ll), iparticle, i, kk, ll IF (v0 .GT. 0.1_dp) THEN WRITE (*, '(A,4I5,2F15.9)') "ERROR IN DERIVATIVE OF A MATRIX, IPARTICLE, ICOORD:", iparticle, i, kk, ll, & @@ -875,17 +875,17 @@ SUBROUTINE debug_charge(dqv, qs_env, density_fit_section, & DO iparticle = 1, SIZE(particle_set) rvec = particle_set(iparticle)%r DO i = 1, 3 - particle_set(iparticle)%r(i) = rvec(i)+dx + particle_set(iparticle)%r(i) = rvec(i) + dx CALL get_ddapc(qs_env, .FALSE., density_fit_section, qout1=qtot1, & ext_rho_tot_g=rho_tot_g, Itype_of_density=type_of_density) - particle_set(iparticle)%r(i) = rvec(i)-dx + particle_set(iparticle)%r(i) = rvec(i) - dx CALL get_ddapc(qs_env, .FALSE., density_fit_section, qout1=qtot2, & ext_rho_tot_g=rho_tot_g, Itype_of_density=type_of_density) - ddqv(:) = (qtot1-qtot2)/(2.0_dp*dx) - DO kk = 1, SIZE(qtot1)-1, SIZE(radii) - IF (ANY(ddqv(kk:kk+2) .GT. 1.0E-8_dp)) THEN - WRITE (*, '(A,2F12.6,F12.2)') "Error :", SUM(dqv(kk:kk+2, iparticle, i)), SUM(ddqv(kk:kk+2)), & - ABS((SUM(ddqv(kk:kk+2))-SUM(dqv(kk:kk+2, iparticle, i)))/SUM(ddqv(kk:kk+2))*100.0_dp) + ddqv(:) = (qtot1 - qtot2)/(2.0_dp*dx) + DO kk = 1, SIZE(qtot1) - 1, SIZE(radii) + IF (ANY(ddqv(kk:kk + 2) .GT. 1.0E-8_dp)) THEN + WRITE (*, '(A,2F12.6,F12.2)') "Error :", SUM(dqv(kk:kk + 2, iparticle, i)), SUM(ddqv(kk:kk + 2)), & + ABS((SUM(ddqv(kk:kk + 2)) - SUM(dqv(kk:kk + 2, iparticle, i)))/SUM(ddqv(kk:kk + 2))*100.0_dp) END IF END DO particle_set(iparticle)%r = rvec diff --git a/src/cp_eri_mme_interface.F b/src/cp_eri_mme_interface.F index 817b5e4db5..38b54094bc 100644 --- a/src/cp_eri_mme_interface.F +++ b/src/cp_eri_mme_interface.F @@ -308,8 +308,8 @@ SUBROUTINE cp_eri_mme_finalize(param) INTEGER :: count_2c, count_3c, unit_nr - count_2c = param%G_count_2c+param%R_count_2c - count_3c = param%GG_count_3c+param%GR_count_3c+param%RR_count_3c + count_2c = param%G_count_2c + param%R_count_2c + count_3c = param%GG_count_3c + param%GR_count_3c + param%RR_count_3c unit_nr = param%par%unit_nr @@ -410,9 +410,9 @@ SUBROUTINE eri_mme_set_params_custom(param, hmat, is_ortho, zet_min, zet_max, l_ param%par%do_calib_cutoff = .TRUE. ELSE ! only calibrate cutoff if parameters (cell, basis coefficients) have changed - IF (ALL(ABS(param%par%hmat-hmat) < eps_changed) .AND. & - ABS(param%par%zet_min-zet_min) < eps_changed .AND. & - ABS(param%par%zet_max-zet_max) < eps_changed .AND. & + IF (ALL(ABS(param%par%hmat - hmat) < eps_changed) .AND. & + ABS(param%par%zet_min - zet_min) < eps_changed .AND. & + ABS(param%par%zet_max - zet_max) < eps_changed .AND. & param%par%l_max_zet == l_max_zet) THEN param%par%do_calib_cutoff = .FALSE. ELSE @@ -507,7 +507,7 @@ SUBROUTINE error_est_pgf_params_from_basis(qs_kind_set, basis_type_1, basis_type basis_type=basis_type) DO iset = 1, basis_set%nset DO ipgf = 1, basis_set%npgf(iset) - IF (ABS(zet_m-basis_set%zet(ipgf, iset)) .LE. (zet_m*1.0E-12_dp) & + IF (ABS(zet_m - basis_set%zet(ipgf, iset)) .LE. (zet_m*1.0E-12_dp) & .AND. (basis_set%lmax(iset) .GT. l_zet)) THEN l_zet = basis_set%lmax(iset) ENDIF @@ -522,8 +522,8 @@ SUBROUTINE error_est_pgf_params_from_basis(qs_kind_set, basis_type_1, basis_type ! l + 1 because we may calculate forces ! this is probably a safe choice also for the case that forces are not needed - l_max_zet = l_zet+1 - l_max = l_m+1 + l_max_zet = l_zet + 1 + l_max = l_m + 1 CALL timestop(handle) END SUBROUTINE error_est_pgf_params_from_basis @@ -566,7 +566,7 @@ SUBROUTINE eri_mme_print_info(param) WRITE (unit_nr, '(T2, A)') "ERI_MME| Estimated absolute error for normalized Hermite-Gaussian basis" WRITE (unit_nr, '(T2, A, T72, ES9.2)') "ERI_MME| Minimax error:", param%par%err_mm WRITE (unit_nr, '(T2, A, T72, ES9.2)') "ERI_MME| Cutoff error:", param%par%err_c - WRITE (unit_nr, '(T2, A, T72, ES9.2)') "ERI_MME| Total error (minimax + cutoff):", param%par%err_mm+param%par%err_c + WRITE (unit_nr, '(T2, A, T72, ES9.2)') "ERI_MME| Total error (minimax + cutoff):", param%par%err_mm + param%par%err_c ENDIF IF (param%par%print_calib) & WRITE (unit_nr, '(T2, A, T68, F13.10)') "ERI_MME| Minimax scaling constant in AM-GM estimate:", param%par%C_mm @@ -726,27 +726,27 @@ SUBROUTINE cp_eri_mme_update_local_counts(param, para_env, G_count_2c, R_count_2 IF (PRESENT(G_count_2c)) THEN CALL mp_sum(G_count_2c, para_env%group) - param%G_count_2c = param%G_count_2c+G_count_2c + param%G_count_2c = param%G_count_2c + G_count_2c ENDIF IF (PRESENT(R_count_2c)) THEN CALL mp_sum(R_count_2c, para_env%group) - param%R_count_2c = param%R_count_2c+R_count_2c + param%R_count_2c = param%R_count_2c + R_count_2c ENDIF IF (PRESENT(GG_count_3c)) THEN CALL mp_sum(GG_count_3c, para_env%group) - param%GG_count_3c = param%GG_count_3c+GG_count_3c + param%GG_count_3c = param%GG_count_3c + GG_count_3c ENDIF IF (PRESENT(GR_count_3c)) THEN CALL mp_sum(GR_count_3c, para_env%group) - param%GR_count_3c = param%GR_count_3c+GR_count_3c + param%GR_count_3c = param%GR_count_3c + GR_count_3c ENDIF IF (PRESENT(RR_count_3c)) THEN CALL mp_sum(RR_count_3c, para_env%group) - param%RR_count_3c = param%RR_count_3c+RR_count_3c + param%RR_count_3c = param%RR_count_3c + RR_count_3c ENDIF END SUBROUTINE cp_eri_mme_update_local_counts @@ -807,9 +807,9 @@ SUBROUTINE cp_eri_mme_perf_acc_test(para_env, iw, eri_mme_test_section) zet(1) = zetmin IF (nzet .GT. 1) THEN - zet_fac = (zetmax/zetmin)**(1.0_dp/(nzet-1)) - DO i = 1, nzet-1 - zet(i+1) = zet(i)*zet_fac + zet_fac = (zetmax/zetmin)**(1.0_dp/(nzet - 1)) + DO i = 1, nzet - 1 + zet(i + 1) = zet(i)*zet_fac ENDDO ENDIF @@ -822,7 +822,7 @@ SUBROUTINE cp_eri_mme_perf_acc_test(para_env, iw, eri_mme_test_section) CALL init_cell(box) ! Create range of rab (atomic distances) to be tested - nR_xyz = CEILING(REAL(min_nR, KIND=dp)**(1.0_dp/3.0_dp)-1.0E-06) + nR_xyz = CEILING(REAL(min_nR, KIND=dp)**(1.0_dp/3.0_dp) - 1.0E-06) nR = nR_xyz**3 ALLOCATE (rabc(3, nR)) @@ -830,11 +830,11 @@ SUBROUTINE cp_eri_mme_perf_acc_test(para_env, iw, eri_mme_test_section) DO ix = 1, nR_xyz DO iy = 1, nR_xyz DO iz = 1, nR_xyz - count_r = count_r+1 + count_r = count_r + 1 ! adding 10% of cell size to positions to avoid atoms exactly at boundary or center of a cell rabc(:, count_r) = pbc([ix*ABS(cell_par(1)), & iy*ABS(cell_par(2)), & - iz*ABS(cell_par(3))]/nR_xyz+ & + iz*ABS(cell_par(3))]/nR_xyz + & 0.1_dp*ABS(cell_par(:)), box) ENDDO ENDDO diff --git a/src/cp_external_control.F b/src/cp_external_control.F index 4bd9957e91..4a162dd432 100644 --- a/src/cp_external_control.F +++ b/src/cp_external_control.F @@ -129,7 +129,7 @@ SUBROUTINE external_control(should_stop, flag, globenv, target_time, start_time) ! however, if should_stop has been true, we should always check ! (at each level scf, md, ... the file must be there to guarantee termination) t1 = m_walltime() - IF (t1 > t_last_file_check+20.0_dp .OR. t1 <= t_last_file_check .OR. check_always) THEN + IF (t1 > t_last_file_check + 20.0_dp .OR. t1 <= t_last_file_check .OR. check_always) THEN t_last_file_check = t1 ! allows for halting execution for a while @@ -147,7 +147,7 @@ SUBROUTINE external_control(should_stop, flag, globenv, target_time, start_time) t1 = m_walltime() DO I = 1, 100000000 t2 = m_walltime() - IF (t2-t1 > 1.0_dp) EXIT + IF (t2 - t1 > 1.0_dp) EXIT ENDDO ! and ask again INQUIRE (FILE="WAIT", EXIST=should_wait) @@ -207,7 +207,7 @@ SUBROUTINE external_control(should_stop, flag, globenv, target_time, start_time) IF ((.NOT. should_stop) .AND. (my_target_time > 0.0_dp)) THEN ! Check for execution time - time_check = m_walltime()-my_start_time + time_check = m_walltime() - my_start_time IF (time_check .GT. my_target_time) THEN should_stop = .TRUE. WRITE (UNIT=cp_logger_get_default_unit_nr(logger), FMT="(/,T2,A,f12.3,A)") & diff --git a/src/cp_gemm_interface.F b/src/cp_gemm_interface.F index 215733508b..24b2e2c0f9 100644 --- a/src/cp_gemm_interface.F +++ b/src/cp_gemm_interface.F @@ -101,21 +101,21 @@ SUBROUTINE cp_gemm(transa, transb, m, n, k, alpha, matrix_a, matrix_b, beta, & IF (my_multi .NE. do_pdgemm) THEN IF (SIZE(a_row_loc) == SIZE(c_row_loc)) THEN - IF (ANY(a_row_loc-c_row_loc .NE. 0)) my_multi = do_pdgemm + IF (ANY(a_row_loc - c_row_loc .NE. 0)) my_multi = do_pdgemm ELSE my_multi = do_pdgemm END IF END IF IF (my_multi .NE. do_pdgemm) THEN IF (SIZE(b_col_loc) == SIZE(c_col_loc)) THEN - IF (ANY(b_col_loc-c_col_loc .NE. 0)) my_multi = do_pdgemm + IF (ANY(b_col_loc - c_col_loc .NE. 0)) my_multi = do_pdgemm ELSE my_multi = do_pdgemm END IF END IF IF (my_multi .NE. do_pdgemm) THEN IF (SIZE(a_col_loc) == SIZE(b_row_loc)) THEN - IF (ANY(a_col_loc-b_row_loc .NE. 0)) my_multi = do_pdgemm + IF (ANY(a_col_loc - b_row_loc .NE. 0)) my_multi = do_pdgemm ELSE my_multi = do_pdgemm END IF diff --git a/src/cp_subsys_methods.F b/src/cp_subsys_methods.F index 1f84046b95..bfe6c017bd 100644 --- a/src/cp_subsys_methods.F +++ b/src/cp_subsys_methods.F @@ -341,7 +341,7 @@ SUBROUTINE create_small_subsys(small_subsys, big_subsys, small_cell, & ! ! Defining element ! - id_ = INDEX(id2str(topology%atom_info%id_atmname(iat)), "_")-1 + id_ = INDEX(id2str(topology%atom_info%id_atmname(iat)), "_") - 1 IF (id_ == -1) id_ = LEN_TRIM(id2str(topology%atom_info%id_atmname(iat))) strtmp1 = id2str(topology%atom_info%id_atmname(iat)) strtmp1 = strtmp1(1:id_) diff --git a/src/cp_symmetry.F b/src/cp_symmetry.F index 778f164a17..496608b0e1 100644 --- a/src/cp_symmetry.F +++ b/src/cp_symmetry.F @@ -120,9 +120,9 @@ SUBROUTINE write_symmetry(particle_set, cell, input_section) CALL section_vals_val_get(section_vals=section, & keyword_name="ALL", l_val=pall) plevel = 0 - IF (pcoor) plevel = plevel+1 - IF (pinertia) plevel = plevel+10 - IF (psymmele) plevel = plevel+100 + IF (pcoor) plevel = plevel + 1 + IF (pinertia) plevel = plevel + 10 + IF (psymmele) plevel = plevel + 100 IF (pall) plevel = 1111111111 CALL print_symmetry(mol_sym, coord, atype, element, z, weight, iw, plevel) @@ -164,7 +164,7 @@ SUBROUTINE write_symmetry(particle_set, cell, input_section) CALL section_vals_val_get(section_vals=section, & keyword_name="ALL", l_val=pall) plevel = 0 - IF (prmat) plevel = plevel+1 + IF (prmat) plevel = plevel + 1 IF (pall) plevel = 1111111111 crys_sym%plevel = plevel diff --git a/src/cryssym.F b/src/cryssym.F index c3cf38cfad..5f1e58192c 100644 --- a/src/cryssym.F +++ b/src/cryssym.F @@ -274,18 +274,18 @@ SUBROUTINE kpoint_gen(csym, nk, symm, shift, full_grid) "possible without symmetrization.") END IF ALLOCATE (ixkp(3, nkpts), iwkp(nkpts)) - is_shift(1:3) = MOD(nk(1:3)+1, 2) + is_shift(1:3) = MOD(nk(1:3) + 1, 2) is_time_reversal = 1 nkp = spg_get_ir_reciprocal_mesh(ixkp, iwkp, nk, is_shift, is_time_reversal, & TRANSPOSE(csym%hmat), csym%scoord, csym%atype, & csym%nat, csym%delta) wkp = 0.0_dp DO i = 1, nkpts - xkp(:, i) = REAL(is_shift+2*ixkp(:, i), KIND=dp)/REAL(2*nk(:), KIND=dp) - j = iwkp(i)+1 - wkp(j) = wkp(j)+1.0_dp + xkp(:, i) = REAL(is_shift + 2*ixkp(:, i), KIND=dp)/REAL(2*nk(:), KIND=dp) + j = iwkp(i) + 1 + wkp(j) = wkp(j) + 1.0_dp ENDDO - csym%kplink(1, 1:nkpts) = iwkp(1:nkpts)+1 + csym%kplink(1, 1:nkpts) = iwkp(1:nkpts) + 1 DEALLOCATE (ixkp, iwkp) END IF ELSE @@ -304,7 +304,7 @@ SUBROUTINE kpoint_gen(csym, nk, symm, shift, full_grid) ! count kpoints nkp = 0 DO i = 1, nkpts - IF (wkp(i) > 0.0_dp) nkp = nkp+1 + IF (wkp(i) > 0.0_dp) nkp = nkp + 1 END DO ! store reduced kpoint set @@ -314,7 +314,7 @@ SUBROUTINE kpoint_gen(csym, nk, symm, shift, full_grid) j = 0 DO ik = 1, nkpts IF (wkp(ik) > 0.0_dp) THEN - j = j+1 + j = j + 1 csym%wkpoint(j) = wkp(ik) csym%xkpoint(1:3, j) = xkp(1:3, ik) xptr(j) = ik @@ -351,8 +351,8 @@ SUBROUTINE kpoint_gen(csym, nk, symm, shift, full_grid) DO i = 1, csym%n_operations IF (SUM(ABS(csym%translations(:, i))) > 1.e-10_dp) CYCLE rxkp(1:3) = kp_apply_operation(csym%xkpoint(1:3, j), csym%rotations(:, :, i)) - rxkp(1:3) = ABS(xkp(1:3, ik)-rxkp(1:3)) - rxkp(1:3) = rxkp(1:3)-REAL(NINT(rxkp(1:3)), KIND=dp) + rxkp(1:3) = ABS(xkp(1:3, ik) - rxkp(1:3)) + rxkp(1:3) = rxkp(1:3) - REAL(NINT(rxkp(1:3)), KIND=dp) IF (ALL((rxkp(1:3)) < 1.e-12_dp)) THEN csym%kpop(ik) = i EXIT @@ -399,17 +399,17 @@ SUBROUTINE full_grid_gen(nk, xkp, wkp, shift) DO ix = 1, nk(1) DO iy = 1, nk(2) DO iz = 1, nk(3) - i = i+1 - kpt_latt(1) = REAL(2*ix-nk(1)-1, KIND=dp)/(2._dp*REAL(nk(1), KIND=dp)) - kpt_latt(2) = REAL(2*iy-nk(2)-1, KIND=dp)/(2._dp*REAL(nk(2), KIND=dp)) - kpt_latt(3) = REAL(2*iz-nk(3)-1, KIND=dp)/(2._dp*REAL(nk(3), KIND=dp)) + i = i + 1 + kpt_latt(1) = REAL(2*ix - nk(1) - 1, KIND=dp)/(2._dp*REAL(nk(1), KIND=dp)) + kpt_latt(2) = REAL(2*iy - nk(2) - 1, KIND=dp)/(2._dp*REAL(nk(2), KIND=dp)) + kpt_latt(3) = REAL(2*iz - nk(3) - 1, KIND=dp)/(2._dp*REAL(nk(3), KIND=dp)) xkp(1:3, i) = kpt_latt(1:3) wkp(i) = 1.0_dp END DO END DO END DO DO i = 1, nk(1)*nk(2)*nk(3) - xkp(1:3, i) = xkp(1:3, i)+shift(1:3) + xkp(1:3, i) = xkp(1:3, i) + shift(1:3) END DO END SUBROUTINE full_grid_gen @@ -432,10 +432,10 @@ SUBROUTINE inversion_symm(xkp, wkp, link) link(:) = 0 DO i = 1, nkpts IF (link(i) == 0) link(i) = i - DO j = i+1, nkpts + DO j = i + 1, nkpts IF (wkp(j) == 0) CYCLE IF (ALL(xkp(:, i) == -xkp(:, j))) THEN - wkp(i) = wkp(i)+wkp(j) + wkp(i) = wkp(i) + wkp(j) wkp(j) = 0.0_dp link(j) = i EXIT @@ -456,9 +456,9 @@ FUNCTION kp_apply_operation(x, r) RESULT(y) INTEGER, INTENT(IN) :: r(3, 3) REAL(KIND=dp) :: y(3) - y(1) = REAL(r(1, 1), dp)*x(1)+REAL(r(1, 2), dp)*x(2)+REAL(r(1, 3), dp)*x(3) - y(2) = REAL(r(2, 1), dp)*x(1)+REAL(r(2, 2), dp)*x(2)+REAL(r(2, 3), dp)*x(3) - y(3) = REAL(r(3, 1), dp)*x(1)+REAL(r(3, 2), dp)*x(2)+REAL(r(3, 3), dp)*x(3) + y(1) = REAL(r(1, 1), dp)*x(1) + REAL(r(1, 2), dp)*x(2) + REAL(r(1, 3), dp)*x(3) + y(2) = REAL(r(2, 1), dp)*x(1) + REAL(r(2, 2), dp)*x(2) + REAL(r(2, 3), dp)*x(3) + y(3) = REAL(r(3, 1), dp)*x(1) + REAL(r(3, 2), dp)*x(2) + REAL(r(3, 3), dp)*x(3) END FUNCTION kp_apply_operation @@ -488,12 +488,12 @@ SUBROUTINE apply_rotation_coord(f0, csym, ir) f0 = 0 DO ia = 1, natom ri(1:3) = csym%scoord(1:3, ia) - ro(1) = REAL(rot(1, 1), dp)*ri(1)+REAL(rot(2, 1), dp)*ri(2)+REAL(rot(3, 1), dp)*ri(3)+tr(1) - ro(2) = REAL(rot(1, 2), dp)*ri(1)+REAL(rot(2, 2), dp)*ri(2)+REAL(rot(3, 2), dp)*ri(3)+tr(2) - ro(3) = REAL(rot(1, 3), dp)*ri(1)+REAL(rot(2, 3), dp)*ri(2)+REAL(rot(3, 3), dp)*ri(3)+tr(3) + ro(1) = REAL(rot(1, 1), dp)*ri(1) + REAL(rot(2, 1), dp)*ri(2) + REAL(rot(3, 1), dp)*ri(3) + tr(1) + ro(2) = REAL(rot(1, 2), dp)*ri(1) + REAL(rot(2, 2), dp)*ri(2) + REAL(rot(3, 2), dp)*ri(3) + tr(2) + ro(3) = REAL(rot(1, 3), dp)*ri(1) + REAL(rot(2, 3), dp)*ri(2) + REAL(rot(3, 3), dp)*ri(3) + tr(3) DO ib = 1, natom rb(1:3) = csym%scoord(1:3, ib) - diff = SQRT(SUM((ri(:)-rb(:))**2)) + diff = SQRT(SUM((ri(:) - rb(:))**2)) IF (diff < csym%delta) THEN f0(ia) = ib EXIT diff --git a/src/csvr_system_types.F b/src/csvr_system_types.F index ad33c23dea..9651624963 100644 --- a/src/csvr_system_types.F +++ b/src/csvr_system_types.F @@ -114,7 +114,7 @@ SUBROUTINE csvr_thermo_create(csvr) seed(:, :, 1) = initial_seed DO ithermo = 2, csvr%glob_num_csvr - seed(:, :, ithermo) = next_rng_seed(seed(:, :, ithermo-1)) + seed(:, :, ithermo) = next_rng_seed(seed(:, :, ithermo - 1)) END DO ! Update initial seed initial_seed = next_rng_seed(seed(:, :, csvr%glob_num_csvr)) diff --git a/src/csvr_system_utils.F b/src/csvr_system_utils.F index c35ec7b605..49d94e5022 100644 --- a/src/csvr_system_utils.F +++ b/src/csvr_system_utils.F @@ -99,13 +99,13 @@ FUNCTION rescaling_factor(kk, sigma, ndeg, taut, rng_stream) RESULT(my_res) reverse = 1.0_dp ! reverse of momentum is implemented to have the correct limit to Langevin dynamics for ndeg=1 ! condition: rr < -SQRT(ndeg*kk*factor/(sigma*(1.0_dp-factor))) - IF ((rr*rr*sigma*(1.0_dp-factor)) > (ndeg*kk*factor) .AND. rr <= 0.0_dp) reverse = -1.0_dp + IF ((rr*rr*sigma*(1.0_dp - factor)) > (ndeg*kk*factor) .AND. rr <= 0.0_dp) reverse = -1.0_dp ! for ndeg/=1, the reverse of momentum is not necessary. in principles, it should be there. ! in practice, it is better to skip it to avoid unnecessary slowing down of the dynamics in the small taut regime ! anyway, this should not affect the final ensemble IF (ndeg /= 1) reverse = 1.0_dp - resample = kk+(1.0_dp-factor)*(sigma*(sumnoises(ndeg-1, rng_stream)+rr**2)/REAL(ndeg, KIND=dp)-kk) & - +2.0_dp*rr*SQRT(kk*sigma/ndeg*(1.0_dp-factor)*factor) + resample = kk + (1.0_dp - factor)*(sigma*(sumnoises(ndeg - 1, rng_stream) + rr**2)/REAL(ndeg, KIND=dp) - kk) & + + 2.0_dp*rr*SQRT(kk*sigma/ndeg*(1.0_dp - factor)*factor) resample = MAX(0.0_dp, resample) my_res = reverse*SQRT(resample/kk) @@ -132,7 +132,7 @@ FUNCTION sumnoises(nn, rng_stream) RESULT(sum_gauss) sum_gauss = 0.0_dp DO i = 1, nn - sum_gauss = sum_gauss+next_random_number(rng_stream)**2 + sum_gauss = sum_gauss + next_random_number(rng_stream)**2 END DO END FUNCTION sumnoises diff --git a/src/ct_methods.F b/src/ct_methods.F index 1fd8169313..34a62e959c 100644 --- a/src/ct_methods.F +++ b/src/ct_methods.F @@ -1001,7 +1001,7 @@ RECURSIVE SUBROUTINE solve_riccati_equation(pp, qq, qp, pq, oo, vv, x, res, & CALL dbcsr_dot(n, m, numer) tau = numer/denom CALL dbcsr_dot(step, m, numer) - beta = tau-kappa*numer/denom + beta = tau - kappa*numer/denom CASE (cg_zero) beta = 0.0_dp CASE DEFAULT @@ -1097,7 +1097,7 @@ RECURSIVE SUBROUTINE solve_riccati_equation(pp, qq, qp, pq, oo, vv, x, res, & c1 = -3.0_dp*c1 CALL dbcsr_dot(res, n, c2) - c2 = -2.0_dp*c2+(dbcsr_frobenius_norm(m))**2 + c2 = -2.0_dp*c2 + (dbcsr_frobenius_norm(m))**2 CALL dbcsr_dot(res, m, c3) @@ -1148,14 +1148,14 @@ RECURSIVE SUBROUTINE solve_riccati_equation(pp, qq, qp, pq, oo, vv, x, res, & IF (unit_nr > 0) THEN WRITE (unit_nr, '(T6,A,1X,I4,1X,E12.3,F8.3)') & - "RICCATI iter ", iteration, best_norm, t2-t1 + "RICCATI iter ", iteration, best_norm, t2 - t1 !WRITE(unit_nr,'(T6,A,1X,I4,1X,F15.9,F15.9,E12.3,F8.3)') & ! "RICCATI iter ",iteration,ecorr,change_ecorr,best_norm,t2-t1 ENDIF t1 = m_walltime() - iteration = iteration+1 + iteration = iteration + 1 IF (prepare_to_exit) EXIT @@ -1394,11 +1394,11 @@ SUBROUTINE analytic_line_search(a, b, c, d, minima, nmins) ENDIF ELSE ! Quadratic equation with max two roots. - DD = c*c-4.0_dp*b*d + DD = c*c - 4.0_dp*b*d IF (DD .GT. 0.0_dp) THEN nroots = 2 - x(1) = (-c+SQRT(DD))/2.0_dp/b - x(2) = (-c-SQRT(DD))/2.0_dp/b + x(1) = (-c + SQRT(DD))/2.0_dp/b + x(2) = (-c - SQRT(DD))/2.0_dp/b ELSE IF (DD .LT. 0.0_dp) THEN nroots = 0 ELSE @@ -1409,38 +1409,38 @@ SUBROUTINE analytic_line_search(a, b, c, d, minima, nmins) ELSE ! Cubic equation with max three roots ! Calculate p and q - p = c/a-b*b/a/a/3.0_dp - q = (2.0_dp*b*b*b/a/a/a-9.0_dp*b*c/a/a+27.0_dp*d/a)/27.0_dp + p = c/a - b*b/a/a/3.0_dp + q = (2.0_dp*b*b*b/a/a/a - 9.0_dp*b*c/a/a + 27.0_dp*d/a)/27.0_dp ! Calculate DD - DD = p*p*p/27.0_dp+q*q/4.0_dp + DD = p*p*p/27.0_dp + q*q/4.0_dp IF (DD .LT. 0.0_dp) THEN ! three real unequal roots -- use the trigonometric formulation phi = ACOS(-q/2.0_dp/SQRT(ABS(p*p*p)/27.0_dp)) temp1 = 2.0_dp*SQRT(ABS(p)/3.0_dp) y1 = temp1*COS(phi/3.0_dp) - y2 = -temp1*COS((phi+pi)/3.0_dp) - y3 = -temp1*COS((phi-pi)/3.0_dp) + y2 = -temp1*COS((phi + pi)/3.0_dp) + y3 = -temp1*COS((phi - pi)/3.0_dp) ELSE ! 1 real & 2 conjugate complex roots OR 3 real roots (some are equal) - temp1 = -q/2.0_dp+SQRT(DD) - temp2 = -q/2.0_dp-SQRT(DD) + temp1 = -q/2.0_dp + SQRT(DD) + temp2 = -q/2.0_dp - SQRT(DD) u = ABS(temp1)**(1.0_dp/3.0_dp) v = ABS(temp2)**(1.0_dp/3.0_dp) IF (temp1 .LT. 0.0_dp) u = -u IF (temp2 .LT. 0.0_dp) v = -v - y1 = u+v - y2r = -(u+v)/2.0_dp - y2i = (u-v)*SQRT(3.0_dp)/2.0_dp + y1 = u + v + y2r = -(u + v)/2.0_dp + y2i = (u - v)*SQRT(3.0_dp)/2.0_dp ENDIF ! Final transformation temp1 = b/a/3.0_dp - y1 = y1-temp1 - y2 = y2-temp1 - y3 = y3-temp1 - y2r = y2r-temp1 + y1 = y1 - temp1 + y2 = y2 - temp1 + y3 = y3 - temp1 + y2r = y2r - temp1 ! Assign answers IF (DD .LT. 0.0_dp) THEN @@ -1467,9 +1467,9 @@ SUBROUTINE analytic_line_search(a, b, c, d, minima, nmins) DO i = 1, nroots ! maximum or minimum? use the derivative ! 3*a*x**2+2*b*x+c - der = 3.0_dp*a*x(i)*x(i)+2.0_dp*b*x(i)+c + der = 3.0_dp*a*x(i)*x(i) + 2.0_dp*b*x(i) + c IF (der .GT. 0.0_dp) THEN - nmins = nmins+1 + nmins = nmins + 1 minima(nmins) = x(i) !write(*,'(a,i2,a,f10.5)') 'Minimum ', i, ', value: ', x(i) ENDIF diff --git a/src/d3_poly.F b/src/d3_poly.F index d4e67e57c3..d0452664a7 100644 --- a/src/d3_poly.F +++ b/src/d3_poly.F @@ -48,9 +48,9 @@ MODULE d3_poly ! maximum grad for cached values INTEGER, PUBLIC, PARAMETER :: max_grad2 = 5 INTEGER, PUBLIC, PARAMETER :: max_grad3 = 3 - INTEGER, PUBLIC, PARAMETER :: cached_dim1 = max_grad2+1 - INTEGER, PUBLIC, PARAMETER :: cached_dim2 = (max_grad2+1)*(max_grad2+2)/2 - INTEGER, PUBLIC, PARAMETER :: cached_dim3 = (max_grad3+1)*(max_grad3+2)*(max_grad3+3)/6 + INTEGER, PUBLIC, PARAMETER :: cached_dim1 = max_grad2 + 1 + INTEGER, PUBLIC, PARAMETER :: cached_dim2 = (max_grad2 + 1)*(max_grad2 + 2)/2 + INTEGER, PUBLIC, PARAMETER :: cached_dim3 = (max_grad3 + 1)*(max_grad3 + 2)*(max_grad3 + 3)/6 ! cached index -> monomial exponents LOGICAL, SAVE :: module_initialized = .FALSE. @@ -83,53 +83,53 @@ SUBROUTINE init_d3_poly_module() DO grad = 0, max_grad2 DO i = grad, 0, -1 a_mono_exp2(1, ii) = i - a_mono_exp2(2, ii) = grad-i - ii = ii+1 + a_mono_exp2(2, ii) = grad - i + ii = ii + 1 END DO END DO ii = 1 DO grad = 0, max_grad3 DO i = grad, 0, -1 - DO j = grad-i, 0, -1 + DO j = grad - i, 0, -1 a_mono_exp3(1, ii) = i a_mono_exp3(2, ii) = j - a_mono_exp3(3, ii) = grad-i-j - ii = ii+1 + a_mono_exp3(3, ii) = grad - i - j + ii = ii + 1 END DO END DO END DO DO ii = 1, cached_dim3 - subG = a_mono_exp3(2, ii)+a_mono_exp3(3, ii) - a_reduce_idx3(ii) = subG*(subG+1)/2+a_mono_exp3(3, ii)+1 + subG = a_mono_exp3(2, ii) + a_mono_exp3(3, ii) + a_reduce_idx3(ii) = subG*(subG + 1)/2 + a_mono_exp3(3, ii) + 1 END DO DO ii = 1, cached_dim3 IF (a_mono_exp3(1, ii) > 0) THEN - a_deriv_idx3(1, ii) = mono_index3(a_mono_exp3(1, ii)-1, a_mono_exp3(2, ii), a_mono_exp3(3, ii)) + a_deriv_idx3(1, ii) = mono_index3(a_mono_exp3(1, ii) - 1, a_mono_exp3(2, ii), a_mono_exp3(3, ii)) ELSE a_deriv_idx3(1, ii) = 0 END IF IF (a_mono_exp3(2, ii) > 0) THEN - a_deriv_idx3(2, ii) = mono_index3(a_mono_exp3(1, ii), a_mono_exp3(2, ii)-1, a_mono_exp3(3, ii)) + a_deriv_idx3(2, ii) = mono_index3(a_mono_exp3(1, ii), a_mono_exp3(2, ii) - 1, a_mono_exp3(3, ii)) ELSE a_deriv_idx3(2, ii) = 0 END IF IF (a_mono_exp3(3, ii) > 0) THEN - a_deriv_idx3(3, ii) = mono_index3(a_mono_exp3(1, ii), a_mono_exp3(2, ii), a_mono_exp3(3, ii)-1) + a_deriv_idx3(3, ii) = mono_index3(a_mono_exp3(1, ii), a_mono_exp3(2, ii), a_mono_exp3(3, ii) - 1) ELSE a_deriv_idx3(3, ii) = 0 END IF END DO DO ii = 1, cached_dim2 DO ij = ii, cached_dim2 - monoRes2 = a_mono_exp2(:, ii)+a_mono_exp2(:, ij) - a_mono_mult2(ii, ij) = mono_index2(monoRes2(1), monoRes2(2))+1 + monoRes2 = a_mono_exp2(:, ii) + a_mono_exp2(:, ij) + a_mono_mult2(ii, ij) = mono_index2(monoRes2(1), monoRes2(2)) + 1 a_mono_mult2(ij, ii) = a_mono_mult2(ii, ij) END DO END DO DO ii = 1, cached_dim3 DO ij = ii, cached_dim3 - monoRes3 = a_mono_exp3(:, ii)+a_mono_exp3(:, ij) - a_mono_mult3(ii, ij) = mono_index3(monoRes3(1), monoRes3(2), monoRes3(3))+1 + monoRes3 = a_mono_exp3(:, ii) + a_mono_exp3(:, ij) + a_mono_mult3(ii, ij) = mono_index3(monoRes3(1), monoRes3(2), monoRes3(3)) + 1 a_mono_mult3(ij, ii) = a_mono_mult3(ii, ij) END DO END DO @@ -137,7 +137,7 @@ SUBROUTINE init_d3_poly_module() DO i = 1, cached_dim3 DO j = 1, 4 a_mono_mult3a(j, i) = a_mono_mult3(j, i) - ii = ii+1 + ii = ii + 1 END DO END DO @@ -153,7 +153,7 @@ PURE FUNCTION poly_size1(maxgrad) RESULT(res) INTEGER, INTENT(in) :: maxgrad INTEGER :: res - res = maxgrad+1 + res = maxgrad + 1 END FUNCTION ! ************************************************************************************************** @@ -165,7 +165,7 @@ PURE FUNCTION poly_size2(maxgrad) RESULT(res) INTEGER, INTENT(in) :: maxgrad INTEGER :: res - res = (maxgrad+1)*(maxgrad+2)/2 + res = (maxgrad + 1)*(maxgrad + 2)/2 END FUNCTION ! ************************************************************************************************** @@ -177,7 +177,7 @@ PURE FUNCTION poly_size3(maxgrad) RESULT(res) INTEGER, INTENT(in) :: maxgrad INTEGER :: res - res = (maxgrad+1)*(maxgrad+2)*(maxgrad+3)/6 + res = (maxgrad + 1)*(maxgrad + 2)*(maxgrad + 3)/6 END FUNCTION ! ************************************************************************************************** @@ -189,7 +189,7 @@ PURE FUNCTION grad_size1(n) RESULT(res) INTEGER, INTENT(in) :: n INTEGER :: res - res = n-1 + res = n - 1 END FUNCTION ! ************************************************************************************************** @@ -201,7 +201,7 @@ PURE FUNCTION grad_size2(n) RESULT(res) INTEGER, INTENT(in) :: n INTEGER :: res - res = INT(FLOOR(0.5_dp*(SQRT(1.0_dp+8.0_dp*REAL(n, dp))-1.0_dp)-2.e-6_dp)) + res = INT(FLOOR(0.5_dp*(SQRT(1.0_dp + 8.0_dp*REAL(n, dp)) - 1.0_dp) - 2.e-6_dp)) END FUNCTION ! ************************************************************************************************** @@ -220,8 +220,8 @@ PURE FUNCTION grad_size3(n) RESULT(res) res = -1 ELSE nn = n*6 - g1 = (108.0_dp*nn+12.0_dp*SQRT(81.0_dp*nn*nn-12.0_dp))**(1.0_dp/3.0_dp) - res = FLOOR(g1/6.0_dp+2.0_dp/g1-1.0_dp-2.e-6_dp) + g1 = (108.0_dp*nn + 12.0_dp*SQRT(81.0_dp*nn*nn - 12.0_dp))**(1.0_dp/3.0_dp) + res = FLOOR(g1/6.0_dp + 2.0_dp/g1 - 1.0_dp - 2.e-6_dp) END IF END FUNCTION @@ -249,8 +249,8 @@ PURE FUNCTION mono_index2(i, j) RESULT(res) INTEGER :: grad - grad = i+j - res = grad*(grad+1)/2+j + grad = i + j + res = grad*(grad + 1)/2 + j END FUNCTION ! ************************************************************************************************** @@ -266,9 +266,9 @@ PURE FUNCTION mono_index3(i, j, k) RESULT(res) INTEGER :: grad, sgrad - sgrad = j+k - grad = i+sgrad - res = grad*(grad+1)*(grad+2)/6+(sgrad)*(sgrad+1)/2+k + sgrad = j + k + grad = i + sgrad + res = grad*(grad + 1)*(grad + 2)/6 + (sgrad)*(sgrad + 1)/2 + k END FUNCTION ! ************************************************************************************************** @@ -294,9 +294,9 @@ PURE FUNCTION mono_exp2(ii) RESULT(res) INTEGER :: grad - grad = INT(FLOOR(0.5_dp*(SQRT(9.0_dp+8.0_dp*ii)-1.0_dp)-2.e-6_dp)) - res(2) = ii-(grad)*(grad+1)/2 - res(1) = grad-res(2) + grad = INT(FLOOR(0.5_dp*(SQRT(9.0_dp + 8.0_dp*ii) - 1.0_dp) - 2.e-6_dp)) + res(2) = ii - (grad)*(grad + 1)/2 + res(1) = grad - res(2) END FUNCTION ! ************************************************************************************************** @@ -311,14 +311,14 @@ PURE FUNCTION mono_exp3(n) RESULT(res) INTEGER :: grad, grad1, ii, nn REAL(dp) :: g1 - nn = (n+1)*6 - g1 = (108.0_dp*nn+12.0_dp*SQRT(81.0_dp*nn*nn-12.0_dp))**(1.0_dp/3.0_dp) - grad1 = INT(FLOOR(g1/6.0_dp+2.0_dp/g1-1.0_dp-2.e-6_dp)) - ii = n-grad1*(grad1+1)*(grad1+2)/6 - grad = INT(FLOOR(0.5_dp*(SQRT(9.0_dp+8.0_dp*ii)-1.0_dp)-1.e-6_dp)) - res(3) = ii-grad*(grad+1)/2 - res(2) = grad-res(3) - res(1) = grad1-grad + nn = (n + 1)*6 + g1 = (108.0_dp*nn + 12.0_dp*SQRT(81.0_dp*nn*nn - 12.0_dp))**(1.0_dp/3.0_dp) + grad1 = INT(FLOOR(g1/6.0_dp + 2.0_dp/g1 - 1.0_dp - 2.e-6_dp)) + ii = n - grad1*(grad1 + 1)*(grad1 + 2)/6 + grad = INT(FLOOR(0.5_dp*(SQRT(9.0_dp + 8.0_dp*ii) - 1.0_dp) - 1.e-6_dp)) + res(3) = ii - grad*(grad + 1)/2 + res(2) = grad - res(3) + res(1) = grad1 - grad END FUNCTION ! ************************************************************************************************** @@ -331,7 +331,7 @@ PURE FUNCTION mono_mult1(ii, ij) RESULT(res) INTEGER, INTENT(in) :: ii, ij INTEGER :: res - res = ii+ij + res = ii + ij END FUNCTION ! ************************************************************************************************** @@ -346,7 +346,7 @@ PURE FUNCTION mono_mult2(ii, ij) RESULT(res) INTEGER, DIMENSION(2) :: monoRes - monoRes = mono_exp2(ii)+mono_exp2(ij) + monoRes = mono_exp2(ii) + mono_exp2(ij) res = mono_index2(monoRes(1), monoRes(2)) END FUNCTION @@ -362,7 +362,7 @@ PURE FUNCTION mono_mult3(ii, ij) RESULT(res) INTEGER, DIMENSION(3) :: monoRes - monoRes = mono_exp3(ii)+mono_exp3(ij) + monoRes = mono_exp3(ii) + mono_exp3(ij) res = mono_index3(monoRes(1), monoRes(2), monoRes(3)) END FUNCTION @@ -394,22 +394,22 @@ SUBROUTINE poly_mult1(p1, p2, pRes, np1, sumUp) IF (PRESENT(sumUp)) mySumUp = sumUp size_p1 = SIZE(p1)/myNp1 size_p2 = SIZE(p2) - newGrad = grad_size1(size_p1)+grad_size1(size_p2) + newGrad = grad_size1(size_p1) + grad_size1(size_p2) newSize = SIZE(pRes)/myNp1 CPASSERT(newSize >= poly_size1(newGrad)) IF (.NOT. mySumUp) pRes = 0 iPos = 1 resShift_0 = 0 - DO ipoly = 0, myNp1-1 + DO ipoly = 0, myNp1 - 1 DO i = 1, size_p1 - resPos = resShift_0+i + resPos = resShift_0 + i DO j = 1, size_p2 - pRes(resPos) = pRes(resPos)+p1(iPos)*p2(j) - resPos = resPos+1 + pRes(resPos) = pRes(resPos) + p1(iPos)*p2(j) + resPos = resPos + 1 END DO - iPos = iPos+1 + iPos = iPos + 1 END DO - resShift_0 = resShift_0+newSize + resShift_0 = resShift_0 + newSize END DO END SUBROUTINE @@ -442,7 +442,7 @@ SUBROUTINE poly_mult2(p1, p2, pRes, np1, sumUp) size_p2 = SIZE(p2) grad1 = grad_size2(size_p1) grad2 = grad_size2(size_p2) - newGrad = grad1+grad2 + newGrad = grad1 + grad2 newSize = SIZE(pRes)/myNp1 CPASSERT(newSize >= poly_size2(newGrad)) IF (.NOT. mySumUp) pRes = 0 @@ -451,44 +451,44 @@ SUBROUTINE poly_mult2(p1, p2, pRes, np1, sumUp) DO ipoly = 1, myNp1 DO i = 1, MIN(size_p1, cached_dim2) DO j = 1, MIN(size_p2, cached_dim2) - pRes(shiftRes+a_mono_mult2(j, i)) = pRes(shiftRes+a_mono_mult2(j, i)) & - +p1(iShift+i)*p2(j) + pRes(shiftRes + a_mono_mult2(j, i)) = pRes(shiftRes + a_mono_mult2(j, i)) & + + p1(iShift + i)*p2(j) END DO END DO - iShift = iShift+size_p1 - shiftRes = shiftRes+newSize + iShift = iShift + size_p1 + shiftRes = shiftRes + newSize END DO IF (grad1 > max_grad2 .OR. grad2 > max_grad2) THEN msize_p1 = size_p1 shiftRes_0 = 0 - DO ipoly = 0, myNp1-1 + DO ipoly = 0, myNp1 - 1 shift1 = ipoly*size_p1 DO g1 = 0, grad1 ! shift1=g1*(g1+1)/2 IF (g1 > max_grad2) THEN subG2 = 0 shift2 = 0 - g1g2 = shiftRes_0-1 + g1g2 = shiftRes_0 - 1 ELSE - subG2 = max_grad2+1 + subG2 = max_grad2 + 1 shift2 = cached_dim2 - g1g2 = shiftRes_0+g1*subG2-1 + g1g2 = shiftRes_0 + g1*subG2 - 1 END IF DO g2 = subG2, grad2 ! shift2=g2*(g2+1)/2 - shiftRes = shift1+shift2+g1g2 ! shiftRes=(g1+g2)*(g1+g2+1)/2-1+ipoly*newSize - DO i = 1, MIN(g1+1, msize_p1-shift1) - DO j = 1, MIN(g2+1, size_p2-shift2) - pRes(shiftRes+i+j) = pRes(shiftRes+i+j)+p1(shift1+i)*p2(shift2+j) + shiftRes = shift1 + shift2 + g1g2 ! shiftRes=(g1+g2)*(g1+g2+1)/2-1+ipoly*newSize + DO i = 1, MIN(g1 + 1, msize_p1 - shift1) + DO j = 1, MIN(g2 + 1, size_p2 - shift2) + pRes(shiftRes + i + j) = pRes(shiftRes + i + j) + p1(shift1 + i)*p2(shift2 + j) END DO END DO - shift2 = shift2+g2+1 ! - g1g2 = g1g2+g1 ! + shift2 = shift2 + g2 + 1 ! + g1g2 = g1g2 + g1 ! END DO - shift1 = shift1+g1+1 ! + shift1 = shift1 + g1 + 1 ! END DO - shiftRes_0 = shiftRes_0+newSize-size_p1 - msize_p1 = msize_p1+size_p1 + shiftRes_0 = shiftRes_0 + newSize - size_p1 + msize_p1 = msize_p1 + size_p1 END DO END IF END SUBROUTINE @@ -522,7 +522,7 @@ SUBROUTINE poly_mult3(p1, p2, pRes, np1, sumUp) size_p2 = SIZE(p2) grad1 = grad_size3(size_p1) grad2 = grad_size3(size_p2) - newGrad = grad1+grad2 + newGrad = grad1 + grad2 newSize = SIZE(pRes)/myNp1 CPASSERT(newSize >= poly_size3(newGrad)) CALL poly_mult3b(p1, SIZE(p1), grad1, p2, SIZE(p2), grad2, pRes, SIZE(pRes), myNp1, mySumUp) @@ -570,66 +570,66 @@ SUBROUTINE poly_mult3b(p1, size_p1, grad1, p2, size_p2, grad2, pRes, size_pRes, DO ipoly = 1, np1 DO i = 1, MIN(my_size_p1, cached_dim3) DO j = 1, MIN(size_p2, cached_dim3) - pRes(shiftRes+a_mono_mult3(j, i)) = pRes(shiftRes+a_mono_mult3(j, i)) & - +p1(iShift+i)*p2(j) + pRes(shiftRes + a_mono_mult3(j, i)) = pRes(shiftRes + a_mono_mult3(j, i)) & + + p1(iShift + i)*p2(j) END DO END DO - iShift = iShift+my_size_p1 - shiftRes = shiftRes+newSize + iShift = iShift + my_size_p1 + shiftRes = shiftRes + newSize END DO IF (grad1 > max_grad3 .OR. grad2 > max_grad3) THEN ! one could remove multiplications even more agressively... msize_p1 = my_size_p1 - DO ipoly = 0, np1-1 - shift1 = 1+ipoly*my_size_p1 - shiftRes_0 = 1+ipoly*newSize + DO ipoly = 0, np1 - 1 + shift1 = 1 + ipoly*my_size_p1 + shiftRes_0 = 1 + ipoly*newSize DO g1 = 0, grad1 IF (g1 > max_grad3) THEN subG2 = 0 shift2 = 1 ELSE - subG2 = max_grad3+1 - shift2 = subG2*(subG2+1)*(subG2+2)/6+1 + subG2 = max_grad3 + 1 + shift2 = subG2*(subG2 + 1)*(subG2 + 2)/6 + 1 END IF DO g2 = subG2, grad2 - shiftRes = (g1+g2)*(g1+g2+1)*(g1+g2+2)/6+shiftRes_0 + shiftRes = (g1 + g2)*(g1 + g2 + 1)*(g1 + g2 + 2)/6 + shiftRes_0 shift1I = shift1 shiftResI_0 = shiftRes DO i1 = g1, 0, -1 IF (shift1I > msize_p1) EXIT shift2I = shift2 shiftResI = shiftResI_0 - subGrad = g1-i1 + subGrad = g1 - i1 DO i2 = g2, 0, -1 !subGrad=g1+g2-i1-i2 !shiftResI=shiftRes+(subGrad)*(subGrad+1)/2 !shift2I=shift2+(g2-i2)*(g2-i2+1)/2 IF (shift2I > size_p2) EXIT - DO j1 = g1-i1, 0, -1 - shift1J = shift1I+g1-i1-j1 + DO j1 = g1 - i1, 0, -1 + shift1J = shift1I + g1 - i1 - j1 IF (shift1J > msize_p1) EXIT - DO j2 = g2-i2, 0, -1 - shift2J = shift2I+g2-i2-j2 + DO j2 = g2 - i2, 0, -1 + shift2J = shift2I + g2 - i2 - j2 IF (shift2J > size_p2) EXIT - shiftResJ = shiftResI+(subGrad-j1-j2) + shiftResJ = shiftResI + (subGrad - j1 - j2) ! shift1J=mono_index3(i1,j1,g1-i1-j1)+ipoly*my_size_p1+1 ! shift2J=mono_index3(i2,j2,g2-i2-j2)+1 ! shiftResJ=mono_index3(i1+i2,j1+j2,g1+g2-i1-i2-j1-j2)+ipoly*newSize+1 - pRes(shiftResJ) = pRes(shiftResJ)+p1(shift1J)*p2(shift2J) + pRes(shiftResJ) = pRes(shiftResJ) + p1(shift1J)*p2(shift2J) END DO END DO - subGrad = subGrad+1 - shift2I = shift2I+(g2-i2+1) - shiftResI = shiftResI+subGrad + subGrad = subGrad + 1 + shift2I = shift2I + (g2 - i2 + 1) + shiftResI = shiftResI + subGrad END DO - shift1I = shift1I+(g1-i1+1) - shiftResI_0 = shiftResI_0+(g1-i1+1) + shift1I = shift1I + (g1 - i1 + 1) + shiftResI_0 = shiftResI_0 + (g1 - i1 + 1) END DO - shift2 = shift2+(g2+1)*(g2+2)/2 + shift2 = shift2 + (g2 + 1)*(g2 + 2)/2 END DO - shift1 = shift1+(g1+1)*(g1+2)/2 + shift1 = shift1 + (g1 + 1)*(g1 + 2)/2 END DO - msize_p1 = msize_p1+my_size_p1 + msize_p1 = msize_p1 + my_size_p1 END DO END IF END SUBROUTINE @@ -673,64 +673,64 @@ SUBROUTINE poly_mult3ab(p1, size_p1, grad1, p2, pRes, size_pRes, np1, sumUp) shiftRes = 0 DO ipoly = 1, np1 DO i = 1, MIN(my_size_p1, cached_dim3) - pRes(shiftRes+a_mono_mult3a(1, i)) = pRes(shiftRes+a_mono_mult3a(1, i)) & - +p1(iShift+i)*p2(1) - pRes(shiftRes+a_mono_mult3a(2, i)) = pRes(shiftRes+a_mono_mult3a(2, i)) & - +p1(iShift+i)*p2(2) - pRes(shiftRes+a_mono_mult3a(3, i)) = pRes(shiftRes+a_mono_mult3a(3, i)) & - +p1(iShift+i)*p2(3) - pRes(shiftRes+a_mono_mult3a(4, i)) = pRes(shiftRes+a_mono_mult3a(4, i)) & - +p1(iShift+i)*p2(4) + pRes(shiftRes + a_mono_mult3a(1, i)) = pRes(shiftRes + a_mono_mult3a(1, i)) & + + p1(iShift + i)*p2(1) + pRes(shiftRes + a_mono_mult3a(2, i)) = pRes(shiftRes + a_mono_mult3a(2, i)) & + + p1(iShift + i)*p2(2) + pRes(shiftRes + a_mono_mult3a(3, i)) = pRes(shiftRes + a_mono_mult3a(3, i)) & + + p1(iShift + i)*p2(3) + pRes(shiftRes + a_mono_mult3a(4, i)) = pRes(shiftRes + a_mono_mult3a(4, i)) & + + p1(iShift + i)*p2(4) END DO - iShift = iShift+my_size_p1 - shiftRes = shiftRes+newSize + iShift = iShift + my_size_p1 + shiftRes = shiftRes + newSize END DO IF (grad1 > max_grad3 .OR. grad2 > max_grad3) THEN ! one could remove multiplications even more agressively... msize_p1 = my_size_p1 - DO ipoly = 0, np1-1 - shift1 = 1+ipoly*my_size_p1+(max_grad3+1)*(max_grad3+2)*(max_grad3+3)/6 - shiftRes_0 = 1+ipoly*newSize - DO g1 = max_grad3+1, grad1 + DO ipoly = 0, np1 - 1 + shift1 = 1 + ipoly*my_size_p1 + (max_grad3 + 1)*(max_grad3 + 2)*(max_grad3 + 3)/6 + shiftRes_0 = 1 + ipoly*newSize + DO g1 = max_grad3 + 1, grad1 subG2 = 0 shift2 = 1 DO g2 = subG2, grad2 - shiftRes = (g1+g2)*(g1+g2+1)*(g1+g2+2)/6+shiftRes_0 + shiftRes = (g1 + g2)*(g1 + g2 + 1)*(g1 + g2 + 2)/6 + shiftRes_0 shift1I = shift1 shiftResI_0 = shiftRes DO i1 = g1, 0, -1 IF (shift1I > msize_p1) EXIT shift2I = shift2 shiftResI = shiftResI_0 - subGrad = g1-i1 + subGrad = g1 - i1 DO i2 = g2, 0, -1 !subGrad=g1+g2-i1-i2 !shiftResI=shiftRes+(subGrad)*(subGrad+1)/2 !shift2I=shift2+(g2-i2)*(g2-i2+1)/2 - DO j1 = g1-i1, 0, -1 - shift1J = shift1I+g1-i1-j1 + DO j1 = g1 - i1, 0, -1 + shift1J = shift1I + g1 - i1 - j1 IF (shift1J > msize_p1) EXIT - DO j2 = g2-i2, 0, -1 - shift2J = shift2I+g2-i2-j2 - shiftResJ = shiftResI+(subGrad-j1-j2) + DO j2 = g2 - i2, 0, -1 + shift2J = shift2I + g2 - i2 - j2 + shiftResJ = shiftResI + (subGrad - j1 - j2) ! shift1J=mono_index3(i1,j1,g1-i1-j1)+ipoly*my_size_p1+1 ! shift2J=mono_index3(i2,j2,g2-i2-j2)+1 ! shiftResJ=mono_index3(i1+i2,j1+j2,g1+g2-i1-i2-j1-j2)+ipoly*newSize+1 - pRes(shiftResJ) = pRes(shiftResJ)+p1(shift1J)*p2(shift2J) + pRes(shiftResJ) = pRes(shiftResJ) + p1(shift1J)*p2(shift2J) END DO END DO - subGrad = subGrad+1 - shift2I = shift2I+(g2-i2+1) - shiftResI = shiftResI+subGrad + subGrad = subGrad + 1 + shift2I = shift2I + (g2 - i2 + 1) + shiftResI = shiftResI + subGrad END DO - shift1I = shift1I+(g1-i1+1) - shiftResI_0 = shiftResI_0+(g1-i1+1) + shift1I = shift1I + (g1 - i1 + 1) + shiftResI_0 = shiftResI_0 + (g1 - i1 + 1) END DO - shift2 = shift2+(g2+1)*(g2+2)/2 + shift2 = shift2 + (g2 + 1)*(g2 + 2)/2 END DO - shift1 = shift1+(g1+1)*(g1+2)/2 + shift1 = shift1 + (g1 + 1)*(g1 + 2)/2 END DO - msize_p1 = msize_p1+my_size_p1 + msize_p1 = msize_p1 + my_size_p1 END DO END IF END SUBROUTINE @@ -752,7 +752,7 @@ SUBROUTINE poly_write1(p, out_f) IF (p(i) /= 0) THEN IF (p(i) >= 0) WRITE (out_f, '("+")', advance='NO') WRITE (out_f, '(G20.10)', advance='NO') p(i) - IF (i /= 1) WRITE (out_f, '("*x^",I3)', advance='NO') i-1 + IF (i /= 1) WRITE (out_f, '("*x^",I3)', advance='NO') i - 1 did_write = .TRUE. END IF END DO @@ -775,7 +775,7 @@ SUBROUTINE poly_write2(p, out_f) IF (.NOT. module_initialized) CPABORT("module d3_poly not initialized") did_write = .FALSE. DO i = 1, SIZE(p) - mono_e = mono_exp2(i-1) + mono_e = mono_exp2(i - 1) IF (p(i) /= 0) THEN IF (p(i) >= 0) WRITE (out_f, '("+")', advance='NO') WRITE (out_f, '(G20.10)', advance='NO') p(i) @@ -803,7 +803,7 @@ SUBROUTINE poly_write3(p, out_f) IF (.NOT. module_initialized) CPABORT("module d3_poly not initialized") did_write = .FALSE. DO i = 1, SIZE(p) - mono_e = mono_exp3(i-1) + mono_e = mono_exp3(i - 1) IF (p(i) /= 0) THEN IF (p(i) >= 0) WRITE (out_f, '("+")', advance='NO') WRITE (out_f, '(G20.10)', advance='NO') p(i) @@ -839,13 +839,13 @@ FUNCTION poly_random(p, maxSize, minSize) RESULT(res) myMinSize = 1 IF (PRESENT(minSize)) myMinSize = minSize CALL RANDOM_NUMBER(g) - pSize = MIN(maxSize, myMinSize+INT((maxSize-myMinSize+1)*g)) + pSize = MIN(maxSize, myMinSize + INT((maxSize - myMinSize + 1)*g)) CPASSERT(SIZE(p) >= pSize) CALL RANDOM_NUMBER(p) DO i = 1, pSize - p(i) = REAL(INT(p(i)*200.0_dp-100.0_dp), dp)/100.0_dp + p(i) = REAL(INT(p(i)*200.0_dp - 100.0_dp), dp)/100.0_dp END DO - DO i = pSize+1, SIZE(p) + DO i = pSize + 1, SIZE(p) p(i) = 0.0_dp END DO res = pSize @@ -882,7 +882,7 @@ SUBROUTINE poly_affine_t3t(p, m, b, pRes, npoly) basepoly(1, :) = b DO j = 1, 3 DO i = 1, 3 - basepoly(j+1, i) = m(i, j) + basepoly(j + 1, i) = m(i, j) END DO END DO size_p = SIZE(pRes)/my_npoly @@ -897,20 +897,20 @@ SUBROUTINE poly_affine_t3t(p, m, b, pRes, npoly) ii = 1 DO ipoly = 1, my_npoly pRes(ii1) = p(ii) - ii = ii+size_res - ii1 = ii1+size_p + ii = ii + size_res + ii1 = ii1 + size_p END DO IF (size_p == 1) RETURN - ALLOCATE (monoG1((grad+1)*(grad+2)/2*minResSize), & - monoG2((grad+1)*(grad+2)/2*minResSize)) + ALLOCATE (monoG1((grad + 1)*(grad + 2)/2*minResSize), & + monoG2((grad + 1)*(grad + 2)/2*minResSize)) !monoG1=0 !monoG2=0 ii1 = 1 DO j = 1, 3 DO i = 1, 4 monoG1(ii1) = basepoly(i, j) - ii1 = ii1+1 + ii1 = ii1 + 1 END DO END DO ii1 = 2 @@ -918,7 +918,7 @@ SUBROUTINE poly_affine_t3t(p, m, b, pRes, npoly) monoDim1 = 4 monoSize1 = 3 monoFullDim1 = monoDim1*monoSize1 - rest_size_p = size_p-1 + rest_size_p = size_p - 1 DO k = MIN(rest_size_p, monoSize1) !call dgemm('T','N',monoDim1,my_npoly,k,& @@ -930,37 +930,37 @@ SUBROUTINE poly_affine_t3t(p, m, b, pRes, npoly) ii = 1 DO pcoeff = 1, k DO rescoeff = 1, monoDim1 - pRes(pIdx) = pRes(pIdx)+p(resShift+rescoeff)*monoG1(ii) - ii = ii+1 + pRes(pIdx) = pRes(pIdx) + p(resShift + rescoeff)*monoG1(ii) + ii = ii + 1 END DO - pIdx = pIdx+1 + pIdx = pIdx + 1 END DO - resShift = resShift+size_res - pShift = pShift+size_p + resShift = resShift + size_res + pShift = pShift + size_p END DO - rest_size_p = rest_size_p-k - ii1 = ii1+k + rest_size_p = rest_size_p - k + ii1 = ii1 + k IF (rest_size_p <= 0) EXIT - monoSize2 = igrad+2+monoSize1 - monoDim2 = monoDim1+monoSize2 + monoSize2 = igrad + 2 + monoSize1 + monoDim2 = monoDim1 + monoSize2 monoFullDim2 = monoSize2*monoDim2 monoDimAtt = monoSize1*monoDim2 CALL poly_mult3ab(IF_CHECK(monoG1(1:monoFullDim1), monoG1(1)), monoFullDim1, igrad, & IF_CHECK(basepoly(:, 1), basepoly(1, 1)), & IF_CHECK(monoG2(1:monoDimAtt), monoG2(1)), monoDimAtt, monoSize1, .FALSE.) - monoDimAtt2 = monoFullDim2-monoDim2 - start_idx1 = (monoSize1-igrad-1)*monoDim1 - CALL poly_mult3ab(IF_CHECK(monoG1(start_idx1+1:monoFullDim1), monoG1(start_idx1+1)), & - monoFullDim1-start_idx1, igrad, IF_CHECK(basepoly(:, 2), basepoly(1, 2)), & - IF_CHECK(monoG2(monoDimAtt+1:monoDimAtt2), monoG2(monoDimAtt+1)), & - monoDimAtt2-monoDimAtt, igrad+1, .FALSE.) - CALL poly_mult3ab(IF_CHECK(monoG1(monoFullDim1-monoDim1+1:monoFullDim1), monoG1(monoFullDim1-monoDim1+1)), & + monoDimAtt2 = monoFullDim2 - monoDim2 + start_idx1 = (monoSize1 - igrad - 1)*monoDim1 + CALL poly_mult3ab(IF_CHECK(monoG1(start_idx1 + 1:monoFullDim1), monoG1(start_idx1 + 1)), & + monoFullDim1 - start_idx1, igrad, IF_CHECK(basepoly(:, 2), basepoly(1, 2)), & + IF_CHECK(monoG2(monoDimAtt + 1:monoDimAtt2), monoG2(monoDimAtt + 1)), & + monoDimAtt2 - monoDimAtt, igrad + 1, .FALSE.) + CALL poly_mult3ab(IF_CHECK(monoG1(monoFullDim1 - monoDim1 + 1:monoFullDim1), monoG1(monoFullDim1 - monoDim1 + 1)), & monoDim1, igrad, IF_CHECK(basepoly(:, 3), basepoly(1, 3)), & - IF_CHECK(monoG2(monoDimAtt2+1:monoFullDim2), monoG2(monoDimAtt2+1)), & - monoFullDim2-monoDimAtt2, 1, .FALSE.) - igrad = igrad+1 + IF_CHECK(monoG2(monoDimAtt2 + 1:monoFullDim2), monoG2(monoDimAtt2 + 1)), & + monoFullDim2 - monoDimAtt2, 1, .FALSE.) + igrad = igrad + 1 ! even grads @@ -974,37 +974,37 @@ SUBROUTINE poly_affine_t3t(p, m, b, pRes, npoly) ii = 1 DO pcoeff = 1, k DO rescoeff = 1, monoDim2 - pRes(pIdx) = pRes(pIdx)+p(resShift+rescoeff)*monoG2(ii) - ii = ii+1 + pRes(pIdx) = pRes(pIdx) + p(resShift + rescoeff)*monoG2(ii) + ii = ii + 1 END DO - pIdx = pIdx+1 + pIdx = pIdx + 1 END DO - resShift = resShift+size_res - pShift = pShift+size_p + resShift = resShift + size_res + pShift = pShift + size_p END DO - rest_size_p = rest_size_p-k - ii1 = ii1+k + rest_size_p = rest_size_p - k + ii1 = ii1 + k IF (rest_size_p <= 0) EXIT - monoSize1 = igrad+2+monoSize2 - monoDim1 = monoDim2+monoSize1 + monoSize1 = igrad + 2 + monoSize2 + monoDim1 = monoDim2 + monoSize1 monoFullDim1 = monoSize1*monoDim1 monoDimAtt = monoSize2*monoDim1 CALL poly_mult3ab(IF_CHECK(monoG2(1:monoFullDim2), monoG2(1)), monoFullDim2, igrad, & IF_CHECK(basepoly(:, 1), basepoly(1, 1)), IF_CHECK(monoG1(1:monoDimAtt), monoG1(1)), & monoDimAtt, monoSize2, .FALSE.) - monoDimAtt2 = monoFullDim1-monoDim1 - start_idx1 = (monoSize2-igrad-1)*monoDim2 - CALL poly_mult3ab(IF_CHECK(monoG2(start_idx1+1:monoFullDim2), monoG2(start_idx1+1)), & - monoFullDim2-start_idx1, igrad, IF_CHECK(basepoly(:, 2), basepoly(1, 2)), & - IF_CHECK(monoG1(monoDimAtt+1:monoDimAtt2), monoG1(monoDimAtt+1)), monoDimAtt2-monoDimAtt, & - igrad+1, .FALSE.) - CALL poly_mult3ab(IF_CHECK(monoG2(monoFullDim2-monoDim2+1:monoFullDim2), monoG2(monoFullDim2-monoDim2+1)), & + monoDimAtt2 = monoFullDim1 - monoDim1 + start_idx1 = (monoSize2 - igrad - 1)*monoDim2 + CALL poly_mult3ab(IF_CHECK(monoG2(start_idx1 + 1:monoFullDim2), monoG2(start_idx1 + 1)), & + monoFullDim2 - start_idx1, igrad, IF_CHECK(basepoly(:, 2), basepoly(1, 2)), & + IF_CHECK(monoG1(monoDimAtt + 1:monoDimAtt2), monoG1(monoDimAtt + 1)), monoDimAtt2 - monoDimAtt, & + igrad + 1, .FALSE.) + CALL poly_mult3ab(IF_CHECK(monoG2(monoFullDim2 - monoDim2 + 1:monoFullDim2), monoG2(monoFullDim2 - monoDim2 + 1)), & monoDim2, igrad, IF_CHECK(basepoly(:, 3), basepoly(1, 3)), & - IF_CHECK(monoG1(monoDimAtt2+1:monoFullDim1), monoG1(monoDimAtt2+1)), & - monoFullDim1-monoDimAtt2, 1, .FALSE.) - igrad = igrad+1 + IF_CHECK(monoG1(monoDimAtt2 + 1:monoFullDim1), monoG1(monoDimAtt2 + 1)), & + monoFullDim1 - monoDimAtt2, 1, .FALSE.) + igrad = igrad + 1 ! ! alterantive to unrolling ! monoG1=monoG2 @@ -1044,7 +1044,7 @@ SUBROUTINE poly_affine_t3(p, m, b, pRes, npoly) basepoly(1, :) = b DO j = 1, 3 DO i = 1, 3 - basepoly(j+1, i) = m(i, j) + basepoly(j + 1, i) = m(i, j) END DO END DO size_p = SIZE(p)/my_npoly @@ -1058,20 +1058,20 @@ SUBROUTINE poly_affine_t3(p, m, b, pRes, npoly) ii = 1 DO ipoly = 1, my_npoly pRes(ii) = p(ii1) - ii = ii+size_res - ii1 = ii1+size_p + ii = ii + size_res + ii1 = ii1 + size_p END DO IF (size_p == 1) RETURN - ALLOCATE (monoG1((grad+1)*(grad+2)/2*minResSize), & - monoG2((grad+1)*(grad+2)/2*minResSize)) + ALLOCATE (monoG1((grad + 1)*(grad + 2)/2*minResSize), & + monoG2((grad + 1)*(grad + 2)/2*minResSize)) monoG1 = 0 monoG2 = 0 ii1 = 1 DO j = 1, 3 DO i = 1, 4 monoG1(ii1) = basepoly(i, j) - ii1 = ii1+1 + ii1 = ii1 + 1 END DO END DO ii1 = 2 @@ -1079,7 +1079,7 @@ SUBROUTINE poly_affine_t3(p, m, b, pRes, npoly) monoDim1 = 4 monoSize1 = 3 monoFullDim1 = monoDim1*monoSize1 - rest_size_p = size_p-1 + rest_size_p = size_p - 1 DO k = MIN(rest_size_p, monoSize1) !call dgemm('T','N',monoDim1,my_npoly,k,& @@ -1091,37 +1091,37 @@ SUBROUTINE poly_affine_t3(p, m, b, pRes, npoly) ii = 1 DO pcoeff = 1, k DO rescoeff = 1, monoDim1 - pRes(resShift+rescoeff) = pRes(resShift+rescoeff)+p(pIdx)*monoG1(ii) - ii = ii+1 + pRes(resShift + rescoeff) = pRes(resShift + rescoeff) + p(pIdx)*monoG1(ii) + ii = ii + 1 END DO - pIdx = pIdx+1 + pIdx = pIdx + 1 END DO - resShift = resShift+size_res - pShift = pShift+size_p + resShift = resShift + size_res + pShift = pShift + size_p END DO - rest_size_p = rest_size_p-k - ii1 = ii1+k + rest_size_p = rest_size_p - k + ii1 = ii1 + k IF (rest_size_p <= 0) EXIT - monoSize2 = igrad+2+monoSize1 - monoDim2 = monoDim1+monoSize2 + monoSize2 = igrad + 2 + monoSize1 + monoDim2 = monoDim1 + monoSize2 monoFullDim2 = monoSize2*monoDim2 monoDimAtt = monoSize1*monoDim2 CALL poly_mult3ab(IF_CHECK(monoG1(1:monoFullDim1), monoG1(1)), monoFullDim1, igrad, & IF_CHECK(basepoly(:, 1), basepoly(1, 1)), & IF_CHECK(monoG2(1:monoDimAtt), monoG2(1)), monoDimAtt, monoSize1, .FALSE.) - monoDimAtt2 = monoFullDim2-monoDim2 - start_idx1 = (monoSize1-igrad-1)*monoDim1 - CALL poly_mult3ab(IF_CHECK(monoG1(start_idx1+1:monoFullDim1), monoG1(start_idx1+1)), & - monoFullDim1-start_idx1, igrad, IF_CHECK(basepoly(:, 2), basepoly(1, 2)), & - IF_CHECK(monoG2(monoDimAtt+1:monoDimAtt2), monoG2(monoDimAtt+1)), & - monoDimAtt2-monoDimAtt, igrad+1, .FALSE.) - CALL poly_mult3ab(IF_CHECK(monoG1(monoFullDim1-monoDim1+1:monoFullDim1), monoG1(monoFullDim1-monoDim1+1)), & + monoDimAtt2 = monoFullDim2 - monoDim2 + start_idx1 = (monoSize1 - igrad - 1)*monoDim1 + CALL poly_mult3ab(IF_CHECK(monoG1(start_idx1 + 1:monoFullDim1), monoG1(start_idx1 + 1)), & + monoFullDim1 - start_idx1, igrad, IF_CHECK(basepoly(:, 2), basepoly(1, 2)), & + IF_CHECK(monoG2(monoDimAtt + 1:monoDimAtt2), monoG2(monoDimAtt + 1)), & + monoDimAtt2 - monoDimAtt, igrad + 1, .FALSE.) + CALL poly_mult3ab(IF_CHECK(monoG1(monoFullDim1 - monoDim1 + 1:monoFullDim1), monoG1(monoFullDim1 - monoDim1 + 1)), & monoDim1, igrad, IF_CHECK(basepoly(:, 3), basepoly(1, 3)), & - IF_CHECK(monoG2(monoDimAtt2+1:monoFullDim2), monoG2(monoDimAtt2+1)), & - monoFullDim2-monoDimAtt2, 1, .FALSE.) - igrad = igrad+1 + IF_CHECK(monoG2(monoDimAtt2 + 1:monoFullDim2), monoG2(monoDimAtt2 + 1)), & + monoFullDim2 - monoDimAtt2, 1, .FALSE.) + igrad = igrad + 1 ! even grads @@ -1135,38 +1135,38 @@ SUBROUTINE poly_affine_t3(p, m, b, pRes, npoly) ii = 1 DO pcoeff = 1, k DO rescoeff = 1, monoDim2 - pRes(resShift+rescoeff) = pRes(resShift+rescoeff)+p(pIdx)*monoG2(ii) - ii = ii+1 + pRes(resShift + rescoeff) = pRes(resShift + rescoeff) + p(pIdx)*monoG2(ii) + ii = ii + 1 END DO - pIdx = pIdx+1 + pIdx = pIdx + 1 END DO - resShift = resShift+size_res - pShift = pShift+size_p + resShift = resShift + size_res + pShift = pShift + size_p END DO - rest_size_p = rest_size_p-k - ii1 = ii1+k + rest_size_p = rest_size_p - k + ii1 = ii1 + k IF (rest_size_p <= 0) EXIT - monoSize1 = igrad+2+monoSize2 - monoDim1 = monoDim2+monoSize1 + monoSize1 = igrad + 2 + monoSize2 + monoDim1 = monoDim2 + monoSize1 monoFullDim1 = monoSize1*monoDim1 monoDimAtt = monoSize2*monoDim1 CALL poly_mult3ab(IF_CHECK(monoG2(1:monoFullDim2), monoG2(1)), monoFullDim2, igrad, & IF_CHECK(basepoly(:, 1), basepoly(1, 1)), & IF_CHECK(monoG1(1:monoDimAtt), monoG1(1)), monoDimAtt, monoSize2, .FALSE.) - monoDimAtt2 = monoFullDim1-monoDim1 - start_idx1 = (monoSize2-igrad-1)*monoDim2 - CALL poly_mult3ab(IF_CHECK(monoG2(start_idx1+1:monoFullDim2), monoG2(start_idx1+1)), & - monoFullDim2-start_idx1, igrad, & + monoDimAtt2 = monoFullDim1 - monoDim1 + start_idx1 = (monoSize2 - igrad - 1)*monoDim2 + CALL poly_mult3ab(IF_CHECK(monoG2(start_idx1 + 1:monoFullDim2), monoG2(start_idx1 + 1)), & + monoFullDim2 - start_idx1, igrad, & IF_CHECK(basepoly(:, 2), basepoly(1, 2)), & - IF_CHECK(monoG1(monoDimAtt+1:monoDimAtt2), monoG1(monoDimAtt+1)), monoDimAtt2-monoDimAtt, & - igrad+1, .FALSE.) - CALL poly_mult3ab(IF_CHECK(monoG2(monoFullDim2-monoDim2+1:monoFullDim2), monoG2(monoFullDim2-monoDim2+1)), & + IF_CHECK(monoG1(monoDimAtt + 1:monoDimAtt2), monoG1(monoDimAtt + 1)), monoDimAtt2 - monoDimAtt, & + igrad + 1, .FALSE.) + CALL poly_mult3ab(IF_CHECK(monoG2(monoFullDim2 - monoDim2 + 1:monoFullDim2), monoG2(monoFullDim2 - monoDim2 + 1)), & monoDim2, igrad, IF_CHECK(basepoly(:, 3), basepoly(1, 3)), & - IF_CHECK(monoG1(monoDimAtt2+1:monoFullDim1), monoG1(monoDimAtt2+1)), & - monoFullDim1-monoDimAtt2, 1, .FALSE.) - igrad = igrad+1 + IF_CHECK(monoG1(monoDimAtt2 + 1:monoFullDim1), monoG1(monoDimAtt2 + 1)), & + monoFullDim1 - monoDimAtt2, 1, .FALSE.) + igrad = igrad + 1 ! ! alterantive to unrolling ! monoG1=monoG2 @@ -1203,7 +1203,7 @@ SUBROUTINE poly_p_eval3(p, x, pRes, npoly) newSize = SIZE(pRes)/my_npoly CPASSERT(newSize >= poly_size2(grad)) pRes = 0.0 - ALLOCATE (xi(grad+1)) + ALLOCATE (xi(grad + 1)) CALL poly_p_eval3b(p, SIZE(p), x, pRes, SIZE(pRes), my_npoly, grad, xi) DEALLOCATE (xi) END SUBROUTINE @@ -1243,24 +1243,24 @@ SUBROUTINE poly_p_eval3b(p, size_p, x, pRes, size_pRes, npoly, grad, xi) pRes(1:size_pRes) = 0.0 xi(1) = 1.0 DO i = 1, grad - xi(i+1) = xi(i)*x + xi(i + 1) = xi(i)*x END DO shiftRes = 0 pShift = 0 DO ipoly = 1, npoly DO ii = 1, MIN(inSize, cached_dim3) - pRes(shiftRes+a_reduce_idx3(ii)) = pRes(shiftRes+a_reduce_idx3(ii))+p(pShift+ii)*xi(a_mono_exp3(1, ii)+1) + pRes(shiftRes + a_reduce_idx3(ii)) = pRes(shiftRes + a_reduce_idx3(ii)) + p(pShift + ii)*xi(a_mono_exp3(1, ii) + 1) END DO - shiftRes = shiftRes+newSize - pShift = pShift+inSize + shiftRes = shiftRes + newSize + pShift = pShift + inSize END DO IF (grad > max_grad3) THEN - ii0 = (max_grad3+1)*(max_grad3+2)*(max_grad3+3)/6+1 + ii0 = (max_grad3 + 1)*(max_grad3 + 2)*(max_grad3 + 3)/6 + 1 shiftRes_0 = 1 msize_p = inSize DO ipoly = 1, npoly ii = ii0 - grad_do: DO igrad = max_grad3+1, grad + grad_do: DO igrad = max_grad3 + 1, grad !ii=igrad*(igrad+1)*(igrad+2)/6+1 shiftRes = shiftRes_0 subG = 0 @@ -1269,16 +1269,16 @@ SUBROUTINE poly_p_eval3b(p, size_p, x, pRes, size_pRes, npoly, grad, xi) !shiftRes=subG*(subG+3)/2+1 DO j = subG, 0, -1 IF (msize_p < ii) EXIT grad_do - pRes(shiftRes-j) = pRes(shiftRes-j)+p(ii)*xi(i+1) - ii = ii+1 + pRes(shiftRes - j) = pRes(shiftRes - j) + p(ii)*xi(i + 1) + ii = ii + 1 END DO - shiftRes = shiftRes+subG+2 - subG = subG+1 + shiftRes = shiftRes + subG + 2 + subG = subG + 1 END DO END DO grad_do - ii0 = ii0+inSize - shiftRes_0 = shiftRes_0+newSize - msize_p = msize_p+inSize + ii0 = ii0 + inSize + shiftRes_0 = shiftRes_0 + newSize + msize_p = msize_p + inSize END DO END IF END SUBROUTINE @@ -1312,7 +1312,7 @@ SUBROUTINE poly_padd_uneval3(p, x, pRes, npoly) grad = grad_size2(newSize) CPASSERT(size_p >= poly_size3(grad)) CPASSERT(newSize == poly_size2(grad)) - ALLOCATE (xi(grad+1)) + ALLOCATE (xi(grad + 1)) CALL poly_padd_uneval3b(p, SIZE(p), x, pRes, SIZE(pRes), my_npoly, grad, xi) DEALLOCATE (xi) END SUBROUTINE @@ -1351,27 +1351,27 @@ SUBROUTINE poly_padd_uneval3b(p, size_p, x, pRes, size_pRes, npoly, grad, xi) IF (.NOT. module_initialized) CPABORT("module d3_poly not initialized") inSize = size_p/npoly newSize = size_pRes/npoly - upSize = (grad+1)*(grad+2)*(grad+3)/6 + upSize = (grad + 1)*(grad + 2)*(grad + 3)/6 xi(1) = 1.0 DO i = 1, grad - xi(i+1) = xi(i)*x + xi(i + 1) = xi(i)*x END DO shiftRes = 0 pShift = 0 DO ipoly = 1, npoly DO ii = 1, MIN(upSize, cached_dim3) - p(pShift+ii) = p(pShift+ii)+pRes(shiftRes+a_reduce_idx3(ii))*xi(a_mono_exp3(1, ii)+1) + p(pShift + ii) = p(pShift + ii) + pRes(shiftRes + a_reduce_idx3(ii))*xi(a_mono_exp3(1, ii) + 1) END DO - shiftRes = shiftRes+newSize - pShift = pShift+inSize + shiftRes = shiftRes + newSize + pShift = pShift + inSize END DO IF (grad > max_grad3) THEN - ii0 = (max_grad3+1)*(max_grad3+2)*(max_grad3+3)/6+1 + ii0 = (max_grad3 + 1)*(max_grad3 + 2)*(max_grad3 + 3)/6 + 1 shiftRes_0 = 1 msize_p = upSize DO ipoly = 1, npoly ii = ii0 - grad_do: DO igrad = max_grad3+1, grad + grad_do: DO igrad = max_grad3 + 1, grad !ii=igrad*(igrad+1)*(igrad+2)/6+1 shiftRes = shiftRes_0 subG = 0 @@ -1380,16 +1380,16 @@ SUBROUTINE poly_padd_uneval3b(p, size_p, x, pRes, size_pRes, npoly, grad, xi) !shiftRes=subG*(subG+3)/2+1 DO j = subG, 0, -1 IF (msize_p < ii) EXIT grad_do - p(ii) = p(ii)+pRes(shiftRes-j)*xi(i+1) - ii = ii+1 + p(ii) = p(ii) + pRes(shiftRes - j)*xi(i + 1) + ii = ii + 1 END DO - shiftRes = shiftRes+subG+2 - subG = subG+1 + shiftRes = shiftRes + subG + 2 + subG = subG + 1 END DO END DO grad_do - ii0 = ii0+inSize - shiftRes_0 = shiftRes_0+newSize - msize_p = msize_p+inSize + ii0 = ii0 + inSize + shiftRes_0 = shiftRes_0 + newSize + msize_p = msize_p + inSize END DO END IF END SUBROUTINE @@ -1420,7 +1420,7 @@ SUBROUTINE poly_p_eval2(p, x, pRes, npoly) newSize = SIZE(pRes)/my_npoly pRes = 0.0_dp CPASSERT(newSize >= poly_size1(grad)) - ALLOCATE (xi(grad+1)) + ALLOCATE (xi(grad + 1)) CALL poly_p_eval2b(p, SIZE(p), x, pRes, SIZE(pRes), my_npoly, grad, xi) DEALLOCATE (xi) END SUBROUTINE @@ -1460,37 +1460,37 @@ SUBROUTINE poly_p_eval2b(p, size_p, x, pRes, size_pRes, npoly, grad, xi) !CPPreconditionNoFail(newSize>grad,cp_failure_level,routineP) xi(1) = 1.0_dp DO i = 1, grad - xi(i+1) = xi(i)*x + xi(i + 1) = xi(i)*x END DO shiftRes = 1 pShift = 0 DO ipoly = 1, npoly DO ii = 1, MIN(inSize, cached_dim2) - pRes(shiftRes+a_mono_exp2(2, ii)) = pRes(shiftRes+a_mono_exp2(2, ii))+p(pShift+ii)*xi(a_mono_exp2(1, ii)+1) + pRes(shiftRes + a_mono_exp2(2, ii)) = pRes(shiftRes + a_mono_exp2(2, ii)) + p(pShift + ii)*xi(a_mono_exp2(1, ii) + 1) END DO - shiftRes = shiftRes+newSize - pShift = pShift+inSize + shiftRes = shiftRes + newSize + pShift = pShift + inSize END DO IF (grad > max_grad2) THEN - ii0 = (max_grad2+1)*(max_grad2+2)/2+1 + ii0 = (max_grad2 + 1)*(max_grad2 + 2)/2 + 1 shiftRes = 1 msize_p = inSize DO ipoly = 1, npoly ii = ii0 - grad_do2: DO igrad = max_grad2+1, grad + grad_do2: DO igrad = max_grad2 + 1, grad !ii=igrad*(igrad+1)/2+1 ij = shiftRes DO i = igrad, 0, -1 IF (msize_p < ii) EXIT grad_do2 ! ij=igrad-i - pRes(ij) = pRes(ij)+p(ii)*xi(i+1) - ii = ii+1 - ij = ij+1 + pRes(ij) = pRes(ij) + p(ii)*xi(i + 1) + ii = ii + 1 + ij = ij + 1 END DO END DO grad_do2 - msize_p = msize_p+inSize - shiftRes = shiftRes+newSize - ii0 = ii0+inSize + msize_p = msize_p + inSize + shiftRes = shiftRes + newSize + ii0 = ii0 + inSize END DO END IF END SUBROUTINE @@ -1524,7 +1524,7 @@ SUBROUTINE poly_padd_uneval2(p, x, pRes, npoly) grad = grad_size1(newSize) CPASSERT(size_p >= poly_size2(grad)) CPASSERT(newSize == poly_size1(grad)) - ALLOCATE (xi(grad+1)) + ALLOCATE (xi(grad + 1)) CALL poly_padd_uneval2b(p, SIZE(p), x, pRes, SIZE(pRes), my_npoly, grad, xi) DEALLOCATE (xi) END SUBROUTINE @@ -1561,42 +1561,42 @@ SUBROUTINE poly_padd_uneval2b(p, size_p, x, pRes, size_pRes, npoly, grad, xi) IF (.NOT. module_initialized) CPABORT("module d3_poly not initialized") inSize = size_p/npoly - upSize = (grad+1)*(grad+2)/2 + upSize = (grad + 1)*(grad + 2)/2 newSize = size_pRes/npoly !CPPreconditionNoFail(newSize>grad,cp_failure_level,routineP) xi(1) = 1.0_dp DO i = 1, grad - xi(i+1) = xi(i)*x + xi(i + 1) = xi(i)*x END DO shiftRes = 1 pShift = 0 DO ipoly = 1, npoly DO ii = 1, MIN(upSize, cached_dim2) - p(pShift+ii) = p(pShift+ii)+pRes(shiftRes+a_mono_exp2(2, ii))*xi(a_mono_exp2(1, ii)+1) + p(pShift + ii) = p(pShift + ii) + pRes(shiftRes + a_mono_exp2(2, ii))*xi(a_mono_exp2(1, ii) + 1) END DO - shiftRes = shiftRes+newSize - pShift = pShift+inSize + shiftRes = shiftRes + newSize + pShift = pShift + inSize END DO IF (grad > max_grad2) THEN - ii0 = (max_grad2+1)*(max_grad2+2)/2+1 + ii0 = (max_grad2 + 1)*(max_grad2 + 2)/2 + 1 shiftRes = 1 msize_p = upSize DO ipoly = 1, npoly ii = ii0 - grad_do2: DO igrad = max_grad2+1, grad + grad_do2: DO igrad = max_grad2 + 1, grad !ii=igrad*(igrad+1)/2+1 ij = shiftRes DO i = igrad, 0, -1 IF (msize_p < ii) EXIT grad_do2 ! ij=igrad-i - p(ii) = p(ii)+pRes(ij)*xi(i+1) - ii = ii+1 - ij = ij+1 + p(ii) = p(ii) + pRes(ij)*xi(i + 1) + ii = ii + 1 + ij = ij + 1 END DO END DO grad_do2 - msize_p = msize_p+inSize - shiftRes = shiftRes+newSize - ii0 = ii0+inSize + msize_p = msize_p + inSize + shiftRes = shiftRes + newSize + ii0 = ii0 + inSize END DO END IF END SUBROUTINE @@ -1628,11 +1628,11 @@ SUBROUTINE poly_eval1(p, x, pRes, npoly) xx = 1.0_dp vv = 0.0_dp DO i = 1, size_p - vv = vv+p(pShift+i)*xx + vv = vv + p(pShift + i)*xx xx = xx*x END DO pRes(ipoly) = vv - pShift = pShift+size_p + pShift = pShift + size_p END DO END SUBROUTINE @@ -1663,43 +1663,43 @@ SUBROUTINE poly_eval2(p, x, y, pRes, npoly) size_p = SIZE(p)/my_npoly grad = grad_size2(size_p) CPASSERT(SIZE(pRes) >= my_npoly) - ALLOCATE (xi(grad+1), yi(grad+1)) + ALLOCATE (xi(grad + 1), yi(grad + 1)) xi(1) = 1.0_dp DO i = 1, grad - xi(i+1) = xi(i)*x + xi(i + 1) = xi(i)*x END DO yi(1) = 1.0_dp DO i = 1, grad - yi(i+1) = yi(i)*y + yi(i + 1) = yi(i)*y END DO pShift = 0 DO ipoly = 1, my_npoly v = 0.0_dp DO ii = 1, MIN(size_p, cached_dim2) - v = v+p(pShift+ii)*xi(a_mono_exp2(1, ii)+1)*yi(a_mono_exp2(2, ii)+1) + v = v + p(pShift + ii)*xi(a_mono_exp2(1, ii) + 1)*yi(a_mono_exp2(2, ii) + 1) END DO pRes(ipoly) = v - pShift = pShift+size_p + pShift = pShift + size_p END DO IF (grad > max_grad2) THEN - pShift = (max_grad2+1)*(max_grad2+2)/2+1 + pShift = (max_grad2 + 1)*(max_grad2 + 2)/2 + 1 msize_p = size_p DO ipoly = 1, my_npoly ii = pShift v = 0.0_dp - grad_do4: DO igrad = max_grad2+1, grad + grad_do4: DO igrad = max_grad2 + 1, grad ! ii=igrad*(igrad+1)*(igrad+2)/6+1 j = 1 DO i = igrad, 0, -1 IF (msize_p < ii) EXIT grad_do4 - v = v+p(ii)*xi(i+1)*yi(j) - j = j+1 - ii = ii+1 + v = v + p(ii)*xi(i + 1)*yi(j) + j = j + 1 + ii = ii + 1 END DO END DO grad_do4 - pRes(ipoly) = pRes(ipoly)+v - pShift = pShift+size_p - msize_p = msize_p+size_p + pRes(ipoly) = pRes(ipoly) + v + pShift = pShift + size_p + msize_p = msize_p + size_p END DO END IF END SUBROUTINE @@ -1732,51 +1732,51 @@ SUBROUTINE poly_eval3(p, x, y, z, pRes, npoly) size_p = SIZE(p)/my_npoly grad = grad_size3(size_p) CPASSERT(SIZE(pRes) >= my_npoly) - ALLOCATE (xi(grad+1), yi(grad+1), zi(grad+1)) + ALLOCATE (xi(grad + 1), yi(grad + 1), zi(grad + 1)) xi(1) = 1.0_dp DO i = 1, grad - xi(i+1) = xi(i)*x + xi(i + 1) = xi(i)*x END DO yi(1) = 1.0_dp DO i = 1, grad - yi(i+1) = yi(i)*y + yi(i + 1) = yi(i)*y END DO zi(1) = 1.0_dp DO i = 1, grad - zi(i+1) = zi(i)*z + zi(i + 1) = zi(i)*z END DO pShift = 0 DO ipoly = 1, my_npoly v = 0.0_dp DO ii = 1, MIN(size_p, cached_dim3) - v = v+p(pShift+ii)*xi(a_mono_exp3(1, ii)+1)*yi(a_mono_exp3(2, ii)+1) & - *zi(a_mono_exp3(3, ii)+1) + v = v + p(pShift + ii)*xi(a_mono_exp3(1, ii) + 1)*yi(a_mono_exp3(2, ii) + 1) & + *zi(a_mono_exp3(3, ii) + 1) END DO pRes(ipoly) = v - pShift = pShift+size_p + pShift = pShift + size_p END DO IF (grad > max_grad3) THEN - pShift = (max_grad3+1)*(max_grad3+2)*(max_grad3+3)/6+1 + pShift = (max_grad3 + 1)*(max_grad3 + 2)*(max_grad3 + 3)/6 + 1 msize_p = size_p DO ipoly = 1, my_npoly ii = pShift v = 0.0_dp - grad_do3: DO igrad = max_grad3+1, grad + grad_do3: DO igrad = max_grad3 + 1, grad ! ii=igrad*(igrad+1)*(igrad+2)/6+1 DO i = igrad, 0, -1 k = 1 - DO j = igrad-i, 0, -1 - ii = (ipoly-1)*size_p+mono_index3(i, j, igrad-i-j)+1 + DO j = igrad - i, 0, -1 + ii = (ipoly - 1)*size_p + mono_index3(i, j, igrad - i - j) + 1 IF (msize_p < ii) EXIT grad_do3 - v = v+p(ii)*xi(i+1)*yi(j+1)*zi(k) - k = k+1 - ii = ii+1 + v = v + p(ii)*xi(i + 1)*yi(j + 1)*zi(k) + k = k + 1 + ii = ii + 1 END DO END DO END DO grad_do3 - pRes(ipoly) = pRes(ipoly)+v - pShift = pShift+size_p - msize_p = msize_p+size_p + pRes(ipoly) = pRes(ipoly) + v + pShift = pShift + size_p + msize_p = msize_p + size_p END DO END IF END SUBROUTINE @@ -1811,57 +1811,57 @@ SUBROUTINE poly_derive3(p, pRes, npoly, sumUp) CPASSERT(newSize >= poly_size3(grad)) IF (.NOT. my_sumUp) pRes = 0 xDerivShift = 1 - yDerivShift = my_npoly*newSize+1 - zDerivShift = 2*yDerivShift-1 + yDerivShift = my_npoly*newSize + 1 + zDerivShift = 2*yDerivShift - 1 pShift = 0 DO ipoly = 1, my_npoly ! split derivs to have less streams to follow (3 vs 5)? DO ii = 1, MIN(cached_dim3, size_p) - pRes(xDerivShift+a_deriv_idx3(1, ii)) = pRes(xDerivShift+a_deriv_idx3(1, ii)) & - +p(pShift+ii)*a_mono_exp3(1, ii) - pRes(yDerivShift+a_deriv_idx3(2, ii)) = pRes(yDerivShift+a_deriv_idx3(2, ii)) & - +p(pShift+ii)*a_mono_exp3(2, ii) - pRes(zDerivShift+a_deriv_idx3(3, ii)) = pRes(zDerivShift+a_deriv_idx3(3, ii)) & - +p(pShift+ii)*a_mono_exp3(3, ii) + pRes(xDerivShift + a_deriv_idx3(1, ii)) = pRes(xDerivShift + a_deriv_idx3(1, ii)) & + + p(pShift + ii)*a_mono_exp3(1, ii) + pRes(yDerivShift + a_deriv_idx3(2, ii)) = pRes(yDerivShift + a_deriv_idx3(2, ii)) & + + p(pShift + ii)*a_mono_exp3(2, ii) + pRes(zDerivShift + a_deriv_idx3(3, ii)) = pRes(zDerivShift + a_deriv_idx3(3, ii)) & + + p(pShift + ii)*a_mono_exp3(3, ii) END DO - xDerivShift = xDerivShift+newSize - yDerivShift = yDerivShift+newSize - zDerivShift = zDerivShift+newSize - pShift = pShift+size_p + xDerivShift = xDerivShift + newSize + yDerivShift = yDerivShift + newSize + zDerivShift = zDerivShift + newSize + pShift = pShift + size_p END DO IF (grad > max_grad3) THEN xDerivShift = 0 yDerivShift = my_npoly*newSize - zDerivShift = 2*yDerivShift-1 + zDerivShift = 2*yDerivShift - 1 msize_p = size_p - xDerivShift = max_grad3*(max_grad3+1)*(max_grad3+2)/6+1 - pShift = xDerivShift+(max_grad3+1)*(max_grad3+2)/2 + xDerivShift = max_grad3*(max_grad3 + 1)*(max_grad3 + 2)/6 + 1 + pShift = xDerivShift + (max_grad3 + 1)*(max_grad3 + 2)/2 DO ipoly = 1, my_npoly ii = pShift ii2 = xDerivShift - grad_do5: DO igrad = max_grad3+1, grad + grad_do5: DO igrad = max_grad3 + 1, grad yShift = yDerivShift zShift = zDerivShift DO i = igrad, 0, -1 k = 0 - DO j = igrad-i, 0, -1 + DO j = igrad - i, 0, -1 IF (ii > msize_p) EXIT grad_do5 ! remove ifs? - IF (i > 0) pRes(ii2) = pRes(ii2)+p(ii)*i - IF (j > 0) pRes(yShift+ii2) = pRes(yShift+ii2)+p(ii)*j - IF (k > 0) pRes(zShift+ii2) = pRes(zShift+ii2)+k*p(ii) - ii = ii+1 - ii2 = ii2+1 - k = k+1 + IF (i > 0) pRes(ii2) = pRes(ii2) + p(ii)*i + IF (j > 0) pRes(yShift + ii2) = pRes(yShift + ii2) + p(ii)*j + IF (k > 0) pRes(zShift + ii2) = pRes(zShift + ii2) + k*p(ii) + ii = ii + 1 + ii2 = ii2 + 1 + k = k + 1 END DO - yShift = yShift-1 - zShift = zShift-1 + yShift = yShift - 1 + zShift = zShift - 1 END DO - ii2 = ii2-igrad-1 + ii2 = ii2 - igrad - 1 END DO grad_do5 - pShift = pShift+size_p - xDerivShift = xDerivShift+newSize - msize_p = msize_p+size_p + pShift = pShift + size_p + xDerivShift = xDerivShift + newSize + msize_p = msize_p + size_p END DO END IF END SUBROUTINE @@ -1883,37 +1883,37 @@ SUBROUTINE poly_cp2k2d3(poly_cp2k, grad, poly_d3) sgrad2, sgrad2k, sgrad3, sgrad3k, & shifti, shiftj, shiftk, size_p - size_p = (grad+1)*(grad+2)*(grad+3)/6 + size_p = (grad + 1)*(grad + 2)*(grad + 3)/6 CPASSERT(SIZE(poly_cp2k) >= size_p) CPASSERT(SIZE(poly_d3) >= size_p) cp_ii = 0 sgrad2k = 0 sgrad3k = 0 DO k = 0, grad - shiftk = k+1 - sgrad2k = sgrad2k+k - sgrad3k = sgrad3k+sgrad2k + shiftk = k + 1 + sgrad2k = sgrad2k + k + sgrad3k = sgrad3k + sgrad2k sgrad2 = sgrad2k sgrad3 = sgrad3k - DO j = 0, grad-k - sgrad = j+k + DO j = 0, grad - k + sgrad = j + k mgrad2 = sgrad2 - shiftj = mgrad2+shiftk + shiftj = mgrad2 + shiftk mgrad = sgrad - shifti = shiftj+sgrad3 - DO i = 0, grad-j-k - cp_ii = cp_ii+1 + shifti = shiftj + sgrad3 + DO i = 0, grad - j - k + cp_ii = cp_ii + 1 poly_d3(shifti) = poly_cp2k(cp_ii) - mgrad = mgrad+1 - mgrad2 = mgrad2+mgrad - shifti = shifti+mgrad2 + mgrad = mgrad + 1 + mgrad2 = mgrad2 + mgrad + shifti = shifti + mgrad2 END DO - sgrad2 = sgrad2+sgrad+1 - sgrad3 = sgrad3+sgrad2 + sgrad2 = sgrad2 + sgrad + 1 + sgrad3 = sgrad3 + sgrad2 END DO END DO IF (SIZE(poly_d3) >= size_p) THEN - poly_d3(size_p+1:) = 0.0_dp + poly_d3(size_p + 1:) = 0.0_dp END IF END SUBROUTINE @@ -1934,37 +1934,37 @@ SUBROUTINE poly_d32cp2k(poly_cp2k, grad, poly_d3) sgrad2, sgrad2k, sgrad3, sgrad3k, & shifti, shiftj, shiftk, size_p - size_p = (grad+1)*(grad+2)*(grad+3)/6 + size_p = (grad + 1)*(grad + 2)*(grad + 3)/6 CPASSERT(SIZE(poly_cp2k) >= size_p) CPASSERT(SIZE(poly_d3) >= size_p) cp_ii = 0 sgrad2k = 0 sgrad3k = 0 DO k = 0, grad - shiftk = k+1 - sgrad2k = sgrad2k+k - sgrad3k = sgrad3k+sgrad2k + shiftk = k + 1 + sgrad2k = sgrad2k + k + sgrad3k = sgrad3k + sgrad2k sgrad2 = sgrad2k sgrad3 = sgrad3k - DO j = 0, grad-k - sgrad = j+k + DO j = 0, grad - k + sgrad = j + k mgrad2 = sgrad2 - shiftj = mgrad2+shiftk + shiftj = mgrad2 + shiftk mgrad = sgrad - shifti = shiftj+sgrad3 - DO i = 0, grad-j-k - cp_ii = cp_ii+1 + shifti = shiftj + sgrad3 + DO i = 0, grad - j - k + cp_ii = cp_ii + 1 poly_cp2k(cp_ii) = poly_d3(shifti) - mgrad = mgrad+1 - mgrad2 = mgrad2+mgrad - shifti = shifti+mgrad2 + mgrad = mgrad + 1 + mgrad2 = mgrad2 + mgrad + shifti = shifti + mgrad2 END DO - sgrad2 = sgrad2+sgrad+1 - sgrad3 = sgrad3+sgrad2 + sgrad2 = sgrad2 + sgrad + 1 + sgrad3 = sgrad3 + sgrad2 END DO END DO IF (SIZE(poly_d3) >= size_p) THEN - poly_cp2k(size_p+1:) = 0.0_dp + poly_cp2k(size_p + 1:) = 0.0_dp END IF END SUBROUTINE diff --git a/src/dbcsrx/hash_table.f90 b/src/dbcsrx/hash_table.f90 index 838f1d7cb0..a3a492b84b 100644 --- a/src/dbcsrx/hash_table.f90 +++ b/src/dbcsrx/hash_table.f90 @@ -20,9 +20,9 @@ FUNCTION matching_prime(i) RESULT(res) res = i j = 0 DO WHILE (j < res) - DO j = 2, res-1 + DO j = 2, res - 1 IF (MOD(res, j) == 0) THEN - res = res+1 + res = res + 1 EXIT ENDIF ENDDO @@ -44,10 +44,10 @@ SUBROUTINE hash_table_create(hash_table, table_size) ! guarantee a minimal hash table size (8), so that expansion works j = 3 - DO WHILE (2**j-1 < table_size) - j = j+1 + DO WHILE (2**j - 1 < table_size) + j = j + 1 ENDDO - hash_table%nmax = 2**j-1 + hash_table%nmax = 2**j - 1 hash_table%prime = matching_prime(hash_table%nmax) hash_table%nele = 0 ALLOCATE (hash_table%table(0:hash_table%nmax)) @@ -89,7 +89,7 @@ RECURSIVE SUBROUTINE hash_table_add(hash_table, c, p) ALLOCATE (tmp_hash(LBOUND(hash_table%table, 1):UBOUND(hash_table%table, 1))) tmp_hash(:) = hash_table%table CALL hash_table_release(hash_table) - CALL hash_table_create(hash_table, INT((UBOUND(tmp_hash, 1)+8)*hash_table_expand)) + CALL hash_table_create(hash_table, INT((UBOUND(tmp_hash, 1) + 8)*hash_table_expand)) DO i = LBOUND(tmp_hash, 1), UBOUND(tmp_hash, 1) IF (tmp_hash(i)%c .NE. 0) THEN CALL hash_table_add(hash_table, tmp_hash(i)%c, tmp_hash(i)%p) @@ -98,7 +98,7 @@ RECURSIVE SUBROUTINE hash_table_add(hash_table, c, p) DEALLOCATE (tmp_hash) ENDIF - hash_table%nele = hash_table%nele+1 + hash_table%nele = hash_table%nele + 1 i = IAND(c*hash_table%prime, hash_table%nmax) DO j = i, hash_table%nmax @@ -108,7 +108,7 @@ RECURSIVE SUBROUTINE hash_table_add(hash_table, c, p) RETURN ENDIF ENDDO - DO j = 0, i-1 + DO j = 0, i - 1 IF (hash_table%table(j)%c == 0 .OR. hash_table%table(j)%c == c) THEN hash_table%table(j)%c = c hash_table%table(j)%p = p @@ -145,7 +145,7 @@ PURE FUNCTION hash_table_get(hash_table, c) RESULT(p) RETURN ENDIF ENDDO - DO j = 0, i-1 + DO j = 0, i - 1 IF (hash_table%table(j)%c == 0 .OR. hash_table%table(j)%c == c) THEN p = hash_table%table(j)%p RETURN diff --git a/src/debug_os_integrals.F b/src/debug_os_integrals.F index 00c5b5c11b..36cae9ed93 100644 --- a/src/debug_os_integrals.F +++ b/src/debug_os_integrals.F @@ -75,7 +75,7 @@ SUBROUTINE overlap_ab_test_simple() lds = ncoset(maxl) ALLOCATE (swork(lds, lds, 1)) sab = 0._dp - rab(:) = B(:)-A(:) + rab(:) = B(:) - A(:) dab = SQRT(DOT_PRODUCT(rab, rab)) xa_work(1) = xa xb_work(1) = xb @@ -92,19 +92,19 @@ SUBROUTINE overlap_ab_test_simple() DO ma = la_min, la_max DO mb = lb_min, lb_max DO iax = 0, ma - DO iay = 0, ma-iax - iaz = ma-iax-iay + DO iay = 0, ma - iax + iaz = ma - iax - iay na(1) = iax; na(2) = iay; na(3) = iaz ia1 = coset(iax, iay, iaz) DO ibx = 0, mb - DO iby = 0, mb-ibx - ibz = mb-ibx-iby + DO iby = 0, mb - ibx + ibz = mb - ibx - iby nb(1) = ibx; nb(2) = iby; nb(3) = ibz ib1 = coset(ibx, iby, ibz) res1 = os_overlap2(na, nb) ! write(*,*) "la, lb,na, nb, res1", ma, mb, na, nb, res1 ! write(*,*) "sab ia1, ib1", ia1, ib1, sab(ia1,ib1) - dmax = MAX(dmax, ABS(res1-sab(ia1, ib1))) + dmax = MAX(dmax, ABS(res1 - sab(ia1, ib1))) END DO END DO END DO @@ -163,27 +163,27 @@ SUBROUTINE overlap_ab_test(la_max, la_min, npgfa, zeta, lb_max, lb_min, npgfb, z DO ma = la_min, la_max DO mb = lb_min, lb_max DO iax = 0, ma - DO iay = 0, ma-iax - iaz = ma-iax-iay + DO iay = 0, ma - iax + iaz = ma - iax - iay na(1) = iax; na(2) = iay; na(3) = iaz ia1 = coset(iax, iay, iaz) DO ibx = 0, mb - DO iby = 0, mb-ibx - ibz = mb-ibx-iby + DO iby = 0, mb - ibx + ibz = mb - ibx - iby nb(1) = ibx; nb(2) = iby; nb(3) = ibz ib1 = coset(ibx, iby, ibz) res1 = os_overlap2(na, nb) - res2 = sab(coa+ia1, cob+ib1) - dmax = MAX(dmax, ABS(res1-res2)) + res2 = sab(coa + ia1, cob + ib1) + dmax = MAX(dmax, ABS(res1 - res2)) END DO END DO END DO END DO END DO END DO - cob = cob+ncoset(lb_max) + cob = cob + ncoset(lb_max) END DO - coa = coa+ncoset(la_max) + coa = coa + ncoset(la_max) END DO !WRITE(*,*) "dmax overlap_ab_test", dmax @@ -225,11 +225,11 @@ SUBROUTINE overlap_abc_test_simple() lc_max = 1 !--------------------------------------- - rab(:) = B(:)-A(:) + rab(:) = B(:) - A(:) dab = SQRT(DOT_PRODUCT(rab, rab)) - rac(:) = C(:)-A(:) + rac(:) = C(:) - A(:) dac = SQRT(DOT_PRODUCT(rac, rac)) - rbc(:) = C(:)-B(:) + rbc(:) = C(:) - B(:) dbc = SQRT(DOT_PRODUCT(rbc, rbc)) ALLOCATE (sabc(ncoset(la_max), ncoset(lb_max), ncoset(lc_max))) xa_work(1) = xa @@ -254,24 +254,24 @@ SUBROUTINE overlap_abc_test_simple() DO mc = lc_min, lc_max DO mb = lb_min, lb_max DO iax = 0, ma - DO iay = 0, ma-iax - iaz = ma-iax-iay + DO iay = 0, ma - iax + iaz = ma - iax - iay na(1) = iax; na(2) = iay; na(3) = iaz ia1 = coset(iax, iay, iaz) DO icx = 0, mc - DO icy = 0, mc-icx - icz = mc-icx-icy + DO icy = 0, mc - icx + icz = mc - icx - icy nc(1) = icx; nc(2) = icy; nc(3) = icz ic1 = coset(icx, icy, icz) DO ibx = 0, mb - DO iby = 0, mb-ibx - ibz = mb-ibx-iby + DO iby = 0, mb - ibx + ibz = mb - ibx - iby nb(1) = ibx; nb(2) = iby; nb(3) = ibz ib1 = coset(ibx, iby, ibz) res1 = os_overlap3(na, nc, nb) !write(*,*) "la, lc, lb,na,nc, nb, res1", ma, mc, mb, na, nc, nb, res1 !write(*,*) "sabc ia1, ib1, ic1", ia1, ib1, ic1, sabc(ia1,ib1,ic1) - dmax = MAX(dmax, ABS(res1-sabc(ia1, ib1, ic1))) + dmax = MAX(dmax, ABS(res1 - sabc(ia1, ib1, ic1))) END DO END DO END DO @@ -353,23 +353,23 @@ SUBROUTINE overlap_abc_test(la_max, npgfa, zeta, la_min, & DO mc = lc_min, lc_max DO mb = lb_min, lb_max DO iax = 0, ma - DO iay = 0, ma-iax - iaz = ma-iax-iay + DO iay = 0, ma - iax + iaz = ma - iax - iay na(1) = iax; na(2) = iay; na(3) = iaz ia1 = coset(iax, iay, iaz) DO icx = 0, mc - DO icy = 0, mc-icx - icz = mc-icx-icy + DO icy = 0, mc - icx + icz = mc - icx - icy nc(1) = icx; nc(2) = icy; nc(3) = icz ic1 = coset(icx, icy, icz) DO ibx = 0, mb - DO iby = 0, mb-ibx - ibz = mb-ibx-iby + DO iby = 0, mb - ibx + ibz = mb - ibx - iby nb(1) = ibx; nb(2) = iby; nb(3) = ibz ib1 = coset(ibx, iby, ibz) res1 = os_overlap3(na, nc, nb) - res2 = sabc(coa+ia1, cob+ib1, coc+ic1) - dmax = MAX(dmax, ABS(res1-res2)) + res2 = sabc(coa + ia1, cob + ib1, coc + ic1) + dmax = MAX(dmax, ABS(res1 - res2)) !IF(dmax > 1.E-10) WRITE(*,*) "dmax in loop", dmax END DO END DO @@ -380,11 +380,11 @@ SUBROUTINE overlap_abc_test(la_max, npgfa, zeta, la_min, & END DO END DO END DO - coc = coc+ncoset(lc_max) + coc = coc + ncoset(lc_max) END DO - cob = cob+ncoset(lb_max) + cob = cob + ncoset(lb_max) END DO - coa = coa+ncoset(la_max) + coa = coa + ncoset(la_max) END DO !WRITE(*,*) "dmax abc", dmax @@ -430,11 +430,11 @@ SUBROUTINE overlap_aabb_test_simple() !--------------------------------------- ALLOCATE (saabb(ncoset(la_max1), ncoset(la_max2), ncoset(lb_max1), ncoset(lb_max2))) - maxl = MAX(la_max1+la_max2, lb_max1+lb_max2) + maxl = MAX(la_max1 + la_max2, lb_max1 + lb_max2) lds = ncoset(maxl) ALLOCATE (swork(lds, lds)) saabb = 0._dp - rab(:) = B(:)-A(:) + rab(:) = B(:) - A(:) dab = SQRT(DOT_PRODUCT(rab, rab)) xa_work1(1) = xa1 xa_work2(1) = xa2 @@ -451,12 +451,12 @@ SUBROUTINE overlap_aabb_test_simple() asets_equal=.FALSE., bsets_equal=.FALSE., rab=rab, dab=dab, saabb=saabb, s=swork, lds=lds) !--------------------------------------- - xa = xa1+xa2 - xb = xb1+xb2 - la_min = la_min1+la_min2 - la_max = la_max1+la_max2 - lb_min = lb_min1+lb_min2 - lb_max = lb_max1+lb_max2 + xa = xa1 + xa2 + xb = xb1 + xb2 + la_min = la_min1 + la_min2 + la_max = la_max1 + la_max2 + lb_min = lb_min1 + lb_min2 + lb_max = lb_max1 + lb_max2 CALL init_os_overlap2(xa, xb, A, B) @@ -464,22 +464,22 @@ SUBROUTINE overlap_aabb_test_simple() DO ma = la_min, la_max DO mb = lb_min, lb_max DO iax = 0, ma - DO iay = 0, ma-iax - iaz = ma-iax-iay + DO iay = 0, ma - iax + iaz = ma - iax - iay na(1) = iax; na(2) = iay; na(3) = iaz DO ibx = 0, mb - DO iby = 0, mb-ibx - ibz = mb-ibx-iby + DO iby = 0, mb - ibx + ibz = mb - ibx - iby nb(1) = ibx; nb(2) = iby; nb(3) = ibz res1 = os_overlap2(na, nb) - DO i = ncoset(la_min1-1)+1, ncoset(la_max1) - DO j = ncoset(la_min2-1)+1, ncoset(la_max2) - naa = indco(1:3, i)+indco(1:3, j) - DO k = ncoset(lb_min1-1)+1, ncoset(lb_max1) - DO l = ncoset(lb_min2-1)+1, ncoset(lb_max2) - nbb = indco(1:3, k)+indco(1:3, l) + DO i = ncoset(la_min1 - 1) + 1, ncoset(la_max1) + DO j = ncoset(la_min2 - 1) + 1, ncoset(la_max2) + naa = indco(1:3, i) + indco(1:3, j) + DO k = ncoset(lb_min1 - 1) + 1, ncoset(lb_max1) + DO l = ncoset(lb_min2 - 1) + 1, ncoset(lb_max2) + nbb = indco(1:3, k) + indco(1:3, l) IF (ALL(na == naa) .AND. ALL(nb == nbb)) THEN - dmax = MAX(dmax, ABS(res1-saabb(i, j, k, l))) + dmax = MAX(dmax, ABS(res1 - saabb(i, j, k, l))) END IF END DO END DO @@ -557,12 +557,12 @@ SUBROUTINE overlap_aabb_test(la_max1, la_min1, npgfa1, zeta1, & cob2 = 0 DO lpgf = 1, npgfb2 - xa = zeta1(ipgf)+zeta2(jpgf) ! exponents - xb = zetb1(kpgf)+zetb2(lpgf) ! exponents - la_max = la_max1+la_max2 - lb_max = lb_max1+lb_max2 - la_min = la_min1+la_min2 - lb_min = lb_min1+lb_min2 + xa = zeta1(ipgf) + zeta2(jpgf) ! exponents + xb = zetb1(kpgf) + zetb2(lpgf) ! exponents + la_max = la_max1 + la_max2 + lb_max = lb_max1 + lb_max2 + la_min = la_min1 + la_min2 + lb_min = lb_min1 + lb_min2 A = ra !positions B = rb @@ -572,22 +572,22 @@ SUBROUTINE overlap_aabb_test(la_max1, la_min1, npgfa1, zeta1, & DO ma = la_min, la_max DO mb = lb_min, lb_max DO iax = 0, ma - DO iay = 0, ma-iax - iaz = ma-iax-iay + DO iay = 0, ma - iax + iaz = ma - iax - iay na(1) = iax; na(2) = iay; na(3) = iaz DO ibx = 0, mb - DO iby = 0, mb-ibx - ibz = mb-ibx-iby + DO iby = 0, mb - ibx + ibz = mb - ibx - iby nb(1) = ibx; nb(2) = iby; nb(3) = ibz res1 = os_overlap2(na, nb) - DO i = ncoset(la_min1-1)+1, ncoset(la_max1) - DO j = ncoset(la_min2-1)+1, ncoset(la_max2) - naa = indco(1:3, i)+indco(1:3, j) - DO k = ncoset(lb_min1-1)+1, ncoset(lb_max1) - DO l = ncoset(lb_min2-1)+1, ncoset(lb_max2) - nbb = indco(1:3, k)+indco(1:3, l) + DO i = ncoset(la_min1 - 1) + 1, ncoset(la_max1) + DO j = ncoset(la_min2 - 1) + 1, ncoset(la_max2) + naa = indco(1:3, i) + indco(1:3, j) + DO k = ncoset(lb_min1 - 1) + 1, ncoset(lb_max1) + DO l = ncoset(lb_min2 - 1) + 1, ncoset(lb_max2) + nbb = indco(1:3, k) + indco(1:3, l) IF (ALL(na == naa) .AND. ALL(nb == nbb)) THEN - dmax = MAX(dmax, ABS(res1-saabb(coa1+i, coa2+j, cob1+k, cob2+l))) + dmax = MAX(dmax, ABS(res1 - saabb(coa1 + i, coa2 + j, cob1 + k, cob2 + l))) ENDIF END DO END DO @@ -599,13 +599,13 @@ SUBROUTINE overlap_aabb_test(la_max1, la_min1, npgfa1, zeta1, & END DO END DO END DO - cob2 = cob2+ncoset(lb_max2) + cob2 = cob2 + ncoset(lb_max2) END DO - cob1 = cob1+ncoset(lb_max1) + cob1 = cob1 + ncoset(lb_max1) END DO - coa2 = coa2+ncoset(la_max2) + coa2 = coa2 + ncoset(la_max2) END DO - coa1 = coa1+ncoset(la_max1) + coa1 = coa1 + ncoset(la_max1) END DO !WRITE(*,*) "dmax aabb", dmax diff --git a/src/dft_plus_u.F b/src/dft_plus_u.F index 68e48e6622..187220d682 100644 --- a/src/dft_plus_u.F +++ b/src/dft_plus_u.F @@ -476,7 +476,7 @@ SUBROUTINE lowdin(qs_env, matrix_h, matrix_w, should_output, output_unit, & IF ((ispin == 1) .AND. (u_ramping > 0.0_dp)) THEN IF (qs_env%scf_env%iter_delta <= eps_u_ramping) THEN - u_minus_j = MIN(u_minus_j+u_ramping, u_minus_j_target) + u_minus_j = MIN(u_minus_j + u_ramping, u_minus_j_target) CALL set_qs_kind(qs_kind_set(ikind), u_minus_j=u_minus_j) END IF IF (should_output .AND. (output_unit > 0)) THEN @@ -502,11 +502,11 @@ SUBROUTINE lowdin(qs_env, matrix_h, matrix_w, should_output, output_unit, & nsb = 0 DO iset = 1, nset DO ishell = 1, nshell(iset) - IF (l(ishell, iset) == lu) nsb = nsb+1 + IF (l(ishell, iset) == lu) nsb = nsb + 1 END DO END DO - nsbsize = (2*lu+1) + nsbsize = (2*lu + 1) n = nsb*nsbsize ALLOCATE (q_matrix(n, n)) @@ -518,7 +518,7 @@ SUBROUTINE lowdin(qs_env, matrix_h, matrix_w, should_output, output_unit, & IF (output_unit > 0) THEN ALLOCATE (symbol(nsbsize)) DO m = -lu, lu - symbol(lu+m+1) = sgf_symbol(0, lu, m) + symbol(lu + m + 1) = sgf_symbol(0, lu, m) END DO IF (nspin > 1) THEN WRITE (UNIT=spin_info, FMT="(A8,I2)") " of spin", ispin @@ -558,13 +558,13 @@ SUBROUTINE lowdin(qs_env, matrix_h, matrix_w, should_output, output_unit, & DO ishell = 1, nshell(iset) IF (l(ishell, iset) /= lu) CYCLE DO isgf = first_sgf(ishell, iset), last_sgf(ishell, iset) - i = i+1 + i = i + 1 j = 0 DO jset = 1, nset DO jshell = 1, nshell(jset) IF (l(jshell, jset) /= lu) CYCLE DO jsgf = first_sgf(jshell, jset), last_sgf(jshell, jset) - j = j+1 + j = j + 1 q_matrix(i, j) = q_block(isgf, jsgf) END DO ! next contracted spherical Gaussian function "jsgf" END DO ! next shell "jshell" @@ -589,8 +589,8 @@ SUBROUTINE lowdin(qs_env, matrix_h, matrix_w, should_output, output_unit, & q_matrix(:, :) = 0.0_dp DO isb = 1, nsb trq = 0.0_dp - DO i = (isb-1)*nsbsize+1, isb*nsbsize - trq = trq+q_eigval(i) + DO i = (isb - 1)*nsbsize + 1, isb*nsbsize + trq = trq + q_eigval(i) END DO IF (smear) THEN occ = trq/REAL(norb, KIND=dp) @@ -599,28 +599,28 @@ SUBROUTINE lowdin(qs_env, matrix_h, matrix_w, should_output, output_unit, & END IF orb_occ(:) = .FALSE. iloc = MAXLOC(q_eigvec(:, isb*nsbsize)) - jsb = INT((iloc(1)-1)/nsbsize)+1 + jsb = INT((iloc(1) - 1)/nsbsize) + 1 i = 0 - i0 = (jsb-1)*nsbsize+1 + i0 = (jsb - 1)*nsbsize + 1 iorb = -1000 DO j = i0, jsb*nsbsize - i = i+1 + i = i + 1 IF (i > norb) THEN DO m = -lu, lu - IF (.NOT. orb_occ(lu+m+1)) THEN - iorb = i0+lu+m - orb_occ(lu+m+1) = .TRUE. + IF (.NOT. orb_occ(lu + m + 1)) THEN + iorb = i0 + lu + m + orb_occ(lu + m + 1) = .TRUE. END IF END DO ELSE - iorb = i0+lu+orbitals(i) - orb_occ(lu+orbitals(i)+1) = .TRUE. + iorb = i0 + lu + orbitals(i) + orb_occ(lu + orbitals(i) + 1) = .TRUE. END IF CPASSERT(iorb /= -1000) iloc = MAXLOC(q_eigvec(iorb, :)) q_eigval(iloc(1)) = MIN(occ, trq) q_matrix(:, iloc(1)) = q_eigval(iloc(1))*q_eigvec(:, iloc(1)) ! backtransform left - trq = trq-q_eigval(iloc(1)) + trq = trq - q_eigval(iloc(1)) END DO END DO q_matrix(:, :) = MATMUL(q_matrix, TRANSPOSE(q_eigvec)) ! backtransform right @@ -634,9 +634,9 @@ SUBROUTINE lowdin(qs_env, matrix_h, matrix_w, should_output, output_unit, & trq2 = 0.0_dp DO i = 1, n - trq = trq+q_matrix(i, i) + trq = trq + q_matrix(i, i) DO j = 1, n - trq2 = trq2+q_matrix(i, j)*q_matrix(j, i) + trq2 = trq2 + q_matrix(i, j)*q_matrix(j, i) END DO END DO @@ -645,7 +645,7 @@ SUBROUTINE lowdin(qs_env, matrix_h, matrix_w, should_output, output_unit, & ! Calculate energy contribution to E(U) - energy%dft_plus_u = energy%dft_plus_u+0.5_dp*u_minus_j*(trq-trq2)/fspin + energy%dft_plus_u = energy%dft_plus_u + 0.5_dp*u_minus_j*(trq - trq2)/fspin ! Calculate potential V(U) = dE(U)/dq @@ -663,15 +663,15 @@ SUBROUTINE lowdin(qs_env, matrix_h, matrix_w, should_output, output_unit, & DO ishell = 1, nshell(iset) IF (l(ishell, iset) /= lu) CYCLE DO isgf = first_sgf(ishell, iset), last_sgf(ishell, iset) - i = i+1 + i = i + 1 j = 0 DO jset = 1, nset DO jshell = 1, nshell(jset) IF (l(jshell, jset) /= lu) CYCLE DO jsgf = first_sgf(jshell, jset), last_sgf(jshell, jset) - j = j+1 + j = j + 1 IF (isgf == jsgf) THEN - v_block(isgf, isgf) = u_minus_j*(0.5_dp-fspin*q_matrix(i, i)) + v_block(isgf, isgf) = u_minus_j*(0.5_dp - fspin*q_matrix(i, i)) ELSE v_block(isgf, jsgf) = -u_minus_j*fspin*q_matrix(j, i) END IF @@ -695,8 +695,8 @@ SUBROUTINE lowdin(qs_env, matrix_h, matrix_w, should_output, output_unit, & q_work(:, :) = 0.0_dp DO isb = 1, nsb j = 0 - DO i = (isb-1)*nsbsize+1, isb*nsbsize - j = j+1 + DO i = (isb - 1)*nsbsize + 1, isb*nsbsize + j = j + 1 q_work(isb, j) = q_matrix(i, i) END DO END DO @@ -1091,7 +1091,7 @@ SUBROUTINE mulliken(qs_env, orthonormal_basis, matrix_h, should_output, & IF ((ispin == 1) .AND. (u_ramping > 0.0_dp)) THEN IF (qs_env%scf_env%iter_delta <= eps_u_ramping) THEN - u_minus_j = MIN(u_minus_j+u_ramping, u_minus_j_target) + u_minus_j = MIN(u_minus_j + u_ramping, u_minus_j_target) CALL set_qs_kind(qs_kind_set(ikind), u_minus_j=u_minus_j) END IF IF (should_output .AND. (output_unit > 0)) THEN @@ -1119,11 +1119,11 @@ SUBROUTINE mulliken(qs_env, orthonormal_basis, matrix_h, should_output, & nsb = 0 DO iset = 1, nset DO ishell = 1, nshell(iset) - IF (l(ishell, iset) == lu) nsb = nsb+1 + IF (l(ishell, iset) == lu) nsb = nsb + 1 END DO END DO - nsbsize = (2*lu+1) + nsbsize = (2*lu + 1) n = nsb*nsbsize ALLOCATE (q_matrix(n, n)) @@ -1135,7 +1135,7 @@ SUBROUTINE mulliken(qs_env, orthonormal_basis, matrix_h, should_output, & IF (output_unit > 0) THEN ALLOCATE (symbol(nsbsize)) DO m = -lu, lu - symbol(lu+m+1) = sgf_symbol(0, lu, m) + symbol(lu + m + 1) = sgf_symbol(0, lu, m) END DO IF (nspin > 1) THEN WRITE (UNIT=spin_info, FMT="(A8,I2)") " of spin", ispin @@ -1175,13 +1175,13 @@ SUBROUTINE mulliken(qs_env, orthonormal_basis, matrix_h, should_output, & DO ishell = 1, nshell(iset) IF (l(ishell, iset) /= lu) CYCLE DO isgf = first_sgf(ishell, iset), last_sgf(ishell, iset) - i = i+1 + i = i + 1 j = 0 DO jset = 1, nset DO jshell = 1, nshell(jset) IF (l(jshell, jset) /= lu) CYCLE DO jsgf = first_sgf(jshell, jset), last_sgf(jshell, jset) - j = j+1 + j = j + 1 q_matrix(i, j) = q_block(isgf, jsgf) END DO ! next contracted spherical Gaussian function "jsgf" END DO ! next shell "jshell" @@ -1210,8 +1210,8 @@ SUBROUTINE mulliken(qs_env, orthonormal_basis, matrix_h, should_output, & END IF DO isb = 1, nsb trq = 0.0_dp - DO i = (isb-1)*nsbsize+1, isb*nsbsize - trq = trq+q_eigval(i) + DO i = (isb - 1)*nsbsize + 1, isb*nsbsize + trq = trq + q_eigval(i) END DO IF (smear) THEN occ = trq/REAL(norb, KIND=dp) @@ -1220,28 +1220,28 @@ SUBROUTINE mulliken(qs_env, orthonormal_basis, matrix_h, should_output, & END IF orb_occ(:) = .FALSE. iloc = MAXLOC(q_eigvec(:, isb*nsbsize)) - jsb = INT((iloc(1)-1)/nsbsize)+1 + jsb = INT((iloc(1) - 1)/nsbsize) + 1 i = 0 - i0 = (jsb-1)*nsbsize+1 + i0 = (jsb - 1)*nsbsize + 1 iorb = -1000 DO j = i0, jsb*nsbsize - i = i+1 + i = i + 1 IF (i > norb) THEN DO m = -lu, lu - IF (.NOT. orb_occ(lu+m+1)) THEN - iorb = i0+lu+m - orb_occ(lu+m+1) = .TRUE. + IF (.NOT. orb_occ(lu + m + 1)) THEN + iorb = i0 + lu + m + orb_occ(lu + m + 1) = .TRUE. END IF END DO ELSE - iorb = i0+lu+orbitals(i) - orb_occ(lu+orbitals(i)+1) = .TRUE. + iorb = i0 + lu + orbitals(i) + orb_occ(lu + orbitals(i) + 1) = .TRUE. END IF CPASSERT(iorb /= -1000) iloc = MAXLOC(q_eigvec(iorb, :)) q_eigval(iloc(1)) = MIN(occ, trq) q_matrix(:, iloc(1)) = q_eigval(iloc(1))*q_eigvec(:, iloc(1)) ! backtransform left - trq = trq-q_eigval(iloc(1)) + trq = trq - q_eigval(iloc(1)) END DO END DO q_matrix(:, :) = MATMUL(q_matrix, TRANSPOSE(q_eigvec)) ! backtransform right @@ -1255,9 +1255,9 @@ SUBROUTINE mulliken(qs_env, orthonormal_basis, matrix_h, should_output, & trq2 = 0.0_dp DO i = 1, n - trq = trq+q_matrix(i, i) + trq = trq + q_matrix(i, i) DO j = 1, n - trq2 = trq2+q_matrix(i, j)*q_matrix(j, i) + trq2 = trq2 + q_matrix(i, j)*q_matrix(j, i) END DO END DO @@ -1266,7 +1266,7 @@ SUBROUTINE mulliken(qs_env, orthonormal_basis, matrix_h, should_output, & ! Calculate energy contribution to E(U) - energy%dft_plus_u = energy%dft_plus_u+0.5_dp*u_minus_j*(trq-trq2)/fspin + energy%dft_plus_u = energy%dft_plus_u + 0.5_dp*u_minus_j*(trq - trq2)/fspin ! Calculate potential V(U) = dE(U)/dq @@ -1284,15 +1284,15 @@ SUBROUTINE mulliken(qs_env, orthonormal_basis, matrix_h, should_output, & DO ishell = 1, nshell(iset) IF (l(ishell, iset) /= lu) CYCLE DO isgf = first_sgf(ishell, iset), last_sgf(ishell, iset) - i = i+1 + i = i + 1 j = 0 DO jset = 1, nset DO jshell = 1, nshell(jset) IF (l(jshell, jset) /= lu) CYCLE DO jsgf = first_sgf(jshell, jset), last_sgf(jshell, jset) - j = j+1 + j = j + 1 IF (isgf == jsgf) THEN - v_block(isgf, isgf) = u_minus_j*(0.5_dp-fspin*q_matrix(i, i)) + v_block(isgf, isgf) = u_minus_j*(0.5_dp - fspin*q_matrix(i, i)) ELSE v_block(isgf, jsgf) = -u_minus_j*fspin*q_matrix(j, i) END IF @@ -1316,8 +1316,8 @@ SUBROUTINE mulliken(qs_env, orthonormal_basis, matrix_h, should_output, & q_work(:, :) = 0.0_dp DO isb = 1, nsb j = 0 - DO i = (isb-1)*nsbsize+1, isb*nsbsize - j = j+1 + DO i = (isb - 1)*nsbsize + 1, isb*nsbsize + j = j + 1 q_work(isb, j) = q_matrix(i, i) END DO END DO @@ -1424,7 +1424,7 @@ SUBROUTINE mulliken(qs_env, orthonormal_basis, matrix_h, should_output, & IF (orthonormal_basis) THEN DO isgf = 1, SIZE(h_block, 1) - h_block(isgf, isgf) = h_block(isgf, isgf)+v_block(isgf, isgf) + h_block(isgf, isgf) = h_block(isgf, isgf) + v_block(isgf, isgf) END DO ELSE CALL dbcsr_get_block_p(matrix=sm_s, & @@ -1435,7 +1435,7 @@ SUBROUTINE mulliken(qs_env, orthonormal_basis, matrix_h, should_output, & CPASSERT(ASSOCIATED(s_block)) DO jsgf = 1, SIZE(h_block, 2) DO isgf = 1, SIZE(h_block, 1) - h_block(isgf, jsgf) = h_block(isgf, jsgf)+v_block(isgf, jsgf)*s_block(isgf, jsgf) + h_block(isgf, jsgf) = h_block(isgf, jsgf) + v_block(isgf, jsgf)*s_block(isgf, jsgf) END DO END DO END IF ! orthonormal basis set @@ -1666,8 +1666,8 @@ SUBROUTINE mulliken_charges(qs_env, orthonormal_basis, matrix_h, matrix_w, & IF (ASSOCIATED(p_block)) THEN sgf = first_sgf_atom(iatom) DO isgf = 1, SIZE(p_block, 1) - trps(sgf) = trps(sgf)+p_block(isgf, isgf) - sgf = sgf+1 + trps(sgf) = trps(sgf) + p_block(isgf, isgf) + sgf = sgf + 1 END DO END IF @@ -1683,18 +1683,18 @@ SUBROUTINE mulliken_charges(qs_env, orthonormal_basis, matrix_h, matrix_w, & sgf = first_sgf_atom(jatom) DO jsgf = 1, SIZE(p_block, 2) DO isgf = 1, SIZE(p_block, 1) - trps(sgf) = trps(sgf)+p_block(isgf, jsgf)*s_block(isgf, jsgf) + trps(sgf) = trps(sgf) + p_block(isgf, jsgf)*s_block(isgf, jsgf) END DO - sgf = sgf+1 + sgf = sgf + 1 END DO IF (iatom /= jatom) THEN sgf = first_sgf_atom(iatom) DO isgf = 1, SIZE(p_block, 1) DO jsgf = 1, SIZE(p_block, 2) - trps(sgf) = trps(sgf)+p_block(isgf, jsgf)*s_block(isgf, jsgf) + trps(sgf) = trps(sgf) + p_block(isgf, jsgf)*s_block(isgf, jsgf) END DO - sgf = sgf+1 + sgf = sgf + 1 END DO END IF @@ -1744,7 +1744,7 @@ SUBROUTINE mulliken_charges(qs_env, orthonormal_basis, matrix_h, matrix_w, & IF ((ispin == 1) .AND. (u_ramping > 0.0_dp)) THEN IF (qs_env%scf_env%iter_delta <= eps_u_ramping) THEN - u_minus_j = MIN(u_minus_j+u_ramping, u_minus_j_target) + u_minus_j = MIN(u_minus_j + u_ramping, u_minus_j_target) CALL set_qs_kind(qs_kind_set(ikind), u_minus_j=u_minus_j) END IF IF (should_output .AND. (output_unit > 0)) THEN @@ -1770,19 +1770,19 @@ SUBROUTINE mulliken_charges(qs_env, orthonormal_basis, matrix_h, matrix_w, & nsb = 0 DO iset = 1, nset DO ishell = 1, nshell(iset) - IF (l(ishell, iset) == lu) nsb = nsb+1 + IF (l(ishell, iset) == lu) nsb = nsb + 1 END DO END DO - ALLOCATE (q_ii(nsb, 2*lu+1)) + ALLOCATE (q_ii(nsb, 2*lu + 1)) ! Print headline if requested IF (should_output .AND. (print_level > low_print_level)) THEN IF (output_unit > 0) THEN - ALLOCATE (symbol(2*lu+1)) + ALLOCATE (symbol(2*lu + 1)) DO m = -lu, lu - symbol(lu+m+1) = sgf_symbol(0, lu, m) + symbol(lu + m + 1) = sgf_symbol(0, lu, m) END DO IF (nspin > 1) THEN WRITE (UNIT=spin_info, FMT="(A8,I2)") " of spin", ispin @@ -1792,7 +1792,7 @@ SUBROUTINE mulliken_charges(qs_env, orthonormal_basis, matrix_h, matrix_w, & WRITE (UNIT=output_unit, FMT="(/,T3,A,I0,A,/,/,T5,A,10(2X,A6))") & "DFT+U occupations"//TRIM(spin_info)//" for the atoms of atomic kind ", ikind, & ": "//TRIM(atomic_kind_name), & - "Atom Shell ", (ADJUSTR(symbol(i)), i=1, 2*lu+1), " Trace" + "Atom Shell ", (ADJUSTR(symbol(i)), i=1, 2*lu + 1), " Trace" DEALLOCATE (symbol) END IF END IF @@ -1823,21 +1823,21 @@ SUBROUTINE mulliken_charges(qs_env, orthonormal_basis, matrix_h, matrix_w, & DO iset = 1, nset DO ishell = 1, nshell(iset) IF (l(ishell, iset) == lu) THEN - isb = isb+1 + isb = isb + 1 i = 0 DO isgf = first_sgf(ishell, iset), last_sgf(ishell, iset) q = fspin*trps(sgf) - i = i+1 + i = i + 1 q_ii(isb, i) = q - energy%dft_plus_u = energy%dft_plus_u+ & - 0.5_dp*u_minus_j*(q-q**2)/fspin + energy%dft_plus_u = energy%dft_plus_u + & + 0.5_dp*u_minus_j*(q - q**2)/fspin IF (.NOT. just_energy) THEN - dEdq(sgf) = dEdq(sgf)+u_minus_j*(0.5_dp-q) + dEdq(sgf) = dEdq(sgf) + u_minus_j*(0.5_dp - q) END IF - sgf = sgf+1 + sgf = sgf + 1 END DO ! next contracted spherical Gaussian function "isgf" ELSE - sgf = sgf+last_sgf(ishell, iset)-first_sgf(ishell, iset)+1 + sgf = sgf + last_sgf(ishell, iset) - first_sgf(ishell, iset) + 1 END IF ! angular momentum requested for DFT+U correction END DO ! next shell "ishell" END DO ! next shell set "iset" @@ -1854,7 +1854,7 @@ SUBROUTINE mulliken_charges(qs_env, orthonormal_basis, matrix_h, matrix_w, & atom_a, isb, q_ii(isb, :), SUM(q_ii(isb, :)) END DO WRITE (UNIT=output_unit, FMT="(T12,A,2X,10F8.3)") & - "Total", (SUM(q_ii(:, i)), i=1, 2*lu+1), SUM(q_ii) + "Total", (SUM(q_ii(:, i)), i=1, 2*lu + 1), SUM(q_ii) WRITE (UNIT=output_unit, FMT="(A)") "" END IF END IF ! should output @@ -1888,8 +1888,8 @@ SUBROUTINE mulliken_charges(qs_env, orthonormal_basis, matrix_h, matrix_w, & IF (ASSOCIATED(h_block)) THEN sgf = first_sgf_atom(iatom) DO isgf = 1, SIZE(h_block, 1) - h_block(isgf, isgf) = h_block(isgf, isgf)+dEdq(sgf) - sgf = sgf+1 + h_block(isgf, isgf) = h_block(isgf, isgf) + dEdq(sgf) + sgf = sgf + 1 END DO END IF @@ -1912,10 +1912,10 @@ SUBROUTINE mulliken_charges(qs_env, orthonormal_basis, matrix_h, matrix_w, & IF (dEdq(sgf) /= 0.0_dp) THEN v = 0.5_dp*dEdq(sgf) DO jsgf = 1, SIZE(h_block, 2) - h_block(isgf, jsgf) = h_block(isgf, jsgf)+v*s_block(isgf, jsgf) + h_block(isgf, jsgf) = h_block(isgf, jsgf) + v*s_block(isgf, jsgf) END DO END IF - sgf = sgf+1 + sgf = sgf + 1 END DO sgf = first_sgf_atom(jatom) @@ -1924,10 +1924,10 @@ SUBROUTINE mulliken_charges(qs_env, orthonormal_basis, matrix_h, matrix_w, & IF (dEdq(sgf) /= 0.0_dp) THEN v = 0.5_dp*dEdq(sgf) DO isgf = 1, SIZE(h_block, 1) - h_block(isgf, jsgf) = h_block(isgf, jsgf)+v*s_block(isgf, jsgf) + h_block(isgf, jsgf) = h_block(isgf, jsgf) + v*s_block(isgf, jsgf) END DO END IF - sgf = sgf+1 + sgf = sgf + 1 END DO END IF ! orthonormal basis set @@ -1971,10 +1971,10 @@ SUBROUTINE mulliken_charges(qs_env, orthonormal_basis, matrix_h, matrix_w, & IF (dEdq(sgf) /= 0.0_dp) THEN v = -0.5_dp*dEdq(sgf) DO jsgf = 1, SIZE(w_block, 2) - w_block(isgf, jsgf) = w_block(isgf, jsgf)+v*p_block(isgf, jsgf) + w_block(isgf, jsgf) = w_block(isgf, jsgf) + v*p_block(isgf, jsgf) END DO END IF - sgf = sgf+1 + sgf = sgf + 1 END DO sgf = first_sgf_atom(jatom) @@ -1983,10 +1983,10 @@ SUBROUTINE mulliken_charges(qs_env, orthonormal_basis, matrix_h, matrix_w, & IF (dEdq(sgf) /= 0.0_dp) THEN v = -0.5_dp*dEdq(sgf) DO isgf = 1, SIZE(w_block, 1) - w_block(isgf, jsgf) = w_block(isgf, jsgf)+v*p_block(isgf, jsgf) + w_block(isgf, jsgf) = w_block(isgf, jsgf) + v*p_block(isgf, jsgf) END DO END IF - sgf = sgf+1 + sgf = sgf + 1 END DO END DO ! next block node "jatom" diff --git a/src/distribution_2d_types.F b/src/distribution_2d_types.F index 5693c8f7cc..ad02645e2d 100644 --- a/src/distribution_2d_types.F +++ b/src/distribution_2d_types.F @@ -124,7 +124,7 @@ SUBROUTINE distribution_2d_create(distribution_2d, blacs_env, & ALLOCATE (distribution_2d) distribution_2d%ref_count = 1 - last_distribution_2d_id = last_distribution_2d_id+1 + last_distribution_2d_id = last_distribution_2d_id + 1 distribution_2d%id_nr = last_distribution_2d_id NULLIFY (distribution_2d%col_distribution, distribution_2d%row_distribution, & @@ -230,7 +230,7 @@ SUBROUTINE distribution_2d_retain(distribution_2d) CPASSERT(ASSOCIATED(distribution_2d)) CPASSERT(distribution_2d%ref_count > 0) - distribution_2d%ref_count = distribution_2d%ref_count+1 + distribution_2d%ref_count = distribution_2d%ref_count + 1 END SUBROUTINE distribution_2d_retain ! ************************************************************************************************** @@ -247,7 +247,7 @@ SUBROUTINE distribution_2d_release(distribution_2d) IF (ASSOCIATED(distribution_2d)) THEN CPASSERT(distribution_2d%ref_count > 0) - distribution_2d%ref_count = distribution_2d%ref_count-1 + distribution_2d%ref_count = distribution_2d%ref_count - 1 IF (distribution_2d%ref_count == 0) THEN CALL cp_blacs_env_release(distribution_2d%blacs_env) IF (ASSOCIATED(distribution_2d%col_distribution)) THEN @@ -544,7 +544,7 @@ SUBROUTINE distribution_2d_get(distribution_2d, row_distribution, & CPASSERT(ikind_min > 0) distribution_2d%flat_local_rows(iblock_atomic) = & distribution_2d%local_rows(ikind_min)%array(multiindex(ikind_min)) - multiindex(ikind_min) = multiindex(ikind_min)+1 + multiindex(ikind_min) = multiindex(ikind_min) + 1 END DO DEALLOCATE (multiindex) END IF @@ -570,7 +570,7 @@ SUBROUTINE distribution_2d_get(distribution_2d, row_distribution, & CPASSERT(ikind_min > 0) distribution_2d%flat_local_cols(iblock_atomic) = & distribution_2d%local_cols(ikind_min)%array(multiindex(ikind_min)) - multiindex(ikind_min) = multiindex(ikind_min)+1 + multiindex(ikind_min) = multiindex(ikind_min) + 1 END DO DEALLOCATE (multiindex) END IF diff --git a/src/distribution_methods.F b/src/distribution_methods.F index 8cbd6b8701..4776426cbd 100644 --- a/src/distribution_methods.F +++ b/src/distribution_methods.F @@ -153,7 +153,7 @@ SUBROUTINE distribute_molecules_1d(atomic_kind_set, particle_set, & logger => cp_get_default_logger() group = logger%para_env%group - mype = logger%para_env%mepos+1 + mype = logger%para_env%mepos + 1 npe = logger%para_env%num_pe ALLOCATE (workload_count(npe)) @@ -210,7 +210,7 @@ SUBROUTINE distribute_molecules_1d(atomic_kind_set, particle_set, & IF (ANY(prev_local_molecules%list(imolecule_prev_kind)%array( & 1:prev_local_molecules%n_el(imolecule_prev_kind)) == molecule_list(imolecule))) THEN ! molecule used to be local - nmolecule_local(imolecule_kind) = nmolecule_local(imolecule_kind)+1 + nmolecule_local(imolecule_kind) = nmolecule_local(imolecule_kind) + 1 ENDIF END DO ELSE @@ -222,9 +222,9 @@ SUBROUTINE distribute_molecules_1d(atomic_kind_set, particle_set, & IF (bin_price /= workload_count(ipe)) & CPABORT("inconsistent heap") - workload_count(ipe) = workload_count(ipe)+nload + workload_count(ipe) = workload_count(ipe) + nload IF (ipe == mype) THEN - nmolecule_local(imolecule_kind) = nmolecule_local(imolecule_kind)+1 + nmolecule_local(imolecule_kind) = nmolecule_local(imolecule_kind) + 1 END IF bin_price = workload_count(ipe) @@ -260,19 +260,19 @@ SUBROUTINE distribute_molecules_1d(atomic_kind_set, particle_set, & IF (bin_price /= workload_fill(ipe)) & CPABORT("inconsistent heap") - workload_fill(ipe) = workload_fill(ipe)+nload + workload_fill(ipe) = workload_fill(ipe) + nload is_local = (ipe == mype) ENDIF IF (is_local) THEN - imolecule_local = imolecule_local+1 + imolecule_local = imolecule_local + 1 molecule_a = molecule_list(imolecule) local_molecule(imolecule_kind)%array(imolecule_local) = molecule_a DO iatom = 1, natom - atom_a = molecule_set(molecule_a)%first_atom+iatom-1 + atom_a = molecule_set(molecule_a)%first_atom + iatom - 1 CALL get_atomic_kind(atomic_kind=particle_set(atom_a)%atomic_kind, & kind_number=kind_a) - nparticle_local(kind_a) = nparticle_local(kind_a)+1 + nparticle_local(kind_a) = nparticle_local(kind_a) + 1 END DO END IF IF (.NOT. has_prev_subsys_info) THEN @@ -320,10 +320,10 @@ SUBROUTINE distribute_molecules_1d(atomic_kind_set, particle_set, & DO imolecule = 1, nmolecule_local(imolecule_kind) molecule_a = local_molecule(imolecule_kind)%array(imolecule) DO iatom = 1, natom - atom_a = molecule_set(molecule_a)%first_atom+iatom-1 + atom_a = molecule_set(molecule_a)%first_atom + iatom - 1 CALL get_atomic_kind(atomic_kind=particle_set(atom_a)%atomic_kind, & kind_number=kind_a) - nparticle_local(kind_a) = nparticle_local(kind_a)+1 + nparticle_local(kind_a) = nparticle_local(kind_a) + 1 local_particles%list(kind_a)%array(nparticle_local(kind_a)) = atom_a END DO END DO @@ -354,7 +354,7 @@ SUBROUTINE distribute_molecules_1d(atomic_kind_set, particle_set, & FMT="(/, T2, A, T51, A, /, (T52, I6, T73, I8))") & "DISTRIBUTION OF THE MOLECULES", & "Process Number of molecules", & - (ipe-1, work(ipe), ipe=1, npe) + (ipe - 1, work(ipe), ipe=1, npe) WRITE (UNIT=output_unit, FMT="(T55, A3, T73, I8)") & "Sum", SUM(work) CALL m_flush(output_unit) @@ -369,7 +369,7 @@ SUBROUTINE distribute_molecules_1d(atomic_kind_set, particle_set, & DO imolecule_kind = 1, nmolecule_kind IF (imolecule_kind == 1) THEN WRITE (UNIT=iw, FMT="(T4, I6, 2X, I5, (T21, 10I6))") & - ipe-1, imolecule_kind, & + ipe - 1, imolecule_kind, & (local_molecules%list(imolecule_kind)%array(imolecule), & imolecule=1, nmolecule_local(imolecule_kind)) ELSE @@ -396,7 +396,7 @@ SUBROUTINE distribute_molecules_1d(atomic_kind_set, particle_set, & FMT="(/, T2, A, T51, A, /, (T52, I6, T73, I8))") & "DISTRIBUTION OF THE PARTICLES", & "Process Number of particles", & - (ipe-1, work(ipe), ipe=1, npe) + (ipe - 1, work(ipe), ipe=1, npe) WRITE (UNIT=output_unit, FMT="(T55, A3, T73, I8)") & "Sum", SUM(work) CALL m_flush(output_unit) @@ -411,7 +411,7 @@ SUBROUTINE distribute_molecules_1d(atomic_kind_set, particle_set, & DO iparticle_kind = 1, nparticle_kind IF (iparticle_kind == 1) THEN WRITE (UNIT=iw, FMT="(T4, I6, 2X, I5, (T20, 10I6))") & - ipe-1, iparticle_kind, & + ipe - 1, iparticle_kind, & (local_particles%list(iparticle_kind)%array(iatom), & iatom=1, nparticle_local(iparticle_kind)) ELSE @@ -531,8 +531,8 @@ SUBROUTINE distribute_molecules_2d(cell, atomic_kind_set, particle_set, & ! group = blacs_env%para_env%group - myprow = blacs_env%mepos(1)+1 - mypcol = blacs_env%mepos(2)+1 + myprow = blacs_env%mepos(1) + 1 + mypcol = blacs_env%mepos(2) + 1 nprow = blacs_env%num_pe(1) npcol = blacs_env%num_pe(2) @@ -590,7 +590,7 @@ SUBROUTINE distribute_molecules_2d(cell, atomic_kind_set, particle_set, & CASE default CALL get_qs_kind(qs_kind_set(ikind), basis_set=orb_basis_set) CALL get_gto_basis_set(orb_basis_set, lmax=lmax_basis) - cluster_price = 8+(MAXVAL(lmax_basis)**2) + cluster_price = 8 + (MAXVAL(lmax_basis)**2) END SELECT cluster_prices(iatom) = cluster_price ENDDO @@ -600,24 +600,24 @@ SUBROUTINE distribute_molecules_2d(cell, atomic_kind_set, particle_set, & molecule_kind => molecule_kind_set(imolecule_kind) CALL get_molecule_kind(molecule_kind=molecule_kind, molecule_list=molecule_list, natom=natom_mol) DO imolecule = 1, SIZE(molecule_list) - imol = imol+1 + imol = imol + 1 cluster_list(imol) = imol cluster_price = 0 DO iatom_mol = 1, natom_mol - iatom = molecule_set(molecule_list(imolecule))%first_atom+iatom_mol-1 + iatom = molecule_set(molecule_list(imolecule))%first_atom + iatom_mol - 1 CALL get_atomic_kind(particle_set(iatom)%atomic_kind, kind_number=ikind) SELECT CASE (cost_model) CASE (model_block_count) CALL get_qs_kind(qs_kind_set(ikind), nsgf=nsgf) - cluster_price = cluster_price+nsgf + cluster_price = cluster_price + nsgf CASE (model_block_lmax) CALL get_qs_kind(qs_kind_set(ikind), basis_set=orb_basis_set) CALL get_gto_basis_set(orb_basis_set, lmax=lmax_basis) - cluster_price = cluster_price+MAXVAL(lmax_basis) + cluster_price = cluster_price + MAXVAL(lmax_basis) CASE default CALL get_qs_kind(qs_kind_set(ikind), basis_set=orb_basis_set) CALL get_gto_basis_set(orb_basis_set, lmax=lmax_basis) - cluster_price = cluster_price+8+(MAXVAL(lmax_basis)**2) + cluster_price = cluster_price + 8 + (MAXVAL(lmax_basis)**2) END SELECT ENDDO cluster_prices(imol) = cluster_price @@ -654,13 +654,13 @@ SUBROUTINE distribute_molecules_2d(cell, atomic_kind_set, particle_set, & molecule_kind => molecule_kind_set(imolecule_kind) CALL get_molecule_kind(molecule_kind=molecule_kind, molecule_list=molecule_list, natom=natom_mol) DO imolecule = 1, SIZE(molecule_list) - imol = imol+1 + imol = imol + 1 iatom_one = molecule_set(molecule_list(imolecule))%first_atom center = 0.0_dp DO iatom_mol = 1, natom_mol - iatom = molecule_set(molecule_list(imolecule))%first_atom+iatom_mol-1 - center = center+ & - pbc(particle_set(iatom)%r(:)-particle_set(iatom_one)%r(:), cell)+particle_set(iatom_one)%r(:) + iatom = molecule_set(molecule_list(imolecule))%first_atom + iatom_mol - 1 + center = center + & + pbc(particle_set(iatom)%r(:) - particle_set(iatom_one)%r(:), cell) + particle_set(iatom_one)%r(:) ENDDO center = center/natom_mol CALL real_to_scaled(pbc_scaled_coords(:, imol), pbc(center, cell), cell) @@ -685,9 +685,9 @@ SUBROUTINE distribute_molecules_2d(cell, atomic_kind_set, particle_set, & molecule_kind => molecule_kind_set(imolecule_kind) CALL get_molecule_kind(molecule_kind=molecule_kind, molecule_list=molecule_list, natom=natom_mol) DO imolecule = 1, SIZE(molecule_list) - imol = imol+1 + imol = imol + 1 DO iatom_mol = 1, natom_mol - iatom = molecule_set(molecule_list(imolecule))%first_atom+iatom_mol-1 + iatom = molecule_set(molecule_list(imolecule))%first_atom + iatom_mol - 1 row_distribution(iatom, :) = cluster_row_distribution(imol, :) col_distribution(iatom, :) = cluster_col_distribution(imol, :) ENDDO @@ -713,8 +713,8 @@ SUBROUTINE distribute_molecules_2d(cell, atomic_kind_set, particle_set, & nparticle_local_row = 0 DO iatom = 1, natom CALL get_atomic_kind(atomic_kind=particle_set(iatom)%atomic_kind, kind_number=kind_a) - IF (row_distribution(iatom, 1) == myprow) nparticle_local_row(kind_a) = nparticle_local_row(kind_a)+1 - IF (col_distribution(iatom, 1) == mypcol) nparticle_local_col(kind_a) = nparticle_local_col(kind_a)+1 + IF (row_distribution(iatom, 1) == myprow) nparticle_local_row(kind_a) = nparticle_local_row(kind_a) + 1 + IF (col_distribution(iatom, 1) == mypcol) nparticle_local_col(kind_a) = nparticle_local_col(kind_a) + 1 ENDDO ! allocate space @@ -732,18 +732,18 @@ SUBROUTINE distribute_molecules_2d(cell, atomic_kind_set, particle_set, & DO iatom = 1, natom CALL get_atomic_kind(atomic_kind=particle_set(iatom)%atomic_kind, kind_number=kind_a) IF (row_distribution(iatom, 1) == myprow) THEN - nparticle_local_row(kind_a) = nparticle_local_row(kind_a)+1 + nparticle_local_row(kind_a) = nparticle_local_row(kind_a) + 1 local_particle_row(kind_a)%array(nparticle_local_row(kind_a)) = iatom ENDIF IF (col_distribution(iatom, 1) == mypcol) THEN - nparticle_local_col(kind_a) = nparticle_local_col(kind_a)+1 + nparticle_local_col(kind_a) = nparticle_local_col(kind_a) + 1 local_particle_col(kind_a)%array(nparticle_local_col(kind_a)) = iatom ENDIF ENDDO ! *** Generate the 2d distribution structure but take care of the zero offsets required - row_distribution(:, 1) = row_distribution(:, 1)-1 - col_distribution(:, 1) = col_distribution(:, 1)-1 + row_distribution(:, 1) = row_distribution(:, 1) - 1 + col_distribution(:, 1) = col_distribution(:, 1) - 1 CALL distribution_2d_create(distribution_2d, & row_distribution_ptr=row_distribution, & col_distribution_ptr=col_distribution, & @@ -777,7 +777,7 @@ SUBROUTINE distribute_molecules_2d(cell, atomic_kind_set, particle_set, & FMT="(/, T2, A, /, T15, A, /, (T16, I10, T41, I10, T71, I10))") & "DISTRIBUTION OF THE PARTICLES (ROWS)", & "Process row Number of particles Number of matrix rows", & - (iprow-1, work(iprow), -1, iprow=1, nprow) + (iprow - 1, work(iprow), -1, iprow=1, nprow) WRITE (UNIT=output_unit, FMT="(T23, A3, T41, I10, T71, I10)") & "Sum", SUM(work), -1 CALL m_flush(output_unit) @@ -799,7 +799,7 @@ SUBROUTINE distribute_molecules_2d(cell, atomic_kind_set, particle_set, & FMT="(/, T2, A, /, T15, A, /, (T16, I10, T41, I10, T71, I10))") & "DISTRIBUTION OF THE PARTICLES (COLUMNS)", & "Process col Number of particles Number of matrix columns", & - (ipcol-1, work(ipcol), -1, ipcol=1, npcol) + (ipcol - 1, work(ipcol), -1, ipcol=1, npcol) WRITE (UNIT=output_unit, FMT="(T23, A3, T41, I10, T71, I10)") & "Sum", SUM(work), -1 CALL m_flush(output_unit) @@ -879,17 +879,17 @@ SUBROUTINE make_basic_distribution(cluster_list, cluster_prices, & IF (.NOT. found) & CPABORT("No topmost heap element found.") ! - prow = INT((bin-1)*pgrid_gcd/npcols) + prow = INT((bin - 1)*pgrid_gcd/npcols) IF (prow .GE. nprows) & CPABORT("Invalid process row.") - pcol = INT((bin-1)*pgrid_gcd/nprows) + pcol = INT((bin - 1)*pgrid_gcd/nprows) IF (pcol .GE. npcols) & CPABORT("Invalid process column.") - row_distribution(cluster) = prow+1 - col_distribution(cluster) = pcol+1 + row_distribution(cluster) = prow + 1 + col_distribution(cluster) = pcol + 1 ! cluster_price = cluster_prices(cluster_index) - bin_price = bin_price+cluster_price + bin_price = bin_price + cluster_price CALL cp_heap_reset_first(bin_heap, bin_price) ENDDO CALL cp_heap_release(bin_heap) @@ -937,8 +937,8 @@ SUBROUTINE make_basic_spatial_distribution(pbc_scaled_coords, costs, & ! final row_distribution / col_distribution DO iatom = 1, natoms - row_distribution(iatom) = (distribution(iatom)-1)*pgrid_gcd/npcols+1 - col_distribution(iatom) = (distribution(iatom)-1)*pgrid_gcd/nprows+1 + row_distribution(iatom) = (distribution(iatom) - 1)*pgrid_gcd/npcols + 1 + col_distribution(iatom) = (distribution(iatom) - 1)*pgrid_gcd/nprows + 1 ENDDO DEALLOCATE (bin_costs, distribution) @@ -969,7 +969,7 @@ RECURSIVE SUBROUTINE spatial_recurse(pbc_scaled_coords, costs, indices, bin_cost natoms = SIZE(costs) nbins = SIZE(bin_costs) - nhalf = (natoms+1)/2 + nhalf = (natoms + 1)/2 IF (natoms <= nbins) THEN ! assign the most expensive atom to the least costly bin @@ -982,11 +982,11 @@ RECURSIVE SUBROUTINE spatial_recurse(pbc_scaled_coords, costs, indices, bin_cost ibin = 0 ! WRITE(*, *) "Dealing with a new bunch of atoms " DO iatom = natoms, 1, -1 - ibin = ibin+1 + ibin = ibin + 1 ! WRITE(*, *) "atom", indices(atom_permutation(iatom)), "cost", atom_costs_sorted(iatom), & ! "bin", permutation(ibin), "its cost", bin_costs(permutation(ibin)) ! WRITE(100, '(A, I0, 3F12.6)') "A", permutation(ibin), pbc_scaled_coords(:, atom_permutation(iatom)) - bin_costs(permutation(ibin)) = bin_costs(permutation(ibin))+atom_costs_sorted(iatom) + bin_costs(permutation(ibin)) = bin_costs(permutation(ibin)) + atom_costs_sorted(iatom) distribution(indices(atom_permutation(iatom))) = permutation(ibin) ENDDO DEALLOCATE (bin_costs_sorted, permutation, atom_costs_sorted, atom_permutation) @@ -994,12 +994,12 @@ RECURSIVE SUBROUTINE spatial_recurse(pbc_scaled_coords, costs, indices, bin_cost ! divide atoms in two subsets, sorting according to their coordinates, alternatively x, y, z ! recursively do this for both subsets ALLOCATE (coord(natoms), permutation(natoms)) - coord(:) = pbc_scaled_coords(MOD(level, 3)+1, :) + coord(:) = pbc_scaled_coords(MOD(level, 3) + 1, :) CALL sort(coord, natoms, permutation) CALL spatial_recurse(pbc_scaled_coords(:, permutation(1:nhalf)), costs(permutation(1:nhalf)), & - indices(permutation(1:nhalf)), bin_costs, distribution, level+1) - CALL spatial_recurse(pbc_scaled_coords(:, permutation(nhalf+1:)), costs(permutation(nhalf+1:)), & - indices(permutation(nhalf+1:)), bin_costs, distribution, level+1) + indices(permutation(1:nhalf)), bin_costs, distribution, level + 1) + CALL spatial_recurse(pbc_scaled_coords(:, permutation(nhalf + 1:)), costs(permutation(nhalf + 1:)), & + indices(permutation(nhalf + 1:)), bin_costs, distribution, level + 1) DEALLOCATE (coord, permutation) ENDIF @@ -1083,13 +1083,13 @@ SUBROUTINE make_cluster_distribution(coords, scaled_coords, cell, costs, & ALLOCATE (cluster_count(ncluster)) cluster_count = 0 DO i = 1, natom - cluster_count(atom_to_cluster(i)) = cluster_count(atom_to_cluster(i))+1 + cluster_count(atom_to_cluster(i)) = cluster_count(atom_to_cluster(i)) + 1 cluster_center(:, atom_to_cluster(i)) = coords(:, i) ENDDO cluster_low = HUGE(0.0_dp)/2 cluster_high = -HUGE(0.0_dp)/2 DO i = 1, natom - fold = pbc(coords(:, i)-cluster_center(:, atom_to_cluster(i)), cell)+cluster_center(:, atom_to_cluster(i)) + fold = pbc(coords(:, i) - cluster_center(:, atom_to_cluster(i)), cell) + cluster_center(:, atom_to_cluster(i)) cluster_low(:, atom_to_cluster(i)) = MIN(cluster_low(:, atom_to_cluster(i)), fold(:)) cluster_high(:, atom_to_cluster(i)) = MAX(cluster_high(:, atom_to_cluster(i)), fold(:)) ENDDO @@ -1101,14 +1101,14 @@ SUBROUTINE make_cluster_distribution(coords, scaled_coords, cell, costs, & WRITE (output_unit, '(T2,A,T48,I8)') "Largest cluster in atoms", MAXVAL(cluster_count) WRITE (output_unit, '(T2,A,T48,I8)') "Smallest cluster in atoms", MINVAL(cluster_count) WRITE (output_unit, '(T2,A,T48,F8.3,I8)') "Largest cartesian extend [a.u.]/cluster x=", & - MAXVAL(cluster_high(1, :)-cluster_low(1, :), MASK=(cluster_count > 0)), & - MAXLOC(cluster_high(1, :)-cluster_low(1, :), MASK=(cluster_count > 0)) + MAXVAL(cluster_high(1, :) - cluster_low(1, :), MASK=(cluster_count > 0)), & + MAXLOC(cluster_high(1, :) - cluster_low(1, :), MASK=(cluster_count > 0)) WRITE (output_unit, '(T2,A,T48,F8.3,I8)') "Largest cartesian extend [a.u.]/cluster y=", & - MAXVAL(cluster_high(2, :)-cluster_low(2, :), MASK=(cluster_count > 0)), & - MAXLOC(cluster_high(2, :)-cluster_low(2, :), MASK=(cluster_count > 0)) + MAXVAL(cluster_high(2, :) - cluster_low(2, :), MASK=(cluster_count > 0)), & + MAXLOC(cluster_high(2, :) - cluster_low(2, :), MASK=(cluster_count > 0)) WRITE (output_unit, '(T2,A,T48,F8.3,I8)') "Largest cartesian extend [a.u.]/cluster z=", & - MAXVAL(cluster_high(3, :)-cluster_low(3, :), MASK=(cluster_count > 0)), & - MAXLOC(cluster_high(3, :)-cluster_low(3, :), MASK=(cluster_count > 0)) + MAXVAL(cluster_high(3, :) - cluster_low(3, :), MASK=(cluster_count > 0)), & + MAXLOC(cluster_high(3, :) - cluster_low(3, :), MASK=(cluster_count > 0)) ENDIF DEALLOCATE (atom_to_cluster, cluster_cost, cluster_to_row, cluster_to_col, sorted_cost, piv_cost, proc_cost) @@ -1141,10 +1141,10 @@ SUBROUTINE assign_clusters(cluster_cost, piv_cost, proc_cost, cluster_assign, np sort_proc_cost(:) = proc_cost(:) CALL sort(sort_proc_cost, nproc, piv_pcost) - offset = (SIZE(cluster_cost)/nproc-ilevel+1)*nproc+1 + offset = (SIZE(cluster_cost)/nproc - ilevel + 1)*nproc + 1 DO i = 1, nproc - cluster_assign(piv_cost(offset-i)) = piv_pcost(i) - proc_cost(piv_pcost(i)) = proc_cost(piv_pcost(i))+cluster_cost(piv_cost(offset-i)) + cluster_assign(piv_cost(offset - i)) = piv_pcost(i) + proc_cost(piv_pcost(i)) = proc_cost(piv_pcost(i)) + cluster_cost(piv_cost(offset - i)) END DO END DO @@ -1195,7 +1195,7 @@ RECURSIVE SUBROUTINE cluster_recurse(coord, scaled_coord, cell, costs, cluster_i nsplits = MIN(INT(MIN(INT(MAX(6, INT(60.00/LOG(REAL(natoms, KIND=dp)))), KIND=int_8), ncluster)), natoms) ENDIF IF (nsplits == 1) THEN - icluster = icluster+1 + icluster = icluster + 1 cluster_inds = icluster fin_cluster_cost(icluster) = SUM(costs) ELSE @@ -1211,11 +1211,11 @@ RECURSIVE SUBROUTINE cluster_recurse(coord, scaled_coord, cell, costs, cluster_i found = .FALSE. DO i = 1, 5 IF (balance .GT. 1.1) THEN - CALL kmeans(nsplits, coord, scaled_coord, cell, cluster_inds, nat_cluster, seed+i*40, conv) + CALL kmeans(nsplits, coord, scaled_coord, cell, cluster_inds, nat_cluster, seed + i*40, conv) balance_new = MAXVAL(REAL(nat_cluster, KIND=dp))/MINVAL(REAL(nat_cluster, KIND=dp)) IF (balance_new .LT. balance) THEN balance = balance_new - min_seed = seed+i*40; + min_seed = seed + i*40; END IF ELSE found = .TRUE. @@ -1228,17 +1228,17 @@ RECURSIVE SUBROUTINE cluster_recurse(coord, scaled_coord, cell, costs, cluster_i ! compute the cost of each cluster to decide how many splits have to be performed on the next lower level DO i = 1, natoms - cluster_cost(cluster_inds(i)) = cluster_cost(cluster_inds(i))+costs(i) + cluster_cost(cluster_inds(i)) = cluster_cost(cluster_inds(i)) + costs(i) END DO tot_cost = SUM(cluster_cost) ! compute new splitting, can be done more elegant ncluster_new(:) = ncluster*cluster_cost(:)/tot_cost - nleft = INT(ncluster-SUM(ncluster_new)) + nleft = INT(ncluster - SUM(ncluster_new)) ! As we won't have empty clusters, we can not have 0 as new size, so we correct for this at first DO i = 1, nsplits IF (ncluster_new(i) == 0) THEN ncluster_new(i) = 1 - nleft = nleft-1 + nleft = nleft - 1 END IF END DO ! now comes the next part that the number of clusters will not match anymore, so try to correct in a meaningful way without @@ -1248,14 +1248,14 @@ RECURSIVE SUBROUTINE cluster_recurse(coord, scaled_coord, cell, costs, cluster_i IF (nleft < 0) THEN maxv = MINLOC(cluster_cost/ncluster_new) IF (ncluster_new(maxv(1)) .NE. 1) THEN - ncluster_new(maxv) = ncluster_new(maxv)-1 + ncluster_new(maxv) = ncluster_new(maxv) - 1 ELSE maxv = MAXLOC(ncluster_new) - ncluster_new(maxv) = ncluster_new(maxv)-1 + ncluster_new(maxv) = ncluster_new(maxv) - 1 END IF ELSE maxv = MAXLOC(cluster_cost/ncluster_new) - ncluster_new(maxv) = ncluster_new(maxv)+1 + ncluster_new(maxv) = ncluster_new(maxv) + 1 END IF END DO END IF @@ -1267,10 +1267,10 @@ RECURSIVE SUBROUTINE cluster_recurse(coord, scaled_coord, cell, costs, cluster_i ibeg = 1; iend = 0 DO i = 1, nsplits IF (nat_cluster(i) == 0) CYCLE - iend = iend+nat_cluster(i) + iend = iend + nat_cluster(i) CALL cluster_recurse(coord(:, piv(ibeg:iend)), scaled_coord(:, piv(ibeg:iend)), cell, costs(piv(ibeg:iend)), & inds_tmp(ibeg:iend), ncluster_new(i), icluster, fin_cluster_cost) - ibeg = ibeg+nat_cluster(i) + ibeg = ibeg + nat_cluster(i) END DO ! copy the sorted cluster IDs on the old layout, inds_tmp gets set at the lowest level of recursion cluster_inds(piv(:)) = inds_tmp @@ -1332,7 +1332,7 @@ SUBROUTINE kmeans(ncent, coord, scaled_coord, cell, cluster, nat_cl, seed, tot_v ind = CEILING(rn*nat) cent_coord(:, i) = coord(:, ind) devi = HUGE(1.0_dp) - DO j = 1, i-1 + DO j = 1, i - 1 dvec = pbc(cent_coord(:, j), cent_coord(:, i), cell) dist = SQRT(DOT_PRODUCT(dvec, dvec)) IF (dist .LT. devi) devi = dist @@ -1357,14 +1357,14 @@ SUBROUTINE kmeans(ncent, coord, scaled_coord, cell, cluster, nat_cl, seed, tot_v DO i = 1, nat devi = HUGE(1.0_dp); oldc = cluster(i) DO j = 1, ncent - dist = dmat(j, i)+MAX(nat_cl(j)**2/nat*ncent, nat/ncent) + dist = dmat(j, i) + MAX(nat_cl(j)**2/nat*ncent, nat/ncent) IF (dist .LT. devi) THEN devi = dist; cluster(i) = j END IF END DO - deviat(cluster(i)) = deviat(cluster(i))+SQRT(devi) - nat_cl(cluster(i)) = nat_cl(cluster(i))+1 - tot_var = tot_var+devi + deviat(cluster(i)) = deviat(cluster(i)) + SQRT(devi) + nat_cl(cluster(i)) = nat_cl(cluster(i)) + 1 + tot_var = tot_var + devi IF (oldc .NE. cluster(i)) changed = .TRUE. END DO ! get the update of the centers done, add a new one in case one center lost all its atoms @@ -1375,8 +1375,8 @@ SUBROUTINE kmeans(ncent, coord, scaled_coord, cell, cluster, nat_cl, seed, tot_v ! The mapping on the unit circle allows to circumvent all problems average = 0.0_dp DO i = 1, SIZE(coord, 2) - average(:, cluster(i), 1) = average(:, cluster(i), 1)+COS(scaled_coord(:, i)*2.0_dp*pi) - average(:, cluster(i), 2) = average(:, cluster(i), 2)+SIN(scaled_coord(:, i)*2.0_dp*pi) + average(:, cluster(i), 1) = average(:, cluster(i), 1) + COS(scaled_coord(:, i)*2.0_dp*pi) + average(:, cluster(i), 2) = average(:, cluster(i), 2) + SIN(scaled_coord(:, i)*2.0_dp*pi) END DO DO i = 1, ncent @@ -1386,7 +1386,7 @@ SUBROUTINE kmeans(ncent, coord, scaled_coord, cell, cluster, nat_cl, seed, tot_v ELSE average(:, i, 1) = average(:, i, 1)/REAL(nat_cl(i), dp) average(:, i, 2) = average(:, i, 2)/REAL(nat_cl(i), dp) - scaled_cent(:, i) = (ATAN2(-average(:, i, 2), -average(:, i, 1))+pi)/(2.0_dp*pi) + scaled_cent(:, i) = (ATAN2(-average(:, i, 2), -average(:, i, 1)) + pi)/(2.0_dp*pi) CALL scaled_to_real(cent_coord(:, i), scaled_cent(:, i), cell) END IF END DO diff --git a/src/dkh_main.F b/src/dkh_main.F index 77d5757b2d..ffe1893dd0 100644 --- a/src/dkh_main.F +++ b/src/dkh_main.F @@ -198,8 +198,8 @@ SUBROUTINE DKH_full_transformation(qs_env, matrix_s, matrix_v, matrix_t, matrix_ !----------------------------------------------------------------------- DO i = 1, n - aa(i) = SQRT((c_light_au**2+e(i))/(2.0_dp*e(i))) - rr(i) = SQRT(c_light_au**2)/(c_light_au**2+e(i)) + aa(i) = SQRT((c_light_au**2 + e(i))/(2.0_dp*e(i))) + rr(i) = SQRT(c_light_au**2)/(c_light_au**2 + e(i)) END DO !----------------------------------------------------------------------- @@ -334,7 +334,7 @@ SUBROUTINE kintegral(n, ev0t, tt, e) tv4 prea = 1/(c_light_au**2) - con2 = prea+prea + con2 = prea + prea con = 1.0_dp/prea DO i = 1, n @@ -352,11 +352,11 @@ SUBROUTINE kintegral(n, ev0t, tt, e) tv2 = -tv1*tt(i)*prea*0.5_dp tv3 = -tv2*tt(i)*prea tv4 = -tv3*tt(i)*prea*1.25_dp - ev0t(i) = tv1+tv2+tv3+tv4 + ev0t(i) = tv1 + tv2 + tv3 + tv4 ELSE - ev0t(i) = con*(SQRT(1.0_dp+con2*tt(i))-1.0_dp) + ev0t(i) = con*(SQRT(1.0_dp + con2*tt(i)) - 1.0_dp) END IF - e(i) = ev0t(i)+con + e(i) = ev0t(i) + con END DO RETURN @@ -1036,7 +1036,7 @@ SUBROUTINE mat_1_over_h(matrix_p, matrix_pp, e, matrix_aux) DO j = 1, ncol_local DO i = 1, nrow_local - matrix_aux%local_data(i, j) = 1/(e(row_indices(i))+e(col_indices(j))) + matrix_aux%local_data(i, j) = 1/(e(row_indices(i)) + e(col_indices(j))) ENDDO ENDDO @@ -1403,7 +1403,7 @@ SUBROUTINE DKH_atom_transformation(s, v, h, pVp, n, dkh_order) DO i = 1, n DO j = 1, i DO k = 1, n - h(i, j) = h(i, j)+revt(i, k)*revt(j, k)*ev0t(k) + h(i, j) = h(i, j) + revt(i, k)*revt(j, k)*ev0t(k) h(j, i) = h(i, j) END DO END DO @@ -1414,8 +1414,8 @@ SUBROUTINE DKH_atom_transformation(s, v, h, pVp, n, dkh_order) !----------------------------------------------------------------------- DO i = 1, n - aa(i) = SQRT((c_light_au**2+e(i))/(2.0_dp*e(i))) - rr(i) = SQRT(c_light_au**2)/(c_light_au**2+e(i)) + aa(i) = SQRT((c_light_au**2 + e(i))/(2.0_dp*e(i))) + rr(i) = SQRT(c_light_au**2)/(c_light_au**2 + e(i)) END DO !----------------------------------------------------------------------- @@ -1554,7 +1554,7 @@ SUBROUTINE kintegral_a(n, ev0t, tt, e) ! Calculate some constants prea = 1/(c_light_au**2) - con2 = prea+prea + con2 = prea + prea con = 1.0_dp/prea ! If T is sufficiently small, use series expansion to avoid @@ -1567,11 +1567,11 @@ SUBROUTINE kintegral_a(n, ev0t, tt, e) tv2 = -tv1*tt(i)*prea/2.0_dp tv3 = -tv2*tt(i)*prea tv4 = -tv3*tt(i)*prea*1.25_dp - ev0t(i) = tv1+tv2+tv3+tv4 + ev0t(i) = tv1 + tv2 + tv3 + tv4 ELSE - ev0t(i) = con*(SQRT(1.0_dp+con2*tt(i))-1.0_dp) + ev0t(i) = con*(SQRT(1.0_dp + con2*tt(i)) - 1.0_dp) END IF - e(i) = ev0t(i)+con + e(i) = ev0t(i) + con END DO RETURN @@ -1614,7 +1614,7 @@ SUBROUTINE even1_a(n, ev1t, vt, pvpt, aa, rr) DO i = 1, n DO j = 1, i - ev1t(i, j) = vt(i, j)*aa(i)*aa(j)+pVpt(i, j)*aa(i)*rr(i)*aa(j)*rr(j) + ev1t(i, j) = vt(i, j)*aa(i)*aa(j) + pVpt(i, j)*aa(i)*rr(i)*aa(j)*rr(j) ev1t(j, i) = ev1t(i, j) END DO END DO @@ -1660,7 +1660,7 @@ SUBROUTINE peven1p_a(n, pev1tp, vt, pvpt, aa, rr, tt) DO i = 1, n DO j = 1, i - pev1tp(i, j) = 4.0_dp*vt(i, j)*aa(i)*aa(j)*rr(i)*rr(i)*rr(j)*rr(j)*tt(i)*tt(j)+ & + pev1tp(i, j) = 4.0_dp*vt(i, j)*aa(i)*aa(j)*rr(i)*rr(i)*rr(j)*rr(j)*tt(i)*tt(j) + & pVpt(i, j)*aa(i)*rr(i)*aa(j)*rr(j) pev1tp(j, i) = pev1tp(i, j) END DO @@ -2228,7 +2228,7 @@ SUBROUTINE mat_1_over_h_a(p, n, e) DO i = 1, n DO j = 1, n - p(i, j) = p(i, j)/(e(i)+e(j)) + p(i, j) = p(i, j)/(e(i) + e(j)) ENDDO ENDDO @@ -2450,7 +2450,7 @@ SUBROUTINE mat_add2(p, alpha, beta, r, n) DO i = 1, n DO j = 1, n - p(i, j) = alpha*p(i, j)+beta*r(i, j) + p(i, j) = alpha*p(i, j) + beta*r(i, j) ENDDO ENDDO @@ -2501,7 +2501,7 @@ SUBROUTINE mat_add(p, alpha, q, beta, r, n) DO i = 1, n DO j = 1, n - p(i, j) = alpha*q(i, j)+beta*r(i, j) + p(i, j) = alpha*q(i, j) + beta*r(i, j) ENDDO ENDDO @@ -2535,7 +2535,7 @@ SUBROUTINE TRSM(W, B, C, N, H) IJ = 0 DO I = 1, N DO J = 1, I - IJ = IJ+1 + IJ = IJ + 1 C(I, J) = 0.0_dp C(J, I) = 0.0_dp H(I, J) = 0.0_dp @@ -2545,7 +2545,7 @@ SUBROUTINE TRSM(W, B, C, N, H) DO I = 1, N DO L = 1, N DO K = 1, N - H(I, L) = B(K, I)*W(K, L)+H(I, L) + H(I, L) = B(K, I)*W(K, L) + H(I, L) END DO END DO END DO @@ -2553,9 +2553,9 @@ SUBROUTINE TRSM(W, B, C, N, H) IJ = 0 DO I = 1, N DO J = 1, I - IJ = IJ+1 + IJ = IJ + 1 DO L = 1, N - C(I, J) = H(I, L)*B(L, J)+C(I, J) + C(I, J) = H(I, L)*B(L, J) + C(I, J) C(J, I) = C(I, J) END DO END DO @@ -2597,7 +2597,7 @@ SUBROUTINE dkh_diag(matrix_t_pgf, n, eig, ew, matrix_sinv_pgf, aux, ic) CALL dgemm("T", "N", n, n, n, 1.0_dp, matrix_sinv_pgf, n, eig, n, 0.0_dp, aux, n) - n2 = 3*n-1 + n2 = 3*n - 1 CALL JACOB2(AUX, EIG, EW, N, IC) RETURN @@ -2635,7 +2635,7 @@ SUBROUTINE JACOB2(sogt, eigv, eigw, n, ic) IF (i .NE. j) THEN eigv(i, j) = 0.0_dp eigv(j, i) = 0.0_dp - ext_norm = ext_norm+sogt(i, j)*sogt(i, j) + ext_norm = ext_norm + sogt(i, j)*sogt(i, j) END IF END DO END DO @@ -2651,75 +2651,75 @@ SUBROUTINE JACOB2(sogt, eigv, eigw, n, ic) DO l = 1 DO - m = l+1 + m = l + 1 DO - IF ((ABS(sogt(m, l))-thr) .GE. 0.0_dp) THEN + IF ((ABS(sogt(m, l)) - thr) .GE. 0.0_dp) THEN ind = 1 - x = 0.5_dp*(eigw(l)-eigw(m)) - y = -sogt(m, l)/SQRT(sogt(m, l)*sogt(m, l)+x*x) + x = 0.5_dp*(eigw(l) - eigw(m)) + y = -sogt(m, l)/SQRT(sogt(m, l)*sogt(m, l) + x*x) IF (x .LT. 0.0_dp) y = -y IF (y .GT. 1.0_dp) y = 1.0_dp IF (y .LT. -1.0_dp) y = -1.0_dp - xy = 1.0_dp-y*y - sint = y/SQRT(2.0_dp*(1.0_dp+SQRT(xy))) + xy = 1.0_dp - y*y + sint = y/SQRT(2.0_dp*(1.0_dp + SQRT(xy))) sint2 = sint*sint - cost2 = 1.0_dp-sint2 + cost2 = 1.0_dp - sint2 cost = SQRT(cost2) sincs = sint*cost DO i = 1, n - IF ((i-m) .NE. 0) THEN - IF ((i-m) .LT. 0) THEN + IF ((i - m) .NE. 0) THEN + IF ((i - m) .LT. 0) THEN im = m mm = i ELSE im = i mm = m END IF - IF ((i-l) .NE. 0) THEN - IF ((i-l) .LT. 0) THEN + IF ((i - l) .NE. 0) THEN + IF ((i - l) .LT. 0) THEN il = l ll = i ELSE il = i ll = l END IF - x = sogt(il, ll)*cost-sogt(im, mm)*sint - sogt(im, mm) = sogt(il, ll)*sint+sogt(im, mm)*cost + x = sogt(il, ll)*cost - sogt(im, mm)*sint + sogt(im, mm) = sogt(il, ll)*sint + sogt(im, mm)*cost sogt(il, ll) = x END IF END IF - x = eigv(i, l)*cost-eigv(i, m)*sint - eigv(i, m) = eigv(i, l)*sint+eigv(i, m)*cost + x = eigv(i, l)*cost - eigv(i, m)*sint + eigv(i, m) = eigv(i, l)*sint + eigv(i, m)*cost eigv(i, l) = x END DO x = 2.0_dp*sogt(m, l)*sincs - y = eigw(l)*cost2+eigw(m)*sint2-x - x = eigw(l)*sint2+eigw(m)*cost2+x - sogt(m, l) = (eigw(l)-eigw(m))*sincs+sogt(m, l)*(cost2-sint2) + y = eigw(l)*cost2 + eigw(m)*sint2 - x + x = eigw(l)*sint2 + eigw(m)*cost2 + x + sogt(m, l) = (eigw(l) - eigw(m))*sincs + sogt(m, l)*(cost2 - sint2) eigw(l) = y eigw(m) = x END IF - IF ((m-n) .EQ. 0) EXIT - m = m+1 + IF ((m - n) .EQ. 0) EXIT + m = m + 1 END DO - IF ((l-m+1) .EQ. 0) EXIT - l = l+1 + IF ((l - m + 1) .EQ. 0) EXIT + l = l + 1 END DO - IF ((ind-1) .NE. 0.0_dp) EXIT + IF ((ind - 1) .NE. 0.0_dp) EXIT ind = 0 END DO - IF ((thr-thr_min) .LE. 0.0_dp) EXIT + IF ((thr - thr_min) .LE. 0.0_dp) EXIT END DO END IF IF (ic .NE. 0) THEN DO i = 1, n DO j = 1, n - IF ((eigw(i)-eigw(j)) .GT. 0.0_dp) THEN + IF ((eigw(i) - eigw(j)) .GT. 0.0_dp) THEN x = eigw(i) eigw(i) = eigw(j) eigw(j) = x @@ -2774,19 +2774,19 @@ SUBROUTINE SOG(n, matrix_s_pgf, matrix_sinv_pgf) g(jn, jn) = 1.0_dp IF (jn .NE. 1) THEN - DO j = 1, jn-1 + DO j = 1, jn - 1 scalar = 0.0_dp DO i = 1, j - scalar = scalar+matrix_s_pgf(i, jn)*g(i, j) + scalar = scalar + matrix_s_pgf(i, jn)*g(i, j) END DO - diag_s = diag_s-scalar*scalar + diag_s = diag_s - scalar*scalar a(j) = scalar END DO - DO j = 1, jn-1 + DO j = 1, jn - 1 row_sum = 0.0_dp - DO k = j, jn-1 - row_sum = row_sum+a(k)*g(j, k) + DO k = j, jn - 1 + row_sum = row_sum + a(k)*g(j, k) END DO g(j, jn) = -row_sum END DO diff --git a/src/dm_ls_chebyshev.F b/src/dm_ls_chebyshev.F index 873b260b7c..f903bfc9b2 100644 --- a/src/dm_ls_chebyshev.F +++ b/src/dm_ls_chebyshev.F @@ -61,7 +61,7 @@ SUBROUTINE chebyshev_poly(value, x, n) !polynomial values !number of chev polynomials - value = COS((n-1)*ACOS(x)) + value = COS((n - 1)*ACOS(x)) END SUBROUTINE chebyshev_poly @@ -83,8 +83,8 @@ SUBROUTINE kernel(value, n, nc) !number of total chebyshev polynomials !Kernel define - value = 1.0_dp/(nc+1.0_dp)*((nc-(n-1)+1.0_dp)* & - COS(pi*(n-1)/(nc+1.0_dp))+SIN(pi*(n-1)/(nc+1.0_dp))*1.0_dp/TAN(pi/(nc+1.0_dp))) + value = 1.0_dp/(nc + 1.0_dp)*((nc - (n - 1) + 1.0_dp)* & + COS(pi*(n - 1)/(nc + 1.0_dp)) + SIN(pi*(n - 1)/(nc + 1.0_dp))*1.0_dp/TAN(pi/(nc + 1.0_dp))) END SUBROUTINE kernel @@ -200,20 +200,20 @@ SUBROUTINE compute_chebyshev(qs_env, ls_scf_env) IF (unit_nr > 0) WRITE (unit_nr, '(T2,A,1000F16.8)') "requested interval-min_energy", ev1(:) IF (unit_nr > 0) WRITE (unit_nr, '(T2,A,1000F16.8)') "requested interval-max_energy", ev2(:) ENDIF - interval_a = (max_ev-min_ev)*scale_evals/2 - interval_b = (max_ev+min_ev)/2 + interval_a = (max_ev - min_ev)*scale_evals/2 + interval_b = (max_ev + min_ev)/2 - sev1(:) = (ev1(:)-interval_b)/interval_a !scaled ev1 vector - sev2(:) = (ev2(:)-interval_b)/interval_a !scaled ev2 vector + sev1(:) = (ev1(:) - interval_b)/interval_a !scaled ev1 vector + sev2(:) = (ev2(:) - interval_b)/interval_a !scaled ev2 vector !chebyshev domain,pi*sqrt(1-x^2) vector construction and chebyshev polynomials for integration (for g(E)) - ALLOCATE (E_inte(1:ninte+1, 1:nwindow)) - ALLOCATE (sqrt_vec(1:ninte+1, 1:nwindow)) + ALLOCATE (E_inte(1:ninte + 1, 1:nwindow)) + ALLOCATE (sqrt_vec(1:ninte + 1, 1:nwindow)) DO iwindow = 1, nwindow - DO iinte = 1, ninte+1 - E_inte(iinte, iwindow) = sev1(iwindow)+((sev2(iwindow)-sev1(iwindow))/ninte)*(iinte-1) - sqrt_vec(iinte, iwindow) = pi*SQRT(1.0_dp-E_inte(iinte, iwindow)*E_inte(iinte, iwindow)) + DO iinte = 1, ninte + 1 + E_inte(iinte, iwindow) = sev1(iwindow) + ((sev2(iwindow) - sev1(iwindow))/ninte)*(iinte - 1) + sqrt_vec(iinte, iwindow) = pi*SQRT(1.0_dp - E_inte(iinte, iwindow)*E_inte(iinte, iwindow)) END DO END DO @@ -225,10 +225,10 @@ SUBROUTINE compute_chebyshev(qs_env, ls_scf_env) DO icheb = 1, ncheb CALL chebyshev_poly(initial, E_inte(1, iwindow), icheb) CALL chebyshev_poly(final, E_inte(1, iwindow), icheb) - summa = (sev2(iwindow)-sev1(iwindow))/(2.0_dp*ninte)*(initial/sqrt_vec(1, iwindow)+final/sqrt_vec(ninte+1, iwindow)) + summa = (sev2(iwindow) - sev1(iwindow))/(2.0_dp*ninte)*(initial/sqrt_vec(1, iwindow) + final/sqrt_vec(ninte + 1, iwindow)) DO iinte = 2, ninte CALL chebyshev_poly(chev_T, E_inte(iinte, iwindow), icheb) - summa = summa+((sev2(iwindow)-sev1(iwindow))/ninte)*(chev_T/sqrt_vec(iinte, iwindow)) + summa = summa + ((sev2(iwindow) - sev1(iwindow))/ninte)*(chev_T/sqrt_vec(iinte, iwindow)) END DO aitchev_T(icheb, iwindow) = summa summa = 0 @@ -267,20 +267,20 @@ SUBROUTINE compute_chebyshev(qs_env, ls_scf_env) CALL dbcsr_add(matrix_dummy2(iwindow), matrix_dummy1, 1.0_dp, 1.0_dp) END DO - DO icheb = 2, ncheb-1 + DO icheb = 2, ncheb - 1 t1 = m_walltime() CALL dbcsr_multiply("N", "N", 2.0_dp, matrix_F, matrix_tmp2, & -1.0_dp, matrix_tmp1, filter_eps=ls_scf_env%eps_filter) !matrix multiplication(Recursion) CALL dbcsr_copy(matrix_tmp3, matrix_tmp1) CALL dbcsr_copy(matrix_tmp1, matrix_tmp2) CALL dbcsr_copy(matrix_tmp2, matrix_tmp3) - CALL dbcsr_trace(matrix_tmp2, trace=mu(icheb+1)) !icheb+1 th coefficient - CALL kernel(kernel_g(icheb+1), icheb+1, ncheb) + CALL dbcsr_trace(matrix_tmp2, trace=mu(icheb + 1)) !icheb+1 th coefficient + CALL kernel(kernel_g(icheb + 1), icheb + 1, ncheb) DO iwindow = 1, nwindow CALL dbcsr_copy(matrix_dummy1, matrix_tmp2) - CALL dbcsr_scale(matrix_dummy1, 2.0_dp*kernel_g(icheb+1)*aitchev_T(icheb+1, iwindow)) !second term of chebyshev poly(matrix) + CALL dbcsr_scale(matrix_dummy1, 2.0_dp*kernel_g(icheb + 1)*aitchev_T(icheb + 1, iwindow)) !second term of chebyshev poly(matrix) CALL dbcsr_add(matrix_dummy2(iwindow), matrix_dummy1, 1.0_dp, 1.0_dp) CALL dbcsr_trace(matrix_dummy2(iwindow), trace=trace_dm(iwindow)) !icheb+1 th coefficient @@ -292,10 +292,10 @@ SUBROUTINE compute_chebyshev(qs_env, ls_scf_env) CALL m_flush(unit_nr) IF (nwindow > 0) THEN WRITE (unit_nr, '(T2,A,I5,1X,A,1X,F8.3,1X,A,1X,F8.6,1X,A,1X,1000F16.8)') & - "Iter.", icheb, "time=", t2-t1, "occ=", occ, "traces=", trace_dm(:) + "Iter.", icheb, "time=", t2 - t1, "occ=", occ, "traces=", trace_dm(:) ELSE WRITE (unit_nr, '(T2,A,I5,1X,A,1X,F8.3,1X,A,1X,F8.6)') & - "Iter.", icheb, "time=", t2-t1, "occ=", occ + "Iter.", icheb, "time=", t2 - t1, "occ=", occ ENDIF ENDIF ENDDO @@ -350,23 +350,23 @@ SUBROUTINE compute_chebyshev(qs_env, ls_scf_env) ALLOCATE (chev_Es_dos(1:n_gridpoint_dos)) ALLOCATE (dummy2(1:nwindow)) DO igrid = 1, n_gridpoint_dos - chev_E(igrid) = min_ev+(igrid-1)*(max_ev-min_ev)/(n_gridpoint_dos-1) - chev_Es_dos(igrid) = (chev_E(igrid)-interval_b)/interval_a + chev_E(igrid) = min_ev + (igrid - 1)*(max_ev - min_ev)/(n_gridpoint_dos - 1) + chev_Es_dos(igrid) = (chev_E(igrid) - interval_b)/interval_a END DO DO igrid = 1, n_gridpoint_dos dummy1 = 0.0_dp !summation of polynomials dummy2(:) = 0.0_dp !summation of polynomials DO icheb = 2, ncheb CALL chebyshev_poly(chev_T_dos, chev_Es_dos(igrid), icheb) - dummy1 = dummy1+kernel_g(icheb)*mu(icheb)*chev_T_dos + dummy1 = dummy1 + kernel_g(icheb)*mu(icheb)*chev_T_dos DO iwindow = 1, nwindow - dummy2(iwindow) = dummy2(iwindow)+kernel_g(icheb)*aitchev_T(icheb, iwindow)*chev_T_dos + dummy2(iwindow) = dummy2(iwindow) + kernel_g(icheb)*aitchev_T(icheb, iwindow)*chev_T_dos END DO END DO dos(igrid) = 1.0_dp/(interval_a*Nrows* & - (pi*SQRT(1.0_dp-chev_Es_dos(igrid)*chev_Es_dos(igrid))))*(kernel_g(1)*mu(1)+2.0_dp*dummy1) + (pi*SQRT(1.0_dp - chev_Es_dos(igrid)*chev_Es_dos(igrid))))*(kernel_g(1)*mu(1) + 2.0_dp*dummy1) DO iwindow = 1, nwindow - gdensity(igrid, iwindow) = kernel_g(1)*aitchev_T(1, iwindow)+2.0_dp*dummy2(iwindow) + gdensity(igrid, iwindow) = kernel_g(1)*aitchev_T(1, iwindow) + 2.0_dp*dummy2(iwindow) END DO WRITE (unit_dos, '(1000F16.8)') chev_E(igrid), dos(igrid), gdensity(igrid, :) END DO diff --git a/src/dm_ls_scf.F b/src/dm_ls_scf.F index 694b8af09d..7e0b6d1243 100644 --- a/src/dm_ls_scf.F +++ b/src/dm_ls_scf.F @@ -299,9 +299,9 @@ SUBROUTINE ls_scf_initial_guess(qs_env, ls_scf_env) ! actual extrapolation CALL dbcsr_set(ls_scf_env%matrix_p(ispin), 0.0_dp) DO iaspc = 1, naspc - alpha = (-1.0_dp)**(iaspc+1)*REAL(iaspc, KIND=dp)* & - binomial(2*naspc, naspc-iaspc)/binomial(2*naspc-2, naspc-1) - istore = MOD(ls_scf_env%scf_history%istore-iaspc, ls_scf_env%scf_history%nstore)+1 + alpha = (-1.0_dp)**(iaspc + 1)*REAL(iaspc, KIND=dp)* & + binomial(2*naspc, naspc - iaspc)/binomial(2*naspc - 2, naspc - 1) + istore = MOD(ls_scf_env%scf_history%istore - iaspc, ls_scf_env%scf_history%nstore) + 1 CALL dbcsr_add(ls_scf_env%matrix_p(ispin), ls_scf_env%scf_history%matrix(ispin, istore), 1.0_dp, alpha) ENDDO ENDDO @@ -403,9 +403,9 @@ SUBROUTINE ls_scf_store_result(ls_scf_env) END IF IF (ls_scf_env%scf_history%nstore > 0) THEN - ls_scf_env%scf_history%istore = ls_scf_env%scf_history%istore+1 + ls_scf_env%scf_history%istore = ls_scf_env%scf_history%istore + 1 DO ispin = 1, SIZE(ls_scf_env%matrix_p) - istore = MOD(ls_scf_env%scf_history%istore-1, ls_scf_env%scf_history%nstore)+1 + istore = MOD(ls_scf_env%scf_history%istore - 1, ls_scf_env%scf_history%nstore) + 1 CALL dbcsr_copy(ls_scf_env%scf_history%matrix(ispin, istore), ls_scf_env%matrix_p(ispin)) ! if we have the sqrt around, we use it to go to the orthogonal basis @@ -534,7 +534,7 @@ SUBROUTINE ls_scf_main(qs_env, ls_scf_env) END IF t1 = m_walltime() - iscf = iscf+1 + iscf = iscf + 1 ! first get a copy of the current KS matrix CALL get_qs_env(qs_env, matrix_ks=matrix_ks) @@ -561,7 +561,7 @@ SUBROUTINE ls_scf_main(qs_env, ls_scf_env) CALL dbcsr_copy(matrix_mixing_old(ispin), ls_scf_env%matrix_ks(ispin)) ELSE IF (ls_scf_env%ls_diis) THEN ! ------- IF-DIIS+MIX--- START - IF (diis_step .AND. (iscf-1) .GE. ls_scf_env%iter_ini_diis) THEN + IF (diis_step .AND. (iscf - 1) .GE. ls_scf_env%iter_ini_diis) THEN IF (unit_nr > 0) THEN WRITE (unit_nr, '(A61)') & '*************************************************************' @@ -584,14 +584,14 @@ SUBROUTINE ls_scf_main(qs_env, ls_scf_env) " to mix KS matrix: iscf=", iscf WRITE (unit_nr, '(A7,F5.3,A6,F5.3,A7)') & " KS_nw=", ls_scf_env%mixing_fraction, "*KS + ", & - 1.0_dp-ls_scf_env%mixing_fraction, "*KS_old" + 1.0_dp - ls_scf_env%mixing_fraction, "*KS_old" WRITE (unit_nr, '(A57)') & "*********************************************************" ENDIF ! perform the mixing of ks matrices CALL dbcsr_add(matrix_mixing_old(ispin), & ls_scf_env%matrix_ks(ispin), & - 1.0_dp-ls_scf_env%mixing_fraction, & + 1.0_dp - ls_scf_env%mixing_fraction, & ls_scf_env%mixing_fraction) ENDIF ELSE ! otherwise @@ -603,14 +603,14 @@ SUBROUTINE ls_scf_main(qs_env, ls_scf_env) " to mix KS matrix: iscf=", iscf WRITE (unit_nr, '(A7,F5.3,A6,F5.3,A7)') & " KS_nw=", ls_scf_env%mixing_fraction, "*KS + ", & - 1.0_dp-ls_scf_env%mixing_fraction, "*KS_old" + 1.0_dp - ls_scf_env%mixing_fraction, "*KS_old" WRITE (unit_nr, '(A57)') & "*********************************************************" ENDIF ! perform the mixing of ks matrices CALL dbcsr_add(matrix_mixing_old(ispin), & ls_scf_env%matrix_ks(ispin), & - 1.0_dp-ls_scf_env%mixing_fraction, & + 1.0_dp - ls_scf_env%mixing_fraction, & ls_scf_env%mixing_fraction) ENDIF ! ------- IF-DIIS+MIX--- END ENDIF @@ -685,13 +685,13 @@ SUBROUTINE ls_scf_main(qs_env, ls_scf_env) ENDIF ! report current SCF loop - energy_diff = energy_new-energy_old + energy_diff = energy_new - energy_old energy_old = energy_new t2 = m_walltime() IF (unit_nr > 0) THEN WRITE (unit_nr, *) - WRITE (unit_nr, '(T2,A,I6,F20.9,F20.9,F12.6)') "SCF", iscf, energy_new, energy_diff, t2-t1 + WRITE (unit_nr, '(T2,A,I6,F20.9,F20.9,F12.6)') "SCF", iscf, energy_new, energy_diff, t2 - t1 WRITE (unit_nr, *) CALL m_flush(unit_nr) ENDIF @@ -968,7 +968,7 @@ SUBROUTINE post_scf_mu_scan(ls_scf_env) t1 = m_walltime() - mu = -0.4_dp+imu*(0.1_dp+0.4_dp)/nmu + mu = -0.4_dp + imu*(0.1_dp + 0.4_dp)/nmu IF (unit_nr > 0) WRITE (unit_nr, *) "------- starting with mu ", mu @@ -985,7 +985,7 @@ SUBROUTINE post_scf_mu_scan(ls_scf_env) t2 = m_walltime() - IF (unit_nr > 0) WRITE (unit_nr, *) " obtained ", mu, trace, t2-t1 + IF (unit_nr > 0) WRITE (unit_nr, *) " obtained ", mu, trace, t2 - t1 ENDDO diff --git a/src/dm_ls_scf_curvy.F b/src/dm_ls_scf_curvy.F index 82bab5179f..9b0246b34f 100644 --- a/src/dm_ls_scf_curvy.F +++ b/src/dm_ls_scf_curvy.F @@ -110,7 +110,7 @@ SUBROUTINE dm_ls_curvy_optimization(ls_scf_env, energy, check_conv) ELSE CALL new_p_from_save(ls_scf_env%matrix_p, ls_scf_env%curvy_data%matrix_psave, lsstep, & ls_scf_env%curvy_data%double_step_size) - ls_scf_env%curvy_data%line_search_step = ls_scf_env%curvy_data%line_search_step+1 + ls_scf_env%curvy_data%line_search_step = ls_scf_env%curvy_data%line_search_step + 1 CALL timestop(handle) RETURN END IF @@ -174,7 +174,7 @@ SUBROUTINE optimization_step(curvy_data, ls_scf_env) curvy_data%BCH_saved = 0 ELSE IF (curvy_data%line_search_step == 2) THEN step_size = curvy_data%step_size - IF (curvy_data%energies(1)-curvy_data%energies(2) .GT. 0.0_dp) THEN + IF (curvy_data%energies(1) - curvy_data%energies(2) .GT. 0.0_dp) THEN curvy_data%step_size = curvy_data%step_size*2.0_dp curvy_data%double_step_size = .TRUE. ELSE @@ -195,7 +195,7 @@ SUBROUTINE optimization_step(curvy_data, ls_scf_env) curvy_data%n_bch_hist) ! line_search type has the value appropriate to the numeber of energy calculations needed - curvy_data%line_search_step = MOD(curvy_data%line_search_step, curvy_data%line_search_type)+1 + curvy_data%line_search_step = MOD(curvy_data%line_search_step, curvy_data%line_search_type) + 1 IF (curvy_data%line_search_step == 1) THEN DO ispin = 1, SIZE(curvy_data%matrix_p) CALL dbcsr_copy(curvy_data%matrix_p(ispin), ls_scf_env%matrix_p(ispin)) @@ -226,7 +226,7 @@ SUBROUTINE line_search_2d(energies, step_size) TYPE(cp_logger_type), POINTER :: logger logger => cp_get_default_logger() - IF (energies(1)-energies(2) .LT. 0._dp) THEN + IF (energies(1) - energies(2) .LT. 0._dp) THEN tmp_e = energies(2); energies(2) = energies(3); energies(3) = tmp_e step_size = step_size*2.0_dp END IF @@ -245,20 +245,20 @@ SUBROUTINE line_search_2d(energies, step_size) CALL invmat(sys_lin_eq, info) param = MATMUL(sys_lin_eq, energies) - v1 = (param(2)*param(4))/(2.0_dp*param(1))-param(5) - v2 = -(param(2)**2)/(2.0_dp*param(1))+2.0_dp*param(3) + v1 = (param(2)*param(4))/(2.0_dp*param(1)) - param(5) + v2 = -(param(2)**2)/(2.0_dp*param(1)) + 2.0_dp*param(3) step_size(2) = v1/v2 - step_size(1) = (-param(2)*step_size(2)-param(4))/(2.0_dp*param(1)) + step_size(1) = (-param(2)*step_size(2) - param(4))/(2.0_dp*param(1)) IF (step_size(1) .LT. 0.0_dp) step_size(1) = 1.0_dp IF (step_size(2) .LT. 0.0_dp) step_size(2) = 1.0_dp ! step_size(1)=MIN(step_size(1),2.0_dp) ! step_size(2)=MIN(step_size(2),2.0_dp) - e_pred = param(1)*step_size(1)**2+param(2)*step_size(1)*step_size(2)+ & - param(3)*step_size(2)**2+param(4)*step_size(1)+param(5)*step_size(2)+param(6) + e_pred = param(1)*step_size(1)**2 + param(2)*step_size(1)*step_size(2) + & + param(3)*step_size(2)**2 + param(4)*step_size(1) + param(5)*step_size(2) + param(6) IF (unit_nr .GT. 0) WRITE (unit_nr, "(t3,a,F10.5,F10.5,A,F20.9)") & " Line Search: Step Size", step_size, " Predicted energy", e_pred - e_pred = param(1)*s1**2+param(2)*s2*s1*0.0_dp+ & - param(3)*s1**2*0.0_dp+param(4)*s1+param(5)*s1*0.0_dp+param(6) + e_pred = param(1)*s1**2 + param(2)*s2*s1*0.0_dp + & + param(3)*s1**2*0.0_dp + param(4)*s1 + param(5)*s1*0.0_dp + param(6) END SUBROUTINE line_search_2d @@ -283,7 +283,7 @@ SUBROUTINE line_search_3pnt(energies, step_size) TYPE(cp_logger_type), POINTER :: logger logger => cp_get_default_logger() - IF (energies(1)-energies(2) .LT. 0._dp) THEN + IF (energies(1) - energies(2) .LT. 0._dp) THEN tmp_e = energies(2); energies(2) = energies(3); energies(3) = tmp_e step_size = step_size*2.0_dp END IF @@ -294,11 +294,11 @@ SUBROUTINE line_search_3pnt(energies, step_size) ENDIF step1 = 0.5_dp*step_size(1) c = energies(1) - a = (energies(3)+c-2.0_dp*energies(2))/(2.0_dp*step1**2) - b = (energies(2)-c-a*step1**2)/step1 + a = (energies(3) + c - 2.0_dp*energies(2))/(2.0_dp*step1**2) + b = (energies(2) - c - a*step1**2)/step1 IF (a .LT. 1.0E-12_dp) a = -1.0E-12_dp min_val = -b/(2.0_dp*a) - e_pred = a*min_val**2+b*min_val+c + e_pred = a*min_val**2 + b*min_val + c tmp = step_size(1) IF (e_pred .LT. energies(1) .AND. e_pred .LT. energies(2)) THEN step_size = MAX(-1.0_dp, & @@ -306,7 +306,7 @@ SUBROUTINE line_search_3pnt(energies, step_size) ELSE step_size = 1.0_dp END IF - e_pred = a*(step_size(1))**2+b*(step_size(1))+c + e_pred = a*(step_size(1))**2 + b*(step_size(1)) + c IF (unit_nr .GT. 0) THEN WRITE (unit_nr, "(t3,a,f16.8,a,F20.9)") "Line Search: Step Size", step_size(1), " Predicted energy", e_pred CALL m_flush(unit_nr) @@ -393,7 +393,7 @@ SUBROUTINE compute_direction_newton(matrix_p, matrix_ks, matrix_dp, eps_filter, conv_val = MAX(0.010_dp*old_conv, 100.0_dp*eps_filter) old_conv = 100.0_dp IF (fix_shift(ispin)) THEN - shift = MAX(min_shift, MIN(10.0_dp, MAX(shift, curvy_shift(ispin)-0.5_dp*curvy_shift(ispin)))) + shift = MAX(min_shift, MIN(10.0_dp, MAX(shift, curvy_shift(ispin) - 0.5_dp*curvy_shift(ispin)))) curvy_shift(ispin) = shift END IF @@ -502,7 +502,7 @@ SUBROUTINE compute_cg_matrices(Ax, res, cg, deltp, tmp, eps_filter, at_limit) CALL dbcsr_add(tmp, Ax, 1.0_dp, -fac) devi(i) = dbcsr_frobenius_norm(tmp) lin_eq(i, :) = (/fac**2, fac, 1.0_dp/) - fac = fac1+fac1*((-1)**i)*0.5_dp + fac = fac1 + fac1*((-1)**i)*0.5_dp END DO CALL invmat(lin_eq, info) vec = MATMUL(lin_eq, devi) @@ -676,7 +676,7 @@ SUBROUTINE update_p_exp(matrix_p_in, matrix_p_out, matrix_dp, matrix_BCH, thresh ! If the copy and scale isn't enough compute a few more BCH steps. 20 seems high but except of the first step it will never be close save_BCH = BCH_saved(ispin) == 0 .AND. n_bch_hist .GT. 0 - DO i = BCH_saved(ispin)+1, 20 + DO i = BCH_saved(ispin) + 1, 20 step_fac = step_fac*step_size(ispin) !allow for a bit of matrix magic here by exploiting matrix and matrix_tmp !matrix_tmp is alway the previous order of the BCH series diff --git a/src/dm_ls_scf_methods.F b/src/dm_ls_scf_methods.F index 44dcc051f2..f3e9b14fb9 100644 --- a/src/dm_ls_scf_methods.F +++ b/src/dm_ls_scf_methods.F @@ -413,27 +413,27 @@ SUBROUTINE density_matrix_sign(matrix_p, mu, fixed_mu, sign_method, sign_order, ! bisect if both bounds are known, otherwise find the bounds with a linear search DO iter = 1, 30 IF (has_mu_low .AND. has_mu_high) THEN - mu = (mu_low+mu_high)/2 - IF (ABS(mu_high-mu_low) < threshold) EXIT + mu = (mu_low + mu_high)/2 + IF (ABS(mu_high - mu_low) < threshold) EXIT ENDIF CALL density_matrix_sign_fixed_mu(matrix_p, trace, mu, sign_method, sign_order, & matrix_ks, matrix_s, matrix_s_inv, threshold) IF (unit_nr > 0) WRITE (unit_nr, '(T2,A,I2,1X,F13.9,1X,F15.9)') & - "Density matrix: iter, mu, trace error: ", iter, mu, trace-nelectron + "Density matrix: iter, mu, trace error: ", iter, mu, trace - nelectron ! OK, we can skip early if we are as close as possible to the exact result ! smaller differences should be considered 'noise' - IF (ABS(trace-nelectron) < 0.5_dp .OR. fixed_mu) EXIT + IF (ABS(trace - nelectron) < 0.5_dp .OR. fixed_mu) EXIT IF (trace < nelectron) THEN mu_low = mu - mu = mu+increment + mu = mu + increment has_mu_low = .TRUE. increment = increment*2 ELSE mu_high = mu - mu = mu-increment + mu = mu - increment has_mu_high = .TRUE. increment = increment*2 ENDIF @@ -629,9 +629,9 @@ SUBROUTINE density_matrix_trs4(matrix_p, matrix_ks, matrix_s_sqrt_inv, & IF (unit_nr > 0) THEN WRITE (unit_nr, '(T6,A,1X,L12)') "Lanczos converged: ", arnoldi_converged WRITE (unit_nr, '(T6,A,1X,F12.5)') "change in mixed matrix: ", maxdev - WRITE (unit_nr, '(T6,A,1X,F12.5)') "HOMO upper bound: ", e_homo+maxdev - WRITE (unit_nr, '(T6,A,1X,F12.5)') "LUMO lower bound: ", e_lumo-maxdev - WRITE (unit_nr, '(T6,A,1X,L12)') "Predicts a gap ? ", ((e_lumo-maxdev)-(e_homo+maxdev)) > 0 + WRITE (unit_nr, '(T6,A,1X,F12.5)') "HOMO upper bound: ", e_homo + maxdev + WRITE (unit_nr, '(T6,A,1X,F12.5)') "LUMO lower bound: ", e_lumo - maxdev + WRITE (unit_nr, '(T6,A,1X,L12)') "Predicts a gap ? ", ((e_lumo - maxdev) - (e_homo + maxdev)) > 0 ENDIF ! save the old mixed matrix CALL dbcsr_copy(matrix_ks_deviation, matrix_x_nosym) @@ -651,14 +651,14 @@ SUBROUTINE density_matrix_trs4(matrix_p, matrix_ks, matrix_s_sqrt_inv, & CALL dbcsr_scale(matrix_x, 1.0_dp/eps_max) ELSE CALL dbcsr_add_on_diag(matrix_x, -eps_max) - CALL dbcsr_scale(matrix_x, -1.0_dp/(eps_max-eps_min)) + CALL dbcsr_scale(matrix_x, -1.0_dp/(eps_max - eps_min)) ENDIF current_threshold = threshold IF (do_dyn_threshold) THEN ! scale bounds for HOMO/LUMO - scaled_homo_bound = (eps_max-(e_homo+maxdev))/(eps_max-eps_min) - scaled_lumo_bound = (eps_max-(e_lumo-maxdev))/(eps_max-eps_min) + scaled_homo_bound = (eps_max - (e_homo + maxdev))/(eps_max - eps_min) + scaled_lumo_bound = (eps_max - (e_lumo - maxdev))/(eps_max - eps_min) ENDIF CALL dbcsr_create(matrix_xsq, template=matrix_ks, matrix_type="S") @@ -702,7 +702,7 @@ SUBROUTINE density_matrix_trs4(matrix_p, matrix_ks, matrix_s_sqrt_inv, & ! if converged, and gam becomes noisy, fix it to 3, which results in a final McWeeny step. ! do this only if the electron count is reasonable. ! maybe tune if the current criterion is not good enough - delta_n = nelectron-trace_fx + delta_n = nelectron - trace_fx ! condition: ABS(frob_id/frob_x) < SQRT(threshold) ... IF (((frob_id*frob_id) < (threshold*frob_x*frob_x)) .AND. (ABS(delta_n) < 0.5_dp)) THEN gam = 3.0_dp @@ -721,16 +721,16 @@ SUBROUTINE density_matrix_trs4(matrix_p, matrix_ks, matrix_s_sqrt_inv, & IF (do_dyn_threshold) THEN ! quantities used for dynamic thresholding, when the estimated gap is larger than zero - xi = (scaled_homo_bound-scaled_lumo_bound) + xi = (scaled_homo_bound - scaled_lumo_bound) IF (xi > 0.0_dp) THEN - mmin = 0.5*(scaled_homo_bound+scaled_lumo_bound) - max_threshold = ABS(1-2*mmin)*xi + mmin = 0.5*(scaled_homo_bound + scaled_lumo_bound) + max_threshold = ABS(1 - 2*mmin)*xi scaled_homo_bound = evaluate_trs4_polynomial(scaled_homo_bound, gamma_values(i:), 1) scaled_lumo_bound = evaluate_trs4_polynomial(scaled_lumo_bound, gamma_values(i:), 1) estimated_steps = estimate_steps(scaled_homo_bound, scaled_lumo_bound, threshold) - est_threshold = (threshold/(estimated_steps+i+1))*xi/(1+threshold/(estimated_steps+i+1)) + est_threshold = (threshold/(estimated_steps + i + 1))*xi/(1 + threshold/(estimated_steps + i + 1)) est_threshold = MIN(max_threshold, est_threshold) IF (i > 1) est_threshold = MAX(est_threshold, 0.1_dp*current_threshold) current_threshold = est_threshold @@ -762,8 +762,8 @@ SUBROUTINE density_matrix_trs4(matrix_p, matrix_ks, matrix_s_sqrt_inv, & IF (unit_nr > 0) THEN WRITE (unit_nr, & '(T6,A,I3,1X,F10.8,E12.3,F12.3,F13.3,E12.3)') "TRS4 it ", & - i, occ_matrix, ABS(trace_gx), t2-t1, & - (flop1+flop2)/(1.0E6_dp*MAX(t2-t1, 0.001_dp)), current_threshold + i, occ_matrix, ABS(trace_gx), t2 - t1, & + (flop1 + flop2)/(1.0E6_dp*MAX(t2 - t1, 0.001_dp)), current_threshold CALL m_flush(unit_nr) ENDIF @@ -797,11 +797,11 @@ SUBROUTINE density_matrix_trs4(matrix_p, matrix_ks, matrix_s_sqrt_inv, & ! calculate the chemical potential by doing a bisection of fk(x0)-0.5, where fk is evaluated using the stored values for gamma ! E. Rubensson et al., Chem Phys Lett 432, 2006, 591-594 mu_a = 0.0_dp; mu_b = 1.0_dp; - mu_fa = evaluate_trs4_polynomial(mu_a, gamma_values, i-1)-0.5_dp + mu_fa = evaluate_trs4_polynomial(mu_a, gamma_values, i - 1) - 0.5_dp DO j = 1, 40 - mu_c = 0.5*(mu_a+mu_b) - mu_fc = evaluate_trs4_polynomial(mu_c, gamma_values, i-1)-0.5_dp ! i-1 because in the last iteration, only convergence is checked - IF (ABS(mu_fc) < 1.0E-6_dp .OR. (mu_b-mu_a)/2 < 1.0E-6_dp) EXIT !TODO: define threshold values + mu_c = 0.5*(mu_a + mu_b) + mu_fc = evaluate_trs4_polynomial(mu_c, gamma_values, i - 1) - 0.5_dp ! i-1 because in the last iteration, only convergence is checked + IF (ABS(mu_fc) < 1.0E-6_dp .OR. (mu_b - mu_a)/2 < 1.0E-6_dp) EXIT !TODO: define threshold values IF (mu_fc*mu_fa > 0) THEN mu_a = mu_c @@ -810,7 +810,7 @@ SUBROUTINE density_matrix_trs4(matrix_p, matrix_ks, matrix_s_sqrt_inv, & mu_b = mu_c ENDIF ENDDO - mu = (eps_min-eps_max)*mu_c+eps_max + mu = (eps_min - eps_max)*mu_c + eps_max DEALLOCATE (gamma_values) IF (unit_nr > 0) THEN WRITE (unit_nr, '(T6,A,1X,F12.5)') 'Chemical potential (mu): ', mu @@ -898,7 +898,7 @@ SUBROUTINE density_matrix_tc2(matrix_p, matrix_ks, matrix_s_sqrt_inv, & IF (unit_nr > 0) THEN WRITE (unit_nr, '(T6,A,1X,F12.5)') "HOMO upper bound: ", e_homo WRITE (unit_nr, '(T6,A,1X,F12.5)') "LUMO lower bound: ", e_lumo - WRITE (unit_nr, '(T6,A,1X,L12)') "Predicts a gap ? ", ((e_lumo)-(e_homo)) > 0 + WRITE (unit_nr, '(T6,A,1X,L12)') "Predicts a gap ? ", ((e_lumo) - (e_homo)) > 0 ENDIF ! get largest/smallest eigenvalues for scaling @@ -913,7 +913,7 @@ SUBROUTINE density_matrix_tc2(matrix_p, matrix_ks, matrix_s_sqrt_inv, & ! scale KS matrix CALL dbcsr_scale(matrix_x, -1.0_dp) CALL dbcsr_add_on_diag(matrix_x, eps_max) - CALL dbcsr_scale(matrix_x, 1/(eps_max-eps_min)) + CALL dbcsr_scale(matrix_x, 1/(eps_max - eps_min)) CALL dbcsr_create(matrix_xsq, template=matrix_ks, matrix_type=dbcsr_type_no_symmetry) CALL dbcsr_copy(matrix_xsq, matrix_x) @@ -929,12 +929,12 @@ SUBROUTINE density_matrix_tc2(matrix_p, matrix_ks, matrix_s_sqrt_inv, & ALLOCATE (lambda(4)) ! Controls over the non_monotonic bounds, First if low gap, bias slightly - beta = (eps_max-ABS(e_lumo))/(eps_max-eps_min) - betaB = (eps_max+ABS(e_homo))/(eps_max-eps_min) + beta = (eps_max - ABS(e_lumo))/(eps_max - eps_min) + betaB = (eps_max + ABS(e_homo))/(eps_max - eps_min) - IF ((beta-betaB) < 0.005_dp) THEN - beta = beta-0.002_dp - betaB = betaB+0.002_dp + IF ((beta - betaB) < 0.005_dp) THEN + beta = beta - 0.002_dp + betaB = betaB + 0.002_dp ENDIF ! Check if input specifies to use monotonic bounds. IF (.NOT. do_non_monotonic) THEN @@ -955,13 +955,13 @@ SUBROUTINE density_matrix_tc2(matrix_p, matrix_ks, matrix_s_sqrt_inv, & t1 = m_walltime() flop1 = 0; flop2 = 0 - IF (ABS(trace_fx-nelectron) <= ABS(trace_gx-nelectron)) THEN + IF (ABS(trace_fx - nelectron) <= ABS(trace_gx - nelectron)) THEN ! Xn+1 = (aX+ (1-a)I)^2 poly(i) = 1.0_dp - alpha(i) = 2.0_dp/(2.0_dp-beta) + alpha(i) = 2.0_dp/(2.0_dp - beta) CALL dbcsr_scale(matrix_x, alpha(i)) - CALL dbcsr_add_on_diag(matrix_x, 1.0_dp-alpha(i)) + CALL dbcsr_add_on_diag(matrix_x, 1.0_dp - alpha(i)) CALL dbcsr_multiply("N", "N", 1.0_dp, matrix_x, matrix_x, & 0.0_dp, matrix_xsq, & filter_eps=threshold, flop=flop1) @@ -971,14 +971,14 @@ SUBROUTINE density_matrix_tc2(matrix_p, matrix_ks, matrix_s_sqrt_inv, & CALL dbcsr_copy(matrix_x, matrix_xsq) - beta = (1.0_dp-alpha(i))+alpha(i)*beta + beta = (1.0_dp - alpha(i)) + alpha(i)*beta beta = beta*beta - betaB = (1.0_dp-alpha(i))+alpha(i)*betaB + betaB = (1.0_dp - alpha(i)) + alpha(i)*betaB betaB = betaB*betaB ELSE ! Xn+1 = 2aX-a^2*X^2 poly(i) = 0.0_dp - alpha(i) = 2.0_dp/(1.0_dp+betaB) + alpha(i) = 2.0_dp/(1.0_dp + betaB) CALL dbcsr_scale(matrix_x, alpha(i)) CALL dbcsr_multiply("N", "N", 1.0_dp, matrix_x, matrix_x, & @@ -991,9 +991,9 @@ SUBROUTINE density_matrix_tc2(matrix_p, matrix_ks, matrix_s_sqrt_inv, & CALL dbcsr_add(matrix_x, matrix_xsq, 2.0_dp, -1.0_dp) beta = alpha(i)*beta - beta = 2.0_dp*beta-beta*beta + beta = 2.0_dp*beta - beta*beta betaB = alpha(i)*betaB - betaB = 2.0_dp*betaB-betaB*betaB + betaB = 2.0_dp*betaB - betaB*betaB ENDIF occ_matrix = dbcsr_get_occupation(matrix_x) @@ -1001,8 +1001,8 @@ SUBROUTINE density_matrix_tc2(matrix_p, matrix_ks, matrix_s_sqrt_inv, & IF (unit_nr > 0) THEN WRITE (unit_nr, & '(T6,A,I3,1X,F10.8,E12.3,F12.3,F13.3,E12.3)') "TC2 it ", & - i, occ_matrix, t2-t1, & - (flop1+flop2)/(1.0E6_dp*(t2-t1)), threshold + i, occ_matrix, t2 - t1, & + (flop1 + flop2)/(1.0E6_dp*(t2 - t1)), threshold CALL m_flush(unit_nr) ENDIF @@ -1039,32 +1039,32 @@ SUBROUTINE density_matrix_tc2(matrix_p, matrix_ks, matrix_s_sqrt_inv, & X(2) = 1.0_dp X(3) = 0.0_dp X(4) = 0.0_dp - gama = 6.0_dp-4.0_dp*(SQRT(2.0_dp)) - gama = gama-gama*gama + gama = 6.0_dp - 4.0_dp*(SQRT(2.0_dp)) + gama = gama - gama*gama DO WHILE (nu(i) < gama) ! safeguard against negative root, is skipping correct? IF (wu(i) < 1.0e-14_dp) THEN - i = i-1 + i = i - 1 CYCLE END IF - IF ((1.0_dp-4.0_dp*nu(i)*nu(i)/wu(i)) < 0.0_dp) THEN - i = i-1 + IF ((1.0_dp - 4.0_dp*nu(i)*nu(i)/wu(i)) < 0.0_dp) THEN + i = i - 1 CYCLE END IF - Y(1) = 0.5_dp*(1.0_dp-SQRT(1.0_dp-4.0_dp*nu(i)*nu(i)/wu(i))) - Y(2) = 0.5_dp*(1.0_dp-SQRT(1.0_dp-4.0_dp*nu(i))) - Y(3) = 0.5_dp*(1.0_dp+SQRT(1.0_dp-4.0_dp*nu(i))) - Y(4) = 0.5_dp*(1.0_dp+SQRT(1.0_dp-4.0_dp*nu(i)*nu(i)/wu(i))) + Y(1) = 0.5_dp*(1.0_dp - SQRT(1.0_dp - 4.0_dp*nu(i)*nu(i)/wu(i))) + Y(2) = 0.5_dp*(1.0_dp - SQRT(1.0_dp - 4.0_dp*nu(i))) + Y(3) = 0.5_dp*(1.0_dp + SQRT(1.0_dp - 4.0_dp*nu(i))) + Y(4) = 0.5_dp*(1.0_dp + SQRT(1.0_dp - 4.0_dp*nu(i)*nu(i)/wu(i))) Y(:) = MIN(1.0_dp, MAX(0.0_dp, Y(:))) DO j = i, 1, -1 IF (poly(j) == 1.0_dp) THEN DO k = 1, 4 Y(k) = SQRT(Y(k)) - Y(k) = (Y(k)-1.0_dp+alpha(j))/alpha(j) + Y(k) = (Y(k) - 1.0_dp + alpha(j))/alpha(j) ENDDO ! end K ELSE DO k = 1, 4 - Y(k) = 1.0_dp-SQRT(1.0_dp-Y(k)) + Y(k) = 1.0_dp - SQRT(1.0_dp - Y(k)) Y(k) = Y(k)/alpha(j) ENDDO ! end K ENDIF ! end poly @@ -1073,17 +1073,17 @@ SUBROUTINE density_matrix_tc2(matrix_p, matrix_ks, matrix_s_sqrt_inv, & X(2) = MIN(X(2), Y(2)) X(3) = MAX(X(3), Y(3)) X(4) = MAX(X(4), Y(4)) - i = i-1 + i = i - 1 ENDDO ! end i ! lambda 1,2,3,4 are:: out lumo, in lumo, in homo, out homo DO k = 1, 4 - lambda(k) = eps_max-(eps_max-eps_min)*X(k) + lambda(k) = eps_max - (eps_max - eps_min)*X(k) ENDDO ! end k ! END ALGO 3 from. SIAM DOI. 10.1137/130911585 e_homo = lambda(4) e_lumo = lambda(1) - IF (unit_nr > 0) WRITE (unit_nr, '(T6,A,3E12.4)') "outer homo/lumo/gap", e_homo, e_lumo, (e_lumo-e_homo) - IF (unit_nr > 0) WRITE (unit_nr, '(T6,A,3E12.4)') "inner homo/lumo/gap", lambda(3), lambda(2), (lambda(2)-lambda(3)) + IF (unit_nr > 0) WRITE (unit_nr, '(T6,A,3E12.4)') "outer homo/lumo/gap", e_homo, e_lumo, (e_lumo - e_homo) + IF (unit_nr > 0) WRITE (unit_nr, '(T6,A,3E12.4)') "inner homo/lumo/gap", lambda(3), lambda(2), (lambda(2) - lambda(3)) DEALLOCATE (poly) DEALLOCATE (nu) @@ -1148,7 +1148,7 @@ SUBROUTINE compute_homo_lumo(matrix_k, matrix_p, eps_min, eps_max, threshold, ma 0.0_dp, tmp1, filter_eps=threshold) CALL arnoldi_extremal(tmp1, max_eig, min_eig, converged=converged, & threshold=eps_lanczos, max_iter=max_iter_lanczos) - homo = max_eig-shift1 + homo = max_eig - shift1 IF (unit_nr > 0) THEN WRITE (unit_nr, '(T6,A,1X,L12)') "Lanczos converged: ", converged ENDIF @@ -1163,11 +1163,11 @@ SUBROUTINE compute_homo_lumo(matrix_k, matrix_p, eps_min, eps_max, threshold, ma 0.0_dp, tmp1, filter_eps=threshold) CALL arnoldi_extremal(tmp1, max_eig, min_eig, converged=converged, & threshold=eps_lanczos, max_iter=max_iter_lanczos) - lumo = -max_eig+shift2 + lumo = -max_eig + shift2 IF (unit_nr > 0) THEN WRITE (unit_nr, '(T6,A,1X,L12)') "Lanczos converged: ", converged - WRITE (unit_nr, '(T6,A,1X,3F12.5)') 'HOMO/LUMO/gap', homo, lumo, lumo-homo + WRITE (unit_nr, '(T6,A,1X,3F12.5)') 'HOMO/LUMO/gap', homo, lumo, lumo - homo ENDIF CALL dbcsr_release(tmp1) CALL dbcsr_release(tmp2) @@ -1195,11 +1195,11 @@ FUNCTION evaluate_trs4_polynomial(x, gamma_values, i) RESULT(xr) xr = x DO k = 1, i IF (gamma_values(k) > gam_max) THEN - xr = 2*xr-xr**2 + xr = 2*xr - xr**2 ELSE IF (gamma_values(k) < gam_min) THEN xr = xr**2 ELSE - xr = (xr*xr)*(4*xr-3*xr*xr)+gamma_values(k)*xr*xr*((1-xr)**2) + xr = (xr*xr)*(4*xr - 3*xr*xr) + gamma_values(k)*xr*xr*((1 - xr)**2) ENDIF ENDDO END FUNCTION evaluate_trs4_polynomial @@ -1222,17 +1222,17 @@ FUNCTION estimate_steps(homo, lumo, threshold) RESULT(steps) h = homo DO i = 1, 200 - IF (ABS(l) < threshold .AND. ABS(1-h) < threshold) EXIT - m = 0.5_dp*(h+l) + IF (ABS(l) < threshold .AND. ABS(1 - h) < threshold) EXIT + m = 0.5_dp*(h + l) IF (m > 0.5_dp) THEN h = h**2 l = l**2 ELSE - h = 2*h-h**2 - l = 2*l-l**2 + h = 2*h - h**2 + l = 2*l - l**2 ENDIF ENDDO - steps = i-1 + steps = i - 1 END FUNCTION estimate_steps END MODULE dm_ls_scf_methods diff --git a/src/dm_ls_scf_qs.F b/src/dm_ls_scf_qs.F index 3cbe306ac6..ef1a5c4bb9 100644 --- a/src/dm_ls_scf_qs.F +++ b/src/dm_ls_scf_qs.F @@ -167,7 +167,7 @@ SUBROUTINE matrix_ls_create(matrix_ls, matrix_qs, ls_mstruct) ALLOCATE (clustered_blk_sizes(nmol)) clustered_blk_sizes = 0 DO iatom = 1, natom - clustered_blk_sizes(atom_to_cluster(iatom)) = clustered_blk_sizes(atom_to_cluster(iatom))+ & + clustered_blk_sizes(atom_to_cluster(iatom)) = clustered_blk_sizes(atom_to_cluster(iatom)) + & ls_blk_sizes(iatom) ENDDO ls_blk_sizes => clustered_blk_sizes ! redirect pointer @@ -609,7 +609,7 @@ SUBROUTINE ls_scf_dm_to_ks(qs_env, ls_scf_env, energy_new, iscf) IF (iscf .GT. MAX(ls_scf_env%mixing_store%nskip_mixing, 1)) THEN CALL gspace_mixing(qs_env, ls_scf_env%density_mixing_method, & ls_scf_env%mixing_store, rho, para_env, & - iscf-1) + iscf - 1) IF (unit_nr > 0) THEN WRITE (unit_nr, '(A57)') & "*********************************************************" @@ -618,7 +618,7 @@ SUBROUTINE ls_scf_dm_to_ks(qs_env, ls_scf_env, energy_new, iscf) " to mix rho: method=", ls_scf_env%mixing_store%iter_method, ", iscf=", iscf WRITE (unit_nr, '(A8,F5.3,A6,F5.3,A8)') & " rho_nw=", ls_scf_env%mixing_store%alpha, "*rho + ", & - 1.0_dp-ls_scf_env%mixing_store%alpha, "*rho_old" + 1.0_dp - ls_scf_env%mixing_store%alpha, "*rho_old" WRITE (unit_nr, '(A57)') & "*********************************************************" ENDIF diff --git a/src/domain_submatrix_methods.F b/src/domain_submatrix_methods.F index 37898578c3..2007f7a72c 100644 --- a/src/domain_submatrix_methods.F +++ b/src/domain_submatrix_methods.F @@ -657,11 +657,11 @@ SUBROUTINE add_submatrices_once(alpha, A, beta, B, transB) IF (NOTB) THEN DO icol = 1, C1 - A%mdata(:, icol) = alpha*A%mdata(:, icol)+beta*B%mdata(:, icol) + A%mdata(:, icol) = alpha*A%mdata(:, icol) + beta*B%mdata(:, icol) ENDDO ELSE DO icol = 1, C1 - A%mdata(:, icol) = alpha*A%mdata(:, icol)+beta*B%mdata(icol, :) + A%mdata(:, icol) = alpha*A%mdata(:, icol) + beta*B%mdata(icol, :) ENDDO ENDIF @@ -813,7 +813,7 @@ SUBROUTINE trace_submatrices(A, B, trace) CPASSERT(A(idomain)%ncols .EQ. B(idomain)%ncols) curr_trace = SUM(A(idomain)%mdata(:, :)*B(idomain)%mdata(:, :)) - send_trace = send_trace+curr_trace + send_trace = send_trace + curr_trace ENDIF @@ -904,8 +904,8 @@ SUBROUTINE construct_submatrices(matrix, submatrix, distr_pattern, domain_map, & ! loop over those rows that have non-zero quencher index_sr = 1 ! index start row - IF (idomain .GT. 1) index_sr = domain_map%index1(idomain-1) - index_er = domain_map%index1(idomain)-1 ! index end row + IF (idomain .GT. 1) index_sr = domain_map%index1(idomain - 1) + index_er = domain_map%index1(idomain) - 1 ! index end row DO index_row = index_sr, index_er @@ -914,8 +914,8 @@ SUBROUTINE construct_submatrices(matrix, submatrix, distr_pattern, domain_map, & IF (job_type == select_row_col) THEN ! loop over those columns that have non-zero quencher index_sc = 1 ! index start col - IF (idomain .GT. 1) index_sc = domain_map%index1(idomain-1) - index_ec = domain_map%index1(idomain)-1 ! index end col + IF (idomain .GT. 1) index_sc = domain_map%index1(idomain - 1) + index_ec = domain_map%index1(idomain) - 1 ! index end col ELSE ! fake loop index_sc = 1 ! index start col @@ -936,9 +936,9 @@ SUBROUTINE construct_submatrices(matrix, submatrix, distr_pattern, domain_map, & IF (block_node .EQ. myNode) THEN CALL dbcsr_get_block_p(matrix, row, col, block_p, found, row_size, col_size) IF (found) THEN - send_descriptor(1, dest_node+1) = send_descriptor(1, dest_node+1)+1 - send_descriptor(2, dest_node+1) = send_descriptor(2, dest_node+1)+ & - row_size*col_size + send_descriptor(1, dest_node + 1) = send_descriptor(1, dest_node + 1) + 1 + send_descriptor(2, dest_node + 1) = send_descriptor(2, dest_node + 1) + & + row_size*col_size ENDIF ENDIF @@ -983,40 +983,40 @@ SUBROUTINE construct_submatrices(matrix, submatrix, distr_pattern, domain_map, & send_size_cpu(1) = send_descriptor(2, 1) DO iNode = 2, nNodes send_size_cpu(iNode) = send_descriptor(2, iNode) - send_offset_cpu(iNode) = send_offset_cpu(iNode-1)+ & - send_size_cpu(iNode-1) + send_offset_cpu(iNode) = send_offset_cpu(iNode - 1) + & + send_size_cpu(iNode - 1) ENDDO - send_size_total = send_offset_cpu(nNodes)+send_size_cpu(nNodes) + send_size_total = send_offset_cpu(nNodes) + send_size_cpu(nNodes) ALLOCATE (recv_size_cpu(nNodes), recv_offset_cpu(nNodes)) recv_offset_cpu(1) = 0 recv_size_cpu(1) = recv_descriptor(2, 1) DO iNode = 2, nNodes recv_size_cpu(iNode) = recv_descriptor(2, iNode) - recv_offset_cpu(iNode) = recv_offset_cpu(iNode-1)+ & - recv_size_cpu(iNode-1) + recv_offset_cpu(iNode) = recv_offset_cpu(iNode - 1) + & + recv_size_cpu(iNode - 1) ENDDO - recv_size_total = recv_offset_cpu(nNodes)+recv_size_cpu(nNodes) + recv_size_total = recv_offset_cpu(nNodes) + recv_size_cpu(nNodes) ALLOCATE (send_size2_cpu(nNodes), send_offset2_cpu(nNodes)) send_offset2_cpu(1) = 0 send_size2_cpu(1) = 2*send_descriptor(1, 1) DO iNode = 2, nNodes send_size2_cpu(iNode) = 2*send_descriptor(1, iNode) - send_offset2_cpu(iNode) = send_offset2_cpu(iNode-1)+ & - send_size2_cpu(iNode-1) + send_offset2_cpu(iNode) = send_offset2_cpu(iNode - 1) + & + send_size2_cpu(iNode - 1) ENDDO - send_size2_total = send_offset2_cpu(nNodes)+send_size2_cpu(nNodes) + send_size2_total = send_offset2_cpu(nNodes) + send_size2_cpu(nNodes) ALLOCATE (recv_size2_cpu(nNodes), recv_offset2_cpu(nNodes)) recv_offset2_cpu(1) = 0 recv_size2_cpu(1) = 2*recv_descriptor(1, 1) DO iNode = 2, nNodes recv_size2_cpu(iNode) = 2*recv_descriptor(1, iNode) - recv_offset2_cpu(iNode) = recv_offset2_cpu(iNode-1)+ & - recv_size2_cpu(iNode-1) + recv_offset2_cpu(iNode) = recv_offset2_cpu(iNode - 1) + & + recv_size2_cpu(iNode - 1) ENDDO - recv_size2_total = recv_offset2_cpu(nNodes)+recv_size2_cpu(nNodes) + recv_size2_total = recv_offset2_cpu(nNodes) + recv_size2_cpu(nNodes) DEALLOCATE (send_descriptor) DEALLOCATE (recv_descriptor) @@ -1037,8 +1037,8 @@ SUBROUTINE construct_submatrices(matrix, submatrix, distr_pattern, domain_map, & ! loop over those rows that have non-zero quencher index_sr = 1 ! index start row - IF (idomain .GT. 1) index_sr = domain_map%index1(idomain-1) - index_er = domain_map%index1(idomain)-1 ! index end row + IF (idomain .GT. 1) index_sr = domain_map%index1(idomain - 1) + index_er = domain_map%index1(idomain) - 1 ! index end row DO index_row = index_sr, index_er @@ -1047,8 +1047,8 @@ SUBROUTINE construct_submatrices(matrix, submatrix, distr_pattern, domain_map, & IF (job_type == select_row_col) THEN ! loop over those columns that have non-zero quencher index_sc = 1 ! index start col - IF (idomain .GT. 1) index_sc = domain_map%index1(idomain-1) - index_ec = domain_map%index1(idomain)-1 ! index end col + IF (idomain .GT. 1) index_sc = domain_map%index1(idomain - 1) + index_ec = domain_map%index1(idomain) - 1 ! index end col ELSE ! fake loop index_sc = 1 ! index start col @@ -1079,17 +1079,17 @@ SUBROUTINE construct_submatrices(matrix, submatrix, distr_pattern, domain_map, & ! col_offset=col_offset+row_size !ENDDO col_offset = row_size*col_size - start_data = send_offset_cpu(dest_node+1)+ & - offset_block(dest_node+1) - send_data(start_data+1:start_data+col_offset) = & + start_data = send_offset_cpu(dest_node + 1) + & + offset_block(dest_node + 1) + send_data(start_data + 1:start_data + col_offset) = & block_p(1:col_offset) - offset_block(dest_node+1) = offset_block(dest_node+1)+col_offset + offset_block(dest_node + 1) = offset_block(dest_node + 1) + col_offset ! fill out row,col information - send_data2(send_offset2_cpu(dest_node+1)+ & - offset2_block(dest_node+1)+1) = row - send_data2(send_offset2_cpu(dest_node+1)+ & - offset2_block(dest_node+1)+2) = col - offset2_block(dest_node+1) = offset2_block(dest_node+1)+2 + send_data2(send_offset2_cpu(dest_node + 1) + & + offset2_block(dest_node + 1) + 1) = row + send_data2(send_offset2_cpu(dest_node + 1) + & + offset2_block(dest_node + 1) + 2) = col + offset2_block(dest_node + 1) = offset2_block(dest_node + 1) + 2 ENDIF ENDIF @@ -1182,15 +1182,15 @@ SUBROUTINE construct_submatrices(matrix, submatrix, distr_pattern, domain_map, & ! loop over those rows that have non-zero quencher first_row(:) = -1 index_sr = 1 ! index start row - IF (idomain .GT. 1) index_sr = domain_map%index1(idomain-1) - index_er = domain_map%index1(idomain)-1 ! index end row + IF (idomain .GT. 1) index_sr = domain_map%index1(idomain - 1) + index_er = domain_map%index1(idomain) - 1 ! index end row DO index_row = index_sr, index_er row = domain_map%pairs(index_row, 1) !DO row = 1, nblkrows_tot ! IF (qblk_exists(domain_map,row,idomain)) THEN - first_row(row) = submatrix(idomain)%nrows+1 - submatrix(idomain)%nrows = submatrix(idomain)%nrows+row_blk_size(row) - submatrix(idomain)%nbrows = submatrix(idomain)%nbrows+1 + first_row(row) = submatrix(idomain)%nrows + 1 + submatrix(idomain)%nrows = submatrix(idomain)%nrows + row_blk_size(row) + submatrix(idomain)%nbrows = submatrix(idomain)%nbrows + 1 ! ENDIF ENDDO ALLOCATE (submatrix(idomain)%dbcsr_row(submatrix(idomain)%nbrows)) @@ -1198,15 +1198,15 @@ SUBROUTINE construct_submatrices(matrix, submatrix, distr_pattern, domain_map, & smrow = 1 ! again loop over those rows that have non-zero quencher index_sr = 1 ! index start row - IF (idomain .GT. 1) index_sr = domain_map%index1(idomain-1) - index_er = domain_map%index1(idomain)-1 ! index end row + IF (idomain .GT. 1) index_sr = domain_map%index1(idomain - 1) + index_er = domain_map%index1(idomain) - 1 ! index end row DO index_row = index_sr, index_er row = domain_map%pairs(index_row, 1) !DO row = 1, nblkrows_tot ! IF (first_row(row).ne.-1) THEN submatrix(idomain)%dbcsr_row(smrow) = row submatrix(idomain)%size_brow(smrow) = row_blk_size(row) - smrow = smrow+1 + smrow = smrow + 1 ! ENDIF ENDDO @@ -1215,8 +1215,8 @@ SUBROUTINE construct_submatrices(matrix, submatrix, distr_pattern, domain_map, & IF (job_type == select_row_col) THEN ! loop over those columns that have non-zero quencher index_sc = 1 ! index start col - IF (idomain .GT. 1) index_sc = domain_map%index1(idomain-1) - index_ec = domain_map%index1(idomain)-1 ! index end col + IF (idomain .GT. 1) index_sc = domain_map%index1(idomain - 1) + index_ec = domain_map%index1(idomain) - 1 ! index end col ELSE ! fake loop index_sc = 1 ! index start col @@ -1235,9 +1235,9 @@ SUBROUTINE construct_submatrices(matrix, submatrix, distr_pattern, domain_map, & ! domain_needs_block=(col==idomain) ! RZK-warning col belongs to the domain ! ENDIF ! IF (domain_needs_block) THEN - first_col(col) = submatrix(idomain)%ncols+1 - submatrix(idomain)%ncols = submatrix(idomain)%ncols+col_blk_size(col) - submatrix(idomain)%nbcols = submatrix(idomain)%nbcols+1 + first_col(col) = submatrix(idomain)%ncols + 1 + submatrix(idomain)%ncols = submatrix(idomain)%ncols + col_blk_size(col) + submatrix(idomain)%nbcols = submatrix(idomain)%nbcols + 1 ! ENDIF ENDDO @@ -1249,8 +1249,8 @@ SUBROUTINE construct_submatrices(matrix, submatrix, distr_pattern, domain_map, & IF (job_type == select_row_col) THEN ! loop over those columns that have non-zero quencher index_sc = 1 ! index start col - IF (idomain .GT. 1) index_sc = domain_map%index1(idomain-1) - index_ec = domain_map%index1(idomain)-1 ! index end col + IF (idomain .GT. 1) index_sc = domain_map%index1(idomain - 1) + index_ec = domain_map%index1(idomain) - 1 ! index end col ELSE ! fake loop index_sc = 1 ! index start col @@ -1266,7 +1266,7 @@ SUBROUTINE construct_submatrices(matrix, submatrix, distr_pattern, domain_map, & ! IF (first_col(col).ne.-1) THEN submatrix(idomain)%dbcsr_col(smcol) = col submatrix(idomain)%size_bcol(smcol) = col_blk_size(col) - smcol = smcol+1 + smcol = smcol + 1 ! ENDIF ENDDO @@ -1278,18 +1278,18 @@ SUBROUTINE construct_submatrices(matrix, submatrix, distr_pattern, domain_map, & block_offset = 0 DO iBlock = 1, recv_size2_cpu(iNode)/2 ! read the (row,col) of the block - row = recv_data2(recv_offset2_cpu(iNode)+(iBlock-1)*2+1) - col = recv_data2(recv_offset2_cpu(iNode)+(iBlock-1)*2+2) + row = recv_data2(recv_offset2_cpu(iNode) + (iBlock - 1)*2 + 1) + col = recv_data2(recv_offset2_cpu(iNode) + (iBlock - 1)*2 + 2) ! check if this block should be in the submatrix of this domain IF ((first_col(col) .NE. -1) .AND. (first_row(row) .NE. -1)) THEN ! copy data from the received array into submatrix - start_data = recv_offset_cpu(iNode)+block_offset+1 - DO icol = 0, col_blk_size(col)-1 + start_data = recv_offset_cpu(iNode) + block_offset + 1 + DO icol = 0, col_blk_size(col) - 1 submatrix(idomain)%mdata(first_row(row): & - first_row(row)+row_blk_size(row)-1, & - first_col(col)+icol) = & - recv_data(start_data:start_data+row_blk_size(row)-1) - start_data = start_data+row_blk_size(row) + first_row(row) + row_blk_size(row) - 1, & + first_col(col) + icol) = & + recv_data(start_data:start_data + row_blk_size(row) - 1) + start_data = start_data + row_blk_size(row) ENDDO IF (job_type == select_row_col) THEN IF (matrix_type == dbcsr_type_symmetric .OR. & @@ -1299,14 +1299,14 @@ SUBROUTINE construct_submatrices(matrix, submatrix, distr_pattern, domain_map, & IF (matrix_type == dbcsr_type_antisymmetric) THEN antifactor = -1.0_dp ENDIF - start_data = recv_offset_cpu(iNode)+block_offset+1 - DO icol = 0, col_blk_size(col)-1 - submatrix(idomain)%mdata(first_row(col)+icol, & + start_data = recv_offset_cpu(iNode) + block_offset + 1 + DO icol = 0, col_blk_size(col) - 1 + submatrix(idomain)%mdata(first_row(col) + icol, & first_col(row): & - first_col(row)+row_blk_size(row)-1) = & + first_col(row) + row_blk_size(row) - 1) = & antifactor*recv_data(start_data: & - start_data+row_blk_size(row)-1) - start_data = start_data+row_blk_size(row) + start_data + row_blk_size(row) - 1) + start_data = start_data + row_blk_size(row) ENDDO ELSE IF (matrix_type == dbcsr_type_no_symmetry) THEN ELSE @@ -1314,7 +1314,7 @@ SUBROUTINE construct_submatrices(matrix, submatrix, distr_pattern, domain_map, & ENDIF ENDIF ENDIF - block_offset = block_offset+col_blk_size(col)*row_blk_size(row) + block_offset = block_offset + col_blk_size(col)*row_blk_size(row) ENDDO ENDDO ENDIF ! mynode.eq.dest_node @@ -1433,10 +1433,10 @@ SUBROUTINE construct_dbcsr_from_submatrices(matrix, submatrix, distr_pattern) CALL dbcsr_get_stored_coordinates(distr_pattern, & row, idomain, dest_node) - send_descriptor(1, dest_node+1) = send_descriptor(1, dest_node+1)+1 - send_descriptor(2, dest_node+1) = send_descriptor(2, dest_node+1)+ & - submatrix(idomain)%size_brow(irow_subm)* & - submatrix(idomain)%size_bcol(1) + send_descriptor(1, dest_node + 1) = send_descriptor(1, dest_node + 1) + 1 + send_descriptor(2, dest_node + 1) = send_descriptor(2, dest_node + 1) + & + submatrix(idomain)%size_brow(irow_subm)* & + submatrix(idomain)%size_bcol(1) ENDDO ! loop over submatrix blocks @@ -1452,40 +1452,40 @@ SUBROUTINE construct_dbcsr_from_submatrices(matrix, submatrix, distr_pattern) send_size_cpu(1) = send_descriptor(2, 1) DO iNode = 2, nNodes send_size_cpu(iNode) = send_descriptor(2, iNode) - send_offset_cpu(iNode) = send_offset_cpu(iNode-1)+ & - send_size_cpu(iNode-1) + send_offset_cpu(iNode) = send_offset_cpu(iNode - 1) + & + send_size_cpu(iNode - 1) ENDDO - send_size_total = send_offset_cpu(nNodes)+send_size_cpu(nNodes) + send_size_total = send_offset_cpu(nNodes) + send_size_cpu(nNodes) ALLOCATE (recv_size_cpu(nNodes), recv_offset_cpu(nNodes)) recv_offset_cpu(1) = 0 recv_size_cpu(1) = recv_descriptor(2, 1) DO iNode = 2, nNodes recv_size_cpu(iNode) = recv_descriptor(2, iNode) - recv_offset_cpu(iNode) = recv_offset_cpu(iNode-1)+ & - recv_size_cpu(iNode-1) + recv_offset_cpu(iNode) = recv_offset_cpu(iNode - 1) + & + recv_size_cpu(iNode - 1) ENDDO - recv_size_total = recv_offset_cpu(nNodes)+recv_size_cpu(nNodes) + recv_size_total = recv_offset_cpu(nNodes) + recv_size_cpu(nNodes) ALLOCATE (send_size2_cpu(nNodes), send_offset2_cpu(nNodes)) send_offset2_cpu(1) = 0 send_size2_cpu(1) = 2*send_descriptor(1, 1) DO iNode = 2, nNodes send_size2_cpu(iNode) = 2*send_descriptor(1, iNode) - send_offset2_cpu(iNode) = send_offset2_cpu(iNode-1)+ & - send_size2_cpu(iNode-1) + send_offset2_cpu(iNode) = send_offset2_cpu(iNode - 1) + & + send_size2_cpu(iNode - 1) ENDDO - send_size2_total = send_offset2_cpu(nNodes)+send_size2_cpu(nNodes) + send_size2_total = send_offset2_cpu(nNodes) + send_size2_cpu(nNodes) ALLOCATE (recv_size2_cpu(nNodes), recv_offset2_cpu(nNodes)) recv_offset2_cpu(1) = 0 recv_size2_cpu(1) = 2*recv_descriptor(1, 1) DO iNode = 2, nNodes recv_size2_cpu(iNode) = 2*recv_descriptor(1, iNode) - recv_offset2_cpu(iNode) = recv_offset2_cpu(iNode-1)+ & - recv_size2_cpu(iNode-1) + recv_offset2_cpu(iNode) = recv_offset2_cpu(iNode - 1) + & + recv_size2_cpu(iNode - 1) ENDDO - recv_size2_total = recv_offset2_cpu(nNodes)+recv_size2_cpu(nNodes) + recv_size2_total = recv_offset2_cpu(nNodes) + recv_size2_cpu(nNodes) DEALLOCATE (send_descriptor) DEALLOCATE (recv_descriptor) @@ -1520,23 +1520,23 @@ SUBROUTINE construct_dbcsr_from_submatrices(matrix, submatrix, distr_pattern) ! place the data appropriately col_offset = 0 DO icol = 1, colsize - start_data = send_offset_cpu(dest_node+1)+ & - offset_block(dest_node+1)+ & + start_data = send_offset_cpu(dest_node + 1) + & + offset_block(dest_node + 1) + & col_offset - send_data(start_data+1:start_data+rowsize) = & - submatrix(idomain)%mdata(smroff+1:smroff+rowsize, icol) - col_offset = col_offset+rowsize + send_data(start_data + 1:start_data + rowsize) = & + submatrix(idomain)%mdata(smroff + 1:smroff + rowsize, icol) + col_offset = col_offset + rowsize ENDDO - offset_block(dest_node+1) = offset_block(dest_node+1)+ & - colsize*rowsize + offset_block(dest_node + 1) = offset_block(dest_node + 1) + & + colsize*rowsize ! fill out row,col information - send_data2(send_offset2_cpu(dest_node+1)+ & - offset2_block(dest_node+1)+1) = row - send_data2(send_offset2_cpu(dest_node+1)+ & - offset2_block(dest_node+1)+2) = col - offset2_block(dest_node+1) = offset2_block(dest_node+1)+2 + send_data2(send_offset2_cpu(dest_node + 1) + & + offset2_block(dest_node + 1) + 1) = row + send_data2(send_offset2_cpu(dest_node + 1) + & + offset2_block(dest_node + 1) + 2) = col + offset2_block(dest_node + 1) = offset2_block(dest_node + 1) + 2 - smroff = smroff+rowsize + smroff = smroff + rowsize ENDDO @@ -1564,8 +1564,8 @@ SUBROUTINE construct_dbcsr_from_submatrices(matrix, submatrix, distr_pattern) block_offset = 0 DO iBlock = 1, recv_size2_cpu(iNode)/2 ! read the (row,col) of the block - row = recv_data2(recv_offset2_cpu(iNode)+(iBlock-1)*2+1) - col = recv_data2(recv_offset2_cpu(iNode)+(iBlock-1)*2+2) + row = recv_data2(recv_offset2_cpu(iNode) + (iBlock - 1)*2 + 1) + col = recv_data2(recv_offset2_cpu(iNode) + (iBlock - 1)*2 + 2) !CALL dbcsr_get_block_p(matrix,row,col,block_p,found) !IF (.NOT.found) THEN NULLIFY (block_p) @@ -1573,13 +1573,13 @@ SUBROUTINE construct_dbcsr_from_submatrices(matrix, submatrix, distr_pattern) CPASSERT(ASSOCIATED(block_p)) !ENDIF ! copy data from the received array into the matrix block - start_data = recv_offset_cpu(iNode)+block_offset+1 + start_data = recv_offset_cpu(iNode) + block_offset + 1 DO icol = 1, col_blk_size(col) block_p(:, icol) = & - recv_data(start_data:start_data+row_blk_size(row)-1) - start_data = start_data+row_blk_size(row) + recv_data(start_data:start_data + row_blk_size(row) - 1) + start_data = start_data + row_blk_size(row) ENDDO - block_offset = block_offset+col_blk_size(col)*row_blk_size(row) + block_offset = block_offset + col_blk_size(col)*row_blk_size(row) ENDDO ENDDO @@ -1661,16 +1661,16 @@ FUNCTION qblk_exists(map, row, col) qblk_exists = .FALSE. IF (col .LT. 1 .OR. col .GT. ndomains) RETURN first = 1 - IF (col .GT. 1) first = map%index1(col-1) - last = map%index1(col)-1 + IF (col .GT. 1) first = map%index1(col - 1) + last = map%index1(col) - 1 ! perform binary search within first-last DO WHILE (last .GE. first) - mid = first+(last-first)/2 + mid = first + (last - first)/2 IF (map%pairs(mid, 1) .GT. row) THEN - last = mid-1 + last = mid - 1 ELSE IF (map%pairs(mid, 1) .LT. row) THEN - first = mid+1 + first = mid + 1 ELSE qblk_exists = .TRUE. ! SUCCESS!! EXIT diff --git a/src/efield_tb_methods.F b/src/efield_tb_methods.F index 4d5e5d7809..7cddb615cf 100644 --- a/src/efield_tb_methods.F +++ b/src/efield_tb_methods.F @@ -170,7 +170,7 @@ SUBROUTINE efield_tb_local(qs_env, ks_matrix, rho, mcharge, energy, calculate_fo charge = mcharge(ia) ria = particle_set(ia)%r ria = pbc(ria, cell) - ci(:) = ci(:)+charge*ria(:) + ci(:) = ci(:) + charge*ria(:) END DO energy%efield = -SUM(ci(:)*fieldpol(:)) @@ -209,11 +209,11 @@ SUBROUTINE efield_tb_local(qs_env, ks_matrix, rho, mcharge, energy, calculate_fo ria = pbc(ria, cell) rib = particle_set(icol)%r rib = pbc(rib, cell) - fdir = 0.5_dp*SUM(fieldpol(1:3)*(ria(1:3)+rib(1:3))) + fdir = 0.5_dp*SUM(fieldpol(1:3)*(ria(1:3) + rib(1:3))) DO ispin = 1, nspin CALL dbcsr_get_block_p(matrix=ks_matrix(ispin, 1)%matrix, & row=irow, col=icol, BLOCK=ks_block, found=found) - ks_block = ks_block+fdir*s_block + ks_block = ks_block + fdir*s_block CPASSERT(found) END DO IF (calculate_forces) THEN @@ -227,18 +227,18 @@ SUBROUTINE efield_tb_local(qs_env, ks_matrix, rho, mcharge, energy, calculate_fo row=irow, col=icol, BLOCK=p_block, found=found) CPASSERT(found) DO idir = 1, 3 - CALL dbcsr_get_block_p(matrix=matrix_s(idir+1)%matrix, & + CALL dbcsr_get_block_p(matrix=matrix_s(idir + 1)%matrix, & row=irow, col=icol, BLOCK=ds_block, found=found) CPASSERT(found) - fij(idir) = fij(idir)+SUM(p_block*ds_block) + fij(idir) = fij(idir) + SUM(p_block*ds_block) END DO END DO fdir = SUM(ria(1:3)*fieldpol(1:3)) - force(ikind)%efield(1:3, atom_a) = force(ikind)%efield(1:3, atom_a)+fdir*fij(1:3) - force(jkind)%efield(1:3, atom_b) = force(jkind)%efield(1:3, atom_b)-fdir*fij(1:3) + force(ikind)%efield(1:3, atom_a) = force(ikind)%efield(1:3, atom_a) + fdir*fij(1:3) + force(jkind)%efield(1:3, atom_b) = force(jkind)%efield(1:3, atom_b) - fdir*fij(1:3) fdir = SUM(rib(1:3)*fieldpol(1:3)) - force(ikind)%efield(1:3, atom_a) = force(ikind)%efield(1:3, atom_a)+fdir*fij(1:3) - force(jkind)%efield(1:3, atom_b) = force(jkind)%efield(1:3, atom_b)-fdir*fij(1:3) + force(ikind)%efield(1:3, atom_a) = force(ikind)%efield(1:3, atom_a) + fdir*fij(1:3) + force(jkind)%efield(1:3, atom_b) = force(jkind)%efield(1:3, atom_b) - fdir*fij(1:3) END IF ENDDO CALL dbcsr_iterator_stop(iter) @@ -329,7 +329,7 @@ SUBROUTINE efield_tb_berry(qs_env, ks_matrix, rho, mcharge, energy, calculate_fo fieldpol = -fieldpol*dft_control%period_efield%strength hmat = cell%hmat(:, :)/twopi DO idir = 1, 3 - fpolvec(idir) = fieldpol(1)*hmat(1, idir)+fieldpol(2)*hmat(2, idir)+fieldpol(3)*hmat(3, idir) + fpolvec(idir) = fieldpol(1)*hmat(1, idir) + fieldpol(2)*hmat(2, idir) + fieldpol(3)*hmat(3, idir) END DO natom = SIZE(particle_set) @@ -399,10 +399,10 @@ SUBROUTINE efield_tb_berry(qs_env, ks_matrix, rho, mcharge, energy, calculate_fo kvec(:) = twopi*cell%h_inv(idir, :) dd = SUM(kvec(:)*ria(:)) zdeta = CMPLX(COS(dd), SIN(dd), KIND=dp) - fdir = fdir+fpolvec(idir)*AIMAG(LOG(zdeta)) + fdir = fdir + fpolvec(idir)*AIMAG(LOG(zdeta)) dd = SUM(kvec(:)*rib(:)) zdeta = CMPLX(COS(dd), SIN(dd), KIND=dp) - fdir = fdir+fpolvec(idir)*AIMAG(LOG(zdeta)) + fdir = fdir + fpolvec(idir)*AIMAG(LOG(zdeta)) END DO DO is = 1, nspin @@ -410,7 +410,7 @@ SUBROUTINE efield_tb_berry(qs_env, ks_matrix, rho, mcharge, energy, calculate_fo CALL dbcsr_get_block_p(matrix=ks_matrix(is, 1)%matrix, & row=irow, col=icol, block=ks_block, found=found) CPASSERT(found) - ks_block = ks_block+0.5_dp*fdir*s_block + ks_block = ks_block + 0.5_dp*fdir*s_block END DO IF (calculate_forces) THEN ikind = kind_of(irow) @@ -423,14 +423,14 @@ SUBROUTINE efield_tb_berry(qs_env, ks_matrix, rho, mcharge, energy, calculate_fo row=irow, col=icol, BLOCK=p_block, found=found) CPASSERT(found) DO idir = 1, 3 - CALL dbcsr_get_block_p(matrix=matrix_s(idir+1, 1)%matrix, & + CALL dbcsr_get_block_p(matrix=matrix_s(idir + 1, 1)%matrix, & row=irow, col=icol, BLOCK=ds_block, found=found) CPASSERT(found) - fij(idir) = fij(idir)+SUM(p_block*ds_block) + fij(idir) = fij(idir) + SUM(p_block*ds_block) END DO END DO - force(ikind)%efield(1:3, atom_a) = force(ikind)%efield(1:3, atom_a)+fdir*fij(1:3) - force(jkind)%efield(1:3, atom_b) = force(jkind)%efield(1:3, atom_b)-fdir*fij(1:3) + force(ikind)%efield(1:3, atom_a) = force(ikind)%efield(1:3, atom_a) + fdir*fij(1:3) + force(jkind)%efield(1:3, atom_b) = force(jkind)%efield(1:3, atom_b) - fdir*fij(1:3) END IF ENDDO @@ -454,10 +454,10 @@ SUBROUTINE efield_tb_berry(qs_env, ks_matrix, rho, mcharge, energy, calculate_fo kvec(:) = twopi*cell%h_inv(idir, :) dd = SUM(kvec(:)*ria(:)) zdeta = CMPLX(COS(dd), SIN(dd), KIND=dp) - fdir = fdir+fpolvec(idir)*AIMAG(LOG(zdeta)) + fdir = fdir + fpolvec(idir)*AIMAG(LOG(zdeta)) dd = SUM(kvec(:)*rib(:)) zdeta = CMPLX(COS(dd), SIN(dd), KIND=dp) - fdir = fdir+fpolvec(idir)*AIMAG(LOG(zdeta)) + fdir = fdir + fpolvec(idir)*AIMAG(LOG(zdeta)) END DO NULLIFY (s_block) @@ -469,7 +469,7 @@ SUBROUTINE efield_tb_berry(qs_env, ks_matrix, rho, mcharge, energy, calculate_fo CALL dbcsr_get_block_p(matrix=ks_matrix(is, ic)%matrix, & row=irow, col=icol, block=ks_block, found=found) CPASSERT(found) - ks_block = ks_block+0.5_dp*fdir*s_block + ks_block = ks_block + 0.5_dp*fdir*s_block END DO IF (calculate_forces) THEN atom_a = atom_of_kind(iatom) @@ -480,15 +480,15 @@ SUBROUTINE efield_tb_berry(qs_env, ks_matrix, rho, mcharge, energy, calculate_fo row=irow, col=icol, BLOCK=p_block, found=found) CPASSERT(found) DO idir = 1, 3 - CALL dbcsr_get_block_p(matrix=matrix_s(idir+1, ic)%matrix, & + CALL dbcsr_get_block_p(matrix=matrix_s(idir + 1, ic)%matrix, & row=irow, col=icol, BLOCK=ds_block, found=found) CPASSERT(found) - fij(idir) = fij(idir)+SUM(p_block*ds_block) + fij(idir) = fij(idir) + SUM(p_block*ds_block) END DO END DO IF (irow == iatom) fij = -fij - force(ikind)%efield(1:3, atom_a) = force(ikind)%efield(1:3, atom_a)-fdir*fij(1:3) - force(jkind)%efield(1:3, atom_b) = force(jkind)%efield(1:3, atom_b)+fdir*fij(1:3) + force(ikind)%efield(1:3, atom_a) = force(ikind)%efield(1:3, atom_a) - fdir*fij(1:3) + force(jkind)%efield(1:3, atom_b) = force(jkind)%efield(1:3, atom_b) + fdir*fij(1:3) END IF END DO @@ -610,15 +610,15 @@ SUBROUTINE dfield_tb_berry(qs_env, ks_matrix, rho, mcharge, energy, calculate_fo ! make sure the total normalized polarization is within [-1:1] DO idir = 1, 3 cqi(idir) = qi(idir)/omega - IF (cqi(idir) > pi) cqi(idir) = cqi(idir)-twopi - IF (cqi(idir) < -pi) cqi(idir) = cqi(idir)+twopi + IF (cqi(idir) > pi) cqi(idir) = cqi(idir) - twopi + IF (cqi(idir) < -pi) cqi(idir) = cqi(idir) + twopi ! now check for log branch IF (calculate_forces) THEN - IF (ABS(efield%polarisation(idir)-cqi(idir)) > pi) THEN - di(idir) = (efield%polarisation(idir)-cqi(idir))/pi + IF (ABS(efield%polarisation(idir) - cqi(idir)) > pi) THEN + di(idir) = (efield%polarisation(idir) - cqi(idir))/pi DO i = 1, 10 - cqi(idir) = cqi(idir)+SIGN(1.0_dp, di(idir))*twopi - IF (ABS(efield%polarisation(idir)-cqi(idir)) < pi) EXIT + cqi(idir) = cqi(idir) + SIGN(1.0_dp, di(idir))*twopi + IF (ABS(efield%polarisation(idir) - cqi(idir)) < pi) EXIT END DO END IF END IF @@ -627,14 +627,14 @@ SUBROUTINE dfield_tb_berry(qs_env, ks_matrix, rho, mcharge, energy, calculate_fo DO idir = 1, 3 ci(idir) = 0.0_dp DO i = 1, 3 - ci(idir) = ci(idir)+hmat(idir, i)*cqi(i) + ci(idir) = ci(idir) + hmat(idir, i)*cqi(i) END DO END DO ! update the references IF (calculate_forces) THEN ener_field = SUM(ci) ! check for smoothness of energy surface - IF (ABS(efield%field_energy-ener_field) > pi*ABS(SUM(hmat))) THEN + IF (ABS(efield%field_energy - ener_field) > pi*ABS(SUM(hmat))) THEN CPWARN("Large change of e-field energy detected. Correct for non-smooth energy surface") END IF efield%field_energy = ener_field @@ -644,12 +644,12 @@ SUBROUTINE dfield_tb_berry(qs_env, ks_matrix, rho, mcharge, energy, calculate_fo ! Energy ener_field = 0.0_dp DO idir = 1, 3 - ener_field = ener_field+dfilter(idir)*(fieldpol(idir)-2._dp*twopi/omega*ci(idir))**2 + ener_field = ener_field + dfilter(idir)*(fieldpol(idir) - 2._dp*twopi/omega*ci(idir))**2 END DO energy%efield = 0.25_dp/twopi*ener_field IF (.NOT. just_energy) THEN - di(:) = -(fieldpol(:)-2._dp*twopi/omega*ci(:))*dfilter(:)/omega + di(:) = -(fieldpol(:) - 2._dp*twopi/omega*ci(:))*dfilter(:)/omega CALL get_qs_env(qs_env=qs_env, matrix_s_kp=matrix_s) CALL qs_rho_get(rho, rho_ao_kp=matrix_p) @@ -671,7 +671,7 @@ SUBROUTINE dfield_tb_berry(qs_env, ks_matrix, rho, mcharge, energy, calculate_fo charge = mcharge(ia) iatom = atom_of_kind(ia) ikind = kind_of(ia) - force(ikind)%efield(:, iatom) = force(ikind)%efield(:, iatom)+di(:)*charge + force(ikind)%efield(:, iatom) = force(ikind)%efield(:, iatom) + di(:)*charge IF (use_virial) THEN ria = particle_set(ia)%r ria = pbc(ria, cell) @@ -697,10 +697,10 @@ SUBROUTINE dfield_tb_berry(qs_env, ks_matrix, rho, mcharge, energy, calculate_fo kvec(:) = twopi*cell%h_inv(idir, :) dd = SUM(kvec(:)*ria(:)) zdeta = CMPLX(COS(dd), SIN(dd), KIND=dp) - fdir = fdir+hdi(idir)*AIMAG(LOG(zdeta)) + fdir = fdir + hdi(idir)*AIMAG(LOG(zdeta)) dd = SUM(kvec(:)*rib(:)) zdeta = CMPLX(COS(dd), SIN(dd), KIND=dp) - fdir = fdir+hdi(idir)*AIMAG(LOG(zdeta)) + fdir = fdir + hdi(idir)*AIMAG(LOG(zdeta)) END DO DO is = 1, nspin @@ -708,7 +708,7 @@ SUBROUTINE dfield_tb_berry(qs_env, ks_matrix, rho, mcharge, energy, calculate_fo CALL dbcsr_get_block_p(matrix=ks_matrix(is, 1)%matrix, & row=irow, col=icol, block=ks_block, found=found) CPASSERT(found) - ks_block = ks_block+0.5_dp*fdir*s_block + ks_block = ks_block + 0.5_dp*fdir*s_block END DO IF (calculate_forces) THEN ikind = kind_of(irow) @@ -721,14 +721,14 @@ SUBROUTINE dfield_tb_berry(qs_env, ks_matrix, rho, mcharge, energy, calculate_fo row=irow, col=icol, BLOCK=p_block, found=found) CPASSERT(found) DO idir = 1, 3 - CALL dbcsr_get_block_p(matrix=matrix_s(idir+1, 1)%matrix, & + CALL dbcsr_get_block_p(matrix=matrix_s(idir + 1, 1)%matrix, & row=irow, col=icol, BLOCK=ds_block, found=found) CPASSERT(found) - fij(idir) = fij(idir)+SUM(p_block*ds_block) + fij(idir) = fij(idir) + SUM(p_block*ds_block) END DO END DO - force(ikind)%efield(1:3, atom_a) = force(ikind)%efield(1:3, atom_a)+fdir*fij(1:3) - force(jkind)%efield(1:3, atom_b) = force(jkind)%efield(1:3, atom_b)-fdir*fij(1:3) + force(ikind)%efield(1:3, atom_a) = force(ikind)%efield(1:3, atom_a) + fdir*fij(1:3) + force(jkind)%efield(1:3, atom_b) = force(jkind)%efield(1:3, atom_b) - fdir*fij(1:3) END IF ENDDO @@ -755,10 +755,10 @@ SUBROUTINE dfield_tb_berry(qs_env, ks_matrix, rho, mcharge, energy, calculate_fo kvec(:) = twopi*cell%h_inv(idir, :) dd = SUM(kvec(:)*ria(:)) zdeta = CMPLX(COS(dd), SIN(dd), KIND=dp) - fdir = fdir+hdi(idir)*AIMAG(LOG(zdeta)) + fdir = fdir + hdi(idir)*AIMAG(LOG(zdeta)) dd = SUM(kvec(:)*rib(:)) zdeta = CMPLX(COS(dd), SIN(dd), KIND=dp) - fdir = fdir+hdi(idir)*AIMAG(LOG(zdeta)) + fdir = fdir + hdi(idir)*AIMAG(LOG(zdeta)) END DO NULLIFY (s_block) @@ -770,7 +770,7 @@ SUBROUTINE dfield_tb_berry(qs_env, ks_matrix, rho, mcharge, energy, calculate_fo CALL dbcsr_get_block_p(matrix=ks_matrix(is, ic)%matrix, & row=irow, col=icol, block=ks_block, found=found) CPASSERT(found) - ks_block = ks_block+0.5_dp*fdir*s_block + ks_block = ks_block + 0.5_dp*fdir*s_block END DO IF (calculate_forces) THEN atom_a = atom_of_kind(iatom) @@ -781,15 +781,15 @@ SUBROUTINE dfield_tb_berry(qs_env, ks_matrix, rho, mcharge, energy, calculate_fo row=irow, col=icol, BLOCK=p_block, found=found) CPASSERT(found) DO idir = 1, 3 - CALL dbcsr_get_block_p(matrix=matrix_s(idir+1, ic)%matrix, & + CALL dbcsr_get_block_p(matrix=matrix_s(idir + 1, ic)%matrix, & row=irow, col=icol, BLOCK=ds_block, found=found) CPASSERT(found) - fij(idir) = fij(idir)+SUM(p_block*ds_block) + fij(idir) = fij(idir) + SUM(p_block*ds_block) END DO END DO IF (irow == iatom) fij = -fij - force(ikind)%efield(1:3, atom_a) = force(ikind)%efield(1:3, atom_a)-fdir*fij(1:3) - force(jkind)%efield(1:3, atom_b) = force(jkind)%efield(1:3, atom_b)+fdir*fij(1:3) + force(ikind)%efield(1:3, atom_a) = force(ikind)%efield(1:3, atom_a) - fdir*fij(1:3) + force(jkind)%efield(1:3, atom_b) = force(jkind)%efield(1:3, atom_b) + fdir*fij(1:3) END IF END DO diff --git a/src/efield_utils.F b/src/efield_utils.F index 4e04e3551b..ec6b3267a5 100644 --- a/src/efield_utils.F +++ b/src/efield_utils.F @@ -97,16 +97,16 @@ SUBROUTINE efield_potential(qs_env, v_efield_rspace) DO k = bo_local(1, 3), bo_local(2, 3) DO j = bo_local(1, 2), bo_local(2, 2) DO i = bo_local(1, 1), bo_local(2, 1) - grid_p(1) = (i-bo_global(1, 1))*dr(1) - grid_p(2) = (j-bo_global(1, 2))*dr(2) - grid_p(3) = (k-bo_global(1, 3))*dr(3) - v_efield_rspace%pw%cr3d(i, j, k) = v_efield_rspace%pw%cr3d(i, j, k)+DOT_PRODUCT(field(:), grid_p(:)) + grid_p(1) = (i - bo_global(1, 1))*dr(1) + grid_p(2) = (j - bo_global(1, 2))*dr(2) + grid_p(3) = (k - bo_global(1, 3))*dr(3) + v_efield_rspace%pw%cr3d(i, j, k) = v_efield_rspace%pw%cr3d(i, j, k) + DOT_PRODUCT(field(:), grid_p(:)) END DO END DO END DO efield_ener = 0.0_dp DO i = 1, dft_control%nspins - efield_ener = efield_ener+accurate_sum(v_efield_rspace%pw%cr3d*rho_r(i)%pw%cr3d)*dvol + efield_ener = efield_ener + accurate_sum(v_efield_rspace%pw%cr3d*rho_r(i)%pw%cr3d)*dvol END DO CALL mp_sum(efield_ener, para_env%group) energy%efield = efield_ener @@ -149,33 +149,33 @@ SUBROUTINE make_field(dft_control, field, sim_step, sim_time) IF (efield%envelop_id == constant_env) THEN IF (sim_step .GE. efield%envelop_i_vars(1) .AND. & (sim_step .LE. efield%envelop_i_vars(2) .OR. efield%envelop_i_vars(2) .LT. 0)) THEN - field = field+strength*COS(sim_time*nu*2.0_dp*pi+ & - efield%phase_offset*pi)*pol(:) + field = field + strength*COS(sim_time*nu*2.0_dp*pi + & + efield%phase_offset*pi)*pol(:) END IF ELSE IF (efield%envelop_id == ramp_env) THEN IF (sim_step .GE. efield%envelop_i_vars(1) .AND. sim_step .LE. efield%envelop_i_vars(2)) & - strength = strength*(sim_step-efield%envelop_i_vars(1))/(efield%envelop_i_vars(2)-efield%envelop_i_vars(1)) + strength = strength*(sim_step - efield%envelop_i_vars(1))/(efield%envelop_i_vars(2) - efield%envelop_i_vars(1)) IF (sim_step .GE. efield%envelop_i_vars(3) .AND. sim_step .LE. efield%envelop_i_vars(4)) & - strength = strength*(efield%envelop_i_vars(4)-sim_step)/(efield%envelop_i_vars(4)-efield%envelop_i_vars(3)) + strength = strength*(efield%envelop_i_vars(4) - sim_step)/(efield%envelop_i_vars(4) - efield%envelop_i_vars(3)) IF (sim_step .GT. efield%envelop_i_vars(4) .AND. efield%envelop_i_vars(4) .GT. 0) strength = 0.0_dp IF (sim_step .LE. efield%envelop_i_vars(1)) strength = 0.0_dp - field = field+strength*COS(sim_time*nu*2.0_dp*pi+ & - efield%phase_offset*pi)*pol(:) + field = field + strength*COS(sim_time*nu*2.0_dp*pi + & + efield%phase_offset*pi)*pol(:) ELSE IF (efield%envelop_id == gaussian_env) THEN - env = EXP(-0.5_dp*((sim_time-efield%envelop_r_vars(1))/efield%envelop_r_vars(2))**2.0_dp) - field = field+strength*env*COS(sim_time*nu*2.0_dp*pi+ & - efield%phase_offset*pi)*pol(:) + env = EXP(-0.5_dp*((sim_time - efield%envelop_r_vars(1))/efield%envelop_r_vars(2))**2.0_dp) + field = field + strength*env*COS(sim_time*nu*2.0_dp*pi + & + efield%phase_offset*pi)*pol(:) ELSE IF (efield%envelop_id == custom_env) THEN dt = efield%envelop_r_vars(1) - IF (sim_time .LT. (SIZE(efield%envelop_r_vars)-2)*dt) THEN + IF (sim_time .LT. (SIZE(efield%envelop_r_vars) - 2)*dt) THEN !make a linear interpolation between the two next points lower = FLOOR(sim_time/dt) - upper = lower+1 - strength = (efield%envelop_r_vars(lower+2)*(upper*dt-sim_time)+efield%envelop_r_vars(upper+2)*(sim_time-lower*dt))/dt + upper = lower + 1 + strength = (efield%envelop_r_vars(lower + 2)*(upper*dt - sim_time) + efield%envelop_r_vars(upper + 2)*(sim_time - lower*dt))/dt ELSE strength = 0.0_dp ENDIF - field = field+strength*pol(:) + field = field + strength*pol(:) END IF END DO @@ -236,10 +236,10 @@ SUBROUTINE calculate_ecore_efield(qs_env, calculate_forces) atom_a = list(iatom) r(:) = pbc(particle_set(atom_a)%r(:), cell) - efield_ener = efield_ener-zeff*DOT_PRODUCT(r, field) + efield_ener = efield_ener - zeff*DOT_PRODUCT(r, field) IF (my_force) THEN CALL get_qs_env(qs_env=qs_env, force=force) - force(ikind)%efield(:, iatom) = force(ikind)%efield(:, iatom)-field*zeff + force(ikind)%efield(:, iatom) = force(ikind)%efield(:, iatom) - field*zeff END IF END DO diff --git a/src/eip_environment_types.F b/src/eip_environment_types.F index 327ab29694..d0bd4d550d 100644 --- a/src/eip_environment_types.F +++ b/src/eip_environment_types.F @@ -132,7 +132,7 @@ SUBROUTINE eip_env_retain(eip_env) CPASSERT(ASSOCIATED(eip_env)) CPASSERT(eip_env%ref_count > 0) - eip_env%ref_count = eip_env%ref_count+1 + eip_env%ref_count = eip_env%ref_count + 1 END SUBROUTINE eip_env_retain ! ************************************************************************************************** @@ -153,7 +153,7 @@ SUBROUTINE eip_env_release(eip_env) IF (ASSOCIATED(eip_env)) THEN CPASSERT(eip_env%ref_count > 0) - eip_env%ref_count = eip_env%ref_count-1 + eip_env%ref_count = eip_env%ref_count - 1 IF (eip_env%ref_count < 1) THEN IF (ASSOCIATED(eip_env%eip_forces)) THEN DEALLOCATE (eip_env%eip_forces) @@ -488,7 +488,7 @@ SUBROUTINE eip_env_create(eip_env) NULLIFY (eip_env%cell_ref) eip_env%ref_count = 1 - last_eip_id = last_eip_id+1 + last_eip_id = last_eip_id + 1 eip_env%id_nr = last_eip_id eip_env%use_ref_cell = .FALSE. CALL eip_env_clear(eip_env) diff --git a/src/eip_silicon.F b/src/eip_silicon.F index 5677fbf52b..59f48ac1d9 100644 --- a/src/eip_silicon.F +++ b/src/eip_silicon.F @@ -137,10 +137,10 @@ SUBROUTINE eip_bazant(eip_env) nparticle_local = local_particles%n_el(iparticle_kind) DO iparticle_local = 1, nparticle_local iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) - ekin = ekin+0.5_dp*mass* & + ekin = ekin + 0.5_dp*mass* & (particle_set(iparticle)%v(1)*particle_set(iparticle)%v(1) & - +particle_set(iparticle)%v(2)*particle_set(iparticle)%v(2) & - +particle_set(iparticle)%v(3)*particle_set(iparticle)%v(3)) + + particle_set(iparticle)%v(2)*particle_set(iparticle)%v(2) & + + particle_set(iparticle)%v(3)*particle_set(iparticle)%v(3)) END DO END DO @@ -150,7 +150,7 @@ SUBROUTINE eip_bazant(eip_env) eip_env%eip_kinetic_energy = ekin eip_env%eip_potential_energy = ener/evolt - eip_env%eip_energy = eip_env%eip_kinetic_energy+eip_env%eip_potential_energy + eip_env%eip_energy = eip_env%eip_kinetic_energy + eip_env%eip_potential_energy eip_env%eip_energy_var = ener_var/evolt DO i = 1, natom @@ -303,10 +303,10 @@ SUBROUTINE eip_lenosky(eip_env) nparticle_local = local_particles%n_el(iparticle_kind) DO iparticle_local = 1, nparticle_local iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) - ekin = ekin+0.5_dp*mass* & + ekin = ekin + 0.5_dp*mass* & (particle_set(iparticle)%v(1)*particle_set(iparticle)%v(1) & - +particle_set(iparticle)%v(2)*particle_set(iparticle)%v(2) & - +particle_set(iparticle)%v(3)*particle_set(iparticle)%v(3)) + + particle_set(iparticle)%v(2)*particle_set(iparticle)%v(2) & + + particle_set(iparticle)%v(3)*particle_set(iparticle)%v(3)) END DO END DO @@ -316,7 +316,7 @@ SUBROUTINE eip_lenosky(eip_env) eip_env%eip_kinetic_energy = ekin eip_env%eip_potential_energy = ener/evolt - eip_env%eip_energy = eip_env%eip_kinetic_energy+eip_env%eip_potential_energy + eip_env%eip_energy = eip_env%eip_kinetic_energy + eip_env%eip_potential_energy eip_env%eip_energy_var = ener_var/evolt DO i = 1, natom @@ -643,10 +643,10 @@ SUBROUTINE eip_bazant_silicon(nat, alat, rxyz0, fxyz, ener, coord, ener_var, & l1, myspaceout, ncx, nn, nnbrx, npr ! cut=par_a - cut = 3.1213820e0_dp+1.e-14_dp + cut = 3.1213820e0_dp + 1.e-14_dp IF (count .EQ. 0) OPEN (unit=10, file='bazant.mon', status='unknown') - count = count+1.e0_dp + count = count + 1.e0_dp ! linear scaling calculation of verlet list ll1 = INT(alat(1)/cut) @@ -685,7 +685,7 @@ SUBROUTINE eip_bazant_silicon(nat, alat, rxyz0, fxyz, ener, coord, ener_var, & l3 = INT(rxyz0(3, iat)*rlc3i) ii = icell(0, l1, l2, l3) - ii = ii+1 + ii = ii + 1 icell(0, l1, l2, l3) = ii IF (ii .GT. ncx) THEN WRITE (10, *) count, 'NCX too small', ncx @@ -725,7 +725,7 @@ SUBROUTINE eip_bazant_silicon(nat, alat, rxyz0, fxyz, ener, coord, ener_var, & l2 = INT(rxyz0(2, iat)*rlc2i) l3 = INT(rxyz0(3, iat)*rlc3i) ii = icell(0, l1, l2, l3) - ii = ii+1 + ii = ii + 1 icell(0, l1, l2, l3) = ii IF (ii .GT. ncx) THEN WRITE (10, *) count, 'NCX too small', ncx @@ -741,8 +741,8 @@ SUBROUTINE eip_bazant_silicon(nat, alat, rxyz0, fxyz, ener, coord, ener_var, & ENDIF ! duplicate all atoms within boundary layer - laymx = ncx*(2*ll1*ll2+2*ll1*ll3+2*ll2*ll3+4*ll1+4*ll2+4*ll3+8) - nn = nat+laymx + laymx = ncx*(2*ll1*ll2 + 2*ll1*ll3 + 2*ll2*ll3 + 4*ll1 + 4*ll2 + 4*ll3 + 8) + nn = nat + laymx ALLOCATE (rxyz(3, nn), lay(nn)) DO iat = 1, nat lay(iat) = iat @@ -752,64 +752,64 @@ SUBROUTINE eip_bazant_silicon(nat, alat, rxyz0, fxyz, ener, coord, ener_var, & ENDDO il = nat ! xy plane - DO l2 = 0, ll2-1 - DO l1 = 0, ll1-1 + DO l2 = 0, ll2 - 1 + DO l1 = 0, ll1 - 1 in = icell(0, l1, l2, 0) icell(0, l1, l2, ll3) = in DO ii = 1, in i = icell(ii, l1, l2, 0) - il = il+1 + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, l1, l2, ll3) = il rxyz(1, il) = rxyz(1, i) rxyz(2, il) = rxyz(2, i) - rxyz(3, il) = rxyz(3, i)+alat(3) + rxyz(3, il) = rxyz(3, i) + alat(3) ENDDO - in = icell(0, l1, l2, ll3-1) + in = icell(0, l1, l2, ll3 - 1) icell(0, l1, l2, -1) = in DO ii = 1, in - i = icell(ii, l1, l2, ll3-1) - il = il+1 + i = icell(ii, l1, l2, ll3 - 1) + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, l1, l2, -1) = il rxyz(1, il) = rxyz(1, i) rxyz(2, il) = rxyz(2, i) - rxyz(3, il) = rxyz(3, i)-alat(3) + rxyz(3, il) = rxyz(3, i) - alat(3) ENDDO ENDDO ENDDO ! yz plane - DO l3 = 0, ll3-1 - DO l2 = 0, ll2-1 + DO l3 = 0, ll3 - 1 + DO l2 = 0, ll2 - 1 in = icell(0, 0, l2, l3) icell(0, ll1, l2, l3) = in DO ii = 1, in i = icell(ii, 0, l2, l3) - il = il+1 + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, ll1, l2, l3) = il - rxyz(1, il) = rxyz(1, i)+alat(1) + rxyz(1, il) = rxyz(1, i) + alat(1) rxyz(2, il) = rxyz(2, i) rxyz(3, il) = rxyz(3, i) ENDDO - in = icell(0, ll1-1, l2, l3) + in = icell(0, ll1 - 1, l2, l3) icell(0, -1, l2, l3) = in DO ii = 1, in - i = icell(ii, ll1-1, l2, l3) - il = il+1 + i = icell(ii, ll1 - 1, l2, l3) + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, -1, l2, l3) = il - rxyz(1, il) = rxyz(1, i)-alat(1) + rxyz(1, il) = rxyz(1, i) - alat(1) rxyz(2, il) = rxyz(2, i) rxyz(3, il) = rxyz(3, i) ENDDO @@ -818,32 +818,32 @@ SUBROUTINE eip_bazant_silicon(nat, alat, rxyz0, fxyz, ener, coord, ener_var, & ENDDO ! xz plane - DO l3 = 0, ll3-1 - DO l1 = 0, ll1-1 + DO l3 = 0, ll3 - 1 + DO l1 = 0, ll1 - 1 in = icell(0, l1, 0, l3) icell(0, l1, ll2, l3) = in DO ii = 1, in i = icell(ii, l1, 0, l3) - il = il+1 + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, l1, ll2, l3) = il rxyz(1, il) = rxyz(1, i) - rxyz(2, il) = rxyz(2, i)+alat(2) + rxyz(2, il) = rxyz(2, i) + alat(2) rxyz(3, il) = rxyz(3, i) ENDDO - in = icell(0, l1, ll2-1, l3) + in = icell(0, l1, ll2 - 1, l3) icell(0, l1, -1, l3) = in DO ii = 1, in - i = icell(ii, l1, ll2-1, l3) - il = il+1 + i = icell(ii, l1, ll2 - 1, l3) + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, l1, -1, l3) = il rxyz(1, il) = rxyz(1, i) - rxyz(2, il) = rxyz(2, i)-alat(2) + rxyz(2, il) = rxyz(2, i) - alat(2) rxyz(3, il) = rxyz(3, i) ENDDO @@ -851,171 +851,171 @@ SUBROUTINE eip_bazant_silicon(nat, alat, rxyz0, fxyz, ener, coord, ener_var, & ENDDO ! x axis - DO l1 = 0, ll1-1 + DO l1 = 0, ll1 - 1 in = icell(0, l1, 0, 0) icell(0, l1, ll2, ll3) = in DO ii = 1, in i = icell(ii, l1, 0, 0) - il = il+1 + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, l1, ll2, ll3) = il rxyz(1, il) = rxyz(1, i) - rxyz(2, il) = rxyz(2, i)+alat(2) - rxyz(3, il) = rxyz(3, i)+alat(3) + rxyz(2, il) = rxyz(2, i) + alat(2) + rxyz(3, il) = rxyz(3, i) + alat(3) ENDDO - in = icell(0, l1, 0, ll3-1) + in = icell(0, l1, 0, ll3 - 1) icell(0, l1, ll2, -1) = in DO ii = 1, in - i = icell(ii, l1, 0, ll3-1) - il = il+1 + i = icell(ii, l1, 0, ll3 - 1) + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, l1, ll2, -1) = il rxyz(1, il) = rxyz(1, i) - rxyz(2, il) = rxyz(2, i)+alat(2) - rxyz(3, il) = rxyz(3, i)-alat(3) + rxyz(2, il) = rxyz(2, i) + alat(2) + rxyz(3, il) = rxyz(3, i) - alat(3) ENDDO - in = icell(0, l1, ll2-1, 0) + in = icell(0, l1, ll2 - 1, 0) icell(0, l1, -1, ll3) = in DO ii = 1, in - i = icell(ii, l1, ll2-1, 0) - il = il+1 + i = icell(ii, l1, ll2 - 1, 0) + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, l1, -1, ll3) = il rxyz(1, il) = rxyz(1, i) - rxyz(2, il) = rxyz(2, i)-alat(2) - rxyz(3, il) = rxyz(3, i)+alat(3) + rxyz(2, il) = rxyz(2, i) - alat(2) + rxyz(3, il) = rxyz(3, i) + alat(3) ENDDO - in = icell(0, l1, ll2-1, ll3-1) + in = icell(0, l1, ll2 - 1, ll3 - 1) icell(0, l1, -1, -1) = in DO ii = 1, in - i = icell(ii, l1, ll2-1, ll3-1) - il = il+1 + i = icell(ii, l1, ll2 - 1, ll3 - 1) + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, l1, -1, -1) = il rxyz(1, il) = rxyz(1, i) - rxyz(2, il) = rxyz(2, i)-alat(2) - rxyz(3, il) = rxyz(3, i)-alat(3) + rxyz(2, il) = rxyz(2, i) - alat(2) + rxyz(3, il) = rxyz(3, i) - alat(3) ENDDO ENDDO ! y axis - DO l2 = 0, ll2-1 + DO l2 = 0, ll2 - 1 in = icell(0, 0, l2, 0) icell(0, ll1, l2, ll3) = in DO ii = 1, in i = icell(ii, 0, l2, 0) - il = il+1 + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, ll1, l2, ll3) = il - rxyz(1, il) = rxyz(1, i)+alat(1) + rxyz(1, il) = rxyz(1, i) + alat(1) rxyz(2, il) = rxyz(2, i) - rxyz(3, il) = rxyz(3, i)+alat(3) + rxyz(3, il) = rxyz(3, i) + alat(3) ENDDO - in = icell(0, 0, l2, ll3-1) + in = icell(0, 0, l2, ll3 - 1) icell(0, ll1, l2, -1) = in DO ii = 1, in - i = icell(ii, 0, l2, ll3-1) - il = il+1 + i = icell(ii, 0, l2, ll3 - 1) + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, ll1, l2, -1) = il - rxyz(1, il) = rxyz(1, i)+alat(1) + rxyz(1, il) = rxyz(1, i) + alat(1) rxyz(2, il) = rxyz(2, i) - rxyz(3, il) = rxyz(3, i)-alat(3) + rxyz(3, il) = rxyz(3, i) - alat(3) ENDDO - in = icell(0, ll1-1, l2, 0) + in = icell(0, ll1 - 1, l2, 0) icell(0, -1, l2, ll3) = in DO ii = 1, in - i = icell(ii, ll1-1, l2, 0) - il = il+1 + i = icell(ii, ll1 - 1, l2, 0) + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, -1, l2, ll3) = il - rxyz(1, il) = rxyz(1, i)-alat(1) + rxyz(1, il) = rxyz(1, i) - alat(1) rxyz(2, il) = rxyz(2, i) - rxyz(3, il) = rxyz(3, i)+alat(3) + rxyz(3, il) = rxyz(3, i) + alat(3) ENDDO - in = icell(0, ll1-1, l2, ll3-1) + in = icell(0, ll1 - 1, l2, ll3 - 1) icell(0, -1, l2, -1) = in DO ii = 1, in - i = icell(ii, ll1-1, l2, ll3-1) - il = il+1 + i = icell(ii, ll1 - 1, l2, ll3 - 1) + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, -1, l2, -1) = il - rxyz(1, il) = rxyz(1, i)-alat(1) + rxyz(1, il) = rxyz(1, i) - alat(1) rxyz(2, il) = rxyz(2, i) - rxyz(3, il) = rxyz(3, i)-alat(3) + rxyz(3, il) = rxyz(3, i) - alat(3) ENDDO ENDDO ! z axis - DO l3 = 0, ll3-1 + DO l3 = 0, ll3 - 1 in = icell(0, 0, 0, l3) icell(0, ll1, ll2, l3) = in DO ii = 1, in i = icell(ii, 0, 0, l3) - il = il+1 + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, ll1, ll2, l3) = il - rxyz(1, il) = rxyz(1, i)+alat(1) - rxyz(2, il) = rxyz(2, i)+alat(2) + rxyz(1, il) = rxyz(1, i) + alat(1) + rxyz(2, il) = rxyz(2, i) + alat(2) rxyz(3, il) = rxyz(3, i) ENDDO - in = icell(0, ll1-1, 0, l3) + in = icell(0, ll1 - 1, 0, l3) icell(0, -1, ll2, l3) = in DO ii = 1, in - i = icell(ii, ll1-1, 0, l3) - il = il+1 + i = icell(ii, ll1 - 1, 0, l3) + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, -1, ll2, l3) = il - rxyz(1, il) = rxyz(1, i)-alat(1) - rxyz(2, il) = rxyz(2, i)+alat(2) + rxyz(1, il) = rxyz(1, i) - alat(1) + rxyz(2, il) = rxyz(2, i) + alat(2) rxyz(3, il) = rxyz(3, i) ENDDO - in = icell(0, 0, ll2-1, l3) + in = icell(0, 0, ll2 - 1, l3) icell(0, ll1, -1, l3) = in DO ii = 1, in - i = icell(ii, 0, ll2-1, l3) - il = il+1 + i = icell(ii, 0, ll2 - 1, l3) + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, ll1, -1, l3) = il - rxyz(1, il) = rxyz(1, i)+alat(1) - rxyz(2, il) = rxyz(2, i)-alat(2) + rxyz(1, il) = rxyz(1, i) + alat(1) + rxyz(2, il) = rxyz(2, i) - alat(2) rxyz(3, il) = rxyz(3, i) ENDDO - in = icell(0, ll1-1, ll2-1, l3) + in = icell(0, ll1 - 1, ll2 - 1, l3) icell(0, -1, -1, l3) = in DO ii = 1, in - i = icell(ii, ll1-1, ll2-1, l3) - il = il+1 + i = icell(ii, ll1 - 1, ll2 - 1, l3) + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, -1, -1, l3) = il - rxyz(1, il) = rxyz(1, i)-alat(1) - rxyz(2, il) = rxyz(2, i)-alat(2) + rxyz(1, il) = rxyz(1, i) - alat(1) + rxyz(2, il) = rxyz(2, i) - alat(2) rxyz(3, il) = rxyz(3, i) ENDDO @@ -1026,104 +1026,104 @@ SUBROUTINE eip_bazant_silicon(nat, alat, rxyz0, fxyz, ener, coord, ener_var, & icell(0, ll1, ll2, ll3) = in DO ii = 1, in i = icell(ii, 0, 0, 0) - il = il+1 + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, ll1, ll2, ll3) = il - rxyz(1, il) = rxyz(1, i)+alat(1) - rxyz(2, il) = rxyz(2, i)+alat(2) - rxyz(3, il) = rxyz(3, i)+alat(3) + rxyz(1, il) = rxyz(1, i) + alat(1) + rxyz(2, il) = rxyz(2, i) + alat(2) + rxyz(3, il) = rxyz(3, i) + alat(3) ENDDO - in = icell(0, ll1-1, 0, 0) + in = icell(0, ll1 - 1, 0, 0) icell(0, -1, ll2, ll3) = in DO ii = 1, in - i = icell(ii, ll1-1, 0, 0) - il = il+1 + i = icell(ii, ll1 - 1, 0, 0) + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, -1, ll2, ll3) = il - rxyz(1, il) = rxyz(1, i)-alat(1) - rxyz(2, il) = rxyz(2, i)+alat(2) - rxyz(3, il) = rxyz(3, i)+alat(3) + rxyz(1, il) = rxyz(1, i) - alat(1) + rxyz(2, il) = rxyz(2, i) + alat(2) + rxyz(3, il) = rxyz(3, i) + alat(3) ENDDO - in = icell(0, 0, ll2-1, 0) + in = icell(0, 0, ll2 - 1, 0) icell(0, ll1, -1, ll3) = in DO ii = 1, in - i = icell(ii, 0, ll2-1, 0) - il = il+1 + i = icell(ii, 0, ll2 - 1, 0) + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, ll1, -1, ll3) = il - rxyz(1, il) = rxyz(1, i)+alat(1) - rxyz(2, il) = rxyz(2, i)-alat(2) - rxyz(3, il) = rxyz(3, i)+alat(3) + rxyz(1, il) = rxyz(1, i) + alat(1) + rxyz(2, il) = rxyz(2, i) - alat(2) + rxyz(3, il) = rxyz(3, i) + alat(3) ENDDO - in = icell(0, ll1-1, ll2-1, 0) + in = icell(0, ll1 - 1, ll2 - 1, 0) icell(0, -1, -1, ll3) = in DO ii = 1, in - i = icell(ii, ll1-1, ll2-1, 0) - il = il+1 + i = icell(ii, ll1 - 1, ll2 - 1, 0) + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, -1, -1, ll3) = il - rxyz(1, il) = rxyz(1, i)-alat(1) - rxyz(2, il) = rxyz(2, i)-alat(2) - rxyz(3, il) = rxyz(3, i)+alat(3) + rxyz(1, il) = rxyz(1, i) - alat(1) + rxyz(2, il) = rxyz(2, i) - alat(2) + rxyz(3, il) = rxyz(3, i) + alat(3) ENDDO - in = icell(0, 0, 0, ll3-1) + in = icell(0, 0, 0, ll3 - 1) icell(0, ll1, ll2, -1) = in DO ii = 1, in - i = icell(ii, 0, 0, ll3-1) - il = il+1 + i = icell(ii, 0, 0, ll3 - 1) + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, ll1, ll2, -1) = il - rxyz(1, il) = rxyz(1, i)+alat(1) - rxyz(2, il) = rxyz(2, i)+alat(2) - rxyz(3, il) = rxyz(3, i)-alat(3) + rxyz(1, il) = rxyz(1, i) + alat(1) + rxyz(2, il) = rxyz(2, i) + alat(2) + rxyz(3, il) = rxyz(3, i) - alat(3) ENDDO - in = icell(0, ll1-1, 0, ll3-1) + in = icell(0, ll1 - 1, 0, ll3 - 1) icell(0, -1, ll2, -1) = in DO ii = 1, in - i = icell(ii, ll1-1, 0, ll3-1) - il = il+1 + i = icell(ii, ll1 - 1, 0, ll3 - 1) + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, -1, ll2, -1) = il - rxyz(1, il) = rxyz(1, i)-alat(1) - rxyz(2, il) = rxyz(2, i)+alat(2) - rxyz(3, il) = rxyz(3, i)-alat(3) + rxyz(1, il) = rxyz(1, i) - alat(1) + rxyz(2, il) = rxyz(2, i) + alat(2) + rxyz(3, il) = rxyz(3, i) - alat(3) ENDDO - in = icell(0, 0, ll2-1, ll3-1) + in = icell(0, 0, ll2 - 1, ll3 - 1) icell(0, ll1, -1, -1) = in DO ii = 1, in - i = icell(ii, 0, ll2-1, ll3-1) - il = il+1 + i = icell(ii, 0, ll2 - 1, ll3 - 1) + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, ll1, -1, -1) = il - rxyz(1, il) = rxyz(1, i)+alat(1) - rxyz(2, il) = rxyz(2, i)-alat(2) - rxyz(3, il) = rxyz(3, i)-alat(3) + rxyz(1, il) = rxyz(1, i) + alat(1) + rxyz(2, il) = rxyz(2, i) - alat(2) + rxyz(3, il) = rxyz(3, i) - alat(3) ENDDO - in = icell(0, ll1-1, ll2-1, ll3-1) + in = icell(0, ll1 - 1, ll2 - 1, ll3 - 1) icell(0, -1, -1, -1) = in DO ii = 1, in - i = icell(ii, ll1-1, ll2-1, ll3-1) - il = il+1 + i = icell(ii, ll1 - 1, ll2 - 1, ll3 - 1) + il = il + 1 IF (il .GT. nn) CPABORT("enlarge laymx") lay(il) = i icell(ii, -1, -1, -1) = il - rxyz(1, il) = rxyz(1, i)-alat(1) - rxyz(2, il) = rxyz(2, i)-alat(2) - rxyz(3, il) = rxyz(3, i)-alat(3) + rxyz(1, il) = rxyz(1, i) - alat(1) + rxyz(2, il) = rxyz(2, i) - alat(2) + rxyz(3, il) = rxyz(3, i) - alat(3) ENDDO ALLOCATE (lsta(2, nat)) @@ -1149,18 +1149,18 @@ SUBROUTINE eip_bazant_silicon(nat, alat, rxyz0, fxyz, ener, coord, ener_var, & IF (iam .EQ. 0) myspaceout = myspace ! Verlet list, relative positions indlst = 0 - loop_l3: DO l3 = 0, ll3-1 - loop_l2: DO l2 = 0, ll2-1 - loop_l1: DO l1 = 0, ll1-1 + loop_l3: DO l3 = 0, ll3 - 1 + loop_l2: DO l2 = 0, ll2 - 1 + loop_l1: DO l1 = 0, ll1 - 1 loop_ii: DO ii = 1, icell(0, l1, l2, l3) iat = icell(ii, l1, l2, l3) - IF (((iat-1)*npr)/nat .EQ. iam) THEN + IF (((iat - 1)*npr)/nat .EQ. iam) THEN ! write(*,*) 'sublstiat:iam,iat',iam,iat - lsta(1, iat) = iam*myspace+indlst+1 + lsta(1, iat) = iam*myspace + indlst + 1 CALL sublstiat_b(iat, nn, ncx, ll1, ll2, ll3, l1, l2, l3, myspace, & - rxyz, icell, lstb(iam*myspace+1), lay, & - rel(1, iam*myspace+1), cut2, indlst) - lsta(2, iat) = iam*myspace+indlst + rxyz, icell, lstb(iam*myspace + 1), lay, & + rel(1, iam*myspace + 1), cut2, indlst) + lsta(2, iat) = iam*myspace + indlst ! write(*,'(a,4(x,i3),100(x,i2))') & ! 'iam,iat,lsta',iam,iat,lsta(1,iat),lsta(2,iat), & ! (lstb(j),j=lsta(1,iat),lsta(2,iat)) @@ -1220,9 +1220,9 @@ SUBROUTINE eip_bazant_silicon(nat, alat, rxyz0, fxyz, ener, coord, ener_var, & !$OMP BARRIER ! Each thread treats at most lot atoms - lot = INT(REAL(nat, KIND=dp)/REAL(npr, KIND=dp)+.999999999999e0_dp) - iat1 = iam*lot+1 - iat2 = MIN((iam+1)*lot, nat) + lot = INT(REAL(nat, KIND=dp)/REAL(npr, KIND=dp) + .999999999999e0_dp) + iat1 = iam*lot + 1 + iat2 = MIN((iam + 1)*lot, nat) ! write(*,*) 'subfeniat:iat1,iat2,iam',iat1,iat2,iam CALL subfeniat_b(iat1, iat2, nat, lsta, lstb, rel, tener, tener2, & tcoord, tcoord2, nnbrx, txyz, max_nbrs, istop, & @@ -1231,15 +1231,15 @@ SUBROUTINE eip_bazant_silicon(nat, alat, rxyz0, fxyz, ener, coord, ener_var, & num3, sz(1, 1), sz(1, 2), sz(1, 3), sz(1, 4), sz(1, 5), sz(1, 6), numz) !$OMP CRITICAL - ener = ener+tener - ener2 = ener2+tener2 - coord = coord+tcoord - coord2 = coord2+tcoord2 - istopg = istopg+istop + ener = ener + tener + ener2 = ener2 + tener2 + coord = coord + tcoord + coord2 = coord2 + tcoord2 + istopg = istopg + istop DO iat = 1, nat - fxyz(1, iat) = fxyz(1, iat)+txyz(1, iat) - fxyz(2, iat) = fxyz(2, iat)+txyz(2, iat) - fxyz(3, iat) = fxyz(3, iat)+txyz(3, iat) + fxyz(1, iat) = fxyz(1, iat) + txyz(1, iat) + fxyz(2, iat) = fxyz(2, iat) + txyz(2, iat) + fxyz(3, iat) = fxyz(3, iat) + txyz(3, iat) END DO DEALLOCATE (txyz, s2, s3, sz, num2, num3, numz) !$OMP END CRITICAL @@ -1263,9 +1263,9 @@ SUBROUTINE eip_bazant_silicon(nat, alat, rxyz0, fxyz, ener, coord, ener_var, & ! write(*,*) 'ener,norm force', & ! ener,DNRM2(3*nat,fxyz,1) IF (istopg .GT. 0) CPABORT("DIMENSION ERROR (see WARNING above)") - ener_var = ener2/nat-(ener/nat)**2 + ener_var = ener2/nat - (ener/nat)**2 coord = coord/nat - coord_var = coord2/nat-coord**2 + coord_var = coord2/nat - coord**2 DEALLOCATE (rxyz, icell, lay, lsta, lstb, rel) @@ -1402,8 +1402,8 @@ SUBROUTINE subfeniat_b(iat1, iat2, nat, lsta, lstb, rel, ener, ener2, & Qort = SQRT(par_Qo) muhalf = par_mu*0.5e0_dp u5 = u2*u4 - bmc = par_b-par_c - cmbinv = 1.0e0_dp/(par_c-par_b) + bmc = par_b - par_c + cmbinv = 1.0e0_dp/(par_c - par_b) ! --- LEVEL 1: OUTER LOOP OVER ATOMS --- @@ -1431,7 +1431,7 @@ SUBROUTINE subfeniat_b(iat1, iat2, nat, lsta, lstb, rel, ener, ener2, & dz = -rel(3, n) r = rel(4, n) rinv = rel(5, n) - rmainv = 1.e0_dp/(r-par_a) + rmainv = 1.e0_dp/(r - par_a) s2_t0(n2) = par_cap_A*EXP(par_sig*rmainv) s2_t1(n2) = (par_cap_B*rinv)**par_rh s2_t2(n2) = par_rh*rinv @@ -1440,7 +1440,7 @@ SUBROUTINE subfeniat_b(iat1, iat2, nat, lsta, lstb, rel, ener, ener2, & s2_dy(n2) = dy s2_dz(n2) = dz s2_r(n2) = r - n2 = n2+1 + n2 = n2 + 1 IF (n2 .GT. max_nbrs) THEN WRITE (*, *) 'WARNING enlarge max_nbrs' istop = 1 @@ -1450,11 +1450,11 @@ SUBROUTINE subfeniat_b(iat1, iat2, nat, lsta, lstb, rel, ener, ener2, & ! coordination number calculated with soft cutoff between first ! nearest neighbor and midpoint of first and second nearest neighbor IF (r .LE. 2.36e0_dp) THEN - coord_iat = coord_iat+1.e0_dp + coord_iat = coord_iat + 1.e0_dp ELSE IF (r .GE. 3.12e0_dp) THEN ELSE - xarg = (r-2.36e0_dp)*(1.e0_dp/(3.12e0_dp-2.36e0_dp)) - coord_iat = coord_iat+(2*xarg+1.e0_dp)*(xarg-1.e0_dp)**2 + xarg = (r - 2.36e0_dp)*(1.e0_dp/(3.12e0_dp - 2.36e0_dp)) + coord_iat = coord_iat + (2*xarg + 1.e0_dp)*(xarg - 1.e0_dp)**2 ENDIF ! RADIAL PARTS OF THREE-BODY INTERACTION r 0) THEN CALL section_vals_val_get(force_env_section, "EMBED%GROUP_PARTITION", i_vals=i_vals) - ALLOCATE (group_partition(0:SIZE(i_vals)-1)) + ALLOCATE (group_partition(0:SIZE(i_vals) - 1)) group_partition(:) = i_vals ngroup_wish_set = .TRUE. ngroup_wish = SIZE(i_vals) @@ -98,7 +98,7 @@ SUBROUTINE embed_create_force_env(embed_env, root_section, para_env, & END IF ! Split the current communicator - ALLOCATE (embed_env%group_distribution(0:para_env%num_pe-1)) + ALLOCATE (embed_env%group_distribution(0:para_env%num_pe - 1)) IF (group_size_wish_set) THEN CALL mp_comm_split(para_env%group, embed_env%new_group, embed_env%ngroups, embed_env%group_distribution, & subgroup_min_size=group_size_wish) @@ -110,7 +110,7 @@ SUBROUTINE embed_create_force_env(embed_env, root_section, para_env, & IF (output_unit > 0) THEN WRITE (output_unit, FMT="(T2,A,T71,I10)") "EMBED_ENV| Number of created MPI groups:", embed_env%ngroups WRITE (output_unit, FMT="(T2,A)", ADVANCE="NO") "EMBED_ENV| Task to group correspondence:" - DO i = 0, para_env%num_pe-1 + DO i = 0, para_env%num_pe - 1 IF (MODULO(i, 4) == 0) WRITE (output_unit, *) WRITE (output_unit, FMT='(A3,I4,A3,I4,A1)', ADVANCE="NO") & " (", i, " : ", embed_env%group_distribution(i), ")" @@ -127,7 +127,7 @@ SUBROUTINE embed_create_force_env(embed_env, root_section, para_env, & ! DO i = 1, embed_env%ngroups NULLIFY (embed_env%sub_para_env(i)%para_env, logger) - IF (MODULO(i-1, embed_env%ngroups) == embed_env%group_distribution(para_env%mepos)) THEN + IF (MODULO(i - 1, embed_env%ngroups) == embed_env%group_distribution(para_env%mepos)) THEN ! Create sub_para_env CALL cp_para_env_create(embed_env%sub_para_env(i)%para_env, & group=embed_env%new_group, & @@ -138,8 +138,8 @@ SUBROUTINE embed_create_force_env(embed_env, root_section, para_env, & CALL section_vals_val_get(root_section, "GLOBAL%PROJECT_NAME", & c_val=input_file_path) lp = LEN_TRIM(input_file_path) - input_file_path(lp+1:LEN(input_file_path)) = "-r-"// & - ADJUSTL(cp_to_string(i)) + input_file_path(lp + 1:LEN(input_file_path)) = "-r-"// & + ADJUSTL(cp_to_string(i)) lp = LEN_TRIM(input_file_path) output_file_path = input_file_path(1:lp)//".out" CALL open_file(file_name=output_file_path, file_status="UNKNOWN", & diff --git a/src/embed_types.F b/src/embed_types.F index 22e4dfbc64..eac9b61238 100644 --- a/src/embed_types.F +++ b/src/embed_types.F @@ -223,7 +223,7 @@ SUBROUTINE init_embed_env(embed_env, para_env) CALL cp_para_env_retain(para_env) embed_env%para_env => para_env embed_env%ref_count = 1 - last_embed_env_id_nr = last_embed_env_id_nr+1 + last_embed_env_id_nr = last_embed_env_id_nr + 1 embed_env%id_nr = last_embed_env_id_nr END SUBROUTINE init_embed_env @@ -351,7 +351,7 @@ SUBROUTINE embed_env_retain(embed_env) CPASSERT(ASSOCIATED(embed_env)) CPASSERT(embed_env%ref_count > 0) - embed_env%ref_count = embed_env%ref_count+1 + embed_env%ref_count = embed_env%ref_count + 1 END SUBROUTINE embed_env_retain ! ************************************************************************************************** @@ -369,7 +369,7 @@ SUBROUTINE embed_env_release(embed_env) IF (ASSOCIATED(embed_env)) THEN CPASSERT(embed_env%ref_count > 0) - embed_env%ref_count = embed_env%ref_count-1 + embed_env%ref_count = embed_env%ref_count - 1 IF (embed_env%ref_count < 1) THEN ngroups = SIZE(embed_env%sub_para_env) DO i = 1, ngroups diff --git a/src/emd/rt_delta_pulse.F b/src/emd/rt_delta_pulse.F index 9dd00b70bc..d672f8d141 100644 --- a/src/emd/rt_delta_pulse.F +++ b/src/emd/rt_delta_pulse.F @@ -136,15 +136,15 @@ SUBROUTINE apply_delta_pulse_periodic(qs_env, mos_old, mos_new) ! virtuals CALL get_mo_set(mo_set=mos(ispin)%mo_set, nao=nao, nmo=nmo) - nvirt = nao-nmo + nvirt = nao - nmo CALL cp_fm_struct_create(fm_struct_tmp, para_env=S_inv_fm%matrix_struct%para_env, context=S_inv_fm%matrix_struct%context, & nrow_global=nrow_global, ncol_global=nvirt) CALL cp_fm_create(virtuals, matrix_struct=fm_struct_tmp, name="virtuals") CALL cp_fm_struct_release(fm_struct_tmp) - CALL cp_fm_to_fm(eigenvectors, virtuals, nvirt, nmo+1, 1) + CALL cp_fm_to_fm(eigenvectors, virtuals, nvirt, nmo + 1, 1) ! occupied - CALL cp_fm_to_fm(eigenvectors, mos_old(2*ispin-1)%matrix, nmo, 1, 1) + CALL cp_fm_to_fm(eigenvectors, mos_old(2*ispin - 1)%matrix, nmo, 1, 1) CALL cp_fm_struct_create(fm_struct_tmp, para_env=S_inv_fm%matrix_struct%para_env, context=S_inv_fm%matrix_struct%context, & nrow_global=nvirt, ncol_global=nmo) @@ -152,31 +152,31 @@ SUBROUTINE apply_delta_pulse_periodic(qs_env, mos_old, mos_new) CALL cp_fm_struct_release(fm_struct_tmp) ! the momentum operator (in a given direction) - CALL cp_fm_set_all(mos_new(2*ispin-1)%matrix, 0.0_dp) + CALL cp_fm_set_all(mos_new(2*ispin - 1)%matrix, 0.0_dp) ! the prefactor (strength of the electric field) - kvec(:) = cell%h_inv(1, :)*dft_control%rtp_control%delta_pulse_direction(1)+ & - cell%h_inv(2, :)*dft_control%rtp_control%delta_pulse_direction(2)+ & + kvec(:) = cell%h_inv(1, :)*dft_control%rtp_control%delta_pulse_direction(1) + & + cell%h_inv(2, :)*dft_control%rtp_control%delta_pulse_direction(2) + & cell%h_inv(3, :)*dft_control%rtp_control%delta_pulse_direction(3) kvec = -kvec*twopi*dft_control%rtp_control%delta_pulse_scale DO idir = 1, 3 factor = kvec(idir) IF (factor .NE. 0.0_dp) THEN - CALL cp_dbcsr_sm_fm_multiply(matrix_s(idir+1)%matrix, mos_old(2*ispin-1)%matrix, & + CALL cp_dbcsr_sm_fm_multiply(matrix_s(idir + 1)%matrix, mos_old(2*ispin - 1)%matrix, & mos_old(2*ispin)%matrix, ncol=nmo) - CALL cp_fm_scale_and_add(1.0_dp, mos_new(2*ispin-1)%matrix, factor, mos_old(2*ispin)%matrix) + CALL cp_fm_scale_and_add(1.0_dp, mos_new(2*ispin - 1)%matrix, factor, mos_old(2*ispin)%matrix) ENDIF ENDDO - CALL cp_gemm('T', 'N', nvirt, nmo, nao, 1.0_dp, virtuals, mos_new(2*ispin-1)%matrix, 0.0_dp, momentum) + CALL cp_gemm('T', 'N', nvirt, nmo, nao, 1.0_dp, virtuals, mos_new(2*ispin - 1)%matrix, 0.0_dp, momentum) ! the tricky bit ... rescale by the eigenvalue difference CALL cp_fm_get_info(momentum, nrow_local=nrow_local, ncol_local=ncol_local, & row_indices=row_indices, col_indices=col_indices, local_data=local_data) DO icol = 1, ncol_local DO irow = 1, nrow_local - factor = 1/(eigenvalues(col_indices(icol))-eigenvalues(nmo+row_indices(irow))) + factor = 1/(eigenvalues(col_indices(icol)) - eigenvalues(nmo + row_indices(irow))) local_data(irow, icol) = factor*local_data(irow, icol) ENDDO ENDDO @@ -184,7 +184,7 @@ SUBROUTINE apply_delta_pulse_periodic(qs_env, mos_old, mos_new) DEALLOCATE (eigenvalues) ! now obtain the initial condition in mos_old - CALL cp_fm_to_fm(eigenvectors, mos_old(2*ispin-1)%matrix, nmo, 1, 1) + CALL cp_fm_to_fm(eigenvectors, mos_old(2*ispin - 1)%matrix, nmo, 1, 1) CALL cp_gemm("N", "N", nao, nmo, nvirt, 1.0_dp, virtuals, momentum, 0.0_dp, mos_old(2*ispin)%matrix) CALL cp_fm_release(virtuals) @@ -197,19 +197,19 @@ SUBROUTINE apply_delta_pulse_periodic(qs_env, mos_old, mos_new) CALL cp_fm_create(oo_2, matrix_struct=fm_struct_tmp, name="oo_2") CALL cp_fm_struct_release(fm_struct_tmp) - CALL cp_fm_create(mat_tmp, matrix_struct=mos_old(2*ispin-1)%matrix%matrix_struct, name="tmp_mat") + CALL cp_fm_create(mat_tmp, matrix_struct=mos_old(2*ispin - 1)%matrix%matrix_struct, name="tmp_mat") ! get the complex overlap matrix ! x^T S x + y^T S y + i (-y^TS x+x^T S y) - CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, mos_old(2*ispin-1)%matrix, & + CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, mos_old(2*ispin - 1)%matrix, & mat_tmp, ncol=nmo) - CALL cp_gemm("T", "N", nmo, nmo, nao, 1.0_dp, mos_old(2*ispin-1)%matrix, mat_tmp, 0.0_dp, oo_1) + CALL cp_gemm("T", "N", nmo, nmo, nao, 1.0_dp, mos_old(2*ispin - 1)%matrix, mat_tmp, 0.0_dp, oo_1) CALL cp_gemm("T", "N", nmo, nmo, nao, -1.0_dp, mos_old(2*ispin)%matrix, mat_tmp, 0.0_dp, oo_2) CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, mos_old(2*ispin)%matrix, & mat_tmp, ncol=nmo) CALL cp_gemm("T", "N", nmo, nmo, nao, 1.0_dp, mos_old(2*ispin)%matrix, mat_tmp, 1.0_dp, oo_1) - CALL cp_gemm("T", "N", nmo, nmo, nao, 1.0_dp, mos_old(2*ispin-1)%matrix, mat_tmp, 1.0_dp, oo_2) + CALL cp_gemm("T", "N", nmo, nmo, nao, 1.0_dp, mos_old(2*ispin - 1)%matrix, mat_tmp, 1.0_dp, oo_2) CALL cp_fm_release(mat_tmp) CALL cp_cfm_create(oo_c, oo_1%matrix_struct) @@ -235,11 +235,11 @@ SUBROUTINE apply_delta_pulse_periodic(qs_env, mos_old, mos_new) CALL cp_cfm_release(oo_vt) ! use this to compute the orthonormal vectors - CALL cp_gemm("N", "N", nao, nmo, nmo, 1.0_dp, mos_old(2*ispin-1)%matrix, oo_1, 0.0_dp, mos_new(2*ispin-1)%matrix) - CALL cp_gemm("N", "N", nao, nmo, nmo, 1.0_dp, mos_old(2*ispin-1)%matrix, oo_2, 0.0_dp, mos_new(2*ispin)%matrix) + CALL cp_gemm("N", "N", nao, nmo, nmo, 1.0_dp, mos_old(2*ispin - 1)%matrix, oo_1, 0.0_dp, mos_new(2*ispin - 1)%matrix) + CALL cp_gemm("N", "N", nao, nmo, nmo, 1.0_dp, mos_old(2*ispin - 1)%matrix, oo_2, 0.0_dp, mos_new(2*ispin)%matrix) - CALL cp_gemm("N", "N", nao, nmo, nmo, -1.0_dp, mos_old(2*ispin)%matrix, oo_2, 0.0_dp, mos_old(2*ispin-1)%matrix) - CALL cp_fm_scale_and_add(1.0_dp, mos_old(2*ispin-1)%matrix, 1.0_dp, mos_new(2*ispin-1)%matrix) + CALL cp_gemm("N", "N", nao, nmo, nmo, -1.0_dp, mos_old(2*ispin)%matrix, oo_2, 0.0_dp, mos_old(2*ispin - 1)%matrix) + CALL cp_fm_scale_and_add(1.0_dp, mos_old(2*ispin - 1)%matrix, 1.0_dp, mos_new(2*ispin - 1)%matrix) CALL cp_gemm("N", "N", nao, nmo, nmo, 1.0_dp, mos_old(2*ispin)%matrix, oo_1, 1.0_dp, mos_new(2*ispin)%matrix) CALL cp_fm_to_fm(mos_new(2*ispin)%matrix, mos_old(2*ispin)%matrix) @@ -322,8 +322,8 @@ SUBROUTINE apply_delta_pulse(qs_env, mos_old, mos_new) CALL get_qs_env(qs_env, cell=cell) ! direction ... unscaled, this will yield a exp(ikr) that is periodic with the cell - kvec(:) = cell%h_inv(1, :)*dft_control%rtp_control%delta_pulse_direction(1)+ & - cell%h_inv(2, :)*dft_control%rtp_control%delta_pulse_direction(2)+ & + kvec(:) = cell%h_inv(1, :)*dft_control%rtp_control%delta_pulse_direction(1) + & + cell%h_inv(2, :)*dft_control%rtp_control%delta_pulse_direction(2) + & cell%h_inv(3, :)*dft_control%rtp_control%delta_pulse_direction(3) kvec = -kvec*twopi ! scaling will make the things not periodic with the cell, which would only be good for gas phase systems ? @@ -337,10 +337,10 @@ SUBROUTINE apply_delta_pulse(qs_env, mos_old, mos_new) ! apply inv(S)*operator to C DO i = 1, SIZE(mos) CALL get_mo_set(mos(i)%mo_set, nao=nao, nmo=nmo) - CALL cp_dbcsr_sm_fm_multiply(cosmat, mos(i)%mo_set%mo_coeff, mos_new(2*i-1)%matrix, ncol=nmo) + CALL cp_dbcsr_sm_fm_multiply(cosmat, mos(i)%mo_set%mo_coeff, mos_new(2*i - 1)%matrix, ncol=nmo) CALL cp_dbcsr_sm_fm_multiply(sinmat, mos(i)%mo_set%mo_coeff, mos_new(2*i)%matrix, ncol=nmo) - CALL cp_gemm("N", "N", nao, nmo, nao, 1.0_dp, S_inv_fm, mos_new(2*i-1)%matrix, 0.0_dp, mos_old(2*i-1)%matrix) + CALL cp_gemm("N", "N", nao, nmo, nao, 1.0_dp, S_inv_fm, mos_new(2*i - 1)%matrix, 0.0_dp, mos_old(2*i - 1)%matrix) CALL cp_gemm("N", "N", nao, nmo, nao, 1.0_dp, S_inv_fm, mos_new(2*i)%matrix, 0.0_dp, mos_old(2*i)%matrix) ! in a finite basis, unfortunately, inv(S)*operator is not unitary, so orthonormalize afterwards @@ -350,16 +350,16 @@ SUBROUTINE apply_delta_pulse(qs_env, mos_old, mos_new) CALL cp_fm_create(oo_2, matrix_struct=fm_struct_tmp, name="oo_2") CALL cp_fm_struct_release(fm_struct_tmp) - CALL cp_fm_create(tmp, matrix_struct=mos_old(2*i-1)%matrix%matrix_struct, name="tmp_mat") + CALL cp_fm_create(tmp, matrix_struct=mos_old(2*i - 1)%matrix%matrix_struct, name="tmp_mat") ! get the complex overlap matrix ! x^T S x + y^T S y + i (-y^TS x+x^T S y) - CALL cp_gemm("N", "N", nao, nmo, nao, 1.0_dp, mat_S, mos_old(2*i-1)%matrix, 0.0_dp, tmp) - CALL cp_gemm("T", "N", nmo, nmo, nao, 1.0_dp, mos_old(2*i-1)%matrix, tmp, 0.0_dp, oo_1) + CALL cp_gemm("N", "N", nao, nmo, nao, 1.0_dp, mat_S, mos_old(2*i - 1)%matrix, 0.0_dp, tmp) + CALL cp_gemm("T", "N", nmo, nmo, nao, 1.0_dp, mos_old(2*i - 1)%matrix, tmp, 0.0_dp, oo_1) CALL cp_gemm("T", "N", nmo, nmo, nao, -1.0_dp, mos_old(2*i)%matrix, tmp, 0.0_dp, oo_2) CALL cp_gemm("N", "N", nao, nmo, nao, 1.0_dp, mat_S, mos_old(2*i)%matrix, 0.0_dp, tmp) CALL cp_gemm("T", "N", nmo, nmo, nao, 1.0_dp, mos_old(2*i)%matrix, tmp, 1.0_dp, oo_1) - CALL cp_gemm("T", "N", nmo, nmo, nao, 1.0_dp, mos_old(2*i-1)%matrix, tmp, 1.0_dp, oo_2) + CALL cp_gemm("T", "N", nmo, nmo, nao, 1.0_dp, mos_old(2*i - 1)%matrix, tmp, 1.0_dp, oo_2) CALL cp_fm_release(tmp) CALL cp_cfm_create(oo_c, oo_1%matrix_struct) @@ -385,11 +385,11 @@ SUBROUTINE apply_delta_pulse(qs_env, mos_old, mos_new) CALL cp_cfm_release(oo_vt) ! use this to compute the orthonormal vectors - CALL cp_gemm("N", "N", nao, nmo, nmo, 1.0_dp, mos_old(2*i-1)%matrix, oo_1, 0.0_dp, mos_new(2*i-1)%matrix) - CALL cp_gemm("N", "N", nao, nmo, nmo, 1.0_dp, mos_old(2*i-1)%matrix, oo_2, 0.0_dp, mos_new(2*i)%matrix) + CALL cp_gemm("N", "N", nao, nmo, nmo, 1.0_dp, mos_old(2*i - 1)%matrix, oo_1, 0.0_dp, mos_new(2*i - 1)%matrix) + CALL cp_gemm("N", "N", nao, nmo, nmo, 1.0_dp, mos_old(2*i - 1)%matrix, oo_2, 0.0_dp, mos_new(2*i)%matrix) - CALL cp_gemm("N", "N", nao, nmo, nmo, -1.0_dp, mos_old(2*i)%matrix, oo_2, 0.0_dp, mos_old(2*i-1)%matrix) - CALL cp_fm_scale_and_add(1.0_dp, mos_old(2*i-1)%matrix, 1.0_dp, mos_new(2*i-1)%matrix) + CALL cp_gemm("N", "N", nao, nmo, nmo, -1.0_dp, mos_old(2*i)%matrix, oo_2, 0.0_dp, mos_old(2*i - 1)%matrix) + CALL cp_fm_scale_and_add(1.0_dp, mos_old(2*i - 1)%matrix, 1.0_dp, mos_new(2*i - 1)%matrix) CALL cp_gemm("N", "N", nao, nmo, nmo, 1.0_dp, mos_old(2*i)%matrix, oo_1, 1.0_dp, mos_new(2*i)%matrix) CALL cp_fm_to_fm(mos_new(2*i)%matrix, mos_old(2*i)%matrix) diff --git a/src/emd/rt_make_propagators.F b/src/emd/rt_make_propagators.F index a1079a3f2d..dc3632997a 100644 --- a/src/emd/rt_make_propagators.F +++ b/src/emd/rt_make_propagators.F @@ -87,7 +87,7 @@ SUBROUTINE propagate_exp(rtp, rtp_control) CALL compute_exponential(exp_H_new, propagator_matrix, rtp_control, rtp) DO i = 1, SIZE(mos_new)/2 - re = 2*i-1 + re = 2*i - 1 im = 2*i CALL cp_fm_get_info(mos_new(re)%matrix, ncol_global=nmo) @@ -160,7 +160,7 @@ SUBROUTINE propagate_exp_density(rtp, rtp_control) CALL dbcsr_create(tmp_im, template=propagator_matrix(1)%matrix, matrix_type="N") DO i = 1, SIZE(exp_H_new)/2 - re = 2*i-1 + re = 2*i - 1 im = 2*i !Save some work by computing the first half of the propagation only once in case of ETRS !For EM this matrix has to be the initial matrix, thus a copy is enough @@ -234,7 +234,7 @@ SUBROUTINE propagate_arnoldi(rtp, rtp_control) END DO DO ispin = 1, nspin - re = ispin*2-1 + re = ispin*2 - 1 im = ispin*2 IF (rtp_control%fixed_ions .AND. .NOT. rtp%do_hfx) THEN CALL arnoldi(mos_old(re:im), mos_new(re:im), & @@ -284,7 +284,7 @@ SUBROUTINE propagate_bch(rtp, rtp_control) rho_next=rho_next) DO ispin = 1, SIZE(propagator_matrix)/2 - re = 2*ispin-1 + re = 2*ispin - 1 im = 2*ispin IF (rtp%iter == 1) THEN @@ -363,7 +363,7 @@ SUBROUTINE compute_exponential(propagator, propagator_matrix, rtp_control, rtp) END DO DO ispin = 1, SIZE(propagator)/2 - re = 2*ispin-1 + re = 2*ispin - 1 im = 2*ispin SELECT CASE (rtp_control%mat_exp) @@ -418,7 +418,7 @@ SUBROUTINE compute_exponential_sparse(propagator, propagator_matrix, rtp_control CALL timeset(routineN, handle) DO ispin = 1, SIZE(propagator)/2 - re = 2*ispin-1 + re = 2*ispin - 1 im = 2*ispin IF (rtp_control%fixed_ions .AND. .NOT. rtp%do_hfx) THEN CALL taylor_only_imaginary_dbcsr(propagator(re:im), propagator_matrix(im)%matrix, & diff --git a/src/emd/rt_propagation_methods.F b/src/emd/rt_propagation_methods.F index 68081be1b2..1048c5093d 100644 --- a/src/emd/rt_propagation_methods.F +++ b/src/emd/rt_propagation_methods.F @@ -186,18 +186,18 @@ SUBROUTINE propagation_step(qs_env, rtp, rtp_control) CALL dbcsr_create(ks_mix_im(i)%matrix, template=matrix_ks(1)%matrix) ENDDO DO i = 1, SIZE(matrix_ks) - re = 2*i-1 + re = 2*i - 1 im = 2*i CALL dbcsr_add(ks_mix(i)%matrix, matrix_ks(i)%matrix, 0.0_dp, rtp%mixing_factor) - CALL dbcsr_add(ks_mix(i)%matrix, H_last_iter(re)%matrix, 1.0_dp, 1.0_dp-rtp%mixing_factor) + CALL dbcsr_add(ks_mix(i)%matrix, H_last_iter(re)%matrix, 1.0_dp, 1.0_dp - rtp%mixing_factor) IF (rtp%do_hfx) THEN CALL dbcsr_add(ks_mix_im(i)%matrix, matrix_ks_im(i)%matrix, 0.0_dp, rtp%mixing_factor) - CALL dbcsr_add(ks_mix_im(i)%matrix, H_last_iter(im)%matrix, 1.0_dp, 1.0_dp-rtp%mixing_factor) + CALL dbcsr_add(ks_mix_im(i)%matrix, H_last_iter(im)%matrix, 1.0_dp, 1.0_dp - rtp%mixing_factor) ENDIF ENDDO CALL calc_SinvH(rtp, ks_mix, ks_mix_im, rtp_control) DO i = 1, SIZE(matrix_ks) - re = 2*i-1 + re = 2*i - 1 im = 2*i CALL dbcsr_copy(H_last_iter(re)%matrix, ks_mix(i)%matrix) IF (rtp%do_hfx) THEN @@ -209,7 +209,7 @@ SUBROUTINE propagation_step(qs_env, rtp, rtp_control) ELSE CALL calc_SinvH(rtp, matrix_ks, matrix_ks_im, rtp_control) DO i = 1, SIZE(matrix_ks) - re = 2*i-1 + re = 2*i - 1 im = 2*i CALL dbcsr_copy(H_last_iter(re)%matrix, matrix_ks(i)%matrix) IF (rtp%do_hfx) THEN @@ -291,7 +291,7 @@ SUBROUTINE step_finalize(qs_env, rtp_control, delta_mos, delta_P) !It would be better to redo the current step with mixixng, !but currently the decision is made to use mixing from the next step on - IF (rtp_control%sc_check_start .LT. rtp%iter+1) THEN + IF (rtp_control%sc_check_start .LT. rtp%iter + 1) THEN IF (rtp%delta_iter/rtp%delta_iter_old > 0.9) THEN rtp%mixing_factor = MAX(rtp%mixing_factor/2.0_dp, 0.125_dp) rtp%mixing = .TRUE. @@ -319,7 +319,7 @@ SUBROUTINE step_finalize(qs_env, rtp_control, delta_mos, delta_P) DO i = 1, SIZE(exp_H_new) CALL dbcsr_copy(exp_H_old(i)%matrix, exp_H_new(i)%matrix) END DO - ihist = MOD(rtp%istep, rtp_control%aspc_order)+1 + ihist = MOD(rtp%istep, rtp_control%aspc_order) + 1 IF (rtp_control%fixed_ions) THEN CALL put_data_to_history(rtp, rho=rho_new, mos=mos_new, ihist=ihist) ELSE @@ -394,7 +394,7 @@ SUBROUTINE calc_SinvH(rtp, matrix_ks, matrix_ks_im, rtp_control) CALL get_rtp(rtp=rtp, S_inv=S_inv, S_minus_half=S_minus_half, exp_H_new=exp_H, dt=t) CALL dbcsr_create(matrix_ks_nosym, template=matrix_ks(1)%matrix, matrix_type="N") DO ispin = 1, SIZE(matrix_ks) - re = ispin*2-1 + re = ispin*2 - 1 im = ispin*2 CALL dbcsr_desymmetrize(matrix_ks(ispin)%matrix, matrix_ks_nosym) CALL dbcsr_multiply("N", "N", one, S_inv, matrix_ks_nosym, zero, exp_H(im)%matrix, & @@ -408,7 +408,7 @@ SUBROUTINE calc_SinvH(rtp, matrix_ks, matrix_ks_im, rtp_control) CALL get_rtp(rtp=rtp, B_mat=B_mat, SinvB=SinvB) IF (rtp%do_hfx) THEN DO ispin = 1, SIZE(matrix_ks) - re = ispin*2-1 + re = ispin*2 - 1 im = ispin*2 CALL dbcsr_set(matrix_ks_nosym, 0.0_dp) CALL dbcsr_desymmetrize(matrix_ks_im(ispin)%matrix, matrix_ks_nosym) @@ -435,7 +435,7 @@ SUBROUTINE calc_SinvH(rtp, matrix_ks, matrix_ks_im, rtp_control) ELSE !set real part to zero DO ispin = 1, SIZE(exp_H)/2 - re = ispin*2-1 + re = ispin*2 - 1 im = ispin*2 CALL dbcsr_set(exp_H(re)%matrix, zero) ENDDO @@ -527,7 +527,7 @@ SUBROUTINE complex_frobenius_norm(frob_norm, mat_re, mat_im) ENDIF CALL dbcsr_get_block_p(mat_im, row_atom, col_atom, block_values2, found=found) IF (found) THEN - block_values = block_values+block_values2*block_values2 + block_values = block_values + block_values2*block_values2 ENDIF block_values = SQRT(block_values) END DO @@ -593,7 +593,7 @@ SUBROUTINE purify_mcweeny_complex_nonorth(P, s_mat, eps, eps_small, max_iter, th CALL dbcsr_scale(P(2)%matrix, one/2) ENDIF DO ispin = 1, SIZE(P)/2 - re = 2*ispin-1 + re = 2*ispin - 1 im = 2*ispin imax = MAX(max_iter, 1) !if max_iter is 0 then only the deviation from idempotency needs to be calculated DO i = 1, imax @@ -690,9 +690,9 @@ SUBROUTINE aspc_extrapolate(rtp, matrix_s, aspc_order) rho_hist => rtp%history%rho_history DO imat = 1, nmat DO iaspc = 1, naspc - alpha = (-1.0_dp)**(iaspc+1)*REAL(iaspc, KIND=dp)* & - binomial(2*naspc, naspc-iaspc)/binomial(2*naspc-2, naspc-1) - ihist = MOD(rtp%istep-iaspc, aspc_order)+1 + alpha = (-1.0_dp)**(iaspc + 1)*REAL(iaspc, KIND=dp)* & + binomial(2*naspc, naspc - iaspc)/binomial(2*naspc - 2, naspc - 1) + ihist = MOD(rtp%istep - iaspc, aspc_order) + 1 IF (iaspc == 1) THEN CALL dbcsr_add(rho_new(imat)%matrix, rho_hist(imat, ihist)%matrix, zero, alpha) ELSE @@ -705,9 +705,9 @@ SUBROUTINE aspc_extrapolate(rtp, matrix_s, aspc_order) nmat = SIZE(mos_new) DO imat = 1, nmat DO iaspc = 1, naspc - alpha = (-1.0_dp)**(iaspc+1)*REAL(iaspc, KIND=dp)* & - binomial(2*naspc, naspc-iaspc)/binomial(2*naspc-2, naspc-1) - ihist = MOD(rtp%istep-iaspc, aspc_order)+1 + alpha = (-1.0_dp)**(iaspc + 1)*REAL(iaspc, KIND=dp)* & + binomial(2*naspc, naspc - iaspc)/binomial(2*naspc - 2, naspc - 1) + ihist = MOD(rtp%istep - iaspc, aspc_order) + 1 IF (iaspc == 1) THEN CALL cp_fm_scale_and_add(zero, mos_new(imat)%matrix, alpha, mo_hist(imat, ihist)%matrix) ELSE @@ -754,23 +754,23 @@ SUBROUTINE aspc_extrapolate(rtp, matrix_s, aspc_order) ! reorthogonalize vectors DO icol_local = 1, ncol_local - fm_tmp%local_data(:, icol_local) = mos_new(2*i-1)%matrix%local_data(:, icol_local) - fm_tmp%local_data(:, icol_local+ncol_local) = mos_new(2*i)%matrix%local_data(:, icol_local) + fm_tmp%local_data(:, icol_local) = mos_new(2*i - 1)%matrix%local_data(:, icol_local) + fm_tmp%local_data(:, icol_local + ncol_local) = mos_new(2*i)%matrix%local_data(:, icol_local) END DO CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, fm_tmp, fm_tmp1, kdbl) DO icol_local = 1, ncol_local cfm_tmp%local_data(:, icol_local) = CMPLX(fm_tmp1%local_data(:, icol_local), & - fm_tmp1%local_data(:, icol_local+ncol_local), dp) - cfm_tmp1%local_data(:, icol_local) = CMPLX(mos_new(2*i-1)%matrix%local_data(:, icol_local), & + fm_tmp1%local_data(:, icol_local + ncol_local), dp) + cfm_tmp1%local_data(:, icol_local) = CMPLX(mos_new(2*i - 1)%matrix%local_data(:, icol_local), & mos_new(2*i)%matrix%local_data(:, icol_local), dp) END DO CALL cp_cfm_gemm('C', 'N', k, k, n, cone, cfm_tmp1, cfm_tmp, czero, csc) CALL cp_cfm_cholesky_decompose(csc) CALL cp_cfm_triangular_multiply(csc, cfm_tmp1, n_cols=k, side='R', invert_tr=.TRUE.) DO icol_local = 1, ncol_local - mos_new(2*i-1)%matrix%local_data(:, icol_local) = REAL(cfm_tmp1%local_data(:, icol_local), dp) + mos_new(2*i - 1)%matrix%local_data(:, icol_local) = REAL(cfm_tmp1%local_data(:, icol_local), dp) mos_new(2*i)%matrix%local_data(:, icol_local) = AIMAG(cfm_tmp1%local_data(:, icol_local)) END DO diff --git a/src/emd/rt_propagation_output.F b/src/emd/rt_propagation_output.F index 849a9ad5f4..8139697182 100644 --- a/src/emd/rt_propagation_output.F +++ b/src/emd/rt_propagation_output.F @@ -142,7 +142,7 @@ SUBROUTINE rt_prop_output(qs_env, run_type, delta_iter, used_time) rtp_section => section_vals_get_subs_vals(input, "DFT%REAL_TIME_PROPAGATION") CALL get_qs_kind_set(qs_kind_set, nelectron=n_electrons) - n_electrons = n_electrons-dft_control%charge + n_electrons = n_electrons - dft_control%charge CALL qs_rho_get(rho_struct=rho, tot_rho_r=qs_tot_rho_r) @@ -157,16 +157,16 @@ SUBROUTINE rt_prop_output(qs_env, run_type, delta_iter, used_time) WRITE (UNIT=output_unit, FMT="((T3,A,T41,2F20.10))") & "Total electronic density (r-space): ", & tot_rho_r, & - tot_rho_r+ & + tot_rho_r + & REAL(n_electrons, dp) WRITE (UNIT=output_unit, FMT="((T3,A,T59,F22.14))") & "Total energy:", rtp%energy_new IF (run_type == ehrenfest) & WRITE (UNIT=output_unit, FMT="((T3,A,T61,F20.14))") & - "Energy difference to previous iteration step:", rtp%energy_new-rtp%energy_old + "Energy difference to previous iteration step:", rtp%energy_new - rtp%energy_old IF (run_type == real_time_propagation) & WRITE (UNIT=output_unit, FMT="((T3,A,T61,F20.14))") & - "Energy difference to initial state:", rtp%energy_new-rtp%energy_old + "Energy difference to initial state:", rtp%energy_new - rtp%energy_old IF (PRESENT(delta_iter)) & WRITE (UNIT=output_unit, FMT="((T3,A,T61,E20.6))") & "Convergence:", delta_iter @@ -175,7 +175,7 @@ SUBROUTINE rt_prop_output(qs_env, run_type, delta_iter, used_time) WRITE (UNIT=output_unit, FMT="((T3,A,T61,F12.2))") & "Time needed for propagation:", used_time WRITE (UNIT=output_unit, FMT="(/,(T3,A,3X,F16.14))") & - "CONVERGENCE REACHED", rtp%energy_new-rtp%energy_old + "CONVERGENCE REACHED", rtp%energy_new - rtp%energy_old END IF END IF @@ -282,7 +282,7 @@ SUBROUTINE rt_calculate_orthonormality(orthonormality, mos_new, matrix_s) max_alpha = 0.0_dp max_beta = 0.0_dp DO ispin = 1, nspin - re = ispin*2-1 + re = ispin*2 - 1 im = ispin*2 ! get S*C CALL cp_fm_create(svec_re, mos_new(im)%matrix%matrix_struct) @@ -315,7 +315,7 @@ SUBROUTINE rt_calculate_orthonormality(orthonormality, mos_new, matrix_s) DO i = 1, nrow_local DO j = 1, ncol_local alpha = overlap_re%local_data(i, j) - IF (row_indices(i) .EQ. col_indices(j)) alpha = alpha-1.0_dp + IF (row_indices(i) .EQ. col_indices(j)) alpha = alpha - 1.0_dp max_alpha = MAX(max_alpha, ABS(alpha)) ENDDO ENDDO @@ -370,7 +370,7 @@ SUBROUTINE rt_convergence(rtp, matrix_s, delta_mos, delta_eps) END DO DO ispin = 1, nspin - re = ispin*2-1 + re = ispin*2 - 1 im = ispin*2 double_col = .TRUE. @@ -392,7 +392,7 @@ SUBROUTINE rt_convergence(rtp, matrix_s, delta_mos, delta_eps) DO icol = 1, lcol work%local_data(:, icol) = delta_mos(re)%matrix%local_data(:, icol) - work%local_data(:, icol+lcol) = delta_mos(im)%matrix%local_data(:, icol) + work%local_data(:, icol + lcol) = delta_mos(im)%matrix%local_data(:, icol) END DO CALL cp_dbcsr_sm_fm_multiply(matrix_s, work, work1, ncol=newdim) @@ -420,8 +420,8 @@ SUBROUTINE rt_convergence(rtp, matrix_s, delta_mos, delta_eps) CALL cp_fm_get_info(work, nrow_local=lrow) DO i = 1, lrow DO j = 1, lcol - alpha = SQRT((work%local_data(i, j)+work2%local_data(i, j+lcol))**2+ & - (work%local_data(i, j+lcol)-work2%local_data(i, j))**2) + alpha = SQRT((work%local_data(i, j) + work2%local_data(i, j + lcol))**2 + & + (work%local_data(i, j + lcol) - work2%local_data(i, j))**2) max_alpha = MAX(max_alpha, ABS(alpha)) ENDDO ENDDO @@ -489,7 +489,7 @@ SUBROUTINE rt_convergence_density(rtp, delta_P, delta_eps) ALLOCATE (tmp) CALL dbcsr_create(tmp, template=delta_P(1)%matrix, matrix_type="N") DO ispin = 1, SIZE(delta_P)/2 - CALL dbcsr_desymmetrize(delta_P(2*ispin-1)%matrix, tmp) + CALL dbcsr_desymmetrize(delta_P(2*ispin - 1)%matrix, tmp) CALL dbcsr_add(delta_P(2*ispin)%matrix, tmp, one, one) END DO !the absolute values are now in the even entries of delta_P @@ -577,7 +577,7 @@ SUBROUTINE report_density_occupation(filter_eps, rho) CALL dbcsr_copy(tmp(i)%matrix, rho(i)%matrix) ENDDO DO ispin = 1, SIZE(rho)/2 - re = 2*ispin-1 + re = 2*ispin - 1 im = 2*ispin eps = MAX(filter_eps, 10E-12_dp) DO WHILE (eps < 1.1_dp) @@ -631,7 +631,7 @@ SUBROUTINE write_rt_p_to_restart(rho_new, history) project_name = logger%iter_info%project_name DO ispin = 1, SIZE(rho_new)/2 - re = 2*ispin-1 + re = 2*ispin - 1 im = 2*ispin IF (history) THEN WRITE (file_name, '(A,I0,A)') & diff --git a/src/emd/rt_propagation_utils.F b/src/emd/rt_propagation_utils.F index 4f3d8f4991..96411f2b98 100644 --- a/src/emd/rt_propagation_utils.F +++ b/src/emd/rt_propagation_utils.F @@ -144,7 +144,7 @@ SUBROUTINE calc_S_derivs(qs_env) ALLOCATE (tmp_mat2) CALL dbcsr_create(tmp_mat2, template=S_der(1)%matrix, matrix_type="S") DO m = 1, 9 - CALL dbcsr_copy(tmp_mat2, s_derivs(m+1)%matrix) + CALL dbcsr_copy(tmp_mat2, s_derivs(m + 1)%matrix) CALL dbcsr_desymmetrize(tmp_mat2, S_der(m)%matrix) CALL dbcsr_scale(S_der(m)%matrix, -one) CALL dbcsr_filter(S_der(m)%matrix, rtp%filter_eps) @@ -181,7 +181,7 @@ SUBROUTINE calc_S_derivs(qs_env) n = 0 DO j = 1, 3 DO m = j, 3 - n = n+1 + n = n + 1 c_map_mat(n, 1) = j IF (m == j) CYCLE c_map_mat(n, 2) = m @@ -192,7 +192,7 @@ SUBROUTINE calc_S_derivs(qs_env) CALL dbcsr_set(C_mat(i)%matrix, zero) END DO DO m = 1, 6 - CALL dbcsr_copy(tmp_mat, S_der(m+3)%matrix) + CALL dbcsr_copy(tmp_mat, S_der(m + 3)%matrix) DO j = 1, 2 IF (c_map_mat(m, j) == 0) CYCLE CALL dbcsr_add(C_mat(c_map_mat(m, j))%matrix, tmp_mat, one, one) @@ -276,7 +276,7 @@ SUBROUTINE get_restart_wfn(qs_env) IF (rtp%linear_scaling) THEN CALL get_rtp(rtp=rtp, rho_old=rho_old, rho_new=rho_new) DO ispin = 1, nspin - re = 2*ispin-1 + re = 2*ispin - 1 im = 2*ispin CALL cp_fm_get_info(mo_array(ispin)%mo_set%mo_coeff, ncol_global=ncol) alpha = 1.0_dp @@ -293,7 +293,7 @@ SUBROUTINE get_restart_wfn(qs_env) ELSE CALL get_rtp(rtp=rtp, mos_old=mos_old) DO i = 1, SIZE(qs_env%mos) - CALL cp_fm_to_fm(mo_array(i)%mo_set%mo_coeff, mos_old(2*i-1)%matrix) + CALL cp_fm_to_fm(mo_array(i)%mo_set%mo_coeff, mos_old(2*i - 1)%matrix) CALL cp_fm_set_all(mos_old(2*i)%matrix, zero, zero) END DO ENDIF @@ -302,7 +302,7 @@ SUBROUTINE get_restart_wfn(qs_env) CALL get_rtp(rtp=rtp, rho_old=rho_old, rho_new=rho_new) project_name = logger%iter_info%project_name DO ispin = 1, nspin - re = 2*ispin-1 + re = 2*ispin - 1 im = 2*ispin WRITE (file_name, '(A,I0,A)') TRIM(project_name)//"_LS_DM_SPIN_RE", ispin, "_RESTART.dm" CALL dbcsr_get_info(rho_old(re)%matrix, distribution=dist) @@ -372,8 +372,8 @@ SUBROUTINE calc_update_rho(qs_env) CALL get_rtp(rtp=rtp, mos_new=mos_new) CALL qs_rho_get(rho_struct=rho, rho_ao=rho_ao) DO i = 1, SIZE(mos_new)/2 - re = 2*i-1; im = 2*i - alpha = 3*one-REAL(SIZE(mos_new)/2, dp) + re = 2*i - 1; im = 2*i + alpha = 3*one - REAL(SIZE(mos_new)/2, dp) CALL dbcsr_set(rho_ao(i)%matrix, zero) CALL cp_fm_get_info(mos_new(re)%matrix, ncol_global=ncol) CALL cp_fm_create(mos_occ%matrix, & @@ -443,7 +443,7 @@ SUBROUTINE calc_update_rho_sparse(qs_env) IF (rtp%do_hfx .OR. rtp%magnetic) CALL qs_rho_get(rho_struct=rho, rho_ao_im=rho_ao_im) DO ispin = 1, SIZE(rho_ao) CALL dbcsr_set(rho_ao(ispin)%matrix, zero) - CALL dbcsr_copy_into_existing(rho_ao(ispin)%matrix, rho_new(ispin*2-1)%matrix) + CALL dbcsr_copy_into_existing(rho_ao(ispin)%matrix, rho_new(ispin*2 - 1)%matrix) IF (rtp%do_hfx .OR. rtp%magnetic) CALL dbcsr_copy_into_existing(rho_ao_im(ispin)%matrix, rho_new(ispin*2)%matrix) END DO @@ -484,8 +484,8 @@ SUBROUTINE calculate_P_imaginary(qs_env, rtp, matrix_p_im, keep_sparsity) ALLOCATE (mos_occ(SIZE(mos)*2)) DO i = 1, SIZE(mos_new)/2 - re = 2*i-1; im = 2*i - alpha = 3.0_dp-REAL(SIZE(matrix_p_im), dp) + re = 2*i - 1; im = 2*i + alpha = 3.0_dp - REAL(SIZE(matrix_p_im), dp) CALL cp_fm_create(mos_occ(re)%matrix, & matrix_struct=mos(i)%mo_set%mo_coeff%matrix_struct, & name="mos_occ") diff --git a/src/emd/rt_propagator_init.F b/src/emd/rt_propagator_init.F index 427f58cc65..0f94198668 100644 --- a/src/emd/rt_propagator_init.F +++ b/src/emd/rt_propagator_init.F @@ -431,8 +431,8 @@ SUBROUTINE rt_initialize_rho_from_mos(rtp, mos) CALL get_rtp(rtp=rtp, rho_old=rho_old, rho_new=rho_new) DO ispin = 1, SIZE(mos) - re = 2*ispin-1 - alpha = 3.0_dp-REAL(SIZE(mos), dp) + re = 2*ispin - 1 + alpha = 3.0_dp - REAL(SIZE(mos), dp) CALL dbcsr_set(rho_old(re)%matrix, 0.0_dp) CALL cp_fm_get_info(mos(ispin)%mo_set%mo_coeff, ncol_global=ncol) CALL cp_fm_column_scale(mos(ispin)%mo_set%mo_coeff, mos(ispin)%mo_set%occupation_numbers/alpha) diff --git a/src/environment.F b/src/environment.F index 581e33dd18..e7655663f6 100644 --- a/src/environment.F +++ b/src/environment.F @@ -245,12 +245,12 @@ SUBROUTINE echo_all_hosts(para_env, output_unit) ALLOCATE (all_pid(para_env%num_pe)) all_pid(:) = 0 - all_pid(para_env%mepos+1) = r_pid + all_pid(para_env%mepos + 1) = r_pid CALL mp_sum(all_pid, para_env%group) ALLOCATE (all_host(30, para_env%num_pe)) all_host(:, :) = 0 - CALL string_to_ascii(r_host_name, all_host(:, para_env%mepos+1)) + CALL string_to_ascii(r_host_name, all_host(:, para_env%mepos + 1)) CALL mp_sum(all_host, para_env%group) IF (output_unit > 0) THEN @@ -259,7 +259,7 @@ SUBROUTINE echo_all_hosts(para_env, output_unit) CALL ascii_to_string(all_host(:, ipe), string) WRITE (UNIT=output_unit, FMT="(T2,A,T63,I8,T71,I10)") & TRIM(r_user_name)//"@"//TRIM(string)// & - " has created rank and process ", ipe-1, all_pid(ipe) + " has created rank and process ", ipe - 1, all_pid(ipe) END DO WRITE (UNIT=output_unit, FMT="(T2,A)") "" END IF @@ -289,7 +289,7 @@ SUBROUTINE echo_all_process_host(para_env, output_unit) all_host(:, :) = 0 IF (m_procrun(r_pid) .EQ. 1) THEN - CALL string_to_ascii(r_host_name, all_host(:, para_env%mepos+1)) + CALL string_to_ascii(r_host_name, all_host(:, para_env%mepos + 1)) CALL mp_sum(all_host, para_env%group) ENDIF @@ -305,7 +305,7 @@ SUBROUTINE echo_all_process_host(para_env, output_unit) DO jpe = 1, para_env%num_pe CALL ascii_to_string(all_host(:, jpe), string_sec) IF (string .EQ. string_sec) THEN - nr_occu = nr_occu+1 + nr_occu = nr_occu + 1 all_pid(jpe) = -1 ENDIF END DO @@ -1092,7 +1092,7 @@ SUBROUTINE cp2k_get_walltime(section, keyword_name, walltime) READ (txt(1:n), FMT="(I2,A1,I2,A1,I2)", IOSTAT=ierr) hours, c1, minutes, c2, seconds IF (n /= 8 .OR. ierr /= 0 .OR. c1 .NE. ":" .OR. c2 .NE. ":") & CPABORT('Could not parse WALLTIME: "'//txt(1:n)//'"') - walltime = 3600.0_dp*REAL(hours, dp)+60.0_dp*REAL(minutes, dp)+REAL(seconds, dp) + walltime = 3600.0_dp*REAL(hours, dp) + 60.0_dp*REAL(minutes, dp) + REAL(seconds, dp) END IF END SUBROUTINE cp2k_get_walltime diff --git a/src/eri_mme/eri_mme_error_control.F b/src/eri_mme/eri_mme_error_control.F index 6dbf010299..07466b3d07 100644 --- a/src/eri_mme/eri_mme_error_control.F +++ b/src/eri_mme/eri_mme_error_control.F @@ -94,7 +94,7 @@ SUBROUTINE calibrate_cutoff(hmat, h_inv, G_min, vol, zet_min, l_mm, zet_max, l_m max_iter = 100 - IF ((cutoff_r-cutoff_l)/(0.5_dp*(cutoff_r+cutoff_l)) .LE. tol) & + IF ((cutoff_r - cutoff_l)/(0.5_dp*(cutoff_r + cutoff_l)) .LE. tol) & CALL cp_abort(__LOCATION__, "difference of boundaries for cutoff "// & "(MAX - MIN) must be greater than cutoff precision.") @@ -114,7 +114,7 @@ SUBROUTINE calibrate_cutoff(hmat, h_inv, G_min, vol, zet_min, l_mm, zet_max, l_m ENDIF ! 1) find valid initial values for bisection - DO iter1 = 1, max_iter+1 + DO iter1 = 1, max_iter + 1 IF (iter1 .GT. max_iter) & CALL cp_abort(__LOCATION__, & "Maximum number of iterations in bisection to determine initial "// & @@ -129,12 +129,12 @@ SUBROUTINE calibrate_cutoff(hmat, h_inv, G_min, vol, zet_min, l_mm, zet_max, l_m ENDDO valid_initial = .TRUE. - IF ((delta_mm(1)-delta_c(1)) .GT. 0) THEN - cutoff_lr(1) = cutoff_lr(1)*(1.0_dp-ABS(delta)) + IF ((delta_mm(1) - delta_c(1)) .GT. 0) THEN + cutoff_lr(1) = cutoff_lr(1)*(1.0_dp - ABS(delta)) valid_initial = .FALSE. ENDIF - IF ((delta_mm(2)-delta_c(2)) .LT. 0) THEN - cutoff_lr(2) = cutoff_lr(2)*(1.0_dp+ABS(delta)) + IF ((delta_mm(2) - delta_c(2)) .LT. 0) THEN + cutoff_lr(2) = cutoff_lr(2)*(1.0_dp + ABS(delta)) valid_initial = .FALSE. ENDIF @@ -145,20 +145,20 @@ SUBROUTINE calibrate_cutoff(hmat, h_inv, G_min, vol, zet_min, l_mm, zet_max, l_m IF (do_print) WRITE (unit_nr, '(/T2, A)') & "ERI_MME| Step, cutoff (min, max, mid), err(minimax), err(cutoff), err diff" - DO iter2 = 1, max_iter+1 + DO iter2 = 1, max_iter + 1 IF (iter2 .GT. max_iter) & CALL cp_abort(__LOCATION__, & "Maximum number of iterations in bisection to determine cutoff has been exceeded") - cutoff_mid = 0.5_dp*(cutoff_lr(1)+cutoff_lr(2)) + cutoff_mid = 0.5_dp*(cutoff_lr(1) + cutoff_lr(2)) CALL cutoff_minimax_error(cutoff_mid, hmat, h_inv, vol, G_min, zet_min, l_mm, zet_max, l_max_zet, & n_minimax, minimax_aw, delta_mm_mid, delta_c_mid, C_mm, para_env) IF (do_print) WRITE (unit_nr, '(T11, I2, F11.1, F11.1, F11.1, 3X, ES9.2, 3X, ES9.2, 3X, ES9.2)') & iter2, cutoff_lr(1), cutoff_lr(2), cutoff_mid, & - delta_mm_mid, delta_c_mid, delta_mm_mid-delta_c_mid + delta_mm_mid, delta_c_mid, delta_mm_mid - delta_c_mid - IF ((cutoff_lr(2)-cutoff_lr(1))/cutoff_mid .LT. tol) EXIT - IF (delta_mm_mid-delta_c_mid .GT. 0) THEN + IF ((cutoff_lr(2) - cutoff_lr(1))/cutoff_mid .LT. tol) EXIT + IF (delta_mm_mid - delta_c_mid .GT. 0) THEN cutoff_lr(2) = cutoff_mid delta_mm(2) = delta_mm_mid delta_c(2) = delta_c_mid @@ -174,8 +174,8 @@ SUBROUTINE calibrate_cutoff(hmat, h_inv, G_min, vol, zet_min, l_mm, zet_max, l_m IF (do_print) THEN WRITE (unit_nr, '(/T2, A)') "ERI_MME| Cutoff calibration number of steps:" - WRITE (unit_nr, '(T2, A, T79, I2)') "ERI_MME| Steps for initial interval", iter1-1 - WRITE (unit_nr, '(T2, A, T79, I2/)') "ERI_MME| Bisection iteration steps", iter2-1 + WRITE (unit_nr, '(T2, A, T79, I2)') "ERI_MME| Steps for initial interval", iter1 - 1 + WRITE (unit_nr, '(T2, A, T79, I2/)') "ERI_MME| Bisection iteration steps", iter2 - 1 ENDIF END SUBROUTINE calibrate_cutoff @@ -263,7 +263,7 @@ SUBROUTINE minimax_error(cutoff, hmat, vol, G_min, zet_min, l_mm, & prod_mm_k = 1.0_dp DO i_xyz = 1, 3 - prod_mm_k = prod_mm_k*(ABS(hmat(i_xyz, i_xyz))/twopi+ & + prod_mm_k = prod_mm_k*(ABS(hmat(i_xyz, i_xyz))/twopi + & MERGE(SQRT(2.0_dp/(zet_min*pi))*EXP(-1.0_dp), 0.0_dp, l_mm .GT. 0)) ENDDO err_mm = 32*pi**4/vol*delta_mm*prod_mm_k @@ -324,28 +324,28 @@ SUBROUTINE cutoff_error(cutoff, h_inv, G_min, zet_max, l_max_zet, & C_mm = 0.0_dp IF (G_1 .GT. G_c) THEN nG = 1000 - dG = (G_1-G_c)/nG + dG = (G_1 - G_c)/nG G = G_c DO iG = 1, nG G = MIN(G, G_c) C = 0.0_dp DO i_aw = 1, n_minimax - C = C+3.0_dp*minimax_aw(n_minimax+i_aw)*EXP(-3.0_dp*minimax_aw(i_aw)*G**2)*G**2 + C = C + 3.0_dp*minimax_aw(n_minimax + i_aw)*EXP(-3.0_dp*minimax_aw(i_aw)*G**2)*G**2 ENDDO C_mm = MAX(C, C_mm) - G = G+dG + G = G + dG ENDDO ELSE DO i_aw = 1, n_minimax - C_mm = C_mm+3.0_dp*minimax_aw(n_minimax+i_aw)*EXP(-3.0_dp*minimax_aw(i_aw)*G_c**2)*G_c**2 + C_mm = C_mm + 3.0_dp*minimax_aw(n_minimax + i_aw)*EXP(-3.0_dp*minimax_aw(i_aw)*G_c**2)*G_c**2 ENDDO ENDIF C = MAX(1.0_dp, C_mm) err_ctff_prev = 0.0_dp - gr = 0.5_dp*(SQRT(5.0_dp)-1.0_dp) ! golden ratio + gr = 0.5_dp*(SQRT(5.0_dp) - 1.0_dp) ! golden ratio ! Find valid starting values for golden section search - DO iter = 1, max_iter+1 + DO iter = 1, max_iter + 1 IF (iter .GT. max_iter) & CALL cp_abort(__LOCATION__, "Maximum number of iterations for finding "// & "exponent maximizing cutoff error has been exceeded.") @@ -362,10 +362,10 @@ SUBROUTINE cutoff_error(cutoff, h_inv, G_min, zet_max, l_max_zet, & ENDDO ! Golden section search - zet_c = zet_b-gr*(zet_b-zet_a) - zet_d = zet_a+gr*(zet_b-zet_a) - DO iter = 1, max_iter+1 - IF (ABS(zet_c-zet_d) .LT. eps_zet*(zet_a+zet_b)) THEN + zet_c = zet_b - gr*(zet_b - zet_a) + zet_d = zet_a + gr*(zet_b - zet_a) + DO iter = 1, max_iter + 1 + IF (ABS(zet_c - zet_d) .LT. eps_zet*(zet_a + zet_b)) THEN CALL cutoff_error_fixed_exp(cutoff, h_inv, G_min, l_max_zet, zet_a, C, err0, para_env) CALL cutoff_error_fixed_exp(cutoff, h_inv, G_min, l_max_zet, zet_b, C, err1, para_env) err_ctff_curr = MAX(err0, err1) @@ -376,11 +376,11 @@ SUBROUTINE cutoff_error(cutoff, h_inv, G_min, zet_max, l_max_zet, & IF (err_c .GT. err_d) THEN zet_b = zet_d zet_d = zet_c - zet_c = zet_b-gr*(zet_b-zet_a) + zet_c = zet_b - gr*(zet_b - zet_a) ELSE zet_a = zet_c zet_c = zet_d - zet_d = zet_a+gr*(zet_b-zet_a) + zet_d = zet_a + gr*(zet_b - zet_a) ENDIF ENDDO err_ctff = err_ctff_curr @@ -455,27 +455,27 @@ SUBROUTINE cutoff_error_fixed_exp(cutoff, h_inv, G_min, l_max_zet, zet_max, C_mm ! 2.0_dp/3.0_dp, prefactor) ! Parallel code: - n_Gu = MAX((G_u-G_l), 0) - n_Gl = 2*G_l+1 + n_Gu = MAX((G_u - G_l), 0) + n_Gl = 2*G_l + 1 n_Gu_p = n_Gu/n_p n_Gl_p = n_Gl/n_p n_Gu_left = MOD(n_Gu, n_p) n_Gl_left = MOD(n_Gl, n_p) IF (my_p .LT. n_Gu_left) THEN - Gu_first = G_l+1+(n_Gu_p+1)*my_p - Gu_last = G_l+1+(n_Gu_p+1)*(my_p+1)-1 + Gu_first = G_l + 1 + (n_Gu_p + 1)*my_p + Gu_last = G_l + 1 + (n_Gu_p + 1)*(my_p + 1) - 1 ELSE - Gu_first = G_l+1+n_Gu_left+n_Gu_p*my_p - Gu_last = G_l+1+n_Gu_left+n_Gu_p*(my_p+1)-1 + Gu_first = G_l + 1 + n_Gu_left + n_Gu_p*my_p + Gu_last = G_l + 1 + n_Gu_left + n_Gu_p*(my_p + 1) - 1 ENDIF IF (my_p .LT. n_Gl_left) THEN - Gl_first = -G_l+(n_Gl_p+1)*my_p - Gl_last = -G_l+(n_Gl_p+1)*(my_p+1)-1 + Gl_first = -G_l + (n_Gl_p + 1)*my_p + Gl_last = -G_l + (n_Gl_p + 1)*(my_p + 1) - 1 ELSE - Gl_first = -G_l+n_Gl_left+n_Gl_p*my_p - Gl_last = -G_l+n_Gl_left+n_Gl_p*(my_p+1)-1 + Gl_first = -G_l + n_Gl_left + n_Gl_p*my_p + Gl_last = -G_l + n_Gl_left + n_Gl_p*(my_p + 1) - 1 ENDIF ! Sum |G| <= G_c @@ -494,17 +494,17 @@ SUBROUTINE cutoff_error_fixed_exp(cutoff, h_inv, G_min, l_max_zet, zet_max, C_mm DO l = 0, l_max_zet DO ax = 0, l - DO ay = 0, l-ax - az = l-ax-ay + DO ay = 0, l - ax + az = l - ax - ay ! Compute prod_k (S_G_l(l_k,k) + S_G_u(l_k,k)) - prod_k (S_G_l(l_k,k)) with k in {x, y, z} ! Note: term by term multiplication to avoid subtraction for numerical stability - sum_G_diff = S_G_u(2*ax, 1)*S_G_u(2*ay, 2)*S_G_u(2*az, 3)+ & - S_G_u(2*ax, 1)*S_G_u(2*ay, 2)*S_G_l(2*az, 3)+ & - S_G_u(2*ax, 1)*S_G_l(2*ay, 2)*S_G_u(2*az, 3)+ & - S_G_l(2*ax, 1)*S_G_u(2*ay, 2)*S_G_u(2*az, 3)+ & - S_G_u(2*ax, 1)*S_G_l(2*ay, 2)*S_G_l(2*az, 3)+ & - S_G_l(2*ax, 1)*S_G_u(2*ay, 2)*S_G_l(2*az, 3)+ & + sum_G_diff = S_G_u(2*ax, 1)*S_G_u(2*ay, 2)*S_G_u(2*az, 3) + & + S_G_u(2*ax, 1)*S_G_u(2*ay, 2)*S_G_l(2*az, 3) + & + S_G_u(2*ax, 1)*S_G_l(2*ay, 2)*S_G_u(2*az, 3) + & + S_G_l(2*ax, 1)*S_G_u(2*ay, 2)*S_G_u(2*az, 3) + & + S_G_u(2*ax, 1)*S_G_l(2*ay, 2)*S_G_l(2*az, 3) + & + S_G_l(2*ax, 1)*S_G_u(2*ay, 2)*S_G_l(2*az, 3) + & S_G_l(2*ax, 1)*S_G_l(2*ay, 2)*S_G_u(2*az, 3) err_c_l = 4.0_dp*pi**4*hermite_gauss_norm(zet_max, [ax, ay, az])**2* & diff --git a/src/eri_mme/eri_mme_gaussian.F b/src/eri_mme/eri_mme_gaussian.F index ac825ea8be..9d792f2d2b 100644 --- a/src/eri_mme/eri_mme_gaussian.F +++ b/src/eri_mme/eri_mme_gaussian.F @@ -54,12 +54,12 @@ PURE SUBROUTINE create_hermite_to_cartesian(zet, l_max, h_to_c) INTEGER :: k, l - ALLOCATE (h_to_c(-1:l_max+1, 0:l_max)) + ALLOCATE (h_to_c(-1:l_max + 1, 0:l_max)) h_to_c(:, :) = 0.0_dp h_to_c(0, 0) = 1.0_dp - DO l = 0, l_max-1 - DO k = 0, l+1 - h_to_c(k, l+1) = -(k+1)*h_to_c(k+1, l)+2.0_dp*zet*h_to_c(k-1, l) + DO l = 0, l_max - 1 + DO k = 0, l + 1 + h_to_c(k, l + 1) = -(k + 1)*h_to_c(k + 1, l) + 2.0_dp*zet*h_to_c(k - 1, l) ENDDO ENDDO @@ -76,7 +76,7 @@ PURE FUNCTION hermite_gauss_norm(zet, l) RESULT(norm) INTEGER, DIMENSION(3), INTENT(IN) :: l REAL(KIND=dp) :: norm - norm = 1.0_dp/SQRT((2.0_dp*zet)**(SUM(l)-1.5_dp)*(gamma1(l(1))*gamma1(l(2))*gamma1(l(3)))) + norm = 1.0_dp/SQRT((2.0_dp*zet)**(SUM(l) - 1.5_dp)*(gamma1(l(1))*gamma1(l(2))*gamma1(l(3)))) END FUNCTION hermite_gauss_norm @@ -136,14 +136,14 @@ SUBROUTINE get_minimax_coeff_v_gspace(n_minimax, cutoff, G_min, minimax_aw, pote IF (potential_prv == eri_mme_coulomb .OR. potential_prv == eri_mme_longrange) THEN minimax_Rc = (G_max/G_min)**2 ELSEIF (potential_prv == eri_mme_yukawa) THEN - minimax_Rc = (G_max**2+pot_par**2)/(G_min**2+pot_par**2) + minimax_Rc = (G_max**2 + pot_par**2)/(G_min**2 + pot_par**2) ENDIF CALL get_exp_minimax_coeff(n_minimax, minimax_Rc, minimax_aw, err_minimax) ALLOCATE (a(n_minimax)); ALLOCATE (w(n_minimax)) a(:) = minimax_aw(:n_minimax) - w(:) = minimax_aw(n_minimax+1:) + w(:) = minimax_aw(n_minimax + 1:) SELECT CASE (potential_prv) ! Scale minimax coefficients to incorporate different Fourier transforms CASE (eri_mme_coulomb) @@ -152,15 +152,15 @@ SUBROUTINE get_minimax_coeff_v_gspace(n_minimax, cutoff, G_min, minimax_aw, pote w(:) = w/G_min**2 CASE (eri_mme_yukawa) ! FT = 1/(G**2 + pot_par**2) - w(:) = w*EXP((-a*pot_par**2)/(G_min**2+pot_par**2))/(G_min**2+pot_par**2) - a(:) = a/(G_min**2+pot_par**2) + w(:) = w*EXP((-a*pot_par**2)/(G_min**2 + pot_par**2))/(G_min**2 + pot_par**2) + a(:) = a/(G_min**2 + pot_par**2) CASE (eri_mme_longrange) ! FT = exp(-(G/pot_par)**2)/G**2 ! approximating 1/G**2 as for Coulomb: a(:) = a/G_min**2 w(:) = w/G_min**2 ! incorporate exponential factor: - a(:) = a+1.0_dp/pot_par**2 + a(:) = a + 1.0_dp/pot_par**2 END SELECT minimax_aw = [a(:), w(:)] @@ -168,7 +168,7 @@ SUBROUTINE get_minimax_coeff_v_gspace(n_minimax, cutoff, G_min, minimax_aw, pote IF (potential_prv == eri_mme_coulomb) THEN err_minimax = err_minimax/G_min**2 ELSEIF (potential_prv == eri_mme_yukawa) THEN - err_minimax = err_minimax/(G_min**2+pot_par**2) + err_minimax = err_minimax/(G_min**2 + pot_par**2) ELSEIF (potential_prv == eri_mme_longrange) THEN err_minimax = err_minimax/G_min**2 ! approx. of Coulomb err_minimax = err_minimax*EXP(-G_min**2/pot_par**2) ! exponential factor @@ -203,25 +203,25 @@ PURE SUBROUTINE create_gaussian_overlap_dist_to_hermite(l, m, a, b, R1, R2, H_or REAL(KIND=dp) :: c1, c2, c3 E(:, :, :) = 0.0_dp - E(0, 0, 0) = EXP(-a*b/(a+b)*(R1-R2)**2) ! cost: exp_w flops + E(0, 0, 0) = EXP(-a*b/(a + b)*(R1 - R2)**2) ! cost: exp_w flops - c1 = 0.5_dp/(a+b) - c2 = (b/(a+b))*(R2-R1) - c3 = (a/(a+b))*(R1-R2) + c1 = 0.5_dp/(a + b) + c2 = (b/(a + b))*(R2 - R1) + c3 = (a/(a + b))*(R1 - R2) IF (H_or_C_product .EQ. 1) THEN ! Cartesian overlap dist DO mm = 0, m DO ll = 0, l - DO t = 0, ll+mm+1 + DO t = 0, ll + mm + 1 IF (ll .LT. l) THEN - E(t, ll+1, mm) = c1*E(t-1, ll, mm)+ & ! cost: 8 flops - c2*E(t, ll, mm)+ & - (t+1)*E(t+1, ll, mm) + E(t, ll + 1, mm) = c1*E(t - 1, ll, mm) + & ! cost: 8 flops + c2*E(t, ll, mm) + & + (t + 1)*E(t + 1, ll, mm) ENDIF IF (mm .LT. m) THEN - E(t, ll, mm+1) = c1*E(t-1, ll, mm)+ & ! cost: 8 flops - c3*E(t, ll, mm)+ & - (t+1)*E(t+1, ll, mm) + E(t, ll, mm + 1) = c1*E(t - 1, ll, mm) + & ! cost: 8 flops + c3*E(t, ll, mm) + & + (t + 1)*E(t + 1, ll, mm) ENDIF ENDDO ENDDO @@ -229,18 +229,18 @@ PURE SUBROUTINE create_gaussian_overlap_dist_to_hermite(l, m, a, b, R1, R2, H_or ELSE ! Hermite overlap dist DO mm = 0, m DO ll = 0, l - DO t = 0, ll+mm+1 + DO t = 0, ll + mm + 1 IF (ll .LT. l) THEN - E(t, ll+1, mm) = a*(2*c1*E(t-1, ll, mm)+ & ! cost: 16 flops - 2*c2*E(t, ll, mm)+ & - 2*(t+1)*E(t+1, ll, mm)- & - 2*ll*E(t, ll-1, mm)) + E(t, ll + 1, mm) = a*(2*c1*E(t - 1, ll, mm) + & ! cost: 16 flops + 2*c2*E(t, ll, mm) + & + 2*(t + 1)*E(t + 1, ll, mm) - & + 2*ll*E(t, ll - 1, mm)) ENDIF IF (mm .LT. m) THEN - E(t, ll, mm+1) = b*(2*c1*E(t-1, ll, mm)+ & ! cost: 16 flops - 2*c3*E(t, ll, mm)+ & - 2*(t+1)*E(t+1, ll, mm)- & - 2*mm*E(t, ll, mm-1)) + E(t, ll, mm + 1) = b*(2*c1*E(t - 1, ll, mm) + & ! cost: 16 flops + 2*c3*E(t, ll, mm) + & + 2*(t + 1)*E(t + 1, ll, mm) - & + 2*mm*E(t, ll, mm - 1)) ENDIF ENDDO @@ -284,7 +284,7 @@ FUNCTION exp_radius_fast(l, alpha, threshold, prefactor, epsin) RESULT(radius) radius = r RETURN ENDIF - r = r+dr + r = r + dr rpowl = r**l exp_rsq = exp_rsq*exp_drsq*exp_2rdr exp_2rdr = exp_2rdr*exp_2drsq diff --git a/src/eri_mme/eri_mme_integrate.F b/src/eri_mme/eri_mme_integrate.F index 5b039e6cf1..ca2893e8e2 100644 --- a/src/eri_mme/eri_mme_integrate.F +++ b/src/eri_mme/eri_mme_integrate.F @@ -117,7 +117,7 @@ SUBROUTINE eri_mme_2c_integrate(param, la_min, la_max, lb_min, lb_max, zeta, zet norm = .FALSE. ENDIF - l_max = la_max+lb_max + l_max = la_max + lb_max IF (PRESENT(potential)) THEN exact = .TRUE. @@ -146,7 +146,7 @@ SUBROUTINE eri_mme_2c_integrate(param, la_min, la_max, lb_min, lb_max, zeta, zet ENDIF IF (exact) THEN - alpha_G = 0.25_dp/zeta+0.25_dp/zetb + alpha_G = 0.25_dp/zeta + 0.25_dp/zetb ! resolution for Gaussian width G_res = 0.5_dp*param%G_min R_res = 0.5_dp*param%R_min @@ -161,7 +161,7 @@ SUBROUTINE eri_mme_2c_integrate(param, la_min, la_max, lb_min, lb_max, zeta, zet CALL eri_mme_2c_get_bounds(hmat, h_inv, vol, is_ortho, param%G_min, param%R_min, la_max, lb_max, & zeta, zetb, aw(i_aw), param%sum_precision, n_sum_1d, n_sum_3d, & G_bounds, G_rad, R_bounds, R_rad) - alpha_G = aw(i_aw)+0.25_dp/zeta+0.25_dp/zetb + alpha_G = aw(i_aw) + 0.25_dp/zeta + 0.25_dp/zetb alpha_R = 0.25_dp/alpha_G IF (is_ortho) THEN ! orthorhombic cell @@ -176,17 +176,17 @@ SUBROUTINE eri_mme_2c_integrate(param, la_min, la_max, lb_min, lb_max, zeta, zet IF (do_g_sum) THEN CALL pgf_sum_2c_gspace_1d(S_G(:, i_xyz, i_aw), -rab(i_xyz), alpha_G, inv_lgth, G_bounds(i_xyz)) - IF (PRESENT(G_count)) G_count = G_count+1 + IF (PRESENT(G_count)) G_count = G_count + 1 ELSE CALL pgf_sum_2c_rspace_1d(S_G(:, i_xyz, i_aw), -rab(i_xyz), alpha_R, lgth, R_bounds(i_xyz)) - IF (PRESENT(R_count)) R_count = R_count+1 + IF (PRESENT(R_count)) R_count = R_count + 1 ENDIF IF (param%debug) THEN ! check consistency of summation methods CALL pgf_sum_2c_gspace_1d(S_G_1, -rab(i_xyz), alpha_G, inv_lgth, G_bounds(i_xyz)) CALL pgf_sum_2c_rspace_1d(S_G_2, -rab(i_xyz), alpha_R, lgth, R_bounds(i_xyz)) - max_error = MAXVAL(ABS(S_G_1-S_G_2)/(0.5_dp*(ABS(S_G_1)+ABS(S_G_2))+1.0_dp)) + max_error = MAXVAL(ABS(S_G_1 - S_G_2)/(0.5_dp*(ABS(S_G_1) + ABS(S_G_2)) + 1.0_dp)) CPASSERT(max_error .LE. param%debug_delta) ENDIF @@ -198,12 +198,12 @@ SUBROUTINE eri_mme_2c_integrate(param, la_min, la_max, lb_min, lb_max, zeta, zet IF (do_g_sum) THEN CALL pgf_sum_2c_gspace_3d(S_G_no_H, l_max, -rab, alpha_G, h_inv, G_bounds, G_rad, vol) - IF (PRESENT(G_count)) G_count = G_count+1 + IF (PRESENT(G_count)) G_count = G_count + 1 ELSE CALL pgf_sum_2c_rspace_3d(S_G_no_H, l_max, -rab, alpha_R, hmat, h_inv, R_bounds, R_rad) - IF (PRESENT(R_count)) R_count = R_count+1 + IF (PRESENT(R_count)) R_count = R_count + 1 ENDIF - S_G_no(:) = S_G_no(:)+aw(n_aw+i_aw)*S_G_no_H + S_G_no(:) = S_G_no(:) + aw(n_aw + i_aw)*S_G_no_H ENDIF ENDDO ENDIF @@ -212,10 +212,10 @@ SUBROUTINE eri_mme_2c_integrate(param, la_min, la_max, lb_min, lb_max, zeta, zet prefac = SQRT(1.0_dp/(zeta*zetb)) ! 2) Assemble integral values from Ewald sums - DO jco = ncoset(lb_min-1)+1, ncoset(lb_max) + DO jco = ncoset(lb_min - 1) + 1, ncoset(lb_max) CALL get_l(jco, lb, bx, by, bz) lb_xyz = [bx, by, bz] - DO ico = ncoset(la_min-1)+1, ncoset(la_max) + DO ico = ncoset(la_min - 1) + 1, ncoset(la_max) CALL get_l(ico, la, ax, ay, az) la_xyz = [ax, ay, az] IF (is_ortho) THEN @@ -223,24 +223,24 @@ SUBROUTINE eri_mme_2c_integrate(param, la_min, la_max, lb_min, lb_max, zeta, zet DO i_aw = 1, n_aw Ixyz = 1.0_dp DO i_xyz = 1, 3 - Ixyz = Ixyz*S_G(la_xyz(i_xyz)+lb_xyz(i_xyz), i_xyz, i_aw)*prefac + Ixyz = Ixyz*S_G(la_xyz(i_xyz) + lb_xyz(i_xyz), i_xyz, i_aw)*prefac ENDDO - Imm = Imm+aw(n_aw+i_aw)*Ixyz + Imm = Imm + aw(n_aw + i_aw)*Ixyz ENDDO ELSE - Imm = S_G_no(coset(ax+bx, ay+by, az+bz))*prefac**3 + Imm = S_G_no(coset(ax + bx, ay + by, az + bz))*prefac**3 ENDIF - IF (la+lb .EQ. 0 .AND. .NOT. exact) THEN - Imm = Imm-SUM(aw(n_aw+1:2*n_aw))*prefac**3/vol ! subtracting G = 0 term + IF (la + lb .EQ. 0 .AND. .NOT. exact) THEN + Imm = Imm - SUM(aw(n_aw + 1:2*n_aw))*prefac**3/vol ! subtracting G = 0 term ENDIF IF (.NOT. norm) THEN ! rescaling needed due to Hermite Gaussians (such that they can be contracted same way as Cartesian Gaussians) ! and factor of 4 pi**4 (-1)**lb - hab(o1+ico, o2+jco) = Imm*4.0_dp*pi**4/((2.0_dp*zeta)**la*(-2.0_dp*zetb)**lb) + hab(o1 + ico, o2 + jco) = Imm*4.0_dp*pi**4/((2.0_dp*zeta)**la*(-2.0_dp*zetb)**lb) ELSE ! same thing for normalized Hermite Gaussians - hab(o1+ico, o2+jco) = Imm*4.0_dp*pi**4*(-1.0_dp)**lb*hermite_gauss_norm(zeta, la_xyz)* & - hermite_gauss_norm(zetb, lb_xyz) + hab(o1 + ico, o2 + jco) = Imm*4.0_dp*pi**4*(-1.0_dp)**lb*hermite_gauss_norm(zeta, la_xyz)* & + hermite_gauss_norm(zetb, lb_xyz) ENDIF ENDDO ! la ENDDO ! lb @@ -350,7 +350,7 @@ SUBROUTINE eri_mme_3c_integrate_ortho(param, la_min, la_max, lb_min, lb_max, lc_ CALL eri_mme_3c_get_rads(la_max, lb_max, lc_max, zeta, zetb, zetc, 0.0_dp, param%G_min, param%R_min, & param%sum_precision, G_rads_1=G_rads_1) - cutoff = (MIN(G_rads_1(1), G_rads_1(2)+G_rads_1(3)))**2/2 + cutoff = (MIN(G_rads_1(1), G_rads_1(2) + G_rads_1(3)))**2/2 CALL get_minimax_from_cutoff(param%minimax_grid, cutoff, n_aw, aw, grid) @@ -376,18 +376,18 @@ SUBROUTINE eri_mme_3c_integrate_ortho(param, la_min, la_max, lb_min, lb_max, lc_ ! G= 0 components IF (lc_min == 0) THEN - ALLOCATE (S_G_0(0:la_max+lb_max, 3)) + ALLOCATE (S_G_0(0:la_max + lb_max, 3)) - alpha_R_0 = zeta*zetb/(zeta+zetb) - lmax_0 = la_max+lb_max + alpha_R_0 = zeta*zetb/(zeta + zetb) + lmax_0 = la_max + lb_max R_rad_0 = exp_radius(lmax_0, alpha_R_0, param%sum_precision, 1.0_dp, epsin=R_res) lgth = ABS(hmat(1, 1)) - CALL pgf_sum_2c_rspace_1d(S_G_0(:, 1), RB(1)-RA(1), alpha_R_0, lgth, R_rad_0/lgth) + CALL pgf_sum_2c_rspace_1d(S_G_0(:, 1), RB(1) - RA(1), alpha_R_0, lgth, R_rad_0/lgth) lgth = ABS(hmat(2, 2)) - CALL pgf_sum_2c_rspace_1d(S_G_0(:, 2), RB(2)-RA(2), alpha_R_0, lgth, R_rad_0/lgth) + CALL pgf_sum_2c_rspace_1d(S_G_0(:, 2), RB(2) - RA(2), alpha_R_0, lgth, R_rad_0/lgth) lgth = ABS(hmat(3, 3)) - CALL pgf_sum_2c_rspace_1d(S_G_0(:, 3), RB(3)-RA(3), alpha_R_0, lgth, R_rad_0/lgth) + CALL pgf_sum_2c_rspace_1d(S_G_0(:, 3), RB(3) - RA(3), alpha_R_0, lgth, R_rad_0/lgth) ENDIF DO i_aw = 1, n_aw @@ -406,7 +406,7 @@ SUBROUTINE eri_mme_3c_integrate_ortho(param, la_min, la_max, lb_min, lb_max, lc_ zeta, zetb, zetc, aw(i_aw), ABS(hmat(3, 3)), & R_bounds_3(:, 3)) - IF (PRESENT(RR_count)) RR_count = RR_count+3 + IF (PRESENT(RR_count)) RR_count = RR_count + 3 ENDDO CALL eri_mme_3c_collect_ortho(vol, la_min, la_max, lb_min, lb_max, lc_min, lc_max, & @@ -479,7 +479,7 @@ SUBROUTINE eri_mme_3c_integrate_nonortho(param, la_min, la_max, lb_min, lb_max, CALL eri_mme_3c_get_rads(la_max, lb_max, lc_max, zeta, zetb, zetc, 0.0_dp, param%G_min, param%R_min, & param%sum_precision, G_rads_1=G_rads_1) - cutoff = (MIN(G_rads_1(1), G_rads_1(2)+G_rads_1(3)))**2/2 + cutoff = (MIN(G_rads_1(1), G_rads_1(2) + G_rads_1(3)))**2/2 CALL get_minimax_from_cutoff(param%minimax_grid, cutoff, n_aw, aw, grid) @@ -519,16 +519,16 @@ SUBROUTINE eri_mme_3c_integrate_nonortho(param, la_min, la_max, lb_min, lb_max, ! G= 0 components IF (lc_min == 0) THEN - ALLOCATE (S_G_0_no(ncoset(la_max+lb_max))) - alpha_G_0 = 0.25_dp/zetb+0.25_dp/zeta + ALLOCATE (S_G_0_no(ncoset(la_max + lb_max))) + alpha_G_0 = 0.25_dp/zetb + 0.25_dp/zeta alpha_R_0 = 0.25_dp/alpha_G_0 - lmax_0 = la_max+lb_max - R_0 = RB-RA + lmax_0 = la_max + lb_max + R_0 = RB - RA G_rad_0 = exp_radius(lmax_0, alpha_G_0, param%sum_precision, 1.0_dp, epsin=G_res) R_rad_0 = exp_radius(lmax_0, alpha_R_0, param%sum_precision, 1.0_dp, epsin=R_res) G_bound_0 = ellipsoid_bounds(G_rad_0, TRANSPOSE(hmat)/(2.0_dp*pi)) R_bound_0 = ellipsoid_bounds(R_rad_0, h_inv) - do_g_sum_0 = PRODUCT(2*R_bound_0+1) .GT. PRODUCT(2*G_bound_0+1) + do_g_sum_0 = PRODUCT(2*R_bound_0 + 1) .GT. PRODUCT(2*G_bound_0 + 1) IF (do_g_sum_0) THEN CALL pgf_sum_2c_gspace_3d(S_G_0_no, lmax_0, R_0, alpha_G_0, h_inv, G_bound_0, G_rad_0, vol) ELSE @@ -547,15 +547,15 @@ SUBROUTINE eri_mme_3c_integrate_nonortho(param, la_min, la_max, lb_min, lb_max, G_bounds_1, R_bounds_2, R_bounds_3, & G_rads_1, R_rads_2, R_rads_3, & method=sum_method, method_out=method) - S_G_no(:, :, :) = S_G_no(:, :, :)+aw(n_aw+i_aw)*S_G_no_H(:, :, :) + S_G_no(:, :, :) = S_G_no(:, :, :) + aw(n_aw + i_aw)*S_G_no_H(:, :, :) SELECT CASE (method) CASE (1) - IF (PRESENT(GG_count)) GG_count = GG_count+1 + IF (PRESENT(GG_count)) GG_count = GG_count + 1 CASE (2) - IF (PRESENT(GR_count)) GR_count = GR_count+1 + IF (PRESENT(GR_count)) GR_count = GR_count + 1 CASE (3) - IF (PRESENT(RR_count)) RR_count = RR_count+1 + IF (PRESENT(RR_count)) RR_count = RR_count + 1 CASE DEFAULT CPABORT("") END SELECT @@ -583,7 +583,7 @@ SUBROUTINE eri_mme_3c_integrate_nonortho(param, la_min, la_max, lb_min, lb_max, G_bounds_1, R_bounds_2, R_bounds_3, & G_rads_1, R_rads_2, R_rads_3, & method=1) - nresults = nresults+1 + nresults = nresults + 1 ENDIF IF (db_sum2) THEN @@ -592,7 +592,7 @@ SUBROUTINE eri_mme_3c_integrate_nonortho(param, la_min, la_max, lb_min, lb_max, G_bounds_1, R_bounds_2, R_bounds_3, & G_rads_1, R_rads_2, R_rads_3, & method=2) - nresults = nresults+1 + nresults = nresults + 1 ENDIF IF (db_sum3) THEN @@ -601,40 +601,40 @@ SUBROUTINE eri_mme_3c_integrate_nonortho(param, la_min, la_max, lb_min, lb_max, G_bounds_1, R_bounds_2, R_bounds_3, & G_rads_1, R_rads_2, R_rads_3, & method=3) - nresults = nresults+1 + nresults = nresults + 1 ENDIF max_error = 0.0_dp ALLOCATE (results_no(nresults)) - DO kco = ncoset(lc_min-1)+1, ncoset(lc_max) + DO kco = ncoset(lc_min - 1) + 1, ncoset(lc_max) CALL get_l(kco, lc, cx, cy, cz) - DO jco = ncoset(lb_min-1)+1, ncoset(lb_max) + DO jco = ncoset(lb_min - 1) + 1, ncoset(lb_max) CALL get_l(jco, lb, bx, by, bz) - DO ico = ncoset(la_min-1)+1, ncoset(la_max) + DO ico = ncoset(la_min - 1) + 1, ncoset(la_max) CALL get_l(ico, la, ax, ay, az) max_error = 0.0_dp ir = 0 IF (db_sum1) THEN - ir = ir+1 + ir = ir + 1 results_no(ir) = S_G_no_1(ico, jco, kco) ENDIF IF (db_sum2) THEN - ir = ir+1 + ir = ir + 1 results_no(ir) = S_G_no_2(ico, jco, kco) ENDIF IF (db_sum3) THEN - ir = ir+1 + ir = ir + 1 results_no(ir) = S_G_no_3(ico, jco, kco) ENDIF max_result = MAXVAL(results_no) min_result = MINVAL(results_no) IF (nresults > 0) max_error = MAX(max_error, & - (max_result-min_result)/(0.5_dp*(ABS(max_result)+ABS(min_result))+1.0_dp)) + (max_result - min_result)/(0.5_dp*(ABS(max_result) + ABS(min_result)) + 1.0_dp)) ENDDO ENDDO ENDDO @@ -703,37 +703,37 @@ SUBROUTINE eri_mme_3c_collect_ortho(vol, la_min, la_max, lb_min, lb_max, lc_min, resc_c = resc_c_init lc_prev = lc_min - DO kco = ncoset(lc_min-1)+1, ncoset(lc_max) + DO kco = ncoset(lc_min - 1) + 1, ncoset(lc_max) CALL get_l(kco, lc, cx, cy, cz) IF (lc_prev < lc) resc_c = resc_c*(2.0_dp*zetc) resc_b = resc_b_init lb_prev = lb_min - DO jco = ncoset(lb_min-1)+1, ncoset(lb_max) + DO jco = ncoset(lb_min - 1) + 1, ncoset(lb_max) CALL get_l(jco, lb, bx, by, bz) mone_lb = (-1.0_dp)**lb IF (lb_prev < lb) resc_b = resc_b*(2.0_dp*zetb) resc_a = resc_a_init la_prev = la_min - DO ico = ncoset(la_min-1)+1, ncoset(la_max) + DO ico = ncoset(la_min - 1) + 1, ncoset(la_max) CALL get_l(ico, la, ax, ay, az) IF (la_prev < la) resc_a = resc_a*(2.0_dp*zeta) Ixyz_0 = 0.0_dp IF (lc == 0) THEN - Ixyz_0 = S_G_0(ax+bx, 1)* & - S_G_0(ay+by, 2)* & - S_G_0(az+bz, 3) & + Ixyz_0 = S_G_0(ax + bx, 1)* & + S_G_0(ay + by, 2)* & + S_G_0(az + bz, 3) & /vol*mone_lb ENDIF - Imm = SUM(aw(n_aw+1:2*n_aw)*( & + Imm = SUM(aw(n_aw + 1:2*n_aw)*( & S_G(1:n_aw, 1, ax, bx, cx)* & S_G(1:n_aw, 2, ay, by, cy)* & - S_G(1:n_aw, 3, az, bz, cz))-Ixyz_0) + S_G(1:n_aw, 3, az, bz, cz)) - Ixyz_0) ! rescaling needed due to Hermite Gaussians - habc(o1+ico, o2+jco, o3+kco) = Imm*prefac/(resc_a*resc_b*resc_c) + habc(o1 + ico, o2 + jco, o3 + kco) = Imm*prefac/(resc_a*resc_b*resc_c) la_prev = la ENDDO ! la lb_prev = lb @@ -794,32 +794,32 @@ PURE SUBROUTINE eri_mme_3c_collect_nonortho(vol, la_min, la_max, lb_min, lb_max, resc_c = resc_c_init lc_prev = lc_min - DO kco = ncoset(lc_min-1)+1, ncoset(lc_max) + DO kco = ncoset(lc_min - 1) + 1, ncoset(lc_max) CALL get_l(kco, lc, cx, cy, cz) IF (lc_prev < lc) resc_c = resc_c*(2.0_dp*zetc) resc_b = resc_b_init lb_prev = lb_min - DO jco = ncoset(lb_min-1)+1, ncoset(lb_max) + DO jco = ncoset(lb_min - 1) + 1, ncoset(lb_max) CALL get_l(jco, lb, bx, by, bz) mone_lb = (-1.0_dp)**lb IF (lb_prev < lb) resc_b = resc_b*(2.0_dp*zetb) resc_a = resc_a_init la_prev = la_min - DO ico = ncoset(la_min-1)+1, ncoset(la_max) + DO ico = ncoset(la_min - 1) + 1, ncoset(la_max) CALL get_l(ico, la, ax, ay, az) IF (la_prev < la) resc_a = resc_a*(2.0_dp*zeta) IF (lc .GT. 0) THEN Imm = S_G(ico, jco, kco) ELSE - ijco = coset(ax+bx, ay+by, az+bz) - Imm = S_G(ico, jco, kco)-SUM(aw(n_aw+1:2*n_aw))*S_G_0(ijco)/vol*mone_lb + ijco = coset(ax + bx, ay + by, az + bz) + Imm = S_G(ico, jco, kco) - SUM(aw(n_aw + 1:2*n_aw))*S_G_0(ijco)/vol*mone_lb ENDIF ! rescaling needed due to Hermite Gaussians - habc(o1+ico, o2+jco, o3+kco) = Imm*prefac/(resc_a*resc_b*resc_c) + habc(o1 + ico, o2 + jco, o3 + kco) = Imm*prefac/(resc_a*resc_b*resc_c) la_prev = la ENDDO ! la lb_prev = lb diff --git a/src/eri_mme/eri_mme_test.F b/src/eri_mme/eri_mme_test.F index 05b3880fb6..6bfae12e4c 100644 --- a/src/eri_mme/eri_mme_test.F +++ b/src/eri_mme/eri_mme_test.F @@ -123,14 +123,14 @@ SUBROUTINE eri_mme_2c_perf_acc_test(param, l_max, zet, rabc, nrep, test_accuracy ENDDO ENDDO CALL CPU_TIME(t1) - time(l, izet) = t1-t0 + time(l, izet) = t1 - t0 ENDDO ENDDO CALL mp_sum(time, para_env%group) IF (test_accuracy) THEN - I_diff(:, :, :, :) = ABS(I_test-I_ref) + I_diff(:, :, :, :) = ABS(I_test - I_ref) ENDIF IF (iw > 0) THEN @@ -140,7 +140,7 @@ SUBROUTINE eri_mme_2c_perf_acc_test(param, l_max, zet, rabc, nrep, test_accuracy DO l = 0, l_max DO izet = 1, nzet IF (test_accuracy) THEN - acc = MAXVAL(I_diff(ncoset(l-1)+1:ncoset(l), ncoset(l-1)+1:ncoset(l), :, izet)) + acc = MAXVAL(I_diff(ncoset(l - 1) + 1:ncoset(l), ncoset(l - 1) + 1:ncoset(l), :, izet)) ELSE acc = 0.0_dp ENDIF @@ -155,7 +155,7 @@ SUBROUTINE eri_mme_2c_perf_acc_test(param, l_max, zet, rabc, nrep, test_accuracy MAXVAL(I_diff) IF (param%is_ortho) THEN - acc_check = param%err_mm+param%err_c .GE. MAXVAL(I_diff) + acc_check = param%err_mm + param%err_c .GE. MAXVAL(I_diff) ELSE acc_check = .TRUE. ENDIF @@ -263,7 +263,7 @@ SUBROUTINE eri_mme_3c_perf_acc_test(param, l_max, zet, rabc, nrep, nsample, & DO izeta = 1, nzet DO izetb = 1, nzet DO izetc = 1, nzet - nintg = nintg+1 + nintg = nintg + 1 IF (MOD(nintg, ns) .EQ. 0) THEN I_test(:, :, :) = 0.0_dp CALL CPU_TIME(t0) @@ -279,7 +279,7 @@ SUBROUTINE eri_mme_3c_perf_acc_test(param, l_max, zet, rabc, nrep, nsample, & ENDDO ENDDO CALL CPU_TIME(t1) - time = t1-t0 + time = t1 - t0 CALL mp_sum(time, para_env%group) IF (iw > 0) THEN WRITE (iw, '(T11, I1, 1X, I1, 1X, I1, 1X, ES9.2, 1X, ES9.2, 1X, ES9.2, 1X, ES9.2)') & @@ -320,34 +320,34 @@ SUBROUTINE overlap_dist_expansion_test(l_max, m_max, zeta, zetb, R1, R2, r, tole h_to_c_ol REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: E_C, E_H - zetp = zeta+zetb - Rp = (zeta*R1+zetb*R2)/zetp + zetp = zeta + zetb + Rp = (zeta*R1 + zetb*R2)/zetp ALLOCATE (C1(0:l_max), H1(0:l_max)) ALLOCATE (C2(0:m_max), H2(0:m_max)) - ALLOCATE (C_ol(0:l_max+m_max)) - ALLOCATE (H_ol(0:l_max+m_max)) + ALLOCATE (C_ol(0:l_max + m_max)) + ALLOCATE (H_ol(0:l_max + m_max)) ALLOCATE (C_prod_ref(0:l_max, 0:m_max)) ALLOCATE (C_prod_test(0:l_max, 0:m_max)) ALLOCATE (H_prod_ref(0:l_max, 0:m_max)) ALLOCATE (H_prod_test(0:l_max, 0:m_max)) - ALLOCATE (E_C(-1:l_max+m_max+1, -1:l_max, -1:m_max)) - ALLOCATE (E_H(-1:l_max+m_max+1, -1:l_max, -1:m_max)) + ALLOCATE (E_C(-1:l_max + m_max + 1, -1:l_max, -1:m_max)) + ALLOCATE (E_H(-1:l_max + m_max + 1, -1:l_max, -1:m_max)) CALL create_gaussian_overlap_dist_to_hermite(l_max, m_max, zeta, zetb, R1, R2, 1, E_C) CALL create_gaussian_overlap_dist_to_hermite(l_max, m_max, zeta, zetb, R1, R2, 2, E_H) - CALL create_hermite_to_cartesian(zetp, l_max+m_max, h_to_c_ol) + CALL create_hermite_to_cartesian(zetp, l_max + m_max, h_to_c_ol) CALL create_hermite_to_cartesian(zeta, l_max, h_to_c_1) CALL create_hermite_to_cartesian(zetb, m_max, h_to_c_2) - DO t = 0, l_max+m_max - C_ol(t) = (r-Rp)**t*EXP(-zetp*(r-Rp)**2) + DO t = 0, l_max + m_max + C_ol(t) = (r - Rp)**t*EXP(-zetp*(r - Rp)**2) ENDDO DO l = 0, l_max - C1(l) = (r-R1)**l*EXP(-zeta*(r-R1)**2) + C1(l) = (r - R1)**l*EXP(-zeta*(r - R1)**2) ENDDO DO m = 0, m_max - C2(m) = (r-R2)**m*EXP(-zetb*(r-R2)**2) + C2(m) = (r - R2)**m*EXP(-zetb*(r - R2)**2) ENDDO H1(:) = MATMUL(TRANSPOSE(h_to_c_1(0:, 0:)), C1) @@ -360,15 +360,15 @@ SUBROUTINE overlap_dist_expansion_test(l_max, m_max, zeta, zetb, R1, R2, r, tole H_prod_ref(l, m) = H1(l)*H2(m) C_prod_test(l, m) = 0.0_dp H_prod_test(l, m) = 0.0_dp - DO t = 0, l+m - C_prod_test(l, m) = C_prod_test(l, m)+E_C(t, l, m)*H_ol(t) - H_prod_test(l, m) = H_prod_test(l, m)+E_H(t, l, m)*H_ol(t) + DO t = 0, l + m + C_prod_test(l, m) = C_prod_test(l, m) + E_C(t, l, m)*H_ol(t) + H_prod_test(l, m) = H_prod_test(l, m) + E_H(t, l, m)*H_ol(t) ENDDO ENDDO ENDDO - C_prod_err = MAXVAL(ABS(C_prod_test-C_prod_ref)/(0.5_dp*(ABS(C_prod_test)+ABS(C_prod_ref))+1.0_dp)) - H_prod_err = MAXVAL(ABS(H_prod_test-H_prod_ref)/(0.5_dp*(ABS(C_prod_test)+ABS(C_prod_ref))+1.0_dp)) + C_prod_err = MAXVAL(ABS(C_prod_test - C_prod_ref)/(0.5_dp*(ABS(C_prod_test) + ABS(C_prod_ref)) + 1.0_dp)) + H_prod_err = MAXVAL(ABS(H_prod_test - H_prod_ref)/(0.5_dp*(ABS(C_prod_test) + ABS(C_prod_ref)) + 1.0_dp)) CPASSERT(C_prod_err .LE. tolerance) CPASSERT(H_prod_err .LE. tolerance) diff --git a/src/eri_mme/eri_mme_types.F b/src/eri_mme/eri_mme_types.F index 389603fb05..0e97512948 100644 --- a/src/eri_mme/eri_mme_types.F +++ b/src/eri_mme/eri_mme_types.F @@ -287,7 +287,7 @@ SUBROUTINE eri_mme_set_potential(param, potential, pot_par) DEALLOCATE (minimax_aw) - CPASSERT(param%zet_max+1.0E-12 .GT. param%zet_min) + CPASSERT(param%zet_max + 1.0E-12 .GT. param%zet_min) CPASSERT(param%n_grids .GE. 1) cutoff_max = param%cutoff @@ -338,11 +338,11 @@ SUBROUTINE eri_mme_create_minimax_grids(n_grids, minimax_grids, n_minimax, & ! for first grid (for max. cutoff) always use default n_minimax CALL get_minimax_coeff_v_gspace(n_minimax, cutoff, G_min, minimax_aw, err_minimax=err_mm, & potential=potential, pot_par=pot_par) - CPASSERT(err_mm .LT. 1.1_dp*target_error+1.0E-12) + CPASSERT(err_mm .LT. 1.1_dp*target_error + 1.0E-12) CALL create_minimax_grid(minimax_grids(n_grids), cutoff, n_minimax, minimax_aw, err_mm) DEALLOCATE (minimax_aw) - DO i_grid = n_grids-1, 1, -1 + DO i_grid = n_grids - 1, 1, -1 DO n_mm = n_minimax, 1, -1 ALLOCATE (minimax_aw(2*n_mm)) CALL get_minimax_coeff_v_gspace(n_mm, cutoff, G_min, minimax_aw, err_minimax=err_mm, & @@ -350,7 +350,7 @@ SUBROUTINE eri_mme_create_minimax_grids(n_grids, minimax_grids, n_minimax, & IF (err_mm .GT. 1.1_dp*target_error) THEN CPASSERT(n_mm .NE. n_minimax) - CALL create_minimax_grid(minimax_grids(i_grid), cutoff, n_mm+1, minimax_aw_prev, err_mm_prev) + CALL create_minimax_grid(minimax_grids(i_grid), cutoff, n_mm + 1, minimax_aw_prev, err_mm_prev) DEALLOCATE (minimax_aw) EXIT diff --git a/src/eri_mme/eri_mme_util.F b/src/eri_mme/eri_mme_util.F index 41ea2c9b75..ec56827f7c 100644 --- a/src/eri_mme/eri_mme_util.F +++ b/src/eri_mme/eri_mme_util.F @@ -45,7 +45,7 @@ FUNCTION R_abs_min(hmat) RESULT(R_m) IF (.NOT. (sx == 0 .AND. sy == 0 .AND. sz == 0)) THEN sxyz = [sx, sy, sz] R = MATMUL(hmat, sxyz) - R_sq = R(1)**2+R(2)**2+R(3)**2 + R_sq = R(1)**2 + R(2)**2 + R(3)**2 IF (R_sq < R_m .OR. R_m < EPSILON(R_m)) R_m = R_sq ENDIF ENDDO @@ -80,7 +80,7 @@ FUNCTION G_abs_min(h_inv) RESULT(G_m) IF (.NOT. (gx == 0 .AND. gy == 0 .AND. gz == 0)) THEN gxyz = [gx, gy, gz] G = MATMUL(H, gxyz) - G_sq = G(1)**2+G(2)**2+G(3)**2 + G_sq = G(1)**2 + G(2)**2 + G(3)**2 IF (G_sq < G_m .OR. G_m < EPSILON(G_m)) G_m = G_sq ENDIF ENDDO diff --git a/src/et_coupling.F b/src/et_coupling.F index e4a2dee849..c2803f07b5 100644 --- a/src/et_coupling.F +++ b/src/et_coupling.F @@ -168,7 +168,7 @@ SUBROUTINE calc_et_coupling(qs_env) DO j = 1, ncol_local DO k = 1, nrow_local - b(i) = b(i)+rest_MO(2)%matrix%local_data(k, j)*inverse_mat%local_data(k, j) + b(i) = b(i) + rest_MO(2)%matrix%local_data(k, j)*inverse_mat%local_data(k, j) END DO END DO @@ -176,7 +176,7 @@ SUBROUTINE calc_et_coupling(qs_env) a(i) = 0.0_dp DO j = 1, ncol_local DO k = 1, nrow_local - a(i) = a(i)+rest_MO(1)%matrix%local_data(k, j)*Tinverse%local_data(k, j) + a(i) = a(i) + rest_MO(1)%matrix%local_data(k, j)*Tinverse%local_data(k, j) END DO END DO IF (is_spin_constraint) THEN @@ -200,10 +200,10 @@ SUBROUTINE calc_et_coupling(qs_env) IF (dft_control%nspins == 2) THEN Sda = S_det(1)*S_det(2) - Wda = ((a(1)+a(2))+(b(1)+b(2)))*0.5_dp*Sda + Wda = ((a(1) + a(2)) + (b(1) + b(2)))*0.5_dp*Sda ELSE Sda = S_det(1)**2 - Wda = (a(1)+b(1))*Sda + Wda = (a(1) + b(1))*Sda END IF IF (dft_control%qs_control%ddapc_restraint) THEN @@ -239,9 +239,9 @@ SUBROUTINE calc_et_coupling(qs_env) CALL get_qs_env(qs_env, energy=energy) W_mat(1, 1) = energy%total W_mat(2, 2) = qs_env%et_coupling%energy - a(1) = (energy%total+strength*Wbb)*Sda-strength*Wda - a(2) = (qs_env%et_coupling%energy+qs_env%et_coupling%e1*Waa)*Sda-qs_env%et_coupling%e1*Wda - W_mat(1, 2) = (a(1)+a(2))*0.5_dp + a(1) = (energy%total + strength*Wbb)*Sda - strength*Wda + a(2) = (qs_env%et_coupling%energy + qs_env%et_coupling%e1*Waa)*Sda - qs_env%et_coupling%e1*Wda + W_mat(1, 2) = (a(1) + a(2))*0.5_dp W_mat(2, 1) = W_mat(1, 2) S_mat = MATMUL(W_mat, (tmp_mat)) diff --git a/src/et_coupling_proj.F b/src/et_coupling_proj.F index 123eae6ac5..022b661703 100644 --- a/src/et_coupling_proj.F +++ b/src/et_coupling_proj.F @@ -265,7 +265,7 @@ SUBROUTINE set_block_data(qs_env, et_proj_sec, ec) nset=n_set, nshell=n_shell, l=ang_mom_id) DO j = 1, n_set DO k = 1, n_shell(j) - atom_nf(i) = atom_nf(i)+nso(ang_mom_id(k, j)) + atom_nf(i) = atom_nf(i) + nso(ang_mom_id(k, j)) END DO END DO END DO @@ -273,7 +273,7 @@ SUBROUTINE set_block_data(qs_env, et_proj_sec, ec) ! Sanity check n = 0 DO i = 1, n_atoms - n = n+atom_nf(i) + n = n + atom_nf(i) END DO CPASSERT(n == n_ao) @@ -281,8 +281,8 @@ SUBROUTINE set_block_data(qs_env, et_proj_sec, ec) ALLOCATE (atom_ps(n_atoms)) CPASSERT(ASSOCIATED(atom_ps)) atom_ps = 1 - DO i = 1, n_atoms-1 - atom_ps(i+1) = atom_ps(i)+atom_nf(i) + DO i = 1, n_atoms - 1 + atom_ps(i + 1) = atom_ps(i) + atom_nf(i) END DO ! Number of blocks @@ -321,7 +321,7 @@ SUBROUTINE set_block_data(qs_env, et_proj_sec, ec) CPABORT('invalid fragment atom ID ('//TRIM(ADJUSTL(cp_to_string(atom_id(j))))//')') ! Check if the atom is not in previously-defined blocks found = .FALSE. - DO k = 1, i-1 + DO k = 1, i - 1 DO l = 1, ec%block(k)%n_atoms IF (ec%block(k)%atom(l)%id == atom_id(j)) THEN CPWARN('multiple definition of atom'//TRIM(ADJUSTL(cp_to_string(atom_id(j))))) @@ -342,7 +342,7 @@ SUBROUTINE set_block_data(qs_env, et_proj_sec, ec) END IF ! Save the atom IF (.NOT. found) THEN - ec%block(i)%n_atoms = ec%block(i)%n_atoms+1 + ec%block(i)%n_atoms = ec%block(i)%n_atoms + 1 t(ec%block(i)%n_atoms) = atom_id(j) END IF END DO @@ -356,10 +356,10 @@ SUBROUTINE set_block_data(qs_env, et_proj_sec, ec) ec%block(i)%atom(j)%id = t(j) ec%block(i)%atom(j)%n_ao = atom_nf(ec%block(i)%atom(j)%id) ec%block(i)%atom(j)%ao_pos = atom_ps(ec%block(i)%atom(j)%id) - ec%block(i)%n_ao = ec%block(i)%n_ao+ec%block(i)%atom(j)%n_ao + ec%block(i)%n_ao = ec%block(i)%n_ao + ec%block(i)%atom(j)%n_ao END DO - ec%n_atoms = ec%n_atoms+ec%block(i)%n_atoms + ec%n_atoms = ec%n_atoms + ec%block(i)%n_atoms END DO ! Clean memory @@ -534,8 +534,8 @@ SUBROUTINE reorder_hamiltonian_matrix(ec, mat_h, mat_w) nw_p_rows, nw_p_cols, cw_row, cw_col, & iw_p_row, iw_p_col, cw_row_f, cw_col_f) CALL infog2l( & - ec%block(ir)%atom(jr)%ao_pos+kr-1, & - ec%block(ic)%atom(jc)%ao_pos+kc-1, & + ec%block(ir)%atom(jr)%ao_pos + kr - 1, & + ec%block(ic)%atom(jc)%ao_pos + kc - 1, & mat_h%matrix_struct%descriptor, & nh_p_rows, nh_p_cols, ch_row, ch_col, & ih_p_row, ih_p_col, ch_row_f, ch_col_f) @@ -556,14 +556,14 @@ SUBROUTINE reorder_hamiltonian_matrix(ec, mat_h, mat_w) END IF #else mat_w%local_data(nr, nc) = mat_h%local_data( & - ec%block(ir)%atom(jr)%ao_pos+kr-1, & - ec%block(ic)%atom(jc)%ao_pos+kc-1) + ec%block(ir)%atom(jr)%ao_pos + kr - 1, & + ec%block(ic)%atom(jc)%ao_pos + kc - 1) #endif - nc = nc+1 + nc = nc + 1 END DO END DO END DO - nr = nr+1 + nr = nr + 1 END DO END DO END DO @@ -769,7 +769,7 @@ SUBROUTINE hamiltonian_block_diag(qs_env, ec, mat_h) DEALLOCATE (vec_e) ! Off-set for next block - j = j+ec%block(i)%n_ao + j = j + ec%block(i)%n_ao END DO @@ -804,10 +804,10 @@ SUBROUTINE hamiltonian_block_diag(qs_env, ec, mat_h) END IF ! Off-set for next block - l = l+ec%block(j)%n_ao + l = l + ec%block(j)%n_ao END DO ! Off-set for next block - k = k+ec%block(i)%n_ao + k = k + ec%block(i)%n_ao END DO ! Clean memory @@ -891,7 +891,7 @@ FUNCTION get_mo_c2_sum(blk_at, mo, id, atom) RESULT(c2) DO k = 1, blk_at(j)%n_ao #if defined(__SCALAPACK) c = 0.0_dp - CALL infog2l(blk_at(j)%ao_pos+k-1, id, mo%matrix_struct%descriptor, & + CALL infog2l(blk_at(j)%ao_pos + k - 1, id, mo%matrix_struct%descriptor, & n_p_rows, n_p_cols, c_row, c_col, & i_p_row, i_p_col, c_row_f, c_col_f) ! local element @@ -903,9 +903,9 @@ FUNCTION get_mo_c2_sum(blk_at, mo, id, atom) RESULT(c2) CALL dgebr2d(mo%matrix_struct%context%group, 'All', ' ', 1, 1, c, 1, c_row_f, c_col_f) END IF #else - c = mo%local_data(blk_at(j)%ao_pos+k-1, id) + c = mo%local_data(blk_at(j)%ao_pos + k - 1, id) #endif - c2 = c2+c*c + c2 = c2 + c*c END DO END DO @@ -1185,7 +1185,7 @@ SUBROUTINE print_couplings(ec_sec, output_unit, logger, ec, mo) #if defined(__SCALAPACK) DO i = 1, ec%n_blocks - DO j = i+1, ec%n_blocks + DO j = i + 1, ec%n_blocks nr = ec%block(i)%hab(1, j)%matrix%matrix_struct%nrow_global nc = ec%block(i)%hab(1, j)%matrix%matrix_struct%ncol_global @@ -1254,7 +1254,7 @@ SUBROUTINE print_couplings(ec_sec, output_unit, logger, ec, mo) IF (output_unit > 0) THEN DO i = 1, ec%n_blocks - DO j = i+1, ec%n_blocks + DO j = i + 1, ec%n_blocks WRITE (filename, '(a5,I1.1,a1,I1.1)') "ET_BL_", i, "-", j unit_nr = cp_print_key_unit_nr(logger, ec_sec, "PRINT%COUPLINGS", extension=".elcoup", & @@ -1447,7 +1447,7 @@ SUBROUTINE set_mo_coefficients(qs_env, ec, id, mo, mat_u, n_ao, n_mo) DO ic = 1, ec%block(id)%n_atoms DO jc = 1, ec%block(id)%atom(ic)%n_ao #if defined(__SCALAPACK) - CALL infog2l(ec%block(id)%atom(ir)%ao_pos+jr-1, nc, & + CALL infog2l(ec%block(id)%atom(ir)%ao_pos + jr - 1, nc, & mat_w%matrix_struct%descriptor, & ns_p_rows, ns_p_cols, cs_row, cs_col, & is_p_row, is_p_col, cs_row_f, cs_col_f) @@ -1470,13 +1470,13 @@ SUBROUTINE set_mo_coefficients(qs_env, ec, id, mo, mat_u, n_ao, n_mo) END IF END IF #else - mat_w%local_data(ec%block(id)%atom(ir)%ao_pos+jr-1, nc) = & + mat_w%local_data(ec%block(id)%atom(ir)%ao_pos + jr - 1, nc) = & mat_u%local_data(nr, nc) #endif - nc = nc+1 + nc = nc + 1 END DO END DO - nr = nr+1 + nr = nr + 1 END DO END DO @@ -1554,7 +1554,7 @@ SUBROUTINE create_block_mo_set(qs_env, ec, id, spin, mat_u, vec_e) n_el = n_el/2 IF (MOD(ec%block(id)%n_electrons, 2) == 1) THEN IF (spin == 1) & - n_el = n_el+1 + n_el = n_el + 1 END IF END IF @@ -1755,7 +1755,7 @@ SUBROUTINE save_el_states(qs_env, ec, n_spins) CALL section_vals_val_get(mo_sec, keyword_name='NHOMO', i_val=n) IF (n > 0) THEN - DO k = MAX(1, mo%homo-n+1), mo%homo + DO k = MAX(1, mo%homo - n + 1), mo%homo CALL save_mo_cube(qs_env, logger, print_sec, mo, i, k, j) END DO END IF @@ -1764,7 +1764,7 @@ SUBROUTINE save_el_states(qs_env, ec, n_spins) CALL section_vals_val_get(mo_sec, keyword_name='NLUMO', i_val=n) IF (n > 0) THEN - DO k = mo%lfomo, MIN(mo%lfomo+n-1, mo%nmo) + DO k = mo%lfomo, MIN(mo%lfomo + n - 1, mo%nmo) CALL save_mo_cube(qs_env, logger, print_sec, mo, i, k, j) END DO END IF @@ -1872,7 +1872,7 @@ SUBROUTINE calc_et_coupling_proj(qs_env) WRITE (output_unit, '(T3,A,I10)') & 'Number of fragment atoms = ', ec%n_atoms WRITE (output_unit, '(T3,A,I10)') & - 'Number of unassigned atoms = ', n_atoms-ec%n_atoms + 'Number of unassigned atoms = ', n_atoms - ec%n_atoms WRITE (output_unit, '(T3,A,I10)') & 'Number of AO basis functions = ', n_ao @@ -1898,11 +1898,11 @@ SUBROUTINE calc_et_coupling_proj(qs_env) WRITE (output_unit, '(T3,A)') 'Block atom IDs =' DO j = 1, ec%block(i)%n_atoms/10 WRITE (output_unit, '(T3,A,10I6)') ' ', & - (ec%block(i)%atom((j-1)*10+k)%id, k=1, 10) + (ec%block(i)%atom((j - 1)*10 + k)%id, k=1, 10) END DO IF (MOD(ec%block(i)%n_atoms, 10) /= 0) THEN WRITE (output_unit, '(T3,A,10I6)') ' ', & - (ec%block(i)%atom(k+10*(ec%block(i)%n_atoms/10))%id, & + (ec%block(i)%atom(k + 10*(ec%block(i)%n_atoms/10))%id, & k=1, MOD(ec%block(i)%n_atoms, 10)) END IF diff --git a/src/ewald_environment_types.F b/src/ewald_environment_types.F index d21c1991d3..c757cede42 100644 --- a/src/ewald_environment_types.F +++ b/src/ewald_environment_types.F @@ -251,7 +251,7 @@ SUBROUTINE ewald_env_create(ewald_env, para_env) ALLOCATE (ewald_env) ewald_env%ref_count = 1 - last_ewald_env_id_nr = last_ewald_env_id_nr+1 + last_ewald_env_id_nr = last_ewald_env_id_nr + 1 ewald_env%id_nr = last_ewald_env_id_nr NULLIFY (ewald_env%poisson_section) CALL cp_para_env_retain(para_env) @@ -274,7 +274,7 @@ SUBROUTINE ewald_env_retain(ewald_env) CPASSERT(ASSOCIATED(ewald_env)) CPASSERT(ewald_env%ref_count > 0) - ewald_env%ref_count = ewald_env%ref_count+1 + ewald_env%ref_count = ewald_env%ref_count + 1 END SUBROUTINE ewald_env_retain ! ************************************************************************************************** @@ -292,7 +292,7 @@ SUBROUTINE ewald_env_release(ewald_env) IF (ASSOCIATED(ewald_env)) THEN CPASSERT(ewald_env%ref_count > 0) - ewald_env%ref_count = ewald_env%ref_count-1 + ewald_env%ref_count = ewald_env%ref_count - 1 IF (ewald_env%ref_count < 1) THEN CALL cp_para_env_release(ewald_env%para_env) CALL section_vals_release(ewald_env%poisson_section) @@ -348,7 +348,7 @@ SUBROUTINE read_ewald_section(ewald_env, ewald_section) SELECT CASE (ewald_env%ewald_type) CASE (do_ewald_ewald, do_ewald_spme) CALL section_vals_val_get(ewald_section, "GMAX", i_vals=gmax_read) - SELECT CASE (SIZE (gmax_read, 1)) + SELECT CASE (SIZE(gmax_read, 1)) CASE (1) ewald_env%gmax = gmax_read(1) CASE (3) @@ -499,7 +499,7 @@ SUBROUTINE read_ewald_section_tb(ewald_env, ewald_section, hmat) CALL section_vals_val_get(ewald_section, "GMAX", explicit=explicit) IF (explicit) THEN CALL section_vals_val_get(ewald_section, "GMAX", i_vals=gmax_read) - SELECT CASE (SIZE (gmax_read, 1)) + SELECT CASE (SIZE(gmax_read, 1)) CASE (1) ewald_env%gmax = gmax_read(1) CASE (3) @@ -513,7 +513,7 @@ SUBROUTINE read_ewald_section_tb(ewald_env, ewald_section, hmat) DO i = 1, 3 alat = SUM(hmat(:, i)**2) CPASSERT(alat /= 0._dp) - ewald_env%gmax(i) = 2*FLOOR(SQRT(2.0_dp*cutoff*alat)/twopi)+1 + ewald_env%gmax(i) = 2*FLOOR(SQRT(2.0_dp*cutoff*alat)/twopi) + 1 ENDDO ENDIF n = ewald_env%gmax @@ -555,22 +555,22 @@ FUNCTION find_ewald_optimal_value(precs) RESULT(value) REAL(KIND=dp) :: func, func1, func2, s, s1, s2 s = 0.1_dp - func = EXP(-s**2)/s**2-precs + func = EXP(-s**2)/s**2 - precs CPASSERT(func > 0.0_dp) DO WHILE (func > 0.0_dp) - s = s+0.1_dp - func = EXP(-s**2)/s**2-precs + s = s + 0.1_dp + func = EXP(-s**2)/s**2 - precs END DO s2 = s - s1 = s-0.1_dp + s1 = s - 0.1_dp ! Start bisection DO WHILE (.TRUE.) - func2 = EXP(-s2**2)/s2**2-precs - func1 = EXP(-s1**2)/s1**2-precs + func2 = EXP(-s2**2)/s2**2 - precs + func1 = EXP(-s1**2)/s1**2 - precs CPASSERT(func1 >= 0) CPASSERT(func2 <= 0) - s = 0.5_dp*(s1+s2) - func = EXP(-s**2)/s**2-precs + s = 0.5_dp*(s1 + s2) + func = EXP(-s**2)/s**2 - precs IF (func > 0.0_dp) THEN s1 = s ELSE IF (func < 0.0_dp) THEN diff --git a/src/ewald_methods_tb.F b/src/ewald_methods_tb.F index c5b45dbe80..6760326266 100644 --- a/src/ewald_methods_tb.F +++ b/src/ewald_methods_tb.F @@ -202,9 +202,9 @@ SUBROUTINE tb_spme_evaluate(ewald_env, ewald_pw, particle_set, box, & CALL get_patch(particle_set, box, green, npts, p1, rhos, is_core=.FALSE., & is_shell=.FALSE., unit_charge=.TRUE.) CALL dg_sum_patch_force_1d(rpot, rhos, center(:, p1), fint) - atprop%atstress(1, 1, p1) = atprop%atstress(1, 1, p1)+0.5_dp*mcharge(p1)*fint*dvols - atprop%atstress(2, 2, p1) = atprop%atstress(2, 2, p1)+0.5_dp*mcharge(p1)*fint*dvols - atprop%atstress(3, 3, p1) = atprop%atstress(3, 3, p1)+0.5_dp*mcharge(p1)*fint*dvols + atprop%atstress(1, 1, p1) = atprop%atstress(1, 1, p1) + 0.5_dp*mcharge(p1)*fint*dvols + atprop%atstress(2, 2, p1) = atprop%atstress(2, 2, p1) + 0.5_dp*mcharge(p1)*fint*dvols + atprop%atstress(3, 3, p1) = atprop%atstress(3, 3, p1) + 0.5_dp*mcharge(p1)*fint*dvols END DO CALL pw_pool_create_pw(pw_pool, phib_g, & @@ -213,7 +213,7 @@ SUBROUTINE tb_spme_evaluate(ewald_env, ewald_pw, particle_set, box, & ffb = 1.0_dp/fourpi DO i = 1, 3 DO ig = grid_spme%first_gne0, grid_spme%ngpts_cut_local - phib_g%cc(ig) = ffb*dphi_g(i)%pw%cc(ig)*(1.0_dp+ffa*grid_spme%gsq(ig)) + phib_g%cc(ig) = ffb*dphi_g(i)%pw%cc(ig)*(1.0_dp + ffa*grid_spme%gsq(ig)) phib_g%cc(ig) = phib_g%cc(ig)*green%influence_fn%cc(ig) END DO IF (grid_spme%have_g0) phib_g%cc(1) = 0.0_dp @@ -235,8 +235,8 @@ SUBROUTINE tb_spme_evaluate(ewald_env, ewald_pw, particle_set, box, & is_core=.FALSE., is_shell=.FALSE., unit_charge=.TRUE.) ! integrate box and potential CALL dg_sum_patch_force_1d(rpot, rhos, center(:, p1), fint) - atprop%atstress(i, j, p1) = atprop%atstress(i, j, p1)+fint*dvols*mcharge(p1) - IF (i /= j) atprop%atstress(j, i, p1) = atprop%atstress(j, i, p1)+fint*dvols*mcharge(p1) + atprop%atstress(i, j, p1) = atprop%atstress(i, j, p1) + fint*dvols*mcharge(p1) + IF (i /= j) atprop%atstress(j, i, p1) = atprop%atstress(j, i, p1) + fint*dvols*mcharge(p1) END DO END DO @@ -266,7 +266,7 @@ SUBROUTINE tb_spme_evaluate(ewald_env, ewald_pw, particle_set, box, & END DO END DO ffa = (1.0_dp/fourpi)*(0.5_dp/alpha)**2 - virial%pv_virial = virial%pv_virial-(ffa*f_stress-h_stress)/REAL(para_env%num_pe, dp) + virial%pv_virial = virial%pv_virial - (ffa*f_stress - h_stress)/REAL(para_env%num_pe, dp) END IF !--------END OF STRESS TENSOR CALCULATION ----------- @@ -303,13 +303,13 @@ SUBROUTINE tb_spme_evaluate(ewald_env, ewald_pw, particle_set, box, & is_shell=.FALSE., unit_charge=.TRUE.) CALL dg_sum_patch_force_1d(rpot, rhos, center(:, p1), fint) - gmcharge(p1, 1) = gmcharge(p1, 1)+fint*dvols + gmcharge(p1, 1) = gmcharge(p1, 1) + fint*dvols IF (calculate_forces) THEN CALL dg_sum_patch_force_3d(drpot, rhos, center(:, p1), fat) - gmcharge(p1, 2) = gmcharge(p1, 2)-fat(1)*dvols - gmcharge(p1, 3) = gmcharge(p1, 3)-fat(2)*dvols - gmcharge(p1, 4) = gmcharge(p1, 4)-fat(3)*dvols + gmcharge(p1, 2) = gmcharge(p1, 2) - fat(1)*dvols + gmcharge(p1, 3) = gmcharge(p1, 3) - fat(2)*dvols + gmcharge(p1, 4) = gmcharge(p1, 4) - fat(3)*dvols END IF END DO @@ -375,14 +375,14 @@ SUBROUTINE tb_ewald_overlap(gmcharge, mcharge, alpha, n_list, virial, use_virial dr = SQRT(SUM(rij(:)**2)) IF (dr > 1.e-10) THEN fr = erfc(alpha*dr)/dr - gmcharge(iatom, 1) = gmcharge(iatom, 1)+mcharge(jatom)*fr - gmcharge(jatom, 1) = gmcharge(jatom, 1)+mcharge(iatom)*fr + gmcharge(iatom, 1) = gmcharge(iatom, 1) + mcharge(jatom)*fr + gmcharge(jatom, 1) = gmcharge(jatom, 1) + mcharge(iatom)*fr IF (nmat > 1) THEN - dfr = -2._dp*alpha*EXP(-alpha*alpha*dr*dr)*oorootpi/dr-fr/dr + dfr = -2._dp*alpha*EXP(-alpha*alpha*dr*dr)*oorootpi/dr - fr/dr dfr = -dfr/dr DO i = 2, nmat - gmcharge(iatom, i) = gmcharge(iatom, i)-rij(i-1)*mcharge(jatom)*dfr - gmcharge(jatom, i) = gmcharge(jatom, i)+rij(i-1)*mcharge(iatom)*dfr + gmcharge(iatom, i) = gmcharge(iatom, i) - rij(i - 1)*mcharge(jatom)*dfr + gmcharge(jatom, i) = gmcharge(jatom, i) + rij(i - 1)*mcharge(iatom)*dfr END DO END IF IF (use_virial) THEN diff --git a/src/ewald_pw_types.F b/src/ewald_pw_types.F index d4cbb32129..29e08bd080 100644 --- a/src/ewald_pw_types.F +++ b/src/ewald_pw_types.F @@ -83,7 +83,7 @@ SUBROUTINE ewald_pw_retain(ewald_pw) CPASSERT(ASSOCIATED(ewald_pw)) CPASSERT(ewald_pw%ref_count > 0) - ewald_pw%ref_count = ewald_pw%ref_count+1 + ewald_pw%ref_count = ewald_pw%ref_count + 1 END SUBROUTINE ewald_pw_retain ! ************************************************************************************************** @@ -114,7 +114,7 @@ SUBROUTINE ewald_pw_create(ewald_pw, ewald_env, cell, cell_ref, print_section) CALL dg_create(dg) ewald_pw%dg => dg ewald_pw%ref_count = 1 - last_ewald_pw_id_nr = last_ewald_pw_id_nr+1 + last_ewald_pw_id_nr = last_ewald_pw_id_nr + 1 ewald_pw%id_nr = last_ewald_pw_id_nr CALL ewald_pw_init(ewald_pw, ewald_env, cell, cell_ref, print_section) END SUBROUTINE ewald_pw_create @@ -136,7 +136,7 @@ SUBROUTINE ewald_pw_release(ewald_pw) CALL timeset(routineN, handle) IF (ASSOCIATED(ewald_pw)) THEN CPASSERT(ewald_pw%ref_count > 0) - ewald_pw%ref_count = ewald_pw%ref_count-1 + ewald_pw%ref_count = ewald_pw%ref_count - 1 IF (ewald_pw%ref_count < 1) THEN CALL pw_pool_release(ewald_pw%pw_small_pool) CALL pw_pool_release(ewald_pw%pw_big_pool) diff --git a/src/ewald_spline_util.F b/src/ewald_spline_util.F index a747e1ac0c..a4e8f34fba 100644 --- a/src/ewald_spline_util.F +++ b/src/ewald_spline_util.F @@ -107,7 +107,7 @@ SUBROUTINE Setup_Ewald_Spline(pw_grid, pw_pool, coeff, LG, gx, gy, gz, hmat, npt iounit = cp_print_key_unit_nr(logger, print_section, "", & extension=".Log") bo(1, 1:3) = 0 - bo(2, 1:3) = npts(1:3)-1 + bo(2, 1:3) = npts(1:3) - 1 CALL pw_grid_setup(cell%hmat, pw_grid, grid_span=HALFSPACE, bounds=bo, iounit=iounit) CALL cp_print_key_finished_output(iounit, logger, print_section, & @@ -203,7 +203,7 @@ SUBROUTINE eval_pw_TabLR(grid, pw_pool, TabLR, Lg, gx, gy, gz, hmat_mm, & ALLOCATE (sin_gz(SIZE(Lg), gbo(1, 3):gbo(2, 3))) !NB precalculate Cos(gx*xs1) etc for Cos refactoring DO k = gbo(1, 3), gbo(2, 3) - my_k = k-gbo(1, 3) + my_k = k - gbo(1, 3) xs3 = REAL(my_k, dp)*dr3 IF (k > nzlim) CYCLE cos_gz(1:SIZE(Lg), k) = COS(gz(1:SIZE(Lg))*xs3) @@ -214,14 +214,14 @@ SUBROUTINE eval_pw_TabLR(grid, pw_pool, TabLR, Lg, gx, gy, gz, hmat_mm, & IF (j > nylim) CYCLE cos_gy(1:SIZE(Lg), j) = COS(gy(1:SIZE(Lg))*xs2) sin_gy(1:SIZE(Lg), j) = SIN(gy(1:SIZE(Lg))*xs2) - xs2 = xs2+dr2 + xs2 = xs2 + dr2 END DO ! j xs1 = 0.0_dp DO i = gbo(1, 1), gbo(2, 1) IF (i > nxlim) CYCLE cos_gx(1:SIZE(Lg), i) = COS(gx(1:SIZE(Lg))*xs1) sin_gx(1:SIZE(Lg), i) = SIN(gx(1:SIZE(Lg))*xs1) - xs1 = xs1+dr1 + xs1 = xs1 + dr1 END DO ! i !NB use DGEMM to compute sum over kg for each i, j, k @@ -231,20 +231,20 @@ SUBROUTINE eval_pw_TabLR(grid, pw_pool, TabLR, Lg, gx, gy, gz, hmat_mm, & n_extra = MOD(SIZE(Lg), grid%pw_grid%para%group_size) ! first n_extra nodes get NLg_loc+1, remaining get NLg_loc IF (grid%pw_grid%para%my_pos < n_extra) THEN - Lg_loc_min = (NLg_loc+1)*grid%pw_grid%para%my_pos+1 - Lg_loc_max = Lg_loc_min+(NLg_loc+1)-1 + Lg_loc_min = (NLg_loc + 1)*grid%pw_grid%para%my_pos + 1 + Lg_loc_max = Lg_loc_min + (NLg_loc + 1) - 1 ELSE - Lg_loc_min = (NLg_loc+1)*n_extra+NLg_loc*(grid%pw_grid%para%my_pos-n_extra)+1 - Lg_loc_max = Lg_loc_min+NLg_loc-1 + Lg_loc_min = (NLg_loc + 1)*n_extra + NLg_loc*(grid%pw_grid%para%my_pos - n_extra) + 1 + Lg_loc_max = Lg_loc_min + NLg_loc - 1 END IF ! shouldn't be necessary Lg_loc_max = MIN(SIZE(Lg), Lg_loc_max) - NLg_loc = Lg_loc_max-Lg_loc_min+1 + NLg_loc = Lg_loc_max - Lg_loc_min + 1 IF (NLg_loc > 0) THEN ! some work for this node - act_nx = MIN(gbo(2, 1), nxlim)-gbo(1, 1)+1 - act_ny = MIN(gbo(2, 2), nylim)-gbo(1, 2)+1 + act_nx = MIN(gbo(2, 1), nxlim) - gbo(1, 1) + 1 + act_ny = MIN(gbo(2, 2), nylim) - gbo(1, 2) + 1 !NB temporaries for DGEMM use ALLOCATE (lhs(act_nx, NLg_loc)) ALLOCATE (rhs(act_ny, NLg_loc)) @@ -252,14 +252,14 @@ SUBROUTINE eval_pw_TabLR(grid, pw_pool, TabLR, Lg, gx, gy, gz, hmat_mm, & ! do cos(gx) cos(gy+gz) term DO i = gbo(1, 1), gbo(2, 1) IF (i > nxlim) CYCLE - lhs(i-gbo(1, 1)+1, 1:NLg_loc) = lg(Lg_loc_min:Lg_loc_max)*cos_gx(Lg_loc_min:Lg_loc_max, i) + lhs(i - gbo(1, 1) + 1, 1:NLg_loc) = lg(Lg_loc_min:Lg_loc_max)*cos_gx(Lg_loc_min:Lg_loc_max, i) END DO DO k = gbo(1, 3), gbo(2, 3) IF (k > nzlim) CYCLE DO j = gbo(1, 2), gbo(2, 2) IF (j > nylim) CYCLE - rhs(j-gbo(1, 2)+1, 1:NLg_loc) = cos_gy(Lg_loc_min:Lg_loc_max, j)*cos_gz(Lg_loc_min:Lg_loc_max, k)- & - sin_gy(Lg_loc_min:Lg_loc_max, j)*sin_gz(Lg_loc_min:Lg_loc_max, k) + rhs(j - gbo(1, 2) + 1, 1:NLg_loc) = cos_gy(Lg_loc_min:Lg_loc_max, j)*cos_gz(Lg_loc_min:Lg_loc_max, k) - & + sin_gy(Lg_loc_min:Lg_loc_max, j)*sin_gz(Lg_loc_min:Lg_loc_max, k) END DO CALL DGEMM('N', 'T', act_nx, act_ny, NLg_loc, 1.0D0, lhs(1, 1), act_nx, rhs(1, 1), act_ny, 0.0D0, & grid%cr3d(gbo(1, 1), gbo(1, 2), k), SIZE(grid%cr3d, 1)) @@ -268,14 +268,14 @@ SUBROUTINE eval_pw_TabLR(grid, pw_pool, TabLR, Lg, gx, gy, gz, hmat_mm, & ! do sin(gx) sin(gy+gz) term DO i = gbo(1, 1), gbo(2, 1) IF (i > nxlim) CYCLE - lhs(i-gbo(1, 1)+1, 1:NLg_loc) = -lg(Lg_loc_min:Lg_loc_max)*sin_gx(Lg_loc_min:Lg_loc_max, i) + lhs(i - gbo(1, 1) + 1, 1:NLg_loc) = -lg(Lg_loc_min:Lg_loc_max)*sin_gx(Lg_loc_min:Lg_loc_max, i) END DO DO k = gbo(1, 3), gbo(2, 3) IF (k > nzlim) CYCLE DO j = gbo(1, 2), gbo(2, 2) IF (j > nylim) CYCLE - rhs(j-gbo(1, 2)+1, 1:NLg_loc) = cos_gy(Lg_loc_min:Lg_loc_max, j)*sin_gz(Lg_loc_min:Lg_loc_max, k)+ & - sin_gy(Lg_loc_min:Lg_loc_max, j)*cos_gz(Lg_loc_min:Lg_loc_max, k) + rhs(j - gbo(1, 2) + 1, 1:NLg_loc) = cos_gy(Lg_loc_min:Lg_loc_max, j)*sin_gz(Lg_loc_min:Lg_loc_max, k) + & + sin_gy(Lg_loc_min:Lg_loc_max, j)*cos_gz(Lg_loc_min:Lg_loc_max, k) END DO CALL DGEMM('N', 'T', act_nx, act_ny, NLg_loc, 1.0D0, lhs(1, 1), act_nx, rhs(1, 1), act_ny, 1.0D0, & grid%cr3d(gbo(1, 1), gbo(1, 2), k), SIZE(grid%cr3d, 1)) @@ -300,13 +300,13 @@ SUBROUTINE eval_pw_TabLR(grid, pw_pool, TabLR, Lg, gx, gy, gz, hmat_mm, & Fake_LoopOnGrid: DO k = gbo(1, 3), gbo(2, 3) my_k = k - IF (k > nzlim) my_k = nzlim-ABS(nzlim-k)+ks + IF (k > nzlim) my_k = nzlim - ABS(nzlim - k) + ks DO j = gbo(1, 2), gbo(2, 2) my_j = j - IF (j > nylim) my_j = nylim-ABS(nylim-j)+js + IF (j > nylim) my_j = nylim - ABS(nylim - j) + js DO i = gbo(1, 1), gbo(2, 1) my_i = i - IF (i > nxlim) my_i = nxlim-ABS(nxlim-i)+is + IF (i > nxlim) my_i = nxlim - ABS(nxlim - i) + is grid%cr3d(i, j, k) = grid%cr3d(my_i, my_j, my_k) END DO END DO @@ -393,7 +393,7 @@ SUBROUTINE check_spline_interp_TabLR(hmat_mm, Lg, gx, gy, gz, TabLR, & WRITE (iw, '(A,T5,A15,4X,A17,T50,4X,A,5X,A,T80,A,T85,A15,4X,A17,T130,4X,A,5X,A)') & "#", "Analytical Term", "Interpolated Term", "Error", "MaxError", & "*", " Analyt Deriv ", "Interp Deriv Mod ", "Error", "MaxError" - DO i = 1, npoints+1 + DO i = 1, npoints + 1 Term = 0.0_dp dxTerm = 0.0_dp dyTerm = 0.0_dp @@ -401,26 +401,26 @@ SUBROUTINE check_spline_interp_TabLR(hmat_mm, Lg, gx, gy, gz, TabLR, & ! Sum over k vectors DO kg = 1, SIZE(Lg) vec = (/REAL(gx(kg), KIND=dp), REAL(gy(kg), KIND=dp), REAL(gz(kg), KIND=dp)/) - Term = Term+lg(kg)*COS(vec(1)*xs1+vec(2)*xs2+vec(3)*xs3) - dxTerm = dxTerm-lg(kg)*SIN(vec(1)*xs1+vec(2)*xs2+vec(3)*xs3)*vec(1) - dyTerm = dyTerm-lg(kg)*SIN(vec(1)*xs1+vec(2)*xs2+vec(3)*xs3)*vec(2) - dzTerm = dzTerm-lg(kg)*SIN(vec(1)*xs1+vec(2)*xs2+vec(3)*xs3)*vec(3) + Term = Term + lg(kg)*COS(vec(1)*xs1 + vec(2)*xs2 + vec(3)*xs3) + dxTerm = dxTerm - lg(kg)*SIN(vec(1)*xs1 + vec(2)*xs2 + vec(3)*xs3)*vec(1) + dyTerm = dyTerm - lg(kg)*SIN(vec(1)*xs1 + vec(2)*xs2 + vec(3)*xs3)*vec(2) + dzTerm = dzTerm - lg(kg)*SIN(vec(1)*xs1 + vec(2)*xs2 + vec(3)*xs3)*vec(3) END DO - Na = SQRT(dxTerm*dxTerm+dyTerm*dyTerm+dzTerm*dzTerm) + Na = SQRT(dxTerm*dxTerm + dyTerm*dyTerm + dzTerm*dzTerm) dn = Eval_d_Interp_Spl3_pbc((/xs1, xs2, xs3/), TabLR) Nn = SQRT(DOT_PRODUCT(dn, dn)) Fterm = Eval_Interp_Spl3_pbc((/xs1, xs2, xs3/), TabLR) - tmp1 = ABS(Term-Fterm) - tmp2 = SQRT(DOT_PRODUCT(dn-(/dxTerm, dyTerm, dzTerm/), dn-(/dxTerm, dyTerm, dzTerm/))) - errf = errf+tmp1 + tmp1 = ABS(Term - Fterm) + tmp2 = SQRT(DOT_PRODUCT(dn - (/dxTerm, dyTerm, dzTerm/), dn - (/dxTerm, dyTerm, dzTerm/))) + errf = errf + tmp1 maxerrorf = MAX(maxerrorf, tmp1) - errd = errd+tmp2 + errd = errd + tmp2 maxerrord = MAX(maxerrord, tmp2) WRITE (iw, '(T5,F15.10,5X,F15.10,T50,2F12.9,T80,A,T85,F15.10,5X,F15.10,T130,2F12.9)') & Term, Fterm, tmp1, maxerrorf, "*", Na, Nn, tmp2, maxerrord - xs1 = xs1+dr1 - xs2 = xs2+dr2 - xs3 = xs3+dr3 + xs1 = xs1 + dr1 + xs2 = xs2 + dr2 + xs3 = xs3 + dr3 END DO WRITE (iw, '(A,T5,A,T50,F12.9,T130,F12.9)') "#", "Averages", errf/REAL(npoints, kind=dp), & errd/REAL(npoints, kind=dp) diff --git a/src/ewalds.F b/src/ewalds.F index 599c625232..32bb72f3a7 100644 --- a/src/ewalds.F +++ b/src/ewalds.F @@ -133,7 +133,7 @@ SUBROUTINE ewald_evaluate(ewald_env, ewald_pw, cell, atomic_kind_set, particle_s nparticle_kind = SIZE(atomic_kind_set) nnodes = 0 DO iparticle_kind = 1, nparticle_kind - nnodes = nnodes+local_particles%n_el(iparticle_kind) + nnodes = nnodes + local_particles%n_el(iparticle_kind) ENDDO CALL structure_factor_allocate(pw_grid%bounds, nnodes, exp_igr) @@ -153,7 +153,7 @@ SUBROUTINE ewald_evaluate(ewald_env, ewald_pw, cell, atomic_kind_set, particle_s nparticle_local = local_particles%n_el(iparticle_kind) IF (use_charge_array) THEN DO iparticle_local = 1, nparticle_local - node = node+1 + node = node + 1 iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) charge(node) = charges(iparticle) CALL matvec_3x3(vec, cell%h_inv, particle_set(iparticle)%r) @@ -164,7 +164,7 @@ SUBROUTINE ewald_evaluate(ewald_env, ewald_pw, cell, atomic_kind_set, particle_s atomic_kind => atomic_kind_set(iparticle_kind) CALL get_atomic_kind(atomic_kind=atomic_kind, qeff=q) DO iparticle_local = 1, nparticle_local - node = node+1 + node = node + 1 iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) charge(node) = q CALL matvec_3x3(vec, cell%h_inv, particle_set(iparticle)%r) @@ -182,13 +182,13 @@ SUBROUTINE ewald_evaluate(ewald_env, ewald_pw, cell, atomic_kind_set, particle_s mp = pw_grid%mapm%pos(pw_grid%g_hat(2, gpt)) np = pw_grid%mapn%pos(pw_grid%g_hat(3, gpt)) - lp = lp+bds(1, 1) - mp = mp+bds(1, 2) - np = np+bds(1, 3) + lp = lp + bds(1, 1) + mp = mp + bds(1, 2) + np = np + bds(1, 3) ! initializing sum to be used in the energy and force DO node = 1, nnodes - summe(gpt) = summe(gpt)+charge(node)* & + summe(gpt) = summe(gpt) + charge(node)* & (exp_igr%ex(lp, node) & *exp_igr%ey(mp, node) & *exp_igr%ez(np, node)) @@ -205,15 +205,15 @@ SUBROUTINE ewald_evaluate(ewald_env, ewald_pw, cell, atomic_kind_set, particle_s mp = pw_grid%mapm%pos(pw_grid%g_hat(2, gpt)) np = pw_grid%mapn%pos(pw_grid%g_hat(3, gpt)) - lp = lp+bds(1, 1) - mp = mp+bds(1, 2) - np = np+bds(1, 3) + lp = lp + bds(1, 1) + mp = mp + bds(1, 2) + np = np + bds(1, 3) IF (pw_grid%gsq(gpt) <= 1.0E-10_dp) CYCLE gauss = (rho0(lp, mp, np)*pw_grid%vol)**2/pw_grid%gsq(gpt) factor = gauss*REAL(summe(gpt)*CONJG(summe(gpt)), KIND=dp) - vg_coulomb = vg_coulomb+factor + vg_coulomb = vg_coulomb + factor ! atomic energies IF (atenergy) THEN @@ -221,7 +221,7 @@ SUBROUTINE ewald_evaluate(ewald_env, ewald_pw, cell, atomic_kind_set, particle_s snode = CONJG(exp_igr%ex(lp, node) & *exp_igr%ey(mp, node) & *exp_igr%ez(np, node)) - e_coulomb(node) = e_coulomb(node)+gauss*charge(node)*REAL(summe(gpt)*snode, KIND=dp) + e_coulomb(node) = e_coulomb(node) + gauss*charge(node)*REAL(summe(gpt)*snode, KIND=dp) END DO END IF @@ -233,21 +233,21 @@ SUBROUTINE ewald_evaluate(ewald_env, ewald_pw, cell, atomic_kind_set, particle_s *exp_igr%ey(mp, node) & *exp_igr%ez(np, node))) fg_coulomb(:, node) = fg_coulomb(:, node) & - +charge(node)*gauss*e_igdotr*pw_grid%g(:, gpt) + + charge(node)*gauss*e_igdotr*pw_grid%g(:, gpt) END DO ! compute the virial P*V - denom = 1.0_dp/four_alpha_sq+1.0_dp/pw_grid%gsq(gpt) + denom = 1.0_dp/four_alpha_sq + 1.0_dp/pw_grid%gsq(gpt) IF (use_virial) THEN - pv_g(1, 1) = pv_g(1, 1)+factor*(1.0_dp-2.0_dp*pw_grid%g(1, gpt)*pw_grid%g(1, gpt)*denom) - pv_g(1, 2) = pv_g(1, 2)-factor*(2.0_dp*pw_grid%g(1, gpt)*pw_grid%g(2, gpt)*denom) - pv_g(1, 3) = pv_g(1, 3)-factor*(2.0_dp*pw_grid%g(1, gpt)*pw_grid%g(3, gpt)*denom) - pv_g(2, 1) = pv_g(2, 1)-factor*(2.0_dp*pw_grid%g(2, gpt)*pw_grid%g(1, gpt)*denom) - pv_g(2, 2) = pv_g(2, 2)+factor*(1.0_dp-2.0_dp*pw_grid%g(2, gpt)*pw_grid%g(2, gpt)*denom) - pv_g(2, 3) = pv_g(2, 3)-factor*(2.0_dp*pw_grid%g(2, gpt)*pw_grid%g(3, gpt)*denom) - pv_g(3, 1) = pv_g(3, 1)-factor*(2.0_dp*pw_grid%g(3, gpt)*pw_grid%g(1, gpt)*denom) - pv_g(3, 2) = pv_g(3, 2)-factor*(2.0_dp*pw_grid%g(3, gpt)*pw_grid%g(2, gpt)*denom) - pv_g(3, 3) = pv_g(3, 3)+factor*(1.0_dp-2.0_dp*pw_grid%g(3, gpt)*pw_grid%g(3, gpt)*denom) + pv_g(1, 1) = pv_g(1, 1) + factor*(1.0_dp - 2.0_dp*pw_grid%g(1, gpt)*pw_grid%g(1, gpt)*denom) + pv_g(1, 2) = pv_g(1, 2) - factor*(2.0_dp*pw_grid%g(1, gpt)*pw_grid%g(2, gpt)*denom) + pv_g(1, 3) = pv_g(1, 3) - factor*(2.0_dp*pw_grid%g(1, gpt)*pw_grid%g(3, gpt)*denom) + pv_g(2, 1) = pv_g(2, 1) - factor*(2.0_dp*pw_grid%g(2, gpt)*pw_grid%g(1, gpt)*denom) + pv_g(2, 2) = pv_g(2, 2) + factor*(1.0_dp - 2.0_dp*pw_grid%g(2, gpt)*pw_grid%g(2, gpt)*denom) + pv_g(2, 3) = pv_g(2, 3) - factor*(2.0_dp*pw_grid%g(2, gpt)*pw_grid%g(3, gpt)*denom) + pv_g(3, 1) = pv_g(3, 1) - factor*(2.0_dp*pw_grid%g(3, gpt)*pw_grid%g(1, gpt)*denom) + pv_g(3, 2) = pv_g(3, 2) - factor*(2.0_dp*pw_grid%g(3, gpt)*pw_grid%g(2, gpt)*denom) + pv_g(3, 3) = pv_g(3, 3) + factor*(1.0_dp - 2.0_dp*pw_grid%g(3, gpt)*pw_grid%g(3, gpt)*denom) END IF IF (atstress) THEN DO node = 1, nnodes @@ -255,15 +255,15 @@ SUBROUTINE ewald_evaluate(ewald_env, ewald_pw, cell, atomic_kind_set, particle_s *exp_igr%ey(mp, node) & *exp_igr%ez(np, node)) factor = gauss*charge(node)*REAL(summe(gpt)*snode, KIND=dp) - pv_coulomb(1, 1, node) = pv_coulomb(1, 1, node)+factor*(1.0_dp-2.0_dp*pw_grid%g(1, gpt)*pw_grid%g(1, gpt)*denom) - pv_coulomb(1, 2, node) = pv_coulomb(1, 2, node)-factor*(2.0_dp*pw_grid%g(1, gpt)*pw_grid%g(2, gpt)*denom) - pv_coulomb(1, 3, node) = pv_coulomb(1, 3, node)-factor*(2.0_dp*pw_grid%g(1, gpt)*pw_grid%g(3, gpt)*denom) - pv_coulomb(2, 1, node) = pv_coulomb(2, 1, node)-factor*(2.0_dp*pw_grid%g(2, gpt)*pw_grid%g(1, gpt)*denom) - pv_coulomb(2, 2, node) = pv_coulomb(2, 2, node)+factor*(1.0_dp-2.0_dp*pw_grid%g(2, gpt)*pw_grid%g(2, gpt)*denom) - pv_coulomb(2, 3, node) = pv_coulomb(2, 3, node)-factor*(2.0_dp*pw_grid%g(2, gpt)*pw_grid%g(3, gpt)*denom) - pv_coulomb(3, 1, node) = pv_coulomb(3, 1, node)-factor*(2.0_dp*pw_grid%g(3, gpt)*pw_grid%g(1, gpt)*denom) - pv_coulomb(3, 2, node) = pv_coulomb(3, 2, node)-factor*(2.0_dp*pw_grid%g(3, gpt)*pw_grid%g(2, gpt)*denom) - pv_coulomb(3, 3, node) = pv_coulomb(3, 3, node)+factor*(1.0_dp-2.0_dp*pw_grid%g(3, gpt)*pw_grid%g(3, gpt)*denom) + pv_coulomb(1, 1, node) = pv_coulomb(1, 1, node) + factor*(1.0_dp - 2.0_dp*pw_grid%g(1, gpt)*pw_grid%g(1, gpt)*denom) + pv_coulomb(1, 2, node) = pv_coulomb(1, 2, node) - factor*(2.0_dp*pw_grid%g(1, gpt)*pw_grid%g(2, gpt)*denom) + pv_coulomb(1, 3, node) = pv_coulomb(1, 3, node) - factor*(2.0_dp*pw_grid%g(1, gpt)*pw_grid%g(3, gpt)*denom) + pv_coulomb(2, 1, node) = pv_coulomb(2, 1, node) - factor*(2.0_dp*pw_grid%g(2, gpt)*pw_grid%g(1, gpt)*denom) + pv_coulomb(2, 2, node) = pv_coulomb(2, 2, node) + factor*(1.0_dp - 2.0_dp*pw_grid%g(2, gpt)*pw_grid%g(2, gpt)*denom) + pv_coulomb(2, 3, node) = pv_coulomb(2, 3, node) - factor*(2.0_dp*pw_grid%g(2, gpt)*pw_grid%g(3, gpt)*denom) + pv_coulomb(3, 1, node) = pv_coulomb(3, 1, node) - factor*(2.0_dp*pw_grid%g(3, gpt)*pw_grid%g(1, gpt)*denom) + pv_coulomb(3, 2, node) = pv_coulomb(3, 2, node) - factor*(2.0_dp*pw_grid%g(3, gpt)*pw_grid%g(2, gpt)*denom) + pv_coulomb(3, 3, node) = pv_coulomb(3, 3, node) + factor*(1.0_dp - 2.0_dp*pw_grid%g(3, gpt)*pw_grid%g(3, gpt)*denom) END DO END IF END DO @@ -344,17 +344,17 @@ SUBROUTINE ewald_self(ewald_env, cell, atomic_kind_set, local_particles, e_self, CALL get_shell(shell=shell, charge_core=qcore, charge_shell=qshell) ! MI: the core-shell ES interaction, when core and shell belong to the same ion, is excluded ! in the nonbond correction term. Therefore, here the self interaction is computed entirely - q_self = q_self+qcore*qcore*nparticle_local+qshell*qshell*nparticle_local - q_sum = q_sum+qcore*nparticle_local+qshell*nparticle_local + q_self = q_self + qcore*qcore*nparticle_local + qshell*qshell*nparticle_local + q_sum = q_sum + qcore*nparticle_local + qshell*nparticle_local IF (mm_radius > 0) THEN ! the core is always a point charge - q_neutg = q_neutg+2.0_dp*qshell*mm_radius**2 + q_neutg = q_neutg + 2.0_dp*qshell*mm_radius**2 END IF ELSE - q_self = q_self+q*q*nparticle_local - q_sum = q_sum+q*nparticle_local + q_self = q_self + q*q*nparticle_local + q_sum = q_sum + q*nparticle_local IF (mm_radius > 0) THEN - q_neutg = q_neutg+2.0_dp*q*mm_radius**2 + q_neutg = q_neutg + 2.0_dp*q*mm_radius**2 END IF END IF END DO @@ -367,7 +367,7 @@ SUBROUTINE ewald_self(ewald_env, cell, atomic_kind_set, local_particles, e_self, e_self = 0.0_dp IF (ewald_type /= do_ewald_none) THEN e_self = -q_self*alpha*oorootpi - e_neut = -q_sum*pi/(2.0_dp*cell%deth)*(q_sum/alpha**2-q_neutg) + e_neut = -q_sum*pi/(2.0_dp*cell%deth)*(q_sum/alpha**2 - q_neutg) END IF END SUBROUTINE ewald_self @@ -421,12 +421,12 @@ SUBROUTINE ewald_self_atom(ewald_env, atomic_kind_set, local_particles, e_self, CALL get_shell(shell=shell, charge_core=qcore, charge_shell=qshell) DO iparticle_local = 1, nparticle_local ii = local_particles%list(iparticle_kind)%array(iparticle_local) - e_self(ii) = e_self(ii)-(qcore*qcore+qshell*qshell)*fself + e_self(ii) = e_self(ii) - (qcore*qcore + qshell*qshell)*fself END DO ELSE DO iparticle_local = 1, nparticle_local ii = local_particles%list(iparticle_kind)%array(iparticle_local) - e_self(ii) = e_self(ii)-q*q*fself + e_self(ii) = e_self(ii) - q*q*fself END DO END IF END DO diff --git a/src/external_potential_methods.F b/src/external_potential_methods.F index e8a62bec68..81c6b9e8ae 100644 --- a/src/external_potential_methods.F +++ b/src/external_potential_methods.F @@ -94,9 +94,9 @@ SUBROUTINE add_external_potential(force_env) CALL section_vals_val_get(ext_pot_section, "ATOMS_LIST", n_rep_val=a_var, i_rep_section=rep) DO k = 1, a_var CALL section_vals_val_get(ext_pot_section, "ATOMS_LIST", i_rep_val=k, i_vals=iatms, i_rep_section=rep) - CALL reallocate(nparticle, 1, natom+SIZE(iatms)) - nparticle(natom+1:natom+SIZE(iatms)) = iatms - natom = natom+SIZE(iatms) + CALL reallocate(nparticle, 1, natom + SIZE(iatms)) + nparticle(natom + 1:natom + SIZE(iatms)) = iatms + natom = natom + SIZE(iatms) END DO IF (a_var == 0) THEN natom = particles%n_els @@ -112,7 +112,7 @@ SUBROUTINE add_external_potential(force_env) my_val(2) = particles%els(iatom)%r(2) my_val(3) = particles%els(iatom)%r(3) - energy = energy+evalf(1, my_val) + energy = energy + evalf(1, my_val) DO j = 1, 3 dedf = evalfd(1, j, my_val, dx, err) IF (ABS(err) > lerr) THEN @@ -125,7 +125,7 @@ SUBROUTINE add_external_potential(force_env) ' Error '//TRIM(this_error)//' in computing numerical derivatives larger then'// & TRIM(def_error)//' .') END IF - particles%els(iatom)%f(j) = particles%els(iatom)%f(j)-dedf + particles%els(iatom)%f(j) = particles%els(iatom)%f(j) - dedf END DO END DO CALL force_env_set(force_env, additional_potential=energy) diff --git a/src/f77_interface.F b/src/f77_interface.F index 74b4dc585d..6eab0d1131 100644 --- a/src/f77_interface.F +++ b/src/f77_interface.F @@ -673,13 +673,13 @@ RECURSIVE SUBROUTINE create_force_env(new_env_id, input_declaration, input_path, root_section => input_file CALL section_vals_retain(root_section) - IF (n_f_envs+1 > SIZE(f_envs)) THEN + IF (n_f_envs + 1 > SIZE(f_envs)) THEN f_envs_old => f_envs - ALLOCATE (f_envs(n_f_envs+10)) + ALLOCATE (f_envs(n_f_envs + 10)) DO i = 1, n_f_envs f_envs(i)%f_env => f_envs_old(i)%f_env END DO - DO i = n_f_envs+1, SIZE(f_envs) + DO i = n_f_envs + 1, SIZE(f_envs) NULLIFY (f_envs(i)%f_env) END DO DEALLOCATE (f_envs_old) @@ -689,7 +689,7 @@ RECURSIVE SUBROUTINE create_force_env(new_env_id, input_declaration, input_path, CALL cp2k_setup(root_section, para_env, globenv) ! Group Distribution - ALLOCATE (group_distribution(0:para_env%num_pe-1)) + ALLOCATE (group_distribution(0:para_env%num_pe - 1)) group_distribution = 0 lgroup_distribution => group_distribution ! Setup all possible force_env @@ -705,7 +705,7 @@ RECURSIVE SUBROUTINE create_force_env(new_env_id, input_declaration, input_path, CALL section_vals_remove_values(wrk_section) END DO END IF - nsubforce_size = nforce_eval-1 + nsubforce_size = nforce_eval - 1 use_multiple_para_env = .FALSE. use_motion_section = .TRUE. DO iforce_eval = 1, nforce_eval @@ -731,11 +731,11 @@ RECURSIVE SUBROUTINE create_force_env(new_env_id, input_declaration, input_path, CPASSERT(check) ngroups = force_env%mixed_env%ngroups my_group = lgroup_distribution(para_env%mepos) - isubforce_eval = iforce_eval-1 + isubforce_eval = iforce_eval - 1 ! If task not allocated on this procs skip setup.. - IF (MODULO(isubforce_eval-1, ngroups) /= my_group) CYCLE - my_para_env => force_env%mixed_env%sub_para_env(my_group+1)%para_env - my_logger => force_env%mixed_env%sub_logger(my_group+1)%p + IF (MODULO(isubforce_eval - 1, ngroups) /= my_group) CYCLE + my_para_env => force_env%mixed_env%sub_para_env(my_group + 1)%para_env + my_logger => force_env%mixed_env%sub_logger(my_group + 1)%p CALL cp_rm_default_logger() CALL cp_add_default_logger(my_logger) ENDIF @@ -744,11 +744,11 @@ RECURSIVE SUBROUTINE create_force_env(new_env_id, input_declaration, input_path, CPASSERT(check) ngroups = force_env%embed_env%ngroups my_group = lgroup_distribution(para_env%mepos) - isubforce_eval = iforce_eval-1 + isubforce_eval = iforce_eval - 1 ! If task not allocated on this procs skip setup.. - IF (MODULO(isubforce_eval-1, ngroups) /= my_group) CYCLE - my_para_env => force_env%embed_env%sub_para_env(my_group+1)%para_env - my_logger => force_env%embed_env%sub_logger(my_group+1)%p + IF (MODULO(isubforce_eval - 1, ngroups) /= my_group) CYCLE + my_para_env => force_env%embed_env%sub_para_env(my_group + 1)%para_env + my_logger => force_env%embed_env%sub_logger(my_group + 1)%p CALL cp_rm_default_logger() CALL cp_add_default_logger(my_logger) ENDIF @@ -882,7 +882,7 @@ RECURSIVE SUBROUTINE create_force_env(new_env_id, input_declaration, input_path, IF (iforce_eval == 1) THEN force_env => my_force_env ELSE - force_env%sub_force_env(iforce_eval-1)%force_env => my_force_env + force_env%sub_force_env(iforce_eval - 1)%force_env => my_force_env END IF ! Multiple para env for sub_force_eval IF (.NOT. use_multiple_para_env) THEN @@ -898,9 +898,9 @@ RECURSIVE SUBROUTINE create_force_env(new_env_id, input_declaration, input_path, timer_env => get_timer_env() mp_perf_env => get_mp_perf_env() CALL mp_max(last_f_env_id, para_env%group) - last_f_env_id = last_f_env_id+1 + last_f_env_id = last_f_env_id + 1 new_env_id = last_f_env_id - n_f_envs = n_f_envs+1 + n_f_envs = n_f_envs + 1 CALL f_env_create(f_envs(n_f_envs)%f_env, logger=logger, & timer_env=timer_env, mp_perf_env=mp_perf_env, force_env=force_env, & id_nr=last_f_env_id, old_dir=old_dir) @@ -943,11 +943,11 @@ RECURSIVE SUBROUTINE destroy_force_env(env_id, ierr, q_finalize) NULLIFY (f_env) CALL f_env_add_defaults(env_id, f_env) env_pos = get_pos_of_env(env_id) - n_f_envs = n_f_envs-1 + n_f_envs = n_f_envs - 1 DO i = env_pos, n_f_envs - f_envs(i)%f_env => f_envs(i+1)%f_env + f_envs(i)%f_env => f_envs(i + 1)%f_env END DO - NULLIFY (f_envs(n_f_envs+1)%f_env) + NULLIFY (f_envs(n_f_envs + 1)%f_env) CALL force_env_get(f_env%force_env, globenv=globenv, & root_section=root_section, para_env=para_env) diff --git a/src/farming_methods.F b/src/farming_methods.F index 7e78c95732..cf9daadf6c 100644 --- a/src/farming_methods.F +++ b/src/farming_methods.F @@ -58,12 +58,12 @@ SUBROUTINE get_next_job(farming_env, start, END, current, todo) IF (current < start) THEN current = start ELSE - current = current+1 + current = current + 1 ENDIF IF (current > END) THEN todo = do_nothing ELSE - todo = MODULO(current-1, farming_env%njobs)+1 + todo = MODULO(current - 1, farming_env%njobs) + 1 ENDIF ELSE ! find a pending job @@ -149,7 +149,7 @@ SUBROUTINE farming_parse_input(farming_env, root_section, para_env) IF (n_rep_val > 0) THEN CALL section_vals_val_get(farming_section, "GROUP_PARTITION", & i_vals=i_vals) - ALLOCATE (farming_env%group_partition(0:SIZE(i_vals)-1)) + ALLOCATE (farming_env%group_partition(0:SIZE(i_vals) - 1)) farming_env%group_partition(:) = i_vals farming_env%ngroup_wish_set = .TRUE. farming_env%ngroup_wish = SIZE(i_vals) @@ -245,7 +245,7 @@ SUBROUTINE farming_parse_input(farming_env, root_section, para_env) WRITE (output_unit, FMT="(T2,A)") "FARMING| Master-slave setup not support for serial runs" ENDIF IF (farming_env%master_slave) THEN - num_slaves = para_env%num_pe-1 + num_slaves = para_env%num_pe - 1 ELSE num_slaves = para_env%num_pe ENDIF @@ -256,7 +256,7 @@ SUBROUTINE farming_parse_input(farming_env, root_section, para_env) WRITE (output_unit, FMT="(T2,A,T71,I10)") "FARMING| Ngroup wish:", farming_env%ngroup_wish IF (ASSOCIATED(farming_env%group_partition)) THEN WRITE (output_unit, FMT="(T2,A)", ADVANCE="NO") "FARMING| User partition:" - DO i = 0, SIZE(farming_env%group_partition)-1 + DO i = 0, SIZE(farming_env%group_partition) - 1 IF (MODULO(i, 4) == 0) WRITE (output_unit, *) WRITE (output_unit, FMT='(I4)', ADVANCE="NO") farming_env%group_partition(i) END DO diff --git a/src/fermi_utils.F b/src/fermi_utils.F index 361382e5c9..9f300d888b 100644 --- a/src/fermi_utils.F +++ b/src/fermi_utils.F @@ -72,30 +72,30 @@ SUBROUTINE Fermi(f, N, kTS, e, mu, T, maxocc, estate, festate) END IF ! have the result of exp go to zero instead of overflowing IF (e(i) > mu) THEN - arg = -(e(i)-mu)/T + arg = -(e(i) - mu)/T ! tmp is smaller than 1 tmp = EXP(arg) - tmp4 = tmp+1.0_dp + tmp4 = tmp + 1.0_dp tmp2 = tmp/tmp4 tmp3 = 1.0_dp/tmp4 ! log(1+eps), might need to be written more accurately tmplog = -LOG(tmp4) - term1 = tmp2*(arg+tmplog) + term1 = tmp2*(arg + tmplog) term2 = tmp3*tmplog ELSE - arg = (e(i)-mu)/T + arg = (e(i) - mu)/T ! tmp is smaller than 1 tmp = EXP(arg) - tmp4 = tmp+1.0_dp + tmp4 = tmp + 1.0_dp tmp2 = 1.0_dp/tmp4 tmp3 = tmp/tmp4 tmplog = -LOG(tmp4) term1 = tmp2*tmplog - term2 = tmp3*(arg+tmplog) + term2 = tmp3*(arg + tmplog) END IF f(i) = occupation*tmp2 - kTS = kTS+T*occupation*(term1+term2) + kTS = kTS + T*occupation*(term1 + term2) END DO N = accurate_sum(f) @@ -138,27 +138,27 @@ SUBROUTINE Fermi2(f, nel, kTS, e, mu, wk, t, maxocc) DO ik = 1, nkp DO is = 1, nmo IF (e(is, ik) > mu) THEN - arg = -(e(is, ik)-mu)*beta + arg = -(e(is, ik) - mu)*beta tmp = EXP(arg) - tmp4 = tmp+1.0_dp + tmp4 = tmp + 1.0_dp tmp2 = tmp/tmp4 tmp3 = 1.0_dp/tmp4 tmplog = -LOG(tmp4) - term1 = tmp2*(arg+tmplog) + term1 = tmp2*(arg + tmplog) term2 = tmp3*tmplog ELSE - arg = (e(is, ik)-mu)*beta + arg = (e(is, ik) - mu)*beta tmp = EXP(arg) - tmp4 = tmp+1.0_dp + tmp4 = tmp + 1.0_dp tmp2 = 1.0_dp/tmp4 tmp3 = tmp/tmp4 tmplog = -LOG(tmp4) term1 = tmp2*tmplog - term2 = tmp3*(arg+tmplog) + term2 = tmp3*(arg + tmplog) END IF f(is, ik) = maxocc*tmp2 - kTS = kTS+t*maxocc*(term1+term2)*wk(ik) + kTS = kTS + t*maxocc*(term1 + term2)*wk(ik) END DO END DO ELSE @@ -175,7 +175,7 @@ SUBROUTINE Fermi2(f, nel, kTS, e, mu, wk, t, maxocc) nel = 0.0_dp DO ik = 1, nkp - nel = nel+accurate_sum(f(1:nmo, ik))*wk(ik) + nel = nel + accurate_sum(f(1:nmo, ik))*wk(ik) END DO END SUBROUTINE Fermi2 @@ -226,10 +226,10 @@ SUBROUTINE FermiFixed(f, mu, kTS, e, N, T, maxocc, estate, festate) mu_min = MINVAL(e) iter = 0 DO - iter = iter+1 + iter = iter + 1 CALL Fermi(f, N_min, kTS, e, mu_min, T, maxocc, my_estate, my_festate) IF (N_min > N .OR. iter > 20) THEN - mu_min = mu_min-T + mu_min = mu_min - T ELSE EXIT ENDIF @@ -238,10 +238,10 @@ SUBROUTINE FermiFixed(f, mu, kTS, e, N, T, maxocc, estate, festate) mu_max = MAXVAL(e) iter = 0 DO - iter = iter+1 + iter = iter + 1 CALL Fermi(f, N_max, kTS, e, mu_max, T, maxocc, my_estate, my_festate) IF (N_max < N .OR. iter > 20) THEN - mu_max = mu_max+T + mu_max = mu_max + T ELSE EXIT ENDIF @@ -249,11 +249,11 @@ SUBROUTINE FermiFixed(f, mu, kTS, e, N, T, maxocc, estate, festate) ! now bisect iter = 0 - DO WHILE (mu_max-mu_min > EPSILON(mu)*MAX(1.0_dp, ABS(mu_max), ABS(mu_min))) - iter = iter+1 - mu_now = (mu_max+mu_min)/2.0_dp + DO WHILE (mu_max - mu_min > EPSILON(mu)*MAX(1.0_dp, ABS(mu_max), ABS(mu_min))) + iter = iter + 1 + mu_now = (mu_max + mu_min)/2.0_dp CALL Fermi(f, N_now, kTS, e, mu_now, T, maxocc, my_estate, my_festate) - iter = iter+1 + iter = iter + 1 IF (N_now <= N) THEN mu_min = mu_now @@ -267,7 +267,7 @@ SUBROUTINE FermiFixed(f, mu, kTS, e, N, T, maxocc, estate, festate) ENDIF ENDDO - mu = (mu_max+mu_min)/2.0_dp + mu = (mu_max + mu_min)/2.0_dp CALL Fermi(f, N_now, kTS, e, mu, T, maxocc, my_estate, my_festate) END SUBROUTINE FermiFixed @@ -298,17 +298,17 @@ SUBROUTINE Fermikp(f, mu, kTS, e, nel, wk, t, maxocc) REAL(KIND=dp) :: de, mu_max, mu_min, N_now ! bisection search to find mu for a given nel - de = t*LOG((1.0_dp-epsocc)/epsocc) + de = t*LOG((1.0_dp - epsocc)/epsocc) de = MAX(de, 0.5_dp) - mu_min = MINVAL(e)-de - mu_max = MAXVAL(e)+de + mu_min = MINVAL(e) - de + mu_max = MAXVAL(e) + de iter = 0 - DO WHILE (mu_max-mu_min > EPSILON(mu)*MAX(1.0_dp, ABS(mu_max), ABS(mu_min))) - iter = iter+1 - mu = (mu_max+mu_min)/2.0_dp + DO WHILE (mu_max - mu_min > EPSILON(mu)*MAX(1.0_dp, ABS(mu_max), ABS(mu_min))) + iter = iter + 1 + mu = (mu_max + mu_min)/2.0_dp CALL Fermi2(f, N_now, kTS, e, mu, wk, t, maxocc) - IF (ABS(N_now-nel) < nel*epsocc) EXIT + IF (ABS(N_now - nel) < nel*epsocc) EXIT IF (N_now <= nel) THEN mu_min = mu @@ -322,7 +322,7 @@ SUBROUTINE Fermikp(f, mu, kTS, e, nel, wk, t, maxocc) ENDIF ENDDO - mu = (mu_max+mu_min)/2.0_dp + mu = (mu_max + mu_min)/2.0_dp CALL Fermi2(f, N_now, kTS, e, mu, wk, t, maxocc) END SUBROUTINE Fermikp @@ -356,19 +356,19 @@ SUBROUTINE Fermikp2(f, mu, kTS, e, nel, wk, t) CPASSERT(SIZE(f, 3) == 2 .AND. SIZE(e, 3) == 2) ! bisection search to find mu for a given nel - de = t*LOG((1.0_dp-epsocc)/epsocc) + de = t*LOG((1.0_dp - epsocc)/epsocc) de = MAX(de, 0.5_dp) - mu_min = MINVAL(e)-de - mu_max = MAXVAL(e)+de + mu_min = MINVAL(e) - de + mu_max = MAXVAL(e) + de iter = 0 - DO WHILE (mu_max-mu_min > EPSILON(mu)*MAX(1.0_dp, ABS(mu_max), ABS(mu_min))) - iter = iter+1 - mu = (mu_max+mu_min)/2.0_dp + DO WHILE (mu_max - mu_min > EPSILON(mu)*MAX(1.0_dp, ABS(mu_max), ABS(mu_min))) + iter = iter + 1 + mu = (mu_max + mu_min)/2.0_dp CALL Fermi2(f(:, :, 1), na, kTSa, e(:, :, 1), mu, wk, t, 1.0_dp) CALL Fermi2(f(:, :, 2), nb, kTSb, e(:, :, 2), mu, wk, t, 1.0_dp) - N_now = na+nb + N_now = na + nb - IF (ABS(N_now-nel) < nel*epsocc) EXIT + IF (ABS(N_now - nel) < nel*epsocc) EXIT IF (N_now <= nel) THEN mu_min = mu @@ -382,10 +382,10 @@ SUBROUTINE Fermikp2(f, mu, kTS, e, nel, wk, t) ENDIF ENDDO - mu = (mu_max+mu_min)/2.0_dp + mu = (mu_max + mu_min)/2.0_dp CALL Fermi2(f(:, :, 1), na, kTSa, e(:, :, 1), mu, wk, t, 1.0_dp) CALL Fermi2(f(:, :, 2), nb, kTSb, e(:, :, 2), mu, wk, t, 1.0_dp) - kTS = kTSa+kTSb + kTS = kTSa + kTSb END SUBROUTINE Fermikp2 @@ -452,12 +452,12 @@ SUBROUTINE FermiFixedDeriv(dfde, f, mu, kTS, e, N, T, maxocc, l, estate, festate ! write(*,*) h,(e(i)+h)-e(i),(e(i)-h)-e(i) ! and the symmetric finite difference ex(:) = e - ex(i) = e(i)+h + ex(i) = e(i) + h CALL FermiFixed(fx, mux, kTS, ex, N, T, maxocc, my_estate, my_festate) dfde(:, I) = fx - ex(i) = e(i)-h + ex(i) = e(i) - h CALL FermiFixed(fx, mux, kTS, ex, N, T, maxocc, my_estate, my_festate) - dfde(:, I) = (dfde(:, I)-fx)/(2.0_dp*h) + dfde(:, I) = (dfde(:, I) - fx)/(2.0_dp*h) ENDDO DEALLOCATE (ex, fx) diff --git a/src/fist_efield_methods.F b/src/fist_efield_methods.F index ec6dae5e45..d3b9dcb030 100644 --- a/src/fist_efield_methods.F +++ b/src/fist_efield_methods.F @@ -135,8 +135,8 @@ SUBROUTINE fist_efield_energy_force(qenergy, qforce, qpv, atomic_kind_set, parti ! E = (omega/8Pi)(D - 4Pi*P)^2 di = dipole/cell%deth DO i = 1, 3 - theta = fieldpol(i)-2._dp*twopi*di(i) - qenergy = qenergy+dfilter(i)*theta**2 + theta = fieldpol(i) - 2._dp*twopi*di(i) + qenergy = qenergy + dfilter(i)*theta**2 fq(i) = -dfilter(i)*theta END DO qenergy = 0.25_dp*cell%deth/twopi*qenergy @@ -160,7 +160,7 @@ SUBROUTINE fist_efield_energy_force(qenergy, qforce, qpv, atomic_kind_set, parti ria = particle_set(ii)%r(:) ria = pbc(ria, cell) DO j = 1, 3 - qpv(j, 1:3) = qpv(j, 1:3)+qforce(j, ii)*ria(1:3) + qpv(j, 1:3) = qpv(j, 1:3) + qforce(j, ii)*ria(1:3) END DO END DO END DO @@ -235,14 +235,14 @@ SUBROUTINE fist_dipole(fist_env, print_section, atomic_kind_set, particle_set, & DO i = 1, SIZE(particle_set) atomic_kind => particle_set(i)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, qeff=q) - charge_tot = charge_tot+q + charge_tot = charge_tot + q END DO END IF ria = twopi*MATMUL(cell%h_inv, rcc) zphase = CMPLX(COS(ria), SIN(ria), dp)**charge_tot dria = twopi*MATMUL(cell%h_inv, drcc) - dzphase = charge_tot*CMPLX(-SIN(ria), COS(ria), dp)**(charge_tot-1.0_dp)*dria + dzphase = charge_tot*CMPLX(-SIN(ria), COS(ria), dp)**(charge_tot - 1.0_dp)*dria ggamma = CMPLX(1.0_dp, 0.0_dp, KIND=dp) dggamma = CMPLX(0.0_dp, 0.0_dp, KIND=dp) @@ -260,19 +260,19 @@ SUBROUTINE fist_dipole(fist_env, print_section, atomic_kind_set, particle_set, & theta = SUM(ria(:)*gvec(:)) dtheta = SUM(via(:)*gvec(:)) zeta = CMPLX(COS(theta), SIN(theta), KIND=dp)**(-q) - dzeta = -q*CMPLX(-SIN(theta), COS(theta), KIND=dp)**(-q-1.0_dp)*dtheta - dggamma(j) = dggamma(j)*zeta+ggamma(j)*dzeta + dzeta = -q*CMPLX(-SIN(theta), COS(theta), KIND=dp)**(-q - 1.0_dp)*dtheta + dggamma(j) = dggamma(j)*zeta + ggamma(j)*dzeta ggamma(j) = ggamma(j)*zeta END DO ENDDO END DO - dggamma = dggamma*zphase+ggamma*dzphase + dggamma = dggamma*zphase + ggamma*dzphase ggamma = ggamma*zphase IF (ALL(REAL(ggamma, KIND=dp) /= 0.0_dp)) THEN tmp = AIMAG(ggamma)/REAL(ggamma, KIND=dp) ci = ATAN(tmp) - dci = (1.0_dp/(1.0_dp+tmp**2))* & - (AIMAG(dggamma)*REAL(ggamma, KIND=dp)-AIMAG(ggamma)*REAL(dggamma, KIND=dp))/(REAL(ggamma, KIND=dp))**2 + dci = (1.0_dp/(1.0_dp + tmp**2))* & + (AIMAG(dggamma)*REAL(ggamma, KIND=dp) - AIMAG(ggamma)*REAL(dggamma, KIND=dp))/(REAL(ggamma, KIND=dp))**2 dipole = MATMUL(cell%hmat, ci)/twopi dipole_deriv = MATMUL(cell%hmat, dci)/twopi @@ -288,8 +288,8 @@ SUBROUTINE fist_dipole(fist_env, print_section, atomic_kind_set, particle_set, & ! is the sum of the molecular dipoles CALL get_atomic_kind(atomic_kind=atomic_kind, qeff=q) IF (use_charges) q = charges(i) - dipole = dipole-q*(ria-rcc) - dipole_deriv(:) = dipole_deriv(:)-q*(particle_set(i)%v(:)-drcc) + dipole = dipole - q*(ria - rcc) + dipole_deriv(:) = dipole_deriv(:) - q*(particle_set(i)%v(:) - drcc) END DO CALL fist_env_get(fist_env=fist_env, results=results) CALL cp_results_erase(results, description) diff --git a/src/fist_environment_types.F b/src/fist_environment_types.F index 90275fcf27..f5fd0658d7 100644 --- a/src/fist_environment_types.F +++ b/src/fist_environment_types.F @@ -260,7 +260,7 @@ SUBROUTINE init_fist_env(fist_env, para_env) CALL cp_para_env_retain(para_env) fist_env%para_env => para_env fist_env%ref_count = 1 - last_fist_env_id_nr = last_fist_env_id_nr+1 + last_fist_env_id_nr = last_fist_env_id_nr + 1 fist_env%id_nr = last_fist_env_id_nr END SUBROUTINE init_fist_env @@ -444,7 +444,7 @@ SUBROUTINE fist_env_retain(fist_env) CPASSERT(ASSOCIATED(fist_env)) CPASSERT(fist_env%ref_count > 0) - fist_env%ref_count = fist_env%ref_count+1 + fist_env%ref_count = fist_env%ref_count + 1 END SUBROUTINE fist_env_retain ! ************************************************************************************************** @@ -462,7 +462,7 @@ SUBROUTINE fist_env_release(fist_env) IF (ASSOCIATED(fist_env)) THEN CPASSERT(fist_env%ref_count > 0) - fist_env%ref_count = fist_env%ref_count-1 + fist_env%ref_count = fist_env%ref_count - 1 IF (fist_env%ref_count < 1) THEN CALL qmmm_env_mm_release(fist_env%qmmm_env) CALL cell_release(fist_env%cell_ref) diff --git a/src/fist_force.F b/src/fist_force.F index f4105e9b7b..d5cc5d8af2 100644 --- a/src/fist_force.F +++ b/src/fist_force.F @@ -202,7 +202,7 @@ SUBROUTINE fist_calc_energy_force(fist_env, debug) nlocal_particles = 0 nparticle_kind = SIZE(atomic_kind_set) DO ikind = 1, nparticle_kind - nlocal_particles = nlocal_particles+local_particles%n_el(ikind) + nlocal_particles = nlocal_particles + local_particles%n_el(ikind) ENDDO ALLOCATE (f_nonbond(3, natoms)) @@ -349,7 +349,7 @@ SUBROUTINE fist_calc_energy_force(fist_env, debug) IF (atprop_env%energy) THEN CALL ewald_self_atom(ewald_env, atomic_kind_set, local_particles, & atprop_env%atener, fist_nonbond_env%charges) - atprop_env%atener = atprop_env%atener+thermo%e_neut/SIZE(atprop_env%atener) + atprop_env%atener = atprop_env%atener + thermo%e_neut/SIZE(atprop_env%atener) END IF END IF @@ -582,8 +582,8 @@ SUBROUTINE fist_calc_energy_force(fist_env, debug) END IF ! add up all the potential energies - thermo%pot = pot_nonbond+pot_bond+pot_bend+pot_torsion+pot_opbend+ & - pot_imptors+pot_urey_bradley+pot_manybody+pot_shell + thermo%pot = pot_nonbond + pot_bond + pot_bend + pot_torsion + pot_opbend + & + pot_imptors + pot_urey_bradley + pot_manybody + pot_shell CALL mp_sum(thermo%pot, para_env%group) @@ -596,10 +596,10 @@ SUBROUTINE fist_calc_energy_force(fist_env, debug) ! e_self, e_neut, and ebonded are already summed over all processors ! vg_coulomb is not calculated in parallel thermo%e_gspace = vg_coulomb - thermo%pot = thermo%pot+thermo%e_self+thermo%e_neut - thermo%pot = thermo%pot+vg_coulomb+thermo%e_bonded + thermo%pot = thermo%pot + thermo%e_self + thermo%e_neut + thermo%pot = thermo%pot + vg_coulomb + thermo%e_bonded ! add the induction energy of the dipoles for polarizable models - IF (do_ipol /= do_fist_pol_none) thermo%pot = thermo%pot+thermo%e_induction + IF (do_ipol /= do_fist_pol_none) thermo%pot = thermo%pot + thermo%e_induction END IF ! add up all the forces @@ -611,9 +611,9 @@ SUBROUTINE fist_calc_energy_force(fist_env, debug) ALLOCATE (f_total(3, natoms)) f_total = 0.0_dp DO i = 1, natoms - f_total(1, i) = particle_set(i)%f(1)+f_nonbond(1, i) - f_total(2, i) = particle_set(i)%f(2)+f_nonbond(2, i) - f_total(3, i) = particle_set(i)%f(3)+f_nonbond(3, i) + f_total(1, i) = particle_set(i)%f(1) + f_nonbond(1, i) + f_total(2, i) = particle_set(i)%f(2) + f_nonbond(2, i) + f_total(3, i) = particle_set(i)%f(3) + f_nonbond(3, i) END DO IF (shell_present) THEN ALLOCATE (fshell_total(3, nshell)) @@ -621,12 +621,12 @@ SUBROUTINE fist_calc_energy_force(fist_env, debug) ALLOCATE (fcore_total(3, nshell)) fcore_total = 0.0_dp DO i = 1, nshell - fcore_total(1, i) = core_particle_set(i)%f(1)+fcore_nonbond(1, i) - fcore_total(2, i) = core_particle_set(i)%f(2)+fcore_nonbond(2, i) - fcore_total(3, i) = core_particle_set(i)%f(3)+fcore_nonbond(3, i) - fshell_total(1, i) = shell_particle_set(i)%f(1)+fshell_nonbond(1, i) - fshell_total(2, i) = shell_particle_set(i)%f(2)+fshell_nonbond(2, i) - fshell_total(3, i) = shell_particle_set(i)%f(3)+fshell_nonbond(3, i) + fcore_total(1, i) = core_particle_set(i)%f(1) + fcore_nonbond(1, i) + fcore_total(2, i) = core_particle_set(i)%f(2) + fcore_nonbond(2, i) + fcore_total(3, i) = core_particle_set(i)%f(3) + fcore_nonbond(3, i) + fshell_total(1, i) = shell_particle_set(i)%f(1) + fshell_nonbond(1, i) + fshell_total(2, i) = shell_particle_set(i)%f(2) + fshell_nonbond(2, i) + fshell_total(3, i) = shell_particle_set(i)%f(3) + fshell_nonbond(3, i) END DO END IF @@ -648,20 +648,20 @@ SUBROUTINE fist_calc_energy_force(fist_env, debug) nparticle_local = local_particles%n_el(iparticle_kind) DO iparticle_local = 1, nparticle_local ii = local_particles%list(iparticle_kind)%array(iparticle_local) - node = node+1 - f_total(1, ii) = f_total(1, ii)+fg_coulomb(1, node) - f_total(2, ii) = f_total(2, ii)+fg_coulomb(2, node) - f_total(3, ii) = f_total(3, ii)+fg_coulomb(3, node) + node = node + 1 + f_total(1, ii) = f_total(1, ii) + fg_coulomb(1, node) + f_total(2, ii) = f_total(2, ii) + fg_coulomb(2, node) + f_total(3, ii) = f_total(3, ii) + fg_coulomb(3, node) IF (PRESENT(debug)) THEN - debug%f_g(1, ii) = debug%f_g(1, ii)+fg_coulomb(1, node) - debug%f_g(2, ii) = debug%f_g(2, ii)+fg_coulomb(2, node) - debug%f_g(3, ii) = debug%f_g(3, ii)+fg_coulomb(3, node) + debug%f_g(1, ii) = debug%f_g(1, ii) + fg_coulomb(1, node) + debug%f_g(2, ii) = debug%f_g(2, ii) + fg_coulomb(2, node) + debug%f_g(3, ii) = debug%f_g(3, ii) + fg_coulomb(3, node) ENDIF IF (atprop_env%energy) THEN - atprop_env%atener(ii) = atprop_env%atener(ii)+e_coulomb(node) + atprop_env%atener(ii) = atprop_env%atener(ii) + e_coulomb(node) END IF IF (atprop_env%stress) THEN - atprop_env%atstress(:, :, ii) = atprop_env%atstress(:, :, ii)+pv_coulomb(:, :, node) + atprop_env%atstress(:, :, ii) = atprop_env%atstress(:, :, ii) + pv_coulomb(:, :, node) END IF END DO END DO @@ -687,7 +687,7 @@ SUBROUTINE fist_calc_energy_force(fist_env, debug) IF (use_virial) THEN ! Add up all the pressure tensors IF (ewald_type == do_ewald_none) THEN - virial%pv_virial = pv_nonbond+pv_bond+pv_bend+pv_torsion+pv_imptors+pv_urey_bradley + virial%pv_virial = pv_nonbond + pv_bond + pv_bend + pv_torsion + pv_imptors + pv_urey_bradley CALL mp_sum(virial%pv_virial, para_env%group) ELSE ident = 0.0_dp @@ -695,11 +695,11 @@ SUBROUTINE fist_calc_energy_force(fist_env, debug) ident(i, i) = 1.0_dp END DO - virial%pv_virial = pv_nonbond+pv_bond+pv_bend+pv_torsion+pv_imptors+pv_urey_bradley+pv_bc + virial%pv_virial = pv_nonbond + pv_bond + pv_bend + pv_torsion + pv_imptors + pv_urey_bradley + pv_bc CALL mp_sum(virial%pv_virial, para_env%group) - virial%pv_virial = virial%pv_virial+ident*thermo%e_neut - virial%pv_virial = virial%pv_virial+pv_g + virial%pv_virial = virial%pv_virial + ident*thermo%e_neut + virial%pv_virial = virial%pv_virial + pv_g END IF END IF @@ -712,10 +712,10 @@ SUBROUTINE fist_calc_energy_force(fist_env, debug) ! contributions from fields (currently all quantities are fully replicated!) IF (efield%apply_field) THEN - thermo%pot = thermo%pot+ef_ener - f_total(1:3, 1:natoms) = f_total(1:3, 1:natoms)+ef_f(1:3, 1:natoms) + thermo%pot = thermo%pot + ef_ener + f_total(1:3, 1:natoms) = f_total(1:3, 1:natoms) + ef_f(1:3, 1:natoms) IF (use_virial) THEN - virial%pv_virial(1:3, 1:3) = virial%pv_virial(1:3, 1:3)+ef_pv(1:3, 1:3) + virial%pv_virial(1:3, 1:3) = virial%pv_virial(1:3, 1:3) + ef_pv(1:3, 1:3) END IF DEALLOCATE (ef_f) END IF @@ -727,33 +727,33 @@ SUBROUTINE fist_calc_energy_force(fist_env, debug) DO i = 1, natoms shell_index = particle_set(i)%shell_index IF (shell_index == 0) THEN - particle_set(i)%f(1:3) = f_total(1:3, i)+fg_coulomb(1:3, i) + particle_set(i)%f(1:3) = f_total(1:3, i) + fg_coulomb(1:3, i) ELSE atomic_kind => particle_set(i)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, shell=shell, mass=mass) fc = shell%mass_core/mass - fcore_total(1:3, shell_index) = fcore_total(1:3, shell_index)+particle_set(i)%f(1:3)*fc + fcore_total(1:3, shell_index) = fcore_total(1:3, shell_index) + particle_set(i)%f(1:3)*fc fs = shell%mass_shell/mass - fshell_total(1:3, shell_index) = fshell_total(1:3, shell_index)+particle_set(i)%f(1:3)*fs + fshell_total(1:3, shell_index) = fshell_total(1:3, shell_index) + particle_set(i)%f(1:3)*fs END IF END DO DO i = 1, nshell - core_particle_set(i)%f(1) = fcore_total(1, i)+fgcore_coulomb(1, i) - core_particle_set(i)%f(2) = fcore_total(2, i)+fgcore_coulomb(2, i) - core_particle_set(i)%f(3) = fcore_total(3, i)+fgcore_coulomb(3, i) - shell_particle_set(i)%f(1) = fshell_total(1, i)+fgshell_coulomb(1, i) - shell_particle_set(i)%f(2) = fshell_total(2, i)+fgshell_coulomb(2, i) - shell_particle_set(i)%f(3) = fshell_total(3, i)+fgshell_coulomb(3, i) + core_particle_set(i)%f(1) = fcore_total(1, i) + fgcore_coulomb(1, i) + core_particle_set(i)%f(2) = fcore_total(2, i) + fgcore_coulomb(2, i) + core_particle_set(i)%f(3) = fcore_total(3, i) + fgcore_coulomb(3, i) + shell_particle_set(i)%f(1) = fshell_total(1, i) + fgshell_coulomb(1, i) + shell_particle_set(i)%f(2) = fshell_total(2, i) + fgshell_coulomb(2, i) + shell_particle_set(i)%f(3) = fshell_total(3, i) + fgshell_coulomb(3, i) END DO ELSEIF (shell_present .AND. .NOT. shell_model_ad) THEN CPABORT("Non adiabatic shell-model not implemented.") ELSE DO i = 1, natoms - particle_set(i)%f(1) = f_total(1, i)+fg_coulomb(1, i) - particle_set(i)%f(2) = f_total(2, i)+fg_coulomb(2, i) - particle_set(i)%f(3) = f_total(3, i)+fg_coulomb(3, i) + particle_set(i)%f(1) = f_total(1, i) + fg_coulomb(1, i) + particle_set(i)%f(2) = f_total(2, i) + fg_coulomb(2, i) + particle_set(i)%f(3) = f_total(3, i) + fg_coulomb(3, i) END DO END IF CASE (do_ewald_ewald, do_ewald_none) @@ -766,9 +766,9 @@ SUBROUTINE fist_calc_energy_force(fist_env, debug) atomic_kind => particle_set(i)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, shell=shell, mass=mass) fc = shell%mass_core/mass - fcore_total(1:3, shell_index) = fcore_total(1:3, shell_index)+particle_set(i)%f(1:3)*fc + fcore_total(1:3, shell_index) = fcore_total(1:3, shell_index) + particle_set(i)%f(1:3)*fc fs = shell%mass_shell/mass - fshell_total(1:3, shell_index) = fshell_total(1:3, shell_index)+particle_set(i)%f(1:3)*fs + fshell_total(1:3, shell_index) = fshell_total(1:3, shell_index) + particle_set(i)%f(1:3)*fs END IF END DO DO i = 1, nshell diff --git a/src/fist_intra_force.F b/src/fist_intra_force.F index 4d692faedf..a22dfb95ec 100644 --- a/src/fist_intra_force.F +++ b/src/fist_intra_force.F @@ -169,27 +169,27 @@ SUBROUTINE force_intra_control(molecule_set, molecule_kind_set, & CALL get_molecule(molecule, first_atom=first_atom) BOND: DO ibond = 1, nbonds - index_a = bond_list(ibond)%a+first_atom-1 - index_b = bond_list(ibond)%b+first_atom-1 - rij = particle_set(index_a)%r-particle_set(index_b)%r + index_a = bond_list(ibond)%a + first_atom - 1 + index_b = bond_list(ibond)%b + first_atom - 1 + rij = particle_set(index_a)%r - particle_set(index_b)%r rij = pbc(rij, cell) CALL force_bonds(bond_list(ibond)%bond_kind%id_type, rij, & bond_list(ibond)%bond_kind%r0, & bond_list(ibond)%bond_kind%k, & bond_list(ibond)%bond_kind%cs, & energy, fscalar) - pot_bond = pot_bond+energy + pot_bond = pot_bond + energy IF (atener) THEN - ener_a(index_a) = ener_a(index_a)+0.5_dp*energy - ener_a(index_b) = ener_a(index_b)+0.5_dp*energy + ener_a(index_a) = ener_a(index_a) + 0.5_dp*energy + ener_a(index_b) = ener_a(index_b) + 0.5_dp*energy END IF - particle_set(index_a)%f(1) = particle_set(index_a)%f(1)-rij(1)*fscalar - particle_set(index_a)%f(2) = particle_set(index_a)%f(2)-rij(2)*fscalar - particle_set(index_a)%f(3) = particle_set(index_a)%f(3)-rij(3)*fscalar - particle_set(index_b)%f(1) = particle_set(index_b)%f(1)+rij(1)*fscalar - particle_set(index_b)%f(2) = particle_set(index_b)%f(2)+rij(2)*fscalar - particle_set(index_b)%f(3) = particle_set(index_b)%f(3)+rij(3)*fscalar + particle_set(index_a)%f(1) = particle_set(index_a)%f(1) - rij(1)*fscalar + particle_set(index_a)%f(2) = particle_set(index_a)%f(2) - rij(2)*fscalar + particle_set(index_a)%f(3) = particle_set(index_a)%f(3) - rij(3)*fscalar + particle_set(index_b)%f(1) = particle_set(index_b)%f(1) + rij(1)*fscalar + particle_set(index_b)%f(2) = particle_set(index_b)%f(2) + rij(2)*fscalar + particle_set(index_b)%f(3) = particle_set(index_b)%f(3) + rij(3)*fscalar ! computing the pressure tensor k2 = -rij*fscalar @@ -201,36 +201,36 @@ SUBROUTINE force_intra_control(molecule_set, molecule_kind_set, & ! the contribution from the bonds. ONLY FOR DEBUG IF (PRESENT(f_bond)) THEN - f_bond(1, index_a) = f_bond(1, index_a)-rij(1)*fscalar - f_bond(2, index_a) = f_bond(2, index_a)-rij(2)*fscalar - f_bond(3, index_a) = f_bond(3, index_a)-rij(3)*fscalar - f_bond(1, index_b) = f_bond(1, index_b)+rij(1)*fscalar - f_bond(2, index_b) = f_bond(2, index_b)+rij(2)*fscalar - f_bond(3, index_b) = f_bond(3, index_b)+rij(3)*fscalar + f_bond(1, index_a) = f_bond(1, index_a) - rij(1)*fscalar + f_bond(2, index_a) = f_bond(2, index_a) - rij(2)*fscalar + f_bond(3, index_a) = f_bond(3, index_a) - rij(3)*fscalar + f_bond(1, index_b) = f_bond(1, index_b) + rij(1)*fscalar + f_bond(2, index_b) = f_bond(2, index_b) + rij(2)*fscalar + f_bond(3, index_b) = f_bond(3, index_b) + rij(3)*fscalar END IF END DO BOND SHELL: DO ishell = 1, nshell - index_a = shell_list(ishell)%a+first_atom-1 + index_a = shell_list(ishell)%a + first_atom - 1 index_b = particle_set(index_a)%shell_index - rij = core_particle_set(index_b)%r-shell_particle_set(index_b)%r + rij = core_particle_set(index_b)%r - shell_particle_set(index_b)%r rij = pbc(rij, cell) k2_spring = shell_list(ishell)%shell_kind%k2_spring k4_spring = shell_list(ishell)%shell_kind%k4_spring r2 = DOT_PRODUCT(rij, rij) - energy = 0.5_dp*(k2_spring+k4_spring*r2/12.0_dp)*r2 - fscalar = k2_spring+k4_spring*r2/6.0_dp - pot_shell = pot_shell+energy + energy = 0.5_dp*(k2_spring + k4_spring*r2/12.0_dp)*r2 + fscalar = k2_spring + k4_spring*r2/6.0_dp + pot_shell = pot_shell + energy IF (atener) THEN - ener_a(index_a) = ener_a(index_a)+energy + ener_a(index_a) = ener_a(index_a) + energy END IF - core_particle_set(index_b)%f(1) = core_particle_set(index_b)%f(1)-rij(1)*fscalar - core_particle_set(index_b)%f(2) = core_particle_set(index_b)%f(2)-rij(2)*fscalar - core_particle_set(index_b)%f(3) = core_particle_set(index_b)%f(3)-rij(3)*fscalar - shell_particle_set(index_b)%f(1) = shell_particle_set(index_b)%f(1)+rij(1)*fscalar - shell_particle_set(index_b)%f(2) = shell_particle_set(index_b)%f(2)+rij(2)*fscalar - shell_particle_set(index_b)%f(3) = shell_particle_set(index_b)%f(3)+rij(3)*fscalar + core_particle_set(index_b)%f(1) = core_particle_set(index_b)%f(1) - rij(1)*fscalar + core_particle_set(index_b)%f(2) = core_particle_set(index_b)%f(2) - rij(2)*fscalar + core_particle_set(index_b)%f(3) = core_particle_set(index_b)%f(3) - rij(3)*fscalar + shell_particle_set(index_b)%f(1) = shell_particle_set(index_b)%f(1) + rij(1)*fscalar + shell_particle_set(index_b)%f(2) = shell_particle_set(index_b)%f(2) + rij(2)*fscalar + shell_particle_set(index_b)%f(3) = shell_particle_set(index_b)%f(3) + rij(3)*fscalar ! Compute the pressure tensor, if requested IF (use_virial) THEN k1 = -rij*fscalar @@ -242,24 +242,24 @@ SUBROUTINE force_intra_control(molecule_set, molecule_kind_set, & END DO SHELL UREY_BRADLEY: DO ibend = 1, nub - index_a = ub_list(ibend)%a+first_atom-1 - index_b = ub_list(ibend)%c+first_atom-1 - rij = particle_set(index_a)%r-particle_set(index_b)%r + index_a = ub_list(ibend)%a + first_atom - 1 + index_b = ub_list(ibend)%c + first_atom - 1 + rij = particle_set(index_a)%r - particle_set(index_b)%r rij = pbc(rij, cell) CALL force_bonds(ub_list(ibend)%ub_kind%id_type, rij, & ub_list(ibend)%ub_kind%r0, & ub_list(ibend)%ub_kind%k, 0.0_dp, energy, fscalar) - pot_urey_bradley = pot_urey_bradley+energy + pot_urey_bradley = pot_urey_bradley + energy IF (atener) THEN - ener_a(index_a) = ener_a(index_a)+0.5_dp*energy - ener_a(index_b) = ener_a(index_b)+0.5_dp*energy + ener_a(index_a) = ener_a(index_a) + 0.5_dp*energy + ener_a(index_b) = ener_a(index_b) + 0.5_dp*energy END IF - particle_set(index_a)%f(1) = particle_set(index_a)%f(1)-rij(1)*fscalar - particle_set(index_a)%f(2) = particle_set(index_a)%f(2)-rij(2)*fscalar - particle_set(index_a)%f(3) = particle_set(index_a)%f(3)-rij(3)*fscalar - particle_set(index_b)%f(1) = particle_set(index_b)%f(1)+rij(1)*fscalar - particle_set(index_b)%f(2) = particle_set(index_b)%f(2)+rij(2)*fscalar - particle_set(index_b)%f(3) = particle_set(index_b)%f(3)+rij(3)*fscalar + particle_set(index_a)%f(1) = particle_set(index_a)%f(1) - rij(1)*fscalar + particle_set(index_a)%f(2) = particle_set(index_a)%f(2) - rij(2)*fscalar + particle_set(index_a)%f(3) = particle_set(index_a)%f(3) - rij(3)*fscalar + particle_set(index_b)%f(1) = particle_set(index_b)%f(1) + rij(1)*fscalar + particle_set(index_b)%f(2) = particle_set(index_b)%f(2) + rij(2)*fscalar + particle_set(index_b)%f(3) = particle_set(index_b)%f(3) + rij(3)*fscalar ! computing the pressure tensor k2 = -rij*fscalar @@ -271,18 +271,18 @@ SUBROUTINE force_intra_control(molecule_set, molecule_kind_set, & ! the contribution from the ub. ONLY FOR DEBUG IF (PRESENT(f_ub)) THEN - f_ub(:, index_a) = f_ub(:, index_a)-rij*fscalar - f_ub(:, index_b) = f_ub(:, index_b)+rij*fscalar + f_ub(:, index_a) = f_ub(:, index_a) - rij*fscalar + f_ub(:, index_b) = f_ub(:, index_b) + rij*fscalar END IF END DO UREY_BRADLEY BEND: DO ibend = 1, nbends - index_a = bend_list(ibend)%a+first_atom-1 - index_b = bend_list(ibend)%b+first_atom-1 - index_c = bend_list(ibend)%c+first_atom-1 - b12 = particle_set(index_a)%r-particle_set(index_b)%r - b32 = particle_set(index_c)%r-particle_set(index_b)%r + index_a = bend_list(ibend)%a + first_atom - 1 + index_b = bend_list(ibend)%b + first_atom - 1 + index_c = bend_list(ibend)%c + first_atom - 1 + b12 = particle_set(index_a)%r - particle_set(index_b)%r + b32 = particle_set(index_c)%r - particle_set(index_b)%r b12 = pbc(b12, cell) b32 = pbc(b32, cell) d12 = SQRT(DOT_PRODUCT(b12, b12)) @@ -306,21 +306,21 @@ SUBROUTINE force_intra_control(molecule_set, molecule_kind_set, & bend_list(ibend)%bend_kind%kss, & bend_list(ibend)%bend_kind%legendre, & g1, g2, g3, energy, fscalar) - pot_bend = pot_bend+energy + pot_bend = pot_bend + energy IF (atener) THEN - ener_a(index_a) = ener_a(index_a)+energy/3._dp - ener_a(index_b) = ener_a(index_b)+energy/3._dp - ener_a(index_c) = ener_a(index_c)+energy/3._dp + ener_a(index_a) = ener_a(index_a) + energy/3._dp + ener_a(index_b) = ener_a(index_b) + energy/3._dp + ener_a(index_c) = ener_a(index_c) + energy/3._dp END IF - particle_set(index_a)%f(1) = particle_set(index_a)%f(1)+g1(1)*fscalar - particle_set(index_a)%f(2) = particle_set(index_a)%f(2)+g1(2)*fscalar - particle_set(index_a)%f(3) = particle_set(index_a)%f(3)+g1(3)*fscalar - particle_set(index_b)%f(1) = particle_set(index_b)%f(1)+g2(1)*fscalar - particle_set(index_b)%f(2) = particle_set(index_b)%f(2)+g2(2)*fscalar - particle_set(index_b)%f(3) = particle_set(index_b)%f(3)+g2(3)*fscalar - particle_set(index_c)%f(1) = particle_set(index_c)%f(1)+g3(1)*fscalar - particle_set(index_c)%f(2) = particle_set(index_c)%f(2)+g3(2)*fscalar - particle_set(index_c)%f(3) = particle_set(index_c)%f(3)+g3(3)*fscalar + particle_set(index_a)%f(1) = particle_set(index_a)%f(1) + g1(1)*fscalar + particle_set(index_a)%f(2) = particle_set(index_a)%f(2) + g1(2)*fscalar + particle_set(index_a)%f(3) = particle_set(index_a)%f(3) + g1(3)*fscalar + particle_set(index_b)%f(1) = particle_set(index_b)%f(1) + g2(1)*fscalar + particle_set(index_b)%f(2) = particle_set(index_b)%f(2) + g2(2)*fscalar + particle_set(index_b)%f(3) = particle_set(index_b)%f(3) + g2(3)*fscalar + particle_set(index_c)%f(1) = particle_set(index_c)%f(1) + g3(1)*fscalar + particle_set(index_c)%f(2) = particle_set(index_c)%f(2) + g3(2)*fscalar + particle_set(index_c)%f(3) = particle_set(index_c)%f(3) + g3(3)*fscalar ! computing the pressure tensor k1 = fscalar*g1 @@ -336,33 +336,33 @@ SUBROUTINE force_intra_control(molecule_set, molecule_kind_set, & ! the contribution from the bends. ONLY FOR DEBUG IF (PRESENT(f_bend)) THEN - f_bend(:, index_a) = f_bend(:, index_a)+fscalar*g1 - f_bend(:, index_b) = f_bend(:, index_b)+fscalar*g2 - f_bend(:, index_c) = f_bend(:, index_c)+fscalar*g3 + f_bend(:, index_a) = f_bend(:, index_a) + fscalar*g1 + f_bend(:, index_b) = f_bend(:, index_b) + fscalar*g2 + f_bend(:, index_c) = f_bend(:, index_c) + fscalar*g3 END IF END DO BEND TORSION: DO itorsion = 1, ntorsions - index_a = torsion_list(itorsion)%a+first_atom-1 - index_b = torsion_list(itorsion)%b+first_atom-1 - index_c = torsion_list(itorsion)%c+first_atom-1 - index_d = torsion_list(itorsion)%d+first_atom-1 - t12 = particle_set(index_a)%r-particle_set(index_b)%r - t32 = particle_set(index_c)%r-particle_set(index_b)%r - t34 = particle_set(index_c)%r-particle_set(index_d)%r - t43 = particle_set(index_d)%r-particle_set(index_c)%r + index_a = torsion_list(itorsion)%a + first_atom - 1 + index_b = torsion_list(itorsion)%b + first_atom - 1 + index_c = torsion_list(itorsion)%c + first_atom - 1 + index_d = torsion_list(itorsion)%d + first_atom - 1 + t12 = particle_set(index_a)%r - particle_set(index_b)%r + t32 = particle_set(index_c)%r - particle_set(index_b)%r + t34 = particle_set(index_c)%r - particle_set(index_d)%r + t43 = particle_set(index_d)%r - particle_set(index_c)%r t12 = pbc(t12, cell) t32 = pbc(t32, cell) t34 = pbc(t34, cell) t43 = pbc(t43, cell) ! t12 x t32 - tm(1) = t12(2)*t32(3)-t32(2)*t12(3) - tm(2) = -t12(1)*t32(3)+t32(1)*t12(3) - tm(3) = t12(1)*t32(2)-t32(1)*t12(2) + tm(1) = t12(2)*t32(3) - t32(2)*t12(3) + tm(2) = -t12(1)*t32(3) + t32(1)*t12(3) + tm(3) = t12(1)*t32(2) - t32(1)*t12(2) ! t32 x t34 - tn(1) = t32(2)*t34(3)-t34(2)*t32(3) - tn(2) = -t32(1)*t34(3)+t34(1)*t32(3) - tn(3) = t32(1)*t34(2)-t34(1)*t32(2) + tn(1) = t32(2)*t34(3) - t34(2)*t32(3) + tn(2) = -t32(1)*t34(3) + t34(1)*t32(3) + tn(3) = t32(1)*t34(2) - t34(1)*t32(2) sm = SQRT(DOT_PRODUCT(tm, tm)) ism = 1.0_dp/sm sn = SQRT(DOT_PRODUCT(tn, tn)) @@ -378,25 +378,25 @@ SUBROUTINE force_intra_control(molecule_set, molecule_kind_set, & torsion_list(itorsion)%torsion_kind%phi0(imul), & torsion_list(itorsion)%torsion_kind%m(imul), & gt1, gt2, gt3, gt4, energy, fscalar) - pot_torsion = pot_torsion+energy + pot_torsion = pot_torsion + energy IF (atener) THEN - ener_a(index_a) = ener_a(index_a)+energy*0.25_dp - ener_a(index_b) = ener_a(index_b)+energy*0.25_dp - ener_a(index_c) = ener_a(index_c)+energy*0.25_dp - ener_a(index_d) = ener_a(index_d)+energy*0.25_dp + ener_a(index_a) = ener_a(index_a) + energy*0.25_dp + ener_a(index_b) = ener_a(index_b) + energy*0.25_dp + ener_a(index_c) = ener_a(index_c) + energy*0.25_dp + ener_a(index_d) = ener_a(index_d) + energy*0.25_dp END IF - particle_set(index_a)%f(1) = particle_set(index_a)%f(1)+gt1(1)*fscalar - particle_set(index_a)%f(2) = particle_set(index_a)%f(2)+gt1(2)*fscalar - particle_set(index_a)%f(3) = particle_set(index_a)%f(3)+gt1(3)*fscalar - particle_set(index_b)%f(1) = particle_set(index_b)%f(1)+gt2(1)*fscalar - particle_set(index_b)%f(2) = particle_set(index_b)%f(2)+gt2(2)*fscalar - particle_set(index_b)%f(3) = particle_set(index_b)%f(3)+gt2(3)*fscalar - particle_set(index_c)%f(1) = particle_set(index_c)%f(1)+gt3(1)*fscalar - particle_set(index_c)%f(2) = particle_set(index_c)%f(2)+gt3(2)*fscalar - particle_set(index_c)%f(3) = particle_set(index_c)%f(3)+gt3(3)*fscalar - particle_set(index_d)%f(1) = particle_set(index_d)%f(1)+gt4(1)*fscalar - particle_set(index_d)%f(2) = particle_set(index_d)%f(2)+gt4(2)*fscalar - particle_set(index_d)%f(3) = particle_set(index_d)%f(3)+gt4(3)*fscalar + particle_set(index_a)%f(1) = particle_set(index_a)%f(1) + gt1(1)*fscalar + particle_set(index_a)%f(2) = particle_set(index_a)%f(2) + gt1(2)*fscalar + particle_set(index_a)%f(3) = particle_set(index_a)%f(3) + gt1(3)*fscalar + particle_set(index_b)%f(1) = particle_set(index_b)%f(1) + gt2(1)*fscalar + particle_set(index_b)%f(2) = particle_set(index_b)%f(2) + gt2(2)*fscalar + particle_set(index_b)%f(3) = particle_set(index_b)%f(3) + gt2(3)*fscalar + particle_set(index_c)%f(1) = particle_set(index_c)%f(1) + gt3(1)*fscalar + particle_set(index_c)%f(2) = particle_set(index_c)%f(2) + gt3(2)*fscalar + particle_set(index_c)%f(3) = particle_set(index_c)%f(3) + gt3(3)*fscalar + particle_set(index_d)%f(1) = particle_set(index_d)%f(1) + gt4(1)*fscalar + particle_set(index_d)%f(2) = particle_set(index_d)%f(2) + gt4(2)*fscalar + particle_set(index_d)%f(3) = particle_set(index_d)%f(3) + gt4(3)*fscalar ! computing the pressure tensor k1 = fscalar*gt1 @@ -415,35 +415,35 @@ SUBROUTINE force_intra_control(molecule_set, molecule_kind_set, & ! the contribution from the torsions. ONLY FOR DEBUG IF (PRESENT(f_torsion)) THEN - f_torsion(:, index_a) = f_torsion(:, index_a)+fscalar*gt1 - f_torsion(:, index_b) = f_torsion(:, index_b)+fscalar*gt2 - f_torsion(:, index_c) = f_torsion(:, index_c)+fscalar*gt3 - f_torsion(:, index_d) = f_torsion(:, index_d)+fscalar*gt4 + f_torsion(:, index_a) = f_torsion(:, index_a) + fscalar*gt1 + f_torsion(:, index_b) = f_torsion(:, index_b) + fscalar*gt2 + f_torsion(:, index_c) = f_torsion(:, index_c) + fscalar*gt3 + f_torsion(:, index_d) = f_torsion(:, index_d) + fscalar*gt4 END IF END DO END DO TORSION IMP_TORSION: DO itorsion = 1, nimptors - index_a = impr_list(itorsion)%a+first_atom-1 - index_b = impr_list(itorsion)%b+first_atom-1 - index_c = impr_list(itorsion)%c+first_atom-1 - index_d = impr_list(itorsion)%d+first_atom-1 - t12 = particle_set(index_a)%r-particle_set(index_b)%r - t32 = particle_set(index_c)%r-particle_set(index_b)%r - t34 = particle_set(index_c)%r-particle_set(index_d)%r - t43 = particle_set(index_d)%r-particle_set(index_c)%r + index_a = impr_list(itorsion)%a + first_atom - 1 + index_b = impr_list(itorsion)%b + first_atom - 1 + index_c = impr_list(itorsion)%c + first_atom - 1 + index_d = impr_list(itorsion)%d + first_atom - 1 + t12 = particle_set(index_a)%r - particle_set(index_b)%r + t32 = particle_set(index_c)%r - particle_set(index_b)%r + t34 = particle_set(index_c)%r - particle_set(index_d)%r + t43 = particle_set(index_d)%r - particle_set(index_c)%r t12 = pbc(t12, cell) t32 = pbc(t32, cell) t34 = pbc(t34, cell) t43 = pbc(t43, cell) ! t12 x t32 - tm(1) = t12(2)*t32(3)-t32(2)*t12(3) - tm(2) = -t12(1)*t32(3)+t32(1)*t12(3) - tm(3) = t12(1)*t32(2)-t32(1)*t12(2) + tm(1) = t12(2)*t32(3) - t32(2)*t12(3) + tm(2) = -t12(1)*t32(3) + t32(1)*t12(3) + tm(3) = t12(1)*t32(2) - t32(1)*t12(2) ! t32 x t34 - tn(1) = t32(2)*t34(3)-t34(2)*t32(3) - tn(2) = -t32(1)*t34(3)+t34(1)*t32(3) - tn(3) = t32(1)*t34(2)-t34(1)*t32(2) + tn(1) = t32(2)*t34(3) - t34(2)*t32(3) + tn(2) = -t32(1)*t34(3) + t34(1)*t32(3) + tn(3) = t32(1)*t34(2) - t34(1)*t32(2) sm = SQRT(DOT_PRODUCT(tm, tm)) ism = 1.0_dp/sm sn = SQRT(DOT_PRODUCT(tn, tn)) @@ -457,25 +457,25 @@ SUBROUTINE force_intra_control(molecule_set, molecule_kind_set, & impr_list(itorsion)%impr_kind%k, & impr_list(itorsion)%impr_kind%phi0, & gt1, gt2, gt3, gt4, energy, fscalar) - pot_imp_torsion = pot_imp_torsion+energy + pot_imp_torsion = pot_imp_torsion + energy IF (atener) THEN - ener_a(index_a) = ener_a(index_a)+energy*0.25_dp - ener_a(index_b) = ener_a(index_b)+energy*0.25_dp - ener_a(index_c) = ener_a(index_c)+energy*0.25_dp - ener_a(index_d) = ener_a(index_d)+energy*0.25_dp + ener_a(index_a) = ener_a(index_a) + energy*0.25_dp + ener_a(index_b) = ener_a(index_b) + energy*0.25_dp + ener_a(index_c) = ener_a(index_c) + energy*0.25_dp + ener_a(index_d) = ener_a(index_d) + energy*0.25_dp END IF - particle_set(index_a)%f(1) = particle_set(index_a)%f(1)+gt1(1)*fscalar - particle_set(index_a)%f(2) = particle_set(index_a)%f(2)+gt1(2)*fscalar - particle_set(index_a)%f(3) = particle_set(index_a)%f(3)+gt1(3)*fscalar - particle_set(index_b)%f(1) = particle_set(index_b)%f(1)+gt2(1)*fscalar - particle_set(index_b)%f(2) = particle_set(index_b)%f(2)+gt2(2)*fscalar - particle_set(index_b)%f(3) = particle_set(index_b)%f(3)+gt2(3)*fscalar - particle_set(index_c)%f(1) = particle_set(index_c)%f(1)+gt3(1)*fscalar - particle_set(index_c)%f(2) = particle_set(index_c)%f(2)+gt3(2)*fscalar - particle_set(index_c)%f(3) = particle_set(index_c)%f(3)+gt3(3)*fscalar - particle_set(index_d)%f(1) = particle_set(index_d)%f(1)+gt4(1)*fscalar - particle_set(index_d)%f(2) = particle_set(index_d)%f(2)+gt4(2)*fscalar - particle_set(index_d)%f(3) = particle_set(index_d)%f(3)+gt4(3)*fscalar + particle_set(index_a)%f(1) = particle_set(index_a)%f(1) + gt1(1)*fscalar + particle_set(index_a)%f(2) = particle_set(index_a)%f(2) + gt1(2)*fscalar + particle_set(index_a)%f(3) = particle_set(index_a)%f(3) + gt1(3)*fscalar + particle_set(index_b)%f(1) = particle_set(index_b)%f(1) + gt2(1)*fscalar + particle_set(index_b)%f(2) = particle_set(index_b)%f(2) + gt2(2)*fscalar + particle_set(index_b)%f(3) = particle_set(index_b)%f(3) + gt2(3)*fscalar + particle_set(index_c)%f(1) = particle_set(index_c)%f(1) + gt3(1)*fscalar + particle_set(index_c)%f(2) = particle_set(index_c)%f(2) + gt3(2)*fscalar + particle_set(index_c)%f(3) = particle_set(index_c)%f(3) + gt3(3)*fscalar + particle_set(index_d)%f(1) = particle_set(index_d)%f(1) + gt4(1)*fscalar + particle_set(index_d)%f(2) = particle_set(index_d)%f(2) + gt4(2)*fscalar + particle_set(index_d)%f(3) = particle_set(index_d)%f(3) + gt4(3)*fscalar ! computing the pressure tensor k1 = fscalar*gt1 @@ -494,33 +494,33 @@ SUBROUTINE force_intra_control(molecule_set, molecule_kind_set, & ! the contribution from the torsions. ONLY FOR DEBUG IF (PRESENT(f_imptor)) THEN - f_imptor(:, index_a) = f_imptor(:, index_a)+fscalar*gt1 - f_imptor(:, index_b) = f_imptor(:, index_b)+fscalar*gt2 - f_imptor(:, index_c) = f_imptor(:, index_c)+fscalar*gt3 - f_imptor(:, index_d) = f_imptor(:, index_d)+fscalar*gt4 + f_imptor(:, index_a) = f_imptor(:, index_a) + fscalar*gt1 + f_imptor(:, index_b) = f_imptor(:, index_b) + fscalar*gt2 + f_imptor(:, index_c) = f_imptor(:, index_c) + fscalar*gt3 + f_imptor(:, index_d) = f_imptor(:, index_d) + fscalar*gt4 END IF END DO IMP_TORSION OPBEND: DO iopbend = 1, nopbends - index_a = opbend_list(iopbend)%a+first_atom-1 - index_b = opbend_list(iopbend)%b+first_atom-1 - index_c = opbend_list(iopbend)%c+first_atom-1 - index_d = opbend_list(iopbend)%d+first_atom-1 - - t12 = particle_set(index_a)%r-particle_set(index_b)%r - t32 = particle_set(index_c)%r-particle_set(index_b)%r - t34 = particle_set(index_c)%r-particle_set(index_d)%r - t43 = particle_set(index_d)%r-particle_set(index_c)%r - t41 = particle_set(index_d)%r-particle_set(index_a)%r - t42 = pbc(t41+t12, cell) + index_a = opbend_list(iopbend)%a + first_atom - 1 + index_b = opbend_list(iopbend)%b + first_atom - 1 + index_c = opbend_list(iopbend)%c + first_atom - 1 + index_d = opbend_list(iopbend)%d + first_atom - 1 + + t12 = particle_set(index_a)%r - particle_set(index_b)%r + t32 = particle_set(index_c)%r - particle_set(index_b)%r + t34 = particle_set(index_c)%r - particle_set(index_d)%r + t43 = particle_set(index_d)%r - particle_set(index_c)%r + t41 = particle_set(index_d)%r - particle_set(index_a)%r + t42 = pbc(t41 + t12, cell) t12 = pbc(t12, cell) t32 = pbc(t32, cell) t41 = pbc(t41, cell) t43 = pbc(t43, cell) ! tm = t32 x t12 - tm(1) = t32(2)*t12(3)-t12(2)*t32(3) - tm(2) = -t32(1)*t12(3)+t12(1)*t32(3) - tm(3) = t32(1)*t12(2)-t12(1)*t32(2) + tm(1) = t32(2)*t12(3) - t12(2)*t32(3) + tm(2) = -t32(1)*t12(3) + t12(1)*t32(3) + tm(3) = t32(1)*t12(2) - t12(1)*t32(2) sm = SQRT(DOT_PRODUCT(tm, tm)) s32 = SQRT(DOT_PRODUCT(t32, t32)) CALL force_opbends(opbend_list(iopbend)%opbend_kind%id_type, & @@ -528,25 +528,25 @@ SUBROUTINE force_intra_control(molecule_set, molecule_kind_set, & opbend_list(iopbend)%opbend_kind%k, & opbend_list(iopbend)%opbend_kind%phi0, & gt1, gt2, gt3, gt4, energy, fscalar) - pot_opbend = pot_opbend+energy + pot_opbend = pot_opbend + energy IF (atener) THEN - ener_a(index_a) = ener_a(index_a)+energy*0.25_dp - ener_a(index_b) = ener_a(index_b)+energy*0.25_dp - ener_a(index_c) = ener_a(index_c)+energy*0.25_dp - ener_a(index_d) = ener_a(index_d)+energy*0.25_dp + ener_a(index_a) = ener_a(index_a) + energy*0.25_dp + ener_a(index_b) = ener_a(index_b) + energy*0.25_dp + ener_a(index_c) = ener_a(index_c) + energy*0.25_dp + ener_a(index_d) = ener_a(index_d) + energy*0.25_dp END IF - particle_set(index_a)%f(1) = particle_set(index_a)%f(1)+gt1(1)*fscalar - particle_set(index_a)%f(2) = particle_set(index_a)%f(2)+gt1(2)*fscalar - particle_set(index_a)%f(3) = particle_set(index_a)%f(3)+gt1(3)*fscalar - particle_set(index_b)%f(1) = particle_set(index_b)%f(1)+gt2(1)*fscalar - particle_set(index_b)%f(2) = particle_set(index_b)%f(2)+gt2(2)*fscalar - particle_set(index_b)%f(3) = particle_set(index_b)%f(3)+gt2(3)*fscalar - particle_set(index_c)%f(1) = particle_set(index_c)%f(1)+gt3(1)*fscalar - particle_set(index_c)%f(2) = particle_set(index_c)%f(2)+gt3(2)*fscalar - particle_set(index_c)%f(3) = particle_set(index_c)%f(3)+gt3(3)*fscalar - particle_set(index_d)%f(1) = particle_set(index_d)%f(1)+gt4(1)*fscalar - particle_set(index_d)%f(2) = particle_set(index_d)%f(2)+gt4(2)*fscalar - particle_set(index_d)%f(3) = particle_set(index_d)%f(3)+gt4(3)*fscalar + particle_set(index_a)%f(1) = particle_set(index_a)%f(1) + gt1(1)*fscalar + particle_set(index_a)%f(2) = particle_set(index_a)%f(2) + gt1(2)*fscalar + particle_set(index_a)%f(3) = particle_set(index_a)%f(3) + gt1(3)*fscalar + particle_set(index_b)%f(1) = particle_set(index_b)%f(1) + gt2(1)*fscalar + particle_set(index_b)%f(2) = particle_set(index_b)%f(2) + gt2(2)*fscalar + particle_set(index_b)%f(3) = particle_set(index_b)%f(3) + gt2(3)*fscalar + particle_set(index_c)%f(1) = particle_set(index_c)%f(1) + gt3(1)*fscalar + particle_set(index_c)%f(2) = particle_set(index_c)%f(2) + gt3(2)*fscalar + particle_set(index_c)%f(3) = particle_set(index_c)%f(3) + gt3(3)*fscalar + particle_set(index_d)%f(1) = particle_set(index_d)%f(1) + gt4(1)*fscalar + particle_set(index_d)%f(2) = particle_set(index_d)%f(2) + gt4(2)*fscalar + particle_set(index_d)%f(3) = particle_set(index_d)%f(3) + gt4(3)*fscalar ! computing the pressure tensor k1 = fscalar*gt1 @@ -566,10 +566,10 @@ SUBROUTINE force_intra_control(molecule_set, molecule_kind_set, & ! the contribution from the opbends. ONLY FOR DEBUG IF (PRESENT(f_opbend)) THEN - f_opbend(:, index_a) = f_opbend(:, index_a)+fscalar*gt1 - f_opbend(:, index_b) = f_opbend(:, index_b)+fscalar*gt2 - f_opbend(:, index_c) = f_opbend(:, index_c)+fscalar*gt3 - f_opbend(:, index_d) = f_opbend(:, index_d)+fscalar*gt4 + f_opbend(:, index_a) = f_opbend(:, index_a) + fscalar*gt1 + f_opbend(:, index_b) = f_opbend(:, index_b) + fscalar*gt2 + f_opbend(:, index_c) = f_opbend(:, index_c) + fscalar*gt3 + f_opbend(:, index_d) = f_opbend(:, index_d) + fscalar*gt4 END IF END DO OPBEND END DO diff --git a/src/fist_neighbor_list_control.F b/src/fist_neighbor_list_control.F index fc41d552b4..d1cd4d4e15 100644 --- a/src/fist_neighbor_list_control.F +++ b/src/fist_neighbor_list_control.F @@ -159,8 +159,8 @@ SUBROUTINE list_control(atomic_kind_set, particle_set, local_particles, & iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) s2r = r_last_update(iparticle)%r s = particle_set(iparticle)%r(:) - dr(:) = s2r-s - dr2 = dr(1)*dr(1)+dr(2)*dr(2)+dr(3)*dr(3) + dr(:) = s2r - s + dr2 = dr(1)*dr(1) + dr(2)*dr(2) + dr(3)*dr(3) dr2_max = MAX(dr2_max, dr2) END DO END DO @@ -233,10 +233,10 @@ SUBROUTINE list_control(atomic_kind_set, particle_set, local_particles, & CALL cell_clone(cell, cell_last_update) IF (counter > 0) THEN - num_update = num_update+1 - lup = counter+1-last_update - last_update = counter+1 - aup = aup+(lup-aup)/REAL(num_update, KIND=dp) + num_update = num_update + 1 + lup = counter + 1 - last_update + last_update = counter + 1 + aup = aup + (lup - aup)/REAL(num_update, KIND=dp) ELSE num_update = 0 lup = 0 @@ -278,33 +278,33 @@ SUBROUTINE list_control(atomic_kind_set, particle_set, local_particles, & rab(2) = -cell%hmat(2, 2)*cell%perd(2)*ANINT(cell_last_update%h_inv(2, 2)*rab(2)) rab(3) = -cell%hmat(3, 3)*cell%perd(3)*ANINT(cell_last_update%h_inv(3, 3)*rab(3)) ELSE - s(1) = cell_last_update%h_inv(1, 1)*rab(1)+cell_last_update%h_inv(1, 2)*rab(2)+ & + s(1) = cell_last_update%h_inv(1, 1)*rab(1) + cell_last_update%h_inv(1, 2)*rab(2) + & cell_last_update%h_inv(1, 3)*rab(3) - s(2) = cell_last_update%h_inv(2, 1)*rab(1)+cell_last_update%h_inv(2, 2)*rab(2)+ & + s(2) = cell_last_update%h_inv(2, 1)*rab(1) + cell_last_update%h_inv(2, 2)*rab(2) + & cell_last_update%h_inv(2, 3)*rab(3) - s(3) = cell_last_update%h_inv(3, 1)*rab(1)+cell_last_update%h_inv(3, 2)*rab(2)+ & + s(3) = cell_last_update%h_inv(3, 1)*rab(1) + cell_last_update%h_inv(3, 2)*rab(2) + & cell_last_update%h_inv(3, 3)*rab(3) s(1) = -cell%perd(1)*ANINT(s(1)) s(2) = -cell%perd(2)*ANINT(s(2)) s(3) = -cell%perd(3)*ANINT(s(3)) - rab(1) = +cell%hmat(1, 1)*s(1)+cell%hmat(1, 2)*s(2)+cell%hmat(1, 3)*s(3) - rab(2) = +cell%hmat(2, 1)*s(1)+cell%hmat(2, 2)*s(2)+cell%hmat(2, 3)*s(3) - rab(3) = +cell%hmat(3, 1)*s(1)+cell%hmat(3, 2)*s(2)+cell%hmat(3, 3)*s(3) + rab(1) = +cell%hmat(1, 1)*s(1) + cell%hmat(1, 2)*s(2) + cell%hmat(1, 3)*s(3) + rab(2) = +cell%hmat(2, 1)*s(1) + cell%hmat(2, 2)*s(2) + cell%hmat(2, 3)*s(3) + rab(3) = +cell%hmat(3, 1)*s(1) + cell%hmat(3, 2)*s(2) + cell%hmat(3, 3)*s(3) END IF - r_last_update_pbc(iparticle)%r = particle_set(iparticle)%r+rab + r_last_update_pbc(iparticle)%r = particle_set(iparticle)%r + rab ! Use the same translation for core and shell. ishell = particle_set(iparticle)%shell_index IF (ishell /= 0) THEN - rshell_last_update_pbc(ishell)%r = rab+shell_particle_set(ishell)%r(:) + rshell_last_update_pbc(ishell)%r = rab + shell_particle_set(ishell)%r(:) IF (shell_adiabatic) THEN - rcore_last_update_pbc(ishell)%r = rab+core_particle_set(ishell)%r(:) + rcore_last_update_pbc(ishell)%r = rab + core_particle_set(ishell)%r(:) ELSE rcore_last_update_pbc(ishell)%r = r_last_update_pbc(iparticle)%r(:) END IF END IF END DO - counter = counter+1 + counter = counter + 1 CALL fist_nonbond_env_set(fist_nonbond_env, counter=counter) CALL timestop(handle) diff --git a/src/fist_neighbor_list_types.F b/src/fist_neighbor_list_types.F index 00e93f396b..bf4f1f3454 100644 --- a/src/fist_neighbor_list_types.F +++ b/src/fist_neighbor_list_types.F @@ -131,7 +131,7 @@ SUBROUTINE fist_neighbor_init(fist_neighbor, ncell) NULLIFY (fist_neighbor%neighbor_kind_pairs) ENDIF - nlistmin = (2*MAXVAL(ncell)+1)**3 + nlistmin = (2*MAXVAL(ncell) + 1)**3 IF (ASSOCIATED(fist_neighbor%neighbor_kind_pairs)) THEN IF (SIZE(fist_neighbor%neighbor_kind_pairs) < nlistmin) THEN ALLOCATE (new_pairs(nlistmin)) @@ -167,7 +167,7 @@ SUBROUTINE fist_neighbor_init(fist_neighbor, ncell) DEALLOCATE (fist_neighbor%neighbor_kind_pairs(i)%is_onfo) END IF ENDDO - DO i = SIZE(fist_neighbor%neighbor_kind_pairs)+1, nlistmin + DO i = SIZE(fist_neighbor%neighbor_kind_pairs) + 1, nlistmin ALLOCATE (new_pairs(i)%list(2, 0)) ALLOCATE (new_pairs(i)%id_kind(0)) NULLIFY (new_pairs(i)%ij_kind, & @@ -265,7 +265,7 @@ SUBROUTINE fist_neighbor_add(neighbor_kind_pair, atom_a, atom_b, & ! subtracted. When they are not the same, rab corresponds to a non-local ! interaction and the exclusion lists do not apply. rabc = pbc(rab, cell) - IF ((ANY(ABS(rab-rabc) > eps_default))) THEN + IF ((ANY(ABS(rab - rabc) > eps_default))) THEN ex_ei = .FALSE. ex_vdw = .FALSE. is_onfo = .FALSE. @@ -300,11 +300,11 @@ SUBROUTINE fist_neighbor_add(neighbor_kind_pair, atom_a, atom_b, & ! Allocate more memory for the scalings if necessary. nscale = neighbor_kind_pair%nscale IF (nscale == SIZE(neighbor_kind_pair%ei_scale)) THEN - CALL reallocate(neighbor_kind_pair%ei_scale, 1, INT(5+1.2*nscale)) - CALL reallocate(neighbor_kind_pair%vdw_scale, 1, INT(5+1.2*nscale)) - CALL reallocate(neighbor_kind_pair%is_onfo, 1, INT(5+1.2*nscale)) + CALL reallocate(neighbor_kind_pair%ei_scale, 1, INT(5 + 1.2*nscale)) + CALL reallocate(neighbor_kind_pair%vdw_scale, 1, INT(5 + 1.2*nscale)) + CALL reallocate(neighbor_kind_pair%is_onfo, 1, INT(5 + 1.2*nscale)) END IF - nscale = nscale+1 + nscale = nscale + 1 IF (ex_ei) THEN neighbor_kind_pair%ei_scale(nscale) = 0.0_dp ELSE IF (is_onfo) THEN @@ -329,7 +329,7 @@ SUBROUTINE fist_neighbor_add(neighbor_kind_pair, atom_a, atom_b, & old_npairs = SIZE(neighbor_kind_pair%list, 2) IF (old_npairs == neighbor_kind_pair%npairs) THEN ! just a choice that will also grow for zero size arrays: - new_npairs = INT(5+1.2*old_npairs) + new_npairs = INT(5 + 1.2*old_npairs) ! Pair Atoms Info ALLOCATE (new_list(2, new_npairs)) new_list(1:2, 1:old_npairs) = neighbor_kind_pair%list(1:2, 1:old_npairs) @@ -343,7 +343,7 @@ SUBROUTINE fist_neighbor_add(neighbor_kind_pair, atom_a, atom_b, & ENDIF ! Store the pair ... - npairs = neighbor_kind_pair%npairs+1 + npairs = neighbor_kind_pair%npairs + 1 IF ((ex_ei .OR. ex_vdw .OR. is_onfo) .AND. (npairs > nscale)) THEN ! ... after the previous pair that had scaling factors. neighbor_kind_pair%list(1, npairs) = neighbor_kind_pair%list(1, nscale) diff --git a/src/fist_neighbor_lists.F b/src/fist_neighbor_lists.F index a9da125c09..9be3f126e5 100644 --- a/src/fist_neighbor_lists.F +++ b/src/fist_neighbor_lists.F @@ -359,13 +359,13 @@ SUBROUTINE build_neighbor_lists(nonbonded, particle_set, atom, cell, & ALLOCATE (cellmap(-ncellmax:ncellmax, -ncellmax:ncellmax, -ncellmax:ncellmax)) cellmap = -1 imap = 0 - nkind00 = nkind*(nkind+1)/2 + nkind00 = nkind*(nkind + 1)/2 DO imax_cell = 0, ncellmax DO kcell = -imax_cell, imax_cell DO jcell = -imax_cell, imax_cell DO icell = -imax_cell, imax_cell IF (cellmap(icell, jcell, kcell) == -1) THEN - imap = imap+1 + imap = imap + 1 cellmap(icell, jcell, kcell) = imap CPASSERT(imap <= nonbonded%nlists) neighbor_kind_pair => nonbonded%neighbor_kind_pairs(imap) @@ -384,7 +384,7 @@ SUBROUTINE build_neighbor_lists(nonbonded, particle_set, atom, cell, & -isubcell(3):isubcell(3))) sphcub = .FALSE. IF (ALL(isubcell /= 0)) THEN - radius = REAL(isubcell(1), KIND=dp)**2+REAL(isubcell(2), KIND=dp)**2+ & + radius = REAL(isubcell(1), KIND=dp)**2 + REAL(isubcell(2), KIND=dp)**2 + & REAL(isubcell(3), KIND=dp)**2 loop1: DO k = -isubcell(3), isubcell(3) loop2: DO j = -isubcell(2), isubcell(2) @@ -392,12 +392,12 @@ SUBROUTINE build_neighbor_lists(nonbonded, particle_set, atom, cell, & ic = REAL((/i, j, k/), KIND=dp) ! subcell cube vertex DO kx = -1, 1 - icx(3) = ic(3)+SIGN(0.5_dp, REAL(kx, KIND=dp)) + icx(3) = ic(3) + SIGN(0.5_dp, REAL(kx, KIND=dp)) DO jx = -1, 1 - icx(2) = ic(2)+SIGN(0.5_dp, REAL(jx, KIND=dp)) + icx(2) = ic(2) + SIGN(0.5_dp, REAL(jx, KIND=dp)) DO ix = -1, 1 - icx(1) = ic(1)+SIGN(0.5_dp, REAL(ix, KIND=dp)) - vv = icx(1)*icx(1)+icx(2)*icx(2)+icx(3)*icx(3) + icx(1) = ic(1) + SIGN(0.5_dp, REAL(ix, KIND=dp)) + vv = icx(1)*icx(1) + icx(2)*icx(2) + icx(3)*icx(3) vv = vv/radius IF (vv <= 1.0_dp) THEN sphcub(i, j, k) = .TRUE. @@ -422,7 +422,7 @@ SUBROUTINE build_neighbor_lists(nonbonded, particle_set, atom, cell, & DO iatom_local = 1, natom_local_a atom_a = atom(ikind)%list_local_a_index(iatom_local) CALL give_ijk_subcell(coord(:, atom_a), i, j, k, cell, nsubcell) - subcell_a(i, j, k)%natom = subcell_a(i, j, k)%natom+1 + subcell_a(i, j, k)%natom = subcell_a(i, j, k)%natom + 1 END DO END DO DO k = 1, nsubcell(3) @@ -439,14 +439,14 @@ SUBROUTINE build_neighbor_lists(nonbonded, particle_set, atom, cell, & DO iatom_local = 1, natom_local_a atom_a = atom(ikind)%list_local_a_index(iatom_local) CALL give_ijk_subcell(coord(:, atom_a), i, j, k, cell, nsubcell) - subcell_a(i, j, k)%natom = subcell_a(i, j, k)%natom+1 + subcell_a(i, j, k)%natom = subcell_a(i, j, k)%natom + 1 subcell_a(i, j, k)%atom_list(subcell_a(i, j, k)%natom) = atom_a END DO END DO ! Associate particles to subcells (distributed particles) DO atom_b = 1, SIZE(particle_set) CALL give_ijk_subcell(coord(:, atom_b), i, j, k, cell, nsubcell) - subcell_b(i, j, k)%natom = subcell_b(i, j, k)%natom+1 + subcell_b(i, j, k)%natom = subcell_b(i, j, k)%natom + 1 END DO DO k = 1, nsubcell(3) DO j = 1, nsubcell(2) @@ -458,7 +458,7 @@ SUBROUTINE build_neighbor_lists(nonbonded, particle_set, atom, cell, & END DO DO atom_b = 1, SIZE(particle_set) CALL give_ijk_subcell(coord(:, atom_b), i, j, k, cell, nsubcell) - subcell_b(i, j, k)%natom = subcell_b(i, j, k)%natom+1 + subcell_b(i, j, k)%natom = subcell_b(i, j, k)%natom + 1 subcell_b(i, j, k)%atom_list(subcell_b(i, j, k)%natom) = atom_b END DO ! Reorder atoms associated to subcells @@ -492,24 +492,24 @@ SUBROUTINE build_neighbor_lists(nonbonded, particle_set, atom, cell, & IF (subcell_a(a_i, a_j, a_k)%natom == 0) CYCLE ! Loop over second subcell loop_b_k: DO ik = ik_start, isubcell(3) - bg_k = a_k+ik + bg_k = a_k + ik b_k = MOD(bg_k, zdim) b_pk = bg_k/zdim IF (b_k <= 0) THEN - b_k = zdim+b_k - b_pk = b_pk-1 + b_k = zdim + b_k + b_pk = b_pk - 1 END IF IF ((periodic(3) == 0) .AND. (ABS(b_pk) > 0)) CYCLE ! Setup the starting point.. this prescreens the order of the subcells ij_start = -isubcell(2) IF ((ik == 0) .AND. (ik_start == 0)) ij_start = 0 loop_b_j: DO ij = ij_start, isubcell(2) - bg_j = a_j+ij + bg_j = a_j + ij b_j = MOD(bg_j, ydim) b_pj = bg_j/ydim IF (b_j <= 0) THEN - b_j = ydim+b_j - b_pj = b_pj-1 + b_j = ydim + b_j + b_pj = b_pj - 1 END IF IF ((periodic(2) == 0) .AND. (ABS(b_pj) > 0)) CYCLE ! Setup the starting point.. this prescreens the order of the subcells @@ -518,12 +518,12 @@ SUBROUTINE build_neighbor_lists(nonbonded, particle_set, atom, cell, & loop_b_i: DO ii = ii_start, isubcell(1) ! Ellipsoidal screening of subcells IF (.NOT. sphcub(ii, ij, ik)) CYCLE - bg_i = a_i+ii + bg_i = a_i + ii b_i = MOD(bg_i, xdim) b_pi = bg_i/xdim IF (b_i <= 0) THEN - b_i = xdim+b_i - b_pi = b_pi-1 + b_i = xdim + b_i + b_pi = b_pi - 1 END IF IF ((periodic(1) == 0) .AND. (ABS(b_pi) > 0)) CYCLE IF (subcell_b(b_i, b_j, b_k)%natom == 0) CYCLE @@ -541,9 +541,9 @@ SUBROUTINE build_neighbor_lists(nonbonded, particle_set, atom, cell, & DO jatom_local = 1, subcell_b(b_i, b_j, b_k)%natom atom_b = subcell_b(b_i, b_j, b_k)%atom_list(jatom_local) jkind = particle_set(atom_b)%atomic_kind%kind_number - rb(1) = coord(1, atom_b)+cell_v(1) - rb(2) = coord(2, atom_b)+cell_v(2) - rb(3) = coord(3, atom_b)+cell_v(3) + rb(1) = coord(1, atom_b) + cell_v(1) + rb(2) = coord(2, atom_b) + cell_v(2) + rb(3) = coord(3, atom_b) + cell_v(3) DO iatom_local = 1, subcell_a(a_i, a_j, a_k)%natom atom_a = subcell_a(a_i, a_j, a_k)%atom_list(iatom_local) ikind = particle_set(atom_a)%atomic_kind%kind_number @@ -561,18 +561,18 @@ SUBROUTINE build_neighbor_lists(nonbonded, particle_set, atom, cell, & END IF END IF IF (subcell000 .AND. atom_order) CYCLE - rab(1) = rb(1)-coord(1, atom_a) - rab(2) = rb(2)-coord(2, atom_a) - rab(3) = rb(3)-coord(3, atom_a) - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab(1) = rb(1) - coord(1, atom_a) + rab(2) = rb(2) - coord(2, atom_a) + rab(3) = rb(3) - coord(3, atom_a) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) rab_max = r_max(ikind, jkind) rab2_max = rab_max*rab_max IF (rab2 < rab2_max) THEN ! Diagonal storage j1 = MIN(ikind, jkind) - i1 = MAX(ikind, jkind)-j1+1 - j1 = nkind-j1+1 - id_kind = nkind00-(j1*(j1+1)/2)+i1 + i1 = MAX(ikind, jkind) - j1 + 1 + j1 = nkind - j1 + 1 + id_kind = nkind00 - (j1*(j1 + 1)/2) + i1 ! Store the pair CALL fist_neighbor_add(neighbor_kind_pair, atom_a, atom_b, & rab=rab, & @@ -584,7 +584,7 @@ SUBROUTINE build_neighbor_lists(nonbonded, particle_set, atom, cell, & IF ((atom_a == atom_b) .AND. (ik_start == 0)) THEN invcellmap = cellmap(-b_pi, -b_pj, -b_pk) inv_neighbor_kind_pair => nonbonded%neighbor_kind_pairs(invcellmap) - rab = rab-2.0_dp*cell_v + rab = rab - 2.0_dp*cell_v CALL fist_neighbor_add(inv_neighbor_kind_pair, atom_a, atom_b, & rab=rab, & check_spline=check_spline, id_kind=id_kind, & @@ -673,7 +673,7 @@ SUBROUTINE write_neighbor_lists(nonbonded, particle_set, cell, para_env, output_ neighbor_kind_pair => nonbonded%neighbor_kind_pairs(iab) CALL matvec_3x3(cell_v, cell%hmat, REAL(neighbor_kind_pair%cell_vector, KIND=dp)) DO ilist = 1, neighbor_kind_pair%npairs - nneighbor = nneighbor+1 + nneighbor = nneighbor + 1 IF (output_unit > 0) THEN ! Print second part of the headline atom_a = neighbor_kind_pair%list(1, ilist) @@ -687,7 +687,7 @@ SUBROUTINE write_neighbor_lists(nonbonded, particle_set, cell, para_env, output_ ra(:) = pbc(particle_set(atom_a)%r, cell) rb(:) = pbc(particle_set(atom_b)%r, cell) - rab = rb(:)-ra(:)+cell_v + rab = rb(:) - ra(:) + cell_v dab = SQRT(DOT_PRODUCT(rab, rab)) IF (ilist <= neighbor_kind_pair%nscale) THEN WRITE (UNIT=output_unit, FMT="(T3,2(I6,3(1X,F10.6)),3(1X,I3),10X,F8.4,L4,F11.5,F9.5)") & @@ -746,11 +746,11 @@ SUBROUTINE sort_neighbor_lists(nonbonded, nkinds) NULLIFY (neighbor_kind_pair) CALL timeset(routineN, handle) ! define a lookup table to get jkind for a given id_kind - ALLOCATE (indj(nkinds*(nkinds+1)/2)) + ALLOCATE (indj(nkinds*(nkinds + 1)/2)) id_kind = 0 DO jkind = 1, nkinds DO ikind = jkind, nkinds - id_kind = id_kind+1 + id_kind = id_kind + 1 indj(id_kind) = jkind END DO END DO @@ -765,16 +765,16 @@ SUBROUTINE sort_neighbor_lists(nonbonded, nkinds) ! scaled (possibly to zero for exclusion) are not touched. They ! stay packed in the beginning. Sorting is skipped altogether when ! all pairs have scaled interactions. - ALLOCATE (work(1:npairs-nscale)) - ALLOCATE (list_copy(2, 1:npairs-nscale)) + ALLOCATE (work(1:npairs - nscale)) + ALLOCATE (list_copy(2, 1:npairs - nscale)) ! Copy of the pair list is required to perform the permutation below ! correctly. - list_copy = neighbor_kind_pair%list(:, nscale+1:npairs) - CALL sort(neighbor_kind_pair%id_kind(nscale+1:npairs), npairs-nscale, work) + list_copy = neighbor_kind_pair%list(:, nscale + 1:npairs) + CALL sort(neighbor_kind_pair%id_kind(nscale + 1:npairs), npairs - nscale, work) ! Reorder atoms using the same permutation that was used to sort ! the array id_kind. - DO ipair = nscale+1, npairs - tmp = work(ipair-nscale) + DO ipair = nscale + 1, npairs + tmp = work(ipair - nscale) neighbor_kind_pair%list(1, ipair) = list_copy(1, tmp) neighbor_kind_pair%list(2, ipair) = list_copy(2, tmp) END DO @@ -789,7 +789,7 @@ SUBROUTINE sort_neighbor_lists(nonbonded, nkinds) ! Allocate sufficient memory in case all pairs of atom kinds are ! present, and also provide storage for the pairs with exclusion ! flags, which are unsorted. - max_alloc_size = nkinds*(nkinds+1)/2+nscale + max_alloc_size = nkinds*(nkinds + 1)/2 + nscale IF (ASSOCIATED(neighbor_kind_pair%grp_kind_start)) THEN DEALLOCATE (neighbor_kind_pair%grp_kind_start) END IF @@ -809,21 +809,21 @@ SUBROUTINE sort_neighbor_lists(nonbonded, nkinds) ! Get ikind and jkind corresponding to id_kind. id_kind = neighbor_kind_pair%id_kind(ipair) jkind = indj(id_kind) - tmp = nkinds-jkind - ikind = nkinds+id_kind-nkinds*(nkinds+1)/2+(tmp*(tmp+1)/2) + tmp = nkinds - jkind + ikind = nkinds + id_kind - nkinds*(nkinds + 1)/2 + (tmp*(tmp + 1)/2) neighbor_kind_pair%ij_kind(1, neighbor_kind_pair%ngrp_kind) = ikind neighbor_kind_pair%ij_kind(2, neighbor_kind_pair%ngrp_kind) = jkind ! Define the remaining intervals. DO ipair = 2, npairs - IF (neighbor_kind_pair%id_kind(ipair) /= neighbor_kind_pair%id_kind(ipair-1)) THEN - neighbor_kind_pair%grp_kind_end(neighbor_kind_pair%ngrp_kind) = ipair-1 - neighbor_kind_pair%ngrp_kind = neighbor_kind_pair%ngrp_kind+1 + IF (neighbor_kind_pair%id_kind(ipair) /= neighbor_kind_pair%id_kind(ipair - 1)) THEN + neighbor_kind_pair%grp_kind_end(neighbor_kind_pair%ngrp_kind) = ipair - 1 + neighbor_kind_pair%ngrp_kind = neighbor_kind_pair%ngrp_kind + 1 neighbor_kind_pair%grp_kind_start(neighbor_kind_pair%ngrp_kind) = ipair ! Get ikind and jkind corresponding to id_kind. id_kind = neighbor_kind_pair%id_kind(ipair) jkind = indj(id_kind) - tmp = nkinds-jkind - ikind = nkinds+id_kind-nkinds*(nkinds+1)/2+(tmp*(tmp+1)/2) + tmp = nkinds - jkind + ikind = nkinds + id_kind - nkinds*(nkinds + 1)/2 + (tmp*(tmp + 1)/2) neighbor_kind_pair%ij_kind(1, neighbor_kind_pair%ngrp_kind) = ikind neighbor_kind_pair%ij_kind(2, neighbor_kind_pair%ngrp_kind) = jkind END IF diff --git a/src/fist_nonbond_env_types.F b/src/fist_nonbond_env_types.F index ece62f6317..063f68d239 100644 --- a/src/fist_nonbond_env_types.F +++ b/src/fist_nonbond_env_types.F @@ -352,7 +352,7 @@ SUBROUTINE init_fist_nonbond_env(fist_nonbond_env, atomic_kind_set, & fist_nonbond_env%long_range_correction = 0 fist_nonbond_env%ref_count = 1 fist_nonbond_env%id_nr = last_fist_nonbond_env_id_nr - last_fist_nonbond_env_id_nr = last_fist_nonbond_env_id_nr+1 + last_fist_nonbond_env_id_nr = last_fist_nonbond_env_id_nr + 1 IF (do_nonbonded) THEN natom_types = 1 ! Determine size of kind arrays @@ -384,7 +384,7 @@ SUBROUTINE init_fist_nonbond_env(fist_nonbond_env, atomic_kind_set, & ! Warning: rlist_rcut should only be used by the neighbor list ! algorithm. It is not the cutoff for the evaluation of the ! interactions because rlist_rcut includes the Verlet skin. - rcut = MAX(rcut, ewald_rcut)+verlet_skin + rcut = MAX(rcut, ewald_rcut) + verlet_skin fist_nonbond_env%rlist_cut(idim, jdim) = rcut fist_nonbond_env%rlist_cut(jdim, idim) = rcut rlow = rlow*(1.06_dp)**2 ! 1.06_dp in order to have 1/2 Emax_spline @@ -442,7 +442,7 @@ SUBROUTINE fist_nonbond_env_retain(fist_nonbond_env) CPASSERT(ASSOCIATED(fist_nonbond_env)) CPASSERT(fist_nonbond_env%ref_count > 0) - fist_nonbond_env%ref_count = fist_nonbond_env%ref_count+1 + fist_nonbond_env%ref_count = fist_nonbond_env%ref_count + 1 END SUBROUTINE fist_nonbond_env_retain ! ************************************************************************************************** @@ -460,7 +460,7 @@ SUBROUTINE fist_nonbond_env_release(fist_nonbond_env) IF (ASSOCIATED(fist_nonbond_env)) THEN CPASSERT(fist_nonbond_env%ref_count > 0) - fist_nonbond_env%ref_count = fist_nonbond_env%ref_count-1 + fist_nonbond_env%ref_count = fist_nonbond_env%ref_count - 1 IF (fist_nonbond_env%ref_count < 1) THEN IF (ASSOCIATED(fist_nonbond_env%nonbonded)) THEN CALL fist_neighbor_deallocate(fist_nonbond_env%nonbonded) diff --git a/src/fist_nonbond_force.F b/src/fist_nonbond_force.F index e70efa17cf..cd48f2e028 100644 --- a/src/fist_nonbond_force.F +++ b/src/fist_nonbond_force.F @@ -284,7 +284,7 @@ SUBROUTINE force_nonbond(fist_nonbond_env, ewald_env, particle_set, cell, & beta_b = sqrthalf/mm_radius_b END IF IF ((mm_radius_a > 0) .OR. (mm_radius_b > 0)) THEN - beta = sqrthalf/SQRT(mm_radius_a*mm_radius_a+mm_radius_b*mm_radius_b) + beta = sqrthalf/SQRT(mm_radius_a*mm_radius_a + mm_radius_b*mm_radius_b) END IF END IF @@ -309,55 +309,55 @@ SUBROUTINE force_nonbond(fist_nonbond_env, ewald_env, particle_set, cell, & IF (shell_type == sh_sh) THEN shell_a = particle_set(atom_a)%shell_index shell_b = particle_set(atom_b)%shell_index - rab_cc = rcore_last_update_pbc(shell_b)%r-rcore_last_update_pbc(shell_a)%r - rab_cs = rshell_last_update_pbc(shell_b)%r-rcore_last_update_pbc(shell_a)%r - rab_sc = rcore_last_update_pbc(shell_b)%r-rshell_last_update_pbc(shell_a)%r - rab_ss = rshell_last_update_pbc(shell_b)%r-rshell_last_update_pbc(shell_a)%r - rab_list(1:3, 1) = rab_cc(1:3)+cell_v(1:3) - rab_list(1:3, 2) = rab_cs(1:3)+cell_v(1:3) - rab_list(1:3, 3) = rab_sc(1:3)+cell_v(1:3) - rab_list(1:3, 4) = rab_ss(1:3)+cell_v(1:3) + rab_cc = rcore_last_update_pbc(shell_b)%r - rcore_last_update_pbc(shell_a)%r + rab_cs = rshell_last_update_pbc(shell_b)%r - rcore_last_update_pbc(shell_a)%r + rab_sc = rcore_last_update_pbc(shell_b)%r - rshell_last_update_pbc(shell_a)%r + rab_ss = rshell_last_update_pbc(shell_b)%r - rshell_last_update_pbc(shell_a)%r + rab_list(1:3, 1) = rab_cc(1:3) + cell_v(1:3) + rab_list(1:3, 2) = rab_cs(1:3) + cell_v(1:3) + rab_list(1:3, 3) = rab_sc(1:3) + cell_v(1:3) + rab_list(1:3, 4) = rab_ss(1:3) + cell_v(1:3) ELSE IF ((shell_type == nosh_sh) .AND. (particle_set(atom_a)%shell_index /= 0)) THEN shell_a = particle_set(atom_a)%shell_index shell_b = 0 - rab_cc = r_last_update_pbc(atom_b)%r-rcore_last_update_pbc(shell_a)%r + rab_cc = r_last_update_pbc(atom_b)%r - rcore_last_update_pbc(shell_a)%r rab_sc = 0.0_dp rab_cs = 0.0_dp - rab_ss = r_last_update_pbc(atom_b)%r-rshell_last_update_pbc(shell_a)%r - rab_list(1:3, 1) = rab_cc(1:3)+cell_v(1:3) + rab_ss = r_last_update_pbc(atom_b)%r - rshell_last_update_pbc(shell_a)%r + rab_list(1:3, 1) = rab_cc(1:3) + cell_v(1:3) rab_list(1:3, 2) = 0.0_dp rab_list(1:3, 3) = 0.0_dp - rab_list(1:3, 4) = rab_ss(1:3)+cell_v(1:3) + rab_list(1:3, 4) = rab_ss(1:3) + cell_v(1:3) ELSE IF ((shell_type == nosh_sh) .AND. (particle_set(atom_b)%shell_index /= 0)) THEN shell_b = particle_set(atom_b)%shell_index shell_a = 0 - rab_cc = rcore_last_update_pbc(shell_b)%r-r_last_update_pbc(atom_a)%r + rab_cc = rcore_last_update_pbc(shell_b)%r - r_last_update_pbc(atom_a)%r rab_sc = 0.0_dp rab_cs = 0.0_dp - rab_ss = rshell_last_update_pbc(shell_b)%r-r_last_update_pbc(atom_a)%r - rab_list(1:3, 1) = rab_cc(1:3)+cell_v(1:3) + rab_ss = rshell_last_update_pbc(shell_b)%r - r_last_update_pbc(atom_a)%r + rab_list(1:3, 1) = rab_cc(1:3) + cell_v(1:3) rab_list(1:3, 2) = 0.0_dp rab_list(1:3, 3) = 0.0_dp - rab_list(1:3, 4) = rab_ss(1:3)+cell_v(1:3) + rab_list(1:3, 4) = rab_ss(1:3) + cell_v(1:3) END IF ! Compute the term only if all the pairs (cc,cs,sc,ss) are within the cut-off Check_terms: DO i = 1, 4 - rab2_list(i) = rab_list(1, i)**2+rab_list(2, i)**2+rab_list(3, i)**2 + rab2_list(i) = rab_list(1, i)**2 + rab_list(2, i)**2 + rab_list(3, i)**2 IF (rab2_list(i) >= rab2_max) THEN all_terms = .FALSE. EXIT Check_terms END IF END DO Check_terms - rab_com = r_last_update_pbc(atom_b)%r-r_last_update_pbc(atom_a)%r + rab_com = r_last_update_pbc(atom_b)%r - r_last_update_pbc(atom_a)%r ELSE ! not do shell - rab_cc = r_last_update_pbc(atom_b)%r-r_last_update_pbc(atom_a)%r + rab_cc = r_last_update_pbc(atom_b)%r - r_last_update_pbc(atom_a)%r rab_com = rab_cc shell_a = 0 shell_b = 0 END IF - rab_com = rab_com+cell_v - rab2_com = rab_com(1)**2+rab_com(2)**2+rab_com(3)**2 + rab_com = rab_com + cell_v + rab2_com = rab_com(1)**2 + rab_com(2)**2 + rab_com(3)**2 ! compute the interactions for the current pair etot = 0.0_dp @@ -395,7 +395,7 @@ SUBROUTINE force_nonbond(fist_nonbond_env, ewald_env, particle_set, cell, & ei_interaction_cutoffs(1, kind_a, kind_b)) CALL add_force_nonbond(fcore_a, fcore_b, pv, fscalar, rab, use_virial) END IF - etot = etot+energy + etot = etot + energy END IF IF (shell_type == sh_sh) THEN @@ -405,7 +405,7 @@ SUBROUTINE force_nonbond(fist_nonbond_env, ewald_env, particle_set, cell, & fscalar = 0.0_dp IF (fac_vdw > 0) THEN energy = potential_s(spline_data, rab2, fscalar, spl_f, logger) - etot = etot+energy*fac_vdw + etot = etot + energy*fac_vdw fscalar = fscalar*fac_vdw END IF IF (fac_ei > 0) THEN @@ -413,7 +413,7 @@ SUBROUTINE force_nonbond(fist_nonbond_env, ewald_env, particle_set, cell, & energy = potential_coulomb(rab2, fscalar, fac_ei*qshell_a*qshell_b, & ewald_type, alpha, beta, & ei_interaction_cutoffs(3, kind_a, kind_b)) - etot = etot+energy + etot = etot + energy END IF CALL add_force_nonbond(fshell_a, fshell_b, pv, fscalar, rab, use_virial) @@ -426,7 +426,7 @@ SUBROUTINE force_nonbond(fist_nonbond_env, ewald_env, particle_set, cell, & energy = potential_coulomb(rab2, fscalar, fac_ei*qcore_a*qshell_b, & ewald_type, alpha, beta_b, & ei_interaction_cutoffs(2, kind_b, kind_a)) - etot = etot+energy + etot = etot + energy CALL add_force_nonbond(fcore_a, fshell_b, pv, fscalar, rab, use_virial) ! shell-core: Coulomb only @@ -436,7 +436,7 @@ SUBROUTINE force_nonbond(fist_nonbond_env, ewald_env, particle_set, cell, & energy = potential_coulomb(rab2, fscalar, fac_ei*qshell_a*qcore_b, & ewald_type, alpha, beta_a, & ei_interaction_cutoffs(2, kind_a, kind_b)) - etot = etot+energy + etot = etot + energy CALL add_force_nonbond(fshell_a, fcore_b, pv, fscalar, rab, use_virial) END IF ELSE IF ((shell_type == nosh_sh) .AND. (shell_a == 0)) THEN @@ -446,7 +446,7 @@ SUBROUTINE force_nonbond(fist_nonbond_env, ewald_env, particle_set, cell, & fscalar = 0.0_dp IF (fac_vdw > 0) THEN energy = potential_s(spline_data, rab2, fscalar, spl_f, logger) - etot = etot+energy*fac_vdw + etot = etot + energy*fac_vdw fscalar = fscalar*fac_vdw END IF IF (fac_ei > 0) THEN @@ -454,7 +454,7 @@ SUBROUTINE force_nonbond(fist_nonbond_env, ewald_env, particle_set, cell, & energy = potential_coulomb(rab2, fscalar, fac_ei*qeff_a*qshell_b, & ewald_type, alpha, beta, & ei_interaction_cutoffs(3, kind_a, kind_b)) - etot = etot+energy + etot = etot + energy END IF CALL add_force_nonbond(fatom_a, fshell_b, pv, fscalar, rab, use_virial) ELSE IF ((shell_type == nosh_sh) .AND. (shell_b == 0)) THEN @@ -464,7 +464,7 @@ SUBROUTINE force_nonbond(fist_nonbond_env, ewald_env, particle_set, cell, & fscalar = 0.0_dp IF (fac_vdw > 0) THEN energy = potential_s(spline_data, rab2, fscalar, spl_f, logger) - etot = etot+energy*fac_vdw + etot = etot + energy*fac_vdw fscalar = fscalar*fac_vdw END IF IF (fac_ei > 0) THEN @@ -472,7 +472,7 @@ SUBROUTINE force_nonbond(fist_nonbond_env, ewald_env, particle_set, cell, & energy = potential_coulomb(rab2, fscalar, fac_ei*qshell_a*qeff_b, & ewald_type, alpha, beta, & ei_interaction_cutoffs(3, kind_a, kind_b)) - etot = etot+energy + etot = etot + energy END IF CALL add_force_nonbond(fshell_a, fatom_b, pv, fscalar, rab, use_virial) END IF @@ -486,7 +486,7 @@ SUBROUTINE force_nonbond(fist_nonbond_env, ewald_env, particle_set, cell, & fscalar = 0.0_dp IF (fac_vdw > 0) THEN energy = potential_s(spline_data, rab2, fscalar, spl_f, logger) - etot = etot+energy*fac_vdw + etot = etot + energy*fac_vdw fscalar = fscalar*fac_vdw END IF IF (fac_ei > 0) THEN @@ -494,56 +494,56 @@ SUBROUTINE force_nonbond(fist_nonbond_env, ewald_env, particle_set, cell, & energy = potential_coulomb(rab2, fscalar, fac_ei*qeff_a*qeff_b, & ewald_type, alpha, beta, & ei_interaction_cutoffs(3, kind_a, kind_b)) - etot = etot+energy + etot = etot + energy END IF CALL add_force_nonbond(fatom_a, fatom_b, pv, fscalar, rab, use_virial) END IF END IF ! Nonbonded energy !$OMP ATOMIC - pot_nonbond = pot_nonbond+etot + pot_nonbond = pot_nonbond + etot IF (atprop_env%energy) THEN ! Update atomic energies !$OMP ATOMIC - atprop_env%atener(atom_a) = atprop_env%atener(atom_a)+0.5_dp*etot + atprop_env%atener(atom_a) = atprop_env%atener(atom_a) + 0.5_dp*etot !$OMP ATOMIC - atprop_env%atener(atom_b) = atprop_env%atener(atom_b)+0.5_dp*etot + atprop_env%atener(atom_b) = atprop_env%atener(atom_b) + 0.5_dp*etot END IF ! Nonbonded forces DO i = 1, 3 !$OMP ATOMIC - f_nonbond(i, atom_a) = f_nonbond(i, atom_a)+fatom_a(i) + f_nonbond(i, atom_a) = f_nonbond(i, atom_a) + fatom_a(i) !$OMP ATOMIC - f_nonbond(i, atom_b) = f_nonbond(i, atom_b)+fatom_b(i) + f_nonbond(i, atom_b) = f_nonbond(i, atom_b) + fatom_b(i) END DO IF (shell_a > 0) THEN DO i = 1, 3 !$OMP ATOMIC - fcore_nonbond(i, shell_a) = fcore_nonbond(i, shell_a)+fcore_a(i) + fcore_nonbond(i, shell_a) = fcore_nonbond(i, shell_a) + fcore_a(i) !$OMP ATOMIC - fshell_nonbond(i, shell_a) = fshell_nonbond(i, shell_a)+fshell_a(i) + fshell_nonbond(i, shell_a) = fshell_nonbond(i, shell_a) + fshell_a(i) END DO END IF IF (shell_b > 0) THEN DO i = 1, 3 !$OMP ATOMIC - fcore_nonbond(i, shell_b) = fcore_nonbond(i, shell_b)+fcore_b(i) + fcore_nonbond(i, shell_b) = fcore_nonbond(i, shell_b) + fcore_b(i) !$OMP ATOMIC - fshell_nonbond(i, shell_b) = fshell_nonbond(i, shell_b)+fshell_b(i) + fshell_nonbond(i, shell_b) = fshell_nonbond(i, shell_b) + fshell_b(i) END DO END IF ! Add the contribution of the current pair to the total pressure tensor IF (use_virial) THEN DO i = 1, 3 DO j = 1, 3 - pv_thread(j, i) = pv_thread(j, i)+pv(j, i) + pv_thread(j, i) = pv_thread(j, i) + pv(j, i) ! Update atomic stress tensors IF (atprop_env%stress) THEN !$OMP ATOMIC - atprop_env%atstress(j, i, atom_a) = atprop_env%atstress(j, i, atom_a)+ & + atprop_env%atstress(j, i, atom_a) = atprop_env%atstress(j, i, atom_a) + & 0.5_dp*pv(j, i) !$OMP ATOMIC - atprop_env%atstress(j, i, atom_b) = atprop_env%atstress(j, i, atom_b)+ & + atprop_env%atstress(j, i, atom_b) = atprop_env%atstress(j, i, atom_b) + & 0.5_dp*pv(j, i) END IF END DO @@ -555,7 +555,7 @@ SUBROUTINE force_nonbond(fist_nonbond_env, ewald_env, particle_set, cell, & DO i = 1, 3 DO j = 1, 3 !$OMP ATOMIC - pv_nonbond(j, i) = pv_nonbond(j, i)+pv_thread(j, i) + pv_nonbond(j, i) = pv_nonbond(j, i) + pv_thread(j, i) END DO END DO END IF @@ -602,22 +602,22 @@ SUBROUTINE add_force_nonbond(f_nonbond_a, f_nonbond_b, pv, fscalar, rab, use_vir fr(1) = fscalar*rab(1) fr(2) = fscalar*rab(2) fr(3) = fscalar*rab(3) - f_nonbond_a(1) = f_nonbond_a(1)-fr(1) - f_nonbond_a(2) = f_nonbond_a(2)-fr(2) - f_nonbond_a(3) = f_nonbond_a(3)-fr(3) - f_nonbond_b(1) = f_nonbond_b(1)+fr(1) - f_nonbond_b(2) = f_nonbond_b(2)+fr(2) - f_nonbond_b(3) = f_nonbond_b(3)+fr(3) + f_nonbond_a(1) = f_nonbond_a(1) - fr(1) + f_nonbond_a(2) = f_nonbond_a(2) - fr(2) + f_nonbond_a(3) = f_nonbond_a(3) - fr(3) + f_nonbond_b(1) = f_nonbond_b(1) + fr(1) + f_nonbond_b(2) = f_nonbond_b(2) + fr(2) + f_nonbond_b(3) = f_nonbond_b(3) + fr(3) IF (use_virial) THEN - pv(1, 1) = pv(1, 1)+rab(1)*fr(1) - pv(1, 2) = pv(1, 2)+rab(1)*fr(2) - pv(1, 3) = pv(1, 3)+rab(1)*fr(3) - pv(2, 1) = pv(2, 1)+rab(2)*fr(1) - pv(2, 2) = pv(2, 2)+rab(2)*fr(2) - pv(2, 3) = pv(2, 3)+rab(2)*fr(3) - pv(3, 1) = pv(3, 1)+rab(3)*fr(1) - pv(3, 2) = pv(3, 2)+rab(3)*fr(2) - pv(3, 3) = pv(3, 3)+rab(3)*fr(3) + pv(1, 1) = pv(1, 1) + rab(1)*fr(1) + pv(1, 2) = pv(1, 2) + rab(1)*fr(2) + pv(1, 3) = pv(1, 3) + rab(1)*fr(3) + pv(2, 1) = pv(2, 1) + rab(2)*fr(1) + pv(2, 2) = pv(2, 2) + rab(2)*fr(2) + pv(2, 3) = pv(2, 3) + rab(2)*fr(3) + pv(3, 1) = pv(3, 1) + rab(3)*fr(1) + pv(3, 2) = pv(3, 2) + rab(3)*fr(2) + pv(3, 3) = pv(3, 3) + rab(3)*fr(3) END IF END SUBROUTINE @@ -733,7 +733,7 @@ SUBROUTINE bonded_correct_gaussian(fist_nonbond_env, atomic_kind_set, & END IF ! The amount of correction is related to the ! amount of scaling as follows: - fac_cor = 1.0_dp-fac_ei + fac_cor = 1.0_dp - fac_ei IF (fac_cor <= 0.0_dp) CYCLE ! Parameters for kind a @@ -927,38 +927,38 @@ SUBROUTINE bonded_correct_gaussian_low(r1, r2, cell, v_bonded_corr, & REAL(KIND=dp), DIMENSION(3) :: fij_com, rij REAL(KIND=dp), DIMENSION(3, 3) :: fbc - rij = r1-r2 + rij = r1 - r2 rij = pbc(rij, cell) - rijsq = rij(1)*rij(1)+rij(2)*rij(2)+rij(3)*rij(3) + rijsq = rij(1)*rij(1) + rij(2)*rij(2) + rij(3)*rij(3) idij = 1.0_dp/SQRT(rijsq) dij = rijsq*idij arg = alpha*dij e_arg_arg = EXP(-arg**2) - tc = 1.0_dp/(1.0_dp+pc*arg) + tc = 1.0_dp/(1.0_dp + pc*arg) ! Defining errf=1-erfc - errf = 1.0_dp-((((ac5*tc+ac4)*tc+ac3)*tc+ac2)*tc+ac1)*tc*e_arg_arg + errf = 1.0_dp - ((((ac5*tc + ac4)*tc + ac3)*tc + ac2)*tc + ac1)*tc*e_arg_arg ! Getting the potential vbc = -q1*q2*idij*errf*fac_cor - v_bonded_corr = v_bonded_corr+vbc + v_bonded_corr = v_bonded_corr + vbc IF (atprop_env%energy) THEN iatom = particle_set1(i)%atom_index - atprop_env%atener(iatom) = atprop_env%atener(iatom)+0.5_dp*vbc + atprop_env%atener(iatom) = atprop_env%atener(iatom) + 0.5_dp*vbc jatom = particle_set2(j)%atom_index - atprop_env%atener(jatom) = atprop_env%atener(jatom)+0.5_dp*vbc + atprop_env%atener(jatom) = atprop_env%atener(jatom) + 0.5_dp*vbc END IF ! Subtracting the force from the total force - fscalar = q1*q2*idij**2*(idij*errf-const*e_arg_arg)*fac_cor + fscalar = q1*q2*idij**2*(idij*errf - const*e_arg_arg)*fac_cor - particle_set1(i)%f(1) = particle_set1(i)%f(1)-fscalar*rij(1) - particle_set1(i)%f(2) = particle_set1(i)%f(2)-fscalar*rij(2) - particle_set1(i)%f(3) = particle_set1(i)%f(3)-fscalar*rij(3) + particle_set1(i)%f(1) = particle_set1(i)%f(1) - fscalar*rij(1) + particle_set1(i)%f(2) = particle_set1(i)%f(2) - fscalar*rij(2) + particle_set1(i)%f(3) = particle_set1(i)%f(3) - fscalar*rij(3) - particle_set2(j)%f(1) = particle_set2(j)%f(1)+fscalar*rij(1) - particle_set2(j)%f(2) = particle_set2(j)%f(2)+fscalar*rij(2) - particle_set2(j)%f(3) = particle_set2(j)%f(3)+fscalar*rij(3) + particle_set2(j)%f(1) = particle_set2(j)%f(1) + fscalar*rij(1) + particle_set2(j)%f(2) = particle_set2(j)%f(2) + fscalar*rij(2) + particle_set2(j)%f(3) = particle_set2(j)%f(3) + fscalar*rij(3) IF (use_virial .AND. shell_adiabatic) THEN fij_com = fscalar*rij @@ -971,13 +971,13 @@ SUBROUTINE bonded_correct_gaussian_low(r1, r2, cell, v_bonded_corr, & fbc(3, 1) = -fij_com(3)*rij(1) fbc(3, 2) = -fij_com(3)*rij(2) fbc(3, 3) = -fij_com(3)*rij(3) - pv_bc(:, :) = pv_bc(:, :)+fbc(:, :) + pv_bc(:, :) = pv_bc(:, :) + fbc(:, :) IF (atprop_env%stress) THEN ! Atomic stress tensors iatom = particle_set1(i)%atom_index - atprop_env%atstress(:, :, iatom) = atprop_env%atstress(:, :, iatom)+0.5_dp*fbc(:, :) + atprop_env%atstress(:, :, iatom) = atprop_env%atstress(:, :, iatom) + 0.5_dp*fbc(:, :) jatom = particle_set2(j)%atom_index - atprop_env%atstress(:, :, jatom) = atprop_env%atstress(:, :, jatom)+0.5_dp*fbc(:, :) + atprop_env%atstress(:, :, jatom) = atprop_env%atstress(:, :, jatom) + 0.5_dp*fbc(:, :) END IF END IF @@ -1032,9 +1032,9 @@ SUBROUTINE bonded_correct_gaussian_low_sh(r1, r2, cell, v_bonded_corr, & REAL(KIND=dp), DIMENSION(3) :: fr, rij REAL(KIND=dp), DIMENSION(3, 3) :: fbc - rij = r1-r2 + rij = r1 - r2 rij = pbc(rij, cell) - rijsq = rij(1)*rij(1)+rij(2)*rij(2)+rij(3)*rij(3) + rijsq = rij(1)*rij(1) + rij(2)*rij(2) + rij(3)*rij(3) dij = SQRT(rijsq) ! Two possible limiting cases according the value of dij arg = alpha*dij @@ -1043,40 +1043,40 @@ SUBROUTINE bonded_correct_gaussian_low_sh(r1, r2, cell, v_bonded_corr, & IF (arg > 0.355_dp) THEN idij = 1.0_dp/dij e_arg_arg = EXP(-arg*arg) - tc = 1.0_dp/(1.0_dp+pc*arg) + tc = 1.0_dp/(1.0_dp + pc*arg) ! defining errf = 1 - erfc - errf = 1.0_dp-((((ac5*tc+ac4)*tc+ac3)*tc+ac2)*tc+ac1)*tc*e_arg_arg + errf = 1.0_dp - ((((ac5*tc + ac4)*tc + ac3)*tc + ac2)*tc + ac1)*tc*e_arg_arg efac = idij*errf - ffac = idij**2*(efac-const*e_arg_arg) + ffac = idij**2*(efac - const*e_arg_arg) ELSE tc = arg*arg tc2 = tc*tc tc4 = tc2*tc2 - efac = const*(1.0_dp-tc/3.0_dp+tc2/10.0_dp-tc*tc2/42.0_dp+tc4/216.0_dp- & - tc*tc4/1320.0_dp+tc2*tc4/9360.0_dp) - ffac = const*alpha**2*(2.0_dp/3.0_dp-2.0_dp*tc/5.0_dp+tc2/7.0_dp-tc*tc2/27.0_dp+ & - tc4/132.0_dp-tc*tc4/780.0_dp) + efac = const*(1.0_dp - tc/3.0_dp + tc2/10.0_dp - tc*tc2/42.0_dp + tc4/216.0_dp - & + tc*tc4/1320.0_dp + tc2*tc4/9360.0_dp) + ffac = const*alpha**2*(2.0_dp/3.0_dp - 2.0_dp*tc/5.0_dp + tc2/7.0_dp - tc*tc2/27.0_dp + & + tc4/132.0_dp - tc*tc4/780.0_dp) END IF ! getting the potential vbc = -q1*q2*efac - v_bonded_corr = v_bonded_corr+vbc + v_bonded_corr = v_bonded_corr + vbc IF (atprop_env%energy) THEN iatom = shell_particle_set(i)%atom_index - atprop_env%atener(iatom) = atprop_env%atener(iatom)+vbc + atprop_env%atener(iatom) = atprop_env%atener(iatom) + vbc END IF ! subtracting the force from the total force fscalar = q1*q2*ffac fr(:) = fscalar*rij(:) - core_particle_set(i)%f(1) = core_particle_set(i)%f(1)-fr(1) - core_particle_set(i)%f(2) = core_particle_set(i)%f(2)-fr(2) - core_particle_set(i)%f(3) = core_particle_set(i)%f(3)-fr(3) + core_particle_set(i)%f(1) = core_particle_set(i)%f(1) - fr(1) + core_particle_set(i)%f(2) = core_particle_set(i)%f(2) - fr(2) + core_particle_set(i)%f(3) = core_particle_set(i)%f(3) - fr(3) - shell_particle_set(i)%f(1) = shell_particle_set(i)%f(1)+fr(1) - shell_particle_set(i)%f(2) = shell_particle_set(i)%f(2)+fr(2) - shell_particle_set(i)%f(3) = shell_particle_set(i)%f(3)+fr(3) + shell_particle_set(i)%f(1) = shell_particle_set(i)%f(1) + fr(1) + shell_particle_set(i)%f(2) = shell_particle_set(i)%f(2) + fr(2) + shell_particle_set(i)%f(3) = shell_particle_set(i)%f(3) + fr(3) IF (use_virial .AND. shell_adiabatic) THEN fbc(1, 1) = -fr(1)*rij(1) @@ -1088,11 +1088,11 @@ SUBROUTINE bonded_correct_gaussian_low_sh(r1, r2, cell, v_bonded_corr, & fbc(3, 1) = -fr(3)*rij(1) fbc(3, 2) = -fr(3)*rij(2) fbc(3, 3) = -fr(3)*rij(3) - pv_bc(:, :) = pv_bc(:, :)+fbc(:, :) + pv_bc(:, :) = pv_bc(:, :) + fbc(:, :) IF (atprop_env%stress) THEN ! Atomic stress tensors iatom = shell_particle_set(i)%atom_index - atprop_env%atstress(:, :, iatom) = atprop_env%atstress(:, :, iatom)+fbc(:, :) + atprop_env%atstress(:, :, iatom) = atprop_env%atstress(:, :, iatom) + fbc(:, :) END IF END IF diff --git a/src/fist_pol_scf.F b/src/fist_pol_scf.F index 7705391f52..db673ef967 100644 --- a/src/fist_pol_scf.F +++ b/src/fist_pol_scf.F @@ -208,8 +208,8 @@ SUBROUTINE fist_pol_evaluate_sc(atomic_kind_set, multipoles, ewald_env, ewald_pw ! ignore atoms with dipole and quadrupole polarizability zero IF (apol == 0 .AND. cpol == 0) CYCLE ! increment counter correctly - IF (apol /= 0) ntot = ntot+natom_of_kind - IF (cpol /= 0) ntot = ntot+natom_of_kind + IF (apol /= 0) ntot = ntot + natom_of_kind + IF (cpol /= 0) ntot = ntot + natom_of_kind DO iatom = 1, natom_of_kind ii = atom_list(iatom) @@ -217,19 +217,19 @@ SUBROUTINE fist_pol_evaluate_sc(atomic_kind_set, multipoles, ewald_env, ewald_pw DO i = 1, 3 ! the rmsd of the derivatives of the energy towards the ! components of the atomic dipole moments - rmsd = rmsd+(multipoles%dipoles(i, ii)/apol-efield1(i, ii))**2 + rmsd = rmsd + (multipoles%dipoles(i, ii)/apol - efield1(i, ii))**2 END DO END IF IF (cpol /= 0) THEN - rmsd = rmsd+(multipoles%quadrupoles(1, 1, ii)/cpol-efield2(1, ii))**2 - rmsd = rmsd+(multipoles%quadrupoles(2, 1, ii)/cpol-efield2(2, ii))**2 - rmsd = rmsd+(multipoles%quadrupoles(3, 1, ii)/cpol-efield2(3, ii))**2 - rmsd = rmsd+(multipoles%quadrupoles(1, 2, ii)/cpol-efield2(4, ii))**2 - rmsd = rmsd+(multipoles%quadrupoles(2, 2, ii)/cpol-efield2(5, ii))**2 - rmsd = rmsd+(multipoles%quadrupoles(3, 2, ii)/cpol-efield2(6, ii))**2 - rmsd = rmsd+(multipoles%quadrupoles(1, 3, ii)/cpol-efield2(7, ii))**2 - rmsd = rmsd+(multipoles%quadrupoles(2, 3, ii)/cpol-efield2(8, ii))**2 - rmsd = rmsd+(multipoles%quadrupoles(3, 3, ii)/cpol-efield2(9, ii))**2 + rmsd = rmsd + (multipoles%quadrupoles(1, 1, ii)/cpol - efield2(1, ii))**2 + rmsd = rmsd + (multipoles%quadrupoles(2, 1, ii)/cpol - efield2(2, ii))**2 + rmsd = rmsd + (multipoles%quadrupoles(3, 1, ii)/cpol - efield2(3, ii))**2 + rmsd = rmsd + (multipoles%quadrupoles(1, 2, ii)/cpol - efield2(4, ii))**2 + rmsd = rmsd + (multipoles%quadrupoles(2, 2, ii)/cpol - efield2(5, ii))**2 + rmsd = rmsd + (multipoles%quadrupoles(3, 2, ii)/cpol - efield2(6, ii))**2 + rmsd = rmsd + (multipoles%quadrupoles(1, 3, ii)/cpol - efield2(7, ii))**2 + rmsd = rmsd + (multipoles%quadrupoles(2, 3, ii)/cpol - efield2(8, ii))**2 + rmsd = rmsd + (multipoles%quadrupoles(3, 3, ii)/cpol - efield2(9, ii))**2 END IF ! compute dipole multipoles%dipoles(:, ii) = apol*efield1(:, ii) @@ -247,7 +247,7 @@ SUBROUTINE fist_pol_evaluate_sc(atomic_kind_set, multipoles, ewald_env, ewald_pw END IF ! Compute the new induction term while we are here IF (apol /= 0) THEN - thermo%e_induction = thermo%e_induction+ & + thermo%e_induction = thermo%e_induction + & DOT_PRODUCT(multipoles%dipoles(:, ii), & multipoles%dipoles(:, ii))/apol/2.0_dp END IF @@ -255,11 +255,11 @@ SUBROUTINE fist_pol_evaluate_sc(atomic_kind_set, multipoles, ewald_env, ewald_pw tmp_trace = 0._dp DO i = 1, 3 DO j = 1, 3 - tmp_trace = tmp_trace+ & + tmp_trace = tmp_trace + & multipoles%quadrupoles(i, j, ii)*multipoles%quadrupoles(i, j, ii) END DO END DO - thermo%e_induction = thermo%e_induction+tmp_trace/cpol/6.0_dp + thermo%e_induction = thermo%e_induction + tmp_trace/cpol/6.0_dp END IF END DO END DO @@ -267,7 +267,7 @@ SUBROUTINE fist_pol_evaluate_sc(atomic_kind_set, multipoles, ewald_env, ewald_pw IF (iw > 0) THEN ! print the energy that is minimized (this is electrostatic + induction) WRITE (iw, FMT='(T5,"POL_SCF|",5X,I5,5X,E12.6,T61,F20.10)') iter, & - rmsd, vg_coulomb+pot_nonbond_local+thermo%e_induction + rmsd, vg_coulomb + pot_nonbond_local + thermo%e_induction END IF IF (rmsd <= eps_pol) THEN IF (iw > 0) WRITE (iw, FMT='(T5,"POL_SCF|",1X,"Self-consistent Polarization achieved.")') @@ -288,13 +288,13 @@ SUBROUTINE fist_pol_evaluate_sc(atomic_kind_set, multipoles, ewald_env, ewald_pw atomic_kind_set=atomic_kind_set, mm_section=mm_section, & forces_local=fg_coulomb, forces_glob=f_nonbond, & pv_local=pv_g, pv_glob=pv_nonbond) - pot_nonbond = pot_nonbond+pot_nonbond_local + pot_nonbond = pot_nonbond + pot_nonbond_local CALL mp_sum(pot_nonbond_local, logger%para_env%group) IF (iw > 0) THEN ! print the energy that is minimized (this is electrostatic + induction) WRITE (iw, FMT='(T5,"POL_SCF|",5X,"Final",T61,F20.10,/)') & - vg_coulomb+pot_nonbond_local+thermo%e_induction + vg_coulomb + pot_nonbond_local + thermo%e_induction END IF ! Deallocate working arrays @@ -434,12 +434,12 @@ SUBROUTINE fist_pol_evaluate_cg(atomic_kind_set, multipoles, ewald_env, ewald_pw CALL get_atomic_kind(atomic_kind, apol=apol, natom=natom_of_kind, atom_list=atom_list) ! ignore atoms with polarizability zero IF (apol == 0) CYCLE - ntot = ntot+natom_of_kind + ntot = ntot + natom_of_kind DO iatom = 1, natom_of_kind ii = atom_list(iatom) DO i = 1, 3 ! residual = b - A x - residual(i, ii) = efield1(i, ii)-multipoles%dipoles(i, ii)/apol + residual(i, ii) = efield1(i, ii) - multipoles%dipoles(i, ii)/apol END DO END DO END DO @@ -474,10 +474,10 @@ SUBROUTINE fist_pol_evaluate_cg(atomic_kind_set, multipoles, ewald_env, ewald_pw ii = atom_list(iatom) DO i = 1, 3 ! residual = b - A x - rmsd = rmsd+residual(i, ii)**2 + rmsd = rmsd + residual(i, ii)**2 IF (debug_this_module) THEN - denom = denom+(residual(i, ii)-(efield1(i, ii)- & - multipoles%dipoles(i, ii)/apol))**2 + denom = denom + (residual(i, ii) - (efield1(i, ii) - & + multipoles%dipoles(i, ii)/apol))**2 END IF END DO END DO @@ -502,7 +502,7 @@ SUBROUTINE fist_pol_evaluate_cg(atomic_kind_set, multipoles, ewald_env, ewald_pw atomic_kind_set=atomic_kind_set, mm_section=mm_section, & efield1=conjugate_applied) multipoles%dipoles = tmp_dipoles ! restore backup - conjugate_applied(:, :) = efield1_ext-conjugate_applied + conjugate_applied(:, :) = efield1_ext - conjugate_applied ! Finish conjugate_applied and compute alpha from the conjugate gradient algorithm. alpha = 0.0_dp @@ -515,10 +515,10 @@ SUBROUTINE fist_pol_evaluate_cg(atomic_kind_set, multipoles, ewald_env, ewald_pw DO iatom = 1, natom_of_kind ii = atom_list(iatom) DO i = 1, 3 - conjugate_applied(i, ii) = conjugate_applied(i, ii)+conjugate(i, ii)/apol + conjugate_applied(i, ii) = conjugate_applied(i, ii) + conjugate(i, ii)/apol END DO - alpha = alpha+DOT_PRODUCT(residual(:, ii), residual(:, ii)) - denom = denom+DOT_PRODUCT(conjugate(:, ii), conjugate_applied(:, ii)) + alpha = alpha + DOT_PRODUCT(residual(:, ii), residual(:, ii)) + denom = denom + DOT_PRODUCT(conjugate(:, ii), conjugate_applied(:, ii)) END DO END DO alpha = alpha/denom @@ -532,11 +532,11 @@ SUBROUTINE fist_pol_evaluate_cg(atomic_kind_set, multipoles, ewald_env, ewald_pw IF (apol == 0) CYCLE DO iatom = 1, natom_of_kind ii = atom_list(iatom) - denom = denom+DOT_PRODUCT(residual(:, ii), residual(:, ii)) + denom = denom + DOT_PRODUCT(residual(:, ii), residual(:, ii)) DO i = 1, 3 - residual(i, ii) = residual(i, ii)-alpha*conjugate_applied(i, ii) + residual(i, ii) = residual(i, ii) - alpha*conjugate_applied(i, ii) END DO - beta = beta+DOT_PRODUCT(residual(:, ii), residual(:, ii)) + beta = beta + DOT_PRODUCT(residual(:, ii), residual(:, ii)) END DO END DO beta = beta/denom @@ -552,9 +552,9 @@ SUBROUTINE fist_pol_evaluate_cg(atomic_kind_set, multipoles, ewald_env, ewald_pw DO iatom = 1, natom_of_kind ii = atom_list(iatom) DO i = 1, 3 - multipoles%dipoles(i, ii) = multipoles%dipoles(i, ii)+alpha*conjugate(i, ii) - conjugate(i, ii) = residual(i, ii)+beta*conjugate(i, ii) - thermo%e_induction = thermo%e_induction+multipoles%dipoles(i, ii)**2/apol/2.0_dp + multipoles%dipoles(i, ii) = multipoles%dipoles(i, ii) + alpha*conjugate(i, ii) + conjugate(i, ii) = residual(i, ii) + beta*conjugate(i, ii) + thermo%e_induction = thermo%e_induction + multipoles%dipoles(i, ii)**2/apol/2.0_dp END DO END DO END DO @@ -593,7 +593,7 @@ SUBROUTINE fist_pol_evaluate_cg(atomic_kind_set, multipoles, ewald_env, ewald_pw ii = atom_list(iatom) DO i = 1, 3 ! residual = b - A x - rmsd = rmsd+(efield1(i, ii)-multipoles%dipoles(i, ii)/apol)**2 + rmsd = rmsd + (efield1(i, ii) - multipoles%dipoles(i, ii)/apol)**2 END DO END DO END DO @@ -613,12 +613,12 @@ SUBROUTINE fist_pol_evaluate_cg(atomic_kind_set, multipoles, ewald_env, ewald_pw forces_local=fg_coulomb, forces_glob=f_nonbond, & pv_local=pv_g, pv_glob=pv_nonbond) ENDIF - pot_nonbond = pot_nonbond+pot_nonbond_local + pot_nonbond = pot_nonbond + pot_nonbond_local CALL mp_sum(pot_nonbond_local, logger%para_env%group) IF (iw > 0) THEN WRITE (iw, FMT='(T5,"POL_SCF|",5X,"Final",T61,F20.10,/)') & - vg_coulomb+pot_nonbond_local+thermo%e_induction + vg_coulomb + pot_nonbond_local + thermo%e_induction END IF ! Deallocate working arrays diff --git a/src/fm/cp_blacs_env.F b/src/fm/cp_blacs_env.F index 6eea6d4559..4272b56e95 100644 --- a/src/fm/cp_blacs_env.F +++ b/src/fm/cp_blacs_env.F @@ -236,16 +236,16 @@ SUBROUTINE cp_blacs_env_create(blacs_env, para_env, blacs_grid_layout, blacs_rep #endif ! generate the mappings blacs2mpi and mpi2blacs - ALLOCATE (blacs_env%blacs2mpi(0:blacs_env%num_pe(1)-1, 0:blacs_env%num_pe(2)-1), & + ALLOCATE (blacs_env%blacs2mpi(0:blacs_env%num_pe(1) - 1, 0:blacs_env%num_pe(2) - 1), & stat=stat) CPASSERT(stat == 0) blacs_env%blacs2mpi = 0 blacs_env%blacs2mpi(blacs_env%mepos(1), blacs_env%mepos(2)) = para_env%mepos CALL mp_sum(blacs_env%blacs2mpi, para_env%group) - ALLOCATE (blacs_env%mpi2blacs(2, 0:para_env%num_pe-1)) + ALLOCATE (blacs_env%mpi2blacs(2, 0:para_env%num_pe - 1)) blacs_env%mpi2blacs = -1 - DO ipcol = 0, blacs_env%num_pe(2)-1 - DO iprow = 0, blacs_env%num_pe(1)-1 + DO ipcol = 0, blacs_env%num_pe(2) - 1 + DO iprow = 0, blacs_env%num_pe(1) - 1 blacs_env%mpi2blacs(1, blacs_env%blacs2mpi(iprow, ipcol)) = iprow blacs_env%mpi2blacs(2, blacs_env%blacs2mpi(iprow, ipcol)) = ipcol END DO @@ -267,7 +267,7 @@ SUBROUTINE cp_blacs_env_retain(blacs_env) CPASSERT(ASSOCIATED(blacs_env)) CPASSERT(blacs_env%ref_count > 0) - blacs_env%ref_count = blacs_env%ref_count+1 + blacs_env%ref_count = blacs_env%ref_count + 1 END SUBROUTINE cp_blacs_env_retain ! ************************************************************************************************** @@ -285,7 +285,7 @@ SUBROUTINE cp_blacs_env_release(blacs_env) IF (ASSOCIATED(blacs_env)) THEN CPASSERT(blacs_env%ref_count > 0) - blacs_env%ref_count = blacs_env%ref_count-1 + blacs_env%ref_count = blacs_env%ref_count - 1 IF (blacs_env%ref_count < 1) THEN CALL cp_blacs_gridexit(blacs_env%group) CALL cp_para_env_release(blacs_env%para_env) diff --git a/src/fm/cp_cfm_basic_linalg.F b/src/fm/cp_cfm_basic_linalg.F index 50d09277e1..bca7f7e05a 100644 --- a/src/fm/cp_cfm_basic_linalg.F +++ b/src/fm/cp_cfm_basic_linalg.F @@ -228,14 +228,14 @@ SUBROUTINE cp_cfm_scale_and_add(alpha, matrix_a, beta, matrix_b) !a(:, :) = a(:, :)+b(:, :) DO icol_local = 1, ncol_local DO irow_local = 1, nrow_local - a(irow_local, icol_local) = a(irow_local, icol_local)+b(irow_local, icol_local) + a(irow_local, icol_local) = a(irow_local, icol_local) + b(irow_local, icol_local) END DO END DO ELSE !a(:, :) = a(:, :)+my_beta*b(:, :) DO icol_local = 1, ncol_local DO irow_local = 1, nrow_local - a(irow_local, icol_local) = a(irow_local, icol_local)+my_beta*b(irow_local, icol_local) + a(irow_local, icol_local) = a(irow_local, icol_local) + my_beta*b(irow_local, icol_local) END DO END DO END IF @@ -243,7 +243,7 @@ SUBROUTINE cp_cfm_scale_and_add(alpha, matrix_a, beta, matrix_b) !a(:, :) = alpha*a(:, :)+my_beta*b(:, :) DO icol_local = 1, ncol_local DO irow_local = 1, nrow_local - a(irow_local, icol_local) = alpha*a(irow_local, icol_local)+my_beta*b(irow_local, icol_local) + a(irow_local, icol_local) = alpha*a(irow_local, icol_local) + my_beta*b(irow_local, icol_local) END DO END DO END IF @@ -338,14 +338,14 @@ SUBROUTINE cp_cfm_scale_and_add_fm(alpha, matrix_a, beta, matrix_b) !a(:, :) = a(:, :)+b(:, :) DO icol_local = 1, ncol_local DO irow_local = 1, nrow_local - a(irow_local, icol_local) = a(irow_local, icol_local)+b(irow_local, icol_local) + a(irow_local, icol_local) = a(irow_local, icol_local) + b(irow_local, icol_local) END DO END DO ELSE !a(:, :) = a(:, :)+beta*b(:, :) DO icol_local = 1, ncol_local DO irow_local = 1, nrow_local - a(irow_local, icol_local) = a(irow_local, icol_local)+beta*b(irow_local, icol_local) + a(irow_local, icol_local) = a(irow_local, icol_local) + beta*b(irow_local, icol_local) END DO END DO END IF @@ -353,7 +353,7 @@ SUBROUTINE cp_cfm_scale_and_add_fm(alpha, matrix_a, beta, matrix_b) !a(:, :) = alpha*a(:, :)+beta*b(:, :) DO icol_local = 1, ncol_local DO irow_local = 1, nrow_local - a(irow_local, icol_local) = alpha*a(irow_local, icol_local)+beta*b(irow_local, icol_local) + a(irow_local, icol_local) = alpha*a(irow_local, icol_local) + beta*b(irow_local, icol_local) END DO END DO END IF @@ -413,7 +413,7 @@ SUBROUTINE cp_cfm_lu_decompose(matrix_a, determinant) counter = 0 DO irow = 1, nrow_local - IF (ipivot(irow) .NE. row_indices(irow)) counter = counter+1 + IF (ipivot(irow) .NE. row_indices(irow)) counter = counter + 1 END DO IF (MOD(counter, 2) == 0) THEN @@ -427,13 +427,13 @@ SUBROUTINE cp_cfm_lu_decompose(matrix_a, determinant) icol = 1 DO WHILE (irow <= nrow_local .AND. icol <= ncol_local) IF (row_indices(irow) < col_indices(icol)) THEN - irow = irow+1 + irow = irow + 1 ELSE IF (row_indices(irow) > col_indices(icol)) THEN - icol = icol+1 + icol = icol + 1 ELSE ! diagonal element determinant = determinant*a(irow, icol) - irow = irow+1 - icol = icol+1 + irow = irow + 1 + icol = icol + 1 END IF END DO CALL mp_prod(determinant, matrix_a%matrix_struct%para_env%group) @@ -443,7 +443,7 @@ SUBROUTINE cp_cfm_lu_decompose(matrix_a, determinant) counter = 0 determinant = z_one DO irow = 1, nrow_global - IF (ipivot(irow) .NE. irow) counter = counter+1 + IF (ipivot(irow) .NE. irow) counter = counter + 1 determinant = determinant*a(irow, irow) ENDDO IF (MOD(counter, 2) == 1) determinant = -1.0_dp*determinant @@ -708,7 +708,7 @@ SUBROUTINE cp_cfm_solve(matrix_a, general_a, determinant) counter = 0 DO irow = 1, nrow_local - IF (ipivot(irow) .NE. row_indices(irow)) counter = counter+1 + IF (ipivot(irow) .NE. row_indices(irow)) counter = counter + 1 END DO IF (MOD(counter, 2) == 0) THEN @@ -722,13 +722,13 @@ SUBROUTINE cp_cfm_solve(matrix_a, general_a, determinant) icol = 1 DO WHILE (irow <= nrow_local .AND. icol <= ncol_local) IF (row_indices(irow) < col_indices(icol)) THEN - irow = irow+1 + irow = irow + 1 ELSE IF (row_indices(irow) > col_indices(icol)) THEN - icol = icol+1 + icol = icol + 1 ELSE ! diagonal element determinant = determinant*a(irow, icol) - irow = irow+1 - icol = icol+1 + irow = irow + 1 + icol = icol + 1 END IF END DO CALL mp_prod(determinant, matrix_a%matrix_struct%para_env%group) @@ -744,7 +744,7 @@ SUBROUTINE cp_cfm_solve(matrix_a, general_a, determinant) counter = 0 determinant = z_one DO irow = 1, nrow_global - IF (ipivot(irow) .NE. irow) counter = counter+1 + IF (ipivot(irow) .NE. irow) counter = counter + 1 determinant = determinant*a(irow, irow) ENDDO IF (MOD(counter, 2) == 1) determinant = -1.0_dp*determinant diff --git a/src/fm/cp_cfm_diag.F b/src/fm/cp_cfm_diag.F index 32023d4b7b..055fd4c605 100644 --- a/src/fm/cp_cfm_diag.F +++ b/src/fm/cp_cfm_diag.F @@ -11,20 +11,20 @@ ! ************************************************************************************************** MODULE cp_cfm_diag USE cp_cfm_basic_linalg, ONLY: cp_cfm_cholesky_decompose, & - cp_cfm_gemm, & - cp_cfm_column_scale, & - cp_cfm_scale, & - cp_cfm_triangular_invert, & - cp_cfm_triangular_multiply + cp_cfm_gemm, & + cp_cfm_column_scale, & + cp_cfm_scale, & + cp_cfm_triangular_invert, & + cp_cfm_triangular_multiply USE cp_cfm_types, ONLY: cp_cfm_get_info, & - cp_cfm_set_element, & - cp_cfm_to_cfm, & - cp_cfm_type + cp_cfm_set_element, & + cp_cfm_to_cfm, & + cp_cfm_type USE kinds, ONLY: dp #if defined (__HAS_IEEE_EXCEPTIONS) USE ieee_exceptions, ONLY: ieee_get_halting_mode, & - ieee_set_halting_mode, & - ieee_all + ieee_set_halting_mode, & + ieee_all #endif #include "../base/base_uses.f90" @@ -91,7 +91,7 @@ SUBROUTINE cp_cfm_heevd(matrix, eigenvectors, eigenvalues) work(1), lwork, rwork(1), lrwork, iwork(1), liwork, info) lwork = CEILING(REAL(work(1), KIND=dp)) ! needed to correct for a bug in scalapack, unclear how much the right number is - lrwork = CEILING(REAL(rwork(1), KIND=dp))+1000000 + lrwork = CEILING(REAL(rwork(1), KIND=dp)) + 1000000 liwork = iwork(1) #else CALL ZHEEVD('V', 'U', n, m(1, 1), SIZE(m, 1), eigenvalues(1), & @@ -224,7 +224,7 @@ SUBROUTINE cp_cfm_geeig_canon(amatrix, bmatrix, eigenvectors, eigenvalues, work, nc = nao DO i = 1, nao IF (evals(i) < epseig) THEN - nc = i-1 + nc = i - 1 EXIT END IF END DO @@ -233,17 +233,17 @@ SUBROUTINE cp_cfm_geeig_canon(amatrix, bmatrix, eigenvectors, eigenvalues, work, IF (nc /= nao) THEN IF (nc < nmo) THEN ! Copy NULL space definition to last vectors of eigenvectors (if needed) - ncol = nmo-nc - CALL cp_cfm_to_cfm(work, eigenvectors, ncol, nc+1, nc+1) + ncol = nmo - nc + CALL cp_cfm_to_cfm(work, eigenvectors, ncol, nc + 1, nc + 1) END IF ! Set NULL space in eigenvector matrix of S to zero - DO icol = nc+1, nao + DO icol = nc + 1, nao DO irow = 1, nao CALL cp_cfm_set_element(work, irow, icol, czero) END DO END DO ! Set small eigenvalues to a dummy save value - evals(nc+1:nao) = 1.0_dp + evals(nc + 1:nao) = 1.0_dp END IF ! calculate U*s**(-1/2) cevals(:) = CMPLX(1.0_dp/SQRT(evals(:)), 0.0_dp, KIND=dp) @@ -253,7 +253,7 @@ SUBROUTINE cp_cfm_geeig_canon(amatrix, bmatrix, eigenvectors, eigenvalues, work, CALL cp_cfm_gemm("N", "N", nao, nao, nao, cone, bmatrix, work, czero, amatrix) IF (nc /= nao) THEN ! set diagonal values to save large value - DO icol = nc+1, nao + DO icol = nc + 1, nao CALL cp_cfm_set_element(amatrix, icol, icol, CMPLX(10000.0_dp, 0.0_dp, KIND=dp)) END DO END IF diff --git a/src/fm/cp_cfm_types.F b/src/fm/cp_cfm_types.F index 244b0d53fc..c33c314851 100644 --- a/src/fm/cp_cfm_types.F +++ b/src/fm/cp_cfm_types.F @@ -142,7 +142,7 @@ SUBROUTINE cp_cfm_create(matrix, matrix_struct, name) context => matrix_struct%context matrix%matrix_struct => matrix_struct CALL cp_fm_struct_retain(matrix%matrix_struct) - last_cfm_id_nr = last_cfm_id_nr+1 + last_cfm_id_nr = last_cfm_id_nr + 1 matrix%id_nr = last_cfm_id_nr matrix%ref_count = 1 matrix%print_count = 0 @@ -176,7 +176,7 @@ SUBROUTINE cp_cfm_retain(matrix) CPASSERT(ASSOCIATED(matrix)) CPASSERT(matrix%ref_count > 0) - matrix%ref_count = matrix%ref_count+1 + matrix%ref_count = matrix%ref_count + 1 END SUBROUTINE cp_cfm_retain ! ************************************************************************************************** @@ -190,7 +190,7 @@ SUBROUTINE cp_cfm_release(matrix) IF (ASSOCIATED(matrix)) THEN CPASSERT(matrix%ref_count > 0) - matrix%ref_count = matrix%ref_count-1 + matrix%ref_count = matrix%ref_count - 1 IF (matrix%ref_count < 1) THEN IF (ASSOCIATED(matrix%local_data)) THEN DEALLOCATE (matrix%local_data) @@ -238,13 +238,13 @@ SUBROUTINE cp_cfm_set_all(matrix, alpha, beta) DO WHILE (irow_local <= nrow_local .AND. icol_local <= ncol_local) IF (row_indices(irow_local) < col_indices(icol_local)) THEN - irow_local = irow_local+1 + irow_local = irow_local + 1 ELSE IF (row_indices(irow_local) > col_indices(icol_local)) THEN - icol_local = icol_local+1 + icol_local = icol_local + 1 ELSE matrix%local_data(irow_local, icol_local) = beta - irow_local = irow_local+1 - icol_local = icol_local+1 + irow_local = irow_local + 1 + icol_local = icol_local + 1 END IF END DO #else @@ -423,8 +423,8 @@ SUBROUTINE cp_cfm_get_submatrix(fm, target_m, start_row, start_col, n_rows, n_co IF (PRESENT(n_rows)) end_row_global = n_rows IF (PRESENT(n_cols)) end_col_global = n_cols - end_row_global = end_row_global+start_row_global-1 - end_col_global = end_col_global+start_col_global-1 + end_row_global = end_row_global + start_row_global - 1 + end_col_global = end_col_global + start_col_global - 1 CALL cp_cfm_get_info(matrix=fm, & nrow_global=nrow_global, ncol_global=ncol_global, & @@ -448,7 +448,7 @@ SUBROUTINE cp_cfm_get_submatrix(fm, target_m, start_row, start_col, n_rows, n_co DO end_row_local = start_row_local, nrow_local IF (row_indices(end_row_local) > end_row_global) EXIT END DO - end_row_local = end_row_local-1 + end_row_local = end_row_local - 1 DO start_col_local = 1, ncol_local IF (col_indices(start_col_local) >= start_col_global) EXIT @@ -457,7 +457,7 @@ SUBROUTINE cp_cfm_get_submatrix(fm, target_m, start_row, start_col, n_rows, n_co DO end_col_local = start_col_local, ncol_local IF (col_indices(end_col_local) > end_col_global) EXIT END DO - end_col_local = end_col_local-1 + end_col_local = end_col_local - 1 para_env => fm%matrix_struct%para_env local_data => fm%local_data @@ -471,16 +471,16 @@ SUBROUTINE cp_cfm_get_submatrix(fm, target_m, start_row, start_col, n_rows, n_co IF (tr_a) THEN DO j = start_col_local, end_col_local - this_col = col_indices(j)-start_col_global+1 + this_col = col_indices(j) - start_col_global + 1 DO i = start_row_local, end_row_local - target_m(this_col, row_indices(i)-start_row_global+1) = local_data(i, j) + target_m(this_col, row_indices(i) - start_row_global + 1) = local_data(i, j) END DO END DO ELSE DO j = start_col_local, end_col_local - this_col = col_indices(j)-start_col_global+1 + this_col = col_indices(j) - start_col_global + 1 DO i = start_row_local, end_row_local - target_m(row_indices(i)-start_row_global+1, this_col) = local_data(i, j) + target_m(row_indices(i) - start_row_global + 1, this_col) = local_data(i, j) END DO END DO END IF @@ -563,8 +563,8 @@ SUBROUTINE cp_cfm_set_submatrix(matrix, new_values, start_row, & IF (PRESENT(n_rows)) end_row_global = n_rows IF (PRESENT(n_cols)) end_col_global = n_cols - end_row_global = end_row_global+start_row_global-1 - end_col_global = end_col_global+start_col_global-1 + end_row_global = end_row_global + start_row_global - 1 + end_col_global = end_col_global + start_col_global - 1 CALL cp_cfm_get_info(matrix=matrix, & nrow_global=nrow_global, ncol_global=ncol_global, & @@ -582,7 +582,7 @@ SUBROUTINE cp_cfm_set_submatrix(matrix, new_values, start_row, & DO end_row_local = start_row_local, nrow_local IF (row_indices(end_row_local) > end_row_global) EXIT END DO - end_row_local = end_row_local-1 + end_row_local = end_row_local - 1 DO start_col_local = 1, ncol_local IF (col_indices(start_col_local) >= start_col_global) EXIT @@ -591,40 +591,40 @@ SUBROUTINE cp_cfm_set_submatrix(matrix, new_values, start_row, & DO end_col_local = start_col_local, ncol_local IF (col_indices(end_col_local) > end_col_global) EXIT END DO - end_col_local = end_col_local-1 + end_col_local = end_col_local - 1 local_data => matrix%local_data IF (al == z_one .AND. be == z_zero) THEN IF (tr_a) THEN DO j = start_col_local, end_col_local - this_col = col_indices(j)-start_col_global+1 + this_col = col_indices(j) - start_col_global + 1 DO i = start_row_local, end_row_local - local_data(i, j) = new_values(this_col, row_indices(i)-start_row_global+1) + local_data(i, j) = new_values(this_col, row_indices(i) - start_row_global + 1) END DO END DO ELSE DO j = start_col_local, end_col_local - this_col = col_indices(j)-start_col_global+1 + this_col = col_indices(j) - start_col_global + 1 DO i = start_row_local, end_row_local - local_data(i, j) = new_values(row_indices(i)-start_row_global+1, this_col) + local_data(i, j) = new_values(row_indices(i) - start_row_global + 1, this_col) END DO END DO END IF ELSE IF (tr_a) THEN DO j = start_col_local, end_col_local - this_col = col_indices(j)-start_col_global+1 + this_col = col_indices(j) - start_col_global + 1 DO i = start_row_local, end_row_local - local_data(i, j) = al*new_values(this_col, row_indices(i)-start_row_global+1)+ & + local_data(i, j) = al*new_values(this_col, row_indices(i) - start_row_global + 1) + & be*local_data(i, j) END DO END DO ELSE DO j = start_col_local, end_col_local - this_col = col_indices(j)-start_col_global+1 + this_col = col_indices(j) - start_col_global + 1 DO i = start_row_local, end_row_local - local_data(i, j) = al*new_values(row_indices(i)-start_row_global+1, this_col)+ & + local_data(i, j) = al*new_values(row_indices(i) - start_row_global + 1, this_col) + & be*local_data(i, j) END DO END DO @@ -825,8 +825,8 @@ SUBROUTINE cp_cfm_to_cfm_columns(msource, mtarget, ncol, source_start, & #if defined(__SCALAPACK) desca(:) = msource%matrix_struct%descriptor(:) descb(:) = mtarget%matrix_struct%descriptor(:) - DO i = 0, ncol-1 - CALL pzcopy(n, a(1, 1), 1, ss+i, desca, 1, b(1, 1), 1, ts+i, descb, 1) + DO i = 0, ncol - 1 + CALL pzcopy(n, a(1, 1), 1, ss + i, desca, 1, b(1, 1), 1, ts + i, descb, 1) END DO #else CALL zcopy(ncol*n, a(1, ss), 1, b(1, ts), 1) @@ -956,7 +956,7 @@ SUBROUTINE cp_fm_to_cfm(msourcer, msourcei, mtarget) (SIZE(rmat, 2) .NE. SIZE(zmat, 2))) THEN CPABORT("size of local_data of msourcer differ to mtarget") END IF - mode = mode+1 + mode = mode + 1 ELSE NULLIFY (rmat) END IF @@ -967,7 +967,7 @@ SUBROUTINE cp_fm_to_cfm(msourcer, msourcei, mtarget) (SIZE(imat, 2) .NE. SIZE(zmat, 2))) THEN CPABORT("size of local_data of msourcei differ to mtarget") END IF - mode = mode+2 + mode = mode + 2 ELSE NULLIFY (imat) END IF @@ -1030,7 +1030,7 @@ SUBROUTINE cp_cfm_start_copy_general(source, destination, para_env, info) k = 0 DO j = 1, ncol_local_send DO i = 1, nrow_local_send - k = k+1 + k = k + 1 info%send_buf(k) = source%local_data(i, j) END DO END DO @@ -1062,12 +1062,12 @@ SUBROUTINE cp_cfm_start_copy_general(source, destination, para_env, info) END IF ! Map the rank in the source/dest communicator to the global rank - ALLOCATE (all_ranks(0:global_size-1)) + ALLOCATE (all_ranks(0:global_size - 1)) CALL mp_allgather(send_rank, all_ranks, global_comm) IF (ASSOCIATED(destination)) THEN - ALLOCATE (source2global(0:COUNT(all_ranks .NE. mp_proc_null)-1)) - DO i = 0, global_size-1 + ALLOCATE (source2global(0:COUNT(all_ranks .NE. mp_proc_null) - 1)) + DO i = 0, global_size - 1 IF (all_ranks(i) .NE. mp_proc_null) THEN source2global(all_ranks(i)) = i END IF @@ -1076,8 +1076,8 @@ SUBROUTINE cp_cfm_start_copy_general(source, destination, para_env, info) CALL mp_allgather(recv_rank, all_ranks, global_comm) IF (ASSOCIATED(source)) THEN - ALLOCATE (dest2global(0:COUNT(all_ranks .NE. mp_proc_null)-1)) - DO i = 0, global_size-1 + ALLOCATE (dest2global(0:COUNT(all_ranks .NE. mp_proc_null) - 1)) + DO i = 0, global_size - 1 IF (all_ranks(i) .NE. mp_proc_null) THEN dest2global(all_ranks(i)) = i END IF @@ -1118,8 +1118,8 @@ SUBROUTINE cp_cfm_start_copy_general(source, destination, para_env, info) IF (global_rank == 0) THEN CALL mp_waitall(recv_req(1:4)) ! Now we know the process decomposition, we can allocate the arrays to hold the blacs2mpi mapping - ALLOCATE (info%src_blacs2mpi(0:src_num_pe(1)-1, 0:src_num_pe(2)-1), & - dest_blacs2mpi(0:dest_num_pe(1)-1, 0:dest_num_pe(2)-1)) + ALLOCATE (info%src_blacs2mpi(0:src_num_pe(1) - 1, 0:src_num_pe(2) - 1), & + dest_blacs2mpi(0:dest_num_pe(1) - 1, 0:dest_num_pe(2) - 1)) CALL mp_irecv(info%src_blacs2mpi, mp_any_source, global_comm, recv_req(5), tag=src_tag) CALL mp_irecv(dest_blacs2mpi, mp_any_source, global_comm, recv_req(6), tag=dest_tag) END IF @@ -1148,8 +1148,8 @@ SUBROUTINE cp_cfm_start_copy_general(source, destination, para_env, info) info%src_num_pe(1:2) = src_num_pe(1:2) info%nblock_src(1:2) = src_block(1:2) IF (global_rank /= 0) THEN - ALLOCATE (info%src_blacs2mpi(0:src_num_pe(1)-1, 0:src_num_pe(2)-1), & - dest_blacs2mpi(0:dest_num_pe(1)-1, 0:dest_num_pe(2)-1)) + ALLOCATE (info%src_blacs2mpi(0:src_num_pe(1) - 1, 0:src_num_pe(2) - 1), & + dest_blacs2mpi(0:dest_num_pe(1) - 1, 0:dest_num_pe(2) - 1)) END IF CALL mp_bcast(info%src_blacs2mpi, 0, global_comm) CALL mp_bcast(dest_blacs2mpi, 0, global_comm) @@ -1181,7 +1181,7 @@ SUBROUTINE cp_cfm_start_copy_general(source, destination, para_env, info) info%recv_row_indices => recv_row_indices nrow_block_src = src_block(1) ncol_block_src = src_block(2) - ALLOCATE (recv_count(0:send_size-1), info%recv_disp(0:send_size-1), info%recv_request(0:send_size-1)) + ALLOCATE (recv_count(0:send_size - 1), info%recv_disp(0:send_size - 1), info%recv_request(0:send_size - 1)) ! Determine the recv counts, allocate the receive buffers, call mpi_irecv for all the non-zero sized receives nrow_local_recv = recv_dist%nrow_locals(recv_dist%context%mepos(1)) @@ -1193,17 +1193,17 @@ SUBROUTINE cp_cfm_start_copy_general(source, destination, para_env, info) DO i = 1, nrow_local_recv ! For each local row we will receive, we look up its global row (in recv_row_indices), ! then work out which row block it comes from, and which process row that row block comes from. - src_p(i) = MOD(((recv_row_indices(i)-1)/nrow_block_src), src_num_pe(1)) + src_p(i) = MOD(((recv_row_indices(i) - 1)/nrow_block_src), src_num_pe(1)) END DO DO j = 1, ncol_local_recv ! Similarly for the columns - src_q(j) = MOD(((recv_col_indices(j)-1)/ncol_block_src), src_num_pe(2)) + src_q(j) = MOD(((recv_col_indices(j) - 1)/ncol_block_src), src_num_pe(2)) END DO ! src_p/q now contains the process row/column ID that will send data to that row/column - DO q = 0, src_num_pe(2)-1 + DO q = 0, src_num_pe(2) - 1 ncols = COUNT(src_q .EQ. q) - DO p = 0, src_num_pe(1)-1 + DO p = 0, src_num_pe(1) - 1 nrows = COUNT(src_p .EQ. p) ! Use the send_dist here as we are looking up the processes where the data comes from recv_count(info%src_blacs2mpi(p, q)) = nrows*ncols @@ -1215,14 +1215,14 @@ SUBROUTINE cp_cfm_start_copy_general(source, destination, para_env, info) ! this prevents the need for a rectangular array where not all elements will be populated ALLOCATE (info%recv_buf(SUM(recv_count(:)))) info%recv_disp(0) = 0 - DO i = 1, send_size-1 - info%recv_disp(i) = info%recv_disp(i-1)+recv_count(i-1) + DO i = 1, send_size - 1 + info%recv_disp(i) = info%recv_disp(i - 1) + recv_count(i - 1) END DO ! Issue receive calls on ranks which expect data - DO k = 0, send_size-1 + DO k = 0, send_size - 1 IF (recv_count(k) .GT. 0) THEN - CALL mp_irecv(info%recv_buf(info%recv_disp(k)+1:info%recv_disp(k)+recv_count(k)), & + CALL mp_irecv(info%recv_buf(info%recv_disp(k) + 1:info%recv_disp(k) + recv_count(k)), & source2global(k), global_comm, info%recv_request(k)) ELSE info%recv_request(k) = mp_request_null @@ -1237,7 +1237,7 @@ SUBROUTINE cp_cfm_start_copy_general(source, destination, para_env, info) col_indices=send_col_indices) nrow_block_dest = dest_block(1) ncol_block_dest = dest_block(2) - ALLOCATE (send_count(0:recv_size-1), send_disp(0:recv_size-1), info%send_request(0:recv_size-1)) + ALLOCATE (send_count(0:recv_size - 1), send_disp(0:recv_size - 1), info%send_request(0:recv_size - 1)) ! Determine the send counts, allocate the send buffers nrow_local_send = send_dist%nrow_locals(send_dist%context%mepos(1)) @@ -1249,16 +1249,16 @@ SUBROUTINE cp_cfm_start_copy_general(source, destination, para_env, info) DO i = 1, nrow_local_send ! Use the send_dist%row_indices() here (we are looping over the local rows we will send) - dest_p(i) = MOD(((send_row_indices(i)-1)/nrow_block_dest), dest_num_pe(1)) + dest_p(i) = MOD(((send_row_indices(i) - 1)/nrow_block_dest), dest_num_pe(1)) END DO DO j = 1, ncol_local_send - dest_q(j) = MOD(((send_col_indices(j)-1)/ncol_block_dest), dest_num_pe(2)) + dest_q(j) = MOD(((send_col_indices(j) - 1)/ncol_block_dest), dest_num_pe(2)) END DO ! dest_p/q now contain the process row/column ID that will receive data from that row/column - DO q = 0, dest_num_pe(2)-1 + DO q = 0, dest_num_pe(2) - 1 ncols = COUNT(dest_q .EQ. q) - DO p = 0, dest_num_pe(1)-1 + DO p = 0, dest_num_pe(1) - 1 nrows = COUNT(dest_p .EQ. p) send_count(dest_blacs2mpi(p, q)) = nrows*ncols END DO @@ -1268,27 +1268,27 @@ SUBROUTINE cp_cfm_start_copy_general(source, destination, para_env, info) ! Allocate the send buffer using send_count -- and calculate the offset into the buffer for each process ALLOCATE (info%send_buf(SUM(send_count(:)))) send_disp(0) = 0 - DO k = 1, recv_size-1 - send_disp(k) = send_disp(k-1)+send_count(k-1) + DO k = 1, recv_size - 1 + send_disp(k) = send_disp(k - 1) + send_count(k - 1) END DO ! Loop over the smat, pack the send buffers send_count(:) = 0 DO j = 1, ncol_local_send ! Use send_col_indices and row_indices here, as we are looking up the global row/column number of local rows. - dest_q_j = MOD(((send_col_indices(j)-1)/ncol_block_dest), dest_num_pe(2)) + dest_q_j = MOD(((send_col_indices(j) - 1)/ncol_block_dest), dest_num_pe(2)) DO i = 1, nrow_local_send - dest_p_i = MOD(((send_row_indices(i)-1)/nrow_block_dest), dest_num_pe(1)) + dest_p_i = MOD(((send_row_indices(i) - 1)/nrow_block_dest), dest_num_pe(1)) mpi_rank = dest_blacs2mpi(dest_p_i, dest_q_j) - send_count(mpi_rank) = send_count(mpi_rank)+1 - info%send_buf(send_disp(mpi_rank)+send_count(mpi_rank)) = source%local_data(i, j) + send_count(mpi_rank) = send_count(mpi_rank) + 1 + info%send_buf(send_disp(mpi_rank) + send_count(mpi_rank)) = source%local_data(i, j) END DO END DO ! For each non-zero send_count, call mpi_isend - DO k = 0, recv_size-1 + DO k = 0, recv_size - 1 IF (send_count(k) .GT. 0) THEN - CALL mp_isend(info%send_buf(send_disp(k)+1:send_disp(k)+send_count(k)), & + CALL mp_isend(info%send_buf(send_disp(k) + 1:send_disp(k) + send_count(k)), & dest2global(k), global_comm, info%send_request(k)) ELSE info%send_request(k) = mp_request_null @@ -1332,7 +1332,7 @@ SUBROUTINE cp_cfm_finish_copy_general(destination, info) k = 0 DO j = 1, SIZE(destination%local_data, 2) DO i = 1, SIZE(destination%local_data, 1) - k = k+1 + k = k + 1 destination%local_data(i, j) = info%send_buf(k) END DO END DO @@ -1348,20 +1348,20 @@ SUBROUTINE cp_cfm_finish_copy_general(destination, info) nj = info%nlocal_recv(2) ni = info%nlocal_recv(1) - ALLOCATE (recv_count(0:info%send_size-1), src_p_i(ni)) + ALLOCATE (recv_count(0:info%send_size - 1), src_p_i(ni)) ! Loop over the rmat, filling it in with data from the recv buffers ! (here the block sizes, num_pes refer to the distribution of the source matrix) recv_count(:) = 0 DO i = 1, ni - src_p_i(i) = MOD(((recv_row_indices(i)-1)/info%nblock_src(1)), info%src_num_pe(1)) + src_p_i(i) = MOD(((recv_row_indices(i) - 1)/info%nblock_src(1)), info%src_num_pe(1)) END DO DO j = 1, nj - src_q_j = MOD(((recv_col_indices(j)-1)/info%nblock_src(2)), info%src_num_pe(2)) + src_q_j = MOD(((recv_col_indices(j) - 1)/info%nblock_src(2)), info%src_num_pe(2)) DO i = 1, ni mpi_rank = info%src_blacs2mpi(src_p_i(i), src_q_j) - recv_count(mpi_rank) = recv_count(mpi_rank)+1 - destination%local_data(i, j) = info%recv_buf(info%recv_disp(mpi_rank)+recv_count(mpi_rank)) + recv_count(mpi_rank) = recv_count(mpi_rank) + 1 + destination%local_data(i, j) = info%recv_buf(info%recv_disp(mpi_rank) + recv_count(mpi_rank)) END DO END DO diff --git a/src/fm/cp_fm_basic_linalg.F b/src/fm/cp_fm_basic_linalg.F index 1d79f1de35..6483114fe5 100644 --- a/src/fm/cp_fm_basic_linalg.F +++ b/src/fm/cp_fm_basic_linalg.F @@ -119,7 +119,7 @@ SUBROUTINE cp_fm_scale_and_add(alpha, matrix_a, beta, matrix_b) IF (matrix_a%id_nr == matrix_b%id_nr) THEN IF (matrix_a%id_nr == matrix_b%id_nr) & CPWARN("Bad use of routine. Call cp_fm_scale instead") - CALL cp_fm_scale(alpha+beta, matrix_a) + CALL cp_fm_scale(alpha + beta, matrix_a) CALL timestop(handle) RETURN END IF @@ -240,13 +240,13 @@ SUBROUTINE cp_fm_geadd(alpha, trans, matrix_a, beta, matrix_b) CASE ('T') DO jj = 1, ncol_global DO ii = 1, nrow_global - bb(ii, jj) = beta*bb(ii, jj)+alpha*aa(jj, ii) + bb(ii, jj) = beta*bb(ii, jj) + alpha*aa(jj, ii) END DO END DO CASE DEFAULT DO jj = 1, ncol_global DO ii = 1, nrow_global - bb(ii, jj) = beta*bb(ii, jj)+alpha*aa(ii, jj) + bb(ii, jj) = beta*bb(ii, jj) + alpha*aa(ii, jj) END DO END DO END SELECT @@ -295,7 +295,7 @@ SUBROUTINE cp_fm_lu_decompose(matrix_a, almost_determinant, correct_sign) a => matrix_a%local_data n = matrix_a%matrix_struct%nrow_global - ALLOCATE (ipivot(n+matrix_a%matrix_struct%nrow_block)) + ALLOCATE (ipivot(n + matrix_a%matrix_struct%nrow_block)) #if defined(__SCALAPACK) MARK_USED(correct_sign) @@ -939,9 +939,9 @@ SUBROUTINE cp_fm_contracted_trace_a2b2t2(matrix_a, matrix_b, trace) !$OMP PRIVATE(nrows_local, t, use_sp_a, use_sp_b), & !$OMP SHARED(matrix_a, matrix_b, na, na8, nb, ntraces, nz, trace) DO itrace = 1, ntraces - ib8 = (itrace-1)/na8 - ia = INT(itrace-ib8*na8) - ib = INT(ib8)+1 + ib8 = (itrace - 1)/na8 + ia = INT(itrace - ib8*na8) + ib = INT(ib8) + 1 t = 0.0_dp DO iz = 1, nz @@ -953,11 +953,11 @@ SUBROUTINE cp_fm_contracted_trace_a2b2t2(matrix_a, matrix_b, trace) IF (.NOT. use_sp_a .AND. .NOT. use_sp_b) THEN ldata_a => matrix_a(iz, ia)%matrix%local_data(1:nrows_local, 1:ncols_local) ldata_b => matrix_b(iz, ib)%matrix%local_data(1:nrows_local, 1:ncols_local) - t = t+accurate_dot_product(ldata_a, ldata_b) + t = t + accurate_dot_product(ldata_a, ldata_b) ELSE IF (use_sp_a .AND. use_sp_b) THEN ldata_a_sp => matrix_a(iz, ia)%matrix%local_data_sp(1:nrows_local, 1:ncols_local) ldata_b_sp => matrix_b(iz, ib)%matrix%local_data_sp(1:nrows_local, 1:ncols_local) - t = t+accurate_dot_product(ldata_a_sp, ldata_b_sp) + t = t + accurate_dot_product(ldata_a_sp, ldata_b_sp) ELSE CPABORT("Matrices A and B are of different types") END IF @@ -1281,7 +1281,7 @@ SUBROUTINE cp_fm_upper_to_full(matrix, work) a => matrix%local_data a_sp => matrix%local_data_sp DO irow_global = 1, nrow_global - DO icol_global = irow_global+1, ncol_global + DO icol_global = irow_global + 1, ncol_global IF (matrix%use_sp) THEN a_sp(icol_global, irow_global) = a_sp(irow_global, icol_global) ELSE @@ -1416,7 +1416,7 @@ SUBROUTINE cp_fm_invert(matrix_a, matrix_inverse, det_a, eps_svd, eigval) a => matrix_lu%local_data n = matrix_lu%matrix_struct%nrow_global - ALLOCATE (ipivot(n+matrix_a%matrix_struct%nrow_block)) + ALLOCATE (ipivot(n + matrix_a%matrix_struct%nrow_block)) ipivot(:) = 0 #if defined(__SCALAPACK) IF (my_eps_svd .EQ. 0.0_dp) THEN @@ -1439,7 +1439,7 @@ SUBROUTINE cp_fm_invert(matrix_a, matrix_inverse, det_a, eps_svd, eigval) DO i = 1, n determinant = determinant*diag(i) IF (ipivot(i) .NE. i) THEN - exponent_of_minus_one = exponent_of_minus_one+1 + exponent_of_minus_one = exponent_of_minus_one + 1 END IF ENDDO IF (PRESENT(eigval)) THEN @@ -1486,7 +1486,7 @@ SUBROUTINE cp_fm_invert(matrix_a, matrix_inverse, det_a, eps_svd, eigval) 1, 1, desca, vt%local_data, 1, 1, desca, work, lwork, info) ! info == n+1 implies homogeneity error when the number of procs is large ! this likely isnt a problem, but maybe we should handle it separately - IF (info /= 0 .AND. info /= n+1) & + IF (info /= 0 .AND. info /= n + 1) & CPABORT("Singular value decomposition of matrix failed.") ! (Pseudo)inverse and (pseudo)determinant CALL cp_fm_create(matrix=sigma, & @@ -1672,7 +1672,7 @@ SUBROUTINE cp_fm_qr_factorization(matrix_a, matrix_r, nrow_fact, ncol_fact, firs ALLOCATE (r_mat(ncol, ncol)) CALL cp_fm_get_submatrix(matrix_a, r_mat, 1, 1, ncol, ncol) DO i = 1, ncol - DO j = i+1, ncol + DO j = i + 1, ncol r_mat(j, i) = 0.0_dp END DO END DO @@ -1711,7 +1711,7 @@ SUBROUTINE cp_fm_solve(matrix_a, general_a) a => matrix_a%local_data a_general => general_a%local_data n = matrix_a%matrix_struct%nrow_global - ALLOCATE (ipivot(n+matrix_a%matrix_struct%nrow_block)) + ALLOCATE (ipivot(n + matrix_a%matrix_struct%nrow_block)) #if defined(__SCALAPACK) desca(:) = matrix_a%matrix_struct%descriptor(:) @@ -2078,13 +2078,13 @@ FUNCTION cp_fm_latra(matrix) RESULT(res) IF (matrix%use_sp) THEN res_sp = 0.0_sp DO ii = 1, nrows - res_sp = res_sp+aa_sp(ii, ii) + res_sp = res_sp + aa_sp(ii, ii) END DO res = REAL(res_sp, KIND=dp) ELSE res = 0.0_dp DO ii = 1, nrows - res = res+aa(ii, ii) + res = res + aa(ii, ii) END DO END IF #endif diff --git a/src/fm/cp_fm_diag.F b/src/fm/cp_fm_diag.F index 06fc6afd7e..4f30c26176 100644 --- a/src/fm/cp_fm_diag.F +++ b/src/fm/cp_fm_diag.F @@ -14,52 +14,52 @@ ! ************************************************************************************************** MODULE cp_fm_diag USE cp_blacs_calls, ONLY: cp_blacs_gridexit, & - cp_blacs_gridinit + cp_blacs_gridinit USE cp_blacs_env, ONLY: cp_blacs_env_create, & - cp_blacs_env_release, & - cp_blacs_env_type + cp_blacs_env_release, & + cp_blacs_env_type USE cp_fm_basic_linalg, ONLY: cp_fm_column_scale, & - cp_fm_gemm, & - cp_fm_scale, & - cp_fm_syrk, & - cp_fm_triangular_invert, & - cp_fm_triangular_multiply, & - cp_fm_upper_to_full + cp_fm_gemm, & + cp_fm_scale, & + cp_fm_syrk, & + cp_fm_triangular_invert, & + cp_fm_triangular_multiply, & + cp_fm_upper_to_full USE cp_fm_cholesky, ONLY: cp_fm_cholesky_decompose USE cp_fm_diag_utils, ONLY: cp_fm_redistribute_start, & - cp_fm_redistribute_end + cp_fm_redistribute_end USE cp_fm_elpa, ONLY: cp_fm_diag_elpa, & - set_elpa_kernel, & - set_elpa_qr, & - set_elpa_print, & - initialize_elpa_library, & - finalize_elpa_library + set_elpa_kernel, & + set_elpa_qr, & + set_elpa_print, & + initialize_elpa_library, & + finalize_elpa_library USE cp_fm_struct, ONLY: cp_fm_struct_create, & - cp_fm_struct_release, & - cp_fm_struct_type + cp_fm_struct_release, & + cp_fm_struct_type USE cp_fm_types, ONLY: cp_fm_create, & - cp_fm_get_info, & - cp_fm_release, & - cp_fm_set_element, & - cp_fm_to_fm, & - cp_fm_type + cp_fm_get_info, & + cp_fm_release, & + cp_fm_set_element, & + cp_fm_to_fm, & + cp_fm_type USE cp_log_handling, ONLY: cp_get_default_logger, & - cp_logger_get_default_unit_nr, & - cp_logger_get_unit_nr, & - cp_logger_type + cp_logger_get_default_unit_nr, & + cp_logger_get_unit_nr, & + cp_logger_type USE cp_para_env, ONLY: cp_para_env_create, & - cp_para_env_release + cp_para_env_release USE cp_para_types, ONLY: cp_para_env_type USE kinds, ONLY: dp USE machine, ONLY: m_memory USE message_passing, ONLY: mp_bcast, & - mp_comm_free, & - mp_comm_split, & - mp_sync + mp_comm_free, & + mp_comm_split, & + mp_sync #if defined (__HAS_IEEE_EXCEPTIONS) USE ieee_exceptions, ONLY: ieee_get_halting_mode, & - ieee_set_halting_mode, & - ieee_all + ieee_set_halting_mode, & + ieee_all #endif #include "../base/base_uses.f90" @@ -221,7 +221,7 @@ SUBROUTINE choose_eigv_solver(matrix, eigenvectors, eigenvalues, info) CALL infog2l(i, j, desca, nprow, npcol, myprow, mypcol, il, jl, iprow, ipcol) IF ((iprow == myprow) .AND. (ipcol == mypcol)) THEN IF (i == j) THEN - IF (ABS(matrix%local_data(il, jl)-1.0_dp) > eps) THEN + IF (ABS(matrix%local_data(il, jl) - 1.0_dp) > eps) THEN WRITE (UNIT=*, FMT="(/,T2,A,/,T2,A,I0,A,I0,A,F0.12,/,T2,A)") & "The eigenvectors returned by "//TRIM(diag_driver(diag_type))//" are not orthonormal", & "Matrix element (", i, ", ", j, ") = ", matrix%local_data(il, jl), & @@ -249,7 +249,7 @@ SUBROUTINE choose_eigv_solver(matrix, eigenvectors, eigenvalues, info) DO i = 1, nmo DO j = 1, nmo IF (i == j) THEN - IF (ABS(matrix%local_data(i, j)-1.0_dp) > eps) THEN + IF (ABS(matrix%local_data(i, j) - 1.0_dp) > eps) THEN WRITE (UNIT=*, FMT="(/,T2,A,/,T2,A,I0,A,I0,A,F0.12,/,T2,A)") & "The eigenvectors returned by "//TRIM(diag_driver(diag_type))//" are not orthonormal", & "Matrix element (", i, ", ", j, ") = ", matrix%local_data(i, j), & @@ -427,7 +427,7 @@ SUBROUTINE cp_fm_syevd_base(matrix, eigenvectors, eig, info) v => eigenvectors%local_data descv(:) = eigenvectors%matrix_struct%descriptor(:) - liwork = 7*n+8*context%num_pe(2)+2 + liwork = 7*n + 8*context%num_pe(2) + 2 ALLOCATE (iwork(liwork)) ! work space query @@ -443,7 +443,7 @@ SUBROUTINE cp_fm_syevd_base(matrix, eigenvectors, eig, info) ! arbitrary additional memory ... we give 100000 more words ! (it seems to depend on the block size used) - lwork = NINT(work(1)+100000) + lwork = NINT(work(1) + 100000) ! lwork = NINT(work(1)) DEALLOCATE (work) ALLOCATE (work(lwork)) @@ -605,12 +605,12 @@ SUBROUTINE cp_fm_syevx(matrix, eigenvectors, eigenvalues, neig, work_syevx) nq0 = MAX(numroc(nn, nb, 0, 0, npcol), nb) IF (needs_evecs) THEN - lwork = 5*n+MAX(5*nn, np0*nq0)+iceil(neig_local, npe)*nn+2*nb*nb+ & - INT(work_syevx_local*REAL((neig_local-1)*n, dp)) !!!! allocates a full matrix on every CPU !!!!! + lwork = 5*n + MAX(5*nn, np0*nq0) + iceil(neig_local, npe)*nn + 2*nb*nb + & + INT(work_syevx_local*REAL((neig_local - 1)*n, dp)) !!!! allocates a full matrix on every CPU !!!!! ELSE - lwork = 5*n+MAX(5*nn, nb*(np0+1)) + lwork = 5*n + MAX(5*nn, nb*(np0 + 1)) ENDIF - liwork = 6*MAX(N, npe+1, 4) + liwork = 6*MAX(N, npe + 1, 4) ALLOCATE (gap(npe)) gap = 0.0_dp @@ -680,7 +680,7 @@ SUBROUTINE cp_fm_syevx(matrix, eigenvectors, eigenvalues, neig, work_syevx) nb = MAX(ilaenv(1, "DSYTRD", "U", n, -1, -1, -1), & ilaenv(1, "DORMTR", "U", n, -1, -1, -1)) - lwork = MAX((nb+3)*n, 8*n)+n ! sun bug fix + lwork = MAX((nb + 3)*n, 8*n) + n ! sun bug fix liwork = 5*n ALLOCATE (ifail(n)) @@ -784,7 +784,7 @@ SUBROUTINE cp_fm_syevr(matrix, eigenvectors, eigenvalues, ilow, iup, vlow, vup) ilow_local = 1 range_type = "I" IF (PRESENT(ilow) .AND. PRESENT(iup)) THEN - neig = iup-ilow+1 + neig = iup - ilow + 1 iup_local = iup ilow_local = ilow ELSE IF (PRESENT(vlow) .AND. PRESENT(vup)) THEN @@ -842,7 +842,7 @@ SUBROUTINE cp_fm_syevr(matrix, eigenvectors, eigenvalues, ilow, iup, vlow, vup) m, nz, w(1), z, 1, 1, descz, work, lwork, iwork, liwork, info) lwork = INT(work(1)) - lwork = NINT(work(1)+300000) + lwork = NINT(work(1) + 300000) liwork = iwork(1) IF (lwork > SIZE(work, 1)) THEN DEALLOCATE (work) @@ -883,7 +883,7 @@ SUBROUTINE cp_fm_syevr(matrix, eigenvectors, eigenvalues, ilow, iup, vlow, vup) nb = MAX(ilaenv(1, "DSYTRD", "U", n, -1, -1, -1), & ilaenv(1, "DORMTR", "U", n, -1, -1, -1)) - lwork = MAX((nb+3)*n, 8*n)+n ! sun bug fix + lwork = MAX((nb + 3)*n, 8*n) + n ! sun bug fix liwork = 5*n ALLOCATE (ifail(n)) @@ -1002,7 +1002,7 @@ SUBROUTINE cp_fm_power(matrix, work, exponent, threshold, n_dependent, verbose, IF (eigenvalues(icol_global) < threshold) THEN - n_dependent = n_dependent+1 + n_dependent = n_dependent + 1 ipcol = indxg2p(icol_global, ncol_block, mypcol, & work%matrix_struct%first_p_pos(2), npcol) @@ -1057,7 +1057,7 @@ SUBROUTINE cp_fm_power(matrix, work, exponent, threshold, n_dependent, verbose, IF (eigenvalues(icol_global) < threshold) THEN - n_dependent = n_dependent+1 + n_dependent = n_dependent + 1 eigenvectors(1:nrow_global, icol_global) = 0.0_dp ELSE @@ -1174,8 +1174,8 @@ SUBROUTINE cp_fm_block_jacobi(matrix, eigenvectors, eigval, thresh, & ! ACHTUNG start_sec_block sagt aus WO der ZWEITE Block STARTET!!! ! Der Block wird mitsamt dem OO-Block bearbeitet - block_dim_row = start_sec_block-1 - block_dim_col = N-block_dim_row + block_dim_row = start_sec_block - 1 + block_dim_col = N - block_dim_row ALLOCATE (A_loc(block_dim_row, block_dim_col)) mype = matrix%matrix_struct%para_env%mepos @@ -1216,17 +1216,17 @@ SUBROUTINE cp_fm_block_jacobi(matrix, eigenvectors, eigval, thresh, & q_loc = 0 DO q = start_sec_block, N - q_loc = q_loc+1 - DO p = 1, (start_sec_block-1) + q_loc = q_loc + 1 + DO p = 1, (start_sec_block - 1) IF (ABS(A_loc(p, q_loc)) > thresh) THEN - tau = (eigval(q)-eigval(p))/(2.0_dp*A_loc(p, q_loc)) + tau = (eigval(q) - eigval(p))/(2.0_dp*A_loc(p, q_loc)) - tan_theta = SIGN(1.0_dp, tau)/(ABS(tau)+SQRT(1.0_dp+tau*tau)) + tan_theta = SIGN(1.0_dp, tau)/(ABS(tau) + SQRT(1.0_dp + tau*tau)) ! cos theta - c = 1.0_dp/SQRT(1.0_dp+tan_theta*tan_theta) + c = 1.0_dp/SQRT(1.0_dp + tan_theta*tan_theta) s = tan_theta*c ! Und jetzt noch die Eigenvektoren produzieren: @@ -1273,16 +1273,16 @@ SUBROUTINE cp_fm_block_jacobi(matrix, eigenvectors, eigval, thresh, & tau = 0.0_dp DO q = start_sec_block, N - DO p = 1, (start_sec_block-1) + DO p = 1, (start_sec_block - 1) IF (ABS(A(p, q)) > thresh) THEN - tau = (eigval(q)-eigval(p))/(2.0_dp*A(p, q)) + tau = (eigval(q) - eigval(p))/(2.0_dp*A(p, q)) - tan_theta = SIGN(1.0_dp, tau)/(ABS(tau)+SQRT(1.0_dp+tau*tau)) + tan_theta = SIGN(1.0_dp, tau)/(ABS(tau) + SQRT(1.0_dp + tau*tau)) ! cos theta - c = 1.0_dp/SQRT(1.0_dp+tan_theta*tan_theta) + c = 1.0_dp/SQRT(1.0_dp + tan_theta*tan_theta) s = tan_theta*c ! Und jetzt noch die Eigenvektoren produzieren: @@ -1457,7 +1457,7 @@ SUBROUTINE cp_fm_geeig_canon(amatrix, bmatrix, eigenvectors, eigenvalues, work, nc = nao DO i = 1, nao IF (seigval(i) < epseig) THEN - nc = i-1 + nc = i - 1 EXIT END IF END DO @@ -1466,17 +1466,17 @@ SUBROUTINE cp_fm_geeig_canon(amatrix, bmatrix, eigenvectors, eigenvalues, work, IF (nc /= nao) THEN IF (nc < nmo) THEN ! Copy NULL space definition to last vectors of eigenvectors (if needed) - ncol = nmo-nc - CALL cp_fm_to_fm(work, eigenvectors, ncol, nc+1, nc+1) + ncol = nmo - nc + CALL cp_fm_to_fm(work, eigenvectors, ncol, nc + 1, nc + 1) END IF ! Set NULL space in eigenvector matrix of S to zero - DO icol = nc+1, nao + DO icol = nc + 1, nao DO irow = 1, nao CALL cp_fm_set_element(work, irow, icol, 0.0_dp) END DO END DO ! Set small eigenvalues to a dummy save value - seigval(nc+1:nao) = 1.0_dp + seigval(nc + 1:nao) = 1.0_dp END IF ! calculate U*s**(-1/2) seigval(:) = 1.0_dp/SQRT(seigval(:)) @@ -1486,7 +1486,7 @@ SUBROUTINE cp_fm_geeig_canon(amatrix, bmatrix, eigenvectors, eigenvalues, work, CALL cp_fm_gemm("N", "N", nao, nao, nao, 1.0_dp, bmatrix, work, 0.0_dp, amatrix) IF (nc /= nao) THEN ! set diagonal values to save large value - DO icol = nc+1, nao + DO icol = nc + 1, nao CALL cp_fm_set_element(amatrix, icol, icol, 10000.0_dp) END DO END IF diff --git a/src/fm/cp_fm_diag_utils.F b/src/fm/cp_fm_diag_utils.F index 7ca5a4c5be..7030fa7266 100644 --- a/src/fm/cp_fm_diag_utils.F +++ b/src/fm/cp_fm_diag_utils.F @@ -147,7 +147,7 @@ FUNCTION cp_fm_diag_get_optimal_ncpu(size) RESULT(ncpu) CHARACTER(len=*), PARAMETER :: routineN = 'cp_fm_diag_get_optimal_ncpu', & routineP = moduleN//':'//routineN - ncpu = ((size+work_redistribute%a*work_redistribute%x-1)/ & + ncpu = ((size + work_redistribute%a*work_redistribute%x - 1)/ & (work_redistribute%a*work_redistribute%x))*work_redistribute%a END FUNCTION cp_fm_diag_get_optimal_ncpu @@ -185,9 +185,9 @@ FUNCTION cp_fm_elpa_get_max_ncpu(matrix) RESULT(ncpu) nrow_block=nrow_block, ncol_block=ncol_block) nzero = COUNT(ncol_locals == 0) num_pe_old = matrix%matrix_struct%para_env%num_pe - ncpu = num_pe_old-nzero + ncpu = num_pe_old - nzero ! Avoid layouts with odd number of CPUs (blacs grid layout will be square) - IF (ncpu /= 1) ncpu = ncpu-MODULO(ncpu, 2) + IF (ncpu /= 1) ncpu = ncpu - MODULO(ncpu, 2) ! Iteratively search for the maximum number of CPUs for ELPA ! On each step, we test whether the blacs grid created with ncpu processes ! contains any columns with zero width @@ -210,15 +210,15 @@ FUNCTION cp_fm_elpa_get_max_ncpu(matrix) RESULT(ncpu) ! Test if there are any columns with zero width ! (snippet copied from cp_fm_struct.F:cp_fm_struct_create) nzero = 0 - DO ipe = 0, npcol-1 + DO ipe = 0, npcol - 1 IF (numroc(ncol_global, ncol_block, ipe, 0, npcol) == 0) & - nzero = nzero+1 + nzero = nzero + 1 END DO IF (nzero == 0) THEN max_cpu_found = .TRUE. ELSE - ncpu = ncpu-nzero - IF (ncpu /= 1) ncpu = ncpu-MODULO(ncpu, 2) + ncpu = ncpu - nzero + IF (ncpu /= 1) ncpu = ncpu - MODULO(ncpu, 2) END IF END DO CPASSERT(ncpu .GT. 0) @@ -334,9 +334,9 @@ SUBROUTINE cp_fm_redistribute_start(matrix, eigenvectors, matrix_new, eigenvecto IF (do_redistribute) THEN ! split comm, the first num_pe_new tasks will do the work - ALLOCATE (work_redistribute%group_distribution(0:num_pe_old-1)) + ALLOCATE (work_redistribute%group_distribution(0:num_pe_old - 1)) ALLOCATE (work_redistribute%group_partition(0:1)) - work_redistribute%group_partition = (/num_pe_new, num_pe_old-num_pe_new/) + work_redistribute%group_partition = (/num_pe_new, num_pe_old - num_pe_new/) CALL mp_comm_split(comm=para_env%group, sub_comm=work_redistribute%subgroup, & ngroups=ngroups, group_distribution=work_redistribute%group_distribution, & n_subgroups=2, group_partition=work_redistribute%group_partition) diff --git a/src/fm/cp_fm_pool_types.F b/src/fm/cp_fm_pool_types.F index 8a658d3500..382ccecad2 100644 --- a/src/fm/cp_fm_pool_types.F +++ b/src/fm/cp_fm_pool_types.F @@ -91,7 +91,7 @@ SUBROUTINE fm_pool_create(pool, el_struct) ALLOCATE (pool) pool%el_struct => el_struct CALL cp_fm_struct_retain(pool%el_struct) - last_fm_pool_id_nr = last_fm_pool_id_nr+1 + last_fm_pool_id_nr = last_fm_pool_id_nr + 1 pool%id_nr = last_fm_pool_id_nr pool%ref_count = 1 NULLIFY (pool%cache) @@ -113,7 +113,7 @@ SUBROUTINE fm_pool_retain(pool) CPASSERT(ASSOCIATED(pool)) CPASSERT(pool%ref_count > 0) - pool%ref_count = pool%ref_count+1 + pool%ref_count = pool%ref_count + 1 END SUBROUTINE fm_pool_retain ! ************************************************************************************************** @@ -157,7 +157,7 @@ SUBROUTINE fm_pool_release(pool) IF (ASSOCIATED(pool)) THEN CPASSERT(pool%ref_count > 0) - pool%ref_count = pool%ref_count-1 + pool%ref_count = pool%ref_count - 1 IF (pool%ref_count == 0) THEN pool%ref_count = 1 CALL fm_pool_flush_cache(pool) diff --git a/src/fm/cp_fm_struct.F b/src/fm/cp_fm_struct.F index 29fe71b03b..6306c10da9 100644 --- a/src/fm/cp_fm_struct.F +++ b/src/fm/cp_fm_struct.F @@ -220,8 +220,8 @@ SUBROUTINE cp_fm_struct_create(fmstruct, para_env, context, nrow_global, & fmstruct%ncol_block = fmstruct%nrow_block END IF - ALLOCATE (fmstruct%nrow_locals(0:(fmstruct%context%num_pe(1)-1)), & - fmstruct%ncol_locals(0:(fmstruct%context%num_pe(2)-1))) + ALLOCATE (fmstruct%nrow_locals(0:(fmstruct%context%num_pe(1) - 1)), & + fmstruct%ncol_locals(0:(fmstruct%context%num_pe(2) - 1))) IF (.NOT. PRESENT(template_fmstruct)) & fmstruct%first_p_pos = (/0, 0/) IF (PRESENT(first_p_pos)) fmstruct%first_p_pos = first_p_pos @@ -279,7 +279,7 @@ SUBROUTINE cp_fm_struct_create(fmstruct, para_env, context, nrow_global, & END IF NULLIFY (fmstruct%row_indices, fmstruct%col_indices) - last_fmstruct_id_nr = last_fmstruct_id_nr+1 + last_fmstruct_id_nr = last_fmstruct_id_nr + 1 fmstruct%id_nr = last_fmstruct_id_nr fmstruct%ref_count = 1 @@ -314,7 +314,7 @@ SUBROUTINE cp_fm_struct_retain(fmstruct) CPASSERT(ASSOCIATED(fmstruct)) CPASSERT(fmstruct%ref_count > 0) - fmstruct%ref_count = fmstruct%ref_count+1 + fmstruct%ref_count = fmstruct%ref_count + 1 END SUBROUTINE cp_fm_struct_retain ! ************************************************************************************************** @@ -332,7 +332,7 @@ SUBROUTINE cp_fm_struct_release(fmstruct) IF (ASSOCIATED(fmstruct)) THEN CPASSERT(fmstruct%ref_count > 0) - fmstruct%ref_count = fmstruct%ref_count-1 + fmstruct%ref_count = fmstruct%ref_count - 1 IF (fmstruct%ref_count < 1) THEN CALL cp_blacs_env_release(fmstruct%context) CALL cp_para_env_release(fmstruct%para_env) @@ -542,10 +542,10 @@ SUBROUTINE cp_fm_struct_double(fmstruct, struct, context, col, row) newdim_col = 0 ELSE !Divide ncol_global by ncol_block and round up - nblocks = (ncol_global+ncol_block-1)/ncol_block + nblocks = (ncol_global + ncol_block - 1)/ncol_block nfilled = MOD(nblocks, nprocs_col) - nempty = MOD(nprocs_col-nfilled, nprocs_col) - newdim_col = 2*ncol_global+2*nempty*ncol_block+2*MOD(ncol_block-MOD(ncol_global, ncol_block), ncol_block) + nempty = MOD(nprocs_col - nfilled, nprocs_col) + newdim_col = 2*ncol_global + 2*nempty*ncol_block + 2*MOD(ncol_block - MOD(ncol_global, ncol_block), ncol_block) END IF END IF @@ -554,10 +554,10 @@ SUBROUTINE cp_fm_struct_double(fmstruct, struct, context, col, row) newdim_row = 0 ELSE !Divide nrow_global by nrow_block and round up - nblocks = (nrow_global+nrow_block-1)/nrow_block + nblocks = (nrow_global + nrow_block - 1)/nrow_block nfilled = MOD(nblocks, nprocs_row) - nempty = MOD(nprocs_row-nfilled, nprocs_row) - newdim_row = 2*nrow_global+2*nempty*nrow_block+2*MOD(nrow_block-MOD(nrow_global, nrow_block), nrow_block) + nempty = MOD(nprocs_row - nfilled, nprocs_row) + newdim_row = 2*nrow_global + 2*nempty*nrow_block + 2*MOD(nrow_block - MOD(nrow_global, nrow_block), nrow_block) END IF END IF diff --git a/src/fm/cp_fm_types.F b/src/fm/cp_fm_types.F index 2c13304dfb..86a893bb10 100644 --- a/src/fm/cp_fm_types.F +++ b/src/fm/cp_fm_types.F @@ -178,7 +178,7 @@ SUBROUTINE cp_fm_create(matrix, matrix_struct, name, use_sp) context => matrix_struct%context matrix%matrix_struct => matrix_struct CALL cp_fm_struct_retain(matrix%matrix_struct) - last_fm_id_nr = last_fm_id_nr+1 + last_fm_id_nr = last_fm_id_nr + 1 matrix%id_nr = last_fm_id_nr matrix%ref_count = 1 matrix%print_count = 0 @@ -233,7 +233,7 @@ SUBROUTINE cp_fm_retain(matrix) CPASSERT(ASSOCIATED(matrix)) CPASSERT(matrix%ref_count > 0) - matrix%ref_count = matrix%ref_count+1 + matrix%ref_count = matrix%ref_count + 1 END SUBROUTINE cp_fm_retain @@ -255,7 +255,7 @@ SUBROUTINE cp_fm_release(matrix) IF (ASSOCIATED(matrix)) THEN CPASSERT(matrix%ref_count > 0) - matrix%ref_count = matrix%ref_count-1 + matrix%ref_count = matrix%ref_count - 1 IF (matrix%ref_count < 1) THEN IF (ASSOCIATED(matrix%local_data)) THEN DEALLOCATE (matrix%local_data) @@ -325,7 +325,7 @@ SUBROUTINE cp_fm_init_random(matrix, ncol, start_col) my_ncol = matrix%matrix_struct%ncol_global IF (PRESENT(ncol)) my_ncol = ncol - IF (ncol_global < (my_start_col+my_ncol-1)) & + IF (ncol_global < (my_start_col + my_ncol - 1)) & CPABORT("ncol_global>=(my_start_col+my_ncol-1)") ALLOCATE (buff(nrow_global)) @@ -338,7 +338,7 @@ SUBROUTINE cp_fm_init_random(matrix, ncol, start_col) CPASSERT(col_indices(icol_local) > icol_global) DO CALL reset_to_next_rng_substream(rng) - icol_global = icol_global+1 + icol_global = icol_global + 1 IF (icol_global == col_indices(icol_local)) EXIT ENDDO CALL random_numbers(buff, rng) @@ -665,7 +665,7 @@ SUBROUTINE cp_fm_set_submatrix(fm, new_values, start_row, & IF (al == 1.0 .AND. be == 0.0) THEN DO j = 1, ncol_local - this_col = col_indices(j)-j0+1 + this_col = col_indices(j) - j0 + 1 IF (this_col .GE. 1 .AND. this_col .LE. ncol) THEN IF (tr_a) THEN IF (i0 == 1 .AND. nrow_global == nrow) THEN @@ -674,7 +674,7 @@ SUBROUTINE cp_fm_set_submatrix(fm, new_values, start_row, & END DO ELSE DO i = 1, nrow_local - this_row = row_indices(i)-i0+1 + this_row = row_indices(i) - i0 + 1 IF (this_row >= 1 .AND. this_row <= nrow) THEN full_block(i, j) = new_values(this_col, this_row) END IF @@ -687,7 +687,7 @@ SUBROUTINE cp_fm_set_submatrix(fm, new_values, start_row, & END DO ELSE DO i = 1, nrow_local - this_row = row_indices(i)-i0+1 + this_row = row_indices(i) - i0 + 1 IF (this_row >= 1 .AND. this_row <= nrow) THEN full_block(i, j) = new_values(this_row, this_col) END IF @@ -698,21 +698,21 @@ SUBROUTINE cp_fm_set_submatrix(fm, new_values, start_row, & END DO ELSE DO j = 1, ncol_local - this_col = col_indices(j)-j0+1 + this_col = col_indices(j) - j0 + 1 IF (this_col .GE. 1 .AND. this_col .LE. ncol) THEN IF (tr_a) THEN DO i = 1, nrow_local - this_row = row_indices(i)-i0+1 + this_row = row_indices(i) - i0 + 1 IF (this_row >= 1 .AND. this_row <= nrow) THEN - full_block(i, j) = al*new_values(this_col, this_row)+ & + full_block(i, j) = al*new_values(this_col, this_row) + & be*full_block(i, j) END IF END DO ELSE DO i = 1, nrow_local - this_row = row_indices(i)-i0+1 + this_row = row_indices(i) - i0 + 1 IF (this_row >= 1 .AND. this_row <= nrow) THEN - full_block(i, j) = al*new_values(this_row, this_col)+ & + full_block(i, j) = al*new_values(this_row, this_col) + & be*full_block(i, j) END IF END DO @@ -806,7 +806,7 @@ SUBROUTINE cp_fm_get_submatrix(fm, target_m, start_row, & row_indices=row_indices, col_indices=col_indices) DO j = 1, ncol_local - this_col = col_indices(j)-j0+1 + this_col = col_indices(j) - j0 + 1 IF (this_col .GE. 1 .AND. this_col .LE. ncol) THEN IF (tr_a) THEN IF (i0 == 1 .AND. nrow_global == nrow) THEN @@ -815,7 +815,7 @@ SUBROUTINE cp_fm_get_submatrix(fm, target_m, start_row, & END DO ELSE DO i = 1, nrow_local - this_row = row_indices(i)-i0+1 + this_row = row_indices(i) - i0 + 1 IF (this_row >= 1 .AND. this_row <= nrow) THEN target_m(this_col, this_row) = full_block(i, j) END IF @@ -828,7 +828,7 @@ SUBROUTINE cp_fm_get_submatrix(fm, target_m, start_row, & END DO ELSE DO i = 1, nrow_local - this_row = row_indices(i)-i0+1 + this_row = row_indices(i) - i0 + 1 IF (this_row >= 1 .AND. this_row <= nrow) THEN target_m(this_row, this_col) = full_block(i, j) END IF @@ -959,12 +959,12 @@ SUBROUTINE cp_fm_maxabsval(matrix, a_max, ir_max, ic_max) IF (PRESENT(ir_max)) THEN num_pe = matrix%matrix_struct%para_env%num_pe mepos = matrix%matrix_struct%para_env%mepos - ALLOCATE (ir_max_vec(0:num_pe-1)) - ir_max_vec(0:num_pe-1) = 0 - ALLOCATE (ic_max_vec(0:num_pe-1)) - ic_max_vec(0:num_pe-1) = 0 - ALLOCATE (a_max_vec(0:num_pe-1)) - a_max_vec(0:num_pe-1) = 0.0_dp + ALLOCATE (ir_max_vec(0:num_pe - 1)) + ir_max_vec(0:num_pe - 1) = 0 + ALLOCATE (ic_max_vec(0:num_pe - 1)) + ic_max_vec(0:num_pe - 1) = 0 + ALLOCATE (a_max_vec(0:num_pe - 1)) + a_max_vec(0:num_pe - 1) = 0.0_dp my_max = 0.0_dp IF ((ncol_local > 0) .AND. (nrow_local > 0)) THEN @@ -997,7 +997,7 @@ SUBROUTINE cp_fm_maxabsval(matrix, a_max, ir_max, ic_max) CALL mp_sum(ic_max_vec, matrix%matrix_struct%para_env%group) my_max = 0.0_dp - DO i = 0, num_pe-1 + DO i = 0, num_pe - 1 IF (a_max_vec(i) > my_max) THEN ir_max = ir_max_vec(i) ic_max = ic_max_vec(i) @@ -1054,7 +1054,7 @@ SUBROUTINE cp_fm_maxabsrownorm(matrix, a_max) values = 0.0_dp DO j = 1, ncol_local DO i = 1, nrow_local - values(row_indices(i)) = values(row_indices(i))+ABS(my_block(i, j)) + values(row_indices(i)) = values(row_indices(i)) + ABS(my_block(i, j)) ENDDO ENDDO CALL mp_sum(values, matrix%matrix_struct%para_env%group) @@ -1094,7 +1094,7 @@ SUBROUTINE cp_fm_vectorsnorm(matrix, norm_array) norm_array = 0.0_dp DO j = 1, ncol_local DO i = 1, nrow_local - norm_array(col_indices(j)) = norm_array(col_indices(j))+my_block(i, j)*my_block(i, j) + norm_array(col_indices(j)) = norm_array(col_indices(j)) + my_block(i, j)*my_block(i, j) ENDDO ENDDO CALL mp_sum(norm_array, matrix%matrix_struct%para_env%group) @@ -1136,7 +1136,7 @@ SUBROUTINE cp_fm_vectorssum(matrix, sum_array) sum_array(:) = 0.0_dp DO j = 1, ncol_local DO i = 1, nrow_local - sum_array(col_indices(j)) = sum_array(col_indices(j))+my_block(i, j) + sum_array(col_indices(j)) = sum_array(col_indices(j)) + my_block(i, j) ENDDO ENDDO CALL mp_sum(sum_array, matrix%matrix_struct%para_env%group) @@ -1252,8 +1252,8 @@ SUBROUTINE cp_fm_to_fm_columns(msource, mtarget, ncol, source_start, & #if defined(__SCALAPACK) desca(:) = msource%matrix_struct%descriptor(:) descb(:) = mtarget%matrix_struct%descriptor(:) - DO i = 0, ncol-1 - CALL pdcopy(n, a(1, 1), 1, ss+i, desca, 1, b(1, 1), 1, ts+i, descb, 1) + DO i = 0, ncol - 1 + CALL pdcopy(n, a(1, 1), 1, ss + i, desca, 1, b(1, 1), 1, ts + i, descb, 1) END DO #else CALL dcopy(ncol*n, a(1, ss), 1, b(1, ts), 1) @@ -1354,15 +1354,15 @@ SUBROUTINE cp_fm_to_fm_submat(msource, mtarget, nrow, ncol, s_firstrow, s_firstc #if defined(__SCALAPACK) desca(:) = msource%matrix_struct%descriptor(:) descb(:) = mtarget%matrix_struct%descriptor(:) - DO i = 0, ncol-1 - ss = s_firstcol+i - ts = t_firstcol+i + DO i = 0, ncol - 1 + ss = s_firstcol + i + ts = t_firstcol + i CALL pdcopy(nrow, a(1, 1), s_firstrow, ss, desca, 1, b(1, 1), t_firstrow, ts, descb, 1) END DO #else - DO i = 0, ncol-1 - ss = s_firstcol+i - ts = t_firstcol+i + DO i = 0, ncol - 1 + ss = s_firstcol + i + ts = t_firstcol + i CALL dcopy(nrow, a(s_firstrow, ss), 1, b(t_firstrow, ts), 1) END DO #endif @@ -1448,7 +1448,7 @@ SUBROUTINE cp_fm_start_copy_general(source, destination, para_env, info) k = 0 DO j = 1, ncol_local_send DO i = 1, nrow_local_send - k = k+1 + k = k + 1 send_buf(k) = source%local_data(i, j) END DO END DO @@ -1488,12 +1488,12 @@ SUBROUTINE cp_fm_start_copy_general(source, destination, para_env, info) END IF ! Map the rank in the source/dest communicator to the global rank - ALLOCATE (all_ranks(0:global_size-1)) + ALLOCATE (all_ranks(0:global_size - 1)) CALL mp_allgather(send_rank, all_ranks, global_comm) IF (ASSOCIATED(destination)) THEN - ALLOCATE (source2global(0:COUNT(all_ranks .NE. mp_proc_null)-1)) - DO i = 0, global_size-1 + ALLOCATE (source2global(0:COUNT(all_ranks .NE. mp_proc_null) - 1)) + DO i = 0, global_size - 1 IF (all_ranks(i) .NE. mp_proc_null) THEN source2global(all_ranks(i)) = i END IF @@ -1502,8 +1502,8 @@ SUBROUTINE cp_fm_start_copy_general(source, destination, para_env, info) CALL mp_allgather(recv_rank, all_ranks, global_comm) IF (ASSOCIATED(source)) THEN - ALLOCATE (dest2global(0:COUNT(all_ranks .NE. mp_proc_null)-1)) - DO i = 0, global_size-1 + ALLOCATE (dest2global(0:COUNT(all_ranks .NE. mp_proc_null) - 1)) + DO i = 0, global_size - 1 IF (all_ranks(i) .NE. mp_proc_null) THEN dest2global(all_ranks(i)) = i END IF @@ -1544,8 +1544,8 @@ SUBROUTINE cp_fm_start_copy_general(source, destination, para_env, info) IF (global_rank == 0) THEN CALL mp_waitall(recv_req(1:4)) ! Now we know the process decomposition, we can allocate the arrays to hold the blacs2mpi mapping - ALLOCATE (src_blacs2mpi(0:src_num_pe(1)-1, 0:src_num_pe(2)-1), & - dest_blacs2mpi(0:dest_num_pe(1)-1, 0:dest_num_pe(2)-1) & + ALLOCATE (src_blacs2mpi(0:src_num_pe(1) - 1, 0:src_num_pe(2) - 1), & + dest_blacs2mpi(0:dest_num_pe(1) - 1, 0:dest_num_pe(2) - 1) & ) CALL mp_irecv(src_blacs2mpi, mp_any_source, global_comm, recv_req(5), tag=src_tag) CALL mp_irecv(dest_blacs2mpi, mp_any_source, global_comm, recv_req(6), tag=dest_tag) @@ -1575,8 +1575,8 @@ SUBROUTINE cp_fm_start_copy_general(source, destination, para_env, info) info%src_num_pe(1:2) = src_num_pe(1:2) info%nblock_src(1:2) = src_block(1:2) IF (global_rank .NE. 0) THEN - ALLOCATE (src_blacs2mpi(0:src_num_pe(1)-1, 0:src_num_pe(2)-1), & - dest_blacs2mpi(0:dest_num_pe(1)-1, 0:dest_num_pe(2)-1) & + ALLOCATE (src_blacs2mpi(0:src_num_pe(1) - 1, 0:src_num_pe(2) - 1), & + dest_blacs2mpi(0:dest_num_pe(1) - 1, 0:dest_num_pe(2) - 1) & ) END IF CALL mp_bcast(src_blacs2mpi, 0, global_comm) @@ -1611,7 +1611,7 @@ SUBROUTINE cp_fm_start_copy_general(source, destination, para_env, info) info%recv_row_indices => recv_row_indices nrow_block_src = src_block(1) ncol_block_src = src_block(2) - ALLOCATE (recv_count(0:send_size-1), recv_disp(0:send_size-1), recv_request(0:send_size-1)) + ALLOCATE (recv_count(0:send_size - 1), recv_disp(0:send_size - 1), recv_request(0:send_size - 1)) ! Determine the recv counts, allocate the receive buffers, call mpi_irecv for all the non-zero sized receives nrow_local_recv = recv_dist%nrow_locals(recv_dist%context%mepos(1)) @@ -1623,17 +1623,17 @@ SUBROUTINE cp_fm_start_copy_general(source, destination, para_env, info) DO i = 1, nrow_local_recv ! For each local row we will receive, we look up its global row (in recv_row_indices), ! then work out which row block it comes from, and which process row that row block comes from. - src_p(i) = MOD(((recv_row_indices(i)-1)/nrow_block_src), src_num_pe(1)) + src_p(i) = MOD(((recv_row_indices(i) - 1)/nrow_block_src), src_num_pe(1)) END DO DO j = 1, ncol_local_recv ! Similarly for the columns - src_q(j) = MOD(((recv_col_indices(j)-1)/ncol_block_src), src_num_pe(2)) + src_q(j) = MOD(((recv_col_indices(j) - 1)/ncol_block_src), src_num_pe(2)) END DO ! src_p/q now contains the process row/column ID that will send data to that row/column - DO q = 0, src_num_pe(2)-1 + DO q = 0, src_num_pe(2) - 1 ncols = COUNT(src_q .EQ. q) - DO p = 0, src_num_pe(1)-1 + DO p = 0, src_num_pe(1) - 1 nrows = COUNT(src_p .EQ. p) ! Use the send_dist here as we are looking up the processes where the data comes from recv_count(src_blacs2mpi(p, q)) = nrows*ncols @@ -1646,15 +1646,15 @@ SUBROUTINE cp_fm_start_copy_general(source, destination, para_env, info) ALLOCATE (recv_buf(SUM(recv_count(:)))) info%recv_buf => recv_buf recv_disp(0) = 0 - DO i = 1, send_size-1 - recv_disp(i) = recv_disp(i-1)+recv_count(i-1) + DO i = 1, send_size - 1 + recv_disp(i) = recv_disp(i - 1) + recv_count(i - 1) END DO info%recv_disp => recv_disp ! Issue receive calls on ranks which expect data - DO k = 0, send_size-1 + DO k = 0, send_size - 1 IF (recv_count(k) .GT. 0) THEN - CALL mp_irecv(recv_buf(recv_disp(k)+1:recv_disp(k)+recv_count(k)), & + CALL mp_irecv(recv_buf(recv_disp(k) + 1:recv_disp(k) + recv_count(k)), & source2global(k), global_comm, recv_request(k)) ELSE recv_request(k) = mp_request_null @@ -1671,7 +1671,7 @@ SUBROUTINE cp_fm_start_copy_general(source, destination, para_env, info) ) nrow_block_dest = dest_block(1) ncol_block_dest = dest_block(2) - ALLOCATE (send_count(0:recv_size-1), send_disp(0:recv_size-1), send_request(0:recv_size-1)) + ALLOCATE (send_count(0:recv_size - 1), send_disp(0:recv_size - 1), send_request(0:recv_size - 1)) ! Determine the send counts, allocate the send buffers nrow_local_send = send_dist%nrow_locals(send_dist%context%mepos(1)) @@ -1683,16 +1683,16 @@ SUBROUTINE cp_fm_start_copy_general(source, destination, para_env, info) DO i = 1, nrow_local_send ! Use the send_dist%row_indices() here (we are looping over the local rows we will send) - dest_p(i) = MOD(((send_row_indices(i)-1)/nrow_block_dest), dest_num_pe(1)) + dest_p(i) = MOD(((send_row_indices(i) - 1)/nrow_block_dest), dest_num_pe(1)) END DO DO j = 1, ncol_local_send - dest_q(j) = MOD(((send_col_indices(j)-1)/ncol_block_dest), dest_num_pe(2)) + dest_q(j) = MOD(((send_col_indices(j) - 1)/ncol_block_dest), dest_num_pe(2)) END DO ! dest_p/q now contain the process row/column ID that will receive data from that row/column - DO q = 0, dest_num_pe(2)-1 + DO q = 0, dest_num_pe(2) - 1 ncols = COUNT(dest_q .EQ. q) - DO p = 0, dest_num_pe(1)-1 + DO p = 0, dest_num_pe(1) - 1 nrows = COUNT(dest_p .EQ. p) send_count(dest_blacs2mpi(p, q)) = nrows*ncols END DO @@ -1702,28 +1702,28 @@ SUBROUTINE cp_fm_start_copy_general(source, destination, para_env, info) ! Allocate the send buffer using send_count -- and calculate the offset into the buffer for each process ALLOCATE (send_buf(SUM(send_count(:)))) send_disp(0) = 0 - DO k = 1, recv_size-1 - send_disp(k) = send_disp(k-1)+send_count(k-1) + DO k = 1, recv_size - 1 + send_disp(k) = send_disp(k - 1) + send_count(k - 1) END DO ! Loop over the smat, pack the send buffers send_count(:) = 0 DO j = 1, ncol_local_send ! Use send_col_indices and row_indices here, as we are looking up the global row/column number of local rows. - dest_q_j = MOD(((send_col_indices(j)-1)/ncol_block_dest), dest_num_pe(2)) + dest_q_j = MOD(((send_col_indices(j) - 1)/ncol_block_dest), dest_num_pe(2)) DO i = 1, nrow_local_send - dest_p_i = MOD(((send_row_indices(i)-1)/nrow_block_dest), dest_num_pe(1)) + dest_p_i = MOD(((send_row_indices(i) - 1)/nrow_block_dest), dest_num_pe(1)) mpi_rank = dest_blacs2mpi(dest_p_i, dest_q_j) - send_count(mpi_rank) = send_count(mpi_rank)+1 - send_buf(send_disp(mpi_rank)+send_count(mpi_rank)) = source%local_data(i, j) + send_count(mpi_rank) = send_count(mpi_rank) + 1 + send_buf(send_disp(mpi_rank) + send_count(mpi_rank)) = source%local_data(i, j) END DO END DO info%send_buf => send_buf ! For each non-zero send_count, call mpi_isend - DO k = 0, recv_size-1 + DO k = 0, recv_size - 1 IF (send_count(k) .GT. 0) THEN - CALL mp_isend(send_buf(send_disp(k)+1:send_disp(k)+send_count(k)), & + CALL mp_isend(send_buf(send_disp(k) + 1:send_disp(k) + send_count(k)), & dest2global(k), global_comm, send_request(k)) ELSE send_request(k) = mp_request_null @@ -1771,7 +1771,7 @@ SUBROUTINE cp_fm_finish_copy_general(destination, info) k = 0 DO j = 1, SIZE(destination%local_data, 2) DO i = 1, SIZE(destination%local_data, 1) - k = k+1 + k = k + 1 destination%local_data(i, j) = info%send_buf(k) END DO END DO @@ -1794,17 +1794,17 @@ SUBROUTINE cp_fm_finish_copy_general(destination, info) ! ... use the local variables to do the work ! DEST_2 CALL mp_waitall(recv_request(:)) - ALLOCATE (recv_count(0:send_size-1)) + ALLOCATE (recv_count(0:send_size - 1)) ! Loop over the rmat, filling it in with data from the recv buffers ! (here the block sizes, num_pes refer to the distribution of the source matrix) recv_count(:) = 0 DO j = 1, nlocal_recv(2) - src_q_j = MOD(((recv_col_indices(j)-1)/nblock_src(2)), src_num_pe(2)) + src_q_j = MOD(((recv_col_indices(j) - 1)/nblock_src(2)), src_num_pe(2)) DO i = 1, nlocal_recv(1) - src_p_i = MOD(((recv_row_indices(i)-1)/nblock_src(1)), src_num_pe(1)) + src_p_i = MOD(((recv_row_indices(i) - 1)/nblock_src(1)), src_num_pe(1)) mpi_rank = src_blacs2mpi(src_p_i, src_q_j) - recv_count(mpi_rank) = recv_count(mpi_rank)+1 - destination%local_data(i, j) = recv_buf(recv_disp(mpi_rank)+recv_count(mpi_rank)) + recv_count(mpi_rank) = recv_count(mpi_rank) + 1 + destination%local_data(i, j) = recv_buf(recv_disp(mpi_rank) + recv_count(mpi_rank)) END DO END DO DEALLOCATE (recv_count, recv_disp, recv_request, recv_buf, src_blacs2mpi) @@ -2031,12 +2031,12 @@ SUBROUTINE cp_fm_add_to_element(matrix, irow_global, icol_global, alpha) irow_local, icol_local, iprow, ipcol) IF ((iprow == myprow) .AND. (ipcol == mypcol)) THEN - a(irow_local, icol_local) = a(irow_local, icol_local)+alpha + a(irow_local, icol_local) = a(irow_local, icol_local) + alpha END IF #else - a(irow_global, icol_global) = a(irow_global, icol_global)+alpha + a(irow_global, icol_global) = a(irow_global, icol_global) + alpha #endif @@ -2097,12 +2097,12 @@ SUBROUTINE cp_fm_write_unformatted(fm, unit) vecbuf = HUGE(1.0_dp) ! init for valgrind DO i = 1, ncol_global, MAX(max_block, 1) - i_block = MIN(max_block, ncol_global-i+1) + i_block = MIN(max_block, ncol_global - i + 1) CALL infog2l(1, i, desc, nprow, npcol, myprow, mypcol, & irow_local, icol_local, iprow, ipcol) IF (ipcol == mypcol) THEN DO j = 1, i_block - vecbuf((j-1)*nrow_global+1:nrow_global*j) = newdat(:, icol_local+j-1) + vecbuf((j - 1)*nrow_global + 1:nrow_global*j) = newdat(:, icol_local + j - 1) END DO END IF @@ -2119,7 +2119,7 @@ SUBROUTINE cp_fm_write_unformatted(fm, unit) IF (unit > 0) THEN DO j = 1, i_block - WRITE (unit) vecbuf((j-1)*nrow_global+1:nrow_global*j) + WRITE (unit) vecbuf((j - 1)*nrow_global + 1:nrow_global*j) END DO END IF @@ -2218,12 +2218,12 @@ SUBROUTINE cp_fm_write_formatted(fm, unit, header, value_format) icol = 1 DO i = 1, ncol_global, MAX(max_block, 1) - i_block = MIN(max_block, ncol_global-i+1) + i_block = MIN(max_block, ncol_global - i + 1) CALL infog2l(1, i, desc, nprow, npcol, myprow, mypcol, & irow_local, icol_local, iprow, ipcol) IF (ipcol == mypcol) THEN DO j = 1, i_block - vecbuf((j-1)*nrow_global+1:nrow_global*j) = newdat(:, icol_local+j-1) + vecbuf((j - 1)*nrow_global + 1:nrow_global*j) = newdat(:, icol_local + j - 1) END DO END IF @@ -2240,12 +2240,12 @@ SUBROUTINE cp_fm_write_formatted(fm, unit, header, value_format) IF (unit > 0) THEN DO j = 1, i_block - DO k = (j-1)*nrow_global+1, nrow_global*j + DO k = (j - 1)*nrow_global + 1, nrow_global*j WRITE (UNIT=unit, FMT=my_value_format) irow, icol, vecbuf(k) - irow = irow+1 + irow = irow + 1 IF (irow > nrow_global) THEN irow = 1 - icol = icol+1 + icol = icol + 1 END IF END DO END DO @@ -2306,7 +2306,7 @@ SUBROUTINE cp_fm_read_unformatted(fm, unit) DO j = 1, ncol_global, max_block - n_cols = MIN(max_block, ncol_global-j+1) + n_cols = MIN(max_block, ncol_global - j + 1) IF (para_env%mepos == 0) THEN DO k = 1, n_cols READ (unit) vecbuf(:, k) diff --git a/src/force_env_methods.F b/src/force_env_methods.F index 157ea3877d..1498ec42a1 100644 --- a/src/force_env_methods.F +++ b/src/force_env_methods.F @@ -362,7 +362,7 @@ RECURSIVE SUBROUTINE force_env_calc_energy_force(force_env, calc_force, & IF (ASSOCIATED(core_particles)) THEN CALL write_forces(core_particles, print_forces, "CORE", ndigits, total_force, & zero_force_core_shell_atom=.FALSE.) - grand_total_force(:) = grand_total_force(:)+total_force(:) + grand_total_force(:) = grand_total_force(:) + total_force(:) END IF IF (ASSOCIATED(shell_particles)) THEN CALL write_forces(shell_particles, print_forces, "SHELL", ndigits, total_force, & @@ -419,7 +419,7 @@ RECURSIVE SUBROUTINE force_env_calc_energy_force(force_env, calc_force, & (i, atprop_env%atener(i), i=1, SIZE(atprop_env%atener)) END IF sum_energy = accurate_sum(atprop_env%atener(:)) - checksum = ABS(e_pot-sum_energy) + checksum = ABS(e_pot - sum_energy) WRITE (UNIT=output_unit, FMT="(/,(T2,A,T56,F25.13))") & "Potential energy (Atomic):", sum_energy, & "Potential energy (Total) :", e_pot, & @@ -449,7 +449,7 @@ RECURSIVE SUBROUTINE force_env_calc_energy_force(force_env, calc_force, & ! symmetrize (same as pv_virial) DO i = 1, SIZE(atprop_env%atstress, 3) atprop_env%atstress(:, :, i) = 0.5_dp*(atprop_env%atstress(:, :, i) & - +TRANSPOSE(atprop_env%atstress(:, :, i))) + + TRANSPOSE(atprop_env%atstress(:, :, i))) END DO IF (output_unit > 0) THEN IF (logger%iter_info%print_level > low_print_level) THEN @@ -459,13 +459,13 @@ RECURSIVE SUBROUTINE force_env_calc_energy_force(force_env, calc_force, & WRITE (UNIT=output_unit, FMT="(A3,3F20.13)") "Y", (atprop_env%atstress(2, j, i), j=1, 3) WRITE (UNIT=output_unit, FMT="(A3,3F20.13)") "Z", (atprop_env%atstress(3, j, i), j=1, 3) WRITE (UNIT=output_unit, FMT="(T2,A,F20.13)") "1/3 Trace(Atomic stress tensor):", & - (atprop_env%atstress(1, 1, i)+atprop_env%atstress(2, 2, i)+atprop_env%atstress(3, 3, i))/3.0_dp + (atprop_env%atstress(1, 1, i) + atprop_env%atstress(2, 2, i) + atprop_env%atstress(3, 3, i))/3.0_dp END DO END IF atomic_stress_tensor(:, :) = 0.0_dp DO i = 1, 3 atomic_stress_tensor(i, i) = accurate_sum(atprop_env%atstress(i, i, :)) - DO j = i+1, 3 + DO j = i + 1, 3 atomic_stress_tensor(i, j) = accurate_sum(atprop_env%atstress(i, j, :)) atomic_stress_tensor(j, i) = atomic_stress_tensor(i, j) END DO @@ -475,7 +475,7 @@ RECURSIVE SUBROUTINE force_env_calc_energy_force(force_env, calc_force, & WRITE (UNIT=output_unit, FMT="(A3,3F20.13)") "Y", (atomic_stress_tensor(2, i), i=1, 3) WRITE (UNIT=output_unit, FMT="(A3,3F20.13)") "Z", (atomic_stress_tensor(3, i), i=1, 3) WRITE (UNIT=output_unit, FMT="(T2,A,10X,F20.13)") "1/3 Trace(Atomic stress tensor):", & - (atomic_stress_tensor(1, 1)+atomic_stress_tensor(2, 2)+atomic_stress_tensor(3, 3))/3.0_dp + (atomic_stress_tensor(1, 1) + atomic_stress_tensor(2, 2) + atomic_stress_tensor(3, 3))/3.0_dp sum_stress_tensor = accurate_sum(atomic_stress_tensor(:, :)) IF (virial%pv_availability .AND. calculate_forces) THEN WRITE (UNIT=output_unit, FMT="(/,T2,A,T16,A1,2(19X,A1))") "Total", "X", "Y", "Z" @@ -483,15 +483,15 @@ RECURSIVE SUBROUTINE force_env_calc_energy_force(force_env, calc_force, & WRITE (UNIT=output_unit, FMT="(A3,3F20.13)") "Y", (virial%pv_virial(2, i), i=1, 3) WRITE (UNIT=output_unit, FMT="(A3,3F20.13)") "Z", (virial%pv_virial(3, i), i=1, 3) WRITE (UNIT=output_unit, FMT="(T2,A,10X,F20.13)") "1/3 Trace(Total stress tensor): ", & - (virial%pv_virial(1, 1)+virial%pv_virial(2, 2)+virial%pv_virial(3, 3))/3.0_dp + (virial%pv_virial(1, 1) + virial%pv_virial(2, 2) + virial%pv_virial(3, 3))/3.0_dp sum_pv_virial = SUM(virial%pv_virial(:, :)) - diff_stress_tensor(:, :) = ABS(virial%pv_virial(:, :)-atomic_stress_tensor(:, :)) + diff_stress_tensor(:, :) = ABS(virial%pv_virial(:, :) - atomic_stress_tensor(:, :)) WRITE (UNIT=output_unit, FMT="(/,T2,A,T16,A1,2(19X,A1))") "Diff", "X", "Y", "Z" WRITE (UNIT=output_unit, FMT="(A3,3F20.13)") "X", (diff_stress_tensor(1, i), i=1, 3) WRITE (UNIT=output_unit, FMT="(A3,3F20.13)") "Y", (diff_stress_tensor(2, i), i=1, 3) WRITE (UNIT=output_unit, FMT="(A3,3F20.13)") "Z", (diff_stress_tensor(3, i), i=1, 3) WRITE (UNIT=output_unit, FMT="(T2,A,10X,F20.13)") "1/3 Trace(Diff) : ", & - (diff_stress_tensor(1, 1)+diff_stress_tensor(2, 2)+diff_stress_tensor(3, 3))/3.0_dp + (diff_stress_tensor(1, 1) + diff_stress_tensor(2, 2) + diff_stress_tensor(3, 3))/3.0_dp checksum = accurate_sum(diff_stress_tensor(:, :)) WRITE (UNIT=output_unit, FMT="(/,(T2,A,11X,F25.13))") & "Checksum stress (Atomic) :", sum_stress_tensor, & @@ -597,7 +597,7 @@ SUBROUTINE force_env_calc_num_pressure(force_env, dx) DO iq = 1, 3 IF (virial%pv_diagonal .AND. (ip /= iq)) CYCLE DO k = 1, 2 - cell%hmat(ip, iq) = cell_local%hmat(ip, iq)-(-1.0_dp)**k*dx_w + cell%hmat(ip, iq) = cell_local%hmat(ip, iq) - (-1.0_dp)**k*dx_w CALL init_cell(cell) ! Scale positions DO i = 1, natom @@ -623,11 +623,11 @@ SUBROUTINE force_env_calc_num_pressure(force_env, dx) cell%hmat(ip, iq) = cell_local%hmat(ip, iq) END DO CALL init_cell(cell) - numer_stress(ip, iq) = 0.5_dp*(numer_energy(1)-numer_energy(2))/dx_w + numer_stress(ip, iq) = 0.5_dp*(numer_energy(1) - numer_energy(2))/dx_w IF (output_unit > 0) THEN WRITE (UNIT=output_unit, FMT="(T7,A,F7.4,A,T27,A,F7.4,A,T49,A)") & - "E("//ACHAR(119+ip)//ACHAR(119+iq)//" +", dx_w, ")", & - "E("//ACHAR(119+ip)//ACHAR(119+iq)//" -", dx_w, ")", & + "E("//ACHAR(119 + ip)//ACHAR(119 + iq)//" +", dx_w, ")", & + "E("//ACHAR(119 + ip)//ACHAR(119 + iq)//" -", dx_w, ")", & "f(numerical)" WRITE (UNIT=output_unit, FMT="(3(1X,F19.8))") & numer_energy(1:2), numer_stress(ip, iq) @@ -655,8 +655,8 @@ SUBROUTINE force_env_calc_num_pressure(force_env, dx) DO i = 1, 3 DO j = 1, 3 DO k = 1, 3 - virial%pv_virial(i, j) = virial%pv_virial(i, j)- & - 0.5_dp*(numer_stress(i, k)*cell_local%hmat(j, k)+ & + virial%pv_virial(i, j) = virial%pv_virial(i, j) - & + 0.5_dp*(numer_stress(i, k)*cell_local%hmat(j, k) + & numer_stress(j, k)*cell_local%hmat(i, k)) END DO END DO @@ -742,7 +742,7 @@ SUBROUTINE force_env_create(force_env, root_section, para_env, globenv, fist_env force_env%qmmm_env, force_env%qmmmx_env, force_env%fp_env, & force_env%force_env_section, force_env%eip_env, force_env%mixed_env, & force_env%embed_env, force_env%pwdft_env, force_env%root_section) - last_force_env_id = last_force_env_id+1 + last_force_env_id = last_force_env_id + 1 force_env%id_nr = last_force_env_id force_env%ref_count = 1 force_env%in_use = 0 @@ -925,7 +925,7 @@ SUBROUTINE mixed_energy_forces(force_env, calculate_forces) IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) CYCLE ! From this point on the error is the sub_error my_group = force_env%mixed_env%group_distribution(force_env%para_env%mepos) - my_logger => force_env%mixed_env%sub_logger(my_group+1)%p + my_logger => force_env%mixed_env%sub_logger(my_group + 1)%p ! Copy iterations info (they are updated only in the main mixed_env) CALL cp_iteration_info_copy_iter(logger%iter_info, my_logger%iter_info) CALL cp_add_default_logger(my_logger) @@ -1034,12 +1034,12 @@ SUBROUTINE mixed_energy_forces(force_env, calculate_forces) ! Support offered only 2 force_eval CPASSERT(nforce_eval == 2) CALL section_vals_val_get(mixed_section, "LINEAR%LAMBDA", r_val=lambda) - mixed_energy%pot = lambda*energies(1)+(1.0_dp-lambda)*energies(2) + mixed_energy%pot = lambda*energies(1) + (1.0_dp - lambda)*energies(2) ! General Mapping of forces... CALL mixed_map_forces(particles_mix, virial_mix, results_mix, global_forces, virials, results, & lambda, 1, nforce_eval, map_index, mapping_section, .TRUE.) CALL mixed_map_forces(particles_mix, virial_mix, results_mix, global_forces, virials, results, & - (1.0_dp-lambda), 2, nforce_eval, map_index, mapping_section, .FALSE.) + (1.0_dp - lambda), 2, nforce_eval, map_index, mapping_section, .FALSE.) CASE (mix_minimum) ! Support offered only 2 force_eval CPASSERT(nforce_eval == 2) @@ -1057,10 +1057,10 @@ SUBROUTINE mixed_energy_forces(force_env, calculate_forces) CPASSERT(nforce_eval == 2) CALL section_vals_val_get(mixed_section, "COUPLING%COUPLING_PARAMETER", & r_val=coupling_parameter) - sd = SQRT((energies(1)-energies(2))**2+4.0_dp*coupling_parameter**2) - der_1 = (1.0_dp-(1.0_dp/(2.0_dp*sd))*2.0_dp*(energies(1)-energies(2)))/2.0_dp - der_2 = (1.0_dp+(1.0_dp/(2.0_dp*sd))*2.0_dp*(energies(1)-energies(2)))/2.0_dp - mixed_energy%pot = (energies(1)+energies(2)-sd)/2.0_dp + sd = SQRT((energies(1) - energies(2))**2 + 4.0_dp*coupling_parameter**2) + der_1 = (1.0_dp - (1.0_dp/(2.0_dp*sd))*2.0_dp*(energies(1) - energies(2)))/2.0_dp + der_2 = (1.0_dp + (1.0_dp/(2.0_dp*sd))*2.0_dp*(energies(1) - energies(2)))/2.0_dp + mixed_energy%pot = (energies(1) + energies(2) - sd)/2.0_dp ! General Mapping of forces... CALL mixed_map_forces(particles_mix, virial_mix, results_mix, global_forces, virials, results, & der_1, 1, nforce_eval, map_index, mapping_section, .TRUE.) @@ -1073,9 +1073,9 @@ SUBROUTINE mixed_energy_forces(force_env, calculate_forces) r_val=restraint_target) CALL section_vals_val_get(mixed_section, "RESTRAINT%RESTRAINT_STRENGTH", & r_val=restraint_strength) - mixed_energy%pot = energies(1)+restraint_strength*(energies(1)-energies(2)-restraint_target)**2 - der_2 = -2.0_dp*restraint_strength*(energies(1)-energies(2)-restraint_target) - der_1 = 1.0_dp-der_2 + mixed_energy%pot = energies(1) + restraint_strength*(energies(1) - energies(2) - restraint_target)**2 + der_2 = -2.0_dp*restraint_strength*(energies(1) - energies(2) - restraint_target) + der_1 = 1.0_dp - der_2 ! General Mapping of forces... CALL mixed_map_forces(particles_mix, virial_mix, results_mix, global_forces, virials, results, & der_1, 1, nforce_eval, map_index, mapping_section, .TRUE.) @@ -1130,12 +1130,12 @@ SUBROUTINE mixed_energy_forces(force_env, calculate_forces) istate = itmplist IF (istate(1) > nforce_eval .OR. istate(2) > nforce_eval) & CPABORT("Invalid force_eval index.") - mixed_energy%pot = lambda*energies(istate(1))+(1.0_dp-lambda)*energies(istate(2)) + mixed_energy%pot = lambda*energies(istate(1)) + (1.0_dp - lambda)*energies(istate(2)) ! General Mapping of forces... CALL mixed_map_forces(particles_mix, virial_mix, results_mix, global_forces, virials, results, & lambda, istate(1), nforce_eval, map_index, mapping_section, .TRUE.) CALL mixed_map_forces(particles_mix, virial_mix, results_mix, global_forces, virials, results, & - (1.0_dp-lambda), istate(2), nforce_eval, map_index, mapping_section, .FALSE.) + (1.0_dp - lambda), istate(2), nforce_eval, map_index, mapping_section, .FALSE.) CASE DEFAULT CPABORT("") END SELECT @@ -1268,10 +1268,10 @@ SUBROUTINE mixed_cdft_energy_forces(force_env, calculate_forces, particles, ener IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) CYCLE ! From this point on the error is the sub_error IF (force_env%mixed_env%cdft_control%run_type == mixed_cdft_serial .AND. iforce_eval .GE. 2) THEN - my_logger => force_env%mixed_env%cdft_control%sub_logger(iforce_eval-1)%p + my_logger => force_env%mixed_env%cdft_control%sub_logger(iforce_eval - 1)%p ELSE my_group = force_env%mixed_env%group_distribution(force_env%para_env%mepos) - my_logger => force_env%mixed_env%sub_logger(my_group+1)%p + my_logger => force_env%mixed_env%sub_logger(my_group + 1)%p END IF ! Copy iterations info (they are updated only in the main mixed_env) CALL cp_iteration_info_copy_iter(logger%iter_info, my_logger%iter_info) @@ -1416,7 +1416,7 @@ SUBROUTINE embed_energy(force_env) IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) CYCLE ! From this point on the error is the sub_error my_group = force_env%embed_env%group_distribution(force_env%para_env%mepos) - my_logger => force_env%embed_env%sub_logger(my_group+1)%p + my_logger => force_env%embed_env%sub_logger(my_group + 1)%p ! Copy iterations info (they are updated only in the main embed_env) CALL cp_iteration_info_copy_iter(logger%iter_info, my_logger%iter_info) CALL cp_add_default_logger(my_logger) @@ -1515,7 +1515,7 @@ SUBROUTINE embed_energy(force_env) END DO ! ONIOM type of mixing in embedding: E = E_total + E_cluster_high - E_cluster - force_env%embed_env%pot_energy = energies(3)+energies(4)-energies(2) + force_env%embed_env%pot_energy = energies(3) + energies(4) - energies(2) !Simply deallocate and loose the pointer references.. DO iforce_eval = 1, nforce_eval @@ -1665,16 +1665,16 @@ SUBROUTINE dfet_embedding(force_env, ref_subsys_number, energies, converged_embe ! Check the preliminary density differences DO i_spin = 1, nspins - diff_rho_r%pw%cr3d(:, :, :) = diff_rho_r%pw%cr3d(:, :, :)-rho_r_ref(i_spin)%pw%cr3d(:, :, :) + diff_rho_r%pw%cr3d(:, :, :) = diff_rho_r%pw%cr3d(:, :, :) - rho_r_ref(i_spin)%pw%cr3d(:, :, :) ENDDO IF (opt_embed%open_shell_embed) THEN ! Spin part IF (nspins .EQ. 2) THEN ! Reference systems has an open shell, else the reference diff_rho_spin is zero - diff_rho_spin%pw%cr3d(:, :, :) = diff_rho_spin%pw%cr3d(:, :, :)-rho_r_ref(1)%pw%cr3d(:, :, :) & - +rho_r_ref(2)%pw%cr3d(:, :, :) + diff_rho_spin%pw%cr3d(:, :, :) = diff_rho_spin%pw%cr3d(:, :, :) - rho_r_ref(1)%pw%cr3d(:, :, :) & + + rho_r_ref(2)%pw%cr3d(:, :, :) ENDIF ENDIF - DO i_force_eval = 1, ref_subsys_number-1 + DO i_force_eval = 1, ref_subsys_number - 1 NULLIFY (subsys_rho, rho_r_subsys, dft_control) CALL get_qs_env(force_env%sub_force_env(i_force_eval)%force_env%qs_env, rho=subsys_rho, energy=energy, & dft_control=dft_control) @@ -1682,18 +1682,18 @@ SUBROUTINE dfet_embedding(force_env, ref_subsys_number, energies, converged_embe ! Add subsystem densities CALL qs_rho_get(rho_struct=subsys_rho, rho_r=rho_r_subsys) DO i_spin = 1, nspins_subsys - diff_rho_r%pw%cr3d(:, :, :) = diff_rho_r%pw%cr3d(:, :, :)+rho_r_subsys(i_spin)%pw%cr3d(:, :, :) + diff_rho_r%pw%cr3d(:, :, :) = diff_rho_r%pw%cr3d(:, :, :) + rho_r_subsys(i_spin)%pw%cr3d(:, :, :) ENDDO IF (opt_embed%open_shell_embed) THEN ! Spin part IF (nspins_subsys .EQ. 2) THEN ! The subsystem makes contribution if it is spin-polarized ! We may need to change spin ONLY FOR THE SECOND SUBSYSTEM: that's the internal convention IF ((i_force_eval .EQ. 2) .AND. (opt_embed%change_spin)) THEN - diff_rho_spin%pw%cr3d(:, :, :) = diff_rho_spin%pw%cr3d(:, :, :)- & - rho_r_subsys(1)%pw%cr3d(:, :, :)+rho_r_subsys(2)%pw%cr3d(:, :, :) + diff_rho_spin%pw%cr3d(:, :, :) = diff_rho_spin%pw%cr3d(:, :, :) - & + rho_r_subsys(1)%pw%cr3d(:, :, :) + rho_r_subsys(2)%pw%cr3d(:, :, :) ELSE ! First subsystem (always) and second subsystem (without spin change) - diff_rho_spin%pw%cr3d(:, :, :) = diff_rho_spin%pw%cr3d(:, :, :)+ & - rho_r_subsys(1)%pw%cr3d(:, :, :)-rho_r_subsys(2)%pw%cr3d(:, :, :) + diff_rho_spin%pw%cr3d(:, :, :) = diff_rho_spin%pw%cr3d(:, :, :) + & + rho_r_subsys(1)%pw%cr3d(:, :, :) - rho_r_subsys(2)%pw%cr3d(:, :, :) ENDIF ENDIF ENDIF @@ -1717,7 +1717,7 @@ SUBROUTINE dfet_embedding(force_env, ref_subsys_number, energies, converged_embe embed_section => section_vals_get_subs_vals(force_env_section, "EMBED") mapping_section => section_vals_get_subs_vals(embed_section, "MAPPING") - DO i_force_eval = 1, ref_subsys_number-1 + DO i_force_eval = 1, ref_subsys_number - 1 IF (i_force_eval .EQ. 1) THEN CALL Coulomb_guess(embed_pot, rhs, mapping_section, & force_env%sub_force_env(i_force_eval)%force_env%qs_env, nforce_eval, i_force_eval, opt_embed%eta) @@ -1726,7 +1726,7 @@ SUBROUTINE dfet_embedding(force_env, ref_subsys_number, energies, converged_embe force_env%sub_force_env(i_force_eval)%force_env%qs_env, nforce_eval, i_force_eval, opt_embed%eta) ENDIF ENDDO - embed_pot%pw%cr3d(:, :, :) = embed_pot%pw%cr3d(:, :, :)+opt_embed%pot_diff%pw%cr3d(:, :, :) + embed_pot%pw%cr3d(:, :, :) = embed_pot%pw%cr3d(:, :, :) + opt_embed%pot_diff%pw%cr3d(:, :, :) IF (.NOT. opt_embed%grid_opt) CALL pw_copy(embed_pot%pw, opt_embed%const_pot%pw) ENDIF @@ -1748,17 +1748,17 @@ SUBROUTINE dfet_embedding(force_env, ref_subsys_number, energies, converged_embe CALL get_qs_env(force_env%sub_force_env(ref_subsys_number)%force_env%qs_env, dft_control=dft_control) nspins = dft_control%nspins DO i_spin = 1, nspins - diff_rho_r%pw%cr3d(:, :, :) = diff_rho_r%pw%cr3d(:, :, :)-rho_r_ref(i_spin)%pw%cr3d(:, :, :) + diff_rho_r%pw%cr3d(:, :, :) = diff_rho_r%pw%cr3d(:, :, :) - rho_r_ref(i_spin)%pw%cr3d(:, :, :) ENDDO IF (opt_embed%open_shell_embed) THEN ! Spin part CALL pw_zero(diff_rho_spin%pw) IF (nspins .EQ. 2) THEN ! Reference systems has an open shell, else the reference diff_rho_spin is zero - diff_rho_spin%pw%cr3d(:, :, :) = diff_rho_spin%pw%cr3d(:, :, :)-rho_r_ref(1)%pw%cr3d(:, :, :) & - +rho_r_ref(2)%pw%cr3d(:, :, :) + diff_rho_spin%pw%cr3d(:, :, :) = diff_rho_spin%pw%cr3d(:, :, :) - rho_r_ref(1)%pw%cr3d(:, :, :) & + + rho_r_ref(2)%pw%cr3d(:, :, :) ENDIF ENDIF - DO i_force_eval = 1, ref_subsys_number-1 + DO i_force_eval = 1, ref_subsys_number - 1 NULLIFY (dft_control) CALL get_qs_env(force_env%sub_force_env(i_force_eval)%force_env%qs_env, dft_control=dft_control) nspins_subsys = dft_control%nspins @@ -1805,7 +1805,7 @@ SUBROUTINE dfet_embedding(force_env, ref_subsys_number, energies, converged_embe CALL get_qs_env(force_env%sub_force_env(i_force_eval)%force_env%qs_env, rho=subsys_rho, & energy=energy) - opt_embed%w_func(i_iter) = opt_embed%w_func(i_iter)+energy%total + opt_embed%w_func(i_iter) = opt_embed%w_func(i_iter) + energy%total ! Find out which subsystem is the cluster IF (dft_control%qs_control%cluster_embed_subsys) THEN @@ -1816,18 +1816,18 @@ SUBROUTINE dfet_embedding(force_env, ref_subsys_number, energies, converged_embe ! Add subsystem densities CALL qs_rho_get(rho_struct=subsys_rho, rho_r=rho_r_subsys) DO i_spin = 1, nspins_subsys - diff_rho_r%pw%cr3d(:, :, :) = diff_rho_r%pw%cr3d(:, :, :)+rho_r_subsys(i_spin)%pw%cr3d(:, :, :) + diff_rho_r%pw%cr3d(:, :, :) = diff_rho_r%pw%cr3d(:, :, :) + rho_r_subsys(i_spin)%pw%cr3d(:, :, :) ENDDO IF (opt_embed%open_shell_embed) THEN ! Spin part IF (nspins_subsys .EQ. 2) THEN ! The subsystem makes contribution if it is spin-polarized ! We may need to change spin ONLY FOR THE SECOND SUBSYSTEM: that's the internal convention IF ((i_force_eval .EQ. 2) .AND. (opt_embed%change_spin)) THEN - diff_rho_spin%pw%cr3d(:, :, :) = diff_rho_spin%pw%cr3d(:, :, :)- & - rho_r_subsys(1)%pw%cr3d(:, :, :)+rho_r_subsys(2)%pw%cr3d(:, :, :) + diff_rho_spin%pw%cr3d(:, :, :) = diff_rho_spin%pw%cr3d(:, :, :) - & + rho_r_subsys(1)%pw%cr3d(:, :, :) + rho_r_subsys(2)%pw%cr3d(:, :, :) ELSE ! First subsystem (always) and second subsystem (without spin change) - diff_rho_spin%pw%cr3d(:, :, :) = diff_rho_spin%pw%cr3d(:, :, :)+ & - rho_r_subsys(1)%pw%cr3d(:, :, :)-rho_r_subsys(2)%pw%cr3d(:, :, :) + diff_rho_spin%pw%cr3d(:, :, :) = diff_rho_spin%pw%cr3d(:, :, :) + & + rho_r_subsys(1)%pw%cr3d(:, :, :) - rho_r_subsys(2)%pw%cr3d(:, :, :) ENDIF ENDIF ENDIF @@ -1852,19 +1852,19 @@ SUBROUTINE dfet_embedding(force_env, ref_subsys_number, energies, converged_embe ! Integrate the potential over density differences and add to w functional; also add regularization contribution DO i_spin = 1, nspins ! Sum over nspins for the reference system, not subsystem! - opt_embed%w_func(i_iter) = opt_embed%w_func(i_iter)-pw_integral_ab(embed_pot%pw, rho_r_ref(i_spin)%pw) + opt_embed%w_func(i_iter) = opt_embed%w_func(i_iter) - pw_integral_ab(embed_pot%pw, rho_r_ref(i_spin)%pw) ENDDO ! Spin part IF (opt_embed%open_shell_embed) THEN ! If reference system is not spin-polarized then it does not make a contribution to W functional IF (nspins .EQ. 2) THEN opt_embed%w_func(i_iter) = opt_embed%w_func(i_iter) & - -pw_integral_ab(spin_embed_pot%pw, rho_r_ref(1)%pw) & - +pw_integral_ab(spin_embed_pot%pw, rho_r_ref(2)%pw) + - pw_integral_ab(spin_embed_pot%pw, rho_r_ref(1)%pw) & + + pw_integral_ab(spin_embed_pot%pw, rho_r_ref(2)%pw) ENDIF ENDIF ! Finally, add the regularization term - opt_embed%w_func(i_iter) = opt_embed%w_func(i_iter)+opt_embed%reg_term + opt_embed%w_func(i_iter) = opt_embed%w_func(i_iter) + opt_embed%reg_term ! Print information and check convergence CALL print_emb_opt_info(output_unit, i_iter, opt_embed) @@ -1918,23 +1918,23 @@ SUBROUTINE dfet_embedding(force_env, ref_subsys_number, energies, converged_embe ! If converged send the embedding potential to the higher-level calculation. IF (opt_embed%converged) THEN - CALL get_qs_env(force_env%sub_force_env(ref_subsys_number+1)%force_env%qs_env, dft_control=dft_control, & + CALL get_qs_env(force_env%sub_force_env(ref_subsys_number + 1)%force_env%qs_env, dft_control=dft_control, & pw_env=pw_env) nspins_subsys = dft_control%nspins dft_control%apply_embed_pot = .TRUE. ! The embedded subsystem corresponds to subsystem #2, where spin change is possible - CALL make_subsys_embed_pot(force_env%sub_force_env(ref_subsys_number+1)%force_env%qs_env, & + CALL make_subsys_embed_pot(force_env%sub_force_env(ref_subsys_number + 1)%force_env%qs_env, & embed_pot, embed_pot_subsys, spin_embed_pot, spin_embed_pot_subsys, & opt_embed%open_shell_embed, opt_embed%change_spin) IF (opt_embed%Coulomb_guess) THEN - embed_pot_subsys%pw%cr3d(:, :, :) = embed_pot_subsys%pw%cr3d(:, :, :)-opt_embed%pot_diff%pw%cr3d(:, :, :) + embed_pot_subsys%pw%cr3d(:, :, :) = embed_pot_subsys%pw%cr3d(:, :, :) - opt_embed%pot_diff%pw%cr3d(:, :, :) ENDIF - CALL set_qs_env(force_env%sub_force_env(ref_subsys_number+1)%force_env%qs_env, embed_pot=embed_pot_subsys) + CALL set_qs_env(force_env%sub_force_env(ref_subsys_number + 1)%force_env%qs_env, embed_pot=embed_pot_subsys) IF ((opt_embed%open_shell_embed) .AND. (nspins_subsys .EQ. 2)) THEN - CALL set_qs_env(force_env%sub_force_env(ref_subsys_number+1)%force_env%qs_env, & + CALL set_qs_env(force_env%sub_force_env(ref_subsys_number + 1)%force_env%qs_env, & spin_embed_pot=spin_embed_pot_subsys) ENDIF @@ -2028,7 +2028,7 @@ SUBROUTINE dmfet_embedding(force_env, ref_subsys_number, energies, converged_emb IF (opt_dmfet%open_shell_embed) CALL cp_fm_copy_general(opt_dmfet%dm_total_beta, & opt_dmfet%dm_diff_beta, para_env) - DO i_force_eval = 1, ref_subsys_number-1 + DO i_force_eval = 1, ref_subsys_number - 1 ! Get the subsystem density matrix/matrices subsys_open_shell = subsys_spin(force_env%sub_force_env(i_force_eval)%force_env%qs_env) @@ -2056,7 +2056,7 @@ SUBROUTINE dmfet_embedding(force_env, ref_subsys_number, energies, converged_emb opt_dmfet%dm_diff_beta, para_env) ! Loop over force evaluations - DO i_force_eval = 1, ref_subsys_number-1 + DO i_force_eval = 1, ref_subsys_number - 1 ! Switch on external potential in the subsystems NULLIFY (dft_control) @@ -2072,7 +2072,7 @@ SUBROUTINE dmfet_embedding(force_env, ref_subsys_number, energies, converged_emb NULLIFY (energy) CALL get_qs_env(force_env%sub_force_env(i_force_eval)%force_env%qs_env, energy=energy) - opt_dmfet%w_func(i_iter) = opt_dmfet%w_func(i_iter)+energy%total + opt_dmfet%w_func(i_iter) = opt_dmfet%w_func(i_iter) + energy%total ! Find out which subsystem is the cluster IF (dft_control%qs_control%cluster_embed_subsys) THEN diff --git a/src/force_env_types.F b/src/force_env_types.F index da3a70edc3..64571e61b5 100644 --- a/src/force_env_types.F +++ b/src/force_env_types.F @@ -182,7 +182,7 @@ SUBROUTINE force_env_retain(force_env) CPASSERT(ASSOCIATED(force_env)) CPASSERT(force_env%ref_count > 0) - force_env%ref_count = force_env%ref_count+1 + force_env%ref_count = force_env%ref_count + 1 END SUBROUTINE force_env_retain ! ************************************************************************************************** @@ -205,7 +205,7 @@ RECURSIVE SUBROUTINE force_env_release(force_env) IF (ASSOCIATED(force_env)) THEN CPASSERT(force_env%ref_count > 0) - force_env%ref_count = force_env%ref_count-1 + force_env%ref_count = force_env%ref_count - 1 IF (force_env%ref_count == 0) THEN ! Deallocate SUB_FORCE_ENV IF (ASSOCIATED(force_env%sub_force_env)) THEN @@ -214,13 +214,13 @@ RECURSIVE SUBROUTINE force_env_release(force_env) ! Use the proper logger to deallocate.. IF (force_env%in_use == use_mixed_force) THEN my_group = force_env%mixed_env%group_distribution(force_env%para_env%mepos) - my_logger => force_env%mixed_env%sub_logger(my_group+1)%p + my_logger => force_env%mixed_env%sub_logger(my_group + 1)%p CALL cp_add_default_logger(my_logger) END IF ! The same for embedding IF (force_env%in_use == use_embed) THEN my_group = force_env%embed_env%group_distribution(force_env%para_env%mepos) - my_logger => force_env%embed_env%sub_logger(my_group+1)%p + my_logger => force_env%embed_env%sub_logger(my_group + 1)%p CALL cp_add_default_logger(my_logger) END IF CALL force_env_release(force_env%sub_force_env(i)%force_env) @@ -434,23 +434,23 @@ RECURSIVE SUBROUTINE force_env_get(force_env, in_use, fist_env, qs_env, & ! adjust the total energy for the metadynamics IF (ASSOCIATED(force_env%meta_env)) THEN IF (PRESENT(potential_energy)) THEN - potential_energy = potential_energy+ & - force_env%meta_env%epot_s+ & - force_env%meta_env%epot_walls+ & + potential_energy = potential_energy + & + force_env%meta_env%epot_s + & + force_env%meta_env%epot_walls + & force_env%meta_env%hills_env%energy END IF IF (PRESENT(kinetic_energy)) THEN - kinetic_energy = kinetic_energy+force_env%meta_env%ekin_s + kinetic_energy = kinetic_energy + force_env%meta_env%ekin_s END IF END IF ! adjust the total energy for the flexible partitioning IF (ASSOCIATED(force_env%fp_env) .AND. PRESENT(potential_energy)) THEN IF (force_env%fp_env%use_fp) THEN - potential_energy = potential_energy+force_env%fp_env%energy + potential_energy = potential_energy + force_env%fp_env%energy ENDIF ENDIF IF (PRESENT(potential_energy)) THEN - potential_energy = potential_energy+force_env%additional_potential + potential_energy = potential_energy + force_env%additional_potential END IF IF (PRESENT(additional_potential)) THEN additional_potential = force_env%additional_potential @@ -691,7 +691,7 @@ SUBROUTINE multiple_fe_list(force_env_sections, root_section, i_force_eval, nfor i_force_eval = my_i_force_eval ELSE ! The difference in the amount of defined force_env MUST be one.. - CPASSERT(nforce_eval-SIZE(my_i_force_eval) == 1) + CPASSERT(nforce_eval - SIZE(my_i_force_eval) == 1) DO iforce_eval = 1, nforce_eval IF (ANY(my_i_force_eval == iforce_eval)) CYCLE main_force_eval = iforce_eval diff --git a/src/force_env_utils.F b/src/force_env_utils.F index bd8be62e8c..1135f108ea 100644 --- a/src/force_env_utils.F +++ b/src/force_env_utils.F @@ -435,12 +435,12 @@ SUBROUTINE write_stress_tensor(pv_virial, output_unit, cell, ndigits, numerical) stress_tensor(:, :) = pv_virial(:, :)/cell%deth*pascal*1.0E-9_dp n = MIN(MAX(1, ndigits), 20) fmtstr1 = "(/,T2,A,/,/,T13,A1,2( X,A1))" - WRITE (UNIT=fmtstr1(22:23), FMT="(I2)") n+7 + WRITE (UNIT=fmtstr1(22:23), FMT="(I2)") n + 7 fmtstr2 = "(T3,A,T5,3(1X,F . ))" - WRITE (UNIT=fmtstr2(16:17), FMT="(I2)") n+7 + WRITE (UNIT=fmtstr2(16:17), FMT="(I2)") n + 7 WRITE (UNIT=fmtstr2(19:20), FMT="(I2)") n fmtstr3 = "(/,T3,A,F . )" - WRITE (UNIT=fmtstr3(10:11), FMT="(I2)") n+8 + WRITE (UNIT=fmtstr3(10:11), FMT="(I2)") n + 8 WRITE (UNIT=fmtstr3(13:14), FMT="(I2)") n IF (numerical) THEN WRITE (UNIT=output_unit, FMT=fmtstr1) & @@ -453,11 +453,11 @@ SUBROUTINE write_stress_tensor(pv_virial, output_unit, cell, ndigits, numerical) WRITE (UNIT=output_unit, FMT=fmtstr2) "Y", stress_tensor(2, 1:3) WRITE (UNIT=output_unit, FMT=fmtstr2) "Z", stress_tensor(3, 1:3) fmtstr4 = "(/,T3,A,ES . )" - WRITE (UNIT=fmtstr4(11:12), FMT="(I2)") n+8 + WRITE (UNIT=fmtstr4(11:12), FMT="(I2)") n + 8 WRITE (UNIT=fmtstr4(14:15), FMT="(I2)") n WRITE (UNIT=output_unit, FMT=fmtstr4) & - "1/3 Trace(stress tensor): ", (stress_tensor(1, 1)+ & - stress_tensor(2, 2)+ & + "1/3 Trace(stress tensor): ", (stress_tensor(1, 1) + & + stress_tensor(2, 2) + & stress_tensor(3, 3))/3.0_dp, & "Det(stress tensor) : ", det_3x3(stress_tensor(:, 1), & stress_tensor(:, 2), & @@ -466,7 +466,7 @@ SUBROUTINE write_stress_tensor(pv_virial, output_unit, cell, ndigits, numerical) eigvec(:, :) = 0.0_dp CALL jacobi(stress_tensor, eigval, eigvec) fmtstr5 = "(/,/,T2,A,/,/,T5,3F . ,/)" - WRITE (UNIT=fmtstr5(20:21), FMT="(I2)") n+8 + WRITE (UNIT=fmtstr5(20:21), FMT="(I2)") n + 8 WRITE (UNIT=fmtstr5(23:24), FMT="(I2)") n WRITE (UNIT=output_unit, FMT=fmtstr5) & "EIGENVECTORS AND EIGENVALUES OF THE STRESS TENSOR", & @@ -515,13 +515,13 @@ SUBROUTINE write_forces(particles, output_unit, label, ndigits, total_force, & CPASSERT(ASSOCIATED(particles)) n = MIN(MAX(1, ndigits), 20) fmtstr1 = "(/,T2,A,/,/,T2,A,T11,A,T18,A,T35,A1,2( X,A1))" - WRITE (UNIT=fmtstr1(39:40), FMT="(I2)") n+6 + WRITE (UNIT=fmtstr1(39:40), FMT="(I2)") n + 6 fmtstr2 = "(T2,I6,1X,I6,T21,A,T28,3(1X,F . ))" WRITE (UNIT=fmtstr2(33:34), FMT="(I2)") n - WRITE (UNIT=fmtstr2(30:31), FMT="(I2)") n+6 + WRITE (UNIT=fmtstr2(30:31), FMT="(I2)") n + 6 fmtstr3 = "(T2,A,T28,4(1X,F . ))" WRITE (UNIT=fmtstr3(20:21), FMT="(I2)") n - WRITE (UNIT=fmtstr3(17:18), FMT="(I2)") n+6 + WRITE (UNIT=fmtstr3(17:18), FMT="(I2)") n + 6 IF (PRESENT(zero_force_core_shell_atom)) THEN zero_force = zero_force_core_shell_atom ELSE @@ -544,14 +544,14 @@ SUBROUTINE write_forces(particles, output_unit, label, ndigits, total_force, & END IF WRITE (UNIT=output_unit, FMT=fmtstr2) & i, ikind, particles%els(iparticle)%atomic_kind%element_symbol, f(1:3) - total_force(1:3) = total_force(1:3)+f(1:3) + total_force(1:3) = total_force(1:3) + f(1:3) END DO WRITE (UNIT=output_unit, FMT=fmtstr3) & "SUM OF "//label//" FORCES", total_force(1:3), SQRT(SUM(total_force(:)**2)) END IF IF (PRESENT(grand_total_force)) THEN - grand_total_force(1:3) = grand_total_force(1:3)+total_force(1:3) + grand_total_force(1:3) = grand_total_force(1:3) + total_force(1:3) WRITE (UNIT=output_unit, FMT="(A)") "" WRITE (UNIT=output_unit, FMT=fmtstr3) & "GRAND TOTAL FORCE", grand_total_force(1:3), SQRT(SUM(grand_total_force(:)**2)) diff --git a/src/force_fields.F b/src/force_fields.F index 9ced4ace48..6165b2a1b8 100644 --- a/src/force_fields.F +++ b/src/force_fields.F @@ -53,12 +53,12 @@ MODULE force_fields USE qmmm_types_low, ONLY: qmmm_env_mm_type #include "./base/base_uses.f90" - IMPLICIT NONE + IMPLICIT NONE CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'force_fields' - PRIVATE - PUBLIC :: force_field_control + PRIVATE + PUBLIC :: force_field_control CONTAINS @@ -81,10 +81,10 @@ MODULE force_fields !> \param core_particle_set ... !> \param cell ... ! ************************************************************************************************** - SUBROUTINE force_field_control(atomic_kind_set, particle_set, & - molecule_kind_set, molecule_set, ewald_env, fist_nonbond_env, & - root_section, para_env, qmmm, qmmm_env, subsys_section, mm_section, & - shell_particle_set, core_particle_set, cell) + SUBROUTINE force_field_control(atomic_kind_set, particle_set, & + molecule_kind_set, molecule_set, ewald_env, fist_nonbond_env, & + root_section, para_env, qmmm, qmmm_env, subsys_section, mm_section, & + shell_particle_set, core_particle_set, cell) TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set TYPE(particle_type), DIMENSION(:), POINTER :: particle_set @@ -109,97 +109,97 @@ SUBROUTINE force_field_control(atomic_kind_set, particle_set, & TYPE(force_field_type) :: ff_type TYPE(section_vals_type), POINTER :: topology_section - CALL timeset(routineN,handle) - logger => cp_get_default_logger() + CALL timeset(routineN, handle) + logger => cp_get_default_logger() - iw = cp_print_key_unit_nr(logger,mm_section,"PRINT%FF_INFO",& - extension=".mmLog") + iw = cp_print_key_unit_nr(logger, mm_section, "PRINT%FF_INFO", & + extension=".mmLog") - !----------------------------------------------------------------------------- - ! 1. Initialize the ff_type structure type - !----------------------------------------------------------------------------- - CALL init_ff_type(ff_type) + !----------------------------------------------------------------------------- + ! 1. Initialize the ff_type structure type + !----------------------------------------------------------------------------- + CALL init_ff_type(ff_type) - !----------------------------------------------------------------------------- - ! 2. Read in the force field section in the input file if any - !----------------------------------------------------------------------------- - CALL read_force_field_section(ff_type,para_env,mm_section) + !----------------------------------------------------------------------------- + ! 2. Read in the force field section in the input file if any + !----------------------------------------------------------------------------- + CALL read_force_field_section(ff_type, para_env, mm_section) - !----------------------------------------------------------------------------- - ! 2.1 In case exclusion 1-4 was requested, we need to modify the values of - ! the scale factors setting them to zero.. - !----------------------------------------------------------------------------- - topology_section => section_vals_get_subs_vals(subsys_section,"TOPOLOGY") - CALL section_vals_val_get(topology_section,"EXCLUDE_VDW",i_val=exclude_vdw) - CALL section_vals_val_get(topology_section,"EXCLUDE_EI",i_val=exclude_ei) - IF (exclude_vdw==do_skip_14) ff_type%vdw_scale14 = 0.0_dp - IF (exclude_ei ==do_skip_14) ff_type%ei_scale14 = 0.0_dp + !----------------------------------------------------------------------------- + ! 2.1 In case exclusion 1-4 was requested, we need to modify the values of + ! the scale factors setting them to zero.. + !----------------------------------------------------------------------------- + topology_section => section_vals_get_subs_vals(subsys_section, "TOPOLOGY") + CALL section_vals_val_get(topology_section, "EXCLUDE_VDW", i_val=exclude_vdw) + CALL section_vals_val_get(topology_section, "EXCLUDE_EI", i_val=exclude_ei) + IF (exclude_vdw == do_skip_14) ff_type%vdw_scale14 = 0.0_dp + IF (exclude_ei == do_skip_14) ff_type%ei_scale14 = 0.0_dp - !----------------------------------------------------------------------------- - ! 3. If reading in from external file, make sure its there first - !----------------------------------------------------------------------------- - SELECT CASE (ff_type%ff_type) - CASE (do_ff_charmm,do_ff_amber,do_ff_g96,do_ff_g87) - INQUIRE(FILE=ff_type%ff_file_name,EXIST=found) - IF (.NOT.found) THEN - CPABORT("Force field file missing") - END IF - CASE (do_ff_undef) - ! Do Nothing - CASE DEFAULT - CPABORT("Force field type not implemented") - END SELECT + !----------------------------------------------------------------------------- + ! 3. If reading in from external file, make sure its there first + !----------------------------------------------------------------------------- + SELECT CASE (ff_type%ff_type) + CASE (do_ff_charmm, do_ff_amber, do_ff_g96, do_ff_g87) + INQUIRE (FILE=ff_type%ff_file_name, EXIST=found) + IF (.NOT. found) THEN + CPABORT("Force field file missing") + END IF + CASE (do_ff_undef) + ! Do Nothing + CASE DEFAULT + CPABORT("Force field type not implemented") + END SELECT - !----------------------------------------------------------------------------- - ! 4. Read in the force field from the corresponding locations - !----------------------------------------------------------------------------- - SELECT CASE (ff_type%ff_type) - CASE (do_ff_charmm) - CALL read_force_field_charmm(ff_type,para_env,mm_section) - CASE (do_ff_amber) - CALL read_force_field_amber(ff_type,para_env,mm_section,particle_set) - CASE (do_ff_g87,do_ff_g96) - CALL read_force_field_gromos(ff_type,para_env,mm_section) - CASE (do_ff_undef) - ! Do Nothing - CASE DEFAULT - CPABORT("Force field type not implemented") - END SELECT + !----------------------------------------------------------------------------- + ! 4. Read in the force field from the corresponding locations + !----------------------------------------------------------------------------- + SELECT CASE (ff_type%ff_type) + CASE (do_ff_charmm) + CALL read_force_field_charmm(ff_type, para_env, mm_section) + CASE (do_ff_amber) + CALL read_force_field_amber(ff_type, para_env, mm_section, particle_set) + CASE (do_ff_g87, do_ff_g96) + CALL read_force_field_gromos(ff_type, para_env, mm_section) + CASE (do_ff_undef) + ! Do Nothing + CASE DEFAULT + CPABORT("Force field type not implemented") + END SELECT - !----------------------------------------------------------------------------- - ! 5. Possibly print the top file - !----------------------------------------------------------------------------- - CALL print_pot_parameter_file(ff_type, mm_section) + !----------------------------------------------------------------------------- + ! 5. Possibly print the top file + !----------------------------------------------------------------------------- + CALL print_pot_parameter_file(ff_type, mm_section) - !----------------------------------------------------------------------------- - ! 6. Pack all force field info into different structures - !----------------------------------------------------------------------------- - CALL force_field_pack (particle_set,atomic_kind_set, molecule_kind_set,molecule_set,& - ewald_env,fist_nonbond_env,ff_type,root_section, qmmm, qmmm_env, mm_section,& - subsys_section, shell_particle_set=shell_particle_set, & - core_particle_set=core_particle_set, cell=cell) + !----------------------------------------------------------------------------- + ! 6. Pack all force field info into different structures + !----------------------------------------------------------------------------- + CALL force_field_pack(particle_set, atomic_kind_set, molecule_kind_set, molecule_set, & + ewald_env, fist_nonbond_env, ff_type, root_section, qmmm, qmmm_env, mm_section, & + subsys_section, shell_particle_set=shell_particle_set, & + core_particle_set=core_particle_set, cell=cell) - !----------------------------------------------------------------------------- - ! 7. Output total system charge assigned to qeff - !----------------------------------------------------------------------------- - CALL force_field_qeff_output (particle_set, molecule_kind_set,& - molecule_set, mm_section, fist_nonbond_env%charges) + !----------------------------------------------------------------------------- + ! 7. Output total system charge assigned to qeff + !----------------------------------------------------------------------------- + CALL force_field_qeff_output(particle_set, molecule_kind_set, & + molecule_set, mm_section, fist_nonbond_env%charges) - !----------------------------------------------------------------------------- - ! 8. Clean up "UNSET" bond,bend,UB,TORSION,IMPR,ONFO kinds - !----------------------------------------------------------------------------- - CALL clean_intra_force_kind (molecule_kind_set,mm_section) + !----------------------------------------------------------------------------- + ! 8. Clean up "UNSET" bond,bend,UB,TORSION,IMPR,ONFO kinds + !----------------------------------------------------------------------------- + CALL clean_intra_force_kind(molecule_kind_set, mm_section) - !----------------------------------------------------------------------------- - ! 9. Cleanup the ff_type structure type - !----------------------------------------------------------------------------- - CALL deallocate_ff_type(ff_type) + !----------------------------------------------------------------------------- + ! 9. Cleanup the ff_type structure type + !----------------------------------------------------------------------------- + CALL deallocate_ff_type(ff_type) - CALL cp_print_key_finished_output(iw,logger,mm_section,& - "PRINT%FF_INFO") - CALL timestop(handle) + CALL cp_print_key_finished_output(iw, logger, mm_section, & + "PRINT%FF_INFO") + CALL timestop(handle) - END SUBROUTINE force_field_control + END SUBROUTINE force_field_control ! ************************************************************************************************** !> \brief Prints force field information in a pot file @@ -207,7 +207,7 @@ END SUBROUTINE force_field_control !> \param mm_section ... !> \author Teodoro Laino [tlaino, teodoro.laino-AT-gmail.com] - 11.2008 ! ************************************************************************************************** - SUBROUTINE print_pot_parameter_file(ff_type, mm_section) + SUBROUTINE print_pot_parameter_file(ff_type, mm_section) TYPE(force_field_type) :: ff_type TYPE(section_vals_type), POINTER :: mm_section @@ -219,95 +219,95 @@ SUBROUTINE print_pot_parameter_file(ff_type, mm_section) REAL(KIND=dp) :: eps, k, phi0, r0, sigma, theta0 TYPE(cp_logger_type), POINTER :: logger - CALL timeset(routineN,handle) - logger => cp_get_default_logger() - IF (BTEST(cp_print_key_should_output(logger%iter_info,mm_section,"PRINT%FF_PARAMETER_FILE")& - ,cp_p_file)) THEN - iw = cp_print_key_unit_nr(logger,mm_section,"PRINT%FF_PARAMETER_FILE",& - middle_name="force_field",extension=".pot") - IF (iw>0) THEN - ! Header - WRITE(iw,1000)"Force Field Parameter File dumped into CHARMM FF style" - END IF - SELECT CASE(ff_type%ff_type) - CASE (do_ff_charmm) - CPWARN("Dumping FF parameter file for CHARMM FF not implemented!") - CASE (do_ff_amber) - IF (iw>0) THEN - ! Bonds - WRITE(iw,1001) - DO i = 1, SIZE(ff_type%amb_info%bond_a) - k = cp_unit_from_cp2k(ff_type%amb_info%bond_k(i),"kcalmol*angstrom^-2") - r0= cp_unit_from_cp2k(ff_type%amb_info%bond_r0(i),"angstrom") - WRITE(iw, 2001) ff_type%amb_info%bond_a(i),& - ff_type%amb_info%bond_b(i),& - k, r0 - END DO - ! Angles - WRITE(iw,1002) - DO i = 1, SIZE(ff_type%amb_info%bend_a) - k = cp_unit_from_cp2k(ff_type%amb_info%bend_k(i),"kcalmol*rad^-2") - theta0 = cp_unit_from_cp2k(ff_type%amb_info%bend_theta0(i),"deg") - WRITE(iw, 2002) ff_type%amb_info%bend_a(i),& - ff_type%amb_info%bend_b(i),& - ff_type%amb_info%bend_c(i),& - k, theta0 - END DO - ! Torsions - WRITE(iw,1003) - DO i = 1, SIZE(ff_type%amb_info%torsion_a) - k = cp_unit_from_cp2k(ff_type%amb_info%torsion_k(i),"kcalmol") - m = ff_type%amb_info%torsion_m(i) - phi0 = cp_unit_from_cp2k(ff_type%amb_info%torsion_phi0(i),"deg") - WRITE(iw, 2003) ff_type%amb_info%torsion_a(i),& - ff_type%amb_info%torsion_b(i),& - ff_type%amb_info%torsion_c(i),& - ff_type%amb_info%torsion_d(i),& - k, m, phi0 - END DO - ! Lennard-Jones - WRITE(iw,1005) - DO i = 1, SIZE(ff_type%amb_info%nonbond_a) - eps = cp_unit_from_cp2k(ff_type%amb_info%nonbond_eps(i),"kcalmol") - sigma = cp_unit_from_cp2k(ff_type%amb_info%nonbond_rmin2(i),"angstrom") - WRITE(iw, 2005) ff_type%amb_info%nonbond_a(i),& - eps, sigma - END DO - END IF - CASE (do_ff_g87,do_ff_g96) - CPWARN("Dumping FF parameter file for GROMOS FF not implemented!") - CASE (do_ff_undef) - CPWARN("Dumping FF parameter file for INPUT FF not implemented!") - END SELECT - IF (iw>0) THEN - WRITE(iw,'(/,A)')"END" - END IF - CALL cp_print_key_finished_output(iw,logger,mm_section,& - "PRINT%FF_PARAMETER_FILE") - END IF - CALL timestop(handle) - RETURN -1000 FORMAT("*>>>>>>>",T12,A,T73,"<<<<<<<") -1001 FORMAT(/,"BONDS",/,"!",/,"!V(bond) = Kb(b - b0)**2",/,"!",/,"!Kb: kcal/mole/A**2",/, & - "!b0: A",/,"!",/,"! atom type Kb b0",/,"!") -1002 FORMAT(/,"ANGLES",/,"!",/,"!V(angle) = Ktheta(Theta - Theta0)**2",/,"!",/, & - "!V(Urey-Bradley) = Kub(S - S0)**2",/,"!",/,"!Ktheta: kcal/mole/rad**2",/, & - "!Theta0: degrees",/,"!Kub: kcal/mole/A**2 (Urey-Bradley)",/,"!S0: A",/, & - "!",/,"! atom types Ktheta Theta0 Kub S0",/,"!") -1003 FORMAT(/,"DIHEDRALS",/,"!",/,"!V(dihedral) = Kchi(1 + cos(n(chi) - delta))",/, & - "!",/,"!Kchi: kcal/mole",/,"!n: multiplicity",/,"!delta: degrees",/, & - "!",/,"! atom types Kchi n delta",/,"!") -1005 FORMAT(/,"NONBONDED",/,"!",/, & - "!V(Lennard-Jones) = Eps,i,j[(Rmin,i,j/ri,j)**12 - 2(Rmin,i,j/ri,j)**6]",/, & - "!",/,"!epsilon: kcal/mole, Eps,i,j = sqrt(eps,i * eps,j)",/, & - "!Rmin/2: A, Rmin,i,j = Rmin/2,i + Rmin/2,j",/,"!",/, & - "!atom ignored epsilon Rmin/2 ignored eps,1-4 "//& - "Rmin/2,1-4",/,"!") + CALL timeset(routineN, handle) + logger => cp_get_default_logger() + IF (BTEST(cp_print_key_should_output(logger%iter_info, mm_section, "PRINT%FF_PARAMETER_FILE") & + , cp_p_file)) THEN + iw = cp_print_key_unit_nr(logger, mm_section, "PRINT%FF_PARAMETER_FILE", & + middle_name="force_field", extension=".pot") + IF (iw > 0) THEN + ! Header + WRITE (iw, 1000) "Force Field Parameter File dumped into CHARMM FF style" + END IF + SELECT CASE (ff_type%ff_type) + CASE (do_ff_charmm) + CPWARN("Dumping FF parameter file for CHARMM FF not implemented!") + CASE (do_ff_amber) + IF (iw > 0) THEN + ! Bonds + WRITE (iw, 1001) + DO i = 1, SIZE(ff_type%amb_info%bond_a) + k = cp_unit_from_cp2k(ff_type%amb_info%bond_k(i), "kcalmol*angstrom^-2") + r0 = cp_unit_from_cp2k(ff_type%amb_info%bond_r0(i), "angstrom") + WRITE (iw, 2001) ff_type%amb_info%bond_a(i), & + ff_type%amb_info%bond_b(i), & + k, r0 + END DO + ! Angles + WRITE (iw, 1002) + DO i = 1, SIZE(ff_type%amb_info%bend_a) + k = cp_unit_from_cp2k(ff_type%amb_info%bend_k(i), "kcalmol*rad^-2") + theta0 = cp_unit_from_cp2k(ff_type%amb_info%bend_theta0(i), "deg") + WRITE (iw, 2002) ff_type%amb_info%bend_a(i), & + ff_type%amb_info%bend_b(i), & + ff_type%amb_info%bend_c(i), & + k, theta0 + END DO + ! Torsions + WRITE (iw, 1003) + DO i = 1, SIZE(ff_type%amb_info%torsion_a) + k = cp_unit_from_cp2k(ff_type%amb_info%torsion_k(i), "kcalmol") + m = ff_type%amb_info%torsion_m(i) + phi0 = cp_unit_from_cp2k(ff_type%amb_info%torsion_phi0(i), "deg") + WRITE (iw, 2003) ff_type%amb_info%torsion_a(i), & + ff_type%amb_info%torsion_b(i), & + ff_type%amb_info%torsion_c(i), & + ff_type%amb_info%torsion_d(i), & + k, m, phi0 + END DO + ! Lennard-Jones + WRITE (iw, 1005) + DO i = 1, SIZE(ff_type%amb_info%nonbond_a) + eps = cp_unit_from_cp2k(ff_type%amb_info%nonbond_eps(i), "kcalmol") + sigma = cp_unit_from_cp2k(ff_type%amb_info%nonbond_rmin2(i), "angstrom") + WRITE (iw, 2005) ff_type%amb_info%nonbond_a(i), & + eps, sigma + END DO + END IF + CASE (do_ff_g87, do_ff_g96) + CPWARN("Dumping FF parameter file for GROMOS FF not implemented!") + CASE (do_ff_undef) + CPWARN("Dumping FF parameter file for INPUT FF not implemented!") + END SELECT + IF (iw > 0) THEN + WRITE (iw, '(/,A)') "END" + END IF + CALL cp_print_key_finished_output(iw, logger, mm_section, & + "PRINT%FF_PARAMETER_FILE") + END IF + CALL timestop(handle) + RETURN +1000 FORMAT("*>>>>>>>", T12, A, T73, "<<<<<<<") +1001 FORMAT(/, "BONDS", /, "!", /, "!V(bond) = Kb(b - b0)**2", /, "!", /, "!Kb: kcal/mole/A**2", /, & + "!b0: A", /, "!", /, "! atom type Kb b0", /, "!") +1002 FORMAT(/, "ANGLES", /, "!", /, "!V(angle) = Ktheta(Theta - Theta0)**2", /, "!", /, & + "!V(Urey-Bradley) = Kub(S - S0)**2", /, "!", /, "!Ktheta: kcal/mole/rad**2", /, & + "!Theta0: degrees", /, "!Kub: kcal/mole/A**2 (Urey-Bradley)", /, "!S0: A", /, & + "!", /, "! atom types Ktheta Theta0 Kub S0", /, "!") +1003 FORMAT(/, "DIHEDRALS", /, "!", /, "!V(dihedral) = Kchi(1 + cos(n(chi) - delta))", /, & + "!", /, "!Kchi: kcal/mole", /, "!n: multiplicity", /, "!delta: degrees", /, & + "!", /, "! atom types Kchi n delta", /, "!") +1005 FORMAT(/, "NONBONDED", /, "!", /, & + "!V(Lennard-Jones) = Eps,i,j[(Rmin,i,j/ri,j)**12 - 2(Rmin,i,j/ri,j)**6]", /, & + "!", /, "!epsilon: kcal/mole, Eps,i,j = sqrt(eps,i * eps,j)", /, & + "!Rmin/2: A, Rmin,i,j = Rmin/2,i + Rmin/2,j", /, "!", /, & + "!atom ignored epsilon Rmin/2 ignored eps,1-4 "// & + "Rmin/2,1-4", /, "!") -2001 FORMAT(A6,1X,A6,1X,2F15.9) ! bond -2002 FORMAT(A6,1X,A6,1X,A6,1X,2F15.9) ! angle -2003 FORMAT(A6,1X,A6,1X,A6,1X,A6,1X,F15.9,I5,F15.9) ! torsion -2005 FORMAT(A6,1X," 0.000000000",2F15.9) ! nonbond - END SUBROUTINE print_pot_parameter_file +2001 FORMAT(A6, 1X, A6, 1X, 2F15.9) ! bond +2002 FORMAT(A6, 1X, A6, 1X, A6, 1X, 2F15.9) ! angle +2003 FORMAT(A6, 1X, A6, 1X, A6, 1X, A6, 1X, F15.9, I5, F15.9) ! torsion +2005 FORMAT(A6, 1X, " 0.000000000", 2F15.9) ! nonbond + END SUBROUTINE print_pot_parameter_file END MODULE force_fields diff --git a/src/force_fields_all.F b/src/force_fields_all.F index 2b9fad8ea7..79b4e0fe14 100644 --- a/src/force_fields_all.F +++ b/src/force_fields_all.F @@ -165,21 +165,21 @@ SUBROUTINE force_field_unique_bond(particle_set, & ELSE DO j = 1, nbond atm_a = bond_list(j)%a - atomic_kind => particle_set(atm_a+first-1)%atomic_kind + atomic_kind => particle_set(atm_a + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_a) atm_b = bond_list(j)%b - atomic_kind => particle_set(atm_b+first-1)%atomic_kind + atomic_kind => particle_set(atm_b + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_b) found = .FALSE. - DO k = 1, j-1 + DO k = 1, j - 1 atm_a = bond_list(k)%a - atomic_kind => particle_set(atm_a+first-1)%atomic_kind + atomic_kind => particle_set(atm_a + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_a2) atm_b = bond_list(k)%b - atomic_kind => particle_set(atm_b+first-1)%atomic_kind + atomic_kind => particle_set(atm_b + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_b2) IF ((((name_atm_a) == (name_atm_a2)) .AND. & @@ -192,7 +192,7 @@ SUBROUTINE force_field_unique_bond(particle_set, & END IF END DO IF (.NOT. found) THEN - counter = counter+1 + counter = counter + 1 map_bond_kind(j) = counter END IF END DO @@ -262,29 +262,29 @@ SUBROUTINE force_field_unique_bend(particle_set, & ELSE DO j = 1, nbend atm_a = bend_list(j)%a - atomic_kind => particle_set(atm_a+first-1)%atomic_kind + atomic_kind => particle_set(atm_a + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_a) atm_b = bend_list(j)%b - atomic_kind => particle_set(atm_b+first-1)%atomic_kind + atomic_kind => particle_set(atm_b + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_b) atm_c = bend_list(j)%c - atomic_kind => particle_set(atm_c+first-1)%atomic_kind + atomic_kind => particle_set(atm_c + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_c) found = .FALSE. - DO k = 1, j-1 + DO k = 1, j - 1 atm_a = bend_list(k)%a - atomic_kind => particle_set(atm_a+first-1)%atomic_kind + atomic_kind => particle_set(atm_a + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_a2) atm_b = bend_list(k)%b - atomic_kind => particle_set(atm_b+first-1)%atomic_kind + atomic_kind => particle_set(atm_b + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_b2) atm_c = bend_list(k)%c - atomic_kind => particle_set(atm_c+first-1)%atomic_kind + atomic_kind => particle_set(atm_c + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_c2) IF ((((name_atm_a) == (name_atm_a2)) .AND. & @@ -299,7 +299,7 @@ SUBROUTINE force_field_unique_bend(particle_set, & END IF END DO IF (.NOT. found) THEN - counter = counter+1 + counter = counter + 1 map_bend_kind(j) = counter END IF END DO @@ -361,29 +361,29 @@ SUBROUTINE force_field_unique_ub(particle_set, & counter = 0 DO j = 1, nub atm_a = ub_list(j)%a - atomic_kind => particle_set(atm_a+first-1)%atomic_kind + atomic_kind => particle_set(atm_a + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_a) atm_b = ub_list(j)%b - atomic_kind => particle_set(atm_b+first-1)%atomic_kind + atomic_kind => particle_set(atm_b + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_b) atm_c = ub_list(j)%c - atomic_kind => particle_set(atm_c+first-1)%atomic_kind + atomic_kind => particle_set(atm_c + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_c) found = .FALSE. - DO k = 1, j-1 + DO k = 1, j - 1 atm_a = ub_list(k)%a - atomic_kind => particle_set(atm_a+first-1)%atomic_kind + atomic_kind => particle_set(atm_a + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_a2) atm_b = ub_list(k)%b - atomic_kind => particle_set(atm_b+first-1)%atomic_kind + atomic_kind => particle_set(atm_b + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_b2) atm_c = ub_list(k)%c - atomic_kind => particle_set(atm_c+first-1)%atomic_kind + atomic_kind => particle_set(atm_c + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_c2) IF ((((name_atm_a) == (name_atm_a2)) .AND. & @@ -398,7 +398,7 @@ SUBROUTINE force_field_unique_ub(particle_set, & END IF END DO IF (.NOT. found) THEN - counter = counter+1 + counter = counter + 1 map_ub_kind(j) = counter END IF END DO @@ -468,37 +468,37 @@ SUBROUTINE force_field_unique_tors(particle_set, & ELSE DO j = 1, ntorsion atm_a = torsion_list(j)%a - atomic_kind => particle_set(atm_a+first-1)%atomic_kind + atomic_kind => particle_set(atm_a + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_a) atm_b = torsion_list(j)%b - atomic_kind => particle_set(atm_b+first-1)%atomic_kind + atomic_kind => particle_set(atm_b + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_b) atm_c = torsion_list(j)%c - atomic_kind => particle_set(atm_c+first-1)%atomic_kind + atomic_kind => particle_set(atm_c + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_c) atm_d = torsion_list(j)%d - atomic_kind => particle_set(atm_d+first-1)%atomic_kind + atomic_kind => particle_set(atm_d + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_d) found = .FALSE. - DO k = 1, j-1 + DO k = 1, j - 1 atm_a = torsion_list(k)%a - atomic_kind => particle_set(atm_a+first-1)%atomic_kind + atomic_kind => particle_set(atm_a + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_a2) atm_b = torsion_list(k)%b - atomic_kind => particle_set(atm_b+first-1)%atomic_kind + atomic_kind => particle_set(atm_b + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_b2) atm_c = torsion_list(k)%c - atomic_kind => particle_set(atm_c+first-1)%atomic_kind + atomic_kind => particle_set(atm_c + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_c2) atm_d = torsion_list(k)%d - atomic_kind => particle_set(atm_d+first-1)%atomic_kind + atomic_kind => particle_set(atm_d + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_d2) IF ((((name_atm_a) == (name_atm_a2)) .AND. & @@ -515,7 +515,7 @@ SUBROUTINE force_field_unique_tors(particle_set, & END IF END DO IF (.NOT. found) THEN - counter = counter+1 + counter = counter + 1 map_torsion_kind(j) = counter END IF END DO @@ -587,37 +587,37 @@ SUBROUTINE force_field_unique_impr(particle_set, & ELSE DO j = 1, nimpr atm_a = impr_list(j)%a - atomic_kind => particle_set(atm_a+first-1)%atomic_kind + atomic_kind => particle_set(atm_a + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_a) atm_b = impr_list(j)%b - atomic_kind => particle_set(atm_b+first-1)%atomic_kind + atomic_kind => particle_set(atm_b + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_b) atm_c = impr_list(j)%c - atomic_kind => particle_set(atm_c+first-1)%atomic_kind + atomic_kind => particle_set(atm_c + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_c) atm_d = impr_list(j)%d - atomic_kind => particle_set(atm_d+first-1)%atomic_kind + atomic_kind => particle_set(atm_d + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_d) found = .FALSE. - DO k = 1, j-1 + DO k = 1, j - 1 atm_a = impr_list(k)%a - atomic_kind => particle_set(atm_a+first-1)%atomic_kind + atomic_kind => particle_set(atm_a + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_a2) atm_b = impr_list(k)%b - atomic_kind => particle_set(atm_b+first-1)%atomic_kind + atomic_kind => particle_set(atm_b + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_b2) atm_c = impr_list(k)%c - atomic_kind => particle_set(atm_c+first-1)%atomic_kind + atomic_kind => particle_set(atm_c + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_c2) atm_d = impr_list(k)%d - atomic_kind => particle_set(atm_d+first-1)%atomic_kind + atomic_kind => particle_set(atm_d + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_d2) IF ((((name_atm_a) == (name_atm_a2)) .AND. & @@ -634,7 +634,7 @@ SUBROUTINE force_field_unique_impr(particle_set, & END IF END DO IF (.NOT. found) THEN - counter = counter+1 + counter = counter + 1 map_impr_kind(j) = counter END IF END DO @@ -708,37 +708,37 @@ SUBROUTINE force_field_unique_opbend(particle_set, & ELSE DO j = 1, nopbend atm_a = opbend_list(j)%a - atomic_kind => particle_set(atm_a+first-1)%atomic_kind + atomic_kind => particle_set(atm_a + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_a) atm_b = opbend_list(j)%b - atomic_kind => particle_set(atm_b+first-1)%atomic_kind + atomic_kind => particle_set(atm_b + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_b) atm_c = opbend_list(j)%c - atomic_kind => particle_set(atm_c+first-1)%atomic_kind + atomic_kind => particle_set(atm_c + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_c) atm_d = opbend_list(j)%d - atomic_kind => particle_set(atm_d+first-1)%atomic_kind + atomic_kind => particle_set(atm_d + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_d) found = .FALSE. - DO k = 1, j-1 + DO k = 1, j - 1 atm_a = opbend_list(k)%a - atomic_kind => particle_set(atm_a+first-1)%atomic_kind + atomic_kind => particle_set(atm_a + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_a2) atm_b = opbend_list(k)%b - atomic_kind => particle_set(atm_b+first-1)%atomic_kind + atomic_kind => particle_set(atm_b + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_b2) atm_c = opbend_list(k)%c - atomic_kind => particle_set(atm_c+first-1)%atomic_kind + atomic_kind => particle_set(atm_c + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_c2) atm_d = opbend_list(k)%d - atomic_kind => particle_set(atm_d+first-1)%atomic_kind + atomic_kind => particle_set(atm_d + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_d2) IF ((((name_atm_a) == (name_atm_a2)) .AND. & @@ -755,7 +755,7 @@ SUBROUTINE force_field_unique_opbend(particle_set, & END IF END DO IF (.NOT. found) THEN - counter = counter+1 + counter = counter + 1 map_opbend_kind(j) = counter END IF END DO @@ -825,11 +825,11 @@ SUBROUTINE force_field_pack_bond(particle_set, molecule_kind_set, molecule_set, CALL get_molecule(molecule=molecule, first_atom=first, last_atom=last) DO j = 1, nbond atm_a = bond_list(j)%a - atomic_kind => particle_set(atm_a+first-1)%atomic_kind + atomic_kind => particle_set(atm_a + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_a) atm_b = bond_list(j)%b - atomic_kind => particle_set(atm_b+first-1)%atomic_kind + atomic_kind => particle_set(atm_b + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_b) found = .FALSE. @@ -845,7 +845,7 @@ SUBROUTINE force_field_pack_bond(particle_set, molecule_kind_set, molecule_set, bond_list(j)%bond_kind%k(1) = gro_info%bond_k(itype) bond_list(j)%bond_kind%r0 = gro_info%bond_r0(itype) ELSE - itype = itype-k + itype = itype - k bond_list(j)%bond_kind%k(1) = gro_info%solvent_k(itype) bond_list(j)%bond_kind%r0 = gro_info%solvent_r0(itype) END IF @@ -975,15 +975,15 @@ SUBROUTINE force_field_pack_bend(particle_set, molecule_kind_set, molecule_set, CALL get_molecule(molecule=molecule, first_atom=first, last_atom=last) DO j = 1, nbend atm_a = bend_list(j)%a - atomic_kind => particle_set(atm_a+first-1)%atomic_kind + atomic_kind => particle_set(atm_a + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_a) atm_b = bend_list(j)%b - atomic_kind => particle_set(atm_b+first-1)%atomic_kind + atomic_kind => particle_set(atm_b + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_b) atm_c = bend_list(j)%c - atomic_kind => particle_set(atm_c+first-1)%atomic_kind + atomic_kind => particle_set(atm_c + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_c) found = .FALSE. @@ -1149,15 +1149,15 @@ SUBROUTINE force_field_pack_ub(particle_set, molecule_kind_set, molecule_set, & CALL get_molecule(molecule=molecule, first_atom=first, last_atom=last) DO j = 1, nub atm_a = ub_list(j)%a - atomic_kind => particle_set(atm_a+first-1)%atomic_kind + atomic_kind => particle_set(atm_a + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_a) atm_b = ub_list(j)%b - atomic_kind => particle_set(atm_b+first-1)%atomic_kind + atomic_kind => particle_set(atm_b + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_b) atm_c = ub_list(j)%c - atomic_kind => particle_set(atm_c+first-1)%atomic_kind + atomic_kind => particle_set(atm_c + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_c) found = .FALSE. @@ -1293,19 +1293,19 @@ SUBROUTINE force_field_pack_tors(particle_set, molecule_kind_set, molecule_set, DO j = 1, ntorsion IF (torsion_list(j)%torsion_kind%id_type == do_ff_undef) THEN atm_a = torsion_list(j)%a - atomic_kind => particle_set(atm_a+first-1)%atomic_kind + atomic_kind => particle_set(atm_a + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_a) atm_b = torsion_list(j)%b - atomic_kind => particle_set(atm_b+first-1)%atomic_kind + atomic_kind => particle_set(atm_b + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_b) atm_c = torsion_list(j)%c - atomic_kind => particle_set(atm_c+first-1)%atomic_kind + atomic_kind => particle_set(atm_c + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_c) atm_d = torsion_list(j)%d - atomic_kind => particle_set(atm_d+first-1)%atomic_kind + atomic_kind => particle_set(atm_d + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_d) found = .FALSE. @@ -1353,7 +1353,7 @@ SUBROUTINE force_field_pack_tors(particle_set, molecule_kind_set, molecule_set, ((chm_info%torsion_b(k)) == (name_atm_c)) .AND. & ((chm_info%torsion_c(k)) == (name_atm_b)) .AND. & ((chm_info%torsion_d(k)) == (name_atm_a)))) THEN - imul = torsion_list(j)%torsion_kind%nmul+1 + imul = torsion_list(j)%torsion_kind%nmul + 1 CALL reallocate(torsion_list(j)%torsion_kind%k, 1, imul) CALL reallocate(torsion_list(j)%torsion_kind%m, 1, imul) CALL reallocate(torsion_list(j)%torsion_kind%phi0, 1, imul) @@ -1376,7 +1376,7 @@ SUBROUTINE force_field_pack_tors(particle_set, molecule_kind_set, molecule_set, ((chm_info%torsion_b(k)) == (name_atm_c)) .AND. & ((chm_info%torsion_c(k)) == (name_atm_b)) .AND. & ((chm_info%torsion_d(k)) == ("X")))) THEN - imul = torsion_list(j)%torsion_kind%nmul+1 + imul = torsion_list(j)%torsion_kind%nmul + 1 CALL reallocate(torsion_list(j)%torsion_kind%k, 1, imul) CALL reallocate(torsion_list(j)%torsion_kind%m, 1, imul) CALL reallocate(torsion_list(j)%torsion_kind%phi0, 1, imul) @@ -1402,7 +1402,7 @@ SUBROUTINE force_field_pack_tors(particle_set, molecule_kind_set, molecule_set, ((amb_info%torsion_b(k)) == (name_atm_c)) .AND. & ((amb_info%torsion_c(k)) == (name_atm_b)) .AND. & ((amb_info%torsion_d(k)) == (name_atm_a)))) THEN - imul = torsion_list(j)%torsion_kind%nmul+1 + imul = torsion_list(j)%torsion_kind%nmul + 1 CALL reallocate(torsion_list(j)%torsion_kind%k, 1, imul) CALL reallocate(torsion_list(j)%torsion_kind%m, 1, imul) CALL reallocate(torsion_list(j)%torsion_kind%phi0, 1, imul) @@ -1425,7 +1425,7 @@ SUBROUTINE force_field_pack_tors(particle_set, molecule_kind_set, molecule_set, ((amb_info%torsion_b(k)) == (name_atm_c)) .AND. & ((amb_info%torsion_c(k)) == (name_atm_b)) .AND. & ((amb_info%torsion_d(k)) == ("X")))) THEN - imul = torsion_list(j)%torsion_kind%nmul+1 + imul = torsion_list(j)%torsion_kind%nmul + 1 CALL reallocate(torsion_list(j)%torsion_kind%k, 1, imul) CALL reallocate(torsion_list(j)%torsion_kind%m, 1, imul) CALL reallocate(torsion_list(j)%torsion_kind%phi0, 1, imul) @@ -1451,7 +1451,7 @@ SUBROUTINE force_field_pack_tors(particle_set, molecule_kind_set, molecule_set, ((inp_info%torsion_b(k)) == (name_atm_c)) .AND. & ((inp_info%torsion_c(k)) == (name_atm_b)) .AND. & ((inp_info%torsion_d(k)) == (name_atm_a)))) THEN - imul = torsion_list(j)%torsion_kind%nmul+1 + imul = torsion_list(j)%torsion_kind%nmul + 1 CALL reallocate(torsion_list(j)%torsion_kind%k, 1, imul) CALL reallocate(torsion_list(j)%torsion_kind%m, 1, imul) CALL reallocate(torsion_list(j)%torsion_kind%phi0, 1, imul) @@ -1556,19 +1556,19 @@ SUBROUTINE force_field_pack_impr(particle_set, molecule_kind_set, molecule_set, CALL get_molecule(molecule=molecule, first_atom=first, last_atom=last) DO j = 1, nimpr atm_a = impr_list(j)%a - atomic_kind => particle_set(atm_a+first-1)%atomic_kind + atomic_kind => particle_set(atm_a + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_a) atm_b = impr_list(j)%b - atomic_kind => particle_set(atm_b+first-1)%atomic_kind + atomic_kind => particle_set(atm_b + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_b) atm_c = impr_list(j)%c - atomic_kind => particle_set(atm_c+first-1)%atomic_kind + atomic_kind => particle_set(atm_c + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_c) atm_d = impr_list(j)%d - atomic_kind => particle_set(atm_d+first-1)%atomic_kind + atomic_kind => particle_set(atm_d + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_d) found = .FALSE. @@ -1748,19 +1748,19 @@ SUBROUTINE force_field_pack_opbend(particle_set, molecule_kind_set, molecule_set CALL get_molecule(molecule=molecule, first_atom=first, last_atom=last) DO j = 1, nopbend atm_a = opbend_list(j)%a - atomic_kind => particle_set(atm_a+first-1)%atomic_kind + atomic_kind => particle_set(atm_a + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_a) atm_b = opbend_list(j)%b - atomic_kind => particle_set(atm_b+first-1)%atomic_kind + atomic_kind => particle_set(atm_b + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_b) atm_c = opbend_list(j)%c - atomic_kind => particle_set(atm_c+first-1)%atomic_kind + atomic_kind => particle_set(atm_c + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_c) atm_d = opbend_list(j)%d - atomic_kind => particle_set(atm_d+first-1)%atomic_kind + atomic_kind => particle_set(atm_d + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=name_atm_d) found = .FALSE. @@ -1915,7 +1915,7 @@ SUBROUTINE force_field_pack_charges(charges, charges_section, particle_set, & DO j = 1, SIZE(inp_info%nonbonded%pot) IF (atmname == inp_info%nonbonded%pot(j)%pot%at1 .OR. & atmname == inp_info%nonbonded%pot(j)%pot%at2) THEN - SELECT CASE (inp_info%nonbonded%pot (j)%pot%type (1)) + SELECT CASE (inp_info%nonbonded%pot(j)%pot%type(1)) CASE (ea_type, tersoff_type, siepmann_type) ! Charge is zero for EAM, TERSOFF and SIEPMANN type potential ! Do nothing.. @@ -2031,7 +2031,7 @@ SUBROUTINE force_field_pack_charge(atomic_kind_set, qmmm_env, fatal, iw, iw4, & DO j = 1, SIZE(inp_info%shell_list) IF ((inp_info%shell_list(j)%atm_name) == atmname) THEN is_shell = .TRUE. - cs_charge = inp_info%shell_list(j)%shell%charge_core+ & + cs_charge = inp_info%shell_list(j)%shell%charge_core + & inp_info%shell_list(j)%shell%charge_shell charge = 0.0_dp IF (found) THEN @@ -2054,7 +2054,7 @@ SUBROUTINE force_field_pack_charge(atomic_kind_set, qmmm_env, fatal, iw, iw4, & DO j = 1, SIZE(inp_info%nonbonded%pot) IF (atmname == inp_info%nonbonded%pot(j)%pot%at1 .OR. & atmname == inp_info%nonbonded%pot(j)%pot%at2) THEN - SELECT CASE (inp_info%nonbonded%pot (j)%pot%type (1)) + SELECT CASE (inp_info%nonbonded%pot(j)%pot%type(1)) CASE (ea_type, tersoff_type, siepmann_type, quip_type) ! Charge is zero for EAM, TERSOFF and SIEPMANN type potential ! Do nothing.. @@ -2104,9 +2104,9 @@ SUBROUTINE force_field_pack_charge(atomic_kind_set, qmmm_env, fatal, iw, iw4, & ! Sum up total charges for IO IF (found) THEN IF (is_shell) THEN - charge_tot = charge_tot+atomic_kind%natom*cs_charge + charge_tot = charge_tot + atomic_kind%natom*cs_charge ELSE - charge_tot = charge_tot+atomic_kind%natom*charge + charge_tot = charge_tot + atomic_kind%natom*charge END IF END IF END DO @@ -2296,7 +2296,7 @@ SUBROUTINE force_field_pack_damp(atomic_kind_set, & CALL issue_duplications(found, "Damping", atm_name1) found = .TRUE. - SELECT CASE (TRIM (inp_info%damping_list (i)%dtype)) + SELECT CASE (TRIM(inp_info%damping_list(i)%dtype)) CASE ('TANG-TOENNIES') damping%damp(k)%itype = tang_toennies CASE DEFAULT @@ -2403,7 +2403,7 @@ SUBROUTINE force_field_pack_shell(particle_set, atomic_kind_set, & IF (.NOT. ASSOCIATED(shell)) THEN CALL shell_create(shell) END IF - nshell_tot = nshell_tot+natom + nshell_tot = nshell_tot + natom shell%charge_core = inp_info%shell_list(j)%shell%charge_core shell%charge_shell = inp_info%shell_list(j)%shell%charge_shell shell%massfrac = inp_info%shell_list(j)%shell%massfrac @@ -2413,7 +2413,7 @@ SUBROUTINE force_field_pack_shell(particle_set, atomic_kind_set, & shell%max_dist = inp_info%shell_list(j)%shell%max_dist shell%shell_cutoff = inp_info%shell_list(j)%shell%shell_cutoff shell%mass_shell = shell%massfrac*atmmass - shell%mass_core = atmmass-shell%mass_shell + shell%mass_core = atmmass - shell%mass_shell CALL issue_duplications(found_shell, "Shell", atmname) found_shell = .TRUE. CALL set_atomic_kind(atomic_kind=atomic_kind, & @@ -2444,7 +2444,7 @@ SUBROUTINE force_field_pack_shell(particle_set, atomic_kind_set, & atomic_kind => particle_set(i)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, shell_active=is_a_shell) IF (is_a_shell) THEN - counter = counter+1 + counter = counter + 1 particle_set(i)%shell_index = counter shell_particle_set(counter)%shell_index = counter shell_particle_set(counter)%atomic_kind => particle_set(i)%atomic_kind @@ -2496,19 +2496,19 @@ SUBROUTINE force_field_pack_shell(particle_set, atomic_kind_set, & atomic_kind => particle_set(j)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, shell_active=is_a_shell) IF (is_a_shell) THEN - counter = counter+1 - shell_list_tmp(counter) = j-first+1 + counter = counter + 1 + shell_list_tmp(counter) = j - first + 1 first_shell = MIN(first_shell, MAX(1, particle_set(j)%shell_index)) END IF END DO ! j atom in molecule_kind i, molecule 1 of the molecule_list IF (counter /= 0) THEN ! Setup of fist_shell and last_shell for all molecules.. DO j = 1, SIZE(molecule_list) - last_shell = first_shell+counter-1 + last_shell = first_shell + counter - 1 molecule => molecule_set(molecule_list(j)) molecule%first_shell = first_shell molecule%last_shell = last_shell - first_shell = last_shell+1 + first_shell = last_shell + 1 END DO ! Setup of shell_list CALL get_molecule_kind(molecule_kind=molecule_kind, shell_list=shell_list) @@ -2518,7 +2518,7 @@ SUBROUTINE force_field_pack_shell(particle_set, atomic_kind_set, & ALLOCATE (shell_list(counter)) DO j = 1, counter shell_list(j)%a = shell_list_tmp(j) - atomic_kind => particle_set(shell_list_tmp(j)+first-1)%atomic_kind + atomic_kind => particle_set(shell_list_tmp(j) + first - 1)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, name=atmname, shell=shell) CALL uppercase(atmname) shell_list(j)%name = atmname @@ -2527,10 +2527,10 @@ SUBROUTINE force_field_pack_shell(particle_set, atomic_kind_set, & CALL set_molecule_kind(molecule_kind=molecule_kind, nshell=counter, shell_list=shell_list) END IF DEALLOCATE (shell_list_tmp) - n = n+nmol*counter + n = n + nmol*counter END DO ! i molecule kind END IF - CPASSERT(first_shell-1 == nshell_tot) + CPASSERT(first_shell - 1 == nshell_tot) CPASSERT(n == nshell_tot) CALL timestop(handle2) @@ -2674,7 +2674,7 @@ SUBROUTINE force_field_pack_nonbond14(atomic_kind_set, ff_type, qmmm_env, iw, & END IF END IF IF (ii /= 0 .AND. jj /= 0) THEN - rmin = rmin2_a+rmin2_b + rmin = rmin2_a + rmin2_b ! ABS to allow for mixing the two different sign conventions for epsilon epsilon0 = SQRT(ABS(epsilon_a*epsilon_b)) CALL pair_potential_lj_create(pot%set(1)%lj) @@ -2712,7 +2712,7 @@ SUBROUTINE force_field_pack_nonbond14(atomic_kind_set, ff_type, qmmm_env, iw, & END DO END IF IF (ii /= 0 .AND. jj /= 0) THEN - rmin = rmin2_a+rmin2_b + rmin = rmin2_a + rmin2_b ! ABS to allow for mixing the two different sign conventions for epsilon epsilon0 = SQRT(ABS(epsilon_a*epsilon_b)) CALL pair_potential_lj_create(pot%set(1)%lj) @@ -2763,8 +2763,8 @@ SUBROUTINE force_field_pack_nonbond14(atomic_kind_set, ff_type, qmmm_env, iw, & ! nonbonded interactions IF (use_qmmm_ff) THEN match_names = 0 - IF ((name_atm_a) == (name_atm_a_local)) match_names = match_names+1 - IF ((name_atm_b) == (name_atm_b_local)) match_names = match_names+1 + IF ((name_atm_a) == (name_atm_a_local)) match_names = match_names + 1 + IF ((name_atm_b) == (name_atm_b_local)) match_names = match_names + 1 IF (match_names == 1) THEN IF (ASSOCIATED(qmmm_env%inp_info%nonbonded14)) THEN DO k = 1, SIZE(qmmm_env%inp_info%nonbonded14%pot) @@ -2937,7 +2937,7 @@ SUBROUTINE force_field_pack_nonbond(atomic_kind_set, ff_type, qmmm_env, fatal, & END DO IF (ii /= 0 .AND. jj /= 0) THEN - rmin = chm_info%nonbond_rmin2(ii)+chm_info%nonbond_rmin2(jj) + rmin = chm_info%nonbond_rmin2(ii) + chm_info%nonbond_rmin2(jj) epsilon0 = SQRT(chm_info%nonbond_eps(ii)* & chm_info%nonbond_eps(jj)) CALL pair_potential_lj_create(pot%set(1)%lj) @@ -2969,7 +2969,7 @@ SUBROUTINE force_field_pack_nonbond(atomic_kind_set, ff_type, qmmm_env, fatal, & END DO IF (ii /= 0 .AND. jj /= 0) THEN - rmin = amb_info%nonbond_rmin2(ii)+amb_info%nonbond_rmin2(jj) + rmin = amb_info%nonbond_rmin2(ii) + amb_info%nonbond_rmin2(jj) epsilon0 = SQRT(amb_info%nonbond_eps(ii)*amb_info%nonbond_eps(jj)) CALL pair_potential_lj_create(pot%set(1)%lj) pot%type = lj_charmm_type @@ -3085,8 +3085,8 @@ SUBROUTINE force_field_pack_nonbond(atomic_kind_set, ff_type, qmmm_env, fatal, & ! nonbonded interactions IF (use_qmmm_ff) THEN match_names = 0 - IF ((name_atm_a) == (name_atm_a_local)) match_names = match_names+1 - IF ((name_atm_b) == (name_atm_b_local)) match_names = match_names+1 + IF ((name_atm_a) == (name_atm_a_local)) match_names = match_names + 1 + IF ((name_atm_b) == (name_atm_b_local)) match_names = match_names + 1 IF (match_names == 1) THEN IF (ASSOCIATED(qmmm_env%inp_info%nonbonded)) THEN DO k = 1, SIZE(qmmm_env%inp_info%nonbonded%pot) @@ -3267,8 +3267,8 @@ SUBROUTINE force_field_pack_eicut(atomic_kind_set, ff_type, & interaction_cutoffs(2, i1, i2) = potential_coulomb(rcut2, tmp, & 1.0_dp, ewald_type, alpha, beta, 0.0_dp) ! cutoff for shell-shell or ion-ion - IF (mm_radius1+mm_radius2 > 0.0_dp) THEN - beta = sqrthalf/SQRT(mm_radius1*mm_radius1+mm_radius2*mm_radius2) + IF (mm_radius1 + mm_radius2 > 0.0_dp) THEN + beta = sqrthalf/SQRT(mm_radius1*mm_radius1 + mm_radius2*mm_radius2) ELSE beta = 0.0_dp END IF @@ -3354,10 +3354,10 @@ SUBROUTINE store_FF_missing_par(atm1, atm2, atm3, atm4, type_name, fatal, array) fmt = 1 my_format = '(T2,"FORCEFIELD| Missing ","'//TRIM(type_name)// & '",T40,"(",A4,")")' - IF (PRESENT(atm2)) fmt = fmt+1 - IF (PRESENT(atm3)) fmt = fmt+1 - IF (PRESENT(atm4)) fmt = fmt+1 - CALL integer_to_string(fmt-1, sfmt) + IF (PRESENT(atm2)) fmt = fmt + 1 + IF (PRESENT(atm3)) fmt = fmt + 1 + IF (PRESENT(atm4)) fmt = fmt + 1 + CALL integer_to_string(fmt - 1, sfmt) IF (fmt > 1) & my_format = '(T2,"FORCEFIELD| Missing ","'//TRIM(type_name)// & '",T40,"(",A4,'//TRIM(sfmt)//'(",",A4),")")' @@ -3465,7 +3465,7 @@ SUBROUTINE store_FF_missing_par(atm1, atm2, atm3, atm4, type_name, fatal, array) END DO ENDIF IF (.NOT. found) THEN - nsize = nsize+1 + nsize = nsize + 1 CALL reallocate(array, 1, nsize) SELECT CASE (fmt) CASE (1) diff --git a/src/force_fields_ext.F b/src/force_fields_ext.F index 3841b1e6e8..b9f348e154 100644 --- a/src/force_fields_ext.F +++ b/src/force_fields_ext.F @@ -197,8 +197,8 @@ SUBROUTINE read_force_field_gromos(ff_type, para_env, mm_section) gro_info%bend_theta0(itype) = COS(gro_info%bend_theta0(itype)) ELSE ! Assume its G87 cost2 = COS(gro_info%bend_theta0(itype))*COS(gro_info%bend_theta0(itype)) - sdet = cost2*cost2-(2.0_dp*cost2-1.0_dp)*(1.0_dp-ekt/gro_info%bend_k(itype)) - csq = (cost2-SQRT(sdet))/(2.0_dp*cost2-1.0_dp) + sdet = cost2*cost2 - (2.0_dp*cost2 - 1.0_dp)*(1.0_dp - ekt/gro_info%bend_k(itype)) + csq = (cost2 - SQRT(sdet))/(2.0_dp*cost2 - 1.0_dp) gro_info%bend_k(itype) = ekt/ACOS(csq)**2 END IF gro_info%bend_k(itype) = cp_unit_to_cp2k(gro_info%bend_k(itype), "kjmol") @@ -271,7 +271,7 @@ SUBROUTINE read_force_field_gromos(ff_type, para_env, mm_section) gro_info%nonbond_c12_14 = 0._dp gro_info%nonbond_c6_14 = 0._dp - DO itype = 1, ntype*(ntype+1)/2 + DO itype = 1, ntype*(ntype + 1)/2 CALL parser_get_next_line(parser, 1) CALL parser_get_object(parser, iatom) CALL parser_get_object(parser, jatom) @@ -382,7 +382,7 @@ SUBROUTINE read_force_field_charmm(ff_type, para_env, mm_section) IF (ANY(string == avail_section)) EXIT CALL parser_get_object(parser, string2) CALL uppercase(string2) - nbond = nbond+1 + nbond = nbond + 1 CALL reallocate(chm_info%bond_a, 1, nbond) CALL reallocate(chm_info%bond_b, 1, nbond) CALL reallocate(chm_info%bond_k, 1, nbond) @@ -435,7 +435,7 @@ SUBROUTINE read_force_field_charmm(ff_type, para_env, mm_section) CALL parser_get_object(parser, string3) CALL uppercase(string2) CALL uppercase(string3) - nbend = nbend+1 + nbend = nbend + 1 CALL reallocate(chm_info%bend_a, 1, nbend) CALL reallocate(chm_info%bend_b, 1, nbend) CALL reallocate(chm_info%bend_c, 1, nbend) @@ -456,7 +456,7 @@ SUBROUTINE read_force_field_charmm(ff_type, para_env, mm_section) chm_info%bend_theta0(nbend) = cp_unit_to_cp2k(chm_info%bend_theta0(nbend), "deg") chm_info%bend_k(nbend) = cp_unit_to_cp2k(chm_info%bend_k(nbend), "kcalmol*rad^-2") IF (parser_test_next_token(parser) == "FLT") THEN - nub = nub+1 + nub = nub + 1 CALL reallocate(chm_info%ub_a, 1, nub) CALL reallocate(chm_info%ub_b, 1, nub) CALL reallocate(chm_info%ub_c, 1, nub) @@ -511,7 +511,7 @@ SUBROUTINE read_force_field_charmm(ff_type, para_env, mm_section) CALL uppercase(string2) CALL uppercase(string3) CALL uppercase(string4) - ntorsion = ntorsion+1 + ntorsion = ntorsion + 1 CALL reallocate(chm_info%torsion_a, 1, ntorsion) CALL reallocate(chm_info%torsion_b, 1, ntorsion) CALL reallocate(chm_info%torsion_c, 1, ntorsion) @@ -572,7 +572,7 @@ SUBROUTINE read_force_field_charmm(ff_type, para_env, mm_section) CALL uppercase(string2) CALL uppercase(string3) CALL uppercase(string4) - nimpr = nimpr+1 + nimpr = nimpr + 1 CALL reallocate(chm_info%impr_a, 1, nimpr) CALL reallocate(chm_info%impr_b, 1, nimpr) CALL reallocate(chm_info%impr_c, 1, nimpr) @@ -623,7 +623,7 @@ SUBROUTINE read_force_field_charmm(ff_type, para_env, mm_section) CALL parser_get_object(parser, string) CALL uppercase(string) IF (ANY(string == avail_section)) EXIT - nnonbond = nnonbond+1 + nnonbond = nnonbond + 1 CALL reallocate(chm_info%nonbond_a, 1, nnonbond) CALL reallocate(chm_info%nonbond_eps, 1, nnonbond) CALL reallocate(chm_info%nonbond_rmin2, 1, nnonbond) @@ -640,7 +640,7 @@ SUBROUTINE read_force_field_charmm(ff_type, para_env, mm_section) chm_info%nonbond_eps(nnonbond) = cp_unit_to_cp2k(chm_info%nonbond_eps(nnonbond), & "kcalmol") IF (parser_test_next_token(parser) == "FLT") THEN - nonfo = nonfo+1 + nonfo = nonfo + 1 CALL reallocate(chm_info%nonbond_a_14, 1, nonfo) CALL reallocate(chm_info%nonbond_eps_14, 1, nonfo) CALL reallocate(chm_info%nonbond_rmin2_14, 1, nonfo) diff --git a/src/force_fields_input.F b/src/force_fields_input.F index 94d3f37e65..3b29d768d0 100644 --- a/src/force_fields_input.F +++ b/src/force_fields_input.F @@ -156,7 +156,7 @@ SUBROUTINE read_force_field_section1(ff_section, mm_section, ff_type, para_env) CALL section_vals_get(tmp_section2, explicit=explicit, n_repetition=nlj) ntot = 0 IF (explicit) THEN - CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot+nlj, lj_charmm=.TRUE.) + CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot + nlj, lj_charmm=.TRUE.) CALL read_lj_section(inp_info%nonbonded, tmp_section2, ntot) END IF @@ -164,93 +164,93 @@ SUBROUTINE read_force_field_section1(ff_section, mm_section, ff_type, para_env) CALL section_vals_get(tmp_section2, explicit=explicit, n_repetition=nwl) ntot = nlj IF (explicit) THEN - CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot+nwl, williams=.TRUE.) + CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot + nwl, williams=.TRUE.) CALL read_wl_section(inp_info%nonbonded, tmp_section2, ntot) END IF tmp_section2 => section_vals_get_subs_vals(tmp_section, "EAM") CALL section_vals_get(tmp_section2, explicit=explicit, n_repetition=neam) - ntot = nlj+nwl + ntot = nlj + nwl IF (explicit) THEN - CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot+neam, eam=.TRUE.) + CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot + neam, eam=.TRUE.) CALL read_eam_section(inp_info%nonbonded, tmp_section2, ntot, para_env, mm_section) END IF tmp_section2 => section_vals_get_subs_vals(tmp_section, "GOODWIN") CALL section_vals_get(tmp_section2, explicit=explicit, n_repetition=ngd) - ntot = nlj+nwl+neam + ntot = nlj + nwl + neam IF (explicit) THEN - CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot+ngd, goodwin=.TRUE.) + CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot + ngd, goodwin=.TRUE.) CALL read_gd_section(inp_info%nonbonded, tmp_section2, ntot) END IF tmp_section2 => section_vals_get_subs_vals(tmp_section, "IPBV") CALL section_vals_get(tmp_section2, explicit=explicit, n_repetition=nipbv) - ntot = nlj+nwl+neam+ngd + ntot = nlj + nwl + neam + ngd IF (explicit) THEN - CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot+nipbv, ipbv=.TRUE.) + CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot + nipbv, ipbv=.TRUE.) CALL read_ipbv_section(inp_info%nonbonded, tmp_section2, ntot) END IF tmp_section2 => section_vals_get_subs_vals(tmp_section, "BMHFT") CALL section_vals_get(tmp_section2, explicit=explicit, n_repetition=nbmhft) - ntot = nlj+nwl+neam+ngd+nipbv + ntot = nlj + nwl + neam + ngd + nipbv IF (explicit) THEN - CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot+nbmhft, bmhft=.TRUE.) + CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot + nbmhft, bmhft=.TRUE.) CALL read_bmhft_section(inp_info%nonbonded, tmp_section2, ntot) END IF tmp_section2 => section_vals_get_subs_vals(tmp_section, "BMHFTD") CALL section_vals_get(tmp_section2, explicit=explicit, n_repetition=nbmhftd) - ntot = nlj+nwl+neam+ngd+nipbv+nbmhft + ntot = nlj + nwl + neam + ngd + nipbv + nbmhft IF (explicit) THEN - CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot+nbmhftd, bmhftd=.TRUE.) + CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot + nbmhftd, bmhftd=.TRUE.) CALL read_bmhftd_section(inp_info%nonbonded, tmp_section2, ntot) END IF tmp_section2 => section_vals_get_subs_vals(tmp_section, "BUCK4RANGES") CALL section_vals_get(tmp_section2, explicit=explicit, n_repetition=nb4) - ntot = nlj+nwl+neam+ngd+nipbv+nbmhft+nbmhftd + ntot = nlj + nwl + neam + ngd + nipbv + nbmhft + nbmhftd IF (explicit) THEN - CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot+nb4, buck4r=.TRUE.) + CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot + nb4, buck4r=.TRUE.) CALL read_b4_section(inp_info%nonbonded, tmp_section2, ntot) END IF tmp_section2 => section_vals_get_subs_vals(tmp_section, "BUCKMORSE") CALL section_vals_get(tmp_section2, explicit=explicit, n_repetition=nbm) - ntot = nlj+nwl+neam+ngd+nipbv+nbmhft+nbmhftd+nb4 + ntot = nlj + nwl + neam + ngd + nipbv + nbmhft + nbmhftd + nb4 IF (explicit) THEN - CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot+nbm, buckmo=.TRUE.) + CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot + nbm, buckmo=.TRUE.) CALL read_bm_section(inp_info%nonbonded, tmp_section2, ntot) END IF tmp_section2 => section_vals_get_subs_vals(tmp_section, "GENPOT") CALL section_vals_get(tmp_section2, explicit=explicit, n_repetition=ngp) - ntot = nlj+nwl+neam+ngd+nipbv+nbmhft+nbmhftd+nb4+nbm + ntot = nlj + nwl + neam + ngd + nipbv + nbmhft + nbmhftd + nb4 + nbm IF (explicit) THEN - CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot+ngp, gp=.TRUE.) + CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot + ngp, gp=.TRUE.) CALL read_gp_section(inp_info%nonbonded, tmp_section2, ntot) END IF tmp_section2 => section_vals_get_subs_vals(tmp_section, "TERSOFF") CALL section_vals_get(tmp_section2, explicit=explicit, n_repetition=ntersoff) - ntot = nlj+nwl+neam+ngd+nipbv+nbmhft+nbmhftd+nb4+nbm+ngp + ntot = nlj + nwl + neam + ngd + nipbv + nbmhft + nbmhftd + nb4 + nbm + ngp IF (explicit) THEN - CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot+ntersoff, tersoff=.TRUE.) + CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot + ntersoff, tersoff=.TRUE.) CALL read_tersoff_section(inp_info%nonbonded, tmp_section2, ntot, tmp_section2) END IF tmp_section2 => section_vals_get_subs_vals(tmp_section, "SIEPMANN") CALL section_vals_get(tmp_section2, explicit=explicit, n_repetition=nsiepmann) - ntot = nlj+nwl+neam+ngd+nipbv+nbmhft+nbmhftd+nb4+nbm+ngp+ntersoff + ntot = nlj + nwl + neam + ngd + nipbv + nbmhft + nbmhftd + nb4 + nbm + ngp + ntersoff IF (explicit) THEN - CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot+nsiepmann, siepmann=.TRUE.) + CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot + nsiepmann, siepmann=.TRUE.) CALL read_siepmann_section(inp_info%nonbonded, tmp_section2, ntot, tmp_section2) END IF tmp_section2 => section_vals_get_subs_vals(tmp_section, "quip") CALL section_vals_get(tmp_section2, explicit=explicit, n_repetition=nquip) - ntot = nlj+nwl+neam+ngd+nipbv+nbmhft+nbmhftd+nb4+nbm+ngp+ntersoff+nsiepmann + ntot = nlj + nwl + neam + ngd + nipbv + nbmhft + nbmhftd + nb4 + nbm + ngp + ntersoff + nsiepmann IF (explicit) THEN - CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot+nquip, quip=.TRUE.) + CALL pair_potential_reallocate(inp_info%nonbonded, 1, ntot + nquip, quip=.TRUE.) CALL read_quip_section(inp_info%nonbonded, tmp_section2, ntot) END IF END IF @@ -262,28 +262,28 @@ SUBROUTINE read_force_field_section1(ff_section, mm_section, ff_type, para_env) CALL section_vals_get(tmp_section2, explicit=explicit, n_repetition=nlj) ntot = 0 IF (explicit) THEN - CALL pair_potential_reallocate(inp_info%nonbonded14, 1, ntot+nlj, lj_charmm=.TRUE.) + CALL pair_potential_reallocate(inp_info%nonbonded14, 1, ntot + nlj, lj_charmm=.TRUE.) CALL read_lj_section(inp_info%nonbonded14, tmp_section2, ntot) END IF tmp_section2 => section_vals_get_subs_vals(tmp_section, "WILLIAMS") CALL section_vals_get(tmp_section2, explicit=explicit, n_repetition=nwl) ntot = nlj IF (explicit) THEN - CALL pair_potential_reallocate(inp_info%nonbonded14, 1, ntot+nwl, williams=.TRUE.) + CALL pair_potential_reallocate(inp_info%nonbonded14, 1, ntot + nwl, williams=.TRUE.) CALL read_wl_section(inp_info%nonbonded14, tmp_section2, ntot) END IF tmp_section2 => section_vals_get_subs_vals(tmp_section, "GOODWIN") CALL section_vals_get(tmp_section2, explicit=explicit, n_repetition=ngd) - ntot = nlj+nwl + ntot = nlj + nwl IF (explicit) THEN - CALL pair_potential_reallocate(inp_info%nonbonded14, 1, ntot+ngd, goodwin=.TRUE.) + CALL pair_potential_reallocate(inp_info%nonbonded14, 1, ntot + ngd, goodwin=.TRUE.) CALL read_gd_section(inp_info%nonbonded14, tmp_section2, ntot) END IF tmp_section2 => section_vals_get_subs_vals(tmp_section, "GENPOT") CALL section_vals_get(tmp_section2, explicit=explicit, n_repetition=ngp) - ntot = nlj+nwl+ngd + ntot = nlj + nwl + ngd IF (explicit) THEN - CALL pair_potential_reallocate(inp_info%nonbonded14, 1, ntot+ngp, gp=.TRUE.) + CALL pair_potential_reallocate(inp_info%nonbonded14, 1, ntot + ngp, gp=.TRUE.) CALL read_gp_section(inp_info%nonbonded14, tmp_section2, ntot) END IF END IF @@ -585,15 +585,15 @@ SUBROUTINE read_eam_section(nonbonded, section, start, para_env, mm_section) DO isec = 1, n_items CALL section_vals_val_get(section, "ATOMS", i_rep_section=isec, c_vals=atm_names) - nonbonded%pot(start+isec)%pot%type = ea_type - nonbonded%pot(start+isec)%pot%at1 = atm_names(1) - nonbonded%pot(start+isec)%pot%at2 = atm_names(2) - CALL uppercase(nonbonded%pot(start+isec)%pot%at1) - CALL uppercase(nonbonded%pot(start+isec)%pot%at2) + nonbonded%pot(start + isec)%pot%type = ea_type + nonbonded%pot(start + isec)%pot%at1 = atm_names(1) + nonbonded%pot(start + isec)%pot%at2 = atm_names(2) + CALL uppercase(nonbonded%pot(start + isec)%pot%at1) + CALL uppercase(nonbonded%pot(start + isec)%pot%at2) CALL section_vals_val_get(section, "PARM_FILE_NAME", i_rep_section=isec, & - c_val=nonbonded%pot(start+isec)%pot%set(1)%eam%eam_file_name) - CALL read_eam_data(nonbonded%pot(start+isec)%pot%set(1)%eam, para_env, mm_section) - nonbonded%pot(start+isec)%pot%rcutsq = nonbonded%pot(start+isec)%pot%set(1)%eam%acutal**2 + c_val=nonbonded%pot(start + isec)%pot%set(1)%eam%eam_file_name) + CALL read_eam_data(nonbonded%pot(start + isec)%pot%set(1)%eam, para_env, mm_section) + nonbonded%pot(start + isec)%pot%rcutsq = nonbonded%pot(start + isec)%pot%set(1)%eam%acutal**2 END DO END SUBROUTINE read_eam_section @@ -620,19 +620,19 @@ SUBROUTINE read_quip_section(nonbonded, section, start) DO isec = 1, n_items CALL section_vals_val_get(section, "ATOMS", i_rep_section=isec, c_vals=atm_names) - nonbonded%pot(start+isec)%pot%type = quip_type - nonbonded%pot(start+isec)%pot%at1 = atm_names(1) - nonbonded%pot(start+isec)%pot%at2 = atm_names(2) - CALL uppercase(nonbonded%pot(start+isec)%pot%at1) - CALL uppercase(nonbonded%pot(start+isec)%pot%at2) + nonbonded%pot(start + isec)%pot%type = quip_type + nonbonded%pot(start + isec)%pot%at1 = atm_names(1) + nonbonded%pot(start + isec)%pot%at2 = atm_names(2) + CALL uppercase(nonbonded%pot(start + isec)%pot%at1) + CALL uppercase(nonbonded%pot(start + isec)%pot%at2) CALL section_vals_val_get(section, "PARM_FILE_NAME", i_rep_section=isec, & - c_val=nonbonded%pot(start+isec)%pot%set(1)%quip%quip_file_name) + c_val=nonbonded%pot(start + isec)%pot%set(1)%quip%quip_file_name) CALL section_vals_val_get(section, "INIT_ARGS", i_rep_section=isec, & c_vals=args_str) - nonbonded%pot(start+isec)%pot%set(1)%quip%init_args = "" + nonbonded%pot(start + isec)%pot%set(1)%quip%init_args = "" DO is = 1, SIZE(args_str) - nonbonded%pot(start+isec)%pot%set(1)%quip%init_args = & - TRIM(nonbonded%pot(start+isec)%pot%set(1)%quip%init_args)// & + nonbonded%pot(start + isec)%pot%set(1)%quip%init_args = & + TRIM(nonbonded%pot(start + isec)%pot%set(1)%quip%init_args)// & " "//TRIM(args_str(is)) END DO ! is CALL section_vals_val_get(section, "CALC_ARGS", i_rep_section=isec, & @@ -641,12 +641,12 @@ SUBROUTINE read_quip_section(nonbonded, section, start) CALL section_vals_val_get(section, "CALC_ARGS", i_rep_section=isec, & c_vals=args_str) DO is = 1, SIZE(args_str) - nonbonded%pot(start+isec)%pot%set(1)%quip%calc_args = & - TRIM(nonbonded%pot(start+isec)%pot%set(1)%quip%calc_args)// & + nonbonded%pot(start + isec)%pot%set(1)%quip%calc_args = & + TRIM(nonbonded%pot(start + isec)%pot%set(1)%quip%calc_args)// & " "//TRIM(args_str(is)) END DO ! is END IF - nonbonded%pot(start+isec)%pot%rcutsq = 0.0_dp + nonbonded%pot(start + isec)%pot%rcutsq = 0.0_dp END DO END SUBROUTINE read_quip_section @@ -677,22 +677,22 @@ SUBROUTINE read_lj_section(nonbonded, section, start) CALL section_vals_val_get(section, "SIGMA", i_rep_section=isec, r_val=sigma) CALL section_vals_val_get(section, "RCUT", i_rep_section=isec, r_val=rcut) - nonbonded%pot(start+isec)%pot%type = lj_charmm_type - nonbonded%pot(start+isec)%pot%at1 = atm_names(1) - nonbonded%pot(start+isec)%pot%at2 = atm_names(2) - CALL uppercase(nonbonded%pot(start+isec)%pot%at1) - CALL uppercase(nonbonded%pot(start+isec)%pot%at2) - nonbonded%pot(start+isec)%pot%set(1)%lj%epsilon = epsilon - nonbonded%pot(start+isec)%pot%set(1)%lj%sigma6 = sigma**6 - nonbonded%pot(start+isec)%pot%set(1)%lj%sigma12 = sigma**12 - nonbonded%pot(start+isec)%pot%rcutsq = rcut*rcut + nonbonded%pot(start + isec)%pot%type = lj_charmm_type + nonbonded%pot(start + isec)%pot%at1 = atm_names(1) + nonbonded%pot(start + isec)%pot%at2 = atm_names(2) + CALL uppercase(nonbonded%pot(start + isec)%pot%at1) + CALL uppercase(nonbonded%pot(start + isec)%pot%at2) + nonbonded%pot(start + isec)%pot%set(1)%lj%epsilon = epsilon + nonbonded%pot(start + isec)%pot%set(1)%lj%sigma6 = sigma**6 + nonbonded%pot(start + isec)%pot%set(1)%lj%sigma12 = sigma**12 + nonbonded%pot(start + isec)%pot%rcutsq = rcut*rcut ! CALL section_vals_val_get(section, "RMIN", i_rep_section=isec, n_rep_val=n_rep) IF (n_rep == 1) CALL section_vals_val_get(section, "RMIN", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%rmin) + r_val=nonbonded%pot(start + isec)%pot%set(1)%rmin) CALL section_vals_val_get(section, "RMAX", i_rep_section=isec, n_rep_val=n_rep) IF (n_rep == 1) CALL section_vals_val_get(section, "RMAX", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%rmax) + r_val=nonbonded%pot(start + isec)%pot%set(1)%rmax) END DO END SUBROUTINE read_lj_section @@ -724,22 +724,22 @@ SUBROUTINE read_wl_section(nonbonded, section, start) CALL section_vals_val_get(section, "C", i_rep_section=isec, r_val=c) CALL section_vals_val_get(section, "RCUT", i_rep_section=isec, r_val=rcut) - nonbonded%pot(start+isec)%pot%type = wl_type - nonbonded%pot(start+isec)%pot%at1 = atm_names(1) - nonbonded%pot(start+isec)%pot%at2 = atm_names(2) - CALL uppercase(nonbonded%pot(start+isec)%pot%at1) - CALL uppercase(nonbonded%pot(start+isec)%pot%at2) - nonbonded%pot(start+isec)%pot%set(1)%willis%a = a - nonbonded%pot(start+isec)%pot%set(1)%willis%b = b - nonbonded%pot(start+isec)%pot%set(1)%willis%c = c - nonbonded%pot(start+isec)%pot%rcutsq = rcut*rcut + nonbonded%pot(start + isec)%pot%type = wl_type + nonbonded%pot(start + isec)%pot%at1 = atm_names(1) + nonbonded%pot(start + isec)%pot%at2 = atm_names(2) + CALL uppercase(nonbonded%pot(start + isec)%pot%at1) + CALL uppercase(nonbonded%pot(start + isec)%pot%at2) + nonbonded%pot(start + isec)%pot%set(1)%willis%a = a + nonbonded%pot(start + isec)%pot%set(1)%willis%b = b + nonbonded%pot(start + isec)%pot%set(1)%willis%c = c + nonbonded%pot(start + isec)%pot%rcutsq = rcut*rcut ! CALL section_vals_val_get(section, "RMIN", i_rep_section=isec, n_rep_val=n_rep) IF (n_rep == 1) CALL section_vals_val_get(section, "RMIN", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%rmin) + r_val=nonbonded%pot(start + isec)%pot%set(1)%rmin) CALL section_vals_val_get(section, "RMAX", i_rep_section=isec, n_rep_val=n_rep) IF (n_rep == 1) CALL section_vals_val_get(section, "RMAX", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%rmax) + r_val=nonbonded%pot(start + isec)%pot%set(1)%rmax) END DO END SUBROUTINE read_wl_section @@ -773,24 +773,24 @@ SUBROUTINE read_gd_section(nonbonded, section, start) CALL section_vals_val_get(section, "MC", i_rep_section=isec, i_val=mc) CALL section_vals_val_get(section, "RCUT", i_rep_section=isec, r_val=rcut) - nonbonded%pot(start+isec)%pot%type = gw_type - nonbonded%pot(start+isec)%pot%at1 = atm_names(1) - nonbonded%pot(start+isec)%pot%at2 = atm_names(2) - CALL uppercase(nonbonded%pot(start+isec)%pot%at1) - CALL uppercase(nonbonded%pot(start+isec)%pot%at2) - nonbonded%pot(start+isec)%pot%set(1)%goodwin%vr0 = vr0 - nonbonded%pot(start+isec)%pot%set(1)%goodwin%d = d - nonbonded%pot(start+isec)%pot%set(1)%goodwin%dc = dc - nonbonded%pot(start+isec)%pot%set(1)%goodwin%m = m - nonbonded%pot(start+isec)%pot%set(1)%goodwin%mc = mc - nonbonded%pot(start+isec)%pot%rcutsq = rcut*rcut + nonbonded%pot(start + isec)%pot%type = gw_type + nonbonded%pot(start + isec)%pot%at1 = atm_names(1) + nonbonded%pot(start + isec)%pot%at2 = atm_names(2) + CALL uppercase(nonbonded%pot(start + isec)%pot%at1) + CALL uppercase(nonbonded%pot(start + isec)%pot%at2) + nonbonded%pot(start + isec)%pot%set(1)%goodwin%vr0 = vr0 + nonbonded%pot(start + isec)%pot%set(1)%goodwin%d = d + nonbonded%pot(start + isec)%pot%set(1)%goodwin%dc = dc + nonbonded%pot(start + isec)%pot%set(1)%goodwin%m = m + nonbonded%pot(start + isec)%pot%set(1)%goodwin%mc = mc + nonbonded%pot(start + isec)%pot%rcutsq = rcut*rcut ! CALL section_vals_val_get(section, "RMIN", i_rep_section=isec, n_rep_val=n_rep) IF (n_rep == 1) CALL section_vals_val_get(section, "RMIN", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%rmin) + r_val=nonbonded%pot(start + isec)%pot%set(1)%rmin) CALL section_vals_val_get(section, "RMAX", i_rep_section=isec, n_rep_val=n_rep) IF (n_rep == 1) CALL section_vals_val_get(section, "RMAX", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%rmax) + r_val=nonbonded%pot(start + isec)%pot%set(1)%rmax) END DO END SUBROUTINE read_gd_section @@ -817,22 +817,22 @@ SUBROUTINE read_ipbv_section(nonbonded, section, start) CALL section_vals_get(section, n_repetition=n_items) DO isec = 1, n_items CALL section_vals_val_get(section, "ATOMS", i_rep_section=isec, c_vals=atm_names) - nonbonded%pot(start+isec)%pot%type = ip_type - nonbonded%pot(start+isec)%pot%at1 = atm_names(1) - nonbonded%pot(start+isec)%pot%at2 = atm_names(2) - CALL uppercase(nonbonded%pot(start+isec)%pot%at1) - CALL uppercase(nonbonded%pot(start+isec)%pot%at2) - CALL set_IPBV_ff(nonbonded%pot(start+isec)%pot%at1, nonbonded%pot(start+isec)%pot%at2, & - nonbonded%pot(start+isec)%pot%set(1)%ipbv) + nonbonded%pot(start + isec)%pot%type = ip_type + nonbonded%pot(start + isec)%pot%at1 = atm_names(1) + nonbonded%pot(start + isec)%pot%at2 = atm_names(2) + CALL uppercase(nonbonded%pot(start + isec)%pot%at1) + CALL uppercase(nonbonded%pot(start + isec)%pot%at2) + CALL set_IPBV_ff(nonbonded%pot(start + isec)%pot%at1, nonbonded%pot(start + isec)%pot%at2, & + nonbonded%pot(start + isec)%pot%set(1)%ipbv) CALL section_vals_val_get(section, "RCUT", i_rep_section=isec, r_val=rcut) - nonbonded%pot(start+isec)%pot%rcutsq = rcut**2 + nonbonded%pot(start + isec)%pot%rcutsq = rcut**2 ! CALL section_vals_val_get(section, "RMIN", i_rep_section=isec, n_rep_val=n_rep) IF (n_rep == 1) CALL section_vals_val_get(section, "RMIN", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%rmin) + r_val=nonbonded%pot(start + isec)%pot%set(1)%rmin) CALL section_vals_val_get(section, "RMAX", i_rep_section=isec, n_rep_val=n_rep) IF (n_rep == 1) CALL section_vals_val_get(section, "RMAX", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%rmax) + r_val=nonbonded%pot(start + isec)%pot%set(1)%rmax) END DO END SUBROUTINE read_ipbv_section @@ -862,38 +862,38 @@ SUBROUTINE read_bmhft_section(nonbonded, section, start) CALL cite_reference(Tosi1964a) CALL cite_reference(Tosi1964b) CALL section_vals_val_get(section, "ATOMS", i_rep_section=isec, c_vals=atm_names) - nonbonded%pot(start+isec)%pot%type = ft_type - nonbonded%pot(start+isec)%pot%at1 = atm_names(1) - nonbonded%pot(start+isec)%pot%at2 = atm_names(2) - CALL uppercase(nonbonded%pot(start+isec)%pot%at1) - CALL uppercase(nonbonded%pot(start+isec)%pot%at2) + nonbonded%pot(start + isec)%pot%type = ft_type + nonbonded%pot(start + isec)%pot%at1 = atm_names(1) + nonbonded%pot(start + isec)%pot%at2 = atm_names(2) + CALL uppercase(nonbonded%pot(start + isec)%pot%at1) + CALL uppercase(nonbonded%pot(start + isec)%pot%at2) CALL section_vals_val_get(section, "A", i_rep_section=isec, n_rep_val=i) IF (i == 1) THEN CALL section_vals_val_get(section, "A", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%ft%a) + r_val=nonbonded%pot(start + isec)%pot%set(1)%ft%a) CALL section_vals_val_get(section, "B", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%ft%b) + r_val=nonbonded%pot(start + isec)%pot%set(1)%ft%b) CALL section_vals_val_get(section, "C", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%ft%c) + r_val=nonbonded%pot(start + isec)%pot%set(1)%ft%c) CALL section_vals_val_get(section, "D", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%ft%d) + r_val=nonbonded%pot(start + isec)%pot%set(1)%ft%d) ELSE CALL section_vals_val_get(section, "MAP_ATOMS", i_rep_section=isec, c_vals=atm_names) map_atoms = atm_names CALL uppercase(map_atoms(1)) CALL uppercase(map_atoms(2)) - CALL set_BMHFT_ff(map_atoms(1), map_atoms(2), nonbonded%pot(start+isec)%pot%set(1)%ft) + CALL set_BMHFT_ff(map_atoms(1), map_atoms(2), nonbonded%pot(start + isec)%pot%set(1)%ft) END IF CALL section_vals_val_get(section, "RCUT", i_rep_section=isec, r_val=rcut) - nonbonded%pot(start+isec)%pot%rcutsq = rcut**2 + nonbonded%pot(start + isec)%pot%rcutsq = rcut**2 ! CALL section_vals_val_get(section, "RMIN", i_rep_section=isec, n_rep_val=n_rep) IF (n_rep == 1) CALL section_vals_val_get(section, "RMIN", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%rmin) + r_val=nonbonded%pot(start + isec)%pot%set(1)%rmin) CALL section_vals_val_get(section, "RMAX", i_rep_section=isec, n_rep_val=n_rep) IF (n_rep == 1) CALL section_vals_val_get(section, "RMAX", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%rmax) + r_val=nonbonded%pot(start + isec)%pot%set(1)%rmax) END DO END SUBROUTINE read_bmhft_section @@ -923,24 +923,24 @@ SUBROUTINE read_bmhftd_section(nonbonded, section, start) CALL cite_reference(Tosi1964a) CALL cite_reference(Tosi1964b) CALL section_vals_val_get(section, "ATOMS", i_rep_section=isec, c_vals=atm_names) - nonbonded%pot(start+isec)%pot%type = ftd_type - nonbonded%pot(start+isec)%pot%at1 = atm_names(1) - nonbonded%pot(start+isec)%pot%at2 = atm_names(2) - CALL uppercase(nonbonded%pot(start+isec)%pot%at1) - CALL uppercase(nonbonded%pot(start+isec)%pot%at2) + nonbonded%pot(start + isec)%pot%type = ftd_type + nonbonded%pot(start + isec)%pot%at1 = atm_names(1) + nonbonded%pot(start + isec)%pot%at2 = atm_names(2) + CALL uppercase(nonbonded%pot(start + isec)%pot%at1) + CALL uppercase(nonbonded%pot(start + isec)%pot%at2) CALL section_vals_val_get(section, "A", i_rep_section=isec, n_rep_val=i) IF (i == 1) THEN CALL section_vals_val_get(section, "A", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%ftd%a) + r_val=nonbonded%pot(start + isec)%pot%set(1)%ftd%a) CALL section_vals_val_get(section, "B", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%ftd%b) + r_val=nonbonded%pot(start + isec)%pot%set(1)%ftd%b) CALL section_vals_val_get(section, "C", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%ftd%c) + r_val=nonbonded%pot(start + isec)%pot%set(1)%ftd%c) CALL section_vals_val_get(section, "D", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%ftd%d) + r_val=nonbonded%pot(start + isec)%pot%set(1)%ftd%d) CALL section_vals_val_get(section, "BD", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%ftd%bd) + r_val=nonbonded%pot(start + isec)%pot%set(1)%ftd%bd) ELSE CALL section_vals_val_get(section, "MAP_ATOMS", i_rep_section=isec, c_vals=atm_names) @@ -950,14 +950,14 @@ SUBROUTINE read_bmhftd_section(nonbonded, section, start) CALL set_BMHFTD_ff() END IF CALL section_vals_val_get(section, "RCUT", i_rep_section=isec, r_val=rcut) - nonbonded%pot(start+isec)%pot%rcutsq = rcut**2 + nonbonded%pot(start + isec)%pot%rcutsq = rcut**2 ! CALL section_vals_val_get(section, "RMIN", i_rep_section=isec, n_rep_val=n_rep) IF (n_rep == 1) CALL section_vals_val_get(section, "RMIN", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%rmin) + r_val=nonbonded%pot(start + isec)%pot%set(1)%rmin) CALL section_vals_val_get(section, "RMAX", i_rep_section=isec, n_rep_val=n_rep) IF (n_rep == 1) CALL section_vals_val_get(section, "RMAX", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%rmax) + r_val=nonbonded%pot(start + isec)%pot%set(1)%rmax) END DO END SUBROUTINE read_bmhftd_section @@ -1009,11 +1009,11 @@ SUBROUTINE read_b4_section(nonbonded, section, start) NULLIFY (list) CALL section_vals_val_get(section, "POLY1", i_rep_val=ir, r_vals=list) IF (ASSOCIATED(list)) THEN - CALL reallocate(coeff1, 0, np1+SIZE(list)-1) + CALL reallocate(coeff1, 0, np1 + SIZE(list) - 1) DO i = 1, SIZE(list) - coeff1(i+np1-1) = list(i) + coeff1(i + np1 - 1) = list(i) END DO - np1 = np1+SIZE(list) + np1 = np1 + SIZE(list) END IF END DO END IF @@ -1024,11 +1024,11 @@ SUBROUTINE read_b4_section(nonbonded, section, start) NULLIFY (list) CALL section_vals_val_get(section, "POLY2", i_rep_val=ir, r_vals=list) IF (ASSOCIATED(list)) THEN - CALL reallocate(coeff2, 0, np2+SIZE(list)-1) + CALL reallocate(coeff2, 0, np2 + SIZE(list) - 1) DO i = 1, SIZE(list) - coeff2(i+np2-1) = list(i) + coeff2(i + np2 - 1) = list(i) END DO - np2 = np2+SIZE(list) + np2 = np2 + SIZE(list) END IF END DO END IF @@ -1040,38 +1040,38 @@ SUBROUTINE read_b4_section(nonbonded, section, start) ! Row 1: Match the 5th-order polynomial and the potential at r1 p(1, 1) = 1.0_dp DO i = 2, 6 - p(1, i) = p(1, i-1)*r1 + p(1, i) = p(1, i - 1)*r1 END DO ! Row 2: Match the first derivatives of the 5th-order polynomial and the potential at r1 DO i = 2, 6 - p(2, i) = REAL(i-1, KIND=dp)*p(1, i-1) + p(2, i) = REAL(i - 1, KIND=dp)*p(1, i - 1) END DO ! Row 3: Match the second derivatives of the 5th-order polynomial and the potential at r1 DO i = 3, 6 - p(3, i) = REAL(i-1, KIND=dp)*p(2, i-1) + p(3, i) = REAL(i - 1, KIND=dp)*p(2, i - 1) END DO ! Row 4: Match the 5th-order and the 3rd-order polynomials at r2 p(4, 1) = 1.0_dp DO i = 2, 6 - p(4, i) = p(4, i-1)*r2 + p(4, i) = p(4, i - 1)*r2 END DO p(4, 7) = -1.0_dp DO i = 8, 10 - p(4, i) = p(4, i-1)*r2 + p(4, i) = p(4, i - 1)*r2 END DO ! Row 5: Match the first derivatives of the 5th-order and the 3rd-order polynomials at r2 DO i = 2, 6 - p(5, i) = REAL(i-1, KIND=dp)*p(4, i-1) + p(5, i) = REAL(i - 1, KIND=dp)*p(4, i - 1) END DO DO i = 8, 10 - p(5, i) = REAL(i-7, KIND=dp)*p(4, i-1) + p(5, i) = REAL(i - 7, KIND=dp)*p(4, i - 1) END DO ! Row 6: Match the second derivatives of the 5th-order and the 3rd-order polynomials at r2 DO i = 3, 6 - p(6, i) = REAL(i-1, KIND=dp)*p(5, i-1) + p(6, i) = REAL(i - 1, KIND=dp)*p(5, i - 1) END DO DO i = 9, 10 - p(6, i) = REAL(i-7, KIND=dp)*p(5, i-1) + p(6, i) = REAL(i - 7, KIND=dp)*p(5, i - 1) END DO ! Row 7: Minimum at r2, ie. the first derivative of the 3rd-order polynomial has to be zero at r2 DO i = 8, 10 @@ -1080,15 +1080,15 @@ SUBROUTINE read_b4_section(nonbonded, section, start) ! Row 8: Match the 3rd-order polynomial and the potential at r3 p(8, 7) = 1.0_dp DO i = 8, 10 - p(8, i) = p(8, i-1)*r3 + p(8, i) = p(8, i - 1)*r3 END DO ! Row 9: Match the first derivatives of the 3rd-order polynomial and the potential at r3 DO i = 8, 10 - p(9, i) = REAL(i-7, KIND=dp)*p(8, i-1) + p(9, i) = REAL(i - 7, KIND=dp)*p(8, i - 1) END DO ! Row 10: Match the second derivatives of the 3rd-order polynomial and the potential at r3 DO i = 9, 10 - p(10, i) = REAL(i-7, KIND=dp)*p(9, i-1) + p(10, i) = REAL(i - 7, KIND=dp)*p(9, i - 1) END DO ! Build the vector v v(1) = a*EXP(-b*r1) @@ -1112,31 +1112,31 @@ SUBROUTINE read_b4_section(nonbonded, section, start) CALL section_vals_val_get(section, "RCUT", i_rep_section=isec, r_val=rcut) - nonbonded%pot(start+isec)%pot%type = b4_type - nonbonded%pot(start+isec)%pot%at1 = atm_names(1) - nonbonded%pot(start+isec)%pot%at2 = atm_names(2) - CALL uppercase(nonbonded%pot(start+isec)%pot%at1) - CALL uppercase(nonbonded%pot(start+isec)%pot%at2) - nonbonded%pot(start+isec)%pot%set(1)%buck4r%a = a - nonbonded%pot(start+isec)%pot%set(1)%buck4r%b = b - nonbonded%pot(start+isec)%pot%set(1)%buck4r%c = c - nonbonded%pot(start+isec)%pot%set(1)%buck4r%r1 = r1 - nonbonded%pot(start+isec)%pot%set(1)%buck4r%r2 = r2 - nonbonded%pot(start+isec)%pot%set(1)%buck4r%r3 = r3 + nonbonded%pot(start + isec)%pot%type = b4_type + nonbonded%pot(start + isec)%pot%at1 = atm_names(1) + nonbonded%pot(start + isec)%pot%at2 = atm_names(2) + CALL uppercase(nonbonded%pot(start + isec)%pot%at1) + CALL uppercase(nonbonded%pot(start + isec)%pot%at2) + nonbonded%pot(start + isec)%pot%set(1)%buck4r%a = a + nonbonded%pot(start + isec)%pot%set(1)%buck4r%b = b + nonbonded%pot(start + isec)%pot%set(1)%buck4r%c = c + nonbonded%pot(start + isec)%pot%set(1)%buck4r%r1 = r1 + nonbonded%pot(start + isec)%pot%set(1)%buck4r%r2 = r2 + nonbonded%pot(start + isec)%pot%set(1)%buck4r%r3 = r3 IF ((.NOT. explicit_poly1) .OR. (.NOT. explicit_poly2)) THEN - nonbonded%pot(start+isec)%pot%set(1)%buck4r%npoly1 = 5 - nonbonded%pot(start+isec)%pot%set(1)%buck4r%poly1(0:5) = x(1:6) - nonbonded%pot(start+isec)%pot%set(1)%buck4r%npoly2 = 3 - nonbonded%pot(start+isec)%pot%set(1)%buck4r%poly2(0:3) = x(7:10) + nonbonded%pot(start + isec)%pot%set(1)%buck4r%npoly1 = 5 + nonbonded%pot(start + isec)%pot%set(1)%buck4r%poly1(0:5) = x(1:6) + nonbonded%pot(start + isec)%pot%set(1)%buck4r%npoly2 = 3 + nonbonded%pot(start + isec)%pot%set(1)%buck4r%poly2(0:3) = x(7:10) ELSE - nonbonded%pot(start+isec)%pot%set(1)%buck4r%npoly1 = np1-1 - CPASSERT(np1-1 <= 10) - nonbonded%pot(start+isec)%pot%set(1)%buck4r%poly1(0:np1-1) = coeff1(0:np1-1) - nonbonded%pot(start+isec)%pot%set(1)%buck4r%npoly2 = np2-1 - CPASSERT(np2-1 <= 10) - nonbonded%pot(start+isec)%pot%set(1)%buck4r%poly2(0:np2-1) = coeff2(0:np2-1) + nonbonded%pot(start + isec)%pot%set(1)%buck4r%npoly1 = np1 - 1 + CPASSERT(np1 - 1 <= 10) + nonbonded%pot(start + isec)%pot%set(1)%buck4r%poly1(0:np1 - 1) = coeff1(0:np1 - 1) + nonbonded%pot(start + isec)%pot%set(1)%buck4r%npoly2 = np2 - 1 + CPASSERT(np2 - 1 <= 10) + nonbonded%pot(start + isec)%pot%set(1)%buck4r%poly2(0:np2 - 1) = coeff2(0:np2 - 1) END IF - nonbonded%pot(start+isec)%pot%rcutsq = rcut*rcut + nonbonded%pot(start + isec)%pot%rcutsq = rcut*rcut IF (ASSOCIATED(coeff1)) THEN DEALLOCATE (coeff1) @@ -1146,10 +1146,10 @@ SUBROUTINE read_b4_section(nonbonded, section, start) END IF CALL section_vals_val_get(section, "RMIN", i_rep_section=isec, n_rep_val=n_rep) IF (n_rep == 1) CALL section_vals_val_get(section, "RMIN", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%rmin) + r_val=nonbonded%pot(start + isec)%pot%set(1)%rmin) CALL section_vals_val_get(section, "RMAX", i_rep_section=isec, n_rep_val=n_rep) IF (n_rep == 1) CALL section_vals_val_get(section, "RMAX", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%rmax) + r_val=nonbonded%pot(start + isec)%pot%set(1)%rmax) END DO END SUBROUTINE read_b4_section @@ -1179,25 +1179,25 @@ SUBROUTINE read_gp_section(nonbonded, section, start) NULLIFY (atm_names) CALL section_vals_val_get(section, "ATOMS", i_rep_section=isec, c_vals=atm_names) CALL section_vals_val_get(section, "RCUT", i_rep_section=isec, r_val=rcut) - nonbonded%pot(start+isec)%pot%type = gp_type - nonbonded%pot(start+isec)%pot%at1 = atm_names(1) - nonbonded%pot(start+isec)%pot%at2 = atm_names(2) - nonbonded%pot(start+isec)%pot%rcutsq = rcut*rcut - CALL uppercase(nonbonded%pot(start+isec)%pot%at1) - CALL uppercase(nonbonded%pot(start+isec)%pot%at2) + nonbonded%pot(start + isec)%pot%type = gp_type + nonbonded%pot(start + isec)%pot%at1 = atm_names(1) + nonbonded%pot(start + isec)%pot%at2 = atm_names(2) + nonbonded%pot(start + isec)%pot%rcutsq = rcut*rcut + CALL uppercase(nonbonded%pot(start + isec)%pot%at1) + CALL uppercase(nonbonded%pot(start + isec)%pot%at2) ! Parse the genpot info - CALL get_generic_info(section, "FUNCTION", nonbonded%pot(start+isec)%pot%set(1)%gp%potential, & - nonbonded%pot(start+isec)%pot%set(1)%gp%parameters, & - nonbonded%pot(start+isec)%pot%set(1)%gp%values, & + CALL get_generic_info(section, "FUNCTION", nonbonded%pot(start + isec)%pot%set(1)%gp%potential, & + nonbonded%pot(start + isec)%pot%set(1)%gp%parameters, & + nonbonded%pot(start + isec)%pot%set(1)%gp%values, & size_variables=1, i_rep_sec=isec) - nonbonded%pot(start+isec)%pot%set(1)%gp%variables = nonbonded%pot(start+isec)%pot%set(1)%gp%parameters(1) + nonbonded%pot(start + isec)%pot%set(1)%gp%variables = nonbonded%pot(start + isec)%pot%set(1)%gp%parameters(1) ! CALL section_vals_val_get(section, "RMIN", i_rep_section=isec, n_rep_val=n_rep) IF (n_rep == 1) CALL section_vals_val_get(section, "RMIN", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%rmin) + r_val=nonbonded%pot(start + isec)%pot%set(1)%rmin) CALL section_vals_val_get(section, "RMAX", i_rep_section=isec, n_rep_val=n_rep) IF (n_rep == 1) CALL section_vals_val_get(section, "RMAX", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%rmax) + r_val=nonbonded%pot(start + isec)%pot%set(1)%rmax) END DO END SUBROUTINE read_gp_section @@ -1228,49 +1228,49 @@ SUBROUTINE read_tersoff_section(nonbonded, section, start, tersoff_section) CALL cite_reference(Tersoff1988) CALL section_vals_val_get(section, "ATOMS", i_rep_section=isec, c_vals=atm_names) - nonbonded%pot(start+isec)%pot%type = tersoff_type - nonbonded%pot(start+isec)%pot%at1 = atm_names(1) - nonbonded%pot(start+isec)%pot%at2 = atm_names(2) - CALL uppercase(nonbonded%pot(start+isec)%pot%at1) - CALL uppercase(nonbonded%pot(start+isec)%pot%at2) + nonbonded%pot(start + isec)%pot%type = tersoff_type + nonbonded%pot(start + isec)%pot%at1 = atm_names(1) + nonbonded%pot(start + isec)%pot%at2 = atm_names(2) + CALL uppercase(nonbonded%pot(start + isec)%pot%at1) + CALL uppercase(nonbonded%pot(start + isec)%pot%at2) CALL section_vals_val_get(tersoff_section, "A", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%tersoff%A) + r_val=nonbonded%pot(start + isec)%pot%set(1)%tersoff%A) CALL section_vals_val_get(tersoff_section, "B", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%tersoff%B) + r_val=nonbonded%pot(start + isec)%pot%set(1)%tersoff%B) CALL section_vals_val_get(tersoff_section, "lambda1", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%tersoff%lambda1) + r_val=nonbonded%pot(start + isec)%pot%set(1)%tersoff%lambda1) CALL section_vals_val_get(tersoff_section, "lambda2", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%tersoff%lambda2) + r_val=nonbonded%pot(start + isec)%pot%set(1)%tersoff%lambda2) CALL section_vals_val_get(tersoff_section, "alpha", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%tersoff%alpha) + r_val=nonbonded%pot(start + isec)%pot%set(1)%tersoff%alpha) CALL section_vals_val_get(tersoff_section, "beta", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%tersoff%beta) + r_val=nonbonded%pot(start + isec)%pot%set(1)%tersoff%beta) CALL section_vals_val_get(tersoff_section, "n", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%tersoff%n) + r_val=nonbonded%pot(start + isec)%pot%set(1)%tersoff%n) CALL section_vals_val_get(tersoff_section, "c", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%tersoff%c) + r_val=nonbonded%pot(start + isec)%pot%set(1)%tersoff%c) CALL section_vals_val_get(tersoff_section, "d", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%tersoff%d) + r_val=nonbonded%pot(start + isec)%pot%set(1)%tersoff%d) CALL section_vals_val_get(tersoff_section, "h", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%tersoff%h) + r_val=nonbonded%pot(start + isec)%pot%set(1)%tersoff%h) CALL section_vals_val_get(tersoff_section, "lambda3", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%tersoff%lambda3) + r_val=nonbonded%pot(start + isec)%pot%set(1)%tersoff%lambda3) CALL section_vals_val_get(tersoff_section, "bigR", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%tersoff%bigR) + r_val=nonbonded%pot(start + isec)%pot%set(1)%tersoff%bigR) CALL section_vals_val_get(tersoff_section, "bigD", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%tersoff%bigD) + r_val=nonbonded%pot(start + isec)%pot%set(1)%tersoff%bigD) - rcutsq = (nonbonded%pot(start+isec)%pot%set(1)%tersoff%bigR+ & - nonbonded%pot(start+isec)%pot%set(1)%tersoff%bigD)**2 - nonbonded%pot(start+isec)%pot%set(1)%tersoff%rcutsq = rcutsq - nonbonded%pot(start+isec)%pot%rcutsq = rcutsq + rcutsq = (nonbonded%pot(start + isec)%pot%set(1)%tersoff%bigR + & + nonbonded%pot(start + isec)%pot%set(1)%tersoff%bigD)**2 + nonbonded%pot(start + isec)%pot%set(1)%tersoff%rcutsq = rcutsq + nonbonded%pot(start + isec)%pot%rcutsq = rcutsq ! In case it is defined override the standard specification of RCUT CALL section_vals_val_get(tersoff_section, "RCUT", i_rep_section=isec, n_rep_val=n_rep) IF (n_rep == 1) THEN CALL section_vals_val_get(tersoff_section, "RCUT", i_rep_section=isec, r_val=rcut) - nonbonded%pot(start+isec)%pot%rcutsq = rcut**2 + nonbonded%pot(start + isec)%pot%rcutsq = rcut**2 END IF END DO END SUBROUTINE read_tersoff_section @@ -1302,35 +1302,35 @@ SUBROUTINE read_siepmann_section(nonbonded, section, start, siepmann_section) CALL cite_reference(Siepmann1995) CALL section_vals_val_get(section, "ATOMS", i_rep_section=isec, c_vals=atm_names) - nonbonded%pot(start+isec)%pot%type = siepmann_type - nonbonded%pot(start+isec)%pot%at1 = atm_names(1) - nonbonded%pot(start+isec)%pot%at2 = atm_names(2) - CALL uppercase(nonbonded%pot(start+isec)%pot%at1) - CALL uppercase(nonbonded%pot(start+isec)%pot%at2) + nonbonded%pot(start + isec)%pot%type = siepmann_type + nonbonded%pot(start + isec)%pot%at1 = atm_names(1) + nonbonded%pot(start + isec)%pot%at2 = atm_names(2) + CALL uppercase(nonbonded%pot(start + isec)%pot%at1) + CALL uppercase(nonbonded%pot(start + isec)%pot%at2) CALL section_vals_val_get(siepmann_section, "B", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%siepmann%B) + r_val=nonbonded%pot(start + isec)%pot%set(1)%siepmann%B) CALL section_vals_val_get(siepmann_section, "D", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%siepmann%D) + r_val=nonbonded%pot(start + isec)%pot%set(1)%siepmann%D) CALL section_vals_val_get(siepmann_section, "E", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%siepmann%E) + r_val=nonbonded%pot(start + isec)%pot%set(1)%siepmann%E) CALL section_vals_val_get(siepmann_section, "F", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%siepmann%F) + r_val=nonbonded%pot(start + isec)%pot%set(1)%siepmann%F) CALL section_vals_val_get(siepmann_section, "beta", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%siepmann%beta) + r_val=nonbonded%pot(start + isec)%pot%set(1)%siepmann%beta) CALL section_vals_val_get(siepmann_section, "ALLOW_OH_FORMATION", i_rep_section=isec, & - l_val=nonbonded%pot(start+isec)%pot%set(1)%siepmann%allow_oh_formation) + l_val=nonbonded%pot(start + isec)%pot%set(1)%siepmann%allow_oh_formation) CALL section_vals_val_get(siepmann_section, "ALLOW_H3O_FORMATION", i_rep_section=isec, & - l_val=nonbonded%pot(start+isec)%pot%set(1)%siepmann%allow_h3o_formation) + l_val=nonbonded%pot(start + isec)%pot%set(1)%siepmann%allow_h3o_formation) CALL section_vals_val_get(siepmann_section, "ALLOW_O_FORMATION", i_rep_section=isec, & - l_val=nonbonded%pot(start+isec)%pot%set(1)%siepmann%allow_o_formation) + l_val=nonbonded%pot(start + isec)%pot%set(1)%siepmann%allow_o_formation) ! ! In case it is defined override the standard specification of RCUT CALL section_vals_val_get(siepmann_section, "RCUT", i_rep_section=isec, n_rep_val=n_rep) IF (n_rep == 1) THEN CALL section_vals_val_get(siepmann_section, "RCUT", i_rep_section=isec, r_val=rcut) - nonbonded%pot(start+isec)%pot%rcutsq = rcut**2 - nonbonded%pot(start+isec)%pot%set(1)%siepmann%rcutsq = rcut**2 + nonbonded%pot(start + isec)%pot%rcutsq = rcut**2 + nonbonded%pot(start + isec)%pot%set(1)%siepmann%rcutsq = rcut**2 END IF END DO END SUBROUTINE read_siepmann_section @@ -1370,28 +1370,28 @@ SUBROUTINE read_bm_section(nonbonded, section, start) CALL section_vals_val_get(section, "Beta", i_rep_section=isec, r_val=beta) CALL section_vals_val_get(section, "RCUT", i_rep_section=isec, r_val=rcut) - nonbonded%pot(start+isec)%pot%type = bm_type - nonbonded%pot(start+isec)%pot%at1 = atm_names(1) - nonbonded%pot(start+isec)%pot%at2 = atm_names(2) - CALL uppercase(nonbonded%pot(start+isec)%pot%at1) - CALL uppercase(nonbonded%pot(start+isec)%pot%at2) - nonbonded%pot(start+isec)%pot%set(1)%buckmo%f0 = f0 - nonbonded%pot(start+isec)%pot%set(1)%buckmo%a1 = a1 - nonbonded%pot(start+isec)%pot%set(1)%buckmo%a2 = a2 - nonbonded%pot(start+isec)%pot%set(1)%buckmo%b1 = b1 - nonbonded%pot(start+isec)%pot%set(1)%buckmo%b2 = b2 - nonbonded%pot(start+isec)%pot%set(1)%buckmo%c = c - nonbonded%pot(start+isec)%pot%set(1)%buckmo%d = d - nonbonded%pot(start+isec)%pot%set(1)%buckmo%r0 = r0 - nonbonded%pot(start+isec)%pot%set(1)%buckmo%beta = beta - nonbonded%pot(start+isec)%pot%rcutsq = rcut*rcut + nonbonded%pot(start + isec)%pot%type = bm_type + nonbonded%pot(start + isec)%pot%at1 = atm_names(1) + nonbonded%pot(start + isec)%pot%at2 = atm_names(2) + CALL uppercase(nonbonded%pot(start + isec)%pot%at1) + CALL uppercase(nonbonded%pot(start + isec)%pot%at2) + nonbonded%pot(start + isec)%pot%set(1)%buckmo%f0 = f0 + nonbonded%pot(start + isec)%pot%set(1)%buckmo%a1 = a1 + nonbonded%pot(start + isec)%pot%set(1)%buckmo%a2 = a2 + nonbonded%pot(start + isec)%pot%set(1)%buckmo%b1 = b1 + nonbonded%pot(start + isec)%pot%set(1)%buckmo%b2 = b2 + nonbonded%pot(start + isec)%pot%set(1)%buckmo%c = c + nonbonded%pot(start + isec)%pot%set(1)%buckmo%d = d + nonbonded%pot(start + isec)%pot%set(1)%buckmo%r0 = r0 + nonbonded%pot(start + isec)%pot%set(1)%buckmo%beta = beta + nonbonded%pot(start + isec)%pot%rcutsq = rcut*rcut ! CALL section_vals_val_get(section, "RMIN", i_rep_section=isec, n_rep_val=n_rep) IF (n_rep == 1) CALL section_vals_val_get(section, "RMIN", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%rmin) + r_val=nonbonded%pot(start + isec)%pot%set(1)%rmin) CALL section_vals_val_get(section, "RMAX", i_rep_section=isec, n_rep_val=n_rep) IF (n_rep == 1) CALL section_vals_val_get(section, "RMAX", i_rep_section=isec, & - r_val=nonbonded%pot(start+isec)%pot%set(1)%rmax) + r_val=nonbonded%pot(start + isec)%pot%set(1)%rmax) END DO END SUBROUTINE read_bm_section @@ -1419,9 +1419,9 @@ SUBROUTINE read_chrg_section(charge_atm, charge, section, start) CALL section_vals_get(section, n_repetition=n_items) DO isec = 1, n_items CALL section_vals_val_get(section, "ATOM", i_rep_section=isec, c_val=atm_name) - charge_atm(start+isec) = atm_name - CALL uppercase(charge_atm(start+isec)) - CALL section_vals_val_get(section, "CHARGE", i_rep_section=isec, r_val=charge(start+isec)) + charge_atm(start + isec) = atm_name + CALL uppercase(charge_atm(start + isec)) + CALL section_vals_val_get(section, "CHARGE", i_rep_section=isec, r_val=charge(start + isec)) END DO END SUBROUTINE read_chrg_section @@ -1459,7 +1459,7 @@ SUBROUTINE read_apol_section(apol_atm, apol, damping_list, section, & tmp_section => section_vals_get_subs_vals(section, "DAMPING", & i_rep_section=isec) CALL section_vals_get(tmp_section, n_repetition=tmp_damp) - n_damp = n_damp+tmp_damp + n_damp = n_damp + tmp_damp END DO @@ -1471,32 +1471,32 @@ SUBROUTINE read_apol_section(apol_atm, apol, damping_list, section, & start_damp = 0 DO isec = 1, n_items CALL section_vals_val_get(section, "ATOM", i_rep_section=isec, c_val=atm_name) - apol_atm(start+isec) = atm_name - CALL uppercase(apol_atm(start+isec)) - CALL section_vals_val_get(section, "APOL", i_rep_section=isec, r_val=apol(start+isec)) + apol_atm(start + isec) = atm_name + CALL uppercase(apol_atm(start + isec)) + CALL section_vals_val_get(section, "APOL", i_rep_section=isec, r_val=apol(start + isec)) tmp_section => section_vals_get_subs_vals(section, "DAMPING", & i_rep_section=isec) CALL section_vals_get(tmp_section, n_repetition=tmp_damp) DO isec_damp = 1, tmp_damp - damping_list(start_damp+isec_damp)%atm_name1 = apol_atm(start+isec) + damping_list(start_damp + isec_damp)%atm_name1 = apol_atm(start + isec) CALL section_vals_val_get(tmp_section, "ATOM", i_rep_section=isec_damp, & c_val=atm_name) - damping_list(start_damp+isec_damp)%atm_name2 = atm_name - CALL uppercase(damping_list(start_damp+isec_damp)%atm_name2) + damping_list(start_damp + isec_damp)%atm_name2 = atm_name + CALL uppercase(damping_list(start_damp + isec_damp)%atm_name2) CALL section_vals_val_get(tmp_section, "TYPE", i_rep_section=isec_damp, & c_val=atm_name) - damping_list(start_damp+isec_damp)%dtype = atm_name - CALL uppercase(damping_list(start_damp+isec_damp)%dtype) + damping_list(start_damp + isec_damp)%dtype = atm_name + CALL uppercase(damping_list(start_damp + isec_damp)%dtype) CALL section_vals_val_get(tmp_section, "ORDER", i_rep_section=isec_damp, & - i_val=damping_list(start_damp+isec_damp)%order) + i_val=damping_list(start_damp + isec_damp)%order) CALL section_vals_val_get(tmp_section, "BIJ", i_rep_section=isec_damp, & - r_val=damping_list(start_damp+isec_damp)%bij) + r_val=damping_list(start_damp + isec_damp)%bij) CALL section_vals_val_get(tmp_section, "CIJ", i_rep_section=isec_damp, & - r_val=damping_list(start_damp+isec_damp)%cij) + r_val=damping_list(start_damp + isec_damp)%cij) END DO - start_damp = start_damp+tmp_damp + start_damp = start_damp + tmp_damp END DO @@ -1526,9 +1526,9 @@ SUBROUTINE read_cpol_section(cpol_atm, cpol, section, start) CALL section_vals_get(section, n_repetition=n_items) DO isec = 1, n_items CALL section_vals_val_get(section, "ATOM", i_rep_section=isec, c_val=atm_name) - cpol_atm(start+isec) = atm_name - CALL uppercase(cpol_atm(start+isec)) - CALL section_vals_val_get(section, "CPOL", i_rep_section=isec, r_val=cpol(start+isec)) + cpol_atm(start + isec) = atm_name + CALL uppercase(cpol_atm(start + isec)) + CALL section_vals_val_get(section, "CPOL", i_rep_section=isec, r_val=cpol(start + isec)) END DO END SUBROUTINE read_cpol_section @@ -1559,31 +1559,31 @@ SUBROUTINE read_shell_section(shell_list, section, start) CALL section_vals_val_get(section, "_SECTION_PARAMETERS_", & c_val=atm_name, i_rep_section=i_rep) CALL uppercase(atm_name) - shell_list(start+i_rep)%atm_name = atm_name + shell_list(start + i_rep)%atm_name = atm_name CALL section_vals_val_get(section, "CORE_CHARGE", i_rep_section=i_rep, r_val=ccharge) - shell_list(start+i_rep)%shell%charge_core = ccharge + shell_list(start + i_rep)%shell%charge_core = ccharge CALL section_vals_val_get(section, "SHELL_CHARGE", i_rep_section=i_rep, r_val=scharge) - shell_list(start+i_rep)%shell%charge_shell = scharge + shell_list(start + i_rep)%shell%charge_shell = scharge CALL section_vals_val_get(section, "MASS_FRACTION", i_rep_section=i_rep, r_val=mfrac) - shell_list(start+i_rep)%shell%massfrac = mfrac + shell_list(start + i_rep)%shell%massfrac = mfrac CALL section_vals_val_get(section, "K2_SPRING", i_rep_section=i_rep, r_val=k) IF (k < 0.0_dp) THEN CALL cp_abort(__LOCATION__, & "An invalid value was specified for the force constant k2 of the core-shell "// & "spring potential") END IF - shell_list(start+i_rep)%shell%k2_spring = k + shell_list(start + i_rep)%shell%k2_spring = k CALL section_vals_val_get(section, "K4_SPRING", i_rep_section=i_rep, r_val=k) IF (k < 0.0_dp) THEN CALL cp_abort(__LOCATION__, & "An invalid value was specified for the force constant k4 of the core-shell "// & "spring potential") END IF - shell_list(start+i_rep)%shell%k4_spring = k + shell_list(start + i_rep)%shell%k4_spring = k CALL section_vals_val_get(section, "MAX_DISTANCE", i_rep_section=i_rep, r_val=maxdist) - shell_list(start+i_rep)%shell%max_dist = maxdist + shell_list(start + i_rep)%shell%max_dist = maxdist CALL section_vals_val_get(section, "SHELL_CUTOFF", i_rep_section=i_rep, r_val=cutoff) - shell_list(start+i_rep)%shell%shell_cutoff = cutoff + shell_list(start + i_rep)%shell%shell_cutoff = cutoff END DO END SUBROUTINE read_shell_section @@ -1620,20 +1620,20 @@ SUBROUTINE read_bonds_section(bond_kind, bond_a, bond_b, bond_k, bond_r0, bond_c NULLIFY (Kvals, atm_names) CALL section_vals_get(section, n_repetition=n_items) DO isec = 1, n_items - CALL section_vals_val_get(section, "KIND", i_rep_section=isec, i_val=bond_kind(start+isec)) + CALL section_vals_val_get(section, "KIND", i_rep_section=isec, i_val=bond_kind(start + isec)) CALL section_vals_val_get(section, "ATOMS", i_rep_section=isec, c_vals=atm_names) - bond_a(start+isec) = atm_names(1) - bond_b(start+isec) = atm_names(2) - CALL uppercase(bond_a(start+isec)) - CALL uppercase(bond_b(start+isec)) + bond_a(start + isec) = atm_names(1) + bond_b(start + isec) = atm_names(2) + CALL uppercase(bond_a(start + isec)) + CALL uppercase(bond_b(start + isec)) CALL section_vals_val_get(section, "K", i_rep_section=isec, r_vals=Kvals) CPASSERT(SIZE(Kvals) <= 3) - bond_k(:, start+isec) = 0.0_dp + bond_k(:, start + isec) = 0.0_dp DO k = 1, SIZE(Kvals) - bond_k(k, start+isec) = Kvals(k) + bond_k(k, start + isec) = Kvals(k) END DO - CALL section_vals_val_get(section, "R0", i_rep_section=isec, r_val=bond_r0(start+isec)) - CALL section_vals_val_get(section, "CS", i_rep_section=isec, r_val=bond_cs(start+isec)) + CALL section_vals_val_get(section, "R0", i_rep_section=isec, r_val=bond_r0(start + isec)) + CALL section_vals_val_get(section, "CS", i_rep_section=isec, r_val=bond_cs(start + isec)) END DO END SUBROUTINE read_bonds_section @@ -1681,34 +1681,34 @@ SUBROUTINE read_bends_section(bend_kind, bend_a, bend_b, bend_c, bend_k, bend_th CALL section_vals_get(section, n_repetition=n_items) bend_legendre%order = 0 DO isec = 1, n_items - CALL section_vals_val_get(section, "KIND", i_rep_section=isec, i_val=bend_kind(start+isec)) + CALL section_vals_val_get(section, "KIND", i_rep_section=isec, i_val=bend_kind(start + isec)) CALL section_vals_val_get(section, "ATOMS", i_rep_section=isec, c_vals=atm_names) - bend_a(start+isec) = atm_names(1) - bend_b(start+isec) = atm_names(2) - bend_c(start+isec) = atm_names(3) - CALL uppercase(bend_a(start+isec)) - CALL uppercase(bend_b(start+isec)) - CALL uppercase(bend_c(start+isec)) + bend_a(start + isec) = atm_names(1) + bend_b(start + isec) = atm_names(2) + bend_c(start + isec) = atm_names(3) + CALL uppercase(bend_a(start + isec)) + CALL uppercase(bend_b(start + isec)) + CALL uppercase(bend_c(start + isec)) CALL section_vals_val_get(section, "K", i_rep_section=isec, r_vals=Kvals) CPASSERT(SIZE(Kvals) == 1) - bend_k(start+isec) = Kvals(1) - CALL section_vals_val_get(section, "THETA0", i_rep_section=isec, r_val=bend_theta0(start+isec)) - CALL section_vals_val_get(section, "CB", i_rep_section=isec, r_val=bend_cb(start+isec)) - CALL section_vals_val_get(section, "R012", i_rep_section=isec, r_val=bend_r012(start+isec)) - CALL section_vals_val_get(section, "R032", i_rep_section=isec, r_val=bend_r032(start+isec)) - CALL section_vals_val_get(section, "KBS12", i_rep_section=isec, r_val=bend_kbs12(start+isec)) - CALL section_vals_val_get(section, "KBS32", i_rep_section=isec, r_val=bend_kbs32(start+isec)) - CALL section_vals_val_get(section, "KSS", i_rep_section=isec, r_val=bend_kss(start+isec)) + bend_k(start + isec) = Kvals(1) + CALL section_vals_val_get(section, "THETA0", i_rep_section=isec, r_val=bend_theta0(start + isec)) + CALL section_vals_val_get(section, "CB", i_rep_section=isec, r_val=bend_cb(start + isec)) + CALL section_vals_val_get(section, "R012", i_rep_section=isec, r_val=bend_r012(start + isec)) + CALL section_vals_val_get(section, "R032", i_rep_section=isec, r_val=bend_r032(start + isec)) + CALL section_vals_val_get(section, "KBS12", i_rep_section=isec, r_val=bend_kbs12(start + isec)) + CALL section_vals_val_get(section, "KBS32", i_rep_section=isec, r_val=bend_kbs32(start + isec)) + CALL section_vals_val_get(section, "KSS", i_rep_section=isec, r_val=bend_kss(start + isec)) ! get legendre based data CALL section_vals_val_get(section, "LEGENDRE", i_rep_section=isec, n_rep_val=n_rep) DO k = 1, n_rep CALL section_vals_val_get(section, "LEGENDRE", i_rep_val=k, r_vals=r_values, i_rep_section=isec) - bend_legendre(start+isec)%order = SIZE(r_values) - IF (ASSOCIATED(bend_legendre(start+isec)%coeffs)) THEN - DEALLOCATE (bend_legendre(start+isec)%coeffs) + bend_legendre(start + isec)%order = SIZE(r_values) + IF (ASSOCIATED(bend_legendre(start + isec)%coeffs)) THEN + DEALLOCATE (bend_legendre(start + isec)%coeffs) END IF - ALLOCATE (bend_legendre(start+isec)%coeffs(bend_legendre(start+isec)%order)) - bend_legendre(start+isec)%coeffs = r_values + ALLOCATE (bend_legendre(start + isec)%coeffs(bend_legendre(start + isec)%order)) + bend_legendre(start + isec)%coeffs = r_values END DO END DO END SUBROUTINE read_bends_section @@ -1749,21 +1749,21 @@ SUBROUTINE read_ubs_section(ub_kind, ub_a, ub_b, ub_c, ub_k, ub_r0, section, sta subsection => section_vals_get_subs_vals(section, "UB", i_rep_section=isec) CALL section_vals_get(subsection, explicit=explicit) IF (explicit) THEN - CALL section_vals_val_get(subsection, "KIND", i_val=ub_kind(start+isec)) + CALL section_vals_val_get(subsection, "KIND", i_val=ub_kind(start + isec)) CALL section_vals_val_get(section, "ATOMS", i_rep_section=isec, c_vals=atm_names) - ub_a(start+isec) = atm_names(1) - ub_b(start+isec) = atm_names(2) - ub_c(start+isec) = atm_names(3) - CALL uppercase(ub_a(start+isec)) - CALL uppercase(ub_b(start+isec)) - CALL uppercase(ub_c(start+isec)) + ub_a(start + isec) = atm_names(1) + ub_b(start + isec) = atm_names(2) + ub_c(start + isec) = atm_names(3) + CALL uppercase(ub_a(start + isec)) + CALL uppercase(ub_b(start + isec)) + CALL uppercase(ub_c(start + isec)) CALL section_vals_val_get(subsection, "K", r_vals=Kvals) CPASSERT(SIZE(Kvals) <= 3) - ub_k(:, start+isec) = 0.0_dp + ub_k(:, start + isec) = 0.0_dp DO k = 1, SIZE(Kvals) - ub_k(k, start+isec) = Kvals(k) + ub_k(k, start + isec) = Kvals(k) END DO - CALL section_vals_val_get(subsection, "R0", r_val=ub_r0(start+isec)) + CALL section_vals_val_get(subsection, "R0", r_val=ub_r0(start + isec)) END IF END DO END SUBROUTINE read_ubs_section @@ -1803,31 +1803,31 @@ SUBROUTINE read_torsions_section(torsion_kind, torsion_a, torsion_b, torsion_c, NULLIFY (atm_names) CALL section_vals_get(section, n_repetition=n_items) DO isec = 1, n_items - CALL section_vals_val_get(section, "KIND", i_rep_section=isec, i_val=torsion_kind(start+isec)) + CALL section_vals_val_get(section, "KIND", i_rep_section=isec, i_val=torsion_kind(start + isec)) CALL section_vals_val_get(section, "ATOMS", i_rep_section=isec, c_vals=atm_names) - torsion_a(start+isec) = atm_names(1) - torsion_b(start+isec) = atm_names(2) - torsion_c(start+isec) = atm_names(3) - torsion_d(start+isec) = atm_names(4) - CALL uppercase(torsion_a(start+isec)) - CALL uppercase(torsion_b(start+isec)) - CALL uppercase(torsion_c(start+isec)) - CALL uppercase(torsion_d(start+isec)) - CALL section_vals_val_get(section, "K", i_rep_section=isec, r_val=torsion_k(start+isec)) - CALL section_vals_val_get(section, "PHI0", i_rep_section=isec, r_val=torsion_phi0(start+isec)) - CALL section_vals_val_get(section, "M", i_rep_section=isec, i_val=torsion_m(start+isec)) + torsion_a(start + isec) = atm_names(1) + torsion_b(start + isec) = atm_names(2) + torsion_c(start + isec) = atm_names(3) + torsion_d(start + isec) = atm_names(4) + CALL uppercase(torsion_a(start + isec)) + CALL uppercase(torsion_b(start + isec)) + CALL uppercase(torsion_c(start + isec)) + CALL uppercase(torsion_d(start + isec)) + CALL section_vals_val_get(section, "K", i_rep_section=isec, r_val=torsion_k(start + isec)) + CALL section_vals_val_get(section, "PHI0", i_rep_section=isec, r_val=torsion_phi0(start + isec)) + CALL section_vals_val_get(section, "M", i_rep_section=isec, i_val=torsion_m(start + isec)) ! Modify parameterisation for OPLS case - IF (torsion_kind(start+isec) .EQ. do_ff_opls) THEN - IF (torsion_phi0(start+isec) .NE. 0.0_dp) THEN + IF (torsion_kind(start + isec) .EQ. do_ff_opls) THEN + IF (torsion_phi0(start + isec) .NE. 0.0_dp) THEN CALL cp_warn(__LOCATION__, "PHI0 parameter was non-zero "// & "for an OPLS-type TORSION. It will be ignored.") ENDIF - IF (MODULO(torsion_m(start+isec), 2) .EQ. 0) THEN + IF (MODULO(torsion_m(start + isec), 2) .EQ. 0) THEN ! For even M, negate the cosine using a Pi phase factor - torsion_phi0(start+isec) = pi + torsion_phi0(start + isec) = pi ENDIF ! the K parameter appears as K/2 in the OPLS parameterisation - torsion_k(start+isec) = torsion_k(start+isec)*0.5_dp + torsion_k(start + isec) = torsion_k(start + isec)*0.5_dp END IF END DO END SUBROUTINE read_torsions_section @@ -1864,18 +1864,18 @@ SUBROUTINE read_improper_section(impr_kind, impr_a, impr_b, impr_c, impr_d, impr NULLIFY (atm_names) CALL section_vals_get(section, n_repetition=n_items) DO isec = 1, n_items - CALL section_vals_val_get(section, "KIND", i_rep_section=isec, i_val=impr_kind(start+isec)) + CALL section_vals_val_get(section, "KIND", i_rep_section=isec, i_val=impr_kind(start + isec)) CALL section_vals_val_get(section, "ATOMS", i_rep_section=isec, c_vals=atm_names) - impr_a(start+isec) = atm_names(1) - impr_b(start+isec) = atm_names(2) - impr_c(start+isec) = atm_names(3) - impr_d(start+isec) = atm_names(4) - CALL uppercase(impr_a(start+isec)) - CALL uppercase(impr_b(start+isec)) - CALL uppercase(impr_c(start+isec)) - CALL uppercase(impr_d(start+isec)) - CALL section_vals_val_get(section, "K", i_rep_section=isec, r_val=impr_k(start+isec)) - CALL section_vals_val_get(section, "PHI0", i_rep_section=isec, r_val=impr_phi0(start+isec)) + impr_a(start + isec) = atm_names(1) + impr_b(start + isec) = atm_names(2) + impr_c(start + isec) = atm_names(3) + impr_d(start + isec) = atm_names(4) + CALL uppercase(impr_a(start + isec)) + CALL uppercase(impr_b(start + isec)) + CALL uppercase(impr_c(start + isec)) + CALL uppercase(impr_d(start + isec)) + CALL section_vals_val_get(section, "K", i_rep_section=isec, r_val=impr_k(start + isec)) + CALL section_vals_val_get(section, "PHI0", i_rep_section=isec, r_val=impr_phi0(start + isec)) END DO END SUBROUTINE read_improper_section @@ -1911,18 +1911,18 @@ SUBROUTINE read_opbend_section(opbend_kind, opbend_a, opbend_b, opbend_c, opbend NULLIFY (atm_names) CALL section_vals_get(section, n_repetition=n_items) DO isec = 1, n_items - CALL section_vals_val_get(section, "KIND", i_rep_section=isec, i_val=opbend_kind(start+isec)) + CALL section_vals_val_get(section, "KIND", i_rep_section=isec, i_val=opbend_kind(start + isec)) CALL section_vals_val_get(section, "ATOMS", i_rep_section=isec, c_vals=atm_names) - opbend_a(start+isec) = atm_names(1) - opbend_b(start+isec) = atm_names(2) - opbend_c(start+isec) = atm_names(3) - opbend_d(start+isec) = atm_names(4) - CALL uppercase(opbend_a(start+isec)) - CALL uppercase(opbend_b(start+isec)) - CALL uppercase(opbend_c(start+isec)) - CALL uppercase(opbend_d(start+isec)) - CALL section_vals_val_get(section, "K", i_rep_section=isec, r_val=opbend_k(start+isec)) - CALL section_vals_val_get(section, "PHI0", i_rep_section=isec, r_val=opbend_phi0(start+isec)) + opbend_a(start + isec) = atm_names(1) + opbend_b(start + isec) = atm_names(2) + opbend_c(start + isec) = atm_names(3) + opbend_d(start + isec) = atm_names(4) + CALL uppercase(opbend_a(start + isec)) + CALL uppercase(opbend_b(start + isec)) + CALL uppercase(opbend_c(start + isec)) + CALL uppercase(opbend_d(start + isec)) + CALL section_vals_val_get(section, "K", i_rep_section=isec, r_val=opbend_k(start + isec)) + CALL section_vals_val_get(section, "PHI0", i_rep_section=isec, r_val=opbend_phi0(start + isec)) END DO END SUBROUTINE read_opbend_section @@ -1994,8 +1994,8 @@ SUBROUTINE read_eam_data(eam, para_env, mm_section) CALL parser_get_next_line(parser, 1) READ (parser%input_line, *) eam%rho(i), eam%rhop(i) eam%rhop(i) = cp_unit_to_cp2k(eam%rhop(i), "angstrom^-1") - eam%rval(i) = REAL(i-1, KIND=dp)*eam%drar - eam%rhoval(i) = REAL(i-1, KIND=dp)*eam%drhoar + eam%rval(i) = REAL(i - 1, KIND=dp)*eam%drar + eam%rhoval(i) = REAL(i - 1, KIND=dp)*eam%drhoar END DO ! Reading pair potential PHI and its derivative (with respect to r) DO i = 1, eam%npoints diff --git a/src/force_fields_util.F b/src/force_fields_util.F index 8f362ddf75..04bfc960e8 100644 --- a/src/force_fields_util.F +++ b/src/force_fields_util.F @@ -451,14 +451,14 @@ SUBROUTINE force_field_qeff_output(particle_set, molecule_kind_set, & atomic_kind => atom_list(iatom)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=atmname, qeff=qeff, mass=mass, shell_active=shell_active, shell=shell) - IF (shell_active) qeff = shell%charge_core+shell%charge_shell + IF (shell_active) qeff = shell%charge_core + shell%charge_shell IF (ASSOCIATED(charges)) THEN - jatom = first-1+iatom + jatom = first - 1 + iatom qeff = charges(jatom) END IF IF (iw > 0) WRITE (iw, *) " atom ", iatom, " ", TRIM(atmname), " charge = ", qeff - qeff_mol = qeff_mol+qeff - mass_mol = mass_mol+mass + qeff_mol = qeff_mol + qeff + mass_mol = mass_mol + mass END DO CALL set_molecule_kind(molecule_kind=molecule_kind, charge=qeff_mol, mass=mass_mol) IF (iw > 0) WRITE (iw, *) " Mol Kind ", TRIM(molname), " charge = ", qeff_mol @@ -472,14 +472,14 @@ SUBROUTINE force_field_qeff_output(particle_set, molecule_kind_set, & atomic_kind => particle_set(iatom)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & name=atmname, qeff=qeff, mass=mass, shell_active=shell_active, shell=shell) - IF (shell_active) qeff = shell%charge_core+shell%charge_shell + IF (shell_active) qeff = shell%charge_core + shell%charge_shell IF (ASSOCIATED(charges)) THEN qeff = charges(iatom) END IF IF (iw > 0) WRITE (iw, *) " atom ", iatom, " ", TRIM(atmname), & " charge = ", qeff - qeff_sum = qeff_sum+qeff - mass_sum = mass_sum+mass + qeff_sum = qeff_sum + qeff + mass_sum = mass_sum + mass END DO IF (iw > 0) WRITE (iw, '(A,F20.10)') " Total system charge = ", qeff_sum IF (iw > 0) WRITE (iw, '(A,F20.10)') " Total system mass = ", mass_sum @@ -734,12 +734,12 @@ SUBROUTINE clean_intra_force_kind(molecule_kind_set, mm_section) IF (unsetme) bad1(ibond) = 1 END DO IF (SUM(bad1) /= 0) THEN - counter = SIZE(bond_kind_set)-SUM(bad1) + counter = SIZE(bond_kind_set) - SUM(bad1) CALL allocate_bond_kind_set(new_bond_kind_set, counter) counter = 0 DO ibond = 1, SIZE(bond_kind_set) IF (bad1(ibond) == 0) THEN - counter = counter+1 + counter = counter + 1 new_bond_kind_set(counter) = bond_kind_set(ibond) END IF END DO @@ -753,15 +753,15 @@ SUBROUTINE clean_intra_force_kind(molecule_kind_set, mm_section) IF (unsetme) bad2(ibond) = 1 END DO IF (SUM(bad2) /= 0) THEN - counter = SIZE(bond_list)-SUM(bad2) + counter = SIZE(bond_list) - SUM(bad2) ALLOCATE (new_bond_list(counter)) counter = 0 DO ibond = 1, SIZE(bond_list) IF (bad2(ibond) == 0) THEN - counter = counter+1 + counter = counter + 1 new_bond_list(counter) = bond_list(ibond) newkind = bond_list(ibond)%bond_kind%kind_number - newkind = newkind-SUM(bad1(1:newkind)) + newkind = newkind - SUM(bad1(1:newkind)) new_bond_list(counter)%bond_kind => new_bond_kind_set(newkind) END IF END DO @@ -817,12 +817,12 @@ SUBROUTINE clean_intra_force_kind(molecule_kind_set, mm_section) IF (unsetme) bad1(ibend) = 1 END DO IF (SUM(bad1) /= 0) THEN - counter = SIZE(bend_kind_set)-SUM(bad1) + counter = SIZE(bend_kind_set) - SUM(bad1) CALL allocate_bend_kind_set(new_bend_kind_set, counter) counter = 0 DO ibend = 1, SIZE(bend_kind_set) IF (bad1(ibend) == 0) THEN - counter = counter+1 + counter = counter + 1 new_bend_kind_set(counter) = bend_kind_set(ibend) END IF END DO @@ -836,15 +836,15 @@ SUBROUTINE clean_intra_force_kind(molecule_kind_set, mm_section) IF (unsetme) bad2(ibend) = 1 END DO IF (SUM(bad2) /= 0) THEN - counter = SIZE(bend_list)-SUM(bad2) + counter = SIZE(bend_list) - SUM(bad2) ALLOCATE (new_bend_list(counter)) counter = 0 DO ibend = 1, SIZE(bend_list) IF (bad2(ibend) == 0) THEN - counter = counter+1 + counter = counter + 1 new_bend_list(counter) = bend_list(ibend) newkind = bend_list(ibend)%bend_kind%kind_number - newkind = newkind-SUM(bad1(1:newkind)) + newkind = newkind - SUM(bad1(1:newkind)) new_bend_list(counter)%bend_kind => new_bend_kind_set(newkind) END IF END DO @@ -901,12 +901,12 @@ SUBROUTINE clean_intra_force_kind(molecule_kind_set, mm_section) IF (unsetme) bad1(iub) = 1 END DO IF (SUM(bad1) /= 0) THEN - counter = SIZE(ub_kind_set)-SUM(bad1) + counter = SIZE(ub_kind_set) - SUM(bad1) CALL allocate_ub_kind_set(new_ub_kind_set, counter) counter = 0 DO iub = 1, SIZE(ub_kind_set) IF (bad1(iub) == 0) THEN - counter = counter+1 + counter = counter + 1 new_ub_kind_set(counter) = ub_kind_set(iub) END IF END DO @@ -920,15 +920,15 @@ SUBROUTINE clean_intra_force_kind(molecule_kind_set, mm_section) IF (unsetme) bad2(iub) = 1 END DO IF (SUM(bad2) /= 0) THEN - counter = SIZE(ub_list)-SUM(bad2) + counter = SIZE(ub_list) - SUM(bad2) ALLOCATE (new_ub_list(counter)) counter = 0 DO iub = 1, SIZE(ub_list) IF (bad2(iub) == 0) THEN - counter = counter+1 + counter = counter + 1 new_ub_list(counter) = ub_list(iub) newkind = ub_list(iub)%ub_kind%kind_number - newkind = newkind-SUM(bad1(1:newkind)) + newkind = newkind - SUM(bad1(1:newkind)) new_ub_list(counter)%ub_kind => new_ub_kind_set(newkind) END IF END DO @@ -985,12 +985,12 @@ SUBROUTINE clean_intra_force_kind(molecule_kind_set, mm_section) IF (unsetme) bad1(itorsion) = 1 END DO IF (SUM(bad1) /= 0) THEN - counter = SIZE(torsion_kind_set)-SUM(bad1) + counter = SIZE(torsion_kind_set) - SUM(bad1) CALL allocate_torsion_kind_set(new_torsion_kind_set, counter) counter = 0 DO itorsion = 1, SIZE(torsion_kind_set) IF (bad1(itorsion) == 0) THEN - counter = counter+1 + counter = counter + 1 new_torsion_kind_set(counter) = torsion_kind_set(itorsion) i = SIZE(torsion_kind_set(itorsion)%m) j = SIZE(torsion_kind_set(itorsion)%k) @@ -1013,15 +1013,15 @@ SUBROUTINE clean_intra_force_kind(molecule_kind_set, mm_section) IF (unsetme) bad2(itorsion) = 1 END DO IF (SUM(bad2) /= 0) THEN - counter = SIZE(torsion_list)-SUM(bad2) + counter = SIZE(torsion_list) - SUM(bad2) ALLOCATE (new_torsion_list(counter)) counter = 0 DO itorsion = 1, SIZE(torsion_list) IF (bad2(itorsion) == 0) THEN - counter = counter+1 + counter = counter + 1 new_torsion_list(counter) = torsion_list(itorsion) newkind = torsion_list(itorsion)%torsion_kind%kind_number - newkind = newkind-SUM(bad1(1:newkind)) + newkind = newkind - SUM(bad1(1:newkind)) new_torsion_list(counter)%torsion_kind => new_torsion_kind_set(newkind) END IF END DO @@ -1080,12 +1080,12 @@ SUBROUTINE clean_intra_force_kind(molecule_kind_set, mm_section) IF (unsetme) bad1(iimpr) = 1 END DO IF (SUM(bad1) /= 0) THEN - counter = SIZE(impr_kind_set)-SUM(bad1) + counter = SIZE(impr_kind_set) - SUM(bad1) CALL allocate_impr_kind_set(new_impr_kind_set, counter) counter = 0 DO iimpr = 1, SIZE(impr_kind_set) IF (bad1(iimpr) == 0) THEN - counter = counter+1 + counter = counter + 1 new_impr_kind_set(counter) = impr_kind_set(iimpr) END IF END DO @@ -1099,15 +1099,15 @@ SUBROUTINE clean_intra_force_kind(molecule_kind_set, mm_section) IF (unsetme) bad2(iimpr) = 1 END DO IF (SUM(bad2) /= 0) THEN - counter = SIZE(impr_list)-SUM(bad2) + counter = SIZE(impr_list) - SUM(bad2) ALLOCATE (new_impr_list(counter)) counter = 0 DO iimpr = 1, SIZE(impr_list) IF (bad2(iimpr) == 0) THEN - counter = counter+1 + counter = counter + 1 new_impr_list(counter) = impr_list(iimpr) newkind = impr_list(iimpr)%impr_kind%kind_number - newkind = newkind-SUM(bad1(1:newkind)) + newkind = newkind - SUM(bad1(1:newkind)) new_impr_list(counter)%impr_kind => new_impr_kind_set(newkind) END IF END DO @@ -1163,12 +1163,12 @@ SUBROUTINE clean_intra_force_kind(molecule_kind_set, mm_section) IF (unsetme) bad1(iopbend) = 1 END DO IF (SUM(bad1) /= 0) THEN - counter = SIZE(opbend_kind_set)-SUM(bad1) + counter = SIZE(opbend_kind_set) - SUM(bad1) CALL allocate_opbend_kind_set(new_opbend_kind_set, counter) counter = 0 DO iopbend = 1, SIZE(opbend_kind_set) IF (bad1(iopbend) == 0) THEN - counter = counter+1 + counter = counter + 1 new_opbend_kind_set(counter) = opbend_kind_set(iopbend) END IF END DO @@ -1182,15 +1182,15 @@ SUBROUTINE clean_intra_force_kind(molecule_kind_set, mm_section) IF (unsetme) bad2(iopbend) = 1 END DO IF (SUM(bad2) /= 0) THEN - counter = SIZE(opbend_list)-SUM(bad2) + counter = SIZE(opbend_list) - SUM(bad2) ALLOCATE (new_opbend_list(counter)) counter = 0 DO iopbend = 1, SIZE(opbend_list) IF (bad2(iopbend) == 0) THEN - counter = counter+1 + counter = counter + 1 new_opbend_list(counter) = opbend_list(iopbend) newkind = opbend_list(iopbend)%opbend_kind%kind_number - newkind = newkind-SUM(bad1(1:newkind)) + newkind = newkind - SUM(bad1(1:newkind)) new_opbend_list(counter)%opbend_kind => new_opbend_kind_set(newkind) END IF END DO @@ -1297,19 +1297,19 @@ SUBROUTINE get_generic_info(gen_section, func_name, xfunction, parameters, value isize = SIZE(my_par) CALL section_vals_val_get(gen_section, "PARAMETERS", i_rep_section=irep, i_rep_val=i, c_vals=my_par_tmp) nblank = COUNT(my_par_tmp == "") - CALL reallocate(my_par, 1, isize+SIZE(my_par_tmp)-nblank) + CALL reallocate(my_par, 1, isize + SIZE(my_par_tmp) - nblank) ind = 0 DO j = 1, SIZE(my_par_tmp) IF (my_par_tmp(j) == "") CYCLE - ind = ind+1 - my_par(isize+ind) = my_par_tmp(j) + ind = ind + 1 + my_par(isize + ind) = my_par_tmp(j) END DO END DO DO i = 1, n_val isize = SIZE(my_val) CALL section_vals_val_get(gen_section, "VALUES", i_rep_section=irep, i_rep_val=i, r_vals=my_val_tmp) - CALL reallocate(my_val, 1, isize+SIZE(my_val_tmp)) - my_val(isize+1:isize+SIZE(my_val_tmp)) = my_val_tmp + CALL reallocate(my_val, 1, isize + SIZE(my_val_tmp)) + my_val(isize + 1:isize + SIZE(my_val_tmp)) = my_val_tmp END DO CPASSERT(SIZE(my_par) == SIZE(my_val)) ! Optionally read the units for each parameter value @@ -1319,17 +1319,17 @@ SUBROUTINE get_generic_info(gen_section, func_name, xfunction, parameters, value isize = SIZE(my_units) CALL section_vals_val_get(gen_section, "UNITS", i_rep_section=irep, i_rep_val=i, c_vals=my_units_tmp) nblank = COUNT(my_units_tmp == "") - CALL reallocate(my_units, 1, isize+SIZE(my_units_tmp)-nblank) + CALL reallocate(my_units, 1, isize + SIZE(my_units_tmp) - nblank) ind = 0 DO j = 1, SIZE(my_units_tmp) IF (my_units_tmp(j) == "") CYCLE - ind = ind+1 - my_units(isize+ind) = my_units_tmp(j) + ind = ind + 1 + my_units(isize + ind) = my_units_tmp(j) END DO END DO CPASSERT(SIZE(my_units) == SIZE(my_val)) END IF - mydim = mydim+SIZE(my_val) + mydim = mydim + SIZE(my_val) IF (SIZE(my_val) == 0) THEN DEALLOCATE (my_par) DEALLOCATE (my_val) @@ -1348,11 +1348,11 @@ SUBROUTINE get_generic_info(gen_section, func_name, xfunction, parameters, value END IF IF (ASSOCIATED(my_val)) THEN DO i = 1, SIZE(my_val) - parameters(SIZE(my_var)+i) = my_par(i) + parameters(SIZE(my_var) + i) = my_par(i) IF (n_units > 0) THEN - values(SIZE(my_var)+i) = cp_unit_to_cp2k(my_val(i), TRIM(ADJUSTL(my_units(i)))) + values(SIZE(my_var) + i) = cp_unit_to_cp2k(my_val(i), TRIM(ADJUSTL(my_units(i)))) ELSE - values(SIZE(my_var)+i) = my_val(i) + values(SIZE(my_var) + i) = my_val(i) END IF END DO END IF diff --git a/src/fp_methods.F b/src/fp_methods.F index 03dd597735..633ab8a2a5 100644 --- a/src/fp_methods.F +++ b/src/fp_methods.F @@ -87,59 +87,59 @@ SUBROUTINE fp_eval(fp_env, subsys, cell) ! inner particles DO i = 1, SIZE(fp_env%inner_atoms) iparticle = fp_env%inner_atoms(i) - rab = particles(iparticle)%r-particles(icenter)%r + rab = particles(iparticle)%r - particles(icenter)%r rab = pbc(rab, cell) r = SQRT(SUM(rab**2)) ! constraint wall (they feel to outer wall) IF (r > fp_env%outer_radius) THEN zero_weight = .TRUE. - fp_env%restraint_energy = fp_env%restraint_energy+0.5_dp*strength*(r-fp_env%outer_radius)**2 - sf = strength*(r-fp_env%outer_radius)/r - particles(iparticle)%f = particles(iparticle)%f-sf*rab - particles(icenter)%f = particles(icenter)%f+sf*rab + fp_env%restraint_energy = fp_env%restraint_energy + 0.5_dp*strength*(r - fp_env%outer_radius)**2 + sf = strength*(r - fp_env%outer_radius)/r + particles(iparticle)%f = particles(iparticle)%f - sf*rab + particles(icenter)%f = particles(icenter)%f + sf*rab ENDIF ! count the distribution IF (r > fp_env%inner_radius) THEN - fp_env%i2 = fp_env%i2+1 + fp_env%i2 = fp_env%i2 + 1 ELSE - fp_env%i1 = fp_env%i1+1 + fp_env%i1 = fp_env%i1 + 1 ENDIF ! smooth count the distribution CALL smooth_count(r, fp_env%inner_radius, fp_env%smooth_width, c, dcdr) - fp_env%ri1 = fp_env%ri1+c - fp_env%ri2 = fp_env%ri2+(1.0_dp-c) + fp_env%ri1 = fp_env%ri1 + c + fp_env%ri2 = fp_env%ri2 + (1.0_dp - c) ENDDO ! outer particles DO i = 1, SIZE(fp_env%outer_atoms) iparticle = fp_env%outer_atoms(i) - rab = particles(iparticle)%r-particles(icenter)%r + rab = particles(iparticle)%r - particles(icenter)%r rab = pbc(rab, cell) r = SQRT(SUM(rab**2)) ! constraint wall (they feel the inner wall) IF (r < fp_env%inner_radius) THEN zero_weight = .TRUE. - fp_env%restraint_energy = fp_env%restraint_energy+ & - 0.5_dp*strength*(r-fp_env%inner_radius)**2 - sf = strength*(r-fp_env%inner_radius)/r - particles(iparticle)%f = particles(iparticle)%f-sf*rab - particles(icenter)%f = particles(icenter)%f+sf*rab + fp_env%restraint_energy = fp_env%restraint_energy + & + 0.5_dp*strength*(r - fp_env%inner_radius)**2 + sf = strength*(r - fp_env%inner_radius)/r + particles(iparticle)%f = particles(iparticle)%f - sf*rab + particles(icenter)%f = particles(icenter)%f + sf*rab ENDIF ! count the distribution IF (r > fp_env%outer_radius) THEN - fp_env%o2 = fp_env%o2+1 + fp_env%o2 = fp_env%o2 + 1 ELSE - fp_env%o1 = fp_env%o1+1 + fp_env%o1 = fp_env%o1 + 1 ENDIF ! smooth count the distribution CALL smooth_count(r, fp_env%outer_radius, fp_env%smooth_width, c, dcdr) - fp_env%ro1 = fp_env%ro1+c - fp_env%ro2 = fp_env%ro2+(1.0_dp-c) + fp_env%ro1 = fp_env%ro1 + c + fp_env%ro2 = fp_env%ro2 + (1.0_dp - c) ENDDO - fp_env%energy = fp_env%energy+fp_env%restraint_energy + fp_env%energy = fp_env%energy + fp_env%restraint_energy ! the combinatorial weight - i = fp_env%i2+fp_env%o1 + i = fp_env%i2 + fp_env%o1 CPASSERT(i <= maxfac) fp_env%comb_weight = (fac(fp_env%i2)*fac(fp_env%o1))/fac(i) @@ -150,34 +150,34 @@ SUBROUTINE fp_eval(fp_env, subsys, cell) fp_env%bias_energy = 0.0_dp IF (fp_env%bias) THEN kT = fp_env%temperature - fp_env%bias_energy = kT*(gamln(fp_env%ro1+fp_env%ri2+1)- & - gamln(fp_env%ro1+1)-gamln(fp_env%ri2+1)) + fp_env%bias_energy = kT*(gamln(fp_env%ro1 + fp_env%ri2 + 1) - & + gamln(fp_env%ro1 + 1) - gamln(fp_env%ri2 + 1)) ! and add the corresponding forces ! inner particles DO i = 1, SIZE(fp_env%inner_atoms) iparticle = fp_env%inner_atoms(i) - rab = particles(iparticle)%r-particles(icenter)%r + rab = particles(iparticle)%r - particles(icenter)%r rab = pbc(rab, cell) r = SQRT(SUM(rab**2)) CALL smooth_count(r, fp_env%inner_radius, fp_env%smooth_width, c, dcdr) - sf = kT*(psi(fp_env%ro1+fp_env%ri2+1)-psi(fp_env%ri2+1))*(-dcdr)/r - particles(iparticle)%f = particles(iparticle)%f-sf*rab - particles(icenter)%f = particles(icenter)%f+sf*rab + sf = kT*(psi(fp_env%ro1 + fp_env%ri2 + 1) - psi(fp_env%ri2 + 1))*(-dcdr)/r + particles(iparticle)%f = particles(iparticle)%f - sf*rab + particles(icenter)%f = particles(icenter)%f + sf*rab ENDDO ! outer particles DO i = 1, SIZE(fp_env%outer_atoms) iparticle = fp_env%outer_atoms(i) - rab = particles(iparticle)%r-particles(icenter)%r + rab = particles(iparticle)%r - particles(icenter)%r rab = pbc(rab, cell) r = SQRT(SUM(rab**2)) CALL smooth_count(r, fp_env%outer_radius, fp_env%smooth_width, c, dcdr) - sf = kT*(psi(fp_env%ro1+fp_env%ri2+1)-psi(fp_env%ro1+1))*(dcdr)/r - particles(iparticle)%f = particles(iparticle)%f-sf*rab - particles(icenter)%f = particles(icenter)%f+sf*rab + sf = kT*(psi(fp_env%ro1 + fp_env%ri2 + 1) - psi(fp_env%ro1 + 1))*(dcdr)/r + particles(iparticle)%f = particles(iparticle)%f - sf*rab + particles(icenter)%f = particles(icenter)%f + sf*rab ENDDO ENDIF - fp_env%energy = fp_env%energy+fp_env%bias_energy + fp_env%energy = fp_env%energy + fp_env%bias_energy fp_env%bias_weight = EXP(fp_env%bias_energy/kT) ! if this configuration is a valid one, compute its weight @@ -226,9 +226,9 @@ SUBROUTINE smooth_count(r, r1, width, c, dcdr) REAL(KIND=dp) :: arg - arg = (r1-r)/width + arg = (r1 - r)/width - c = (1.0_dp+erf1(arg))/2.0_dp + c = (1.0_dp + erf1(arg))/2.0_dp dcdr = (-oorootpi/width)*EXP(-arg**2) END SUBROUTINE diff --git a/src/fp_types.F b/src/fp_types.F index a10d987a34..a56784a8a1 100644 --- a/src/fp_types.F +++ b/src/fp_types.F @@ -97,7 +97,7 @@ SUBROUTINE fp_env_release(fp_env) IF (ASSOCIATED(fp_env)) THEN CPASSERT(fp_env%ref_count > 0) - fp_env%ref_count = fp_env%ref_count-1 + fp_env%ref_count = fp_env%ref_count - 1 IF (fp_env%ref_count == 0) THEN IF (ASSOCIATED(fp_env%inner_atoms)) DEALLOCATE (fp_env%inner_atoms) IF (ASSOCIATED(fp_env%outer_atoms)) DEALLOCATE (fp_env%outer_atoms) @@ -120,7 +120,7 @@ SUBROUTINE fp_env_retain(fp_env) CHARACTER(len=*), PARAMETER :: routineN = 'fp_env_retain', routineP = moduleN//':'//routineN CPASSERT(ASSOCIATED(fp_env)) - fp_env%ref_count = fp_env%ref_count+1 + fp_env%ref_count = fp_env%ref_count + 1 END SUBROUTINE fp_env_retain diff --git a/src/generic_os_integrals.F b/src/generic_os_integrals.F index e84f3845bc..d8677efea1 100644 --- a/src/generic_os_integrals.F +++ b/src/generic_os_integrals.F @@ -191,7 +191,7 @@ SUBROUTINE int_operator_ab_os_low(cps_operator2, vab, dvab, rab, fba, fbb, omega CALL get_gto_basis_set(fbb, maxco=maxcob, maxl=maxlb) maxco = MAX(maxcoa, maxcob) IF (calculate_forces) THEN - maxl = MAX(maxla+1, maxlb) + maxl = MAX(maxla + 1, maxlb) ELSE maxl = MAX(maxla, maxlb) ENDIF @@ -206,26 +206,26 @@ SUBROUTINE int_operator_ab_os_low(cps_operator2, vab, dvab, rab, fba, fbb, omega DO iset = 1, nseta ncoa = npgfa(iset)*ncoset(la_max(iset)) - ncoap = npgfa(iset)*ncoset(la_max(iset)+1) + ncoap = npgfa(iset)*ncoset(la_max(iset) + 1) sgfa = first_sgfa(1, iset) DO jset = 1, nsetb ncob = npgfb(jset)*ncoset(lb_max(jset)) - ncobp = npgfb(jset)*ncoset(lb_max(jset)+1) + ncobp = npgfb(jset)*ncoset(lb_max(jset) + 1) sgfb = first_sgfb(1, jset) - m1 = sgfa+nsgfa(iset)-1 - m2 = sgfb+nsgfb(jset)-1 + m1 = sgfa + nsgfa(iset) - 1 + m2 = sgfb + nsgfb(jset) - 1 ! calculate integrals IF (calculate_forces) THEN - ALLOCATE (vwork(ncoap, ncobp, la_max(iset)+lb_max(jset)+3), & + ALLOCATE (vwork(ncoap, ncobp, la_max(iset) + lb_max(jset) + 3), & vac(ncoa, ncob), vac_plus(ncoap, ncobp), devab(ncoa, ncob, 3)) devab = 0._dp vwork = 0.0_dp vac = 0.0_dp - CALL operator2(cps_operator2, la_max(iset)+1, npgfa(iset), zeta(:, iset), la_min(iset), & - lb_max(jset)+1, npgfb(jset), zetb(:, jset), lb_min(jset), & + CALL operator2(cps_operator2, la_max(iset) + 1, npgfa(iset), zeta(:, iset), la_min(iset), & + lb_max(jset) + 1, npgfb(jset), zetb(:, jset), lb_min(jset), & omega, r_cutoff, rab, rab2, vac, vwork, maxder=1, vac_plus=vac_plus) CALL dabdr_noscreen(la_max(iset), npgfa(iset), zeta(:, iset), lb_max(jset), npgfb(jset), & vac_plus, devab(:, :, 1), devab(:, :, 2), devab(:, :, 3)) @@ -235,7 +235,7 @@ SUBROUTINE int_operator_ab_os_low(cps_operator2, vab, dvab, rab, fba, fbb, omega ENDDO ELSE - ALLOCATE (vwork(ncoa, ncob, la_max(iset)+lb_max(jset)+1), & + ALLOCATE (vwork(ncoa, ncob, la_max(iset) + lb_max(jset) + 1), & vac(ncoa, ncob), vac_plus(ncoap, ncobp), devab(ncoa, ncob, 3)) vwork = 0.0_dp vac = 0.0_dp @@ -335,17 +335,17 @@ SUBROUTINE int_overlap_ab_os(sab, dsab, rab, fba, fbb, calculate_forces, debug, DO iset = 1, nseta - ncoa = npgfa(iset)*(ncoset(la_max(iset))-ncoset(la_min(iset)-1)) + ncoa = npgfa(iset)*(ncoset(la_max(iset)) - ncoset(la_min(iset) - 1)) sgfa = first_sgfa(1, iset) DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE - ncob = npgfb(jset)*(ncoset(lb_max(jset))-ncoset(lb_min(jset)-1)) + ncob = npgfb(jset)*(ncoset(lb_max(jset)) - ncoset(lb_min(jset) - 1)) sgfb = first_sgfb(1, jset) - m1 = sgfa+nsgfa(iset)-1 - m2 = sgfb+nsgfb(jset)-1 + m1 = sgfa + nsgfa(iset) - 1 + m2 = sgfb + nsgfb(jset) - 1 IF (calculate_forces) THEN CALL overlap_ab(la_max(iset), la_min(iset), npgfa(iset), rpgfa(:, iset), zeta(:, iset), & @@ -458,15 +458,15 @@ SUBROUTINE int_ra2m_ab_os(sab, dsab, rab, fba, fbb, m, calculate_forces) DO iset = 1, nseta - ncoa = npgfa(iset)*(ncoset(la_max(iset))-ncoset(la_min(iset)-1)) + ncoa = npgfa(iset)*(ncoset(la_max(iset)) - ncoset(la_min(iset) - 1)) sgfa = first_sgfa(1, iset) DO jset = 1, nsetb - ncob = npgfb(jset)*(ncoset(lb_max(jset))-ncoset(lb_min(jset)-1)) + ncob = npgfb(jset)*(ncoset(lb_max(jset)) - ncoset(lb_min(jset) - 1)) sgfb = first_sgfb(1, jset) - m1 = sgfa+nsgfa(iset)-1 - m2 = sgfb+nsgfb(jset)-1 + m1 = sgfa + nsgfa(iset) - 1 + m2 = sgfb + nsgfb(jset) - 1 CALL operator_ra2m(la_max(iset), la_min(iset), npgfa(iset), zeta(:, iset), & lb_max(jset), lb_min(jset), npgfb(jset), zetb(:, jset), & @@ -581,17 +581,17 @@ SUBROUTINE int_overlap_aba_os(abaint, dabdaint, rab, oba, obb, fba, & DO iset = 1, nseta - ncoa = npgfa(iset)*(ncoset(la_max(iset))-ncoset(la_min(iset)-1)) + ncoa = npgfa(iset)*(ncoset(la_max(iset)) - ncoset(la_min(iset) - 1)) sgfa = first_sgfa(1, iset) DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE - ncob = npgfb(jset)*(ncoset(lb_max(jset))-ncoset(lb_min(jset)-1)) + ncob = npgfb(jset)*(ncoset(lb_max(jset)) - ncoset(lb_min(jset) - 1)) sgfb = first_sgfb(1, jset) - m1 = sgfa+nsgfa(iset)-1 - m2 = sgfb+nsgfb(jset)-1 + m1 = sgfa + nsgfa(iset) - 1 + m2 = sgfb + nsgfb(jset) - 1 ! calculate integrals abaint and derivative [d(a,b,a)/dA] dabdaint if requested rac = 0._dp @@ -601,11 +601,11 @@ SUBROUTINE int_overlap_aba_os(abaint, dabdaint, rab, oba, obb, fba, & DO kaset = 1, nsetca - IF (set_radius_b(jset)+set_radius_ca(kaset) < dab) CYCLE + IF (set_radius_b(jset) + set_radius_ca(kaset) < dab) CYCLE - ncoc = npgfca(kaset)*(ncoset(lca_max(kaset))-ncoset(lca_min(kaset)-1)) + ncoc = npgfca(kaset)*(ncoset(lca_max(kaset)) - ncoset(lca_min(kaset) - 1)) sgfc = first_sgfca(1, kaset) - m3 = sgfc+nsgfca(kaset)-1 + m3 = sgfc + nsgfca(kaset) - 1 IF (ncoa*ncob*ncoc > 0) THEN ALLOCATE (saba(ncoa, ncob, ncoc)) ! integrals @@ -743,17 +743,17 @@ SUBROUTINE int_overlap_abb_os(abbint, dabbint, rab, oba, obb, fbb, calculate_for DO iset = 1, nseta - ncoa = npgfa(iset)*(ncoset(la_max(iset))-ncoset(la_min(iset)-1)) + ncoa = npgfa(iset)*(ncoset(la_max(iset)) - ncoset(la_min(iset) - 1)) sgfa = first_sgfa(1, iset) DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE - ncob = npgfb(jset)*(ncoset(lb_max(jset))-ncoset(lb_min(jset)-1)) + ncob = npgfb(jset)*(ncoset(lb_max(jset)) - ncoset(lb_min(jset) - 1)) sgfb = first_sgfb(1, jset) - m1 = sgfa+nsgfa(iset)-1 - m2 = sgfb+nsgfb(jset)-1 + m1 = sgfa + nsgfa(iset) - 1 + m2 = sgfb + nsgfb(jset) - 1 ! calculate integrals abbint and derivative [d(a,b,b)/dA] dabbint if requested rac = rab @@ -763,11 +763,11 @@ SUBROUTINE int_overlap_abb_os(abbint, dabbint, rab, oba, obb, fbb, calculate_for DO kbset = 1, nsetcb - IF (set_radius_a(iset)+set_radius_cb(kbset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_cb(kbset) < dab) CYCLE - ncoc = npgfcb(kbset)*(ncoset(lcb_max(kbset))-ncoset(lcb_min(kbset)-1)) + ncoc = npgfcb(kbset)*(ncoset(lcb_max(kbset)) - ncoset(lcb_min(kbset) - 1)) sgfc = first_sgfcb(1, kbset) - m3 = sgfc+nsgfcb(kbset)-1 + m3 = sgfc + nsgfcb(kbset) - 1 IF (ncoa*ncob*ncoc > 0) THEN ALLOCATE (sabb(ncoa, ncob, ncoc)) IF (calculate_forces) THEN @@ -892,25 +892,25 @@ SUBROUTINE int_overlap_aabb_os(saabb, oba, obb, rab, debug, dmax) ncoa1 = npgfa(iset)*ncoset(la_max(iset)) sgfa1 = first_sgfa(1, iset) - m1 = sgfa1+nsgfa(iset)-1 + m1 = sgfa1 + nsgfa(iset) - 1 DO jset = iset, nseta ncoa2 = npgfa(jset)*ncoset(la_max(jset)) sgfa2 = first_sgfa(1, jset) - m2 = sgfa2+nsgfa(jset)-1 + m2 = sgfa2 + nsgfa(jset) - 1 DO kset = 1, nsetb ncob1 = npgfb(kset)*ncoset(lb_max(kset)) sgfb1 = first_sgfb(1, kset) - m3 = sgfb1+nsgfb(kset)-1 + m3 = sgfb1 + nsgfb(kset) - 1 DO lset = kset, nsetb ncob2 = npgfb(lset)*ncoset(lb_max(lset)) sgfb2 = first_sgfb(1, lset) - m4 = sgfb2+nsgfb(lset)-1 + m4 = sgfb2 + nsgfb(lset) - 1 ! check if sets are identical to spare some integral evaluation asets_equal = .FALSE. diff --git a/src/gle_system_types.F b/src/gle_system_types.F index 16640ab9be..ea432749fc 100644 --- a/src/gle_system_types.F +++ b/src/gle_system_types.F @@ -110,15 +110,15 @@ SUBROUTINE gle_init(gle, dt, temp, section) CPABORT("GLE: Too many elements in A_LIST") END IF gle%a_mat(j, k) = list(i) - k = k+1 + k = k + 1 IF (k > gle%ndim) THEN k = 1 - j = j+1 + j = j + 1 END IF END DO END IF END DO ! ir - IF (j < gle%ndim+1) THEN + IF (j < gle%ndim + 1) THEN CPABORT("GLE: Too few elements in A_LIST") END IF gle%a_mat = gle%a_mat*a_scale @@ -138,15 +138,15 @@ SUBROUTINE gle_init(gle, dt, temp, section) CPABORT("GLE: Too many elements in C_LIST") END IF gle%c_mat(j, k) = list(i) - k = k+1 + k = k + 1 IF (k > gle%ndim) THEN k = 1 - j = j+1 + j = j + 1 END IF END DO END IF END DO ! ir - IF (j < gle%ndim+1) THEN + IF (j < gle%ndim + 1) THEN CPABORT("GLE: Too few elements in C_LIST") END IF ELSE @@ -196,7 +196,7 @@ SUBROUTINE gle_thermo_create(gle, mal_size) seed(:, :, 1) = initial_seed DO ithermo = 2, gle%glob_num_gle - seed(:, :, ithermo) = next_rng_seed(seed(:, :, ithermo-1)) + seed(:, :, ithermo) = next_rng_seed(seed(:, :, ithermo - 1)) END DO ! Update initial seed diff --git a/src/global_types.F b/src/global_types.F index d58cb09c00..21eac58935 100644 --- a/src/global_types.F +++ b/src/global_types.F @@ -126,7 +126,7 @@ SUBROUTINE globenv_retain(globenv) CPASSERT(ASSOCIATED(globenv)) CPASSERT(globenv%ref_count > 0) - globenv%ref_count = globenv%ref_count+1 + globenv%ref_count = globenv%ref_count + 1 END SUBROUTINE globenv_retain ! ************************************************************************************************** @@ -142,7 +142,7 @@ SUBROUTINE globenv_release(globenv) IF (ASSOCIATED(globenv)) THEN CPASSERT(globenv%ref_count > 0) - globenv%ref_count = globenv%ref_count-1 + globenv%ref_count = globenv%ref_count - 1 IF (globenv%ref_count == 0) THEN IF (ASSOCIATED(globenv%gaussian_rng_stream)) THEN CALL delete_rng_stream(globenv%gaussian_rng_stream) diff --git a/src/graphcon.F b/src/graphcon.F index ae3f83e4ff..a619625106 100644 --- a/src/graphcon.F +++ b/src/graphcon.F @@ -19,45 +19,45 @@ !> \author Joost VandeVondele ! ************************************************************************************************** MODULE graphcon - + USE util, ONLY: sort #include "./base/base_uses.f90" - IMPLICIT NONE + IMPLICIT NONE - PRIVATE - PUBLIC :: vertex, graph_type, reorder_graph, hash_molecule + PRIVATE + PUBLIC :: vertex, graph_type, reorder_graph, hash_molecule - ! a molecule is an array of vertices, each vertex has a kind - ! and a list of edges (bonds). - ! (the number is the index of the other vertex in the array that builds the molecule) + ! a molecule is an array of vertices, each vertex has a kind + ! and a list of edges (bonds). + ! (the number is the index of the other vertex in the array that builds the molecule) ! ************************************************************************************************** - TYPE graph_type - TYPE(vertex), POINTER, DIMENSION(:) :: graph - END TYPE graph_type + TYPE graph_type + TYPE(vertex), POINTER, DIMENSION(:) :: graph + END TYPE graph_type ! ************************************************************************************************** - TYPE vertex - INTEGER :: kind - INTEGER, POINTER, DIMENSION(:) :: bonds - END TYPE vertex + TYPE vertex + INTEGER :: kind + INTEGER, POINTER, DIMENSION(:) :: bonds + END TYPE vertex ! ************************************************************************************************** - TYPE class - INTEGER, DIMENSION(:), POINTER :: reference - INTEGER, DIMENSION(:), POINTER :: unordered - INTEGER :: kind - INTEGER :: Nele - LOGICAL :: first - INTEGER, DIMENSION(:), POINTER :: order - INTEGER, DIMENSION(:), POINTER :: q - END TYPE class + TYPE class + INTEGER, DIMENSION(:), POINTER :: reference + INTEGER, DIMENSION(:), POINTER :: unordered + INTEGER :: kind + INTEGER :: Nele + LOGICAL :: first + INTEGER, DIMENSION(:), POINTER :: order + INTEGER, DIMENSION(:), POINTER :: q + END TYPE class ! ************************************************************************************************** - TYPE superclass - INTEGER :: Nele - INTEGER, DIMENSION(:), POINTER :: classes - END TYPE + TYPE superclass + INTEGER :: Nele + INTEGER, DIMENSION(:), POINTER :: classes + END TYPE CONTAINS @@ -74,7 +74,7 @@ MODULE graphcon !> Although relatively fast in general, might be quadratic with molecule size for !> some systems (e.g. linear alkanes) ! ************************************************************************************************** - SUBROUTINE hash_molecule(reference,kind_ref,hash) + SUBROUTINE hash_molecule(reference, kind_ref, hash) TYPE(vertex), DIMENSION(:), INTENT(IN) :: reference INTEGER, DIMENSION(:), INTENT(OUT) :: kind_ref INTEGER, INTENT(OUT) :: hash @@ -83,35 +83,35 @@ SUBROUTINE hash_molecule(reference,kind_ref,hash) old_class INTEGER, ALLOCATABLE, DIMENSION(:) :: index, kind_new - N=SIZE(kind_ref) - ALLOCATE(kind_new(N),INDEX(N)) - kind_ref=reference%kind - Nclasses_old=0 - DO Ihash=1,N - ! generate a hash based on the the kind of each atom and the kind of its bonded atoms - DO I=1,N - kind_new(I)=hash_kind(kind_ref(I),kind_ref(reference(I)%bonds)) - ENDDO - kind_ref=kind_new - ! find the number of equivalent atoms - CALL sort(kind_new,N,index) - Nclasses=1 - old_class=kind_new(1) - DO i=2,N - IF (kind_new(I).NE.old_class) THEN - Nclasses=Nclasses+1 - old_class=kind_new(I) - ENDIF - ENDDO - ! if we have not generated new classes, we have presumably found all equivalence classes - IF (Nclasses==Nclasses_old) EXIT - Nclasses_old=Nclasses - ! write(*,*) "Classes",Ihash, Nclasses - ENDDO - ! hash (sorted) kinds to a molecular hash - hash=joaat_hash_i(kind_new) - DEALLOCATE(kind_new,index) - END SUBROUTINE hash_molecule + N = SIZE(kind_ref) + ALLOCATE (kind_new(N), INDEX(N)) + kind_ref = reference%kind + Nclasses_old = 0 + DO Ihash = 1, N + ! generate a hash based on the the kind of each atom and the kind of its bonded atoms + DO I = 1, N + kind_new(I) = hash_kind(kind_ref(I), kind_ref(reference(I)%bonds)) + ENDDO + kind_ref = kind_new + ! find the number of equivalent atoms + CALL sort(kind_new, N, index) + Nclasses = 1 + old_class = kind_new(1) + DO i = 2, N + IF (kind_new(I) .NE. old_class) THEN + Nclasses = Nclasses + 1 + old_class = kind_new(I) + ENDIF + ENDDO + ! if we have not generated new classes, we have presumably found all equivalence classes + IF (Nclasses == Nclasses_old) EXIT + Nclasses_old = Nclasses + ! write(*,*) "Classes",Ihash, Nclasses + ENDDO + ! hash (sorted) kinds to a molecular hash + hash = joaat_hash_i(kind_new) + DEALLOCATE (kind_new, index) + END SUBROUTINE hash_molecule ! ************************************************************************************************** !> \brief If two molecules are topologically the same, finds the ordering that maps @@ -128,7 +128,7 @@ END SUBROUTINE hash_molecule !> molecules with a large number of equivalent atoms as different !> despite the fact that an ordering could exist for which they are the same ! ************************************************************************************************** - SUBROUTINE reorder_graph(reference, unordered, order, matches) + SUBROUTINE reorder_graph(reference, unordered, order, matches) TYPE(vertex), DIMENSION(:), INTENT(IN) :: reference, unordered INTEGER, DIMENSION(:), INTENT(OUT) :: order LOGICAL, INTENT(OUT) :: matches @@ -149,175 +149,175 @@ SUBROUTINE reorder_graph(reference, unordered, order, matches) ! molecules with no symmetry e.g. JAC need less than 500 tries ! catch the cases where the molecules are trivially different - IF (SIZE(reference).NE.SIZE(unordered)) THEN - matches=.FALSE. - RETURN - ENDIF - - ! catch the case where the molecules are already in the right order - N=SIZE(order) - order=(/(i,i=1,N)/) - IF (matrix_equal(reference,unordered,order)) THEN - matches=.TRUE. - RETURN - ENDIF - - ! determine the kind of each atom, and the hash of the whole molecule - ALLOCATE(kind_ref(N),kind_un(N),index_ref(N),index_un(N), & - kind_ref_ordered(N),kind_un_ordered(N), & - class_of_atom(N),superclass_of_atom(N)) - CALL hash_molecule(reference,kind_ref,hash_re) - CALL hash_molecule(unordered,kind_un,hash_un) - IF (hash_re .NE. hash_un) THEN - matches=.FALSE. - RETURN - ENDIF - - ! generate the classes of equivalent atoms, i.e. the groups of atoms of the same topological kind - kind_ref_ordered(:)=kind_ref - CALL sort(kind_ref_ordered,N,index_ref) - kind_un_ordered(:)=kind_un - CALL sort(kind_un_ordered,N,index_un) - IF (ANY(kind_ref_ordered.NE.kind_un_ordered)) THEN - matches=.FALSE. - RETURN - ENDIF - - ! count different classes, assign their kinds, and the number of elements - Nclasses=1 - old_class=kind_ref_ordered(1) - DO i=2,N - IF (kind_ref_ordered(I).NE.old_class) THEN - Nclasses=Nclasses+1 - old_class=kind_ref_ordered(I) - ENDIF - ENDDO - ALLOCATE(classes(Nclasses)) - classes(1)%kind=kind_ref_ordered(1) - Nclasses=1 - classes(1)%Nele=1 - DO i=2,N - IF (kind_ref_ordered(I).NE.classes(Nclasses)%kind) THEN - Nclasses=Nclasses+1 - classes(Nclasses)%kind=kind_ref_ordered(I) - classes(Nclasses)%Nele=1 - ELSE - classes(Nclasses)%Nele=classes(Nclasses)%Nele+1 - ENDIF - ENDDO - - ! assign the atoms to their classes - iele=0 - DO I=1,Nclasses - Nele=classes(I)%Nele - ALLOCATE(classes(I)%reference(Nele)) - ALLOCATE(classes(I)%unordered(Nele)) - DO J=1,Nele - iele=iele+1 - classes(I)%reference(J)=index_ref(iele) - classes(I)%unordered(J)=index_un(iele) - ENDDO - class_of_atom(classes(I)%reference)=I - ALLOCATE(classes(I)%order(Nele)) - ALLOCATE(classes(I)%q(Nele)) - classes(I)%order=(/(J,J=1,Nele)/) - classes(I)%first=.TRUE. - ENDDO - - ! find which groups of classes (superclasses) that can be solved independently. - ! only classes with more than one element that are connected need to be reordered simultaniously - - ! find these connected components in a recursive way - superclass_of_atom=-1 - isuperclass=0 - DO I=1,N - ! this atom belongs to a class with several equivalent atoms, and has not yet been found - IF (superclass_of_atom(I).EQ.-1 .AND. classes(class_of_atom(I))%Nele>1) THEN - isuperclass=isuperclass+1 - CALL spread_superclass(I,isuperclass,superclass_of_atom,class_of_atom,classes,reference) - ENDIF - ENDDO - - ! put classes into superclasses - ALLOCATE(superclasses(isuperclass)) - superclasses%Nele=0 - DO I=1,Nclasses - J=superclass_of_atom(classes(I)%reference(1)) - IF (J>0) superclasses(J)%Nele=superclasses(J)%Nele+1 - ENDDO - DO I=1,isuperclass - ALLOCATE(superclasses(I)%classes(superclasses(I)%Nele)) - superclasses(I)%Nele=0 - ENDDO - DO I=1,Nclasses - J=superclass_of_atom(classes(I)%reference(1)) - IF (J>0) THEN - superclasses(J)%Nele=superclasses(J)%Nele+1 - superclasses(J)%classes(superclasses(J)%Nele)=I - ENDIF - ENDDO - - ! write(*,*) "Class generation time",t2-t1 - ! WRITE(*,*) "Nclasses, max size, total-non-1 ",Nclasses,MAXVAL(classes%Nele),COUNT(classes%Nele>1) - ! write(*,*) "isuperclass ",isuperclass - - ! assign the order array to their initial value - DO Iclass=1,Nclasses - order(classes(Iclass)%unordered)=classes(Iclass)%reference(classes(Iclass)%order) - ENDDO - - ! reorder the atoms superclass after superclass - itries=0 - DO I=1,isuperclass - DO - itries=itries+1 + IF (SIZE(reference) .NE. SIZE(unordered)) THEN + matches = .FALSE. + RETURN + ENDIF + + ! catch the case where the molecules are already in the right order + N = SIZE(order) + order = (/(i, i=1, N)/) + IF (matrix_equal(reference, unordered, order)) THEN + matches = .TRUE. + RETURN + ENDIF + + ! determine the kind of each atom, and the hash of the whole molecule + ALLOCATE (kind_ref(N), kind_un(N), index_ref(N), index_un(N), & + kind_ref_ordered(N), kind_un_ordered(N), & + class_of_atom(N), superclass_of_atom(N)) + CALL hash_molecule(reference, kind_ref, hash_re) + CALL hash_molecule(unordered, kind_un, hash_un) + IF (hash_re .NE. hash_un) THEN + matches = .FALSE. + RETURN + ENDIF + + ! generate the classes of equivalent atoms, i.e. the groups of atoms of the same topological kind + kind_ref_ordered(:) = kind_ref + CALL sort(kind_ref_ordered, N, index_ref) + kind_un_ordered(:) = kind_un + CALL sort(kind_un_ordered, N, index_un) + IF (ANY(kind_ref_ordered .NE. kind_un_ordered)) THEN + matches = .FALSE. + RETURN + ENDIF + + ! count different classes, assign their kinds, and the number of elements + Nclasses = 1 + old_class = kind_ref_ordered(1) + DO i = 2, N + IF (kind_ref_ordered(I) .NE. old_class) THEN + Nclasses = Nclasses + 1 + old_class = kind_ref_ordered(I) + ENDIF + ENDDO + ALLOCATE (classes(Nclasses)) + classes(1)%kind = kind_ref_ordered(1) + Nclasses = 1 + classes(1)%Nele = 1 + DO i = 2, N + IF (kind_ref_ordered(I) .NE. classes(Nclasses)%kind) THEN + Nclasses = Nclasses + 1 + classes(Nclasses)%kind = kind_ref_ordered(I) + classes(Nclasses)%Nele = 1 + ELSE + classes(Nclasses)%Nele = classes(Nclasses)%Nele + 1 + ENDIF + ENDDO + + ! assign the atoms to their classes + iele = 0 + DO I = 1, Nclasses + Nele = classes(I)%Nele + ALLOCATE (classes(I)%reference(Nele)) + ALLOCATE (classes(I)%unordered(Nele)) + DO J = 1, Nele + iele = iele + 1 + classes(I)%reference(J) = index_ref(iele) + classes(I)%unordered(J) = index_un(iele) + ENDDO + class_of_atom(classes(I)%reference) = I + ALLOCATE (classes(I)%order(Nele)) + ALLOCATE (classes(I)%q(Nele)) + classes(I)%order = (/(J, J=1, Nele)/) + classes(I)%first = .TRUE. + ENDDO + + ! find which groups of classes (superclasses) that can be solved independently. + ! only classes with more than one element that are connected need to be reordered simultaniously + + ! find these connected components in a recursive way + superclass_of_atom = -1 + isuperclass = 0 + DO I = 1, N + ! this atom belongs to a class with several equivalent atoms, and has not yet been found + IF (superclass_of_atom(I) .EQ. -1 .AND. classes(class_of_atom(I))%Nele > 1) THEN + isuperclass = isuperclass + 1 + CALL spread_superclass(I, isuperclass, superclass_of_atom, class_of_atom, classes, reference) + ENDIF + ENDDO + + ! put classes into superclasses + ALLOCATE (superclasses(isuperclass)) + superclasses%Nele = 0 + DO I = 1, Nclasses + J = superclass_of_atom(classes(I)%reference(1)) + IF (J > 0) superclasses(J)%Nele = superclasses(J)%Nele + 1 + ENDDO + DO I = 1, isuperclass + ALLOCATE (superclasses(I)%classes(superclasses(I)%Nele)) + superclasses(I)%Nele = 0 + ENDDO + DO I = 1, Nclasses + J = superclass_of_atom(classes(I)%reference(1)) + IF (J > 0) THEN + superclasses(J)%Nele = superclasses(J)%Nele + 1 + superclasses(J)%classes(superclasses(J)%Nele) = I + ENDIF + ENDDO + + ! write(*,*) "Class generation time",t2-t1 + ! WRITE(*,*) "Nclasses, max size, total-non-1 ",Nclasses,MAXVAL(classes%Nele),COUNT(classes%Nele>1) + ! write(*,*) "isuperclass ",isuperclass + + ! assign the order array to their initial value + DO Iclass = 1, Nclasses + order(classes(Iclass)%unordered) = classes(Iclass)%reference(classes(Iclass)%order) + ENDDO + + ! reorder the atoms superclass after superclass + itries = 0 + DO I = 1, isuperclass + DO + itries = itries + 1 ! assign the current order - DO iclass=1,superclasses(I)%Nele - J=superclasses(I)%classes(iclass) - order(classes(J)%unordered)=classes(J)%reference(classes(J)%order) + DO iclass = 1, superclasses(I)%Nele + J = superclasses(I)%classes(iclass) + order(classes(J)%unordered) = classes(J)%reference(classes(J)%order) ENDDO ! check for matches within this superclass only, be happy if we have a match - matches = matrix_superclass_equal(reference,unordered,order,superclasses(I),classes) - IF (itries>max_tries) THEN - WRITE(*,*) "Could not find the 1-to-1 mapping to prove graph isomorphism" - WRITE(*,*) "Reordering failed, assuming these molecules are different" + matches = matrix_superclass_equal(reference, unordered, order, superclasses(I), classes) + IF (itries > max_tries) THEN + WRITE (*, *) "Could not find the 1-to-1 mapping to prove graph isomorphism" + WRITE (*, *) "Reordering failed, assuming these molecules are different" EXIT ENDIF IF (matches) EXIT ! generate next permutation within this superclass - DO iclass=1,superclasses(I)%Nele - J=superclasses(I)%classes(iclass) - CALL all_permutations(classes(J)%order,classes(J)%Nele, & - classes(J)%q,classes(J)%first) + DO iclass = 1, superclasses(I)%Nele + J = superclasses(I)%classes(iclass) + CALL all_permutations(classes(J)%order, classes(J)%Nele, & + classes(J)%q, classes(J)%first) IF (.NOT. classes(J)%first) EXIT ENDDO ! we are back at the original permutation so we're unable to match this superclass. - IF (iclass.EQ.superclasses(I)%Nele .AND. & + IF (iclass .EQ. superclasses(I)%Nele .AND. & classes(superclasses(I)%classes(superclasses(I)%Nele))%first) EXIT - ENDDO - ! failed in this superblock, can exit now - IF (.NOT. matches) EXIT - ENDDO - - ! the final check, just to be sure - matches=matrix_equal(reference,unordered,order) - - DO Iclass=1,Nclasses - DEALLOCATE(classes(Iclass)%reference) - DEALLOCATE(classes(Iclass)%unordered) - DEALLOCATE(classes(Iclass)%order) - DEALLOCATE(classes(Iclass)%q) - ENDDO - DEALLOCATE(classes) - DO I=1,isuperclass - DEALLOCATE(superclasses(I)%classes) - ENDDO - DEALLOCATE(superclasses) - END SUBROUTINE reorder_graph + ENDDO + ! failed in this superblock, can exit now + IF (.NOT. matches) EXIT + ENDDO + + ! the final check, just to be sure + matches = matrix_equal(reference, unordered, order) + + DO Iclass = 1, Nclasses + DEALLOCATE (classes(Iclass)%reference) + DEALLOCATE (classes(Iclass)%unordered) + DEALLOCATE (classes(Iclass)%order) + DEALLOCATE (classes(Iclass)%q) + ENDDO + DEALLOCATE (classes) + DO I = 1, isuperclass + DEALLOCATE (superclasses(I)%classes) + ENDDO + DEALLOCATE (superclasses) + END SUBROUTINE reorder_graph ! ************************************************************************************************** !> \brief spreads the superclass over all atoms of this class and all their bonded atoms @@ -331,8 +331,8 @@ END SUBROUTINE reorder_graph !> \par History !> 09.2006 created [Joost VandeVondele] ! ************************************************************************************************** - RECURSIVE SUBROUTINE spread_superclass(I,isuperclass,superclass_of_atom,class_of_atom, & - classes, reference) + RECURSIVE SUBROUTINE spread_superclass(I, isuperclass, superclass_of_atom, class_of_atom, & + classes, reference) INTEGER, INTENT(IN) :: i, isuperclass INTEGER, DIMENSION(:), INTENT(INOUT) :: superclass_of_atom INTEGER, DIMENSION(:), INTENT(IN) :: class_of_atom @@ -341,18 +341,18 @@ RECURSIVE SUBROUTINE spread_superclass(I,isuperclass,superclass_of_atom,class_of INTEGER :: J - IF (superclass_of_atom(I).EQ.-1 .AND. classes(class_of_atom(I))%Nele>1) THEN - superclass_of_atom(I)=isuperclass - DO J=1, classes(class_of_atom(I))%Nele - CALL spread_superclass(classes(class_of_atom(I))%reference(J), isuperclass, & - superclass_of_atom,class_of_atom,classes,reference) - ENDDO - DO J=1,SIZE(reference(I)%bonds) - CALL spread_superclass(reference(I)%bonds(J),isuperclass, & - superclass_of_atom,class_of_atom,classes,reference) - ENDDO - ENDIF - END SUBROUTINE spread_superclass + IF (superclass_of_atom(I) .EQ. -1 .AND. classes(class_of_atom(I))%Nele > 1) THEN + superclass_of_atom(I) = isuperclass + DO J = 1, classes(class_of_atom(I))%Nele + CALL spread_superclass(classes(class_of_atom(I))%reference(J), isuperclass, & + superclass_of_atom, class_of_atom, classes, reference) + ENDDO + DO J = 1, SIZE(reference(I)%bonds) + CALL spread_superclass(reference(I)%bonds(J), isuperclass, & + superclass_of_atom, class_of_atom, classes, reference) + ENDDO + ENDIF + END SUBROUTINE spread_superclass ! ************************************************************************************************** !> \brief determines of the vertices of this superclass have the same edges @@ -365,7 +365,7 @@ END SUBROUTINE spread_superclass !> \par History !> 09.2006 created [Joost VandeVondele] ! ************************************************************************************************** - FUNCTION matrix_superclass_equal(reference,unordered,order,super,classes) RESULT(res) + FUNCTION matrix_superclass_equal(reference, unordered, order, super, classes) RESULT(res) TYPE(vertex), DIMENSION(:), INTENT(IN) :: reference, unordered INTEGER, DIMENSION(:), INTENT(IN) :: order TYPE(superclass), INTENT(IN) :: super @@ -376,24 +376,24 @@ FUNCTION matrix_superclass_equal(reference,unordered,order,super,classes) RESULT ! I is the atom in the unordered set -loop: DO iclass=1,super%Nele - DO iele=1,classes(super%classes(iclass))%Nele - I=classes(super%classes(iclass))%unordered(iele) - res=( reference(order(I))%kind == unordered(I)%kind .AND. & - SIZE(reference(order(I))%bonds) == SIZE(unordered(I)%bonds) ) - IF (res) THEN - DO J=1,SIZE(reference(order(I))%bonds) - IF (ALL(reference(order(I))%bonds(:).NE.order(unordered(I)%bonds(J)))) THEN - res=.FALSE. - EXIT loop - ENDIF - ENDDO - ELSE - EXIT loop - ENDIF + loop: DO iclass = 1, super%Nele + DO iele = 1, classes(super%classes(iclass))%Nele + I = classes(super%classes(iclass))%unordered(iele) + res = (reference(order(I))%kind == unordered(I)%kind .AND. & + SIZE(reference(order(I))%bonds) == SIZE(unordered(I)%bonds)) + IF (res) THEN + DO J = 1, SIZE(reference(order(I))%bonds) + IF (ALL(reference(order(I))%bonds(:) .NE. order(unordered(I)%bonds(J)))) THEN + res = .FALSE. + EXIT loop + ENDIF + ENDDO + ELSE + EXIT loop + ENDIF ENDDO - ENDDO loop - END FUNCTION matrix_superclass_equal + ENDDO loop + END FUNCTION matrix_superclass_equal ! ************************************************************************************************** !> \brief determines of the vertices of the full set is equal, i.e. @@ -405,28 +405,28 @@ END FUNCTION matrix_superclass_equal !> \par History !> 09.2006 created [Joost VandeVondele] ! ************************************************************************************************** - FUNCTION matrix_equal(reference,unordered,order) RESULT(res) + FUNCTION matrix_equal(reference, unordered, order) RESULT(res) TYPE(vertex), DIMENSION(:), INTENT(IN) :: reference, unordered INTEGER, DIMENSION(:), INTENT(IN) :: order LOGICAL :: res INTEGER :: I, J -loop: DO I=1,SIZE(reference) - res=( reference(order(I))%kind == unordered(I)%kind .AND. & - SIZE(reference(order(I))%bonds) == SIZE(unordered(I)%bonds) ) - IF (res) THEN - DO J=1,SIZE(reference(order(I))%bonds) - IF (ALL(reference(order(I))%bonds(:).NE.order(unordered(I)%bonds(J)))) THEN - res=.FALSE. - EXIT loop - ENDIF - ENDDO - ELSE - EXIT loop - ENDIF - ENDDO loop - END FUNCTION matrix_equal + loop: DO I = 1, SIZE(reference) + res = (reference(order(I))%kind == unordered(I)%kind .AND. & + SIZE(reference(order(I))%bonds) == SIZE(unordered(I)%bonds)) + IF (res) THEN + DO J = 1, SIZE(reference(order(I))%bonds) + IF (ALL(reference(order(I))%bonds(:) .NE. order(unordered(I)%bonds(J)))) THEN + res = .FALSE. + EXIT loop + ENDIF + ENDDO + ELSE + EXIT loop + ENDIF + ENDDO loop + END FUNCTION matrix_equal ! ************************************************************************************************** !> \brief creates a hash for an atom based on its own kind and on the kinds @@ -440,7 +440,7 @@ END FUNCTION matrix_equal !> bonds are sorted so that the order of neighbors appearing in the bonded list !> is not important ! ************************************************************************************************** - FUNCTION hash_kind(me,bonds) RESULT(res) + FUNCTION hash_kind(me, bonds) RESULT(res) INTEGER, INTENT(IN) :: me INTEGER, DIMENSION(:), INTENT(IN) :: bonds INTEGER :: res @@ -448,16 +448,16 @@ FUNCTION hash_kind(me,bonds) RESULT(res) INTEGER :: I, N INTEGER, ALLOCATABLE, DIMENSION(:) :: index, ordered_bonds - N=SIZE(bonds) - ALLOCATE(ordered_bonds(N+1),INDEX(N)) - DO I=1,N - ordered_bonds(I)=bonds(I) - ENDDO - ordered_bonds(N+1)=me - ! N: only sort the bonds, not me - CALL sort(ordered_bonds,N,index) - res=joaat_hash_i(ordered_bonds) - END FUNCTION hash_kind + N = SIZE(bonds) + ALLOCATE (ordered_bonds(N + 1), INDEX(N)) + DO I = 1, N + ordered_bonds(I) = bonds(I) + ENDDO + ordered_bonds(N + 1) = me + ! N: only sort the bonds, not me + CALL sort(ordered_bonds, N, index) + res = joaat_hash_i(ordered_bonds) + END FUNCTION hash_kind ! ************************************************************************************************** !> \brief generates the hash of an array of integers and the index in the table @@ -472,38 +472,38 @@ END FUNCTION hash_kind !> we compute it using an integer with the appropriate range !> we return already the index in the table as a final result ! ************************************************************************************************** - FUNCTION joaat_hash_i(key) RESULT(hash_index) + FUNCTION joaat_hash_i(key) RESULT(hash_index) INTEGER, DIMENSION(:), INTENT(IN) :: key INTEGER :: hash_index INTEGER, PARAMETER :: k64 = SELECTED_INT_KIND(10) - INTEGER(KIND=k64), PARAMETER :: b32 = 2_k64**32-1_k64 + INTEGER(KIND=k64), PARAMETER :: b32 = 2_k64**32 - 1_k64 INTEGER :: i INTEGER(KIND=k64) :: hash - hash=0_k64 - DO i=1,SIZE(key) - hash=IAND(hash+IBITS(key(i),0,8) ,b32) - hash=IAND( hash+IAND(ISHFT(hash,10),b32) ,b32) - hash=IAND(IEOR(hash,IAND(ISHFT(hash,-6),b32)) ,b32) - hash=IAND(hash+IBITS(key(i),8,8) ,b32) - hash=IAND( hash+IAND(ISHFT(hash,10),b32) ,b32) - hash=IAND(IEOR(hash,IAND(ISHFT(hash,-6),b32)) ,b32) - hash=IAND(hash+IBITS(key(i),16,8) ,b32) - hash=IAND( hash+IAND(ISHFT(hash,10),b32) ,b32) - hash=IAND(IEOR(hash,IAND(ISHFT(hash,-6),b32)) ,b32) - hash=IAND(hash+IBITS(key(i),24,8) ,b32) - hash=IAND( hash+IAND(ISHFT(hash,10),b32) ,b32) - hash=IAND(IEOR(hash,IAND(ISHFT(hash,-6),b32)) ,b32) - ENDDO - hash=IAND( hash+IAND(ISHFT(hash, 3),b32) ,b32) - hash=IAND(IEOR(hash,IAND(ISHFT(hash,-11),b32)) ,b32) - hash=IAND( hash+IAND(ISHFT(hash, 15),b32) ,b32) - ! hash is the real 32bit hash value of the string, - ! hash_index is an index in the hash_table - hash_index=INT(MOD(hash,INT(HUGE(hash_index),KIND=k64)),KIND=KIND(hash_index)) - END FUNCTION joaat_hash_i + hash = 0_k64 + DO i = 1, SIZE(key) + hash = IAND(hash + IBITS(key(i), 0, 8), b32) + hash = IAND(hash + IAND(ISHFT(hash, 10), b32), b32) + hash = IAND(IEOR(hash, IAND(ISHFT(hash, -6), b32)), b32) + hash = IAND(hash + IBITS(key(i), 8, 8), b32) + hash = IAND(hash + IAND(ISHFT(hash, 10), b32), b32) + hash = IAND(IEOR(hash, IAND(ISHFT(hash, -6), b32)), b32) + hash = IAND(hash + IBITS(key(i), 16, 8), b32) + hash = IAND(hash + IAND(ISHFT(hash, 10), b32), b32) + hash = IAND(IEOR(hash, IAND(ISHFT(hash, -6), b32)), b32) + hash = IAND(hash + IBITS(key(i), 24, 8), b32) + hash = IAND(hash + IAND(ISHFT(hash, 10), b32), b32) + hash = IAND(IEOR(hash, IAND(ISHFT(hash, -6), b32)), b32) + ENDDO + hash = IAND(hash + IAND(ISHFT(hash, 3), b32), b32) + hash = IAND(IEOR(hash, IAND(ISHFT(hash, -11), b32)), b32) + hash = IAND(hash + IAND(ISHFT(hash, 15), b32), b32) + ! hash is the real 32bit hash value of the string, + ! hash_index is an index in the hash_table + hash_index = INT(MOD(hash, INT(HUGE(hash_index), KIND=k64)), KIND=KIND(hash_index)) + END FUNCTION joaat_hash_i !===ACM Algorithm 323, Generation of Permutations in Lexicographic ! Order (G6) by R. J. Ord-Smith, CACM 11 (Feb. 1968):117 @@ -521,55 +521,55 @@ END FUNCTION joaat_hash_i !> \param q ... !> \param first ... ! ************************************************************************************************** - SUBROUTINE all_permutations(x,n,q,first) + SUBROUTINE all_permutations(x, n, q, first) INTEGER :: n, x(n), q(n) LOGICAL :: first INTEGER :: k, m, t - IF (n==1) RETURN - IF (first) THEN - first=.FALSE. - DO m=1,n-1 - q(m)=n - END DO - ENDIF - IF(q(n-1).EQ.n) THEN - q(n-1)=n-1 - t=x(n) - x(n)=x(n-1) - x(n-1)=t - RETURN - ENDIF - DO k=n-1,1,-1 - IF(q(k).EQ.k) THEN - q(k)=n - ELSE + IF (n == 1) RETURN + IF (first) THEN + first = .FALSE. + DO m = 1, n - 1 + q(m) = n + END DO + ENDIF + IF (q(n - 1) .EQ. n) THEN + q(n - 1) = n - 1 + t = x(n) + x(n) = x(n - 1) + x(n - 1) = t + RETURN + ENDIF + DO k = n - 1, 1, -1 + IF (q(k) .EQ. k) THEN + q(k) = n + ELSE go to 1 - ENDIF - END DO - first=.TRUE. - k=1 - GOTO 2 -1 m=q(k) - t=x(m) - x(m)=x(k) - x(k)=t - q(k)=m-1 - k=k+1 -2 m=n - t=x(m) - x(m)=x(k) - x(k)=t - m=m-1 - k=k+1 - DO WHILE (k.LT.m) - t=x(m) - x(m)=x(k) - x(k)=t - m=m-1 - k=k+1 - END DO - END SUBROUTINE + ENDIF + END DO + first = .TRUE. + k = 1 + GOTO 2 +1 m = q(k) + t = x(m) + x(m) = x(k) + x(k) = t + q(k) = m - 1 + k = k + 1 +2 m = n + t = x(m) + x(m) = x(k) + x(k) = t + m = m - 1 + k = k + 1 + DO WHILE (k .LT. m) + t = x(m) + x(m) = x(k) + x(k) = t + m = m - 1 + k = k + 1 + END DO + END SUBROUTINE END MODULE graphcon diff --git a/src/grid/collocate_fast_1.f90 b/src/grid/collocate_fast_1.f90 index 52366068e7..4de683ebc0 100644 --- a/src/grid/collocate_fast_1.f90 +++ b/src/grid/collocate_fast_1.f90 @@ -14,7 +14,7 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bounds, lp, cmax, gridbounds) USE kinds, ONLY: dp INTEGER, INTENT(IN) :: sphere_bounds(*), lp - REAL(dp), INTENT(IN) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(IN) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER, INTENT(IN) :: cmax REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & @@ -29,15 +29,15 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) @@ -45,35 +45,35 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_xyz(lxyz)*pol_z(1, lzp, kg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_xyz(lxyz)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_xyz(lxyz)*pol_z(1, lzp, kg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_xyz(lxyz)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_x(1, lxp) = coef_x(1, lxp)+coef_xy(1, lxy)*pol_y(1, lyp, jg) - coef_x(2, lxp) = coef_x(2, lxp)+coef_xy(2, lxy)*pol_y(1, lyp, jg) - coef_x(3, lxp) = coef_x(3, lxp)+coef_xy(1, lxy)*pol_y(2, lyp, jg) - coef_x(4, lxp) = coef_x(4, lxp)+coef_xy(2, lxy)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_x(1, lxp) = coef_x(1, lxp) + coef_xy(1, lxy)*pol_y(1, lyp, jg) + coef_x(2, lxp) = coef_x(2, lxp) + coef_xy(2, lxy)*pol_y(1, lyp, jg) + coef_x(3, lxp) = coef_x(3, lxp) + coef_xy(1, lxy)*pol_y(2, lyp, jg) + coef_x(4, lxp) = coef_x(4, lxp) + coef_xy(2, lxy)*pol_y(2, lyp, jg) ENDDO ENDDO @@ -84,15 +84,15 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe s03 = 0.0_dp s04 = 0.0_dp DO lxp = 0, lp - s01 = s01+coef_x(1, lxp)*pol_x(lxp, ig) - s02 = s02+coef_x(2, lxp)*pol_x(lxp, ig) - s03 = s03+coef_x(3, lxp)*pol_x(lxp, ig) - s04 = s04+coef_x(4, lxp)*pol_x(lxp, ig) + s01 = s01 + coef_x(1, lxp)*pol_x(lxp, ig) + s02 = s02 + coef_x(2, lxp)*pol_x(lxp, ig) + s03 = s03 + coef_x(3, lxp)*pol_x(lxp, ig) + s04 = s04 + coef_x(4, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO @@ -120,65 +120,65 @@ SUBROUTINE collocate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 0 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_xyz(lxyz)*pol_z(1, lzp, kg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_xyz(lxyz)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_xyz(lxyz)*pol_z(1, lzp, kg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_xyz(lxyz)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -205,77 +205,77 @@ SUBROUTINE collocate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 1 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_xyz(lxyz)*pol_z(1, lzp, kg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_xyz(lxyz)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_xyz(lxyz)*pol_z(1, lzp, kg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_xyz(lxyz)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 3)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 3)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 3)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 3)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 3)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 3)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 3)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 3)*pol_y(2, 1, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -302,93 +302,93 @@ SUBROUTINE collocate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 2 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_xyz(lxyz)*pol_z(1, lzp, kg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_xyz(lxyz)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_xyz(lxyz)*pol_z(1, lzp, kg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_xyz(lxyz)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 4)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 4)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 4)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 4)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 5)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 5)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 5)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 5)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 6)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 6)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 6)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 6)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 4)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 4)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 4)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 4)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 5)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 5)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 5)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 5)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 6)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 6)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 6)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 6)*pol_y(2, 2, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -415,140 +415,140 @@ SUBROUTINE collocate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 3 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(7)*pol_z(1, 0, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(7)*pol_z(2, 0, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(8)*pol_z(1, 0, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(8)*pol_z(2, 0, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(9)*pol_z(1, 0, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(9)*pol_z(2, 0, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(10)*pol_z(1, 0, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(10)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(11)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(11)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(12)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(12)*pol_z(2, 1, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(13)*pol_z(1, 1, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(13)*pol_z(2, 1, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(14)*pol_z(1, 1, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(14)*pol_z(2, 1, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(15)*pol_z(1, 1, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(15)*pol_z(2, 1, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(16)*pol_z(1, 1, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(16)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(17)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(17)*pol_z(2, 2, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(18)*pol_z(1, 2, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(18)*pol_z(2, 2, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(19)*pol_z(1, 2, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(19)*pol_z(2, 2, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(20)*pol_z(1, 3, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(20)*pol_z(2, 3, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(7)*pol_z(1, 0, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(7)*pol_z(2, 0, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(8)*pol_z(1, 0, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(8)*pol_z(2, 0, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(9)*pol_z(1, 0, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(9)*pol_z(2, 0, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(10)*pol_z(1, 0, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(10)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(11)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(11)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(12)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(12)*pol_z(2, 1, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(13)*pol_z(1, 1, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(13)*pol_z(2, 1, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(14)*pol_z(1, 1, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(14)*pol_z(2, 1, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(15)*pol_z(1, 1, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(15)*pol_z(2, 1, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(16)*pol_z(1, 1, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(16)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(17)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(17)*pol_z(2, 2, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(18)*pol_z(1, 2, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(18)*pol_z(2, 2, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(19)*pol_z(1, 2, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(19)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(20)*pol_z(1, 3, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(20)*pol_z(2, 3, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 4)*pol_y(1, 0, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 4)*pol_y(1, 0, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 4)*pol_y(2, 0, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 4)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 5)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 5)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 5)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 5)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 6)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 6)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 6)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 6)*pol_y(2, 1, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 7)*pol_y(1, 1, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 7)*pol_y(1, 1, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 7)*pol_y(2, 1, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 7)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 8)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 8)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 8)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 8)*pol_y(2, 2, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 9)*pol_y(1, 2, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 9)*pol_y(1, 2, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 9)*pol_y(2, 2, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 9)*pol_y(2, 2, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 10)*pol_y(1, 3, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 10)*pol_y(1, 3, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 10)*pol_y(2, 3, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 10)*pol_y(2, 3, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 4)*pol_y(1, 0, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 4)*pol_y(1, 0, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 4)*pol_y(2, 0, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 4)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 5)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 5)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 5)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 5)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 6)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 6)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 6)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 6)*pol_y(2, 1, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 7)*pol_y(1, 1, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 7)*pol_y(1, 1, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 7)*pol_y(2, 1, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 7)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 8)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 8)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 8)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 8)*pol_y(2, 2, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 9)*pol_y(1, 2, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 9)*pol_y(1, 2, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 9)*pol_y(2, 2, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 9)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 10)*pol_y(1, 3, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 10)*pol_y(1, 3, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 10)*pol_y(2, 3, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 10)*pol_y(2, 3, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -575,194 +575,194 @@ SUBROUTINE collocate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 4 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(7)*pol_z(1, 0, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(7)*pol_z(2, 0, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(8)*pol_z(1, 0, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(8)*pol_z(2, 0, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(9)*pol_z(1, 0, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(9)*pol_z(2, 0, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(10)*pol_z(1, 0, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(10)*pol_z(2, 0, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(11)*pol_z(1, 0, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(11)*pol_z(2, 0, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(12)*pol_z(1, 0, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(12)*pol_z(2, 0, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(13)*pol_z(1, 0, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(13)*pol_z(2, 0, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(14)*pol_z(1, 0, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(14)*pol_z(2, 0, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(15)*pol_z(1, 0, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(15)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(16)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(16)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(17)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(17)*pol_z(2, 1, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(18)*pol_z(1, 1, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(18)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(19)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(19)*pol_z(2, 1, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(20)*pol_z(1, 1, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(20)*pol_z(2, 1, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(21)*pol_z(1, 1, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(21)*pol_z(2, 1, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(22)*pol_z(1, 1, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(22)*pol_z(2, 1, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(23)*pol_z(1, 1, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(23)*pol_z(2, 1, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(24)*pol_z(1, 1, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(24)*pol_z(2, 1, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(25)*pol_z(1, 1, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(25)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(26)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(26)*pol_z(2, 2, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(27)*pol_z(1, 2, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(27)*pol_z(2, 2, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(28)*pol_z(1, 2, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(28)*pol_z(2, 2, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(29)*pol_z(1, 2, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(29)*pol_z(2, 2, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(30)*pol_z(1, 2, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(30)*pol_z(2, 2, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(31)*pol_z(1, 2, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(31)*pol_z(2, 2, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(32)*pol_z(1, 3, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(32)*pol_z(2, 3, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(33)*pol_z(1, 3, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(33)*pol_z(2, 3, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(34)*pol_z(1, 3, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(34)*pol_z(2, 3, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(35)*pol_z(1, 4, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(35)*pol_z(2, 4, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(7)*pol_z(1, 0, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(7)*pol_z(2, 0, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(8)*pol_z(1, 0, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(8)*pol_z(2, 0, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(9)*pol_z(1, 0, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(9)*pol_z(2, 0, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(10)*pol_z(1, 0, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(10)*pol_z(2, 0, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(11)*pol_z(1, 0, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(11)*pol_z(2, 0, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(12)*pol_z(1, 0, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(12)*pol_z(2, 0, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(13)*pol_z(1, 0, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(13)*pol_z(2, 0, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(14)*pol_z(1, 0, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(14)*pol_z(2, 0, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(15)*pol_z(1, 0, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(15)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(16)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(16)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(17)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(17)*pol_z(2, 1, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(18)*pol_z(1, 1, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(18)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(19)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(19)*pol_z(2, 1, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(20)*pol_z(1, 1, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(20)*pol_z(2, 1, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(21)*pol_z(1, 1, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(21)*pol_z(2, 1, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(22)*pol_z(1, 1, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(22)*pol_z(2, 1, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(23)*pol_z(1, 1, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(23)*pol_z(2, 1, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(24)*pol_z(1, 1, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(24)*pol_z(2, 1, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(25)*pol_z(1, 1, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(25)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(26)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(26)*pol_z(2, 2, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(27)*pol_z(1, 2, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(27)*pol_z(2, 2, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(28)*pol_z(1, 2, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(28)*pol_z(2, 2, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(29)*pol_z(1, 2, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(29)*pol_z(2, 2, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(30)*pol_z(1, 2, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(30)*pol_z(2, 2, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(31)*pol_z(1, 2, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(31)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(32)*pol_z(1, 3, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(32)*pol_z(2, 3, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(33)*pol_z(1, 3, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(33)*pol_z(2, 3, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(34)*pol_z(1, 3, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(34)*pol_z(2, 3, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(35)*pol_z(1, 4, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(35)*pol_z(2, 4, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 4)*pol_y(1, 0, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 4)*pol_y(1, 0, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 4)*pol_y(2, 0, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 4)*pol_y(2, 0, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 5)*pol_y(1, 0, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 5)*pol_y(1, 0, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 5)*pol_y(2, 0, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 5)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 6)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 6)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 6)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 6)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 7)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 7)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 7)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 7)*pol_y(2, 1, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 8)*pol_y(1, 1, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 8)*pol_y(1, 1, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 8)*pol_y(2, 1, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 8)*pol_y(2, 1, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 9)*pol_y(1, 1, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 9)*pol_y(1, 1, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 9)*pol_y(2, 1, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 9)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 10)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 10)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 10)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 10)*pol_y(2, 2, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 11)*pol_y(1, 2, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 11)*pol_y(1, 2, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 11)*pol_y(2, 2, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 11)*pol_y(2, 2, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 12)*pol_y(1, 2, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 12)*pol_y(1, 2, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 12)*pol_y(2, 2, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 12)*pol_y(2, 2, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 13)*pol_y(1, 3, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 13)*pol_y(1, 3, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 13)*pol_y(2, 3, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 13)*pol_y(2, 3, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 14)*pol_y(1, 3, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 14)*pol_y(1, 3, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 14)*pol_y(2, 3, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 14)*pol_y(2, 3, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 15)*pol_y(1, 4, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 15)*pol_y(1, 4, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 15)*pol_y(2, 4, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 15)*pol_y(2, 4, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 4)*pol_y(1, 0, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 4)*pol_y(1, 0, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 4)*pol_y(2, 0, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 4)*pol_y(2, 0, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 5)*pol_y(1, 0, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 5)*pol_y(1, 0, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 5)*pol_y(2, 0, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 5)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 6)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 6)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 6)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 6)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 7)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 7)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 7)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 7)*pol_y(2, 1, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 8)*pol_y(1, 1, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 8)*pol_y(1, 1, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 8)*pol_y(2, 1, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 8)*pol_y(2, 1, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 9)*pol_y(1, 1, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 9)*pol_y(1, 1, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 9)*pol_y(2, 1, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 9)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 10)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 10)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 10)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 10)*pol_y(2, 2, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 11)*pol_y(1, 2, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 11)*pol_y(1, 2, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 11)*pol_y(2, 2, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 11)*pol_y(2, 2, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 12)*pol_y(1, 2, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 12)*pol_y(1, 2, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 12)*pol_y(2, 2, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 12)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 13)*pol_y(1, 3, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 13)*pol_y(1, 3, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 13)*pol_y(2, 3, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 13)*pol_y(2, 3, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 14)*pol_y(1, 3, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 14)*pol_y(1, 3, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 14)*pol_y(2, 3, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 14)*pol_y(2, 3, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 15)*pol_y(1, 4, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 15)*pol_y(1, 4, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 15)*pol_y(2, 4, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 15)*pol_y(2, 4, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - s01 = s01+coef_x(1, 4)*pol_x(4, ig) - s02 = s02+coef_x(2, 4)*pol_x(4, ig) - s03 = s03+coef_x(3, 4)*pol_x(4, ig) - s04 = s04+coef_x(4, 4)*pol_x(4, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + s01 = s01 + coef_x(1, 4)*pol_x(4, ig) + s02 = s02 + coef_x(2, 4)*pol_x(4, ig) + s03 = s03 + coef_x(3, 4)*pol_x(4, ig) + s04 = s04 + coef_x(4, 4)*pol_x(4, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -789,264 +789,264 @@ SUBROUTINE collocate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 5 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(7)*pol_z(1, 0, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(7)*pol_z(2, 0, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(8)*pol_z(1, 0, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(8)*pol_z(2, 0, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(9)*pol_z(1, 0, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(9)*pol_z(2, 0, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(10)*pol_z(1, 0, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(10)*pol_z(2, 0, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(11)*pol_z(1, 0, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(11)*pol_z(2, 0, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(12)*pol_z(1, 0, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(12)*pol_z(2, 0, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(13)*pol_z(1, 0, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(13)*pol_z(2, 0, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(14)*pol_z(1, 0, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(14)*pol_z(2, 0, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(15)*pol_z(1, 0, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(15)*pol_z(2, 0, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(16)*pol_z(1, 0, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(16)*pol_z(2, 0, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(17)*pol_z(1, 0, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(17)*pol_z(2, 0, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(18)*pol_z(1, 0, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(18)*pol_z(2, 0, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(19)*pol_z(1, 0, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(19)*pol_z(2, 0, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(20)*pol_z(1, 0, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(20)*pol_z(2, 0, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(21)*pol_z(1, 0, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(21)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(22)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(22)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(23)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(23)*pol_z(2, 1, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(24)*pol_z(1, 1, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(24)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(25)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(25)*pol_z(2, 1, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(26)*pol_z(1, 1, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(26)*pol_z(2, 1, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(27)*pol_z(1, 1, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(27)*pol_z(2, 1, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(28)*pol_z(1, 1, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(28)*pol_z(2, 1, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(29)*pol_z(1, 1, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(29)*pol_z(2, 1, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(30)*pol_z(1, 1, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(30)*pol_z(2, 1, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(31)*pol_z(1, 1, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(31)*pol_z(2, 1, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(32)*pol_z(1, 1, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(32)*pol_z(2, 1, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(33)*pol_z(1, 1, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(33)*pol_z(2, 1, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(34)*pol_z(1, 1, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(34)*pol_z(2, 1, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(35)*pol_z(1, 1, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(35)*pol_z(2, 1, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(36)*pol_z(1, 1, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(36)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(37)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(37)*pol_z(2, 2, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(38)*pol_z(1, 2, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(38)*pol_z(2, 2, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(39)*pol_z(1, 2, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(39)*pol_z(2, 2, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(40)*pol_z(1, 2, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(40)*pol_z(2, 2, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(41)*pol_z(1, 2, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(41)*pol_z(2, 2, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(42)*pol_z(1, 2, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(42)*pol_z(2, 2, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(43)*pol_z(1, 2, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(43)*pol_z(2, 2, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(44)*pol_z(1, 2, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(44)*pol_z(2, 2, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(45)*pol_z(1, 2, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(45)*pol_z(2, 2, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(46)*pol_z(1, 2, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(46)*pol_z(2, 2, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(47)*pol_z(1, 3, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(47)*pol_z(2, 3, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(48)*pol_z(1, 3, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(48)*pol_z(2, 3, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(49)*pol_z(1, 3, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(49)*pol_z(2, 3, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(50)*pol_z(1, 3, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(50)*pol_z(2, 3, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(51)*pol_z(1, 3, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(51)*pol_z(2, 3, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(52)*pol_z(1, 3, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(52)*pol_z(2, 3, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(53)*pol_z(1, 4, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(53)*pol_z(2, 4, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(54)*pol_z(1, 4, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(54)*pol_z(2, 4, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(55)*pol_z(1, 4, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(55)*pol_z(2, 4, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(56)*pol_z(1, 5, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(56)*pol_z(2, 5, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(7)*pol_z(1, 0, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(7)*pol_z(2, 0, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(8)*pol_z(1, 0, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(8)*pol_z(2, 0, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(9)*pol_z(1, 0, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(9)*pol_z(2, 0, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(10)*pol_z(1, 0, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(10)*pol_z(2, 0, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(11)*pol_z(1, 0, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(11)*pol_z(2, 0, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(12)*pol_z(1, 0, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(12)*pol_z(2, 0, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(13)*pol_z(1, 0, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(13)*pol_z(2, 0, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(14)*pol_z(1, 0, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(14)*pol_z(2, 0, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(15)*pol_z(1, 0, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(15)*pol_z(2, 0, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(16)*pol_z(1, 0, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(16)*pol_z(2, 0, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(17)*pol_z(1, 0, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(17)*pol_z(2, 0, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(18)*pol_z(1, 0, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(18)*pol_z(2, 0, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(19)*pol_z(1, 0, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(19)*pol_z(2, 0, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(20)*pol_z(1, 0, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(20)*pol_z(2, 0, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(21)*pol_z(1, 0, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(21)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(22)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(22)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(23)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(23)*pol_z(2, 1, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(24)*pol_z(1, 1, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(24)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(25)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(25)*pol_z(2, 1, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(26)*pol_z(1, 1, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(26)*pol_z(2, 1, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(27)*pol_z(1, 1, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(27)*pol_z(2, 1, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(28)*pol_z(1, 1, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(28)*pol_z(2, 1, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(29)*pol_z(1, 1, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(29)*pol_z(2, 1, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(30)*pol_z(1, 1, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(30)*pol_z(2, 1, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(31)*pol_z(1, 1, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(31)*pol_z(2, 1, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(32)*pol_z(1, 1, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(32)*pol_z(2, 1, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(33)*pol_z(1, 1, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(33)*pol_z(2, 1, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(34)*pol_z(1, 1, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(34)*pol_z(2, 1, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(35)*pol_z(1, 1, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(35)*pol_z(2, 1, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(36)*pol_z(1, 1, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(36)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(37)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(37)*pol_z(2, 2, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(38)*pol_z(1, 2, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(38)*pol_z(2, 2, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(39)*pol_z(1, 2, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(39)*pol_z(2, 2, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(40)*pol_z(1, 2, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(40)*pol_z(2, 2, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(41)*pol_z(1, 2, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(41)*pol_z(2, 2, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(42)*pol_z(1, 2, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(42)*pol_z(2, 2, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(43)*pol_z(1, 2, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(43)*pol_z(2, 2, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(44)*pol_z(1, 2, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(44)*pol_z(2, 2, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(45)*pol_z(1, 2, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(45)*pol_z(2, 2, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(46)*pol_z(1, 2, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(46)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(47)*pol_z(1, 3, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(47)*pol_z(2, 3, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(48)*pol_z(1, 3, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(48)*pol_z(2, 3, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(49)*pol_z(1, 3, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(49)*pol_z(2, 3, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(50)*pol_z(1, 3, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(50)*pol_z(2, 3, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(51)*pol_z(1, 3, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(51)*pol_z(2, 3, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(52)*pol_z(1, 3, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(52)*pol_z(2, 3, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(53)*pol_z(1, 4, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(53)*pol_z(2, 4, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(54)*pol_z(1, 4, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(54)*pol_z(2, 4, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(55)*pol_z(1, 4, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(55)*pol_z(2, 4, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(56)*pol_z(1, 5, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(56)*pol_z(2, 5, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 4)*pol_y(1, 0, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 4)*pol_y(1, 0, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 4)*pol_y(2, 0, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 4)*pol_y(2, 0, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 5)*pol_y(1, 0, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 5)*pol_y(1, 0, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 5)*pol_y(2, 0, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 5)*pol_y(2, 0, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 6)*pol_y(1, 0, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 6)*pol_y(1, 0, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 6)*pol_y(2, 0, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 6)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 7)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 7)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 7)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 7)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 8)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 8)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 8)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 8)*pol_y(2, 1, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 9)*pol_y(1, 1, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 9)*pol_y(1, 1, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 9)*pol_y(2, 1, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 9)*pol_y(2, 1, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 10)*pol_y(1, 1, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 10)*pol_y(1, 1, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 10)*pol_y(2, 1, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 10)*pol_y(2, 1, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 11)*pol_y(1, 1, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 11)*pol_y(1, 1, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 11)*pol_y(2, 1, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 11)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 12)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 12)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 12)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 12)*pol_y(2, 2, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 13)*pol_y(1, 2, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 13)*pol_y(1, 2, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 13)*pol_y(2, 2, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 13)*pol_y(2, 2, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 14)*pol_y(1, 2, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 14)*pol_y(1, 2, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 14)*pol_y(2, 2, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 14)*pol_y(2, 2, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 15)*pol_y(1, 2, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 15)*pol_y(1, 2, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 15)*pol_y(2, 2, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 15)*pol_y(2, 2, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 16)*pol_y(1, 3, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 16)*pol_y(1, 3, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 16)*pol_y(2, 3, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 16)*pol_y(2, 3, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 17)*pol_y(1, 3, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 17)*pol_y(1, 3, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 17)*pol_y(2, 3, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 17)*pol_y(2, 3, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 18)*pol_y(1, 3, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 18)*pol_y(1, 3, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 18)*pol_y(2, 3, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 18)*pol_y(2, 3, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 19)*pol_y(1, 4, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 19)*pol_y(1, 4, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 19)*pol_y(2, 4, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 19)*pol_y(2, 4, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 20)*pol_y(1, 4, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 20)*pol_y(1, 4, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 20)*pol_y(2, 4, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 20)*pol_y(2, 4, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 21)*pol_y(1, 5, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 21)*pol_y(1, 5, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 21)*pol_y(2, 5, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 21)*pol_y(2, 5, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 4)*pol_y(1, 0, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 4)*pol_y(1, 0, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 4)*pol_y(2, 0, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 4)*pol_y(2, 0, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 5)*pol_y(1, 0, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 5)*pol_y(1, 0, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 5)*pol_y(2, 0, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 5)*pol_y(2, 0, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 6)*pol_y(1, 0, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 6)*pol_y(1, 0, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 6)*pol_y(2, 0, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 6)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 7)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 7)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 7)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 7)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 8)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 8)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 8)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 8)*pol_y(2, 1, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 9)*pol_y(1, 1, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 9)*pol_y(1, 1, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 9)*pol_y(2, 1, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 9)*pol_y(2, 1, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 10)*pol_y(1, 1, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 10)*pol_y(1, 1, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 10)*pol_y(2, 1, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 10)*pol_y(2, 1, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 11)*pol_y(1, 1, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 11)*pol_y(1, 1, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 11)*pol_y(2, 1, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 11)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 12)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 12)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 12)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 12)*pol_y(2, 2, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 13)*pol_y(1, 2, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 13)*pol_y(1, 2, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 13)*pol_y(2, 2, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 13)*pol_y(2, 2, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 14)*pol_y(1, 2, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 14)*pol_y(1, 2, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 14)*pol_y(2, 2, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 14)*pol_y(2, 2, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 15)*pol_y(1, 2, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 15)*pol_y(1, 2, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 15)*pol_y(2, 2, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 15)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 16)*pol_y(1, 3, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 16)*pol_y(1, 3, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 16)*pol_y(2, 3, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 16)*pol_y(2, 3, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 17)*pol_y(1, 3, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 17)*pol_y(1, 3, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 17)*pol_y(2, 3, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 17)*pol_y(2, 3, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 18)*pol_y(1, 3, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 18)*pol_y(1, 3, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 18)*pol_y(2, 3, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 18)*pol_y(2, 3, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 19)*pol_y(1, 4, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 19)*pol_y(1, 4, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 19)*pol_y(2, 4, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 19)*pol_y(2, 4, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 20)*pol_y(1, 4, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 20)*pol_y(1, 4, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 20)*pol_y(2, 4, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 20)*pol_y(2, 4, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 21)*pol_y(1, 5, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 21)*pol_y(1, 5, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 21)*pol_y(2, 5, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 21)*pol_y(2, 5, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - s01 = s01+coef_x(1, 4)*pol_x(4, ig) - s02 = s02+coef_x(2, 4)*pol_x(4, ig) - s03 = s03+coef_x(3, 4)*pol_x(4, ig) - s04 = s04+coef_x(4, 4)*pol_x(4, ig) - s01 = s01+coef_x(1, 5)*pol_x(5, ig) - s02 = s02+coef_x(2, 5)*pol_x(5, ig) - s03 = s03+coef_x(3, 5)*pol_x(5, ig) - s04 = s04+coef_x(4, 5)*pol_x(5, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + s01 = s01 + coef_x(1, 4)*pol_x(4, ig) + s02 = s02 + coef_x(2, 4)*pol_x(4, ig) + s03 = s03 + coef_x(3, 4)*pol_x(4, ig) + s04 = s04 + coef_x(4, 4)*pol_x(4, ig) + s01 = s01 + coef_x(1, 5)*pol_x(5, ig) + s02 = s02 + coef_x(2, 5)*pol_x(5, ig) + s03 = s03 + coef_x(3, 5)*pol_x(5, ig) + s04 = s04 + coef_x(4, 5)*pol_x(5, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -1073,352 +1073,352 @@ SUBROUTINE collocate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 6 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(7)*pol_z(1, 0, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(7)*pol_z(2, 0, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(8)*pol_z(1, 0, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(8)*pol_z(2, 0, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(9)*pol_z(1, 0, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(9)*pol_z(2, 0, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(10)*pol_z(1, 0, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(10)*pol_z(2, 0, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(11)*pol_z(1, 0, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(11)*pol_z(2, 0, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(12)*pol_z(1, 0, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(12)*pol_z(2, 0, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(13)*pol_z(1, 0, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(13)*pol_z(2, 0, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(14)*pol_z(1, 0, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(14)*pol_z(2, 0, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(15)*pol_z(1, 0, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(15)*pol_z(2, 0, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(16)*pol_z(1, 0, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(16)*pol_z(2, 0, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(17)*pol_z(1, 0, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(17)*pol_z(2, 0, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(18)*pol_z(1, 0, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(18)*pol_z(2, 0, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(19)*pol_z(1, 0, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(19)*pol_z(2, 0, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(20)*pol_z(1, 0, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(20)*pol_z(2, 0, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(21)*pol_z(1, 0, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(21)*pol_z(2, 0, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(22)*pol_z(1, 0, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(22)*pol_z(2, 0, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(23)*pol_z(1, 0, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(23)*pol_z(2, 0, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(24)*pol_z(1, 0, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(24)*pol_z(2, 0, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(25)*pol_z(1, 0, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(25)*pol_z(2, 0, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(26)*pol_z(1, 0, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(26)*pol_z(2, 0, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(27)*pol_z(1, 0, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(27)*pol_z(2, 0, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(28)*pol_z(1, 0, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(28)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(29)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(29)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(30)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(30)*pol_z(2, 1, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(31)*pol_z(1, 1, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(31)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(32)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(32)*pol_z(2, 1, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(33)*pol_z(1, 1, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(33)*pol_z(2, 1, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(34)*pol_z(1, 1, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(34)*pol_z(2, 1, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(35)*pol_z(1, 1, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(35)*pol_z(2, 1, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(36)*pol_z(1, 1, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(36)*pol_z(2, 1, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(37)*pol_z(1, 1, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(37)*pol_z(2, 1, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(38)*pol_z(1, 1, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(38)*pol_z(2, 1, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(39)*pol_z(1, 1, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(39)*pol_z(2, 1, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(40)*pol_z(1, 1, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(40)*pol_z(2, 1, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(41)*pol_z(1, 1, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(41)*pol_z(2, 1, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(42)*pol_z(1, 1, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(42)*pol_z(2, 1, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(43)*pol_z(1, 1, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(43)*pol_z(2, 1, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(44)*pol_z(1, 1, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(44)*pol_z(2, 1, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(45)*pol_z(1, 1, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(45)*pol_z(2, 1, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(46)*pol_z(1, 1, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(46)*pol_z(2, 1, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(47)*pol_z(1, 1, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(47)*pol_z(2, 1, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(48)*pol_z(1, 1, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(48)*pol_z(2, 1, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(49)*pol_z(1, 1, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(49)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(50)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(50)*pol_z(2, 2, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(51)*pol_z(1, 2, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(51)*pol_z(2, 2, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(52)*pol_z(1, 2, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(52)*pol_z(2, 2, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(53)*pol_z(1, 2, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(53)*pol_z(2, 2, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(54)*pol_z(1, 2, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(54)*pol_z(2, 2, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(55)*pol_z(1, 2, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(55)*pol_z(2, 2, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(56)*pol_z(1, 2, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(56)*pol_z(2, 2, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(57)*pol_z(1, 2, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(57)*pol_z(2, 2, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(58)*pol_z(1, 2, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(58)*pol_z(2, 2, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(59)*pol_z(1, 2, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(59)*pol_z(2, 2, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(60)*pol_z(1, 2, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(60)*pol_z(2, 2, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(61)*pol_z(1, 2, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(61)*pol_z(2, 2, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(62)*pol_z(1, 2, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(62)*pol_z(2, 2, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(63)*pol_z(1, 2, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(63)*pol_z(2, 2, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(64)*pol_z(1, 2, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(64)*pol_z(2, 2, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(65)*pol_z(1, 3, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(65)*pol_z(2, 3, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(66)*pol_z(1, 3, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(66)*pol_z(2, 3, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(67)*pol_z(1, 3, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(67)*pol_z(2, 3, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(68)*pol_z(1, 3, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(68)*pol_z(2, 3, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(69)*pol_z(1, 3, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(69)*pol_z(2, 3, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(70)*pol_z(1, 3, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(70)*pol_z(2, 3, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(71)*pol_z(1, 3, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(71)*pol_z(2, 3, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(72)*pol_z(1, 3, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(72)*pol_z(2, 3, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(73)*pol_z(1, 3, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(73)*pol_z(2, 3, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(74)*pol_z(1, 3, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(74)*pol_z(2, 3, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(75)*pol_z(1, 4, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(75)*pol_z(2, 4, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(76)*pol_z(1, 4, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(76)*pol_z(2, 4, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(77)*pol_z(1, 4, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(77)*pol_z(2, 4, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(78)*pol_z(1, 4, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(78)*pol_z(2, 4, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(79)*pol_z(1, 4, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(79)*pol_z(2, 4, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(80)*pol_z(1, 4, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(80)*pol_z(2, 4, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(81)*pol_z(1, 5, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(81)*pol_z(2, 5, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(82)*pol_z(1, 5, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(82)*pol_z(2, 5, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(83)*pol_z(1, 5, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(83)*pol_z(2, 5, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(84)*pol_z(1, 6, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(84)*pol_z(2, 6, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(7)*pol_z(1, 0, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(7)*pol_z(2, 0, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(8)*pol_z(1, 0, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(8)*pol_z(2, 0, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(9)*pol_z(1, 0, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(9)*pol_z(2, 0, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(10)*pol_z(1, 0, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(10)*pol_z(2, 0, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(11)*pol_z(1, 0, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(11)*pol_z(2, 0, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(12)*pol_z(1, 0, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(12)*pol_z(2, 0, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(13)*pol_z(1, 0, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(13)*pol_z(2, 0, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(14)*pol_z(1, 0, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(14)*pol_z(2, 0, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(15)*pol_z(1, 0, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(15)*pol_z(2, 0, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(16)*pol_z(1, 0, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(16)*pol_z(2, 0, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(17)*pol_z(1, 0, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(17)*pol_z(2, 0, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(18)*pol_z(1, 0, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(18)*pol_z(2, 0, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(19)*pol_z(1, 0, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(19)*pol_z(2, 0, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(20)*pol_z(1, 0, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(20)*pol_z(2, 0, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(21)*pol_z(1, 0, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(21)*pol_z(2, 0, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(22)*pol_z(1, 0, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(22)*pol_z(2, 0, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(23)*pol_z(1, 0, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(23)*pol_z(2, 0, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(24)*pol_z(1, 0, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(24)*pol_z(2, 0, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(25)*pol_z(1, 0, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(25)*pol_z(2, 0, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(26)*pol_z(1, 0, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(26)*pol_z(2, 0, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(27)*pol_z(1, 0, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(27)*pol_z(2, 0, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(28)*pol_z(1, 0, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(28)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(29)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(29)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(30)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(30)*pol_z(2, 1, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(31)*pol_z(1, 1, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(31)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(32)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(32)*pol_z(2, 1, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(33)*pol_z(1, 1, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(33)*pol_z(2, 1, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(34)*pol_z(1, 1, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(34)*pol_z(2, 1, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(35)*pol_z(1, 1, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(35)*pol_z(2, 1, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(36)*pol_z(1, 1, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(36)*pol_z(2, 1, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(37)*pol_z(1, 1, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(37)*pol_z(2, 1, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(38)*pol_z(1, 1, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(38)*pol_z(2, 1, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(39)*pol_z(1, 1, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(39)*pol_z(2, 1, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(40)*pol_z(1, 1, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(40)*pol_z(2, 1, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(41)*pol_z(1, 1, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(41)*pol_z(2, 1, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(42)*pol_z(1, 1, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(42)*pol_z(2, 1, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(43)*pol_z(1, 1, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(43)*pol_z(2, 1, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(44)*pol_z(1, 1, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(44)*pol_z(2, 1, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(45)*pol_z(1, 1, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(45)*pol_z(2, 1, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(46)*pol_z(1, 1, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(46)*pol_z(2, 1, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(47)*pol_z(1, 1, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(47)*pol_z(2, 1, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(48)*pol_z(1, 1, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(48)*pol_z(2, 1, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(49)*pol_z(1, 1, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(49)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(50)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(50)*pol_z(2, 2, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(51)*pol_z(1, 2, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(51)*pol_z(2, 2, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(52)*pol_z(1, 2, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(52)*pol_z(2, 2, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(53)*pol_z(1, 2, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(53)*pol_z(2, 2, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(54)*pol_z(1, 2, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(54)*pol_z(2, 2, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(55)*pol_z(1, 2, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(55)*pol_z(2, 2, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(56)*pol_z(1, 2, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(56)*pol_z(2, 2, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(57)*pol_z(1, 2, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(57)*pol_z(2, 2, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(58)*pol_z(1, 2, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(58)*pol_z(2, 2, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(59)*pol_z(1, 2, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(59)*pol_z(2, 2, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(60)*pol_z(1, 2, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(60)*pol_z(2, 2, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(61)*pol_z(1, 2, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(61)*pol_z(2, 2, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(62)*pol_z(1, 2, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(62)*pol_z(2, 2, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(63)*pol_z(1, 2, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(63)*pol_z(2, 2, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(64)*pol_z(1, 2, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(64)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(65)*pol_z(1, 3, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(65)*pol_z(2, 3, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(66)*pol_z(1, 3, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(66)*pol_z(2, 3, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(67)*pol_z(1, 3, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(67)*pol_z(2, 3, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(68)*pol_z(1, 3, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(68)*pol_z(2, 3, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(69)*pol_z(1, 3, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(69)*pol_z(2, 3, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(70)*pol_z(1, 3, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(70)*pol_z(2, 3, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(71)*pol_z(1, 3, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(71)*pol_z(2, 3, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(72)*pol_z(1, 3, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(72)*pol_z(2, 3, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(73)*pol_z(1, 3, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(73)*pol_z(2, 3, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(74)*pol_z(1, 3, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(74)*pol_z(2, 3, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(75)*pol_z(1, 4, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(75)*pol_z(2, 4, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(76)*pol_z(1, 4, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(76)*pol_z(2, 4, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(77)*pol_z(1, 4, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(77)*pol_z(2, 4, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(78)*pol_z(1, 4, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(78)*pol_z(2, 4, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(79)*pol_z(1, 4, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(79)*pol_z(2, 4, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(80)*pol_z(1, 4, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(80)*pol_z(2, 4, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(81)*pol_z(1, 5, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(81)*pol_z(2, 5, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(82)*pol_z(1, 5, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(82)*pol_z(2, 5, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(83)*pol_z(1, 5, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(83)*pol_z(2, 5, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(84)*pol_z(1, 6, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(84)*pol_z(2, 6, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 4)*pol_y(1, 0, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 4)*pol_y(1, 0, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 4)*pol_y(2, 0, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 4)*pol_y(2, 0, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 5)*pol_y(1, 0, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 5)*pol_y(1, 0, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 5)*pol_y(2, 0, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 5)*pol_y(2, 0, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 6)*pol_y(1, 0, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 6)*pol_y(1, 0, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 6)*pol_y(2, 0, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 6)*pol_y(2, 0, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 7)*pol_y(1, 0, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 7)*pol_y(1, 0, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 7)*pol_y(2, 0, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 7)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 8)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 8)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 8)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 8)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 9)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 9)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 9)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 9)*pol_y(2, 1, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 10)*pol_y(1, 1, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 10)*pol_y(1, 1, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 10)*pol_y(2, 1, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 10)*pol_y(2, 1, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 11)*pol_y(1, 1, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 11)*pol_y(1, 1, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 11)*pol_y(2, 1, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 11)*pol_y(2, 1, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 12)*pol_y(1, 1, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 12)*pol_y(1, 1, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 12)*pol_y(2, 1, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 12)*pol_y(2, 1, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 13)*pol_y(1, 1, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 13)*pol_y(1, 1, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 13)*pol_y(2, 1, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 13)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 14)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 14)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 14)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 14)*pol_y(2, 2, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 15)*pol_y(1, 2, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 15)*pol_y(1, 2, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 15)*pol_y(2, 2, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 15)*pol_y(2, 2, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 16)*pol_y(1, 2, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 16)*pol_y(1, 2, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 16)*pol_y(2, 2, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 16)*pol_y(2, 2, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 17)*pol_y(1, 2, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 17)*pol_y(1, 2, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 17)*pol_y(2, 2, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 17)*pol_y(2, 2, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 18)*pol_y(1, 2, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 18)*pol_y(1, 2, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 18)*pol_y(2, 2, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 18)*pol_y(2, 2, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 19)*pol_y(1, 3, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 19)*pol_y(1, 3, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 19)*pol_y(2, 3, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 19)*pol_y(2, 3, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 20)*pol_y(1, 3, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 20)*pol_y(1, 3, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 20)*pol_y(2, 3, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 20)*pol_y(2, 3, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 21)*pol_y(1, 3, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 21)*pol_y(1, 3, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 21)*pol_y(2, 3, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 21)*pol_y(2, 3, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 22)*pol_y(1, 3, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 22)*pol_y(1, 3, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 22)*pol_y(2, 3, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 22)*pol_y(2, 3, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 23)*pol_y(1, 4, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 23)*pol_y(1, 4, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 23)*pol_y(2, 4, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 23)*pol_y(2, 4, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 24)*pol_y(1, 4, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 24)*pol_y(1, 4, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 24)*pol_y(2, 4, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 24)*pol_y(2, 4, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 25)*pol_y(1, 4, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 25)*pol_y(1, 4, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 25)*pol_y(2, 4, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 25)*pol_y(2, 4, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 26)*pol_y(1, 5, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 26)*pol_y(1, 5, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 26)*pol_y(2, 5, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 26)*pol_y(2, 5, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 27)*pol_y(1, 5, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 27)*pol_y(1, 5, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 27)*pol_y(2, 5, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 27)*pol_y(2, 5, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 28)*pol_y(1, 6, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 28)*pol_y(1, 6, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 28)*pol_y(2, 6, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 28)*pol_y(2, 6, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 4)*pol_y(1, 0, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 4)*pol_y(1, 0, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 4)*pol_y(2, 0, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 4)*pol_y(2, 0, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 5)*pol_y(1, 0, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 5)*pol_y(1, 0, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 5)*pol_y(2, 0, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 5)*pol_y(2, 0, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 6)*pol_y(1, 0, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 6)*pol_y(1, 0, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 6)*pol_y(2, 0, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 6)*pol_y(2, 0, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 7)*pol_y(1, 0, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 7)*pol_y(1, 0, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 7)*pol_y(2, 0, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 7)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 8)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 8)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 8)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 8)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 9)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 9)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 9)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 9)*pol_y(2, 1, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 10)*pol_y(1, 1, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 10)*pol_y(1, 1, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 10)*pol_y(2, 1, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 10)*pol_y(2, 1, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 11)*pol_y(1, 1, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 11)*pol_y(1, 1, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 11)*pol_y(2, 1, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 11)*pol_y(2, 1, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 12)*pol_y(1, 1, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 12)*pol_y(1, 1, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 12)*pol_y(2, 1, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 12)*pol_y(2, 1, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 13)*pol_y(1, 1, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 13)*pol_y(1, 1, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 13)*pol_y(2, 1, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 13)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 14)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 14)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 14)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 14)*pol_y(2, 2, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 15)*pol_y(1, 2, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 15)*pol_y(1, 2, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 15)*pol_y(2, 2, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 15)*pol_y(2, 2, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 16)*pol_y(1, 2, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 16)*pol_y(1, 2, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 16)*pol_y(2, 2, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 16)*pol_y(2, 2, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 17)*pol_y(1, 2, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 17)*pol_y(1, 2, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 17)*pol_y(2, 2, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 17)*pol_y(2, 2, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 18)*pol_y(1, 2, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 18)*pol_y(1, 2, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 18)*pol_y(2, 2, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 18)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 19)*pol_y(1, 3, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 19)*pol_y(1, 3, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 19)*pol_y(2, 3, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 19)*pol_y(2, 3, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 20)*pol_y(1, 3, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 20)*pol_y(1, 3, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 20)*pol_y(2, 3, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 20)*pol_y(2, 3, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 21)*pol_y(1, 3, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 21)*pol_y(1, 3, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 21)*pol_y(2, 3, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 21)*pol_y(2, 3, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 22)*pol_y(1, 3, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 22)*pol_y(1, 3, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 22)*pol_y(2, 3, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 22)*pol_y(2, 3, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 23)*pol_y(1, 4, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 23)*pol_y(1, 4, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 23)*pol_y(2, 4, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 23)*pol_y(2, 4, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 24)*pol_y(1, 4, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 24)*pol_y(1, 4, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 24)*pol_y(2, 4, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 24)*pol_y(2, 4, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 25)*pol_y(1, 4, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 25)*pol_y(1, 4, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 25)*pol_y(2, 4, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 25)*pol_y(2, 4, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 26)*pol_y(1, 5, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 26)*pol_y(1, 5, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 26)*pol_y(2, 5, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 26)*pol_y(2, 5, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 27)*pol_y(1, 5, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 27)*pol_y(1, 5, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 27)*pol_y(2, 5, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 27)*pol_y(2, 5, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 28)*pol_y(1, 6, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 28)*pol_y(1, 6, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 28)*pol_y(2, 6, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 28)*pol_y(2, 6, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - s01 = s01+coef_x(1, 4)*pol_x(4, ig) - s02 = s02+coef_x(2, 4)*pol_x(4, ig) - s03 = s03+coef_x(3, 4)*pol_x(4, ig) - s04 = s04+coef_x(4, 4)*pol_x(4, ig) - s01 = s01+coef_x(1, 5)*pol_x(5, ig) - s02 = s02+coef_x(2, 5)*pol_x(5, ig) - s03 = s03+coef_x(3, 5)*pol_x(5, ig) - s04 = s04+coef_x(4, 5)*pol_x(5, ig) - s01 = s01+coef_x(1, 6)*pol_x(6, ig) - s02 = s02+coef_x(2, 6)*pol_x(6, ig) - s03 = s03+coef_x(3, 6)*pol_x(6, ig) - s04 = s04+coef_x(4, 6)*pol_x(6, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + s01 = s01 + coef_x(1, 4)*pol_x(4, ig) + s02 = s02 + coef_x(2, 4)*pol_x(4, ig) + s03 = s03 + coef_x(3, 4)*pol_x(4, ig) + s04 = s04 + coef_x(4, 4)*pol_x(4, ig) + s01 = s01 + coef_x(1, 5)*pol_x(5, ig) + s02 = s02 + coef_x(2, 5)*pol_x(5, ig) + s03 = s03 + coef_x(3, 5)*pol_x(5, ig) + s04 = s04 + coef_x(4, 5)*pol_x(5, ig) + s01 = s01 + coef_x(1, 6)*pol_x(6, ig) + s02 = s02 + coef_x(2, 6)*pol_x(6, ig) + s03 = s03 + coef_x(3, 6)*pol_x(6, ig) + s04 = s04 + coef_x(4, 6)*pol_x(6, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -1445,460 +1445,460 @@ SUBROUTINE collocate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 7 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(7)*pol_z(1, 0, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(7)*pol_z(2, 0, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(8)*pol_z(1, 0, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(8)*pol_z(2, 0, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(9)*pol_z(1, 0, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(9)*pol_z(2, 0, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(10)*pol_z(1, 0, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(10)*pol_z(2, 0, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(11)*pol_z(1, 0, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(11)*pol_z(2, 0, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(12)*pol_z(1, 0, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(12)*pol_z(2, 0, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(13)*pol_z(1, 0, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(13)*pol_z(2, 0, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(14)*pol_z(1, 0, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(14)*pol_z(2, 0, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(15)*pol_z(1, 0, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(15)*pol_z(2, 0, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(16)*pol_z(1, 0, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(16)*pol_z(2, 0, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(17)*pol_z(1, 0, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(17)*pol_z(2, 0, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(18)*pol_z(1, 0, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(18)*pol_z(2, 0, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(19)*pol_z(1, 0, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(19)*pol_z(2, 0, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(20)*pol_z(1, 0, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(20)*pol_z(2, 0, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(21)*pol_z(1, 0, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(21)*pol_z(2, 0, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(22)*pol_z(1, 0, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(22)*pol_z(2, 0, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(23)*pol_z(1, 0, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(23)*pol_z(2, 0, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(24)*pol_z(1, 0, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(24)*pol_z(2, 0, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(25)*pol_z(1, 0, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(25)*pol_z(2, 0, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(26)*pol_z(1, 0, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(26)*pol_z(2, 0, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(27)*pol_z(1, 0, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(27)*pol_z(2, 0, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(28)*pol_z(1, 0, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(28)*pol_z(2, 0, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(29)*pol_z(1, 0, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(29)*pol_z(2, 0, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(30)*pol_z(1, 0, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(30)*pol_z(2, 0, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(31)*pol_z(1, 0, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(31)*pol_z(2, 0, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(32)*pol_z(1, 0, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(32)*pol_z(2, 0, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(33)*pol_z(1, 0, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(33)*pol_z(2, 0, kg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_xyz(34)*pol_z(1, 0, kg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_xyz(34)*pol_z(2, 0, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(35)*pol_z(1, 0, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(35)*pol_z(2, 0, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(36)*pol_z(1, 0, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(36)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(37)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(37)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(38)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(38)*pol_z(2, 1, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(39)*pol_z(1, 1, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(39)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(40)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(40)*pol_z(2, 1, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(41)*pol_z(1, 1, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(41)*pol_z(2, 1, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(42)*pol_z(1, 1, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(42)*pol_z(2, 1, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(43)*pol_z(1, 1, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(43)*pol_z(2, 1, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(44)*pol_z(1, 1, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(44)*pol_z(2, 1, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(45)*pol_z(1, 1, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(45)*pol_z(2, 1, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(46)*pol_z(1, 1, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(46)*pol_z(2, 1, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(47)*pol_z(1, 1, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(47)*pol_z(2, 1, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(48)*pol_z(1, 1, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(48)*pol_z(2, 1, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(49)*pol_z(1, 1, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(49)*pol_z(2, 1, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(50)*pol_z(1, 1, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(50)*pol_z(2, 1, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(51)*pol_z(1, 1, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(51)*pol_z(2, 1, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(52)*pol_z(1, 1, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(52)*pol_z(2, 1, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(53)*pol_z(1, 1, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(53)*pol_z(2, 1, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(54)*pol_z(1, 1, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(54)*pol_z(2, 1, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(55)*pol_z(1, 1, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(55)*pol_z(2, 1, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(56)*pol_z(1, 1, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(56)*pol_z(2, 1, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(57)*pol_z(1, 1, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(57)*pol_z(2, 1, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(58)*pol_z(1, 1, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(58)*pol_z(2, 1, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(59)*pol_z(1, 1, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(59)*pol_z(2, 1, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(60)*pol_z(1, 1, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(60)*pol_z(2, 1, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(61)*pol_z(1, 1, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(61)*pol_z(2, 1, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(62)*pol_z(1, 1, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(62)*pol_z(2, 1, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(63)*pol_z(1, 1, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(63)*pol_z(2, 1, kg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_xyz(64)*pol_z(1, 1, kg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_xyz(64)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(65)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(65)*pol_z(2, 2, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(66)*pol_z(1, 2, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(66)*pol_z(2, 2, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(67)*pol_z(1, 2, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(67)*pol_z(2, 2, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(68)*pol_z(1, 2, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(68)*pol_z(2, 2, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(69)*pol_z(1, 2, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(69)*pol_z(2, 2, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(70)*pol_z(1, 2, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(70)*pol_z(2, 2, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(71)*pol_z(1, 2, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(71)*pol_z(2, 2, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(72)*pol_z(1, 2, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(72)*pol_z(2, 2, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(73)*pol_z(1, 2, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(73)*pol_z(2, 2, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(74)*pol_z(1, 2, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(74)*pol_z(2, 2, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(75)*pol_z(1, 2, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(75)*pol_z(2, 2, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(76)*pol_z(1, 2, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(76)*pol_z(2, 2, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(77)*pol_z(1, 2, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(77)*pol_z(2, 2, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(78)*pol_z(1, 2, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(78)*pol_z(2, 2, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(79)*pol_z(1, 2, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(79)*pol_z(2, 2, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(80)*pol_z(1, 2, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(80)*pol_z(2, 2, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(81)*pol_z(1, 2, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(81)*pol_z(2, 2, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(82)*pol_z(1, 2, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(82)*pol_z(2, 2, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(83)*pol_z(1, 2, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(83)*pol_z(2, 2, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(84)*pol_z(1, 2, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(84)*pol_z(2, 2, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(85)*pol_z(1, 2, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(85)*pol_z(2, 2, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(86)*pol_z(1, 3, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(86)*pol_z(2, 3, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(87)*pol_z(1, 3, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(87)*pol_z(2, 3, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(88)*pol_z(1, 3, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(88)*pol_z(2, 3, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(89)*pol_z(1, 3, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(89)*pol_z(2, 3, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(90)*pol_z(1, 3, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(90)*pol_z(2, 3, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(91)*pol_z(1, 3, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(91)*pol_z(2, 3, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(92)*pol_z(1, 3, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(92)*pol_z(2, 3, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(93)*pol_z(1, 3, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(93)*pol_z(2, 3, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(94)*pol_z(1, 3, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(94)*pol_z(2, 3, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(95)*pol_z(1, 3, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(95)*pol_z(2, 3, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(96)*pol_z(1, 3, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(96)*pol_z(2, 3, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(97)*pol_z(1, 3, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(97)*pol_z(2, 3, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(98)*pol_z(1, 3, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(98)*pol_z(2, 3, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(99)*pol_z(1, 3, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(99)*pol_z(2, 3, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(100)*pol_z(1, 3, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(100)*pol_z(2, 3, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(101)*pol_z(1, 4, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(101)*pol_z(2, 4, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(102)*pol_z(1, 4, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(102)*pol_z(2, 4, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(103)*pol_z(1, 4, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(103)*pol_z(2, 4, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(104)*pol_z(1, 4, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(104)*pol_z(2, 4, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(105)*pol_z(1, 4, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(105)*pol_z(2, 4, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(106)*pol_z(1, 4, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(106)*pol_z(2, 4, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(107)*pol_z(1, 4, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(107)*pol_z(2, 4, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(108)*pol_z(1, 4, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(108)*pol_z(2, 4, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(109)*pol_z(1, 4, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(109)*pol_z(2, 4, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(110)*pol_z(1, 4, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(110)*pol_z(2, 4, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(111)*pol_z(1, 5, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(111)*pol_z(2, 5, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(112)*pol_z(1, 5, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(112)*pol_z(2, 5, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(113)*pol_z(1, 5, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(113)*pol_z(2, 5, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(114)*pol_z(1, 5, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(114)*pol_z(2, 5, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(115)*pol_z(1, 5, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(115)*pol_z(2, 5, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(116)*pol_z(1, 5, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(116)*pol_z(2, 5, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(117)*pol_z(1, 6, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(117)*pol_z(2, 6, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(118)*pol_z(1, 6, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(118)*pol_z(2, 6, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(119)*pol_z(1, 6, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(119)*pol_z(2, 6, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(120)*pol_z(1, 7, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(120)*pol_z(2, 7, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(7)*pol_z(1, 0, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(7)*pol_z(2, 0, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(8)*pol_z(1, 0, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(8)*pol_z(2, 0, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(9)*pol_z(1, 0, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(9)*pol_z(2, 0, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(10)*pol_z(1, 0, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(10)*pol_z(2, 0, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(11)*pol_z(1, 0, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(11)*pol_z(2, 0, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(12)*pol_z(1, 0, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(12)*pol_z(2, 0, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(13)*pol_z(1, 0, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(13)*pol_z(2, 0, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(14)*pol_z(1, 0, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(14)*pol_z(2, 0, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(15)*pol_z(1, 0, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(15)*pol_z(2, 0, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(16)*pol_z(1, 0, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(16)*pol_z(2, 0, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(17)*pol_z(1, 0, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(17)*pol_z(2, 0, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(18)*pol_z(1, 0, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(18)*pol_z(2, 0, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(19)*pol_z(1, 0, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(19)*pol_z(2, 0, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(20)*pol_z(1, 0, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(20)*pol_z(2, 0, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(21)*pol_z(1, 0, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(21)*pol_z(2, 0, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(22)*pol_z(1, 0, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(22)*pol_z(2, 0, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(23)*pol_z(1, 0, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(23)*pol_z(2, 0, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(24)*pol_z(1, 0, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(24)*pol_z(2, 0, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(25)*pol_z(1, 0, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(25)*pol_z(2, 0, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(26)*pol_z(1, 0, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(26)*pol_z(2, 0, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(27)*pol_z(1, 0, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(27)*pol_z(2, 0, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(28)*pol_z(1, 0, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(28)*pol_z(2, 0, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(29)*pol_z(1, 0, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(29)*pol_z(2, 0, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(30)*pol_z(1, 0, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(30)*pol_z(2, 0, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(31)*pol_z(1, 0, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(31)*pol_z(2, 0, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(32)*pol_z(1, 0, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(32)*pol_z(2, 0, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(33)*pol_z(1, 0, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(33)*pol_z(2, 0, kg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_xyz(34)*pol_z(1, 0, kg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_xyz(34)*pol_z(2, 0, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(35)*pol_z(1, 0, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(35)*pol_z(2, 0, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(36)*pol_z(1, 0, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(36)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(37)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(37)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(38)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(38)*pol_z(2, 1, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(39)*pol_z(1, 1, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(39)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(40)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(40)*pol_z(2, 1, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(41)*pol_z(1, 1, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(41)*pol_z(2, 1, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(42)*pol_z(1, 1, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(42)*pol_z(2, 1, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(43)*pol_z(1, 1, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(43)*pol_z(2, 1, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(44)*pol_z(1, 1, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(44)*pol_z(2, 1, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(45)*pol_z(1, 1, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(45)*pol_z(2, 1, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(46)*pol_z(1, 1, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(46)*pol_z(2, 1, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(47)*pol_z(1, 1, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(47)*pol_z(2, 1, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(48)*pol_z(1, 1, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(48)*pol_z(2, 1, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(49)*pol_z(1, 1, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(49)*pol_z(2, 1, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(50)*pol_z(1, 1, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(50)*pol_z(2, 1, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(51)*pol_z(1, 1, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(51)*pol_z(2, 1, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(52)*pol_z(1, 1, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(52)*pol_z(2, 1, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(53)*pol_z(1, 1, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(53)*pol_z(2, 1, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(54)*pol_z(1, 1, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(54)*pol_z(2, 1, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(55)*pol_z(1, 1, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(55)*pol_z(2, 1, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(56)*pol_z(1, 1, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(56)*pol_z(2, 1, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(57)*pol_z(1, 1, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(57)*pol_z(2, 1, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(58)*pol_z(1, 1, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(58)*pol_z(2, 1, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(59)*pol_z(1, 1, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(59)*pol_z(2, 1, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(60)*pol_z(1, 1, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(60)*pol_z(2, 1, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(61)*pol_z(1, 1, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(61)*pol_z(2, 1, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(62)*pol_z(1, 1, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(62)*pol_z(2, 1, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(63)*pol_z(1, 1, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(63)*pol_z(2, 1, kg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_xyz(64)*pol_z(1, 1, kg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_xyz(64)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(65)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(65)*pol_z(2, 2, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(66)*pol_z(1, 2, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(66)*pol_z(2, 2, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(67)*pol_z(1, 2, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(67)*pol_z(2, 2, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(68)*pol_z(1, 2, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(68)*pol_z(2, 2, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(69)*pol_z(1, 2, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(69)*pol_z(2, 2, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(70)*pol_z(1, 2, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(70)*pol_z(2, 2, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(71)*pol_z(1, 2, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(71)*pol_z(2, 2, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(72)*pol_z(1, 2, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(72)*pol_z(2, 2, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(73)*pol_z(1, 2, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(73)*pol_z(2, 2, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(74)*pol_z(1, 2, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(74)*pol_z(2, 2, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(75)*pol_z(1, 2, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(75)*pol_z(2, 2, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(76)*pol_z(1, 2, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(76)*pol_z(2, 2, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(77)*pol_z(1, 2, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(77)*pol_z(2, 2, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(78)*pol_z(1, 2, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(78)*pol_z(2, 2, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(79)*pol_z(1, 2, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(79)*pol_z(2, 2, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(80)*pol_z(1, 2, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(80)*pol_z(2, 2, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(81)*pol_z(1, 2, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(81)*pol_z(2, 2, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(82)*pol_z(1, 2, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(82)*pol_z(2, 2, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(83)*pol_z(1, 2, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(83)*pol_z(2, 2, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(84)*pol_z(1, 2, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(84)*pol_z(2, 2, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(85)*pol_z(1, 2, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(85)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(86)*pol_z(1, 3, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(86)*pol_z(2, 3, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(87)*pol_z(1, 3, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(87)*pol_z(2, 3, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(88)*pol_z(1, 3, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(88)*pol_z(2, 3, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(89)*pol_z(1, 3, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(89)*pol_z(2, 3, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(90)*pol_z(1, 3, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(90)*pol_z(2, 3, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(91)*pol_z(1, 3, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(91)*pol_z(2, 3, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(92)*pol_z(1, 3, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(92)*pol_z(2, 3, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(93)*pol_z(1, 3, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(93)*pol_z(2, 3, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(94)*pol_z(1, 3, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(94)*pol_z(2, 3, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(95)*pol_z(1, 3, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(95)*pol_z(2, 3, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(96)*pol_z(1, 3, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(96)*pol_z(2, 3, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(97)*pol_z(1, 3, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(97)*pol_z(2, 3, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(98)*pol_z(1, 3, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(98)*pol_z(2, 3, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(99)*pol_z(1, 3, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(99)*pol_z(2, 3, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(100)*pol_z(1, 3, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(100)*pol_z(2, 3, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(101)*pol_z(1, 4, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(101)*pol_z(2, 4, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(102)*pol_z(1, 4, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(102)*pol_z(2, 4, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(103)*pol_z(1, 4, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(103)*pol_z(2, 4, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(104)*pol_z(1, 4, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(104)*pol_z(2, 4, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(105)*pol_z(1, 4, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(105)*pol_z(2, 4, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(106)*pol_z(1, 4, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(106)*pol_z(2, 4, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(107)*pol_z(1, 4, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(107)*pol_z(2, 4, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(108)*pol_z(1, 4, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(108)*pol_z(2, 4, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(109)*pol_z(1, 4, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(109)*pol_z(2, 4, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(110)*pol_z(1, 4, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(110)*pol_z(2, 4, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(111)*pol_z(1, 5, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(111)*pol_z(2, 5, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(112)*pol_z(1, 5, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(112)*pol_z(2, 5, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(113)*pol_z(1, 5, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(113)*pol_z(2, 5, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(114)*pol_z(1, 5, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(114)*pol_z(2, 5, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(115)*pol_z(1, 5, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(115)*pol_z(2, 5, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(116)*pol_z(1, 5, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(116)*pol_z(2, 5, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(117)*pol_z(1, 6, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(117)*pol_z(2, 6, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(118)*pol_z(1, 6, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(118)*pol_z(2, 6, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(119)*pol_z(1, 6, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(119)*pol_z(2, 6, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(120)*pol_z(1, 7, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(120)*pol_z(2, 7, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 4)*pol_y(1, 0, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 4)*pol_y(1, 0, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 4)*pol_y(2, 0, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 4)*pol_y(2, 0, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 5)*pol_y(1, 0, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 5)*pol_y(1, 0, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 5)*pol_y(2, 0, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 5)*pol_y(2, 0, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 6)*pol_y(1, 0, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 6)*pol_y(1, 0, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 6)*pol_y(2, 0, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 6)*pol_y(2, 0, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 7)*pol_y(1, 0, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 7)*pol_y(1, 0, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 7)*pol_y(2, 0, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 7)*pol_y(2, 0, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 8)*pol_y(1, 0, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 8)*pol_y(1, 0, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 8)*pol_y(2, 0, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 8)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 9)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 9)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 9)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 9)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 10)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 10)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 10)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 10)*pol_y(2, 1, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 11)*pol_y(1, 1, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 11)*pol_y(1, 1, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 11)*pol_y(2, 1, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 11)*pol_y(2, 1, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 12)*pol_y(1, 1, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 12)*pol_y(1, 1, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 12)*pol_y(2, 1, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 12)*pol_y(2, 1, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 13)*pol_y(1, 1, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 13)*pol_y(1, 1, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 13)*pol_y(2, 1, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 13)*pol_y(2, 1, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 14)*pol_y(1, 1, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 14)*pol_y(1, 1, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 14)*pol_y(2, 1, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 14)*pol_y(2, 1, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 15)*pol_y(1, 1, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 15)*pol_y(1, 1, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 15)*pol_y(2, 1, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 15)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 16)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 16)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 16)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 16)*pol_y(2, 2, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 17)*pol_y(1, 2, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 17)*pol_y(1, 2, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 17)*pol_y(2, 2, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 17)*pol_y(2, 2, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 18)*pol_y(1, 2, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 18)*pol_y(1, 2, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 18)*pol_y(2, 2, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 18)*pol_y(2, 2, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 19)*pol_y(1, 2, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 19)*pol_y(1, 2, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 19)*pol_y(2, 2, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 19)*pol_y(2, 2, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 20)*pol_y(1, 2, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 20)*pol_y(1, 2, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 20)*pol_y(2, 2, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 20)*pol_y(2, 2, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 21)*pol_y(1, 2, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 21)*pol_y(1, 2, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 21)*pol_y(2, 2, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 21)*pol_y(2, 2, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 22)*pol_y(1, 3, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 22)*pol_y(1, 3, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 22)*pol_y(2, 3, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 22)*pol_y(2, 3, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 23)*pol_y(1, 3, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 23)*pol_y(1, 3, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 23)*pol_y(2, 3, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 23)*pol_y(2, 3, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 24)*pol_y(1, 3, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 24)*pol_y(1, 3, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 24)*pol_y(2, 3, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 24)*pol_y(2, 3, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 25)*pol_y(1, 3, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 25)*pol_y(1, 3, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 25)*pol_y(2, 3, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 25)*pol_y(2, 3, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 26)*pol_y(1, 3, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 26)*pol_y(1, 3, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 26)*pol_y(2, 3, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 26)*pol_y(2, 3, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 27)*pol_y(1, 4, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 27)*pol_y(1, 4, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 27)*pol_y(2, 4, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 27)*pol_y(2, 4, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 28)*pol_y(1, 4, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 28)*pol_y(1, 4, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 28)*pol_y(2, 4, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 28)*pol_y(2, 4, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 29)*pol_y(1, 4, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 29)*pol_y(1, 4, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 29)*pol_y(2, 4, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 29)*pol_y(2, 4, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 30)*pol_y(1, 4, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 30)*pol_y(1, 4, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 30)*pol_y(2, 4, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 30)*pol_y(2, 4, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 31)*pol_y(1, 5, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 31)*pol_y(1, 5, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 31)*pol_y(2, 5, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 31)*pol_y(2, 5, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 32)*pol_y(1, 5, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 32)*pol_y(1, 5, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 32)*pol_y(2, 5, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 32)*pol_y(2, 5, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 33)*pol_y(1, 5, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 33)*pol_y(1, 5, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 33)*pol_y(2, 5, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 33)*pol_y(2, 5, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 34)*pol_y(1, 6, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 34)*pol_y(1, 6, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 34)*pol_y(2, 6, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 34)*pol_y(2, 6, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 35)*pol_y(1, 6, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 35)*pol_y(1, 6, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 35)*pol_y(2, 6, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 35)*pol_y(2, 6, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 36)*pol_y(1, 7, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 36)*pol_y(1, 7, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 36)*pol_y(2, 7, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 36)*pol_y(2, 7, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 4)*pol_y(1, 0, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 4)*pol_y(1, 0, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 4)*pol_y(2, 0, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 4)*pol_y(2, 0, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 5)*pol_y(1, 0, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 5)*pol_y(1, 0, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 5)*pol_y(2, 0, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 5)*pol_y(2, 0, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 6)*pol_y(1, 0, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 6)*pol_y(1, 0, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 6)*pol_y(2, 0, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 6)*pol_y(2, 0, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 7)*pol_y(1, 0, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 7)*pol_y(1, 0, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 7)*pol_y(2, 0, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 7)*pol_y(2, 0, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 8)*pol_y(1, 0, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 8)*pol_y(1, 0, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 8)*pol_y(2, 0, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 8)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 9)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 9)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 9)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 9)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 10)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 10)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 10)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 10)*pol_y(2, 1, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 11)*pol_y(1, 1, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 11)*pol_y(1, 1, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 11)*pol_y(2, 1, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 11)*pol_y(2, 1, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 12)*pol_y(1, 1, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 12)*pol_y(1, 1, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 12)*pol_y(2, 1, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 12)*pol_y(2, 1, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 13)*pol_y(1, 1, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 13)*pol_y(1, 1, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 13)*pol_y(2, 1, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 13)*pol_y(2, 1, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 14)*pol_y(1, 1, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 14)*pol_y(1, 1, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 14)*pol_y(2, 1, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 14)*pol_y(2, 1, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 15)*pol_y(1, 1, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 15)*pol_y(1, 1, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 15)*pol_y(2, 1, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 15)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 16)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 16)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 16)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 16)*pol_y(2, 2, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 17)*pol_y(1, 2, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 17)*pol_y(1, 2, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 17)*pol_y(2, 2, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 17)*pol_y(2, 2, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 18)*pol_y(1, 2, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 18)*pol_y(1, 2, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 18)*pol_y(2, 2, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 18)*pol_y(2, 2, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 19)*pol_y(1, 2, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 19)*pol_y(1, 2, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 19)*pol_y(2, 2, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 19)*pol_y(2, 2, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 20)*pol_y(1, 2, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 20)*pol_y(1, 2, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 20)*pol_y(2, 2, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 20)*pol_y(2, 2, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 21)*pol_y(1, 2, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 21)*pol_y(1, 2, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 21)*pol_y(2, 2, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 21)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 22)*pol_y(1, 3, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 22)*pol_y(1, 3, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 22)*pol_y(2, 3, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 22)*pol_y(2, 3, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 23)*pol_y(1, 3, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 23)*pol_y(1, 3, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 23)*pol_y(2, 3, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 23)*pol_y(2, 3, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 24)*pol_y(1, 3, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 24)*pol_y(1, 3, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 24)*pol_y(2, 3, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 24)*pol_y(2, 3, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 25)*pol_y(1, 3, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 25)*pol_y(1, 3, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 25)*pol_y(2, 3, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 25)*pol_y(2, 3, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 26)*pol_y(1, 3, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 26)*pol_y(1, 3, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 26)*pol_y(2, 3, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 26)*pol_y(2, 3, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 27)*pol_y(1, 4, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 27)*pol_y(1, 4, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 27)*pol_y(2, 4, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 27)*pol_y(2, 4, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 28)*pol_y(1, 4, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 28)*pol_y(1, 4, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 28)*pol_y(2, 4, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 28)*pol_y(2, 4, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 29)*pol_y(1, 4, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 29)*pol_y(1, 4, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 29)*pol_y(2, 4, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 29)*pol_y(2, 4, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 30)*pol_y(1, 4, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 30)*pol_y(1, 4, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 30)*pol_y(2, 4, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 30)*pol_y(2, 4, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 31)*pol_y(1, 5, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 31)*pol_y(1, 5, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 31)*pol_y(2, 5, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 31)*pol_y(2, 5, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 32)*pol_y(1, 5, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 32)*pol_y(1, 5, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 32)*pol_y(2, 5, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 32)*pol_y(2, 5, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 33)*pol_y(1, 5, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 33)*pol_y(1, 5, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 33)*pol_y(2, 5, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 33)*pol_y(2, 5, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 34)*pol_y(1, 6, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 34)*pol_y(1, 6, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 34)*pol_y(2, 6, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 34)*pol_y(2, 6, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 35)*pol_y(1, 6, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 35)*pol_y(1, 6, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 35)*pol_y(2, 6, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 35)*pol_y(2, 6, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 36)*pol_y(1, 7, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 36)*pol_y(1, 7, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 36)*pol_y(2, 7, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 36)*pol_y(2, 7, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - s01 = s01+coef_x(1, 4)*pol_x(4, ig) - s02 = s02+coef_x(2, 4)*pol_x(4, ig) - s03 = s03+coef_x(3, 4)*pol_x(4, ig) - s04 = s04+coef_x(4, 4)*pol_x(4, ig) - s01 = s01+coef_x(1, 5)*pol_x(5, ig) - s02 = s02+coef_x(2, 5)*pol_x(5, ig) - s03 = s03+coef_x(3, 5)*pol_x(5, ig) - s04 = s04+coef_x(4, 5)*pol_x(5, ig) - s01 = s01+coef_x(1, 6)*pol_x(6, ig) - s02 = s02+coef_x(2, 6)*pol_x(6, ig) - s03 = s03+coef_x(3, 6)*pol_x(6, ig) - s04 = s04+coef_x(4, 6)*pol_x(6, ig) - s01 = s01+coef_x(1, 7)*pol_x(7, ig) - s02 = s02+coef_x(2, 7)*pol_x(7, ig) - s03 = s03+coef_x(3, 7)*pol_x(7, ig) - s04 = s04+coef_x(4, 7)*pol_x(7, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + s01 = s01 + coef_x(1, 4)*pol_x(4, ig) + s02 = s02 + coef_x(2, 4)*pol_x(4, ig) + s03 = s03 + coef_x(3, 4)*pol_x(4, ig) + s04 = s04 + coef_x(4, 4)*pol_x(4, ig) + s01 = s01 + coef_x(1, 5)*pol_x(5, ig) + s02 = s02 + coef_x(2, 5)*pol_x(5, ig) + s03 = s03 + coef_x(3, 5)*pol_x(5, ig) + s04 = s04 + coef_x(4, 5)*pol_x(5, ig) + s01 = s01 + coef_x(1, 6)*pol_x(6, ig) + s02 = s02 + coef_x(2, 6)*pol_x(6, ig) + s03 = s03 + coef_x(3, 6)*pol_x(6, ig) + s04 = s04 + coef_x(4, 6)*pol_x(6, ig) + s01 = s01 + coef_x(1, 7)*pol_x(7, ig) + s02 = s02 + coef_x(2, 7)*pol_x(7, ig) + s03 = s03 + coef_x(3, 7)*pol_x(7, ig) + s04 = s04 + coef_x(4, 7)*pol_x(7, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -1925,590 +1925,590 @@ SUBROUTINE collocate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 8 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(7)*pol_z(1, 0, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(7)*pol_z(2, 0, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(8)*pol_z(1, 0, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(8)*pol_z(2, 0, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(9)*pol_z(1, 0, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(9)*pol_z(2, 0, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(10)*pol_z(1, 0, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(10)*pol_z(2, 0, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(11)*pol_z(1, 0, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(11)*pol_z(2, 0, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(12)*pol_z(1, 0, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(12)*pol_z(2, 0, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(13)*pol_z(1, 0, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(13)*pol_z(2, 0, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(14)*pol_z(1, 0, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(14)*pol_z(2, 0, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(15)*pol_z(1, 0, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(15)*pol_z(2, 0, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(16)*pol_z(1, 0, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(16)*pol_z(2, 0, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(17)*pol_z(1, 0, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(17)*pol_z(2, 0, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(18)*pol_z(1, 0, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(18)*pol_z(2, 0, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(19)*pol_z(1, 0, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(19)*pol_z(2, 0, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(20)*pol_z(1, 0, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(20)*pol_z(2, 0, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(21)*pol_z(1, 0, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(21)*pol_z(2, 0, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(22)*pol_z(1, 0, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(22)*pol_z(2, 0, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(23)*pol_z(1, 0, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(23)*pol_z(2, 0, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(24)*pol_z(1, 0, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(24)*pol_z(2, 0, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(25)*pol_z(1, 0, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(25)*pol_z(2, 0, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(26)*pol_z(1, 0, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(26)*pol_z(2, 0, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(27)*pol_z(1, 0, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(27)*pol_z(2, 0, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(28)*pol_z(1, 0, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(28)*pol_z(2, 0, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(29)*pol_z(1, 0, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(29)*pol_z(2, 0, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(30)*pol_z(1, 0, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(30)*pol_z(2, 0, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(31)*pol_z(1, 0, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(31)*pol_z(2, 0, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(32)*pol_z(1, 0, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(32)*pol_z(2, 0, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(33)*pol_z(1, 0, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(33)*pol_z(2, 0, kg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_xyz(34)*pol_z(1, 0, kg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_xyz(34)*pol_z(2, 0, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(35)*pol_z(1, 0, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(35)*pol_z(2, 0, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(36)*pol_z(1, 0, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(36)*pol_z(2, 0, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(37)*pol_z(1, 0, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(37)*pol_z(2, 0, kg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_xyz(38)*pol_z(1, 0, kg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_xyz(38)*pol_z(2, 0, kg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_xyz(39)*pol_z(1, 0, kg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_xyz(39)*pol_z(2, 0, kg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_xyz(40)*pol_z(1, 0, kg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_xyz(40)*pol_z(2, 0, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(41)*pol_z(1, 0, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(41)*pol_z(2, 0, kg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_xyz(42)*pol_z(1, 0, kg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_xyz(42)*pol_z(2, 0, kg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_xyz(43)*pol_z(1, 0, kg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_xyz(43)*pol_z(2, 0, kg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_xyz(44)*pol_z(1, 0, kg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_xyz(44)*pol_z(2, 0, kg) - coef_xy(1, 45) = coef_xy(1, 45)+coef_xyz(45)*pol_z(1, 0, kg) - coef_xy(2, 45) = coef_xy(2, 45)+coef_xyz(45)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(46)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(46)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(47)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(47)*pol_z(2, 1, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(48)*pol_z(1, 1, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(48)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(49)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(49)*pol_z(2, 1, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(50)*pol_z(1, 1, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(50)*pol_z(2, 1, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(51)*pol_z(1, 1, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(51)*pol_z(2, 1, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(52)*pol_z(1, 1, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(52)*pol_z(2, 1, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(53)*pol_z(1, 1, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(53)*pol_z(2, 1, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(54)*pol_z(1, 1, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(54)*pol_z(2, 1, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(55)*pol_z(1, 1, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(55)*pol_z(2, 1, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(56)*pol_z(1, 1, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(56)*pol_z(2, 1, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(57)*pol_z(1, 1, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(57)*pol_z(2, 1, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(58)*pol_z(1, 1, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(58)*pol_z(2, 1, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(59)*pol_z(1, 1, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(59)*pol_z(2, 1, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(60)*pol_z(1, 1, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(60)*pol_z(2, 1, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(61)*pol_z(1, 1, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(61)*pol_z(2, 1, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(62)*pol_z(1, 1, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(62)*pol_z(2, 1, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(63)*pol_z(1, 1, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(63)*pol_z(2, 1, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(64)*pol_z(1, 1, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(64)*pol_z(2, 1, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(65)*pol_z(1, 1, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(65)*pol_z(2, 1, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(66)*pol_z(1, 1, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(66)*pol_z(2, 1, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(67)*pol_z(1, 1, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(67)*pol_z(2, 1, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(68)*pol_z(1, 1, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(68)*pol_z(2, 1, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(69)*pol_z(1, 1, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(69)*pol_z(2, 1, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(70)*pol_z(1, 1, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(70)*pol_z(2, 1, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(71)*pol_z(1, 1, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(71)*pol_z(2, 1, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(72)*pol_z(1, 1, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(72)*pol_z(2, 1, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(73)*pol_z(1, 1, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(73)*pol_z(2, 1, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(74)*pol_z(1, 1, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(74)*pol_z(2, 1, kg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_xyz(75)*pol_z(1, 1, kg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_xyz(75)*pol_z(2, 1, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(76)*pol_z(1, 1, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(76)*pol_z(2, 1, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(77)*pol_z(1, 1, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(77)*pol_z(2, 1, kg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_xyz(78)*pol_z(1, 1, kg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_xyz(78)*pol_z(2, 1, kg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_xyz(79)*pol_z(1, 1, kg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_xyz(79)*pol_z(2, 1, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(80)*pol_z(1, 1, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(80)*pol_z(2, 1, kg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_xyz(81)*pol_z(1, 1, kg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_xyz(81)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(82)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(82)*pol_z(2, 2, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(83)*pol_z(1, 2, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(83)*pol_z(2, 2, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(84)*pol_z(1, 2, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(84)*pol_z(2, 2, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(85)*pol_z(1, 2, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(85)*pol_z(2, 2, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(86)*pol_z(1, 2, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(86)*pol_z(2, 2, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(87)*pol_z(1, 2, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(87)*pol_z(2, 2, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(88)*pol_z(1, 2, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(88)*pol_z(2, 2, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(89)*pol_z(1, 2, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(89)*pol_z(2, 2, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(90)*pol_z(1, 2, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(90)*pol_z(2, 2, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(91)*pol_z(1, 2, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(91)*pol_z(2, 2, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(92)*pol_z(1, 2, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(92)*pol_z(2, 2, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(93)*pol_z(1, 2, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(93)*pol_z(2, 2, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(94)*pol_z(1, 2, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(94)*pol_z(2, 2, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(95)*pol_z(1, 2, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(95)*pol_z(2, 2, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(96)*pol_z(1, 2, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(96)*pol_z(2, 2, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(97)*pol_z(1, 2, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(97)*pol_z(2, 2, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(98)*pol_z(1, 2, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(98)*pol_z(2, 2, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(99)*pol_z(1, 2, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(99)*pol_z(2, 2, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(100)*pol_z(1, 2, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(100)*pol_z(2, 2, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(101)*pol_z(1, 2, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(101)*pol_z(2, 2, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(102)*pol_z(1, 2, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(102)*pol_z(2, 2, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(103)*pol_z(1, 2, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(103)*pol_z(2, 2, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(104)*pol_z(1, 2, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(104)*pol_z(2, 2, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(105)*pol_z(1, 2, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(105)*pol_z(2, 2, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(106)*pol_z(1, 2, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(106)*pol_z(2, 2, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(107)*pol_z(1, 2, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(107)*pol_z(2, 2, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(108)*pol_z(1, 2, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(108)*pol_z(2, 2, kg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_xyz(109)*pol_z(1, 2, kg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_xyz(109)*pol_z(2, 2, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(110)*pol_z(1, 3, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(110)*pol_z(2, 3, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(111)*pol_z(1, 3, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(111)*pol_z(2, 3, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(112)*pol_z(1, 3, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(112)*pol_z(2, 3, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(113)*pol_z(1, 3, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(113)*pol_z(2, 3, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(114)*pol_z(1, 3, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(114)*pol_z(2, 3, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(115)*pol_z(1, 3, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(115)*pol_z(2, 3, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(116)*pol_z(1, 3, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(116)*pol_z(2, 3, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(117)*pol_z(1, 3, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(117)*pol_z(2, 3, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(118)*pol_z(1, 3, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(118)*pol_z(2, 3, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(119)*pol_z(1, 3, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(119)*pol_z(2, 3, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(120)*pol_z(1, 3, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(120)*pol_z(2, 3, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(121)*pol_z(1, 3, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(121)*pol_z(2, 3, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(122)*pol_z(1, 3, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(122)*pol_z(2, 3, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(123)*pol_z(1, 3, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(123)*pol_z(2, 3, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(124)*pol_z(1, 3, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(124)*pol_z(2, 3, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(125)*pol_z(1, 3, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(125)*pol_z(2, 3, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(126)*pol_z(1, 3, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(126)*pol_z(2, 3, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(127)*pol_z(1, 3, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(127)*pol_z(2, 3, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(128)*pol_z(1, 3, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(128)*pol_z(2, 3, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(129)*pol_z(1, 3, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(129)*pol_z(2, 3, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(130)*pol_z(1, 3, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(130)*pol_z(2, 3, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(131)*pol_z(1, 4, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(131)*pol_z(2, 4, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(132)*pol_z(1, 4, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(132)*pol_z(2, 4, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(133)*pol_z(1, 4, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(133)*pol_z(2, 4, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(134)*pol_z(1, 4, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(134)*pol_z(2, 4, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(135)*pol_z(1, 4, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(135)*pol_z(2, 4, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(136)*pol_z(1, 4, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(136)*pol_z(2, 4, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(137)*pol_z(1, 4, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(137)*pol_z(2, 4, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(138)*pol_z(1, 4, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(138)*pol_z(2, 4, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(139)*pol_z(1, 4, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(139)*pol_z(2, 4, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(140)*pol_z(1, 4, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(140)*pol_z(2, 4, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(141)*pol_z(1, 4, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(141)*pol_z(2, 4, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(142)*pol_z(1, 4, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(142)*pol_z(2, 4, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(143)*pol_z(1, 4, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(143)*pol_z(2, 4, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(144)*pol_z(1, 4, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(144)*pol_z(2, 4, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(145)*pol_z(1, 4, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(145)*pol_z(2, 4, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(146)*pol_z(1, 5, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(146)*pol_z(2, 5, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(147)*pol_z(1, 5, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(147)*pol_z(2, 5, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(148)*pol_z(1, 5, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(148)*pol_z(2, 5, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(149)*pol_z(1, 5, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(149)*pol_z(2, 5, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(150)*pol_z(1, 5, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(150)*pol_z(2, 5, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(151)*pol_z(1, 5, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(151)*pol_z(2, 5, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(152)*pol_z(1, 5, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(152)*pol_z(2, 5, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(153)*pol_z(1, 5, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(153)*pol_z(2, 5, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(154)*pol_z(1, 5, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(154)*pol_z(2, 5, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(155)*pol_z(1, 5, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(155)*pol_z(2, 5, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(156)*pol_z(1, 6, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(156)*pol_z(2, 6, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(157)*pol_z(1, 6, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(157)*pol_z(2, 6, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(158)*pol_z(1, 6, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(158)*pol_z(2, 6, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(159)*pol_z(1, 6, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(159)*pol_z(2, 6, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(160)*pol_z(1, 6, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(160)*pol_z(2, 6, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(161)*pol_z(1, 6, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(161)*pol_z(2, 6, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(162)*pol_z(1, 7, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(162)*pol_z(2, 7, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(163)*pol_z(1, 7, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(163)*pol_z(2, 7, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(164)*pol_z(1, 7, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(164)*pol_z(2, 7, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(165)*pol_z(1, 8, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(165)*pol_z(2, 8, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(7)*pol_z(1, 0, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(7)*pol_z(2, 0, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(8)*pol_z(1, 0, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(8)*pol_z(2, 0, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(9)*pol_z(1, 0, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(9)*pol_z(2, 0, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(10)*pol_z(1, 0, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(10)*pol_z(2, 0, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(11)*pol_z(1, 0, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(11)*pol_z(2, 0, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(12)*pol_z(1, 0, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(12)*pol_z(2, 0, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(13)*pol_z(1, 0, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(13)*pol_z(2, 0, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(14)*pol_z(1, 0, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(14)*pol_z(2, 0, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(15)*pol_z(1, 0, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(15)*pol_z(2, 0, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(16)*pol_z(1, 0, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(16)*pol_z(2, 0, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(17)*pol_z(1, 0, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(17)*pol_z(2, 0, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(18)*pol_z(1, 0, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(18)*pol_z(2, 0, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(19)*pol_z(1, 0, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(19)*pol_z(2, 0, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(20)*pol_z(1, 0, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(20)*pol_z(2, 0, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(21)*pol_z(1, 0, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(21)*pol_z(2, 0, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(22)*pol_z(1, 0, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(22)*pol_z(2, 0, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(23)*pol_z(1, 0, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(23)*pol_z(2, 0, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(24)*pol_z(1, 0, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(24)*pol_z(2, 0, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(25)*pol_z(1, 0, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(25)*pol_z(2, 0, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(26)*pol_z(1, 0, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(26)*pol_z(2, 0, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(27)*pol_z(1, 0, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(27)*pol_z(2, 0, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(28)*pol_z(1, 0, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(28)*pol_z(2, 0, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(29)*pol_z(1, 0, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(29)*pol_z(2, 0, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(30)*pol_z(1, 0, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(30)*pol_z(2, 0, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(31)*pol_z(1, 0, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(31)*pol_z(2, 0, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(32)*pol_z(1, 0, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(32)*pol_z(2, 0, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(33)*pol_z(1, 0, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(33)*pol_z(2, 0, kg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_xyz(34)*pol_z(1, 0, kg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_xyz(34)*pol_z(2, 0, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(35)*pol_z(1, 0, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(35)*pol_z(2, 0, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(36)*pol_z(1, 0, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(36)*pol_z(2, 0, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(37)*pol_z(1, 0, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(37)*pol_z(2, 0, kg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_xyz(38)*pol_z(1, 0, kg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_xyz(38)*pol_z(2, 0, kg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_xyz(39)*pol_z(1, 0, kg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_xyz(39)*pol_z(2, 0, kg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_xyz(40)*pol_z(1, 0, kg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_xyz(40)*pol_z(2, 0, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(41)*pol_z(1, 0, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(41)*pol_z(2, 0, kg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_xyz(42)*pol_z(1, 0, kg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_xyz(42)*pol_z(2, 0, kg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_xyz(43)*pol_z(1, 0, kg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_xyz(43)*pol_z(2, 0, kg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_xyz(44)*pol_z(1, 0, kg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_xyz(44)*pol_z(2, 0, kg) + coef_xy(1, 45) = coef_xy(1, 45) + coef_xyz(45)*pol_z(1, 0, kg) + coef_xy(2, 45) = coef_xy(2, 45) + coef_xyz(45)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(46)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(46)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(47)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(47)*pol_z(2, 1, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(48)*pol_z(1, 1, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(48)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(49)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(49)*pol_z(2, 1, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(50)*pol_z(1, 1, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(50)*pol_z(2, 1, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(51)*pol_z(1, 1, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(51)*pol_z(2, 1, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(52)*pol_z(1, 1, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(52)*pol_z(2, 1, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(53)*pol_z(1, 1, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(53)*pol_z(2, 1, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(54)*pol_z(1, 1, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(54)*pol_z(2, 1, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(55)*pol_z(1, 1, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(55)*pol_z(2, 1, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(56)*pol_z(1, 1, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(56)*pol_z(2, 1, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(57)*pol_z(1, 1, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(57)*pol_z(2, 1, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(58)*pol_z(1, 1, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(58)*pol_z(2, 1, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(59)*pol_z(1, 1, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(59)*pol_z(2, 1, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(60)*pol_z(1, 1, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(60)*pol_z(2, 1, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(61)*pol_z(1, 1, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(61)*pol_z(2, 1, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(62)*pol_z(1, 1, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(62)*pol_z(2, 1, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(63)*pol_z(1, 1, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(63)*pol_z(2, 1, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(64)*pol_z(1, 1, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(64)*pol_z(2, 1, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(65)*pol_z(1, 1, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(65)*pol_z(2, 1, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(66)*pol_z(1, 1, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(66)*pol_z(2, 1, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(67)*pol_z(1, 1, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(67)*pol_z(2, 1, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(68)*pol_z(1, 1, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(68)*pol_z(2, 1, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(69)*pol_z(1, 1, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(69)*pol_z(2, 1, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(70)*pol_z(1, 1, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(70)*pol_z(2, 1, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(71)*pol_z(1, 1, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(71)*pol_z(2, 1, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(72)*pol_z(1, 1, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(72)*pol_z(2, 1, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(73)*pol_z(1, 1, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(73)*pol_z(2, 1, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(74)*pol_z(1, 1, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(74)*pol_z(2, 1, kg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_xyz(75)*pol_z(1, 1, kg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_xyz(75)*pol_z(2, 1, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(76)*pol_z(1, 1, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(76)*pol_z(2, 1, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(77)*pol_z(1, 1, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(77)*pol_z(2, 1, kg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_xyz(78)*pol_z(1, 1, kg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_xyz(78)*pol_z(2, 1, kg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_xyz(79)*pol_z(1, 1, kg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_xyz(79)*pol_z(2, 1, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(80)*pol_z(1, 1, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(80)*pol_z(2, 1, kg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_xyz(81)*pol_z(1, 1, kg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_xyz(81)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(82)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(82)*pol_z(2, 2, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(83)*pol_z(1, 2, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(83)*pol_z(2, 2, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(84)*pol_z(1, 2, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(84)*pol_z(2, 2, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(85)*pol_z(1, 2, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(85)*pol_z(2, 2, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(86)*pol_z(1, 2, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(86)*pol_z(2, 2, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(87)*pol_z(1, 2, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(87)*pol_z(2, 2, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(88)*pol_z(1, 2, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(88)*pol_z(2, 2, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(89)*pol_z(1, 2, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(89)*pol_z(2, 2, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(90)*pol_z(1, 2, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(90)*pol_z(2, 2, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(91)*pol_z(1, 2, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(91)*pol_z(2, 2, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(92)*pol_z(1, 2, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(92)*pol_z(2, 2, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(93)*pol_z(1, 2, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(93)*pol_z(2, 2, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(94)*pol_z(1, 2, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(94)*pol_z(2, 2, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(95)*pol_z(1, 2, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(95)*pol_z(2, 2, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(96)*pol_z(1, 2, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(96)*pol_z(2, 2, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(97)*pol_z(1, 2, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(97)*pol_z(2, 2, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(98)*pol_z(1, 2, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(98)*pol_z(2, 2, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(99)*pol_z(1, 2, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(99)*pol_z(2, 2, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(100)*pol_z(1, 2, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(100)*pol_z(2, 2, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(101)*pol_z(1, 2, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(101)*pol_z(2, 2, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(102)*pol_z(1, 2, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(102)*pol_z(2, 2, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(103)*pol_z(1, 2, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(103)*pol_z(2, 2, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(104)*pol_z(1, 2, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(104)*pol_z(2, 2, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(105)*pol_z(1, 2, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(105)*pol_z(2, 2, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(106)*pol_z(1, 2, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(106)*pol_z(2, 2, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(107)*pol_z(1, 2, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(107)*pol_z(2, 2, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(108)*pol_z(1, 2, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(108)*pol_z(2, 2, kg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_xyz(109)*pol_z(1, 2, kg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_xyz(109)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(110)*pol_z(1, 3, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(110)*pol_z(2, 3, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(111)*pol_z(1, 3, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(111)*pol_z(2, 3, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(112)*pol_z(1, 3, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(112)*pol_z(2, 3, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(113)*pol_z(1, 3, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(113)*pol_z(2, 3, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(114)*pol_z(1, 3, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(114)*pol_z(2, 3, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(115)*pol_z(1, 3, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(115)*pol_z(2, 3, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(116)*pol_z(1, 3, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(116)*pol_z(2, 3, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(117)*pol_z(1, 3, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(117)*pol_z(2, 3, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(118)*pol_z(1, 3, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(118)*pol_z(2, 3, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(119)*pol_z(1, 3, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(119)*pol_z(2, 3, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(120)*pol_z(1, 3, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(120)*pol_z(2, 3, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(121)*pol_z(1, 3, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(121)*pol_z(2, 3, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(122)*pol_z(1, 3, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(122)*pol_z(2, 3, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(123)*pol_z(1, 3, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(123)*pol_z(2, 3, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(124)*pol_z(1, 3, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(124)*pol_z(2, 3, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(125)*pol_z(1, 3, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(125)*pol_z(2, 3, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(126)*pol_z(1, 3, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(126)*pol_z(2, 3, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(127)*pol_z(1, 3, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(127)*pol_z(2, 3, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(128)*pol_z(1, 3, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(128)*pol_z(2, 3, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(129)*pol_z(1, 3, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(129)*pol_z(2, 3, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(130)*pol_z(1, 3, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(130)*pol_z(2, 3, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(131)*pol_z(1, 4, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(131)*pol_z(2, 4, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(132)*pol_z(1, 4, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(132)*pol_z(2, 4, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(133)*pol_z(1, 4, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(133)*pol_z(2, 4, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(134)*pol_z(1, 4, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(134)*pol_z(2, 4, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(135)*pol_z(1, 4, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(135)*pol_z(2, 4, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(136)*pol_z(1, 4, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(136)*pol_z(2, 4, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(137)*pol_z(1, 4, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(137)*pol_z(2, 4, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(138)*pol_z(1, 4, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(138)*pol_z(2, 4, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(139)*pol_z(1, 4, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(139)*pol_z(2, 4, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(140)*pol_z(1, 4, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(140)*pol_z(2, 4, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(141)*pol_z(1, 4, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(141)*pol_z(2, 4, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(142)*pol_z(1, 4, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(142)*pol_z(2, 4, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(143)*pol_z(1, 4, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(143)*pol_z(2, 4, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(144)*pol_z(1, 4, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(144)*pol_z(2, 4, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(145)*pol_z(1, 4, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(145)*pol_z(2, 4, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(146)*pol_z(1, 5, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(146)*pol_z(2, 5, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(147)*pol_z(1, 5, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(147)*pol_z(2, 5, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(148)*pol_z(1, 5, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(148)*pol_z(2, 5, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(149)*pol_z(1, 5, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(149)*pol_z(2, 5, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(150)*pol_z(1, 5, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(150)*pol_z(2, 5, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(151)*pol_z(1, 5, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(151)*pol_z(2, 5, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(152)*pol_z(1, 5, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(152)*pol_z(2, 5, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(153)*pol_z(1, 5, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(153)*pol_z(2, 5, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(154)*pol_z(1, 5, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(154)*pol_z(2, 5, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(155)*pol_z(1, 5, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(155)*pol_z(2, 5, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(156)*pol_z(1, 6, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(156)*pol_z(2, 6, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(157)*pol_z(1, 6, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(157)*pol_z(2, 6, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(158)*pol_z(1, 6, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(158)*pol_z(2, 6, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(159)*pol_z(1, 6, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(159)*pol_z(2, 6, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(160)*pol_z(1, 6, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(160)*pol_z(2, 6, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(161)*pol_z(1, 6, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(161)*pol_z(2, 6, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(162)*pol_z(1, 7, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(162)*pol_z(2, 7, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(163)*pol_z(1, 7, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(163)*pol_z(2, 7, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(164)*pol_z(1, 7, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(164)*pol_z(2, 7, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(165)*pol_z(1, 8, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(165)*pol_z(2, 8, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 4)*pol_y(1, 0, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 4)*pol_y(1, 0, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 4)*pol_y(2, 0, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 4)*pol_y(2, 0, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 5)*pol_y(1, 0, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 5)*pol_y(1, 0, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 5)*pol_y(2, 0, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 5)*pol_y(2, 0, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 6)*pol_y(1, 0, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 6)*pol_y(1, 0, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 6)*pol_y(2, 0, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 6)*pol_y(2, 0, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 7)*pol_y(1, 0, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 7)*pol_y(1, 0, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 7)*pol_y(2, 0, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 7)*pol_y(2, 0, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 8)*pol_y(1, 0, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 8)*pol_y(1, 0, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 8)*pol_y(2, 0, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 8)*pol_y(2, 0, jg) - coef_x(1, 8) = coef_x(1, 8)+coef_xy(1, 9)*pol_y(1, 0, jg) - coef_x(2, 8) = coef_x(2, 8)+coef_xy(2, 9)*pol_y(1, 0, jg) - coef_x(3, 8) = coef_x(3, 8)+coef_xy(1, 9)*pol_y(2, 0, jg) - coef_x(4, 8) = coef_x(4, 8)+coef_xy(2, 9)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 10)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 10)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 10)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 10)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 11)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 11)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 11)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 11)*pol_y(2, 1, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 12)*pol_y(1, 1, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 12)*pol_y(1, 1, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 12)*pol_y(2, 1, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 12)*pol_y(2, 1, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 13)*pol_y(1, 1, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 13)*pol_y(1, 1, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 13)*pol_y(2, 1, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 13)*pol_y(2, 1, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 14)*pol_y(1, 1, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 14)*pol_y(1, 1, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 14)*pol_y(2, 1, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 14)*pol_y(2, 1, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 15)*pol_y(1, 1, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 15)*pol_y(1, 1, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 15)*pol_y(2, 1, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 15)*pol_y(2, 1, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 16)*pol_y(1, 1, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 16)*pol_y(1, 1, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 16)*pol_y(2, 1, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 16)*pol_y(2, 1, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 17)*pol_y(1, 1, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 17)*pol_y(1, 1, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 17)*pol_y(2, 1, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 17)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 18)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 18)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 18)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 18)*pol_y(2, 2, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 19)*pol_y(1, 2, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 19)*pol_y(1, 2, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 19)*pol_y(2, 2, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 19)*pol_y(2, 2, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 20)*pol_y(1, 2, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 20)*pol_y(1, 2, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 20)*pol_y(2, 2, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 20)*pol_y(2, 2, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 21)*pol_y(1, 2, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 21)*pol_y(1, 2, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 21)*pol_y(2, 2, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 21)*pol_y(2, 2, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 22)*pol_y(1, 2, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 22)*pol_y(1, 2, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 22)*pol_y(2, 2, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 22)*pol_y(2, 2, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 23)*pol_y(1, 2, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 23)*pol_y(1, 2, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 23)*pol_y(2, 2, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 23)*pol_y(2, 2, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 24)*pol_y(1, 2, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 24)*pol_y(1, 2, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 24)*pol_y(2, 2, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 24)*pol_y(2, 2, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 25)*pol_y(1, 3, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 25)*pol_y(1, 3, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 25)*pol_y(2, 3, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 25)*pol_y(2, 3, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 26)*pol_y(1, 3, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 26)*pol_y(1, 3, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 26)*pol_y(2, 3, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 26)*pol_y(2, 3, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 27)*pol_y(1, 3, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 27)*pol_y(1, 3, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 27)*pol_y(2, 3, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 27)*pol_y(2, 3, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 28)*pol_y(1, 3, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 28)*pol_y(1, 3, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 28)*pol_y(2, 3, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 28)*pol_y(2, 3, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 29)*pol_y(1, 3, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 29)*pol_y(1, 3, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 29)*pol_y(2, 3, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 29)*pol_y(2, 3, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 30)*pol_y(1, 3, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 30)*pol_y(1, 3, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 30)*pol_y(2, 3, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 30)*pol_y(2, 3, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 31)*pol_y(1, 4, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 31)*pol_y(1, 4, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 31)*pol_y(2, 4, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 31)*pol_y(2, 4, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 32)*pol_y(1, 4, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 32)*pol_y(1, 4, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 32)*pol_y(2, 4, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 32)*pol_y(2, 4, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 33)*pol_y(1, 4, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 33)*pol_y(1, 4, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 33)*pol_y(2, 4, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 33)*pol_y(2, 4, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 34)*pol_y(1, 4, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 34)*pol_y(1, 4, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 34)*pol_y(2, 4, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 34)*pol_y(2, 4, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 35)*pol_y(1, 4, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 35)*pol_y(1, 4, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 35)*pol_y(2, 4, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 35)*pol_y(2, 4, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 36)*pol_y(1, 5, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 36)*pol_y(1, 5, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 36)*pol_y(2, 5, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 36)*pol_y(2, 5, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 37)*pol_y(1, 5, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 37)*pol_y(1, 5, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 37)*pol_y(2, 5, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 37)*pol_y(2, 5, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 38)*pol_y(1, 5, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 38)*pol_y(1, 5, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 38)*pol_y(2, 5, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 38)*pol_y(2, 5, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 39)*pol_y(1, 5, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 39)*pol_y(1, 5, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 39)*pol_y(2, 5, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 39)*pol_y(2, 5, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 40)*pol_y(1, 6, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 40)*pol_y(1, 6, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 40)*pol_y(2, 6, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 40)*pol_y(2, 6, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 41)*pol_y(1, 6, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 41)*pol_y(1, 6, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 41)*pol_y(2, 6, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 41)*pol_y(2, 6, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 42)*pol_y(1, 6, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 42)*pol_y(1, 6, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 42)*pol_y(2, 6, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 42)*pol_y(2, 6, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 43)*pol_y(1, 7, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 43)*pol_y(1, 7, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 43)*pol_y(2, 7, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 43)*pol_y(2, 7, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 44)*pol_y(1, 7, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 44)*pol_y(1, 7, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 44)*pol_y(2, 7, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 44)*pol_y(2, 7, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 45)*pol_y(1, 8, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 45)*pol_y(1, 8, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 45)*pol_y(2, 8, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 45)*pol_y(2, 8, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 4)*pol_y(1, 0, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 4)*pol_y(1, 0, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 4)*pol_y(2, 0, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 4)*pol_y(2, 0, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 5)*pol_y(1, 0, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 5)*pol_y(1, 0, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 5)*pol_y(2, 0, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 5)*pol_y(2, 0, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 6)*pol_y(1, 0, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 6)*pol_y(1, 0, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 6)*pol_y(2, 0, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 6)*pol_y(2, 0, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 7)*pol_y(1, 0, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 7)*pol_y(1, 0, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 7)*pol_y(2, 0, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 7)*pol_y(2, 0, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 8)*pol_y(1, 0, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 8)*pol_y(1, 0, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 8)*pol_y(2, 0, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 8)*pol_y(2, 0, jg) + coef_x(1, 8) = coef_x(1, 8) + coef_xy(1, 9)*pol_y(1, 0, jg) + coef_x(2, 8) = coef_x(2, 8) + coef_xy(2, 9)*pol_y(1, 0, jg) + coef_x(3, 8) = coef_x(3, 8) + coef_xy(1, 9)*pol_y(2, 0, jg) + coef_x(4, 8) = coef_x(4, 8) + coef_xy(2, 9)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 10)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 10)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 10)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 10)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 11)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 11)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 11)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 11)*pol_y(2, 1, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 12)*pol_y(1, 1, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 12)*pol_y(1, 1, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 12)*pol_y(2, 1, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 12)*pol_y(2, 1, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 13)*pol_y(1, 1, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 13)*pol_y(1, 1, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 13)*pol_y(2, 1, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 13)*pol_y(2, 1, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 14)*pol_y(1, 1, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 14)*pol_y(1, 1, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 14)*pol_y(2, 1, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 14)*pol_y(2, 1, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 15)*pol_y(1, 1, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 15)*pol_y(1, 1, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 15)*pol_y(2, 1, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 15)*pol_y(2, 1, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 16)*pol_y(1, 1, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 16)*pol_y(1, 1, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 16)*pol_y(2, 1, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 16)*pol_y(2, 1, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 17)*pol_y(1, 1, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 17)*pol_y(1, 1, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 17)*pol_y(2, 1, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 17)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 18)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 18)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 18)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 18)*pol_y(2, 2, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 19)*pol_y(1, 2, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 19)*pol_y(1, 2, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 19)*pol_y(2, 2, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 19)*pol_y(2, 2, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 20)*pol_y(1, 2, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 20)*pol_y(1, 2, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 20)*pol_y(2, 2, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 20)*pol_y(2, 2, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 21)*pol_y(1, 2, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 21)*pol_y(1, 2, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 21)*pol_y(2, 2, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 21)*pol_y(2, 2, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 22)*pol_y(1, 2, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 22)*pol_y(1, 2, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 22)*pol_y(2, 2, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 22)*pol_y(2, 2, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 23)*pol_y(1, 2, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 23)*pol_y(1, 2, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 23)*pol_y(2, 2, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 23)*pol_y(2, 2, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 24)*pol_y(1, 2, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 24)*pol_y(1, 2, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 24)*pol_y(2, 2, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 24)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 25)*pol_y(1, 3, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 25)*pol_y(1, 3, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 25)*pol_y(2, 3, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 25)*pol_y(2, 3, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 26)*pol_y(1, 3, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 26)*pol_y(1, 3, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 26)*pol_y(2, 3, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 26)*pol_y(2, 3, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 27)*pol_y(1, 3, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 27)*pol_y(1, 3, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 27)*pol_y(2, 3, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 27)*pol_y(2, 3, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 28)*pol_y(1, 3, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 28)*pol_y(1, 3, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 28)*pol_y(2, 3, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 28)*pol_y(2, 3, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 29)*pol_y(1, 3, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 29)*pol_y(1, 3, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 29)*pol_y(2, 3, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 29)*pol_y(2, 3, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 30)*pol_y(1, 3, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 30)*pol_y(1, 3, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 30)*pol_y(2, 3, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 30)*pol_y(2, 3, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 31)*pol_y(1, 4, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 31)*pol_y(1, 4, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 31)*pol_y(2, 4, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 31)*pol_y(2, 4, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 32)*pol_y(1, 4, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 32)*pol_y(1, 4, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 32)*pol_y(2, 4, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 32)*pol_y(2, 4, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 33)*pol_y(1, 4, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 33)*pol_y(1, 4, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 33)*pol_y(2, 4, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 33)*pol_y(2, 4, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 34)*pol_y(1, 4, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 34)*pol_y(1, 4, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 34)*pol_y(2, 4, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 34)*pol_y(2, 4, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 35)*pol_y(1, 4, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 35)*pol_y(1, 4, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 35)*pol_y(2, 4, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 35)*pol_y(2, 4, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 36)*pol_y(1, 5, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 36)*pol_y(1, 5, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 36)*pol_y(2, 5, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 36)*pol_y(2, 5, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 37)*pol_y(1, 5, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 37)*pol_y(1, 5, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 37)*pol_y(2, 5, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 37)*pol_y(2, 5, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 38)*pol_y(1, 5, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 38)*pol_y(1, 5, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 38)*pol_y(2, 5, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 38)*pol_y(2, 5, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 39)*pol_y(1, 5, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 39)*pol_y(1, 5, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 39)*pol_y(2, 5, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 39)*pol_y(2, 5, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 40)*pol_y(1, 6, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 40)*pol_y(1, 6, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 40)*pol_y(2, 6, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 40)*pol_y(2, 6, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 41)*pol_y(1, 6, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 41)*pol_y(1, 6, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 41)*pol_y(2, 6, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 41)*pol_y(2, 6, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 42)*pol_y(1, 6, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 42)*pol_y(1, 6, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 42)*pol_y(2, 6, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 42)*pol_y(2, 6, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 43)*pol_y(1, 7, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 43)*pol_y(1, 7, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 43)*pol_y(2, 7, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 43)*pol_y(2, 7, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 44)*pol_y(1, 7, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 44)*pol_y(1, 7, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 44)*pol_y(2, 7, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 44)*pol_y(2, 7, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 45)*pol_y(1, 8, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 45)*pol_y(1, 8, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 45)*pol_y(2, 8, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 45)*pol_y(2, 8, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - s01 = s01+coef_x(1, 4)*pol_x(4, ig) - s02 = s02+coef_x(2, 4)*pol_x(4, ig) - s03 = s03+coef_x(3, 4)*pol_x(4, ig) - s04 = s04+coef_x(4, 4)*pol_x(4, ig) - s01 = s01+coef_x(1, 5)*pol_x(5, ig) - s02 = s02+coef_x(2, 5)*pol_x(5, ig) - s03 = s03+coef_x(3, 5)*pol_x(5, ig) - s04 = s04+coef_x(4, 5)*pol_x(5, ig) - s01 = s01+coef_x(1, 6)*pol_x(6, ig) - s02 = s02+coef_x(2, 6)*pol_x(6, ig) - s03 = s03+coef_x(3, 6)*pol_x(6, ig) - s04 = s04+coef_x(4, 6)*pol_x(6, ig) - s01 = s01+coef_x(1, 7)*pol_x(7, ig) - s02 = s02+coef_x(2, 7)*pol_x(7, ig) - s03 = s03+coef_x(3, 7)*pol_x(7, ig) - s04 = s04+coef_x(4, 7)*pol_x(7, ig) - s01 = s01+coef_x(1, 8)*pol_x(8, ig) - s02 = s02+coef_x(2, 8)*pol_x(8, ig) - s03 = s03+coef_x(3, 8)*pol_x(8, ig) - s04 = s04+coef_x(4, 8)*pol_x(8, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + s01 = s01 + coef_x(1, 4)*pol_x(4, ig) + s02 = s02 + coef_x(2, 4)*pol_x(4, ig) + s03 = s03 + coef_x(3, 4)*pol_x(4, ig) + s04 = s04 + coef_x(4, 4)*pol_x(4, ig) + s01 = s01 + coef_x(1, 5)*pol_x(5, ig) + s02 = s02 + coef_x(2, 5)*pol_x(5, ig) + s03 = s03 + coef_x(3, 5)*pol_x(5, ig) + s04 = s04 + coef_x(4, 5)*pol_x(5, ig) + s01 = s01 + coef_x(1, 6)*pol_x(6, ig) + s02 = s02 + coef_x(2, 6)*pol_x(6, ig) + s03 = s03 + coef_x(3, 6)*pol_x(6, ig) + s04 = s04 + coef_x(4, 6)*pol_x(6, ig) + s01 = s01 + coef_x(1, 7)*pol_x(7, ig) + s02 = s02 + coef_x(2, 7)*pol_x(7, ig) + s03 = s03 + coef_x(3, 7)*pol_x(7, ig) + s04 = s04 + coef_x(4, 7)*pol_x(7, ig) + s01 = s01 + coef_x(1, 8)*pol_x(8, ig) + s02 = s02 + coef_x(2, 8)*pol_x(8, ig) + s03 = s03 + coef_x(3, 8)*pol_x(8, ig) + s04 = s04 + coef_x(4, 8)*pol_x(8, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -2535,744 +2535,744 @@ SUBROUTINE collocate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 9 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(7)*pol_z(1, 0, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(7)*pol_z(2, 0, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(8)*pol_z(1, 0, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(8)*pol_z(2, 0, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(9)*pol_z(1, 0, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(9)*pol_z(2, 0, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(10)*pol_z(1, 0, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(10)*pol_z(2, 0, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(11)*pol_z(1, 0, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(11)*pol_z(2, 0, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(12)*pol_z(1, 0, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(12)*pol_z(2, 0, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(13)*pol_z(1, 0, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(13)*pol_z(2, 0, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(14)*pol_z(1, 0, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(14)*pol_z(2, 0, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(15)*pol_z(1, 0, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(15)*pol_z(2, 0, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(16)*pol_z(1, 0, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(16)*pol_z(2, 0, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(17)*pol_z(1, 0, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(17)*pol_z(2, 0, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(18)*pol_z(1, 0, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(18)*pol_z(2, 0, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(19)*pol_z(1, 0, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(19)*pol_z(2, 0, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(20)*pol_z(1, 0, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(20)*pol_z(2, 0, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(21)*pol_z(1, 0, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(21)*pol_z(2, 0, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(22)*pol_z(1, 0, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(22)*pol_z(2, 0, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(23)*pol_z(1, 0, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(23)*pol_z(2, 0, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(24)*pol_z(1, 0, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(24)*pol_z(2, 0, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(25)*pol_z(1, 0, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(25)*pol_z(2, 0, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(26)*pol_z(1, 0, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(26)*pol_z(2, 0, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(27)*pol_z(1, 0, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(27)*pol_z(2, 0, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(28)*pol_z(1, 0, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(28)*pol_z(2, 0, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(29)*pol_z(1, 0, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(29)*pol_z(2, 0, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(30)*pol_z(1, 0, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(30)*pol_z(2, 0, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(31)*pol_z(1, 0, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(31)*pol_z(2, 0, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(32)*pol_z(1, 0, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(32)*pol_z(2, 0, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(33)*pol_z(1, 0, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(33)*pol_z(2, 0, kg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_xyz(34)*pol_z(1, 0, kg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_xyz(34)*pol_z(2, 0, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(35)*pol_z(1, 0, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(35)*pol_z(2, 0, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(36)*pol_z(1, 0, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(36)*pol_z(2, 0, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(37)*pol_z(1, 0, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(37)*pol_z(2, 0, kg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_xyz(38)*pol_z(1, 0, kg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_xyz(38)*pol_z(2, 0, kg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_xyz(39)*pol_z(1, 0, kg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_xyz(39)*pol_z(2, 0, kg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_xyz(40)*pol_z(1, 0, kg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_xyz(40)*pol_z(2, 0, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(41)*pol_z(1, 0, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(41)*pol_z(2, 0, kg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_xyz(42)*pol_z(1, 0, kg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_xyz(42)*pol_z(2, 0, kg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_xyz(43)*pol_z(1, 0, kg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_xyz(43)*pol_z(2, 0, kg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_xyz(44)*pol_z(1, 0, kg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_xyz(44)*pol_z(2, 0, kg) - coef_xy(1, 45) = coef_xy(1, 45)+coef_xyz(45)*pol_z(1, 0, kg) - coef_xy(2, 45) = coef_xy(2, 45)+coef_xyz(45)*pol_z(2, 0, kg) - coef_xy(1, 46) = coef_xy(1, 46)+coef_xyz(46)*pol_z(1, 0, kg) - coef_xy(2, 46) = coef_xy(2, 46)+coef_xyz(46)*pol_z(2, 0, kg) - coef_xy(1, 47) = coef_xy(1, 47)+coef_xyz(47)*pol_z(1, 0, kg) - coef_xy(2, 47) = coef_xy(2, 47)+coef_xyz(47)*pol_z(2, 0, kg) - coef_xy(1, 48) = coef_xy(1, 48)+coef_xyz(48)*pol_z(1, 0, kg) - coef_xy(2, 48) = coef_xy(2, 48)+coef_xyz(48)*pol_z(2, 0, kg) - coef_xy(1, 49) = coef_xy(1, 49)+coef_xyz(49)*pol_z(1, 0, kg) - coef_xy(2, 49) = coef_xy(2, 49)+coef_xyz(49)*pol_z(2, 0, kg) - coef_xy(1, 50) = coef_xy(1, 50)+coef_xyz(50)*pol_z(1, 0, kg) - coef_xy(2, 50) = coef_xy(2, 50)+coef_xyz(50)*pol_z(2, 0, kg) - coef_xy(1, 51) = coef_xy(1, 51)+coef_xyz(51)*pol_z(1, 0, kg) - coef_xy(2, 51) = coef_xy(2, 51)+coef_xyz(51)*pol_z(2, 0, kg) - coef_xy(1, 52) = coef_xy(1, 52)+coef_xyz(52)*pol_z(1, 0, kg) - coef_xy(2, 52) = coef_xy(2, 52)+coef_xyz(52)*pol_z(2, 0, kg) - coef_xy(1, 53) = coef_xy(1, 53)+coef_xyz(53)*pol_z(1, 0, kg) - coef_xy(2, 53) = coef_xy(2, 53)+coef_xyz(53)*pol_z(2, 0, kg) - coef_xy(1, 54) = coef_xy(1, 54)+coef_xyz(54)*pol_z(1, 0, kg) - coef_xy(2, 54) = coef_xy(2, 54)+coef_xyz(54)*pol_z(2, 0, kg) - coef_xy(1, 55) = coef_xy(1, 55)+coef_xyz(55)*pol_z(1, 0, kg) - coef_xy(2, 55) = coef_xy(2, 55)+coef_xyz(55)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(56)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(56)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(57)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(57)*pol_z(2, 1, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(58)*pol_z(1, 1, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(58)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(59)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(59)*pol_z(2, 1, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(60)*pol_z(1, 1, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(60)*pol_z(2, 1, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(61)*pol_z(1, 1, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(61)*pol_z(2, 1, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(62)*pol_z(1, 1, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(62)*pol_z(2, 1, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(63)*pol_z(1, 1, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(63)*pol_z(2, 1, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(64)*pol_z(1, 1, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(64)*pol_z(2, 1, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(65)*pol_z(1, 1, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(65)*pol_z(2, 1, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(66)*pol_z(1, 1, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(66)*pol_z(2, 1, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(67)*pol_z(1, 1, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(67)*pol_z(2, 1, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(68)*pol_z(1, 1, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(68)*pol_z(2, 1, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(69)*pol_z(1, 1, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(69)*pol_z(2, 1, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(70)*pol_z(1, 1, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(70)*pol_z(2, 1, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(71)*pol_z(1, 1, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(71)*pol_z(2, 1, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(72)*pol_z(1, 1, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(72)*pol_z(2, 1, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(73)*pol_z(1, 1, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(73)*pol_z(2, 1, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(74)*pol_z(1, 1, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(74)*pol_z(2, 1, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(75)*pol_z(1, 1, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(75)*pol_z(2, 1, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(76)*pol_z(1, 1, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(76)*pol_z(2, 1, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(77)*pol_z(1, 1, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(77)*pol_z(2, 1, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(78)*pol_z(1, 1, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(78)*pol_z(2, 1, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(79)*pol_z(1, 1, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(79)*pol_z(2, 1, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(80)*pol_z(1, 1, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(80)*pol_z(2, 1, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(81)*pol_z(1, 1, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(81)*pol_z(2, 1, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(82)*pol_z(1, 1, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(82)*pol_z(2, 1, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(83)*pol_z(1, 1, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(83)*pol_z(2, 1, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(84)*pol_z(1, 1, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(84)*pol_z(2, 1, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(85)*pol_z(1, 1, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(85)*pol_z(2, 1, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(86)*pol_z(1, 1, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(86)*pol_z(2, 1, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(87)*pol_z(1, 1, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(87)*pol_z(2, 1, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(88)*pol_z(1, 1, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(88)*pol_z(2, 1, kg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_xyz(89)*pol_z(1, 1, kg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_xyz(89)*pol_z(2, 1, kg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_xyz(90)*pol_z(1, 1, kg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_xyz(90)*pol_z(2, 1, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(91)*pol_z(1, 1, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(91)*pol_z(2, 1, kg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_xyz(92)*pol_z(1, 1, kg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_xyz(92)*pol_z(2, 1, kg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_xyz(93)*pol_z(1, 1, kg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_xyz(93)*pol_z(2, 1, kg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_xyz(94)*pol_z(1, 1, kg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_xyz(94)*pol_z(2, 1, kg) - coef_xy(1, 46) = coef_xy(1, 46)+coef_xyz(95)*pol_z(1, 1, kg) - coef_xy(2, 46) = coef_xy(2, 46)+coef_xyz(95)*pol_z(2, 1, kg) - coef_xy(1, 47) = coef_xy(1, 47)+coef_xyz(96)*pol_z(1, 1, kg) - coef_xy(2, 47) = coef_xy(2, 47)+coef_xyz(96)*pol_z(2, 1, kg) - coef_xy(1, 48) = coef_xy(1, 48)+coef_xyz(97)*pol_z(1, 1, kg) - coef_xy(2, 48) = coef_xy(2, 48)+coef_xyz(97)*pol_z(2, 1, kg) - coef_xy(1, 50) = coef_xy(1, 50)+coef_xyz(98)*pol_z(1, 1, kg) - coef_xy(2, 50) = coef_xy(2, 50)+coef_xyz(98)*pol_z(2, 1, kg) - coef_xy(1, 51) = coef_xy(1, 51)+coef_xyz(99)*pol_z(1, 1, kg) - coef_xy(2, 51) = coef_xy(2, 51)+coef_xyz(99)*pol_z(2, 1, kg) - coef_xy(1, 53) = coef_xy(1, 53)+coef_xyz(100)*pol_z(1, 1, kg) - coef_xy(2, 53) = coef_xy(2, 53)+coef_xyz(100)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(101)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(101)*pol_z(2, 2, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(102)*pol_z(1, 2, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(102)*pol_z(2, 2, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(103)*pol_z(1, 2, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(103)*pol_z(2, 2, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(104)*pol_z(1, 2, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(104)*pol_z(2, 2, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(105)*pol_z(1, 2, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(105)*pol_z(2, 2, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(106)*pol_z(1, 2, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(106)*pol_z(2, 2, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(107)*pol_z(1, 2, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(107)*pol_z(2, 2, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(108)*pol_z(1, 2, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(108)*pol_z(2, 2, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(109)*pol_z(1, 2, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(109)*pol_z(2, 2, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(110)*pol_z(1, 2, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(110)*pol_z(2, 2, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(111)*pol_z(1, 2, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(111)*pol_z(2, 2, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(112)*pol_z(1, 2, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(112)*pol_z(2, 2, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(113)*pol_z(1, 2, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(113)*pol_z(2, 2, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(114)*pol_z(1, 2, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(114)*pol_z(2, 2, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(115)*pol_z(1, 2, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(115)*pol_z(2, 2, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(116)*pol_z(1, 2, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(116)*pol_z(2, 2, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(117)*pol_z(1, 2, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(117)*pol_z(2, 2, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(118)*pol_z(1, 2, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(118)*pol_z(2, 2, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(119)*pol_z(1, 2, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(119)*pol_z(2, 2, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(120)*pol_z(1, 2, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(120)*pol_z(2, 2, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(121)*pol_z(1, 2, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(121)*pol_z(2, 2, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(122)*pol_z(1, 2, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(122)*pol_z(2, 2, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(123)*pol_z(1, 2, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(123)*pol_z(2, 2, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(124)*pol_z(1, 2, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(124)*pol_z(2, 2, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(125)*pol_z(1, 2, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(125)*pol_z(2, 2, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(126)*pol_z(1, 2, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(126)*pol_z(2, 2, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(127)*pol_z(1, 2, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(127)*pol_z(2, 2, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(128)*pol_z(1, 2, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(128)*pol_z(2, 2, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(129)*pol_z(1, 2, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(129)*pol_z(2, 2, kg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_xyz(130)*pol_z(1, 2, kg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_xyz(130)*pol_z(2, 2, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(131)*pol_z(1, 2, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(131)*pol_z(2, 2, kg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_xyz(132)*pol_z(1, 2, kg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_xyz(132)*pol_z(2, 2, kg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_xyz(133)*pol_z(1, 2, kg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_xyz(133)*pol_z(2, 2, kg) - coef_xy(1, 46) = coef_xy(1, 46)+coef_xyz(134)*pol_z(1, 2, kg) - coef_xy(2, 46) = coef_xy(2, 46)+coef_xyz(134)*pol_z(2, 2, kg) - coef_xy(1, 47) = coef_xy(1, 47)+coef_xyz(135)*pol_z(1, 2, kg) - coef_xy(2, 47) = coef_xy(2, 47)+coef_xyz(135)*pol_z(2, 2, kg) - coef_xy(1, 50) = coef_xy(1, 50)+coef_xyz(136)*pol_z(1, 2, kg) - coef_xy(2, 50) = coef_xy(2, 50)+coef_xyz(136)*pol_z(2, 2, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(137)*pol_z(1, 3, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(137)*pol_z(2, 3, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(138)*pol_z(1, 3, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(138)*pol_z(2, 3, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(139)*pol_z(1, 3, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(139)*pol_z(2, 3, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(140)*pol_z(1, 3, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(140)*pol_z(2, 3, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(141)*pol_z(1, 3, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(141)*pol_z(2, 3, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(142)*pol_z(1, 3, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(142)*pol_z(2, 3, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(143)*pol_z(1, 3, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(143)*pol_z(2, 3, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(144)*pol_z(1, 3, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(144)*pol_z(2, 3, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(145)*pol_z(1, 3, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(145)*pol_z(2, 3, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(146)*pol_z(1, 3, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(146)*pol_z(2, 3, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(147)*pol_z(1, 3, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(147)*pol_z(2, 3, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(148)*pol_z(1, 3, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(148)*pol_z(2, 3, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(149)*pol_z(1, 3, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(149)*pol_z(2, 3, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(150)*pol_z(1, 3, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(150)*pol_z(2, 3, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(151)*pol_z(1, 3, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(151)*pol_z(2, 3, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(152)*pol_z(1, 3, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(152)*pol_z(2, 3, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(153)*pol_z(1, 3, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(153)*pol_z(2, 3, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(154)*pol_z(1, 3, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(154)*pol_z(2, 3, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(155)*pol_z(1, 3, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(155)*pol_z(2, 3, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(156)*pol_z(1, 3, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(156)*pol_z(2, 3, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(157)*pol_z(1, 3, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(157)*pol_z(2, 3, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(158)*pol_z(1, 3, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(158)*pol_z(2, 3, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(159)*pol_z(1, 3, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(159)*pol_z(2, 3, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(160)*pol_z(1, 3, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(160)*pol_z(2, 3, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(161)*pol_z(1, 3, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(161)*pol_z(2, 3, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(162)*pol_z(1, 3, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(162)*pol_z(2, 3, kg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_xyz(163)*pol_z(1, 3, kg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_xyz(163)*pol_z(2, 3, kg) - coef_xy(1, 46) = coef_xy(1, 46)+coef_xyz(164)*pol_z(1, 3, kg) - coef_xy(2, 46) = coef_xy(2, 46)+coef_xyz(164)*pol_z(2, 3, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(165)*pol_z(1, 4, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(165)*pol_z(2, 4, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(166)*pol_z(1, 4, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(166)*pol_z(2, 4, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(167)*pol_z(1, 4, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(167)*pol_z(2, 4, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(168)*pol_z(1, 4, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(168)*pol_z(2, 4, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(169)*pol_z(1, 4, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(169)*pol_z(2, 4, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(170)*pol_z(1, 4, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(170)*pol_z(2, 4, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(171)*pol_z(1, 4, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(171)*pol_z(2, 4, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(172)*pol_z(1, 4, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(172)*pol_z(2, 4, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(173)*pol_z(1, 4, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(173)*pol_z(2, 4, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(174)*pol_z(1, 4, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(174)*pol_z(2, 4, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(175)*pol_z(1, 4, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(175)*pol_z(2, 4, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(176)*pol_z(1, 4, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(176)*pol_z(2, 4, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(177)*pol_z(1, 4, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(177)*pol_z(2, 4, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(178)*pol_z(1, 4, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(178)*pol_z(2, 4, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(179)*pol_z(1, 4, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(179)*pol_z(2, 4, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(180)*pol_z(1, 4, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(180)*pol_z(2, 4, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(181)*pol_z(1, 4, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(181)*pol_z(2, 4, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(182)*pol_z(1, 4, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(182)*pol_z(2, 4, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(183)*pol_z(1, 4, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(183)*pol_z(2, 4, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(184)*pol_z(1, 4, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(184)*pol_z(2, 4, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(185)*pol_z(1, 4, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(185)*pol_z(2, 4, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(186)*pol_z(1, 5, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(186)*pol_z(2, 5, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(187)*pol_z(1, 5, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(187)*pol_z(2, 5, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(188)*pol_z(1, 5, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(188)*pol_z(2, 5, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(189)*pol_z(1, 5, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(189)*pol_z(2, 5, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(190)*pol_z(1, 5, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(190)*pol_z(2, 5, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(191)*pol_z(1, 5, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(191)*pol_z(2, 5, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(192)*pol_z(1, 5, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(192)*pol_z(2, 5, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(193)*pol_z(1, 5, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(193)*pol_z(2, 5, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(194)*pol_z(1, 5, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(194)*pol_z(2, 5, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(195)*pol_z(1, 5, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(195)*pol_z(2, 5, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(196)*pol_z(1, 5, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(196)*pol_z(2, 5, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(197)*pol_z(1, 5, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(197)*pol_z(2, 5, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(198)*pol_z(1, 5, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(198)*pol_z(2, 5, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(199)*pol_z(1, 5, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(199)*pol_z(2, 5, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(200)*pol_z(1, 5, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(200)*pol_z(2, 5, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(201)*pol_z(1, 6, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(201)*pol_z(2, 6, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(202)*pol_z(1, 6, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(202)*pol_z(2, 6, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(203)*pol_z(1, 6, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(203)*pol_z(2, 6, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(204)*pol_z(1, 6, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(204)*pol_z(2, 6, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(205)*pol_z(1, 6, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(205)*pol_z(2, 6, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(206)*pol_z(1, 6, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(206)*pol_z(2, 6, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(207)*pol_z(1, 6, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(207)*pol_z(2, 6, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(208)*pol_z(1, 6, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(208)*pol_z(2, 6, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(209)*pol_z(1, 6, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(209)*pol_z(2, 6, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(210)*pol_z(1, 6, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(210)*pol_z(2, 6, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(211)*pol_z(1, 7, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(211)*pol_z(2, 7, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(212)*pol_z(1, 7, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(212)*pol_z(2, 7, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(213)*pol_z(1, 7, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(213)*pol_z(2, 7, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(214)*pol_z(1, 7, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(214)*pol_z(2, 7, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(215)*pol_z(1, 7, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(215)*pol_z(2, 7, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(216)*pol_z(1, 7, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(216)*pol_z(2, 7, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(217)*pol_z(1, 8, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(217)*pol_z(2, 8, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(218)*pol_z(1, 8, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(218)*pol_z(2, 8, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(219)*pol_z(1, 8, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(219)*pol_z(2, 8, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(220)*pol_z(1, 9, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(220)*pol_z(2, 9, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(7)*pol_z(1, 0, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(7)*pol_z(2, 0, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(8)*pol_z(1, 0, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(8)*pol_z(2, 0, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(9)*pol_z(1, 0, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(9)*pol_z(2, 0, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(10)*pol_z(1, 0, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(10)*pol_z(2, 0, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(11)*pol_z(1, 0, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(11)*pol_z(2, 0, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(12)*pol_z(1, 0, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(12)*pol_z(2, 0, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(13)*pol_z(1, 0, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(13)*pol_z(2, 0, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(14)*pol_z(1, 0, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(14)*pol_z(2, 0, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(15)*pol_z(1, 0, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(15)*pol_z(2, 0, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(16)*pol_z(1, 0, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(16)*pol_z(2, 0, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(17)*pol_z(1, 0, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(17)*pol_z(2, 0, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(18)*pol_z(1, 0, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(18)*pol_z(2, 0, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(19)*pol_z(1, 0, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(19)*pol_z(2, 0, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(20)*pol_z(1, 0, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(20)*pol_z(2, 0, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(21)*pol_z(1, 0, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(21)*pol_z(2, 0, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(22)*pol_z(1, 0, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(22)*pol_z(2, 0, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(23)*pol_z(1, 0, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(23)*pol_z(2, 0, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(24)*pol_z(1, 0, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(24)*pol_z(2, 0, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(25)*pol_z(1, 0, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(25)*pol_z(2, 0, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(26)*pol_z(1, 0, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(26)*pol_z(2, 0, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(27)*pol_z(1, 0, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(27)*pol_z(2, 0, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(28)*pol_z(1, 0, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(28)*pol_z(2, 0, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(29)*pol_z(1, 0, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(29)*pol_z(2, 0, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(30)*pol_z(1, 0, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(30)*pol_z(2, 0, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(31)*pol_z(1, 0, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(31)*pol_z(2, 0, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(32)*pol_z(1, 0, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(32)*pol_z(2, 0, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(33)*pol_z(1, 0, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(33)*pol_z(2, 0, kg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_xyz(34)*pol_z(1, 0, kg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_xyz(34)*pol_z(2, 0, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(35)*pol_z(1, 0, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(35)*pol_z(2, 0, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(36)*pol_z(1, 0, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(36)*pol_z(2, 0, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(37)*pol_z(1, 0, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(37)*pol_z(2, 0, kg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_xyz(38)*pol_z(1, 0, kg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_xyz(38)*pol_z(2, 0, kg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_xyz(39)*pol_z(1, 0, kg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_xyz(39)*pol_z(2, 0, kg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_xyz(40)*pol_z(1, 0, kg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_xyz(40)*pol_z(2, 0, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(41)*pol_z(1, 0, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(41)*pol_z(2, 0, kg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_xyz(42)*pol_z(1, 0, kg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_xyz(42)*pol_z(2, 0, kg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_xyz(43)*pol_z(1, 0, kg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_xyz(43)*pol_z(2, 0, kg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_xyz(44)*pol_z(1, 0, kg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_xyz(44)*pol_z(2, 0, kg) + coef_xy(1, 45) = coef_xy(1, 45) + coef_xyz(45)*pol_z(1, 0, kg) + coef_xy(2, 45) = coef_xy(2, 45) + coef_xyz(45)*pol_z(2, 0, kg) + coef_xy(1, 46) = coef_xy(1, 46) + coef_xyz(46)*pol_z(1, 0, kg) + coef_xy(2, 46) = coef_xy(2, 46) + coef_xyz(46)*pol_z(2, 0, kg) + coef_xy(1, 47) = coef_xy(1, 47) + coef_xyz(47)*pol_z(1, 0, kg) + coef_xy(2, 47) = coef_xy(2, 47) + coef_xyz(47)*pol_z(2, 0, kg) + coef_xy(1, 48) = coef_xy(1, 48) + coef_xyz(48)*pol_z(1, 0, kg) + coef_xy(2, 48) = coef_xy(2, 48) + coef_xyz(48)*pol_z(2, 0, kg) + coef_xy(1, 49) = coef_xy(1, 49) + coef_xyz(49)*pol_z(1, 0, kg) + coef_xy(2, 49) = coef_xy(2, 49) + coef_xyz(49)*pol_z(2, 0, kg) + coef_xy(1, 50) = coef_xy(1, 50) + coef_xyz(50)*pol_z(1, 0, kg) + coef_xy(2, 50) = coef_xy(2, 50) + coef_xyz(50)*pol_z(2, 0, kg) + coef_xy(1, 51) = coef_xy(1, 51) + coef_xyz(51)*pol_z(1, 0, kg) + coef_xy(2, 51) = coef_xy(2, 51) + coef_xyz(51)*pol_z(2, 0, kg) + coef_xy(1, 52) = coef_xy(1, 52) + coef_xyz(52)*pol_z(1, 0, kg) + coef_xy(2, 52) = coef_xy(2, 52) + coef_xyz(52)*pol_z(2, 0, kg) + coef_xy(1, 53) = coef_xy(1, 53) + coef_xyz(53)*pol_z(1, 0, kg) + coef_xy(2, 53) = coef_xy(2, 53) + coef_xyz(53)*pol_z(2, 0, kg) + coef_xy(1, 54) = coef_xy(1, 54) + coef_xyz(54)*pol_z(1, 0, kg) + coef_xy(2, 54) = coef_xy(2, 54) + coef_xyz(54)*pol_z(2, 0, kg) + coef_xy(1, 55) = coef_xy(1, 55) + coef_xyz(55)*pol_z(1, 0, kg) + coef_xy(2, 55) = coef_xy(2, 55) + coef_xyz(55)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(56)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(56)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(57)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(57)*pol_z(2, 1, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(58)*pol_z(1, 1, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(58)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(59)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(59)*pol_z(2, 1, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(60)*pol_z(1, 1, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(60)*pol_z(2, 1, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(61)*pol_z(1, 1, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(61)*pol_z(2, 1, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(62)*pol_z(1, 1, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(62)*pol_z(2, 1, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(63)*pol_z(1, 1, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(63)*pol_z(2, 1, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(64)*pol_z(1, 1, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(64)*pol_z(2, 1, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(65)*pol_z(1, 1, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(65)*pol_z(2, 1, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(66)*pol_z(1, 1, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(66)*pol_z(2, 1, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(67)*pol_z(1, 1, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(67)*pol_z(2, 1, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(68)*pol_z(1, 1, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(68)*pol_z(2, 1, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(69)*pol_z(1, 1, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(69)*pol_z(2, 1, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(70)*pol_z(1, 1, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(70)*pol_z(2, 1, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(71)*pol_z(1, 1, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(71)*pol_z(2, 1, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(72)*pol_z(1, 1, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(72)*pol_z(2, 1, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(73)*pol_z(1, 1, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(73)*pol_z(2, 1, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(74)*pol_z(1, 1, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(74)*pol_z(2, 1, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(75)*pol_z(1, 1, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(75)*pol_z(2, 1, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(76)*pol_z(1, 1, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(76)*pol_z(2, 1, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(77)*pol_z(1, 1, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(77)*pol_z(2, 1, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(78)*pol_z(1, 1, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(78)*pol_z(2, 1, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(79)*pol_z(1, 1, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(79)*pol_z(2, 1, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(80)*pol_z(1, 1, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(80)*pol_z(2, 1, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(81)*pol_z(1, 1, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(81)*pol_z(2, 1, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(82)*pol_z(1, 1, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(82)*pol_z(2, 1, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(83)*pol_z(1, 1, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(83)*pol_z(2, 1, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(84)*pol_z(1, 1, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(84)*pol_z(2, 1, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(85)*pol_z(1, 1, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(85)*pol_z(2, 1, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(86)*pol_z(1, 1, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(86)*pol_z(2, 1, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(87)*pol_z(1, 1, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(87)*pol_z(2, 1, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(88)*pol_z(1, 1, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(88)*pol_z(2, 1, kg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_xyz(89)*pol_z(1, 1, kg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_xyz(89)*pol_z(2, 1, kg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_xyz(90)*pol_z(1, 1, kg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_xyz(90)*pol_z(2, 1, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(91)*pol_z(1, 1, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(91)*pol_z(2, 1, kg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_xyz(92)*pol_z(1, 1, kg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_xyz(92)*pol_z(2, 1, kg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_xyz(93)*pol_z(1, 1, kg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_xyz(93)*pol_z(2, 1, kg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_xyz(94)*pol_z(1, 1, kg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_xyz(94)*pol_z(2, 1, kg) + coef_xy(1, 46) = coef_xy(1, 46) + coef_xyz(95)*pol_z(1, 1, kg) + coef_xy(2, 46) = coef_xy(2, 46) + coef_xyz(95)*pol_z(2, 1, kg) + coef_xy(1, 47) = coef_xy(1, 47) + coef_xyz(96)*pol_z(1, 1, kg) + coef_xy(2, 47) = coef_xy(2, 47) + coef_xyz(96)*pol_z(2, 1, kg) + coef_xy(1, 48) = coef_xy(1, 48) + coef_xyz(97)*pol_z(1, 1, kg) + coef_xy(2, 48) = coef_xy(2, 48) + coef_xyz(97)*pol_z(2, 1, kg) + coef_xy(1, 50) = coef_xy(1, 50) + coef_xyz(98)*pol_z(1, 1, kg) + coef_xy(2, 50) = coef_xy(2, 50) + coef_xyz(98)*pol_z(2, 1, kg) + coef_xy(1, 51) = coef_xy(1, 51) + coef_xyz(99)*pol_z(1, 1, kg) + coef_xy(2, 51) = coef_xy(2, 51) + coef_xyz(99)*pol_z(2, 1, kg) + coef_xy(1, 53) = coef_xy(1, 53) + coef_xyz(100)*pol_z(1, 1, kg) + coef_xy(2, 53) = coef_xy(2, 53) + coef_xyz(100)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(101)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(101)*pol_z(2, 2, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(102)*pol_z(1, 2, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(102)*pol_z(2, 2, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(103)*pol_z(1, 2, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(103)*pol_z(2, 2, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(104)*pol_z(1, 2, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(104)*pol_z(2, 2, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(105)*pol_z(1, 2, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(105)*pol_z(2, 2, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(106)*pol_z(1, 2, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(106)*pol_z(2, 2, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(107)*pol_z(1, 2, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(107)*pol_z(2, 2, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(108)*pol_z(1, 2, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(108)*pol_z(2, 2, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(109)*pol_z(1, 2, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(109)*pol_z(2, 2, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(110)*pol_z(1, 2, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(110)*pol_z(2, 2, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(111)*pol_z(1, 2, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(111)*pol_z(2, 2, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(112)*pol_z(1, 2, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(112)*pol_z(2, 2, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(113)*pol_z(1, 2, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(113)*pol_z(2, 2, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(114)*pol_z(1, 2, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(114)*pol_z(2, 2, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(115)*pol_z(1, 2, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(115)*pol_z(2, 2, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(116)*pol_z(1, 2, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(116)*pol_z(2, 2, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(117)*pol_z(1, 2, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(117)*pol_z(2, 2, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(118)*pol_z(1, 2, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(118)*pol_z(2, 2, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(119)*pol_z(1, 2, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(119)*pol_z(2, 2, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(120)*pol_z(1, 2, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(120)*pol_z(2, 2, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(121)*pol_z(1, 2, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(121)*pol_z(2, 2, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(122)*pol_z(1, 2, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(122)*pol_z(2, 2, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(123)*pol_z(1, 2, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(123)*pol_z(2, 2, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(124)*pol_z(1, 2, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(124)*pol_z(2, 2, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(125)*pol_z(1, 2, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(125)*pol_z(2, 2, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(126)*pol_z(1, 2, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(126)*pol_z(2, 2, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(127)*pol_z(1, 2, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(127)*pol_z(2, 2, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(128)*pol_z(1, 2, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(128)*pol_z(2, 2, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(129)*pol_z(1, 2, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(129)*pol_z(2, 2, kg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_xyz(130)*pol_z(1, 2, kg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_xyz(130)*pol_z(2, 2, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(131)*pol_z(1, 2, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(131)*pol_z(2, 2, kg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_xyz(132)*pol_z(1, 2, kg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_xyz(132)*pol_z(2, 2, kg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_xyz(133)*pol_z(1, 2, kg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_xyz(133)*pol_z(2, 2, kg) + coef_xy(1, 46) = coef_xy(1, 46) + coef_xyz(134)*pol_z(1, 2, kg) + coef_xy(2, 46) = coef_xy(2, 46) + coef_xyz(134)*pol_z(2, 2, kg) + coef_xy(1, 47) = coef_xy(1, 47) + coef_xyz(135)*pol_z(1, 2, kg) + coef_xy(2, 47) = coef_xy(2, 47) + coef_xyz(135)*pol_z(2, 2, kg) + coef_xy(1, 50) = coef_xy(1, 50) + coef_xyz(136)*pol_z(1, 2, kg) + coef_xy(2, 50) = coef_xy(2, 50) + coef_xyz(136)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(137)*pol_z(1, 3, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(137)*pol_z(2, 3, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(138)*pol_z(1, 3, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(138)*pol_z(2, 3, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(139)*pol_z(1, 3, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(139)*pol_z(2, 3, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(140)*pol_z(1, 3, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(140)*pol_z(2, 3, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(141)*pol_z(1, 3, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(141)*pol_z(2, 3, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(142)*pol_z(1, 3, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(142)*pol_z(2, 3, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(143)*pol_z(1, 3, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(143)*pol_z(2, 3, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(144)*pol_z(1, 3, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(144)*pol_z(2, 3, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(145)*pol_z(1, 3, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(145)*pol_z(2, 3, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(146)*pol_z(1, 3, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(146)*pol_z(2, 3, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(147)*pol_z(1, 3, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(147)*pol_z(2, 3, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(148)*pol_z(1, 3, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(148)*pol_z(2, 3, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(149)*pol_z(1, 3, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(149)*pol_z(2, 3, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(150)*pol_z(1, 3, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(150)*pol_z(2, 3, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(151)*pol_z(1, 3, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(151)*pol_z(2, 3, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(152)*pol_z(1, 3, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(152)*pol_z(2, 3, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(153)*pol_z(1, 3, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(153)*pol_z(2, 3, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(154)*pol_z(1, 3, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(154)*pol_z(2, 3, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(155)*pol_z(1, 3, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(155)*pol_z(2, 3, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(156)*pol_z(1, 3, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(156)*pol_z(2, 3, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(157)*pol_z(1, 3, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(157)*pol_z(2, 3, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(158)*pol_z(1, 3, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(158)*pol_z(2, 3, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(159)*pol_z(1, 3, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(159)*pol_z(2, 3, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(160)*pol_z(1, 3, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(160)*pol_z(2, 3, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(161)*pol_z(1, 3, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(161)*pol_z(2, 3, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(162)*pol_z(1, 3, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(162)*pol_z(2, 3, kg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_xyz(163)*pol_z(1, 3, kg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_xyz(163)*pol_z(2, 3, kg) + coef_xy(1, 46) = coef_xy(1, 46) + coef_xyz(164)*pol_z(1, 3, kg) + coef_xy(2, 46) = coef_xy(2, 46) + coef_xyz(164)*pol_z(2, 3, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(165)*pol_z(1, 4, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(165)*pol_z(2, 4, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(166)*pol_z(1, 4, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(166)*pol_z(2, 4, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(167)*pol_z(1, 4, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(167)*pol_z(2, 4, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(168)*pol_z(1, 4, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(168)*pol_z(2, 4, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(169)*pol_z(1, 4, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(169)*pol_z(2, 4, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(170)*pol_z(1, 4, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(170)*pol_z(2, 4, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(171)*pol_z(1, 4, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(171)*pol_z(2, 4, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(172)*pol_z(1, 4, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(172)*pol_z(2, 4, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(173)*pol_z(1, 4, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(173)*pol_z(2, 4, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(174)*pol_z(1, 4, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(174)*pol_z(2, 4, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(175)*pol_z(1, 4, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(175)*pol_z(2, 4, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(176)*pol_z(1, 4, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(176)*pol_z(2, 4, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(177)*pol_z(1, 4, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(177)*pol_z(2, 4, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(178)*pol_z(1, 4, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(178)*pol_z(2, 4, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(179)*pol_z(1, 4, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(179)*pol_z(2, 4, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(180)*pol_z(1, 4, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(180)*pol_z(2, 4, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(181)*pol_z(1, 4, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(181)*pol_z(2, 4, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(182)*pol_z(1, 4, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(182)*pol_z(2, 4, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(183)*pol_z(1, 4, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(183)*pol_z(2, 4, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(184)*pol_z(1, 4, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(184)*pol_z(2, 4, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(185)*pol_z(1, 4, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(185)*pol_z(2, 4, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(186)*pol_z(1, 5, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(186)*pol_z(2, 5, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(187)*pol_z(1, 5, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(187)*pol_z(2, 5, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(188)*pol_z(1, 5, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(188)*pol_z(2, 5, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(189)*pol_z(1, 5, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(189)*pol_z(2, 5, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(190)*pol_z(1, 5, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(190)*pol_z(2, 5, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(191)*pol_z(1, 5, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(191)*pol_z(2, 5, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(192)*pol_z(1, 5, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(192)*pol_z(2, 5, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(193)*pol_z(1, 5, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(193)*pol_z(2, 5, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(194)*pol_z(1, 5, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(194)*pol_z(2, 5, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(195)*pol_z(1, 5, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(195)*pol_z(2, 5, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(196)*pol_z(1, 5, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(196)*pol_z(2, 5, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(197)*pol_z(1, 5, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(197)*pol_z(2, 5, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(198)*pol_z(1, 5, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(198)*pol_z(2, 5, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(199)*pol_z(1, 5, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(199)*pol_z(2, 5, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(200)*pol_z(1, 5, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(200)*pol_z(2, 5, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(201)*pol_z(1, 6, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(201)*pol_z(2, 6, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(202)*pol_z(1, 6, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(202)*pol_z(2, 6, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(203)*pol_z(1, 6, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(203)*pol_z(2, 6, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(204)*pol_z(1, 6, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(204)*pol_z(2, 6, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(205)*pol_z(1, 6, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(205)*pol_z(2, 6, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(206)*pol_z(1, 6, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(206)*pol_z(2, 6, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(207)*pol_z(1, 6, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(207)*pol_z(2, 6, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(208)*pol_z(1, 6, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(208)*pol_z(2, 6, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(209)*pol_z(1, 6, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(209)*pol_z(2, 6, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(210)*pol_z(1, 6, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(210)*pol_z(2, 6, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(211)*pol_z(1, 7, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(211)*pol_z(2, 7, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(212)*pol_z(1, 7, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(212)*pol_z(2, 7, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(213)*pol_z(1, 7, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(213)*pol_z(2, 7, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(214)*pol_z(1, 7, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(214)*pol_z(2, 7, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(215)*pol_z(1, 7, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(215)*pol_z(2, 7, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(216)*pol_z(1, 7, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(216)*pol_z(2, 7, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(217)*pol_z(1, 8, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(217)*pol_z(2, 8, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(218)*pol_z(1, 8, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(218)*pol_z(2, 8, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(219)*pol_z(1, 8, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(219)*pol_z(2, 8, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(220)*pol_z(1, 9, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(220)*pol_z(2, 9, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 4)*pol_y(1, 0, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 4)*pol_y(1, 0, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 4)*pol_y(2, 0, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 4)*pol_y(2, 0, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 5)*pol_y(1, 0, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 5)*pol_y(1, 0, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 5)*pol_y(2, 0, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 5)*pol_y(2, 0, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 6)*pol_y(1, 0, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 6)*pol_y(1, 0, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 6)*pol_y(2, 0, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 6)*pol_y(2, 0, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 7)*pol_y(1, 0, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 7)*pol_y(1, 0, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 7)*pol_y(2, 0, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 7)*pol_y(2, 0, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 8)*pol_y(1, 0, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 8)*pol_y(1, 0, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 8)*pol_y(2, 0, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 8)*pol_y(2, 0, jg) - coef_x(1, 8) = coef_x(1, 8)+coef_xy(1, 9)*pol_y(1, 0, jg) - coef_x(2, 8) = coef_x(2, 8)+coef_xy(2, 9)*pol_y(1, 0, jg) - coef_x(3, 8) = coef_x(3, 8)+coef_xy(1, 9)*pol_y(2, 0, jg) - coef_x(4, 8) = coef_x(4, 8)+coef_xy(2, 9)*pol_y(2, 0, jg) - coef_x(1, 9) = coef_x(1, 9)+coef_xy(1, 10)*pol_y(1, 0, jg) - coef_x(2, 9) = coef_x(2, 9)+coef_xy(2, 10)*pol_y(1, 0, jg) - coef_x(3, 9) = coef_x(3, 9)+coef_xy(1, 10)*pol_y(2, 0, jg) - coef_x(4, 9) = coef_x(4, 9)+coef_xy(2, 10)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 11)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 11)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 11)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 11)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 12)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 12)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 12)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 12)*pol_y(2, 1, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 13)*pol_y(1, 1, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 13)*pol_y(1, 1, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 13)*pol_y(2, 1, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 13)*pol_y(2, 1, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 14)*pol_y(1, 1, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 14)*pol_y(1, 1, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 14)*pol_y(2, 1, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 14)*pol_y(2, 1, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 15)*pol_y(1, 1, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 15)*pol_y(1, 1, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 15)*pol_y(2, 1, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 15)*pol_y(2, 1, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 16)*pol_y(1, 1, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 16)*pol_y(1, 1, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 16)*pol_y(2, 1, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 16)*pol_y(2, 1, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 17)*pol_y(1, 1, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 17)*pol_y(1, 1, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 17)*pol_y(2, 1, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 17)*pol_y(2, 1, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 18)*pol_y(1, 1, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 18)*pol_y(1, 1, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 18)*pol_y(2, 1, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 18)*pol_y(2, 1, jg) - coef_x(1, 8) = coef_x(1, 8)+coef_xy(1, 19)*pol_y(1, 1, jg) - coef_x(2, 8) = coef_x(2, 8)+coef_xy(2, 19)*pol_y(1, 1, jg) - coef_x(3, 8) = coef_x(3, 8)+coef_xy(1, 19)*pol_y(2, 1, jg) - coef_x(4, 8) = coef_x(4, 8)+coef_xy(2, 19)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 20)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 20)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 20)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 20)*pol_y(2, 2, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 21)*pol_y(1, 2, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 21)*pol_y(1, 2, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 21)*pol_y(2, 2, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 21)*pol_y(2, 2, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 22)*pol_y(1, 2, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 22)*pol_y(1, 2, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 22)*pol_y(2, 2, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 22)*pol_y(2, 2, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 23)*pol_y(1, 2, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 23)*pol_y(1, 2, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 23)*pol_y(2, 2, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 23)*pol_y(2, 2, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 24)*pol_y(1, 2, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 24)*pol_y(1, 2, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 24)*pol_y(2, 2, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 24)*pol_y(2, 2, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 25)*pol_y(1, 2, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 25)*pol_y(1, 2, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 25)*pol_y(2, 2, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 25)*pol_y(2, 2, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 26)*pol_y(1, 2, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 26)*pol_y(1, 2, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 26)*pol_y(2, 2, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 26)*pol_y(2, 2, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 27)*pol_y(1, 2, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 27)*pol_y(1, 2, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 27)*pol_y(2, 2, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 27)*pol_y(2, 2, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 28)*pol_y(1, 3, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 28)*pol_y(1, 3, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 28)*pol_y(2, 3, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 28)*pol_y(2, 3, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 29)*pol_y(1, 3, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 29)*pol_y(1, 3, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 29)*pol_y(2, 3, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 29)*pol_y(2, 3, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 30)*pol_y(1, 3, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 30)*pol_y(1, 3, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 30)*pol_y(2, 3, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 30)*pol_y(2, 3, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 31)*pol_y(1, 3, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 31)*pol_y(1, 3, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 31)*pol_y(2, 3, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 31)*pol_y(2, 3, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 32)*pol_y(1, 3, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 32)*pol_y(1, 3, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 32)*pol_y(2, 3, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 32)*pol_y(2, 3, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 33)*pol_y(1, 3, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 33)*pol_y(1, 3, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 33)*pol_y(2, 3, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 33)*pol_y(2, 3, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 34)*pol_y(1, 3, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 34)*pol_y(1, 3, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 34)*pol_y(2, 3, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 34)*pol_y(2, 3, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 35)*pol_y(1, 4, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 35)*pol_y(1, 4, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 35)*pol_y(2, 4, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 35)*pol_y(2, 4, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 36)*pol_y(1, 4, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 36)*pol_y(1, 4, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 36)*pol_y(2, 4, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 36)*pol_y(2, 4, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 37)*pol_y(1, 4, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 37)*pol_y(1, 4, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 37)*pol_y(2, 4, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 37)*pol_y(2, 4, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 38)*pol_y(1, 4, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 38)*pol_y(1, 4, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 38)*pol_y(2, 4, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 38)*pol_y(2, 4, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 39)*pol_y(1, 4, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 39)*pol_y(1, 4, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 39)*pol_y(2, 4, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 39)*pol_y(2, 4, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 40)*pol_y(1, 4, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 40)*pol_y(1, 4, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 40)*pol_y(2, 4, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 40)*pol_y(2, 4, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 41)*pol_y(1, 5, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 41)*pol_y(1, 5, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 41)*pol_y(2, 5, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 41)*pol_y(2, 5, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 42)*pol_y(1, 5, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 42)*pol_y(1, 5, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 42)*pol_y(2, 5, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 42)*pol_y(2, 5, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 43)*pol_y(1, 5, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 43)*pol_y(1, 5, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 43)*pol_y(2, 5, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 43)*pol_y(2, 5, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 44)*pol_y(1, 5, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 44)*pol_y(1, 5, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 44)*pol_y(2, 5, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 44)*pol_y(2, 5, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 45)*pol_y(1, 5, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 45)*pol_y(1, 5, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 45)*pol_y(2, 5, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 45)*pol_y(2, 5, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 46)*pol_y(1, 6, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 46)*pol_y(1, 6, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 46)*pol_y(2, 6, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 46)*pol_y(2, 6, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 47)*pol_y(1, 6, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 47)*pol_y(1, 6, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 47)*pol_y(2, 6, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 47)*pol_y(2, 6, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 48)*pol_y(1, 6, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 48)*pol_y(1, 6, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 48)*pol_y(2, 6, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 48)*pol_y(2, 6, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 49)*pol_y(1, 6, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 49)*pol_y(1, 6, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 49)*pol_y(2, 6, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 49)*pol_y(2, 6, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 50)*pol_y(1, 7, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 50)*pol_y(1, 7, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 50)*pol_y(2, 7, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 50)*pol_y(2, 7, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 51)*pol_y(1, 7, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 51)*pol_y(1, 7, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 51)*pol_y(2, 7, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 51)*pol_y(2, 7, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 52)*pol_y(1, 7, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 52)*pol_y(1, 7, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 52)*pol_y(2, 7, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 52)*pol_y(2, 7, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 53)*pol_y(1, 8, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 53)*pol_y(1, 8, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 53)*pol_y(2, 8, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 53)*pol_y(2, 8, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 54)*pol_y(1, 8, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 54)*pol_y(1, 8, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 54)*pol_y(2, 8, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 54)*pol_y(2, 8, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 55)*pol_y(1, 9, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 55)*pol_y(1, 9, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 55)*pol_y(2, 9, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 55)*pol_y(2, 9, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 4)*pol_y(1, 0, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 4)*pol_y(1, 0, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 4)*pol_y(2, 0, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 4)*pol_y(2, 0, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 5)*pol_y(1, 0, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 5)*pol_y(1, 0, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 5)*pol_y(2, 0, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 5)*pol_y(2, 0, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 6)*pol_y(1, 0, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 6)*pol_y(1, 0, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 6)*pol_y(2, 0, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 6)*pol_y(2, 0, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 7)*pol_y(1, 0, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 7)*pol_y(1, 0, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 7)*pol_y(2, 0, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 7)*pol_y(2, 0, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 8)*pol_y(1, 0, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 8)*pol_y(1, 0, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 8)*pol_y(2, 0, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 8)*pol_y(2, 0, jg) + coef_x(1, 8) = coef_x(1, 8) + coef_xy(1, 9)*pol_y(1, 0, jg) + coef_x(2, 8) = coef_x(2, 8) + coef_xy(2, 9)*pol_y(1, 0, jg) + coef_x(3, 8) = coef_x(3, 8) + coef_xy(1, 9)*pol_y(2, 0, jg) + coef_x(4, 8) = coef_x(4, 8) + coef_xy(2, 9)*pol_y(2, 0, jg) + coef_x(1, 9) = coef_x(1, 9) + coef_xy(1, 10)*pol_y(1, 0, jg) + coef_x(2, 9) = coef_x(2, 9) + coef_xy(2, 10)*pol_y(1, 0, jg) + coef_x(3, 9) = coef_x(3, 9) + coef_xy(1, 10)*pol_y(2, 0, jg) + coef_x(4, 9) = coef_x(4, 9) + coef_xy(2, 10)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 11)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 11)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 11)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 11)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 12)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 12)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 12)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 12)*pol_y(2, 1, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 13)*pol_y(1, 1, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 13)*pol_y(1, 1, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 13)*pol_y(2, 1, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 13)*pol_y(2, 1, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 14)*pol_y(1, 1, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 14)*pol_y(1, 1, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 14)*pol_y(2, 1, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 14)*pol_y(2, 1, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 15)*pol_y(1, 1, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 15)*pol_y(1, 1, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 15)*pol_y(2, 1, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 15)*pol_y(2, 1, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 16)*pol_y(1, 1, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 16)*pol_y(1, 1, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 16)*pol_y(2, 1, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 16)*pol_y(2, 1, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 17)*pol_y(1, 1, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 17)*pol_y(1, 1, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 17)*pol_y(2, 1, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 17)*pol_y(2, 1, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 18)*pol_y(1, 1, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 18)*pol_y(1, 1, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 18)*pol_y(2, 1, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 18)*pol_y(2, 1, jg) + coef_x(1, 8) = coef_x(1, 8) + coef_xy(1, 19)*pol_y(1, 1, jg) + coef_x(2, 8) = coef_x(2, 8) + coef_xy(2, 19)*pol_y(1, 1, jg) + coef_x(3, 8) = coef_x(3, 8) + coef_xy(1, 19)*pol_y(2, 1, jg) + coef_x(4, 8) = coef_x(4, 8) + coef_xy(2, 19)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 20)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 20)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 20)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 20)*pol_y(2, 2, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 21)*pol_y(1, 2, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 21)*pol_y(1, 2, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 21)*pol_y(2, 2, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 21)*pol_y(2, 2, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 22)*pol_y(1, 2, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 22)*pol_y(1, 2, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 22)*pol_y(2, 2, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 22)*pol_y(2, 2, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 23)*pol_y(1, 2, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 23)*pol_y(1, 2, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 23)*pol_y(2, 2, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 23)*pol_y(2, 2, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 24)*pol_y(1, 2, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 24)*pol_y(1, 2, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 24)*pol_y(2, 2, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 24)*pol_y(2, 2, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 25)*pol_y(1, 2, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 25)*pol_y(1, 2, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 25)*pol_y(2, 2, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 25)*pol_y(2, 2, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 26)*pol_y(1, 2, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 26)*pol_y(1, 2, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 26)*pol_y(2, 2, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 26)*pol_y(2, 2, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 27)*pol_y(1, 2, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 27)*pol_y(1, 2, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 27)*pol_y(2, 2, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 27)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 28)*pol_y(1, 3, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 28)*pol_y(1, 3, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 28)*pol_y(2, 3, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 28)*pol_y(2, 3, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 29)*pol_y(1, 3, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 29)*pol_y(1, 3, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 29)*pol_y(2, 3, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 29)*pol_y(2, 3, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 30)*pol_y(1, 3, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 30)*pol_y(1, 3, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 30)*pol_y(2, 3, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 30)*pol_y(2, 3, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 31)*pol_y(1, 3, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 31)*pol_y(1, 3, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 31)*pol_y(2, 3, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 31)*pol_y(2, 3, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 32)*pol_y(1, 3, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 32)*pol_y(1, 3, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 32)*pol_y(2, 3, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 32)*pol_y(2, 3, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 33)*pol_y(1, 3, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 33)*pol_y(1, 3, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 33)*pol_y(2, 3, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 33)*pol_y(2, 3, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 34)*pol_y(1, 3, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 34)*pol_y(1, 3, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 34)*pol_y(2, 3, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 34)*pol_y(2, 3, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 35)*pol_y(1, 4, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 35)*pol_y(1, 4, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 35)*pol_y(2, 4, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 35)*pol_y(2, 4, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 36)*pol_y(1, 4, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 36)*pol_y(1, 4, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 36)*pol_y(2, 4, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 36)*pol_y(2, 4, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 37)*pol_y(1, 4, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 37)*pol_y(1, 4, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 37)*pol_y(2, 4, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 37)*pol_y(2, 4, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 38)*pol_y(1, 4, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 38)*pol_y(1, 4, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 38)*pol_y(2, 4, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 38)*pol_y(2, 4, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 39)*pol_y(1, 4, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 39)*pol_y(1, 4, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 39)*pol_y(2, 4, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 39)*pol_y(2, 4, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 40)*pol_y(1, 4, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 40)*pol_y(1, 4, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 40)*pol_y(2, 4, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 40)*pol_y(2, 4, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 41)*pol_y(1, 5, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 41)*pol_y(1, 5, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 41)*pol_y(2, 5, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 41)*pol_y(2, 5, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 42)*pol_y(1, 5, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 42)*pol_y(1, 5, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 42)*pol_y(2, 5, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 42)*pol_y(2, 5, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 43)*pol_y(1, 5, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 43)*pol_y(1, 5, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 43)*pol_y(2, 5, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 43)*pol_y(2, 5, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 44)*pol_y(1, 5, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 44)*pol_y(1, 5, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 44)*pol_y(2, 5, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 44)*pol_y(2, 5, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 45)*pol_y(1, 5, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 45)*pol_y(1, 5, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 45)*pol_y(2, 5, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 45)*pol_y(2, 5, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 46)*pol_y(1, 6, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 46)*pol_y(1, 6, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 46)*pol_y(2, 6, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 46)*pol_y(2, 6, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 47)*pol_y(1, 6, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 47)*pol_y(1, 6, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 47)*pol_y(2, 6, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 47)*pol_y(2, 6, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 48)*pol_y(1, 6, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 48)*pol_y(1, 6, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 48)*pol_y(2, 6, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 48)*pol_y(2, 6, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 49)*pol_y(1, 6, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 49)*pol_y(1, 6, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 49)*pol_y(2, 6, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 49)*pol_y(2, 6, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 50)*pol_y(1, 7, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 50)*pol_y(1, 7, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 50)*pol_y(2, 7, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 50)*pol_y(2, 7, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 51)*pol_y(1, 7, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 51)*pol_y(1, 7, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 51)*pol_y(2, 7, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 51)*pol_y(2, 7, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 52)*pol_y(1, 7, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 52)*pol_y(1, 7, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 52)*pol_y(2, 7, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 52)*pol_y(2, 7, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 53)*pol_y(1, 8, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 53)*pol_y(1, 8, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 53)*pol_y(2, 8, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 53)*pol_y(2, 8, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 54)*pol_y(1, 8, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 54)*pol_y(1, 8, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 54)*pol_y(2, 8, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 54)*pol_y(2, 8, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 55)*pol_y(1, 9, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 55)*pol_y(1, 9, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 55)*pol_y(2, 9, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 55)*pol_y(2, 9, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - s01 = s01+coef_x(1, 4)*pol_x(4, ig) - s02 = s02+coef_x(2, 4)*pol_x(4, ig) - s03 = s03+coef_x(3, 4)*pol_x(4, ig) - s04 = s04+coef_x(4, 4)*pol_x(4, ig) - s01 = s01+coef_x(1, 5)*pol_x(5, ig) - s02 = s02+coef_x(2, 5)*pol_x(5, ig) - s03 = s03+coef_x(3, 5)*pol_x(5, ig) - s04 = s04+coef_x(4, 5)*pol_x(5, ig) - s01 = s01+coef_x(1, 6)*pol_x(6, ig) - s02 = s02+coef_x(2, 6)*pol_x(6, ig) - s03 = s03+coef_x(3, 6)*pol_x(6, ig) - s04 = s04+coef_x(4, 6)*pol_x(6, ig) - s01 = s01+coef_x(1, 7)*pol_x(7, ig) - s02 = s02+coef_x(2, 7)*pol_x(7, ig) - s03 = s03+coef_x(3, 7)*pol_x(7, ig) - s04 = s04+coef_x(4, 7)*pol_x(7, ig) - s01 = s01+coef_x(1, 8)*pol_x(8, ig) - s02 = s02+coef_x(2, 8)*pol_x(8, ig) - s03 = s03+coef_x(3, 8)*pol_x(8, ig) - s04 = s04+coef_x(4, 8)*pol_x(8, ig) - s01 = s01+coef_x(1, 9)*pol_x(9, ig) - s02 = s02+coef_x(2, 9)*pol_x(9, ig) - s03 = s03+coef_x(3, 9)*pol_x(9, ig) - s04 = s04+coef_x(4, 9)*pol_x(9, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + s01 = s01 + coef_x(1, 4)*pol_x(4, ig) + s02 = s02 + coef_x(2, 4)*pol_x(4, ig) + s03 = s03 + coef_x(3, 4)*pol_x(4, ig) + s04 = s04 + coef_x(4, 4)*pol_x(4, ig) + s01 = s01 + coef_x(1, 5)*pol_x(5, ig) + s02 = s02 + coef_x(2, 5)*pol_x(5, ig) + s03 = s03 + coef_x(3, 5)*pol_x(5, ig) + s04 = s04 + coef_x(4, 5)*pol_x(5, ig) + s01 = s01 + coef_x(1, 6)*pol_x(6, ig) + s02 = s02 + coef_x(2, 6)*pol_x(6, ig) + s03 = s03 + coef_x(3, 6)*pol_x(6, ig) + s04 = s04 + coef_x(4, 6)*pol_x(6, ig) + s01 = s01 + coef_x(1, 7)*pol_x(7, ig) + s02 = s02 + coef_x(2, 7)*pol_x(7, ig) + s03 = s03 + coef_x(3, 7)*pol_x(7, ig) + s04 = s04 + coef_x(4, 7)*pol_x(7, ig) + s01 = s01 + coef_x(1, 8)*pol_x(8, ig) + s02 = s02 + coef_x(2, 8)*pol_x(8, ig) + s03 = s03 + coef_x(3, 8)*pol_x(8, ig) + s04 = s04 + coef_x(4, 8)*pol_x(8, ig) + s01 = s01 + coef_x(1, 9)*pol_x(9, ig) + s02 = s02 + coef_x(2, 9)*pol_x(9, ig) + s03 = s03 + coef_x(3, 9)*pol_x(9, ig) + s04 = s04 + coef_x(4, 9)*pol_x(9, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO diff --git a/src/grid/collocate_fast_2.f90 b/src/grid/collocate_fast_2.f90 index 41be23ab18..6f9516c2bb 100644 --- a/src/grid/collocate_fast_2.f90 +++ b/src/grid/collocate_fast_2.f90 @@ -14,7 +14,7 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bounds, lp, cmax, gridbounds) USE kinds, ONLY: dp INTEGER, INTENT(IN) :: sphere_bounds(*), lp - REAL(dp), INTENT(IN) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(IN) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER, INTENT(IN) :: cmax REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & @@ -29,15 +29,15 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) @@ -45,35 +45,35 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_xyz(lxyz)*pol_z(1, lzp, kg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_xyz(lxyz)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_xyz(lxyz)*pol_z(1, lzp, kg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_xyz(lxyz)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_x(1, lxp) = coef_x(1, lxp)+coef_xy(1, lxy)*pol_y(1, lyp, jg) - coef_x(2, lxp) = coef_x(2, lxp)+coef_xy(2, lxy)*pol_y(1, lyp, jg) - coef_x(3, lxp) = coef_x(3, lxp)+coef_xy(1, lxy)*pol_y(2, lyp, jg) - coef_x(4, lxp) = coef_x(4, lxp)+coef_xy(2, lxy)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_x(1, lxp) = coef_x(1, lxp) + coef_xy(1, lxy)*pol_y(1, lyp, jg) + coef_x(2, lxp) = coef_x(2, lxp) + coef_xy(2, lxy)*pol_y(1, lyp, jg) + coef_x(3, lxp) = coef_x(3, lxp) + coef_xy(1, lxy)*pol_y(2, lyp, jg) + coef_x(4, lxp) = coef_x(4, lxp) + coef_xy(2, lxy)*pol_y(2, lyp, jg) ENDDO ENDDO @@ -84,15 +84,15 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe s03 = 0.0_dp s04 = 0.0_dp DO lxp = 0, lp - s01 = s01+coef_x(1, lxp)*pol_x(lxp, ig) - s02 = s02+coef_x(2, lxp)*pol_x(lxp, ig) - s03 = s03+coef_x(3, lxp)*pol_x(lxp, ig) - s04 = s04+coef_x(4, lxp)*pol_x(lxp, ig) + s01 = s01 + coef_x(1, lxp)*pol_x(lxp, ig) + s02 = s02 + coef_x(2, lxp)*pol_x(lxp, ig) + s03 = s03 + coef_x(3, lxp)*pol_x(lxp, ig) + s04 = s04 + coef_x(4, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO @@ -120,63 +120,63 @@ SUBROUTINE collocate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 0 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_xyz(lxyz)*pol_z(1, lzp, kg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_xyz(lxyz)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_xyz(lxyz)*pol_z(1, lzp, kg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_xyz(lxyz)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 1)*pol_y(1, 0, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 1)*pol_y(2, 0, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 1)*pol_y(1, 0, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 1)*pol_y(2, 0, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -203,70 +203,70 @@ SUBROUTINE collocate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 1 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xy(:, lxy) = coef_xy(:, lxy)+coef_xyz(lxyz)*pol_z(:, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xy(:, lxy) = coef_xy(:, lxy) + coef_xyz(lxyz)*pol_z(:, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 1)*pol_y(1, 0, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 1)*pol_y(2, 0, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 2)*pol_y(1, 0, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 2)*pol_y(2, 0, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 3)*pol_y(1, 1, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 3)*pol_y(2, 1, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 1)*pol_y(1, 0, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 1)*pol_y(2, 0, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 2)*pol_y(1, 0, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 2)*pol_y(2, 0, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 3)*pol_y(1, 1, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 3)*pol_y(2, 1, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -293,78 +293,78 @@ SUBROUTINE collocate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 2 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(1)*pol_z(:, 0, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(2)*pol_z(:, 0, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(3)*pol_z(:, 0, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(4)*pol_z(:, 0, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(5)*pol_z(:, 0, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(6)*pol_z(:, 0, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(7)*pol_z(:, 1, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(8)*pol_z(:, 1, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(9)*pol_z(:, 1, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(10)*pol_z(:, 2, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(1)*pol_z(:, 0, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(2)*pol_z(:, 0, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(3)*pol_z(:, 0, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(4)*pol_z(:, 0, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(5)*pol_z(:, 0, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(6)*pol_z(:, 0, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(7)*pol_z(:, 1, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(8)*pol_z(:, 1, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(9)*pol_z(:, 1, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(10)*pol_z(:, 2, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 1)*pol_y(1, 0, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 1)*pol_y(2, 0, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 2)*pol_y(1, 0, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 2)*pol_y(2, 0, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 3)*pol_y(1, 0, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 3)*pol_y(2, 0, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 4)*pol_y(1, 1, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 4)*pol_y(2, 1, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 5)*pol_y(1, 1, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 5)*pol_y(2, 1, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 6)*pol_y(1, 2, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 6)*pol_y(2, 2, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 1)*pol_y(1, 0, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 1)*pol_y(2, 0, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 2)*pol_y(1, 0, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 2)*pol_y(2, 0, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 3)*pol_y(1, 0, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 3)*pol_y(2, 0, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 4)*pol_y(1, 1, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 4)*pol_y(2, 1, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 5)*pol_y(1, 1, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 5)*pol_y(2, 1, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 6)*pol_y(1, 2, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 6)*pol_y(2, 2, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -391,100 +391,100 @@ SUBROUTINE collocate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 3 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(1)*pol_z(:, 0, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(2)*pol_z(:, 0, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(3)*pol_z(:, 0, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(4)*pol_z(:, 0, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(5)*pol_z(:, 0, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(6)*pol_z(:, 0, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(7)*pol_z(:, 0, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(8)*pol_z(:, 0, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(9)*pol_z(:, 0, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(10)*pol_z(:, 0, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(11)*pol_z(:, 1, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(12)*pol_z(:, 1, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(13)*pol_z(:, 1, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(14)*pol_z(:, 1, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(15)*pol_z(:, 1, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(16)*pol_z(:, 1, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(17)*pol_z(:, 2, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(18)*pol_z(:, 2, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(19)*pol_z(:, 2, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(20)*pol_z(:, 3, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(1)*pol_z(:, 0, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(2)*pol_z(:, 0, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(3)*pol_z(:, 0, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(4)*pol_z(:, 0, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(5)*pol_z(:, 0, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(6)*pol_z(:, 0, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(7)*pol_z(:, 0, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(8)*pol_z(:, 0, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(9)*pol_z(:, 0, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(10)*pol_z(:, 0, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(11)*pol_z(:, 1, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(12)*pol_z(:, 1, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(13)*pol_z(:, 1, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(14)*pol_z(:, 1, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(15)*pol_z(:, 1, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(16)*pol_z(:, 1, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(17)*pol_z(:, 2, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(18)*pol_z(:, 2, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(19)*pol_z(:, 2, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(20)*pol_z(:, 3, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 1)*pol_y(1, 0, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 1)*pol_y(2, 0, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 2)*pol_y(1, 0, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 2)*pol_y(2, 0, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 3)*pol_y(1, 0, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 3)*pol_y(2, 0, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 4)*pol_y(1, 0, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 4)*pol_y(2, 0, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 5)*pol_y(1, 1, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 5)*pol_y(2, 1, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 6)*pol_y(1, 1, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 6)*pol_y(2, 1, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 7)*pol_y(1, 1, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 7)*pol_y(2, 1, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 8)*pol_y(1, 2, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 8)*pol_y(2, 2, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 9)*pol_y(1, 2, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 9)*pol_y(2, 2, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 10)*pol_y(1, 3, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 10)*pol_y(2, 3, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 1)*pol_y(1, 0, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 1)*pol_y(2, 0, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 2)*pol_y(1, 0, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 2)*pol_y(2, 0, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 3)*pol_y(1, 0, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 3)*pol_y(2, 0, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 4)*pol_y(1, 0, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 4)*pol_y(2, 0, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 5)*pol_y(1, 1, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 5)*pol_y(2, 1, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 6)*pol_y(1, 1, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 6)*pol_y(2, 1, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 7)*pol_y(1, 1, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 7)*pol_y(2, 1, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 8)*pol_y(1, 2, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 8)*pol_y(2, 2, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 9)*pol_y(1, 2, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 9)*pol_y(2, 2, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 10)*pol_y(1, 3, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 10)*pol_y(2, 3, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -511,99 +511,99 @@ SUBROUTINE collocate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 4 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(1)*pol_z(:, 0, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(2)*pol_z(:, 0, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(3)*pol_z(:, 0, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(4)*pol_z(:, 0, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(5)*pol_z(:, 0, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(6)*pol_z(:, 0, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(7)*pol_z(:, 0, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(8)*pol_z(:, 0, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(9)*pol_z(:, 0, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(10)*pol_z(:, 0, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(11)*pol_z(:, 0, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(12)*pol_z(:, 0, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(13)*pol_z(:, 0, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(14)*pol_z(:, 0, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(15)*pol_z(:, 0, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(16)*pol_z(:, 1, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(17)*pol_z(:, 1, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(18)*pol_z(:, 1, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(19)*pol_z(:, 1, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(20)*pol_z(:, 1, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(21)*pol_z(:, 1, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(22)*pol_z(:, 1, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(23)*pol_z(:, 1, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(24)*pol_z(:, 1, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(25)*pol_z(:, 1, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(26)*pol_z(:, 2, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(27)*pol_z(:, 2, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(28)*pol_z(:, 2, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(29)*pol_z(:, 2, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(30)*pol_z(:, 2, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(31)*pol_z(:, 2, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(32)*pol_z(:, 3, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(33)*pol_z(:, 3, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(34)*pol_z(:, 3, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(35)*pol_z(:, 4, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(1)*pol_z(:, 0, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(2)*pol_z(:, 0, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(3)*pol_z(:, 0, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(4)*pol_z(:, 0, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(5)*pol_z(:, 0, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(6)*pol_z(:, 0, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(7)*pol_z(:, 0, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(8)*pol_z(:, 0, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(9)*pol_z(:, 0, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(10)*pol_z(:, 0, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(11)*pol_z(:, 0, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(12)*pol_z(:, 0, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(13)*pol_z(:, 0, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(14)*pol_z(:, 0, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(15)*pol_z(:, 0, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(16)*pol_z(:, 1, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(17)*pol_z(:, 1, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(18)*pol_z(:, 1, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(19)*pol_z(:, 1, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(20)*pol_z(:, 1, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(21)*pol_z(:, 1, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(22)*pol_z(:, 1, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(23)*pol_z(:, 1, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(24)*pol_z(:, 1, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(25)*pol_z(:, 1, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(26)*pol_z(:, 2, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(27)*pol_z(:, 2, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(28)*pol_z(:, 2, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(29)*pol_z(:, 2, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(30)*pol_z(:, 2, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(31)*pol_z(:, 2, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(32)*pol_z(:, 3, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(33)*pol_z(:, 3, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(34)*pol_z(:, 3, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(35)*pol_z(:, 4, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 1)*pol_y(1, 0, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 1)*pol_y(2, 0, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 2)*pol_y(1, 0, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 2)*pol_y(2, 0, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 3)*pol_y(1, 0, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 3)*pol_y(2, 0, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 4)*pol_y(1, 0, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 4)*pol_y(2, 0, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 5)*pol_y(1, 0, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 5)*pol_y(2, 0, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 6)*pol_y(1, 1, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 6)*pol_y(2, 1, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 7)*pol_y(1, 1, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 7)*pol_y(2, 1, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 8)*pol_y(1, 1, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 8)*pol_y(2, 1, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 9)*pol_y(1, 1, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 9)*pol_y(2, 1, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 10)*pol_y(1, 2, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 10)*pol_y(2, 2, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 11)*pol_y(1, 2, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 11)*pol_y(2, 2, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 12)*pol_y(1, 2, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 12)*pol_y(2, 2, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 13)*pol_y(1, 3, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 13)*pol_y(2, 3, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 14)*pol_y(1, 3, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 14)*pol_y(2, 3, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 15)*pol_y(1, 4, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 15)*pol_y(2, 4, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 1)*pol_y(1, 0, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 1)*pol_y(2, 0, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 2)*pol_y(1, 0, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 2)*pol_y(2, 0, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 3)*pol_y(1, 0, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 3)*pol_y(2, 0, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 4)*pol_y(1, 0, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 4)*pol_y(2, 0, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 5)*pol_y(1, 0, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 5)*pol_y(2, 0, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 6)*pol_y(1, 1, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 6)*pol_y(2, 1, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 7)*pol_y(1, 1, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 7)*pol_y(2, 1, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 8)*pol_y(1, 1, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 8)*pol_y(2, 1, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 9)*pol_y(1, 1, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 9)*pol_y(2, 1, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 10)*pol_y(1, 2, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 10)*pol_y(2, 2, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 11)*pol_y(1, 2, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 11)*pol_y(2, 2, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 12)*pol_y(1, 2, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 12)*pol_y(2, 2, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 13)*pol_y(1, 3, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 13)*pol_y(2, 3, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 14)*pol_y(1, 3, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 14)*pol_y(2, 3, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 15)*pol_y(1, 4, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 15)*pol_y(2, 4, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp @@ -611,15 +611,15 @@ SUBROUTINE collocate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = 0.0_dp s04 = 0.0_dp DO lxp = 0, lp - s01 = s01+coef_x(1, lxp)*pol_x(lxp, ig) - s02 = s02+coef_x(2, lxp)*pol_x(lxp, ig) - s03 = s03+coef_x(3, lxp)*pol_x(lxp, ig) - s04 = s04+coef_x(4, lxp)*pol_x(lxp, ig) + s01 = s01 + coef_x(1, lxp)*pol_x(lxp, ig) + s02 = s02 + coef_x(2, lxp)*pol_x(lxp, ig) + s03 = s03 + coef_x(3, lxp)*pol_x(lxp, ig) + s04 = s04 + coef_x(4, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -646,188 +646,188 @@ SUBROUTINE collocate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 5 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(7)*pol_z(1, 0, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(7)*pol_z(2, 0, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(8)*pol_z(1, 0, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(8)*pol_z(2, 0, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(9)*pol_z(1, 0, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(9)*pol_z(2, 0, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(10)*pol_z(1, 0, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(10)*pol_z(2, 0, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(11)*pol_z(1, 0, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(11)*pol_z(2, 0, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(12)*pol_z(1, 0, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(12)*pol_z(2, 0, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(13)*pol_z(1, 0, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(13)*pol_z(2, 0, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(14)*pol_z(1, 0, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(14)*pol_z(2, 0, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(15)*pol_z(1, 0, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(15)*pol_z(2, 0, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(16)*pol_z(1, 0, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(16)*pol_z(2, 0, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(17)*pol_z(1, 0, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(17)*pol_z(2, 0, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(18)*pol_z(1, 0, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(18)*pol_z(2, 0, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(19)*pol_z(1, 0, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(19)*pol_z(2, 0, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(20)*pol_z(1, 0, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(20)*pol_z(2, 0, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(21)*pol_z(1, 0, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(21)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(22)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(22)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(23)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(23)*pol_z(2, 1, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(24)*pol_z(1, 1, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(24)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(25)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(25)*pol_z(2, 1, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(26)*pol_z(1, 1, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(26)*pol_z(2, 1, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(27)*pol_z(1, 1, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(27)*pol_z(2, 1, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(28)*pol_z(1, 1, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(28)*pol_z(2, 1, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(29)*pol_z(1, 1, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(29)*pol_z(2, 1, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(30)*pol_z(1, 1, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(30)*pol_z(2, 1, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(31)*pol_z(1, 1, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(31)*pol_z(2, 1, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(32)*pol_z(1, 1, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(32)*pol_z(2, 1, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(33)*pol_z(1, 1, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(33)*pol_z(2, 1, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(34)*pol_z(1, 1, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(34)*pol_z(2, 1, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(35)*pol_z(1, 1, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(35)*pol_z(2, 1, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(36)*pol_z(1, 1, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(36)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(37)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(37)*pol_z(2, 2, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(38)*pol_z(1, 2, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(38)*pol_z(2, 2, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(39)*pol_z(1, 2, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(39)*pol_z(2, 2, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(40)*pol_z(1, 2, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(40)*pol_z(2, 2, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(41)*pol_z(1, 2, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(41)*pol_z(2, 2, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(42)*pol_z(1, 2, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(42)*pol_z(2, 2, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(43)*pol_z(1, 2, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(43)*pol_z(2, 2, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(44)*pol_z(1, 2, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(44)*pol_z(2, 2, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(45)*pol_z(1, 2, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(45)*pol_z(2, 2, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(46)*pol_z(1, 2, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(46)*pol_z(2, 2, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(47)*pol_z(1, 3, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(47)*pol_z(2, 3, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(48)*pol_z(1, 3, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(48)*pol_z(2, 3, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(49)*pol_z(1, 3, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(49)*pol_z(2, 3, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(50)*pol_z(1, 3, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(50)*pol_z(2, 3, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(51)*pol_z(1, 3, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(51)*pol_z(2, 3, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(52)*pol_z(1, 3, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(52)*pol_z(2, 3, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(53)*pol_z(1, 4, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(53)*pol_z(2, 4, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(54)*pol_z(1, 4, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(54)*pol_z(2, 4, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(55)*pol_z(1, 4, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(55)*pol_z(2, 4, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(56)*pol_z(1, 5, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(56)*pol_z(2, 5, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(7)*pol_z(1, 0, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(7)*pol_z(2, 0, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(8)*pol_z(1, 0, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(8)*pol_z(2, 0, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(9)*pol_z(1, 0, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(9)*pol_z(2, 0, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(10)*pol_z(1, 0, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(10)*pol_z(2, 0, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(11)*pol_z(1, 0, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(11)*pol_z(2, 0, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(12)*pol_z(1, 0, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(12)*pol_z(2, 0, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(13)*pol_z(1, 0, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(13)*pol_z(2, 0, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(14)*pol_z(1, 0, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(14)*pol_z(2, 0, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(15)*pol_z(1, 0, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(15)*pol_z(2, 0, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(16)*pol_z(1, 0, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(16)*pol_z(2, 0, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(17)*pol_z(1, 0, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(17)*pol_z(2, 0, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(18)*pol_z(1, 0, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(18)*pol_z(2, 0, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(19)*pol_z(1, 0, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(19)*pol_z(2, 0, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(20)*pol_z(1, 0, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(20)*pol_z(2, 0, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(21)*pol_z(1, 0, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(21)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(22)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(22)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(23)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(23)*pol_z(2, 1, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(24)*pol_z(1, 1, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(24)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(25)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(25)*pol_z(2, 1, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(26)*pol_z(1, 1, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(26)*pol_z(2, 1, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(27)*pol_z(1, 1, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(27)*pol_z(2, 1, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(28)*pol_z(1, 1, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(28)*pol_z(2, 1, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(29)*pol_z(1, 1, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(29)*pol_z(2, 1, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(30)*pol_z(1, 1, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(30)*pol_z(2, 1, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(31)*pol_z(1, 1, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(31)*pol_z(2, 1, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(32)*pol_z(1, 1, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(32)*pol_z(2, 1, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(33)*pol_z(1, 1, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(33)*pol_z(2, 1, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(34)*pol_z(1, 1, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(34)*pol_z(2, 1, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(35)*pol_z(1, 1, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(35)*pol_z(2, 1, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(36)*pol_z(1, 1, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(36)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(37)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(37)*pol_z(2, 2, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(38)*pol_z(1, 2, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(38)*pol_z(2, 2, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(39)*pol_z(1, 2, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(39)*pol_z(2, 2, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(40)*pol_z(1, 2, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(40)*pol_z(2, 2, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(41)*pol_z(1, 2, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(41)*pol_z(2, 2, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(42)*pol_z(1, 2, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(42)*pol_z(2, 2, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(43)*pol_z(1, 2, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(43)*pol_z(2, 2, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(44)*pol_z(1, 2, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(44)*pol_z(2, 2, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(45)*pol_z(1, 2, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(45)*pol_z(2, 2, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(46)*pol_z(1, 2, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(46)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(47)*pol_z(1, 3, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(47)*pol_z(2, 3, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(48)*pol_z(1, 3, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(48)*pol_z(2, 3, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(49)*pol_z(1, 3, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(49)*pol_z(2, 3, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(50)*pol_z(1, 3, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(50)*pol_z(2, 3, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(51)*pol_z(1, 3, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(51)*pol_z(2, 3, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(52)*pol_z(1, 3, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(52)*pol_z(2, 3, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(53)*pol_z(1, 4, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(53)*pol_z(2, 4, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(54)*pol_z(1, 4, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(54)*pol_z(2, 4, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(55)*pol_z(1, 4, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(55)*pol_z(2, 4, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(56)*pol_z(1, 5, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(56)*pol_z(2, 5, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 1)*pol_y(1, 0, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 1)*pol_y(2, 0, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 2)*pol_y(1, 0, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 2)*pol_y(2, 0, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 3)*pol_y(1, 0, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 3)*pol_y(2, 0, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 4)*pol_y(1, 0, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 4)*pol_y(2, 0, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 5)*pol_y(1, 0, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 5)*pol_y(2, 0, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 6)*pol_y(1, 0, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 6)*pol_y(2, 0, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 7)*pol_y(1, 1, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 7)*pol_y(2, 1, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 8)*pol_y(1, 1, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 8)*pol_y(2, 1, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 9)*pol_y(1, 1, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 9)*pol_y(2, 1, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 10)*pol_y(1, 1, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 10)*pol_y(2, 1, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 11)*pol_y(1, 1, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 11)*pol_y(2, 1, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 12)*pol_y(1, 2, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 12)*pol_y(2, 2, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 13)*pol_y(1, 2, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 13)*pol_y(2, 2, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 14)*pol_y(1, 2, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 14)*pol_y(2, 2, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 15)*pol_y(1, 2, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 15)*pol_y(2, 2, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 16)*pol_y(1, 3, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 16)*pol_y(2, 3, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 17)*pol_y(1, 3, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 17)*pol_y(2, 3, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 18)*pol_y(1, 3, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 18)*pol_y(2, 3, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 19)*pol_y(1, 4, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 19)*pol_y(2, 4, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 20)*pol_y(1, 4, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 20)*pol_y(2, 4, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 21)*pol_y(1, 5, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 21)*pol_y(2, 5, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 1)*pol_y(1, 0, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 1)*pol_y(2, 0, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 2)*pol_y(1, 0, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 2)*pol_y(2, 0, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 3)*pol_y(1, 0, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 3)*pol_y(2, 0, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 4)*pol_y(1, 0, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 4)*pol_y(2, 0, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 5)*pol_y(1, 0, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 5)*pol_y(2, 0, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 6)*pol_y(1, 0, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 6)*pol_y(2, 0, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 7)*pol_y(1, 1, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 7)*pol_y(2, 1, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 8)*pol_y(1, 1, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 8)*pol_y(2, 1, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 9)*pol_y(1, 1, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 9)*pol_y(2, 1, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 10)*pol_y(1, 1, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 10)*pol_y(2, 1, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 11)*pol_y(1, 1, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 11)*pol_y(2, 1, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 12)*pol_y(1, 2, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 12)*pol_y(2, 2, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 13)*pol_y(1, 2, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 13)*pol_y(2, 2, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 14)*pol_y(1, 2, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 14)*pol_y(2, 2, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 15)*pol_y(1, 2, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 15)*pol_y(2, 2, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 16)*pol_y(1, 3, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 16)*pol_y(2, 3, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 17)*pol_y(1, 3, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 17)*pol_y(2, 3, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 18)*pol_y(1, 3, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 18)*pol_y(2, 3, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 19)*pol_y(1, 4, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 19)*pol_y(2, 4, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 20)*pol_y(1, 4, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 20)*pol_y(2, 4, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 21)*pol_y(1, 5, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 21)*pol_y(2, 5, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp @@ -835,15 +835,15 @@ SUBROUTINE collocate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = 0.0_dp s04 = 0.0_dp DO lxp = 0, lp - s01 = s01+coef_x(1, lxp)*pol_x(lxp, ig) - s02 = s02+coef_x(2, lxp)*pol_x(lxp, ig) - s03 = s03+coef_x(3, lxp)*pol_x(lxp, ig) - s04 = s04+coef_x(4, lxp)*pol_x(lxp, ig) + s01 = s01 + coef_x(1, lxp)*pol_x(lxp, ig) + s02 = s02 + coef_x(2, lxp)*pol_x(lxp, ig) + s03 = s03 + coef_x(3, lxp)*pol_x(lxp, ig) + s04 = s04 + coef_x(4, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -870,174 +870,174 @@ SUBROUTINE collocate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 6 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(1)*pol_z(:, 0, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(2)*pol_z(:, 0, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(3)*pol_z(:, 0, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(4)*pol_z(:, 0, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(5)*pol_z(:, 0, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(6)*pol_z(:, 0, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(7)*pol_z(:, 0, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(8)*pol_z(:, 0, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(9)*pol_z(:, 0, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(10)*pol_z(:, 0, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(11)*pol_z(:, 0, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(12)*pol_z(:, 0, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(13)*pol_z(:, 0, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(14)*pol_z(:, 0, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(15)*pol_z(:, 0, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(16)*pol_z(:, 0, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(17)*pol_z(:, 0, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(18)*pol_z(:, 0, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(19)*pol_z(:, 0, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(20)*pol_z(:, 0, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(21)*pol_z(:, 0, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(22)*pol_z(:, 0, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(23)*pol_z(:, 0, kg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_xyz(24)*pol_z(:, 0, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(25)*pol_z(:, 0, kg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_xyz(26)*pol_z(:, 0, kg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_xyz(27)*pol_z(:, 0, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(28)*pol_z(:, 0, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(29)*pol_z(:, 1, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(30)*pol_z(:, 1, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(31)*pol_z(:, 1, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(32)*pol_z(:, 1, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(33)*pol_z(:, 1, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(34)*pol_z(:, 1, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(35)*pol_z(:, 1, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(36)*pol_z(:, 1, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(37)*pol_z(:, 1, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(38)*pol_z(:, 1, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(39)*pol_z(:, 1, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(40)*pol_z(:, 1, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(41)*pol_z(:, 1, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(42)*pol_z(:, 1, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(43)*pol_z(:, 1, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(44)*pol_z(:, 1, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(45)*pol_z(:, 1, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(46)*pol_z(:, 1, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(47)*pol_z(:, 1, kg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_xyz(48)*pol_z(:, 1, kg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_xyz(49)*pol_z(:, 1, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(50)*pol_z(:, 2, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(51)*pol_z(:, 2, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(52)*pol_z(:, 2, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(53)*pol_z(:, 2, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(54)*pol_z(:, 2, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(55)*pol_z(:, 2, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(56)*pol_z(:, 2, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(57)*pol_z(:, 2, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(58)*pol_z(:, 2, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(59)*pol_z(:, 2, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(60)*pol_z(:, 2, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(61)*pol_z(:, 2, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(62)*pol_z(:, 2, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(63)*pol_z(:, 2, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(64)*pol_z(:, 2, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(65)*pol_z(:, 3, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(66)*pol_z(:, 3, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(67)*pol_z(:, 3, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(68)*pol_z(:, 3, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(69)*pol_z(:, 3, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(70)*pol_z(:, 3, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(71)*pol_z(:, 3, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(72)*pol_z(:, 3, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(73)*pol_z(:, 3, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(74)*pol_z(:, 3, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(75)*pol_z(:, 4, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(76)*pol_z(:, 4, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(77)*pol_z(:, 4, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(78)*pol_z(:, 4, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(79)*pol_z(:, 4, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(80)*pol_z(:, 4, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(81)*pol_z(:, 5, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(82)*pol_z(:, 5, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(83)*pol_z(:, 5, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(84)*pol_z(:, 6, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(1)*pol_z(:, 0, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(2)*pol_z(:, 0, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(3)*pol_z(:, 0, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(4)*pol_z(:, 0, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(5)*pol_z(:, 0, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(6)*pol_z(:, 0, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(7)*pol_z(:, 0, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(8)*pol_z(:, 0, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(9)*pol_z(:, 0, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(10)*pol_z(:, 0, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(11)*pol_z(:, 0, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(12)*pol_z(:, 0, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(13)*pol_z(:, 0, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(14)*pol_z(:, 0, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(15)*pol_z(:, 0, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(16)*pol_z(:, 0, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(17)*pol_z(:, 0, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(18)*pol_z(:, 0, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(19)*pol_z(:, 0, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(20)*pol_z(:, 0, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(21)*pol_z(:, 0, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(22)*pol_z(:, 0, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(23)*pol_z(:, 0, kg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_xyz(24)*pol_z(:, 0, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(25)*pol_z(:, 0, kg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_xyz(26)*pol_z(:, 0, kg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_xyz(27)*pol_z(:, 0, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(28)*pol_z(:, 0, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(29)*pol_z(:, 1, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(30)*pol_z(:, 1, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(31)*pol_z(:, 1, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(32)*pol_z(:, 1, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(33)*pol_z(:, 1, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(34)*pol_z(:, 1, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(35)*pol_z(:, 1, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(36)*pol_z(:, 1, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(37)*pol_z(:, 1, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(38)*pol_z(:, 1, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(39)*pol_z(:, 1, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(40)*pol_z(:, 1, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(41)*pol_z(:, 1, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(42)*pol_z(:, 1, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(43)*pol_z(:, 1, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(44)*pol_z(:, 1, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(45)*pol_z(:, 1, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(46)*pol_z(:, 1, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(47)*pol_z(:, 1, kg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_xyz(48)*pol_z(:, 1, kg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_xyz(49)*pol_z(:, 1, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(50)*pol_z(:, 2, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(51)*pol_z(:, 2, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(52)*pol_z(:, 2, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(53)*pol_z(:, 2, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(54)*pol_z(:, 2, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(55)*pol_z(:, 2, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(56)*pol_z(:, 2, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(57)*pol_z(:, 2, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(58)*pol_z(:, 2, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(59)*pol_z(:, 2, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(60)*pol_z(:, 2, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(61)*pol_z(:, 2, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(62)*pol_z(:, 2, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(63)*pol_z(:, 2, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(64)*pol_z(:, 2, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(65)*pol_z(:, 3, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(66)*pol_z(:, 3, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(67)*pol_z(:, 3, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(68)*pol_z(:, 3, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(69)*pol_z(:, 3, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(70)*pol_z(:, 3, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(71)*pol_z(:, 3, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(72)*pol_z(:, 3, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(73)*pol_z(:, 3, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(74)*pol_z(:, 3, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(75)*pol_z(:, 4, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(76)*pol_z(:, 4, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(77)*pol_z(:, 4, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(78)*pol_z(:, 4, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(79)*pol_z(:, 4, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(80)*pol_z(:, 4, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(81)*pol_z(:, 5, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(82)*pol_z(:, 5, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(83)*pol_z(:, 5, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(84)*pol_z(:, 6, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 1)*pol_y(1, 0, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 1)*pol_y(2, 0, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 2)*pol_y(1, 0, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 2)*pol_y(2, 0, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 3)*pol_y(1, 0, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 3)*pol_y(2, 0, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 4)*pol_y(1, 0, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 4)*pol_y(2, 0, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 5)*pol_y(1, 0, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 5)*pol_y(2, 0, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 6)*pol_y(1, 0, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 6)*pol_y(2, 0, jg) - coef_x(1:2, 6) = coef_x(1:2, 6)+coef_xy(1:2, 7)*pol_y(1, 0, jg) - coef_x(3:4, 6) = coef_x(3:4, 6)+coef_xy(1:2, 7)*pol_y(2, 0, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 8)*pol_y(1, 1, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 8)*pol_y(2, 1, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 9)*pol_y(1, 1, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 9)*pol_y(2, 1, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 10)*pol_y(1, 1, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 10)*pol_y(2, 1, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 11)*pol_y(1, 1, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 11)*pol_y(2, 1, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 12)*pol_y(1, 1, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 12)*pol_y(2, 1, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 13)*pol_y(1, 1, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 13)*pol_y(2, 1, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 14)*pol_y(1, 2, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 14)*pol_y(2, 2, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 15)*pol_y(1, 2, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 15)*pol_y(2, 2, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 16)*pol_y(1, 2, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 16)*pol_y(2, 2, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 17)*pol_y(1, 2, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 17)*pol_y(2, 2, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 18)*pol_y(1, 2, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 18)*pol_y(2, 2, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 19)*pol_y(1, 3, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 19)*pol_y(2, 3, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 20)*pol_y(1, 3, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 20)*pol_y(2, 3, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 21)*pol_y(1, 3, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 21)*pol_y(2, 3, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 22)*pol_y(1, 3, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 22)*pol_y(2, 3, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 23)*pol_y(1, 4, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 23)*pol_y(2, 4, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 24)*pol_y(1, 4, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 24)*pol_y(2, 4, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 25)*pol_y(1, 4, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 25)*pol_y(2, 4, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 26)*pol_y(1, 5, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 26)*pol_y(2, 5, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 27)*pol_y(1, 5, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 27)*pol_y(2, 5, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 28)*pol_y(1, 6, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 28)*pol_y(2, 6, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 1)*pol_y(1, 0, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 1)*pol_y(2, 0, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 2)*pol_y(1, 0, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 2)*pol_y(2, 0, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 3)*pol_y(1, 0, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 3)*pol_y(2, 0, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 4)*pol_y(1, 0, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 4)*pol_y(2, 0, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 5)*pol_y(1, 0, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 5)*pol_y(2, 0, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 6)*pol_y(1, 0, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 6)*pol_y(2, 0, jg) + coef_x(1:2, 6) = coef_x(1:2, 6) + coef_xy(1:2, 7)*pol_y(1, 0, jg) + coef_x(3:4, 6) = coef_x(3:4, 6) + coef_xy(1:2, 7)*pol_y(2, 0, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 8)*pol_y(1, 1, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 8)*pol_y(2, 1, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 9)*pol_y(1, 1, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 9)*pol_y(2, 1, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 10)*pol_y(1, 1, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 10)*pol_y(2, 1, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 11)*pol_y(1, 1, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 11)*pol_y(2, 1, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 12)*pol_y(1, 1, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 12)*pol_y(2, 1, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 13)*pol_y(1, 1, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 13)*pol_y(2, 1, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 14)*pol_y(1, 2, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 14)*pol_y(2, 2, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 15)*pol_y(1, 2, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 15)*pol_y(2, 2, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 16)*pol_y(1, 2, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 16)*pol_y(2, 2, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 17)*pol_y(1, 2, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 17)*pol_y(2, 2, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 18)*pol_y(1, 2, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 18)*pol_y(2, 2, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 19)*pol_y(1, 3, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 19)*pol_y(2, 3, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 20)*pol_y(1, 3, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 20)*pol_y(2, 3, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 21)*pol_y(1, 3, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 21)*pol_y(2, 3, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 22)*pol_y(1, 3, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 22)*pol_y(2, 3, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 23)*pol_y(1, 4, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 23)*pol_y(2, 4, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 24)*pol_y(1, 4, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 24)*pol_y(2, 4, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 25)*pol_y(1, 4, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 25)*pol_y(2, 4, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 26)*pol_y(1, 5, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 26)*pol_y(2, 5, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 27)*pol_y(1, 5, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 27)*pol_y(2, 5, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 28)*pol_y(1, 6, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 28)*pol_y(2, 6, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp @@ -1045,15 +1045,15 @@ SUBROUTINE collocate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = 0.0_dp s04 = 0.0_dp DO lxp = 0, lp - s01 = s01+coef_x(1, lxp)*pol_x(lxp, ig) - s02 = s02+coef_x(2, lxp)*pol_x(lxp, ig) - s03 = s03+coef_x(3, lxp)*pol_x(lxp, ig) - s04 = s04+coef_x(4, lxp)*pol_x(lxp, ig) + s01 = s01 + coef_x(1, lxp)*pol_x(lxp, ig) + s02 = s02 + coef_x(2, lxp)*pol_x(lxp, ig) + s03 = s03 + coef_x(3, lxp)*pol_x(lxp, ig) + s04 = s04 + coef_x(4, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -1080,268 +1080,268 @@ SUBROUTINE collocate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 7 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(1)*pol_z(:, 0, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(2)*pol_z(:, 0, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(3)*pol_z(:, 0, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(4)*pol_z(:, 0, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(5)*pol_z(:, 0, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(6)*pol_z(:, 0, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(7)*pol_z(:, 0, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(8)*pol_z(:, 0, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(9)*pol_z(:, 0, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(10)*pol_z(:, 0, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(11)*pol_z(:, 0, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(12)*pol_z(:, 0, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(13)*pol_z(:, 0, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(14)*pol_z(:, 0, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(15)*pol_z(:, 0, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(16)*pol_z(:, 0, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(17)*pol_z(:, 0, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(18)*pol_z(:, 0, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(19)*pol_z(:, 0, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(20)*pol_z(:, 0, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(21)*pol_z(:, 0, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(22)*pol_z(:, 0, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(23)*pol_z(:, 0, kg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_xyz(24)*pol_z(:, 0, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(25)*pol_z(:, 0, kg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_xyz(26)*pol_z(:, 0, kg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_xyz(27)*pol_z(:, 0, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(28)*pol_z(:, 0, kg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_xyz(29)*pol_z(:, 0, kg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_xyz(30)*pol_z(:, 0, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(31)*pol_z(:, 0, kg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_xyz(32)*pol_z(:, 0, kg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_xyz(33)*pol_z(:, 0, kg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_xyz(34)*pol_z(:, 0, kg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_xyz(35)*pol_z(:, 0, kg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_xyz(36)*pol_z(:, 0, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(37)*pol_z(:, 1, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(38)*pol_z(:, 1, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(39)*pol_z(:, 1, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(40)*pol_z(:, 1, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(41)*pol_z(:, 1, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(42)*pol_z(:, 1, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(43)*pol_z(:, 1, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(44)*pol_z(:, 1, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(45)*pol_z(:, 1, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(46)*pol_z(:, 1, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(47)*pol_z(:, 1, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(48)*pol_z(:, 1, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(49)*pol_z(:, 1, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(50)*pol_z(:, 1, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(51)*pol_z(:, 1, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(52)*pol_z(:, 1, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(53)*pol_z(:, 1, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(54)*pol_z(:, 1, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(55)*pol_z(:, 1, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(56)*pol_z(:, 1, kg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_xyz(57)*pol_z(:, 1, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(58)*pol_z(:, 1, kg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_xyz(59)*pol_z(:, 1, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(60)*pol_z(:, 1, kg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_xyz(61)*pol_z(:, 1, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(62)*pol_z(:, 1, kg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_xyz(63)*pol_z(:, 1, kg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_xyz(64)*pol_z(:, 1, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(65)*pol_z(:, 2, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(66)*pol_z(:, 2, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(67)*pol_z(:, 2, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(68)*pol_z(:, 2, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(69)*pol_z(:, 2, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(70)*pol_z(:, 2, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(71)*pol_z(:, 2, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(72)*pol_z(:, 2, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(73)*pol_z(:, 2, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(74)*pol_z(:, 2, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(75)*pol_z(:, 2, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(76)*pol_z(:, 2, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(77)*pol_z(:, 2, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(78)*pol_z(:, 2, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(79)*pol_z(:, 2, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(80)*pol_z(:, 2, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(81)*pol_z(:, 2, kg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_xyz(82)*pol_z(:, 2, kg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_xyz(83)*pol_z(:, 2, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(84)*pol_z(:, 2, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(85)*pol_z(:, 2, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(86)*pol_z(:, 3, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(87)*pol_z(:, 3, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(88)*pol_z(:, 3, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(89)*pol_z(:, 3, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(90)*pol_z(:, 3, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(91)*pol_z(:, 3, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(92)*pol_z(:, 3, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(93)*pol_z(:, 3, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(94)*pol_z(:, 3, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(95)*pol_z(:, 3, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(96)*pol_z(:, 3, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(97)*pol_z(:, 3, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(98)*pol_z(:, 3, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(99)*pol_z(:, 3, kg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_xyz(100)*pol_z(:, 3, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(101)*pol_z(:, 4, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(102)*pol_z(:, 4, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(103)*pol_z(:, 4, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(104)*pol_z(:, 4, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(105)*pol_z(:, 4, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(106)*pol_z(:, 4, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(107)*pol_z(:, 4, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(108)*pol_z(:, 4, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(109)*pol_z(:, 4, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(110)*pol_z(:, 4, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(111)*pol_z(:, 5, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(112)*pol_z(:, 5, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(113)*pol_z(:, 5, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(114)*pol_z(:, 5, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(115)*pol_z(:, 5, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(116)*pol_z(:, 5, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(117)*pol_z(:, 6, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(118)*pol_z(:, 6, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(119)*pol_z(:, 6, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(120)*pol_z(:, 7, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(1)*pol_z(:, 0, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(2)*pol_z(:, 0, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(3)*pol_z(:, 0, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(4)*pol_z(:, 0, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(5)*pol_z(:, 0, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(6)*pol_z(:, 0, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(7)*pol_z(:, 0, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(8)*pol_z(:, 0, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(9)*pol_z(:, 0, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(10)*pol_z(:, 0, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(11)*pol_z(:, 0, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(12)*pol_z(:, 0, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(13)*pol_z(:, 0, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(14)*pol_z(:, 0, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(15)*pol_z(:, 0, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(16)*pol_z(:, 0, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(17)*pol_z(:, 0, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(18)*pol_z(:, 0, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(19)*pol_z(:, 0, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(20)*pol_z(:, 0, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(21)*pol_z(:, 0, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(22)*pol_z(:, 0, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(23)*pol_z(:, 0, kg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_xyz(24)*pol_z(:, 0, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(25)*pol_z(:, 0, kg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_xyz(26)*pol_z(:, 0, kg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_xyz(27)*pol_z(:, 0, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(28)*pol_z(:, 0, kg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_xyz(29)*pol_z(:, 0, kg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_xyz(30)*pol_z(:, 0, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(31)*pol_z(:, 0, kg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_xyz(32)*pol_z(:, 0, kg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_xyz(33)*pol_z(:, 0, kg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_xyz(34)*pol_z(:, 0, kg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_xyz(35)*pol_z(:, 0, kg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_xyz(36)*pol_z(:, 0, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(37)*pol_z(:, 1, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(38)*pol_z(:, 1, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(39)*pol_z(:, 1, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(40)*pol_z(:, 1, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(41)*pol_z(:, 1, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(42)*pol_z(:, 1, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(43)*pol_z(:, 1, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(44)*pol_z(:, 1, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(45)*pol_z(:, 1, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(46)*pol_z(:, 1, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(47)*pol_z(:, 1, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(48)*pol_z(:, 1, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(49)*pol_z(:, 1, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(50)*pol_z(:, 1, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(51)*pol_z(:, 1, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(52)*pol_z(:, 1, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(53)*pol_z(:, 1, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(54)*pol_z(:, 1, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(55)*pol_z(:, 1, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(56)*pol_z(:, 1, kg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_xyz(57)*pol_z(:, 1, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(58)*pol_z(:, 1, kg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_xyz(59)*pol_z(:, 1, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(60)*pol_z(:, 1, kg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_xyz(61)*pol_z(:, 1, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(62)*pol_z(:, 1, kg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_xyz(63)*pol_z(:, 1, kg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_xyz(64)*pol_z(:, 1, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(65)*pol_z(:, 2, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(66)*pol_z(:, 2, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(67)*pol_z(:, 2, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(68)*pol_z(:, 2, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(69)*pol_z(:, 2, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(70)*pol_z(:, 2, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(71)*pol_z(:, 2, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(72)*pol_z(:, 2, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(73)*pol_z(:, 2, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(74)*pol_z(:, 2, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(75)*pol_z(:, 2, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(76)*pol_z(:, 2, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(77)*pol_z(:, 2, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(78)*pol_z(:, 2, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(79)*pol_z(:, 2, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(80)*pol_z(:, 2, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(81)*pol_z(:, 2, kg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_xyz(82)*pol_z(:, 2, kg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_xyz(83)*pol_z(:, 2, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(84)*pol_z(:, 2, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(85)*pol_z(:, 2, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(86)*pol_z(:, 3, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(87)*pol_z(:, 3, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(88)*pol_z(:, 3, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(89)*pol_z(:, 3, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(90)*pol_z(:, 3, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(91)*pol_z(:, 3, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(92)*pol_z(:, 3, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(93)*pol_z(:, 3, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(94)*pol_z(:, 3, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(95)*pol_z(:, 3, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(96)*pol_z(:, 3, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(97)*pol_z(:, 3, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(98)*pol_z(:, 3, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(99)*pol_z(:, 3, kg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_xyz(100)*pol_z(:, 3, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(101)*pol_z(:, 4, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(102)*pol_z(:, 4, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(103)*pol_z(:, 4, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(104)*pol_z(:, 4, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(105)*pol_z(:, 4, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(106)*pol_z(:, 4, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(107)*pol_z(:, 4, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(108)*pol_z(:, 4, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(109)*pol_z(:, 4, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(110)*pol_z(:, 4, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(111)*pol_z(:, 5, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(112)*pol_z(:, 5, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(113)*pol_z(:, 5, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(114)*pol_z(:, 5, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(115)*pol_z(:, 5, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(116)*pol_z(:, 5, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(117)*pol_z(:, 6, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(118)*pol_z(:, 6, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(119)*pol_z(:, 6, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(120)*pol_z(:, 7, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 1)*pol_y(1, 0, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 1)*pol_y(2, 0, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 2)*pol_y(1, 0, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 2)*pol_y(2, 0, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 3)*pol_y(1, 0, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 3)*pol_y(2, 0, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 4)*pol_y(1, 0, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 4)*pol_y(2, 0, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 5)*pol_y(1, 0, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 5)*pol_y(2, 0, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 6)*pol_y(1, 0, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 6)*pol_y(2, 0, jg) - coef_x(1:2, 6) = coef_x(1:2, 6)+coef_xy(1:2, 7)*pol_y(1, 0, jg) - coef_x(3:4, 6) = coef_x(3:4, 6)+coef_xy(1:2, 7)*pol_y(2, 0, jg) - coef_x(1:2, 7) = coef_x(1:2, 7)+coef_xy(1:2, 8)*pol_y(1, 0, jg) - coef_x(3:4, 7) = coef_x(3:4, 7)+coef_xy(1:2, 8)*pol_y(2, 0, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 9)*pol_y(1, 1, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 9)*pol_y(2, 1, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 10)*pol_y(1, 1, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 10)*pol_y(2, 1, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 11)*pol_y(1, 1, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 11)*pol_y(2, 1, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 12)*pol_y(1, 1, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 12)*pol_y(2, 1, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 13)*pol_y(1, 1, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 13)*pol_y(2, 1, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 14)*pol_y(1, 1, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 14)*pol_y(2, 1, jg) - coef_x(1:2, 6) = coef_x(1:2, 6)+coef_xy(1:2, 15)*pol_y(1, 1, jg) - coef_x(3:4, 6) = coef_x(3:4, 6)+coef_xy(1:2, 15)*pol_y(2, 1, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 16)*pol_y(1, 2, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 16)*pol_y(2, 2, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 17)*pol_y(1, 2, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 17)*pol_y(2, 2, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 18)*pol_y(1, 2, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 18)*pol_y(2, 2, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 19)*pol_y(1, 2, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 19)*pol_y(2, 2, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 20)*pol_y(1, 2, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 20)*pol_y(2, 2, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 21)*pol_y(1, 2, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 21)*pol_y(2, 2, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 22)*pol_y(1, 3, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 22)*pol_y(2, 3, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 23)*pol_y(1, 3, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 23)*pol_y(2, 3, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 24)*pol_y(1, 3, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 24)*pol_y(2, 3, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 25)*pol_y(1, 3, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 25)*pol_y(2, 3, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 26)*pol_y(1, 3, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 26)*pol_y(2, 3, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 27)*pol_y(1, 4, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 27)*pol_y(2, 4, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 28)*pol_y(1, 4, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 28)*pol_y(2, 4, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 29)*pol_y(1, 4, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 29)*pol_y(2, 4, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 30)*pol_y(1, 4, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 30)*pol_y(2, 4, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 31)*pol_y(1, 5, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 31)*pol_y(2, 5, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 32)*pol_y(1, 5, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 32)*pol_y(2, 5, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 33)*pol_y(1, 5, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 33)*pol_y(2, 5, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 34)*pol_y(1, 6, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 34)*pol_y(2, 6, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 35)*pol_y(1, 6, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 35)*pol_y(2, 6, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 36)*pol_y(1, 7, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 36)*pol_y(2, 7, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 1)*pol_y(1, 0, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 1)*pol_y(2, 0, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 2)*pol_y(1, 0, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 2)*pol_y(2, 0, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 3)*pol_y(1, 0, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 3)*pol_y(2, 0, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 4)*pol_y(1, 0, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 4)*pol_y(2, 0, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 5)*pol_y(1, 0, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 5)*pol_y(2, 0, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 6)*pol_y(1, 0, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 6)*pol_y(2, 0, jg) + coef_x(1:2, 6) = coef_x(1:2, 6) + coef_xy(1:2, 7)*pol_y(1, 0, jg) + coef_x(3:4, 6) = coef_x(3:4, 6) + coef_xy(1:2, 7)*pol_y(2, 0, jg) + coef_x(1:2, 7) = coef_x(1:2, 7) + coef_xy(1:2, 8)*pol_y(1, 0, jg) + coef_x(3:4, 7) = coef_x(3:4, 7) + coef_xy(1:2, 8)*pol_y(2, 0, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 9)*pol_y(1, 1, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 9)*pol_y(2, 1, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 10)*pol_y(1, 1, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 10)*pol_y(2, 1, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 11)*pol_y(1, 1, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 11)*pol_y(2, 1, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 12)*pol_y(1, 1, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 12)*pol_y(2, 1, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 13)*pol_y(1, 1, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 13)*pol_y(2, 1, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 14)*pol_y(1, 1, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 14)*pol_y(2, 1, jg) + coef_x(1:2, 6) = coef_x(1:2, 6) + coef_xy(1:2, 15)*pol_y(1, 1, jg) + coef_x(3:4, 6) = coef_x(3:4, 6) + coef_xy(1:2, 15)*pol_y(2, 1, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 16)*pol_y(1, 2, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 16)*pol_y(2, 2, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 17)*pol_y(1, 2, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 17)*pol_y(2, 2, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 18)*pol_y(1, 2, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 18)*pol_y(2, 2, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 19)*pol_y(1, 2, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 19)*pol_y(2, 2, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 20)*pol_y(1, 2, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 20)*pol_y(2, 2, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 21)*pol_y(1, 2, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 21)*pol_y(2, 2, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 22)*pol_y(1, 3, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 22)*pol_y(2, 3, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 23)*pol_y(1, 3, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 23)*pol_y(2, 3, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 24)*pol_y(1, 3, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 24)*pol_y(2, 3, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 25)*pol_y(1, 3, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 25)*pol_y(2, 3, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 26)*pol_y(1, 3, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 26)*pol_y(2, 3, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 27)*pol_y(1, 4, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 27)*pol_y(2, 4, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 28)*pol_y(1, 4, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 28)*pol_y(2, 4, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 29)*pol_y(1, 4, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 29)*pol_y(2, 4, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 30)*pol_y(1, 4, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 30)*pol_y(2, 4, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 31)*pol_y(1, 5, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 31)*pol_y(2, 5, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 32)*pol_y(1, 5, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 32)*pol_y(2, 5, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 33)*pol_y(1, 5, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 33)*pol_y(2, 5, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 34)*pol_y(1, 6, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 34)*pol_y(2, 6, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 35)*pol_y(1, 6, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 35)*pol_y(2, 6, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 36)*pol_y(1, 7, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 36)*pol_y(2, 7, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - s01 = s01+coef_x(1, 4)*pol_x(4, ig) - s02 = s02+coef_x(2, 4)*pol_x(4, ig) - s03 = s03+coef_x(3, 4)*pol_x(4, ig) - s04 = s04+coef_x(4, 4)*pol_x(4, ig) - s01 = s01+coef_x(1, 5)*pol_x(5, ig) - s02 = s02+coef_x(2, 5)*pol_x(5, ig) - s03 = s03+coef_x(3, 5)*pol_x(5, ig) - s04 = s04+coef_x(4, 5)*pol_x(5, ig) - s01 = s01+coef_x(1, 6)*pol_x(6, ig) - s02 = s02+coef_x(2, 6)*pol_x(6, ig) - s03 = s03+coef_x(3, 6)*pol_x(6, ig) - s04 = s04+coef_x(4, 6)*pol_x(6, ig) - s01 = s01+coef_x(1, 7)*pol_x(7, ig) - s02 = s02+coef_x(2, 7)*pol_x(7, ig) - s03 = s03+coef_x(3, 7)*pol_x(7, ig) - s04 = s04+coef_x(4, 7)*pol_x(7, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + s01 = s01 + coef_x(1, 4)*pol_x(4, ig) + s02 = s02 + coef_x(2, 4)*pol_x(4, ig) + s03 = s03 + coef_x(3, 4)*pol_x(4, ig) + s04 = s04 + coef_x(4, 4)*pol_x(4, ig) + s01 = s01 + coef_x(1, 5)*pol_x(5, ig) + s02 = s02 + coef_x(2, 5)*pol_x(5, ig) + s03 = s03 + coef_x(3, 5)*pol_x(5, ig) + s04 = s04 + coef_x(4, 5)*pol_x(5, ig) + s01 = s01 + coef_x(1, 6)*pol_x(6, ig) + s02 = s02 + coef_x(2, 6)*pol_x(6, ig) + s03 = s03 + coef_x(3, 6)*pol_x(6, ig) + s04 = s04 + coef_x(4, 6)*pol_x(6, ig) + s01 = s01 + coef_x(1, 7)*pol_x(7, ig) + s02 = s02 + coef_x(2, 7)*pol_x(7, ig) + s03 = s03 + coef_x(3, 7)*pol_x(7, ig) + s04 = s04 + coef_x(4, 7)*pol_x(7, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -1368,335 +1368,335 @@ SUBROUTINE collocate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 8 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(1)*pol_z(:, 0, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(2)*pol_z(:, 0, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(3)*pol_z(:, 0, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(4)*pol_z(:, 0, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(5)*pol_z(:, 0, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(6)*pol_z(:, 0, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(7)*pol_z(:, 0, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(8)*pol_z(:, 0, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(9)*pol_z(:, 0, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(10)*pol_z(:, 0, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(11)*pol_z(:, 0, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(12)*pol_z(:, 0, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(13)*pol_z(:, 0, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(14)*pol_z(:, 0, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(15)*pol_z(:, 0, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(16)*pol_z(:, 0, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(17)*pol_z(:, 0, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(18)*pol_z(:, 0, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(19)*pol_z(:, 0, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(20)*pol_z(:, 0, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(21)*pol_z(:, 0, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(22)*pol_z(:, 0, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(23)*pol_z(:, 0, kg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_xyz(24)*pol_z(:, 0, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(25)*pol_z(:, 0, kg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_xyz(26)*pol_z(:, 0, kg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_xyz(27)*pol_z(:, 0, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(28)*pol_z(:, 0, kg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_xyz(29)*pol_z(:, 0, kg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_xyz(30)*pol_z(:, 0, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(31)*pol_z(:, 0, kg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_xyz(32)*pol_z(:, 0, kg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_xyz(33)*pol_z(:, 0, kg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_xyz(34)*pol_z(:, 0, kg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_xyz(35)*pol_z(:, 0, kg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_xyz(36)*pol_z(:, 0, kg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_xyz(37)*pol_z(:, 0, kg) - coef_xy(:, 38) = coef_xy(:, 38)+coef_xyz(38)*pol_z(:, 0, kg) - coef_xy(:, 39) = coef_xy(:, 39)+coef_xyz(39)*pol_z(:, 0, kg) - coef_xy(:, 40) = coef_xy(:, 40)+coef_xyz(40)*pol_z(:, 0, kg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_xyz(41)*pol_z(:, 0, kg) - coef_xy(:, 42) = coef_xy(:, 42)+coef_xyz(42)*pol_z(:, 0, kg) - coef_xy(:, 43) = coef_xy(:, 43)+coef_xyz(43)*pol_z(:, 0, kg) - coef_xy(:, 44) = coef_xy(:, 44)+coef_xyz(44)*pol_z(:, 0, kg) - coef_xy(:, 45) = coef_xy(:, 45)+coef_xyz(45)*pol_z(:, 0, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(46)*pol_z(:, 1, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(47)*pol_z(:, 1, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(48)*pol_z(:, 1, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(49)*pol_z(:, 1, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(50)*pol_z(:, 1, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(51)*pol_z(:, 1, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(52)*pol_z(:, 1, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(53)*pol_z(:, 1, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(54)*pol_z(:, 1, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(55)*pol_z(:, 1, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(56)*pol_z(:, 1, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(57)*pol_z(:, 1, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(58)*pol_z(:, 1, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(59)*pol_z(:, 1, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(60)*pol_z(:, 1, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(61)*pol_z(:, 1, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(62)*pol_z(:, 1, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(63)*pol_z(:, 1, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(64)*pol_z(:, 1, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(65)*pol_z(:, 1, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(66)*pol_z(:, 1, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(67)*pol_z(:, 1, kg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_xyz(68)*pol_z(:, 1, kg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_xyz(69)*pol_z(:, 1, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(70)*pol_z(:, 1, kg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_xyz(71)*pol_z(:, 1, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(72)*pol_z(:, 1, kg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_xyz(73)*pol_z(:, 1, kg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_xyz(74)*pol_z(:, 1, kg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_xyz(75)*pol_z(:, 1, kg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_xyz(76)*pol_z(:, 1, kg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_xyz(77)*pol_z(:, 1, kg) - coef_xy(:, 38) = coef_xy(:, 38)+coef_xyz(78)*pol_z(:, 1, kg) - coef_xy(:, 40) = coef_xy(:, 40)+coef_xyz(79)*pol_z(:, 1, kg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_xyz(80)*pol_z(:, 1, kg) - coef_xy(:, 43) = coef_xy(:, 43)+coef_xyz(81)*pol_z(:, 1, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(82)*pol_z(:, 2, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(83)*pol_z(:, 2, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(84)*pol_z(:, 2, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(85)*pol_z(:, 2, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(86)*pol_z(:, 2, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(87)*pol_z(:, 2, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(88)*pol_z(:, 2, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(89)*pol_z(:, 2, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(90)*pol_z(:, 2, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(91)*pol_z(:, 2, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(92)*pol_z(:, 2, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(93)*pol_z(:, 2, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(94)*pol_z(:, 2, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(95)*pol_z(:, 2, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(96)*pol_z(:, 2, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(97)*pol_z(:, 2, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(98)*pol_z(:, 2, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(99)*pol_z(:, 2, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(100)*pol_z(:, 2, kg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_xyz(101)*pol_z(:, 2, kg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_xyz(102)*pol_z(:, 2, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(103)*pol_z(:, 2, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(104)*pol_z(:, 2, kg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_xyz(105)*pol_z(:, 2, kg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_xyz(106)*pol_z(:, 2, kg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_xyz(107)*pol_z(:, 2, kg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_xyz(108)*pol_z(:, 2, kg) - coef_xy(:, 40) = coef_xy(:, 40)+coef_xyz(109)*pol_z(:, 2, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(110)*pol_z(:, 3, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(111)*pol_z(:, 3, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(112)*pol_z(:, 3, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(113)*pol_z(:, 3, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(114)*pol_z(:, 3, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(115)*pol_z(:, 3, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(116)*pol_z(:, 3, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(117)*pol_z(:, 3, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(118)*pol_z(:, 3, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(119)*pol_z(:, 3, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(120)*pol_z(:, 3, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(121)*pol_z(:, 3, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(122)*pol_z(:, 3, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(123)*pol_z(:, 3, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(124)*pol_z(:, 3, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(125)*pol_z(:, 3, kg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_xyz(126)*pol_z(:, 3, kg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_xyz(127)*pol_z(:, 3, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(128)*pol_z(:, 3, kg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_xyz(129)*pol_z(:, 3, kg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_xyz(130)*pol_z(:, 3, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(131)*pol_z(:, 4, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(132)*pol_z(:, 4, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(133)*pol_z(:, 4, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(134)*pol_z(:, 4, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(135)*pol_z(:, 4, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(136)*pol_z(:, 4, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(137)*pol_z(:, 4, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(138)*pol_z(:, 4, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(139)*pol_z(:, 4, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(140)*pol_z(:, 4, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(141)*pol_z(:, 4, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(142)*pol_z(:, 4, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(143)*pol_z(:, 4, kg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_xyz(144)*pol_z(:, 4, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(145)*pol_z(:, 4, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(146)*pol_z(:, 5, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(147)*pol_z(:, 5, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(148)*pol_z(:, 5, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(149)*pol_z(:, 5, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(150)*pol_z(:, 5, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(151)*pol_z(:, 5, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(152)*pol_z(:, 5, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(153)*pol_z(:, 5, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(154)*pol_z(:, 5, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(155)*pol_z(:, 5, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(156)*pol_z(:, 6, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(157)*pol_z(:, 6, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(158)*pol_z(:, 6, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(159)*pol_z(:, 6, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(160)*pol_z(:, 6, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(161)*pol_z(:, 6, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(162)*pol_z(:, 7, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(163)*pol_z(:, 7, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(164)*pol_z(:, 7, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(165)*pol_z(:, 8, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(1)*pol_z(:, 0, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(2)*pol_z(:, 0, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(3)*pol_z(:, 0, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(4)*pol_z(:, 0, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(5)*pol_z(:, 0, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(6)*pol_z(:, 0, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(7)*pol_z(:, 0, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(8)*pol_z(:, 0, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(9)*pol_z(:, 0, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(10)*pol_z(:, 0, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(11)*pol_z(:, 0, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(12)*pol_z(:, 0, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(13)*pol_z(:, 0, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(14)*pol_z(:, 0, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(15)*pol_z(:, 0, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(16)*pol_z(:, 0, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(17)*pol_z(:, 0, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(18)*pol_z(:, 0, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(19)*pol_z(:, 0, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(20)*pol_z(:, 0, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(21)*pol_z(:, 0, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(22)*pol_z(:, 0, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(23)*pol_z(:, 0, kg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_xyz(24)*pol_z(:, 0, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(25)*pol_z(:, 0, kg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_xyz(26)*pol_z(:, 0, kg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_xyz(27)*pol_z(:, 0, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(28)*pol_z(:, 0, kg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_xyz(29)*pol_z(:, 0, kg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_xyz(30)*pol_z(:, 0, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(31)*pol_z(:, 0, kg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_xyz(32)*pol_z(:, 0, kg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_xyz(33)*pol_z(:, 0, kg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_xyz(34)*pol_z(:, 0, kg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_xyz(35)*pol_z(:, 0, kg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_xyz(36)*pol_z(:, 0, kg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_xyz(37)*pol_z(:, 0, kg) + coef_xy(:, 38) = coef_xy(:, 38) + coef_xyz(38)*pol_z(:, 0, kg) + coef_xy(:, 39) = coef_xy(:, 39) + coef_xyz(39)*pol_z(:, 0, kg) + coef_xy(:, 40) = coef_xy(:, 40) + coef_xyz(40)*pol_z(:, 0, kg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_xyz(41)*pol_z(:, 0, kg) + coef_xy(:, 42) = coef_xy(:, 42) + coef_xyz(42)*pol_z(:, 0, kg) + coef_xy(:, 43) = coef_xy(:, 43) + coef_xyz(43)*pol_z(:, 0, kg) + coef_xy(:, 44) = coef_xy(:, 44) + coef_xyz(44)*pol_z(:, 0, kg) + coef_xy(:, 45) = coef_xy(:, 45) + coef_xyz(45)*pol_z(:, 0, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(46)*pol_z(:, 1, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(47)*pol_z(:, 1, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(48)*pol_z(:, 1, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(49)*pol_z(:, 1, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(50)*pol_z(:, 1, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(51)*pol_z(:, 1, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(52)*pol_z(:, 1, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(53)*pol_z(:, 1, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(54)*pol_z(:, 1, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(55)*pol_z(:, 1, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(56)*pol_z(:, 1, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(57)*pol_z(:, 1, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(58)*pol_z(:, 1, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(59)*pol_z(:, 1, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(60)*pol_z(:, 1, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(61)*pol_z(:, 1, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(62)*pol_z(:, 1, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(63)*pol_z(:, 1, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(64)*pol_z(:, 1, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(65)*pol_z(:, 1, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(66)*pol_z(:, 1, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(67)*pol_z(:, 1, kg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_xyz(68)*pol_z(:, 1, kg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_xyz(69)*pol_z(:, 1, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(70)*pol_z(:, 1, kg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_xyz(71)*pol_z(:, 1, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(72)*pol_z(:, 1, kg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_xyz(73)*pol_z(:, 1, kg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_xyz(74)*pol_z(:, 1, kg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_xyz(75)*pol_z(:, 1, kg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_xyz(76)*pol_z(:, 1, kg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_xyz(77)*pol_z(:, 1, kg) + coef_xy(:, 38) = coef_xy(:, 38) + coef_xyz(78)*pol_z(:, 1, kg) + coef_xy(:, 40) = coef_xy(:, 40) + coef_xyz(79)*pol_z(:, 1, kg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_xyz(80)*pol_z(:, 1, kg) + coef_xy(:, 43) = coef_xy(:, 43) + coef_xyz(81)*pol_z(:, 1, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(82)*pol_z(:, 2, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(83)*pol_z(:, 2, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(84)*pol_z(:, 2, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(85)*pol_z(:, 2, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(86)*pol_z(:, 2, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(87)*pol_z(:, 2, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(88)*pol_z(:, 2, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(89)*pol_z(:, 2, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(90)*pol_z(:, 2, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(91)*pol_z(:, 2, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(92)*pol_z(:, 2, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(93)*pol_z(:, 2, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(94)*pol_z(:, 2, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(95)*pol_z(:, 2, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(96)*pol_z(:, 2, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(97)*pol_z(:, 2, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(98)*pol_z(:, 2, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(99)*pol_z(:, 2, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(100)*pol_z(:, 2, kg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_xyz(101)*pol_z(:, 2, kg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_xyz(102)*pol_z(:, 2, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(103)*pol_z(:, 2, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(104)*pol_z(:, 2, kg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_xyz(105)*pol_z(:, 2, kg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_xyz(106)*pol_z(:, 2, kg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_xyz(107)*pol_z(:, 2, kg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_xyz(108)*pol_z(:, 2, kg) + coef_xy(:, 40) = coef_xy(:, 40) + coef_xyz(109)*pol_z(:, 2, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(110)*pol_z(:, 3, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(111)*pol_z(:, 3, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(112)*pol_z(:, 3, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(113)*pol_z(:, 3, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(114)*pol_z(:, 3, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(115)*pol_z(:, 3, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(116)*pol_z(:, 3, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(117)*pol_z(:, 3, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(118)*pol_z(:, 3, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(119)*pol_z(:, 3, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(120)*pol_z(:, 3, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(121)*pol_z(:, 3, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(122)*pol_z(:, 3, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(123)*pol_z(:, 3, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(124)*pol_z(:, 3, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(125)*pol_z(:, 3, kg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_xyz(126)*pol_z(:, 3, kg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_xyz(127)*pol_z(:, 3, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(128)*pol_z(:, 3, kg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_xyz(129)*pol_z(:, 3, kg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_xyz(130)*pol_z(:, 3, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(131)*pol_z(:, 4, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(132)*pol_z(:, 4, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(133)*pol_z(:, 4, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(134)*pol_z(:, 4, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(135)*pol_z(:, 4, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(136)*pol_z(:, 4, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(137)*pol_z(:, 4, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(138)*pol_z(:, 4, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(139)*pol_z(:, 4, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(140)*pol_z(:, 4, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(141)*pol_z(:, 4, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(142)*pol_z(:, 4, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(143)*pol_z(:, 4, kg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_xyz(144)*pol_z(:, 4, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(145)*pol_z(:, 4, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(146)*pol_z(:, 5, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(147)*pol_z(:, 5, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(148)*pol_z(:, 5, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(149)*pol_z(:, 5, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(150)*pol_z(:, 5, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(151)*pol_z(:, 5, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(152)*pol_z(:, 5, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(153)*pol_z(:, 5, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(154)*pol_z(:, 5, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(155)*pol_z(:, 5, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(156)*pol_z(:, 6, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(157)*pol_z(:, 6, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(158)*pol_z(:, 6, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(159)*pol_z(:, 6, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(160)*pol_z(:, 6, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(161)*pol_z(:, 6, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(162)*pol_z(:, 7, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(163)*pol_z(:, 7, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(164)*pol_z(:, 7, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(165)*pol_z(:, 8, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 1)*pol_y(1, 0, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 1)*pol_y(2, 0, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 2)*pol_y(1, 0, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 2)*pol_y(2, 0, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 3)*pol_y(1, 0, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 3)*pol_y(2, 0, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 4)*pol_y(1, 0, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 4)*pol_y(2, 0, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 5)*pol_y(1, 0, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 5)*pol_y(2, 0, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 6)*pol_y(1, 0, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 6)*pol_y(2, 0, jg) - coef_x(1:2, 6) = coef_x(1:2, 6)+coef_xy(1:2, 7)*pol_y(1, 0, jg) - coef_x(3:4, 6) = coef_x(3:4, 6)+coef_xy(1:2, 7)*pol_y(2, 0, jg) - coef_x(1:2, 7) = coef_x(1:2, 7)+coef_xy(1:2, 8)*pol_y(1, 0, jg) - coef_x(3:4, 7) = coef_x(3:4, 7)+coef_xy(1:2, 8)*pol_y(2, 0, jg) - coef_x(1:2, 8) = coef_x(1:2, 8)+coef_xy(1:2, 9)*pol_y(1, 0, jg) - coef_x(3:4, 8) = coef_x(3:4, 8)+coef_xy(1:2, 9)*pol_y(2, 0, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 10)*pol_y(1, 1, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 10)*pol_y(2, 1, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 11)*pol_y(1, 1, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 11)*pol_y(2, 1, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 12)*pol_y(1, 1, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 12)*pol_y(2, 1, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 13)*pol_y(1, 1, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 13)*pol_y(2, 1, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 14)*pol_y(1, 1, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 14)*pol_y(2, 1, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 15)*pol_y(1, 1, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 15)*pol_y(2, 1, jg) - coef_x(1:2, 6) = coef_x(1:2, 6)+coef_xy(1:2, 16)*pol_y(1, 1, jg) - coef_x(3:4, 6) = coef_x(3:4, 6)+coef_xy(1:2, 16)*pol_y(2, 1, jg) - coef_x(1:2, 7) = coef_x(1:2, 7)+coef_xy(1:2, 17)*pol_y(1, 1, jg) - coef_x(3:4, 7) = coef_x(3:4, 7)+coef_xy(1:2, 17)*pol_y(2, 1, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 18)*pol_y(1, 2, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 18)*pol_y(2, 2, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 19)*pol_y(1, 2, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 19)*pol_y(2, 2, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 20)*pol_y(1, 2, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 20)*pol_y(2, 2, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 21)*pol_y(1, 2, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 21)*pol_y(2, 2, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 22)*pol_y(1, 2, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 22)*pol_y(2, 2, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 23)*pol_y(1, 2, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 23)*pol_y(2, 2, jg) - coef_x(1:2, 6) = coef_x(1:2, 6)+coef_xy(1:2, 24)*pol_y(1, 2, jg) - coef_x(3:4, 6) = coef_x(3:4, 6)+coef_xy(1:2, 24)*pol_y(2, 2, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 25)*pol_y(1, 3, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 25)*pol_y(2, 3, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 26)*pol_y(1, 3, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 26)*pol_y(2, 3, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 27)*pol_y(1, 3, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 27)*pol_y(2, 3, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 28)*pol_y(1, 3, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 28)*pol_y(2, 3, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 29)*pol_y(1, 3, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 29)*pol_y(2, 3, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 30)*pol_y(1, 3, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 30)*pol_y(2, 3, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 31)*pol_y(1, 4, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 31)*pol_y(2, 4, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 32)*pol_y(1, 4, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 32)*pol_y(2, 4, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 33)*pol_y(1, 4, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 33)*pol_y(2, 4, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 34)*pol_y(1, 4, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 34)*pol_y(2, 4, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 35)*pol_y(1, 4, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 35)*pol_y(2, 4, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 36)*pol_y(1, 5, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 36)*pol_y(2, 5, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 37)*pol_y(1, 5, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 37)*pol_y(2, 5, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 38)*pol_y(1, 5, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 38)*pol_y(2, 5, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 39)*pol_y(1, 5, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 39)*pol_y(2, 5, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 40)*pol_y(1, 6, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 40)*pol_y(2, 6, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 41)*pol_y(1, 6, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 41)*pol_y(2, 6, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 42)*pol_y(1, 6, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 42)*pol_y(2, 6, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 43)*pol_y(1, 7, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 43)*pol_y(2, 7, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 44)*pol_y(1, 7, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 44)*pol_y(2, 7, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 45)*pol_y(1, 8, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 45)*pol_y(2, 8, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 1)*pol_y(1, 0, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 1)*pol_y(2, 0, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 2)*pol_y(1, 0, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 2)*pol_y(2, 0, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 3)*pol_y(1, 0, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 3)*pol_y(2, 0, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 4)*pol_y(1, 0, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 4)*pol_y(2, 0, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 5)*pol_y(1, 0, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 5)*pol_y(2, 0, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 6)*pol_y(1, 0, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 6)*pol_y(2, 0, jg) + coef_x(1:2, 6) = coef_x(1:2, 6) + coef_xy(1:2, 7)*pol_y(1, 0, jg) + coef_x(3:4, 6) = coef_x(3:4, 6) + coef_xy(1:2, 7)*pol_y(2, 0, jg) + coef_x(1:2, 7) = coef_x(1:2, 7) + coef_xy(1:2, 8)*pol_y(1, 0, jg) + coef_x(3:4, 7) = coef_x(3:4, 7) + coef_xy(1:2, 8)*pol_y(2, 0, jg) + coef_x(1:2, 8) = coef_x(1:2, 8) + coef_xy(1:2, 9)*pol_y(1, 0, jg) + coef_x(3:4, 8) = coef_x(3:4, 8) + coef_xy(1:2, 9)*pol_y(2, 0, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 10)*pol_y(1, 1, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 10)*pol_y(2, 1, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 11)*pol_y(1, 1, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 11)*pol_y(2, 1, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 12)*pol_y(1, 1, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 12)*pol_y(2, 1, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 13)*pol_y(1, 1, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 13)*pol_y(2, 1, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 14)*pol_y(1, 1, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 14)*pol_y(2, 1, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 15)*pol_y(1, 1, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 15)*pol_y(2, 1, jg) + coef_x(1:2, 6) = coef_x(1:2, 6) + coef_xy(1:2, 16)*pol_y(1, 1, jg) + coef_x(3:4, 6) = coef_x(3:4, 6) + coef_xy(1:2, 16)*pol_y(2, 1, jg) + coef_x(1:2, 7) = coef_x(1:2, 7) + coef_xy(1:2, 17)*pol_y(1, 1, jg) + coef_x(3:4, 7) = coef_x(3:4, 7) + coef_xy(1:2, 17)*pol_y(2, 1, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 18)*pol_y(1, 2, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 18)*pol_y(2, 2, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 19)*pol_y(1, 2, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 19)*pol_y(2, 2, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 20)*pol_y(1, 2, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 20)*pol_y(2, 2, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 21)*pol_y(1, 2, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 21)*pol_y(2, 2, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 22)*pol_y(1, 2, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 22)*pol_y(2, 2, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 23)*pol_y(1, 2, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 23)*pol_y(2, 2, jg) + coef_x(1:2, 6) = coef_x(1:2, 6) + coef_xy(1:2, 24)*pol_y(1, 2, jg) + coef_x(3:4, 6) = coef_x(3:4, 6) + coef_xy(1:2, 24)*pol_y(2, 2, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 25)*pol_y(1, 3, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 25)*pol_y(2, 3, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 26)*pol_y(1, 3, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 26)*pol_y(2, 3, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 27)*pol_y(1, 3, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 27)*pol_y(2, 3, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 28)*pol_y(1, 3, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 28)*pol_y(2, 3, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 29)*pol_y(1, 3, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 29)*pol_y(2, 3, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 30)*pol_y(1, 3, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 30)*pol_y(2, 3, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 31)*pol_y(1, 4, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 31)*pol_y(2, 4, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 32)*pol_y(1, 4, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 32)*pol_y(2, 4, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 33)*pol_y(1, 4, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 33)*pol_y(2, 4, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 34)*pol_y(1, 4, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 34)*pol_y(2, 4, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 35)*pol_y(1, 4, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 35)*pol_y(2, 4, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 36)*pol_y(1, 5, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 36)*pol_y(2, 5, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 37)*pol_y(1, 5, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 37)*pol_y(2, 5, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 38)*pol_y(1, 5, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 38)*pol_y(2, 5, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 39)*pol_y(1, 5, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 39)*pol_y(2, 5, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 40)*pol_y(1, 6, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 40)*pol_y(2, 6, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 41)*pol_y(1, 6, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 41)*pol_y(2, 6, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 42)*pol_y(1, 6, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 42)*pol_y(2, 6, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 43)*pol_y(1, 7, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 43)*pol_y(2, 7, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 44)*pol_y(1, 7, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 44)*pol_y(2, 7, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 45)*pol_y(1, 8, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 45)*pol_y(2, 8, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - s01 = s01+coef_x(1, 4)*pol_x(4, ig) - s02 = s02+coef_x(2, 4)*pol_x(4, ig) - s03 = s03+coef_x(3, 4)*pol_x(4, ig) - s04 = s04+coef_x(4, 4)*pol_x(4, ig) - s01 = s01+coef_x(1, 5)*pol_x(5, ig) - s02 = s02+coef_x(2, 5)*pol_x(5, ig) - s03 = s03+coef_x(3, 5)*pol_x(5, ig) - s04 = s04+coef_x(4, 5)*pol_x(5, ig) - s01 = s01+coef_x(1, 6)*pol_x(6, ig) - s02 = s02+coef_x(2, 6)*pol_x(6, ig) - s03 = s03+coef_x(3, 6)*pol_x(6, ig) - s04 = s04+coef_x(4, 6)*pol_x(6, ig) - s01 = s01+coef_x(1, 7)*pol_x(7, ig) - s02 = s02+coef_x(2, 7)*pol_x(7, ig) - s03 = s03+coef_x(3, 7)*pol_x(7, ig) - s04 = s04+coef_x(4, 7)*pol_x(7, ig) - s01 = s01+coef_x(1, 8)*pol_x(8, ig) - s02 = s02+coef_x(2, 8)*pol_x(8, ig) - s03 = s03+coef_x(3, 8)*pol_x(8, ig) - s04 = s04+coef_x(4, 8)*pol_x(8, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + s01 = s01 + coef_x(1, 4)*pol_x(4, ig) + s02 = s02 + coef_x(2, 4)*pol_x(4, ig) + s03 = s03 + coef_x(3, 4)*pol_x(4, ig) + s04 = s04 + coef_x(4, 4)*pol_x(4, ig) + s01 = s01 + coef_x(1, 5)*pol_x(5, ig) + s02 = s02 + coef_x(2, 5)*pol_x(5, ig) + s03 = s03 + coef_x(3, 5)*pol_x(5, ig) + s04 = s04 + coef_x(4, 5)*pol_x(5, ig) + s01 = s01 + coef_x(1, 6)*pol_x(6, ig) + s02 = s02 + coef_x(2, 6)*pol_x(6, ig) + s03 = s03 + coef_x(3, 6)*pol_x(6, ig) + s04 = s04 + coef_x(4, 6)*pol_x(6, ig) + s01 = s01 + coef_x(1, 7)*pol_x(7, ig) + s02 = s02 + coef_x(2, 7)*pol_x(7, ig) + s03 = s03 + coef_x(3, 7)*pol_x(7, ig) + s04 = s04 + coef_x(4, 7)*pol_x(7, ig) + s01 = s01 + coef_x(1, 8)*pol_x(8, ig) + s02 = s02 + coef_x(2, 8)*pol_x(8, ig) + s03 = s03 + coef_x(3, 8)*pol_x(8, ig) + s04 = s04 + coef_x(4, 8)*pol_x(8, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -1723,414 +1723,414 @@ SUBROUTINE collocate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 9 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(1)*pol_z(:, 0, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(2)*pol_z(:, 0, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(3)*pol_z(:, 0, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(4)*pol_z(:, 0, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(5)*pol_z(:, 0, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(6)*pol_z(:, 0, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(7)*pol_z(:, 0, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(8)*pol_z(:, 0, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(9)*pol_z(:, 0, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(10)*pol_z(:, 0, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(11)*pol_z(:, 0, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(12)*pol_z(:, 0, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(13)*pol_z(:, 0, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(14)*pol_z(:, 0, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(15)*pol_z(:, 0, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(16)*pol_z(:, 0, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(17)*pol_z(:, 0, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(18)*pol_z(:, 0, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(19)*pol_z(:, 0, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(20)*pol_z(:, 0, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(21)*pol_z(:, 0, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(22)*pol_z(:, 0, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(23)*pol_z(:, 0, kg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_xyz(24)*pol_z(:, 0, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(25)*pol_z(:, 0, kg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_xyz(26)*pol_z(:, 0, kg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_xyz(27)*pol_z(:, 0, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(28)*pol_z(:, 0, kg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_xyz(29)*pol_z(:, 0, kg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_xyz(30)*pol_z(:, 0, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(31)*pol_z(:, 0, kg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_xyz(32)*pol_z(:, 0, kg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_xyz(33)*pol_z(:, 0, kg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_xyz(34)*pol_z(:, 0, kg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_xyz(35)*pol_z(:, 0, kg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_xyz(36)*pol_z(:, 0, kg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_xyz(37)*pol_z(:, 0, kg) - coef_xy(:, 38) = coef_xy(:, 38)+coef_xyz(38)*pol_z(:, 0, kg) - coef_xy(:, 39) = coef_xy(:, 39)+coef_xyz(39)*pol_z(:, 0, kg) - coef_xy(:, 40) = coef_xy(:, 40)+coef_xyz(40)*pol_z(:, 0, kg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_xyz(41)*pol_z(:, 0, kg) - coef_xy(:, 42) = coef_xy(:, 42)+coef_xyz(42)*pol_z(:, 0, kg) - coef_xy(:, 43) = coef_xy(:, 43)+coef_xyz(43)*pol_z(:, 0, kg) - coef_xy(:, 44) = coef_xy(:, 44)+coef_xyz(44)*pol_z(:, 0, kg) - coef_xy(:, 45) = coef_xy(:, 45)+coef_xyz(45)*pol_z(:, 0, kg) - coef_xy(:, 46) = coef_xy(:, 46)+coef_xyz(46)*pol_z(:, 0, kg) - coef_xy(:, 47) = coef_xy(:, 47)+coef_xyz(47)*pol_z(:, 0, kg) - coef_xy(:, 48) = coef_xy(:, 48)+coef_xyz(48)*pol_z(:, 0, kg) - coef_xy(:, 49) = coef_xy(:, 49)+coef_xyz(49)*pol_z(:, 0, kg) - coef_xy(:, 50) = coef_xy(:, 50)+coef_xyz(50)*pol_z(:, 0, kg) - coef_xy(:, 51) = coef_xy(:, 51)+coef_xyz(51)*pol_z(:, 0, kg) - coef_xy(:, 52) = coef_xy(:, 52)+coef_xyz(52)*pol_z(:, 0, kg) - coef_xy(:, 53) = coef_xy(:, 53)+coef_xyz(53)*pol_z(:, 0, kg) - coef_xy(:, 54) = coef_xy(:, 54)+coef_xyz(54)*pol_z(:, 0, kg) - coef_xy(:, 55) = coef_xy(:, 55)+coef_xyz(55)*pol_z(:, 0, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(56)*pol_z(:, 1, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(57)*pol_z(:, 1, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(58)*pol_z(:, 1, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(59)*pol_z(:, 1, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(60)*pol_z(:, 1, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(61)*pol_z(:, 1, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(62)*pol_z(:, 1, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(63)*pol_z(:, 1, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(64)*pol_z(:, 1, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(65)*pol_z(:, 1, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(66)*pol_z(:, 1, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(67)*pol_z(:, 1, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(68)*pol_z(:, 1, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(69)*pol_z(:, 1, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(70)*pol_z(:, 1, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(71)*pol_z(:, 1, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(72)*pol_z(:, 1, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(73)*pol_z(:, 1, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(74)*pol_z(:, 1, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(75)*pol_z(:, 1, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(76)*pol_z(:, 1, kg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_xyz(77)*pol_z(:, 1, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(78)*pol_z(:, 1, kg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_xyz(79)*pol_z(:, 1, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(80)*pol_z(:, 1, kg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_xyz(81)*pol_z(:, 1, kg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_xyz(82)*pol_z(:, 1, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(83)*pol_z(:, 1, kg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_xyz(84)*pol_z(:, 1, kg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_xyz(85)*pol_z(:, 1, kg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_xyz(86)*pol_z(:, 1, kg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_xyz(87)*pol_z(:, 1, kg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_xyz(88)*pol_z(:, 1, kg) - coef_xy(:, 38) = coef_xy(:, 38)+coef_xyz(89)*pol_z(:, 1, kg) - coef_xy(:, 39) = coef_xy(:, 39)+coef_xyz(90)*pol_z(:, 1, kg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_xyz(91)*pol_z(:, 1, kg) - coef_xy(:, 42) = coef_xy(:, 42)+coef_xyz(92)*pol_z(:, 1, kg) - coef_xy(:, 43) = coef_xy(:, 43)+coef_xyz(93)*pol_z(:, 1, kg) - coef_xy(:, 44) = coef_xy(:, 44)+coef_xyz(94)*pol_z(:, 1, kg) - coef_xy(:, 46) = coef_xy(:, 46)+coef_xyz(95)*pol_z(:, 1, kg) - coef_xy(:, 47) = coef_xy(:, 47)+coef_xyz(96)*pol_z(:, 1, kg) - coef_xy(:, 48) = coef_xy(:, 48)+coef_xyz(97)*pol_z(:, 1, kg) - coef_xy(:, 50) = coef_xy(:, 50)+coef_xyz(98)*pol_z(:, 1, kg) - coef_xy(:, 51) = coef_xy(:, 51)+coef_xyz(99)*pol_z(:, 1, kg) - coef_xy(:, 53) = coef_xy(:, 53)+coef_xyz(100)*pol_z(:, 1, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(101)*pol_z(:, 2, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(102)*pol_z(:, 2, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(103)*pol_z(:, 2, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(104)*pol_z(:, 2, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(105)*pol_z(:, 2, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(106)*pol_z(:, 2, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(107)*pol_z(:, 2, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(108)*pol_z(:, 2, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(109)*pol_z(:, 2, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(110)*pol_z(:, 2, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(111)*pol_z(:, 2, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(112)*pol_z(:, 2, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(113)*pol_z(:, 2, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(114)*pol_z(:, 2, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(115)*pol_z(:, 2, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(116)*pol_z(:, 2, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(117)*pol_z(:, 2, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(118)*pol_z(:, 2, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(119)*pol_z(:, 2, kg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_xyz(120)*pol_z(:, 2, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(121)*pol_z(:, 2, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(122)*pol_z(:, 2, kg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_xyz(123)*pol_z(:, 2, kg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_xyz(124)*pol_z(:, 2, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(125)*pol_z(:, 2, kg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_xyz(126)*pol_z(:, 2, kg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_xyz(127)*pol_z(:, 2, kg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_xyz(128)*pol_z(:, 2, kg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_xyz(129)*pol_z(:, 2, kg) - coef_xy(:, 38) = coef_xy(:, 38)+coef_xyz(130)*pol_z(:, 2, kg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_xyz(131)*pol_z(:, 2, kg) - coef_xy(:, 42) = coef_xy(:, 42)+coef_xyz(132)*pol_z(:, 2, kg) - coef_xy(:, 43) = coef_xy(:, 43)+coef_xyz(133)*pol_z(:, 2, kg) - coef_xy(:, 46) = coef_xy(:, 46)+coef_xyz(134)*pol_z(:, 2, kg) - coef_xy(:, 47) = coef_xy(:, 47)+coef_xyz(135)*pol_z(:, 2, kg) - coef_xy(:, 50) = coef_xy(:, 50)+coef_xyz(136)*pol_z(:, 2, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(137)*pol_z(:, 3, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(138)*pol_z(:, 3, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(139)*pol_z(:, 3, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(140)*pol_z(:, 3, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(141)*pol_z(:, 3, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(142)*pol_z(:, 3, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(143)*pol_z(:, 3, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(144)*pol_z(:, 3, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(145)*pol_z(:, 3, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(146)*pol_z(:, 3, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(147)*pol_z(:, 3, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(148)*pol_z(:, 3, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(149)*pol_z(:, 3, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(150)*pol_z(:, 3, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(151)*pol_z(:, 3, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(152)*pol_z(:, 3, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(153)*pol_z(:, 3, kg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_xyz(154)*pol_z(:, 3, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(155)*pol_z(:, 3, kg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_xyz(156)*pol_z(:, 3, kg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_xyz(157)*pol_z(:, 3, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(158)*pol_z(:, 3, kg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_xyz(159)*pol_z(:, 3, kg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_xyz(160)*pol_z(:, 3, kg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_xyz(161)*pol_z(:, 3, kg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_xyz(162)*pol_z(:, 3, kg) - coef_xy(:, 42) = coef_xy(:, 42)+coef_xyz(163)*pol_z(:, 3, kg) - coef_xy(:, 46) = coef_xy(:, 46)+coef_xyz(164)*pol_z(:, 3, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(165)*pol_z(:, 4, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(166)*pol_z(:, 4, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(167)*pol_z(:, 4, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(168)*pol_z(:, 4, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(169)*pol_z(:, 4, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(170)*pol_z(:, 4, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(171)*pol_z(:, 4, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(172)*pol_z(:, 4, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(173)*pol_z(:, 4, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(174)*pol_z(:, 4, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(175)*pol_z(:, 4, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(176)*pol_z(:, 4, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(177)*pol_z(:, 4, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(178)*pol_z(:, 4, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(179)*pol_z(:, 4, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(180)*pol_z(:, 4, kg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_xyz(181)*pol_z(:, 4, kg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_xyz(182)*pol_z(:, 4, kg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_xyz(183)*pol_z(:, 4, kg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_xyz(184)*pol_z(:, 4, kg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_xyz(185)*pol_z(:, 4, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(186)*pol_z(:, 5, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(187)*pol_z(:, 5, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(188)*pol_z(:, 5, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(189)*pol_z(:, 5, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(190)*pol_z(:, 5, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(191)*pol_z(:, 5, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(192)*pol_z(:, 5, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(193)*pol_z(:, 5, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(194)*pol_z(:, 5, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(195)*pol_z(:, 5, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(196)*pol_z(:, 5, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(197)*pol_z(:, 5, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(198)*pol_z(:, 5, kg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_xyz(199)*pol_z(:, 5, kg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_xyz(200)*pol_z(:, 5, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(201)*pol_z(:, 6, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(202)*pol_z(:, 6, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(203)*pol_z(:, 6, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(204)*pol_z(:, 6, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(205)*pol_z(:, 6, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(206)*pol_z(:, 6, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(207)*pol_z(:, 6, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(208)*pol_z(:, 6, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(209)*pol_z(:, 6, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(210)*pol_z(:, 6, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(211)*pol_z(:, 7, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(212)*pol_z(:, 7, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(213)*pol_z(:, 7, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(214)*pol_z(:, 7, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(215)*pol_z(:, 7, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(216)*pol_z(:, 7, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(217)*pol_z(:, 8, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(218)*pol_z(:, 8, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(219)*pol_z(:, 8, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(220)*pol_z(:, 9, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(1)*pol_z(:, 0, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(2)*pol_z(:, 0, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(3)*pol_z(:, 0, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(4)*pol_z(:, 0, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(5)*pol_z(:, 0, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(6)*pol_z(:, 0, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(7)*pol_z(:, 0, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(8)*pol_z(:, 0, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(9)*pol_z(:, 0, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(10)*pol_z(:, 0, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(11)*pol_z(:, 0, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(12)*pol_z(:, 0, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(13)*pol_z(:, 0, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(14)*pol_z(:, 0, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(15)*pol_z(:, 0, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(16)*pol_z(:, 0, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(17)*pol_z(:, 0, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(18)*pol_z(:, 0, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(19)*pol_z(:, 0, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(20)*pol_z(:, 0, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(21)*pol_z(:, 0, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(22)*pol_z(:, 0, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(23)*pol_z(:, 0, kg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_xyz(24)*pol_z(:, 0, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(25)*pol_z(:, 0, kg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_xyz(26)*pol_z(:, 0, kg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_xyz(27)*pol_z(:, 0, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(28)*pol_z(:, 0, kg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_xyz(29)*pol_z(:, 0, kg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_xyz(30)*pol_z(:, 0, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(31)*pol_z(:, 0, kg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_xyz(32)*pol_z(:, 0, kg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_xyz(33)*pol_z(:, 0, kg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_xyz(34)*pol_z(:, 0, kg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_xyz(35)*pol_z(:, 0, kg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_xyz(36)*pol_z(:, 0, kg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_xyz(37)*pol_z(:, 0, kg) + coef_xy(:, 38) = coef_xy(:, 38) + coef_xyz(38)*pol_z(:, 0, kg) + coef_xy(:, 39) = coef_xy(:, 39) + coef_xyz(39)*pol_z(:, 0, kg) + coef_xy(:, 40) = coef_xy(:, 40) + coef_xyz(40)*pol_z(:, 0, kg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_xyz(41)*pol_z(:, 0, kg) + coef_xy(:, 42) = coef_xy(:, 42) + coef_xyz(42)*pol_z(:, 0, kg) + coef_xy(:, 43) = coef_xy(:, 43) + coef_xyz(43)*pol_z(:, 0, kg) + coef_xy(:, 44) = coef_xy(:, 44) + coef_xyz(44)*pol_z(:, 0, kg) + coef_xy(:, 45) = coef_xy(:, 45) + coef_xyz(45)*pol_z(:, 0, kg) + coef_xy(:, 46) = coef_xy(:, 46) + coef_xyz(46)*pol_z(:, 0, kg) + coef_xy(:, 47) = coef_xy(:, 47) + coef_xyz(47)*pol_z(:, 0, kg) + coef_xy(:, 48) = coef_xy(:, 48) + coef_xyz(48)*pol_z(:, 0, kg) + coef_xy(:, 49) = coef_xy(:, 49) + coef_xyz(49)*pol_z(:, 0, kg) + coef_xy(:, 50) = coef_xy(:, 50) + coef_xyz(50)*pol_z(:, 0, kg) + coef_xy(:, 51) = coef_xy(:, 51) + coef_xyz(51)*pol_z(:, 0, kg) + coef_xy(:, 52) = coef_xy(:, 52) + coef_xyz(52)*pol_z(:, 0, kg) + coef_xy(:, 53) = coef_xy(:, 53) + coef_xyz(53)*pol_z(:, 0, kg) + coef_xy(:, 54) = coef_xy(:, 54) + coef_xyz(54)*pol_z(:, 0, kg) + coef_xy(:, 55) = coef_xy(:, 55) + coef_xyz(55)*pol_z(:, 0, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(56)*pol_z(:, 1, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(57)*pol_z(:, 1, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(58)*pol_z(:, 1, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(59)*pol_z(:, 1, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(60)*pol_z(:, 1, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(61)*pol_z(:, 1, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(62)*pol_z(:, 1, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(63)*pol_z(:, 1, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(64)*pol_z(:, 1, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(65)*pol_z(:, 1, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(66)*pol_z(:, 1, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(67)*pol_z(:, 1, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(68)*pol_z(:, 1, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(69)*pol_z(:, 1, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(70)*pol_z(:, 1, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(71)*pol_z(:, 1, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(72)*pol_z(:, 1, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(73)*pol_z(:, 1, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(74)*pol_z(:, 1, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(75)*pol_z(:, 1, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(76)*pol_z(:, 1, kg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_xyz(77)*pol_z(:, 1, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(78)*pol_z(:, 1, kg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_xyz(79)*pol_z(:, 1, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(80)*pol_z(:, 1, kg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_xyz(81)*pol_z(:, 1, kg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_xyz(82)*pol_z(:, 1, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(83)*pol_z(:, 1, kg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_xyz(84)*pol_z(:, 1, kg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_xyz(85)*pol_z(:, 1, kg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_xyz(86)*pol_z(:, 1, kg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_xyz(87)*pol_z(:, 1, kg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_xyz(88)*pol_z(:, 1, kg) + coef_xy(:, 38) = coef_xy(:, 38) + coef_xyz(89)*pol_z(:, 1, kg) + coef_xy(:, 39) = coef_xy(:, 39) + coef_xyz(90)*pol_z(:, 1, kg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_xyz(91)*pol_z(:, 1, kg) + coef_xy(:, 42) = coef_xy(:, 42) + coef_xyz(92)*pol_z(:, 1, kg) + coef_xy(:, 43) = coef_xy(:, 43) + coef_xyz(93)*pol_z(:, 1, kg) + coef_xy(:, 44) = coef_xy(:, 44) + coef_xyz(94)*pol_z(:, 1, kg) + coef_xy(:, 46) = coef_xy(:, 46) + coef_xyz(95)*pol_z(:, 1, kg) + coef_xy(:, 47) = coef_xy(:, 47) + coef_xyz(96)*pol_z(:, 1, kg) + coef_xy(:, 48) = coef_xy(:, 48) + coef_xyz(97)*pol_z(:, 1, kg) + coef_xy(:, 50) = coef_xy(:, 50) + coef_xyz(98)*pol_z(:, 1, kg) + coef_xy(:, 51) = coef_xy(:, 51) + coef_xyz(99)*pol_z(:, 1, kg) + coef_xy(:, 53) = coef_xy(:, 53) + coef_xyz(100)*pol_z(:, 1, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(101)*pol_z(:, 2, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(102)*pol_z(:, 2, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(103)*pol_z(:, 2, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(104)*pol_z(:, 2, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(105)*pol_z(:, 2, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(106)*pol_z(:, 2, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(107)*pol_z(:, 2, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(108)*pol_z(:, 2, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(109)*pol_z(:, 2, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(110)*pol_z(:, 2, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(111)*pol_z(:, 2, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(112)*pol_z(:, 2, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(113)*pol_z(:, 2, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(114)*pol_z(:, 2, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(115)*pol_z(:, 2, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(116)*pol_z(:, 2, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(117)*pol_z(:, 2, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(118)*pol_z(:, 2, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(119)*pol_z(:, 2, kg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_xyz(120)*pol_z(:, 2, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(121)*pol_z(:, 2, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(122)*pol_z(:, 2, kg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_xyz(123)*pol_z(:, 2, kg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_xyz(124)*pol_z(:, 2, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(125)*pol_z(:, 2, kg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_xyz(126)*pol_z(:, 2, kg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_xyz(127)*pol_z(:, 2, kg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_xyz(128)*pol_z(:, 2, kg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_xyz(129)*pol_z(:, 2, kg) + coef_xy(:, 38) = coef_xy(:, 38) + coef_xyz(130)*pol_z(:, 2, kg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_xyz(131)*pol_z(:, 2, kg) + coef_xy(:, 42) = coef_xy(:, 42) + coef_xyz(132)*pol_z(:, 2, kg) + coef_xy(:, 43) = coef_xy(:, 43) + coef_xyz(133)*pol_z(:, 2, kg) + coef_xy(:, 46) = coef_xy(:, 46) + coef_xyz(134)*pol_z(:, 2, kg) + coef_xy(:, 47) = coef_xy(:, 47) + coef_xyz(135)*pol_z(:, 2, kg) + coef_xy(:, 50) = coef_xy(:, 50) + coef_xyz(136)*pol_z(:, 2, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(137)*pol_z(:, 3, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(138)*pol_z(:, 3, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(139)*pol_z(:, 3, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(140)*pol_z(:, 3, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(141)*pol_z(:, 3, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(142)*pol_z(:, 3, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(143)*pol_z(:, 3, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(144)*pol_z(:, 3, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(145)*pol_z(:, 3, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(146)*pol_z(:, 3, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(147)*pol_z(:, 3, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(148)*pol_z(:, 3, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(149)*pol_z(:, 3, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(150)*pol_z(:, 3, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(151)*pol_z(:, 3, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(152)*pol_z(:, 3, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(153)*pol_z(:, 3, kg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_xyz(154)*pol_z(:, 3, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(155)*pol_z(:, 3, kg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_xyz(156)*pol_z(:, 3, kg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_xyz(157)*pol_z(:, 3, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(158)*pol_z(:, 3, kg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_xyz(159)*pol_z(:, 3, kg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_xyz(160)*pol_z(:, 3, kg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_xyz(161)*pol_z(:, 3, kg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_xyz(162)*pol_z(:, 3, kg) + coef_xy(:, 42) = coef_xy(:, 42) + coef_xyz(163)*pol_z(:, 3, kg) + coef_xy(:, 46) = coef_xy(:, 46) + coef_xyz(164)*pol_z(:, 3, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(165)*pol_z(:, 4, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(166)*pol_z(:, 4, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(167)*pol_z(:, 4, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(168)*pol_z(:, 4, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(169)*pol_z(:, 4, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(170)*pol_z(:, 4, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(171)*pol_z(:, 4, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(172)*pol_z(:, 4, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(173)*pol_z(:, 4, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(174)*pol_z(:, 4, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(175)*pol_z(:, 4, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(176)*pol_z(:, 4, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(177)*pol_z(:, 4, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(178)*pol_z(:, 4, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(179)*pol_z(:, 4, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(180)*pol_z(:, 4, kg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_xyz(181)*pol_z(:, 4, kg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_xyz(182)*pol_z(:, 4, kg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_xyz(183)*pol_z(:, 4, kg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_xyz(184)*pol_z(:, 4, kg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_xyz(185)*pol_z(:, 4, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(186)*pol_z(:, 5, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(187)*pol_z(:, 5, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(188)*pol_z(:, 5, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(189)*pol_z(:, 5, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(190)*pol_z(:, 5, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(191)*pol_z(:, 5, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(192)*pol_z(:, 5, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(193)*pol_z(:, 5, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(194)*pol_z(:, 5, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(195)*pol_z(:, 5, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(196)*pol_z(:, 5, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(197)*pol_z(:, 5, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(198)*pol_z(:, 5, kg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_xyz(199)*pol_z(:, 5, kg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_xyz(200)*pol_z(:, 5, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(201)*pol_z(:, 6, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(202)*pol_z(:, 6, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(203)*pol_z(:, 6, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(204)*pol_z(:, 6, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(205)*pol_z(:, 6, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(206)*pol_z(:, 6, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(207)*pol_z(:, 6, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(208)*pol_z(:, 6, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(209)*pol_z(:, 6, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(210)*pol_z(:, 6, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(211)*pol_z(:, 7, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(212)*pol_z(:, 7, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(213)*pol_z(:, 7, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(214)*pol_z(:, 7, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(215)*pol_z(:, 7, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(216)*pol_z(:, 7, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(217)*pol_z(:, 8, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(218)*pol_z(:, 8, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(219)*pol_z(:, 8, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(220)*pol_z(:, 9, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 1)*pol_y(1, 0, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 1)*pol_y(2, 0, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 2)*pol_y(1, 0, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 2)*pol_y(2, 0, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 3)*pol_y(1, 0, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 3)*pol_y(2, 0, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 4)*pol_y(1, 0, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 4)*pol_y(2, 0, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 5)*pol_y(1, 0, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 5)*pol_y(2, 0, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 6)*pol_y(1, 0, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 6)*pol_y(2, 0, jg) - coef_x(1:2, 6) = coef_x(1:2, 6)+coef_xy(1:2, 7)*pol_y(1, 0, jg) - coef_x(3:4, 6) = coef_x(3:4, 6)+coef_xy(1:2, 7)*pol_y(2, 0, jg) - coef_x(1:2, 7) = coef_x(1:2, 7)+coef_xy(1:2, 8)*pol_y(1, 0, jg) - coef_x(3:4, 7) = coef_x(3:4, 7)+coef_xy(1:2, 8)*pol_y(2, 0, jg) - coef_x(1:2, 8) = coef_x(1:2, 8)+coef_xy(1:2, 9)*pol_y(1, 0, jg) - coef_x(3:4, 8) = coef_x(3:4, 8)+coef_xy(1:2, 9)*pol_y(2, 0, jg) - coef_x(1:2, 9) = coef_x(1:2, 9)+coef_xy(1:2, 10)*pol_y(1, 0, jg) - coef_x(3:4, 9) = coef_x(3:4, 9)+coef_xy(1:2, 10)*pol_y(2, 0, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 11)*pol_y(1, 1, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 11)*pol_y(2, 1, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 12)*pol_y(1, 1, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 12)*pol_y(2, 1, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 13)*pol_y(1, 1, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 13)*pol_y(2, 1, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 14)*pol_y(1, 1, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 14)*pol_y(2, 1, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 15)*pol_y(1, 1, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 15)*pol_y(2, 1, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 16)*pol_y(1, 1, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 16)*pol_y(2, 1, jg) - coef_x(1:2, 6) = coef_x(1:2, 6)+coef_xy(1:2, 17)*pol_y(1, 1, jg) - coef_x(3:4, 6) = coef_x(3:4, 6)+coef_xy(1:2, 17)*pol_y(2, 1, jg) - coef_x(1:2, 7) = coef_x(1:2, 7)+coef_xy(1:2, 18)*pol_y(1, 1, jg) - coef_x(3:4, 7) = coef_x(3:4, 7)+coef_xy(1:2, 18)*pol_y(2, 1, jg) - coef_x(1:2, 8) = coef_x(1:2, 8)+coef_xy(1:2, 19)*pol_y(1, 1, jg) - coef_x(3:4, 8) = coef_x(3:4, 8)+coef_xy(1:2, 19)*pol_y(2, 1, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 20)*pol_y(1, 2, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 20)*pol_y(2, 2, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 21)*pol_y(1, 2, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 21)*pol_y(2, 2, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 22)*pol_y(1, 2, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 22)*pol_y(2, 2, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 23)*pol_y(1, 2, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 23)*pol_y(2, 2, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 24)*pol_y(1, 2, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 24)*pol_y(2, 2, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 25)*pol_y(1, 2, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 25)*pol_y(2, 2, jg) - coef_x(1:2, 6) = coef_x(1:2, 6)+coef_xy(1:2, 26)*pol_y(1, 2, jg) - coef_x(3:4, 6) = coef_x(3:4, 6)+coef_xy(1:2, 26)*pol_y(2, 2, jg) - coef_x(1:2, 7) = coef_x(1:2, 7)+coef_xy(1:2, 27)*pol_y(1, 2, jg) - coef_x(3:4, 7) = coef_x(3:4, 7)+coef_xy(1:2, 27)*pol_y(2, 2, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 28)*pol_y(1, 3, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 28)*pol_y(2, 3, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 29)*pol_y(1, 3, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 29)*pol_y(2, 3, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 30)*pol_y(1, 3, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 30)*pol_y(2, 3, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 31)*pol_y(1, 3, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 31)*pol_y(2, 3, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 32)*pol_y(1, 3, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 32)*pol_y(2, 3, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 33)*pol_y(1, 3, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 33)*pol_y(2, 3, jg) - coef_x(1:2, 6) = coef_x(1:2, 6)+coef_xy(1:2, 34)*pol_y(1, 3, jg) - coef_x(3:4, 6) = coef_x(3:4, 6)+coef_xy(1:2, 34)*pol_y(2, 3, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 35)*pol_y(1, 4, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 35)*pol_y(2, 4, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 36)*pol_y(1, 4, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 36)*pol_y(2, 4, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 37)*pol_y(1, 4, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 37)*pol_y(2, 4, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 38)*pol_y(1, 4, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 38)*pol_y(2, 4, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 39)*pol_y(1, 4, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 39)*pol_y(2, 4, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 40)*pol_y(1, 4, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 40)*pol_y(2, 4, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 41)*pol_y(1, 5, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 41)*pol_y(2, 5, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 42)*pol_y(1, 5, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 42)*pol_y(2, 5, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 43)*pol_y(1, 5, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 43)*pol_y(2, 5, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 44)*pol_y(1, 5, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 44)*pol_y(2, 5, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 45)*pol_y(1, 5, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 45)*pol_y(2, 5, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 46)*pol_y(1, 6, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 46)*pol_y(2, 6, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 47)*pol_y(1, 6, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 47)*pol_y(2, 6, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 48)*pol_y(1, 6, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 48)*pol_y(2, 6, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 49)*pol_y(1, 6, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 49)*pol_y(2, 6, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 50)*pol_y(1, 7, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 50)*pol_y(2, 7, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 51)*pol_y(1, 7, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 51)*pol_y(2, 7, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 52)*pol_y(1, 7, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 52)*pol_y(2, 7, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 53)*pol_y(1, 8, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 53)*pol_y(2, 8, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 54)*pol_y(1, 8, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 54)*pol_y(2, 8, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 55)*pol_y(1, 9, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 55)*pol_y(2, 9, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 1)*pol_y(1, 0, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 1)*pol_y(2, 0, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 2)*pol_y(1, 0, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 2)*pol_y(2, 0, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 3)*pol_y(1, 0, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 3)*pol_y(2, 0, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 4)*pol_y(1, 0, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 4)*pol_y(2, 0, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 5)*pol_y(1, 0, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 5)*pol_y(2, 0, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 6)*pol_y(1, 0, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 6)*pol_y(2, 0, jg) + coef_x(1:2, 6) = coef_x(1:2, 6) + coef_xy(1:2, 7)*pol_y(1, 0, jg) + coef_x(3:4, 6) = coef_x(3:4, 6) + coef_xy(1:2, 7)*pol_y(2, 0, jg) + coef_x(1:2, 7) = coef_x(1:2, 7) + coef_xy(1:2, 8)*pol_y(1, 0, jg) + coef_x(3:4, 7) = coef_x(3:4, 7) + coef_xy(1:2, 8)*pol_y(2, 0, jg) + coef_x(1:2, 8) = coef_x(1:2, 8) + coef_xy(1:2, 9)*pol_y(1, 0, jg) + coef_x(3:4, 8) = coef_x(3:4, 8) + coef_xy(1:2, 9)*pol_y(2, 0, jg) + coef_x(1:2, 9) = coef_x(1:2, 9) + coef_xy(1:2, 10)*pol_y(1, 0, jg) + coef_x(3:4, 9) = coef_x(3:4, 9) + coef_xy(1:2, 10)*pol_y(2, 0, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 11)*pol_y(1, 1, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 11)*pol_y(2, 1, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 12)*pol_y(1, 1, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 12)*pol_y(2, 1, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 13)*pol_y(1, 1, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 13)*pol_y(2, 1, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 14)*pol_y(1, 1, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 14)*pol_y(2, 1, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 15)*pol_y(1, 1, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 15)*pol_y(2, 1, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 16)*pol_y(1, 1, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 16)*pol_y(2, 1, jg) + coef_x(1:2, 6) = coef_x(1:2, 6) + coef_xy(1:2, 17)*pol_y(1, 1, jg) + coef_x(3:4, 6) = coef_x(3:4, 6) + coef_xy(1:2, 17)*pol_y(2, 1, jg) + coef_x(1:2, 7) = coef_x(1:2, 7) + coef_xy(1:2, 18)*pol_y(1, 1, jg) + coef_x(3:4, 7) = coef_x(3:4, 7) + coef_xy(1:2, 18)*pol_y(2, 1, jg) + coef_x(1:2, 8) = coef_x(1:2, 8) + coef_xy(1:2, 19)*pol_y(1, 1, jg) + coef_x(3:4, 8) = coef_x(3:4, 8) + coef_xy(1:2, 19)*pol_y(2, 1, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 20)*pol_y(1, 2, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 20)*pol_y(2, 2, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 21)*pol_y(1, 2, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 21)*pol_y(2, 2, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 22)*pol_y(1, 2, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 22)*pol_y(2, 2, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 23)*pol_y(1, 2, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 23)*pol_y(2, 2, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 24)*pol_y(1, 2, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 24)*pol_y(2, 2, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 25)*pol_y(1, 2, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 25)*pol_y(2, 2, jg) + coef_x(1:2, 6) = coef_x(1:2, 6) + coef_xy(1:2, 26)*pol_y(1, 2, jg) + coef_x(3:4, 6) = coef_x(3:4, 6) + coef_xy(1:2, 26)*pol_y(2, 2, jg) + coef_x(1:2, 7) = coef_x(1:2, 7) + coef_xy(1:2, 27)*pol_y(1, 2, jg) + coef_x(3:4, 7) = coef_x(3:4, 7) + coef_xy(1:2, 27)*pol_y(2, 2, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 28)*pol_y(1, 3, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 28)*pol_y(2, 3, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 29)*pol_y(1, 3, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 29)*pol_y(2, 3, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 30)*pol_y(1, 3, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 30)*pol_y(2, 3, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 31)*pol_y(1, 3, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 31)*pol_y(2, 3, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 32)*pol_y(1, 3, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 32)*pol_y(2, 3, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 33)*pol_y(1, 3, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 33)*pol_y(2, 3, jg) + coef_x(1:2, 6) = coef_x(1:2, 6) + coef_xy(1:2, 34)*pol_y(1, 3, jg) + coef_x(3:4, 6) = coef_x(3:4, 6) + coef_xy(1:2, 34)*pol_y(2, 3, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 35)*pol_y(1, 4, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 35)*pol_y(2, 4, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 36)*pol_y(1, 4, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 36)*pol_y(2, 4, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 37)*pol_y(1, 4, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 37)*pol_y(2, 4, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 38)*pol_y(1, 4, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 38)*pol_y(2, 4, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 39)*pol_y(1, 4, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 39)*pol_y(2, 4, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 40)*pol_y(1, 4, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 40)*pol_y(2, 4, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 41)*pol_y(1, 5, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 41)*pol_y(2, 5, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 42)*pol_y(1, 5, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 42)*pol_y(2, 5, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 43)*pol_y(1, 5, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 43)*pol_y(2, 5, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 44)*pol_y(1, 5, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 44)*pol_y(2, 5, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 45)*pol_y(1, 5, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 45)*pol_y(2, 5, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 46)*pol_y(1, 6, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 46)*pol_y(2, 6, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 47)*pol_y(1, 6, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 47)*pol_y(2, 6, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 48)*pol_y(1, 6, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 48)*pol_y(2, 6, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 49)*pol_y(1, 6, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 49)*pol_y(2, 6, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 50)*pol_y(1, 7, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 50)*pol_y(2, 7, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 51)*pol_y(1, 7, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 51)*pol_y(2, 7, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 52)*pol_y(1, 7, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 52)*pol_y(2, 7, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 53)*pol_y(1, 8, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 53)*pol_y(2, 8, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 54)*pol_y(1, 8, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 54)*pol_y(2, 8, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 55)*pol_y(1, 9, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 55)*pol_y(2, 9, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - s01 = s01+coef_x(1, 4)*pol_x(4, ig) - s02 = s02+coef_x(2, 4)*pol_x(4, ig) - s03 = s03+coef_x(3, 4)*pol_x(4, ig) - s04 = s04+coef_x(4, 4)*pol_x(4, ig) - s01 = s01+coef_x(1, 5)*pol_x(5, ig) - s02 = s02+coef_x(2, 5)*pol_x(5, ig) - s03 = s03+coef_x(3, 5)*pol_x(5, ig) - s04 = s04+coef_x(4, 5)*pol_x(5, ig) - s01 = s01+coef_x(1, 6)*pol_x(6, ig) - s02 = s02+coef_x(2, 6)*pol_x(6, ig) - s03 = s03+coef_x(3, 6)*pol_x(6, ig) - s04 = s04+coef_x(4, 6)*pol_x(6, ig) - s01 = s01+coef_x(1, 7)*pol_x(7, ig) - s02 = s02+coef_x(2, 7)*pol_x(7, ig) - s03 = s03+coef_x(3, 7)*pol_x(7, ig) - s04 = s04+coef_x(4, 7)*pol_x(7, ig) - s01 = s01+coef_x(1, 8)*pol_x(8, ig) - s02 = s02+coef_x(2, 8)*pol_x(8, ig) - s03 = s03+coef_x(3, 8)*pol_x(8, ig) - s04 = s04+coef_x(4, 8)*pol_x(8, ig) - s01 = s01+coef_x(1, 9)*pol_x(9, ig) - s02 = s02+coef_x(2, 9)*pol_x(9, ig) - s03 = s03+coef_x(3, 9)*pol_x(9, ig) - s04 = s04+coef_x(4, 9)*pol_x(9, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + s01 = s01 + coef_x(1, 4)*pol_x(4, ig) + s02 = s02 + coef_x(2, 4)*pol_x(4, ig) + s03 = s03 + coef_x(3, 4)*pol_x(4, ig) + s04 = s04 + coef_x(4, 4)*pol_x(4, ig) + s01 = s01 + coef_x(1, 5)*pol_x(5, ig) + s02 = s02 + coef_x(2, 5)*pol_x(5, ig) + s03 = s03 + coef_x(3, 5)*pol_x(5, ig) + s04 = s04 + coef_x(4, 5)*pol_x(5, ig) + s01 = s01 + coef_x(1, 6)*pol_x(6, ig) + s02 = s02 + coef_x(2, 6)*pol_x(6, ig) + s03 = s03 + coef_x(3, 6)*pol_x(6, ig) + s04 = s04 + coef_x(4, 6)*pol_x(6, ig) + s01 = s01 + coef_x(1, 7)*pol_x(7, ig) + s02 = s02 + coef_x(2, 7)*pol_x(7, ig) + s03 = s03 + coef_x(3, 7)*pol_x(7, ig) + s04 = s04 + coef_x(4, 7)*pol_x(7, ig) + s01 = s01 + coef_x(1, 8)*pol_x(8, ig) + s02 = s02 + coef_x(2, 8)*pol_x(8, ig) + s03 = s03 + coef_x(3, 8)*pol_x(8, ig) + s04 = s04 + coef_x(4, 8)*pol_x(8, ig) + s01 = s01 + coef_x(1, 9)*pol_x(9, ig) + s02 = s02 + coef_x(2, 9)*pol_x(9, ig) + s03 = s03 + coef_x(3, 9)*pol_x(9, ig) + s04 = s04 + coef_x(4, 9)*pol_x(9, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO diff --git a/src/grid/collocate_fast_3.f90 b/src/grid/collocate_fast_3.f90 index e4c3a82919..17d28b5f94 100644 --- a/src/grid/collocate_fast_3.f90 +++ b/src/grid/collocate_fast_3.f90 @@ -14,7 +14,7 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bounds, lp, cmax, gridbounds) USE kinds, ONLY: dp INTEGER, INTENT(IN) :: sphere_bounds(*), lp - REAL(dp), INTENT(IN) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(IN) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER, INTENT(IN) :: cmax REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & @@ -29,15 +29,15 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) @@ -45,35 +45,35 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_xyz(lxyz)*pol_z(1, lzp, kg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_xyz(lxyz)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_xyz(lxyz)*pol_z(1, lzp, kg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_xyz(lxyz)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_x(1, lxp) = coef_x(1, lxp)+coef_xy(1, lxy)*pol_y(1, lyp, jg) - coef_x(2, lxp) = coef_x(2, lxp)+coef_xy(2, lxy)*pol_y(1, lyp, jg) - coef_x(3, lxp) = coef_x(3, lxp)+coef_xy(1, lxy)*pol_y(2, lyp, jg) - coef_x(4, lxp) = coef_x(4, lxp)+coef_xy(2, lxy)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_x(1, lxp) = coef_x(1, lxp) + coef_xy(1, lxy)*pol_y(1, lyp, jg) + coef_x(2, lxp) = coef_x(2, lxp) + coef_xy(2, lxy)*pol_y(1, lyp, jg) + coef_x(3, lxp) = coef_x(3, lxp) + coef_xy(1, lxy)*pol_y(2, lyp, jg) + coef_x(4, lxp) = coef_x(4, lxp) + coef_xy(2, lxy)*pol_y(2, lyp, jg) ENDDO ENDDO @@ -84,15 +84,15 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe s03 = 0.0_dp s04 = 0.0_dp DO lxp = 0, lp - s01 = s01+coef_x(1, lxp)*pol_x(lxp, ig) - s02 = s02+coef_x(2, lxp)*pol_x(lxp, ig) - s03 = s03+coef_x(3, lxp)*pol_x(lxp, ig) - s04 = s04+coef_x(4, lxp)*pol_x(lxp, ig) + s01 = s01 + coef_x(1, lxp)*pol_x(lxp, ig) + s02 = s02 + coef_x(2, lxp)*pol_x(lxp, ig) + s03 = s03 + coef_x(3, lxp)*pol_x(lxp, ig) + s04 = s04 + coef_x(4, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO @@ -120,42 +120,42 @@ SUBROUTINE collocate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 0 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lyp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_x(1:2, lxp) = coef_x(1:2, lxp)+coef_xy(1:2, lxy)*pol_y(1, lyp, jg) - coef_x(3:4, lxp) = coef_x(3:4, lxp)+coef_xy(1:2, lxy)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_x(1:2, lxp) = coef_x(1:2, lxp) + coef_xy(1:2, lxy)*pol_y(1, lyp, jg) + coef_x(3:4, lxp) = coef_x(3:4, lxp) + coef_xy(1:2, lxy)*pol_y(2, lyp, jg) ENDDO ENDDO DO ig = igmin, igmax @@ -165,15 +165,15 @@ SUBROUTINE collocate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = 0.0_dp s04 = 0.0_dp DO lxp = 0, lp - s01 = s01+coef_x(1, lxp)*pol_x(lxp, ig) - s02 = s02+coef_x(2, lxp)*pol_x(lxp, ig) - s03 = s03+coef_x(3, lxp)*pol_x(lxp, ig) - s04 = s04+coef_x(4, lxp)*pol_x(lxp, ig) + s01 = s01 + coef_x(1, lxp)*pol_x(lxp, ig) + s02 = s02 + coef_x(2, lxp)*pol_x(lxp, ig) + s03 = s03 + coef_x(3, lxp)*pol_x(lxp, ig) + s04 = s04 + coef_x(4, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -200,52 +200,52 @@ SUBROUTINE collocate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 1 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xy(:, lxy) = coef_xy(:, lxy)+coef_xyz(lxyz)*pol_z(:, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xy(:, lxy) = coef_xy(:, lxy) + coef_xyz(lxyz)*pol_z(:, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_x(1:2, lxp) = coef_x(1:2, lxp)+coef_xy(1:2, lxy)*pol_y(1, lyp, jg) - coef_x(3:4, lxp) = coef_x(3:4, lxp)+coef_xy(1:2, lxy)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_x(1:2, lxp) = coef_x(1:2, lxp) + coef_xy(1:2, lxy)*pol_y(1, lyp, jg) + coef_x(3:4, lxp) = coef_x(3:4, lxp) + coef_xy(1:2, lxy)*pol_y(2, lyp, jg) ENDDO ENDDO DO ig = igmin, igmax @@ -254,18 +254,18 @@ SUBROUTINE collocate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -292,88 +292,88 @@ SUBROUTINE collocate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 2 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(7)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(7)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(8)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(8)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(9)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(9)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(10)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(10)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(7)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(7)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(8)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(8)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(9)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(9)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(10)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(10)*pol_z(2, 2, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 1)*pol_y(1, 0, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 1)*pol_y(2, 0, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 2)*pol_y(1, 0, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 2)*pol_y(2, 0, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 3)*pol_y(1, 0, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 3)*pol_y(2, 0, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 4)*pol_y(1, 1, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 4)*pol_y(2, 1, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 5)*pol_y(1, 1, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 5)*pol_y(2, 1, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 6)*pol_y(1, 2, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 6)*pol_y(2, 2, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 1)*pol_y(1, 0, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 1)*pol_y(2, 0, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 2)*pol_y(1, 0, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 2)*pol_y(2, 0, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 3)*pol_y(1, 0, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 3)*pol_y(2, 0, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 4)*pol_y(1, 1, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 4)*pol_y(2, 1, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 5)*pol_y(1, 1, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 5)*pol_y(2, 1, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 6)*pol_y(1, 2, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 6)*pol_y(2, 2, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -400,62 +400,62 @@ SUBROUTINE collocate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 3 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lyp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(1)*pol_z(:, 0, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(2)*pol_z(:, 0, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(3)*pol_z(:, 0, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(4)*pol_z(:, 0, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(5)*pol_z(:, 0, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(6)*pol_z(:, 0, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(7)*pol_z(:, 0, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(8)*pol_z(:, 0, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(9)*pol_z(:, 0, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(10)*pol_z(:, 0, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(11)*pol_z(:, 1, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(12)*pol_z(:, 1, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(13)*pol_z(:, 1, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(14)*pol_z(:, 1, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(15)*pol_z(:, 1, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(16)*pol_z(:, 1, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(17)*pol_z(:, 2, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(18)*pol_z(:, 2, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(19)*pol_z(:, 2, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(20)*pol_z(:, 3, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(1)*pol_z(:, 0, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(2)*pol_z(:, 0, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(3)*pol_z(:, 0, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(4)*pol_z(:, 0, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(5)*pol_z(:, 0, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(6)*pol_z(:, 0, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(7)*pol_z(:, 0, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(8)*pol_z(:, 0, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(9)*pol_z(:, 0, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(10)*pol_z(:, 0, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(11)*pol_z(:, 1, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(12)*pol_z(:, 1, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(13)*pol_z(:, 1, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(14)*pol_z(:, 1, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(15)*pol_z(:, 1, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(16)*pol_z(:, 1, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(17)*pol_z(:, 2, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(18)*pol_z(:, 2, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(19)*pol_z(:, 2, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(20)*pol_z(:, 3, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_x(1, lxp) = coef_x(1, lxp)+coef_xy(1, lxy)*pol_y(1, lyp, jg) - coef_x(2, lxp) = coef_x(2, lxp)+coef_xy(2, lxy)*pol_y(1, lyp, jg) - coef_x(3, lxp) = coef_x(3, lxp)+coef_xy(1, lxy)*pol_y(2, lyp, jg) - coef_x(4, lxp) = coef_x(4, lxp)+coef_xy(2, lxy)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_x(1, lxp) = coef_x(1, lxp) + coef_xy(1, lxy)*pol_y(1, lyp, jg) + coef_x(2, lxp) = coef_x(2, lxp) + coef_xy(2, lxy)*pol_y(1, lyp, jg) + coef_x(3, lxp) = coef_x(3, lxp) + coef_xy(1, lxy)*pol_y(2, lyp, jg) + coef_x(4, lxp) = coef_x(4, lxp) + coef_xy(2, lxy)*pol_y(2, lyp, jg) ENDDO ENDDO DO ig = igmin, igmax @@ -464,26 +464,26 @@ SUBROUTINE collocate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -510,137 +510,137 @@ SUBROUTINE collocate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 4 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_xyz(lxyz)*pol_z(1, lzp, kg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_xyz(lxyz)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_xyz(lxyz)*pol_z(1, lzp, kg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_xyz(lxyz)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 4)*pol_y(1, 0, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 4)*pol_y(1, 0, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 4)*pol_y(2, 0, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 4)*pol_y(2, 0, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 5)*pol_y(1, 0, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 5)*pol_y(1, 0, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 5)*pol_y(2, 0, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 5)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 6)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 6)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 6)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 6)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 7)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 7)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 7)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 7)*pol_y(2, 1, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 8)*pol_y(1, 1, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 8)*pol_y(1, 1, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 8)*pol_y(2, 1, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 8)*pol_y(2, 1, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 9)*pol_y(1, 1, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 9)*pol_y(1, 1, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 9)*pol_y(2, 1, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 9)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 10)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 10)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 10)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 10)*pol_y(2, 2, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 11)*pol_y(1, 2, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 11)*pol_y(1, 2, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 11)*pol_y(2, 2, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 11)*pol_y(2, 2, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 12)*pol_y(1, 2, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 12)*pol_y(1, 2, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 12)*pol_y(2, 2, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 12)*pol_y(2, 2, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 13)*pol_y(1, 3, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 13)*pol_y(1, 3, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 13)*pol_y(2, 3, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 13)*pol_y(2, 3, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 14)*pol_y(1, 3, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 14)*pol_y(1, 3, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 14)*pol_y(2, 3, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 14)*pol_y(2, 3, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 15)*pol_y(1, 4, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 15)*pol_y(1, 4, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 15)*pol_y(2, 4, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 15)*pol_y(2, 4, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 4)*pol_y(1, 0, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 4)*pol_y(1, 0, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 4)*pol_y(2, 0, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 4)*pol_y(2, 0, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 5)*pol_y(1, 0, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 5)*pol_y(1, 0, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 5)*pol_y(2, 0, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 5)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 6)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 6)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 6)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 6)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 7)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 7)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 7)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 7)*pol_y(2, 1, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 8)*pol_y(1, 1, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 8)*pol_y(1, 1, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 8)*pol_y(2, 1, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 8)*pol_y(2, 1, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 9)*pol_y(1, 1, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 9)*pol_y(1, 1, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 9)*pol_y(2, 1, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 9)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 10)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 10)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 10)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 10)*pol_y(2, 2, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 11)*pol_y(1, 2, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 11)*pol_y(1, 2, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 11)*pol_y(2, 2, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 11)*pol_y(2, 2, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 12)*pol_y(1, 2, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 12)*pol_y(1, 2, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 12)*pol_y(2, 2, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 12)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 13)*pol_y(1, 3, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 13)*pol_y(1, 3, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 13)*pol_y(2, 3, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 13)*pol_y(2, 3, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 14)*pol_y(1, 3, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 14)*pol_y(1, 3, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 14)*pol_y(2, 3, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 14)*pol_y(2, 3, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 15)*pol_y(1, 4, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 15)*pol_y(1, 4, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 15)*pol_y(2, 4, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 15)*pol_y(2, 4, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - s01 = s01+coef_x(1, 4)*pol_x(4, ig) - s02 = s02+coef_x(2, 4)*pol_x(4, ig) - s03 = s03+coef_x(3, 4)*pol_x(4, ig) - s04 = s04+coef_x(4, 4)*pol_x(4, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + s01 = s01 + coef_x(1, 4)*pol_x(4, ig) + s02 = s02 + coef_x(2, 4)*pol_x(4, ig) + s03 = s03 + coef_x(3, 4)*pol_x(4, ig) + s04 = s04 + coef_x(4, 4)*pol_x(4, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -667,123 +667,123 @@ SUBROUTINE collocate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 5 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_xyz(lxyz)*pol_z(1, lzp, kg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_xyz(lxyz)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_xyz(lxyz)*pol_z(1, lzp, kg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_xyz(lxyz)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 1)*pol_y(1, 0, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 1)*pol_y(2, 0, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 2)*pol_y(1, 0, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 2)*pol_y(2, 0, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 3)*pol_y(1, 0, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 3)*pol_y(2, 0, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 4)*pol_y(1, 0, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 4)*pol_y(2, 0, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 5)*pol_y(1, 0, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 5)*pol_y(2, 0, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 6)*pol_y(1, 0, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 6)*pol_y(2, 0, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 7)*pol_y(1, 1, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 7)*pol_y(2, 1, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 8)*pol_y(1, 1, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 8)*pol_y(2, 1, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 9)*pol_y(1, 1, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 9)*pol_y(2, 1, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 10)*pol_y(1, 1, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 10)*pol_y(2, 1, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 11)*pol_y(1, 1, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 11)*pol_y(2, 1, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 12)*pol_y(1, 2, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 12)*pol_y(2, 2, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 13)*pol_y(1, 2, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 13)*pol_y(2, 2, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 14)*pol_y(1, 2, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 14)*pol_y(2, 2, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 15)*pol_y(1, 2, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 15)*pol_y(2, 2, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 16)*pol_y(1, 3, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 16)*pol_y(2, 3, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 17)*pol_y(1, 3, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 17)*pol_y(2, 3, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 18)*pol_y(1, 3, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 18)*pol_y(2, 3, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 19)*pol_y(1, 4, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 19)*pol_y(2, 4, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 20)*pol_y(1, 4, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 20)*pol_y(2, 4, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 21)*pol_y(1, 5, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 21)*pol_y(2, 5, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 1)*pol_y(1, 0, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 1)*pol_y(2, 0, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 2)*pol_y(1, 0, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 2)*pol_y(2, 0, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 3)*pol_y(1, 0, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 3)*pol_y(2, 0, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 4)*pol_y(1, 0, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 4)*pol_y(2, 0, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 5)*pol_y(1, 0, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 5)*pol_y(2, 0, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 6)*pol_y(1, 0, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 6)*pol_y(2, 0, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 7)*pol_y(1, 1, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 7)*pol_y(2, 1, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 8)*pol_y(1, 1, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 8)*pol_y(2, 1, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 9)*pol_y(1, 1, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 9)*pol_y(2, 1, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 10)*pol_y(1, 1, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 10)*pol_y(2, 1, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 11)*pol_y(1, 1, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 11)*pol_y(2, 1, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 12)*pol_y(1, 2, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 12)*pol_y(2, 2, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 13)*pol_y(1, 2, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 13)*pol_y(2, 2, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 14)*pol_y(1, 2, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 14)*pol_y(2, 2, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 15)*pol_y(1, 2, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 15)*pol_y(2, 2, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 16)*pol_y(1, 3, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 16)*pol_y(2, 3, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 17)*pol_y(1, 3, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 17)*pol_y(2, 3, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 18)*pol_y(1, 3, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 18)*pol_y(2, 3, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 19)*pol_y(1, 4, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 19)*pol_y(2, 4, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 20)*pol_y(1, 4, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 20)*pol_y(2, 4, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 21)*pol_y(1, 5, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 21)*pol_y(2, 5, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - s01 = s01+coef_x(1, 4)*pol_x(4, ig) - s02 = s02+coef_x(2, 4)*pol_x(4, ig) - s03 = s03+coef_x(3, 4)*pol_x(4, ig) - s04 = s04+coef_x(4, 4)*pol_x(4, ig) - s01 = s01+coef_x(1, 5)*pol_x(5, ig) - s02 = s02+coef_x(2, 5)*pol_x(5, ig) - s03 = s03+coef_x(3, 5)*pol_x(5, ig) - s04 = s04+coef_x(4, 5)*pol_x(5, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + s01 = s01 + coef_x(1, 4)*pol_x(4, ig) + s02 = s02 + coef_x(2, 4)*pol_x(4, ig) + s03 = s03 + coef_x(3, 4)*pol_x(4, ig) + s04 = s04 + coef_x(4, 4)*pol_x(4, ig) + s01 = s01 + coef_x(1, 5)*pol_x(5, ig) + s02 = s02 + coef_x(2, 5)*pol_x(5, ig) + s03 = s03 + coef_x(3, 5)*pol_x(5, ig) + s04 = s04 + coef_x(4, 5)*pol_x(5, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -810,268 +810,268 @@ SUBROUTINE collocate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 6 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(1)*pol_z(:, 0, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(2)*pol_z(:, 0, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(3)*pol_z(:, 0, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(4)*pol_z(:, 0, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(5)*pol_z(:, 0, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(6)*pol_z(:, 0, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(7)*pol_z(:, 0, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(8)*pol_z(:, 0, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(9)*pol_z(:, 0, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(10)*pol_z(:, 0, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(11)*pol_z(:, 0, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(12)*pol_z(:, 0, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(13)*pol_z(:, 0, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(14)*pol_z(:, 0, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(15)*pol_z(:, 0, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(16)*pol_z(:, 0, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(17)*pol_z(:, 0, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(18)*pol_z(:, 0, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(19)*pol_z(:, 0, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(20)*pol_z(:, 0, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(21)*pol_z(:, 0, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(22)*pol_z(:, 0, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(23)*pol_z(:, 0, kg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_xyz(24)*pol_z(:, 0, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(25)*pol_z(:, 0, kg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_xyz(26)*pol_z(:, 0, kg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_xyz(27)*pol_z(:, 0, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(28)*pol_z(:, 0, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(29)*pol_z(:, 1, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(30)*pol_z(:, 1, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(31)*pol_z(:, 1, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(32)*pol_z(:, 1, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(33)*pol_z(:, 1, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(34)*pol_z(:, 1, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(35)*pol_z(:, 1, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(36)*pol_z(:, 1, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(37)*pol_z(:, 1, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(38)*pol_z(:, 1, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(39)*pol_z(:, 1, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(40)*pol_z(:, 1, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(41)*pol_z(:, 1, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(42)*pol_z(:, 1, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(43)*pol_z(:, 1, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(44)*pol_z(:, 1, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(45)*pol_z(:, 1, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(46)*pol_z(:, 1, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(47)*pol_z(:, 1, kg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_xyz(48)*pol_z(:, 1, kg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_xyz(49)*pol_z(:, 1, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(50)*pol_z(:, 2, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(51)*pol_z(:, 2, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(52)*pol_z(:, 2, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(53)*pol_z(:, 2, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(54)*pol_z(:, 2, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(55)*pol_z(:, 2, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(56)*pol_z(:, 2, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(57)*pol_z(:, 2, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(58)*pol_z(:, 2, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(59)*pol_z(:, 2, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(60)*pol_z(:, 2, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(61)*pol_z(:, 2, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(62)*pol_z(:, 2, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(63)*pol_z(:, 2, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(64)*pol_z(:, 2, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(65)*pol_z(:, 3, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(66)*pol_z(:, 3, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(67)*pol_z(:, 3, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(68)*pol_z(:, 3, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(69)*pol_z(:, 3, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(70)*pol_z(:, 3, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(71)*pol_z(:, 3, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(72)*pol_z(:, 3, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(73)*pol_z(:, 3, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(74)*pol_z(:, 3, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(75)*pol_z(:, 4, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(76)*pol_z(:, 4, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(77)*pol_z(:, 4, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(78)*pol_z(:, 4, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(79)*pol_z(:, 4, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(80)*pol_z(:, 4, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(81)*pol_z(:, 5, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(82)*pol_z(:, 5, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(83)*pol_z(:, 5, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(84)*pol_z(:, 6, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(1)*pol_z(:, 0, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(2)*pol_z(:, 0, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(3)*pol_z(:, 0, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(4)*pol_z(:, 0, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(5)*pol_z(:, 0, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(6)*pol_z(:, 0, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(7)*pol_z(:, 0, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(8)*pol_z(:, 0, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(9)*pol_z(:, 0, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(10)*pol_z(:, 0, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(11)*pol_z(:, 0, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(12)*pol_z(:, 0, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(13)*pol_z(:, 0, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(14)*pol_z(:, 0, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(15)*pol_z(:, 0, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(16)*pol_z(:, 0, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(17)*pol_z(:, 0, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(18)*pol_z(:, 0, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(19)*pol_z(:, 0, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(20)*pol_z(:, 0, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(21)*pol_z(:, 0, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(22)*pol_z(:, 0, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(23)*pol_z(:, 0, kg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_xyz(24)*pol_z(:, 0, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(25)*pol_z(:, 0, kg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_xyz(26)*pol_z(:, 0, kg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_xyz(27)*pol_z(:, 0, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(28)*pol_z(:, 0, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(29)*pol_z(:, 1, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(30)*pol_z(:, 1, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(31)*pol_z(:, 1, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(32)*pol_z(:, 1, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(33)*pol_z(:, 1, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(34)*pol_z(:, 1, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(35)*pol_z(:, 1, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(36)*pol_z(:, 1, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(37)*pol_z(:, 1, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(38)*pol_z(:, 1, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(39)*pol_z(:, 1, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(40)*pol_z(:, 1, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(41)*pol_z(:, 1, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(42)*pol_z(:, 1, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(43)*pol_z(:, 1, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(44)*pol_z(:, 1, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(45)*pol_z(:, 1, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(46)*pol_z(:, 1, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(47)*pol_z(:, 1, kg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_xyz(48)*pol_z(:, 1, kg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_xyz(49)*pol_z(:, 1, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(50)*pol_z(:, 2, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(51)*pol_z(:, 2, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(52)*pol_z(:, 2, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(53)*pol_z(:, 2, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(54)*pol_z(:, 2, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(55)*pol_z(:, 2, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(56)*pol_z(:, 2, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(57)*pol_z(:, 2, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(58)*pol_z(:, 2, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(59)*pol_z(:, 2, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(60)*pol_z(:, 2, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(61)*pol_z(:, 2, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(62)*pol_z(:, 2, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(63)*pol_z(:, 2, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(64)*pol_z(:, 2, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(65)*pol_z(:, 3, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(66)*pol_z(:, 3, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(67)*pol_z(:, 3, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(68)*pol_z(:, 3, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(69)*pol_z(:, 3, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(70)*pol_z(:, 3, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(71)*pol_z(:, 3, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(72)*pol_z(:, 3, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(73)*pol_z(:, 3, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(74)*pol_z(:, 3, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(75)*pol_z(:, 4, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(76)*pol_z(:, 4, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(77)*pol_z(:, 4, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(78)*pol_z(:, 4, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(79)*pol_z(:, 4, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(80)*pol_z(:, 4, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(81)*pol_z(:, 5, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(82)*pol_z(:, 5, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(83)*pol_z(:, 5, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(84)*pol_z(:, 6, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 4)*pol_y(1, 0, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 4)*pol_y(1, 0, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 4)*pol_y(2, 0, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 4)*pol_y(2, 0, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 5)*pol_y(1, 0, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 5)*pol_y(1, 0, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 5)*pol_y(2, 0, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 5)*pol_y(2, 0, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 6)*pol_y(1, 0, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 6)*pol_y(1, 0, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 6)*pol_y(2, 0, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 6)*pol_y(2, 0, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 7)*pol_y(1, 0, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 7)*pol_y(1, 0, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 7)*pol_y(2, 0, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 7)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 8)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 8)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 8)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 8)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 9)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 9)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 9)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 9)*pol_y(2, 1, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 10)*pol_y(1, 1, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 10)*pol_y(1, 1, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 10)*pol_y(2, 1, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 10)*pol_y(2, 1, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 11)*pol_y(1, 1, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 11)*pol_y(1, 1, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 11)*pol_y(2, 1, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 11)*pol_y(2, 1, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 12)*pol_y(1, 1, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 12)*pol_y(1, 1, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 12)*pol_y(2, 1, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 12)*pol_y(2, 1, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 13)*pol_y(1, 1, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 13)*pol_y(1, 1, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 13)*pol_y(2, 1, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 13)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 14)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 14)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 14)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 14)*pol_y(2, 2, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 15)*pol_y(1, 2, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 15)*pol_y(1, 2, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 15)*pol_y(2, 2, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 15)*pol_y(2, 2, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 16)*pol_y(1, 2, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 16)*pol_y(1, 2, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 16)*pol_y(2, 2, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 16)*pol_y(2, 2, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 17)*pol_y(1, 2, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 17)*pol_y(1, 2, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 17)*pol_y(2, 2, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 17)*pol_y(2, 2, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 18)*pol_y(1, 2, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 18)*pol_y(1, 2, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 18)*pol_y(2, 2, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 18)*pol_y(2, 2, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 19)*pol_y(1, 3, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 19)*pol_y(1, 3, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 19)*pol_y(2, 3, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 19)*pol_y(2, 3, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 20)*pol_y(1, 3, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 20)*pol_y(1, 3, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 20)*pol_y(2, 3, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 20)*pol_y(2, 3, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 21)*pol_y(1, 3, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 21)*pol_y(1, 3, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 21)*pol_y(2, 3, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 21)*pol_y(2, 3, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 22)*pol_y(1, 3, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 22)*pol_y(1, 3, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 22)*pol_y(2, 3, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 22)*pol_y(2, 3, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 23)*pol_y(1, 4, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 23)*pol_y(1, 4, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 23)*pol_y(2, 4, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 23)*pol_y(2, 4, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 24)*pol_y(1, 4, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 24)*pol_y(1, 4, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 24)*pol_y(2, 4, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 24)*pol_y(2, 4, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 25)*pol_y(1, 4, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 25)*pol_y(1, 4, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 25)*pol_y(2, 4, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 25)*pol_y(2, 4, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 26)*pol_y(1, 5, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 26)*pol_y(1, 5, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 26)*pol_y(2, 5, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 26)*pol_y(2, 5, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 27)*pol_y(1, 5, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 27)*pol_y(1, 5, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 27)*pol_y(2, 5, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 27)*pol_y(2, 5, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 28)*pol_y(1, 6, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 28)*pol_y(1, 6, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 28)*pol_y(2, 6, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 28)*pol_y(2, 6, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 4)*pol_y(1, 0, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 4)*pol_y(1, 0, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 4)*pol_y(2, 0, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 4)*pol_y(2, 0, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 5)*pol_y(1, 0, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 5)*pol_y(1, 0, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 5)*pol_y(2, 0, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 5)*pol_y(2, 0, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 6)*pol_y(1, 0, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 6)*pol_y(1, 0, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 6)*pol_y(2, 0, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 6)*pol_y(2, 0, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 7)*pol_y(1, 0, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 7)*pol_y(1, 0, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 7)*pol_y(2, 0, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 7)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 8)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 8)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 8)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 8)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 9)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 9)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 9)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 9)*pol_y(2, 1, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 10)*pol_y(1, 1, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 10)*pol_y(1, 1, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 10)*pol_y(2, 1, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 10)*pol_y(2, 1, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 11)*pol_y(1, 1, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 11)*pol_y(1, 1, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 11)*pol_y(2, 1, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 11)*pol_y(2, 1, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 12)*pol_y(1, 1, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 12)*pol_y(1, 1, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 12)*pol_y(2, 1, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 12)*pol_y(2, 1, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 13)*pol_y(1, 1, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 13)*pol_y(1, 1, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 13)*pol_y(2, 1, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 13)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 14)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 14)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 14)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 14)*pol_y(2, 2, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 15)*pol_y(1, 2, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 15)*pol_y(1, 2, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 15)*pol_y(2, 2, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 15)*pol_y(2, 2, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 16)*pol_y(1, 2, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 16)*pol_y(1, 2, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 16)*pol_y(2, 2, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 16)*pol_y(2, 2, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 17)*pol_y(1, 2, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 17)*pol_y(1, 2, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 17)*pol_y(2, 2, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 17)*pol_y(2, 2, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 18)*pol_y(1, 2, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 18)*pol_y(1, 2, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 18)*pol_y(2, 2, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 18)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 19)*pol_y(1, 3, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 19)*pol_y(1, 3, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 19)*pol_y(2, 3, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 19)*pol_y(2, 3, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 20)*pol_y(1, 3, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 20)*pol_y(1, 3, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 20)*pol_y(2, 3, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 20)*pol_y(2, 3, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 21)*pol_y(1, 3, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 21)*pol_y(1, 3, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 21)*pol_y(2, 3, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 21)*pol_y(2, 3, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 22)*pol_y(1, 3, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 22)*pol_y(1, 3, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 22)*pol_y(2, 3, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 22)*pol_y(2, 3, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 23)*pol_y(1, 4, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 23)*pol_y(1, 4, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 23)*pol_y(2, 4, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 23)*pol_y(2, 4, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 24)*pol_y(1, 4, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 24)*pol_y(1, 4, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 24)*pol_y(2, 4, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 24)*pol_y(2, 4, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 25)*pol_y(1, 4, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 25)*pol_y(1, 4, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 25)*pol_y(2, 4, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 25)*pol_y(2, 4, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 26)*pol_y(1, 5, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 26)*pol_y(1, 5, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 26)*pol_y(2, 5, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 26)*pol_y(2, 5, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 27)*pol_y(1, 5, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 27)*pol_y(1, 5, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 27)*pol_y(2, 5, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 27)*pol_y(2, 5, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 28)*pol_y(1, 6, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 28)*pol_y(1, 6, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 28)*pol_y(2, 6, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 28)*pol_y(2, 6, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - s01 = s01+coef_x(1, 4)*pol_x(4, ig) - s02 = s02+coef_x(2, 4)*pol_x(4, ig) - s03 = s03+coef_x(3, 4)*pol_x(4, ig) - s04 = s04+coef_x(4, 4)*pol_x(4, ig) - s01 = s01+coef_x(1, 5)*pol_x(5, ig) - s02 = s02+coef_x(2, 5)*pol_x(5, ig) - s03 = s03+coef_x(3, 5)*pol_x(5, ig) - s04 = s04+coef_x(4, 5)*pol_x(5, ig) - s01 = s01+coef_x(1, 6)*pol_x(6, ig) - s02 = s02+coef_x(2, 6)*pol_x(6, ig) - s03 = s03+coef_x(3, 6)*pol_x(6, ig) - s04 = s04+coef_x(4, 6)*pol_x(6, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + s01 = s01 + coef_x(1, 4)*pol_x(4, ig) + s02 = s02 + coef_x(2, 4)*pol_x(4, ig) + s03 = s03 + coef_x(3, 4)*pol_x(4, ig) + s04 = s04 + coef_x(4, 4)*pol_x(4, ig) + s01 = s01 + coef_x(1, 5)*pol_x(5, ig) + s02 = s02 + coef_x(2, 5)*pol_x(5, ig) + s03 = s03 + coef_x(3, 5)*pol_x(5, ig) + s04 = s04 + coef_x(4, 5)*pol_x(5, ig) + s01 = s01 + coef_x(1, 6)*pol_x(6, ig) + s02 = s02 + coef_x(2, 6)*pol_x(6, ig) + s03 = s03 + coef_x(3, 6)*pol_x(6, ig) + s04 = s04 + coef_x(4, 6)*pol_x(6, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -1098,460 +1098,460 @@ SUBROUTINE collocate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 7 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(7)*pol_z(1, 0, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(7)*pol_z(2, 0, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(8)*pol_z(1, 0, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(8)*pol_z(2, 0, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(9)*pol_z(1, 0, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(9)*pol_z(2, 0, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(10)*pol_z(1, 0, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(10)*pol_z(2, 0, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(11)*pol_z(1, 0, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(11)*pol_z(2, 0, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(12)*pol_z(1, 0, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(12)*pol_z(2, 0, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(13)*pol_z(1, 0, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(13)*pol_z(2, 0, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(14)*pol_z(1, 0, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(14)*pol_z(2, 0, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(15)*pol_z(1, 0, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(15)*pol_z(2, 0, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(16)*pol_z(1, 0, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(16)*pol_z(2, 0, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(17)*pol_z(1, 0, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(17)*pol_z(2, 0, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(18)*pol_z(1, 0, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(18)*pol_z(2, 0, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(19)*pol_z(1, 0, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(19)*pol_z(2, 0, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(20)*pol_z(1, 0, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(20)*pol_z(2, 0, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(21)*pol_z(1, 0, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(21)*pol_z(2, 0, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(22)*pol_z(1, 0, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(22)*pol_z(2, 0, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(23)*pol_z(1, 0, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(23)*pol_z(2, 0, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(24)*pol_z(1, 0, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(24)*pol_z(2, 0, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(25)*pol_z(1, 0, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(25)*pol_z(2, 0, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(26)*pol_z(1, 0, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(26)*pol_z(2, 0, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(27)*pol_z(1, 0, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(27)*pol_z(2, 0, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(28)*pol_z(1, 0, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(28)*pol_z(2, 0, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(29)*pol_z(1, 0, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(29)*pol_z(2, 0, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(30)*pol_z(1, 0, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(30)*pol_z(2, 0, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(31)*pol_z(1, 0, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(31)*pol_z(2, 0, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(32)*pol_z(1, 0, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(32)*pol_z(2, 0, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(33)*pol_z(1, 0, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(33)*pol_z(2, 0, kg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_xyz(34)*pol_z(1, 0, kg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_xyz(34)*pol_z(2, 0, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(35)*pol_z(1, 0, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(35)*pol_z(2, 0, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(36)*pol_z(1, 0, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(36)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(37)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(37)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(38)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(38)*pol_z(2, 1, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(39)*pol_z(1, 1, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(39)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(40)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(40)*pol_z(2, 1, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(41)*pol_z(1, 1, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(41)*pol_z(2, 1, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(42)*pol_z(1, 1, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(42)*pol_z(2, 1, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(43)*pol_z(1, 1, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(43)*pol_z(2, 1, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(44)*pol_z(1, 1, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(44)*pol_z(2, 1, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(45)*pol_z(1, 1, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(45)*pol_z(2, 1, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(46)*pol_z(1, 1, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(46)*pol_z(2, 1, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(47)*pol_z(1, 1, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(47)*pol_z(2, 1, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(48)*pol_z(1, 1, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(48)*pol_z(2, 1, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(49)*pol_z(1, 1, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(49)*pol_z(2, 1, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(50)*pol_z(1, 1, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(50)*pol_z(2, 1, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(51)*pol_z(1, 1, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(51)*pol_z(2, 1, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(52)*pol_z(1, 1, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(52)*pol_z(2, 1, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(53)*pol_z(1, 1, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(53)*pol_z(2, 1, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(54)*pol_z(1, 1, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(54)*pol_z(2, 1, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(55)*pol_z(1, 1, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(55)*pol_z(2, 1, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(56)*pol_z(1, 1, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(56)*pol_z(2, 1, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(57)*pol_z(1, 1, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(57)*pol_z(2, 1, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(58)*pol_z(1, 1, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(58)*pol_z(2, 1, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(59)*pol_z(1, 1, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(59)*pol_z(2, 1, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(60)*pol_z(1, 1, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(60)*pol_z(2, 1, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(61)*pol_z(1, 1, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(61)*pol_z(2, 1, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(62)*pol_z(1, 1, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(62)*pol_z(2, 1, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(63)*pol_z(1, 1, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(63)*pol_z(2, 1, kg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_xyz(64)*pol_z(1, 1, kg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_xyz(64)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(65)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(65)*pol_z(2, 2, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(66)*pol_z(1, 2, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(66)*pol_z(2, 2, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(67)*pol_z(1, 2, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(67)*pol_z(2, 2, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(68)*pol_z(1, 2, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(68)*pol_z(2, 2, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(69)*pol_z(1, 2, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(69)*pol_z(2, 2, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(70)*pol_z(1, 2, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(70)*pol_z(2, 2, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(71)*pol_z(1, 2, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(71)*pol_z(2, 2, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(72)*pol_z(1, 2, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(72)*pol_z(2, 2, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(73)*pol_z(1, 2, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(73)*pol_z(2, 2, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(74)*pol_z(1, 2, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(74)*pol_z(2, 2, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(75)*pol_z(1, 2, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(75)*pol_z(2, 2, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(76)*pol_z(1, 2, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(76)*pol_z(2, 2, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(77)*pol_z(1, 2, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(77)*pol_z(2, 2, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(78)*pol_z(1, 2, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(78)*pol_z(2, 2, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(79)*pol_z(1, 2, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(79)*pol_z(2, 2, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(80)*pol_z(1, 2, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(80)*pol_z(2, 2, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(81)*pol_z(1, 2, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(81)*pol_z(2, 2, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(82)*pol_z(1, 2, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(82)*pol_z(2, 2, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(83)*pol_z(1, 2, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(83)*pol_z(2, 2, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(84)*pol_z(1, 2, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(84)*pol_z(2, 2, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(85)*pol_z(1, 2, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(85)*pol_z(2, 2, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(86)*pol_z(1, 3, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(86)*pol_z(2, 3, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(87)*pol_z(1, 3, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(87)*pol_z(2, 3, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(88)*pol_z(1, 3, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(88)*pol_z(2, 3, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(89)*pol_z(1, 3, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(89)*pol_z(2, 3, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(90)*pol_z(1, 3, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(90)*pol_z(2, 3, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(91)*pol_z(1, 3, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(91)*pol_z(2, 3, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(92)*pol_z(1, 3, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(92)*pol_z(2, 3, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(93)*pol_z(1, 3, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(93)*pol_z(2, 3, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(94)*pol_z(1, 3, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(94)*pol_z(2, 3, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(95)*pol_z(1, 3, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(95)*pol_z(2, 3, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(96)*pol_z(1, 3, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(96)*pol_z(2, 3, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(97)*pol_z(1, 3, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(97)*pol_z(2, 3, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(98)*pol_z(1, 3, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(98)*pol_z(2, 3, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(99)*pol_z(1, 3, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(99)*pol_z(2, 3, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(100)*pol_z(1, 3, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(100)*pol_z(2, 3, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(101)*pol_z(1, 4, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(101)*pol_z(2, 4, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(102)*pol_z(1, 4, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(102)*pol_z(2, 4, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(103)*pol_z(1, 4, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(103)*pol_z(2, 4, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(104)*pol_z(1, 4, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(104)*pol_z(2, 4, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(105)*pol_z(1, 4, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(105)*pol_z(2, 4, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(106)*pol_z(1, 4, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(106)*pol_z(2, 4, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(107)*pol_z(1, 4, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(107)*pol_z(2, 4, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(108)*pol_z(1, 4, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(108)*pol_z(2, 4, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(109)*pol_z(1, 4, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(109)*pol_z(2, 4, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(110)*pol_z(1, 4, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(110)*pol_z(2, 4, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(111)*pol_z(1, 5, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(111)*pol_z(2, 5, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(112)*pol_z(1, 5, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(112)*pol_z(2, 5, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(113)*pol_z(1, 5, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(113)*pol_z(2, 5, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(114)*pol_z(1, 5, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(114)*pol_z(2, 5, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(115)*pol_z(1, 5, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(115)*pol_z(2, 5, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(116)*pol_z(1, 5, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(116)*pol_z(2, 5, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(117)*pol_z(1, 6, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(117)*pol_z(2, 6, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(118)*pol_z(1, 6, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(118)*pol_z(2, 6, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(119)*pol_z(1, 6, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(119)*pol_z(2, 6, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(120)*pol_z(1, 7, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(120)*pol_z(2, 7, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(7)*pol_z(1, 0, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(7)*pol_z(2, 0, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(8)*pol_z(1, 0, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(8)*pol_z(2, 0, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(9)*pol_z(1, 0, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(9)*pol_z(2, 0, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(10)*pol_z(1, 0, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(10)*pol_z(2, 0, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(11)*pol_z(1, 0, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(11)*pol_z(2, 0, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(12)*pol_z(1, 0, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(12)*pol_z(2, 0, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(13)*pol_z(1, 0, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(13)*pol_z(2, 0, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(14)*pol_z(1, 0, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(14)*pol_z(2, 0, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(15)*pol_z(1, 0, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(15)*pol_z(2, 0, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(16)*pol_z(1, 0, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(16)*pol_z(2, 0, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(17)*pol_z(1, 0, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(17)*pol_z(2, 0, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(18)*pol_z(1, 0, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(18)*pol_z(2, 0, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(19)*pol_z(1, 0, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(19)*pol_z(2, 0, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(20)*pol_z(1, 0, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(20)*pol_z(2, 0, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(21)*pol_z(1, 0, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(21)*pol_z(2, 0, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(22)*pol_z(1, 0, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(22)*pol_z(2, 0, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(23)*pol_z(1, 0, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(23)*pol_z(2, 0, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(24)*pol_z(1, 0, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(24)*pol_z(2, 0, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(25)*pol_z(1, 0, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(25)*pol_z(2, 0, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(26)*pol_z(1, 0, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(26)*pol_z(2, 0, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(27)*pol_z(1, 0, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(27)*pol_z(2, 0, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(28)*pol_z(1, 0, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(28)*pol_z(2, 0, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(29)*pol_z(1, 0, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(29)*pol_z(2, 0, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(30)*pol_z(1, 0, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(30)*pol_z(2, 0, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(31)*pol_z(1, 0, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(31)*pol_z(2, 0, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(32)*pol_z(1, 0, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(32)*pol_z(2, 0, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(33)*pol_z(1, 0, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(33)*pol_z(2, 0, kg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_xyz(34)*pol_z(1, 0, kg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_xyz(34)*pol_z(2, 0, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(35)*pol_z(1, 0, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(35)*pol_z(2, 0, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(36)*pol_z(1, 0, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(36)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(37)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(37)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(38)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(38)*pol_z(2, 1, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(39)*pol_z(1, 1, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(39)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(40)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(40)*pol_z(2, 1, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(41)*pol_z(1, 1, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(41)*pol_z(2, 1, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(42)*pol_z(1, 1, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(42)*pol_z(2, 1, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(43)*pol_z(1, 1, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(43)*pol_z(2, 1, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(44)*pol_z(1, 1, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(44)*pol_z(2, 1, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(45)*pol_z(1, 1, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(45)*pol_z(2, 1, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(46)*pol_z(1, 1, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(46)*pol_z(2, 1, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(47)*pol_z(1, 1, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(47)*pol_z(2, 1, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(48)*pol_z(1, 1, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(48)*pol_z(2, 1, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(49)*pol_z(1, 1, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(49)*pol_z(2, 1, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(50)*pol_z(1, 1, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(50)*pol_z(2, 1, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(51)*pol_z(1, 1, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(51)*pol_z(2, 1, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(52)*pol_z(1, 1, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(52)*pol_z(2, 1, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(53)*pol_z(1, 1, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(53)*pol_z(2, 1, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(54)*pol_z(1, 1, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(54)*pol_z(2, 1, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(55)*pol_z(1, 1, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(55)*pol_z(2, 1, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(56)*pol_z(1, 1, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(56)*pol_z(2, 1, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(57)*pol_z(1, 1, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(57)*pol_z(2, 1, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(58)*pol_z(1, 1, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(58)*pol_z(2, 1, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(59)*pol_z(1, 1, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(59)*pol_z(2, 1, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(60)*pol_z(1, 1, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(60)*pol_z(2, 1, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(61)*pol_z(1, 1, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(61)*pol_z(2, 1, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(62)*pol_z(1, 1, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(62)*pol_z(2, 1, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(63)*pol_z(1, 1, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(63)*pol_z(2, 1, kg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_xyz(64)*pol_z(1, 1, kg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_xyz(64)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(65)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(65)*pol_z(2, 2, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(66)*pol_z(1, 2, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(66)*pol_z(2, 2, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(67)*pol_z(1, 2, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(67)*pol_z(2, 2, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(68)*pol_z(1, 2, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(68)*pol_z(2, 2, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(69)*pol_z(1, 2, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(69)*pol_z(2, 2, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(70)*pol_z(1, 2, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(70)*pol_z(2, 2, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(71)*pol_z(1, 2, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(71)*pol_z(2, 2, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(72)*pol_z(1, 2, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(72)*pol_z(2, 2, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(73)*pol_z(1, 2, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(73)*pol_z(2, 2, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(74)*pol_z(1, 2, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(74)*pol_z(2, 2, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(75)*pol_z(1, 2, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(75)*pol_z(2, 2, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(76)*pol_z(1, 2, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(76)*pol_z(2, 2, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(77)*pol_z(1, 2, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(77)*pol_z(2, 2, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(78)*pol_z(1, 2, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(78)*pol_z(2, 2, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(79)*pol_z(1, 2, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(79)*pol_z(2, 2, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(80)*pol_z(1, 2, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(80)*pol_z(2, 2, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(81)*pol_z(1, 2, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(81)*pol_z(2, 2, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(82)*pol_z(1, 2, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(82)*pol_z(2, 2, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(83)*pol_z(1, 2, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(83)*pol_z(2, 2, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(84)*pol_z(1, 2, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(84)*pol_z(2, 2, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(85)*pol_z(1, 2, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(85)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(86)*pol_z(1, 3, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(86)*pol_z(2, 3, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(87)*pol_z(1, 3, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(87)*pol_z(2, 3, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(88)*pol_z(1, 3, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(88)*pol_z(2, 3, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(89)*pol_z(1, 3, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(89)*pol_z(2, 3, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(90)*pol_z(1, 3, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(90)*pol_z(2, 3, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(91)*pol_z(1, 3, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(91)*pol_z(2, 3, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(92)*pol_z(1, 3, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(92)*pol_z(2, 3, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(93)*pol_z(1, 3, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(93)*pol_z(2, 3, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(94)*pol_z(1, 3, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(94)*pol_z(2, 3, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(95)*pol_z(1, 3, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(95)*pol_z(2, 3, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(96)*pol_z(1, 3, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(96)*pol_z(2, 3, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(97)*pol_z(1, 3, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(97)*pol_z(2, 3, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(98)*pol_z(1, 3, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(98)*pol_z(2, 3, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(99)*pol_z(1, 3, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(99)*pol_z(2, 3, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(100)*pol_z(1, 3, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(100)*pol_z(2, 3, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(101)*pol_z(1, 4, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(101)*pol_z(2, 4, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(102)*pol_z(1, 4, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(102)*pol_z(2, 4, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(103)*pol_z(1, 4, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(103)*pol_z(2, 4, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(104)*pol_z(1, 4, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(104)*pol_z(2, 4, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(105)*pol_z(1, 4, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(105)*pol_z(2, 4, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(106)*pol_z(1, 4, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(106)*pol_z(2, 4, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(107)*pol_z(1, 4, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(107)*pol_z(2, 4, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(108)*pol_z(1, 4, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(108)*pol_z(2, 4, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(109)*pol_z(1, 4, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(109)*pol_z(2, 4, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(110)*pol_z(1, 4, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(110)*pol_z(2, 4, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(111)*pol_z(1, 5, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(111)*pol_z(2, 5, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(112)*pol_z(1, 5, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(112)*pol_z(2, 5, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(113)*pol_z(1, 5, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(113)*pol_z(2, 5, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(114)*pol_z(1, 5, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(114)*pol_z(2, 5, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(115)*pol_z(1, 5, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(115)*pol_z(2, 5, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(116)*pol_z(1, 5, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(116)*pol_z(2, 5, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(117)*pol_z(1, 6, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(117)*pol_z(2, 6, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(118)*pol_z(1, 6, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(118)*pol_z(2, 6, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(119)*pol_z(1, 6, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(119)*pol_z(2, 6, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(120)*pol_z(1, 7, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(120)*pol_z(2, 7, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 4)*pol_y(1, 0, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 4)*pol_y(1, 0, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 4)*pol_y(2, 0, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 4)*pol_y(2, 0, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 5)*pol_y(1, 0, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 5)*pol_y(1, 0, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 5)*pol_y(2, 0, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 5)*pol_y(2, 0, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 6)*pol_y(1, 0, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 6)*pol_y(1, 0, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 6)*pol_y(2, 0, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 6)*pol_y(2, 0, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 7)*pol_y(1, 0, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 7)*pol_y(1, 0, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 7)*pol_y(2, 0, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 7)*pol_y(2, 0, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 8)*pol_y(1, 0, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 8)*pol_y(1, 0, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 8)*pol_y(2, 0, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 8)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 9)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 9)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 9)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 9)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 10)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 10)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 10)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 10)*pol_y(2, 1, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 11)*pol_y(1, 1, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 11)*pol_y(1, 1, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 11)*pol_y(2, 1, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 11)*pol_y(2, 1, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 12)*pol_y(1, 1, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 12)*pol_y(1, 1, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 12)*pol_y(2, 1, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 12)*pol_y(2, 1, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 13)*pol_y(1, 1, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 13)*pol_y(1, 1, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 13)*pol_y(2, 1, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 13)*pol_y(2, 1, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 14)*pol_y(1, 1, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 14)*pol_y(1, 1, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 14)*pol_y(2, 1, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 14)*pol_y(2, 1, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 15)*pol_y(1, 1, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 15)*pol_y(1, 1, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 15)*pol_y(2, 1, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 15)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 16)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 16)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 16)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 16)*pol_y(2, 2, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 17)*pol_y(1, 2, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 17)*pol_y(1, 2, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 17)*pol_y(2, 2, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 17)*pol_y(2, 2, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 18)*pol_y(1, 2, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 18)*pol_y(1, 2, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 18)*pol_y(2, 2, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 18)*pol_y(2, 2, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 19)*pol_y(1, 2, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 19)*pol_y(1, 2, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 19)*pol_y(2, 2, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 19)*pol_y(2, 2, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 20)*pol_y(1, 2, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 20)*pol_y(1, 2, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 20)*pol_y(2, 2, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 20)*pol_y(2, 2, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 21)*pol_y(1, 2, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 21)*pol_y(1, 2, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 21)*pol_y(2, 2, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 21)*pol_y(2, 2, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 22)*pol_y(1, 3, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 22)*pol_y(1, 3, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 22)*pol_y(2, 3, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 22)*pol_y(2, 3, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 23)*pol_y(1, 3, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 23)*pol_y(1, 3, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 23)*pol_y(2, 3, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 23)*pol_y(2, 3, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 24)*pol_y(1, 3, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 24)*pol_y(1, 3, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 24)*pol_y(2, 3, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 24)*pol_y(2, 3, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 25)*pol_y(1, 3, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 25)*pol_y(1, 3, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 25)*pol_y(2, 3, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 25)*pol_y(2, 3, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 26)*pol_y(1, 3, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 26)*pol_y(1, 3, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 26)*pol_y(2, 3, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 26)*pol_y(2, 3, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 27)*pol_y(1, 4, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 27)*pol_y(1, 4, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 27)*pol_y(2, 4, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 27)*pol_y(2, 4, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 28)*pol_y(1, 4, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 28)*pol_y(1, 4, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 28)*pol_y(2, 4, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 28)*pol_y(2, 4, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 29)*pol_y(1, 4, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 29)*pol_y(1, 4, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 29)*pol_y(2, 4, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 29)*pol_y(2, 4, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 30)*pol_y(1, 4, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 30)*pol_y(1, 4, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 30)*pol_y(2, 4, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 30)*pol_y(2, 4, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 31)*pol_y(1, 5, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 31)*pol_y(1, 5, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 31)*pol_y(2, 5, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 31)*pol_y(2, 5, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 32)*pol_y(1, 5, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 32)*pol_y(1, 5, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 32)*pol_y(2, 5, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 32)*pol_y(2, 5, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 33)*pol_y(1, 5, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 33)*pol_y(1, 5, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 33)*pol_y(2, 5, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 33)*pol_y(2, 5, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 34)*pol_y(1, 6, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 34)*pol_y(1, 6, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 34)*pol_y(2, 6, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 34)*pol_y(2, 6, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 35)*pol_y(1, 6, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 35)*pol_y(1, 6, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 35)*pol_y(2, 6, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 35)*pol_y(2, 6, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 36)*pol_y(1, 7, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 36)*pol_y(1, 7, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 36)*pol_y(2, 7, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 36)*pol_y(2, 7, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 4)*pol_y(1, 0, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 4)*pol_y(1, 0, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 4)*pol_y(2, 0, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 4)*pol_y(2, 0, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 5)*pol_y(1, 0, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 5)*pol_y(1, 0, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 5)*pol_y(2, 0, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 5)*pol_y(2, 0, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 6)*pol_y(1, 0, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 6)*pol_y(1, 0, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 6)*pol_y(2, 0, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 6)*pol_y(2, 0, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 7)*pol_y(1, 0, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 7)*pol_y(1, 0, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 7)*pol_y(2, 0, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 7)*pol_y(2, 0, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 8)*pol_y(1, 0, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 8)*pol_y(1, 0, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 8)*pol_y(2, 0, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 8)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 9)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 9)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 9)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 9)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 10)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 10)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 10)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 10)*pol_y(2, 1, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 11)*pol_y(1, 1, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 11)*pol_y(1, 1, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 11)*pol_y(2, 1, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 11)*pol_y(2, 1, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 12)*pol_y(1, 1, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 12)*pol_y(1, 1, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 12)*pol_y(2, 1, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 12)*pol_y(2, 1, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 13)*pol_y(1, 1, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 13)*pol_y(1, 1, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 13)*pol_y(2, 1, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 13)*pol_y(2, 1, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 14)*pol_y(1, 1, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 14)*pol_y(1, 1, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 14)*pol_y(2, 1, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 14)*pol_y(2, 1, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 15)*pol_y(1, 1, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 15)*pol_y(1, 1, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 15)*pol_y(2, 1, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 15)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 16)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 16)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 16)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 16)*pol_y(2, 2, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 17)*pol_y(1, 2, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 17)*pol_y(1, 2, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 17)*pol_y(2, 2, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 17)*pol_y(2, 2, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 18)*pol_y(1, 2, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 18)*pol_y(1, 2, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 18)*pol_y(2, 2, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 18)*pol_y(2, 2, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 19)*pol_y(1, 2, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 19)*pol_y(1, 2, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 19)*pol_y(2, 2, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 19)*pol_y(2, 2, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 20)*pol_y(1, 2, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 20)*pol_y(1, 2, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 20)*pol_y(2, 2, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 20)*pol_y(2, 2, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 21)*pol_y(1, 2, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 21)*pol_y(1, 2, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 21)*pol_y(2, 2, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 21)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 22)*pol_y(1, 3, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 22)*pol_y(1, 3, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 22)*pol_y(2, 3, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 22)*pol_y(2, 3, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 23)*pol_y(1, 3, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 23)*pol_y(1, 3, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 23)*pol_y(2, 3, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 23)*pol_y(2, 3, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 24)*pol_y(1, 3, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 24)*pol_y(1, 3, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 24)*pol_y(2, 3, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 24)*pol_y(2, 3, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 25)*pol_y(1, 3, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 25)*pol_y(1, 3, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 25)*pol_y(2, 3, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 25)*pol_y(2, 3, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 26)*pol_y(1, 3, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 26)*pol_y(1, 3, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 26)*pol_y(2, 3, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 26)*pol_y(2, 3, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 27)*pol_y(1, 4, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 27)*pol_y(1, 4, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 27)*pol_y(2, 4, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 27)*pol_y(2, 4, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 28)*pol_y(1, 4, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 28)*pol_y(1, 4, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 28)*pol_y(2, 4, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 28)*pol_y(2, 4, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 29)*pol_y(1, 4, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 29)*pol_y(1, 4, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 29)*pol_y(2, 4, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 29)*pol_y(2, 4, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 30)*pol_y(1, 4, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 30)*pol_y(1, 4, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 30)*pol_y(2, 4, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 30)*pol_y(2, 4, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 31)*pol_y(1, 5, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 31)*pol_y(1, 5, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 31)*pol_y(2, 5, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 31)*pol_y(2, 5, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 32)*pol_y(1, 5, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 32)*pol_y(1, 5, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 32)*pol_y(2, 5, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 32)*pol_y(2, 5, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 33)*pol_y(1, 5, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 33)*pol_y(1, 5, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 33)*pol_y(2, 5, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 33)*pol_y(2, 5, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 34)*pol_y(1, 6, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 34)*pol_y(1, 6, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 34)*pol_y(2, 6, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 34)*pol_y(2, 6, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 35)*pol_y(1, 6, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 35)*pol_y(1, 6, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 35)*pol_y(2, 6, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 35)*pol_y(2, 6, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 36)*pol_y(1, 7, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 36)*pol_y(1, 7, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 36)*pol_y(2, 7, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 36)*pol_y(2, 7, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - s01 = s01+coef_x(1, 4)*pol_x(4, ig) - s02 = s02+coef_x(2, 4)*pol_x(4, ig) - s03 = s03+coef_x(3, 4)*pol_x(4, ig) - s04 = s04+coef_x(4, 4)*pol_x(4, ig) - s01 = s01+coef_x(1, 5)*pol_x(5, ig) - s02 = s02+coef_x(2, 5)*pol_x(5, ig) - s03 = s03+coef_x(3, 5)*pol_x(5, ig) - s04 = s04+coef_x(4, 5)*pol_x(5, ig) - s01 = s01+coef_x(1, 6)*pol_x(6, ig) - s02 = s02+coef_x(2, 6)*pol_x(6, ig) - s03 = s03+coef_x(3, 6)*pol_x(6, ig) - s04 = s04+coef_x(4, 6)*pol_x(6, ig) - s01 = s01+coef_x(1, 7)*pol_x(7, ig) - s02 = s02+coef_x(2, 7)*pol_x(7, ig) - s03 = s03+coef_x(3, 7)*pol_x(7, ig) - s04 = s04+coef_x(4, 7)*pol_x(7, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + s01 = s01 + coef_x(1, 4)*pol_x(4, ig) + s02 = s02 + coef_x(2, 4)*pol_x(4, ig) + s03 = s03 + coef_x(3, 4)*pol_x(4, ig) + s04 = s04 + coef_x(4, 4)*pol_x(4, ig) + s01 = s01 + coef_x(1, 5)*pol_x(5, ig) + s02 = s02 + coef_x(2, 5)*pol_x(5, ig) + s03 = s03 + coef_x(3, 5)*pol_x(5, ig) + s04 = s04 + coef_x(4, 5)*pol_x(5, ig) + s01 = s01 + coef_x(1, 6)*pol_x(6, ig) + s02 = s02 + coef_x(2, 6)*pol_x(6, ig) + s03 = s03 + coef_x(3, 6)*pol_x(6, ig) + s04 = s04 + coef_x(4, 6)*pol_x(6, ig) + s01 = s01 + coef_x(1, 7)*pol_x(7, ig) + s02 = s02 + coef_x(2, 7)*pol_x(7, ig) + s03 = s03 + coef_x(3, 7)*pol_x(7, ig) + s04 = s04 + coef_x(4, 7)*pol_x(7, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -1578,590 +1578,590 @@ SUBROUTINE collocate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 8 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(7)*pol_z(1, 0, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(7)*pol_z(2, 0, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(8)*pol_z(1, 0, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(8)*pol_z(2, 0, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(9)*pol_z(1, 0, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(9)*pol_z(2, 0, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(10)*pol_z(1, 0, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(10)*pol_z(2, 0, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(11)*pol_z(1, 0, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(11)*pol_z(2, 0, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(12)*pol_z(1, 0, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(12)*pol_z(2, 0, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(13)*pol_z(1, 0, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(13)*pol_z(2, 0, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(14)*pol_z(1, 0, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(14)*pol_z(2, 0, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(15)*pol_z(1, 0, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(15)*pol_z(2, 0, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(16)*pol_z(1, 0, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(16)*pol_z(2, 0, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(17)*pol_z(1, 0, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(17)*pol_z(2, 0, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(18)*pol_z(1, 0, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(18)*pol_z(2, 0, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(19)*pol_z(1, 0, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(19)*pol_z(2, 0, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(20)*pol_z(1, 0, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(20)*pol_z(2, 0, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(21)*pol_z(1, 0, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(21)*pol_z(2, 0, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(22)*pol_z(1, 0, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(22)*pol_z(2, 0, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(23)*pol_z(1, 0, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(23)*pol_z(2, 0, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(24)*pol_z(1, 0, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(24)*pol_z(2, 0, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(25)*pol_z(1, 0, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(25)*pol_z(2, 0, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(26)*pol_z(1, 0, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(26)*pol_z(2, 0, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(27)*pol_z(1, 0, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(27)*pol_z(2, 0, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(28)*pol_z(1, 0, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(28)*pol_z(2, 0, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(29)*pol_z(1, 0, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(29)*pol_z(2, 0, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(30)*pol_z(1, 0, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(30)*pol_z(2, 0, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(31)*pol_z(1, 0, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(31)*pol_z(2, 0, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(32)*pol_z(1, 0, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(32)*pol_z(2, 0, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(33)*pol_z(1, 0, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(33)*pol_z(2, 0, kg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_xyz(34)*pol_z(1, 0, kg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_xyz(34)*pol_z(2, 0, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(35)*pol_z(1, 0, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(35)*pol_z(2, 0, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(36)*pol_z(1, 0, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(36)*pol_z(2, 0, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(37)*pol_z(1, 0, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(37)*pol_z(2, 0, kg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_xyz(38)*pol_z(1, 0, kg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_xyz(38)*pol_z(2, 0, kg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_xyz(39)*pol_z(1, 0, kg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_xyz(39)*pol_z(2, 0, kg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_xyz(40)*pol_z(1, 0, kg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_xyz(40)*pol_z(2, 0, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(41)*pol_z(1, 0, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(41)*pol_z(2, 0, kg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_xyz(42)*pol_z(1, 0, kg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_xyz(42)*pol_z(2, 0, kg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_xyz(43)*pol_z(1, 0, kg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_xyz(43)*pol_z(2, 0, kg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_xyz(44)*pol_z(1, 0, kg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_xyz(44)*pol_z(2, 0, kg) - coef_xy(1, 45) = coef_xy(1, 45)+coef_xyz(45)*pol_z(1, 0, kg) - coef_xy(2, 45) = coef_xy(2, 45)+coef_xyz(45)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(46)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(46)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(47)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(47)*pol_z(2, 1, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(48)*pol_z(1, 1, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(48)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(49)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(49)*pol_z(2, 1, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(50)*pol_z(1, 1, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(50)*pol_z(2, 1, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(51)*pol_z(1, 1, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(51)*pol_z(2, 1, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(52)*pol_z(1, 1, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(52)*pol_z(2, 1, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(53)*pol_z(1, 1, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(53)*pol_z(2, 1, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(54)*pol_z(1, 1, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(54)*pol_z(2, 1, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(55)*pol_z(1, 1, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(55)*pol_z(2, 1, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(56)*pol_z(1, 1, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(56)*pol_z(2, 1, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(57)*pol_z(1, 1, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(57)*pol_z(2, 1, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(58)*pol_z(1, 1, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(58)*pol_z(2, 1, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(59)*pol_z(1, 1, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(59)*pol_z(2, 1, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(60)*pol_z(1, 1, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(60)*pol_z(2, 1, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(61)*pol_z(1, 1, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(61)*pol_z(2, 1, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(62)*pol_z(1, 1, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(62)*pol_z(2, 1, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(63)*pol_z(1, 1, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(63)*pol_z(2, 1, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(64)*pol_z(1, 1, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(64)*pol_z(2, 1, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(65)*pol_z(1, 1, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(65)*pol_z(2, 1, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(66)*pol_z(1, 1, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(66)*pol_z(2, 1, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(67)*pol_z(1, 1, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(67)*pol_z(2, 1, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(68)*pol_z(1, 1, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(68)*pol_z(2, 1, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(69)*pol_z(1, 1, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(69)*pol_z(2, 1, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(70)*pol_z(1, 1, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(70)*pol_z(2, 1, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(71)*pol_z(1, 1, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(71)*pol_z(2, 1, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(72)*pol_z(1, 1, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(72)*pol_z(2, 1, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(73)*pol_z(1, 1, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(73)*pol_z(2, 1, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(74)*pol_z(1, 1, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(74)*pol_z(2, 1, kg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_xyz(75)*pol_z(1, 1, kg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_xyz(75)*pol_z(2, 1, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(76)*pol_z(1, 1, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(76)*pol_z(2, 1, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(77)*pol_z(1, 1, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(77)*pol_z(2, 1, kg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_xyz(78)*pol_z(1, 1, kg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_xyz(78)*pol_z(2, 1, kg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_xyz(79)*pol_z(1, 1, kg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_xyz(79)*pol_z(2, 1, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(80)*pol_z(1, 1, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(80)*pol_z(2, 1, kg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_xyz(81)*pol_z(1, 1, kg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_xyz(81)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(82)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(82)*pol_z(2, 2, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(83)*pol_z(1, 2, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(83)*pol_z(2, 2, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(84)*pol_z(1, 2, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(84)*pol_z(2, 2, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(85)*pol_z(1, 2, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(85)*pol_z(2, 2, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(86)*pol_z(1, 2, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(86)*pol_z(2, 2, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(87)*pol_z(1, 2, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(87)*pol_z(2, 2, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(88)*pol_z(1, 2, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(88)*pol_z(2, 2, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(89)*pol_z(1, 2, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(89)*pol_z(2, 2, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(90)*pol_z(1, 2, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(90)*pol_z(2, 2, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(91)*pol_z(1, 2, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(91)*pol_z(2, 2, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(92)*pol_z(1, 2, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(92)*pol_z(2, 2, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(93)*pol_z(1, 2, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(93)*pol_z(2, 2, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(94)*pol_z(1, 2, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(94)*pol_z(2, 2, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(95)*pol_z(1, 2, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(95)*pol_z(2, 2, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(96)*pol_z(1, 2, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(96)*pol_z(2, 2, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(97)*pol_z(1, 2, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(97)*pol_z(2, 2, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(98)*pol_z(1, 2, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(98)*pol_z(2, 2, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(99)*pol_z(1, 2, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(99)*pol_z(2, 2, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(100)*pol_z(1, 2, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(100)*pol_z(2, 2, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(101)*pol_z(1, 2, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(101)*pol_z(2, 2, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(102)*pol_z(1, 2, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(102)*pol_z(2, 2, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(103)*pol_z(1, 2, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(103)*pol_z(2, 2, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(104)*pol_z(1, 2, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(104)*pol_z(2, 2, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(105)*pol_z(1, 2, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(105)*pol_z(2, 2, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(106)*pol_z(1, 2, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(106)*pol_z(2, 2, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(107)*pol_z(1, 2, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(107)*pol_z(2, 2, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(108)*pol_z(1, 2, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(108)*pol_z(2, 2, kg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_xyz(109)*pol_z(1, 2, kg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_xyz(109)*pol_z(2, 2, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(110)*pol_z(1, 3, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(110)*pol_z(2, 3, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(111)*pol_z(1, 3, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(111)*pol_z(2, 3, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(112)*pol_z(1, 3, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(112)*pol_z(2, 3, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(113)*pol_z(1, 3, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(113)*pol_z(2, 3, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(114)*pol_z(1, 3, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(114)*pol_z(2, 3, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(115)*pol_z(1, 3, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(115)*pol_z(2, 3, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(116)*pol_z(1, 3, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(116)*pol_z(2, 3, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(117)*pol_z(1, 3, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(117)*pol_z(2, 3, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(118)*pol_z(1, 3, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(118)*pol_z(2, 3, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(119)*pol_z(1, 3, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(119)*pol_z(2, 3, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(120)*pol_z(1, 3, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(120)*pol_z(2, 3, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(121)*pol_z(1, 3, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(121)*pol_z(2, 3, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(122)*pol_z(1, 3, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(122)*pol_z(2, 3, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(123)*pol_z(1, 3, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(123)*pol_z(2, 3, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(124)*pol_z(1, 3, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(124)*pol_z(2, 3, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(125)*pol_z(1, 3, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(125)*pol_z(2, 3, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(126)*pol_z(1, 3, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(126)*pol_z(2, 3, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(127)*pol_z(1, 3, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(127)*pol_z(2, 3, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(128)*pol_z(1, 3, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(128)*pol_z(2, 3, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(129)*pol_z(1, 3, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(129)*pol_z(2, 3, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(130)*pol_z(1, 3, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(130)*pol_z(2, 3, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(131)*pol_z(1, 4, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(131)*pol_z(2, 4, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(132)*pol_z(1, 4, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(132)*pol_z(2, 4, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(133)*pol_z(1, 4, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(133)*pol_z(2, 4, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(134)*pol_z(1, 4, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(134)*pol_z(2, 4, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(135)*pol_z(1, 4, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(135)*pol_z(2, 4, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(136)*pol_z(1, 4, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(136)*pol_z(2, 4, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(137)*pol_z(1, 4, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(137)*pol_z(2, 4, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(138)*pol_z(1, 4, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(138)*pol_z(2, 4, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(139)*pol_z(1, 4, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(139)*pol_z(2, 4, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(140)*pol_z(1, 4, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(140)*pol_z(2, 4, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(141)*pol_z(1, 4, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(141)*pol_z(2, 4, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(142)*pol_z(1, 4, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(142)*pol_z(2, 4, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(143)*pol_z(1, 4, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(143)*pol_z(2, 4, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(144)*pol_z(1, 4, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(144)*pol_z(2, 4, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(145)*pol_z(1, 4, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(145)*pol_z(2, 4, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(146)*pol_z(1, 5, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(146)*pol_z(2, 5, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(147)*pol_z(1, 5, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(147)*pol_z(2, 5, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(148)*pol_z(1, 5, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(148)*pol_z(2, 5, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(149)*pol_z(1, 5, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(149)*pol_z(2, 5, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(150)*pol_z(1, 5, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(150)*pol_z(2, 5, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(151)*pol_z(1, 5, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(151)*pol_z(2, 5, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(152)*pol_z(1, 5, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(152)*pol_z(2, 5, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(153)*pol_z(1, 5, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(153)*pol_z(2, 5, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(154)*pol_z(1, 5, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(154)*pol_z(2, 5, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(155)*pol_z(1, 5, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(155)*pol_z(2, 5, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(156)*pol_z(1, 6, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(156)*pol_z(2, 6, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(157)*pol_z(1, 6, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(157)*pol_z(2, 6, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(158)*pol_z(1, 6, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(158)*pol_z(2, 6, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(159)*pol_z(1, 6, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(159)*pol_z(2, 6, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(160)*pol_z(1, 6, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(160)*pol_z(2, 6, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(161)*pol_z(1, 6, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(161)*pol_z(2, 6, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(162)*pol_z(1, 7, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(162)*pol_z(2, 7, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(163)*pol_z(1, 7, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(163)*pol_z(2, 7, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(164)*pol_z(1, 7, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(164)*pol_z(2, 7, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(165)*pol_z(1, 8, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(165)*pol_z(2, 8, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(7)*pol_z(1, 0, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(7)*pol_z(2, 0, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(8)*pol_z(1, 0, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(8)*pol_z(2, 0, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(9)*pol_z(1, 0, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(9)*pol_z(2, 0, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(10)*pol_z(1, 0, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(10)*pol_z(2, 0, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(11)*pol_z(1, 0, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(11)*pol_z(2, 0, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(12)*pol_z(1, 0, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(12)*pol_z(2, 0, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(13)*pol_z(1, 0, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(13)*pol_z(2, 0, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(14)*pol_z(1, 0, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(14)*pol_z(2, 0, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(15)*pol_z(1, 0, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(15)*pol_z(2, 0, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(16)*pol_z(1, 0, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(16)*pol_z(2, 0, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(17)*pol_z(1, 0, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(17)*pol_z(2, 0, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(18)*pol_z(1, 0, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(18)*pol_z(2, 0, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(19)*pol_z(1, 0, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(19)*pol_z(2, 0, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(20)*pol_z(1, 0, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(20)*pol_z(2, 0, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(21)*pol_z(1, 0, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(21)*pol_z(2, 0, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(22)*pol_z(1, 0, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(22)*pol_z(2, 0, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(23)*pol_z(1, 0, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(23)*pol_z(2, 0, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(24)*pol_z(1, 0, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(24)*pol_z(2, 0, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(25)*pol_z(1, 0, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(25)*pol_z(2, 0, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(26)*pol_z(1, 0, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(26)*pol_z(2, 0, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(27)*pol_z(1, 0, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(27)*pol_z(2, 0, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(28)*pol_z(1, 0, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(28)*pol_z(2, 0, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(29)*pol_z(1, 0, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(29)*pol_z(2, 0, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(30)*pol_z(1, 0, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(30)*pol_z(2, 0, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(31)*pol_z(1, 0, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(31)*pol_z(2, 0, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(32)*pol_z(1, 0, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(32)*pol_z(2, 0, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(33)*pol_z(1, 0, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(33)*pol_z(2, 0, kg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_xyz(34)*pol_z(1, 0, kg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_xyz(34)*pol_z(2, 0, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(35)*pol_z(1, 0, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(35)*pol_z(2, 0, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(36)*pol_z(1, 0, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(36)*pol_z(2, 0, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(37)*pol_z(1, 0, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(37)*pol_z(2, 0, kg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_xyz(38)*pol_z(1, 0, kg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_xyz(38)*pol_z(2, 0, kg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_xyz(39)*pol_z(1, 0, kg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_xyz(39)*pol_z(2, 0, kg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_xyz(40)*pol_z(1, 0, kg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_xyz(40)*pol_z(2, 0, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(41)*pol_z(1, 0, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(41)*pol_z(2, 0, kg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_xyz(42)*pol_z(1, 0, kg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_xyz(42)*pol_z(2, 0, kg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_xyz(43)*pol_z(1, 0, kg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_xyz(43)*pol_z(2, 0, kg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_xyz(44)*pol_z(1, 0, kg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_xyz(44)*pol_z(2, 0, kg) + coef_xy(1, 45) = coef_xy(1, 45) + coef_xyz(45)*pol_z(1, 0, kg) + coef_xy(2, 45) = coef_xy(2, 45) + coef_xyz(45)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(46)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(46)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(47)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(47)*pol_z(2, 1, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(48)*pol_z(1, 1, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(48)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(49)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(49)*pol_z(2, 1, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(50)*pol_z(1, 1, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(50)*pol_z(2, 1, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(51)*pol_z(1, 1, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(51)*pol_z(2, 1, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(52)*pol_z(1, 1, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(52)*pol_z(2, 1, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(53)*pol_z(1, 1, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(53)*pol_z(2, 1, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(54)*pol_z(1, 1, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(54)*pol_z(2, 1, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(55)*pol_z(1, 1, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(55)*pol_z(2, 1, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(56)*pol_z(1, 1, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(56)*pol_z(2, 1, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(57)*pol_z(1, 1, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(57)*pol_z(2, 1, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(58)*pol_z(1, 1, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(58)*pol_z(2, 1, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(59)*pol_z(1, 1, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(59)*pol_z(2, 1, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(60)*pol_z(1, 1, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(60)*pol_z(2, 1, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(61)*pol_z(1, 1, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(61)*pol_z(2, 1, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(62)*pol_z(1, 1, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(62)*pol_z(2, 1, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(63)*pol_z(1, 1, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(63)*pol_z(2, 1, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(64)*pol_z(1, 1, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(64)*pol_z(2, 1, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(65)*pol_z(1, 1, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(65)*pol_z(2, 1, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(66)*pol_z(1, 1, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(66)*pol_z(2, 1, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(67)*pol_z(1, 1, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(67)*pol_z(2, 1, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(68)*pol_z(1, 1, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(68)*pol_z(2, 1, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(69)*pol_z(1, 1, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(69)*pol_z(2, 1, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(70)*pol_z(1, 1, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(70)*pol_z(2, 1, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(71)*pol_z(1, 1, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(71)*pol_z(2, 1, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(72)*pol_z(1, 1, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(72)*pol_z(2, 1, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(73)*pol_z(1, 1, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(73)*pol_z(2, 1, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(74)*pol_z(1, 1, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(74)*pol_z(2, 1, kg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_xyz(75)*pol_z(1, 1, kg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_xyz(75)*pol_z(2, 1, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(76)*pol_z(1, 1, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(76)*pol_z(2, 1, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(77)*pol_z(1, 1, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(77)*pol_z(2, 1, kg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_xyz(78)*pol_z(1, 1, kg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_xyz(78)*pol_z(2, 1, kg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_xyz(79)*pol_z(1, 1, kg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_xyz(79)*pol_z(2, 1, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(80)*pol_z(1, 1, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(80)*pol_z(2, 1, kg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_xyz(81)*pol_z(1, 1, kg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_xyz(81)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(82)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(82)*pol_z(2, 2, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(83)*pol_z(1, 2, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(83)*pol_z(2, 2, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(84)*pol_z(1, 2, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(84)*pol_z(2, 2, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(85)*pol_z(1, 2, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(85)*pol_z(2, 2, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(86)*pol_z(1, 2, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(86)*pol_z(2, 2, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(87)*pol_z(1, 2, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(87)*pol_z(2, 2, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(88)*pol_z(1, 2, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(88)*pol_z(2, 2, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(89)*pol_z(1, 2, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(89)*pol_z(2, 2, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(90)*pol_z(1, 2, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(90)*pol_z(2, 2, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(91)*pol_z(1, 2, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(91)*pol_z(2, 2, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(92)*pol_z(1, 2, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(92)*pol_z(2, 2, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(93)*pol_z(1, 2, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(93)*pol_z(2, 2, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(94)*pol_z(1, 2, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(94)*pol_z(2, 2, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(95)*pol_z(1, 2, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(95)*pol_z(2, 2, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(96)*pol_z(1, 2, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(96)*pol_z(2, 2, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(97)*pol_z(1, 2, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(97)*pol_z(2, 2, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(98)*pol_z(1, 2, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(98)*pol_z(2, 2, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(99)*pol_z(1, 2, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(99)*pol_z(2, 2, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(100)*pol_z(1, 2, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(100)*pol_z(2, 2, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(101)*pol_z(1, 2, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(101)*pol_z(2, 2, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(102)*pol_z(1, 2, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(102)*pol_z(2, 2, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(103)*pol_z(1, 2, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(103)*pol_z(2, 2, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(104)*pol_z(1, 2, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(104)*pol_z(2, 2, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(105)*pol_z(1, 2, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(105)*pol_z(2, 2, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(106)*pol_z(1, 2, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(106)*pol_z(2, 2, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(107)*pol_z(1, 2, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(107)*pol_z(2, 2, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(108)*pol_z(1, 2, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(108)*pol_z(2, 2, kg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_xyz(109)*pol_z(1, 2, kg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_xyz(109)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(110)*pol_z(1, 3, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(110)*pol_z(2, 3, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(111)*pol_z(1, 3, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(111)*pol_z(2, 3, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(112)*pol_z(1, 3, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(112)*pol_z(2, 3, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(113)*pol_z(1, 3, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(113)*pol_z(2, 3, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(114)*pol_z(1, 3, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(114)*pol_z(2, 3, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(115)*pol_z(1, 3, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(115)*pol_z(2, 3, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(116)*pol_z(1, 3, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(116)*pol_z(2, 3, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(117)*pol_z(1, 3, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(117)*pol_z(2, 3, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(118)*pol_z(1, 3, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(118)*pol_z(2, 3, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(119)*pol_z(1, 3, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(119)*pol_z(2, 3, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(120)*pol_z(1, 3, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(120)*pol_z(2, 3, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(121)*pol_z(1, 3, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(121)*pol_z(2, 3, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(122)*pol_z(1, 3, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(122)*pol_z(2, 3, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(123)*pol_z(1, 3, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(123)*pol_z(2, 3, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(124)*pol_z(1, 3, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(124)*pol_z(2, 3, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(125)*pol_z(1, 3, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(125)*pol_z(2, 3, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(126)*pol_z(1, 3, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(126)*pol_z(2, 3, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(127)*pol_z(1, 3, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(127)*pol_z(2, 3, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(128)*pol_z(1, 3, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(128)*pol_z(2, 3, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(129)*pol_z(1, 3, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(129)*pol_z(2, 3, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(130)*pol_z(1, 3, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(130)*pol_z(2, 3, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(131)*pol_z(1, 4, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(131)*pol_z(2, 4, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(132)*pol_z(1, 4, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(132)*pol_z(2, 4, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(133)*pol_z(1, 4, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(133)*pol_z(2, 4, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(134)*pol_z(1, 4, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(134)*pol_z(2, 4, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(135)*pol_z(1, 4, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(135)*pol_z(2, 4, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(136)*pol_z(1, 4, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(136)*pol_z(2, 4, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(137)*pol_z(1, 4, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(137)*pol_z(2, 4, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(138)*pol_z(1, 4, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(138)*pol_z(2, 4, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(139)*pol_z(1, 4, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(139)*pol_z(2, 4, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(140)*pol_z(1, 4, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(140)*pol_z(2, 4, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(141)*pol_z(1, 4, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(141)*pol_z(2, 4, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(142)*pol_z(1, 4, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(142)*pol_z(2, 4, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(143)*pol_z(1, 4, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(143)*pol_z(2, 4, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(144)*pol_z(1, 4, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(144)*pol_z(2, 4, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(145)*pol_z(1, 4, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(145)*pol_z(2, 4, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(146)*pol_z(1, 5, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(146)*pol_z(2, 5, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(147)*pol_z(1, 5, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(147)*pol_z(2, 5, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(148)*pol_z(1, 5, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(148)*pol_z(2, 5, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(149)*pol_z(1, 5, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(149)*pol_z(2, 5, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(150)*pol_z(1, 5, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(150)*pol_z(2, 5, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(151)*pol_z(1, 5, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(151)*pol_z(2, 5, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(152)*pol_z(1, 5, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(152)*pol_z(2, 5, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(153)*pol_z(1, 5, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(153)*pol_z(2, 5, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(154)*pol_z(1, 5, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(154)*pol_z(2, 5, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(155)*pol_z(1, 5, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(155)*pol_z(2, 5, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(156)*pol_z(1, 6, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(156)*pol_z(2, 6, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(157)*pol_z(1, 6, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(157)*pol_z(2, 6, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(158)*pol_z(1, 6, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(158)*pol_z(2, 6, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(159)*pol_z(1, 6, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(159)*pol_z(2, 6, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(160)*pol_z(1, 6, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(160)*pol_z(2, 6, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(161)*pol_z(1, 6, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(161)*pol_z(2, 6, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(162)*pol_z(1, 7, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(162)*pol_z(2, 7, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(163)*pol_z(1, 7, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(163)*pol_z(2, 7, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(164)*pol_z(1, 7, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(164)*pol_z(2, 7, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(165)*pol_z(1, 8, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(165)*pol_z(2, 8, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 4)*pol_y(1, 0, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 4)*pol_y(1, 0, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 4)*pol_y(2, 0, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 4)*pol_y(2, 0, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 5)*pol_y(1, 0, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 5)*pol_y(1, 0, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 5)*pol_y(2, 0, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 5)*pol_y(2, 0, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 6)*pol_y(1, 0, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 6)*pol_y(1, 0, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 6)*pol_y(2, 0, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 6)*pol_y(2, 0, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 7)*pol_y(1, 0, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 7)*pol_y(1, 0, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 7)*pol_y(2, 0, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 7)*pol_y(2, 0, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 8)*pol_y(1, 0, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 8)*pol_y(1, 0, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 8)*pol_y(2, 0, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 8)*pol_y(2, 0, jg) - coef_x(1, 8) = coef_x(1, 8)+coef_xy(1, 9)*pol_y(1, 0, jg) - coef_x(2, 8) = coef_x(2, 8)+coef_xy(2, 9)*pol_y(1, 0, jg) - coef_x(3, 8) = coef_x(3, 8)+coef_xy(1, 9)*pol_y(2, 0, jg) - coef_x(4, 8) = coef_x(4, 8)+coef_xy(2, 9)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 10)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 10)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 10)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 10)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 11)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 11)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 11)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 11)*pol_y(2, 1, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 12)*pol_y(1, 1, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 12)*pol_y(1, 1, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 12)*pol_y(2, 1, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 12)*pol_y(2, 1, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 13)*pol_y(1, 1, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 13)*pol_y(1, 1, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 13)*pol_y(2, 1, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 13)*pol_y(2, 1, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 14)*pol_y(1, 1, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 14)*pol_y(1, 1, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 14)*pol_y(2, 1, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 14)*pol_y(2, 1, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 15)*pol_y(1, 1, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 15)*pol_y(1, 1, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 15)*pol_y(2, 1, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 15)*pol_y(2, 1, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 16)*pol_y(1, 1, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 16)*pol_y(1, 1, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 16)*pol_y(2, 1, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 16)*pol_y(2, 1, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 17)*pol_y(1, 1, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 17)*pol_y(1, 1, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 17)*pol_y(2, 1, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 17)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 18)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 18)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 18)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 18)*pol_y(2, 2, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 19)*pol_y(1, 2, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 19)*pol_y(1, 2, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 19)*pol_y(2, 2, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 19)*pol_y(2, 2, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 20)*pol_y(1, 2, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 20)*pol_y(1, 2, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 20)*pol_y(2, 2, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 20)*pol_y(2, 2, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 21)*pol_y(1, 2, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 21)*pol_y(1, 2, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 21)*pol_y(2, 2, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 21)*pol_y(2, 2, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 22)*pol_y(1, 2, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 22)*pol_y(1, 2, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 22)*pol_y(2, 2, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 22)*pol_y(2, 2, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 23)*pol_y(1, 2, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 23)*pol_y(1, 2, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 23)*pol_y(2, 2, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 23)*pol_y(2, 2, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 24)*pol_y(1, 2, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 24)*pol_y(1, 2, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 24)*pol_y(2, 2, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 24)*pol_y(2, 2, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 25)*pol_y(1, 3, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 25)*pol_y(1, 3, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 25)*pol_y(2, 3, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 25)*pol_y(2, 3, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 26)*pol_y(1, 3, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 26)*pol_y(1, 3, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 26)*pol_y(2, 3, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 26)*pol_y(2, 3, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 27)*pol_y(1, 3, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 27)*pol_y(1, 3, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 27)*pol_y(2, 3, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 27)*pol_y(2, 3, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 28)*pol_y(1, 3, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 28)*pol_y(1, 3, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 28)*pol_y(2, 3, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 28)*pol_y(2, 3, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 29)*pol_y(1, 3, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 29)*pol_y(1, 3, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 29)*pol_y(2, 3, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 29)*pol_y(2, 3, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 30)*pol_y(1, 3, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 30)*pol_y(1, 3, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 30)*pol_y(2, 3, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 30)*pol_y(2, 3, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 31)*pol_y(1, 4, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 31)*pol_y(1, 4, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 31)*pol_y(2, 4, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 31)*pol_y(2, 4, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 32)*pol_y(1, 4, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 32)*pol_y(1, 4, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 32)*pol_y(2, 4, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 32)*pol_y(2, 4, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 33)*pol_y(1, 4, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 33)*pol_y(1, 4, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 33)*pol_y(2, 4, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 33)*pol_y(2, 4, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 34)*pol_y(1, 4, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 34)*pol_y(1, 4, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 34)*pol_y(2, 4, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 34)*pol_y(2, 4, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 35)*pol_y(1, 4, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 35)*pol_y(1, 4, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 35)*pol_y(2, 4, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 35)*pol_y(2, 4, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 36)*pol_y(1, 5, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 36)*pol_y(1, 5, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 36)*pol_y(2, 5, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 36)*pol_y(2, 5, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 37)*pol_y(1, 5, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 37)*pol_y(1, 5, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 37)*pol_y(2, 5, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 37)*pol_y(2, 5, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 38)*pol_y(1, 5, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 38)*pol_y(1, 5, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 38)*pol_y(2, 5, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 38)*pol_y(2, 5, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 39)*pol_y(1, 5, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 39)*pol_y(1, 5, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 39)*pol_y(2, 5, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 39)*pol_y(2, 5, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 40)*pol_y(1, 6, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 40)*pol_y(1, 6, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 40)*pol_y(2, 6, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 40)*pol_y(2, 6, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 41)*pol_y(1, 6, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 41)*pol_y(1, 6, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 41)*pol_y(2, 6, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 41)*pol_y(2, 6, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 42)*pol_y(1, 6, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 42)*pol_y(1, 6, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 42)*pol_y(2, 6, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 42)*pol_y(2, 6, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 43)*pol_y(1, 7, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 43)*pol_y(1, 7, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 43)*pol_y(2, 7, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 43)*pol_y(2, 7, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 44)*pol_y(1, 7, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 44)*pol_y(1, 7, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 44)*pol_y(2, 7, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 44)*pol_y(2, 7, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 45)*pol_y(1, 8, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 45)*pol_y(1, 8, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 45)*pol_y(2, 8, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 45)*pol_y(2, 8, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 4)*pol_y(1, 0, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 4)*pol_y(1, 0, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 4)*pol_y(2, 0, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 4)*pol_y(2, 0, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 5)*pol_y(1, 0, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 5)*pol_y(1, 0, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 5)*pol_y(2, 0, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 5)*pol_y(2, 0, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 6)*pol_y(1, 0, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 6)*pol_y(1, 0, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 6)*pol_y(2, 0, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 6)*pol_y(2, 0, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 7)*pol_y(1, 0, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 7)*pol_y(1, 0, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 7)*pol_y(2, 0, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 7)*pol_y(2, 0, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 8)*pol_y(1, 0, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 8)*pol_y(1, 0, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 8)*pol_y(2, 0, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 8)*pol_y(2, 0, jg) + coef_x(1, 8) = coef_x(1, 8) + coef_xy(1, 9)*pol_y(1, 0, jg) + coef_x(2, 8) = coef_x(2, 8) + coef_xy(2, 9)*pol_y(1, 0, jg) + coef_x(3, 8) = coef_x(3, 8) + coef_xy(1, 9)*pol_y(2, 0, jg) + coef_x(4, 8) = coef_x(4, 8) + coef_xy(2, 9)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 10)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 10)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 10)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 10)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 11)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 11)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 11)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 11)*pol_y(2, 1, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 12)*pol_y(1, 1, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 12)*pol_y(1, 1, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 12)*pol_y(2, 1, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 12)*pol_y(2, 1, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 13)*pol_y(1, 1, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 13)*pol_y(1, 1, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 13)*pol_y(2, 1, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 13)*pol_y(2, 1, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 14)*pol_y(1, 1, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 14)*pol_y(1, 1, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 14)*pol_y(2, 1, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 14)*pol_y(2, 1, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 15)*pol_y(1, 1, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 15)*pol_y(1, 1, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 15)*pol_y(2, 1, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 15)*pol_y(2, 1, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 16)*pol_y(1, 1, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 16)*pol_y(1, 1, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 16)*pol_y(2, 1, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 16)*pol_y(2, 1, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 17)*pol_y(1, 1, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 17)*pol_y(1, 1, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 17)*pol_y(2, 1, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 17)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 18)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 18)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 18)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 18)*pol_y(2, 2, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 19)*pol_y(1, 2, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 19)*pol_y(1, 2, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 19)*pol_y(2, 2, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 19)*pol_y(2, 2, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 20)*pol_y(1, 2, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 20)*pol_y(1, 2, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 20)*pol_y(2, 2, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 20)*pol_y(2, 2, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 21)*pol_y(1, 2, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 21)*pol_y(1, 2, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 21)*pol_y(2, 2, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 21)*pol_y(2, 2, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 22)*pol_y(1, 2, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 22)*pol_y(1, 2, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 22)*pol_y(2, 2, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 22)*pol_y(2, 2, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 23)*pol_y(1, 2, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 23)*pol_y(1, 2, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 23)*pol_y(2, 2, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 23)*pol_y(2, 2, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 24)*pol_y(1, 2, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 24)*pol_y(1, 2, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 24)*pol_y(2, 2, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 24)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 25)*pol_y(1, 3, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 25)*pol_y(1, 3, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 25)*pol_y(2, 3, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 25)*pol_y(2, 3, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 26)*pol_y(1, 3, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 26)*pol_y(1, 3, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 26)*pol_y(2, 3, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 26)*pol_y(2, 3, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 27)*pol_y(1, 3, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 27)*pol_y(1, 3, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 27)*pol_y(2, 3, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 27)*pol_y(2, 3, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 28)*pol_y(1, 3, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 28)*pol_y(1, 3, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 28)*pol_y(2, 3, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 28)*pol_y(2, 3, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 29)*pol_y(1, 3, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 29)*pol_y(1, 3, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 29)*pol_y(2, 3, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 29)*pol_y(2, 3, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 30)*pol_y(1, 3, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 30)*pol_y(1, 3, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 30)*pol_y(2, 3, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 30)*pol_y(2, 3, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 31)*pol_y(1, 4, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 31)*pol_y(1, 4, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 31)*pol_y(2, 4, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 31)*pol_y(2, 4, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 32)*pol_y(1, 4, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 32)*pol_y(1, 4, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 32)*pol_y(2, 4, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 32)*pol_y(2, 4, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 33)*pol_y(1, 4, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 33)*pol_y(1, 4, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 33)*pol_y(2, 4, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 33)*pol_y(2, 4, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 34)*pol_y(1, 4, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 34)*pol_y(1, 4, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 34)*pol_y(2, 4, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 34)*pol_y(2, 4, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 35)*pol_y(1, 4, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 35)*pol_y(1, 4, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 35)*pol_y(2, 4, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 35)*pol_y(2, 4, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 36)*pol_y(1, 5, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 36)*pol_y(1, 5, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 36)*pol_y(2, 5, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 36)*pol_y(2, 5, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 37)*pol_y(1, 5, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 37)*pol_y(1, 5, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 37)*pol_y(2, 5, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 37)*pol_y(2, 5, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 38)*pol_y(1, 5, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 38)*pol_y(1, 5, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 38)*pol_y(2, 5, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 38)*pol_y(2, 5, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 39)*pol_y(1, 5, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 39)*pol_y(1, 5, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 39)*pol_y(2, 5, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 39)*pol_y(2, 5, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 40)*pol_y(1, 6, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 40)*pol_y(1, 6, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 40)*pol_y(2, 6, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 40)*pol_y(2, 6, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 41)*pol_y(1, 6, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 41)*pol_y(1, 6, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 41)*pol_y(2, 6, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 41)*pol_y(2, 6, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 42)*pol_y(1, 6, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 42)*pol_y(1, 6, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 42)*pol_y(2, 6, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 42)*pol_y(2, 6, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 43)*pol_y(1, 7, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 43)*pol_y(1, 7, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 43)*pol_y(2, 7, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 43)*pol_y(2, 7, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 44)*pol_y(1, 7, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 44)*pol_y(1, 7, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 44)*pol_y(2, 7, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 44)*pol_y(2, 7, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 45)*pol_y(1, 8, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 45)*pol_y(1, 8, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 45)*pol_y(2, 8, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 45)*pol_y(2, 8, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - s01 = s01+coef_x(1, 4)*pol_x(4, ig) - s02 = s02+coef_x(2, 4)*pol_x(4, ig) - s03 = s03+coef_x(3, 4)*pol_x(4, ig) - s04 = s04+coef_x(4, 4)*pol_x(4, ig) - s01 = s01+coef_x(1, 5)*pol_x(5, ig) - s02 = s02+coef_x(2, 5)*pol_x(5, ig) - s03 = s03+coef_x(3, 5)*pol_x(5, ig) - s04 = s04+coef_x(4, 5)*pol_x(5, ig) - s01 = s01+coef_x(1, 6)*pol_x(6, ig) - s02 = s02+coef_x(2, 6)*pol_x(6, ig) - s03 = s03+coef_x(3, 6)*pol_x(6, ig) - s04 = s04+coef_x(4, 6)*pol_x(6, ig) - s01 = s01+coef_x(1, 7)*pol_x(7, ig) - s02 = s02+coef_x(2, 7)*pol_x(7, ig) - s03 = s03+coef_x(3, 7)*pol_x(7, ig) - s04 = s04+coef_x(4, 7)*pol_x(7, ig) - s01 = s01+coef_x(1, 8)*pol_x(8, ig) - s02 = s02+coef_x(2, 8)*pol_x(8, ig) - s03 = s03+coef_x(3, 8)*pol_x(8, ig) - s04 = s04+coef_x(4, 8)*pol_x(8, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + s01 = s01 + coef_x(1, 4)*pol_x(4, ig) + s02 = s02 + coef_x(2, 4)*pol_x(4, ig) + s03 = s03 + coef_x(3, 4)*pol_x(4, ig) + s04 = s04 + coef_x(4, 4)*pol_x(4, ig) + s01 = s01 + coef_x(1, 5)*pol_x(5, ig) + s02 = s02 + coef_x(2, 5)*pol_x(5, ig) + s03 = s03 + coef_x(3, 5)*pol_x(5, ig) + s04 = s04 + coef_x(4, 5)*pol_x(5, ig) + s01 = s01 + coef_x(1, 6)*pol_x(6, ig) + s02 = s02 + coef_x(2, 6)*pol_x(6, ig) + s03 = s03 + coef_x(3, 6)*pol_x(6, ig) + s04 = s04 + coef_x(4, 6)*pol_x(6, ig) + s01 = s01 + coef_x(1, 7)*pol_x(7, ig) + s02 = s02 + coef_x(2, 7)*pol_x(7, ig) + s03 = s03 + coef_x(3, 7)*pol_x(7, ig) + s04 = s04 + coef_x(4, 7)*pol_x(7, ig) + s01 = s01 + coef_x(1, 8)*pol_x(8, ig) + s02 = s02 + coef_x(2, 8)*pol_x(8, ig) + s03 = s03 + coef_x(3, 8)*pol_x(8, ig) + s04 = s04 + coef_x(4, 8)*pol_x(8, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -2188,744 +2188,744 @@ SUBROUTINE collocate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 9 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(7)*pol_z(1, 0, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(7)*pol_z(2, 0, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(8)*pol_z(1, 0, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(8)*pol_z(2, 0, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(9)*pol_z(1, 0, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(9)*pol_z(2, 0, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(10)*pol_z(1, 0, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(10)*pol_z(2, 0, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(11)*pol_z(1, 0, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(11)*pol_z(2, 0, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(12)*pol_z(1, 0, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(12)*pol_z(2, 0, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(13)*pol_z(1, 0, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(13)*pol_z(2, 0, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(14)*pol_z(1, 0, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(14)*pol_z(2, 0, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(15)*pol_z(1, 0, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(15)*pol_z(2, 0, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(16)*pol_z(1, 0, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(16)*pol_z(2, 0, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(17)*pol_z(1, 0, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(17)*pol_z(2, 0, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(18)*pol_z(1, 0, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(18)*pol_z(2, 0, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(19)*pol_z(1, 0, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(19)*pol_z(2, 0, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(20)*pol_z(1, 0, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(20)*pol_z(2, 0, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(21)*pol_z(1, 0, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(21)*pol_z(2, 0, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(22)*pol_z(1, 0, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(22)*pol_z(2, 0, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(23)*pol_z(1, 0, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(23)*pol_z(2, 0, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(24)*pol_z(1, 0, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(24)*pol_z(2, 0, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(25)*pol_z(1, 0, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(25)*pol_z(2, 0, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(26)*pol_z(1, 0, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(26)*pol_z(2, 0, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(27)*pol_z(1, 0, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(27)*pol_z(2, 0, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(28)*pol_z(1, 0, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(28)*pol_z(2, 0, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(29)*pol_z(1, 0, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(29)*pol_z(2, 0, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(30)*pol_z(1, 0, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(30)*pol_z(2, 0, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(31)*pol_z(1, 0, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(31)*pol_z(2, 0, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(32)*pol_z(1, 0, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(32)*pol_z(2, 0, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(33)*pol_z(1, 0, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(33)*pol_z(2, 0, kg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_xyz(34)*pol_z(1, 0, kg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_xyz(34)*pol_z(2, 0, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(35)*pol_z(1, 0, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(35)*pol_z(2, 0, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(36)*pol_z(1, 0, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(36)*pol_z(2, 0, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(37)*pol_z(1, 0, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(37)*pol_z(2, 0, kg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_xyz(38)*pol_z(1, 0, kg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_xyz(38)*pol_z(2, 0, kg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_xyz(39)*pol_z(1, 0, kg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_xyz(39)*pol_z(2, 0, kg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_xyz(40)*pol_z(1, 0, kg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_xyz(40)*pol_z(2, 0, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(41)*pol_z(1, 0, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(41)*pol_z(2, 0, kg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_xyz(42)*pol_z(1, 0, kg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_xyz(42)*pol_z(2, 0, kg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_xyz(43)*pol_z(1, 0, kg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_xyz(43)*pol_z(2, 0, kg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_xyz(44)*pol_z(1, 0, kg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_xyz(44)*pol_z(2, 0, kg) - coef_xy(1, 45) = coef_xy(1, 45)+coef_xyz(45)*pol_z(1, 0, kg) - coef_xy(2, 45) = coef_xy(2, 45)+coef_xyz(45)*pol_z(2, 0, kg) - coef_xy(1, 46) = coef_xy(1, 46)+coef_xyz(46)*pol_z(1, 0, kg) - coef_xy(2, 46) = coef_xy(2, 46)+coef_xyz(46)*pol_z(2, 0, kg) - coef_xy(1, 47) = coef_xy(1, 47)+coef_xyz(47)*pol_z(1, 0, kg) - coef_xy(2, 47) = coef_xy(2, 47)+coef_xyz(47)*pol_z(2, 0, kg) - coef_xy(1, 48) = coef_xy(1, 48)+coef_xyz(48)*pol_z(1, 0, kg) - coef_xy(2, 48) = coef_xy(2, 48)+coef_xyz(48)*pol_z(2, 0, kg) - coef_xy(1, 49) = coef_xy(1, 49)+coef_xyz(49)*pol_z(1, 0, kg) - coef_xy(2, 49) = coef_xy(2, 49)+coef_xyz(49)*pol_z(2, 0, kg) - coef_xy(1, 50) = coef_xy(1, 50)+coef_xyz(50)*pol_z(1, 0, kg) - coef_xy(2, 50) = coef_xy(2, 50)+coef_xyz(50)*pol_z(2, 0, kg) - coef_xy(1, 51) = coef_xy(1, 51)+coef_xyz(51)*pol_z(1, 0, kg) - coef_xy(2, 51) = coef_xy(2, 51)+coef_xyz(51)*pol_z(2, 0, kg) - coef_xy(1, 52) = coef_xy(1, 52)+coef_xyz(52)*pol_z(1, 0, kg) - coef_xy(2, 52) = coef_xy(2, 52)+coef_xyz(52)*pol_z(2, 0, kg) - coef_xy(1, 53) = coef_xy(1, 53)+coef_xyz(53)*pol_z(1, 0, kg) - coef_xy(2, 53) = coef_xy(2, 53)+coef_xyz(53)*pol_z(2, 0, kg) - coef_xy(1, 54) = coef_xy(1, 54)+coef_xyz(54)*pol_z(1, 0, kg) - coef_xy(2, 54) = coef_xy(2, 54)+coef_xyz(54)*pol_z(2, 0, kg) - coef_xy(1, 55) = coef_xy(1, 55)+coef_xyz(55)*pol_z(1, 0, kg) - coef_xy(2, 55) = coef_xy(2, 55)+coef_xyz(55)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(56)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(56)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(57)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(57)*pol_z(2, 1, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(58)*pol_z(1, 1, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(58)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(59)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(59)*pol_z(2, 1, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(60)*pol_z(1, 1, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(60)*pol_z(2, 1, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(61)*pol_z(1, 1, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(61)*pol_z(2, 1, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(62)*pol_z(1, 1, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(62)*pol_z(2, 1, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(63)*pol_z(1, 1, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(63)*pol_z(2, 1, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(64)*pol_z(1, 1, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(64)*pol_z(2, 1, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(65)*pol_z(1, 1, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(65)*pol_z(2, 1, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(66)*pol_z(1, 1, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(66)*pol_z(2, 1, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(67)*pol_z(1, 1, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(67)*pol_z(2, 1, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(68)*pol_z(1, 1, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(68)*pol_z(2, 1, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(69)*pol_z(1, 1, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(69)*pol_z(2, 1, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(70)*pol_z(1, 1, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(70)*pol_z(2, 1, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(71)*pol_z(1, 1, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(71)*pol_z(2, 1, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(72)*pol_z(1, 1, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(72)*pol_z(2, 1, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(73)*pol_z(1, 1, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(73)*pol_z(2, 1, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(74)*pol_z(1, 1, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(74)*pol_z(2, 1, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(75)*pol_z(1, 1, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(75)*pol_z(2, 1, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(76)*pol_z(1, 1, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(76)*pol_z(2, 1, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(77)*pol_z(1, 1, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(77)*pol_z(2, 1, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(78)*pol_z(1, 1, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(78)*pol_z(2, 1, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(79)*pol_z(1, 1, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(79)*pol_z(2, 1, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(80)*pol_z(1, 1, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(80)*pol_z(2, 1, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(81)*pol_z(1, 1, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(81)*pol_z(2, 1, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(82)*pol_z(1, 1, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(82)*pol_z(2, 1, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(83)*pol_z(1, 1, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(83)*pol_z(2, 1, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(84)*pol_z(1, 1, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(84)*pol_z(2, 1, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(85)*pol_z(1, 1, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(85)*pol_z(2, 1, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(86)*pol_z(1, 1, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(86)*pol_z(2, 1, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(87)*pol_z(1, 1, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(87)*pol_z(2, 1, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(88)*pol_z(1, 1, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(88)*pol_z(2, 1, kg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_xyz(89)*pol_z(1, 1, kg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_xyz(89)*pol_z(2, 1, kg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_xyz(90)*pol_z(1, 1, kg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_xyz(90)*pol_z(2, 1, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(91)*pol_z(1, 1, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(91)*pol_z(2, 1, kg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_xyz(92)*pol_z(1, 1, kg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_xyz(92)*pol_z(2, 1, kg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_xyz(93)*pol_z(1, 1, kg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_xyz(93)*pol_z(2, 1, kg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_xyz(94)*pol_z(1, 1, kg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_xyz(94)*pol_z(2, 1, kg) - coef_xy(1, 46) = coef_xy(1, 46)+coef_xyz(95)*pol_z(1, 1, kg) - coef_xy(2, 46) = coef_xy(2, 46)+coef_xyz(95)*pol_z(2, 1, kg) - coef_xy(1, 47) = coef_xy(1, 47)+coef_xyz(96)*pol_z(1, 1, kg) - coef_xy(2, 47) = coef_xy(2, 47)+coef_xyz(96)*pol_z(2, 1, kg) - coef_xy(1, 48) = coef_xy(1, 48)+coef_xyz(97)*pol_z(1, 1, kg) - coef_xy(2, 48) = coef_xy(2, 48)+coef_xyz(97)*pol_z(2, 1, kg) - coef_xy(1, 50) = coef_xy(1, 50)+coef_xyz(98)*pol_z(1, 1, kg) - coef_xy(2, 50) = coef_xy(2, 50)+coef_xyz(98)*pol_z(2, 1, kg) - coef_xy(1, 51) = coef_xy(1, 51)+coef_xyz(99)*pol_z(1, 1, kg) - coef_xy(2, 51) = coef_xy(2, 51)+coef_xyz(99)*pol_z(2, 1, kg) - coef_xy(1, 53) = coef_xy(1, 53)+coef_xyz(100)*pol_z(1, 1, kg) - coef_xy(2, 53) = coef_xy(2, 53)+coef_xyz(100)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(101)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(101)*pol_z(2, 2, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(102)*pol_z(1, 2, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(102)*pol_z(2, 2, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(103)*pol_z(1, 2, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(103)*pol_z(2, 2, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(104)*pol_z(1, 2, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(104)*pol_z(2, 2, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(105)*pol_z(1, 2, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(105)*pol_z(2, 2, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(106)*pol_z(1, 2, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(106)*pol_z(2, 2, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(107)*pol_z(1, 2, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(107)*pol_z(2, 2, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(108)*pol_z(1, 2, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(108)*pol_z(2, 2, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(109)*pol_z(1, 2, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(109)*pol_z(2, 2, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(110)*pol_z(1, 2, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(110)*pol_z(2, 2, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(111)*pol_z(1, 2, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(111)*pol_z(2, 2, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(112)*pol_z(1, 2, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(112)*pol_z(2, 2, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(113)*pol_z(1, 2, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(113)*pol_z(2, 2, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(114)*pol_z(1, 2, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(114)*pol_z(2, 2, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(115)*pol_z(1, 2, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(115)*pol_z(2, 2, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(116)*pol_z(1, 2, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(116)*pol_z(2, 2, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(117)*pol_z(1, 2, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(117)*pol_z(2, 2, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(118)*pol_z(1, 2, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(118)*pol_z(2, 2, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(119)*pol_z(1, 2, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(119)*pol_z(2, 2, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(120)*pol_z(1, 2, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(120)*pol_z(2, 2, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(121)*pol_z(1, 2, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(121)*pol_z(2, 2, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(122)*pol_z(1, 2, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(122)*pol_z(2, 2, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(123)*pol_z(1, 2, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(123)*pol_z(2, 2, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(124)*pol_z(1, 2, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(124)*pol_z(2, 2, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(125)*pol_z(1, 2, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(125)*pol_z(2, 2, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(126)*pol_z(1, 2, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(126)*pol_z(2, 2, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(127)*pol_z(1, 2, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(127)*pol_z(2, 2, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(128)*pol_z(1, 2, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(128)*pol_z(2, 2, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(129)*pol_z(1, 2, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(129)*pol_z(2, 2, kg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_xyz(130)*pol_z(1, 2, kg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_xyz(130)*pol_z(2, 2, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(131)*pol_z(1, 2, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(131)*pol_z(2, 2, kg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_xyz(132)*pol_z(1, 2, kg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_xyz(132)*pol_z(2, 2, kg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_xyz(133)*pol_z(1, 2, kg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_xyz(133)*pol_z(2, 2, kg) - coef_xy(1, 46) = coef_xy(1, 46)+coef_xyz(134)*pol_z(1, 2, kg) - coef_xy(2, 46) = coef_xy(2, 46)+coef_xyz(134)*pol_z(2, 2, kg) - coef_xy(1, 47) = coef_xy(1, 47)+coef_xyz(135)*pol_z(1, 2, kg) - coef_xy(2, 47) = coef_xy(2, 47)+coef_xyz(135)*pol_z(2, 2, kg) - coef_xy(1, 50) = coef_xy(1, 50)+coef_xyz(136)*pol_z(1, 2, kg) - coef_xy(2, 50) = coef_xy(2, 50)+coef_xyz(136)*pol_z(2, 2, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(137)*pol_z(1, 3, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(137)*pol_z(2, 3, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(138)*pol_z(1, 3, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(138)*pol_z(2, 3, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(139)*pol_z(1, 3, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(139)*pol_z(2, 3, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(140)*pol_z(1, 3, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(140)*pol_z(2, 3, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(141)*pol_z(1, 3, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(141)*pol_z(2, 3, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(142)*pol_z(1, 3, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(142)*pol_z(2, 3, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(143)*pol_z(1, 3, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(143)*pol_z(2, 3, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(144)*pol_z(1, 3, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(144)*pol_z(2, 3, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(145)*pol_z(1, 3, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(145)*pol_z(2, 3, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(146)*pol_z(1, 3, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(146)*pol_z(2, 3, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(147)*pol_z(1, 3, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(147)*pol_z(2, 3, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(148)*pol_z(1, 3, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(148)*pol_z(2, 3, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(149)*pol_z(1, 3, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(149)*pol_z(2, 3, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(150)*pol_z(1, 3, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(150)*pol_z(2, 3, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(151)*pol_z(1, 3, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(151)*pol_z(2, 3, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(152)*pol_z(1, 3, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(152)*pol_z(2, 3, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(153)*pol_z(1, 3, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(153)*pol_z(2, 3, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(154)*pol_z(1, 3, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(154)*pol_z(2, 3, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(155)*pol_z(1, 3, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(155)*pol_z(2, 3, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(156)*pol_z(1, 3, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(156)*pol_z(2, 3, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(157)*pol_z(1, 3, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(157)*pol_z(2, 3, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(158)*pol_z(1, 3, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(158)*pol_z(2, 3, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(159)*pol_z(1, 3, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(159)*pol_z(2, 3, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(160)*pol_z(1, 3, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(160)*pol_z(2, 3, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(161)*pol_z(1, 3, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(161)*pol_z(2, 3, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(162)*pol_z(1, 3, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(162)*pol_z(2, 3, kg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_xyz(163)*pol_z(1, 3, kg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_xyz(163)*pol_z(2, 3, kg) - coef_xy(1, 46) = coef_xy(1, 46)+coef_xyz(164)*pol_z(1, 3, kg) - coef_xy(2, 46) = coef_xy(2, 46)+coef_xyz(164)*pol_z(2, 3, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(165)*pol_z(1, 4, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(165)*pol_z(2, 4, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(166)*pol_z(1, 4, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(166)*pol_z(2, 4, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(167)*pol_z(1, 4, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(167)*pol_z(2, 4, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(168)*pol_z(1, 4, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(168)*pol_z(2, 4, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(169)*pol_z(1, 4, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(169)*pol_z(2, 4, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(170)*pol_z(1, 4, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(170)*pol_z(2, 4, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(171)*pol_z(1, 4, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(171)*pol_z(2, 4, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(172)*pol_z(1, 4, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(172)*pol_z(2, 4, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(173)*pol_z(1, 4, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(173)*pol_z(2, 4, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(174)*pol_z(1, 4, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(174)*pol_z(2, 4, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(175)*pol_z(1, 4, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(175)*pol_z(2, 4, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(176)*pol_z(1, 4, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(176)*pol_z(2, 4, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(177)*pol_z(1, 4, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(177)*pol_z(2, 4, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(178)*pol_z(1, 4, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(178)*pol_z(2, 4, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(179)*pol_z(1, 4, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(179)*pol_z(2, 4, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(180)*pol_z(1, 4, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(180)*pol_z(2, 4, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(181)*pol_z(1, 4, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(181)*pol_z(2, 4, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(182)*pol_z(1, 4, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(182)*pol_z(2, 4, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(183)*pol_z(1, 4, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(183)*pol_z(2, 4, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(184)*pol_z(1, 4, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(184)*pol_z(2, 4, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(185)*pol_z(1, 4, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(185)*pol_z(2, 4, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(186)*pol_z(1, 5, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(186)*pol_z(2, 5, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(187)*pol_z(1, 5, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(187)*pol_z(2, 5, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(188)*pol_z(1, 5, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(188)*pol_z(2, 5, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(189)*pol_z(1, 5, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(189)*pol_z(2, 5, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(190)*pol_z(1, 5, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(190)*pol_z(2, 5, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(191)*pol_z(1, 5, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(191)*pol_z(2, 5, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(192)*pol_z(1, 5, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(192)*pol_z(2, 5, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(193)*pol_z(1, 5, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(193)*pol_z(2, 5, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(194)*pol_z(1, 5, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(194)*pol_z(2, 5, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(195)*pol_z(1, 5, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(195)*pol_z(2, 5, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(196)*pol_z(1, 5, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(196)*pol_z(2, 5, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(197)*pol_z(1, 5, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(197)*pol_z(2, 5, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(198)*pol_z(1, 5, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(198)*pol_z(2, 5, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(199)*pol_z(1, 5, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(199)*pol_z(2, 5, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(200)*pol_z(1, 5, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(200)*pol_z(2, 5, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(201)*pol_z(1, 6, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(201)*pol_z(2, 6, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(202)*pol_z(1, 6, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(202)*pol_z(2, 6, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(203)*pol_z(1, 6, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(203)*pol_z(2, 6, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(204)*pol_z(1, 6, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(204)*pol_z(2, 6, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(205)*pol_z(1, 6, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(205)*pol_z(2, 6, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(206)*pol_z(1, 6, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(206)*pol_z(2, 6, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(207)*pol_z(1, 6, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(207)*pol_z(2, 6, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(208)*pol_z(1, 6, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(208)*pol_z(2, 6, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(209)*pol_z(1, 6, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(209)*pol_z(2, 6, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(210)*pol_z(1, 6, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(210)*pol_z(2, 6, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(211)*pol_z(1, 7, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(211)*pol_z(2, 7, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(212)*pol_z(1, 7, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(212)*pol_z(2, 7, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(213)*pol_z(1, 7, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(213)*pol_z(2, 7, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(214)*pol_z(1, 7, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(214)*pol_z(2, 7, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(215)*pol_z(1, 7, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(215)*pol_z(2, 7, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(216)*pol_z(1, 7, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(216)*pol_z(2, 7, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(217)*pol_z(1, 8, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(217)*pol_z(2, 8, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(218)*pol_z(1, 8, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(218)*pol_z(2, 8, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(219)*pol_z(1, 8, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(219)*pol_z(2, 8, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(220)*pol_z(1, 9, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(220)*pol_z(2, 9, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(7)*pol_z(1, 0, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(7)*pol_z(2, 0, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(8)*pol_z(1, 0, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(8)*pol_z(2, 0, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(9)*pol_z(1, 0, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(9)*pol_z(2, 0, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(10)*pol_z(1, 0, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(10)*pol_z(2, 0, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(11)*pol_z(1, 0, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(11)*pol_z(2, 0, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(12)*pol_z(1, 0, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(12)*pol_z(2, 0, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(13)*pol_z(1, 0, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(13)*pol_z(2, 0, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(14)*pol_z(1, 0, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(14)*pol_z(2, 0, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(15)*pol_z(1, 0, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(15)*pol_z(2, 0, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(16)*pol_z(1, 0, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(16)*pol_z(2, 0, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(17)*pol_z(1, 0, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(17)*pol_z(2, 0, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(18)*pol_z(1, 0, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(18)*pol_z(2, 0, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(19)*pol_z(1, 0, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(19)*pol_z(2, 0, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(20)*pol_z(1, 0, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(20)*pol_z(2, 0, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(21)*pol_z(1, 0, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(21)*pol_z(2, 0, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(22)*pol_z(1, 0, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(22)*pol_z(2, 0, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(23)*pol_z(1, 0, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(23)*pol_z(2, 0, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(24)*pol_z(1, 0, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(24)*pol_z(2, 0, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(25)*pol_z(1, 0, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(25)*pol_z(2, 0, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(26)*pol_z(1, 0, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(26)*pol_z(2, 0, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(27)*pol_z(1, 0, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(27)*pol_z(2, 0, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(28)*pol_z(1, 0, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(28)*pol_z(2, 0, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(29)*pol_z(1, 0, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(29)*pol_z(2, 0, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(30)*pol_z(1, 0, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(30)*pol_z(2, 0, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(31)*pol_z(1, 0, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(31)*pol_z(2, 0, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(32)*pol_z(1, 0, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(32)*pol_z(2, 0, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(33)*pol_z(1, 0, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(33)*pol_z(2, 0, kg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_xyz(34)*pol_z(1, 0, kg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_xyz(34)*pol_z(2, 0, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(35)*pol_z(1, 0, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(35)*pol_z(2, 0, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(36)*pol_z(1, 0, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(36)*pol_z(2, 0, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(37)*pol_z(1, 0, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(37)*pol_z(2, 0, kg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_xyz(38)*pol_z(1, 0, kg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_xyz(38)*pol_z(2, 0, kg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_xyz(39)*pol_z(1, 0, kg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_xyz(39)*pol_z(2, 0, kg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_xyz(40)*pol_z(1, 0, kg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_xyz(40)*pol_z(2, 0, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(41)*pol_z(1, 0, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(41)*pol_z(2, 0, kg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_xyz(42)*pol_z(1, 0, kg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_xyz(42)*pol_z(2, 0, kg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_xyz(43)*pol_z(1, 0, kg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_xyz(43)*pol_z(2, 0, kg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_xyz(44)*pol_z(1, 0, kg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_xyz(44)*pol_z(2, 0, kg) + coef_xy(1, 45) = coef_xy(1, 45) + coef_xyz(45)*pol_z(1, 0, kg) + coef_xy(2, 45) = coef_xy(2, 45) + coef_xyz(45)*pol_z(2, 0, kg) + coef_xy(1, 46) = coef_xy(1, 46) + coef_xyz(46)*pol_z(1, 0, kg) + coef_xy(2, 46) = coef_xy(2, 46) + coef_xyz(46)*pol_z(2, 0, kg) + coef_xy(1, 47) = coef_xy(1, 47) + coef_xyz(47)*pol_z(1, 0, kg) + coef_xy(2, 47) = coef_xy(2, 47) + coef_xyz(47)*pol_z(2, 0, kg) + coef_xy(1, 48) = coef_xy(1, 48) + coef_xyz(48)*pol_z(1, 0, kg) + coef_xy(2, 48) = coef_xy(2, 48) + coef_xyz(48)*pol_z(2, 0, kg) + coef_xy(1, 49) = coef_xy(1, 49) + coef_xyz(49)*pol_z(1, 0, kg) + coef_xy(2, 49) = coef_xy(2, 49) + coef_xyz(49)*pol_z(2, 0, kg) + coef_xy(1, 50) = coef_xy(1, 50) + coef_xyz(50)*pol_z(1, 0, kg) + coef_xy(2, 50) = coef_xy(2, 50) + coef_xyz(50)*pol_z(2, 0, kg) + coef_xy(1, 51) = coef_xy(1, 51) + coef_xyz(51)*pol_z(1, 0, kg) + coef_xy(2, 51) = coef_xy(2, 51) + coef_xyz(51)*pol_z(2, 0, kg) + coef_xy(1, 52) = coef_xy(1, 52) + coef_xyz(52)*pol_z(1, 0, kg) + coef_xy(2, 52) = coef_xy(2, 52) + coef_xyz(52)*pol_z(2, 0, kg) + coef_xy(1, 53) = coef_xy(1, 53) + coef_xyz(53)*pol_z(1, 0, kg) + coef_xy(2, 53) = coef_xy(2, 53) + coef_xyz(53)*pol_z(2, 0, kg) + coef_xy(1, 54) = coef_xy(1, 54) + coef_xyz(54)*pol_z(1, 0, kg) + coef_xy(2, 54) = coef_xy(2, 54) + coef_xyz(54)*pol_z(2, 0, kg) + coef_xy(1, 55) = coef_xy(1, 55) + coef_xyz(55)*pol_z(1, 0, kg) + coef_xy(2, 55) = coef_xy(2, 55) + coef_xyz(55)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(56)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(56)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(57)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(57)*pol_z(2, 1, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(58)*pol_z(1, 1, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(58)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(59)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(59)*pol_z(2, 1, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(60)*pol_z(1, 1, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(60)*pol_z(2, 1, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(61)*pol_z(1, 1, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(61)*pol_z(2, 1, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(62)*pol_z(1, 1, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(62)*pol_z(2, 1, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(63)*pol_z(1, 1, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(63)*pol_z(2, 1, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(64)*pol_z(1, 1, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(64)*pol_z(2, 1, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(65)*pol_z(1, 1, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(65)*pol_z(2, 1, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(66)*pol_z(1, 1, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(66)*pol_z(2, 1, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(67)*pol_z(1, 1, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(67)*pol_z(2, 1, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(68)*pol_z(1, 1, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(68)*pol_z(2, 1, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(69)*pol_z(1, 1, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(69)*pol_z(2, 1, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(70)*pol_z(1, 1, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(70)*pol_z(2, 1, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(71)*pol_z(1, 1, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(71)*pol_z(2, 1, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(72)*pol_z(1, 1, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(72)*pol_z(2, 1, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(73)*pol_z(1, 1, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(73)*pol_z(2, 1, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(74)*pol_z(1, 1, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(74)*pol_z(2, 1, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(75)*pol_z(1, 1, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(75)*pol_z(2, 1, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(76)*pol_z(1, 1, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(76)*pol_z(2, 1, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(77)*pol_z(1, 1, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(77)*pol_z(2, 1, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(78)*pol_z(1, 1, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(78)*pol_z(2, 1, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(79)*pol_z(1, 1, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(79)*pol_z(2, 1, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(80)*pol_z(1, 1, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(80)*pol_z(2, 1, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(81)*pol_z(1, 1, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(81)*pol_z(2, 1, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(82)*pol_z(1, 1, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(82)*pol_z(2, 1, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(83)*pol_z(1, 1, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(83)*pol_z(2, 1, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(84)*pol_z(1, 1, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(84)*pol_z(2, 1, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(85)*pol_z(1, 1, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(85)*pol_z(2, 1, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(86)*pol_z(1, 1, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(86)*pol_z(2, 1, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(87)*pol_z(1, 1, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(87)*pol_z(2, 1, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(88)*pol_z(1, 1, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(88)*pol_z(2, 1, kg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_xyz(89)*pol_z(1, 1, kg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_xyz(89)*pol_z(2, 1, kg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_xyz(90)*pol_z(1, 1, kg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_xyz(90)*pol_z(2, 1, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(91)*pol_z(1, 1, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(91)*pol_z(2, 1, kg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_xyz(92)*pol_z(1, 1, kg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_xyz(92)*pol_z(2, 1, kg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_xyz(93)*pol_z(1, 1, kg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_xyz(93)*pol_z(2, 1, kg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_xyz(94)*pol_z(1, 1, kg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_xyz(94)*pol_z(2, 1, kg) + coef_xy(1, 46) = coef_xy(1, 46) + coef_xyz(95)*pol_z(1, 1, kg) + coef_xy(2, 46) = coef_xy(2, 46) + coef_xyz(95)*pol_z(2, 1, kg) + coef_xy(1, 47) = coef_xy(1, 47) + coef_xyz(96)*pol_z(1, 1, kg) + coef_xy(2, 47) = coef_xy(2, 47) + coef_xyz(96)*pol_z(2, 1, kg) + coef_xy(1, 48) = coef_xy(1, 48) + coef_xyz(97)*pol_z(1, 1, kg) + coef_xy(2, 48) = coef_xy(2, 48) + coef_xyz(97)*pol_z(2, 1, kg) + coef_xy(1, 50) = coef_xy(1, 50) + coef_xyz(98)*pol_z(1, 1, kg) + coef_xy(2, 50) = coef_xy(2, 50) + coef_xyz(98)*pol_z(2, 1, kg) + coef_xy(1, 51) = coef_xy(1, 51) + coef_xyz(99)*pol_z(1, 1, kg) + coef_xy(2, 51) = coef_xy(2, 51) + coef_xyz(99)*pol_z(2, 1, kg) + coef_xy(1, 53) = coef_xy(1, 53) + coef_xyz(100)*pol_z(1, 1, kg) + coef_xy(2, 53) = coef_xy(2, 53) + coef_xyz(100)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(101)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(101)*pol_z(2, 2, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(102)*pol_z(1, 2, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(102)*pol_z(2, 2, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(103)*pol_z(1, 2, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(103)*pol_z(2, 2, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(104)*pol_z(1, 2, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(104)*pol_z(2, 2, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(105)*pol_z(1, 2, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(105)*pol_z(2, 2, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(106)*pol_z(1, 2, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(106)*pol_z(2, 2, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(107)*pol_z(1, 2, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(107)*pol_z(2, 2, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(108)*pol_z(1, 2, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(108)*pol_z(2, 2, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(109)*pol_z(1, 2, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(109)*pol_z(2, 2, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(110)*pol_z(1, 2, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(110)*pol_z(2, 2, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(111)*pol_z(1, 2, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(111)*pol_z(2, 2, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(112)*pol_z(1, 2, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(112)*pol_z(2, 2, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(113)*pol_z(1, 2, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(113)*pol_z(2, 2, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(114)*pol_z(1, 2, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(114)*pol_z(2, 2, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(115)*pol_z(1, 2, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(115)*pol_z(2, 2, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(116)*pol_z(1, 2, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(116)*pol_z(2, 2, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(117)*pol_z(1, 2, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(117)*pol_z(2, 2, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(118)*pol_z(1, 2, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(118)*pol_z(2, 2, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(119)*pol_z(1, 2, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(119)*pol_z(2, 2, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(120)*pol_z(1, 2, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(120)*pol_z(2, 2, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(121)*pol_z(1, 2, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(121)*pol_z(2, 2, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(122)*pol_z(1, 2, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(122)*pol_z(2, 2, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(123)*pol_z(1, 2, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(123)*pol_z(2, 2, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(124)*pol_z(1, 2, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(124)*pol_z(2, 2, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(125)*pol_z(1, 2, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(125)*pol_z(2, 2, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(126)*pol_z(1, 2, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(126)*pol_z(2, 2, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(127)*pol_z(1, 2, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(127)*pol_z(2, 2, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(128)*pol_z(1, 2, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(128)*pol_z(2, 2, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(129)*pol_z(1, 2, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(129)*pol_z(2, 2, kg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_xyz(130)*pol_z(1, 2, kg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_xyz(130)*pol_z(2, 2, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(131)*pol_z(1, 2, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(131)*pol_z(2, 2, kg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_xyz(132)*pol_z(1, 2, kg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_xyz(132)*pol_z(2, 2, kg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_xyz(133)*pol_z(1, 2, kg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_xyz(133)*pol_z(2, 2, kg) + coef_xy(1, 46) = coef_xy(1, 46) + coef_xyz(134)*pol_z(1, 2, kg) + coef_xy(2, 46) = coef_xy(2, 46) + coef_xyz(134)*pol_z(2, 2, kg) + coef_xy(1, 47) = coef_xy(1, 47) + coef_xyz(135)*pol_z(1, 2, kg) + coef_xy(2, 47) = coef_xy(2, 47) + coef_xyz(135)*pol_z(2, 2, kg) + coef_xy(1, 50) = coef_xy(1, 50) + coef_xyz(136)*pol_z(1, 2, kg) + coef_xy(2, 50) = coef_xy(2, 50) + coef_xyz(136)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(137)*pol_z(1, 3, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(137)*pol_z(2, 3, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(138)*pol_z(1, 3, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(138)*pol_z(2, 3, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(139)*pol_z(1, 3, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(139)*pol_z(2, 3, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(140)*pol_z(1, 3, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(140)*pol_z(2, 3, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(141)*pol_z(1, 3, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(141)*pol_z(2, 3, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(142)*pol_z(1, 3, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(142)*pol_z(2, 3, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(143)*pol_z(1, 3, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(143)*pol_z(2, 3, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(144)*pol_z(1, 3, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(144)*pol_z(2, 3, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(145)*pol_z(1, 3, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(145)*pol_z(2, 3, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(146)*pol_z(1, 3, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(146)*pol_z(2, 3, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(147)*pol_z(1, 3, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(147)*pol_z(2, 3, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(148)*pol_z(1, 3, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(148)*pol_z(2, 3, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(149)*pol_z(1, 3, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(149)*pol_z(2, 3, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(150)*pol_z(1, 3, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(150)*pol_z(2, 3, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(151)*pol_z(1, 3, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(151)*pol_z(2, 3, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(152)*pol_z(1, 3, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(152)*pol_z(2, 3, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(153)*pol_z(1, 3, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(153)*pol_z(2, 3, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(154)*pol_z(1, 3, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(154)*pol_z(2, 3, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(155)*pol_z(1, 3, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(155)*pol_z(2, 3, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(156)*pol_z(1, 3, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(156)*pol_z(2, 3, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(157)*pol_z(1, 3, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(157)*pol_z(2, 3, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(158)*pol_z(1, 3, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(158)*pol_z(2, 3, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(159)*pol_z(1, 3, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(159)*pol_z(2, 3, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(160)*pol_z(1, 3, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(160)*pol_z(2, 3, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(161)*pol_z(1, 3, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(161)*pol_z(2, 3, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(162)*pol_z(1, 3, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(162)*pol_z(2, 3, kg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_xyz(163)*pol_z(1, 3, kg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_xyz(163)*pol_z(2, 3, kg) + coef_xy(1, 46) = coef_xy(1, 46) + coef_xyz(164)*pol_z(1, 3, kg) + coef_xy(2, 46) = coef_xy(2, 46) + coef_xyz(164)*pol_z(2, 3, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(165)*pol_z(1, 4, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(165)*pol_z(2, 4, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(166)*pol_z(1, 4, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(166)*pol_z(2, 4, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(167)*pol_z(1, 4, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(167)*pol_z(2, 4, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(168)*pol_z(1, 4, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(168)*pol_z(2, 4, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(169)*pol_z(1, 4, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(169)*pol_z(2, 4, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(170)*pol_z(1, 4, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(170)*pol_z(2, 4, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(171)*pol_z(1, 4, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(171)*pol_z(2, 4, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(172)*pol_z(1, 4, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(172)*pol_z(2, 4, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(173)*pol_z(1, 4, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(173)*pol_z(2, 4, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(174)*pol_z(1, 4, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(174)*pol_z(2, 4, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(175)*pol_z(1, 4, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(175)*pol_z(2, 4, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(176)*pol_z(1, 4, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(176)*pol_z(2, 4, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(177)*pol_z(1, 4, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(177)*pol_z(2, 4, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(178)*pol_z(1, 4, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(178)*pol_z(2, 4, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(179)*pol_z(1, 4, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(179)*pol_z(2, 4, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(180)*pol_z(1, 4, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(180)*pol_z(2, 4, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(181)*pol_z(1, 4, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(181)*pol_z(2, 4, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(182)*pol_z(1, 4, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(182)*pol_z(2, 4, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(183)*pol_z(1, 4, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(183)*pol_z(2, 4, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(184)*pol_z(1, 4, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(184)*pol_z(2, 4, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(185)*pol_z(1, 4, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(185)*pol_z(2, 4, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(186)*pol_z(1, 5, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(186)*pol_z(2, 5, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(187)*pol_z(1, 5, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(187)*pol_z(2, 5, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(188)*pol_z(1, 5, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(188)*pol_z(2, 5, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(189)*pol_z(1, 5, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(189)*pol_z(2, 5, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(190)*pol_z(1, 5, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(190)*pol_z(2, 5, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(191)*pol_z(1, 5, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(191)*pol_z(2, 5, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(192)*pol_z(1, 5, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(192)*pol_z(2, 5, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(193)*pol_z(1, 5, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(193)*pol_z(2, 5, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(194)*pol_z(1, 5, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(194)*pol_z(2, 5, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(195)*pol_z(1, 5, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(195)*pol_z(2, 5, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(196)*pol_z(1, 5, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(196)*pol_z(2, 5, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(197)*pol_z(1, 5, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(197)*pol_z(2, 5, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(198)*pol_z(1, 5, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(198)*pol_z(2, 5, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(199)*pol_z(1, 5, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(199)*pol_z(2, 5, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(200)*pol_z(1, 5, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(200)*pol_z(2, 5, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(201)*pol_z(1, 6, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(201)*pol_z(2, 6, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(202)*pol_z(1, 6, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(202)*pol_z(2, 6, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(203)*pol_z(1, 6, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(203)*pol_z(2, 6, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(204)*pol_z(1, 6, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(204)*pol_z(2, 6, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(205)*pol_z(1, 6, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(205)*pol_z(2, 6, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(206)*pol_z(1, 6, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(206)*pol_z(2, 6, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(207)*pol_z(1, 6, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(207)*pol_z(2, 6, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(208)*pol_z(1, 6, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(208)*pol_z(2, 6, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(209)*pol_z(1, 6, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(209)*pol_z(2, 6, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(210)*pol_z(1, 6, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(210)*pol_z(2, 6, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(211)*pol_z(1, 7, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(211)*pol_z(2, 7, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(212)*pol_z(1, 7, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(212)*pol_z(2, 7, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(213)*pol_z(1, 7, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(213)*pol_z(2, 7, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(214)*pol_z(1, 7, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(214)*pol_z(2, 7, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(215)*pol_z(1, 7, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(215)*pol_z(2, 7, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(216)*pol_z(1, 7, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(216)*pol_z(2, 7, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(217)*pol_z(1, 8, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(217)*pol_z(2, 8, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(218)*pol_z(1, 8, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(218)*pol_z(2, 8, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(219)*pol_z(1, 8, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(219)*pol_z(2, 8, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(220)*pol_z(1, 9, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(220)*pol_z(2, 9, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 4)*pol_y(1, 0, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 4)*pol_y(1, 0, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 4)*pol_y(2, 0, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 4)*pol_y(2, 0, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 5)*pol_y(1, 0, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 5)*pol_y(1, 0, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 5)*pol_y(2, 0, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 5)*pol_y(2, 0, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 6)*pol_y(1, 0, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 6)*pol_y(1, 0, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 6)*pol_y(2, 0, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 6)*pol_y(2, 0, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 7)*pol_y(1, 0, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 7)*pol_y(1, 0, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 7)*pol_y(2, 0, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 7)*pol_y(2, 0, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 8)*pol_y(1, 0, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 8)*pol_y(1, 0, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 8)*pol_y(2, 0, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 8)*pol_y(2, 0, jg) - coef_x(1, 8) = coef_x(1, 8)+coef_xy(1, 9)*pol_y(1, 0, jg) - coef_x(2, 8) = coef_x(2, 8)+coef_xy(2, 9)*pol_y(1, 0, jg) - coef_x(3, 8) = coef_x(3, 8)+coef_xy(1, 9)*pol_y(2, 0, jg) - coef_x(4, 8) = coef_x(4, 8)+coef_xy(2, 9)*pol_y(2, 0, jg) - coef_x(1, 9) = coef_x(1, 9)+coef_xy(1, 10)*pol_y(1, 0, jg) - coef_x(2, 9) = coef_x(2, 9)+coef_xy(2, 10)*pol_y(1, 0, jg) - coef_x(3, 9) = coef_x(3, 9)+coef_xy(1, 10)*pol_y(2, 0, jg) - coef_x(4, 9) = coef_x(4, 9)+coef_xy(2, 10)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 11)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 11)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 11)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 11)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 12)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 12)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 12)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 12)*pol_y(2, 1, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 13)*pol_y(1, 1, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 13)*pol_y(1, 1, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 13)*pol_y(2, 1, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 13)*pol_y(2, 1, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 14)*pol_y(1, 1, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 14)*pol_y(1, 1, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 14)*pol_y(2, 1, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 14)*pol_y(2, 1, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 15)*pol_y(1, 1, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 15)*pol_y(1, 1, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 15)*pol_y(2, 1, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 15)*pol_y(2, 1, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 16)*pol_y(1, 1, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 16)*pol_y(1, 1, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 16)*pol_y(2, 1, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 16)*pol_y(2, 1, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 17)*pol_y(1, 1, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 17)*pol_y(1, 1, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 17)*pol_y(2, 1, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 17)*pol_y(2, 1, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 18)*pol_y(1, 1, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 18)*pol_y(1, 1, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 18)*pol_y(2, 1, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 18)*pol_y(2, 1, jg) - coef_x(1, 8) = coef_x(1, 8)+coef_xy(1, 19)*pol_y(1, 1, jg) - coef_x(2, 8) = coef_x(2, 8)+coef_xy(2, 19)*pol_y(1, 1, jg) - coef_x(3, 8) = coef_x(3, 8)+coef_xy(1, 19)*pol_y(2, 1, jg) - coef_x(4, 8) = coef_x(4, 8)+coef_xy(2, 19)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 20)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 20)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 20)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 20)*pol_y(2, 2, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 21)*pol_y(1, 2, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 21)*pol_y(1, 2, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 21)*pol_y(2, 2, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 21)*pol_y(2, 2, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 22)*pol_y(1, 2, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 22)*pol_y(1, 2, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 22)*pol_y(2, 2, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 22)*pol_y(2, 2, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 23)*pol_y(1, 2, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 23)*pol_y(1, 2, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 23)*pol_y(2, 2, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 23)*pol_y(2, 2, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 24)*pol_y(1, 2, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 24)*pol_y(1, 2, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 24)*pol_y(2, 2, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 24)*pol_y(2, 2, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 25)*pol_y(1, 2, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 25)*pol_y(1, 2, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 25)*pol_y(2, 2, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 25)*pol_y(2, 2, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 26)*pol_y(1, 2, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 26)*pol_y(1, 2, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 26)*pol_y(2, 2, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 26)*pol_y(2, 2, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 27)*pol_y(1, 2, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 27)*pol_y(1, 2, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 27)*pol_y(2, 2, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 27)*pol_y(2, 2, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 28)*pol_y(1, 3, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 28)*pol_y(1, 3, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 28)*pol_y(2, 3, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 28)*pol_y(2, 3, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 29)*pol_y(1, 3, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 29)*pol_y(1, 3, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 29)*pol_y(2, 3, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 29)*pol_y(2, 3, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 30)*pol_y(1, 3, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 30)*pol_y(1, 3, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 30)*pol_y(2, 3, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 30)*pol_y(2, 3, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 31)*pol_y(1, 3, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 31)*pol_y(1, 3, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 31)*pol_y(2, 3, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 31)*pol_y(2, 3, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 32)*pol_y(1, 3, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 32)*pol_y(1, 3, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 32)*pol_y(2, 3, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 32)*pol_y(2, 3, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 33)*pol_y(1, 3, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 33)*pol_y(1, 3, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 33)*pol_y(2, 3, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 33)*pol_y(2, 3, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 34)*pol_y(1, 3, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 34)*pol_y(1, 3, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 34)*pol_y(2, 3, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 34)*pol_y(2, 3, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 35)*pol_y(1, 4, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 35)*pol_y(1, 4, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 35)*pol_y(2, 4, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 35)*pol_y(2, 4, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 36)*pol_y(1, 4, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 36)*pol_y(1, 4, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 36)*pol_y(2, 4, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 36)*pol_y(2, 4, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 37)*pol_y(1, 4, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 37)*pol_y(1, 4, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 37)*pol_y(2, 4, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 37)*pol_y(2, 4, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 38)*pol_y(1, 4, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 38)*pol_y(1, 4, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 38)*pol_y(2, 4, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 38)*pol_y(2, 4, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 39)*pol_y(1, 4, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 39)*pol_y(1, 4, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 39)*pol_y(2, 4, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 39)*pol_y(2, 4, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 40)*pol_y(1, 4, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 40)*pol_y(1, 4, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 40)*pol_y(2, 4, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 40)*pol_y(2, 4, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 41)*pol_y(1, 5, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 41)*pol_y(1, 5, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 41)*pol_y(2, 5, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 41)*pol_y(2, 5, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 42)*pol_y(1, 5, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 42)*pol_y(1, 5, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 42)*pol_y(2, 5, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 42)*pol_y(2, 5, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 43)*pol_y(1, 5, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 43)*pol_y(1, 5, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 43)*pol_y(2, 5, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 43)*pol_y(2, 5, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 44)*pol_y(1, 5, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 44)*pol_y(1, 5, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 44)*pol_y(2, 5, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 44)*pol_y(2, 5, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 45)*pol_y(1, 5, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 45)*pol_y(1, 5, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 45)*pol_y(2, 5, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 45)*pol_y(2, 5, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 46)*pol_y(1, 6, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 46)*pol_y(1, 6, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 46)*pol_y(2, 6, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 46)*pol_y(2, 6, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 47)*pol_y(1, 6, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 47)*pol_y(1, 6, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 47)*pol_y(2, 6, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 47)*pol_y(2, 6, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 48)*pol_y(1, 6, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 48)*pol_y(1, 6, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 48)*pol_y(2, 6, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 48)*pol_y(2, 6, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 49)*pol_y(1, 6, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 49)*pol_y(1, 6, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 49)*pol_y(2, 6, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 49)*pol_y(2, 6, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 50)*pol_y(1, 7, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 50)*pol_y(1, 7, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 50)*pol_y(2, 7, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 50)*pol_y(2, 7, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 51)*pol_y(1, 7, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 51)*pol_y(1, 7, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 51)*pol_y(2, 7, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 51)*pol_y(2, 7, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 52)*pol_y(1, 7, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 52)*pol_y(1, 7, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 52)*pol_y(2, 7, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 52)*pol_y(2, 7, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 53)*pol_y(1, 8, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 53)*pol_y(1, 8, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 53)*pol_y(2, 8, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 53)*pol_y(2, 8, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 54)*pol_y(1, 8, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 54)*pol_y(1, 8, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 54)*pol_y(2, 8, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 54)*pol_y(2, 8, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 55)*pol_y(1, 9, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 55)*pol_y(1, 9, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 55)*pol_y(2, 9, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 55)*pol_y(2, 9, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 4)*pol_y(1, 0, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 4)*pol_y(1, 0, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 4)*pol_y(2, 0, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 4)*pol_y(2, 0, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 5)*pol_y(1, 0, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 5)*pol_y(1, 0, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 5)*pol_y(2, 0, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 5)*pol_y(2, 0, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 6)*pol_y(1, 0, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 6)*pol_y(1, 0, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 6)*pol_y(2, 0, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 6)*pol_y(2, 0, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 7)*pol_y(1, 0, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 7)*pol_y(1, 0, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 7)*pol_y(2, 0, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 7)*pol_y(2, 0, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 8)*pol_y(1, 0, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 8)*pol_y(1, 0, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 8)*pol_y(2, 0, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 8)*pol_y(2, 0, jg) + coef_x(1, 8) = coef_x(1, 8) + coef_xy(1, 9)*pol_y(1, 0, jg) + coef_x(2, 8) = coef_x(2, 8) + coef_xy(2, 9)*pol_y(1, 0, jg) + coef_x(3, 8) = coef_x(3, 8) + coef_xy(1, 9)*pol_y(2, 0, jg) + coef_x(4, 8) = coef_x(4, 8) + coef_xy(2, 9)*pol_y(2, 0, jg) + coef_x(1, 9) = coef_x(1, 9) + coef_xy(1, 10)*pol_y(1, 0, jg) + coef_x(2, 9) = coef_x(2, 9) + coef_xy(2, 10)*pol_y(1, 0, jg) + coef_x(3, 9) = coef_x(3, 9) + coef_xy(1, 10)*pol_y(2, 0, jg) + coef_x(4, 9) = coef_x(4, 9) + coef_xy(2, 10)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 11)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 11)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 11)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 11)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 12)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 12)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 12)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 12)*pol_y(2, 1, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 13)*pol_y(1, 1, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 13)*pol_y(1, 1, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 13)*pol_y(2, 1, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 13)*pol_y(2, 1, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 14)*pol_y(1, 1, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 14)*pol_y(1, 1, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 14)*pol_y(2, 1, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 14)*pol_y(2, 1, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 15)*pol_y(1, 1, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 15)*pol_y(1, 1, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 15)*pol_y(2, 1, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 15)*pol_y(2, 1, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 16)*pol_y(1, 1, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 16)*pol_y(1, 1, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 16)*pol_y(2, 1, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 16)*pol_y(2, 1, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 17)*pol_y(1, 1, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 17)*pol_y(1, 1, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 17)*pol_y(2, 1, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 17)*pol_y(2, 1, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 18)*pol_y(1, 1, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 18)*pol_y(1, 1, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 18)*pol_y(2, 1, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 18)*pol_y(2, 1, jg) + coef_x(1, 8) = coef_x(1, 8) + coef_xy(1, 19)*pol_y(1, 1, jg) + coef_x(2, 8) = coef_x(2, 8) + coef_xy(2, 19)*pol_y(1, 1, jg) + coef_x(3, 8) = coef_x(3, 8) + coef_xy(1, 19)*pol_y(2, 1, jg) + coef_x(4, 8) = coef_x(4, 8) + coef_xy(2, 19)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 20)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 20)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 20)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 20)*pol_y(2, 2, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 21)*pol_y(1, 2, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 21)*pol_y(1, 2, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 21)*pol_y(2, 2, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 21)*pol_y(2, 2, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 22)*pol_y(1, 2, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 22)*pol_y(1, 2, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 22)*pol_y(2, 2, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 22)*pol_y(2, 2, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 23)*pol_y(1, 2, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 23)*pol_y(1, 2, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 23)*pol_y(2, 2, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 23)*pol_y(2, 2, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 24)*pol_y(1, 2, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 24)*pol_y(1, 2, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 24)*pol_y(2, 2, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 24)*pol_y(2, 2, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 25)*pol_y(1, 2, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 25)*pol_y(1, 2, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 25)*pol_y(2, 2, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 25)*pol_y(2, 2, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 26)*pol_y(1, 2, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 26)*pol_y(1, 2, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 26)*pol_y(2, 2, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 26)*pol_y(2, 2, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 27)*pol_y(1, 2, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 27)*pol_y(1, 2, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 27)*pol_y(2, 2, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 27)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 28)*pol_y(1, 3, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 28)*pol_y(1, 3, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 28)*pol_y(2, 3, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 28)*pol_y(2, 3, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 29)*pol_y(1, 3, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 29)*pol_y(1, 3, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 29)*pol_y(2, 3, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 29)*pol_y(2, 3, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 30)*pol_y(1, 3, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 30)*pol_y(1, 3, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 30)*pol_y(2, 3, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 30)*pol_y(2, 3, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 31)*pol_y(1, 3, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 31)*pol_y(1, 3, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 31)*pol_y(2, 3, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 31)*pol_y(2, 3, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 32)*pol_y(1, 3, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 32)*pol_y(1, 3, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 32)*pol_y(2, 3, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 32)*pol_y(2, 3, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 33)*pol_y(1, 3, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 33)*pol_y(1, 3, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 33)*pol_y(2, 3, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 33)*pol_y(2, 3, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 34)*pol_y(1, 3, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 34)*pol_y(1, 3, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 34)*pol_y(2, 3, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 34)*pol_y(2, 3, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 35)*pol_y(1, 4, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 35)*pol_y(1, 4, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 35)*pol_y(2, 4, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 35)*pol_y(2, 4, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 36)*pol_y(1, 4, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 36)*pol_y(1, 4, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 36)*pol_y(2, 4, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 36)*pol_y(2, 4, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 37)*pol_y(1, 4, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 37)*pol_y(1, 4, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 37)*pol_y(2, 4, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 37)*pol_y(2, 4, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 38)*pol_y(1, 4, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 38)*pol_y(1, 4, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 38)*pol_y(2, 4, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 38)*pol_y(2, 4, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 39)*pol_y(1, 4, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 39)*pol_y(1, 4, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 39)*pol_y(2, 4, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 39)*pol_y(2, 4, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 40)*pol_y(1, 4, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 40)*pol_y(1, 4, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 40)*pol_y(2, 4, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 40)*pol_y(2, 4, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 41)*pol_y(1, 5, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 41)*pol_y(1, 5, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 41)*pol_y(2, 5, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 41)*pol_y(2, 5, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 42)*pol_y(1, 5, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 42)*pol_y(1, 5, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 42)*pol_y(2, 5, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 42)*pol_y(2, 5, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 43)*pol_y(1, 5, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 43)*pol_y(1, 5, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 43)*pol_y(2, 5, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 43)*pol_y(2, 5, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 44)*pol_y(1, 5, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 44)*pol_y(1, 5, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 44)*pol_y(2, 5, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 44)*pol_y(2, 5, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 45)*pol_y(1, 5, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 45)*pol_y(1, 5, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 45)*pol_y(2, 5, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 45)*pol_y(2, 5, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 46)*pol_y(1, 6, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 46)*pol_y(1, 6, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 46)*pol_y(2, 6, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 46)*pol_y(2, 6, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 47)*pol_y(1, 6, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 47)*pol_y(1, 6, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 47)*pol_y(2, 6, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 47)*pol_y(2, 6, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 48)*pol_y(1, 6, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 48)*pol_y(1, 6, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 48)*pol_y(2, 6, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 48)*pol_y(2, 6, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 49)*pol_y(1, 6, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 49)*pol_y(1, 6, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 49)*pol_y(2, 6, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 49)*pol_y(2, 6, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 50)*pol_y(1, 7, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 50)*pol_y(1, 7, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 50)*pol_y(2, 7, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 50)*pol_y(2, 7, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 51)*pol_y(1, 7, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 51)*pol_y(1, 7, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 51)*pol_y(2, 7, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 51)*pol_y(2, 7, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 52)*pol_y(1, 7, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 52)*pol_y(1, 7, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 52)*pol_y(2, 7, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 52)*pol_y(2, 7, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 53)*pol_y(1, 8, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 53)*pol_y(1, 8, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 53)*pol_y(2, 8, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 53)*pol_y(2, 8, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 54)*pol_y(1, 8, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 54)*pol_y(1, 8, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 54)*pol_y(2, 8, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 54)*pol_y(2, 8, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 55)*pol_y(1, 9, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 55)*pol_y(1, 9, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 55)*pol_y(2, 9, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 55)*pol_y(2, 9, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - s01 = s01+coef_x(1, 4)*pol_x(4, ig) - s02 = s02+coef_x(2, 4)*pol_x(4, ig) - s03 = s03+coef_x(3, 4)*pol_x(4, ig) - s04 = s04+coef_x(4, 4)*pol_x(4, ig) - s01 = s01+coef_x(1, 5)*pol_x(5, ig) - s02 = s02+coef_x(2, 5)*pol_x(5, ig) - s03 = s03+coef_x(3, 5)*pol_x(5, ig) - s04 = s04+coef_x(4, 5)*pol_x(5, ig) - s01 = s01+coef_x(1, 6)*pol_x(6, ig) - s02 = s02+coef_x(2, 6)*pol_x(6, ig) - s03 = s03+coef_x(3, 6)*pol_x(6, ig) - s04 = s04+coef_x(4, 6)*pol_x(6, ig) - s01 = s01+coef_x(1, 7)*pol_x(7, ig) - s02 = s02+coef_x(2, 7)*pol_x(7, ig) - s03 = s03+coef_x(3, 7)*pol_x(7, ig) - s04 = s04+coef_x(4, 7)*pol_x(7, ig) - s01 = s01+coef_x(1, 8)*pol_x(8, ig) - s02 = s02+coef_x(2, 8)*pol_x(8, ig) - s03 = s03+coef_x(3, 8)*pol_x(8, ig) - s04 = s04+coef_x(4, 8)*pol_x(8, ig) - s01 = s01+coef_x(1, 9)*pol_x(9, ig) - s02 = s02+coef_x(2, 9)*pol_x(9, ig) - s03 = s03+coef_x(3, 9)*pol_x(9, ig) - s04 = s04+coef_x(4, 9)*pol_x(9, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + s01 = s01 + coef_x(1, 4)*pol_x(4, ig) + s02 = s02 + coef_x(2, 4)*pol_x(4, ig) + s03 = s03 + coef_x(3, 4)*pol_x(4, ig) + s04 = s04 + coef_x(4, 4)*pol_x(4, ig) + s01 = s01 + coef_x(1, 5)*pol_x(5, ig) + s02 = s02 + coef_x(2, 5)*pol_x(5, ig) + s03 = s03 + coef_x(3, 5)*pol_x(5, ig) + s04 = s04 + coef_x(4, 5)*pol_x(5, ig) + s01 = s01 + coef_x(1, 6)*pol_x(6, ig) + s02 = s02 + coef_x(2, 6)*pol_x(6, ig) + s03 = s03 + coef_x(3, 6)*pol_x(6, ig) + s04 = s04 + coef_x(4, 6)*pol_x(6, ig) + s01 = s01 + coef_x(1, 7)*pol_x(7, ig) + s02 = s02 + coef_x(2, 7)*pol_x(7, ig) + s03 = s03 + coef_x(3, 7)*pol_x(7, ig) + s04 = s04 + coef_x(4, 7)*pol_x(7, ig) + s01 = s01 + coef_x(1, 8)*pol_x(8, ig) + s02 = s02 + coef_x(2, 8)*pol_x(8, ig) + s03 = s03 + coef_x(3, 8)*pol_x(8, ig) + s04 = s04 + coef_x(4, 8)*pol_x(8, ig) + s01 = s01 + coef_x(1, 9)*pol_x(9, ig) + s02 = s02 + coef_x(2, 9)*pol_x(9, ig) + s03 = s03 + coef_x(3, 9)*pol_x(9, ig) + s04 = s04 + coef_x(4, 9)*pol_x(9, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO diff --git a/src/grid/collocate_fast_4.f90 b/src/grid/collocate_fast_4.f90 index 41717dae4d..356d1a9608 100644 --- a/src/grid/collocate_fast_4.f90 +++ b/src/grid/collocate_fast_4.f90 @@ -14,7 +14,7 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bounds, lp, cmax, gridbounds) USE kinds, ONLY: dp INTEGER, INTENT(IN) :: sphere_bounds(*), lp - REAL(dp), INTENT(IN) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(IN) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER, INTENT(IN) :: cmax REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & @@ -29,15 +29,15 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) @@ -45,35 +45,35 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_xyz(lxyz)*pol_z(1, lzp, kg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_xyz(lxyz)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_xyz(lxyz)*pol_z(1, lzp, kg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_xyz(lxyz)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_x(1, lxp) = coef_x(1, lxp)+coef_xy(1, lxy)*pol_y(1, lyp, jg) - coef_x(2, lxp) = coef_x(2, lxp)+coef_xy(2, lxy)*pol_y(1, lyp, jg) - coef_x(3, lxp) = coef_x(3, lxp)+coef_xy(1, lxy)*pol_y(2, lyp, jg) - coef_x(4, lxp) = coef_x(4, lxp)+coef_xy(2, lxy)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_x(1, lxp) = coef_x(1, lxp) + coef_xy(1, lxy)*pol_y(1, lyp, jg) + coef_x(2, lxp) = coef_x(2, lxp) + coef_xy(2, lxy)*pol_y(1, lyp, jg) + coef_x(3, lxp) = coef_x(3, lxp) + coef_xy(1, lxy)*pol_y(2, lyp, jg) + coef_x(4, lxp) = coef_x(4, lxp) + coef_xy(2, lxy)*pol_y(2, lyp, jg) ENDDO ENDDO @@ -84,15 +84,15 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe s03 = 0.0_dp s04 = 0.0_dp DO lxp = 0, lp - s01 = s01+coef_x(1, lxp)*pol_x(lxp, ig) - s02 = s02+coef_x(2, lxp)*pol_x(lxp, ig) - s03 = s03+coef_x(3, lxp)*pol_x(lxp, ig) - s04 = s04+coef_x(4, lxp)*pol_x(lxp, ig) + s01 = s01 + coef_x(1, lxp)*pol_x(lxp, ig) + s02 = s02 + coef_x(2, lxp)*pol_x(lxp, ig) + s03 = s03 + coef_x(3, lxp)*pol_x(lxp, ig) + s04 = s04 + coef_x(4, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO @@ -120,43 +120,43 @@ SUBROUTINE collocate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 0 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lyp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(1)*pol_z(:, 0, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(1)*pol_z(:, 0, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_x(1, lxp) = coef_x(1, lxp)+coef_xy(1, lxy)*pol_y(1, lyp, jg) - coef_x(2, lxp) = coef_x(2, lxp)+coef_xy(2, lxy)*pol_y(1, lyp, jg) - coef_x(3, lxp) = coef_x(3, lxp)+coef_xy(1, lxy)*pol_y(2, lyp, jg) - coef_x(4, lxp) = coef_x(4, lxp)+coef_xy(2, lxy)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_x(1, lxp) = coef_x(1, lxp) + coef_xy(1, lxy)*pol_y(1, lyp, jg) + coef_x(2, lxp) = coef_x(2, lxp) + coef_xy(2, lxy)*pol_y(1, lyp, jg) + coef_x(3, lxp) = coef_x(3, lxp) + coef_xy(1, lxy)*pol_y(2, lyp, jg) + coef_x(4, lxp) = coef_x(4, lxp) + coef_xy(2, lxy)*pol_y(2, lyp, jg) ENDDO ENDDO DO ig = igmin, igmax @@ -166,15 +166,15 @@ SUBROUTINE collocate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = 0.0_dp s04 = 0.0_dp DO lxp = 0, lp - s01 = s01+coef_x(1, lxp)*pol_x(lxp, ig) - s02 = s02+coef_x(2, lxp)*pol_x(lxp, ig) - s03 = s03+coef_x(3, lxp)*pol_x(lxp, ig) - s04 = s04+coef_x(4, lxp)*pol_x(lxp, ig) + s01 = s01 + coef_x(1, lxp)*pol_x(lxp, ig) + s02 = s02 + coef_x(2, lxp)*pol_x(lxp, ig) + s03 = s03 + coef_x(3, lxp)*pol_x(lxp, ig) + s04 = s04 + coef_x(4, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -201,44 +201,44 @@ SUBROUTINE collocate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 1 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(1)*pol_z(:, 0, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(2)*pol_z(:, 0, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(3)*pol_z(:, 0, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(4)*pol_z(:, 1, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(1)*pol_z(:, 0, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(2)*pol_z(:, 0, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(3)*pol_z(:, 0, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(4)*pol_z(:, 1, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 1)*pol_y(1, 0, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 1)*pol_y(2, 0, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 2)*pol_y(1, 0, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 2)*pol_y(2, 0, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 3)*pol_y(1, 1, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 3)*pol_y(2, 1, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 1)*pol_y(1, 0, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 1)*pol_y(2, 0, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 2)*pol_y(1, 0, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 2)*pol_y(2, 0, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 3)*pol_y(1, 1, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 3)*pol_y(2, 1, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp @@ -246,15 +246,15 @@ SUBROUTINE collocate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = 0.0_dp s04 = 0.0_dp DO lxp = 0, lp - s01 = s01+coef_x(1, lxp)*pol_x(lxp, ig) - s02 = s02+coef_x(2, lxp)*pol_x(lxp, ig) - s03 = s03+coef_x(3, lxp)*pol_x(lxp, ig) - s04 = s04+coef_x(4, lxp)*pol_x(lxp, ig) + s01 = s01 + coef_x(1, lxp)*pol_x(lxp, ig) + s02 = s02 + coef_x(2, lxp)*pol_x(lxp, ig) + s03 = s03 + coef_x(3, lxp)*pol_x(lxp, ig) + s04 = s04 + coef_x(4, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -281,88 +281,88 @@ SUBROUTINE collocate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 2 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(7)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(7)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(8)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(8)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(9)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(9)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(10)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(10)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(7)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(7)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(8)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(8)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(9)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(9)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(10)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(10)*pol_z(2, 2, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 1)*pol_y(1, 0, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 1)*pol_y(2, 0, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 2)*pol_y(1, 0, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 2)*pol_y(2, 0, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 3)*pol_y(1, 0, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 3)*pol_y(2, 0, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 4)*pol_y(1, 1, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 4)*pol_y(2, 1, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 5)*pol_y(1, 1, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 5)*pol_y(2, 1, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 6)*pol_y(1, 2, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 6)*pol_y(2, 2, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 1)*pol_y(1, 0, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 1)*pol_y(2, 0, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 2)*pol_y(1, 0, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 2)*pol_y(2, 0, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 3)*pol_y(1, 0, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 3)*pol_y(2, 0, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 4)*pol_y(1, 1, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 4)*pol_y(2, 1, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 5)*pol_y(1, 1, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 5)*pol_y(2, 1, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 6)*pol_y(1, 2, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 6)*pol_y(2, 2, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -389,94 +389,94 @@ SUBROUTINE collocate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 3 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(1)*pol_z(:, 0, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(2)*pol_z(:, 0, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(3)*pol_z(:, 0, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(4)*pol_z(:, 0, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(5)*pol_z(:, 0, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(6)*pol_z(:, 0, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(7)*pol_z(:, 0, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(8)*pol_z(:, 0, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(9)*pol_z(:, 0, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(10)*pol_z(:, 0, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(11)*pol_z(:, 1, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(12)*pol_z(:, 1, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(13)*pol_z(:, 1, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(14)*pol_z(:, 1, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(15)*pol_z(:, 1, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(16)*pol_z(:, 1, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(17)*pol_z(:, 2, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(18)*pol_z(:, 2, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(19)*pol_z(:, 2, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(20)*pol_z(:, 3, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(1)*pol_z(:, 0, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(2)*pol_z(:, 0, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(3)*pol_z(:, 0, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(4)*pol_z(:, 0, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(5)*pol_z(:, 0, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(6)*pol_z(:, 0, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(7)*pol_z(:, 0, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(8)*pol_z(:, 0, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(9)*pol_z(:, 0, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(10)*pol_z(:, 0, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(11)*pol_z(:, 1, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(12)*pol_z(:, 1, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(13)*pol_z(:, 1, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(14)*pol_z(:, 1, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(15)*pol_z(:, 1, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(16)*pol_z(:, 1, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(17)*pol_z(:, 2, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(18)*pol_z(:, 2, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(19)*pol_z(:, 2, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(20)*pol_z(:, 3, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 4)*pol_y(1, 0, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 4)*pol_y(1, 0, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 4)*pol_y(2, 0, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 4)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 5)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 5)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 5)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 5)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 6)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 6)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 6)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 6)*pol_y(2, 1, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 7)*pol_y(1, 1, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 7)*pol_y(1, 1, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 7)*pol_y(2, 1, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 7)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 8)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 8)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 8)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 8)*pol_y(2, 2, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 9)*pol_y(1, 2, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 9)*pol_y(1, 2, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 9)*pol_y(2, 2, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 9)*pol_y(2, 2, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 10)*pol_y(1, 3, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 10)*pol_y(1, 3, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 10)*pol_y(2, 3, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 10)*pol_y(2, 3, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 4)*pol_y(1, 0, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 4)*pol_y(1, 0, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 4)*pol_y(2, 0, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 4)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 5)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 5)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 5)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 5)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 6)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 6)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 6)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 6)*pol_y(2, 1, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 7)*pol_y(1, 1, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 7)*pol_y(1, 1, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 7)*pol_y(2, 1, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 7)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 8)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 8)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 8)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 8)*pol_y(2, 2, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 9)*pol_y(1, 2, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 9)*pol_y(1, 2, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 9)*pol_y(2, 2, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 9)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 10)*pol_y(1, 3, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 10)*pol_y(1, 3, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 10)*pol_y(2, 3, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 10)*pol_y(2, 3, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp @@ -484,15 +484,15 @@ SUBROUTINE collocate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = 0.0_dp s04 = 0.0_dp DO lxp = 0, lp - s01 = s01+coef_x(1, lxp)*pol_x(lxp, ig) - s02 = s02+coef_x(2, lxp)*pol_x(lxp, ig) - s03 = s03+coef_x(3, lxp)*pol_x(lxp, ig) - s04 = s04+coef_x(4, lxp)*pol_x(lxp, ig) + s01 = s01 + coef_x(1, lxp)*pol_x(lxp, ig) + s02 = s02 + coef_x(2, lxp)*pol_x(lxp, ig) + s03 = s03 + coef_x(3, lxp)*pol_x(lxp, ig) + s04 = s04 + coef_x(4, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -519,194 +519,194 @@ SUBROUTINE collocate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 4 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(7)*pol_z(1, 0, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(7)*pol_z(2, 0, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(8)*pol_z(1, 0, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(8)*pol_z(2, 0, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(9)*pol_z(1, 0, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(9)*pol_z(2, 0, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(10)*pol_z(1, 0, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(10)*pol_z(2, 0, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(11)*pol_z(1, 0, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(11)*pol_z(2, 0, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(12)*pol_z(1, 0, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(12)*pol_z(2, 0, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(13)*pol_z(1, 0, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(13)*pol_z(2, 0, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(14)*pol_z(1, 0, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(14)*pol_z(2, 0, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(15)*pol_z(1, 0, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(15)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(16)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(16)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(17)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(17)*pol_z(2, 1, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(18)*pol_z(1, 1, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(18)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(19)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(19)*pol_z(2, 1, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(20)*pol_z(1, 1, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(20)*pol_z(2, 1, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(21)*pol_z(1, 1, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(21)*pol_z(2, 1, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(22)*pol_z(1, 1, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(22)*pol_z(2, 1, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(23)*pol_z(1, 1, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(23)*pol_z(2, 1, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(24)*pol_z(1, 1, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(24)*pol_z(2, 1, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(25)*pol_z(1, 1, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(25)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(26)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(26)*pol_z(2, 2, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(27)*pol_z(1, 2, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(27)*pol_z(2, 2, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(28)*pol_z(1, 2, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(28)*pol_z(2, 2, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(29)*pol_z(1, 2, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(29)*pol_z(2, 2, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(30)*pol_z(1, 2, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(30)*pol_z(2, 2, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(31)*pol_z(1, 2, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(31)*pol_z(2, 2, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(32)*pol_z(1, 3, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(32)*pol_z(2, 3, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(33)*pol_z(1, 3, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(33)*pol_z(2, 3, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(34)*pol_z(1, 3, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(34)*pol_z(2, 3, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(35)*pol_z(1, 4, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(35)*pol_z(2, 4, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(7)*pol_z(1, 0, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(7)*pol_z(2, 0, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(8)*pol_z(1, 0, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(8)*pol_z(2, 0, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(9)*pol_z(1, 0, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(9)*pol_z(2, 0, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(10)*pol_z(1, 0, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(10)*pol_z(2, 0, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(11)*pol_z(1, 0, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(11)*pol_z(2, 0, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(12)*pol_z(1, 0, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(12)*pol_z(2, 0, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(13)*pol_z(1, 0, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(13)*pol_z(2, 0, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(14)*pol_z(1, 0, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(14)*pol_z(2, 0, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(15)*pol_z(1, 0, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(15)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(16)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(16)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(17)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(17)*pol_z(2, 1, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(18)*pol_z(1, 1, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(18)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(19)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(19)*pol_z(2, 1, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(20)*pol_z(1, 1, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(20)*pol_z(2, 1, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(21)*pol_z(1, 1, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(21)*pol_z(2, 1, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(22)*pol_z(1, 1, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(22)*pol_z(2, 1, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(23)*pol_z(1, 1, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(23)*pol_z(2, 1, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(24)*pol_z(1, 1, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(24)*pol_z(2, 1, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(25)*pol_z(1, 1, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(25)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(26)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(26)*pol_z(2, 2, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(27)*pol_z(1, 2, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(27)*pol_z(2, 2, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(28)*pol_z(1, 2, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(28)*pol_z(2, 2, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(29)*pol_z(1, 2, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(29)*pol_z(2, 2, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(30)*pol_z(1, 2, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(30)*pol_z(2, 2, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(31)*pol_z(1, 2, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(31)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(32)*pol_z(1, 3, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(32)*pol_z(2, 3, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(33)*pol_z(1, 3, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(33)*pol_z(2, 3, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(34)*pol_z(1, 3, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(34)*pol_z(2, 3, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(35)*pol_z(1, 4, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(35)*pol_z(2, 4, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 4)*pol_y(1, 0, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 4)*pol_y(1, 0, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 4)*pol_y(2, 0, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 4)*pol_y(2, 0, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 5)*pol_y(1, 0, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 5)*pol_y(1, 0, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 5)*pol_y(2, 0, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 5)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 6)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 6)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 6)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 6)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 7)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 7)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 7)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 7)*pol_y(2, 1, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 8)*pol_y(1, 1, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 8)*pol_y(1, 1, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 8)*pol_y(2, 1, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 8)*pol_y(2, 1, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 9)*pol_y(1, 1, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 9)*pol_y(1, 1, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 9)*pol_y(2, 1, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 9)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 10)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 10)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 10)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 10)*pol_y(2, 2, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 11)*pol_y(1, 2, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 11)*pol_y(1, 2, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 11)*pol_y(2, 2, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 11)*pol_y(2, 2, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 12)*pol_y(1, 2, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 12)*pol_y(1, 2, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 12)*pol_y(2, 2, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 12)*pol_y(2, 2, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 13)*pol_y(1, 3, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 13)*pol_y(1, 3, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 13)*pol_y(2, 3, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 13)*pol_y(2, 3, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 14)*pol_y(1, 3, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 14)*pol_y(1, 3, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 14)*pol_y(2, 3, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 14)*pol_y(2, 3, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 15)*pol_y(1, 4, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 15)*pol_y(1, 4, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 15)*pol_y(2, 4, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 15)*pol_y(2, 4, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 4)*pol_y(1, 0, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 4)*pol_y(1, 0, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 4)*pol_y(2, 0, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 4)*pol_y(2, 0, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 5)*pol_y(1, 0, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 5)*pol_y(1, 0, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 5)*pol_y(2, 0, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 5)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 6)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 6)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 6)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 6)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 7)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 7)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 7)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 7)*pol_y(2, 1, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 8)*pol_y(1, 1, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 8)*pol_y(1, 1, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 8)*pol_y(2, 1, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 8)*pol_y(2, 1, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 9)*pol_y(1, 1, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 9)*pol_y(1, 1, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 9)*pol_y(2, 1, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 9)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 10)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 10)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 10)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 10)*pol_y(2, 2, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 11)*pol_y(1, 2, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 11)*pol_y(1, 2, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 11)*pol_y(2, 2, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 11)*pol_y(2, 2, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 12)*pol_y(1, 2, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 12)*pol_y(1, 2, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 12)*pol_y(2, 2, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 12)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 13)*pol_y(1, 3, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 13)*pol_y(1, 3, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 13)*pol_y(2, 3, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 13)*pol_y(2, 3, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 14)*pol_y(1, 3, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 14)*pol_y(1, 3, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 14)*pol_y(2, 3, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 14)*pol_y(2, 3, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 15)*pol_y(1, 4, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 15)*pol_y(1, 4, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 15)*pol_y(2, 4, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 15)*pol_y(2, 4, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - s01 = s01+coef_x(1, 4)*pol_x(4, ig) - s02 = s02+coef_x(2, 4)*pol_x(4, ig) - s03 = s03+coef_x(3, 4)*pol_x(4, ig) - s04 = s04+coef_x(4, 4)*pol_x(4, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + s01 = s01 + coef_x(1, 4)*pol_x(4, ig) + s02 = s02 + coef_x(2, 4)*pol_x(4, ig) + s03 = s03 + coef_x(3, 4)*pol_x(4, ig) + s04 = s04 + coef_x(4, 4)*pol_x(4, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -733,188 +733,188 @@ SUBROUTINE collocate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 5 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(7)*pol_z(1, 0, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(7)*pol_z(2, 0, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(8)*pol_z(1, 0, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(8)*pol_z(2, 0, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(9)*pol_z(1, 0, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(9)*pol_z(2, 0, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(10)*pol_z(1, 0, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(10)*pol_z(2, 0, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(11)*pol_z(1, 0, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(11)*pol_z(2, 0, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(12)*pol_z(1, 0, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(12)*pol_z(2, 0, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(13)*pol_z(1, 0, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(13)*pol_z(2, 0, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(14)*pol_z(1, 0, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(14)*pol_z(2, 0, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(15)*pol_z(1, 0, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(15)*pol_z(2, 0, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(16)*pol_z(1, 0, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(16)*pol_z(2, 0, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(17)*pol_z(1, 0, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(17)*pol_z(2, 0, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(18)*pol_z(1, 0, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(18)*pol_z(2, 0, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(19)*pol_z(1, 0, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(19)*pol_z(2, 0, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(20)*pol_z(1, 0, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(20)*pol_z(2, 0, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(21)*pol_z(1, 0, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(21)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(22)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(22)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(23)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(23)*pol_z(2, 1, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(24)*pol_z(1, 1, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(24)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(25)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(25)*pol_z(2, 1, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(26)*pol_z(1, 1, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(26)*pol_z(2, 1, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(27)*pol_z(1, 1, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(27)*pol_z(2, 1, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(28)*pol_z(1, 1, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(28)*pol_z(2, 1, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(29)*pol_z(1, 1, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(29)*pol_z(2, 1, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(30)*pol_z(1, 1, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(30)*pol_z(2, 1, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(31)*pol_z(1, 1, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(31)*pol_z(2, 1, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(32)*pol_z(1, 1, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(32)*pol_z(2, 1, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(33)*pol_z(1, 1, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(33)*pol_z(2, 1, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(34)*pol_z(1, 1, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(34)*pol_z(2, 1, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(35)*pol_z(1, 1, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(35)*pol_z(2, 1, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(36)*pol_z(1, 1, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(36)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(37)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(37)*pol_z(2, 2, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(38)*pol_z(1, 2, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(38)*pol_z(2, 2, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(39)*pol_z(1, 2, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(39)*pol_z(2, 2, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(40)*pol_z(1, 2, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(40)*pol_z(2, 2, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(41)*pol_z(1, 2, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(41)*pol_z(2, 2, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(42)*pol_z(1, 2, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(42)*pol_z(2, 2, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(43)*pol_z(1, 2, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(43)*pol_z(2, 2, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(44)*pol_z(1, 2, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(44)*pol_z(2, 2, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(45)*pol_z(1, 2, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(45)*pol_z(2, 2, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(46)*pol_z(1, 2, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(46)*pol_z(2, 2, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(47)*pol_z(1, 3, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(47)*pol_z(2, 3, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(48)*pol_z(1, 3, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(48)*pol_z(2, 3, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(49)*pol_z(1, 3, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(49)*pol_z(2, 3, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(50)*pol_z(1, 3, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(50)*pol_z(2, 3, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(51)*pol_z(1, 3, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(51)*pol_z(2, 3, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(52)*pol_z(1, 3, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(52)*pol_z(2, 3, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(53)*pol_z(1, 4, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(53)*pol_z(2, 4, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(54)*pol_z(1, 4, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(54)*pol_z(2, 4, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(55)*pol_z(1, 4, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(55)*pol_z(2, 4, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(56)*pol_z(1, 5, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(56)*pol_z(2, 5, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(7)*pol_z(1, 0, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(7)*pol_z(2, 0, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(8)*pol_z(1, 0, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(8)*pol_z(2, 0, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(9)*pol_z(1, 0, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(9)*pol_z(2, 0, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(10)*pol_z(1, 0, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(10)*pol_z(2, 0, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(11)*pol_z(1, 0, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(11)*pol_z(2, 0, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(12)*pol_z(1, 0, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(12)*pol_z(2, 0, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(13)*pol_z(1, 0, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(13)*pol_z(2, 0, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(14)*pol_z(1, 0, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(14)*pol_z(2, 0, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(15)*pol_z(1, 0, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(15)*pol_z(2, 0, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(16)*pol_z(1, 0, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(16)*pol_z(2, 0, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(17)*pol_z(1, 0, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(17)*pol_z(2, 0, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(18)*pol_z(1, 0, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(18)*pol_z(2, 0, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(19)*pol_z(1, 0, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(19)*pol_z(2, 0, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(20)*pol_z(1, 0, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(20)*pol_z(2, 0, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(21)*pol_z(1, 0, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(21)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(22)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(22)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(23)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(23)*pol_z(2, 1, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(24)*pol_z(1, 1, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(24)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(25)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(25)*pol_z(2, 1, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(26)*pol_z(1, 1, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(26)*pol_z(2, 1, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(27)*pol_z(1, 1, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(27)*pol_z(2, 1, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(28)*pol_z(1, 1, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(28)*pol_z(2, 1, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(29)*pol_z(1, 1, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(29)*pol_z(2, 1, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(30)*pol_z(1, 1, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(30)*pol_z(2, 1, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(31)*pol_z(1, 1, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(31)*pol_z(2, 1, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(32)*pol_z(1, 1, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(32)*pol_z(2, 1, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(33)*pol_z(1, 1, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(33)*pol_z(2, 1, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(34)*pol_z(1, 1, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(34)*pol_z(2, 1, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(35)*pol_z(1, 1, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(35)*pol_z(2, 1, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(36)*pol_z(1, 1, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(36)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(37)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(37)*pol_z(2, 2, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(38)*pol_z(1, 2, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(38)*pol_z(2, 2, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(39)*pol_z(1, 2, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(39)*pol_z(2, 2, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(40)*pol_z(1, 2, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(40)*pol_z(2, 2, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(41)*pol_z(1, 2, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(41)*pol_z(2, 2, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(42)*pol_z(1, 2, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(42)*pol_z(2, 2, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(43)*pol_z(1, 2, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(43)*pol_z(2, 2, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(44)*pol_z(1, 2, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(44)*pol_z(2, 2, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(45)*pol_z(1, 2, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(45)*pol_z(2, 2, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(46)*pol_z(1, 2, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(46)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(47)*pol_z(1, 3, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(47)*pol_z(2, 3, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(48)*pol_z(1, 3, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(48)*pol_z(2, 3, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(49)*pol_z(1, 3, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(49)*pol_z(2, 3, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(50)*pol_z(1, 3, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(50)*pol_z(2, 3, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(51)*pol_z(1, 3, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(51)*pol_z(2, 3, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(52)*pol_z(1, 3, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(52)*pol_z(2, 3, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(53)*pol_z(1, 4, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(53)*pol_z(2, 4, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(54)*pol_z(1, 4, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(54)*pol_z(2, 4, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(55)*pol_z(1, 4, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(55)*pol_z(2, 4, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(56)*pol_z(1, 5, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(56)*pol_z(2, 5, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 1)*pol_y(1, 0, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 1)*pol_y(2, 0, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 2)*pol_y(1, 0, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 2)*pol_y(2, 0, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 3)*pol_y(1, 0, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 3)*pol_y(2, 0, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 4)*pol_y(1, 0, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 4)*pol_y(2, 0, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 5)*pol_y(1, 0, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 5)*pol_y(2, 0, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 6)*pol_y(1, 0, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 6)*pol_y(2, 0, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 7)*pol_y(1, 1, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 7)*pol_y(2, 1, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 8)*pol_y(1, 1, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 8)*pol_y(2, 1, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 9)*pol_y(1, 1, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 9)*pol_y(2, 1, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 10)*pol_y(1, 1, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 10)*pol_y(2, 1, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 11)*pol_y(1, 1, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 11)*pol_y(2, 1, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 12)*pol_y(1, 2, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 12)*pol_y(2, 2, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 13)*pol_y(1, 2, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 13)*pol_y(2, 2, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 14)*pol_y(1, 2, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 14)*pol_y(2, 2, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 15)*pol_y(1, 2, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 15)*pol_y(2, 2, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 16)*pol_y(1, 3, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 16)*pol_y(2, 3, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 17)*pol_y(1, 3, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 17)*pol_y(2, 3, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 18)*pol_y(1, 3, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 18)*pol_y(2, 3, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 19)*pol_y(1, 4, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 19)*pol_y(2, 4, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 20)*pol_y(1, 4, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 20)*pol_y(2, 4, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 21)*pol_y(1, 5, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 21)*pol_y(2, 5, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 1)*pol_y(1, 0, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 1)*pol_y(2, 0, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 2)*pol_y(1, 0, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 2)*pol_y(2, 0, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 3)*pol_y(1, 0, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 3)*pol_y(2, 0, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 4)*pol_y(1, 0, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 4)*pol_y(2, 0, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 5)*pol_y(1, 0, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 5)*pol_y(2, 0, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 6)*pol_y(1, 0, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 6)*pol_y(2, 0, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 7)*pol_y(1, 1, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 7)*pol_y(2, 1, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 8)*pol_y(1, 1, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 8)*pol_y(2, 1, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 9)*pol_y(1, 1, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 9)*pol_y(2, 1, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 10)*pol_y(1, 1, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 10)*pol_y(2, 1, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 11)*pol_y(1, 1, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 11)*pol_y(2, 1, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 12)*pol_y(1, 2, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 12)*pol_y(2, 2, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 13)*pol_y(1, 2, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 13)*pol_y(2, 2, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 14)*pol_y(1, 2, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 14)*pol_y(2, 2, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 15)*pol_y(1, 2, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 15)*pol_y(2, 2, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 16)*pol_y(1, 3, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 16)*pol_y(2, 3, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 17)*pol_y(1, 3, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 17)*pol_y(2, 3, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 18)*pol_y(1, 3, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 18)*pol_y(2, 3, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 19)*pol_y(1, 4, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 19)*pol_y(2, 4, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 20)*pol_y(1, 4, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 20)*pol_y(2, 4, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 21)*pol_y(1, 5, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 21)*pol_y(2, 5, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp @@ -922,15 +922,15 @@ SUBROUTINE collocate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = 0.0_dp s04 = 0.0_dp DO lxp = 0, lp - s01 = s01+coef_x(1, lxp)*pol_x(lxp, ig) - s02 = s02+coef_x(2, lxp)*pol_x(lxp, ig) - s03 = s03+coef_x(3, lxp)*pol_x(lxp, ig) - s04 = s04+coef_x(4, lxp)*pol_x(lxp, ig) + s01 = s01 + coef_x(1, lxp)*pol_x(lxp, ig) + s02 = s02 + coef_x(2, lxp)*pol_x(lxp, ig) + s03 = s03 + coef_x(3, lxp)*pol_x(lxp, ig) + s04 = s04 + coef_x(4, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -957,230 +957,230 @@ SUBROUTINE collocate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 6 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(1)*pol_z(:, 0, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(2)*pol_z(:, 0, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(3)*pol_z(:, 0, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(4)*pol_z(:, 0, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(5)*pol_z(:, 0, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(6)*pol_z(:, 0, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(7)*pol_z(:, 0, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(8)*pol_z(:, 0, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(9)*pol_z(:, 0, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(10)*pol_z(:, 0, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(11)*pol_z(:, 0, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(12)*pol_z(:, 0, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(13)*pol_z(:, 0, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(14)*pol_z(:, 0, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(15)*pol_z(:, 0, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(16)*pol_z(:, 0, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(17)*pol_z(:, 0, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(18)*pol_z(:, 0, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(19)*pol_z(:, 0, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(20)*pol_z(:, 0, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(21)*pol_z(:, 0, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(22)*pol_z(:, 0, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(23)*pol_z(:, 0, kg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_xyz(24)*pol_z(:, 0, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(25)*pol_z(:, 0, kg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_xyz(26)*pol_z(:, 0, kg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_xyz(27)*pol_z(:, 0, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(28)*pol_z(:, 0, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(29)*pol_z(:, 1, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(30)*pol_z(:, 1, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(31)*pol_z(:, 1, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(32)*pol_z(:, 1, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(33)*pol_z(:, 1, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(34)*pol_z(:, 1, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(35)*pol_z(:, 1, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(36)*pol_z(:, 1, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(37)*pol_z(:, 1, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(38)*pol_z(:, 1, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(39)*pol_z(:, 1, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(40)*pol_z(:, 1, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(41)*pol_z(:, 1, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(42)*pol_z(:, 1, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(43)*pol_z(:, 1, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(44)*pol_z(:, 1, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(45)*pol_z(:, 1, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(46)*pol_z(:, 1, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(47)*pol_z(:, 1, kg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_xyz(48)*pol_z(:, 1, kg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_xyz(49)*pol_z(:, 1, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(50)*pol_z(:, 2, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(51)*pol_z(:, 2, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(52)*pol_z(:, 2, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(53)*pol_z(:, 2, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(54)*pol_z(:, 2, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(55)*pol_z(:, 2, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(56)*pol_z(:, 2, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(57)*pol_z(:, 2, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(58)*pol_z(:, 2, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(59)*pol_z(:, 2, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(60)*pol_z(:, 2, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(61)*pol_z(:, 2, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(62)*pol_z(:, 2, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(63)*pol_z(:, 2, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(64)*pol_z(:, 2, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(65)*pol_z(:, 3, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(66)*pol_z(:, 3, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(67)*pol_z(:, 3, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(68)*pol_z(:, 3, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(69)*pol_z(:, 3, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(70)*pol_z(:, 3, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(71)*pol_z(:, 3, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(72)*pol_z(:, 3, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(73)*pol_z(:, 3, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(74)*pol_z(:, 3, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(75)*pol_z(:, 4, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(76)*pol_z(:, 4, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(77)*pol_z(:, 4, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(78)*pol_z(:, 4, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(79)*pol_z(:, 4, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(80)*pol_z(:, 4, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(81)*pol_z(:, 5, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(82)*pol_z(:, 5, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(83)*pol_z(:, 5, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(84)*pol_z(:, 6, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(1)*pol_z(:, 0, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(2)*pol_z(:, 0, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(3)*pol_z(:, 0, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(4)*pol_z(:, 0, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(5)*pol_z(:, 0, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(6)*pol_z(:, 0, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(7)*pol_z(:, 0, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(8)*pol_z(:, 0, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(9)*pol_z(:, 0, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(10)*pol_z(:, 0, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(11)*pol_z(:, 0, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(12)*pol_z(:, 0, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(13)*pol_z(:, 0, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(14)*pol_z(:, 0, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(15)*pol_z(:, 0, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(16)*pol_z(:, 0, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(17)*pol_z(:, 0, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(18)*pol_z(:, 0, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(19)*pol_z(:, 0, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(20)*pol_z(:, 0, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(21)*pol_z(:, 0, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(22)*pol_z(:, 0, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(23)*pol_z(:, 0, kg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_xyz(24)*pol_z(:, 0, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(25)*pol_z(:, 0, kg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_xyz(26)*pol_z(:, 0, kg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_xyz(27)*pol_z(:, 0, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(28)*pol_z(:, 0, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(29)*pol_z(:, 1, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(30)*pol_z(:, 1, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(31)*pol_z(:, 1, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(32)*pol_z(:, 1, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(33)*pol_z(:, 1, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(34)*pol_z(:, 1, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(35)*pol_z(:, 1, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(36)*pol_z(:, 1, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(37)*pol_z(:, 1, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(38)*pol_z(:, 1, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(39)*pol_z(:, 1, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(40)*pol_z(:, 1, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(41)*pol_z(:, 1, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(42)*pol_z(:, 1, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(43)*pol_z(:, 1, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(44)*pol_z(:, 1, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(45)*pol_z(:, 1, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(46)*pol_z(:, 1, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(47)*pol_z(:, 1, kg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_xyz(48)*pol_z(:, 1, kg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_xyz(49)*pol_z(:, 1, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(50)*pol_z(:, 2, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(51)*pol_z(:, 2, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(52)*pol_z(:, 2, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(53)*pol_z(:, 2, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(54)*pol_z(:, 2, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(55)*pol_z(:, 2, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(56)*pol_z(:, 2, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(57)*pol_z(:, 2, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(58)*pol_z(:, 2, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(59)*pol_z(:, 2, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(60)*pol_z(:, 2, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(61)*pol_z(:, 2, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(62)*pol_z(:, 2, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(63)*pol_z(:, 2, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(64)*pol_z(:, 2, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(65)*pol_z(:, 3, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(66)*pol_z(:, 3, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(67)*pol_z(:, 3, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(68)*pol_z(:, 3, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(69)*pol_z(:, 3, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(70)*pol_z(:, 3, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(71)*pol_z(:, 3, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(72)*pol_z(:, 3, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(73)*pol_z(:, 3, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(74)*pol_z(:, 3, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(75)*pol_z(:, 4, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(76)*pol_z(:, 4, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(77)*pol_z(:, 4, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(78)*pol_z(:, 4, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(79)*pol_z(:, 4, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(80)*pol_z(:, 4, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(81)*pol_z(:, 5, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(82)*pol_z(:, 5, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(83)*pol_z(:, 5, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(84)*pol_z(:, 6, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 4)*pol_y(1, 0, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 4)*pol_y(1, 0, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 4)*pol_y(2, 0, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 4)*pol_y(2, 0, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 5)*pol_y(1, 0, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 5)*pol_y(1, 0, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 5)*pol_y(2, 0, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 5)*pol_y(2, 0, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 6)*pol_y(1, 0, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 6)*pol_y(1, 0, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 6)*pol_y(2, 0, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 6)*pol_y(2, 0, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 7)*pol_y(1, 0, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 7)*pol_y(1, 0, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 7)*pol_y(2, 0, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 7)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 8)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 8)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 8)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 8)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 9)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 9)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 9)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 9)*pol_y(2, 1, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 10)*pol_y(1, 1, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 10)*pol_y(1, 1, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 10)*pol_y(2, 1, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 10)*pol_y(2, 1, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 11)*pol_y(1, 1, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 11)*pol_y(1, 1, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 11)*pol_y(2, 1, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 11)*pol_y(2, 1, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 12)*pol_y(1, 1, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 12)*pol_y(1, 1, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 12)*pol_y(2, 1, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 12)*pol_y(2, 1, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 13)*pol_y(1, 1, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 13)*pol_y(1, 1, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 13)*pol_y(2, 1, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 13)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 14)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 14)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 14)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 14)*pol_y(2, 2, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 15)*pol_y(1, 2, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 15)*pol_y(1, 2, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 15)*pol_y(2, 2, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 15)*pol_y(2, 2, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 16)*pol_y(1, 2, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 16)*pol_y(1, 2, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 16)*pol_y(2, 2, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 16)*pol_y(2, 2, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 17)*pol_y(1, 2, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 17)*pol_y(1, 2, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 17)*pol_y(2, 2, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 17)*pol_y(2, 2, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 18)*pol_y(1, 2, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 18)*pol_y(1, 2, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 18)*pol_y(2, 2, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 18)*pol_y(2, 2, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 19)*pol_y(1, 3, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 19)*pol_y(1, 3, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 19)*pol_y(2, 3, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 19)*pol_y(2, 3, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 20)*pol_y(1, 3, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 20)*pol_y(1, 3, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 20)*pol_y(2, 3, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 20)*pol_y(2, 3, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 21)*pol_y(1, 3, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 21)*pol_y(1, 3, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 21)*pol_y(2, 3, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 21)*pol_y(2, 3, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 22)*pol_y(1, 3, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 22)*pol_y(1, 3, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 22)*pol_y(2, 3, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 22)*pol_y(2, 3, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 23)*pol_y(1, 4, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 23)*pol_y(1, 4, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 23)*pol_y(2, 4, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 23)*pol_y(2, 4, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 24)*pol_y(1, 4, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 24)*pol_y(1, 4, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 24)*pol_y(2, 4, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 24)*pol_y(2, 4, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 25)*pol_y(1, 4, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 25)*pol_y(1, 4, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 25)*pol_y(2, 4, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 25)*pol_y(2, 4, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 26)*pol_y(1, 5, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 26)*pol_y(1, 5, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 26)*pol_y(2, 5, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 26)*pol_y(2, 5, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 27)*pol_y(1, 5, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 27)*pol_y(1, 5, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 27)*pol_y(2, 5, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 27)*pol_y(2, 5, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 28)*pol_y(1, 6, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 28)*pol_y(1, 6, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 28)*pol_y(2, 6, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 28)*pol_y(2, 6, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 4)*pol_y(1, 0, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 4)*pol_y(1, 0, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 4)*pol_y(2, 0, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 4)*pol_y(2, 0, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 5)*pol_y(1, 0, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 5)*pol_y(1, 0, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 5)*pol_y(2, 0, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 5)*pol_y(2, 0, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 6)*pol_y(1, 0, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 6)*pol_y(1, 0, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 6)*pol_y(2, 0, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 6)*pol_y(2, 0, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 7)*pol_y(1, 0, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 7)*pol_y(1, 0, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 7)*pol_y(2, 0, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 7)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 8)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 8)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 8)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 8)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 9)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 9)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 9)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 9)*pol_y(2, 1, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 10)*pol_y(1, 1, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 10)*pol_y(1, 1, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 10)*pol_y(2, 1, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 10)*pol_y(2, 1, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 11)*pol_y(1, 1, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 11)*pol_y(1, 1, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 11)*pol_y(2, 1, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 11)*pol_y(2, 1, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 12)*pol_y(1, 1, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 12)*pol_y(1, 1, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 12)*pol_y(2, 1, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 12)*pol_y(2, 1, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 13)*pol_y(1, 1, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 13)*pol_y(1, 1, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 13)*pol_y(2, 1, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 13)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 14)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 14)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 14)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 14)*pol_y(2, 2, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 15)*pol_y(1, 2, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 15)*pol_y(1, 2, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 15)*pol_y(2, 2, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 15)*pol_y(2, 2, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 16)*pol_y(1, 2, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 16)*pol_y(1, 2, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 16)*pol_y(2, 2, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 16)*pol_y(2, 2, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 17)*pol_y(1, 2, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 17)*pol_y(1, 2, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 17)*pol_y(2, 2, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 17)*pol_y(2, 2, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 18)*pol_y(1, 2, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 18)*pol_y(1, 2, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 18)*pol_y(2, 2, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 18)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 19)*pol_y(1, 3, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 19)*pol_y(1, 3, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 19)*pol_y(2, 3, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 19)*pol_y(2, 3, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 20)*pol_y(1, 3, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 20)*pol_y(1, 3, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 20)*pol_y(2, 3, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 20)*pol_y(2, 3, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 21)*pol_y(1, 3, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 21)*pol_y(1, 3, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 21)*pol_y(2, 3, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 21)*pol_y(2, 3, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 22)*pol_y(1, 3, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 22)*pol_y(1, 3, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 22)*pol_y(2, 3, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 22)*pol_y(2, 3, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 23)*pol_y(1, 4, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 23)*pol_y(1, 4, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 23)*pol_y(2, 4, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 23)*pol_y(2, 4, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 24)*pol_y(1, 4, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 24)*pol_y(1, 4, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 24)*pol_y(2, 4, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 24)*pol_y(2, 4, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 25)*pol_y(1, 4, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 25)*pol_y(1, 4, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 25)*pol_y(2, 4, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 25)*pol_y(2, 4, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 26)*pol_y(1, 5, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 26)*pol_y(1, 5, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 26)*pol_y(2, 5, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 26)*pol_y(2, 5, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 27)*pol_y(1, 5, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 27)*pol_y(1, 5, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 27)*pol_y(2, 5, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 27)*pol_y(2, 5, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 28)*pol_y(1, 6, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 28)*pol_y(1, 6, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 28)*pol_y(2, 6, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 28)*pol_y(2, 6, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp @@ -1188,15 +1188,15 @@ SUBROUTINE collocate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = 0.0_dp s04 = 0.0_dp DO lxp = 0, lp - s01 = s01+coef_x(1, lxp)*pol_x(lxp, ig) - s02 = s02+coef_x(2, lxp)*pol_x(lxp, ig) - s03 = s03+coef_x(3, lxp)*pol_x(lxp, ig) - s04 = s04+coef_x(4, lxp)*pol_x(lxp, ig) + s01 = s01 + coef_x(1, lxp)*pol_x(lxp, ig) + s02 = s02 + coef_x(2, lxp)*pol_x(lxp, ig) + s03 = s03 + coef_x(3, lxp)*pol_x(lxp, ig) + s04 = s04 + coef_x(4, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -1223,298 +1223,298 @@ SUBROUTINE collocate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 7 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(1)*pol_z(:, 0, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(2)*pol_z(:, 0, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(3)*pol_z(:, 0, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(4)*pol_z(:, 0, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(5)*pol_z(:, 0, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(6)*pol_z(:, 0, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(7)*pol_z(:, 0, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(8)*pol_z(:, 0, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(9)*pol_z(:, 0, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(10)*pol_z(:, 0, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(11)*pol_z(:, 0, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(12)*pol_z(:, 0, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(13)*pol_z(:, 0, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(14)*pol_z(:, 0, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(15)*pol_z(:, 0, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(16)*pol_z(:, 0, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(17)*pol_z(:, 0, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(18)*pol_z(:, 0, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(19)*pol_z(:, 0, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(20)*pol_z(:, 0, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(21)*pol_z(:, 0, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(22)*pol_z(:, 0, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(23)*pol_z(:, 0, kg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_xyz(24)*pol_z(:, 0, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(25)*pol_z(:, 0, kg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_xyz(26)*pol_z(:, 0, kg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_xyz(27)*pol_z(:, 0, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(28)*pol_z(:, 0, kg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_xyz(29)*pol_z(:, 0, kg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_xyz(30)*pol_z(:, 0, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(31)*pol_z(:, 0, kg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_xyz(32)*pol_z(:, 0, kg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_xyz(33)*pol_z(:, 0, kg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_xyz(34)*pol_z(:, 0, kg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_xyz(35)*pol_z(:, 0, kg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_xyz(36)*pol_z(:, 0, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(37)*pol_z(:, 1, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(38)*pol_z(:, 1, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(39)*pol_z(:, 1, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(40)*pol_z(:, 1, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(41)*pol_z(:, 1, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(42)*pol_z(:, 1, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(43)*pol_z(:, 1, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(44)*pol_z(:, 1, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(45)*pol_z(:, 1, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(46)*pol_z(:, 1, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(47)*pol_z(:, 1, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(48)*pol_z(:, 1, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(49)*pol_z(:, 1, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(50)*pol_z(:, 1, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(51)*pol_z(:, 1, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(52)*pol_z(:, 1, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(53)*pol_z(:, 1, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(54)*pol_z(:, 1, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(55)*pol_z(:, 1, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(56)*pol_z(:, 1, kg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_xyz(57)*pol_z(:, 1, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(58)*pol_z(:, 1, kg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_xyz(59)*pol_z(:, 1, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(60)*pol_z(:, 1, kg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_xyz(61)*pol_z(:, 1, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(62)*pol_z(:, 1, kg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_xyz(63)*pol_z(:, 1, kg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_xyz(64)*pol_z(:, 1, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(65)*pol_z(:, 2, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(66)*pol_z(:, 2, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(67)*pol_z(:, 2, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(68)*pol_z(:, 2, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(69)*pol_z(:, 2, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(70)*pol_z(:, 2, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(71)*pol_z(:, 2, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(72)*pol_z(:, 2, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(73)*pol_z(:, 2, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(74)*pol_z(:, 2, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(75)*pol_z(:, 2, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(76)*pol_z(:, 2, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(77)*pol_z(:, 2, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(78)*pol_z(:, 2, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(79)*pol_z(:, 2, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(80)*pol_z(:, 2, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(81)*pol_z(:, 2, kg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_xyz(82)*pol_z(:, 2, kg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_xyz(83)*pol_z(:, 2, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(84)*pol_z(:, 2, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(85)*pol_z(:, 2, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(86)*pol_z(:, 3, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(87)*pol_z(:, 3, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(88)*pol_z(:, 3, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(89)*pol_z(:, 3, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(90)*pol_z(:, 3, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(91)*pol_z(:, 3, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(92)*pol_z(:, 3, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(93)*pol_z(:, 3, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(94)*pol_z(:, 3, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(95)*pol_z(:, 3, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(96)*pol_z(:, 3, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(97)*pol_z(:, 3, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(98)*pol_z(:, 3, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(99)*pol_z(:, 3, kg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_xyz(100)*pol_z(:, 3, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(101)*pol_z(:, 4, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(102)*pol_z(:, 4, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(103)*pol_z(:, 4, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(104)*pol_z(:, 4, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(105)*pol_z(:, 4, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(106)*pol_z(:, 4, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(107)*pol_z(:, 4, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(108)*pol_z(:, 4, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(109)*pol_z(:, 4, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(110)*pol_z(:, 4, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(111)*pol_z(:, 5, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(112)*pol_z(:, 5, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(113)*pol_z(:, 5, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(114)*pol_z(:, 5, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(115)*pol_z(:, 5, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(116)*pol_z(:, 5, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(117)*pol_z(:, 6, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(118)*pol_z(:, 6, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(119)*pol_z(:, 6, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(120)*pol_z(:, 7, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(1)*pol_z(:, 0, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(2)*pol_z(:, 0, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(3)*pol_z(:, 0, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(4)*pol_z(:, 0, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(5)*pol_z(:, 0, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(6)*pol_z(:, 0, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(7)*pol_z(:, 0, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(8)*pol_z(:, 0, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(9)*pol_z(:, 0, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(10)*pol_z(:, 0, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(11)*pol_z(:, 0, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(12)*pol_z(:, 0, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(13)*pol_z(:, 0, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(14)*pol_z(:, 0, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(15)*pol_z(:, 0, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(16)*pol_z(:, 0, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(17)*pol_z(:, 0, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(18)*pol_z(:, 0, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(19)*pol_z(:, 0, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(20)*pol_z(:, 0, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(21)*pol_z(:, 0, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(22)*pol_z(:, 0, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(23)*pol_z(:, 0, kg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_xyz(24)*pol_z(:, 0, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(25)*pol_z(:, 0, kg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_xyz(26)*pol_z(:, 0, kg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_xyz(27)*pol_z(:, 0, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(28)*pol_z(:, 0, kg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_xyz(29)*pol_z(:, 0, kg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_xyz(30)*pol_z(:, 0, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(31)*pol_z(:, 0, kg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_xyz(32)*pol_z(:, 0, kg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_xyz(33)*pol_z(:, 0, kg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_xyz(34)*pol_z(:, 0, kg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_xyz(35)*pol_z(:, 0, kg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_xyz(36)*pol_z(:, 0, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(37)*pol_z(:, 1, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(38)*pol_z(:, 1, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(39)*pol_z(:, 1, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(40)*pol_z(:, 1, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(41)*pol_z(:, 1, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(42)*pol_z(:, 1, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(43)*pol_z(:, 1, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(44)*pol_z(:, 1, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(45)*pol_z(:, 1, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(46)*pol_z(:, 1, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(47)*pol_z(:, 1, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(48)*pol_z(:, 1, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(49)*pol_z(:, 1, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(50)*pol_z(:, 1, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(51)*pol_z(:, 1, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(52)*pol_z(:, 1, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(53)*pol_z(:, 1, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(54)*pol_z(:, 1, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(55)*pol_z(:, 1, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(56)*pol_z(:, 1, kg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_xyz(57)*pol_z(:, 1, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(58)*pol_z(:, 1, kg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_xyz(59)*pol_z(:, 1, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(60)*pol_z(:, 1, kg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_xyz(61)*pol_z(:, 1, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(62)*pol_z(:, 1, kg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_xyz(63)*pol_z(:, 1, kg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_xyz(64)*pol_z(:, 1, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(65)*pol_z(:, 2, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(66)*pol_z(:, 2, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(67)*pol_z(:, 2, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(68)*pol_z(:, 2, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(69)*pol_z(:, 2, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(70)*pol_z(:, 2, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(71)*pol_z(:, 2, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(72)*pol_z(:, 2, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(73)*pol_z(:, 2, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(74)*pol_z(:, 2, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(75)*pol_z(:, 2, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(76)*pol_z(:, 2, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(77)*pol_z(:, 2, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(78)*pol_z(:, 2, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(79)*pol_z(:, 2, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(80)*pol_z(:, 2, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(81)*pol_z(:, 2, kg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_xyz(82)*pol_z(:, 2, kg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_xyz(83)*pol_z(:, 2, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(84)*pol_z(:, 2, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(85)*pol_z(:, 2, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(86)*pol_z(:, 3, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(87)*pol_z(:, 3, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(88)*pol_z(:, 3, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(89)*pol_z(:, 3, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(90)*pol_z(:, 3, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(91)*pol_z(:, 3, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(92)*pol_z(:, 3, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(93)*pol_z(:, 3, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(94)*pol_z(:, 3, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(95)*pol_z(:, 3, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(96)*pol_z(:, 3, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(97)*pol_z(:, 3, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(98)*pol_z(:, 3, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(99)*pol_z(:, 3, kg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_xyz(100)*pol_z(:, 3, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(101)*pol_z(:, 4, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(102)*pol_z(:, 4, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(103)*pol_z(:, 4, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(104)*pol_z(:, 4, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(105)*pol_z(:, 4, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(106)*pol_z(:, 4, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(107)*pol_z(:, 4, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(108)*pol_z(:, 4, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(109)*pol_z(:, 4, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(110)*pol_z(:, 4, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(111)*pol_z(:, 5, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(112)*pol_z(:, 5, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(113)*pol_z(:, 5, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(114)*pol_z(:, 5, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(115)*pol_z(:, 5, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(116)*pol_z(:, 5, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(117)*pol_z(:, 6, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(118)*pol_z(:, 6, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(119)*pol_z(:, 6, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(120)*pol_z(:, 7, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 4)*pol_y(1, 0, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 4)*pol_y(1, 0, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 4)*pol_y(2, 0, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 4)*pol_y(2, 0, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 5)*pol_y(1, 0, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 5)*pol_y(1, 0, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 5)*pol_y(2, 0, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 5)*pol_y(2, 0, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 6)*pol_y(1, 0, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 6)*pol_y(1, 0, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 6)*pol_y(2, 0, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 6)*pol_y(2, 0, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 7)*pol_y(1, 0, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 7)*pol_y(1, 0, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 7)*pol_y(2, 0, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 7)*pol_y(2, 0, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 8)*pol_y(1, 0, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 8)*pol_y(1, 0, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 8)*pol_y(2, 0, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 8)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 9)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 9)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 9)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 9)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 10)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 10)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 10)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 10)*pol_y(2, 1, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 11)*pol_y(1, 1, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 11)*pol_y(1, 1, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 11)*pol_y(2, 1, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 11)*pol_y(2, 1, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 12)*pol_y(1, 1, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 12)*pol_y(1, 1, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 12)*pol_y(2, 1, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 12)*pol_y(2, 1, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 13)*pol_y(1, 1, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 13)*pol_y(1, 1, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 13)*pol_y(2, 1, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 13)*pol_y(2, 1, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 14)*pol_y(1, 1, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 14)*pol_y(1, 1, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 14)*pol_y(2, 1, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 14)*pol_y(2, 1, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 15)*pol_y(1, 1, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 15)*pol_y(1, 1, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 15)*pol_y(2, 1, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 15)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 16)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 16)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 16)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 16)*pol_y(2, 2, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 17)*pol_y(1, 2, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 17)*pol_y(1, 2, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 17)*pol_y(2, 2, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 17)*pol_y(2, 2, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 18)*pol_y(1, 2, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 18)*pol_y(1, 2, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 18)*pol_y(2, 2, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 18)*pol_y(2, 2, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 19)*pol_y(1, 2, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 19)*pol_y(1, 2, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 19)*pol_y(2, 2, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 19)*pol_y(2, 2, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 20)*pol_y(1, 2, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 20)*pol_y(1, 2, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 20)*pol_y(2, 2, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 20)*pol_y(2, 2, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 21)*pol_y(1, 2, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 21)*pol_y(1, 2, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 21)*pol_y(2, 2, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 21)*pol_y(2, 2, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 22)*pol_y(1, 3, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 22)*pol_y(1, 3, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 22)*pol_y(2, 3, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 22)*pol_y(2, 3, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 23)*pol_y(1, 3, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 23)*pol_y(1, 3, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 23)*pol_y(2, 3, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 23)*pol_y(2, 3, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 24)*pol_y(1, 3, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 24)*pol_y(1, 3, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 24)*pol_y(2, 3, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 24)*pol_y(2, 3, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 25)*pol_y(1, 3, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 25)*pol_y(1, 3, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 25)*pol_y(2, 3, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 25)*pol_y(2, 3, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 26)*pol_y(1, 3, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 26)*pol_y(1, 3, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 26)*pol_y(2, 3, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 26)*pol_y(2, 3, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 27)*pol_y(1, 4, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 27)*pol_y(1, 4, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 27)*pol_y(2, 4, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 27)*pol_y(2, 4, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 28)*pol_y(1, 4, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 28)*pol_y(1, 4, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 28)*pol_y(2, 4, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 28)*pol_y(2, 4, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 29)*pol_y(1, 4, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 29)*pol_y(1, 4, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 29)*pol_y(2, 4, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 29)*pol_y(2, 4, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 30)*pol_y(1, 4, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 30)*pol_y(1, 4, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 30)*pol_y(2, 4, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 30)*pol_y(2, 4, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 31)*pol_y(1, 5, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 31)*pol_y(1, 5, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 31)*pol_y(2, 5, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 31)*pol_y(2, 5, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 32)*pol_y(1, 5, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 32)*pol_y(1, 5, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 32)*pol_y(2, 5, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 32)*pol_y(2, 5, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 33)*pol_y(1, 5, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 33)*pol_y(1, 5, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 33)*pol_y(2, 5, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 33)*pol_y(2, 5, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 34)*pol_y(1, 6, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 34)*pol_y(1, 6, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 34)*pol_y(2, 6, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 34)*pol_y(2, 6, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 35)*pol_y(1, 6, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 35)*pol_y(1, 6, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 35)*pol_y(2, 6, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 35)*pol_y(2, 6, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 36)*pol_y(1, 7, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 36)*pol_y(1, 7, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 36)*pol_y(2, 7, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 36)*pol_y(2, 7, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 4)*pol_y(1, 0, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 4)*pol_y(1, 0, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 4)*pol_y(2, 0, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 4)*pol_y(2, 0, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 5)*pol_y(1, 0, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 5)*pol_y(1, 0, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 5)*pol_y(2, 0, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 5)*pol_y(2, 0, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 6)*pol_y(1, 0, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 6)*pol_y(1, 0, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 6)*pol_y(2, 0, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 6)*pol_y(2, 0, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 7)*pol_y(1, 0, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 7)*pol_y(1, 0, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 7)*pol_y(2, 0, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 7)*pol_y(2, 0, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 8)*pol_y(1, 0, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 8)*pol_y(1, 0, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 8)*pol_y(2, 0, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 8)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 9)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 9)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 9)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 9)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 10)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 10)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 10)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 10)*pol_y(2, 1, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 11)*pol_y(1, 1, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 11)*pol_y(1, 1, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 11)*pol_y(2, 1, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 11)*pol_y(2, 1, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 12)*pol_y(1, 1, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 12)*pol_y(1, 1, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 12)*pol_y(2, 1, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 12)*pol_y(2, 1, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 13)*pol_y(1, 1, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 13)*pol_y(1, 1, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 13)*pol_y(2, 1, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 13)*pol_y(2, 1, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 14)*pol_y(1, 1, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 14)*pol_y(1, 1, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 14)*pol_y(2, 1, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 14)*pol_y(2, 1, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 15)*pol_y(1, 1, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 15)*pol_y(1, 1, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 15)*pol_y(2, 1, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 15)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 16)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 16)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 16)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 16)*pol_y(2, 2, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 17)*pol_y(1, 2, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 17)*pol_y(1, 2, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 17)*pol_y(2, 2, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 17)*pol_y(2, 2, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 18)*pol_y(1, 2, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 18)*pol_y(1, 2, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 18)*pol_y(2, 2, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 18)*pol_y(2, 2, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 19)*pol_y(1, 2, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 19)*pol_y(1, 2, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 19)*pol_y(2, 2, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 19)*pol_y(2, 2, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 20)*pol_y(1, 2, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 20)*pol_y(1, 2, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 20)*pol_y(2, 2, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 20)*pol_y(2, 2, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 21)*pol_y(1, 2, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 21)*pol_y(1, 2, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 21)*pol_y(2, 2, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 21)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 22)*pol_y(1, 3, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 22)*pol_y(1, 3, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 22)*pol_y(2, 3, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 22)*pol_y(2, 3, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 23)*pol_y(1, 3, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 23)*pol_y(1, 3, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 23)*pol_y(2, 3, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 23)*pol_y(2, 3, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 24)*pol_y(1, 3, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 24)*pol_y(1, 3, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 24)*pol_y(2, 3, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 24)*pol_y(2, 3, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 25)*pol_y(1, 3, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 25)*pol_y(1, 3, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 25)*pol_y(2, 3, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 25)*pol_y(2, 3, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 26)*pol_y(1, 3, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 26)*pol_y(1, 3, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 26)*pol_y(2, 3, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 26)*pol_y(2, 3, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 27)*pol_y(1, 4, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 27)*pol_y(1, 4, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 27)*pol_y(2, 4, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 27)*pol_y(2, 4, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 28)*pol_y(1, 4, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 28)*pol_y(1, 4, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 28)*pol_y(2, 4, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 28)*pol_y(2, 4, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 29)*pol_y(1, 4, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 29)*pol_y(1, 4, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 29)*pol_y(2, 4, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 29)*pol_y(2, 4, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 30)*pol_y(1, 4, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 30)*pol_y(1, 4, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 30)*pol_y(2, 4, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 30)*pol_y(2, 4, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 31)*pol_y(1, 5, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 31)*pol_y(1, 5, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 31)*pol_y(2, 5, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 31)*pol_y(2, 5, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 32)*pol_y(1, 5, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 32)*pol_y(1, 5, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 32)*pol_y(2, 5, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 32)*pol_y(2, 5, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 33)*pol_y(1, 5, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 33)*pol_y(1, 5, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 33)*pol_y(2, 5, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 33)*pol_y(2, 5, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 34)*pol_y(1, 6, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 34)*pol_y(1, 6, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 34)*pol_y(2, 6, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 34)*pol_y(2, 6, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 35)*pol_y(1, 6, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 35)*pol_y(1, 6, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 35)*pol_y(2, 6, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 35)*pol_y(2, 6, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 36)*pol_y(1, 7, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 36)*pol_y(1, 7, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 36)*pol_y(2, 7, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 36)*pol_y(2, 7, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp @@ -1522,15 +1522,15 @@ SUBROUTINE collocate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = 0.0_dp s04 = 0.0_dp DO lxp = 0, lp - s01 = s01+coef_x(1, lxp)*pol_x(lxp, ig) - s02 = s02+coef_x(2, lxp)*pol_x(lxp, ig) - s03 = s03+coef_x(3, lxp)*pol_x(lxp, ig) - s04 = s04+coef_x(4, lxp)*pol_x(lxp, ig) + s01 = s01 + coef_x(1, lxp)*pol_x(lxp, ig) + s02 = s02 + coef_x(2, lxp)*pol_x(lxp, ig) + s03 = s03 + coef_x(3, lxp)*pol_x(lxp, ig) + s04 = s04 + coef_x(4, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -1557,379 +1557,379 @@ SUBROUTINE collocate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 8 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(1)*pol_z(:, 0, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(2)*pol_z(:, 0, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(3)*pol_z(:, 0, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(4)*pol_z(:, 0, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(5)*pol_z(:, 0, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(6)*pol_z(:, 0, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(7)*pol_z(:, 0, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(8)*pol_z(:, 0, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(9)*pol_z(:, 0, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(10)*pol_z(:, 0, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(11)*pol_z(:, 0, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(12)*pol_z(:, 0, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(13)*pol_z(:, 0, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(14)*pol_z(:, 0, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(15)*pol_z(:, 0, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(16)*pol_z(:, 0, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(17)*pol_z(:, 0, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(18)*pol_z(:, 0, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(19)*pol_z(:, 0, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(20)*pol_z(:, 0, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(21)*pol_z(:, 0, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(22)*pol_z(:, 0, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(23)*pol_z(:, 0, kg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_xyz(24)*pol_z(:, 0, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(25)*pol_z(:, 0, kg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_xyz(26)*pol_z(:, 0, kg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_xyz(27)*pol_z(:, 0, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(28)*pol_z(:, 0, kg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_xyz(29)*pol_z(:, 0, kg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_xyz(30)*pol_z(:, 0, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(31)*pol_z(:, 0, kg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_xyz(32)*pol_z(:, 0, kg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_xyz(33)*pol_z(:, 0, kg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_xyz(34)*pol_z(:, 0, kg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_xyz(35)*pol_z(:, 0, kg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_xyz(36)*pol_z(:, 0, kg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_xyz(37)*pol_z(:, 0, kg) - coef_xy(:, 38) = coef_xy(:, 38)+coef_xyz(38)*pol_z(:, 0, kg) - coef_xy(:, 39) = coef_xy(:, 39)+coef_xyz(39)*pol_z(:, 0, kg) - coef_xy(:, 40) = coef_xy(:, 40)+coef_xyz(40)*pol_z(:, 0, kg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_xyz(41)*pol_z(:, 0, kg) - coef_xy(:, 42) = coef_xy(:, 42)+coef_xyz(42)*pol_z(:, 0, kg) - coef_xy(:, 43) = coef_xy(:, 43)+coef_xyz(43)*pol_z(:, 0, kg) - coef_xy(:, 44) = coef_xy(:, 44)+coef_xyz(44)*pol_z(:, 0, kg) - coef_xy(:, 45) = coef_xy(:, 45)+coef_xyz(45)*pol_z(:, 0, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(46)*pol_z(:, 1, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(47)*pol_z(:, 1, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(48)*pol_z(:, 1, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(49)*pol_z(:, 1, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(50)*pol_z(:, 1, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(51)*pol_z(:, 1, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(52)*pol_z(:, 1, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(53)*pol_z(:, 1, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(54)*pol_z(:, 1, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(55)*pol_z(:, 1, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(56)*pol_z(:, 1, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(57)*pol_z(:, 1, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(58)*pol_z(:, 1, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(59)*pol_z(:, 1, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(60)*pol_z(:, 1, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(61)*pol_z(:, 1, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(62)*pol_z(:, 1, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(63)*pol_z(:, 1, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(64)*pol_z(:, 1, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(65)*pol_z(:, 1, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(66)*pol_z(:, 1, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(67)*pol_z(:, 1, kg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_xyz(68)*pol_z(:, 1, kg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_xyz(69)*pol_z(:, 1, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(70)*pol_z(:, 1, kg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_xyz(71)*pol_z(:, 1, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(72)*pol_z(:, 1, kg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_xyz(73)*pol_z(:, 1, kg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_xyz(74)*pol_z(:, 1, kg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_xyz(75)*pol_z(:, 1, kg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_xyz(76)*pol_z(:, 1, kg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_xyz(77)*pol_z(:, 1, kg) - coef_xy(:, 38) = coef_xy(:, 38)+coef_xyz(78)*pol_z(:, 1, kg) - coef_xy(:, 40) = coef_xy(:, 40)+coef_xyz(79)*pol_z(:, 1, kg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_xyz(80)*pol_z(:, 1, kg) - coef_xy(:, 43) = coef_xy(:, 43)+coef_xyz(81)*pol_z(:, 1, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(82)*pol_z(:, 2, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(83)*pol_z(:, 2, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(84)*pol_z(:, 2, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(85)*pol_z(:, 2, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(86)*pol_z(:, 2, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(87)*pol_z(:, 2, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(88)*pol_z(:, 2, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(89)*pol_z(:, 2, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(90)*pol_z(:, 2, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(91)*pol_z(:, 2, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(92)*pol_z(:, 2, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(93)*pol_z(:, 2, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(94)*pol_z(:, 2, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(95)*pol_z(:, 2, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(96)*pol_z(:, 2, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(97)*pol_z(:, 2, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(98)*pol_z(:, 2, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(99)*pol_z(:, 2, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(100)*pol_z(:, 2, kg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_xyz(101)*pol_z(:, 2, kg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_xyz(102)*pol_z(:, 2, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(103)*pol_z(:, 2, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(104)*pol_z(:, 2, kg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_xyz(105)*pol_z(:, 2, kg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_xyz(106)*pol_z(:, 2, kg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_xyz(107)*pol_z(:, 2, kg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_xyz(108)*pol_z(:, 2, kg) - coef_xy(:, 40) = coef_xy(:, 40)+coef_xyz(109)*pol_z(:, 2, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(110)*pol_z(:, 3, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(111)*pol_z(:, 3, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(112)*pol_z(:, 3, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(113)*pol_z(:, 3, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(114)*pol_z(:, 3, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(115)*pol_z(:, 3, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(116)*pol_z(:, 3, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(117)*pol_z(:, 3, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(118)*pol_z(:, 3, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(119)*pol_z(:, 3, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(120)*pol_z(:, 3, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(121)*pol_z(:, 3, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(122)*pol_z(:, 3, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(123)*pol_z(:, 3, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(124)*pol_z(:, 3, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(125)*pol_z(:, 3, kg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_xyz(126)*pol_z(:, 3, kg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_xyz(127)*pol_z(:, 3, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(128)*pol_z(:, 3, kg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_xyz(129)*pol_z(:, 3, kg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_xyz(130)*pol_z(:, 3, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(131)*pol_z(:, 4, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(132)*pol_z(:, 4, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(133)*pol_z(:, 4, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(134)*pol_z(:, 4, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(135)*pol_z(:, 4, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(136)*pol_z(:, 4, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(137)*pol_z(:, 4, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(138)*pol_z(:, 4, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(139)*pol_z(:, 4, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(140)*pol_z(:, 4, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(141)*pol_z(:, 4, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(142)*pol_z(:, 4, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(143)*pol_z(:, 4, kg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_xyz(144)*pol_z(:, 4, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(145)*pol_z(:, 4, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(146)*pol_z(:, 5, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(147)*pol_z(:, 5, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(148)*pol_z(:, 5, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(149)*pol_z(:, 5, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(150)*pol_z(:, 5, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(151)*pol_z(:, 5, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(152)*pol_z(:, 5, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(153)*pol_z(:, 5, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(154)*pol_z(:, 5, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(155)*pol_z(:, 5, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(156)*pol_z(:, 6, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(157)*pol_z(:, 6, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(158)*pol_z(:, 6, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(159)*pol_z(:, 6, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(160)*pol_z(:, 6, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(161)*pol_z(:, 6, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(162)*pol_z(:, 7, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(163)*pol_z(:, 7, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(164)*pol_z(:, 7, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(165)*pol_z(:, 8, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(1)*pol_z(:, 0, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(2)*pol_z(:, 0, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(3)*pol_z(:, 0, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(4)*pol_z(:, 0, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(5)*pol_z(:, 0, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(6)*pol_z(:, 0, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(7)*pol_z(:, 0, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(8)*pol_z(:, 0, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(9)*pol_z(:, 0, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(10)*pol_z(:, 0, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(11)*pol_z(:, 0, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(12)*pol_z(:, 0, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(13)*pol_z(:, 0, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(14)*pol_z(:, 0, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(15)*pol_z(:, 0, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(16)*pol_z(:, 0, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(17)*pol_z(:, 0, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(18)*pol_z(:, 0, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(19)*pol_z(:, 0, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(20)*pol_z(:, 0, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(21)*pol_z(:, 0, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(22)*pol_z(:, 0, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(23)*pol_z(:, 0, kg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_xyz(24)*pol_z(:, 0, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(25)*pol_z(:, 0, kg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_xyz(26)*pol_z(:, 0, kg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_xyz(27)*pol_z(:, 0, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(28)*pol_z(:, 0, kg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_xyz(29)*pol_z(:, 0, kg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_xyz(30)*pol_z(:, 0, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(31)*pol_z(:, 0, kg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_xyz(32)*pol_z(:, 0, kg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_xyz(33)*pol_z(:, 0, kg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_xyz(34)*pol_z(:, 0, kg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_xyz(35)*pol_z(:, 0, kg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_xyz(36)*pol_z(:, 0, kg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_xyz(37)*pol_z(:, 0, kg) + coef_xy(:, 38) = coef_xy(:, 38) + coef_xyz(38)*pol_z(:, 0, kg) + coef_xy(:, 39) = coef_xy(:, 39) + coef_xyz(39)*pol_z(:, 0, kg) + coef_xy(:, 40) = coef_xy(:, 40) + coef_xyz(40)*pol_z(:, 0, kg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_xyz(41)*pol_z(:, 0, kg) + coef_xy(:, 42) = coef_xy(:, 42) + coef_xyz(42)*pol_z(:, 0, kg) + coef_xy(:, 43) = coef_xy(:, 43) + coef_xyz(43)*pol_z(:, 0, kg) + coef_xy(:, 44) = coef_xy(:, 44) + coef_xyz(44)*pol_z(:, 0, kg) + coef_xy(:, 45) = coef_xy(:, 45) + coef_xyz(45)*pol_z(:, 0, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(46)*pol_z(:, 1, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(47)*pol_z(:, 1, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(48)*pol_z(:, 1, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(49)*pol_z(:, 1, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(50)*pol_z(:, 1, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(51)*pol_z(:, 1, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(52)*pol_z(:, 1, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(53)*pol_z(:, 1, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(54)*pol_z(:, 1, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(55)*pol_z(:, 1, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(56)*pol_z(:, 1, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(57)*pol_z(:, 1, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(58)*pol_z(:, 1, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(59)*pol_z(:, 1, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(60)*pol_z(:, 1, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(61)*pol_z(:, 1, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(62)*pol_z(:, 1, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(63)*pol_z(:, 1, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(64)*pol_z(:, 1, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(65)*pol_z(:, 1, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(66)*pol_z(:, 1, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(67)*pol_z(:, 1, kg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_xyz(68)*pol_z(:, 1, kg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_xyz(69)*pol_z(:, 1, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(70)*pol_z(:, 1, kg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_xyz(71)*pol_z(:, 1, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(72)*pol_z(:, 1, kg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_xyz(73)*pol_z(:, 1, kg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_xyz(74)*pol_z(:, 1, kg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_xyz(75)*pol_z(:, 1, kg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_xyz(76)*pol_z(:, 1, kg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_xyz(77)*pol_z(:, 1, kg) + coef_xy(:, 38) = coef_xy(:, 38) + coef_xyz(78)*pol_z(:, 1, kg) + coef_xy(:, 40) = coef_xy(:, 40) + coef_xyz(79)*pol_z(:, 1, kg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_xyz(80)*pol_z(:, 1, kg) + coef_xy(:, 43) = coef_xy(:, 43) + coef_xyz(81)*pol_z(:, 1, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(82)*pol_z(:, 2, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(83)*pol_z(:, 2, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(84)*pol_z(:, 2, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(85)*pol_z(:, 2, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(86)*pol_z(:, 2, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(87)*pol_z(:, 2, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(88)*pol_z(:, 2, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(89)*pol_z(:, 2, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(90)*pol_z(:, 2, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(91)*pol_z(:, 2, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(92)*pol_z(:, 2, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(93)*pol_z(:, 2, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(94)*pol_z(:, 2, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(95)*pol_z(:, 2, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(96)*pol_z(:, 2, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(97)*pol_z(:, 2, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(98)*pol_z(:, 2, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(99)*pol_z(:, 2, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(100)*pol_z(:, 2, kg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_xyz(101)*pol_z(:, 2, kg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_xyz(102)*pol_z(:, 2, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(103)*pol_z(:, 2, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(104)*pol_z(:, 2, kg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_xyz(105)*pol_z(:, 2, kg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_xyz(106)*pol_z(:, 2, kg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_xyz(107)*pol_z(:, 2, kg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_xyz(108)*pol_z(:, 2, kg) + coef_xy(:, 40) = coef_xy(:, 40) + coef_xyz(109)*pol_z(:, 2, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(110)*pol_z(:, 3, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(111)*pol_z(:, 3, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(112)*pol_z(:, 3, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(113)*pol_z(:, 3, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(114)*pol_z(:, 3, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(115)*pol_z(:, 3, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(116)*pol_z(:, 3, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(117)*pol_z(:, 3, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(118)*pol_z(:, 3, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(119)*pol_z(:, 3, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(120)*pol_z(:, 3, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(121)*pol_z(:, 3, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(122)*pol_z(:, 3, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(123)*pol_z(:, 3, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(124)*pol_z(:, 3, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(125)*pol_z(:, 3, kg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_xyz(126)*pol_z(:, 3, kg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_xyz(127)*pol_z(:, 3, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(128)*pol_z(:, 3, kg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_xyz(129)*pol_z(:, 3, kg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_xyz(130)*pol_z(:, 3, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(131)*pol_z(:, 4, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(132)*pol_z(:, 4, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(133)*pol_z(:, 4, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(134)*pol_z(:, 4, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(135)*pol_z(:, 4, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(136)*pol_z(:, 4, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(137)*pol_z(:, 4, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(138)*pol_z(:, 4, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(139)*pol_z(:, 4, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(140)*pol_z(:, 4, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(141)*pol_z(:, 4, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(142)*pol_z(:, 4, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(143)*pol_z(:, 4, kg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_xyz(144)*pol_z(:, 4, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(145)*pol_z(:, 4, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(146)*pol_z(:, 5, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(147)*pol_z(:, 5, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(148)*pol_z(:, 5, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(149)*pol_z(:, 5, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(150)*pol_z(:, 5, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(151)*pol_z(:, 5, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(152)*pol_z(:, 5, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(153)*pol_z(:, 5, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(154)*pol_z(:, 5, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(155)*pol_z(:, 5, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(156)*pol_z(:, 6, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(157)*pol_z(:, 6, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(158)*pol_z(:, 6, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(159)*pol_z(:, 6, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(160)*pol_z(:, 6, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(161)*pol_z(:, 6, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(162)*pol_z(:, 7, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(163)*pol_z(:, 7, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(164)*pol_z(:, 7, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(165)*pol_z(:, 8, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 4)*pol_y(1, 0, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 4)*pol_y(1, 0, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 4)*pol_y(2, 0, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 4)*pol_y(2, 0, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 5)*pol_y(1, 0, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 5)*pol_y(1, 0, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 5)*pol_y(2, 0, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 5)*pol_y(2, 0, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 6)*pol_y(1, 0, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 6)*pol_y(1, 0, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 6)*pol_y(2, 0, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 6)*pol_y(2, 0, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 7)*pol_y(1, 0, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 7)*pol_y(1, 0, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 7)*pol_y(2, 0, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 7)*pol_y(2, 0, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 8)*pol_y(1, 0, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 8)*pol_y(1, 0, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 8)*pol_y(2, 0, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 8)*pol_y(2, 0, jg) - coef_x(1, 8) = coef_x(1, 8)+coef_xy(1, 9)*pol_y(1, 0, jg) - coef_x(2, 8) = coef_x(2, 8)+coef_xy(2, 9)*pol_y(1, 0, jg) - coef_x(3, 8) = coef_x(3, 8)+coef_xy(1, 9)*pol_y(2, 0, jg) - coef_x(4, 8) = coef_x(4, 8)+coef_xy(2, 9)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 10)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 10)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 10)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 10)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 11)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 11)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 11)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 11)*pol_y(2, 1, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 12)*pol_y(1, 1, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 12)*pol_y(1, 1, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 12)*pol_y(2, 1, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 12)*pol_y(2, 1, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 13)*pol_y(1, 1, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 13)*pol_y(1, 1, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 13)*pol_y(2, 1, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 13)*pol_y(2, 1, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 14)*pol_y(1, 1, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 14)*pol_y(1, 1, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 14)*pol_y(2, 1, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 14)*pol_y(2, 1, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 15)*pol_y(1, 1, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 15)*pol_y(1, 1, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 15)*pol_y(2, 1, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 15)*pol_y(2, 1, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 16)*pol_y(1, 1, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 16)*pol_y(1, 1, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 16)*pol_y(2, 1, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 16)*pol_y(2, 1, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 17)*pol_y(1, 1, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 17)*pol_y(1, 1, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 17)*pol_y(2, 1, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 17)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 18)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 18)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 18)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 18)*pol_y(2, 2, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 19)*pol_y(1, 2, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 19)*pol_y(1, 2, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 19)*pol_y(2, 2, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 19)*pol_y(2, 2, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 20)*pol_y(1, 2, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 20)*pol_y(1, 2, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 20)*pol_y(2, 2, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 20)*pol_y(2, 2, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 21)*pol_y(1, 2, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 21)*pol_y(1, 2, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 21)*pol_y(2, 2, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 21)*pol_y(2, 2, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 22)*pol_y(1, 2, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 22)*pol_y(1, 2, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 22)*pol_y(2, 2, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 22)*pol_y(2, 2, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 23)*pol_y(1, 2, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 23)*pol_y(1, 2, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 23)*pol_y(2, 2, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 23)*pol_y(2, 2, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 24)*pol_y(1, 2, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 24)*pol_y(1, 2, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 24)*pol_y(2, 2, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 24)*pol_y(2, 2, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 25)*pol_y(1, 3, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 25)*pol_y(1, 3, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 25)*pol_y(2, 3, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 25)*pol_y(2, 3, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 26)*pol_y(1, 3, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 26)*pol_y(1, 3, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 26)*pol_y(2, 3, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 26)*pol_y(2, 3, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 27)*pol_y(1, 3, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 27)*pol_y(1, 3, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 27)*pol_y(2, 3, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 27)*pol_y(2, 3, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 28)*pol_y(1, 3, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 28)*pol_y(1, 3, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 28)*pol_y(2, 3, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 28)*pol_y(2, 3, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 29)*pol_y(1, 3, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 29)*pol_y(1, 3, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 29)*pol_y(2, 3, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 29)*pol_y(2, 3, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 30)*pol_y(1, 3, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 30)*pol_y(1, 3, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 30)*pol_y(2, 3, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 30)*pol_y(2, 3, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 31)*pol_y(1, 4, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 31)*pol_y(1, 4, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 31)*pol_y(2, 4, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 31)*pol_y(2, 4, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 32)*pol_y(1, 4, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 32)*pol_y(1, 4, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 32)*pol_y(2, 4, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 32)*pol_y(2, 4, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 33)*pol_y(1, 4, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 33)*pol_y(1, 4, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 33)*pol_y(2, 4, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 33)*pol_y(2, 4, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 34)*pol_y(1, 4, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 34)*pol_y(1, 4, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 34)*pol_y(2, 4, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 34)*pol_y(2, 4, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 35)*pol_y(1, 4, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 35)*pol_y(1, 4, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 35)*pol_y(2, 4, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 35)*pol_y(2, 4, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 36)*pol_y(1, 5, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 36)*pol_y(1, 5, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 36)*pol_y(2, 5, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 36)*pol_y(2, 5, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 37)*pol_y(1, 5, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 37)*pol_y(1, 5, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 37)*pol_y(2, 5, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 37)*pol_y(2, 5, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 38)*pol_y(1, 5, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 38)*pol_y(1, 5, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 38)*pol_y(2, 5, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 38)*pol_y(2, 5, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 39)*pol_y(1, 5, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 39)*pol_y(1, 5, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 39)*pol_y(2, 5, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 39)*pol_y(2, 5, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 40)*pol_y(1, 6, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 40)*pol_y(1, 6, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 40)*pol_y(2, 6, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 40)*pol_y(2, 6, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 41)*pol_y(1, 6, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 41)*pol_y(1, 6, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 41)*pol_y(2, 6, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 41)*pol_y(2, 6, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 42)*pol_y(1, 6, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 42)*pol_y(1, 6, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 42)*pol_y(2, 6, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 42)*pol_y(2, 6, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 43)*pol_y(1, 7, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 43)*pol_y(1, 7, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 43)*pol_y(2, 7, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 43)*pol_y(2, 7, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 44)*pol_y(1, 7, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 44)*pol_y(1, 7, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 44)*pol_y(2, 7, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 44)*pol_y(2, 7, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 45)*pol_y(1, 8, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 45)*pol_y(1, 8, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 45)*pol_y(2, 8, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 45)*pol_y(2, 8, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 4)*pol_y(1, 0, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 4)*pol_y(1, 0, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 4)*pol_y(2, 0, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 4)*pol_y(2, 0, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 5)*pol_y(1, 0, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 5)*pol_y(1, 0, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 5)*pol_y(2, 0, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 5)*pol_y(2, 0, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 6)*pol_y(1, 0, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 6)*pol_y(1, 0, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 6)*pol_y(2, 0, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 6)*pol_y(2, 0, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 7)*pol_y(1, 0, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 7)*pol_y(1, 0, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 7)*pol_y(2, 0, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 7)*pol_y(2, 0, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 8)*pol_y(1, 0, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 8)*pol_y(1, 0, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 8)*pol_y(2, 0, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 8)*pol_y(2, 0, jg) + coef_x(1, 8) = coef_x(1, 8) + coef_xy(1, 9)*pol_y(1, 0, jg) + coef_x(2, 8) = coef_x(2, 8) + coef_xy(2, 9)*pol_y(1, 0, jg) + coef_x(3, 8) = coef_x(3, 8) + coef_xy(1, 9)*pol_y(2, 0, jg) + coef_x(4, 8) = coef_x(4, 8) + coef_xy(2, 9)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 10)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 10)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 10)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 10)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 11)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 11)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 11)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 11)*pol_y(2, 1, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 12)*pol_y(1, 1, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 12)*pol_y(1, 1, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 12)*pol_y(2, 1, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 12)*pol_y(2, 1, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 13)*pol_y(1, 1, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 13)*pol_y(1, 1, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 13)*pol_y(2, 1, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 13)*pol_y(2, 1, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 14)*pol_y(1, 1, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 14)*pol_y(1, 1, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 14)*pol_y(2, 1, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 14)*pol_y(2, 1, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 15)*pol_y(1, 1, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 15)*pol_y(1, 1, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 15)*pol_y(2, 1, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 15)*pol_y(2, 1, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 16)*pol_y(1, 1, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 16)*pol_y(1, 1, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 16)*pol_y(2, 1, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 16)*pol_y(2, 1, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 17)*pol_y(1, 1, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 17)*pol_y(1, 1, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 17)*pol_y(2, 1, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 17)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 18)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 18)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 18)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 18)*pol_y(2, 2, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 19)*pol_y(1, 2, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 19)*pol_y(1, 2, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 19)*pol_y(2, 2, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 19)*pol_y(2, 2, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 20)*pol_y(1, 2, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 20)*pol_y(1, 2, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 20)*pol_y(2, 2, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 20)*pol_y(2, 2, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 21)*pol_y(1, 2, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 21)*pol_y(1, 2, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 21)*pol_y(2, 2, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 21)*pol_y(2, 2, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 22)*pol_y(1, 2, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 22)*pol_y(1, 2, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 22)*pol_y(2, 2, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 22)*pol_y(2, 2, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 23)*pol_y(1, 2, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 23)*pol_y(1, 2, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 23)*pol_y(2, 2, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 23)*pol_y(2, 2, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 24)*pol_y(1, 2, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 24)*pol_y(1, 2, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 24)*pol_y(2, 2, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 24)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 25)*pol_y(1, 3, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 25)*pol_y(1, 3, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 25)*pol_y(2, 3, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 25)*pol_y(2, 3, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 26)*pol_y(1, 3, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 26)*pol_y(1, 3, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 26)*pol_y(2, 3, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 26)*pol_y(2, 3, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 27)*pol_y(1, 3, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 27)*pol_y(1, 3, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 27)*pol_y(2, 3, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 27)*pol_y(2, 3, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 28)*pol_y(1, 3, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 28)*pol_y(1, 3, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 28)*pol_y(2, 3, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 28)*pol_y(2, 3, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 29)*pol_y(1, 3, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 29)*pol_y(1, 3, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 29)*pol_y(2, 3, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 29)*pol_y(2, 3, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 30)*pol_y(1, 3, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 30)*pol_y(1, 3, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 30)*pol_y(2, 3, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 30)*pol_y(2, 3, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 31)*pol_y(1, 4, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 31)*pol_y(1, 4, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 31)*pol_y(2, 4, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 31)*pol_y(2, 4, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 32)*pol_y(1, 4, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 32)*pol_y(1, 4, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 32)*pol_y(2, 4, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 32)*pol_y(2, 4, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 33)*pol_y(1, 4, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 33)*pol_y(1, 4, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 33)*pol_y(2, 4, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 33)*pol_y(2, 4, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 34)*pol_y(1, 4, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 34)*pol_y(1, 4, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 34)*pol_y(2, 4, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 34)*pol_y(2, 4, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 35)*pol_y(1, 4, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 35)*pol_y(1, 4, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 35)*pol_y(2, 4, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 35)*pol_y(2, 4, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 36)*pol_y(1, 5, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 36)*pol_y(1, 5, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 36)*pol_y(2, 5, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 36)*pol_y(2, 5, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 37)*pol_y(1, 5, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 37)*pol_y(1, 5, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 37)*pol_y(2, 5, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 37)*pol_y(2, 5, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 38)*pol_y(1, 5, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 38)*pol_y(1, 5, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 38)*pol_y(2, 5, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 38)*pol_y(2, 5, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 39)*pol_y(1, 5, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 39)*pol_y(1, 5, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 39)*pol_y(2, 5, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 39)*pol_y(2, 5, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 40)*pol_y(1, 6, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 40)*pol_y(1, 6, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 40)*pol_y(2, 6, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 40)*pol_y(2, 6, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 41)*pol_y(1, 6, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 41)*pol_y(1, 6, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 41)*pol_y(2, 6, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 41)*pol_y(2, 6, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 42)*pol_y(1, 6, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 42)*pol_y(1, 6, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 42)*pol_y(2, 6, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 42)*pol_y(2, 6, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 43)*pol_y(1, 7, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 43)*pol_y(1, 7, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 43)*pol_y(2, 7, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 43)*pol_y(2, 7, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 44)*pol_y(1, 7, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 44)*pol_y(1, 7, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 44)*pol_y(2, 7, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 44)*pol_y(2, 7, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 45)*pol_y(1, 8, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 45)*pol_y(1, 8, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 45)*pol_y(2, 8, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 45)*pol_y(2, 8, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp @@ -1937,15 +1937,15 @@ SUBROUTINE collocate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = 0.0_dp s04 = 0.0_dp DO lxp = 0, lp - s01 = s01+coef_x(1, lxp)*pol_x(lxp, ig) - s02 = s02+coef_x(2, lxp)*pol_x(lxp, ig) - s03 = s03+coef_x(3, lxp)*pol_x(lxp, ig) - s04 = s04+coef_x(4, lxp)*pol_x(lxp, ig) + s01 = s01 + coef_x(1, lxp)*pol_x(lxp, ig) + s02 = s02 + coef_x(2, lxp)*pol_x(lxp, ig) + s03 = s03 + coef_x(3, lxp)*pol_x(lxp, ig) + s04 = s04 + coef_x(4, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -1972,474 +1972,474 @@ SUBROUTINE collocate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 9 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(1)*pol_z(:, 0, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(2)*pol_z(:, 0, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(3)*pol_z(:, 0, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(4)*pol_z(:, 0, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(5)*pol_z(:, 0, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(6)*pol_z(:, 0, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(7)*pol_z(:, 0, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(8)*pol_z(:, 0, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(9)*pol_z(:, 0, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(10)*pol_z(:, 0, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(11)*pol_z(:, 0, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(12)*pol_z(:, 0, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(13)*pol_z(:, 0, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(14)*pol_z(:, 0, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(15)*pol_z(:, 0, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(16)*pol_z(:, 0, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(17)*pol_z(:, 0, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(18)*pol_z(:, 0, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(19)*pol_z(:, 0, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(20)*pol_z(:, 0, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(21)*pol_z(:, 0, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(22)*pol_z(:, 0, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(23)*pol_z(:, 0, kg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_xyz(24)*pol_z(:, 0, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(25)*pol_z(:, 0, kg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_xyz(26)*pol_z(:, 0, kg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_xyz(27)*pol_z(:, 0, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(28)*pol_z(:, 0, kg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_xyz(29)*pol_z(:, 0, kg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_xyz(30)*pol_z(:, 0, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(31)*pol_z(:, 0, kg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_xyz(32)*pol_z(:, 0, kg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_xyz(33)*pol_z(:, 0, kg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_xyz(34)*pol_z(:, 0, kg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_xyz(35)*pol_z(:, 0, kg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_xyz(36)*pol_z(:, 0, kg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_xyz(37)*pol_z(:, 0, kg) - coef_xy(:, 38) = coef_xy(:, 38)+coef_xyz(38)*pol_z(:, 0, kg) - coef_xy(:, 39) = coef_xy(:, 39)+coef_xyz(39)*pol_z(:, 0, kg) - coef_xy(:, 40) = coef_xy(:, 40)+coef_xyz(40)*pol_z(:, 0, kg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_xyz(41)*pol_z(:, 0, kg) - coef_xy(:, 42) = coef_xy(:, 42)+coef_xyz(42)*pol_z(:, 0, kg) - coef_xy(:, 43) = coef_xy(:, 43)+coef_xyz(43)*pol_z(:, 0, kg) - coef_xy(:, 44) = coef_xy(:, 44)+coef_xyz(44)*pol_z(:, 0, kg) - coef_xy(:, 45) = coef_xy(:, 45)+coef_xyz(45)*pol_z(:, 0, kg) - coef_xy(:, 46) = coef_xy(:, 46)+coef_xyz(46)*pol_z(:, 0, kg) - coef_xy(:, 47) = coef_xy(:, 47)+coef_xyz(47)*pol_z(:, 0, kg) - coef_xy(:, 48) = coef_xy(:, 48)+coef_xyz(48)*pol_z(:, 0, kg) - coef_xy(:, 49) = coef_xy(:, 49)+coef_xyz(49)*pol_z(:, 0, kg) - coef_xy(:, 50) = coef_xy(:, 50)+coef_xyz(50)*pol_z(:, 0, kg) - coef_xy(:, 51) = coef_xy(:, 51)+coef_xyz(51)*pol_z(:, 0, kg) - coef_xy(:, 52) = coef_xy(:, 52)+coef_xyz(52)*pol_z(:, 0, kg) - coef_xy(:, 53) = coef_xy(:, 53)+coef_xyz(53)*pol_z(:, 0, kg) - coef_xy(:, 54) = coef_xy(:, 54)+coef_xyz(54)*pol_z(:, 0, kg) - coef_xy(:, 55) = coef_xy(:, 55)+coef_xyz(55)*pol_z(:, 0, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(56)*pol_z(:, 1, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(57)*pol_z(:, 1, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(58)*pol_z(:, 1, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(59)*pol_z(:, 1, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(60)*pol_z(:, 1, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(61)*pol_z(:, 1, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(62)*pol_z(:, 1, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(63)*pol_z(:, 1, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(64)*pol_z(:, 1, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(65)*pol_z(:, 1, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(66)*pol_z(:, 1, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(67)*pol_z(:, 1, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(68)*pol_z(:, 1, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(69)*pol_z(:, 1, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(70)*pol_z(:, 1, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(71)*pol_z(:, 1, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(72)*pol_z(:, 1, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(73)*pol_z(:, 1, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(74)*pol_z(:, 1, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(75)*pol_z(:, 1, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(76)*pol_z(:, 1, kg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_xyz(77)*pol_z(:, 1, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(78)*pol_z(:, 1, kg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_xyz(79)*pol_z(:, 1, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(80)*pol_z(:, 1, kg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_xyz(81)*pol_z(:, 1, kg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_xyz(82)*pol_z(:, 1, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(83)*pol_z(:, 1, kg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_xyz(84)*pol_z(:, 1, kg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_xyz(85)*pol_z(:, 1, kg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_xyz(86)*pol_z(:, 1, kg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_xyz(87)*pol_z(:, 1, kg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_xyz(88)*pol_z(:, 1, kg) - coef_xy(:, 38) = coef_xy(:, 38)+coef_xyz(89)*pol_z(:, 1, kg) - coef_xy(:, 39) = coef_xy(:, 39)+coef_xyz(90)*pol_z(:, 1, kg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_xyz(91)*pol_z(:, 1, kg) - coef_xy(:, 42) = coef_xy(:, 42)+coef_xyz(92)*pol_z(:, 1, kg) - coef_xy(:, 43) = coef_xy(:, 43)+coef_xyz(93)*pol_z(:, 1, kg) - coef_xy(:, 44) = coef_xy(:, 44)+coef_xyz(94)*pol_z(:, 1, kg) - coef_xy(:, 46) = coef_xy(:, 46)+coef_xyz(95)*pol_z(:, 1, kg) - coef_xy(:, 47) = coef_xy(:, 47)+coef_xyz(96)*pol_z(:, 1, kg) - coef_xy(:, 48) = coef_xy(:, 48)+coef_xyz(97)*pol_z(:, 1, kg) - coef_xy(:, 50) = coef_xy(:, 50)+coef_xyz(98)*pol_z(:, 1, kg) - coef_xy(:, 51) = coef_xy(:, 51)+coef_xyz(99)*pol_z(:, 1, kg) - coef_xy(:, 53) = coef_xy(:, 53)+coef_xyz(100)*pol_z(:, 1, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(101)*pol_z(:, 2, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(102)*pol_z(:, 2, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(103)*pol_z(:, 2, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(104)*pol_z(:, 2, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(105)*pol_z(:, 2, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(106)*pol_z(:, 2, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(107)*pol_z(:, 2, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(108)*pol_z(:, 2, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(109)*pol_z(:, 2, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(110)*pol_z(:, 2, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(111)*pol_z(:, 2, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(112)*pol_z(:, 2, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(113)*pol_z(:, 2, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(114)*pol_z(:, 2, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(115)*pol_z(:, 2, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(116)*pol_z(:, 2, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(117)*pol_z(:, 2, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(118)*pol_z(:, 2, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(119)*pol_z(:, 2, kg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_xyz(120)*pol_z(:, 2, kg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_xyz(121)*pol_z(:, 2, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(122)*pol_z(:, 2, kg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_xyz(123)*pol_z(:, 2, kg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_xyz(124)*pol_z(:, 2, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(125)*pol_z(:, 2, kg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_xyz(126)*pol_z(:, 2, kg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_xyz(127)*pol_z(:, 2, kg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_xyz(128)*pol_z(:, 2, kg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_xyz(129)*pol_z(:, 2, kg) - coef_xy(:, 38) = coef_xy(:, 38)+coef_xyz(130)*pol_z(:, 2, kg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_xyz(131)*pol_z(:, 2, kg) - coef_xy(:, 42) = coef_xy(:, 42)+coef_xyz(132)*pol_z(:, 2, kg) - coef_xy(:, 43) = coef_xy(:, 43)+coef_xyz(133)*pol_z(:, 2, kg) - coef_xy(:, 46) = coef_xy(:, 46)+coef_xyz(134)*pol_z(:, 2, kg) - coef_xy(:, 47) = coef_xy(:, 47)+coef_xyz(135)*pol_z(:, 2, kg) - coef_xy(:, 50) = coef_xy(:, 50)+coef_xyz(136)*pol_z(:, 2, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(137)*pol_z(:, 3, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(138)*pol_z(:, 3, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(139)*pol_z(:, 3, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(140)*pol_z(:, 3, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(141)*pol_z(:, 3, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(142)*pol_z(:, 3, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(143)*pol_z(:, 3, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(144)*pol_z(:, 3, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(145)*pol_z(:, 3, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(146)*pol_z(:, 3, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(147)*pol_z(:, 3, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(148)*pol_z(:, 3, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(149)*pol_z(:, 3, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(150)*pol_z(:, 3, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(151)*pol_z(:, 3, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(152)*pol_z(:, 3, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(153)*pol_z(:, 3, kg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_xyz(154)*pol_z(:, 3, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(155)*pol_z(:, 3, kg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_xyz(156)*pol_z(:, 3, kg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_xyz(157)*pol_z(:, 3, kg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_xyz(158)*pol_z(:, 3, kg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_xyz(159)*pol_z(:, 3, kg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_xyz(160)*pol_z(:, 3, kg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_xyz(161)*pol_z(:, 3, kg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_xyz(162)*pol_z(:, 3, kg) - coef_xy(:, 42) = coef_xy(:, 42)+coef_xyz(163)*pol_z(:, 3, kg) - coef_xy(:, 46) = coef_xy(:, 46)+coef_xyz(164)*pol_z(:, 3, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(165)*pol_z(:, 4, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(166)*pol_z(:, 4, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(167)*pol_z(:, 4, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(168)*pol_z(:, 4, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(169)*pol_z(:, 4, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(170)*pol_z(:, 4, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(171)*pol_z(:, 4, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(172)*pol_z(:, 4, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(173)*pol_z(:, 4, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(174)*pol_z(:, 4, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(175)*pol_z(:, 4, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(176)*pol_z(:, 4, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(177)*pol_z(:, 4, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(178)*pol_z(:, 4, kg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_xyz(179)*pol_z(:, 4, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(180)*pol_z(:, 4, kg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_xyz(181)*pol_z(:, 4, kg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_xyz(182)*pol_z(:, 4, kg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_xyz(183)*pol_z(:, 4, kg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_xyz(184)*pol_z(:, 4, kg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_xyz(185)*pol_z(:, 4, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(186)*pol_z(:, 5, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(187)*pol_z(:, 5, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(188)*pol_z(:, 5, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(189)*pol_z(:, 5, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(190)*pol_z(:, 5, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(191)*pol_z(:, 5, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(192)*pol_z(:, 5, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(193)*pol_z(:, 5, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(194)*pol_z(:, 5, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(195)*pol_z(:, 5, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(196)*pol_z(:, 5, kg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_xyz(197)*pol_z(:, 5, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(198)*pol_z(:, 5, kg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_xyz(199)*pol_z(:, 5, kg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_xyz(200)*pol_z(:, 5, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(201)*pol_z(:, 6, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(202)*pol_z(:, 6, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(203)*pol_z(:, 6, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(204)*pol_z(:, 6, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(205)*pol_z(:, 6, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(206)*pol_z(:, 6, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(207)*pol_z(:, 6, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(208)*pol_z(:, 6, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(209)*pol_z(:, 6, kg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_xyz(210)*pol_z(:, 6, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(211)*pol_z(:, 7, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(212)*pol_z(:, 7, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(213)*pol_z(:, 7, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(214)*pol_z(:, 7, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(215)*pol_z(:, 7, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(216)*pol_z(:, 7, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(217)*pol_z(:, 8, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(218)*pol_z(:, 8, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(219)*pol_z(:, 8, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(220)*pol_z(:, 9, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(1)*pol_z(:, 0, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(2)*pol_z(:, 0, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(3)*pol_z(:, 0, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(4)*pol_z(:, 0, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(5)*pol_z(:, 0, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(6)*pol_z(:, 0, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(7)*pol_z(:, 0, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(8)*pol_z(:, 0, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(9)*pol_z(:, 0, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(10)*pol_z(:, 0, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(11)*pol_z(:, 0, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(12)*pol_z(:, 0, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(13)*pol_z(:, 0, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(14)*pol_z(:, 0, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(15)*pol_z(:, 0, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(16)*pol_z(:, 0, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(17)*pol_z(:, 0, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(18)*pol_z(:, 0, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(19)*pol_z(:, 0, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(20)*pol_z(:, 0, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(21)*pol_z(:, 0, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(22)*pol_z(:, 0, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(23)*pol_z(:, 0, kg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_xyz(24)*pol_z(:, 0, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(25)*pol_z(:, 0, kg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_xyz(26)*pol_z(:, 0, kg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_xyz(27)*pol_z(:, 0, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(28)*pol_z(:, 0, kg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_xyz(29)*pol_z(:, 0, kg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_xyz(30)*pol_z(:, 0, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(31)*pol_z(:, 0, kg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_xyz(32)*pol_z(:, 0, kg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_xyz(33)*pol_z(:, 0, kg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_xyz(34)*pol_z(:, 0, kg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_xyz(35)*pol_z(:, 0, kg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_xyz(36)*pol_z(:, 0, kg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_xyz(37)*pol_z(:, 0, kg) + coef_xy(:, 38) = coef_xy(:, 38) + coef_xyz(38)*pol_z(:, 0, kg) + coef_xy(:, 39) = coef_xy(:, 39) + coef_xyz(39)*pol_z(:, 0, kg) + coef_xy(:, 40) = coef_xy(:, 40) + coef_xyz(40)*pol_z(:, 0, kg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_xyz(41)*pol_z(:, 0, kg) + coef_xy(:, 42) = coef_xy(:, 42) + coef_xyz(42)*pol_z(:, 0, kg) + coef_xy(:, 43) = coef_xy(:, 43) + coef_xyz(43)*pol_z(:, 0, kg) + coef_xy(:, 44) = coef_xy(:, 44) + coef_xyz(44)*pol_z(:, 0, kg) + coef_xy(:, 45) = coef_xy(:, 45) + coef_xyz(45)*pol_z(:, 0, kg) + coef_xy(:, 46) = coef_xy(:, 46) + coef_xyz(46)*pol_z(:, 0, kg) + coef_xy(:, 47) = coef_xy(:, 47) + coef_xyz(47)*pol_z(:, 0, kg) + coef_xy(:, 48) = coef_xy(:, 48) + coef_xyz(48)*pol_z(:, 0, kg) + coef_xy(:, 49) = coef_xy(:, 49) + coef_xyz(49)*pol_z(:, 0, kg) + coef_xy(:, 50) = coef_xy(:, 50) + coef_xyz(50)*pol_z(:, 0, kg) + coef_xy(:, 51) = coef_xy(:, 51) + coef_xyz(51)*pol_z(:, 0, kg) + coef_xy(:, 52) = coef_xy(:, 52) + coef_xyz(52)*pol_z(:, 0, kg) + coef_xy(:, 53) = coef_xy(:, 53) + coef_xyz(53)*pol_z(:, 0, kg) + coef_xy(:, 54) = coef_xy(:, 54) + coef_xyz(54)*pol_z(:, 0, kg) + coef_xy(:, 55) = coef_xy(:, 55) + coef_xyz(55)*pol_z(:, 0, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(56)*pol_z(:, 1, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(57)*pol_z(:, 1, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(58)*pol_z(:, 1, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(59)*pol_z(:, 1, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(60)*pol_z(:, 1, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(61)*pol_z(:, 1, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(62)*pol_z(:, 1, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(63)*pol_z(:, 1, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(64)*pol_z(:, 1, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(65)*pol_z(:, 1, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(66)*pol_z(:, 1, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(67)*pol_z(:, 1, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(68)*pol_z(:, 1, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(69)*pol_z(:, 1, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(70)*pol_z(:, 1, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(71)*pol_z(:, 1, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(72)*pol_z(:, 1, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(73)*pol_z(:, 1, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(74)*pol_z(:, 1, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(75)*pol_z(:, 1, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(76)*pol_z(:, 1, kg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_xyz(77)*pol_z(:, 1, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(78)*pol_z(:, 1, kg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_xyz(79)*pol_z(:, 1, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(80)*pol_z(:, 1, kg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_xyz(81)*pol_z(:, 1, kg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_xyz(82)*pol_z(:, 1, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(83)*pol_z(:, 1, kg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_xyz(84)*pol_z(:, 1, kg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_xyz(85)*pol_z(:, 1, kg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_xyz(86)*pol_z(:, 1, kg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_xyz(87)*pol_z(:, 1, kg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_xyz(88)*pol_z(:, 1, kg) + coef_xy(:, 38) = coef_xy(:, 38) + coef_xyz(89)*pol_z(:, 1, kg) + coef_xy(:, 39) = coef_xy(:, 39) + coef_xyz(90)*pol_z(:, 1, kg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_xyz(91)*pol_z(:, 1, kg) + coef_xy(:, 42) = coef_xy(:, 42) + coef_xyz(92)*pol_z(:, 1, kg) + coef_xy(:, 43) = coef_xy(:, 43) + coef_xyz(93)*pol_z(:, 1, kg) + coef_xy(:, 44) = coef_xy(:, 44) + coef_xyz(94)*pol_z(:, 1, kg) + coef_xy(:, 46) = coef_xy(:, 46) + coef_xyz(95)*pol_z(:, 1, kg) + coef_xy(:, 47) = coef_xy(:, 47) + coef_xyz(96)*pol_z(:, 1, kg) + coef_xy(:, 48) = coef_xy(:, 48) + coef_xyz(97)*pol_z(:, 1, kg) + coef_xy(:, 50) = coef_xy(:, 50) + coef_xyz(98)*pol_z(:, 1, kg) + coef_xy(:, 51) = coef_xy(:, 51) + coef_xyz(99)*pol_z(:, 1, kg) + coef_xy(:, 53) = coef_xy(:, 53) + coef_xyz(100)*pol_z(:, 1, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(101)*pol_z(:, 2, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(102)*pol_z(:, 2, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(103)*pol_z(:, 2, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(104)*pol_z(:, 2, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(105)*pol_z(:, 2, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(106)*pol_z(:, 2, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(107)*pol_z(:, 2, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(108)*pol_z(:, 2, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(109)*pol_z(:, 2, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(110)*pol_z(:, 2, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(111)*pol_z(:, 2, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(112)*pol_z(:, 2, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(113)*pol_z(:, 2, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(114)*pol_z(:, 2, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(115)*pol_z(:, 2, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(116)*pol_z(:, 2, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(117)*pol_z(:, 2, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(118)*pol_z(:, 2, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(119)*pol_z(:, 2, kg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_xyz(120)*pol_z(:, 2, kg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_xyz(121)*pol_z(:, 2, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(122)*pol_z(:, 2, kg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_xyz(123)*pol_z(:, 2, kg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_xyz(124)*pol_z(:, 2, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(125)*pol_z(:, 2, kg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_xyz(126)*pol_z(:, 2, kg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_xyz(127)*pol_z(:, 2, kg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_xyz(128)*pol_z(:, 2, kg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_xyz(129)*pol_z(:, 2, kg) + coef_xy(:, 38) = coef_xy(:, 38) + coef_xyz(130)*pol_z(:, 2, kg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_xyz(131)*pol_z(:, 2, kg) + coef_xy(:, 42) = coef_xy(:, 42) + coef_xyz(132)*pol_z(:, 2, kg) + coef_xy(:, 43) = coef_xy(:, 43) + coef_xyz(133)*pol_z(:, 2, kg) + coef_xy(:, 46) = coef_xy(:, 46) + coef_xyz(134)*pol_z(:, 2, kg) + coef_xy(:, 47) = coef_xy(:, 47) + coef_xyz(135)*pol_z(:, 2, kg) + coef_xy(:, 50) = coef_xy(:, 50) + coef_xyz(136)*pol_z(:, 2, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(137)*pol_z(:, 3, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(138)*pol_z(:, 3, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(139)*pol_z(:, 3, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(140)*pol_z(:, 3, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(141)*pol_z(:, 3, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(142)*pol_z(:, 3, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(143)*pol_z(:, 3, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(144)*pol_z(:, 3, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(145)*pol_z(:, 3, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(146)*pol_z(:, 3, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(147)*pol_z(:, 3, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(148)*pol_z(:, 3, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(149)*pol_z(:, 3, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(150)*pol_z(:, 3, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(151)*pol_z(:, 3, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(152)*pol_z(:, 3, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(153)*pol_z(:, 3, kg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_xyz(154)*pol_z(:, 3, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(155)*pol_z(:, 3, kg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_xyz(156)*pol_z(:, 3, kg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_xyz(157)*pol_z(:, 3, kg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_xyz(158)*pol_z(:, 3, kg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_xyz(159)*pol_z(:, 3, kg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_xyz(160)*pol_z(:, 3, kg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_xyz(161)*pol_z(:, 3, kg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_xyz(162)*pol_z(:, 3, kg) + coef_xy(:, 42) = coef_xy(:, 42) + coef_xyz(163)*pol_z(:, 3, kg) + coef_xy(:, 46) = coef_xy(:, 46) + coef_xyz(164)*pol_z(:, 3, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(165)*pol_z(:, 4, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(166)*pol_z(:, 4, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(167)*pol_z(:, 4, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(168)*pol_z(:, 4, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(169)*pol_z(:, 4, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(170)*pol_z(:, 4, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(171)*pol_z(:, 4, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(172)*pol_z(:, 4, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(173)*pol_z(:, 4, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(174)*pol_z(:, 4, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(175)*pol_z(:, 4, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(176)*pol_z(:, 4, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(177)*pol_z(:, 4, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(178)*pol_z(:, 4, kg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_xyz(179)*pol_z(:, 4, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(180)*pol_z(:, 4, kg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_xyz(181)*pol_z(:, 4, kg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_xyz(182)*pol_z(:, 4, kg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_xyz(183)*pol_z(:, 4, kg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_xyz(184)*pol_z(:, 4, kg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_xyz(185)*pol_z(:, 4, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(186)*pol_z(:, 5, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(187)*pol_z(:, 5, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(188)*pol_z(:, 5, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(189)*pol_z(:, 5, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(190)*pol_z(:, 5, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(191)*pol_z(:, 5, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(192)*pol_z(:, 5, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(193)*pol_z(:, 5, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(194)*pol_z(:, 5, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(195)*pol_z(:, 5, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(196)*pol_z(:, 5, kg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_xyz(197)*pol_z(:, 5, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(198)*pol_z(:, 5, kg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_xyz(199)*pol_z(:, 5, kg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_xyz(200)*pol_z(:, 5, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(201)*pol_z(:, 6, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(202)*pol_z(:, 6, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(203)*pol_z(:, 6, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(204)*pol_z(:, 6, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(205)*pol_z(:, 6, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(206)*pol_z(:, 6, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(207)*pol_z(:, 6, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(208)*pol_z(:, 6, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(209)*pol_z(:, 6, kg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_xyz(210)*pol_z(:, 6, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(211)*pol_z(:, 7, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(212)*pol_z(:, 7, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(213)*pol_z(:, 7, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(214)*pol_z(:, 7, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(215)*pol_z(:, 7, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(216)*pol_z(:, 7, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(217)*pol_z(:, 8, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(218)*pol_z(:, 8, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(219)*pol_z(:, 8, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(220)*pol_z(:, 9, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 4)*pol_y(1, 0, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 4)*pol_y(1, 0, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 4)*pol_y(2, 0, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 4)*pol_y(2, 0, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 5)*pol_y(1, 0, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 5)*pol_y(1, 0, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 5)*pol_y(2, 0, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 5)*pol_y(2, 0, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 6)*pol_y(1, 0, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 6)*pol_y(1, 0, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 6)*pol_y(2, 0, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 6)*pol_y(2, 0, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 7)*pol_y(1, 0, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 7)*pol_y(1, 0, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 7)*pol_y(2, 0, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 7)*pol_y(2, 0, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 8)*pol_y(1, 0, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 8)*pol_y(1, 0, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 8)*pol_y(2, 0, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 8)*pol_y(2, 0, jg) - coef_x(1, 8) = coef_x(1, 8)+coef_xy(1, 9)*pol_y(1, 0, jg) - coef_x(2, 8) = coef_x(2, 8)+coef_xy(2, 9)*pol_y(1, 0, jg) - coef_x(3, 8) = coef_x(3, 8)+coef_xy(1, 9)*pol_y(2, 0, jg) - coef_x(4, 8) = coef_x(4, 8)+coef_xy(2, 9)*pol_y(2, 0, jg) - coef_x(1, 9) = coef_x(1, 9)+coef_xy(1, 10)*pol_y(1, 0, jg) - coef_x(2, 9) = coef_x(2, 9)+coef_xy(2, 10)*pol_y(1, 0, jg) - coef_x(3, 9) = coef_x(3, 9)+coef_xy(1, 10)*pol_y(2, 0, jg) - coef_x(4, 9) = coef_x(4, 9)+coef_xy(2, 10)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 11)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 11)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 11)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 11)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 12)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 12)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 12)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 12)*pol_y(2, 1, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 13)*pol_y(1, 1, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 13)*pol_y(1, 1, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 13)*pol_y(2, 1, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 13)*pol_y(2, 1, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 14)*pol_y(1, 1, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 14)*pol_y(1, 1, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 14)*pol_y(2, 1, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 14)*pol_y(2, 1, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 15)*pol_y(1, 1, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 15)*pol_y(1, 1, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 15)*pol_y(2, 1, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 15)*pol_y(2, 1, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 16)*pol_y(1, 1, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 16)*pol_y(1, 1, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 16)*pol_y(2, 1, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 16)*pol_y(2, 1, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 17)*pol_y(1, 1, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 17)*pol_y(1, 1, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 17)*pol_y(2, 1, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 17)*pol_y(2, 1, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 18)*pol_y(1, 1, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 18)*pol_y(1, 1, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 18)*pol_y(2, 1, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 18)*pol_y(2, 1, jg) - coef_x(1, 8) = coef_x(1, 8)+coef_xy(1, 19)*pol_y(1, 1, jg) - coef_x(2, 8) = coef_x(2, 8)+coef_xy(2, 19)*pol_y(1, 1, jg) - coef_x(3, 8) = coef_x(3, 8)+coef_xy(1, 19)*pol_y(2, 1, jg) - coef_x(4, 8) = coef_x(4, 8)+coef_xy(2, 19)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 20)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 20)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 20)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 20)*pol_y(2, 2, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 21)*pol_y(1, 2, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 21)*pol_y(1, 2, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 21)*pol_y(2, 2, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 21)*pol_y(2, 2, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 22)*pol_y(1, 2, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 22)*pol_y(1, 2, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 22)*pol_y(2, 2, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 22)*pol_y(2, 2, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 23)*pol_y(1, 2, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 23)*pol_y(1, 2, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 23)*pol_y(2, 2, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 23)*pol_y(2, 2, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 24)*pol_y(1, 2, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 24)*pol_y(1, 2, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 24)*pol_y(2, 2, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 24)*pol_y(2, 2, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 25)*pol_y(1, 2, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 25)*pol_y(1, 2, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 25)*pol_y(2, 2, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 25)*pol_y(2, 2, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 26)*pol_y(1, 2, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 26)*pol_y(1, 2, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 26)*pol_y(2, 2, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 26)*pol_y(2, 2, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 27)*pol_y(1, 2, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 27)*pol_y(1, 2, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 27)*pol_y(2, 2, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 27)*pol_y(2, 2, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 28)*pol_y(1, 3, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 28)*pol_y(1, 3, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 28)*pol_y(2, 3, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 28)*pol_y(2, 3, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 29)*pol_y(1, 3, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 29)*pol_y(1, 3, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 29)*pol_y(2, 3, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 29)*pol_y(2, 3, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 30)*pol_y(1, 3, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 30)*pol_y(1, 3, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 30)*pol_y(2, 3, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 30)*pol_y(2, 3, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 31)*pol_y(1, 3, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 31)*pol_y(1, 3, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 31)*pol_y(2, 3, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 31)*pol_y(2, 3, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 32)*pol_y(1, 3, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 32)*pol_y(1, 3, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 32)*pol_y(2, 3, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 32)*pol_y(2, 3, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 33)*pol_y(1, 3, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 33)*pol_y(1, 3, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 33)*pol_y(2, 3, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 33)*pol_y(2, 3, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 34)*pol_y(1, 3, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 34)*pol_y(1, 3, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 34)*pol_y(2, 3, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 34)*pol_y(2, 3, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 35)*pol_y(1, 4, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 35)*pol_y(1, 4, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 35)*pol_y(2, 4, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 35)*pol_y(2, 4, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 36)*pol_y(1, 4, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 36)*pol_y(1, 4, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 36)*pol_y(2, 4, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 36)*pol_y(2, 4, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 37)*pol_y(1, 4, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 37)*pol_y(1, 4, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 37)*pol_y(2, 4, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 37)*pol_y(2, 4, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 38)*pol_y(1, 4, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 38)*pol_y(1, 4, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 38)*pol_y(2, 4, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 38)*pol_y(2, 4, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 39)*pol_y(1, 4, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 39)*pol_y(1, 4, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 39)*pol_y(2, 4, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 39)*pol_y(2, 4, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 40)*pol_y(1, 4, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 40)*pol_y(1, 4, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 40)*pol_y(2, 4, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 40)*pol_y(2, 4, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 41)*pol_y(1, 5, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 41)*pol_y(1, 5, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 41)*pol_y(2, 5, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 41)*pol_y(2, 5, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 42)*pol_y(1, 5, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 42)*pol_y(1, 5, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 42)*pol_y(2, 5, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 42)*pol_y(2, 5, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 43)*pol_y(1, 5, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 43)*pol_y(1, 5, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 43)*pol_y(2, 5, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 43)*pol_y(2, 5, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 44)*pol_y(1, 5, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 44)*pol_y(1, 5, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 44)*pol_y(2, 5, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 44)*pol_y(2, 5, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 45)*pol_y(1, 5, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 45)*pol_y(1, 5, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 45)*pol_y(2, 5, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 45)*pol_y(2, 5, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 46)*pol_y(1, 6, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 46)*pol_y(1, 6, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 46)*pol_y(2, 6, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 46)*pol_y(2, 6, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 47)*pol_y(1, 6, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 47)*pol_y(1, 6, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 47)*pol_y(2, 6, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 47)*pol_y(2, 6, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 48)*pol_y(1, 6, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 48)*pol_y(1, 6, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 48)*pol_y(2, 6, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 48)*pol_y(2, 6, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 49)*pol_y(1, 6, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 49)*pol_y(1, 6, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 49)*pol_y(2, 6, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 49)*pol_y(2, 6, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 50)*pol_y(1, 7, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 50)*pol_y(1, 7, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 50)*pol_y(2, 7, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 50)*pol_y(2, 7, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 51)*pol_y(1, 7, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 51)*pol_y(1, 7, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 51)*pol_y(2, 7, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 51)*pol_y(2, 7, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 52)*pol_y(1, 7, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 52)*pol_y(1, 7, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 52)*pol_y(2, 7, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 52)*pol_y(2, 7, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 53)*pol_y(1, 8, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 53)*pol_y(1, 8, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 53)*pol_y(2, 8, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 53)*pol_y(2, 8, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 54)*pol_y(1, 8, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 54)*pol_y(1, 8, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 54)*pol_y(2, 8, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 54)*pol_y(2, 8, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 55)*pol_y(1, 9, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 55)*pol_y(1, 9, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 55)*pol_y(2, 9, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 55)*pol_y(2, 9, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 4)*pol_y(1, 0, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 4)*pol_y(1, 0, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 4)*pol_y(2, 0, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 4)*pol_y(2, 0, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 5)*pol_y(1, 0, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 5)*pol_y(1, 0, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 5)*pol_y(2, 0, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 5)*pol_y(2, 0, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 6)*pol_y(1, 0, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 6)*pol_y(1, 0, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 6)*pol_y(2, 0, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 6)*pol_y(2, 0, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 7)*pol_y(1, 0, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 7)*pol_y(1, 0, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 7)*pol_y(2, 0, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 7)*pol_y(2, 0, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 8)*pol_y(1, 0, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 8)*pol_y(1, 0, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 8)*pol_y(2, 0, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 8)*pol_y(2, 0, jg) + coef_x(1, 8) = coef_x(1, 8) + coef_xy(1, 9)*pol_y(1, 0, jg) + coef_x(2, 8) = coef_x(2, 8) + coef_xy(2, 9)*pol_y(1, 0, jg) + coef_x(3, 8) = coef_x(3, 8) + coef_xy(1, 9)*pol_y(2, 0, jg) + coef_x(4, 8) = coef_x(4, 8) + coef_xy(2, 9)*pol_y(2, 0, jg) + coef_x(1, 9) = coef_x(1, 9) + coef_xy(1, 10)*pol_y(1, 0, jg) + coef_x(2, 9) = coef_x(2, 9) + coef_xy(2, 10)*pol_y(1, 0, jg) + coef_x(3, 9) = coef_x(3, 9) + coef_xy(1, 10)*pol_y(2, 0, jg) + coef_x(4, 9) = coef_x(4, 9) + coef_xy(2, 10)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 11)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 11)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 11)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 11)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 12)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 12)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 12)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 12)*pol_y(2, 1, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 13)*pol_y(1, 1, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 13)*pol_y(1, 1, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 13)*pol_y(2, 1, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 13)*pol_y(2, 1, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 14)*pol_y(1, 1, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 14)*pol_y(1, 1, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 14)*pol_y(2, 1, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 14)*pol_y(2, 1, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 15)*pol_y(1, 1, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 15)*pol_y(1, 1, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 15)*pol_y(2, 1, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 15)*pol_y(2, 1, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 16)*pol_y(1, 1, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 16)*pol_y(1, 1, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 16)*pol_y(2, 1, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 16)*pol_y(2, 1, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 17)*pol_y(1, 1, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 17)*pol_y(1, 1, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 17)*pol_y(2, 1, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 17)*pol_y(2, 1, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 18)*pol_y(1, 1, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 18)*pol_y(1, 1, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 18)*pol_y(2, 1, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 18)*pol_y(2, 1, jg) + coef_x(1, 8) = coef_x(1, 8) + coef_xy(1, 19)*pol_y(1, 1, jg) + coef_x(2, 8) = coef_x(2, 8) + coef_xy(2, 19)*pol_y(1, 1, jg) + coef_x(3, 8) = coef_x(3, 8) + coef_xy(1, 19)*pol_y(2, 1, jg) + coef_x(4, 8) = coef_x(4, 8) + coef_xy(2, 19)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 20)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 20)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 20)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 20)*pol_y(2, 2, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 21)*pol_y(1, 2, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 21)*pol_y(1, 2, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 21)*pol_y(2, 2, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 21)*pol_y(2, 2, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 22)*pol_y(1, 2, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 22)*pol_y(1, 2, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 22)*pol_y(2, 2, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 22)*pol_y(2, 2, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 23)*pol_y(1, 2, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 23)*pol_y(1, 2, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 23)*pol_y(2, 2, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 23)*pol_y(2, 2, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 24)*pol_y(1, 2, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 24)*pol_y(1, 2, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 24)*pol_y(2, 2, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 24)*pol_y(2, 2, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 25)*pol_y(1, 2, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 25)*pol_y(1, 2, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 25)*pol_y(2, 2, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 25)*pol_y(2, 2, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 26)*pol_y(1, 2, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 26)*pol_y(1, 2, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 26)*pol_y(2, 2, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 26)*pol_y(2, 2, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 27)*pol_y(1, 2, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 27)*pol_y(1, 2, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 27)*pol_y(2, 2, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 27)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 28)*pol_y(1, 3, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 28)*pol_y(1, 3, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 28)*pol_y(2, 3, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 28)*pol_y(2, 3, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 29)*pol_y(1, 3, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 29)*pol_y(1, 3, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 29)*pol_y(2, 3, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 29)*pol_y(2, 3, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 30)*pol_y(1, 3, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 30)*pol_y(1, 3, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 30)*pol_y(2, 3, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 30)*pol_y(2, 3, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 31)*pol_y(1, 3, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 31)*pol_y(1, 3, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 31)*pol_y(2, 3, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 31)*pol_y(2, 3, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 32)*pol_y(1, 3, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 32)*pol_y(1, 3, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 32)*pol_y(2, 3, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 32)*pol_y(2, 3, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 33)*pol_y(1, 3, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 33)*pol_y(1, 3, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 33)*pol_y(2, 3, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 33)*pol_y(2, 3, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 34)*pol_y(1, 3, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 34)*pol_y(1, 3, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 34)*pol_y(2, 3, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 34)*pol_y(2, 3, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 35)*pol_y(1, 4, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 35)*pol_y(1, 4, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 35)*pol_y(2, 4, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 35)*pol_y(2, 4, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 36)*pol_y(1, 4, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 36)*pol_y(1, 4, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 36)*pol_y(2, 4, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 36)*pol_y(2, 4, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 37)*pol_y(1, 4, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 37)*pol_y(1, 4, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 37)*pol_y(2, 4, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 37)*pol_y(2, 4, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 38)*pol_y(1, 4, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 38)*pol_y(1, 4, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 38)*pol_y(2, 4, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 38)*pol_y(2, 4, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 39)*pol_y(1, 4, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 39)*pol_y(1, 4, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 39)*pol_y(2, 4, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 39)*pol_y(2, 4, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 40)*pol_y(1, 4, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 40)*pol_y(1, 4, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 40)*pol_y(2, 4, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 40)*pol_y(2, 4, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 41)*pol_y(1, 5, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 41)*pol_y(1, 5, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 41)*pol_y(2, 5, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 41)*pol_y(2, 5, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 42)*pol_y(1, 5, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 42)*pol_y(1, 5, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 42)*pol_y(2, 5, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 42)*pol_y(2, 5, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 43)*pol_y(1, 5, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 43)*pol_y(1, 5, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 43)*pol_y(2, 5, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 43)*pol_y(2, 5, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 44)*pol_y(1, 5, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 44)*pol_y(1, 5, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 44)*pol_y(2, 5, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 44)*pol_y(2, 5, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 45)*pol_y(1, 5, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 45)*pol_y(1, 5, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 45)*pol_y(2, 5, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 45)*pol_y(2, 5, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 46)*pol_y(1, 6, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 46)*pol_y(1, 6, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 46)*pol_y(2, 6, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 46)*pol_y(2, 6, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 47)*pol_y(1, 6, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 47)*pol_y(1, 6, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 47)*pol_y(2, 6, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 47)*pol_y(2, 6, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 48)*pol_y(1, 6, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 48)*pol_y(1, 6, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 48)*pol_y(2, 6, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 48)*pol_y(2, 6, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 49)*pol_y(1, 6, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 49)*pol_y(1, 6, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 49)*pol_y(2, 6, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 49)*pol_y(2, 6, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 50)*pol_y(1, 7, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 50)*pol_y(1, 7, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 50)*pol_y(2, 7, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 50)*pol_y(2, 7, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 51)*pol_y(1, 7, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 51)*pol_y(1, 7, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 51)*pol_y(2, 7, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 51)*pol_y(2, 7, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 52)*pol_y(1, 7, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 52)*pol_y(1, 7, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 52)*pol_y(2, 7, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 52)*pol_y(2, 7, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 53)*pol_y(1, 8, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 53)*pol_y(1, 8, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 53)*pol_y(2, 8, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 53)*pol_y(2, 8, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 54)*pol_y(1, 8, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 54)*pol_y(1, 8, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 54)*pol_y(2, 8, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 54)*pol_y(2, 8, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 55)*pol_y(1, 9, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 55)*pol_y(1, 9, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 55)*pol_y(2, 9, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 55)*pol_y(2, 9, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp @@ -2447,15 +2447,15 @@ SUBROUTINE collocate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = 0.0_dp s04 = 0.0_dp DO lxp = 0, lp - s01 = s01+coef_x(1, lxp)*pol_x(lxp, ig) - s02 = s02+coef_x(2, lxp)*pol_x(lxp, ig) - s03 = s03+coef_x(3, lxp)*pol_x(lxp, ig) - s04 = s04+coef_x(4, lxp)*pol_x(lxp, ig) + s01 = s01 + coef_x(1, lxp)*pol_x(lxp, ig) + s02 = s02 + coef_x(2, lxp)*pol_x(lxp, ig) + s03 = s03 + coef_x(3, lxp)*pol_x(lxp, ig) + s04 = s04 + coef_x(4, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO diff --git a/src/grid/collocate_fast_5.f90 b/src/grid/collocate_fast_5.f90 index 02e5f17262..1ccbcfc920 100644 --- a/src/grid/collocate_fast_5.f90 +++ b/src/grid/collocate_fast_5.f90 @@ -14,7 +14,7 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bounds, lp, cmax, gridbounds) USE kinds, ONLY: dp INTEGER, INTENT(IN) :: sphere_bounds(*), lp - REAL(dp), INTENT(IN) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(IN) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER, INTENT(IN) :: cmax REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & @@ -29,15 +29,15 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) @@ -45,35 +45,35 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_xyz(lxyz)*pol_z(1, lzp, kg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_xyz(lxyz)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_xyz(lxyz)*pol_z(1, lzp, kg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_xyz(lxyz)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_x(1, lxp) = coef_x(1, lxp)+coef_xy(1, lxy)*pol_y(1, lyp, jg) - coef_x(2, lxp) = coef_x(2, lxp)+coef_xy(2, lxy)*pol_y(1, lyp, jg) - coef_x(3, lxp) = coef_x(3, lxp)+coef_xy(1, lxy)*pol_y(2, lyp, jg) - coef_x(4, lxp) = coef_x(4, lxp)+coef_xy(2, lxy)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_x(1, lxp) = coef_x(1, lxp) + coef_xy(1, lxy)*pol_y(1, lyp, jg) + coef_x(2, lxp) = coef_x(2, lxp) + coef_xy(2, lxy)*pol_y(1, lyp, jg) + coef_x(3, lxp) = coef_x(3, lxp) + coef_xy(1, lxy)*pol_y(2, lyp, jg) + coef_x(4, lxp) = coef_x(4, lxp) + coef_xy(2, lxy)*pol_y(2, lyp, jg) ENDDO ENDDO @@ -84,15 +84,15 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe s03 = 0.0_dp s04 = 0.0_dp DO lxp = 0, lp - s01 = s01+coef_x(1, lxp)*pol_x(lxp, ig) - s02 = s02+coef_x(2, lxp)*pol_x(lxp, ig) - s03 = s03+coef_x(3, lxp)*pol_x(lxp, ig) - s04 = s04+coef_x(4, lxp)*pol_x(lxp, ig) + s01 = s01 + coef_x(1, lxp)*pol_x(lxp, ig) + s02 = s02 + coef_x(2, lxp)*pol_x(lxp, ig) + s03 = s03 + coef_x(3, lxp)*pol_x(lxp, ig) + s04 = s04 + coef_x(4, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO @@ -120,40 +120,40 @@ SUBROUTINE collocate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 0 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp @@ -161,15 +161,15 @@ SUBROUTINE collocate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = 0.0_dp s04 = 0.0_dp DO lxp = 0, lp - s01 = s01+coef_x(1, lxp)*pol_x(lxp, ig) - s02 = s02+coef_x(2, lxp)*pol_x(lxp, ig) - s03 = s03+coef_x(3, lxp)*pol_x(lxp, ig) - s04 = s04+coef_x(4, lxp)*pol_x(lxp, ig) + s01 = s01 + coef_x(1, lxp)*pol_x(lxp, ig) + s02 = s02 + coef_x(2, lxp)*pol_x(lxp, ig) + s03 = s03 + coef_x(3, lxp)*pol_x(lxp, ig) + s04 = s04 + coef_x(4, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -196,59 +196,59 @@ SUBROUTINE collocate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 1 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lyp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s(4) sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(4)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(4)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(4)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(4)*pol_z(2, 1, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_x(1:2, lxp) = coef_x(1:2, lxp)+coef_xy(1:2, lxy)*pol_y(1, lyp, jg) - coef_x(3:4, lxp) = coef_x(3:4, lxp)+coef_xy(1:2, lxy)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_x(1:2, lxp) = coef_x(1:2, lxp) + coef_xy(1:2, lxy)*pol_y(1, lyp, jg) + coef_x(3:4, lxp) = coef_x(3:4, lxp) + coef_xy(1:2, lxy)*pol_y(2, lyp, jg) ENDDO ENDDO DO ig = igmin, igmax i = map(ig, 1) s(:) = 0.0_dp - s(:) = s(:)+coef_x(:, 0)*pol_x(0, ig) - s(:) = s(:)+coef_x(:, 1)*pol_x(1, ig) - grid(i, j, k) = grid(i, j, k)+s(1) - grid(i, j2, k) = grid(i, j2, k)+s(3) - grid(i, j, k2) = grid(i, j, k2)+s(2) - grid(i, j2, k2) = grid(i, j2, k2)+s(4) + s(:) = s(:) + coef_x(:, 0)*pol_x(0, ig) + s(:) = s(:) + coef_x(:, 1)*pol_x(1, ig) + grid(i, j, k) = grid(i, j, k) + s(1) + grid(i, j2, k) = grid(i, j2, k) + s(3) + grid(i, j, k2) = grid(i, j, k2) + s(2) + grid(i, j2, k2) = grid(i, j2, k2) + s(4) END DO END DO END DO @@ -275,50 +275,50 @@ SUBROUTINE collocate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 2 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lyp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(1)*pol_z(:, 0, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(2)*pol_z(:, 0, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(3)*pol_z(:, 0, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(4)*pol_z(:, 0, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(5)*pol_z(:, 0, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(6)*pol_z(:, 0, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(7)*pol_z(:, 1, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(8)*pol_z(:, 1, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(9)*pol_z(:, 1, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(10)*pol_z(:, 2, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(1)*pol_z(:, 0, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(2)*pol_z(:, 0, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(3)*pol_z(:, 0, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(4)*pol_z(:, 0, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(5)*pol_z(:, 0, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(6)*pol_z(:, 0, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(7)*pol_z(:, 1, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(8)*pol_z(:, 1, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(9)*pol_z(:, 1, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(10)*pol_z(:, 2, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_x(1:2, lxp) = coef_x(1:2, lxp)+coef_xy(1:2, lxy)*pol_y(1, lyp, jg) - coef_x(3:4, lxp) = coef_x(3:4, lxp)+coef_xy(1:2, lxy)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_x(1:2, lxp) = coef_x(1:2, lxp) + coef_xy(1:2, lxy)*pol_y(1, lyp, jg) + coef_x(3:4, lxp) = coef_x(3:4, lxp) + coef_xy(1:2, lxy)*pol_y(2, lyp, jg) ENDDO ENDDO DO ig = igmin, igmax @@ -328,15 +328,15 @@ SUBROUTINE collocate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = 0.0_dp s04 = 0.0_dp DO lxp = 0, lp - s01 = s01+coef_x(1, lxp)*pol_x(lxp, ig) - s02 = s02+coef_x(2, lxp)*pol_x(lxp, ig) - s03 = s03+coef_x(3, lxp)*pol_x(lxp, ig) - s04 = s04+coef_x(4, lxp)*pol_x(lxp, ig) + s01 = s01 + coef_x(1, lxp)*pol_x(lxp, ig) + s02 = s02 + coef_x(2, lxp)*pol_x(lxp, ig) + s03 = s03 + coef_x(3, lxp)*pol_x(lxp, ig) + s04 = s04 + coef_x(4, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -363,67 +363,67 @@ SUBROUTINE collocate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 3 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_xyz(lxyz)*pol_z(1, lzp, kg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_xyz(lxyz)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_xyz(lxyz)*pol_z(1, lzp, kg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_xyz(lxyz)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 1)*pol_y(1, 0, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 1)*pol_y(2, 0, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 2)*pol_y(1, 0, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 2)*pol_y(2, 0, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 3)*pol_y(1, 0, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 3)*pol_y(2, 0, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 4)*pol_y(1, 0, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 4)*pol_y(2, 0, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 5)*pol_y(1, 1, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 5)*pol_y(2, 1, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 6)*pol_y(1, 1, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 6)*pol_y(2, 1, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 7)*pol_y(1, 1, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 7)*pol_y(2, 1, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 8)*pol_y(1, 2, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 8)*pol_y(2, 2, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 9)*pol_y(1, 2, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 9)*pol_y(2, 2, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 10)*pol_y(1, 3, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 10)*pol_y(2, 3, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 1)*pol_y(1, 0, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 1)*pol_y(2, 0, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 2)*pol_y(1, 0, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 2)*pol_y(2, 0, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 3)*pol_y(1, 0, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 3)*pol_y(2, 0, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 4)*pol_y(1, 0, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 4)*pol_y(2, 0, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 5)*pol_y(1, 1, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 5)*pol_y(2, 1, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 6)*pol_y(1, 1, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 6)*pol_y(2, 1, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 7)*pol_y(1, 1, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 7)*pol_y(2, 1, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 8)*pol_y(1, 2, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 8)*pol_y(2, 2, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 9)*pol_y(1, 2, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 9)*pol_y(2, 2, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 10)*pol_y(1, 3, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 10)*pol_y(2, 3, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp @@ -431,15 +431,15 @@ SUBROUTINE collocate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = 0.0_dp s04 = 0.0_dp DO lxp = 0, lp - s01 = s01+coef_x(1, lxp)*pol_x(lxp, ig) - s02 = s02+coef_x(2, lxp)*pol_x(lxp, ig) - s03 = s03+coef_x(3, lxp)*pol_x(lxp, ig) - s04 = s04+coef_x(4, lxp)*pol_x(lxp, ig) + s01 = s01 + coef_x(1, lxp)*pol_x(lxp, ig) + s02 = s02 + coef_x(2, lxp)*pol_x(lxp, ig) + s03 = s03 + coef_x(3, lxp)*pol_x(lxp, ig) + s04 = s04 + coef_x(4, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -466,159 +466,159 @@ SUBROUTINE collocate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 4 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(1)*pol_z(:, 0, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(2)*pol_z(:, 0, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(3)*pol_z(:, 0, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(4)*pol_z(:, 0, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(5)*pol_z(:, 0, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(6)*pol_z(:, 0, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(7)*pol_z(:, 0, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(8)*pol_z(:, 0, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(9)*pol_z(:, 0, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(10)*pol_z(:, 0, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(11)*pol_z(:, 0, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(12)*pol_z(:, 0, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(13)*pol_z(:, 0, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(14)*pol_z(:, 0, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(15)*pol_z(:, 0, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(16)*pol_z(:, 1, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(17)*pol_z(:, 1, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(18)*pol_z(:, 1, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(19)*pol_z(:, 1, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(20)*pol_z(:, 1, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(21)*pol_z(:, 1, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(22)*pol_z(:, 1, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(23)*pol_z(:, 1, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(24)*pol_z(:, 1, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(25)*pol_z(:, 1, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(26)*pol_z(:, 2, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(27)*pol_z(:, 2, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(28)*pol_z(:, 2, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(29)*pol_z(:, 2, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(30)*pol_z(:, 2, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(31)*pol_z(:, 2, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(32)*pol_z(:, 3, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(33)*pol_z(:, 3, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(34)*pol_z(:, 3, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(35)*pol_z(:, 4, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(1)*pol_z(:, 0, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(2)*pol_z(:, 0, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(3)*pol_z(:, 0, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(4)*pol_z(:, 0, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(5)*pol_z(:, 0, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(6)*pol_z(:, 0, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(7)*pol_z(:, 0, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(8)*pol_z(:, 0, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(9)*pol_z(:, 0, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(10)*pol_z(:, 0, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(11)*pol_z(:, 0, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(12)*pol_z(:, 0, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(13)*pol_z(:, 0, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(14)*pol_z(:, 0, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(15)*pol_z(:, 0, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(16)*pol_z(:, 1, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(17)*pol_z(:, 1, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(18)*pol_z(:, 1, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(19)*pol_z(:, 1, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(20)*pol_z(:, 1, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(21)*pol_z(:, 1, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(22)*pol_z(:, 1, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(23)*pol_z(:, 1, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(24)*pol_z(:, 1, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(25)*pol_z(:, 1, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(26)*pol_z(:, 2, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(27)*pol_z(:, 2, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(28)*pol_z(:, 2, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(29)*pol_z(:, 2, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(30)*pol_z(:, 2, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(31)*pol_z(:, 2, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(32)*pol_z(:, 3, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(33)*pol_z(:, 3, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(34)*pol_z(:, 3, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(35)*pol_z(:, 4, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 4)*pol_y(1, 0, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 4)*pol_y(1, 0, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 4)*pol_y(2, 0, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 4)*pol_y(2, 0, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 5)*pol_y(1, 0, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 5)*pol_y(1, 0, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 5)*pol_y(2, 0, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 5)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 6)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 6)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 6)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 6)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 7)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 7)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 7)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 7)*pol_y(2, 1, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 8)*pol_y(1, 1, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 8)*pol_y(1, 1, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 8)*pol_y(2, 1, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 8)*pol_y(2, 1, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 9)*pol_y(1, 1, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 9)*pol_y(1, 1, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 9)*pol_y(2, 1, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 9)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 10)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 10)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 10)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 10)*pol_y(2, 2, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 11)*pol_y(1, 2, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 11)*pol_y(1, 2, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 11)*pol_y(2, 2, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 11)*pol_y(2, 2, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 12)*pol_y(1, 2, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 12)*pol_y(1, 2, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 12)*pol_y(2, 2, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 12)*pol_y(2, 2, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 13)*pol_y(1, 3, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 13)*pol_y(1, 3, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 13)*pol_y(2, 3, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 13)*pol_y(2, 3, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 14)*pol_y(1, 3, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 14)*pol_y(1, 3, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 14)*pol_y(2, 3, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 14)*pol_y(2, 3, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 15)*pol_y(1, 4, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 15)*pol_y(1, 4, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 15)*pol_y(2, 4, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 15)*pol_y(2, 4, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 4)*pol_y(1, 0, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 4)*pol_y(1, 0, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 4)*pol_y(2, 0, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 4)*pol_y(2, 0, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 5)*pol_y(1, 0, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 5)*pol_y(1, 0, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 5)*pol_y(2, 0, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 5)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 6)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 6)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 6)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 6)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 7)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 7)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 7)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 7)*pol_y(2, 1, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 8)*pol_y(1, 1, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 8)*pol_y(1, 1, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 8)*pol_y(2, 1, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 8)*pol_y(2, 1, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 9)*pol_y(1, 1, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 9)*pol_y(1, 1, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 9)*pol_y(2, 1, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 9)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 10)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 10)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 10)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 10)*pol_y(2, 2, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 11)*pol_y(1, 2, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 11)*pol_y(1, 2, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 11)*pol_y(2, 2, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 11)*pol_y(2, 2, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 12)*pol_y(1, 2, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 12)*pol_y(1, 2, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 12)*pol_y(2, 2, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 12)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 13)*pol_y(1, 3, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 13)*pol_y(1, 3, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 13)*pol_y(2, 3, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 13)*pol_y(2, 3, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 14)*pol_y(1, 3, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 14)*pol_y(1, 3, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 14)*pol_y(2, 3, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 14)*pol_y(2, 3, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 15)*pol_y(1, 4, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 15)*pol_y(1, 4, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 15)*pol_y(2, 4, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 15)*pol_y(2, 4, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - s01 = s01+coef_x(1, 4)*pol_x(4, ig) - s02 = s02+coef_x(2, 4)*pol_x(4, ig) - s03 = s03+coef_x(3, 4)*pol_x(4, ig) - s04 = s04+coef_x(4, 4)*pol_x(4, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + s01 = s01 + coef_x(1, 4)*pol_x(4, ig) + s02 = s02 + coef_x(2, 4)*pol_x(4, ig) + s03 = s03 + coef_x(3, 4)*pol_x(4, ig) + s04 = s04 + coef_x(4, 4)*pol_x(4, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -645,222 +645,222 @@ SUBROUTINE collocate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 5 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(7)*pol_z(1, 0, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(7)*pol_z(2, 0, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(8)*pol_z(1, 0, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(8)*pol_z(2, 0, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(9)*pol_z(1, 0, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(9)*pol_z(2, 0, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(10)*pol_z(1, 0, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(10)*pol_z(2, 0, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(11)*pol_z(1, 0, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(11)*pol_z(2, 0, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(12)*pol_z(1, 0, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(12)*pol_z(2, 0, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(13)*pol_z(1, 0, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(13)*pol_z(2, 0, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(14)*pol_z(1, 0, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(14)*pol_z(2, 0, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(15)*pol_z(1, 0, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(15)*pol_z(2, 0, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(16)*pol_z(1, 0, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(16)*pol_z(2, 0, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(17)*pol_z(1, 0, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(17)*pol_z(2, 0, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(18)*pol_z(1, 0, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(18)*pol_z(2, 0, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(19)*pol_z(1, 0, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(19)*pol_z(2, 0, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(20)*pol_z(1, 0, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(20)*pol_z(2, 0, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(21)*pol_z(1, 0, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(21)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(22)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(22)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(23)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(23)*pol_z(2, 1, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(24)*pol_z(1, 1, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(24)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(25)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(25)*pol_z(2, 1, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(26)*pol_z(1, 1, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(26)*pol_z(2, 1, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(27)*pol_z(1, 1, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(27)*pol_z(2, 1, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(28)*pol_z(1, 1, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(28)*pol_z(2, 1, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(29)*pol_z(1, 1, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(29)*pol_z(2, 1, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(30)*pol_z(1, 1, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(30)*pol_z(2, 1, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(31)*pol_z(1, 1, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(31)*pol_z(2, 1, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(32)*pol_z(1, 1, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(32)*pol_z(2, 1, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(33)*pol_z(1, 1, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(33)*pol_z(2, 1, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(34)*pol_z(1, 1, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(34)*pol_z(2, 1, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(35)*pol_z(1, 1, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(35)*pol_z(2, 1, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(36)*pol_z(1, 1, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(36)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(37)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(37)*pol_z(2, 2, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(38)*pol_z(1, 2, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(38)*pol_z(2, 2, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(39)*pol_z(1, 2, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(39)*pol_z(2, 2, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(40)*pol_z(1, 2, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(40)*pol_z(2, 2, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(41)*pol_z(1, 2, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(41)*pol_z(2, 2, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(42)*pol_z(1, 2, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(42)*pol_z(2, 2, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(43)*pol_z(1, 2, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(43)*pol_z(2, 2, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(44)*pol_z(1, 2, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(44)*pol_z(2, 2, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(45)*pol_z(1, 2, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(45)*pol_z(2, 2, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(46)*pol_z(1, 2, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(46)*pol_z(2, 2, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(47)*pol_z(1, 3, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(47)*pol_z(2, 3, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(48)*pol_z(1, 3, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(48)*pol_z(2, 3, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(49)*pol_z(1, 3, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(49)*pol_z(2, 3, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(50)*pol_z(1, 3, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(50)*pol_z(2, 3, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(51)*pol_z(1, 3, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(51)*pol_z(2, 3, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(52)*pol_z(1, 3, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(52)*pol_z(2, 3, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(53)*pol_z(1, 4, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(53)*pol_z(2, 4, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(54)*pol_z(1, 4, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(54)*pol_z(2, 4, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(55)*pol_z(1, 4, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(55)*pol_z(2, 4, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(56)*pol_z(1, 5, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(56)*pol_z(2, 5, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(7)*pol_z(1, 0, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(7)*pol_z(2, 0, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(8)*pol_z(1, 0, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(8)*pol_z(2, 0, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(9)*pol_z(1, 0, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(9)*pol_z(2, 0, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(10)*pol_z(1, 0, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(10)*pol_z(2, 0, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(11)*pol_z(1, 0, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(11)*pol_z(2, 0, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(12)*pol_z(1, 0, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(12)*pol_z(2, 0, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(13)*pol_z(1, 0, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(13)*pol_z(2, 0, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(14)*pol_z(1, 0, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(14)*pol_z(2, 0, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(15)*pol_z(1, 0, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(15)*pol_z(2, 0, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(16)*pol_z(1, 0, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(16)*pol_z(2, 0, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(17)*pol_z(1, 0, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(17)*pol_z(2, 0, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(18)*pol_z(1, 0, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(18)*pol_z(2, 0, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(19)*pol_z(1, 0, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(19)*pol_z(2, 0, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(20)*pol_z(1, 0, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(20)*pol_z(2, 0, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(21)*pol_z(1, 0, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(21)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(22)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(22)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(23)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(23)*pol_z(2, 1, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(24)*pol_z(1, 1, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(24)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(25)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(25)*pol_z(2, 1, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(26)*pol_z(1, 1, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(26)*pol_z(2, 1, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(27)*pol_z(1, 1, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(27)*pol_z(2, 1, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(28)*pol_z(1, 1, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(28)*pol_z(2, 1, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(29)*pol_z(1, 1, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(29)*pol_z(2, 1, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(30)*pol_z(1, 1, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(30)*pol_z(2, 1, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(31)*pol_z(1, 1, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(31)*pol_z(2, 1, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(32)*pol_z(1, 1, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(32)*pol_z(2, 1, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(33)*pol_z(1, 1, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(33)*pol_z(2, 1, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(34)*pol_z(1, 1, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(34)*pol_z(2, 1, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(35)*pol_z(1, 1, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(35)*pol_z(2, 1, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(36)*pol_z(1, 1, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(36)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(37)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(37)*pol_z(2, 2, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(38)*pol_z(1, 2, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(38)*pol_z(2, 2, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(39)*pol_z(1, 2, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(39)*pol_z(2, 2, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(40)*pol_z(1, 2, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(40)*pol_z(2, 2, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(41)*pol_z(1, 2, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(41)*pol_z(2, 2, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(42)*pol_z(1, 2, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(42)*pol_z(2, 2, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(43)*pol_z(1, 2, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(43)*pol_z(2, 2, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(44)*pol_z(1, 2, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(44)*pol_z(2, 2, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(45)*pol_z(1, 2, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(45)*pol_z(2, 2, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(46)*pol_z(1, 2, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(46)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(47)*pol_z(1, 3, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(47)*pol_z(2, 3, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(48)*pol_z(1, 3, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(48)*pol_z(2, 3, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(49)*pol_z(1, 3, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(49)*pol_z(2, 3, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(50)*pol_z(1, 3, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(50)*pol_z(2, 3, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(51)*pol_z(1, 3, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(51)*pol_z(2, 3, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(52)*pol_z(1, 3, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(52)*pol_z(2, 3, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(53)*pol_z(1, 4, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(53)*pol_z(2, 4, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(54)*pol_z(1, 4, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(54)*pol_z(2, 4, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(55)*pol_z(1, 4, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(55)*pol_z(2, 4, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(56)*pol_z(1, 5, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(56)*pol_z(2, 5, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 1)*pol_y(1, 0, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 1)*pol_y(2, 0, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 2)*pol_y(1, 0, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 2)*pol_y(2, 0, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 3)*pol_y(1, 0, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 3)*pol_y(2, 0, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 4)*pol_y(1, 0, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 4)*pol_y(2, 0, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 5)*pol_y(1, 0, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 5)*pol_y(2, 0, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 6)*pol_y(1, 0, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 6)*pol_y(2, 0, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 7)*pol_y(1, 1, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 7)*pol_y(2, 1, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 8)*pol_y(1, 1, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 8)*pol_y(2, 1, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 9)*pol_y(1, 1, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 9)*pol_y(2, 1, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 10)*pol_y(1, 1, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 10)*pol_y(2, 1, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 11)*pol_y(1, 1, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 11)*pol_y(2, 1, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 12)*pol_y(1, 2, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 12)*pol_y(2, 2, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 13)*pol_y(1, 2, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 13)*pol_y(2, 2, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 14)*pol_y(1, 2, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 14)*pol_y(2, 2, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 15)*pol_y(1, 2, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 15)*pol_y(2, 2, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 16)*pol_y(1, 3, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 16)*pol_y(2, 3, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 17)*pol_y(1, 3, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 17)*pol_y(2, 3, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 18)*pol_y(1, 3, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 18)*pol_y(2, 3, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 19)*pol_y(1, 4, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 19)*pol_y(2, 4, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 20)*pol_y(1, 4, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 20)*pol_y(2, 4, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 21)*pol_y(1, 5, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 21)*pol_y(2, 5, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 1)*pol_y(1, 0, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 1)*pol_y(2, 0, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 2)*pol_y(1, 0, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 2)*pol_y(2, 0, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 3)*pol_y(1, 0, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 3)*pol_y(2, 0, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 4)*pol_y(1, 0, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 4)*pol_y(2, 0, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 5)*pol_y(1, 0, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 5)*pol_y(2, 0, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 6)*pol_y(1, 0, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 6)*pol_y(2, 0, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 7)*pol_y(1, 1, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 7)*pol_y(2, 1, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 8)*pol_y(1, 1, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 8)*pol_y(2, 1, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 9)*pol_y(1, 1, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 9)*pol_y(2, 1, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 10)*pol_y(1, 1, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 10)*pol_y(2, 1, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 11)*pol_y(1, 1, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 11)*pol_y(2, 1, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 12)*pol_y(1, 2, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 12)*pol_y(2, 2, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 13)*pol_y(1, 2, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 13)*pol_y(2, 2, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 14)*pol_y(1, 2, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 14)*pol_y(2, 2, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 15)*pol_y(1, 2, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 15)*pol_y(2, 2, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 16)*pol_y(1, 3, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 16)*pol_y(2, 3, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 17)*pol_y(1, 3, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 17)*pol_y(2, 3, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 18)*pol_y(1, 3, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 18)*pol_y(2, 3, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 19)*pol_y(1, 4, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 19)*pol_y(2, 4, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 20)*pol_y(1, 4, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 20)*pol_y(2, 4, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 21)*pol_y(1, 5, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 21)*pol_y(2, 5, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - s01 = s01+coef_x(1, 4)*pol_x(4, ig) - s02 = s02+coef_x(2, 4)*pol_x(4, ig) - s03 = s03+coef_x(3, 4)*pol_x(4, ig) - s04 = s04+coef_x(4, 4)*pol_x(4, ig) - s01 = s01+coef_x(1, 5)*pol_x(5, ig) - s02 = s02+coef_x(2, 5)*pol_x(5, ig) - s03 = s03+coef_x(3, 5)*pol_x(5, ig) - s04 = s04+coef_x(4, 5)*pol_x(5, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + s01 = s01 + coef_x(1, 4)*pol_x(4, ig) + s02 = s02 + coef_x(2, 4)*pol_x(4, ig) + s03 = s03 + coef_x(3, 4)*pol_x(4, ig) + s04 = s04 + coef_x(4, 4)*pol_x(4, ig) + s01 = s01 + coef_x(1, 5)*pol_x(5, ig) + s02 = s02 + coef_x(2, 5)*pol_x(5, ig) + s03 = s03 + coef_x(3, 5)*pol_x(5, ig) + s04 = s04 + coef_x(4, 5)*pol_x(5, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -887,208 +887,208 @@ SUBROUTINE collocate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 6 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lyp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(7)*pol_z(1, 0, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(7)*pol_z(2, 0, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(8)*pol_z(1, 0, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(8)*pol_z(2, 0, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(9)*pol_z(1, 0, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(9)*pol_z(2, 0, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(10)*pol_z(1, 0, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(10)*pol_z(2, 0, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(11)*pol_z(1, 0, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(11)*pol_z(2, 0, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(12)*pol_z(1, 0, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(12)*pol_z(2, 0, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(13)*pol_z(1, 0, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(13)*pol_z(2, 0, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(14)*pol_z(1, 0, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(14)*pol_z(2, 0, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(15)*pol_z(1, 0, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(15)*pol_z(2, 0, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(16)*pol_z(1, 0, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(16)*pol_z(2, 0, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(17)*pol_z(1, 0, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(17)*pol_z(2, 0, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(18)*pol_z(1, 0, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(18)*pol_z(2, 0, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(19)*pol_z(1, 0, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(19)*pol_z(2, 0, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(20)*pol_z(1, 0, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(20)*pol_z(2, 0, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(21)*pol_z(1, 0, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(21)*pol_z(2, 0, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(22)*pol_z(1, 0, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(22)*pol_z(2, 0, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(23)*pol_z(1, 0, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(23)*pol_z(2, 0, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(24)*pol_z(1, 0, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(24)*pol_z(2, 0, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(25)*pol_z(1, 0, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(25)*pol_z(2, 0, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(26)*pol_z(1, 0, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(26)*pol_z(2, 0, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(27)*pol_z(1, 0, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(27)*pol_z(2, 0, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(28)*pol_z(1, 0, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(28)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(29)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(29)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(30)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(30)*pol_z(2, 1, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(31)*pol_z(1, 1, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(31)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(32)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(32)*pol_z(2, 1, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(33)*pol_z(1, 1, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(33)*pol_z(2, 1, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(34)*pol_z(1, 1, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(34)*pol_z(2, 1, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(35)*pol_z(1, 1, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(35)*pol_z(2, 1, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(36)*pol_z(1, 1, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(36)*pol_z(2, 1, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(37)*pol_z(1, 1, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(37)*pol_z(2, 1, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(38)*pol_z(1, 1, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(38)*pol_z(2, 1, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(39)*pol_z(1, 1, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(39)*pol_z(2, 1, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(40)*pol_z(1, 1, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(40)*pol_z(2, 1, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(41)*pol_z(1, 1, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(41)*pol_z(2, 1, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(42)*pol_z(1, 1, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(42)*pol_z(2, 1, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(43)*pol_z(1, 1, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(43)*pol_z(2, 1, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(44)*pol_z(1, 1, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(44)*pol_z(2, 1, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(45)*pol_z(1, 1, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(45)*pol_z(2, 1, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(46)*pol_z(1, 1, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(46)*pol_z(2, 1, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(47)*pol_z(1, 1, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(47)*pol_z(2, 1, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(48)*pol_z(1, 1, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(48)*pol_z(2, 1, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(49)*pol_z(1, 1, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(49)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(50)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(50)*pol_z(2, 2, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(51)*pol_z(1, 2, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(51)*pol_z(2, 2, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(52)*pol_z(1, 2, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(52)*pol_z(2, 2, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(53)*pol_z(1, 2, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(53)*pol_z(2, 2, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(54)*pol_z(1, 2, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(54)*pol_z(2, 2, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(55)*pol_z(1, 2, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(55)*pol_z(2, 2, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(56)*pol_z(1, 2, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(56)*pol_z(2, 2, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(57)*pol_z(1, 2, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(57)*pol_z(2, 2, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(58)*pol_z(1, 2, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(58)*pol_z(2, 2, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(59)*pol_z(1, 2, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(59)*pol_z(2, 2, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(60)*pol_z(1, 2, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(60)*pol_z(2, 2, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(61)*pol_z(1, 2, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(61)*pol_z(2, 2, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(62)*pol_z(1, 2, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(62)*pol_z(2, 2, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(63)*pol_z(1, 2, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(63)*pol_z(2, 2, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(64)*pol_z(1, 2, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(64)*pol_z(2, 2, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(65)*pol_z(1, 3, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(65)*pol_z(2, 3, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(66)*pol_z(1, 3, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(66)*pol_z(2, 3, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(67)*pol_z(1, 3, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(67)*pol_z(2, 3, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(68)*pol_z(1, 3, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(68)*pol_z(2, 3, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(69)*pol_z(1, 3, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(69)*pol_z(2, 3, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(70)*pol_z(1, 3, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(70)*pol_z(2, 3, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(71)*pol_z(1, 3, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(71)*pol_z(2, 3, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(72)*pol_z(1, 3, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(72)*pol_z(2, 3, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(73)*pol_z(1, 3, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(73)*pol_z(2, 3, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(74)*pol_z(1, 3, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(74)*pol_z(2, 3, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(75)*pol_z(1, 4, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(75)*pol_z(2, 4, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(76)*pol_z(1, 4, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(76)*pol_z(2, 4, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(77)*pol_z(1, 4, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(77)*pol_z(2, 4, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(78)*pol_z(1, 4, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(78)*pol_z(2, 4, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(79)*pol_z(1, 4, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(79)*pol_z(2, 4, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(80)*pol_z(1, 4, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(80)*pol_z(2, 4, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(81)*pol_z(1, 5, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(81)*pol_z(2, 5, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(82)*pol_z(1, 5, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(82)*pol_z(2, 5, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(83)*pol_z(1, 5, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(83)*pol_z(2, 5, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(84)*pol_z(1, 6, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(84)*pol_z(2, 6, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(7)*pol_z(1, 0, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(7)*pol_z(2, 0, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(8)*pol_z(1, 0, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(8)*pol_z(2, 0, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(9)*pol_z(1, 0, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(9)*pol_z(2, 0, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(10)*pol_z(1, 0, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(10)*pol_z(2, 0, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(11)*pol_z(1, 0, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(11)*pol_z(2, 0, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(12)*pol_z(1, 0, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(12)*pol_z(2, 0, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(13)*pol_z(1, 0, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(13)*pol_z(2, 0, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(14)*pol_z(1, 0, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(14)*pol_z(2, 0, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(15)*pol_z(1, 0, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(15)*pol_z(2, 0, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(16)*pol_z(1, 0, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(16)*pol_z(2, 0, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(17)*pol_z(1, 0, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(17)*pol_z(2, 0, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(18)*pol_z(1, 0, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(18)*pol_z(2, 0, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(19)*pol_z(1, 0, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(19)*pol_z(2, 0, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(20)*pol_z(1, 0, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(20)*pol_z(2, 0, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(21)*pol_z(1, 0, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(21)*pol_z(2, 0, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(22)*pol_z(1, 0, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(22)*pol_z(2, 0, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(23)*pol_z(1, 0, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(23)*pol_z(2, 0, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(24)*pol_z(1, 0, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(24)*pol_z(2, 0, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(25)*pol_z(1, 0, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(25)*pol_z(2, 0, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(26)*pol_z(1, 0, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(26)*pol_z(2, 0, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(27)*pol_z(1, 0, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(27)*pol_z(2, 0, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(28)*pol_z(1, 0, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(28)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(29)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(29)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(30)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(30)*pol_z(2, 1, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(31)*pol_z(1, 1, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(31)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(32)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(32)*pol_z(2, 1, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(33)*pol_z(1, 1, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(33)*pol_z(2, 1, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(34)*pol_z(1, 1, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(34)*pol_z(2, 1, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(35)*pol_z(1, 1, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(35)*pol_z(2, 1, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(36)*pol_z(1, 1, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(36)*pol_z(2, 1, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(37)*pol_z(1, 1, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(37)*pol_z(2, 1, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(38)*pol_z(1, 1, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(38)*pol_z(2, 1, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(39)*pol_z(1, 1, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(39)*pol_z(2, 1, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(40)*pol_z(1, 1, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(40)*pol_z(2, 1, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(41)*pol_z(1, 1, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(41)*pol_z(2, 1, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(42)*pol_z(1, 1, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(42)*pol_z(2, 1, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(43)*pol_z(1, 1, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(43)*pol_z(2, 1, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(44)*pol_z(1, 1, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(44)*pol_z(2, 1, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(45)*pol_z(1, 1, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(45)*pol_z(2, 1, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(46)*pol_z(1, 1, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(46)*pol_z(2, 1, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(47)*pol_z(1, 1, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(47)*pol_z(2, 1, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(48)*pol_z(1, 1, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(48)*pol_z(2, 1, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(49)*pol_z(1, 1, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(49)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(50)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(50)*pol_z(2, 2, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(51)*pol_z(1, 2, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(51)*pol_z(2, 2, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(52)*pol_z(1, 2, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(52)*pol_z(2, 2, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(53)*pol_z(1, 2, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(53)*pol_z(2, 2, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(54)*pol_z(1, 2, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(54)*pol_z(2, 2, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(55)*pol_z(1, 2, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(55)*pol_z(2, 2, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(56)*pol_z(1, 2, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(56)*pol_z(2, 2, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(57)*pol_z(1, 2, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(57)*pol_z(2, 2, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(58)*pol_z(1, 2, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(58)*pol_z(2, 2, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(59)*pol_z(1, 2, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(59)*pol_z(2, 2, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(60)*pol_z(1, 2, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(60)*pol_z(2, 2, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(61)*pol_z(1, 2, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(61)*pol_z(2, 2, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(62)*pol_z(1, 2, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(62)*pol_z(2, 2, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(63)*pol_z(1, 2, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(63)*pol_z(2, 2, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(64)*pol_z(1, 2, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(64)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(65)*pol_z(1, 3, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(65)*pol_z(2, 3, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(66)*pol_z(1, 3, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(66)*pol_z(2, 3, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(67)*pol_z(1, 3, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(67)*pol_z(2, 3, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(68)*pol_z(1, 3, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(68)*pol_z(2, 3, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(69)*pol_z(1, 3, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(69)*pol_z(2, 3, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(70)*pol_z(1, 3, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(70)*pol_z(2, 3, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(71)*pol_z(1, 3, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(71)*pol_z(2, 3, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(72)*pol_z(1, 3, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(72)*pol_z(2, 3, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(73)*pol_z(1, 3, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(73)*pol_z(2, 3, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(74)*pol_z(1, 3, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(74)*pol_z(2, 3, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(75)*pol_z(1, 4, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(75)*pol_z(2, 4, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(76)*pol_z(1, 4, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(76)*pol_z(2, 4, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(77)*pol_z(1, 4, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(77)*pol_z(2, 4, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(78)*pol_z(1, 4, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(78)*pol_z(2, 4, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(79)*pol_z(1, 4, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(79)*pol_z(2, 4, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(80)*pol_z(1, 4, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(80)*pol_z(2, 4, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(81)*pol_z(1, 5, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(81)*pol_z(2, 5, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(82)*pol_z(1, 5, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(82)*pol_z(2, 5, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(83)*pol_z(1, 5, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(83)*pol_z(2, 5, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(84)*pol_z(1, 6, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(84)*pol_z(2, 6, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_x(1:2, lxp) = coef_x(1:2, lxp)+coef_xy(1:2, lxy)*pol_y(1, lyp, jg) - coef_x(3:4, lxp) = coef_x(3:4, lxp)+coef_xy(1:2, lxy)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_x(1:2, lxp) = coef_x(1:2, lxp) + coef_xy(1:2, lxy)*pol_y(1, lyp, jg) + coef_x(3:4, lxp) = coef_x(3:4, lxp) + coef_xy(1:2, lxy)*pol_y(2, lyp, jg) ENDDO ENDDO DO ig = igmin, igmax @@ -1097,38 +1097,38 @@ SUBROUTINE collocate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - s01 = s01+coef_x(1, 4)*pol_x(4, ig) - s02 = s02+coef_x(2, 4)*pol_x(4, ig) - s03 = s03+coef_x(3, 4)*pol_x(4, ig) - s04 = s04+coef_x(4, 4)*pol_x(4, ig) - s01 = s01+coef_x(1, 5)*pol_x(5, ig) - s02 = s02+coef_x(2, 5)*pol_x(5, ig) - s03 = s03+coef_x(3, 5)*pol_x(5, ig) - s04 = s04+coef_x(4, 5)*pol_x(5, ig) - s01 = s01+coef_x(1, 6)*pol_x(6, ig) - s02 = s02+coef_x(2, 6)*pol_x(6, ig) - s03 = s03+coef_x(3, 6)*pol_x(6, ig) - s04 = s04+coef_x(4, 6)*pol_x(6, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + s01 = s01 + coef_x(1, 4)*pol_x(4, ig) + s02 = s02 + coef_x(2, 4)*pol_x(4, ig) + s03 = s03 + coef_x(3, 4)*pol_x(4, ig) + s04 = s04 + coef_x(4, 4)*pol_x(4, ig) + s01 = s01 + coef_x(1, 5)*pol_x(5, ig) + s02 = s02 + coef_x(2, 5)*pol_x(5, ig) + s03 = s03 + coef_x(3, 5)*pol_x(5, ig) + s04 = s04 + coef_x(4, 5)*pol_x(5, ig) + s01 = s01 + coef_x(1, 6)*pol_x(6, ig) + s02 = s02 + coef_x(2, 6)*pol_x(6, ig) + s03 = s03 + coef_x(3, 6)*pol_x(6, ig) + s04 = s04 + coef_x(4, 6)*pol_x(6, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -1155,433 +1155,433 @@ SUBROUTINE collocate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 7 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s(4) sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(7)*pol_z(1, 0, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(7)*pol_z(2, 0, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(8)*pol_z(1, 0, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(8)*pol_z(2, 0, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(9)*pol_z(1, 0, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(9)*pol_z(2, 0, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(10)*pol_z(1, 0, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(10)*pol_z(2, 0, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(11)*pol_z(1, 0, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(11)*pol_z(2, 0, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(12)*pol_z(1, 0, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(12)*pol_z(2, 0, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(13)*pol_z(1, 0, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(13)*pol_z(2, 0, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(14)*pol_z(1, 0, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(14)*pol_z(2, 0, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(15)*pol_z(1, 0, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(15)*pol_z(2, 0, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(16)*pol_z(1, 0, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(16)*pol_z(2, 0, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(17)*pol_z(1, 0, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(17)*pol_z(2, 0, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(18)*pol_z(1, 0, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(18)*pol_z(2, 0, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(19)*pol_z(1, 0, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(19)*pol_z(2, 0, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(20)*pol_z(1, 0, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(20)*pol_z(2, 0, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(21)*pol_z(1, 0, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(21)*pol_z(2, 0, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(22)*pol_z(1, 0, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(22)*pol_z(2, 0, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(23)*pol_z(1, 0, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(23)*pol_z(2, 0, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(24)*pol_z(1, 0, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(24)*pol_z(2, 0, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(25)*pol_z(1, 0, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(25)*pol_z(2, 0, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(26)*pol_z(1, 0, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(26)*pol_z(2, 0, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(27)*pol_z(1, 0, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(27)*pol_z(2, 0, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(28)*pol_z(1, 0, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(28)*pol_z(2, 0, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(29)*pol_z(1, 0, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(29)*pol_z(2, 0, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(30)*pol_z(1, 0, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(30)*pol_z(2, 0, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(31)*pol_z(1, 0, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(31)*pol_z(2, 0, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(32)*pol_z(1, 0, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(32)*pol_z(2, 0, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(33)*pol_z(1, 0, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(33)*pol_z(2, 0, kg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_xyz(34)*pol_z(1, 0, kg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_xyz(34)*pol_z(2, 0, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(35)*pol_z(1, 0, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(35)*pol_z(2, 0, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(36)*pol_z(1, 0, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(36)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(37)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(37)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(38)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(38)*pol_z(2, 1, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(39)*pol_z(1, 1, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(39)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(40)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(40)*pol_z(2, 1, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(41)*pol_z(1, 1, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(41)*pol_z(2, 1, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(42)*pol_z(1, 1, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(42)*pol_z(2, 1, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(43)*pol_z(1, 1, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(43)*pol_z(2, 1, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(44)*pol_z(1, 1, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(44)*pol_z(2, 1, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(45)*pol_z(1, 1, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(45)*pol_z(2, 1, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(46)*pol_z(1, 1, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(46)*pol_z(2, 1, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(47)*pol_z(1, 1, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(47)*pol_z(2, 1, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(48)*pol_z(1, 1, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(48)*pol_z(2, 1, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(49)*pol_z(1, 1, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(49)*pol_z(2, 1, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(50)*pol_z(1, 1, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(50)*pol_z(2, 1, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(51)*pol_z(1, 1, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(51)*pol_z(2, 1, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(52)*pol_z(1, 1, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(52)*pol_z(2, 1, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(53)*pol_z(1, 1, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(53)*pol_z(2, 1, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(54)*pol_z(1, 1, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(54)*pol_z(2, 1, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(55)*pol_z(1, 1, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(55)*pol_z(2, 1, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(56)*pol_z(1, 1, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(56)*pol_z(2, 1, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(57)*pol_z(1, 1, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(57)*pol_z(2, 1, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(58)*pol_z(1, 1, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(58)*pol_z(2, 1, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(59)*pol_z(1, 1, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(59)*pol_z(2, 1, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(60)*pol_z(1, 1, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(60)*pol_z(2, 1, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(61)*pol_z(1, 1, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(61)*pol_z(2, 1, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(62)*pol_z(1, 1, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(62)*pol_z(2, 1, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(63)*pol_z(1, 1, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(63)*pol_z(2, 1, kg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_xyz(64)*pol_z(1, 1, kg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_xyz(64)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(65)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(65)*pol_z(2, 2, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(66)*pol_z(1, 2, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(66)*pol_z(2, 2, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(67)*pol_z(1, 2, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(67)*pol_z(2, 2, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(68)*pol_z(1, 2, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(68)*pol_z(2, 2, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(69)*pol_z(1, 2, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(69)*pol_z(2, 2, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(70)*pol_z(1, 2, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(70)*pol_z(2, 2, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(71)*pol_z(1, 2, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(71)*pol_z(2, 2, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(72)*pol_z(1, 2, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(72)*pol_z(2, 2, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(73)*pol_z(1, 2, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(73)*pol_z(2, 2, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(74)*pol_z(1, 2, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(74)*pol_z(2, 2, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(75)*pol_z(1, 2, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(75)*pol_z(2, 2, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(76)*pol_z(1, 2, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(76)*pol_z(2, 2, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(77)*pol_z(1, 2, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(77)*pol_z(2, 2, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(78)*pol_z(1, 2, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(78)*pol_z(2, 2, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(79)*pol_z(1, 2, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(79)*pol_z(2, 2, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(80)*pol_z(1, 2, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(80)*pol_z(2, 2, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(81)*pol_z(1, 2, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(81)*pol_z(2, 2, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(82)*pol_z(1, 2, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(82)*pol_z(2, 2, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(83)*pol_z(1, 2, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(83)*pol_z(2, 2, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(84)*pol_z(1, 2, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(84)*pol_z(2, 2, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(85)*pol_z(1, 2, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(85)*pol_z(2, 2, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(86)*pol_z(1, 3, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(86)*pol_z(2, 3, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(87)*pol_z(1, 3, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(87)*pol_z(2, 3, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(88)*pol_z(1, 3, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(88)*pol_z(2, 3, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(89)*pol_z(1, 3, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(89)*pol_z(2, 3, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(90)*pol_z(1, 3, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(90)*pol_z(2, 3, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(91)*pol_z(1, 3, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(91)*pol_z(2, 3, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(92)*pol_z(1, 3, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(92)*pol_z(2, 3, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(93)*pol_z(1, 3, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(93)*pol_z(2, 3, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(94)*pol_z(1, 3, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(94)*pol_z(2, 3, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(95)*pol_z(1, 3, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(95)*pol_z(2, 3, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(96)*pol_z(1, 3, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(96)*pol_z(2, 3, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(97)*pol_z(1, 3, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(97)*pol_z(2, 3, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(98)*pol_z(1, 3, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(98)*pol_z(2, 3, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(99)*pol_z(1, 3, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(99)*pol_z(2, 3, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(100)*pol_z(1, 3, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(100)*pol_z(2, 3, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(101)*pol_z(1, 4, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(101)*pol_z(2, 4, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(102)*pol_z(1, 4, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(102)*pol_z(2, 4, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(103)*pol_z(1, 4, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(103)*pol_z(2, 4, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(104)*pol_z(1, 4, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(104)*pol_z(2, 4, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(105)*pol_z(1, 4, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(105)*pol_z(2, 4, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(106)*pol_z(1, 4, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(106)*pol_z(2, 4, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(107)*pol_z(1, 4, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(107)*pol_z(2, 4, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(108)*pol_z(1, 4, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(108)*pol_z(2, 4, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(109)*pol_z(1, 4, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(109)*pol_z(2, 4, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(110)*pol_z(1, 4, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(110)*pol_z(2, 4, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(111)*pol_z(1, 5, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(111)*pol_z(2, 5, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(112)*pol_z(1, 5, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(112)*pol_z(2, 5, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(113)*pol_z(1, 5, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(113)*pol_z(2, 5, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(114)*pol_z(1, 5, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(114)*pol_z(2, 5, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(115)*pol_z(1, 5, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(115)*pol_z(2, 5, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(116)*pol_z(1, 5, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(116)*pol_z(2, 5, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(117)*pol_z(1, 6, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(117)*pol_z(2, 6, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(118)*pol_z(1, 6, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(118)*pol_z(2, 6, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(119)*pol_z(1, 6, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(119)*pol_z(2, 6, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(120)*pol_z(1, 7, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(120)*pol_z(2, 7, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(7)*pol_z(1, 0, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(7)*pol_z(2, 0, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(8)*pol_z(1, 0, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(8)*pol_z(2, 0, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(9)*pol_z(1, 0, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(9)*pol_z(2, 0, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(10)*pol_z(1, 0, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(10)*pol_z(2, 0, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(11)*pol_z(1, 0, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(11)*pol_z(2, 0, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(12)*pol_z(1, 0, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(12)*pol_z(2, 0, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(13)*pol_z(1, 0, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(13)*pol_z(2, 0, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(14)*pol_z(1, 0, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(14)*pol_z(2, 0, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(15)*pol_z(1, 0, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(15)*pol_z(2, 0, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(16)*pol_z(1, 0, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(16)*pol_z(2, 0, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(17)*pol_z(1, 0, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(17)*pol_z(2, 0, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(18)*pol_z(1, 0, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(18)*pol_z(2, 0, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(19)*pol_z(1, 0, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(19)*pol_z(2, 0, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(20)*pol_z(1, 0, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(20)*pol_z(2, 0, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(21)*pol_z(1, 0, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(21)*pol_z(2, 0, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(22)*pol_z(1, 0, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(22)*pol_z(2, 0, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(23)*pol_z(1, 0, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(23)*pol_z(2, 0, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(24)*pol_z(1, 0, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(24)*pol_z(2, 0, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(25)*pol_z(1, 0, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(25)*pol_z(2, 0, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(26)*pol_z(1, 0, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(26)*pol_z(2, 0, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(27)*pol_z(1, 0, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(27)*pol_z(2, 0, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(28)*pol_z(1, 0, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(28)*pol_z(2, 0, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(29)*pol_z(1, 0, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(29)*pol_z(2, 0, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(30)*pol_z(1, 0, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(30)*pol_z(2, 0, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(31)*pol_z(1, 0, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(31)*pol_z(2, 0, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(32)*pol_z(1, 0, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(32)*pol_z(2, 0, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(33)*pol_z(1, 0, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(33)*pol_z(2, 0, kg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_xyz(34)*pol_z(1, 0, kg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_xyz(34)*pol_z(2, 0, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(35)*pol_z(1, 0, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(35)*pol_z(2, 0, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(36)*pol_z(1, 0, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(36)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(37)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(37)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(38)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(38)*pol_z(2, 1, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(39)*pol_z(1, 1, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(39)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(40)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(40)*pol_z(2, 1, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(41)*pol_z(1, 1, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(41)*pol_z(2, 1, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(42)*pol_z(1, 1, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(42)*pol_z(2, 1, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(43)*pol_z(1, 1, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(43)*pol_z(2, 1, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(44)*pol_z(1, 1, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(44)*pol_z(2, 1, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(45)*pol_z(1, 1, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(45)*pol_z(2, 1, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(46)*pol_z(1, 1, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(46)*pol_z(2, 1, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(47)*pol_z(1, 1, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(47)*pol_z(2, 1, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(48)*pol_z(1, 1, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(48)*pol_z(2, 1, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(49)*pol_z(1, 1, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(49)*pol_z(2, 1, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(50)*pol_z(1, 1, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(50)*pol_z(2, 1, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(51)*pol_z(1, 1, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(51)*pol_z(2, 1, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(52)*pol_z(1, 1, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(52)*pol_z(2, 1, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(53)*pol_z(1, 1, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(53)*pol_z(2, 1, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(54)*pol_z(1, 1, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(54)*pol_z(2, 1, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(55)*pol_z(1, 1, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(55)*pol_z(2, 1, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(56)*pol_z(1, 1, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(56)*pol_z(2, 1, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(57)*pol_z(1, 1, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(57)*pol_z(2, 1, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(58)*pol_z(1, 1, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(58)*pol_z(2, 1, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(59)*pol_z(1, 1, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(59)*pol_z(2, 1, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(60)*pol_z(1, 1, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(60)*pol_z(2, 1, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(61)*pol_z(1, 1, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(61)*pol_z(2, 1, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(62)*pol_z(1, 1, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(62)*pol_z(2, 1, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(63)*pol_z(1, 1, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(63)*pol_z(2, 1, kg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_xyz(64)*pol_z(1, 1, kg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_xyz(64)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(65)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(65)*pol_z(2, 2, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(66)*pol_z(1, 2, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(66)*pol_z(2, 2, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(67)*pol_z(1, 2, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(67)*pol_z(2, 2, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(68)*pol_z(1, 2, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(68)*pol_z(2, 2, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(69)*pol_z(1, 2, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(69)*pol_z(2, 2, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(70)*pol_z(1, 2, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(70)*pol_z(2, 2, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(71)*pol_z(1, 2, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(71)*pol_z(2, 2, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(72)*pol_z(1, 2, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(72)*pol_z(2, 2, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(73)*pol_z(1, 2, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(73)*pol_z(2, 2, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(74)*pol_z(1, 2, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(74)*pol_z(2, 2, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(75)*pol_z(1, 2, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(75)*pol_z(2, 2, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(76)*pol_z(1, 2, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(76)*pol_z(2, 2, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(77)*pol_z(1, 2, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(77)*pol_z(2, 2, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(78)*pol_z(1, 2, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(78)*pol_z(2, 2, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(79)*pol_z(1, 2, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(79)*pol_z(2, 2, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(80)*pol_z(1, 2, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(80)*pol_z(2, 2, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(81)*pol_z(1, 2, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(81)*pol_z(2, 2, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(82)*pol_z(1, 2, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(82)*pol_z(2, 2, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(83)*pol_z(1, 2, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(83)*pol_z(2, 2, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(84)*pol_z(1, 2, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(84)*pol_z(2, 2, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(85)*pol_z(1, 2, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(85)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(86)*pol_z(1, 3, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(86)*pol_z(2, 3, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(87)*pol_z(1, 3, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(87)*pol_z(2, 3, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(88)*pol_z(1, 3, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(88)*pol_z(2, 3, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(89)*pol_z(1, 3, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(89)*pol_z(2, 3, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(90)*pol_z(1, 3, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(90)*pol_z(2, 3, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(91)*pol_z(1, 3, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(91)*pol_z(2, 3, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(92)*pol_z(1, 3, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(92)*pol_z(2, 3, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(93)*pol_z(1, 3, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(93)*pol_z(2, 3, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(94)*pol_z(1, 3, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(94)*pol_z(2, 3, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(95)*pol_z(1, 3, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(95)*pol_z(2, 3, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(96)*pol_z(1, 3, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(96)*pol_z(2, 3, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(97)*pol_z(1, 3, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(97)*pol_z(2, 3, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(98)*pol_z(1, 3, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(98)*pol_z(2, 3, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(99)*pol_z(1, 3, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(99)*pol_z(2, 3, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(100)*pol_z(1, 3, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(100)*pol_z(2, 3, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(101)*pol_z(1, 4, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(101)*pol_z(2, 4, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(102)*pol_z(1, 4, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(102)*pol_z(2, 4, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(103)*pol_z(1, 4, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(103)*pol_z(2, 4, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(104)*pol_z(1, 4, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(104)*pol_z(2, 4, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(105)*pol_z(1, 4, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(105)*pol_z(2, 4, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(106)*pol_z(1, 4, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(106)*pol_z(2, 4, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(107)*pol_z(1, 4, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(107)*pol_z(2, 4, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(108)*pol_z(1, 4, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(108)*pol_z(2, 4, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(109)*pol_z(1, 4, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(109)*pol_z(2, 4, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(110)*pol_z(1, 4, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(110)*pol_z(2, 4, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(111)*pol_z(1, 5, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(111)*pol_z(2, 5, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(112)*pol_z(1, 5, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(112)*pol_z(2, 5, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(113)*pol_z(1, 5, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(113)*pol_z(2, 5, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(114)*pol_z(1, 5, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(114)*pol_z(2, 5, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(115)*pol_z(1, 5, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(115)*pol_z(2, 5, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(116)*pol_z(1, 5, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(116)*pol_z(2, 5, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(117)*pol_z(1, 6, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(117)*pol_z(2, 6, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(118)*pol_z(1, 6, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(118)*pol_z(2, 6, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(119)*pol_z(1, 6, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(119)*pol_z(2, 6, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(120)*pol_z(1, 7, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(120)*pol_z(2, 7, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 4)*pol_y(1, 0, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 4)*pol_y(1, 0, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 4)*pol_y(2, 0, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 4)*pol_y(2, 0, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 5)*pol_y(1, 0, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 5)*pol_y(1, 0, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 5)*pol_y(2, 0, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 5)*pol_y(2, 0, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 6)*pol_y(1, 0, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 6)*pol_y(1, 0, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 6)*pol_y(2, 0, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 6)*pol_y(2, 0, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 7)*pol_y(1, 0, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 7)*pol_y(1, 0, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 7)*pol_y(2, 0, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 7)*pol_y(2, 0, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 8)*pol_y(1, 0, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 8)*pol_y(1, 0, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 8)*pol_y(2, 0, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 8)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 9)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 9)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 9)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 9)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 10)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 10)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 10)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 10)*pol_y(2, 1, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 11)*pol_y(1, 1, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 11)*pol_y(1, 1, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 11)*pol_y(2, 1, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 11)*pol_y(2, 1, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 12)*pol_y(1, 1, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 12)*pol_y(1, 1, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 12)*pol_y(2, 1, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 12)*pol_y(2, 1, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 13)*pol_y(1, 1, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 13)*pol_y(1, 1, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 13)*pol_y(2, 1, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 13)*pol_y(2, 1, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 14)*pol_y(1, 1, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 14)*pol_y(1, 1, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 14)*pol_y(2, 1, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 14)*pol_y(2, 1, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 15)*pol_y(1, 1, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 15)*pol_y(1, 1, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 15)*pol_y(2, 1, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 15)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 16)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 16)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 16)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 16)*pol_y(2, 2, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 17)*pol_y(1, 2, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 17)*pol_y(1, 2, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 17)*pol_y(2, 2, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 17)*pol_y(2, 2, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 18)*pol_y(1, 2, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 18)*pol_y(1, 2, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 18)*pol_y(2, 2, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 18)*pol_y(2, 2, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 19)*pol_y(1, 2, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 19)*pol_y(1, 2, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 19)*pol_y(2, 2, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 19)*pol_y(2, 2, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 20)*pol_y(1, 2, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 20)*pol_y(1, 2, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 20)*pol_y(2, 2, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 20)*pol_y(2, 2, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 21)*pol_y(1, 2, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 21)*pol_y(1, 2, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 21)*pol_y(2, 2, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 21)*pol_y(2, 2, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 22)*pol_y(1, 3, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 22)*pol_y(1, 3, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 22)*pol_y(2, 3, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 22)*pol_y(2, 3, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 23)*pol_y(1, 3, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 23)*pol_y(1, 3, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 23)*pol_y(2, 3, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 23)*pol_y(2, 3, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 24)*pol_y(1, 3, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 24)*pol_y(1, 3, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 24)*pol_y(2, 3, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 24)*pol_y(2, 3, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 25)*pol_y(1, 3, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 25)*pol_y(1, 3, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 25)*pol_y(2, 3, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 25)*pol_y(2, 3, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 26)*pol_y(1, 3, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 26)*pol_y(1, 3, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 26)*pol_y(2, 3, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 26)*pol_y(2, 3, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 27)*pol_y(1, 4, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 27)*pol_y(1, 4, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 27)*pol_y(2, 4, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 27)*pol_y(2, 4, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 28)*pol_y(1, 4, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 28)*pol_y(1, 4, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 28)*pol_y(2, 4, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 28)*pol_y(2, 4, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 29)*pol_y(1, 4, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 29)*pol_y(1, 4, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 29)*pol_y(2, 4, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 29)*pol_y(2, 4, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 30)*pol_y(1, 4, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 30)*pol_y(1, 4, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 30)*pol_y(2, 4, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 30)*pol_y(2, 4, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 31)*pol_y(1, 5, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 31)*pol_y(1, 5, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 31)*pol_y(2, 5, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 31)*pol_y(2, 5, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 32)*pol_y(1, 5, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 32)*pol_y(1, 5, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 32)*pol_y(2, 5, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 32)*pol_y(2, 5, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 33)*pol_y(1, 5, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 33)*pol_y(1, 5, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 33)*pol_y(2, 5, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 33)*pol_y(2, 5, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 34)*pol_y(1, 6, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 34)*pol_y(1, 6, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 34)*pol_y(2, 6, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 34)*pol_y(2, 6, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 35)*pol_y(1, 6, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 35)*pol_y(1, 6, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 35)*pol_y(2, 6, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 35)*pol_y(2, 6, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 36)*pol_y(1, 7, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 36)*pol_y(1, 7, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 36)*pol_y(2, 7, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 36)*pol_y(2, 7, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 4)*pol_y(1, 0, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 4)*pol_y(1, 0, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 4)*pol_y(2, 0, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 4)*pol_y(2, 0, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 5)*pol_y(1, 0, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 5)*pol_y(1, 0, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 5)*pol_y(2, 0, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 5)*pol_y(2, 0, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 6)*pol_y(1, 0, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 6)*pol_y(1, 0, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 6)*pol_y(2, 0, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 6)*pol_y(2, 0, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 7)*pol_y(1, 0, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 7)*pol_y(1, 0, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 7)*pol_y(2, 0, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 7)*pol_y(2, 0, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 8)*pol_y(1, 0, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 8)*pol_y(1, 0, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 8)*pol_y(2, 0, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 8)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 9)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 9)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 9)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 9)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 10)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 10)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 10)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 10)*pol_y(2, 1, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 11)*pol_y(1, 1, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 11)*pol_y(1, 1, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 11)*pol_y(2, 1, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 11)*pol_y(2, 1, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 12)*pol_y(1, 1, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 12)*pol_y(1, 1, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 12)*pol_y(2, 1, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 12)*pol_y(2, 1, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 13)*pol_y(1, 1, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 13)*pol_y(1, 1, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 13)*pol_y(2, 1, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 13)*pol_y(2, 1, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 14)*pol_y(1, 1, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 14)*pol_y(1, 1, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 14)*pol_y(2, 1, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 14)*pol_y(2, 1, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 15)*pol_y(1, 1, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 15)*pol_y(1, 1, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 15)*pol_y(2, 1, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 15)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 16)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 16)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 16)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 16)*pol_y(2, 2, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 17)*pol_y(1, 2, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 17)*pol_y(1, 2, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 17)*pol_y(2, 2, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 17)*pol_y(2, 2, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 18)*pol_y(1, 2, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 18)*pol_y(1, 2, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 18)*pol_y(2, 2, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 18)*pol_y(2, 2, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 19)*pol_y(1, 2, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 19)*pol_y(1, 2, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 19)*pol_y(2, 2, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 19)*pol_y(2, 2, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 20)*pol_y(1, 2, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 20)*pol_y(1, 2, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 20)*pol_y(2, 2, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 20)*pol_y(2, 2, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 21)*pol_y(1, 2, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 21)*pol_y(1, 2, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 21)*pol_y(2, 2, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 21)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 22)*pol_y(1, 3, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 22)*pol_y(1, 3, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 22)*pol_y(2, 3, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 22)*pol_y(2, 3, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 23)*pol_y(1, 3, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 23)*pol_y(1, 3, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 23)*pol_y(2, 3, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 23)*pol_y(2, 3, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 24)*pol_y(1, 3, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 24)*pol_y(1, 3, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 24)*pol_y(2, 3, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 24)*pol_y(2, 3, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 25)*pol_y(1, 3, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 25)*pol_y(1, 3, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 25)*pol_y(2, 3, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 25)*pol_y(2, 3, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 26)*pol_y(1, 3, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 26)*pol_y(1, 3, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 26)*pol_y(2, 3, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 26)*pol_y(2, 3, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 27)*pol_y(1, 4, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 27)*pol_y(1, 4, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 27)*pol_y(2, 4, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 27)*pol_y(2, 4, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 28)*pol_y(1, 4, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 28)*pol_y(1, 4, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 28)*pol_y(2, 4, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 28)*pol_y(2, 4, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 29)*pol_y(1, 4, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 29)*pol_y(1, 4, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 29)*pol_y(2, 4, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 29)*pol_y(2, 4, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 30)*pol_y(1, 4, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 30)*pol_y(1, 4, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 30)*pol_y(2, 4, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 30)*pol_y(2, 4, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 31)*pol_y(1, 5, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 31)*pol_y(1, 5, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 31)*pol_y(2, 5, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 31)*pol_y(2, 5, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 32)*pol_y(1, 5, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 32)*pol_y(1, 5, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 32)*pol_y(2, 5, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 32)*pol_y(2, 5, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 33)*pol_y(1, 5, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 33)*pol_y(1, 5, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 33)*pol_y(2, 5, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 33)*pol_y(2, 5, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 34)*pol_y(1, 6, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 34)*pol_y(1, 6, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 34)*pol_y(2, 6, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 34)*pol_y(2, 6, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 35)*pol_y(1, 6, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 35)*pol_y(1, 6, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 35)*pol_y(2, 6, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 35)*pol_y(2, 6, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 36)*pol_y(1, 7, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 36)*pol_y(1, 7, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 36)*pol_y(2, 7, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 36)*pol_y(2, 7, jg) DO ig = igmin, igmax i = map(ig, 1) s(:) = 0.0_dp - s(:) = s(:)+coef_x(:, 0)*pol_x(0, ig) - s(:) = s(:)+coef_x(:, 1)*pol_x(1, ig) - s(:) = s(:)+coef_x(:, 2)*pol_x(2, ig) - s(:) = s(:)+coef_x(:, 3)*pol_x(3, ig) - s(:) = s(:)+coef_x(:, 4)*pol_x(4, ig) - s(:) = s(:)+coef_x(:, 5)*pol_x(5, ig) - s(:) = s(:)+coef_x(:, 6)*pol_x(6, ig) - s(:) = s(:)+coef_x(:, 7)*pol_x(7, ig) - grid(i, j, k) = grid(i, j, k)+s(1) - grid(i, j2, k) = grid(i, j2, k)+s(3) - grid(i, j, k2) = grid(i, j, k2)+s(2) - grid(i, j2, k2) = grid(i, j2, k2)+s(4) + s(:) = s(:) + coef_x(:, 0)*pol_x(0, ig) + s(:) = s(:) + coef_x(:, 1)*pol_x(1, ig) + s(:) = s(:) + coef_x(:, 2)*pol_x(2, ig) + s(:) = s(:) + coef_x(:, 3)*pol_x(3, ig) + s(:) = s(:) + coef_x(:, 4)*pol_x(4, ig) + s(:) = s(:) + coef_x(:, 5)*pol_x(5, ig) + s(:) = s(:) + coef_x(:, 6)*pol_x(6, ig) + s(:) = s(:) + coef_x(:, 7)*pol_x(7, ig) + grid(i, j, k) = grid(i, j, k) + s(1) + grid(i, j2, k) = grid(i, j2, k) + s(3) + grid(i, j, k2) = grid(i, j, k2) + s(2) + grid(i, j2, k2) = grid(i, j2, k2) + s(4) END DO END DO END DO @@ -1608,560 +1608,560 @@ SUBROUTINE collocate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 8 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s(4) sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(7)*pol_z(1, 0, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(7)*pol_z(2, 0, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(8)*pol_z(1, 0, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(8)*pol_z(2, 0, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(9)*pol_z(1, 0, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(9)*pol_z(2, 0, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(10)*pol_z(1, 0, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(10)*pol_z(2, 0, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(11)*pol_z(1, 0, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(11)*pol_z(2, 0, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(12)*pol_z(1, 0, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(12)*pol_z(2, 0, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(13)*pol_z(1, 0, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(13)*pol_z(2, 0, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(14)*pol_z(1, 0, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(14)*pol_z(2, 0, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(15)*pol_z(1, 0, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(15)*pol_z(2, 0, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(16)*pol_z(1, 0, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(16)*pol_z(2, 0, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(17)*pol_z(1, 0, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(17)*pol_z(2, 0, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(18)*pol_z(1, 0, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(18)*pol_z(2, 0, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(19)*pol_z(1, 0, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(19)*pol_z(2, 0, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(20)*pol_z(1, 0, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(20)*pol_z(2, 0, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(21)*pol_z(1, 0, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(21)*pol_z(2, 0, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(22)*pol_z(1, 0, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(22)*pol_z(2, 0, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(23)*pol_z(1, 0, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(23)*pol_z(2, 0, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(24)*pol_z(1, 0, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(24)*pol_z(2, 0, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(25)*pol_z(1, 0, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(25)*pol_z(2, 0, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(26)*pol_z(1, 0, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(26)*pol_z(2, 0, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(27)*pol_z(1, 0, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(27)*pol_z(2, 0, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(28)*pol_z(1, 0, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(28)*pol_z(2, 0, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(29)*pol_z(1, 0, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(29)*pol_z(2, 0, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(30)*pol_z(1, 0, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(30)*pol_z(2, 0, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(31)*pol_z(1, 0, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(31)*pol_z(2, 0, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(32)*pol_z(1, 0, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(32)*pol_z(2, 0, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(33)*pol_z(1, 0, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(33)*pol_z(2, 0, kg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_xyz(34)*pol_z(1, 0, kg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_xyz(34)*pol_z(2, 0, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(35)*pol_z(1, 0, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(35)*pol_z(2, 0, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(36)*pol_z(1, 0, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(36)*pol_z(2, 0, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(37)*pol_z(1, 0, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(37)*pol_z(2, 0, kg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_xyz(38)*pol_z(1, 0, kg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_xyz(38)*pol_z(2, 0, kg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_xyz(39)*pol_z(1, 0, kg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_xyz(39)*pol_z(2, 0, kg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_xyz(40)*pol_z(1, 0, kg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_xyz(40)*pol_z(2, 0, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(41)*pol_z(1, 0, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(41)*pol_z(2, 0, kg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_xyz(42)*pol_z(1, 0, kg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_xyz(42)*pol_z(2, 0, kg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_xyz(43)*pol_z(1, 0, kg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_xyz(43)*pol_z(2, 0, kg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_xyz(44)*pol_z(1, 0, kg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_xyz(44)*pol_z(2, 0, kg) - coef_xy(1, 45) = coef_xy(1, 45)+coef_xyz(45)*pol_z(1, 0, kg) - coef_xy(2, 45) = coef_xy(2, 45)+coef_xyz(45)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(46)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(46)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(47)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(47)*pol_z(2, 1, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(48)*pol_z(1, 1, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(48)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(49)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(49)*pol_z(2, 1, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(50)*pol_z(1, 1, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(50)*pol_z(2, 1, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(51)*pol_z(1, 1, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(51)*pol_z(2, 1, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(52)*pol_z(1, 1, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(52)*pol_z(2, 1, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(53)*pol_z(1, 1, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(53)*pol_z(2, 1, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(54)*pol_z(1, 1, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(54)*pol_z(2, 1, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(55)*pol_z(1, 1, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(55)*pol_z(2, 1, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(56)*pol_z(1, 1, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(56)*pol_z(2, 1, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(57)*pol_z(1, 1, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(57)*pol_z(2, 1, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(58)*pol_z(1, 1, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(58)*pol_z(2, 1, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(59)*pol_z(1, 1, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(59)*pol_z(2, 1, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(60)*pol_z(1, 1, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(60)*pol_z(2, 1, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(61)*pol_z(1, 1, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(61)*pol_z(2, 1, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(62)*pol_z(1, 1, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(62)*pol_z(2, 1, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(63)*pol_z(1, 1, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(63)*pol_z(2, 1, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(64)*pol_z(1, 1, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(64)*pol_z(2, 1, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(65)*pol_z(1, 1, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(65)*pol_z(2, 1, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(66)*pol_z(1, 1, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(66)*pol_z(2, 1, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(67)*pol_z(1, 1, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(67)*pol_z(2, 1, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(68)*pol_z(1, 1, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(68)*pol_z(2, 1, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(69)*pol_z(1, 1, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(69)*pol_z(2, 1, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(70)*pol_z(1, 1, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(70)*pol_z(2, 1, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(71)*pol_z(1, 1, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(71)*pol_z(2, 1, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(72)*pol_z(1, 1, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(72)*pol_z(2, 1, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(73)*pol_z(1, 1, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(73)*pol_z(2, 1, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(74)*pol_z(1, 1, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(74)*pol_z(2, 1, kg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_xyz(75)*pol_z(1, 1, kg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_xyz(75)*pol_z(2, 1, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(76)*pol_z(1, 1, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(76)*pol_z(2, 1, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(77)*pol_z(1, 1, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(77)*pol_z(2, 1, kg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_xyz(78)*pol_z(1, 1, kg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_xyz(78)*pol_z(2, 1, kg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_xyz(79)*pol_z(1, 1, kg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_xyz(79)*pol_z(2, 1, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(80)*pol_z(1, 1, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(80)*pol_z(2, 1, kg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_xyz(81)*pol_z(1, 1, kg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_xyz(81)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(82)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(82)*pol_z(2, 2, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(83)*pol_z(1, 2, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(83)*pol_z(2, 2, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(84)*pol_z(1, 2, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(84)*pol_z(2, 2, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(85)*pol_z(1, 2, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(85)*pol_z(2, 2, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(86)*pol_z(1, 2, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(86)*pol_z(2, 2, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(87)*pol_z(1, 2, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(87)*pol_z(2, 2, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(88)*pol_z(1, 2, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(88)*pol_z(2, 2, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(89)*pol_z(1, 2, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(89)*pol_z(2, 2, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(90)*pol_z(1, 2, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(90)*pol_z(2, 2, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(91)*pol_z(1, 2, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(91)*pol_z(2, 2, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(92)*pol_z(1, 2, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(92)*pol_z(2, 2, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(93)*pol_z(1, 2, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(93)*pol_z(2, 2, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(94)*pol_z(1, 2, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(94)*pol_z(2, 2, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(95)*pol_z(1, 2, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(95)*pol_z(2, 2, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(96)*pol_z(1, 2, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(96)*pol_z(2, 2, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(97)*pol_z(1, 2, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(97)*pol_z(2, 2, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(98)*pol_z(1, 2, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(98)*pol_z(2, 2, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(99)*pol_z(1, 2, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(99)*pol_z(2, 2, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(100)*pol_z(1, 2, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(100)*pol_z(2, 2, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(101)*pol_z(1, 2, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(101)*pol_z(2, 2, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(102)*pol_z(1, 2, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(102)*pol_z(2, 2, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(103)*pol_z(1, 2, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(103)*pol_z(2, 2, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(104)*pol_z(1, 2, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(104)*pol_z(2, 2, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(105)*pol_z(1, 2, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(105)*pol_z(2, 2, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(106)*pol_z(1, 2, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(106)*pol_z(2, 2, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(107)*pol_z(1, 2, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(107)*pol_z(2, 2, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(108)*pol_z(1, 2, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(108)*pol_z(2, 2, kg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_xyz(109)*pol_z(1, 2, kg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_xyz(109)*pol_z(2, 2, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(110)*pol_z(1, 3, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(110)*pol_z(2, 3, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(111)*pol_z(1, 3, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(111)*pol_z(2, 3, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(112)*pol_z(1, 3, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(112)*pol_z(2, 3, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(113)*pol_z(1, 3, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(113)*pol_z(2, 3, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(114)*pol_z(1, 3, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(114)*pol_z(2, 3, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(115)*pol_z(1, 3, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(115)*pol_z(2, 3, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(116)*pol_z(1, 3, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(116)*pol_z(2, 3, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(117)*pol_z(1, 3, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(117)*pol_z(2, 3, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(118)*pol_z(1, 3, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(118)*pol_z(2, 3, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(119)*pol_z(1, 3, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(119)*pol_z(2, 3, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(120)*pol_z(1, 3, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(120)*pol_z(2, 3, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(121)*pol_z(1, 3, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(121)*pol_z(2, 3, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(122)*pol_z(1, 3, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(122)*pol_z(2, 3, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(123)*pol_z(1, 3, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(123)*pol_z(2, 3, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(124)*pol_z(1, 3, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(124)*pol_z(2, 3, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(125)*pol_z(1, 3, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(125)*pol_z(2, 3, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(126)*pol_z(1, 3, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(126)*pol_z(2, 3, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(127)*pol_z(1, 3, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(127)*pol_z(2, 3, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(128)*pol_z(1, 3, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(128)*pol_z(2, 3, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(129)*pol_z(1, 3, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(129)*pol_z(2, 3, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(130)*pol_z(1, 3, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(130)*pol_z(2, 3, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(131)*pol_z(1, 4, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(131)*pol_z(2, 4, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(132)*pol_z(1, 4, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(132)*pol_z(2, 4, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(133)*pol_z(1, 4, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(133)*pol_z(2, 4, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(134)*pol_z(1, 4, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(134)*pol_z(2, 4, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(135)*pol_z(1, 4, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(135)*pol_z(2, 4, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(136)*pol_z(1, 4, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(136)*pol_z(2, 4, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(137)*pol_z(1, 4, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(137)*pol_z(2, 4, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(138)*pol_z(1, 4, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(138)*pol_z(2, 4, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(139)*pol_z(1, 4, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(139)*pol_z(2, 4, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(140)*pol_z(1, 4, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(140)*pol_z(2, 4, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(141)*pol_z(1, 4, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(141)*pol_z(2, 4, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(142)*pol_z(1, 4, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(142)*pol_z(2, 4, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(143)*pol_z(1, 4, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(143)*pol_z(2, 4, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(144)*pol_z(1, 4, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(144)*pol_z(2, 4, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(145)*pol_z(1, 4, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(145)*pol_z(2, 4, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(146)*pol_z(1, 5, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(146)*pol_z(2, 5, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(147)*pol_z(1, 5, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(147)*pol_z(2, 5, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(148)*pol_z(1, 5, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(148)*pol_z(2, 5, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(149)*pol_z(1, 5, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(149)*pol_z(2, 5, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(150)*pol_z(1, 5, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(150)*pol_z(2, 5, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(151)*pol_z(1, 5, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(151)*pol_z(2, 5, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(152)*pol_z(1, 5, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(152)*pol_z(2, 5, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(153)*pol_z(1, 5, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(153)*pol_z(2, 5, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(154)*pol_z(1, 5, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(154)*pol_z(2, 5, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(155)*pol_z(1, 5, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(155)*pol_z(2, 5, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(156)*pol_z(1, 6, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(156)*pol_z(2, 6, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(157)*pol_z(1, 6, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(157)*pol_z(2, 6, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(158)*pol_z(1, 6, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(158)*pol_z(2, 6, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(159)*pol_z(1, 6, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(159)*pol_z(2, 6, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(160)*pol_z(1, 6, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(160)*pol_z(2, 6, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(161)*pol_z(1, 6, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(161)*pol_z(2, 6, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(162)*pol_z(1, 7, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(162)*pol_z(2, 7, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(163)*pol_z(1, 7, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(163)*pol_z(2, 7, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(164)*pol_z(1, 7, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(164)*pol_z(2, 7, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(165)*pol_z(1, 8, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(165)*pol_z(2, 8, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(7)*pol_z(1, 0, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(7)*pol_z(2, 0, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(8)*pol_z(1, 0, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(8)*pol_z(2, 0, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(9)*pol_z(1, 0, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(9)*pol_z(2, 0, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(10)*pol_z(1, 0, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(10)*pol_z(2, 0, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(11)*pol_z(1, 0, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(11)*pol_z(2, 0, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(12)*pol_z(1, 0, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(12)*pol_z(2, 0, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(13)*pol_z(1, 0, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(13)*pol_z(2, 0, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(14)*pol_z(1, 0, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(14)*pol_z(2, 0, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(15)*pol_z(1, 0, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(15)*pol_z(2, 0, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(16)*pol_z(1, 0, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(16)*pol_z(2, 0, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(17)*pol_z(1, 0, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(17)*pol_z(2, 0, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(18)*pol_z(1, 0, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(18)*pol_z(2, 0, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(19)*pol_z(1, 0, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(19)*pol_z(2, 0, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(20)*pol_z(1, 0, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(20)*pol_z(2, 0, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(21)*pol_z(1, 0, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(21)*pol_z(2, 0, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(22)*pol_z(1, 0, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(22)*pol_z(2, 0, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(23)*pol_z(1, 0, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(23)*pol_z(2, 0, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(24)*pol_z(1, 0, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(24)*pol_z(2, 0, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(25)*pol_z(1, 0, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(25)*pol_z(2, 0, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(26)*pol_z(1, 0, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(26)*pol_z(2, 0, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(27)*pol_z(1, 0, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(27)*pol_z(2, 0, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(28)*pol_z(1, 0, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(28)*pol_z(2, 0, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(29)*pol_z(1, 0, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(29)*pol_z(2, 0, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(30)*pol_z(1, 0, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(30)*pol_z(2, 0, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(31)*pol_z(1, 0, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(31)*pol_z(2, 0, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(32)*pol_z(1, 0, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(32)*pol_z(2, 0, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(33)*pol_z(1, 0, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(33)*pol_z(2, 0, kg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_xyz(34)*pol_z(1, 0, kg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_xyz(34)*pol_z(2, 0, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(35)*pol_z(1, 0, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(35)*pol_z(2, 0, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(36)*pol_z(1, 0, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(36)*pol_z(2, 0, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(37)*pol_z(1, 0, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(37)*pol_z(2, 0, kg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_xyz(38)*pol_z(1, 0, kg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_xyz(38)*pol_z(2, 0, kg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_xyz(39)*pol_z(1, 0, kg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_xyz(39)*pol_z(2, 0, kg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_xyz(40)*pol_z(1, 0, kg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_xyz(40)*pol_z(2, 0, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(41)*pol_z(1, 0, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(41)*pol_z(2, 0, kg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_xyz(42)*pol_z(1, 0, kg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_xyz(42)*pol_z(2, 0, kg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_xyz(43)*pol_z(1, 0, kg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_xyz(43)*pol_z(2, 0, kg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_xyz(44)*pol_z(1, 0, kg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_xyz(44)*pol_z(2, 0, kg) + coef_xy(1, 45) = coef_xy(1, 45) + coef_xyz(45)*pol_z(1, 0, kg) + coef_xy(2, 45) = coef_xy(2, 45) + coef_xyz(45)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(46)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(46)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(47)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(47)*pol_z(2, 1, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(48)*pol_z(1, 1, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(48)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(49)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(49)*pol_z(2, 1, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(50)*pol_z(1, 1, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(50)*pol_z(2, 1, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(51)*pol_z(1, 1, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(51)*pol_z(2, 1, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(52)*pol_z(1, 1, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(52)*pol_z(2, 1, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(53)*pol_z(1, 1, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(53)*pol_z(2, 1, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(54)*pol_z(1, 1, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(54)*pol_z(2, 1, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(55)*pol_z(1, 1, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(55)*pol_z(2, 1, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(56)*pol_z(1, 1, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(56)*pol_z(2, 1, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(57)*pol_z(1, 1, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(57)*pol_z(2, 1, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(58)*pol_z(1, 1, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(58)*pol_z(2, 1, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(59)*pol_z(1, 1, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(59)*pol_z(2, 1, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(60)*pol_z(1, 1, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(60)*pol_z(2, 1, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(61)*pol_z(1, 1, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(61)*pol_z(2, 1, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(62)*pol_z(1, 1, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(62)*pol_z(2, 1, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(63)*pol_z(1, 1, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(63)*pol_z(2, 1, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(64)*pol_z(1, 1, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(64)*pol_z(2, 1, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(65)*pol_z(1, 1, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(65)*pol_z(2, 1, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(66)*pol_z(1, 1, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(66)*pol_z(2, 1, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(67)*pol_z(1, 1, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(67)*pol_z(2, 1, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(68)*pol_z(1, 1, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(68)*pol_z(2, 1, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(69)*pol_z(1, 1, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(69)*pol_z(2, 1, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(70)*pol_z(1, 1, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(70)*pol_z(2, 1, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(71)*pol_z(1, 1, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(71)*pol_z(2, 1, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(72)*pol_z(1, 1, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(72)*pol_z(2, 1, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(73)*pol_z(1, 1, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(73)*pol_z(2, 1, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(74)*pol_z(1, 1, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(74)*pol_z(2, 1, kg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_xyz(75)*pol_z(1, 1, kg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_xyz(75)*pol_z(2, 1, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(76)*pol_z(1, 1, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(76)*pol_z(2, 1, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(77)*pol_z(1, 1, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(77)*pol_z(2, 1, kg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_xyz(78)*pol_z(1, 1, kg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_xyz(78)*pol_z(2, 1, kg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_xyz(79)*pol_z(1, 1, kg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_xyz(79)*pol_z(2, 1, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(80)*pol_z(1, 1, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(80)*pol_z(2, 1, kg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_xyz(81)*pol_z(1, 1, kg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_xyz(81)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(82)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(82)*pol_z(2, 2, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(83)*pol_z(1, 2, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(83)*pol_z(2, 2, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(84)*pol_z(1, 2, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(84)*pol_z(2, 2, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(85)*pol_z(1, 2, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(85)*pol_z(2, 2, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(86)*pol_z(1, 2, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(86)*pol_z(2, 2, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(87)*pol_z(1, 2, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(87)*pol_z(2, 2, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(88)*pol_z(1, 2, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(88)*pol_z(2, 2, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(89)*pol_z(1, 2, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(89)*pol_z(2, 2, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(90)*pol_z(1, 2, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(90)*pol_z(2, 2, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(91)*pol_z(1, 2, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(91)*pol_z(2, 2, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(92)*pol_z(1, 2, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(92)*pol_z(2, 2, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(93)*pol_z(1, 2, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(93)*pol_z(2, 2, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(94)*pol_z(1, 2, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(94)*pol_z(2, 2, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(95)*pol_z(1, 2, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(95)*pol_z(2, 2, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(96)*pol_z(1, 2, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(96)*pol_z(2, 2, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(97)*pol_z(1, 2, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(97)*pol_z(2, 2, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(98)*pol_z(1, 2, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(98)*pol_z(2, 2, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(99)*pol_z(1, 2, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(99)*pol_z(2, 2, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(100)*pol_z(1, 2, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(100)*pol_z(2, 2, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(101)*pol_z(1, 2, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(101)*pol_z(2, 2, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(102)*pol_z(1, 2, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(102)*pol_z(2, 2, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(103)*pol_z(1, 2, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(103)*pol_z(2, 2, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(104)*pol_z(1, 2, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(104)*pol_z(2, 2, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(105)*pol_z(1, 2, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(105)*pol_z(2, 2, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(106)*pol_z(1, 2, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(106)*pol_z(2, 2, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(107)*pol_z(1, 2, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(107)*pol_z(2, 2, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(108)*pol_z(1, 2, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(108)*pol_z(2, 2, kg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_xyz(109)*pol_z(1, 2, kg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_xyz(109)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(110)*pol_z(1, 3, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(110)*pol_z(2, 3, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(111)*pol_z(1, 3, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(111)*pol_z(2, 3, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(112)*pol_z(1, 3, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(112)*pol_z(2, 3, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(113)*pol_z(1, 3, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(113)*pol_z(2, 3, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(114)*pol_z(1, 3, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(114)*pol_z(2, 3, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(115)*pol_z(1, 3, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(115)*pol_z(2, 3, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(116)*pol_z(1, 3, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(116)*pol_z(2, 3, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(117)*pol_z(1, 3, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(117)*pol_z(2, 3, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(118)*pol_z(1, 3, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(118)*pol_z(2, 3, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(119)*pol_z(1, 3, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(119)*pol_z(2, 3, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(120)*pol_z(1, 3, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(120)*pol_z(2, 3, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(121)*pol_z(1, 3, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(121)*pol_z(2, 3, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(122)*pol_z(1, 3, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(122)*pol_z(2, 3, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(123)*pol_z(1, 3, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(123)*pol_z(2, 3, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(124)*pol_z(1, 3, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(124)*pol_z(2, 3, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(125)*pol_z(1, 3, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(125)*pol_z(2, 3, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(126)*pol_z(1, 3, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(126)*pol_z(2, 3, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(127)*pol_z(1, 3, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(127)*pol_z(2, 3, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(128)*pol_z(1, 3, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(128)*pol_z(2, 3, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(129)*pol_z(1, 3, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(129)*pol_z(2, 3, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(130)*pol_z(1, 3, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(130)*pol_z(2, 3, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(131)*pol_z(1, 4, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(131)*pol_z(2, 4, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(132)*pol_z(1, 4, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(132)*pol_z(2, 4, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(133)*pol_z(1, 4, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(133)*pol_z(2, 4, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(134)*pol_z(1, 4, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(134)*pol_z(2, 4, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(135)*pol_z(1, 4, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(135)*pol_z(2, 4, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(136)*pol_z(1, 4, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(136)*pol_z(2, 4, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(137)*pol_z(1, 4, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(137)*pol_z(2, 4, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(138)*pol_z(1, 4, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(138)*pol_z(2, 4, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(139)*pol_z(1, 4, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(139)*pol_z(2, 4, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(140)*pol_z(1, 4, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(140)*pol_z(2, 4, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(141)*pol_z(1, 4, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(141)*pol_z(2, 4, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(142)*pol_z(1, 4, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(142)*pol_z(2, 4, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(143)*pol_z(1, 4, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(143)*pol_z(2, 4, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(144)*pol_z(1, 4, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(144)*pol_z(2, 4, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(145)*pol_z(1, 4, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(145)*pol_z(2, 4, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(146)*pol_z(1, 5, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(146)*pol_z(2, 5, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(147)*pol_z(1, 5, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(147)*pol_z(2, 5, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(148)*pol_z(1, 5, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(148)*pol_z(2, 5, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(149)*pol_z(1, 5, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(149)*pol_z(2, 5, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(150)*pol_z(1, 5, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(150)*pol_z(2, 5, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(151)*pol_z(1, 5, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(151)*pol_z(2, 5, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(152)*pol_z(1, 5, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(152)*pol_z(2, 5, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(153)*pol_z(1, 5, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(153)*pol_z(2, 5, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(154)*pol_z(1, 5, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(154)*pol_z(2, 5, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(155)*pol_z(1, 5, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(155)*pol_z(2, 5, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(156)*pol_z(1, 6, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(156)*pol_z(2, 6, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(157)*pol_z(1, 6, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(157)*pol_z(2, 6, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(158)*pol_z(1, 6, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(158)*pol_z(2, 6, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(159)*pol_z(1, 6, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(159)*pol_z(2, 6, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(160)*pol_z(1, 6, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(160)*pol_z(2, 6, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(161)*pol_z(1, 6, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(161)*pol_z(2, 6, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(162)*pol_z(1, 7, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(162)*pol_z(2, 7, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(163)*pol_z(1, 7, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(163)*pol_z(2, 7, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(164)*pol_z(1, 7, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(164)*pol_z(2, 7, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(165)*pol_z(1, 8, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(165)*pol_z(2, 8, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 4)*pol_y(1, 0, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 4)*pol_y(1, 0, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 4)*pol_y(2, 0, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 4)*pol_y(2, 0, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 5)*pol_y(1, 0, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 5)*pol_y(1, 0, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 5)*pol_y(2, 0, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 5)*pol_y(2, 0, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 6)*pol_y(1, 0, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 6)*pol_y(1, 0, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 6)*pol_y(2, 0, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 6)*pol_y(2, 0, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 7)*pol_y(1, 0, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 7)*pol_y(1, 0, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 7)*pol_y(2, 0, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 7)*pol_y(2, 0, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 8)*pol_y(1, 0, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 8)*pol_y(1, 0, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 8)*pol_y(2, 0, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 8)*pol_y(2, 0, jg) - coef_x(1, 8) = coef_x(1, 8)+coef_xy(1, 9)*pol_y(1, 0, jg) - coef_x(2, 8) = coef_x(2, 8)+coef_xy(2, 9)*pol_y(1, 0, jg) - coef_x(3, 8) = coef_x(3, 8)+coef_xy(1, 9)*pol_y(2, 0, jg) - coef_x(4, 8) = coef_x(4, 8)+coef_xy(2, 9)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 10)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 10)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 10)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 10)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 11)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 11)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 11)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 11)*pol_y(2, 1, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 12)*pol_y(1, 1, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 12)*pol_y(1, 1, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 12)*pol_y(2, 1, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 12)*pol_y(2, 1, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 13)*pol_y(1, 1, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 13)*pol_y(1, 1, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 13)*pol_y(2, 1, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 13)*pol_y(2, 1, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 14)*pol_y(1, 1, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 14)*pol_y(1, 1, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 14)*pol_y(2, 1, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 14)*pol_y(2, 1, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 15)*pol_y(1, 1, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 15)*pol_y(1, 1, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 15)*pol_y(2, 1, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 15)*pol_y(2, 1, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 16)*pol_y(1, 1, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 16)*pol_y(1, 1, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 16)*pol_y(2, 1, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 16)*pol_y(2, 1, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 17)*pol_y(1, 1, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 17)*pol_y(1, 1, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 17)*pol_y(2, 1, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 17)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 18)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 18)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 18)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 18)*pol_y(2, 2, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 19)*pol_y(1, 2, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 19)*pol_y(1, 2, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 19)*pol_y(2, 2, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 19)*pol_y(2, 2, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 20)*pol_y(1, 2, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 20)*pol_y(1, 2, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 20)*pol_y(2, 2, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 20)*pol_y(2, 2, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 21)*pol_y(1, 2, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 21)*pol_y(1, 2, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 21)*pol_y(2, 2, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 21)*pol_y(2, 2, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 22)*pol_y(1, 2, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 22)*pol_y(1, 2, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 22)*pol_y(2, 2, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 22)*pol_y(2, 2, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 23)*pol_y(1, 2, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 23)*pol_y(1, 2, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 23)*pol_y(2, 2, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 23)*pol_y(2, 2, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 24)*pol_y(1, 2, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 24)*pol_y(1, 2, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 24)*pol_y(2, 2, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 24)*pol_y(2, 2, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 25)*pol_y(1, 3, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 25)*pol_y(1, 3, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 25)*pol_y(2, 3, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 25)*pol_y(2, 3, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 26)*pol_y(1, 3, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 26)*pol_y(1, 3, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 26)*pol_y(2, 3, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 26)*pol_y(2, 3, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 27)*pol_y(1, 3, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 27)*pol_y(1, 3, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 27)*pol_y(2, 3, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 27)*pol_y(2, 3, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 28)*pol_y(1, 3, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 28)*pol_y(1, 3, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 28)*pol_y(2, 3, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 28)*pol_y(2, 3, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 29)*pol_y(1, 3, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 29)*pol_y(1, 3, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 29)*pol_y(2, 3, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 29)*pol_y(2, 3, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 30)*pol_y(1, 3, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 30)*pol_y(1, 3, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 30)*pol_y(2, 3, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 30)*pol_y(2, 3, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 31)*pol_y(1, 4, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 31)*pol_y(1, 4, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 31)*pol_y(2, 4, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 31)*pol_y(2, 4, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 32)*pol_y(1, 4, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 32)*pol_y(1, 4, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 32)*pol_y(2, 4, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 32)*pol_y(2, 4, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 33)*pol_y(1, 4, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 33)*pol_y(1, 4, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 33)*pol_y(2, 4, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 33)*pol_y(2, 4, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 34)*pol_y(1, 4, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 34)*pol_y(1, 4, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 34)*pol_y(2, 4, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 34)*pol_y(2, 4, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 35)*pol_y(1, 4, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 35)*pol_y(1, 4, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 35)*pol_y(2, 4, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 35)*pol_y(2, 4, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 36)*pol_y(1, 5, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 36)*pol_y(1, 5, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 36)*pol_y(2, 5, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 36)*pol_y(2, 5, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 37)*pol_y(1, 5, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 37)*pol_y(1, 5, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 37)*pol_y(2, 5, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 37)*pol_y(2, 5, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 38)*pol_y(1, 5, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 38)*pol_y(1, 5, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 38)*pol_y(2, 5, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 38)*pol_y(2, 5, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 39)*pol_y(1, 5, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 39)*pol_y(1, 5, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 39)*pol_y(2, 5, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 39)*pol_y(2, 5, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 40)*pol_y(1, 6, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 40)*pol_y(1, 6, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 40)*pol_y(2, 6, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 40)*pol_y(2, 6, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 41)*pol_y(1, 6, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 41)*pol_y(1, 6, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 41)*pol_y(2, 6, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 41)*pol_y(2, 6, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 42)*pol_y(1, 6, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 42)*pol_y(1, 6, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 42)*pol_y(2, 6, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 42)*pol_y(2, 6, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 43)*pol_y(1, 7, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 43)*pol_y(1, 7, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 43)*pol_y(2, 7, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 43)*pol_y(2, 7, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 44)*pol_y(1, 7, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 44)*pol_y(1, 7, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 44)*pol_y(2, 7, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 44)*pol_y(2, 7, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 45)*pol_y(1, 8, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 45)*pol_y(1, 8, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 45)*pol_y(2, 8, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 45)*pol_y(2, 8, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 4)*pol_y(1, 0, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 4)*pol_y(1, 0, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 4)*pol_y(2, 0, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 4)*pol_y(2, 0, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 5)*pol_y(1, 0, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 5)*pol_y(1, 0, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 5)*pol_y(2, 0, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 5)*pol_y(2, 0, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 6)*pol_y(1, 0, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 6)*pol_y(1, 0, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 6)*pol_y(2, 0, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 6)*pol_y(2, 0, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 7)*pol_y(1, 0, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 7)*pol_y(1, 0, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 7)*pol_y(2, 0, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 7)*pol_y(2, 0, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 8)*pol_y(1, 0, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 8)*pol_y(1, 0, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 8)*pol_y(2, 0, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 8)*pol_y(2, 0, jg) + coef_x(1, 8) = coef_x(1, 8) + coef_xy(1, 9)*pol_y(1, 0, jg) + coef_x(2, 8) = coef_x(2, 8) + coef_xy(2, 9)*pol_y(1, 0, jg) + coef_x(3, 8) = coef_x(3, 8) + coef_xy(1, 9)*pol_y(2, 0, jg) + coef_x(4, 8) = coef_x(4, 8) + coef_xy(2, 9)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 10)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 10)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 10)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 10)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 11)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 11)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 11)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 11)*pol_y(2, 1, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 12)*pol_y(1, 1, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 12)*pol_y(1, 1, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 12)*pol_y(2, 1, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 12)*pol_y(2, 1, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 13)*pol_y(1, 1, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 13)*pol_y(1, 1, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 13)*pol_y(2, 1, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 13)*pol_y(2, 1, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 14)*pol_y(1, 1, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 14)*pol_y(1, 1, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 14)*pol_y(2, 1, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 14)*pol_y(2, 1, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 15)*pol_y(1, 1, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 15)*pol_y(1, 1, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 15)*pol_y(2, 1, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 15)*pol_y(2, 1, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 16)*pol_y(1, 1, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 16)*pol_y(1, 1, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 16)*pol_y(2, 1, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 16)*pol_y(2, 1, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 17)*pol_y(1, 1, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 17)*pol_y(1, 1, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 17)*pol_y(2, 1, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 17)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 18)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 18)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 18)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 18)*pol_y(2, 2, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 19)*pol_y(1, 2, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 19)*pol_y(1, 2, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 19)*pol_y(2, 2, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 19)*pol_y(2, 2, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 20)*pol_y(1, 2, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 20)*pol_y(1, 2, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 20)*pol_y(2, 2, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 20)*pol_y(2, 2, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 21)*pol_y(1, 2, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 21)*pol_y(1, 2, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 21)*pol_y(2, 2, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 21)*pol_y(2, 2, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 22)*pol_y(1, 2, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 22)*pol_y(1, 2, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 22)*pol_y(2, 2, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 22)*pol_y(2, 2, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 23)*pol_y(1, 2, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 23)*pol_y(1, 2, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 23)*pol_y(2, 2, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 23)*pol_y(2, 2, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 24)*pol_y(1, 2, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 24)*pol_y(1, 2, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 24)*pol_y(2, 2, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 24)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 25)*pol_y(1, 3, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 25)*pol_y(1, 3, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 25)*pol_y(2, 3, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 25)*pol_y(2, 3, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 26)*pol_y(1, 3, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 26)*pol_y(1, 3, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 26)*pol_y(2, 3, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 26)*pol_y(2, 3, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 27)*pol_y(1, 3, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 27)*pol_y(1, 3, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 27)*pol_y(2, 3, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 27)*pol_y(2, 3, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 28)*pol_y(1, 3, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 28)*pol_y(1, 3, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 28)*pol_y(2, 3, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 28)*pol_y(2, 3, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 29)*pol_y(1, 3, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 29)*pol_y(1, 3, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 29)*pol_y(2, 3, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 29)*pol_y(2, 3, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 30)*pol_y(1, 3, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 30)*pol_y(1, 3, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 30)*pol_y(2, 3, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 30)*pol_y(2, 3, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 31)*pol_y(1, 4, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 31)*pol_y(1, 4, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 31)*pol_y(2, 4, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 31)*pol_y(2, 4, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 32)*pol_y(1, 4, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 32)*pol_y(1, 4, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 32)*pol_y(2, 4, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 32)*pol_y(2, 4, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 33)*pol_y(1, 4, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 33)*pol_y(1, 4, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 33)*pol_y(2, 4, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 33)*pol_y(2, 4, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 34)*pol_y(1, 4, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 34)*pol_y(1, 4, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 34)*pol_y(2, 4, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 34)*pol_y(2, 4, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 35)*pol_y(1, 4, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 35)*pol_y(1, 4, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 35)*pol_y(2, 4, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 35)*pol_y(2, 4, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 36)*pol_y(1, 5, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 36)*pol_y(1, 5, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 36)*pol_y(2, 5, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 36)*pol_y(2, 5, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 37)*pol_y(1, 5, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 37)*pol_y(1, 5, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 37)*pol_y(2, 5, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 37)*pol_y(2, 5, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 38)*pol_y(1, 5, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 38)*pol_y(1, 5, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 38)*pol_y(2, 5, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 38)*pol_y(2, 5, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 39)*pol_y(1, 5, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 39)*pol_y(1, 5, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 39)*pol_y(2, 5, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 39)*pol_y(2, 5, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 40)*pol_y(1, 6, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 40)*pol_y(1, 6, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 40)*pol_y(2, 6, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 40)*pol_y(2, 6, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 41)*pol_y(1, 6, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 41)*pol_y(1, 6, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 41)*pol_y(2, 6, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 41)*pol_y(2, 6, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 42)*pol_y(1, 6, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 42)*pol_y(1, 6, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 42)*pol_y(2, 6, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 42)*pol_y(2, 6, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 43)*pol_y(1, 7, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 43)*pol_y(1, 7, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 43)*pol_y(2, 7, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 43)*pol_y(2, 7, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 44)*pol_y(1, 7, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 44)*pol_y(1, 7, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 44)*pol_y(2, 7, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 44)*pol_y(2, 7, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 45)*pol_y(1, 8, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 45)*pol_y(1, 8, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 45)*pol_y(2, 8, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 45)*pol_y(2, 8, jg) DO ig = igmin, igmax i = map(ig, 1) s(:) = 0.0_dp - s(:) = s(:)+coef_x(:, 0)*pol_x(0, ig) - s(:) = s(:)+coef_x(:, 1)*pol_x(1, ig) - s(:) = s(:)+coef_x(:, 2)*pol_x(2, ig) - s(:) = s(:)+coef_x(:, 3)*pol_x(3, ig) - s(:) = s(:)+coef_x(:, 4)*pol_x(4, ig) - s(:) = s(:)+coef_x(:, 5)*pol_x(5, ig) - s(:) = s(:)+coef_x(:, 6)*pol_x(6, ig) - s(:) = s(:)+coef_x(:, 7)*pol_x(7, ig) - s(:) = s(:)+coef_x(:, 8)*pol_x(8, ig) - grid(i, j, k) = grid(i, j, k)+s(1) - grid(i, j2, k) = grid(i, j2, k)+s(3) - grid(i, j, k2) = grid(i, j, k2)+s(2) - grid(i, j2, k2) = grid(i, j2, k2)+s(4) + s(:) = s(:) + coef_x(:, 0)*pol_x(0, ig) + s(:) = s(:) + coef_x(:, 1)*pol_x(1, ig) + s(:) = s(:) + coef_x(:, 2)*pol_x(2, ig) + s(:) = s(:) + coef_x(:, 3)*pol_x(3, ig) + s(:) = s(:) + coef_x(:, 4)*pol_x(4, ig) + s(:) = s(:) + coef_x(:, 5)*pol_x(5, ig) + s(:) = s(:) + coef_x(:, 6)*pol_x(6, ig) + s(:) = s(:) + coef_x(:, 7)*pol_x(7, ig) + s(:) = s(:) + coef_x(:, 8)*pol_x(8, ig) + grid(i, j, k) = grid(i, j, k) + s(1) + grid(i, j2, k) = grid(i, j2, k) + s(3) + grid(i, j, k2) = grid(i, j, k2) + s(2) + grid(i, j2, k2) = grid(i, j2, k2) + s(4) END DO END DO END DO @@ -2188,711 +2188,711 @@ SUBROUTINE collocate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 9 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s(4) sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(7)*pol_z(1, 0, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(7)*pol_z(2, 0, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(8)*pol_z(1, 0, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(8)*pol_z(2, 0, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(9)*pol_z(1, 0, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(9)*pol_z(2, 0, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(10)*pol_z(1, 0, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(10)*pol_z(2, 0, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(11)*pol_z(1, 0, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(11)*pol_z(2, 0, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(12)*pol_z(1, 0, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(12)*pol_z(2, 0, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(13)*pol_z(1, 0, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(13)*pol_z(2, 0, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(14)*pol_z(1, 0, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(14)*pol_z(2, 0, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(15)*pol_z(1, 0, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(15)*pol_z(2, 0, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(16)*pol_z(1, 0, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(16)*pol_z(2, 0, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(17)*pol_z(1, 0, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(17)*pol_z(2, 0, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(18)*pol_z(1, 0, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(18)*pol_z(2, 0, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(19)*pol_z(1, 0, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(19)*pol_z(2, 0, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(20)*pol_z(1, 0, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(20)*pol_z(2, 0, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(21)*pol_z(1, 0, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(21)*pol_z(2, 0, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(22)*pol_z(1, 0, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(22)*pol_z(2, 0, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(23)*pol_z(1, 0, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(23)*pol_z(2, 0, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(24)*pol_z(1, 0, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(24)*pol_z(2, 0, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(25)*pol_z(1, 0, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(25)*pol_z(2, 0, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(26)*pol_z(1, 0, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(26)*pol_z(2, 0, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(27)*pol_z(1, 0, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(27)*pol_z(2, 0, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(28)*pol_z(1, 0, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(28)*pol_z(2, 0, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(29)*pol_z(1, 0, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(29)*pol_z(2, 0, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(30)*pol_z(1, 0, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(30)*pol_z(2, 0, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(31)*pol_z(1, 0, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(31)*pol_z(2, 0, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(32)*pol_z(1, 0, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(32)*pol_z(2, 0, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(33)*pol_z(1, 0, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(33)*pol_z(2, 0, kg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_xyz(34)*pol_z(1, 0, kg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_xyz(34)*pol_z(2, 0, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(35)*pol_z(1, 0, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(35)*pol_z(2, 0, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(36)*pol_z(1, 0, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(36)*pol_z(2, 0, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(37)*pol_z(1, 0, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(37)*pol_z(2, 0, kg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_xyz(38)*pol_z(1, 0, kg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_xyz(38)*pol_z(2, 0, kg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_xyz(39)*pol_z(1, 0, kg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_xyz(39)*pol_z(2, 0, kg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_xyz(40)*pol_z(1, 0, kg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_xyz(40)*pol_z(2, 0, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(41)*pol_z(1, 0, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(41)*pol_z(2, 0, kg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_xyz(42)*pol_z(1, 0, kg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_xyz(42)*pol_z(2, 0, kg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_xyz(43)*pol_z(1, 0, kg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_xyz(43)*pol_z(2, 0, kg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_xyz(44)*pol_z(1, 0, kg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_xyz(44)*pol_z(2, 0, kg) - coef_xy(1, 45) = coef_xy(1, 45)+coef_xyz(45)*pol_z(1, 0, kg) - coef_xy(2, 45) = coef_xy(2, 45)+coef_xyz(45)*pol_z(2, 0, kg) - coef_xy(1, 46) = coef_xy(1, 46)+coef_xyz(46)*pol_z(1, 0, kg) - coef_xy(2, 46) = coef_xy(2, 46)+coef_xyz(46)*pol_z(2, 0, kg) - coef_xy(1, 47) = coef_xy(1, 47)+coef_xyz(47)*pol_z(1, 0, kg) - coef_xy(2, 47) = coef_xy(2, 47)+coef_xyz(47)*pol_z(2, 0, kg) - coef_xy(1, 48) = coef_xy(1, 48)+coef_xyz(48)*pol_z(1, 0, kg) - coef_xy(2, 48) = coef_xy(2, 48)+coef_xyz(48)*pol_z(2, 0, kg) - coef_xy(1, 49) = coef_xy(1, 49)+coef_xyz(49)*pol_z(1, 0, kg) - coef_xy(2, 49) = coef_xy(2, 49)+coef_xyz(49)*pol_z(2, 0, kg) - coef_xy(1, 50) = coef_xy(1, 50)+coef_xyz(50)*pol_z(1, 0, kg) - coef_xy(2, 50) = coef_xy(2, 50)+coef_xyz(50)*pol_z(2, 0, kg) - coef_xy(1, 51) = coef_xy(1, 51)+coef_xyz(51)*pol_z(1, 0, kg) - coef_xy(2, 51) = coef_xy(2, 51)+coef_xyz(51)*pol_z(2, 0, kg) - coef_xy(1, 52) = coef_xy(1, 52)+coef_xyz(52)*pol_z(1, 0, kg) - coef_xy(2, 52) = coef_xy(2, 52)+coef_xyz(52)*pol_z(2, 0, kg) - coef_xy(1, 53) = coef_xy(1, 53)+coef_xyz(53)*pol_z(1, 0, kg) - coef_xy(2, 53) = coef_xy(2, 53)+coef_xyz(53)*pol_z(2, 0, kg) - coef_xy(1, 54) = coef_xy(1, 54)+coef_xyz(54)*pol_z(1, 0, kg) - coef_xy(2, 54) = coef_xy(2, 54)+coef_xyz(54)*pol_z(2, 0, kg) - coef_xy(1, 55) = coef_xy(1, 55)+coef_xyz(55)*pol_z(1, 0, kg) - coef_xy(2, 55) = coef_xy(2, 55)+coef_xyz(55)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(56)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(56)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(57)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(57)*pol_z(2, 1, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(58)*pol_z(1, 1, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(58)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(59)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(59)*pol_z(2, 1, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(60)*pol_z(1, 1, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(60)*pol_z(2, 1, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(61)*pol_z(1, 1, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(61)*pol_z(2, 1, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(62)*pol_z(1, 1, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(62)*pol_z(2, 1, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(63)*pol_z(1, 1, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(63)*pol_z(2, 1, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(64)*pol_z(1, 1, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(64)*pol_z(2, 1, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(65)*pol_z(1, 1, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(65)*pol_z(2, 1, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(66)*pol_z(1, 1, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(66)*pol_z(2, 1, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(67)*pol_z(1, 1, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(67)*pol_z(2, 1, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(68)*pol_z(1, 1, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(68)*pol_z(2, 1, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(69)*pol_z(1, 1, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(69)*pol_z(2, 1, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(70)*pol_z(1, 1, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(70)*pol_z(2, 1, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(71)*pol_z(1, 1, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(71)*pol_z(2, 1, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(72)*pol_z(1, 1, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(72)*pol_z(2, 1, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(73)*pol_z(1, 1, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(73)*pol_z(2, 1, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(74)*pol_z(1, 1, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(74)*pol_z(2, 1, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(75)*pol_z(1, 1, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(75)*pol_z(2, 1, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(76)*pol_z(1, 1, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(76)*pol_z(2, 1, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(77)*pol_z(1, 1, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(77)*pol_z(2, 1, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(78)*pol_z(1, 1, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(78)*pol_z(2, 1, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(79)*pol_z(1, 1, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(79)*pol_z(2, 1, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(80)*pol_z(1, 1, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(80)*pol_z(2, 1, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(81)*pol_z(1, 1, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(81)*pol_z(2, 1, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(82)*pol_z(1, 1, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(82)*pol_z(2, 1, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(83)*pol_z(1, 1, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(83)*pol_z(2, 1, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(84)*pol_z(1, 1, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(84)*pol_z(2, 1, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(85)*pol_z(1, 1, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(85)*pol_z(2, 1, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(86)*pol_z(1, 1, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(86)*pol_z(2, 1, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(87)*pol_z(1, 1, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(87)*pol_z(2, 1, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(88)*pol_z(1, 1, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(88)*pol_z(2, 1, kg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_xyz(89)*pol_z(1, 1, kg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_xyz(89)*pol_z(2, 1, kg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_xyz(90)*pol_z(1, 1, kg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_xyz(90)*pol_z(2, 1, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(91)*pol_z(1, 1, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(91)*pol_z(2, 1, kg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_xyz(92)*pol_z(1, 1, kg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_xyz(92)*pol_z(2, 1, kg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_xyz(93)*pol_z(1, 1, kg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_xyz(93)*pol_z(2, 1, kg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_xyz(94)*pol_z(1, 1, kg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_xyz(94)*pol_z(2, 1, kg) - coef_xy(1, 46) = coef_xy(1, 46)+coef_xyz(95)*pol_z(1, 1, kg) - coef_xy(2, 46) = coef_xy(2, 46)+coef_xyz(95)*pol_z(2, 1, kg) - coef_xy(1, 47) = coef_xy(1, 47)+coef_xyz(96)*pol_z(1, 1, kg) - coef_xy(2, 47) = coef_xy(2, 47)+coef_xyz(96)*pol_z(2, 1, kg) - coef_xy(1, 48) = coef_xy(1, 48)+coef_xyz(97)*pol_z(1, 1, kg) - coef_xy(2, 48) = coef_xy(2, 48)+coef_xyz(97)*pol_z(2, 1, kg) - coef_xy(1, 50) = coef_xy(1, 50)+coef_xyz(98)*pol_z(1, 1, kg) - coef_xy(2, 50) = coef_xy(2, 50)+coef_xyz(98)*pol_z(2, 1, kg) - coef_xy(1, 51) = coef_xy(1, 51)+coef_xyz(99)*pol_z(1, 1, kg) - coef_xy(2, 51) = coef_xy(2, 51)+coef_xyz(99)*pol_z(2, 1, kg) - coef_xy(1, 53) = coef_xy(1, 53)+coef_xyz(100)*pol_z(1, 1, kg) - coef_xy(2, 53) = coef_xy(2, 53)+coef_xyz(100)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(101)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(101)*pol_z(2, 2, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(102)*pol_z(1, 2, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(102)*pol_z(2, 2, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(103)*pol_z(1, 2, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(103)*pol_z(2, 2, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(104)*pol_z(1, 2, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(104)*pol_z(2, 2, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(105)*pol_z(1, 2, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(105)*pol_z(2, 2, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(106)*pol_z(1, 2, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(106)*pol_z(2, 2, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(107)*pol_z(1, 2, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(107)*pol_z(2, 2, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(108)*pol_z(1, 2, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(108)*pol_z(2, 2, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(109)*pol_z(1, 2, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(109)*pol_z(2, 2, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(110)*pol_z(1, 2, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(110)*pol_z(2, 2, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(111)*pol_z(1, 2, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(111)*pol_z(2, 2, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(112)*pol_z(1, 2, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(112)*pol_z(2, 2, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(113)*pol_z(1, 2, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(113)*pol_z(2, 2, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(114)*pol_z(1, 2, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(114)*pol_z(2, 2, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(115)*pol_z(1, 2, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(115)*pol_z(2, 2, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(116)*pol_z(1, 2, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(116)*pol_z(2, 2, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(117)*pol_z(1, 2, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(117)*pol_z(2, 2, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(118)*pol_z(1, 2, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(118)*pol_z(2, 2, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(119)*pol_z(1, 2, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(119)*pol_z(2, 2, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(120)*pol_z(1, 2, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(120)*pol_z(2, 2, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(121)*pol_z(1, 2, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(121)*pol_z(2, 2, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(122)*pol_z(1, 2, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(122)*pol_z(2, 2, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(123)*pol_z(1, 2, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(123)*pol_z(2, 2, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(124)*pol_z(1, 2, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(124)*pol_z(2, 2, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(125)*pol_z(1, 2, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(125)*pol_z(2, 2, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(126)*pol_z(1, 2, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(126)*pol_z(2, 2, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(127)*pol_z(1, 2, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(127)*pol_z(2, 2, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(128)*pol_z(1, 2, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(128)*pol_z(2, 2, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(129)*pol_z(1, 2, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(129)*pol_z(2, 2, kg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_xyz(130)*pol_z(1, 2, kg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_xyz(130)*pol_z(2, 2, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(131)*pol_z(1, 2, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(131)*pol_z(2, 2, kg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_xyz(132)*pol_z(1, 2, kg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_xyz(132)*pol_z(2, 2, kg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_xyz(133)*pol_z(1, 2, kg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_xyz(133)*pol_z(2, 2, kg) - coef_xy(1, 46) = coef_xy(1, 46)+coef_xyz(134)*pol_z(1, 2, kg) - coef_xy(2, 46) = coef_xy(2, 46)+coef_xyz(134)*pol_z(2, 2, kg) - coef_xy(1, 47) = coef_xy(1, 47)+coef_xyz(135)*pol_z(1, 2, kg) - coef_xy(2, 47) = coef_xy(2, 47)+coef_xyz(135)*pol_z(2, 2, kg) - coef_xy(1, 50) = coef_xy(1, 50)+coef_xyz(136)*pol_z(1, 2, kg) - coef_xy(2, 50) = coef_xy(2, 50)+coef_xyz(136)*pol_z(2, 2, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(137)*pol_z(1, 3, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(137)*pol_z(2, 3, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(138)*pol_z(1, 3, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(138)*pol_z(2, 3, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(139)*pol_z(1, 3, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(139)*pol_z(2, 3, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(140)*pol_z(1, 3, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(140)*pol_z(2, 3, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(141)*pol_z(1, 3, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(141)*pol_z(2, 3, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(142)*pol_z(1, 3, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(142)*pol_z(2, 3, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(143)*pol_z(1, 3, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(143)*pol_z(2, 3, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(144)*pol_z(1, 3, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(144)*pol_z(2, 3, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(145)*pol_z(1, 3, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(145)*pol_z(2, 3, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(146)*pol_z(1, 3, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(146)*pol_z(2, 3, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(147)*pol_z(1, 3, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(147)*pol_z(2, 3, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(148)*pol_z(1, 3, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(148)*pol_z(2, 3, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(149)*pol_z(1, 3, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(149)*pol_z(2, 3, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(150)*pol_z(1, 3, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(150)*pol_z(2, 3, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(151)*pol_z(1, 3, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(151)*pol_z(2, 3, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(152)*pol_z(1, 3, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(152)*pol_z(2, 3, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(153)*pol_z(1, 3, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(153)*pol_z(2, 3, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(154)*pol_z(1, 3, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(154)*pol_z(2, 3, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(155)*pol_z(1, 3, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(155)*pol_z(2, 3, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(156)*pol_z(1, 3, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(156)*pol_z(2, 3, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(157)*pol_z(1, 3, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(157)*pol_z(2, 3, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(158)*pol_z(1, 3, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(158)*pol_z(2, 3, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(159)*pol_z(1, 3, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(159)*pol_z(2, 3, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(160)*pol_z(1, 3, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(160)*pol_z(2, 3, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(161)*pol_z(1, 3, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(161)*pol_z(2, 3, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(162)*pol_z(1, 3, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(162)*pol_z(2, 3, kg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_xyz(163)*pol_z(1, 3, kg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_xyz(163)*pol_z(2, 3, kg) - coef_xy(1, 46) = coef_xy(1, 46)+coef_xyz(164)*pol_z(1, 3, kg) - coef_xy(2, 46) = coef_xy(2, 46)+coef_xyz(164)*pol_z(2, 3, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(165)*pol_z(1, 4, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(165)*pol_z(2, 4, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(166)*pol_z(1, 4, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(166)*pol_z(2, 4, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(167)*pol_z(1, 4, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(167)*pol_z(2, 4, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(168)*pol_z(1, 4, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(168)*pol_z(2, 4, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(169)*pol_z(1, 4, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(169)*pol_z(2, 4, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(170)*pol_z(1, 4, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(170)*pol_z(2, 4, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(171)*pol_z(1, 4, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(171)*pol_z(2, 4, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(172)*pol_z(1, 4, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(172)*pol_z(2, 4, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(173)*pol_z(1, 4, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(173)*pol_z(2, 4, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(174)*pol_z(1, 4, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(174)*pol_z(2, 4, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(175)*pol_z(1, 4, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(175)*pol_z(2, 4, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(176)*pol_z(1, 4, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(176)*pol_z(2, 4, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(177)*pol_z(1, 4, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(177)*pol_z(2, 4, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(178)*pol_z(1, 4, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(178)*pol_z(2, 4, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(179)*pol_z(1, 4, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(179)*pol_z(2, 4, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(180)*pol_z(1, 4, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(180)*pol_z(2, 4, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(181)*pol_z(1, 4, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(181)*pol_z(2, 4, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(182)*pol_z(1, 4, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(182)*pol_z(2, 4, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(183)*pol_z(1, 4, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(183)*pol_z(2, 4, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(184)*pol_z(1, 4, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(184)*pol_z(2, 4, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(185)*pol_z(1, 4, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(185)*pol_z(2, 4, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(186)*pol_z(1, 5, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(186)*pol_z(2, 5, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(187)*pol_z(1, 5, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(187)*pol_z(2, 5, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(188)*pol_z(1, 5, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(188)*pol_z(2, 5, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(189)*pol_z(1, 5, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(189)*pol_z(2, 5, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(190)*pol_z(1, 5, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(190)*pol_z(2, 5, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(191)*pol_z(1, 5, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(191)*pol_z(2, 5, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(192)*pol_z(1, 5, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(192)*pol_z(2, 5, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(193)*pol_z(1, 5, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(193)*pol_z(2, 5, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(194)*pol_z(1, 5, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(194)*pol_z(2, 5, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(195)*pol_z(1, 5, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(195)*pol_z(2, 5, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(196)*pol_z(1, 5, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(196)*pol_z(2, 5, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(197)*pol_z(1, 5, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(197)*pol_z(2, 5, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(198)*pol_z(1, 5, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(198)*pol_z(2, 5, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(199)*pol_z(1, 5, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(199)*pol_z(2, 5, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(200)*pol_z(1, 5, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(200)*pol_z(2, 5, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(201)*pol_z(1, 6, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(201)*pol_z(2, 6, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(202)*pol_z(1, 6, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(202)*pol_z(2, 6, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(203)*pol_z(1, 6, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(203)*pol_z(2, 6, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(204)*pol_z(1, 6, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(204)*pol_z(2, 6, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(205)*pol_z(1, 6, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(205)*pol_z(2, 6, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(206)*pol_z(1, 6, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(206)*pol_z(2, 6, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(207)*pol_z(1, 6, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(207)*pol_z(2, 6, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(208)*pol_z(1, 6, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(208)*pol_z(2, 6, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(209)*pol_z(1, 6, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(209)*pol_z(2, 6, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(210)*pol_z(1, 6, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(210)*pol_z(2, 6, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(211)*pol_z(1, 7, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(211)*pol_z(2, 7, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(212)*pol_z(1, 7, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(212)*pol_z(2, 7, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(213)*pol_z(1, 7, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(213)*pol_z(2, 7, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(214)*pol_z(1, 7, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(214)*pol_z(2, 7, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(215)*pol_z(1, 7, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(215)*pol_z(2, 7, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(216)*pol_z(1, 7, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(216)*pol_z(2, 7, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(217)*pol_z(1, 8, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(217)*pol_z(2, 8, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(218)*pol_z(1, 8, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(218)*pol_z(2, 8, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(219)*pol_z(1, 8, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(219)*pol_z(2, 8, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(220)*pol_z(1, 9, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(220)*pol_z(2, 9, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(7)*pol_z(1, 0, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(7)*pol_z(2, 0, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(8)*pol_z(1, 0, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(8)*pol_z(2, 0, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(9)*pol_z(1, 0, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(9)*pol_z(2, 0, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(10)*pol_z(1, 0, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(10)*pol_z(2, 0, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(11)*pol_z(1, 0, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(11)*pol_z(2, 0, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(12)*pol_z(1, 0, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(12)*pol_z(2, 0, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(13)*pol_z(1, 0, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(13)*pol_z(2, 0, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(14)*pol_z(1, 0, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(14)*pol_z(2, 0, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(15)*pol_z(1, 0, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(15)*pol_z(2, 0, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(16)*pol_z(1, 0, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(16)*pol_z(2, 0, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(17)*pol_z(1, 0, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(17)*pol_z(2, 0, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(18)*pol_z(1, 0, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(18)*pol_z(2, 0, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(19)*pol_z(1, 0, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(19)*pol_z(2, 0, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(20)*pol_z(1, 0, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(20)*pol_z(2, 0, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(21)*pol_z(1, 0, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(21)*pol_z(2, 0, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(22)*pol_z(1, 0, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(22)*pol_z(2, 0, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(23)*pol_z(1, 0, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(23)*pol_z(2, 0, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(24)*pol_z(1, 0, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(24)*pol_z(2, 0, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(25)*pol_z(1, 0, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(25)*pol_z(2, 0, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(26)*pol_z(1, 0, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(26)*pol_z(2, 0, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(27)*pol_z(1, 0, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(27)*pol_z(2, 0, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(28)*pol_z(1, 0, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(28)*pol_z(2, 0, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(29)*pol_z(1, 0, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(29)*pol_z(2, 0, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(30)*pol_z(1, 0, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(30)*pol_z(2, 0, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(31)*pol_z(1, 0, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(31)*pol_z(2, 0, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(32)*pol_z(1, 0, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(32)*pol_z(2, 0, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(33)*pol_z(1, 0, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(33)*pol_z(2, 0, kg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_xyz(34)*pol_z(1, 0, kg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_xyz(34)*pol_z(2, 0, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(35)*pol_z(1, 0, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(35)*pol_z(2, 0, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(36)*pol_z(1, 0, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(36)*pol_z(2, 0, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(37)*pol_z(1, 0, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(37)*pol_z(2, 0, kg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_xyz(38)*pol_z(1, 0, kg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_xyz(38)*pol_z(2, 0, kg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_xyz(39)*pol_z(1, 0, kg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_xyz(39)*pol_z(2, 0, kg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_xyz(40)*pol_z(1, 0, kg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_xyz(40)*pol_z(2, 0, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(41)*pol_z(1, 0, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(41)*pol_z(2, 0, kg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_xyz(42)*pol_z(1, 0, kg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_xyz(42)*pol_z(2, 0, kg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_xyz(43)*pol_z(1, 0, kg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_xyz(43)*pol_z(2, 0, kg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_xyz(44)*pol_z(1, 0, kg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_xyz(44)*pol_z(2, 0, kg) + coef_xy(1, 45) = coef_xy(1, 45) + coef_xyz(45)*pol_z(1, 0, kg) + coef_xy(2, 45) = coef_xy(2, 45) + coef_xyz(45)*pol_z(2, 0, kg) + coef_xy(1, 46) = coef_xy(1, 46) + coef_xyz(46)*pol_z(1, 0, kg) + coef_xy(2, 46) = coef_xy(2, 46) + coef_xyz(46)*pol_z(2, 0, kg) + coef_xy(1, 47) = coef_xy(1, 47) + coef_xyz(47)*pol_z(1, 0, kg) + coef_xy(2, 47) = coef_xy(2, 47) + coef_xyz(47)*pol_z(2, 0, kg) + coef_xy(1, 48) = coef_xy(1, 48) + coef_xyz(48)*pol_z(1, 0, kg) + coef_xy(2, 48) = coef_xy(2, 48) + coef_xyz(48)*pol_z(2, 0, kg) + coef_xy(1, 49) = coef_xy(1, 49) + coef_xyz(49)*pol_z(1, 0, kg) + coef_xy(2, 49) = coef_xy(2, 49) + coef_xyz(49)*pol_z(2, 0, kg) + coef_xy(1, 50) = coef_xy(1, 50) + coef_xyz(50)*pol_z(1, 0, kg) + coef_xy(2, 50) = coef_xy(2, 50) + coef_xyz(50)*pol_z(2, 0, kg) + coef_xy(1, 51) = coef_xy(1, 51) + coef_xyz(51)*pol_z(1, 0, kg) + coef_xy(2, 51) = coef_xy(2, 51) + coef_xyz(51)*pol_z(2, 0, kg) + coef_xy(1, 52) = coef_xy(1, 52) + coef_xyz(52)*pol_z(1, 0, kg) + coef_xy(2, 52) = coef_xy(2, 52) + coef_xyz(52)*pol_z(2, 0, kg) + coef_xy(1, 53) = coef_xy(1, 53) + coef_xyz(53)*pol_z(1, 0, kg) + coef_xy(2, 53) = coef_xy(2, 53) + coef_xyz(53)*pol_z(2, 0, kg) + coef_xy(1, 54) = coef_xy(1, 54) + coef_xyz(54)*pol_z(1, 0, kg) + coef_xy(2, 54) = coef_xy(2, 54) + coef_xyz(54)*pol_z(2, 0, kg) + coef_xy(1, 55) = coef_xy(1, 55) + coef_xyz(55)*pol_z(1, 0, kg) + coef_xy(2, 55) = coef_xy(2, 55) + coef_xyz(55)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(56)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(56)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(57)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(57)*pol_z(2, 1, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(58)*pol_z(1, 1, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(58)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(59)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(59)*pol_z(2, 1, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(60)*pol_z(1, 1, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(60)*pol_z(2, 1, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(61)*pol_z(1, 1, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(61)*pol_z(2, 1, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(62)*pol_z(1, 1, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(62)*pol_z(2, 1, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(63)*pol_z(1, 1, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(63)*pol_z(2, 1, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(64)*pol_z(1, 1, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(64)*pol_z(2, 1, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(65)*pol_z(1, 1, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(65)*pol_z(2, 1, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(66)*pol_z(1, 1, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(66)*pol_z(2, 1, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(67)*pol_z(1, 1, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(67)*pol_z(2, 1, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(68)*pol_z(1, 1, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(68)*pol_z(2, 1, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(69)*pol_z(1, 1, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(69)*pol_z(2, 1, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(70)*pol_z(1, 1, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(70)*pol_z(2, 1, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(71)*pol_z(1, 1, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(71)*pol_z(2, 1, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(72)*pol_z(1, 1, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(72)*pol_z(2, 1, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(73)*pol_z(1, 1, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(73)*pol_z(2, 1, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(74)*pol_z(1, 1, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(74)*pol_z(2, 1, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(75)*pol_z(1, 1, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(75)*pol_z(2, 1, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(76)*pol_z(1, 1, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(76)*pol_z(2, 1, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(77)*pol_z(1, 1, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(77)*pol_z(2, 1, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(78)*pol_z(1, 1, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(78)*pol_z(2, 1, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(79)*pol_z(1, 1, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(79)*pol_z(2, 1, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(80)*pol_z(1, 1, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(80)*pol_z(2, 1, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(81)*pol_z(1, 1, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(81)*pol_z(2, 1, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(82)*pol_z(1, 1, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(82)*pol_z(2, 1, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(83)*pol_z(1, 1, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(83)*pol_z(2, 1, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(84)*pol_z(1, 1, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(84)*pol_z(2, 1, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(85)*pol_z(1, 1, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(85)*pol_z(2, 1, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(86)*pol_z(1, 1, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(86)*pol_z(2, 1, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(87)*pol_z(1, 1, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(87)*pol_z(2, 1, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(88)*pol_z(1, 1, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(88)*pol_z(2, 1, kg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_xyz(89)*pol_z(1, 1, kg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_xyz(89)*pol_z(2, 1, kg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_xyz(90)*pol_z(1, 1, kg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_xyz(90)*pol_z(2, 1, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(91)*pol_z(1, 1, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(91)*pol_z(2, 1, kg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_xyz(92)*pol_z(1, 1, kg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_xyz(92)*pol_z(2, 1, kg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_xyz(93)*pol_z(1, 1, kg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_xyz(93)*pol_z(2, 1, kg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_xyz(94)*pol_z(1, 1, kg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_xyz(94)*pol_z(2, 1, kg) + coef_xy(1, 46) = coef_xy(1, 46) + coef_xyz(95)*pol_z(1, 1, kg) + coef_xy(2, 46) = coef_xy(2, 46) + coef_xyz(95)*pol_z(2, 1, kg) + coef_xy(1, 47) = coef_xy(1, 47) + coef_xyz(96)*pol_z(1, 1, kg) + coef_xy(2, 47) = coef_xy(2, 47) + coef_xyz(96)*pol_z(2, 1, kg) + coef_xy(1, 48) = coef_xy(1, 48) + coef_xyz(97)*pol_z(1, 1, kg) + coef_xy(2, 48) = coef_xy(2, 48) + coef_xyz(97)*pol_z(2, 1, kg) + coef_xy(1, 50) = coef_xy(1, 50) + coef_xyz(98)*pol_z(1, 1, kg) + coef_xy(2, 50) = coef_xy(2, 50) + coef_xyz(98)*pol_z(2, 1, kg) + coef_xy(1, 51) = coef_xy(1, 51) + coef_xyz(99)*pol_z(1, 1, kg) + coef_xy(2, 51) = coef_xy(2, 51) + coef_xyz(99)*pol_z(2, 1, kg) + coef_xy(1, 53) = coef_xy(1, 53) + coef_xyz(100)*pol_z(1, 1, kg) + coef_xy(2, 53) = coef_xy(2, 53) + coef_xyz(100)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(101)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(101)*pol_z(2, 2, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(102)*pol_z(1, 2, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(102)*pol_z(2, 2, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(103)*pol_z(1, 2, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(103)*pol_z(2, 2, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(104)*pol_z(1, 2, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(104)*pol_z(2, 2, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(105)*pol_z(1, 2, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(105)*pol_z(2, 2, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(106)*pol_z(1, 2, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(106)*pol_z(2, 2, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(107)*pol_z(1, 2, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(107)*pol_z(2, 2, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(108)*pol_z(1, 2, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(108)*pol_z(2, 2, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(109)*pol_z(1, 2, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(109)*pol_z(2, 2, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(110)*pol_z(1, 2, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(110)*pol_z(2, 2, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(111)*pol_z(1, 2, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(111)*pol_z(2, 2, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(112)*pol_z(1, 2, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(112)*pol_z(2, 2, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(113)*pol_z(1, 2, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(113)*pol_z(2, 2, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(114)*pol_z(1, 2, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(114)*pol_z(2, 2, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(115)*pol_z(1, 2, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(115)*pol_z(2, 2, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(116)*pol_z(1, 2, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(116)*pol_z(2, 2, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(117)*pol_z(1, 2, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(117)*pol_z(2, 2, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(118)*pol_z(1, 2, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(118)*pol_z(2, 2, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(119)*pol_z(1, 2, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(119)*pol_z(2, 2, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(120)*pol_z(1, 2, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(120)*pol_z(2, 2, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(121)*pol_z(1, 2, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(121)*pol_z(2, 2, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(122)*pol_z(1, 2, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(122)*pol_z(2, 2, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(123)*pol_z(1, 2, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(123)*pol_z(2, 2, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(124)*pol_z(1, 2, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(124)*pol_z(2, 2, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(125)*pol_z(1, 2, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(125)*pol_z(2, 2, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(126)*pol_z(1, 2, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(126)*pol_z(2, 2, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(127)*pol_z(1, 2, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(127)*pol_z(2, 2, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(128)*pol_z(1, 2, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(128)*pol_z(2, 2, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(129)*pol_z(1, 2, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(129)*pol_z(2, 2, kg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_xyz(130)*pol_z(1, 2, kg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_xyz(130)*pol_z(2, 2, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(131)*pol_z(1, 2, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(131)*pol_z(2, 2, kg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_xyz(132)*pol_z(1, 2, kg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_xyz(132)*pol_z(2, 2, kg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_xyz(133)*pol_z(1, 2, kg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_xyz(133)*pol_z(2, 2, kg) + coef_xy(1, 46) = coef_xy(1, 46) + coef_xyz(134)*pol_z(1, 2, kg) + coef_xy(2, 46) = coef_xy(2, 46) + coef_xyz(134)*pol_z(2, 2, kg) + coef_xy(1, 47) = coef_xy(1, 47) + coef_xyz(135)*pol_z(1, 2, kg) + coef_xy(2, 47) = coef_xy(2, 47) + coef_xyz(135)*pol_z(2, 2, kg) + coef_xy(1, 50) = coef_xy(1, 50) + coef_xyz(136)*pol_z(1, 2, kg) + coef_xy(2, 50) = coef_xy(2, 50) + coef_xyz(136)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(137)*pol_z(1, 3, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(137)*pol_z(2, 3, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(138)*pol_z(1, 3, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(138)*pol_z(2, 3, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(139)*pol_z(1, 3, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(139)*pol_z(2, 3, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(140)*pol_z(1, 3, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(140)*pol_z(2, 3, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(141)*pol_z(1, 3, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(141)*pol_z(2, 3, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(142)*pol_z(1, 3, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(142)*pol_z(2, 3, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(143)*pol_z(1, 3, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(143)*pol_z(2, 3, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(144)*pol_z(1, 3, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(144)*pol_z(2, 3, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(145)*pol_z(1, 3, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(145)*pol_z(2, 3, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(146)*pol_z(1, 3, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(146)*pol_z(2, 3, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(147)*pol_z(1, 3, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(147)*pol_z(2, 3, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(148)*pol_z(1, 3, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(148)*pol_z(2, 3, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(149)*pol_z(1, 3, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(149)*pol_z(2, 3, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(150)*pol_z(1, 3, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(150)*pol_z(2, 3, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(151)*pol_z(1, 3, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(151)*pol_z(2, 3, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(152)*pol_z(1, 3, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(152)*pol_z(2, 3, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(153)*pol_z(1, 3, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(153)*pol_z(2, 3, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(154)*pol_z(1, 3, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(154)*pol_z(2, 3, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(155)*pol_z(1, 3, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(155)*pol_z(2, 3, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(156)*pol_z(1, 3, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(156)*pol_z(2, 3, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(157)*pol_z(1, 3, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(157)*pol_z(2, 3, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(158)*pol_z(1, 3, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(158)*pol_z(2, 3, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(159)*pol_z(1, 3, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(159)*pol_z(2, 3, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(160)*pol_z(1, 3, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(160)*pol_z(2, 3, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(161)*pol_z(1, 3, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(161)*pol_z(2, 3, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(162)*pol_z(1, 3, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(162)*pol_z(2, 3, kg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_xyz(163)*pol_z(1, 3, kg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_xyz(163)*pol_z(2, 3, kg) + coef_xy(1, 46) = coef_xy(1, 46) + coef_xyz(164)*pol_z(1, 3, kg) + coef_xy(2, 46) = coef_xy(2, 46) + coef_xyz(164)*pol_z(2, 3, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(165)*pol_z(1, 4, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(165)*pol_z(2, 4, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(166)*pol_z(1, 4, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(166)*pol_z(2, 4, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(167)*pol_z(1, 4, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(167)*pol_z(2, 4, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(168)*pol_z(1, 4, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(168)*pol_z(2, 4, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(169)*pol_z(1, 4, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(169)*pol_z(2, 4, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(170)*pol_z(1, 4, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(170)*pol_z(2, 4, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(171)*pol_z(1, 4, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(171)*pol_z(2, 4, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(172)*pol_z(1, 4, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(172)*pol_z(2, 4, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(173)*pol_z(1, 4, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(173)*pol_z(2, 4, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(174)*pol_z(1, 4, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(174)*pol_z(2, 4, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(175)*pol_z(1, 4, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(175)*pol_z(2, 4, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(176)*pol_z(1, 4, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(176)*pol_z(2, 4, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(177)*pol_z(1, 4, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(177)*pol_z(2, 4, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(178)*pol_z(1, 4, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(178)*pol_z(2, 4, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(179)*pol_z(1, 4, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(179)*pol_z(2, 4, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(180)*pol_z(1, 4, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(180)*pol_z(2, 4, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(181)*pol_z(1, 4, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(181)*pol_z(2, 4, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(182)*pol_z(1, 4, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(182)*pol_z(2, 4, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(183)*pol_z(1, 4, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(183)*pol_z(2, 4, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(184)*pol_z(1, 4, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(184)*pol_z(2, 4, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(185)*pol_z(1, 4, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(185)*pol_z(2, 4, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(186)*pol_z(1, 5, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(186)*pol_z(2, 5, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(187)*pol_z(1, 5, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(187)*pol_z(2, 5, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(188)*pol_z(1, 5, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(188)*pol_z(2, 5, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(189)*pol_z(1, 5, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(189)*pol_z(2, 5, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(190)*pol_z(1, 5, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(190)*pol_z(2, 5, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(191)*pol_z(1, 5, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(191)*pol_z(2, 5, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(192)*pol_z(1, 5, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(192)*pol_z(2, 5, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(193)*pol_z(1, 5, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(193)*pol_z(2, 5, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(194)*pol_z(1, 5, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(194)*pol_z(2, 5, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(195)*pol_z(1, 5, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(195)*pol_z(2, 5, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(196)*pol_z(1, 5, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(196)*pol_z(2, 5, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(197)*pol_z(1, 5, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(197)*pol_z(2, 5, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(198)*pol_z(1, 5, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(198)*pol_z(2, 5, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(199)*pol_z(1, 5, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(199)*pol_z(2, 5, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(200)*pol_z(1, 5, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(200)*pol_z(2, 5, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(201)*pol_z(1, 6, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(201)*pol_z(2, 6, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(202)*pol_z(1, 6, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(202)*pol_z(2, 6, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(203)*pol_z(1, 6, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(203)*pol_z(2, 6, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(204)*pol_z(1, 6, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(204)*pol_z(2, 6, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(205)*pol_z(1, 6, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(205)*pol_z(2, 6, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(206)*pol_z(1, 6, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(206)*pol_z(2, 6, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(207)*pol_z(1, 6, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(207)*pol_z(2, 6, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(208)*pol_z(1, 6, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(208)*pol_z(2, 6, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(209)*pol_z(1, 6, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(209)*pol_z(2, 6, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(210)*pol_z(1, 6, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(210)*pol_z(2, 6, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(211)*pol_z(1, 7, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(211)*pol_z(2, 7, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(212)*pol_z(1, 7, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(212)*pol_z(2, 7, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(213)*pol_z(1, 7, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(213)*pol_z(2, 7, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(214)*pol_z(1, 7, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(214)*pol_z(2, 7, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(215)*pol_z(1, 7, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(215)*pol_z(2, 7, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(216)*pol_z(1, 7, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(216)*pol_z(2, 7, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(217)*pol_z(1, 8, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(217)*pol_z(2, 8, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(218)*pol_z(1, 8, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(218)*pol_z(2, 8, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(219)*pol_z(1, 8, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(219)*pol_z(2, 8, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(220)*pol_z(1, 9, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(220)*pol_z(2, 9, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 4)*pol_y(1, 0, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 4)*pol_y(1, 0, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 4)*pol_y(2, 0, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 4)*pol_y(2, 0, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 5)*pol_y(1, 0, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 5)*pol_y(1, 0, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 5)*pol_y(2, 0, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 5)*pol_y(2, 0, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 6)*pol_y(1, 0, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 6)*pol_y(1, 0, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 6)*pol_y(2, 0, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 6)*pol_y(2, 0, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 7)*pol_y(1, 0, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 7)*pol_y(1, 0, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 7)*pol_y(2, 0, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 7)*pol_y(2, 0, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 8)*pol_y(1, 0, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 8)*pol_y(1, 0, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 8)*pol_y(2, 0, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 8)*pol_y(2, 0, jg) - coef_x(1, 8) = coef_x(1, 8)+coef_xy(1, 9)*pol_y(1, 0, jg) - coef_x(2, 8) = coef_x(2, 8)+coef_xy(2, 9)*pol_y(1, 0, jg) - coef_x(3, 8) = coef_x(3, 8)+coef_xy(1, 9)*pol_y(2, 0, jg) - coef_x(4, 8) = coef_x(4, 8)+coef_xy(2, 9)*pol_y(2, 0, jg) - coef_x(1, 9) = coef_x(1, 9)+coef_xy(1, 10)*pol_y(1, 0, jg) - coef_x(2, 9) = coef_x(2, 9)+coef_xy(2, 10)*pol_y(1, 0, jg) - coef_x(3, 9) = coef_x(3, 9)+coef_xy(1, 10)*pol_y(2, 0, jg) - coef_x(4, 9) = coef_x(4, 9)+coef_xy(2, 10)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 11)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 11)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 11)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 11)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 12)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 12)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 12)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 12)*pol_y(2, 1, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 13)*pol_y(1, 1, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 13)*pol_y(1, 1, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 13)*pol_y(2, 1, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 13)*pol_y(2, 1, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 14)*pol_y(1, 1, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 14)*pol_y(1, 1, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 14)*pol_y(2, 1, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 14)*pol_y(2, 1, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 15)*pol_y(1, 1, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 15)*pol_y(1, 1, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 15)*pol_y(2, 1, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 15)*pol_y(2, 1, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 16)*pol_y(1, 1, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 16)*pol_y(1, 1, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 16)*pol_y(2, 1, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 16)*pol_y(2, 1, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 17)*pol_y(1, 1, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 17)*pol_y(1, 1, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 17)*pol_y(2, 1, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 17)*pol_y(2, 1, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 18)*pol_y(1, 1, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 18)*pol_y(1, 1, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 18)*pol_y(2, 1, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 18)*pol_y(2, 1, jg) - coef_x(1, 8) = coef_x(1, 8)+coef_xy(1, 19)*pol_y(1, 1, jg) - coef_x(2, 8) = coef_x(2, 8)+coef_xy(2, 19)*pol_y(1, 1, jg) - coef_x(3, 8) = coef_x(3, 8)+coef_xy(1, 19)*pol_y(2, 1, jg) - coef_x(4, 8) = coef_x(4, 8)+coef_xy(2, 19)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 20)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 20)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 20)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 20)*pol_y(2, 2, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 21)*pol_y(1, 2, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 21)*pol_y(1, 2, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 21)*pol_y(2, 2, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 21)*pol_y(2, 2, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 22)*pol_y(1, 2, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 22)*pol_y(1, 2, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 22)*pol_y(2, 2, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 22)*pol_y(2, 2, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 23)*pol_y(1, 2, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 23)*pol_y(1, 2, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 23)*pol_y(2, 2, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 23)*pol_y(2, 2, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 24)*pol_y(1, 2, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 24)*pol_y(1, 2, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 24)*pol_y(2, 2, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 24)*pol_y(2, 2, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 25)*pol_y(1, 2, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 25)*pol_y(1, 2, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 25)*pol_y(2, 2, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 25)*pol_y(2, 2, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 26)*pol_y(1, 2, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 26)*pol_y(1, 2, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 26)*pol_y(2, 2, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 26)*pol_y(2, 2, jg) - coef_x(1, 7) = coef_x(1, 7)+coef_xy(1, 27)*pol_y(1, 2, jg) - coef_x(2, 7) = coef_x(2, 7)+coef_xy(2, 27)*pol_y(1, 2, jg) - coef_x(3, 7) = coef_x(3, 7)+coef_xy(1, 27)*pol_y(2, 2, jg) - coef_x(4, 7) = coef_x(4, 7)+coef_xy(2, 27)*pol_y(2, 2, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 28)*pol_y(1, 3, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 28)*pol_y(1, 3, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 28)*pol_y(2, 3, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 28)*pol_y(2, 3, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 29)*pol_y(1, 3, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 29)*pol_y(1, 3, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 29)*pol_y(2, 3, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 29)*pol_y(2, 3, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 30)*pol_y(1, 3, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 30)*pol_y(1, 3, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 30)*pol_y(2, 3, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 30)*pol_y(2, 3, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 31)*pol_y(1, 3, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 31)*pol_y(1, 3, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 31)*pol_y(2, 3, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 31)*pol_y(2, 3, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 32)*pol_y(1, 3, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 32)*pol_y(1, 3, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 32)*pol_y(2, 3, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 32)*pol_y(2, 3, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 33)*pol_y(1, 3, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 33)*pol_y(1, 3, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 33)*pol_y(2, 3, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 33)*pol_y(2, 3, jg) - coef_x(1, 6) = coef_x(1, 6)+coef_xy(1, 34)*pol_y(1, 3, jg) - coef_x(2, 6) = coef_x(2, 6)+coef_xy(2, 34)*pol_y(1, 3, jg) - coef_x(3, 6) = coef_x(3, 6)+coef_xy(1, 34)*pol_y(2, 3, jg) - coef_x(4, 6) = coef_x(4, 6)+coef_xy(2, 34)*pol_y(2, 3, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 35)*pol_y(1, 4, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 35)*pol_y(1, 4, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 35)*pol_y(2, 4, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 35)*pol_y(2, 4, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 36)*pol_y(1, 4, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 36)*pol_y(1, 4, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 36)*pol_y(2, 4, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 36)*pol_y(2, 4, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 37)*pol_y(1, 4, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 37)*pol_y(1, 4, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 37)*pol_y(2, 4, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 37)*pol_y(2, 4, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 38)*pol_y(1, 4, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 38)*pol_y(1, 4, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 38)*pol_y(2, 4, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 38)*pol_y(2, 4, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 39)*pol_y(1, 4, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 39)*pol_y(1, 4, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 39)*pol_y(2, 4, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 39)*pol_y(2, 4, jg) - coef_x(1, 5) = coef_x(1, 5)+coef_xy(1, 40)*pol_y(1, 4, jg) - coef_x(2, 5) = coef_x(2, 5)+coef_xy(2, 40)*pol_y(1, 4, jg) - coef_x(3, 5) = coef_x(3, 5)+coef_xy(1, 40)*pol_y(2, 4, jg) - coef_x(4, 5) = coef_x(4, 5)+coef_xy(2, 40)*pol_y(2, 4, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 41)*pol_y(1, 5, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 41)*pol_y(1, 5, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 41)*pol_y(2, 5, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 41)*pol_y(2, 5, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 42)*pol_y(1, 5, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 42)*pol_y(1, 5, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 42)*pol_y(2, 5, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 42)*pol_y(2, 5, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 43)*pol_y(1, 5, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 43)*pol_y(1, 5, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 43)*pol_y(2, 5, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 43)*pol_y(2, 5, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 44)*pol_y(1, 5, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 44)*pol_y(1, 5, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 44)*pol_y(2, 5, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 44)*pol_y(2, 5, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 45)*pol_y(1, 5, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 45)*pol_y(1, 5, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 45)*pol_y(2, 5, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 45)*pol_y(2, 5, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 46)*pol_y(1, 6, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 46)*pol_y(1, 6, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 46)*pol_y(2, 6, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 46)*pol_y(2, 6, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 47)*pol_y(1, 6, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 47)*pol_y(1, 6, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 47)*pol_y(2, 6, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 47)*pol_y(2, 6, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 48)*pol_y(1, 6, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 48)*pol_y(1, 6, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 48)*pol_y(2, 6, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 48)*pol_y(2, 6, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 49)*pol_y(1, 6, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 49)*pol_y(1, 6, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 49)*pol_y(2, 6, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 49)*pol_y(2, 6, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 50)*pol_y(1, 7, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 50)*pol_y(1, 7, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 50)*pol_y(2, 7, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 50)*pol_y(2, 7, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 51)*pol_y(1, 7, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 51)*pol_y(1, 7, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 51)*pol_y(2, 7, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 51)*pol_y(2, 7, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 52)*pol_y(1, 7, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 52)*pol_y(1, 7, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 52)*pol_y(2, 7, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 52)*pol_y(2, 7, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 53)*pol_y(1, 8, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 53)*pol_y(1, 8, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 53)*pol_y(2, 8, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 53)*pol_y(2, 8, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 54)*pol_y(1, 8, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 54)*pol_y(1, 8, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 54)*pol_y(2, 8, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 54)*pol_y(2, 8, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 55)*pol_y(1, 9, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 55)*pol_y(1, 9, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 55)*pol_y(2, 9, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 55)*pol_y(2, 9, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 4)*pol_y(1, 0, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 4)*pol_y(1, 0, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 4)*pol_y(2, 0, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 4)*pol_y(2, 0, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 5)*pol_y(1, 0, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 5)*pol_y(1, 0, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 5)*pol_y(2, 0, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 5)*pol_y(2, 0, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 6)*pol_y(1, 0, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 6)*pol_y(1, 0, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 6)*pol_y(2, 0, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 6)*pol_y(2, 0, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 7)*pol_y(1, 0, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 7)*pol_y(1, 0, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 7)*pol_y(2, 0, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 7)*pol_y(2, 0, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 8)*pol_y(1, 0, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 8)*pol_y(1, 0, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 8)*pol_y(2, 0, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 8)*pol_y(2, 0, jg) + coef_x(1, 8) = coef_x(1, 8) + coef_xy(1, 9)*pol_y(1, 0, jg) + coef_x(2, 8) = coef_x(2, 8) + coef_xy(2, 9)*pol_y(1, 0, jg) + coef_x(3, 8) = coef_x(3, 8) + coef_xy(1, 9)*pol_y(2, 0, jg) + coef_x(4, 8) = coef_x(4, 8) + coef_xy(2, 9)*pol_y(2, 0, jg) + coef_x(1, 9) = coef_x(1, 9) + coef_xy(1, 10)*pol_y(1, 0, jg) + coef_x(2, 9) = coef_x(2, 9) + coef_xy(2, 10)*pol_y(1, 0, jg) + coef_x(3, 9) = coef_x(3, 9) + coef_xy(1, 10)*pol_y(2, 0, jg) + coef_x(4, 9) = coef_x(4, 9) + coef_xy(2, 10)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 11)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 11)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 11)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 11)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 12)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 12)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 12)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 12)*pol_y(2, 1, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 13)*pol_y(1, 1, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 13)*pol_y(1, 1, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 13)*pol_y(2, 1, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 13)*pol_y(2, 1, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 14)*pol_y(1, 1, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 14)*pol_y(1, 1, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 14)*pol_y(2, 1, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 14)*pol_y(2, 1, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 15)*pol_y(1, 1, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 15)*pol_y(1, 1, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 15)*pol_y(2, 1, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 15)*pol_y(2, 1, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 16)*pol_y(1, 1, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 16)*pol_y(1, 1, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 16)*pol_y(2, 1, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 16)*pol_y(2, 1, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 17)*pol_y(1, 1, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 17)*pol_y(1, 1, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 17)*pol_y(2, 1, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 17)*pol_y(2, 1, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 18)*pol_y(1, 1, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 18)*pol_y(1, 1, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 18)*pol_y(2, 1, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 18)*pol_y(2, 1, jg) + coef_x(1, 8) = coef_x(1, 8) + coef_xy(1, 19)*pol_y(1, 1, jg) + coef_x(2, 8) = coef_x(2, 8) + coef_xy(2, 19)*pol_y(1, 1, jg) + coef_x(3, 8) = coef_x(3, 8) + coef_xy(1, 19)*pol_y(2, 1, jg) + coef_x(4, 8) = coef_x(4, 8) + coef_xy(2, 19)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 20)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 20)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 20)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 20)*pol_y(2, 2, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 21)*pol_y(1, 2, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 21)*pol_y(1, 2, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 21)*pol_y(2, 2, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 21)*pol_y(2, 2, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 22)*pol_y(1, 2, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 22)*pol_y(1, 2, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 22)*pol_y(2, 2, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 22)*pol_y(2, 2, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 23)*pol_y(1, 2, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 23)*pol_y(1, 2, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 23)*pol_y(2, 2, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 23)*pol_y(2, 2, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 24)*pol_y(1, 2, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 24)*pol_y(1, 2, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 24)*pol_y(2, 2, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 24)*pol_y(2, 2, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 25)*pol_y(1, 2, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 25)*pol_y(1, 2, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 25)*pol_y(2, 2, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 25)*pol_y(2, 2, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 26)*pol_y(1, 2, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 26)*pol_y(1, 2, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 26)*pol_y(2, 2, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 26)*pol_y(2, 2, jg) + coef_x(1, 7) = coef_x(1, 7) + coef_xy(1, 27)*pol_y(1, 2, jg) + coef_x(2, 7) = coef_x(2, 7) + coef_xy(2, 27)*pol_y(1, 2, jg) + coef_x(3, 7) = coef_x(3, 7) + coef_xy(1, 27)*pol_y(2, 2, jg) + coef_x(4, 7) = coef_x(4, 7) + coef_xy(2, 27)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 28)*pol_y(1, 3, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 28)*pol_y(1, 3, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 28)*pol_y(2, 3, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 28)*pol_y(2, 3, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 29)*pol_y(1, 3, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 29)*pol_y(1, 3, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 29)*pol_y(2, 3, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 29)*pol_y(2, 3, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 30)*pol_y(1, 3, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 30)*pol_y(1, 3, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 30)*pol_y(2, 3, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 30)*pol_y(2, 3, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 31)*pol_y(1, 3, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 31)*pol_y(1, 3, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 31)*pol_y(2, 3, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 31)*pol_y(2, 3, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 32)*pol_y(1, 3, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 32)*pol_y(1, 3, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 32)*pol_y(2, 3, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 32)*pol_y(2, 3, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 33)*pol_y(1, 3, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 33)*pol_y(1, 3, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 33)*pol_y(2, 3, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 33)*pol_y(2, 3, jg) + coef_x(1, 6) = coef_x(1, 6) + coef_xy(1, 34)*pol_y(1, 3, jg) + coef_x(2, 6) = coef_x(2, 6) + coef_xy(2, 34)*pol_y(1, 3, jg) + coef_x(3, 6) = coef_x(3, 6) + coef_xy(1, 34)*pol_y(2, 3, jg) + coef_x(4, 6) = coef_x(4, 6) + coef_xy(2, 34)*pol_y(2, 3, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 35)*pol_y(1, 4, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 35)*pol_y(1, 4, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 35)*pol_y(2, 4, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 35)*pol_y(2, 4, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 36)*pol_y(1, 4, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 36)*pol_y(1, 4, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 36)*pol_y(2, 4, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 36)*pol_y(2, 4, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 37)*pol_y(1, 4, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 37)*pol_y(1, 4, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 37)*pol_y(2, 4, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 37)*pol_y(2, 4, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 38)*pol_y(1, 4, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 38)*pol_y(1, 4, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 38)*pol_y(2, 4, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 38)*pol_y(2, 4, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 39)*pol_y(1, 4, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 39)*pol_y(1, 4, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 39)*pol_y(2, 4, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 39)*pol_y(2, 4, jg) + coef_x(1, 5) = coef_x(1, 5) + coef_xy(1, 40)*pol_y(1, 4, jg) + coef_x(2, 5) = coef_x(2, 5) + coef_xy(2, 40)*pol_y(1, 4, jg) + coef_x(3, 5) = coef_x(3, 5) + coef_xy(1, 40)*pol_y(2, 4, jg) + coef_x(4, 5) = coef_x(4, 5) + coef_xy(2, 40)*pol_y(2, 4, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 41)*pol_y(1, 5, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 41)*pol_y(1, 5, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 41)*pol_y(2, 5, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 41)*pol_y(2, 5, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 42)*pol_y(1, 5, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 42)*pol_y(1, 5, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 42)*pol_y(2, 5, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 42)*pol_y(2, 5, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 43)*pol_y(1, 5, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 43)*pol_y(1, 5, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 43)*pol_y(2, 5, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 43)*pol_y(2, 5, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 44)*pol_y(1, 5, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 44)*pol_y(1, 5, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 44)*pol_y(2, 5, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 44)*pol_y(2, 5, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 45)*pol_y(1, 5, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 45)*pol_y(1, 5, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 45)*pol_y(2, 5, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 45)*pol_y(2, 5, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 46)*pol_y(1, 6, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 46)*pol_y(1, 6, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 46)*pol_y(2, 6, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 46)*pol_y(2, 6, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 47)*pol_y(1, 6, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 47)*pol_y(1, 6, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 47)*pol_y(2, 6, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 47)*pol_y(2, 6, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 48)*pol_y(1, 6, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 48)*pol_y(1, 6, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 48)*pol_y(2, 6, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 48)*pol_y(2, 6, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 49)*pol_y(1, 6, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 49)*pol_y(1, 6, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 49)*pol_y(2, 6, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 49)*pol_y(2, 6, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 50)*pol_y(1, 7, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 50)*pol_y(1, 7, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 50)*pol_y(2, 7, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 50)*pol_y(2, 7, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 51)*pol_y(1, 7, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 51)*pol_y(1, 7, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 51)*pol_y(2, 7, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 51)*pol_y(2, 7, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 52)*pol_y(1, 7, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 52)*pol_y(1, 7, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 52)*pol_y(2, 7, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 52)*pol_y(2, 7, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 53)*pol_y(1, 8, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 53)*pol_y(1, 8, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 53)*pol_y(2, 8, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 53)*pol_y(2, 8, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 54)*pol_y(1, 8, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 54)*pol_y(1, 8, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 54)*pol_y(2, 8, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 54)*pol_y(2, 8, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 55)*pol_y(1, 9, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 55)*pol_y(1, 9, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 55)*pol_y(2, 9, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 55)*pol_y(2, 9, jg) DO ig = igmin, igmax i = map(ig, 1) s(:) = 0.0_dp - s(:) = s(:)+coef_x(:, 0)*pol_x(0, ig) - s(:) = s(:)+coef_x(:, 1)*pol_x(1, ig) - s(:) = s(:)+coef_x(:, 2)*pol_x(2, ig) - s(:) = s(:)+coef_x(:, 3)*pol_x(3, ig) - s(:) = s(:)+coef_x(:, 4)*pol_x(4, ig) - s(:) = s(:)+coef_x(:, 5)*pol_x(5, ig) - s(:) = s(:)+coef_x(:, 6)*pol_x(6, ig) - s(:) = s(:)+coef_x(:, 7)*pol_x(7, ig) - s(:) = s(:)+coef_x(:, 8)*pol_x(8, ig) - s(:) = s(:)+coef_x(:, 9)*pol_x(9, ig) - grid(i, j, k) = grid(i, j, k)+s(1) - grid(i, j2, k) = grid(i, j2, k)+s(3) - grid(i, j, k2) = grid(i, j, k2)+s(2) - grid(i, j2, k2) = grid(i, j2, k2)+s(4) + s(:) = s(:) + coef_x(:, 0)*pol_x(0, ig) + s(:) = s(:) + coef_x(:, 1)*pol_x(1, ig) + s(:) = s(:) + coef_x(:, 2)*pol_x(2, ig) + s(:) = s(:) + coef_x(:, 3)*pol_x(3, ig) + s(:) = s(:) + coef_x(:, 4)*pol_x(4, ig) + s(:) = s(:) + coef_x(:, 5)*pol_x(5, ig) + s(:) = s(:) + coef_x(:, 6)*pol_x(6, ig) + s(:) = s(:) + coef_x(:, 7)*pol_x(7, ig) + s(:) = s(:) + coef_x(:, 8)*pol_x(8, ig) + s(:) = s(:) + coef_x(:, 9)*pol_x(9, ig) + grid(i, j, k) = grid(i, j, k) + s(1) + grid(i, j2, k) = grid(i, j2, k) + s(3) + grid(i, j, k2) = grid(i, j, k2) + s(2) + grid(i, j2, k2) = grid(i, j2, k2) + s(4) END DO END DO END DO diff --git a/src/grid/collocate_fast_6.f90 b/src/grid/collocate_fast_6.f90 index 65189dc8fd..76b6f738dd 100644 --- a/src/grid/collocate_fast_6.f90 +++ b/src/grid/collocate_fast_6.f90 @@ -14,7 +14,7 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bounds, lp, cmax, gridbounds) USE kinds, ONLY: dp INTEGER, INTENT(IN) :: sphere_bounds(*), lp - REAL(dp), INTENT(IN) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(IN) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER, INTENT(IN) :: cmax REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & @@ -29,15 +29,15 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) @@ -45,35 +45,35 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_xyz(lxyz)*pol_z(1, lzp, kg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_xyz(lxyz)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_xyz(lxyz)*pol_z(1, lzp, kg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_xyz(lxyz)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_x(1, lxp) = coef_x(1, lxp)+coef_xy(1, lxy)*pol_y(1, lyp, jg) - coef_x(2, lxp) = coef_x(2, lxp)+coef_xy(2, lxy)*pol_y(1, lyp, jg) - coef_x(3, lxp) = coef_x(3, lxp)+coef_xy(1, lxy)*pol_y(2, lyp, jg) - coef_x(4, lxp) = coef_x(4, lxp)+coef_xy(2, lxy)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_x(1, lxp) = coef_x(1, lxp) + coef_xy(1, lxy)*pol_y(1, lyp, jg) + coef_x(2, lxp) = coef_x(2, lxp) + coef_xy(2, lxy)*pol_y(1, lyp, jg) + coef_x(3, lxp) = coef_x(3, lxp) + coef_xy(1, lxy)*pol_y(2, lyp, jg) + coef_x(4, lxp) = coef_x(4, lxp) + coef_xy(2, lxy)*pol_y(2, lyp, jg) ENDDO ENDDO @@ -84,15 +84,15 @@ SUBROUTINE collocate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe s03 = 0.0_dp s04 = 0.0_dp DO lxp = 0, lp - s01 = s01+coef_x(1, lxp)*pol_x(lxp, ig) - s02 = s02+coef_x(2, lxp)*pol_x(lxp, ig) - s03 = s03+coef_x(3, lxp)*pol_x(lxp, ig) - s04 = s04+coef_x(4, lxp)*pol_x(lxp, ig) + s01 = s01 + coef_x(1, lxp)*pol_x(lxp, ig) + s02 = s02 + coef_x(2, lxp)*pol_x(lxp, ig) + s03 = s03 + coef_x(3, lxp)*pol_x(lxp, ig) + s04 = s04 + coef_x(4, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO @@ -120,53 +120,53 @@ SUBROUTINE collocate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 0 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_xyz(lxyz)*pol_z(1, lzp, kg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_xyz(lxyz)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_xyz(lxyz)*pol_z(1, lzp, kg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_xyz(lxyz)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_x(1:2, lxp) = coef_x(1:2, lxp)+coef_xy(1:2, lxy)*pol_y(1, lyp, jg) - coef_x(3:4, lxp) = coef_x(3:4, lxp)+coef_xy(1:2, lxy)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_x(1:2, lxp) = coef_x(1:2, lxp) + coef_xy(1:2, lxy)*pol_y(1, lyp, jg) + coef_x(3:4, lxp) = coef_x(3:4, lxp) + coef_xy(1:2, lxy)*pol_y(2, lyp, jg) ENDDO ENDDO DO ig = igmin, igmax @@ -175,14 +175,14 @@ SUBROUTINE collocate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -209,60 +209,60 @@ SUBROUTINE collocate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 1 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s(4) sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(1)*pol_z(:, 0, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(2)*pol_z(:, 0, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(3)*pol_z(:, 0, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(4)*pol_z(:, 1, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(1)*pol_z(:, 0, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(2)*pol_z(:, 0, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(3)*pol_z(:, 0, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(4)*pol_z(:, 1, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 3)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 3)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 3)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 3)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 3)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 3)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 3)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 3)*pol_y(2, 1, jg) DO ig = igmin, igmax i = map(ig, 1) s(:) = 0.0_dp DO lxp = 0, lp - s(:) = s(:)+coef_x(:, lxp)*pol_x(lxp, ig) + s(:) = s(:) + coef_x(:, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s(1) - grid(i, j2, k) = grid(i, j2, k)+s(3) - grid(i, j, k2) = grid(i, j, k2)+s(2) - grid(i, j2, k2) = grid(i, j2, k2)+s(4) + grid(i, j, k) = grid(i, j, k) + s(1) + grid(i, j2, k) = grid(i, j2, k) + s(3) + grid(i, j, k2) = grid(i, j, k2) + s(2) + grid(i, j2, k2) = grid(i, j2, k2) + s(4) END DO END DO END DO @@ -289,69 +289,69 @@ SUBROUTINE collocate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 2 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s(4) sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_xyz(lxyz)*pol_z(1, lzp, kg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_xyz(lxyz)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_xyz(lxyz)*pol_z(1, lzp, kg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_xyz(lxyz)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 1)*pol_y(1, 0, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 1)*pol_y(2, 0, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 2)*pol_y(1, 0, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 2)*pol_y(2, 0, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 3)*pol_y(1, 0, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 3)*pol_y(2, 0, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 4)*pol_y(1, 1, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 4)*pol_y(2, 1, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 5)*pol_y(1, 1, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 5)*pol_y(2, 1, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 6)*pol_y(1, 2, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 6)*pol_y(2, 2, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 1)*pol_y(1, 0, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 1)*pol_y(2, 0, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 2)*pol_y(1, 0, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 2)*pol_y(2, 0, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 3)*pol_y(1, 0, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 3)*pol_y(2, 0, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 4)*pol_y(1, 1, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 4)*pol_y(2, 1, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 5)*pol_y(1, 1, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 5)*pol_y(2, 1, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 6)*pol_y(1, 2, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 6)*pol_y(2, 2, jg) DO ig = igmin, igmax i = map(ig, 1) s(:) = 0.0_dp - s(:) = s(:)+coef_x(:, 0)*pol_x(0, ig) - s(:) = s(:)+coef_x(:, 1)*pol_x(1, ig) - s(:) = s(:)+coef_x(:, 2)*pol_x(2, ig) - grid(i, j, k) = grid(i, j, k)+s(1) - grid(i, j2, k) = grid(i, j2, k)+s(3) - grid(i, j, k2) = grid(i, j, k2)+s(2) - grid(i, j2, k2) = grid(i, j2, k2)+s(4) + s(:) = s(:) + coef_x(:, 0)*pol_x(0, ig) + s(:) = s(:) + coef_x(:, 1)*pol_x(1, ig) + s(:) = s(:) + coef_x(:, 2)*pol_x(2, ig) + grid(i, j, k) = grid(i, j, k) + s(1) + grid(i, j2, k) = grid(i, j2, k) + s(3) + grid(i, j, k2) = grid(i, j, k2) + s(2) + grid(i, j2, k2) = grid(i, j2, k2) + s(4) END DO END DO END DO @@ -378,54 +378,54 @@ SUBROUTINE collocate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 3 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xy(:, lxy) = coef_xy(:, lxy)+coef_xyz(lxyz)*pol_z(:, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xy(:, lxy) = coef_xy(:, lxy) + coef_xyz(lxyz)*pol_z(:, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_x(1, lxp) = coef_x(1, lxp)+coef_xy(1, lxy)*pol_y(1, lyp, jg) - coef_x(2, lxp) = coef_x(2, lxp)+coef_xy(2, lxy)*pol_y(1, lyp, jg) - coef_x(3, lxp) = coef_x(3, lxp)+coef_xy(1, lxy)*pol_y(2, lyp, jg) - coef_x(4, lxp) = coef_x(4, lxp)+coef_xy(2, lxy)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_x(1, lxp) = coef_x(1, lxp) + coef_xy(1, lxy)*pol_y(1, lyp, jg) + coef_x(2, lxp) = coef_x(2, lxp) + coef_xy(2, lxy)*pol_y(1, lyp, jg) + coef_x(3, lxp) = coef_x(3, lxp) + coef_xy(1, lxy)*pol_y(2, lyp, jg) + coef_x(4, lxp) = coef_x(4, lxp) + coef_xy(2, lxy)*pol_y(2, lyp, jg) ENDDO ENDDO DO ig = igmin, igmax @@ -435,15 +435,15 @@ SUBROUTINE collocate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = 0.0_dp s04 = 0.0_dp DO lxp = 0, lp - s01 = s01+coef_x(1, lxp)*pol_x(lxp, ig) - s02 = s02+coef_x(2, lxp)*pol_x(lxp, ig) - s03 = s03+coef_x(3, lxp)*pol_x(lxp, ig) - s04 = s04+coef_x(4, lxp)*pol_x(lxp, ig) + s01 = s01 + coef_x(1, lxp)*pol_x(lxp, ig) + s02 = s02 + coef_x(2, lxp)*pol_x(lxp, ig) + s03 = s03 + coef_x(3, lxp)*pol_x(lxp, ig) + s04 = s04 + coef_x(4, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -470,174 +470,174 @@ SUBROUTINE collocate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 4 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s(4) sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(7)*pol_z(1, 0, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(7)*pol_z(2, 0, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(8)*pol_z(1, 0, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(8)*pol_z(2, 0, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(9)*pol_z(1, 0, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(9)*pol_z(2, 0, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(10)*pol_z(1, 0, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(10)*pol_z(2, 0, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(11)*pol_z(1, 0, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(11)*pol_z(2, 0, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(12)*pol_z(1, 0, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(12)*pol_z(2, 0, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(13)*pol_z(1, 0, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(13)*pol_z(2, 0, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(14)*pol_z(1, 0, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(14)*pol_z(2, 0, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(15)*pol_z(1, 0, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(15)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(16)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(16)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(17)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(17)*pol_z(2, 1, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(18)*pol_z(1, 1, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(18)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(19)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(19)*pol_z(2, 1, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(20)*pol_z(1, 1, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(20)*pol_z(2, 1, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(21)*pol_z(1, 1, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(21)*pol_z(2, 1, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(22)*pol_z(1, 1, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(22)*pol_z(2, 1, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(23)*pol_z(1, 1, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(23)*pol_z(2, 1, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(24)*pol_z(1, 1, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(24)*pol_z(2, 1, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(25)*pol_z(1, 1, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(25)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(26)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(26)*pol_z(2, 2, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(27)*pol_z(1, 2, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(27)*pol_z(2, 2, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(28)*pol_z(1, 2, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(28)*pol_z(2, 2, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(29)*pol_z(1, 2, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(29)*pol_z(2, 2, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(30)*pol_z(1, 2, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(30)*pol_z(2, 2, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(31)*pol_z(1, 2, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(31)*pol_z(2, 2, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(32)*pol_z(1, 3, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(32)*pol_z(2, 3, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(33)*pol_z(1, 3, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(33)*pol_z(2, 3, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(34)*pol_z(1, 3, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(34)*pol_z(2, 3, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(35)*pol_z(1, 4, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(35)*pol_z(2, 4, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(7)*pol_z(1, 0, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(7)*pol_z(2, 0, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(8)*pol_z(1, 0, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(8)*pol_z(2, 0, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(9)*pol_z(1, 0, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(9)*pol_z(2, 0, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(10)*pol_z(1, 0, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(10)*pol_z(2, 0, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(11)*pol_z(1, 0, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(11)*pol_z(2, 0, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(12)*pol_z(1, 0, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(12)*pol_z(2, 0, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(13)*pol_z(1, 0, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(13)*pol_z(2, 0, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(14)*pol_z(1, 0, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(14)*pol_z(2, 0, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(15)*pol_z(1, 0, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(15)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(16)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(16)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(17)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(17)*pol_z(2, 1, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(18)*pol_z(1, 1, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(18)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(19)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(19)*pol_z(2, 1, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(20)*pol_z(1, 1, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(20)*pol_z(2, 1, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(21)*pol_z(1, 1, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(21)*pol_z(2, 1, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(22)*pol_z(1, 1, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(22)*pol_z(2, 1, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(23)*pol_z(1, 1, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(23)*pol_z(2, 1, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(24)*pol_z(1, 1, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(24)*pol_z(2, 1, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(25)*pol_z(1, 1, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(25)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(26)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(26)*pol_z(2, 2, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(27)*pol_z(1, 2, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(27)*pol_z(2, 2, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(28)*pol_z(1, 2, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(28)*pol_z(2, 2, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(29)*pol_z(1, 2, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(29)*pol_z(2, 2, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(30)*pol_z(1, 2, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(30)*pol_z(2, 2, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(31)*pol_z(1, 2, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(31)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(32)*pol_z(1, 3, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(32)*pol_z(2, 3, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(33)*pol_z(1, 3, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(33)*pol_z(2, 3, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(34)*pol_z(1, 3, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(34)*pol_z(2, 3, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(35)*pol_z(1, 4, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(35)*pol_z(2, 4, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 1)*pol_y(1, 0, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 1)*pol_y(1, 0, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 1)*pol_y(2, 0, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 1)*pol_y(2, 0, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 2)*pol_y(1, 0, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 2)*pol_y(1, 0, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 2)*pol_y(2, 0, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 2)*pol_y(2, 0, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 3)*pol_y(1, 0, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 3)*pol_y(1, 0, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 3)*pol_y(2, 0, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 3)*pol_y(2, 0, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 4)*pol_y(1, 0, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 4)*pol_y(1, 0, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 4)*pol_y(2, 0, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 4)*pol_y(2, 0, jg) - coef_x(1, 4) = coef_x(1, 4)+coef_xy(1, 5)*pol_y(1, 0, jg) - coef_x(2, 4) = coef_x(2, 4)+coef_xy(2, 5)*pol_y(1, 0, jg) - coef_x(3, 4) = coef_x(3, 4)+coef_xy(1, 5)*pol_y(2, 0, jg) - coef_x(4, 4) = coef_x(4, 4)+coef_xy(2, 5)*pol_y(2, 0, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 6)*pol_y(1, 1, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 6)*pol_y(1, 1, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 6)*pol_y(2, 1, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 6)*pol_y(2, 1, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 7)*pol_y(1, 1, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 7)*pol_y(1, 1, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 7)*pol_y(2, 1, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 7)*pol_y(2, 1, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 8)*pol_y(1, 1, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 8)*pol_y(1, 1, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 8)*pol_y(2, 1, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 8)*pol_y(2, 1, jg) - coef_x(1, 3) = coef_x(1, 3)+coef_xy(1, 9)*pol_y(1, 1, jg) - coef_x(2, 3) = coef_x(2, 3)+coef_xy(2, 9)*pol_y(1, 1, jg) - coef_x(3, 3) = coef_x(3, 3)+coef_xy(1, 9)*pol_y(2, 1, jg) - coef_x(4, 3) = coef_x(4, 3)+coef_xy(2, 9)*pol_y(2, 1, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 10)*pol_y(1, 2, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 10)*pol_y(1, 2, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 10)*pol_y(2, 2, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 10)*pol_y(2, 2, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 11)*pol_y(1, 2, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 11)*pol_y(1, 2, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 11)*pol_y(2, 2, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 11)*pol_y(2, 2, jg) - coef_x(1, 2) = coef_x(1, 2)+coef_xy(1, 12)*pol_y(1, 2, jg) - coef_x(2, 2) = coef_x(2, 2)+coef_xy(2, 12)*pol_y(1, 2, jg) - coef_x(3, 2) = coef_x(3, 2)+coef_xy(1, 12)*pol_y(2, 2, jg) - coef_x(4, 2) = coef_x(4, 2)+coef_xy(2, 12)*pol_y(2, 2, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 13)*pol_y(1, 3, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 13)*pol_y(1, 3, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 13)*pol_y(2, 3, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 13)*pol_y(2, 3, jg) - coef_x(1, 1) = coef_x(1, 1)+coef_xy(1, 14)*pol_y(1, 3, jg) - coef_x(2, 1) = coef_x(2, 1)+coef_xy(2, 14)*pol_y(1, 3, jg) - coef_x(3, 1) = coef_x(3, 1)+coef_xy(1, 14)*pol_y(2, 3, jg) - coef_x(4, 1) = coef_x(4, 1)+coef_xy(2, 14)*pol_y(2, 3, jg) - coef_x(1, 0) = coef_x(1, 0)+coef_xy(1, 15)*pol_y(1, 4, jg) - coef_x(2, 0) = coef_x(2, 0)+coef_xy(2, 15)*pol_y(1, 4, jg) - coef_x(3, 0) = coef_x(3, 0)+coef_xy(1, 15)*pol_y(2, 4, jg) - coef_x(4, 0) = coef_x(4, 0)+coef_xy(2, 15)*pol_y(2, 4, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 1)*pol_y(1, 0, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 1)*pol_y(1, 0, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 1)*pol_y(2, 0, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 1)*pol_y(2, 0, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 2)*pol_y(1, 0, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 2)*pol_y(1, 0, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 2)*pol_y(2, 0, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 2)*pol_y(2, 0, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 3)*pol_y(1, 0, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 3)*pol_y(1, 0, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 3)*pol_y(2, 0, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 3)*pol_y(2, 0, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 4)*pol_y(1, 0, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 4)*pol_y(1, 0, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 4)*pol_y(2, 0, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 4)*pol_y(2, 0, jg) + coef_x(1, 4) = coef_x(1, 4) + coef_xy(1, 5)*pol_y(1, 0, jg) + coef_x(2, 4) = coef_x(2, 4) + coef_xy(2, 5)*pol_y(1, 0, jg) + coef_x(3, 4) = coef_x(3, 4) + coef_xy(1, 5)*pol_y(2, 0, jg) + coef_x(4, 4) = coef_x(4, 4) + coef_xy(2, 5)*pol_y(2, 0, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 6)*pol_y(1, 1, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 6)*pol_y(1, 1, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 6)*pol_y(2, 1, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 6)*pol_y(2, 1, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 7)*pol_y(1, 1, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 7)*pol_y(1, 1, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 7)*pol_y(2, 1, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 7)*pol_y(2, 1, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 8)*pol_y(1, 1, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 8)*pol_y(1, 1, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 8)*pol_y(2, 1, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 8)*pol_y(2, 1, jg) + coef_x(1, 3) = coef_x(1, 3) + coef_xy(1, 9)*pol_y(1, 1, jg) + coef_x(2, 3) = coef_x(2, 3) + coef_xy(2, 9)*pol_y(1, 1, jg) + coef_x(3, 3) = coef_x(3, 3) + coef_xy(1, 9)*pol_y(2, 1, jg) + coef_x(4, 3) = coef_x(4, 3) + coef_xy(2, 9)*pol_y(2, 1, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 10)*pol_y(1, 2, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 10)*pol_y(1, 2, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 10)*pol_y(2, 2, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 10)*pol_y(2, 2, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 11)*pol_y(1, 2, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 11)*pol_y(1, 2, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 11)*pol_y(2, 2, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 11)*pol_y(2, 2, jg) + coef_x(1, 2) = coef_x(1, 2) + coef_xy(1, 12)*pol_y(1, 2, jg) + coef_x(2, 2) = coef_x(2, 2) + coef_xy(2, 12)*pol_y(1, 2, jg) + coef_x(3, 2) = coef_x(3, 2) + coef_xy(1, 12)*pol_y(2, 2, jg) + coef_x(4, 2) = coef_x(4, 2) + coef_xy(2, 12)*pol_y(2, 2, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 13)*pol_y(1, 3, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 13)*pol_y(1, 3, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 13)*pol_y(2, 3, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 13)*pol_y(2, 3, jg) + coef_x(1, 1) = coef_x(1, 1) + coef_xy(1, 14)*pol_y(1, 3, jg) + coef_x(2, 1) = coef_x(2, 1) + coef_xy(2, 14)*pol_y(1, 3, jg) + coef_x(3, 1) = coef_x(3, 1) + coef_xy(1, 14)*pol_y(2, 3, jg) + coef_x(4, 1) = coef_x(4, 1) + coef_xy(2, 14)*pol_y(2, 3, jg) + coef_x(1, 0) = coef_x(1, 0) + coef_xy(1, 15)*pol_y(1, 4, jg) + coef_x(2, 0) = coef_x(2, 0) + coef_xy(2, 15)*pol_y(1, 4, jg) + coef_x(3, 0) = coef_x(3, 0) + coef_xy(1, 15)*pol_y(2, 4, jg) + coef_x(4, 0) = coef_x(4, 0) + coef_xy(2, 15)*pol_y(2, 4, jg) DO ig = igmin, igmax i = map(ig, 1) s(:) = 0.0_dp DO lxp = 0, lp - s(:) = s(:)+coef_x(:, lxp)*pol_x(lxp, ig) + s(:) = s(:) + coef_x(:, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s(1) - grid(i, j2, k) = grid(i, j2, k)+s(3) - grid(i, j, k2) = grid(i, j, k2)+s(2) - grid(i, j2, k2) = grid(i, j2, k2)+s(4) + grid(i, j, k) = grid(i, j, k) + s(1) + grid(i, j2, k) = grid(i, j2, k) + s(3) + grid(i, j, k2) = grid(i, j, k2) + s(2) + grid(i, j2, k2) = grid(i, j2, k2) + s(4) END DO END DO END DO @@ -664,132 +664,132 @@ SUBROUTINE collocate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 5 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(1)*pol_z(:, 0, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(2)*pol_z(:, 0, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(3)*pol_z(:, 0, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(4)*pol_z(:, 0, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(5)*pol_z(:, 0, kg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_xyz(6)*pol_z(:, 0, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(7)*pol_z(:, 0, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(8)*pol_z(:, 0, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(9)*pol_z(:, 0, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(10)*pol_z(:, 0, kg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_xyz(11)*pol_z(:, 0, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(12)*pol_z(:, 0, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(13)*pol_z(:, 0, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(14)*pol_z(:, 0, kg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_xyz(15)*pol_z(:, 0, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(16)*pol_z(:, 0, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(17)*pol_z(:, 0, kg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_xyz(18)*pol_z(:, 0, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(19)*pol_z(:, 0, kg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_xyz(20)*pol_z(:, 0, kg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_xyz(21)*pol_z(:, 0, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(22)*pol_z(:, 1, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(23)*pol_z(:, 1, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(24)*pol_z(:, 1, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(25)*pol_z(:, 1, kg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_xyz(26)*pol_z(:, 1, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(27)*pol_z(:, 1, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(28)*pol_z(:, 1, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(29)*pol_z(:, 1, kg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_xyz(30)*pol_z(:, 1, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(31)*pol_z(:, 1, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(32)*pol_z(:, 1, kg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_xyz(33)*pol_z(:, 1, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(34)*pol_z(:, 1, kg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_xyz(35)*pol_z(:, 1, kg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_xyz(36)*pol_z(:, 1, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(37)*pol_z(:, 2, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(38)*pol_z(:, 2, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(39)*pol_z(:, 2, kg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_xyz(40)*pol_z(:, 2, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(41)*pol_z(:, 2, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(42)*pol_z(:, 2, kg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_xyz(43)*pol_z(:, 2, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(44)*pol_z(:, 2, kg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_xyz(45)*pol_z(:, 2, kg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_xyz(46)*pol_z(:, 2, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(47)*pol_z(:, 3, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(48)*pol_z(:, 3, kg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_xyz(49)*pol_z(:, 3, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(50)*pol_z(:, 3, kg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_xyz(51)*pol_z(:, 3, kg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_xyz(52)*pol_z(:, 3, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(53)*pol_z(:, 4, kg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_xyz(54)*pol_z(:, 4, kg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_xyz(55)*pol_z(:, 4, kg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_xyz(56)*pol_z(:, 5, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(1)*pol_z(:, 0, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(2)*pol_z(:, 0, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(3)*pol_z(:, 0, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(4)*pol_z(:, 0, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(5)*pol_z(:, 0, kg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_xyz(6)*pol_z(:, 0, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(7)*pol_z(:, 0, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(8)*pol_z(:, 0, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(9)*pol_z(:, 0, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(10)*pol_z(:, 0, kg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_xyz(11)*pol_z(:, 0, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(12)*pol_z(:, 0, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(13)*pol_z(:, 0, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(14)*pol_z(:, 0, kg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_xyz(15)*pol_z(:, 0, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(16)*pol_z(:, 0, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(17)*pol_z(:, 0, kg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_xyz(18)*pol_z(:, 0, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(19)*pol_z(:, 0, kg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_xyz(20)*pol_z(:, 0, kg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_xyz(21)*pol_z(:, 0, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(22)*pol_z(:, 1, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(23)*pol_z(:, 1, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(24)*pol_z(:, 1, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(25)*pol_z(:, 1, kg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_xyz(26)*pol_z(:, 1, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(27)*pol_z(:, 1, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(28)*pol_z(:, 1, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(29)*pol_z(:, 1, kg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_xyz(30)*pol_z(:, 1, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(31)*pol_z(:, 1, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(32)*pol_z(:, 1, kg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_xyz(33)*pol_z(:, 1, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(34)*pol_z(:, 1, kg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_xyz(35)*pol_z(:, 1, kg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_xyz(36)*pol_z(:, 1, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(37)*pol_z(:, 2, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(38)*pol_z(:, 2, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(39)*pol_z(:, 2, kg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_xyz(40)*pol_z(:, 2, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(41)*pol_z(:, 2, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(42)*pol_z(:, 2, kg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_xyz(43)*pol_z(:, 2, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(44)*pol_z(:, 2, kg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_xyz(45)*pol_z(:, 2, kg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_xyz(46)*pol_z(:, 2, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(47)*pol_z(:, 3, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(48)*pol_z(:, 3, kg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_xyz(49)*pol_z(:, 3, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(50)*pol_z(:, 3, kg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_xyz(51)*pol_z(:, 3, kg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_xyz(52)*pol_z(:, 3, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(53)*pol_z(:, 4, kg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_xyz(54)*pol_z(:, 4, kg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_xyz(55)*pol_z(:, 4, kg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_xyz(56)*pol_z(:, 5, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 1)*pol_y(1, 0, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 1)*pol_y(2, 0, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 2)*pol_y(1, 0, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 2)*pol_y(2, 0, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 3)*pol_y(1, 0, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 3)*pol_y(2, 0, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 4)*pol_y(1, 0, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 4)*pol_y(2, 0, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 5)*pol_y(1, 0, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 5)*pol_y(2, 0, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 6)*pol_y(1, 0, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 6)*pol_y(2, 0, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 7)*pol_y(1, 1, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 7)*pol_y(2, 1, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 8)*pol_y(1, 1, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 8)*pol_y(2, 1, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 9)*pol_y(1, 1, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 9)*pol_y(2, 1, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 10)*pol_y(1, 1, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 10)*pol_y(2, 1, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 11)*pol_y(1, 1, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 11)*pol_y(2, 1, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 12)*pol_y(1, 2, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 12)*pol_y(2, 2, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 13)*pol_y(1, 2, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 13)*pol_y(2, 2, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 14)*pol_y(1, 2, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 14)*pol_y(2, 2, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 15)*pol_y(1, 2, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 15)*pol_y(2, 2, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 16)*pol_y(1, 3, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 16)*pol_y(2, 3, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 17)*pol_y(1, 3, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 17)*pol_y(2, 3, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 18)*pol_y(1, 3, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 18)*pol_y(2, 3, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 19)*pol_y(1, 4, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 19)*pol_y(2, 4, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 20)*pol_y(1, 4, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 20)*pol_y(2, 4, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 21)*pol_y(1, 5, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 21)*pol_y(2, 5, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 1)*pol_y(1, 0, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 1)*pol_y(2, 0, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 2)*pol_y(1, 0, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 2)*pol_y(2, 0, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 3)*pol_y(1, 0, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 3)*pol_y(2, 0, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 4)*pol_y(1, 0, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 4)*pol_y(2, 0, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 5)*pol_y(1, 0, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 5)*pol_y(2, 0, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 6)*pol_y(1, 0, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 6)*pol_y(2, 0, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 7)*pol_y(1, 1, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 7)*pol_y(2, 1, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 8)*pol_y(1, 1, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 8)*pol_y(2, 1, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 9)*pol_y(1, 1, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 9)*pol_y(2, 1, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 10)*pol_y(1, 1, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 10)*pol_y(2, 1, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 11)*pol_y(1, 1, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 11)*pol_y(2, 1, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 12)*pol_y(1, 2, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 12)*pol_y(2, 2, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 13)*pol_y(1, 2, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 13)*pol_y(2, 2, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 14)*pol_y(1, 2, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 14)*pol_y(2, 2, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 15)*pol_y(1, 2, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 15)*pol_y(2, 2, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 16)*pol_y(1, 3, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 16)*pol_y(2, 3, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 17)*pol_y(1, 3, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 17)*pol_y(2, 3, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 18)*pol_y(1, 3, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 18)*pol_y(2, 3, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 19)*pol_y(1, 4, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 19)*pol_y(2, 4, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 20)*pol_y(1, 4, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 20)*pol_y(2, 4, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 21)*pol_y(1, 5, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 21)*pol_y(2, 5, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp @@ -797,15 +797,15 @@ SUBROUTINE collocate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = 0.0_dp s04 = 0.0_dp DO lxp = 0, lp - s01 = s01+coef_x(1, lxp)*pol_x(lxp, ig) - s02 = s02+coef_x(2, lxp)*pol_x(lxp, ig) - s03 = s03+coef_x(3, lxp)*pol_x(lxp, ig) - s04 = s04+coef_x(4, lxp)*pol_x(lxp, ig) + s01 = s01 + coef_x(1, lxp)*pol_x(lxp, ig) + s02 = s02 + coef_x(2, lxp)*pol_x(lxp, ig) + s03 = s03 + coef_x(3, lxp)*pol_x(lxp, ig) + s04 = s04 + coef_x(4, lxp)*pol_x(lxp, ig) ENDDO - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -832,272 +832,272 @@ SUBROUTINE collocate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 6 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s(4) sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(7)*pol_z(1, 0, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(7)*pol_z(2, 0, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(8)*pol_z(1, 0, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(8)*pol_z(2, 0, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(9)*pol_z(1, 0, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(9)*pol_z(2, 0, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(10)*pol_z(1, 0, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(10)*pol_z(2, 0, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(11)*pol_z(1, 0, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(11)*pol_z(2, 0, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(12)*pol_z(1, 0, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(12)*pol_z(2, 0, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(13)*pol_z(1, 0, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(13)*pol_z(2, 0, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(14)*pol_z(1, 0, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(14)*pol_z(2, 0, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(15)*pol_z(1, 0, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(15)*pol_z(2, 0, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(16)*pol_z(1, 0, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(16)*pol_z(2, 0, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(17)*pol_z(1, 0, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(17)*pol_z(2, 0, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(18)*pol_z(1, 0, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(18)*pol_z(2, 0, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(19)*pol_z(1, 0, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(19)*pol_z(2, 0, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(20)*pol_z(1, 0, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(20)*pol_z(2, 0, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(21)*pol_z(1, 0, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(21)*pol_z(2, 0, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(22)*pol_z(1, 0, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(22)*pol_z(2, 0, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(23)*pol_z(1, 0, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(23)*pol_z(2, 0, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(24)*pol_z(1, 0, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(24)*pol_z(2, 0, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(25)*pol_z(1, 0, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(25)*pol_z(2, 0, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(26)*pol_z(1, 0, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(26)*pol_z(2, 0, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(27)*pol_z(1, 0, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(27)*pol_z(2, 0, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(28)*pol_z(1, 0, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(28)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(29)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(29)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(30)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(30)*pol_z(2, 1, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(31)*pol_z(1, 1, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(31)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(32)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(32)*pol_z(2, 1, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(33)*pol_z(1, 1, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(33)*pol_z(2, 1, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(34)*pol_z(1, 1, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(34)*pol_z(2, 1, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(35)*pol_z(1, 1, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(35)*pol_z(2, 1, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(36)*pol_z(1, 1, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(36)*pol_z(2, 1, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(37)*pol_z(1, 1, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(37)*pol_z(2, 1, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(38)*pol_z(1, 1, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(38)*pol_z(2, 1, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(39)*pol_z(1, 1, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(39)*pol_z(2, 1, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(40)*pol_z(1, 1, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(40)*pol_z(2, 1, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(41)*pol_z(1, 1, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(41)*pol_z(2, 1, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(42)*pol_z(1, 1, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(42)*pol_z(2, 1, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(43)*pol_z(1, 1, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(43)*pol_z(2, 1, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(44)*pol_z(1, 1, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(44)*pol_z(2, 1, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(45)*pol_z(1, 1, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(45)*pol_z(2, 1, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(46)*pol_z(1, 1, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(46)*pol_z(2, 1, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(47)*pol_z(1, 1, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(47)*pol_z(2, 1, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(48)*pol_z(1, 1, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(48)*pol_z(2, 1, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(49)*pol_z(1, 1, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(49)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(50)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(50)*pol_z(2, 2, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(51)*pol_z(1, 2, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(51)*pol_z(2, 2, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(52)*pol_z(1, 2, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(52)*pol_z(2, 2, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(53)*pol_z(1, 2, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(53)*pol_z(2, 2, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(54)*pol_z(1, 2, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(54)*pol_z(2, 2, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(55)*pol_z(1, 2, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(55)*pol_z(2, 2, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(56)*pol_z(1, 2, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(56)*pol_z(2, 2, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(57)*pol_z(1, 2, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(57)*pol_z(2, 2, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(58)*pol_z(1, 2, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(58)*pol_z(2, 2, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(59)*pol_z(1, 2, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(59)*pol_z(2, 2, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(60)*pol_z(1, 2, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(60)*pol_z(2, 2, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(61)*pol_z(1, 2, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(61)*pol_z(2, 2, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(62)*pol_z(1, 2, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(62)*pol_z(2, 2, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(63)*pol_z(1, 2, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(63)*pol_z(2, 2, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(64)*pol_z(1, 2, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(64)*pol_z(2, 2, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(65)*pol_z(1, 3, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(65)*pol_z(2, 3, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(66)*pol_z(1, 3, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(66)*pol_z(2, 3, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(67)*pol_z(1, 3, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(67)*pol_z(2, 3, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(68)*pol_z(1, 3, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(68)*pol_z(2, 3, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(69)*pol_z(1, 3, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(69)*pol_z(2, 3, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(70)*pol_z(1, 3, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(70)*pol_z(2, 3, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(71)*pol_z(1, 3, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(71)*pol_z(2, 3, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(72)*pol_z(1, 3, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(72)*pol_z(2, 3, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(73)*pol_z(1, 3, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(73)*pol_z(2, 3, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(74)*pol_z(1, 3, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(74)*pol_z(2, 3, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(75)*pol_z(1, 4, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(75)*pol_z(2, 4, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(76)*pol_z(1, 4, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(76)*pol_z(2, 4, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(77)*pol_z(1, 4, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(77)*pol_z(2, 4, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(78)*pol_z(1, 4, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(78)*pol_z(2, 4, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(79)*pol_z(1, 4, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(79)*pol_z(2, 4, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(80)*pol_z(1, 4, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(80)*pol_z(2, 4, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(81)*pol_z(1, 5, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(81)*pol_z(2, 5, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(82)*pol_z(1, 5, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(82)*pol_z(2, 5, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(83)*pol_z(1, 5, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(83)*pol_z(2, 5, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(84)*pol_z(1, 6, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(84)*pol_z(2, 6, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(7)*pol_z(1, 0, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(7)*pol_z(2, 0, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(8)*pol_z(1, 0, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(8)*pol_z(2, 0, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(9)*pol_z(1, 0, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(9)*pol_z(2, 0, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(10)*pol_z(1, 0, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(10)*pol_z(2, 0, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(11)*pol_z(1, 0, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(11)*pol_z(2, 0, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(12)*pol_z(1, 0, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(12)*pol_z(2, 0, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(13)*pol_z(1, 0, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(13)*pol_z(2, 0, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(14)*pol_z(1, 0, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(14)*pol_z(2, 0, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(15)*pol_z(1, 0, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(15)*pol_z(2, 0, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(16)*pol_z(1, 0, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(16)*pol_z(2, 0, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(17)*pol_z(1, 0, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(17)*pol_z(2, 0, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(18)*pol_z(1, 0, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(18)*pol_z(2, 0, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(19)*pol_z(1, 0, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(19)*pol_z(2, 0, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(20)*pol_z(1, 0, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(20)*pol_z(2, 0, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(21)*pol_z(1, 0, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(21)*pol_z(2, 0, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(22)*pol_z(1, 0, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(22)*pol_z(2, 0, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(23)*pol_z(1, 0, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(23)*pol_z(2, 0, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(24)*pol_z(1, 0, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(24)*pol_z(2, 0, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(25)*pol_z(1, 0, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(25)*pol_z(2, 0, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(26)*pol_z(1, 0, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(26)*pol_z(2, 0, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(27)*pol_z(1, 0, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(27)*pol_z(2, 0, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(28)*pol_z(1, 0, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(28)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(29)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(29)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(30)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(30)*pol_z(2, 1, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(31)*pol_z(1, 1, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(31)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(32)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(32)*pol_z(2, 1, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(33)*pol_z(1, 1, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(33)*pol_z(2, 1, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(34)*pol_z(1, 1, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(34)*pol_z(2, 1, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(35)*pol_z(1, 1, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(35)*pol_z(2, 1, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(36)*pol_z(1, 1, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(36)*pol_z(2, 1, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(37)*pol_z(1, 1, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(37)*pol_z(2, 1, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(38)*pol_z(1, 1, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(38)*pol_z(2, 1, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(39)*pol_z(1, 1, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(39)*pol_z(2, 1, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(40)*pol_z(1, 1, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(40)*pol_z(2, 1, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(41)*pol_z(1, 1, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(41)*pol_z(2, 1, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(42)*pol_z(1, 1, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(42)*pol_z(2, 1, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(43)*pol_z(1, 1, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(43)*pol_z(2, 1, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(44)*pol_z(1, 1, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(44)*pol_z(2, 1, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(45)*pol_z(1, 1, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(45)*pol_z(2, 1, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(46)*pol_z(1, 1, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(46)*pol_z(2, 1, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(47)*pol_z(1, 1, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(47)*pol_z(2, 1, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(48)*pol_z(1, 1, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(48)*pol_z(2, 1, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(49)*pol_z(1, 1, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(49)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(50)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(50)*pol_z(2, 2, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(51)*pol_z(1, 2, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(51)*pol_z(2, 2, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(52)*pol_z(1, 2, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(52)*pol_z(2, 2, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(53)*pol_z(1, 2, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(53)*pol_z(2, 2, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(54)*pol_z(1, 2, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(54)*pol_z(2, 2, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(55)*pol_z(1, 2, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(55)*pol_z(2, 2, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(56)*pol_z(1, 2, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(56)*pol_z(2, 2, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(57)*pol_z(1, 2, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(57)*pol_z(2, 2, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(58)*pol_z(1, 2, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(58)*pol_z(2, 2, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(59)*pol_z(1, 2, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(59)*pol_z(2, 2, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(60)*pol_z(1, 2, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(60)*pol_z(2, 2, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(61)*pol_z(1, 2, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(61)*pol_z(2, 2, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(62)*pol_z(1, 2, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(62)*pol_z(2, 2, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(63)*pol_z(1, 2, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(63)*pol_z(2, 2, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(64)*pol_z(1, 2, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(64)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(65)*pol_z(1, 3, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(65)*pol_z(2, 3, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(66)*pol_z(1, 3, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(66)*pol_z(2, 3, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(67)*pol_z(1, 3, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(67)*pol_z(2, 3, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(68)*pol_z(1, 3, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(68)*pol_z(2, 3, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(69)*pol_z(1, 3, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(69)*pol_z(2, 3, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(70)*pol_z(1, 3, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(70)*pol_z(2, 3, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(71)*pol_z(1, 3, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(71)*pol_z(2, 3, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(72)*pol_z(1, 3, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(72)*pol_z(2, 3, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(73)*pol_z(1, 3, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(73)*pol_z(2, 3, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(74)*pol_z(1, 3, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(74)*pol_z(2, 3, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(75)*pol_z(1, 4, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(75)*pol_z(2, 4, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(76)*pol_z(1, 4, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(76)*pol_z(2, 4, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(77)*pol_z(1, 4, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(77)*pol_z(2, 4, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(78)*pol_z(1, 4, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(78)*pol_z(2, 4, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(79)*pol_z(1, 4, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(79)*pol_z(2, 4, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(80)*pol_z(1, 4, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(80)*pol_z(2, 4, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(81)*pol_z(1, 5, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(81)*pol_z(2, 5, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(82)*pol_z(1, 5, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(82)*pol_z(2, 5, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(83)*pol_z(1, 5, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(83)*pol_z(2, 5, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(84)*pol_z(1, 6, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(84)*pol_z(2, 6, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 1)*pol_y(1, 0, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 1)*pol_y(2, 0, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 2)*pol_y(1, 0, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 2)*pol_y(2, 0, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 3)*pol_y(1, 0, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 3)*pol_y(2, 0, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 4)*pol_y(1, 0, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 4)*pol_y(2, 0, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 5)*pol_y(1, 0, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 5)*pol_y(2, 0, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 6)*pol_y(1, 0, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 6)*pol_y(2, 0, jg) - coef_x(1:2, 6) = coef_x(1:2, 6)+coef_xy(1:2, 7)*pol_y(1, 0, jg) - coef_x(3:4, 6) = coef_x(3:4, 6)+coef_xy(1:2, 7)*pol_y(2, 0, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 8)*pol_y(1, 1, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 8)*pol_y(2, 1, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 9)*pol_y(1, 1, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 9)*pol_y(2, 1, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 10)*pol_y(1, 1, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 10)*pol_y(2, 1, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 11)*pol_y(1, 1, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 11)*pol_y(2, 1, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 12)*pol_y(1, 1, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 12)*pol_y(2, 1, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 13)*pol_y(1, 1, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 13)*pol_y(2, 1, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 14)*pol_y(1, 2, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 14)*pol_y(2, 2, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 15)*pol_y(1, 2, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 15)*pol_y(2, 2, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 16)*pol_y(1, 2, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 16)*pol_y(2, 2, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 17)*pol_y(1, 2, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 17)*pol_y(2, 2, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 18)*pol_y(1, 2, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 18)*pol_y(2, 2, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 19)*pol_y(1, 3, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 19)*pol_y(2, 3, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 20)*pol_y(1, 3, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 20)*pol_y(2, 3, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 21)*pol_y(1, 3, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 21)*pol_y(2, 3, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 22)*pol_y(1, 3, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 22)*pol_y(2, 3, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 23)*pol_y(1, 4, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 23)*pol_y(2, 4, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 24)*pol_y(1, 4, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 24)*pol_y(2, 4, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 25)*pol_y(1, 4, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 25)*pol_y(2, 4, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 26)*pol_y(1, 5, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 26)*pol_y(2, 5, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 27)*pol_y(1, 5, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 27)*pol_y(2, 5, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 28)*pol_y(1, 6, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 28)*pol_y(2, 6, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 1)*pol_y(1, 0, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 1)*pol_y(2, 0, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 2)*pol_y(1, 0, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 2)*pol_y(2, 0, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 3)*pol_y(1, 0, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 3)*pol_y(2, 0, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 4)*pol_y(1, 0, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 4)*pol_y(2, 0, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 5)*pol_y(1, 0, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 5)*pol_y(2, 0, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 6)*pol_y(1, 0, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 6)*pol_y(2, 0, jg) + coef_x(1:2, 6) = coef_x(1:2, 6) + coef_xy(1:2, 7)*pol_y(1, 0, jg) + coef_x(3:4, 6) = coef_x(3:4, 6) + coef_xy(1:2, 7)*pol_y(2, 0, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 8)*pol_y(1, 1, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 8)*pol_y(2, 1, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 9)*pol_y(1, 1, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 9)*pol_y(2, 1, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 10)*pol_y(1, 1, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 10)*pol_y(2, 1, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 11)*pol_y(1, 1, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 11)*pol_y(2, 1, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 12)*pol_y(1, 1, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 12)*pol_y(2, 1, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 13)*pol_y(1, 1, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 13)*pol_y(2, 1, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 14)*pol_y(1, 2, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 14)*pol_y(2, 2, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 15)*pol_y(1, 2, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 15)*pol_y(2, 2, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 16)*pol_y(1, 2, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 16)*pol_y(2, 2, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 17)*pol_y(1, 2, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 17)*pol_y(2, 2, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 18)*pol_y(1, 2, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 18)*pol_y(2, 2, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 19)*pol_y(1, 3, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 19)*pol_y(2, 3, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 20)*pol_y(1, 3, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 20)*pol_y(2, 3, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 21)*pol_y(1, 3, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 21)*pol_y(2, 3, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 22)*pol_y(1, 3, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 22)*pol_y(2, 3, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 23)*pol_y(1, 4, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 23)*pol_y(2, 4, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 24)*pol_y(1, 4, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 24)*pol_y(2, 4, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 25)*pol_y(1, 4, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 25)*pol_y(2, 4, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 26)*pol_y(1, 5, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 26)*pol_y(2, 5, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 27)*pol_y(1, 5, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 27)*pol_y(2, 5, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 28)*pol_y(1, 6, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 28)*pol_y(2, 6, jg) DO ig = igmin, igmax i = map(ig, 1) s(:) = 0.0_dp - s(:) = s(:)+coef_x(:, 0)*pol_x(0, ig) - s(:) = s(:)+coef_x(:, 1)*pol_x(1, ig) - s(:) = s(:)+coef_x(:, 2)*pol_x(2, ig) - s(:) = s(:)+coef_x(:, 3)*pol_x(3, ig) - s(:) = s(:)+coef_x(:, 4)*pol_x(4, ig) - s(:) = s(:)+coef_x(:, 5)*pol_x(5, ig) - s(:) = s(:)+coef_x(:, 6)*pol_x(6, ig) - grid(i, j, k) = grid(i, j, k)+s(1) - grid(i, j2, k) = grid(i, j2, k)+s(3) - grid(i, j, k2) = grid(i, j, k2)+s(2) - grid(i, j2, k2) = grid(i, j2, k2)+s(4) + s(:) = s(:) + coef_x(:, 0)*pol_x(0, ig) + s(:) = s(:) + coef_x(:, 1)*pol_x(1, ig) + s(:) = s(:) + coef_x(:, 2)*pol_x(2, ig) + s(:) = s(:) + coef_x(:, 3)*pol_x(3, ig) + s(:) = s(:) + coef_x(:, 4)*pol_x(4, ig) + s(:) = s(:) + coef_x(:, 5)*pol_x(5, ig) + s(:) = s(:) + coef_x(:, 6)*pol_x(6, ig) + grid(i, j, k) = grid(i, j, k) + s(1) + grid(i, j2, k) = grid(i, j2, k) + s(3) + grid(i, j, k2) = grid(i, j, k2) + s(2) + grid(i, j2, k2) = grid(i, j2, k2) + s(4) END DO END DO END DO @@ -1124,388 +1124,388 @@ SUBROUTINE collocate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 7 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(7)*pol_z(1, 0, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(7)*pol_z(2, 0, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(8)*pol_z(1, 0, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(8)*pol_z(2, 0, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(9)*pol_z(1, 0, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(9)*pol_z(2, 0, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(10)*pol_z(1, 0, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(10)*pol_z(2, 0, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(11)*pol_z(1, 0, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(11)*pol_z(2, 0, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(12)*pol_z(1, 0, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(12)*pol_z(2, 0, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(13)*pol_z(1, 0, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(13)*pol_z(2, 0, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(14)*pol_z(1, 0, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(14)*pol_z(2, 0, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(15)*pol_z(1, 0, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(15)*pol_z(2, 0, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(16)*pol_z(1, 0, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(16)*pol_z(2, 0, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(17)*pol_z(1, 0, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(17)*pol_z(2, 0, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(18)*pol_z(1, 0, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(18)*pol_z(2, 0, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(19)*pol_z(1, 0, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(19)*pol_z(2, 0, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(20)*pol_z(1, 0, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(20)*pol_z(2, 0, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(21)*pol_z(1, 0, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(21)*pol_z(2, 0, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(22)*pol_z(1, 0, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(22)*pol_z(2, 0, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(23)*pol_z(1, 0, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(23)*pol_z(2, 0, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(24)*pol_z(1, 0, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(24)*pol_z(2, 0, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(25)*pol_z(1, 0, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(25)*pol_z(2, 0, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(26)*pol_z(1, 0, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(26)*pol_z(2, 0, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(27)*pol_z(1, 0, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(27)*pol_z(2, 0, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(28)*pol_z(1, 0, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(28)*pol_z(2, 0, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(29)*pol_z(1, 0, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(29)*pol_z(2, 0, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(30)*pol_z(1, 0, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(30)*pol_z(2, 0, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(31)*pol_z(1, 0, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(31)*pol_z(2, 0, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(32)*pol_z(1, 0, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(32)*pol_z(2, 0, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(33)*pol_z(1, 0, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(33)*pol_z(2, 0, kg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_xyz(34)*pol_z(1, 0, kg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_xyz(34)*pol_z(2, 0, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(35)*pol_z(1, 0, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(35)*pol_z(2, 0, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(36)*pol_z(1, 0, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(36)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(37)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(37)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(38)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(38)*pol_z(2, 1, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(39)*pol_z(1, 1, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(39)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(40)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(40)*pol_z(2, 1, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(41)*pol_z(1, 1, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(41)*pol_z(2, 1, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(42)*pol_z(1, 1, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(42)*pol_z(2, 1, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(43)*pol_z(1, 1, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(43)*pol_z(2, 1, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(44)*pol_z(1, 1, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(44)*pol_z(2, 1, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(45)*pol_z(1, 1, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(45)*pol_z(2, 1, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(46)*pol_z(1, 1, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(46)*pol_z(2, 1, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(47)*pol_z(1, 1, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(47)*pol_z(2, 1, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(48)*pol_z(1, 1, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(48)*pol_z(2, 1, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(49)*pol_z(1, 1, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(49)*pol_z(2, 1, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(50)*pol_z(1, 1, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(50)*pol_z(2, 1, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(51)*pol_z(1, 1, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(51)*pol_z(2, 1, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(52)*pol_z(1, 1, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(52)*pol_z(2, 1, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(53)*pol_z(1, 1, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(53)*pol_z(2, 1, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(54)*pol_z(1, 1, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(54)*pol_z(2, 1, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(55)*pol_z(1, 1, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(55)*pol_z(2, 1, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(56)*pol_z(1, 1, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(56)*pol_z(2, 1, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(57)*pol_z(1, 1, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(57)*pol_z(2, 1, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(58)*pol_z(1, 1, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(58)*pol_z(2, 1, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(59)*pol_z(1, 1, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(59)*pol_z(2, 1, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(60)*pol_z(1, 1, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(60)*pol_z(2, 1, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(61)*pol_z(1, 1, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(61)*pol_z(2, 1, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(62)*pol_z(1, 1, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(62)*pol_z(2, 1, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(63)*pol_z(1, 1, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(63)*pol_z(2, 1, kg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_xyz(64)*pol_z(1, 1, kg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_xyz(64)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(65)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(65)*pol_z(2, 2, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(66)*pol_z(1, 2, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(66)*pol_z(2, 2, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(67)*pol_z(1, 2, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(67)*pol_z(2, 2, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(68)*pol_z(1, 2, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(68)*pol_z(2, 2, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(69)*pol_z(1, 2, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(69)*pol_z(2, 2, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(70)*pol_z(1, 2, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(70)*pol_z(2, 2, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(71)*pol_z(1, 2, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(71)*pol_z(2, 2, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(72)*pol_z(1, 2, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(72)*pol_z(2, 2, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(73)*pol_z(1, 2, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(73)*pol_z(2, 2, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(74)*pol_z(1, 2, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(74)*pol_z(2, 2, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(75)*pol_z(1, 2, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(75)*pol_z(2, 2, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(76)*pol_z(1, 2, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(76)*pol_z(2, 2, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(77)*pol_z(1, 2, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(77)*pol_z(2, 2, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(78)*pol_z(1, 2, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(78)*pol_z(2, 2, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(79)*pol_z(1, 2, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(79)*pol_z(2, 2, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(80)*pol_z(1, 2, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(80)*pol_z(2, 2, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(81)*pol_z(1, 2, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(81)*pol_z(2, 2, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(82)*pol_z(1, 2, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(82)*pol_z(2, 2, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(83)*pol_z(1, 2, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(83)*pol_z(2, 2, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(84)*pol_z(1, 2, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(84)*pol_z(2, 2, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(85)*pol_z(1, 2, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(85)*pol_z(2, 2, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(86)*pol_z(1, 3, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(86)*pol_z(2, 3, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(87)*pol_z(1, 3, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(87)*pol_z(2, 3, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(88)*pol_z(1, 3, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(88)*pol_z(2, 3, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(89)*pol_z(1, 3, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(89)*pol_z(2, 3, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(90)*pol_z(1, 3, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(90)*pol_z(2, 3, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(91)*pol_z(1, 3, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(91)*pol_z(2, 3, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(92)*pol_z(1, 3, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(92)*pol_z(2, 3, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(93)*pol_z(1, 3, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(93)*pol_z(2, 3, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(94)*pol_z(1, 3, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(94)*pol_z(2, 3, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(95)*pol_z(1, 3, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(95)*pol_z(2, 3, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(96)*pol_z(1, 3, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(96)*pol_z(2, 3, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(97)*pol_z(1, 3, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(97)*pol_z(2, 3, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(98)*pol_z(1, 3, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(98)*pol_z(2, 3, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(99)*pol_z(1, 3, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(99)*pol_z(2, 3, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(100)*pol_z(1, 3, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(100)*pol_z(2, 3, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(101)*pol_z(1, 4, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(101)*pol_z(2, 4, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(102)*pol_z(1, 4, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(102)*pol_z(2, 4, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(103)*pol_z(1, 4, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(103)*pol_z(2, 4, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(104)*pol_z(1, 4, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(104)*pol_z(2, 4, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(105)*pol_z(1, 4, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(105)*pol_z(2, 4, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(106)*pol_z(1, 4, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(106)*pol_z(2, 4, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(107)*pol_z(1, 4, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(107)*pol_z(2, 4, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(108)*pol_z(1, 4, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(108)*pol_z(2, 4, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(109)*pol_z(1, 4, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(109)*pol_z(2, 4, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(110)*pol_z(1, 4, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(110)*pol_z(2, 4, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(111)*pol_z(1, 5, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(111)*pol_z(2, 5, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(112)*pol_z(1, 5, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(112)*pol_z(2, 5, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(113)*pol_z(1, 5, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(113)*pol_z(2, 5, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(114)*pol_z(1, 5, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(114)*pol_z(2, 5, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(115)*pol_z(1, 5, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(115)*pol_z(2, 5, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(116)*pol_z(1, 5, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(116)*pol_z(2, 5, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(117)*pol_z(1, 6, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(117)*pol_z(2, 6, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(118)*pol_z(1, 6, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(118)*pol_z(2, 6, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(119)*pol_z(1, 6, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(119)*pol_z(2, 6, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(120)*pol_z(1, 7, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(120)*pol_z(2, 7, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(7)*pol_z(1, 0, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(7)*pol_z(2, 0, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(8)*pol_z(1, 0, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(8)*pol_z(2, 0, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(9)*pol_z(1, 0, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(9)*pol_z(2, 0, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(10)*pol_z(1, 0, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(10)*pol_z(2, 0, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(11)*pol_z(1, 0, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(11)*pol_z(2, 0, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(12)*pol_z(1, 0, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(12)*pol_z(2, 0, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(13)*pol_z(1, 0, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(13)*pol_z(2, 0, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(14)*pol_z(1, 0, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(14)*pol_z(2, 0, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(15)*pol_z(1, 0, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(15)*pol_z(2, 0, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(16)*pol_z(1, 0, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(16)*pol_z(2, 0, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(17)*pol_z(1, 0, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(17)*pol_z(2, 0, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(18)*pol_z(1, 0, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(18)*pol_z(2, 0, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(19)*pol_z(1, 0, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(19)*pol_z(2, 0, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(20)*pol_z(1, 0, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(20)*pol_z(2, 0, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(21)*pol_z(1, 0, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(21)*pol_z(2, 0, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(22)*pol_z(1, 0, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(22)*pol_z(2, 0, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(23)*pol_z(1, 0, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(23)*pol_z(2, 0, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(24)*pol_z(1, 0, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(24)*pol_z(2, 0, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(25)*pol_z(1, 0, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(25)*pol_z(2, 0, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(26)*pol_z(1, 0, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(26)*pol_z(2, 0, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(27)*pol_z(1, 0, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(27)*pol_z(2, 0, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(28)*pol_z(1, 0, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(28)*pol_z(2, 0, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(29)*pol_z(1, 0, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(29)*pol_z(2, 0, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(30)*pol_z(1, 0, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(30)*pol_z(2, 0, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(31)*pol_z(1, 0, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(31)*pol_z(2, 0, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(32)*pol_z(1, 0, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(32)*pol_z(2, 0, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(33)*pol_z(1, 0, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(33)*pol_z(2, 0, kg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_xyz(34)*pol_z(1, 0, kg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_xyz(34)*pol_z(2, 0, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(35)*pol_z(1, 0, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(35)*pol_z(2, 0, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(36)*pol_z(1, 0, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(36)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(37)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(37)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(38)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(38)*pol_z(2, 1, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(39)*pol_z(1, 1, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(39)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(40)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(40)*pol_z(2, 1, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(41)*pol_z(1, 1, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(41)*pol_z(2, 1, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(42)*pol_z(1, 1, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(42)*pol_z(2, 1, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(43)*pol_z(1, 1, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(43)*pol_z(2, 1, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(44)*pol_z(1, 1, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(44)*pol_z(2, 1, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(45)*pol_z(1, 1, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(45)*pol_z(2, 1, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(46)*pol_z(1, 1, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(46)*pol_z(2, 1, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(47)*pol_z(1, 1, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(47)*pol_z(2, 1, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(48)*pol_z(1, 1, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(48)*pol_z(2, 1, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(49)*pol_z(1, 1, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(49)*pol_z(2, 1, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(50)*pol_z(1, 1, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(50)*pol_z(2, 1, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(51)*pol_z(1, 1, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(51)*pol_z(2, 1, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(52)*pol_z(1, 1, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(52)*pol_z(2, 1, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(53)*pol_z(1, 1, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(53)*pol_z(2, 1, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(54)*pol_z(1, 1, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(54)*pol_z(2, 1, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(55)*pol_z(1, 1, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(55)*pol_z(2, 1, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(56)*pol_z(1, 1, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(56)*pol_z(2, 1, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(57)*pol_z(1, 1, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(57)*pol_z(2, 1, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(58)*pol_z(1, 1, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(58)*pol_z(2, 1, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(59)*pol_z(1, 1, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(59)*pol_z(2, 1, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(60)*pol_z(1, 1, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(60)*pol_z(2, 1, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(61)*pol_z(1, 1, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(61)*pol_z(2, 1, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(62)*pol_z(1, 1, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(62)*pol_z(2, 1, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(63)*pol_z(1, 1, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(63)*pol_z(2, 1, kg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_xyz(64)*pol_z(1, 1, kg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_xyz(64)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(65)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(65)*pol_z(2, 2, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(66)*pol_z(1, 2, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(66)*pol_z(2, 2, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(67)*pol_z(1, 2, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(67)*pol_z(2, 2, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(68)*pol_z(1, 2, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(68)*pol_z(2, 2, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(69)*pol_z(1, 2, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(69)*pol_z(2, 2, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(70)*pol_z(1, 2, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(70)*pol_z(2, 2, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(71)*pol_z(1, 2, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(71)*pol_z(2, 2, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(72)*pol_z(1, 2, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(72)*pol_z(2, 2, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(73)*pol_z(1, 2, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(73)*pol_z(2, 2, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(74)*pol_z(1, 2, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(74)*pol_z(2, 2, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(75)*pol_z(1, 2, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(75)*pol_z(2, 2, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(76)*pol_z(1, 2, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(76)*pol_z(2, 2, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(77)*pol_z(1, 2, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(77)*pol_z(2, 2, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(78)*pol_z(1, 2, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(78)*pol_z(2, 2, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(79)*pol_z(1, 2, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(79)*pol_z(2, 2, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(80)*pol_z(1, 2, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(80)*pol_z(2, 2, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(81)*pol_z(1, 2, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(81)*pol_z(2, 2, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(82)*pol_z(1, 2, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(82)*pol_z(2, 2, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(83)*pol_z(1, 2, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(83)*pol_z(2, 2, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(84)*pol_z(1, 2, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(84)*pol_z(2, 2, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(85)*pol_z(1, 2, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(85)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(86)*pol_z(1, 3, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(86)*pol_z(2, 3, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(87)*pol_z(1, 3, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(87)*pol_z(2, 3, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(88)*pol_z(1, 3, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(88)*pol_z(2, 3, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(89)*pol_z(1, 3, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(89)*pol_z(2, 3, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(90)*pol_z(1, 3, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(90)*pol_z(2, 3, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(91)*pol_z(1, 3, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(91)*pol_z(2, 3, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(92)*pol_z(1, 3, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(92)*pol_z(2, 3, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(93)*pol_z(1, 3, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(93)*pol_z(2, 3, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(94)*pol_z(1, 3, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(94)*pol_z(2, 3, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(95)*pol_z(1, 3, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(95)*pol_z(2, 3, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(96)*pol_z(1, 3, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(96)*pol_z(2, 3, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(97)*pol_z(1, 3, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(97)*pol_z(2, 3, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(98)*pol_z(1, 3, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(98)*pol_z(2, 3, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(99)*pol_z(1, 3, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(99)*pol_z(2, 3, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(100)*pol_z(1, 3, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(100)*pol_z(2, 3, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(101)*pol_z(1, 4, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(101)*pol_z(2, 4, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(102)*pol_z(1, 4, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(102)*pol_z(2, 4, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(103)*pol_z(1, 4, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(103)*pol_z(2, 4, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(104)*pol_z(1, 4, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(104)*pol_z(2, 4, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(105)*pol_z(1, 4, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(105)*pol_z(2, 4, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(106)*pol_z(1, 4, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(106)*pol_z(2, 4, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(107)*pol_z(1, 4, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(107)*pol_z(2, 4, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(108)*pol_z(1, 4, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(108)*pol_z(2, 4, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(109)*pol_z(1, 4, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(109)*pol_z(2, 4, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(110)*pol_z(1, 4, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(110)*pol_z(2, 4, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(111)*pol_z(1, 5, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(111)*pol_z(2, 5, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(112)*pol_z(1, 5, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(112)*pol_z(2, 5, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(113)*pol_z(1, 5, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(113)*pol_z(2, 5, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(114)*pol_z(1, 5, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(114)*pol_z(2, 5, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(115)*pol_z(1, 5, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(115)*pol_z(2, 5, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(116)*pol_z(1, 5, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(116)*pol_z(2, 5, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(117)*pol_z(1, 6, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(117)*pol_z(2, 6, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(118)*pol_z(1, 6, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(118)*pol_z(2, 6, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(119)*pol_z(1, 6, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(119)*pol_z(2, 6, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(120)*pol_z(1, 7, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(120)*pol_z(2, 7, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 1)*pol_y(1, 0, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 1)*pol_y(2, 0, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 2)*pol_y(1, 0, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 2)*pol_y(2, 0, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 3)*pol_y(1, 0, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 3)*pol_y(2, 0, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 4)*pol_y(1, 0, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 4)*pol_y(2, 0, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 5)*pol_y(1, 0, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 5)*pol_y(2, 0, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 6)*pol_y(1, 0, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 6)*pol_y(2, 0, jg) - coef_x(1:2, 6) = coef_x(1:2, 6)+coef_xy(1:2, 7)*pol_y(1, 0, jg) - coef_x(3:4, 6) = coef_x(3:4, 6)+coef_xy(1:2, 7)*pol_y(2, 0, jg) - coef_x(1:2, 7) = coef_x(1:2, 7)+coef_xy(1:2, 8)*pol_y(1, 0, jg) - coef_x(3:4, 7) = coef_x(3:4, 7)+coef_xy(1:2, 8)*pol_y(2, 0, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 9)*pol_y(1, 1, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 9)*pol_y(2, 1, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 10)*pol_y(1, 1, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 10)*pol_y(2, 1, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 11)*pol_y(1, 1, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 11)*pol_y(2, 1, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 12)*pol_y(1, 1, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 12)*pol_y(2, 1, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 13)*pol_y(1, 1, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 13)*pol_y(2, 1, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 14)*pol_y(1, 1, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 14)*pol_y(2, 1, jg) - coef_x(1:2, 6) = coef_x(1:2, 6)+coef_xy(1:2, 15)*pol_y(1, 1, jg) - coef_x(3:4, 6) = coef_x(3:4, 6)+coef_xy(1:2, 15)*pol_y(2, 1, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 16)*pol_y(1, 2, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 16)*pol_y(2, 2, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 17)*pol_y(1, 2, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 17)*pol_y(2, 2, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 18)*pol_y(1, 2, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 18)*pol_y(2, 2, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 19)*pol_y(1, 2, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 19)*pol_y(2, 2, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 20)*pol_y(1, 2, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 20)*pol_y(2, 2, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 21)*pol_y(1, 2, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 21)*pol_y(2, 2, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 22)*pol_y(1, 3, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 22)*pol_y(2, 3, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 23)*pol_y(1, 3, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 23)*pol_y(2, 3, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 24)*pol_y(1, 3, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 24)*pol_y(2, 3, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 25)*pol_y(1, 3, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 25)*pol_y(2, 3, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 26)*pol_y(1, 3, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 26)*pol_y(2, 3, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 27)*pol_y(1, 4, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 27)*pol_y(2, 4, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 28)*pol_y(1, 4, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 28)*pol_y(2, 4, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 29)*pol_y(1, 4, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 29)*pol_y(2, 4, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 30)*pol_y(1, 4, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 30)*pol_y(2, 4, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 31)*pol_y(1, 5, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 31)*pol_y(2, 5, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 32)*pol_y(1, 5, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 32)*pol_y(2, 5, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 33)*pol_y(1, 5, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 33)*pol_y(2, 5, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 34)*pol_y(1, 6, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 34)*pol_y(2, 6, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 35)*pol_y(1, 6, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 35)*pol_y(2, 6, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 36)*pol_y(1, 7, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 36)*pol_y(2, 7, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 1)*pol_y(1, 0, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 1)*pol_y(2, 0, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 2)*pol_y(1, 0, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 2)*pol_y(2, 0, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 3)*pol_y(1, 0, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 3)*pol_y(2, 0, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 4)*pol_y(1, 0, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 4)*pol_y(2, 0, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 5)*pol_y(1, 0, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 5)*pol_y(2, 0, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 6)*pol_y(1, 0, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 6)*pol_y(2, 0, jg) + coef_x(1:2, 6) = coef_x(1:2, 6) + coef_xy(1:2, 7)*pol_y(1, 0, jg) + coef_x(3:4, 6) = coef_x(3:4, 6) + coef_xy(1:2, 7)*pol_y(2, 0, jg) + coef_x(1:2, 7) = coef_x(1:2, 7) + coef_xy(1:2, 8)*pol_y(1, 0, jg) + coef_x(3:4, 7) = coef_x(3:4, 7) + coef_xy(1:2, 8)*pol_y(2, 0, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 9)*pol_y(1, 1, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 9)*pol_y(2, 1, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 10)*pol_y(1, 1, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 10)*pol_y(2, 1, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 11)*pol_y(1, 1, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 11)*pol_y(2, 1, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 12)*pol_y(1, 1, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 12)*pol_y(2, 1, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 13)*pol_y(1, 1, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 13)*pol_y(2, 1, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 14)*pol_y(1, 1, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 14)*pol_y(2, 1, jg) + coef_x(1:2, 6) = coef_x(1:2, 6) + coef_xy(1:2, 15)*pol_y(1, 1, jg) + coef_x(3:4, 6) = coef_x(3:4, 6) + coef_xy(1:2, 15)*pol_y(2, 1, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 16)*pol_y(1, 2, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 16)*pol_y(2, 2, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 17)*pol_y(1, 2, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 17)*pol_y(2, 2, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 18)*pol_y(1, 2, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 18)*pol_y(2, 2, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 19)*pol_y(1, 2, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 19)*pol_y(2, 2, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 20)*pol_y(1, 2, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 20)*pol_y(2, 2, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 21)*pol_y(1, 2, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 21)*pol_y(2, 2, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 22)*pol_y(1, 3, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 22)*pol_y(2, 3, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 23)*pol_y(1, 3, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 23)*pol_y(2, 3, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 24)*pol_y(1, 3, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 24)*pol_y(2, 3, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 25)*pol_y(1, 3, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 25)*pol_y(2, 3, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 26)*pol_y(1, 3, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 26)*pol_y(2, 3, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 27)*pol_y(1, 4, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 27)*pol_y(2, 4, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 28)*pol_y(1, 4, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 28)*pol_y(2, 4, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 29)*pol_y(1, 4, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 29)*pol_y(2, 4, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 30)*pol_y(1, 4, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 30)*pol_y(2, 4, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 31)*pol_y(1, 5, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 31)*pol_y(2, 5, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 32)*pol_y(1, 5, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 32)*pol_y(2, 5, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 33)*pol_y(1, 5, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 33)*pol_y(2, 5, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 34)*pol_y(1, 6, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 34)*pol_y(2, 6, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 35)*pol_y(1, 6, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 35)*pol_y(2, 6, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 36)*pol_y(1, 7, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 36)*pol_y(2, 7, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - s01 = s01+coef_x(1, 4)*pol_x(4, ig) - s02 = s02+coef_x(2, 4)*pol_x(4, ig) - s03 = s03+coef_x(3, 4)*pol_x(4, ig) - s04 = s04+coef_x(4, 4)*pol_x(4, ig) - s01 = s01+coef_x(1, 5)*pol_x(5, ig) - s02 = s02+coef_x(2, 5)*pol_x(5, ig) - s03 = s03+coef_x(3, 5)*pol_x(5, ig) - s04 = s04+coef_x(4, 5)*pol_x(5, ig) - s01 = s01+coef_x(1, 6)*pol_x(6, ig) - s02 = s02+coef_x(2, 6)*pol_x(6, ig) - s03 = s03+coef_x(3, 6)*pol_x(6, ig) - s04 = s04+coef_x(4, 6)*pol_x(6, ig) - s01 = s01+coef_x(1, 7)*pol_x(7, ig) - s02 = s02+coef_x(2, 7)*pol_x(7, ig) - s03 = s03+coef_x(3, 7)*pol_x(7, ig) - s04 = s04+coef_x(4, 7)*pol_x(7, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + s01 = s01 + coef_x(1, 4)*pol_x(4, ig) + s02 = s02 + coef_x(2, 4)*pol_x(4, ig) + s03 = s03 + coef_x(3, 4)*pol_x(4, ig) + s04 = s04 + coef_x(4, 4)*pol_x(4, ig) + s01 = s01 + coef_x(1, 5)*pol_x(5, ig) + s02 = s02 + coef_x(2, 5)*pol_x(5, ig) + s03 = s03 + coef_x(3, 5)*pol_x(5, ig) + s04 = s04 + coef_x(4, 5)*pol_x(5, ig) + s01 = s01 + coef_x(1, 6)*pol_x(6, ig) + s02 = s02 + coef_x(2, 6)*pol_x(6, ig) + s03 = s03 + coef_x(3, 6)*pol_x(6, ig) + s04 = s04 + coef_x(4, 6)*pol_x(6, ig) + s01 = s01 + coef_x(1, 7)*pol_x(7, ig) + s02 = s02 + coef_x(2, 7)*pol_x(7, ig) + s03 = s03 + coef_x(3, 7)*pol_x(7, ig) + s04 = s04 + coef_x(4, 7)*pol_x(7, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -1532,500 +1532,500 @@ SUBROUTINE collocate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 8 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(7)*pol_z(1, 0, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(7)*pol_z(2, 0, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(8)*pol_z(1, 0, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(8)*pol_z(2, 0, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(9)*pol_z(1, 0, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(9)*pol_z(2, 0, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(10)*pol_z(1, 0, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(10)*pol_z(2, 0, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(11)*pol_z(1, 0, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(11)*pol_z(2, 0, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(12)*pol_z(1, 0, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(12)*pol_z(2, 0, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(13)*pol_z(1, 0, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(13)*pol_z(2, 0, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(14)*pol_z(1, 0, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(14)*pol_z(2, 0, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(15)*pol_z(1, 0, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(15)*pol_z(2, 0, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(16)*pol_z(1, 0, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(16)*pol_z(2, 0, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(17)*pol_z(1, 0, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(17)*pol_z(2, 0, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(18)*pol_z(1, 0, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(18)*pol_z(2, 0, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(19)*pol_z(1, 0, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(19)*pol_z(2, 0, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(20)*pol_z(1, 0, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(20)*pol_z(2, 0, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(21)*pol_z(1, 0, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(21)*pol_z(2, 0, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(22)*pol_z(1, 0, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(22)*pol_z(2, 0, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(23)*pol_z(1, 0, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(23)*pol_z(2, 0, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(24)*pol_z(1, 0, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(24)*pol_z(2, 0, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(25)*pol_z(1, 0, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(25)*pol_z(2, 0, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(26)*pol_z(1, 0, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(26)*pol_z(2, 0, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(27)*pol_z(1, 0, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(27)*pol_z(2, 0, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(28)*pol_z(1, 0, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(28)*pol_z(2, 0, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(29)*pol_z(1, 0, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(29)*pol_z(2, 0, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(30)*pol_z(1, 0, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(30)*pol_z(2, 0, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(31)*pol_z(1, 0, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(31)*pol_z(2, 0, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(32)*pol_z(1, 0, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(32)*pol_z(2, 0, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(33)*pol_z(1, 0, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(33)*pol_z(2, 0, kg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_xyz(34)*pol_z(1, 0, kg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_xyz(34)*pol_z(2, 0, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(35)*pol_z(1, 0, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(35)*pol_z(2, 0, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(36)*pol_z(1, 0, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(36)*pol_z(2, 0, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(37)*pol_z(1, 0, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(37)*pol_z(2, 0, kg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_xyz(38)*pol_z(1, 0, kg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_xyz(38)*pol_z(2, 0, kg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_xyz(39)*pol_z(1, 0, kg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_xyz(39)*pol_z(2, 0, kg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_xyz(40)*pol_z(1, 0, kg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_xyz(40)*pol_z(2, 0, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(41)*pol_z(1, 0, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(41)*pol_z(2, 0, kg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_xyz(42)*pol_z(1, 0, kg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_xyz(42)*pol_z(2, 0, kg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_xyz(43)*pol_z(1, 0, kg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_xyz(43)*pol_z(2, 0, kg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_xyz(44)*pol_z(1, 0, kg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_xyz(44)*pol_z(2, 0, kg) - coef_xy(1, 45) = coef_xy(1, 45)+coef_xyz(45)*pol_z(1, 0, kg) - coef_xy(2, 45) = coef_xy(2, 45)+coef_xyz(45)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(46)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(46)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(47)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(47)*pol_z(2, 1, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(48)*pol_z(1, 1, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(48)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(49)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(49)*pol_z(2, 1, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(50)*pol_z(1, 1, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(50)*pol_z(2, 1, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(51)*pol_z(1, 1, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(51)*pol_z(2, 1, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(52)*pol_z(1, 1, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(52)*pol_z(2, 1, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(53)*pol_z(1, 1, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(53)*pol_z(2, 1, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(54)*pol_z(1, 1, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(54)*pol_z(2, 1, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(55)*pol_z(1, 1, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(55)*pol_z(2, 1, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(56)*pol_z(1, 1, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(56)*pol_z(2, 1, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(57)*pol_z(1, 1, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(57)*pol_z(2, 1, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(58)*pol_z(1, 1, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(58)*pol_z(2, 1, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(59)*pol_z(1, 1, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(59)*pol_z(2, 1, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(60)*pol_z(1, 1, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(60)*pol_z(2, 1, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(61)*pol_z(1, 1, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(61)*pol_z(2, 1, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(62)*pol_z(1, 1, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(62)*pol_z(2, 1, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(63)*pol_z(1, 1, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(63)*pol_z(2, 1, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(64)*pol_z(1, 1, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(64)*pol_z(2, 1, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(65)*pol_z(1, 1, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(65)*pol_z(2, 1, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(66)*pol_z(1, 1, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(66)*pol_z(2, 1, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(67)*pol_z(1, 1, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(67)*pol_z(2, 1, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(68)*pol_z(1, 1, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(68)*pol_z(2, 1, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(69)*pol_z(1, 1, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(69)*pol_z(2, 1, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(70)*pol_z(1, 1, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(70)*pol_z(2, 1, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(71)*pol_z(1, 1, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(71)*pol_z(2, 1, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(72)*pol_z(1, 1, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(72)*pol_z(2, 1, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(73)*pol_z(1, 1, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(73)*pol_z(2, 1, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(74)*pol_z(1, 1, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(74)*pol_z(2, 1, kg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_xyz(75)*pol_z(1, 1, kg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_xyz(75)*pol_z(2, 1, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(76)*pol_z(1, 1, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(76)*pol_z(2, 1, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(77)*pol_z(1, 1, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(77)*pol_z(2, 1, kg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_xyz(78)*pol_z(1, 1, kg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_xyz(78)*pol_z(2, 1, kg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_xyz(79)*pol_z(1, 1, kg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_xyz(79)*pol_z(2, 1, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(80)*pol_z(1, 1, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(80)*pol_z(2, 1, kg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_xyz(81)*pol_z(1, 1, kg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_xyz(81)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(82)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(82)*pol_z(2, 2, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(83)*pol_z(1, 2, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(83)*pol_z(2, 2, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(84)*pol_z(1, 2, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(84)*pol_z(2, 2, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(85)*pol_z(1, 2, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(85)*pol_z(2, 2, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(86)*pol_z(1, 2, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(86)*pol_z(2, 2, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(87)*pol_z(1, 2, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(87)*pol_z(2, 2, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(88)*pol_z(1, 2, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(88)*pol_z(2, 2, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(89)*pol_z(1, 2, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(89)*pol_z(2, 2, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(90)*pol_z(1, 2, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(90)*pol_z(2, 2, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(91)*pol_z(1, 2, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(91)*pol_z(2, 2, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(92)*pol_z(1, 2, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(92)*pol_z(2, 2, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(93)*pol_z(1, 2, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(93)*pol_z(2, 2, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(94)*pol_z(1, 2, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(94)*pol_z(2, 2, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(95)*pol_z(1, 2, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(95)*pol_z(2, 2, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(96)*pol_z(1, 2, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(96)*pol_z(2, 2, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(97)*pol_z(1, 2, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(97)*pol_z(2, 2, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(98)*pol_z(1, 2, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(98)*pol_z(2, 2, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(99)*pol_z(1, 2, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(99)*pol_z(2, 2, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(100)*pol_z(1, 2, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(100)*pol_z(2, 2, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(101)*pol_z(1, 2, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(101)*pol_z(2, 2, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(102)*pol_z(1, 2, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(102)*pol_z(2, 2, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(103)*pol_z(1, 2, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(103)*pol_z(2, 2, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(104)*pol_z(1, 2, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(104)*pol_z(2, 2, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(105)*pol_z(1, 2, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(105)*pol_z(2, 2, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(106)*pol_z(1, 2, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(106)*pol_z(2, 2, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(107)*pol_z(1, 2, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(107)*pol_z(2, 2, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(108)*pol_z(1, 2, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(108)*pol_z(2, 2, kg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_xyz(109)*pol_z(1, 2, kg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_xyz(109)*pol_z(2, 2, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(110)*pol_z(1, 3, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(110)*pol_z(2, 3, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(111)*pol_z(1, 3, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(111)*pol_z(2, 3, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(112)*pol_z(1, 3, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(112)*pol_z(2, 3, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(113)*pol_z(1, 3, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(113)*pol_z(2, 3, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(114)*pol_z(1, 3, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(114)*pol_z(2, 3, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(115)*pol_z(1, 3, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(115)*pol_z(2, 3, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(116)*pol_z(1, 3, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(116)*pol_z(2, 3, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(117)*pol_z(1, 3, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(117)*pol_z(2, 3, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(118)*pol_z(1, 3, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(118)*pol_z(2, 3, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(119)*pol_z(1, 3, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(119)*pol_z(2, 3, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(120)*pol_z(1, 3, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(120)*pol_z(2, 3, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(121)*pol_z(1, 3, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(121)*pol_z(2, 3, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(122)*pol_z(1, 3, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(122)*pol_z(2, 3, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(123)*pol_z(1, 3, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(123)*pol_z(2, 3, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(124)*pol_z(1, 3, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(124)*pol_z(2, 3, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(125)*pol_z(1, 3, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(125)*pol_z(2, 3, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(126)*pol_z(1, 3, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(126)*pol_z(2, 3, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(127)*pol_z(1, 3, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(127)*pol_z(2, 3, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(128)*pol_z(1, 3, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(128)*pol_z(2, 3, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(129)*pol_z(1, 3, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(129)*pol_z(2, 3, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(130)*pol_z(1, 3, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(130)*pol_z(2, 3, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(131)*pol_z(1, 4, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(131)*pol_z(2, 4, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(132)*pol_z(1, 4, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(132)*pol_z(2, 4, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(133)*pol_z(1, 4, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(133)*pol_z(2, 4, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(134)*pol_z(1, 4, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(134)*pol_z(2, 4, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(135)*pol_z(1, 4, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(135)*pol_z(2, 4, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(136)*pol_z(1, 4, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(136)*pol_z(2, 4, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(137)*pol_z(1, 4, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(137)*pol_z(2, 4, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(138)*pol_z(1, 4, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(138)*pol_z(2, 4, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(139)*pol_z(1, 4, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(139)*pol_z(2, 4, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(140)*pol_z(1, 4, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(140)*pol_z(2, 4, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(141)*pol_z(1, 4, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(141)*pol_z(2, 4, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(142)*pol_z(1, 4, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(142)*pol_z(2, 4, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(143)*pol_z(1, 4, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(143)*pol_z(2, 4, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(144)*pol_z(1, 4, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(144)*pol_z(2, 4, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(145)*pol_z(1, 4, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(145)*pol_z(2, 4, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(146)*pol_z(1, 5, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(146)*pol_z(2, 5, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(147)*pol_z(1, 5, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(147)*pol_z(2, 5, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(148)*pol_z(1, 5, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(148)*pol_z(2, 5, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(149)*pol_z(1, 5, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(149)*pol_z(2, 5, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(150)*pol_z(1, 5, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(150)*pol_z(2, 5, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(151)*pol_z(1, 5, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(151)*pol_z(2, 5, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(152)*pol_z(1, 5, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(152)*pol_z(2, 5, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(153)*pol_z(1, 5, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(153)*pol_z(2, 5, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(154)*pol_z(1, 5, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(154)*pol_z(2, 5, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(155)*pol_z(1, 5, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(155)*pol_z(2, 5, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(156)*pol_z(1, 6, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(156)*pol_z(2, 6, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(157)*pol_z(1, 6, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(157)*pol_z(2, 6, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(158)*pol_z(1, 6, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(158)*pol_z(2, 6, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(159)*pol_z(1, 6, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(159)*pol_z(2, 6, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(160)*pol_z(1, 6, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(160)*pol_z(2, 6, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(161)*pol_z(1, 6, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(161)*pol_z(2, 6, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(162)*pol_z(1, 7, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(162)*pol_z(2, 7, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(163)*pol_z(1, 7, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(163)*pol_z(2, 7, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(164)*pol_z(1, 7, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(164)*pol_z(2, 7, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(165)*pol_z(1, 8, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(165)*pol_z(2, 8, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(7)*pol_z(1, 0, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(7)*pol_z(2, 0, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(8)*pol_z(1, 0, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(8)*pol_z(2, 0, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(9)*pol_z(1, 0, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(9)*pol_z(2, 0, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(10)*pol_z(1, 0, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(10)*pol_z(2, 0, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(11)*pol_z(1, 0, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(11)*pol_z(2, 0, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(12)*pol_z(1, 0, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(12)*pol_z(2, 0, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(13)*pol_z(1, 0, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(13)*pol_z(2, 0, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(14)*pol_z(1, 0, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(14)*pol_z(2, 0, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(15)*pol_z(1, 0, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(15)*pol_z(2, 0, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(16)*pol_z(1, 0, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(16)*pol_z(2, 0, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(17)*pol_z(1, 0, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(17)*pol_z(2, 0, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(18)*pol_z(1, 0, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(18)*pol_z(2, 0, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(19)*pol_z(1, 0, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(19)*pol_z(2, 0, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(20)*pol_z(1, 0, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(20)*pol_z(2, 0, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(21)*pol_z(1, 0, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(21)*pol_z(2, 0, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(22)*pol_z(1, 0, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(22)*pol_z(2, 0, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(23)*pol_z(1, 0, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(23)*pol_z(2, 0, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(24)*pol_z(1, 0, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(24)*pol_z(2, 0, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(25)*pol_z(1, 0, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(25)*pol_z(2, 0, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(26)*pol_z(1, 0, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(26)*pol_z(2, 0, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(27)*pol_z(1, 0, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(27)*pol_z(2, 0, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(28)*pol_z(1, 0, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(28)*pol_z(2, 0, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(29)*pol_z(1, 0, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(29)*pol_z(2, 0, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(30)*pol_z(1, 0, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(30)*pol_z(2, 0, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(31)*pol_z(1, 0, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(31)*pol_z(2, 0, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(32)*pol_z(1, 0, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(32)*pol_z(2, 0, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(33)*pol_z(1, 0, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(33)*pol_z(2, 0, kg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_xyz(34)*pol_z(1, 0, kg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_xyz(34)*pol_z(2, 0, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(35)*pol_z(1, 0, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(35)*pol_z(2, 0, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(36)*pol_z(1, 0, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(36)*pol_z(2, 0, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(37)*pol_z(1, 0, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(37)*pol_z(2, 0, kg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_xyz(38)*pol_z(1, 0, kg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_xyz(38)*pol_z(2, 0, kg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_xyz(39)*pol_z(1, 0, kg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_xyz(39)*pol_z(2, 0, kg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_xyz(40)*pol_z(1, 0, kg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_xyz(40)*pol_z(2, 0, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(41)*pol_z(1, 0, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(41)*pol_z(2, 0, kg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_xyz(42)*pol_z(1, 0, kg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_xyz(42)*pol_z(2, 0, kg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_xyz(43)*pol_z(1, 0, kg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_xyz(43)*pol_z(2, 0, kg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_xyz(44)*pol_z(1, 0, kg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_xyz(44)*pol_z(2, 0, kg) + coef_xy(1, 45) = coef_xy(1, 45) + coef_xyz(45)*pol_z(1, 0, kg) + coef_xy(2, 45) = coef_xy(2, 45) + coef_xyz(45)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(46)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(46)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(47)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(47)*pol_z(2, 1, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(48)*pol_z(1, 1, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(48)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(49)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(49)*pol_z(2, 1, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(50)*pol_z(1, 1, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(50)*pol_z(2, 1, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(51)*pol_z(1, 1, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(51)*pol_z(2, 1, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(52)*pol_z(1, 1, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(52)*pol_z(2, 1, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(53)*pol_z(1, 1, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(53)*pol_z(2, 1, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(54)*pol_z(1, 1, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(54)*pol_z(2, 1, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(55)*pol_z(1, 1, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(55)*pol_z(2, 1, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(56)*pol_z(1, 1, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(56)*pol_z(2, 1, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(57)*pol_z(1, 1, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(57)*pol_z(2, 1, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(58)*pol_z(1, 1, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(58)*pol_z(2, 1, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(59)*pol_z(1, 1, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(59)*pol_z(2, 1, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(60)*pol_z(1, 1, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(60)*pol_z(2, 1, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(61)*pol_z(1, 1, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(61)*pol_z(2, 1, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(62)*pol_z(1, 1, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(62)*pol_z(2, 1, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(63)*pol_z(1, 1, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(63)*pol_z(2, 1, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(64)*pol_z(1, 1, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(64)*pol_z(2, 1, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(65)*pol_z(1, 1, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(65)*pol_z(2, 1, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(66)*pol_z(1, 1, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(66)*pol_z(2, 1, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(67)*pol_z(1, 1, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(67)*pol_z(2, 1, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(68)*pol_z(1, 1, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(68)*pol_z(2, 1, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(69)*pol_z(1, 1, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(69)*pol_z(2, 1, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(70)*pol_z(1, 1, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(70)*pol_z(2, 1, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(71)*pol_z(1, 1, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(71)*pol_z(2, 1, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(72)*pol_z(1, 1, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(72)*pol_z(2, 1, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(73)*pol_z(1, 1, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(73)*pol_z(2, 1, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(74)*pol_z(1, 1, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(74)*pol_z(2, 1, kg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_xyz(75)*pol_z(1, 1, kg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_xyz(75)*pol_z(2, 1, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(76)*pol_z(1, 1, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(76)*pol_z(2, 1, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(77)*pol_z(1, 1, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(77)*pol_z(2, 1, kg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_xyz(78)*pol_z(1, 1, kg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_xyz(78)*pol_z(2, 1, kg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_xyz(79)*pol_z(1, 1, kg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_xyz(79)*pol_z(2, 1, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(80)*pol_z(1, 1, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(80)*pol_z(2, 1, kg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_xyz(81)*pol_z(1, 1, kg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_xyz(81)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(82)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(82)*pol_z(2, 2, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(83)*pol_z(1, 2, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(83)*pol_z(2, 2, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(84)*pol_z(1, 2, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(84)*pol_z(2, 2, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(85)*pol_z(1, 2, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(85)*pol_z(2, 2, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(86)*pol_z(1, 2, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(86)*pol_z(2, 2, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(87)*pol_z(1, 2, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(87)*pol_z(2, 2, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(88)*pol_z(1, 2, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(88)*pol_z(2, 2, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(89)*pol_z(1, 2, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(89)*pol_z(2, 2, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(90)*pol_z(1, 2, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(90)*pol_z(2, 2, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(91)*pol_z(1, 2, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(91)*pol_z(2, 2, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(92)*pol_z(1, 2, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(92)*pol_z(2, 2, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(93)*pol_z(1, 2, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(93)*pol_z(2, 2, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(94)*pol_z(1, 2, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(94)*pol_z(2, 2, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(95)*pol_z(1, 2, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(95)*pol_z(2, 2, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(96)*pol_z(1, 2, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(96)*pol_z(2, 2, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(97)*pol_z(1, 2, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(97)*pol_z(2, 2, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(98)*pol_z(1, 2, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(98)*pol_z(2, 2, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(99)*pol_z(1, 2, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(99)*pol_z(2, 2, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(100)*pol_z(1, 2, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(100)*pol_z(2, 2, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(101)*pol_z(1, 2, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(101)*pol_z(2, 2, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(102)*pol_z(1, 2, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(102)*pol_z(2, 2, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(103)*pol_z(1, 2, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(103)*pol_z(2, 2, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(104)*pol_z(1, 2, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(104)*pol_z(2, 2, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(105)*pol_z(1, 2, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(105)*pol_z(2, 2, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(106)*pol_z(1, 2, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(106)*pol_z(2, 2, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(107)*pol_z(1, 2, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(107)*pol_z(2, 2, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(108)*pol_z(1, 2, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(108)*pol_z(2, 2, kg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_xyz(109)*pol_z(1, 2, kg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_xyz(109)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(110)*pol_z(1, 3, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(110)*pol_z(2, 3, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(111)*pol_z(1, 3, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(111)*pol_z(2, 3, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(112)*pol_z(1, 3, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(112)*pol_z(2, 3, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(113)*pol_z(1, 3, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(113)*pol_z(2, 3, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(114)*pol_z(1, 3, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(114)*pol_z(2, 3, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(115)*pol_z(1, 3, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(115)*pol_z(2, 3, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(116)*pol_z(1, 3, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(116)*pol_z(2, 3, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(117)*pol_z(1, 3, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(117)*pol_z(2, 3, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(118)*pol_z(1, 3, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(118)*pol_z(2, 3, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(119)*pol_z(1, 3, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(119)*pol_z(2, 3, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(120)*pol_z(1, 3, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(120)*pol_z(2, 3, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(121)*pol_z(1, 3, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(121)*pol_z(2, 3, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(122)*pol_z(1, 3, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(122)*pol_z(2, 3, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(123)*pol_z(1, 3, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(123)*pol_z(2, 3, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(124)*pol_z(1, 3, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(124)*pol_z(2, 3, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(125)*pol_z(1, 3, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(125)*pol_z(2, 3, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(126)*pol_z(1, 3, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(126)*pol_z(2, 3, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(127)*pol_z(1, 3, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(127)*pol_z(2, 3, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(128)*pol_z(1, 3, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(128)*pol_z(2, 3, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(129)*pol_z(1, 3, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(129)*pol_z(2, 3, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(130)*pol_z(1, 3, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(130)*pol_z(2, 3, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(131)*pol_z(1, 4, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(131)*pol_z(2, 4, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(132)*pol_z(1, 4, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(132)*pol_z(2, 4, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(133)*pol_z(1, 4, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(133)*pol_z(2, 4, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(134)*pol_z(1, 4, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(134)*pol_z(2, 4, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(135)*pol_z(1, 4, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(135)*pol_z(2, 4, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(136)*pol_z(1, 4, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(136)*pol_z(2, 4, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(137)*pol_z(1, 4, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(137)*pol_z(2, 4, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(138)*pol_z(1, 4, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(138)*pol_z(2, 4, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(139)*pol_z(1, 4, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(139)*pol_z(2, 4, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(140)*pol_z(1, 4, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(140)*pol_z(2, 4, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(141)*pol_z(1, 4, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(141)*pol_z(2, 4, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(142)*pol_z(1, 4, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(142)*pol_z(2, 4, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(143)*pol_z(1, 4, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(143)*pol_z(2, 4, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(144)*pol_z(1, 4, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(144)*pol_z(2, 4, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(145)*pol_z(1, 4, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(145)*pol_z(2, 4, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(146)*pol_z(1, 5, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(146)*pol_z(2, 5, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(147)*pol_z(1, 5, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(147)*pol_z(2, 5, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(148)*pol_z(1, 5, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(148)*pol_z(2, 5, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(149)*pol_z(1, 5, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(149)*pol_z(2, 5, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(150)*pol_z(1, 5, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(150)*pol_z(2, 5, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(151)*pol_z(1, 5, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(151)*pol_z(2, 5, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(152)*pol_z(1, 5, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(152)*pol_z(2, 5, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(153)*pol_z(1, 5, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(153)*pol_z(2, 5, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(154)*pol_z(1, 5, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(154)*pol_z(2, 5, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(155)*pol_z(1, 5, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(155)*pol_z(2, 5, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(156)*pol_z(1, 6, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(156)*pol_z(2, 6, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(157)*pol_z(1, 6, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(157)*pol_z(2, 6, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(158)*pol_z(1, 6, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(158)*pol_z(2, 6, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(159)*pol_z(1, 6, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(159)*pol_z(2, 6, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(160)*pol_z(1, 6, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(160)*pol_z(2, 6, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(161)*pol_z(1, 6, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(161)*pol_z(2, 6, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(162)*pol_z(1, 7, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(162)*pol_z(2, 7, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(163)*pol_z(1, 7, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(163)*pol_z(2, 7, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(164)*pol_z(1, 7, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(164)*pol_z(2, 7, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(165)*pol_z(1, 8, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(165)*pol_z(2, 8, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 1)*pol_y(1, 0, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 1)*pol_y(2, 0, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 2)*pol_y(1, 0, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 2)*pol_y(2, 0, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 3)*pol_y(1, 0, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 3)*pol_y(2, 0, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 4)*pol_y(1, 0, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 4)*pol_y(2, 0, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 5)*pol_y(1, 0, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 5)*pol_y(2, 0, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 6)*pol_y(1, 0, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 6)*pol_y(2, 0, jg) - coef_x(1:2, 6) = coef_x(1:2, 6)+coef_xy(1:2, 7)*pol_y(1, 0, jg) - coef_x(3:4, 6) = coef_x(3:4, 6)+coef_xy(1:2, 7)*pol_y(2, 0, jg) - coef_x(1:2, 7) = coef_x(1:2, 7)+coef_xy(1:2, 8)*pol_y(1, 0, jg) - coef_x(3:4, 7) = coef_x(3:4, 7)+coef_xy(1:2, 8)*pol_y(2, 0, jg) - coef_x(1:2, 8) = coef_x(1:2, 8)+coef_xy(1:2, 9)*pol_y(1, 0, jg) - coef_x(3:4, 8) = coef_x(3:4, 8)+coef_xy(1:2, 9)*pol_y(2, 0, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 10)*pol_y(1, 1, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 10)*pol_y(2, 1, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 11)*pol_y(1, 1, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 11)*pol_y(2, 1, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 12)*pol_y(1, 1, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 12)*pol_y(2, 1, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 13)*pol_y(1, 1, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 13)*pol_y(2, 1, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 14)*pol_y(1, 1, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 14)*pol_y(2, 1, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 15)*pol_y(1, 1, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 15)*pol_y(2, 1, jg) - coef_x(1:2, 6) = coef_x(1:2, 6)+coef_xy(1:2, 16)*pol_y(1, 1, jg) - coef_x(3:4, 6) = coef_x(3:4, 6)+coef_xy(1:2, 16)*pol_y(2, 1, jg) - coef_x(1:2, 7) = coef_x(1:2, 7)+coef_xy(1:2, 17)*pol_y(1, 1, jg) - coef_x(3:4, 7) = coef_x(3:4, 7)+coef_xy(1:2, 17)*pol_y(2, 1, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 18)*pol_y(1, 2, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 18)*pol_y(2, 2, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 19)*pol_y(1, 2, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 19)*pol_y(2, 2, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 20)*pol_y(1, 2, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 20)*pol_y(2, 2, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 21)*pol_y(1, 2, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 21)*pol_y(2, 2, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 22)*pol_y(1, 2, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 22)*pol_y(2, 2, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 23)*pol_y(1, 2, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 23)*pol_y(2, 2, jg) - coef_x(1:2, 6) = coef_x(1:2, 6)+coef_xy(1:2, 24)*pol_y(1, 2, jg) - coef_x(3:4, 6) = coef_x(3:4, 6)+coef_xy(1:2, 24)*pol_y(2, 2, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 25)*pol_y(1, 3, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 25)*pol_y(2, 3, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 26)*pol_y(1, 3, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 26)*pol_y(2, 3, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 27)*pol_y(1, 3, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 27)*pol_y(2, 3, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 28)*pol_y(1, 3, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 28)*pol_y(2, 3, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 29)*pol_y(1, 3, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 29)*pol_y(2, 3, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 30)*pol_y(1, 3, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 30)*pol_y(2, 3, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 31)*pol_y(1, 4, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 31)*pol_y(2, 4, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 32)*pol_y(1, 4, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 32)*pol_y(2, 4, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 33)*pol_y(1, 4, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 33)*pol_y(2, 4, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 34)*pol_y(1, 4, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 34)*pol_y(2, 4, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 35)*pol_y(1, 4, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 35)*pol_y(2, 4, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 36)*pol_y(1, 5, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 36)*pol_y(2, 5, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 37)*pol_y(1, 5, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 37)*pol_y(2, 5, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 38)*pol_y(1, 5, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 38)*pol_y(2, 5, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 39)*pol_y(1, 5, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 39)*pol_y(2, 5, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 40)*pol_y(1, 6, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 40)*pol_y(2, 6, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 41)*pol_y(1, 6, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 41)*pol_y(2, 6, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 42)*pol_y(1, 6, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 42)*pol_y(2, 6, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 43)*pol_y(1, 7, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 43)*pol_y(2, 7, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 44)*pol_y(1, 7, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 44)*pol_y(2, 7, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 45)*pol_y(1, 8, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 45)*pol_y(2, 8, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 1)*pol_y(1, 0, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 1)*pol_y(2, 0, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 2)*pol_y(1, 0, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 2)*pol_y(2, 0, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 3)*pol_y(1, 0, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 3)*pol_y(2, 0, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 4)*pol_y(1, 0, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 4)*pol_y(2, 0, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 5)*pol_y(1, 0, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 5)*pol_y(2, 0, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 6)*pol_y(1, 0, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 6)*pol_y(2, 0, jg) + coef_x(1:2, 6) = coef_x(1:2, 6) + coef_xy(1:2, 7)*pol_y(1, 0, jg) + coef_x(3:4, 6) = coef_x(3:4, 6) + coef_xy(1:2, 7)*pol_y(2, 0, jg) + coef_x(1:2, 7) = coef_x(1:2, 7) + coef_xy(1:2, 8)*pol_y(1, 0, jg) + coef_x(3:4, 7) = coef_x(3:4, 7) + coef_xy(1:2, 8)*pol_y(2, 0, jg) + coef_x(1:2, 8) = coef_x(1:2, 8) + coef_xy(1:2, 9)*pol_y(1, 0, jg) + coef_x(3:4, 8) = coef_x(3:4, 8) + coef_xy(1:2, 9)*pol_y(2, 0, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 10)*pol_y(1, 1, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 10)*pol_y(2, 1, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 11)*pol_y(1, 1, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 11)*pol_y(2, 1, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 12)*pol_y(1, 1, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 12)*pol_y(2, 1, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 13)*pol_y(1, 1, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 13)*pol_y(2, 1, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 14)*pol_y(1, 1, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 14)*pol_y(2, 1, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 15)*pol_y(1, 1, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 15)*pol_y(2, 1, jg) + coef_x(1:2, 6) = coef_x(1:2, 6) + coef_xy(1:2, 16)*pol_y(1, 1, jg) + coef_x(3:4, 6) = coef_x(3:4, 6) + coef_xy(1:2, 16)*pol_y(2, 1, jg) + coef_x(1:2, 7) = coef_x(1:2, 7) + coef_xy(1:2, 17)*pol_y(1, 1, jg) + coef_x(3:4, 7) = coef_x(3:4, 7) + coef_xy(1:2, 17)*pol_y(2, 1, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 18)*pol_y(1, 2, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 18)*pol_y(2, 2, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 19)*pol_y(1, 2, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 19)*pol_y(2, 2, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 20)*pol_y(1, 2, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 20)*pol_y(2, 2, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 21)*pol_y(1, 2, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 21)*pol_y(2, 2, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 22)*pol_y(1, 2, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 22)*pol_y(2, 2, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 23)*pol_y(1, 2, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 23)*pol_y(2, 2, jg) + coef_x(1:2, 6) = coef_x(1:2, 6) + coef_xy(1:2, 24)*pol_y(1, 2, jg) + coef_x(3:4, 6) = coef_x(3:4, 6) + coef_xy(1:2, 24)*pol_y(2, 2, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 25)*pol_y(1, 3, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 25)*pol_y(2, 3, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 26)*pol_y(1, 3, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 26)*pol_y(2, 3, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 27)*pol_y(1, 3, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 27)*pol_y(2, 3, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 28)*pol_y(1, 3, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 28)*pol_y(2, 3, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 29)*pol_y(1, 3, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 29)*pol_y(2, 3, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 30)*pol_y(1, 3, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 30)*pol_y(2, 3, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 31)*pol_y(1, 4, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 31)*pol_y(2, 4, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 32)*pol_y(1, 4, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 32)*pol_y(2, 4, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 33)*pol_y(1, 4, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 33)*pol_y(2, 4, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 34)*pol_y(1, 4, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 34)*pol_y(2, 4, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 35)*pol_y(1, 4, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 35)*pol_y(2, 4, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 36)*pol_y(1, 5, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 36)*pol_y(2, 5, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 37)*pol_y(1, 5, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 37)*pol_y(2, 5, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 38)*pol_y(1, 5, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 38)*pol_y(2, 5, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 39)*pol_y(1, 5, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 39)*pol_y(2, 5, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 40)*pol_y(1, 6, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 40)*pol_y(2, 6, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 41)*pol_y(1, 6, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 41)*pol_y(2, 6, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 42)*pol_y(1, 6, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 42)*pol_y(2, 6, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 43)*pol_y(1, 7, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 43)*pol_y(2, 7, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 44)*pol_y(1, 7, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 44)*pol_y(2, 7, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 45)*pol_y(1, 8, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 45)*pol_y(2, 8, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - s01 = s01+coef_x(1, 4)*pol_x(4, ig) - s02 = s02+coef_x(2, 4)*pol_x(4, ig) - s03 = s03+coef_x(3, 4)*pol_x(4, ig) - s04 = s04+coef_x(4, 4)*pol_x(4, ig) - s01 = s01+coef_x(1, 5)*pol_x(5, ig) - s02 = s02+coef_x(2, 5)*pol_x(5, ig) - s03 = s03+coef_x(3, 5)*pol_x(5, ig) - s04 = s04+coef_x(4, 5)*pol_x(5, ig) - s01 = s01+coef_x(1, 6)*pol_x(6, ig) - s02 = s02+coef_x(2, 6)*pol_x(6, ig) - s03 = s03+coef_x(3, 6)*pol_x(6, ig) - s04 = s04+coef_x(4, 6)*pol_x(6, ig) - s01 = s01+coef_x(1, 7)*pol_x(7, ig) - s02 = s02+coef_x(2, 7)*pol_x(7, ig) - s03 = s03+coef_x(3, 7)*pol_x(7, ig) - s04 = s04+coef_x(4, 7)*pol_x(7, ig) - s01 = s01+coef_x(1, 8)*pol_x(8, ig) - s02 = s02+coef_x(2, 8)*pol_x(8, ig) - s03 = s03+coef_x(3, 8)*pol_x(8, ig) - s04 = s04+coef_x(4, 8)*pol_x(8, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + s01 = s01 + coef_x(1, 4)*pol_x(4, ig) + s02 = s02 + coef_x(2, 4)*pol_x(4, ig) + s03 = s03 + coef_x(3, 4)*pol_x(4, ig) + s04 = s04 + coef_x(4, 4)*pol_x(4, ig) + s01 = s01 + coef_x(1, 5)*pol_x(5, ig) + s02 = s02 + coef_x(2, 5)*pol_x(5, ig) + s03 = s03 + coef_x(3, 5)*pol_x(5, ig) + s04 = s04 + coef_x(4, 5)*pol_x(5, ig) + s01 = s01 + coef_x(1, 6)*pol_x(6, ig) + s02 = s02 + coef_x(2, 6)*pol_x(6, ig) + s03 = s03 + coef_x(3, 6)*pol_x(6, ig) + s04 = s04 + coef_x(4, 6)*pol_x(6, ig) + s01 = s01 + coef_x(1, 7)*pol_x(7, ig) + s02 = s02 + coef_x(2, 7)*pol_x(7, ig) + s03 = s03 + coef_x(3, 7)*pol_x(7, ig) + s04 = s04 + coef_x(4, 7)*pol_x(7, ig) + s01 = s01 + coef_x(1, 8)*pol_x(8, ig) + s02 = s02 + coef_x(2, 8)*pol_x(8, ig) + s03 = s03 + coef_x(3, 8)*pol_x(8, ig) + s04 = s04 + coef_x(4, 8)*pol_x(8, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO @@ -2052,634 +2052,634 @@ SUBROUTINE collocate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou gridbounds(1, 2):gridbounds(2, 2), gridbounds(1, 3):gridbounds(2, 3)) INTEGER, PARAMETER :: lp = 9 REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), pol_y(1:2, 0:lp, -cmax:0), & - pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + pol_z(1:2, 0:lp, -cmax:0), coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, (lp+1)*(lp+2)/2), & + coef_xy(2, (lp + 1)*(lp + 2)/2), & s01, s02, s03, s04 sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(1)*pol_z(1, 0, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(1)*pol_z(2, 0, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(2)*pol_z(1, 0, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(2)*pol_z(2, 0, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(3)*pol_z(1, 0, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(3)*pol_z(2, 0, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(4)*pol_z(1, 0, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(4)*pol_z(2, 0, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(5)*pol_z(1, 0, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(5)*pol_z(2, 0, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(6)*pol_z(1, 0, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(6)*pol_z(2, 0, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(7)*pol_z(1, 0, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(7)*pol_z(2, 0, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(8)*pol_z(1, 0, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(8)*pol_z(2, 0, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(9)*pol_z(1, 0, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(9)*pol_z(2, 0, kg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_xyz(10)*pol_z(1, 0, kg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_xyz(10)*pol_z(2, 0, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(11)*pol_z(1, 0, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(11)*pol_z(2, 0, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(12)*pol_z(1, 0, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(12)*pol_z(2, 0, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(13)*pol_z(1, 0, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(13)*pol_z(2, 0, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(14)*pol_z(1, 0, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(14)*pol_z(2, 0, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(15)*pol_z(1, 0, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(15)*pol_z(2, 0, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(16)*pol_z(1, 0, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(16)*pol_z(2, 0, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(17)*pol_z(1, 0, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(17)*pol_z(2, 0, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(18)*pol_z(1, 0, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(18)*pol_z(2, 0, kg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_xyz(19)*pol_z(1, 0, kg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_xyz(19)*pol_z(2, 0, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(20)*pol_z(1, 0, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(20)*pol_z(2, 0, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(21)*pol_z(1, 0, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(21)*pol_z(2, 0, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(22)*pol_z(1, 0, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(22)*pol_z(2, 0, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(23)*pol_z(1, 0, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(23)*pol_z(2, 0, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(24)*pol_z(1, 0, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(24)*pol_z(2, 0, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(25)*pol_z(1, 0, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(25)*pol_z(2, 0, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(26)*pol_z(1, 0, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(26)*pol_z(2, 0, kg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_xyz(27)*pol_z(1, 0, kg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_xyz(27)*pol_z(2, 0, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(28)*pol_z(1, 0, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(28)*pol_z(2, 0, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(29)*pol_z(1, 0, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(29)*pol_z(2, 0, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(30)*pol_z(1, 0, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(30)*pol_z(2, 0, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(31)*pol_z(1, 0, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(31)*pol_z(2, 0, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(32)*pol_z(1, 0, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(32)*pol_z(2, 0, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(33)*pol_z(1, 0, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(33)*pol_z(2, 0, kg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_xyz(34)*pol_z(1, 0, kg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_xyz(34)*pol_z(2, 0, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(35)*pol_z(1, 0, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(35)*pol_z(2, 0, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(36)*pol_z(1, 0, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(36)*pol_z(2, 0, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(37)*pol_z(1, 0, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(37)*pol_z(2, 0, kg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_xyz(38)*pol_z(1, 0, kg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_xyz(38)*pol_z(2, 0, kg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_xyz(39)*pol_z(1, 0, kg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_xyz(39)*pol_z(2, 0, kg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_xyz(40)*pol_z(1, 0, kg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_xyz(40)*pol_z(2, 0, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(41)*pol_z(1, 0, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(41)*pol_z(2, 0, kg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_xyz(42)*pol_z(1, 0, kg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_xyz(42)*pol_z(2, 0, kg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_xyz(43)*pol_z(1, 0, kg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_xyz(43)*pol_z(2, 0, kg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_xyz(44)*pol_z(1, 0, kg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_xyz(44)*pol_z(2, 0, kg) - coef_xy(1, 45) = coef_xy(1, 45)+coef_xyz(45)*pol_z(1, 0, kg) - coef_xy(2, 45) = coef_xy(2, 45)+coef_xyz(45)*pol_z(2, 0, kg) - coef_xy(1, 46) = coef_xy(1, 46)+coef_xyz(46)*pol_z(1, 0, kg) - coef_xy(2, 46) = coef_xy(2, 46)+coef_xyz(46)*pol_z(2, 0, kg) - coef_xy(1, 47) = coef_xy(1, 47)+coef_xyz(47)*pol_z(1, 0, kg) - coef_xy(2, 47) = coef_xy(2, 47)+coef_xyz(47)*pol_z(2, 0, kg) - coef_xy(1, 48) = coef_xy(1, 48)+coef_xyz(48)*pol_z(1, 0, kg) - coef_xy(2, 48) = coef_xy(2, 48)+coef_xyz(48)*pol_z(2, 0, kg) - coef_xy(1, 49) = coef_xy(1, 49)+coef_xyz(49)*pol_z(1, 0, kg) - coef_xy(2, 49) = coef_xy(2, 49)+coef_xyz(49)*pol_z(2, 0, kg) - coef_xy(1, 50) = coef_xy(1, 50)+coef_xyz(50)*pol_z(1, 0, kg) - coef_xy(2, 50) = coef_xy(2, 50)+coef_xyz(50)*pol_z(2, 0, kg) - coef_xy(1, 51) = coef_xy(1, 51)+coef_xyz(51)*pol_z(1, 0, kg) - coef_xy(2, 51) = coef_xy(2, 51)+coef_xyz(51)*pol_z(2, 0, kg) - coef_xy(1, 52) = coef_xy(1, 52)+coef_xyz(52)*pol_z(1, 0, kg) - coef_xy(2, 52) = coef_xy(2, 52)+coef_xyz(52)*pol_z(2, 0, kg) - coef_xy(1, 53) = coef_xy(1, 53)+coef_xyz(53)*pol_z(1, 0, kg) - coef_xy(2, 53) = coef_xy(2, 53)+coef_xyz(53)*pol_z(2, 0, kg) - coef_xy(1, 54) = coef_xy(1, 54)+coef_xyz(54)*pol_z(1, 0, kg) - coef_xy(2, 54) = coef_xy(2, 54)+coef_xyz(54)*pol_z(2, 0, kg) - coef_xy(1, 55) = coef_xy(1, 55)+coef_xyz(55)*pol_z(1, 0, kg) - coef_xy(2, 55) = coef_xy(2, 55)+coef_xyz(55)*pol_z(2, 0, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(56)*pol_z(1, 1, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(56)*pol_z(2, 1, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(57)*pol_z(1, 1, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(57)*pol_z(2, 1, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(58)*pol_z(1, 1, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(58)*pol_z(2, 1, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(59)*pol_z(1, 1, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(59)*pol_z(2, 1, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(60)*pol_z(1, 1, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(60)*pol_z(2, 1, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(61)*pol_z(1, 1, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(61)*pol_z(2, 1, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(62)*pol_z(1, 1, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(62)*pol_z(2, 1, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(63)*pol_z(1, 1, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(63)*pol_z(2, 1, kg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_xyz(64)*pol_z(1, 1, kg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_xyz(64)*pol_z(2, 1, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(65)*pol_z(1, 1, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(65)*pol_z(2, 1, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(66)*pol_z(1, 1, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(66)*pol_z(2, 1, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(67)*pol_z(1, 1, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(67)*pol_z(2, 1, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(68)*pol_z(1, 1, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(68)*pol_z(2, 1, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(69)*pol_z(1, 1, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(69)*pol_z(2, 1, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(70)*pol_z(1, 1, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(70)*pol_z(2, 1, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(71)*pol_z(1, 1, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(71)*pol_z(2, 1, kg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_xyz(72)*pol_z(1, 1, kg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_xyz(72)*pol_z(2, 1, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(73)*pol_z(1, 1, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(73)*pol_z(2, 1, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(74)*pol_z(1, 1, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(74)*pol_z(2, 1, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(75)*pol_z(1, 1, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(75)*pol_z(2, 1, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(76)*pol_z(1, 1, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(76)*pol_z(2, 1, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(77)*pol_z(1, 1, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(77)*pol_z(2, 1, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(78)*pol_z(1, 1, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(78)*pol_z(2, 1, kg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_xyz(79)*pol_z(1, 1, kg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_xyz(79)*pol_z(2, 1, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(80)*pol_z(1, 1, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(80)*pol_z(2, 1, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(81)*pol_z(1, 1, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(81)*pol_z(2, 1, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(82)*pol_z(1, 1, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(82)*pol_z(2, 1, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(83)*pol_z(1, 1, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(83)*pol_z(2, 1, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(84)*pol_z(1, 1, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(84)*pol_z(2, 1, kg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_xyz(85)*pol_z(1, 1, kg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_xyz(85)*pol_z(2, 1, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(86)*pol_z(1, 1, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(86)*pol_z(2, 1, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(87)*pol_z(1, 1, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(87)*pol_z(2, 1, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(88)*pol_z(1, 1, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(88)*pol_z(2, 1, kg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_xyz(89)*pol_z(1, 1, kg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_xyz(89)*pol_z(2, 1, kg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_xyz(90)*pol_z(1, 1, kg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_xyz(90)*pol_z(2, 1, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(91)*pol_z(1, 1, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(91)*pol_z(2, 1, kg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_xyz(92)*pol_z(1, 1, kg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_xyz(92)*pol_z(2, 1, kg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_xyz(93)*pol_z(1, 1, kg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_xyz(93)*pol_z(2, 1, kg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_xyz(94)*pol_z(1, 1, kg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_xyz(94)*pol_z(2, 1, kg) - coef_xy(1, 46) = coef_xy(1, 46)+coef_xyz(95)*pol_z(1, 1, kg) - coef_xy(2, 46) = coef_xy(2, 46)+coef_xyz(95)*pol_z(2, 1, kg) - coef_xy(1, 47) = coef_xy(1, 47)+coef_xyz(96)*pol_z(1, 1, kg) - coef_xy(2, 47) = coef_xy(2, 47)+coef_xyz(96)*pol_z(2, 1, kg) - coef_xy(1, 48) = coef_xy(1, 48)+coef_xyz(97)*pol_z(1, 1, kg) - coef_xy(2, 48) = coef_xy(2, 48)+coef_xyz(97)*pol_z(2, 1, kg) - coef_xy(1, 50) = coef_xy(1, 50)+coef_xyz(98)*pol_z(1, 1, kg) - coef_xy(2, 50) = coef_xy(2, 50)+coef_xyz(98)*pol_z(2, 1, kg) - coef_xy(1, 51) = coef_xy(1, 51)+coef_xyz(99)*pol_z(1, 1, kg) - coef_xy(2, 51) = coef_xy(2, 51)+coef_xyz(99)*pol_z(2, 1, kg) - coef_xy(1, 53) = coef_xy(1, 53)+coef_xyz(100)*pol_z(1, 1, kg) - coef_xy(2, 53) = coef_xy(2, 53)+coef_xyz(100)*pol_z(2, 1, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(101)*pol_z(1, 2, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(101)*pol_z(2, 2, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(102)*pol_z(1, 2, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(102)*pol_z(2, 2, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(103)*pol_z(1, 2, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(103)*pol_z(2, 2, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(104)*pol_z(1, 2, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(104)*pol_z(2, 2, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(105)*pol_z(1, 2, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(105)*pol_z(2, 2, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(106)*pol_z(1, 2, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(106)*pol_z(2, 2, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(107)*pol_z(1, 2, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(107)*pol_z(2, 2, kg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_xyz(108)*pol_z(1, 2, kg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_xyz(108)*pol_z(2, 2, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(109)*pol_z(1, 2, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(109)*pol_z(2, 2, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(110)*pol_z(1, 2, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(110)*pol_z(2, 2, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(111)*pol_z(1, 2, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(111)*pol_z(2, 2, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(112)*pol_z(1, 2, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(112)*pol_z(2, 2, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(113)*pol_z(1, 2, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(113)*pol_z(2, 2, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(114)*pol_z(1, 2, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(114)*pol_z(2, 2, kg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_xyz(115)*pol_z(1, 2, kg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_xyz(115)*pol_z(2, 2, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(116)*pol_z(1, 2, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(116)*pol_z(2, 2, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(117)*pol_z(1, 2, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(117)*pol_z(2, 2, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(118)*pol_z(1, 2, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(118)*pol_z(2, 2, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(119)*pol_z(1, 2, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(119)*pol_z(2, 2, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(120)*pol_z(1, 2, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(120)*pol_z(2, 2, kg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_xyz(121)*pol_z(1, 2, kg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_xyz(121)*pol_z(2, 2, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(122)*pol_z(1, 2, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(122)*pol_z(2, 2, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(123)*pol_z(1, 2, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(123)*pol_z(2, 2, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(124)*pol_z(1, 2, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(124)*pol_z(2, 2, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(125)*pol_z(1, 2, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(125)*pol_z(2, 2, kg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_xyz(126)*pol_z(1, 2, kg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_xyz(126)*pol_z(2, 2, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(127)*pol_z(1, 2, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(127)*pol_z(2, 2, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(128)*pol_z(1, 2, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(128)*pol_z(2, 2, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(129)*pol_z(1, 2, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(129)*pol_z(2, 2, kg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_xyz(130)*pol_z(1, 2, kg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_xyz(130)*pol_z(2, 2, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(131)*pol_z(1, 2, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(131)*pol_z(2, 2, kg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_xyz(132)*pol_z(1, 2, kg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_xyz(132)*pol_z(2, 2, kg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_xyz(133)*pol_z(1, 2, kg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_xyz(133)*pol_z(2, 2, kg) - coef_xy(1, 46) = coef_xy(1, 46)+coef_xyz(134)*pol_z(1, 2, kg) - coef_xy(2, 46) = coef_xy(2, 46)+coef_xyz(134)*pol_z(2, 2, kg) - coef_xy(1, 47) = coef_xy(1, 47)+coef_xyz(135)*pol_z(1, 2, kg) - coef_xy(2, 47) = coef_xy(2, 47)+coef_xyz(135)*pol_z(2, 2, kg) - coef_xy(1, 50) = coef_xy(1, 50)+coef_xyz(136)*pol_z(1, 2, kg) - coef_xy(2, 50) = coef_xy(2, 50)+coef_xyz(136)*pol_z(2, 2, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(137)*pol_z(1, 3, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(137)*pol_z(2, 3, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(138)*pol_z(1, 3, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(138)*pol_z(2, 3, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(139)*pol_z(1, 3, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(139)*pol_z(2, 3, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(140)*pol_z(1, 3, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(140)*pol_z(2, 3, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(141)*pol_z(1, 3, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(141)*pol_z(2, 3, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(142)*pol_z(1, 3, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(142)*pol_z(2, 3, kg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_xyz(143)*pol_z(1, 3, kg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_xyz(143)*pol_z(2, 3, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(144)*pol_z(1, 3, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(144)*pol_z(2, 3, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(145)*pol_z(1, 3, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(145)*pol_z(2, 3, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(146)*pol_z(1, 3, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(146)*pol_z(2, 3, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(147)*pol_z(1, 3, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(147)*pol_z(2, 3, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(148)*pol_z(1, 3, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(148)*pol_z(2, 3, kg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_xyz(149)*pol_z(1, 3, kg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_xyz(149)*pol_z(2, 3, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(150)*pol_z(1, 3, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(150)*pol_z(2, 3, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(151)*pol_z(1, 3, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(151)*pol_z(2, 3, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(152)*pol_z(1, 3, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(152)*pol_z(2, 3, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(153)*pol_z(1, 3, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(153)*pol_z(2, 3, kg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_xyz(154)*pol_z(1, 3, kg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_xyz(154)*pol_z(2, 3, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(155)*pol_z(1, 3, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(155)*pol_z(2, 3, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(156)*pol_z(1, 3, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(156)*pol_z(2, 3, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(157)*pol_z(1, 3, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(157)*pol_z(2, 3, kg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_xyz(158)*pol_z(1, 3, kg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_xyz(158)*pol_z(2, 3, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(159)*pol_z(1, 3, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(159)*pol_z(2, 3, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(160)*pol_z(1, 3, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(160)*pol_z(2, 3, kg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_xyz(161)*pol_z(1, 3, kg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_xyz(161)*pol_z(2, 3, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(162)*pol_z(1, 3, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(162)*pol_z(2, 3, kg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_xyz(163)*pol_z(1, 3, kg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_xyz(163)*pol_z(2, 3, kg) - coef_xy(1, 46) = coef_xy(1, 46)+coef_xyz(164)*pol_z(1, 3, kg) - coef_xy(2, 46) = coef_xy(2, 46)+coef_xyz(164)*pol_z(2, 3, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(165)*pol_z(1, 4, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(165)*pol_z(2, 4, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(166)*pol_z(1, 4, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(166)*pol_z(2, 4, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(167)*pol_z(1, 4, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(167)*pol_z(2, 4, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(168)*pol_z(1, 4, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(168)*pol_z(2, 4, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(169)*pol_z(1, 4, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(169)*pol_z(2, 4, kg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_xyz(170)*pol_z(1, 4, kg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_xyz(170)*pol_z(2, 4, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(171)*pol_z(1, 4, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(171)*pol_z(2, 4, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(172)*pol_z(1, 4, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(172)*pol_z(2, 4, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(173)*pol_z(1, 4, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(173)*pol_z(2, 4, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(174)*pol_z(1, 4, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(174)*pol_z(2, 4, kg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_xyz(175)*pol_z(1, 4, kg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_xyz(175)*pol_z(2, 4, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(176)*pol_z(1, 4, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(176)*pol_z(2, 4, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(177)*pol_z(1, 4, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(177)*pol_z(2, 4, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(178)*pol_z(1, 4, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(178)*pol_z(2, 4, kg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_xyz(179)*pol_z(1, 4, kg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_xyz(179)*pol_z(2, 4, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(180)*pol_z(1, 4, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(180)*pol_z(2, 4, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(181)*pol_z(1, 4, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(181)*pol_z(2, 4, kg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_xyz(182)*pol_z(1, 4, kg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_xyz(182)*pol_z(2, 4, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(183)*pol_z(1, 4, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(183)*pol_z(2, 4, kg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_xyz(184)*pol_z(1, 4, kg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_xyz(184)*pol_z(2, 4, kg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_xyz(185)*pol_z(1, 4, kg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_xyz(185)*pol_z(2, 4, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(186)*pol_z(1, 5, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(186)*pol_z(2, 5, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(187)*pol_z(1, 5, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(187)*pol_z(2, 5, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(188)*pol_z(1, 5, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(188)*pol_z(2, 5, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(189)*pol_z(1, 5, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(189)*pol_z(2, 5, kg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_xyz(190)*pol_z(1, 5, kg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_xyz(190)*pol_z(2, 5, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(191)*pol_z(1, 5, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(191)*pol_z(2, 5, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(192)*pol_z(1, 5, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(192)*pol_z(2, 5, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(193)*pol_z(1, 5, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(193)*pol_z(2, 5, kg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_xyz(194)*pol_z(1, 5, kg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_xyz(194)*pol_z(2, 5, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(195)*pol_z(1, 5, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(195)*pol_z(2, 5, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(196)*pol_z(1, 5, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(196)*pol_z(2, 5, kg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_xyz(197)*pol_z(1, 5, kg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_xyz(197)*pol_z(2, 5, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(198)*pol_z(1, 5, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(198)*pol_z(2, 5, kg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_xyz(199)*pol_z(1, 5, kg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_xyz(199)*pol_z(2, 5, kg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_xyz(200)*pol_z(1, 5, kg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_xyz(200)*pol_z(2, 5, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(201)*pol_z(1, 6, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(201)*pol_z(2, 6, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(202)*pol_z(1, 6, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(202)*pol_z(2, 6, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(203)*pol_z(1, 6, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(203)*pol_z(2, 6, kg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_xyz(204)*pol_z(1, 6, kg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_xyz(204)*pol_z(2, 6, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(205)*pol_z(1, 6, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(205)*pol_z(2, 6, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(206)*pol_z(1, 6, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(206)*pol_z(2, 6, kg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_xyz(207)*pol_z(1, 6, kg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_xyz(207)*pol_z(2, 6, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(208)*pol_z(1, 6, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(208)*pol_z(2, 6, kg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_xyz(209)*pol_z(1, 6, kg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_xyz(209)*pol_z(2, 6, kg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_xyz(210)*pol_z(1, 6, kg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_xyz(210)*pol_z(2, 6, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(211)*pol_z(1, 7, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(211)*pol_z(2, 7, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(212)*pol_z(1, 7, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(212)*pol_z(2, 7, kg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_xyz(213)*pol_z(1, 7, kg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_xyz(213)*pol_z(2, 7, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(214)*pol_z(1, 7, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(214)*pol_z(2, 7, kg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_xyz(215)*pol_z(1, 7, kg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_xyz(215)*pol_z(2, 7, kg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_xyz(216)*pol_z(1, 7, kg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_xyz(216)*pol_z(2, 7, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(217)*pol_z(1, 8, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(217)*pol_z(2, 8, kg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_xyz(218)*pol_z(1, 8, kg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_xyz(218)*pol_z(2, 8, kg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_xyz(219)*pol_z(1, 8, kg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_xyz(219)*pol_z(2, 8, kg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_xyz(220)*pol_z(1, 9, kg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_xyz(220)*pol_z(2, 9, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(1)*pol_z(1, 0, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(1)*pol_z(2, 0, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(2)*pol_z(1, 0, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(2)*pol_z(2, 0, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(3)*pol_z(1, 0, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(3)*pol_z(2, 0, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(4)*pol_z(1, 0, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(4)*pol_z(2, 0, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(5)*pol_z(1, 0, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(5)*pol_z(2, 0, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(6)*pol_z(1, 0, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(6)*pol_z(2, 0, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(7)*pol_z(1, 0, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(7)*pol_z(2, 0, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(8)*pol_z(1, 0, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(8)*pol_z(2, 0, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(9)*pol_z(1, 0, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(9)*pol_z(2, 0, kg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_xyz(10)*pol_z(1, 0, kg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_xyz(10)*pol_z(2, 0, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(11)*pol_z(1, 0, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(11)*pol_z(2, 0, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(12)*pol_z(1, 0, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(12)*pol_z(2, 0, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(13)*pol_z(1, 0, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(13)*pol_z(2, 0, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(14)*pol_z(1, 0, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(14)*pol_z(2, 0, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(15)*pol_z(1, 0, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(15)*pol_z(2, 0, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(16)*pol_z(1, 0, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(16)*pol_z(2, 0, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(17)*pol_z(1, 0, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(17)*pol_z(2, 0, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(18)*pol_z(1, 0, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(18)*pol_z(2, 0, kg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_xyz(19)*pol_z(1, 0, kg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_xyz(19)*pol_z(2, 0, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(20)*pol_z(1, 0, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(20)*pol_z(2, 0, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(21)*pol_z(1, 0, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(21)*pol_z(2, 0, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(22)*pol_z(1, 0, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(22)*pol_z(2, 0, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(23)*pol_z(1, 0, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(23)*pol_z(2, 0, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(24)*pol_z(1, 0, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(24)*pol_z(2, 0, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(25)*pol_z(1, 0, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(25)*pol_z(2, 0, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(26)*pol_z(1, 0, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(26)*pol_z(2, 0, kg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_xyz(27)*pol_z(1, 0, kg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_xyz(27)*pol_z(2, 0, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(28)*pol_z(1, 0, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(28)*pol_z(2, 0, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(29)*pol_z(1, 0, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(29)*pol_z(2, 0, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(30)*pol_z(1, 0, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(30)*pol_z(2, 0, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(31)*pol_z(1, 0, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(31)*pol_z(2, 0, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(32)*pol_z(1, 0, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(32)*pol_z(2, 0, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(33)*pol_z(1, 0, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(33)*pol_z(2, 0, kg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_xyz(34)*pol_z(1, 0, kg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_xyz(34)*pol_z(2, 0, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(35)*pol_z(1, 0, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(35)*pol_z(2, 0, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(36)*pol_z(1, 0, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(36)*pol_z(2, 0, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(37)*pol_z(1, 0, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(37)*pol_z(2, 0, kg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_xyz(38)*pol_z(1, 0, kg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_xyz(38)*pol_z(2, 0, kg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_xyz(39)*pol_z(1, 0, kg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_xyz(39)*pol_z(2, 0, kg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_xyz(40)*pol_z(1, 0, kg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_xyz(40)*pol_z(2, 0, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(41)*pol_z(1, 0, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(41)*pol_z(2, 0, kg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_xyz(42)*pol_z(1, 0, kg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_xyz(42)*pol_z(2, 0, kg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_xyz(43)*pol_z(1, 0, kg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_xyz(43)*pol_z(2, 0, kg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_xyz(44)*pol_z(1, 0, kg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_xyz(44)*pol_z(2, 0, kg) + coef_xy(1, 45) = coef_xy(1, 45) + coef_xyz(45)*pol_z(1, 0, kg) + coef_xy(2, 45) = coef_xy(2, 45) + coef_xyz(45)*pol_z(2, 0, kg) + coef_xy(1, 46) = coef_xy(1, 46) + coef_xyz(46)*pol_z(1, 0, kg) + coef_xy(2, 46) = coef_xy(2, 46) + coef_xyz(46)*pol_z(2, 0, kg) + coef_xy(1, 47) = coef_xy(1, 47) + coef_xyz(47)*pol_z(1, 0, kg) + coef_xy(2, 47) = coef_xy(2, 47) + coef_xyz(47)*pol_z(2, 0, kg) + coef_xy(1, 48) = coef_xy(1, 48) + coef_xyz(48)*pol_z(1, 0, kg) + coef_xy(2, 48) = coef_xy(2, 48) + coef_xyz(48)*pol_z(2, 0, kg) + coef_xy(1, 49) = coef_xy(1, 49) + coef_xyz(49)*pol_z(1, 0, kg) + coef_xy(2, 49) = coef_xy(2, 49) + coef_xyz(49)*pol_z(2, 0, kg) + coef_xy(1, 50) = coef_xy(1, 50) + coef_xyz(50)*pol_z(1, 0, kg) + coef_xy(2, 50) = coef_xy(2, 50) + coef_xyz(50)*pol_z(2, 0, kg) + coef_xy(1, 51) = coef_xy(1, 51) + coef_xyz(51)*pol_z(1, 0, kg) + coef_xy(2, 51) = coef_xy(2, 51) + coef_xyz(51)*pol_z(2, 0, kg) + coef_xy(1, 52) = coef_xy(1, 52) + coef_xyz(52)*pol_z(1, 0, kg) + coef_xy(2, 52) = coef_xy(2, 52) + coef_xyz(52)*pol_z(2, 0, kg) + coef_xy(1, 53) = coef_xy(1, 53) + coef_xyz(53)*pol_z(1, 0, kg) + coef_xy(2, 53) = coef_xy(2, 53) + coef_xyz(53)*pol_z(2, 0, kg) + coef_xy(1, 54) = coef_xy(1, 54) + coef_xyz(54)*pol_z(1, 0, kg) + coef_xy(2, 54) = coef_xy(2, 54) + coef_xyz(54)*pol_z(2, 0, kg) + coef_xy(1, 55) = coef_xy(1, 55) + coef_xyz(55)*pol_z(1, 0, kg) + coef_xy(2, 55) = coef_xy(2, 55) + coef_xyz(55)*pol_z(2, 0, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(56)*pol_z(1, 1, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(56)*pol_z(2, 1, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(57)*pol_z(1, 1, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(57)*pol_z(2, 1, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(58)*pol_z(1, 1, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(58)*pol_z(2, 1, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(59)*pol_z(1, 1, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(59)*pol_z(2, 1, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(60)*pol_z(1, 1, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(60)*pol_z(2, 1, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(61)*pol_z(1, 1, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(61)*pol_z(2, 1, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(62)*pol_z(1, 1, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(62)*pol_z(2, 1, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(63)*pol_z(1, 1, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(63)*pol_z(2, 1, kg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_xyz(64)*pol_z(1, 1, kg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_xyz(64)*pol_z(2, 1, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(65)*pol_z(1, 1, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(65)*pol_z(2, 1, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(66)*pol_z(1, 1, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(66)*pol_z(2, 1, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(67)*pol_z(1, 1, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(67)*pol_z(2, 1, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(68)*pol_z(1, 1, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(68)*pol_z(2, 1, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(69)*pol_z(1, 1, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(69)*pol_z(2, 1, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(70)*pol_z(1, 1, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(70)*pol_z(2, 1, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(71)*pol_z(1, 1, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(71)*pol_z(2, 1, kg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_xyz(72)*pol_z(1, 1, kg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_xyz(72)*pol_z(2, 1, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(73)*pol_z(1, 1, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(73)*pol_z(2, 1, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(74)*pol_z(1, 1, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(74)*pol_z(2, 1, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(75)*pol_z(1, 1, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(75)*pol_z(2, 1, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(76)*pol_z(1, 1, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(76)*pol_z(2, 1, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(77)*pol_z(1, 1, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(77)*pol_z(2, 1, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(78)*pol_z(1, 1, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(78)*pol_z(2, 1, kg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_xyz(79)*pol_z(1, 1, kg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_xyz(79)*pol_z(2, 1, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(80)*pol_z(1, 1, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(80)*pol_z(2, 1, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(81)*pol_z(1, 1, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(81)*pol_z(2, 1, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(82)*pol_z(1, 1, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(82)*pol_z(2, 1, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(83)*pol_z(1, 1, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(83)*pol_z(2, 1, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(84)*pol_z(1, 1, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(84)*pol_z(2, 1, kg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_xyz(85)*pol_z(1, 1, kg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_xyz(85)*pol_z(2, 1, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(86)*pol_z(1, 1, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(86)*pol_z(2, 1, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(87)*pol_z(1, 1, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(87)*pol_z(2, 1, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(88)*pol_z(1, 1, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(88)*pol_z(2, 1, kg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_xyz(89)*pol_z(1, 1, kg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_xyz(89)*pol_z(2, 1, kg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_xyz(90)*pol_z(1, 1, kg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_xyz(90)*pol_z(2, 1, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(91)*pol_z(1, 1, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(91)*pol_z(2, 1, kg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_xyz(92)*pol_z(1, 1, kg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_xyz(92)*pol_z(2, 1, kg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_xyz(93)*pol_z(1, 1, kg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_xyz(93)*pol_z(2, 1, kg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_xyz(94)*pol_z(1, 1, kg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_xyz(94)*pol_z(2, 1, kg) + coef_xy(1, 46) = coef_xy(1, 46) + coef_xyz(95)*pol_z(1, 1, kg) + coef_xy(2, 46) = coef_xy(2, 46) + coef_xyz(95)*pol_z(2, 1, kg) + coef_xy(1, 47) = coef_xy(1, 47) + coef_xyz(96)*pol_z(1, 1, kg) + coef_xy(2, 47) = coef_xy(2, 47) + coef_xyz(96)*pol_z(2, 1, kg) + coef_xy(1, 48) = coef_xy(1, 48) + coef_xyz(97)*pol_z(1, 1, kg) + coef_xy(2, 48) = coef_xy(2, 48) + coef_xyz(97)*pol_z(2, 1, kg) + coef_xy(1, 50) = coef_xy(1, 50) + coef_xyz(98)*pol_z(1, 1, kg) + coef_xy(2, 50) = coef_xy(2, 50) + coef_xyz(98)*pol_z(2, 1, kg) + coef_xy(1, 51) = coef_xy(1, 51) + coef_xyz(99)*pol_z(1, 1, kg) + coef_xy(2, 51) = coef_xy(2, 51) + coef_xyz(99)*pol_z(2, 1, kg) + coef_xy(1, 53) = coef_xy(1, 53) + coef_xyz(100)*pol_z(1, 1, kg) + coef_xy(2, 53) = coef_xy(2, 53) + coef_xyz(100)*pol_z(2, 1, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(101)*pol_z(1, 2, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(101)*pol_z(2, 2, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(102)*pol_z(1, 2, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(102)*pol_z(2, 2, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(103)*pol_z(1, 2, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(103)*pol_z(2, 2, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(104)*pol_z(1, 2, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(104)*pol_z(2, 2, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(105)*pol_z(1, 2, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(105)*pol_z(2, 2, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(106)*pol_z(1, 2, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(106)*pol_z(2, 2, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(107)*pol_z(1, 2, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(107)*pol_z(2, 2, kg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_xyz(108)*pol_z(1, 2, kg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_xyz(108)*pol_z(2, 2, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(109)*pol_z(1, 2, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(109)*pol_z(2, 2, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(110)*pol_z(1, 2, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(110)*pol_z(2, 2, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(111)*pol_z(1, 2, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(111)*pol_z(2, 2, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(112)*pol_z(1, 2, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(112)*pol_z(2, 2, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(113)*pol_z(1, 2, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(113)*pol_z(2, 2, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(114)*pol_z(1, 2, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(114)*pol_z(2, 2, kg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_xyz(115)*pol_z(1, 2, kg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_xyz(115)*pol_z(2, 2, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(116)*pol_z(1, 2, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(116)*pol_z(2, 2, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(117)*pol_z(1, 2, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(117)*pol_z(2, 2, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(118)*pol_z(1, 2, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(118)*pol_z(2, 2, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(119)*pol_z(1, 2, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(119)*pol_z(2, 2, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(120)*pol_z(1, 2, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(120)*pol_z(2, 2, kg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_xyz(121)*pol_z(1, 2, kg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_xyz(121)*pol_z(2, 2, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(122)*pol_z(1, 2, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(122)*pol_z(2, 2, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(123)*pol_z(1, 2, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(123)*pol_z(2, 2, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(124)*pol_z(1, 2, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(124)*pol_z(2, 2, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(125)*pol_z(1, 2, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(125)*pol_z(2, 2, kg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_xyz(126)*pol_z(1, 2, kg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_xyz(126)*pol_z(2, 2, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(127)*pol_z(1, 2, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(127)*pol_z(2, 2, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(128)*pol_z(1, 2, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(128)*pol_z(2, 2, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(129)*pol_z(1, 2, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(129)*pol_z(2, 2, kg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_xyz(130)*pol_z(1, 2, kg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_xyz(130)*pol_z(2, 2, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(131)*pol_z(1, 2, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(131)*pol_z(2, 2, kg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_xyz(132)*pol_z(1, 2, kg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_xyz(132)*pol_z(2, 2, kg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_xyz(133)*pol_z(1, 2, kg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_xyz(133)*pol_z(2, 2, kg) + coef_xy(1, 46) = coef_xy(1, 46) + coef_xyz(134)*pol_z(1, 2, kg) + coef_xy(2, 46) = coef_xy(2, 46) + coef_xyz(134)*pol_z(2, 2, kg) + coef_xy(1, 47) = coef_xy(1, 47) + coef_xyz(135)*pol_z(1, 2, kg) + coef_xy(2, 47) = coef_xy(2, 47) + coef_xyz(135)*pol_z(2, 2, kg) + coef_xy(1, 50) = coef_xy(1, 50) + coef_xyz(136)*pol_z(1, 2, kg) + coef_xy(2, 50) = coef_xy(2, 50) + coef_xyz(136)*pol_z(2, 2, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(137)*pol_z(1, 3, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(137)*pol_z(2, 3, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(138)*pol_z(1, 3, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(138)*pol_z(2, 3, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(139)*pol_z(1, 3, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(139)*pol_z(2, 3, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(140)*pol_z(1, 3, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(140)*pol_z(2, 3, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(141)*pol_z(1, 3, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(141)*pol_z(2, 3, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(142)*pol_z(1, 3, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(142)*pol_z(2, 3, kg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_xyz(143)*pol_z(1, 3, kg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_xyz(143)*pol_z(2, 3, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(144)*pol_z(1, 3, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(144)*pol_z(2, 3, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(145)*pol_z(1, 3, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(145)*pol_z(2, 3, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(146)*pol_z(1, 3, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(146)*pol_z(2, 3, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(147)*pol_z(1, 3, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(147)*pol_z(2, 3, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(148)*pol_z(1, 3, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(148)*pol_z(2, 3, kg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_xyz(149)*pol_z(1, 3, kg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_xyz(149)*pol_z(2, 3, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(150)*pol_z(1, 3, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(150)*pol_z(2, 3, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(151)*pol_z(1, 3, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(151)*pol_z(2, 3, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(152)*pol_z(1, 3, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(152)*pol_z(2, 3, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(153)*pol_z(1, 3, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(153)*pol_z(2, 3, kg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_xyz(154)*pol_z(1, 3, kg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_xyz(154)*pol_z(2, 3, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(155)*pol_z(1, 3, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(155)*pol_z(2, 3, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(156)*pol_z(1, 3, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(156)*pol_z(2, 3, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(157)*pol_z(1, 3, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(157)*pol_z(2, 3, kg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_xyz(158)*pol_z(1, 3, kg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_xyz(158)*pol_z(2, 3, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(159)*pol_z(1, 3, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(159)*pol_z(2, 3, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(160)*pol_z(1, 3, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(160)*pol_z(2, 3, kg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_xyz(161)*pol_z(1, 3, kg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_xyz(161)*pol_z(2, 3, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(162)*pol_z(1, 3, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(162)*pol_z(2, 3, kg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_xyz(163)*pol_z(1, 3, kg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_xyz(163)*pol_z(2, 3, kg) + coef_xy(1, 46) = coef_xy(1, 46) + coef_xyz(164)*pol_z(1, 3, kg) + coef_xy(2, 46) = coef_xy(2, 46) + coef_xyz(164)*pol_z(2, 3, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(165)*pol_z(1, 4, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(165)*pol_z(2, 4, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(166)*pol_z(1, 4, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(166)*pol_z(2, 4, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(167)*pol_z(1, 4, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(167)*pol_z(2, 4, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(168)*pol_z(1, 4, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(168)*pol_z(2, 4, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(169)*pol_z(1, 4, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(169)*pol_z(2, 4, kg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_xyz(170)*pol_z(1, 4, kg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_xyz(170)*pol_z(2, 4, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(171)*pol_z(1, 4, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(171)*pol_z(2, 4, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(172)*pol_z(1, 4, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(172)*pol_z(2, 4, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(173)*pol_z(1, 4, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(173)*pol_z(2, 4, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(174)*pol_z(1, 4, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(174)*pol_z(2, 4, kg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_xyz(175)*pol_z(1, 4, kg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_xyz(175)*pol_z(2, 4, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(176)*pol_z(1, 4, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(176)*pol_z(2, 4, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(177)*pol_z(1, 4, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(177)*pol_z(2, 4, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(178)*pol_z(1, 4, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(178)*pol_z(2, 4, kg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_xyz(179)*pol_z(1, 4, kg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_xyz(179)*pol_z(2, 4, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(180)*pol_z(1, 4, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(180)*pol_z(2, 4, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(181)*pol_z(1, 4, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(181)*pol_z(2, 4, kg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_xyz(182)*pol_z(1, 4, kg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_xyz(182)*pol_z(2, 4, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(183)*pol_z(1, 4, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(183)*pol_z(2, 4, kg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_xyz(184)*pol_z(1, 4, kg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_xyz(184)*pol_z(2, 4, kg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_xyz(185)*pol_z(1, 4, kg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_xyz(185)*pol_z(2, 4, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(186)*pol_z(1, 5, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(186)*pol_z(2, 5, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(187)*pol_z(1, 5, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(187)*pol_z(2, 5, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(188)*pol_z(1, 5, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(188)*pol_z(2, 5, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(189)*pol_z(1, 5, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(189)*pol_z(2, 5, kg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_xyz(190)*pol_z(1, 5, kg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_xyz(190)*pol_z(2, 5, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(191)*pol_z(1, 5, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(191)*pol_z(2, 5, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(192)*pol_z(1, 5, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(192)*pol_z(2, 5, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(193)*pol_z(1, 5, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(193)*pol_z(2, 5, kg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_xyz(194)*pol_z(1, 5, kg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_xyz(194)*pol_z(2, 5, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(195)*pol_z(1, 5, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(195)*pol_z(2, 5, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(196)*pol_z(1, 5, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(196)*pol_z(2, 5, kg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_xyz(197)*pol_z(1, 5, kg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_xyz(197)*pol_z(2, 5, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(198)*pol_z(1, 5, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(198)*pol_z(2, 5, kg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_xyz(199)*pol_z(1, 5, kg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_xyz(199)*pol_z(2, 5, kg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_xyz(200)*pol_z(1, 5, kg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_xyz(200)*pol_z(2, 5, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(201)*pol_z(1, 6, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(201)*pol_z(2, 6, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(202)*pol_z(1, 6, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(202)*pol_z(2, 6, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(203)*pol_z(1, 6, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(203)*pol_z(2, 6, kg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_xyz(204)*pol_z(1, 6, kg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_xyz(204)*pol_z(2, 6, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(205)*pol_z(1, 6, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(205)*pol_z(2, 6, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(206)*pol_z(1, 6, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(206)*pol_z(2, 6, kg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_xyz(207)*pol_z(1, 6, kg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_xyz(207)*pol_z(2, 6, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(208)*pol_z(1, 6, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(208)*pol_z(2, 6, kg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_xyz(209)*pol_z(1, 6, kg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_xyz(209)*pol_z(2, 6, kg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_xyz(210)*pol_z(1, 6, kg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_xyz(210)*pol_z(2, 6, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(211)*pol_z(1, 7, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(211)*pol_z(2, 7, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(212)*pol_z(1, 7, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(212)*pol_z(2, 7, kg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_xyz(213)*pol_z(1, 7, kg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_xyz(213)*pol_z(2, 7, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(214)*pol_z(1, 7, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(214)*pol_z(2, 7, kg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_xyz(215)*pol_z(1, 7, kg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_xyz(215)*pol_z(2, 7, kg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_xyz(216)*pol_z(1, 7, kg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_xyz(216)*pol_z(2, 7, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(217)*pol_z(1, 8, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(217)*pol_z(2, 8, kg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_xyz(218)*pol_z(1, 8, kg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_xyz(218)*pol_z(2, 8, kg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_xyz(219)*pol_z(1, 8, kg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_xyz(219)*pol_z(2, 8, kg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_xyz(220)*pol_z(1, 9, kg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_xyz(220)*pol_z(2, 9, kg) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 1)*pol_y(1, 0, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 1)*pol_y(2, 0, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 2)*pol_y(1, 0, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 2)*pol_y(2, 0, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 3)*pol_y(1, 0, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 3)*pol_y(2, 0, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 4)*pol_y(1, 0, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 4)*pol_y(2, 0, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 5)*pol_y(1, 0, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 5)*pol_y(2, 0, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 6)*pol_y(1, 0, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 6)*pol_y(2, 0, jg) - coef_x(1:2, 6) = coef_x(1:2, 6)+coef_xy(1:2, 7)*pol_y(1, 0, jg) - coef_x(3:4, 6) = coef_x(3:4, 6)+coef_xy(1:2, 7)*pol_y(2, 0, jg) - coef_x(1:2, 7) = coef_x(1:2, 7)+coef_xy(1:2, 8)*pol_y(1, 0, jg) - coef_x(3:4, 7) = coef_x(3:4, 7)+coef_xy(1:2, 8)*pol_y(2, 0, jg) - coef_x(1:2, 8) = coef_x(1:2, 8)+coef_xy(1:2, 9)*pol_y(1, 0, jg) - coef_x(3:4, 8) = coef_x(3:4, 8)+coef_xy(1:2, 9)*pol_y(2, 0, jg) - coef_x(1:2, 9) = coef_x(1:2, 9)+coef_xy(1:2, 10)*pol_y(1, 0, jg) - coef_x(3:4, 9) = coef_x(3:4, 9)+coef_xy(1:2, 10)*pol_y(2, 0, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 11)*pol_y(1, 1, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 11)*pol_y(2, 1, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 12)*pol_y(1, 1, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 12)*pol_y(2, 1, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 13)*pol_y(1, 1, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 13)*pol_y(2, 1, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 14)*pol_y(1, 1, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 14)*pol_y(2, 1, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 15)*pol_y(1, 1, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 15)*pol_y(2, 1, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 16)*pol_y(1, 1, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 16)*pol_y(2, 1, jg) - coef_x(1:2, 6) = coef_x(1:2, 6)+coef_xy(1:2, 17)*pol_y(1, 1, jg) - coef_x(3:4, 6) = coef_x(3:4, 6)+coef_xy(1:2, 17)*pol_y(2, 1, jg) - coef_x(1:2, 7) = coef_x(1:2, 7)+coef_xy(1:2, 18)*pol_y(1, 1, jg) - coef_x(3:4, 7) = coef_x(3:4, 7)+coef_xy(1:2, 18)*pol_y(2, 1, jg) - coef_x(1:2, 8) = coef_x(1:2, 8)+coef_xy(1:2, 19)*pol_y(1, 1, jg) - coef_x(3:4, 8) = coef_x(3:4, 8)+coef_xy(1:2, 19)*pol_y(2, 1, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 20)*pol_y(1, 2, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 20)*pol_y(2, 2, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 21)*pol_y(1, 2, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 21)*pol_y(2, 2, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 22)*pol_y(1, 2, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 22)*pol_y(2, 2, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 23)*pol_y(1, 2, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 23)*pol_y(2, 2, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 24)*pol_y(1, 2, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 24)*pol_y(2, 2, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 25)*pol_y(1, 2, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 25)*pol_y(2, 2, jg) - coef_x(1:2, 6) = coef_x(1:2, 6)+coef_xy(1:2, 26)*pol_y(1, 2, jg) - coef_x(3:4, 6) = coef_x(3:4, 6)+coef_xy(1:2, 26)*pol_y(2, 2, jg) - coef_x(1:2, 7) = coef_x(1:2, 7)+coef_xy(1:2, 27)*pol_y(1, 2, jg) - coef_x(3:4, 7) = coef_x(3:4, 7)+coef_xy(1:2, 27)*pol_y(2, 2, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 28)*pol_y(1, 3, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 28)*pol_y(2, 3, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 29)*pol_y(1, 3, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 29)*pol_y(2, 3, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 30)*pol_y(1, 3, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 30)*pol_y(2, 3, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 31)*pol_y(1, 3, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 31)*pol_y(2, 3, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 32)*pol_y(1, 3, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 32)*pol_y(2, 3, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 33)*pol_y(1, 3, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 33)*pol_y(2, 3, jg) - coef_x(1:2, 6) = coef_x(1:2, 6)+coef_xy(1:2, 34)*pol_y(1, 3, jg) - coef_x(3:4, 6) = coef_x(3:4, 6)+coef_xy(1:2, 34)*pol_y(2, 3, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 35)*pol_y(1, 4, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 35)*pol_y(2, 4, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 36)*pol_y(1, 4, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 36)*pol_y(2, 4, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 37)*pol_y(1, 4, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 37)*pol_y(2, 4, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 38)*pol_y(1, 4, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 38)*pol_y(2, 4, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 39)*pol_y(1, 4, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 39)*pol_y(2, 4, jg) - coef_x(1:2, 5) = coef_x(1:2, 5)+coef_xy(1:2, 40)*pol_y(1, 4, jg) - coef_x(3:4, 5) = coef_x(3:4, 5)+coef_xy(1:2, 40)*pol_y(2, 4, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 41)*pol_y(1, 5, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 41)*pol_y(2, 5, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 42)*pol_y(1, 5, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 42)*pol_y(2, 5, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 43)*pol_y(1, 5, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 43)*pol_y(2, 5, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 44)*pol_y(1, 5, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 44)*pol_y(2, 5, jg) - coef_x(1:2, 4) = coef_x(1:2, 4)+coef_xy(1:2, 45)*pol_y(1, 5, jg) - coef_x(3:4, 4) = coef_x(3:4, 4)+coef_xy(1:2, 45)*pol_y(2, 5, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 46)*pol_y(1, 6, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 46)*pol_y(2, 6, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 47)*pol_y(1, 6, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 47)*pol_y(2, 6, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 48)*pol_y(1, 6, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 48)*pol_y(2, 6, jg) - coef_x(1:2, 3) = coef_x(1:2, 3)+coef_xy(1:2, 49)*pol_y(1, 6, jg) - coef_x(3:4, 3) = coef_x(3:4, 3)+coef_xy(1:2, 49)*pol_y(2, 6, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 50)*pol_y(1, 7, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 50)*pol_y(2, 7, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 51)*pol_y(1, 7, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 51)*pol_y(2, 7, jg) - coef_x(1:2, 2) = coef_x(1:2, 2)+coef_xy(1:2, 52)*pol_y(1, 7, jg) - coef_x(3:4, 2) = coef_x(3:4, 2)+coef_xy(1:2, 52)*pol_y(2, 7, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 53)*pol_y(1, 8, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 53)*pol_y(2, 8, jg) - coef_x(1:2, 1) = coef_x(1:2, 1)+coef_xy(1:2, 54)*pol_y(1, 8, jg) - coef_x(3:4, 1) = coef_x(3:4, 1)+coef_xy(1:2, 54)*pol_y(2, 8, jg) - coef_x(1:2, 0) = coef_x(1:2, 0)+coef_xy(1:2, 55)*pol_y(1, 9, jg) - coef_x(3:4, 0) = coef_x(3:4, 0)+coef_xy(1:2, 55)*pol_y(2, 9, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 1)*pol_y(1, 0, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 1)*pol_y(2, 0, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 2)*pol_y(1, 0, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 2)*pol_y(2, 0, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 3)*pol_y(1, 0, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 3)*pol_y(2, 0, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 4)*pol_y(1, 0, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 4)*pol_y(2, 0, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 5)*pol_y(1, 0, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 5)*pol_y(2, 0, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 6)*pol_y(1, 0, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 6)*pol_y(2, 0, jg) + coef_x(1:2, 6) = coef_x(1:2, 6) + coef_xy(1:2, 7)*pol_y(1, 0, jg) + coef_x(3:4, 6) = coef_x(3:4, 6) + coef_xy(1:2, 7)*pol_y(2, 0, jg) + coef_x(1:2, 7) = coef_x(1:2, 7) + coef_xy(1:2, 8)*pol_y(1, 0, jg) + coef_x(3:4, 7) = coef_x(3:4, 7) + coef_xy(1:2, 8)*pol_y(2, 0, jg) + coef_x(1:2, 8) = coef_x(1:2, 8) + coef_xy(1:2, 9)*pol_y(1, 0, jg) + coef_x(3:4, 8) = coef_x(3:4, 8) + coef_xy(1:2, 9)*pol_y(2, 0, jg) + coef_x(1:2, 9) = coef_x(1:2, 9) + coef_xy(1:2, 10)*pol_y(1, 0, jg) + coef_x(3:4, 9) = coef_x(3:4, 9) + coef_xy(1:2, 10)*pol_y(2, 0, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 11)*pol_y(1, 1, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 11)*pol_y(2, 1, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 12)*pol_y(1, 1, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 12)*pol_y(2, 1, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 13)*pol_y(1, 1, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 13)*pol_y(2, 1, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 14)*pol_y(1, 1, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 14)*pol_y(2, 1, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 15)*pol_y(1, 1, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 15)*pol_y(2, 1, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 16)*pol_y(1, 1, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 16)*pol_y(2, 1, jg) + coef_x(1:2, 6) = coef_x(1:2, 6) + coef_xy(1:2, 17)*pol_y(1, 1, jg) + coef_x(3:4, 6) = coef_x(3:4, 6) + coef_xy(1:2, 17)*pol_y(2, 1, jg) + coef_x(1:2, 7) = coef_x(1:2, 7) + coef_xy(1:2, 18)*pol_y(1, 1, jg) + coef_x(3:4, 7) = coef_x(3:4, 7) + coef_xy(1:2, 18)*pol_y(2, 1, jg) + coef_x(1:2, 8) = coef_x(1:2, 8) + coef_xy(1:2, 19)*pol_y(1, 1, jg) + coef_x(3:4, 8) = coef_x(3:4, 8) + coef_xy(1:2, 19)*pol_y(2, 1, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 20)*pol_y(1, 2, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 20)*pol_y(2, 2, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 21)*pol_y(1, 2, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 21)*pol_y(2, 2, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 22)*pol_y(1, 2, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 22)*pol_y(2, 2, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 23)*pol_y(1, 2, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 23)*pol_y(2, 2, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 24)*pol_y(1, 2, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 24)*pol_y(2, 2, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 25)*pol_y(1, 2, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 25)*pol_y(2, 2, jg) + coef_x(1:2, 6) = coef_x(1:2, 6) + coef_xy(1:2, 26)*pol_y(1, 2, jg) + coef_x(3:4, 6) = coef_x(3:4, 6) + coef_xy(1:2, 26)*pol_y(2, 2, jg) + coef_x(1:2, 7) = coef_x(1:2, 7) + coef_xy(1:2, 27)*pol_y(1, 2, jg) + coef_x(3:4, 7) = coef_x(3:4, 7) + coef_xy(1:2, 27)*pol_y(2, 2, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 28)*pol_y(1, 3, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 28)*pol_y(2, 3, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 29)*pol_y(1, 3, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 29)*pol_y(2, 3, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 30)*pol_y(1, 3, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 30)*pol_y(2, 3, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 31)*pol_y(1, 3, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 31)*pol_y(2, 3, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 32)*pol_y(1, 3, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 32)*pol_y(2, 3, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 33)*pol_y(1, 3, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 33)*pol_y(2, 3, jg) + coef_x(1:2, 6) = coef_x(1:2, 6) + coef_xy(1:2, 34)*pol_y(1, 3, jg) + coef_x(3:4, 6) = coef_x(3:4, 6) + coef_xy(1:2, 34)*pol_y(2, 3, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 35)*pol_y(1, 4, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 35)*pol_y(2, 4, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 36)*pol_y(1, 4, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 36)*pol_y(2, 4, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 37)*pol_y(1, 4, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 37)*pol_y(2, 4, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 38)*pol_y(1, 4, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 38)*pol_y(2, 4, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 39)*pol_y(1, 4, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 39)*pol_y(2, 4, jg) + coef_x(1:2, 5) = coef_x(1:2, 5) + coef_xy(1:2, 40)*pol_y(1, 4, jg) + coef_x(3:4, 5) = coef_x(3:4, 5) + coef_xy(1:2, 40)*pol_y(2, 4, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 41)*pol_y(1, 5, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 41)*pol_y(2, 5, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 42)*pol_y(1, 5, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 42)*pol_y(2, 5, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 43)*pol_y(1, 5, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 43)*pol_y(2, 5, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 44)*pol_y(1, 5, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 44)*pol_y(2, 5, jg) + coef_x(1:2, 4) = coef_x(1:2, 4) + coef_xy(1:2, 45)*pol_y(1, 5, jg) + coef_x(3:4, 4) = coef_x(3:4, 4) + coef_xy(1:2, 45)*pol_y(2, 5, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 46)*pol_y(1, 6, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 46)*pol_y(2, 6, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 47)*pol_y(1, 6, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 47)*pol_y(2, 6, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 48)*pol_y(1, 6, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 48)*pol_y(2, 6, jg) + coef_x(1:2, 3) = coef_x(1:2, 3) + coef_xy(1:2, 49)*pol_y(1, 6, jg) + coef_x(3:4, 3) = coef_x(3:4, 3) + coef_xy(1:2, 49)*pol_y(2, 6, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 50)*pol_y(1, 7, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 50)*pol_y(2, 7, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 51)*pol_y(1, 7, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 51)*pol_y(2, 7, jg) + coef_x(1:2, 2) = coef_x(1:2, 2) + coef_xy(1:2, 52)*pol_y(1, 7, jg) + coef_x(3:4, 2) = coef_x(3:4, 2) + coef_xy(1:2, 52)*pol_y(2, 7, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 53)*pol_y(1, 8, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 53)*pol_y(2, 8, jg) + coef_x(1:2, 1) = coef_x(1:2, 1) + coef_xy(1:2, 54)*pol_y(1, 8, jg) + coef_x(3:4, 1) = coef_x(3:4, 1) + coef_xy(1:2, 54)*pol_y(2, 8, jg) + coef_x(1:2, 0) = coef_x(1:2, 0) + coef_xy(1:2, 55)*pol_y(1, 9, jg) + coef_x(3:4, 0) = coef_x(3:4, 0) + coef_xy(1:2, 55)*pol_y(2, 9, jg) DO ig = igmin, igmax i = map(ig, 1) s01 = 0.0_dp s02 = 0.0_dp s03 = 0.0_dp s04 = 0.0_dp - s01 = s01+coef_x(1, 0)*pol_x(0, ig) - s02 = s02+coef_x(2, 0)*pol_x(0, ig) - s03 = s03+coef_x(3, 0)*pol_x(0, ig) - s04 = s04+coef_x(4, 0)*pol_x(0, ig) - s01 = s01+coef_x(1, 1)*pol_x(1, ig) - s02 = s02+coef_x(2, 1)*pol_x(1, ig) - s03 = s03+coef_x(3, 1)*pol_x(1, ig) - s04 = s04+coef_x(4, 1)*pol_x(1, ig) - s01 = s01+coef_x(1, 2)*pol_x(2, ig) - s02 = s02+coef_x(2, 2)*pol_x(2, ig) - s03 = s03+coef_x(3, 2)*pol_x(2, ig) - s04 = s04+coef_x(4, 2)*pol_x(2, ig) - s01 = s01+coef_x(1, 3)*pol_x(3, ig) - s02 = s02+coef_x(2, 3)*pol_x(3, ig) - s03 = s03+coef_x(3, 3)*pol_x(3, ig) - s04 = s04+coef_x(4, 3)*pol_x(3, ig) - s01 = s01+coef_x(1, 4)*pol_x(4, ig) - s02 = s02+coef_x(2, 4)*pol_x(4, ig) - s03 = s03+coef_x(3, 4)*pol_x(4, ig) - s04 = s04+coef_x(4, 4)*pol_x(4, ig) - s01 = s01+coef_x(1, 5)*pol_x(5, ig) - s02 = s02+coef_x(2, 5)*pol_x(5, ig) - s03 = s03+coef_x(3, 5)*pol_x(5, ig) - s04 = s04+coef_x(4, 5)*pol_x(5, ig) - s01 = s01+coef_x(1, 6)*pol_x(6, ig) - s02 = s02+coef_x(2, 6)*pol_x(6, ig) - s03 = s03+coef_x(3, 6)*pol_x(6, ig) - s04 = s04+coef_x(4, 6)*pol_x(6, ig) - s01 = s01+coef_x(1, 7)*pol_x(7, ig) - s02 = s02+coef_x(2, 7)*pol_x(7, ig) - s03 = s03+coef_x(3, 7)*pol_x(7, ig) - s04 = s04+coef_x(4, 7)*pol_x(7, ig) - s01 = s01+coef_x(1, 8)*pol_x(8, ig) - s02 = s02+coef_x(2, 8)*pol_x(8, ig) - s03 = s03+coef_x(3, 8)*pol_x(8, ig) - s04 = s04+coef_x(4, 8)*pol_x(8, ig) - s01 = s01+coef_x(1, 9)*pol_x(9, ig) - s02 = s02+coef_x(2, 9)*pol_x(9, ig) - s03 = s03+coef_x(3, 9)*pol_x(9, ig) - s04 = s04+coef_x(4, 9)*pol_x(9, ig) - grid(i, j, k) = grid(i, j, k)+s01 - grid(i, j2, k) = grid(i, j2, k)+s03 - grid(i, j, k2) = grid(i, j, k2)+s02 - grid(i, j2, k2) = grid(i, j2, k2)+s04 + s01 = s01 + coef_x(1, 0)*pol_x(0, ig) + s02 = s02 + coef_x(2, 0)*pol_x(0, ig) + s03 = s03 + coef_x(3, 0)*pol_x(0, ig) + s04 = s04 + coef_x(4, 0)*pol_x(0, ig) + s01 = s01 + coef_x(1, 1)*pol_x(1, ig) + s02 = s02 + coef_x(2, 1)*pol_x(1, ig) + s03 = s03 + coef_x(3, 1)*pol_x(1, ig) + s04 = s04 + coef_x(4, 1)*pol_x(1, ig) + s01 = s01 + coef_x(1, 2)*pol_x(2, ig) + s02 = s02 + coef_x(2, 2)*pol_x(2, ig) + s03 = s03 + coef_x(3, 2)*pol_x(2, ig) + s04 = s04 + coef_x(4, 2)*pol_x(2, ig) + s01 = s01 + coef_x(1, 3)*pol_x(3, ig) + s02 = s02 + coef_x(2, 3)*pol_x(3, ig) + s03 = s03 + coef_x(3, 3)*pol_x(3, ig) + s04 = s04 + coef_x(4, 3)*pol_x(3, ig) + s01 = s01 + coef_x(1, 4)*pol_x(4, ig) + s02 = s02 + coef_x(2, 4)*pol_x(4, ig) + s03 = s03 + coef_x(3, 4)*pol_x(4, ig) + s04 = s04 + coef_x(4, 4)*pol_x(4, ig) + s01 = s01 + coef_x(1, 5)*pol_x(5, ig) + s02 = s02 + coef_x(2, 5)*pol_x(5, ig) + s03 = s03 + coef_x(3, 5)*pol_x(5, ig) + s04 = s04 + coef_x(4, 5)*pol_x(5, ig) + s01 = s01 + coef_x(1, 6)*pol_x(6, ig) + s02 = s02 + coef_x(2, 6)*pol_x(6, ig) + s03 = s03 + coef_x(3, 6)*pol_x(6, ig) + s04 = s04 + coef_x(4, 6)*pol_x(6, ig) + s01 = s01 + coef_x(1, 7)*pol_x(7, ig) + s02 = s02 + coef_x(2, 7)*pol_x(7, ig) + s03 = s03 + coef_x(3, 7)*pol_x(7, ig) + s04 = s04 + coef_x(4, 7)*pol_x(7, ig) + s01 = s01 + coef_x(1, 8)*pol_x(8, ig) + s02 = s02 + coef_x(2, 8)*pol_x(8, ig) + s03 = s03 + coef_x(3, 8)*pol_x(8, ig) + s04 = s04 + coef_x(4, 8)*pol_x(8, ig) + s01 = s01 + coef_x(1, 9)*pol_x(9, ig) + s02 = s02 + coef_x(2, 9)*pol_x(9, ig) + s03 = s03 + coef_x(3, 9)*pol_x(9, ig) + s04 = s04 + coef_x(4, 9)*pol_x(9, ig) + grid(i, j, k) = grid(i, j, k) + s01 + grid(i, j2, k) = grid(i, j2, k) + s03 + grid(i, j, k2) = grid(i, j, k2) + s02 + grid(i, j2, k2) = grid(i, j2, k2) + s04 END DO END DO END DO diff --git a/src/grid/grid_fast.F b/src/grid/grid_fast.F index 31a82c4e11..be4d67bc1f 100644 --- a/src/grid/grid_fast.F +++ b/src/grid/grid_fast.F @@ -40,7 +40,7 @@ SUBROUTINE collocate_gf_npbc(grid, xdat, ydat, zdat, bo1, bo2, zlb, zub, ylb, yu DO iy = ylb, yub tmp1 = zdat(iz)*ydat(iy) DO ix = xlb, xub - grid(ix, iy, iz) = grid(ix, iy, iz)+xdat(ix)*tmp1 + grid(ix, iy, iz) = grid(ix, iy, iz) + xdat(ix)*tmp1 END DO ! Loop on x END DO ! Loop on y END DO ! Loop on z @@ -80,8 +80,8 @@ SUBROUTINE integrate_gf_npbc(grid, xdat, ydat, zdat, bo, zlb, zub, ylb, yub, xlb DO iz = zlb, zub iy2 = HUGE(0) ! unroll by 2 - DO iy = ylb, yub-1, 2 - iy2 = iy+1 + DO iy = ylb, yub - 1, 2 + iy2 = iy + 1 fx1 = 0.0_dp fyz1 = 0.0_dp fx2 = 0.0_dp @@ -91,17 +91,17 @@ SUBROUTINE integrate_gf_npbc(grid, xdat, ydat, zdat, bo, zlb, zub, ylb, yub, xlb g2 = grid(ix, iy2, iz) x1 = xdat(1, ix) x2 = xdat(2, ix) - fyz1 = fyz1+g1*x1 - fx1 = fx1+g1*x2 - fyz2 = fyz2+g2*x1 - fx2 = fx2+g2*x2 + fyz1 = fyz1 + g1*x1 + fx1 = fx1 + g1*x2 + fyz2 = fyz2 + g2*x1 + fx2 = fx2 + g2*x2 END DO ! Loop on x - force(1) = force(1)+fx1*zdat(1, iz)*ydat(1, iy) - force(2) = force(2)+fyz1*zdat(1, iz)*ydat(2, iy) - force(3) = force(3)+fyz1*zdat(2, iz)*ydat(1, iy) - force(1) = force(1)+fx2*zdat(1, iz)*ydat(1, iy2) - force(2) = force(2)+fyz2*zdat(1, iz)*ydat(2, iy2) - force(3) = force(3)+fyz2*zdat(2, iz)*ydat(1, iy2) + force(1) = force(1) + fx1*zdat(1, iz)*ydat(1, iy) + force(2) = force(2) + fyz1*zdat(1, iz)*ydat(2, iy) + force(3) = force(3) + fyz1*zdat(2, iz)*ydat(1, iy) + force(1) = force(1) + fx2*zdat(1, iz)*ydat(1, iy2) + force(2) = force(2) + fyz2*zdat(1, iz)*ydat(2, iy2) + force(3) = force(3) + fyz2*zdat(2, iz)*ydat(1, iy2) END DO ! Loop on y ! cleanup loop: check if the last loop element has done @@ -113,12 +113,12 @@ SUBROUTINE integrate_gf_npbc(grid, xdat, ydat, zdat, bo, zlb, zub, ylb, yub, xlb g2 = grid(ix, iy2, iz) x1 = xdat(1, ix) x2 = xdat(2, ix) - fyz2 = fyz2+g2*x1 - fx2 = fx2+g2*x2 + fyz2 = fyz2 + g2*x1 + fx2 = fx2 + g2*x2 END DO ! Loop on x - force(1) = force(1)+fx2*zdat(1, iz)*ydat(1, iy2) - force(2) = force(2)+fyz2*zdat(1, iz)*ydat(2, iy2) - force(3) = force(3)+fyz2*zdat(2, iz)*ydat(1, iy2) + force(1) = force(1) + fx2*zdat(1, iz)*ydat(1, iy2) + force(2) = force(2) + fyz2*zdat(1, iz)*ydat(2, iy2) + force(3) = force(3) + fyz2*zdat(2, iz)*ydat(1, iy2) ENDIF END DO ! Loop on z diff --git a/src/grid/integrate_fast_1.f90 b/src/grid/integrate_fast_1.f90 index 1e6d3c5efb..749bfec236 100644 --- a/src/grid/integrate_fast_1.f90 +++ b/src/grid/integrate_fast_1.f90 @@ -14,7 +14,7 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bounds, lp, cmax, gridbounds) USE kinds, ONLY: dp INTEGER, INTENT(IN) :: sphere_bounds(*), lp - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER, INTENT(IN) :: cmax REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & @@ -29,7 +29,7 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -37,23 +37,23 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp @@ -64,21 +64,21 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_x(1, lxp)*pol_y(1, lyp, jg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_x(2, lxp)*pol_y(1, lyp, jg) - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_x(3, lxp)*pol_y(2, lyp, jg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_x(4, lxp)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_x(1, lxp)*pol_y(1, lyp, jg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_x(2, lxp)*pol_y(1, lyp, jg) + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_x(3, lxp)*pol_y(2, lyp, jg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_x(4, lxp)*pol_y(2, lyp, jg) ENDDO ENDDO @@ -87,13 +87,13 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(1, lxy)*pol_z(1, lzp, kg) - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(2, lxy)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(1, lxy)*pol_z(1, lzp, kg) + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(2, lxy)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO @@ -123,14 +123,14 @@ SUBROUTINE integrate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -138,23 +138,23 @@ SUBROUTINE integrate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -163,26 +163,26 @@ SUBROUTINE integrate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = grid(i, j, k2) s03 = grid(i, j2, k) s04 = grid(i, j2, k2) - coef_x(1, 0) = coef_x(1, 0)+s01*pol_x(0, ig) - coef_x(2, 0) = coef_x(2, 0)+s02*pol_x(0, ig) - coef_x(3, 0) = coef_x(3, 0)+s03*pol_x(0, ig) - coef_x(4, 0) = coef_x(4, 0)+s04*pol_x(0, ig) + coef_x(1, 0) = coef_x(1, 0) + s01*pol_x(0, ig) + coef_x(2, 0) = coef_x(2, 0) + s02*pol_x(0, ig) + coef_x(3, 0) = coef_x(3, 0) + s03*pol_x(0, ig) + coef_x(4, 0) = coef_x(4, 0) + s04*pol_x(0, ig) END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) END DO lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(1, lxy)*pol_z(1, lzp, kg) - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(2, lxy)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(1, lxy)*pol_z(1, lzp, kg) + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(2, lxy)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO END DO @@ -211,13 +211,13 @@ SUBROUTINE integrate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -225,23 +225,23 @@ SUBROUTINE integrate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -250,36 +250,36 @@ SUBROUTINE integrate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = grid(i, j, k2) s03 = grid(i, j2, k) s04 = grid(i, j2, k2) - coef_x(1, 0) = coef_x(1, 0)+s01*pol_x(0, ig) - coef_x(2, 0) = coef_x(2, 0)+s02*pol_x(0, ig) - coef_x(3, 0) = coef_x(3, 0)+s03*pol_x(0, ig) - coef_x(4, 0) = coef_x(4, 0)+s04*pol_x(0, ig) - coef_x(1, 1) = coef_x(1, 1)+s01*pol_x(1, ig) - coef_x(2, 1) = coef_x(2, 1)+s02*pol_x(1, ig) - coef_x(3, 1) = coef_x(3, 1)+s03*pol_x(1, ig) - coef_x(4, 1) = coef_x(4, 1)+s04*pol_x(1, ig) + coef_x(1, 0) = coef_x(1, 0) + s01*pol_x(0, ig) + coef_x(2, 0) = coef_x(2, 0) + s02*pol_x(0, ig) + coef_x(3, 0) = coef_x(3, 0) + s03*pol_x(0, ig) + coef_x(4, 0) = coef_x(4, 0) + s04*pol_x(0, ig) + coef_x(1, 1) = coef_x(1, 1) + s01*pol_x(1, ig) + coef_x(2, 1) = coef_x(2, 1) + s02*pol_x(1, ig) + coef_x(3, 1) = coef_x(3, 1) + s03*pol_x(1, ig) + coef_x(4, 1) = coef_x(4, 1) + s04*pol_x(1, ig) END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 0)*pol_y(2, 1, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 1)*pol_z(2, 1, kg) END DO END SUBROUTINE integrate_core_1 @@ -306,13 +306,13 @@ SUBROUTINE integrate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -320,23 +320,23 @@ SUBROUTINE integrate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -345,64 +345,64 @@ SUBROUTINE integrate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = grid(i, j, k2) s03 = grid(i, j2, k) s04 = grid(i, j2, k2) - coef_x(1, 0) = coef_x(1, 0)+s01*pol_x(0, ig) - coef_x(2, 0) = coef_x(2, 0)+s02*pol_x(0, ig) - coef_x(3, 0) = coef_x(3, 0)+s03*pol_x(0, ig) - coef_x(4, 0) = coef_x(4, 0)+s04*pol_x(0, ig) - coef_x(1, 1) = coef_x(1, 1)+s01*pol_x(1, ig) - coef_x(2, 1) = coef_x(2, 1)+s02*pol_x(1, ig) - coef_x(3, 1) = coef_x(3, 1)+s03*pol_x(1, ig) - coef_x(4, 1) = coef_x(4, 1)+s04*pol_x(1, ig) - coef_x(1, 2) = coef_x(1, 2)+s01*pol_x(2, ig) - coef_x(2, 2) = coef_x(2, 2)+s02*pol_x(2, ig) - coef_x(3, 2) = coef_x(3, 2)+s03*pol_x(2, ig) - coef_x(4, 2) = coef_x(4, 2)+s04*pol_x(2, ig) + coef_x(1, 0) = coef_x(1, 0) + s01*pol_x(0, ig) + coef_x(2, 0) = coef_x(2, 0) + s02*pol_x(0, ig) + coef_x(3, 0) = coef_x(3, 0) + s03*pol_x(0, ig) + coef_x(4, 0) = coef_x(4, 0) + s04*pol_x(0, ig) + coef_x(1, 1) = coef_x(1, 1) + s01*pol_x(1, ig) + coef_x(2, 1) = coef_x(2, 1) + s02*pol_x(1, ig) + coef_x(3, 1) = coef_x(3, 1) + s03*pol_x(1, ig) + coef_x(4, 1) = coef_x(4, 1) + s04*pol_x(1, ig) + coef_x(1, 2) = coef_x(1, 2) + s01*pol_x(2, ig) + coef_x(2, 2) = coef_x(2, 2) + s02*pol_x(2, ig) + coef_x(3, 2) = coef_x(3, 2) + s03*pol_x(2, ig) + coef_x(4, 2) = coef_x(4, 2) + s04*pol_x(2, ig) END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 2)*pol_y(1, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 2)*pol_y(1, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 2)*pol_y(2, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 2)*pol_y(2, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(4, 0)*pol_y(2, 1, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(1, 1)*pol_y(1, 1, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(2, 1)*pol_y(1, 1, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(3, 1)*pol_y(2, 1, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(4, 1)*pol_y(2, 1, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(1, 0)*pol_y(1, 2, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(2, 0)*pol_y(1, 2, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(3, 0)*pol_y(2, 2, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(4, 0)*pol_y(2, 2, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 2)*pol_y(1, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 2)*pol_y(1, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 2)*pol_y(2, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 2)*pol_y(2, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(1, 1)*pol_y(1, 1, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(2, 1)*pol_y(1, 1, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(3, 1)*pol_y(2, 1, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(4, 1)*pol_y(2, 1, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(1, 0)*pol_y(1, 2, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(2, 0)*pol_y(1, 2, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(3, 0)*pol_y(2, 2, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(4, 0)*pol_y(2, 2, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 1)*pol_z(2, 2, kg) END DO END SUBROUTINE integrate_core_2 @@ -429,13 +429,13 @@ SUBROUTINE integrate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -443,23 +443,23 @@ SUBROUTINE integrate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -468,104 +468,104 @@ SUBROUTINE integrate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = grid(i, j, k2) s03 = grid(i, j2, k) s04 = grid(i, j2, k2) - coef_x(1, 0) = coef_x(1, 0)+s01*pol_x(0, ig) - coef_x(2, 0) = coef_x(2, 0)+s02*pol_x(0, ig) - coef_x(3, 0) = coef_x(3, 0)+s03*pol_x(0, ig) - coef_x(4, 0) = coef_x(4, 0)+s04*pol_x(0, ig) - coef_x(1, 1) = coef_x(1, 1)+s01*pol_x(1, ig) - coef_x(2, 1) = coef_x(2, 1)+s02*pol_x(1, ig) - coef_x(3, 1) = coef_x(3, 1)+s03*pol_x(1, ig) - coef_x(4, 1) = coef_x(4, 1)+s04*pol_x(1, ig) - coef_x(1, 2) = coef_x(1, 2)+s01*pol_x(2, ig) - coef_x(2, 2) = coef_x(2, 2)+s02*pol_x(2, ig) - coef_x(3, 2) = coef_x(3, 2)+s03*pol_x(2, ig) - coef_x(4, 2) = coef_x(4, 2)+s04*pol_x(2, ig) - coef_x(1, 3) = coef_x(1, 3)+s01*pol_x(3, ig) - coef_x(2, 3) = coef_x(2, 3)+s02*pol_x(3, ig) - coef_x(3, 3) = coef_x(3, 3)+s03*pol_x(3, ig) - coef_x(4, 3) = coef_x(4, 3)+s04*pol_x(3, ig) + coef_x(1, 0) = coef_x(1, 0) + s01*pol_x(0, ig) + coef_x(2, 0) = coef_x(2, 0) + s02*pol_x(0, ig) + coef_x(3, 0) = coef_x(3, 0) + s03*pol_x(0, ig) + coef_x(4, 0) = coef_x(4, 0) + s04*pol_x(0, ig) + coef_x(1, 1) = coef_x(1, 1) + s01*pol_x(1, ig) + coef_x(2, 1) = coef_x(2, 1) + s02*pol_x(1, ig) + coef_x(3, 1) = coef_x(3, 1) + s03*pol_x(1, ig) + coef_x(4, 1) = coef_x(4, 1) + s04*pol_x(1, ig) + coef_x(1, 2) = coef_x(1, 2) + s01*pol_x(2, ig) + coef_x(2, 2) = coef_x(2, 2) + s02*pol_x(2, ig) + coef_x(3, 2) = coef_x(3, 2) + s03*pol_x(2, ig) + coef_x(4, 2) = coef_x(4, 2) + s04*pol_x(2, ig) + coef_x(1, 3) = coef_x(1, 3) + s01*pol_x(3, ig) + coef_x(2, 3) = coef_x(2, 3) + s02*pol_x(3, ig) + coef_x(3, 3) = coef_x(3, 3) + s03*pol_x(3, ig) + coef_x(4, 3) = coef_x(4, 3) + s04*pol_x(3, ig) END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 2)*pol_y(1, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 2)*pol_y(1, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 2)*pol_y(2, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 2)*pol_y(2, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(1, 3)*pol_y(1, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(2, 3)*pol_y(1, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(3, 3)*pol_y(2, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(4, 3)*pol_y(2, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(4, 0)*pol_y(2, 1, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(1, 1)*pol_y(1, 1, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(2, 1)*pol_y(1, 1, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(3, 1)*pol_y(2, 1, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(4, 1)*pol_y(2, 1, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(1, 2)*pol_y(1, 1, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(2, 2)*pol_y(1, 1, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(3, 2)*pol_y(2, 1, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(4, 2)*pol_y(2, 1, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(1, 0)*pol_y(1, 2, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(2, 0)*pol_y(1, 2, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(3, 0)*pol_y(2, 2, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(4, 0)*pol_y(2, 2, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(1, 1)*pol_y(1, 2, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(2, 1)*pol_y(1, 2, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(3, 1)*pol_y(2, 2, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(4, 1)*pol_y(2, 2, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(1, 0)*pol_y(1, 3, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(2, 0)*pol_y(1, 3, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(3, 0)*pol_y(2, 3, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(4, 0)*pol_y(2, 3, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 2)*pol_y(1, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 2)*pol_y(1, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 2)*pol_y(2, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 2)*pol_y(2, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(1, 3)*pol_y(1, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(2, 3)*pol_y(1, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(3, 3)*pol_y(2, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(4, 3)*pol_y(2, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(1, 1)*pol_y(1, 1, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(2, 1)*pol_y(1, 1, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(3, 1)*pol_y(2, 1, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(4, 1)*pol_y(2, 1, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(1, 2)*pol_y(1, 1, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(2, 2)*pol_y(1, 1, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(3, 2)*pol_y(2, 1, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(4, 2)*pol_y(2, 1, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(1, 0)*pol_y(1, 2, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(2, 0)*pol_y(1, 2, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(3, 0)*pol_y(2, 2, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(4, 0)*pol_y(2, 2, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(1, 1)*pol_y(1, 2, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(2, 1)*pol_y(1, 2, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(3, 1)*pol_y(2, 2, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(4, 1)*pol_y(2, 2, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(1, 0)*pol_y(1, 3, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(2, 0)*pol_y(1, 3, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(3, 0)*pol_y(2, 3, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(4, 0)*pol_y(2, 3, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 5)*pol_z(1, 1, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 5)*pol_z(2, 1, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 8)*pol_z(1, 1, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 8)*pol_z(2, 1, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 5)*pol_z(1, 2, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 5)*pol_z(2, 2, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 5)*pol_z(1, 1, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 5)*pol_z(2, 1, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 8)*pol_z(1, 1, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 8)*pol_z(2, 1, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 5)*pol_z(1, 2, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 5)*pol_z(2, 2, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 1)*pol_z(2, 3, kg) END DO END SUBROUTINE integrate_core_3 @@ -592,13 +592,13 @@ SUBROUTINE integrate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -606,23 +606,23 @@ SUBROUTINE integrate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -631,158 +631,158 @@ SUBROUTINE integrate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = grid(i, j, k2) s03 = grid(i, j2, k) s04 = grid(i, j2, k2) - coef_x(1, 0) = coef_x(1, 0)+s01*pol_x(0, ig) - coef_x(2, 0) = coef_x(2, 0)+s02*pol_x(0, ig) - coef_x(3, 0) = coef_x(3, 0)+s03*pol_x(0, ig) - coef_x(4, 0) = coef_x(4, 0)+s04*pol_x(0, ig) - coef_x(1, 1) = coef_x(1, 1)+s01*pol_x(1, ig) - coef_x(2, 1) = coef_x(2, 1)+s02*pol_x(1, ig) - coef_x(3, 1) = coef_x(3, 1)+s03*pol_x(1, ig) - coef_x(4, 1) = coef_x(4, 1)+s04*pol_x(1, ig) - coef_x(1, 2) = coef_x(1, 2)+s01*pol_x(2, ig) - coef_x(2, 2) = coef_x(2, 2)+s02*pol_x(2, ig) - coef_x(3, 2) = coef_x(3, 2)+s03*pol_x(2, ig) - coef_x(4, 2) = coef_x(4, 2)+s04*pol_x(2, ig) - coef_x(1, 3) = coef_x(1, 3)+s01*pol_x(3, ig) - coef_x(2, 3) = coef_x(2, 3)+s02*pol_x(3, ig) - coef_x(3, 3) = coef_x(3, 3)+s03*pol_x(3, ig) - coef_x(4, 3) = coef_x(4, 3)+s04*pol_x(3, ig) - coef_x(1, 4) = coef_x(1, 4)+s01*pol_x(4, ig) - coef_x(2, 4) = coef_x(2, 4)+s02*pol_x(4, ig) - coef_x(3, 4) = coef_x(3, 4)+s03*pol_x(4, ig) - coef_x(4, 4) = coef_x(4, 4)+s04*pol_x(4, ig) + coef_x(1, 0) = coef_x(1, 0) + s01*pol_x(0, ig) + coef_x(2, 0) = coef_x(2, 0) + s02*pol_x(0, ig) + coef_x(3, 0) = coef_x(3, 0) + s03*pol_x(0, ig) + coef_x(4, 0) = coef_x(4, 0) + s04*pol_x(0, ig) + coef_x(1, 1) = coef_x(1, 1) + s01*pol_x(1, ig) + coef_x(2, 1) = coef_x(2, 1) + s02*pol_x(1, ig) + coef_x(3, 1) = coef_x(3, 1) + s03*pol_x(1, ig) + coef_x(4, 1) = coef_x(4, 1) + s04*pol_x(1, ig) + coef_x(1, 2) = coef_x(1, 2) + s01*pol_x(2, ig) + coef_x(2, 2) = coef_x(2, 2) + s02*pol_x(2, ig) + coef_x(3, 2) = coef_x(3, 2) + s03*pol_x(2, ig) + coef_x(4, 2) = coef_x(4, 2) + s04*pol_x(2, ig) + coef_x(1, 3) = coef_x(1, 3) + s01*pol_x(3, ig) + coef_x(2, 3) = coef_x(2, 3) + s02*pol_x(3, ig) + coef_x(3, 3) = coef_x(3, 3) + s03*pol_x(3, ig) + coef_x(4, 3) = coef_x(4, 3) + s04*pol_x(3, ig) + coef_x(1, 4) = coef_x(1, 4) + s01*pol_x(4, ig) + coef_x(2, 4) = coef_x(2, 4) + s02*pol_x(4, ig) + coef_x(3, 4) = coef_x(3, 4) + s03*pol_x(4, ig) + coef_x(4, 4) = coef_x(4, 4) + s04*pol_x(4, ig) END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 2)*pol_y(1, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 2)*pol_y(1, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 2)*pol_y(2, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 2)*pol_y(2, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(1, 3)*pol_y(1, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(2, 3)*pol_y(1, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(3, 3)*pol_y(2, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(4, 3)*pol_y(2, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(1, 4)*pol_y(1, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(2, 4)*pol_y(1, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(3, 4)*pol_y(2, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(4, 4)*pol_y(2, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(4, 0)*pol_y(2, 1, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(1, 1)*pol_y(1, 1, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(2, 1)*pol_y(1, 1, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(3, 1)*pol_y(2, 1, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(4, 1)*pol_y(2, 1, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(1, 2)*pol_y(1, 1, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(2, 2)*pol_y(1, 1, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(3, 2)*pol_y(2, 1, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(4, 2)*pol_y(2, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(1, 3)*pol_y(1, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(2, 3)*pol_y(1, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(3, 3)*pol_y(2, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(4, 3)*pol_y(2, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(1, 0)*pol_y(1, 2, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(2, 0)*pol_y(1, 2, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(3, 0)*pol_y(2, 2, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(4, 0)*pol_y(2, 2, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(1, 1)*pol_y(1, 2, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(2, 1)*pol_y(1, 2, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(3, 1)*pol_y(2, 2, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(4, 1)*pol_y(2, 2, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(1, 2)*pol_y(1, 2, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(2, 2)*pol_y(1, 2, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(3, 2)*pol_y(2, 2, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(4, 2)*pol_y(2, 2, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(1, 0)*pol_y(1, 3, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(2, 0)*pol_y(1, 3, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(3, 0)*pol_y(2, 3, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(4, 0)*pol_y(2, 3, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(1, 1)*pol_y(1, 3, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(2, 1)*pol_y(1, 3, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(3, 1)*pol_y(2, 3, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(4, 1)*pol_y(2, 3, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(1, 0)*pol_y(1, 4, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(2, 0)*pol_y(1, 4, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(3, 0)*pol_y(2, 4, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(4, 0)*pol_y(2, 4, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 2)*pol_y(1, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 2)*pol_y(1, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 2)*pol_y(2, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 2)*pol_y(2, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(1, 3)*pol_y(1, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(2, 3)*pol_y(1, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(3, 3)*pol_y(2, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(4, 3)*pol_y(2, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(1, 4)*pol_y(1, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(2, 4)*pol_y(1, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(3, 4)*pol_y(2, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(4, 4)*pol_y(2, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(1, 1)*pol_y(1, 1, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(2, 1)*pol_y(1, 1, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(3, 1)*pol_y(2, 1, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(4, 1)*pol_y(2, 1, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(1, 2)*pol_y(1, 1, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(2, 2)*pol_y(1, 1, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(3, 2)*pol_y(2, 1, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(4, 2)*pol_y(2, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(1, 3)*pol_y(1, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(2, 3)*pol_y(1, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(3, 3)*pol_y(2, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(4, 3)*pol_y(2, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(1, 0)*pol_y(1, 2, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(2, 0)*pol_y(1, 2, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(3, 0)*pol_y(2, 2, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(4, 0)*pol_y(2, 2, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(1, 1)*pol_y(1, 2, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(2, 1)*pol_y(1, 2, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(3, 1)*pol_y(2, 2, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(4, 1)*pol_y(2, 2, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(1, 2)*pol_y(1, 2, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(2, 2)*pol_y(1, 2, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(3, 2)*pol_y(2, 2, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(4, 2)*pol_y(2, 2, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(1, 0)*pol_y(1, 3, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(2, 0)*pol_y(1, 3, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(3, 0)*pol_y(2, 3, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(4, 0)*pol_y(2, 3, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(1, 1)*pol_y(1, 3, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(2, 1)*pol_y(1, 3, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(3, 1)*pol_y(2, 3, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(4, 1)*pol_y(2, 3, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(1, 0)*pol_y(1, 4, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(2, 0)*pol_y(1, 4, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(3, 0)*pol_y(2, 4, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(4, 0)*pol_y(2, 4, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 11)*pol_z(1, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 11)*pol_z(2, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 12)*pol_z(1, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 12)*pol_z(2, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 13)*pol_z(1, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 13)*pol_z(2, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 14)*pol_z(1, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 14)*pol_z(2, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 15)*pol_z(1, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 15)*pol_z(2, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(1, 7)*pol_z(1, 1, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(2, 7)*pol_z(2, 1, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(1, 8)*pol_z(1, 1, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(2, 8)*pol_z(2, 1, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(1, 10)*pol_z(1, 1, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(2, 10)*pol_z(2, 1, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(1, 11)*pol_z(1, 1, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(2, 11)*pol_z(2, 1, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(1, 13)*pol_z(1, 1, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(2, 13)*pol_z(2, 1, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(1, 3)*pol_z(1, 2, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(2, 3)*pol_z(2, 2, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(1, 6)*pol_z(1, 2, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(2, 6)*pol_z(2, 2, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(1, 7)*pol_z(1, 2, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(2, 7)*pol_z(2, 2, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(1, 10)*pol_z(1, 2, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(2, 10)*pol_z(2, 2, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(2, 1)*pol_z(2, 3, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(1, 2)*pol_z(1, 3, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(2, 2)*pol_z(2, 3, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(1, 6)*pol_z(1, 3, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(2, 6)*pol_z(2, 3, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(1, 1)*pol_z(1, 4, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(2, 1)*pol_z(2, 4, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 11)*pol_z(1, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 11)*pol_z(2, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 12)*pol_z(1, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 12)*pol_z(2, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 13)*pol_z(1, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 13)*pol_z(2, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 14)*pol_z(1, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 14)*pol_z(2, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 15)*pol_z(1, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 15)*pol_z(2, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(1, 7)*pol_z(1, 1, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(2, 7)*pol_z(2, 1, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(1, 8)*pol_z(1, 1, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(2, 8)*pol_z(2, 1, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(1, 10)*pol_z(1, 1, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(2, 10)*pol_z(2, 1, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(1, 11)*pol_z(1, 1, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(2, 11)*pol_z(2, 1, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(1, 13)*pol_z(1, 1, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(2, 13)*pol_z(2, 1, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(1, 3)*pol_z(1, 2, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(2, 3)*pol_z(2, 2, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(1, 6)*pol_z(1, 2, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(2, 6)*pol_z(2, 2, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(1, 7)*pol_z(1, 2, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(2, 7)*pol_z(2, 2, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(1, 10)*pol_z(1, 2, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(2, 10)*pol_z(2, 2, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(1, 2)*pol_z(1, 3, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(2, 2)*pol_z(2, 3, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(1, 6)*pol_z(1, 3, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(2, 6)*pol_z(2, 3, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(1, 1)*pol_z(1, 4, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(2, 1)*pol_z(2, 4, kg) END DO END SUBROUTINE integrate_core_4 @@ -809,13 +809,13 @@ SUBROUTINE integrate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -823,23 +823,23 @@ SUBROUTINE integrate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -848,228 +848,228 @@ SUBROUTINE integrate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = grid(i, j, k2) s03 = grid(i, j2, k) s04 = grid(i, j2, k2) - coef_x(1, 0) = coef_x(1, 0)+s01*pol_x(0, ig) - coef_x(2, 0) = coef_x(2, 0)+s02*pol_x(0, ig) - coef_x(3, 0) = coef_x(3, 0)+s03*pol_x(0, ig) - coef_x(4, 0) = coef_x(4, 0)+s04*pol_x(0, ig) - coef_x(1, 1) = coef_x(1, 1)+s01*pol_x(1, ig) - coef_x(2, 1) = coef_x(2, 1)+s02*pol_x(1, ig) - coef_x(3, 1) = coef_x(3, 1)+s03*pol_x(1, ig) - coef_x(4, 1) = coef_x(4, 1)+s04*pol_x(1, ig) - coef_x(1, 2) = coef_x(1, 2)+s01*pol_x(2, ig) - coef_x(2, 2) = coef_x(2, 2)+s02*pol_x(2, ig) - coef_x(3, 2) = coef_x(3, 2)+s03*pol_x(2, ig) - coef_x(4, 2) = coef_x(4, 2)+s04*pol_x(2, ig) - coef_x(1, 3) = coef_x(1, 3)+s01*pol_x(3, ig) - coef_x(2, 3) = coef_x(2, 3)+s02*pol_x(3, ig) - coef_x(3, 3) = coef_x(3, 3)+s03*pol_x(3, ig) - coef_x(4, 3) = coef_x(4, 3)+s04*pol_x(3, ig) - coef_x(1, 4) = coef_x(1, 4)+s01*pol_x(4, ig) - coef_x(2, 4) = coef_x(2, 4)+s02*pol_x(4, ig) - coef_x(3, 4) = coef_x(3, 4)+s03*pol_x(4, ig) - coef_x(4, 4) = coef_x(4, 4)+s04*pol_x(4, ig) - coef_x(1, 5) = coef_x(1, 5)+s01*pol_x(5, ig) - coef_x(2, 5) = coef_x(2, 5)+s02*pol_x(5, ig) - coef_x(3, 5) = coef_x(3, 5)+s03*pol_x(5, ig) - coef_x(4, 5) = coef_x(4, 5)+s04*pol_x(5, ig) + coef_x(1, 0) = coef_x(1, 0) + s01*pol_x(0, ig) + coef_x(2, 0) = coef_x(2, 0) + s02*pol_x(0, ig) + coef_x(3, 0) = coef_x(3, 0) + s03*pol_x(0, ig) + coef_x(4, 0) = coef_x(4, 0) + s04*pol_x(0, ig) + coef_x(1, 1) = coef_x(1, 1) + s01*pol_x(1, ig) + coef_x(2, 1) = coef_x(2, 1) + s02*pol_x(1, ig) + coef_x(3, 1) = coef_x(3, 1) + s03*pol_x(1, ig) + coef_x(4, 1) = coef_x(4, 1) + s04*pol_x(1, ig) + coef_x(1, 2) = coef_x(1, 2) + s01*pol_x(2, ig) + coef_x(2, 2) = coef_x(2, 2) + s02*pol_x(2, ig) + coef_x(3, 2) = coef_x(3, 2) + s03*pol_x(2, ig) + coef_x(4, 2) = coef_x(4, 2) + s04*pol_x(2, ig) + coef_x(1, 3) = coef_x(1, 3) + s01*pol_x(3, ig) + coef_x(2, 3) = coef_x(2, 3) + s02*pol_x(3, ig) + coef_x(3, 3) = coef_x(3, 3) + s03*pol_x(3, ig) + coef_x(4, 3) = coef_x(4, 3) + s04*pol_x(3, ig) + coef_x(1, 4) = coef_x(1, 4) + s01*pol_x(4, ig) + coef_x(2, 4) = coef_x(2, 4) + s02*pol_x(4, ig) + coef_x(3, 4) = coef_x(3, 4) + s03*pol_x(4, ig) + coef_x(4, 4) = coef_x(4, 4) + s04*pol_x(4, ig) + coef_x(1, 5) = coef_x(1, 5) + s01*pol_x(5, ig) + coef_x(2, 5) = coef_x(2, 5) + s02*pol_x(5, ig) + coef_x(3, 5) = coef_x(3, 5) + s03*pol_x(5, ig) + coef_x(4, 5) = coef_x(4, 5) + s04*pol_x(5, ig) END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 2)*pol_y(1, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 2)*pol_y(1, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 2)*pol_y(2, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 2)*pol_y(2, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(1, 3)*pol_y(1, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(2, 3)*pol_y(1, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(3, 3)*pol_y(2, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(4, 3)*pol_y(2, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(1, 4)*pol_y(1, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(2, 4)*pol_y(1, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(3, 4)*pol_y(2, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(4, 4)*pol_y(2, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(1, 5)*pol_y(1, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(2, 5)*pol_y(1, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(3, 5)*pol_y(2, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(4, 5)*pol_y(2, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(4, 0)*pol_y(2, 1, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(1, 1)*pol_y(1, 1, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(2, 1)*pol_y(1, 1, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(3, 1)*pol_y(2, 1, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(4, 1)*pol_y(2, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(1, 2)*pol_y(1, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(2, 2)*pol_y(1, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(3, 2)*pol_y(2, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(4, 2)*pol_y(2, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(1, 3)*pol_y(1, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(2, 3)*pol_y(1, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(3, 3)*pol_y(2, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(4, 3)*pol_y(2, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(1, 4)*pol_y(1, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(2, 4)*pol_y(1, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(3, 4)*pol_y(2, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(4, 4)*pol_y(2, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(1, 0)*pol_y(1, 2, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(2, 0)*pol_y(1, 2, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(3, 0)*pol_y(2, 2, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(4, 0)*pol_y(2, 2, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(1, 1)*pol_y(1, 2, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(2, 1)*pol_y(1, 2, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(3, 1)*pol_y(2, 2, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(4, 1)*pol_y(2, 2, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(1, 2)*pol_y(1, 2, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(2, 2)*pol_y(1, 2, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(3, 2)*pol_y(2, 2, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(4, 2)*pol_y(2, 2, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(1, 3)*pol_y(1, 2, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(2, 3)*pol_y(1, 2, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(3, 3)*pol_y(2, 2, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(4, 3)*pol_y(2, 2, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(1, 0)*pol_y(1, 3, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(2, 0)*pol_y(1, 3, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(3, 0)*pol_y(2, 3, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(4, 0)*pol_y(2, 3, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(1, 1)*pol_y(1, 3, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(2, 1)*pol_y(1, 3, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(3, 1)*pol_y(2, 3, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(4, 1)*pol_y(2, 3, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(1, 2)*pol_y(1, 3, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(2, 2)*pol_y(1, 3, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(3, 2)*pol_y(2, 3, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(4, 2)*pol_y(2, 3, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(1, 0)*pol_y(1, 4, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(2, 0)*pol_y(1, 4, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(3, 0)*pol_y(2, 4, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(4, 0)*pol_y(2, 4, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(1, 1)*pol_y(1, 4, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(2, 1)*pol_y(1, 4, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(3, 1)*pol_y(2, 4, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(4, 1)*pol_y(2, 4, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(1, 0)*pol_y(1, 5, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(2, 0)*pol_y(1, 5, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(3, 0)*pol_y(2, 5, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(4, 0)*pol_y(2, 5, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 2)*pol_y(1, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 2)*pol_y(1, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 2)*pol_y(2, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 2)*pol_y(2, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(1, 3)*pol_y(1, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(2, 3)*pol_y(1, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(3, 3)*pol_y(2, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(4, 3)*pol_y(2, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(1, 4)*pol_y(1, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(2, 4)*pol_y(1, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(3, 4)*pol_y(2, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(4, 4)*pol_y(2, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(1, 5)*pol_y(1, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(2, 5)*pol_y(1, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(3, 5)*pol_y(2, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(4, 5)*pol_y(2, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(1, 1)*pol_y(1, 1, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(2, 1)*pol_y(1, 1, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(3, 1)*pol_y(2, 1, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(4, 1)*pol_y(2, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(1, 2)*pol_y(1, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(2, 2)*pol_y(1, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(3, 2)*pol_y(2, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(4, 2)*pol_y(2, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(1, 3)*pol_y(1, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(2, 3)*pol_y(1, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(3, 3)*pol_y(2, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(4, 3)*pol_y(2, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(1, 4)*pol_y(1, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(2, 4)*pol_y(1, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(3, 4)*pol_y(2, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(4, 4)*pol_y(2, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(1, 0)*pol_y(1, 2, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(2, 0)*pol_y(1, 2, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(3, 0)*pol_y(2, 2, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(4, 0)*pol_y(2, 2, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(1, 1)*pol_y(1, 2, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(2, 1)*pol_y(1, 2, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(3, 1)*pol_y(2, 2, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(4, 1)*pol_y(2, 2, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(1, 2)*pol_y(1, 2, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(2, 2)*pol_y(1, 2, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(3, 2)*pol_y(2, 2, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(4, 2)*pol_y(2, 2, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(1, 3)*pol_y(1, 2, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(2, 3)*pol_y(1, 2, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(3, 3)*pol_y(2, 2, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(4, 3)*pol_y(2, 2, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(1, 0)*pol_y(1, 3, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(2, 0)*pol_y(1, 3, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(3, 0)*pol_y(2, 3, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(4, 0)*pol_y(2, 3, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(1, 1)*pol_y(1, 3, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(2, 1)*pol_y(1, 3, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(3, 1)*pol_y(2, 3, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(4, 1)*pol_y(2, 3, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(1, 2)*pol_y(1, 3, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(2, 2)*pol_y(1, 3, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(3, 2)*pol_y(2, 3, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(4, 2)*pol_y(2, 3, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(1, 0)*pol_y(1, 4, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(2, 0)*pol_y(1, 4, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(3, 0)*pol_y(2, 4, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(4, 0)*pol_y(2, 4, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(1, 1)*pol_y(1, 4, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(2, 1)*pol_y(1, 4, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(3, 1)*pol_y(2, 4, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(4, 1)*pol_y(2, 4, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(1, 0)*pol_y(1, 5, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(2, 0)*pol_y(1, 5, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(3, 0)*pol_y(2, 5, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(4, 0)*pol_y(2, 5, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 11)*pol_z(1, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 11)*pol_z(2, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 12)*pol_z(1, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 12)*pol_z(2, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 13)*pol_z(1, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 13)*pol_z(2, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 14)*pol_z(1, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 14)*pol_z(2, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 15)*pol_z(1, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 15)*pol_z(2, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 16)*pol_z(1, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 16)*pol_z(2, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 17)*pol_z(1, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 17)*pol_z(2, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 18)*pol_z(1, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 18)*pol_z(2, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 19)*pol_z(1, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 19)*pol_z(2, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 20)*pol_z(1, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 20)*pol_z(2, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(1, 21)*pol_z(1, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(2, 21)*pol_z(2, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(1, 5)*pol_z(1, 1, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(2, 5)*pol_z(2, 1, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(1, 7)*pol_z(1, 1, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(2, 7)*pol_z(2, 1, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(1, 8)*pol_z(1, 1, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(2, 8)*pol_z(2, 1, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(1, 9)*pol_z(1, 1, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(2, 9)*pol_z(2, 1, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(1, 10)*pol_z(1, 1, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(2, 10)*pol_z(2, 1, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(1, 12)*pol_z(1, 1, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(2, 12)*pol_z(2, 1, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(1, 13)*pol_z(1, 1, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(2, 13)*pol_z(2, 1, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(1, 14)*pol_z(1, 1, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(2, 14)*pol_z(2, 1, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(1, 16)*pol_z(1, 1, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(2, 16)*pol_z(2, 1, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(1, 17)*pol_z(1, 1, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(2, 17)*pol_z(2, 1, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(1, 19)*pol_z(1, 1, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(2, 19)*pol_z(2, 1, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(1, 3)*pol_z(1, 2, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(2, 3)*pol_z(2, 2, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(1, 4)*pol_z(1, 2, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(2, 4)*pol_z(2, 2, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(1, 7)*pol_z(1, 2, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(2, 7)*pol_z(2, 2, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(1, 8)*pol_z(1, 2, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(2, 8)*pol_z(2, 2, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(1, 9)*pol_z(1, 2, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(2, 9)*pol_z(2, 2, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(1, 12)*pol_z(1, 2, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(2, 12)*pol_z(2, 2, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(1, 13)*pol_z(1, 2, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(2, 13)*pol_z(2, 2, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(1, 16)*pol_z(1, 2, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(2, 16)*pol_z(2, 2, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(2, 1)*pol_z(2, 3, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(1, 2)*pol_z(1, 3, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(2, 2)*pol_z(2, 3, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(1, 3)*pol_z(1, 3, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(2, 3)*pol_z(2, 3, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(1, 7)*pol_z(1, 3, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(2, 7)*pol_z(2, 3, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(1, 8)*pol_z(1, 3, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(2, 8)*pol_z(2, 3, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(1, 12)*pol_z(1, 3, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(2, 12)*pol_z(2, 3, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(1, 1)*pol_z(1, 4, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(2, 1)*pol_z(2, 4, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(1, 2)*pol_z(1, 4, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(2, 2)*pol_z(2, 4, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(1, 7)*pol_z(1, 4, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(2, 7)*pol_z(2, 4, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(1, 1)*pol_z(1, 5, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(2, 1)*pol_z(2, 5, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 11)*pol_z(1, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 11)*pol_z(2, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 12)*pol_z(1, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 12)*pol_z(2, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 13)*pol_z(1, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 13)*pol_z(2, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 14)*pol_z(1, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 14)*pol_z(2, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 15)*pol_z(1, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 15)*pol_z(2, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 16)*pol_z(1, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 16)*pol_z(2, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 17)*pol_z(1, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 17)*pol_z(2, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 18)*pol_z(1, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 18)*pol_z(2, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 19)*pol_z(1, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 19)*pol_z(2, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 20)*pol_z(1, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 20)*pol_z(2, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(1, 21)*pol_z(1, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(2, 21)*pol_z(2, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(1, 5)*pol_z(1, 1, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(2, 5)*pol_z(2, 1, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(1, 7)*pol_z(1, 1, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(2, 7)*pol_z(2, 1, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(1, 8)*pol_z(1, 1, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(2, 8)*pol_z(2, 1, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(1, 9)*pol_z(1, 1, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(2, 9)*pol_z(2, 1, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(1, 10)*pol_z(1, 1, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(2, 10)*pol_z(2, 1, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(1, 12)*pol_z(1, 1, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(2, 12)*pol_z(2, 1, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(1, 13)*pol_z(1, 1, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(2, 13)*pol_z(2, 1, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(1, 14)*pol_z(1, 1, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(2, 14)*pol_z(2, 1, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(1, 16)*pol_z(1, 1, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(2, 16)*pol_z(2, 1, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(1, 17)*pol_z(1, 1, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(2, 17)*pol_z(2, 1, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(1, 19)*pol_z(1, 1, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(2, 19)*pol_z(2, 1, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(1, 3)*pol_z(1, 2, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(2, 3)*pol_z(2, 2, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(1, 4)*pol_z(1, 2, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(2, 4)*pol_z(2, 2, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(1, 7)*pol_z(1, 2, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(2, 7)*pol_z(2, 2, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(1, 8)*pol_z(1, 2, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(2, 8)*pol_z(2, 2, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(1, 9)*pol_z(1, 2, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(2, 9)*pol_z(2, 2, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(1, 12)*pol_z(1, 2, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(2, 12)*pol_z(2, 2, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(1, 13)*pol_z(1, 2, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(2, 13)*pol_z(2, 2, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(1, 16)*pol_z(1, 2, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(2, 16)*pol_z(2, 2, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(1, 2)*pol_z(1, 3, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(2, 2)*pol_z(2, 3, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(1, 3)*pol_z(1, 3, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(2, 3)*pol_z(2, 3, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(1, 7)*pol_z(1, 3, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(2, 7)*pol_z(2, 3, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(1, 8)*pol_z(1, 3, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(2, 8)*pol_z(2, 3, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(1, 12)*pol_z(1, 3, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(2, 12)*pol_z(2, 3, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(1, 1)*pol_z(1, 4, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(2, 1)*pol_z(2, 4, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(1, 2)*pol_z(1, 4, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(2, 2)*pol_z(2, 4, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(1, 7)*pol_z(1, 4, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(2, 7)*pol_z(2, 4, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(1, 1)*pol_z(1, 5, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(2, 1)*pol_z(2, 5, kg) END DO END SUBROUTINE integrate_core_5 @@ -1096,13 +1096,13 @@ SUBROUTINE integrate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -1110,23 +1110,23 @@ SUBROUTINE integrate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -1135,316 +1135,316 @@ SUBROUTINE integrate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = grid(i, j, k2) s03 = grid(i, j2, k) s04 = grid(i, j2, k2) - coef_x(1, 0) = coef_x(1, 0)+s01*pol_x(0, ig) - coef_x(2, 0) = coef_x(2, 0)+s02*pol_x(0, ig) - coef_x(3, 0) = coef_x(3, 0)+s03*pol_x(0, ig) - coef_x(4, 0) = coef_x(4, 0)+s04*pol_x(0, ig) - coef_x(1, 1) = coef_x(1, 1)+s01*pol_x(1, ig) - coef_x(2, 1) = coef_x(2, 1)+s02*pol_x(1, ig) - coef_x(3, 1) = coef_x(3, 1)+s03*pol_x(1, ig) - coef_x(4, 1) = coef_x(4, 1)+s04*pol_x(1, ig) - coef_x(1, 2) = coef_x(1, 2)+s01*pol_x(2, ig) - coef_x(2, 2) = coef_x(2, 2)+s02*pol_x(2, ig) - coef_x(3, 2) = coef_x(3, 2)+s03*pol_x(2, ig) - coef_x(4, 2) = coef_x(4, 2)+s04*pol_x(2, ig) - coef_x(1, 3) = coef_x(1, 3)+s01*pol_x(3, ig) - coef_x(2, 3) = coef_x(2, 3)+s02*pol_x(3, ig) - coef_x(3, 3) = coef_x(3, 3)+s03*pol_x(3, ig) - coef_x(4, 3) = coef_x(4, 3)+s04*pol_x(3, ig) - coef_x(1, 4) = coef_x(1, 4)+s01*pol_x(4, ig) - coef_x(2, 4) = coef_x(2, 4)+s02*pol_x(4, ig) - coef_x(3, 4) = coef_x(3, 4)+s03*pol_x(4, ig) - coef_x(4, 4) = coef_x(4, 4)+s04*pol_x(4, ig) - coef_x(1, 5) = coef_x(1, 5)+s01*pol_x(5, ig) - coef_x(2, 5) = coef_x(2, 5)+s02*pol_x(5, ig) - coef_x(3, 5) = coef_x(3, 5)+s03*pol_x(5, ig) - coef_x(4, 5) = coef_x(4, 5)+s04*pol_x(5, ig) - coef_x(1, 6) = coef_x(1, 6)+s01*pol_x(6, ig) - coef_x(2, 6) = coef_x(2, 6)+s02*pol_x(6, ig) - coef_x(3, 6) = coef_x(3, 6)+s03*pol_x(6, ig) - coef_x(4, 6) = coef_x(4, 6)+s04*pol_x(6, ig) + coef_x(1, 0) = coef_x(1, 0) + s01*pol_x(0, ig) + coef_x(2, 0) = coef_x(2, 0) + s02*pol_x(0, ig) + coef_x(3, 0) = coef_x(3, 0) + s03*pol_x(0, ig) + coef_x(4, 0) = coef_x(4, 0) + s04*pol_x(0, ig) + coef_x(1, 1) = coef_x(1, 1) + s01*pol_x(1, ig) + coef_x(2, 1) = coef_x(2, 1) + s02*pol_x(1, ig) + coef_x(3, 1) = coef_x(3, 1) + s03*pol_x(1, ig) + coef_x(4, 1) = coef_x(4, 1) + s04*pol_x(1, ig) + coef_x(1, 2) = coef_x(1, 2) + s01*pol_x(2, ig) + coef_x(2, 2) = coef_x(2, 2) + s02*pol_x(2, ig) + coef_x(3, 2) = coef_x(3, 2) + s03*pol_x(2, ig) + coef_x(4, 2) = coef_x(4, 2) + s04*pol_x(2, ig) + coef_x(1, 3) = coef_x(1, 3) + s01*pol_x(3, ig) + coef_x(2, 3) = coef_x(2, 3) + s02*pol_x(3, ig) + coef_x(3, 3) = coef_x(3, 3) + s03*pol_x(3, ig) + coef_x(4, 3) = coef_x(4, 3) + s04*pol_x(3, ig) + coef_x(1, 4) = coef_x(1, 4) + s01*pol_x(4, ig) + coef_x(2, 4) = coef_x(2, 4) + s02*pol_x(4, ig) + coef_x(3, 4) = coef_x(3, 4) + s03*pol_x(4, ig) + coef_x(4, 4) = coef_x(4, 4) + s04*pol_x(4, ig) + coef_x(1, 5) = coef_x(1, 5) + s01*pol_x(5, ig) + coef_x(2, 5) = coef_x(2, 5) + s02*pol_x(5, ig) + coef_x(3, 5) = coef_x(3, 5) + s03*pol_x(5, ig) + coef_x(4, 5) = coef_x(4, 5) + s04*pol_x(5, ig) + coef_x(1, 6) = coef_x(1, 6) + s01*pol_x(6, ig) + coef_x(2, 6) = coef_x(2, 6) + s02*pol_x(6, ig) + coef_x(3, 6) = coef_x(3, 6) + s03*pol_x(6, ig) + coef_x(4, 6) = coef_x(4, 6) + s04*pol_x(6, ig) END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 2)*pol_y(1, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 2)*pol_y(1, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 2)*pol_y(2, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 2)*pol_y(2, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(1, 3)*pol_y(1, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(2, 3)*pol_y(1, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(3, 3)*pol_y(2, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(4, 3)*pol_y(2, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(1, 4)*pol_y(1, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(2, 4)*pol_y(1, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(3, 4)*pol_y(2, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(4, 4)*pol_y(2, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(1, 5)*pol_y(1, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(2, 5)*pol_y(1, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(3, 5)*pol_y(2, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(4, 5)*pol_y(2, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(1, 6)*pol_y(1, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(2, 6)*pol_y(1, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(3, 6)*pol_y(2, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(4, 6)*pol_y(2, 0, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(4, 0)*pol_y(2, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(1, 1)*pol_y(1, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(2, 1)*pol_y(1, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(3, 1)*pol_y(2, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(4, 1)*pol_y(2, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(1, 2)*pol_y(1, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(2, 2)*pol_y(1, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(3, 2)*pol_y(2, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(4, 2)*pol_y(2, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(1, 3)*pol_y(1, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(2, 3)*pol_y(1, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(3, 3)*pol_y(2, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(4, 3)*pol_y(2, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(1, 4)*pol_y(1, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(2, 4)*pol_y(1, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(3, 4)*pol_y(2, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(4, 4)*pol_y(2, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(1, 5)*pol_y(1, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(2, 5)*pol_y(1, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(3, 5)*pol_y(2, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(4, 5)*pol_y(2, 1, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(1, 0)*pol_y(1, 2, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(2, 0)*pol_y(1, 2, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(3, 0)*pol_y(2, 2, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(4, 0)*pol_y(2, 2, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(1, 1)*pol_y(1, 2, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(2, 1)*pol_y(1, 2, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(3, 1)*pol_y(2, 2, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(4, 1)*pol_y(2, 2, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(1, 2)*pol_y(1, 2, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(2, 2)*pol_y(1, 2, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(3, 2)*pol_y(2, 2, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(4, 2)*pol_y(2, 2, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(1, 3)*pol_y(1, 2, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(2, 3)*pol_y(1, 2, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(3, 3)*pol_y(2, 2, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(4, 3)*pol_y(2, 2, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(1, 4)*pol_y(1, 2, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(2, 4)*pol_y(1, 2, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(3, 4)*pol_y(2, 2, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(4, 4)*pol_y(2, 2, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(1, 0)*pol_y(1, 3, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(2, 0)*pol_y(1, 3, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(3, 0)*pol_y(2, 3, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(4, 0)*pol_y(2, 3, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(1, 1)*pol_y(1, 3, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(2, 1)*pol_y(1, 3, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(3, 1)*pol_y(2, 3, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(4, 1)*pol_y(2, 3, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(1, 2)*pol_y(1, 3, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(2, 2)*pol_y(1, 3, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(3, 2)*pol_y(2, 3, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(4, 2)*pol_y(2, 3, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(1, 3)*pol_y(1, 3, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(2, 3)*pol_y(1, 3, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(3, 3)*pol_y(2, 3, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(4, 3)*pol_y(2, 3, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(1, 0)*pol_y(1, 4, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(2, 0)*pol_y(1, 4, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(3, 0)*pol_y(2, 4, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(4, 0)*pol_y(2, 4, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(1, 1)*pol_y(1, 4, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(2, 1)*pol_y(1, 4, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(3, 1)*pol_y(2, 4, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(4, 1)*pol_y(2, 4, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(1, 2)*pol_y(1, 4, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(2, 2)*pol_y(1, 4, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(3, 2)*pol_y(2, 4, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(4, 2)*pol_y(2, 4, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(1, 0)*pol_y(1, 5, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(2, 0)*pol_y(1, 5, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(3, 0)*pol_y(2, 5, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(4, 0)*pol_y(2, 5, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(1, 1)*pol_y(1, 5, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(2, 1)*pol_y(1, 5, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(3, 1)*pol_y(2, 5, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(4, 1)*pol_y(2, 5, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(1, 0)*pol_y(1, 6, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(2, 0)*pol_y(1, 6, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(3, 0)*pol_y(2, 6, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(4, 0)*pol_y(2, 6, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 2)*pol_y(1, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 2)*pol_y(1, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 2)*pol_y(2, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 2)*pol_y(2, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(1, 3)*pol_y(1, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(2, 3)*pol_y(1, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(3, 3)*pol_y(2, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(4, 3)*pol_y(2, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(1, 4)*pol_y(1, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(2, 4)*pol_y(1, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(3, 4)*pol_y(2, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(4, 4)*pol_y(2, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(1, 5)*pol_y(1, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(2, 5)*pol_y(1, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(3, 5)*pol_y(2, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(4, 5)*pol_y(2, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(1, 6)*pol_y(1, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(2, 6)*pol_y(1, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(3, 6)*pol_y(2, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(4, 6)*pol_y(2, 0, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(1, 1)*pol_y(1, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(2, 1)*pol_y(1, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(3, 1)*pol_y(2, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(4, 1)*pol_y(2, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(1, 2)*pol_y(1, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(2, 2)*pol_y(1, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(3, 2)*pol_y(2, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(4, 2)*pol_y(2, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(1, 3)*pol_y(1, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(2, 3)*pol_y(1, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(3, 3)*pol_y(2, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(4, 3)*pol_y(2, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(1, 4)*pol_y(1, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(2, 4)*pol_y(1, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(3, 4)*pol_y(2, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(4, 4)*pol_y(2, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(1, 5)*pol_y(1, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(2, 5)*pol_y(1, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(3, 5)*pol_y(2, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(4, 5)*pol_y(2, 1, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(1, 0)*pol_y(1, 2, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(2, 0)*pol_y(1, 2, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(3, 0)*pol_y(2, 2, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(4, 0)*pol_y(2, 2, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(1, 1)*pol_y(1, 2, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(2, 1)*pol_y(1, 2, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(3, 1)*pol_y(2, 2, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(4, 1)*pol_y(2, 2, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(1, 2)*pol_y(1, 2, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(2, 2)*pol_y(1, 2, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(3, 2)*pol_y(2, 2, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(4, 2)*pol_y(2, 2, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(1, 3)*pol_y(1, 2, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(2, 3)*pol_y(1, 2, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(3, 3)*pol_y(2, 2, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(4, 3)*pol_y(2, 2, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(1, 4)*pol_y(1, 2, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(2, 4)*pol_y(1, 2, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(3, 4)*pol_y(2, 2, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(4, 4)*pol_y(2, 2, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(1, 0)*pol_y(1, 3, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(2, 0)*pol_y(1, 3, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(3, 0)*pol_y(2, 3, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(4, 0)*pol_y(2, 3, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(1, 1)*pol_y(1, 3, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(2, 1)*pol_y(1, 3, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(3, 1)*pol_y(2, 3, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(4, 1)*pol_y(2, 3, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(1, 2)*pol_y(1, 3, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(2, 2)*pol_y(1, 3, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(3, 2)*pol_y(2, 3, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(4, 2)*pol_y(2, 3, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(1, 3)*pol_y(1, 3, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(2, 3)*pol_y(1, 3, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(3, 3)*pol_y(2, 3, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(4, 3)*pol_y(2, 3, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(1, 0)*pol_y(1, 4, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(2, 0)*pol_y(1, 4, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(3, 0)*pol_y(2, 4, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(4, 0)*pol_y(2, 4, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(1, 1)*pol_y(1, 4, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(2, 1)*pol_y(1, 4, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(3, 1)*pol_y(2, 4, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(4, 1)*pol_y(2, 4, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(1, 2)*pol_y(1, 4, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(2, 2)*pol_y(1, 4, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(3, 2)*pol_y(2, 4, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(4, 2)*pol_y(2, 4, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(1, 0)*pol_y(1, 5, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(2, 0)*pol_y(1, 5, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(3, 0)*pol_y(2, 5, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(4, 0)*pol_y(2, 5, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(1, 1)*pol_y(1, 5, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(2, 1)*pol_y(1, 5, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(3, 1)*pol_y(2, 5, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(4, 1)*pol_y(2, 5, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(1, 0)*pol_y(1, 6, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(2, 0)*pol_y(1, 6, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(3, 0)*pol_y(2, 6, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(4, 0)*pol_y(2, 6, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 11)*pol_z(1, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 11)*pol_z(2, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 12)*pol_z(1, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 12)*pol_z(2, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 13)*pol_z(1, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 13)*pol_z(2, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 14)*pol_z(1, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 14)*pol_z(2, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 15)*pol_z(1, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 15)*pol_z(2, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 16)*pol_z(1, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 16)*pol_z(2, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 17)*pol_z(1, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 17)*pol_z(2, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 18)*pol_z(1, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 18)*pol_z(2, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 19)*pol_z(1, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 19)*pol_z(2, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 20)*pol_z(1, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 20)*pol_z(2, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(1, 21)*pol_z(1, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(2, 21)*pol_z(2, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(1, 22)*pol_z(1, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(2, 22)*pol_z(2, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(1, 23)*pol_z(1, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(2, 23)*pol_z(2, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(1, 24)*pol_z(1, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(2, 24)*pol_z(2, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(1, 25)*pol_z(1, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(2, 25)*pol_z(2, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(1, 26)*pol_z(1, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(2, 26)*pol_z(2, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(1, 27)*pol_z(1, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(2, 27)*pol_z(2, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(1, 28)*pol_z(1, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(2, 28)*pol_z(2, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(1, 5)*pol_z(1, 1, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(2, 5)*pol_z(2, 1, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(1, 8)*pol_z(1, 1, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(2, 8)*pol_z(2, 1, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(1, 9)*pol_z(1, 1, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(2, 9)*pol_z(2, 1, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(1, 10)*pol_z(1, 1, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(2, 10)*pol_z(2, 1, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(1, 11)*pol_z(1, 1, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(2, 11)*pol_z(2, 1, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(1, 12)*pol_z(1, 1, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(2, 12)*pol_z(2, 1, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(1, 14)*pol_z(1, 1, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(2, 14)*pol_z(2, 1, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(1, 15)*pol_z(1, 1, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(2, 15)*pol_z(2, 1, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(1, 16)*pol_z(1, 1, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(2, 16)*pol_z(2, 1, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(1, 17)*pol_z(1, 1, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(2, 17)*pol_z(2, 1, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(1, 19)*pol_z(1, 1, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(2, 19)*pol_z(2, 1, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(1, 20)*pol_z(1, 1, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(2, 20)*pol_z(2, 1, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(1, 21)*pol_z(1, 1, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(2, 21)*pol_z(2, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(1, 23)*pol_z(1, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(2, 23)*pol_z(2, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(1, 24)*pol_z(1, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(2, 24)*pol_z(2, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(1, 26)*pol_z(1, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(2, 26)*pol_z(2, 1, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(1, 3)*pol_z(1, 2, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(2, 3)*pol_z(2, 2, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(1, 4)*pol_z(1, 2, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(2, 4)*pol_z(2, 2, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(1, 5)*pol_z(1, 2, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(2, 5)*pol_z(2, 2, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(1, 8)*pol_z(1, 2, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(2, 8)*pol_z(2, 2, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(1, 9)*pol_z(1, 2, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(2, 9)*pol_z(2, 2, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(1, 10)*pol_z(1, 2, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(2, 10)*pol_z(2, 2, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(1, 11)*pol_z(1, 2, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(2, 11)*pol_z(2, 2, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(1, 14)*pol_z(1, 2, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(2, 14)*pol_z(2, 2, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(1, 15)*pol_z(1, 2, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(2, 15)*pol_z(2, 2, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(1, 16)*pol_z(1, 2, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(2, 16)*pol_z(2, 2, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(1, 19)*pol_z(1, 2, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(2, 19)*pol_z(2, 2, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(1, 20)*pol_z(1, 2, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(2, 20)*pol_z(2, 2, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(1, 23)*pol_z(1, 2, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(2, 23)*pol_z(2, 2, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(2, 1)*pol_z(2, 3, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(1, 2)*pol_z(1, 3, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(2, 2)*pol_z(2, 3, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(1, 3)*pol_z(1, 3, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(2, 3)*pol_z(2, 3, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(1, 4)*pol_z(1, 3, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(2, 4)*pol_z(2, 3, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(1, 8)*pol_z(1, 3, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(2, 8)*pol_z(2, 3, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(1, 9)*pol_z(1, 3, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(2, 9)*pol_z(2, 3, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(1, 10)*pol_z(1, 3, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(2, 10)*pol_z(2, 3, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(1, 14)*pol_z(1, 3, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(2, 14)*pol_z(2, 3, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(1, 15)*pol_z(1, 3, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(2, 15)*pol_z(2, 3, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(1, 19)*pol_z(1, 3, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(2, 19)*pol_z(2, 3, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(1, 1)*pol_z(1, 4, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(2, 1)*pol_z(2, 4, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(1, 2)*pol_z(1, 4, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(2, 2)*pol_z(2, 4, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(1, 3)*pol_z(1, 4, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(2, 3)*pol_z(2, 4, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(1, 8)*pol_z(1, 4, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(2, 8)*pol_z(2, 4, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(1, 9)*pol_z(1, 4, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(2, 9)*pol_z(2, 4, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(1, 14)*pol_z(1, 4, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(2, 14)*pol_z(2, 4, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(1, 1)*pol_z(1, 5, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(2, 1)*pol_z(2, 5, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(1, 2)*pol_z(1, 5, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(2, 2)*pol_z(2, 5, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(1, 8)*pol_z(1, 5, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(2, 8)*pol_z(2, 5, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(1, 1)*pol_z(1, 6, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(2, 1)*pol_z(2, 6, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 11)*pol_z(1, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 11)*pol_z(2, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 12)*pol_z(1, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 12)*pol_z(2, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 13)*pol_z(1, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 13)*pol_z(2, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 14)*pol_z(1, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 14)*pol_z(2, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 15)*pol_z(1, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 15)*pol_z(2, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 16)*pol_z(1, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 16)*pol_z(2, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 17)*pol_z(1, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 17)*pol_z(2, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 18)*pol_z(1, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 18)*pol_z(2, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 19)*pol_z(1, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 19)*pol_z(2, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 20)*pol_z(1, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 20)*pol_z(2, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(1, 21)*pol_z(1, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(2, 21)*pol_z(2, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(1, 22)*pol_z(1, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(2, 22)*pol_z(2, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(1, 23)*pol_z(1, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(2, 23)*pol_z(2, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(1, 24)*pol_z(1, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(2, 24)*pol_z(2, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(1, 25)*pol_z(1, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(2, 25)*pol_z(2, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(1, 26)*pol_z(1, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(2, 26)*pol_z(2, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(1, 27)*pol_z(1, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(2, 27)*pol_z(2, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(1, 28)*pol_z(1, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(2, 28)*pol_z(2, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(1, 5)*pol_z(1, 1, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(2, 5)*pol_z(2, 1, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(1, 8)*pol_z(1, 1, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(2, 8)*pol_z(2, 1, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(1, 9)*pol_z(1, 1, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(2, 9)*pol_z(2, 1, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(1, 10)*pol_z(1, 1, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(2, 10)*pol_z(2, 1, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(1, 11)*pol_z(1, 1, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(2, 11)*pol_z(2, 1, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(1, 12)*pol_z(1, 1, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(2, 12)*pol_z(2, 1, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(1, 14)*pol_z(1, 1, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(2, 14)*pol_z(2, 1, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(1, 15)*pol_z(1, 1, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(2, 15)*pol_z(2, 1, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(1, 16)*pol_z(1, 1, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(2, 16)*pol_z(2, 1, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(1, 17)*pol_z(1, 1, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(2, 17)*pol_z(2, 1, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(1, 19)*pol_z(1, 1, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(2, 19)*pol_z(2, 1, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(1, 20)*pol_z(1, 1, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(2, 20)*pol_z(2, 1, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(1, 21)*pol_z(1, 1, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(2, 21)*pol_z(2, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(1, 23)*pol_z(1, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(2, 23)*pol_z(2, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(1, 24)*pol_z(1, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(2, 24)*pol_z(2, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(1, 26)*pol_z(1, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(2, 26)*pol_z(2, 1, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(1, 3)*pol_z(1, 2, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(2, 3)*pol_z(2, 2, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(1, 4)*pol_z(1, 2, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(2, 4)*pol_z(2, 2, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(1, 5)*pol_z(1, 2, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(2, 5)*pol_z(2, 2, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(1, 8)*pol_z(1, 2, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(2, 8)*pol_z(2, 2, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(1, 9)*pol_z(1, 2, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(2, 9)*pol_z(2, 2, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(1, 10)*pol_z(1, 2, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(2, 10)*pol_z(2, 2, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(1, 11)*pol_z(1, 2, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(2, 11)*pol_z(2, 2, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(1, 14)*pol_z(1, 2, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(2, 14)*pol_z(2, 2, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(1, 15)*pol_z(1, 2, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(2, 15)*pol_z(2, 2, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(1, 16)*pol_z(1, 2, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(2, 16)*pol_z(2, 2, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(1, 19)*pol_z(1, 2, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(2, 19)*pol_z(2, 2, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(1, 20)*pol_z(1, 2, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(2, 20)*pol_z(2, 2, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(1, 23)*pol_z(1, 2, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(2, 23)*pol_z(2, 2, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(1, 2)*pol_z(1, 3, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(2, 2)*pol_z(2, 3, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(1, 3)*pol_z(1, 3, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(2, 3)*pol_z(2, 3, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(1, 4)*pol_z(1, 3, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(2, 4)*pol_z(2, 3, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(1, 8)*pol_z(1, 3, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(2, 8)*pol_z(2, 3, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(1, 9)*pol_z(1, 3, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(2, 9)*pol_z(2, 3, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(1, 10)*pol_z(1, 3, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(2, 10)*pol_z(2, 3, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(1, 14)*pol_z(1, 3, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(2, 14)*pol_z(2, 3, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(1, 15)*pol_z(1, 3, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(2, 15)*pol_z(2, 3, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(1, 19)*pol_z(1, 3, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(2, 19)*pol_z(2, 3, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(1, 1)*pol_z(1, 4, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(2, 1)*pol_z(2, 4, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(1, 2)*pol_z(1, 4, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(2, 2)*pol_z(2, 4, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(1, 3)*pol_z(1, 4, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(2, 3)*pol_z(2, 4, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(1, 8)*pol_z(1, 4, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(2, 8)*pol_z(2, 4, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(1, 9)*pol_z(1, 4, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(2, 9)*pol_z(2, 4, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(1, 14)*pol_z(1, 4, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(2, 14)*pol_z(2, 4, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(1, 1)*pol_z(1, 5, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(2, 1)*pol_z(2, 5, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(1, 2)*pol_z(1, 5, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(2, 2)*pol_z(2, 5, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(1, 8)*pol_z(1, 5, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(2, 8)*pol_z(2, 5, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(1, 1)*pol_z(1, 6, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(2, 1)*pol_z(2, 6, kg) END DO END SUBROUTINE integrate_core_6 @@ -1471,13 +1471,13 @@ SUBROUTINE integrate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -1485,23 +1485,23 @@ SUBROUTINE integrate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -1510,424 +1510,424 @@ SUBROUTINE integrate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = grid(i, j, k2) s03 = grid(i, j2, k) s04 = grid(i, j2, k2) - coef_x(1, 0) = coef_x(1, 0)+s01*pol_x(0, ig) - coef_x(2, 0) = coef_x(2, 0)+s02*pol_x(0, ig) - coef_x(3, 0) = coef_x(3, 0)+s03*pol_x(0, ig) - coef_x(4, 0) = coef_x(4, 0)+s04*pol_x(0, ig) - coef_x(1, 1) = coef_x(1, 1)+s01*pol_x(1, ig) - coef_x(2, 1) = coef_x(2, 1)+s02*pol_x(1, ig) - coef_x(3, 1) = coef_x(3, 1)+s03*pol_x(1, ig) - coef_x(4, 1) = coef_x(4, 1)+s04*pol_x(1, ig) - coef_x(1, 2) = coef_x(1, 2)+s01*pol_x(2, ig) - coef_x(2, 2) = coef_x(2, 2)+s02*pol_x(2, ig) - coef_x(3, 2) = coef_x(3, 2)+s03*pol_x(2, ig) - coef_x(4, 2) = coef_x(4, 2)+s04*pol_x(2, ig) - coef_x(1, 3) = coef_x(1, 3)+s01*pol_x(3, ig) - coef_x(2, 3) = coef_x(2, 3)+s02*pol_x(3, ig) - coef_x(3, 3) = coef_x(3, 3)+s03*pol_x(3, ig) - coef_x(4, 3) = coef_x(4, 3)+s04*pol_x(3, ig) - coef_x(1, 4) = coef_x(1, 4)+s01*pol_x(4, ig) - coef_x(2, 4) = coef_x(2, 4)+s02*pol_x(4, ig) - coef_x(3, 4) = coef_x(3, 4)+s03*pol_x(4, ig) - coef_x(4, 4) = coef_x(4, 4)+s04*pol_x(4, ig) - coef_x(1, 5) = coef_x(1, 5)+s01*pol_x(5, ig) - coef_x(2, 5) = coef_x(2, 5)+s02*pol_x(5, ig) - coef_x(3, 5) = coef_x(3, 5)+s03*pol_x(5, ig) - coef_x(4, 5) = coef_x(4, 5)+s04*pol_x(5, ig) - coef_x(1, 6) = coef_x(1, 6)+s01*pol_x(6, ig) - coef_x(2, 6) = coef_x(2, 6)+s02*pol_x(6, ig) - coef_x(3, 6) = coef_x(3, 6)+s03*pol_x(6, ig) - coef_x(4, 6) = coef_x(4, 6)+s04*pol_x(6, ig) - coef_x(1, 7) = coef_x(1, 7)+s01*pol_x(7, ig) - coef_x(2, 7) = coef_x(2, 7)+s02*pol_x(7, ig) - coef_x(3, 7) = coef_x(3, 7)+s03*pol_x(7, ig) - coef_x(4, 7) = coef_x(4, 7)+s04*pol_x(7, ig) + coef_x(1, 0) = coef_x(1, 0) + s01*pol_x(0, ig) + coef_x(2, 0) = coef_x(2, 0) + s02*pol_x(0, ig) + coef_x(3, 0) = coef_x(3, 0) + s03*pol_x(0, ig) + coef_x(4, 0) = coef_x(4, 0) + s04*pol_x(0, ig) + coef_x(1, 1) = coef_x(1, 1) + s01*pol_x(1, ig) + coef_x(2, 1) = coef_x(2, 1) + s02*pol_x(1, ig) + coef_x(3, 1) = coef_x(3, 1) + s03*pol_x(1, ig) + coef_x(4, 1) = coef_x(4, 1) + s04*pol_x(1, ig) + coef_x(1, 2) = coef_x(1, 2) + s01*pol_x(2, ig) + coef_x(2, 2) = coef_x(2, 2) + s02*pol_x(2, ig) + coef_x(3, 2) = coef_x(3, 2) + s03*pol_x(2, ig) + coef_x(4, 2) = coef_x(4, 2) + s04*pol_x(2, ig) + coef_x(1, 3) = coef_x(1, 3) + s01*pol_x(3, ig) + coef_x(2, 3) = coef_x(2, 3) + s02*pol_x(3, ig) + coef_x(3, 3) = coef_x(3, 3) + s03*pol_x(3, ig) + coef_x(4, 3) = coef_x(4, 3) + s04*pol_x(3, ig) + coef_x(1, 4) = coef_x(1, 4) + s01*pol_x(4, ig) + coef_x(2, 4) = coef_x(2, 4) + s02*pol_x(4, ig) + coef_x(3, 4) = coef_x(3, 4) + s03*pol_x(4, ig) + coef_x(4, 4) = coef_x(4, 4) + s04*pol_x(4, ig) + coef_x(1, 5) = coef_x(1, 5) + s01*pol_x(5, ig) + coef_x(2, 5) = coef_x(2, 5) + s02*pol_x(5, ig) + coef_x(3, 5) = coef_x(3, 5) + s03*pol_x(5, ig) + coef_x(4, 5) = coef_x(4, 5) + s04*pol_x(5, ig) + coef_x(1, 6) = coef_x(1, 6) + s01*pol_x(6, ig) + coef_x(2, 6) = coef_x(2, 6) + s02*pol_x(6, ig) + coef_x(3, 6) = coef_x(3, 6) + s03*pol_x(6, ig) + coef_x(4, 6) = coef_x(4, 6) + s04*pol_x(6, ig) + coef_x(1, 7) = coef_x(1, 7) + s01*pol_x(7, ig) + coef_x(2, 7) = coef_x(2, 7) + s02*pol_x(7, ig) + coef_x(3, 7) = coef_x(3, 7) + s03*pol_x(7, ig) + coef_x(4, 7) = coef_x(4, 7) + s04*pol_x(7, ig) END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 2)*pol_y(1, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 2)*pol_y(1, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 2)*pol_y(2, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 2)*pol_y(2, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(1, 3)*pol_y(1, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(2, 3)*pol_y(1, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(3, 3)*pol_y(2, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(4, 3)*pol_y(2, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(1, 4)*pol_y(1, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(2, 4)*pol_y(1, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(3, 4)*pol_y(2, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(4, 4)*pol_y(2, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(1, 5)*pol_y(1, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(2, 5)*pol_y(1, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(3, 5)*pol_y(2, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(4, 5)*pol_y(2, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(1, 6)*pol_y(1, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(2, 6)*pol_y(1, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(3, 6)*pol_y(2, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(4, 6)*pol_y(2, 0, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(1, 7)*pol_y(1, 0, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(2, 7)*pol_y(1, 0, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(3, 7)*pol_y(2, 0, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(4, 7)*pol_y(2, 0, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(4, 0)*pol_y(2, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(1, 1)*pol_y(1, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(2, 1)*pol_y(1, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(3, 1)*pol_y(2, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(4, 1)*pol_y(2, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(1, 2)*pol_y(1, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(2, 2)*pol_y(1, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(3, 2)*pol_y(2, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(4, 2)*pol_y(2, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(1, 3)*pol_y(1, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(2, 3)*pol_y(1, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(3, 3)*pol_y(2, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(4, 3)*pol_y(2, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(1, 4)*pol_y(1, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(2, 4)*pol_y(1, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(3, 4)*pol_y(2, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(4, 4)*pol_y(2, 1, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(1, 5)*pol_y(1, 1, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(2, 5)*pol_y(1, 1, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(3, 5)*pol_y(2, 1, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(4, 5)*pol_y(2, 1, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(1, 6)*pol_y(1, 1, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(2, 6)*pol_y(1, 1, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(3, 6)*pol_y(2, 1, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(4, 6)*pol_y(2, 1, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(1, 0)*pol_y(1, 2, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(2, 0)*pol_y(1, 2, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(3, 0)*pol_y(2, 2, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(4, 0)*pol_y(2, 2, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(1, 1)*pol_y(1, 2, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(2, 1)*pol_y(1, 2, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(3, 1)*pol_y(2, 2, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(4, 1)*pol_y(2, 2, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(1, 2)*pol_y(1, 2, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(2, 2)*pol_y(1, 2, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(3, 2)*pol_y(2, 2, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(4, 2)*pol_y(2, 2, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(1, 3)*pol_y(1, 2, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(2, 3)*pol_y(1, 2, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(3, 3)*pol_y(2, 2, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(4, 3)*pol_y(2, 2, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(1, 4)*pol_y(1, 2, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(2, 4)*pol_y(1, 2, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(3, 4)*pol_y(2, 2, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(4, 4)*pol_y(2, 2, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(1, 5)*pol_y(1, 2, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(2, 5)*pol_y(1, 2, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(3, 5)*pol_y(2, 2, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(4, 5)*pol_y(2, 2, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(1, 0)*pol_y(1, 3, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(2, 0)*pol_y(1, 3, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(3, 0)*pol_y(2, 3, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(4, 0)*pol_y(2, 3, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(1, 1)*pol_y(1, 3, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(2, 1)*pol_y(1, 3, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(3, 1)*pol_y(2, 3, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(4, 1)*pol_y(2, 3, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(1, 2)*pol_y(1, 3, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(2, 2)*pol_y(1, 3, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(3, 2)*pol_y(2, 3, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(4, 2)*pol_y(2, 3, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(1, 3)*pol_y(1, 3, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(2, 3)*pol_y(1, 3, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(3, 3)*pol_y(2, 3, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(4, 3)*pol_y(2, 3, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(1, 4)*pol_y(1, 3, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(2, 4)*pol_y(1, 3, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(3, 4)*pol_y(2, 3, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(4, 4)*pol_y(2, 3, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(1, 0)*pol_y(1, 4, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(2, 0)*pol_y(1, 4, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(3, 0)*pol_y(2, 4, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(4, 0)*pol_y(2, 4, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(1, 1)*pol_y(1, 4, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(2, 1)*pol_y(1, 4, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(3, 1)*pol_y(2, 4, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(4, 1)*pol_y(2, 4, jg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_x(1, 2)*pol_y(1, 4, jg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_x(2, 2)*pol_y(1, 4, jg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_x(3, 2)*pol_y(2, 4, jg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_x(4, 2)*pol_y(2, 4, jg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_x(1, 3)*pol_y(1, 4, jg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_x(2, 3)*pol_y(1, 4, jg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_x(3, 3)*pol_y(2, 4, jg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_x(4, 3)*pol_y(2, 4, jg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_x(1, 0)*pol_y(1, 5, jg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_x(2, 0)*pol_y(1, 5, jg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_x(3, 0)*pol_y(2, 5, jg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_x(4, 0)*pol_y(2, 5, jg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_x(1, 1)*pol_y(1, 5, jg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_x(2, 1)*pol_y(1, 5, jg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_x(3, 1)*pol_y(2, 5, jg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_x(4, 1)*pol_y(2, 5, jg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_x(1, 2)*pol_y(1, 5, jg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_x(2, 2)*pol_y(1, 5, jg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_x(3, 2)*pol_y(2, 5, jg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_x(4, 2)*pol_y(2, 5, jg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_x(1, 0)*pol_y(1, 6, jg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_x(2, 0)*pol_y(1, 6, jg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_x(3, 0)*pol_y(2, 6, jg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_x(4, 0)*pol_y(2, 6, jg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_x(1, 1)*pol_y(1, 6, jg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_x(2, 1)*pol_y(1, 6, jg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_x(3, 1)*pol_y(2, 6, jg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_x(4, 1)*pol_y(2, 6, jg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_x(1, 0)*pol_y(1, 7, jg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_x(2, 0)*pol_y(1, 7, jg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_x(3, 0)*pol_y(2, 7, jg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_x(4, 0)*pol_y(2, 7, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 2)*pol_y(1, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 2)*pol_y(1, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 2)*pol_y(2, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 2)*pol_y(2, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(1, 3)*pol_y(1, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(2, 3)*pol_y(1, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(3, 3)*pol_y(2, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(4, 3)*pol_y(2, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(1, 4)*pol_y(1, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(2, 4)*pol_y(1, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(3, 4)*pol_y(2, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(4, 4)*pol_y(2, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(1, 5)*pol_y(1, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(2, 5)*pol_y(1, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(3, 5)*pol_y(2, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(4, 5)*pol_y(2, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(1, 6)*pol_y(1, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(2, 6)*pol_y(1, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(3, 6)*pol_y(2, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(4, 6)*pol_y(2, 0, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(1, 7)*pol_y(1, 0, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(2, 7)*pol_y(1, 0, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(3, 7)*pol_y(2, 0, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(4, 7)*pol_y(2, 0, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(1, 1)*pol_y(1, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(2, 1)*pol_y(1, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(3, 1)*pol_y(2, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(4, 1)*pol_y(2, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(1, 2)*pol_y(1, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(2, 2)*pol_y(1, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(3, 2)*pol_y(2, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(4, 2)*pol_y(2, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(1, 3)*pol_y(1, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(2, 3)*pol_y(1, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(3, 3)*pol_y(2, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(4, 3)*pol_y(2, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(1, 4)*pol_y(1, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(2, 4)*pol_y(1, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(3, 4)*pol_y(2, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(4, 4)*pol_y(2, 1, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(1, 5)*pol_y(1, 1, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(2, 5)*pol_y(1, 1, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(3, 5)*pol_y(2, 1, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(4, 5)*pol_y(2, 1, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(1, 6)*pol_y(1, 1, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(2, 6)*pol_y(1, 1, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(3, 6)*pol_y(2, 1, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(4, 6)*pol_y(2, 1, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(1, 0)*pol_y(1, 2, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(2, 0)*pol_y(1, 2, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(3, 0)*pol_y(2, 2, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(4, 0)*pol_y(2, 2, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(1, 1)*pol_y(1, 2, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(2, 1)*pol_y(1, 2, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(3, 1)*pol_y(2, 2, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(4, 1)*pol_y(2, 2, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(1, 2)*pol_y(1, 2, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(2, 2)*pol_y(1, 2, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(3, 2)*pol_y(2, 2, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(4, 2)*pol_y(2, 2, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(1, 3)*pol_y(1, 2, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(2, 3)*pol_y(1, 2, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(3, 3)*pol_y(2, 2, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(4, 3)*pol_y(2, 2, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(1, 4)*pol_y(1, 2, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(2, 4)*pol_y(1, 2, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(3, 4)*pol_y(2, 2, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(4, 4)*pol_y(2, 2, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(1, 5)*pol_y(1, 2, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(2, 5)*pol_y(1, 2, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(3, 5)*pol_y(2, 2, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(4, 5)*pol_y(2, 2, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(1, 0)*pol_y(1, 3, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(2, 0)*pol_y(1, 3, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(3, 0)*pol_y(2, 3, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(4, 0)*pol_y(2, 3, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(1, 1)*pol_y(1, 3, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(2, 1)*pol_y(1, 3, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(3, 1)*pol_y(2, 3, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(4, 1)*pol_y(2, 3, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(1, 2)*pol_y(1, 3, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(2, 2)*pol_y(1, 3, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(3, 2)*pol_y(2, 3, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(4, 2)*pol_y(2, 3, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(1, 3)*pol_y(1, 3, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(2, 3)*pol_y(1, 3, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(3, 3)*pol_y(2, 3, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(4, 3)*pol_y(2, 3, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(1, 4)*pol_y(1, 3, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(2, 4)*pol_y(1, 3, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(3, 4)*pol_y(2, 3, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(4, 4)*pol_y(2, 3, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(1, 0)*pol_y(1, 4, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(2, 0)*pol_y(1, 4, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(3, 0)*pol_y(2, 4, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(4, 0)*pol_y(2, 4, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(1, 1)*pol_y(1, 4, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(2, 1)*pol_y(1, 4, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(3, 1)*pol_y(2, 4, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(4, 1)*pol_y(2, 4, jg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_x(1, 2)*pol_y(1, 4, jg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_x(2, 2)*pol_y(1, 4, jg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_x(3, 2)*pol_y(2, 4, jg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_x(4, 2)*pol_y(2, 4, jg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_x(1, 3)*pol_y(1, 4, jg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_x(2, 3)*pol_y(1, 4, jg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_x(3, 3)*pol_y(2, 4, jg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_x(4, 3)*pol_y(2, 4, jg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_x(1, 0)*pol_y(1, 5, jg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_x(2, 0)*pol_y(1, 5, jg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_x(3, 0)*pol_y(2, 5, jg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_x(4, 0)*pol_y(2, 5, jg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_x(1, 1)*pol_y(1, 5, jg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_x(2, 1)*pol_y(1, 5, jg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_x(3, 1)*pol_y(2, 5, jg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_x(4, 1)*pol_y(2, 5, jg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_x(1, 2)*pol_y(1, 5, jg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_x(2, 2)*pol_y(1, 5, jg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_x(3, 2)*pol_y(2, 5, jg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_x(4, 2)*pol_y(2, 5, jg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_x(1, 0)*pol_y(1, 6, jg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_x(2, 0)*pol_y(1, 6, jg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_x(3, 0)*pol_y(2, 6, jg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_x(4, 0)*pol_y(2, 6, jg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_x(1, 1)*pol_y(1, 6, jg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_x(2, 1)*pol_y(1, 6, jg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_x(3, 1)*pol_y(2, 6, jg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_x(4, 1)*pol_y(2, 6, jg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_x(1, 0)*pol_y(1, 7, jg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_x(2, 0)*pol_y(1, 7, jg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_x(3, 0)*pol_y(2, 7, jg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_x(4, 0)*pol_y(2, 7, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 11)*pol_z(1, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 11)*pol_z(2, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 12)*pol_z(1, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 12)*pol_z(2, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 13)*pol_z(1, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 13)*pol_z(2, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 14)*pol_z(1, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 14)*pol_z(2, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 15)*pol_z(1, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 15)*pol_z(2, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 16)*pol_z(1, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 16)*pol_z(2, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 17)*pol_z(1, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 17)*pol_z(2, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 18)*pol_z(1, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 18)*pol_z(2, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 19)*pol_z(1, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 19)*pol_z(2, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 20)*pol_z(1, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 20)*pol_z(2, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(1, 21)*pol_z(1, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(2, 21)*pol_z(2, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(1, 22)*pol_z(1, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(2, 22)*pol_z(2, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(1, 23)*pol_z(1, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(2, 23)*pol_z(2, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(1, 24)*pol_z(1, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(2, 24)*pol_z(2, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(1, 25)*pol_z(1, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(2, 25)*pol_z(2, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(1, 26)*pol_z(1, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(2, 26)*pol_z(2, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(1, 27)*pol_z(1, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(2, 27)*pol_z(2, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(1, 28)*pol_z(1, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(2, 28)*pol_z(2, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(1, 29)*pol_z(1, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(2, 29)*pol_z(2, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(1, 30)*pol_z(1, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(2, 30)*pol_z(2, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(1, 31)*pol_z(1, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(2, 31)*pol_z(2, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(1, 32)*pol_z(1, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(2, 32)*pol_z(2, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(1, 33)*pol_z(1, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(2, 33)*pol_z(2, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(1, 34)*pol_z(1, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(2, 34)*pol_z(2, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(1, 35)*pol_z(1, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(2, 35)*pol_z(2, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(1, 36)*pol_z(1, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(2, 36)*pol_z(2, 0, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(1, 5)*pol_z(1, 1, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(2, 5)*pol_z(2, 1, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(1, 7)*pol_z(1, 1, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(2, 7)*pol_z(2, 1, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(1, 9)*pol_z(1, 1, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(2, 9)*pol_z(2, 1, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(1, 10)*pol_z(1, 1, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(2, 10)*pol_z(2, 1, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(1, 11)*pol_z(1, 1, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(2, 11)*pol_z(2, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(1, 12)*pol_z(1, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(2, 12)*pol_z(2, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(1, 13)*pol_z(1, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(2, 13)*pol_z(2, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(1, 14)*pol_z(1, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(2, 14)*pol_z(2, 1, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(1, 16)*pol_z(1, 1, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(2, 16)*pol_z(2, 1, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(1, 17)*pol_z(1, 1, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(2, 17)*pol_z(2, 1, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(1, 18)*pol_z(1, 1, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(2, 18)*pol_z(2, 1, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(1, 19)*pol_z(1, 1, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(2, 19)*pol_z(2, 1, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(1, 20)*pol_z(1, 1, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(2, 20)*pol_z(2, 1, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(1, 22)*pol_z(1, 1, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(2, 22)*pol_z(2, 1, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(1, 23)*pol_z(1, 1, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(2, 23)*pol_z(2, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(1, 24)*pol_z(1, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(2, 24)*pol_z(2, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(1, 25)*pol_z(1, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(2, 25)*pol_z(2, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(1, 27)*pol_z(1, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(2, 27)*pol_z(2, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(1, 28)*pol_z(1, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(2, 28)*pol_z(2, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(1, 29)*pol_z(1, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(2, 29)*pol_z(2, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(1, 31)*pol_z(1, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(2, 31)*pol_z(2, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(1, 32)*pol_z(1, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(2, 32)*pol_z(2, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(1, 34)*pol_z(1, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(2, 34)*pol_z(2, 1, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(1, 3)*pol_z(1, 2, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(2, 3)*pol_z(2, 2, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(1, 4)*pol_z(1, 2, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(2, 4)*pol_z(2, 2, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(1, 5)*pol_z(1, 2, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(2, 5)*pol_z(2, 2, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(1, 6)*pol_z(1, 2, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(2, 6)*pol_z(2, 2, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(1, 9)*pol_z(1, 2, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(2, 9)*pol_z(2, 2, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(1, 10)*pol_z(1, 2, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(2, 10)*pol_z(2, 2, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(1, 11)*pol_z(1, 2, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(2, 11)*pol_z(2, 2, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(1, 12)*pol_z(1, 2, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(2, 12)*pol_z(2, 2, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(1, 13)*pol_z(1, 2, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(2, 13)*pol_z(2, 2, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(1, 16)*pol_z(1, 2, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(2, 16)*pol_z(2, 2, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(1, 17)*pol_z(1, 2, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(2, 17)*pol_z(2, 2, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(1, 18)*pol_z(1, 2, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(2, 18)*pol_z(2, 2, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(1, 19)*pol_z(1, 2, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(2, 19)*pol_z(2, 2, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(1, 22)*pol_z(1, 2, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(2, 22)*pol_z(2, 2, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(1, 23)*pol_z(1, 2, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(2, 23)*pol_z(2, 2, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(1, 24)*pol_z(1, 2, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(2, 24)*pol_z(2, 2, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(1, 27)*pol_z(1, 2, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(2, 27)*pol_z(2, 2, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(1, 28)*pol_z(1, 2, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(2, 28)*pol_z(2, 2, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(1, 31)*pol_z(1, 2, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(2, 31)*pol_z(2, 2, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(2, 1)*pol_z(2, 3, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(1, 2)*pol_z(1, 3, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(2, 2)*pol_z(2, 3, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(1, 3)*pol_z(1, 3, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(2, 3)*pol_z(2, 3, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(1, 4)*pol_z(1, 3, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(2, 4)*pol_z(2, 3, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(1, 5)*pol_z(1, 3, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(2, 5)*pol_z(2, 3, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(1, 9)*pol_z(1, 3, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(2, 9)*pol_z(2, 3, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(1, 10)*pol_z(1, 3, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(2, 10)*pol_z(2, 3, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(1, 11)*pol_z(1, 3, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(2, 11)*pol_z(2, 3, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(1, 12)*pol_z(1, 3, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(2, 12)*pol_z(2, 3, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(1, 16)*pol_z(1, 3, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(2, 16)*pol_z(2, 3, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(1, 17)*pol_z(1, 3, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(2, 17)*pol_z(2, 3, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(1, 18)*pol_z(1, 3, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(2, 18)*pol_z(2, 3, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(1, 22)*pol_z(1, 3, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(2, 22)*pol_z(2, 3, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(1, 23)*pol_z(1, 3, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(2, 23)*pol_z(2, 3, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(1, 27)*pol_z(1, 3, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(2, 27)*pol_z(2, 3, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(1, 1)*pol_z(1, 4, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(2, 1)*pol_z(2, 4, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(1, 2)*pol_z(1, 4, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(2, 2)*pol_z(2, 4, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(1, 3)*pol_z(1, 4, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(2, 3)*pol_z(2, 4, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(1, 4)*pol_z(1, 4, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(2, 4)*pol_z(2, 4, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(1, 9)*pol_z(1, 4, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(2, 9)*pol_z(2, 4, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(1, 10)*pol_z(1, 4, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(2, 10)*pol_z(2, 4, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(1, 11)*pol_z(1, 4, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(2, 11)*pol_z(2, 4, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(1, 16)*pol_z(1, 4, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(2, 16)*pol_z(2, 4, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(1, 17)*pol_z(1, 4, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(2, 17)*pol_z(2, 4, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(1, 22)*pol_z(1, 4, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(2, 22)*pol_z(2, 4, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(1, 1)*pol_z(1, 5, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(2, 1)*pol_z(2, 5, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(1, 2)*pol_z(1, 5, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(2, 2)*pol_z(2, 5, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(1, 3)*pol_z(1, 5, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(2, 3)*pol_z(2, 5, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(1, 9)*pol_z(1, 5, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(2, 9)*pol_z(2, 5, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(1, 10)*pol_z(1, 5, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(2, 10)*pol_z(2, 5, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(1, 16)*pol_z(1, 5, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(2, 16)*pol_z(2, 5, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(1, 1)*pol_z(1, 6, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(2, 1)*pol_z(2, 6, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(1, 2)*pol_z(1, 6, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(2, 2)*pol_z(2, 6, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(1, 9)*pol_z(1, 6, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(2, 9)*pol_z(2, 6, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(1, 1)*pol_z(1, 7, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(2, 1)*pol_z(2, 7, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 11)*pol_z(1, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 11)*pol_z(2, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 12)*pol_z(1, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 12)*pol_z(2, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 13)*pol_z(1, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 13)*pol_z(2, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 14)*pol_z(1, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 14)*pol_z(2, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 15)*pol_z(1, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 15)*pol_z(2, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 16)*pol_z(1, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 16)*pol_z(2, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 17)*pol_z(1, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 17)*pol_z(2, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 18)*pol_z(1, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 18)*pol_z(2, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 19)*pol_z(1, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 19)*pol_z(2, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 20)*pol_z(1, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 20)*pol_z(2, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(1, 21)*pol_z(1, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(2, 21)*pol_z(2, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(1, 22)*pol_z(1, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(2, 22)*pol_z(2, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(1, 23)*pol_z(1, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(2, 23)*pol_z(2, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(1, 24)*pol_z(1, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(2, 24)*pol_z(2, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(1, 25)*pol_z(1, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(2, 25)*pol_z(2, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(1, 26)*pol_z(1, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(2, 26)*pol_z(2, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(1, 27)*pol_z(1, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(2, 27)*pol_z(2, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(1, 28)*pol_z(1, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(2, 28)*pol_z(2, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(1, 29)*pol_z(1, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(2, 29)*pol_z(2, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(1, 30)*pol_z(1, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(2, 30)*pol_z(2, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(1, 31)*pol_z(1, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(2, 31)*pol_z(2, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(1, 32)*pol_z(1, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(2, 32)*pol_z(2, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(1, 33)*pol_z(1, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(2, 33)*pol_z(2, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(1, 34)*pol_z(1, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(2, 34)*pol_z(2, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(1, 35)*pol_z(1, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(2, 35)*pol_z(2, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(1, 36)*pol_z(1, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(2, 36)*pol_z(2, 0, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(1, 5)*pol_z(1, 1, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(2, 5)*pol_z(2, 1, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(1, 7)*pol_z(1, 1, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(2, 7)*pol_z(2, 1, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(1, 9)*pol_z(1, 1, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(2, 9)*pol_z(2, 1, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(1, 10)*pol_z(1, 1, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(2, 10)*pol_z(2, 1, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(1, 11)*pol_z(1, 1, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(2, 11)*pol_z(2, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(1, 12)*pol_z(1, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(2, 12)*pol_z(2, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(1, 13)*pol_z(1, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(2, 13)*pol_z(2, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(1, 14)*pol_z(1, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(2, 14)*pol_z(2, 1, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(1, 16)*pol_z(1, 1, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(2, 16)*pol_z(2, 1, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(1, 17)*pol_z(1, 1, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(2, 17)*pol_z(2, 1, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(1, 18)*pol_z(1, 1, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(2, 18)*pol_z(2, 1, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(1, 19)*pol_z(1, 1, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(2, 19)*pol_z(2, 1, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(1, 20)*pol_z(1, 1, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(2, 20)*pol_z(2, 1, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(1, 22)*pol_z(1, 1, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(2, 22)*pol_z(2, 1, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(1, 23)*pol_z(1, 1, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(2, 23)*pol_z(2, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(1, 24)*pol_z(1, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(2, 24)*pol_z(2, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(1, 25)*pol_z(1, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(2, 25)*pol_z(2, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(1, 27)*pol_z(1, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(2, 27)*pol_z(2, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(1, 28)*pol_z(1, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(2, 28)*pol_z(2, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(1, 29)*pol_z(1, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(2, 29)*pol_z(2, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(1, 31)*pol_z(1, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(2, 31)*pol_z(2, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(1, 32)*pol_z(1, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(2, 32)*pol_z(2, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(1, 34)*pol_z(1, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(2, 34)*pol_z(2, 1, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(1, 3)*pol_z(1, 2, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(2, 3)*pol_z(2, 2, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(1, 4)*pol_z(1, 2, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(2, 4)*pol_z(2, 2, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(1, 5)*pol_z(1, 2, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(2, 5)*pol_z(2, 2, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(1, 6)*pol_z(1, 2, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(2, 6)*pol_z(2, 2, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(1, 9)*pol_z(1, 2, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(2, 9)*pol_z(2, 2, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(1, 10)*pol_z(1, 2, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(2, 10)*pol_z(2, 2, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(1, 11)*pol_z(1, 2, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(2, 11)*pol_z(2, 2, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(1, 12)*pol_z(1, 2, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(2, 12)*pol_z(2, 2, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(1, 13)*pol_z(1, 2, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(2, 13)*pol_z(2, 2, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(1, 16)*pol_z(1, 2, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(2, 16)*pol_z(2, 2, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(1, 17)*pol_z(1, 2, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(2, 17)*pol_z(2, 2, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(1, 18)*pol_z(1, 2, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(2, 18)*pol_z(2, 2, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(1, 19)*pol_z(1, 2, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(2, 19)*pol_z(2, 2, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(1, 22)*pol_z(1, 2, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(2, 22)*pol_z(2, 2, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(1, 23)*pol_z(1, 2, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(2, 23)*pol_z(2, 2, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(1, 24)*pol_z(1, 2, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(2, 24)*pol_z(2, 2, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(1, 27)*pol_z(1, 2, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(2, 27)*pol_z(2, 2, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(1, 28)*pol_z(1, 2, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(2, 28)*pol_z(2, 2, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(1, 31)*pol_z(1, 2, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(2, 31)*pol_z(2, 2, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(1, 2)*pol_z(1, 3, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(2, 2)*pol_z(2, 3, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(1, 3)*pol_z(1, 3, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(2, 3)*pol_z(2, 3, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(1, 4)*pol_z(1, 3, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(2, 4)*pol_z(2, 3, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(1, 5)*pol_z(1, 3, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(2, 5)*pol_z(2, 3, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(1, 9)*pol_z(1, 3, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(2, 9)*pol_z(2, 3, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(1, 10)*pol_z(1, 3, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(2, 10)*pol_z(2, 3, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(1, 11)*pol_z(1, 3, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(2, 11)*pol_z(2, 3, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(1, 12)*pol_z(1, 3, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(2, 12)*pol_z(2, 3, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(1, 16)*pol_z(1, 3, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(2, 16)*pol_z(2, 3, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(1, 17)*pol_z(1, 3, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(2, 17)*pol_z(2, 3, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(1, 18)*pol_z(1, 3, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(2, 18)*pol_z(2, 3, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(1, 22)*pol_z(1, 3, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(2, 22)*pol_z(2, 3, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(1, 23)*pol_z(1, 3, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(2, 23)*pol_z(2, 3, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(1, 27)*pol_z(1, 3, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(2, 27)*pol_z(2, 3, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(1, 1)*pol_z(1, 4, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(2, 1)*pol_z(2, 4, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(1, 2)*pol_z(1, 4, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(2, 2)*pol_z(2, 4, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(1, 3)*pol_z(1, 4, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(2, 3)*pol_z(2, 4, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(1, 4)*pol_z(1, 4, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(2, 4)*pol_z(2, 4, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(1, 9)*pol_z(1, 4, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(2, 9)*pol_z(2, 4, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(1, 10)*pol_z(1, 4, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(2, 10)*pol_z(2, 4, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(1, 11)*pol_z(1, 4, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(2, 11)*pol_z(2, 4, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(1, 16)*pol_z(1, 4, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(2, 16)*pol_z(2, 4, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(1, 17)*pol_z(1, 4, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(2, 17)*pol_z(2, 4, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(1, 22)*pol_z(1, 4, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(2, 22)*pol_z(2, 4, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(1, 1)*pol_z(1, 5, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(2, 1)*pol_z(2, 5, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(1, 2)*pol_z(1, 5, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(2, 2)*pol_z(2, 5, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(1, 3)*pol_z(1, 5, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(2, 3)*pol_z(2, 5, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(1, 9)*pol_z(1, 5, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(2, 9)*pol_z(2, 5, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(1, 10)*pol_z(1, 5, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(2, 10)*pol_z(2, 5, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(1, 16)*pol_z(1, 5, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(2, 16)*pol_z(2, 5, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(1, 1)*pol_z(1, 6, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(2, 1)*pol_z(2, 6, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(1, 2)*pol_z(1, 6, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(2, 2)*pol_z(2, 6, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(1, 9)*pol_z(1, 6, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(2, 9)*pol_z(2, 6, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(1, 1)*pol_z(1, 7, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(2, 1)*pol_z(2, 7, kg) END DO END SUBROUTINE integrate_core_7 @@ -1954,13 +1954,13 @@ SUBROUTINE integrate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -1968,23 +1968,23 @@ SUBROUTINE integrate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -1993,554 +1993,554 @@ SUBROUTINE integrate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = grid(i, j, k2) s03 = grid(i, j2, k) s04 = grid(i, j2, k2) - coef_x(1, 0) = coef_x(1, 0)+s01*pol_x(0, ig) - coef_x(2, 0) = coef_x(2, 0)+s02*pol_x(0, ig) - coef_x(3, 0) = coef_x(3, 0)+s03*pol_x(0, ig) - coef_x(4, 0) = coef_x(4, 0)+s04*pol_x(0, ig) - coef_x(1, 1) = coef_x(1, 1)+s01*pol_x(1, ig) - coef_x(2, 1) = coef_x(2, 1)+s02*pol_x(1, ig) - coef_x(3, 1) = coef_x(3, 1)+s03*pol_x(1, ig) - coef_x(4, 1) = coef_x(4, 1)+s04*pol_x(1, ig) - coef_x(1, 2) = coef_x(1, 2)+s01*pol_x(2, ig) - coef_x(2, 2) = coef_x(2, 2)+s02*pol_x(2, ig) - coef_x(3, 2) = coef_x(3, 2)+s03*pol_x(2, ig) - coef_x(4, 2) = coef_x(4, 2)+s04*pol_x(2, ig) - coef_x(1, 3) = coef_x(1, 3)+s01*pol_x(3, ig) - coef_x(2, 3) = coef_x(2, 3)+s02*pol_x(3, ig) - coef_x(3, 3) = coef_x(3, 3)+s03*pol_x(3, ig) - coef_x(4, 3) = coef_x(4, 3)+s04*pol_x(3, ig) - coef_x(1, 4) = coef_x(1, 4)+s01*pol_x(4, ig) - coef_x(2, 4) = coef_x(2, 4)+s02*pol_x(4, ig) - coef_x(3, 4) = coef_x(3, 4)+s03*pol_x(4, ig) - coef_x(4, 4) = coef_x(4, 4)+s04*pol_x(4, ig) - coef_x(1, 5) = coef_x(1, 5)+s01*pol_x(5, ig) - coef_x(2, 5) = coef_x(2, 5)+s02*pol_x(5, ig) - coef_x(3, 5) = coef_x(3, 5)+s03*pol_x(5, ig) - coef_x(4, 5) = coef_x(4, 5)+s04*pol_x(5, ig) - coef_x(1, 6) = coef_x(1, 6)+s01*pol_x(6, ig) - coef_x(2, 6) = coef_x(2, 6)+s02*pol_x(6, ig) - coef_x(3, 6) = coef_x(3, 6)+s03*pol_x(6, ig) - coef_x(4, 6) = coef_x(4, 6)+s04*pol_x(6, ig) - coef_x(1, 7) = coef_x(1, 7)+s01*pol_x(7, ig) - coef_x(2, 7) = coef_x(2, 7)+s02*pol_x(7, ig) - coef_x(3, 7) = coef_x(3, 7)+s03*pol_x(7, ig) - coef_x(4, 7) = coef_x(4, 7)+s04*pol_x(7, ig) - coef_x(1, 8) = coef_x(1, 8)+s01*pol_x(8, ig) - coef_x(2, 8) = coef_x(2, 8)+s02*pol_x(8, ig) - coef_x(3, 8) = coef_x(3, 8)+s03*pol_x(8, ig) - coef_x(4, 8) = coef_x(4, 8)+s04*pol_x(8, ig) + coef_x(1, 0) = coef_x(1, 0) + s01*pol_x(0, ig) + coef_x(2, 0) = coef_x(2, 0) + s02*pol_x(0, ig) + coef_x(3, 0) = coef_x(3, 0) + s03*pol_x(0, ig) + coef_x(4, 0) = coef_x(4, 0) + s04*pol_x(0, ig) + coef_x(1, 1) = coef_x(1, 1) + s01*pol_x(1, ig) + coef_x(2, 1) = coef_x(2, 1) + s02*pol_x(1, ig) + coef_x(3, 1) = coef_x(3, 1) + s03*pol_x(1, ig) + coef_x(4, 1) = coef_x(4, 1) + s04*pol_x(1, ig) + coef_x(1, 2) = coef_x(1, 2) + s01*pol_x(2, ig) + coef_x(2, 2) = coef_x(2, 2) + s02*pol_x(2, ig) + coef_x(3, 2) = coef_x(3, 2) + s03*pol_x(2, ig) + coef_x(4, 2) = coef_x(4, 2) + s04*pol_x(2, ig) + coef_x(1, 3) = coef_x(1, 3) + s01*pol_x(3, ig) + coef_x(2, 3) = coef_x(2, 3) + s02*pol_x(3, ig) + coef_x(3, 3) = coef_x(3, 3) + s03*pol_x(3, ig) + coef_x(4, 3) = coef_x(4, 3) + s04*pol_x(3, ig) + coef_x(1, 4) = coef_x(1, 4) + s01*pol_x(4, ig) + coef_x(2, 4) = coef_x(2, 4) + s02*pol_x(4, ig) + coef_x(3, 4) = coef_x(3, 4) + s03*pol_x(4, ig) + coef_x(4, 4) = coef_x(4, 4) + s04*pol_x(4, ig) + coef_x(1, 5) = coef_x(1, 5) + s01*pol_x(5, ig) + coef_x(2, 5) = coef_x(2, 5) + s02*pol_x(5, ig) + coef_x(3, 5) = coef_x(3, 5) + s03*pol_x(5, ig) + coef_x(4, 5) = coef_x(4, 5) + s04*pol_x(5, ig) + coef_x(1, 6) = coef_x(1, 6) + s01*pol_x(6, ig) + coef_x(2, 6) = coef_x(2, 6) + s02*pol_x(6, ig) + coef_x(3, 6) = coef_x(3, 6) + s03*pol_x(6, ig) + coef_x(4, 6) = coef_x(4, 6) + s04*pol_x(6, ig) + coef_x(1, 7) = coef_x(1, 7) + s01*pol_x(7, ig) + coef_x(2, 7) = coef_x(2, 7) + s02*pol_x(7, ig) + coef_x(3, 7) = coef_x(3, 7) + s03*pol_x(7, ig) + coef_x(4, 7) = coef_x(4, 7) + s04*pol_x(7, ig) + coef_x(1, 8) = coef_x(1, 8) + s01*pol_x(8, ig) + coef_x(2, 8) = coef_x(2, 8) + s02*pol_x(8, ig) + coef_x(3, 8) = coef_x(3, 8) + s03*pol_x(8, ig) + coef_x(4, 8) = coef_x(4, 8) + s04*pol_x(8, ig) END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 2)*pol_y(1, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 2)*pol_y(1, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 2)*pol_y(2, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 2)*pol_y(2, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(1, 3)*pol_y(1, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(2, 3)*pol_y(1, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(3, 3)*pol_y(2, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(4, 3)*pol_y(2, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(1, 4)*pol_y(1, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(2, 4)*pol_y(1, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(3, 4)*pol_y(2, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(4, 4)*pol_y(2, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(1, 5)*pol_y(1, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(2, 5)*pol_y(1, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(3, 5)*pol_y(2, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(4, 5)*pol_y(2, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(1, 6)*pol_y(1, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(2, 6)*pol_y(1, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(3, 6)*pol_y(2, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(4, 6)*pol_y(2, 0, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(1, 7)*pol_y(1, 0, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(2, 7)*pol_y(1, 0, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(3, 7)*pol_y(2, 0, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(4, 7)*pol_y(2, 0, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(1, 8)*pol_y(1, 0, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(2, 8)*pol_y(1, 0, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(3, 8)*pol_y(2, 0, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(4, 8)*pol_y(2, 0, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(4, 0)*pol_y(2, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(1, 1)*pol_y(1, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(2, 1)*pol_y(1, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(3, 1)*pol_y(2, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(4, 1)*pol_y(2, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(1, 2)*pol_y(1, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(2, 2)*pol_y(1, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(3, 2)*pol_y(2, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(4, 2)*pol_y(2, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(1, 3)*pol_y(1, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(2, 3)*pol_y(1, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(3, 3)*pol_y(2, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(4, 3)*pol_y(2, 1, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(1, 4)*pol_y(1, 1, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(2, 4)*pol_y(1, 1, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(3, 4)*pol_y(2, 1, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(4, 4)*pol_y(2, 1, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(1, 5)*pol_y(1, 1, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(2, 5)*pol_y(1, 1, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(3, 5)*pol_y(2, 1, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(4, 5)*pol_y(2, 1, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(1, 6)*pol_y(1, 1, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(2, 6)*pol_y(1, 1, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(3, 6)*pol_y(2, 1, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(4, 6)*pol_y(2, 1, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(1, 7)*pol_y(1, 1, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(2, 7)*pol_y(1, 1, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(3, 7)*pol_y(2, 1, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(4, 7)*pol_y(2, 1, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(1, 0)*pol_y(1, 2, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(2, 0)*pol_y(1, 2, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(3, 0)*pol_y(2, 2, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(4, 0)*pol_y(2, 2, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(1, 1)*pol_y(1, 2, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(2, 1)*pol_y(1, 2, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(3, 1)*pol_y(2, 2, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(4, 1)*pol_y(2, 2, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(1, 2)*pol_y(1, 2, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(2, 2)*pol_y(1, 2, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(3, 2)*pol_y(2, 2, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(4, 2)*pol_y(2, 2, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(1, 3)*pol_y(1, 2, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(2, 3)*pol_y(1, 2, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(3, 3)*pol_y(2, 2, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(4, 3)*pol_y(2, 2, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(1, 4)*pol_y(1, 2, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(2, 4)*pol_y(1, 2, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(3, 4)*pol_y(2, 2, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(4, 4)*pol_y(2, 2, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(1, 5)*pol_y(1, 2, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(2, 5)*pol_y(1, 2, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(3, 5)*pol_y(2, 2, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(4, 5)*pol_y(2, 2, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(1, 6)*pol_y(1, 2, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(2, 6)*pol_y(1, 2, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(3, 6)*pol_y(2, 2, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(4, 6)*pol_y(2, 2, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(1, 0)*pol_y(1, 3, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(2, 0)*pol_y(1, 3, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(3, 0)*pol_y(2, 3, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(4, 0)*pol_y(2, 3, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(1, 1)*pol_y(1, 3, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(2, 1)*pol_y(1, 3, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(3, 1)*pol_y(2, 3, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(4, 1)*pol_y(2, 3, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(1, 2)*pol_y(1, 3, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(2, 2)*pol_y(1, 3, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(3, 2)*pol_y(2, 3, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(4, 2)*pol_y(2, 3, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(1, 3)*pol_y(1, 3, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(2, 3)*pol_y(1, 3, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(3, 3)*pol_y(2, 3, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(4, 3)*pol_y(2, 3, jg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_x(1, 4)*pol_y(1, 3, jg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_x(2, 4)*pol_y(1, 3, jg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_x(3, 4)*pol_y(2, 3, jg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_x(4, 4)*pol_y(2, 3, jg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_x(1, 5)*pol_y(1, 3, jg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_x(2, 5)*pol_y(1, 3, jg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_x(3, 5)*pol_y(2, 3, jg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_x(4, 5)*pol_y(2, 3, jg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_x(1, 0)*pol_y(1, 4, jg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_x(2, 0)*pol_y(1, 4, jg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_x(3, 0)*pol_y(2, 4, jg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_x(4, 0)*pol_y(2, 4, jg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_x(1, 1)*pol_y(1, 4, jg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_x(2, 1)*pol_y(1, 4, jg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_x(3, 1)*pol_y(2, 4, jg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_x(4, 1)*pol_y(2, 4, jg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_x(1, 2)*pol_y(1, 4, jg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_x(2, 2)*pol_y(1, 4, jg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_x(3, 2)*pol_y(2, 4, jg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_x(4, 2)*pol_y(2, 4, jg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_x(1, 3)*pol_y(1, 4, jg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_x(2, 3)*pol_y(1, 4, jg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_x(3, 3)*pol_y(2, 4, jg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_x(4, 3)*pol_y(2, 4, jg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_x(1, 4)*pol_y(1, 4, jg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_x(2, 4)*pol_y(1, 4, jg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_x(3, 4)*pol_y(2, 4, jg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_x(4, 4)*pol_y(2, 4, jg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_x(1, 0)*pol_y(1, 5, jg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_x(2, 0)*pol_y(1, 5, jg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_x(3, 0)*pol_y(2, 5, jg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_x(4, 0)*pol_y(2, 5, jg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_x(1, 1)*pol_y(1, 5, jg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_x(2, 1)*pol_y(1, 5, jg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_x(3, 1)*pol_y(2, 5, jg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_x(4, 1)*pol_y(2, 5, jg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_x(1, 2)*pol_y(1, 5, jg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_x(2, 2)*pol_y(1, 5, jg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_x(3, 2)*pol_y(2, 5, jg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_x(4, 2)*pol_y(2, 5, jg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_x(1, 3)*pol_y(1, 5, jg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_x(2, 3)*pol_y(1, 5, jg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_x(3, 3)*pol_y(2, 5, jg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_x(4, 3)*pol_y(2, 5, jg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_x(1, 0)*pol_y(1, 6, jg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_x(2, 0)*pol_y(1, 6, jg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_x(3, 0)*pol_y(2, 6, jg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_x(4, 0)*pol_y(2, 6, jg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_x(1, 1)*pol_y(1, 6, jg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_x(2, 1)*pol_y(1, 6, jg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_x(3, 1)*pol_y(2, 6, jg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_x(4, 1)*pol_y(2, 6, jg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_x(1, 2)*pol_y(1, 6, jg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_x(2, 2)*pol_y(1, 6, jg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_x(3, 2)*pol_y(2, 6, jg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_x(4, 2)*pol_y(2, 6, jg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_x(1, 0)*pol_y(1, 7, jg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_x(2, 0)*pol_y(1, 7, jg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_x(3, 0)*pol_y(2, 7, jg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_x(4, 0)*pol_y(2, 7, jg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_x(1, 1)*pol_y(1, 7, jg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_x(2, 1)*pol_y(1, 7, jg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_x(3, 1)*pol_y(2, 7, jg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_x(4, 1)*pol_y(2, 7, jg) - coef_xy(1, 45) = coef_xy(1, 45)+coef_x(1, 0)*pol_y(1, 8, jg) - coef_xy(2, 45) = coef_xy(2, 45)+coef_x(2, 0)*pol_y(1, 8, jg) - coef_xy(1, 45) = coef_xy(1, 45)+coef_x(3, 0)*pol_y(2, 8, jg) - coef_xy(2, 45) = coef_xy(2, 45)+coef_x(4, 0)*pol_y(2, 8, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 2)*pol_y(1, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 2)*pol_y(1, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 2)*pol_y(2, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 2)*pol_y(2, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(1, 3)*pol_y(1, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(2, 3)*pol_y(1, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(3, 3)*pol_y(2, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(4, 3)*pol_y(2, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(1, 4)*pol_y(1, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(2, 4)*pol_y(1, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(3, 4)*pol_y(2, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(4, 4)*pol_y(2, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(1, 5)*pol_y(1, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(2, 5)*pol_y(1, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(3, 5)*pol_y(2, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(4, 5)*pol_y(2, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(1, 6)*pol_y(1, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(2, 6)*pol_y(1, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(3, 6)*pol_y(2, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(4, 6)*pol_y(2, 0, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(1, 7)*pol_y(1, 0, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(2, 7)*pol_y(1, 0, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(3, 7)*pol_y(2, 0, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(4, 7)*pol_y(2, 0, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(1, 8)*pol_y(1, 0, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(2, 8)*pol_y(1, 0, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(3, 8)*pol_y(2, 0, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(4, 8)*pol_y(2, 0, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(1, 1)*pol_y(1, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(2, 1)*pol_y(1, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(3, 1)*pol_y(2, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(4, 1)*pol_y(2, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(1, 2)*pol_y(1, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(2, 2)*pol_y(1, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(3, 2)*pol_y(2, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(4, 2)*pol_y(2, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(1, 3)*pol_y(1, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(2, 3)*pol_y(1, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(3, 3)*pol_y(2, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(4, 3)*pol_y(2, 1, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(1, 4)*pol_y(1, 1, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(2, 4)*pol_y(1, 1, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(3, 4)*pol_y(2, 1, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(4, 4)*pol_y(2, 1, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(1, 5)*pol_y(1, 1, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(2, 5)*pol_y(1, 1, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(3, 5)*pol_y(2, 1, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(4, 5)*pol_y(2, 1, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(1, 6)*pol_y(1, 1, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(2, 6)*pol_y(1, 1, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(3, 6)*pol_y(2, 1, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(4, 6)*pol_y(2, 1, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(1, 7)*pol_y(1, 1, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(2, 7)*pol_y(1, 1, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(3, 7)*pol_y(2, 1, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(4, 7)*pol_y(2, 1, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(1, 0)*pol_y(1, 2, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(2, 0)*pol_y(1, 2, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(3, 0)*pol_y(2, 2, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(4, 0)*pol_y(2, 2, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(1, 1)*pol_y(1, 2, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(2, 1)*pol_y(1, 2, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(3, 1)*pol_y(2, 2, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(4, 1)*pol_y(2, 2, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(1, 2)*pol_y(1, 2, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(2, 2)*pol_y(1, 2, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(3, 2)*pol_y(2, 2, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(4, 2)*pol_y(2, 2, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(1, 3)*pol_y(1, 2, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(2, 3)*pol_y(1, 2, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(3, 3)*pol_y(2, 2, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(4, 3)*pol_y(2, 2, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(1, 4)*pol_y(1, 2, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(2, 4)*pol_y(1, 2, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(3, 4)*pol_y(2, 2, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(4, 4)*pol_y(2, 2, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(1, 5)*pol_y(1, 2, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(2, 5)*pol_y(1, 2, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(3, 5)*pol_y(2, 2, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(4, 5)*pol_y(2, 2, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(1, 6)*pol_y(1, 2, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(2, 6)*pol_y(1, 2, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(3, 6)*pol_y(2, 2, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(4, 6)*pol_y(2, 2, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(1, 0)*pol_y(1, 3, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(2, 0)*pol_y(1, 3, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(3, 0)*pol_y(2, 3, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(4, 0)*pol_y(2, 3, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(1, 1)*pol_y(1, 3, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(2, 1)*pol_y(1, 3, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(3, 1)*pol_y(2, 3, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(4, 1)*pol_y(2, 3, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(1, 2)*pol_y(1, 3, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(2, 2)*pol_y(1, 3, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(3, 2)*pol_y(2, 3, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(4, 2)*pol_y(2, 3, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(1, 3)*pol_y(1, 3, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(2, 3)*pol_y(1, 3, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(3, 3)*pol_y(2, 3, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(4, 3)*pol_y(2, 3, jg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_x(1, 4)*pol_y(1, 3, jg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_x(2, 4)*pol_y(1, 3, jg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_x(3, 4)*pol_y(2, 3, jg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_x(4, 4)*pol_y(2, 3, jg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_x(1, 5)*pol_y(1, 3, jg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_x(2, 5)*pol_y(1, 3, jg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_x(3, 5)*pol_y(2, 3, jg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_x(4, 5)*pol_y(2, 3, jg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_x(1, 0)*pol_y(1, 4, jg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_x(2, 0)*pol_y(1, 4, jg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_x(3, 0)*pol_y(2, 4, jg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_x(4, 0)*pol_y(2, 4, jg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_x(1, 1)*pol_y(1, 4, jg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_x(2, 1)*pol_y(1, 4, jg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_x(3, 1)*pol_y(2, 4, jg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_x(4, 1)*pol_y(2, 4, jg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_x(1, 2)*pol_y(1, 4, jg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_x(2, 2)*pol_y(1, 4, jg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_x(3, 2)*pol_y(2, 4, jg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_x(4, 2)*pol_y(2, 4, jg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_x(1, 3)*pol_y(1, 4, jg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_x(2, 3)*pol_y(1, 4, jg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_x(3, 3)*pol_y(2, 4, jg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_x(4, 3)*pol_y(2, 4, jg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_x(1, 4)*pol_y(1, 4, jg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_x(2, 4)*pol_y(1, 4, jg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_x(3, 4)*pol_y(2, 4, jg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_x(4, 4)*pol_y(2, 4, jg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_x(1, 0)*pol_y(1, 5, jg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_x(2, 0)*pol_y(1, 5, jg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_x(3, 0)*pol_y(2, 5, jg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_x(4, 0)*pol_y(2, 5, jg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_x(1, 1)*pol_y(1, 5, jg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_x(2, 1)*pol_y(1, 5, jg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_x(3, 1)*pol_y(2, 5, jg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_x(4, 1)*pol_y(2, 5, jg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_x(1, 2)*pol_y(1, 5, jg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_x(2, 2)*pol_y(1, 5, jg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_x(3, 2)*pol_y(2, 5, jg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_x(4, 2)*pol_y(2, 5, jg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_x(1, 3)*pol_y(1, 5, jg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_x(2, 3)*pol_y(1, 5, jg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_x(3, 3)*pol_y(2, 5, jg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_x(4, 3)*pol_y(2, 5, jg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_x(1, 0)*pol_y(1, 6, jg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_x(2, 0)*pol_y(1, 6, jg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_x(3, 0)*pol_y(2, 6, jg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_x(4, 0)*pol_y(2, 6, jg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_x(1, 1)*pol_y(1, 6, jg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_x(2, 1)*pol_y(1, 6, jg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_x(3, 1)*pol_y(2, 6, jg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_x(4, 1)*pol_y(2, 6, jg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_x(1, 2)*pol_y(1, 6, jg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_x(2, 2)*pol_y(1, 6, jg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_x(3, 2)*pol_y(2, 6, jg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_x(4, 2)*pol_y(2, 6, jg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_x(1, 0)*pol_y(1, 7, jg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_x(2, 0)*pol_y(1, 7, jg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_x(3, 0)*pol_y(2, 7, jg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_x(4, 0)*pol_y(2, 7, jg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_x(1, 1)*pol_y(1, 7, jg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_x(2, 1)*pol_y(1, 7, jg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_x(3, 1)*pol_y(2, 7, jg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_x(4, 1)*pol_y(2, 7, jg) + coef_xy(1, 45) = coef_xy(1, 45) + coef_x(1, 0)*pol_y(1, 8, jg) + coef_xy(2, 45) = coef_xy(2, 45) + coef_x(2, 0)*pol_y(1, 8, jg) + coef_xy(1, 45) = coef_xy(1, 45) + coef_x(3, 0)*pol_y(2, 8, jg) + coef_xy(2, 45) = coef_xy(2, 45) + coef_x(4, 0)*pol_y(2, 8, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 11)*pol_z(1, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 11)*pol_z(2, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 12)*pol_z(1, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 12)*pol_z(2, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 13)*pol_z(1, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 13)*pol_z(2, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 14)*pol_z(1, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 14)*pol_z(2, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 15)*pol_z(1, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 15)*pol_z(2, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 16)*pol_z(1, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 16)*pol_z(2, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 17)*pol_z(1, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 17)*pol_z(2, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 18)*pol_z(1, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 18)*pol_z(2, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 19)*pol_z(1, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 19)*pol_z(2, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 20)*pol_z(1, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 20)*pol_z(2, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(1, 21)*pol_z(1, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(2, 21)*pol_z(2, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(1, 22)*pol_z(1, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(2, 22)*pol_z(2, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(1, 23)*pol_z(1, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(2, 23)*pol_z(2, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(1, 24)*pol_z(1, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(2, 24)*pol_z(2, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(1, 25)*pol_z(1, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(2, 25)*pol_z(2, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(1, 26)*pol_z(1, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(2, 26)*pol_z(2, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(1, 27)*pol_z(1, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(2, 27)*pol_z(2, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(1, 28)*pol_z(1, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(2, 28)*pol_z(2, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(1, 29)*pol_z(1, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(2, 29)*pol_z(2, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(1, 30)*pol_z(1, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(2, 30)*pol_z(2, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(1, 31)*pol_z(1, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(2, 31)*pol_z(2, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(1, 32)*pol_z(1, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(2, 32)*pol_z(2, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(1, 33)*pol_z(1, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(2, 33)*pol_z(2, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(1, 34)*pol_z(1, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(2, 34)*pol_z(2, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(1, 35)*pol_z(1, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(2, 35)*pol_z(2, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(1, 36)*pol_z(1, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(2, 36)*pol_z(2, 0, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(1, 37)*pol_z(1, 0, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(2, 37)*pol_z(2, 0, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(1, 38)*pol_z(1, 0, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(2, 38)*pol_z(2, 0, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(1, 39)*pol_z(1, 0, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(2, 39)*pol_z(2, 0, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(1, 40)*pol_z(1, 0, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(2, 40)*pol_z(2, 0, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(1, 41)*pol_z(1, 0, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(2, 41)*pol_z(2, 0, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(1, 42)*pol_z(1, 0, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(2, 42)*pol_z(2, 0, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(1, 43)*pol_z(1, 0, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(2, 43)*pol_z(2, 0, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(1, 44)*pol_z(1, 0, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(2, 44)*pol_z(2, 0, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(1, 45)*pol_z(1, 0, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(2, 45)*pol_z(2, 0, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(1, 5)*pol_z(1, 1, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(2, 5)*pol_z(2, 1, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(1, 7)*pol_z(1, 1, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(2, 7)*pol_z(2, 1, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(1, 8)*pol_z(1, 1, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(2, 8)*pol_z(2, 1, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(1, 10)*pol_z(1, 1, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(2, 10)*pol_z(2, 1, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(1, 11)*pol_z(1, 1, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(2, 11)*pol_z(2, 1, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(1, 12)*pol_z(1, 1, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(2, 12)*pol_z(2, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(1, 13)*pol_z(1, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(2, 13)*pol_z(2, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(1, 14)*pol_z(1, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(2, 14)*pol_z(2, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(1, 15)*pol_z(1, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(2, 15)*pol_z(2, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(1, 16)*pol_z(1, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(2, 16)*pol_z(2, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(1, 18)*pol_z(1, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(2, 18)*pol_z(2, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(1, 19)*pol_z(1, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(2, 19)*pol_z(2, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(1, 20)*pol_z(1, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(2, 20)*pol_z(2, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(1, 21)*pol_z(1, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(2, 21)*pol_z(2, 1, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(1, 22)*pol_z(1, 1, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(2, 22)*pol_z(2, 1, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(1, 23)*pol_z(1, 1, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(2, 23)*pol_z(2, 1, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(1, 25)*pol_z(1, 1, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(2, 25)*pol_z(2, 1, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(1, 26)*pol_z(1, 1, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(2, 26)*pol_z(2, 1, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(1, 27)*pol_z(1, 1, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(2, 27)*pol_z(2, 1, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(1, 28)*pol_z(1, 1, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(2, 28)*pol_z(2, 1, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(1, 29)*pol_z(1, 1, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(2, 29)*pol_z(2, 1, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(1, 31)*pol_z(1, 1, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(2, 31)*pol_z(2, 1, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(1, 32)*pol_z(1, 1, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(2, 32)*pol_z(2, 1, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(1, 33)*pol_z(1, 1, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(2, 33)*pol_z(2, 1, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(1, 34)*pol_z(1, 1, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(2, 34)*pol_z(2, 1, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(1, 36)*pol_z(1, 1, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(2, 36)*pol_z(2, 1, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(1, 37)*pol_z(1, 1, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(2, 37)*pol_z(2, 1, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(1, 38)*pol_z(1, 1, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(2, 38)*pol_z(2, 1, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(1, 40)*pol_z(1, 1, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(2, 40)*pol_z(2, 1, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(1, 41)*pol_z(1, 1, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(2, 41)*pol_z(2, 1, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(1, 43)*pol_z(1, 1, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(2, 43)*pol_z(2, 1, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(1, 3)*pol_z(1, 2, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(2, 3)*pol_z(2, 2, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(1, 4)*pol_z(1, 2, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(2, 4)*pol_z(2, 2, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(1, 5)*pol_z(1, 2, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(2, 5)*pol_z(2, 2, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(1, 6)*pol_z(1, 2, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(2, 6)*pol_z(2, 2, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(1, 7)*pol_z(1, 2, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(2, 7)*pol_z(2, 2, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(1, 10)*pol_z(1, 2, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(2, 10)*pol_z(2, 2, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(1, 11)*pol_z(1, 2, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(2, 11)*pol_z(2, 2, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(1, 12)*pol_z(1, 2, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(2, 12)*pol_z(2, 2, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(1, 13)*pol_z(1, 2, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(2, 13)*pol_z(2, 2, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(1, 14)*pol_z(1, 2, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(2, 14)*pol_z(2, 2, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(1, 15)*pol_z(1, 2, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(2, 15)*pol_z(2, 2, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(1, 18)*pol_z(1, 2, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(2, 18)*pol_z(2, 2, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(1, 19)*pol_z(1, 2, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(2, 19)*pol_z(2, 2, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(1, 20)*pol_z(1, 2, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(2, 20)*pol_z(2, 2, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(1, 21)*pol_z(1, 2, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(2, 21)*pol_z(2, 2, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(1, 22)*pol_z(1, 2, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(2, 22)*pol_z(2, 2, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(1, 25)*pol_z(1, 2, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(2, 25)*pol_z(2, 2, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(1, 26)*pol_z(1, 2, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(2, 26)*pol_z(2, 2, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(1, 27)*pol_z(1, 2, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(2, 27)*pol_z(2, 2, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(1, 28)*pol_z(1, 2, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(2, 28)*pol_z(2, 2, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(1, 31)*pol_z(1, 2, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(2, 31)*pol_z(2, 2, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(1, 32)*pol_z(1, 2, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(2, 32)*pol_z(2, 2, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(1, 33)*pol_z(1, 2, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(2, 33)*pol_z(2, 2, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(1, 36)*pol_z(1, 2, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(2, 36)*pol_z(2, 2, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(1, 37)*pol_z(1, 2, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(2, 37)*pol_z(2, 2, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(1, 40)*pol_z(1, 2, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(2, 40)*pol_z(2, 2, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(2, 1)*pol_z(2, 3, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(1, 2)*pol_z(1, 3, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(2, 2)*pol_z(2, 3, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(1, 3)*pol_z(1, 3, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(2, 3)*pol_z(2, 3, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(1, 4)*pol_z(1, 3, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(2, 4)*pol_z(2, 3, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(1, 5)*pol_z(1, 3, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(2, 5)*pol_z(2, 3, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(1, 6)*pol_z(1, 3, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(2, 6)*pol_z(2, 3, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(1, 10)*pol_z(1, 3, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(2, 10)*pol_z(2, 3, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(1, 11)*pol_z(1, 3, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(2, 11)*pol_z(2, 3, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(1, 12)*pol_z(1, 3, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(2, 12)*pol_z(2, 3, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(1, 13)*pol_z(1, 3, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(2, 13)*pol_z(2, 3, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(1, 14)*pol_z(1, 3, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(2, 14)*pol_z(2, 3, kg) - coef_xyz(121) = coef_xyz(121)+coef_xy(1, 18)*pol_z(1, 3, kg) - coef_xyz(121) = coef_xyz(121)+coef_xy(2, 18)*pol_z(2, 3, kg) - coef_xyz(122) = coef_xyz(122)+coef_xy(1, 19)*pol_z(1, 3, kg) - coef_xyz(122) = coef_xyz(122)+coef_xy(2, 19)*pol_z(2, 3, kg) - coef_xyz(123) = coef_xyz(123)+coef_xy(1, 20)*pol_z(1, 3, kg) - coef_xyz(123) = coef_xyz(123)+coef_xy(2, 20)*pol_z(2, 3, kg) - coef_xyz(124) = coef_xyz(124)+coef_xy(1, 21)*pol_z(1, 3, kg) - coef_xyz(124) = coef_xyz(124)+coef_xy(2, 21)*pol_z(2, 3, kg) - coef_xyz(125) = coef_xyz(125)+coef_xy(1, 25)*pol_z(1, 3, kg) - coef_xyz(125) = coef_xyz(125)+coef_xy(2, 25)*pol_z(2, 3, kg) - coef_xyz(126) = coef_xyz(126)+coef_xy(1, 26)*pol_z(1, 3, kg) - coef_xyz(126) = coef_xyz(126)+coef_xy(2, 26)*pol_z(2, 3, kg) - coef_xyz(127) = coef_xyz(127)+coef_xy(1, 27)*pol_z(1, 3, kg) - coef_xyz(127) = coef_xyz(127)+coef_xy(2, 27)*pol_z(2, 3, kg) - coef_xyz(128) = coef_xyz(128)+coef_xy(1, 31)*pol_z(1, 3, kg) - coef_xyz(128) = coef_xyz(128)+coef_xy(2, 31)*pol_z(2, 3, kg) - coef_xyz(129) = coef_xyz(129)+coef_xy(1, 32)*pol_z(1, 3, kg) - coef_xyz(129) = coef_xyz(129)+coef_xy(2, 32)*pol_z(2, 3, kg) - coef_xyz(130) = coef_xyz(130)+coef_xy(1, 36)*pol_z(1, 3, kg) - coef_xyz(130) = coef_xyz(130)+coef_xy(2, 36)*pol_z(2, 3, kg) - coef_xyz(131) = coef_xyz(131)+coef_xy(1, 1)*pol_z(1, 4, kg) - coef_xyz(131) = coef_xyz(131)+coef_xy(2, 1)*pol_z(2, 4, kg) - coef_xyz(132) = coef_xyz(132)+coef_xy(1, 2)*pol_z(1, 4, kg) - coef_xyz(132) = coef_xyz(132)+coef_xy(2, 2)*pol_z(2, 4, kg) - coef_xyz(133) = coef_xyz(133)+coef_xy(1, 3)*pol_z(1, 4, kg) - coef_xyz(133) = coef_xyz(133)+coef_xy(2, 3)*pol_z(2, 4, kg) - coef_xyz(134) = coef_xyz(134)+coef_xy(1, 4)*pol_z(1, 4, kg) - coef_xyz(134) = coef_xyz(134)+coef_xy(2, 4)*pol_z(2, 4, kg) - coef_xyz(135) = coef_xyz(135)+coef_xy(1, 5)*pol_z(1, 4, kg) - coef_xyz(135) = coef_xyz(135)+coef_xy(2, 5)*pol_z(2, 4, kg) - coef_xyz(136) = coef_xyz(136)+coef_xy(1, 10)*pol_z(1, 4, kg) - coef_xyz(136) = coef_xyz(136)+coef_xy(2, 10)*pol_z(2, 4, kg) - coef_xyz(137) = coef_xyz(137)+coef_xy(1, 11)*pol_z(1, 4, kg) - coef_xyz(137) = coef_xyz(137)+coef_xy(2, 11)*pol_z(2, 4, kg) - coef_xyz(138) = coef_xyz(138)+coef_xy(1, 12)*pol_z(1, 4, kg) - coef_xyz(138) = coef_xyz(138)+coef_xy(2, 12)*pol_z(2, 4, kg) - coef_xyz(139) = coef_xyz(139)+coef_xy(1, 13)*pol_z(1, 4, kg) - coef_xyz(139) = coef_xyz(139)+coef_xy(2, 13)*pol_z(2, 4, kg) - coef_xyz(140) = coef_xyz(140)+coef_xy(1, 18)*pol_z(1, 4, kg) - coef_xyz(140) = coef_xyz(140)+coef_xy(2, 18)*pol_z(2, 4, kg) - coef_xyz(141) = coef_xyz(141)+coef_xy(1, 19)*pol_z(1, 4, kg) - coef_xyz(141) = coef_xyz(141)+coef_xy(2, 19)*pol_z(2, 4, kg) - coef_xyz(142) = coef_xyz(142)+coef_xy(1, 20)*pol_z(1, 4, kg) - coef_xyz(142) = coef_xyz(142)+coef_xy(2, 20)*pol_z(2, 4, kg) - coef_xyz(143) = coef_xyz(143)+coef_xy(1, 25)*pol_z(1, 4, kg) - coef_xyz(143) = coef_xyz(143)+coef_xy(2, 25)*pol_z(2, 4, kg) - coef_xyz(144) = coef_xyz(144)+coef_xy(1, 26)*pol_z(1, 4, kg) - coef_xyz(144) = coef_xyz(144)+coef_xy(2, 26)*pol_z(2, 4, kg) - coef_xyz(145) = coef_xyz(145)+coef_xy(1, 31)*pol_z(1, 4, kg) - coef_xyz(145) = coef_xyz(145)+coef_xy(2, 31)*pol_z(2, 4, kg) - coef_xyz(146) = coef_xyz(146)+coef_xy(1, 1)*pol_z(1, 5, kg) - coef_xyz(146) = coef_xyz(146)+coef_xy(2, 1)*pol_z(2, 5, kg) - coef_xyz(147) = coef_xyz(147)+coef_xy(1, 2)*pol_z(1, 5, kg) - coef_xyz(147) = coef_xyz(147)+coef_xy(2, 2)*pol_z(2, 5, kg) - coef_xyz(148) = coef_xyz(148)+coef_xy(1, 3)*pol_z(1, 5, kg) - coef_xyz(148) = coef_xyz(148)+coef_xy(2, 3)*pol_z(2, 5, kg) - coef_xyz(149) = coef_xyz(149)+coef_xy(1, 4)*pol_z(1, 5, kg) - coef_xyz(149) = coef_xyz(149)+coef_xy(2, 4)*pol_z(2, 5, kg) - coef_xyz(150) = coef_xyz(150)+coef_xy(1, 10)*pol_z(1, 5, kg) - coef_xyz(150) = coef_xyz(150)+coef_xy(2, 10)*pol_z(2, 5, kg) - coef_xyz(151) = coef_xyz(151)+coef_xy(1, 11)*pol_z(1, 5, kg) - coef_xyz(151) = coef_xyz(151)+coef_xy(2, 11)*pol_z(2, 5, kg) - coef_xyz(152) = coef_xyz(152)+coef_xy(1, 12)*pol_z(1, 5, kg) - coef_xyz(152) = coef_xyz(152)+coef_xy(2, 12)*pol_z(2, 5, kg) - coef_xyz(153) = coef_xyz(153)+coef_xy(1, 18)*pol_z(1, 5, kg) - coef_xyz(153) = coef_xyz(153)+coef_xy(2, 18)*pol_z(2, 5, kg) - coef_xyz(154) = coef_xyz(154)+coef_xy(1, 19)*pol_z(1, 5, kg) - coef_xyz(154) = coef_xyz(154)+coef_xy(2, 19)*pol_z(2, 5, kg) - coef_xyz(155) = coef_xyz(155)+coef_xy(1, 25)*pol_z(1, 5, kg) - coef_xyz(155) = coef_xyz(155)+coef_xy(2, 25)*pol_z(2, 5, kg) - coef_xyz(156) = coef_xyz(156)+coef_xy(1, 1)*pol_z(1, 6, kg) - coef_xyz(156) = coef_xyz(156)+coef_xy(2, 1)*pol_z(2, 6, kg) - coef_xyz(157) = coef_xyz(157)+coef_xy(1, 2)*pol_z(1, 6, kg) - coef_xyz(157) = coef_xyz(157)+coef_xy(2, 2)*pol_z(2, 6, kg) - coef_xyz(158) = coef_xyz(158)+coef_xy(1, 3)*pol_z(1, 6, kg) - coef_xyz(158) = coef_xyz(158)+coef_xy(2, 3)*pol_z(2, 6, kg) - coef_xyz(159) = coef_xyz(159)+coef_xy(1, 10)*pol_z(1, 6, kg) - coef_xyz(159) = coef_xyz(159)+coef_xy(2, 10)*pol_z(2, 6, kg) - coef_xyz(160) = coef_xyz(160)+coef_xy(1, 11)*pol_z(1, 6, kg) - coef_xyz(160) = coef_xyz(160)+coef_xy(2, 11)*pol_z(2, 6, kg) - coef_xyz(161) = coef_xyz(161)+coef_xy(1, 18)*pol_z(1, 6, kg) - coef_xyz(161) = coef_xyz(161)+coef_xy(2, 18)*pol_z(2, 6, kg) - coef_xyz(162) = coef_xyz(162)+coef_xy(1, 1)*pol_z(1, 7, kg) - coef_xyz(162) = coef_xyz(162)+coef_xy(2, 1)*pol_z(2, 7, kg) - coef_xyz(163) = coef_xyz(163)+coef_xy(1, 2)*pol_z(1, 7, kg) - coef_xyz(163) = coef_xyz(163)+coef_xy(2, 2)*pol_z(2, 7, kg) - coef_xyz(164) = coef_xyz(164)+coef_xy(1, 10)*pol_z(1, 7, kg) - coef_xyz(164) = coef_xyz(164)+coef_xy(2, 10)*pol_z(2, 7, kg) - coef_xyz(165) = coef_xyz(165)+coef_xy(1, 1)*pol_z(1, 8, kg) - coef_xyz(165) = coef_xyz(165)+coef_xy(2, 1)*pol_z(2, 8, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 11)*pol_z(1, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 11)*pol_z(2, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 12)*pol_z(1, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 12)*pol_z(2, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 13)*pol_z(1, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 13)*pol_z(2, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 14)*pol_z(1, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 14)*pol_z(2, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 15)*pol_z(1, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 15)*pol_z(2, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 16)*pol_z(1, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 16)*pol_z(2, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 17)*pol_z(1, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 17)*pol_z(2, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 18)*pol_z(1, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 18)*pol_z(2, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 19)*pol_z(1, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 19)*pol_z(2, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 20)*pol_z(1, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 20)*pol_z(2, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(1, 21)*pol_z(1, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(2, 21)*pol_z(2, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(1, 22)*pol_z(1, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(2, 22)*pol_z(2, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(1, 23)*pol_z(1, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(2, 23)*pol_z(2, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(1, 24)*pol_z(1, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(2, 24)*pol_z(2, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(1, 25)*pol_z(1, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(2, 25)*pol_z(2, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(1, 26)*pol_z(1, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(2, 26)*pol_z(2, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(1, 27)*pol_z(1, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(2, 27)*pol_z(2, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(1, 28)*pol_z(1, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(2, 28)*pol_z(2, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(1, 29)*pol_z(1, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(2, 29)*pol_z(2, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(1, 30)*pol_z(1, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(2, 30)*pol_z(2, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(1, 31)*pol_z(1, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(2, 31)*pol_z(2, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(1, 32)*pol_z(1, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(2, 32)*pol_z(2, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(1, 33)*pol_z(1, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(2, 33)*pol_z(2, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(1, 34)*pol_z(1, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(2, 34)*pol_z(2, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(1, 35)*pol_z(1, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(2, 35)*pol_z(2, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(1, 36)*pol_z(1, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(2, 36)*pol_z(2, 0, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(1, 37)*pol_z(1, 0, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(2, 37)*pol_z(2, 0, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(1, 38)*pol_z(1, 0, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(2, 38)*pol_z(2, 0, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(1, 39)*pol_z(1, 0, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(2, 39)*pol_z(2, 0, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(1, 40)*pol_z(1, 0, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(2, 40)*pol_z(2, 0, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(1, 41)*pol_z(1, 0, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(2, 41)*pol_z(2, 0, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(1, 42)*pol_z(1, 0, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(2, 42)*pol_z(2, 0, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(1, 43)*pol_z(1, 0, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(2, 43)*pol_z(2, 0, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(1, 44)*pol_z(1, 0, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(2, 44)*pol_z(2, 0, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(1, 45)*pol_z(1, 0, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(2, 45)*pol_z(2, 0, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(1, 5)*pol_z(1, 1, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(2, 5)*pol_z(2, 1, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(1, 7)*pol_z(1, 1, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(2, 7)*pol_z(2, 1, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(1, 8)*pol_z(1, 1, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(2, 8)*pol_z(2, 1, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(1, 10)*pol_z(1, 1, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(2, 10)*pol_z(2, 1, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(1, 11)*pol_z(1, 1, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(2, 11)*pol_z(2, 1, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(1, 12)*pol_z(1, 1, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(2, 12)*pol_z(2, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(1, 13)*pol_z(1, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(2, 13)*pol_z(2, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(1, 14)*pol_z(1, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(2, 14)*pol_z(2, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(1, 15)*pol_z(1, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(2, 15)*pol_z(2, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(1, 16)*pol_z(1, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(2, 16)*pol_z(2, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(1, 18)*pol_z(1, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(2, 18)*pol_z(2, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(1, 19)*pol_z(1, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(2, 19)*pol_z(2, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(1, 20)*pol_z(1, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(2, 20)*pol_z(2, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(1, 21)*pol_z(1, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(2, 21)*pol_z(2, 1, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(1, 22)*pol_z(1, 1, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(2, 22)*pol_z(2, 1, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(1, 23)*pol_z(1, 1, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(2, 23)*pol_z(2, 1, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(1, 25)*pol_z(1, 1, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(2, 25)*pol_z(2, 1, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(1, 26)*pol_z(1, 1, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(2, 26)*pol_z(2, 1, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(1, 27)*pol_z(1, 1, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(2, 27)*pol_z(2, 1, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(1, 28)*pol_z(1, 1, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(2, 28)*pol_z(2, 1, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(1, 29)*pol_z(1, 1, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(2, 29)*pol_z(2, 1, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(1, 31)*pol_z(1, 1, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(2, 31)*pol_z(2, 1, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(1, 32)*pol_z(1, 1, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(2, 32)*pol_z(2, 1, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(1, 33)*pol_z(1, 1, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(2, 33)*pol_z(2, 1, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(1, 34)*pol_z(1, 1, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(2, 34)*pol_z(2, 1, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(1, 36)*pol_z(1, 1, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(2, 36)*pol_z(2, 1, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(1, 37)*pol_z(1, 1, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(2, 37)*pol_z(2, 1, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(1, 38)*pol_z(1, 1, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(2, 38)*pol_z(2, 1, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(1, 40)*pol_z(1, 1, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(2, 40)*pol_z(2, 1, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(1, 41)*pol_z(1, 1, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(2, 41)*pol_z(2, 1, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(1, 43)*pol_z(1, 1, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(2, 43)*pol_z(2, 1, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(1, 3)*pol_z(1, 2, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(2, 3)*pol_z(2, 2, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(1, 4)*pol_z(1, 2, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(2, 4)*pol_z(2, 2, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(1, 5)*pol_z(1, 2, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(2, 5)*pol_z(2, 2, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(1, 6)*pol_z(1, 2, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(2, 6)*pol_z(2, 2, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(1, 7)*pol_z(1, 2, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(2, 7)*pol_z(2, 2, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(1, 10)*pol_z(1, 2, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(2, 10)*pol_z(2, 2, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(1, 11)*pol_z(1, 2, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(2, 11)*pol_z(2, 2, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(1, 12)*pol_z(1, 2, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(2, 12)*pol_z(2, 2, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(1, 13)*pol_z(1, 2, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(2, 13)*pol_z(2, 2, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(1, 14)*pol_z(1, 2, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(2, 14)*pol_z(2, 2, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(1, 15)*pol_z(1, 2, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(2, 15)*pol_z(2, 2, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(1, 18)*pol_z(1, 2, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(2, 18)*pol_z(2, 2, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(1, 19)*pol_z(1, 2, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(2, 19)*pol_z(2, 2, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(1, 20)*pol_z(1, 2, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(2, 20)*pol_z(2, 2, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(1, 21)*pol_z(1, 2, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(2, 21)*pol_z(2, 2, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(1, 22)*pol_z(1, 2, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(2, 22)*pol_z(2, 2, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(1, 25)*pol_z(1, 2, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(2, 25)*pol_z(2, 2, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(1, 26)*pol_z(1, 2, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(2, 26)*pol_z(2, 2, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(1, 27)*pol_z(1, 2, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(2, 27)*pol_z(2, 2, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(1, 28)*pol_z(1, 2, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(2, 28)*pol_z(2, 2, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(1, 31)*pol_z(1, 2, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(2, 31)*pol_z(2, 2, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(1, 32)*pol_z(1, 2, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(2, 32)*pol_z(2, 2, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(1, 33)*pol_z(1, 2, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(2, 33)*pol_z(2, 2, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(1, 36)*pol_z(1, 2, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(2, 36)*pol_z(2, 2, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(1, 37)*pol_z(1, 2, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(2, 37)*pol_z(2, 2, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(1, 40)*pol_z(1, 2, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(2, 40)*pol_z(2, 2, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(1, 2)*pol_z(1, 3, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(2, 2)*pol_z(2, 3, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(1, 3)*pol_z(1, 3, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(2, 3)*pol_z(2, 3, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(1, 4)*pol_z(1, 3, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(2, 4)*pol_z(2, 3, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(1, 5)*pol_z(1, 3, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(2, 5)*pol_z(2, 3, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(1, 6)*pol_z(1, 3, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(2, 6)*pol_z(2, 3, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(1, 10)*pol_z(1, 3, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(2, 10)*pol_z(2, 3, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(1, 11)*pol_z(1, 3, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(2, 11)*pol_z(2, 3, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(1, 12)*pol_z(1, 3, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(2, 12)*pol_z(2, 3, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(1, 13)*pol_z(1, 3, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(2, 13)*pol_z(2, 3, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(1, 14)*pol_z(1, 3, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(2, 14)*pol_z(2, 3, kg) + coef_xyz(121) = coef_xyz(121) + coef_xy(1, 18)*pol_z(1, 3, kg) + coef_xyz(121) = coef_xyz(121) + coef_xy(2, 18)*pol_z(2, 3, kg) + coef_xyz(122) = coef_xyz(122) + coef_xy(1, 19)*pol_z(1, 3, kg) + coef_xyz(122) = coef_xyz(122) + coef_xy(2, 19)*pol_z(2, 3, kg) + coef_xyz(123) = coef_xyz(123) + coef_xy(1, 20)*pol_z(1, 3, kg) + coef_xyz(123) = coef_xyz(123) + coef_xy(2, 20)*pol_z(2, 3, kg) + coef_xyz(124) = coef_xyz(124) + coef_xy(1, 21)*pol_z(1, 3, kg) + coef_xyz(124) = coef_xyz(124) + coef_xy(2, 21)*pol_z(2, 3, kg) + coef_xyz(125) = coef_xyz(125) + coef_xy(1, 25)*pol_z(1, 3, kg) + coef_xyz(125) = coef_xyz(125) + coef_xy(2, 25)*pol_z(2, 3, kg) + coef_xyz(126) = coef_xyz(126) + coef_xy(1, 26)*pol_z(1, 3, kg) + coef_xyz(126) = coef_xyz(126) + coef_xy(2, 26)*pol_z(2, 3, kg) + coef_xyz(127) = coef_xyz(127) + coef_xy(1, 27)*pol_z(1, 3, kg) + coef_xyz(127) = coef_xyz(127) + coef_xy(2, 27)*pol_z(2, 3, kg) + coef_xyz(128) = coef_xyz(128) + coef_xy(1, 31)*pol_z(1, 3, kg) + coef_xyz(128) = coef_xyz(128) + coef_xy(2, 31)*pol_z(2, 3, kg) + coef_xyz(129) = coef_xyz(129) + coef_xy(1, 32)*pol_z(1, 3, kg) + coef_xyz(129) = coef_xyz(129) + coef_xy(2, 32)*pol_z(2, 3, kg) + coef_xyz(130) = coef_xyz(130) + coef_xy(1, 36)*pol_z(1, 3, kg) + coef_xyz(130) = coef_xyz(130) + coef_xy(2, 36)*pol_z(2, 3, kg) + coef_xyz(131) = coef_xyz(131) + coef_xy(1, 1)*pol_z(1, 4, kg) + coef_xyz(131) = coef_xyz(131) + coef_xy(2, 1)*pol_z(2, 4, kg) + coef_xyz(132) = coef_xyz(132) + coef_xy(1, 2)*pol_z(1, 4, kg) + coef_xyz(132) = coef_xyz(132) + coef_xy(2, 2)*pol_z(2, 4, kg) + coef_xyz(133) = coef_xyz(133) + coef_xy(1, 3)*pol_z(1, 4, kg) + coef_xyz(133) = coef_xyz(133) + coef_xy(2, 3)*pol_z(2, 4, kg) + coef_xyz(134) = coef_xyz(134) + coef_xy(1, 4)*pol_z(1, 4, kg) + coef_xyz(134) = coef_xyz(134) + coef_xy(2, 4)*pol_z(2, 4, kg) + coef_xyz(135) = coef_xyz(135) + coef_xy(1, 5)*pol_z(1, 4, kg) + coef_xyz(135) = coef_xyz(135) + coef_xy(2, 5)*pol_z(2, 4, kg) + coef_xyz(136) = coef_xyz(136) + coef_xy(1, 10)*pol_z(1, 4, kg) + coef_xyz(136) = coef_xyz(136) + coef_xy(2, 10)*pol_z(2, 4, kg) + coef_xyz(137) = coef_xyz(137) + coef_xy(1, 11)*pol_z(1, 4, kg) + coef_xyz(137) = coef_xyz(137) + coef_xy(2, 11)*pol_z(2, 4, kg) + coef_xyz(138) = coef_xyz(138) + coef_xy(1, 12)*pol_z(1, 4, kg) + coef_xyz(138) = coef_xyz(138) + coef_xy(2, 12)*pol_z(2, 4, kg) + coef_xyz(139) = coef_xyz(139) + coef_xy(1, 13)*pol_z(1, 4, kg) + coef_xyz(139) = coef_xyz(139) + coef_xy(2, 13)*pol_z(2, 4, kg) + coef_xyz(140) = coef_xyz(140) + coef_xy(1, 18)*pol_z(1, 4, kg) + coef_xyz(140) = coef_xyz(140) + coef_xy(2, 18)*pol_z(2, 4, kg) + coef_xyz(141) = coef_xyz(141) + coef_xy(1, 19)*pol_z(1, 4, kg) + coef_xyz(141) = coef_xyz(141) + coef_xy(2, 19)*pol_z(2, 4, kg) + coef_xyz(142) = coef_xyz(142) + coef_xy(1, 20)*pol_z(1, 4, kg) + coef_xyz(142) = coef_xyz(142) + coef_xy(2, 20)*pol_z(2, 4, kg) + coef_xyz(143) = coef_xyz(143) + coef_xy(1, 25)*pol_z(1, 4, kg) + coef_xyz(143) = coef_xyz(143) + coef_xy(2, 25)*pol_z(2, 4, kg) + coef_xyz(144) = coef_xyz(144) + coef_xy(1, 26)*pol_z(1, 4, kg) + coef_xyz(144) = coef_xyz(144) + coef_xy(2, 26)*pol_z(2, 4, kg) + coef_xyz(145) = coef_xyz(145) + coef_xy(1, 31)*pol_z(1, 4, kg) + coef_xyz(145) = coef_xyz(145) + coef_xy(2, 31)*pol_z(2, 4, kg) + coef_xyz(146) = coef_xyz(146) + coef_xy(1, 1)*pol_z(1, 5, kg) + coef_xyz(146) = coef_xyz(146) + coef_xy(2, 1)*pol_z(2, 5, kg) + coef_xyz(147) = coef_xyz(147) + coef_xy(1, 2)*pol_z(1, 5, kg) + coef_xyz(147) = coef_xyz(147) + coef_xy(2, 2)*pol_z(2, 5, kg) + coef_xyz(148) = coef_xyz(148) + coef_xy(1, 3)*pol_z(1, 5, kg) + coef_xyz(148) = coef_xyz(148) + coef_xy(2, 3)*pol_z(2, 5, kg) + coef_xyz(149) = coef_xyz(149) + coef_xy(1, 4)*pol_z(1, 5, kg) + coef_xyz(149) = coef_xyz(149) + coef_xy(2, 4)*pol_z(2, 5, kg) + coef_xyz(150) = coef_xyz(150) + coef_xy(1, 10)*pol_z(1, 5, kg) + coef_xyz(150) = coef_xyz(150) + coef_xy(2, 10)*pol_z(2, 5, kg) + coef_xyz(151) = coef_xyz(151) + coef_xy(1, 11)*pol_z(1, 5, kg) + coef_xyz(151) = coef_xyz(151) + coef_xy(2, 11)*pol_z(2, 5, kg) + coef_xyz(152) = coef_xyz(152) + coef_xy(1, 12)*pol_z(1, 5, kg) + coef_xyz(152) = coef_xyz(152) + coef_xy(2, 12)*pol_z(2, 5, kg) + coef_xyz(153) = coef_xyz(153) + coef_xy(1, 18)*pol_z(1, 5, kg) + coef_xyz(153) = coef_xyz(153) + coef_xy(2, 18)*pol_z(2, 5, kg) + coef_xyz(154) = coef_xyz(154) + coef_xy(1, 19)*pol_z(1, 5, kg) + coef_xyz(154) = coef_xyz(154) + coef_xy(2, 19)*pol_z(2, 5, kg) + coef_xyz(155) = coef_xyz(155) + coef_xy(1, 25)*pol_z(1, 5, kg) + coef_xyz(155) = coef_xyz(155) + coef_xy(2, 25)*pol_z(2, 5, kg) + coef_xyz(156) = coef_xyz(156) + coef_xy(1, 1)*pol_z(1, 6, kg) + coef_xyz(156) = coef_xyz(156) + coef_xy(2, 1)*pol_z(2, 6, kg) + coef_xyz(157) = coef_xyz(157) + coef_xy(1, 2)*pol_z(1, 6, kg) + coef_xyz(157) = coef_xyz(157) + coef_xy(2, 2)*pol_z(2, 6, kg) + coef_xyz(158) = coef_xyz(158) + coef_xy(1, 3)*pol_z(1, 6, kg) + coef_xyz(158) = coef_xyz(158) + coef_xy(2, 3)*pol_z(2, 6, kg) + coef_xyz(159) = coef_xyz(159) + coef_xy(1, 10)*pol_z(1, 6, kg) + coef_xyz(159) = coef_xyz(159) + coef_xy(2, 10)*pol_z(2, 6, kg) + coef_xyz(160) = coef_xyz(160) + coef_xy(1, 11)*pol_z(1, 6, kg) + coef_xyz(160) = coef_xyz(160) + coef_xy(2, 11)*pol_z(2, 6, kg) + coef_xyz(161) = coef_xyz(161) + coef_xy(1, 18)*pol_z(1, 6, kg) + coef_xyz(161) = coef_xyz(161) + coef_xy(2, 18)*pol_z(2, 6, kg) + coef_xyz(162) = coef_xyz(162) + coef_xy(1, 1)*pol_z(1, 7, kg) + coef_xyz(162) = coef_xyz(162) + coef_xy(2, 1)*pol_z(2, 7, kg) + coef_xyz(163) = coef_xyz(163) + coef_xy(1, 2)*pol_z(1, 7, kg) + coef_xyz(163) = coef_xyz(163) + coef_xy(2, 2)*pol_z(2, 7, kg) + coef_xyz(164) = coef_xyz(164) + coef_xy(1, 10)*pol_z(1, 7, kg) + coef_xyz(164) = coef_xyz(164) + coef_xy(2, 10)*pol_z(2, 7, kg) + coef_xyz(165) = coef_xyz(165) + coef_xy(1, 1)*pol_z(1, 8, kg) + coef_xyz(165) = coef_xyz(165) + coef_xy(2, 1)*pol_z(2, 8, kg) END DO END SUBROUTINE integrate_core_8 @@ -2567,13 +2567,13 @@ SUBROUTINE integrate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -2581,23 +2581,23 @@ SUBROUTINE integrate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -2606,708 +2606,708 @@ SUBROUTINE integrate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = grid(i, j, k2) s03 = grid(i, j2, k) s04 = grid(i, j2, k2) - coef_x(1, 0) = coef_x(1, 0)+s01*pol_x(0, ig) - coef_x(2, 0) = coef_x(2, 0)+s02*pol_x(0, ig) - coef_x(3, 0) = coef_x(3, 0)+s03*pol_x(0, ig) - coef_x(4, 0) = coef_x(4, 0)+s04*pol_x(0, ig) - coef_x(1, 1) = coef_x(1, 1)+s01*pol_x(1, ig) - coef_x(2, 1) = coef_x(2, 1)+s02*pol_x(1, ig) - coef_x(3, 1) = coef_x(3, 1)+s03*pol_x(1, ig) - coef_x(4, 1) = coef_x(4, 1)+s04*pol_x(1, ig) - coef_x(1, 2) = coef_x(1, 2)+s01*pol_x(2, ig) - coef_x(2, 2) = coef_x(2, 2)+s02*pol_x(2, ig) - coef_x(3, 2) = coef_x(3, 2)+s03*pol_x(2, ig) - coef_x(4, 2) = coef_x(4, 2)+s04*pol_x(2, ig) - coef_x(1, 3) = coef_x(1, 3)+s01*pol_x(3, ig) - coef_x(2, 3) = coef_x(2, 3)+s02*pol_x(3, ig) - coef_x(3, 3) = coef_x(3, 3)+s03*pol_x(3, ig) - coef_x(4, 3) = coef_x(4, 3)+s04*pol_x(3, ig) - coef_x(1, 4) = coef_x(1, 4)+s01*pol_x(4, ig) - coef_x(2, 4) = coef_x(2, 4)+s02*pol_x(4, ig) - coef_x(3, 4) = coef_x(3, 4)+s03*pol_x(4, ig) - coef_x(4, 4) = coef_x(4, 4)+s04*pol_x(4, ig) - coef_x(1, 5) = coef_x(1, 5)+s01*pol_x(5, ig) - coef_x(2, 5) = coef_x(2, 5)+s02*pol_x(5, ig) - coef_x(3, 5) = coef_x(3, 5)+s03*pol_x(5, ig) - coef_x(4, 5) = coef_x(4, 5)+s04*pol_x(5, ig) - coef_x(1, 6) = coef_x(1, 6)+s01*pol_x(6, ig) - coef_x(2, 6) = coef_x(2, 6)+s02*pol_x(6, ig) - coef_x(3, 6) = coef_x(3, 6)+s03*pol_x(6, ig) - coef_x(4, 6) = coef_x(4, 6)+s04*pol_x(6, ig) - coef_x(1, 7) = coef_x(1, 7)+s01*pol_x(7, ig) - coef_x(2, 7) = coef_x(2, 7)+s02*pol_x(7, ig) - coef_x(3, 7) = coef_x(3, 7)+s03*pol_x(7, ig) - coef_x(4, 7) = coef_x(4, 7)+s04*pol_x(7, ig) - coef_x(1, 8) = coef_x(1, 8)+s01*pol_x(8, ig) - coef_x(2, 8) = coef_x(2, 8)+s02*pol_x(8, ig) - coef_x(3, 8) = coef_x(3, 8)+s03*pol_x(8, ig) - coef_x(4, 8) = coef_x(4, 8)+s04*pol_x(8, ig) - coef_x(1, 9) = coef_x(1, 9)+s01*pol_x(9, ig) - coef_x(2, 9) = coef_x(2, 9)+s02*pol_x(9, ig) - coef_x(3, 9) = coef_x(3, 9)+s03*pol_x(9, ig) - coef_x(4, 9) = coef_x(4, 9)+s04*pol_x(9, ig) + coef_x(1, 0) = coef_x(1, 0) + s01*pol_x(0, ig) + coef_x(2, 0) = coef_x(2, 0) + s02*pol_x(0, ig) + coef_x(3, 0) = coef_x(3, 0) + s03*pol_x(0, ig) + coef_x(4, 0) = coef_x(4, 0) + s04*pol_x(0, ig) + coef_x(1, 1) = coef_x(1, 1) + s01*pol_x(1, ig) + coef_x(2, 1) = coef_x(2, 1) + s02*pol_x(1, ig) + coef_x(3, 1) = coef_x(3, 1) + s03*pol_x(1, ig) + coef_x(4, 1) = coef_x(4, 1) + s04*pol_x(1, ig) + coef_x(1, 2) = coef_x(1, 2) + s01*pol_x(2, ig) + coef_x(2, 2) = coef_x(2, 2) + s02*pol_x(2, ig) + coef_x(3, 2) = coef_x(3, 2) + s03*pol_x(2, ig) + coef_x(4, 2) = coef_x(4, 2) + s04*pol_x(2, ig) + coef_x(1, 3) = coef_x(1, 3) + s01*pol_x(3, ig) + coef_x(2, 3) = coef_x(2, 3) + s02*pol_x(3, ig) + coef_x(3, 3) = coef_x(3, 3) + s03*pol_x(3, ig) + coef_x(4, 3) = coef_x(4, 3) + s04*pol_x(3, ig) + coef_x(1, 4) = coef_x(1, 4) + s01*pol_x(4, ig) + coef_x(2, 4) = coef_x(2, 4) + s02*pol_x(4, ig) + coef_x(3, 4) = coef_x(3, 4) + s03*pol_x(4, ig) + coef_x(4, 4) = coef_x(4, 4) + s04*pol_x(4, ig) + coef_x(1, 5) = coef_x(1, 5) + s01*pol_x(5, ig) + coef_x(2, 5) = coef_x(2, 5) + s02*pol_x(5, ig) + coef_x(3, 5) = coef_x(3, 5) + s03*pol_x(5, ig) + coef_x(4, 5) = coef_x(4, 5) + s04*pol_x(5, ig) + coef_x(1, 6) = coef_x(1, 6) + s01*pol_x(6, ig) + coef_x(2, 6) = coef_x(2, 6) + s02*pol_x(6, ig) + coef_x(3, 6) = coef_x(3, 6) + s03*pol_x(6, ig) + coef_x(4, 6) = coef_x(4, 6) + s04*pol_x(6, ig) + coef_x(1, 7) = coef_x(1, 7) + s01*pol_x(7, ig) + coef_x(2, 7) = coef_x(2, 7) + s02*pol_x(7, ig) + coef_x(3, 7) = coef_x(3, 7) + s03*pol_x(7, ig) + coef_x(4, 7) = coef_x(4, 7) + s04*pol_x(7, ig) + coef_x(1, 8) = coef_x(1, 8) + s01*pol_x(8, ig) + coef_x(2, 8) = coef_x(2, 8) + s02*pol_x(8, ig) + coef_x(3, 8) = coef_x(3, 8) + s03*pol_x(8, ig) + coef_x(4, 8) = coef_x(4, 8) + s04*pol_x(8, ig) + coef_x(1, 9) = coef_x(1, 9) + s01*pol_x(9, ig) + coef_x(2, 9) = coef_x(2, 9) + s02*pol_x(9, ig) + coef_x(3, 9) = coef_x(3, 9) + s03*pol_x(9, ig) + coef_x(4, 9) = coef_x(4, 9) + s04*pol_x(9, ig) END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 2)*pol_y(1, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 2)*pol_y(1, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 2)*pol_y(2, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 2)*pol_y(2, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(1, 3)*pol_y(1, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(2, 3)*pol_y(1, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(3, 3)*pol_y(2, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(4, 3)*pol_y(2, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(1, 4)*pol_y(1, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(2, 4)*pol_y(1, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(3, 4)*pol_y(2, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(4, 4)*pol_y(2, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(1, 5)*pol_y(1, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(2, 5)*pol_y(1, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(3, 5)*pol_y(2, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(4, 5)*pol_y(2, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(1, 6)*pol_y(1, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(2, 6)*pol_y(1, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(3, 6)*pol_y(2, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(4, 6)*pol_y(2, 0, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(1, 7)*pol_y(1, 0, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(2, 7)*pol_y(1, 0, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(3, 7)*pol_y(2, 0, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(4, 7)*pol_y(2, 0, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(1, 8)*pol_y(1, 0, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(2, 8)*pol_y(1, 0, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(3, 8)*pol_y(2, 0, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(4, 8)*pol_y(2, 0, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(1, 9)*pol_y(1, 0, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(2, 9)*pol_y(1, 0, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(3, 9)*pol_y(2, 0, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(4, 9)*pol_y(2, 0, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(4, 0)*pol_y(2, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(1, 1)*pol_y(1, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(2, 1)*pol_y(1, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(3, 1)*pol_y(2, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(4, 1)*pol_y(2, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(1, 2)*pol_y(1, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(2, 2)*pol_y(1, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(3, 2)*pol_y(2, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(4, 2)*pol_y(2, 1, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(1, 3)*pol_y(1, 1, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(2, 3)*pol_y(1, 1, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(3, 3)*pol_y(2, 1, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(4, 3)*pol_y(2, 1, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(1, 4)*pol_y(1, 1, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(2, 4)*pol_y(1, 1, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(3, 4)*pol_y(2, 1, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(4, 4)*pol_y(2, 1, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(1, 5)*pol_y(1, 1, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(2, 5)*pol_y(1, 1, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(3, 5)*pol_y(2, 1, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(4, 5)*pol_y(2, 1, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(1, 6)*pol_y(1, 1, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(2, 6)*pol_y(1, 1, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(3, 6)*pol_y(2, 1, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(4, 6)*pol_y(2, 1, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(1, 7)*pol_y(1, 1, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(2, 7)*pol_y(1, 1, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(3, 7)*pol_y(2, 1, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(4, 7)*pol_y(2, 1, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(1, 8)*pol_y(1, 1, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(2, 8)*pol_y(1, 1, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(3, 8)*pol_y(2, 1, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(4, 8)*pol_y(2, 1, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(1, 0)*pol_y(1, 2, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(2, 0)*pol_y(1, 2, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(3, 0)*pol_y(2, 2, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(4, 0)*pol_y(2, 2, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(1, 1)*pol_y(1, 2, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(2, 1)*pol_y(1, 2, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(3, 1)*pol_y(2, 2, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(4, 1)*pol_y(2, 2, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(1, 2)*pol_y(1, 2, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(2, 2)*pol_y(1, 2, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(3, 2)*pol_y(2, 2, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(4, 2)*pol_y(2, 2, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(1, 3)*pol_y(1, 2, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(2, 3)*pol_y(1, 2, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(3, 3)*pol_y(2, 2, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(4, 3)*pol_y(2, 2, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(1, 4)*pol_y(1, 2, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(2, 4)*pol_y(1, 2, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(3, 4)*pol_y(2, 2, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(4, 4)*pol_y(2, 2, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(1, 5)*pol_y(1, 2, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(2, 5)*pol_y(1, 2, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(3, 5)*pol_y(2, 2, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(4, 5)*pol_y(2, 2, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(1, 6)*pol_y(1, 2, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(2, 6)*pol_y(1, 2, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(3, 6)*pol_y(2, 2, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(4, 6)*pol_y(2, 2, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(1, 7)*pol_y(1, 2, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(2, 7)*pol_y(1, 2, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(3, 7)*pol_y(2, 2, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(4, 7)*pol_y(2, 2, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(1, 0)*pol_y(1, 3, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(2, 0)*pol_y(1, 3, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(3, 0)*pol_y(2, 3, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(4, 0)*pol_y(2, 3, jg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_x(1, 1)*pol_y(1, 3, jg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_x(2, 1)*pol_y(1, 3, jg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_x(3, 1)*pol_y(2, 3, jg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_x(4, 1)*pol_y(2, 3, jg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_x(1, 2)*pol_y(1, 3, jg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_x(2, 2)*pol_y(1, 3, jg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_x(3, 2)*pol_y(2, 3, jg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_x(4, 2)*pol_y(2, 3, jg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_x(1, 3)*pol_y(1, 3, jg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_x(2, 3)*pol_y(1, 3, jg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_x(3, 3)*pol_y(2, 3, jg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_x(4, 3)*pol_y(2, 3, jg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_x(1, 4)*pol_y(1, 3, jg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_x(2, 4)*pol_y(1, 3, jg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_x(3, 4)*pol_y(2, 3, jg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_x(4, 4)*pol_y(2, 3, jg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_x(1, 5)*pol_y(1, 3, jg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_x(2, 5)*pol_y(1, 3, jg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_x(3, 5)*pol_y(2, 3, jg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_x(4, 5)*pol_y(2, 3, jg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_x(1, 6)*pol_y(1, 3, jg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_x(2, 6)*pol_y(1, 3, jg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_x(3, 6)*pol_y(2, 3, jg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_x(4, 6)*pol_y(2, 3, jg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_x(1, 0)*pol_y(1, 4, jg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_x(2, 0)*pol_y(1, 4, jg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_x(3, 0)*pol_y(2, 4, jg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_x(4, 0)*pol_y(2, 4, jg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_x(1, 1)*pol_y(1, 4, jg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_x(2, 1)*pol_y(1, 4, jg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_x(3, 1)*pol_y(2, 4, jg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_x(4, 1)*pol_y(2, 4, jg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_x(1, 2)*pol_y(1, 4, jg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_x(2, 2)*pol_y(1, 4, jg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_x(3, 2)*pol_y(2, 4, jg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_x(4, 2)*pol_y(2, 4, jg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_x(1, 3)*pol_y(1, 4, jg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_x(2, 3)*pol_y(1, 4, jg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_x(3, 3)*pol_y(2, 4, jg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_x(4, 3)*pol_y(2, 4, jg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_x(1, 4)*pol_y(1, 4, jg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_x(2, 4)*pol_y(1, 4, jg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_x(3, 4)*pol_y(2, 4, jg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_x(4, 4)*pol_y(2, 4, jg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_x(1, 5)*pol_y(1, 4, jg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_x(2, 5)*pol_y(1, 4, jg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_x(3, 5)*pol_y(2, 4, jg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_x(4, 5)*pol_y(2, 4, jg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_x(1, 0)*pol_y(1, 5, jg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_x(2, 0)*pol_y(1, 5, jg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_x(3, 0)*pol_y(2, 5, jg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_x(4, 0)*pol_y(2, 5, jg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_x(1, 1)*pol_y(1, 5, jg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_x(2, 1)*pol_y(1, 5, jg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_x(3, 1)*pol_y(2, 5, jg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_x(4, 1)*pol_y(2, 5, jg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_x(1, 2)*pol_y(1, 5, jg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_x(2, 2)*pol_y(1, 5, jg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_x(3, 2)*pol_y(2, 5, jg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_x(4, 2)*pol_y(2, 5, jg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_x(1, 3)*pol_y(1, 5, jg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_x(2, 3)*pol_y(1, 5, jg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_x(3, 3)*pol_y(2, 5, jg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_x(4, 3)*pol_y(2, 5, jg) - coef_xy(1, 45) = coef_xy(1, 45)+coef_x(1, 4)*pol_y(1, 5, jg) - coef_xy(2, 45) = coef_xy(2, 45)+coef_x(2, 4)*pol_y(1, 5, jg) - coef_xy(1, 45) = coef_xy(1, 45)+coef_x(3, 4)*pol_y(2, 5, jg) - coef_xy(2, 45) = coef_xy(2, 45)+coef_x(4, 4)*pol_y(2, 5, jg) - coef_xy(1, 46) = coef_xy(1, 46)+coef_x(1, 0)*pol_y(1, 6, jg) - coef_xy(2, 46) = coef_xy(2, 46)+coef_x(2, 0)*pol_y(1, 6, jg) - coef_xy(1, 46) = coef_xy(1, 46)+coef_x(3, 0)*pol_y(2, 6, jg) - coef_xy(2, 46) = coef_xy(2, 46)+coef_x(4, 0)*pol_y(2, 6, jg) - coef_xy(1, 47) = coef_xy(1, 47)+coef_x(1, 1)*pol_y(1, 6, jg) - coef_xy(2, 47) = coef_xy(2, 47)+coef_x(2, 1)*pol_y(1, 6, jg) - coef_xy(1, 47) = coef_xy(1, 47)+coef_x(3, 1)*pol_y(2, 6, jg) - coef_xy(2, 47) = coef_xy(2, 47)+coef_x(4, 1)*pol_y(2, 6, jg) - coef_xy(1, 48) = coef_xy(1, 48)+coef_x(1, 2)*pol_y(1, 6, jg) - coef_xy(2, 48) = coef_xy(2, 48)+coef_x(2, 2)*pol_y(1, 6, jg) - coef_xy(1, 48) = coef_xy(1, 48)+coef_x(3, 2)*pol_y(2, 6, jg) - coef_xy(2, 48) = coef_xy(2, 48)+coef_x(4, 2)*pol_y(2, 6, jg) - coef_xy(1, 49) = coef_xy(1, 49)+coef_x(1, 3)*pol_y(1, 6, jg) - coef_xy(2, 49) = coef_xy(2, 49)+coef_x(2, 3)*pol_y(1, 6, jg) - coef_xy(1, 49) = coef_xy(1, 49)+coef_x(3, 3)*pol_y(2, 6, jg) - coef_xy(2, 49) = coef_xy(2, 49)+coef_x(4, 3)*pol_y(2, 6, jg) - coef_xy(1, 50) = coef_xy(1, 50)+coef_x(1, 0)*pol_y(1, 7, jg) - coef_xy(2, 50) = coef_xy(2, 50)+coef_x(2, 0)*pol_y(1, 7, jg) - coef_xy(1, 50) = coef_xy(1, 50)+coef_x(3, 0)*pol_y(2, 7, jg) - coef_xy(2, 50) = coef_xy(2, 50)+coef_x(4, 0)*pol_y(2, 7, jg) - coef_xy(1, 51) = coef_xy(1, 51)+coef_x(1, 1)*pol_y(1, 7, jg) - coef_xy(2, 51) = coef_xy(2, 51)+coef_x(2, 1)*pol_y(1, 7, jg) - coef_xy(1, 51) = coef_xy(1, 51)+coef_x(3, 1)*pol_y(2, 7, jg) - coef_xy(2, 51) = coef_xy(2, 51)+coef_x(4, 1)*pol_y(2, 7, jg) - coef_xy(1, 52) = coef_xy(1, 52)+coef_x(1, 2)*pol_y(1, 7, jg) - coef_xy(2, 52) = coef_xy(2, 52)+coef_x(2, 2)*pol_y(1, 7, jg) - coef_xy(1, 52) = coef_xy(1, 52)+coef_x(3, 2)*pol_y(2, 7, jg) - coef_xy(2, 52) = coef_xy(2, 52)+coef_x(4, 2)*pol_y(2, 7, jg) - coef_xy(1, 53) = coef_xy(1, 53)+coef_x(1, 0)*pol_y(1, 8, jg) - coef_xy(2, 53) = coef_xy(2, 53)+coef_x(2, 0)*pol_y(1, 8, jg) - coef_xy(1, 53) = coef_xy(1, 53)+coef_x(3, 0)*pol_y(2, 8, jg) - coef_xy(2, 53) = coef_xy(2, 53)+coef_x(4, 0)*pol_y(2, 8, jg) - coef_xy(1, 54) = coef_xy(1, 54)+coef_x(1, 1)*pol_y(1, 8, jg) - coef_xy(2, 54) = coef_xy(2, 54)+coef_x(2, 1)*pol_y(1, 8, jg) - coef_xy(1, 54) = coef_xy(1, 54)+coef_x(3, 1)*pol_y(2, 8, jg) - coef_xy(2, 54) = coef_xy(2, 54)+coef_x(4, 1)*pol_y(2, 8, jg) - coef_xy(1, 55) = coef_xy(1, 55)+coef_x(1, 0)*pol_y(1, 9, jg) - coef_xy(2, 55) = coef_xy(2, 55)+coef_x(2, 0)*pol_y(1, 9, jg) - coef_xy(1, 55) = coef_xy(1, 55)+coef_x(3, 0)*pol_y(2, 9, jg) - coef_xy(2, 55) = coef_xy(2, 55)+coef_x(4, 0)*pol_y(2, 9, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 2)*pol_y(1, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 2)*pol_y(1, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 2)*pol_y(2, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 2)*pol_y(2, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(1, 3)*pol_y(1, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(2, 3)*pol_y(1, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(3, 3)*pol_y(2, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(4, 3)*pol_y(2, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(1, 4)*pol_y(1, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(2, 4)*pol_y(1, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(3, 4)*pol_y(2, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(4, 4)*pol_y(2, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(1, 5)*pol_y(1, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(2, 5)*pol_y(1, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(3, 5)*pol_y(2, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(4, 5)*pol_y(2, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(1, 6)*pol_y(1, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(2, 6)*pol_y(1, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(3, 6)*pol_y(2, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(4, 6)*pol_y(2, 0, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(1, 7)*pol_y(1, 0, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(2, 7)*pol_y(1, 0, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(3, 7)*pol_y(2, 0, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(4, 7)*pol_y(2, 0, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(1, 8)*pol_y(1, 0, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(2, 8)*pol_y(1, 0, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(3, 8)*pol_y(2, 0, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(4, 8)*pol_y(2, 0, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(1, 9)*pol_y(1, 0, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(2, 9)*pol_y(1, 0, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(3, 9)*pol_y(2, 0, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(4, 9)*pol_y(2, 0, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(1, 1)*pol_y(1, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(2, 1)*pol_y(1, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(3, 1)*pol_y(2, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(4, 1)*pol_y(2, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(1, 2)*pol_y(1, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(2, 2)*pol_y(1, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(3, 2)*pol_y(2, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(4, 2)*pol_y(2, 1, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(1, 3)*pol_y(1, 1, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(2, 3)*pol_y(1, 1, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(3, 3)*pol_y(2, 1, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(4, 3)*pol_y(2, 1, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(1, 4)*pol_y(1, 1, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(2, 4)*pol_y(1, 1, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(3, 4)*pol_y(2, 1, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(4, 4)*pol_y(2, 1, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(1, 5)*pol_y(1, 1, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(2, 5)*pol_y(1, 1, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(3, 5)*pol_y(2, 1, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(4, 5)*pol_y(2, 1, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(1, 6)*pol_y(1, 1, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(2, 6)*pol_y(1, 1, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(3, 6)*pol_y(2, 1, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(4, 6)*pol_y(2, 1, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(1, 7)*pol_y(1, 1, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(2, 7)*pol_y(1, 1, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(3, 7)*pol_y(2, 1, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(4, 7)*pol_y(2, 1, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(1, 8)*pol_y(1, 1, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(2, 8)*pol_y(1, 1, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(3, 8)*pol_y(2, 1, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(4, 8)*pol_y(2, 1, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(1, 0)*pol_y(1, 2, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(2, 0)*pol_y(1, 2, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(3, 0)*pol_y(2, 2, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(4, 0)*pol_y(2, 2, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(1, 1)*pol_y(1, 2, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(2, 1)*pol_y(1, 2, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(3, 1)*pol_y(2, 2, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(4, 1)*pol_y(2, 2, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(1, 2)*pol_y(1, 2, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(2, 2)*pol_y(1, 2, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(3, 2)*pol_y(2, 2, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(4, 2)*pol_y(2, 2, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(1, 3)*pol_y(1, 2, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(2, 3)*pol_y(1, 2, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(3, 3)*pol_y(2, 2, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(4, 3)*pol_y(2, 2, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(1, 4)*pol_y(1, 2, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(2, 4)*pol_y(1, 2, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(3, 4)*pol_y(2, 2, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(4, 4)*pol_y(2, 2, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(1, 5)*pol_y(1, 2, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(2, 5)*pol_y(1, 2, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(3, 5)*pol_y(2, 2, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(4, 5)*pol_y(2, 2, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(1, 6)*pol_y(1, 2, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(2, 6)*pol_y(1, 2, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(3, 6)*pol_y(2, 2, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(4, 6)*pol_y(2, 2, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(1, 7)*pol_y(1, 2, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(2, 7)*pol_y(1, 2, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(3, 7)*pol_y(2, 2, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(4, 7)*pol_y(2, 2, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(1, 0)*pol_y(1, 3, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(2, 0)*pol_y(1, 3, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(3, 0)*pol_y(2, 3, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(4, 0)*pol_y(2, 3, jg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_x(1, 1)*pol_y(1, 3, jg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_x(2, 1)*pol_y(1, 3, jg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_x(3, 1)*pol_y(2, 3, jg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_x(4, 1)*pol_y(2, 3, jg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_x(1, 2)*pol_y(1, 3, jg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_x(2, 2)*pol_y(1, 3, jg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_x(3, 2)*pol_y(2, 3, jg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_x(4, 2)*pol_y(2, 3, jg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_x(1, 3)*pol_y(1, 3, jg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_x(2, 3)*pol_y(1, 3, jg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_x(3, 3)*pol_y(2, 3, jg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_x(4, 3)*pol_y(2, 3, jg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_x(1, 4)*pol_y(1, 3, jg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_x(2, 4)*pol_y(1, 3, jg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_x(3, 4)*pol_y(2, 3, jg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_x(4, 4)*pol_y(2, 3, jg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_x(1, 5)*pol_y(1, 3, jg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_x(2, 5)*pol_y(1, 3, jg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_x(3, 5)*pol_y(2, 3, jg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_x(4, 5)*pol_y(2, 3, jg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_x(1, 6)*pol_y(1, 3, jg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_x(2, 6)*pol_y(1, 3, jg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_x(3, 6)*pol_y(2, 3, jg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_x(4, 6)*pol_y(2, 3, jg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_x(1, 0)*pol_y(1, 4, jg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_x(2, 0)*pol_y(1, 4, jg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_x(3, 0)*pol_y(2, 4, jg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_x(4, 0)*pol_y(2, 4, jg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_x(1, 1)*pol_y(1, 4, jg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_x(2, 1)*pol_y(1, 4, jg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_x(3, 1)*pol_y(2, 4, jg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_x(4, 1)*pol_y(2, 4, jg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_x(1, 2)*pol_y(1, 4, jg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_x(2, 2)*pol_y(1, 4, jg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_x(3, 2)*pol_y(2, 4, jg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_x(4, 2)*pol_y(2, 4, jg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_x(1, 3)*pol_y(1, 4, jg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_x(2, 3)*pol_y(1, 4, jg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_x(3, 3)*pol_y(2, 4, jg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_x(4, 3)*pol_y(2, 4, jg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_x(1, 4)*pol_y(1, 4, jg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_x(2, 4)*pol_y(1, 4, jg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_x(3, 4)*pol_y(2, 4, jg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_x(4, 4)*pol_y(2, 4, jg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_x(1, 5)*pol_y(1, 4, jg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_x(2, 5)*pol_y(1, 4, jg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_x(3, 5)*pol_y(2, 4, jg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_x(4, 5)*pol_y(2, 4, jg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_x(1, 0)*pol_y(1, 5, jg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_x(2, 0)*pol_y(1, 5, jg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_x(3, 0)*pol_y(2, 5, jg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_x(4, 0)*pol_y(2, 5, jg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_x(1, 1)*pol_y(1, 5, jg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_x(2, 1)*pol_y(1, 5, jg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_x(3, 1)*pol_y(2, 5, jg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_x(4, 1)*pol_y(2, 5, jg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_x(1, 2)*pol_y(1, 5, jg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_x(2, 2)*pol_y(1, 5, jg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_x(3, 2)*pol_y(2, 5, jg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_x(4, 2)*pol_y(2, 5, jg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_x(1, 3)*pol_y(1, 5, jg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_x(2, 3)*pol_y(1, 5, jg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_x(3, 3)*pol_y(2, 5, jg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_x(4, 3)*pol_y(2, 5, jg) + coef_xy(1, 45) = coef_xy(1, 45) + coef_x(1, 4)*pol_y(1, 5, jg) + coef_xy(2, 45) = coef_xy(2, 45) + coef_x(2, 4)*pol_y(1, 5, jg) + coef_xy(1, 45) = coef_xy(1, 45) + coef_x(3, 4)*pol_y(2, 5, jg) + coef_xy(2, 45) = coef_xy(2, 45) + coef_x(4, 4)*pol_y(2, 5, jg) + coef_xy(1, 46) = coef_xy(1, 46) + coef_x(1, 0)*pol_y(1, 6, jg) + coef_xy(2, 46) = coef_xy(2, 46) + coef_x(2, 0)*pol_y(1, 6, jg) + coef_xy(1, 46) = coef_xy(1, 46) + coef_x(3, 0)*pol_y(2, 6, jg) + coef_xy(2, 46) = coef_xy(2, 46) + coef_x(4, 0)*pol_y(2, 6, jg) + coef_xy(1, 47) = coef_xy(1, 47) + coef_x(1, 1)*pol_y(1, 6, jg) + coef_xy(2, 47) = coef_xy(2, 47) + coef_x(2, 1)*pol_y(1, 6, jg) + coef_xy(1, 47) = coef_xy(1, 47) + coef_x(3, 1)*pol_y(2, 6, jg) + coef_xy(2, 47) = coef_xy(2, 47) + coef_x(4, 1)*pol_y(2, 6, jg) + coef_xy(1, 48) = coef_xy(1, 48) + coef_x(1, 2)*pol_y(1, 6, jg) + coef_xy(2, 48) = coef_xy(2, 48) + coef_x(2, 2)*pol_y(1, 6, jg) + coef_xy(1, 48) = coef_xy(1, 48) + coef_x(3, 2)*pol_y(2, 6, jg) + coef_xy(2, 48) = coef_xy(2, 48) + coef_x(4, 2)*pol_y(2, 6, jg) + coef_xy(1, 49) = coef_xy(1, 49) + coef_x(1, 3)*pol_y(1, 6, jg) + coef_xy(2, 49) = coef_xy(2, 49) + coef_x(2, 3)*pol_y(1, 6, jg) + coef_xy(1, 49) = coef_xy(1, 49) + coef_x(3, 3)*pol_y(2, 6, jg) + coef_xy(2, 49) = coef_xy(2, 49) + coef_x(4, 3)*pol_y(2, 6, jg) + coef_xy(1, 50) = coef_xy(1, 50) + coef_x(1, 0)*pol_y(1, 7, jg) + coef_xy(2, 50) = coef_xy(2, 50) + coef_x(2, 0)*pol_y(1, 7, jg) + coef_xy(1, 50) = coef_xy(1, 50) + coef_x(3, 0)*pol_y(2, 7, jg) + coef_xy(2, 50) = coef_xy(2, 50) + coef_x(4, 0)*pol_y(2, 7, jg) + coef_xy(1, 51) = coef_xy(1, 51) + coef_x(1, 1)*pol_y(1, 7, jg) + coef_xy(2, 51) = coef_xy(2, 51) + coef_x(2, 1)*pol_y(1, 7, jg) + coef_xy(1, 51) = coef_xy(1, 51) + coef_x(3, 1)*pol_y(2, 7, jg) + coef_xy(2, 51) = coef_xy(2, 51) + coef_x(4, 1)*pol_y(2, 7, jg) + coef_xy(1, 52) = coef_xy(1, 52) + coef_x(1, 2)*pol_y(1, 7, jg) + coef_xy(2, 52) = coef_xy(2, 52) + coef_x(2, 2)*pol_y(1, 7, jg) + coef_xy(1, 52) = coef_xy(1, 52) + coef_x(3, 2)*pol_y(2, 7, jg) + coef_xy(2, 52) = coef_xy(2, 52) + coef_x(4, 2)*pol_y(2, 7, jg) + coef_xy(1, 53) = coef_xy(1, 53) + coef_x(1, 0)*pol_y(1, 8, jg) + coef_xy(2, 53) = coef_xy(2, 53) + coef_x(2, 0)*pol_y(1, 8, jg) + coef_xy(1, 53) = coef_xy(1, 53) + coef_x(3, 0)*pol_y(2, 8, jg) + coef_xy(2, 53) = coef_xy(2, 53) + coef_x(4, 0)*pol_y(2, 8, jg) + coef_xy(1, 54) = coef_xy(1, 54) + coef_x(1, 1)*pol_y(1, 8, jg) + coef_xy(2, 54) = coef_xy(2, 54) + coef_x(2, 1)*pol_y(1, 8, jg) + coef_xy(1, 54) = coef_xy(1, 54) + coef_x(3, 1)*pol_y(2, 8, jg) + coef_xy(2, 54) = coef_xy(2, 54) + coef_x(4, 1)*pol_y(2, 8, jg) + coef_xy(1, 55) = coef_xy(1, 55) + coef_x(1, 0)*pol_y(1, 9, jg) + coef_xy(2, 55) = coef_xy(2, 55) + coef_x(2, 0)*pol_y(1, 9, jg) + coef_xy(1, 55) = coef_xy(1, 55) + coef_x(3, 0)*pol_y(2, 9, jg) + coef_xy(2, 55) = coef_xy(2, 55) + coef_x(4, 0)*pol_y(2, 9, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 11)*pol_z(1, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 11)*pol_z(2, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 12)*pol_z(1, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 12)*pol_z(2, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 13)*pol_z(1, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 13)*pol_z(2, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 14)*pol_z(1, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 14)*pol_z(2, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 15)*pol_z(1, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 15)*pol_z(2, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 16)*pol_z(1, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 16)*pol_z(2, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 17)*pol_z(1, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 17)*pol_z(2, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 18)*pol_z(1, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 18)*pol_z(2, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 19)*pol_z(1, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 19)*pol_z(2, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 20)*pol_z(1, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 20)*pol_z(2, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(1, 21)*pol_z(1, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(2, 21)*pol_z(2, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(1, 22)*pol_z(1, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(2, 22)*pol_z(2, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(1, 23)*pol_z(1, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(2, 23)*pol_z(2, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(1, 24)*pol_z(1, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(2, 24)*pol_z(2, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(1, 25)*pol_z(1, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(2, 25)*pol_z(2, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(1, 26)*pol_z(1, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(2, 26)*pol_z(2, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(1, 27)*pol_z(1, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(2, 27)*pol_z(2, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(1, 28)*pol_z(1, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(2, 28)*pol_z(2, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(1, 29)*pol_z(1, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(2, 29)*pol_z(2, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(1, 30)*pol_z(1, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(2, 30)*pol_z(2, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(1, 31)*pol_z(1, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(2, 31)*pol_z(2, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(1, 32)*pol_z(1, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(2, 32)*pol_z(2, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(1, 33)*pol_z(1, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(2, 33)*pol_z(2, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(1, 34)*pol_z(1, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(2, 34)*pol_z(2, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(1, 35)*pol_z(1, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(2, 35)*pol_z(2, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(1, 36)*pol_z(1, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(2, 36)*pol_z(2, 0, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(1, 37)*pol_z(1, 0, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(2, 37)*pol_z(2, 0, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(1, 38)*pol_z(1, 0, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(2, 38)*pol_z(2, 0, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(1, 39)*pol_z(1, 0, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(2, 39)*pol_z(2, 0, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(1, 40)*pol_z(1, 0, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(2, 40)*pol_z(2, 0, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(1, 41)*pol_z(1, 0, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(2, 41)*pol_z(2, 0, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(1, 42)*pol_z(1, 0, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(2, 42)*pol_z(2, 0, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(1, 43)*pol_z(1, 0, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(2, 43)*pol_z(2, 0, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(1, 44)*pol_z(1, 0, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(2, 44)*pol_z(2, 0, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(1, 45)*pol_z(1, 0, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(2, 45)*pol_z(2, 0, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(1, 46)*pol_z(1, 0, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(2, 46)*pol_z(2, 0, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(1, 47)*pol_z(1, 0, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(2, 47)*pol_z(2, 0, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(1, 48)*pol_z(1, 0, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(2, 48)*pol_z(2, 0, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(1, 49)*pol_z(1, 0, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(2, 49)*pol_z(2, 0, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(1, 50)*pol_z(1, 0, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(2, 50)*pol_z(2, 0, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(1, 51)*pol_z(1, 0, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(2, 51)*pol_z(2, 0, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(1, 52)*pol_z(1, 0, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(2, 52)*pol_z(2, 0, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(1, 53)*pol_z(1, 0, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(2, 53)*pol_z(2, 0, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(1, 54)*pol_z(1, 0, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(2, 54)*pol_z(2, 0, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(1, 55)*pol_z(1, 0, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(2, 55)*pol_z(2, 0, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(1, 5)*pol_z(1, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(2, 5)*pol_z(2, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(1, 7)*pol_z(1, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(2, 7)*pol_z(2, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(1, 8)*pol_z(1, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(2, 8)*pol_z(2, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(1, 9)*pol_z(1, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(2, 9)*pol_z(2, 1, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(1, 11)*pol_z(1, 1, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(2, 11)*pol_z(2, 1, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(1, 12)*pol_z(1, 1, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(2, 12)*pol_z(2, 1, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(1, 13)*pol_z(1, 1, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(2, 13)*pol_z(2, 1, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(1, 14)*pol_z(1, 1, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(2, 14)*pol_z(2, 1, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(1, 15)*pol_z(1, 1, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(2, 15)*pol_z(2, 1, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(1, 16)*pol_z(1, 1, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(2, 16)*pol_z(2, 1, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(1, 17)*pol_z(1, 1, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(2, 17)*pol_z(2, 1, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(1, 18)*pol_z(1, 1, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(2, 18)*pol_z(2, 1, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(1, 20)*pol_z(1, 1, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(2, 20)*pol_z(2, 1, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(1, 21)*pol_z(1, 1, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(2, 21)*pol_z(2, 1, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(1, 22)*pol_z(1, 1, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(2, 22)*pol_z(2, 1, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(1, 23)*pol_z(1, 1, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(2, 23)*pol_z(2, 1, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(1, 24)*pol_z(1, 1, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(2, 24)*pol_z(2, 1, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(1, 25)*pol_z(1, 1, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(2, 25)*pol_z(2, 1, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(1, 26)*pol_z(1, 1, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(2, 26)*pol_z(2, 1, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(1, 28)*pol_z(1, 1, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(2, 28)*pol_z(2, 1, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(1, 29)*pol_z(1, 1, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(2, 29)*pol_z(2, 1, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(1, 30)*pol_z(1, 1, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(2, 30)*pol_z(2, 1, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(1, 31)*pol_z(1, 1, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(2, 31)*pol_z(2, 1, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(1, 32)*pol_z(1, 1, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(2, 32)*pol_z(2, 1, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(1, 33)*pol_z(1, 1, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(2, 33)*pol_z(2, 1, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(1, 35)*pol_z(1, 1, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(2, 35)*pol_z(2, 1, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(1, 36)*pol_z(1, 1, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(2, 36)*pol_z(2, 1, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(1, 37)*pol_z(1, 1, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(2, 37)*pol_z(2, 1, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(1, 38)*pol_z(1, 1, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(2, 38)*pol_z(2, 1, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(1, 39)*pol_z(1, 1, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(2, 39)*pol_z(2, 1, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(1, 41)*pol_z(1, 1, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(2, 41)*pol_z(2, 1, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(1, 42)*pol_z(1, 1, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(2, 42)*pol_z(2, 1, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(1, 43)*pol_z(1, 1, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(2, 43)*pol_z(2, 1, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(1, 44)*pol_z(1, 1, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(2, 44)*pol_z(2, 1, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(1, 46)*pol_z(1, 1, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(2, 46)*pol_z(2, 1, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(1, 47)*pol_z(1, 1, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(2, 47)*pol_z(2, 1, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(1, 48)*pol_z(1, 1, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(2, 48)*pol_z(2, 1, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(1, 50)*pol_z(1, 1, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(2, 50)*pol_z(2, 1, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(1, 51)*pol_z(1, 1, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(2, 51)*pol_z(2, 1, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(1, 53)*pol_z(1, 1, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(2, 53)*pol_z(2, 1, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(1, 3)*pol_z(1, 2, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(2, 3)*pol_z(2, 2, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(1, 4)*pol_z(1, 2, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(2, 4)*pol_z(2, 2, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(1, 5)*pol_z(1, 2, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(2, 5)*pol_z(2, 2, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(1, 6)*pol_z(1, 2, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(2, 6)*pol_z(2, 2, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(1, 7)*pol_z(1, 2, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(2, 7)*pol_z(2, 2, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(1, 8)*pol_z(1, 2, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(2, 8)*pol_z(2, 2, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(1, 11)*pol_z(1, 2, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(2, 11)*pol_z(2, 2, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(1, 12)*pol_z(1, 2, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(2, 12)*pol_z(2, 2, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(1, 13)*pol_z(1, 2, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(2, 13)*pol_z(2, 2, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(1, 14)*pol_z(1, 2, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(2, 14)*pol_z(2, 2, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(1, 15)*pol_z(1, 2, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(2, 15)*pol_z(2, 2, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(1, 16)*pol_z(1, 2, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(2, 16)*pol_z(2, 2, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(1, 17)*pol_z(1, 2, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(2, 17)*pol_z(2, 2, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(1, 20)*pol_z(1, 2, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(2, 20)*pol_z(2, 2, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(1, 21)*pol_z(1, 2, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(2, 21)*pol_z(2, 2, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(1, 22)*pol_z(1, 2, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(2, 22)*pol_z(2, 2, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(1, 23)*pol_z(1, 2, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(2, 23)*pol_z(2, 2, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(1, 24)*pol_z(1, 2, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(2, 24)*pol_z(2, 2, kg) - coef_xyz(121) = coef_xyz(121)+coef_xy(1, 25)*pol_z(1, 2, kg) - coef_xyz(121) = coef_xyz(121)+coef_xy(2, 25)*pol_z(2, 2, kg) - coef_xyz(122) = coef_xyz(122)+coef_xy(1, 28)*pol_z(1, 2, kg) - coef_xyz(122) = coef_xyz(122)+coef_xy(2, 28)*pol_z(2, 2, kg) - coef_xyz(123) = coef_xyz(123)+coef_xy(1, 29)*pol_z(1, 2, kg) - coef_xyz(123) = coef_xyz(123)+coef_xy(2, 29)*pol_z(2, 2, kg) - coef_xyz(124) = coef_xyz(124)+coef_xy(1, 30)*pol_z(1, 2, kg) - coef_xyz(124) = coef_xyz(124)+coef_xy(2, 30)*pol_z(2, 2, kg) - coef_xyz(125) = coef_xyz(125)+coef_xy(1, 31)*pol_z(1, 2, kg) - coef_xyz(125) = coef_xyz(125)+coef_xy(2, 31)*pol_z(2, 2, kg) - coef_xyz(126) = coef_xyz(126)+coef_xy(1, 32)*pol_z(1, 2, kg) - coef_xyz(126) = coef_xyz(126)+coef_xy(2, 32)*pol_z(2, 2, kg) - coef_xyz(127) = coef_xyz(127)+coef_xy(1, 35)*pol_z(1, 2, kg) - coef_xyz(127) = coef_xyz(127)+coef_xy(2, 35)*pol_z(2, 2, kg) - coef_xyz(128) = coef_xyz(128)+coef_xy(1, 36)*pol_z(1, 2, kg) - coef_xyz(128) = coef_xyz(128)+coef_xy(2, 36)*pol_z(2, 2, kg) - coef_xyz(129) = coef_xyz(129)+coef_xy(1, 37)*pol_z(1, 2, kg) - coef_xyz(129) = coef_xyz(129)+coef_xy(2, 37)*pol_z(2, 2, kg) - coef_xyz(130) = coef_xyz(130)+coef_xy(1, 38)*pol_z(1, 2, kg) - coef_xyz(130) = coef_xyz(130)+coef_xy(2, 38)*pol_z(2, 2, kg) - coef_xyz(131) = coef_xyz(131)+coef_xy(1, 41)*pol_z(1, 2, kg) - coef_xyz(131) = coef_xyz(131)+coef_xy(2, 41)*pol_z(2, 2, kg) - coef_xyz(132) = coef_xyz(132)+coef_xy(1, 42)*pol_z(1, 2, kg) - coef_xyz(132) = coef_xyz(132)+coef_xy(2, 42)*pol_z(2, 2, kg) - coef_xyz(133) = coef_xyz(133)+coef_xy(1, 43)*pol_z(1, 2, kg) - coef_xyz(133) = coef_xyz(133)+coef_xy(2, 43)*pol_z(2, 2, kg) - coef_xyz(134) = coef_xyz(134)+coef_xy(1, 46)*pol_z(1, 2, kg) - coef_xyz(134) = coef_xyz(134)+coef_xy(2, 46)*pol_z(2, 2, kg) - coef_xyz(135) = coef_xyz(135)+coef_xy(1, 47)*pol_z(1, 2, kg) - coef_xyz(135) = coef_xyz(135)+coef_xy(2, 47)*pol_z(2, 2, kg) - coef_xyz(136) = coef_xyz(136)+coef_xy(1, 50)*pol_z(1, 2, kg) - coef_xyz(136) = coef_xyz(136)+coef_xy(2, 50)*pol_z(2, 2, kg) - coef_xyz(137) = coef_xyz(137)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(137) = coef_xyz(137)+coef_xy(2, 1)*pol_z(2, 3, kg) - coef_xyz(138) = coef_xyz(138)+coef_xy(1, 2)*pol_z(1, 3, kg) - coef_xyz(138) = coef_xyz(138)+coef_xy(2, 2)*pol_z(2, 3, kg) - coef_xyz(139) = coef_xyz(139)+coef_xy(1, 3)*pol_z(1, 3, kg) - coef_xyz(139) = coef_xyz(139)+coef_xy(2, 3)*pol_z(2, 3, kg) - coef_xyz(140) = coef_xyz(140)+coef_xy(1, 4)*pol_z(1, 3, kg) - coef_xyz(140) = coef_xyz(140)+coef_xy(2, 4)*pol_z(2, 3, kg) - coef_xyz(141) = coef_xyz(141)+coef_xy(1, 5)*pol_z(1, 3, kg) - coef_xyz(141) = coef_xyz(141)+coef_xy(2, 5)*pol_z(2, 3, kg) - coef_xyz(142) = coef_xyz(142)+coef_xy(1, 6)*pol_z(1, 3, kg) - coef_xyz(142) = coef_xyz(142)+coef_xy(2, 6)*pol_z(2, 3, kg) - coef_xyz(143) = coef_xyz(143)+coef_xy(1, 7)*pol_z(1, 3, kg) - coef_xyz(143) = coef_xyz(143)+coef_xy(2, 7)*pol_z(2, 3, kg) - coef_xyz(144) = coef_xyz(144)+coef_xy(1, 11)*pol_z(1, 3, kg) - coef_xyz(144) = coef_xyz(144)+coef_xy(2, 11)*pol_z(2, 3, kg) - coef_xyz(145) = coef_xyz(145)+coef_xy(1, 12)*pol_z(1, 3, kg) - coef_xyz(145) = coef_xyz(145)+coef_xy(2, 12)*pol_z(2, 3, kg) - coef_xyz(146) = coef_xyz(146)+coef_xy(1, 13)*pol_z(1, 3, kg) - coef_xyz(146) = coef_xyz(146)+coef_xy(2, 13)*pol_z(2, 3, kg) - coef_xyz(147) = coef_xyz(147)+coef_xy(1, 14)*pol_z(1, 3, kg) - coef_xyz(147) = coef_xyz(147)+coef_xy(2, 14)*pol_z(2, 3, kg) - coef_xyz(148) = coef_xyz(148)+coef_xy(1, 15)*pol_z(1, 3, kg) - coef_xyz(148) = coef_xyz(148)+coef_xy(2, 15)*pol_z(2, 3, kg) - coef_xyz(149) = coef_xyz(149)+coef_xy(1, 16)*pol_z(1, 3, kg) - coef_xyz(149) = coef_xyz(149)+coef_xy(2, 16)*pol_z(2, 3, kg) - coef_xyz(150) = coef_xyz(150)+coef_xy(1, 20)*pol_z(1, 3, kg) - coef_xyz(150) = coef_xyz(150)+coef_xy(2, 20)*pol_z(2, 3, kg) - coef_xyz(151) = coef_xyz(151)+coef_xy(1, 21)*pol_z(1, 3, kg) - coef_xyz(151) = coef_xyz(151)+coef_xy(2, 21)*pol_z(2, 3, kg) - coef_xyz(152) = coef_xyz(152)+coef_xy(1, 22)*pol_z(1, 3, kg) - coef_xyz(152) = coef_xyz(152)+coef_xy(2, 22)*pol_z(2, 3, kg) - coef_xyz(153) = coef_xyz(153)+coef_xy(1, 23)*pol_z(1, 3, kg) - coef_xyz(153) = coef_xyz(153)+coef_xy(2, 23)*pol_z(2, 3, kg) - coef_xyz(154) = coef_xyz(154)+coef_xy(1, 24)*pol_z(1, 3, kg) - coef_xyz(154) = coef_xyz(154)+coef_xy(2, 24)*pol_z(2, 3, kg) - coef_xyz(155) = coef_xyz(155)+coef_xy(1, 28)*pol_z(1, 3, kg) - coef_xyz(155) = coef_xyz(155)+coef_xy(2, 28)*pol_z(2, 3, kg) - coef_xyz(156) = coef_xyz(156)+coef_xy(1, 29)*pol_z(1, 3, kg) - coef_xyz(156) = coef_xyz(156)+coef_xy(2, 29)*pol_z(2, 3, kg) - coef_xyz(157) = coef_xyz(157)+coef_xy(1, 30)*pol_z(1, 3, kg) - coef_xyz(157) = coef_xyz(157)+coef_xy(2, 30)*pol_z(2, 3, kg) - coef_xyz(158) = coef_xyz(158)+coef_xy(1, 31)*pol_z(1, 3, kg) - coef_xyz(158) = coef_xyz(158)+coef_xy(2, 31)*pol_z(2, 3, kg) - coef_xyz(159) = coef_xyz(159)+coef_xy(1, 35)*pol_z(1, 3, kg) - coef_xyz(159) = coef_xyz(159)+coef_xy(2, 35)*pol_z(2, 3, kg) - coef_xyz(160) = coef_xyz(160)+coef_xy(1, 36)*pol_z(1, 3, kg) - coef_xyz(160) = coef_xyz(160)+coef_xy(2, 36)*pol_z(2, 3, kg) - coef_xyz(161) = coef_xyz(161)+coef_xy(1, 37)*pol_z(1, 3, kg) - coef_xyz(161) = coef_xyz(161)+coef_xy(2, 37)*pol_z(2, 3, kg) - coef_xyz(162) = coef_xyz(162)+coef_xy(1, 41)*pol_z(1, 3, kg) - coef_xyz(162) = coef_xyz(162)+coef_xy(2, 41)*pol_z(2, 3, kg) - coef_xyz(163) = coef_xyz(163)+coef_xy(1, 42)*pol_z(1, 3, kg) - coef_xyz(163) = coef_xyz(163)+coef_xy(2, 42)*pol_z(2, 3, kg) - coef_xyz(164) = coef_xyz(164)+coef_xy(1, 46)*pol_z(1, 3, kg) - coef_xyz(164) = coef_xyz(164)+coef_xy(2, 46)*pol_z(2, 3, kg) - coef_xyz(165) = coef_xyz(165)+coef_xy(1, 1)*pol_z(1, 4, kg) - coef_xyz(165) = coef_xyz(165)+coef_xy(2, 1)*pol_z(2, 4, kg) - coef_xyz(166) = coef_xyz(166)+coef_xy(1, 2)*pol_z(1, 4, kg) - coef_xyz(166) = coef_xyz(166)+coef_xy(2, 2)*pol_z(2, 4, kg) - coef_xyz(167) = coef_xyz(167)+coef_xy(1, 3)*pol_z(1, 4, kg) - coef_xyz(167) = coef_xyz(167)+coef_xy(2, 3)*pol_z(2, 4, kg) - coef_xyz(168) = coef_xyz(168)+coef_xy(1, 4)*pol_z(1, 4, kg) - coef_xyz(168) = coef_xyz(168)+coef_xy(2, 4)*pol_z(2, 4, kg) - coef_xyz(169) = coef_xyz(169)+coef_xy(1, 5)*pol_z(1, 4, kg) - coef_xyz(169) = coef_xyz(169)+coef_xy(2, 5)*pol_z(2, 4, kg) - coef_xyz(170) = coef_xyz(170)+coef_xy(1, 6)*pol_z(1, 4, kg) - coef_xyz(170) = coef_xyz(170)+coef_xy(2, 6)*pol_z(2, 4, kg) - coef_xyz(171) = coef_xyz(171)+coef_xy(1, 11)*pol_z(1, 4, kg) - coef_xyz(171) = coef_xyz(171)+coef_xy(2, 11)*pol_z(2, 4, kg) - coef_xyz(172) = coef_xyz(172)+coef_xy(1, 12)*pol_z(1, 4, kg) - coef_xyz(172) = coef_xyz(172)+coef_xy(2, 12)*pol_z(2, 4, kg) - coef_xyz(173) = coef_xyz(173)+coef_xy(1, 13)*pol_z(1, 4, kg) - coef_xyz(173) = coef_xyz(173)+coef_xy(2, 13)*pol_z(2, 4, kg) - coef_xyz(174) = coef_xyz(174)+coef_xy(1, 14)*pol_z(1, 4, kg) - coef_xyz(174) = coef_xyz(174)+coef_xy(2, 14)*pol_z(2, 4, kg) - coef_xyz(175) = coef_xyz(175)+coef_xy(1, 15)*pol_z(1, 4, kg) - coef_xyz(175) = coef_xyz(175)+coef_xy(2, 15)*pol_z(2, 4, kg) - coef_xyz(176) = coef_xyz(176)+coef_xy(1, 20)*pol_z(1, 4, kg) - coef_xyz(176) = coef_xyz(176)+coef_xy(2, 20)*pol_z(2, 4, kg) - coef_xyz(177) = coef_xyz(177)+coef_xy(1, 21)*pol_z(1, 4, kg) - coef_xyz(177) = coef_xyz(177)+coef_xy(2, 21)*pol_z(2, 4, kg) - coef_xyz(178) = coef_xyz(178)+coef_xy(1, 22)*pol_z(1, 4, kg) - coef_xyz(178) = coef_xyz(178)+coef_xy(2, 22)*pol_z(2, 4, kg) - coef_xyz(179) = coef_xyz(179)+coef_xy(1, 23)*pol_z(1, 4, kg) - coef_xyz(179) = coef_xyz(179)+coef_xy(2, 23)*pol_z(2, 4, kg) - coef_xyz(180) = coef_xyz(180)+coef_xy(1, 28)*pol_z(1, 4, kg) - coef_xyz(180) = coef_xyz(180)+coef_xy(2, 28)*pol_z(2, 4, kg) - coef_xyz(181) = coef_xyz(181)+coef_xy(1, 29)*pol_z(1, 4, kg) - coef_xyz(181) = coef_xyz(181)+coef_xy(2, 29)*pol_z(2, 4, kg) - coef_xyz(182) = coef_xyz(182)+coef_xy(1, 30)*pol_z(1, 4, kg) - coef_xyz(182) = coef_xyz(182)+coef_xy(2, 30)*pol_z(2, 4, kg) - coef_xyz(183) = coef_xyz(183)+coef_xy(1, 35)*pol_z(1, 4, kg) - coef_xyz(183) = coef_xyz(183)+coef_xy(2, 35)*pol_z(2, 4, kg) - coef_xyz(184) = coef_xyz(184)+coef_xy(1, 36)*pol_z(1, 4, kg) - coef_xyz(184) = coef_xyz(184)+coef_xy(2, 36)*pol_z(2, 4, kg) - coef_xyz(185) = coef_xyz(185)+coef_xy(1, 41)*pol_z(1, 4, kg) - coef_xyz(185) = coef_xyz(185)+coef_xy(2, 41)*pol_z(2, 4, kg) - coef_xyz(186) = coef_xyz(186)+coef_xy(1, 1)*pol_z(1, 5, kg) - coef_xyz(186) = coef_xyz(186)+coef_xy(2, 1)*pol_z(2, 5, kg) - coef_xyz(187) = coef_xyz(187)+coef_xy(1, 2)*pol_z(1, 5, kg) - coef_xyz(187) = coef_xyz(187)+coef_xy(2, 2)*pol_z(2, 5, kg) - coef_xyz(188) = coef_xyz(188)+coef_xy(1, 3)*pol_z(1, 5, kg) - coef_xyz(188) = coef_xyz(188)+coef_xy(2, 3)*pol_z(2, 5, kg) - coef_xyz(189) = coef_xyz(189)+coef_xy(1, 4)*pol_z(1, 5, kg) - coef_xyz(189) = coef_xyz(189)+coef_xy(2, 4)*pol_z(2, 5, kg) - coef_xyz(190) = coef_xyz(190)+coef_xy(1, 5)*pol_z(1, 5, kg) - coef_xyz(190) = coef_xyz(190)+coef_xy(2, 5)*pol_z(2, 5, kg) - coef_xyz(191) = coef_xyz(191)+coef_xy(1, 11)*pol_z(1, 5, kg) - coef_xyz(191) = coef_xyz(191)+coef_xy(2, 11)*pol_z(2, 5, kg) - coef_xyz(192) = coef_xyz(192)+coef_xy(1, 12)*pol_z(1, 5, kg) - coef_xyz(192) = coef_xyz(192)+coef_xy(2, 12)*pol_z(2, 5, kg) - coef_xyz(193) = coef_xyz(193)+coef_xy(1, 13)*pol_z(1, 5, kg) - coef_xyz(193) = coef_xyz(193)+coef_xy(2, 13)*pol_z(2, 5, kg) - coef_xyz(194) = coef_xyz(194)+coef_xy(1, 14)*pol_z(1, 5, kg) - coef_xyz(194) = coef_xyz(194)+coef_xy(2, 14)*pol_z(2, 5, kg) - coef_xyz(195) = coef_xyz(195)+coef_xy(1, 20)*pol_z(1, 5, kg) - coef_xyz(195) = coef_xyz(195)+coef_xy(2, 20)*pol_z(2, 5, kg) - coef_xyz(196) = coef_xyz(196)+coef_xy(1, 21)*pol_z(1, 5, kg) - coef_xyz(196) = coef_xyz(196)+coef_xy(2, 21)*pol_z(2, 5, kg) - coef_xyz(197) = coef_xyz(197)+coef_xy(1, 22)*pol_z(1, 5, kg) - coef_xyz(197) = coef_xyz(197)+coef_xy(2, 22)*pol_z(2, 5, kg) - coef_xyz(198) = coef_xyz(198)+coef_xy(1, 28)*pol_z(1, 5, kg) - coef_xyz(198) = coef_xyz(198)+coef_xy(2, 28)*pol_z(2, 5, kg) - coef_xyz(199) = coef_xyz(199)+coef_xy(1, 29)*pol_z(1, 5, kg) - coef_xyz(199) = coef_xyz(199)+coef_xy(2, 29)*pol_z(2, 5, kg) - coef_xyz(200) = coef_xyz(200)+coef_xy(1, 35)*pol_z(1, 5, kg) - coef_xyz(200) = coef_xyz(200)+coef_xy(2, 35)*pol_z(2, 5, kg) - coef_xyz(201) = coef_xyz(201)+coef_xy(1, 1)*pol_z(1, 6, kg) - coef_xyz(201) = coef_xyz(201)+coef_xy(2, 1)*pol_z(2, 6, kg) - coef_xyz(202) = coef_xyz(202)+coef_xy(1, 2)*pol_z(1, 6, kg) - coef_xyz(202) = coef_xyz(202)+coef_xy(2, 2)*pol_z(2, 6, kg) - coef_xyz(203) = coef_xyz(203)+coef_xy(1, 3)*pol_z(1, 6, kg) - coef_xyz(203) = coef_xyz(203)+coef_xy(2, 3)*pol_z(2, 6, kg) - coef_xyz(204) = coef_xyz(204)+coef_xy(1, 4)*pol_z(1, 6, kg) - coef_xyz(204) = coef_xyz(204)+coef_xy(2, 4)*pol_z(2, 6, kg) - coef_xyz(205) = coef_xyz(205)+coef_xy(1, 11)*pol_z(1, 6, kg) - coef_xyz(205) = coef_xyz(205)+coef_xy(2, 11)*pol_z(2, 6, kg) - coef_xyz(206) = coef_xyz(206)+coef_xy(1, 12)*pol_z(1, 6, kg) - coef_xyz(206) = coef_xyz(206)+coef_xy(2, 12)*pol_z(2, 6, kg) - coef_xyz(207) = coef_xyz(207)+coef_xy(1, 13)*pol_z(1, 6, kg) - coef_xyz(207) = coef_xyz(207)+coef_xy(2, 13)*pol_z(2, 6, kg) - coef_xyz(208) = coef_xyz(208)+coef_xy(1, 20)*pol_z(1, 6, kg) - coef_xyz(208) = coef_xyz(208)+coef_xy(2, 20)*pol_z(2, 6, kg) - coef_xyz(209) = coef_xyz(209)+coef_xy(1, 21)*pol_z(1, 6, kg) - coef_xyz(209) = coef_xyz(209)+coef_xy(2, 21)*pol_z(2, 6, kg) - coef_xyz(210) = coef_xyz(210)+coef_xy(1, 28)*pol_z(1, 6, kg) - coef_xyz(210) = coef_xyz(210)+coef_xy(2, 28)*pol_z(2, 6, kg) - coef_xyz(211) = coef_xyz(211)+coef_xy(1, 1)*pol_z(1, 7, kg) - coef_xyz(211) = coef_xyz(211)+coef_xy(2, 1)*pol_z(2, 7, kg) - coef_xyz(212) = coef_xyz(212)+coef_xy(1, 2)*pol_z(1, 7, kg) - coef_xyz(212) = coef_xyz(212)+coef_xy(2, 2)*pol_z(2, 7, kg) - coef_xyz(213) = coef_xyz(213)+coef_xy(1, 3)*pol_z(1, 7, kg) - coef_xyz(213) = coef_xyz(213)+coef_xy(2, 3)*pol_z(2, 7, kg) - coef_xyz(214) = coef_xyz(214)+coef_xy(1, 11)*pol_z(1, 7, kg) - coef_xyz(214) = coef_xyz(214)+coef_xy(2, 11)*pol_z(2, 7, kg) - coef_xyz(215) = coef_xyz(215)+coef_xy(1, 12)*pol_z(1, 7, kg) - coef_xyz(215) = coef_xyz(215)+coef_xy(2, 12)*pol_z(2, 7, kg) - coef_xyz(216) = coef_xyz(216)+coef_xy(1, 20)*pol_z(1, 7, kg) - coef_xyz(216) = coef_xyz(216)+coef_xy(2, 20)*pol_z(2, 7, kg) - coef_xyz(217) = coef_xyz(217)+coef_xy(1, 1)*pol_z(1, 8, kg) - coef_xyz(217) = coef_xyz(217)+coef_xy(2, 1)*pol_z(2, 8, kg) - coef_xyz(218) = coef_xyz(218)+coef_xy(1, 2)*pol_z(1, 8, kg) - coef_xyz(218) = coef_xyz(218)+coef_xy(2, 2)*pol_z(2, 8, kg) - coef_xyz(219) = coef_xyz(219)+coef_xy(1, 11)*pol_z(1, 8, kg) - coef_xyz(219) = coef_xyz(219)+coef_xy(2, 11)*pol_z(2, 8, kg) - coef_xyz(220) = coef_xyz(220)+coef_xy(1, 1)*pol_z(1, 9, kg) - coef_xyz(220) = coef_xyz(220)+coef_xy(2, 1)*pol_z(2, 9, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 11)*pol_z(1, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 11)*pol_z(2, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 12)*pol_z(1, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 12)*pol_z(2, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 13)*pol_z(1, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 13)*pol_z(2, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 14)*pol_z(1, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 14)*pol_z(2, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 15)*pol_z(1, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 15)*pol_z(2, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 16)*pol_z(1, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 16)*pol_z(2, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 17)*pol_z(1, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 17)*pol_z(2, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 18)*pol_z(1, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 18)*pol_z(2, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 19)*pol_z(1, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 19)*pol_z(2, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 20)*pol_z(1, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 20)*pol_z(2, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(1, 21)*pol_z(1, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(2, 21)*pol_z(2, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(1, 22)*pol_z(1, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(2, 22)*pol_z(2, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(1, 23)*pol_z(1, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(2, 23)*pol_z(2, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(1, 24)*pol_z(1, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(2, 24)*pol_z(2, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(1, 25)*pol_z(1, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(2, 25)*pol_z(2, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(1, 26)*pol_z(1, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(2, 26)*pol_z(2, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(1, 27)*pol_z(1, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(2, 27)*pol_z(2, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(1, 28)*pol_z(1, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(2, 28)*pol_z(2, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(1, 29)*pol_z(1, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(2, 29)*pol_z(2, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(1, 30)*pol_z(1, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(2, 30)*pol_z(2, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(1, 31)*pol_z(1, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(2, 31)*pol_z(2, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(1, 32)*pol_z(1, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(2, 32)*pol_z(2, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(1, 33)*pol_z(1, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(2, 33)*pol_z(2, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(1, 34)*pol_z(1, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(2, 34)*pol_z(2, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(1, 35)*pol_z(1, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(2, 35)*pol_z(2, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(1, 36)*pol_z(1, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(2, 36)*pol_z(2, 0, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(1, 37)*pol_z(1, 0, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(2, 37)*pol_z(2, 0, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(1, 38)*pol_z(1, 0, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(2, 38)*pol_z(2, 0, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(1, 39)*pol_z(1, 0, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(2, 39)*pol_z(2, 0, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(1, 40)*pol_z(1, 0, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(2, 40)*pol_z(2, 0, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(1, 41)*pol_z(1, 0, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(2, 41)*pol_z(2, 0, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(1, 42)*pol_z(1, 0, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(2, 42)*pol_z(2, 0, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(1, 43)*pol_z(1, 0, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(2, 43)*pol_z(2, 0, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(1, 44)*pol_z(1, 0, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(2, 44)*pol_z(2, 0, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(1, 45)*pol_z(1, 0, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(2, 45)*pol_z(2, 0, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(1, 46)*pol_z(1, 0, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(2, 46)*pol_z(2, 0, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(1, 47)*pol_z(1, 0, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(2, 47)*pol_z(2, 0, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(1, 48)*pol_z(1, 0, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(2, 48)*pol_z(2, 0, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(1, 49)*pol_z(1, 0, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(2, 49)*pol_z(2, 0, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(1, 50)*pol_z(1, 0, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(2, 50)*pol_z(2, 0, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(1, 51)*pol_z(1, 0, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(2, 51)*pol_z(2, 0, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(1, 52)*pol_z(1, 0, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(2, 52)*pol_z(2, 0, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(1, 53)*pol_z(1, 0, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(2, 53)*pol_z(2, 0, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(1, 54)*pol_z(1, 0, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(2, 54)*pol_z(2, 0, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(1, 55)*pol_z(1, 0, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(2, 55)*pol_z(2, 0, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(1, 5)*pol_z(1, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(2, 5)*pol_z(2, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(1, 7)*pol_z(1, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(2, 7)*pol_z(2, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(1, 8)*pol_z(1, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(2, 8)*pol_z(2, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(1, 9)*pol_z(1, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(2, 9)*pol_z(2, 1, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(1, 11)*pol_z(1, 1, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(2, 11)*pol_z(2, 1, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(1, 12)*pol_z(1, 1, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(2, 12)*pol_z(2, 1, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(1, 13)*pol_z(1, 1, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(2, 13)*pol_z(2, 1, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(1, 14)*pol_z(1, 1, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(2, 14)*pol_z(2, 1, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(1, 15)*pol_z(1, 1, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(2, 15)*pol_z(2, 1, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(1, 16)*pol_z(1, 1, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(2, 16)*pol_z(2, 1, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(1, 17)*pol_z(1, 1, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(2, 17)*pol_z(2, 1, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(1, 18)*pol_z(1, 1, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(2, 18)*pol_z(2, 1, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(1, 20)*pol_z(1, 1, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(2, 20)*pol_z(2, 1, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(1, 21)*pol_z(1, 1, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(2, 21)*pol_z(2, 1, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(1, 22)*pol_z(1, 1, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(2, 22)*pol_z(2, 1, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(1, 23)*pol_z(1, 1, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(2, 23)*pol_z(2, 1, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(1, 24)*pol_z(1, 1, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(2, 24)*pol_z(2, 1, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(1, 25)*pol_z(1, 1, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(2, 25)*pol_z(2, 1, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(1, 26)*pol_z(1, 1, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(2, 26)*pol_z(2, 1, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(1, 28)*pol_z(1, 1, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(2, 28)*pol_z(2, 1, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(1, 29)*pol_z(1, 1, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(2, 29)*pol_z(2, 1, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(1, 30)*pol_z(1, 1, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(2, 30)*pol_z(2, 1, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(1, 31)*pol_z(1, 1, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(2, 31)*pol_z(2, 1, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(1, 32)*pol_z(1, 1, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(2, 32)*pol_z(2, 1, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(1, 33)*pol_z(1, 1, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(2, 33)*pol_z(2, 1, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(1, 35)*pol_z(1, 1, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(2, 35)*pol_z(2, 1, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(1, 36)*pol_z(1, 1, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(2, 36)*pol_z(2, 1, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(1, 37)*pol_z(1, 1, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(2, 37)*pol_z(2, 1, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(1, 38)*pol_z(1, 1, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(2, 38)*pol_z(2, 1, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(1, 39)*pol_z(1, 1, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(2, 39)*pol_z(2, 1, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(1, 41)*pol_z(1, 1, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(2, 41)*pol_z(2, 1, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(1, 42)*pol_z(1, 1, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(2, 42)*pol_z(2, 1, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(1, 43)*pol_z(1, 1, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(2, 43)*pol_z(2, 1, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(1, 44)*pol_z(1, 1, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(2, 44)*pol_z(2, 1, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(1, 46)*pol_z(1, 1, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(2, 46)*pol_z(2, 1, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(1, 47)*pol_z(1, 1, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(2, 47)*pol_z(2, 1, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(1, 48)*pol_z(1, 1, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(2, 48)*pol_z(2, 1, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(1, 50)*pol_z(1, 1, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(2, 50)*pol_z(2, 1, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(1, 51)*pol_z(1, 1, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(2, 51)*pol_z(2, 1, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(1, 53)*pol_z(1, 1, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(2, 53)*pol_z(2, 1, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(1, 3)*pol_z(1, 2, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(2, 3)*pol_z(2, 2, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(1, 4)*pol_z(1, 2, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(2, 4)*pol_z(2, 2, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(1, 5)*pol_z(1, 2, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(2, 5)*pol_z(2, 2, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(1, 6)*pol_z(1, 2, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(2, 6)*pol_z(2, 2, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(1, 7)*pol_z(1, 2, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(2, 7)*pol_z(2, 2, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(1, 8)*pol_z(1, 2, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(2, 8)*pol_z(2, 2, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(1, 11)*pol_z(1, 2, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(2, 11)*pol_z(2, 2, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(1, 12)*pol_z(1, 2, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(2, 12)*pol_z(2, 2, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(1, 13)*pol_z(1, 2, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(2, 13)*pol_z(2, 2, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(1, 14)*pol_z(1, 2, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(2, 14)*pol_z(2, 2, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(1, 15)*pol_z(1, 2, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(2, 15)*pol_z(2, 2, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(1, 16)*pol_z(1, 2, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(2, 16)*pol_z(2, 2, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(1, 17)*pol_z(1, 2, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(2, 17)*pol_z(2, 2, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(1, 20)*pol_z(1, 2, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(2, 20)*pol_z(2, 2, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(1, 21)*pol_z(1, 2, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(2, 21)*pol_z(2, 2, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(1, 22)*pol_z(1, 2, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(2, 22)*pol_z(2, 2, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(1, 23)*pol_z(1, 2, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(2, 23)*pol_z(2, 2, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(1, 24)*pol_z(1, 2, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(2, 24)*pol_z(2, 2, kg) + coef_xyz(121) = coef_xyz(121) + coef_xy(1, 25)*pol_z(1, 2, kg) + coef_xyz(121) = coef_xyz(121) + coef_xy(2, 25)*pol_z(2, 2, kg) + coef_xyz(122) = coef_xyz(122) + coef_xy(1, 28)*pol_z(1, 2, kg) + coef_xyz(122) = coef_xyz(122) + coef_xy(2, 28)*pol_z(2, 2, kg) + coef_xyz(123) = coef_xyz(123) + coef_xy(1, 29)*pol_z(1, 2, kg) + coef_xyz(123) = coef_xyz(123) + coef_xy(2, 29)*pol_z(2, 2, kg) + coef_xyz(124) = coef_xyz(124) + coef_xy(1, 30)*pol_z(1, 2, kg) + coef_xyz(124) = coef_xyz(124) + coef_xy(2, 30)*pol_z(2, 2, kg) + coef_xyz(125) = coef_xyz(125) + coef_xy(1, 31)*pol_z(1, 2, kg) + coef_xyz(125) = coef_xyz(125) + coef_xy(2, 31)*pol_z(2, 2, kg) + coef_xyz(126) = coef_xyz(126) + coef_xy(1, 32)*pol_z(1, 2, kg) + coef_xyz(126) = coef_xyz(126) + coef_xy(2, 32)*pol_z(2, 2, kg) + coef_xyz(127) = coef_xyz(127) + coef_xy(1, 35)*pol_z(1, 2, kg) + coef_xyz(127) = coef_xyz(127) + coef_xy(2, 35)*pol_z(2, 2, kg) + coef_xyz(128) = coef_xyz(128) + coef_xy(1, 36)*pol_z(1, 2, kg) + coef_xyz(128) = coef_xyz(128) + coef_xy(2, 36)*pol_z(2, 2, kg) + coef_xyz(129) = coef_xyz(129) + coef_xy(1, 37)*pol_z(1, 2, kg) + coef_xyz(129) = coef_xyz(129) + coef_xy(2, 37)*pol_z(2, 2, kg) + coef_xyz(130) = coef_xyz(130) + coef_xy(1, 38)*pol_z(1, 2, kg) + coef_xyz(130) = coef_xyz(130) + coef_xy(2, 38)*pol_z(2, 2, kg) + coef_xyz(131) = coef_xyz(131) + coef_xy(1, 41)*pol_z(1, 2, kg) + coef_xyz(131) = coef_xyz(131) + coef_xy(2, 41)*pol_z(2, 2, kg) + coef_xyz(132) = coef_xyz(132) + coef_xy(1, 42)*pol_z(1, 2, kg) + coef_xyz(132) = coef_xyz(132) + coef_xy(2, 42)*pol_z(2, 2, kg) + coef_xyz(133) = coef_xyz(133) + coef_xy(1, 43)*pol_z(1, 2, kg) + coef_xyz(133) = coef_xyz(133) + coef_xy(2, 43)*pol_z(2, 2, kg) + coef_xyz(134) = coef_xyz(134) + coef_xy(1, 46)*pol_z(1, 2, kg) + coef_xyz(134) = coef_xyz(134) + coef_xy(2, 46)*pol_z(2, 2, kg) + coef_xyz(135) = coef_xyz(135) + coef_xy(1, 47)*pol_z(1, 2, kg) + coef_xyz(135) = coef_xyz(135) + coef_xy(2, 47)*pol_z(2, 2, kg) + coef_xyz(136) = coef_xyz(136) + coef_xy(1, 50)*pol_z(1, 2, kg) + coef_xyz(136) = coef_xyz(136) + coef_xy(2, 50)*pol_z(2, 2, kg) + coef_xyz(137) = coef_xyz(137) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(137) = coef_xyz(137) + coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(138) = coef_xyz(138) + coef_xy(1, 2)*pol_z(1, 3, kg) + coef_xyz(138) = coef_xyz(138) + coef_xy(2, 2)*pol_z(2, 3, kg) + coef_xyz(139) = coef_xyz(139) + coef_xy(1, 3)*pol_z(1, 3, kg) + coef_xyz(139) = coef_xyz(139) + coef_xy(2, 3)*pol_z(2, 3, kg) + coef_xyz(140) = coef_xyz(140) + coef_xy(1, 4)*pol_z(1, 3, kg) + coef_xyz(140) = coef_xyz(140) + coef_xy(2, 4)*pol_z(2, 3, kg) + coef_xyz(141) = coef_xyz(141) + coef_xy(1, 5)*pol_z(1, 3, kg) + coef_xyz(141) = coef_xyz(141) + coef_xy(2, 5)*pol_z(2, 3, kg) + coef_xyz(142) = coef_xyz(142) + coef_xy(1, 6)*pol_z(1, 3, kg) + coef_xyz(142) = coef_xyz(142) + coef_xy(2, 6)*pol_z(2, 3, kg) + coef_xyz(143) = coef_xyz(143) + coef_xy(1, 7)*pol_z(1, 3, kg) + coef_xyz(143) = coef_xyz(143) + coef_xy(2, 7)*pol_z(2, 3, kg) + coef_xyz(144) = coef_xyz(144) + coef_xy(1, 11)*pol_z(1, 3, kg) + coef_xyz(144) = coef_xyz(144) + coef_xy(2, 11)*pol_z(2, 3, kg) + coef_xyz(145) = coef_xyz(145) + coef_xy(1, 12)*pol_z(1, 3, kg) + coef_xyz(145) = coef_xyz(145) + coef_xy(2, 12)*pol_z(2, 3, kg) + coef_xyz(146) = coef_xyz(146) + coef_xy(1, 13)*pol_z(1, 3, kg) + coef_xyz(146) = coef_xyz(146) + coef_xy(2, 13)*pol_z(2, 3, kg) + coef_xyz(147) = coef_xyz(147) + coef_xy(1, 14)*pol_z(1, 3, kg) + coef_xyz(147) = coef_xyz(147) + coef_xy(2, 14)*pol_z(2, 3, kg) + coef_xyz(148) = coef_xyz(148) + coef_xy(1, 15)*pol_z(1, 3, kg) + coef_xyz(148) = coef_xyz(148) + coef_xy(2, 15)*pol_z(2, 3, kg) + coef_xyz(149) = coef_xyz(149) + coef_xy(1, 16)*pol_z(1, 3, kg) + coef_xyz(149) = coef_xyz(149) + coef_xy(2, 16)*pol_z(2, 3, kg) + coef_xyz(150) = coef_xyz(150) + coef_xy(1, 20)*pol_z(1, 3, kg) + coef_xyz(150) = coef_xyz(150) + coef_xy(2, 20)*pol_z(2, 3, kg) + coef_xyz(151) = coef_xyz(151) + coef_xy(1, 21)*pol_z(1, 3, kg) + coef_xyz(151) = coef_xyz(151) + coef_xy(2, 21)*pol_z(2, 3, kg) + coef_xyz(152) = coef_xyz(152) + coef_xy(1, 22)*pol_z(1, 3, kg) + coef_xyz(152) = coef_xyz(152) + coef_xy(2, 22)*pol_z(2, 3, kg) + coef_xyz(153) = coef_xyz(153) + coef_xy(1, 23)*pol_z(1, 3, kg) + coef_xyz(153) = coef_xyz(153) + coef_xy(2, 23)*pol_z(2, 3, kg) + coef_xyz(154) = coef_xyz(154) + coef_xy(1, 24)*pol_z(1, 3, kg) + coef_xyz(154) = coef_xyz(154) + coef_xy(2, 24)*pol_z(2, 3, kg) + coef_xyz(155) = coef_xyz(155) + coef_xy(1, 28)*pol_z(1, 3, kg) + coef_xyz(155) = coef_xyz(155) + coef_xy(2, 28)*pol_z(2, 3, kg) + coef_xyz(156) = coef_xyz(156) + coef_xy(1, 29)*pol_z(1, 3, kg) + coef_xyz(156) = coef_xyz(156) + coef_xy(2, 29)*pol_z(2, 3, kg) + coef_xyz(157) = coef_xyz(157) + coef_xy(1, 30)*pol_z(1, 3, kg) + coef_xyz(157) = coef_xyz(157) + coef_xy(2, 30)*pol_z(2, 3, kg) + coef_xyz(158) = coef_xyz(158) + coef_xy(1, 31)*pol_z(1, 3, kg) + coef_xyz(158) = coef_xyz(158) + coef_xy(2, 31)*pol_z(2, 3, kg) + coef_xyz(159) = coef_xyz(159) + coef_xy(1, 35)*pol_z(1, 3, kg) + coef_xyz(159) = coef_xyz(159) + coef_xy(2, 35)*pol_z(2, 3, kg) + coef_xyz(160) = coef_xyz(160) + coef_xy(1, 36)*pol_z(1, 3, kg) + coef_xyz(160) = coef_xyz(160) + coef_xy(2, 36)*pol_z(2, 3, kg) + coef_xyz(161) = coef_xyz(161) + coef_xy(1, 37)*pol_z(1, 3, kg) + coef_xyz(161) = coef_xyz(161) + coef_xy(2, 37)*pol_z(2, 3, kg) + coef_xyz(162) = coef_xyz(162) + coef_xy(1, 41)*pol_z(1, 3, kg) + coef_xyz(162) = coef_xyz(162) + coef_xy(2, 41)*pol_z(2, 3, kg) + coef_xyz(163) = coef_xyz(163) + coef_xy(1, 42)*pol_z(1, 3, kg) + coef_xyz(163) = coef_xyz(163) + coef_xy(2, 42)*pol_z(2, 3, kg) + coef_xyz(164) = coef_xyz(164) + coef_xy(1, 46)*pol_z(1, 3, kg) + coef_xyz(164) = coef_xyz(164) + coef_xy(2, 46)*pol_z(2, 3, kg) + coef_xyz(165) = coef_xyz(165) + coef_xy(1, 1)*pol_z(1, 4, kg) + coef_xyz(165) = coef_xyz(165) + coef_xy(2, 1)*pol_z(2, 4, kg) + coef_xyz(166) = coef_xyz(166) + coef_xy(1, 2)*pol_z(1, 4, kg) + coef_xyz(166) = coef_xyz(166) + coef_xy(2, 2)*pol_z(2, 4, kg) + coef_xyz(167) = coef_xyz(167) + coef_xy(1, 3)*pol_z(1, 4, kg) + coef_xyz(167) = coef_xyz(167) + coef_xy(2, 3)*pol_z(2, 4, kg) + coef_xyz(168) = coef_xyz(168) + coef_xy(1, 4)*pol_z(1, 4, kg) + coef_xyz(168) = coef_xyz(168) + coef_xy(2, 4)*pol_z(2, 4, kg) + coef_xyz(169) = coef_xyz(169) + coef_xy(1, 5)*pol_z(1, 4, kg) + coef_xyz(169) = coef_xyz(169) + coef_xy(2, 5)*pol_z(2, 4, kg) + coef_xyz(170) = coef_xyz(170) + coef_xy(1, 6)*pol_z(1, 4, kg) + coef_xyz(170) = coef_xyz(170) + coef_xy(2, 6)*pol_z(2, 4, kg) + coef_xyz(171) = coef_xyz(171) + coef_xy(1, 11)*pol_z(1, 4, kg) + coef_xyz(171) = coef_xyz(171) + coef_xy(2, 11)*pol_z(2, 4, kg) + coef_xyz(172) = coef_xyz(172) + coef_xy(1, 12)*pol_z(1, 4, kg) + coef_xyz(172) = coef_xyz(172) + coef_xy(2, 12)*pol_z(2, 4, kg) + coef_xyz(173) = coef_xyz(173) + coef_xy(1, 13)*pol_z(1, 4, kg) + coef_xyz(173) = coef_xyz(173) + coef_xy(2, 13)*pol_z(2, 4, kg) + coef_xyz(174) = coef_xyz(174) + coef_xy(1, 14)*pol_z(1, 4, kg) + coef_xyz(174) = coef_xyz(174) + coef_xy(2, 14)*pol_z(2, 4, kg) + coef_xyz(175) = coef_xyz(175) + coef_xy(1, 15)*pol_z(1, 4, kg) + coef_xyz(175) = coef_xyz(175) + coef_xy(2, 15)*pol_z(2, 4, kg) + coef_xyz(176) = coef_xyz(176) + coef_xy(1, 20)*pol_z(1, 4, kg) + coef_xyz(176) = coef_xyz(176) + coef_xy(2, 20)*pol_z(2, 4, kg) + coef_xyz(177) = coef_xyz(177) + coef_xy(1, 21)*pol_z(1, 4, kg) + coef_xyz(177) = coef_xyz(177) + coef_xy(2, 21)*pol_z(2, 4, kg) + coef_xyz(178) = coef_xyz(178) + coef_xy(1, 22)*pol_z(1, 4, kg) + coef_xyz(178) = coef_xyz(178) + coef_xy(2, 22)*pol_z(2, 4, kg) + coef_xyz(179) = coef_xyz(179) + coef_xy(1, 23)*pol_z(1, 4, kg) + coef_xyz(179) = coef_xyz(179) + coef_xy(2, 23)*pol_z(2, 4, kg) + coef_xyz(180) = coef_xyz(180) + coef_xy(1, 28)*pol_z(1, 4, kg) + coef_xyz(180) = coef_xyz(180) + coef_xy(2, 28)*pol_z(2, 4, kg) + coef_xyz(181) = coef_xyz(181) + coef_xy(1, 29)*pol_z(1, 4, kg) + coef_xyz(181) = coef_xyz(181) + coef_xy(2, 29)*pol_z(2, 4, kg) + coef_xyz(182) = coef_xyz(182) + coef_xy(1, 30)*pol_z(1, 4, kg) + coef_xyz(182) = coef_xyz(182) + coef_xy(2, 30)*pol_z(2, 4, kg) + coef_xyz(183) = coef_xyz(183) + coef_xy(1, 35)*pol_z(1, 4, kg) + coef_xyz(183) = coef_xyz(183) + coef_xy(2, 35)*pol_z(2, 4, kg) + coef_xyz(184) = coef_xyz(184) + coef_xy(1, 36)*pol_z(1, 4, kg) + coef_xyz(184) = coef_xyz(184) + coef_xy(2, 36)*pol_z(2, 4, kg) + coef_xyz(185) = coef_xyz(185) + coef_xy(1, 41)*pol_z(1, 4, kg) + coef_xyz(185) = coef_xyz(185) + coef_xy(2, 41)*pol_z(2, 4, kg) + coef_xyz(186) = coef_xyz(186) + coef_xy(1, 1)*pol_z(1, 5, kg) + coef_xyz(186) = coef_xyz(186) + coef_xy(2, 1)*pol_z(2, 5, kg) + coef_xyz(187) = coef_xyz(187) + coef_xy(1, 2)*pol_z(1, 5, kg) + coef_xyz(187) = coef_xyz(187) + coef_xy(2, 2)*pol_z(2, 5, kg) + coef_xyz(188) = coef_xyz(188) + coef_xy(1, 3)*pol_z(1, 5, kg) + coef_xyz(188) = coef_xyz(188) + coef_xy(2, 3)*pol_z(2, 5, kg) + coef_xyz(189) = coef_xyz(189) + coef_xy(1, 4)*pol_z(1, 5, kg) + coef_xyz(189) = coef_xyz(189) + coef_xy(2, 4)*pol_z(2, 5, kg) + coef_xyz(190) = coef_xyz(190) + coef_xy(1, 5)*pol_z(1, 5, kg) + coef_xyz(190) = coef_xyz(190) + coef_xy(2, 5)*pol_z(2, 5, kg) + coef_xyz(191) = coef_xyz(191) + coef_xy(1, 11)*pol_z(1, 5, kg) + coef_xyz(191) = coef_xyz(191) + coef_xy(2, 11)*pol_z(2, 5, kg) + coef_xyz(192) = coef_xyz(192) + coef_xy(1, 12)*pol_z(1, 5, kg) + coef_xyz(192) = coef_xyz(192) + coef_xy(2, 12)*pol_z(2, 5, kg) + coef_xyz(193) = coef_xyz(193) + coef_xy(1, 13)*pol_z(1, 5, kg) + coef_xyz(193) = coef_xyz(193) + coef_xy(2, 13)*pol_z(2, 5, kg) + coef_xyz(194) = coef_xyz(194) + coef_xy(1, 14)*pol_z(1, 5, kg) + coef_xyz(194) = coef_xyz(194) + coef_xy(2, 14)*pol_z(2, 5, kg) + coef_xyz(195) = coef_xyz(195) + coef_xy(1, 20)*pol_z(1, 5, kg) + coef_xyz(195) = coef_xyz(195) + coef_xy(2, 20)*pol_z(2, 5, kg) + coef_xyz(196) = coef_xyz(196) + coef_xy(1, 21)*pol_z(1, 5, kg) + coef_xyz(196) = coef_xyz(196) + coef_xy(2, 21)*pol_z(2, 5, kg) + coef_xyz(197) = coef_xyz(197) + coef_xy(1, 22)*pol_z(1, 5, kg) + coef_xyz(197) = coef_xyz(197) + coef_xy(2, 22)*pol_z(2, 5, kg) + coef_xyz(198) = coef_xyz(198) + coef_xy(1, 28)*pol_z(1, 5, kg) + coef_xyz(198) = coef_xyz(198) + coef_xy(2, 28)*pol_z(2, 5, kg) + coef_xyz(199) = coef_xyz(199) + coef_xy(1, 29)*pol_z(1, 5, kg) + coef_xyz(199) = coef_xyz(199) + coef_xy(2, 29)*pol_z(2, 5, kg) + coef_xyz(200) = coef_xyz(200) + coef_xy(1, 35)*pol_z(1, 5, kg) + coef_xyz(200) = coef_xyz(200) + coef_xy(2, 35)*pol_z(2, 5, kg) + coef_xyz(201) = coef_xyz(201) + coef_xy(1, 1)*pol_z(1, 6, kg) + coef_xyz(201) = coef_xyz(201) + coef_xy(2, 1)*pol_z(2, 6, kg) + coef_xyz(202) = coef_xyz(202) + coef_xy(1, 2)*pol_z(1, 6, kg) + coef_xyz(202) = coef_xyz(202) + coef_xy(2, 2)*pol_z(2, 6, kg) + coef_xyz(203) = coef_xyz(203) + coef_xy(1, 3)*pol_z(1, 6, kg) + coef_xyz(203) = coef_xyz(203) + coef_xy(2, 3)*pol_z(2, 6, kg) + coef_xyz(204) = coef_xyz(204) + coef_xy(1, 4)*pol_z(1, 6, kg) + coef_xyz(204) = coef_xyz(204) + coef_xy(2, 4)*pol_z(2, 6, kg) + coef_xyz(205) = coef_xyz(205) + coef_xy(1, 11)*pol_z(1, 6, kg) + coef_xyz(205) = coef_xyz(205) + coef_xy(2, 11)*pol_z(2, 6, kg) + coef_xyz(206) = coef_xyz(206) + coef_xy(1, 12)*pol_z(1, 6, kg) + coef_xyz(206) = coef_xyz(206) + coef_xy(2, 12)*pol_z(2, 6, kg) + coef_xyz(207) = coef_xyz(207) + coef_xy(1, 13)*pol_z(1, 6, kg) + coef_xyz(207) = coef_xyz(207) + coef_xy(2, 13)*pol_z(2, 6, kg) + coef_xyz(208) = coef_xyz(208) + coef_xy(1, 20)*pol_z(1, 6, kg) + coef_xyz(208) = coef_xyz(208) + coef_xy(2, 20)*pol_z(2, 6, kg) + coef_xyz(209) = coef_xyz(209) + coef_xy(1, 21)*pol_z(1, 6, kg) + coef_xyz(209) = coef_xyz(209) + coef_xy(2, 21)*pol_z(2, 6, kg) + coef_xyz(210) = coef_xyz(210) + coef_xy(1, 28)*pol_z(1, 6, kg) + coef_xyz(210) = coef_xyz(210) + coef_xy(2, 28)*pol_z(2, 6, kg) + coef_xyz(211) = coef_xyz(211) + coef_xy(1, 1)*pol_z(1, 7, kg) + coef_xyz(211) = coef_xyz(211) + coef_xy(2, 1)*pol_z(2, 7, kg) + coef_xyz(212) = coef_xyz(212) + coef_xy(1, 2)*pol_z(1, 7, kg) + coef_xyz(212) = coef_xyz(212) + coef_xy(2, 2)*pol_z(2, 7, kg) + coef_xyz(213) = coef_xyz(213) + coef_xy(1, 3)*pol_z(1, 7, kg) + coef_xyz(213) = coef_xyz(213) + coef_xy(2, 3)*pol_z(2, 7, kg) + coef_xyz(214) = coef_xyz(214) + coef_xy(1, 11)*pol_z(1, 7, kg) + coef_xyz(214) = coef_xyz(214) + coef_xy(2, 11)*pol_z(2, 7, kg) + coef_xyz(215) = coef_xyz(215) + coef_xy(1, 12)*pol_z(1, 7, kg) + coef_xyz(215) = coef_xyz(215) + coef_xy(2, 12)*pol_z(2, 7, kg) + coef_xyz(216) = coef_xyz(216) + coef_xy(1, 20)*pol_z(1, 7, kg) + coef_xyz(216) = coef_xyz(216) + coef_xy(2, 20)*pol_z(2, 7, kg) + coef_xyz(217) = coef_xyz(217) + coef_xy(1, 1)*pol_z(1, 8, kg) + coef_xyz(217) = coef_xyz(217) + coef_xy(2, 1)*pol_z(2, 8, kg) + coef_xyz(218) = coef_xyz(218) + coef_xy(1, 2)*pol_z(1, 8, kg) + coef_xyz(218) = coef_xyz(218) + coef_xy(2, 2)*pol_z(2, 8, kg) + coef_xyz(219) = coef_xyz(219) + coef_xy(1, 11)*pol_z(1, 8, kg) + coef_xyz(219) = coef_xyz(219) + coef_xy(2, 11)*pol_z(2, 8, kg) + coef_xyz(220) = coef_xyz(220) + coef_xy(1, 1)*pol_z(1, 9, kg) + coef_xyz(220) = coef_xyz(220) + coef_xy(2, 1)*pol_z(2, 9, kg) END DO END SUBROUTINE integrate_core_9 diff --git a/src/grid/integrate_fast_2.f90 b/src/grid/integrate_fast_2.f90 index f14e80cb16..6830cb7568 100644 --- a/src/grid/integrate_fast_2.f90 +++ b/src/grid/integrate_fast_2.f90 @@ -14,7 +14,7 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bounds, lp, cmax, gridbounds) USE kinds, ONLY: dp INTEGER, INTENT(IN) :: sphere_bounds(*), lp - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER, INTENT(IN) :: cmax REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & @@ -29,7 +29,7 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -37,23 +37,23 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp @@ -64,21 +64,21 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_x(1, lxp)*pol_y(1, lyp, jg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_x(2, lxp)*pol_y(1, lyp, jg) - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_x(3, lxp)*pol_y(2, lyp, jg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_x(4, lxp)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_x(1, lxp)*pol_y(1, lyp, jg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_x(2, lxp)*pol_y(1, lyp, jg) + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_x(3, lxp)*pol_y(2, lyp, jg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_x(4, lxp)*pol_y(2, lyp, jg) ENDDO ENDDO @@ -87,13 +87,13 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(1, lxy)*pol_z(1, lzp, kg) - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(2, lxy)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(1, lxy)*pol_z(1, lzp, kg) + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(2, lxy)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO @@ -123,13 +123,13 @@ SUBROUTINE integrate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -137,23 +137,23 @@ SUBROUTINE integrate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -162,18 +162,18 @@ SUBROUTINE integrate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = grid(i, j, k2) s03 = grid(i, j2, k) s04 = grid(i, j2, k2) - coef_x(1, 0) = coef_x(1, 0)+s01*pol_x(0, ig) - coef_x(2, 0) = coef_x(2, 0)+s02*pol_x(0, ig) - coef_x(3, 0) = coef_x(3, 0)+s03*pol_x(0, ig) - coef_x(4, 0) = coef_x(4, 0)+s04*pol_x(0, ig) + coef_x(1, 0) = coef_x(1, 0) + s01*pol_x(0, ig) + coef_x(2, 0) = coef_x(2, 0) + s02*pol_x(0, ig) + coef_x(3, 0) = coef_x(3, 0) + s03*pol_x(0, ig) + coef_x(4, 0) = coef_x(4, 0) + s04*pol_x(0, ig) END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) END DO END SUBROUTINE integrate_core_0 @@ -200,13 +200,13 @@ SUBROUTINE integrate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -214,23 +214,23 @@ SUBROUTINE integrate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -239,32 +239,32 @@ SUBROUTINE integrate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = grid(i, j, k2) s03 = grid(i, j2, k) s04 = grid(i, j2, k2) - coef_x(1, 0) = coef_x(1, 0)+s01*pol_x(0, ig) - coef_x(2, 0) = coef_x(2, 0)+s02*pol_x(0, ig) - coef_x(3, 0) = coef_x(3, 0)+s03*pol_x(0, ig) - coef_x(4, 0) = coef_x(4, 0)+s04*pol_x(0, ig) - coef_x(1, 1) = coef_x(1, 1)+s01*pol_x(1, ig) - coef_x(2, 1) = coef_x(2, 1)+s02*pol_x(1, ig) - coef_x(3, 1) = coef_x(3, 1)+s03*pol_x(1, ig) - coef_x(4, 1) = coef_x(4, 1)+s04*pol_x(1, ig) + coef_x(1, 0) = coef_x(1, 0) + s01*pol_x(0, ig) + coef_x(2, 0) = coef_x(2, 0) + s02*pol_x(0, ig) + coef_x(3, 0) = coef_x(3, 0) + s03*pol_x(0, ig) + coef_x(4, 0) = coef_x(4, 0) + s04*pol_x(0, ig) + coef_x(1, 1) = coef_x(1, 1) + s01*pol_x(1, ig) + coef_x(2, 1) = coef_x(2, 1) + s02*pol_x(1, ig) + coef_x(3, 1) = coef_x(3, 1) + s03*pol_x(1, ig) + coef_x(4, 1) = coef_x(4, 1) + s04*pol_x(1, ig) END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 0)*pol_y(2, 1, jg) END DO - coef_xyz(1) = coef_xyz(1)+SUM(coef_xy(:, 1)*pol_z(:, 0, kg)) - coef_xyz(2) = coef_xyz(2)+SUM(coef_xy(:, 2)*pol_z(:, 0, kg)) - coef_xyz(3) = coef_xyz(3)+SUM(coef_xy(:, 3)*pol_z(:, 0, kg)) - coef_xyz(4) = coef_xyz(4)+SUM(coef_xy(:, 1)*pol_z(:, 1, kg)) + coef_xyz(1) = coef_xyz(1) + SUM(coef_xy(:, 1)*pol_z(:, 0, kg)) + coef_xyz(2) = coef_xyz(2) + SUM(coef_xy(:, 2)*pol_z(:, 0, kg)) + coef_xyz(3) = coef_xyz(3) + SUM(coef_xy(:, 3)*pol_z(:, 0, kg)) + coef_xyz(4) = coef_xyz(4) + SUM(coef_xy(:, 1)*pol_z(:, 1, kg)) END DO END SUBROUTINE integrate_core_1 @@ -291,14 +291,14 @@ SUBROUTINE integrate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s(4) sci = 1 @@ -306,23 +306,23 @@ SUBROUTINE integrate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -331,32 +331,32 @@ SUBROUTINE integrate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s(2) = grid(i, j, k2) s(3) = grid(i, j2, k) s(4) = grid(i, j2, k2) - coef_x(:, 0) = coef_x(:, 0)+s(:)*pol_x(0, ig) - coef_x(:, 1) = coef_x(:, 1)+s(:)*pol_x(1, ig) - coef_x(:, 2) = coef_x(:, 2)+s(:)*pol_x(2, ig) + coef_x(:, 0) = coef_x(:, 0) + s(:)*pol_x(0, ig) + coef_x(:, 1) = coef_x(:, 1) + s(:)*pol_x(1, ig) + coef_x(:, 2) = coef_x(:, 2) + s(:)*pol_x(2, ig) END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(1:2, 1)*pol_y(1, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(3:4, 1)*pol_y(2, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(1:2, 2)*pol_y(1, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(3:4, 2)*pol_y(2, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(1:2, 0)*pol_y(1, 1, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(3:4, 0)*pol_y(2, 1, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(1:2, 1)*pol_y(1, 1, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(3:4, 1)*pol_y(2, 1, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(1:2, 0)*pol_y(1, 2, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(3:4, 0)*pol_y(2, 2, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(1:2, 1)*pol_y(1, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(3:4, 1)*pol_y(2, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(1:2, 2)*pol_y(1, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(3:4, 2)*pol_y(2, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(1:2, 0)*pol_y(1, 1, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(3:4, 0)*pol_y(2, 1, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(1:2, 1)*pol_y(1, 1, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(3:4, 1)*pol_y(2, 1, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(1:2, 0)*pol_y(1, 2, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(3:4, 0)*pol_y(2, 2, jg) END DO lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xyz(lxyz) = coef_xyz(lxyz)+SUM(coef_xy(:, lxy)*pol_z(:, lzp, kg)) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xyz(lxyz) = coef_xyz(lxyz) + SUM(coef_xy(:, lxy)*pol_z(:, lzp, kg)) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO END DO @@ -385,14 +385,14 @@ SUBROUTINE integrate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s(4) sci = 1 @@ -400,23 +400,23 @@ SUBROUTINE integrate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -426,39 +426,39 @@ SUBROUTINE integrate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s(3) = grid(i, j2, k) s(4) = grid(i, j2, k2) DO lxp = 0, lp - coef_x(:, lxp) = coef_x(:, lxp)+s(:)*pol_x(lxp, ig) + coef_x(:, lxp) = coef_x(:, lxp) + s(:)*pol_x(lxp, ig) ENDDO END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(1:2, 1)*pol_y(1, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(3:4, 1)*pol_y(2, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(1:2, 2)*pol_y(1, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(3:4, 2)*pol_y(2, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(1:2, 3)*pol_y(1, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(3:4, 3)*pol_y(2, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(1:2, 0)*pol_y(1, 1, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(3:4, 0)*pol_y(2, 1, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(1:2, 1)*pol_y(1, 1, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(3:4, 1)*pol_y(2, 1, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(1:2, 2)*pol_y(1, 1, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(3:4, 2)*pol_y(2, 1, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(1:2, 0)*pol_y(1, 2, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(3:4, 0)*pol_y(2, 2, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(1:2, 1)*pol_y(1, 2, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(3:4, 1)*pol_y(2, 2, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(1:2, 0)*pol_y(1, 3, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(3:4, 0)*pol_y(2, 3, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(1:2, 1)*pol_y(1, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(3:4, 1)*pol_y(2, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(1:2, 2)*pol_y(1, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(3:4, 2)*pol_y(2, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(1:2, 3)*pol_y(1, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(3:4, 3)*pol_y(2, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(1:2, 0)*pol_y(1, 1, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(3:4, 0)*pol_y(2, 1, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(1:2, 1)*pol_y(1, 1, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(3:4, 1)*pol_y(2, 1, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(1:2, 2)*pol_y(1, 1, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(3:4, 2)*pol_y(2, 1, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(1:2, 0)*pol_y(1, 2, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(3:4, 0)*pol_y(2, 2, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(1:2, 1)*pol_y(1, 2, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(3:4, 1)*pol_y(2, 2, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(1:2, 0)*pol_y(1, 3, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(3:4, 0)*pol_y(2, 3, jg) END DO lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xyz(lxyz) = coef_xyz(lxyz)+SUM(coef_xy(:, lxy)*pol_z(:, lzp, kg)) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xyz(lxyz) = coef_xyz(lxyz) + SUM(coef_xy(:, lxy)*pol_z(:, lzp, kg)) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO END DO @@ -487,13 +487,13 @@ SUBROUTINE integrate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s(4) sci = 1 @@ -501,23 +501,23 @@ SUBROUTINE integrate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -527,110 +527,110 @@ SUBROUTINE integrate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s(3) = grid(i, j2, k) s(4) = grid(i, j2, k2) DO lxp = 0, lp - coef_x(:, lxp) = coef_x(:, lxp)+s(:)*pol_x(lxp, ig) + coef_x(:, lxp) = coef_x(:, lxp) + s(:)*pol_x(lxp, ig) ENDDO END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(1:2, 1)*pol_y(1, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(3:4, 1)*pol_y(2, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(1:2, 2)*pol_y(1, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(3:4, 2)*pol_y(2, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(1:2, 3)*pol_y(1, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(3:4, 3)*pol_y(2, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(1:2, 4)*pol_y(1, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(3:4, 4)*pol_y(2, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(1:2, 0)*pol_y(1, 1, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(3:4, 0)*pol_y(2, 1, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(1:2, 1)*pol_y(1, 1, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(3:4, 1)*pol_y(2, 1, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(1:2, 2)*pol_y(1, 1, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(3:4, 2)*pol_y(2, 1, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(1:2, 3)*pol_y(1, 1, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(3:4, 3)*pol_y(2, 1, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(1:2, 0)*pol_y(1, 2, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(3:4, 0)*pol_y(2, 2, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(1:2, 1)*pol_y(1, 2, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(3:4, 1)*pol_y(2, 2, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(1:2, 2)*pol_y(1, 2, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(3:4, 2)*pol_y(2, 2, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(1:2, 0)*pol_y(1, 3, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(3:4, 0)*pol_y(2, 3, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(1:2, 1)*pol_y(1, 3, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(3:4, 1)*pol_y(2, 3, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(1:2, 0)*pol_y(1, 4, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(3:4, 0)*pol_y(2, 4, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(1:2, 1)*pol_y(1, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(3:4, 1)*pol_y(2, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(1:2, 2)*pol_y(1, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(3:4, 2)*pol_y(2, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(1:2, 3)*pol_y(1, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(3:4, 3)*pol_y(2, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(1:2, 4)*pol_y(1, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(3:4, 4)*pol_y(2, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(1:2, 0)*pol_y(1, 1, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(3:4, 0)*pol_y(2, 1, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(1:2, 1)*pol_y(1, 1, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(3:4, 1)*pol_y(2, 1, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(1:2, 2)*pol_y(1, 1, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(3:4, 2)*pol_y(2, 1, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(1:2, 3)*pol_y(1, 1, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(3:4, 3)*pol_y(2, 1, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(1:2, 0)*pol_y(1, 2, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(3:4, 0)*pol_y(2, 2, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(1:2, 1)*pol_y(1, 2, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(3:4, 1)*pol_y(2, 2, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(1:2, 2)*pol_y(1, 2, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(3:4, 2)*pol_y(2, 2, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(1:2, 0)*pol_y(1, 3, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(3:4, 0)*pol_y(2, 3, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(1:2, 1)*pol_y(1, 3, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(3:4, 1)*pol_y(2, 3, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(1:2, 0)*pol_y(1, 4, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(3:4, 0)*pol_y(2, 4, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 11)*pol_z(1, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 11)*pol_z(2, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 12)*pol_z(1, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 12)*pol_z(2, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 13)*pol_z(1, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 13)*pol_z(2, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 14)*pol_z(1, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 14)*pol_z(2, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 15)*pol_z(1, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 15)*pol_z(2, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(1, 7)*pol_z(1, 1, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(2, 7)*pol_z(2, 1, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(1, 8)*pol_z(1, 1, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(2, 8)*pol_z(2, 1, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(1, 10)*pol_z(1, 1, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(2, 10)*pol_z(2, 1, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(1, 11)*pol_z(1, 1, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(2, 11)*pol_z(2, 1, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(1, 13)*pol_z(1, 1, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(2, 13)*pol_z(2, 1, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(1, 3)*pol_z(1, 2, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(2, 3)*pol_z(2, 2, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(1, 6)*pol_z(1, 2, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(2, 6)*pol_z(2, 2, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(1, 7)*pol_z(1, 2, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(2, 7)*pol_z(2, 2, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(1, 10)*pol_z(1, 2, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(2, 10)*pol_z(2, 2, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(2, 1)*pol_z(2, 3, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(1, 2)*pol_z(1, 3, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(2, 2)*pol_z(2, 3, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(1, 6)*pol_z(1, 3, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(2, 6)*pol_z(2, 3, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(1, 1)*pol_z(1, 4, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(2, 1)*pol_z(2, 4, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 11)*pol_z(1, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 11)*pol_z(2, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 12)*pol_z(1, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 12)*pol_z(2, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 13)*pol_z(1, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 13)*pol_z(2, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 14)*pol_z(1, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 14)*pol_z(2, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 15)*pol_z(1, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 15)*pol_z(2, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(1, 7)*pol_z(1, 1, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(2, 7)*pol_z(2, 1, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(1, 8)*pol_z(1, 1, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(2, 8)*pol_z(2, 1, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(1, 10)*pol_z(1, 1, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(2, 10)*pol_z(2, 1, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(1, 11)*pol_z(1, 1, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(2, 11)*pol_z(2, 1, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(1, 13)*pol_z(1, 1, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(2, 13)*pol_z(2, 1, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(1, 3)*pol_z(1, 2, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(2, 3)*pol_z(2, 2, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(1, 6)*pol_z(1, 2, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(2, 6)*pol_z(2, 2, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(1, 7)*pol_z(1, 2, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(2, 7)*pol_z(2, 2, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(1, 10)*pol_z(1, 2, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(2, 10)*pol_z(2, 2, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(1, 2)*pol_z(1, 3, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(2, 2)*pol_z(2, 3, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(1, 6)*pol_z(1, 3, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(2, 6)*pol_z(2, 3, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(1, 1)*pol_z(1, 4, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(2, 1)*pol_z(2, 4, kg) END DO END SUBROUTINE integrate_core_4 @@ -657,14 +657,14 @@ SUBROUTINE integrate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s(4) sci = 1 @@ -672,23 +672,23 @@ SUBROUTINE integrate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -698,61 +698,61 @@ SUBROUTINE integrate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s(3) = grid(i, j2, k) s(4) = grid(i, j2, k2) DO lxp = 0, lp - coef_x(:, lxp) = coef_x(:, lxp)+s(:)*pol_x(lxp, ig) + coef_x(:, lxp) = coef_x(:, lxp) + s(:)*pol_x(lxp, ig) ENDDO END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(1:2, 1)*pol_y(1, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(3:4, 1)*pol_y(2, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(1:2, 2)*pol_y(1, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(3:4, 2)*pol_y(2, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(1:2, 3)*pol_y(1, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(3:4, 3)*pol_y(2, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(1:2, 4)*pol_y(1, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(3:4, 4)*pol_y(2, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(1:2, 5)*pol_y(1, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(3:4, 5)*pol_y(2, 0, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(1:2, 0)*pol_y(1, 1, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(3:4, 0)*pol_y(2, 1, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(1:2, 1)*pol_y(1, 1, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(3:4, 1)*pol_y(2, 1, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(1:2, 2)*pol_y(1, 1, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(3:4, 2)*pol_y(2, 1, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(1:2, 3)*pol_y(1, 1, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(3:4, 3)*pol_y(2, 1, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(1:2, 4)*pol_y(1, 1, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(3:4, 4)*pol_y(2, 1, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(1:2, 0)*pol_y(1, 2, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(3:4, 0)*pol_y(2, 2, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(1:2, 1)*pol_y(1, 2, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(3:4, 1)*pol_y(2, 2, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(1:2, 2)*pol_y(1, 2, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(3:4, 2)*pol_y(2, 2, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(1:2, 3)*pol_y(1, 2, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(3:4, 3)*pol_y(2, 2, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(1:2, 0)*pol_y(1, 3, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(3:4, 0)*pol_y(2, 3, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(1:2, 1)*pol_y(1, 3, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(3:4, 1)*pol_y(2, 3, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(1:2, 2)*pol_y(1, 3, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(3:4, 2)*pol_y(2, 3, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(1:2, 0)*pol_y(1, 4, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(3:4, 0)*pol_y(2, 4, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(1:2, 1)*pol_y(1, 4, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(3:4, 1)*pol_y(2, 4, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(1:2, 0)*pol_y(1, 5, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(3:4, 0)*pol_y(2, 5, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(1:2, 1)*pol_y(1, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(3:4, 1)*pol_y(2, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(1:2, 2)*pol_y(1, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(3:4, 2)*pol_y(2, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(1:2, 3)*pol_y(1, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(3:4, 3)*pol_y(2, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(1:2, 4)*pol_y(1, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(3:4, 4)*pol_y(2, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(1:2, 5)*pol_y(1, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(3:4, 5)*pol_y(2, 0, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(1:2, 0)*pol_y(1, 1, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(3:4, 0)*pol_y(2, 1, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(1:2, 1)*pol_y(1, 1, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(3:4, 1)*pol_y(2, 1, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(1:2, 2)*pol_y(1, 1, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(3:4, 2)*pol_y(2, 1, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(1:2, 3)*pol_y(1, 1, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(3:4, 3)*pol_y(2, 1, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(1:2, 4)*pol_y(1, 1, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(3:4, 4)*pol_y(2, 1, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(1:2, 0)*pol_y(1, 2, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(3:4, 0)*pol_y(2, 2, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(1:2, 1)*pol_y(1, 2, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(3:4, 1)*pol_y(2, 2, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(1:2, 2)*pol_y(1, 2, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(3:4, 2)*pol_y(2, 2, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(1:2, 3)*pol_y(1, 2, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(3:4, 3)*pol_y(2, 2, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(1:2, 0)*pol_y(1, 3, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(3:4, 0)*pol_y(2, 3, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(1:2, 1)*pol_y(1, 3, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(3:4, 1)*pol_y(2, 3, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(1:2, 2)*pol_y(1, 3, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(3:4, 2)*pol_y(2, 3, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(1:2, 0)*pol_y(1, 4, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(3:4, 0)*pol_y(2, 4, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(1:2, 1)*pol_y(1, 4, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(3:4, 1)*pol_y(2, 4, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(1:2, 0)*pol_y(1, 5, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(3:4, 0)*pol_y(2, 5, jg) END DO lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xyz(lxyz) = coef_xyz(lxyz)+SUM(coef_xy(:, lxy)*pol_z(:, lzp, kg)) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xyz(lxyz) = coef_xyz(lxyz) + SUM(coef_xy(:, lxy)*pol_z(:, lzp, kg)) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO END DO @@ -781,14 +781,14 @@ SUBROUTINE integrate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s(4) sci = 1 @@ -796,23 +796,23 @@ SUBROUTINE integrate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -822,75 +822,75 @@ SUBROUTINE integrate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s(3) = grid(i, j2, k) s(4) = grid(i, j2, k2) DO lxp = 0, lp - coef_x(:, lxp) = coef_x(:, lxp)+s(:)*pol_x(lxp, ig) + coef_x(:, lxp) = coef_x(:, lxp) + s(:)*pol_x(lxp, ig) ENDDO END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(1:2, 1)*pol_y(1, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(3:4, 1)*pol_y(2, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(1:2, 2)*pol_y(1, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(3:4, 2)*pol_y(2, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(1:2, 3)*pol_y(1, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(3:4, 3)*pol_y(2, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(1:2, 4)*pol_y(1, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(3:4, 4)*pol_y(2, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(1:2, 5)*pol_y(1, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(3:4, 5)*pol_y(2, 0, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(1:2, 6)*pol_y(1, 0, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(3:4, 6)*pol_y(2, 0, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(1:2, 0)*pol_y(1, 1, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(3:4, 0)*pol_y(2, 1, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(1:2, 1)*pol_y(1, 1, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(3:4, 1)*pol_y(2, 1, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(1:2, 2)*pol_y(1, 1, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(3:4, 2)*pol_y(2, 1, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(1:2, 3)*pol_y(1, 1, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(3:4, 3)*pol_y(2, 1, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(1:2, 4)*pol_y(1, 1, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(3:4, 4)*pol_y(2, 1, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(1:2, 5)*pol_y(1, 1, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(3:4, 5)*pol_y(2, 1, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(1:2, 0)*pol_y(1, 2, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(3:4, 0)*pol_y(2, 2, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(1:2, 1)*pol_y(1, 2, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(3:4, 1)*pol_y(2, 2, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(1:2, 2)*pol_y(1, 2, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(3:4, 2)*pol_y(2, 2, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(1:2, 3)*pol_y(1, 2, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(3:4, 3)*pol_y(2, 2, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(1:2, 4)*pol_y(1, 2, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(3:4, 4)*pol_y(2, 2, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(1:2, 0)*pol_y(1, 3, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(3:4, 0)*pol_y(2, 3, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(1:2, 1)*pol_y(1, 3, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(3:4, 1)*pol_y(2, 3, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(1:2, 2)*pol_y(1, 3, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(3:4, 2)*pol_y(2, 3, jg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_x(1:2, 3)*pol_y(1, 3, jg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_x(3:4, 3)*pol_y(2, 3, jg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_x(1:2, 0)*pol_y(1, 4, jg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_x(3:4, 0)*pol_y(2, 4, jg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_x(1:2, 1)*pol_y(1, 4, jg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_x(3:4, 1)*pol_y(2, 4, jg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_x(1:2, 2)*pol_y(1, 4, jg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_x(3:4, 2)*pol_y(2, 4, jg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_x(1:2, 0)*pol_y(1, 5, jg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_x(3:4, 0)*pol_y(2, 5, jg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_x(1:2, 1)*pol_y(1, 5, jg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_x(3:4, 1)*pol_y(2, 5, jg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_x(1:2, 0)*pol_y(1, 6, jg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_x(3:4, 0)*pol_y(2, 6, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(1:2, 1)*pol_y(1, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(3:4, 1)*pol_y(2, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(1:2, 2)*pol_y(1, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(3:4, 2)*pol_y(2, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(1:2, 3)*pol_y(1, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(3:4, 3)*pol_y(2, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(1:2, 4)*pol_y(1, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(3:4, 4)*pol_y(2, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(1:2, 5)*pol_y(1, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(3:4, 5)*pol_y(2, 0, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(1:2, 6)*pol_y(1, 0, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(3:4, 6)*pol_y(2, 0, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(1:2, 0)*pol_y(1, 1, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(3:4, 0)*pol_y(2, 1, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(1:2, 1)*pol_y(1, 1, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(3:4, 1)*pol_y(2, 1, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(1:2, 2)*pol_y(1, 1, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(3:4, 2)*pol_y(2, 1, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(1:2, 3)*pol_y(1, 1, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(3:4, 3)*pol_y(2, 1, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(1:2, 4)*pol_y(1, 1, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(3:4, 4)*pol_y(2, 1, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(1:2, 5)*pol_y(1, 1, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(3:4, 5)*pol_y(2, 1, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(1:2, 0)*pol_y(1, 2, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(3:4, 0)*pol_y(2, 2, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(1:2, 1)*pol_y(1, 2, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(3:4, 1)*pol_y(2, 2, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(1:2, 2)*pol_y(1, 2, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(3:4, 2)*pol_y(2, 2, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(1:2, 3)*pol_y(1, 2, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(3:4, 3)*pol_y(2, 2, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(1:2, 4)*pol_y(1, 2, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(3:4, 4)*pol_y(2, 2, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(1:2, 0)*pol_y(1, 3, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(3:4, 0)*pol_y(2, 3, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(1:2, 1)*pol_y(1, 3, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(3:4, 1)*pol_y(2, 3, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(1:2, 2)*pol_y(1, 3, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(3:4, 2)*pol_y(2, 3, jg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_x(1:2, 3)*pol_y(1, 3, jg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_x(3:4, 3)*pol_y(2, 3, jg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_x(1:2, 0)*pol_y(1, 4, jg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_x(3:4, 0)*pol_y(2, 4, jg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_x(1:2, 1)*pol_y(1, 4, jg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_x(3:4, 1)*pol_y(2, 4, jg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_x(1:2, 2)*pol_y(1, 4, jg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_x(3:4, 2)*pol_y(2, 4, jg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_x(1:2, 0)*pol_y(1, 5, jg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_x(3:4, 0)*pol_y(2, 5, jg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_x(1:2, 1)*pol_y(1, 5, jg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_x(3:4, 1)*pol_y(2, 5, jg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_x(1:2, 0)*pol_y(1, 6, jg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_x(3:4, 0)*pol_y(2, 6, jg) END DO lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xyz(lxyz) = coef_xyz(lxyz)+SUM(coef_xy(:, lxy)*pol_z(:, lzp, kg)) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xyz(lxyz) = coef_xyz(lxyz) + SUM(coef_xy(:, lxy)*pol_z(:, lzp, kg)) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO END DO @@ -919,14 +919,14 @@ SUBROUTINE integrate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s(4) sci = 1 @@ -934,23 +934,23 @@ SUBROUTINE integrate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -960,91 +960,91 @@ SUBROUTINE integrate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s(3) = grid(i, j2, k) s(4) = grid(i, j2, k2) DO lxp = 0, lp - coef_x(:, lxp) = coef_x(:, lxp)+s(:)*pol_x(lxp, ig) + coef_x(:, lxp) = coef_x(:, lxp) + s(:)*pol_x(lxp, ig) ENDDO END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(1:2, 1)*pol_y(1, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(3:4, 1)*pol_y(2, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(1:2, 2)*pol_y(1, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(3:4, 2)*pol_y(2, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(1:2, 3)*pol_y(1, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(3:4, 3)*pol_y(2, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(1:2, 4)*pol_y(1, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(3:4, 4)*pol_y(2, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(1:2, 5)*pol_y(1, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(3:4, 5)*pol_y(2, 0, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(1:2, 6)*pol_y(1, 0, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(3:4, 6)*pol_y(2, 0, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(1:2, 7)*pol_y(1, 0, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(3:4, 7)*pol_y(2, 0, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(1:2, 0)*pol_y(1, 1, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(3:4, 0)*pol_y(2, 1, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(1:2, 1)*pol_y(1, 1, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(3:4, 1)*pol_y(2, 1, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(1:2, 2)*pol_y(1, 1, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(3:4, 2)*pol_y(2, 1, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(1:2, 3)*pol_y(1, 1, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(3:4, 3)*pol_y(2, 1, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(1:2, 4)*pol_y(1, 1, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(3:4, 4)*pol_y(2, 1, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(1:2, 5)*pol_y(1, 1, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(3:4, 5)*pol_y(2, 1, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(1:2, 6)*pol_y(1, 1, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(3:4, 6)*pol_y(2, 1, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(1:2, 0)*pol_y(1, 2, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(3:4, 0)*pol_y(2, 2, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(1:2, 1)*pol_y(1, 2, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(3:4, 1)*pol_y(2, 2, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(1:2, 2)*pol_y(1, 2, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(3:4, 2)*pol_y(2, 2, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(1:2, 3)*pol_y(1, 2, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(3:4, 3)*pol_y(2, 2, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(1:2, 4)*pol_y(1, 2, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(3:4, 4)*pol_y(2, 2, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(1:2, 5)*pol_y(1, 2, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(3:4, 5)*pol_y(2, 2, jg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_x(1:2, 0)*pol_y(1, 3, jg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_x(3:4, 0)*pol_y(2, 3, jg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_x(1:2, 1)*pol_y(1, 3, jg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_x(3:4, 1)*pol_y(2, 3, jg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_x(1:2, 2)*pol_y(1, 3, jg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_x(3:4, 2)*pol_y(2, 3, jg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_x(1:2, 3)*pol_y(1, 3, jg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_x(3:4, 3)*pol_y(2, 3, jg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_x(1:2, 4)*pol_y(1, 3, jg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_x(3:4, 4)*pol_y(2, 3, jg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_x(1:2, 0)*pol_y(1, 4, jg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_x(3:4, 0)*pol_y(2, 4, jg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_x(1:2, 1)*pol_y(1, 4, jg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_x(3:4, 1)*pol_y(2, 4, jg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_x(1:2, 2)*pol_y(1, 4, jg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_x(3:4, 2)*pol_y(2, 4, jg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_x(1:2, 3)*pol_y(1, 4, jg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_x(3:4, 3)*pol_y(2, 4, jg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_x(1:2, 0)*pol_y(1, 5, jg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_x(3:4, 0)*pol_y(2, 5, jg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_x(1:2, 1)*pol_y(1, 5, jg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_x(3:4, 1)*pol_y(2, 5, jg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_x(1:2, 2)*pol_y(1, 5, jg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_x(3:4, 2)*pol_y(2, 5, jg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_x(1:2, 0)*pol_y(1, 6, jg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_x(3:4, 0)*pol_y(2, 6, jg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_x(1:2, 1)*pol_y(1, 6, jg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_x(3:4, 1)*pol_y(2, 6, jg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_x(1:2, 0)*pol_y(1, 7, jg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_x(3:4, 0)*pol_y(2, 7, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(1:2, 1)*pol_y(1, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(3:4, 1)*pol_y(2, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(1:2, 2)*pol_y(1, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(3:4, 2)*pol_y(2, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(1:2, 3)*pol_y(1, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(3:4, 3)*pol_y(2, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(1:2, 4)*pol_y(1, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(3:4, 4)*pol_y(2, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(1:2, 5)*pol_y(1, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(3:4, 5)*pol_y(2, 0, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(1:2, 6)*pol_y(1, 0, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(3:4, 6)*pol_y(2, 0, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(1:2, 7)*pol_y(1, 0, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(3:4, 7)*pol_y(2, 0, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(1:2, 0)*pol_y(1, 1, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(3:4, 0)*pol_y(2, 1, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(1:2, 1)*pol_y(1, 1, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(3:4, 1)*pol_y(2, 1, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(1:2, 2)*pol_y(1, 1, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(3:4, 2)*pol_y(2, 1, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(1:2, 3)*pol_y(1, 1, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(3:4, 3)*pol_y(2, 1, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(1:2, 4)*pol_y(1, 1, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(3:4, 4)*pol_y(2, 1, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(1:2, 5)*pol_y(1, 1, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(3:4, 5)*pol_y(2, 1, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(1:2, 6)*pol_y(1, 1, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(3:4, 6)*pol_y(2, 1, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(1:2, 0)*pol_y(1, 2, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(3:4, 0)*pol_y(2, 2, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(1:2, 1)*pol_y(1, 2, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(3:4, 1)*pol_y(2, 2, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(1:2, 2)*pol_y(1, 2, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(3:4, 2)*pol_y(2, 2, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(1:2, 3)*pol_y(1, 2, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(3:4, 3)*pol_y(2, 2, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(1:2, 4)*pol_y(1, 2, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(3:4, 4)*pol_y(2, 2, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(1:2, 5)*pol_y(1, 2, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(3:4, 5)*pol_y(2, 2, jg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_x(1:2, 0)*pol_y(1, 3, jg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_x(3:4, 0)*pol_y(2, 3, jg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_x(1:2, 1)*pol_y(1, 3, jg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_x(3:4, 1)*pol_y(2, 3, jg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_x(1:2, 2)*pol_y(1, 3, jg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_x(3:4, 2)*pol_y(2, 3, jg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_x(1:2, 3)*pol_y(1, 3, jg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_x(3:4, 3)*pol_y(2, 3, jg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_x(1:2, 4)*pol_y(1, 3, jg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_x(3:4, 4)*pol_y(2, 3, jg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_x(1:2, 0)*pol_y(1, 4, jg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_x(3:4, 0)*pol_y(2, 4, jg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_x(1:2, 1)*pol_y(1, 4, jg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_x(3:4, 1)*pol_y(2, 4, jg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_x(1:2, 2)*pol_y(1, 4, jg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_x(3:4, 2)*pol_y(2, 4, jg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_x(1:2, 3)*pol_y(1, 4, jg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_x(3:4, 3)*pol_y(2, 4, jg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_x(1:2, 0)*pol_y(1, 5, jg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_x(3:4, 0)*pol_y(2, 5, jg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_x(1:2, 1)*pol_y(1, 5, jg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_x(3:4, 1)*pol_y(2, 5, jg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_x(1:2, 2)*pol_y(1, 5, jg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_x(3:4, 2)*pol_y(2, 5, jg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_x(1:2, 0)*pol_y(1, 6, jg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_x(3:4, 0)*pol_y(2, 6, jg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_x(1:2, 1)*pol_y(1, 6, jg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_x(3:4, 1)*pol_y(2, 6, jg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_x(1:2, 0)*pol_y(1, 7, jg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_x(3:4, 0)*pol_y(2, 7, jg) END DO lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xyz(lxyz) = coef_xyz(lxyz)+SUM(coef_xy(:, lxy)*pol_z(:, lzp, kg)) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xyz(lxyz) = coef_xyz(lxyz) + SUM(coef_xy(:, lxy)*pol_z(:, lzp, kg)) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO END DO @@ -1073,14 +1073,14 @@ SUBROUTINE integrate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s(4) sci = 1 @@ -1088,23 +1088,23 @@ SUBROUTINE integrate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -1114,109 +1114,109 @@ SUBROUTINE integrate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s(3) = grid(i, j2, k) s(4) = grid(i, j2, k2) DO lxp = 0, lp - coef_x(:, lxp) = coef_x(:, lxp)+s(:)*pol_x(lxp, ig) + coef_x(:, lxp) = coef_x(:, lxp) + s(:)*pol_x(lxp, ig) ENDDO END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(1:2, 1)*pol_y(1, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(3:4, 1)*pol_y(2, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(1:2, 2)*pol_y(1, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(3:4, 2)*pol_y(2, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(1:2, 3)*pol_y(1, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(3:4, 3)*pol_y(2, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(1:2, 4)*pol_y(1, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(3:4, 4)*pol_y(2, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(1:2, 5)*pol_y(1, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(3:4, 5)*pol_y(2, 0, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(1:2, 6)*pol_y(1, 0, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(3:4, 6)*pol_y(2, 0, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(1:2, 7)*pol_y(1, 0, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(3:4, 7)*pol_y(2, 0, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(1:2, 8)*pol_y(1, 0, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(3:4, 8)*pol_y(2, 0, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(1:2, 0)*pol_y(1, 1, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(3:4, 0)*pol_y(2, 1, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(1:2, 1)*pol_y(1, 1, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(3:4, 1)*pol_y(2, 1, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(1:2, 2)*pol_y(1, 1, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(3:4, 2)*pol_y(2, 1, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(1:2, 3)*pol_y(1, 1, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(3:4, 3)*pol_y(2, 1, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(1:2, 4)*pol_y(1, 1, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(3:4, 4)*pol_y(2, 1, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(1:2, 5)*pol_y(1, 1, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(3:4, 5)*pol_y(2, 1, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(1:2, 6)*pol_y(1, 1, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(3:4, 6)*pol_y(2, 1, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(1:2, 7)*pol_y(1, 1, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(3:4, 7)*pol_y(2, 1, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(1:2, 0)*pol_y(1, 2, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(3:4, 0)*pol_y(2, 2, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(1:2, 1)*pol_y(1, 2, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(3:4, 1)*pol_y(2, 2, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(1:2, 2)*pol_y(1, 2, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(3:4, 2)*pol_y(2, 2, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(1:2, 3)*pol_y(1, 2, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(3:4, 3)*pol_y(2, 2, jg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_x(1:2, 4)*pol_y(1, 2, jg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_x(3:4, 4)*pol_y(2, 2, jg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_x(1:2, 5)*pol_y(1, 2, jg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_x(3:4, 5)*pol_y(2, 2, jg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_x(1:2, 6)*pol_y(1, 2, jg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_x(3:4, 6)*pol_y(2, 2, jg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_x(1:2, 0)*pol_y(1, 3, jg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_x(3:4, 0)*pol_y(2, 3, jg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_x(1:2, 1)*pol_y(1, 3, jg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_x(3:4, 1)*pol_y(2, 3, jg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_x(1:2, 2)*pol_y(1, 3, jg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_x(3:4, 2)*pol_y(2, 3, jg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_x(1:2, 3)*pol_y(1, 3, jg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_x(3:4, 3)*pol_y(2, 3, jg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_x(1:2, 4)*pol_y(1, 3, jg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_x(3:4, 4)*pol_y(2, 3, jg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_x(1:2, 5)*pol_y(1, 3, jg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_x(3:4, 5)*pol_y(2, 3, jg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_x(1:2, 0)*pol_y(1, 4, jg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_x(3:4, 0)*pol_y(2, 4, jg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_x(1:2, 1)*pol_y(1, 4, jg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_x(3:4, 1)*pol_y(2, 4, jg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_x(1:2, 2)*pol_y(1, 4, jg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_x(3:4, 2)*pol_y(2, 4, jg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_x(1:2, 3)*pol_y(1, 4, jg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_x(3:4, 3)*pol_y(2, 4, jg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_x(1:2, 4)*pol_y(1, 4, jg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_x(3:4, 4)*pol_y(2, 4, jg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_x(1:2, 0)*pol_y(1, 5, jg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_x(3:4, 0)*pol_y(2, 5, jg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_x(1:2, 1)*pol_y(1, 5, jg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_x(3:4, 1)*pol_y(2, 5, jg) - coef_xy(:, 38) = coef_xy(:, 38)+coef_x(1:2, 2)*pol_y(1, 5, jg) - coef_xy(:, 38) = coef_xy(:, 38)+coef_x(3:4, 2)*pol_y(2, 5, jg) - coef_xy(:, 39) = coef_xy(:, 39)+coef_x(1:2, 3)*pol_y(1, 5, jg) - coef_xy(:, 39) = coef_xy(:, 39)+coef_x(3:4, 3)*pol_y(2, 5, jg) - coef_xy(:, 40) = coef_xy(:, 40)+coef_x(1:2, 0)*pol_y(1, 6, jg) - coef_xy(:, 40) = coef_xy(:, 40)+coef_x(3:4, 0)*pol_y(2, 6, jg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_x(1:2, 1)*pol_y(1, 6, jg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_x(3:4, 1)*pol_y(2, 6, jg) - coef_xy(:, 42) = coef_xy(:, 42)+coef_x(1:2, 2)*pol_y(1, 6, jg) - coef_xy(:, 42) = coef_xy(:, 42)+coef_x(3:4, 2)*pol_y(2, 6, jg) - coef_xy(:, 43) = coef_xy(:, 43)+coef_x(1:2, 0)*pol_y(1, 7, jg) - coef_xy(:, 43) = coef_xy(:, 43)+coef_x(3:4, 0)*pol_y(2, 7, jg) - coef_xy(:, 44) = coef_xy(:, 44)+coef_x(1:2, 1)*pol_y(1, 7, jg) - coef_xy(:, 44) = coef_xy(:, 44)+coef_x(3:4, 1)*pol_y(2, 7, jg) - coef_xy(:, 45) = coef_xy(:, 45)+coef_x(1:2, 0)*pol_y(1, 8, jg) - coef_xy(:, 45) = coef_xy(:, 45)+coef_x(3:4, 0)*pol_y(2, 8, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(1:2, 1)*pol_y(1, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(3:4, 1)*pol_y(2, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(1:2, 2)*pol_y(1, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(3:4, 2)*pol_y(2, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(1:2, 3)*pol_y(1, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(3:4, 3)*pol_y(2, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(1:2, 4)*pol_y(1, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(3:4, 4)*pol_y(2, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(1:2, 5)*pol_y(1, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(3:4, 5)*pol_y(2, 0, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(1:2, 6)*pol_y(1, 0, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(3:4, 6)*pol_y(2, 0, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(1:2, 7)*pol_y(1, 0, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(3:4, 7)*pol_y(2, 0, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(1:2, 8)*pol_y(1, 0, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(3:4, 8)*pol_y(2, 0, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(1:2, 0)*pol_y(1, 1, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(3:4, 0)*pol_y(2, 1, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(1:2, 1)*pol_y(1, 1, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(3:4, 1)*pol_y(2, 1, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(1:2, 2)*pol_y(1, 1, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(3:4, 2)*pol_y(2, 1, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(1:2, 3)*pol_y(1, 1, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(3:4, 3)*pol_y(2, 1, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(1:2, 4)*pol_y(1, 1, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(3:4, 4)*pol_y(2, 1, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(1:2, 5)*pol_y(1, 1, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(3:4, 5)*pol_y(2, 1, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(1:2, 6)*pol_y(1, 1, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(3:4, 6)*pol_y(2, 1, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(1:2, 7)*pol_y(1, 1, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(3:4, 7)*pol_y(2, 1, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(1:2, 0)*pol_y(1, 2, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(3:4, 0)*pol_y(2, 2, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(1:2, 1)*pol_y(1, 2, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(3:4, 1)*pol_y(2, 2, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(1:2, 2)*pol_y(1, 2, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(3:4, 2)*pol_y(2, 2, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(1:2, 3)*pol_y(1, 2, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(3:4, 3)*pol_y(2, 2, jg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_x(1:2, 4)*pol_y(1, 2, jg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_x(3:4, 4)*pol_y(2, 2, jg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_x(1:2, 5)*pol_y(1, 2, jg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_x(3:4, 5)*pol_y(2, 2, jg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_x(1:2, 6)*pol_y(1, 2, jg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_x(3:4, 6)*pol_y(2, 2, jg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_x(1:2, 0)*pol_y(1, 3, jg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_x(3:4, 0)*pol_y(2, 3, jg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_x(1:2, 1)*pol_y(1, 3, jg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_x(3:4, 1)*pol_y(2, 3, jg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_x(1:2, 2)*pol_y(1, 3, jg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_x(3:4, 2)*pol_y(2, 3, jg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_x(1:2, 3)*pol_y(1, 3, jg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_x(3:4, 3)*pol_y(2, 3, jg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_x(1:2, 4)*pol_y(1, 3, jg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_x(3:4, 4)*pol_y(2, 3, jg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_x(1:2, 5)*pol_y(1, 3, jg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_x(3:4, 5)*pol_y(2, 3, jg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_x(1:2, 0)*pol_y(1, 4, jg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_x(3:4, 0)*pol_y(2, 4, jg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_x(1:2, 1)*pol_y(1, 4, jg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_x(3:4, 1)*pol_y(2, 4, jg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_x(1:2, 2)*pol_y(1, 4, jg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_x(3:4, 2)*pol_y(2, 4, jg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_x(1:2, 3)*pol_y(1, 4, jg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_x(3:4, 3)*pol_y(2, 4, jg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_x(1:2, 4)*pol_y(1, 4, jg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_x(3:4, 4)*pol_y(2, 4, jg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_x(1:2, 0)*pol_y(1, 5, jg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_x(3:4, 0)*pol_y(2, 5, jg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_x(1:2, 1)*pol_y(1, 5, jg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_x(3:4, 1)*pol_y(2, 5, jg) + coef_xy(:, 38) = coef_xy(:, 38) + coef_x(1:2, 2)*pol_y(1, 5, jg) + coef_xy(:, 38) = coef_xy(:, 38) + coef_x(3:4, 2)*pol_y(2, 5, jg) + coef_xy(:, 39) = coef_xy(:, 39) + coef_x(1:2, 3)*pol_y(1, 5, jg) + coef_xy(:, 39) = coef_xy(:, 39) + coef_x(3:4, 3)*pol_y(2, 5, jg) + coef_xy(:, 40) = coef_xy(:, 40) + coef_x(1:2, 0)*pol_y(1, 6, jg) + coef_xy(:, 40) = coef_xy(:, 40) + coef_x(3:4, 0)*pol_y(2, 6, jg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_x(1:2, 1)*pol_y(1, 6, jg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_x(3:4, 1)*pol_y(2, 6, jg) + coef_xy(:, 42) = coef_xy(:, 42) + coef_x(1:2, 2)*pol_y(1, 6, jg) + coef_xy(:, 42) = coef_xy(:, 42) + coef_x(3:4, 2)*pol_y(2, 6, jg) + coef_xy(:, 43) = coef_xy(:, 43) + coef_x(1:2, 0)*pol_y(1, 7, jg) + coef_xy(:, 43) = coef_xy(:, 43) + coef_x(3:4, 0)*pol_y(2, 7, jg) + coef_xy(:, 44) = coef_xy(:, 44) + coef_x(1:2, 1)*pol_y(1, 7, jg) + coef_xy(:, 44) = coef_xy(:, 44) + coef_x(3:4, 1)*pol_y(2, 7, jg) + coef_xy(:, 45) = coef_xy(:, 45) + coef_x(1:2, 0)*pol_y(1, 8, jg) + coef_xy(:, 45) = coef_xy(:, 45) + coef_x(3:4, 0)*pol_y(2, 8, jg) END DO lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xyz(lxyz) = coef_xyz(lxyz)+SUM(coef_xy(:, lxy)*pol_z(:, lzp, kg)) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xyz(lxyz) = coef_xyz(lxyz) + SUM(coef_xy(:, lxy)*pol_z(:, lzp, kg)) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO END DO @@ -1245,14 +1245,14 @@ SUBROUTINE integrate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s(4) sci = 1 @@ -1260,23 +1260,23 @@ SUBROUTINE integrate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -1286,129 +1286,129 @@ SUBROUTINE integrate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s(3) = grid(i, j2, k) s(4) = grid(i, j2, k2) DO lxp = 0, lp - coef_x(:, lxp) = coef_x(:, lxp)+s(:)*pol_x(lxp, ig) + coef_x(:, lxp) = coef_x(:, lxp) + s(:)*pol_x(lxp, ig) ENDDO END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(1:2, 1)*pol_y(1, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(3:4, 1)*pol_y(2, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(1:2, 2)*pol_y(1, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(3:4, 2)*pol_y(2, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(1:2, 3)*pol_y(1, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(3:4, 3)*pol_y(2, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(1:2, 4)*pol_y(1, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(3:4, 4)*pol_y(2, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(1:2, 5)*pol_y(1, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(3:4, 5)*pol_y(2, 0, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(1:2, 6)*pol_y(1, 0, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(3:4, 6)*pol_y(2, 0, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(1:2, 7)*pol_y(1, 0, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(3:4, 7)*pol_y(2, 0, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(1:2, 8)*pol_y(1, 0, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(3:4, 8)*pol_y(2, 0, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(1:2, 9)*pol_y(1, 0, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(3:4, 9)*pol_y(2, 0, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(1:2, 0)*pol_y(1, 1, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(3:4, 0)*pol_y(2, 1, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(1:2, 1)*pol_y(1, 1, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(3:4, 1)*pol_y(2, 1, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(1:2, 2)*pol_y(1, 1, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(3:4, 2)*pol_y(2, 1, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(1:2, 3)*pol_y(1, 1, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(3:4, 3)*pol_y(2, 1, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(1:2, 4)*pol_y(1, 1, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(3:4, 4)*pol_y(2, 1, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(1:2, 5)*pol_y(1, 1, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(3:4, 5)*pol_y(2, 1, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(1:2, 6)*pol_y(1, 1, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(3:4, 6)*pol_y(2, 1, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(1:2, 7)*pol_y(1, 1, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(3:4, 7)*pol_y(2, 1, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(1:2, 8)*pol_y(1, 1, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(3:4, 8)*pol_y(2, 1, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(1:2, 0)*pol_y(1, 2, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(3:4, 0)*pol_y(2, 2, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(1:2, 1)*pol_y(1, 2, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(3:4, 1)*pol_y(2, 2, jg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_x(1:2, 2)*pol_y(1, 2, jg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_x(3:4, 2)*pol_y(2, 2, jg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_x(1:2, 3)*pol_y(1, 2, jg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_x(3:4, 3)*pol_y(2, 2, jg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_x(1:2, 4)*pol_y(1, 2, jg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_x(3:4, 4)*pol_y(2, 2, jg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_x(1:2, 5)*pol_y(1, 2, jg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_x(3:4, 5)*pol_y(2, 2, jg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_x(1:2, 6)*pol_y(1, 2, jg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_x(3:4, 6)*pol_y(2, 2, jg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_x(1:2, 7)*pol_y(1, 2, jg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_x(3:4, 7)*pol_y(2, 2, jg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_x(1:2, 0)*pol_y(1, 3, jg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_x(3:4, 0)*pol_y(2, 3, jg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_x(1:2, 1)*pol_y(1, 3, jg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_x(3:4, 1)*pol_y(2, 3, jg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_x(1:2, 2)*pol_y(1, 3, jg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_x(3:4, 2)*pol_y(2, 3, jg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_x(1:2, 3)*pol_y(1, 3, jg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_x(3:4, 3)*pol_y(2, 3, jg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_x(1:2, 4)*pol_y(1, 3, jg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_x(3:4, 4)*pol_y(2, 3, jg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_x(1:2, 5)*pol_y(1, 3, jg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_x(3:4, 5)*pol_y(2, 3, jg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_x(1:2, 6)*pol_y(1, 3, jg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_x(3:4, 6)*pol_y(2, 3, jg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_x(1:2, 0)*pol_y(1, 4, jg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_x(3:4, 0)*pol_y(2, 4, jg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_x(1:2, 1)*pol_y(1, 4, jg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_x(3:4, 1)*pol_y(2, 4, jg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_x(1:2, 2)*pol_y(1, 4, jg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_x(3:4, 2)*pol_y(2, 4, jg) - coef_xy(:, 38) = coef_xy(:, 38)+coef_x(1:2, 3)*pol_y(1, 4, jg) - coef_xy(:, 38) = coef_xy(:, 38)+coef_x(3:4, 3)*pol_y(2, 4, jg) - coef_xy(:, 39) = coef_xy(:, 39)+coef_x(1:2, 4)*pol_y(1, 4, jg) - coef_xy(:, 39) = coef_xy(:, 39)+coef_x(3:4, 4)*pol_y(2, 4, jg) - coef_xy(:, 40) = coef_xy(:, 40)+coef_x(1:2, 5)*pol_y(1, 4, jg) - coef_xy(:, 40) = coef_xy(:, 40)+coef_x(3:4, 5)*pol_y(2, 4, jg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_x(1:2, 0)*pol_y(1, 5, jg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_x(3:4, 0)*pol_y(2, 5, jg) - coef_xy(:, 42) = coef_xy(:, 42)+coef_x(1:2, 1)*pol_y(1, 5, jg) - coef_xy(:, 42) = coef_xy(:, 42)+coef_x(3:4, 1)*pol_y(2, 5, jg) - coef_xy(:, 43) = coef_xy(:, 43)+coef_x(1:2, 2)*pol_y(1, 5, jg) - coef_xy(:, 43) = coef_xy(:, 43)+coef_x(3:4, 2)*pol_y(2, 5, jg) - coef_xy(:, 44) = coef_xy(:, 44)+coef_x(1:2, 3)*pol_y(1, 5, jg) - coef_xy(:, 44) = coef_xy(:, 44)+coef_x(3:4, 3)*pol_y(2, 5, jg) - coef_xy(:, 45) = coef_xy(:, 45)+coef_x(1:2, 4)*pol_y(1, 5, jg) - coef_xy(:, 45) = coef_xy(:, 45)+coef_x(3:4, 4)*pol_y(2, 5, jg) - coef_xy(:, 46) = coef_xy(:, 46)+coef_x(1:2, 0)*pol_y(1, 6, jg) - coef_xy(:, 46) = coef_xy(:, 46)+coef_x(3:4, 0)*pol_y(2, 6, jg) - coef_xy(:, 47) = coef_xy(:, 47)+coef_x(1:2, 1)*pol_y(1, 6, jg) - coef_xy(:, 47) = coef_xy(:, 47)+coef_x(3:4, 1)*pol_y(2, 6, jg) - coef_xy(:, 48) = coef_xy(:, 48)+coef_x(1:2, 2)*pol_y(1, 6, jg) - coef_xy(:, 48) = coef_xy(:, 48)+coef_x(3:4, 2)*pol_y(2, 6, jg) - coef_xy(:, 49) = coef_xy(:, 49)+coef_x(1:2, 3)*pol_y(1, 6, jg) - coef_xy(:, 49) = coef_xy(:, 49)+coef_x(3:4, 3)*pol_y(2, 6, jg) - coef_xy(:, 50) = coef_xy(:, 50)+coef_x(1:2, 0)*pol_y(1, 7, jg) - coef_xy(:, 50) = coef_xy(:, 50)+coef_x(3:4, 0)*pol_y(2, 7, jg) - coef_xy(:, 51) = coef_xy(:, 51)+coef_x(1:2, 1)*pol_y(1, 7, jg) - coef_xy(:, 51) = coef_xy(:, 51)+coef_x(3:4, 1)*pol_y(2, 7, jg) - coef_xy(:, 52) = coef_xy(:, 52)+coef_x(1:2, 2)*pol_y(1, 7, jg) - coef_xy(:, 52) = coef_xy(:, 52)+coef_x(3:4, 2)*pol_y(2, 7, jg) - coef_xy(:, 53) = coef_xy(:, 53)+coef_x(1:2, 0)*pol_y(1, 8, jg) - coef_xy(:, 53) = coef_xy(:, 53)+coef_x(3:4, 0)*pol_y(2, 8, jg) - coef_xy(:, 54) = coef_xy(:, 54)+coef_x(1:2, 1)*pol_y(1, 8, jg) - coef_xy(:, 54) = coef_xy(:, 54)+coef_x(3:4, 1)*pol_y(2, 8, jg) - coef_xy(:, 55) = coef_xy(:, 55)+coef_x(1:2, 0)*pol_y(1, 9, jg) - coef_xy(:, 55) = coef_xy(:, 55)+coef_x(3:4, 0)*pol_y(2, 9, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(1:2, 1)*pol_y(1, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(3:4, 1)*pol_y(2, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(1:2, 2)*pol_y(1, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(3:4, 2)*pol_y(2, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(1:2, 3)*pol_y(1, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(3:4, 3)*pol_y(2, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(1:2, 4)*pol_y(1, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(3:4, 4)*pol_y(2, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(1:2, 5)*pol_y(1, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(3:4, 5)*pol_y(2, 0, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(1:2, 6)*pol_y(1, 0, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(3:4, 6)*pol_y(2, 0, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(1:2, 7)*pol_y(1, 0, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(3:4, 7)*pol_y(2, 0, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(1:2, 8)*pol_y(1, 0, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(3:4, 8)*pol_y(2, 0, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(1:2, 9)*pol_y(1, 0, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(3:4, 9)*pol_y(2, 0, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(1:2, 0)*pol_y(1, 1, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(3:4, 0)*pol_y(2, 1, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(1:2, 1)*pol_y(1, 1, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(3:4, 1)*pol_y(2, 1, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(1:2, 2)*pol_y(1, 1, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(3:4, 2)*pol_y(2, 1, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(1:2, 3)*pol_y(1, 1, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(3:4, 3)*pol_y(2, 1, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(1:2, 4)*pol_y(1, 1, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(3:4, 4)*pol_y(2, 1, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(1:2, 5)*pol_y(1, 1, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(3:4, 5)*pol_y(2, 1, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(1:2, 6)*pol_y(1, 1, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(3:4, 6)*pol_y(2, 1, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(1:2, 7)*pol_y(1, 1, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(3:4, 7)*pol_y(2, 1, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(1:2, 8)*pol_y(1, 1, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(3:4, 8)*pol_y(2, 1, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(1:2, 0)*pol_y(1, 2, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(3:4, 0)*pol_y(2, 2, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(1:2, 1)*pol_y(1, 2, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(3:4, 1)*pol_y(2, 2, jg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_x(1:2, 2)*pol_y(1, 2, jg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_x(3:4, 2)*pol_y(2, 2, jg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_x(1:2, 3)*pol_y(1, 2, jg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_x(3:4, 3)*pol_y(2, 2, jg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_x(1:2, 4)*pol_y(1, 2, jg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_x(3:4, 4)*pol_y(2, 2, jg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_x(1:2, 5)*pol_y(1, 2, jg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_x(3:4, 5)*pol_y(2, 2, jg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_x(1:2, 6)*pol_y(1, 2, jg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_x(3:4, 6)*pol_y(2, 2, jg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_x(1:2, 7)*pol_y(1, 2, jg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_x(3:4, 7)*pol_y(2, 2, jg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_x(1:2, 0)*pol_y(1, 3, jg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_x(3:4, 0)*pol_y(2, 3, jg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_x(1:2, 1)*pol_y(1, 3, jg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_x(3:4, 1)*pol_y(2, 3, jg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_x(1:2, 2)*pol_y(1, 3, jg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_x(3:4, 2)*pol_y(2, 3, jg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_x(1:2, 3)*pol_y(1, 3, jg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_x(3:4, 3)*pol_y(2, 3, jg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_x(1:2, 4)*pol_y(1, 3, jg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_x(3:4, 4)*pol_y(2, 3, jg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_x(1:2, 5)*pol_y(1, 3, jg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_x(3:4, 5)*pol_y(2, 3, jg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_x(1:2, 6)*pol_y(1, 3, jg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_x(3:4, 6)*pol_y(2, 3, jg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_x(1:2, 0)*pol_y(1, 4, jg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_x(3:4, 0)*pol_y(2, 4, jg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_x(1:2, 1)*pol_y(1, 4, jg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_x(3:4, 1)*pol_y(2, 4, jg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_x(1:2, 2)*pol_y(1, 4, jg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_x(3:4, 2)*pol_y(2, 4, jg) + coef_xy(:, 38) = coef_xy(:, 38) + coef_x(1:2, 3)*pol_y(1, 4, jg) + coef_xy(:, 38) = coef_xy(:, 38) + coef_x(3:4, 3)*pol_y(2, 4, jg) + coef_xy(:, 39) = coef_xy(:, 39) + coef_x(1:2, 4)*pol_y(1, 4, jg) + coef_xy(:, 39) = coef_xy(:, 39) + coef_x(3:4, 4)*pol_y(2, 4, jg) + coef_xy(:, 40) = coef_xy(:, 40) + coef_x(1:2, 5)*pol_y(1, 4, jg) + coef_xy(:, 40) = coef_xy(:, 40) + coef_x(3:4, 5)*pol_y(2, 4, jg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_x(1:2, 0)*pol_y(1, 5, jg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_x(3:4, 0)*pol_y(2, 5, jg) + coef_xy(:, 42) = coef_xy(:, 42) + coef_x(1:2, 1)*pol_y(1, 5, jg) + coef_xy(:, 42) = coef_xy(:, 42) + coef_x(3:4, 1)*pol_y(2, 5, jg) + coef_xy(:, 43) = coef_xy(:, 43) + coef_x(1:2, 2)*pol_y(1, 5, jg) + coef_xy(:, 43) = coef_xy(:, 43) + coef_x(3:4, 2)*pol_y(2, 5, jg) + coef_xy(:, 44) = coef_xy(:, 44) + coef_x(1:2, 3)*pol_y(1, 5, jg) + coef_xy(:, 44) = coef_xy(:, 44) + coef_x(3:4, 3)*pol_y(2, 5, jg) + coef_xy(:, 45) = coef_xy(:, 45) + coef_x(1:2, 4)*pol_y(1, 5, jg) + coef_xy(:, 45) = coef_xy(:, 45) + coef_x(3:4, 4)*pol_y(2, 5, jg) + coef_xy(:, 46) = coef_xy(:, 46) + coef_x(1:2, 0)*pol_y(1, 6, jg) + coef_xy(:, 46) = coef_xy(:, 46) + coef_x(3:4, 0)*pol_y(2, 6, jg) + coef_xy(:, 47) = coef_xy(:, 47) + coef_x(1:2, 1)*pol_y(1, 6, jg) + coef_xy(:, 47) = coef_xy(:, 47) + coef_x(3:4, 1)*pol_y(2, 6, jg) + coef_xy(:, 48) = coef_xy(:, 48) + coef_x(1:2, 2)*pol_y(1, 6, jg) + coef_xy(:, 48) = coef_xy(:, 48) + coef_x(3:4, 2)*pol_y(2, 6, jg) + coef_xy(:, 49) = coef_xy(:, 49) + coef_x(1:2, 3)*pol_y(1, 6, jg) + coef_xy(:, 49) = coef_xy(:, 49) + coef_x(3:4, 3)*pol_y(2, 6, jg) + coef_xy(:, 50) = coef_xy(:, 50) + coef_x(1:2, 0)*pol_y(1, 7, jg) + coef_xy(:, 50) = coef_xy(:, 50) + coef_x(3:4, 0)*pol_y(2, 7, jg) + coef_xy(:, 51) = coef_xy(:, 51) + coef_x(1:2, 1)*pol_y(1, 7, jg) + coef_xy(:, 51) = coef_xy(:, 51) + coef_x(3:4, 1)*pol_y(2, 7, jg) + coef_xy(:, 52) = coef_xy(:, 52) + coef_x(1:2, 2)*pol_y(1, 7, jg) + coef_xy(:, 52) = coef_xy(:, 52) + coef_x(3:4, 2)*pol_y(2, 7, jg) + coef_xy(:, 53) = coef_xy(:, 53) + coef_x(1:2, 0)*pol_y(1, 8, jg) + coef_xy(:, 53) = coef_xy(:, 53) + coef_x(3:4, 0)*pol_y(2, 8, jg) + coef_xy(:, 54) = coef_xy(:, 54) + coef_x(1:2, 1)*pol_y(1, 8, jg) + coef_xy(:, 54) = coef_xy(:, 54) + coef_x(3:4, 1)*pol_y(2, 8, jg) + coef_xy(:, 55) = coef_xy(:, 55) + coef_x(1:2, 0)*pol_y(1, 9, jg) + coef_xy(:, 55) = coef_xy(:, 55) + coef_x(3:4, 0)*pol_y(2, 9, jg) END DO lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xyz(lxyz) = coef_xyz(lxyz)+SUM(coef_xy(:, lxy)*pol_z(:, lzp, kg)) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xyz(lxyz) = coef_xyz(lxyz) + SUM(coef_xy(:, lxy)*pol_z(:, lzp, kg)) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO END DO diff --git a/src/grid/integrate_fast_3.f90 b/src/grid/integrate_fast_3.f90 index 30712ce104..8639ea86a4 100644 --- a/src/grid/integrate_fast_3.f90 +++ b/src/grid/integrate_fast_3.f90 @@ -14,7 +14,7 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bounds, lp, cmax, gridbounds) USE kinds, ONLY: dp INTEGER, INTENT(IN) :: sphere_bounds(*), lp - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER, INTENT(IN) :: cmax REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & @@ -29,7 +29,7 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -37,23 +37,23 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp @@ -64,21 +64,21 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_x(1, lxp)*pol_y(1, lyp, jg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_x(2, lxp)*pol_y(1, lyp, jg) - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_x(3, lxp)*pol_y(2, lyp, jg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_x(4, lxp)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_x(1, lxp)*pol_y(1, lyp, jg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_x(2, lxp)*pol_y(1, lyp, jg) + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_x(3, lxp)*pol_y(2, lyp, jg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_x(4, lxp)*pol_y(2, lyp, jg) ENDDO ENDDO @@ -87,13 +87,13 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(1, lxy)*pol_z(1, lzp, kg) - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(2, lxy)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(1, lxy)*pol_z(1, lzp, kg) + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(2, lxy)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO @@ -123,14 +123,14 @@ SUBROUTINE integrate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -138,23 +138,23 @@ SUBROUTINE integrate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -163,24 +163,24 @@ SUBROUTINE integrate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = grid(i, j, k2) s03 = grid(i, j2, k) s04 = grid(i, j2, k2) - coef_x(1, 0) = coef_x(1, 0)+s01*pol_x(0, ig) - coef_x(2, 0) = coef_x(2, 0)+s02*pol_x(0, ig) - coef_x(3, 0) = coef_x(3, 0)+s03*pol_x(0, ig) - coef_x(4, 0) = coef_x(4, 0)+s04*pol_x(0, ig) + coef_x(1, 0) = coef_x(1, 0) + s01*pol_x(0, ig) + coef_x(2, 0) = coef_x(2, 0) + s02*pol_x(0, ig) + coef_x(3, 0) = coef_x(3, 0) + s03*pol_x(0, ig) + coef_x(4, 0) = coef_x(4, 0) + s04*pol_x(0, ig) END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) END DO lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(1, lxy)*pol_z(1, lzp, kg) - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(2, lxy)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(1, lxy)*pol_z(1, lzp, kg) + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(2, lxy)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO END DO @@ -209,14 +209,14 @@ SUBROUTINE integrate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -224,23 +224,23 @@ SUBROUTINE integrate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -249,35 +249,35 @@ SUBROUTINE integrate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = grid(i, j, k2) s03 = grid(i, j2, k) s04 = grid(i, j2, k2) - coef_x(1, 0) = coef_x(1, 0)+s01*pol_x(0, ig) - coef_x(2, 0) = coef_x(2, 0)+s02*pol_x(0, ig) - coef_x(3, 0) = coef_x(3, 0)+s03*pol_x(0, ig) - coef_x(4, 0) = coef_x(4, 0)+s04*pol_x(0, ig) - coef_x(1, 1) = coef_x(1, 1)+s01*pol_x(1, ig) - coef_x(2, 1) = coef_x(2, 1)+s02*pol_x(1, ig) - coef_x(3, 1) = coef_x(3, 1)+s03*pol_x(1, ig) - coef_x(4, 1) = coef_x(4, 1)+s04*pol_x(1, ig) + coef_x(1, 0) = coef_x(1, 0) + s01*pol_x(0, ig) + coef_x(2, 0) = coef_x(2, 0) + s02*pol_x(0, ig) + coef_x(3, 0) = coef_x(3, 0) + s03*pol_x(0, ig) + coef_x(4, 0) = coef_x(4, 0) + s04*pol_x(0, ig) + coef_x(1, 1) = coef_x(1, 1) + s01*pol_x(1, ig) + coef_x(2, 1) = coef_x(2, 1) + s02*pol_x(1, ig) + coef_x(3, 1) = coef_x(3, 1) + s03*pol_x(1, ig) + coef_x(4, 1) = coef_x(4, 1) + s04*pol_x(1, ig) END DO lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_x(1, lxp)*pol_y(1, lyp, jg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_x(2, lxp)*pol_y(1, lyp, jg) - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_x(3, lxp)*pol_y(2, lyp, jg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_x(4, lxp)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_x(1, lxp)*pol_y(1, lyp, jg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_x(2, lxp)*pol_y(1, lyp, jg) + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_x(3, lxp)*pol_y(2, lyp, jg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_x(4, lxp)*pol_y(2, lyp, jg) ENDDO ENDDO END DO lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xyz(lxyz) = coef_xyz(lxyz)+SUM(coef_xy(:, lxy)*pol_z(:, lzp, kg)) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xyz(lxyz) = coef_xyz(lxyz) + SUM(coef_xy(:, lxy)*pol_z(:, lzp, kg)) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO END DO @@ -306,13 +306,13 @@ SUBROUTINE integrate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s(4) sci = 1 @@ -320,23 +320,23 @@ SUBROUTINE integrate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -345,33 +345,33 @@ SUBROUTINE integrate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s(2) = grid(i, j, k2) s(3) = grid(i, j2, k) s(4) = grid(i, j2, k2) - coef_x(:, 0) = coef_x(:, 0)+s(:)*pol_x(0, ig) - coef_x(:, 1) = coef_x(:, 1)+s(:)*pol_x(1, ig) - coef_x(:, 2) = coef_x(:, 2)+s(:)*pol_x(2, ig) + coef_x(:, 0) = coef_x(:, 0) + s(:)*pol_x(0, ig) + coef_x(:, 1) = coef_x(:, 1) + s(:)*pol_x(1, ig) + coef_x(:, 2) = coef_x(:, 2) + s(:)*pol_x(2, ig) END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(1:2, 1)*pol_y(1, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(3:4, 1)*pol_y(2, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(1:2, 2)*pol_y(1, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(3:4, 2)*pol_y(2, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(1:2, 0)*pol_y(1, 1, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(3:4, 0)*pol_y(2, 1, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(1:2, 1)*pol_y(1, 1, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(3:4, 1)*pol_y(2, 1, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(1:2, 0)*pol_y(1, 2, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(3:4, 0)*pol_y(2, 2, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(1:2, 1)*pol_y(1, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(3:4, 1)*pol_y(2, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(1:2, 2)*pol_y(1, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(3:4, 2)*pol_y(2, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(1:2, 0)*pol_y(1, 1, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(3:4, 0)*pol_y(2, 1, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(1:2, 1)*pol_y(1, 1, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(3:4, 1)*pol_y(2, 1, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(1:2, 0)*pol_y(1, 2, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(3:4, 0)*pol_y(2, 2, jg) END DO - coef_xyz(1) = coef_xyz(1)+SUM(coef_xy(:, 1)*pol_z(:, 0, kg)) - coef_xyz(2) = coef_xyz(2)+SUM(coef_xy(:, 2)*pol_z(:, 0, kg)) - coef_xyz(3) = coef_xyz(3)+SUM(coef_xy(:, 3)*pol_z(:, 0, kg)) - coef_xyz(4) = coef_xyz(4)+SUM(coef_xy(:, 4)*pol_z(:, 0, kg)) - coef_xyz(5) = coef_xyz(5)+SUM(coef_xy(:, 5)*pol_z(:, 0, kg)) - coef_xyz(6) = coef_xyz(6)+SUM(coef_xy(:, 6)*pol_z(:, 0, kg)) - coef_xyz(7) = coef_xyz(7)+SUM(coef_xy(:, 1)*pol_z(:, 1, kg)) - coef_xyz(8) = coef_xyz(8)+SUM(coef_xy(:, 2)*pol_z(:, 1, kg)) - coef_xyz(9) = coef_xyz(9)+SUM(coef_xy(:, 4)*pol_z(:, 1, kg)) - coef_xyz(10) = coef_xyz(10)+SUM(coef_xy(:, 1)*pol_z(:, 2, kg)) + coef_xyz(1) = coef_xyz(1) + SUM(coef_xy(:, 1)*pol_z(:, 0, kg)) + coef_xyz(2) = coef_xyz(2) + SUM(coef_xy(:, 2)*pol_z(:, 0, kg)) + coef_xyz(3) = coef_xyz(3) + SUM(coef_xy(:, 3)*pol_z(:, 0, kg)) + coef_xyz(4) = coef_xyz(4) + SUM(coef_xy(:, 4)*pol_z(:, 0, kg)) + coef_xyz(5) = coef_xyz(5) + SUM(coef_xy(:, 5)*pol_z(:, 0, kg)) + coef_xyz(6) = coef_xyz(6) + SUM(coef_xy(:, 6)*pol_z(:, 0, kg)) + coef_xyz(7) = coef_xyz(7) + SUM(coef_xy(:, 1)*pol_z(:, 1, kg)) + coef_xyz(8) = coef_xyz(8) + SUM(coef_xy(:, 2)*pol_z(:, 1, kg)) + coef_xyz(9) = coef_xyz(9) + SUM(coef_xy(:, 4)*pol_z(:, 1, kg)) + coef_xyz(10) = coef_xyz(10) + SUM(coef_xy(:, 1)*pol_z(:, 2, kg)) END DO END SUBROUTINE integrate_core_2 @@ -398,13 +398,13 @@ SUBROUTINE integrate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lyp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -412,23 +412,23 @@ SUBROUTINE integrate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -438,43 +438,43 @@ SUBROUTINE integrate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_x(1, lxp)*pol_y(1, lyp, jg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_x(2, lxp)*pol_y(1, lyp, jg) - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_x(3, lxp)*pol_y(2, lyp, jg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_x(4, lxp)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_x(1, lxp)*pol_y(1, lyp, jg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_x(2, lxp)*pol_y(1, lyp, jg) + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_x(3, lxp)*pol_y(2, lyp, jg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_x(4, lxp)*pol_y(2, lyp, jg) ENDDO ENDDO END DO - coef_xyz(1) = coef_xyz(1)+SUM(coef_xy(:, 1)*pol_z(:, 0, kg)) - coef_xyz(2) = coef_xyz(2)+SUM(coef_xy(:, 2)*pol_z(:, 0, kg)) - coef_xyz(3) = coef_xyz(3)+SUM(coef_xy(:, 3)*pol_z(:, 0, kg)) - coef_xyz(4) = coef_xyz(4)+SUM(coef_xy(:, 4)*pol_z(:, 0, kg)) - coef_xyz(5) = coef_xyz(5)+SUM(coef_xy(:, 5)*pol_z(:, 0, kg)) - coef_xyz(6) = coef_xyz(6)+SUM(coef_xy(:, 6)*pol_z(:, 0, kg)) - coef_xyz(7) = coef_xyz(7)+SUM(coef_xy(:, 7)*pol_z(:, 0, kg)) - coef_xyz(8) = coef_xyz(8)+SUM(coef_xy(:, 8)*pol_z(:, 0, kg)) - coef_xyz(9) = coef_xyz(9)+SUM(coef_xy(:, 9)*pol_z(:, 0, kg)) - coef_xyz(10) = coef_xyz(10)+SUM(coef_xy(:, 10)*pol_z(:, 0, kg)) - coef_xyz(11) = coef_xyz(11)+SUM(coef_xy(:, 1)*pol_z(:, 1, kg)) - coef_xyz(12) = coef_xyz(12)+SUM(coef_xy(:, 2)*pol_z(:, 1, kg)) - coef_xyz(13) = coef_xyz(13)+SUM(coef_xy(:, 3)*pol_z(:, 1, kg)) - coef_xyz(14) = coef_xyz(14)+SUM(coef_xy(:, 5)*pol_z(:, 1, kg)) - coef_xyz(15) = coef_xyz(15)+SUM(coef_xy(:, 6)*pol_z(:, 1, kg)) - coef_xyz(16) = coef_xyz(16)+SUM(coef_xy(:, 8)*pol_z(:, 1, kg)) - coef_xyz(17) = coef_xyz(17)+SUM(coef_xy(:, 1)*pol_z(:, 2, kg)) - coef_xyz(18) = coef_xyz(18)+SUM(coef_xy(:, 2)*pol_z(:, 2, kg)) - coef_xyz(19) = coef_xyz(19)+SUM(coef_xy(:, 5)*pol_z(:, 2, kg)) - coef_xyz(20) = coef_xyz(20)+SUM(coef_xy(:, 1)*pol_z(:, 3, kg)) + coef_xyz(1) = coef_xyz(1) + SUM(coef_xy(:, 1)*pol_z(:, 0, kg)) + coef_xyz(2) = coef_xyz(2) + SUM(coef_xy(:, 2)*pol_z(:, 0, kg)) + coef_xyz(3) = coef_xyz(3) + SUM(coef_xy(:, 3)*pol_z(:, 0, kg)) + coef_xyz(4) = coef_xyz(4) + SUM(coef_xy(:, 4)*pol_z(:, 0, kg)) + coef_xyz(5) = coef_xyz(5) + SUM(coef_xy(:, 5)*pol_z(:, 0, kg)) + coef_xyz(6) = coef_xyz(6) + SUM(coef_xy(:, 6)*pol_z(:, 0, kg)) + coef_xyz(7) = coef_xyz(7) + SUM(coef_xy(:, 7)*pol_z(:, 0, kg)) + coef_xyz(8) = coef_xyz(8) + SUM(coef_xy(:, 8)*pol_z(:, 0, kg)) + coef_xyz(9) = coef_xyz(9) + SUM(coef_xy(:, 9)*pol_z(:, 0, kg)) + coef_xyz(10) = coef_xyz(10) + SUM(coef_xy(:, 10)*pol_z(:, 0, kg)) + coef_xyz(11) = coef_xyz(11) + SUM(coef_xy(:, 1)*pol_z(:, 1, kg)) + coef_xyz(12) = coef_xyz(12) + SUM(coef_xy(:, 2)*pol_z(:, 1, kg)) + coef_xyz(13) = coef_xyz(13) + SUM(coef_xy(:, 3)*pol_z(:, 1, kg)) + coef_xyz(14) = coef_xyz(14) + SUM(coef_xy(:, 5)*pol_z(:, 1, kg)) + coef_xyz(15) = coef_xyz(15) + SUM(coef_xy(:, 6)*pol_z(:, 1, kg)) + coef_xyz(16) = coef_xyz(16) + SUM(coef_xy(:, 8)*pol_z(:, 1, kg)) + coef_xyz(17) = coef_xyz(17) + SUM(coef_xy(:, 1)*pol_z(:, 2, kg)) + coef_xyz(18) = coef_xyz(18) + SUM(coef_xy(:, 2)*pol_z(:, 2, kg)) + coef_xyz(19) = coef_xyz(19) + SUM(coef_xy(:, 5)*pol_z(:, 2, kg)) + coef_xyz(20) = coef_xyz(20) + SUM(coef_xy(:, 1)*pol_z(:, 3, kg)) END DO END SUBROUTINE integrate_core_3 @@ -501,13 +501,13 @@ SUBROUTINE integrate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s(4) sci = 1 @@ -515,23 +515,23 @@ SUBROUTINE integrate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -540,78 +540,78 @@ SUBROUTINE integrate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s(2) = grid(i, j, k2) s(3) = grid(i, j2, k) s(4) = grid(i, j2, k2) - coef_x(:, 0) = coef_x(:, 0)+s(:)*pol_x(0, ig) - coef_x(:, 1) = coef_x(:, 1)+s(:)*pol_x(1, ig) - coef_x(:, 2) = coef_x(:, 2)+s(:)*pol_x(2, ig) - coef_x(:, 3) = coef_x(:, 3)+s(:)*pol_x(3, ig) - coef_x(:, 4) = coef_x(:, 4)+s(:)*pol_x(4, ig) + coef_x(:, 0) = coef_x(:, 0) + s(:)*pol_x(0, ig) + coef_x(:, 1) = coef_x(:, 1) + s(:)*pol_x(1, ig) + coef_x(:, 2) = coef_x(:, 2) + s(:)*pol_x(2, ig) + coef_x(:, 3) = coef_x(:, 3) + s(:)*pol_x(3, ig) + coef_x(:, 4) = coef_x(:, 4) + s(:)*pol_x(4, ig) END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(1:2, 1)*pol_y(1, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(3:4, 1)*pol_y(2, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(1:2, 2)*pol_y(1, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(3:4, 2)*pol_y(2, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(1:2, 3)*pol_y(1, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(3:4, 3)*pol_y(2, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(1:2, 4)*pol_y(1, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(3:4, 4)*pol_y(2, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(1:2, 0)*pol_y(1, 1, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(3:4, 0)*pol_y(2, 1, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(1:2, 1)*pol_y(1, 1, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(3:4, 1)*pol_y(2, 1, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(1:2, 2)*pol_y(1, 1, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(3:4, 2)*pol_y(2, 1, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(1:2, 3)*pol_y(1, 1, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(3:4, 3)*pol_y(2, 1, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(1:2, 0)*pol_y(1, 2, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(3:4, 0)*pol_y(2, 2, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(1:2, 1)*pol_y(1, 2, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(3:4, 1)*pol_y(2, 2, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(1:2, 2)*pol_y(1, 2, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(3:4, 2)*pol_y(2, 2, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(1:2, 0)*pol_y(1, 3, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(3:4, 0)*pol_y(2, 3, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(1:2, 1)*pol_y(1, 3, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(3:4, 1)*pol_y(2, 3, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(1:2, 0)*pol_y(1, 4, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(3:4, 0)*pol_y(2, 4, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(1:2, 1)*pol_y(1, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(3:4, 1)*pol_y(2, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(1:2, 2)*pol_y(1, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(3:4, 2)*pol_y(2, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(1:2, 3)*pol_y(1, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(3:4, 3)*pol_y(2, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(1:2, 4)*pol_y(1, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(3:4, 4)*pol_y(2, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(1:2, 0)*pol_y(1, 1, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(3:4, 0)*pol_y(2, 1, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(1:2, 1)*pol_y(1, 1, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(3:4, 1)*pol_y(2, 1, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(1:2, 2)*pol_y(1, 1, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(3:4, 2)*pol_y(2, 1, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(1:2, 3)*pol_y(1, 1, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(3:4, 3)*pol_y(2, 1, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(1:2, 0)*pol_y(1, 2, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(3:4, 0)*pol_y(2, 2, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(1:2, 1)*pol_y(1, 2, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(3:4, 1)*pol_y(2, 2, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(1:2, 2)*pol_y(1, 2, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(3:4, 2)*pol_y(2, 2, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(1:2, 0)*pol_y(1, 3, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(3:4, 0)*pol_y(2, 3, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(1:2, 1)*pol_y(1, 3, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(3:4, 1)*pol_y(2, 3, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(1:2, 0)*pol_y(1, 4, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(3:4, 0)*pol_y(2, 4, jg) END DO - coef_xyz(1) = coef_xyz(1)+SUM(coef_xy(:, 1)*pol_z(:, 0, kg)) - coef_xyz(2) = coef_xyz(2)+SUM(coef_xy(:, 2)*pol_z(:, 0, kg)) - coef_xyz(3) = coef_xyz(3)+SUM(coef_xy(:, 3)*pol_z(:, 0, kg)) - coef_xyz(4) = coef_xyz(4)+SUM(coef_xy(:, 4)*pol_z(:, 0, kg)) - coef_xyz(5) = coef_xyz(5)+SUM(coef_xy(:, 5)*pol_z(:, 0, kg)) - coef_xyz(6) = coef_xyz(6)+SUM(coef_xy(:, 6)*pol_z(:, 0, kg)) - coef_xyz(7) = coef_xyz(7)+SUM(coef_xy(:, 7)*pol_z(:, 0, kg)) - coef_xyz(8) = coef_xyz(8)+SUM(coef_xy(:, 8)*pol_z(:, 0, kg)) - coef_xyz(9) = coef_xyz(9)+SUM(coef_xy(:, 9)*pol_z(:, 0, kg)) - coef_xyz(10) = coef_xyz(10)+SUM(coef_xy(:, 10)*pol_z(:, 0, kg)) - coef_xyz(11) = coef_xyz(11)+SUM(coef_xy(:, 11)*pol_z(:, 0, kg)) - coef_xyz(12) = coef_xyz(12)+SUM(coef_xy(:, 12)*pol_z(:, 0, kg)) - coef_xyz(13) = coef_xyz(13)+SUM(coef_xy(:, 13)*pol_z(:, 0, kg)) - coef_xyz(14) = coef_xyz(14)+SUM(coef_xy(:, 14)*pol_z(:, 0, kg)) - coef_xyz(15) = coef_xyz(15)+SUM(coef_xy(:, 15)*pol_z(:, 0, kg)) - coef_xyz(16) = coef_xyz(16)+SUM(coef_xy(:, 1)*pol_z(:, 1, kg)) - coef_xyz(17) = coef_xyz(17)+SUM(coef_xy(:, 2)*pol_z(:, 1, kg)) - coef_xyz(18) = coef_xyz(18)+SUM(coef_xy(:, 3)*pol_z(:, 1, kg)) - coef_xyz(19) = coef_xyz(19)+SUM(coef_xy(:, 4)*pol_z(:, 1, kg)) - coef_xyz(20) = coef_xyz(20)+SUM(coef_xy(:, 6)*pol_z(:, 1, kg)) - coef_xyz(21) = coef_xyz(21)+SUM(coef_xy(:, 7)*pol_z(:, 1, kg)) - coef_xyz(22) = coef_xyz(22)+SUM(coef_xy(:, 8)*pol_z(:, 1, kg)) - coef_xyz(23) = coef_xyz(23)+SUM(coef_xy(:, 10)*pol_z(:, 1, kg)) - coef_xyz(24) = coef_xyz(24)+SUM(coef_xy(:, 11)*pol_z(:, 1, kg)) - coef_xyz(25) = coef_xyz(25)+SUM(coef_xy(:, 13)*pol_z(:, 1, kg)) - coef_xyz(26) = coef_xyz(26)+SUM(coef_xy(:, 1)*pol_z(:, 2, kg)) - coef_xyz(27) = coef_xyz(27)+SUM(coef_xy(:, 2)*pol_z(:, 2, kg)) - coef_xyz(28) = coef_xyz(28)+SUM(coef_xy(:, 3)*pol_z(:, 2, kg)) - coef_xyz(29) = coef_xyz(29)+SUM(coef_xy(:, 6)*pol_z(:, 2, kg)) - coef_xyz(30) = coef_xyz(30)+SUM(coef_xy(:, 7)*pol_z(:, 2, kg)) - coef_xyz(31) = coef_xyz(31)+SUM(coef_xy(:, 10)*pol_z(:, 2, kg)) - coef_xyz(32) = coef_xyz(32)+SUM(coef_xy(:, 1)*pol_z(:, 3, kg)) - coef_xyz(33) = coef_xyz(33)+SUM(coef_xy(:, 2)*pol_z(:, 3, kg)) - coef_xyz(34) = coef_xyz(34)+SUM(coef_xy(:, 6)*pol_z(:, 3, kg)) - coef_xyz(35) = coef_xyz(35)+SUM(coef_xy(:, 1)*pol_z(:, 4, kg)) + coef_xyz(1) = coef_xyz(1) + SUM(coef_xy(:, 1)*pol_z(:, 0, kg)) + coef_xyz(2) = coef_xyz(2) + SUM(coef_xy(:, 2)*pol_z(:, 0, kg)) + coef_xyz(3) = coef_xyz(3) + SUM(coef_xy(:, 3)*pol_z(:, 0, kg)) + coef_xyz(4) = coef_xyz(4) + SUM(coef_xy(:, 4)*pol_z(:, 0, kg)) + coef_xyz(5) = coef_xyz(5) + SUM(coef_xy(:, 5)*pol_z(:, 0, kg)) + coef_xyz(6) = coef_xyz(6) + SUM(coef_xy(:, 6)*pol_z(:, 0, kg)) + coef_xyz(7) = coef_xyz(7) + SUM(coef_xy(:, 7)*pol_z(:, 0, kg)) + coef_xyz(8) = coef_xyz(8) + SUM(coef_xy(:, 8)*pol_z(:, 0, kg)) + coef_xyz(9) = coef_xyz(9) + SUM(coef_xy(:, 9)*pol_z(:, 0, kg)) + coef_xyz(10) = coef_xyz(10) + SUM(coef_xy(:, 10)*pol_z(:, 0, kg)) + coef_xyz(11) = coef_xyz(11) + SUM(coef_xy(:, 11)*pol_z(:, 0, kg)) + coef_xyz(12) = coef_xyz(12) + SUM(coef_xy(:, 12)*pol_z(:, 0, kg)) + coef_xyz(13) = coef_xyz(13) + SUM(coef_xy(:, 13)*pol_z(:, 0, kg)) + coef_xyz(14) = coef_xyz(14) + SUM(coef_xy(:, 14)*pol_z(:, 0, kg)) + coef_xyz(15) = coef_xyz(15) + SUM(coef_xy(:, 15)*pol_z(:, 0, kg)) + coef_xyz(16) = coef_xyz(16) + SUM(coef_xy(:, 1)*pol_z(:, 1, kg)) + coef_xyz(17) = coef_xyz(17) + SUM(coef_xy(:, 2)*pol_z(:, 1, kg)) + coef_xyz(18) = coef_xyz(18) + SUM(coef_xy(:, 3)*pol_z(:, 1, kg)) + coef_xyz(19) = coef_xyz(19) + SUM(coef_xy(:, 4)*pol_z(:, 1, kg)) + coef_xyz(20) = coef_xyz(20) + SUM(coef_xy(:, 6)*pol_z(:, 1, kg)) + coef_xyz(21) = coef_xyz(21) + SUM(coef_xy(:, 7)*pol_z(:, 1, kg)) + coef_xyz(22) = coef_xyz(22) + SUM(coef_xy(:, 8)*pol_z(:, 1, kg)) + coef_xyz(23) = coef_xyz(23) + SUM(coef_xy(:, 10)*pol_z(:, 1, kg)) + coef_xyz(24) = coef_xyz(24) + SUM(coef_xy(:, 11)*pol_z(:, 1, kg)) + coef_xyz(25) = coef_xyz(25) + SUM(coef_xy(:, 13)*pol_z(:, 1, kg)) + coef_xyz(26) = coef_xyz(26) + SUM(coef_xy(:, 1)*pol_z(:, 2, kg)) + coef_xyz(27) = coef_xyz(27) + SUM(coef_xy(:, 2)*pol_z(:, 2, kg)) + coef_xyz(28) = coef_xyz(28) + SUM(coef_xy(:, 3)*pol_z(:, 2, kg)) + coef_xyz(29) = coef_xyz(29) + SUM(coef_xy(:, 6)*pol_z(:, 2, kg)) + coef_xyz(30) = coef_xyz(30) + SUM(coef_xy(:, 7)*pol_z(:, 2, kg)) + coef_xyz(31) = coef_xyz(31) + SUM(coef_xy(:, 10)*pol_z(:, 2, kg)) + coef_xyz(32) = coef_xyz(32) + SUM(coef_xy(:, 1)*pol_z(:, 3, kg)) + coef_xyz(33) = coef_xyz(33) + SUM(coef_xy(:, 2)*pol_z(:, 3, kg)) + coef_xyz(34) = coef_xyz(34) + SUM(coef_xy(:, 6)*pol_z(:, 3, kg)) + coef_xyz(35) = coef_xyz(35) + SUM(coef_xy(:, 1)*pol_z(:, 4, kg)) END DO END SUBROUTINE integrate_core_4 @@ -638,13 +638,13 @@ SUBROUTINE integrate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s(4) sci = 1 @@ -652,23 +652,23 @@ SUBROUTINE integrate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -677,210 +677,210 @@ SUBROUTINE integrate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s(2) = grid(i, j, k2) s(3) = grid(i, j2, k) s(4) = grid(i, j2, k2) - coef_x(:, 0) = coef_x(:, 0)+s(:)*pol_x(0, ig) - coef_x(:, 1) = coef_x(:, 1)+s(:)*pol_x(1, ig) - coef_x(:, 2) = coef_x(:, 2)+s(:)*pol_x(2, ig) - coef_x(:, 3) = coef_x(:, 3)+s(:)*pol_x(3, ig) - coef_x(:, 4) = coef_x(:, 4)+s(:)*pol_x(4, ig) - coef_x(:, 5) = coef_x(:, 5)+s(:)*pol_x(5, ig) + coef_x(:, 0) = coef_x(:, 0) + s(:)*pol_x(0, ig) + coef_x(:, 1) = coef_x(:, 1) + s(:)*pol_x(1, ig) + coef_x(:, 2) = coef_x(:, 2) + s(:)*pol_x(2, ig) + coef_x(:, 3) = coef_x(:, 3) + s(:)*pol_x(3, ig) + coef_x(:, 4) = coef_x(:, 4) + s(:)*pol_x(4, ig) + coef_x(:, 5) = coef_x(:, 5) + s(:)*pol_x(5, ig) END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 2)*pol_y(1, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 2)*pol_y(1, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 2)*pol_y(2, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 2)*pol_y(2, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(1, 3)*pol_y(1, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(2, 3)*pol_y(1, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(3, 3)*pol_y(2, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(4, 3)*pol_y(2, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(1, 4)*pol_y(1, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(2, 4)*pol_y(1, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(3, 4)*pol_y(2, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(4, 4)*pol_y(2, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(1, 5)*pol_y(1, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(2, 5)*pol_y(1, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(3, 5)*pol_y(2, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(4, 5)*pol_y(2, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(4, 0)*pol_y(2, 1, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(1, 1)*pol_y(1, 1, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(2, 1)*pol_y(1, 1, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(3, 1)*pol_y(2, 1, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(4, 1)*pol_y(2, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(1, 2)*pol_y(1, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(2, 2)*pol_y(1, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(3, 2)*pol_y(2, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(4, 2)*pol_y(2, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(1, 3)*pol_y(1, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(2, 3)*pol_y(1, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(3, 3)*pol_y(2, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(4, 3)*pol_y(2, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(1, 4)*pol_y(1, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(2, 4)*pol_y(1, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(3, 4)*pol_y(2, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(4, 4)*pol_y(2, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(1, 0)*pol_y(1, 2, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(2, 0)*pol_y(1, 2, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(3, 0)*pol_y(2, 2, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(4, 0)*pol_y(2, 2, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(1, 1)*pol_y(1, 2, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(2, 1)*pol_y(1, 2, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(3, 1)*pol_y(2, 2, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(4, 1)*pol_y(2, 2, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(1, 2)*pol_y(1, 2, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(2, 2)*pol_y(1, 2, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(3, 2)*pol_y(2, 2, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(4, 2)*pol_y(2, 2, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(1, 3)*pol_y(1, 2, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(2, 3)*pol_y(1, 2, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(3, 3)*pol_y(2, 2, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(4, 3)*pol_y(2, 2, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(1, 0)*pol_y(1, 3, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(2, 0)*pol_y(1, 3, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(3, 0)*pol_y(2, 3, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(4, 0)*pol_y(2, 3, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(1, 1)*pol_y(1, 3, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(2, 1)*pol_y(1, 3, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(3, 1)*pol_y(2, 3, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(4, 1)*pol_y(2, 3, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(1, 2)*pol_y(1, 3, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(2, 2)*pol_y(1, 3, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(3, 2)*pol_y(2, 3, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(4, 2)*pol_y(2, 3, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(1, 0)*pol_y(1, 4, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(2, 0)*pol_y(1, 4, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(3, 0)*pol_y(2, 4, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(4, 0)*pol_y(2, 4, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(1, 1)*pol_y(1, 4, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(2, 1)*pol_y(1, 4, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(3, 1)*pol_y(2, 4, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(4, 1)*pol_y(2, 4, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(1, 0)*pol_y(1, 5, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(2, 0)*pol_y(1, 5, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(3, 0)*pol_y(2, 5, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(4, 0)*pol_y(2, 5, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 2)*pol_y(1, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 2)*pol_y(1, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 2)*pol_y(2, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 2)*pol_y(2, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(1, 3)*pol_y(1, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(2, 3)*pol_y(1, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(3, 3)*pol_y(2, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(4, 3)*pol_y(2, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(1, 4)*pol_y(1, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(2, 4)*pol_y(1, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(3, 4)*pol_y(2, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(4, 4)*pol_y(2, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(1, 5)*pol_y(1, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(2, 5)*pol_y(1, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(3, 5)*pol_y(2, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(4, 5)*pol_y(2, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(1, 1)*pol_y(1, 1, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(2, 1)*pol_y(1, 1, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(3, 1)*pol_y(2, 1, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(4, 1)*pol_y(2, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(1, 2)*pol_y(1, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(2, 2)*pol_y(1, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(3, 2)*pol_y(2, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(4, 2)*pol_y(2, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(1, 3)*pol_y(1, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(2, 3)*pol_y(1, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(3, 3)*pol_y(2, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(4, 3)*pol_y(2, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(1, 4)*pol_y(1, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(2, 4)*pol_y(1, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(3, 4)*pol_y(2, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(4, 4)*pol_y(2, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(1, 0)*pol_y(1, 2, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(2, 0)*pol_y(1, 2, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(3, 0)*pol_y(2, 2, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(4, 0)*pol_y(2, 2, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(1, 1)*pol_y(1, 2, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(2, 1)*pol_y(1, 2, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(3, 1)*pol_y(2, 2, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(4, 1)*pol_y(2, 2, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(1, 2)*pol_y(1, 2, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(2, 2)*pol_y(1, 2, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(3, 2)*pol_y(2, 2, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(4, 2)*pol_y(2, 2, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(1, 3)*pol_y(1, 2, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(2, 3)*pol_y(1, 2, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(3, 3)*pol_y(2, 2, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(4, 3)*pol_y(2, 2, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(1, 0)*pol_y(1, 3, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(2, 0)*pol_y(1, 3, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(3, 0)*pol_y(2, 3, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(4, 0)*pol_y(2, 3, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(1, 1)*pol_y(1, 3, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(2, 1)*pol_y(1, 3, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(3, 1)*pol_y(2, 3, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(4, 1)*pol_y(2, 3, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(1, 2)*pol_y(1, 3, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(2, 2)*pol_y(1, 3, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(3, 2)*pol_y(2, 3, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(4, 2)*pol_y(2, 3, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(1, 0)*pol_y(1, 4, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(2, 0)*pol_y(1, 4, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(3, 0)*pol_y(2, 4, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(4, 0)*pol_y(2, 4, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(1, 1)*pol_y(1, 4, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(2, 1)*pol_y(1, 4, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(3, 1)*pol_y(2, 4, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(4, 1)*pol_y(2, 4, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(1, 0)*pol_y(1, 5, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(2, 0)*pol_y(1, 5, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(3, 0)*pol_y(2, 5, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(4, 0)*pol_y(2, 5, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 11)*pol_z(1, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 11)*pol_z(2, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 12)*pol_z(1, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 12)*pol_z(2, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 13)*pol_z(1, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 13)*pol_z(2, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 14)*pol_z(1, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 14)*pol_z(2, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 15)*pol_z(1, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 15)*pol_z(2, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 16)*pol_z(1, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 16)*pol_z(2, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 17)*pol_z(1, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 17)*pol_z(2, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 18)*pol_z(1, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 18)*pol_z(2, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 19)*pol_z(1, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 19)*pol_z(2, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 20)*pol_z(1, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 20)*pol_z(2, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(1, 21)*pol_z(1, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(2, 21)*pol_z(2, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(1, 5)*pol_z(1, 1, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(2, 5)*pol_z(2, 1, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(1, 7)*pol_z(1, 1, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(2, 7)*pol_z(2, 1, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(1, 8)*pol_z(1, 1, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(2, 8)*pol_z(2, 1, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(1, 9)*pol_z(1, 1, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(2, 9)*pol_z(2, 1, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(1, 10)*pol_z(1, 1, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(2, 10)*pol_z(2, 1, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(1, 12)*pol_z(1, 1, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(2, 12)*pol_z(2, 1, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(1, 13)*pol_z(1, 1, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(2, 13)*pol_z(2, 1, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(1, 14)*pol_z(1, 1, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(2, 14)*pol_z(2, 1, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(1, 16)*pol_z(1, 1, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(2, 16)*pol_z(2, 1, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(1, 17)*pol_z(1, 1, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(2, 17)*pol_z(2, 1, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(1, 19)*pol_z(1, 1, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(2, 19)*pol_z(2, 1, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(1, 3)*pol_z(1, 2, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(2, 3)*pol_z(2, 2, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(1, 4)*pol_z(1, 2, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(2, 4)*pol_z(2, 2, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(1, 7)*pol_z(1, 2, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(2, 7)*pol_z(2, 2, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(1, 8)*pol_z(1, 2, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(2, 8)*pol_z(2, 2, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(1, 9)*pol_z(1, 2, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(2, 9)*pol_z(2, 2, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(1, 12)*pol_z(1, 2, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(2, 12)*pol_z(2, 2, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(1, 13)*pol_z(1, 2, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(2, 13)*pol_z(2, 2, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(1, 16)*pol_z(1, 2, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(2, 16)*pol_z(2, 2, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(2, 1)*pol_z(2, 3, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(1, 2)*pol_z(1, 3, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(2, 2)*pol_z(2, 3, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(1, 3)*pol_z(1, 3, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(2, 3)*pol_z(2, 3, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(1, 7)*pol_z(1, 3, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(2, 7)*pol_z(2, 3, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(1, 8)*pol_z(1, 3, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(2, 8)*pol_z(2, 3, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(1, 12)*pol_z(1, 3, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(2, 12)*pol_z(2, 3, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(1, 1)*pol_z(1, 4, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(2, 1)*pol_z(2, 4, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(1, 2)*pol_z(1, 4, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(2, 2)*pol_z(2, 4, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(1, 7)*pol_z(1, 4, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(2, 7)*pol_z(2, 4, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(1, 1)*pol_z(1, 5, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(2, 1)*pol_z(2, 5, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 11)*pol_z(1, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 11)*pol_z(2, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 12)*pol_z(1, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 12)*pol_z(2, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 13)*pol_z(1, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 13)*pol_z(2, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 14)*pol_z(1, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 14)*pol_z(2, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 15)*pol_z(1, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 15)*pol_z(2, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 16)*pol_z(1, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 16)*pol_z(2, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 17)*pol_z(1, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 17)*pol_z(2, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 18)*pol_z(1, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 18)*pol_z(2, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 19)*pol_z(1, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 19)*pol_z(2, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 20)*pol_z(1, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 20)*pol_z(2, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(1, 21)*pol_z(1, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(2, 21)*pol_z(2, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(1, 5)*pol_z(1, 1, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(2, 5)*pol_z(2, 1, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(1, 7)*pol_z(1, 1, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(2, 7)*pol_z(2, 1, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(1, 8)*pol_z(1, 1, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(2, 8)*pol_z(2, 1, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(1, 9)*pol_z(1, 1, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(2, 9)*pol_z(2, 1, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(1, 10)*pol_z(1, 1, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(2, 10)*pol_z(2, 1, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(1, 12)*pol_z(1, 1, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(2, 12)*pol_z(2, 1, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(1, 13)*pol_z(1, 1, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(2, 13)*pol_z(2, 1, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(1, 14)*pol_z(1, 1, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(2, 14)*pol_z(2, 1, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(1, 16)*pol_z(1, 1, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(2, 16)*pol_z(2, 1, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(1, 17)*pol_z(1, 1, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(2, 17)*pol_z(2, 1, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(1, 19)*pol_z(1, 1, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(2, 19)*pol_z(2, 1, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(1, 3)*pol_z(1, 2, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(2, 3)*pol_z(2, 2, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(1, 4)*pol_z(1, 2, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(2, 4)*pol_z(2, 2, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(1, 7)*pol_z(1, 2, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(2, 7)*pol_z(2, 2, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(1, 8)*pol_z(1, 2, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(2, 8)*pol_z(2, 2, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(1, 9)*pol_z(1, 2, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(2, 9)*pol_z(2, 2, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(1, 12)*pol_z(1, 2, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(2, 12)*pol_z(2, 2, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(1, 13)*pol_z(1, 2, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(2, 13)*pol_z(2, 2, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(1, 16)*pol_z(1, 2, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(2, 16)*pol_z(2, 2, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(1, 2)*pol_z(1, 3, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(2, 2)*pol_z(2, 3, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(1, 3)*pol_z(1, 3, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(2, 3)*pol_z(2, 3, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(1, 7)*pol_z(1, 3, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(2, 7)*pol_z(2, 3, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(1, 8)*pol_z(1, 3, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(2, 8)*pol_z(2, 3, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(1, 12)*pol_z(1, 3, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(2, 12)*pol_z(2, 3, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(1, 1)*pol_z(1, 4, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(2, 1)*pol_z(2, 4, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(1, 2)*pol_z(1, 4, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(2, 2)*pol_z(2, 4, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(1, 7)*pol_z(1, 4, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(2, 7)*pol_z(2, 4, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(1, 1)*pol_z(1, 5, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(2, 1)*pol_z(2, 5, kg) END DO END SUBROUTINE integrate_core_5 @@ -907,13 +907,13 @@ SUBROUTINE integrate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s(4) sci = 1 @@ -921,23 +921,23 @@ SUBROUTINE integrate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -946,295 +946,295 @@ SUBROUTINE integrate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s(2) = grid(i, j, k2) s(3) = grid(i, j2, k) s(4) = grid(i, j2, k2) - coef_x(:, 0) = coef_x(:, 0)+s(:)*pol_x(0, ig) - coef_x(:, 1) = coef_x(:, 1)+s(:)*pol_x(1, ig) - coef_x(:, 2) = coef_x(:, 2)+s(:)*pol_x(2, ig) - coef_x(:, 3) = coef_x(:, 3)+s(:)*pol_x(3, ig) - coef_x(:, 4) = coef_x(:, 4)+s(:)*pol_x(4, ig) - coef_x(:, 5) = coef_x(:, 5)+s(:)*pol_x(5, ig) - coef_x(:, 6) = coef_x(:, 6)+s(:)*pol_x(6, ig) + coef_x(:, 0) = coef_x(:, 0) + s(:)*pol_x(0, ig) + coef_x(:, 1) = coef_x(:, 1) + s(:)*pol_x(1, ig) + coef_x(:, 2) = coef_x(:, 2) + s(:)*pol_x(2, ig) + coef_x(:, 3) = coef_x(:, 3) + s(:)*pol_x(3, ig) + coef_x(:, 4) = coef_x(:, 4) + s(:)*pol_x(4, ig) + coef_x(:, 5) = coef_x(:, 5) + s(:)*pol_x(5, ig) + coef_x(:, 6) = coef_x(:, 6) + s(:)*pol_x(6, ig) END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 2)*pol_y(1, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 2)*pol_y(1, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 2)*pol_y(2, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 2)*pol_y(2, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(1, 3)*pol_y(1, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(2, 3)*pol_y(1, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(3, 3)*pol_y(2, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(4, 3)*pol_y(2, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(1, 4)*pol_y(1, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(2, 4)*pol_y(1, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(3, 4)*pol_y(2, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(4, 4)*pol_y(2, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(1, 5)*pol_y(1, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(2, 5)*pol_y(1, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(3, 5)*pol_y(2, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(4, 5)*pol_y(2, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(1, 6)*pol_y(1, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(2, 6)*pol_y(1, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(3, 6)*pol_y(2, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(4, 6)*pol_y(2, 0, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(4, 0)*pol_y(2, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(1, 1)*pol_y(1, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(2, 1)*pol_y(1, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(3, 1)*pol_y(2, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(4, 1)*pol_y(2, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(1, 2)*pol_y(1, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(2, 2)*pol_y(1, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(3, 2)*pol_y(2, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(4, 2)*pol_y(2, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(1, 3)*pol_y(1, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(2, 3)*pol_y(1, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(3, 3)*pol_y(2, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(4, 3)*pol_y(2, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(1, 4)*pol_y(1, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(2, 4)*pol_y(1, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(3, 4)*pol_y(2, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(4, 4)*pol_y(2, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(1, 5)*pol_y(1, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(2, 5)*pol_y(1, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(3, 5)*pol_y(2, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(4, 5)*pol_y(2, 1, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(1, 0)*pol_y(1, 2, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(2, 0)*pol_y(1, 2, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(3, 0)*pol_y(2, 2, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(4, 0)*pol_y(2, 2, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(1, 1)*pol_y(1, 2, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(2, 1)*pol_y(1, 2, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(3, 1)*pol_y(2, 2, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(4, 1)*pol_y(2, 2, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(1, 2)*pol_y(1, 2, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(2, 2)*pol_y(1, 2, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(3, 2)*pol_y(2, 2, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(4, 2)*pol_y(2, 2, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(1, 3)*pol_y(1, 2, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(2, 3)*pol_y(1, 2, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(3, 3)*pol_y(2, 2, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(4, 3)*pol_y(2, 2, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(1, 4)*pol_y(1, 2, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(2, 4)*pol_y(1, 2, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(3, 4)*pol_y(2, 2, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(4, 4)*pol_y(2, 2, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(1, 0)*pol_y(1, 3, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(2, 0)*pol_y(1, 3, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(3, 0)*pol_y(2, 3, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(4, 0)*pol_y(2, 3, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(1, 1)*pol_y(1, 3, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(2, 1)*pol_y(1, 3, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(3, 1)*pol_y(2, 3, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(4, 1)*pol_y(2, 3, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(1, 2)*pol_y(1, 3, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(2, 2)*pol_y(1, 3, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(3, 2)*pol_y(2, 3, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(4, 2)*pol_y(2, 3, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(1, 3)*pol_y(1, 3, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(2, 3)*pol_y(1, 3, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(3, 3)*pol_y(2, 3, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(4, 3)*pol_y(2, 3, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(1, 0)*pol_y(1, 4, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(2, 0)*pol_y(1, 4, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(3, 0)*pol_y(2, 4, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(4, 0)*pol_y(2, 4, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(1, 1)*pol_y(1, 4, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(2, 1)*pol_y(1, 4, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(3, 1)*pol_y(2, 4, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(4, 1)*pol_y(2, 4, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(1, 2)*pol_y(1, 4, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(2, 2)*pol_y(1, 4, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(3, 2)*pol_y(2, 4, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(4, 2)*pol_y(2, 4, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(1, 0)*pol_y(1, 5, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(2, 0)*pol_y(1, 5, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(3, 0)*pol_y(2, 5, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(4, 0)*pol_y(2, 5, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(1, 1)*pol_y(1, 5, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(2, 1)*pol_y(1, 5, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(3, 1)*pol_y(2, 5, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(4, 1)*pol_y(2, 5, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(1, 0)*pol_y(1, 6, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(2, 0)*pol_y(1, 6, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(3, 0)*pol_y(2, 6, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(4, 0)*pol_y(2, 6, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 2)*pol_y(1, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 2)*pol_y(1, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 2)*pol_y(2, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 2)*pol_y(2, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(1, 3)*pol_y(1, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(2, 3)*pol_y(1, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(3, 3)*pol_y(2, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(4, 3)*pol_y(2, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(1, 4)*pol_y(1, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(2, 4)*pol_y(1, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(3, 4)*pol_y(2, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(4, 4)*pol_y(2, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(1, 5)*pol_y(1, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(2, 5)*pol_y(1, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(3, 5)*pol_y(2, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(4, 5)*pol_y(2, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(1, 6)*pol_y(1, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(2, 6)*pol_y(1, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(3, 6)*pol_y(2, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(4, 6)*pol_y(2, 0, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(1, 1)*pol_y(1, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(2, 1)*pol_y(1, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(3, 1)*pol_y(2, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(4, 1)*pol_y(2, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(1, 2)*pol_y(1, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(2, 2)*pol_y(1, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(3, 2)*pol_y(2, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(4, 2)*pol_y(2, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(1, 3)*pol_y(1, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(2, 3)*pol_y(1, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(3, 3)*pol_y(2, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(4, 3)*pol_y(2, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(1, 4)*pol_y(1, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(2, 4)*pol_y(1, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(3, 4)*pol_y(2, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(4, 4)*pol_y(2, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(1, 5)*pol_y(1, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(2, 5)*pol_y(1, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(3, 5)*pol_y(2, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(4, 5)*pol_y(2, 1, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(1, 0)*pol_y(1, 2, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(2, 0)*pol_y(1, 2, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(3, 0)*pol_y(2, 2, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(4, 0)*pol_y(2, 2, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(1, 1)*pol_y(1, 2, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(2, 1)*pol_y(1, 2, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(3, 1)*pol_y(2, 2, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(4, 1)*pol_y(2, 2, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(1, 2)*pol_y(1, 2, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(2, 2)*pol_y(1, 2, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(3, 2)*pol_y(2, 2, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(4, 2)*pol_y(2, 2, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(1, 3)*pol_y(1, 2, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(2, 3)*pol_y(1, 2, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(3, 3)*pol_y(2, 2, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(4, 3)*pol_y(2, 2, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(1, 4)*pol_y(1, 2, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(2, 4)*pol_y(1, 2, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(3, 4)*pol_y(2, 2, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(4, 4)*pol_y(2, 2, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(1, 0)*pol_y(1, 3, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(2, 0)*pol_y(1, 3, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(3, 0)*pol_y(2, 3, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(4, 0)*pol_y(2, 3, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(1, 1)*pol_y(1, 3, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(2, 1)*pol_y(1, 3, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(3, 1)*pol_y(2, 3, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(4, 1)*pol_y(2, 3, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(1, 2)*pol_y(1, 3, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(2, 2)*pol_y(1, 3, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(3, 2)*pol_y(2, 3, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(4, 2)*pol_y(2, 3, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(1, 3)*pol_y(1, 3, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(2, 3)*pol_y(1, 3, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(3, 3)*pol_y(2, 3, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(4, 3)*pol_y(2, 3, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(1, 0)*pol_y(1, 4, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(2, 0)*pol_y(1, 4, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(3, 0)*pol_y(2, 4, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(4, 0)*pol_y(2, 4, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(1, 1)*pol_y(1, 4, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(2, 1)*pol_y(1, 4, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(3, 1)*pol_y(2, 4, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(4, 1)*pol_y(2, 4, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(1, 2)*pol_y(1, 4, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(2, 2)*pol_y(1, 4, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(3, 2)*pol_y(2, 4, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(4, 2)*pol_y(2, 4, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(1, 0)*pol_y(1, 5, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(2, 0)*pol_y(1, 5, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(3, 0)*pol_y(2, 5, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(4, 0)*pol_y(2, 5, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(1, 1)*pol_y(1, 5, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(2, 1)*pol_y(1, 5, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(3, 1)*pol_y(2, 5, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(4, 1)*pol_y(2, 5, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(1, 0)*pol_y(1, 6, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(2, 0)*pol_y(1, 6, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(3, 0)*pol_y(2, 6, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(4, 0)*pol_y(2, 6, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 11)*pol_z(1, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 11)*pol_z(2, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 12)*pol_z(1, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 12)*pol_z(2, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 13)*pol_z(1, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 13)*pol_z(2, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 14)*pol_z(1, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 14)*pol_z(2, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 15)*pol_z(1, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 15)*pol_z(2, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 16)*pol_z(1, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 16)*pol_z(2, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 17)*pol_z(1, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 17)*pol_z(2, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 18)*pol_z(1, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 18)*pol_z(2, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 19)*pol_z(1, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 19)*pol_z(2, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 20)*pol_z(1, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 20)*pol_z(2, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(1, 21)*pol_z(1, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(2, 21)*pol_z(2, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(1, 22)*pol_z(1, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(2, 22)*pol_z(2, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(1, 23)*pol_z(1, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(2, 23)*pol_z(2, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(1, 24)*pol_z(1, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(2, 24)*pol_z(2, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(1, 25)*pol_z(1, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(2, 25)*pol_z(2, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(1, 26)*pol_z(1, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(2, 26)*pol_z(2, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(1, 27)*pol_z(1, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(2, 27)*pol_z(2, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(1, 28)*pol_z(1, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(2, 28)*pol_z(2, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(1, 5)*pol_z(1, 1, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(2, 5)*pol_z(2, 1, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(1, 8)*pol_z(1, 1, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(2, 8)*pol_z(2, 1, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(1, 9)*pol_z(1, 1, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(2, 9)*pol_z(2, 1, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(1, 10)*pol_z(1, 1, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(2, 10)*pol_z(2, 1, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(1, 11)*pol_z(1, 1, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(2, 11)*pol_z(2, 1, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(1, 12)*pol_z(1, 1, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(2, 12)*pol_z(2, 1, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(1, 14)*pol_z(1, 1, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(2, 14)*pol_z(2, 1, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(1, 15)*pol_z(1, 1, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(2, 15)*pol_z(2, 1, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(1, 16)*pol_z(1, 1, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(2, 16)*pol_z(2, 1, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(1, 17)*pol_z(1, 1, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(2, 17)*pol_z(2, 1, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(1, 19)*pol_z(1, 1, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(2, 19)*pol_z(2, 1, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(1, 20)*pol_z(1, 1, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(2, 20)*pol_z(2, 1, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(1, 21)*pol_z(1, 1, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(2, 21)*pol_z(2, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(1, 23)*pol_z(1, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(2, 23)*pol_z(2, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(1, 24)*pol_z(1, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(2, 24)*pol_z(2, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(1, 26)*pol_z(1, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(2, 26)*pol_z(2, 1, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(1, 3)*pol_z(1, 2, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(2, 3)*pol_z(2, 2, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(1, 4)*pol_z(1, 2, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(2, 4)*pol_z(2, 2, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(1, 5)*pol_z(1, 2, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(2, 5)*pol_z(2, 2, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(1, 8)*pol_z(1, 2, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(2, 8)*pol_z(2, 2, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(1, 9)*pol_z(1, 2, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(2, 9)*pol_z(2, 2, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(1, 10)*pol_z(1, 2, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(2, 10)*pol_z(2, 2, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(1, 11)*pol_z(1, 2, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(2, 11)*pol_z(2, 2, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(1, 14)*pol_z(1, 2, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(2, 14)*pol_z(2, 2, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(1, 15)*pol_z(1, 2, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(2, 15)*pol_z(2, 2, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(1, 16)*pol_z(1, 2, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(2, 16)*pol_z(2, 2, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(1, 19)*pol_z(1, 2, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(2, 19)*pol_z(2, 2, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(1, 20)*pol_z(1, 2, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(2, 20)*pol_z(2, 2, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(1, 23)*pol_z(1, 2, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(2, 23)*pol_z(2, 2, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(2, 1)*pol_z(2, 3, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(1, 2)*pol_z(1, 3, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(2, 2)*pol_z(2, 3, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(1, 3)*pol_z(1, 3, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(2, 3)*pol_z(2, 3, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(1, 4)*pol_z(1, 3, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(2, 4)*pol_z(2, 3, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(1, 8)*pol_z(1, 3, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(2, 8)*pol_z(2, 3, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(1, 9)*pol_z(1, 3, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(2, 9)*pol_z(2, 3, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(1, 10)*pol_z(1, 3, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(2, 10)*pol_z(2, 3, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(1, 14)*pol_z(1, 3, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(2, 14)*pol_z(2, 3, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(1, 15)*pol_z(1, 3, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(2, 15)*pol_z(2, 3, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(1, 19)*pol_z(1, 3, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(2, 19)*pol_z(2, 3, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(1, 1)*pol_z(1, 4, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(2, 1)*pol_z(2, 4, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(1, 2)*pol_z(1, 4, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(2, 2)*pol_z(2, 4, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(1, 3)*pol_z(1, 4, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(2, 3)*pol_z(2, 4, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(1, 8)*pol_z(1, 4, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(2, 8)*pol_z(2, 4, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(1, 9)*pol_z(1, 4, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(2, 9)*pol_z(2, 4, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(1, 14)*pol_z(1, 4, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(2, 14)*pol_z(2, 4, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(1, 1)*pol_z(1, 5, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(2, 1)*pol_z(2, 5, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(1, 2)*pol_z(1, 5, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(2, 2)*pol_z(2, 5, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(1, 8)*pol_z(1, 5, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(2, 8)*pol_z(2, 5, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(1, 1)*pol_z(1, 6, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(2, 1)*pol_z(2, 6, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 11)*pol_z(1, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 11)*pol_z(2, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 12)*pol_z(1, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 12)*pol_z(2, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 13)*pol_z(1, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 13)*pol_z(2, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 14)*pol_z(1, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 14)*pol_z(2, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 15)*pol_z(1, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 15)*pol_z(2, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 16)*pol_z(1, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 16)*pol_z(2, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 17)*pol_z(1, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 17)*pol_z(2, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 18)*pol_z(1, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 18)*pol_z(2, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 19)*pol_z(1, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 19)*pol_z(2, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 20)*pol_z(1, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 20)*pol_z(2, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(1, 21)*pol_z(1, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(2, 21)*pol_z(2, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(1, 22)*pol_z(1, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(2, 22)*pol_z(2, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(1, 23)*pol_z(1, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(2, 23)*pol_z(2, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(1, 24)*pol_z(1, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(2, 24)*pol_z(2, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(1, 25)*pol_z(1, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(2, 25)*pol_z(2, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(1, 26)*pol_z(1, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(2, 26)*pol_z(2, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(1, 27)*pol_z(1, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(2, 27)*pol_z(2, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(1, 28)*pol_z(1, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(2, 28)*pol_z(2, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(1, 5)*pol_z(1, 1, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(2, 5)*pol_z(2, 1, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(1, 8)*pol_z(1, 1, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(2, 8)*pol_z(2, 1, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(1, 9)*pol_z(1, 1, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(2, 9)*pol_z(2, 1, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(1, 10)*pol_z(1, 1, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(2, 10)*pol_z(2, 1, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(1, 11)*pol_z(1, 1, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(2, 11)*pol_z(2, 1, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(1, 12)*pol_z(1, 1, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(2, 12)*pol_z(2, 1, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(1, 14)*pol_z(1, 1, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(2, 14)*pol_z(2, 1, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(1, 15)*pol_z(1, 1, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(2, 15)*pol_z(2, 1, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(1, 16)*pol_z(1, 1, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(2, 16)*pol_z(2, 1, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(1, 17)*pol_z(1, 1, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(2, 17)*pol_z(2, 1, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(1, 19)*pol_z(1, 1, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(2, 19)*pol_z(2, 1, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(1, 20)*pol_z(1, 1, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(2, 20)*pol_z(2, 1, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(1, 21)*pol_z(1, 1, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(2, 21)*pol_z(2, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(1, 23)*pol_z(1, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(2, 23)*pol_z(2, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(1, 24)*pol_z(1, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(2, 24)*pol_z(2, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(1, 26)*pol_z(1, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(2, 26)*pol_z(2, 1, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(1, 3)*pol_z(1, 2, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(2, 3)*pol_z(2, 2, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(1, 4)*pol_z(1, 2, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(2, 4)*pol_z(2, 2, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(1, 5)*pol_z(1, 2, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(2, 5)*pol_z(2, 2, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(1, 8)*pol_z(1, 2, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(2, 8)*pol_z(2, 2, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(1, 9)*pol_z(1, 2, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(2, 9)*pol_z(2, 2, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(1, 10)*pol_z(1, 2, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(2, 10)*pol_z(2, 2, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(1, 11)*pol_z(1, 2, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(2, 11)*pol_z(2, 2, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(1, 14)*pol_z(1, 2, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(2, 14)*pol_z(2, 2, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(1, 15)*pol_z(1, 2, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(2, 15)*pol_z(2, 2, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(1, 16)*pol_z(1, 2, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(2, 16)*pol_z(2, 2, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(1, 19)*pol_z(1, 2, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(2, 19)*pol_z(2, 2, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(1, 20)*pol_z(1, 2, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(2, 20)*pol_z(2, 2, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(1, 23)*pol_z(1, 2, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(2, 23)*pol_z(2, 2, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(1, 2)*pol_z(1, 3, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(2, 2)*pol_z(2, 3, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(1, 3)*pol_z(1, 3, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(2, 3)*pol_z(2, 3, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(1, 4)*pol_z(1, 3, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(2, 4)*pol_z(2, 3, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(1, 8)*pol_z(1, 3, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(2, 8)*pol_z(2, 3, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(1, 9)*pol_z(1, 3, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(2, 9)*pol_z(2, 3, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(1, 10)*pol_z(1, 3, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(2, 10)*pol_z(2, 3, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(1, 14)*pol_z(1, 3, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(2, 14)*pol_z(2, 3, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(1, 15)*pol_z(1, 3, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(2, 15)*pol_z(2, 3, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(1, 19)*pol_z(1, 3, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(2, 19)*pol_z(2, 3, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(1, 1)*pol_z(1, 4, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(2, 1)*pol_z(2, 4, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(1, 2)*pol_z(1, 4, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(2, 2)*pol_z(2, 4, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(1, 3)*pol_z(1, 4, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(2, 3)*pol_z(2, 4, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(1, 8)*pol_z(1, 4, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(2, 8)*pol_z(2, 4, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(1, 9)*pol_z(1, 4, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(2, 9)*pol_z(2, 4, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(1, 14)*pol_z(1, 4, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(2, 14)*pol_z(2, 4, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(1, 1)*pol_z(1, 5, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(2, 1)*pol_z(2, 5, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(1, 2)*pol_z(1, 5, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(2, 2)*pol_z(2, 5, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(1, 8)*pol_z(1, 5, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(2, 8)*pol_z(2, 5, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(1, 1)*pol_z(1, 6, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(2, 1)*pol_z(2, 6, kg) END DO END SUBROUTINE integrate_core_6 @@ -1261,13 +1261,13 @@ SUBROUTINE integrate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s(4) sci = 1 @@ -1275,23 +1275,23 @@ SUBROUTINE integrate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -1300,328 +1300,328 @@ SUBROUTINE integrate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s(2) = grid(i, j, k2) s(3) = grid(i, j2, k) s(4) = grid(i, j2, k2) - coef_x(:, 0) = coef_x(:, 0)+s(:)*pol_x(0, ig) - coef_x(:, 1) = coef_x(:, 1)+s(:)*pol_x(1, ig) - coef_x(:, 2) = coef_x(:, 2)+s(:)*pol_x(2, ig) - coef_x(:, 3) = coef_x(:, 3)+s(:)*pol_x(3, ig) - coef_x(:, 4) = coef_x(:, 4)+s(:)*pol_x(4, ig) - coef_x(:, 5) = coef_x(:, 5)+s(:)*pol_x(5, ig) - coef_x(:, 6) = coef_x(:, 6)+s(:)*pol_x(6, ig) - coef_x(:, 7) = coef_x(:, 7)+s(:)*pol_x(7, ig) + coef_x(:, 0) = coef_x(:, 0) + s(:)*pol_x(0, ig) + coef_x(:, 1) = coef_x(:, 1) + s(:)*pol_x(1, ig) + coef_x(:, 2) = coef_x(:, 2) + s(:)*pol_x(2, ig) + coef_x(:, 3) = coef_x(:, 3) + s(:)*pol_x(3, ig) + coef_x(:, 4) = coef_x(:, 4) + s(:)*pol_x(4, ig) + coef_x(:, 5) = coef_x(:, 5) + s(:)*pol_x(5, ig) + coef_x(:, 6) = coef_x(:, 6) + s(:)*pol_x(6, ig) + coef_x(:, 7) = coef_x(:, 7) + s(:)*pol_x(7, ig) END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(1:2, 1)*pol_y(1, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(3:4, 1)*pol_y(2, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(1:2, 2)*pol_y(1, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(3:4, 2)*pol_y(2, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(1:2, 3)*pol_y(1, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(3:4, 3)*pol_y(2, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(1:2, 4)*pol_y(1, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(3:4, 4)*pol_y(2, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(1:2, 5)*pol_y(1, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(3:4, 5)*pol_y(2, 0, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(1:2, 6)*pol_y(1, 0, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(3:4, 6)*pol_y(2, 0, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(1:2, 7)*pol_y(1, 0, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(3:4, 7)*pol_y(2, 0, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(1:2, 0)*pol_y(1, 1, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(3:4, 0)*pol_y(2, 1, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(1:2, 1)*pol_y(1, 1, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(3:4, 1)*pol_y(2, 1, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(1:2, 2)*pol_y(1, 1, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(3:4, 2)*pol_y(2, 1, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(1:2, 3)*pol_y(1, 1, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(3:4, 3)*pol_y(2, 1, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(1:2, 4)*pol_y(1, 1, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(3:4, 4)*pol_y(2, 1, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(1:2, 5)*pol_y(1, 1, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(3:4, 5)*pol_y(2, 1, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(1:2, 6)*pol_y(1, 1, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(3:4, 6)*pol_y(2, 1, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(1:2, 0)*pol_y(1, 2, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(3:4, 0)*pol_y(2, 2, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(1:2, 1)*pol_y(1, 2, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(3:4, 1)*pol_y(2, 2, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(1:2, 2)*pol_y(1, 2, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(3:4, 2)*pol_y(2, 2, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(1:2, 3)*pol_y(1, 2, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(3:4, 3)*pol_y(2, 2, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(1:2, 4)*pol_y(1, 2, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(3:4, 4)*pol_y(2, 2, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(1:2, 5)*pol_y(1, 2, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(3:4, 5)*pol_y(2, 2, jg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_x(1:2, 0)*pol_y(1, 3, jg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_x(3:4, 0)*pol_y(2, 3, jg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_x(1:2, 1)*pol_y(1, 3, jg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_x(3:4, 1)*pol_y(2, 3, jg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_x(1:2, 2)*pol_y(1, 3, jg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_x(3:4, 2)*pol_y(2, 3, jg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_x(1:2, 3)*pol_y(1, 3, jg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_x(3:4, 3)*pol_y(2, 3, jg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_x(1:2, 4)*pol_y(1, 3, jg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_x(3:4, 4)*pol_y(2, 3, jg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_x(1:2, 0)*pol_y(1, 4, jg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_x(3:4, 0)*pol_y(2, 4, jg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_x(1:2, 1)*pol_y(1, 4, jg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_x(3:4, 1)*pol_y(2, 4, jg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_x(1:2, 2)*pol_y(1, 4, jg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_x(3:4, 2)*pol_y(2, 4, jg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_x(1:2, 3)*pol_y(1, 4, jg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_x(3:4, 3)*pol_y(2, 4, jg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_x(1:2, 0)*pol_y(1, 5, jg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_x(3:4, 0)*pol_y(2, 5, jg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_x(1:2, 1)*pol_y(1, 5, jg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_x(3:4, 1)*pol_y(2, 5, jg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_x(1:2, 2)*pol_y(1, 5, jg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_x(3:4, 2)*pol_y(2, 5, jg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_x(1:2, 0)*pol_y(1, 6, jg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_x(3:4, 0)*pol_y(2, 6, jg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_x(1:2, 1)*pol_y(1, 6, jg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_x(3:4, 1)*pol_y(2, 6, jg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_x(1:2, 0)*pol_y(1, 7, jg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_x(3:4, 0)*pol_y(2, 7, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(1:2, 1)*pol_y(1, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(3:4, 1)*pol_y(2, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(1:2, 2)*pol_y(1, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(3:4, 2)*pol_y(2, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(1:2, 3)*pol_y(1, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(3:4, 3)*pol_y(2, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(1:2, 4)*pol_y(1, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(3:4, 4)*pol_y(2, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(1:2, 5)*pol_y(1, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(3:4, 5)*pol_y(2, 0, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(1:2, 6)*pol_y(1, 0, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(3:4, 6)*pol_y(2, 0, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(1:2, 7)*pol_y(1, 0, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(3:4, 7)*pol_y(2, 0, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(1:2, 0)*pol_y(1, 1, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(3:4, 0)*pol_y(2, 1, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(1:2, 1)*pol_y(1, 1, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(3:4, 1)*pol_y(2, 1, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(1:2, 2)*pol_y(1, 1, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(3:4, 2)*pol_y(2, 1, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(1:2, 3)*pol_y(1, 1, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(3:4, 3)*pol_y(2, 1, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(1:2, 4)*pol_y(1, 1, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(3:4, 4)*pol_y(2, 1, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(1:2, 5)*pol_y(1, 1, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(3:4, 5)*pol_y(2, 1, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(1:2, 6)*pol_y(1, 1, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(3:4, 6)*pol_y(2, 1, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(1:2, 0)*pol_y(1, 2, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(3:4, 0)*pol_y(2, 2, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(1:2, 1)*pol_y(1, 2, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(3:4, 1)*pol_y(2, 2, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(1:2, 2)*pol_y(1, 2, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(3:4, 2)*pol_y(2, 2, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(1:2, 3)*pol_y(1, 2, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(3:4, 3)*pol_y(2, 2, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(1:2, 4)*pol_y(1, 2, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(3:4, 4)*pol_y(2, 2, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(1:2, 5)*pol_y(1, 2, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(3:4, 5)*pol_y(2, 2, jg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_x(1:2, 0)*pol_y(1, 3, jg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_x(3:4, 0)*pol_y(2, 3, jg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_x(1:2, 1)*pol_y(1, 3, jg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_x(3:4, 1)*pol_y(2, 3, jg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_x(1:2, 2)*pol_y(1, 3, jg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_x(3:4, 2)*pol_y(2, 3, jg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_x(1:2, 3)*pol_y(1, 3, jg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_x(3:4, 3)*pol_y(2, 3, jg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_x(1:2, 4)*pol_y(1, 3, jg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_x(3:4, 4)*pol_y(2, 3, jg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_x(1:2, 0)*pol_y(1, 4, jg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_x(3:4, 0)*pol_y(2, 4, jg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_x(1:2, 1)*pol_y(1, 4, jg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_x(3:4, 1)*pol_y(2, 4, jg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_x(1:2, 2)*pol_y(1, 4, jg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_x(3:4, 2)*pol_y(2, 4, jg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_x(1:2, 3)*pol_y(1, 4, jg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_x(3:4, 3)*pol_y(2, 4, jg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_x(1:2, 0)*pol_y(1, 5, jg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_x(3:4, 0)*pol_y(2, 5, jg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_x(1:2, 1)*pol_y(1, 5, jg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_x(3:4, 1)*pol_y(2, 5, jg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_x(1:2, 2)*pol_y(1, 5, jg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_x(3:4, 2)*pol_y(2, 5, jg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_x(1:2, 0)*pol_y(1, 6, jg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_x(3:4, 0)*pol_y(2, 6, jg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_x(1:2, 1)*pol_y(1, 6, jg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_x(3:4, 1)*pol_y(2, 6, jg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_x(1:2, 0)*pol_y(1, 7, jg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_x(3:4, 0)*pol_y(2, 7, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 11)*pol_z(1, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 11)*pol_z(2, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 12)*pol_z(1, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 12)*pol_z(2, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 13)*pol_z(1, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 13)*pol_z(2, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 14)*pol_z(1, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 14)*pol_z(2, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 15)*pol_z(1, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 15)*pol_z(2, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 16)*pol_z(1, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 16)*pol_z(2, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 17)*pol_z(1, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 17)*pol_z(2, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 18)*pol_z(1, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 18)*pol_z(2, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 19)*pol_z(1, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 19)*pol_z(2, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 20)*pol_z(1, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 20)*pol_z(2, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(1, 21)*pol_z(1, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(2, 21)*pol_z(2, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(1, 22)*pol_z(1, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(2, 22)*pol_z(2, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(1, 23)*pol_z(1, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(2, 23)*pol_z(2, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(1, 24)*pol_z(1, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(2, 24)*pol_z(2, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(1, 25)*pol_z(1, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(2, 25)*pol_z(2, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(1, 26)*pol_z(1, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(2, 26)*pol_z(2, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(1, 27)*pol_z(1, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(2, 27)*pol_z(2, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(1, 28)*pol_z(1, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(2, 28)*pol_z(2, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(1, 29)*pol_z(1, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(2, 29)*pol_z(2, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(1, 30)*pol_z(1, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(2, 30)*pol_z(2, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(1, 31)*pol_z(1, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(2, 31)*pol_z(2, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(1, 32)*pol_z(1, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(2, 32)*pol_z(2, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(1, 33)*pol_z(1, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(2, 33)*pol_z(2, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(1, 34)*pol_z(1, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(2, 34)*pol_z(2, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(1, 35)*pol_z(1, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(2, 35)*pol_z(2, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(1, 36)*pol_z(1, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(2, 36)*pol_z(2, 0, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(1, 5)*pol_z(1, 1, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(2, 5)*pol_z(2, 1, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(1, 7)*pol_z(1, 1, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(2, 7)*pol_z(2, 1, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(1, 9)*pol_z(1, 1, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(2, 9)*pol_z(2, 1, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(1, 10)*pol_z(1, 1, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(2, 10)*pol_z(2, 1, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(1, 11)*pol_z(1, 1, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(2, 11)*pol_z(2, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(1, 12)*pol_z(1, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(2, 12)*pol_z(2, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(1, 13)*pol_z(1, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(2, 13)*pol_z(2, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(1, 14)*pol_z(1, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(2, 14)*pol_z(2, 1, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(1, 16)*pol_z(1, 1, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(2, 16)*pol_z(2, 1, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(1, 17)*pol_z(1, 1, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(2, 17)*pol_z(2, 1, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(1, 18)*pol_z(1, 1, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(2, 18)*pol_z(2, 1, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(1, 19)*pol_z(1, 1, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(2, 19)*pol_z(2, 1, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(1, 20)*pol_z(1, 1, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(2, 20)*pol_z(2, 1, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(1, 22)*pol_z(1, 1, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(2, 22)*pol_z(2, 1, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(1, 23)*pol_z(1, 1, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(2, 23)*pol_z(2, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(1, 24)*pol_z(1, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(2, 24)*pol_z(2, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(1, 25)*pol_z(1, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(2, 25)*pol_z(2, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(1, 27)*pol_z(1, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(2, 27)*pol_z(2, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(1, 28)*pol_z(1, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(2, 28)*pol_z(2, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(1, 29)*pol_z(1, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(2, 29)*pol_z(2, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(1, 31)*pol_z(1, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(2, 31)*pol_z(2, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(1, 32)*pol_z(1, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(2, 32)*pol_z(2, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(1, 34)*pol_z(1, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(2, 34)*pol_z(2, 1, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(1, 3)*pol_z(1, 2, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(2, 3)*pol_z(2, 2, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(1, 4)*pol_z(1, 2, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(2, 4)*pol_z(2, 2, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(1, 5)*pol_z(1, 2, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(2, 5)*pol_z(2, 2, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(1, 6)*pol_z(1, 2, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(2, 6)*pol_z(2, 2, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(1, 9)*pol_z(1, 2, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(2, 9)*pol_z(2, 2, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(1, 10)*pol_z(1, 2, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(2, 10)*pol_z(2, 2, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(1, 11)*pol_z(1, 2, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(2, 11)*pol_z(2, 2, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(1, 12)*pol_z(1, 2, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(2, 12)*pol_z(2, 2, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(1, 13)*pol_z(1, 2, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(2, 13)*pol_z(2, 2, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(1, 16)*pol_z(1, 2, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(2, 16)*pol_z(2, 2, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(1, 17)*pol_z(1, 2, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(2, 17)*pol_z(2, 2, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(1, 18)*pol_z(1, 2, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(2, 18)*pol_z(2, 2, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(1, 19)*pol_z(1, 2, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(2, 19)*pol_z(2, 2, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(1, 22)*pol_z(1, 2, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(2, 22)*pol_z(2, 2, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(1, 23)*pol_z(1, 2, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(2, 23)*pol_z(2, 2, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(1, 24)*pol_z(1, 2, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(2, 24)*pol_z(2, 2, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(1, 27)*pol_z(1, 2, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(2, 27)*pol_z(2, 2, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(1, 28)*pol_z(1, 2, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(2, 28)*pol_z(2, 2, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(1, 31)*pol_z(1, 2, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(2, 31)*pol_z(2, 2, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(2, 1)*pol_z(2, 3, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(1, 2)*pol_z(1, 3, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(2, 2)*pol_z(2, 3, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(1, 3)*pol_z(1, 3, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(2, 3)*pol_z(2, 3, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(1, 4)*pol_z(1, 3, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(2, 4)*pol_z(2, 3, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(1, 5)*pol_z(1, 3, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(2, 5)*pol_z(2, 3, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(1, 9)*pol_z(1, 3, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(2, 9)*pol_z(2, 3, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(1, 10)*pol_z(1, 3, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(2, 10)*pol_z(2, 3, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(1, 11)*pol_z(1, 3, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(2, 11)*pol_z(2, 3, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(1, 12)*pol_z(1, 3, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(2, 12)*pol_z(2, 3, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(1, 16)*pol_z(1, 3, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(2, 16)*pol_z(2, 3, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(1, 17)*pol_z(1, 3, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(2, 17)*pol_z(2, 3, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(1, 18)*pol_z(1, 3, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(2, 18)*pol_z(2, 3, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(1, 22)*pol_z(1, 3, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(2, 22)*pol_z(2, 3, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(1, 23)*pol_z(1, 3, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(2, 23)*pol_z(2, 3, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(1, 27)*pol_z(1, 3, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(2, 27)*pol_z(2, 3, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(1, 1)*pol_z(1, 4, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(2, 1)*pol_z(2, 4, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(1, 2)*pol_z(1, 4, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(2, 2)*pol_z(2, 4, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(1, 3)*pol_z(1, 4, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(2, 3)*pol_z(2, 4, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(1, 4)*pol_z(1, 4, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(2, 4)*pol_z(2, 4, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(1, 9)*pol_z(1, 4, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(2, 9)*pol_z(2, 4, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(1, 10)*pol_z(1, 4, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(2, 10)*pol_z(2, 4, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(1, 11)*pol_z(1, 4, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(2, 11)*pol_z(2, 4, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(1, 16)*pol_z(1, 4, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(2, 16)*pol_z(2, 4, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(1, 17)*pol_z(1, 4, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(2, 17)*pol_z(2, 4, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(1, 22)*pol_z(1, 4, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(2, 22)*pol_z(2, 4, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(1, 1)*pol_z(1, 5, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(2, 1)*pol_z(2, 5, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(1, 2)*pol_z(1, 5, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(2, 2)*pol_z(2, 5, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(1, 3)*pol_z(1, 5, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(2, 3)*pol_z(2, 5, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(1, 9)*pol_z(1, 5, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(2, 9)*pol_z(2, 5, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(1, 10)*pol_z(1, 5, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(2, 10)*pol_z(2, 5, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(1, 16)*pol_z(1, 5, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(2, 16)*pol_z(2, 5, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(1, 1)*pol_z(1, 6, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(2, 1)*pol_z(2, 6, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(1, 2)*pol_z(1, 6, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(2, 2)*pol_z(2, 6, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(1, 9)*pol_z(1, 6, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(2, 9)*pol_z(2, 6, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(1, 1)*pol_z(1, 7, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(2, 1)*pol_z(2, 7, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 11)*pol_z(1, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 11)*pol_z(2, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 12)*pol_z(1, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 12)*pol_z(2, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 13)*pol_z(1, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 13)*pol_z(2, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 14)*pol_z(1, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 14)*pol_z(2, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 15)*pol_z(1, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 15)*pol_z(2, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 16)*pol_z(1, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 16)*pol_z(2, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 17)*pol_z(1, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 17)*pol_z(2, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 18)*pol_z(1, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 18)*pol_z(2, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 19)*pol_z(1, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 19)*pol_z(2, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 20)*pol_z(1, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 20)*pol_z(2, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(1, 21)*pol_z(1, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(2, 21)*pol_z(2, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(1, 22)*pol_z(1, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(2, 22)*pol_z(2, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(1, 23)*pol_z(1, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(2, 23)*pol_z(2, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(1, 24)*pol_z(1, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(2, 24)*pol_z(2, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(1, 25)*pol_z(1, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(2, 25)*pol_z(2, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(1, 26)*pol_z(1, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(2, 26)*pol_z(2, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(1, 27)*pol_z(1, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(2, 27)*pol_z(2, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(1, 28)*pol_z(1, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(2, 28)*pol_z(2, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(1, 29)*pol_z(1, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(2, 29)*pol_z(2, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(1, 30)*pol_z(1, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(2, 30)*pol_z(2, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(1, 31)*pol_z(1, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(2, 31)*pol_z(2, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(1, 32)*pol_z(1, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(2, 32)*pol_z(2, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(1, 33)*pol_z(1, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(2, 33)*pol_z(2, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(1, 34)*pol_z(1, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(2, 34)*pol_z(2, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(1, 35)*pol_z(1, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(2, 35)*pol_z(2, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(1, 36)*pol_z(1, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(2, 36)*pol_z(2, 0, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(1, 5)*pol_z(1, 1, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(2, 5)*pol_z(2, 1, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(1, 7)*pol_z(1, 1, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(2, 7)*pol_z(2, 1, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(1, 9)*pol_z(1, 1, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(2, 9)*pol_z(2, 1, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(1, 10)*pol_z(1, 1, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(2, 10)*pol_z(2, 1, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(1, 11)*pol_z(1, 1, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(2, 11)*pol_z(2, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(1, 12)*pol_z(1, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(2, 12)*pol_z(2, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(1, 13)*pol_z(1, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(2, 13)*pol_z(2, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(1, 14)*pol_z(1, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(2, 14)*pol_z(2, 1, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(1, 16)*pol_z(1, 1, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(2, 16)*pol_z(2, 1, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(1, 17)*pol_z(1, 1, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(2, 17)*pol_z(2, 1, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(1, 18)*pol_z(1, 1, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(2, 18)*pol_z(2, 1, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(1, 19)*pol_z(1, 1, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(2, 19)*pol_z(2, 1, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(1, 20)*pol_z(1, 1, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(2, 20)*pol_z(2, 1, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(1, 22)*pol_z(1, 1, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(2, 22)*pol_z(2, 1, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(1, 23)*pol_z(1, 1, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(2, 23)*pol_z(2, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(1, 24)*pol_z(1, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(2, 24)*pol_z(2, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(1, 25)*pol_z(1, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(2, 25)*pol_z(2, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(1, 27)*pol_z(1, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(2, 27)*pol_z(2, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(1, 28)*pol_z(1, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(2, 28)*pol_z(2, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(1, 29)*pol_z(1, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(2, 29)*pol_z(2, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(1, 31)*pol_z(1, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(2, 31)*pol_z(2, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(1, 32)*pol_z(1, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(2, 32)*pol_z(2, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(1, 34)*pol_z(1, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(2, 34)*pol_z(2, 1, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(1, 3)*pol_z(1, 2, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(2, 3)*pol_z(2, 2, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(1, 4)*pol_z(1, 2, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(2, 4)*pol_z(2, 2, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(1, 5)*pol_z(1, 2, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(2, 5)*pol_z(2, 2, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(1, 6)*pol_z(1, 2, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(2, 6)*pol_z(2, 2, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(1, 9)*pol_z(1, 2, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(2, 9)*pol_z(2, 2, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(1, 10)*pol_z(1, 2, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(2, 10)*pol_z(2, 2, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(1, 11)*pol_z(1, 2, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(2, 11)*pol_z(2, 2, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(1, 12)*pol_z(1, 2, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(2, 12)*pol_z(2, 2, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(1, 13)*pol_z(1, 2, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(2, 13)*pol_z(2, 2, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(1, 16)*pol_z(1, 2, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(2, 16)*pol_z(2, 2, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(1, 17)*pol_z(1, 2, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(2, 17)*pol_z(2, 2, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(1, 18)*pol_z(1, 2, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(2, 18)*pol_z(2, 2, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(1, 19)*pol_z(1, 2, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(2, 19)*pol_z(2, 2, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(1, 22)*pol_z(1, 2, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(2, 22)*pol_z(2, 2, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(1, 23)*pol_z(1, 2, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(2, 23)*pol_z(2, 2, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(1, 24)*pol_z(1, 2, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(2, 24)*pol_z(2, 2, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(1, 27)*pol_z(1, 2, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(2, 27)*pol_z(2, 2, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(1, 28)*pol_z(1, 2, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(2, 28)*pol_z(2, 2, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(1, 31)*pol_z(1, 2, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(2, 31)*pol_z(2, 2, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(1, 2)*pol_z(1, 3, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(2, 2)*pol_z(2, 3, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(1, 3)*pol_z(1, 3, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(2, 3)*pol_z(2, 3, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(1, 4)*pol_z(1, 3, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(2, 4)*pol_z(2, 3, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(1, 5)*pol_z(1, 3, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(2, 5)*pol_z(2, 3, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(1, 9)*pol_z(1, 3, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(2, 9)*pol_z(2, 3, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(1, 10)*pol_z(1, 3, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(2, 10)*pol_z(2, 3, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(1, 11)*pol_z(1, 3, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(2, 11)*pol_z(2, 3, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(1, 12)*pol_z(1, 3, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(2, 12)*pol_z(2, 3, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(1, 16)*pol_z(1, 3, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(2, 16)*pol_z(2, 3, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(1, 17)*pol_z(1, 3, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(2, 17)*pol_z(2, 3, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(1, 18)*pol_z(1, 3, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(2, 18)*pol_z(2, 3, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(1, 22)*pol_z(1, 3, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(2, 22)*pol_z(2, 3, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(1, 23)*pol_z(1, 3, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(2, 23)*pol_z(2, 3, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(1, 27)*pol_z(1, 3, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(2, 27)*pol_z(2, 3, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(1, 1)*pol_z(1, 4, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(2, 1)*pol_z(2, 4, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(1, 2)*pol_z(1, 4, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(2, 2)*pol_z(2, 4, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(1, 3)*pol_z(1, 4, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(2, 3)*pol_z(2, 4, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(1, 4)*pol_z(1, 4, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(2, 4)*pol_z(2, 4, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(1, 9)*pol_z(1, 4, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(2, 9)*pol_z(2, 4, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(1, 10)*pol_z(1, 4, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(2, 10)*pol_z(2, 4, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(1, 11)*pol_z(1, 4, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(2, 11)*pol_z(2, 4, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(1, 16)*pol_z(1, 4, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(2, 16)*pol_z(2, 4, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(1, 17)*pol_z(1, 4, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(2, 17)*pol_z(2, 4, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(1, 22)*pol_z(1, 4, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(2, 22)*pol_z(2, 4, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(1, 1)*pol_z(1, 5, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(2, 1)*pol_z(2, 5, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(1, 2)*pol_z(1, 5, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(2, 2)*pol_z(2, 5, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(1, 3)*pol_z(1, 5, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(2, 3)*pol_z(2, 5, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(1, 9)*pol_z(1, 5, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(2, 9)*pol_z(2, 5, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(1, 10)*pol_z(1, 5, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(2, 10)*pol_z(2, 5, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(1, 16)*pol_z(1, 5, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(2, 16)*pol_z(2, 5, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(1, 1)*pol_z(1, 6, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(2, 1)*pol_z(2, 6, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(1, 2)*pol_z(1, 6, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(2, 2)*pol_z(2, 6, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(1, 9)*pol_z(1, 6, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(2, 9)*pol_z(2, 6, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(1, 1)*pol_z(1, 7, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(2, 1)*pol_z(2, 7, kg) END DO END SUBROUTINE integrate_core_7 @@ -1648,13 +1648,13 @@ SUBROUTINE integrate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s(4) sci = 1 @@ -1662,23 +1662,23 @@ SUBROUTINE integrate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -1687,437 +1687,437 @@ SUBROUTINE integrate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s(2) = grid(i, j, k2) s(3) = grid(i, j2, k) s(4) = grid(i, j2, k2) - coef_x(:, 0) = coef_x(:, 0)+s(:)*pol_x(0, ig) - coef_x(:, 1) = coef_x(:, 1)+s(:)*pol_x(1, ig) - coef_x(:, 2) = coef_x(:, 2)+s(:)*pol_x(2, ig) - coef_x(:, 3) = coef_x(:, 3)+s(:)*pol_x(3, ig) - coef_x(:, 4) = coef_x(:, 4)+s(:)*pol_x(4, ig) - coef_x(:, 5) = coef_x(:, 5)+s(:)*pol_x(5, ig) - coef_x(:, 6) = coef_x(:, 6)+s(:)*pol_x(6, ig) - coef_x(:, 7) = coef_x(:, 7)+s(:)*pol_x(7, ig) - coef_x(:, 8) = coef_x(:, 8)+s(:)*pol_x(8, ig) + coef_x(:, 0) = coef_x(:, 0) + s(:)*pol_x(0, ig) + coef_x(:, 1) = coef_x(:, 1) + s(:)*pol_x(1, ig) + coef_x(:, 2) = coef_x(:, 2) + s(:)*pol_x(2, ig) + coef_x(:, 3) = coef_x(:, 3) + s(:)*pol_x(3, ig) + coef_x(:, 4) = coef_x(:, 4) + s(:)*pol_x(4, ig) + coef_x(:, 5) = coef_x(:, 5) + s(:)*pol_x(5, ig) + coef_x(:, 6) = coef_x(:, 6) + s(:)*pol_x(6, ig) + coef_x(:, 7) = coef_x(:, 7) + s(:)*pol_x(7, ig) + coef_x(:, 8) = coef_x(:, 8) + s(:)*pol_x(8, ig) END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(1:2, 1)*pol_y(1, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(3:4, 1)*pol_y(2, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(1:2, 2)*pol_y(1, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(3:4, 2)*pol_y(2, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(1:2, 3)*pol_y(1, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(3:4, 3)*pol_y(2, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(1:2, 4)*pol_y(1, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(3:4, 4)*pol_y(2, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(1:2, 5)*pol_y(1, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(3:4, 5)*pol_y(2, 0, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(1:2, 6)*pol_y(1, 0, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(3:4, 6)*pol_y(2, 0, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(1:2, 7)*pol_y(1, 0, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(3:4, 7)*pol_y(2, 0, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(1:2, 8)*pol_y(1, 0, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(3:4, 8)*pol_y(2, 0, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(1:2, 0)*pol_y(1, 1, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(3:4, 0)*pol_y(2, 1, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(1:2, 1)*pol_y(1, 1, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(3:4, 1)*pol_y(2, 1, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(1:2, 2)*pol_y(1, 1, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(3:4, 2)*pol_y(2, 1, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(1:2, 3)*pol_y(1, 1, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(3:4, 3)*pol_y(2, 1, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(1:2, 4)*pol_y(1, 1, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(3:4, 4)*pol_y(2, 1, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(1:2, 5)*pol_y(1, 1, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(3:4, 5)*pol_y(2, 1, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(1:2, 6)*pol_y(1, 1, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(3:4, 6)*pol_y(2, 1, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(1:2, 7)*pol_y(1, 1, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(3:4, 7)*pol_y(2, 1, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(1:2, 0)*pol_y(1, 2, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(3:4, 0)*pol_y(2, 2, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(1:2, 1)*pol_y(1, 2, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(3:4, 1)*pol_y(2, 2, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(1:2, 2)*pol_y(1, 2, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(3:4, 2)*pol_y(2, 2, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(1:2, 3)*pol_y(1, 2, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(3:4, 3)*pol_y(2, 2, jg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_x(1:2, 4)*pol_y(1, 2, jg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_x(3:4, 4)*pol_y(2, 2, jg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_x(1:2, 5)*pol_y(1, 2, jg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_x(3:4, 5)*pol_y(2, 2, jg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_x(1:2, 6)*pol_y(1, 2, jg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_x(3:4, 6)*pol_y(2, 2, jg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_x(1:2, 0)*pol_y(1, 3, jg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_x(3:4, 0)*pol_y(2, 3, jg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_x(1:2, 1)*pol_y(1, 3, jg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_x(3:4, 1)*pol_y(2, 3, jg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_x(1:2, 2)*pol_y(1, 3, jg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_x(3:4, 2)*pol_y(2, 3, jg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_x(1:2, 3)*pol_y(1, 3, jg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_x(3:4, 3)*pol_y(2, 3, jg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_x(1:2, 4)*pol_y(1, 3, jg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_x(3:4, 4)*pol_y(2, 3, jg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_x(1:2, 5)*pol_y(1, 3, jg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_x(3:4, 5)*pol_y(2, 3, jg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_x(1:2, 0)*pol_y(1, 4, jg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_x(3:4, 0)*pol_y(2, 4, jg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_x(1:2, 1)*pol_y(1, 4, jg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_x(3:4, 1)*pol_y(2, 4, jg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_x(1:2, 2)*pol_y(1, 4, jg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_x(3:4, 2)*pol_y(2, 4, jg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_x(1:2, 3)*pol_y(1, 4, jg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_x(3:4, 3)*pol_y(2, 4, jg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_x(1:2, 4)*pol_y(1, 4, jg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_x(3:4, 4)*pol_y(2, 4, jg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_x(1:2, 0)*pol_y(1, 5, jg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_x(3:4, 0)*pol_y(2, 5, jg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_x(1:2, 1)*pol_y(1, 5, jg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_x(3:4, 1)*pol_y(2, 5, jg) - coef_xy(:, 38) = coef_xy(:, 38)+coef_x(1:2, 2)*pol_y(1, 5, jg) - coef_xy(:, 38) = coef_xy(:, 38)+coef_x(3:4, 2)*pol_y(2, 5, jg) - coef_xy(:, 39) = coef_xy(:, 39)+coef_x(1:2, 3)*pol_y(1, 5, jg) - coef_xy(:, 39) = coef_xy(:, 39)+coef_x(3:4, 3)*pol_y(2, 5, jg) - coef_xy(:, 40) = coef_xy(:, 40)+coef_x(1:2, 0)*pol_y(1, 6, jg) - coef_xy(:, 40) = coef_xy(:, 40)+coef_x(3:4, 0)*pol_y(2, 6, jg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_x(1:2, 1)*pol_y(1, 6, jg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_x(3:4, 1)*pol_y(2, 6, jg) - coef_xy(:, 42) = coef_xy(:, 42)+coef_x(1:2, 2)*pol_y(1, 6, jg) - coef_xy(:, 42) = coef_xy(:, 42)+coef_x(3:4, 2)*pol_y(2, 6, jg) - coef_xy(:, 43) = coef_xy(:, 43)+coef_x(1:2, 0)*pol_y(1, 7, jg) - coef_xy(:, 43) = coef_xy(:, 43)+coef_x(3:4, 0)*pol_y(2, 7, jg) - coef_xy(:, 44) = coef_xy(:, 44)+coef_x(1:2, 1)*pol_y(1, 7, jg) - coef_xy(:, 44) = coef_xy(:, 44)+coef_x(3:4, 1)*pol_y(2, 7, jg) - coef_xy(:, 45) = coef_xy(:, 45)+coef_x(1:2, 0)*pol_y(1, 8, jg) - coef_xy(:, 45) = coef_xy(:, 45)+coef_x(3:4, 0)*pol_y(2, 8, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(1:2, 1)*pol_y(1, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(3:4, 1)*pol_y(2, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(1:2, 2)*pol_y(1, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(3:4, 2)*pol_y(2, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(1:2, 3)*pol_y(1, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(3:4, 3)*pol_y(2, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(1:2, 4)*pol_y(1, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(3:4, 4)*pol_y(2, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(1:2, 5)*pol_y(1, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(3:4, 5)*pol_y(2, 0, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(1:2, 6)*pol_y(1, 0, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(3:4, 6)*pol_y(2, 0, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(1:2, 7)*pol_y(1, 0, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(3:4, 7)*pol_y(2, 0, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(1:2, 8)*pol_y(1, 0, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(3:4, 8)*pol_y(2, 0, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(1:2, 0)*pol_y(1, 1, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(3:4, 0)*pol_y(2, 1, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(1:2, 1)*pol_y(1, 1, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(3:4, 1)*pol_y(2, 1, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(1:2, 2)*pol_y(1, 1, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(3:4, 2)*pol_y(2, 1, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(1:2, 3)*pol_y(1, 1, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(3:4, 3)*pol_y(2, 1, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(1:2, 4)*pol_y(1, 1, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(3:4, 4)*pol_y(2, 1, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(1:2, 5)*pol_y(1, 1, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(3:4, 5)*pol_y(2, 1, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(1:2, 6)*pol_y(1, 1, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(3:4, 6)*pol_y(2, 1, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(1:2, 7)*pol_y(1, 1, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(3:4, 7)*pol_y(2, 1, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(1:2, 0)*pol_y(1, 2, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(3:4, 0)*pol_y(2, 2, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(1:2, 1)*pol_y(1, 2, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(3:4, 1)*pol_y(2, 2, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(1:2, 2)*pol_y(1, 2, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(3:4, 2)*pol_y(2, 2, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(1:2, 3)*pol_y(1, 2, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(3:4, 3)*pol_y(2, 2, jg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_x(1:2, 4)*pol_y(1, 2, jg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_x(3:4, 4)*pol_y(2, 2, jg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_x(1:2, 5)*pol_y(1, 2, jg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_x(3:4, 5)*pol_y(2, 2, jg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_x(1:2, 6)*pol_y(1, 2, jg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_x(3:4, 6)*pol_y(2, 2, jg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_x(1:2, 0)*pol_y(1, 3, jg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_x(3:4, 0)*pol_y(2, 3, jg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_x(1:2, 1)*pol_y(1, 3, jg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_x(3:4, 1)*pol_y(2, 3, jg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_x(1:2, 2)*pol_y(1, 3, jg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_x(3:4, 2)*pol_y(2, 3, jg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_x(1:2, 3)*pol_y(1, 3, jg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_x(3:4, 3)*pol_y(2, 3, jg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_x(1:2, 4)*pol_y(1, 3, jg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_x(3:4, 4)*pol_y(2, 3, jg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_x(1:2, 5)*pol_y(1, 3, jg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_x(3:4, 5)*pol_y(2, 3, jg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_x(1:2, 0)*pol_y(1, 4, jg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_x(3:4, 0)*pol_y(2, 4, jg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_x(1:2, 1)*pol_y(1, 4, jg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_x(3:4, 1)*pol_y(2, 4, jg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_x(1:2, 2)*pol_y(1, 4, jg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_x(3:4, 2)*pol_y(2, 4, jg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_x(1:2, 3)*pol_y(1, 4, jg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_x(3:4, 3)*pol_y(2, 4, jg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_x(1:2, 4)*pol_y(1, 4, jg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_x(3:4, 4)*pol_y(2, 4, jg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_x(1:2, 0)*pol_y(1, 5, jg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_x(3:4, 0)*pol_y(2, 5, jg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_x(1:2, 1)*pol_y(1, 5, jg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_x(3:4, 1)*pol_y(2, 5, jg) + coef_xy(:, 38) = coef_xy(:, 38) + coef_x(1:2, 2)*pol_y(1, 5, jg) + coef_xy(:, 38) = coef_xy(:, 38) + coef_x(3:4, 2)*pol_y(2, 5, jg) + coef_xy(:, 39) = coef_xy(:, 39) + coef_x(1:2, 3)*pol_y(1, 5, jg) + coef_xy(:, 39) = coef_xy(:, 39) + coef_x(3:4, 3)*pol_y(2, 5, jg) + coef_xy(:, 40) = coef_xy(:, 40) + coef_x(1:2, 0)*pol_y(1, 6, jg) + coef_xy(:, 40) = coef_xy(:, 40) + coef_x(3:4, 0)*pol_y(2, 6, jg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_x(1:2, 1)*pol_y(1, 6, jg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_x(3:4, 1)*pol_y(2, 6, jg) + coef_xy(:, 42) = coef_xy(:, 42) + coef_x(1:2, 2)*pol_y(1, 6, jg) + coef_xy(:, 42) = coef_xy(:, 42) + coef_x(3:4, 2)*pol_y(2, 6, jg) + coef_xy(:, 43) = coef_xy(:, 43) + coef_x(1:2, 0)*pol_y(1, 7, jg) + coef_xy(:, 43) = coef_xy(:, 43) + coef_x(3:4, 0)*pol_y(2, 7, jg) + coef_xy(:, 44) = coef_xy(:, 44) + coef_x(1:2, 1)*pol_y(1, 7, jg) + coef_xy(:, 44) = coef_xy(:, 44) + coef_x(3:4, 1)*pol_y(2, 7, jg) + coef_xy(:, 45) = coef_xy(:, 45) + coef_x(1:2, 0)*pol_y(1, 8, jg) + coef_xy(:, 45) = coef_xy(:, 45) + coef_x(3:4, 0)*pol_y(2, 8, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 11)*pol_z(1, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 11)*pol_z(2, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 12)*pol_z(1, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 12)*pol_z(2, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 13)*pol_z(1, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 13)*pol_z(2, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 14)*pol_z(1, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 14)*pol_z(2, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 15)*pol_z(1, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 15)*pol_z(2, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 16)*pol_z(1, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 16)*pol_z(2, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 17)*pol_z(1, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 17)*pol_z(2, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 18)*pol_z(1, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 18)*pol_z(2, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 19)*pol_z(1, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 19)*pol_z(2, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 20)*pol_z(1, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 20)*pol_z(2, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(1, 21)*pol_z(1, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(2, 21)*pol_z(2, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(1, 22)*pol_z(1, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(2, 22)*pol_z(2, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(1, 23)*pol_z(1, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(2, 23)*pol_z(2, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(1, 24)*pol_z(1, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(2, 24)*pol_z(2, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(1, 25)*pol_z(1, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(2, 25)*pol_z(2, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(1, 26)*pol_z(1, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(2, 26)*pol_z(2, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(1, 27)*pol_z(1, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(2, 27)*pol_z(2, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(1, 28)*pol_z(1, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(2, 28)*pol_z(2, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(1, 29)*pol_z(1, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(2, 29)*pol_z(2, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(1, 30)*pol_z(1, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(2, 30)*pol_z(2, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(1, 31)*pol_z(1, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(2, 31)*pol_z(2, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(1, 32)*pol_z(1, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(2, 32)*pol_z(2, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(1, 33)*pol_z(1, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(2, 33)*pol_z(2, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(1, 34)*pol_z(1, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(2, 34)*pol_z(2, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(1, 35)*pol_z(1, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(2, 35)*pol_z(2, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(1, 36)*pol_z(1, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(2, 36)*pol_z(2, 0, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(1, 37)*pol_z(1, 0, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(2, 37)*pol_z(2, 0, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(1, 38)*pol_z(1, 0, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(2, 38)*pol_z(2, 0, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(1, 39)*pol_z(1, 0, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(2, 39)*pol_z(2, 0, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(1, 40)*pol_z(1, 0, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(2, 40)*pol_z(2, 0, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(1, 41)*pol_z(1, 0, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(2, 41)*pol_z(2, 0, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(1, 42)*pol_z(1, 0, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(2, 42)*pol_z(2, 0, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(1, 43)*pol_z(1, 0, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(2, 43)*pol_z(2, 0, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(1, 44)*pol_z(1, 0, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(2, 44)*pol_z(2, 0, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(1, 45)*pol_z(1, 0, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(2, 45)*pol_z(2, 0, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(1, 5)*pol_z(1, 1, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(2, 5)*pol_z(2, 1, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(1, 7)*pol_z(1, 1, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(2, 7)*pol_z(2, 1, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(1, 8)*pol_z(1, 1, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(2, 8)*pol_z(2, 1, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(1, 10)*pol_z(1, 1, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(2, 10)*pol_z(2, 1, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(1, 11)*pol_z(1, 1, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(2, 11)*pol_z(2, 1, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(1, 12)*pol_z(1, 1, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(2, 12)*pol_z(2, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(1, 13)*pol_z(1, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(2, 13)*pol_z(2, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(1, 14)*pol_z(1, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(2, 14)*pol_z(2, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(1, 15)*pol_z(1, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(2, 15)*pol_z(2, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(1, 16)*pol_z(1, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(2, 16)*pol_z(2, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(1, 18)*pol_z(1, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(2, 18)*pol_z(2, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(1, 19)*pol_z(1, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(2, 19)*pol_z(2, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(1, 20)*pol_z(1, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(2, 20)*pol_z(2, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(1, 21)*pol_z(1, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(2, 21)*pol_z(2, 1, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(1, 22)*pol_z(1, 1, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(2, 22)*pol_z(2, 1, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(1, 23)*pol_z(1, 1, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(2, 23)*pol_z(2, 1, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(1, 25)*pol_z(1, 1, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(2, 25)*pol_z(2, 1, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(1, 26)*pol_z(1, 1, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(2, 26)*pol_z(2, 1, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(1, 27)*pol_z(1, 1, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(2, 27)*pol_z(2, 1, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(1, 28)*pol_z(1, 1, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(2, 28)*pol_z(2, 1, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(1, 29)*pol_z(1, 1, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(2, 29)*pol_z(2, 1, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(1, 31)*pol_z(1, 1, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(2, 31)*pol_z(2, 1, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(1, 32)*pol_z(1, 1, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(2, 32)*pol_z(2, 1, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(1, 33)*pol_z(1, 1, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(2, 33)*pol_z(2, 1, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(1, 34)*pol_z(1, 1, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(2, 34)*pol_z(2, 1, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(1, 36)*pol_z(1, 1, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(2, 36)*pol_z(2, 1, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(1, 37)*pol_z(1, 1, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(2, 37)*pol_z(2, 1, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(1, 38)*pol_z(1, 1, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(2, 38)*pol_z(2, 1, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(1, 40)*pol_z(1, 1, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(2, 40)*pol_z(2, 1, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(1, 41)*pol_z(1, 1, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(2, 41)*pol_z(2, 1, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(1, 43)*pol_z(1, 1, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(2, 43)*pol_z(2, 1, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(1, 3)*pol_z(1, 2, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(2, 3)*pol_z(2, 2, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(1, 4)*pol_z(1, 2, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(2, 4)*pol_z(2, 2, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(1, 5)*pol_z(1, 2, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(2, 5)*pol_z(2, 2, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(1, 6)*pol_z(1, 2, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(2, 6)*pol_z(2, 2, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(1, 7)*pol_z(1, 2, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(2, 7)*pol_z(2, 2, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(1, 10)*pol_z(1, 2, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(2, 10)*pol_z(2, 2, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(1, 11)*pol_z(1, 2, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(2, 11)*pol_z(2, 2, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(1, 12)*pol_z(1, 2, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(2, 12)*pol_z(2, 2, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(1, 13)*pol_z(1, 2, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(2, 13)*pol_z(2, 2, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(1, 14)*pol_z(1, 2, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(2, 14)*pol_z(2, 2, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(1, 15)*pol_z(1, 2, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(2, 15)*pol_z(2, 2, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(1, 18)*pol_z(1, 2, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(2, 18)*pol_z(2, 2, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(1, 19)*pol_z(1, 2, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(2, 19)*pol_z(2, 2, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(1, 20)*pol_z(1, 2, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(2, 20)*pol_z(2, 2, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(1, 21)*pol_z(1, 2, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(2, 21)*pol_z(2, 2, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(1, 22)*pol_z(1, 2, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(2, 22)*pol_z(2, 2, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(1, 25)*pol_z(1, 2, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(2, 25)*pol_z(2, 2, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(1, 26)*pol_z(1, 2, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(2, 26)*pol_z(2, 2, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(1, 27)*pol_z(1, 2, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(2, 27)*pol_z(2, 2, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(1, 28)*pol_z(1, 2, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(2, 28)*pol_z(2, 2, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(1, 31)*pol_z(1, 2, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(2, 31)*pol_z(2, 2, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(1, 32)*pol_z(1, 2, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(2, 32)*pol_z(2, 2, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(1, 33)*pol_z(1, 2, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(2, 33)*pol_z(2, 2, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(1, 36)*pol_z(1, 2, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(2, 36)*pol_z(2, 2, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(1, 37)*pol_z(1, 2, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(2, 37)*pol_z(2, 2, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(1, 40)*pol_z(1, 2, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(2, 40)*pol_z(2, 2, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(2, 1)*pol_z(2, 3, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(1, 2)*pol_z(1, 3, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(2, 2)*pol_z(2, 3, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(1, 3)*pol_z(1, 3, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(2, 3)*pol_z(2, 3, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(1, 4)*pol_z(1, 3, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(2, 4)*pol_z(2, 3, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(1, 5)*pol_z(1, 3, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(2, 5)*pol_z(2, 3, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(1, 6)*pol_z(1, 3, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(2, 6)*pol_z(2, 3, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(1, 10)*pol_z(1, 3, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(2, 10)*pol_z(2, 3, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(1, 11)*pol_z(1, 3, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(2, 11)*pol_z(2, 3, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(1, 12)*pol_z(1, 3, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(2, 12)*pol_z(2, 3, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(1, 13)*pol_z(1, 3, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(2, 13)*pol_z(2, 3, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(1, 14)*pol_z(1, 3, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(2, 14)*pol_z(2, 3, kg) - coef_xyz(121) = coef_xyz(121)+coef_xy(1, 18)*pol_z(1, 3, kg) - coef_xyz(121) = coef_xyz(121)+coef_xy(2, 18)*pol_z(2, 3, kg) - coef_xyz(122) = coef_xyz(122)+coef_xy(1, 19)*pol_z(1, 3, kg) - coef_xyz(122) = coef_xyz(122)+coef_xy(2, 19)*pol_z(2, 3, kg) - coef_xyz(123) = coef_xyz(123)+coef_xy(1, 20)*pol_z(1, 3, kg) - coef_xyz(123) = coef_xyz(123)+coef_xy(2, 20)*pol_z(2, 3, kg) - coef_xyz(124) = coef_xyz(124)+coef_xy(1, 21)*pol_z(1, 3, kg) - coef_xyz(124) = coef_xyz(124)+coef_xy(2, 21)*pol_z(2, 3, kg) - coef_xyz(125) = coef_xyz(125)+coef_xy(1, 25)*pol_z(1, 3, kg) - coef_xyz(125) = coef_xyz(125)+coef_xy(2, 25)*pol_z(2, 3, kg) - coef_xyz(126) = coef_xyz(126)+coef_xy(1, 26)*pol_z(1, 3, kg) - coef_xyz(126) = coef_xyz(126)+coef_xy(2, 26)*pol_z(2, 3, kg) - coef_xyz(127) = coef_xyz(127)+coef_xy(1, 27)*pol_z(1, 3, kg) - coef_xyz(127) = coef_xyz(127)+coef_xy(2, 27)*pol_z(2, 3, kg) - coef_xyz(128) = coef_xyz(128)+coef_xy(1, 31)*pol_z(1, 3, kg) - coef_xyz(128) = coef_xyz(128)+coef_xy(2, 31)*pol_z(2, 3, kg) - coef_xyz(129) = coef_xyz(129)+coef_xy(1, 32)*pol_z(1, 3, kg) - coef_xyz(129) = coef_xyz(129)+coef_xy(2, 32)*pol_z(2, 3, kg) - coef_xyz(130) = coef_xyz(130)+coef_xy(1, 36)*pol_z(1, 3, kg) - coef_xyz(130) = coef_xyz(130)+coef_xy(2, 36)*pol_z(2, 3, kg) - coef_xyz(131) = coef_xyz(131)+coef_xy(1, 1)*pol_z(1, 4, kg) - coef_xyz(131) = coef_xyz(131)+coef_xy(2, 1)*pol_z(2, 4, kg) - coef_xyz(132) = coef_xyz(132)+coef_xy(1, 2)*pol_z(1, 4, kg) - coef_xyz(132) = coef_xyz(132)+coef_xy(2, 2)*pol_z(2, 4, kg) - coef_xyz(133) = coef_xyz(133)+coef_xy(1, 3)*pol_z(1, 4, kg) - coef_xyz(133) = coef_xyz(133)+coef_xy(2, 3)*pol_z(2, 4, kg) - coef_xyz(134) = coef_xyz(134)+coef_xy(1, 4)*pol_z(1, 4, kg) - coef_xyz(134) = coef_xyz(134)+coef_xy(2, 4)*pol_z(2, 4, kg) - coef_xyz(135) = coef_xyz(135)+coef_xy(1, 5)*pol_z(1, 4, kg) - coef_xyz(135) = coef_xyz(135)+coef_xy(2, 5)*pol_z(2, 4, kg) - coef_xyz(136) = coef_xyz(136)+coef_xy(1, 10)*pol_z(1, 4, kg) - coef_xyz(136) = coef_xyz(136)+coef_xy(2, 10)*pol_z(2, 4, kg) - coef_xyz(137) = coef_xyz(137)+coef_xy(1, 11)*pol_z(1, 4, kg) - coef_xyz(137) = coef_xyz(137)+coef_xy(2, 11)*pol_z(2, 4, kg) - coef_xyz(138) = coef_xyz(138)+coef_xy(1, 12)*pol_z(1, 4, kg) - coef_xyz(138) = coef_xyz(138)+coef_xy(2, 12)*pol_z(2, 4, kg) - coef_xyz(139) = coef_xyz(139)+coef_xy(1, 13)*pol_z(1, 4, kg) - coef_xyz(139) = coef_xyz(139)+coef_xy(2, 13)*pol_z(2, 4, kg) - coef_xyz(140) = coef_xyz(140)+coef_xy(1, 18)*pol_z(1, 4, kg) - coef_xyz(140) = coef_xyz(140)+coef_xy(2, 18)*pol_z(2, 4, kg) - coef_xyz(141) = coef_xyz(141)+coef_xy(1, 19)*pol_z(1, 4, kg) - coef_xyz(141) = coef_xyz(141)+coef_xy(2, 19)*pol_z(2, 4, kg) - coef_xyz(142) = coef_xyz(142)+coef_xy(1, 20)*pol_z(1, 4, kg) - coef_xyz(142) = coef_xyz(142)+coef_xy(2, 20)*pol_z(2, 4, kg) - coef_xyz(143) = coef_xyz(143)+coef_xy(1, 25)*pol_z(1, 4, kg) - coef_xyz(143) = coef_xyz(143)+coef_xy(2, 25)*pol_z(2, 4, kg) - coef_xyz(144) = coef_xyz(144)+coef_xy(1, 26)*pol_z(1, 4, kg) - coef_xyz(144) = coef_xyz(144)+coef_xy(2, 26)*pol_z(2, 4, kg) - coef_xyz(145) = coef_xyz(145)+coef_xy(1, 31)*pol_z(1, 4, kg) - coef_xyz(145) = coef_xyz(145)+coef_xy(2, 31)*pol_z(2, 4, kg) - coef_xyz(146) = coef_xyz(146)+coef_xy(1, 1)*pol_z(1, 5, kg) - coef_xyz(146) = coef_xyz(146)+coef_xy(2, 1)*pol_z(2, 5, kg) - coef_xyz(147) = coef_xyz(147)+coef_xy(1, 2)*pol_z(1, 5, kg) - coef_xyz(147) = coef_xyz(147)+coef_xy(2, 2)*pol_z(2, 5, kg) - coef_xyz(148) = coef_xyz(148)+coef_xy(1, 3)*pol_z(1, 5, kg) - coef_xyz(148) = coef_xyz(148)+coef_xy(2, 3)*pol_z(2, 5, kg) - coef_xyz(149) = coef_xyz(149)+coef_xy(1, 4)*pol_z(1, 5, kg) - coef_xyz(149) = coef_xyz(149)+coef_xy(2, 4)*pol_z(2, 5, kg) - coef_xyz(150) = coef_xyz(150)+coef_xy(1, 10)*pol_z(1, 5, kg) - coef_xyz(150) = coef_xyz(150)+coef_xy(2, 10)*pol_z(2, 5, kg) - coef_xyz(151) = coef_xyz(151)+coef_xy(1, 11)*pol_z(1, 5, kg) - coef_xyz(151) = coef_xyz(151)+coef_xy(2, 11)*pol_z(2, 5, kg) - coef_xyz(152) = coef_xyz(152)+coef_xy(1, 12)*pol_z(1, 5, kg) - coef_xyz(152) = coef_xyz(152)+coef_xy(2, 12)*pol_z(2, 5, kg) - coef_xyz(153) = coef_xyz(153)+coef_xy(1, 18)*pol_z(1, 5, kg) - coef_xyz(153) = coef_xyz(153)+coef_xy(2, 18)*pol_z(2, 5, kg) - coef_xyz(154) = coef_xyz(154)+coef_xy(1, 19)*pol_z(1, 5, kg) - coef_xyz(154) = coef_xyz(154)+coef_xy(2, 19)*pol_z(2, 5, kg) - coef_xyz(155) = coef_xyz(155)+coef_xy(1, 25)*pol_z(1, 5, kg) - coef_xyz(155) = coef_xyz(155)+coef_xy(2, 25)*pol_z(2, 5, kg) - coef_xyz(156) = coef_xyz(156)+coef_xy(1, 1)*pol_z(1, 6, kg) - coef_xyz(156) = coef_xyz(156)+coef_xy(2, 1)*pol_z(2, 6, kg) - coef_xyz(157) = coef_xyz(157)+coef_xy(1, 2)*pol_z(1, 6, kg) - coef_xyz(157) = coef_xyz(157)+coef_xy(2, 2)*pol_z(2, 6, kg) - coef_xyz(158) = coef_xyz(158)+coef_xy(1, 3)*pol_z(1, 6, kg) - coef_xyz(158) = coef_xyz(158)+coef_xy(2, 3)*pol_z(2, 6, kg) - coef_xyz(159) = coef_xyz(159)+coef_xy(1, 10)*pol_z(1, 6, kg) - coef_xyz(159) = coef_xyz(159)+coef_xy(2, 10)*pol_z(2, 6, kg) - coef_xyz(160) = coef_xyz(160)+coef_xy(1, 11)*pol_z(1, 6, kg) - coef_xyz(160) = coef_xyz(160)+coef_xy(2, 11)*pol_z(2, 6, kg) - coef_xyz(161) = coef_xyz(161)+coef_xy(1, 18)*pol_z(1, 6, kg) - coef_xyz(161) = coef_xyz(161)+coef_xy(2, 18)*pol_z(2, 6, kg) - coef_xyz(162) = coef_xyz(162)+coef_xy(1, 1)*pol_z(1, 7, kg) - coef_xyz(162) = coef_xyz(162)+coef_xy(2, 1)*pol_z(2, 7, kg) - coef_xyz(163) = coef_xyz(163)+coef_xy(1, 2)*pol_z(1, 7, kg) - coef_xyz(163) = coef_xyz(163)+coef_xy(2, 2)*pol_z(2, 7, kg) - coef_xyz(164) = coef_xyz(164)+coef_xy(1, 10)*pol_z(1, 7, kg) - coef_xyz(164) = coef_xyz(164)+coef_xy(2, 10)*pol_z(2, 7, kg) - coef_xyz(165) = coef_xyz(165)+coef_xy(1, 1)*pol_z(1, 8, kg) - coef_xyz(165) = coef_xyz(165)+coef_xy(2, 1)*pol_z(2, 8, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 11)*pol_z(1, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 11)*pol_z(2, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 12)*pol_z(1, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 12)*pol_z(2, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 13)*pol_z(1, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 13)*pol_z(2, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 14)*pol_z(1, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 14)*pol_z(2, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 15)*pol_z(1, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 15)*pol_z(2, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 16)*pol_z(1, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 16)*pol_z(2, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 17)*pol_z(1, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 17)*pol_z(2, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 18)*pol_z(1, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 18)*pol_z(2, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 19)*pol_z(1, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 19)*pol_z(2, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 20)*pol_z(1, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 20)*pol_z(2, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(1, 21)*pol_z(1, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(2, 21)*pol_z(2, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(1, 22)*pol_z(1, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(2, 22)*pol_z(2, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(1, 23)*pol_z(1, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(2, 23)*pol_z(2, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(1, 24)*pol_z(1, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(2, 24)*pol_z(2, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(1, 25)*pol_z(1, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(2, 25)*pol_z(2, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(1, 26)*pol_z(1, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(2, 26)*pol_z(2, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(1, 27)*pol_z(1, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(2, 27)*pol_z(2, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(1, 28)*pol_z(1, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(2, 28)*pol_z(2, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(1, 29)*pol_z(1, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(2, 29)*pol_z(2, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(1, 30)*pol_z(1, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(2, 30)*pol_z(2, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(1, 31)*pol_z(1, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(2, 31)*pol_z(2, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(1, 32)*pol_z(1, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(2, 32)*pol_z(2, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(1, 33)*pol_z(1, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(2, 33)*pol_z(2, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(1, 34)*pol_z(1, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(2, 34)*pol_z(2, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(1, 35)*pol_z(1, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(2, 35)*pol_z(2, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(1, 36)*pol_z(1, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(2, 36)*pol_z(2, 0, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(1, 37)*pol_z(1, 0, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(2, 37)*pol_z(2, 0, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(1, 38)*pol_z(1, 0, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(2, 38)*pol_z(2, 0, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(1, 39)*pol_z(1, 0, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(2, 39)*pol_z(2, 0, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(1, 40)*pol_z(1, 0, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(2, 40)*pol_z(2, 0, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(1, 41)*pol_z(1, 0, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(2, 41)*pol_z(2, 0, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(1, 42)*pol_z(1, 0, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(2, 42)*pol_z(2, 0, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(1, 43)*pol_z(1, 0, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(2, 43)*pol_z(2, 0, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(1, 44)*pol_z(1, 0, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(2, 44)*pol_z(2, 0, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(1, 45)*pol_z(1, 0, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(2, 45)*pol_z(2, 0, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(1, 5)*pol_z(1, 1, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(2, 5)*pol_z(2, 1, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(1, 7)*pol_z(1, 1, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(2, 7)*pol_z(2, 1, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(1, 8)*pol_z(1, 1, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(2, 8)*pol_z(2, 1, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(1, 10)*pol_z(1, 1, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(2, 10)*pol_z(2, 1, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(1, 11)*pol_z(1, 1, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(2, 11)*pol_z(2, 1, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(1, 12)*pol_z(1, 1, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(2, 12)*pol_z(2, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(1, 13)*pol_z(1, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(2, 13)*pol_z(2, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(1, 14)*pol_z(1, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(2, 14)*pol_z(2, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(1, 15)*pol_z(1, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(2, 15)*pol_z(2, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(1, 16)*pol_z(1, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(2, 16)*pol_z(2, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(1, 18)*pol_z(1, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(2, 18)*pol_z(2, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(1, 19)*pol_z(1, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(2, 19)*pol_z(2, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(1, 20)*pol_z(1, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(2, 20)*pol_z(2, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(1, 21)*pol_z(1, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(2, 21)*pol_z(2, 1, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(1, 22)*pol_z(1, 1, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(2, 22)*pol_z(2, 1, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(1, 23)*pol_z(1, 1, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(2, 23)*pol_z(2, 1, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(1, 25)*pol_z(1, 1, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(2, 25)*pol_z(2, 1, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(1, 26)*pol_z(1, 1, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(2, 26)*pol_z(2, 1, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(1, 27)*pol_z(1, 1, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(2, 27)*pol_z(2, 1, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(1, 28)*pol_z(1, 1, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(2, 28)*pol_z(2, 1, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(1, 29)*pol_z(1, 1, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(2, 29)*pol_z(2, 1, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(1, 31)*pol_z(1, 1, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(2, 31)*pol_z(2, 1, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(1, 32)*pol_z(1, 1, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(2, 32)*pol_z(2, 1, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(1, 33)*pol_z(1, 1, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(2, 33)*pol_z(2, 1, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(1, 34)*pol_z(1, 1, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(2, 34)*pol_z(2, 1, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(1, 36)*pol_z(1, 1, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(2, 36)*pol_z(2, 1, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(1, 37)*pol_z(1, 1, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(2, 37)*pol_z(2, 1, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(1, 38)*pol_z(1, 1, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(2, 38)*pol_z(2, 1, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(1, 40)*pol_z(1, 1, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(2, 40)*pol_z(2, 1, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(1, 41)*pol_z(1, 1, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(2, 41)*pol_z(2, 1, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(1, 43)*pol_z(1, 1, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(2, 43)*pol_z(2, 1, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(1, 3)*pol_z(1, 2, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(2, 3)*pol_z(2, 2, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(1, 4)*pol_z(1, 2, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(2, 4)*pol_z(2, 2, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(1, 5)*pol_z(1, 2, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(2, 5)*pol_z(2, 2, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(1, 6)*pol_z(1, 2, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(2, 6)*pol_z(2, 2, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(1, 7)*pol_z(1, 2, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(2, 7)*pol_z(2, 2, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(1, 10)*pol_z(1, 2, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(2, 10)*pol_z(2, 2, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(1, 11)*pol_z(1, 2, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(2, 11)*pol_z(2, 2, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(1, 12)*pol_z(1, 2, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(2, 12)*pol_z(2, 2, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(1, 13)*pol_z(1, 2, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(2, 13)*pol_z(2, 2, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(1, 14)*pol_z(1, 2, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(2, 14)*pol_z(2, 2, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(1, 15)*pol_z(1, 2, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(2, 15)*pol_z(2, 2, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(1, 18)*pol_z(1, 2, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(2, 18)*pol_z(2, 2, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(1, 19)*pol_z(1, 2, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(2, 19)*pol_z(2, 2, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(1, 20)*pol_z(1, 2, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(2, 20)*pol_z(2, 2, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(1, 21)*pol_z(1, 2, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(2, 21)*pol_z(2, 2, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(1, 22)*pol_z(1, 2, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(2, 22)*pol_z(2, 2, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(1, 25)*pol_z(1, 2, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(2, 25)*pol_z(2, 2, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(1, 26)*pol_z(1, 2, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(2, 26)*pol_z(2, 2, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(1, 27)*pol_z(1, 2, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(2, 27)*pol_z(2, 2, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(1, 28)*pol_z(1, 2, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(2, 28)*pol_z(2, 2, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(1, 31)*pol_z(1, 2, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(2, 31)*pol_z(2, 2, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(1, 32)*pol_z(1, 2, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(2, 32)*pol_z(2, 2, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(1, 33)*pol_z(1, 2, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(2, 33)*pol_z(2, 2, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(1, 36)*pol_z(1, 2, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(2, 36)*pol_z(2, 2, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(1, 37)*pol_z(1, 2, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(2, 37)*pol_z(2, 2, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(1, 40)*pol_z(1, 2, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(2, 40)*pol_z(2, 2, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(1, 2)*pol_z(1, 3, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(2, 2)*pol_z(2, 3, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(1, 3)*pol_z(1, 3, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(2, 3)*pol_z(2, 3, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(1, 4)*pol_z(1, 3, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(2, 4)*pol_z(2, 3, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(1, 5)*pol_z(1, 3, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(2, 5)*pol_z(2, 3, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(1, 6)*pol_z(1, 3, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(2, 6)*pol_z(2, 3, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(1, 10)*pol_z(1, 3, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(2, 10)*pol_z(2, 3, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(1, 11)*pol_z(1, 3, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(2, 11)*pol_z(2, 3, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(1, 12)*pol_z(1, 3, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(2, 12)*pol_z(2, 3, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(1, 13)*pol_z(1, 3, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(2, 13)*pol_z(2, 3, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(1, 14)*pol_z(1, 3, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(2, 14)*pol_z(2, 3, kg) + coef_xyz(121) = coef_xyz(121) + coef_xy(1, 18)*pol_z(1, 3, kg) + coef_xyz(121) = coef_xyz(121) + coef_xy(2, 18)*pol_z(2, 3, kg) + coef_xyz(122) = coef_xyz(122) + coef_xy(1, 19)*pol_z(1, 3, kg) + coef_xyz(122) = coef_xyz(122) + coef_xy(2, 19)*pol_z(2, 3, kg) + coef_xyz(123) = coef_xyz(123) + coef_xy(1, 20)*pol_z(1, 3, kg) + coef_xyz(123) = coef_xyz(123) + coef_xy(2, 20)*pol_z(2, 3, kg) + coef_xyz(124) = coef_xyz(124) + coef_xy(1, 21)*pol_z(1, 3, kg) + coef_xyz(124) = coef_xyz(124) + coef_xy(2, 21)*pol_z(2, 3, kg) + coef_xyz(125) = coef_xyz(125) + coef_xy(1, 25)*pol_z(1, 3, kg) + coef_xyz(125) = coef_xyz(125) + coef_xy(2, 25)*pol_z(2, 3, kg) + coef_xyz(126) = coef_xyz(126) + coef_xy(1, 26)*pol_z(1, 3, kg) + coef_xyz(126) = coef_xyz(126) + coef_xy(2, 26)*pol_z(2, 3, kg) + coef_xyz(127) = coef_xyz(127) + coef_xy(1, 27)*pol_z(1, 3, kg) + coef_xyz(127) = coef_xyz(127) + coef_xy(2, 27)*pol_z(2, 3, kg) + coef_xyz(128) = coef_xyz(128) + coef_xy(1, 31)*pol_z(1, 3, kg) + coef_xyz(128) = coef_xyz(128) + coef_xy(2, 31)*pol_z(2, 3, kg) + coef_xyz(129) = coef_xyz(129) + coef_xy(1, 32)*pol_z(1, 3, kg) + coef_xyz(129) = coef_xyz(129) + coef_xy(2, 32)*pol_z(2, 3, kg) + coef_xyz(130) = coef_xyz(130) + coef_xy(1, 36)*pol_z(1, 3, kg) + coef_xyz(130) = coef_xyz(130) + coef_xy(2, 36)*pol_z(2, 3, kg) + coef_xyz(131) = coef_xyz(131) + coef_xy(1, 1)*pol_z(1, 4, kg) + coef_xyz(131) = coef_xyz(131) + coef_xy(2, 1)*pol_z(2, 4, kg) + coef_xyz(132) = coef_xyz(132) + coef_xy(1, 2)*pol_z(1, 4, kg) + coef_xyz(132) = coef_xyz(132) + coef_xy(2, 2)*pol_z(2, 4, kg) + coef_xyz(133) = coef_xyz(133) + coef_xy(1, 3)*pol_z(1, 4, kg) + coef_xyz(133) = coef_xyz(133) + coef_xy(2, 3)*pol_z(2, 4, kg) + coef_xyz(134) = coef_xyz(134) + coef_xy(1, 4)*pol_z(1, 4, kg) + coef_xyz(134) = coef_xyz(134) + coef_xy(2, 4)*pol_z(2, 4, kg) + coef_xyz(135) = coef_xyz(135) + coef_xy(1, 5)*pol_z(1, 4, kg) + coef_xyz(135) = coef_xyz(135) + coef_xy(2, 5)*pol_z(2, 4, kg) + coef_xyz(136) = coef_xyz(136) + coef_xy(1, 10)*pol_z(1, 4, kg) + coef_xyz(136) = coef_xyz(136) + coef_xy(2, 10)*pol_z(2, 4, kg) + coef_xyz(137) = coef_xyz(137) + coef_xy(1, 11)*pol_z(1, 4, kg) + coef_xyz(137) = coef_xyz(137) + coef_xy(2, 11)*pol_z(2, 4, kg) + coef_xyz(138) = coef_xyz(138) + coef_xy(1, 12)*pol_z(1, 4, kg) + coef_xyz(138) = coef_xyz(138) + coef_xy(2, 12)*pol_z(2, 4, kg) + coef_xyz(139) = coef_xyz(139) + coef_xy(1, 13)*pol_z(1, 4, kg) + coef_xyz(139) = coef_xyz(139) + coef_xy(2, 13)*pol_z(2, 4, kg) + coef_xyz(140) = coef_xyz(140) + coef_xy(1, 18)*pol_z(1, 4, kg) + coef_xyz(140) = coef_xyz(140) + coef_xy(2, 18)*pol_z(2, 4, kg) + coef_xyz(141) = coef_xyz(141) + coef_xy(1, 19)*pol_z(1, 4, kg) + coef_xyz(141) = coef_xyz(141) + coef_xy(2, 19)*pol_z(2, 4, kg) + coef_xyz(142) = coef_xyz(142) + coef_xy(1, 20)*pol_z(1, 4, kg) + coef_xyz(142) = coef_xyz(142) + coef_xy(2, 20)*pol_z(2, 4, kg) + coef_xyz(143) = coef_xyz(143) + coef_xy(1, 25)*pol_z(1, 4, kg) + coef_xyz(143) = coef_xyz(143) + coef_xy(2, 25)*pol_z(2, 4, kg) + coef_xyz(144) = coef_xyz(144) + coef_xy(1, 26)*pol_z(1, 4, kg) + coef_xyz(144) = coef_xyz(144) + coef_xy(2, 26)*pol_z(2, 4, kg) + coef_xyz(145) = coef_xyz(145) + coef_xy(1, 31)*pol_z(1, 4, kg) + coef_xyz(145) = coef_xyz(145) + coef_xy(2, 31)*pol_z(2, 4, kg) + coef_xyz(146) = coef_xyz(146) + coef_xy(1, 1)*pol_z(1, 5, kg) + coef_xyz(146) = coef_xyz(146) + coef_xy(2, 1)*pol_z(2, 5, kg) + coef_xyz(147) = coef_xyz(147) + coef_xy(1, 2)*pol_z(1, 5, kg) + coef_xyz(147) = coef_xyz(147) + coef_xy(2, 2)*pol_z(2, 5, kg) + coef_xyz(148) = coef_xyz(148) + coef_xy(1, 3)*pol_z(1, 5, kg) + coef_xyz(148) = coef_xyz(148) + coef_xy(2, 3)*pol_z(2, 5, kg) + coef_xyz(149) = coef_xyz(149) + coef_xy(1, 4)*pol_z(1, 5, kg) + coef_xyz(149) = coef_xyz(149) + coef_xy(2, 4)*pol_z(2, 5, kg) + coef_xyz(150) = coef_xyz(150) + coef_xy(1, 10)*pol_z(1, 5, kg) + coef_xyz(150) = coef_xyz(150) + coef_xy(2, 10)*pol_z(2, 5, kg) + coef_xyz(151) = coef_xyz(151) + coef_xy(1, 11)*pol_z(1, 5, kg) + coef_xyz(151) = coef_xyz(151) + coef_xy(2, 11)*pol_z(2, 5, kg) + coef_xyz(152) = coef_xyz(152) + coef_xy(1, 12)*pol_z(1, 5, kg) + coef_xyz(152) = coef_xyz(152) + coef_xy(2, 12)*pol_z(2, 5, kg) + coef_xyz(153) = coef_xyz(153) + coef_xy(1, 18)*pol_z(1, 5, kg) + coef_xyz(153) = coef_xyz(153) + coef_xy(2, 18)*pol_z(2, 5, kg) + coef_xyz(154) = coef_xyz(154) + coef_xy(1, 19)*pol_z(1, 5, kg) + coef_xyz(154) = coef_xyz(154) + coef_xy(2, 19)*pol_z(2, 5, kg) + coef_xyz(155) = coef_xyz(155) + coef_xy(1, 25)*pol_z(1, 5, kg) + coef_xyz(155) = coef_xyz(155) + coef_xy(2, 25)*pol_z(2, 5, kg) + coef_xyz(156) = coef_xyz(156) + coef_xy(1, 1)*pol_z(1, 6, kg) + coef_xyz(156) = coef_xyz(156) + coef_xy(2, 1)*pol_z(2, 6, kg) + coef_xyz(157) = coef_xyz(157) + coef_xy(1, 2)*pol_z(1, 6, kg) + coef_xyz(157) = coef_xyz(157) + coef_xy(2, 2)*pol_z(2, 6, kg) + coef_xyz(158) = coef_xyz(158) + coef_xy(1, 3)*pol_z(1, 6, kg) + coef_xyz(158) = coef_xyz(158) + coef_xy(2, 3)*pol_z(2, 6, kg) + coef_xyz(159) = coef_xyz(159) + coef_xy(1, 10)*pol_z(1, 6, kg) + coef_xyz(159) = coef_xyz(159) + coef_xy(2, 10)*pol_z(2, 6, kg) + coef_xyz(160) = coef_xyz(160) + coef_xy(1, 11)*pol_z(1, 6, kg) + coef_xyz(160) = coef_xyz(160) + coef_xy(2, 11)*pol_z(2, 6, kg) + coef_xyz(161) = coef_xyz(161) + coef_xy(1, 18)*pol_z(1, 6, kg) + coef_xyz(161) = coef_xyz(161) + coef_xy(2, 18)*pol_z(2, 6, kg) + coef_xyz(162) = coef_xyz(162) + coef_xy(1, 1)*pol_z(1, 7, kg) + coef_xyz(162) = coef_xyz(162) + coef_xy(2, 1)*pol_z(2, 7, kg) + coef_xyz(163) = coef_xyz(163) + coef_xy(1, 2)*pol_z(1, 7, kg) + coef_xyz(163) = coef_xyz(163) + coef_xy(2, 2)*pol_z(2, 7, kg) + coef_xyz(164) = coef_xyz(164) + coef_xy(1, 10)*pol_z(1, 7, kg) + coef_xyz(164) = coef_xyz(164) + coef_xy(2, 10)*pol_z(2, 7, kg) + coef_xyz(165) = coef_xyz(165) + coef_xy(1, 1)*pol_z(1, 8, kg) + coef_xyz(165) = coef_xyz(165) + coef_xy(2, 1)*pol_z(2, 8, kg) END DO END SUBROUTINE integrate_core_8 @@ -2144,13 +2144,13 @@ SUBROUTINE integrate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s(4) sci = 1 @@ -2158,23 +2158,23 @@ SUBROUTINE integrate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -2183,568 +2183,568 @@ SUBROUTINE integrate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s(2) = grid(i, j, k2) s(3) = grid(i, j2, k) s(4) = grid(i, j2, k2) - coef_x(:, 0) = coef_x(:, 0)+s(:)*pol_x(0, ig) - coef_x(:, 1) = coef_x(:, 1)+s(:)*pol_x(1, ig) - coef_x(:, 2) = coef_x(:, 2)+s(:)*pol_x(2, ig) - coef_x(:, 3) = coef_x(:, 3)+s(:)*pol_x(3, ig) - coef_x(:, 4) = coef_x(:, 4)+s(:)*pol_x(4, ig) - coef_x(:, 5) = coef_x(:, 5)+s(:)*pol_x(5, ig) - coef_x(:, 6) = coef_x(:, 6)+s(:)*pol_x(6, ig) - coef_x(:, 7) = coef_x(:, 7)+s(:)*pol_x(7, ig) - coef_x(:, 8) = coef_x(:, 8)+s(:)*pol_x(8, ig) - coef_x(:, 9) = coef_x(:, 9)+s(:)*pol_x(9, ig) + coef_x(:, 0) = coef_x(:, 0) + s(:)*pol_x(0, ig) + coef_x(:, 1) = coef_x(:, 1) + s(:)*pol_x(1, ig) + coef_x(:, 2) = coef_x(:, 2) + s(:)*pol_x(2, ig) + coef_x(:, 3) = coef_x(:, 3) + s(:)*pol_x(3, ig) + coef_x(:, 4) = coef_x(:, 4) + s(:)*pol_x(4, ig) + coef_x(:, 5) = coef_x(:, 5) + s(:)*pol_x(5, ig) + coef_x(:, 6) = coef_x(:, 6) + s(:)*pol_x(6, ig) + coef_x(:, 7) = coef_x(:, 7) + s(:)*pol_x(7, ig) + coef_x(:, 8) = coef_x(:, 8) + s(:)*pol_x(8, ig) + coef_x(:, 9) = coef_x(:, 9) + s(:)*pol_x(9, ig) END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(1:2, 1)*pol_y(1, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(3:4, 1)*pol_y(2, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(1:2, 2)*pol_y(1, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(3:4, 2)*pol_y(2, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(1:2, 3)*pol_y(1, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(3:4, 3)*pol_y(2, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(1:2, 4)*pol_y(1, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(3:4, 4)*pol_y(2, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(1:2, 5)*pol_y(1, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(3:4, 5)*pol_y(2, 0, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(1:2, 6)*pol_y(1, 0, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(3:4, 6)*pol_y(2, 0, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(1:2, 7)*pol_y(1, 0, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(3:4, 7)*pol_y(2, 0, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(1:2, 8)*pol_y(1, 0, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(3:4, 8)*pol_y(2, 0, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(1:2, 9)*pol_y(1, 0, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(3:4, 9)*pol_y(2, 0, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(1:2, 0)*pol_y(1, 1, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(3:4, 0)*pol_y(2, 1, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(1:2, 1)*pol_y(1, 1, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(3:4, 1)*pol_y(2, 1, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(1:2, 2)*pol_y(1, 1, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(3:4, 2)*pol_y(2, 1, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(1:2, 3)*pol_y(1, 1, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(3:4, 3)*pol_y(2, 1, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(1:2, 4)*pol_y(1, 1, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(3:4, 4)*pol_y(2, 1, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(1:2, 5)*pol_y(1, 1, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(3:4, 5)*pol_y(2, 1, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(1:2, 6)*pol_y(1, 1, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(3:4, 6)*pol_y(2, 1, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(1:2, 7)*pol_y(1, 1, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(3:4, 7)*pol_y(2, 1, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(1:2, 8)*pol_y(1, 1, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(3:4, 8)*pol_y(2, 1, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(1:2, 0)*pol_y(1, 2, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(3:4, 0)*pol_y(2, 2, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(1:2, 1)*pol_y(1, 2, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(3:4, 1)*pol_y(2, 2, jg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_x(1:2, 2)*pol_y(1, 2, jg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_x(3:4, 2)*pol_y(2, 2, jg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_x(1:2, 3)*pol_y(1, 2, jg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_x(3:4, 3)*pol_y(2, 2, jg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_x(1:2, 4)*pol_y(1, 2, jg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_x(3:4, 4)*pol_y(2, 2, jg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_x(1:2, 5)*pol_y(1, 2, jg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_x(3:4, 5)*pol_y(2, 2, jg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_x(1:2, 6)*pol_y(1, 2, jg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_x(3:4, 6)*pol_y(2, 2, jg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_x(1:2, 7)*pol_y(1, 2, jg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_x(3:4, 7)*pol_y(2, 2, jg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_x(1:2, 0)*pol_y(1, 3, jg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_x(3:4, 0)*pol_y(2, 3, jg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_x(1:2, 1)*pol_y(1, 3, jg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_x(3:4, 1)*pol_y(2, 3, jg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_x(1:2, 2)*pol_y(1, 3, jg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_x(3:4, 2)*pol_y(2, 3, jg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_x(1:2, 3)*pol_y(1, 3, jg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_x(3:4, 3)*pol_y(2, 3, jg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_x(1:2, 4)*pol_y(1, 3, jg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_x(3:4, 4)*pol_y(2, 3, jg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_x(1:2, 5)*pol_y(1, 3, jg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_x(3:4, 5)*pol_y(2, 3, jg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_x(1:2, 6)*pol_y(1, 3, jg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_x(3:4, 6)*pol_y(2, 3, jg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_x(1:2, 0)*pol_y(1, 4, jg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_x(3:4, 0)*pol_y(2, 4, jg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_x(1:2, 1)*pol_y(1, 4, jg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_x(3:4, 1)*pol_y(2, 4, jg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_x(1:2, 2)*pol_y(1, 4, jg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_x(3:4, 2)*pol_y(2, 4, jg) - coef_xy(:, 38) = coef_xy(:, 38)+coef_x(1:2, 3)*pol_y(1, 4, jg) - coef_xy(:, 38) = coef_xy(:, 38)+coef_x(3:4, 3)*pol_y(2, 4, jg) - coef_xy(:, 39) = coef_xy(:, 39)+coef_x(1:2, 4)*pol_y(1, 4, jg) - coef_xy(:, 39) = coef_xy(:, 39)+coef_x(3:4, 4)*pol_y(2, 4, jg) - coef_xy(:, 40) = coef_xy(:, 40)+coef_x(1:2, 5)*pol_y(1, 4, jg) - coef_xy(:, 40) = coef_xy(:, 40)+coef_x(3:4, 5)*pol_y(2, 4, jg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_x(1:2, 0)*pol_y(1, 5, jg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_x(3:4, 0)*pol_y(2, 5, jg) - coef_xy(:, 42) = coef_xy(:, 42)+coef_x(1:2, 1)*pol_y(1, 5, jg) - coef_xy(:, 42) = coef_xy(:, 42)+coef_x(3:4, 1)*pol_y(2, 5, jg) - coef_xy(:, 43) = coef_xy(:, 43)+coef_x(1:2, 2)*pol_y(1, 5, jg) - coef_xy(:, 43) = coef_xy(:, 43)+coef_x(3:4, 2)*pol_y(2, 5, jg) - coef_xy(:, 44) = coef_xy(:, 44)+coef_x(1:2, 3)*pol_y(1, 5, jg) - coef_xy(:, 44) = coef_xy(:, 44)+coef_x(3:4, 3)*pol_y(2, 5, jg) - coef_xy(:, 45) = coef_xy(:, 45)+coef_x(1:2, 4)*pol_y(1, 5, jg) - coef_xy(:, 45) = coef_xy(:, 45)+coef_x(3:4, 4)*pol_y(2, 5, jg) - coef_xy(:, 46) = coef_xy(:, 46)+coef_x(1:2, 0)*pol_y(1, 6, jg) - coef_xy(:, 46) = coef_xy(:, 46)+coef_x(3:4, 0)*pol_y(2, 6, jg) - coef_xy(:, 47) = coef_xy(:, 47)+coef_x(1:2, 1)*pol_y(1, 6, jg) - coef_xy(:, 47) = coef_xy(:, 47)+coef_x(3:4, 1)*pol_y(2, 6, jg) - coef_xy(:, 48) = coef_xy(:, 48)+coef_x(1:2, 2)*pol_y(1, 6, jg) - coef_xy(:, 48) = coef_xy(:, 48)+coef_x(3:4, 2)*pol_y(2, 6, jg) - coef_xy(:, 49) = coef_xy(:, 49)+coef_x(1:2, 3)*pol_y(1, 6, jg) - coef_xy(:, 49) = coef_xy(:, 49)+coef_x(3:4, 3)*pol_y(2, 6, jg) - coef_xy(:, 50) = coef_xy(:, 50)+coef_x(1:2, 0)*pol_y(1, 7, jg) - coef_xy(:, 50) = coef_xy(:, 50)+coef_x(3:4, 0)*pol_y(2, 7, jg) - coef_xy(:, 51) = coef_xy(:, 51)+coef_x(1:2, 1)*pol_y(1, 7, jg) - coef_xy(:, 51) = coef_xy(:, 51)+coef_x(3:4, 1)*pol_y(2, 7, jg) - coef_xy(:, 52) = coef_xy(:, 52)+coef_x(1:2, 2)*pol_y(1, 7, jg) - coef_xy(:, 52) = coef_xy(:, 52)+coef_x(3:4, 2)*pol_y(2, 7, jg) - coef_xy(:, 53) = coef_xy(:, 53)+coef_x(1:2, 0)*pol_y(1, 8, jg) - coef_xy(:, 53) = coef_xy(:, 53)+coef_x(3:4, 0)*pol_y(2, 8, jg) - coef_xy(:, 54) = coef_xy(:, 54)+coef_x(1:2, 1)*pol_y(1, 8, jg) - coef_xy(:, 54) = coef_xy(:, 54)+coef_x(3:4, 1)*pol_y(2, 8, jg) - coef_xy(:, 55) = coef_xy(:, 55)+coef_x(1:2, 0)*pol_y(1, 9, jg) - coef_xy(:, 55) = coef_xy(:, 55)+coef_x(3:4, 0)*pol_y(2, 9, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(1:2, 1)*pol_y(1, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(3:4, 1)*pol_y(2, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(1:2, 2)*pol_y(1, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(3:4, 2)*pol_y(2, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(1:2, 3)*pol_y(1, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(3:4, 3)*pol_y(2, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(1:2, 4)*pol_y(1, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(3:4, 4)*pol_y(2, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(1:2, 5)*pol_y(1, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(3:4, 5)*pol_y(2, 0, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(1:2, 6)*pol_y(1, 0, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(3:4, 6)*pol_y(2, 0, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(1:2, 7)*pol_y(1, 0, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(3:4, 7)*pol_y(2, 0, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(1:2, 8)*pol_y(1, 0, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(3:4, 8)*pol_y(2, 0, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(1:2, 9)*pol_y(1, 0, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(3:4, 9)*pol_y(2, 0, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(1:2, 0)*pol_y(1, 1, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(3:4, 0)*pol_y(2, 1, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(1:2, 1)*pol_y(1, 1, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(3:4, 1)*pol_y(2, 1, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(1:2, 2)*pol_y(1, 1, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(3:4, 2)*pol_y(2, 1, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(1:2, 3)*pol_y(1, 1, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(3:4, 3)*pol_y(2, 1, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(1:2, 4)*pol_y(1, 1, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(3:4, 4)*pol_y(2, 1, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(1:2, 5)*pol_y(1, 1, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(3:4, 5)*pol_y(2, 1, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(1:2, 6)*pol_y(1, 1, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(3:4, 6)*pol_y(2, 1, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(1:2, 7)*pol_y(1, 1, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(3:4, 7)*pol_y(2, 1, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(1:2, 8)*pol_y(1, 1, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(3:4, 8)*pol_y(2, 1, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(1:2, 0)*pol_y(1, 2, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(3:4, 0)*pol_y(2, 2, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(1:2, 1)*pol_y(1, 2, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(3:4, 1)*pol_y(2, 2, jg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_x(1:2, 2)*pol_y(1, 2, jg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_x(3:4, 2)*pol_y(2, 2, jg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_x(1:2, 3)*pol_y(1, 2, jg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_x(3:4, 3)*pol_y(2, 2, jg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_x(1:2, 4)*pol_y(1, 2, jg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_x(3:4, 4)*pol_y(2, 2, jg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_x(1:2, 5)*pol_y(1, 2, jg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_x(3:4, 5)*pol_y(2, 2, jg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_x(1:2, 6)*pol_y(1, 2, jg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_x(3:4, 6)*pol_y(2, 2, jg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_x(1:2, 7)*pol_y(1, 2, jg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_x(3:4, 7)*pol_y(2, 2, jg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_x(1:2, 0)*pol_y(1, 3, jg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_x(3:4, 0)*pol_y(2, 3, jg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_x(1:2, 1)*pol_y(1, 3, jg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_x(3:4, 1)*pol_y(2, 3, jg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_x(1:2, 2)*pol_y(1, 3, jg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_x(3:4, 2)*pol_y(2, 3, jg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_x(1:2, 3)*pol_y(1, 3, jg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_x(3:4, 3)*pol_y(2, 3, jg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_x(1:2, 4)*pol_y(1, 3, jg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_x(3:4, 4)*pol_y(2, 3, jg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_x(1:2, 5)*pol_y(1, 3, jg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_x(3:4, 5)*pol_y(2, 3, jg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_x(1:2, 6)*pol_y(1, 3, jg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_x(3:4, 6)*pol_y(2, 3, jg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_x(1:2, 0)*pol_y(1, 4, jg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_x(3:4, 0)*pol_y(2, 4, jg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_x(1:2, 1)*pol_y(1, 4, jg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_x(3:4, 1)*pol_y(2, 4, jg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_x(1:2, 2)*pol_y(1, 4, jg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_x(3:4, 2)*pol_y(2, 4, jg) + coef_xy(:, 38) = coef_xy(:, 38) + coef_x(1:2, 3)*pol_y(1, 4, jg) + coef_xy(:, 38) = coef_xy(:, 38) + coef_x(3:4, 3)*pol_y(2, 4, jg) + coef_xy(:, 39) = coef_xy(:, 39) + coef_x(1:2, 4)*pol_y(1, 4, jg) + coef_xy(:, 39) = coef_xy(:, 39) + coef_x(3:4, 4)*pol_y(2, 4, jg) + coef_xy(:, 40) = coef_xy(:, 40) + coef_x(1:2, 5)*pol_y(1, 4, jg) + coef_xy(:, 40) = coef_xy(:, 40) + coef_x(3:4, 5)*pol_y(2, 4, jg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_x(1:2, 0)*pol_y(1, 5, jg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_x(3:4, 0)*pol_y(2, 5, jg) + coef_xy(:, 42) = coef_xy(:, 42) + coef_x(1:2, 1)*pol_y(1, 5, jg) + coef_xy(:, 42) = coef_xy(:, 42) + coef_x(3:4, 1)*pol_y(2, 5, jg) + coef_xy(:, 43) = coef_xy(:, 43) + coef_x(1:2, 2)*pol_y(1, 5, jg) + coef_xy(:, 43) = coef_xy(:, 43) + coef_x(3:4, 2)*pol_y(2, 5, jg) + coef_xy(:, 44) = coef_xy(:, 44) + coef_x(1:2, 3)*pol_y(1, 5, jg) + coef_xy(:, 44) = coef_xy(:, 44) + coef_x(3:4, 3)*pol_y(2, 5, jg) + coef_xy(:, 45) = coef_xy(:, 45) + coef_x(1:2, 4)*pol_y(1, 5, jg) + coef_xy(:, 45) = coef_xy(:, 45) + coef_x(3:4, 4)*pol_y(2, 5, jg) + coef_xy(:, 46) = coef_xy(:, 46) + coef_x(1:2, 0)*pol_y(1, 6, jg) + coef_xy(:, 46) = coef_xy(:, 46) + coef_x(3:4, 0)*pol_y(2, 6, jg) + coef_xy(:, 47) = coef_xy(:, 47) + coef_x(1:2, 1)*pol_y(1, 6, jg) + coef_xy(:, 47) = coef_xy(:, 47) + coef_x(3:4, 1)*pol_y(2, 6, jg) + coef_xy(:, 48) = coef_xy(:, 48) + coef_x(1:2, 2)*pol_y(1, 6, jg) + coef_xy(:, 48) = coef_xy(:, 48) + coef_x(3:4, 2)*pol_y(2, 6, jg) + coef_xy(:, 49) = coef_xy(:, 49) + coef_x(1:2, 3)*pol_y(1, 6, jg) + coef_xy(:, 49) = coef_xy(:, 49) + coef_x(3:4, 3)*pol_y(2, 6, jg) + coef_xy(:, 50) = coef_xy(:, 50) + coef_x(1:2, 0)*pol_y(1, 7, jg) + coef_xy(:, 50) = coef_xy(:, 50) + coef_x(3:4, 0)*pol_y(2, 7, jg) + coef_xy(:, 51) = coef_xy(:, 51) + coef_x(1:2, 1)*pol_y(1, 7, jg) + coef_xy(:, 51) = coef_xy(:, 51) + coef_x(3:4, 1)*pol_y(2, 7, jg) + coef_xy(:, 52) = coef_xy(:, 52) + coef_x(1:2, 2)*pol_y(1, 7, jg) + coef_xy(:, 52) = coef_xy(:, 52) + coef_x(3:4, 2)*pol_y(2, 7, jg) + coef_xy(:, 53) = coef_xy(:, 53) + coef_x(1:2, 0)*pol_y(1, 8, jg) + coef_xy(:, 53) = coef_xy(:, 53) + coef_x(3:4, 0)*pol_y(2, 8, jg) + coef_xy(:, 54) = coef_xy(:, 54) + coef_x(1:2, 1)*pol_y(1, 8, jg) + coef_xy(:, 54) = coef_xy(:, 54) + coef_x(3:4, 1)*pol_y(2, 8, jg) + coef_xy(:, 55) = coef_xy(:, 55) + coef_x(1:2, 0)*pol_y(1, 9, jg) + coef_xy(:, 55) = coef_xy(:, 55) + coef_x(3:4, 0)*pol_y(2, 9, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 11)*pol_z(1, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 11)*pol_z(2, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 12)*pol_z(1, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 12)*pol_z(2, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 13)*pol_z(1, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 13)*pol_z(2, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 14)*pol_z(1, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 14)*pol_z(2, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 15)*pol_z(1, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 15)*pol_z(2, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 16)*pol_z(1, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 16)*pol_z(2, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 17)*pol_z(1, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 17)*pol_z(2, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 18)*pol_z(1, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 18)*pol_z(2, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 19)*pol_z(1, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 19)*pol_z(2, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 20)*pol_z(1, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 20)*pol_z(2, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(1, 21)*pol_z(1, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(2, 21)*pol_z(2, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(1, 22)*pol_z(1, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(2, 22)*pol_z(2, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(1, 23)*pol_z(1, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(2, 23)*pol_z(2, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(1, 24)*pol_z(1, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(2, 24)*pol_z(2, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(1, 25)*pol_z(1, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(2, 25)*pol_z(2, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(1, 26)*pol_z(1, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(2, 26)*pol_z(2, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(1, 27)*pol_z(1, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(2, 27)*pol_z(2, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(1, 28)*pol_z(1, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(2, 28)*pol_z(2, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(1, 29)*pol_z(1, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(2, 29)*pol_z(2, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(1, 30)*pol_z(1, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(2, 30)*pol_z(2, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(1, 31)*pol_z(1, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(2, 31)*pol_z(2, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(1, 32)*pol_z(1, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(2, 32)*pol_z(2, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(1, 33)*pol_z(1, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(2, 33)*pol_z(2, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(1, 34)*pol_z(1, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(2, 34)*pol_z(2, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(1, 35)*pol_z(1, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(2, 35)*pol_z(2, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(1, 36)*pol_z(1, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(2, 36)*pol_z(2, 0, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(1, 37)*pol_z(1, 0, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(2, 37)*pol_z(2, 0, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(1, 38)*pol_z(1, 0, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(2, 38)*pol_z(2, 0, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(1, 39)*pol_z(1, 0, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(2, 39)*pol_z(2, 0, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(1, 40)*pol_z(1, 0, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(2, 40)*pol_z(2, 0, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(1, 41)*pol_z(1, 0, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(2, 41)*pol_z(2, 0, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(1, 42)*pol_z(1, 0, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(2, 42)*pol_z(2, 0, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(1, 43)*pol_z(1, 0, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(2, 43)*pol_z(2, 0, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(1, 44)*pol_z(1, 0, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(2, 44)*pol_z(2, 0, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(1, 45)*pol_z(1, 0, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(2, 45)*pol_z(2, 0, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(1, 46)*pol_z(1, 0, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(2, 46)*pol_z(2, 0, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(1, 47)*pol_z(1, 0, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(2, 47)*pol_z(2, 0, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(1, 48)*pol_z(1, 0, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(2, 48)*pol_z(2, 0, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(1, 49)*pol_z(1, 0, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(2, 49)*pol_z(2, 0, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(1, 50)*pol_z(1, 0, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(2, 50)*pol_z(2, 0, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(1, 51)*pol_z(1, 0, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(2, 51)*pol_z(2, 0, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(1, 52)*pol_z(1, 0, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(2, 52)*pol_z(2, 0, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(1, 53)*pol_z(1, 0, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(2, 53)*pol_z(2, 0, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(1, 54)*pol_z(1, 0, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(2, 54)*pol_z(2, 0, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(1, 55)*pol_z(1, 0, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(2, 55)*pol_z(2, 0, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(1, 5)*pol_z(1, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(2, 5)*pol_z(2, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(1, 7)*pol_z(1, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(2, 7)*pol_z(2, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(1, 8)*pol_z(1, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(2, 8)*pol_z(2, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(1, 9)*pol_z(1, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(2, 9)*pol_z(2, 1, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(1, 11)*pol_z(1, 1, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(2, 11)*pol_z(2, 1, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(1, 12)*pol_z(1, 1, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(2, 12)*pol_z(2, 1, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(1, 13)*pol_z(1, 1, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(2, 13)*pol_z(2, 1, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(1, 14)*pol_z(1, 1, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(2, 14)*pol_z(2, 1, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(1, 15)*pol_z(1, 1, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(2, 15)*pol_z(2, 1, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(1, 16)*pol_z(1, 1, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(2, 16)*pol_z(2, 1, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(1, 17)*pol_z(1, 1, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(2, 17)*pol_z(2, 1, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(1, 18)*pol_z(1, 1, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(2, 18)*pol_z(2, 1, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(1, 20)*pol_z(1, 1, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(2, 20)*pol_z(2, 1, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(1, 21)*pol_z(1, 1, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(2, 21)*pol_z(2, 1, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(1, 22)*pol_z(1, 1, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(2, 22)*pol_z(2, 1, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(1, 23)*pol_z(1, 1, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(2, 23)*pol_z(2, 1, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(1, 24)*pol_z(1, 1, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(2, 24)*pol_z(2, 1, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(1, 25)*pol_z(1, 1, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(2, 25)*pol_z(2, 1, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(1, 26)*pol_z(1, 1, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(2, 26)*pol_z(2, 1, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(1, 28)*pol_z(1, 1, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(2, 28)*pol_z(2, 1, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(1, 29)*pol_z(1, 1, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(2, 29)*pol_z(2, 1, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(1, 30)*pol_z(1, 1, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(2, 30)*pol_z(2, 1, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(1, 31)*pol_z(1, 1, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(2, 31)*pol_z(2, 1, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(1, 32)*pol_z(1, 1, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(2, 32)*pol_z(2, 1, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(1, 33)*pol_z(1, 1, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(2, 33)*pol_z(2, 1, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(1, 35)*pol_z(1, 1, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(2, 35)*pol_z(2, 1, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(1, 36)*pol_z(1, 1, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(2, 36)*pol_z(2, 1, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(1, 37)*pol_z(1, 1, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(2, 37)*pol_z(2, 1, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(1, 38)*pol_z(1, 1, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(2, 38)*pol_z(2, 1, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(1, 39)*pol_z(1, 1, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(2, 39)*pol_z(2, 1, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(1, 41)*pol_z(1, 1, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(2, 41)*pol_z(2, 1, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(1, 42)*pol_z(1, 1, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(2, 42)*pol_z(2, 1, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(1, 43)*pol_z(1, 1, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(2, 43)*pol_z(2, 1, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(1, 44)*pol_z(1, 1, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(2, 44)*pol_z(2, 1, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(1, 46)*pol_z(1, 1, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(2, 46)*pol_z(2, 1, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(1, 47)*pol_z(1, 1, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(2, 47)*pol_z(2, 1, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(1, 48)*pol_z(1, 1, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(2, 48)*pol_z(2, 1, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(1, 50)*pol_z(1, 1, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(2, 50)*pol_z(2, 1, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(1, 51)*pol_z(1, 1, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(2, 51)*pol_z(2, 1, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(1, 53)*pol_z(1, 1, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(2, 53)*pol_z(2, 1, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(1, 3)*pol_z(1, 2, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(2, 3)*pol_z(2, 2, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(1, 4)*pol_z(1, 2, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(2, 4)*pol_z(2, 2, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(1, 5)*pol_z(1, 2, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(2, 5)*pol_z(2, 2, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(1, 6)*pol_z(1, 2, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(2, 6)*pol_z(2, 2, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(1, 7)*pol_z(1, 2, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(2, 7)*pol_z(2, 2, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(1, 8)*pol_z(1, 2, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(2, 8)*pol_z(2, 2, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(1, 11)*pol_z(1, 2, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(2, 11)*pol_z(2, 2, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(1, 12)*pol_z(1, 2, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(2, 12)*pol_z(2, 2, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(1, 13)*pol_z(1, 2, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(2, 13)*pol_z(2, 2, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(1, 14)*pol_z(1, 2, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(2, 14)*pol_z(2, 2, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(1, 15)*pol_z(1, 2, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(2, 15)*pol_z(2, 2, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(1, 16)*pol_z(1, 2, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(2, 16)*pol_z(2, 2, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(1, 17)*pol_z(1, 2, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(2, 17)*pol_z(2, 2, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(1, 20)*pol_z(1, 2, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(2, 20)*pol_z(2, 2, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(1, 21)*pol_z(1, 2, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(2, 21)*pol_z(2, 2, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(1, 22)*pol_z(1, 2, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(2, 22)*pol_z(2, 2, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(1, 23)*pol_z(1, 2, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(2, 23)*pol_z(2, 2, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(1, 24)*pol_z(1, 2, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(2, 24)*pol_z(2, 2, kg) - coef_xyz(121) = coef_xyz(121)+coef_xy(1, 25)*pol_z(1, 2, kg) - coef_xyz(121) = coef_xyz(121)+coef_xy(2, 25)*pol_z(2, 2, kg) - coef_xyz(122) = coef_xyz(122)+coef_xy(1, 28)*pol_z(1, 2, kg) - coef_xyz(122) = coef_xyz(122)+coef_xy(2, 28)*pol_z(2, 2, kg) - coef_xyz(123) = coef_xyz(123)+coef_xy(1, 29)*pol_z(1, 2, kg) - coef_xyz(123) = coef_xyz(123)+coef_xy(2, 29)*pol_z(2, 2, kg) - coef_xyz(124) = coef_xyz(124)+coef_xy(1, 30)*pol_z(1, 2, kg) - coef_xyz(124) = coef_xyz(124)+coef_xy(2, 30)*pol_z(2, 2, kg) - coef_xyz(125) = coef_xyz(125)+coef_xy(1, 31)*pol_z(1, 2, kg) - coef_xyz(125) = coef_xyz(125)+coef_xy(2, 31)*pol_z(2, 2, kg) - coef_xyz(126) = coef_xyz(126)+coef_xy(1, 32)*pol_z(1, 2, kg) - coef_xyz(126) = coef_xyz(126)+coef_xy(2, 32)*pol_z(2, 2, kg) - coef_xyz(127) = coef_xyz(127)+coef_xy(1, 35)*pol_z(1, 2, kg) - coef_xyz(127) = coef_xyz(127)+coef_xy(2, 35)*pol_z(2, 2, kg) - coef_xyz(128) = coef_xyz(128)+coef_xy(1, 36)*pol_z(1, 2, kg) - coef_xyz(128) = coef_xyz(128)+coef_xy(2, 36)*pol_z(2, 2, kg) - coef_xyz(129) = coef_xyz(129)+coef_xy(1, 37)*pol_z(1, 2, kg) - coef_xyz(129) = coef_xyz(129)+coef_xy(2, 37)*pol_z(2, 2, kg) - coef_xyz(130) = coef_xyz(130)+coef_xy(1, 38)*pol_z(1, 2, kg) - coef_xyz(130) = coef_xyz(130)+coef_xy(2, 38)*pol_z(2, 2, kg) - coef_xyz(131) = coef_xyz(131)+coef_xy(1, 41)*pol_z(1, 2, kg) - coef_xyz(131) = coef_xyz(131)+coef_xy(2, 41)*pol_z(2, 2, kg) - coef_xyz(132) = coef_xyz(132)+coef_xy(1, 42)*pol_z(1, 2, kg) - coef_xyz(132) = coef_xyz(132)+coef_xy(2, 42)*pol_z(2, 2, kg) - coef_xyz(133) = coef_xyz(133)+coef_xy(1, 43)*pol_z(1, 2, kg) - coef_xyz(133) = coef_xyz(133)+coef_xy(2, 43)*pol_z(2, 2, kg) - coef_xyz(134) = coef_xyz(134)+coef_xy(1, 46)*pol_z(1, 2, kg) - coef_xyz(134) = coef_xyz(134)+coef_xy(2, 46)*pol_z(2, 2, kg) - coef_xyz(135) = coef_xyz(135)+coef_xy(1, 47)*pol_z(1, 2, kg) - coef_xyz(135) = coef_xyz(135)+coef_xy(2, 47)*pol_z(2, 2, kg) - coef_xyz(136) = coef_xyz(136)+coef_xy(1, 50)*pol_z(1, 2, kg) - coef_xyz(136) = coef_xyz(136)+coef_xy(2, 50)*pol_z(2, 2, kg) - coef_xyz(137) = coef_xyz(137)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(137) = coef_xyz(137)+coef_xy(2, 1)*pol_z(2, 3, kg) - coef_xyz(138) = coef_xyz(138)+coef_xy(1, 2)*pol_z(1, 3, kg) - coef_xyz(138) = coef_xyz(138)+coef_xy(2, 2)*pol_z(2, 3, kg) - coef_xyz(139) = coef_xyz(139)+coef_xy(1, 3)*pol_z(1, 3, kg) - coef_xyz(139) = coef_xyz(139)+coef_xy(2, 3)*pol_z(2, 3, kg) - coef_xyz(140) = coef_xyz(140)+coef_xy(1, 4)*pol_z(1, 3, kg) - coef_xyz(140) = coef_xyz(140)+coef_xy(2, 4)*pol_z(2, 3, kg) - coef_xyz(141) = coef_xyz(141)+coef_xy(1, 5)*pol_z(1, 3, kg) - coef_xyz(141) = coef_xyz(141)+coef_xy(2, 5)*pol_z(2, 3, kg) - coef_xyz(142) = coef_xyz(142)+coef_xy(1, 6)*pol_z(1, 3, kg) - coef_xyz(142) = coef_xyz(142)+coef_xy(2, 6)*pol_z(2, 3, kg) - coef_xyz(143) = coef_xyz(143)+coef_xy(1, 7)*pol_z(1, 3, kg) - coef_xyz(143) = coef_xyz(143)+coef_xy(2, 7)*pol_z(2, 3, kg) - coef_xyz(144) = coef_xyz(144)+coef_xy(1, 11)*pol_z(1, 3, kg) - coef_xyz(144) = coef_xyz(144)+coef_xy(2, 11)*pol_z(2, 3, kg) - coef_xyz(145) = coef_xyz(145)+coef_xy(1, 12)*pol_z(1, 3, kg) - coef_xyz(145) = coef_xyz(145)+coef_xy(2, 12)*pol_z(2, 3, kg) - coef_xyz(146) = coef_xyz(146)+coef_xy(1, 13)*pol_z(1, 3, kg) - coef_xyz(146) = coef_xyz(146)+coef_xy(2, 13)*pol_z(2, 3, kg) - coef_xyz(147) = coef_xyz(147)+coef_xy(1, 14)*pol_z(1, 3, kg) - coef_xyz(147) = coef_xyz(147)+coef_xy(2, 14)*pol_z(2, 3, kg) - coef_xyz(148) = coef_xyz(148)+coef_xy(1, 15)*pol_z(1, 3, kg) - coef_xyz(148) = coef_xyz(148)+coef_xy(2, 15)*pol_z(2, 3, kg) - coef_xyz(149) = coef_xyz(149)+coef_xy(1, 16)*pol_z(1, 3, kg) - coef_xyz(149) = coef_xyz(149)+coef_xy(2, 16)*pol_z(2, 3, kg) - coef_xyz(150) = coef_xyz(150)+coef_xy(1, 20)*pol_z(1, 3, kg) - coef_xyz(150) = coef_xyz(150)+coef_xy(2, 20)*pol_z(2, 3, kg) - coef_xyz(151) = coef_xyz(151)+coef_xy(1, 21)*pol_z(1, 3, kg) - coef_xyz(151) = coef_xyz(151)+coef_xy(2, 21)*pol_z(2, 3, kg) - coef_xyz(152) = coef_xyz(152)+coef_xy(1, 22)*pol_z(1, 3, kg) - coef_xyz(152) = coef_xyz(152)+coef_xy(2, 22)*pol_z(2, 3, kg) - coef_xyz(153) = coef_xyz(153)+coef_xy(1, 23)*pol_z(1, 3, kg) - coef_xyz(153) = coef_xyz(153)+coef_xy(2, 23)*pol_z(2, 3, kg) - coef_xyz(154) = coef_xyz(154)+coef_xy(1, 24)*pol_z(1, 3, kg) - coef_xyz(154) = coef_xyz(154)+coef_xy(2, 24)*pol_z(2, 3, kg) - coef_xyz(155) = coef_xyz(155)+coef_xy(1, 28)*pol_z(1, 3, kg) - coef_xyz(155) = coef_xyz(155)+coef_xy(2, 28)*pol_z(2, 3, kg) - coef_xyz(156) = coef_xyz(156)+coef_xy(1, 29)*pol_z(1, 3, kg) - coef_xyz(156) = coef_xyz(156)+coef_xy(2, 29)*pol_z(2, 3, kg) - coef_xyz(157) = coef_xyz(157)+coef_xy(1, 30)*pol_z(1, 3, kg) - coef_xyz(157) = coef_xyz(157)+coef_xy(2, 30)*pol_z(2, 3, kg) - coef_xyz(158) = coef_xyz(158)+coef_xy(1, 31)*pol_z(1, 3, kg) - coef_xyz(158) = coef_xyz(158)+coef_xy(2, 31)*pol_z(2, 3, kg) - coef_xyz(159) = coef_xyz(159)+coef_xy(1, 35)*pol_z(1, 3, kg) - coef_xyz(159) = coef_xyz(159)+coef_xy(2, 35)*pol_z(2, 3, kg) - coef_xyz(160) = coef_xyz(160)+coef_xy(1, 36)*pol_z(1, 3, kg) - coef_xyz(160) = coef_xyz(160)+coef_xy(2, 36)*pol_z(2, 3, kg) - coef_xyz(161) = coef_xyz(161)+coef_xy(1, 37)*pol_z(1, 3, kg) - coef_xyz(161) = coef_xyz(161)+coef_xy(2, 37)*pol_z(2, 3, kg) - coef_xyz(162) = coef_xyz(162)+coef_xy(1, 41)*pol_z(1, 3, kg) - coef_xyz(162) = coef_xyz(162)+coef_xy(2, 41)*pol_z(2, 3, kg) - coef_xyz(163) = coef_xyz(163)+coef_xy(1, 42)*pol_z(1, 3, kg) - coef_xyz(163) = coef_xyz(163)+coef_xy(2, 42)*pol_z(2, 3, kg) - coef_xyz(164) = coef_xyz(164)+coef_xy(1, 46)*pol_z(1, 3, kg) - coef_xyz(164) = coef_xyz(164)+coef_xy(2, 46)*pol_z(2, 3, kg) - coef_xyz(165) = coef_xyz(165)+coef_xy(1, 1)*pol_z(1, 4, kg) - coef_xyz(165) = coef_xyz(165)+coef_xy(2, 1)*pol_z(2, 4, kg) - coef_xyz(166) = coef_xyz(166)+coef_xy(1, 2)*pol_z(1, 4, kg) - coef_xyz(166) = coef_xyz(166)+coef_xy(2, 2)*pol_z(2, 4, kg) - coef_xyz(167) = coef_xyz(167)+coef_xy(1, 3)*pol_z(1, 4, kg) - coef_xyz(167) = coef_xyz(167)+coef_xy(2, 3)*pol_z(2, 4, kg) - coef_xyz(168) = coef_xyz(168)+coef_xy(1, 4)*pol_z(1, 4, kg) - coef_xyz(168) = coef_xyz(168)+coef_xy(2, 4)*pol_z(2, 4, kg) - coef_xyz(169) = coef_xyz(169)+coef_xy(1, 5)*pol_z(1, 4, kg) - coef_xyz(169) = coef_xyz(169)+coef_xy(2, 5)*pol_z(2, 4, kg) - coef_xyz(170) = coef_xyz(170)+coef_xy(1, 6)*pol_z(1, 4, kg) - coef_xyz(170) = coef_xyz(170)+coef_xy(2, 6)*pol_z(2, 4, kg) - coef_xyz(171) = coef_xyz(171)+coef_xy(1, 11)*pol_z(1, 4, kg) - coef_xyz(171) = coef_xyz(171)+coef_xy(2, 11)*pol_z(2, 4, kg) - coef_xyz(172) = coef_xyz(172)+coef_xy(1, 12)*pol_z(1, 4, kg) - coef_xyz(172) = coef_xyz(172)+coef_xy(2, 12)*pol_z(2, 4, kg) - coef_xyz(173) = coef_xyz(173)+coef_xy(1, 13)*pol_z(1, 4, kg) - coef_xyz(173) = coef_xyz(173)+coef_xy(2, 13)*pol_z(2, 4, kg) - coef_xyz(174) = coef_xyz(174)+coef_xy(1, 14)*pol_z(1, 4, kg) - coef_xyz(174) = coef_xyz(174)+coef_xy(2, 14)*pol_z(2, 4, kg) - coef_xyz(175) = coef_xyz(175)+coef_xy(1, 15)*pol_z(1, 4, kg) - coef_xyz(175) = coef_xyz(175)+coef_xy(2, 15)*pol_z(2, 4, kg) - coef_xyz(176) = coef_xyz(176)+coef_xy(1, 20)*pol_z(1, 4, kg) - coef_xyz(176) = coef_xyz(176)+coef_xy(2, 20)*pol_z(2, 4, kg) - coef_xyz(177) = coef_xyz(177)+coef_xy(1, 21)*pol_z(1, 4, kg) - coef_xyz(177) = coef_xyz(177)+coef_xy(2, 21)*pol_z(2, 4, kg) - coef_xyz(178) = coef_xyz(178)+coef_xy(1, 22)*pol_z(1, 4, kg) - coef_xyz(178) = coef_xyz(178)+coef_xy(2, 22)*pol_z(2, 4, kg) - coef_xyz(179) = coef_xyz(179)+coef_xy(1, 23)*pol_z(1, 4, kg) - coef_xyz(179) = coef_xyz(179)+coef_xy(2, 23)*pol_z(2, 4, kg) - coef_xyz(180) = coef_xyz(180)+coef_xy(1, 28)*pol_z(1, 4, kg) - coef_xyz(180) = coef_xyz(180)+coef_xy(2, 28)*pol_z(2, 4, kg) - coef_xyz(181) = coef_xyz(181)+coef_xy(1, 29)*pol_z(1, 4, kg) - coef_xyz(181) = coef_xyz(181)+coef_xy(2, 29)*pol_z(2, 4, kg) - coef_xyz(182) = coef_xyz(182)+coef_xy(1, 30)*pol_z(1, 4, kg) - coef_xyz(182) = coef_xyz(182)+coef_xy(2, 30)*pol_z(2, 4, kg) - coef_xyz(183) = coef_xyz(183)+coef_xy(1, 35)*pol_z(1, 4, kg) - coef_xyz(183) = coef_xyz(183)+coef_xy(2, 35)*pol_z(2, 4, kg) - coef_xyz(184) = coef_xyz(184)+coef_xy(1, 36)*pol_z(1, 4, kg) - coef_xyz(184) = coef_xyz(184)+coef_xy(2, 36)*pol_z(2, 4, kg) - coef_xyz(185) = coef_xyz(185)+coef_xy(1, 41)*pol_z(1, 4, kg) - coef_xyz(185) = coef_xyz(185)+coef_xy(2, 41)*pol_z(2, 4, kg) - coef_xyz(186) = coef_xyz(186)+coef_xy(1, 1)*pol_z(1, 5, kg) - coef_xyz(186) = coef_xyz(186)+coef_xy(2, 1)*pol_z(2, 5, kg) - coef_xyz(187) = coef_xyz(187)+coef_xy(1, 2)*pol_z(1, 5, kg) - coef_xyz(187) = coef_xyz(187)+coef_xy(2, 2)*pol_z(2, 5, kg) - coef_xyz(188) = coef_xyz(188)+coef_xy(1, 3)*pol_z(1, 5, kg) - coef_xyz(188) = coef_xyz(188)+coef_xy(2, 3)*pol_z(2, 5, kg) - coef_xyz(189) = coef_xyz(189)+coef_xy(1, 4)*pol_z(1, 5, kg) - coef_xyz(189) = coef_xyz(189)+coef_xy(2, 4)*pol_z(2, 5, kg) - coef_xyz(190) = coef_xyz(190)+coef_xy(1, 5)*pol_z(1, 5, kg) - coef_xyz(190) = coef_xyz(190)+coef_xy(2, 5)*pol_z(2, 5, kg) - coef_xyz(191) = coef_xyz(191)+coef_xy(1, 11)*pol_z(1, 5, kg) - coef_xyz(191) = coef_xyz(191)+coef_xy(2, 11)*pol_z(2, 5, kg) - coef_xyz(192) = coef_xyz(192)+coef_xy(1, 12)*pol_z(1, 5, kg) - coef_xyz(192) = coef_xyz(192)+coef_xy(2, 12)*pol_z(2, 5, kg) - coef_xyz(193) = coef_xyz(193)+coef_xy(1, 13)*pol_z(1, 5, kg) - coef_xyz(193) = coef_xyz(193)+coef_xy(2, 13)*pol_z(2, 5, kg) - coef_xyz(194) = coef_xyz(194)+coef_xy(1, 14)*pol_z(1, 5, kg) - coef_xyz(194) = coef_xyz(194)+coef_xy(2, 14)*pol_z(2, 5, kg) - coef_xyz(195) = coef_xyz(195)+coef_xy(1, 20)*pol_z(1, 5, kg) - coef_xyz(195) = coef_xyz(195)+coef_xy(2, 20)*pol_z(2, 5, kg) - coef_xyz(196) = coef_xyz(196)+coef_xy(1, 21)*pol_z(1, 5, kg) - coef_xyz(196) = coef_xyz(196)+coef_xy(2, 21)*pol_z(2, 5, kg) - coef_xyz(197) = coef_xyz(197)+coef_xy(1, 22)*pol_z(1, 5, kg) - coef_xyz(197) = coef_xyz(197)+coef_xy(2, 22)*pol_z(2, 5, kg) - coef_xyz(198) = coef_xyz(198)+coef_xy(1, 28)*pol_z(1, 5, kg) - coef_xyz(198) = coef_xyz(198)+coef_xy(2, 28)*pol_z(2, 5, kg) - coef_xyz(199) = coef_xyz(199)+coef_xy(1, 29)*pol_z(1, 5, kg) - coef_xyz(199) = coef_xyz(199)+coef_xy(2, 29)*pol_z(2, 5, kg) - coef_xyz(200) = coef_xyz(200)+coef_xy(1, 35)*pol_z(1, 5, kg) - coef_xyz(200) = coef_xyz(200)+coef_xy(2, 35)*pol_z(2, 5, kg) - coef_xyz(201) = coef_xyz(201)+coef_xy(1, 1)*pol_z(1, 6, kg) - coef_xyz(201) = coef_xyz(201)+coef_xy(2, 1)*pol_z(2, 6, kg) - coef_xyz(202) = coef_xyz(202)+coef_xy(1, 2)*pol_z(1, 6, kg) - coef_xyz(202) = coef_xyz(202)+coef_xy(2, 2)*pol_z(2, 6, kg) - coef_xyz(203) = coef_xyz(203)+coef_xy(1, 3)*pol_z(1, 6, kg) - coef_xyz(203) = coef_xyz(203)+coef_xy(2, 3)*pol_z(2, 6, kg) - coef_xyz(204) = coef_xyz(204)+coef_xy(1, 4)*pol_z(1, 6, kg) - coef_xyz(204) = coef_xyz(204)+coef_xy(2, 4)*pol_z(2, 6, kg) - coef_xyz(205) = coef_xyz(205)+coef_xy(1, 11)*pol_z(1, 6, kg) - coef_xyz(205) = coef_xyz(205)+coef_xy(2, 11)*pol_z(2, 6, kg) - coef_xyz(206) = coef_xyz(206)+coef_xy(1, 12)*pol_z(1, 6, kg) - coef_xyz(206) = coef_xyz(206)+coef_xy(2, 12)*pol_z(2, 6, kg) - coef_xyz(207) = coef_xyz(207)+coef_xy(1, 13)*pol_z(1, 6, kg) - coef_xyz(207) = coef_xyz(207)+coef_xy(2, 13)*pol_z(2, 6, kg) - coef_xyz(208) = coef_xyz(208)+coef_xy(1, 20)*pol_z(1, 6, kg) - coef_xyz(208) = coef_xyz(208)+coef_xy(2, 20)*pol_z(2, 6, kg) - coef_xyz(209) = coef_xyz(209)+coef_xy(1, 21)*pol_z(1, 6, kg) - coef_xyz(209) = coef_xyz(209)+coef_xy(2, 21)*pol_z(2, 6, kg) - coef_xyz(210) = coef_xyz(210)+coef_xy(1, 28)*pol_z(1, 6, kg) - coef_xyz(210) = coef_xyz(210)+coef_xy(2, 28)*pol_z(2, 6, kg) - coef_xyz(211) = coef_xyz(211)+coef_xy(1, 1)*pol_z(1, 7, kg) - coef_xyz(211) = coef_xyz(211)+coef_xy(2, 1)*pol_z(2, 7, kg) - coef_xyz(212) = coef_xyz(212)+coef_xy(1, 2)*pol_z(1, 7, kg) - coef_xyz(212) = coef_xyz(212)+coef_xy(2, 2)*pol_z(2, 7, kg) - coef_xyz(213) = coef_xyz(213)+coef_xy(1, 3)*pol_z(1, 7, kg) - coef_xyz(213) = coef_xyz(213)+coef_xy(2, 3)*pol_z(2, 7, kg) - coef_xyz(214) = coef_xyz(214)+coef_xy(1, 11)*pol_z(1, 7, kg) - coef_xyz(214) = coef_xyz(214)+coef_xy(2, 11)*pol_z(2, 7, kg) - coef_xyz(215) = coef_xyz(215)+coef_xy(1, 12)*pol_z(1, 7, kg) - coef_xyz(215) = coef_xyz(215)+coef_xy(2, 12)*pol_z(2, 7, kg) - coef_xyz(216) = coef_xyz(216)+coef_xy(1, 20)*pol_z(1, 7, kg) - coef_xyz(216) = coef_xyz(216)+coef_xy(2, 20)*pol_z(2, 7, kg) - coef_xyz(217) = coef_xyz(217)+coef_xy(1, 1)*pol_z(1, 8, kg) - coef_xyz(217) = coef_xyz(217)+coef_xy(2, 1)*pol_z(2, 8, kg) - coef_xyz(218) = coef_xyz(218)+coef_xy(1, 2)*pol_z(1, 8, kg) - coef_xyz(218) = coef_xyz(218)+coef_xy(2, 2)*pol_z(2, 8, kg) - coef_xyz(219) = coef_xyz(219)+coef_xy(1, 11)*pol_z(1, 8, kg) - coef_xyz(219) = coef_xyz(219)+coef_xy(2, 11)*pol_z(2, 8, kg) - coef_xyz(220) = coef_xyz(220)+coef_xy(1, 1)*pol_z(1, 9, kg) - coef_xyz(220) = coef_xyz(220)+coef_xy(2, 1)*pol_z(2, 9, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 11)*pol_z(1, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 11)*pol_z(2, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 12)*pol_z(1, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 12)*pol_z(2, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 13)*pol_z(1, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 13)*pol_z(2, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 14)*pol_z(1, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 14)*pol_z(2, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 15)*pol_z(1, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 15)*pol_z(2, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 16)*pol_z(1, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 16)*pol_z(2, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 17)*pol_z(1, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 17)*pol_z(2, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 18)*pol_z(1, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 18)*pol_z(2, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 19)*pol_z(1, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 19)*pol_z(2, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 20)*pol_z(1, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 20)*pol_z(2, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(1, 21)*pol_z(1, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(2, 21)*pol_z(2, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(1, 22)*pol_z(1, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(2, 22)*pol_z(2, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(1, 23)*pol_z(1, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(2, 23)*pol_z(2, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(1, 24)*pol_z(1, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(2, 24)*pol_z(2, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(1, 25)*pol_z(1, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(2, 25)*pol_z(2, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(1, 26)*pol_z(1, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(2, 26)*pol_z(2, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(1, 27)*pol_z(1, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(2, 27)*pol_z(2, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(1, 28)*pol_z(1, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(2, 28)*pol_z(2, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(1, 29)*pol_z(1, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(2, 29)*pol_z(2, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(1, 30)*pol_z(1, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(2, 30)*pol_z(2, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(1, 31)*pol_z(1, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(2, 31)*pol_z(2, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(1, 32)*pol_z(1, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(2, 32)*pol_z(2, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(1, 33)*pol_z(1, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(2, 33)*pol_z(2, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(1, 34)*pol_z(1, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(2, 34)*pol_z(2, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(1, 35)*pol_z(1, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(2, 35)*pol_z(2, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(1, 36)*pol_z(1, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(2, 36)*pol_z(2, 0, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(1, 37)*pol_z(1, 0, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(2, 37)*pol_z(2, 0, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(1, 38)*pol_z(1, 0, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(2, 38)*pol_z(2, 0, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(1, 39)*pol_z(1, 0, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(2, 39)*pol_z(2, 0, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(1, 40)*pol_z(1, 0, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(2, 40)*pol_z(2, 0, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(1, 41)*pol_z(1, 0, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(2, 41)*pol_z(2, 0, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(1, 42)*pol_z(1, 0, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(2, 42)*pol_z(2, 0, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(1, 43)*pol_z(1, 0, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(2, 43)*pol_z(2, 0, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(1, 44)*pol_z(1, 0, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(2, 44)*pol_z(2, 0, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(1, 45)*pol_z(1, 0, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(2, 45)*pol_z(2, 0, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(1, 46)*pol_z(1, 0, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(2, 46)*pol_z(2, 0, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(1, 47)*pol_z(1, 0, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(2, 47)*pol_z(2, 0, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(1, 48)*pol_z(1, 0, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(2, 48)*pol_z(2, 0, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(1, 49)*pol_z(1, 0, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(2, 49)*pol_z(2, 0, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(1, 50)*pol_z(1, 0, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(2, 50)*pol_z(2, 0, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(1, 51)*pol_z(1, 0, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(2, 51)*pol_z(2, 0, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(1, 52)*pol_z(1, 0, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(2, 52)*pol_z(2, 0, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(1, 53)*pol_z(1, 0, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(2, 53)*pol_z(2, 0, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(1, 54)*pol_z(1, 0, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(2, 54)*pol_z(2, 0, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(1, 55)*pol_z(1, 0, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(2, 55)*pol_z(2, 0, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(1, 5)*pol_z(1, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(2, 5)*pol_z(2, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(1, 7)*pol_z(1, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(2, 7)*pol_z(2, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(1, 8)*pol_z(1, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(2, 8)*pol_z(2, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(1, 9)*pol_z(1, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(2, 9)*pol_z(2, 1, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(1, 11)*pol_z(1, 1, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(2, 11)*pol_z(2, 1, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(1, 12)*pol_z(1, 1, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(2, 12)*pol_z(2, 1, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(1, 13)*pol_z(1, 1, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(2, 13)*pol_z(2, 1, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(1, 14)*pol_z(1, 1, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(2, 14)*pol_z(2, 1, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(1, 15)*pol_z(1, 1, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(2, 15)*pol_z(2, 1, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(1, 16)*pol_z(1, 1, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(2, 16)*pol_z(2, 1, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(1, 17)*pol_z(1, 1, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(2, 17)*pol_z(2, 1, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(1, 18)*pol_z(1, 1, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(2, 18)*pol_z(2, 1, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(1, 20)*pol_z(1, 1, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(2, 20)*pol_z(2, 1, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(1, 21)*pol_z(1, 1, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(2, 21)*pol_z(2, 1, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(1, 22)*pol_z(1, 1, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(2, 22)*pol_z(2, 1, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(1, 23)*pol_z(1, 1, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(2, 23)*pol_z(2, 1, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(1, 24)*pol_z(1, 1, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(2, 24)*pol_z(2, 1, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(1, 25)*pol_z(1, 1, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(2, 25)*pol_z(2, 1, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(1, 26)*pol_z(1, 1, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(2, 26)*pol_z(2, 1, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(1, 28)*pol_z(1, 1, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(2, 28)*pol_z(2, 1, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(1, 29)*pol_z(1, 1, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(2, 29)*pol_z(2, 1, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(1, 30)*pol_z(1, 1, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(2, 30)*pol_z(2, 1, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(1, 31)*pol_z(1, 1, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(2, 31)*pol_z(2, 1, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(1, 32)*pol_z(1, 1, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(2, 32)*pol_z(2, 1, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(1, 33)*pol_z(1, 1, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(2, 33)*pol_z(2, 1, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(1, 35)*pol_z(1, 1, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(2, 35)*pol_z(2, 1, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(1, 36)*pol_z(1, 1, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(2, 36)*pol_z(2, 1, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(1, 37)*pol_z(1, 1, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(2, 37)*pol_z(2, 1, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(1, 38)*pol_z(1, 1, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(2, 38)*pol_z(2, 1, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(1, 39)*pol_z(1, 1, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(2, 39)*pol_z(2, 1, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(1, 41)*pol_z(1, 1, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(2, 41)*pol_z(2, 1, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(1, 42)*pol_z(1, 1, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(2, 42)*pol_z(2, 1, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(1, 43)*pol_z(1, 1, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(2, 43)*pol_z(2, 1, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(1, 44)*pol_z(1, 1, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(2, 44)*pol_z(2, 1, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(1, 46)*pol_z(1, 1, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(2, 46)*pol_z(2, 1, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(1, 47)*pol_z(1, 1, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(2, 47)*pol_z(2, 1, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(1, 48)*pol_z(1, 1, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(2, 48)*pol_z(2, 1, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(1, 50)*pol_z(1, 1, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(2, 50)*pol_z(2, 1, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(1, 51)*pol_z(1, 1, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(2, 51)*pol_z(2, 1, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(1, 53)*pol_z(1, 1, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(2, 53)*pol_z(2, 1, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(1, 3)*pol_z(1, 2, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(2, 3)*pol_z(2, 2, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(1, 4)*pol_z(1, 2, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(2, 4)*pol_z(2, 2, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(1, 5)*pol_z(1, 2, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(2, 5)*pol_z(2, 2, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(1, 6)*pol_z(1, 2, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(2, 6)*pol_z(2, 2, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(1, 7)*pol_z(1, 2, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(2, 7)*pol_z(2, 2, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(1, 8)*pol_z(1, 2, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(2, 8)*pol_z(2, 2, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(1, 11)*pol_z(1, 2, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(2, 11)*pol_z(2, 2, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(1, 12)*pol_z(1, 2, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(2, 12)*pol_z(2, 2, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(1, 13)*pol_z(1, 2, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(2, 13)*pol_z(2, 2, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(1, 14)*pol_z(1, 2, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(2, 14)*pol_z(2, 2, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(1, 15)*pol_z(1, 2, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(2, 15)*pol_z(2, 2, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(1, 16)*pol_z(1, 2, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(2, 16)*pol_z(2, 2, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(1, 17)*pol_z(1, 2, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(2, 17)*pol_z(2, 2, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(1, 20)*pol_z(1, 2, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(2, 20)*pol_z(2, 2, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(1, 21)*pol_z(1, 2, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(2, 21)*pol_z(2, 2, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(1, 22)*pol_z(1, 2, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(2, 22)*pol_z(2, 2, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(1, 23)*pol_z(1, 2, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(2, 23)*pol_z(2, 2, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(1, 24)*pol_z(1, 2, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(2, 24)*pol_z(2, 2, kg) + coef_xyz(121) = coef_xyz(121) + coef_xy(1, 25)*pol_z(1, 2, kg) + coef_xyz(121) = coef_xyz(121) + coef_xy(2, 25)*pol_z(2, 2, kg) + coef_xyz(122) = coef_xyz(122) + coef_xy(1, 28)*pol_z(1, 2, kg) + coef_xyz(122) = coef_xyz(122) + coef_xy(2, 28)*pol_z(2, 2, kg) + coef_xyz(123) = coef_xyz(123) + coef_xy(1, 29)*pol_z(1, 2, kg) + coef_xyz(123) = coef_xyz(123) + coef_xy(2, 29)*pol_z(2, 2, kg) + coef_xyz(124) = coef_xyz(124) + coef_xy(1, 30)*pol_z(1, 2, kg) + coef_xyz(124) = coef_xyz(124) + coef_xy(2, 30)*pol_z(2, 2, kg) + coef_xyz(125) = coef_xyz(125) + coef_xy(1, 31)*pol_z(1, 2, kg) + coef_xyz(125) = coef_xyz(125) + coef_xy(2, 31)*pol_z(2, 2, kg) + coef_xyz(126) = coef_xyz(126) + coef_xy(1, 32)*pol_z(1, 2, kg) + coef_xyz(126) = coef_xyz(126) + coef_xy(2, 32)*pol_z(2, 2, kg) + coef_xyz(127) = coef_xyz(127) + coef_xy(1, 35)*pol_z(1, 2, kg) + coef_xyz(127) = coef_xyz(127) + coef_xy(2, 35)*pol_z(2, 2, kg) + coef_xyz(128) = coef_xyz(128) + coef_xy(1, 36)*pol_z(1, 2, kg) + coef_xyz(128) = coef_xyz(128) + coef_xy(2, 36)*pol_z(2, 2, kg) + coef_xyz(129) = coef_xyz(129) + coef_xy(1, 37)*pol_z(1, 2, kg) + coef_xyz(129) = coef_xyz(129) + coef_xy(2, 37)*pol_z(2, 2, kg) + coef_xyz(130) = coef_xyz(130) + coef_xy(1, 38)*pol_z(1, 2, kg) + coef_xyz(130) = coef_xyz(130) + coef_xy(2, 38)*pol_z(2, 2, kg) + coef_xyz(131) = coef_xyz(131) + coef_xy(1, 41)*pol_z(1, 2, kg) + coef_xyz(131) = coef_xyz(131) + coef_xy(2, 41)*pol_z(2, 2, kg) + coef_xyz(132) = coef_xyz(132) + coef_xy(1, 42)*pol_z(1, 2, kg) + coef_xyz(132) = coef_xyz(132) + coef_xy(2, 42)*pol_z(2, 2, kg) + coef_xyz(133) = coef_xyz(133) + coef_xy(1, 43)*pol_z(1, 2, kg) + coef_xyz(133) = coef_xyz(133) + coef_xy(2, 43)*pol_z(2, 2, kg) + coef_xyz(134) = coef_xyz(134) + coef_xy(1, 46)*pol_z(1, 2, kg) + coef_xyz(134) = coef_xyz(134) + coef_xy(2, 46)*pol_z(2, 2, kg) + coef_xyz(135) = coef_xyz(135) + coef_xy(1, 47)*pol_z(1, 2, kg) + coef_xyz(135) = coef_xyz(135) + coef_xy(2, 47)*pol_z(2, 2, kg) + coef_xyz(136) = coef_xyz(136) + coef_xy(1, 50)*pol_z(1, 2, kg) + coef_xyz(136) = coef_xyz(136) + coef_xy(2, 50)*pol_z(2, 2, kg) + coef_xyz(137) = coef_xyz(137) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(137) = coef_xyz(137) + coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(138) = coef_xyz(138) + coef_xy(1, 2)*pol_z(1, 3, kg) + coef_xyz(138) = coef_xyz(138) + coef_xy(2, 2)*pol_z(2, 3, kg) + coef_xyz(139) = coef_xyz(139) + coef_xy(1, 3)*pol_z(1, 3, kg) + coef_xyz(139) = coef_xyz(139) + coef_xy(2, 3)*pol_z(2, 3, kg) + coef_xyz(140) = coef_xyz(140) + coef_xy(1, 4)*pol_z(1, 3, kg) + coef_xyz(140) = coef_xyz(140) + coef_xy(2, 4)*pol_z(2, 3, kg) + coef_xyz(141) = coef_xyz(141) + coef_xy(1, 5)*pol_z(1, 3, kg) + coef_xyz(141) = coef_xyz(141) + coef_xy(2, 5)*pol_z(2, 3, kg) + coef_xyz(142) = coef_xyz(142) + coef_xy(1, 6)*pol_z(1, 3, kg) + coef_xyz(142) = coef_xyz(142) + coef_xy(2, 6)*pol_z(2, 3, kg) + coef_xyz(143) = coef_xyz(143) + coef_xy(1, 7)*pol_z(1, 3, kg) + coef_xyz(143) = coef_xyz(143) + coef_xy(2, 7)*pol_z(2, 3, kg) + coef_xyz(144) = coef_xyz(144) + coef_xy(1, 11)*pol_z(1, 3, kg) + coef_xyz(144) = coef_xyz(144) + coef_xy(2, 11)*pol_z(2, 3, kg) + coef_xyz(145) = coef_xyz(145) + coef_xy(1, 12)*pol_z(1, 3, kg) + coef_xyz(145) = coef_xyz(145) + coef_xy(2, 12)*pol_z(2, 3, kg) + coef_xyz(146) = coef_xyz(146) + coef_xy(1, 13)*pol_z(1, 3, kg) + coef_xyz(146) = coef_xyz(146) + coef_xy(2, 13)*pol_z(2, 3, kg) + coef_xyz(147) = coef_xyz(147) + coef_xy(1, 14)*pol_z(1, 3, kg) + coef_xyz(147) = coef_xyz(147) + coef_xy(2, 14)*pol_z(2, 3, kg) + coef_xyz(148) = coef_xyz(148) + coef_xy(1, 15)*pol_z(1, 3, kg) + coef_xyz(148) = coef_xyz(148) + coef_xy(2, 15)*pol_z(2, 3, kg) + coef_xyz(149) = coef_xyz(149) + coef_xy(1, 16)*pol_z(1, 3, kg) + coef_xyz(149) = coef_xyz(149) + coef_xy(2, 16)*pol_z(2, 3, kg) + coef_xyz(150) = coef_xyz(150) + coef_xy(1, 20)*pol_z(1, 3, kg) + coef_xyz(150) = coef_xyz(150) + coef_xy(2, 20)*pol_z(2, 3, kg) + coef_xyz(151) = coef_xyz(151) + coef_xy(1, 21)*pol_z(1, 3, kg) + coef_xyz(151) = coef_xyz(151) + coef_xy(2, 21)*pol_z(2, 3, kg) + coef_xyz(152) = coef_xyz(152) + coef_xy(1, 22)*pol_z(1, 3, kg) + coef_xyz(152) = coef_xyz(152) + coef_xy(2, 22)*pol_z(2, 3, kg) + coef_xyz(153) = coef_xyz(153) + coef_xy(1, 23)*pol_z(1, 3, kg) + coef_xyz(153) = coef_xyz(153) + coef_xy(2, 23)*pol_z(2, 3, kg) + coef_xyz(154) = coef_xyz(154) + coef_xy(1, 24)*pol_z(1, 3, kg) + coef_xyz(154) = coef_xyz(154) + coef_xy(2, 24)*pol_z(2, 3, kg) + coef_xyz(155) = coef_xyz(155) + coef_xy(1, 28)*pol_z(1, 3, kg) + coef_xyz(155) = coef_xyz(155) + coef_xy(2, 28)*pol_z(2, 3, kg) + coef_xyz(156) = coef_xyz(156) + coef_xy(1, 29)*pol_z(1, 3, kg) + coef_xyz(156) = coef_xyz(156) + coef_xy(2, 29)*pol_z(2, 3, kg) + coef_xyz(157) = coef_xyz(157) + coef_xy(1, 30)*pol_z(1, 3, kg) + coef_xyz(157) = coef_xyz(157) + coef_xy(2, 30)*pol_z(2, 3, kg) + coef_xyz(158) = coef_xyz(158) + coef_xy(1, 31)*pol_z(1, 3, kg) + coef_xyz(158) = coef_xyz(158) + coef_xy(2, 31)*pol_z(2, 3, kg) + coef_xyz(159) = coef_xyz(159) + coef_xy(1, 35)*pol_z(1, 3, kg) + coef_xyz(159) = coef_xyz(159) + coef_xy(2, 35)*pol_z(2, 3, kg) + coef_xyz(160) = coef_xyz(160) + coef_xy(1, 36)*pol_z(1, 3, kg) + coef_xyz(160) = coef_xyz(160) + coef_xy(2, 36)*pol_z(2, 3, kg) + coef_xyz(161) = coef_xyz(161) + coef_xy(1, 37)*pol_z(1, 3, kg) + coef_xyz(161) = coef_xyz(161) + coef_xy(2, 37)*pol_z(2, 3, kg) + coef_xyz(162) = coef_xyz(162) + coef_xy(1, 41)*pol_z(1, 3, kg) + coef_xyz(162) = coef_xyz(162) + coef_xy(2, 41)*pol_z(2, 3, kg) + coef_xyz(163) = coef_xyz(163) + coef_xy(1, 42)*pol_z(1, 3, kg) + coef_xyz(163) = coef_xyz(163) + coef_xy(2, 42)*pol_z(2, 3, kg) + coef_xyz(164) = coef_xyz(164) + coef_xy(1, 46)*pol_z(1, 3, kg) + coef_xyz(164) = coef_xyz(164) + coef_xy(2, 46)*pol_z(2, 3, kg) + coef_xyz(165) = coef_xyz(165) + coef_xy(1, 1)*pol_z(1, 4, kg) + coef_xyz(165) = coef_xyz(165) + coef_xy(2, 1)*pol_z(2, 4, kg) + coef_xyz(166) = coef_xyz(166) + coef_xy(1, 2)*pol_z(1, 4, kg) + coef_xyz(166) = coef_xyz(166) + coef_xy(2, 2)*pol_z(2, 4, kg) + coef_xyz(167) = coef_xyz(167) + coef_xy(1, 3)*pol_z(1, 4, kg) + coef_xyz(167) = coef_xyz(167) + coef_xy(2, 3)*pol_z(2, 4, kg) + coef_xyz(168) = coef_xyz(168) + coef_xy(1, 4)*pol_z(1, 4, kg) + coef_xyz(168) = coef_xyz(168) + coef_xy(2, 4)*pol_z(2, 4, kg) + coef_xyz(169) = coef_xyz(169) + coef_xy(1, 5)*pol_z(1, 4, kg) + coef_xyz(169) = coef_xyz(169) + coef_xy(2, 5)*pol_z(2, 4, kg) + coef_xyz(170) = coef_xyz(170) + coef_xy(1, 6)*pol_z(1, 4, kg) + coef_xyz(170) = coef_xyz(170) + coef_xy(2, 6)*pol_z(2, 4, kg) + coef_xyz(171) = coef_xyz(171) + coef_xy(1, 11)*pol_z(1, 4, kg) + coef_xyz(171) = coef_xyz(171) + coef_xy(2, 11)*pol_z(2, 4, kg) + coef_xyz(172) = coef_xyz(172) + coef_xy(1, 12)*pol_z(1, 4, kg) + coef_xyz(172) = coef_xyz(172) + coef_xy(2, 12)*pol_z(2, 4, kg) + coef_xyz(173) = coef_xyz(173) + coef_xy(1, 13)*pol_z(1, 4, kg) + coef_xyz(173) = coef_xyz(173) + coef_xy(2, 13)*pol_z(2, 4, kg) + coef_xyz(174) = coef_xyz(174) + coef_xy(1, 14)*pol_z(1, 4, kg) + coef_xyz(174) = coef_xyz(174) + coef_xy(2, 14)*pol_z(2, 4, kg) + coef_xyz(175) = coef_xyz(175) + coef_xy(1, 15)*pol_z(1, 4, kg) + coef_xyz(175) = coef_xyz(175) + coef_xy(2, 15)*pol_z(2, 4, kg) + coef_xyz(176) = coef_xyz(176) + coef_xy(1, 20)*pol_z(1, 4, kg) + coef_xyz(176) = coef_xyz(176) + coef_xy(2, 20)*pol_z(2, 4, kg) + coef_xyz(177) = coef_xyz(177) + coef_xy(1, 21)*pol_z(1, 4, kg) + coef_xyz(177) = coef_xyz(177) + coef_xy(2, 21)*pol_z(2, 4, kg) + coef_xyz(178) = coef_xyz(178) + coef_xy(1, 22)*pol_z(1, 4, kg) + coef_xyz(178) = coef_xyz(178) + coef_xy(2, 22)*pol_z(2, 4, kg) + coef_xyz(179) = coef_xyz(179) + coef_xy(1, 23)*pol_z(1, 4, kg) + coef_xyz(179) = coef_xyz(179) + coef_xy(2, 23)*pol_z(2, 4, kg) + coef_xyz(180) = coef_xyz(180) + coef_xy(1, 28)*pol_z(1, 4, kg) + coef_xyz(180) = coef_xyz(180) + coef_xy(2, 28)*pol_z(2, 4, kg) + coef_xyz(181) = coef_xyz(181) + coef_xy(1, 29)*pol_z(1, 4, kg) + coef_xyz(181) = coef_xyz(181) + coef_xy(2, 29)*pol_z(2, 4, kg) + coef_xyz(182) = coef_xyz(182) + coef_xy(1, 30)*pol_z(1, 4, kg) + coef_xyz(182) = coef_xyz(182) + coef_xy(2, 30)*pol_z(2, 4, kg) + coef_xyz(183) = coef_xyz(183) + coef_xy(1, 35)*pol_z(1, 4, kg) + coef_xyz(183) = coef_xyz(183) + coef_xy(2, 35)*pol_z(2, 4, kg) + coef_xyz(184) = coef_xyz(184) + coef_xy(1, 36)*pol_z(1, 4, kg) + coef_xyz(184) = coef_xyz(184) + coef_xy(2, 36)*pol_z(2, 4, kg) + coef_xyz(185) = coef_xyz(185) + coef_xy(1, 41)*pol_z(1, 4, kg) + coef_xyz(185) = coef_xyz(185) + coef_xy(2, 41)*pol_z(2, 4, kg) + coef_xyz(186) = coef_xyz(186) + coef_xy(1, 1)*pol_z(1, 5, kg) + coef_xyz(186) = coef_xyz(186) + coef_xy(2, 1)*pol_z(2, 5, kg) + coef_xyz(187) = coef_xyz(187) + coef_xy(1, 2)*pol_z(1, 5, kg) + coef_xyz(187) = coef_xyz(187) + coef_xy(2, 2)*pol_z(2, 5, kg) + coef_xyz(188) = coef_xyz(188) + coef_xy(1, 3)*pol_z(1, 5, kg) + coef_xyz(188) = coef_xyz(188) + coef_xy(2, 3)*pol_z(2, 5, kg) + coef_xyz(189) = coef_xyz(189) + coef_xy(1, 4)*pol_z(1, 5, kg) + coef_xyz(189) = coef_xyz(189) + coef_xy(2, 4)*pol_z(2, 5, kg) + coef_xyz(190) = coef_xyz(190) + coef_xy(1, 5)*pol_z(1, 5, kg) + coef_xyz(190) = coef_xyz(190) + coef_xy(2, 5)*pol_z(2, 5, kg) + coef_xyz(191) = coef_xyz(191) + coef_xy(1, 11)*pol_z(1, 5, kg) + coef_xyz(191) = coef_xyz(191) + coef_xy(2, 11)*pol_z(2, 5, kg) + coef_xyz(192) = coef_xyz(192) + coef_xy(1, 12)*pol_z(1, 5, kg) + coef_xyz(192) = coef_xyz(192) + coef_xy(2, 12)*pol_z(2, 5, kg) + coef_xyz(193) = coef_xyz(193) + coef_xy(1, 13)*pol_z(1, 5, kg) + coef_xyz(193) = coef_xyz(193) + coef_xy(2, 13)*pol_z(2, 5, kg) + coef_xyz(194) = coef_xyz(194) + coef_xy(1, 14)*pol_z(1, 5, kg) + coef_xyz(194) = coef_xyz(194) + coef_xy(2, 14)*pol_z(2, 5, kg) + coef_xyz(195) = coef_xyz(195) + coef_xy(1, 20)*pol_z(1, 5, kg) + coef_xyz(195) = coef_xyz(195) + coef_xy(2, 20)*pol_z(2, 5, kg) + coef_xyz(196) = coef_xyz(196) + coef_xy(1, 21)*pol_z(1, 5, kg) + coef_xyz(196) = coef_xyz(196) + coef_xy(2, 21)*pol_z(2, 5, kg) + coef_xyz(197) = coef_xyz(197) + coef_xy(1, 22)*pol_z(1, 5, kg) + coef_xyz(197) = coef_xyz(197) + coef_xy(2, 22)*pol_z(2, 5, kg) + coef_xyz(198) = coef_xyz(198) + coef_xy(1, 28)*pol_z(1, 5, kg) + coef_xyz(198) = coef_xyz(198) + coef_xy(2, 28)*pol_z(2, 5, kg) + coef_xyz(199) = coef_xyz(199) + coef_xy(1, 29)*pol_z(1, 5, kg) + coef_xyz(199) = coef_xyz(199) + coef_xy(2, 29)*pol_z(2, 5, kg) + coef_xyz(200) = coef_xyz(200) + coef_xy(1, 35)*pol_z(1, 5, kg) + coef_xyz(200) = coef_xyz(200) + coef_xy(2, 35)*pol_z(2, 5, kg) + coef_xyz(201) = coef_xyz(201) + coef_xy(1, 1)*pol_z(1, 6, kg) + coef_xyz(201) = coef_xyz(201) + coef_xy(2, 1)*pol_z(2, 6, kg) + coef_xyz(202) = coef_xyz(202) + coef_xy(1, 2)*pol_z(1, 6, kg) + coef_xyz(202) = coef_xyz(202) + coef_xy(2, 2)*pol_z(2, 6, kg) + coef_xyz(203) = coef_xyz(203) + coef_xy(1, 3)*pol_z(1, 6, kg) + coef_xyz(203) = coef_xyz(203) + coef_xy(2, 3)*pol_z(2, 6, kg) + coef_xyz(204) = coef_xyz(204) + coef_xy(1, 4)*pol_z(1, 6, kg) + coef_xyz(204) = coef_xyz(204) + coef_xy(2, 4)*pol_z(2, 6, kg) + coef_xyz(205) = coef_xyz(205) + coef_xy(1, 11)*pol_z(1, 6, kg) + coef_xyz(205) = coef_xyz(205) + coef_xy(2, 11)*pol_z(2, 6, kg) + coef_xyz(206) = coef_xyz(206) + coef_xy(1, 12)*pol_z(1, 6, kg) + coef_xyz(206) = coef_xyz(206) + coef_xy(2, 12)*pol_z(2, 6, kg) + coef_xyz(207) = coef_xyz(207) + coef_xy(1, 13)*pol_z(1, 6, kg) + coef_xyz(207) = coef_xyz(207) + coef_xy(2, 13)*pol_z(2, 6, kg) + coef_xyz(208) = coef_xyz(208) + coef_xy(1, 20)*pol_z(1, 6, kg) + coef_xyz(208) = coef_xyz(208) + coef_xy(2, 20)*pol_z(2, 6, kg) + coef_xyz(209) = coef_xyz(209) + coef_xy(1, 21)*pol_z(1, 6, kg) + coef_xyz(209) = coef_xyz(209) + coef_xy(2, 21)*pol_z(2, 6, kg) + coef_xyz(210) = coef_xyz(210) + coef_xy(1, 28)*pol_z(1, 6, kg) + coef_xyz(210) = coef_xyz(210) + coef_xy(2, 28)*pol_z(2, 6, kg) + coef_xyz(211) = coef_xyz(211) + coef_xy(1, 1)*pol_z(1, 7, kg) + coef_xyz(211) = coef_xyz(211) + coef_xy(2, 1)*pol_z(2, 7, kg) + coef_xyz(212) = coef_xyz(212) + coef_xy(1, 2)*pol_z(1, 7, kg) + coef_xyz(212) = coef_xyz(212) + coef_xy(2, 2)*pol_z(2, 7, kg) + coef_xyz(213) = coef_xyz(213) + coef_xy(1, 3)*pol_z(1, 7, kg) + coef_xyz(213) = coef_xyz(213) + coef_xy(2, 3)*pol_z(2, 7, kg) + coef_xyz(214) = coef_xyz(214) + coef_xy(1, 11)*pol_z(1, 7, kg) + coef_xyz(214) = coef_xyz(214) + coef_xy(2, 11)*pol_z(2, 7, kg) + coef_xyz(215) = coef_xyz(215) + coef_xy(1, 12)*pol_z(1, 7, kg) + coef_xyz(215) = coef_xyz(215) + coef_xy(2, 12)*pol_z(2, 7, kg) + coef_xyz(216) = coef_xyz(216) + coef_xy(1, 20)*pol_z(1, 7, kg) + coef_xyz(216) = coef_xyz(216) + coef_xy(2, 20)*pol_z(2, 7, kg) + coef_xyz(217) = coef_xyz(217) + coef_xy(1, 1)*pol_z(1, 8, kg) + coef_xyz(217) = coef_xyz(217) + coef_xy(2, 1)*pol_z(2, 8, kg) + coef_xyz(218) = coef_xyz(218) + coef_xy(1, 2)*pol_z(1, 8, kg) + coef_xyz(218) = coef_xyz(218) + coef_xy(2, 2)*pol_z(2, 8, kg) + coef_xyz(219) = coef_xyz(219) + coef_xy(1, 11)*pol_z(1, 8, kg) + coef_xyz(219) = coef_xyz(219) + coef_xy(2, 11)*pol_z(2, 8, kg) + coef_xyz(220) = coef_xyz(220) + coef_xy(1, 1)*pol_z(1, 9, kg) + coef_xyz(220) = coef_xyz(220) + coef_xy(2, 1)*pol_z(2, 9, kg) END DO END SUBROUTINE integrate_core_9 diff --git a/src/grid/integrate_fast_4.f90 b/src/grid/integrate_fast_4.f90 index 86527117ad..9638595315 100644 --- a/src/grid/integrate_fast_4.f90 +++ b/src/grid/integrate_fast_4.f90 @@ -14,7 +14,7 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bounds, lp, cmax, gridbounds) USE kinds, ONLY: dp INTEGER, INTENT(IN) :: sphere_bounds(*), lp - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER, INTENT(IN) :: cmax REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & @@ -29,7 +29,7 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -37,23 +37,23 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp @@ -64,21 +64,21 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_x(1, lxp)*pol_y(1, lyp, jg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_x(2, lxp)*pol_y(1, lyp, jg) - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_x(3, lxp)*pol_y(2, lyp, jg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_x(4, lxp)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_x(1, lxp)*pol_y(1, lyp, jg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_x(2, lxp)*pol_y(1, lyp, jg) + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_x(3, lxp)*pol_y(2, lyp, jg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_x(4, lxp)*pol_y(2, lyp, jg) ENDDO ENDDO @@ -87,13 +87,13 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(1, lxy)*pol_z(1, lzp, kg) - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(2, lxy)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(1, lxy)*pol_z(1, lzp, kg) + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(2, lxy)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO @@ -123,14 +123,14 @@ SUBROUTINE integrate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s(4) sci = 1 @@ -138,23 +138,23 @@ SUBROUTINE integrate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -164,22 +164,22 @@ SUBROUTINE integrate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s(3) = grid(i, j2, k) s(4) = grid(i, j2, k2) DO lxp = 0, lp - coef_x(:, lxp) = coef_x(:, lxp)+s(:)*pol_x(lxp, ig) + coef_x(:, lxp) = coef_x(:, lxp) + s(:)*pol_x(lxp, ig) ENDDO END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) END DO lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(1, lxy)*pol_z(1, lzp, kg) - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(2, lxy)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(1, lxy)*pol_z(1, lzp, kg) + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(2, lxy)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO END DO @@ -208,13 +208,13 @@ SUBROUTINE integrate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s(4) sci = 1 @@ -222,23 +222,23 @@ SUBROUTINE integrate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -248,24 +248,24 @@ SUBROUTINE integrate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s(3) = grid(i, j2, k) s(4) = grid(i, j2, k2) DO lxp = 0, lp - coef_x(:, lxp) = coef_x(:, lxp)+s(:)*pol_x(lxp, ig) + coef_x(:, lxp) = coef_x(:, lxp) + s(:)*pol_x(lxp, ig) ENDDO END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(1:2, 1)*pol_y(1, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(3:4, 1)*pol_y(2, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(1:2, 0)*pol_y(1, 1, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(3:4, 0)*pol_y(2, 1, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(1:2, 1)*pol_y(1, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(3:4, 1)*pol_y(2, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(1:2, 0)*pol_y(1, 1, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(3:4, 0)*pol_y(2, 1, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 1)*pol_z(2, 1, kg) END DO END SUBROUTINE integrate_core_1 @@ -292,13 +292,13 @@ SUBROUTINE integrate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -306,23 +306,23 @@ SUBROUTINE integrate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -332,45 +332,45 @@ SUBROUTINE integrate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(1:2, 1)*pol_y(1, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(3:4, 1)*pol_y(2, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(1:2, 2)*pol_y(1, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(3:4, 2)*pol_y(2, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(1:2, 0)*pol_y(1, 1, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(3:4, 0)*pol_y(2, 1, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(1:2, 1)*pol_y(1, 1, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(3:4, 1)*pol_y(2, 1, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(1:2, 0)*pol_y(1, 2, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(3:4, 0)*pol_y(2, 2, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(1:2, 1)*pol_y(1, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(3:4, 1)*pol_y(2, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(1:2, 2)*pol_y(1, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(3:4, 2)*pol_y(2, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(1:2, 0)*pol_y(1, 1, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(3:4, 0)*pol_y(2, 1, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(1:2, 1)*pol_y(1, 1, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(3:4, 1)*pol_y(2, 1, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(1:2, 0)*pol_y(1, 2, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(3:4, 0)*pol_y(2, 2, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 1)*pol_z(2, 2, kg) END DO END SUBROUTINE integrate_core_2 @@ -397,13 +397,13 @@ SUBROUTINE integrate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -411,23 +411,23 @@ SUBROUTINE integrate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -437,73 +437,73 @@ SUBROUTINE integrate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(1:2, 1)*pol_y(1, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(3:4, 1)*pol_y(2, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(1:2, 2)*pol_y(1, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(3:4, 2)*pol_y(2, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(1:2, 3)*pol_y(1, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(3:4, 3)*pol_y(2, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(1:2, 0)*pol_y(1, 1, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(3:4, 0)*pol_y(2, 1, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(1:2, 1)*pol_y(1, 1, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(3:4, 1)*pol_y(2, 1, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(1:2, 2)*pol_y(1, 1, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(3:4, 2)*pol_y(2, 1, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(1:2, 0)*pol_y(1, 2, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(3:4, 0)*pol_y(2, 2, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(1:2, 1)*pol_y(1, 2, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(3:4, 1)*pol_y(2, 2, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(1:2, 0)*pol_y(1, 3, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(3:4, 0)*pol_y(2, 3, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(1:2, 1)*pol_y(1, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(3:4, 1)*pol_y(2, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(1:2, 2)*pol_y(1, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(3:4, 2)*pol_y(2, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(1:2, 3)*pol_y(1, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(3:4, 3)*pol_y(2, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(1:2, 0)*pol_y(1, 1, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(3:4, 0)*pol_y(2, 1, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(1:2, 1)*pol_y(1, 1, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(3:4, 1)*pol_y(2, 1, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(1:2, 2)*pol_y(1, 1, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(3:4, 2)*pol_y(2, 1, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(1:2, 0)*pol_y(1, 2, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(3:4, 0)*pol_y(2, 2, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(1:2, 1)*pol_y(1, 2, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(3:4, 1)*pol_y(2, 2, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(1:2, 0)*pol_y(1, 3, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(3:4, 0)*pol_y(2, 3, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 5)*pol_z(1, 1, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 5)*pol_z(2, 1, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 8)*pol_z(1, 1, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 8)*pol_z(2, 1, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 5)*pol_z(1, 2, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 5)*pol_z(2, 2, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 5)*pol_z(1, 1, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 5)*pol_z(2, 1, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 8)*pol_z(1, 1, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 8)*pol_z(2, 1, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 5)*pol_z(1, 2, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 5)*pol_z(2, 2, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 1)*pol_z(2, 3, kg) END DO END SUBROUTINE integrate_core_3 @@ -530,13 +530,13 @@ SUBROUTINE integrate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -544,23 +544,23 @@ SUBROUTINE integrate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -570,143 +570,143 @@ SUBROUTINE integrate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 2)*pol_y(1, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 2)*pol_y(1, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 2)*pol_y(2, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 2)*pol_y(2, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(1, 3)*pol_y(1, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(2, 3)*pol_y(1, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(3, 3)*pol_y(2, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(4, 3)*pol_y(2, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(1, 4)*pol_y(1, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(2, 4)*pol_y(1, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(3, 4)*pol_y(2, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(4, 4)*pol_y(2, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(4, 0)*pol_y(2, 1, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(1, 1)*pol_y(1, 1, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(2, 1)*pol_y(1, 1, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(3, 1)*pol_y(2, 1, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(4, 1)*pol_y(2, 1, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(1, 2)*pol_y(1, 1, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(2, 2)*pol_y(1, 1, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(3, 2)*pol_y(2, 1, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(4, 2)*pol_y(2, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(1, 3)*pol_y(1, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(2, 3)*pol_y(1, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(3, 3)*pol_y(2, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(4, 3)*pol_y(2, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(1, 0)*pol_y(1, 2, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(2, 0)*pol_y(1, 2, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(3, 0)*pol_y(2, 2, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(4, 0)*pol_y(2, 2, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(1, 1)*pol_y(1, 2, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(2, 1)*pol_y(1, 2, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(3, 1)*pol_y(2, 2, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(4, 1)*pol_y(2, 2, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(1, 2)*pol_y(1, 2, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(2, 2)*pol_y(1, 2, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(3, 2)*pol_y(2, 2, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(4, 2)*pol_y(2, 2, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(1, 0)*pol_y(1, 3, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(2, 0)*pol_y(1, 3, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(3, 0)*pol_y(2, 3, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(4, 0)*pol_y(2, 3, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(1, 1)*pol_y(1, 3, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(2, 1)*pol_y(1, 3, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(3, 1)*pol_y(2, 3, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(4, 1)*pol_y(2, 3, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(1, 0)*pol_y(1, 4, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(2, 0)*pol_y(1, 4, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(3, 0)*pol_y(2, 4, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(4, 0)*pol_y(2, 4, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 2)*pol_y(1, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 2)*pol_y(1, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 2)*pol_y(2, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 2)*pol_y(2, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(1, 3)*pol_y(1, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(2, 3)*pol_y(1, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(3, 3)*pol_y(2, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(4, 3)*pol_y(2, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(1, 4)*pol_y(1, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(2, 4)*pol_y(1, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(3, 4)*pol_y(2, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(4, 4)*pol_y(2, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(1, 1)*pol_y(1, 1, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(2, 1)*pol_y(1, 1, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(3, 1)*pol_y(2, 1, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(4, 1)*pol_y(2, 1, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(1, 2)*pol_y(1, 1, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(2, 2)*pol_y(1, 1, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(3, 2)*pol_y(2, 1, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(4, 2)*pol_y(2, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(1, 3)*pol_y(1, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(2, 3)*pol_y(1, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(3, 3)*pol_y(2, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(4, 3)*pol_y(2, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(1, 0)*pol_y(1, 2, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(2, 0)*pol_y(1, 2, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(3, 0)*pol_y(2, 2, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(4, 0)*pol_y(2, 2, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(1, 1)*pol_y(1, 2, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(2, 1)*pol_y(1, 2, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(3, 1)*pol_y(2, 2, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(4, 1)*pol_y(2, 2, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(1, 2)*pol_y(1, 2, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(2, 2)*pol_y(1, 2, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(3, 2)*pol_y(2, 2, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(4, 2)*pol_y(2, 2, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(1, 0)*pol_y(1, 3, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(2, 0)*pol_y(1, 3, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(3, 0)*pol_y(2, 3, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(4, 0)*pol_y(2, 3, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(1, 1)*pol_y(1, 3, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(2, 1)*pol_y(1, 3, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(3, 1)*pol_y(2, 3, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(4, 1)*pol_y(2, 3, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(1, 0)*pol_y(1, 4, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(2, 0)*pol_y(1, 4, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(3, 0)*pol_y(2, 4, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(4, 0)*pol_y(2, 4, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 11)*pol_z(1, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 11)*pol_z(2, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 12)*pol_z(1, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 12)*pol_z(2, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 13)*pol_z(1, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 13)*pol_z(2, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 14)*pol_z(1, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 14)*pol_z(2, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 15)*pol_z(1, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 15)*pol_z(2, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(1, 7)*pol_z(1, 1, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(2, 7)*pol_z(2, 1, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(1, 8)*pol_z(1, 1, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(2, 8)*pol_z(2, 1, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(1, 10)*pol_z(1, 1, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(2, 10)*pol_z(2, 1, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(1, 11)*pol_z(1, 1, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(2, 11)*pol_z(2, 1, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(1, 13)*pol_z(1, 1, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(2, 13)*pol_z(2, 1, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(1, 3)*pol_z(1, 2, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(2, 3)*pol_z(2, 2, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(1, 6)*pol_z(1, 2, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(2, 6)*pol_z(2, 2, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(1, 7)*pol_z(1, 2, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(2, 7)*pol_z(2, 2, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(1, 10)*pol_z(1, 2, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(2, 10)*pol_z(2, 2, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(2, 1)*pol_z(2, 3, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(1, 2)*pol_z(1, 3, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(2, 2)*pol_z(2, 3, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(1, 6)*pol_z(1, 3, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(2, 6)*pol_z(2, 3, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(1, 1)*pol_z(1, 4, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(2, 1)*pol_z(2, 4, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 11)*pol_z(1, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 11)*pol_z(2, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 12)*pol_z(1, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 12)*pol_z(2, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 13)*pol_z(1, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 13)*pol_z(2, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 14)*pol_z(1, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 14)*pol_z(2, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 15)*pol_z(1, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 15)*pol_z(2, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(1, 7)*pol_z(1, 1, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(2, 7)*pol_z(2, 1, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(1, 8)*pol_z(1, 1, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(2, 8)*pol_z(2, 1, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(1, 10)*pol_z(1, 1, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(2, 10)*pol_z(2, 1, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(1, 11)*pol_z(1, 1, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(2, 11)*pol_z(2, 1, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(1, 13)*pol_z(1, 1, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(2, 13)*pol_z(2, 1, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(1, 3)*pol_z(1, 2, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(2, 3)*pol_z(2, 2, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(1, 6)*pol_z(1, 2, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(2, 6)*pol_z(2, 2, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(1, 7)*pol_z(1, 2, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(2, 7)*pol_z(2, 2, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(1, 10)*pol_z(1, 2, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(2, 10)*pol_z(2, 2, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(1, 2)*pol_z(1, 3, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(2, 2)*pol_z(2, 3, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(1, 6)*pol_z(1, 3, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(2, 6)*pol_z(2, 3, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(1, 1)*pol_z(1, 4, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(2, 1)*pol_z(2, 4, kg) END DO END SUBROUTINE integrate_core_4 @@ -733,13 +733,13 @@ SUBROUTINE integrate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -747,23 +747,23 @@ SUBROUTINE integrate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -772,172 +772,172 @@ SUBROUTINE integrate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = grid(i, j, k2) s03 = grid(i, j2, k) s04 = grid(i, j2, k2) - coef_x(1, 0) = coef_x(1, 0)+s01*pol_x(0, ig) - coef_x(2, 0) = coef_x(2, 0)+s02*pol_x(0, ig) - coef_x(3, 0) = coef_x(3, 0)+s03*pol_x(0, ig) - coef_x(4, 0) = coef_x(4, 0)+s04*pol_x(0, ig) - coef_x(1, 1) = coef_x(1, 1)+s01*pol_x(1, ig) - coef_x(2, 1) = coef_x(2, 1)+s02*pol_x(1, ig) - coef_x(3, 1) = coef_x(3, 1)+s03*pol_x(1, ig) - coef_x(4, 1) = coef_x(4, 1)+s04*pol_x(1, ig) - coef_x(1, 2) = coef_x(1, 2)+s01*pol_x(2, ig) - coef_x(2, 2) = coef_x(2, 2)+s02*pol_x(2, ig) - coef_x(3, 2) = coef_x(3, 2)+s03*pol_x(2, ig) - coef_x(4, 2) = coef_x(4, 2)+s04*pol_x(2, ig) - coef_x(1, 3) = coef_x(1, 3)+s01*pol_x(3, ig) - coef_x(2, 3) = coef_x(2, 3)+s02*pol_x(3, ig) - coef_x(3, 3) = coef_x(3, 3)+s03*pol_x(3, ig) - coef_x(4, 3) = coef_x(4, 3)+s04*pol_x(3, ig) - coef_x(1, 4) = coef_x(1, 4)+s01*pol_x(4, ig) - coef_x(2, 4) = coef_x(2, 4)+s02*pol_x(4, ig) - coef_x(3, 4) = coef_x(3, 4)+s03*pol_x(4, ig) - coef_x(4, 4) = coef_x(4, 4)+s04*pol_x(4, ig) - coef_x(1, 5) = coef_x(1, 5)+s01*pol_x(5, ig) - coef_x(2, 5) = coef_x(2, 5)+s02*pol_x(5, ig) - coef_x(3, 5) = coef_x(3, 5)+s03*pol_x(5, ig) - coef_x(4, 5) = coef_x(4, 5)+s04*pol_x(5, ig) + coef_x(1, 0) = coef_x(1, 0) + s01*pol_x(0, ig) + coef_x(2, 0) = coef_x(2, 0) + s02*pol_x(0, ig) + coef_x(3, 0) = coef_x(3, 0) + s03*pol_x(0, ig) + coef_x(4, 0) = coef_x(4, 0) + s04*pol_x(0, ig) + coef_x(1, 1) = coef_x(1, 1) + s01*pol_x(1, ig) + coef_x(2, 1) = coef_x(2, 1) + s02*pol_x(1, ig) + coef_x(3, 1) = coef_x(3, 1) + s03*pol_x(1, ig) + coef_x(4, 1) = coef_x(4, 1) + s04*pol_x(1, ig) + coef_x(1, 2) = coef_x(1, 2) + s01*pol_x(2, ig) + coef_x(2, 2) = coef_x(2, 2) + s02*pol_x(2, ig) + coef_x(3, 2) = coef_x(3, 2) + s03*pol_x(2, ig) + coef_x(4, 2) = coef_x(4, 2) + s04*pol_x(2, ig) + coef_x(1, 3) = coef_x(1, 3) + s01*pol_x(3, ig) + coef_x(2, 3) = coef_x(2, 3) + s02*pol_x(3, ig) + coef_x(3, 3) = coef_x(3, 3) + s03*pol_x(3, ig) + coef_x(4, 3) = coef_x(4, 3) + s04*pol_x(3, ig) + coef_x(1, 4) = coef_x(1, 4) + s01*pol_x(4, ig) + coef_x(2, 4) = coef_x(2, 4) + s02*pol_x(4, ig) + coef_x(3, 4) = coef_x(3, 4) + s03*pol_x(4, ig) + coef_x(4, 4) = coef_x(4, 4) + s04*pol_x(4, ig) + coef_x(1, 5) = coef_x(1, 5) + s01*pol_x(5, ig) + coef_x(2, 5) = coef_x(2, 5) + s02*pol_x(5, ig) + coef_x(3, 5) = coef_x(3, 5) + s03*pol_x(5, ig) + coef_x(4, 5) = coef_x(4, 5) + s04*pol_x(5, ig) END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 2)*pol_y(1, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 2)*pol_y(1, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 2)*pol_y(2, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 2)*pol_y(2, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(1, 3)*pol_y(1, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(2, 3)*pol_y(1, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(3, 3)*pol_y(2, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(4, 3)*pol_y(2, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(1, 4)*pol_y(1, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(2, 4)*pol_y(1, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(3, 4)*pol_y(2, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(4, 4)*pol_y(2, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(1, 5)*pol_y(1, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(2, 5)*pol_y(1, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(3, 5)*pol_y(2, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(4, 5)*pol_y(2, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(4, 0)*pol_y(2, 1, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(1, 1)*pol_y(1, 1, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(2, 1)*pol_y(1, 1, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(3, 1)*pol_y(2, 1, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(4, 1)*pol_y(2, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(1, 2)*pol_y(1, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(2, 2)*pol_y(1, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(3, 2)*pol_y(2, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(4, 2)*pol_y(2, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(1, 3)*pol_y(1, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(2, 3)*pol_y(1, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(3, 3)*pol_y(2, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(4, 3)*pol_y(2, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(1, 4)*pol_y(1, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(2, 4)*pol_y(1, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(3, 4)*pol_y(2, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(4, 4)*pol_y(2, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(1, 0)*pol_y(1, 2, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(2, 0)*pol_y(1, 2, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(3, 0)*pol_y(2, 2, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(4, 0)*pol_y(2, 2, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(1, 1)*pol_y(1, 2, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(2, 1)*pol_y(1, 2, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(3, 1)*pol_y(2, 2, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(4, 1)*pol_y(2, 2, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(1, 2)*pol_y(1, 2, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(2, 2)*pol_y(1, 2, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(3, 2)*pol_y(2, 2, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(4, 2)*pol_y(2, 2, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(1, 3)*pol_y(1, 2, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(2, 3)*pol_y(1, 2, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(3, 3)*pol_y(2, 2, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(4, 3)*pol_y(2, 2, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(1, 0)*pol_y(1, 3, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(2, 0)*pol_y(1, 3, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(3, 0)*pol_y(2, 3, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(4, 0)*pol_y(2, 3, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(1, 1)*pol_y(1, 3, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(2, 1)*pol_y(1, 3, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(3, 1)*pol_y(2, 3, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(4, 1)*pol_y(2, 3, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(1, 2)*pol_y(1, 3, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(2, 2)*pol_y(1, 3, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(3, 2)*pol_y(2, 3, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(4, 2)*pol_y(2, 3, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(1, 0)*pol_y(1, 4, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(2, 0)*pol_y(1, 4, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(3, 0)*pol_y(2, 4, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(4, 0)*pol_y(2, 4, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(1, 1)*pol_y(1, 4, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(2, 1)*pol_y(1, 4, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(3, 1)*pol_y(2, 4, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(4, 1)*pol_y(2, 4, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(1, 0)*pol_y(1, 5, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(2, 0)*pol_y(1, 5, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(3, 0)*pol_y(2, 5, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(4, 0)*pol_y(2, 5, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 2)*pol_y(1, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 2)*pol_y(1, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 2)*pol_y(2, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 2)*pol_y(2, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(1, 3)*pol_y(1, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(2, 3)*pol_y(1, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(3, 3)*pol_y(2, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(4, 3)*pol_y(2, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(1, 4)*pol_y(1, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(2, 4)*pol_y(1, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(3, 4)*pol_y(2, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(4, 4)*pol_y(2, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(1, 5)*pol_y(1, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(2, 5)*pol_y(1, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(3, 5)*pol_y(2, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(4, 5)*pol_y(2, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(1, 1)*pol_y(1, 1, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(2, 1)*pol_y(1, 1, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(3, 1)*pol_y(2, 1, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(4, 1)*pol_y(2, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(1, 2)*pol_y(1, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(2, 2)*pol_y(1, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(3, 2)*pol_y(2, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(4, 2)*pol_y(2, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(1, 3)*pol_y(1, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(2, 3)*pol_y(1, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(3, 3)*pol_y(2, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(4, 3)*pol_y(2, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(1, 4)*pol_y(1, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(2, 4)*pol_y(1, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(3, 4)*pol_y(2, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(4, 4)*pol_y(2, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(1, 0)*pol_y(1, 2, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(2, 0)*pol_y(1, 2, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(3, 0)*pol_y(2, 2, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(4, 0)*pol_y(2, 2, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(1, 1)*pol_y(1, 2, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(2, 1)*pol_y(1, 2, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(3, 1)*pol_y(2, 2, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(4, 1)*pol_y(2, 2, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(1, 2)*pol_y(1, 2, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(2, 2)*pol_y(1, 2, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(3, 2)*pol_y(2, 2, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(4, 2)*pol_y(2, 2, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(1, 3)*pol_y(1, 2, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(2, 3)*pol_y(1, 2, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(3, 3)*pol_y(2, 2, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(4, 3)*pol_y(2, 2, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(1, 0)*pol_y(1, 3, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(2, 0)*pol_y(1, 3, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(3, 0)*pol_y(2, 3, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(4, 0)*pol_y(2, 3, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(1, 1)*pol_y(1, 3, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(2, 1)*pol_y(1, 3, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(3, 1)*pol_y(2, 3, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(4, 1)*pol_y(2, 3, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(1, 2)*pol_y(1, 3, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(2, 2)*pol_y(1, 3, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(3, 2)*pol_y(2, 3, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(4, 2)*pol_y(2, 3, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(1, 0)*pol_y(1, 4, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(2, 0)*pol_y(1, 4, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(3, 0)*pol_y(2, 4, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(4, 0)*pol_y(2, 4, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(1, 1)*pol_y(1, 4, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(2, 1)*pol_y(1, 4, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(3, 1)*pol_y(2, 4, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(4, 1)*pol_y(2, 4, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(1, 0)*pol_y(1, 5, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(2, 0)*pol_y(1, 5, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(3, 0)*pol_y(2, 5, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(4, 0)*pol_y(2, 5, jg) END DO - coef_xyz(1) = coef_xyz(1)+SUM(coef_xy(:, 1)*pol_z(:, 0, kg)) - coef_xyz(2) = coef_xyz(2)+SUM(coef_xy(:, 2)*pol_z(:, 0, kg)) - coef_xyz(3) = coef_xyz(3)+SUM(coef_xy(:, 3)*pol_z(:, 0, kg)) - coef_xyz(4) = coef_xyz(4)+SUM(coef_xy(:, 4)*pol_z(:, 0, kg)) - coef_xyz(5) = coef_xyz(5)+SUM(coef_xy(:, 5)*pol_z(:, 0, kg)) - coef_xyz(6) = coef_xyz(6)+SUM(coef_xy(:, 6)*pol_z(:, 0, kg)) - coef_xyz(7) = coef_xyz(7)+SUM(coef_xy(:, 7)*pol_z(:, 0, kg)) - coef_xyz(8) = coef_xyz(8)+SUM(coef_xy(:, 8)*pol_z(:, 0, kg)) - coef_xyz(9) = coef_xyz(9)+SUM(coef_xy(:, 9)*pol_z(:, 0, kg)) - coef_xyz(10) = coef_xyz(10)+SUM(coef_xy(:, 10)*pol_z(:, 0, kg)) - coef_xyz(11) = coef_xyz(11)+SUM(coef_xy(:, 11)*pol_z(:, 0, kg)) - coef_xyz(12) = coef_xyz(12)+SUM(coef_xy(:, 12)*pol_z(:, 0, kg)) - coef_xyz(13) = coef_xyz(13)+SUM(coef_xy(:, 13)*pol_z(:, 0, kg)) - coef_xyz(14) = coef_xyz(14)+SUM(coef_xy(:, 14)*pol_z(:, 0, kg)) - coef_xyz(15) = coef_xyz(15)+SUM(coef_xy(:, 15)*pol_z(:, 0, kg)) - coef_xyz(16) = coef_xyz(16)+SUM(coef_xy(:, 16)*pol_z(:, 0, kg)) - coef_xyz(17) = coef_xyz(17)+SUM(coef_xy(:, 17)*pol_z(:, 0, kg)) - coef_xyz(18) = coef_xyz(18)+SUM(coef_xy(:, 18)*pol_z(:, 0, kg)) - coef_xyz(19) = coef_xyz(19)+SUM(coef_xy(:, 19)*pol_z(:, 0, kg)) - coef_xyz(20) = coef_xyz(20)+SUM(coef_xy(:, 20)*pol_z(:, 0, kg)) - coef_xyz(21) = coef_xyz(21)+SUM(coef_xy(:, 21)*pol_z(:, 0, kg)) - coef_xyz(22) = coef_xyz(22)+SUM(coef_xy(:, 1)*pol_z(:, 1, kg)) - coef_xyz(23) = coef_xyz(23)+SUM(coef_xy(:, 2)*pol_z(:, 1, kg)) - coef_xyz(24) = coef_xyz(24)+SUM(coef_xy(:, 3)*pol_z(:, 1, kg)) - coef_xyz(25) = coef_xyz(25)+SUM(coef_xy(:, 4)*pol_z(:, 1, kg)) - coef_xyz(26) = coef_xyz(26)+SUM(coef_xy(:, 5)*pol_z(:, 1, kg)) - coef_xyz(27) = coef_xyz(27)+SUM(coef_xy(:, 7)*pol_z(:, 1, kg)) - coef_xyz(28) = coef_xyz(28)+SUM(coef_xy(:, 8)*pol_z(:, 1, kg)) - coef_xyz(29) = coef_xyz(29)+SUM(coef_xy(:, 9)*pol_z(:, 1, kg)) - coef_xyz(30) = coef_xyz(30)+SUM(coef_xy(:, 10)*pol_z(:, 1, kg)) - coef_xyz(31) = coef_xyz(31)+SUM(coef_xy(:, 12)*pol_z(:, 1, kg)) - coef_xyz(32) = coef_xyz(32)+SUM(coef_xy(:, 13)*pol_z(:, 1, kg)) - coef_xyz(33) = coef_xyz(33)+SUM(coef_xy(:, 14)*pol_z(:, 1, kg)) - coef_xyz(34) = coef_xyz(34)+SUM(coef_xy(:, 16)*pol_z(:, 1, kg)) - coef_xyz(35) = coef_xyz(35)+SUM(coef_xy(:, 17)*pol_z(:, 1, kg)) - coef_xyz(36) = coef_xyz(36)+SUM(coef_xy(:, 19)*pol_z(:, 1, kg)) - coef_xyz(37) = coef_xyz(37)+SUM(coef_xy(:, 1)*pol_z(:, 2, kg)) - coef_xyz(38) = coef_xyz(38)+SUM(coef_xy(:, 2)*pol_z(:, 2, kg)) - coef_xyz(39) = coef_xyz(39)+SUM(coef_xy(:, 3)*pol_z(:, 2, kg)) - coef_xyz(40) = coef_xyz(40)+SUM(coef_xy(:, 4)*pol_z(:, 2, kg)) - coef_xyz(41) = coef_xyz(41)+SUM(coef_xy(:, 7)*pol_z(:, 2, kg)) - coef_xyz(42) = coef_xyz(42)+SUM(coef_xy(:, 8)*pol_z(:, 2, kg)) - coef_xyz(43) = coef_xyz(43)+SUM(coef_xy(:, 9)*pol_z(:, 2, kg)) - coef_xyz(44) = coef_xyz(44)+SUM(coef_xy(:, 12)*pol_z(:, 2, kg)) - coef_xyz(45) = coef_xyz(45)+SUM(coef_xy(:, 13)*pol_z(:, 2, kg)) - coef_xyz(46) = coef_xyz(46)+SUM(coef_xy(:, 16)*pol_z(:, 2, kg)) - coef_xyz(47) = coef_xyz(47)+SUM(coef_xy(:, 1)*pol_z(:, 3, kg)) - coef_xyz(48) = coef_xyz(48)+SUM(coef_xy(:, 2)*pol_z(:, 3, kg)) - coef_xyz(49) = coef_xyz(49)+SUM(coef_xy(:, 3)*pol_z(:, 3, kg)) - coef_xyz(50) = coef_xyz(50)+SUM(coef_xy(:, 7)*pol_z(:, 3, kg)) - coef_xyz(51) = coef_xyz(51)+SUM(coef_xy(:, 8)*pol_z(:, 3, kg)) - coef_xyz(52) = coef_xyz(52)+SUM(coef_xy(:, 12)*pol_z(:, 3, kg)) - coef_xyz(53) = coef_xyz(53)+SUM(coef_xy(:, 1)*pol_z(:, 4, kg)) - coef_xyz(54) = coef_xyz(54)+SUM(coef_xy(:, 2)*pol_z(:, 4, kg)) - coef_xyz(55) = coef_xyz(55)+SUM(coef_xy(:, 7)*pol_z(:, 4, kg)) - coef_xyz(56) = coef_xyz(56)+SUM(coef_xy(:, 1)*pol_z(:, 5, kg)) + coef_xyz(1) = coef_xyz(1) + SUM(coef_xy(:, 1)*pol_z(:, 0, kg)) + coef_xyz(2) = coef_xyz(2) + SUM(coef_xy(:, 2)*pol_z(:, 0, kg)) + coef_xyz(3) = coef_xyz(3) + SUM(coef_xy(:, 3)*pol_z(:, 0, kg)) + coef_xyz(4) = coef_xyz(4) + SUM(coef_xy(:, 4)*pol_z(:, 0, kg)) + coef_xyz(5) = coef_xyz(5) + SUM(coef_xy(:, 5)*pol_z(:, 0, kg)) + coef_xyz(6) = coef_xyz(6) + SUM(coef_xy(:, 6)*pol_z(:, 0, kg)) + coef_xyz(7) = coef_xyz(7) + SUM(coef_xy(:, 7)*pol_z(:, 0, kg)) + coef_xyz(8) = coef_xyz(8) + SUM(coef_xy(:, 8)*pol_z(:, 0, kg)) + coef_xyz(9) = coef_xyz(9) + SUM(coef_xy(:, 9)*pol_z(:, 0, kg)) + coef_xyz(10) = coef_xyz(10) + SUM(coef_xy(:, 10)*pol_z(:, 0, kg)) + coef_xyz(11) = coef_xyz(11) + SUM(coef_xy(:, 11)*pol_z(:, 0, kg)) + coef_xyz(12) = coef_xyz(12) + SUM(coef_xy(:, 12)*pol_z(:, 0, kg)) + coef_xyz(13) = coef_xyz(13) + SUM(coef_xy(:, 13)*pol_z(:, 0, kg)) + coef_xyz(14) = coef_xyz(14) + SUM(coef_xy(:, 14)*pol_z(:, 0, kg)) + coef_xyz(15) = coef_xyz(15) + SUM(coef_xy(:, 15)*pol_z(:, 0, kg)) + coef_xyz(16) = coef_xyz(16) + SUM(coef_xy(:, 16)*pol_z(:, 0, kg)) + coef_xyz(17) = coef_xyz(17) + SUM(coef_xy(:, 17)*pol_z(:, 0, kg)) + coef_xyz(18) = coef_xyz(18) + SUM(coef_xy(:, 18)*pol_z(:, 0, kg)) + coef_xyz(19) = coef_xyz(19) + SUM(coef_xy(:, 19)*pol_z(:, 0, kg)) + coef_xyz(20) = coef_xyz(20) + SUM(coef_xy(:, 20)*pol_z(:, 0, kg)) + coef_xyz(21) = coef_xyz(21) + SUM(coef_xy(:, 21)*pol_z(:, 0, kg)) + coef_xyz(22) = coef_xyz(22) + SUM(coef_xy(:, 1)*pol_z(:, 1, kg)) + coef_xyz(23) = coef_xyz(23) + SUM(coef_xy(:, 2)*pol_z(:, 1, kg)) + coef_xyz(24) = coef_xyz(24) + SUM(coef_xy(:, 3)*pol_z(:, 1, kg)) + coef_xyz(25) = coef_xyz(25) + SUM(coef_xy(:, 4)*pol_z(:, 1, kg)) + coef_xyz(26) = coef_xyz(26) + SUM(coef_xy(:, 5)*pol_z(:, 1, kg)) + coef_xyz(27) = coef_xyz(27) + SUM(coef_xy(:, 7)*pol_z(:, 1, kg)) + coef_xyz(28) = coef_xyz(28) + SUM(coef_xy(:, 8)*pol_z(:, 1, kg)) + coef_xyz(29) = coef_xyz(29) + SUM(coef_xy(:, 9)*pol_z(:, 1, kg)) + coef_xyz(30) = coef_xyz(30) + SUM(coef_xy(:, 10)*pol_z(:, 1, kg)) + coef_xyz(31) = coef_xyz(31) + SUM(coef_xy(:, 12)*pol_z(:, 1, kg)) + coef_xyz(32) = coef_xyz(32) + SUM(coef_xy(:, 13)*pol_z(:, 1, kg)) + coef_xyz(33) = coef_xyz(33) + SUM(coef_xy(:, 14)*pol_z(:, 1, kg)) + coef_xyz(34) = coef_xyz(34) + SUM(coef_xy(:, 16)*pol_z(:, 1, kg)) + coef_xyz(35) = coef_xyz(35) + SUM(coef_xy(:, 17)*pol_z(:, 1, kg)) + coef_xyz(36) = coef_xyz(36) + SUM(coef_xy(:, 19)*pol_z(:, 1, kg)) + coef_xyz(37) = coef_xyz(37) + SUM(coef_xy(:, 1)*pol_z(:, 2, kg)) + coef_xyz(38) = coef_xyz(38) + SUM(coef_xy(:, 2)*pol_z(:, 2, kg)) + coef_xyz(39) = coef_xyz(39) + SUM(coef_xy(:, 3)*pol_z(:, 2, kg)) + coef_xyz(40) = coef_xyz(40) + SUM(coef_xy(:, 4)*pol_z(:, 2, kg)) + coef_xyz(41) = coef_xyz(41) + SUM(coef_xy(:, 7)*pol_z(:, 2, kg)) + coef_xyz(42) = coef_xyz(42) + SUM(coef_xy(:, 8)*pol_z(:, 2, kg)) + coef_xyz(43) = coef_xyz(43) + SUM(coef_xy(:, 9)*pol_z(:, 2, kg)) + coef_xyz(44) = coef_xyz(44) + SUM(coef_xy(:, 12)*pol_z(:, 2, kg)) + coef_xyz(45) = coef_xyz(45) + SUM(coef_xy(:, 13)*pol_z(:, 2, kg)) + coef_xyz(46) = coef_xyz(46) + SUM(coef_xy(:, 16)*pol_z(:, 2, kg)) + coef_xyz(47) = coef_xyz(47) + SUM(coef_xy(:, 1)*pol_z(:, 3, kg)) + coef_xyz(48) = coef_xyz(48) + SUM(coef_xy(:, 2)*pol_z(:, 3, kg)) + coef_xyz(49) = coef_xyz(49) + SUM(coef_xy(:, 3)*pol_z(:, 3, kg)) + coef_xyz(50) = coef_xyz(50) + SUM(coef_xy(:, 7)*pol_z(:, 3, kg)) + coef_xyz(51) = coef_xyz(51) + SUM(coef_xy(:, 8)*pol_z(:, 3, kg)) + coef_xyz(52) = coef_xyz(52) + SUM(coef_xy(:, 12)*pol_z(:, 3, kg)) + coef_xyz(53) = coef_xyz(53) + SUM(coef_xy(:, 1)*pol_z(:, 4, kg)) + coef_xyz(54) = coef_xyz(54) + SUM(coef_xy(:, 2)*pol_z(:, 4, kg)) + coef_xyz(55) = coef_xyz(55) + SUM(coef_xy(:, 7)*pol_z(:, 4, kg)) + coef_xyz(56) = coef_xyz(56) + SUM(coef_xy(:, 1)*pol_z(:, 5, kg)) END DO END SUBROUTINE integrate_core_5 @@ -964,13 +964,13 @@ SUBROUTINE integrate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -978,23 +978,23 @@ SUBROUTINE integrate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -1003,316 +1003,316 @@ SUBROUTINE integrate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = grid(i, j, k2) s03 = grid(i, j2, k) s04 = grid(i, j2, k2) - coef_x(1, 0) = coef_x(1, 0)+s01*pol_x(0, ig) - coef_x(2, 0) = coef_x(2, 0)+s02*pol_x(0, ig) - coef_x(3, 0) = coef_x(3, 0)+s03*pol_x(0, ig) - coef_x(4, 0) = coef_x(4, 0)+s04*pol_x(0, ig) - coef_x(1, 1) = coef_x(1, 1)+s01*pol_x(1, ig) - coef_x(2, 1) = coef_x(2, 1)+s02*pol_x(1, ig) - coef_x(3, 1) = coef_x(3, 1)+s03*pol_x(1, ig) - coef_x(4, 1) = coef_x(4, 1)+s04*pol_x(1, ig) - coef_x(1, 2) = coef_x(1, 2)+s01*pol_x(2, ig) - coef_x(2, 2) = coef_x(2, 2)+s02*pol_x(2, ig) - coef_x(3, 2) = coef_x(3, 2)+s03*pol_x(2, ig) - coef_x(4, 2) = coef_x(4, 2)+s04*pol_x(2, ig) - coef_x(1, 3) = coef_x(1, 3)+s01*pol_x(3, ig) - coef_x(2, 3) = coef_x(2, 3)+s02*pol_x(3, ig) - coef_x(3, 3) = coef_x(3, 3)+s03*pol_x(3, ig) - coef_x(4, 3) = coef_x(4, 3)+s04*pol_x(3, ig) - coef_x(1, 4) = coef_x(1, 4)+s01*pol_x(4, ig) - coef_x(2, 4) = coef_x(2, 4)+s02*pol_x(4, ig) - coef_x(3, 4) = coef_x(3, 4)+s03*pol_x(4, ig) - coef_x(4, 4) = coef_x(4, 4)+s04*pol_x(4, ig) - coef_x(1, 5) = coef_x(1, 5)+s01*pol_x(5, ig) - coef_x(2, 5) = coef_x(2, 5)+s02*pol_x(5, ig) - coef_x(3, 5) = coef_x(3, 5)+s03*pol_x(5, ig) - coef_x(4, 5) = coef_x(4, 5)+s04*pol_x(5, ig) - coef_x(1, 6) = coef_x(1, 6)+s01*pol_x(6, ig) - coef_x(2, 6) = coef_x(2, 6)+s02*pol_x(6, ig) - coef_x(3, 6) = coef_x(3, 6)+s03*pol_x(6, ig) - coef_x(4, 6) = coef_x(4, 6)+s04*pol_x(6, ig) + coef_x(1, 0) = coef_x(1, 0) + s01*pol_x(0, ig) + coef_x(2, 0) = coef_x(2, 0) + s02*pol_x(0, ig) + coef_x(3, 0) = coef_x(3, 0) + s03*pol_x(0, ig) + coef_x(4, 0) = coef_x(4, 0) + s04*pol_x(0, ig) + coef_x(1, 1) = coef_x(1, 1) + s01*pol_x(1, ig) + coef_x(2, 1) = coef_x(2, 1) + s02*pol_x(1, ig) + coef_x(3, 1) = coef_x(3, 1) + s03*pol_x(1, ig) + coef_x(4, 1) = coef_x(4, 1) + s04*pol_x(1, ig) + coef_x(1, 2) = coef_x(1, 2) + s01*pol_x(2, ig) + coef_x(2, 2) = coef_x(2, 2) + s02*pol_x(2, ig) + coef_x(3, 2) = coef_x(3, 2) + s03*pol_x(2, ig) + coef_x(4, 2) = coef_x(4, 2) + s04*pol_x(2, ig) + coef_x(1, 3) = coef_x(1, 3) + s01*pol_x(3, ig) + coef_x(2, 3) = coef_x(2, 3) + s02*pol_x(3, ig) + coef_x(3, 3) = coef_x(3, 3) + s03*pol_x(3, ig) + coef_x(4, 3) = coef_x(4, 3) + s04*pol_x(3, ig) + coef_x(1, 4) = coef_x(1, 4) + s01*pol_x(4, ig) + coef_x(2, 4) = coef_x(2, 4) + s02*pol_x(4, ig) + coef_x(3, 4) = coef_x(3, 4) + s03*pol_x(4, ig) + coef_x(4, 4) = coef_x(4, 4) + s04*pol_x(4, ig) + coef_x(1, 5) = coef_x(1, 5) + s01*pol_x(5, ig) + coef_x(2, 5) = coef_x(2, 5) + s02*pol_x(5, ig) + coef_x(3, 5) = coef_x(3, 5) + s03*pol_x(5, ig) + coef_x(4, 5) = coef_x(4, 5) + s04*pol_x(5, ig) + coef_x(1, 6) = coef_x(1, 6) + s01*pol_x(6, ig) + coef_x(2, 6) = coef_x(2, 6) + s02*pol_x(6, ig) + coef_x(3, 6) = coef_x(3, 6) + s03*pol_x(6, ig) + coef_x(4, 6) = coef_x(4, 6) + s04*pol_x(6, ig) END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 2)*pol_y(1, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 2)*pol_y(1, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 2)*pol_y(2, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 2)*pol_y(2, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(1, 3)*pol_y(1, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(2, 3)*pol_y(1, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(3, 3)*pol_y(2, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(4, 3)*pol_y(2, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(1, 4)*pol_y(1, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(2, 4)*pol_y(1, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(3, 4)*pol_y(2, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(4, 4)*pol_y(2, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(1, 5)*pol_y(1, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(2, 5)*pol_y(1, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(3, 5)*pol_y(2, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(4, 5)*pol_y(2, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(1, 6)*pol_y(1, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(2, 6)*pol_y(1, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(3, 6)*pol_y(2, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(4, 6)*pol_y(2, 0, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(4, 0)*pol_y(2, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(1, 1)*pol_y(1, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(2, 1)*pol_y(1, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(3, 1)*pol_y(2, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(4, 1)*pol_y(2, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(1, 2)*pol_y(1, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(2, 2)*pol_y(1, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(3, 2)*pol_y(2, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(4, 2)*pol_y(2, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(1, 3)*pol_y(1, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(2, 3)*pol_y(1, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(3, 3)*pol_y(2, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(4, 3)*pol_y(2, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(1, 4)*pol_y(1, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(2, 4)*pol_y(1, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(3, 4)*pol_y(2, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(4, 4)*pol_y(2, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(1, 5)*pol_y(1, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(2, 5)*pol_y(1, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(3, 5)*pol_y(2, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(4, 5)*pol_y(2, 1, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(1, 0)*pol_y(1, 2, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(2, 0)*pol_y(1, 2, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(3, 0)*pol_y(2, 2, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(4, 0)*pol_y(2, 2, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(1, 1)*pol_y(1, 2, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(2, 1)*pol_y(1, 2, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(3, 1)*pol_y(2, 2, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(4, 1)*pol_y(2, 2, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(1, 2)*pol_y(1, 2, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(2, 2)*pol_y(1, 2, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(3, 2)*pol_y(2, 2, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(4, 2)*pol_y(2, 2, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(1, 3)*pol_y(1, 2, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(2, 3)*pol_y(1, 2, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(3, 3)*pol_y(2, 2, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(4, 3)*pol_y(2, 2, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(1, 4)*pol_y(1, 2, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(2, 4)*pol_y(1, 2, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(3, 4)*pol_y(2, 2, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(4, 4)*pol_y(2, 2, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(1, 0)*pol_y(1, 3, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(2, 0)*pol_y(1, 3, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(3, 0)*pol_y(2, 3, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(4, 0)*pol_y(2, 3, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(1, 1)*pol_y(1, 3, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(2, 1)*pol_y(1, 3, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(3, 1)*pol_y(2, 3, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(4, 1)*pol_y(2, 3, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(1, 2)*pol_y(1, 3, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(2, 2)*pol_y(1, 3, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(3, 2)*pol_y(2, 3, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(4, 2)*pol_y(2, 3, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(1, 3)*pol_y(1, 3, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(2, 3)*pol_y(1, 3, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(3, 3)*pol_y(2, 3, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(4, 3)*pol_y(2, 3, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(1, 0)*pol_y(1, 4, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(2, 0)*pol_y(1, 4, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(3, 0)*pol_y(2, 4, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(4, 0)*pol_y(2, 4, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(1, 1)*pol_y(1, 4, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(2, 1)*pol_y(1, 4, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(3, 1)*pol_y(2, 4, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(4, 1)*pol_y(2, 4, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(1, 2)*pol_y(1, 4, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(2, 2)*pol_y(1, 4, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(3, 2)*pol_y(2, 4, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(4, 2)*pol_y(2, 4, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(1, 0)*pol_y(1, 5, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(2, 0)*pol_y(1, 5, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(3, 0)*pol_y(2, 5, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(4, 0)*pol_y(2, 5, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(1, 1)*pol_y(1, 5, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(2, 1)*pol_y(1, 5, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(3, 1)*pol_y(2, 5, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(4, 1)*pol_y(2, 5, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(1, 0)*pol_y(1, 6, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(2, 0)*pol_y(1, 6, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(3, 0)*pol_y(2, 6, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(4, 0)*pol_y(2, 6, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 2)*pol_y(1, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 2)*pol_y(1, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 2)*pol_y(2, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 2)*pol_y(2, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(1, 3)*pol_y(1, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(2, 3)*pol_y(1, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(3, 3)*pol_y(2, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(4, 3)*pol_y(2, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(1, 4)*pol_y(1, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(2, 4)*pol_y(1, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(3, 4)*pol_y(2, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(4, 4)*pol_y(2, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(1, 5)*pol_y(1, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(2, 5)*pol_y(1, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(3, 5)*pol_y(2, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(4, 5)*pol_y(2, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(1, 6)*pol_y(1, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(2, 6)*pol_y(1, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(3, 6)*pol_y(2, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(4, 6)*pol_y(2, 0, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(1, 1)*pol_y(1, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(2, 1)*pol_y(1, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(3, 1)*pol_y(2, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(4, 1)*pol_y(2, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(1, 2)*pol_y(1, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(2, 2)*pol_y(1, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(3, 2)*pol_y(2, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(4, 2)*pol_y(2, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(1, 3)*pol_y(1, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(2, 3)*pol_y(1, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(3, 3)*pol_y(2, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(4, 3)*pol_y(2, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(1, 4)*pol_y(1, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(2, 4)*pol_y(1, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(3, 4)*pol_y(2, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(4, 4)*pol_y(2, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(1, 5)*pol_y(1, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(2, 5)*pol_y(1, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(3, 5)*pol_y(2, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(4, 5)*pol_y(2, 1, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(1, 0)*pol_y(1, 2, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(2, 0)*pol_y(1, 2, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(3, 0)*pol_y(2, 2, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(4, 0)*pol_y(2, 2, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(1, 1)*pol_y(1, 2, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(2, 1)*pol_y(1, 2, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(3, 1)*pol_y(2, 2, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(4, 1)*pol_y(2, 2, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(1, 2)*pol_y(1, 2, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(2, 2)*pol_y(1, 2, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(3, 2)*pol_y(2, 2, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(4, 2)*pol_y(2, 2, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(1, 3)*pol_y(1, 2, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(2, 3)*pol_y(1, 2, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(3, 3)*pol_y(2, 2, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(4, 3)*pol_y(2, 2, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(1, 4)*pol_y(1, 2, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(2, 4)*pol_y(1, 2, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(3, 4)*pol_y(2, 2, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(4, 4)*pol_y(2, 2, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(1, 0)*pol_y(1, 3, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(2, 0)*pol_y(1, 3, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(3, 0)*pol_y(2, 3, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(4, 0)*pol_y(2, 3, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(1, 1)*pol_y(1, 3, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(2, 1)*pol_y(1, 3, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(3, 1)*pol_y(2, 3, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(4, 1)*pol_y(2, 3, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(1, 2)*pol_y(1, 3, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(2, 2)*pol_y(1, 3, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(3, 2)*pol_y(2, 3, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(4, 2)*pol_y(2, 3, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(1, 3)*pol_y(1, 3, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(2, 3)*pol_y(1, 3, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(3, 3)*pol_y(2, 3, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(4, 3)*pol_y(2, 3, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(1, 0)*pol_y(1, 4, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(2, 0)*pol_y(1, 4, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(3, 0)*pol_y(2, 4, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(4, 0)*pol_y(2, 4, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(1, 1)*pol_y(1, 4, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(2, 1)*pol_y(1, 4, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(3, 1)*pol_y(2, 4, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(4, 1)*pol_y(2, 4, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(1, 2)*pol_y(1, 4, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(2, 2)*pol_y(1, 4, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(3, 2)*pol_y(2, 4, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(4, 2)*pol_y(2, 4, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(1, 0)*pol_y(1, 5, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(2, 0)*pol_y(1, 5, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(3, 0)*pol_y(2, 5, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(4, 0)*pol_y(2, 5, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(1, 1)*pol_y(1, 5, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(2, 1)*pol_y(1, 5, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(3, 1)*pol_y(2, 5, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(4, 1)*pol_y(2, 5, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(1, 0)*pol_y(1, 6, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(2, 0)*pol_y(1, 6, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(3, 0)*pol_y(2, 6, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(4, 0)*pol_y(2, 6, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 11)*pol_z(1, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 11)*pol_z(2, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 12)*pol_z(1, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 12)*pol_z(2, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 13)*pol_z(1, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 13)*pol_z(2, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 14)*pol_z(1, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 14)*pol_z(2, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 15)*pol_z(1, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 15)*pol_z(2, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 16)*pol_z(1, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 16)*pol_z(2, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 17)*pol_z(1, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 17)*pol_z(2, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 18)*pol_z(1, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 18)*pol_z(2, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 19)*pol_z(1, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 19)*pol_z(2, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 20)*pol_z(1, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 20)*pol_z(2, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(1, 21)*pol_z(1, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(2, 21)*pol_z(2, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(1, 22)*pol_z(1, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(2, 22)*pol_z(2, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(1, 23)*pol_z(1, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(2, 23)*pol_z(2, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(1, 24)*pol_z(1, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(2, 24)*pol_z(2, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(1, 25)*pol_z(1, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(2, 25)*pol_z(2, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(1, 26)*pol_z(1, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(2, 26)*pol_z(2, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(1, 27)*pol_z(1, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(2, 27)*pol_z(2, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(1, 28)*pol_z(1, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(2, 28)*pol_z(2, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(1, 5)*pol_z(1, 1, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(2, 5)*pol_z(2, 1, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(1, 8)*pol_z(1, 1, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(2, 8)*pol_z(2, 1, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(1, 9)*pol_z(1, 1, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(2, 9)*pol_z(2, 1, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(1, 10)*pol_z(1, 1, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(2, 10)*pol_z(2, 1, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(1, 11)*pol_z(1, 1, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(2, 11)*pol_z(2, 1, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(1, 12)*pol_z(1, 1, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(2, 12)*pol_z(2, 1, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(1, 14)*pol_z(1, 1, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(2, 14)*pol_z(2, 1, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(1, 15)*pol_z(1, 1, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(2, 15)*pol_z(2, 1, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(1, 16)*pol_z(1, 1, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(2, 16)*pol_z(2, 1, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(1, 17)*pol_z(1, 1, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(2, 17)*pol_z(2, 1, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(1, 19)*pol_z(1, 1, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(2, 19)*pol_z(2, 1, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(1, 20)*pol_z(1, 1, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(2, 20)*pol_z(2, 1, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(1, 21)*pol_z(1, 1, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(2, 21)*pol_z(2, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(1, 23)*pol_z(1, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(2, 23)*pol_z(2, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(1, 24)*pol_z(1, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(2, 24)*pol_z(2, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(1, 26)*pol_z(1, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(2, 26)*pol_z(2, 1, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(1, 3)*pol_z(1, 2, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(2, 3)*pol_z(2, 2, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(1, 4)*pol_z(1, 2, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(2, 4)*pol_z(2, 2, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(1, 5)*pol_z(1, 2, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(2, 5)*pol_z(2, 2, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(1, 8)*pol_z(1, 2, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(2, 8)*pol_z(2, 2, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(1, 9)*pol_z(1, 2, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(2, 9)*pol_z(2, 2, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(1, 10)*pol_z(1, 2, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(2, 10)*pol_z(2, 2, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(1, 11)*pol_z(1, 2, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(2, 11)*pol_z(2, 2, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(1, 14)*pol_z(1, 2, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(2, 14)*pol_z(2, 2, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(1, 15)*pol_z(1, 2, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(2, 15)*pol_z(2, 2, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(1, 16)*pol_z(1, 2, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(2, 16)*pol_z(2, 2, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(1, 19)*pol_z(1, 2, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(2, 19)*pol_z(2, 2, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(1, 20)*pol_z(1, 2, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(2, 20)*pol_z(2, 2, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(1, 23)*pol_z(1, 2, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(2, 23)*pol_z(2, 2, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(2, 1)*pol_z(2, 3, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(1, 2)*pol_z(1, 3, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(2, 2)*pol_z(2, 3, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(1, 3)*pol_z(1, 3, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(2, 3)*pol_z(2, 3, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(1, 4)*pol_z(1, 3, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(2, 4)*pol_z(2, 3, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(1, 8)*pol_z(1, 3, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(2, 8)*pol_z(2, 3, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(1, 9)*pol_z(1, 3, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(2, 9)*pol_z(2, 3, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(1, 10)*pol_z(1, 3, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(2, 10)*pol_z(2, 3, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(1, 14)*pol_z(1, 3, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(2, 14)*pol_z(2, 3, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(1, 15)*pol_z(1, 3, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(2, 15)*pol_z(2, 3, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(1, 19)*pol_z(1, 3, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(2, 19)*pol_z(2, 3, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(1, 1)*pol_z(1, 4, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(2, 1)*pol_z(2, 4, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(1, 2)*pol_z(1, 4, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(2, 2)*pol_z(2, 4, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(1, 3)*pol_z(1, 4, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(2, 3)*pol_z(2, 4, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(1, 8)*pol_z(1, 4, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(2, 8)*pol_z(2, 4, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(1, 9)*pol_z(1, 4, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(2, 9)*pol_z(2, 4, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(1, 14)*pol_z(1, 4, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(2, 14)*pol_z(2, 4, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(1, 1)*pol_z(1, 5, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(2, 1)*pol_z(2, 5, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(1, 2)*pol_z(1, 5, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(2, 2)*pol_z(2, 5, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(1, 8)*pol_z(1, 5, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(2, 8)*pol_z(2, 5, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(1, 1)*pol_z(1, 6, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(2, 1)*pol_z(2, 6, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 11)*pol_z(1, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 11)*pol_z(2, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 12)*pol_z(1, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 12)*pol_z(2, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 13)*pol_z(1, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 13)*pol_z(2, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 14)*pol_z(1, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 14)*pol_z(2, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 15)*pol_z(1, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 15)*pol_z(2, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 16)*pol_z(1, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 16)*pol_z(2, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 17)*pol_z(1, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 17)*pol_z(2, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 18)*pol_z(1, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 18)*pol_z(2, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 19)*pol_z(1, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 19)*pol_z(2, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 20)*pol_z(1, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 20)*pol_z(2, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(1, 21)*pol_z(1, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(2, 21)*pol_z(2, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(1, 22)*pol_z(1, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(2, 22)*pol_z(2, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(1, 23)*pol_z(1, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(2, 23)*pol_z(2, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(1, 24)*pol_z(1, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(2, 24)*pol_z(2, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(1, 25)*pol_z(1, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(2, 25)*pol_z(2, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(1, 26)*pol_z(1, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(2, 26)*pol_z(2, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(1, 27)*pol_z(1, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(2, 27)*pol_z(2, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(1, 28)*pol_z(1, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(2, 28)*pol_z(2, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(1, 5)*pol_z(1, 1, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(2, 5)*pol_z(2, 1, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(1, 8)*pol_z(1, 1, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(2, 8)*pol_z(2, 1, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(1, 9)*pol_z(1, 1, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(2, 9)*pol_z(2, 1, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(1, 10)*pol_z(1, 1, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(2, 10)*pol_z(2, 1, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(1, 11)*pol_z(1, 1, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(2, 11)*pol_z(2, 1, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(1, 12)*pol_z(1, 1, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(2, 12)*pol_z(2, 1, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(1, 14)*pol_z(1, 1, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(2, 14)*pol_z(2, 1, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(1, 15)*pol_z(1, 1, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(2, 15)*pol_z(2, 1, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(1, 16)*pol_z(1, 1, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(2, 16)*pol_z(2, 1, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(1, 17)*pol_z(1, 1, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(2, 17)*pol_z(2, 1, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(1, 19)*pol_z(1, 1, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(2, 19)*pol_z(2, 1, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(1, 20)*pol_z(1, 1, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(2, 20)*pol_z(2, 1, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(1, 21)*pol_z(1, 1, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(2, 21)*pol_z(2, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(1, 23)*pol_z(1, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(2, 23)*pol_z(2, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(1, 24)*pol_z(1, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(2, 24)*pol_z(2, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(1, 26)*pol_z(1, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(2, 26)*pol_z(2, 1, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(1, 3)*pol_z(1, 2, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(2, 3)*pol_z(2, 2, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(1, 4)*pol_z(1, 2, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(2, 4)*pol_z(2, 2, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(1, 5)*pol_z(1, 2, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(2, 5)*pol_z(2, 2, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(1, 8)*pol_z(1, 2, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(2, 8)*pol_z(2, 2, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(1, 9)*pol_z(1, 2, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(2, 9)*pol_z(2, 2, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(1, 10)*pol_z(1, 2, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(2, 10)*pol_z(2, 2, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(1, 11)*pol_z(1, 2, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(2, 11)*pol_z(2, 2, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(1, 14)*pol_z(1, 2, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(2, 14)*pol_z(2, 2, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(1, 15)*pol_z(1, 2, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(2, 15)*pol_z(2, 2, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(1, 16)*pol_z(1, 2, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(2, 16)*pol_z(2, 2, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(1, 19)*pol_z(1, 2, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(2, 19)*pol_z(2, 2, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(1, 20)*pol_z(1, 2, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(2, 20)*pol_z(2, 2, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(1, 23)*pol_z(1, 2, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(2, 23)*pol_z(2, 2, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(1, 2)*pol_z(1, 3, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(2, 2)*pol_z(2, 3, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(1, 3)*pol_z(1, 3, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(2, 3)*pol_z(2, 3, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(1, 4)*pol_z(1, 3, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(2, 4)*pol_z(2, 3, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(1, 8)*pol_z(1, 3, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(2, 8)*pol_z(2, 3, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(1, 9)*pol_z(1, 3, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(2, 9)*pol_z(2, 3, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(1, 10)*pol_z(1, 3, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(2, 10)*pol_z(2, 3, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(1, 14)*pol_z(1, 3, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(2, 14)*pol_z(2, 3, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(1, 15)*pol_z(1, 3, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(2, 15)*pol_z(2, 3, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(1, 19)*pol_z(1, 3, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(2, 19)*pol_z(2, 3, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(1, 1)*pol_z(1, 4, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(2, 1)*pol_z(2, 4, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(1, 2)*pol_z(1, 4, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(2, 2)*pol_z(2, 4, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(1, 3)*pol_z(1, 4, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(2, 3)*pol_z(2, 4, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(1, 8)*pol_z(1, 4, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(2, 8)*pol_z(2, 4, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(1, 9)*pol_z(1, 4, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(2, 9)*pol_z(2, 4, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(1, 14)*pol_z(1, 4, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(2, 14)*pol_z(2, 4, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(1, 1)*pol_z(1, 5, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(2, 1)*pol_z(2, 5, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(1, 2)*pol_z(1, 5, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(2, 2)*pol_z(2, 5, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(1, 8)*pol_z(1, 5, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(2, 8)*pol_z(2, 5, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(1, 1)*pol_z(1, 6, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(2, 1)*pol_z(2, 6, kg) END DO END SUBROUTINE integrate_core_6 @@ -1339,13 +1339,13 @@ SUBROUTINE integrate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -1353,23 +1353,23 @@ SUBROUTINE integrate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -1379,397 +1379,397 @@ SUBROUTINE integrate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 2)*pol_y(1, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 2)*pol_y(1, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 2)*pol_y(2, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 2)*pol_y(2, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(1, 3)*pol_y(1, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(2, 3)*pol_y(1, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(3, 3)*pol_y(2, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(4, 3)*pol_y(2, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(1, 4)*pol_y(1, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(2, 4)*pol_y(1, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(3, 4)*pol_y(2, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(4, 4)*pol_y(2, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(1, 5)*pol_y(1, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(2, 5)*pol_y(1, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(3, 5)*pol_y(2, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(4, 5)*pol_y(2, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(1, 6)*pol_y(1, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(2, 6)*pol_y(1, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(3, 6)*pol_y(2, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(4, 6)*pol_y(2, 0, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(1, 7)*pol_y(1, 0, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(2, 7)*pol_y(1, 0, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(3, 7)*pol_y(2, 0, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(4, 7)*pol_y(2, 0, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(4, 0)*pol_y(2, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(1, 1)*pol_y(1, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(2, 1)*pol_y(1, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(3, 1)*pol_y(2, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(4, 1)*pol_y(2, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(1, 2)*pol_y(1, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(2, 2)*pol_y(1, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(3, 2)*pol_y(2, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(4, 2)*pol_y(2, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(1, 3)*pol_y(1, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(2, 3)*pol_y(1, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(3, 3)*pol_y(2, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(4, 3)*pol_y(2, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(1, 4)*pol_y(1, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(2, 4)*pol_y(1, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(3, 4)*pol_y(2, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(4, 4)*pol_y(2, 1, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(1, 5)*pol_y(1, 1, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(2, 5)*pol_y(1, 1, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(3, 5)*pol_y(2, 1, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(4, 5)*pol_y(2, 1, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(1, 6)*pol_y(1, 1, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(2, 6)*pol_y(1, 1, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(3, 6)*pol_y(2, 1, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(4, 6)*pol_y(2, 1, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(1, 0)*pol_y(1, 2, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(2, 0)*pol_y(1, 2, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(3, 0)*pol_y(2, 2, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(4, 0)*pol_y(2, 2, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(1, 1)*pol_y(1, 2, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(2, 1)*pol_y(1, 2, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(3, 1)*pol_y(2, 2, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(4, 1)*pol_y(2, 2, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(1, 2)*pol_y(1, 2, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(2, 2)*pol_y(1, 2, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(3, 2)*pol_y(2, 2, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(4, 2)*pol_y(2, 2, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(1, 3)*pol_y(1, 2, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(2, 3)*pol_y(1, 2, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(3, 3)*pol_y(2, 2, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(4, 3)*pol_y(2, 2, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(1, 4)*pol_y(1, 2, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(2, 4)*pol_y(1, 2, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(3, 4)*pol_y(2, 2, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(4, 4)*pol_y(2, 2, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(1, 5)*pol_y(1, 2, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(2, 5)*pol_y(1, 2, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(3, 5)*pol_y(2, 2, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(4, 5)*pol_y(2, 2, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(1, 0)*pol_y(1, 3, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(2, 0)*pol_y(1, 3, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(3, 0)*pol_y(2, 3, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(4, 0)*pol_y(2, 3, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(1, 1)*pol_y(1, 3, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(2, 1)*pol_y(1, 3, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(3, 1)*pol_y(2, 3, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(4, 1)*pol_y(2, 3, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(1, 2)*pol_y(1, 3, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(2, 2)*pol_y(1, 3, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(3, 2)*pol_y(2, 3, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(4, 2)*pol_y(2, 3, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(1, 3)*pol_y(1, 3, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(2, 3)*pol_y(1, 3, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(3, 3)*pol_y(2, 3, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(4, 3)*pol_y(2, 3, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(1, 4)*pol_y(1, 3, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(2, 4)*pol_y(1, 3, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(3, 4)*pol_y(2, 3, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(4, 4)*pol_y(2, 3, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(1, 0)*pol_y(1, 4, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(2, 0)*pol_y(1, 4, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(3, 0)*pol_y(2, 4, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(4, 0)*pol_y(2, 4, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(1, 1)*pol_y(1, 4, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(2, 1)*pol_y(1, 4, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(3, 1)*pol_y(2, 4, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(4, 1)*pol_y(2, 4, jg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_x(1, 2)*pol_y(1, 4, jg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_x(2, 2)*pol_y(1, 4, jg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_x(3, 2)*pol_y(2, 4, jg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_x(4, 2)*pol_y(2, 4, jg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_x(1, 3)*pol_y(1, 4, jg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_x(2, 3)*pol_y(1, 4, jg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_x(3, 3)*pol_y(2, 4, jg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_x(4, 3)*pol_y(2, 4, jg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_x(1, 0)*pol_y(1, 5, jg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_x(2, 0)*pol_y(1, 5, jg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_x(3, 0)*pol_y(2, 5, jg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_x(4, 0)*pol_y(2, 5, jg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_x(1, 1)*pol_y(1, 5, jg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_x(2, 1)*pol_y(1, 5, jg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_x(3, 1)*pol_y(2, 5, jg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_x(4, 1)*pol_y(2, 5, jg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_x(1, 2)*pol_y(1, 5, jg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_x(2, 2)*pol_y(1, 5, jg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_x(3, 2)*pol_y(2, 5, jg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_x(4, 2)*pol_y(2, 5, jg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_x(1, 0)*pol_y(1, 6, jg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_x(2, 0)*pol_y(1, 6, jg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_x(3, 0)*pol_y(2, 6, jg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_x(4, 0)*pol_y(2, 6, jg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_x(1, 1)*pol_y(1, 6, jg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_x(2, 1)*pol_y(1, 6, jg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_x(3, 1)*pol_y(2, 6, jg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_x(4, 1)*pol_y(2, 6, jg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_x(1, 0)*pol_y(1, 7, jg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_x(2, 0)*pol_y(1, 7, jg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_x(3, 0)*pol_y(2, 7, jg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_x(4, 0)*pol_y(2, 7, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 2)*pol_y(1, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 2)*pol_y(1, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 2)*pol_y(2, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 2)*pol_y(2, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(1, 3)*pol_y(1, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(2, 3)*pol_y(1, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(3, 3)*pol_y(2, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(4, 3)*pol_y(2, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(1, 4)*pol_y(1, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(2, 4)*pol_y(1, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(3, 4)*pol_y(2, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(4, 4)*pol_y(2, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(1, 5)*pol_y(1, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(2, 5)*pol_y(1, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(3, 5)*pol_y(2, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(4, 5)*pol_y(2, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(1, 6)*pol_y(1, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(2, 6)*pol_y(1, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(3, 6)*pol_y(2, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(4, 6)*pol_y(2, 0, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(1, 7)*pol_y(1, 0, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(2, 7)*pol_y(1, 0, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(3, 7)*pol_y(2, 0, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(4, 7)*pol_y(2, 0, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(1, 1)*pol_y(1, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(2, 1)*pol_y(1, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(3, 1)*pol_y(2, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(4, 1)*pol_y(2, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(1, 2)*pol_y(1, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(2, 2)*pol_y(1, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(3, 2)*pol_y(2, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(4, 2)*pol_y(2, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(1, 3)*pol_y(1, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(2, 3)*pol_y(1, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(3, 3)*pol_y(2, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(4, 3)*pol_y(2, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(1, 4)*pol_y(1, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(2, 4)*pol_y(1, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(3, 4)*pol_y(2, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(4, 4)*pol_y(2, 1, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(1, 5)*pol_y(1, 1, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(2, 5)*pol_y(1, 1, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(3, 5)*pol_y(2, 1, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(4, 5)*pol_y(2, 1, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(1, 6)*pol_y(1, 1, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(2, 6)*pol_y(1, 1, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(3, 6)*pol_y(2, 1, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(4, 6)*pol_y(2, 1, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(1, 0)*pol_y(1, 2, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(2, 0)*pol_y(1, 2, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(3, 0)*pol_y(2, 2, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(4, 0)*pol_y(2, 2, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(1, 1)*pol_y(1, 2, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(2, 1)*pol_y(1, 2, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(3, 1)*pol_y(2, 2, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(4, 1)*pol_y(2, 2, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(1, 2)*pol_y(1, 2, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(2, 2)*pol_y(1, 2, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(3, 2)*pol_y(2, 2, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(4, 2)*pol_y(2, 2, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(1, 3)*pol_y(1, 2, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(2, 3)*pol_y(1, 2, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(3, 3)*pol_y(2, 2, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(4, 3)*pol_y(2, 2, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(1, 4)*pol_y(1, 2, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(2, 4)*pol_y(1, 2, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(3, 4)*pol_y(2, 2, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(4, 4)*pol_y(2, 2, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(1, 5)*pol_y(1, 2, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(2, 5)*pol_y(1, 2, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(3, 5)*pol_y(2, 2, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(4, 5)*pol_y(2, 2, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(1, 0)*pol_y(1, 3, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(2, 0)*pol_y(1, 3, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(3, 0)*pol_y(2, 3, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(4, 0)*pol_y(2, 3, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(1, 1)*pol_y(1, 3, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(2, 1)*pol_y(1, 3, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(3, 1)*pol_y(2, 3, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(4, 1)*pol_y(2, 3, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(1, 2)*pol_y(1, 3, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(2, 2)*pol_y(1, 3, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(3, 2)*pol_y(2, 3, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(4, 2)*pol_y(2, 3, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(1, 3)*pol_y(1, 3, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(2, 3)*pol_y(1, 3, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(3, 3)*pol_y(2, 3, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(4, 3)*pol_y(2, 3, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(1, 4)*pol_y(1, 3, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(2, 4)*pol_y(1, 3, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(3, 4)*pol_y(2, 3, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(4, 4)*pol_y(2, 3, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(1, 0)*pol_y(1, 4, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(2, 0)*pol_y(1, 4, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(3, 0)*pol_y(2, 4, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(4, 0)*pol_y(2, 4, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(1, 1)*pol_y(1, 4, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(2, 1)*pol_y(1, 4, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(3, 1)*pol_y(2, 4, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(4, 1)*pol_y(2, 4, jg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_x(1, 2)*pol_y(1, 4, jg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_x(2, 2)*pol_y(1, 4, jg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_x(3, 2)*pol_y(2, 4, jg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_x(4, 2)*pol_y(2, 4, jg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_x(1, 3)*pol_y(1, 4, jg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_x(2, 3)*pol_y(1, 4, jg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_x(3, 3)*pol_y(2, 4, jg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_x(4, 3)*pol_y(2, 4, jg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_x(1, 0)*pol_y(1, 5, jg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_x(2, 0)*pol_y(1, 5, jg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_x(3, 0)*pol_y(2, 5, jg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_x(4, 0)*pol_y(2, 5, jg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_x(1, 1)*pol_y(1, 5, jg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_x(2, 1)*pol_y(1, 5, jg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_x(3, 1)*pol_y(2, 5, jg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_x(4, 1)*pol_y(2, 5, jg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_x(1, 2)*pol_y(1, 5, jg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_x(2, 2)*pol_y(1, 5, jg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_x(3, 2)*pol_y(2, 5, jg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_x(4, 2)*pol_y(2, 5, jg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_x(1, 0)*pol_y(1, 6, jg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_x(2, 0)*pol_y(1, 6, jg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_x(3, 0)*pol_y(2, 6, jg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_x(4, 0)*pol_y(2, 6, jg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_x(1, 1)*pol_y(1, 6, jg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_x(2, 1)*pol_y(1, 6, jg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_x(3, 1)*pol_y(2, 6, jg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_x(4, 1)*pol_y(2, 6, jg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_x(1, 0)*pol_y(1, 7, jg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_x(2, 0)*pol_y(1, 7, jg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_x(3, 0)*pol_y(2, 7, jg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_x(4, 0)*pol_y(2, 7, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 11)*pol_z(1, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 11)*pol_z(2, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 12)*pol_z(1, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 12)*pol_z(2, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 13)*pol_z(1, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 13)*pol_z(2, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 14)*pol_z(1, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 14)*pol_z(2, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 15)*pol_z(1, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 15)*pol_z(2, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 16)*pol_z(1, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 16)*pol_z(2, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 17)*pol_z(1, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 17)*pol_z(2, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 18)*pol_z(1, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 18)*pol_z(2, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 19)*pol_z(1, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 19)*pol_z(2, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 20)*pol_z(1, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 20)*pol_z(2, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(1, 21)*pol_z(1, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(2, 21)*pol_z(2, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(1, 22)*pol_z(1, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(2, 22)*pol_z(2, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(1, 23)*pol_z(1, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(2, 23)*pol_z(2, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(1, 24)*pol_z(1, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(2, 24)*pol_z(2, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(1, 25)*pol_z(1, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(2, 25)*pol_z(2, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(1, 26)*pol_z(1, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(2, 26)*pol_z(2, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(1, 27)*pol_z(1, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(2, 27)*pol_z(2, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(1, 28)*pol_z(1, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(2, 28)*pol_z(2, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(1, 29)*pol_z(1, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(2, 29)*pol_z(2, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(1, 30)*pol_z(1, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(2, 30)*pol_z(2, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(1, 31)*pol_z(1, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(2, 31)*pol_z(2, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(1, 32)*pol_z(1, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(2, 32)*pol_z(2, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(1, 33)*pol_z(1, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(2, 33)*pol_z(2, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(1, 34)*pol_z(1, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(2, 34)*pol_z(2, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(1, 35)*pol_z(1, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(2, 35)*pol_z(2, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(1, 36)*pol_z(1, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(2, 36)*pol_z(2, 0, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(1, 5)*pol_z(1, 1, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(2, 5)*pol_z(2, 1, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(1, 7)*pol_z(1, 1, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(2, 7)*pol_z(2, 1, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(1, 9)*pol_z(1, 1, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(2, 9)*pol_z(2, 1, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(1, 10)*pol_z(1, 1, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(2, 10)*pol_z(2, 1, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(1, 11)*pol_z(1, 1, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(2, 11)*pol_z(2, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(1, 12)*pol_z(1, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(2, 12)*pol_z(2, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(1, 13)*pol_z(1, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(2, 13)*pol_z(2, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(1, 14)*pol_z(1, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(2, 14)*pol_z(2, 1, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(1, 16)*pol_z(1, 1, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(2, 16)*pol_z(2, 1, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(1, 17)*pol_z(1, 1, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(2, 17)*pol_z(2, 1, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(1, 18)*pol_z(1, 1, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(2, 18)*pol_z(2, 1, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(1, 19)*pol_z(1, 1, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(2, 19)*pol_z(2, 1, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(1, 20)*pol_z(1, 1, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(2, 20)*pol_z(2, 1, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(1, 22)*pol_z(1, 1, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(2, 22)*pol_z(2, 1, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(1, 23)*pol_z(1, 1, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(2, 23)*pol_z(2, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(1, 24)*pol_z(1, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(2, 24)*pol_z(2, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(1, 25)*pol_z(1, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(2, 25)*pol_z(2, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(1, 27)*pol_z(1, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(2, 27)*pol_z(2, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(1, 28)*pol_z(1, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(2, 28)*pol_z(2, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(1, 29)*pol_z(1, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(2, 29)*pol_z(2, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(1, 31)*pol_z(1, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(2, 31)*pol_z(2, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(1, 32)*pol_z(1, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(2, 32)*pol_z(2, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(1, 34)*pol_z(1, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(2, 34)*pol_z(2, 1, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(1, 3)*pol_z(1, 2, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(2, 3)*pol_z(2, 2, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(1, 4)*pol_z(1, 2, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(2, 4)*pol_z(2, 2, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(1, 5)*pol_z(1, 2, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(2, 5)*pol_z(2, 2, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(1, 6)*pol_z(1, 2, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(2, 6)*pol_z(2, 2, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(1, 9)*pol_z(1, 2, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(2, 9)*pol_z(2, 2, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(1, 10)*pol_z(1, 2, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(2, 10)*pol_z(2, 2, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(1, 11)*pol_z(1, 2, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(2, 11)*pol_z(2, 2, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(1, 12)*pol_z(1, 2, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(2, 12)*pol_z(2, 2, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(1, 13)*pol_z(1, 2, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(2, 13)*pol_z(2, 2, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(1, 16)*pol_z(1, 2, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(2, 16)*pol_z(2, 2, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(1, 17)*pol_z(1, 2, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(2, 17)*pol_z(2, 2, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(1, 18)*pol_z(1, 2, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(2, 18)*pol_z(2, 2, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(1, 19)*pol_z(1, 2, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(2, 19)*pol_z(2, 2, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(1, 22)*pol_z(1, 2, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(2, 22)*pol_z(2, 2, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(1, 23)*pol_z(1, 2, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(2, 23)*pol_z(2, 2, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(1, 24)*pol_z(1, 2, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(2, 24)*pol_z(2, 2, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(1, 27)*pol_z(1, 2, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(2, 27)*pol_z(2, 2, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(1, 28)*pol_z(1, 2, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(2, 28)*pol_z(2, 2, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(1, 31)*pol_z(1, 2, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(2, 31)*pol_z(2, 2, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(2, 1)*pol_z(2, 3, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(1, 2)*pol_z(1, 3, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(2, 2)*pol_z(2, 3, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(1, 3)*pol_z(1, 3, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(2, 3)*pol_z(2, 3, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(1, 4)*pol_z(1, 3, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(2, 4)*pol_z(2, 3, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(1, 5)*pol_z(1, 3, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(2, 5)*pol_z(2, 3, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(1, 9)*pol_z(1, 3, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(2, 9)*pol_z(2, 3, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(1, 10)*pol_z(1, 3, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(2, 10)*pol_z(2, 3, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(1, 11)*pol_z(1, 3, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(2, 11)*pol_z(2, 3, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(1, 12)*pol_z(1, 3, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(2, 12)*pol_z(2, 3, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(1, 16)*pol_z(1, 3, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(2, 16)*pol_z(2, 3, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(1, 17)*pol_z(1, 3, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(2, 17)*pol_z(2, 3, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(1, 18)*pol_z(1, 3, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(2, 18)*pol_z(2, 3, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(1, 22)*pol_z(1, 3, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(2, 22)*pol_z(2, 3, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(1, 23)*pol_z(1, 3, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(2, 23)*pol_z(2, 3, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(1, 27)*pol_z(1, 3, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(2, 27)*pol_z(2, 3, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(1, 1)*pol_z(1, 4, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(2, 1)*pol_z(2, 4, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(1, 2)*pol_z(1, 4, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(2, 2)*pol_z(2, 4, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(1, 3)*pol_z(1, 4, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(2, 3)*pol_z(2, 4, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(1, 4)*pol_z(1, 4, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(2, 4)*pol_z(2, 4, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(1, 9)*pol_z(1, 4, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(2, 9)*pol_z(2, 4, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(1, 10)*pol_z(1, 4, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(2, 10)*pol_z(2, 4, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(1, 11)*pol_z(1, 4, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(2, 11)*pol_z(2, 4, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(1, 16)*pol_z(1, 4, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(2, 16)*pol_z(2, 4, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(1, 17)*pol_z(1, 4, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(2, 17)*pol_z(2, 4, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(1, 22)*pol_z(1, 4, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(2, 22)*pol_z(2, 4, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(1, 1)*pol_z(1, 5, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(2, 1)*pol_z(2, 5, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(1, 2)*pol_z(1, 5, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(2, 2)*pol_z(2, 5, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(1, 3)*pol_z(1, 5, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(2, 3)*pol_z(2, 5, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(1, 9)*pol_z(1, 5, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(2, 9)*pol_z(2, 5, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(1, 10)*pol_z(1, 5, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(2, 10)*pol_z(2, 5, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(1, 16)*pol_z(1, 5, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(2, 16)*pol_z(2, 5, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(1, 1)*pol_z(1, 6, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(2, 1)*pol_z(2, 6, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(1, 2)*pol_z(1, 6, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(2, 2)*pol_z(2, 6, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(1, 9)*pol_z(1, 6, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(2, 9)*pol_z(2, 6, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(1, 1)*pol_z(1, 7, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(2, 1)*pol_z(2, 7, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 11)*pol_z(1, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 11)*pol_z(2, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 12)*pol_z(1, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 12)*pol_z(2, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 13)*pol_z(1, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 13)*pol_z(2, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 14)*pol_z(1, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 14)*pol_z(2, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 15)*pol_z(1, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 15)*pol_z(2, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 16)*pol_z(1, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 16)*pol_z(2, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 17)*pol_z(1, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 17)*pol_z(2, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 18)*pol_z(1, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 18)*pol_z(2, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 19)*pol_z(1, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 19)*pol_z(2, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 20)*pol_z(1, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 20)*pol_z(2, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(1, 21)*pol_z(1, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(2, 21)*pol_z(2, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(1, 22)*pol_z(1, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(2, 22)*pol_z(2, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(1, 23)*pol_z(1, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(2, 23)*pol_z(2, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(1, 24)*pol_z(1, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(2, 24)*pol_z(2, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(1, 25)*pol_z(1, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(2, 25)*pol_z(2, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(1, 26)*pol_z(1, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(2, 26)*pol_z(2, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(1, 27)*pol_z(1, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(2, 27)*pol_z(2, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(1, 28)*pol_z(1, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(2, 28)*pol_z(2, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(1, 29)*pol_z(1, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(2, 29)*pol_z(2, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(1, 30)*pol_z(1, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(2, 30)*pol_z(2, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(1, 31)*pol_z(1, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(2, 31)*pol_z(2, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(1, 32)*pol_z(1, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(2, 32)*pol_z(2, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(1, 33)*pol_z(1, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(2, 33)*pol_z(2, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(1, 34)*pol_z(1, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(2, 34)*pol_z(2, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(1, 35)*pol_z(1, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(2, 35)*pol_z(2, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(1, 36)*pol_z(1, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(2, 36)*pol_z(2, 0, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(1, 5)*pol_z(1, 1, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(2, 5)*pol_z(2, 1, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(1, 7)*pol_z(1, 1, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(2, 7)*pol_z(2, 1, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(1, 9)*pol_z(1, 1, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(2, 9)*pol_z(2, 1, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(1, 10)*pol_z(1, 1, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(2, 10)*pol_z(2, 1, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(1, 11)*pol_z(1, 1, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(2, 11)*pol_z(2, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(1, 12)*pol_z(1, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(2, 12)*pol_z(2, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(1, 13)*pol_z(1, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(2, 13)*pol_z(2, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(1, 14)*pol_z(1, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(2, 14)*pol_z(2, 1, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(1, 16)*pol_z(1, 1, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(2, 16)*pol_z(2, 1, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(1, 17)*pol_z(1, 1, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(2, 17)*pol_z(2, 1, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(1, 18)*pol_z(1, 1, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(2, 18)*pol_z(2, 1, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(1, 19)*pol_z(1, 1, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(2, 19)*pol_z(2, 1, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(1, 20)*pol_z(1, 1, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(2, 20)*pol_z(2, 1, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(1, 22)*pol_z(1, 1, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(2, 22)*pol_z(2, 1, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(1, 23)*pol_z(1, 1, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(2, 23)*pol_z(2, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(1, 24)*pol_z(1, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(2, 24)*pol_z(2, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(1, 25)*pol_z(1, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(2, 25)*pol_z(2, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(1, 27)*pol_z(1, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(2, 27)*pol_z(2, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(1, 28)*pol_z(1, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(2, 28)*pol_z(2, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(1, 29)*pol_z(1, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(2, 29)*pol_z(2, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(1, 31)*pol_z(1, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(2, 31)*pol_z(2, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(1, 32)*pol_z(1, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(2, 32)*pol_z(2, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(1, 34)*pol_z(1, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(2, 34)*pol_z(2, 1, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(1, 3)*pol_z(1, 2, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(2, 3)*pol_z(2, 2, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(1, 4)*pol_z(1, 2, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(2, 4)*pol_z(2, 2, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(1, 5)*pol_z(1, 2, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(2, 5)*pol_z(2, 2, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(1, 6)*pol_z(1, 2, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(2, 6)*pol_z(2, 2, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(1, 9)*pol_z(1, 2, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(2, 9)*pol_z(2, 2, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(1, 10)*pol_z(1, 2, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(2, 10)*pol_z(2, 2, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(1, 11)*pol_z(1, 2, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(2, 11)*pol_z(2, 2, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(1, 12)*pol_z(1, 2, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(2, 12)*pol_z(2, 2, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(1, 13)*pol_z(1, 2, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(2, 13)*pol_z(2, 2, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(1, 16)*pol_z(1, 2, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(2, 16)*pol_z(2, 2, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(1, 17)*pol_z(1, 2, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(2, 17)*pol_z(2, 2, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(1, 18)*pol_z(1, 2, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(2, 18)*pol_z(2, 2, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(1, 19)*pol_z(1, 2, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(2, 19)*pol_z(2, 2, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(1, 22)*pol_z(1, 2, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(2, 22)*pol_z(2, 2, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(1, 23)*pol_z(1, 2, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(2, 23)*pol_z(2, 2, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(1, 24)*pol_z(1, 2, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(2, 24)*pol_z(2, 2, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(1, 27)*pol_z(1, 2, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(2, 27)*pol_z(2, 2, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(1, 28)*pol_z(1, 2, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(2, 28)*pol_z(2, 2, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(1, 31)*pol_z(1, 2, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(2, 31)*pol_z(2, 2, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(1, 2)*pol_z(1, 3, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(2, 2)*pol_z(2, 3, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(1, 3)*pol_z(1, 3, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(2, 3)*pol_z(2, 3, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(1, 4)*pol_z(1, 3, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(2, 4)*pol_z(2, 3, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(1, 5)*pol_z(1, 3, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(2, 5)*pol_z(2, 3, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(1, 9)*pol_z(1, 3, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(2, 9)*pol_z(2, 3, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(1, 10)*pol_z(1, 3, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(2, 10)*pol_z(2, 3, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(1, 11)*pol_z(1, 3, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(2, 11)*pol_z(2, 3, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(1, 12)*pol_z(1, 3, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(2, 12)*pol_z(2, 3, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(1, 16)*pol_z(1, 3, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(2, 16)*pol_z(2, 3, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(1, 17)*pol_z(1, 3, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(2, 17)*pol_z(2, 3, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(1, 18)*pol_z(1, 3, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(2, 18)*pol_z(2, 3, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(1, 22)*pol_z(1, 3, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(2, 22)*pol_z(2, 3, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(1, 23)*pol_z(1, 3, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(2, 23)*pol_z(2, 3, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(1, 27)*pol_z(1, 3, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(2, 27)*pol_z(2, 3, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(1, 1)*pol_z(1, 4, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(2, 1)*pol_z(2, 4, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(1, 2)*pol_z(1, 4, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(2, 2)*pol_z(2, 4, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(1, 3)*pol_z(1, 4, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(2, 3)*pol_z(2, 4, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(1, 4)*pol_z(1, 4, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(2, 4)*pol_z(2, 4, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(1, 9)*pol_z(1, 4, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(2, 9)*pol_z(2, 4, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(1, 10)*pol_z(1, 4, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(2, 10)*pol_z(2, 4, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(1, 11)*pol_z(1, 4, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(2, 11)*pol_z(2, 4, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(1, 16)*pol_z(1, 4, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(2, 16)*pol_z(2, 4, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(1, 17)*pol_z(1, 4, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(2, 17)*pol_z(2, 4, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(1, 22)*pol_z(1, 4, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(2, 22)*pol_z(2, 4, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(1, 1)*pol_z(1, 5, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(2, 1)*pol_z(2, 5, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(1, 2)*pol_z(1, 5, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(2, 2)*pol_z(2, 5, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(1, 3)*pol_z(1, 5, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(2, 3)*pol_z(2, 5, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(1, 9)*pol_z(1, 5, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(2, 9)*pol_z(2, 5, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(1, 10)*pol_z(1, 5, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(2, 10)*pol_z(2, 5, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(1, 16)*pol_z(1, 5, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(2, 16)*pol_z(2, 5, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(1, 1)*pol_z(1, 6, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(2, 1)*pol_z(2, 6, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(1, 2)*pol_z(1, 6, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(2, 2)*pol_z(2, 6, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(1, 9)*pol_z(1, 6, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(2, 9)*pol_z(2, 6, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(1, 1)*pol_z(1, 7, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(2, 1)*pol_z(2, 7, kg) END DO END SUBROUTINE integrate_core_7 @@ -1796,13 +1796,13 @@ SUBROUTINE integrate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -1810,23 +1810,23 @@ SUBROUTINE integrate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -1836,523 +1836,523 @@ SUBROUTINE integrate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 2)*pol_y(1, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 2)*pol_y(1, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 2)*pol_y(2, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 2)*pol_y(2, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(1, 3)*pol_y(1, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(2, 3)*pol_y(1, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(3, 3)*pol_y(2, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(4, 3)*pol_y(2, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(1, 4)*pol_y(1, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(2, 4)*pol_y(1, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(3, 4)*pol_y(2, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(4, 4)*pol_y(2, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(1, 5)*pol_y(1, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(2, 5)*pol_y(1, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(3, 5)*pol_y(2, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(4, 5)*pol_y(2, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(1, 6)*pol_y(1, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(2, 6)*pol_y(1, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(3, 6)*pol_y(2, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(4, 6)*pol_y(2, 0, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(1, 7)*pol_y(1, 0, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(2, 7)*pol_y(1, 0, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(3, 7)*pol_y(2, 0, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(4, 7)*pol_y(2, 0, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(1, 8)*pol_y(1, 0, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(2, 8)*pol_y(1, 0, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(3, 8)*pol_y(2, 0, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(4, 8)*pol_y(2, 0, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(4, 0)*pol_y(2, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(1, 1)*pol_y(1, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(2, 1)*pol_y(1, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(3, 1)*pol_y(2, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(4, 1)*pol_y(2, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(1, 2)*pol_y(1, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(2, 2)*pol_y(1, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(3, 2)*pol_y(2, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(4, 2)*pol_y(2, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(1, 3)*pol_y(1, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(2, 3)*pol_y(1, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(3, 3)*pol_y(2, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(4, 3)*pol_y(2, 1, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(1, 4)*pol_y(1, 1, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(2, 4)*pol_y(1, 1, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(3, 4)*pol_y(2, 1, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(4, 4)*pol_y(2, 1, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(1, 5)*pol_y(1, 1, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(2, 5)*pol_y(1, 1, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(3, 5)*pol_y(2, 1, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(4, 5)*pol_y(2, 1, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(1, 6)*pol_y(1, 1, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(2, 6)*pol_y(1, 1, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(3, 6)*pol_y(2, 1, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(4, 6)*pol_y(2, 1, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(1, 7)*pol_y(1, 1, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(2, 7)*pol_y(1, 1, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(3, 7)*pol_y(2, 1, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(4, 7)*pol_y(2, 1, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(1, 0)*pol_y(1, 2, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(2, 0)*pol_y(1, 2, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(3, 0)*pol_y(2, 2, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(4, 0)*pol_y(2, 2, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(1, 1)*pol_y(1, 2, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(2, 1)*pol_y(1, 2, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(3, 1)*pol_y(2, 2, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(4, 1)*pol_y(2, 2, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(1, 2)*pol_y(1, 2, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(2, 2)*pol_y(1, 2, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(3, 2)*pol_y(2, 2, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(4, 2)*pol_y(2, 2, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(1, 3)*pol_y(1, 2, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(2, 3)*pol_y(1, 2, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(3, 3)*pol_y(2, 2, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(4, 3)*pol_y(2, 2, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(1, 4)*pol_y(1, 2, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(2, 4)*pol_y(1, 2, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(3, 4)*pol_y(2, 2, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(4, 4)*pol_y(2, 2, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(1, 5)*pol_y(1, 2, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(2, 5)*pol_y(1, 2, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(3, 5)*pol_y(2, 2, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(4, 5)*pol_y(2, 2, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(1, 6)*pol_y(1, 2, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(2, 6)*pol_y(1, 2, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(3, 6)*pol_y(2, 2, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(4, 6)*pol_y(2, 2, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(1, 0)*pol_y(1, 3, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(2, 0)*pol_y(1, 3, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(3, 0)*pol_y(2, 3, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(4, 0)*pol_y(2, 3, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(1, 1)*pol_y(1, 3, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(2, 1)*pol_y(1, 3, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(3, 1)*pol_y(2, 3, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(4, 1)*pol_y(2, 3, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(1, 2)*pol_y(1, 3, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(2, 2)*pol_y(1, 3, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(3, 2)*pol_y(2, 3, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(4, 2)*pol_y(2, 3, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(1, 3)*pol_y(1, 3, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(2, 3)*pol_y(1, 3, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(3, 3)*pol_y(2, 3, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(4, 3)*pol_y(2, 3, jg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_x(1, 4)*pol_y(1, 3, jg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_x(2, 4)*pol_y(1, 3, jg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_x(3, 4)*pol_y(2, 3, jg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_x(4, 4)*pol_y(2, 3, jg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_x(1, 5)*pol_y(1, 3, jg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_x(2, 5)*pol_y(1, 3, jg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_x(3, 5)*pol_y(2, 3, jg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_x(4, 5)*pol_y(2, 3, jg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_x(1, 0)*pol_y(1, 4, jg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_x(2, 0)*pol_y(1, 4, jg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_x(3, 0)*pol_y(2, 4, jg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_x(4, 0)*pol_y(2, 4, jg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_x(1, 1)*pol_y(1, 4, jg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_x(2, 1)*pol_y(1, 4, jg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_x(3, 1)*pol_y(2, 4, jg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_x(4, 1)*pol_y(2, 4, jg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_x(1, 2)*pol_y(1, 4, jg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_x(2, 2)*pol_y(1, 4, jg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_x(3, 2)*pol_y(2, 4, jg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_x(4, 2)*pol_y(2, 4, jg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_x(1, 3)*pol_y(1, 4, jg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_x(2, 3)*pol_y(1, 4, jg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_x(3, 3)*pol_y(2, 4, jg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_x(4, 3)*pol_y(2, 4, jg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_x(1, 4)*pol_y(1, 4, jg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_x(2, 4)*pol_y(1, 4, jg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_x(3, 4)*pol_y(2, 4, jg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_x(4, 4)*pol_y(2, 4, jg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_x(1, 0)*pol_y(1, 5, jg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_x(2, 0)*pol_y(1, 5, jg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_x(3, 0)*pol_y(2, 5, jg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_x(4, 0)*pol_y(2, 5, jg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_x(1, 1)*pol_y(1, 5, jg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_x(2, 1)*pol_y(1, 5, jg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_x(3, 1)*pol_y(2, 5, jg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_x(4, 1)*pol_y(2, 5, jg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_x(1, 2)*pol_y(1, 5, jg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_x(2, 2)*pol_y(1, 5, jg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_x(3, 2)*pol_y(2, 5, jg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_x(4, 2)*pol_y(2, 5, jg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_x(1, 3)*pol_y(1, 5, jg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_x(2, 3)*pol_y(1, 5, jg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_x(3, 3)*pol_y(2, 5, jg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_x(4, 3)*pol_y(2, 5, jg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_x(1, 0)*pol_y(1, 6, jg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_x(2, 0)*pol_y(1, 6, jg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_x(3, 0)*pol_y(2, 6, jg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_x(4, 0)*pol_y(2, 6, jg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_x(1, 1)*pol_y(1, 6, jg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_x(2, 1)*pol_y(1, 6, jg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_x(3, 1)*pol_y(2, 6, jg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_x(4, 1)*pol_y(2, 6, jg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_x(1, 2)*pol_y(1, 6, jg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_x(2, 2)*pol_y(1, 6, jg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_x(3, 2)*pol_y(2, 6, jg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_x(4, 2)*pol_y(2, 6, jg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_x(1, 0)*pol_y(1, 7, jg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_x(2, 0)*pol_y(1, 7, jg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_x(3, 0)*pol_y(2, 7, jg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_x(4, 0)*pol_y(2, 7, jg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_x(1, 1)*pol_y(1, 7, jg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_x(2, 1)*pol_y(1, 7, jg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_x(3, 1)*pol_y(2, 7, jg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_x(4, 1)*pol_y(2, 7, jg) - coef_xy(1, 45) = coef_xy(1, 45)+coef_x(1, 0)*pol_y(1, 8, jg) - coef_xy(2, 45) = coef_xy(2, 45)+coef_x(2, 0)*pol_y(1, 8, jg) - coef_xy(1, 45) = coef_xy(1, 45)+coef_x(3, 0)*pol_y(2, 8, jg) - coef_xy(2, 45) = coef_xy(2, 45)+coef_x(4, 0)*pol_y(2, 8, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 2)*pol_y(1, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 2)*pol_y(1, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 2)*pol_y(2, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 2)*pol_y(2, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(1, 3)*pol_y(1, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(2, 3)*pol_y(1, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(3, 3)*pol_y(2, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(4, 3)*pol_y(2, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(1, 4)*pol_y(1, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(2, 4)*pol_y(1, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(3, 4)*pol_y(2, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(4, 4)*pol_y(2, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(1, 5)*pol_y(1, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(2, 5)*pol_y(1, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(3, 5)*pol_y(2, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(4, 5)*pol_y(2, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(1, 6)*pol_y(1, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(2, 6)*pol_y(1, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(3, 6)*pol_y(2, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(4, 6)*pol_y(2, 0, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(1, 7)*pol_y(1, 0, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(2, 7)*pol_y(1, 0, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(3, 7)*pol_y(2, 0, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(4, 7)*pol_y(2, 0, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(1, 8)*pol_y(1, 0, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(2, 8)*pol_y(1, 0, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(3, 8)*pol_y(2, 0, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(4, 8)*pol_y(2, 0, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(1, 1)*pol_y(1, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(2, 1)*pol_y(1, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(3, 1)*pol_y(2, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(4, 1)*pol_y(2, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(1, 2)*pol_y(1, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(2, 2)*pol_y(1, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(3, 2)*pol_y(2, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(4, 2)*pol_y(2, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(1, 3)*pol_y(1, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(2, 3)*pol_y(1, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(3, 3)*pol_y(2, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(4, 3)*pol_y(2, 1, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(1, 4)*pol_y(1, 1, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(2, 4)*pol_y(1, 1, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(3, 4)*pol_y(2, 1, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(4, 4)*pol_y(2, 1, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(1, 5)*pol_y(1, 1, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(2, 5)*pol_y(1, 1, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(3, 5)*pol_y(2, 1, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(4, 5)*pol_y(2, 1, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(1, 6)*pol_y(1, 1, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(2, 6)*pol_y(1, 1, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(3, 6)*pol_y(2, 1, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(4, 6)*pol_y(2, 1, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(1, 7)*pol_y(1, 1, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(2, 7)*pol_y(1, 1, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(3, 7)*pol_y(2, 1, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(4, 7)*pol_y(2, 1, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(1, 0)*pol_y(1, 2, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(2, 0)*pol_y(1, 2, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(3, 0)*pol_y(2, 2, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(4, 0)*pol_y(2, 2, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(1, 1)*pol_y(1, 2, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(2, 1)*pol_y(1, 2, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(3, 1)*pol_y(2, 2, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(4, 1)*pol_y(2, 2, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(1, 2)*pol_y(1, 2, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(2, 2)*pol_y(1, 2, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(3, 2)*pol_y(2, 2, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(4, 2)*pol_y(2, 2, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(1, 3)*pol_y(1, 2, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(2, 3)*pol_y(1, 2, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(3, 3)*pol_y(2, 2, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(4, 3)*pol_y(2, 2, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(1, 4)*pol_y(1, 2, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(2, 4)*pol_y(1, 2, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(3, 4)*pol_y(2, 2, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(4, 4)*pol_y(2, 2, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(1, 5)*pol_y(1, 2, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(2, 5)*pol_y(1, 2, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(3, 5)*pol_y(2, 2, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(4, 5)*pol_y(2, 2, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(1, 6)*pol_y(1, 2, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(2, 6)*pol_y(1, 2, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(3, 6)*pol_y(2, 2, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(4, 6)*pol_y(2, 2, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(1, 0)*pol_y(1, 3, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(2, 0)*pol_y(1, 3, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(3, 0)*pol_y(2, 3, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(4, 0)*pol_y(2, 3, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(1, 1)*pol_y(1, 3, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(2, 1)*pol_y(1, 3, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(3, 1)*pol_y(2, 3, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(4, 1)*pol_y(2, 3, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(1, 2)*pol_y(1, 3, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(2, 2)*pol_y(1, 3, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(3, 2)*pol_y(2, 3, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(4, 2)*pol_y(2, 3, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(1, 3)*pol_y(1, 3, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(2, 3)*pol_y(1, 3, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(3, 3)*pol_y(2, 3, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(4, 3)*pol_y(2, 3, jg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_x(1, 4)*pol_y(1, 3, jg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_x(2, 4)*pol_y(1, 3, jg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_x(3, 4)*pol_y(2, 3, jg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_x(4, 4)*pol_y(2, 3, jg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_x(1, 5)*pol_y(1, 3, jg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_x(2, 5)*pol_y(1, 3, jg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_x(3, 5)*pol_y(2, 3, jg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_x(4, 5)*pol_y(2, 3, jg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_x(1, 0)*pol_y(1, 4, jg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_x(2, 0)*pol_y(1, 4, jg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_x(3, 0)*pol_y(2, 4, jg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_x(4, 0)*pol_y(2, 4, jg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_x(1, 1)*pol_y(1, 4, jg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_x(2, 1)*pol_y(1, 4, jg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_x(3, 1)*pol_y(2, 4, jg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_x(4, 1)*pol_y(2, 4, jg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_x(1, 2)*pol_y(1, 4, jg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_x(2, 2)*pol_y(1, 4, jg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_x(3, 2)*pol_y(2, 4, jg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_x(4, 2)*pol_y(2, 4, jg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_x(1, 3)*pol_y(1, 4, jg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_x(2, 3)*pol_y(1, 4, jg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_x(3, 3)*pol_y(2, 4, jg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_x(4, 3)*pol_y(2, 4, jg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_x(1, 4)*pol_y(1, 4, jg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_x(2, 4)*pol_y(1, 4, jg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_x(3, 4)*pol_y(2, 4, jg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_x(4, 4)*pol_y(2, 4, jg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_x(1, 0)*pol_y(1, 5, jg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_x(2, 0)*pol_y(1, 5, jg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_x(3, 0)*pol_y(2, 5, jg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_x(4, 0)*pol_y(2, 5, jg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_x(1, 1)*pol_y(1, 5, jg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_x(2, 1)*pol_y(1, 5, jg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_x(3, 1)*pol_y(2, 5, jg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_x(4, 1)*pol_y(2, 5, jg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_x(1, 2)*pol_y(1, 5, jg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_x(2, 2)*pol_y(1, 5, jg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_x(3, 2)*pol_y(2, 5, jg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_x(4, 2)*pol_y(2, 5, jg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_x(1, 3)*pol_y(1, 5, jg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_x(2, 3)*pol_y(1, 5, jg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_x(3, 3)*pol_y(2, 5, jg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_x(4, 3)*pol_y(2, 5, jg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_x(1, 0)*pol_y(1, 6, jg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_x(2, 0)*pol_y(1, 6, jg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_x(3, 0)*pol_y(2, 6, jg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_x(4, 0)*pol_y(2, 6, jg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_x(1, 1)*pol_y(1, 6, jg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_x(2, 1)*pol_y(1, 6, jg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_x(3, 1)*pol_y(2, 6, jg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_x(4, 1)*pol_y(2, 6, jg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_x(1, 2)*pol_y(1, 6, jg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_x(2, 2)*pol_y(1, 6, jg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_x(3, 2)*pol_y(2, 6, jg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_x(4, 2)*pol_y(2, 6, jg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_x(1, 0)*pol_y(1, 7, jg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_x(2, 0)*pol_y(1, 7, jg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_x(3, 0)*pol_y(2, 7, jg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_x(4, 0)*pol_y(2, 7, jg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_x(1, 1)*pol_y(1, 7, jg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_x(2, 1)*pol_y(1, 7, jg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_x(3, 1)*pol_y(2, 7, jg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_x(4, 1)*pol_y(2, 7, jg) + coef_xy(1, 45) = coef_xy(1, 45) + coef_x(1, 0)*pol_y(1, 8, jg) + coef_xy(2, 45) = coef_xy(2, 45) + coef_x(2, 0)*pol_y(1, 8, jg) + coef_xy(1, 45) = coef_xy(1, 45) + coef_x(3, 0)*pol_y(2, 8, jg) + coef_xy(2, 45) = coef_xy(2, 45) + coef_x(4, 0)*pol_y(2, 8, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 11)*pol_z(1, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 11)*pol_z(2, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 12)*pol_z(1, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 12)*pol_z(2, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 13)*pol_z(1, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 13)*pol_z(2, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 14)*pol_z(1, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 14)*pol_z(2, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 15)*pol_z(1, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 15)*pol_z(2, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 16)*pol_z(1, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 16)*pol_z(2, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 17)*pol_z(1, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 17)*pol_z(2, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 18)*pol_z(1, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 18)*pol_z(2, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 19)*pol_z(1, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 19)*pol_z(2, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 20)*pol_z(1, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 20)*pol_z(2, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(1, 21)*pol_z(1, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(2, 21)*pol_z(2, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(1, 22)*pol_z(1, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(2, 22)*pol_z(2, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(1, 23)*pol_z(1, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(2, 23)*pol_z(2, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(1, 24)*pol_z(1, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(2, 24)*pol_z(2, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(1, 25)*pol_z(1, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(2, 25)*pol_z(2, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(1, 26)*pol_z(1, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(2, 26)*pol_z(2, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(1, 27)*pol_z(1, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(2, 27)*pol_z(2, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(1, 28)*pol_z(1, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(2, 28)*pol_z(2, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(1, 29)*pol_z(1, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(2, 29)*pol_z(2, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(1, 30)*pol_z(1, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(2, 30)*pol_z(2, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(1, 31)*pol_z(1, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(2, 31)*pol_z(2, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(1, 32)*pol_z(1, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(2, 32)*pol_z(2, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(1, 33)*pol_z(1, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(2, 33)*pol_z(2, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(1, 34)*pol_z(1, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(2, 34)*pol_z(2, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(1, 35)*pol_z(1, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(2, 35)*pol_z(2, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(1, 36)*pol_z(1, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(2, 36)*pol_z(2, 0, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(1, 37)*pol_z(1, 0, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(2, 37)*pol_z(2, 0, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(1, 38)*pol_z(1, 0, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(2, 38)*pol_z(2, 0, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(1, 39)*pol_z(1, 0, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(2, 39)*pol_z(2, 0, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(1, 40)*pol_z(1, 0, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(2, 40)*pol_z(2, 0, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(1, 41)*pol_z(1, 0, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(2, 41)*pol_z(2, 0, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(1, 42)*pol_z(1, 0, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(2, 42)*pol_z(2, 0, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(1, 43)*pol_z(1, 0, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(2, 43)*pol_z(2, 0, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(1, 44)*pol_z(1, 0, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(2, 44)*pol_z(2, 0, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(1, 45)*pol_z(1, 0, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(2, 45)*pol_z(2, 0, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(1, 5)*pol_z(1, 1, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(2, 5)*pol_z(2, 1, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(1, 7)*pol_z(1, 1, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(2, 7)*pol_z(2, 1, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(1, 8)*pol_z(1, 1, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(2, 8)*pol_z(2, 1, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(1, 10)*pol_z(1, 1, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(2, 10)*pol_z(2, 1, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(1, 11)*pol_z(1, 1, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(2, 11)*pol_z(2, 1, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(1, 12)*pol_z(1, 1, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(2, 12)*pol_z(2, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(1, 13)*pol_z(1, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(2, 13)*pol_z(2, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(1, 14)*pol_z(1, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(2, 14)*pol_z(2, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(1, 15)*pol_z(1, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(2, 15)*pol_z(2, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(1, 16)*pol_z(1, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(2, 16)*pol_z(2, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(1, 18)*pol_z(1, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(2, 18)*pol_z(2, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(1, 19)*pol_z(1, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(2, 19)*pol_z(2, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(1, 20)*pol_z(1, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(2, 20)*pol_z(2, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(1, 21)*pol_z(1, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(2, 21)*pol_z(2, 1, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(1, 22)*pol_z(1, 1, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(2, 22)*pol_z(2, 1, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(1, 23)*pol_z(1, 1, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(2, 23)*pol_z(2, 1, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(1, 25)*pol_z(1, 1, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(2, 25)*pol_z(2, 1, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(1, 26)*pol_z(1, 1, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(2, 26)*pol_z(2, 1, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(1, 27)*pol_z(1, 1, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(2, 27)*pol_z(2, 1, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(1, 28)*pol_z(1, 1, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(2, 28)*pol_z(2, 1, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(1, 29)*pol_z(1, 1, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(2, 29)*pol_z(2, 1, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(1, 31)*pol_z(1, 1, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(2, 31)*pol_z(2, 1, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(1, 32)*pol_z(1, 1, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(2, 32)*pol_z(2, 1, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(1, 33)*pol_z(1, 1, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(2, 33)*pol_z(2, 1, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(1, 34)*pol_z(1, 1, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(2, 34)*pol_z(2, 1, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(1, 36)*pol_z(1, 1, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(2, 36)*pol_z(2, 1, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(1, 37)*pol_z(1, 1, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(2, 37)*pol_z(2, 1, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(1, 38)*pol_z(1, 1, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(2, 38)*pol_z(2, 1, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(1, 40)*pol_z(1, 1, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(2, 40)*pol_z(2, 1, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(1, 41)*pol_z(1, 1, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(2, 41)*pol_z(2, 1, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(1, 43)*pol_z(1, 1, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(2, 43)*pol_z(2, 1, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(1, 3)*pol_z(1, 2, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(2, 3)*pol_z(2, 2, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(1, 4)*pol_z(1, 2, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(2, 4)*pol_z(2, 2, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(1, 5)*pol_z(1, 2, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(2, 5)*pol_z(2, 2, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(1, 6)*pol_z(1, 2, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(2, 6)*pol_z(2, 2, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(1, 7)*pol_z(1, 2, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(2, 7)*pol_z(2, 2, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(1, 10)*pol_z(1, 2, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(2, 10)*pol_z(2, 2, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(1, 11)*pol_z(1, 2, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(2, 11)*pol_z(2, 2, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(1, 12)*pol_z(1, 2, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(2, 12)*pol_z(2, 2, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(1, 13)*pol_z(1, 2, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(2, 13)*pol_z(2, 2, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(1, 14)*pol_z(1, 2, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(2, 14)*pol_z(2, 2, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(1, 15)*pol_z(1, 2, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(2, 15)*pol_z(2, 2, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(1, 18)*pol_z(1, 2, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(2, 18)*pol_z(2, 2, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(1, 19)*pol_z(1, 2, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(2, 19)*pol_z(2, 2, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(1, 20)*pol_z(1, 2, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(2, 20)*pol_z(2, 2, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(1, 21)*pol_z(1, 2, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(2, 21)*pol_z(2, 2, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(1, 22)*pol_z(1, 2, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(2, 22)*pol_z(2, 2, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(1, 25)*pol_z(1, 2, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(2, 25)*pol_z(2, 2, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(1, 26)*pol_z(1, 2, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(2, 26)*pol_z(2, 2, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(1, 27)*pol_z(1, 2, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(2, 27)*pol_z(2, 2, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(1, 28)*pol_z(1, 2, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(2, 28)*pol_z(2, 2, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(1, 31)*pol_z(1, 2, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(2, 31)*pol_z(2, 2, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(1, 32)*pol_z(1, 2, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(2, 32)*pol_z(2, 2, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(1, 33)*pol_z(1, 2, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(2, 33)*pol_z(2, 2, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(1, 36)*pol_z(1, 2, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(2, 36)*pol_z(2, 2, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(1, 37)*pol_z(1, 2, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(2, 37)*pol_z(2, 2, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(1, 40)*pol_z(1, 2, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(2, 40)*pol_z(2, 2, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(2, 1)*pol_z(2, 3, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(1, 2)*pol_z(1, 3, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(2, 2)*pol_z(2, 3, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(1, 3)*pol_z(1, 3, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(2, 3)*pol_z(2, 3, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(1, 4)*pol_z(1, 3, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(2, 4)*pol_z(2, 3, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(1, 5)*pol_z(1, 3, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(2, 5)*pol_z(2, 3, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(1, 6)*pol_z(1, 3, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(2, 6)*pol_z(2, 3, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(1, 10)*pol_z(1, 3, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(2, 10)*pol_z(2, 3, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(1, 11)*pol_z(1, 3, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(2, 11)*pol_z(2, 3, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(1, 12)*pol_z(1, 3, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(2, 12)*pol_z(2, 3, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(1, 13)*pol_z(1, 3, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(2, 13)*pol_z(2, 3, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(1, 14)*pol_z(1, 3, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(2, 14)*pol_z(2, 3, kg) - coef_xyz(121) = coef_xyz(121)+coef_xy(1, 18)*pol_z(1, 3, kg) - coef_xyz(121) = coef_xyz(121)+coef_xy(2, 18)*pol_z(2, 3, kg) - coef_xyz(122) = coef_xyz(122)+coef_xy(1, 19)*pol_z(1, 3, kg) - coef_xyz(122) = coef_xyz(122)+coef_xy(2, 19)*pol_z(2, 3, kg) - coef_xyz(123) = coef_xyz(123)+coef_xy(1, 20)*pol_z(1, 3, kg) - coef_xyz(123) = coef_xyz(123)+coef_xy(2, 20)*pol_z(2, 3, kg) - coef_xyz(124) = coef_xyz(124)+coef_xy(1, 21)*pol_z(1, 3, kg) - coef_xyz(124) = coef_xyz(124)+coef_xy(2, 21)*pol_z(2, 3, kg) - coef_xyz(125) = coef_xyz(125)+coef_xy(1, 25)*pol_z(1, 3, kg) - coef_xyz(125) = coef_xyz(125)+coef_xy(2, 25)*pol_z(2, 3, kg) - coef_xyz(126) = coef_xyz(126)+coef_xy(1, 26)*pol_z(1, 3, kg) - coef_xyz(126) = coef_xyz(126)+coef_xy(2, 26)*pol_z(2, 3, kg) - coef_xyz(127) = coef_xyz(127)+coef_xy(1, 27)*pol_z(1, 3, kg) - coef_xyz(127) = coef_xyz(127)+coef_xy(2, 27)*pol_z(2, 3, kg) - coef_xyz(128) = coef_xyz(128)+coef_xy(1, 31)*pol_z(1, 3, kg) - coef_xyz(128) = coef_xyz(128)+coef_xy(2, 31)*pol_z(2, 3, kg) - coef_xyz(129) = coef_xyz(129)+coef_xy(1, 32)*pol_z(1, 3, kg) - coef_xyz(129) = coef_xyz(129)+coef_xy(2, 32)*pol_z(2, 3, kg) - coef_xyz(130) = coef_xyz(130)+coef_xy(1, 36)*pol_z(1, 3, kg) - coef_xyz(130) = coef_xyz(130)+coef_xy(2, 36)*pol_z(2, 3, kg) - coef_xyz(131) = coef_xyz(131)+coef_xy(1, 1)*pol_z(1, 4, kg) - coef_xyz(131) = coef_xyz(131)+coef_xy(2, 1)*pol_z(2, 4, kg) - coef_xyz(132) = coef_xyz(132)+coef_xy(1, 2)*pol_z(1, 4, kg) - coef_xyz(132) = coef_xyz(132)+coef_xy(2, 2)*pol_z(2, 4, kg) - coef_xyz(133) = coef_xyz(133)+coef_xy(1, 3)*pol_z(1, 4, kg) - coef_xyz(133) = coef_xyz(133)+coef_xy(2, 3)*pol_z(2, 4, kg) - coef_xyz(134) = coef_xyz(134)+coef_xy(1, 4)*pol_z(1, 4, kg) - coef_xyz(134) = coef_xyz(134)+coef_xy(2, 4)*pol_z(2, 4, kg) - coef_xyz(135) = coef_xyz(135)+coef_xy(1, 5)*pol_z(1, 4, kg) - coef_xyz(135) = coef_xyz(135)+coef_xy(2, 5)*pol_z(2, 4, kg) - coef_xyz(136) = coef_xyz(136)+coef_xy(1, 10)*pol_z(1, 4, kg) - coef_xyz(136) = coef_xyz(136)+coef_xy(2, 10)*pol_z(2, 4, kg) - coef_xyz(137) = coef_xyz(137)+coef_xy(1, 11)*pol_z(1, 4, kg) - coef_xyz(137) = coef_xyz(137)+coef_xy(2, 11)*pol_z(2, 4, kg) - coef_xyz(138) = coef_xyz(138)+coef_xy(1, 12)*pol_z(1, 4, kg) - coef_xyz(138) = coef_xyz(138)+coef_xy(2, 12)*pol_z(2, 4, kg) - coef_xyz(139) = coef_xyz(139)+coef_xy(1, 13)*pol_z(1, 4, kg) - coef_xyz(139) = coef_xyz(139)+coef_xy(2, 13)*pol_z(2, 4, kg) - coef_xyz(140) = coef_xyz(140)+coef_xy(1, 18)*pol_z(1, 4, kg) - coef_xyz(140) = coef_xyz(140)+coef_xy(2, 18)*pol_z(2, 4, kg) - coef_xyz(141) = coef_xyz(141)+coef_xy(1, 19)*pol_z(1, 4, kg) - coef_xyz(141) = coef_xyz(141)+coef_xy(2, 19)*pol_z(2, 4, kg) - coef_xyz(142) = coef_xyz(142)+coef_xy(1, 20)*pol_z(1, 4, kg) - coef_xyz(142) = coef_xyz(142)+coef_xy(2, 20)*pol_z(2, 4, kg) - coef_xyz(143) = coef_xyz(143)+coef_xy(1, 25)*pol_z(1, 4, kg) - coef_xyz(143) = coef_xyz(143)+coef_xy(2, 25)*pol_z(2, 4, kg) - coef_xyz(144) = coef_xyz(144)+coef_xy(1, 26)*pol_z(1, 4, kg) - coef_xyz(144) = coef_xyz(144)+coef_xy(2, 26)*pol_z(2, 4, kg) - coef_xyz(145) = coef_xyz(145)+coef_xy(1, 31)*pol_z(1, 4, kg) - coef_xyz(145) = coef_xyz(145)+coef_xy(2, 31)*pol_z(2, 4, kg) - coef_xyz(146) = coef_xyz(146)+coef_xy(1, 1)*pol_z(1, 5, kg) - coef_xyz(146) = coef_xyz(146)+coef_xy(2, 1)*pol_z(2, 5, kg) - coef_xyz(147) = coef_xyz(147)+coef_xy(1, 2)*pol_z(1, 5, kg) - coef_xyz(147) = coef_xyz(147)+coef_xy(2, 2)*pol_z(2, 5, kg) - coef_xyz(148) = coef_xyz(148)+coef_xy(1, 3)*pol_z(1, 5, kg) - coef_xyz(148) = coef_xyz(148)+coef_xy(2, 3)*pol_z(2, 5, kg) - coef_xyz(149) = coef_xyz(149)+coef_xy(1, 4)*pol_z(1, 5, kg) - coef_xyz(149) = coef_xyz(149)+coef_xy(2, 4)*pol_z(2, 5, kg) - coef_xyz(150) = coef_xyz(150)+coef_xy(1, 10)*pol_z(1, 5, kg) - coef_xyz(150) = coef_xyz(150)+coef_xy(2, 10)*pol_z(2, 5, kg) - coef_xyz(151) = coef_xyz(151)+coef_xy(1, 11)*pol_z(1, 5, kg) - coef_xyz(151) = coef_xyz(151)+coef_xy(2, 11)*pol_z(2, 5, kg) - coef_xyz(152) = coef_xyz(152)+coef_xy(1, 12)*pol_z(1, 5, kg) - coef_xyz(152) = coef_xyz(152)+coef_xy(2, 12)*pol_z(2, 5, kg) - coef_xyz(153) = coef_xyz(153)+coef_xy(1, 18)*pol_z(1, 5, kg) - coef_xyz(153) = coef_xyz(153)+coef_xy(2, 18)*pol_z(2, 5, kg) - coef_xyz(154) = coef_xyz(154)+coef_xy(1, 19)*pol_z(1, 5, kg) - coef_xyz(154) = coef_xyz(154)+coef_xy(2, 19)*pol_z(2, 5, kg) - coef_xyz(155) = coef_xyz(155)+coef_xy(1, 25)*pol_z(1, 5, kg) - coef_xyz(155) = coef_xyz(155)+coef_xy(2, 25)*pol_z(2, 5, kg) - coef_xyz(156) = coef_xyz(156)+coef_xy(1, 1)*pol_z(1, 6, kg) - coef_xyz(156) = coef_xyz(156)+coef_xy(2, 1)*pol_z(2, 6, kg) - coef_xyz(157) = coef_xyz(157)+coef_xy(1, 2)*pol_z(1, 6, kg) - coef_xyz(157) = coef_xyz(157)+coef_xy(2, 2)*pol_z(2, 6, kg) - coef_xyz(158) = coef_xyz(158)+coef_xy(1, 3)*pol_z(1, 6, kg) - coef_xyz(158) = coef_xyz(158)+coef_xy(2, 3)*pol_z(2, 6, kg) - coef_xyz(159) = coef_xyz(159)+coef_xy(1, 10)*pol_z(1, 6, kg) - coef_xyz(159) = coef_xyz(159)+coef_xy(2, 10)*pol_z(2, 6, kg) - coef_xyz(160) = coef_xyz(160)+coef_xy(1, 11)*pol_z(1, 6, kg) - coef_xyz(160) = coef_xyz(160)+coef_xy(2, 11)*pol_z(2, 6, kg) - coef_xyz(161) = coef_xyz(161)+coef_xy(1, 18)*pol_z(1, 6, kg) - coef_xyz(161) = coef_xyz(161)+coef_xy(2, 18)*pol_z(2, 6, kg) - coef_xyz(162) = coef_xyz(162)+coef_xy(1, 1)*pol_z(1, 7, kg) - coef_xyz(162) = coef_xyz(162)+coef_xy(2, 1)*pol_z(2, 7, kg) - coef_xyz(163) = coef_xyz(163)+coef_xy(1, 2)*pol_z(1, 7, kg) - coef_xyz(163) = coef_xyz(163)+coef_xy(2, 2)*pol_z(2, 7, kg) - coef_xyz(164) = coef_xyz(164)+coef_xy(1, 10)*pol_z(1, 7, kg) - coef_xyz(164) = coef_xyz(164)+coef_xy(2, 10)*pol_z(2, 7, kg) - coef_xyz(165) = coef_xyz(165)+coef_xy(1, 1)*pol_z(1, 8, kg) - coef_xyz(165) = coef_xyz(165)+coef_xy(2, 1)*pol_z(2, 8, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 11)*pol_z(1, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 11)*pol_z(2, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 12)*pol_z(1, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 12)*pol_z(2, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 13)*pol_z(1, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 13)*pol_z(2, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 14)*pol_z(1, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 14)*pol_z(2, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 15)*pol_z(1, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 15)*pol_z(2, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 16)*pol_z(1, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 16)*pol_z(2, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 17)*pol_z(1, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 17)*pol_z(2, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 18)*pol_z(1, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 18)*pol_z(2, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 19)*pol_z(1, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 19)*pol_z(2, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 20)*pol_z(1, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 20)*pol_z(2, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(1, 21)*pol_z(1, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(2, 21)*pol_z(2, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(1, 22)*pol_z(1, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(2, 22)*pol_z(2, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(1, 23)*pol_z(1, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(2, 23)*pol_z(2, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(1, 24)*pol_z(1, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(2, 24)*pol_z(2, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(1, 25)*pol_z(1, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(2, 25)*pol_z(2, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(1, 26)*pol_z(1, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(2, 26)*pol_z(2, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(1, 27)*pol_z(1, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(2, 27)*pol_z(2, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(1, 28)*pol_z(1, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(2, 28)*pol_z(2, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(1, 29)*pol_z(1, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(2, 29)*pol_z(2, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(1, 30)*pol_z(1, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(2, 30)*pol_z(2, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(1, 31)*pol_z(1, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(2, 31)*pol_z(2, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(1, 32)*pol_z(1, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(2, 32)*pol_z(2, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(1, 33)*pol_z(1, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(2, 33)*pol_z(2, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(1, 34)*pol_z(1, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(2, 34)*pol_z(2, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(1, 35)*pol_z(1, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(2, 35)*pol_z(2, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(1, 36)*pol_z(1, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(2, 36)*pol_z(2, 0, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(1, 37)*pol_z(1, 0, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(2, 37)*pol_z(2, 0, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(1, 38)*pol_z(1, 0, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(2, 38)*pol_z(2, 0, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(1, 39)*pol_z(1, 0, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(2, 39)*pol_z(2, 0, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(1, 40)*pol_z(1, 0, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(2, 40)*pol_z(2, 0, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(1, 41)*pol_z(1, 0, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(2, 41)*pol_z(2, 0, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(1, 42)*pol_z(1, 0, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(2, 42)*pol_z(2, 0, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(1, 43)*pol_z(1, 0, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(2, 43)*pol_z(2, 0, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(1, 44)*pol_z(1, 0, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(2, 44)*pol_z(2, 0, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(1, 45)*pol_z(1, 0, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(2, 45)*pol_z(2, 0, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(1, 5)*pol_z(1, 1, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(2, 5)*pol_z(2, 1, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(1, 7)*pol_z(1, 1, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(2, 7)*pol_z(2, 1, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(1, 8)*pol_z(1, 1, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(2, 8)*pol_z(2, 1, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(1, 10)*pol_z(1, 1, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(2, 10)*pol_z(2, 1, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(1, 11)*pol_z(1, 1, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(2, 11)*pol_z(2, 1, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(1, 12)*pol_z(1, 1, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(2, 12)*pol_z(2, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(1, 13)*pol_z(1, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(2, 13)*pol_z(2, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(1, 14)*pol_z(1, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(2, 14)*pol_z(2, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(1, 15)*pol_z(1, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(2, 15)*pol_z(2, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(1, 16)*pol_z(1, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(2, 16)*pol_z(2, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(1, 18)*pol_z(1, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(2, 18)*pol_z(2, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(1, 19)*pol_z(1, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(2, 19)*pol_z(2, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(1, 20)*pol_z(1, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(2, 20)*pol_z(2, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(1, 21)*pol_z(1, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(2, 21)*pol_z(2, 1, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(1, 22)*pol_z(1, 1, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(2, 22)*pol_z(2, 1, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(1, 23)*pol_z(1, 1, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(2, 23)*pol_z(2, 1, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(1, 25)*pol_z(1, 1, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(2, 25)*pol_z(2, 1, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(1, 26)*pol_z(1, 1, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(2, 26)*pol_z(2, 1, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(1, 27)*pol_z(1, 1, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(2, 27)*pol_z(2, 1, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(1, 28)*pol_z(1, 1, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(2, 28)*pol_z(2, 1, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(1, 29)*pol_z(1, 1, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(2, 29)*pol_z(2, 1, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(1, 31)*pol_z(1, 1, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(2, 31)*pol_z(2, 1, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(1, 32)*pol_z(1, 1, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(2, 32)*pol_z(2, 1, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(1, 33)*pol_z(1, 1, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(2, 33)*pol_z(2, 1, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(1, 34)*pol_z(1, 1, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(2, 34)*pol_z(2, 1, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(1, 36)*pol_z(1, 1, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(2, 36)*pol_z(2, 1, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(1, 37)*pol_z(1, 1, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(2, 37)*pol_z(2, 1, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(1, 38)*pol_z(1, 1, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(2, 38)*pol_z(2, 1, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(1, 40)*pol_z(1, 1, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(2, 40)*pol_z(2, 1, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(1, 41)*pol_z(1, 1, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(2, 41)*pol_z(2, 1, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(1, 43)*pol_z(1, 1, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(2, 43)*pol_z(2, 1, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(1, 3)*pol_z(1, 2, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(2, 3)*pol_z(2, 2, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(1, 4)*pol_z(1, 2, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(2, 4)*pol_z(2, 2, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(1, 5)*pol_z(1, 2, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(2, 5)*pol_z(2, 2, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(1, 6)*pol_z(1, 2, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(2, 6)*pol_z(2, 2, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(1, 7)*pol_z(1, 2, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(2, 7)*pol_z(2, 2, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(1, 10)*pol_z(1, 2, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(2, 10)*pol_z(2, 2, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(1, 11)*pol_z(1, 2, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(2, 11)*pol_z(2, 2, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(1, 12)*pol_z(1, 2, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(2, 12)*pol_z(2, 2, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(1, 13)*pol_z(1, 2, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(2, 13)*pol_z(2, 2, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(1, 14)*pol_z(1, 2, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(2, 14)*pol_z(2, 2, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(1, 15)*pol_z(1, 2, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(2, 15)*pol_z(2, 2, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(1, 18)*pol_z(1, 2, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(2, 18)*pol_z(2, 2, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(1, 19)*pol_z(1, 2, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(2, 19)*pol_z(2, 2, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(1, 20)*pol_z(1, 2, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(2, 20)*pol_z(2, 2, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(1, 21)*pol_z(1, 2, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(2, 21)*pol_z(2, 2, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(1, 22)*pol_z(1, 2, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(2, 22)*pol_z(2, 2, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(1, 25)*pol_z(1, 2, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(2, 25)*pol_z(2, 2, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(1, 26)*pol_z(1, 2, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(2, 26)*pol_z(2, 2, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(1, 27)*pol_z(1, 2, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(2, 27)*pol_z(2, 2, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(1, 28)*pol_z(1, 2, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(2, 28)*pol_z(2, 2, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(1, 31)*pol_z(1, 2, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(2, 31)*pol_z(2, 2, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(1, 32)*pol_z(1, 2, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(2, 32)*pol_z(2, 2, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(1, 33)*pol_z(1, 2, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(2, 33)*pol_z(2, 2, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(1, 36)*pol_z(1, 2, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(2, 36)*pol_z(2, 2, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(1, 37)*pol_z(1, 2, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(2, 37)*pol_z(2, 2, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(1, 40)*pol_z(1, 2, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(2, 40)*pol_z(2, 2, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(1, 2)*pol_z(1, 3, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(2, 2)*pol_z(2, 3, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(1, 3)*pol_z(1, 3, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(2, 3)*pol_z(2, 3, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(1, 4)*pol_z(1, 3, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(2, 4)*pol_z(2, 3, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(1, 5)*pol_z(1, 3, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(2, 5)*pol_z(2, 3, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(1, 6)*pol_z(1, 3, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(2, 6)*pol_z(2, 3, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(1, 10)*pol_z(1, 3, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(2, 10)*pol_z(2, 3, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(1, 11)*pol_z(1, 3, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(2, 11)*pol_z(2, 3, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(1, 12)*pol_z(1, 3, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(2, 12)*pol_z(2, 3, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(1, 13)*pol_z(1, 3, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(2, 13)*pol_z(2, 3, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(1, 14)*pol_z(1, 3, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(2, 14)*pol_z(2, 3, kg) + coef_xyz(121) = coef_xyz(121) + coef_xy(1, 18)*pol_z(1, 3, kg) + coef_xyz(121) = coef_xyz(121) + coef_xy(2, 18)*pol_z(2, 3, kg) + coef_xyz(122) = coef_xyz(122) + coef_xy(1, 19)*pol_z(1, 3, kg) + coef_xyz(122) = coef_xyz(122) + coef_xy(2, 19)*pol_z(2, 3, kg) + coef_xyz(123) = coef_xyz(123) + coef_xy(1, 20)*pol_z(1, 3, kg) + coef_xyz(123) = coef_xyz(123) + coef_xy(2, 20)*pol_z(2, 3, kg) + coef_xyz(124) = coef_xyz(124) + coef_xy(1, 21)*pol_z(1, 3, kg) + coef_xyz(124) = coef_xyz(124) + coef_xy(2, 21)*pol_z(2, 3, kg) + coef_xyz(125) = coef_xyz(125) + coef_xy(1, 25)*pol_z(1, 3, kg) + coef_xyz(125) = coef_xyz(125) + coef_xy(2, 25)*pol_z(2, 3, kg) + coef_xyz(126) = coef_xyz(126) + coef_xy(1, 26)*pol_z(1, 3, kg) + coef_xyz(126) = coef_xyz(126) + coef_xy(2, 26)*pol_z(2, 3, kg) + coef_xyz(127) = coef_xyz(127) + coef_xy(1, 27)*pol_z(1, 3, kg) + coef_xyz(127) = coef_xyz(127) + coef_xy(2, 27)*pol_z(2, 3, kg) + coef_xyz(128) = coef_xyz(128) + coef_xy(1, 31)*pol_z(1, 3, kg) + coef_xyz(128) = coef_xyz(128) + coef_xy(2, 31)*pol_z(2, 3, kg) + coef_xyz(129) = coef_xyz(129) + coef_xy(1, 32)*pol_z(1, 3, kg) + coef_xyz(129) = coef_xyz(129) + coef_xy(2, 32)*pol_z(2, 3, kg) + coef_xyz(130) = coef_xyz(130) + coef_xy(1, 36)*pol_z(1, 3, kg) + coef_xyz(130) = coef_xyz(130) + coef_xy(2, 36)*pol_z(2, 3, kg) + coef_xyz(131) = coef_xyz(131) + coef_xy(1, 1)*pol_z(1, 4, kg) + coef_xyz(131) = coef_xyz(131) + coef_xy(2, 1)*pol_z(2, 4, kg) + coef_xyz(132) = coef_xyz(132) + coef_xy(1, 2)*pol_z(1, 4, kg) + coef_xyz(132) = coef_xyz(132) + coef_xy(2, 2)*pol_z(2, 4, kg) + coef_xyz(133) = coef_xyz(133) + coef_xy(1, 3)*pol_z(1, 4, kg) + coef_xyz(133) = coef_xyz(133) + coef_xy(2, 3)*pol_z(2, 4, kg) + coef_xyz(134) = coef_xyz(134) + coef_xy(1, 4)*pol_z(1, 4, kg) + coef_xyz(134) = coef_xyz(134) + coef_xy(2, 4)*pol_z(2, 4, kg) + coef_xyz(135) = coef_xyz(135) + coef_xy(1, 5)*pol_z(1, 4, kg) + coef_xyz(135) = coef_xyz(135) + coef_xy(2, 5)*pol_z(2, 4, kg) + coef_xyz(136) = coef_xyz(136) + coef_xy(1, 10)*pol_z(1, 4, kg) + coef_xyz(136) = coef_xyz(136) + coef_xy(2, 10)*pol_z(2, 4, kg) + coef_xyz(137) = coef_xyz(137) + coef_xy(1, 11)*pol_z(1, 4, kg) + coef_xyz(137) = coef_xyz(137) + coef_xy(2, 11)*pol_z(2, 4, kg) + coef_xyz(138) = coef_xyz(138) + coef_xy(1, 12)*pol_z(1, 4, kg) + coef_xyz(138) = coef_xyz(138) + coef_xy(2, 12)*pol_z(2, 4, kg) + coef_xyz(139) = coef_xyz(139) + coef_xy(1, 13)*pol_z(1, 4, kg) + coef_xyz(139) = coef_xyz(139) + coef_xy(2, 13)*pol_z(2, 4, kg) + coef_xyz(140) = coef_xyz(140) + coef_xy(1, 18)*pol_z(1, 4, kg) + coef_xyz(140) = coef_xyz(140) + coef_xy(2, 18)*pol_z(2, 4, kg) + coef_xyz(141) = coef_xyz(141) + coef_xy(1, 19)*pol_z(1, 4, kg) + coef_xyz(141) = coef_xyz(141) + coef_xy(2, 19)*pol_z(2, 4, kg) + coef_xyz(142) = coef_xyz(142) + coef_xy(1, 20)*pol_z(1, 4, kg) + coef_xyz(142) = coef_xyz(142) + coef_xy(2, 20)*pol_z(2, 4, kg) + coef_xyz(143) = coef_xyz(143) + coef_xy(1, 25)*pol_z(1, 4, kg) + coef_xyz(143) = coef_xyz(143) + coef_xy(2, 25)*pol_z(2, 4, kg) + coef_xyz(144) = coef_xyz(144) + coef_xy(1, 26)*pol_z(1, 4, kg) + coef_xyz(144) = coef_xyz(144) + coef_xy(2, 26)*pol_z(2, 4, kg) + coef_xyz(145) = coef_xyz(145) + coef_xy(1, 31)*pol_z(1, 4, kg) + coef_xyz(145) = coef_xyz(145) + coef_xy(2, 31)*pol_z(2, 4, kg) + coef_xyz(146) = coef_xyz(146) + coef_xy(1, 1)*pol_z(1, 5, kg) + coef_xyz(146) = coef_xyz(146) + coef_xy(2, 1)*pol_z(2, 5, kg) + coef_xyz(147) = coef_xyz(147) + coef_xy(1, 2)*pol_z(1, 5, kg) + coef_xyz(147) = coef_xyz(147) + coef_xy(2, 2)*pol_z(2, 5, kg) + coef_xyz(148) = coef_xyz(148) + coef_xy(1, 3)*pol_z(1, 5, kg) + coef_xyz(148) = coef_xyz(148) + coef_xy(2, 3)*pol_z(2, 5, kg) + coef_xyz(149) = coef_xyz(149) + coef_xy(1, 4)*pol_z(1, 5, kg) + coef_xyz(149) = coef_xyz(149) + coef_xy(2, 4)*pol_z(2, 5, kg) + coef_xyz(150) = coef_xyz(150) + coef_xy(1, 10)*pol_z(1, 5, kg) + coef_xyz(150) = coef_xyz(150) + coef_xy(2, 10)*pol_z(2, 5, kg) + coef_xyz(151) = coef_xyz(151) + coef_xy(1, 11)*pol_z(1, 5, kg) + coef_xyz(151) = coef_xyz(151) + coef_xy(2, 11)*pol_z(2, 5, kg) + coef_xyz(152) = coef_xyz(152) + coef_xy(1, 12)*pol_z(1, 5, kg) + coef_xyz(152) = coef_xyz(152) + coef_xy(2, 12)*pol_z(2, 5, kg) + coef_xyz(153) = coef_xyz(153) + coef_xy(1, 18)*pol_z(1, 5, kg) + coef_xyz(153) = coef_xyz(153) + coef_xy(2, 18)*pol_z(2, 5, kg) + coef_xyz(154) = coef_xyz(154) + coef_xy(1, 19)*pol_z(1, 5, kg) + coef_xyz(154) = coef_xyz(154) + coef_xy(2, 19)*pol_z(2, 5, kg) + coef_xyz(155) = coef_xyz(155) + coef_xy(1, 25)*pol_z(1, 5, kg) + coef_xyz(155) = coef_xyz(155) + coef_xy(2, 25)*pol_z(2, 5, kg) + coef_xyz(156) = coef_xyz(156) + coef_xy(1, 1)*pol_z(1, 6, kg) + coef_xyz(156) = coef_xyz(156) + coef_xy(2, 1)*pol_z(2, 6, kg) + coef_xyz(157) = coef_xyz(157) + coef_xy(1, 2)*pol_z(1, 6, kg) + coef_xyz(157) = coef_xyz(157) + coef_xy(2, 2)*pol_z(2, 6, kg) + coef_xyz(158) = coef_xyz(158) + coef_xy(1, 3)*pol_z(1, 6, kg) + coef_xyz(158) = coef_xyz(158) + coef_xy(2, 3)*pol_z(2, 6, kg) + coef_xyz(159) = coef_xyz(159) + coef_xy(1, 10)*pol_z(1, 6, kg) + coef_xyz(159) = coef_xyz(159) + coef_xy(2, 10)*pol_z(2, 6, kg) + coef_xyz(160) = coef_xyz(160) + coef_xy(1, 11)*pol_z(1, 6, kg) + coef_xyz(160) = coef_xyz(160) + coef_xy(2, 11)*pol_z(2, 6, kg) + coef_xyz(161) = coef_xyz(161) + coef_xy(1, 18)*pol_z(1, 6, kg) + coef_xyz(161) = coef_xyz(161) + coef_xy(2, 18)*pol_z(2, 6, kg) + coef_xyz(162) = coef_xyz(162) + coef_xy(1, 1)*pol_z(1, 7, kg) + coef_xyz(162) = coef_xyz(162) + coef_xy(2, 1)*pol_z(2, 7, kg) + coef_xyz(163) = coef_xyz(163) + coef_xy(1, 2)*pol_z(1, 7, kg) + coef_xyz(163) = coef_xyz(163) + coef_xy(2, 2)*pol_z(2, 7, kg) + coef_xyz(164) = coef_xyz(164) + coef_xy(1, 10)*pol_z(1, 7, kg) + coef_xyz(164) = coef_xyz(164) + coef_xy(2, 10)*pol_z(2, 7, kg) + coef_xyz(165) = coef_xyz(165) + coef_xy(1, 1)*pol_z(1, 8, kg) + coef_xyz(165) = coef_xyz(165) + coef_xy(2, 1)*pol_z(2, 8, kg) END DO END SUBROUTINE integrate_core_8 @@ -2379,13 +2379,13 @@ SUBROUTINE integrate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -2393,23 +2393,23 @@ SUBROUTINE integrate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -2419,673 +2419,673 @@ SUBROUTINE integrate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 2)*pol_y(1, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 2)*pol_y(1, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 2)*pol_y(2, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 2)*pol_y(2, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(1, 3)*pol_y(1, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(2, 3)*pol_y(1, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(3, 3)*pol_y(2, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(4, 3)*pol_y(2, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(1, 4)*pol_y(1, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(2, 4)*pol_y(1, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(3, 4)*pol_y(2, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(4, 4)*pol_y(2, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(1, 5)*pol_y(1, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(2, 5)*pol_y(1, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(3, 5)*pol_y(2, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(4, 5)*pol_y(2, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(1, 6)*pol_y(1, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(2, 6)*pol_y(1, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(3, 6)*pol_y(2, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(4, 6)*pol_y(2, 0, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(1, 7)*pol_y(1, 0, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(2, 7)*pol_y(1, 0, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(3, 7)*pol_y(2, 0, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(4, 7)*pol_y(2, 0, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(1, 8)*pol_y(1, 0, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(2, 8)*pol_y(1, 0, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(3, 8)*pol_y(2, 0, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(4, 8)*pol_y(2, 0, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(1, 9)*pol_y(1, 0, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(2, 9)*pol_y(1, 0, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(3, 9)*pol_y(2, 0, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(4, 9)*pol_y(2, 0, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(4, 0)*pol_y(2, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(1, 1)*pol_y(1, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(2, 1)*pol_y(1, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(3, 1)*pol_y(2, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(4, 1)*pol_y(2, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(1, 2)*pol_y(1, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(2, 2)*pol_y(1, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(3, 2)*pol_y(2, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(4, 2)*pol_y(2, 1, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(1, 3)*pol_y(1, 1, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(2, 3)*pol_y(1, 1, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(3, 3)*pol_y(2, 1, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(4, 3)*pol_y(2, 1, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(1, 4)*pol_y(1, 1, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(2, 4)*pol_y(1, 1, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(3, 4)*pol_y(2, 1, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(4, 4)*pol_y(2, 1, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(1, 5)*pol_y(1, 1, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(2, 5)*pol_y(1, 1, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(3, 5)*pol_y(2, 1, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(4, 5)*pol_y(2, 1, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(1, 6)*pol_y(1, 1, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(2, 6)*pol_y(1, 1, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(3, 6)*pol_y(2, 1, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(4, 6)*pol_y(2, 1, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(1, 7)*pol_y(1, 1, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(2, 7)*pol_y(1, 1, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(3, 7)*pol_y(2, 1, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(4, 7)*pol_y(2, 1, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(1, 8)*pol_y(1, 1, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(2, 8)*pol_y(1, 1, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(3, 8)*pol_y(2, 1, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(4, 8)*pol_y(2, 1, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(1, 0)*pol_y(1, 2, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(2, 0)*pol_y(1, 2, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(3, 0)*pol_y(2, 2, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(4, 0)*pol_y(2, 2, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(1, 1)*pol_y(1, 2, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(2, 1)*pol_y(1, 2, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(3, 1)*pol_y(2, 2, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(4, 1)*pol_y(2, 2, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(1, 2)*pol_y(1, 2, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(2, 2)*pol_y(1, 2, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(3, 2)*pol_y(2, 2, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(4, 2)*pol_y(2, 2, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(1, 3)*pol_y(1, 2, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(2, 3)*pol_y(1, 2, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(3, 3)*pol_y(2, 2, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(4, 3)*pol_y(2, 2, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(1, 4)*pol_y(1, 2, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(2, 4)*pol_y(1, 2, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(3, 4)*pol_y(2, 2, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(4, 4)*pol_y(2, 2, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(1, 5)*pol_y(1, 2, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(2, 5)*pol_y(1, 2, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(3, 5)*pol_y(2, 2, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(4, 5)*pol_y(2, 2, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(1, 6)*pol_y(1, 2, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(2, 6)*pol_y(1, 2, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(3, 6)*pol_y(2, 2, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(4, 6)*pol_y(2, 2, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(1, 7)*pol_y(1, 2, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(2, 7)*pol_y(1, 2, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(3, 7)*pol_y(2, 2, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(4, 7)*pol_y(2, 2, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(1, 0)*pol_y(1, 3, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(2, 0)*pol_y(1, 3, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(3, 0)*pol_y(2, 3, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(4, 0)*pol_y(2, 3, jg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_x(1, 1)*pol_y(1, 3, jg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_x(2, 1)*pol_y(1, 3, jg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_x(3, 1)*pol_y(2, 3, jg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_x(4, 1)*pol_y(2, 3, jg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_x(1, 2)*pol_y(1, 3, jg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_x(2, 2)*pol_y(1, 3, jg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_x(3, 2)*pol_y(2, 3, jg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_x(4, 2)*pol_y(2, 3, jg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_x(1, 3)*pol_y(1, 3, jg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_x(2, 3)*pol_y(1, 3, jg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_x(3, 3)*pol_y(2, 3, jg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_x(4, 3)*pol_y(2, 3, jg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_x(1, 4)*pol_y(1, 3, jg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_x(2, 4)*pol_y(1, 3, jg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_x(3, 4)*pol_y(2, 3, jg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_x(4, 4)*pol_y(2, 3, jg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_x(1, 5)*pol_y(1, 3, jg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_x(2, 5)*pol_y(1, 3, jg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_x(3, 5)*pol_y(2, 3, jg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_x(4, 5)*pol_y(2, 3, jg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_x(1, 6)*pol_y(1, 3, jg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_x(2, 6)*pol_y(1, 3, jg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_x(3, 6)*pol_y(2, 3, jg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_x(4, 6)*pol_y(2, 3, jg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_x(1, 0)*pol_y(1, 4, jg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_x(2, 0)*pol_y(1, 4, jg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_x(3, 0)*pol_y(2, 4, jg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_x(4, 0)*pol_y(2, 4, jg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_x(1, 1)*pol_y(1, 4, jg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_x(2, 1)*pol_y(1, 4, jg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_x(3, 1)*pol_y(2, 4, jg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_x(4, 1)*pol_y(2, 4, jg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_x(1, 2)*pol_y(1, 4, jg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_x(2, 2)*pol_y(1, 4, jg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_x(3, 2)*pol_y(2, 4, jg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_x(4, 2)*pol_y(2, 4, jg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_x(1, 3)*pol_y(1, 4, jg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_x(2, 3)*pol_y(1, 4, jg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_x(3, 3)*pol_y(2, 4, jg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_x(4, 3)*pol_y(2, 4, jg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_x(1, 4)*pol_y(1, 4, jg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_x(2, 4)*pol_y(1, 4, jg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_x(3, 4)*pol_y(2, 4, jg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_x(4, 4)*pol_y(2, 4, jg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_x(1, 5)*pol_y(1, 4, jg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_x(2, 5)*pol_y(1, 4, jg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_x(3, 5)*pol_y(2, 4, jg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_x(4, 5)*pol_y(2, 4, jg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_x(1, 0)*pol_y(1, 5, jg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_x(2, 0)*pol_y(1, 5, jg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_x(3, 0)*pol_y(2, 5, jg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_x(4, 0)*pol_y(2, 5, jg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_x(1, 1)*pol_y(1, 5, jg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_x(2, 1)*pol_y(1, 5, jg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_x(3, 1)*pol_y(2, 5, jg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_x(4, 1)*pol_y(2, 5, jg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_x(1, 2)*pol_y(1, 5, jg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_x(2, 2)*pol_y(1, 5, jg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_x(3, 2)*pol_y(2, 5, jg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_x(4, 2)*pol_y(2, 5, jg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_x(1, 3)*pol_y(1, 5, jg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_x(2, 3)*pol_y(1, 5, jg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_x(3, 3)*pol_y(2, 5, jg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_x(4, 3)*pol_y(2, 5, jg) - coef_xy(1, 45) = coef_xy(1, 45)+coef_x(1, 4)*pol_y(1, 5, jg) - coef_xy(2, 45) = coef_xy(2, 45)+coef_x(2, 4)*pol_y(1, 5, jg) - coef_xy(1, 45) = coef_xy(1, 45)+coef_x(3, 4)*pol_y(2, 5, jg) - coef_xy(2, 45) = coef_xy(2, 45)+coef_x(4, 4)*pol_y(2, 5, jg) - coef_xy(1, 46) = coef_xy(1, 46)+coef_x(1, 0)*pol_y(1, 6, jg) - coef_xy(2, 46) = coef_xy(2, 46)+coef_x(2, 0)*pol_y(1, 6, jg) - coef_xy(1, 46) = coef_xy(1, 46)+coef_x(3, 0)*pol_y(2, 6, jg) - coef_xy(2, 46) = coef_xy(2, 46)+coef_x(4, 0)*pol_y(2, 6, jg) - coef_xy(1, 47) = coef_xy(1, 47)+coef_x(1, 1)*pol_y(1, 6, jg) - coef_xy(2, 47) = coef_xy(2, 47)+coef_x(2, 1)*pol_y(1, 6, jg) - coef_xy(1, 47) = coef_xy(1, 47)+coef_x(3, 1)*pol_y(2, 6, jg) - coef_xy(2, 47) = coef_xy(2, 47)+coef_x(4, 1)*pol_y(2, 6, jg) - coef_xy(1, 48) = coef_xy(1, 48)+coef_x(1, 2)*pol_y(1, 6, jg) - coef_xy(2, 48) = coef_xy(2, 48)+coef_x(2, 2)*pol_y(1, 6, jg) - coef_xy(1, 48) = coef_xy(1, 48)+coef_x(3, 2)*pol_y(2, 6, jg) - coef_xy(2, 48) = coef_xy(2, 48)+coef_x(4, 2)*pol_y(2, 6, jg) - coef_xy(1, 49) = coef_xy(1, 49)+coef_x(1, 3)*pol_y(1, 6, jg) - coef_xy(2, 49) = coef_xy(2, 49)+coef_x(2, 3)*pol_y(1, 6, jg) - coef_xy(1, 49) = coef_xy(1, 49)+coef_x(3, 3)*pol_y(2, 6, jg) - coef_xy(2, 49) = coef_xy(2, 49)+coef_x(4, 3)*pol_y(2, 6, jg) - coef_xy(1, 50) = coef_xy(1, 50)+coef_x(1, 0)*pol_y(1, 7, jg) - coef_xy(2, 50) = coef_xy(2, 50)+coef_x(2, 0)*pol_y(1, 7, jg) - coef_xy(1, 50) = coef_xy(1, 50)+coef_x(3, 0)*pol_y(2, 7, jg) - coef_xy(2, 50) = coef_xy(2, 50)+coef_x(4, 0)*pol_y(2, 7, jg) - coef_xy(1, 51) = coef_xy(1, 51)+coef_x(1, 1)*pol_y(1, 7, jg) - coef_xy(2, 51) = coef_xy(2, 51)+coef_x(2, 1)*pol_y(1, 7, jg) - coef_xy(1, 51) = coef_xy(1, 51)+coef_x(3, 1)*pol_y(2, 7, jg) - coef_xy(2, 51) = coef_xy(2, 51)+coef_x(4, 1)*pol_y(2, 7, jg) - coef_xy(1, 52) = coef_xy(1, 52)+coef_x(1, 2)*pol_y(1, 7, jg) - coef_xy(2, 52) = coef_xy(2, 52)+coef_x(2, 2)*pol_y(1, 7, jg) - coef_xy(1, 52) = coef_xy(1, 52)+coef_x(3, 2)*pol_y(2, 7, jg) - coef_xy(2, 52) = coef_xy(2, 52)+coef_x(4, 2)*pol_y(2, 7, jg) - coef_xy(1, 53) = coef_xy(1, 53)+coef_x(1, 0)*pol_y(1, 8, jg) - coef_xy(2, 53) = coef_xy(2, 53)+coef_x(2, 0)*pol_y(1, 8, jg) - coef_xy(1, 53) = coef_xy(1, 53)+coef_x(3, 0)*pol_y(2, 8, jg) - coef_xy(2, 53) = coef_xy(2, 53)+coef_x(4, 0)*pol_y(2, 8, jg) - coef_xy(1, 54) = coef_xy(1, 54)+coef_x(1, 1)*pol_y(1, 8, jg) - coef_xy(2, 54) = coef_xy(2, 54)+coef_x(2, 1)*pol_y(1, 8, jg) - coef_xy(1, 54) = coef_xy(1, 54)+coef_x(3, 1)*pol_y(2, 8, jg) - coef_xy(2, 54) = coef_xy(2, 54)+coef_x(4, 1)*pol_y(2, 8, jg) - coef_xy(1, 55) = coef_xy(1, 55)+coef_x(1, 0)*pol_y(1, 9, jg) - coef_xy(2, 55) = coef_xy(2, 55)+coef_x(2, 0)*pol_y(1, 9, jg) - coef_xy(1, 55) = coef_xy(1, 55)+coef_x(3, 0)*pol_y(2, 9, jg) - coef_xy(2, 55) = coef_xy(2, 55)+coef_x(4, 0)*pol_y(2, 9, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 2)*pol_y(1, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 2)*pol_y(1, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 2)*pol_y(2, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 2)*pol_y(2, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(1, 3)*pol_y(1, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(2, 3)*pol_y(1, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(3, 3)*pol_y(2, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(4, 3)*pol_y(2, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(1, 4)*pol_y(1, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(2, 4)*pol_y(1, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(3, 4)*pol_y(2, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(4, 4)*pol_y(2, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(1, 5)*pol_y(1, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(2, 5)*pol_y(1, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(3, 5)*pol_y(2, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(4, 5)*pol_y(2, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(1, 6)*pol_y(1, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(2, 6)*pol_y(1, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(3, 6)*pol_y(2, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(4, 6)*pol_y(2, 0, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(1, 7)*pol_y(1, 0, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(2, 7)*pol_y(1, 0, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(3, 7)*pol_y(2, 0, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(4, 7)*pol_y(2, 0, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(1, 8)*pol_y(1, 0, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(2, 8)*pol_y(1, 0, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(3, 8)*pol_y(2, 0, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(4, 8)*pol_y(2, 0, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(1, 9)*pol_y(1, 0, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(2, 9)*pol_y(1, 0, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(3, 9)*pol_y(2, 0, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(4, 9)*pol_y(2, 0, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(1, 1)*pol_y(1, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(2, 1)*pol_y(1, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(3, 1)*pol_y(2, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(4, 1)*pol_y(2, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(1, 2)*pol_y(1, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(2, 2)*pol_y(1, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(3, 2)*pol_y(2, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(4, 2)*pol_y(2, 1, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(1, 3)*pol_y(1, 1, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(2, 3)*pol_y(1, 1, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(3, 3)*pol_y(2, 1, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(4, 3)*pol_y(2, 1, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(1, 4)*pol_y(1, 1, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(2, 4)*pol_y(1, 1, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(3, 4)*pol_y(2, 1, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(4, 4)*pol_y(2, 1, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(1, 5)*pol_y(1, 1, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(2, 5)*pol_y(1, 1, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(3, 5)*pol_y(2, 1, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(4, 5)*pol_y(2, 1, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(1, 6)*pol_y(1, 1, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(2, 6)*pol_y(1, 1, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(3, 6)*pol_y(2, 1, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(4, 6)*pol_y(2, 1, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(1, 7)*pol_y(1, 1, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(2, 7)*pol_y(1, 1, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(3, 7)*pol_y(2, 1, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(4, 7)*pol_y(2, 1, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(1, 8)*pol_y(1, 1, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(2, 8)*pol_y(1, 1, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(3, 8)*pol_y(2, 1, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(4, 8)*pol_y(2, 1, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(1, 0)*pol_y(1, 2, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(2, 0)*pol_y(1, 2, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(3, 0)*pol_y(2, 2, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(4, 0)*pol_y(2, 2, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(1, 1)*pol_y(1, 2, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(2, 1)*pol_y(1, 2, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(3, 1)*pol_y(2, 2, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(4, 1)*pol_y(2, 2, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(1, 2)*pol_y(1, 2, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(2, 2)*pol_y(1, 2, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(3, 2)*pol_y(2, 2, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(4, 2)*pol_y(2, 2, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(1, 3)*pol_y(1, 2, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(2, 3)*pol_y(1, 2, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(3, 3)*pol_y(2, 2, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(4, 3)*pol_y(2, 2, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(1, 4)*pol_y(1, 2, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(2, 4)*pol_y(1, 2, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(3, 4)*pol_y(2, 2, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(4, 4)*pol_y(2, 2, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(1, 5)*pol_y(1, 2, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(2, 5)*pol_y(1, 2, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(3, 5)*pol_y(2, 2, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(4, 5)*pol_y(2, 2, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(1, 6)*pol_y(1, 2, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(2, 6)*pol_y(1, 2, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(3, 6)*pol_y(2, 2, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(4, 6)*pol_y(2, 2, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(1, 7)*pol_y(1, 2, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(2, 7)*pol_y(1, 2, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(3, 7)*pol_y(2, 2, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(4, 7)*pol_y(2, 2, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(1, 0)*pol_y(1, 3, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(2, 0)*pol_y(1, 3, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(3, 0)*pol_y(2, 3, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(4, 0)*pol_y(2, 3, jg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_x(1, 1)*pol_y(1, 3, jg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_x(2, 1)*pol_y(1, 3, jg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_x(3, 1)*pol_y(2, 3, jg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_x(4, 1)*pol_y(2, 3, jg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_x(1, 2)*pol_y(1, 3, jg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_x(2, 2)*pol_y(1, 3, jg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_x(3, 2)*pol_y(2, 3, jg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_x(4, 2)*pol_y(2, 3, jg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_x(1, 3)*pol_y(1, 3, jg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_x(2, 3)*pol_y(1, 3, jg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_x(3, 3)*pol_y(2, 3, jg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_x(4, 3)*pol_y(2, 3, jg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_x(1, 4)*pol_y(1, 3, jg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_x(2, 4)*pol_y(1, 3, jg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_x(3, 4)*pol_y(2, 3, jg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_x(4, 4)*pol_y(2, 3, jg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_x(1, 5)*pol_y(1, 3, jg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_x(2, 5)*pol_y(1, 3, jg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_x(3, 5)*pol_y(2, 3, jg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_x(4, 5)*pol_y(2, 3, jg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_x(1, 6)*pol_y(1, 3, jg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_x(2, 6)*pol_y(1, 3, jg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_x(3, 6)*pol_y(2, 3, jg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_x(4, 6)*pol_y(2, 3, jg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_x(1, 0)*pol_y(1, 4, jg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_x(2, 0)*pol_y(1, 4, jg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_x(3, 0)*pol_y(2, 4, jg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_x(4, 0)*pol_y(2, 4, jg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_x(1, 1)*pol_y(1, 4, jg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_x(2, 1)*pol_y(1, 4, jg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_x(3, 1)*pol_y(2, 4, jg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_x(4, 1)*pol_y(2, 4, jg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_x(1, 2)*pol_y(1, 4, jg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_x(2, 2)*pol_y(1, 4, jg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_x(3, 2)*pol_y(2, 4, jg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_x(4, 2)*pol_y(2, 4, jg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_x(1, 3)*pol_y(1, 4, jg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_x(2, 3)*pol_y(1, 4, jg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_x(3, 3)*pol_y(2, 4, jg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_x(4, 3)*pol_y(2, 4, jg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_x(1, 4)*pol_y(1, 4, jg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_x(2, 4)*pol_y(1, 4, jg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_x(3, 4)*pol_y(2, 4, jg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_x(4, 4)*pol_y(2, 4, jg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_x(1, 5)*pol_y(1, 4, jg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_x(2, 5)*pol_y(1, 4, jg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_x(3, 5)*pol_y(2, 4, jg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_x(4, 5)*pol_y(2, 4, jg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_x(1, 0)*pol_y(1, 5, jg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_x(2, 0)*pol_y(1, 5, jg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_x(3, 0)*pol_y(2, 5, jg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_x(4, 0)*pol_y(2, 5, jg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_x(1, 1)*pol_y(1, 5, jg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_x(2, 1)*pol_y(1, 5, jg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_x(3, 1)*pol_y(2, 5, jg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_x(4, 1)*pol_y(2, 5, jg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_x(1, 2)*pol_y(1, 5, jg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_x(2, 2)*pol_y(1, 5, jg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_x(3, 2)*pol_y(2, 5, jg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_x(4, 2)*pol_y(2, 5, jg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_x(1, 3)*pol_y(1, 5, jg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_x(2, 3)*pol_y(1, 5, jg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_x(3, 3)*pol_y(2, 5, jg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_x(4, 3)*pol_y(2, 5, jg) + coef_xy(1, 45) = coef_xy(1, 45) + coef_x(1, 4)*pol_y(1, 5, jg) + coef_xy(2, 45) = coef_xy(2, 45) + coef_x(2, 4)*pol_y(1, 5, jg) + coef_xy(1, 45) = coef_xy(1, 45) + coef_x(3, 4)*pol_y(2, 5, jg) + coef_xy(2, 45) = coef_xy(2, 45) + coef_x(4, 4)*pol_y(2, 5, jg) + coef_xy(1, 46) = coef_xy(1, 46) + coef_x(1, 0)*pol_y(1, 6, jg) + coef_xy(2, 46) = coef_xy(2, 46) + coef_x(2, 0)*pol_y(1, 6, jg) + coef_xy(1, 46) = coef_xy(1, 46) + coef_x(3, 0)*pol_y(2, 6, jg) + coef_xy(2, 46) = coef_xy(2, 46) + coef_x(4, 0)*pol_y(2, 6, jg) + coef_xy(1, 47) = coef_xy(1, 47) + coef_x(1, 1)*pol_y(1, 6, jg) + coef_xy(2, 47) = coef_xy(2, 47) + coef_x(2, 1)*pol_y(1, 6, jg) + coef_xy(1, 47) = coef_xy(1, 47) + coef_x(3, 1)*pol_y(2, 6, jg) + coef_xy(2, 47) = coef_xy(2, 47) + coef_x(4, 1)*pol_y(2, 6, jg) + coef_xy(1, 48) = coef_xy(1, 48) + coef_x(1, 2)*pol_y(1, 6, jg) + coef_xy(2, 48) = coef_xy(2, 48) + coef_x(2, 2)*pol_y(1, 6, jg) + coef_xy(1, 48) = coef_xy(1, 48) + coef_x(3, 2)*pol_y(2, 6, jg) + coef_xy(2, 48) = coef_xy(2, 48) + coef_x(4, 2)*pol_y(2, 6, jg) + coef_xy(1, 49) = coef_xy(1, 49) + coef_x(1, 3)*pol_y(1, 6, jg) + coef_xy(2, 49) = coef_xy(2, 49) + coef_x(2, 3)*pol_y(1, 6, jg) + coef_xy(1, 49) = coef_xy(1, 49) + coef_x(3, 3)*pol_y(2, 6, jg) + coef_xy(2, 49) = coef_xy(2, 49) + coef_x(4, 3)*pol_y(2, 6, jg) + coef_xy(1, 50) = coef_xy(1, 50) + coef_x(1, 0)*pol_y(1, 7, jg) + coef_xy(2, 50) = coef_xy(2, 50) + coef_x(2, 0)*pol_y(1, 7, jg) + coef_xy(1, 50) = coef_xy(1, 50) + coef_x(3, 0)*pol_y(2, 7, jg) + coef_xy(2, 50) = coef_xy(2, 50) + coef_x(4, 0)*pol_y(2, 7, jg) + coef_xy(1, 51) = coef_xy(1, 51) + coef_x(1, 1)*pol_y(1, 7, jg) + coef_xy(2, 51) = coef_xy(2, 51) + coef_x(2, 1)*pol_y(1, 7, jg) + coef_xy(1, 51) = coef_xy(1, 51) + coef_x(3, 1)*pol_y(2, 7, jg) + coef_xy(2, 51) = coef_xy(2, 51) + coef_x(4, 1)*pol_y(2, 7, jg) + coef_xy(1, 52) = coef_xy(1, 52) + coef_x(1, 2)*pol_y(1, 7, jg) + coef_xy(2, 52) = coef_xy(2, 52) + coef_x(2, 2)*pol_y(1, 7, jg) + coef_xy(1, 52) = coef_xy(1, 52) + coef_x(3, 2)*pol_y(2, 7, jg) + coef_xy(2, 52) = coef_xy(2, 52) + coef_x(4, 2)*pol_y(2, 7, jg) + coef_xy(1, 53) = coef_xy(1, 53) + coef_x(1, 0)*pol_y(1, 8, jg) + coef_xy(2, 53) = coef_xy(2, 53) + coef_x(2, 0)*pol_y(1, 8, jg) + coef_xy(1, 53) = coef_xy(1, 53) + coef_x(3, 0)*pol_y(2, 8, jg) + coef_xy(2, 53) = coef_xy(2, 53) + coef_x(4, 0)*pol_y(2, 8, jg) + coef_xy(1, 54) = coef_xy(1, 54) + coef_x(1, 1)*pol_y(1, 8, jg) + coef_xy(2, 54) = coef_xy(2, 54) + coef_x(2, 1)*pol_y(1, 8, jg) + coef_xy(1, 54) = coef_xy(1, 54) + coef_x(3, 1)*pol_y(2, 8, jg) + coef_xy(2, 54) = coef_xy(2, 54) + coef_x(4, 1)*pol_y(2, 8, jg) + coef_xy(1, 55) = coef_xy(1, 55) + coef_x(1, 0)*pol_y(1, 9, jg) + coef_xy(2, 55) = coef_xy(2, 55) + coef_x(2, 0)*pol_y(1, 9, jg) + coef_xy(1, 55) = coef_xy(1, 55) + coef_x(3, 0)*pol_y(2, 9, jg) + coef_xy(2, 55) = coef_xy(2, 55) + coef_x(4, 0)*pol_y(2, 9, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 11)*pol_z(1, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 11)*pol_z(2, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 12)*pol_z(1, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 12)*pol_z(2, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 13)*pol_z(1, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 13)*pol_z(2, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 14)*pol_z(1, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 14)*pol_z(2, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 15)*pol_z(1, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 15)*pol_z(2, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 16)*pol_z(1, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 16)*pol_z(2, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 17)*pol_z(1, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 17)*pol_z(2, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 18)*pol_z(1, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 18)*pol_z(2, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 19)*pol_z(1, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 19)*pol_z(2, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 20)*pol_z(1, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 20)*pol_z(2, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(1, 21)*pol_z(1, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(2, 21)*pol_z(2, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(1, 22)*pol_z(1, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(2, 22)*pol_z(2, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(1, 23)*pol_z(1, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(2, 23)*pol_z(2, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(1, 24)*pol_z(1, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(2, 24)*pol_z(2, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(1, 25)*pol_z(1, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(2, 25)*pol_z(2, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(1, 26)*pol_z(1, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(2, 26)*pol_z(2, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(1, 27)*pol_z(1, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(2, 27)*pol_z(2, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(1, 28)*pol_z(1, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(2, 28)*pol_z(2, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(1, 29)*pol_z(1, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(2, 29)*pol_z(2, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(1, 30)*pol_z(1, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(2, 30)*pol_z(2, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(1, 31)*pol_z(1, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(2, 31)*pol_z(2, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(1, 32)*pol_z(1, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(2, 32)*pol_z(2, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(1, 33)*pol_z(1, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(2, 33)*pol_z(2, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(1, 34)*pol_z(1, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(2, 34)*pol_z(2, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(1, 35)*pol_z(1, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(2, 35)*pol_z(2, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(1, 36)*pol_z(1, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(2, 36)*pol_z(2, 0, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(1, 37)*pol_z(1, 0, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(2, 37)*pol_z(2, 0, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(1, 38)*pol_z(1, 0, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(2, 38)*pol_z(2, 0, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(1, 39)*pol_z(1, 0, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(2, 39)*pol_z(2, 0, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(1, 40)*pol_z(1, 0, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(2, 40)*pol_z(2, 0, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(1, 41)*pol_z(1, 0, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(2, 41)*pol_z(2, 0, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(1, 42)*pol_z(1, 0, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(2, 42)*pol_z(2, 0, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(1, 43)*pol_z(1, 0, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(2, 43)*pol_z(2, 0, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(1, 44)*pol_z(1, 0, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(2, 44)*pol_z(2, 0, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(1, 45)*pol_z(1, 0, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(2, 45)*pol_z(2, 0, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(1, 46)*pol_z(1, 0, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(2, 46)*pol_z(2, 0, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(1, 47)*pol_z(1, 0, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(2, 47)*pol_z(2, 0, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(1, 48)*pol_z(1, 0, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(2, 48)*pol_z(2, 0, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(1, 49)*pol_z(1, 0, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(2, 49)*pol_z(2, 0, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(1, 50)*pol_z(1, 0, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(2, 50)*pol_z(2, 0, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(1, 51)*pol_z(1, 0, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(2, 51)*pol_z(2, 0, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(1, 52)*pol_z(1, 0, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(2, 52)*pol_z(2, 0, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(1, 53)*pol_z(1, 0, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(2, 53)*pol_z(2, 0, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(1, 54)*pol_z(1, 0, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(2, 54)*pol_z(2, 0, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(1, 55)*pol_z(1, 0, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(2, 55)*pol_z(2, 0, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(1, 5)*pol_z(1, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(2, 5)*pol_z(2, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(1, 7)*pol_z(1, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(2, 7)*pol_z(2, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(1, 8)*pol_z(1, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(2, 8)*pol_z(2, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(1, 9)*pol_z(1, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(2, 9)*pol_z(2, 1, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(1, 11)*pol_z(1, 1, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(2, 11)*pol_z(2, 1, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(1, 12)*pol_z(1, 1, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(2, 12)*pol_z(2, 1, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(1, 13)*pol_z(1, 1, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(2, 13)*pol_z(2, 1, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(1, 14)*pol_z(1, 1, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(2, 14)*pol_z(2, 1, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(1, 15)*pol_z(1, 1, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(2, 15)*pol_z(2, 1, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(1, 16)*pol_z(1, 1, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(2, 16)*pol_z(2, 1, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(1, 17)*pol_z(1, 1, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(2, 17)*pol_z(2, 1, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(1, 18)*pol_z(1, 1, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(2, 18)*pol_z(2, 1, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(1, 20)*pol_z(1, 1, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(2, 20)*pol_z(2, 1, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(1, 21)*pol_z(1, 1, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(2, 21)*pol_z(2, 1, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(1, 22)*pol_z(1, 1, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(2, 22)*pol_z(2, 1, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(1, 23)*pol_z(1, 1, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(2, 23)*pol_z(2, 1, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(1, 24)*pol_z(1, 1, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(2, 24)*pol_z(2, 1, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(1, 25)*pol_z(1, 1, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(2, 25)*pol_z(2, 1, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(1, 26)*pol_z(1, 1, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(2, 26)*pol_z(2, 1, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(1, 28)*pol_z(1, 1, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(2, 28)*pol_z(2, 1, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(1, 29)*pol_z(1, 1, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(2, 29)*pol_z(2, 1, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(1, 30)*pol_z(1, 1, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(2, 30)*pol_z(2, 1, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(1, 31)*pol_z(1, 1, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(2, 31)*pol_z(2, 1, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(1, 32)*pol_z(1, 1, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(2, 32)*pol_z(2, 1, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(1, 33)*pol_z(1, 1, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(2, 33)*pol_z(2, 1, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(1, 35)*pol_z(1, 1, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(2, 35)*pol_z(2, 1, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(1, 36)*pol_z(1, 1, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(2, 36)*pol_z(2, 1, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(1, 37)*pol_z(1, 1, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(2, 37)*pol_z(2, 1, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(1, 38)*pol_z(1, 1, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(2, 38)*pol_z(2, 1, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(1, 39)*pol_z(1, 1, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(2, 39)*pol_z(2, 1, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(1, 41)*pol_z(1, 1, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(2, 41)*pol_z(2, 1, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(1, 42)*pol_z(1, 1, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(2, 42)*pol_z(2, 1, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(1, 43)*pol_z(1, 1, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(2, 43)*pol_z(2, 1, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(1, 44)*pol_z(1, 1, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(2, 44)*pol_z(2, 1, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(1, 46)*pol_z(1, 1, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(2, 46)*pol_z(2, 1, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(1, 47)*pol_z(1, 1, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(2, 47)*pol_z(2, 1, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(1, 48)*pol_z(1, 1, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(2, 48)*pol_z(2, 1, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(1, 50)*pol_z(1, 1, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(2, 50)*pol_z(2, 1, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(1, 51)*pol_z(1, 1, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(2, 51)*pol_z(2, 1, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(1, 53)*pol_z(1, 1, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(2, 53)*pol_z(2, 1, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(1, 3)*pol_z(1, 2, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(2, 3)*pol_z(2, 2, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(1, 4)*pol_z(1, 2, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(2, 4)*pol_z(2, 2, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(1, 5)*pol_z(1, 2, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(2, 5)*pol_z(2, 2, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(1, 6)*pol_z(1, 2, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(2, 6)*pol_z(2, 2, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(1, 7)*pol_z(1, 2, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(2, 7)*pol_z(2, 2, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(1, 8)*pol_z(1, 2, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(2, 8)*pol_z(2, 2, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(1, 11)*pol_z(1, 2, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(2, 11)*pol_z(2, 2, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(1, 12)*pol_z(1, 2, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(2, 12)*pol_z(2, 2, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(1, 13)*pol_z(1, 2, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(2, 13)*pol_z(2, 2, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(1, 14)*pol_z(1, 2, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(2, 14)*pol_z(2, 2, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(1, 15)*pol_z(1, 2, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(2, 15)*pol_z(2, 2, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(1, 16)*pol_z(1, 2, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(2, 16)*pol_z(2, 2, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(1, 17)*pol_z(1, 2, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(2, 17)*pol_z(2, 2, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(1, 20)*pol_z(1, 2, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(2, 20)*pol_z(2, 2, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(1, 21)*pol_z(1, 2, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(2, 21)*pol_z(2, 2, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(1, 22)*pol_z(1, 2, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(2, 22)*pol_z(2, 2, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(1, 23)*pol_z(1, 2, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(2, 23)*pol_z(2, 2, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(1, 24)*pol_z(1, 2, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(2, 24)*pol_z(2, 2, kg) - coef_xyz(121) = coef_xyz(121)+coef_xy(1, 25)*pol_z(1, 2, kg) - coef_xyz(121) = coef_xyz(121)+coef_xy(2, 25)*pol_z(2, 2, kg) - coef_xyz(122) = coef_xyz(122)+coef_xy(1, 28)*pol_z(1, 2, kg) - coef_xyz(122) = coef_xyz(122)+coef_xy(2, 28)*pol_z(2, 2, kg) - coef_xyz(123) = coef_xyz(123)+coef_xy(1, 29)*pol_z(1, 2, kg) - coef_xyz(123) = coef_xyz(123)+coef_xy(2, 29)*pol_z(2, 2, kg) - coef_xyz(124) = coef_xyz(124)+coef_xy(1, 30)*pol_z(1, 2, kg) - coef_xyz(124) = coef_xyz(124)+coef_xy(2, 30)*pol_z(2, 2, kg) - coef_xyz(125) = coef_xyz(125)+coef_xy(1, 31)*pol_z(1, 2, kg) - coef_xyz(125) = coef_xyz(125)+coef_xy(2, 31)*pol_z(2, 2, kg) - coef_xyz(126) = coef_xyz(126)+coef_xy(1, 32)*pol_z(1, 2, kg) - coef_xyz(126) = coef_xyz(126)+coef_xy(2, 32)*pol_z(2, 2, kg) - coef_xyz(127) = coef_xyz(127)+coef_xy(1, 35)*pol_z(1, 2, kg) - coef_xyz(127) = coef_xyz(127)+coef_xy(2, 35)*pol_z(2, 2, kg) - coef_xyz(128) = coef_xyz(128)+coef_xy(1, 36)*pol_z(1, 2, kg) - coef_xyz(128) = coef_xyz(128)+coef_xy(2, 36)*pol_z(2, 2, kg) - coef_xyz(129) = coef_xyz(129)+coef_xy(1, 37)*pol_z(1, 2, kg) - coef_xyz(129) = coef_xyz(129)+coef_xy(2, 37)*pol_z(2, 2, kg) - coef_xyz(130) = coef_xyz(130)+coef_xy(1, 38)*pol_z(1, 2, kg) - coef_xyz(130) = coef_xyz(130)+coef_xy(2, 38)*pol_z(2, 2, kg) - coef_xyz(131) = coef_xyz(131)+coef_xy(1, 41)*pol_z(1, 2, kg) - coef_xyz(131) = coef_xyz(131)+coef_xy(2, 41)*pol_z(2, 2, kg) - coef_xyz(132) = coef_xyz(132)+coef_xy(1, 42)*pol_z(1, 2, kg) - coef_xyz(132) = coef_xyz(132)+coef_xy(2, 42)*pol_z(2, 2, kg) - coef_xyz(133) = coef_xyz(133)+coef_xy(1, 43)*pol_z(1, 2, kg) - coef_xyz(133) = coef_xyz(133)+coef_xy(2, 43)*pol_z(2, 2, kg) - coef_xyz(134) = coef_xyz(134)+coef_xy(1, 46)*pol_z(1, 2, kg) - coef_xyz(134) = coef_xyz(134)+coef_xy(2, 46)*pol_z(2, 2, kg) - coef_xyz(135) = coef_xyz(135)+coef_xy(1, 47)*pol_z(1, 2, kg) - coef_xyz(135) = coef_xyz(135)+coef_xy(2, 47)*pol_z(2, 2, kg) - coef_xyz(136) = coef_xyz(136)+coef_xy(1, 50)*pol_z(1, 2, kg) - coef_xyz(136) = coef_xyz(136)+coef_xy(2, 50)*pol_z(2, 2, kg) - coef_xyz(137) = coef_xyz(137)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(137) = coef_xyz(137)+coef_xy(2, 1)*pol_z(2, 3, kg) - coef_xyz(138) = coef_xyz(138)+coef_xy(1, 2)*pol_z(1, 3, kg) - coef_xyz(138) = coef_xyz(138)+coef_xy(2, 2)*pol_z(2, 3, kg) - coef_xyz(139) = coef_xyz(139)+coef_xy(1, 3)*pol_z(1, 3, kg) - coef_xyz(139) = coef_xyz(139)+coef_xy(2, 3)*pol_z(2, 3, kg) - coef_xyz(140) = coef_xyz(140)+coef_xy(1, 4)*pol_z(1, 3, kg) - coef_xyz(140) = coef_xyz(140)+coef_xy(2, 4)*pol_z(2, 3, kg) - coef_xyz(141) = coef_xyz(141)+coef_xy(1, 5)*pol_z(1, 3, kg) - coef_xyz(141) = coef_xyz(141)+coef_xy(2, 5)*pol_z(2, 3, kg) - coef_xyz(142) = coef_xyz(142)+coef_xy(1, 6)*pol_z(1, 3, kg) - coef_xyz(142) = coef_xyz(142)+coef_xy(2, 6)*pol_z(2, 3, kg) - coef_xyz(143) = coef_xyz(143)+coef_xy(1, 7)*pol_z(1, 3, kg) - coef_xyz(143) = coef_xyz(143)+coef_xy(2, 7)*pol_z(2, 3, kg) - coef_xyz(144) = coef_xyz(144)+coef_xy(1, 11)*pol_z(1, 3, kg) - coef_xyz(144) = coef_xyz(144)+coef_xy(2, 11)*pol_z(2, 3, kg) - coef_xyz(145) = coef_xyz(145)+coef_xy(1, 12)*pol_z(1, 3, kg) - coef_xyz(145) = coef_xyz(145)+coef_xy(2, 12)*pol_z(2, 3, kg) - coef_xyz(146) = coef_xyz(146)+coef_xy(1, 13)*pol_z(1, 3, kg) - coef_xyz(146) = coef_xyz(146)+coef_xy(2, 13)*pol_z(2, 3, kg) - coef_xyz(147) = coef_xyz(147)+coef_xy(1, 14)*pol_z(1, 3, kg) - coef_xyz(147) = coef_xyz(147)+coef_xy(2, 14)*pol_z(2, 3, kg) - coef_xyz(148) = coef_xyz(148)+coef_xy(1, 15)*pol_z(1, 3, kg) - coef_xyz(148) = coef_xyz(148)+coef_xy(2, 15)*pol_z(2, 3, kg) - coef_xyz(149) = coef_xyz(149)+coef_xy(1, 16)*pol_z(1, 3, kg) - coef_xyz(149) = coef_xyz(149)+coef_xy(2, 16)*pol_z(2, 3, kg) - coef_xyz(150) = coef_xyz(150)+coef_xy(1, 20)*pol_z(1, 3, kg) - coef_xyz(150) = coef_xyz(150)+coef_xy(2, 20)*pol_z(2, 3, kg) - coef_xyz(151) = coef_xyz(151)+coef_xy(1, 21)*pol_z(1, 3, kg) - coef_xyz(151) = coef_xyz(151)+coef_xy(2, 21)*pol_z(2, 3, kg) - coef_xyz(152) = coef_xyz(152)+coef_xy(1, 22)*pol_z(1, 3, kg) - coef_xyz(152) = coef_xyz(152)+coef_xy(2, 22)*pol_z(2, 3, kg) - coef_xyz(153) = coef_xyz(153)+coef_xy(1, 23)*pol_z(1, 3, kg) - coef_xyz(153) = coef_xyz(153)+coef_xy(2, 23)*pol_z(2, 3, kg) - coef_xyz(154) = coef_xyz(154)+coef_xy(1, 24)*pol_z(1, 3, kg) - coef_xyz(154) = coef_xyz(154)+coef_xy(2, 24)*pol_z(2, 3, kg) - coef_xyz(155) = coef_xyz(155)+coef_xy(1, 28)*pol_z(1, 3, kg) - coef_xyz(155) = coef_xyz(155)+coef_xy(2, 28)*pol_z(2, 3, kg) - coef_xyz(156) = coef_xyz(156)+coef_xy(1, 29)*pol_z(1, 3, kg) - coef_xyz(156) = coef_xyz(156)+coef_xy(2, 29)*pol_z(2, 3, kg) - coef_xyz(157) = coef_xyz(157)+coef_xy(1, 30)*pol_z(1, 3, kg) - coef_xyz(157) = coef_xyz(157)+coef_xy(2, 30)*pol_z(2, 3, kg) - coef_xyz(158) = coef_xyz(158)+coef_xy(1, 31)*pol_z(1, 3, kg) - coef_xyz(158) = coef_xyz(158)+coef_xy(2, 31)*pol_z(2, 3, kg) - coef_xyz(159) = coef_xyz(159)+coef_xy(1, 35)*pol_z(1, 3, kg) - coef_xyz(159) = coef_xyz(159)+coef_xy(2, 35)*pol_z(2, 3, kg) - coef_xyz(160) = coef_xyz(160)+coef_xy(1, 36)*pol_z(1, 3, kg) - coef_xyz(160) = coef_xyz(160)+coef_xy(2, 36)*pol_z(2, 3, kg) - coef_xyz(161) = coef_xyz(161)+coef_xy(1, 37)*pol_z(1, 3, kg) - coef_xyz(161) = coef_xyz(161)+coef_xy(2, 37)*pol_z(2, 3, kg) - coef_xyz(162) = coef_xyz(162)+coef_xy(1, 41)*pol_z(1, 3, kg) - coef_xyz(162) = coef_xyz(162)+coef_xy(2, 41)*pol_z(2, 3, kg) - coef_xyz(163) = coef_xyz(163)+coef_xy(1, 42)*pol_z(1, 3, kg) - coef_xyz(163) = coef_xyz(163)+coef_xy(2, 42)*pol_z(2, 3, kg) - coef_xyz(164) = coef_xyz(164)+coef_xy(1, 46)*pol_z(1, 3, kg) - coef_xyz(164) = coef_xyz(164)+coef_xy(2, 46)*pol_z(2, 3, kg) - coef_xyz(165) = coef_xyz(165)+coef_xy(1, 1)*pol_z(1, 4, kg) - coef_xyz(165) = coef_xyz(165)+coef_xy(2, 1)*pol_z(2, 4, kg) - coef_xyz(166) = coef_xyz(166)+coef_xy(1, 2)*pol_z(1, 4, kg) - coef_xyz(166) = coef_xyz(166)+coef_xy(2, 2)*pol_z(2, 4, kg) - coef_xyz(167) = coef_xyz(167)+coef_xy(1, 3)*pol_z(1, 4, kg) - coef_xyz(167) = coef_xyz(167)+coef_xy(2, 3)*pol_z(2, 4, kg) - coef_xyz(168) = coef_xyz(168)+coef_xy(1, 4)*pol_z(1, 4, kg) - coef_xyz(168) = coef_xyz(168)+coef_xy(2, 4)*pol_z(2, 4, kg) - coef_xyz(169) = coef_xyz(169)+coef_xy(1, 5)*pol_z(1, 4, kg) - coef_xyz(169) = coef_xyz(169)+coef_xy(2, 5)*pol_z(2, 4, kg) - coef_xyz(170) = coef_xyz(170)+coef_xy(1, 6)*pol_z(1, 4, kg) - coef_xyz(170) = coef_xyz(170)+coef_xy(2, 6)*pol_z(2, 4, kg) - coef_xyz(171) = coef_xyz(171)+coef_xy(1, 11)*pol_z(1, 4, kg) - coef_xyz(171) = coef_xyz(171)+coef_xy(2, 11)*pol_z(2, 4, kg) - coef_xyz(172) = coef_xyz(172)+coef_xy(1, 12)*pol_z(1, 4, kg) - coef_xyz(172) = coef_xyz(172)+coef_xy(2, 12)*pol_z(2, 4, kg) - coef_xyz(173) = coef_xyz(173)+coef_xy(1, 13)*pol_z(1, 4, kg) - coef_xyz(173) = coef_xyz(173)+coef_xy(2, 13)*pol_z(2, 4, kg) - coef_xyz(174) = coef_xyz(174)+coef_xy(1, 14)*pol_z(1, 4, kg) - coef_xyz(174) = coef_xyz(174)+coef_xy(2, 14)*pol_z(2, 4, kg) - coef_xyz(175) = coef_xyz(175)+coef_xy(1, 15)*pol_z(1, 4, kg) - coef_xyz(175) = coef_xyz(175)+coef_xy(2, 15)*pol_z(2, 4, kg) - coef_xyz(176) = coef_xyz(176)+coef_xy(1, 20)*pol_z(1, 4, kg) - coef_xyz(176) = coef_xyz(176)+coef_xy(2, 20)*pol_z(2, 4, kg) - coef_xyz(177) = coef_xyz(177)+coef_xy(1, 21)*pol_z(1, 4, kg) - coef_xyz(177) = coef_xyz(177)+coef_xy(2, 21)*pol_z(2, 4, kg) - coef_xyz(178) = coef_xyz(178)+coef_xy(1, 22)*pol_z(1, 4, kg) - coef_xyz(178) = coef_xyz(178)+coef_xy(2, 22)*pol_z(2, 4, kg) - coef_xyz(179) = coef_xyz(179)+coef_xy(1, 23)*pol_z(1, 4, kg) - coef_xyz(179) = coef_xyz(179)+coef_xy(2, 23)*pol_z(2, 4, kg) - coef_xyz(180) = coef_xyz(180)+coef_xy(1, 28)*pol_z(1, 4, kg) - coef_xyz(180) = coef_xyz(180)+coef_xy(2, 28)*pol_z(2, 4, kg) - coef_xyz(181) = coef_xyz(181)+coef_xy(1, 29)*pol_z(1, 4, kg) - coef_xyz(181) = coef_xyz(181)+coef_xy(2, 29)*pol_z(2, 4, kg) - coef_xyz(182) = coef_xyz(182)+coef_xy(1, 30)*pol_z(1, 4, kg) - coef_xyz(182) = coef_xyz(182)+coef_xy(2, 30)*pol_z(2, 4, kg) - coef_xyz(183) = coef_xyz(183)+coef_xy(1, 35)*pol_z(1, 4, kg) - coef_xyz(183) = coef_xyz(183)+coef_xy(2, 35)*pol_z(2, 4, kg) - coef_xyz(184) = coef_xyz(184)+coef_xy(1, 36)*pol_z(1, 4, kg) - coef_xyz(184) = coef_xyz(184)+coef_xy(2, 36)*pol_z(2, 4, kg) - coef_xyz(185) = coef_xyz(185)+coef_xy(1, 41)*pol_z(1, 4, kg) - coef_xyz(185) = coef_xyz(185)+coef_xy(2, 41)*pol_z(2, 4, kg) - coef_xyz(186) = coef_xyz(186)+coef_xy(1, 1)*pol_z(1, 5, kg) - coef_xyz(186) = coef_xyz(186)+coef_xy(2, 1)*pol_z(2, 5, kg) - coef_xyz(187) = coef_xyz(187)+coef_xy(1, 2)*pol_z(1, 5, kg) - coef_xyz(187) = coef_xyz(187)+coef_xy(2, 2)*pol_z(2, 5, kg) - coef_xyz(188) = coef_xyz(188)+coef_xy(1, 3)*pol_z(1, 5, kg) - coef_xyz(188) = coef_xyz(188)+coef_xy(2, 3)*pol_z(2, 5, kg) - coef_xyz(189) = coef_xyz(189)+coef_xy(1, 4)*pol_z(1, 5, kg) - coef_xyz(189) = coef_xyz(189)+coef_xy(2, 4)*pol_z(2, 5, kg) - coef_xyz(190) = coef_xyz(190)+coef_xy(1, 5)*pol_z(1, 5, kg) - coef_xyz(190) = coef_xyz(190)+coef_xy(2, 5)*pol_z(2, 5, kg) - coef_xyz(191) = coef_xyz(191)+coef_xy(1, 11)*pol_z(1, 5, kg) - coef_xyz(191) = coef_xyz(191)+coef_xy(2, 11)*pol_z(2, 5, kg) - coef_xyz(192) = coef_xyz(192)+coef_xy(1, 12)*pol_z(1, 5, kg) - coef_xyz(192) = coef_xyz(192)+coef_xy(2, 12)*pol_z(2, 5, kg) - coef_xyz(193) = coef_xyz(193)+coef_xy(1, 13)*pol_z(1, 5, kg) - coef_xyz(193) = coef_xyz(193)+coef_xy(2, 13)*pol_z(2, 5, kg) - coef_xyz(194) = coef_xyz(194)+coef_xy(1, 14)*pol_z(1, 5, kg) - coef_xyz(194) = coef_xyz(194)+coef_xy(2, 14)*pol_z(2, 5, kg) - coef_xyz(195) = coef_xyz(195)+coef_xy(1, 20)*pol_z(1, 5, kg) - coef_xyz(195) = coef_xyz(195)+coef_xy(2, 20)*pol_z(2, 5, kg) - coef_xyz(196) = coef_xyz(196)+coef_xy(1, 21)*pol_z(1, 5, kg) - coef_xyz(196) = coef_xyz(196)+coef_xy(2, 21)*pol_z(2, 5, kg) - coef_xyz(197) = coef_xyz(197)+coef_xy(1, 22)*pol_z(1, 5, kg) - coef_xyz(197) = coef_xyz(197)+coef_xy(2, 22)*pol_z(2, 5, kg) - coef_xyz(198) = coef_xyz(198)+coef_xy(1, 28)*pol_z(1, 5, kg) - coef_xyz(198) = coef_xyz(198)+coef_xy(2, 28)*pol_z(2, 5, kg) - coef_xyz(199) = coef_xyz(199)+coef_xy(1, 29)*pol_z(1, 5, kg) - coef_xyz(199) = coef_xyz(199)+coef_xy(2, 29)*pol_z(2, 5, kg) - coef_xyz(200) = coef_xyz(200)+coef_xy(1, 35)*pol_z(1, 5, kg) - coef_xyz(200) = coef_xyz(200)+coef_xy(2, 35)*pol_z(2, 5, kg) - coef_xyz(201) = coef_xyz(201)+coef_xy(1, 1)*pol_z(1, 6, kg) - coef_xyz(201) = coef_xyz(201)+coef_xy(2, 1)*pol_z(2, 6, kg) - coef_xyz(202) = coef_xyz(202)+coef_xy(1, 2)*pol_z(1, 6, kg) - coef_xyz(202) = coef_xyz(202)+coef_xy(2, 2)*pol_z(2, 6, kg) - coef_xyz(203) = coef_xyz(203)+coef_xy(1, 3)*pol_z(1, 6, kg) - coef_xyz(203) = coef_xyz(203)+coef_xy(2, 3)*pol_z(2, 6, kg) - coef_xyz(204) = coef_xyz(204)+coef_xy(1, 4)*pol_z(1, 6, kg) - coef_xyz(204) = coef_xyz(204)+coef_xy(2, 4)*pol_z(2, 6, kg) - coef_xyz(205) = coef_xyz(205)+coef_xy(1, 11)*pol_z(1, 6, kg) - coef_xyz(205) = coef_xyz(205)+coef_xy(2, 11)*pol_z(2, 6, kg) - coef_xyz(206) = coef_xyz(206)+coef_xy(1, 12)*pol_z(1, 6, kg) - coef_xyz(206) = coef_xyz(206)+coef_xy(2, 12)*pol_z(2, 6, kg) - coef_xyz(207) = coef_xyz(207)+coef_xy(1, 13)*pol_z(1, 6, kg) - coef_xyz(207) = coef_xyz(207)+coef_xy(2, 13)*pol_z(2, 6, kg) - coef_xyz(208) = coef_xyz(208)+coef_xy(1, 20)*pol_z(1, 6, kg) - coef_xyz(208) = coef_xyz(208)+coef_xy(2, 20)*pol_z(2, 6, kg) - coef_xyz(209) = coef_xyz(209)+coef_xy(1, 21)*pol_z(1, 6, kg) - coef_xyz(209) = coef_xyz(209)+coef_xy(2, 21)*pol_z(2, 6, kg) - coef_xyz(210) = coef_xyz(210)+coef_xy(1, 28)*pol_z(1, 6, kg) - coef_xyz(210) = coef_xyz(210)+coef_xy(2, 28)*pol_z(2, 6, kg) - coef_xyz(211) = coef_xyz(211)+coef_xy(1, 1)*pol_z(1, 7, kg) - coef_xyz(211) = coef_xyz(211)+coef_xy(2, 1)*pol_z(2, 7, kg) - coef_xyz(212) = coef_xyz(212)+coef_xy(1, 2)*pol_z(1, 7, kg) - coef_xyz(212) = coef_xyz(212)+coef_xy(2, 2)*pol_z(2, 7, kg) - coef_xyz(213) = coef_xyz(213)+coef_xy(1, 3)*pol_z(1, 7, kg) - coef_xyz(213) = coef_xyz(213)+coef_xy(2, 3)*pol_z(2, 7, kg) - coef_xyz(214) = coef_xyz(214)+coef_xy(1, 11)*pol_z(1, 7, kg) - coef_xyz(214) = coef_xyz(214)+coef_xy(2, 11)*pol_z(2, 7, kg) - coef_xyz(215) = coef_xyz(215)+coef_xy(1, 12)*pol_z(1, 7, kg) - coef_xyz(215) = coef_xyz(215)+coef_xy(2, 12)*pol_z(2, 7, kg) - coef_xyz(216) = coef_xyz(216)+coef_xy(1, 20)*pol_z(1, 7, kg) - coef_xyz(216) = coef_xyz(216)+coef_xy(2, 20)*pol_z(2, 7, kg) - coef_xyz(217) = coef_xyz(217)+coef_xy(1, 1)*pol_z(1, 8, kg) - coef_xyz(217) = coef_xyz(217)+coef_xy(2, 1)*pol_z(2, 8, kg) - coef_xyz(218) = coef_xyz(218)+coef_xy(1, 2)*pol_z(1, 8, kg) - coef_xyz(218) = coef_xyz(218)+coef_xy(2, 2)*pol_z(2, 8, kg) - coef_xyz(219) = coef_xyz(219)+coef_xy(1, 11)*pol_z(1, 8, kg) - coef_xyz(219) = coef_xyz(219)+coef_xy(2, 11)*pol_z(2, 8, kg) - coef_xyz(220) = coef_xyz(220)+coef_xy(1, 1)*pol_z(1, 9, kg) - coef_xyz(220) = coef_xyz(220)+coef_xy(2, 1)*pol_z(2, 9, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 11)*pol_z(1, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 11)*pol_z(2, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 12)*pol_z(1, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 12)*pol_z(2, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 13)*pol_z(1, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 13)*pol_z(2, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 14)*pol_z(1, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 14)*pol_z(2, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 15)*pol_z(1, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 15)*pol_z(2, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 16)*pol_z(1, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 16)*pol_z(2, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 17)*pol_z(1, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 17)*pol_z(2, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 18)*pol_z(1, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 18)*pol_z(2, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 19)*pol_z(1, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 19)*pol_z(2, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 20)*pol_z(1, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 20)*pol_z(2, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(1, 21)*pol_z(1, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(2, 21)*pol_z(2, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(1, 22)*pol_z(1, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(2, 22)*pol_z(2, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(1, 23)*pol_z(1, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(2, 23)*pol_z(2, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(1, 24)*pol_z(1, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(2, 24)*pol_z(2, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(1, 25)*pol_z(1, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(2, 25)*pol_z(2, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(1, 26)*pol_z(1, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(2, 26)*pol_z(2, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(1, 27)*pol_z(1, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(2, 27)*pol_z(2, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(1, 28)*pol_z(1, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(2, 28)*pol_z(2, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(1, 29)*pol_z(1, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(2, 29)*pol_z(2, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(1, 30)*pol_z(1, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(2, 30)*pol_z(2, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(1, 31)*pol_z(1, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(2, 31)*pol_z(2, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(1, 32)*pol_z(1, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(2, 32)*pol_z(2, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(1, 33)*pol_z(1, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(2, 33)*pol_z(2, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(1, 34)*pol_z(1, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(2, 34)*pol_z(2, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(1, 35)*pol_z(1, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(2, 35)*pol_z(2, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(1, 36)*pol_z(1, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(2, 36)*pol_z(2, 0, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(1, 37)*pol_z(1, 0, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(2, 37)*pol_z(2, 0, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(1, 38)*pol_z(1, 0, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(2, 38)*pol_z(2, 0, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(1, 39)*pol_z(1, 0, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(2, 39)*pol_z(2, 0, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(1, 40)*pol_z(1, 0, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(2, 40)*pol_z(2, 0, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(1, 41)*pol_z(1, 0, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(2, 41)*pol_z(2, 0, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(1, 42)*pol_z(1, 0, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(2, 42)*pol_z(2, 0, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(1, 43)*pol_z(1, 0, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(2, 43)*pol_z(2, 0, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(1, 44)*pol_z(1, 0, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(2, 44)*pol_z(2, 0, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(1, 45)*pol_z(1, 0, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(2, 45)*pol_z(2, 0, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(1, 46)*pol_z(1, 0, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(2, 46)*pol_z(2, 0, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(1, 47)*pol_z(1, 0, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(2, 47)*pol_z(2, 0, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(1, 48)*pol_z(1, 0, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(2, 48)*pol_z(2, 0, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(1, 49)*pol_z(1, 0, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(2, 49)*pol_z(2, 0, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(1, 50)*pol_z(1, 0, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(2, 50)*pol_z(2, 0, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(1, 51)*pol_z(1, 0, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(2, 51)*pol_z(2, 0, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(1, 52)*pol_z(1, 0, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(2, 52)*pol_z(2, 0, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(1, 53)*pol_z(1, 0, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(2, 53)*pol_z(2, 0, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(1, 54)*pol_z(1, 0, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(2, 54)*pol_z(2, 0, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(1, 55)*pol_z(1, 0, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(2, 55)*pol_z(2, 0, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(1, 5)*pol_z(1, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(2, 5)*pol_z(2, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(1, 7)*pol_z(1, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(2, 7)*pol_z(2, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(1, 8)*pol_z(1, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(2, 8)*pol_z(2, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(1, 9)*pol_z(1, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(2, 9)*pol_z(2, 1, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(1, 11)*pol_z(1, 1, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(2, 11)*pol_z(2, 1, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(1, 12)*pol_z(1, 1, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(2, 12)*pol_z(2, 1, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(1, 13)*pol_z(1, 1, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(2, 13)*pol_z(2, 1, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(1, 14)*pol_z(1, 1, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(2, 14)*pol_z(2, 1, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(1, 15)*pol_z(1, 1, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(2, 15)*pol_z(2, 1, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(1, 16)*pol_z(1, 1, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(2, 16)*pol_z(2, 1, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(1, 17)*pol_z(1, 1, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(2, 17)*pol_z(2, 1, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(1, 18)*pol_z(1, 1, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(2, 18)*pol_z(2, 1, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(1, 20)*pol_z(1, 1, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(2, 20)*pol_z(2, 1, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(1, 21)*pol_z(1, 1, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(2, 21)*pol_z(2, 1, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(1, 22)*pol_z(1, 1, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(2, 22)*pol_z(2, 1, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(1, 23)*pol_z(1, 1, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(2, 23)*pol_z(2, 1, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(1, 24)*pol_z(1, 1, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(2, 24)*pol_z(2, 1, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(1, 25)*pol_z(1, 1, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(2, 25)*pol_z(2, 1, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(1, 26)*pol_z(1, 1, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(2, 26)*pol_z(2, 1, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(1, 28)*pol_z(1, 1, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(2, 28)*pol_z(2, 1, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(1, 29)*pol_z(1, 1, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(2, 29)*pol_z(2, 1, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(1, 30)*pol_z(1, 1, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(2, 30)*pol_z(2, 1, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(1, 31)*pol_z(1, 1, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(2, 31)*pol_z(2, 1, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(1, 32)*pol_z(1, 1, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(2, 32)*pol_z(2, 1, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(1, 33)*pol_z(1, 1, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(2, 33)*pol_z(2, 1, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(1, 35)*pol_z(1, 1, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(2, 35)*pol_z(2, 1, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(1, 36)*pol_z(1, 1, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(2, 36)*pol_z(2, 1, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(1, 37)*pol_z(1, 1, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(2, 37)*pol_z(2, 1, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(1, 38)*pol_z(1, 1, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(2, 38)*pol_z(2, 1, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(1, 39)*pol_z(1, 1, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(2, 39)*pol_z(2, 1, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(1, 41)*pol_z(1, 1, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(2, 41)*pol_z(2, 1, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(1, 42)*pol_z(1, 1, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(2, 42)*pol_z(2, 1, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(1, 43)*pol_z(1, 1, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(2, 43)*pol_z(2, 1, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(1, 44)*pol_z(1, 1, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(2, 44)*pol_z(2, 1, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(1, 46)*pol_z(1, 1, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(2, 46)*pol_z(2, 1, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(1, 47)*pol_z(1, 1, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(2, 47)*pol_z(2, 1, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(1, 48)*pol_z(1, 1, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(2, 48)*pol_z(2, 1, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(1, 50)*pol_z(1, 1, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(2, 50)*pol_z(2, 1, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(1, 51)*pol_z(1, 1, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(2, 51)*pol_z(2, 1, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(1, 53)*pol_z(1, 1, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(2, 53)*pol_z(2, 1, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(1, 3)*pol_z(1, 2, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(2, 3)*pol_z(2, 2, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(1, 4)*pol_z(1, 2, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(2, 4)*pol_z(2, 2, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(1, 5)*pol_z(1, 2, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(2, 5)*pol_z(2, 2, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(1, 6)*pol_z(1, 2, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(2, 6)*pol_z(2, 2, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(1, 7)*pol_z(1, 2, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(2, 7)*pol_z(2, 2, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(1, 8)*pol_z(1, 2, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(2, 8)*pol_z(2, 2, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(1, 11)*pol_z(1, 2, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(2, 11)*pol_z(2, 2, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(1, 12)*pol_z(1, 2, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(2, 12)*pol_z(2, 2, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(1, 13)*pol_z(1, 2, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(2, 13)*pol_z(2, 2, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(1, 14)*pol_z(1, 2, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(2, 14)*pol_z(2, 2, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(1, 15)*pol_z(1, 2, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(2, 15)*pol_z(2, 2, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(1, 16)*pol_z(1, 2, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(2, 16)*pol_z(2, 2, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(1, 17)*pol_z(1, 2, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(2, 17)*pol_z(2, 2, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(1, 20)*pol_z(1, 2, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(2, 20)*pol_z(2, 2, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(1, 21)*pol_z(1, 2, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(2, 21)*pol_z(2, 2, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(1, 22)*pol_z(1, 2, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(2, 22)*pol_z(2, 2, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(1, 23)*pol_z(1, 2, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(2, 23)*pol_z(2, 2, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(1, 24)*pol_z(1, 2, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(2, 24)*pol_z(2, 2, kg) + coef_xyz(121) = coef_xyz(121) + coef_xy(1, 25)*pol_z(1, 2, kg) + coef_xyz(121) = coef_xyz(121) + coef_xy(2, 25)*pol_z(2, 2, kg) + coef_xyz(122) = coef_xyz(122) + coef_xy(1, 28)*pol_z(1, 2, kg) + coef_xyz(122) = coef_xyz(122) + coef_xy(2, 28)*pol_z(2, 2, kg) + coef_xyz(123) = coef_xyz(123) + coef_xy(1, 29)*pol_z(1, 2, kg) + coef_xyz(123) = coef_xyz(123) + coef_xy(2, 29)*pol_z(2, 2, kg) + coef_xyz(124) = coef_xyz(124) + coef_xy(1, 30)*pol_z(1, 2, kg) + coef_xyz(124) = coef_xyz(124) + coef_xy(2, 30)*pol_z(2, 2, kg) + coef_xyz(125) = coef_xyz(125) + coef_xy(1, 31)*pol_z(1, 2, kg) + coef_xyz(125) = coef_xyz(125) + coef_xy(2, 31)*pol_z(2, 2, kg) + coef_xyz(126) = coef_xyz(126) + coef_xy(1, 32)*pol_z(1, 2, kg) + coef_xyz(126) = coef_xyz(126) + coef_xy(2, 32)*pol_z(2, 2, kg) + coef_xyz(127) = coef_xyz(127) + coef_xy(1, 35)*pol_z(1, 2, kg) + coef_xyz(127) = coef_xyz(127) + coef_xy(2, 35)*pol_z(2, 2, kg) + coef_xyz(128) = coef_xyz(128) + coef_xy(1, 36)*pol_z(1, 2, kg) + coef_xyz(128) = coef_xyz(128) + coef_xy(2, 36)*pol_z(2, 2, kg) + coef_xyz(129) = coef_xyz(129) + coef_xy(1, 37)*pol_z(1, 2, kg) + coef_xyz(129) = coef_xyz(129) + coef_xy(2, 37)*pol_z(2, 2, kg) + coef_xyz(130) = coef_xyz(130) + coef_xy(1, 38)*pol_z(1, 2, kg) + coef_xyz(130) = coef_xyz(130) + coef_xy(2, 38)*pol_z(2, 2, kg) + coef_xyz(131) = coef_xyz(131) + coef_xy(1, 41)*pol_z(1, 2, kg) + coef_xyz(131) = coef_xyz(131) + coef_xy(2, 41)*pol_z(2, 2, kg) + coef_xyz(132) = coef_xyz(132) + coef_xy(1, 42)*pol_z(1, 2, kg) + coef_xyz(132) = coef_xyz(132) + coef_xy(2, 42)*pol_z(2, 2, kg) + coef_xyz(133) = coef_xyz(133) + coef_xy(1, 43)*pol_z(1, 2, kg) + coef_xyz(133) = coef_xyz(133) + coef_xy(2, 43)*pol_z(2, 2, kg) + coef_xyz(134) = coef_xyz(134) + coef_xy(1, 46)*pol_z(1, 2, kg) + coef_xyz(134) = coef_xyz(134) + coef_xy(2, 46)*pol_z(2, 2, kg) + coef_xyz(135) = coef_xyz(135) + coef_xy(1, 47)*pol_z(1, 2, kg) + coef_xyz(135) = coef_xyz(135) + coef_xy(2, 47)*pol_z(2, 2, kg) + coef_xyz(136) = coef_xyz(136) + coef_xy(1, 50)*pol_z(1, 2, kg) + coef_xyz(136) = coef_xyz(136) + coef_xy(2, 50)*pol_z(2, 2, kg) + coef_xyz(137) = coef_xyz(137) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(137) = coef_xyz(137) + coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(138) = coef_xyz(138) + coef_xy(1, 2)*pol_z(1, 3, kg) + coef_xyz(138) = coef_xyz(138) + coef_xy(2, 2)*pol_z(2, 3, kg) + coef_xyz(139) = coef_xyz(139) + coef_xy(1, 3)*pol_z(1, 3, kg) + coef_xyz(139) = coef_xyz(139) + coef_xy(2, 3)*pol_z(2, 3, kg) + coef_xyz(140) = coef_xyz(140) + coef_xy(1, 4)*pol_z(1, 3, kg) + coef_xyz(140) = coef_xyz(140) + coef_xy(2, 4)*pol_z(2, 3, kg) + coef_xyz(141) = coef_xyz(141) + coef_xy(1, 5)*pol_z(1, 3, kg) + coef_xyz(141) = coef_xyz(141) + coef_xy(2, 5)*pol_z(2, 3, kg) + coef_xyz(142) = coef_xyz(142) + coef_xy(1, 6)*pol_z(1, 3, kg) + coef_xyz(142) = coef_xyz(142) + coef_xy(2, 6)*pol_z(2, 3, kg) + coef_xyz(143) = coef_xyz(143) + coef_xy(1, 7)*pol_z(1, 3, kg) + coef_xyz(143) = coef_xyz(143) + coef_xy(2, 7)*pol_z(2, 3, kg) + coef_xyz(144) = coef_xyz(144) + coef_xy(1, 11)*pol_z(1, 3, kg) + coef_xyz(144) = coef_xyz(144) + coef_xy(2, 11)*pol_z(2, 3, kg) + coef_xyz(145) = coef_xyz(145) + coef_xy(1, 12)*pol_z(1, 3, kg) + coef_xyz(145) = coef_xyz(145) + coef_xy(2, 12)*pol_z(2, 3, kg) + coef_xyz(146) = coef_xyz(146) + coef_xy(1, 13)*pol_z(1, 3, kg) + coef_xyz(146) = coef_xyz(146) + coef_xy(2, 13)*pol_z(2, 3, kg) + coef_xyz(147) = coef_xyz(147) + coef_xy(1, 14)*pol_z(1, 3, kg) + coef_xyz(147) = coef_xyz(147) + coef_xy(2, 14)*pol_z(2, 3, kg) + coef_xyz(148) = coef_xyz(148) + coef_xy(1, 15)*pol_z(1, 3, kg) + coef_xyz(148) = coef_xyz(148) + coef_xy(2, 15)*pol_z(2, 3, kg) + coef_xyz(149) = coef_xyz(149) + coef_xy(1, 16)*pol_z(1, 3, kg) + coef_xyz(149) = coef_xyz(149) + coef_xy(2, 16)*pol_z(2, 3, kg) + coef_xyz(150) = coef_xyz(150) + coef_xy(1, 20)*pol_z(1, 3, kg) + coef_xyz(150) = coef_xyz(150) + coef_xy(2, 20)*pol_z(2, 3, kg) + coef_xyz(151) = coef_xyz(151) + coef_xy(1, 21)*pol_z(1, 3, kg) + coef_xyz(151) = coef_xyz(151) + coef_xy(2, 21)*pol_z(2, 3, kg) + coef_xyz(152) = coef_xyz(152) + coef_xy(1, 22)*pol_z(1, 3, kg) + coef_xyz(152) = coef_xyz(152) + coef_xy(2, 22)*pol_z(2, 3, kg) + coef_xyz(153) = coef_xyz(153) + coef_xy(1, 23)*pol_z(1, 3, kg) + coef_xyz(153) = coef_xyz(153) + coef_xy(2, 23)*pol_z(2, 3, kg) + coef_xyz(154) = coef_xyz(154) + coef_xy(1, 24)*pol_z(1, 3, kg) + coef_xyz(154) = coef_xyz(154) + coef_xy(2, 24)*pol_z(2, 3, kg) + coef_xyz(155) = coef_xyz(155) + coef_xy(1, 28)*pol_z(1, 3, kg) + coef_xyz(155) = coef_xyz(155) + coef_xy(2, 28)*pol_z(2, 3, kg) + coef_xyz(156) = coef_xyz(156) + coef_xy(1, 29)*pol_z(1, 3, kg) + coef_xyz(156) = coef_xyz(156) + coef_xy(2, 29)*pol_z(2, 3, kg) + coef_xyz(157) = coef_xyz(157) + coef_xy(1, 30)*pol_z(1, 3, kg) + coef_xyz(157) = coef_xyz(157) + coef_xy(2, 30)*pol_z(2, 3, kg) + coef_xyz(158) = coef_xyz(158) + coef_xy(1, 31)*pol_z(1, 3, kg) + coef_xyz(158) = coef_xyz(158) + coef_xy(2, 31)*pol_z(2, 3, kg) + coef_xyz(159) = coef_xyz(159) + coef_xy(1, 35)*pol_z(1, 3, kg) + coef_xyz(159) = coef_xyz(159) + coef_xy(2, 35)*pol_z(2, 3, kg) + coef_xyz(160) = coef_xyz(160) + coef_xy(1, 36)*pol_z(1, 3, kg) + coef_xyz(160) = coef_xyz(160) + coef_xy(2, 36)*pol_z(2, 3, kg) + coef_xyz(161) = coef_xyz(161) + coef_xy(1, 37)*pol_z(1, 3, kg) + coef_xyz(161) = coef_xyz(161) + coef_xy(2, 37)*pol_z(2, 3, kg) + coef_xyz(162) = coef_xyz(162) + coef_xy(1, 41)*pol_z(1, 3, kg) + coef_xyz(162) = coef_xyz(162) + coef_xy(2, 41)*pol_z(2, 3, kg) + coef_xyz(163) = coef_xyz(163) + coef_xy(1, 42)*pol_z(1, 3, kg) + coef_xyz(163) = coef_xyz(163) + coef_xy(2, 42)*pol_z(2, 3, kg) + coef_xyz(164) = coef_xyz(164) + coef_xy(1, 46)*pol_z(1, 3, kg) + coef_xyz(164) = coef_xyz(164) + coef_xy(2, 46)*pol_z(2, 3, kg) + coef_xyz(165) = coef_xyz(165) + coef_xy(1, 1)*pol_z(1, 4, kg) + coef_xyz(165) = coef_xyz(165) + coef_xy(2, 1)*pol_z(2, 4, kg) + coef_xyz(166) = coef_xyz(166) + coef_xy(1, 2)*pol_z(1, 4, kg) + coef_xyz(166) = coef_xyz(166) + coef_xy(2, 2)*pol_z(2, 4, kg) + coef_xyz(167) = coef_xyz(167) + coef_xy(1, 3)*pol_z(1, 4, kg) + coef_xyz(167) = coef_xyz(167) + coef_xy(2, 3)*pol_z(2, 4, kg) + coef_xyz(168) = coef_xyz(168) + coef_xy(1, 4)*pol_z(1, 4, kg) + coef_xyz(168) = coef_xyz(168) + coef_xy(2, 4)*pol_z(2, 4, kg) + coef_xyz(169) = coef_xyz(169) + coef_xy(1, 5)*pol_z(1, 4, kg) + coef_xyz(169) = coef_xyz(169) + coef_xy(2, 5)*pol_z(2, 4, kg) + coef_xyz(170) = coef_xyz(170) + coef_xy(1, 6)*pol_z(1, 4, kg) + coef_xyz(170) = coef_xyz(170) + coef_xy(2, 6)*pol_z(2, 4, kg) + coef_xyz(171) = coef_xyz(171) + coef_xy(1, 11)*pol_z(1, 4, kg) + coef_xyz(171) = coef_xyz(171) + coef_xy(2, 11)*pol_z(2, 4, kg) + coef_xyz(172) = coef_xyz(172) + coef_xy(1, 12)*pol_z(1, 4, kg) + coef_xyz(172) = coef_xyz(172) + coef_xy(2, 12)*pol_z(2, 4, kg) + coef_xyz(173) = coef_xyz(173) + coef_xy(1, 13)*pol_z(1, 4, kg) + coef_xyz(173) = coef_xyz(173) + coef_xy(2, 13)*pol_z(2, 4, kg) + coef_xyz(174) = coef_xyz(174) + coef_xy(1, 14)*pol_z(1, 4, kg) + coef_xyz(174) = coef_xyz(174) + coef_xy(2, 14)*pol_z(2, 4, kg) + coef_xyz(175) = coef_xyz(175) + coef_xy(1, 15)*pol_z(1, 4, kg) + coef_xyz(175) = coef_xyz(175) + coef_xy(2, 15)*pol_z(2, 4, kg) + coef_xyz(176) = coef_xyz(176) + coef_xy(1, 20)*pol_z(1, 4, kg) + coef_xyz(176) = coef_xyz(176) + coef_xy(2, 20)*pol_z(2, 4, kg) + coef_xyz(177) = coef_xyz(177) + coef_xy(1, 21)*pol_z(1, 4, kg) + coef_xyz(177) = coef_xyz(177) + coef_xy(2, 21)*pol_z(2, 4, kg) + coef_xyz(178) = coef_xyz(178) + coef_xy(1, 22)*pol_z(1, 4, kg) + coef_xyz(178) = coef_xyz(178) + coef_xy(2, 22)*pol_z(2, 4, kg) + coef_xyz(179) = coef_xyz(179) + coef_xy(1, 23)*pol_z(1, 4, kg) + coef_xyz(179) = coef_xyz(179) + coef_xy(2, 23)*pol_z(2, 4, kg) + coef_xyz(180) = coef_xyz(180) + coef_xy(1, 28)*pol_z(1, 4, kg) + coef_xyz(180) = coef_xyz(180) + coef_xy(2, 28)*pol_z(2, 4, kg) + coef_xyz(181) = coef_xyz(181) + coef_xy(1, 29)*pol_z(1, 4, kg) + coef_xyz(181) = coef_xyz(181) + coef_xy(2, 29)*pol_z(2, 4, kg) + coef_xyz(182) = coef_xyz(182) + coef_xy(1, 30)*pol_z(1, 4, kg) + coef_xyz(182) = coef_xyz(182) + coef_xy(2, 30)*pol_z(2, 4, kg) + coef_xyz(183) = coef_xyz(183) + coef_xy(1, 35)*pol_z(1, 4, kg) + coef_xyz(183) = coef_xyz(183) + coef_xy(2, 35)*pol_z(2, 4, kg) + coef_xyz(184) = coef_xyz(184) + coef_xy(1, 36)*pol_z(1, 4, kg) + coef_xyz(184) = coef_xyz(184) + coef_xy(2, 36)*pol_z(2, 4, kg) + coef_xyz(185) = coef_xyz(185) + coef_xy(1, 41)*pol_z(1, 4, kg) + coef_xyz(185) = coef_xyz(185) + coef_xy(2, 41)*pol_z(2, 4, kg) + coef_xyz(186) = coef_xyz(186) + coef_xy(1, 1)*pol_z(1, 5, kg) + coef_xyz(186) = coef_xyz(186) + coef_xy(2, 1)*pol_z(2, 5, kg) + coef_xyz(187) = coef_xyz(187) + coef_xy(1, 2)*pol_z(1, 5, kg) + coef_xyz(187) = coef_xyz(187) + coef_xy(2, 2)*pol_z(2, 5, kg) + coef_xyz(188) = coef_xyz(188) + coef_xy(1, 3)*pol_z(1, 5, kg) + coef_xyz(188) = coef_xyz(188) + coef_xy(2, 3)*pol_z(2, 5, kg) + coef_xyz(189) = coef_xyz(189) + coef_xy(1, 4)*pol_z(1, 5, kg) + coef_xyz(189) = coef_xyz(189) + coef_xy(2, 4)*pol_z(2, 5, kg) + coef_xyz(190) = coef_xyz(190) + coef_xy(1, 5)*pol_z(1, 5, kg) + coef_xyz(190) = coef_xyz(190) + coef_xy(2, 5)*pol_z(2, 5, kg) + coef_xyz(191) = coef_xyz(191) + coef_xy(1, 11)*pol_z(1, 5, kg) + coef_xyz(191) = coef_xyz(191) + coef_xy(2, 11)*pol_z(2, 5, kg) + coef_xyz(192) = coef_xyz(192) + coef_xy(1, 12)*pol_z(1, 5, kg) + coef_xyz(192) = coef_xyz(192) + coef_xy(2, 12)*pol_z(2, 5, kg) + coef_xyz(193) = coef_xyz(193) + coef_xy(1, 13)*pol_z(1, 5, kg) + coef_xyz(193) = coef_xyz(193) + coef_xy(2, 13)*pol_z(2, 5, kg) + coef_xyz(194) = coef_xyz(194) + coef_xy(1, 14)*pol_z(1, 5, kg) + coef_xyz(194) = coef_xyz(194) + coef_xy(2, 14)*pol_z(2, 5, kg) + coef_xyz(195) = coef_xyz(195) + coef_xy(1, 20)*pol_z(1, 5, kg) + coef_xyz(195) = coef_xyz(195) + coef_xy(2, 20)*pol_z(2, 5, kg) + coef_xyz(196) = coef_xyz(196) + coef_xy(1, 21)*pol_z(1, 5, kg) + coef_xyz(196) = coef_xyz(196) + coef_xy(2, 21)*pol_z(2, 5, kg) + coef_xyz(197) = coef_xyz(197) + coef_xy(1, 22)*pol_z(1, 5, kg) + coef_xyz(197) = coef_xyz(197) + coef_xy(2, 22)*pol_z(2, 5, kg) + coef_xyz(198) = coef_xyz(198) + coef_xy(1, 28)*pol_z(1, 5, kg) + coef_xyz(198) = coef_xyz(198) + coef_xy(2, 28)*pol_z(2, 5, kg) + coef_xyz(199) = coef_xyz(199) + coef_xy(1, 29)*pol_z(1, 5, kg) + coef_xyz(199) = coef_xyz(199) + coef_xy(2, 29)*pol_z(2, 5, kg) + coef_xyz(200) = coef_xyz(200) + coef_xy(1, 35)*pol_z(1, 5, kg) + coef_xyz(200) = coef_xyz(200) + coef_xy(2, 35)*pol_z(2, 5, kg) + coef_xyz(201) = coef_xyz(201) + coef_xy(1, 1)*pol_z(1, 6, kg) + coef_xyz(201) = coef_xyz(201) + coef_xy(2, 1)*pol_z(2, 6, kg) + coef_xyz(202) = coef_xyz(202) + coef_xy(1, 2)*pol_z(1, 6, kg) + coef_xyz(202) = coef_xyz(202) + coef_xy(2, 2)*pol_z(2, 6, kg) + coef_xyz(203) = coef_xyz(203) + coef_xy(1, 3)*pol_z(1, 6, kg) + coef_xyz(203) = coef_xyz(203) + coef_xy(2, 3)*pol_z(2, 6, kg) + coef_xyz(204) = coef_xyz(204) + coef_xy(1, 4)*pol_z(1, 6, kg) + coef_xyz(204) = coef_xyz(204) + coef_xy(2, 4)*pol_z(2, 6, kg) + coef_xyz(205) = coef_xyz(205) + coef_xy(1, 11)*pol_z(1, 6, kg) + coef_xyz(205) = coef_xyz(205) + coef_xy(2, 11)*pol_z(2, 6, kg) + coef_xyz(206) = coef_xyz(206) + coef_xy(1, 12)*pol_z(1, 6, kg) + coef_xyz(206) = coef_xyz(206) + coef_xy(2, 12)*pol_z(2, 6, kg) + coef_xyz(207) = coef_xyz(207) + coef_xy(1, 13)*pol_z(1, 6, kg) + coef_xyz(207) = coef_xyz(207) + coef_xy(2, 13)*pol_z(2, 6, kg) + coef_xyz(208) = coef_xyz(208) + coef_xy(1, 20)*pol_z(1, 6, kg) + coef_xyz(208) = coef_xyz(208) + coef_xy(2, 20)*pol_z(2, 6, kg) + coef_xyz(209) = coef_xyz(209) + coef_xy(1, 21)*pol_z(1, 6, kg) + coef_xyz(209) = coef_xyz(209) + coef_xy(2, 21)*pol_z(2, 6, kg) + coef_xyz(210) = coef_xyz(210) + coef_xy(1, 28)*pol_z(1, 6, kg) + coef_xyz(210) = coef_xyz(210) + coef_xy(2, 28)*pol_z(2, 6, kg) + coef_xyz(211) = coef_xyz(211) + coef_xy(1, 1)*pol_z(1, 7, kg) + coef_xyz(211) = coef_xyz(211) + coef_xy(2, 1)*pol_z(2, 7, kg) + coef_xyz(212) = coef_xyz(212) + coef_xy(1, 2)*pol_z(1, 7, kg) + coef_xyz(212) = coef_xyz(212) + coef_xy(2, 2)*pol_z(2, 7, kg) + coef_xyz(213) = coef_xyz(213) + coef_xy(1, 3)*pol_z(1, 7, kg) + coef_xyz(213) = coef_xyz(213) + coef_xy(2, 3)*pol_z(2, 7, kg) + coef_xyz(214) = coef_xyz(214) + coef_xy(1, 11)*pol_z(1, 7, kg) + coef_xyz(214) = coef_xyz(214) + coef_xy(2, 11)*pol_z(2, 7, kg) + coef_xyz(215) = coef_xyz(215) + coef_xy(1, 12)*pol_z(1, 7, kg) + coef_xyz(215) = coef_xyz(215) + coef_xy(2, 12)*pol_z(2, 7, kg) + coef_xyz(216) = coef_xyz(216) + coef_xy(1, 20)*pol_z(1, 7, kg) + coef_xyz(216) = coef_xyz(216) + coef_xy(2, 20)*pol_z(2, 7, kg) + coef_xyz(217) = coef_xyz(217) + coef_xy(1, 1)*pol_z(1, 8, kg) + coef_xyz(217) = coef_xyz(217) + coef_xy(2, 1)*pol_z(2, 8, kg) + coef_xyz(218) = coef_xyz(218) + coef_xy(1, 2)*pol_z(1, 8, kg) + coef_xyz(218) = coef_xyz(218) + coef_xy(2, 2)*pol_z(2, 8, kg) + coef_xyz(219) = coef_xyz(219) + coef_xy(1, 11)*pol_z(1, 8, kg) + coef_xyz(219) = coef_xyz(219) + coef_xy(2, 11)*pol_z(2, 8, kg) + coef_xyz(220) = coef_xyz(220) + coef_xy(1, 1)*pol_z(1, 9, kg) + coef_xyz(220) = coef_xyz(220) + coef_xy(2, 1)*pol_z(2, 9, kg) END DO END SUBROUTINE integrate_core_9 diff --git a/src/grid/integrate_fast_5.f90 b/src/grid/integrate_fast_5.f90 index f199e9cfad..9e29e631b1 100644 --- a/src/grid/integrate_fast_5.f90 +++ b/src/grid/integrate_fast_5.f90 @@ -14,7 +14,7 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bounds, lp, cmax, gridbounds) USE kinds, ONLY: dp INTEGER, INTENT(IN) :: sphere_bounds(*), lp - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER, INTENT(IN) :: cmax REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & @@ -29,7 +29,7 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -37,23 +37,23 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp @@ -64,21 +64,21 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_x(1, lxp)*pol_y(1, lyp, jg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_x(2, lxp)*pol_y(1, lyp, jg) - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_x(3, lxp)*pol_y(2, lyp, jg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_x(4, lxp)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_x(1, lxp)*pol_y(1, lyp, jg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_x(2, lxp)*pol_y(1, lyp, jg) + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_x(3, lxp)*pol_y(2, lyp, jg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_x(4, lxp)*pol_y(2, lyp, jg) ENDDO ENDDO @@ -87,13 +87,13 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(1, lxy)*pol_z(1, lzp, kg) - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(2, lxy)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(1, lxy)*pol_z(1, lzp, kg) + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(2, lxy)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO @@ -123,13 +123,13 @@ SUBROUTINE integrate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -137,23 +137,23 @@ SUBROUTINE integrate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -163,17 +163,17 @@ SUBROUTINE integrate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) END DO END SUBROUTINE integrate_core_0 @@ -200,14 +200,14 @@ SUBROUTINE integrate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -215,23 +215,23 @@ SUBROUTINE integrate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -240,33 +240,33 @@ SUBROUTINE integrate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = grid(i, j, k2) s03 = grid(i, j2, k) s04 = grid(i, j2, k2) - coef_x(1, 0) = coef_x(1, 0)+s01*pol_x(0, ig) - coef_x(2, 0) = coef_x(2, 0)+s02*pol_x(0, ig) - coef_x(3, 0) = coef_x(3, 0)+s03*pol_x(0, ig) - coef_x(4, 0) = coef_x(4, 0)+s04*pol_x(0, ig) - coef_x(1, 1) = coef_x(1, 1)+s01*pol_x(1, ig) - coef_x(2, 1) = coef_x(2, 1)+s02*pol_x(1, ig) - coef_x(3, 1) = coef_x(3, 1)+s03*pol_x(1, ig) - coef_x(4, 1) = coef_x(4, 1)+s04*pol_x(1, ig) + coef_x(1, 0) = coef_x(1, 0) + s01*pol_x(0, ig) + coef_x(2, 0) = coef_x(2, 0) + s02*pol_x(0, ig) + coef_x(3, 0) = coef_x(3, 0) + s03*pol_x(0, ig) + coef_x(4, 0) = coef_x(4, 0) + s04*pol_x(0, ig) + coef_x(1, 1) = coef_x(1, 1) + s01*pol_x(1, ig) + coef_x(2, 1) = coef_x(2, 1) + s02*pol_x(1, ig) + coef_x(3, 1) = coef_x(3, 1) + s03*pol_x(1, ig) + coef_x(4, 1) = coef_x(4, 1) + s04*pol_x(1, ig) END DO lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_xy(:, lxy) = coef_xy(:, lxy)+coef_x(1:2, lxp)*pol_y(1, lyp, jg) - coef_xy(:, lxy) = coef_xy(:, lxy)+coef_x(3:4, lxp)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_xy(:, lxy) = coef_xy(:, lxy) + coef_x(1:2, lxp)*pol_y(1, lyp, jg) + coef_xy(:, lxy) = coef_xy(:, lxy) + coef_x(3:4, lxp)*pol_y(2, lyp, jg) ENDDO ENDDO END DO lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xyz(lxyz) = coef_xyz(lxyz)+SUM(coef_xy(:, lxy)*pol_z(:, lzp, kg)) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xyz(lxyz) = coef_xyz(lxyz) + SUM(coef_xy(:, lxy)*pol_z(:, lzp, kg)) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO END DO @@ -295,13 +295,13 @@ SUBROUTINE integrate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lyp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -309,23 +309,23 @@ SUBROUTINE integrate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -335,31 +335,31 @@ SUBROUTINE integrate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_xy(:, lxy) = coef_xy(:, lxy)+coef_x(1:2, lxp)*pol_y(1, lyp, jg) - coef_xy(:, lxy) = coef_xy(:, lxy)+coef_x(3:4, lxp)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_xy(:, lxy) = coef_xy(:, lxy) + coef_x(1:2, lxp)*pol_y(1, lyp, jg) + coef_xy(:, lxy) = coef_xy(:, lxy) + coef_x(3:4, lxp)*pol_y(2, lyp, jg) ENDDO ENDDO END DO - coef_xyz(1) = coef_xyz(1)+SUM(coef_xy(:, 1)*pol_z(:, 0, kg)) - coef_xyz(2) = coef_xyz(2)+SUM(coef_xy(:, 2)*pol_z(:, 0, kg)) - coef_xyz(3) = coef_xyz(3)+SUM(coef_xy(:, 3)*pol_z(:, 0, kg)) - coef_xyz(4) = coef_xyz(4)+SUM(coef_xy(:, 4)*pol_z(:, 0, kg)) - coef_xyz(5) = coef_xyz(5)+SUM(coef_xy(:, 5)*pol_z(:, 0, kg)) - coef_xyz(6) = coef_xyz(6)+SUM(coef_xy(:, 6)*pol_z(:, 0, kg)) - coef_xyz(7) = coef_xyz(7)+SUM(coef_xy(:, 1)*pol_z(:, 1, kg)) - coef_xyz(8) = coef_xyz(8)+SUM(coef_xy(:, 2)*pol_z(:, 1, kg)) - coef_xyz(9) = coef_xyz(9)+SUM(coef_xy(:, 4)*pol_z(:, 1, kg)) - coef_xyz(10) = coef_xyz(10)+SUM(coef_xy(:, 1)*pol_z(:, 2, kg)) + coef_xyz(1) = coef_xyz(1) + SUM(coef_xy(:, 1)*pol_z(:, 0, kg)) + coef_xyz(2) = coef_xyz(2) + SUM(coef_xy(:, 2)*pol_z(:, 0, kg)) + coef_xyz(3) = coef_xyz(3) + SUM(coef_xy(:, 3)*pol_z(:, 0, kg)) + coef_xyz(4) = coef_xyz(4) + SUM(coef_xy(:, 4)*pol_z(:, 0, kg)) + coef_xyz(5) = coef_xyz(5) + SUM(coef_xy(:, 5)*pol_z(:, 0, kg)) + coef_xyz(6) = coef_xyz(6) + SUM(coef_xy(:, 6)*pol_z(:, 0, kg)) + coef_xyz(7) = coef_xyz(7) + SUM(coef_xy(:, 1)*pol_z(:, 1, kg)) + coef_xyz(8) = coef_xyz(8) + SUM(coef_xy(:, 2)*pol_z(:, 1, kg)) + coef_xyz(9) = coef_xyz(9) + SUM(coef_xy(:, 4)*pol_z(:, 1, kg)) + coef_xyz(10) = coef_xyz(10) + SUM(coef_xy(:, 1)*pol_z(:, 2, kg)) END DO END SUBROUTINE integrate_core_2 @@ -386,13 +386,13 @@ SUBROUTINE integrate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s(4) sci = 1 @@ -400,23 +400,23 @@ SUBROUTINE integrate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -425,72 +425,72 @@ SUBROUTINE integrate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s(2) = grid(i, j, k2) s(3) = grid(i, j2, k) s(4) = grid(i, j2, k2) - coef_x(:, 0) = coef_x(:, 0)+s(:)*pol_x(0, ig) - coef_x(:, 1) = coef_x(:, 1)+s(:)*pol_x(1, ig) - coef_x(:, 2) = coef_x(:, 2)+s(:)*pol_x(2, ig) - coef_x(:, 3) = coef_x(:, 3)+s(:)*pol_x(3, ig) + coef_x(:, 0) = coef_x(:, 0) + s(:)*pol_x(0, ig) + coef_x(:, 1) = coef_x(:, 1) + s(:)*pol_x(1, ig) + coef_x(:, 2) = coef_x(:, 2) + s(:)*pol_x(2, ig) + coef_x(:, 3) = coef_x(:, 3) + s(:)*pol_x(3, ig) END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(1:2, 1)*pol_y(1, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(3:4, 1)*pol_y(2, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(1:2, 2)*pol_y(1, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(3:4, 2)*pol_y(2, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(1:2, 3)*pol_y(1, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(3:4, 3)*pol_y(2, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(1:2, 0)*pol_y(1, 1, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(3:4, 0)*pol_y(2, 1, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(1:2, 1)*pol_y(1, 1, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(3:4, 1)*pol_y(2, 1, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(1:2, 2)*pol_y(1, 1, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(3:4, 2)*pol_y(2, 1, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(1:2, 0)*pol_y(1, 2, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(3:4, 0)*pol_y(2, 2, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(1:2, 1)*pol_y(1, 2, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(3:4, 1)*pol_y(2, 2, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(1:2, 0)*pol_y(1, 3, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(3:4, 0)*pol_y(2, 3, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(1:2, 1)*pol_y(1, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(3:4, 1)*pol_y(2, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(1:2, 2)*pol_y(1, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(3:4, 2)*pol_y(2, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(1:2, 3)*pol_y(1, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(3:4, 3)*pol_y(2, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(1:2, 0)*pol_y(1, 1, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(3:4, 0)*pol_y(2, 1, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(1:2, 1)*pol_y(1, 1, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(3:4, 1)*pol_y(2, 1, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(1:2, 2)*pol_y(1, 1, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(3:4, 2)*pol_y(2, 1, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(1:2, 0)*pol_y(1, 2, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(3:4, 0)*pol_y(2, 2, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(1:2, 1)*pol_y(1, 2, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(3:4, 1)*pol_y(2, 2, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(1:2, 0)*pol_y(1, 3, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(3:4, 0)*pol_y(2, 3, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 5)*pol_z(1, 1, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 5)*pol_z(2, 1, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 8)*pol_z(1, 1, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 8)*pol_z(2, 1, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 5)*pol_z(1, 2, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 5)*pol_z(2, 2, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 5)*pol_z(1, 1, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 5)*pol_z(2, 1, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 8)*pol_z(1, 1, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 8)*pol_z(2, 1, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 5)*pol_z(1, 2, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 5)*pol_z(2, 2, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 1)*pol_z(2, 3, kg) END DO END SUBROUTINE integrate_core_3 @@ -517,13 +517,13 @@ SUBROUTINE integrate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lyp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -531,23 +531,23 @@ SUBROUTINE integrate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -557,91 +557,91 @@ SUBROUTINE integrate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_xy(:, lxy) = coef_xy(:, lxy)+coef_x(1:2, lxp)*pol_y(1, lyp, jg) - coef_xy(:, lxy) = coef_xy(:, lxy)+coef_x(3:4, lxp)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_xy(:, lxy) = coef_xy(:, lxy) + coef_x(1:2, lxp)*pol_y(1, lyp, jg) + coef_xy(:, lxy) = coef_xy(:, lxy) + coef_x(3:4, lxp)*pol_y(2, lyp, jg) ENDDO ENDDO END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 11)*pol_z(1, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 11)*pol_z(2, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 12)*pol_z(1, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 12)*pol_z(2, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 13)*pol_z(1, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 13)*pol_z(2, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 14)*pol_z(1, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 14)*pol_z(2, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 15)*pol_z(1, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 15)*pol_z(2, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(1, 7)*pol_z(1, 1, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(2, 7)*pol_z(2, 1, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(1, 8)*pol_z(1, 1, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(2, 8)*pol_z(2, 1, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(1, 10)*pol_z(1, 1, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(2, 10)*pol_z(2, 1, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(1, 11)*pol_z(1, 1, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(2, 11)*pol_z(2, 1, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(1, 13)*pol_z(1, 1, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(2, 13)*pol_z(2, 1, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(1, 3)*pol_z(1, 2, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(2, 3)*pol_z(2, 2, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(1, 6)*pol_z(1, 2, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(2, 6)*pol_z(2, 2, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(1, 7)*pol_z(1, 2, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(2, 7)*pol_z(2, 2, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(1, 10)*pol_z(1, 2, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(2, 10)*pol_z(2, 2, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(2, 1)*pol_z(2, 3, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(1, 2)*pol_z(1, 3, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(2, 2)*pol_z(2, 3, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(1, 6)*pol_z(1, 3, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(2, 6)*pol_z(2, 3, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(1, 1)*pol_z(1, 4, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(2, 1)*pol_z(2, 4, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 11)*pol_z(1, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 11)*pol_z(2, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 12)*pol_z(1, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 12)*pol_z(2, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 13)*pol_z(1, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 13)*pol_z(2, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 14)*pol_z(1, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 14)*pol_z(2, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 15)*pol_z(1, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 15)*pol_z(2, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(1, 7)*pol_z(1, 1, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(2, 7)*pol_z(2, 1, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(1, 8)*pol_z(1, 1, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(2, 8)*pol_z(2, 1, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(1, 10)*pol_z(1, 1, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(2, 10)*pol_z(2, 1, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(1, 11)*pol_z(1, 1, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(2, 11)*pol_z(2, 1, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(1, 13)*pol_z(1, 1, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(2, 13)*pol_z(2, 1, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(1, 3)*pol_z(1, 2, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(2, 3)*pol_z(2, 2, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(1, 6)*pol_z(1, 2, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(2, 6)*pol_z(2, 2, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(1, 7)*pol_z(1, 2, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(2, 7)*pol_z(2, 2, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(1, 10)*pol_z(1, 2, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(2, 10)*pol_z(2, 2, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(1, 2)*pol_z(1, 3, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(2, 2)*pol_z(2, 3, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(1, 6)*pol_z(1, 3, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(2, 6)*pol_z(2, 3, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(1, 1)*pol_z(1, 4, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(2, 1)*pol_z(2, 4, kg) END DO END SUBROUTINE integrate_core_4 @@ -668,13 +668,13 @@ SUBROUTINE integrate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -682,23 +682,23 @@ SUBROUTINE integrate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -708,111 +708,111 @@ SUBROUTINE integrate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(1:2, 1)*pol_y(1, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(3:4, 1)*pol_y(2, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(1:2, 2)*pol_y(1, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(3:4, 2)*pol_y(2, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(1:2, 3)*pol_y(1, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(3:4, 3)*pol_y(2, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(1:2, 4)*pol_y(1, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(3:4, 4)*pol_y(2, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(1:2, 5)*pol_y(1, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(3:4, 5)*pol_y(2, 0, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(1:2, 0)*pol_y(1, 1, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(3:4, 0)*pol_y(2, 1, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(1:2, 1)*pol_y(1, 1, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(3:4, 1)*pol_y(2, 1, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(1:2, 2)*pol_y(1, 1, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(3:4, 2)*pol_y(2, 1, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(1:2, 3)*pol_y(1, 1, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(3:4, 3)*pol_y(2, 1, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(1:2, 4)*pol_y(1, 1, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(3:4, 4)*pol_y(2, 1, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(1:2, 0)*pol_y(1, 2, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(3:4, 0)*pol_y(2, 2, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(1:2, 1)*pol_y(1, 2, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(3:4, 1)*pol_y(2, 2, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(1:2, 2)*pol_y(1, 2, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(3:4, 2)*pol_y(2, 2, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(1:2, 3)*pol_y(1, 2, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(3:4, 3)*pol_y(2, 2, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(1:2, 0)*pol_y(1, 3, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(3:4, 0)*pol_y(2, 3, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(1:2, 1)*pol_y(1, 3, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(3:4, 1)*pol_y(2, 3, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(1:2, 2)*pol_y(1, 3, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(3:4, 2)*pol_y(2, 3, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(1:2, 0)*pol_y(1, 4, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(3:4, 0)*pol_y(2, 4, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(1:2, 1)*pol_y(1, 4, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(3:4, 1)*pol_y(2, 4, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(1:2, 0)*pol_y(1, 5, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(3:4, 0)*pol_y(2, 5, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(1:2, 1)*pol_y(1, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(3:4, 1)*pol_y(2, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(1:2, 2)*pol_y(1, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(3:4, 2)*pol_y(2, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(1:2, 3)*pol_y(1, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(3:4, 3)*pol_y(2, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(1:2, 4)*pol_y(1, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(3:4, 4)*pol_y(2, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(1:2, 5)*pol_y(1, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(3:4, 5)*pol_y(2, 0, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(1:2, 0)*pol_y(1, 1, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(3:4, 0)*pol_y(2, 1, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(1:2, 1)*pol_y(1, 1, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(3:4, 1)*pol_y(2, 1, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(1:2, 2)*pol_y(1, 1, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(3:4, 2)*pol_y(2, 1, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(1:2, 3)*pol_y(1, 1, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(3:4, 3)*pol_y(2, 1, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(1:2, 4)*pol_y(1, 1, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(3:4, 4)*pol_y(2, 1, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(1:2, 0)*pol_y(1, 2, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(3:4, 0)*pol_y(2, 2, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(1:2, 1)*pol_y(1, 2, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(3:4, 1)*pol_y(2, 2, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(1:2, 2)*pol_y(1, 2, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(3:4, 2)*pol_y(2, 2, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(1:2, 3)*pol_y(1, 2, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(3:4, 3)*pol_y(2, 2, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(1:2, 0)*pol_y(1, 3, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(3:4, 0)*pol_y(2, 3, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(1:2, 1)*pol_y(1, 3, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(3:4, 1)*pol_y(2, 3, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(1:2, 2)*pol_y(1, 3, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(3:4, 2)*pol_y(2, 3, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(1:2, 0)*pol_y(1, 4, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(3:4, 0)*pol_y(2, 4, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(1:2, 1)*pol_y(1, 4, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(3:4, 1)*pol_y(2, 4, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(1:2, 0)*pol_y(1, 5, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(3:4, 0)*pol_y(2, 5, jg) END DO - coef_xyz(1) = coef_xyz(1)+SUM(coef_xy(:, 1)*pol_z(:, 0, kg)) - coef_xyz(2) = coef_xyz(2)+SUM(coef_xy(:, 2)*pol_z(:, 0, kg)) - coef_xyz(3) = coef_xyz(3)+SUM(coef_xy(:, 3)*pol_z(:, 0, kg)) - coef_xyz(4) = coef_xyz(4)+SUM(coef_xy(:, 4)*pol_z(:, 0, kg)) - coef_xyz(5) = coef_xyz(5)+SUM(coef_xy(:, 5)*pol_z(:, 0, kg)) - coef_xyz(6) = coef_xyz(6)+SUM(coef_xy(:, 6)*pol_z(:, 0, kg)) - coef_xyz(7) = coef_xyz(7)+SUM(coef_xy(:, 7)*pol_z(:, 0, kg)) - coef_xyz(8) = coef_xyz(8)+SUM(coef_xy(:, 8)*pol_z(:, 0, kg)) - coef_xyz(9) = coef_xyz(9)+SUM(coef_xy(:, 9)*pol_z(:, 0, kg)) - coef_xyz(10) = coef_xyz(10)+SUM(coef_xy(:, 10)*pol_z(:, 0, kg)) - coef_xyz(11) = coef_xyz(11)+SUM(coef_xy(:, 11)*pol_z(:, 0, kg)) - coef_xyz(12) = coef_xyz(12)+SUM(coef_xy(:, 12)*pol_z(:, 0, kg)) - coef_xyz(13) = coef_xyz(13)+SUM(coef_xy(:, 13)*pol_z(:, 0, kg)) - coef_xyz(14) = coef_xyz(14)+SUM(coef_xy(:, 14)*pol_z(:, 0, kg)) - coef_xyz(15) = coef_xyz(15)+SUM(coef_xy(:, 15)*pol_z(:, 0, kg)) - coef_xyz(16) = coef_xyz(16)+SUM(coef_xy(:, 16)*pol_z(:, 0, kg)) - coef_xyz(17) = coef_xyz(17)+SUM(coef_xy(:, 17)*pol_z(:, 0, kg)) - coef_xyz(18) = coef_xyz(18)+SUM(coef_xy(:, 18)*pol_z(:, 0, kg)) - coef_xyz(19) = coef_xyz(19)+SUM(coef_xy(:, 19)*pol_z(:, 0, kg)) - coef_xyz(20) = coef_xyz(20)+SUM(coef_xy(:, 20)*pol_z(:, 0, kg)) - coef_xyz(21) = coef_xyz(21)+SUM(coef_xy(:, 21)*pol_z(:, 0, kg)) - coef_xyz(22) = coef_xyz(22)+SUM(coef_xy(:, 1)*pol_z(:, 1, kg)) - coef_xyz(23) = coef_xyz(23)+SUM(coef_xy(:, 2)*pol_z(:, 1, kg)) - coef_xyz(24) = coef_xyz(24)+SUM(coef_xy(:, 3)*pol_z(:, 1, kg)) - coef_xyz(25) = coef_xyz(25)+SUM(coef_xy(:, 4)*pol_z(:, 1, kg)) - coef_xyz(26) = coef_xyz(26)+SUM(coef_xy(:, 5)*pol_z(:, 1, kg)) - coef_xyz(27) = coef_xyz(27)+SUM(coef_xy(:, 7)*pol_z(:, 1, kg)) - coef_xyz(28) = coef_xyz(28)+SUM(coef_xy(:, 8)*pol_z(:, 1, kg)) - coef_xyz(29) = coef_xyz(29)+SUM(coef_xy(:, 9)*pol_z(:, 1, kg)) - coef_xyz(30) = coef_xyz(30)+SUM(coef_xy(:, 10)*pol_z(:, 1, kg)) - coef_xyz(31) = coef_xyz(31)+SUM(coef_xy(:, 12)*pol_z(:, 1, kg)) - coef_xyz(32) = coef_xyz(32)+SUM(coef_xy(:, 13)*pol_z(:, 1, kg)) - coef_xyz(33) = coef_xyz(33)+SUM(coef_xy(:, 14)*pol_z(:, 1, kg)) - coef_xyz(34) = coef_xyz(34)+SUM(coef_xy(:, 16)*pol_z(:, 1, kg)) - coef_xyz(35) = coef_xyz(35)+SUM(coef_xy(:, 17)*pol_z(:, 1, kg)) - coef_xyz(36) = coef_xyz(36)+SUM(coef_xy(:, 19)*pol_z(:, 1, kg)) - coef_xyz(37) = coef_xyz(37)+SUM(coef_xy(:, 1)*pol_z(:, 2, kg)) - coef_xyz(38) = coef_xyz(38)+SUM(coef_xy(:, 2)*pol_z(:, 2, kg)) - coef_xyz(39) = coef_xyz(39)+SUM(coef_xy(:, 3)*pol_z(:, 2, kg)) - coef_xyz(40) = coef_xyz(40)+SUM(coef_xy(:, 4)*pol_z(:, 2, kg)) - coef_xyz(41) = coef_xyz(41)+SUM(coef_xy(:, 7)*pol_z(:, 2, kg)) - coef_xyz(42) = coef_xyz(42)+SUM(coef_xy(:, 8)*pol_z(:, 2, kg)) - coef_xyz(43) = coef_xyz(43)+SUM(coef_xy(:, 9)*pol_z(:, 2, kg)) - coef_xyz(44) = coef_xyz(44)+SUM(coef_xy(:, 12)*pol_z(:, 2, kg)) - coef_xyz(45) = coef_xyz(45)+SUM(coef_xy(:, 13)*pol_z(:, 2, kg)) - coef_xyz(46) = coef_xyz(46)+SUM(coef_xy(:, 16)*pol_z(:, 2, kg)) - coef_xyz(47) = coef_xyz(47)+SUM(coef_xy(:, 1)*pol_z(:, 3, kg)) - coef_xyz(48) = coef_xyz(48)+SUM(coef_xy(:, 2)*pol_z(:, 3, kg)) - coef_xyz(49) = coef_xyz(49)+SUM(coef_xy(:, 3)*pol_z(:, 3, kg)) - coef_xyz(50) = coef_xyz(50)+SUM(coef_xy(:, 7)*pol_z(:, 3, kg)) - coef_xyz(51) = coef_xyz(51)+SUM(coef_xy(:, 8)*pol_z(:, 3, kg)) - coef_xyz(52) = coef_xyz(52)+SUM(coef_xy(:, 12)*pol_z(:, 3, kg)) - coef_xyz(53) = coef_xyz(53)+SUM(coef_xy(:, 1)*pol_z(:, 4, kg)) - coef_xyz(54) = coef_xyz(54)+SUM(coef_xy(:, 2)*pol_z(:, 4, kg)) - coef_xyz(55) = coef_xyz(55)+SUM(coef_xy(:, 7)*pol_z(:, 4, kg)) - coef_xyz(56) = coef_xyz(56)+SUM(coef_xy(:, 1)*pol_z(:, 5, kg)) + coef_xyz(1) = coef_xyz(1) + SUM(coef_xy(:, 1)*pol_z(:, 0, kg)) + coef_xyz(2) = coef_xyz(2) + SUM(coef_xy(:, 2)*pol_z(:, 0, kg)) + coef_xyz(3) = coef_xyz(3) + SUM(coef_xy(:, 3)*pol_z(:, 0, kg)) + coef_xyz(4) = coef_xyz(4) + SUM(coef_xy(:, 4)*pol_z(:, 0, kg)) + coef_xyz(5) = coef_xyz(5) + SUM(coef_xy(:, 5)*pol_z(:, 0, kg)) + coef_xyz(6) = coef_xyz(6) + SUM(coef_xy(:, 6)*pol_z(:, 0, kg)) + coef_xyz(7) = coef_xyz(7) + SUM(coef_xy(:, 7)*pol_z(:, 0, kg)) + coef_xyz(8) = coef_xyz(8) + SUM(coef_xy(:, 8)*pol_z(:, 0, kg)) + coef_xyz(9) = coef_xyz(9) + SUM(coef_xy(:, 9)*pol_z(:, 0, kg)) + coef_xyz(10) = coef_xyz(10) + SUM(coef_xy(:, 10)*pol_z(:, 0, kg)) + coef_xyz(11) = coef_xyz(11) + SUM(coef_xy(:, 11)*pol_z(:, 0, kg)) + coef_xyz(12) = coef_xyz(12) + SUM(coef_xy(:, 12)*pol_z(:, 0, kg)) + coef_xyz(13) = coef_xyz(13) + SUM(coef_xy(:, 13)*pol_z(:, 0, kg)) + coef_xyz(14) = coef_xyz(14) + SUM(coef_xy(:, 14)*pol_z(:, 0, kg)) + coef_xyz(15) = coef_xyz(15) + SUM(coef_xy(:, 15)*pol_z(:, 0, kg)) + coef_xyz(16) = coef_xyz(16) + SUM(coef_xy(:, 16)*pol_z(:, 0, kg)) + coef_xyz(17) = coef_xyz(17) + SUM(coef_xy(:, 17)*pol_z(:, 0, kg)) + coef_xyz(18) = coef_xyz(18) + SUM(coef_xy(:, 18)*pol_z(:, 0, kg)) + coef_xyz(19) = coef_xyz(19) + SUM(coef_xy(:, 19)*pol_z(:, 0, kg)) + coef_xyz(20) = coef_xyz(20) + SUM(coef_xy(:, 20)*pol_z(:, 0, kg)) + coef_xyz(21) = coef_xyz(21) + SUM(coef_xy(:, 21)*pol_z(:, 0, kg)) + coef_xyz(22) = coef_xyz(22) + SUM(coef_xy(:, 1)*pol_z(:, 1, kg)) + coef_xyz(23) = coef_xyz(23) + SUM(coef_xy(:, 2)*pol_z(:, 1, kg)) + coef_xyz(24) = coef_xyz(24) + SUM(coef_xy(:, 3)*pol_z(:, 1, kg)) + coef_xyz(25) = coef_xyz(25) + SUM(coef_xy(:, 4)*pol_z(:, 1, kg)) + coef_xyz(26) = coef_xyz(26) + SUM(coef_xy(:, 5)*pol_z(:, 1, kg)) + coef_xyz(27) = coef_xyz(27) + SUM(coef_xy(:, 7)*pol_z(:, 1, kg)) + coef_xyz(28) = coef_xyz(28) + SUM(coef_xy(:, 8)*pol_z(:, 1, kg)) + coef_xyz(29) = coef_xyz(29) + SUM(coef_xy(:, 9)*pol_z(:, 1, kg)) + coef_xyz(30) = coef_xyz(30) + SUM(coef_xy(:, 10)*pol_z(:, 1, kg)) + coef_xyz(31) = coef_xyz(31) + SUM(coef_xy(:, 12)*pol_z(:, 1, kg)) + coef_xyz(32) = coef_xyz(32) + SUM(coef_xy(:, 13)*pol_z(:, 1, kg)) + coef_xyz(33) = coef_xyz(33) + SUM(coef_xy(:, 14)*pol_z(:, 1, kg)) + coef_xyz(34) = coef_xyz(34) + SUM(coef_xy(:, 16)*pol_z(:, 1, kg)) + coef_xyz(35) = coef_xyz(35) + SUM(coef_xy(:, 17)*pol_z(:, 1, kg)) + coef_xyz(36) = coef_xyz(36) + SUM(coef_xy(:, 19)*pol_z(:, 1, kg)) + coef_xyz(37) = coef_xyz(37) + SUM(coef_xy(:, 1)*pol_z(:, 2, kg)) + coef_xyz(38) = coef_xyz(38) + SUM(coef_xy(:, 2)*pol_z(:, 2, kg)) + coef_xyz(39) = coef_xyz(39) + SUM(coef_xy(:, 3)*pol_z(:, 2, kg)) + coef_xyz(40) = coef_xyz(40) + SUM(coef_xy(:, 4)*pol_z(:, 2, kg)) + coef_xyz(41) = coef_xyz(41) + SUM(coef_xy(:, 7)*pol_z(:, 2, kg)) + coef_xyz(42) = coef_xyz(42) + SUM(coef_xy(:, 8)*pol_z(:, 2, kg)) + coef_xyz(43) = coef_xyz(43) + SUM(coef_xy(:, 9)*pol_z(:, 2, kg)) + coef_xyz(44) = coef_xyz(44) + SUM(coef_xy(:, 12)*pol_z(:, 2, kg)) + coef_xyz(45) = coef_xyz(45) + SUM(coef_xy(:, 13)*pol_z(:, 2, kg)) + coef_xyz(46) = coef_xyz(46) + SUM(coef_xy(:, 16)*pol_z(:, 2, kg)) + coef_xyz(47) = coef_xyz(47) + SUM(coef_xy(:, 1)*pol_z(:, 3, kg)) + coef_xyz(48) = coef_xyz(48) + SUM(coef_xy(:, 2)*pol_z(:, 3, kg)) + coef_xyz(49) = coef_xyz(49) + SUM(coef_xy(:, 3)*pol_z(:, 3, kg)) + coef_xyz(50) = coef_xyz(50) + SUM(coef_xy(:, 7)*pol_z(:, 3, kg)) + coef_xyz(51) = coef_xyz(51) + SUM(coef_xy(:, 8)*pol_z(:, 3, kg)) + coef_xyz(52) = coef_xyz(52) + SUM(coef_xy(:, 12)*pol_z(:, 3, kg)) + coef_xyz(53) = coef_xyz(53) + SUM(coef_xy(:, 1)*pol_z(:, 4, kg)) + coef_xyz(54) = coef_xyz(54) + SUM(coef_xy(:, 2)*pol_z(:, 4, kg)) + coef_xyz(55) = coef_xyz(55) + SUM(coef_xy(:, 7)*pol_z(:, 4, kg)) + coef_xyz(56) = coef_xyz(56) + SUM(coef_xy(:, 1)*pol_z(:, 5, kg)) END DO END SUBROUTINE integrate_core_5 @@ -839,13 +839,13 @@ SUBROUTINE integrate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s(4) sci = 1 @@ -853,23 +853,23 @@ SUBROUTINE integrate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -879,290 +879,290 @@ SUBROUTINE integrate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s(3) = grid(i, j2, k) s(4) = grid(i, j2, k2) DO lxp = 0, lp - coef_x(:, lxp) = coef_x(:, lxp)+s(:)*pol_x(lxp, ig) + coef_x(:, lxp) = coef_x(:, lxp) + s(:)*pol_x(lxp, ig) ENDDO END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 2)*pol_y(1, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 2)*pol_y(1, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 2)*pol_y(2, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 2)*pol_y(2, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(1, 3)*pol_y(1, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(2, 3)*pol_y(1, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(3, 3)*pol_y(2, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(4, 3)*pol_y(2, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(1, 4)*pol_y(1, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(2, 4)*pol_y(1, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(3, 4)*pol_y(2, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(4, 4)*pol_y(2, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(1, 5)*pol_y(1, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(2, 5)*pol_y(1, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(3, 5)*pol_y(2, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(4, 5)*pol_y(2, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(1, 6)*pol_y(1, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(2, 6)*pol_y(1, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(3, 6)*pol_y(2, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(4, 6)*pol_y(2, 0, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(4, 0)*pol_y(2, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(1, 1)*pol_y(1, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(2, 1)*pol_y(1, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(3, 1)*pol_y(2, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(4, 1)*pol_y(2, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(1, 2)*pol_y(1, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(2, 2)*pol_y(1, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(3, 2)*pol_y(2, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(4, 2)*pol_y(2, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(1, 3)*pol_y(1, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(2, 3)*pol_y(1, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(3, 3)*pol_y(2, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(4, 3)*pol_y(2, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(1, 4)*pol_y(1, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(2, 4)*pol_y(1, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(3, 4)*pol_y(2, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(4, 4)*pol_y(2, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(1, 5)*pol_y(1, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(2, 5)*pol_y(1, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(3, 5)*pol_y(2, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(4, 5)*pol_y(2, 1, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(1, 0)*pol_y(1, 2, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(2, 0)*pol_y(1, 2, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(3, 0)*pol_y(2, 2, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(4, 0)*pol_y(2, 2, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(1, 1)*pol_y(1, 2, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(2, 1)*pol_y(1, 2, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(3, 1)*pol_y(2, 2, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(4, 1)*pol_y(2, 2, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(1, 2)*pol_y(1, 2, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(2, 2)*pol_y(1, 2, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(3, 2)*pol_y(2, 2, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(4, 2)*pol_y(2, 2, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(1, 3)*pol_y(1, 2, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(2, 3)*pol_y(1, 2, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(3, 3)*pol_y(2, 2, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(4, 3)*pol_y(2, 2, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(1, 4)*pol_y(1, 2, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(2, 4)*pol_y(1, 2, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(3, 4)*pol_y(2, 2, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(4, 4)*pol_y(2, 2, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(1, 0)*pol_y(1, 3, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(2, 0)*pol_y(1, 3, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(3, 0)*pol_y(2, 3, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(4, 0)*pol_y(2, 3, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(1, 1)*pol_y(1, 3, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(2, 1)*pol_y(1, 3, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(3, 1)*pol_y(2, 3, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(4, 1)*pol_y(2, 3, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(1, 2)*pol_y(1, 3, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(2, 2)*pol_y(1, 3, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(3, 2)*pol_y(2, 3, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(4, 2)*pol_y(2, 3, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(1, 3)*pol_y(1, 3, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(2, 3)*pol_y(1, 3, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(3, 3)*pol_y(2, 3, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(4, 3)*pol_y(2, 3, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(1, 0)*pol_y(1, 4, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(2, 0)*pol_y(1, 4, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(3, 0)*pol_y(2, 4, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(4, 0)*pol_y(2, 4, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(1, 1)*pol_y(1, 4, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(2, 1)*pol_y(1, 4, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(3, 1)*pol_y(2, 4, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(4, 1)*pol_y(2, 4, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(1, 2)*pol_y(1, 4, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(2, 2)*pol_y(1, 4, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(3, 2)*pol_y(2, 4, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(4, 2)*pol_y(2, 4, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(1, 0)*pol_y(1, 5, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(2, 0)*pol_y(1, 5, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(3, 0)*pol_y(2, 5, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(4, 0)*pol_y(2, 5, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(1, 1)*pol_y(1, 5, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(2, 1)*pol_y(1, 5, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(3, 1)*pol_y(2, 5, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(4, 1)*pol_y(2, 5, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(1, 0)*pol_y(1, 6, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(2, 0)*pol_y(1, 6, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(3, 0)*pol_y(2, 6, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(4, 0)*pol_y(2, 6, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 2)*pol_y(1, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 2)*pol_y(1, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 2)*pol_y(2, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 2)*pol_y(2, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(1, 3)*pol_y(1, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(2, 3)*pol_y(1, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(3, 3)*pol_y(2, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(4, 3)*pol_y(2, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(1, 4)*pol_y(1, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(2, 4)*pol_y(1, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(3, 4)*pol_y(2, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(4, 4)*pol_y(2, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(1, 5)*pol_y(1, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(2, 5)*pol_y(1, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(3, 5)*pol_y(2, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(4, 5)*pol_y(2, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(1, 6)*pol_y(1, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(2, 6)*pol_y(1, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(3, 6)*pol_y(2, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(4, 6)*pol_y(2, 0, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(1, 1)*pol_y(1, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(2, 1)*pol_y(1, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(3, 1)*pol_y(2, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(4, 1)*pol_y(2, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(1, 2)*pol_y(1, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(2, 2)*pol_y(1, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(3, 2)*pol_y(2, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(4, 2)*pol_y(2, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(1, 3)*pol_y(1, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(2, 3)*pol_y(1, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(3, 3)*pol_y(2, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(4, 3)*pol_y(2, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(1, 4)*pol_y(1, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(2, 4)*pol_y(1, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(3, 4)*pol_y(2, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(4, 4)*pol_y(2, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(1, 5)*pol_y(1, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(2, 5)*pol_y(1, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(3, 5)*pol_y(2, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(4, 5)*pol_y(2, 1, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(1, 0)*pol_y(1, 2, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(2, 0)*pol_y(1, 2, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(3, 0)*pol_y(2, 2, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(4, 0)*pol_y(2, 2, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(1, 1)*pol_y(1, 2, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(2, 1)*pol_y(1, 2, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(3, 1)*pol_y(2, 2, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(4, 1)*pol_y(2, 2, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(1, 2)*pol_y(1, 2, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(2, 2)*pol_y(1, 2, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(3, 2)*pol_y(2, 2, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(4, 2)*pol_y(2, 2, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(1, 3)*pol_y(1, 2, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(2, 3)*pol_y(1, 2, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(3, 3)*pol_y(2, 2, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(4, 3)*pol_y(2, 2, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(1, 4)*pol_y(1, 2, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(2, 4)*pol_y(1, 2, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(3, 4)*pol_y(2, 2, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(4, 4)*pol_y(2, 2, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(1, 0)*pol_y(1, 3, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(2, 0)*pol_y(1, 3, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(3, 0)*pol_y(2, 3, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(4, 0)*pol_y(2, 3, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(1, 1)*pol_y(1, 3, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(2, 1)*pol_y(1, 3, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(3, 1)*pol_y(2, 3, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(4, 1)*pol_y(2, 3, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(1, 2)*pol_y(1, 3, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(2, 2)*pol_y(1, 3, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(3, 2)*pol_y(2, 3, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(4, 2)*pol_y(2, 3, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(1, 3)*pol_y(1, 3, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(2, 3)*pol_y(1, 3, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(3, 3)*pol_y(2, 3, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(4, 3)*pol_y(2, 3, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(1, 0)*pol_y(1, 4, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(2, 0)*pol_y(1, 4, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(3, 0)*pol_y(2, 4, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(4, 0)*pol_y(2, 4, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(1, 1)*pol_y(1, 4, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(2, 1)*pol_y(1, 4, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(3, 1)*pol_y(2, 4, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(4, 1)*pol_y(2, 4, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(1, 2)*pol_y(1, 4, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(2, 2)*pol_y(1, 4, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(3, 2)*pol_y(2, 4, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(4, 2)*pol_y(2, 4, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(1, 0)*pol_y(1, 5, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(2, 0)*pol_y(1, 5, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(3, 0)*pol_y(2, 5, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(4, 0)*pol_y(2, 5, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(1, 1)*pol_y(1, 5, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(2, 1)*pol_y(1, 5, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(3, 1)*pol_y(2, 5, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(4, 1)*pol_y(2, 5, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(1, 0)*pol_y(1, 6, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(2, 0)*pol_y(1, 6, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(3, 0)*pol_y(2, 6, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(4, 0)*pol_y(2, 6, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 11)*pol_z(1, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 11)*pol_z(2, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 12)*pol_z(1, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 12)*pol_z(2, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 13)*pol_z(1, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 13)*pol_z(2, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 14)*pol_z(1, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 14)*pol_z(2, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 15)*pol_z(1, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 15)*pol_z(2, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 16)*pol_z(1, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 16)*pol_z(2, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 17)*pol_z(1, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 17)*pol_z(2, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 18)*pol_z(1, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 18)*pol_z(2, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 19)*pol_z(1, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 19)*pol_z(2, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 20)*pol_z(1, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 20)*pol_z(2, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(1, 21)*pol_z(1, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(2, 21)*pol_z(2, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(1, 22)*pol_z(1, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(2, 22)*pol_z(2, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(1, 23)*pol_z(1, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(2, 23)*pol_z(2, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(1, 24)*pol_z(1, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(2, 24)*pol_z(2, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(1, 25)*pol_z(1, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(2, 25)*pol_z(2, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(1, 26)*pol_z(1, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(2, 26)*pol_z(2, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(1, 27)*pol_z(1, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(2, 27)*pol_z(2, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(1, 28)*pol_z(1, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(2, 28)*pol_z(2, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(1, 5)*pol_z(1, 1, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(2, 5)*pol_z(2, 1, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(1, 8)*pol_z(1, 1, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(2, 8)*pol_z(2, 1, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(1, 9)*pol_z(1, 1, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(2, 9)*pol_z(2, 1, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(1, 10)*pol_z(1, 1, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(2, 10)*pol_z(2, 1, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(1, 11)*pol_z(1, 1, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(2, 11)*pol_z(2, 1, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(1, 12)*pol_z(1, 1, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(2, 12)*pol_z(2, 1, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(1, 14)*pol_z(1, 1, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(2, 14)*pol_z(2, 1, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(1, 15)*pol_z(1, 1, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(2, 15)*pol_z(2, 1, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(1, 16)*pol_z(1, 1, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(2, 16)*pol_z(2, 1, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(1, 17)*pol_z(1, 1, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(2, 17)*pol_z(2, 1, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(1, 19)*pol_z(1, 1, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(2, 19)*pol_z(2, 1, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(1, 20)*pol_z(1, 1, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(2, 20)*pol_z(2, 1, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(1, 21)*pol_z(1, 1, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(2, 21)*pol_z(2, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(1, 23)*pol_z(1, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(2, 23)*pol_z(2, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(1, 24)*pol_z(1, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(2, 24)*pol_z(2, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(1, 26)*pol_z(1, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(2, 26)*pol_z(2, 1, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(1, 3)*pol_z(1, 2, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(2, 3)*pol_z(2, 2, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(1, 4)*pol_z(1, 2, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(2, 4)*pol_z(2, 2, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(1, 5)*pol_z(1, 2, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(2, 5)*pol_z(2, 2, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(1, 8)*pol_z(1, 2, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(2, 8)*pol_z(2, 2, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(1, 9)*pol_z(1, 2, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(2, 9)*pol_z(2, 2, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(1, 10)*pol_z(1, 2, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(2, 10)*pol_z(2, 2, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(1, 11)*pol_z(1, 2, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(2, 11)*pol_z(2, 2, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(1, 14)*pol_z(1, 2, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(2, 14)*pol_z(2, 2, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(1, 15)*pol_z(1, 2, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(2, 15)*pol_z(2, 2, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(1, 16)*pol_z(1, 2, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(2, 16)*pol_z(2, 2, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(1, 19)*pol_z(1, 2, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(2, 19)*pol_z(2, 2, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(1, 20)*pol_z(1, 2, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(2, 20)*pol_z(2, 2, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(1, 23)*pol_z(1, 2, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(2, 23)*pol_z(2, 2, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(2, 1)*pol_z(2, 3, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(1, 2)*pol_z(1, 3, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(2, 2)*pol_z(2, 3, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(1, 3)*pol_z(1, 3, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(2, 3)*pol_z(2, 3, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(1, 4)*pol_z(1, 3, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(2, 4)*pol_z(2, 3, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(1, 8)*pol_z(1, 3, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(2, 8)*pol_z(2, 3, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(1, 9)*pol_z(1, 3, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(2, 9)*pol_z(2, 3, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(1, 10)*pol_z(1, 3, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(2, 10)*pol_z(2, 3, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(1, 14)*pol_z(1, 3, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(2, 14)*pol_z(2, 3, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(1, 15)*pol_z(1, 3, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(2, 15)*pol_z(2, 3, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(1, 19)*pol_z(1, 3, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(2, 19)*pol_z(2, 3, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(1, 1)*pol_z(1, 4, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(2, 1)*pol_z(2, 4, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(1, 2)*pol_z(1, 4, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(2, 2)*pol_z(2, 4, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(1, 3)*pol_z(1, 4, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(2, 3)*pol_z(2, 4, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(1, 8)*pol_z(1, 4, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(2, 8)*pol_z(2, 4, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(1, 9)*pol_z(1, 4, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(2, 9)*pol_z(2, 4, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(1, 14)*pol_z(1, 4, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(2, 14)*pol_z(2, 4, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(1, 1)*pol_z(1, 5, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(2, 1)*pol_z(2, 5, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(1, 2)*pol_z(1, 5, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(2, 2)*pol_z(2, 5, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(1, 8)*pol_z(1, 5, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(2, 8)*pol_z(2, 5, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(1, 1)*pol_z(1, 6, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(2, 1)*pol_z(2, 6, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 11)*pol_z(1, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 11)*pol_z(2, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 12)*pol_z(1, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 12)*pol_z(2, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 13)*pol_z(1, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 13)*pol_z(2, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 14)*pol_z(1, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 14)*pol_z(2, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 15)*pol_z(1, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 15)*pol_z(2, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 16)*pol_z(1, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 16)*pol_z(2, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 17)*pol_z(1, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 17)*pol_z(2, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 18)*pol_z(1, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 18)*pol_z(2, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 19)*pol_z(1, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 19)*pol_z(2, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 20)*pol_z(1, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 20)*pol_z(2, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(1, 21)*pol_z(1, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(2, 21)*pol_z(2, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(1, 22)*pol_z(1, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(2, 22)*pol_z(2, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(1, 23)*pol_z(1, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(2, 23)*pol_z(2, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(1, 24)*pol_z(1, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(2, 24)*pol_z(2, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(1, 25)*pol_z(1, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(2, 25)*pol_z(2, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(1, 26)*pol_z(1, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(2, 26)*pol_z(2, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(1, 27)*pol_z(1, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(2, 27)*pol_z(2, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(1, 28)*pol_z(1, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(2, 28)*pol_z(2, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(1, 5)*pol_z(1, 1, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(2, 5)*pol_z(2, 1, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(1, 8)*pol_z(1, 1, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(2, 8)*pol_z(2, 1, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(1, 9)*pol_z(1, 1, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(2, 9)*pol_z(2, 1, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(1, 10)*pol_z(1, 1, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(2, 10)*pol_z(2, 1, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(1, 11)*pol_z(1, 1, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(2, 11)*pol_z(2, 1, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(1, 12)*pol_z(1, 1, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(2, 12)*pol_z(2, 1, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(1, 14)*pol_z(1, 1, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(2, 14)*pol_z(2, 1, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(1, 15)*pol_z(1, 1, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(2, 15)*pol_z(2, 1, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(1, 16)*pol_z(1, 1, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(2, 16)*pol_z(2, 1, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(1, 17)*pol_z(1, 1, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(2, 17)*pol_z(2, 1, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(1, 19)*pol_z(1, 1, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(2, 19)*pol_z(2, 1, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(1, 20)*pol_z(1, 1, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(2, 20)*pol_z(2, 1, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(1, 21)*pol_z(1, 1, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(2, 21)*pol_z(2, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(1, 23)*pol_z(1, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(2, 23)*pol_z(2, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(1, 24)*pol_z(1, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(2, 24)*pol_z(2, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(1, 26)*pol_z(1, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(2, 26)*pol_z(2, 1, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(1, 3)*pol_z(1, 2, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(2, 3)*pol_z(2, 2, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(1, 4)*pol_z(1, 2, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(2, 4)*pol_z(2, 2, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(1, 5)*pol_z(1, 2, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(2, 5)*pol_z(2, 2, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(1, 8)*pol_z(1, 2, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(2, 8)*pol_z(2, 2, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(1, 9)*pol_z(1, 2, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(2, 9)*pol_z(2, 2, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(1, 10)*pol_z(1, 2, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(2, 10)*pol_z(2, 2, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(1, 11)*pol_z(1, 2, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(2, 11)*pol_z(2, 2, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(1, 14)*pol_z(1, 2, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(2, 14)*pol_z(2, 2, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(1, 15)*pol_z(1, 2, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(2, 15)*pol_z(2, 2, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(1, 16)*pol_z(1, 2, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(2, 16)*pol_z(2, 2, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(1, 19)*pol_z(1, 2, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(2, 19)*pol_z(2, 2, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(1, 20)*pol_z(1, 2, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(2, 20)*pol_z(2, 2, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(1, 23)*pol_z(1, 2, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(2, 23)*pol_z(2, 2, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(1, 2)*pol_z(1, 3, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(2, 2)*pol_z(2, 3, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(1, 3)*pol_z(1, 3, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(2, 3)*pol_z(2, 3, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(1, 4)*pol_z(1, 3, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(2, 4)*pol_z(2, 3, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(1, 8)*pol_z(1, 3, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(2, 8)*pol_z(2, 3, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(1, 9)*pol_z(1, 3, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(2, 9)*pol_z(2, 3, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(1, 10)*pol_z(1, 3, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(2, 10)*pol_z(2, 3, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(1, 14)*pol_z(1, 3, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(2, 14)*pol_z(2, 3, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(1, 15)*pol_z(1, 3, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(2, 15)*pol_z(2, 3, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(1, 19)*pol_z(1, 3, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(2, 19)*pol_z(2, 3, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(1, 1)*pol_z(1, 4, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(2, 1)*pol_z(2, 4, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(1, 2)*pol_z(1, 4, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(2, 2)*pol_z(2, 4, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(1, 3)*pol_z(1, 4, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(2, 3)*pol_z(2, 4, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(1, 8)*pol_z(1, 4, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(2, 8)*pol_z(2, 4, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(1, 9)*pol_z(1, 4, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(2, 9)*pol_z(2, 4, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(1, 14)*pol_z(1, 4, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(2, 14)*pol_z(2, 4, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(1, 1)*pol_z(1, 5, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(2, 1)*pol_z(2, 5, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(1, 2)*pol_z(1, 5, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(2, 2)*pol_z(2, 5, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(1, 8)*pol_z(1, 5, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(2, 8)*pol_z(2, 5, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(1, 1)*pol_z(1, 6, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(2, 1)*pol_z(2, 6, kg) END DO END SUBROUTINE integrate_core_6 @@ -1189,14 +1189,14 @@ SUBROUTINE integrate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -1204,23 +1204,23 @@ SUBROUTINE integrate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -1230,95 +1230,95 @@ SUBROUTINE integrate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(1:2, 1)*pol_y(1, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(3:4, 1)*pol_y(2, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(1:2, 2)*pol_y(1, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(3:4, 2)*pol_y(2, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(1:2, 3)*pol_y(1, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(3:4, 3)*pol_y(2, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(1:2, 4)*pol_y(1, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(3:4, 4)*pol_y(2, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(1:2, 5)*pol_y(1, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(3:4, 5)*pol_y(2, 0, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(1:2, 6)*pol_y(1, 0, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(3:4, 6)*pol_y(2, 0, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(1:2, 7)*pol_y(1, 0, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(3:4, 7)*pol_y(2, 0, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(1:2, 0)*pol_y(1, 1, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(3:4, 0)*pol_y(2, 1, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(1:2, 1)*pol_y(1, 1, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(3:4, 1)*pol_y(2, 1, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(1:2, 2)*pol_y(1, 1, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(3:4, 2)*pol_y(2, 1, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(1:2, 3)*pol_y(1, 1, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(3:4, 3)*pol_y(2, 1, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(1:2, 4)*pol_y(1, 1, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(3:4, 4)*pol_y(2, 1, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(1:2, 5)*pol_y(1, 1, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(3:4, 5)*pol_y(2, 1, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(1:2, 6)*pol_y(1, 1, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(3:4, 6)*pol_y(2, 1, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(1:2, 0)*pol_y(1, 2, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(3:4, 0)*pol_y(2, 2, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(1:2, 1)*pol_y(1, 2, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(3:4, 1)*pol_y(2, 2, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(1:2, 2)*pol_y(1, 2, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(3:4, 2)*pol_y(2, 2, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(1:2, 3)*pol_y(1, 2, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(3:4, 3)*pol_y(2, 2, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(1:2, 4)*pol_y(1, 2, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(3:4, 4)*pol_y(2, 2, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(1:2, 5)*pol_y(1, 2, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(3:4, 5)*pol_y(2, 2, jg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_x(1:2, 0)*pol_y(1, 3, jg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_x(3:4, 0)*pol_y(2, 3, jg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_x(1:2, 1)*pol_y(1, 3, jg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_x(3:4, 1)*pol_y(2, 3, jg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_x(1:2, 2)*pol_y(1, 3, jg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_x(3:4, 2)*pol_y(2, 3, jg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_x(1:2, 3)*pol_y(1, 3, jg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_x(3:4, 3)*pol_y(2, 3, jg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_x(1:2, 4)*pol_y(1, 3, jg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_x(3:4, 4)*pol_y(2, 3, jg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_x(1:2, 0)*pol_y(1, 4, jg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_x(3:4, 0)*pol_y(2, 4, jg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_x(1:2, 1)*pol_y(1, 4, jg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_x(3:4, 1)*pol_y(2, 4, jg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_x(1:2, 2)*pol_y(1, 4, jg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_x(3:4, 2)*pol_y(2, 4, jg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_x(1:2, 3)*pol_y(1, 4, jg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_x(3:4, 3)*pol_y(2, 4, jg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_x(1:2, 0)*pol_y(1, 5, jg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_x(3:4, 0)*pol_y(2, 5, jg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_x(1:2, 1)*pol_y(1, 5, jg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_x(3:4, 1)*pol_y(2, 5, jg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_x(1:2, 2)*pol_y(1, 5, jg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_x(3:4, 2)*pol_y(2, 5, jg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_x(1:2, 0)*pol_y(1, 6, jg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_x(3:4, 0)*pol_y(2, 6, jg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_x(1:2, 1)*pol_y(1, 6, jg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_x(3:4, 1)*pol_y(2, 6, jg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_x(1:2, 0)*pol_y(1, 7, jg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_x(3:4, 0)*pol_y(2, 7, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(1:2, 1)*pol_y(1, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(3:4, 1)*pol_y(2, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(1:2, 2)*pol_y(1, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(3:4, 2)*pol_y(2, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(1:2, 3)*pol_y(1, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(3:4, 3)*pol_y(2, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(1:2, 4)*pol_y(1, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(3:4, 4)*pol_y(2, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(1:2, 5)*pol_y(1, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(3:4, 5)*pol_y(2, 0, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(1:2, 6)*pol_y(1, 0, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(3:4, 6)*pol_y(2, 0, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(1:2, 7)*pol_y(1, 0, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(3:4, 7)*pol_y(2, 0, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(1:2, 0)*pol_y(1, 1, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(3:4, 0)*pol_y(2, 1, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(1:2, 1)*pol_y(1, 1, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(3:4, 1)*pol_y(2, 1, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(1:2, 2)*pol_y(1, 1, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(3:4, 2)*pol_y(2, 1, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(1:2, 3)*pol_y(1, 1, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(3:4, 3)*pol_y(2, 1, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(1:2, 4)*pol_y(1, 1, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(3:4, 4)*pol_y(2, 1, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(1:2, 5)*pol_y(1, 1, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(3:4, 5)*pol_y(2, 1, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(1:2, 6)*pol_y(1, 1, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(3:4, 6)*pol_y(2, 1, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(1:2, 0)*pol_y(1, 2, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(3:4, 0)*pol_y(2, 2, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(1:2, 1)*pol_y(1, 2, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(3:4, 1)*pol_y(2, 2, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(1:2, 2)*pol_y(1, 2, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(3:4, 2)*pol_y(2, 2, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(1:2, 3)*pol_y(1, 2, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(3:4, 3)*pol_y(2, 2, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(1:2, 4)*pol_y(1, 2, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(3:4, 4)*pol_y(2, 2, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(1:2, 5)*pol_y(1, 2, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(3:4, 5)*pol_y(2, 2, jg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_x(1:2, 0)*pol_y(1, 3, jg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_x(3:4, 0)*pol_y(2, 3, jg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_x(1:2, 1)*pol_y(1, 3, jg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_x(3:4, 1)*pol_y(2, 3, jg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_x(1:2, 2)*pol_y(1, 3, jg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_x(3:4, 2)*pol_y(2, 3, jg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_x(1:2, 3)*pol_y(1, 3, jg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_x(3:4, 3)*pol_y(2, 3, jg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_x(1:2, 4)*pol_y(1, 3, jg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_x(3:4, 4)*pol_y(2, 3, jg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_x(1:2, 0)*pol_y(1, 4, jg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_x(3:4, 0)*pol_y(2, 4, jg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_x(1:2, 1)*pol_y(1, 4, jg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_x(3:4, 1)*pol_y(2, 4, jg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_x(1:2, 2)*pol_y(1, 4, jg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_x(3:4, 2)*pol_y(2, 4, jg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_x(1:2, 3)*pol_y(1, 4, jg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_x(3:4, 3)*pol_y(2, 4, jg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_x(1:2, 0)*pol_y(1, 5, jg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_x(3:4, 0)*pol_y(2, 5, jg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_x(1:2, 1)*pol_y(1, 5, jg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_x(3:4, 1)*pol_y(2, 5, jg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_x(1:2, 2)*pol_y(1, 5, jg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_x(3:4, 2)*pol_y(2, 5, jg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_x(1:2, 0)*pol_y(1, 6, jg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_x(3:4, 0)*pol_y(2, 6, jg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_x(1:2, 1)*pol_y(1, 6, jg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_x(3:4, 1)*pol_y(2, 6, jg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_x(1:2, 0)*pol_y(1, 7, jg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_x(3:4, 0)*pol_y(2, 7, jg) END DO lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(1, lxy)*pol_z(1, lzp, kg) - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(2, lxy)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(1, lxy)*pol_z(1, lzp, kg) + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(2, lxy)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO END DO @@ -1347,14 +1347,14 @@ SUBROUTINE integrate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -1362,23 +1362,23 @@ SUBROUTINE integrate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -1388,113 +1388,113 @@ SUBROUTINE integrate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(1:2, 1)*pol_y(1, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(3:4, 1)*pol_y(2, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(1:2, 2)*pol_y(1, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(3:4, 2)*pol_y(2, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(1:2, 3)*pol_y(1, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(3:4, 3)*pol_y(2, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(1:2, 4)*pol_y(1, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(3:4, 4)*pol_y(2, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(1:2, 5)*pol_y(1, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(3:4, 5)*pol_y(2, 0, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(1:2, 6)*pol_y(1, 0, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(3:4, 6)*pol_y(2, 0, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(1:2, 7)*pol_y(1, 0, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(3:4, 7)*pol_y(2, 0, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(1:2, 8)*pol_y(1, 0, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(3:4, 8)*pol_y(2, 0, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(1:2, 0)*pol_y(1, 1, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(3:4, 0)*pol_y(2, 1, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(1:2, 1)*pol_y(1, 1, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(3:4, 1)*pol_y(2, 1, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(1:2, 2)*pol_y(1, 1, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(3:4, 2)*pol_y(2, 1, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(1:2, 3)*pol_y(1, 1, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(3:4, 3)*pol_y(2, 1, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(1:2, 4)*pol_y(1, 1, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(3:4, 4)*pol_y(2, 1, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(1:2, 5)*pol_y(1, 1, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(3:4, 5)*pol_y(2, 1, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(1:2, 6)*pol_y(1, 1, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(3:4, 6)*pol_y(2, 1, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(1:2, 7)*pol_y(1, 1, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(3:4, 7)*pol_y(2, 1, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(1:2, 0)*pol_y(1, 2, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(3:4, 0)*pol_y(2, 2, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(1:2, 1)*pol_y(1, 2, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(3:4, 1)*pol_y(2, 2, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(1:2, 2)*pol_y(1, 2, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(3:4, 2)*pol_y(2, 2, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(1:2, 3)*pol_y(1, 2, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(3:4, 3)*pol_y(2, 2, jg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_x(1:2, 4)*pol_y(1, 2, jg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_x(3:4, 4)*pol_y(2, 2, jg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_x(1:2, 5)*pol_y(1, 2, jg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_x(3:4, 5)*pol_y(2, 2, jg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_x(1:2, 6)*pol_y(1, 2, jg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_x(3:4, 6)*pol_y(2, 2, jg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_x(1:2, 0)*pol_y(1, 3, jg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_x(3:4, 0)*pol_y(2, 3, jg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_x(1:2, 1)*pol_y(1, 3, jg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_x(3:4, 1)*pol_y(2, 3, jg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_x(1:2, 2)*pol_y(1, 3, jg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_x(3:4, 2)*pol_y(2, 3, jg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_x(1:2, 3)*pol_y(1, 3, jg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_x(3:4, 3)*pol_y(2, 3, jg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_x(1:2, 4)*pol_y(1, 3, jg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_x(3:4, 4)*pol_y(2, 3, jg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_x(1:2, 5)*pol_y(1, 3, jg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_x(3:4, 5)*pol_y(2, 3, jg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_x(1:2, 0)*pol_y(1, 4, jg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_x(3:4, 0)*pol_y(2, 4, jg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_x(1:2, 1)*pol_y(1, 4, jg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_x(3:4, 1)*pol_y(2, 4, jg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_x(1:2, 2)*pol_y(1, 4, jg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_x(3:4, 2)*pol_y(2, 4, jg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_x(1:2, 3)*pol_y(1, 4, jg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_x(3:4, 3)*pol_y(2, 4, jg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_x(1:2, 4)*pol_y(1, 4, jg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_x(3:4, 4)*pol_y(2, 4, jg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_x(1:2, 0)*pol_y(1, 5, jg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_x(3:4, 0)*pol_y(2, 5, jg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_x(1:2, 1)*pol_y(1, 5, jg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_x(3:4, 1)*pol_y(2, 5, jg) - coef_xy(:, 38) = coef_xy(:, 38)+coef_x(1:2, 2)*pol_y(1, 5, jg) - coef_xy(:, 38) = coef_xy(:, 38)+coef_x(3:4, 2)*pol_y(2, 5, jg) - coef_xy(:, 39) = coef_xy(:, 39)+coef_x(1:2, 3)*pol_y(1, 5, jg) - coef_xy(:, 39) = coef_xy(:, 39)+coef_x(3:4, 3)*pol_y(2, 5, jg) - coef_xy(:, 40) = coef_xy(:, 40)+coef_x(1:2, 0)*pol_y(1, 6, jg) - coef_xy(:, 40) = coef_xy(:, 40)+coef_x(3:4, 0)*pol_y(2, 6, jg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_x(1:2, 1)*pol_y(1, 6, jg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_x(3:4, 1)*pol_y(2, 6, jg) - coef_xy(:, 42) = coef_xy(:, 42)+coef_x(1:2, 2)*pol_y(1, 6, jg) - coef_xy(:, 42) = coef_xy(:, 42)+coef_x(3:4, 2)*pol_y(2, 6, jg) - coef_xy(:, 43) = coef_xy(:, 43)+coef_x(1:2, 0)*pol_y(1, 7, jg) - coef_xy(:, 43) = coef_xy(:, 43)+coef_x(3:4, 0)*pol_y(2, 7, jg) - coef_xy(:, 44) = coef_xy(:, 44)+coef_x(1:2, 1)*pol_y(1, 7, jg) - coef_xy(:, 44) = coef_xy(:, 44)+coef_x(3:4, 1)*pol_y(2, 7, jg) - coef_xy(:, 45) = coef_xy(:, 45)+coef_x(1:2, 0)*pol_y(1, 8, jg) - coef_xy(:, 45) = coef_xy(:, 45)+coef_x(3:4, 0)*pol_y(2, 8, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(1:2, 1)*pol_y(1, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(3:4, 1)*pol_y(2, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(1:2, 2)*pol_y(1, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(3:4, 2)*pol_y(2, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(1:2, 3)*pol_y(1, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(3:4, 3)*pol_y(2, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(1:2, 4)*pol_y(1, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(3:4, 4)*pol_y(2, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(1:2, 5)*pol_y(1, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(3:4, 5)*pol_y(2, 0, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(1:2, 6)*pol_y(1, 0, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(3:4, 6)*pol_y(2, 0, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(1:2, 7)*pol_y(1, 0, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(3:4, 7)*pol_y(2, 0, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(1:2, 8)*pol_y(1, 0, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(3:4, 8)*pol_y(2, 0, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(1:2, 0)*pol_y(1, 1, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(3:4, 0)*pol_y(2, 1, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(1:2, 1)*pol_y(1, 1, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(3:4, 1)*pol_y(2, 1, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(1:2, 2)*pol_y(1, 1, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(3:4, 2)*pol_y(2, 1, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(1:2, 3)*pol_y(1, 1, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(3:4, 3)*pol_y(2, 1, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(1:2, 4)*pol_y(1, 1, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(3:4, 4)*pol_y(2, 1, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(1:2, 5)*pol_y(1, 1, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(3:4, 5)*pol_y(2, 1, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(1:2, 6)*pol_y(1, 1, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(3:4, 6)*pol_y(2, 1, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(1:2, 7)*pol_y(1, 1, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(3:4, 7)*pol_y(2, 1, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(1:2, 0)*pol_y(1, 2, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(3:4, 0)*pol_y(2, 2, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(1:2, 1)*pol_y(1, 2, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(3:4, 1)*pol_y(2, 2, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(1:2, 2)*pol_y(1, 2, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(3:4, 2)*pol_y(2, 2, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(1:2, 3)*pol_y(1, 2, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(3:4, 3)*pol_y(2, 2, jg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_x(1:2, 4)*pol_y(1, 2, jg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_x(3:4, 4)*pol_y(2, 2, jg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_x(1:2, 5)*pol_y(1, 2, jg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_x(3:4, 5)*pol_y(2, 2, jg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_x(1:2, 6)*pol_y(1, 2, jg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_x(3:4, 6)*pol_y(2, 2, jg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_x(1:2, 0)*pol_y(1, 3, jg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_x(3:4, 0)*pol_y(2, 3, jg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_x(1:2, 1)*pol_y(1, 3, jg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_x(3:4, 1)*pol_y(2, 3, jg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_x(1:2, 2)*pol_y(1, 3, jg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_x(3:4, 2)*pol_y(2, 3, jg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_x(1:2, 3)*pol_y(1, 3, jg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_x(3:4, 3)*pol_y(2, 3, jg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_x(1:2, 4)*pol_y(1, 3, jg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_x(3:4, 4)*pol_y(2, 3, jg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_x(1:2, 5)*pol_y(1, 3, jg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_x(3:4, 5)*pol_y(2, 3, jg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_x(1:2, 0)*pol_y(1, 4, jg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_x(3:4, 0)*pol_y(2, 4, jg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_x(1:2, 1)*pol_y(1, 4, jg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_x(3:4, 1)*pol_y(2, 4, jg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_x(1:2, 2)*pol_y(1, 4, jg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_x(3:4, 2)*pol_y(2, 4, jg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_x(1:2, 3)*pol_y(1, 4, jg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_x(3:4, 3)*pol_y(2, 4, jg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_x(1:2, 4)*pol_y(1, 4, jg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_x(3:4, 4)*pol_y(2, 4, jg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_x(1:2, 0)*pol_y(1, 5, jg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_x(3:4, 0)*pol_y(2, 5, jg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_x(1:2, 1)*pol_y(1, 5, jg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_x(3:4, 1)*pol_y(2, 5, jg) + coef_xy(:, 38) = coef_xy(:, 38) + coef_x(1:2, 2)*pol_y(1, 5, jg) + coef_xy(:, 38) = coef_xy(:, 38) + coef_x(3:4, 2)*pol_y(2, 5, jg) + coef_xy(:, 39) = coef_xy(:, 39) + coef_x(1:2, 3)*pol_y(1, 5, jg) + coef_xy(:, 39) = coef_xy(:, 39) + coef_x(3:4, 3)*pol_y(2, 5, jg) + coef_xy(:, 40) = coef_xy(:, 40) + coef_x(1:2, 0)*pol_y(1, 6, jg) + coef_xy(:, 40) = coef_xy(:, 40) + coef_x(3:4, 0)*pol_y(2, 6, jg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_x(1:2, 1)*pol_y(1, 6, jg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_x(3:4, 1)*pol_y(2, 6, jg) + coef_xy(:, 42) = coef_xy(:, 42) + coef_x(1:2, 2)*pol_y(1, 6, jg) + coef_xy(:, 42) = coef_xy(:, 42) + coef_x(3:4, 2)*pol_y(2, 6, jg) + coef_xy(:, 43) = coef_xy(:, 43) + coef_x(1:2, 0)*pol_y(1, 7, jg) + coef_xy(:, 43) = coef_xy(:, 43) + coef_x(3:4, 0)*pol_y(2, 7, jg) + coef_xy(:, 44) = coef_xy(:, 44) + coef_x(1:2, 1)*pol_y(1, 7, jg) + coef_xy(:, 44) = coef_xy(:, 44) + coef_x(3:4, 1)*pol_y(2, 7, jg) + coef_xy(:, 45) = coef_xy(:, 45) + coef_x(1:2, 0)*pol_y(1, 8, jg) + coef_xy(:, 45) = coef_xy(:, 45) + coef_x(3:4, 0)*pol_y(2, 8, jg) END DO lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(1, lxy)*pol_z(1, lzp, kg) - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(2, lxy)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(1, lxy)*pol_z(1, lzp, kg) + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(2, lxy)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO END DO @@ -1523,14 +1523,14 @@ SUBROUTINE integrate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -1538,23 +1538,23 @@ SUBROUTINE integrate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -1564,133 +1564,133 @@ SUBROUTINE integrate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(1:2, 1)*pol_y(1, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(3:4, 1)*pol_y(2, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(1:2, 2)*pol_y(1, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(3:4, 2)*pol_y(2, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(1:2, 3)*pol_y(1, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(3:4, 3)*pol_y(2, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(1:2, 4)*pol_y(1, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(3:4, 4)*pol_y(2, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(1:2, 5)*pol_y(1, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(3:4, 5)*pol_y(2, 0, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(1:2, 6)*pol_y(1, 0, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(3:4, 6)*pol_y(2, 0, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(1:2, 7)*pol_y(1, 0, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(3:4, 7)*pol_y(2, 0, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(1:2, 8)*pol_y(1, 0, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(3:4, 8)*pol_y(2, 0, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(1:2, 9)*pol_y(1, 0, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(3:4, 9)*pol_y(2, 0, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(1:2, 0)*pol_y(1, 1, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(3:4, 0)*pol_y(2, 1, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(1:2, 1)*pol_y(1, 1, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(3:4, 1)*pol_y(2, 1, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(1:2, 2)*pol_y(1, 1, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(3:4, 2)*pol_y(2, 1, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(1:2, 3)*pol_y(1, 1, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(3:4, 3)*pol_y(2, 1, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(1:2, 4)*pol_y(1, 1, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(3:4, 4)*pol_y(2, 1, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(1:2, 5)*pol_y(1, 1, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(3:4, 5)*pol_y(2, 1, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(1:2, 6)*pol_y(1, 1, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(3:4, 6)*pol_y(2, 1, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(1:2, 7)*pol_y(1, 1, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(3:4, 7)*pol_y(2, 1, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(1:2, 8)*pol_y(1, 1, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(3:4, 8)*pol_y(2, 1, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(1:2, 0)*pol_y(1, 2, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(3:4, 0)*pol_y(2, 2, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(1:2, 1)*pol_y(1, 2, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(3:4, 1)*pol_y(2, 2, jg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_x(1:2, 2)*pol_y(1, 2, jg) - coef_xy(:, 22) = coef_xy(:, 22)+coef_x(3:4, 2)*pol_y(2, 2, jg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_x(1:2, 3)*pol_y(1, 2, jg) - coef_xy(:, 23) = coef_xy(:, 23)+coef_x(3:4, 3)*pol_y(2, 2, jg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_x(1:2, 4)*pol_y(1, 2, jg) - coef_xy(:, 24) = coef_xy(:, 24)+coef_x(3:4, 4)*pol_y(2, 2, jg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_x(1:2, 5)*pol_y(1, 2, jg) - coef_xy(:, 25) = coef_xy(:, 25)+coef_x(3:4, 5)*pol_y(2, 2, jg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_x(1:2, 6)*pol_y(1, 2, jg) - coef_xy(:, 26) = coef_xy(:, 26)+coef_x(3:4, 6)*pol_y(2, 2, jg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_x(1:2, 7)*pol_y(1, 2, jg) - coef_xy(:, 27) = coef_xy(:, 27)+coef_x(3:4, 7)*pol_y(2, 2, jg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_x(1:2, 0)*pol_y(1, 3, jg) - coef_xy(:, 28) = coef_xy(:, 28)+coef_x(3:4, 0)*pol_y(2, 3, jg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_x(1:2, 1)*pol_y(1, 3, jg) - coef_xy(:, 29) = coef_xy(:, 29)+coef_x(3:4, 1)*pol_y(2, 3, jg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_x(1:2, 2)*pol_y(1, 3, jg) - coef_xy(:, 30) = coef_xy(:, 30)+coef_x(3:4, 2)*pol_y(2, 3, jg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_x(1:2, 3)*pol_y(1, 3, jg) - coef_xy(:, 31) = coef_xy(:, 31)+coef_x(3:4, 3)*pol_y(2, 3, jg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_x(1:2, 4)*pol_y(1, 3, jg) - coef_xy(:, 32) = coef_xy(:, 32)+coef_x(3:4, 4)*pol_y(2, 3, jg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_x(1:2, 5)*pol_y(1, 3, jg) - coef_xy(:, 33) = coef_xy(:, 33)+coef_x(3:4, 5)*pol_y(2, 3, jg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_x(1:2, 6)*pol_y(1, 3, jg) - coef_xy(:, 34) = coef_xy(:, 34)+coef_x(3:4, 6)*pol_y(2, 3, jg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_x(1:2, 0)*pol_y(1, 4, jg) - coef_xy(:, 35) = coef_xy(:, 35)+coef_x(3:4, 0)*pol_y(2, 4, jg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_x(1:2, 1)*pol_y(1, 4, jg) - coef_xy(:, 36) = coef_xy(:, 36)+coef_x(3:4, 1)*pol_y(2, 4, jg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_x(1:2, 2)*pol_y(1, 4, jg) - coef_xy(:, 37) = coef_xy(:, 37)+coef_x(3:4, 2)*pol_y(2, 4, jg) - coef_xy(:, 38) = coef_xy(:, 38)+coef_x(1:2, 3)*pol_y(1, 4, jg) - coef_xy(:, 38) = coef_xy(:, 38)+coef_x(3:4, 3)*pol_y(2, 4, jg) - coef_xy(:, 39) = coef_xy(:, 39)+coef_x(1:2, 4)*pol_y(1, 4, jg) - coef_xy(:, 39) = coef_xy(:, 39)+coef_x(3:4, 4)*pol_y(2, 4, jg) - coef_xy(:, 40) = coef_xy(:, 40)+coef_x(1:2, 5)*pol_y(1, 4, jg) - coef_xy(:, 40) = coef_xy(:, 40)+coef_x(3:4, 5)*pol_y(2, 4, jg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_x(1:2, 0)*pol_y(1, 5, jg) - coef_xy(:, 41) = coef_xy(:, 41)+coef_x(3:4, 0)*pol_y(2, 5, jg) - coef_xy(:, 42) = coef_xy(:, 42)+coef_x(1:2, 1)*pol_y(1, 5, jg) - coef_xy(:, 42) = coef_xy(:, 42)+coef_x(3:4, 1)*pol_y(2, 5, jg) - coef_xy(:, 43) = coef_xy(:, 43)+coef_x(1:2, 2)*pol_y(1, 5, jg) - coef_xy(:, 43) = coef_xy(:, 43)+coef_x(3:4, 2)*pol_y(2, 5, jg) - coef_xy(:, 44) = coef_xy(:, 44)+coef_x(1:2, 3)*pol_y(1, 5, jg) - coef_xy(:, 44) = coef_xy(:, 44)+coef_x(3:4, 3)*pol_y(2, 5, jg) - coef_xy(:, 45) = coef_xy(:, 45)+coef_x(1:2, 4)*pol_y(1, 5, jg) - coef_xy(:, 45) = coef_xy(:, 45)+coef_x(3:4, 4)*pol_y(2, 5, jg) - coef_xy(:, 46) = coef_xy(:, 46)+coef_x(1:2, 0)*pol_y(1, 6, jg) - coef_xy(:, 46) = coef_xy(:, 46)+coef_x(3:4, 0)*pol_y(2, 6, jg) - coef_xy(:, 47) = coef_xy(:, 47)+coef_x(1:2, 1)*pol_y(1, 6, jg) - coef_xy(:, 47) = coef_xy(:, 47)+coef_x(3:4, 1)*pol_y(2, 6, jg) - coef_xy(:, 48) = coef_xy(:, 48)+coef_x(1:2, 2)*pol_y(1, 6, jg) - coef_xy(:, 48) = coef_xy(:, 48)+coef_x(3:4, 2)*pol_y(2, 6, jg) - coef_xy(:, 49) = coef_xy(:, 49)+coef_x(1:2, 3)*pol_y(1, 6, jg) - coef_xy(:, 49) = coef_xy(:, 49)+coef_x(3:4, 3)*pol_y(2, 6, jg) - coef_xy(:, 50) = coef_xy(:, 50)+coef_x(1:2, 0)*pol_y(1, 7, jg) - coef_xy(:, 50) = coef_xy(:, 50)+coef_x(3:4, 0)*pol_y(2, 7, jg) - coef_xy(:, 51) = coef_xy(:, 51)+coef_x(1:2, 1)*pol_y(1, 7, jg) - coef_xy(:, 51) = coef_xy(:, 51)+coef_x(3:4, 1)*pol_y(2, 7, jg) - coef_xy(:, 52) = coef_xy(:, 52)+coef_x(1:2, 2)*pol_y(1, 7, jg) - coef_xy(:, 52) = coef_xy(:, 52)+coef_x(3:4, 2)*pol_y(2, 7, jg) - coef_xy(:, 53) = coef_xy(:, 53)+coef_x(1:2, 0)*pol_y(1, 8, jg) - coef_xy(:, 53) = coef_xy(:, 53)+coef_x(3:4, 0)*pol_y(2, 8, jg) - coef_xy(:, 54) = coef_xy(:, 54)+coef_x(1:2, 1)*pol_y(1, 8, jg) - coef_xy(:, 54) = coef_xy(:, 54)+coef_x(3:4, 1)*pol_y(2, 8, jg) - coef_xy(:, 55) = coef_xy(:, 55)+coef_x(1:2, 0)*pol_y(1, 9, jg) - coef_xy(:, 55) = coef_xy(:, 55)+coef_x(3:4, 0)*pol_y(2, 9, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(1:2, 1)*pol_y(1, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(3:4, 1)*pol_y(2, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(1:2, 2)*pol_y(1, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(3:4, 2)*pol_y(2, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(1:2, 3)*pol_y(1, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(3:4, 3)*pol_y(2, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(1:2, 4)*pol_y(1, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(3:4, 4)*pol_y(2, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(1:2, 5)*pol_y(1, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(3:4, 5)*pol_y(2, 0, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(1:2, 6)*pol_y(1, 0, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(3:4, 6)*pol_y(2, 0, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(1:2, 7)*pol_y(1, 0, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(3:4, 7)*pol_y(2, 0, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(1:2, 8)*pol_y(1, 0, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(3:4, 8)*pol_y(2, 0, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(1:2, 9)*pol_y(1, 0, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(3:4, 9)*pol_y(2, 0, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(1:2, 0)*pol_y(1, 1, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(3:4, 0)*pol_y(2, 1, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(1:2, 1)*pol_y(1, 1, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(3:4, 1)*pol_y(2, 1, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(1:2, 2)*pol_y(1, 1, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(3:4, 2)*pol_y(2, 1, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(1:2, 3)*pol_y(1, 1, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(3:4, 3)*pol_y(2, 1, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(1:2, 4)*pol_y(1, 1, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(3:4, 4)*pol_y(2, 1, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(1:2, 5)*pol_y(1, 1, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(3:4, 5)*pol_y(2, 1, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(1:2, 6)*pol_y(1, 1, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(3:4, 6)*pol_y(2, 1, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(1:2, 7)*pol_y(1, 1, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(3:4, 7)*pol_y(2, 1, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(1:2, 8)*pol_y(1, 1, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(3:4, 8)*pol_y(2, 1, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(1:2, 0)*pol_y(1, 2, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(3:4, 0)*pol_y(2, 2, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(1:2, 1)*pol_y(1, 2, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(3:4, 1)*pol_y(2, 2, jg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_x(1:2, 2)*pol_y(1, 2, jg) + coef_xy(:, 22) = coef_xy(:, 22) + coef_x(3:4, 2)*pol_y(2, 2, jg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_x(1:2, 3)*pol_y(1, 2, jg) + coef_xy(:, 23) = coef_xy(:, 23) + coef_x(3:4, 3)*pol_y(2, 2, jg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_x(1:2, 4)*pol_y(1, 2, jg) + coef_xy(:, 24) = coef_xy(:, 24) + coef_x(3:4, 4)*pol_y(2, 2, jg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_x(1:2, 5)*pol_y(1, 2, jg) + coef_xy(:, 25) = coef_xy(:, 25) + coef_x(3:4, 5)*pol_y(2, 2, jg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_x(1:2, 6)*pol_y(1, 2, jg) + coef_xy(:, 26) = coef_xy(:, 26) + coef_x(3:4, 6)*pol_y(2, 2, jg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_x(1:2, 7)*pol_y(1, 2, jg) + coef_xy(:, 27) = coef_xy(:, 27) + coef_x(3:4, 7)*pol_y(2, 2, jg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_x(1:2, 0)*pol_y(1, 3, jg) + coef_xy(:, 28) = coef_xy(:, 28) + coef_x(3:4, 0)*pol_y(2, 3, jg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_x(1:2, 1)*pol_y(1, 3, jg) + coef_xy(:, 29) = coef_xy(:, 29) + coef_x(3:4, 1)*pol_y(2, 3, jg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_x(1:2, 2)*pol_y(1, 3, jg) + coef_xy(:, 30) = coef_xy(:, 30) + coef_x(3:4, 2)*pol_y(2, 3, jg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_x(1:2, 3)*pol_y(1, 3, jg) + coef_xy(:, 31) = coef_xy(:, 31) + coef_x(3:4, 3)*pol_y(2, 3, jg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_x(1:2, 4)*pol_y(1, 3, jg) + coef_xy(:, 32) = coef_xy(:, 32) + coef_x(3:4, 4)*pol_y(2, 3, jg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_x(1:2, 5)*pol_y(1, 3, jg) + coef_xy(:, 33) = coef_xy(:, 33) + coef_x(3:4, 5)*pol_y(2, 3, jg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_x(1:2, 6)*pol_y(1, 3, jg) + coef_xy(:, 34) = coef_xy(:, 34) + coef_x(3:4, 6)*pol_y(2, 3, jg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_x(1:2, 0)*pol_y(1, 4, jg) + coef_xy(:, 35) = coef_xy(:, 35) + coef_x(3:4, 0)*pol_y(2, 4, jg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_x(1:2, 1)*pol_y(1, 4, jg) + coef_xy(:, 36) = coef_xy(:, 36) + coef_x(3:4, 1)*pol_y(2, 4, jg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_x(1:2, 2)*pol_y(1, 4, jg) + coef_xy(:, 37) = coef_xy(:, 37) + coef_x(3:4, 2)*pol_y(2, 4, jg) + coef_xy(:, 38) = coef_xy(:, 38) + coef_x(1:2, 3)*pol_y(1, 4, jg) + coef_xy(:, 38) = coef_xy(:, 38) + coef_x(3:4, 3)*pol_y(2, 4, jg) + coef_xy(:, 39) = coef_xy(:, 39) + coef_x(1:2, 4)*pol_y(1, 4, jg) + coef_xy(:, 39) = coef_xy(:, 39) + coef_x(3:4, 4)*pol_y(2, 4, jg) + coef_xy(:, 40) = coef_xy(:, 40) + coef_x(1:2, 5)*pol_y(1, 4, jg) + coef_xy(:, 40) = coef_xy(:, 40) + coef_x(3:4, 5)*pol_y(2, 4, jg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_x(1:2, 0)*pol_y(1, 5, jg) + coef_xy(:, 41) = coef_xy(:, 41) + coef_x(3:4, 0)*pol_y(2, 5, jg) + coef_xy(:, 42) = coef_xy(:, 42) + coef_x(1:2, 1)*pol_y(1, 5, jg) + coef_xy(:, 42) = coef_xy(:, 42) + coef_x(3:4, 1)*pol_y(2, 5, jg) + coef_xy(:, 43) = coef_xy(:, 43) + coef_x(1:2, 2)*pol_y(1, 5, jg) + coef_xy(:, 43) = coef_xy(:, 43) + coef_x(3:4, 2)*pol_y(2, 5, jg) + coef_xy(:, 44) = coef_xy(:, 44) + coef_x(1:2, 3)*pol_y(1, 5, jg) + coef_xy(:, 44) = coef_xy(:, 44) + coef_x(3:4, 3)*pol_y(2, 5, jg) + coef_xy(:, 45) = coef_xy(:, 45) + coef_x(1:2, 4)*pol_y(1, 5, jg) + coef_xy(:, 45) = coef_xy(:, 45) + coef_x(3:4, 4)*pol_y(2, 5, jg) + coef_xy(:, 46) = coef_xy(:, 46) + coef_x(1:2, 0)*pol_y(1, 6, jg) + coef_xy(:, 46) = coef_xy(:, 46) + coef_x(3:4, 0)*pol_y(2, 6, jg) + coef_xy(:, 47) = coef_xy(:, 47) + coef_x(1:2, 1)*pol_y(1, 6, jg) + coef_xy(:, 47) = coef_xy(:, 47) + coef_x(3:4, 1)*pol_y(2, 6, jg) + coef_xy(:, 48) = coef_xy(:, 48) + coef_x(1:2, 2)*pol_y(1, 6, jg) + coef_xy(:, 48) = coef_xy(:, 48) + coef_x(3:4, 2)*pol_y(2, 6, jg) + coef_xy(:, 49) = coef_xy(:, 49) + coef_x(1:2, 3)*pol_y(1, 6, jg) + coef_xy(:, 49) = coef_xy(:, 49) + coef_x(3:4, 3)*pol_y(2, 6, jg) + coef_xy(:, 50) = coef_xy(:, 50) + coef_x(1:2, 0)*pol_y(1, 7, jg) + coef_xy(:, 50) = coef_xy(:, 50) + coef_x(3:4, 0)*pol_y(2, 7, jg) + coef_xy(:, 51) = coef_xy(:, 51) + coef_x(1:2, 1)*pol_y(1, 7, jg) + coef_xy(:, 51) = coef_xy(:, 51) + coef_x(3:4, 1)*pol_y(2, 7, jg) + coef_xy(:, 52) = coef_xy(:, 52) + coef_x(1:2, 2)*pol_y(1, 7, jg) + coef_xy(:, 52) = coef_xy(:, 52) + coef_x(3:4, 2)*pol_y(2, 7, jg) + coef_xy(:, 53) = coef_xy(:, 53) + coef_x(1:2, 0)*pol_y(1, 8, jg) + coef_xy(:, 53) = coef_xy(:, 53) + coef_x(3:4, 0)*pol_y(2, 8, jg) + coef_xy(:, 54) = coef_xy(:, 54) + coef_x(1:2, 1)*pol_y(1, 8, jg) + coef_xy(:, 54) = coef_xy(:, 54) + coef_x(3:4, 1)*pol_y(2, 8, jg) + coef_xy(:, 55) = coef_xy(:, 55) + coef_x(1:2, 0)*pol_y(1, 9, jg) + coef_xy(:, 55) = coef_xy(:, 55) + coef_x(3:4, 0)*pol_y(2, 9, jg) END DO lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(1, lxy)*pol_z(1, lzp, kg) - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(2, lxy)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(1, lxy)*pol_z(1, lzp, kg) + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(2, lxy)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO END DO diff --git a/src/grid/integrate_fast_6.f90 b/src/grid/integrate_fast_6.f90 index 547fc54a2d..fabe81c169 100644 --- a/src/grid/integrate_fast_6.f90 +++ b/src/grid/integrate_fast_6.f90 @@ -14,7 +14,7 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bounds, lp, cmax, gridbounds) USE kinds, ONLY: dp INTEGER, INTENT(IN) :: sphere_bounds(*), lp - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER, INTENT(IN) :: cmax REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & @@ -29,7 +29,7 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -37,23 +37,23 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp @@ -64,21 +64,21 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_x(1, lxp)*pol_y(1, lyp, jg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_x(2, lxp)*pol_y(1, lyp, jg) - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_x(3, lxp)*pol_y(2, lyp, jg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_x(4, lxp)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_x(1, lxp)*pol_y(1, lyp, jg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_x(2, lxp)*pol_y(1, lyp, jg) + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_x(3, lxp)*pol_y(2, lyp, jg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_x(4, lxp)*pol_y(2, lyp, jg) ENDDO ENDDO @@ -87,13 +87,13 @@ SUBROUTINE integrate_core_default(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphe lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(1, lxy)*pol_z(1, lzp, kg) - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(2, lxy)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(1, lxy)*pol_z(1, lzp, kg) + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(2, lxy)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO @@ -123,14 +123,14 @@ SUBROUTINE integrate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lxyz, & lyp, lzp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -138,23 +138,23 @@ SUBROUTINE integrate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -164,27 +164,27 @@ SUBROUTINE integrate_core_0(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) END DO lxyz = 0 DO lzp = 0, lp lxy = 0 - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1; lxy = lxy+1 - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(1, lxy)*pol_z(1, lzp, kg) - coef_xyz(lxyz) = coef_xyz(lxyz)+coef_xy(2, lxy)*pol_z(2, lzp, kg) + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(1, lxy)*pol_z(1, lzp, kg) + coef_xyz(lxyz) = coef_xyz(lxyz) + coef_xy(2, lxy)*pol_z(2, lzp, kg) ENDDO - lxy = lxy+lzp + lxy = lxy + lzp ENDDO ENDDO END DO @@ -213,13 +213,13 @@ SUBROUTINE integrate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -227,23 +227,23 @@ SUBROUTINE integrate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -253,23 +253,23 @@ SUBROUTINE integrate_core_1(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(1:2, 1)*pol_y(1, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(3:4, 1)*pol_y(2, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(1:2, 0)*pol_y(1, 1, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(3:4, 0)*pol_y(2, 1, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(1:2, 1)*pol_y(1, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(3:4, 1)*pol_y(2, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(1:2, 0)*pol_y(1, 1, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(3:4, 0)*pol_y(2, 1, jg) END DO - coef_xyz(1) = coef_xyz(1)+SUM(coef_xy(:, 1)*pol_z(:, 0, kg)) - coef_xyz(2) = coef_xyz(2)+SUM(coef_xy(:, 2)*pol_z(:, 0, kg)) - coef_xyz(3) = coef_xyz(3)+SUM(coef_xy(:, 3)*pol_z(:, 0, kg)) - coef_xyz(4) = coef_xyz(4)+SUM(coef_xy(:, 1)*pol_z(:, 1, kg)) + coef_xyz(1) = coef_xyz(1) + SUM(coef_xy(:, 1)*pol_z(:, 0, kg)) + coef_xyz(2) = coef_xyz(2) + SUM(coef_xy(:, 2)*pol_z(:, 0, kg)) + coef_xyz(3) = coef_xyz(3) + SUM(coef_xy(:, 3)*pol_z(:, 0, kg)) + coef_xyz(4) = coef_xyz(4) + SUM(coef_xy(:, 1)*pol_z(:, 1, kg)) END DO END SUBROUTINE integrate_core_1 @@ -296,13 +296,13 @@ SUBROUTINE integrate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lyp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -310,23 +310,23 @@ SUBROUTINE integrate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -335,48 +335,48 @@ SUBROUTINE integrate_core_2(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = grid(i, j, k2) s03 = grid(i, j2, k) s04 = grid(i, j2, k2) - coef_x(1, 0) = coef_x(1, 0)+s01*pol_x(0, ig) - coef_x(2, 0) = coef_x(2, 0)+s02*pol_x(0, ig) - coef_x(3, 0) = coef_x(3, 0)+s03*pol_x(0, ig) - coef_x(4, 0) = coef_x(4, 0)+s04*pol_x(0, ig) - coef_x(1, 1) = coef_x(1, 1)+s01*pol_x(1, ig) - coef_x(2, 1) = coef_x(2, 1)+s02*pol_x(1, ig) - coef_x(3, 1) = coef_x(3, 1)+s03*pol_x(1, ig) - coef_x(4, 1) = coef_x(4, 1)+s04*pol_x(1, ig) - coef_x(1, 2) = coef_x(1, 2)+s01*pol_x(2, ig) - coef_x(2, 2) = coef_x(2, 2)+s02*pol_x(2, ig) - coef_x(3, 2) = coef_x(3, 2)+s03*pol_x(2, ig) - coef_x(4, 2) = coef_x(4, 2)+s04*pol_x(2, ig) + coef_x(1, 0) = coef_x(1, 0) + s01*pol_x(0, ig) + coef_x(2, 0) = coef_x(2, 0) + s02*pol_x(0, ig) + coef_x(3, 0) = coef_x(3, 0) + s03*pol_x(0, ig) + coef_x(4, 0) = coef_x(4, 0) + s04*pol_x(0, ig) + coef_x(1, 1) = coef_x(1, 1) + s01*pol_x(1, ig) + coef_x(2, 1) = coef_x(2, 1) + s02*pol_x(1, ig) + coef_x(3, 1) = coef_x(3, 1) + s03*pol_x(1, ig) + coef_x(4, 1) = coef_x(4, 1) + s04*pol_x(1, ig) + coef_x(1, 2) = coef_x(1, 2) + s01*pol_x(2, ig) + coef_x(2, 2) = coef_x(2, 2) + s02*pol_x(2, ig) + coef_x(3, 2) = coef_x(3, 2) + s03*pol_x(2, ig) + coef_x(4, 2) = coef_x(4, 2) + s04*pol_x(2, ig) END DO lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_xy(:, lxy) = coef_xy(:, lxy)+coef_x(1:2, lxp)*pol_y(1, lyp, jg) - coef_xy(:, lxy) = coef_xy(:, lxy)+coef_x(3:4, lxp)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_xy(:, lxy) = coef_xy(:, lxy) + coef_x(1:2, lxp)*pol_y(1, lyp, jg) + coef_xy(:, lxy) = coef_xy(:, lxy) + coef_x(3:4, lxp)*pol_y(2, lyp, jg) ENDDO ENDDO END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 1)*pol_z(2, 2, kg) END DO END SUBROUTINE integrate_core_2 @@ -403,13 +403,13 @@ SUBROUTINE integrate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, lxy, lyp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -417,23 +417,23 @@ SUBROUTINE integrate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -442,74 +442,74 @@ SUBROUTINE integrate_core_3(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = grid(i, j, k2) s03 = grid(i, j2, k) s04 = grid(i, j2, k2) - coef_x(1, 0) = coef_x(1, 0)+s01*pol_x(0, ig) - coef_x(2, 0) = coef_x(2, 0)+s02*pol_x(0, ig) - coef_x(3, 0) = coef_x(3, 0)+s03*pol_x(0, ig) - coef_x(4, 0) = coef_x(4, 0)+s04*pol_x(0, ig) - coef_x(1, 1) = coef_x(1, 1)+s01*pol_x(1, ig) - coef_x(2, 1) = coef_x(2, 1)+s02*pol_x(1, ig) - coef_x(3, 1) = coef_x(3, 1)+s03*pol_x(1, ig) - coef_x(4, 1) = coef_x(4, 1)+s04*pol_x(1, ig) - coef_x(1, 2) = coef_x(1, 2)+s01*pol_x(2, ig) - coef_x(2, 2) = coef_x(2, 2)+s02*pol_x(2, ig) - coef_x(3, 2) = coef_x(3, 2)+s03*pol_x(2, ig) - coef_x(4, 2) = coef_x(4, 2)+s04*pol_x(2, ig) - coef_x(1, 3) = coef_x(1, 3)+s01*pol_x(3, ig) - coef_x(2, 3) = coef_x(2, 3)+s02*pol_x(3, ig) - coef_x(3, 3) = coef_x(3, 3)+s03*pol_x(3, ig) - coef_x(4, 3) = coef_x(4, 3)+s04*pol_x(3, ig) + coef_x(1, 0) = coef_x(1, 0) + s01*pol_x(0, ig) + coef_x(2, 0) = coef_x(2, 0) + s02*pol_x(0, ig) + coef_x(3, 0) = coef_x(3, 0) + s03*pol_x(0, ig) + coef_x(4, 0) = coef_x(4, 0) + s04*pol_x(0, ig) + coef_x(1, 1) = coef_x(1, 1) + s01*pol_x(1, ig) + coef_x(2, 1) = coef_x(2, 1) + s02*pol_x(1, ig) + coef_x(3, 1) = coef_x(3, 1) + s03*pol_x(1, ig) + coef_x(4, 1) = coef_x(4, 1) + s04*pol_x(1, ig) + coef_x(1, 2) = coef_x(1, 2) + s01*pol_x(2, ig) + coef_x(2, 2) = coef_x(2, 2) + s02*pol_x(2, ig) + coef_x(3, 2) = coef_x(3, 2) + s03*pol_x(2, ig) + coef_x(4, 2) = coef_x(4, 2) + s04*pol_x(2, ig) + coef_x(1, 3) = coef_x(1, 3) + s01*pol_x(3, ig) + coef_x(2, 3) = coef_x(2, 3) + s02*pol_x(3, ig) + coef_x(3, 3) = coef_x(3, 3) + s03*pol_x(3, ig) + coef_x(4, 3) = coef_x(4, 3) + s04*pol_x(3, ig) END DO lxy = 0 DO lyp = 0, lp - DO lxp = 0, lp-lyp - lxy = lxy+1 - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_x(1, lxp)*pol_y(1, lyp, jg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_x(2, lxp)*pol_y(1, lyp, jg) - coef_xy(1, lxy) = coef_xy(1, lxy)+coef_x(3, lxp)*pol_y(2, lyp, jg) - coef_xy(2, lxy) = coef_xy(2, lxy)+coef_x(4, lxp)*pol_y(2, lyp, jg) + DO lxp = 0, lp - lyp + lxy = lxy + 1 + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_x(1, lxp)*pol_y(1, lyp, jg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_x(2, lxp)*pol_y(1, lyp, jg) + coef_xy(1, lxy) = coef_xy(1, lxy) + coef_x(3, lxp)*pol_y(2, lyp, jg) + coef_xy(2, lxy) = coef_xy(2, lxy) + coef_x(4, lxp)*pol_y(2, lyp, jg) ENDDO ENDDO END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 5)*pol_z(1, 1, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 5)*pol_z(2, 1, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 8)*pol_z(1, 1, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 8)*pol_z(2, 1, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 5)*pol_z(1, 2, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 5)*pol_z(2, 2, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 5)*pol_z(1, 1, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 5)*pol_z(2, 1, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 8)*pol_z(1, 1, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 8)*pol_z(2, 1, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 5)*pol_z(1, 2, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 5)*pol_z(2, 2, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 1)*pol_z(2, 3, kg) END DO END SUBROUTINE integrate_core_3 @@ -536,13 +536,13 @@ SUBROUTINE integrate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -550,23 +550,23 @@ SUBROUTINE integrate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -576,143 +576,143 @@ SUBROUTINE integrate_core_4(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 2)*pol_y(1, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 2)*pol_y(1, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 2)*pol_y(2, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 2)*pol_y(2, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(1, 3)*pol_y(1, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(2, 3)*pol_y(1, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(3, 3)*pol_y(2, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(4, 3)*pol_y(2, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(1, 4)*pol_y(1, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(2, 4)*pol_y(1, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(3, 4)*pol_y(2, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(4, 4)*pol_y(2, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(4, 0)*pol_y(2, 1, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(1, 1)*pol_y(1, 1, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(2, 1)*pol_y(1, 1, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(3, 1)*pol_y(2, 1, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(4, 1)*pol_y(2, 1, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(1, 2)*pol_y(1, 1, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(2, 2)*pol_y(1, 1, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(3, 2)*pol_y(2, 1, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(4, 2)*pol_y(2, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(1, 3)*pol_y(1, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(2, 3)*pol_y(1, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(3, 3)*pol_y(2, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(4, 3)*pol_y(2, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(1, 0)*pol_y(1, 2, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(2, 0)*pol_y(1, 2, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(3, 0)*pol_y(2, 2, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(4, 0)*pol_y(2, 2, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(1, 1)*pol_y(1, 2, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(2, 1)*pol_y(1, 2, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(3, 1)*pol_y(2, 2, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(4, 1)*pol_y(2, 2, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(1, 2)*pol_y(1, 2, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(2, 2)*pol_y(1, 2, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(3, 2)*pol_y(2, 2, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(4, 2)*pol_y(2, 2, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(1, 0)*pol_y(1, 3, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(2, 0)*pol_y(1, 3, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(3, 0)*pol_y(2, 3, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(4, 0)*pol_y(2, 3, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(1, 1)*pol_y(1, 3, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(2, 1)*pol_y(1, 3, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(3, 1)*pol_y(2, 3, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(4, 1)*pol_y(2, 3, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(1, 0)*pol_y(1, 4, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(2, 0)*pol_y(1, 4, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(3, 0)*pol_y(2, 4, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(4, 0)*pol_y(2, 4, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 2)*pol_y(1, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 2)*pol_y(1, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 2)*pol_y(2, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 2)*pol_y(2, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(1, 3)*pol_y(1, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(2, 3)*pol_y(1, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(3, 3)*pol_y(2, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(4, 3)*pol_y(2, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(1, 4)*pol_y(1, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(2, 4)*pol_y(1, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(3, 4)*pol_y(2, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(4, 4)*pol_y(2, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(1, 1)*pol_y(1, 1, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(2, 1)*pol_y(1, 1, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(3, 1)*pol_y(2, 1, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(4, 1)*pol_y(2, 1, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(1, 2)*pol_y(1, 1, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(2, 2)*pol_y(1, 1, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(3, 2)*pol_y(2, 1, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(4, 2)*pol_y(2, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(1, 3)*pol_y(1, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(2, 3)*pol_y(1, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(3, 3)*pol_y(2, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(4, 3)*pol_y(2, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(1, 0)*pol_y(1, 2, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(2, 0)*pol_y(1, 2, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(3, 0)*pol_y(2, 2, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(4, 0)*pol_y(2, 2, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(1, 1)*pol_y(1, 2, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(2, 1)*pol_y(1, 2, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(3, 1)*pol_y(2, 2, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(4, 1)*pol_y(2, 2, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(1, 2)*pol_y(1, 2, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(2, 2)*pol_y(1, 2, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(3, 2)*pol_y(2, 2, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(4, 2)*pol_y(2, 2, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(1, 0)*pol_y(1, 3, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(2, 0)*pol_y(1, 3, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(3, 0)*pol_y(2, 3, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(4, 0)*pol_y(2, 3, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(1, 1)*pol_y(1, 3, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(2, 1)*pol_y(1, 3, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(3, 1)*pol_y(2, 3, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(4, 1)*pol_y(2, 3, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(1, 0)*pol_y(1, 4, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(2, 0)*pol_y(1, 4, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(3, 0)*pol_y(2, 4, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(4, 0)*pol_y(2, 4, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 11)*pol_z(1, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 11)*pol_z(2, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 12)*pol_z(1, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 12)*pol_z(2, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 13)*pol_z(1, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 13)*pol_z(2, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 14)*pol_z(1, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 14)*pol_z(2, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 15)*pol_z(1, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 15)*pol_z(2, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(1, 7)*pol_z(1, 1, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(2, 7)*pol_z(2, 1, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(1, 8)*pol_z(1, 1, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(2, 8)*pol_z(2, 1, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(1, 10)*pol_z(1, 1, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(2, 10)*pol_z(2, 1, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(1, 11)*pol_z(1, 1, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(2, 11)*pol_z(2, 1, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(1, 13)*pol_z(1, 1, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(2, 13)*pol_z(2, 1, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(1, 3)*pol_z(1, 2, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(2, 3)*pol_z(2, 2, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(1, 6)*pol_z(1, 2, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(2, 6)*pol_z(2, 2, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(1, 7)*pol_z(1, 2, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(2, 7)*pol_z(2, 2, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(1, 10)*pol_z(1, 2, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(2, 10)*pol_z(2, 2, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(2, 1)*pol_z(2, 3, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(1, 2)*pol_z(1, 3, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(2, 2)*pol_z(2, 3, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(1, 6)*pol_z(1, 3, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(2, 6)*pol_z(2, 3, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(1, 1)*pol_z(1, 4, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(2, 1)*pol_z(2, 4, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 11)*pol_z(1, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 11)*pol_z(2, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 12)*pol_z(1, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 12)*pol_z(2, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 13)*pol_z(1, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 13)*pol_z(2, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 14)*pol_z(1, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 14)*pol_z(2, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 15)*pol_z(1, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 15)*pol_z(2, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(1, 7)*pol_z(1, 1, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(2, 7)*pol_z(2, 1, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(1, 8)*pol_z(1, 1, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(2, 8)*pol_z(2, 1, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(1, 10)*pol_z(1, 1, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(2, 10)*pol_z(2, 1, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(1, 11)*pol_z(1, 1, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(2, 11)*pol_z(2, 1, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(1, 13)*pol_z(1, 1, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(2, 13)*pol_z(2, 1, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(1, 3)*pol_z(1, 2, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(2, 3)*pol_z(2, 2, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(1, 6)*pol_z(1, 2, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(2, 6)*pol_z(2, 2, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(1, 7)*pol_z(1, 2, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(2, 7)*pol_z(2, 2, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(1, 10)*pol_z(1, 2, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(2, 10)*pol_z(2, 2, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(1, 2)*pol_z(1, 3, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(2, 2)*pol_z(2, 3, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(1, 6)*pol_z(1, 3, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(2, 6)*pol_z(2, 3, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(1, 1)*pol_z(1, 4, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(2, 1)*pol_z(2, 4, kg) END DO END SUBROUTINE integrate_core_4 @@ -739,13 +739,13 @@ SUBROUTINE integrate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -753,23 +753,23 @@ SUBROUTINE integrate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -778,130 +778,130 @@ SUBROUTINE integrate_core_5(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s02 = grid(i, j, k2) s03 = grid(i, j2, k) s04 = grid(i, j2, k2) - coef_x(1, 0) = coef_x(1, 0)+s01*pol_x(0, ig) - coef_x(2, 0) = coef_x(2, 0)+s02*pol_x(0, ig) - coef_x(3, 0) = coef_x(3, 0)+s03*pol_x(0, ig) - coef_x(4, 0) = coef_x(4, 0)+s04*pol_x(0, ig) - coef_x(1, 1) = coef_x(1, 1)+s01*pol_x(1, ig) - coef_x(2, 1) = coef_x(2, 1)+s02*pol_x(1, ig) - coef_x(3, 1) = coef_x(3, 1)+s03*pol_x(1, ig) - coef_x(4, 1) = coef_x(4, 1)+s04*pol_x(1, ig) - coef_x(1, 2) = coef_x(1, 2)+s01*pol_x(2, ig) - coef_x(2, 2) = coef_x(2, 2)+s02*pol_x(2, ig) - coef_x(3, 2) = coef_x(3, 2)+s03*pol_x(2, ig) - coef_x(4, 2) = coef_x(4, 2)+s04*pol_x(2, ig) - coef_x(1, 3) = coef_x(1, 3)+s01*pol_x(3, ig) - coef_x(2, 3) = coef_x(2, 3)+s02*pol_x(3, ig) - coef_x(3, 3) = coef_x(3, 3)+s03*pol_x(3, ig) - coef_x(4, 3) = coef_x(4, 3)+s04*pol_x(3, ig) - coef_x(1, 4) = coef_x(1, 4)+s01*pol_x(4, ig) - coef_x(2, 4) = coef_x(2, 4)+s02*pol_x(4, ig) - coef_x(3, 4) = coef_x(3, 4)+s03*pol_x(4, ig) - coef_x(4, 4) = coef_x(4, 4)+s04*pol_x(4, ig) - coef_x(1, 5) = coef_x(1, 5)+s01*pol_x(5, ig) - coef_x(2, 5) = coef_x(2, 5)+s02*pol_x(5, ig) - coef_x(3, 5) = coef_x(3, 5)+s03*pol_x(5, ig) - coef_x(4, 5) = coef_x(4, 5)+s04*pol_x(5, ig) + coef_x(1, 0) = coef_x(1, 0) + s01*pol_x(0, ig) + coef_x(2, 0) = coef_x(2, 0) + s02*pol_x(0, ig) + coef_x(3, 0) = coef_x(3, 0) + s03*pol_x(0, ig) + coef_x(4, 0) = coef_x(4, 0) + s04*pol_x(0, ig) + coef_x(1, 1) = coef_x(1, 1) + s01*pol_x(1, ig) + coef_x(2, 1) = coef_x(2, 1) + s02*pol_x(1, ig) + coef_x(3, 1) = coef_x(3, 1) + s03*pol_x(1, ig) + coef_x(4, 1) = coef_x(4, 1) + s04*pol_x(1, ig) + coef_x(1, 2) = coef_x(1, 2) + s01*pol_x(2, ig) + coef_x(2, 2) = coef_x(2, 2) + s02*pol_x(2, ig) + coef_x(3, 2) = coef_x(3, 2) + s03*pol_x(2, ig) + coef_x(4, 2) = coef_x(4, 2) + s04*pol_x(2, ig) + coef_x(1, 3) = coef_x(1, 3) + s01*pol_x(3, ig) + coef_x(2, 3) = coef_x(2, 3) + s02*pol_x(3, ig) + coef_x(3, 3) = coef_x(3, 3) + s03*pol_x(3, ig) + coef_x(4, 3) = coef_x(4, 3) + s04*pol_x(3, ig) + coef_x(1, 4) = coef_x(1, 4) + s01*pol_x(4, ig) + coef_x(2, 4) = coef_x(2, 4) + s02*pol_x(4, ig) + coef_x(3, 4) = coef_x(3, 4) + s03*pol_x(4, ig) + coef_x(4, 4) = coef_x(4, 4) + s04*pol_x(4, ig) + coef_x(1, 5) = coef_x(1, 5) + s01*pol_x(5, ig) + coef_x(2, 5) = coef_x(2, 5) + s02*pol_x(5, ig) + coef_x(3, 5) = coef_x(3, 5) + s03*pol_x(5, ig) + coef_x(4, 5) = coef_x(4, 5) + s04*pol_x(5, ig) END DO - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(1:2, 0)*pol_y(1, 0, jg) - coef_xy(:, 1) = coef_xy(:, 1)+coef_x(3:4, 0)*pol_y(2, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(1:2, 1)*pol_y(1, 0, jg) - coef_xy(:, 2) = coef_xy(:, 2)+coef_x(3:4, 1)*pol_y(2, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(1:2, 2)*pol_y(1, 0, jg) - coef_xy(:, 3) = coef_xy(:, 3)+coef_x(3:4, 2)*pol_y(2, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(1:2, 3)*pol_y(1, 0, jg) - coef_xy(:, 4) = coef_xy(:, 4)+coef_x(3:4, 3)*pol_y(2, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(1:2, 4)*pol_y(1, 0, jg) - coef_xy(:, 5) = coef_xy(:, 5)+coef_x(3:4, 4)*pol_y(2, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(1:2, 5)*pol_y(1, 0, jg) - coef_xy(:, 6) = coef_xy(:, 6)+coef_x(3:4, 5)*pol_y(2, 0, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(1:2, 0)*pol_y(1, 1, jg) - coef_xy(:, 7) = coef_xy(:, 7)+coef_x(3:4, 0)*pol_y(2, 1, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(1:2, 1)*pol_y(1, 1, jg) - coef_xy(:, 8) = coef_xy(:, 8)+coef_x(3:4, 1)*pol_y(2, 1, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(1:2, 2)*pol_y(1, 1, jg) - coef_xy(:, 9) = coef_xy(:, 9)+coef_x(3:4, 2)*pol_y(2, 1, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(1:2, 3)*pol_y(1, 1, jg) - coef_xy(:, 10) = coef_xy(:, 10)+coef_x(3:4, 3)*pol_y(2, 1, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(1:2, 4)*pol_y(1, 1, jg) - coef_xy(:, 11) = coef_xy(:, 11)+coef_x(3:4, 4)*pol_y(2, 1, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(1:2, 0)*pol_y(1, 2, jg) - coef_xy(:, 12) = coef_xy(:, 12)+coef_x(3:4, 0)*pol_y(2, 2, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(1:2, 1)*pol_y(1, 2, jg) - coef_xy(:, 13) = coef_xy(:, 13)+coef_x(3:4, 1)*pol_y(2, 2, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(1:2, 2)*pol_y(1, 2, jg) - coef_xy(:, 14) = coef_xy(:, 14)+coef_x(3:4, 2)*pol_y(2, 2, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(1:2, 3)*pol_y(1, 2, jg) - coef_xy(:, 15) = coef_xy(:, 15)+coef_x(3:4, 3)*pol_y(2, 2, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(1:2, 0)*pol_y(1, 3, jg) - coef_xy(:, 16) = coef_xy(:, 16)+coef_x(3:4, 0)*pol_y(2, 3, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(1:2, 1)*pol_y(1, 3, jg) - coef_xy(:, 17) = coef_xy(:, 17)+coef_x(3:4, 1)*pol_y(2, 3, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(1:2, 2)*pol_y(1, 3, jg) - coef_xy(:, 18) = coef_xy(:, 18)+coef_x(3:4, 2)*pol_y(2, 3, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(1:2, 0)*pol_y(1, 4, jg) - coef_xy(:, 19) = coef_xy(:, 19)+coef_x(3:4, 0)*pol_y(2, 4, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(1:2, 1)*pol_y(1, 4, jg) - coef_xy(:, 20) = coef_xy(:, 20)+coef_x(3:4, 1)*pol_y(2, 4, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(1:2, 0)*pol_y(1, 5, jg) - coef_xy(:, 21) = coef_xy(:, 21)+coef_x(3:4, 0)*pol_y(2, 5, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(1:2, 0)*pol_y(1, 0, jg) + coef_xy(:, 1) = coef_xy(:, 1) + coef_x(3:4, 0)*pol_y(2, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(1:2, 1)*pol_y(1, 0, jg) + coef_xy(:, 2) = coef_xy(:, 2) + coef_x(3:4, 1)*pol_y(2, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(1:2, 2)*pol_y(1, 0, jg) + coef_xy(:, 3) = coef_xy(:, 3) + coef_x(3:4, 2)*pol_y(2, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(1:2, 3)*pol_y(1, 0, jg) + coef_xy(:, 4) = coef_xy(:, 4) + coef_x(3:4, 3)*pol_y(2, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(1:2, 4)*pol_y(1, 0, jg) + coef_xy(:, 5) = coef_xy(:, 5) + coef_x(3:4, 4)*pol_y(2, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(1:2, 5)*pol_y(1, 0, jg) + coef_xy(:, 6) = coef_xy(:, 6) + coef_x(3:4, 5)*pol_y(2, 0, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(1:2, 0)*pol_y(1, 1, jg) + coef_xy(:, 7) = coef_xy(:, 7) + coef_x(3:4, 0)*pol_y(2, 1, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(1:2, 1)*pol_y(1, 1, jg) + coef_xy(:, 8) = coef_xy(:, 8) + coef_x(3:4, 1)*pol_y(2, 1, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(1:2, 2)*pol_y(1, 1, jg) + coef_xy(:, 9) = coef_xy(:, 9) + coef_x(3:4, 2)*pol_y(2, 1, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(1:2, 3)*pol_y(1, 1, jg) + coef_xy(:, 10) = coef_xy(:, 10) + coef_x(3:4, 3)*pol_y(2, 1, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(1:2, 4)*pol_y(1, 1, jg) + coef_xy(:, 11) = coef_xy(:, 11) + coef_x(3:4, 4)*pol_y(2, 1, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(1:2, 0)*pol_y(1, 2, jg) + coef_xy(:, 12) = coef_xy(:, 12) + coef_x(3:4, 0)*pol_y(2, 2, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(1:2, 1)*pol_y(1, 2, jg) + coef_xy(:, 13) = coef_xy(:, 13) + coef_x(3:4, 1)*pol_y(2, 2, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(1:2, 2)*pol_y(1, 2, jg) + coef_xy(:, 14) = coef_xy(:, 14) + coef_x(3:4, 2)*pol_y(2, 2, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(1:2, 3)*pol_y(1, 2, jg) + coef_xy(:, 15) = coef_xy(:, 15) + coef_x(3:4, 3)*pol_y(2, 2, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(1:2, 0)*pol_y(1, 3, jg) + coef_xy(:, 16) = coef_xy(:, 16) + coef_x(3:4, 0)*pol_y(2, 3, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(1:2, 1)*pol_y(1, 3, jg) + coef_xy(:, 17) = coef_xy(:, 17) + coef_x(3:4, 1)*pol_y(2, 3, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(1:2, 2)*pol_y(1, 3, jg) + coef_xy(:, 18) = coef_xy(:, 18) + coef_x(3:4, 2)*pol_y(2, 3, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(1:2, 0)*pol_y(1, 4, jg) + coef_xy(:, 19) = coef_xy(:, 19) + coef_x(3:4, 0)*pol_y(2, 4, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(1:2, 1)*pol_y(1, 4, jg) + coef_xy(:, 20) = coef_xy(:, 20) + coef_x(3:4, 1)*pol_y(2, 4, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(1:2, 0)*pol_y(1, 5, jg) + coef_xy(:, 21) = coef_xy(:, 21) + coef_x(3:4, 0)*pol_y(2, 5, jg) END DO - coef_xyz(1) = coef_xyz(1)+SUM(coef_xy(:, 1)*pol_z(:, 0, kg)) - coef_xyz(2) = coef_xyz(2)+SUM(coef_xy(:, 2)*pol_z(:, 0, kg)) - coef_xyz(3) = coef_xyz(3)+SUM(coef_xy(:, 3)*pol_z(:, 0, kg)) - coef_xyz(4) = coef_xyz(4)+SUM(coef_xy(:, 4)*pol_z(:, 0, kg)) - coef_xyz(5) = coef_xyz(5)+SUM(coef_xy(:, 5)*pol_z(:, 0, kg)) - coef_xyz(6) = coef_xyz(6)+SUM(coef_xy(:, 6)*pol_z(:, 0, kg)) - coef_xyz(7) = coef_xyz(7)+SUM(coef_xy(:, 7)*pol_z(:, 0, kg)) - coef_xyz(8) = coef_xyz(8)+SUM(coef_xy(:, 8)*pol_z(:, 0, kg)) - coef_xyz(9) = coef_xyz(9)+SUM(coef_xy(:, 9)*pol_z(:, 0, kg)) - coef_xyz(10) = coef_xyz(10)+SUM(coef_xy(:, 10)*pol_z(:, 0, kg)) - coef_xyz(11) = coef_xyz(11)+SUM(coef_xy(:, 11)*pol_z(:, 0, kg)) - coef_xyz(12) = coef_xyz(12)+SUM(coef_xy(:, 12)*pol_z(:, 0, kg)) - coef_xyz(13) = coef_xyz(13)+SUM(coef_xy(:, 13)*pol_z(:, 0, kg)) - coef_xyz(14) = coef_xyz(14)+SUM(coef_xy(:, 14)*pol_z(:, 0, kg)) - coef_xyz(15) = coef_xyz(15)+SUM(coef_xy(:, 15)*pol_z(:, 0, kg)) - coef_xyz(16) = coef_xyz(16)+SUM(coef_xy(:, 16)*pol_z(:, 0, kg)) - coef_xyz(17) = coef_xyz(17)+SUM(coef_xy(:, 17)*pol_z(:, 0, kg)) - coef_xyz(18) = coef_xyz(18)+SUM(coef_xy(:, 18)*pol_z(:, 0, kg)) - coef_xyz(19) = coef_xyz(19)+SUM(coef_xy(:, 19)*pol_z(:, 0, kg)) - coef_xyz(20) = coef_xyz(20)+SUM(coef_xy(:, 20)*pol_z(:, 0, kg)) - coef_xyz(21) = coef_xyz(21)+SUM(coef_xy(:, 21)*pol_z(:, 0, kg)) - coef_xyz(22) = coef_xyz(22)+SUM(coef_xy(:, 1)*pol_z(:, 1, kg)) - coef_xyz(23) = coef_xyz(23)+SUM(coef_xy(:, 2)*pol_z(:, 1, kg)) - coef_xyz(24) = coef_xyz(24)+SUM(coef_xy(:, 3)*pol_z(:, 1, kg)) - coef_xyz(25) = coef_xyz(25)+SUM(coef_xy(:, 4)*pol_z(:, 1, kg)) - coef_xyz(26) = coef_xyz(26)+SUM(coef_xy(:, 5)*pol_z(:, 1, kg)) - coef_xyz(27) = coef_xyz(27)+SUM(coef_xy(:, 7)*pol_z(:, 1, kg)) - coef_xyz(28) = coef_xyz(28)+SUM(coef_xy(:, 8)*pol_z(:, 1, kg)) - coef_xyz(29) = coef_xyz(29)+SUM(coef_xy(:, 9)*pol_z(:, 1, kg)) - coef_xyz(30) = coef_xyz(30)+SUM(coef_xy(:, 10)*pol_z(:, 1, kg)) - coef_xyz(31) = coef_xyz(31)+SUM(coef_xy(:, 12)*pol_z(:, 1, kg)) - coef_xyz(32) = coef_xyz(32)+SUM(coef_xy(:, 13)*pol_z(:, 1, kg)) - coef_xyz(33) = coef_xyz(33)+SUM(coef_xy(:, 14)*pol_z(:, 1, kg)) - coef_xyz(34) = coef_xyz(34)+SUM(coef_xy(:, 16)*pol_z(:, 1, kg)) - coef_xyz(35) = coef_xyz(35)+SUM(coef_xy(:, 17)*pol_z(:, 1, kg)) - coef_xyz(36) = coef_xyz(36)+SUM(coef_xy(:, 19)*pol_z(:, 1, kg)) - coef_xyz(37) = coef_xyz(37)+SUM(coef_xy(:, 1)*pol_z(:, 2, kg)) - coef_xyz(38) = coef_xyz(38)+SUM(coef_xy(:, 2)*pol_z(:, 2, kg)) - coef_xyz(39) = coef_xyz(39)+SUM(coef_xy(:, 3)*pol_z(:, 2, kg)) - coef_xyz(40) = coef_xyz(40)+SUM(coef_xy(:, 4)*pol_z(:, 2, kg)) - coef_xyz(41) = coef_xyz(41)+SUM(coef_xy(:, 7)*pol_z(:, 2, kg)) - coef_xyz(42) = coef_xyz(42)+SUM(coef_xy(:, 8)*pol_z(:, 2, kg)) - coef_xyz(43) = coef_xyz(43)+SUM(coef_xy(:, 9)*pol_z(:, 2, kg)) - coef_xyz(44) = coef_xyz(44)+SUM(coef_xy(:, 12)*pol_z(:, 2, kg)) - coef_xyz(45) = coef_xyz(45)+SUM(coef_xy(:, 13)*pol_z(:, 2, kg)) - coef_xyz(46) = coef_xyz(46)+SUM(coef_xy(:, 16)*pol_z(:, 2, kg)) - coef_xyz(47) = coef_xyz(47)+SUM(coef_xy(:, 1)*pol_z(:, 3, kg)) - coef_xyz(48) = coef_xyz(48)+SUM(coef_xy(:, 2)*pol_z(:, 3, kg)) - coef_xyz(49) = coef_xyz(49)+SUM(coef_xy(:, 3)*pol_z(:, 3, kg)) - coef_xyz(50) = coef_xyz(50)+SUM(coef_xy(:, 7)*pol_z(:, 3, kg)) - coef_xyz(51) = coef_xyz(51)+SUM(coef_xy(:, 8)*pol_z(:, 3, kg)) - coef_xyz(52) = coef_xyz(52)+SUM(coef_xy(:, 12)*pol_z(:, 3, kg)) - coef_xyz(53) = coef_xyz(53)+SUM(coef_xy(:, 1)*pol_z(:, 4, kg)) - coef_xyz(54) = coef_xyz(54)+SUM(coef_xy(:, 2)*pol_z(:, 4, kg)) - coef_xyz(55) = coef_xyz(55)+SUM(coef_xy(:, 7)*pol_z(:, 4, kg)) - coef_xyz(56) = coef_xyz(56)+SUM(coef_xy(:, 1)*pol_z(:, 5, kg)) + coef_xyz(1) = coef_xyz(1) + SUM(coef_xy(:, 1)*pol_z(:, 0, kg)) + coef_xyz(2) = coef_xyz(2) + SUM(coef_xy(:, 2)*pol_z(:, 0, kg)) + coef_xyz(3) = coef_xyz(3) + SUM(coef_xy(:, 3)*pol_z(:, 0, kg)) + coef_xyz(4) = coef_xyz(4) + SUM(coef_xy(:, 4)*pol_z(:, 0, kg)) + coef_xyz(5) = coef_xyz(5) + SUM(coef_xy(:, 5)*pol_z(:, 0, kg)) + coef_xyz(6) = coef_xyz(6) + SUM(coef_xy(:, 6)*pol_z(:, 0, kg)) + coef_xyz(7) = coef_xyz(7) + SUM(coef_xy(:, 7)*pol_z(:, 0, kg)) + coef_xyz(8) = coef_xyz(8) + SUM(coef_xy(:, 8)*pol_z(:, 0, kg)) + coef_xyz(9) = coef_xyz(9) + SUM(coef_xy(:, 9)*pol_z(:, 0, kg)) + coef_xyz(10) = coef_xyz(10) + SUM(coef_xy(:, 10)*pol_z(:, 0, kg)) + coef_xyz(11) = coef_xyz(11) + SUM(coef_xy(:, 11)*pol_z(:, 0, kg)) + coef_xyz(12) = coef_xyz(12) + SUM(coef_xy(:, 12)*pol_z(:, 0, kg)) + coef_xyz(13) = coef_xyz(13) + SUM(coef_xy(:, 13)*pol_z(:, 0, kg)) + coef_xyz(14) = coef_xyz(14) + SUM(coef_xy(:, 14)*pol_z(:, 0, kg)) + coef_xyz(15) = coef_xyz(15) + SUM(coef_xy(:, 15)*pol_z(:, 0, kg)) + coef_xyz(16) = coef_xyz(16) + SUM(coef_xy(:, 16)*pol_z(:, 0, kg)) + coef_xyz(17) = coef_xyz(17) + SUM(coef_xy(:, 17)*pol_z(:, 0, kg)) + coef_xyz(18) = coef_xyz(18) + SUM(coef_xy(:, 18)*pol_z(:, 0, kg)) + coef_xyz(19) = coef_xyz(19) + SUM(coef_xy(:, 19)*pol_z(:, 0, kg)) + coef_xyz(20) = coef_xyz(20) + SUM(coef_xy(:, 20)*pol_z(:, 0, kg)) + coef_xyz(21) = coef_xyz(21) + SUM(coef_xy(:, 21)*pol_z(:, 0, kg)) + coef_xyz(22) = coef_xyz(22) + SUM(coef_xy(:, 1)*pol_z(:, 1, kg)) + coef_xyz(23) = coef_xyz(23) + SUM(coef_xy(:, 2)*pol_z(:, 1, kg)) + coef_xyz(24) = coef_xyz(24) + SUM(coef_xy(:, 3)*pol_z(:, 1, kg)) + coef_xyz(25) = coef_xyz(25) + SUM(coef_xy(:, 4)*pol_z(:, 1, kg)) + coef_xyz(26) = coef_xyz(26) + SUM(coef_xy(:, 5)*pol_z(:, 1, kg)) + coef_xyz(27) = coef_xyz(27) + SUM(coef_xy(:, 7)*pol_z(:, 1, kg)) + coef_xyz(28) = coef_xyz(28) + SUM(coef_xy(:, 8)*pol_z(:, 1, kg)) + coef_xyz(29) = coef_xyz(29) + SUM(coef_xy(:, 9)*pol_z(:, 1, kg)) + coef_xyz(30) = coef_xyz(30) + SUM(coef_xy(:, 10)*pol_z(:, 1, kg)) + coef_xyz(31) = coef_xyz(31) + SUM(coef_xy(:, 12)*pol_z(:, 1, kg)) + coef_xyz(32) = coef_xyz(32) + SUM(coef_xy(:, 13)*pol_z(:, 1, kg)) + coef_xyz(33) = coef_xyz(33) + SUM(coef_xy(:, 14)*pol_z(:, 1, kg)) + coef_xyz(34) = coef_xyz(34) + SUM(coef_xy(:, 16)*pol_z(:, 1, kg)) + coef_xyz(35) = coef_xyz(35) + SUM(coef_xy(:, 17)*pol_z(:, 1, kg)) + coef_xyz(36) = coef_xyz(36) + SUM(coef_xy(:, 19)*pol_z(:, 1, kg)) + coef_xyz(37) = coef_xyz(37) + SUM(coef_xy(:, 1)*pol_z(:, 2, kg)) + coef_xyz(38) = coef_xyz(38) + SUM(coef_xy(:, 2)*pol_z(:, 2, kg)) + coef_xyz(39) = coef_xyz(39) + SUM(coef_xy(:, 3)*pol_z(:, 2, kg)) + coef_xyz(40) = coef_xyz(40) + SUM(coef_xy(:, 4)*pol_z(:, 2, kg)) + coef_xyz(41) = coef_xyz(41) + SUM(coef_xy(:, 7)*pol_z(:, 2, kg)) + coef_xyz(42) = coef_xyz(42) + SUM(coef_xy(:, 8)*pol_z(:, 2, kg)) + coef_xyz(43) = coef_xyz(43) + SUM(coef_xy(:, 9)*pol_z(:, 2, kg)) + coef_xyz(44) = coef_xyz(44) + SUM(coef_xy(:, 12)*pol_z(:, 2, kg)) + coef_xyz(45) = coef_xyz(45) + SUM(coef_xy(:, 13)*pol_z(:, 2, kg)) + coef_xyz(46) = coef_xyz(46) + SUM(coef_xy(:, 16)*pol_z(:, 2, kg)) + coef_xyz(47) = coef_xyz(47) + SUM(coef_xy(:, 1)*pol_z(:, 3, kg)) + coef_xyz(48) = coef_xyz(48) + SUM(coef_xy(:, 2)*pol_z(:, 3, kg)) + coef_xyz(49) = coef_xyz(49) + SUM(coef_xy(:, 3)*pol_z(:, 3, kg)) + coef_xyz(50) = coef_xyz(50) + SUM(coef_xy(:, 7)*pol_z(:, 3, kg)) + coef_xyz(51) = coef_xyz(51) + SUM(coef_xy(:, 8)*pol_z(:, 3, kg)) + coef_xyz(52) = coef_xyz(52) + SUM(coef_xy(:, 12)*pol_z(:, 3, kg)) + coef_xyz(53) = coef_xyz(53) + SUM(coef_xy(:, 1)*pol_z(:, 4, kg)) + coef_xyz(54) = coef_xyz(54) + SUM(coef_xy(:, 2)*pol_z(:, 4, kg)) + coef_xyz(55) = coef_xyz(55) + SUM(coef_xy(:, 7)*pol_z(:, 4, kg)) + coef_xyz(56) = coef_xyz(56) + SUM(coef_xy(:, 1)*pol_z(:, 5, kg)) END DO END SUBROUTINE integrate_core_5 @@ -928,13 +928,13 @@ SUBROUTINE integrate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, lxp, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s01, s02, s03, s04 sci = 1 @@ -942,23 +942,23 @@ SUBROUTINE integrate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -968,209 +968,209 @@ SUBROUTINE integrate_core_6(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s03 = grid(i, j2, k) s04 = grid(i, j2, k2) DO lxp = 0, lp - coef_x(1, lxp) = coef_x(1, lxp)+s01*pol_x(lxp, ig) - coef_x(2, lxp) = coef_x(2, lxp)+s02*pol_x(lxp, ig) - coef_x(3, lxp) = coef_x(3, lxp)+s03*pol_x(lxp, ig) - coef_x(4, lxp) = coef_x(4, lxp)+s04*pol_x(lxp, ig) + coef_x(1, lxp) = coef_x(1, lxp) + s01*pol_x(lxp, ig) + coef_x(2, lxp) = coef_x(2, lxp) + s02*pol_x(lxp, ig) + coef_x(3, lxp) = coef_x(3, lxp) + s03*pol_x(lxp, ig) + coef_x(4, lxp) = coef_x(4, lxp) + s04*pol_x(lxp, ig) ENDDO END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 2)*pol_y(1, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 2)*pol_y(1, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 2)*pol_y(2, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 2)*pol_y(2, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(1, 3)*pol_y(1, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(2, 3)*pol_y(1, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(3, 3)*pol_y(2, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(4, 3)*pol_y(2, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(1, 4)*pol_y(1, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(2, 4)*pol_y(1, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(3, 4)*pol_y(2, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(4, 4)*pol_y(2, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(1, 5)*pol_y(1, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(2, 5)*pol_y(1, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(3, 5)*pol_y(2, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(4, 5)*pol_y(2, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(1, 6)*pol_y(1, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(2, 6)*pol_y(1, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(3, 6)*pol_y(2, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(4, 6)*pol_y(2, 0, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(4, 0)*pol_y(2, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(1, 1)*pol_y(1, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(2, 1)*pol_y(1, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(3, 1)*pol_y(2, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(4, 1)*pol_y(2, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(1, 2)*pol_y(1, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(2, 2)*pol_y(1, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(3, 2)*pol_y(2, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(4, 2)*pol_y(2, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(1, 3)*pol_y(1, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(2, 3)*pol_y(1, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(3, 3)*pol_y(2, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(4, 3)*pol_y(2, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(1, 4)*pol_y(1, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(2, 4)*pol_y(1, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(3, 4)*pol_y(2, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(4, 4)*pol_y(2, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(1, 5)*pol_y(1, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(2, 5)*pol_y(1, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(3, 5)*pol_y(2, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(4, 5)*pol_y(2, 1, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(1, 0)*pol_y(1, 2, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(2, 0)*pol_y(1, 2, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(3, 0)*pol_y(2, 2, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(4, 0)*pol_y(2, 2, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(1, 1)*pol_y(1, 2, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(2, 1)*pol_y(1, 2, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(3, 1)*pol_y(2, 2, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(4, 1)*pol_y(2, 2, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(1, 2)*pol_y(1, 2, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(2, 2)*pol_y(1, 2, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(3, 2)*pol_y(2, 2, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(4, 2)*pol_y(2, 2, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(1, 3)*pol_y(1, 2, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(2, 3)*pol_y(1, 2, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(3, 3)*pol_y(2, 2, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(4, 3)*pol_y(2, 2, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(1, 4)*pol_y(1, 2, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(2, 4)*pol_y(1, 2, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(3, 4)*pol_y(2, 2, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(4, 4)*pol_y(2, 2, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(1, 0)*pol_y(1, 3, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(2, 0)*pol_y(1, 3, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(3, 0)*pol_y(2, 3, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(4, 0)*pol_y(2, 3, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(1, 1)*pol_y(1, 3, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(2, 1)*pol_y(1, 3, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(3, 1)*pol_y(2, 3, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(4, 1)*pol_y(2, 3, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(1, 2)*pol_y(1, 3, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(2, 2)*pol_y(1, 3, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(3, 2)*pol_y(2, 3, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(4, 2)*pol_y(2, 3, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(1, 3)*pol_y(1, 3, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(2, 3)*pol_y(1, 3, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(3, 3)*pol_y(2, 3, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(4, 3)*pol_y(2, 3, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(1, 0)*pol_y(1, 4, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(2, 0)*pol_y(1, 4, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(3, 0)*pol_y(2, 4, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(4, 0)*pol_y(2, 4, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(1, 1)*pol_y(1, 4, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(2, 1)*pol_y(1, 4, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(3, 1)*pol_y(2, 4, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(4, 1)*pol_y(2, 4, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(1, 2)*pol_y(1, 4, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(2, 2)*pol_y(1, 4, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(3, 2)*pol_y(2, 4, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(4, 2)*pol_y(2, 4, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(1, 0)*pol_y(1, 5, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(2, 0)*pol_y(1, 5, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(3, 0)*pol_y(2, 5, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(4, 0)*pol_y(2, 5, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(1, 1)*pol_y(1, 5, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(2, 1)*pol_y(1, 5, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(3, 1)*pol_y(2, 5, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(4, 1)*pol_y(2, 5, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(1, 0)*pol_y(1, 6, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(2, 0)*pol_y(1, 6, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(3, 0)*pol_y(2, 6, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(4, 0)*pol_y(2, 6, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 2)*pol_y(1, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 2)*pol_y(1, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 2)*pol_y(2, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 2)*pol_y(2, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(1, 3)*pol_y(1, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(2, 3)*pol_y(1, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(3, 3)*pol_y(2, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(4, 3)*pol_y(2, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(1, 4)*pol_y(1, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(2, 4)*pol_y(1, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(3, 4)*pol_y(2, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(4, 4)*pol_y(2, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(1, 5)*pol_y(1, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(2, 5)*pol_y(1, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(3, 5)*pol_y(2, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(4, 5)*pol_y(2, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(1, 6)*pol_y(1, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(2, 6)*pol_y(1, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(3, 6)*pol_y(2, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(4, 6)*pol_y(2, 0, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(1, 1)*pol_y(1, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(2, 1)*pol_y(1, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(3, 1)*pol_y(2, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(4, 1)*pol_y(2, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(1, 2)*pol_y(1, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(2, 2)*pol_y(1, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(3, 2)*pol_y(2, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(4, 2)*pol_y(2, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(1, 3)*pol_y(1, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(2, 3)*pol_y(1, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(3, 3)*pol_y(2, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(4, 3)*pol_y(2, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(1, 4)*pol_y(1, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(2, 4)*pol_y(1, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(3, 4)*pol_y(2, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(4, 4)*pol_y(2, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(1, 5)*pol_y(1, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(2, 5)*pol_y(1, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(3, 5)*pol_y(2, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(4, 5)*pol_y(2, 1, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(1, 0)*pol_y(1, 2, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(2, 0)*pol_y(1, 2, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(3, 0)*pol_y(2, 2, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(4, 0)*pol_y(2, 2, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(1, 1)*pol_y(1, 2, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(2, 1)*pol_y(1, 2, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(3, 1)*pol_y(2, 2, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(4, 1)*pol_y(2, 2, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(1, 2)*pol_y(1, 2, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(2, 2)*pol_y(1, 2, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(3, 2)*pol_y(2, 2, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(4, 2)*pol_y(2, 2, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(1, 3)*pol_y(1, 2, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(2, 3)*pol_y(1, 2, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(3, 3)*pol_y(2, 2, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(4, 3)*pol_y(2, 2, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(1, 4)*pol_y(1, 2, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(2, 4)*pol_y(1, 2, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(3, 4)*pol_y(2, 2, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(4, 4)*pol_y(2, 2, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(1, 0)*pol_y(1, 3, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(2, 0)*pol_y(1, 3, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(3, 0)*pol_y(2, 3, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(4, 0)*pol_y(2, 3, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(1, 1)*pol_y(1, 3, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(2, 1)*pol_y(1, 3, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(3, 1)*pol_y(2, 3, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(4, 1)*pol_y(2, 3, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(1, 2)*pol_y(1, 3, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(2, 2)*pol_y(1, 3, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(3, 2)*pol_y(2, 3, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(4, 2)*pol_y(2, 3, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(1, 3)*pol_y(1, 3, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(2, 3)*pol_y(1, 3, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(3, 3)*pol_y(2, 3, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(4, 3)*pol_y(2, 3, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(1, 0)*pol_y(1, 4, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(2, 0)*pol_y(1, 4, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(3, 0)*pol_y(2, 4, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(4, 0)*pol_y(2, 4, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(1, 1)*pol_y(1, 4, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(2, 1)*pol_y(1, 4, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(3, 1)*pol_y(2, 4, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(4, 1)*pol_y(2, 4, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(1, 2)*pol_y(1, 4, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(2, 2)*pol_y(1, 4, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(3, 2)*pol_y(2, 4, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(4, 2)*pol_y(2, 4, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(1, 0)*pol_y(1, 5, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(2, 0)*pol_y(1, 5, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(3, 0)*pol_y(2, 5, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(4, 0)*pol_y(2, 5, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(1, 1)*pol_y(1, 5, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(2, 1)*pol_y(1, 5, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(3, 1)*pol_y(2, 5, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(4, 1)*pol_y(2, 5, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(1, 0)*pol_y(1, 6, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(2, 0)*pol_y(1, 6, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(3, 0)*pol_y(2, 6, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(4, 0)*pol_y(2, 6, jg) END DO - coef_xyz(1) = coef_xyz(1)+SUM(coef_xy(:, 1)*pol_z(:, 0, kg)) - coef_xyz(2) = coef_xyz(2)+SUM(coef_xy(:, 2)*pol_z(:, 0, kg)) - coef_xyz(3) = coef_xyz(3)+SUM(coef_xy(:, 3)*pol_z(:, 0, kg)) - coef_xyz(4) = coef_xyz(4)+SUM(coef_xy(:, 4)*pol_z(:, 0, kg)) - coef_xyz(5) = coef_xyz(5)+SUM(coef_xy(:, 5)*pol_z(:, 0, kg)) - coef_xyz(6) = coef_xyz(6)+SUM(coef_xy(:, 6)*pol_z(:, 0, kg)) - coef_xyz(7) = coef_xyz(7)+SUM(coef_xy(:, 7)*pol_z(:, 0, kg)) - coef_xyz(8) = coef_xyz(8)+SUM(coef_xy(:, 8)*pol_z(:, 0, kg)) - coef_xyz(9) = coef_xyz(9)+SUM(coef_xy(:, 9)*pol_z(:, 0, kg)) - coef_xyz(10) = coef_xyz(10)+SUM(coef_xy(:, 10)*pol_z(:, 0, kg)) - coef_xyz(11) = coef_xyz(11)+SUM(coef_xy(:, 11)*pol_z(:, 0, kg)) - coef_xyz(12) = coef_xyz(12)+SUM(coef_xy(:, 12)*pol_z(:, 0, kg)) - coef_xyz(13) = coef_xyz(13)+SUM(coef_xy(:, 13)*pol_z(:, 0, kg)) - coef_xyz(14) = coef_xyz(14)+SUM(coef_xy(:, 14)*pol_z(:, 0, kg)) - coef_xyz(15) = coef_xyz(15)+SUM(coef_xy(:, 15)*pol_z(:, 0, kg)) - coef_xyz(16) = coef_xyz(16)+SUM(coef_xy(:, 16)*pol_z(:, 0, kg)) - coef_xyz(17) = coef_xyz(17)+SUM(coef_xy(:, 17)*pol_z(:, 0, kg)) - coef_xyz(18) = coef_xyz(18)+SUM(coef_xy(:, 18)*pol_z(:, 0, kg)) - coef_xyz(19) = coef_xyz(19)+SUM(coef_xy(:, 19)*pol_z(:, 0, kg)) - coef_xyz(20) = coef_xyz(20)+SUM(coef_xy(:, 20)*pol_z(:, 0, kg)) - coef_xyz(21) = coef_xyz(21)+SUM(coef_xy(:, 21)*pol_z(:, 0, kg)) - coef_xyz(22) = coef_xyz(22)+SUM(coef_xy(:, 22)*pol_z(:, 0, kg)) - coef_xyz(23) = coef_xyz(23)+SUM(coef_xy(:, 23)*pol_z(:, 0, kg)) - coef_xyz(24) = coef_xyz(24)+SUM(coef_xy(:, 24)*pol_z(:, 0, kg)) - coef_xyz(25) = coef_xyz(25)+SUM(coef_xy(:, 25)*pol_z(:, 0, kg)) - coef_xyz(26) = coef_xyz(26)+SUM(coef_xy(:, 26)*pol_z(:, 0, kg)) - coef_xyz(27) = coef_xyz(27)+SUM(coef_xy(:, 27)*pol_z(:, 0, kg)) - coef_xyz(28) = coef_xyz(28)+SUM(coef_xy(:, 28)*pol_z(:, 0, kg)) - coef_xyz(29) = coef_xyz(29)+SUM(coef_xy(:, 1)*pol_z(:, 1, kg)) - coef_xyz(30) = coef_xyz(30)+SUM(coef_xy(:, 2)*pol_z(:, 1, kg)) - coef_xyz(31) = coef_xyz(31)+SUM(coef_xy(:, 3)*pol_z(:, 1, kg)) - coef_xyz(32) = coef_xyz(32)+SUM(coef_xy(:, 4)*pol_z(:, 1, kg)) - coef_xyz(33) = coef_xyz(33)+SUM(coef_xy(:, 5)*pol_z(:, 1, kg)) - coef_xyz(34) = coef_xyz(34)+SUM(coef_xy(:, 6)*pol_z(:, 1, kg)) - coef_xyz(35) = coef_xyz(35)+SUM(coef_xy(:, 8)*pol_z(:, 1, kg)) - coef_xyz(36) = coef_xyz(36)+SUM(coef_xy(:, 9)*pol_z(:, 1, kg)) - coef_xyz(37) = coef_xyz(37)+SUM(coef_xy(:, 10)*pol_z(:, 1, kg)) - coef_xyz(38) = coef_xyz(38)+SUM(coef_xy(:, 11)*pol_z(:, 1, kg)) - coef_xyz(39) = coef_xyz(39)+SUM(coef_xy(:, 12)*pol_z(:, 1, kg)) - coef_xyz(40) = coef_xyz(40)+SUM(coef_xy(:, 14)*pol_z(:, 1, kg)) - coef_xyz(41) = coef_xyz(41)+SUM(coef_xy(:, 15)*pol_z(:, 1, kg)) - coef_xyz(42) = coef_xyz(42)+SUM(coef_xy(:, 16)*pol_z(:, 1, kg)) - coef_xyz(43) = coef_xyz(43)+SUM(coef_xy(:, 17)*pol_z(:, 1, kg)) - coef_xyz(44) = coef_xyz(44)+SUM(coef_xy(:, 19)*pol_z(:, 1, kg)) - coef_xyz(45) = coef_xyz(45)+SUM(coef_xy(:, 20)*pol_z(:, 1, kg)) - coef_xyz(46) = coef_xyz(46)+SUM(coef_xy(:, 21)*pol_z(:, 1, kg)) - coef_xyz(47) = coef_xyz(47)+SUM(coef_xy(:, 23)*pol_z(:, 1, kg)) - coef_xyz(48) = coef_xyz(48)+SUM(coef_xy(:, 24)*pol_z(:, 1, kg)) - coef_xyz(49) = coef_xyz(49)+SUM(coef_xy(:, 26)*pol_z(:, 1, kg)) - coef_xyz(50) = coef_xyz(50)+SUM(coef_xy(:, 1)*pol_z(:, 2, kg)) - coef_xyz(51) = coef_xyz(51)+SUM(coef_xy(:, 2)*pol_z(:, 2, kg)) - coef_xyz(52) = coef_xyz(52)+SUM(coef_xy(:, 3)*pol_z(:, 2, kg)) - coef_xyz(53) = coef_xyz(53)+SUM(coef_xy(:, 4)*pol_z(:, 2, kg)) - coef_xyz(54) = coef_xyz(54)+SUM(coef_xy(:, 5)*pol_z(:, 2, kg)) - coef_xyz(55) = coef_xyz(55)+SUM(coef_xy(:, 8)*pol_z(:, 2, kg)) - coef_xyz(56) = coef_xyz(56)+SUM(coef_xy(:, 9)*pol_z(:, 2, kg)) - coef_xyz(57) = coef_xyz(57)+SUM(coef_xy(:, 10)*pol_z(:, 2, kg)) - coef_xyz(58) = coef_xyz(58)+SUM(coef_xy(:, 11)*pol_z(:, 2, kg)) - coef_xyz(59) = coef_xyz(59)+SUM(coef_xy(:, 14)*pol_z(:, 2, kg)) - coef_xyz(60) = coef_xyz(60)+SUM(coef_xy(:, 15)*pol_z(:, 2, kg)) - coef_xyz(61) = coef_xyz(61)+SUM(coef_xy(:, 16)*pol_z(:, 2, kg)) - coef_xyz(62) = coef_xyz(62)+SUM(coef_xy(:, 19)*pol_z(:, 2, kg)) - coef_xyz(63) = coef_xyz(63)+SUM(coef_xy(:, 20)*pol_z(:, 2, kg)) - coef_xyz(64) = coef_xyz(64)+SUM(coef_xy(:, 23)*pol_z(:, 2, kg)) - coef_xyz(65) = coef_xyz(65)+SUM(coef_xy(:, 1)*pol_z(:, 3, kg)) - coef_xyz(66) = coef_xyz(66)+SUM(coef_xy(:, 2)*pol_z(:, 3, kg)) - coef_xyz(67) = coef_xyz(67)+SUM(coef_xy(:, 3)*pol_z(:, 3, kg)) - coef_xyz(68) = coef_xyz(68)+SUM(coef_xy(:, 4)*pol_z(:, 3, kg)) - coef_xyz(69) = coef_xyz(69)+SUM(coef_xy(:, 8)*pol_z(:, 3, kg)) - coef_xyz(70) = coef_xyz(70)+SUM(coef_xy(:, 9)*pol_z(:, 3, kg)) - coef_xyz(71) = coef_xyz(71)+SUM(coef_xy(:, 10)*pol_z(:, 3, kg)) - coef_xyz(72) = coef_xyz(72)+SUM(coef_xy(:, 14)*pol_z(:, 3, kg)) - coef_xyz(73) = coef_xyz(73)+SUM(coef_xy(:, 15)*pol_z(:, 3, kg)) - coef_xyz(74) = coef_xyz(74)+SUM(coef_xy(:, 19)*pol_z(:, 3, kg)) - coef_xyz(75) = coef_xyz(75)+SUM(coef_xy(:, 1)*pol_z(:, 4, kg)) - coef_xyz(76) = coef_xyz(76)+SUM(coef_xy(:, 2)*pol_z(:, 4, kg)) - coef_xyz(77) = coef_xyz(77)+SUM(coef_xy(:, 3)*pol_z(:, 4, kg)) - coef_xyz(78) = coef_xyz(78)+SUM(coef_xy(:, 8)*pol_z(:, 4, kg)) - coef_xyz(79) = coef_xyz(79)+SUM(coef_xy(:, 9)*pol_z(:, 4, kg)) - coef_xyz(80) = coef_xyz(80)+SUM(coef_xy(:, 14)*pol_z(:, 4, kg)) - coef_xyz(81) = coef_xyz(81)+SUM(coef_xy(:, 1)*pol_z(:, 5, kg)) - coef_xyz(82) = coef_xyz(82)+SUM(coef_xy(:, 2)*pol_z(:, 5, kg)) - coef_xyz(83) = coef_xyz(83)+SUM(coef_xy(:, 8)*pol_z(:, 5, kg)) - coef_xyz(84) = coef_xyz(84)+SUM(coef_xy(:, 1)*pol_z(:, 6, kg)) + coef_xyz(1) = coef_xyz(1) + SUM(coef_xy(:, 1)*pol_z(:, 0, kg)) + coef_xyz(2) = coef_xyz(2) + SUM(coef_xy(:, 2)*pol_z(:, 0, kg)) + coef_xyz(3) = coef_xyz(3) + SUM(coef_xy(:, 3)*pol_z(:, 0, kg)) + coef_xyz(4) = coef_xyz(4) + SUM(coef_xy(:, 4)*pol_z(:, 0, kg)) + coef_xyz(5) = coef_xyz(5) + SUM(coef_xy(:, 5)*pol_z(:, 0, kg)) + coef_xyz(6) = coef_xyz(6) + SUM(coef_xy(:, 6)*pol_z(:, 0, kg)) + coef_xyz(7) = coef_xyz(7) + SUM(coef_xy(:, 7)*pol_z(:, 0, kg)) + coef_xyz(8) = coef_xyz(8) + SUM(coef_xy(:, 8)*pol_z(:, 0, kg)) + coef_xyz(9) = coef_xyz(9) + SUM(coef_xy(:, 9)*pol_z(:, 0, kg)) + coef_xyz(10) = coef_xyz(10) + SUM(coef_xy(:, 10)*pol_z(:, 0, kg)) + coef_xyz(11) = coef_xyz(11) + SUM(coef_xy(:, 11)*pol_z(:, 0, kg)) + coef_xyz(12) = coef_xyz(12) + SUM(coef_xy(:, 12)*pol_z(:, 0, kg)) + coef_xyz(13) = coef_xyz(13) + SUM(coef_xy(:, 13)*pol_z(:, 0, kg)) + coef_xyz(14) = coef_xyz(14) + SUM(coef_xy(:, 14)*pol_z(:, 0, kg)) + coef_xyz(15) = coef_xyz(15) + SUM(coef_xy(:, 15)*pol_z(:, 0, kg)) + coef_xyz(16) = coef_xyz(16) + SUM(coef_xy(:, 16)*pol_z(:, 0, kg)) + coef_xyz(17) = coef_xyz(17) + SUM(coef_xy(:, 17)*pol_z(:, 0, kg)) + coef_xyz(18) = coef_xyz(18) + SUM(coef_xy(:, 18)*pol_z(:, 0, kg)) + coef_xyz(19) = coef_xyz(19) + SUM(coef_xy(:, 19)*pol_z(:, 0, kg)) + coef_xyz(20) = coef_xyz(20) + SUM(coef_xy(:, 20)*pol_z(:, 0, kg)) + coef_xyz(21) = coef_xyz(21) + SUM(coef_xy(:, 21)*pol_z(:, 0, kg)) + coef_xyz(22) = coef_xyz(22) + SUM(coef_xy(:, 22)*pol_z(:, 0, kg)) + coef_xyz(23) = coef_xyz(23) + SUM(coef_xy(:, 23)*pol_z(:, 0, kg)) + coef_xyz(24) = coef_xyz(24) + SUM(coef_xy(:, 24)*pol_z(:, 0, kg)) + coef_xyz(25) = coef_xyz(25) + SUM(coef_xy(:, 25)*pol_z(:, 0, kg)) + coef_xyz(26) = coef_xyz(26) + SUM(coef_xy(:, 26)*pol_z(:, 0, kg)) + coef_xyz(27) = coef_xyz(27) + SUM(coef_xy(:, 27)*pol_z(:, 0, kg)) + coef_xyz(28) = coef_xyz(28) + SUM(coef_xy(:, 28)*pol_z(:, 0, kg)) + coef_xyz(29) = coef_xyz(29) + SUM(coef_xy(:, 1)*pol_z(:, 1, kg)) + coef_xyz(30) = coef_xyz(30) + SUM(coef_xy(:, 2)*pol_z(:, 1, kg)) + coef_xyz(31) = coef_xyz(31) + SUM(coef_xy(:, 3)*pol_z(:, 1, kg)) + coef_xyz(32) = coef_xyz(32) + SUM(coef_xy(:, 4)*pol_z(:, 1, kg)) + coef_xyz(33) = coef_xyz(33) + SUM(coef_xy(:, 5)*pol_z(:, 1, kg)) + coef_xyz(34) = coef_xyz(34) + SUM(coef_xy(:, 6)*pol_z(:, 1, kg)) + coef_xyz(35) = coef_xyz(35) + SUM(coef_xy(:, 8)*pol_z(:, 1, kg)) + coef_xyz(36) = coef_xyz(36) + SUM(coef_xy(:, 9)*pol_z(:, 1, kg)) + coef_xyz(37) = coef_xyz(37) + SUM(coef_xy(:, 10)*pol_z(:, 1, kg)) + coef_xyz(38) = coef_xyz(38) + SUM(coef_xy(:, 11)*pol_z(:, 1, kg)) + coef_xyz(39) = coef_xyz(39) + SUM(coef_xy(:, 12)*pol_z(:, 1, kg)) + coef_xyz(40) = coef_xyz(40) + SUM(coef_xy(:, 14)*pol_z(:, 1, kg)) + coef_xyz(41) = coef_xyz(41) + SUM(coef_xy(:, 15)*pol_z(:, 1, kg)) + coef_xyz(42) = coef_xyz(42) + SUM(coef_xy(:, 16)*pol_z(:, 1, kg)) + coef_xyz(43) = coef_xyz(43) + SUM(coef_xy(:, 17)*pol_z(:, 1, kg)) + coef_xyz(44) = coef_xyz(44) + SUM(coef_xy(:, 19)*pol_z(:, 1, kg)) + coef_xyz(45) = coef_xyz(45) + SUM(coef_xy(:, 20)*pol_z(:, 1, kg)) + coef_xyz(46) = coef_xyz(46) + SUM(coef_xy(:, 21)*pol_z(:, 1, kg)) + coef_xyz(47) = coef_xyz(47) + SUM(coef_xy(:, 23)*pol_z(:, 1, kg)) + coef_xyz(48) = coef_xyz(48) + SUM(coef_xy(:, 24)*pol_z(:, 1, kg)) + coef_xyz(49) = coef_xyz(49) + SUM(coef_xy(:, 26)*pol_z(:, 1, kg)) + coef_xyz(50) = coef_xyz(50) + SUM(coef_xy(:, 1)*pol_z(:, 2, kg)) + coef_xyz(51) = coef_xyz(51) + SUM(coef_xy(:, 2)*pol_z(:, 2, kg)) + coef_xyz(52) = coef_xyz(52) + SUM(coef_xy(:, 3)*pol_z(:, 2, kg)) + coef_xyz(53) = coef_xyz(53) + SUM(coef_xy(:, 4)*pol_z(:, 2, kg)) + coef_xyz(54) = coef_xyz(54) + SUM(coef_xy(:, 5)*pol_z(:, 2, kg)) + coef_xyz(55) = coef_xyz(55) + SUM(coef_xy(:, 8)*pol_z(:, 2, kg)) + coef_xyz(56) = coef_xyz(56) + SUM(coef_xy(:, 9)*pol_z(:, 2, kg)) + coef_xyz(57) = coef_xyz(57) + SUM(coef_xy(:, 10)*pol_z(:, 2, kg)) + coef_xyz(58) = coef_xyz(58) + SUM(coef_xy(:, 11)*pol_z(:, 2, kg)) + coef_xyz(59) = coef_xyz(59) + SUM(coef_xy(:, 14)*pol_z(:, 2, kg)) + coef_xyz(60) = coef_xyz(60) + SUM(coef_xy(:, 15)*pol_z(:, 2, kg)) + coef_xyz(61) = coef_xyz(61) + SUM(coef_xy(:, 16)*pol_z(:, 2, kg)) + coef_xyz(62) = coef_xyz(62) + SUM(coef_xy(:, 19)*pol_z(:, 2, kg)) + coef_xyz(63) = coef_xyz(63) + SUM(coef_xy(:, 20)*pol_z(:, 2, kg)) + coef_xyz(64) = coef_xyz(64) + SUM(coef_xy(:, 23)*pol_z(:, 2, kg)) + coef_xyz(65) = coef_xyz(65) + SUM(coef_xy(:, 1)*pol_z(:, 3, kg)) + coef_xyz(66) = coef_xyz(66) + SUM(coef_xy(:, 2)*pol_z(:, 3, kg)) + coef_xyz(67) = coef_xyz(67) + SUM(coef_xy(:, 3)*pol_z(:, 3, kg)) + coef_xyz(68) = coef_xyz(68) + SUM(coef_xy(:, 4)*pol_z(:, 3, kg)) + coef_xyz(69) = coef_xyz(69) + SUM(coef_xy(:, 8)*pol_z(:, 3, kg)) + coef_xyz(70) = coef_xyz(70) + SUM(coef_xy(:, 9)*pol_z(:, 3, kg)) + coef_xyz(71) = coef_xyz(71) + SUM(coef_xy(:, 10)*pol_z(:, 3, kg)) + coef_xyz(72) = coef_xyz(72) + SUM(coef_xy(:, 14)*pol_z(:, 3, kg)) + coef_xyz(73) = coef_xyz(73) + SUM(coef_xy(:, 15)*pol_z(:, 3, kg)) + coef_xyz(74) = coef_xyz(74) + SUM(coef_xy(:, 19)*pol_z(:, 3, kg)) + coef_xyz(75) = coef_xyz(75) + SUM(coef_xy(:, 1)*pol_z(:, 4, kg)) + coef_xyz(76) = coef_xyz(76) + SUM(coef_xy(:, 2)*pol_z(:, 4, kg)) + coef_xyz(77) = coef_xyz(77) + SUM(coef_xy(:, 3)*pol_z(:, 4, kg)) + coef_xyz(78) = coef_xyz(78) + SUM(coef_xy(:, 8)*pol_z(:, 4, kg)) + coef_xyz(79) = coef_xyz(79) + SUM(coef_xy(:, 9)*pol_z(:, 4, kg)) + coef_xyz(80) = coef_xyz(80) + SUM(coef_xy(:, 14)*pol_z(:, 4, kg)) + coef_xyz(81) = coef_xyz(81) + SUM(coef_xy(:, 1)*pol_z(:, 5, kg)) + coef_xyz(82) = coef_xyz(82) + SUM(coef_xy(:, 2)*pol_z(:, 5, kg)) + coef_xyz(83) = coef_xyz(83) + SUM(coef_xy(:, 8)*pol_z(:, 5, kg)) + coef_xyz(84) = coef_xyz(84) + SUM(coef_xy(:, 1)*pol_z(:, 6, kg)) END DO END SUBROUTINE integrate_core_6 @@ -1197,13 +1197,13 @@ SUBROUTINE integrate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s(4) sci = 1 @@ -1211,23 +1211,23 @@ SUBROUTINE integrate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -1236,400 +1236,400 @@ SUBROUTINE integrate_core_7(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s(2) = grid(i, j, k2) s(3) = grid(i, j2, k) s(4) = grid(i, j2, k2) - coef_x(:, 0) = coef_x(:, 0)+s(:)*pol_x(0, ig) - coef_x(:, 1) = coef_x(:, 1)+s(:)*pol_x(1, ig) - coef_x(:, 2) = coef_x(:, 2)+s(:)*pol_x(2, ig) - coef_x(:, 3) = coef_x(:, 3)+s(:)*pol_x(3, ig) - coef_x(:, 4) = coef_x(:, 4)+s(:)*pol_x(4, ig) - coef_x(:, 5) = coef_x(:, 5)+s(:)*pol_x(5, ig) - coef_x(:, 6) = coef_x(:, 6)+s(:)*pol_x(6, ig) - coef_x(:, 7) = coef_x(:, 7)+s(:)*pol_x(7, ig) + coef_x(:, 0) = coef_x(:, 0) + s(:)*pol_x(0, ig) + coef_x(:, 1) = coef_x(:, 1) + s(:)*pol_x(1, ig) + coef_x(:, 2) = coef_x(:, 2) + s(:)*pol_x(2, ig) + coef_x(:, 3) = coef_x(:, 3) + s(:)*pol_x(3, ig) + coef_x(:, 4) = coef_x(:, 4) + s(:)*pol_x(4, ig) + coef_x(:, 5) = coef_x(:, 5) + s(:)*pol_x(5, ig) + coef_x(:, 6) = coef_x(:, 6) + s(:)*pol_x(6, ig) + coef_x(:, 7) = coef_x(:, 7) + s(:)*pol_x(7, ig) END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 2)*pol_y(1, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 2)*pol_y(1, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 2)*pol_y(2, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 2)*pol_y(2, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(1, 3)*pol_y(1, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(2, 3)*pol_y(1, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(3, 3)*pol_y(2, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(4, 3)*pol_y(2, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(1, 4)*pol_y(1, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(2, 4)*pol_y(1, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(3, 4)*pol_y(2, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(4, 4)*pol_y(2, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(1, 5)*pol_y(1, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(2, 5)*pol_y(1, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(3, 5)*pol_y(2, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(4, 5)*pol_y(2, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(1, 6)*pol_y(1, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(2, 6)*pol_y(1, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(3, 6)*pol_y(2, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(4, 6)*pol_y(2, 0, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(1, 7)*pol_y(1, 0, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(2, 7)*pol_y(1, 0, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(3, 7)*pol_y(2, 0, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(4, 7)*pol_y(2, 0, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(4, 0)*pol_y(2, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(1, 1)*pol_y(1, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(2, 1)*pol_y(1, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(3, 1)*pol_y(2, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(4, 1)*pol_y(2, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(1, 2)*pol_y(1, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(2, 2)*pol_y(1, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(3, 2)*pol_y(2, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(4, 2)*pol_y(2, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(1, 3)*pol_y(1, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(2, 3)*pol_y(1, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(3, 3)*pol_y(2, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(4, 3)*pol_y(2, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(1, 4)*pol_y(1, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(2, 4)*pol_y(1, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(3, 4)*pol_y(2, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(4, 4)*pol_y(2, 1, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(1, 5)*pol_y(1, 1, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(2, 5)*pol_y(1, 1, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(3, 5)*pol_y(2, 1, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(4, 5)*pol_y(2, 1, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(1, 6)*pol_y(1, 1, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(2, 6)*pol_y(1, 1, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(3, 6)*pol_y(2, 1, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(4, 6)*pol_y(2, 1, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(1, 0)*pol_y(1, 2, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(2, 0)*pol_y(1, 2, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(3, 0)*pol_y(2, 2, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(4, 0)*pol_y(2, 2, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(1, 1)*pol_y(1, 2, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(2, 1)*pol_y(1, 2, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(3, 1)*pol_y(2, 2, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(4, 1)*pol_y(2, 2, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(1, 2)*pol_y(1, 2, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(2, 2)*pol_y(1, 2, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(3, 2)*pol_y(2, 2, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(4, 2)*pol_y(2, 2, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(1, 3)*pol_y(1, 2, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(2, 3)*pol_y(1, 2, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(3, 3)*pol_y(2, 2, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(4, 3)*pol_y(2, 2, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(1, 4)*pol_y(1, 2, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(2, 4)*pol_y(1, 2, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(3, 4)*pol_y(2, 2, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(4, 4)*pol_y(2, 2, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(1, 5)*pol_y(1, 2, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(2, 5)*pol_y(1, 2, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(3, 5)*pol_y(2, 2, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(4, 5)*pol_y(2, 2, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(1, 0)*pol_y(1, 3, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(2, 0)*pol_y(1, 3, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(3, 0)*pol_y(2, 3, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(4, 0)*pol_y(2, 3, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(1, 1)*pol_y(1, 3, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(2, 1)*pol_y(1, 3, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(3, 1)*pol_y(2, 3, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(4, 1)*pol_y(2, 3, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(1, 2)*pol_y(1, 3, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(2, 2)*pol_y(1, 3, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(3, 2)*pol_y(2, 3, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(4, 2)*pol_y(2, 3, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(1, 3)*pol_y(1, 3, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(2, 3)*pol_y(1, 3, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(3, 3)*pol_y(2, 3, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(4, 3)*pol_y(2, 3, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(1, 4)*pol_y(1, 3, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(2, 4)*pol_y(1, 3, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(3, 4)*pol_y(2, 3, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(4, 4)*pol_y(2, 3, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(1, 0)*pol_y(1, 4, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(2, 0)*pol_y(1, 4, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(3, 0)*pol_y(2, 4, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(4, 0)*pol_y(2, 4, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(1, 1)*pol_y(1, 4, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(2, 1)*pol_y(1, 4, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(3, 1)*pol_y(2, 4, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(4, 1)*pol_y(2, 4, jg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_x(1, 2)*pol_y(1, 4, jg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_x(2, 2)*pol_y(1, 4, jg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_x(3, 2)*pol_y(2, 4, jg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_x(4, 2)*pol_y(2, 4, jg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_x(1, 3)*pol_y(1, 4, jg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_x(2, 3)*pol_y(1, 4, jg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_x(3, 3)*pol_y(2, 4, jg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_x(4, 3)*pol_y(2, 4, jg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_x(1, 0)*pol_y(1, 5, jg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_x(2, 0)*pol_y(1, 5, jg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_x(3, 0)*pol_y(2, 5, jg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_x(4, 0)*pol_y(2, 5, jg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_x(1, 1)*pol_y(1, 5, jg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_x(2, 1)*pol_y(1, 5, jg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_x(3, 1)*pol_y(2, 5, jg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_x(4, 1)*pol_y(2, 5, jg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_x(1, 2)*pol_y(1, 5, jg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_x(2, 2)*pol_y(1, 5, jg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_x(3, 2)*pol_y(2, 5, jg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_x(4, 2)*pol_y(2, 5, jg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_x(1, 0)*pol_y(1, 6, jg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_x(2, 0)*pol_y(1, 6, jg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_x(3, 0)*pol_y(2, 6, jg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_x(4, 0)*pol_y(2, 6, jg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_x(1, 1)*pol_y(1, 6, jg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_x(2, 1)*pol_y(1, 6, jg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_x(3, 1)*pol_y(2, 6, jg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_x(4, 1)*pol_y(2, 6, jg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_x(1, 0)*pol_y(1, 7, jg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_x(2, 0)*pol_y(1, 7, jg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_x(3, 0)*pol_y(2, 7, jg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_x(4, 0)*pol_y(2, 7, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 2)*pol_y(1, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 2)*pol_y(1, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 2)*pol_y(2, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 2)*pol_y(2, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(1, 3)*pol_y(1, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(2, 3)*pol_y(1, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(3, 3)*pol_y(2, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(4, 3)*pol_y(2, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(1, 4)*pol_y(1, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(2, 4)*pol_y(1, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(3, 4)*pol_y(2, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(4, 4)*pol_y(2, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(1, 5)*pol_y(1, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(2, 5)*pol_y(1, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(3, 5)*pol_y(2, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(4, 5)*pol_y(2, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(1, 6)*pol_y(1, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(2, 6)*pol_y(1, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(3, 6)*pol_y(2, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(4, 6)*pol_y(2, 0, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(1, 7)*pol_y(1, 0, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(2, 7)*pol_y(1, 0, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(3, 7)*pol_y(2, 0, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(4, 7)*pol_y(2, 0, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(1, 1)*pol_y(1, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(2, 1)*pol_y(1, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(3, 1)*pol_y(2, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(4, 1)*pol_y(2, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(1, 2)*pol_y(1, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(2, 2)*pol_y(1, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(3, 2)*pol_y(2, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(4, 2)*pol_y(2, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(1, 3)*pol_y(1, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(2, 3)*pol_y(1, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(3, 3)*pol_y(2, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(4, 3)*pol_y(2, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(1, 4)*pol_y(1, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(2, 4)*pol_y(1, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(3, 4)*pol_y(2, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(4, 4)*pol_y(2, 1, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(1, 5)*pol_y(1, 1, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(2, 5)*pol_y(1, 1, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(3, 5)*pol_y(2, 1, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(4, 5)*pol_y(2, 1, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(1, 6)*pol_y(1, 1, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(2, 6)*pol_y(1, 1, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(3, 6)*pol_y(2, 1, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(4, 6)*pol_y(2, 1, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(1, 0)*pol_y(1, 2, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(2, 0)*pol_y(1, 2, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(3, 0)*pol_y(2, 2, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(4, 0)*pol_y(2, 2, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(1, 1)*pol_y(1, 2, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(2, 1)*pol_y(1, 2, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(3, 1)*pol_y(2, 2, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(4, 1)*pol_y(2, 2, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(1, 2)*pol_y(1, 2, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(2, 2)*pol_y(1, 2, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(3, 2)*pol_y(2, 2, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(4, 2)*pol_y(2, 2, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(1, 3)*pol_y(1, 2, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(2, 3)*pol_y(1, 2, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(3, 3)*pol_y(2, 2, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(4, 3)*pol_y(2, 2, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(1, 4)*pol_y(1, 2, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(2, 4)*pol_y(1, 2, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(3, 4)*pol_y(2, 2, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(4, 4)*pol_y(2, 2, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(1, 5)*pol_y(1, 2, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(2, 5)*pol_y(1, 2, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(3, 5)*pol_y(2, 2, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(4, 5)*pol_y(2, 2, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(1, 0)*pol_y(1, 3, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(2, 0)*pol_y(1, 3, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(3, 0)*pol_y(2, 3, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(4, 0)*pol_y(2, 3, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(1, 1)*pol_y(1, 3, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(2, 1)*pol_y(1, 3, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(3, 1)*pol_y(2, 3, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(4, 1)*pol_y(2, 3, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(1, 2)*pol_y(1, 3, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(2, 2)*pol_y(1, 3, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(3, 2)*pol_y(2, 3, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(4, 2)*pol_y(2, 3, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(1, 3)*pol_y(1, 3, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(2, 3)*pol_y(1, 3, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(3, 3)*pol_y(2, 3, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(4, 3)*pol_y(2, 3, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(1, 4)*pol_y(1, 3, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(2, 4)*pol_y(1, 3, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(3, 4)*pol_y(2, 3, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(4, 4)*pol_y(2, 3, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(1, 0)*pol_y(1, 4, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(2, 0)*pol_y(1, 4, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(3, 0)*pol_y(2, 4, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(4, 0)*pol_y(2, 4, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(1, 1)*pol_y(1, 4, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(2, 1)*pol_y(1, 4, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(3, 1)*pol_y(2, 4, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(4, 1)*pol_y(2, 4, jg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_x(1, 2)*pol_y(1, 4, jg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_x(2, 2)*pol_y(1, 4, jg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_x(3, 2)*pol_y(2, 4, jg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_x(4, 2)*pol_y(2, 4, jg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_x(1, 3)*pol_y(1, 4, jg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_x(2, 3)*pol_y(1, 4, jg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_x(3, 3)*pol_y(2, 4, jg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_x(4, 3)*pol_y(2, 4, jg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_x(1, 0)*pol_y(1, 5, jg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_x(2, 0)*pol_y(1, 5, jg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_x(3, 0)*pol_y(2, 5, jg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_x(4, 0)*pol_y(2, 5, jg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_x(1, 1)*pol_y(1, 5, jg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_x(2, 1)*pol_y(1, 5, jg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_x(3, 1)*pol_y(2, 5, jg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_x(4, 1)*pol_y(2, 5, jg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_x(1, 2)*pol_y(1, 5, jg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_x(2, 2)*pol_y(1, 5, jg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_x(3, 2)*pol_y(2, 5, jg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_x(4, 2)*pol_y(2, 5, jg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_x(1, 0)*pol_y(1, 6, jg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_x(2, 0)*pol_y(1, 6, jg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_x(3, 0)*pol_y(2, 6, jg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_x(4, 0)*pol_y(2, 6, jg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_x(1, 1)*pol_y(1, 6, jg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_x(2, 1)*pol_y(1, 6, jg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_x(3, 1)*pol_y(2, 6, jg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_x(4, 1)*pol_y(2, 6, jg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_x(1, 0)*pol_y(1, 7, jg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_x(2, 0)*pol_y(1, 7, jg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_x(3, 0)*pol_y(2, 7, jg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_x(4, 0)*pol_y(2, 7, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 11)*pol_z(1, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 11)*pol_z(2, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 12)*pol_z(1, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 12)*pol_z(2, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 13)*pol_z(1, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 13)*pol_z(2, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 14)*pol_z(1, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 14)*pol_z(2, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 15)*pol_z(1, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 15)*pol_z(2, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 16)*pol_z(1, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 16)*pol_z(2, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 17)*pol_z(1, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 17)*pol_z(2, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 18)*pol_z(1, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 18)*pol_z(2, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 19)*pol_z(1, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 19)*pol_z(2, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 20)*pol_z(1, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 20)*pol_z(2, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(1, 21)*pol_z(1, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(2, 21)*pol_z(2, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(1, 22)*pol_z(1, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(2, 22)*pol_z(2, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(1, 23)*pol_z(1, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(2, 23)*pol_z(2, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(1, 24)*pol_z(1, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(2, 24)*pol_z(2, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(1, 25)*pol_z(1, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(2, 25)*pol_z(2, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(1, 26)*pol_z(1, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(2, 26)*pol_z(2, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(1, 27)*pol_z(1, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(2, 27)*pol_z(2, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(1, 28)*pol_z(1, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(2, 28)*pol_z(2, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(1, 29)*pol_z(1, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(2, 29)*pol_z(2, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(1, 30)*pol_z(1, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(2, 30)*pol_z(2, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(1, 31)*pol_z(1, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(2, 31)*pol_z(2, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(1, 32)*pol_z(1, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(2, 32)*pol_z(2, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(1, 33)*pol_z(1, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(2, 33)*pol_z(2, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(1, 34)*pol_z(1, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(2, 34)*pol_z(2, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(1, 35)*pol_z(1, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(2, 35)*pol_z(2, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(1, 36)*pol_z(1, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(2, 36)*pol_z(2, 0, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(1, 5)*pol_z(1, 1, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(2, 5)*pol_z(2, 1, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(1, 7)*pol_z(1, 1, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(2, 7)*pol_z(2, 1, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(1, 9)*pol_z(1, 1, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(2, 9)*pol_z(2, 1, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(1, 10)*pol_z(1, 1, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(2, 10)*pol_z(2, 1, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(1, 11)*pol_z(1, 1, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(2, 11)*pol_z(2, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(1, 12)*pol_z(1, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(2, 12)*pol_z(2, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(1, 13)*pol_z(1, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(2, 13)*pol_z(2, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(1, 14)*pol_z(1, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(2, 14)*pol_z(2, 1, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(1, 16)*pol_z(1, 1, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(2, 16)*pol_z(2, 1, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(1, 17)*pol_z(1, 1, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(2, 17)*pol_z(2, 1, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(1, 18)*pol_z(1, 1, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(2, 18)*pol_z(2, 1, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(1, 19)*pol_z(1, 1, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(2, 19)*pol_z(2, 1, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(1, 20)*pol_z(1, 1, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(2, 20)*pol_z(2, 1, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(1, 22)*pol_z(1, 1, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(2, 22)*pol_z(2, 1, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(1, 23)*pol_z(1, 1, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(2, 23)*pol_z(2, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(1, 24)*pol_z(1, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(2, 24)*pol_z(2, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(1, 25)*pol_z(1, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(2, 25)*pol_z(2, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(1, 27)*pol_z(1, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(2, 27)*pol_z(2, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(1, 28)*pol_z(1, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(2, 28)*pol_z(2, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(1, 29)*pol_z(1, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(2, 29)*pol_z(2, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(1, 31)*pol_z(1, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(2, 31)*pol_z(2, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(1, 32)*pol_z(1, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(2, 32)*pol_z(2, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(1, 34)*pol_z(1, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(2, 34)*pol_z(2, 1, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(1, 3)*pol_z(1, 2, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(2, 3)*pol_z(2, 2, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(1, 4)*pol_z(1, 2, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(2, 4)*pol_z(2, 2, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(1, 5)*pol_z(1, 2, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(2, 5)*pol_z(2, 2, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(1, 6)*pol_z(1, 2, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(2, 6)*pol_z(2, 2, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(1, 9)*pol_z(1, 2, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(2, 9)*pol_z(2, 2, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(1, 10)*pol_z(1, 2, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(2, 10)*pol_z(2, 2, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(1, 11)*pol_z(1, 2, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(2, 11)*pol_z(2, 2, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(1, 12)*pol_z(1, 2, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(2, 12)*pol_z(2, 2, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(1, 13)*pol_z(1, 2, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(2, 13)*pol_z(2, 2, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(1, 16)*pol_z(1, 2, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(2, 16)*pol_z(2, 2, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(1, 17)*pol_z(1, 2, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(2, 17)*pol_z(2, 2, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(1, 18)*pol_z(1, 2, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(2, 18)*pol_z(2, 2, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(1, 19)*pol_z(1, 2, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(2, 19)*pol_z(2, 2, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(1, 22)*pol_z(1, 2, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(2, 22)*pol_z(2, 2, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(1, 23)*pol_z(1, 2, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(2, 23)*pol_z(2, 2, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(1, 24)*pol_z(1, 2, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(2, 24)*pol_z(2, 2, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(1, 27)*pol_z(1, 2, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(2, 27)*pol_z(2, 2, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(1, 28)*pol_z(1, 2, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(2, 28)*pol_z(2, 2, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(1, 31)*pol_z(1, 2, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(2, 31)*pol_z(2, 2, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(2, 1)*pol_z(2, 3, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(1, 2)*pol_z(1, 3, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(2, 2)*pol_z(2, 3, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(1, 3)*pol_z(1, 3, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(2, 3)*pol_z(2, 3, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(1, 4)*pol_z(1, 3, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(2, 4)*pol_z(2, 3, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(1, 5)*pol_z(1, 3, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(2, 5)*pol_z(2, 3, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(1, 9)*pol_z(1, 3, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(2, 9)*pol_z(2, 3, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(1, 10)*pol_z(1, 3, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(2, 10)*pol_z(2, 3, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(1, 11)*pol_z(1, 3, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(2, 11)*pol_z(2, 3, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(1, 12)*pol_z(1, 3, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(2, 12)*pol_z(2, 3, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(1, 16)*pol_z(1, 3, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(2, 16)*pol_z(2, 3, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(1, 17)*pol_z(1, 3, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(2, 17)*pol_z(2, 3, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(1, 18)*pol_z(1, 3, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(2, 18)*pol_z(2, 3, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(1, 22)*pol_z(1, 3, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(2, 22)*pol_z(2, 3, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(1, 23)*pol_z(1, 3, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(2, 23)*pol_z(2, 3, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(1, 27)*pol_z(1, 3, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(2, 27)*pol_z(2, 3, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(1, 1)*pol_z(1, 4, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(2, 1)*pol_z(2, 4, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(1, 2)*pol_z(1, 4, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(2, 2)*pol_z(2, 4, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(1, 3)*pol_z(1, 4, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(2, 3)*pol_z(2, 4, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(1, 4)*pol_z(1, 4, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(2, 4)*pol_z(2, 4, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(1, 9)*pol_z(1, 4, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(2, 9)*pol_z(2, 4, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(1, 10)*pol_z(1, 4, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(2, 10)*pol_z(2, 4, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(1, 11)*pol_z(1, 4, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(2, 11)*pol_z(2, 4, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(1, 16)*pol_z(1, 4, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(2, 16)*pol_z(2, 4, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(1, 17)*pol_z(1, 4, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(2, 17)*pol_z(2, 4, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(1, 22)*pol_z(1, 4, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(2, 22)*pol_z(2, 4, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(1, 1)*pol_z(1, 5, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(2, 1)*pol_z(2, 5, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(1, 2)*pol_z(1, 5, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(2, 2)*pol_z(2, 5, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(1, 3)*pol_z(1, 5, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(2, 3)*pol_z(2, 5, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(1, 9)*pol_z(1, 5, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(2, 9)*pol_z(2, 5, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(1, 10)*pol_z(1, 5, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(2, 10)*pol_z(2, 5, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(1, 16)*pol_z(1, 5, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(2, 16)*pol_z(2, 5, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(1, 1)*pol_z(1, 6, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(2, 1)*pol_z(2, 6, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(1, 2)*pol_z(1, 6, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(2, 2)*pol_z(2, 6, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(1, 9)*pol_z(1, 6, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(2, 9)*pol_z(2, 6, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(1, 1)*pol_z(1, 7, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(2, 1)*pol_z(2, 7, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 11)*pol_z(1, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 11)*pol_z(2, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 12)*pol_z(1, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 12)*pol_z(2, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 13)*pol_z(1, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 13)*pol_z(2, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 14)*pol_z(1, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 14)*pol_z(2, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 15)*pol_z(1, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 15)*pol_z(2, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 16)*pol_z(1, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 16)*pol_z(2, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 17)*pol_z(1, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 17)*pol_z(2, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 18)*pol_z(1, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 18)*pol_z(2, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 19)*pol_z(1, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 19)*pol_z(2, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 20)*pol_z(1, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 20)*pol_z(2, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(1, 21)*pol_z(1, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(2, 21)*pol_z(2, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(1, 22)*pol_z(1, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(2, 22)*pol_z(2, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(1, 23)*pol_z(1, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(2, 23)*pol_z(2, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(1, 24)*pol_z(1, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(2, 24)*pol_z(2, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(1, 25)*pol_z(1, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(2, 25)*pol_z(2, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(1, 26)*pol_z(1, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(2, 26)*pol_z(2, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(1, 27)*pol_z(1, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(2, 27)*pol_z(2, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(1, 28)*pol_z(1, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(2, 28)*pol_z(2, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(1, 29)*pol_z(1, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(2, 29)*pol_z(2, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(1, 30)*pol_z(1, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(2, 30)*pol_z(2, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(1, 31)*pol_z(1, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(2, 31)*pol_z(2, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(1, 32)*pol_z(1, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(2, 32)*pol_z(2, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(1, 33)*pol_z(1, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(2, 33)*pol_z(2, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(1, 34)*pol_z(1, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(2, 34)*pol_z(2, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(1, 35)*pol_z(1, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(2, 35)*pol_z(2, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(1, 36)*pol_z(1, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(2, 36)*pol_z(2, 0, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(1, 5)*pol_z(1, 1, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(2, 5)*pol_z(2, 1, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(1, 7)*pol_z(1, 1, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(2, 7)*pol_z(2, 1, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(1, 9)*pol_z(1, 1, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(2, 9)*pol_z(2, 1, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(1, 10)*pol_z(1, 1, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(2, 10)*pol_z(2, 1, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(1, 11)*pol_z(1, 1, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(2, 11)*pol_z(2, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(1, 12)*pol_z(1, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(2, 12)*pol_z(2, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(1, 13)*pol_z(1, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(2, 13)*pol_z(2, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(1, 14)*pol_z(1, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(2, 14)*pol_z(2, 1, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(1, 16)*pol_z(1, 1, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(2, 16)*pol_z(2, 1, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(1, 17)*pol_z(1, 1, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(2, 17)*pol_z(2, 1, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(1, 18)*pol_z(1, 1, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(2, 18)*pol_z(2, 1, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(1, 19)*pol_z(1, 1, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(2, 19)*pol_z(2, 1, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(1, 20)*pol_z(1, 1, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(2, 20)*pol_z(2, 1, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(1, 22)*pol_z(1, 1, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(2, 22)*pol_z(2, 1, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(1, 23)*pol_z(1, 1, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(2, 23)*pol_z(2, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(1, 24)*pol_z(1, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(2, 24)*pol_z(2, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(1, 25)*pol_z(1, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(2, 25)*pol_z(2, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(1, 27)*pol_z(1, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(2, 27)*pol_z(2, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(1, 28)*pol_z(1, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(2, 28)*pol_z(2, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(1, 29)*pol_z(1, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(2, 29)*pol_z(2, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(1, 31)*pol_z(1, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(2, 31)*pol_z(2, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(1, 32)*pol_z(1, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(2, 32)*pol_z(2, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(1, 34)*pol_z(1, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(2, 34)*pol_z(2, 1, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(1, 3)*pol_z(1, 2, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(2, 3)*pol_z(2, 2, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(1, 4)*pol_z(1, 2, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(2, 4)*pol_z(2, 2, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(1, 5)*pol_z(1, 2, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(2, 5)*pol_z(2, 2, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(1, 6)*pol_z(1, 2, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(2, 6)*pol_z(2, 2, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(1, 9)*pol_z(1, 2, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(2, 9)*pol_z(2, 2, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(1, 10)*pol_z(1, 2, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(2, 10)*pol_z(2, 2, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(1, 11)*pol_z(1, 2, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(2, 11)*pol_z(2, 2, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(1, 12)*pol_z(1, 2, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(2, 12)*pol_z(2, 2, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(1, 13)*pol_z(1, 2, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(2, 13)*pol_z(2, 2, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(1, 16)*pol_z(1, 2, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(2, 16)*pol_z(2, 2, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(1, 17)*pol_z(1, 2, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(2, 17)*pol_z(2, 2, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(1, 18)*pol_z(1, 2, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(2, 18)*pol_z(2, 2, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(1, 19)*pol_z(1, 2, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(2, 19)*pol_z(2, 2, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(1, 22)*pol_z(1, 2, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(2, 22)*pol_z(2, 2, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(1, 23)*pol_z(1, 2, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(2, 23)*pol_z(2, 2, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(1, 24)*pol_z(1, 2, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(2, 24)*pol_z(2, 2, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(1, 27)*pol_z(1, 2, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(2, 27)*pol_z(2, 2, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(1, 28)*pol_z(1, 2, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(2, 28)*pol_z(2, 2, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(1, 31)*pol_z(1, 2, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(2, 31)*pol_z(2, 2, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(1, 2)*pol_z(1, 3, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(2, 2)*pol_z(2, 3, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(1, 3)*pol_z(1, 3, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(2, 3)*pol_z(2, 3, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(1, 4)*pol_z(1, 3, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(2, 4)*pol_z(2, 3, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(1, 5)*pol_z(1, 3, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(2, 5)*pol_z(2, 3, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(1, 9)*pol_z(1, 3, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(2, 9)*pol_z(2, 3, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(1, 10)*pol_z(1, 3, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(2, 10)*pol_z(2, 3, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(1, 11)*pol_z(1, 3, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(2, 11)*pol_z(2, 3, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(1, 12)*pol_z(1, 3, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(2, 12)*pol_z(2, 3, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(1, 16)*pol_z(1, 3, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(2, 16)*pol_z(2, 3, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(1, 17)*pol_z(1, 3, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(2, 17)*pol_z(2, 3, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(1, 18)*pol_z(1, 3, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(2, 18)*pol_z(2, 3, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(1, 22)*pol_z(1, 3, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(2, 22)*pol_z(2, 3, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(1, 23)*pol_z(1, 3, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(2, 23)*pol_z(2, 3, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(1, 27)*pol_z(1, 3, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(2, 27)*pol_z(2, 3, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(1, 1)*pol_z(1, 4, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(2, 1)*pol_z(2, 4, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(1, 2)*pol_z(1, 4, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(2, 2)*pol_z(2, 4, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(1, 3)*pol_z(1, 4, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(2, 3)*pol_z(2, 4, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(1, 4)*pol_z(1, 4, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(2, 4)*pol_z(2, 4, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(1, 9)*pol_z(1, 4, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(2, 9)*pol_z(2, 4, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(1, 10)*pol_z(1, 4, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(2, 10)*pol_z(2, 4, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(1, 11)*pol_z(1, 4, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(2, 11)*pol_z(2, 4, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(1, 16)*pol_z(1, 4, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(2, 16)*pol_z(2, 4, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(1, 17)*pol_z(1, 4, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(2, 17)*pol_z(2, 4, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(1, 22)*pol_z(1, 4, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(2, 22)*pol_z(2, 4, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(1, 1)*pol_z(1, 5, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(2, 1)*pol_z(2, 5, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(1, 2)*pol_z(1, 5, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(2, 2)*pol_z(2, 5, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(1, 3)*pol_z(1, 5, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(2, 3)*pol_z(2, 5, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(1, 9)*pol_z(1, 5, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(2, 9)*pol_z(2, 5, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(1, 10)*pol_z(1, 5, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(2, 10)*pol_z(2, 5, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(1, 16)*pol_z(1, 5, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(2, 16)*pol_z(2, 5, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(1, 1)*pol_z(1, 6, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(2, 1)*pol_z(2, 6, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(1, 2)*pol_z(1, 6, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(2, 2)*pol_z(2, 6, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(1, 9)*pol_z(1, 6, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(2, 9)*pol_z(2, 6, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(1, 1)*pol_z(1, 7, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(2, 1)*pol_z(2, 7, kg) END DO END SUBROUTINE integrate_core_7 @@ -1656,13 +1656,13 @@ SUBROUTINE integrate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s(4) sci = 1 @@ -1670,23 +1670,23 @@ SUBROUTINE integrate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -1695,527 +1695,527 @@ SUBROUTINE integrate_core_8(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s(2) = grid(i, j, k2) s(3) = grid(i, j2, k) s(4) = grid(i, j2, k2) - coef_x(:, 0) = coef_x(:, 0)+s(:)*pol_x(0, ig) - coef_x(:, 1) = coef_x(:, 1)+s(:)*pol_x(1, ig) - coef_x(:, 2) = coef_x(:, 2)+s(:)*pol_x(2, ig) - coef_x(:, 3) = coef_x(:, 3)+s(:)*pol_x(3, ig) - coef_x(:, 4) = coef_x(:, 4)+s(:)*pol_x(4, ig) - coef_x(:, 5) = coef_x(:, 5)+s(:)*pol_x(5, ig) - coef_x(:, 6) = coef_x(:, 6)+s(:)*pol_x(6, ig) - coef_x(:, 7) = coef_x(:, 7)+s(:)*pol_x(7, ig) - coef_x(:, 8) = coef_x(:, 8)+s(:)*pol_x(8, ig) + coef_x(:, 0) = coef_x(:, 0) + s(:)*pol_x(0, ig) + coef_x(:, 1) = coef_x(:, 1) + s(:)*pol_x(1, ig) + coef_x(:, 2) = coef_x(:, 2) + s(:)*pol_x(2, ig) + coef_x(:, 3) = coef_x(:, 3) + s(:)*pol_x(3, ig) + coef_x(:, 4) = coef_x(:, 4) + s(:)*pol_x(4, ig) + coef_x(:, 5) = coef_x(:, 5) + s(:)*pol_x(5, ig) + coef_x(:, 6) = coef_x(:, 6) + s(:)*pol_x(6, ig) + coef_x(:, 7) = coef_x(:, 7) + s(:)*pol_x(7, ig) + coef_x(:, 8) = coef_x(:, 8) + s(:)*pol_x(8, ig) END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 2)*pol_y(1, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 2)*pol_y(1, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 2)*pol_y(2, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 2)*pol_y(2, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(1, 3)*pol_y(1, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(2, 3)*pol_y(1, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(3, 3)*pol_y(2, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(4, 3)*pol_y(2, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(1, 4)*pol_y(1, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(2, 4)*pol_y(1, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(3, 4)*pol_y(2, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(4, 4)*pol_y(2, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(1, 5)*pol_y(1, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(2, 5)*pol_y(1, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(3, 5)*pol_y(2, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(4, 5)*pol_y(2, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(1, 6)*pol_y(1, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(2, 6)*pol_y(1, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(3, 6)*pol_y(2, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(4, 6)*pol_y(2, 0, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(1, 7)*pol_y(1, 0, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(2, 7)*pol_y(1, 0, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(3, 7)*pol_y(2, 0, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(4, 7)*pol_y(2, 0, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(1, 8)*pol_y(1, 0, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(2, 8)*pol_y(1, 0, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(3, 8)*pol_y(2, 0, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(4, 8)*pol_y(2, 0, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(4, 0)*pol_y(2, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(1, 1)*pol_y(1, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(2, 1)*pol_y(1, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(3, 1)*pol_y(2, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(4, 1)*pol_y(2, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(1, 2)*pol_y(1, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(2, 2)*pol_y(1, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(3, 2)*pol_y(2, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(4, 2)*pol_y(2, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(1, 3)*pol_y(1, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(2, 3)*pol_y(1, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(3, 3)*pol_y(2, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(4, 3)*pol_y(2, 1, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(1, 4)*pol_y(1, 1, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(2, 4)*pol_y(1, 1, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(3, 4)*pol_y(2, 1, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(4, 4)*pol_y(2, 1, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(1, 5)*pol_y(1, 1, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(2, 5)*pol_y(1, 1, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(3, 5)*pol_y(2, 1, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(4, 5)*pol_y(2, 1, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(1, 6)*pol_y(1, 1, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(2, 6)*pol_y(1, 1, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(3, 6)*pol_y(2, 1, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(4, 6)*pol_y(2, 1, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(1, 7)*pol_y(1, 1, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(2, 7)*pol_y(1, 1, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(3, 7)*pol_y(2, 1, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(4, 7)*pol_y(2, 1, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(1, 0)*pol_y(1, 2, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(2, 0)*pol_y(1, 2, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(3, 0)*pol_y(2, 2, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(4, 0)*pol_y(2, 2, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(1, 1)*pol_y(1, 2, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(2, 1)*pol_y(1, 2, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(3, 1)*pol_y(2, 2, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(4, 1)*pol_y(2, 2, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(1, 2)*pol_y(1, 2, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(2, 2)*pol_y(1, 2, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(3, 2)*pol_y(2, 2, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(4, 2)*pol_y(2, 2, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(1, 3)*pol_y(1, 2, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(2, 3)*pol_y(1, 2, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(3, 3)*pol_y(2, 2, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(4, 3)*pol_y(2, 2, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(1, 4)*pol_y(1, 2, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(2, 4)*pol_y(1, 2, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(3, 4)*pol_y(2, 2, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(4, 4)*pol_y(2, 2, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(1, 5)*pol_y(1, 2, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(2, 5)*pol_y(1, 2, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(3, 5)*pol_y(2, 2, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(4, 5)*pol_y(2, 2, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(1, 6)*pol_y(1, 2, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(2, 6)*pol_y(1, 2, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(3, 6)*pol_y(2, 2, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(4, 6)*pol_y(2, 2, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(1, 0)*pol_y(1, 3, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(2, 0)*pol_y(1, 3, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(3, 0)*pol_y(2, 3, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(4, 0)*pol_y(2, 3, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(1, 1)*pol_y(1, 3, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(2, 1)*pol_y(1, 3, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(3, 1)*pol_y(2, 3, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(4, 1)*pol_y(2, 3, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(1, 2)*pol_y(1, 3, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(2, 2)*pol_y(1, 3, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(3, 2)*pol_y(2, 3, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(4, 2)*pol_y(2, 3, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(1, 3)*pol_y(1, 3, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(2, 3)*pol_y(1, 3, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(3, 3)*pol_y(2, 3, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(4, 3)*pol_y(2, 3, jg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_x(1, 4)*pol_y(1, 3, jg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_x(2, 4)*pol_y(1, 3, jg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_x(3, 4)*pol_y(2, 3, jg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_x(4, 4)*pol_y(2, 3, jg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_x(1, 5)*pol_y(1, 3, jg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_x(2, 5)*pol_y(1, 3, jg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_x(3, 5)*pol_y(2, 3, jg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_x(4, 5)*pol_y(2, 3, jg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_x(1, 0)*pol_y(1, 4, jg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_x(2, 0)*pol_y(1, 4, jg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_x(3, 0)*pol_y(2, 4, jg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_x(4, 0)*pol_y(2, 4, jg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_x(1, 1)*pol_y(1, 4, jg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_x(2, 1)*pol_y(1, 4, jg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_x(3, 1)*pol_y(2, 4, jg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_x(4, 1)*pol_y(2, 4, jg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_x(1, 2)*pol_y(1, 4, jg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_x(2, 2)*pol_y(1, 4, jg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_x(3, 2)*pol_y(2, 4, jg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_x(4, 2)*pol_y(2, 4, jg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_x(1, 3)*pol_y(1, 4, jg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_x(2, 3)*pol_y(1, 4, jg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_x(3, 3)*pol_y(2, 4, jg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_x(4, 3)*pol_y(2, 4, jg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_x(1, 4)*pol_y(1, 4, jg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_x(2, 4)*pol_y(1, 4, jg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_x(3, 4)*pol_y(2, 4, jg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_x(4, 4)*pol_y(2, 4, jg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_x(1, 0)*pol_y(1, 5, jg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_x(2, 0)*pol_y(1, 5, jg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_x(3, 0)*pol_y(2, 5, jg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_x(4, 0)*pol_y(2, 5, jg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_x(1, 1)*pol_y(1, 5, jg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_x(2, 1)*pol_y(1, 5, jg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_x(3, 1)*pol_y(2, 5, jg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_x(4, 1)*pol_y(2, 5, jg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_x(1, 2)*pol_y(1, 5, jg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_x(2, 2)*pol_y(1, 5, jg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_x(3, 2)*pol_y(2, 5, jg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_x(4, 2)*pol_y(2, 5, jg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_x(1, 3)*pol_y(1, 5, jg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_x(2, 3)*pol_y(1, 5, jg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_x(3, 3)*pol_y(2, 5, jg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_x(4, 3)*pol_y(2, 5, jg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_x(1, 0)*pol_y(1, 6, jg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_x(2, 0)*pol_y(1, 6, jg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_x(3, 0)*pol_y(2, 6, jg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_x(4, 0)*pol_y(2, 6, jg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_x(1, 1)*pol_y(1, 6, jg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_x(2, 1)*pol_y(1, 6, jg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_x(3, 1)*pol_y(2, 6, jg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_x(4, 1)*pol_y(2, 6, jg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_x(1, 2)*pol_y(1, 6, jg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_x(2, 2)*pol_y(1, 6, jg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_x(3, 2)*pol_y(2, 6, jg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_x(4, 2)*pol_y(2, 6, jg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_x(1, 0)*pol_y(1, 7, jg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_x(2, 0)*pol_y(1, 7, jg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_x(3, 0)*pol_y(2, 7, jg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_x(4, 0)*pol_y(2, 7, jg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_x(1, 1)*pol_y(1, 7, jg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_x(2, 1)*pol_y(1, 7, jg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_x(3, 1)*pol_y(2, 7, jg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_x(4, 1)*pol_y(2, 7, jg) - coef_xy(1, 45) = coef_xy(1, 45)+coef_x(1, 0)*pol_y(1, 8, jg) - coef_xy(2, 45) = coef_xy(2, 45)+coef_x(2, 0)*pol_y(1, 8, jg) - coef_xy(1, 45) = coef_xy(1, 45)+coef_x(3, 0)*pol_y(2, 8, jg) - coef_xy(2, 45) = coef_xy(2, 45)+coef_x(4, 0)*pol_y(2, 8, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 2)*pol_y(1, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 2)*pol_y(1, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 2)*pol_y(2, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 2)*pol_y(2, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(1, 3)*pol_y(1, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(2, 3)*pol_y(1, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(3, 3)*pol_y(2, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(4, 3)*pol_y(2, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(1, 4)*pol_y(1, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(2, 4)*pol_y(1, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(3, 4)*pol_y(2, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(4, 4)*pol_y(2, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(1, 5)*pol_y(1, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(2, 5)*pol_y(1, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(3, 5)*pol_y(2, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(4, 5)*pol_y(2, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(1, 6)*pol_y(1, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(2, 6)*pol_y(1, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(3, 6)*pol_y(2, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(4, 6)*pol_y(2, 0, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(1, 7)*pol_y(1, 0, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(2, 7)*pol_y(1, 0, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(3, 7)*pol_y(2, 0, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(4, 7)*pol_y(2, 0, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(1, 8)*pol_y(1, 0, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(2, 8)*pol_y(1, 0, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(3, 8)*pol_y(2, 0, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(4, 8)*pol_y(2, 0, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(1, 1)*pol_y(1, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(2, 1)*pol_y(1, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(3, 1)*pol_y(2, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(4, 1)*pol_y(2, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(1, 2)*pol_y(1, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(2, 2)*pol_y(1, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(3, 2)*pol_y(2, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(4, 2)*pol_y(2, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(1, 3)*pol_y(1, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(2, 3)*pol_y(1, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(3, 3)*pol_y(2, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(4, 3)*pol_y(2, 1, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(1, 4)*pol_y(1, 1, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(2, 4)*pol_y(1, 1, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(3, 4)*pol_y(2, 1, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(4, 4)*pol_y(2, 1, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(1, 5)*pol_y(1, 1, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(2, 5)*pol_y(1, 1, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(3, 5)*pol_y(2, 1, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(4, 5)*pol_y(2, 1, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(1, 6)*pol_y(1, 1, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(2, 6)*pol_y(1, 1, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(3, 6)*pol_y(2, 1, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(4, 6)*pol_y(2, 1, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(1, 7)*pol_y(1, 1, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(2, 7)*pol_y(1, 1, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(3, 7)*pol_y(2, 1, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(4, 7)*pol_y(2, 1, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(1, 0)*pol_y(1, 2, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(2, 0)*pol_y(1, 2, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(3, 0)*pol_y(2, 2, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(4, 0)*pol_y(2, 2, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(1, 1)*pol_y(1, 2, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(2, 1)*pol_y(1, 2, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(3, 1)*pol_y(2, 2, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(4, 1)*pol_y(2, 2, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(1, 2)*pol_y(1, 2, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(2, 2)*pol_y(1, 2, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(3, 2)*pol_y(2, 2, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(4, 2)*pol_y(2, 2, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(1, 3)*pol_y(1, 2, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(2, 3)*pol_y(1, 2, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(3, 3)*pol_y(2, 2, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(4, 3)*pol_y(2, 2, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(1, 4)*pol_y(1, 2, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(2, 4)*pol_y(1, 2, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(3, 4)*pol_y(2, 2, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(4, 4)*pol_y(2, 2, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(1, 5)*pol_y(1, 2, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(2, 5)*pol_y(1, 2, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(3, 5)*pol_y(2, 2, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(4, 5)*pol_y(2, 2, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(1, 6)*pol_y(1, 2, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(2, 6)*pol_y(1, 2, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(3, 6)*pol_y(2, 2, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(4, 6)*pol_y(2, 2, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(1, 0)*pol_y(1, 3, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(2, 0)*pol_y(1, 3, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(3, 0)*pol_y(2, 3, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(4, 0)*pol_y(2, 3, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(1, 1)*pol_y(1, 3, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(2, 1)*pol_y(1, 3, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(3, 1)*pol_y(2, 3, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(4, 1)*pol_y(2, 3, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(1, 2)*pol_y(1, 3, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(2, 2)*pol_y(1, 3, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(3, 2)*pol_y(2, 3, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(4, 2)*pol_y(2, 3, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(1, 3)*pol_y(1, 3, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(2, 3)*pol_y(1, 3, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(3, 3)*pol_y(2, 3, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(4, 3)*pol_y(2, 3, jg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_x(1, 4)*pol_y(1, 3, jg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_x(2, 4)*pol_y(1, 3, jg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_x(3, 4)*pol_y(2, 3, jg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_x(4, 4)*pol_y(2, 3, jg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_x(1, 5)*pol_y(1, 3, jg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_x(2, 5)*pol_y(1, 3, jg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_x(3, 5)*pol_y(2, 3, jg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_x(4, 5)*pol_y(2, 3, jg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_x(1, 0)*pol_y(1, 4, jg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_x(2, 0)*pol_y(1, 4, jg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_x(3, 0)*pol_y(2, 4, jg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_x(4, 0)*pol_y(2, 4, jg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_x(1, 1)*pol_y(1, 4, jg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_x(2, 1)*pol_y(1, 4, jg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_x(3, 1)*pol_y(2, 4, jg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_x(4, 1)*pol_y(2, 4, jg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_x(1, 2)*pol_y(1, 4, jg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_x(2, 2)*pol_y(1, 4, jg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_x(3, 2)*pol_y(2, 4, jg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_x(4, 2)*pol_y(2, 4, jg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_x(1, 3)*pol_y(1, 4, jg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_x(2, 3)*pol_y(1, 4, jg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_x(3, 3)*pol_y(2, 4, jg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_x(4, 3)*pol_y(2, 4, jg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_x(1, 4)*pol_y(1, 4, jg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_x(2, 4)*pol_y(1, 4, jg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_x(3, 4)*pol_y(2, 4, jg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_x(4, 4)*pol_y(2, 4, jg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_x(1, 0)*pol_y(1, 5, jg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_x(2, 0)*pol_y(1, 5, jg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_x(3, 0)*pol_y(2, 5, jg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_x(4, 0)*pol_y(2, 5, jg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_x(1, 1)*pol_y(1, 5, jg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_x(2, 1)*pol_y(1, 5, jg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_x(3, 1)*pol_y(2, 5, jg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_x(4, 1)*pol_y(2, 5, jg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_x(1, 2)*pol_y(1, 5, jg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_x(2, 2)*pol_y(1, 5, jg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_x(3, 2)*pol_y(2, 5, jg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_x(4, 2)*pol_y(2, 5, jg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_x(1, 3)*pol_y(1, 5, jg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_x(2, 3)*pol_y(1, 5, jg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_x(3, 3)*pol_y(2, 5, jg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_x(4, 3)*pol_y(2, 5, jg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_x(1, 0)*pol_y(1, 6, jg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_x(2, 0)*pol_y(1, 6, jg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_x(3, 0)*pol_y(2, 6, jg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_x(4, 0)*pol_y(2, 6, jg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_x(1, 1)*pol_y(1, 6, jg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_x(2, 1)*pol_y(1, 6, jg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_x(3, 1)*pol_y(2, 6, jg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_x(4, 1)*pol_y(2, 6, jg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_x(1, 2)*pol_y(1, 6, jg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_x(2, 2)*pol_y(1, 6, jg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_x(3, 2)*pol_y(2, 6, jg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_x(4, 2)*pol_y(2, 6, jg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_x(1, 0)*pol_y(1, 7, jg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_x(2, 0)*pol_y(1, 7, jg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_x(3, 0)*pol_y(2, 7, jg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_x(4, 0)*pol_y(2, 7, jg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_x(1, 1)*pol_y(1, 7, jg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_x(2, 1)*pol_y(1, 7, jg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_x(3, 1)*pol_y(2, 7, jg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_x(4, 1)*pol_y(2, 7, jg) + coef_xy(1, 45) = coef_xy(1, 45) + coef_x(1, 0)*pol_y(1, 8, jg) + coef_xy(2, 45) = coef_xy(2, 45) + coef_x(2, 0)*pol_y(1, 8, jg) + coef_xy(1, 45) = coef_xy(1, 45) + coef_x(3, 0)*pol_y(2, 8, jg) + coef_xy(2, 45) = coef_xy(2, 45) + coef_x(4, 0)*pol_y(2, 8, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 11)*pol_z(1, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 11)*pol_z(2, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 12)*pol_z(1, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 12)*pol_z(2, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 13)*pol_z(1, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 13)*pol_z(2, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 14)*pol_z(1, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 14)*pol_z(2, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 15)*pol_z(1, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 15)*pol_z(2, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 16)*pol_z(1, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 16)*pol_z(2, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 17)*pol_z(1, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 17)*pol_z(2, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 18)*pol_z(1, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 18)*pol_z(2, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 19)*pol_z(1, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 19)*pol_z(2, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 20)*pol_z(1, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 20)*pol_z(2, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(1, 21)*pol_z(1, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(2, 21)*pol_z(2, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(1, 22)*pol_z(1, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(2, 22)*pol_z(2, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(1, 23)*pol_z(1, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(2, 23)*pol_z(2, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(1, 24)*pol_z(1, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(2, 24)*pol_z(2, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(1, 25)*pol_z(1, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(2, 25)*pol_z(2, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(1, 26)*pol_z(1, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(2, 26)*pol_z(2, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(1, 27)*pol_z(1, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(2, 27)*pol_z(2, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(1, 28)*pol_z(1, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(2, 28)*pol_z(2, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(1, 29)*pol_z(1, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(2, 29)*pol_z(2, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(1, 30)*pol_z(1, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(2, 30)*pol_z(2, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(1, 31)*pol_z(1, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(2, 31)*pol_z(2, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(1, 32)*pol_z(1, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(2, 32)*pol_z(2, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(1, 33)*pol_z(1, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(2, 33)*pol_z(2, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(1, 34)*pol_z(1, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(2, 34)*pol_z(2, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(1, 35)*pol_z(1, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(2, 35)*pol_z(2, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(1, 36)*pol_z(1, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(2, 36)*pol_z(2, 0, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(1, 37)*pol_z(1, 0, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(2, 37)*pol_z(2, 0, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(1, 38)*pol_z(1, 0, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(2, 38)*pol_z(2, 0, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(1, 39)*pol_z(1, 0, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(2, 39)*pol_z(2, 0, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(1, 40)*pol_z(1, 0, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(2, 40)*pol_z(2, 0, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(1, 41)*pol_z(1, 0, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(2, 41)*pol_z(2, 0, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(1, 42)*pol_z(1, 0, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(2, 42)*pol_z(2, 0, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(1, 43)*pol_z(1, 0, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(2, 43)*pol_z(2, 0, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(1, 44)*pol_z(1, 0, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(2, 44)*pol_z(2, 0, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(1, 45)*pol_z(1, 0, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(2, 45)*pol_z(2, 0, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(1, 5)*pol_z(1, 1, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(2, 5)*pol_z(2, 1, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(1, 7)*pol_z(1, 1, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(2, 7)*pol_z(2, 1, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(1, 8)*pol_z(1, 1, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(2, 8)*pol_z(2, 1, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(1, 10)*pol_z(1, 1, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(2, 10)*pol_z(2, 1, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(1, 11)*pol_z(1, 1, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(2, 11)*pol_z(2, 1, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(1, 12)*pol_z(1, 1, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(2, 12)*pol_z(2, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(1, 13)*pol_z(1, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(2, 13)*pol_z(2, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(1, 14)*pol_z(1, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(2, 14)*pol_z(2, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(1, 15)*pol_z(1, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(2, 15)*pol_z(2, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(1, 16)*pol_z(1, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(2, 16)*pol_z(2, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(1, 18)*pol_z(1, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(2, 18)*pol_z(2, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(1, 19)*pol_z(1, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(2, 19)*pol_z(2, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(1, 20)*pol_z(1, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(2, 20)*pol_z(2, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(1, 21)*pol_z(1, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(2, 21)*pol_z(2, 1, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(1, 22)*pol_z(1, 1, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(2, 22)*pol_z(2, 1, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(1, 23)*pol_z(1, 1, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(2, 23)*pol_z(2, 1, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(1, 25)*pol_z(1, 1, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(2, 25)*pol_z(2, 1, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(1, 26)*pol_z(1, 1, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(2, 26)*pol_z(2, 1, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(1, 27)*pol_z(1, 1, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(2, 27)*pol_z(2, 1, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(1, 28)*pol_z(1, 1, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(2, 28)*pol_z(2, 1, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(1, 29)*pol_z(1, 1, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(2, 29)*pol_z(2, 1, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(1, 31)*pol_z(1, 1, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(2, 31)*pol_z(2, 1, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(1, 32)*pol_z(1, 1, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(2, 32)*pol_z(2, 1, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(1, 33)*pol_z(1, 1, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(2, 33)*pol_z(2, 1, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(1, 34)*pol_z(1, 1, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(2, 34)*pol_z(2, 1, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(1, 36)*pol_z(1, 1, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(2, 36)*pol_z(2, 1, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(1, 37)*pol_z(1, 1, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(2, 37)*pol_z(2, 1, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(1, 38)*pol_z(1, 1, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(2, 38)*pol_z(2, 1, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(1, 40)*pol_z(1, 1, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(2, 40)*pol_z(2, 1, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(1, 41)*pol_z(1, 1, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(2, 41)*pol_z(2, 1, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(1, 43)*pol_z(1, 1, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(2, 43)*pol_z(2, 1, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(1, 3)*pol_z(1, 2, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(2, 3)*pol_z(2, 2, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(1, 4)*pol_z(1, 2, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(2, 4)*pol_z(2, 2, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(1, 5)*pol_z(1, 2, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(2, 5)*pol_z(2, 2, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(1, 6)*pol_z(1, 2, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(2, 6)*pol_z(2, 2, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(1, 7)*pol_z(1, 2, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(2, 7)*pol_z(2, 2, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(1, 10)*pol_z(1, 2, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(2, 10)*pol_z(2, 2, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(1, 11)*pol_z(1, 2, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(2, 11)*pol_z(2, 2, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(1, 12)*pol_z(1, 2, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(2, 12)*pol_z(2, 2, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(1, 13)*pol_z(1, 2, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(2, 13)*pol_z(2, 2, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(1, 14)*pol_z(1, 2, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(2, 14)*pol_z(2, 2, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(1, 15)*pol_z(1, 2, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(2, 15)*pol_z(2, 2, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(1, 18)*pol_z(1, 2, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(2, 18)*pol_z(2, 2, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(1, 19)*pol_z(1, 2, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(2, 19)*pol_z(2, 2, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(1, 20)*pol_z(1, 2, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(2, 20)*pol_z(2, 2, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(1, 21)*pol_z(1, 2, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(2, 21)*pol_z(2, 2, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(1, 22)*pol_z(1, 2, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(2, 22)*pol_z(2, 2, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(1, 25)*pol_z(1, 2, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(2, 25)*pol_z(2, 2, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(1, 26)*pol_z(1, 2, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(2, 26)*pol_z(2, 2, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(1, 27)*pol_z(1, 2, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(2, 27)*pol_z(2, 2, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(1, 28)*pol_z(1, 2, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(2, 28)*pol_z(2, 2, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(1, 31)*pol_z(1, 2, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(2, 31)*pol_z(2, 2, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(1, 32)*pol_z(1, 2, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(2, 32)*pol_z(2, 2, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(1, 33)*pol_z(1, 2, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(2, 33)*pol_z(2, 2, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(1, 36)*pol_z(1, 2, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(2, 36)*pol_z(2, 2, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(1, 37)*pol_z(1, 2, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(2, 37)*pol_z(2, 2, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(1, 40)*pol_z(1, 2, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(2, 40)*pol_z(2, 2, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(2, 1)*pol_z(2, 3, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(1, 2)*pol_z(1, 3, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(2, 2)*pol_z(2, 3, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(1, 3)*pol_z(1, 3, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(2, 3)*pol_z(2, 3, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(1, 4)*pol_z(1, 3, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(2, 4)*pol_z(2, 3, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(1, 5)*pol_z(1, 3, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(2, 5)*pol_z(2, 3, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(1, 6)*pol_z(1, 3, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(2, 6)*pol_z(2, 3, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(1, 10)*pol_z(1, 3, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(2, 10)*pol_z(2, 3, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(1, 11)*pol_z(1, 3, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(2, 11)*pol_z(2, 3, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(1, 12)*pol_z(1, 3, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(2, 12)*pol_z(2, 3, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(1, 13)*pol_z(1, 3, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(2, 13)*pol_z(2, 3, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(1, 14)*pol_z(1, 3, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(2, 14)*pol_z(2, 3, kg) - coef_xyz(121) = coef_xyz(121)+coef_xy(1, 18)*pol_z(1, 3, kg) - coef_xyz(121) = coef_xyz(121)+coef_xy(2, 18)*pol_z(2, 3, kg) - coef_xyz(122) = coef_xyz(122)+coef_xy(1, 19)*pol_z(1, 3, kg) - coef_xyz(122) = coef_xyz(122)+coef_xy(2, 19)*pol_z(2, 3, kg) - coef_xyz(123) = coef_xyz(123)+coef_xy(1, 20)*pol_z(1, 3, kg) - coef_xyz(123) = coef_xyz(123)+coef_xy(2, 20)*pol_z(2, 3, kg) - coef_xyz(124) = coef_xyz(124)+coef_xy(1, 21)*pol_z(1, 3, kg) - coef_xyz(124) = coef_xyz(124)+coef_xy(2, 21)*pol_z(2, 3, kg) - coef_xyz(125) = coef_xyz(125)+coef_xy(1, 25)*pol_z(1, 3, kg) - coef_xyz(125) = coef_xyz(125)+coef_xy(2, 25)*pol_z(2, 3, kg) - coef_xyz(126) = coef_xyz(126)+coef_xy(1, 26)*pol_z(1, 3, kg) - coef_xyz(126) = coef_xyz(126)+coef_xy(2, 26)*pol_z(2, 3, kg) - coef_xyz(127) = coef_xyz(127)+coef_xy(1, 27)*pol_z(1, 3, kg) - coef_xyz(127) = coef_xyz(127)+coef_xy(2, 27)*pol_z(2, 3, kg) - coef_xyz(128) = coef_xyz(128)+coef_xy(1, 31)*pol_z(1, 3, kg) - coef_xyz(128) = coef_xyz(128)+coef_xy(2, 31)*pol_z(2, 3, kg) - coef_xyz(129) = coef_xyz(129)+coef_xy(1, 32)*pol_z(1, 3, kg) - coef_xyz(129) = coef_xyz(129)+coef_xy(2, 32)*pol_z(2, 3, kg) - coef_xyz(130) = coef_xyz(130)+coef_xy(1, 36)*pol_z(1, 3, kg) - coef_xyz(130) = coef_xyz(130)+coef_xy(2, 36)*pol_z(2, 3, kg) - coef_xyz(131) = coef_xyz(131)+coef_xy(1, 1)*pol_z(1, 4, kg) - coef_xyz(131) = coef_xyz(131)+coef_xy(2, 1)*pol_z(2, 4, kg) - coef_xyz(132) = coef_xyz(132)+coef_xy(1, 2)*pol_z(1, 4, kg) - coef_xyz(132) = coef_xyz(132)+coef_xy(2, 2)*pol_z(2, 4, kg) - coef_xyz(133) = coef_xyz(133)+coef_xy(1, 3)*pol_z(1, 4, kg) - coef_xyz(133) = coef_xyz(133)+coef_xy(2, 3)*pol_z(2, 4, kg) - coef_xyz(134) = coef_xyz(134)+coef_xy(1, 4)*pol_z(1, 4, kg) - coef_xyz(134) = coef_xyz(134)+coef_xy(2, 4)*pol_z(2, 4, kg) - coef_xyz(135) = coef_xyz(135)+coef_xy(1, 5)*pol_z(1, 4, kg) - coef_xyz(135) = coef_xyz(135)+coef_xy(2, 5)*pol_z(2, 4, kg) - coef_xyz(136) = coef_xyz(136)+coef_xy(1, 10)*pol_z(1, 4, kg) - coef_xyz(136) = coef_xyz(136)+coef_xy(2, 10)*pol_z(2, 4, kg) - coef_xyz(137) = coef_xyz(137)+coef_xy(1, 11)*pol_z(1, 4, kg) - coef_xyz(137) = coef_xyz(137)+coef_xy(2, 11)*pol_z(2, 4, kg) - coef_xyz(138) = coef_xyz(138)+coef_xy(1, 12)*pol_z(1, 4, kg) - coef_xyz(138) = coef_xyz(138)+coef_xy(2, 12)*pol_z(2, 4, kg) - coef_xyz(139) = coef_xyz(139)+coef_xy(1, 13)*pol_z(1, 4, kg) - coef_xyz(139) = coef_xyz(139)+coef_xy(2, 13)*pol_z(2, 4, kg) - coef_xyz(140) = coef_xyz(140)+coef_xy(1, 18)*pol_z(1, 4, kg) - coef_xyz(140) = coef_xyz(140)+coef_xy(2, 18)*pol_z(2, 4, kg) - coef_xyz(141) = coef_xyz(141)+coef_xy(1, 19)*pol_z(1, 4, kg) - coef_xyz(141) = coef_xyz(141)+coef_xy(2, 19)*pol_z(2, 4, kg) - coef_xyz(142) = coef_xyz(142)+coef_xy(1, 20)*pol_z(1, 4, kg) - coef_xyz(142) = coef_xyz(142)+coef_xy(2, 20)*pol_z(2, 4, kg) - coef_xyz(143) = coef_xyz(143)+coef_xy(1, 25)*pol_z(1, 4, kg) - coef_xyz(143) = coef_xyz(143)+coef_xy(2, 25)*pol_z(2, 4, kg) - coef_xyz(144) = coef_xyz(144)+coef_xy(1, 26)*pol_z(1, 4, kg) - coef_xyz(144) = coef_xyz(144)+coef_xy(2, 26)*pol_z(2, 4, kg) - coef_xyz(145) = coef_xyz(145)+coef_xy(1, 31)*pol_z(1, 4, kg) - coef_xyz(145) = coef_xyz(145)+coef_xy(2, 31)*pol_z(2, 4, kg) - coef_xyz(146) = coef_xyz(146)+coef_xy(1, 1)*pol_z(1, 5, kg) - coef_xyz(146) = coef_xyz(146)+coef_xy(2, 1)*pol_z(2, 5, kg) - coef_xyz(147) = coef_xyz(147)+coef_xy(1, 2)*pol_z(1, 5, kg) - coef_xyz(147) = coef_xyz(147)+coef_xy(2, 2)*pol_z(2, 5, kg) - coef_xyz(148) = coef_xyz(148)+coef_xy(1, 3)*pol_z(1, 5, kg) - coef_xyz(148) = coef_xyz(148)+coef_xy(2, 3)*pol_z(2, 5, kg) - coef_xyz(149) = coef_xyz(149)+coef_xy(1, 4)*pol_z(1, 5, kg) - coef_xyz(149) = coef_xyz(149)+coef_xy(2, 4)*pol_z(2, 5, kg) - coef_xyz(150) = coef_xyz(150)+coef_xy(1, 10)*pol_z(1, 5, kg) - coef_xyz(150) = coef_xyz(150)+coef_xy(2, 10)*pol_z(2, 5, kg) - coef_xyz(151) = coef_xyz(151)+coef_xy(1, 11)*pol_z(1, 5, kg) - coef_xyz(151) = coef_xyz(151)+coef_xy(2, 11)*pol_z(2, 5, kg) - coef_xyz(152) = coef_xyz(152)+coef_xy(1, 12)*pol_z(1, 5, kg) - coef_xyz(152) = coef_xyz(152)+coef_xy(2, 12)*pol_z(2, 5, kg) - coef_xyz(153) = coef_xyz(153)+coef_xy(1, 18)*pol_z(1, 5, kg) - coef_xyz(153) = coef_xyz(153)+coef_xy(2, 18)*pol_z(2, 5, kg) - coef_xyz(154) = coef_xyz(154)+coef_xy(1, 19)*pol_z(1, 5, kg) - coef_xyz(154) = coef_xyz(154)+coef_xy(2, 19)*pol_z(2, 5, kg) - coef_xyz(155) = coef_xyz(155)+coef_xy(1, 25)*pol_z(1, 5, kg) - coef_xyz(155) = coef_xyz(155)+coef_xy(2, 25)*pol_z(2, 5, kg) - coef_xyz(156) = coef_xyz(156)+coef_xy(1, 1)*pol_z(1, 6, kg) - coef_xyz(156) = coef_xyz(156)+coef_xy(2, 1)*pol_z(2, 6, kg) - coef_xyz(157) = coef_xyz(157)+coef_xy(1, 2)*pol_z(1, 6, kg) - coef_xyz(157) = coef_xyz(157)+coef_xy(2, 2)*pol_z(2, 6, kg) - coef_xyz(158) = coef_xyz(158)+coef_xy(1, 3)*pol_z(1, 6, kg) - coef_xyz(158) = coef_xyz(158)+coef_xy(2, 3)*pol_z(2, 6, kg) - coef_xyz(159) = coef_xyz(159)+coef_xy(1, 10)*pol_z(1, 6, kg) - coef_xyz(159) = coef_xyz(159)+coef_xy(2, 10)*pol_z(2, 6, kg) - coef_xyz(160) = coef_xyz(160)+coef_xy(1, 11)*pol_z(1, 6, kg) - coef_xyz(160) = coef_xyz(160)+coef_xy(2, 11)*pol_z(2, 6, kg) - coef_xyz(161) = coef_xyz(161)+coef_xy(1, 18)*pol_z(1, 6, kg) - coef_xyz(161) = coef_xyz(161)+coef_xy(2, 18)*pol_z(2, 6, kg) - coef_xyz(162) = coef_xyz(162)+coef_xy(1, 1)*pol_z(1, 7, kg) - coef_xyz(162) = coef_xyz(162)+coef_xy(2, 1)*pol_z(2, 7, kg) - coef_xyz(163) = coef_xyz(163)+coef_xy(1, 2)*pol_z(1, 7, kg) - coef_xyz(163) = coef_xyz(163)+coef_xy(2, 2)*pol_z(2, 7, kg) - coef_xyz(164) = coef_xyz(164)+coef_xy(1, 10)*pol_z(1, 7, kg) - coef_xyz(164) = coef_xyz(164)+coef_xy(2, 10)*pol_z(2, 7, kg) - coef_xyz(165) = coef_xyz(165)+coef_xy(1, 1)*pol_z(1, 8, kg) - coef_xyz(165) = coef_xyz(165)+coef_xy(2, 1)*pol_z(2, 8, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 11)*pol_z(1, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 11)*pol_z(2, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 12)*pol_z(1, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 12)*pol_z(2, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 13)*pol_z(1, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 13)*pol_z(2, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 14)*pol_z(1, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 14)*pol_z(2, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 15)*pol_z(1, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 15)*pol_z(2, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 16)*pol_z(1, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 16)*pol_z(2, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 17)*pol_z(1, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 17)*pol_z(2, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 18)*pol_z(1, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 18)*pol_z(2, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 19)*pol_z(1, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 19)*pol_z(2, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 20)*pol_z(1, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 20)*pol_z(2, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(1, 21)*pol_z(1, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(2, 21)*pol_z(2, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(1, 22)*pol_z(1, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(2, 22)*pol_z(2, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(1, 23)*pol_z(1, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(2, 23)*pol_z(2, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(1, 24)*pol_z(1, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(2, 24)*pol_z(2, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(1, 25)*pol_z(1, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(2, 25)*pol_z(2, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(1, 26)*pol_z(1, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(2, 26)*pol_z(2, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(1, 27)*pol_z(1, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(2, 27)*pol_z(2, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(1, 28)*pol_z(1, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(2, 28)*pol_z(2, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(1, 29)*pol_z(1, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(2, 29)*pol_z(2, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(1, 30)*pol_z(1, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(2, 30)*pol_z(2, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(1, 31)*pol_z(1, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(2, 31)*pol_z(2, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(1, 32)*pol_z(1, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(2, 32)*pol_z(2, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(1, 33)*pol_z(1, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(2, 33)*pol_z(2, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(1, 34)*pol_z(1, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(2, 34)*pol_z(2, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(1, 35)*pol_z(1, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(2, 35)*pol_z(2, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(1, 36)*pol_z(1, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(2, 36)*pol_z(2, 0, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(1, 37)*pol_z(1, 0, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(2, 37)*pol_z(2, 0, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(1, 38)*pol_z(1, 0, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(2, 38)*pol_z(2, 0, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(1, 39)*pol_z(1, 0, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(2, 39)*pol_z(2, 0, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(1, 40)*pol_z(1, 0, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(2, 40)*pol_z(2, 0, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(1, 41)*pol_z(1, 0, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(2, 41)*pol_z(2, 0, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(1, 42)*pol_z(1, 0, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(2, 42)*pol_z(2, 0, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(1, 43)*pol_z(1, 0, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(2, 43)*pol_z(2, 0, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(1, 44)*pol_z(1, 0, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(2, 44)*pol_z(2, 0, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(1, 45)*pol_z(1, 0, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(2, 45)*pol_z(2, 0, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(1, 5)*pol_z(1, 1, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(2, 5)*pol_z(2, 1, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(1, 7)*pol_z(1, 1, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(2, 7)*pol_z(2, 1, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(1, 8)*pol_z(1, 1, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(2, 8)*pol_z(2, 1, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(1, 10)*pol_z(1, 1, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(2, 10)*pol_z(2, 1, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(1, 11)*pol_z(1, 1, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(2, 11)*pol_z(2, 1, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(1, 12)*pol_z(1, 1, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(2, 12)*pol_z(2, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(1, 13)*pol_z(1, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(2, 13)*pol_z(2, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(1, 14)*pol_z(1, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(2, 14)*pol_z(2, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(1, 15)*pol_z(1, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(2, 15)*pol_z(2, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(1, 16)*pol_z(1, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(2, 16)*pol_z(2, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(1, 18)*pol_z(1, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(2, 18)*pol_z(2, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(1, 19)*pol_z(1, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(2, 19)*pol_z(2, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(1, 20)*pol_z(1, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(2, 20)*pol_z(2, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(1, 21)*pol_z(1, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(2, 21)*pol_z(2, 1, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(1, 22)*pol_z(1, 1, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(2, 22)*pol_z(2, 1, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(1, 23)*pol_z(1, 1, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(2, 23)*pol_z(2, 1, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(1, 25)*pol_z(1, 1, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(2, 25)*pol_z(2, 1, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(1, 26)*pol_z(1, 1, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(2, 26)*pol_z(2, 1, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(1, 27)*pol_z(1, 1, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(2, 27)*pol_z(2, 1, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(1, 28)*pol_z(1, 1, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(2, 28)*pol_z(2, 1, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(1, 29)*pol_z(1, 1, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(2, 29)*pol_z(2, 1, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(1, 31)*pol_z(1, 1, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(2, 31)*pol_z(2, 1, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(1, 32)*pol_z(1, 1, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(2, 32)*pol_z(2, 1, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(1, 33)*pol_z(1, 1, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(2, 33)*pol_z(2, 1, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(1, 34)*pol_z(1, 1, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(2, 34)*pol_z(2, 1, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(1, 36)*pol_z(1, 1, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(2, 36)*pol_z(2, 1, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(1, 37)*pol_z(1, 1, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(2, 37)*pol_z(2, 1, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(1, 38)*pol_z(1, 1, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(2, 38)*pol_z(2, 1, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(1, 40)*pol_z(1, 1, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(2, 40)*pol_z(2, 1, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(1, 41)*pol_z(1, 1, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(2, 41)*pol_z(2, 1, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(1, 43)*pol_z(1, 1, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(2, 43)*pol_z(2, 1, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(1, 3)*pol_z(1, 2, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(2, 3)*pol_z(2, 2, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(1, 4)*pol_z(1, 2, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(2, 4)*pol_z(2, 2, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(1, 5)*pol_z(1, 2, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(2, 5)*pol_z(2, 2, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(1, 6)*pol_z(1, 2, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(2, 6)*pol_z(2, 2, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(1, 7)*pol_z(1, 2, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(2, 7)*pol_z(2, 2, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(1, 10)*pol_z(1, 2, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(2, 10)*pol_z(2, 2, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(1, 11)*pol_z(1, 2, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(2, 11)*pol_z(2, 2, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(1, 12)*pol_z(1, 2, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(2, 12)*pol_z(2, 2, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(1, 13)*pol_z(1, 2, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(2, 13)*pol_z(2, 2, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(1, 14)*pol_z(1, 2, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(2, 14)*pol_z(2, 2, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(1, 15)*pol_z(1, 2, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(2, 15)*pol_z(2, 2, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(1, 18)*pol_z(1, 2, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(2, 18)*pol_z(2, 2, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(1, 19)*pol_z(1, 2, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(2, 19)*pol_z(2, 2, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(1, 20)*pol_z(1, 2, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(2, 20)*pol_z(2, 2, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(1, 21)*pol_z(1, 2, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(2, 21)*pol_z(2, 2, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(1, 22)*pol_z(1, 2, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(2, 22)*pol_z(2, 2, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(1, 25)*pol_z(1, 2, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(2, 25)*pol_z(2, 2, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(1, 26)*pol_z(1, 2, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(2, 26)*pol_z(2, 2, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(1, 27)*pol_z(1, 2, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(2, 27)*pol_z(2, 2, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(1, 28)*pol_z(1, 2, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(2, 28)*pol_z(2, 2, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(1, 31)*pol_z(1, 2, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(2, 31)*pol_z(2, 2, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(1, 32)*pol_z(1, 2, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(2, 32)*pol_z(2, 2, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(1, 33)*pol_z(1, 2, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(2, 33)*pol_z(2, 2, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(1, 36)*pol_z(1, 2, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(2, 36)*pol_z(2, 2, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(1, 37)*pol_z(1, 2, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(2, 37)*pol_z(2, 2, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(1, 40)*pol_z(1, 2, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(2, 40)*pol_z(2, 2, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(1, 2)*pol_z(1, 3, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(2, 2)*pol_z(2, 3, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(1, 3)*pol_z(1, 3, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(2, 3)*pol_z(2, 3, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(1, 4)*pol_z(1, 3, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(2, 4)*pol_z(2, 3, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(1, 5)*pol_z(1, 3, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(2, 5)*pol_z(2, 3, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(1, 6)*pol_z(1, 3, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(2, 6)*pol_z(2, 3, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(1, 10)*pol_z(1, 3, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(2, 10)*pol_z(2, 3, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(1, 11)*pol_z(1, 3, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(2, 11)*pol_z(2, 3, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(1, 12)*pol_z(1, 3, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(2, 12)*pol_z(2, 3, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(1, 13)*pol_z(1, 3, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(2, 13)*pol_z(2, 3, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(1, 14)*pol_z(1, 3, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(2, 14)*pol_z(2, 3, kg) + coef_xyz(121) = coef_xyz(121) + coef_xy(1, 18)*pol_z(1, 3, kg) + coef_xyz(121) = coef_xyz(121) + coef_xy(2, 18)*pol_z(2, 3, kg) + coef_xyz(122) = coef_xyz(122) + coef_xy(1, 19)*pol_z(1, 3, kg) + coef_xyz(122) = coef_xyz(122) + coef_xy(2, 19)*pol_z(2, 3, kg) + coef_xyz(123) = coef_xyz(123) + coef_xy(1, 20)*pol_z(1, 3, kg) + coef_xyz(123) = coef_xyz(123) + coef_xy(2, 20)*pol_z(2, 3, kg) + coef_xyz(124) = coef_xyz(124) + coef_xy(1, 21)*pol_z(1, 3, kg) + coef_xyz(124) = coef_xyz(124) + coef_xy(2, 21)*pol_z(2, 3, kg) + coef_xyz(125) = coef_xyz(125) + coef_xy(1, 25)*pol_z(1, 3, kg) + coef_xyz(125) = coef_xyz(125) + coef_xy(2, 25)*pol_z(2, 3, kg) + coef_xyz(126) = coef_xyz(126) + coef_xy(1, 26)*pol_z(1, 3, kg) + coef_xyz(126) = coef_xyz(126) + coef_xy(2, 26)*pol_z(2, 3, kg) + coef_xyz(127) = coef_xyz(127) + coef_xy(1, 27)*pol_z(1, 3, kg) + coef_xyz(127) = coef_xyz(127) + coef_xy(2, 27)*pol_z(2, 3, kg) + coef_xyz(128) = coef_xyz(128) + coef_xy(1, 31)*pol_z(1, 3, kg) + coef_xyz(128) = coef_xyz(128) + coef_xy(2, 31)*pol_z(2, 3, kg) + coef_xyz(129) = coef_xyz(129) + coef_xy(1, 32)*pol_z(1, 3, kg) + coef_xyz(129) = coef_xyz(129) + coef_xy(2, 32)*pol_z(2, 3, kg) + coef_xyz(130) = coef_xyz(130) + coef_xy(1, 36)*pol_z(1, 3, kg) + coef_xyz(130) = coef_xyz(130) + coef_xy(2, 36)*pol_z(2, 3, kg) + coef_xyz(131) = coef_xyz(131) + coef_xy(1, 1)*pol_z(1, 4, kg) + coef_xyz(131) = coef_xyz(131) + coef_xy(2, 1)*pol_z(2, 4, kg) + coef_xyz(132) = coef_xyz(132) + coef_xy(1, 2)*pol_z(1, 4, kg) + coef_xyz(132) = coef_xyz(132) + coef_xy(2, 2)*pol_z(2, 4, kg) + coef_xyz(133) = coef_xyz(133) + coef_xy(1, 3)*pol_z(1, 4, kg) + coef_xyz(133) = coef_xyz(133) + coef_xy(2, 3)*pol_z(2, 4, kg) + coef_xyz(134) = coef_xyz(134) + coef_xy(1, 4)*pol_z(1, 4, kg) + coef_xyz(134) = coef_xyz(134) + coef_xy(2, 4)*pol_z(2, 4, kg) + coef_xyz(135) = coef_xyz(135) + coef_xy(1, 5)*pol_z(1, 4, kg) + coef_xyz(135) = coef_xyz(135) + coef_xy(2, 5)*pol_z(2, 4, kg) + coef_xyz(136) = coef_xyz(136) + coef_xy(1, 10)*pol_z(1, 4, kg) + coef_xyz(136) = coef_xyz(136) + coef_xy(2, 10)*pol_z(2, 4, kg) + coef_xyz(137) = coef_xyz(137) + coef_xy(1, 11)*pol_z(1, 4, kg) + coef_xyz(137) = coef_xyz(137) + coef_xy(2, 11)*pol_z(2, 4, kg) + coef_xyz(138) = coef_xyz(138) + coef_xy(1, 12)*pol_z(1, 4, kg) + coef_xyz(138) = coef_xyz(138) + coef_xy(2, 12)*pol_z(2, 4, kg) + coef_xyz(139) = coef_xyz(139) + coef_xy(1, 13)*pol_z(1, 4, kg) + coef_xyz(139) = coef_xyz(139) + coef_xy(2, 13)*pol_z(2, 4, kg) + coef_xyz(140) = coef_xyz(140) + coef_xy(1, 18)*pol_z(1, 4, kg) + coef_xyz(140) = coef_xyz(140) + coef_xy(2, 18)*pol_z(2, 4, kg) + coef_xyz(141) = coef_xyz(141) + coef_xy(1, 19)*pol_z(1, 4, kg) + coef_xyz(141) = coef_xyz(141) + coef_xy(2, 19)*pol_z(2, 4, kg) + coef_xyz(142) = coef_xyz(142) + coef_xy(1, 20)*pol_z(1, 4, kg) + coef_xyz(142) = coef_xyz(142) + coef_xy(2, 20)*pol_z(2, 4, kg) + coef_xyz(143) = coef_xyz(143) + coef_xy(1, 25)*pol_z(1, 4, kg) + coef_xyz(143) = coef_xyz(143) + coef_xy(2, 25)*pol_z(2, 4, kg) + coef_xyz(144) = coef_xyz(144) + coef_xy(1, 26)*pol_z(1, 4, kg) + coef_xyz(144) = coef_xyz(144) + coef_xy(2, 26)*pol_z(2, 4, kg) + coef_xyz(145) = coef_xyz(145) + coef_xy(1, 31)*pol_z(1, 4, kg) + coef_xyz(145) = coef_xyz(145) + coef_xy(2, 31)*pol_z(2, 4, kg) + coef_xyz(146) = coef_xyz(146) + coef_xy(1, 1)*pol_z(1, 5, kg) + coef_xyz(146) = coef_xyz(146) + coef_xy(2, 1)*pol_z(2, 5, kg) + coef_xyz(147) = coef_xyz(147) + coef_xy(1, 2)*pol_z(1, 5, kg) + coef_xyz(147) = coef_xyz(147) + coef_xy(2, 2)*pol_z(2, 5, kg) + coef_xyz(148) = coef_xyz(148) + coef_xy(1, 3)*pol_z(1, 5, kg) + coef_xyz(148) = coef_xyz(148) + coef_xy(2, 3)*pol_z(2, 5, kg) + coef_xyz(149) = coef_xyz(149) + coef_xy(1, 4)*pol_z(1, 5, kg) + coef_xyz(149) = coef_xyz(149) + coef_xy(2, 4)*pol_z(2, 5, kg) + coef_xyz(150) = coef_xyz(150) + coef_xy(1, 10)*pol_z(1, 5, kg) + coef_xyz(150) = coef_xyz(150) + coef_xy(2, 10)*pol_z(2, 5, kg) + coef_xyz(151) = coef_xyz(151) + coef_xy(1, 11)*pol_z(1, 5, kg) + coef_xyz(151) = coef_xyz(151) + coef_xy(2, 11)*pol_z(2, 5, kg) + coef_xyz(152) = coef_xyz(152) + coef_xy(1, 12)*pol_z(1, 5, kg) + coef_xyz(152) = coef_xyz(152) + coef_xy(2, 12)*pol_z(2, 5, kg) + coef_xyz(153) = coef_xyz(153) + coef_xy(1, 18)*pol_z(1, 5, kg) + coef_xyz(153) = coef_xyz(153) + coef_xy(2, 18)*pol_z(2, 5, kg) + coef_xyz(154) = coef_xyz(154) + coef_xy(1, 19)*pol_z(1, 5, kg) + coef_xyz(154) = coef_xyz(154) + coef_xy(2, 19)*pol_z(2, 5, kg) + coef_xyz(155) = coef_xyz(155) + coef_xy(1, 25)*pol_z(1, 5, kg) + coef_xyz(155) = coef_xyz(155) + coef_xy(2, 25)*pol_z(2, 5, kg) + coef_xyz(156) = coef_xyz(156) + coef_xy(1, 1)*pol_z(1, 6, kg) + coef_xyz(156) = coef_xyz(156) + coef_xy(2, 1)*pol_z(2, 6, kg) + coef_xyz(157) = coef_xyz(157) + coef_xy(1, 2)*pol_z(1, 6, kg) + coef_xyz(157) = coef_xyz(157) + coef_xy(2, 2)*pol_z(2, 6, kg) + coef_xyz(158) = coef_xyz(158) + coef_xy(1, 3)*pol_z(1, 6, kg) + coef_xyz(158) = coef_xyz(158) + coef_xy(2, 3)*pol_z(2, 6, kg) + coef_xyz(159) = coef_xyz(159) + coef_xy(1, 10)*pol_z(1, 6, kg) + coef_xyz(159) = coef_xyz(159) + coef_xy(2, 10)*pol_z(2, 6, kg) + coef_xyz(160) = coef_xyz(160) + coef_xy(1, 11)*pol_z(1, 6, kg) + coef_xyz(160) = coef_xyz(160) + coef_xy(2, 11)*pol_z(2, 6, kg) + coef_xyz(161) = coef_xyz(161) + coef_xy(1, 18)*pol_z(1, 6, kg) + coef_xyz(161) = coef_xyz(161) + coef_xy(2, 18)*pol_z(2, 6, kg) + coef_xyz(162) = coef_xyz(162) + coef_xy(1, 1)*pol_z(1, 7, kg) + coef_xyz(162) = coef_xyz(162) + coef_xy(2, 1)*pol_z(2, 7, kg) + coef_xyz(163) = coef_xyz(163) + coef_xy(1, 2)*pol_z(1, 7, kg) + coef_xyz(163) = coef_xyz(163) + coef_xy(2, 2)*pol_z(2, 7, kg) + coef_xyz(164) = coef_xyz(164) + coef_xy(1, 10)*pol_z(1, 7, kg) + coef_xyz(164) = coef_xyz(164) + coef_xy(2, 10)*pol_z(2, 7, kg) + coef_xyz(165) = coef_xyz(165) + coef_xy(1, 1)*pol_z(1, 8, kg) + coef_xyz(165) = coef_xyz(165) + coef_xy(2, 1)*pol_z(2, 8, kg) END DO END SUBROUTINE integrate_core_8 @@ -2242,13 +2242,13 @@ SUBROUTINE integrate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou REAL(dp), INTENT(IN) :: pol_x(0:lp, -cmax:cmax), & pol_y(1:2, 0:lp, -cmax:0), & pol_z(1:2, 0:lp, -cmax:0) - REAL(dp), INTENT(OUT) :: coef_xyz(((lp+1)*(lp+2)*(lp+3))/6) + REAL(dp), INTENT(OUT) :: coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6) INTEGER :: i, ig, igmax, igmin, j, j2, & jg, jg2, jgmin, k, k2, kg, & kg2, kgmin, sci REAL(dp) :: coef_x(4, 0:lp), & - coef_xy(2, ((lp+1)*(lp+2))/2), & + coef_xy(2, ((lp + 1)*(lp + 2))/2), & s(4) sci = 1 @@ -2256,23 +2256,23 @@ SUBROUTINE integrate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou coef_xyz = 0.0_dp kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) coef_xy = 0.0_dp jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin coef_x = 0.0_dp DO ig = igmin, igmax @@ -2281,678 +2281,678 @@ SUBROUTINE integrate_core_9(grid, coef_xyz, pol_x, pol_y, pol_z, map, sphere_bou s(2) = grid(i, j, k2) s(3) = grid(i, j2, k) s(4) = grid(i, j2, k2) - coef_x(:, 0) = coef_x(:, 0)+s(:)*pol_x(0, ig) - coef_x(:, 1) = coef_x(:, 1)+s(:)*pol_x(1, ig) - coef_x(:, 2) = coef_x(:, 2)+s(:)*pol_x(2, ig) - coef_x(:, 3) = coef_x(:, 3)+s(:)*pol_x(3, ig) - coef_x(:, 4) = coef_x(:, 4)+s(:)*pol_x(4, ig) - coef_x(:, 5) = coef_x(:, 5)+s(:)*pol_x(5, ig) - coef_x(:, 6) = coef_x(:, 6)+s(:)*pol_x(6, ig) - coef_x(:, 7) = coef_x(:, 7)+s(:)*pol_x(7, ig) - coef_x(:, 8) = coef_x(:, 8)+s(:)*pol_x(8, ig) - coef_x(:, 9) = coef_x(:, 9)+s(:)*pol_x(9, ig) + coef_x(:, 0) = coef_x(:, 0) + s(:)*pol_x(0, ig) + coef_x(:, 1) = coef_x(:, 1) + s(:)*pol_x(1, ig) + coef_x(:, 2) = coef_x(:, 2) + s(:)*pol_x(2, ig) + coef_x(:, 3) = coef_x(:, 3) + s(:)*pol_x(3, ig) + coef_x(:, 4) = coef_x(:, 4) + s(:)*pol_x(4, ig) + coef_x(:, 5) = coef_x(:, 5) + s(:)*pol_x(5, ig) + coef_x(:, 6) = coef_x(:, 6) + s(:)*pol_x(6, ig) + coef_x(:, 7) = coef_x(:, 7) + s(:)*pol_x(7, ig) + coef_x(:, 8) = coef_x(:, 8) + s(:)*pol_x(8, ig) + coef_x(:, 9) = coef_x(:, 9) + s(:)*pol_x(9, ig) END DO - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(1, 0)*pol_y(1, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(2, 0)*pol_y(1, 0, jg) - coef_xy(1, 1) = coef_xy(1, 1)+coef_x(3, 0)*pol_y(2, 0, jg) - coef_xy(2, 1) = coef_xy(2, 1)+coef_x(4, 0)*pol_y(2, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(1, 1)*pol_y(1, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(2, 1)*pol_y(1, 0, jg) - coef_xy(1, 2) = coef_xy(1, 2)+coef_x(3, 1)*pol_y(2, 0, jg) - coef_xy(2, 2) = coef_xy(2, 2)+coef_x(4, 1)*pol_y(2, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(1, 2)*pol_y(1, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(2, 2)*pol_y(1, 0, jg) - coef_xy(1, 3) = coef_xy(1, 3)+coef_x(3, 2)*pol_y(2, 0, jg) - coef_xy(2, 3) = coef_xy(2, 3)+coef_x(4, 2)*pol_y(2, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(1, 3)*pol_y(1, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(2, 3)*pol_y(1, 0, jg) - coef_xy(1, 4) = coef_xy(1, 4)+coef_x(3, 3)*pol_y(2, 0, jg) - coef_xy(2, 4) = coef_xy(2, 4)+coef_x(4, 3)*pol_y(2, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(1, 4)*pol_y(1, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(2, 4)*pol_y(1, 0, jg) - coef_xy(1, 5) = coef_xy(1, 5)+coef_x(3, 4)*pol_y(2, 0, jg) - coef_xy(2, 5) = coef_xy(2, 5)+coef_x(4, 4)*pol_y(2, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(1, 5)*pol_y(1, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(2, 5)*pol_y(1, 0, jg) - coef_xy(1, 6) = coef_xy(1, 6)+coef_x(3, 5)*pol_y(2, 0, jg) - coef_xy(2, 6) = coef_xy(2, 6)+coef_x(4, 5)*pol_y(2, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(1, 6)*pol_y(1, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(2, 6)*pol_y(1, 0, jg) - coef_xy(1, 7) = coef_xy(1, 7)+coef_x(3, 6)*pol_y(2, 0, jg) - coef_xy(2, 7) = coef_xy(2, 7)+coef_x(4, 6)*pol_y(2, 0, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(1, 7)*pol_y(1, 0, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(2, 7)*pol_y(1, 0, jg) - coef_xy(1, 8) = coef_xy(1, 8)+coef_x(3, 7)*pol_y(2, 0, jg) - coef_xy(2, 8) = coef_xy(2, 8)+coef_x(4, 7)*pol_y(2, 0, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(1, 8)*pol_y(1, 0, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(2, 8)*pol_y(1, 0, jg) - coef_xy(1, 9) = coef_xy(1, 9)+coef_x(3, 8)*pol_y(2, 0, jg) - coef_xy(2, 9) = coef_xy(2, 9)+coef_x(4, 8)*pol_y(2, 0, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(1, 9)*pol_y(1, 0, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(2, 9)*pol_y(1, 0, jg) - coef_xy(1, 10) = coef_xy(1, 10)+coef_x(3, 9)*pol_y(2, 0, jg) - coef_xy(2, 10) = coef_xy(2, 10)+coef_x(4, 9)*pol_y(2, 0, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(1, 0)*pol_y(1, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(2, 0)*pol_y(1, 1, jg) - coef_xy(1, 11) = coef_xy(1, 11)+coef_x(3, 0)*pol_y(2, 1, jg) - coef_xy(2, 11) = coef_xy(2, 11)+coef_x(4, 0)*pol_y(2, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(1, 1)*pol_y(1, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(2, 1)*pol_y(1, 1, jg) - coef_xy(1, 12) = coef_xy(1, 12)+coef_x(3, 1)*pol_y(2, 1, jg) - coef_xy(2, 12) = coef_xy(2, 12)+coef_x(4, 1)*pol_y(2, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(1, 2)*pol_y(1, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(2, 2)*pol_y(1, 1, jg) - coef_xy(1, 13) = coef_xy(1, 13)+coef_x(3, 2)*pol_y(2, 1, jg) - coef_xy(2, 13) = coef_xy(2, 13)+coef_x(4, 2)*pol_y(2, 1, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(1, 3)*pol_y(1, 1, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(2, 3)*pol_y(1, 1, jg) - coef_xy(1, 14) = coef_xy(1, 14)+coef_x(3, 3)*pol_y(2, 1, jg) - coef_xy(2, 14) = coef_xy(2, 14)+coef_x(4, 3)*pol_y(2, 1, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(1, 4)*pol_y(1, 1, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(2, 4)*pol_y(1, 1, jg) - coef_xy(1, 15) = coef_xy(1, 15)+coef_x(3, 4)*pol_y(2, 1, jg) - coef_xy(2, 15) = coef_xy(2, 15)+coef_x(4, 4)*pol_y(2, 1, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(1, 5)*pol_y(1, 1, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(2, 5)*pol_y(1, 1, jg) - coef_xy(1, 16) = coef_xy(1, 16)+coef_x(3, 5)*pol_y(2, 1, jg) - coef_xy(2, 16) = coef_xy(2, 16)+coef_x(4, 5)*pol_y(2, 1, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(1, 6)*pol_y(1, 1, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(2, 6)*pol_y(1, 1, jg) - coef_xy(1, 17) = coef_xy(1, 17)+coef_x(3, 6)*pol_y(2, 1, jg) - coef_xy(2, 17) = coef_xy(2, 17)+coef_x(4, 6)*pol_y(2, 1, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(1, 7)*pol_y(1, 1, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(2, 7)*pol_y(1, 1, jg) - coef_xy(1, 18) = coef_xy(1, 18)+coef_x(3, 7)*pol_y(2, 1, jg) - coef_xy(2, 18) = coef_xy(2, 18)+coef_x(4, 7)*pol_y(2, 1, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(1, 8)*pol_y(1, 1, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(2, 8)*pol_y(1, 1, jg) - coef_xy(1, 19) = coef_xy(1, 19)+coef_x(3, 8)*pol_y(2, 1, jg) - coef_xy(2, 19) = coef_xy(2, 19)+coef_x(4, 8)*pol_y(2, 1, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(1, 0)*pol_y(1, 2, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(2, 0)*pol_y(1, 2, jg) - coef_xy(1, 20) = coef_xy(1, 20)+coef_x(3, 0)*pol_y(2, 2, jg) - coef_xy(2, 20) = coef_xy(2, 20)+coef_x(4, 0)*pol_y(2, 2, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(1, 1)*pol_y(1, 2, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(2, 1)*pol_y(1, 2, jg) - coef_xy(1, 21) = coef_xy(1, 21)+coef_x(3, 1)*pol_y(2, 2, jg) - coef_xy(2, 21) = coef_xy(2, 21)+coef_x(4, 1)*pol_y(2, 2, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(1, 2)*pol_y(1, 2, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(2, 2)*pol_y(1, 2, jg) - coef_xy(1, 22) = coef_xy(1, 22)+coef_x(3, 2)*pol_y(2, 2, jg) - coef_xy(2, 22) = coef_xy(2, 22)+coef_x(4, 2)*pol_y(2, 2, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(1, 3)*pol_y(1, 2, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(2, 3)*pol_y(1, 2, jg) - coef_xy(1, 23) = coef_xy(1, 23)+coef_x(3, 3)*pol_y(2, 2, jg) - coef_xy(2, 23) = coef_xy(2, 23)+coef_x(4, 3)*pol_y(2, 2, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(1, 4)*pol_y(1, 2, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(2, 4)*pol_y(1, 2, jg) - coef_xy(1, 24) = coef_xy(1, 24)+coef_x(3, 4)*pol_y(2, 2, jg) - coef_xy(2, 24) = coef_xy(2, 24)+coef_x(4, 4)*pol_y(2, 2, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(1, 5)*pol_y(1, 2, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(2, 5)*pol_y(1, 2, jg) - coef_xy(1, 25) = coef_xy(1, 25)+coef_x(3, 5)*pol_y(2, 2, jg) - coef_xy(2, 25) = coef_xy(2, 25)+coef_x(4, 5)*pol_y(2, 2, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(1, 6)*pol_y(1, 2, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(2, 6)*pol_y(1, 2, jg) - coef_xy(1, 26) = coef_xy(1, 26)+coef_x(3, 6)*pol_y(2, 2, jg) - coef_xy(2, 26) = coef_xy(2, 26)+coef_x(4, 6)*pol_y(2, 2, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(1, 7)*pol_y(1, 2, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(2, 7)*pol_y(1, 2, jg) - coef_xy(1, 27) = coef_xy(1, 27)+coef_x(3, 7)*pol_y(2, 2, jg) - coef_xy(2, 27) = coef_xy(2, 27)+coef_x(4, 7)*pol_y(2, 2, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(1, 0)*pol_y(1, 3, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(2, 0)*pol_y(1, 3, jg) - coef_xy(1, 28) = coef_xy(1, 28)+coef_x(3, 0)*pol_y(2, 3, jg) - coef_xy(2, 28) = coef_xy(2, 28)+coef_x(4, 0)*pol_y(2, 3, jg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_x(1, 1)*pol_y(1, 3, jg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_x(2, 1)*pol_y(1, 3, jg) - coef_xy(1, 29) = coef_xy(1, 29)+coef_x(3, 1)*pol_y(2, 3, jg) - coef_xy(2, 29) = coef_xy(2, 29)+coef_x(4, 1)*pol_y(2, 3, jg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_x(1, 2)*pol_y(1, 3, jg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_x(2, 2)*pol_y(1, 3, jg) - coef_xy(1, 30) = coef_xy(1, 30)+coef_x(3, 2)*pol_y(2, 3, jg) - coef_xy(2, 30) = coef_xy(2, 30)+coef_x(4, 2)*pol_y(2, 3, jg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_x(1, 3)*pol_y(1, 3, jg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_x(2, 3)*pol_y(1, 3, jg) - coef_xy(1, 31) = coef_xy(1, 31)+coef_x(3, 3)*pol_y(2, 3, jg) - coef_xy(2, 31) = coef_xy(2, 31)+coef_x(4, 3)*pol_y(2, 3, jg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_x(1, 4)*pol_y(1, 3, jg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_x(2, 4)*pol_y(1, 3, jg) - coef_xy(1, 32) = coef_xy(1, 32)+coef_x(3, 4)*pol_y(2, 3, jg) - coef_xy(2, 32) = coef_xy(2, 32)+coef_x(4, 4)*pol_y(2, 3, jg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_x(1, 5)*pol_y(1, 3, jg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_x(2, 5)*pol_y(1, 3, jg) - coef_xy(1, 33) = coef_xy(1, 33)+coef_x(3, 5)*pol_y(2, 3, jg) - coef_xy(2, 33) = coef_xy(2, 33)+coef_x(4, 5)*pol_y(2, 3, jg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_x(1, 6)*pol_y(1, 3, jg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_x(2, 6)*pol_y(1, 3, jg) - coef_xy(1, 34) = coef_xy(1, 34)+coef_x(3, 6)*pol_y(2, 3, jg) - coef_xy(2, 34) = coef_xy(2, 34)+coef_x(4, 6)*pol_y(2, 3, jg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_x(1, 0)*pol_y(1, 4, jg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_x(2, 0)*pol_y(1, 4, jg) - coef_xy(1, 35) = coef_xy(1, 35)+coef_x(3, 0)*pol_y(2, 4, jg) - coef_xy(2, 35) = coef_xy(2, 35)+coef_x(4, 0)*pol_y(2, 4, jg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_x(1, 1)*pol_y(1, 4, jg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_x(2, 1)*pol_y(1, 4, jg) - coef_xy(1, 36) = coef_xy(1, 36)+coef_x(3, 1)*pol_y(2, 4, jg) - coef_xy(2, 36) = coef_xy(2, 36)+coef_x(4, 1)*pol_y(2, 4, jg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_x(1, 2)*pol_y(1, 4, jg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_x(2, 2)*pol_y(1, 4, jg) - coef_xy(1, 37) = coef_xy(1, 37)+coef_x(3, 2)*pol_y(2, 4, jg) - coef_xy(2, 37) = coef_xy(2, 37)+coef_x(4, 2)*pol_y(2, 4, jg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_x(1, 3)*pol_y(1, 4, jg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_x(2, 3)*pol_y(1, 4, jg) - coef_xy(1, 38) = coef_xy(1, 38)+coef_x(3, 3)*pol_y(2, 4, jg) - coef_xy(2, 38) = coef_xy(2, 38)+coef_x(4, 3)*pol_y(2, 4, jg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_x(1, 4)*pol_y(1, 4, jg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_x(2, 4)*pol_y(1, 4, jg) - coef_xy(1, 39) = coef_xy(1, 39)+coef_x(3, 4)*pol_y(2, 4, jg) - coef_xy(2, 39) = coef_xy(2, 39)+coef_x(4, 4)*pol_y(2, 4, jg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_x(1, 5)*pol_y(1, 4, jg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_x(2, 5)*pol_y(1, 4, jg) - coef_xy(1, 40) = coef_xy(1, 40)+coef_x(3, 5)*pol_y(2, 4, jg) - coef_xy(2, 40) = coef_xy(2, 40)+coef_x(4, 5)*pol_y(2, 4, jg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_x(1, 0)*pol_y(1, 5, jg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_x(2, 0)*pol_y(1, 5, jg) - coef_xy(1, 41) = coef_xy(1, 41)+coef_x(3, 0)*pol_y(2, 5, jg) - coef_xy(2, 41) = coef_xy(2, 41)+coef_x(4, 0)*pol_y(2, 5, jg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_x(1, 1)*pol_y(1, 5, jg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_x(2, 1)*pol_y(1, 5, jg) - coef_xy(1, 42) = coef_xy(1, 42)+coef_x(3, 1)*pol_y(2, 5, jg) - coef_xy(2, 42) = coef_xy(2, 42)+coef_x(4, 1)*pol_y(2, 5, jg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_x(1, 2)*pol_y(1, 5, jg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_x(2, 2)*pol_y(1, 5, jg) - coef_xy(1, 43) = coef_xy(1, 43)+coef_x(3, 2)*pol_y(2, 5, jg) - coef_xy(2, 43) = coef_xy(2, 43)+coef_x(4, 2)*pol_y(2, 5, jg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_x(1, 3)*pol_y(1, 5, jg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_x(2, 3)*pol_y(1, 5, jg) - coef_xy(1, 44) = coef_xy(1, 44)+coef_x(3, 3)*pol_y(2, 5, jg) - coef_xy(2, 44) = coef_xy(2, 44)+coef_x(4, 3)*pol_y(2, 5, jg) - coef_xy(1, 45) = coef_xy(1, 45)+coef_x(1, 4)*pol_y(1, 5, jg) - coef_xy(2, 45) = coef_xy(2, 45)+coef_x(2, 4)*pol_y(1, 5, jg) - coef_xy(1, 45) = coef_xy(1, 45)+coef_x(3, 4)*pol_y(2, 5, jg) - coef_xy(2, 45) = coef_xy(2, 45)+coef_x(4, 4)*pol_y(2, 5, jg) - coef_xy(1, 46) = coef_xy(1, 46)+coef_x(1, 0)*pol_y(1, 6, jg) - coef_xy(2, 46) = coef_xy(2, 46)+coef_x(2, 0)*pol_y(1, 6, jg) - coef_xy(1, 46) = coef_xy(1, 46)+coef_x(3, 0)*pol_y(2, 6, jg) - coef_xy(2, 46) = coef_xy(2, 46)+coef_x(4, 0)*pol_y(2, 6, jg) - coef_xy(1, 47) = coef_xy(1, 47)+coef_x(1, 1)*pol_y(1, 6, jg) - coef_xy(2, 47) = coef_xy(2, 47)+coef_x(2, 1)*pol_y(1, 6, jg) - coef_xy(1, 47) = coef_xy(1, 47)+coef_x(3, 1)*pol_y(2, 6, jg) - coef_xy(2, 47) = coef_xy(2, 47)+coef_x(4, 1)*pol_y(2, 6, jg) - coef_xy(1, 48) = coef_xy(1, 48)+coef_x(1, 2)*pol_y(1, 6, jg) - coef_xy(2, 48) = coef_xy(2, 48)+coef_x(2, 2)*pol_y(1, 6, jg) - coef_xy(1, 48) = coef_xy(1, 48)+coef_x(3, 2)*pol_y(2, 6, jg) - coef_xy(2, 48) = coef_xy(2, 48)+coef_x(4, 2)*pol_y(2, 6, jg) - coef_xy(1, 49) = coef_xy(1, 49)+coef_x(1, 3)*pol_y(1, 6, jg) - coef_xy(2, 49) = coef_xy(2, 49)+coef_x(2, 3)*pol_y(1, 6, jg) - coef_xy(1, 49) = coef_xy(1, 49)+coef_x(3, 3)*pol_y(2, 6, jg) - coef_xy(2, 49) = coef_xy(2, 49)+coef_x(4, 3)*pol_y(2, 6, jg) - coef_xy(1, 50) = coef_xy(1, 50)+coef_x(1, 0)*pol_y(1, 7, jg) - coef_xy(2, 50) = coef_xy(2, 50)+coef_x(2, 0)*pol_y(1, 7, jg) - coef_xy(1, 50) = coef_xy(1, 50)+coef_x(3, 0)*pol_y(2, 7, jg) - coef_xy(2, 50) = coef_xy(2, 50)+coef_x(4, 0)*pol_y(2, 7, jg) - coef_xy(1, 51) = coef_xy(1, 51)+coef_x(1, 1)*pol_y(1, 7, jg) - coef_xy(2, 51) = coef_xy(2, 51)+coef_x(2, 1)*pol_y(1, 7, jg) - coef_xy(1, 51) = coef_xy(1, 51)+coef_x(3, 1)*pol_y(2, 7, jg) - coef_xy(2, 51) = coef_xy(2, 51)+coef_x(4, 1)*pol_y(2, 7, jg) - coef_xy(1, 52) = coef_xy(1, 52)+coef_x(1, 2)*pol_y(1, 7, jg) - coef_xy(2, 52) = coef_xy(2, 52)+coef_x(2, 2)*pol_y(1, 7, jg) - coef_xy(1, 52) = coef_xy(1, 52)+coef_x(3, 2)*pol_y(2, 7, jg) - coef_xy(2, 52) = coef_xy(2, 52)+coef_x(4, 2)*pol_y(2, 7, jg) - coef_xy(1, 53) = coef_xy(1, 53)+coef_x(1, 0)*pol_y(1, 8, jg) - coef_xy(2, 53) = coef_xy(2, 53)+coef_x(2, 0)*pol_y(1, 8, jg) - coef_xy(1, 53) = coef_xy(1, 53)+coef_x(3, 0)*pol_y(2, 8, jg) - coef_xy(2, 53) = coef_xy(2, 53)+coef_x(4, 0)*pol_y(2, 8, jg) - coef_xy(1, 54) = coef_xy(1, 54)+coef_x(1, 1)*pol_y(1, 8, jg) - coef_xy(2, 54) = coef_xy(2, 54)+coef_x(2, 1)*pol_y(1, 8, jg) - coef_xy(1, 54) = coef_xy(1, 54)+coef_x(3, 1)*pol_y(2, 8, jg) - coef_xy(2, 54) = coef_xy(2, 54)+coef_x(4, 1)*pol_y(2, 8, jg) - coef_xy(1, 55) = coef_xy(1, 55)+coef_x(1, 0)*pol_y(1, 9, jg) - coef_xy(2, 55) = coef_xy(2, 55)+coef_x(2, 0)*pol_y(1, 9, jg) - coef_xy(1, 55) = coef_xy(1, 55)+coef_x(3, 0)*pol_y(2, 9, jg) - coef_xy(2, 55) = coef_xy(2, 55)+coef_x(4, 0)*pol_y(2, 9, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(1, 0)*pol_y(1, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(2, 0)*pol_y(1, 0, jg) + coef_xy(1, 1) = coef_xy(1, 1) + coef_x(3, 0)*pol_y(2, 0, jg) + coef_xy(2, 1) = coef_xy(2, 1) + coef_x(4, 0)*pol_y(2, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(1, 1)*pol_y(1, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(2, 1)*pol_y(1, 0, jg) + coef_xy(1, 2) = coef_xy(1, 2) + coef_x(3, 1)*pol_y(2, 0, jg) + coef_xy(2, 2) = coef_xy(2, 2) + coef_x(4, 1)*pol_y(2, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(1, 2)*pol_y(1, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(2, 2)*pol_y(1, 0, jg) + coef_xy(1, 3) = coef_xy(1, 3) + coef_x(3, 2)*pol_y(2, 0, jg) + coef_xy(2, 3) = coef_xy(2, 3) + coef_x(4, 2)*pol_y(2, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(1, 3)*pol_y(1, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(2, 3)*pol_y(1, 0, jg) + coef_xy(1, 4) = coef_xy(1, 4) + coef_x(3, 3)*pol_y(2, 0, jg) + coef_xy(2, 4) = coef_xy(2, 4) + coef_x(4, 3)*pol_y(2, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(1, 4)*pol_y(1, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(2, 4)*pol_y(1, 0, jg) + coef_xy(1, 5) = coef_xy(1, 5) + coef_x(3, 4)*pol_y(2, 0, jg) + coef_xy(2, 5) = coef_xy(2, 5) + coef_x(4, 4)*pol_y(2, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(1, 5)*pol_y(1, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(2, 5)*pol_y(1, 0, jg) + coef_xy(1, 6) = coef_xy(1, 6) + coef_x(3, 5)*pol_y(2, 0, jg) + coef_xy(2, 6) = coef_xy(2, 6) + coef_x(4, 5)*pol_y(2, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(1, 6)*pol_y(1, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(2, 6)*pol_y(1, 0, jg) + coef_xy(1, 7) = coef_xy(1, 7) + coef_x(3, 6)*pol_y(2, 0, jg) + coef_xy(2, 7) = coef_xy(2, 7) + coef_x(4, 6)*pol_y(2, 0, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(1, 7)*pol_y(1, 0, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(2, 7)*pol_y(1, 0, jg) + coef_xy(1, 8) = coef_xy(1, 8) + coef_x(3, 7)*pol_y(2, 0, jg) + coef_xy(2, 8) = coef_xy(2, 8) + coef_x(4, 7)*pol_y(2, 0, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(1, 8)*pol_y(1, 0, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(2, 8)*pol_y(1, 0, jg) + coef_xy(1, 9) = coef_xy(1, 9) + coef_x(3, 8)*pol_y(2, 0, jg) + coef_xy(2, 9) = coef_xy(2, 9) + coef_x(4, 8)*pol_y(2, 0, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(1, 9)*pol_y(1, 0, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(2, 9)*pol_y(1, 0, jg) + coef_xy(1, 10) = coef_xy(1, 10) + coef_x(3, 9)*pol_y(2, 0, jg) + coef_xy(2, 10) = coef_xy(2, 10) + coef_x(4, 9)*pol_y(2, 0, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(1, 0)*pol_y(1, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(2, 0)*pol_y(1, 1, jg) + coef_xy(1, 11) = coef_xy(1, 11) + coef_x(3, 0)*pol_y(2, 1, jg) + coef_xy(2, 11) = coef_xy(2, 11) + coef_x(4, 0)*pol_y(2, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(1, 1)*pol_y(1, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(2, 1)*pol_y(1, 1, jg) + coef_xy(1, 12) = coef_xy(1, 12) + coef_x(3, 1)*pol_y(2, 1, jg) + coef_xy(2, 12) = coef_xy(2, 12) + coef_x(4, 1)*pol_y(2, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(1, 2)*pol_y(1, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(2, 2)*pol_y(1, 1, jg) + coef_xy(1, 13) = coef_xy(1, 13) + coef_x(3, 2)*pol_y(2, 1, jg) + coef_xy(2, 13) = coef_xy(2, 13) + coef_x(4, 2)*pol_y(2, 1, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(1, 3)*pol_y(1, 1, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(2, 3)*pol_y(1, 1, jg) + coef_xy(1, 14) = coef_xy(1, 14) + coef_x(3, 3)*pol_y(2, 1, jg) + coef_xy(2, 14) = coef_xy(2, 14) + coef_x(4, 3)*pol_y(2, 1, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(1, 4)*pol_y(1, 1, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(2, 4)*pol_y(1, 1, jg) + coef_xy(1, 15) = coef_xy(1, 15) + coef_x(3, 4)*pol_y(2, 1, jg) + coef_xy(2, 15) = coef_xy(2, 15) + coef_x(4, 4)*pol_y(2, 1, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(1, 5)*pol_y(1, 1, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(2, 5)*pol_y(1, 1, jg) + coef_xy(1, 16) = coef_xy(1, 16) + coef_x(3, 5)*pol_y(2, 1, jg) + coef_xy(2, 16) = coef_xy(2, 16) + coef_x(4, 5)*pol_y(2, 1, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(1, 6)*pol_y(1, 1, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(2, 6)*pol_y(1, 1, jg) + coef_xy(1, 17) = coef_xy(1, 17) + coef_x(3, 6)*pol_y(2, 1, jg) + coef_xy(2, 17) = coef_xy(2, 17) + coef_x(4, 6)*pol_y(2, 1, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(1, 7)*pol_y(1, 1, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(2, 7)*pol_y(1, 1, jg) + coef_xy(1, 18) = coef_xy(1, 18) + coef_x(3, 7)*pol_y(2, 1, jg) + coef_xy(2, 18) = coef_xy(2, 18) + coef_x(4, 7)*pol_y(2, 1, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(1, 8)*pol_y(1, 1, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(2, 8)*pol_y(1, 1, jg) + coef_xy(1, 19) = coef_xy(1, 19) + coef_x(3, 8)*pol_y(2, 1, jg) + coef_xy(2, 19) = coef_xy(2, 19) + coef_x(4, 8)*pol_y(2, 1, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(1, 0)*pol_y(1, 2, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(2, 0)*pol_y(1, 2, jg) + coef_xy(1, 20) = coef_xy(1, 20) + coef_x(3, 0)*pol_y(2, 2, jg) + coef_xy(2, 20) = coef_xy(2, 20) + coef_x(4, 0)*pol_y(2, 2, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(1, 1)*pol_y(1, 2, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(2, 1)*pol_y(1, 2, jg) + coef_xy(1, 21) = coef_xy(1, 21) + coef_x(3, 1)*pol_y(2, 2, jg) + coef_xy(2, 21) = coef_xy(2, 21) + coef_x(4, 1)*pol_y(2, 2, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(1, 2)*pol_y(1, 2, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(2, 2)*pol_y(1, 2, jg) + coef_xy(1, 22) = coef_xy(1, 22) + coef_x(3, 2)*pol_y(2, 2, jg) + coef_xy(2, 22) = coef_xy(2, 22) + coef_x(4, 2)*pol_y(2, 2, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(1, 3)*pol_y(1, 2, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(2, 3)*pol_y(1, 2, jg) + coef_xy(1, 23) = coef_xy(1, 23) + coef_x(3, 3)*pol_y(2, 2, jg) + coef_xy(2, 23) = coef_xy(2, 23) + coef_x(4, 3)*pol_y(2, 2, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(1, 4)*pol_y(1, 2, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(2, 4)*pol_y(1, 2, jg) + coef_xy(1, 24) = coef_xy(1, 24) + coef_x(3, 4)*pol_y(2, 2, jg) + coef_xy(2, 24) = coef_xy(2, 24) + coef_x(4, 4)*pol_y(2, 2, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(1, 5)*pol_y(1, 2, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(2, 5)*pol_y(1, 2, jg) + coef_xy(1, 25) = coef_xy(1, 25) + coef_x(3, 5)*pol_y(2, 2, jg) + coef_xy(2, 25) = coef_xy(2, 25) + coef_x(4, 5)*pol_y(2, 2, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(1, 6)*pol_y(1, 2, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(2, 6)*pol_y(1, 2, jg) + coef_xy(1, 26) = coef_xy(1, 26) + coef_x(3, 6)*pol_y(2, 2, jg) + coef_xy(2, 26) = coef_xy(2, 26) + coef_x(4, 6)*pol_y(2, 2, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(1, 7)*pol_y(1, 2, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(2, 7)*pol_y(1, 2, jg) + coef_xy(1, 27) = coef_xy(1, 27) + coef_x(3, 7)*pol_y(2, 2, jg) + coef_xy(2, 27) = coef_xy(2, 27) + coef_x(4, 7)*pol_y(2, 2, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(1, 0)*pol_y(1, 3, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(2, 0)*pol_y(1, 3, jg) + coef_xy(1, 28) = coef_xy(1, 28) + coef_x(3, 0)*pol_y(2, 3, jg) + coef_xy(2, 28) = coef_xy(2, 28) + coef_x(4, 0)*pol_y(2, 3, jg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_x(1, 1)*pol_y(1, 3, jg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_x(2, 1)*pol_y(1, 3, jg) + coef_xy(1, 29) = coef_xy(1, 29) + coef_x(3, 1)*pol_y(2, 3, jg) + coef_xy(2, 29) = coef_xy(2, 29) + coef_x(4, 1)*pol_y(2, 3, jg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_x(1, 2)*pol_y(1, 3, jg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_x(2, 2)*pol_y(1, 3, jg) + coef_xy(1, 30) = coef_xy(1, 30) + coef_x(3, 2)*pol_y(2, 3, jg) + coef_xy(2, 30) = coef_xy(2, 30) + coef_x(4, 2)*pol_y(2, 3, jg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_x(1, 3)*pol_y(1, 3, jg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_x(2, 3)*pol_y(1, 3, jg) + coef_xy(1, 31) = coef_xy(1, 31) + coef_x(3, 3)*pol_y(2, 3, jg) + coef_xy(2, 31) = coef_xy(2, 31) + coef_x(4, 3)*pol_y(2, 3, jg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_x(1, 4)*pol_y(1, 3, jg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_x(2, 4)*pol_y(1, 3, jg) + coef_xy(1, 32) = coef_xy(1, 32) + coef_x(3, 4)*pol_y(2, 3, jg) + coef_xy(2, 32) = coef_xy(2, 32) + coef_x(4, 4)*pol_y(2, 3, jg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_x(1, 5)*pol_y(1, 3, jg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_x(2, 5)*pol_y(1, 3, jg) + coef_xy(1, 33) = coef_xy(1, 33) + coef_x(3, 5)*pol_y(2, 3, jg) + coef_xy(2, 33) = coef_xy(2, 33) + coef_x(4, 5)*pol_y(2, 3, jg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_x(1, 6)*pol_y(1, 3, jg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_x(2, 6)*pol_y(1, 3, jg) + coef_xy(1, 34) = coef_xy(1, 34) + coef_x(3, 6)*pol_y(2, 3, jg) + coef_xy(2, 34) = coef_xy(2, 34) + coef_x(4, 6)*pol_y(2, 3, jg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_x(1, 0)*pol_y(1, 4, jg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_x(2, 0)*pol_y(1, 4, jg) + coef_xy(1, 35) = coef_xy(1, 35) + coef_x(3, 0)*pol_y(2, 4, jg) + coef_xy(2, 35) = coef_xy(2, 35) + coef_x(4, 0)*pol_y(2, 4, jg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_x(1, 1)*pol_y(1, 4, jg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_x(2, 1)*pol_y(1, 4, jg) + coef_xy(1, 36) = coef_xy(1, 36) + coef_x(3, 1)*pol_y(2, 4, jg) + coef_xy(2, 36) = coef_xy(2, 36) + coef_x(4, 1)*pol_y(2, 4, jg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_x(1, 2)*pol_y(1, 4, jg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_x(2, 2)*pol_y(1, 4, jg) + coef_xy(1, 37) = coef_xy(1, 37) + coef_x(3, 2)*pol_y(2, 4, jg) + coef_xy(2, 37) = coef_xy(2, 37) + coef_x(4, 2)*pol_y(2, 4, jg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_x(1, 3)*pol_y(1, 4, jg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_x(2, 3)*pol_y(1, 4, jg) + coef_xy(1, 38) = coef_xy(1, 38) + coef_x(3, 3)*pol_y(2, 4, jg) + coef_xy(2, 38) = coef_xy(2, 38) + coef_x(4, 3)*pol_y(2, 4, jg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_x(1, 4)*pol_y(1, 4, jg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_x(2, 4)*pol_y(1, 4, jg) + coef_xy(1, 39) = coef_xy(1, 39) + coef_x(3, 4)*pol_y(2, 4, jg) + coef_xy(2, 39) = coef_xy(2, 39) + coef_x(4, 4)*pol_y(2, 4, jg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_x(1, 5)*pol_y(1, 4, jg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_x(2, 5)*pol_y(1, 4, jg) + coef_xy(1, 40) = coef_xy(1, 40) + coef_x(3, 5)*pol_y(2, 4, jg) + coef_xy(2, 40) = coef_xy(2, 40) + coef_x(4, 5)*pol_y(2, 4, jg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_x(1, 0)*pol_y(1, 5, jg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_x(2, 0)*pol_y(1, 5, jg) + coef_xy(1, 41) = coef_xy(1, 41) + coef_x(3, 0)*pol_y(2, 5, jg) + coef_xy(2, 41) = coef_xy(2, 41) + coef_x(4, 0)*pol_y(2, 5, jg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_x(1, 1)*pol_y(1, 5, jg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_x(2, 1)*pol_y(1, 5, jg) + coef_xy(1, 42) = coef_xy(1, 42) + coef_x(3, 1)*pol_y(2, 5, jg) + coef_xy(2, 42) = coef_xy(2, 42) + coef_x(4, 1)*pol_y(2, 5, jg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_x(1, 2)*pol_y(1, 5, jg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_x(2, 2)*pol_y(1, 5, jg) + coef_xy(1, 43) = coef_xy(1, 43) + coef_x(3, 2)*pol_y(2, 5, jg) + coef_xy(2, 43) = coef_xy(2, 43) + coef_x(4, 2)*pol_y(2, 5, jg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_x(1, 3)*pol_y(1, 5, jg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_x(2, 3)*pol_y(1, 5, jg) + coef_xy(1, 44) = coef_xy(1, 44) + coef_x(3, 3)*pol_y(2, 5, jg) + coef_xy(2, 44) = coef_xy(2, 44) + coef_x(4, 3)*pol_y(2, 5, jg) + coef_xy(1, 45) = coef_xy(1, 45) + coef_x(1, 4)*pol_y(1, 5, jg) + coef_xy(2, 45) = coef_xy(2, 45) + coef_x(2, 4)*pol_y(1, 5, jg) + coef_xy(1, 45) = coef_xy(1, 45) + coef_x(3, 4)*pol_y(2, 5, jg) + coef_xy(2, 45) = coef_xy(2, 45) + coef_x(4, 4)*pol_y(2, 5, jg) + coef_xy(1, 46) = coef_xy(1, 46) + coef_x(1, 0)*pol_y(1, 6, jg) + coef_xy(2, 46) = coef_xy(2, 46) + coef_x(2, 0)*pol_y(1, 6, jg) + coef_xy(1, 46) = coef_xy(1, 46) + coef_x(3, 0)*pol_y(2, 6, jg) + coef_xy(2, 46) = coef_xy(2, 46) + coef_x(4, 0)*pol_y(2, 6, jg) + coef_xy(1, 47) = coef_xy(1, 47) + coef_x(1, 1)*pol_y(1, 6, jg) + coef_xy(2, 47) = coef_xy(2, 47) + coef_x(2, 1)*pol_y(1, 6, jg) + coef_xy(1, 47) = coef_xy(1, 47) + coef_x(3, 1)*pol_y(2, 6, jg) + coef_xy(2, 47) = coef_xy(2, 47) + coef_x(4, 1)*pol_y(2, 6, jg) + coef_xy(1, 48) = coef_xy(1, 48) + coef_x(1, 2)*pol_y(1, 6, jg) + coef_xy(2, 48) = coef_xy(2, 48) + coef_x(2, 2)*pol_y(1, 6, jg) + coef_xy(1, 48) = coef_xy(1, 48) + coef_x(3, 2)*pol_y(2, 6, jg) + coef_xy(2, 48) = coef_xy(2, 48) + coef_x(4, 2)*pol_y(2, 6, jg) + coef_xy(1, 49) = coef_xy(1, 49) + coef_x(1, 3)*pol_y(1, 6, jg) + coef_xy(2, 49) = coef_xy(2, 49) + coef_x(2, 3)*pol_y(1, 6, jg) + coef_xy(1, 49) = coef_xy(1, 49) + coef_x(3, 3)*pol_y(2, 6, jg) + coef_xy(2, 49) = coef_xy(2, 49) + coef_x(4, 3)*pol_y(2, 6, jg) + coef_xy(1, 50) = coef_xy(1, 50) + coef_x(1, 0)*pol_y(1, 7, jg) + coef_xy(2, 50) = coef_xy(2, 50) + coef_x(2, 0)*pol_y(1, 7, jg) + coef_xy(1, 50) = coef_xy(1, 50) + coef_x(3, 0)*pol_y(2, 7, jg) + coef_xy(2, 50) = coef_xy(2, 50) + coef_x(4, 0)*pol_y(2, 7, jg) + coef_xy(1, 51) = coef_xy(1, 51) + coef_x(1, 1)*pol_y(1, 7, jg) + coef_xy(2, 51) = coef_xy(2, 51) + coef_x(2, 1)*pol_y(1, 7, jg) + coef_xy(1, 51) = coef_xy(1, 51) + coef_x(3, 1)*pol_y(2, 7, jg) + coef_xy(2, 51) = coef_xy(2, 51) + coef_x(4, 1)*pol_y(2, 7, jg) + coef_xy(1, 52) = coef_xy(1, 52) + coef_x(1, 2)*pol_y(1, 7, jg) + coef_xy(2, 52) = coef_xy(2, 52) + coef_x(2, 2)*pol_y(1, 7, jg) + coef_xy(1, 52) = coef_xy(1, 52) + coef_x(3, 2)*pol_y(2, 7, jg) + coef_xy(2, 52) = coef_xy(2, 52) + coef_x(4, 2)*pol_y(2, 7, jg) + coef_xy(1, 53) = coef_xy(1, 53) + coef_x(1, 0)*pol_y(1, 8, jg) + coef_xy(2, 53) = coef_xy(2, 53) + coef_x(2, 0)*pol_y(1, 8, jg) + coef_xy(1, 53) = coef_xy(1, 53) + coef_x(3, 0)*pol_y(2, 8, jg) + coef_xy(2, 53) = coef_xy(2, 53) + coef_x(4, 0)*pol_y(2, 8, jg) + coef_xy(1, 54) = coef_xy(1, 54) + coef_x(1, 1)*pol_y(1, 8, jg) + coef_xy(2, 54) = coef_xy(2, 54) + coef_x(2, 1)*pol_y(1, 8, jg) + coef_xy(1, 54) = coef_xy(1, 54) + coef_x(3, 1)*pol_y(2, 8, jg) + coef_xy(2, 54) = coef_xy(2, 54) + coef_x(4, 1)*pol_y(2, 8, jg) + coef_xy(1, 55) = coef_xy(1, 55) + coef_x(1, 0)*pol_y(1, 9, jg) + coef_xy(2, 55) = coef_xy(2, 55) + coef_x(2, 0)*pol_y(1, 9, jg) + coef_xy(1, 55) = coef_xy(1, 55) + coef_x(3, 0)*pol_y(2, 9, jg) + coef_xy(2, 55) = coef_xy(2, 55) + coef_x(4, 0)*pol_y(2, 9, jg) END DO - coef_xyz(1) = coef_xyz(1)+coef_xy(1, 1)*pol_z(1, 0, kg) - coef_xyz(1) = coef_xyz(1)+coef_xy(2, 1)*pol_z(2, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(1, 2)*pol_z(1, 0, kg) - coef_xyz(2) = coef_xyz(2)+coef_xy(2, 2)*pol_z(2, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(1, 3)*pol_z(1, 0, kg) - coef_xyz(3) = coef_xyz(3)+coef_xy(2, 3)*pol_z(2, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(1, 4)*pol_z(1, 0, kg) - coef_xyz(4) = coef_xyz(4)+coef_xy(2, 4)*pol_z(2, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(1, 5)*pol_z(1, 0, kg) - coef_xyz(5) = coef_xyz(5)+coef_xy(2, 5)*pol_z(2, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(1, 6)*pol_z(1, 0, kg) - coef_xyz(6) = coef_xyz(6)+coef_xy(2, 6)*pol_z(2, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(1, 7)*pol_z(1, 0, kg) - coef_xyz(7) = coef_xyz(7)+coef_xy(2, 7)*pol_z(2, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(1, 8)*pol_z(1, 0, kg) - coef_xyz(8) = coef_xyz(8)+coef_xy(2, 8)*pol_z(2, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(1, 9)*pol_z(1, 0, kg) - coef_xyz(9) = coef_xyz(9)+coef_xy(2, 9)*pol_z(2, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(1, 10)*pol_z(1, 0, kg) - coef_xyz(10) = coef_xyz(10)+coef_xy(2, 10)*pol_z(2, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(1, 11)*pol_z(1, 0, kg) - coef_xyz(11) = coef_xyz(11)+coef_xy(2, 11)*pol_z(2, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(1, 12)*pol_z(1, 0, kg) - coef_xyz(12) = coef_xyz(12)+coef_xy(2, 12)*pol_z(2, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(1, 13)*pol_z(1, 0, kg) - coef_xyz(13) = coef_xyz(13)+coef_xy(2, 13)*pol_z(2, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(1, 14)*pol_z(1, 0, kg) - coef_xyz(14) = coef_xyz(14)+coef_xy(2, 14)*pol_z(2, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(1, 15)*pol_z(1, 0, kg) - coef_xyz(15) = coef_xyz(15)+coef_xy(2, 15)*pol_z(2, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(1, 16)*pol_z(1, 0, kg) - coef_xyz(16) = coef_xyz(16)+coef_xy(2, 16)*pol_z(2, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(1, 17)*pol_z(1, 0, kg) - coef_xyz(17) = coef_xyz(17)+coef_xy(2, 17)*pol_z(2, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(1, 18)*pol_z(1, 0, kg) - coef_xyz(18) = coef_xyz(18)+coef_xy(2, 18)*pol_z(2, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(1, 19)*pol_z(1, 0, kg) - coef_xyz(19) = coef_xyz(19)+coef_xy(2, 19)*pol_z(2, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(1, 20)*pol_z(1, 0, kg) - coef_xyz(20) = coef_xyz(20)+coef_xy(2, 20)*pol_z(2, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(1, 21)*pol_z(1, 0, kg) - coef_xyz(21) = coef_xyz(21)+coef_xy(2, 21)*pol_z(2, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(1, 22)*pol_z(1, 0, kg) - coef_xyz(22) = coef_xyz(22)+coef_xy(2, 22)*pol_z(2, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(1, 23)*pol_z(1, 0, kg) - coef_xyz(23) = coef_xyz(23)+coef_xy(2, 23)*pol_z(2, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(1, 24)*pol_z(1, 0, kg) - coef_xyz(24) = coef_xyz(24)+coef_xy(2, 24)*pol_z(2, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(1, 25)*pol_z(1, 0, kg) - coef_xyz(25) = coef_xyz(25)+coef_xy(2, 25)*pol_z(2, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(1, 26)*pol_z(1, 0, kg) - coef_xyz(26) = coef_xyz(26)+coef_xy(2, 26)*pol_z(2, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(1, 27)*pol_z(1, 0, kg) - coef_xyz(27) = coef_xyz(27)+coef_xy(2, 27)*pol_z(2, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(1, 28)*pol_z(1, 0, kg) - coef_xyz(28) = coef_xyz(28)+coef_xy(2, 28)*pol_z(2, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(1, 29)*pol_z(1, 0, kg) - coef_xyz(29) = coef_xyz(29)+coef_xy(2, 29)*pol_z(2, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(1, 30)*pol_z(1, 0, kg) - coef_xyz(30) = coef_xyz(30)+coef_xy(2, 30)*pol_z(2, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(1, 31)*pol_z(1, 0, kg) - coef_xyz(31) = coef_xyz(31)+coef_xy(2, 31)*pol_z(2, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(1, 32)*pol_z(1, 0, kg) - coef_xyz(32) = coef_xyz(32)+coef_xy(2, 32)*pol_z(2, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(1, 33)*pol_z(1, 0, kg) - coef_xyz(33) = coef_xyz(33)+coef_xy(2, 33)*pol_z(2, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(1, 34)*pol_z(1, 0, kg) - coef_xyz(34) = coef_xyz(34)+coef_xy(2, 34)*pol_z(2, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(1, 35)*pol_z(1, 0, kg) - coef_xyz(35) = coef_xyz(35)+coef_xy(2, 35)*pol_z(2, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(1, 36)*pol_z(1, 0, kg) - coef_xyz(36) = coef_xyz(36)+coef_xy(2, 36)*pol_z(2, 0, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(1, 37)*pol_z(1, 0, kg) - coef_xyz(37) = coef_xyz(37)+coef_xy(2, 37)*pol_z(2, 0, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(1, 38)*pol_z(1, 0, kg) - coef_xyz(38) = coef_xyz(38)+coef_xy(2, 38)*pol_z(2, 0, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(1, 39)*pol_z(1, 0, kg) - coef_xyz(39) = coef_xyz(39)+coef_xy(2, 39)*pol_z(2, 0, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(1, 40)*pol_z(1, 0, kg) - coef_xyz(40) = coef_xyz(40)+coef_xy(2, 40)*pol_z(2, 0, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(1, 41)*pol_z(1, 0, kg) - coef_xyz(41) = coef_xyz(41)+coef_xy(2, 41)*pol_z(2, 0, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(1, 42)*pol_z(1, 0, kg) - coef_xyz(42) = coef_xyz(42)+coef_xy(2, 42)*pol_z(2, 0, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(1, 43)*pol_z(1, 0, kg) - coef_xyz(43) = coef_xyz(43)+coef_xy(2, 43)*pol_z(2, 0, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(1, 44)*pol_z(1, 0, kg) - coef_xyz(44) = coef_xyz(44)+coef_xy(2, 44)*pol_z(2, 0, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(1, 45)*pol_z(1, 0, kg) - coef_xyz(45) = coef_xyz(45)+coef_xy(2, 45)*pol_z(2, 0, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(1, 46)*pol_z(1, 0, kg) - coef_xyz(46) = coef_xyz(46)+coef_xy(2, 46)*pol_z(2, 0, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(1, 47)*pol_z(1, 0, kg) - coef_xyz(47) = coef_xyz(47)+coef_xy(2, 47)*pol_z(2, 0, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(1, 48)*pol_z(1, 0, kg) - coef_xyz(48) = coef_xyz(48)+coef_xy(2, 48)*pol_z(2, 0, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(1, 49)*pol_z(1, 0, kg) - coef_xyz(49) = coef_xyz(49)+coef_xy(2, 49)*pol_z(2, 0, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(1, 50)*pol_z(1, 0, kg) - coef_xyz(50) = coef_xyz(50)+coef_xy(2, 50)*pol_z(2, 0, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(1, 51)*pol_z(1, 0, kg) - coef_xyz(51) = coef_xyz(51)+coef_xy(2, 51)*pol_z(2, 0, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(1, 52)*pol_z(1, 0, kg) - coef_xyz(52) = coef_xyz(52)+coef_xy(2, 52)*pol_z(2, 0, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(1, 53)*pol_z(1, 0, kg) - coef_xyz(53) = coef_xyz(53)+coef_xy(2, 53)*pol_z(2, 0, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(1, 54)*pol_z(1, 0, kg) - coef_xyz(54) = coef_xyz(54)+coef_xy(2, 54)*pol_z(2, 0, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(1, 55)*pol_z(1, 0, kg) - coef_xyz(55) = coef_xyz(55)+coef_xy(2, 55)*pol_z(2, 0, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(1, 1)*pol_z(1, 1, kg) - coef_xyz(56) = coef_xyz(56)+coef_xy(2, 1)*pol_z(2, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(1, 2)*pol_z(1, 1, kg) - coef_xyz(57) = coef_xyz(57)+coef_xy(2, 2)*pol_z(2, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(1, 3)*pol_z(1, 1, kg) - coef_xyz(58) = coef_xyz(58)+coef_xy(2, 3)*pol_z(2, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(1, 4)*pol_z(1, 1, kg) - coef_xyz(59) = coef_xyz(59)+coef_xy(2, 4)*pol_z(2, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(1, 5)*pol_z(1, 1, kg) - coef_xyz(60) = coef_xyz(60)+coef_xy(2, 5)*pol_z(2, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(1, 6)*pol_z(1, 1, kg) - coef_xyz(61) = coef_xyz(61)+coef_xy(2, 6)*pol_z(2, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(1, 7)*pol_z(1, 1, kg) - coef_xyz(62) = coef_xyz(62)+coef_xy(2, 7)*pol_z(2, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(1, 8)*pol_z(1, 1, kg) - coef_xyz(63) = coef_xyz(63)+coef_xy(2, 8)*pol_z(2, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(1, 9)*pol_z(1, 1, kg) - coef_xyz(64) = coef_xyz(64)+coef_xy(2, 9)*pol_z(2, 1, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(1, 11)*pol_z(1, 1, kg) - coef_xyz(65) = coef_xyz(65)+coef_xy(2, 11)*pol_z(2, 1, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(1, 12)*pol_z(1, 1, kg) - coef_xyz(66) = coef_xyz(66)+coef_xy(2, 12)*pol_z(2, 1, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(1, 13)*pol_z(1, 1, kg) - coef_xyz(67) = coef_xyz(67)+coef_xy(2, 13)*pol_z(2, 1, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(1, 14)*pol_z(1, 1, kg) - coef_xyz(68) = coef_xyz(68)+coef_xy(2, 14)*pol_z(2, 1, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(1, 15)*pol_z(1, 1, kg) - coef_xyz(69) = coef_xyz(69)+coef_xy(2, 15)*pol_z(2, 1, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(1, 16)*pol_z(1, 1, kg) - coef_xyz(70) = coef_xyz(70)+coef_xy(2, 16)*pol_z(2, 1, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(1, 17)*pol_z(1, 1, kg) - coef_xyz(71) = coef_xyz(71)+coef_xy(2, 17)*pol_z(2, 1, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(1, 18)*pol_z(1, 1, kg) - coef_xyz(72) = coef_xyz(72)+coef_xy(2, 18)*pol_z(2, 1, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(1, 20)*pol_z(1, 1, kg) - coef_xyz(73) = coef_xyz(73)+coef_xy(2, 20)*pol_z(2, 1, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(1, 21)*pol_z(1, 1, kg) - coef_xyz(74) = coef_xyz(74)+coef_xy(2, 21)*pol_z(2, 1, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(1, 22)*pol_z(1, 1, kg) - coef_xyz(75) = coef_xyz(75)+coef_xy(2, 22)*pol_z(2, 1, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(1, 23)*pol_z(1, 1, kg) - coef_xyz(76) = coef_xyz(76)+coef_xy(2, 23)*pol_z(2, 1, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(1, 24)*pol_z(1, 1, kg) - coef_xyz(77) = coef_xyz(77)+coef_xy(2, 24)*pol_z(2, 1, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(1, 25)*pol_z(1, 1, kg) - coef_xyz(78) = coef_xyz(78)+coef_xy(2, 25)*pol_z(2, 1, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(1, 26)*pol_z(1, 1, kg) - coef_xyz(79) = coef_xyz(79)+coef_xy(2, 26)*pol_z(2, 1, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(1, 28)*pol_z(1, 1, kg) - coef_xyz(80) = coef_xyz(80)+coef_xy(2, 28)*pol_z(2, 1, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(1, 29)*pol_z(1, 1, kg) - coef_xyz(81) = coef_xyz(81)+coef_xy(2, 29)*pol_z(2, 1, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(1, 30)*pol_z(1, 1, kg) - coef_xyz(82) = coef_xyz(82)+coef_xy(2, 30)*pol_z(2, 1, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(1, 31)*pol_z(1, 1, kg) - coef_xyz(83) = coef_xyz(83)+coef_xy(2, 31)*pol_z(2, 1, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(1, 32)*pol_z(1, 1, kg) - coef_xyz(84) = coef_xyz(84)+coef_xy(2, 32)*pol_z(2, 1, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(1, 33)*pol_z(1, 1, kg) - coef_xyz(85) = coef_xyz(85)+coef_xy(2, 33)*pol_z(2, 1, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(1, 35)*pol_z(1, 1, kg) - coef_xyz(86) = coef_xyz(86)+coef_xy(2, 35)*pol_z(2, 1, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(1, 36)*pol_z(1, 1, kg) - coef_xyz(87) = coef_xyz(87)+coef_xy(2, 36)*pol_z(2, 1, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(1, 37)*pol_z(1, 1, kg) - coef_xyz(88) = coef_xyz(88)+coef_xy(2, 37)*pol_z(2, 1, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(1, 38)*pol_z(1, 1, kg) - coef_xyz(89) = coef_xyz(89)+coef_xy(2, 38)*pol_z(2, 1, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(1, 39)*pol_z(1, 1, kg) - coef_xyz(90) = coef_xyz(90)+coef_xy(2, 39)*pol_z(2, 1, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(1, 41)*pol_z(1, 1, kg) - coef_xyz(91) = coef_xyz(91)+coef_xy(2, 41)*pol_z(2, 1, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(1, 42)*pol_z(1, 1, kg) - coef_xyz(92) = coef_xyz(92)+coef_xy(2, 42)*pol_z(2, 1, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(1, 43)*pol_z(1, 1, kg) - coef_xyz(93) = coef_xyz(93)+coef_xy(2, 43)*pol_z(2, 1, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(1, 44)*pol_z(1, 1, kg) - coef_xyz(94) = coef_xyz(94)+coef_xy(2, 44)*pol_z(2, 1, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(1, 46)*pol_z(1, 1, kg) - coef_xyz(95) = coef_xyz(95)+coef_xy(2, 46)*pol_z(2, 1, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(1, 47)*pol_z(1, 1, kg) - coef_xyz(96) = coef_xyz(96)+coef_xy(2, 47)*pol_z(2, 1, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(1, 48)*pol_z(1, 1, kg) - coef_xyz(97) = coef_xyz(97)+coef_xy(2, 48)*pol_z(2, 1, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(1, 50)*pol_z(1, 1, kg) - coef_xyz(98) = coef_xyz(98)+coef_xy(2, 50)*pol_z(2, 1, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(1, 51)*pol_z(1, 1, kg) - coef_xyz(99) = coef_xyz(99)+coef_xy(2, 51)*pol_z(2, 1, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(1, 53)*pol_z(1, 1, kg) - coef_xyz(100) = coef_xyz(100)+coef_xy(2, 53)*pol_z(2, 1, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(1, 1)*pol_z(1, 2, kg) - coef_xyz(101) = coef_xyz(101)+coef_xy(2, 1)*pol_z(2, 2, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(1, 2)*pol_z(1, 2, kg) - coef_xyz(102) = coef_xyz(102)+coef_xy(2, 2)*pol_z(2, 2, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(1, 3)*pol_z(1, 2, kg) - coef_xyz(103) = coef_xyz(103)+coef_xy(2, 3)*pol_z(2, 2, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(1, 4)*pol_z(1, 2, kg) - coef_xyz(104) = coef_xyz(104)+coef_xy(2, 4)*pol_z(2, 2, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(1, 5)*pol_z(1, 2, kg) - coef_xyz(105) = coef_xyz(105)+coef_xy(2, 5)*pol_z(2, 2, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(1, 6)*pol_z(1, 2, kg) - coef_xyz(106) = coef_xyz(106)+coef_xy(2, 6)*pol_z(2, 2, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(1, 7)*pol_z(1, 2, kg) - coef_xyz(107) = coef_xyz(107)+coef_xy(2, 7)*pol_z(2, 2, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(1, 8)*pol_z(1, 2, kg) - coef_xyz(108) = coef_xyz(108)+coef_xy(2, 8)*pol_z(2, 2, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(1, 11)*pol_z(1, 2, kg) - coef_xyz(109) = coef_xyz(109)+coef_xy(2, 11)*pol_z(2, 2, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(1, 12)*pol_z(1, 2, kg) - coef_xyz(110) = coef_xyz(110)+coef_xy(2, 12)*pol_z(2, 2, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(1, 13)*pol_z(1, 2, kg) - coef_xyz(111) = coef_xyz(111)+coef_xy(2, 13)*pol_z(2, 2, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(1, 14)*pol_z(1, 2, kg) - coef_xyz(112) = coef_xyz(112)+coef_xy(2, 14)*pol_z(2, 2, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(1, 15)*pol_z(1, 2, kg) - coef_xyz(113) = coef_xyz(113)+coef_xy(2, 15)*pol_z(2, 2, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(1, 16)*pol_z(1, 2, kg) - coef_xyz(114) = coef_xyz(114)+coef_xy(2, 16)*pol_z(2, 2, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(1, 17)*pol_z(1, 2, kg) - coef_xyz(115) = coef_xyz(115)+coef_xy(2, 17)*pol_z(2, 2, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(1, 20)*pol_z(1, 2, kg) - coef_xyz(116) = coef_xyz(116)+coef_xy(2, 20)*pol_z(2, 2, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(1, 21)*pol_z(1, 2, kg) - coef_xyz(117) = coef_xyz(117)+coef_xy(2, 21)*pol_z(2, 2, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(1, 22)*pol_z(1, 2, kg) - coef_xyz(118) = coef_xyz(118)+coef_xy(2, 22)*pol_z(2, 2, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(1, 23)*pol_z(1, 2, kg) - coef_xyz(119) = coef_xyz(119)+coef_xy(2, 23)*pol_z(2, 2, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(1, 24)*pol_z(1, 2, kg) - coef_xyz(120) = coef_xyz(120)+coef_xy(2, 24)*pol_z(2, 2, kg) - coef_xyz(121) = coef_xyz(121)+coef_xy(1, 25)*pol_z(1, 2, kg) - coef_xyz(121) = coef_xyz(121)+coef_xy(2, 25)*pol_z(2, 2, kg) - coef_xyz(122) = coef_xyz(122)+coef_xy(1, 28)*pol_z(1, 2, kg) - coef_xyz(122) = coef_xyz(122)+coef_xy(2, 28)*pol_z(2, 2, kg) - coef_xyz(123) = coef_xyz(123)+coef_xy(1, 29)*pol_z(1, 2, kg) - coef_xyz(123) = coef_xyz(123)+coef_xy(2, 29)*pol_z(2, 2, kg) - coef_xyz(124) = coef_xyz(124)+coef_xy(1, 30)*pol_z(1, 2, kg) - coef_xyz(124) = coef_xyz(124)+coef_xy(2, 30)*pol_z(2, 2, kg) - coef_xyz(125) = coef_xyz(125)+coef_xy(1, 31)*pol_z(1, 2, kg) - coef_xyz(125) = coef_xyz(125)+coef_xy(2, 31)*pol_z(2, 2, kg) - coef_xyz(126) = coef_xyz(126)+coef_xy(1, 32)*pol_z(1, 2, kg) - coef_xyz(126) = coef_xyz(126)+coef_xy(2, 32)*pol_z(2, 2, kg) - coef_xyz(127) = coef_xyz(127)+coef_xy(1, 35)*pol_z(1, 2, kg) - coef_xyz(127) = coef_xyz(127)+coef_xy(2, 35)*pol_z(2, 2, kg) - coef_xyz(128) = coef_xyz(128)+coef_xy(1, 36)*pol_z(1, 2, kg) - coef_xyz(128) = coef_xyz(128)+coef_xy(2, 36)*pol_z(2, 2, kg) - coef_xyz(129) = coef_xyz(129)+coef_xy(1, 37)*pol_z(1, 2, kg) - coef_xyz(129) = coef_xyz(129)+coef_xy(2, 37)*pol_z(2, 2, kg) - coef_xyz(130) = coef_xyz(130)+coef_xy(1, 38)*pol_z(1, 2, kg) - coef_xyz(130) = coef_xyz(130)+coef_xy(2, 38)*pol_z(2, 2, kg) - coef_xyz(131) = coef_xyz(131)+coef_xy(1, 41)*pol_z(1, 2, kg) - coef_xyz(131) = coef_xyz(131)+coef_xy(2, 41)*pol_z(2, 2, kg) - coef_xyz(132) = coef_xyz(132)+coef_xy(1, 42)*pol_z(1, 2, kg) - coef_xyz(132) = coef_xyz(132)+coef_xy(2, 42)*pol_z(2, 2, kg) - coef_xyz(133) = coef_xyz(133)+coef_xy(1, 43)*pol_z(1, 2, kg) - coef_xyz(133) = coef_xyz(133)+coef_xy(2, 43)*pol_z(2, 2, kg) - coef_xyz(134) = coef_xyz(134)+coef_xy(1, 46)*pol_z(1, 2, kg) - coef_xyz(134) = coef_xyz(134)+coef_xy(2, 46)*pol_z(2, 2, kg) - coef_xyz(135) = coef_xyz(135)+coef_xy(1, 47)*pol_z(1, 2, kg) - coef_xyz(135) = coef_xyz(135)+coef_xy(2, 47)*pol_z(2, 2, kg) - coef_xyz(136) = coef_xyz(136)+coef_xy(1, 50)*pol_z(1, 2, kg) - coef_xyz(136) = coef_xyz(136)+coef_xy(2, 50)*pol_z(2, 2, kg) - coef_xyz(137) = coef_xyz(137)+coef_xy(1, 1)*pol_z(1, 3, kg) - coef_xyz(137) = coef_xyz(137)+coef_xy(2, 1)*pol_z(2, 3, kg) - coef_xyz(138) = coef_xyz(138)+coef_xy(1, 2)*pol_z(1, 3, kg) - coef_xyz(138) = coef_xyz(138)+coef_xy(2, 2)*pol_z(2, 3, kg) - coef_xyz(139) = coef_xyz(139)+coef_xy(1, 3)*pol_z(1, 3, kg) - coef_xyz(139) = coef_xyz(139)+coef_xy(2, 3)*pol_z(2, 3, kg) - coef_xyz(140) = coef_xyz(140)+coef_xy(1, 4)*pol_z(1, 3, kg) - coef_xyz(140) = coef_xyz(140)+coef_xy(2, 4)*pol_z(2, 3, kg) - coef_xyz(141) = coef_xyz(141)+coef_xy(1, 5)*pol_z(1, 3, kg) - coef_xyz(141) = coef_xyz(141)+coef_xy(2, 5)*pol_z(2, 3, kg) - coef_xyz(142) = coef_xyz(142)+coef_xy(1, 6)*pol_z(1, 3, kg) - coef_xyz(142) = coef_xyz(142)+coef_xy(2, 6)*pol_z(2, 3, kg) - coef_xyz(143) = coef_xyz(143)+coef_xy(1, 7)*pol_z(1, 3, kg) - coef_xyz(143) = coef_xyz(143)+coef_xy(2, 7)*pol_z(2, 3, kg) - coef_xyz(144) = coef_xyz(144)+coef_xy(1, 11)*pol_z(1, 3, kg) - coef_xyz(144) = coef_xyz(144)+coef_xy(2, 11)*pol_z(2, 3, kg) - coef_xyz(145) = coef_xyz(145)+coef_xy(1, 12)*pol_z(1, 3, kg) - coef_xyz(145) = coef_xyz(145)+coef_xy(2, 12)*pol_z(2, 3, kg) - coef_xyz(146) = coef_xyz(146)+coef_xy(1, 13)*pol_z(1, 3, kg) - coef_xyz(146) = coef_xyz(146)+coef_xy(2, 13)*pol_z(2, 3, kg) - coef_xyz(147) = coef_xyz(147)+coef_xy(1, 14)*pol_z(1, 3, kg) - coef_xyz(147) = coef_xyz(147)+coef_xy(2, 14)*pol_z(2, 3, kg) - coef_xyz(148) = coef_xyz(148)+coef_xy(1, 15)*pol_z(1, 3, kg) - coef_xyz(148) = coef_xyz(148)+coef_xy(2, 15)*pol_z(2, 3, kg) - coef_xyz(149) = coef_xyz(149)+coef_xy(1, 16)*pol_z(1, 3, kg) - coef_xyz(149) = coef_xyz(149)+coef_xy(2, 16)*pol_z(2, 3, kg) - coef_xyz(150) = coef_xyz(150)+coef_xy(1, 20)*pol_z(1, 3, kg) - coef_xyz(150) = coef_xyz(150)+coef_xy(2, 20)*pol_z(2, 3, kg) - coef_xyz(151) = coef_xyz(151)+coef_xy(1, 21)*pol_z(1, 3, kg) - coef_xyz(151) = coef_xyz(151)+coef_xy(2, 21)*pol_z(2, 3, kg) - coef_xyz(152) = coef_xyz(152)+coef_xy(1, 22)*pol_z(1, 3, kg) - coef_xyz(152) = coef_xyz(152)+coef_xy(2, 22)*pol_z(2, 3, kg) - coef_xyz(153) = coef_xyz(153)+coef_xy(1, 23)*pol_z(1, 3, kg) - coef_xyz(153) = coef_xyz(153)+coef_xy(2, 23)*pol_z(2, 3, kg) - coef_xyz(154) = coef_xyz(154)+coef_xy(1, 24)*pol_z(1, 3, kg) - coef_xyz(154) = coef_xyz(154)+coef_xy(2, 24)*pol_z(2, 3, kg) - coef_xyz(155) = coef_xyz(155)+coef_xy(1, 28)*pol_z(1, 3, kg) - coef_xyz(155) = coef_xyz(155)+coef_xy(2, 28)*pol_z(2, 3, kg) - coef_xyz(156) = coef_xyz(156)+coef_xy(1, 29)*pol_z(1, 3, kg) - coef_xyz(156) = coef_xyz(156)+coef_xy(2, 29)*pol_z(2, 3, kg) - coef_xyz(157) = coef_xyz(157)+coef_xy(1, 30)*pol_z(1, 3, kg) - coef_xyz(157) = coef_xyz(157)+coef_xy(2, 30)*pol_z(2, 3, kg) - coef_xyz(158) = coef_xyz(158)+coef_xy(1, 31)*pol_z(1, 3, kg) - coef_xyz(158) = coef_xyz(158)+coef_xy(2, 31)*pol_z(2, 3, kg) - coef_xyz(159) = coef_xyz(159)+coef_xy(1, 35)*pol_z(1, 3, kg) - coef_xyz(159) = coef_xyz(159)+coef_xy(2, 35)*pol_z(2, 3, kg) - coef_xyz(160) = coef_xyz(160)+coef_xy(1, 36)*pol_z(1, 3, kg) - coef_xyz(160) = coef_xyz(160)+coef_xy(2, 36)*pol_z(2, 3, kg) - coef_xyz(161) = coef_xyz(161)+coef_xy(1, 37)*pol_z(1, 3, kg) - coef_xyz(161) = coef_xyz(161)+coef_xy(2, 37)*pol_z(2, 3, kg) - coef_xyz(162) = coef_xyz(162)+coef_xy(1, 41)*pol_z(1, 3, kg) - coef_xyz(162) = coef_xyz(162)+coef_xy(2, 41)*pol_z(2, 3, kg) - coef_xyz(163) = coef_xyz(163)+coef_xy(1, 42)*pol_z(1, 3, kg) - coef_xyz(163) = coef_xyz(163)+coef_xy(2, 42)*pol_z(2, 3, kg) - coef_xyz(164) = coef_xyz(164)+coef_xy(1, 46)*pol_z(1, 3, kg) - coef_xyz(164) = coef_xyz(164)+coef_xy(2, 46)*pol_z(2, 3, kg) - coef_xyz(165) = coef_xyz(165)+coef_xy(1, 1)*pol_z(1, 4, kg) - coef_xyz(165) = coef_xyz(165)+coef_xy(2, 1)*pol_z(2, 4, kg) - coef_xyz(166) = coef_xyz(166)+coef_xy(1, 2)*pol_z(1, 4, kg) - coef_xyz(166) = coef_xyz(166)+coef_xy(2, 2)*pol_z(2, 4, kg) - coef_xyz(167) = coef_xyz(167)+coef_xy(1, 3)*pol_z(1, 4, kg) - coef_xyz(167) = coef_xyz(167)+coef_xy(2, 3)*pol_z(2, 4, kg) - coef_xyz(168) = coef_xyz(168)+coef_xy(1, 4)*pol_z(1, 4, kg) - coef_xyz(168) = coef_xyz(168)+coef_xy(2, 4)*pol_z(2, 4, kg) - coef_xyz(169) = coef_xyz(169)+coef_xy(1, 5)*pol_z(1, 4, kg) - coef_xyz(169) = coef_xyz(169)+coef_xy(2, 5)*pol_z(2, 4, kg) - coef_xyz(170) = coef_xyz(170)+coef_xy(1, 6)*pol_z(1, 4, kg) - coef_xyz(170) = coef_xyz(170)+coef_xy(2, 6)*pol_z(2, 4, kg) - coef_xyz(171) = coef_xyz(171)+coef_xy(1, 11)*pol_z(1, 4, kg) - coef_xyz(171) = coef_xyz(171)+coef_xy(2, 11)*pol_z(2, 4, kg) - coef_xyz(172) = coef_xyz(172)+coef_xy(1, 12)*pol_z(1, 4, kg) - coef_xyz(172) = coef_xyz(172)+coef_xy(2, 12)*pol_z(2, 4, kg) - coef_xyz(173) = coef_xyz(173)+coef_xy(1, 13)*pol_z(1, 4, kg) - coef_xyz(173) = coef_xyz(173)+coef_xy(2, 13)*pol_z(2, 4, kg) - coef_xyz(174) = coef_xyz(174)+coef_xy(1, 14)*pol_z(1, 4, kg) - coef_xyz(174) = coef_xyz(174)+coef_xy(2, 14)*pol_z(2, 4, kg) - coef_xyz(175) = coef_xyz(175)+coef_xy(1, 15)*pol_z(1, 4, kg) - coef_xyz(175) = coef_xyz(175)+coef_xy(2, 15)*pol_z(2, 4, kg) - coef_xyz(176) = coef_xyz(176)+coef_xy(1, 20)*pol_z(1, 4, kg) - coef_xyz(176) = coef_xyz(176)+coef_xy(2, 20)*pol_z(2, 4, kg) - coef_xyz(177) = coef_xyz(177)+coef_xy(1, 21)*pol_z(1, 4, kg) - coef_xyz(177) = coef_xyz(177)+coef_xy(2, 21)*pol_z(2, 4, kg) - coef_xyz(178) = coef_xyz(178)+coef_xy(1, 22)*pol_z(1, 4, kg) - coef_xyz(178) = coef_xyz(178)+coef_xy(2, 22)*pol_z(2, 4, kg) - coef_xyz(179) = coef_xyz(179)+coef_xy(1, 23)*pol_z(1, 4, kg) - coef_xyz(179) = coef_xyz(179)+coef_xy(2, 23)*pol_z(2, 4, kg) - coef_xyz(180) = coef_xyz(180)+coef_xy(1, 28)*pol_z(1, 4, kg) - coef_xyz(180) = coef_xyz(180)+coef_xy(2, 28)*pol_z(2, 4, kg) - coef_xyz(181) = coef_xyz(181)+coef_xy(1, 29)*pol_z(1, 4, kg) - coef_xyz(181) = coef_xyz(181)+coef_xy(2, 29)*pol_z(2, 4, kg) - coef_xyz(182) = coef_xyz(182)+coef_xy(1, 30)*pol_z(1, 4, kg) - coef_xyz(182) = coef_xyz(182)+coef_xy(2, 30)*pol_z(2, 4, kg) - coef_xyz(183) = coef_xyz(183)+coef_xy(1, 35)*pol_z(1, 4, kg) - coef_xyz(183) = coef_xyz(183)+coef_xy(2, 35)*pol_z(2, 4, kg) - coef_xyz(184) = coef_xyz(184)+coef_xy(1, 36)*pol_z(1, 4, kg) - coef_xyz(184) = coef_xyz(184)+coef_xy(2, 36)*pol_z(2, 4, kg) - coef_xyz(185) = coef_xyz(185)+coef_xy(1, 41)*pol_z(1, 4, kg) - coef_xyz(185) = coef_xyz(185)+coef_xy(2, 41)*pol_z(2, 4, kg) - coef_xyz(186) = coef_xyz(186)+coef_xy(1, 1)*pol_z(1, 5, kg) - coef_xyz(186) = coef_xyz(186)+coef_xy(2, 1)*pol_z(2, 5, kg) - coef_xyz(187) = coef_xyz(187)+coef_xy(1, 2)*pol_z(1, 5, kg) - coef_xyz(187) = coef_xyz(187)+coef_xy(2, 2)*pol_z(2, 5, kg) - coef_xyz(188) = coef_xyz(188)+coef_xy(1, 3)*pol_z(1, 5, kg) - coef_xyz(188) = coef_xyz(188)+coef_xy(2, 3)*pol_z(2, 5, kg) - coef_xyz(189) = coef_xyz(189)+coef_xy(1, 4)*pol_z(1, 5, kg) - coef_xyz(189) = coef_xyz(189)+coef_xy(2, 4)*pol_z(2, 5, kg) - coef_xyz(190) = coef_xyz(190)+coef_xy(1, 5)*pol_z(1, 5, kg) - coef_xyz(190) = coef_xyz(190)+coef_xy(2, 5)*pol_z(2, 5, kg) - coef_xyz(191) = coef_xyz(191)+coef_xy(1, 11)*pol_z(1, 5, kg) - coef_xyz(191) = coef_xyz(191)+coef_xy(2, 11)*pol_z(2, 5, kg) - coef_xyz(192) = coef_xyz(192)+coef_xy(1, 12)*pol_z(1, 5, kg) - coef_xyz(192) = coef_xyz(192)+coef_xy(2, 12)*pol_z(2, 5, kg) - coef_xyz(193) = coef_xyz(193)+coef_xy(1, 13)*pol_z(1, 5, kg) - coef_xyz(193) = coef_xyz(193)+coef_xy(2, 13)*pol_z(2, 5, kg) - coef_xyz(194) = coef_xyz(194)+coef_xy(1, 14)*pol_z(1, 5, kg) - coef_xyz(194) = coef_xyz(194)+coef_xy(2, 14)*pol_z(2, 5, kg) - coef_xyz(195) = coef_xyz(195)+coef_xy(1, 20)*pol_z(1, 5, kg) - coef_xyz(195) = coef_xyz(195)+coef_xy(2, 20)*pol_z(2, 5, kg) - coef_xyz(196) = coef_xyz(196)+coef_xy(1, 21)*pol_z(1, 5, kg) - coef_xyz(196) = coef_xyz(196)+coef_xy(2, 21)*pol_z(2, 5, kg) - coef_xyz(197) = coef_xyz(197)+coef_xy(1, 22)*pol_z(1, 5, kg) - coef_xyz(197) = coef_xyz(197)+coef_xy(2, 22)*pol_z(2, 5, kg) - coef_xyz(198) = coef_xyz(198)+coef_xy(1, 28)*pol_z(1, 5, kg) - coef_xyz(198) = coef_xyz(198)+coef_xy(2, 28)*pol_z(2, 5, kg) - coef_xyz(199) = coef_xyz(199)+coef_xy(1, 29)*pol_z(1, 5, kg) - coef_xyz(199) = coef_xyz(199)+coef_xy(2, 29)*pol_z(2, 5, kg) - coef_xyz(200) = coef_xyz(200)+coef_xy(1, 35)*pol_z(1, 5, kg) - coef_xyz(200) = coef_xyz(200)+coef_xy(2, 35)*pol_z(2, 5, kg) - coef_xyz(201) = coef_xyz(201)+coef_xy(1, 1)*pol_z(1, 6, kg) - coef_xyz(201) = coef_xyz(201)+coef_xy(2, 1)*pol_z(2, 6, kg) - coef_xyz(202) = coef_xyz(202)+coef_xy(1, 2)*pol_z(1, 6, kg) - coef_xyz(202) = coef_xyz(202)+coef_xy(2, 2)*pol_z(2, 6, kg) - coef_xyz(203) = coef_xyz(203)+coef_xy(1, 3)*pol_z(1, 6, kg) - coef_xyz(203) = coef_xyz(203)+coef_xy(2, 3)*pol_z(2, 6, kg) - coef_xyz(204) = coef_xyz(204)+coef_xy(1, 4)*pol_z(1, 6, kg) - coef_xyz(204) = coef_xyz(204)+coef_xy(2, 4)*pol_z(2, 6, kg) - coef_xyz(205) = coef_xyz(205)+coef_xy(1, 11)*pol_z(1, 6, kg) - coef_xyz(205) = coef_xyz(205)+coef_xy(2, 11)*pol_z(2, 6, kg) - coef_xyz(206) = coef_xyz(206)+coef_xy(1, 12)*pol_z(1, 6, kg) - coef_xyz(206) = coef_xyz(206)+coef_xy(2, 12)*pol_z(2, 6, kg) - coef_xyz(207) = coef_xyz(207)+coef_xy(1, 13)*pol_z(1, 6, kg) - coef_xyz(207) = coef_xyz(207)+coef_xy(2, 13)*pol_z(2, 6, kg) - coef_xyz(208) = coef_xyz(208)+coef_xy(1, 20)*pol_z(1, 6, kg) - coef_xyz(208) = coef_xyz(208)+coef_xy(2, 20)*pol_z(2, 6, kg) - coef_xyz(209) = coef_xyz(209)+coef_xy(1, 21)*pol_z(1, 6, kg) - coef_xyz(209) = coef_xyz(209)+coef_xy(2, 21)*pol_z(2, 6, kg) - coef_xyz(210) = coef_xyz(210)+coef_xy(1, 28)*pol_z(1, 6, kg) - coef_xyz(210) = coef_xyz(210)+coef_xy(2, 28)*pol_z(2, 6, kg) - coef_xyz(211) = coef_xyz(211)+coef_xy(1, 1)*pol_z(1, 7, kg) - coef_xyz(211) = coef_xyz(211)+coef_xy(2, 1)*pol_z(2, 7, kg) - coef_xyz(212) = coef_xyz(212)+coef_xy(1, 2)*pol_z(1, 7, kg) - coef_xyz(212) = coef_xyz(212)+coef_xy(2, 2)*pol_z(2, 7, kg) - coef_xyz(213) = coef_xyz(213)+coef_xy(1, 3)*pol_z(1, 7, kg) - coef_xyz(213) = coef_xyz(213)+coef_xy(2, 3)*pol_z(2, 7, kg) - coef_xyz(214) = coef_xyz(214)+coef_xy(1, 11)*pol_z(1, 7, kg) - coef_xyz(214) = coef_xyz(214)+coef_xy(2, 11)*pol_z(2, 7, kg) - coef_xyz(215) = coef_xyz(215)+coef_xy(1, 12)*pol_z(1, 7, kg) - coef_xyz(215) = coef_xyz(215)+coef_xy(2, 12)*pol_z(2, 7, kg) - coef_xyz(216) = coef_xyz(216)+coef_xy(1, 20)*pol_z(1, 7, kg) - coef_xyz(216) = coef_xyz(216)+coef_xy(2, 20)*pol_z(2, 7, kg) - coef_xyz(217) = coef_xyz(217)+coef_xy(1, 1)*pol_z(1, 8, kg) - coef_xyz(217) = coef_xyz(217)+coef_xy(2, 1)*pol_z(2, 8, kg) - coef_xyz(218) = coef_xyz(218)+coef_xy(1, 2)*pol_z(1, 8, kg) - coef_xyz(218) = coef_xyz(218)+coef_xy(2, 2)*pol_z(2, 8, kg) - coef_xyz(219) = coef_xyz(219)+coef_xy(1, 11)*pol_z(1, 8, kg) - coef_xyz(219) = coef_xyz(219)+coef_xy(2, 11)*pol_z(2, 8, kg) - coef_xyz(220) = coef_xyz(220)+coef_xy(1, 1)*pol_z(1, 9, kg) - coef_xyz(220) = coef_xyz(220)+coef_xy(2, 1)*pol_z(2, 9, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(1, 1)*pol_z(1, 0, kg) + coef_xyz(1) = coef_xyz(1) + coef_xy(2, 1)*pol_z(2, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(1, 2)*pol_z(1, 0, kg) + coef_xyz(2) = coef_xyz(2) + coef_xy(2, 2)*pol_z(2, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(1, 3)*pol_z(1, 0, kg) + coef_xyz(3) = coef_xyz(3) + coef_xy(2, 3)*pol_z(2, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(1, 4)*pol_z(1, 0, kg) + coef_xyz(4) = coef_xyz(4) + coef_xy(2, 4)*pol_z(2, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(1, 5)*pol_z(1, 0, kg) + coef_xyz(5) = coef_xyz(5) + coef_xy(2, 5)*pol_z(2, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(1, 6)*pol_z(1, 0, kg) + coef_xyz(6) = coef_xyz(6) + coef_xy(2, 6)*pol_z(2, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(1, 7)*pol_z(1, 0, kg) + coef_xyz(7) = coef_xyz(7) + coef_xy(2, 7)*pol_z(2, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(1, 8)*pol_z(1, 0, kg) + coef_xyz(8) = coef_xyz(8) + coef_xy(2, 8)*pol_z(2, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(1, 9)*pol_z(1, 0, kg) + coef_xyz(9) = coef_xyz(9) + coef_xy(2, 9)*pol_z(2, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(1, 10)*pol_z(1, 0, kg) + coef_xyz(10) = coef_xyz(10) + coef_xy(2, 10)*pol_z(2, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(1, 11)*pol_z(1, 0, kg) + coef_xyz(11) = coef_xyz(11) + coef_xy(2, 11)*pol_z(2, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(1, 12)*pol_z(1, 0, kg) + coef_xyz(12) = coef_xyz(12) + coef_xy(2, 12)*pol_z(2, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(1, 13)*pol_z(1, 0, kg) + coef_xyz(13) = coef_xyz(13) + coef_xy(2, 13)*pol_z(2, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(1, 14)*pol_z(1, 0, kg) + coef_xyz(14) = coef_xyz(14) + coef_xy(2, 14)*pol_z(2, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(1, 15)*pol_z(1, 0, kg) + coef_xyz(15) = coef_xyz(15) + coef_xy(2, 15)*pol_z(2, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(1, 16)*pol_z(1, 0, kg) + coef_xyz(16) = coef_xyz(16) + coef_xy(2, 16)*pol_z(2, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(1, 17)*pol_z(1, 0, kg) + coef_xyz(17) = coef_xyz(17) + coef_xy(2, 17)*pol_z(2, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(1, 18)*pol_z(1, 0, kg) + coef_xyz(18) = coef_xyz(18) + coef_xy(2, 18)*pol_z(2, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(1, 19)*pol_z(1, 0, kg) + coef_xyz(19) = coef_xyz(19) + coef_xy(2, 19)*pol_z(2, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(1, 20)*pol_z(1, 0, kg) + coef_xyz(20) = coef_xyz(20) + coef_xy(2, 20)*pol_z(2, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(1, 21)*pol_z(1, 0, kg) + coef_xyz(21) = coef_xyz(21) + coef_xy(2, 21)*pol_z(2, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(1, 22)*pol_z(1, 0, kg) + coef_xyz(22) = coef_xyz(22) + coef_xy(2, 22)*pol_z(2, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(1, 23)*pol_z(1, 0, kg) + coef_xyz(23) = coef_xyz(23) + coef_xy(2, 23)*pol_z(2, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(1, 24)*pol_z(1, 0, kg) + coef_xyz(24) = coef_xyz(24) + coef_xy(2, 24)*pol_z(2, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(1, 25)*pol_z(1, 0, kg) + coef_xyz(25) = coef_xyz(25) + coef_xy(2, 25)*pol_z(2, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(1, 26)*pol_z(1, 0, kg) + coef_xyz(26) = coef_xyz(26) + coef_xy(2, 26)*pol_z(2, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(1, 27)*pol_z(1, 0, kg) + coef_xyz(27) = coef_xyz(27) + coef_xy(2, 27)*pol_z(2, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(1, 28)*pol_z(1, 0, kg) + coef_xyz(28) = coef_xyz(28) + coef_xy(2, 28)*pol_z(2, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(1, 29)*pol_z(1, 0, kg) + coef_xyz(29) = coef_xyz(29) + coef_xy(2, 29)*pol_z(2, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(1, 30)*pol_z(1, 0, kg) + coef_xyz(30) = coef_xyz(30) + coef_xy(2, 30)*pol_z(2, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(1, 31)*pol_z(1, 0, kg) + coef_xyz(31) = coef_xyz(31) + coef_xy(2, 31)*pol_z(2, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(1, 32)*pol_z(1, 0, kg) + coef_xyz(32) = coef_xyz(32) + coef_xy(2, 32)*pol_z(2, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(1, 33)*pol_z(1, 0, kg) + coef_xyz(33) = coef_xyz(33) + coef_xy(2, 33)*pol_z(2, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(1, 34)*pol_z(1, 0, kg) + coef_xyz(34) = coef_xyz(34) + coef_xy(2, 34)*pol_z(2, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(1, 35)*pol_z(1, 0, kg) + coef_xyz(35) = coef_xyz(35) + coef_xy(2, 35)*pol_z(2, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(1, 36)*pol_z(1, 0, kg) + coef_xyz(36) = coef_xyz(36) + coef_xy(2, 36)*pol_z(2, 0, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(1, 37)*pol_z(1, 0, kg) + coef_xyz(37) = coef_xyz(37) + coef_xy(2, 37)*pol_z(2, 0, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(1, 38)*pol_z(1, 0, kg) + coef_xyz(38) = coef_xyz(38) + coef_xy(2, 38)*pol_z(2, 0, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(1, 39)*pol_z(1, 0, kg) + coef_xyz(39) = coef_xyz(39) + coef_xy(2, 39)*pol_z(2, 0, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(1, 40)*pol_z(1, 0, kg) + coef_xyz(40) = coef_xyz(40) + coef_xy(2, 40)*pol_z(2, 0, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(1, 41)*pol_z(1, 0, kg) + coef_xyz(41) = coef_xyz(41) + coef_xy(2, 41)*pol_z(2, 0, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(1, 42)*pol_z(1, 0, kg) + coef_xyz(42) = coef_xyz(42) + coef_xy(2, 42)*pol_z(2, 0, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(1, 43)*pol_z(1, 0, kg) + coef_xyz(43) = coef_xyz(43) + coef_xy(2, 43)*pol_z(2, 0, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(1, 44)*pol_z(1, 0, kg) + coef_xyz(44) = coef_xyz(44) + coef_xy(2, 44)*pol_z(2, 0, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(1, 45)*pol_z(1, 0, kg) + coef_xyz(45) = coef_xyz(45) + coef_xy(2, 45)*pol_z(2, 0, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(1, 46)*pol_z(1, 0, kg) + coef_xyz(46) = coef_xyz(46) + coef_xy(2, 46)*pol_z(2, 0, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(1, 47)*pol_z(1, 0, kg) + coef_xyz(47) = coef_xyz(47) + coef_xy(2, 47)*pol_z(2, 0, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(1, 48)*pol_z(1, 0, kg) + coef_xyz(48) = coef_xyz(48) + coef_xy(2, 48)*pol_z(2, 0, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(1, 49)*pol_z(1, 0, kg) + coef_xyz(49) = coef_xyz(49) + coef_xy(2, 49)*pol_z(2, 0, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(1, 50)*pol_z(1, 0, kg) + coef_xyz(50) = coef_xyz(50) + coef_xy(2, 50)*pol_z(2, 0, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(1, 51)*pol_z(1, 0, kg) + coef_xyz(51) = coef_xyz(51) + coef_xy(2, 51)*pol_z(2, 0, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(1, 52)*pol_z(1, 0, kg) + coef_xyz(52) = coef_xyz(52) + coef_xy(2, 52)*pol_z(2, 0, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(1, 53)*pol_z(1, 0, kg) + coef_xyz(53) = coef_xyz(53) + coef_xy(2, 53)*pol_z(2, 0, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(1, 54)*pol_z(1, 0, kg) + coef_xyz(54) = coef_xyz(54) + coef_xy(2, 54)*pol_z(2, 0, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(1, 55)*pol_z(1, 0, kg) + coef_xyz(55) = coef_xyz(55) + coef_xy(2, 55)*pol_z(2, 0, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(1, 1)*pol_z(1, 1, kg) + coef_xyz(56) = coef_xyz(56) + coef_xy(2, 1)*pol_z(2, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(1, 2)*pol_z(1, 1, kg) + coef_xyz(57) = coef_xyz(57) + coef_xy(2, 2)*pol_z(2, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(1, 3)*pol_z(1, 1, kg) + coef_xyz(58) = coef_xyz(58) + coef_xy(2, 3)*pol_z(2, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(1, 4)*pol_z(1, 1, kg) + coef_xyz(59) = coef_xyz(59) + coef_xy(2, 4)*pol_z(2, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(1, 5)*pol_z(1, 1, kg) + coef_xyz(60) = coef_xyz(60) + coef_xy(2, 5)*pol_z(2, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(1, 6)*pol_z(1, 1, kg) + coef_xyz(61) = coef_xyz(61) + coef_xy(2, 6)*pol_z(2, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(1, 7)*pol_z(1, 1, kg) + coef_xyz(62) = coef_xyz(62) + coef_xy(2, 7)*pol_z(2, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(1, 8)*pol_z(1, 1, kg) + coef_xyz(63) = coef_xyz(63) + coef_xy(2, 8)*pol_z(2, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(1, 9)*pol_z(1, 1, kg) + coef_xyz(64) = coef_xyz(64) + coef_xy(2, 9)*pol_z(2, 1, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(1, 11)*pol_z(1, 1, kg) + coef_xyz(65) = coef_xyz(65) + coef_xy(2, 11)*pol_z(2, 1, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(1, 12)*pol_z(1, 1, kg) + coef_xyz(66) = coef_xyz(66) + coef_xy(2, 12)*pol_z(2, 1, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(1, 13)*pol_z(1, 1, kg) + coef_xyz(67) = coef_xyz(67) + coef_xy(2, 13)*pol_z(2, 1, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(1, 14)*pol_z(1, 1, kg) + coef_xyz(68) = coef_xyz(68) + coef_xy(2, 14)*pol_z(2, 1, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(1, 15)*pol_z(1, 1, kg) + coef_xyz(69) = coef_xyz(69) + coef_xy(2, 15)*pol_z(2, 1, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(1, 16)*pol_z(1, 1, kg) + coef_xyz(70) = coef_xyz(70) + coef_xy(2, 16)*pol_z(2, 1, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(1, 17)*pol_z(1, 1, kg) + coef_xyz(71) = coef_xyz(71) + coef_xy(2, 17)*pol_z(2, 1, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(1, 18)*pol_z(1, 1, kg) + coef_xyz(72) = coef_xyz(72) + coef_xy(2, 18)*pol_z(2, 1, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(1, 20)*pol_z(1, 1, kg) + coef_xyz(73) = coef_xyz(73) + coef_xy(2, 20)*pol_z(2, 1, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(1, 21)*pol_z(1, 1, kg) + coef_xyz(74) = coef_xyz(74) + coef_xy(2, 21)*pol_z(2, 1, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(1, 22)*pol_z(1, 1, kg) + coef_xyz(75) = coef_xyz(75) + coef_xy(2, 22)*pol_z(2, 1, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(1, 23)*pol_z(1, 1, kg) + coef_xyz(76) = coef_xyz(76) + coef_xy(2, 23)*pol_z(2, 1, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(1, 24)*pol_z(1, 1, kg) + coef_xyz(77) = coef_xyz(77) + coef_xy(2, 24)*pol_z(2, 1, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(1, 25)*pol_z(1, 1, kg) + coef_xyz(78) = coef_xyz(78) + coef_xy(2, 25)*pol_z(2, 1, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(1, 26)*pol_z(1, 1, kg) + coef_xyz(79) = coef_xyz(79) + coef_xy(2, 26)*pol_z(2, 1, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(1, 28)*pol_z(1, 1, kg) + coef_xyz(80) = coef_xyz(80) + coef_xy(2, 28)*pol_z(2, 1, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(1, 29)*pol_z(1, 1, kg) + coef_xyz(81) = coef_xyz(81) + coef_xy(2, 29)*pol_z(2, 1, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(1, 30)*pol_z(1, 1, kg) + coef_xyz(82) = coef_xyz(82) + coef_xy(2, 30)*pol_z(2, 1, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(1, 31)*pol_z(1, 1, kg) + coef_xyz(83) = coef_xyz(83) + coef_xy(2, 31)*pol_z(2, 1, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(1, 32)*pol_z(1, 1, kg) + coef_xyz(84) = coef_xyz(84) + coef_xy(2, 32)*pol_z(2, 1, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(1, 33)*pol_z(1, 1, kg) + coef_xyz(85) = coef_xyz(85) + coef_xy(2, 33)*pol_z(2, 1, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(1, 35)*pol_z(1, 1, kg) + coef_xyz(86) = coef_xyz(86) + coef_xy(2, 35)*pol_z(2, 1, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(1, 36)*pol_z(1, 1, kg) + coef_xyz(87) = coef_xyz(87) + coef_xy(2, 36)*pol_z(2, 1, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(1, 37)*pol_z(1, 1, kg) + coef_xyz(88) = coef_xyz(88) + coef_xy(2, 37)*pol_z(2, 1, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(1, 38)*pol_z(1, 1, kg) + coef_xyz(89) = coef_xyz(89) + coef_xy(2, 38)*pol_z(2, 1, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(1, 39)*pol_z(1, 1, kg) + coef_xyz(90) = coef_xyz(90) + coef_xy(2, 39)*pol_z(2, 1, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(1, 41)*pol_z(1, 1, kg) + coef_xyz(91) = coef_xyz(91) + coef_xy(2, 41)*pol_z(2, 1, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(1, 42)*pol_z(1, 1, kg) + coef_xyz(92) = coef_xyz(92) + coef_xy(2, 42)*pol_z(2, 1, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(1, 43)*pol_z(1, 1, kg) + coef_xyz(93) = coef_xyz(93) + coef_xy(2, 43)*pol_z(2, 1, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(1, 44)*pol_z(1, 1, kg) + coef_xyz(94) = coef_xyz(94) + coef_xy(2, 44)*pol_z(2, 1, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(1, 46)*pol_z(1, 1, kg) + coef_xyz(95) = coef_xyz(95) + coef_xy(2, 46)*pol_z(2, 1, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(1, 47)*pol_z(1, 1, kg) + coef_xyz(96) = coef_xyz(96) + coef_xy(2, 47)*pol_z(2, 1, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(1, 48)*pol_z(1, 1, kg) + coef_xyz(97) = coef_xyz(97) + coef_xy(2, 48)*pol_z(2, 1, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(1, 50)*pol_z(1, 1, kg) + coef_xyz(98) = coef_xyz(98) + coef_xy(2, 50)*pol_z(2, 1, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(1, 51)*pol_z(1, 1, kg) + coef_xyz(99) = coef_xyz(99) + coef_xy(2, 51)*pol_z(2, 1, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(1, 53)*pol_z(1, 1, kg) + coef_xyz(100) = coef_xyz(100) + coef_xy(2, 53)*pol_z(2, 1, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(1, 1)*pol_z(1, 2, kg) + coef_xyz(101) = coef_xyz(101) + coef_xy(2, 1)*pol_z(2, 2, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(1, 2)*pol_z(1, 2, kg) + coef_xyz(102) = coef_xyz(102) + coef_xy(2, 2)*pol_z(2, 2, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(1, 3)*pol_z(1, 2, kg) + coef_xyz(103) = coef_xyz(103) + coef_xy(2, 3)*pol_z(2, 2, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(1, 4)*pol_z(1, 2, kg) + coef_xyz(104) = coef_xyz(104) + coef_xy(2, 4)*pol_z(2, 2, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(1, 5)*pol_z(1, 2, kg) + coef_xyz(105) = coef_xyz(105) + coef_xy(2, 5)*pol_z(2, 2, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(1, 6)*pol_z(1, 2, kg) + coef_xyz(106) = coef_xyz(106) + coef_xy(2, 6)*pol_z(2, 2, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(1, 7)*pol_z(1, 2, kg) + coef_xyz(107) = coef_xyz(107) + coef_xy(2, 7)*pol_z(2, 2, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(1, 8)*pol_z(1, 2, kg) + coef_xyz(108) = coef_xyz(108) + coef_xy(2, 8)*pol_z(2, 2, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(1, 11)*pol_z(1, 2, kg) + coef_xyz(109) = coef_xyz(109) + coef_xy(2, 11)*pol_z(2, 2, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(1, 12)*pol_z(1, 2, kg) + coef_xyz(110) = coef_xyz(110) + coef_xy(2, 12)*pol_z(2, 2, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(1, 13)*pol_z(1, 2, kg) + coef_xyz(111) = coef_xyz(111) + coef_xy(2, 13)*pol_z(2, 2, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(1, 14)*pol_z(1, 2, kg) + coef_xyz(112) = coef_xyz(112) + coef_xy(2, 14)*pol_z(2, 2, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(1, 15)*pol_z(1, 2, kg) + coef_xyz(113) = coef_xyz(113) + coef_xy(2, 15)*pol_z(2, 2, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(1, 16)*pol_z(1, 2, kg) + coef_xyz(114) = coef_xyz(114) + coef_xy(2, 16)*pol_z(2, 2, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(1, 17)*pol_z(1, 2, kg) + coef_xyz(115) = coef_xyz(115) + coef_xy(2, 17)*pol_z(2, 2, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(1, 20)*pol_z(1, 2, kg) + coef_xyz(116) = coef_xyz(116) + coef_xy(2, 20)*pol_z(2, 2, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(1, 21)*pol_z(1, 2, kg) + coef_xyz(117) = coef_xyz(117) + coef_xy(2, 21)*pol_z(2, 2, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(1, 22)*pol_z(1, 2, kg) + coef_xyz(118) = coef_xyz(118) + coef_xy(2, 22)*pol_z(2, 2, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(1, 23)*pol_z(1, 2, kg) + coef_xyz(119) = coef_xyz(119) + coef_xy(2, 23)*pol_z(2, 2, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(1, 24)*pol_z(1, 2, kg) + coef_xyz(120) = coef_xyz(120) + coef_xy(2, 24)*pol_z(2, 2, kg) + coef_xyz(121) = coef_xyz(121) + coef_xy(1, 25)*pol_z(1, 2, kg) + coef_xyz(121) = coef_xyz(121) + coef_xy(2, 25)*pol_z(2, 2, kg) + coef_xyz(122) = coef_xyz(122) + coef_xy(1, 28)*pol_z(1, 2, kg) + coef_xyz(122) = coef_xyz(122) + coef_xy(2, 28)*pol_z(2, 2, kg) + coef_xyz(123) = coef_xyz(123) + coef_xy(1, 29)*pol_z(1, 2, kg) + coef_xyz(123) = coef_xyz(123) + coef_xy(2, 29)*pol_z(2, 2, kg) + coef_xyz(124) = coef_xyz(124) + coef_xy(1, 30)*pol_z(1, 2, kg) + coef_xyz(124) = coef_xyz(124) + coef_xy(2, 30)*pol_z(2, 2, kg) + coef_xyz(125) = coef_xyz(125) + coef_xy(1, 31)*pol_z(1, 2, kg) + coef_xyz(125) = coef_xyz(125) + coef_xy(2, 31)*pol_z(2, 2, kg) + coef_xyz(126) = coef_xyz(126) + coef_xy(1, 32)*pol_z(1, 2, kg) + coef_xyz(126) = coef_xyz(126) + coef_xy(2, 32)*pol_z(2, 2, kg) + coef_xyz(127) = coef_xyz(127) + coef_xy(1, 35)*pol_z(1, 2, kg) + coef_xyz(127) = coef_xyz(127) + coef_xy(2, 35)*pol_z(2, 2, kg) + coef_xyz(128) = coef_xyz(128) + coef_xy(1, 36)*pol_z(1, 2, kg) + coef_xyz(128) = coef_xyz(128) + coef_xy(2, 36)*pol_z(2, 2, kg) + coef_xyz(129) = coef_xyz(129) + coef_xy(1, 37)*pol_z(1, 2, kg) + coef_xyz(129) = coef_xyz(129) + coef_xy(2, 37)*pol_z(2, 2, kg) + coef_xyz(130) = coef_xyz(130) + coef_xy(1, 38)*pol_z(1, 2, kg) + coef_xyz(130) = coef_xyz(130) + coef_xy(2, 38)*pol_z(2, 2, kg) + coef_xyz(131) = coef_xyz(131) + coef_xy(1, 41)*pol_z(1, 2, kg) + coef_xyz(131) = coef_xyz(131) + coef_xy(2, 41)*pol_z(2, 2, kg) + coef_xyz(132) = coef_xyz(132) + coef_xy(1, 42)*pol_z(1, 2, kg) + coef_xyz(132) = coef_xyz(132) + coef_xy(2, 42)*pol_z(2, 2, kg) + coef_xyz(133) = coef_xyz(133) + coef_xy(1, 43)*pol_z(1, 2, kg) + coef_xyz(133) = coef_xyz(133) + coef_xy(2, 43)*pol_z(2, 2, kg) + coef_xyz(134) = coef_xyz(134) + coef_xy(1, 46)*pol_z(1, 2, kg) + coef_xyz(134) = coef_xyz(134) + coef_xy(2, 46)*pol_z(2, 2, kg) + coef_xyz(135) = coef_xyz(135) + coef_xy(1, 47)*pol_z(1, 2, kg) + coef_xyz(135) = coef_xyz(135) + coef_xy(2, 47)*pol_z(2, 2, kg) + coef_xyz(136) = coef_xyz(136) + coef_xy(1, 50)*pol_z(1, 2, kg) + coef_xyz(136) = coef_xyz(136) + coef_xy(2, 50)*pol_z(2, 2, kg) + coef_xyz(137) = coef_xyz(137) + coef_xy(1, 1)*pol_z(1, 3, kg) + coef_xyz(137) = coef_xyz(137) + coef_xy(2, 1)*pol_z(2, 3, kg) + coef_xyz(138) = coef_xyz(138) + coef_xy(1, 2)*pol_z(1, 3, kg) + coef_xyz(138) = coef_xyz(138) + coef_xy(2, 2)*pol_z(2, 3, kg) + coef_xyz(139) = coef_xyz(139) + coef_xy(1, 3)*pol_z(1, 3, kg) + coef_xyz(139) = coef_xyz(139) + coef_xy(2, 3)*pol_z(2, 3, kg) + coef_xyz(140) = coef_xyz(140) + coef_xy(1, 4)*pol_z(1, 3, kg) + coef_xyz(140) = coef_xyz(140) + coef_xy(2, 4)*pol_z(2, 3, kg) + coef_xyz(141) = coef_xyz(141) + coef_xy(1, 5)*pol_z(1, 3, kg) + coef_xyz(141) = coef_xyz(141) + coef_xy(2, 5)*pol_z(2, 3, kg) + coef_xyz(142) = coef_xyz(142) + coef_xy(1, 6)*pol_z(1, 3, kg) + coef_xyz(142) = coef_xyz(142) + coef_xy(2, 6)*pol_z(2, 3, kg) + coef_xyz(143) = coef_xyz(143) + coef_xy(1, 7)*pol_z(1, 3, kg) + coef_xyz(143) = coef_xyz(143) + coef_xy(2, 7)*pol_z(2, 3, kg) + coef_xyz(144) = coef_xyz(144) + coef_xy(1, 11)*pol_z(1, 3, kg) + coef_xyz(144) = coef_xyz(144) + coef_xy(2, 11)*pol_z(2, 3, kg) + coef_xyz(145) = coef_xyz(145) + coef_xy(1, 12)*pol_z(1, 3, kg) + coef_xyz(145) = coef_xyz(145) + coef_xy(2, 12)*pol_z(2, 3, kg) + coef_xyz(146) = coef_xyz(146) + coef_xy(1, 13)*pol_z(1, 3, kg) + coef_xyz(146) = coef_xyz(146) + coef_xy(2, 13)*pol_z(2, 3, kg) + coef_xyz(147) = coef_xyz(147) + coef_xy(1, 14)*pol_z(1, 3, kg) + coef_xyz(147) = coef_xyz(147) + coef_xy(2, 14)*pol_z(2, 3, kg) + coef_xyz(148) = coef_xyz(148) + coef_xy(1, 15)*pol_z(1, 3, kg) + coef_xyz(148) = coef_xyz(148) + coef_xy(2, 15)*pol_z(2, 3, kg) + coef_xyz(149) = coef_xyz(149) + coef_xy(1, 16)*pol_z(1, 3, kg) + coef_xyz(149) = coef_xyz(149) + coef_xy(2, 16)*pol_z(2, 3, kg) + coef_xyz(150) = coef_xyz(150) + coef_xy(1, 20)*pol_z(1, 3, kg) + coef_xyz(150) = coef_xyz(150) + coef_xy(2, 20)*pol_z(2, 3, kg) + coef_xyz(151) = coef_xyz(151) + coef_xy(1, 21)*pol_z(1, 3, kg) + coef_xyz(151) = coef_xyz(151) + coef_xy(2, 21)*pol_z(2, 3, kg) + coef_xyz(152) = coef_xyz(152) + coef_xy(1, 22)*pol_z(1, 3, kg) + coef_xyz(152) = coef_xyz(152) + coef_xy(2, 22)*pol_z(2, 3, kg) + coef_xyz(153) = coef_xyz(153) + coef_xy(1, 23)*pol_z(1, 3, kg) + coef_xyz(153) = coef_xyz(153) + coef_xy(2, 23)*pol_z(2, 3, kg) + coef_xyz(154) = coef_xyz(154) + coef_xy(1, 24)*pol_z(1, 3, kg) + coef_xyz(154) = coef_xyz(154) + coef_xy(2, 24)*pol_z(2, 3, kg) + coef_xyz(155) = coef_xyz(155) + coef_xy(1, 28)*pol_z(1, 3, kg) + coef_xyz(155) = coef_xyz(155) + coef_xy(2, 28)*pol_z(2, 3, kg) + coef_xyz(156) = coef_xyz(156) + coef_xy(1, 29)*pol_z(1, 3, kg) + coef_xyz(156) = coef_xyz(156) + coef_xy(2, 29)*pol_z(2, 3, kg) + coef_xyz(157) = coef_xyz(157) + coef_xy(1, 30)*pol_z(1, 3, kg) + coef_xyz(157) = coef_xyz(157) + coef_xy(2, 30)*pol_z(2, 3, kg) + coef_xyz(158) = coef_xyz(158) + coef_xy(1, 31)*pol_z(1, 3, kg) + coef_xyz(158) = coef_xyz(158) + coef_xy(2, 31)*pol_z(2, 3, kg) + coef_xyz(159) = coef_xyz(159) + coef_xy(1, 35)*pol_z(1, 3, kg) + coef_xyz(159) = coef_xyz(159) + coef_xy(2, 35)*pol_z(2, 3, kg) + coef_xyz(160) = coef_xyz(160) + coef_xy(1, 36)*pol_z(1, 3, kg) + coef_xyz(160) = coef_xyz(160) + coef_xy(2, 36)*pol_z(2, 3, kg) + coef_xyz(161) = coef_xyz(161) + coef_xy(1, 37)*pol_z(1, 3, kg) + coef_xyz(161) = coef_xyz(161) + coef_xy(2, 37)*pol_z(2, 3, kg) + coef_xyz(162) = coef_xyz(162) + coef_xy(1, 41)*pol_z(1, 3, kg) + coef_xyz(162) = coef_xyz(162) + coef_xy(2, 41)*pol_z(2, 3, kg) + coef_xyz(163) = coef_xyz(163) + coef_xy(1, 42)*pol_z(1, 3, kg) + coef_xyz(163) = coef_xyz(163) + coef_xy(2, 42)*pol_z(2, 3, kg) + coef_xyz(164) = coef_xyz(164) + coef_xy(1, 46)*pol_z(1, 3, kg) + coef_xyz(164) = coef_xyz(164) + coef_xy(2, 46)*pol_z(2, 3, kg) + coef_xyz(165) = coef_xyz(165) + coef_xy(1, 1)*pol_z(1, 4, kg) + coef_xyz(165) = coef_xyz(165) + coef_xy(2, 1)*pol_z(2, 4, kg) + coef_xyz(166) = coef_xyz(166) + coef_xy(1, 2)*pol_z(1, 4, kg) + coef_xyz(166) = coef_xyz(166) + coef_xy(2, 2)*pol_z(2, 4, kg) + coef_xyz(167) = coef_xyz(167) + coef_xy(1, 3)*pol_z(1, 4, kg) + coef_xyz(167) = coef_xyz(167) + coef_xy(2, 3)*pol_z(2, 4, kg) + coef_xyz(168) = coef_xyz(168) + coef_xy(1, 4)*pol_z(1, 4, kg) + coef_xyz(168) = coef_xyz(168) + coef_xy(2, 4)*pol_z(2, 4, kg) + coef_xyz(169) = coef_xyz(169) + coef_xy(1, 5)*pol_z(1, 4, kg) + coef_xyz(169) = coef_xyz(169) + coef_xy(2, 5)*pol_z(2, 4, kg) + coef_xyz(170) = coef_xyz(170) + coef_xy(1, 6)*pol_z(1, 4, kg) + coef_xyz(170) = coef_xyz(170) + coef_xy(2, 6)*pol_z(2, 4, kg) + coef_xyz(171) = coef_xyz(171) + coef_xy(1, 11)*pol_z(1, 4, kg) + coef_xyz(171) = coef_xyz(171) + coef_xy(2, 11)*pol_z(2, 4, kg) + coef_xyz(172) = coef_xyz(172) + coef_xy(1, 12)*pol_z(1, 4, kg) + coef_xyz(172) = coef_xyz(172) + coef_xy(2, 12)*pol_z(2, 4, kg) + coef_xyz(173) = coef_xyz(173) + coef_xy(1, 13)*pol_z(1, 4, kg) + coef_xyz(173) = coef_xyz(173) + coef_xy(2, 13)*pol_z(2, 4, kg) + coef_xyz(174) = coef_xyz(174) + coef_xy(1, 14)*pol_z(1, 4, kg) + coef_xyz(174) = coef_xyz(174) + coef_xy(2, 14)*pol_z(2, 4, kg) + coef_xyz(175) = coef_xyz(175) + coef_xy(1, 15)*pol_z(1, 4, kg) + coef_xyz(175) = coef_xyz(175) + coef_xy(2, 15)*pol_z(2, 4, kg) + coef_xyz(176) = coef_xyz(176) + coef_xy(1, 20)*pol_z(1, 4, kg) + coef_xyz(176) = coef_xyz(176) + coef_xy(2, 20)*pol_z(2, 4, kg) + coef_xyz(177) = coef_xyz(177) + coef_xy(1, 21)*pol_z(1, 4, kg) + coef_xyz(177) = coef_xyz(177) + coef_xy(2, 21)*pol_z(2, 4, kg) + coef_xyz(178) = coef_xyz(178) + coef_xy(1, 22)*pol_z(1, 4, kg) + coef_xyz(178) = coef_xyz(178) + coef_xy(2, 22)*pol_z(2, 4, kg) + coef_xyz(179) = coef_xyz(179) + coef_xy(1, 23)*pol_z(1, 4, kg) + coef_xyz(179) = coef_xyz(179) + coef_xy(2, 23)*pol_z(2, 4, kg) + coef_xyz(180) = coef_xyz(180) + coef_xy(1, 28)*pol_z(1, 4, kg) + coef_xyz(180) = coef_xyz(180) + coef_xy(2, 28)*pol_z(2, 4, kg) + coef_xyz(181) = coef_xyz(181) + coef_xy(1, 29)*pol_z(1, 4, kg) + coef_xyz(181) = coef_xyz(181) + coef_xy(2, 29)*pol_z(2, 4, kg) + coef_xyz(182) = coef_xyz(182) + coef_xy(1, 30)*pol_z(1, 4, kg) + coef_xyz(182) = coef_xyz(182) + coef_xy(2, 30)*pol_z(2, 4, kg) + coef_xyz(183) = coef_xyz(183) + coef_xy(1, 35)*pol_z(1, 4, kg) + coef_xyz(183) = coef_xyz(183) + coef_xy(2, 35)*pol_z(2, 4, kg) + coef_xyz(184) = coef_xyz(184) + coef_xy(1, 36)*pol_z(1, 4, kg) + coef_xyz(184) = coef_xyz(184) + coef_xy(2, 36)*pol_z(2, 4, kg) + coef_xyz(185) = coef_xyz(185) + coef_xy(1, 41)*pol_z(1, 4, kg) + coef_xyz(185) = coef_xyz(185) + coef_xy(2, 41)*pol_z(2, 4, kg) + coef_xyz(186) = coef_xyz(186) + coef_xy(1, 1)*pol_z(1, 5, kg) + coef_xyz(186) = coef_xyz(186) + coef_xy(2, 1)*pol_z(2, 5, kg) + coef_xyz(187) = coef_xyz(187) + coef_xy(1, 2)*pol_z(1, 5, kg) + coef_xyz(187) = coef_xyz(187) + coef_xy(2, 2)*pol_z(2, 5, kg) + coef_xyz(188) = coef_xyz(188) + coef_xy(1, 3)*pol_z(1, 5, kg) + coef_xyz(188) = coef_xyz(188) + coef_xy(2, 3)*pol_z(2, 5, kg) + coef_xyz(189) = coef_xyz(189) + coef_xy(1, 4)*pol_z(1, 5, kg) + coef_xyz(189) = coef_xyz(189) + coef_xy(2, 4)*pol_z(2, 5, kg) + coef_xyz(190) = coef_xyz(190) + coef_xy(1, 5)*pol_z(1, 5, kg) + coef_xyz(190) = coef_xyz(190) + coef_xy(2, 5)*pol_z(2, 5, kg) + coef_xyz(191) = coef_xyz(191) + coef_xy(1, 11)*pol_z(1, 5, kg) + coef_xyz(191) = coef_xyz(191) + coef_xy(2, 11)*pol_z(2, 5, kg) + coef_xyz(192) = coef_xyz(192) + coef_xy(1, 12)*pol_z(1, 5, kg) + coef_xyz(192) = coef_xyz(192) + coef_xy(2, 12)*pol_z(2, 5, kg) + coef_xyz(193) = coef_xyz(193) + coef_xy(1, 13)*pol_z(1, 5, kg) + coef_xyz(193) = coef_xyz(193) + coef_xy(2, 13)*pol_z(2, 5, kg) + coef_xyz(194) = coef_xyz(194) + coef_xy(1, 14)*pol_z(1, 5, kg) + coef_xyz(194) = coef_xyz(194) + coef_xy(2, 14)*pol_z(2, 5, kg) + coef_xyz(195) = coef_xyz(195) + coef_xy(1, 20)*pol_z(1, 5, kg) + coef_xyz(195) = coef_xyz(195) + coef_xy(2, 20)*pol_z(2, 5, kg) + coef_xyz(196) = coef_xyz(196) + coef_xy(1, 21)*pol_z(1, 5, kg) + coef_xyz(196) = coef_xyz(196) + coef_xy(2, 21)*pol_z(2, 5, kg) + coef_xyz(197) = coef_xyz(197) + coef_xy(1, 22)*pol_z(1, 5, kg) + coef_xyz(197) = coef_xyz(197) + coef_xy(2, 22)*pol_z(2, 5, kg) + coef_xyz(198) = coef_xyz(198) + coef_xy(1, 28)*pol_z(1, 5, kg) + coef_xyz(198) = coef_xyz(198) + coef_xy(2, 28)*pol_z(2, 5, kg) + coef_xyz(199) = coef_xyz(199) + coef_xy(1, 29)*pol_z(1, 5, kg) + coef_xyz(199) = coef_xyz(199) + coef_xy(2, 29)*pol_z(2, 5, kg) + coef_xyz(200) = coef_xyz(200) + coef_xy(1, 35)*pol_z(1, 5, kg) + coef_xyz(200) = coef_xyz(200) + coef_xy(2, 35)*pol_z(2, 5, kg) + coef_xyz(201) = coef_xyz(201) + coef_xy(1, 1)*pol_z(1, 6, kg) + coef_xyz(201) = coef_xyz(201) + coef_xy(2, 1)*pol_z(2, 6, kg) + coef_xyz(202) = coef_xyz(202) + coef_xy(1, 2)*pol_z(1, 6, kg) + coef_xyz(202) = coef_xyz(202) + coef_xy(2, 2)*pol_z(2, 6, kg) + coef_xyz(203) = coef_xyz(203) + coef_xy(1, 3)*pol_z(1, 6, kg) + coef_xyz(203) = coef_xyz(203) + coef_xy(2, 3)*pol_z(2, 6, kg) + coef_xyz(204) = coef_xyz(204) + coef_xy(1, 4)*pol_z(1, 6, kg) + coef_xyz(204) = coef_xyz(204) + coef_xy(2, 4)*pol_z(2, 6, kg) + coef_xyz(205) = coef_xyz(205) + coef_xy(1, 11)*pol_z(1, 6, kg) + coef_xyz(205) = coef_xyz(205) + coef_xy(2, 11)*pol_z(2, 6, kg) + coef_xyz(206) = coef_xyz(206) + coef_xy(1, 12)*pol_z(1, 6, kg) + coef_xyz(206) = coef_xyz(206) + coef_xy(2, 12)*pol_z(2, 6, kg) + coef_xyz(207) = coef_xyz(207) + coef_xy(1, 13)*pol_z(1, 6, kg) + coef_xyz(207) = coef_xyz(207) + coef_xy(2, 13)*pol_z(2, 6, kg) + coef_xyz(208) = coef_xyz(208) + coef_xy(1, 20)*pol_z(1, 6, kg) + coef_xyz(208) = coef_xyz(208) + coef_xy(2, 20)*pol_z(2, 6, kg) + coef_xyz(209) = coef_xyz(209) + coef_xy(1, 21)*pol_z(1, 6, kg) + coef_xyz(209) = coef_xyz(209) + coef_xy(2, 21)*pol_z(2, 6, kg) + coef_xyz(210) = coef_xyz(210) + coef_xy(1, 28)*pol_z(1, 6, kg) + coef_xyz(210) = coef_xyz(210) + coef_xy(2, 28)*pol_z(2, 6, kg) + coef_xyz(211) = coef_xyz(211) + coef_xy(1, 1)*pol_z(1, 7, kg) + coef_xyz(211) = coef_xyz(211) + coef_xy(2, 1)*pol_z(2, 7, kg) + coef_xyz(212) = coef_xyz(212) + coef_xy(1, 2)*pol_z(1, 7, kg) + coef_xyz(212) = coef_xyz(212) + coef_xy(2, 2)*pol_z(2, 7, kg) + coef_xyz(213) = coef_xyz(213) + coef_xy(1, 3)*pol_z(1, 7, kg) + coef_xyz(213) = coef_xyz(213) + coef_xy(2, 3)*pol_z(2, 7, kg) + coef_xyz(214) = coef_xyz(214) + coef_xy(1, 11)*pol_z(1, 7, kg) + coef_xyz(214) = coef_xyz(214) + coef_xy(2, 11)*pol_z(2, 7, kg) + coef_xyz(215) = coef_xyz(215) + coef_xy(1, 12)*pol_z(1, 7, kg) + coef_xyz(215) = coef_xyz(215) + coef_xy(2, 12)*pol_z(2, 7, kg) + coef_xyz(216) = coef_xyz(216) + coef_xy(1, 20)*pol_z(1, 7, kg) + coef_xyz(216) = coef_xyz(216) + coef_xy(2, 20)*pol_z(2, 7, kg) + coef_xyz(217) = coef_xyz(217) + coef_xy(1, 1)*pol_z(1, 8, kg) + coef_xyz(217) = coef_xyz(217) + coef_xy(2, 1)*pol_z(2, 8, kg) + coef_xyz(218) = coef_xyz(218) + coef_xy(1, 2)*pol_z(1, 8, kg) + coef_xyz(218) = coef_xyz(218) + coef_xy(2, 2)*pol_z(2, 8, kg) + coef_xyz(219) = coef_xyz(219) + coef_xy(1, 11)*pol_z(1, 8, kg) + coef_xyz(219) = coef_xyz(219) + coef_xy(2, 11)*pol_z(2, 8, kg) + coef_xyz(220) = coef_xyz(220) + coef_xy(1, 1)*pol_z(1, 9, kg) + coef_xyz(220) = coef_xyz(220) + coef_xy(2, 1)*pol_z(2, 9, kg) END DO END SUBROUTINE integrate_core_9 diff --git a/src/group_dist_types.F b/src/group_dist_types.F index 5f4c2dc65f..f203e692fa 100644 --- a/src/group_dist_types.F +++ b/src/group_dist_types.F @@ -74,7 +74,7 @@ PURE SUBROUTINE create_group_dist_d0(this, ngroups, dimen, pos) itmp = get_limit(dimen, ngroups, pos) this%starts = itmp(1) this%ends = itmp(2) - this%sizes = itmp(2)-itmp(1)+1 + this%sizes = itmp(2) - itmp(1) + 1 END SUBROUTINE create_group_dist_d0 @@ -94,18 +94,18 @@ PURE SUBROUTINE create_group_dist_d1_i1(this, ngroups, dimen) INTEGER :: iproc INTEGER, DIMENSION(2) :: itmp - ALLOCATE (this%starts(0:ngroups-1)) + ALLOCATE (this%starts(0:ngroups - 1)) this%starts = 0 - ALLOCATE (this%ends(0:ngroups-1)) + ALLOCATE (this%ends(0:ngroups - 1)) this%ends = 0 - ALLOCATE (this%sizes(0:ngroups-1)) + ALLOCATE (this%sizes(0:ngroups - 1)) this%sizes = 0 - DO iproc = 0, ngroups-1 + DO iproc = 0, ngroups - 1 itmp = get_limit(dimen, ngroups, iproc) this%starts(iproc) = itmp(1) this%ends(iproc) = itmp(2) - this%sizes(iproc) = itmp(2)-itmp(1)+1 + this%sizes(iproc) = itmp(2) - itmp(1) + 1 END DO END SUBROUTINE create_group_dist_d1_i1 @@ -122,11 +122,11 @@ PURE SUBROUTINE create_group_dist_d1_0(this, ngroups) CHARACTER(LEN=*), PARAMETER :: routineN = 'create_group_dist_d1_0', & routineP = moduleN//':'//routineN - ALLOCATE (this%starts(0:ngroups-1)) + ALLOCATE (this%starts(0:ngroups - 1)) this%starts = 0 - ALLOCATE (this%ends(0:ngroups-1)) + ALLOCATE (this%ends(0:ngroups - 1)) this%ends = 0 - ALLOCATE (this%sizes(0:ngroups-1)) + ALLOCATE (this%sizes(0:ngroups - 1)) this%sizes = 0 END SUBROUTINE create_group_dist_d1_0 @@ -151,11 +151,11 @@ SUBROUTINE create_group_dist_d1_i3(this, starts, ends, sizes, para_env) CALL timeset(routineN, handle) - ALLOCATE (this%starts(0:para_env%num_pe-1)) + ALLOCATE (this%starts(0:para_env%num_pe - 1)) this%starts = 0 - ALLOCATE (this%ends(0:para_env%num_pe-1)) + ALLOCATE (this%ends(0:para_env%num_pe - 1)) this%ends = 0 - ALLOCATE (this%sizes(0:para_env%num_pe-1)) + ALLOCATE (this%sizes(0:para_env%num_pe - 1)) this%sizes = 0 this%starts(para_env%mepos) = starts @@ -188,11 +188,11 @@ SUBROUTINE create_group_dist_d1_gd(this, group_dist_ext, para_env) CALL timeset(routineN, handle) - ALLOCATE (this%starts(0:para_env%num_pe-1)) + ALLOCATE (this%starts(0:para_env%num_pe - 1)) this%starts = 0 - ALLOCATE (this%ends(0:para_env%num_pe-1)) + ALLOCATE (this%ends(0:para_env%num_pe - 1)) this%ends = 0 - ALLOCATE (this%sizes(0:para_env%num_pe-1)) + ALLOCATE (this%sizes(0:para_env%num_pe - 1)) this%sizes = 0 this%starts(para_env%mepos) = group_dist_ext%starts diff --git a/src/grrm_utils.F b/src/grrm_utils.F index 9e50b62bc8..f6b6107128 100644 --- a/src/grrm_utils.F +++ b/src/grrm_utils.F @@ -81,14 +81,14 @@ SUBROUTINE write_grrm(iounit, particles, energy, dipole, hessian, dipder, polar) CPASSERT(nc == 3*natom) DO i = 1, nc, 5 DO j = i, nc - WRITE (iounit, "(5(F13.9,1X))") hessian(j, i:MIN(j, i+4)) + WRITE (iounit, "(5(F13.9,1X))") hessian(j, i:MIN(j, i + 4)) END DO END DO ELSE nc = 3*natom DO i = 1, nc, 5 DO j = i, nc - WRITE (iounit, "(5(F13.9,1X))") fz(1:MIN(j-i+1, 5)) + WRITE (iounit, "(5(F13.9,1X))") fz(1:MIN(j - i + 1, 5)) END DO END DO END IF diff --git a/src/hartree_local_methods.F b/src/hartree_local_methods.F index 09432edc47..efa0186b28 100644 --- a/src/hartree_local_methods.F +++ b/src/hartree_local_methods.F @@ -144,12 +144,12 @@ SUBROUTINE calculate_Vh_1center(vrad_h, vrad_s, rrad_h, rrad_s, rrad_0, rrad_z, DO iso = 1, max_s_harm DO ispin = 1, nspins - rho_1(:, iso) = rho_1(:, iso)+rrad_h(ispin)%r_coef(:, iso) - rho_2(:, iso) = rho_2(:, iso)+rrad_s(ispin)%r_coef(:, iso) + rho_1(:, iso) = rho_1(:, iso) + rrad_h(ispin)%r_coef(:, iso) + rho_2(:, iso) = rho_2(:, iso) + rrad_s(ispin)%r_coef(:, iso) END DO l_ang = indso(1, iso) - prefactor = fourpi/(2._dp*l_ang+1._dp) + prefactor = fourpi/(2._dp*l_ang + 1._dp) rho_1(:, iso) = rho_1(:, iso)*wr(:) rho_2(:, iso) = rho_2(:, iso)*wr(:) @@ -162,26 +162,26 @@ SUBROUTINE calculate_Vh_1center(vrad_h, vrad_s, rrad_h, rrad_s, rrad_0, rrad_z, I1_up = r2l(nr, l_ang)*rho_1(nr, iso) I2_up = r2l(nr, l_ang)*rho_2(nr, iso) - DO ir = nr-1, 1, -1 - I1_down = I1_down+oor2l(ir, l_ang+1)*rho_1(ir, iso) - I2_down = I2_down+oor2l(ir, l_ang+1)*rho_2(ir, iso) + DO ir = nr - 1, 1, -1 + I1_down = I1_down + oor2l(ir, l_ang + 1)*rho_1(ir, iso) + I2_down = I2_down + oor2l(ir, l_ang + 1)*rho_2(ir, iso) END DO - vrad_h(nr, iso) = vrad_h(nr, iso)+prefactor* & - (oor2l(nr, l_ang+1)*I1_up+r2l(nr, l_ang)*I1_down) - vrad_s(nr, iso) = vrad_s(nr, iso)+prefactor* & - (oor2l(nr, l_ang+1)*I2_up+r2l(nr, l_ang)*I2_down) + vrad_h(nr, iso) = vrad_h(nr, iso) + prefactor* & + (oor2l(nr, l_ang + 1)*I1_up + r2l(nr, l_ang)*I1_down) + vrad_s(nr, iso) = vrad_s(nr, iso) + prefactor* & + (oor2l(nr, l_ang + 1)*I2_up + r2l(nr, l_ang)*I2_down) - DO ir = nr-1, 1, -1 - I1_up = I1_up+r2l(ir, l_ang)*rho_1(ir, iso) - I1_down = I1_down-oor2l(ir, l_ang+1)*rho_1(ir, iso) - I2_up = I2_up+r2l(ir, l_ang)*rho_2(ir, iso) - I2_down = I2_down-oor2l(ir, l_ang+1)*rho_2(ir, iso) + DO ir = nr - 1, 1, -1 + I1_up = I1_up + r2l(ir, l_ang)*rho_1(ir, iso) + I1_down = I1_down - oor2l(ir, l_ang + 1)*rho_1(ir, iso) + I2_up = I2_up + r2l(ir, l_ang)*rho_2(ir, iso) + I2_down = I2_down - oor2l(ir, l_ang + 1)*rho_2(ir, iso) - vrad_h(ir, iso) = vrad_h(ir, iso)+prefactor* & - (oor2l(ir, l_ang+1)*I1_up+r2l(ir, l_ang)*I1_down) - vrad_s(ir, iso) = vrad_s(ir, iso)+prefactor* & - (oor2l(ir, l_ang+1)*I2_up+r2l(ir, l_ang)*I2_down) + vrad_h(ir, iso) = vrad_h(ir, iso) + prefactor* & + (oor2l(ir, l_ang + 1)*I1_up + r2l(ir, l_ang)*I1_down) + vrad_s(ir, iso) = vrad_s(ir, iso) + prefactor* & + (oor2l(ir, l_ang + 1)*I2_up + r2l(ir, l_ang)*I2_down) END DO @@ -377,13 +377,13 @@ SUBROUTINE Vh_1c_gg_integrals(qs_env, energy_hartree_1c, tddft, do_triplet, p_en n1 = nsoset(lmax(iset1)) DO ipgf1 = 1, npgf(iset1) gexp(1:nr) = EXP(-zet(ipgf1, iset1)*grid_atom%rad2(1:nr))*sqrtwr(1:nr) - DO is1 = nsoset(lmin(iset1)-1)+1, nsoset(lmax(iset1)) - iso = is1+(ipgf1-1)*n1+m1 + DO is1 = nsoset(lmin(iset1) - 1) + 1, nsoset(lmax(iset1)) + iso = is1 + (ipgf1 - 1)*n1 + m1 l_ang = indso(1, is1) gsph(1:nr, iso) = grid_atom%rad2l(1:nr, l_ang)*gexp(1:nr) END DO ! is1 END DO ! ipgf1 - m1 = m1+maxso + m1 = m1 + maxso END DO ! iset1 ! Distribute the atoms of this kind @@ -496,15 +496,15 @@ SUBROUTINE Vh_1c_atom_potential(rho_atom, vrrad_0, & DO ispin = 1, nspins DO iso = 1, max_iso_not0 - Vh1_h(:, iso) = Vh1_h(:, iso)+vr_h(ispin)%r_coef(:, iso) - Vh1_s(:, iso) = Vh1_s(:, iso)+vr_s(ispin)%r_coef(:, iso) + Vh1_h(:, iso) = Vh1_h(:, iso) + vr_h(ispin)%r_coef(:, iso) + Vh1_s(:, iso) = Vh1_s(:, iso) + vr_s(ispin)%r_coef(:, iso) END DO END DO IF (bfactor /= 0._dp) THEN DO ir = 1, nr - Vh1_h(ir, 1) = Vh1_h(ir, 1)+bfactor*grid_atom%rad2(ir)*grid_atom%wr(ir) - Vh1_s(ir, 1) = Vh1_s(ir, 1)+bfactor*grid_atom%rad2(ir)*grid_atom%wr(ir) + Vh1_h(ir, 1) = Vh1_h(ir, 1) + bfactor*grid_atom%rad2(ir)*grid_atom%wr(ir) + Vh1_s(ir, 1) = Vh1_s(ir, 1) + bfactor*grid_atom%rad2(ir)*grid_atom%wr(ir) END DO END IF @@ -569,7 +569,7 @@ SUBROUTINE Vh_1c_atom_energy(energy_hartree_1c, ecoul_1c, rho_atom, rrad_0, & ! Calculate the contributions to Ecoul coming from Vh1_s*rho0 ecoul_1_0 = 0.0_dp DO iso = 1, nchan_0 - ecoul_1_0 = ecoul_1_0+0.5_dp*SUM(Vh1_s(:, iso)*rrad_0(:, iso)*grid_atom%wr(:)) + ecoul_1_0 = ecoul_1_0 + 0.5_dp*SUM(Vh1_s(:, iso)*rrad_0(:, iso)*grid_atom%wr(:)) END DO ! Calculate the contributions to Ecoul coming from Vh1_h*rho1_h and Vh1_s*rho1_s @@ -577,20 +577,20 @@ SUBROUTINE Vh_1c_atom_energy(energy_hartree_1c, ecoul_1c, rho_atom, rrad_0, & ecoul_1_h = 0.0_dp DO ispin = 1, nspins DO iso = 1, max_iso_not0 - ecoul_1_s = ecoul_1_s+0.5_dp*SUM(Vh1_s(:, iso)*r_s(ispin)%r_coef(:, iso)*grid_atom%wr(:)) - ecoul_1_h = ecoul_1_h+0.5_dp*SUM(Vh1_h(:, iso)*r_h(ispin)%r_coef(:, iso)*grid_atom%wr(:)) + ecoul_1_s = ecoul_1_s + 0.5_dp*SUM(Vh1_s(:, iso)*r_s(ispin)%r_coef(:, iso)*grid_atom%wr(:)) + ecoul_1_h = ecoul_1_h + 0.5_dp*SUM(Vh1_h(:, iso)*r_h(ispin)%r_coef(:, iso)*grid_atom%wr(:)) END DO END DO CALL set_ecoul_1c(ecoul_1c, iatom, ecoul_1_z=ecoul_1_z, ecoul_1_0=ecoul_1_0) CALL set_ecoul_1c(ecoul_1c=ecoul_1c, iatom=iatom, ecoul_1_h=ecoul_1_h, ecoul_1_s=ecoul_1_s) - energy_hartree_1c = energy_hartree_1c+ecoul_1_z-ecoul_1_0 - energy_hartree_1c = energy_hartree_1c+ecoul_1_h-ecoul_1_s + energy_hartree_1c = energy_hartree_1c + ecoul_1_z - ecoul_1_0 + energy_hartree_1c = energy_hartree_1c + ecoul_1_h - ecoul_1_s ! atomic energy contribution IF (atenergy) THEN - ate1c(iatom) = ate1c(iatom)+ecoul_1_z-ecoul_1_0 + ate1c(iatom) = ate1c(iatom) + ecoul_1_z - ecoul_1_0 END IF END SUBROUTINE Vh_1c_atom_energy @@ -681,48 +681,48 @@ SUBROUTINE Vh_1c_atom_integrals(rho_atom, & is1 = cg_list(1, icg, iso) is2 = cg_list(2, icg, iso) - iso1 = is1+n1*(ipgf1-1)+m1 - iso2 = is2+n2*(ipgf2-1)+m2 + iso1 = is1 + n1*(ipgf1 - 1) + m1 + iso2 = is2 + n2*(ipgf2 - 1) + m2 gVg_h = 0.0_dp gVg_s = 0.0_dp DO ir = 1, nr - gVg_h = gVg_h+gsph(ir, iso1)*gsph(ir, iso2)*Vh1_h(ir, iso) - gVg_s = gVg_s+gsph(ir, iso1)*gsph(ir, iso2)*Vh1_s(ir, iso) + gVg_h = gVg_h + gsph(ir, iso1)*gsph(ir, iso2)*Vh1_h(ir, iso) + gVg_s = gVg_s + gsph(ir, iso1)*gsph(ir, iso2)*Vh1_s(ir, iso) END DO ! ir - aVh1b_hh(iso1, iso2) = aVh1b_hh(iso1, iso2)+gVg_h*my_CG(is1, is2, iso) - aVh1b_ss(iso1, iso2) = aVh1b_ss(iso1, iso2)+gVg_s*my_CG(is1, is2, iso) - aVh1b_00(iso1, iso2) = aVh1b_00(iso1, iso2)+gVg_0*Qlm_gg(iso1, iso2, iso) + aVh1b_hh(iso1, iso2) = aVh1b_hh(iso1, iso2) + gVg_h*my_CG(is1, is2, iso) + aVh1b_ss(iso1, iso2) = aVh1b_ss(iso1, iso2) + gVg_s*my_CG(is1, is2, iso) + aVh1b_00(iso1, iso2) = aVh1b_00(iso1, iso2) + gVg_0*Qlm_gg(iso1, iso2, iso) END DO !icg END DO ! iso ! without contributions to V1_s*rho0 - DO iso = nchan_0+1, max_iso_not0 + DO iso = nchan_0 + 1, max_iso_not0 DO icg = 1, cg_n_list(iso) is1 = cg_list(1, icg, iso) is2 = cg_list(2, icg, iso) - iso1 = is1+n1*(ipgf1-1)+m1 - iso2 = is2+n2*(ipgf2-1)+m2 + iso1 = is1 + n1*(ipgf1 - 1) + m1 + iso2 = is2 + n2*(ipgf2 - 1) + m2 gVg_h = 0.0_dp gVg_s = 0.0_dp DO ir = 1, nr - gVg_h = gVg_h+gsph(ir, iso1)*gsph(ir, iso2)*Vh1_h(ir, iso) - gVg_s = gVg_s+gsph(ir, iso1)*gsph(ir, iso2)*Vh1_s(ir, iso) + gVg_h = gVg_h + gsph(ir, iso1)*gsph(ir, iso2)*Vh1_h(ir, iso) + gVg_s = gVg_s + gsph(ir, iso1)*gsph(ir, iso2)*Vh1_s(ir, iso) END DO ! ir - aVh1b_hh(iso1, iso2) = aVh1b_hh(iso1, iso2)+gVg_h*my_CG(is1, is2, iso) - aVh1b_ss(iso1, iso2) = aVh1b_ss(iso1, iso2)+gVg_s*my_CG(is1, is2, iso) + aVh1b_hh(iso1, iso2) = aVh1b_hh(iso1, iso2) + gVg_h*my_CG(is1, is2, iso) + aVh1b_ss(iso1, iso2) = aVh1b_ss(iso1, iso2) + gVg_s*my_CG(is1, is2, iso) END DO !icg END DO ! iso END DO ! ipgf2 END DO ! ipgf1 - m2 = m2+maxso + m2 = m2 + maxso END DO ! iset2 - m1 = m1+maxso + m1 = m1 + maxso END DO !iset1 DO ispin = 1, nspins diff --git a/src/header.F b/src/header.F index 2fd8fcac32..5bb3808f80 100644 --- a/src/header.F +++ b/src/header.F @@ -52,7 +52,7 @@ SUBROUTINE cp2k_header(iw, wdir) WRITE (UNIT=iw, FMT="(A,T44,A37)") & " **** ** ******* ** PROGRAM STARTED IN ", ADJUSTR(cwd(1:37)) DO l = 38, LEN_TRIM(cwd), 37 - WRITE (UNIT=iw, FMT="(T44,A)") cwd(l:MIN(LEN_TRIM(cwd), l+36)) + WRITE (UNIT=iw, FMT="(T44,A)") cwd(l:MIN(LEN_TRIM(cwd), l + 36)) END DO END SUBROUTINE cp2k_header @@ -81,7 +81,7 @@ SUBROUTINE cp2k_footer(iw, wdir) WRITE (UNIT=iw, FMT="(A,T44,A37)") & " **** ** ******* ** PROGRAM STOPPED IN ", ADJUSTR(cwd(1:37)) DO l = 38, LEN_TRIM(cwd), 37 - WRITE (UNIT=iw, FMT="(T44,A)") cwd(l:MIN(LEN_TRIM(cwd), l+36)) + WRITE (UNIT=iw, FMT="(T44,A)") cwd(l:MIN(LEN_TRIM(cwd), l + 36)) END DO END SUBROUTINE cp2k_footer diff --git a/src/hfx_admm_utils.F b/src/hfx_admm_utils.F index b79b5307d6..b32806cb88 100644 --- a/src/hfx_admm_utils.F +++ b/src/hfx_admm_utils.F @@ -323,7 +323,7 @@ SUBROUTINE hfx_ks_matrix(qs_env, matrix_ks, rho, energy, calculate_forces, & CALL integrate_four_center(qs_env, x_data, matrix_ks_orb, eh1, rho_ao_orb, hfx_sections, & para_env, s_mstruct_changed, irep, distribute_fock_matrix, & ispin=ispin) - ehfx = ehfx+eh1 + ehfx = ehfx + eh1 END DO IF (calculate_forces .AND. .NOT. do_adiabatic_rescaling) THEN @@ -372,7 +372,7 @@ SUBROUTINE hfx_ks_matrix(qs_env, matrix_ks, rho, energy, calculate_forces, & CALL integrate_four_center(qs_env, x_data, matrix_ks_orb, eh1, rho_ao_orb, hfx_sections, & para_env, .FALSE., irep, distribute_fock_matrix, & ispin=ispin) - ehfxrt = ehfxrt+eh1 + ehfxrt = ehfxrt + eh1 END DO IF (calculate_forces .AND. .NOT. do_adiabatic_rescaling) THEN @@ -381,7 +381,7 @@ SUBROUTINE hfx_ks_matrix(qs_env, matrix_ks, rho, energy, calculate_forces, & END IF !! If required, the calculation of the forces will be done later with adiabatic rescaling - IF (do_adiabatic_rescaling) hf_energy(irep) = ehfx+ehfxrt + IF (do_adiabatic_rescaling) hf_energy(irep) = ehfx + ehfxrt END IF CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, & @@ -391,7 +391,7 @@ SUBROUTINE hfx_ks_matrix(qs_env, matrix_ks, rho, energy, calculate_forces, & END DO ! *** Set the total HFX energy - energy%ex = ehfx+ehfxrt + energy%ex = ehfx + ehfxrt ! *** Add Core-Hamiltonian-Matrix *** DO ispin = 1, nspins @@ -401,7 +401,7 @@ SUBROUTINE hfx_ks_matrix(qs_env, matrix_ks, rho, energy, calculate_forces, & END DO END DO IF (use_virial .AND. calculate_forces) THEN - virial%pv_virial = virial%pv_virial-virial%pv_fock_4c + virial%pv_virial = virial%pv_virial - virial%pv_fock_4c virial%pv_calculate = .FALSE. ENDIF @@ -512,9 +512,9 @@ SUBROUTINE pw_hfx(qs_env, energy, hfx_section, poisson_env, auxbas_pw_pool, irep DO iorb_block = 1, norb, blocksize - DO iorb = iorb_block, MIN(iorb_block+blocksize-1, norb) + DO iorb = iorb_block, MIN(iorb_block + blocksize - 1, norb) - iloc = iorb-iorb_block+1 + iloc = iorb - iorb_block + 1 CALL calculate_wavefunction(mo_coeff, iorb, rho_i(iloc), rho_g, & atomic_kind_set, qs_kind_set, cell, dft_control, particle_set, & pw_env) @@ -523,19 +523,19 @@ SUBROUTINE pw_hfx(qs_env, energy, hfx_section, poisson_env, auxbas_pw_pool, irep DO jorb_block = iorb_block, norb, blocksize - DO jorb = jorb_block, MIN(jorb_block+blocksize-1, norb) + DO jorb = jorb_block, MIN(jorb_block + blocksize - 1, norb) - jloc = jorb-jorb_block+1 + jloc = jorb - jorb_block + 1 CALL calculate_wavefunction(mo_coeff, jorb, rho_j(jloc), rho_g, & atomic_kind_set, qs_kind_set, cell, dft_control, particle_set, & pw_env) ENDDO - DO iorb = iorb_block, MIN(iorb_block+blocksize-1, norb) - iloc = iorb-iorb_block+1 - DO jorb = jorb_block, MIN(jorb_block+blocksize-1, norb) - jloc = jorb-jorb_block+1 + DO iorb = iorb_block, MIN(iorb_block + blocksize - 1, norb) + iloc = iorb - iorb_block + 1 + DO jorb = jorb_block, MIN(jorb_block + blocksize - 1, norb) + jloc = jorb - jorb_block + 1 IF (jorb < iorb) CYCLE ! compute the pair density @@ -550,7 +550,7 @@ SUBROUTINE pw_hfx(qs_env, energy, hfx_section, poisson_env, auxbas_pw_pool, irep IF (SIZE(mo_array) == 1) scaling = scaling*2.0_dp IF (iorb /= jorb) scaling = scaling*2.0_dp - exchange_energy = exchange_energy-scaling*pair_energy + exchange_energy = exchange_energy - scaling*pair_energy ENDDO ENDDO @@ -645,10 +645,10 @@ SUBROUTINE create_admm_xc_section(qs_env, xc_section, admm_env) ifun = 0 nfun = 0 DO - ifun = ifun+1 + ifun = ifun + 1 xc_fun => section_vals_get_subs_vals2(xc_fun_section, i_section=ifun) IF (.NOT. ASSOCIATED(xc_fun)) EXIT - nfun = nfun+1 + nfun = nfun + 1 END DO ifun = 0 @@ -718,7 +718,7 @@ SUBROUTINE create_admm_xc_section(qs_env, xc_section, admm_env) ifun = 0 funct_found = .FALSE. DO - ifun = ifun+1 + ifun = ifun + 1 xc_fun => section_vals_get_subs_vals2(xc_fun_section, i_section=ifun) IF (.NOT. ASSOCIATED(xc_fun)) EXIT IF (xc_fun%section%name == "PBE") THEN @@ -735,7 +735,7 @@ SUBROUTINE create_admm_xc_section(qs_env, xc_section, admm_env) ELSE CALL section_vals_val_get(xc_fun_section, "PBE%SCALE_X", & r_val=scale_x) - scale_x = scale_x+hfx_fraction + scale_x = scale_x + hfx_fraction CALL section_vals_val_set(xc_fun_section, "PBE%SCALE_X", & r_val=scale_x) END IF @@ -744,7 +744,7 @@ SUBROUTINE create_admm_xc_section(qs_env, xc_section, admm_env) ifun = 0 funct_found = .FALSE. DO - ifun = ifun+1 + ifun = ifun + 1 xc_fun => section_vals_get_subs_vals2(xc_fun_section, i_section=ifun) IF (.NOT. ASSOCIATED(xc_fun)) EXIT IF (xc_fun%section%name == "XWPBE") THEN @@ -763,7 +763,7 @@ SUBROUTINE create_admm_xc_section(qs_env, xc_section, admm_env) ELSE CALL section_vals_val_get(xc_fun_section, "XWPBE%SCALE_X", & r_val=scale_x) - scale_x = scale_x+hfx_fraction + scale_x = scale_x + hfx_fraction CALL section_vals_val_set(xc_fun_section, "XWPBE%SCALE_X", & r_val=scale_x) END IF @@ -772,7 +772,7 @@ SUBROUTINE create_admm_xc_section(qs_env, xc_section, admm_env) ifun = 0 funct_found = .FALSE. DO - ifun = ifun+1 + ifun = ifun + 1 xc_fun => section_vals_get_subs_vals2(xc_fun_section, i_section=ifun) IF (.NOT. ASSOCIATED(xc_fun)) EXIT IF (xc_fun%section%name == "PBE_HOLE_T_C_LR") THEN @@ -790,7 +790,7 @@ SUBROUTINE create_admm_xc_section(qs_env, xc_section, admm_env) ELSE CALL section_vals_val_get(xc_fun_section, "PBE_HOLE_T_C_LR%SCALE_X", & r_val=scale_x) - scale_x = scale_x-hfx_fraction + scale_x = scale_x - hfx_fraction CALL section_vals_val_set(xc_fun_section, "PBE_HOLE_T_C_LR%SCALE_X", & r_val=scale_x) CALL section_vals_val_set(xc_fun_section, "PBE_HOLE_T_C_LR%CUTOFF_RADIUS", & @@ -799,7 +799,7 @@ SUBROUTINE create_admm_xc_section(qs_env, xc_section, admm_env) ifun = 0 funct_found = .FALSE. DO - ifun = ifun+1 + ifun = ifun + 1 xc_fun => section_vals_get_subs_vals2(xc_fun_section, i_section=ifun) IF (.NOT. ASSOCIATED(xc_fun)) EXIT IF (xc_fun%section%name == "XWPBE") THEN @@ -817,7 +817,7 @@ SUBROUTINE create_admm_xc_section(qs_env, xc_section, admm_env) ELSE CALL section_vals_val_get(xc_fun_section, "XWPBE%SCALE_X0", & r_val=scale_x) - scale_x = scale_x+hfx_fraction + scale_x = scale_x + hfx_fraction CALL section_vals_val_set(xc_fun_section, "XWPBE%SCALE_X0", & r_val=scale_x) END IF @@ -866,7 +866,7 @@ SUBROUTINE create_admm_xc_section(qs_env, xc_section, admm_env) ifun = 0 funct_found = .FALSE. DO - ifun = ifun+1 + ifun = ifun + 1 xc_fun => section_vals_get_subs_vals2(xc_fun_section, i_section=ifun) IF (.NOT. ASSOCIATED(xc_fun)) EXIT IF (xc_fun%section%name == TRIM(name_x_func)) THEN @@ -895,7 +895,7 @@ SUBROUTINE create_admm_xc_section(qs_env, xc_section, admm_env) ELSE CALL section_vals_val_get(xc_fun_section, TRIM(name_x_func)//"%SCALE_X", & r_val=scale_x) - scale_x = scale_x+hfx_fraction + scale_x = scale_x + hfx_fraction CALL section_vals_val_set(xc_fun_section, TRIM(name_x_func)//"%SCALE_X", & r_val=scale_x) IF (admm_env%aux_exch_func == do_admm_aux_exch_func_opt) THEN @@ -911,7 +911,7 @@ SUBROUTINE create_admm_xc_section(qs_env, xc_section, admm_env) ifun = 0 funct_found = .FALSE. DO - ifun = ifun+1 + ifun = ifun + 1 xc_fun => section_vals_get_subs_vals2(xc_fun_section, i_section=ifun) IF (.NOT. ASSOCIATED(xc_fun)) EXIT @@ -935,7 +935,7 @@ SUBROUTINE create_admm_xc_section(qs_env, xc_section, admm_env) ifun = 0 funct_found = .FALSE. DO - ifun = ifun+1 + ifun = ifun + 1 xc_fun => section_vals_get_subs_vals2(xc_fun_section, i_section=ifun) IF (.NOT. ASSOCIATED(xc_fun)) EXIT scale_x = -1000.0_dp @@ -1023,7 +1023,7 @@ SUBROUTINE tddft_hfx_matrix(matrix_ks, rho_ao, qs_env) DO ispin = 1, mspin CALL integrate_four_center(qs_env, x_data, matrix_ks_kp, eh1, rho_ao_kp, hfx_sections, para_env, & s_mstruct_changed, irep, distribute_fock_matrix, ispin=ispin) - ehfx = ehfx+eh1 + ehfx = ehfx + eh1 END DO END DO energy%ex = ehfx diff --git a/src/hfx_communication.F b/src/hfx_communication.F index 38ef3627bb..f95b4f82e1 100644 --- a/src/hfx_communication.F +++ b/src/hfx_communication.F @@ -125,30 +125,30 @@ SUBROUTINE get_full_density(para_env, full_density, rho, number_of_p_entries, & DO iset = 1, nseta pb = 0 DO jset = 1, nsetb - DO pa1 = pa+1, pa+nsgfa(iset) - DO pb1 = pb+1, pb+nsgfb(jset) + DO pa1 = pa + 1, pa + nsgfa(iset) + DO pb1 = pb + 1, pb + nsgfb(jset) sendbuffer(i) = MAX(ABS(sparse_block(pa1, pb1)), ABS(sparse_block_beta(pa1, pb1))) - i = i+1 + i = i + 1 END DO END DO - pb = pb+nsgfb(jset) + pb = pb + nsgfb(jset) END DO - pa = pa+nsgfa(iset) + pa = pa + nsgfa(iset) END DO ELSE pa = 0 DO iset = 1, nseta pb = 0 DO jset = 1, nsetb - DO pa1 = pa+1, pa+nsgfa(iset) - DO pb1 = pb+1, pb+nsgfb(jset) + DO pa1 = pa + 1, pa + nsgfa(iset) + DO pb1 = pb + 1, pb + nsgfb(jset) sendbuffer(i) = sparse_block(pa1, pb1)*symmfac - i = i+1 + i = i + 1 END DO END DO - pb = pb+nsgfb(jset) + pb = pb + nsgfb(jset) END DO - pa = pa+nsgfa(iset) + pa = pa + nsgfa(iset) END DO END IF END DO @@ -158,19 +158,19 @@ SUBROUTINE get_full_density(para_env, full_density, rho, number_of_p_entries, & CALL mp_sync(para_env%group) ncpu = para_env%num_pe mepos = para_env%mepos - dest = MODULO(mepos+1, ncpu) - source = MODULO(mepos-1, ncpu) - DO icpu = 0, ncpu-1 - IF (icpu .NE. ncpu-1) THEN + dest = MODULO(mepos + 1, ncpu) + source = MODULO(mepos - 1, ncpu) + DO icpu = 0, ncpu - 1 + IF (icpu .NE. ncpu - 1) THEN CALL mp_isendrecv(sendbuffer, dest, recbuffer, source, & para_env%group, req(1), req(2), 13) ENDIF - data_from = MODULO(mepos-icpu, ncpu) - source_cpu = MODULO(data_from, ncpu)+1 - block_size = block_offset(source_cpu+1)-block_offset(source_cpu) - full_density(block_offset(source_cpu):block_offset(source_cpu)+block_size-1) = sendbuffer(1:block_size) + data_from = MODULO(mepos - icpu, ncpu) + source_cpu = MODULO(data_from, ncpu) + 1 + block_size = block_offset(source_cpu + 1) - block_offset(source_cpu) + full_density(block_offset(source_cpu):block_offset(source_cpu) + block_size - 1) = sendbuffer(1:block_size) - IF (icpu .NE. ncpu-1) THEN + IF (icpu .NE. ncpu - 1) THEN CALL mp_waitall(req) ENDIF swapbuffer => sendbuffer @@ -235,17 +235,17 @@ SUBROUTINE distribute_ks_matrix(para_env, full_ks, ks_matrix, number_of_p_entrie ncpu = para_env%num_pe mepos = para_env%mepos - dest = MODULO(mepos+1, ncpu) - source = MODULO(mepos-1, ncpu) + dest = MODULO(mepos + 1, ncpu) + source = MODULO(mepos - 1, ncpu) ! sync before/after a ring of isendrecv CALL mp_sync(para_env%group) DO icpu = 1, ncpu i = 1 - data_to = mepos-icpu - dest_cpu = MODULO(data_to, ncpu)+1 - block_size = block_offset(dest_cpu+1)-block_offset(dest_cpu) - sendbuffer(1:block_size) = sendbuffer(1:block_size)+full_ks(block_offset(dest_cpu):block_offset(dest_cpu)+block_size-1) + data_to = mepos - icpu + dest_cpu = MODULO(data_to, ncpu) + 1 + block_size = block_offset(dest_cpu + 1) - block_offset(dest_cpu) + sendbuffer(1:block_size) = sendbuffer(1:block_size) + full_ks(block_offset(dest_cpu):block_offset(dest_cpu) + block_size - 1) IF (icpu .EQ. ncpu) EXIT CALL mp_isendrecv(sendbuffer, dest, recbuffer, source, & para_env%group, req(1), req(2), 13) @@ -273,19 +273,19 @@ SUBROUTINE distribute_ks_matrix(para_env, full_ks, ks_matrix, number_of_p_entrie DO iset = 1, nseta pb = 0 DO jset = 1, nsetb - DO pa1 = pa+1, pa+nsgfa(iset) - DO pb1 = pb+1, pb+nsgfb(jset) + DO pa1 = pa + 1, pa + nsgfa(iset) + DO pb1 = pb + 1, pb + nsgfb(jset) IF (iatom == jatom .AND. pa1 == pb1) THEN - sparse_block(pa1, pb1) = sendbuffer(i)*myd_fac+sparse_block(pa1, pb1) + sparse_block(pa1, pb1) = sendbuffer(i)*myd_fac + sparse_block(pa1, pb1) ELSE - sparse_block(pa1, pb1) = sendbuffer(i)*my_fac+sparse_block(pa1, pb1) + sparse_block(pa1, pb1) = sendbuffer(i)*my_fac + sparse_block(pa1, pb1) END IF - i = i+1 + i = i + 1 END DO END DO - pb = pb+nsgfb(jset) + pb = pb + nsgfb(jset) END DO - pa = pa+nsgfa(iset) + pa = pa + nsgfa(iset) END DO END DO CALL dbcsr_iterator_stop(iter) @@ -355,7 +355,7 @@ SUBROUTINE scale_and_add_fock_to_ks_matrix(para_env, qs_env, ks_matrix, irep, & last_sgf_global(0) = 0 DO iatom = 1, natom ikind = kind_of(iatom) - last_sgf_global(iatom) = last_sgf_global(iatom-1)+basis_parameter(ikind)%nsgf_total + last_sgf_global(iatom) = last_sgf_global(iatom - 1) + basis_parameter(ikind)%nsgf_total END DO full_ks => actual_x_data%full_ks_alpha IF (scaling_factor /= 1.0_dp) THEN @@ -406,7 +406,7 @@ PURE FUNCTION get_1D_idx(i, j, N) INTEGER(int_8) :: min_ij min_ij = MIN(i, j) - get_1D_idx = min_ij*N+MAX(i, j)-(min_ij-1)*min_ij/2-N + get_1D_idx = min_ij*N + MAX(i, j) - (min_ij - 1)*min_ij/2 - N END FUNCTION get_1D_idx @@ -473,8 +473,8 @@ SUBROUTINE get_atomic_block_maps(matrix, basis_parameter, kind_of, & CALL dbcsr_iterator_next_block(iter, iatom, jatom, sparse_block, blk) ikind = kind_of(iatom) jkind = kind_of(jatom) - number_of_p_blocks = number_of_p_blocks+1 - number_of_p_entries = number_of_p_entries+ & + number_of_p_blocks = number_of_p_blocks + 1 + number_of_p_entries = number_of_p_entries + & basis_parameter(ikind)%nsgf_total*basis_parameter(jkind)%nsgf_total END DO CALL dbcsr_iterator_stop(iter) @@ -498,27 +498,27 @@ SUBROUTINE get_atomic_block_maps(matrix, basis_parameter, kind_of, & DO WHILE (dbcsr_iterator_blocks_left(iter)) CALL dbcsr_iterator_next_block(iter, iatom, jatom, sparse_block, blk) - buffer_in(ibuf+1) = iatom - buffer_in(ibuf+2) = jatom - buffer_in(ibuf+3) = para_env%mepos+1 - ibuf = ibuf+3 + buffer_in(ibuf + 1) = iatom + buffer_in(ibuf + 2) = jatom + buffer_in(ibuf + 3) = para_env%mepos + 1 + ibuf = ibuf + 3 END DO CALL dbcsr_iterator_stop(iter) rcount = SIZE(buffer_in) rdispl(1) = 0 DO icpu = 2, para_env%num_pe - rdispl(icpu) = rdispl(icpu-1)+rcount(icpu-1) + rdispl(icpu) = rdispl(icpu - 1) + rcount(icpu - 1) ENDDO CALL mp_allgather(buffer_in, buffer_out, rcount, rdispl, para_env%group) - DO ibuf = 0, number_of_p_blocks*para_env%num_pe*3-3, 3 - itask = buffer_out(ibuf+3) + DO ibuf = 0, number_of_p_blocks*para_env%num_pe*3 - 3, 3 + itask = buffer_out(ibuf + 3) ! buffer_out can be 0 if buffer_in contained less elements than the max number of atom pairs ! is_assoc_atomic_block is a map for atom pairs to a processor (assumes symmetry, i,j on the ame as j,i) IF (itask .NE. 0) THEN - iatom = buffer_out(ibuf+1) - jatom = buffer_out(ibuf+2) + iatom = buffer_out(ibuf + 1) + jatom = buffer_out(ibuf + 2) is_assoc_atomic_block(iatom, jatom) = itask is_assoc_atomic_block(jatom, iatom) = itask ENDIF @@ -540,7 +540,7 @@ SUBROUTINE get_atomic_block_maps(matrix, basis_parameter, kind_of, & DO iatom = 1, natom DO jatom = iatom, natom icpu = is_assoc_atomic_block(jatom, iatom) - IF (icpu > 0) counter(icpu) = counter(icpu)+1 + IF (icpu > 0) counter(icpu) = counter(icpu) + 1 END DO END DO DO icpu = 1, para_env%num_pe @@ -552,7 +552,7 @@ SUBROUTINE get_atomic_block_maps(matrix, basis_parameter, kind_of, & DO jatom = iatom, natom icpu = is_assoc_atomic_block(jatom, iatom) IF (icpu > 0) THEN - counter(icpu) = counter(icpu)+1 + counter(icpu) = counter(icpu) + 1 map_atoms_to_cpus(icpu)%jatom_list(counter(icpu)) = jatom map_atoms_to_cpus(icpu)%iatom_list(counter(icpu)) = iatom END IF @@ -576,10 +576,10 @@ SUBROUTINE get_atomic_block_maps(matrix, basis_parameter, kind_of, & jkind = kind_of(jatom) atomic_block_offset(iatom, jatom) = offset atomic_block_offset(jatom, iatom) = offset - offset = offset+basis_parameter(ikind)%nsgf_total*basis_parameter(jkind)%nsgf_total + offset = offset + basis_parameter(ikind)%nsgf_total*basis_parameter(jkind)%nsgf_total END DO END DO - block_offset(ncpu+1) = offset + block_offset(ncpu + 1) = offset set_offset = 0 DO ikind = 1, nkind nseta = basis_parameter(ikind)%nset @@ -591,7 +591,7 @@ SUBROUTINE get_atomic_block_maps(matrix, basis_parameter, kind_of, & DO iset = 1, nseta DO jset = 1, nsetb set_offset(jset, iset, jkind, ikind) = offset - offset = offset+nsgfa(iset)*nsgfb(jset) + offset = offset + nsgfa(iset)*nsgfb(jset) END DO END DO END DO diff --git a/src/hfx_compression_methods.F b/src/hfx_compression_methods.F index 7c7ecf33f9..853d41c86d 100644 --- a/src/hfx_compression_methods.F +++ b/src/hfx_compression_methods.F @@ -77,11 +77,11 @@ SUBROUTINE hfx_add_single_cache_element(value, nbits, cache, container, memory_u INTEGER(int_8) :: int_val - int_val = value+shifts(nbits-1) + int_val = value + shifts(nbits - 1) IF (cache%element_counter /= CACHE_SIZE) THEN cache%data(cache%element_counter) = int_val - cache%element_counter = cache%element_counter+1 + cache%element_counter = cache%element_counter + 1 ELSE cache%data(CACHE_SIZE) = int_val CALL hfx_compress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage, & @@ -119,34 +119,34 @@ SUBROUTINE hfx_compress_cache(full_array, container, nbits, memory_usage, use_di tmp_elements, tmp_nints start_idx = container%element_counter - increment_counter = (nbits*CACHE_SIZE+63)/64 - end_idx = start_idx+increment_counter-1 + increment_counter = (nbits*CACHE_SIZE + 63)/64 + end_idx = start_idx + increment_counter - 1 IF (end_idx < CACHE_SIZE) THEN CALL ints2bits_specific(nbits, CACHE_SIZE, container%current%data(start_idx), full_array(1)) - container%element_counter = container%element_counter+increment_counter + container%element_counter = container%element_counter + increment_counter ELSE !! We have to fill the container first with the remaining number of bits - tmp_elements = CACHE_SIZE-start_idx+1 + tmp_elements = CACHE_SIZE - start_idx + 1 tmp_nints = (tmp_elements*64)/nbits CALL ints2bits_specific(nbits, tmp_nints, container%current%data(start_idx), full_array(1)) IF (use_disk_storage) THEN !! write to file WRITE (container%unit) container%current%data !$OMP ATOMIC - memory_usage = memory_usage+1 - container%file_counter = container%file_counter+1 + memory_usage = memory_usage + 1 + container%file_counter = container%file_counter + 1 ELSE !! Allocate new list entry ALLOCATE (container%current%next) !$OMP ATOMIC - memory_usage = memory_usage+1 + memory_usage = memory_usage + 1 container%current%next%next => NULL() container%current => container%current%next - IF (PRESENT(max_val_memory)) max_val_memory = max_val_memory+1 + IF (PRESENT(max_val_memory)) max_val_memory = max_val_memory + 1 END IF !! compress remaining ints - CALL ints2bits_specific(nbits, CACHE_SIZE-tmp_nints, container%current%data(1), full_array(tmp_nints+1)) - container%element_counter = 1+(nbits*(CACHE_SIZE-tmp_nints)+63)/64 + CALL ints2bits_specific(nbits, CACHE_SIZE - tmp_nints, container%current%data(1), full_array(tmp_nints + 1)) + container%element_counter = 1 + (nbits*(CACHE_SIZE - tmp_nints) + 63)/64 END IF END SUBROUTINE hfx_compress_cache @@ -175,14 +175,14 @@ SUBROUTINE hfx_get_single_cache_element(value, nbits, cache, container, memory_u IF (cache%element_counter /= CACHE_SIZE) THEN value = cache%data(cache%element_counter) - cache%element_counter = cache%element_counter+1 + cache%element_counter = cache%element_counter + 1 ELSE value = cache%data(CACHE_SIZE) CALL hfx_decompress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage) cache%element_counter = 1 END IF - value = value-shifts(nbits-1) + value = value - shifts(nbits - 1) END SUBROUTINE hfx_get_single_cache_element @@ -209,14 +209,14 @@ SUBROUTINE hfx_decompress_cache(full_array, container, nbits, memory_usage, use_ stat, tmp_elements, tmp_nints start_idx = container%element_counter - increment_counter = (nbits*CACHE_SIZE+63)/64 - end_idx = start_idx+increment_counter-1 + increment_counter = (nbits*CACHE_SIZE + 63)/64 + end_idx = start_idx + increment_counter - 1 IF (end_idx < CACHE_SIZE) THEN CALL bits2ints_specific(nbits, CACHE_SIZE, container%current%data(start_idx), full_array(1)) - container%element_counter = container%element_counter+increment_counter + container%element_counter = container%element_counter + increment_counter ELSE !! We have to fill the container first with the remaining number of bits - tmp_elements = CACHE_SIZE-start_idx+1 + tmp_elements = CACHE_SIZE - start_idx + 1 tmp_nints = (tmp_elements*64)/nbits CALL bits2ints_specific(nbits, tmp_nints, container%current%data(start_idx), full_array(1)) IF (use_disk_storage) THEN @@ -225,15 +225,15 @@ SUBROUTINE hfx_decompress_cache(full_array, container, nbits, memory_usage, use_ !! but no other was needed for the current bit size !! Therefore we can safely igonore an eof error READ (container%unit, IOSTAT=stat) container%current%data - memory_usage = memory_usage+1 - container%file_counter = container%file_counter+1 + memory_usage = memory_usage + 1 + container%file_counter = container%file_counter + 1 ELSE container%current => container%current%next - memory_usage = memory_usage+1 + memory_usage = memory_usage + 1 END IF !! decompress remaining ints - CALL bits2ints_specific(nbits, CACHE_SIZE-tmp_nints, container%current%data(1), full_array(tmp_nints+1)) - container%element_counter = 1+(nbits*(CACHE_SIZE-tmp_nints)+63)/64 + CALL bits2ints_specific(nbits, CACHE_SIZE - tmp_nints, container%current%data(1), full_array(tmp_nints + 1)) + container%element_counter = 1 + (nbits*(CACHE_SIZE - tmp_nints) + 63)/64 END IF END SUBROUTINE hfx_decompress_cache @@ -315,8 +315,8 @@ SUBROUTINE hfx_flush_last_cache(nbits, cache, container, memory_usage, use_disk_ IF (use_disk_storage) THEN IF (container%element_counter /= 1) THEN WRITE (container%unit) container%current%data - memory_usage = memory_usage+1 - container%file_counter = container%file_counter+1 + memory_usage = memory_usage + 1 + container%file_counter = container%file_counter + 1 END IF END IF END SUBROUTINE hfx_flush_last_cache @@ -354,49 +354,49 @@ SUBROUTINE hfx_add_mult_cache_elements(values, nints, nbits, cache, container, e eps_schwarz_inv = 1.0_dp/eps_schwarz factor = eps_schwarz/pmax_entry - shift = shifts(nbits-1) + shift = shifts(nbits - 1) start_idx = cache%element_counter - end_idx = start_idx+nints-1 + end_idx = start_idx + nints - 1 IF (end_idx < CACHE_SIZE) THEN DO i = 1, nints values(i) = values(i)*pmax_entry IF (ABS(values(i)) > eps_schwarz) THEN tmp = NINT(values(i)*eps_schwarz_inv, KIND=int_8) - cache%data(i+start_idx-1) = tmp+shift + cache%data(i + start_idx - 1) = tmp + shift values(i) = tmp*factor ELSE values(i) = 0.0_dp - cache%data(i+start_idx-1) = shift + cache%data(i + start_idx - 1) = shift END IF END DO - cache%element_counter = end_idx+1 + cache%element_counter = end_idx + 1 ELSE - tmp_elements = CACHE_SIZE-start_idx+1 + tmp_elements = CACHE_SIZE - start_idx + 1 DO i = 1, tmp_elements values(i) = values(i)*pmax_entry IF (ABS(values(i)) > eps_schwarz) THEN tmp = NINT(values(i)*eps_schwarz_inv, KIND=int_8) - cache%data(i+start_idx-1) = tmp+shift + cache%data(i + start_idx - 1) = tmp + shift values(i) = tmp*factor ELSE values(i) = 0.0_dp - cache%data(i+start_idx-1) = shift + cache%data(i + start_idx - 1) = shift END IF END DO CALL hfx_compress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage) - DO i = tmp_elements+1, nints + DO i = tmp_elements + 1, nints values(i) = values(i)*pmax_entry IF (ABS(values(i)) > eps_schwarz) THEN tmp = NINT(values(i)*eps_schwarz_inv, KIND=int_8) - cache%data(i-tmp_elements) = tmp+shift + cache%data(i - tmp_elements) = tmp + shift values(i) = tmp*factor ELSE values(i) = 0.0_dp - cache%data(i-tmp_elements) = shift + cache%data(i - tmp_elements) = shift END IF END DO - cache%element_counter = nints-tmp_elements+1 + cache%element_counter = nints - tmp_elements + 1 END IF END SUBROUTINE hfx_add_mult_cache_elements @@ -433,26 +433,26 @@ SUBROUTINE hfx_get_mult_cache_elements(values, nints, nbits, cache, container, e factor = eps_schwarz/pmax_entry - shift = shifts(nbits-1) + shift = shifts(nbits - 1) start_idx = cache%element_counter - end_idx = start_idx+nints-1 + end_idx = start_idx + nints - 1 IF (end_idx < CACHE_SIZE) THEN DO i = 1, nints - values(i) = factor*REAL(cache%data(i+start_idx-1)-shift, dp) + values(i) = factor*REAL(cache%data(i + start_idx - 1) - shift, dp) END DO - cache%element_counter = end_idx+1 + cache%element_counter = end_idx + 1 ELSE - tmp_elements = CACHE_SIZE-start_idx+1 + tmp_elements = CACHE_SIZE - start_idx + 1 DO i = 1, tmp_elements - values(i) = factor*REAL(cache%data(i+start_idx-1)-shift, dp) + values(i) = factor*REAL(cache%data(i + start_idx - 1) - shift, dp) END DO CALL hfx_decompress_cache(cache%data(1), container, nbits, memory_usage, use_disk_storage) - DO i = tmp_elements+1, nints - values(i) = factor*REAL(cache%data(i-tmp_elements)-shift, dp) + DO i = tmp_elements + 1, nints + values(i) = factor*REAL(cache%data(i - tmp_elements) - shift, dp) END DO - cache%element_counter = nints-tmp_elements+1 + cache%element_counter = nints - tmp_elements + 1 END IF END SUBROUTINE hfx_get_mult_cache_elements diff --git a/src/hfx_derivatives.F b/src/hfx_derivatives.F index 65a1e627e5..c9a9f9e250 100644 --- a/src/hfx_derivatives.F +++ b/src/hfx_derivatives.F @@ -247,7 +247,7 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & DO ikind = 1, nkind l_max = MAX(l_max, MAXVAL(qs_env%x_data(1, 1)%basis_parameter(ikind)%lmax)) ENDDO - l_max = 4*l_max+1 + l_max = 4*l_max + 1 CALL init_md_ftable(l_max) IF (qs_env%x_data(1, 1)%potential_parameter%potential_type == do_potential_truncated .OR. & @@ -365,7 +365,7 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & ln_10 = LOG(10.0_dp) log_2 = LOG10(2.0_dp) - actual_x_data => qs_env%x_data(irep, i_thread+1) + actual_x_data => qs_env%x_data(irep, i_thread + 1) do_periodic = actual_x_data%periodic_parameter%do_periodic screening_parameter = actual_x_data%screening_parameter @@ -432,7 +432,7 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & last_sgf_global(0) = 0 DO iatom = 1, natom ikind = kind_of(iatom) - last_sgf_global(iatom) = last_sgf_global(iatom-1)+basis_parameter(ikind)%nsgf_total + last_sgf_global(iatom) = last_sgf_global(iatom - 1) + basis_parameter(ikind)%nsgf_total END DO ALLOCATE (max_contraction(max_set, natom)) @@ -453,7 +453,7 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & sgfb = first_sgfb(1, jset) ! if the primitives are assumed to be all of max_val2, max_val2*p2s_b becomes ! the maximum value after multiplication with sphi_b - max_contraction(jset, jatom) = MAXVAL((/(SUM(ABS(sphi_b(1:ncob, i))), i=sgfb, sgfb+nsgfb(jset)-1)/)) + max_contraction(jset, jatom) = MAXVAL((/(SUM(ABS(sphi_b(1:ncob, i))), i=sgfb, sgfb + nsgfb(jset) - 1)/)) max_pgf = MAX(max_pgf, npgfb(jset)) ENDDO ENDDO @@ -482,7 +482,7 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & NULLIFY (full_density_alpha) NULLIFY (full_density_beta) - ALLOCATE (full_density_alpha(shm_block_offset(ncpu+1), nkimages)) + ALLOCATE (full_density_alpha(shm_block_offset(ncpu + 1), nkimages)) !! Get the full density from all the processors CALL timeset(routineN//"_getP", handle_getP) @@ -493,7 +493,7 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & ! for now only closed shell case IF (with_mp2_density) THEN NULLIFY (full_density_mp2) - ALLOCATE (full_density_mp2(shm_block_offset(ncpu+1))) + ALLOCATE (full_density_mp2(shm_block_offset(ncpu + 1))) CALL get_full_density(para_env, full_density_mp2, rho_ao_mp2(1)%matrix, shm_number_of_p_entries, & shm_block_offset, & kind_of, basis_parameter, get_max_vals_spin=.FALSE., & @@ -501,7 +501,7 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & END IF IF (nspins == 2) THEN - ALLOCATE (full_density_beta(shm_block_offset(ncpu+1), 1)) + ALLOCATE (full_density_beta(shm_block_offset(ncpu + 1), 1)) CALL get_full_density(para_env, full_density_beta(:, 1), rho_ao(2, 1)%matrix, shm_number_of_p_entries, & shm_block_offset, & kind_of, basis_parameter, get_max_vals_spin=.FALSE., & @@ -509,7 +509,7 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & ! With mp2 density IF (with_mp2_density) THEN NULLIFY (full_density_mp2_beta) - ALLOCATE (full_density_mp2_beta(shm_block_offset(ncpu+1))) + ALLOCATE (full_density_mp2_beta(shm_block_offset(ncpu + 1))) CALL get_full_density(para_env, full_density_mp2_beta, rho_ao_mp2(2)%matrix, shm_number_of_p_entries, & shm_block_offset, & kind_of, basis_parameter, get_max_vals_spin=.FALSE., & @@ -545,10 +545,10 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & ! restore as full density the HF density ! maybe in the future IF (with_mp2_density) THEN - full_density_alpha(:, 1) = full_density_alpha(:, 1)-full_density_mp2 + full_density_alpha(:, 1) = full_density_alpha(:, 1) - full_density_mp2 IF (nspins == 2) THEN full_density_beta(:, 1) = & - full_density_beta(:, 1)-full_density_mp2_beta + full_density_beta(:, 1) - full_density_mp2_beta ENDIF ! full_density_mp2=full_density+full_density_mp2 END IF @@ -776,13 +776,13 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & ! ** Lets construct the task list shm_total_bins = 0 DO i = 1, n_threads - shm_total_bins = shm_total_bins+SIZE(qs_env%x_data(irep, i)%distribution_forces) + shm_total_bins = shm_total_bins + SIZE(qs_env%x_data(irep, i)%distribution_forces) END DO ALLOCATE (tmp_task_list(shm_total_bins)) shm_task_counter = 0 DO i = 1, n_threads DO bin = 1, SIZE(qs_env%x_data(irep, i)%distribution_forces) - shm_task_counter = shm_task_counter+1 + shm_task_counter = shm_task_counter + 1 tmp_task_list(shm_task_counter)%thread_id = i tmp_task_list(shm_task_counter)%bin_id = bin tmp_task_list(shm_task_counter)%cost = qs_env%x_data(irep, i)%distribution_forces(bin)%cost @@ -802,7 +802,7 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & ALLOCATE (actual_x_data%task_list(shm_total_bins)) DO i = 1, shm_total_bins - actual_x_data%task_list(i) = tmp_task_list(tmp_index(shm_total_bins-i+1)) + actual_x_data%task_list(i) = tmp_task_list(tmp_index(shm_total_bins - i + 1)) END DO shm_task_list => actual_x_data%task_list @@ -856,7 +856,7 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & bin = 0 DO WHILE (bins_left) IF (.NOT. do_dynamic_load_balancing) THEN - bin = bin+1 + bin = bin + 1 IF (bin > my_bin_size) THEN do_it = .FALSE. bins_left = .FALSE. @@ -867,7 +867,7 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & END IF ELSE !$OMP CRITICAL(hfxderivatives_critical) - shm_task_counter = shm_task_counter+1 + shm_task_counter = shm_task_counter + 1 IF (shm_task_counter <= shm_total_bins) THEN my_thread_id = shm_task_list(shm_task_counter)%thread_id my_bin_id = shm_task_list(shm_task_counter)%bin_id @@ -900,17 +900,17 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & my_current_counter = 0 IF (distribution_forces%number_of_atom_quartets == 0 .OR. & my_istart == -1_int_8) my_istart = nblocks**4 - atomic_blocks: DO atom_block = my_istart, nblocks**4-1, n_processes - latom_block = INT(MODULO(atom_block, nblocks))+1 + atomic_blocks: DO atom_block = my_istart, nblocks**4 - 1, n_processes + latom_block = INT(MODULO(atom_block, nblocks)) + 1 tmp_block = atom_block/nblocks - katom_block = INT(MODULO(tmp_block, nblocks))+1 + katom_block = INT(MODULO(tmp_block, nblocks)) + 1 IF (latom_block < katom_block) CYCLE tmp_block = tmp_block/nblocks - jatom_block = INT(MODULO(tmp_block, nblocks))+1 + jatom_block = INT(MODULO(tmp_block, nblocks)) + 1 tmp_block = tmp_block/nblocks - iatom_block = INT(MODULO(tmp_block, nblocks))+1 + iatom_block = INT(MODULO(tmp_block, nblocks)) + 1 IF (jatom_block < iatom_block) CYCLE - my_current_counter = my_current_counter+1 + my_current_counter = my_current_counter + 1 IF (my_current_counter > distribution_forces%number_of_atom_quartets) EXIT atomic_blocks iatom_start = actual_x_data%blocks(iatom_block)%istart @@ -922,12 +922,12 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & latom_start = actual_x_data%blocks(latom_block)%istart latom_end = actual_x_data%blocks(latom_block)%iend - pmax_blocks = MAX(shm_pmax_block(katom_block, iatom_block)+ & + pmax_blocks = MAX(shm_pmax_block(katom_block, iatom_block) + & shm_pmax_block(latom_block, jatom_block), & - shm_pmax_block(latom_block, iatom_block)+ & + shm_pmax_block(latom_block, iatom_block) + & shm_pmax_block(katom_block, jatom_block)) - IF (2.0_dp*coeffs_kind_max0+pmax_blocks < log10_eps_schwarz) CYCLE + IF (2.0_dp*coeffs_kind_max0 + pmax_blocks < log10_eps_schwarz) CYCLE CALL build_pair_list(natom, list_ij, set_list_ij, iatom_start, iatom_end, & jatom_start, jatom_end, & @@ -989,8 +989,8 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & !All four centers equivalent => zero-contribution !VIIRAL IF((iatom==jatom .AND. iatom==katom .AND. iatom==latom)) CYCLE - IF (.NOT. (katom+latom <= iatom+jatom)) CYCLE - IF (((iatom+jatom) .EQ. (katom+latom)) .AND. (katom < iatom)) CYCLE + IF (.NOT. (katom + latom <= iatom + jatom)) CYCLE + IF (((iatom + jatom) .EQ. (katom + latom)) .AND. (katom < iatom)) CYCLE i_set_list_kl_start = list_kl%elements(i_list_kl)%set_bounds(1) i_set_list_kl_stop = list_kl%elements(i_list_kl)%set_bounds(2) @@ -1001,18 +1001,18 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & rcd2 = list_kl%elements(i_list_kl)%dist2 IF (screen_pmat_forces) THEN - pmax_atom = MAX(shm_pmax_atom(katom, iatom)+ & + pmax_atom = MAX(shm_pmax_atom(katom, iatom) + & shm_pmax_atom(latom, jatom), & - shm_pmax_atom(latom, iatom)+ & + shm_pmax_atom(latom, iatom) + & shm_pmax_atom(katom, jatom)) ELSE pmax_atom = 0.0_dp END IF - IF ((screen_coeffs_kind(jkind, ikind)%x(1)*rab2+ & - screen_coeffs_kind(jkind, ikind)%x(2))+ & - (screen_coeffs_kind(lkind, kkind)%x(1)*rcd2+ & - screen_coeffs_kind(lkind, kkind)%x(2))+pmax_atom < log10_eps_schwarz) CYCLE + IF ((screen_coeffs_kind(jkind, ikind)%x(1)*rab2 + & + screen_coeffs_kind(jkind, ikind)%x(2)) + & + (screen_coeffs_kind(lkind, kkind)%x(1)*rcd2 + & + screen_coeffs_kind(lkind, kkind)%x(2)) + pmax_atom < log10_eps_schwarz) CYCLE IF (.NOT. (shm_is_assoc_atomic_block(latom, iatom) >= 1 .AND. & shm_is_assoc_atomic_block(katom, iatom) >= 1 .AND. & @@ -1100,7 +1100,7 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & ptr_p_1 => shm_initial_p(kind_kind_idx)%p_kind(:, :, & actual_x_data%map_atom_to_kind_atom(iatom), & actual_x_data%map_atom_to_kind_atom(katom)) - swap_id = swap_id+1 + swap_id = swap_id + 1 END IF kind_kind_idx = INT(get_1D_idx(lkind, jkind, INT(nkind, int_8))) IF (jkind >= lkind) THEN @@ -1111,7 +1111,7 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & ptr_p_2 => shm_initial_p(kind_kind_idx)%p_kind(:, :, & actual_x_data%map_atom_to_kind_atom(jatom), & actual_x_data%map_atom_to_kind_atom(latom)) - swap_id = swap_id+2 + swap_id = swap_id + 2 END IF kind_kind_idx = INT(get_1D_idx(lkind, ikind, INT(nkind, int_8))) IF (ikind >= lkind) THEN @@ -1122,7 +1122,7 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & ptr_p_3 => shm_initial_p(kind_kind_idx)%p_kind(:, :, & actual_x_data%map_atom_to_kind_atom(iatom), & actual_x_data%map_atom_to_kind_atom(latom)) - swap_id = swap_id+4 + swap_id = swap_id + 4 END IF kind_kind_idx = INT(get_1D_idx(kkind, jkind, INT(nkind, int_8))) IF (jkind >= kkind) THEN @@ -1133,7 +1133,7 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & ptr_p_4 => shm_initial_p(kind_kind_idx)%p_kind(:, :, & actual_x_data%map_atom_to_kind_atom(jatom), & actual_x_data%map_atom_to_kind_atom(katom)) - swap_id = swap_id+8 + swap_id = swap_id + 8 END IF END IF @@ -1151,10 +1151,10 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & DO i = 1, n_threads !$OMP ATOMIC READ tmp_i4 = qs_env%x_data(irep, i)%memory_parameter%actual_memory_usage - mem_compression_counter = mem_compression_counter+ & + mem_compression_counter = mem_compression_counter + & tmp_i4*memory_parameter%cache_size END DO - IF (mem_compression_counter+memory_parameter%final_comp_counter_energy & + IF (mem_compression_counter + memory_parameter%final_comp_counter_energy & > memory_parameter%max_compression_counter) THEN buffer_overflow = .TRUE. IF (do_dynamic_load_balancing) THEN @@ -1163,7 +1163,7 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & memory_parameter%ram_counter_forces = counter END IF ELSE - counter = counter+1 + counter = counter + 1 buffer_overflow = .FALSE. END IF END IF @@ -1173,14 +1173,14 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & IF (distribution_forces%ram_counter == counter) THEN buffer_overflow = .TRUE. ELSE - counter = counter+1 + counter = counter + 1 buffer_overflow = .FALSE. END IF ELSE IF (memory_parameter%ram_counter_forces == counter) THEN buffer_overflow = .TRUE. ELSE - counter = counter+1 + counter = counter + 1 buffer_overflow = .FALSE. END IF END IF @@ -1192,11 +1192,11 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & jset = set_list_ij(i_set_list_ij)%pair(2) ncob = npgfb(jset)*ncoset(lb_max(jset)) - max_val1 = screen_coeffs_set(jset, iset, jkind, ikind)%x(1)*rab2+ & + max_val1 = screen_coeffs_set(jset, iset, jkind, ikind)%x(1)*rab2 + & screen_coeffs_set(jset, iset, jkind, ikind)%x(2) !! Near field screening - IF (max_val1+(screen_coeffs_kind(lkind, kkind)%x(1)*rcd2+ & - screen_coeffs_kind(lkind, kkind)%x(2))+pmax_atom < log10_eps_schwarz) CYCLE + IF (max_val1 + (screen_coeffs_kind(lkind, kkind)%x(1)*rcd2 + & + screen_coeffs_kind(lkind, kkind)%x(2)) + pmax_atom < log10_eps_schwarz) CYCLE sphi_a_ext_set => sphi_a_ext(:, :, :, iset) sphi_b_ext_set => sphi_b_ext(:, :, :, jset) @@ -1204,12 +1204,12 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & kset = set_list_kl(i_set_list_kl)%pair(1) lset = set_list_kl(i_set_list_kl)%pair(2) - max_val2_set = (screen_coeffs_set(lset, kset, lkind, kkind)%x(1)*rcd2+ & + max_val2_set = (screen_coeffs_set(lset, kset, lkind, kkind)%x(1)*rcd2 + & screen_coeffs_set(lset, kset, lkind, kkind)%x(2)) - max_val2 = max_val1+max_val2_set + max_val2 = max_val1 + max_val2_set !! Near field screening - IF (max_val2+pmax_atom < log10_eps_schwarz) CYCLE + IF (max_val2 + pmax_atom < log10_eps_schwarz) CYCLE sphi_c_ext_set => sphi_c_ext(:, :, :, kset) sphi_d_ext_set => sphi_d_ext(:, :, :, lset) @@ -1218,19 +1218,19 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & iset, jset, kset, lset, & pmax_tmp, swap_id) - log10_pmax = log_2+pmax_tmp + log10_pmax = log_2 + pmax_tmp ELSE log10_pmax = 0.0_dp END IF - max_val2 = max_val2+log10_pmax + max_val2 = max_val2 + log10_pmax IF (max_val2 < log10_eps_schwarz) CYCLE pmax_entry = EXP(log10_pmax*ln_10) !! store current number of integrals, update total number and number of integrals in buffer current_counter = nsgfa(iset)*nsgfb(jset)*nsgfc(kset)*nsgfd(lset)*12 IF (buffer_overflow) THEN - neris_onthefly = neris_onthefly+current_counter + neris_onthefly = neris_onthefly + current_counter END IF !! Get integrals from buffer and update Kohn-Sham matrix @@ -1239,15 +1239,15 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & CALL hfx_get_single_cache_element(estimate_to_store_int, 6, & maxval_cache, maxval_container, memory_parameter%actual_memory_usage, & use_disk_storage) - spherical_estimate = SET_EXPONENT(1.0_dp, estimate_to_store_int+1) + spherical_estimate = SET_EXPONENT(1.0_dp, estimate_to_store_int + 1) ! IF (spherical_estimate*pmax_entry < eps_schwarz) CYCLE IF (.NOT. use_virial) THEN IF (spherical_estimate*pmax_entry < eps_schwarz) CYCLE END IF - nbits = EXPONENT(ANINT(spherical_estimate*pmax_entry/eps_storage))+1 + nbits = EXPONENT(ANINT(spherical_estimate*pmax_entry/eps_storage)) + 1 buffer_left = nints buffer_start = 1 - neris_incore = neris_incore+INT(nints, int_8) + neris_incore = neris_incore + INT(nints, int_8) DO WHILE (buffer_left > 0) buffer_size = MIN(buffer_left, cache_size) CALL hfx_get_mult_cache_elements(primitive_forces(buffer_start), & @@ -1257,8 +1257,8 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & eps_storage, pmax_entry, & memory_parameter%actual_memory_usage, & use_disk_storage) - buffer_left = buffer_left-buffer_size - buffer_start = buffer_start+buffer_size + buffer_left = buffer_left - buffer_size + buffer_start = buffer_start + buffer_size END DO END IF !! Calculate integrals if we run out of buffer or the geometry did change @@ -1300,8 +1300,8 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & ede_primitives_tmp_virial, primitive_forces_virial, cartesian_estimate_virial) nints = nsgfa(iset)*nsgfb(jset)*nsgfc(kset)*nsgfd(lset)*12 - neris_total = neris_total+nints - nprim_ints = nprim_ints+neris_tmp + neris_total = neris_total + nints + nprim_ints = nprim_ints + neris_tmp ! IF (cartesian_estimate == 0.0_dp) cartesian_estimate = TINY(cartesian_estimate) ! estimate_to_store_int = EXPONENT(cartesian_estimate) ! estimate_to_store_int = MAX(estimate_to_store_int, -15_int_8) @@ -1341,16 +1341,16 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & memory_parameter%actual_memory_usage, & use_disk_storage, max_val_memory) END IF - spherical_estimate = SET_EXPONENT(1.0_dp, estimate_to_store_int+1) + spherical_estimate = SET_EXPONENT(1.0_dp, estimate_to_store_int + 1) IF (.NOT. use_virial) THEN IF (spherical_estimate*pmax_entry < eps_schwarz) CYCLE END IF IF (.NOT. buffer_overflow) THEN - nbits = EXPONENT(ANINT(spherical_estimate*pmax_entry/eps_storage))+1 + nbits = EXPONENT(ANINT(spherical_estimate*pmax_entry/eps_storage)) + 1 buffer_left = nints buffer_start = 1 ! neris_incore = neris_incore+nints - neris_incore = neris_incore+INT(nints, int_8) + neris_incore = neris_incore + INT(nints, int_8) DO WHILE (buffer_left > 0) buffer_size = MIN(buffer_left, CACHE_SIZE) @@ -1361,8 +1361,8 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & eps_storage, pmax_entry, & memory_parameter%actual_memory_usage, & use_disk_storage) - buffer_left = buffer_left-buffer_size - buffer_start = buffer_start+buffer_size + buffer_left = buffer_left - buffer_size + buffer_start = buffer_start + buffer_size END DO ELSE !! In order to be consistent with in-core part, round all the eris wrt. eps_schwarz @@ -1425,7 +1425,7 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & END IF IF (spherical_estimate*pmax_entry >= eps_schwarz) THEN DO coord = 1, 12 - T2 => primitive_forces((coord-1)*nsgfa(iset)*nsgfb(jset)*nsgfc(kset)*nsgfd(lset)+1: & + T2 => primitive_forces((coord - 1)*nsgfa(iset)*nsgfb(jset)*nsgfc(kset)*nsgfd(lset) + 1: & coord*nsgfa(iset)*nsgfb(jset)*nsgfc(kset)*nsgfd(lset)) IF (with_mp2_density) THEN @@ -1457,8 +1457,8 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & DO coord = 1, 12 DO i = 1, 3 T2 => primitive_forces_virial( & - ((i-1)*12+coord-1)*nsgfa(iset)*nsgfb(jset)*nsgfc(kset)*nsgfd(lset)+1: & - ((i-1)*12+coord)*nsgfa(iset)*nsgfb(jset)*nsgfc(kset)*nsgfd(lset)) + ((i - 1)*12 + coord - 1)*nsgfa(iset)*nsgfb(jset)*nsgfc(kset)*nsgfd(lset) + 1: & + ((i - 1)*12 + coord)*nsgfa(iset)*nsgfb(jset)*nsgfc(kset)*nsgfd(lset)) IF (with_mp2_density) THEN CALL update_virial(nsgfa(iset), nsgfb(jset), nsgfc(kset), nsgfd(lset), & pbd_buf, pbc_buf, pad_buf, pac_buf, fac, & @@ -1491,7 +1491,7 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & END DO !i_list_ij END DO atomic_blocks bintime_stop = m_walltime() - distribution_forces%time_forces = bintime_stop-bintime_start + distribution_forces%time_forces = bintime_stop - bintime_start !$OMP MASTER CALL timestop(handle_bin) !$OMP END MASTER @@ -1525,7 +1525,7 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & DO j = 1, 3 DO k = 1, 3 !$OMP ATOMIC - virial%pv_fock_4c(i, j) = virial%pv_fock_4c(i, j)+tmp_virial(i, k)*cell%hmat(j, k) + virial%pv_fock_4c(i, j) = virial%pv_fock_4c(i, j) + tmp_virial(i, k)*cell%hmat(j, k) END DO END DO END DO @@ -1534,21 +1534,21 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & !$OMP BARRIER !! Get some number about ERIS !$OMP ATOMIC - shm_neris_total = shm_neris_total+neris_total + shm_neris_total = shm_neris_total + neris_total !$OMP ATOMIC - shm_neris_onthefly = shm_neris_onthefly+neris_onthefly + shm_neris_onthefly = shm_neris_onthefly + neris_onthefly !$OMP ATOMIC - shm_nprim_ints = shm_nprim_ints+nprim_ints + shm_nprim_ints = shm_nprim_ints + nprim_ints storage_counter_integrals = memory_parameter%actual_memory_usage* & memory_parameter%cache_size stor_count_max_val = max_val_memory*memory_parameter%cache_size !$OMP ATOMIC - shm_storage_counter_integrals = shm_storage_counter_integrals+storage_counter_integrals + shm_storage_counter_integrals = shm_storage_counter_integrals + storage_counter_integrals !$OMP ATOMIC - shm_neris_incore = shm_neris_incore+neris_incore + shm_neris_incore = shm_neris_incore + neris_incore !$OMP ATOMIC - shm_stor_count_max_val = shm_stor_count_max_val+stor_count_max_val + shm_stor_count_max_val = shm_stor_count_max_val + stor_count_max_val !$OMP BARRIER ! IF(with_mp2_density) THEN @@ -1569,9 +1569,9 @@ SUBROUTINE derivatives_four_center(qs_env, rho_ao, hfx_section, para_env, & shm_neris_total = tmp_i8(4) shm_nprim_ints = tmp_i8(5) shm_stor_count_max_val = tmp_i8(6) - mem_eris = (shm_storage_counter_integrals+128*1024-1)/1024/128 + mem_eris = (shm_storage_counter_integrals + 128*1024 - 1)/1024/128 compression_factor = REAL(shm_neris_incore, dp)/REAL(shm_storage_counter_integrals, dp) - mem_max_val = (shm_stor_count_max_val+128*1024-1)/1024/128 + mem_max_val = (shm_stor_count_max_val + 128*1024 - 1)/1024/128 IF (shm_neris_incore == 0) THEN mem_eris = 0 @@ -1898,7 +1898,7 @@ SUBROUTINE forces4(deriv, ra, rb, rc, rd, npgfa, npgfb, npgfc, npgfd, & cart_estimate_virial = 0.0_dp END IF neris_tmp = 0_int_8 - max_l = la_max+lb_max+lc_max+ld_max+1 + max_l = la_max + lb_max + lc_max + ld_max + 1 DO list_ij = 1, nelements_ij Zeta_A = pgf_list_ij(list_ij)%zeta Zeta_B = pgf_list_ij(list_ij)%zetb @@ -1950,23 +1950,23 @@ SUBROUTINE forces4(deriv, ra, rb, rc, rd, npgfa, npgfb, npgfc, npgfd, & Zeta_A, Zeta_B, Zeta_C, Zeta_D, ZetaInv, EtaInv, & s_offset_a, s_offset_b, s_offset_c, s_offset_d, & nsgfla, nsgflb, nsgflc, nsgfld, nsoa, nsob, nsoc, nsod, & - sphi_a_ext(1, la+1, ipgf), & - sphi_b_ext(1, lb+1, jpgf), & - sphi_c_ext(1, lc+1, kpgf), & - sphi_d_ext(1, ld+1, lpgf), & + sphi_a_ext(1, la + 1, ipgf), & + sphi_b_ext(1, lb + 1, jpgf), & + sphi_c_ext(1, lc + 1, kpgf), & + sphi_d_ext(1, ld + 1, lpgf), & ede_work, ede_work2, ede_work_forces, & ede_buffer1, ede_buffer2, ede_primitives_tmp, use_virial, & ede_work_virial, ede_work2_virial, ede_primitives_tmp_virial, & primitive_integrals_virial, cell, tmp_max_virial) cart_estimate = MAX(tmp_max, cart_estimate) IF (use_virial) cart_estimate_virial = MAX(tmp_max_virial, cart_estimate_virial) - s_offset_d = s_offset_d+nsod*nsgfld + s_offset_d = s_offset_d + nsod*nsgfld END DO !ld - s_offset_c = s_offset_c+nsoc*nsgflc + s_offset_c = s_offset_c + nsoc*nsgflc END DO !lc - s_offset_b = s_offset_b+nsob*nsgflb + s_offset_b = s_offset_b + nsob*nsgflb END DO !lb - s_offset_a = s_offset_a+nsoa*nsgfla + s_offset_a = s_offset_a + nsoa*nsgfla END DO !la END DO END DO @@ -1994,7 +1994,7 @@ PURE FUNCTION get_1D_idx(i, j, N) INTEGER(int_8) :: min_ij min_ij = MIN(i, j) - get_1D_idx = min_ij*N+MAX(i, j)-(min_ij-1)*min_ij/2-N + get_1D_idx = min_ij*N + MAX(i, j) - (min_ij - 1)*min_ij/2 - N END FUNCTION get_1D_idx @@ -2058,93 +2058,93 @@ SUBROUTINE prefetch_density_matrix(ma_max, mb_max, mc_max, md_max, & IF (anti_symmetric) fac = -1.0_dp IF (jatom >= latom) THEN i = 1 - offset_bd = offset_bd_set(jset, lset)+atomic_offset_bd-1 + offset_bd = offset_bd_set(jset, lset) + atomic_offset_bd - 1 j = offset_bd DO md = 1, md_max DO mb = 1, mb_max pbd(i) = density(j)*fac - i = i+1 - j = j+1 + i = i + 1 + j = j + 1 END DO END DO ELSE i = 1 - offset_bd = offset_bd_set(lset, jset)+atomic_offset_bd-1 + offset_bd = offset_bd_set(lset, jset) + atomic_offset_bd - 1 DO md = 1, md_max - j = offset_bd+md-1 + j = offset_bd + md - 1 DO mb = 1, mb_max pbd(i) = density(j) - i = i+1 - j = j+md_max + i = i + 1 + j = j + md_max END DO END DO END IF IF (jatom >= katom) THEN i = 1 - offset_bc = offset_bc_set(jset, kset)+atomic_offset_bc-1 + offset_bc = offset_bc_set(jset, kset) + atomic_offset_bc - 1 j = offset_bc DO mc = 1, mc_max DO mb = 1, mb_max pbc(i) = density(j)*fac - i = i+1 - j = j+1 + i = i + 1 + j = j + 1 END DO END DO ELSE i = 1 - offset_bc = offset_bc_set(kset, jset)+atomic_offset_bc-1 + offset_bc = offset_bc_set(kset, jset) + atomic_offset_bc - 1 DO mc = 1, mc_max - j = offset_bc+mc-1 + j = offset_bc + mc - 1 DO mb = 1, mb_max pbc(i) = density(j) - i = i+1 - j = j+mc_max + i = i + 1 + j = j + mc_max END DO END DO END IF IF (iatom >= latom) THEN i = 1 - offset_ad = offset_ad_set(iset, lset)+atomic_offset_ad-1 + offset_ad = offset_ad_set(iset, lset) + atomic_offset_ad - 1 j = offset_ad DO md = 1, md_max DO ma = 1, ma_max pad(i) = density(j)*fac - i = i+1 - j = j+1 + i = i + 1 + j = j + 1 END DO END DO ELSE i = 1 - offset_ad = offset_ad_set(lset, iset)+atomic_offset_ad-1 + offset_ad = offset_ad_set(lset, iset) + atomic_offset_ad - 1 DO md = 1, md_max - j = offset_ad+md-1 + j = offset_ad + md - 1 DO ma = 1, ma_max pad(i) = density(j) - i = i+1 - j = j+md_max + i = i + 1 + j = j + md_max END DO END DO END IF IF (iatom >= katom) THEN i = 1 - offset_ac = offset_ac_set(iset, kset)+atomic_offset_ac-1 + offset_ac = offset_ac_set(iset, kset) + atomic_offset_ac - 1 j = offset_ac DO mc = 1, mc_max DO ma = 1, ma_max pac(i) = density(j)*fac - i = i+1 - j = j+1 + i = i + 1 + j = j + 1 END DO END DO ELSE i = 1 - offset_ac = offset_ac_set(kset, iset)+atomic_offset_ac-1 + offset_ac = offset_ac_set(kset, iset) + atomic_offset_ac - 1 DO mc = 1, mc_max - j = offset_ac+mc-1 + j = offset_ac + mc - 1 DO ma = 1, ma_max pac(i) = density(j) - i = i+1 - j = j+mc_max + i = i + 1 + j = j + mc_max END DO END DO END IF @@ -2204,22 +2204,22 @@ SUBROUTINE update_forces(ma_max, mb_max, mc_max, md_max, & DO md = 1, md_max DO mc = 1, mc_max DO mb = 1, mb_max - temp1 = pbc((mc-1)*mb_max+mb)*fac - temp3 = pbd((md-1)*mb_max+mb)*fac - temp1_mp2 = pbc_mp2((mc-1)*mb_max+mb)*fac - temp3_mp2 = pbd_mp2((md-1)*mb_max+mb)*fac + temp1 = pbc((mc - 1)*mb_max + mb)*fac + temp3 = pbd((md - 1)*mb_max + mb)*fac + temp1_mp2 = pbc_mp2((mc - 1)*mb_max + mb)*fac + temp3_mp2 = pbd_mp2((md - 1)*mb_max + mb)*fac DO ma = 1, ma_max - p_index = p_index+1 + p_index = p_index + 1 ! HF-SCF - temp2 = temp1*pad((md-1)*ma_max+ma)+ & - temp3*pac((mc-1)*ma_max+ma) + temp2 = temp1*pad((md - 1)*ma_max + ma) + & + temp3*pac((mc - 1)*ma_max + ma) ! MP2+HF - temp2 = temp2+ & - pac((mc-1)*ma_max+ma)*temp3_mp2+ & - pac_mp2((mc-1)*ma_max+ma)*temp3+ & - pad((md-1)*ma_max+ma)*temp1_mp2+ & - pad_mp2((md-1)*ma_max+ma)*temp1 - temp4 = temp4+temp2*prim(p_index) + temp2 = temp2 + & + pac((mc - 1)*ma_max + ma)*temp3_mp2 + & + pac_mp2((mc - 1)*ma_max + ma)*temp3 + & + pad((md - 1)*ma_max + ma)*temp1_mp2 + & + pad_mp2((md - 1)*ma_max + ma)*temp1 + temp4 = temp4 + temp2*prim(p_index) END DO !ma END DO !mb END DO !mc @@ -2230,13 +2230,13 @@ SUBROUTINE update_forces(ma_max, mb_max, mc_max, md_max, & DO md = 1, md_max DO mc = 1, mc_max DO mb = 1, mb_max - temp1 = pbc((mc-1)*mb_max+mb)*fac - temp3 = pbd((md-1)*mb_max+mb)*fac + temp1 = pbc((mc - 1)*mb_max + mb)*fac + temp3 = pbd((md - 1)*mb_max + mb)*fac DO ma = 1, ma_max - p_index = p_index+1 - temp2 = temp1*pad((md-1)*ma_max+ma)+ & - temp3*pac((mc-1)*ma_max+ma) - temp4 = temp4+temp2*prim(p_index) + p_index = p_index + 1 + temp2 = temp1*pad((md - 1)*ma_max + ma) + & + temp3*pac((mc - 1)*ma_max + ma) + temp4 = temp4 + temp2*prim(p_index) END DO !ma END DO !mb END DO !mc @@ -2244,10 +2244,10 @@ SUBROUTINE update_forces(ma_max, mb_max, mc_max, md_max, & END IF !$OMP ATOMIC - force(forces_map((coord-1)/3+1, 1))%fock_4c(MOD(coord-1, 3)+1, & - forces_map((coord-1)/3+1, 2)) = & - force(forces_map((coord-1)/3+1, 1))%fock_4c(MOD(coord-1, 3)+1, & - forces_map((coord-1)/3+1, 2))- & + force(forces_map((coord - 1)/3 + 1, 1))%fock_4c(MOD(coord - 1, 3) + 1, & + forces_map((coord - 1)/3 + 1, 2)) = & + force(forces_map((coord - 1)/3 + 1, 1))%fock_4c(MOD(coord - 1, 3) + 1, & + forces_map((coord - 1)/3 + 1, 2)) - & temp4 END SUBROUTINE update_forces @@ -2306,22 +2306,22 @@ SUBROUTINE update_virial(ma_max, mb_max, mc_max, md_max, & DO md = 1, md_max DO mc = 1, mc_max DO mb = 1, mb_max - temp1 = pbc((mc-1)*mb_max+mb)*fac - temp3 = pbd((md-1)*mb_max+mb)*fac - temp1_mp2 = pbc_mp2((mc-1)*mb_max+mb)*fac - temp3_mp2 = pbd_mp2((md-1)*mb_max+mb)*fac + temp1 = pbc((mc - 1)*mb_max + mb)*fac + temp3 = pbd((md - 1)*mb_max + mb)*fac + temp1_mp2 = pbc_mp2((mc - 1)*mb_max + mb)*fac + temp3_mp2 = pbd_mp2((md - 1)*mb_max + mb)*fac DO ma = 1, ma_max - p_index = p_index+1 + p_index = p_index + 1 ! HF-SCF - temp2 = temp1*pad((md-1)*ma_max+ma)+ & - temp3*pac((mc-1)*ma_max+ma) + temp2 = temp1*pad((md - 1)*ma_max + ma) + & + temp3*pac((mc - 1)*ma_max + ma) ! MP2+HF - temp2 = temp2+ & - pac((mc-1)*ma_max+ma)*temp3_mp2+ & - pac_mp2((mc-1)*ma_max+ma)*temp3+ & - pad((md-1)*ma_max+ma)*temp1_mp2+ & - pad_mp2((md-1)*ma_max+ma)*temp1 - temp4 = temp4+temp2*prim(p_index) + temp2 = temp2 + & + pac((mc - 1)*ma_max + ma)*temp3_mp2 + & + pac_mp2((mc - 1)*ma_max + ma)*temp3 + & + pad((md - 1)*ma_max + ma)*temp1_mp2 + & + pad_mp2((md - 1)*ma_max + ma)*temp1 + temp4 = temp4 + temp2*prim(p_index) END DO !ma END DO !mb END DO !mc @@ -2332,13 +2332,13 @@ SUBROUTINE update_virial(ma_max, mb_max, mc_max, md_max, & DO md = 1, md_max DO mc = 1, mc_max DO mb = 1, mb_max - temp1 = pbc((mc-1)*mb_max+mb)*fac - temp3 = pbd((md-1)*mb_max+mb)*fac + temp1 = pbc((mc - 1)*mb_max + mb)*fac + temp3 = pbd((md - 1)*mb_max + mb)*fac DO ma = 1, ma_max - p_index = p_index+1 - temp2 = temp1*pad((md-1)*ma_max+ma)+ & - temp3*pac((mc-1)*ma_max+ma) - temp4 = temp4+temp2*prim(p_index) + p_index = p_index + 1 + temp2 = temp1*pad((md - 1)*ma_max + ma) + & + temp3*pac((mc - 1)*ma_max + ma) + temp4 = temp4 + temp2*prim(p_index) END DO !ma END DO !mb END DO !mc @@ -2346,8 +2346,8 @@ SUBROUTINE update_virial(ma_max, mb_max, mc_max, md_max, & END IF j = l - i = MOD(coord-1, 3)+1 - tmp_virial(i, j) = tmp_virial(i, j)-temp4 + i = MOD(coord - 1, 3) + 1 + tmp_virial(i, j) = tmp_virial(i, j) - temp4 END SUBROUTINE update_virial #include "hfx_get_pmax_val.f90" diff --git a/src/hfx_energy_potential.F b/src/hfx_energy_potential.F index 682fbec907..e1e6acf5a9 100644 --- a/src/hfx_energy_potential.F +++ b/src/hfx_energy_potential.F @@ -411,7 +411,7 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se i_thread = 0 !$ i_thread = omp_get_thread_num() - actual_x_data => x_data(irep, i_thread+1) + actual_x_data => x_data(irep, i_thread + 1) !$OMP MASTER shm_master_x_data => x_data(irep, 1) !$OMP END MASTER @@ -541,7 +541,7 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se sgfb = first_sgfb(1, jset) ! if the primitives are assumed to be all of max_val2, max_val2*p2s_b becomes ! the maximum value after multiplication with sphi_b - max_contraction(jset, jatom) = MAXVAL((/(SUM(ABS(sphi_b(1:ncob, i))), i=sgfb, sgfb+nsgfb(jset)-1)/)) + max_contraction(jset, jatom) = MAXVAL((/(SUM(ABS(sphi_b(1:ncob, i))), i=sgfb, sgfb + nsgfb(jset) - 1)/)) max_pgf = MAX(max_pgf, npgfb(jset)) ENDDO ENDDO @@ -607,45 +607,45 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se ! ** Reset storage counter given by MAX_MEMORY by subtracting all buffers ! ** Fock and density Matrices (shared) - subtr_size_mb = 2_int_8*shm_block_offset(ncpu+1) + subtr_size_mb = 2_int_8*shm_block_offset(ncpu + 1) ! ** if non restricted ==> alpha/beta spin IF (.NOT. treat_lsd_in_core) THEN IF (nspins == 2) subtr_size_mb = subtr_size_mb*2_int_8 END IF ! ** Initial P only MAX(alpha,beta) (shared) IF (do_p_screening .OR. screening_parameter%do_p_screening_forces) THEN - subtr_size_mb = subtr_size_mb+memory_parameter%size_p_screen + subtr_size_mb = subtr_size_mb + memory_parameter%size_p_screen END IF ! ** In core forces require their own initial P IF (screening_parameter%do_p_screening_forces) THEN IF (memory_parameter%treat_forces_in_core) THEN - subtr_size_mb = subtr_size_mb+memory_parameter%size_p_screen + subtr_size_mb = subtr_size_mb + memory_parameter%size_p_screen END IF END IF ! ** primitive buffer (not shared by the threads) - subtr_size_mb = subtr_size_mb+nsgf_max**4*n_threads + subtr_size_mb = subtr_size_mb + nsgf_max**4*n_threads ! ** density + fock buffers - subtr_size_mb = subtr_size_mb+8_int_8*nsgf_max**2*n_threads + subtr_size_mb = subtr_size_mb + 8_int_8*nsgf_max**2*n_threads ! ** screening functions (shared) ! ** coeffs_pgf - subtr_size_mb = subtr_size_mb+max_pgf**2*max_set**2*nkind**2 + subtr_size_mb = subtr_size_mb + max_pgf**2*max_set**2*nkind**2 ! ** coeffs_set - subtr_size_mb = subtr_size_mb+max_set**2*nkind**2 + subtr_size_mb = subtr_size_mb + max_set**2*nkind**2 ! ** coeffs_kind - subtr_size_mb = subtr_size_mb+nkind**2 + subtr_size_mb = subtr_size_mb + nkind**2 ! ** radii_pgf - subtr_size_mb = subtr_size_mb+max_pgf**2*max_set**2*nkind**2 + subtr_size_mb = subtr_size_mb + max_pgf**2*max_set**2*nkind**2 ! ** is_assoc (shared) - subtr_size_mb = subtr_size_mb+natom**2 + subtr_size_mb = subtr_size_mb + natom**2 ! ** pmax_atom (shared) IF (do_p_screening) THEN - subtr_size_mb = subtr_size_mb+natom**2 + subtr_size_mb = subtr_size_mb + natom**2 END IF IF (screening_parameter%do_p_screening_forces) THEN IF (memory_parameter%treat_forces_in_core) THEN - subtr_size_mb = subtr_size_mb+natom**2 + subtr_size_mb = subtr_size_mb + natom**2 END IF END IF @@ -714,14 +714,14 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se last_sgf_global(0) = 0 DO iatom = 1, natom ikind = kind_of(iatom) - last_sgf_global(iatom) = last_sgf_global(iatom-1)+basis_parameter(ikind)%nsgf_total + last_sgf_global(iatom) = last_sgf_global(iatom - 1) + basis_parameter(ikind)%nsgf_total END DO !$OMP BARRIER !$OMP MASTER !! Let master thread get the density (avoid problems with MPI) !! Get the full density from all the processors NULLIFY (full_density_alpha, full_density_beta) - ALLOCATE (full_density_alpha(shm_block_offset(ncpu+1), nkimages)) + ALLOCATE (full_density_alpha(shm_block_offset(ncpu + 1), nkimages)) IF (.NOT. treat_lsd_in_core .OR. nspins == 1) THEN CALL timeset(routineN//"_getP", handle_getP) DO img = 1, nkimages @@ -731,7 +731,7 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se END DO IF (nspins == 2) THEN - ALLOCATE (full_density_beta(shm_block_offset(ncpu+1), nkimages)) + ALLOCATE (full_density_beta(shm_block_offset(ncpu + 1), nkimages)) DO img = 1, nkimages CALL get_full_density(para_env, full_density_beta(:, img), rho_ao(2, img)%matrix, shm_number_of_p_entries, & shm_master_x_data%block_offset, & @@ -796,13 +796,13 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se END IF NULLIFY (full_ks_alpha, full_ks_beta) - ALLOCATE (shm_master_x_data%full_ks_alpha(shm_block_offset(ncpu+1), nkimages)) + ALLOCATE (shm_master_x_data%full_ks_alpha(shm_block_offset(ncpu + 1), nkimages)) full_ks_alpha => shm_master_x_data%full_ks_alpha full_ks_alpha = 0.0_dp IF (.NOT. treat_lsd_in_core) THEN IF (nspins == 2) THEN - ALLOCATE (shm_master_x_data%full_ks_beta(shm_block_offset(ncpu+1), nkimages)) + ALLOCATE (shm_master_x_data%full_ks_beta(shm_block_offset(ncpu + 1), nkimages)) full_ks_beta => shm_master_x_data%full_ks_beta full_ks_beta = 0.0_dp END IF @@ -988,13 +988,13 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se ! ** Lets construct the task list shm_total_bins = 0 DO i = 1, n_threads - shm_total_bins = shm_total_bins+SIZE(x_data(irep, i)%distribution_energy) + shm_total_bins = shm_total_bins + SIZE(x_data(irep, i)%distribution_energy) END DO ALLOCATE (tmp_task_list(shm_total_bins)) shm_task_counter = 0 DO i = 1, n_threads DO bin = 1, SIZE(x_data(irep, i)%distribution_energy) - shm_task_counter = shm_task_counter+1 + shm_task_counter = shm_task_counter + 1 tmp_task_list(shm_task_counter)%thread_id = i tmp_task_list(shm_task_counter)%bin_id = bin tmp_task_list(shm_task_counter)%cost = x_data(irep, i)%distribution_energy(bin)%cost @@ -1014,7 +1014,7 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se ALLOCATE (shm_master_x_data%task_list(shm_total_bins)) DO i = 1, shm_total_bins - shm_master_x_data%task_list(i) = tmp_task_list(tmp_index(shm_total_bins-i+1)) + shm_master_x_data%task_list(i) = tmp_task_list(tmp_index(shm_total_bins - i + 1)) END DO shm_task_list => shm_master_x_data%task_list @@ -1087,7 +1087,7 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se bin = 0 DO WHILE (bins_left) IF (.NOT. do_dynamic_load_balancing) THEN - bin = bin+1 + bin = bin + 1 IF (bin > my_bin_size) THEN do_it = .FALSE. bins_left = .FALSE. @@ -1098,7 +1098,7 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se END IF ELSE !$OMP CRITICAL(hfxenergy_critical) - shm_task_counter = shm_task_counter+1 + shm_task_counter = shm_task_counter + 1 IF (shm_task_counter <= shm_total_bins) THEN my_thread_id = shm_task_list(shm_task_counter)%thread_id my_bin_id = shm_task_list(shm_task_counter)%bin_id @@ -1131,17 +1131,17 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se my_current_counter = 0 IF (distribution_energy%number_of_atom_quartets == 0 .OR. & my_istart == -1_int_8) my_istart = nblocks**4 - atomic_blocks: DO atom_block = my_istart, nblocks**4-1, n_processes - latom_block = INT(MODULO(atom_block, nblocks))+1 + atomic_blocks: DO atom_block = my_istart, nblocks**4 - 1, n_processes + latom_block = INT(MODULO(atom_block, nblocks)) + 1 tmp_block = atom_block/nblocks - katom_block = INT(MODULO(tmp_block, nblocks))+1 + katom_block = INT(MODULO(tmp_block, nblocks)) + 1 IF (latom_block < katom_block) CYCLE tmp_block = tmp_block/nblocks - jatom_block = INT(MODULO(tmp_block, nblocks))+1 + jatom_block = INT(MODULO(tmp_block, nblocks)) + 1 tmp_block = tmp_block/nblocks - iatom_block = INT(MODULO(tmp_block, nblocks))+1 + iatom_block = INT(MODULO(tmp_block, nblocks)) + 1 IF (jatom_block < iatom_block) CYCLE - my_current_counter = my_current_counter+1 + my_current_counter = my_current_counter + 1 IF (my_current_counter > distribution_energy%number_of_atom_quartets) EXIT atomic_blocks iatom_start = actual_x_data%blocks(iatom_block)%istart @@ -1158,7 +1158,7 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se shm_pmax_block(latom_block, iatom_block), & shm_pmax_block(katom_block, jatom_block)) - IF (2.0_dp*coeffs_kind_max0+pmax_blocks < log10_eps_schwarz) CYCLE + IF (2.0_dp*coeffs_kind_max0 + pmax_blocks < log10_eps_schwarz) CYCLE CALL build_pair_list(natom, list_ij, set_list_ij, iatom_start, iatom_end, & jatom_start, jatom_end, & @@ -1214,8 +1214,8 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se katom = list_kl%elements(i_list_kl)%pair(1) latom = list_kl%elements(i_list_kl)%pair(2) - IF (.NOT. (katom+latom <= iatom+jatom)) CYCLE - IF (((iatom+jatom) .EQ. (katom+latom)) .AND. (katom < iatom)) CYCLE + IF (.NOT. (katom + latom <= iatom + jatom)) CYCLE + IF (((iatom + jatom) .EQ. (katom + latom)) .AND. (katom < iatom)) CYCLE i_set_list_kl_start = list_kl%elements(i_list_kl)%set_bounds(1) i_set_list_kl_stop = list_kl%elements(i_list_kl)%set_bounds(2) kkind = list_kl%elements(i_list_kl)%kind_pair(1) @@ -1233,12 +1233,12 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se pmax_atom = 0.0_dp END IF - screen_kind_ij = screen_coeffs_kind(jkind, ikind)%x(1)*rab2+ & + screen_kind_ij = screen_coeffs_kind(jkind, ikind)%x(1)*rab2 + & screen_coeffs_kind(jkind, ikind)%x(2) - screen_kind_kl = screen_coeffs_kind(lkind, kkind)%x(1)*rcd2+ & + screen_kind_kl = screen_coeffs_kind(lkind, kkind)%x(1)*rcd2 + & screen_coeffs_kind(lkind, kkind)%x(2) - IF (screen_kind_ij+screen_kind_kl+pmax_atom < log10_eps_schwarz) CYCLE + IF (screen_kind_ij + screen_kind_kl + pmax_atom < log10_eps_schwarz) CYCLE !! we want to be consistent with the KS matrix. If none of the atomic indices !! is associated cycle @@ -1314,7 +1314,7 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se ptr_p_1 => shm_initial_p(kind_kind_idx)%p_kind(:, :, & actual_x_data%map_atom_to_kind_atom(iatom), & actual_x_data%map_atom_to_kind_atom(katom)) - swap_id = swap_id+1 + swap_id = swap_id + 1 END IF kind_kind_idx = INT(get_1D_idx(lkind, jkind, INT(nkind, int_8))) IF (jkind >= lkind) THEN @@ -1325,7 +1325,7 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se ptr_p_2 => shm_initial_p(kind_kind_idx)%p_kind(:, :, & actual_x_data%map_atom_to_kind_atom(jatom), & actual_x_data%map_atom_to_kind_atom(latom)) - swap_id = swap_id+2 + swap_id = swap_id + 2 END IF kind_kind_idx = INT(get_1D_idx(lkind, ikind, INT(nkind, int_8))) IF (ikind >= lkind) THEN @@ -1336,7 +1336,7 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se ptr_p_3 => shm_initial_p(kind_kind_idx)%p_kind(:, :, & actual_x_data%map_atom_to_kind_atom(iatom), & actual_x_data%map_atom_to_kind_atom(latom)) - swap_id = swap_id+4 + swap_id = swap_id + 4 END IF kind_kind_idx = INT(get_1D_idx(kkind, jkind, INT(nkind, int_8))) IF (jkind >= kkind) THEN @@ -1347,7 +1347,7 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se ptr_p_4 => shm_initial_p(kind_kind_idx)%p_kind(:, :, & actual_x_data%map_atom_to_kind_atom(jatom), & actual_x_data%map_atom_to_kind_atom(katom)) - swap_id = swap_id+8 + swap_id = swap_id + 8 END IF END IF @@ -1365,7 +1365,7 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se DO i = 1, n_threads !$OMP ATOMIC READ tmp_i4 = x_data(irep, i)%memory_parameter%actual_memory_usage - mem_compression_counter = mem_compression_counter+ & + mem_compression_counter = mem_compression_counter + & tmp_i4*memory_parameter%cache_size END DO IF (mem_compression_counter > memory_parameter%max_compression_counter) THEN @@ -1376,7 +1376,7 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se memory_parameter%ram_counter = counter END IF ELSE - counter = counter+1 + counter = counter + 1 buffer_overflow = .FALSE. END IF END IF @@ -1386,7 +1386,7 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se IF (distribution_energy%ram_counter == counter) THEN buffer_overflow = .TRUE. ELSE - counter = counter+1 + counter = counter + 1 buffer_overflow = .FALSE. END IF @@ -1394,7 +1394,7 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se IF (memory_parameter%ram_counter == counter) THEN buffer_overflow = .TRUE. ELSE - counter = counter+1 + counter = counter + 1 buffer_overflow = .FALSE. END IF END IF @@ -1421,10 +1421,10 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se jset = set_list_ij(i_set_list_ij)%pair(2) ncob = npgfb(jset)*ncoset(lb_max(jset)) - max_val1 = screen_coeffs_set(jset, iset, jkind, ikind)%x(1)*rab2+ & + max_val1 = screen_coeffs_set(jset, iset, jkind, ikind)%x(1)*rab2 + & screen_coeffs_set(jset, iset, jkind, ikind)%x(2) - IF (max_val1+screen_kind_kl+pmax_atom < log10_eps_schwarz) CYCLE + IF (max_val1 + screen_kind_kl + pmax_atom < log10_eps_schwarz) CYCLE sphi_a_ext_set => sphi_a_ext(:, :, :, iset) sphi_b_ext_set => sphi_b_ext(:, :, :, jset) @@ -1432,12 +1432,12 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se kset = set_list_kl(i_set_list_kl)%pair(1) lset = set_list_kl(i_set_list_kl)%pair(2) - max_val2_set = (screen_coeffs_set(lset, kset, lkind, kkind)%x(1)*rcd2+ & + max_val2_set = (screen_coeffs_set(lset, kset, lkind, kkind)%x(1)*rcd2 + & screen_coeffs_set(lset, kset, lkind, kkind)%x(2)) - max_val2 = max_val1+max_val2_set + max_val2 = max_val1 + max_val2_set !! Near field screening - IF (max_val2+pmax_atom < log10_eps_schwarz) CYCLE + IF (max_val2 + pmax_atom < log10_eps_schwarz) CYCLE sphi_c_ext_set => sphi_c_ext(:, :, :, kset) sphi_d_ext_set => sphi_d_ext(:, :, :, lset) !! get max_vals if we screen on initial density @@ -1449,14 +1449,14 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se pmax_entry = 0.0_dp END IF log10_pmax = pmax_entry - max_val2 = max_val2+log10_pmax + max_val2 = max_val2 + log10_pmax IF (max_val2 < log10_eps_schwarz) CYCLE pmax_entry = EXP(log10_pmax*ln_10) !! store current number of integrals, update total number and number of integrals in buffer current_counter = nsgfa(iset)*nsgfb(jset)*nsgfc(kset)*nsgfd(lset) IF (buffer_overflow) THEN - neris_onthefly = neris_onthefly+current_counter + neris_onthefly = neris_onthefly + current_counter END IF !! Get integrals from buffer and update Kohn-Sham matrix @@ -1473,15 +1473,15 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se maxval_cache_disk, maxval_container_disk, memory_parameter%actual_memory_usage_disk, & use_disk_storage) END IF - spherical_estimate = SET_EXPONENT(1.0_dp, estimate_to_store_int+1) + spherical_estimate = SET_EXPONENT(1.0_dp, estimate_to_store_int + 1) IF (spherical_estimate*pmax_entry < eps_schwarz) CYCLE - nbits = EXPONENT(ANINT(spherical_estimate*pmax_entry/eps_storage))+1 + nbits = EXPONENT(ANINT(spherical_estimate*pmax_entry/eps_storage)) + 1 buffer_left = nints buffer_start = 1 IF (.NOT. use_disk_storage) THEN - neris_incore = neris_incore+INT(nints, int_8) + neris_incore = neris_incore + INT(nints, int_8) ELSE - neris_disk = neris_disk+INT(nints, int_8) + neris_disk = neris_disk + INT(nints, int_8) END IF DO WHILE (buffer_left > 0) buffer_size = MIN(buffer_left, cache_size) @@ -1502,8 +1502,8 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se memory_parameter%actual_memory_usage_disk, & use_disk_storage) END IF - buffer_left = buffer_left-buffer_size - buffer_start = buffer_start+buffer_size + buffer_left = buffer_left - buffer_size + buffer_start = buffer_start + buffer_size END DO END IF !! Calculate integrals if we run out of buffer or the geometry did change @@ -1545,8 +1545,8 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se nimages, do_periodic, p_work) nints = nsgfa(iset)*nsgfb(jset)*nsgfc(kset)*nsgfd(lset) - neris_total = neris_total+nints - nprim_ints = nprim_ints+neris_tmp + neris_total = neris_total + nints + nprim_ints = nprim_ints + neris_tmp ! IF (cartesian_estimate == 0.0_dp) cartesian_estimate = TINY(cartesian_estimate) ! estimate_to_store_int = EXPONENT(cartesian_estimate) ! estimate_to_store_int = MAX(estimate_to_store_int, -15_int_8) @@ -1592,10 +1592,10 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se use_disk_storage) END IF END IF - spherical_estimate = SET_EXPONENT(1.0_dp, estimate_to_store_int+1) + spherical_estimate = SET_EXPONENT(1.0_dp, estimate_to_store_int + 1) IF (spherical_estimate*pmax_entry < eps_schwarz) CYCLE IF (.NOT. buffer_overflow) THEN - nbits = EXPONENT(ANINT(spherical_estimate*pmax_entry/eps_storage))+1 + nbits = EXPONENT(ANINT(spherical_estimate*pmax_entry/eps_storage)) + 1 ! In case of a tight eps_storage threshold the number of significant ! bits in the integer number NINT(value*pmax_entry/eps_storage) may @@ -1626,10 +1626,10 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se buffer_left = nints buffer_start = 1 IF (.NOT. use_disk_storage) THEN - neris_incore = neris_incore+INT(nints, int_8) + neris_incore = neris_incore + INT(nints, int_8) ! neris_incore = neris_incore+nints ELSE - neris_disk = neris_disk+INT(nints, int_8) + neris_disk = neris_disk + INT(nints, int_8) ! neris_disk = neris_disk+nints END IF DO WHILE (buffer_left > 0) @@ -1651,8 +1651,8 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se memory_parameter%actual_memory_usage_disk, & use_disk_storage) END IF - buffer_left = buffer_left-buffer_size - buffer_start = buffer_start+buffer_size + buffer_left = buffer_left - buffer_size + buffer_start = buffer_start + buffer_size END DO ELSE !! In order to be consistent with in-core part, round all the eris wrt. eps_schwarz @@ -1723,10 +1723,10 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se END DO atomic_blocks bintime_stop = m_walltime() IF (my_geo_change) THEN - distribution_energy%time_first_scf = bintime_stop-bintime_start + distribution_energy%time_first_scf = bintime_stop - bintime_start ELSE distribution_energy%time_other_scf = & - distribution_energy%time_other_scf+bintime_stop-bintime_start + distribution_energy%time_other_scf + bintime_stop - bintime_start ENDIF !$OMP MASTER CALL timestop(handle_bin) @@ -1766,11 +1766,11 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se !$OMP BARRIER !! Get some number about ERIS !$OMP ATOMIC - shm_neris_total = shm_neris_total+neris_total + shm_neris_total = shm_neris_total + neris_total !$OMP ATOMIC - shm_neris_onthefly = shm_neris_onthefly+neris_onthefly + shm_neris_onthefly = shm_neris_onthefly + neris_onthefly !$OMP ATOMIC - shm_nprim_ints = shm_nprim_ints+nprim_ints + shm_nprim_ints = shm_nprim_ints + nprim_ints storage_counter_integrals = memory_parameter%actual_memory_usage* & memory_parameter%cache_size @@ -1778,15 +1778,15 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se memory_parameter%cache_size stor_count_max_val = max_val_memory*memory_parameter%cache_size !$OMP ATOMIC - shm_storage_counter_integrals = shm_storage_counter_integrals+storage_counter_integrals + shm_storage_counter_integrals = shm_storage_counter_integrals + storage_counter_integrals !$OMP ATOMIC - shm_stor_count_int_disk = shm_stor_count_int_disk+stor_count_int_disk + shm_stor_count_int_disk = shm_stor_count_int_disk + stor_count_int_disk !$OMP ATOMIC - shm_neris_incore = shm_neris_incore+neris_incore + shm_neris_incore = shm_neris_incore + neris_incore !$OMP ATOMIC - shm_neris_disk = shm_neris_disk+neris_disk + shm_neris_disk = shm_neris_disk + neris_disk !$OMP ATOMIC - shm_stor_count_max_val = shm_stor_count_max_val+stor_count_max_val + shm_stor_count_max_val = shm_stor_count_max_val + stor_count_max_val !$OMP BARRIER ! ** Calculate how much memory has already been used (might be needed for in-core forces @@ -1795,7 +1795,7 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se DO i = 1, n_threads !$OMP ATOMIC READ tmp_i4 = x_data(irep, i)%memory_parameter%actual_memory_usage - shm_mem_compression_counter = shm_mem_compression_counter+ & + shm_mem_compression_counter = shm_mem_compression_counter + & tmp_i4*memory_parameter%cache_size END DO !$OMP END MASTER @@ -1807,8 +1807,8 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se ene_x_aa = 0.0_dp ene_x_bb = 0.0_dp - mb_size_p = shm_block_offset(ncpu+1)/1024/128 - mb_size_f = shm_block_offset(ncpu+1)/1024/128 + mb_size_p = shm_block_offset(ncpu + 1)/1024/128 + mb_size_f = shm_block_offset(ncpu + 1)/1024/128 IF (.NOT. treat_lsd_in_core) THEN IF (nspins == 2) THEN mb_size_f = mb_size_f*2 @@ -1818,32 +1818,32 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se !! size of primitive_integrals(not shared) mb_size_buffers = INT(nsgf_max, int_8)**4*n_threads !! fock density buffers (not shared) - mb_size_buffers = mb_size_buffers+INT(nsgf_max, int_8)**2*n_threads - subtr_size_mb = subtr_size_mb+8_int_8*nsgf_max**2*n_threads + mb_size_buffers = mb_size_buffers + INT(nsgf_max, int_8)**2*n_threads + subtr_size_mb = subtr_size_mb + 8_int_8*nsgf_max**2*n_threads !! size of screening functions (shared) - mb_size_buffers = mb_size_buffers+max_pgf**2*max_set**2*nkind**2 & - +max_set**2*nkind**2 & - +nkind**2 & - +max_pgf**2*max_set**2*nkind**2 + mb_size_buffers = mb_size_buffers + max_pgf**2*max_set**2*nkind**2 & + + max_set**2*nkind**2 & + + nkind**2 & + + max_pgf**2*max_set**2*nkind**2 !! is_assoc (shared) - mb_size_buffers = mb_size_buffers+natom**2 + mb_size_buffers = mb_size_buffers + natom**2 ! ** pmax_atom (shared) IF (do_p_screening) THEN - mb_size_buffers = mb_size_buffers+natom**2 + mb_size_buffers = mb_size_buffers + natom**2 END IF IF (screening_parameter%do_p_screening_forces) THEN IF (memory_parameter%treat_forces_in_core) THEN - mb_size_buffers = mb_size_buffers+natom**2 + mb_size_buffers = mb_size_buffers + natom**2 END IF END IF ! ** Initial P only MAX(alpha,beta) (shared) IF (do_p_screening .OR. screening_parameter%do_p_screening_forces) THEN - mb_size_buffers = mb_size_buffers+memory_parameter%size_p_screen + mb_size_buffers = mb_size_buffers + memory_parameter%size_p_screen END IF ! ** In core forces require their own initial P IF (screening_parameter%do_p_screening_forces) THEN IF (memory_parameter%treat_forces_in_core) THEN - mb_size_buffers = mb_size_buffers+memory_parameter%size_p_screen + mb_size_buffers = mb_size_buffers + memory_parameter%size_p_screen END IF END IF @@ -1868,27 +1868,27 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se DO iset = 1, nseta DO jset = 1, nsetb act_set_offset = shm_set_offset(jset, iset, jkind, ikind) - i = act_set_offset+act_atomic_block_offset-1 + i = act_set_offset + act_atomic_block_offset - 1 DO ma = 1, nsgfa(iset) - j = shm_set_offset(iset, jset, jkind, ikind)+act_atomic_block_offset-1+ma-1 + j = shm_set_offset(iset, jset, jkind, ikind) + act_atomic_block_offset - 1 + ma - 1 DO mb = 1, nsgfb(jset) IF (i > j) THEN - full_ks_alpha(i, img) = (full_ks_alpha(i, img)+full_ks_alpha(j, img)*afac) + full_ks_alpha(i, img) = (full_ks_alpha(i, img) + full_ks_alpha(j, img)*afac) full_ks_alpha(j, img) = full_ks_alpha(i, img)*afac IF (.NOT. treat_lsd_in_core .AND. nspins == 2) THEN - full_ks_beta(i, img) = (full_ks_beta(i, img)+full_ks_beta(j, img)*afac) + full_ks_beta(i, img) = (full_ks_beta(i, img) + full_ks_beta(j, img)*afac) full_ks_beta(j, img) = full_ks_beta(i, img)*afac END IF END IF ! ** For adiabatically rescaled functionals we need the energy coming from the diagonal elements IF (i == j) THEN - ene_x_aa_diag = ene_x_aa_diag+full_ks_alpha(i, img)*full_density_alpha(i, img) + ene_x_aa_diag = ene_x_aa_diag + full_ks_alpha(i, img)*full_density_alpha(i, img) IF (.NOT. treat_lsd_in_core .AND. nspins == 2) THEN - ene_x_bb_diag = ene_x_bb_diag+full_ks_beta(i, img)*full_density_beta(i, img) + ene_x_bb_diag = ene_x_bb_diag + full_ks_beta(i, img)*full_density_beta(i, img) END IF END IF - i = i+1 - j = j+nsgfa(iset) + i = i + 1 + j = j + nsgfa(iset) END DO END DO END DO @@ -1930,7 +1930,7 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se DO img = 1, nkimages CALL dbcsr_dot(ks_matrix(ispin, img)%matrix, rho_ao(ispin, img)%matrix, & etmp) - ene_x_aa = ene_x_aa+etmp + ene_x_aa = ene_x_aa + etmp END DO !for ADMMS, we need the exchange matrix k(d) for both spins IF (dft_control%do_admm) THEN @@ -1944,7 +1944,7 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se DO img = 1, nkimages CALL dbcsr_dot(ks_matrix(2, img)%matrix, rho_ao(2, img)%matrix, & etmp) - ene_x_bb = ene_x_bb+etmp + ene_x_bb = ene_x_bb + etmp END DO !for ADMMS, we need the exchange matrix k(d) for both spins IF (dft_control%do_admm) THEN @@ -1955,29 +1955,29 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se END IF !! Update energy type - ehfx = 0.5_dp*(ene_x_aa+ene_x_bb) + ehfx = 0.5_dp*(ene_x_aa + ene_x_bb) ELSE ! ** It is easier to correct the following expression by the diagonal energy contribution, ! ** than explicitly going throuhg the diagonal elements DO img = 1, nkimages DO pa = 1, SIZE(full_ks_alpha, 1) - ene_x_aa = ene_x_aa+full_ks_alpha(pa, img)*full_density_alpha(pa, img) + ene_x_aa = ene_x_aa + full_ks_alpha(pa, img)*full_density_alpha(pa, img) END DO END DO ! ** Now correct - ene_x_aa = (ene_x_aa+ene_x_aa_diag)*0.5_dp + ene_x_aa = (ene_x_aa + ene_x_aa_diag)*0.5_dp IF (nspins == 2) THEN DO img = 1, nkimages DO pa = 1, SIZE(full_ks_beta, 1) - ene_x_bb = ene_x_bb+full_ks_beta(pa, img)*full_density_beta(pa, img) + ene_x_bb = ene_x_bb + full_ks_beta(pa, img)*full_density_beta(pa, img) END DO END DO ! ** Now correct - ene_x_bb = (ene_x_bb+ene_x_bb_diag)*0.5_dp + ene_x_bb = (ene_x_bb + ene_x_bb_diag)*0.5_dp END IF CALL mp_sum(ene_x_aa, para_env%group) IF (nspins == 2) CALL mp_sum(ene_x_bb, para_env%group) - ehfx = 0.5_dp*(ene_x_aa+ene_x_bb) + ehfx = 0.5_dp*(ene_x_aa + ene_x_bb) END IF !! Print some memeory information if this is the first step @@ -1994,11 +1994,11 @@ SUBROUTINE integrate_four_center(qs_env, x_data, ks_matrix, ehfx, rho_ao, hfx_se shm_nprim_ints = tmp_i8(7) shm_stor_count_max_val = tmp_i8(8) CALL mp_max(memsize_after, para_env%group) - mem_eris = (shm_storage_counter_integrals+128*1024-1)/1024/128 + mem_eris = (shm_storage_counter_integrals + 128*1024 - 1)/1024/128 compression_factor = REAL(shm_neris_incore, dp)/REAL(shm_storage_counter_integrals, dp) - mem_eris_disk = (shm_stor_count_int_disk+128*1024-1)/1024/128 + mem_eris_disk = (shm_stor_count_int_disk + 128*1024 - 1)/1024/128 compression_factor_disk = REAL(shm_neris_disk, dp)/REAL(shm_stor_count_int_disk, dp) - mem_max_val = (shm_stor_count_max_val+128*1024-1)/1024/128 + mem_max_val = (shm_stor_count_max_val + 128*1024 - 1)/1024/128 IF (shm_neris_incore == 0) THEN mem_eris = 0 @@ -2316,7 +2316,7 @@ SUBROUTINE coulomb4(lib, ra, rb, rc, rd, npgfa, npgfb, npgfc, npgfd, & cart_estimate = 0.0_dp neris_tmp = 0 primitive_integrals = 0.0_dp - max_l = la_max+lb_max+lc_max+ld_max + max_l = la_max + lb_max + lc_max + ld_max DO list_ij = 1, nelements_ij ZetaInv = pgf_list_ij(list_ij)%ZetaInv ipgf = pgf_list_ij(list_ij)%ipgf @@ -2365,20 +2365,20 @@ SUBROUTINE coulomb4(lib, ra, rb, rc, rd, npgfa, npgfb, npgfc, npgfd, & neris_tmp, ZetaInv, EtaInv, & s_offset_a, s_offset_b, s_offset_c, s_offset_d, & nsgfla, nsgflb, nsgflc, nsgfld, nsoa, nsob, nsoc, nsod, & - sphi_a_ext(1, la+1, ipgf), & - sphi_b_ext(1, lb+1, jpgf), & - sphi_c_ext(1, lc+1, kpgf), & - sphi_d_ext(1, ld+1, lpgf), & + sphi_a_ext(1, la + 1, ipgf), & + sphi_b_ext(1, lb + 1, jpgf), & + sphi_c_ext(1, lc + 1, kpgf), & + sphi_d_ext(1, ld + 1, lpgf), & ee_work, ee_work2, ee_buffer1, ee_buffer2, ee_primitives_tmp, & p_work) cart_estimate = MAX(tmp_max, cart_estimate) - s_offset_d = s_offset_d+nsod*nsgfld + s_offset_d = s_offset_d + nsod*nsgfld END DO !ld - s_offset_c = s_offset_c+nsoc*nsgflc + s_offset_c = s_offset_c + nsoc*nsgflc END DO !lc - s_offset_b = s_offset_b+nsob*nsgflb + s_offset_b = s_offset_b + nsob*nsgflb END DO !lb - s_offset_a = s_offset_a+nsoa*nsgfla + s_offset_a = s_offset_a + nsoa*nsgfla END DO !la END DO END DO @@ -2406,7 +2406,7 @@ PURE FUNCTION get_1D_idx(i, j, N) INTEGER(int_8) :: min_ij min_ij = MIN(i, j) - get_1D_idx = min_ij*N+MAX(i, j)-(min_ij-1)*min_ij/2-N + get_1D_idx = min_ij*N + MAX(i, j) - (min_ij - 1)*min_ij/2 - N END FUNCTION get_1D_idx @@ -2479,93 +2479,93 @@ SUBROUTINE update_fock_matrix(ma_max, mb_max, mc_max, md_max, & IF (jatom >= latom) THEN i = 1 - offset_bd = offset_bd_set(jset, lset)+atomic_offset_bd-1 + offset_bd = offset_bd_set(jset, lset) + atomic_offset_bd - 1 j = offset_bd DO md = 1, md_max DO mb = 1, mb_max pbd(i) = density(j) - i = i+1 - j = j+1 + i = i + 1 + j = j + 1 END DO END DO ELSE i = 1 - offset_bd = offset_bd_set(lset, jset)+atomic_offset_bd-1 + offset_bd = offset_bd_set(lset, jset) + atomic_offset_bd - 1 DO md = 1, md_max - j = offset_bd+md-1 + j = offset_bd + md - 1 DO mb = 1, mb_max pbd(i) = density(j) - i = i+1 - j = j+md_max + i = i + 1 + j = j + md_max END DO END DO END IF IF (jatom >= katom) THEN i = 1 - offset_bc = offset_bc_set(jset, kset)+atomic_offset_bc-1 + offset_bc = offset_bc_set(jset, kset) + atomic_offset_bc - 1 j = offset_bc DO mc = 1, mc_max DO mb = 1, mb_max pbc(i) = density(j) - i = i+1 - j = j+1 + i = i + 1 + j = j + 1 END DO END DO ELSE i = 1 - offset_bc = offset_bc_set(kset, jset)+atomic_offset_bc-1 + offset_bc = offset_bc_set(kset, jset) + atomic_offset_bc - 1 DO mc = 1, mc_max - j = offset_bc+mc-1 + j = offset_bc + mc - 1 DO mb = 1, mb_max pbc(i) = density(j) - i = i+1 - j = j+mc_max + i = i + 1 + j = j + mc_max END DO END DO END IF IF (iatom >= latom) THEN i = 1 - offset_ad = offset_ad_set(iset, lset)+atomic_offset_ad-1 + offset_ad = offset_ad_set(iset, lset) + atomic_offset_ad - 1 j = offset_ad DO md = 1, md_max DO ma = 1, ma_max pad(i) = density(j) - i = i+1 - j = j+1 + i = i + 1 + j = j + 1 END DO END DO ELSE i = 1 - offset_ad = offset_ad_set(lset, iset)+atomic_offset_ad-1 + offset_ad = offset_ad_set(lset, iset) + atomic_offset_ad - 1 DO md = 1, md_max - j = offset_ad+md-1 + j = offset_ad + md - 1 DO ma = 1, ma_max pad(i) = density(j) - i = i+1 - j = j+md_max + i = i + 1 + j = j + md_max END DO END DO END IF IF (iatom >= katom) THEN i = 1 - offset_ac = offset_ac_set(iset, kset)+atomic_offset_ac-1 + offset_ac = offset_ac_set(iset, kset) + atomic_offset_ac - 1 j = offset_ac DO mc = 1, mc_max DO ma = 1, ma_max pac(i) = density(j) - i = i+1 - j = j+1 + i = i + 1 + j = j + 1 END DO END DO ELSE i = 1 - offset_ac = offset_ac_set(kset, iset)+atomic_offset_ac-1 + offset_ac = offset_ac_set(kset, iset) + atomic_offset_ac - 1 DO mc = 1, mc_max - j = offset_ac+mc-1 + j = offset_ac + mc - 1 DO ma = 1, ma_max pac(i) = density(j) - i = i+1 - j = j+mc_max + i = i + 1 + j = j + mc_max END DO END DO END IF @@ -2577,20 +2577,20 @@ SUBROUTINE update_fock_matrix(ma_max, mb_max, mc_max, md_max, & DO md = 1, md_max DO mb = 1, mb_max !$OMP ATOMIC - ks(j) = ks(j)+kbd(i) - i = i+1 - j = j+1 + ks(j) = ks(j) + kbd(i) + i = i + 1 + j = j + 1 END DO END DO ELSE i = 1 DO md = 1, md_max - j = offset_bd+md-1 + j = offset_bd + md - 1 DO mb = 1, mb_max !$OMP ATOMIC - ks(j) = ks(j)+kbd(i) - i = i+1 - j = j+md_max + ks(j) = ks(j) + kbd(i) + i = i + 1 + j = j + md_max END DO END DO END IF @@ -2600,20 +2600,20 @@ SUBROUTINE update_fock_matrix(ma_max, mb_max, mc_max, md_max, & DO mc = 1, mc_max DO mb = 1, mb_max !$OMP ATOMIC - ks(j) = ks(j)+kbc(i) - i = i+1 - j = j+1 + ks(j) = ks(j) + kbc(i) + i = i + 1 + j = j + 1 END DO END DO ELSE i = 1 DO mc = 1, mc_max - j = offset_bc+mc-1 + j = offset_bc + mc - 1 DO mb = 1, mb_max !$OMP ATOMIC - ks(j) = ks(j)+kbc(i) - i = i+1 - j = j+mc_max + ks(j) = ks(j) + kbc(i) + i = i + 1 + j = j + mc_max END DO END DO END IF @@ -2623,20 +2623,20 @@ SUBROUTINE update_fock_matrix(ma_max, mb_max, mc_max, md_max, & DO md = 1, md_max DO ma = 1, ma_max !$OMP ATOMIC - ks(j) = ks(j)+kad(i) - i = i+1 - j = j+1 + ks(j) = ks(j) + kad(i) + i = i + 1 + j = j + 1 END DO END DO ELSE i = 1 DO md = 1, md_max - j = offset_ad+md-1 + j = offset_ad + md - 1 DO ma = 1, ma_max !$OMP ATOMIC - ks(j) = ks(j)+kad(i) - i = i+1 - j = j+md_max + ks(j) = ks(j) + kad(i) + i = i + 1 + j = j + md_max END DO END DO END IF @@ -2646,20 +2646,20 @@ SUBROUTINE update_fock_matrix(ma_max, mb_max, mc_max, md_max, & DO mc = 1, mc_max DO ma = 1, ma_max !$OMP ATOMIC - ks(j) = ks(j)+kac(i) - i = i+1 - j = j+1 + ks(j) = ks(j) + kac(i) + i = i + 1 + j = j + 1 END DO END DO ELSE i = 1 DO mc = 1, mc_max - j = offset_ac+mc-1 + j = offset_ac + mc - 1 DO ma = 1, ma_max !$OMP ATOMIC - ks(j) = ks(j)+kac(i) - i = i+1 - j = j+mc_max + ks(j) = ks(j) + kac(i) + i = i + 1 + j = j + mc_max END DO END DO END IF @@ -2728,93 +2728,93 @@ SUBROUTINE update_fock_matrix_as(ma_max, mb_max, mc_max, md_max, & IF (jatom >= latom) THEN i = 1 - offset_bd = offset_bd_set(jset, lset)+atomic_offset_bd-1 + offset_bd = offset_bd_set(jset, lset) + atomic_offset_bd - 1 j = offset_bd DO md = 1, md_max DO mb = 1, mb_max pbd(i) = +density(j) - i = i+1 - j = j+1 + i = i + 1 + j = j + 1 END DO END DO ELSE i = 1 - offset_bd = offset_bd_set(lset, jset)+atomic_offset_bd-1 + offset_bd = offset_bd_set(lset, jset) + atomic_offset_bd - 1 DO md = 1, md_max - j = offset_bd+md-1 + j = offset_bd + md - 1 DO mb = 1, mb_max pbd(i) = -density(j) - i = i+1 - j = j+md_max + i = i + 1 + j = j + md_max END DO END DO END IF IF (jatom >= katom) THEN i = 1 - offset_bc = offset_bc_set(jset, kset)+atomic_offset_bc-1 + offset_bc = offset_bc_set(jset, kset) + atomic_offset_bc - 1 j = offset_bc DO mc = 1, mc_max DO mb = 1, mb_max pbc(i) = -density(j) - i = i+1 - j = j+1 + i = i + 1 + j = j + 1 END DO END DO ELSE i = 1 - offset_bc = offset_bc_set(kset, jset)+atomic_offset_bc-1 + offset_bc = offset_bc_set(kset, jset) + atomic_offset_bc - 1 DO mc = 1, mc_max - j = offset_bc+mc-1 + j = offset_bc + mc - 1 DO mb = 1, mb_max pbc(i) = density(j) - i = i+1 - j = j+mc_max + i = i + 1 + j = j + mc_max END DO END DO END IF IF (iatom >= latom) THEN i = 1 - offset_ad = offset_ad_set(iset, lset)+atomic_offset_ad-1 + offset_ad = offset_ad_set(iset, lset) + atomic_offset_ad - 1 j = offset_ad DO md = 1, md_max DO ma = 1, ma_max pad(i) = -density(j) - i = i+1 - j = j+1 + i = i + 1 + j = j + 1 END DO END DO ELSE i = 1 - offset_ad = offset_ad_set(lset, iset)+atomic_offset_ad-1 + offset_ad = offset_ad_set(lset, iset) + atomic_offset_ad - 1 DO md = 1, md_max - j = offset_ad+md-1 + j = offset_ad + md - 1 DO ma = 1, ma_max pad(i) = density(j) - i = i+1 - j = j+md_max + i = i + 1 + j = j + md_max END DO END DO END IF IF (iatom >= katom) THEN i = 1 - offset_ac = offset_ac_set(iset, kset)+atomic_offset_ac-1 + offset_ac = offset_ac_set(iset, kset) + atomic_offset_ac - 1 j = offset_ac DO mc = 1, mc_max DO ma = 1, ma_max pac(i) = +density(j) - i = i+1 - j = j+1 + i = i + 1 + j = j + 1 END DO END DO ELSE i = 1 - offset_ac = offset_ac_set(kset, iset)+atomic_offset_ac-1 + offset_ac = offset_ac_set(kset, iset) + atomic_offset_ac - 1 DO mc = 1, mc_max - j = offset_ac+mc-1 + j = offset_ac + mc - 1 DO ma = 1, ma_max pac(i) = -density(j) - i = i+1 - j = j+mc_max + i = i + 1 + j = j + mc_max END DO END DO END IF @@ -2827,20 +2827,20 @@ SUBROUTINE update_fock_matrix_as(ma_max, mb_max, mc_max, md_max, & DO md = 1, md_max DO mb = 1, mb_max !$OMP ATOMIC - ks(j) = ks(j)+kbd(i) - i = i+1 - j = j+1 + ks(j) = ks(j) + kbd(i) + i = i + 1 + j = j + 1 END DO END DO ELSE i = 1 DO md = 1, md_max - j = offset_bd+md-1 + j = offset_bd + md - 1 DO mb = 1, mb_max !$OMP ATOMIC - ks(j) = ks(j)-kbd(i) - i = i+1 - j = j+md_max + ks(j) = ks(j) - kbd(i) + i = i + 1 + j = j + md_max END DO END DO END IF @@ -2850,20 +2850,20 @@ SUBROUTINE update_fock_matrix_as(ma_max, mb_max, mc_max, md_max, & DO mc = 1, mc_max DO mb = 1, mb_max !$OMP ATOMIC - ks(j) = ks(j)-kbc(i) - i = i+1 - j = j+1 + ks(j) = ks(j) - kbc(i) + i = i + 1 + j = j + 1 END DO END DO ELSE i = 1 DO mc = 1, mc_max - j = offset_bc+mc-1 + j = offset_bc + mc - 1 DO mb = 1, mb_max !$OMP ATOMIC - ks(j) = ks(j)+kbc(i) - i = i+1 - j = j+mc_max + ks(j) = ks(j) + kbc(i) + i = i + 1 + j = j + mc_max END DO END DO END IF @@ -2873,20 +2873,20 @@ SUBROUTINE update_fock_matrix_as(ma_max, mb_max, mc_max, md_max, & DO md = 1, md_max DO ma = 1, ma_max !$OMP ATOMIC - ks(j) = ks(j)-kad(i) - i = i+1 - j = j+1 + ks(j) = ks(j) - kad(i) + i = i + 1 + j = j + 1 END DO END DO ELSE i = 1 DO md = 1, md_max - j = offset_ad+md-1 + j = offset_ad + md - 1 DO ma = 1, ma_max !$OMP ATOMIC - ks(j) = ks(j)+kad(i) - i = i+1 - j = j+md_max + ks(j) = ks(j) + kad(i) + i = i + 1 + j = j + md_max END DO END DO END IF @@ -2897,20 +2897,20 @@ SUBROUTINE update_fock_matrix_as(ma_max, mb_max, mc_max, md_max, & DO mc = 1, mc_max DO ma = 1, ma_max !$OMP ATOMIC - ks(j) = ks(j)+kac(i) - i = i+1 - j = j+1 + ks(j) = ks(j) + kac(i) + i = i + 1 + j = j + 1 END DO END DO ELSE i = 1 DO mc = 1, mc_max - j = offset_ac+mc-1 + j = offset_ac + mc - 1 DO ma = 1, ma_max !$OMP ATOMIC - ks(j) = ks(j)-kac(i) - i = i+1 - j = j+mc_max + ks(j) = ks(j) - kac(i) + i = i + 1 + j = j + mc_max END DO END DO END IF @@ -2951,12 +2951,12 @@ SUBROUTINE print_integrals(i, j, k, l, set_offsets, atom_offsets, iset, jset, ks DO mc = 1, mc_max DO mb = 1, mb_max DO ma = 1, ma_max - iint = iint+1 + iint = iint + 1 IF (ABS(prim(iint)) .GT. 0.0000000000001) & - WRITE (99, *) atom_offsets(i, 1)+ma+set_offsets(iset, 1, i, 1)-1, & - atom_offsets(j, 1)+ma+set_offsets(jset, 1, j, 1)-1, & - atom_offsets(k, 1)+ma+set_offsets(kset, 1, k, 1)-1, & - atom_offsets(l, 1)+ma+set_offsets(lset, 1, l, 1)-1, & + WRITE (99, *) atom_offsets(i, 1) + ma + set_offsets(iset, 1, i, 1) - 1, & + atom_offsets(j, 1) + ma + set_offsets(jset, 1, j, 1) - 1, & + atom_offsets(k, 1) + ma + set_offsets(kset, 1, k, 1) - 1, & + atom_offsets(l, 1) + ma + set_offsets(lset, 1, l, 1) - 1, & prim(iint) END DO END DO diff --git a/src/hfx_get_pmax_val.f90 b/src/hfx_get_pmax_val.f90 index 7273ab6ebd..291e21b9f9 100644 --- a/src/hfx_get_pmax_val.f90 +++ b/src/hfx_get_pmax_val.f90 @@ -132,97 +132,97 @@ PURE SUBROUTINE get_pmax_val(ptr_p_1, ptr_p_2, ptr_p_3, ptr_p_4, & pmax_2 = ptr_p_2(lset, jset) pmax_3 = ptr_p_3(lset, iset) pmax_4 = ptr_p_4(kset, jset) - pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4) + pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4) CASE (17) pmax_1 = ptr_p_1(iset, kset) pmax_2 = ptr_p_2(lset, jset) pmax_3 = ptr_p_3(lset, iset) pmax_4 = ptr_p_4(kset, jset) - pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4) + pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4) CASE (18) pmax_1 = ptr_p_1(kset, iset) pmax_2 = ptr_p_2(jset, lset) pmax_3 = ptr_p_3(lset, iset) pmax_4 = ptr_p_4(kset, jset) - pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4) + pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4) CASE (19) pmax_1 = ptr_p_1(iset, kset) pmax_2 = ptr_p_2(jset, lset) pmax_3 = ptr_p_3(lset, iset) pmax_4 = ptr_p_4(kset, jset) - pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4) + pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4) CASE (20) pmax_1 = ptr_p_1(kset, iset) pmax_2 = ptr_p_2(lset, jset) pmax_3 = ptr_p_3(iset, lset) pmax_4 = ptr_p_4(kset, jset) - pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4) + pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4) CASE (21) pmax_1 = ptr_p_1(iset, kset) pmax_2 = ptr_p_2(lset, jset) pmax_3 = ptr_p_3(iset, lset) pmax_4 = ptr_p_4(kset, jset) - pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4) + pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4) CASE (22) pmax_1 = ptr_p_1(kset, iset) pmax_2 = ptr_p_2(jset, lset) pmax_3 = ptr_p_3(iset, lset) pmax_4 = ptr_p_4(kset, jset) - pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4) + pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4) CASE (23) pmax_1 = ptr_p_1(iset, kset) pmax_2 = ptr_p_2(jset, lset) pmax_3 = ptr_p_3(iset, lset) pmax_4 = ptr_p_4(kset, jset) - pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4) + pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4) CASE (24) pmax_1 = ptr_p_1(kset, iset) pmax_2 = ptr_p_2(lset, jset) pmax_3 = ptr_p_3(lset, iset) pmax_4 = ptr_p_4(jset, kset) - pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4) + pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4) CASE (25) pmax_1 = ptr_p_1(iset, kset) pmax_2 = ptr_p_2(lset, jset) pmax_3 = ptr_p_3(lset, iset) pmax_4 = ptr_p_4(jset, kset) - pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4) + pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4) CASE (26) pmax_1 = ptr_p_1(kset, iset) pmax_2 = ptr_p_2(jset, lset) pmax_3 = ptr_p_3(lset, iset) pmax_4 = ptr_p_4(jset, kset) - pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4) + pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4) CASE (27) pmax_1 = ptr_p_1(iset, kset) pmax_2 = ptr_p_2(jset, lset) pmax_3 = ptr_p_3(lset, iset) pmax_4 = ptr_p_4(jset, kset) - pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4) + pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4) CASE (28) pmax_1 = ptr_p_1(kset, iset) pmax_2 = ptr_p_2(lset, jset) pmax_3 = ptr_p_3(iset, lset) pmax_4 = ptr_p_4(jset, kset) - pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4) + pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4) CASE (29) pmax_1 = ptr_p_1(iset, kset) pmax_2 = ptr_p_2(lset, jset) pmax_3 = ptr_p_3(iset, lset) pmax_4 = ptr_p_4(jset, kset) - pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4) + pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4) CASE (30) pmax_1 = ptr_p_1(kset, iset) pmax_2 = ptr_p_2(jset, lset) pmax_3 = ptr_p_3(iset, lset) pmax_4 = ptr_p_4(jset, kset) - pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4) + pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4) CASE (31) pmax_1 = ptr_p_1(iset, kset) pmax_2 = ptr_p_2(jset, lset) pmax_3 = ptr_p_3(iset, lset) pmax_4 = ptr_p_4(jset, kset) - pmax_val = MAX(pmax_1+pmax_2, pmax_3+pmax_4) + pmax_val = MAX(pmax_1 + pmax_2, pmax_3 + pmax_4) END SELECT END SUBROUTINE get_pmax_val diff --git a/src/hfx_helpers.F b/src/hfx_helpers.F index 40fffe5e8b..179400bc56 100644 --- a/src/hfx_helpers.F +++ b/src/hfx_helpers.F @@ -42,7 +42,7 @@ FUNCTION count_cells_perd(shell, perd) DO i = -shell*perd(1), shell*perd(1) DO j = -shell*perd(2), shell*perd(2) DO k = -shell*perd(3), shell*perd(3) - IF ((i**2+j**2+k**2 == shell)) count_cells_perd = count_cells_perd+1 + IF ((i**2 + j**2 + k**2 == shell)) count_cells_perd = count_cells_perd + 1 ENDDO ENDDO ENDDO @@ -69,7 +69,7 @@ SUBROUTINE next_image_cell_perd(m, perd) DO i = -shell*perd(1), shell*perd(1) DO j = -shell*perd(2), shell*perd(2) inner: DO k = -shell*perd(3), shell*perd(3) - IF (.NOT. (i**2+j**2+k**2 == shell)) CYCLE inner + IF (.NOT. (i**2 + j**2 + k**2 == shell)) CYCLE inner IF (found) THEN m = (/i, j, k/) EXIT outer @@ -78,7 +78,7 @@ SUBROUTINE next_image_cell_perd(m, perd) ENDDO inner ENDDO ENDDO - shell = shell+1 + shell = shell + 1 ENDDO outer END SUBROUTINE next_image_cell_perd diff --git a/src/hfx_libint_interface.F b/src/hfx_libint_interface.F index 3d0af2b43d..1bb151ddbf 100644 --- a/src/hfx_libint_interface.F +++ b/src/hfx_libint_interface.F @@ -91,29 +91,29 @@ SUBROUTINE build_quartet_data_screen(A, B, C, D, Zeta_A, Zeta_B, Zeta_C, Zeta_D, ZetaInv, ZetapEtaInv REAL(KIND=dp), DIMENSION(prim_data_f_size) :: F, Fm - Zeta = Zeta_A+Zeta_B + Zeta = Zeta_A + Zeta_B ZetaInv = 1.0_dp/Zeta - Eta = Zeta_C+Zeta_D + Eta = Zeta_C + Zeta_D EtaInv = 1.0_dp/Eta - ZetapEtaInv = Zeta+Eta + ZetapEtaInv = Zeta + Eta ZetapEtaInv = 1.0_dp/ZetapEtaInv Rho = Zeta*Eta*ZetapEtaInv RhoInv = 1.0_dp/Rho DO i = 1, 3 - P(i) = (Zeta_A*A(i)+Zeta_B*B(i))*ZetaInv - Q(i) = (Zeta_C*C(i)+Zeta_D*D(i))*EtaInv - AB(i) = A(i)-B(i) - CD(i) = C(i)-D(i) - PQ(i) = P(i)-Q(i) - W(i) = (Zeta*P(i)+Eta*Q(i))*ZetapEtaInv + P(i) = (Zeta_A*A(i) + Zeta_B*B(i))*ZetaInv + Q(i) = (Zeta_C*C(i) + Zeta_D*D(i))*EtaInv + AB(i) = A(i) - B(i) + CD(i) = C(i) - D(i) + PQ(i) = P(i) - Q(i) + W(i) = (Zeta*P(i) + Eta*Q(i))*ZetapEtaInv END DO AB2 = DOT_PRODUCT(AB, AB) CD2 = DOT_PRODUCT(CD, CD) PQ2 = DOT_PRODUCT(PQ, PQ) - S1234 = EXP((-Zeta_A*Zeta_B*ZetaInv*AB2)+(-Zeta_C*Zeta_D*EtaInv*CD2)) + S1234 = EXP((-Zeta_A*Zeta_B*ZetaInv*AB2) + (-Zeta_C*Zeta_D*EtaInv*CD2)) T = Rho*PQ2 SELECT CASE (potential_parameter%potential_type) @@ -121,7 +121,7 @@ SUBROUTINE build_quartet_data_screen(A, B, C, D, Zeta_A, Zeta_B, Zeta_C, Zeta_D, R = potential_parameter%cutoff_radius*SQRT(rho) R1 = R11 R2 = R22 - IF (PQ2 > (R1+R2+potential_parameter%cutoff_radius)**2) THEN + IF (PQ2 > (R1 + R2 + potential_parameter%cutoff_radius)**2) THEN RETURN END IF CALL t_c_g0_n(F(1), use_gamma, R, T, m_max) @@ -134,29 +134,29 @@ SUBROUTINE build_quartet_data_screen(A, B, C, D, Zeta_A, Zeta_B, Zeta_C, Zeta_D, R = potential_parameter%cutoff_radius*SQRT(rho) R1 = R11 R2 = R22 - IF (PQ2 > (R1+R2+potential_parameter%cutoff_radius)**2) THEN + IF (PQ2 > (R1 + R2 + potential_parameter%cutoff_radius)**2) THEN RETURN END IF CALL fgamma(m_max, T, F(1)) omega2 = potential_parameter%omega**2 - omega_corr2 = omega2/(omega2+Rho) + omega_corr2 = omega2/(omega2 + Rho) omega_corr = SQRT(omega_corr2) T = T*omega_corr2 CALL fgamma(m_max, T, Fm) tmp = -omega_corr - DO i = 1, m_max+1 - F(i) = F(i)+Fm(i)*tmp + DO i = 1, m_max + 1 + F(i) = F(i) + Fm(i)*tmp tmp = tmp*omega_corr2 END DO factor = 2.0_dp*Pi*RhoInv CASE (do_potential_long) omega2 = potential_parameter%omega**2 - omega_corr2 = omega2/(omega2+Rho) + omega_corr2 = omega2/(omega2 + Rho) omega_corr = SQRT(omega_corr2) T = T*omega_corr2 CALL fgamma(m_max, T, F(1)) tmp = omega_corr - DO i = 1, m_max+1 + DO i = 1, m_max + 1 F(i) = F(i)*tmp tmp = tmp*omega_corr2 END DO @@ -164,13 +164,13 @@ SUBROUTINE build_quartet_data_screen(A, B, C, D, Zeta_A, Zeta_B, Zeta_C, Zeta_D, CASE (do_potential_mix_cl) CALL fgamma(m_max, T, F(1)) omega2 = potential_parameter%omega**2 - omega_corr2 = omega2/(omega2+Rho) + omega_corr2 = omega2/(omega2 + Rho) omega_corr = SQRT(omega_corr2) T = T*omega_corr2 CALL fgamma(m_max, T, Fm) tmp = omega_corr - DO i = 1, m_max+1 - F(i) = F(i)*potential_parameter%scale_coulomb+Fm(i)*tmp*potential_parameter%scale_longrange + DO i = 1, m_max + 1 + F(i) = F(i)*potential_parameter%scale_coulomb + Fm(i)*tmp*potential_parameter%scale_longrange tmp = tmp*omega_corr2 END DO factor = 2.0_dp*Pi*RhoInv @@ -180,7 +180,7 @@ SUBROUTINE build_quartet_data_screen(A, B, C, D, Zeta_A, Zeta_B, Zeta_C, Zeta_D, R = potential_parameter%cutoff_radius*SQRT(rho) R1 = R11 R2 = R22 - IF (PQ2 > (R1+R2+potential_parameter%cutoff_radius)**2) THEN + IF (PQ2 > (R1 + R2 + potential_parameter%cutoff_radius)**2) THEN RETURN END IF CALL t_c_g0_n(F(1), use_gamma, R, T, m_max) @@ -189,62 +189,62 @@ SUBROUTINE build_quartet_data_screen(A, B, C, D, Zeta_A, Zeta_B, Zeta_C, Zeta_D, ! Coulomb CALL fgamma(m_max, T, Fm) - DO i = 1, m_max+1 - F(i) = F(i)*(potential_parameter%scale_coulomb+potential_parameter%scale_longrange)- & + DO i = 1, m_max + 1 + F(i) = F(i)*(potential_parameter%scale_coulomb + potential_parameter%scale_longrange) - & Fm(i)*potential_parameter%scale_longrange ENDDO ! longrange omega2 = potential_parameter%omega**2 - omega_corr2 = omega2/(omega2+Rho) + omega_corr2 = omega2/(omega2 + Rho) omega_corr = SQRT(omega_corr2) T = T*omega_corr2 CALL fgamma(m_max, T, Fm) tmp = omega_corr - DO i = 1, m_max+1 - F(i) = F(i)+Fm(i)*tmp*potential_parameter%scale_longrange + DO i = 1, m_max + 1 + F(i) = F(i) + Fm(i)*tmp*potential_parameter%scale_longrange tmp = tmp*omega_corr2 END DO factor = 2.0_dp*Pi*RhoInv CASE (do_potential_gaussian) omega2 = potential_parameter%omega**2 - T = -omega2*T/(Rho+omega2) + T = -omega2*T/(Rho + omega2) tmp = 1.0_dp - DO i = 1, m_max+1 + DO i = 1, m_max + 1 F(i) = EXP(T)*tmp - tmp = tmp*omega2/(Rho+omega2) + tmp = tmp*omega2/(Rho + omega2) END DO - factor = (Pi/(Rho+omega2))**(1.5_dp) + factor = (Pi/(Rho + omega2))**(1.5_dp) CASE (do_potential_mix_lg) omega2 = potential_parameter%omega**2 - omega_corr2 = omega2/(omega2+Rho) + omega_corr2 = omega2/(omega2 + Rho) omega_corr = SQRT(omega_corr2) T = T*omega_corr2 CALL fgamma(m_max, T, Fm) tmp = omega_corr*2.0_dp*Pi*RhoInv*potential_parameter%scale_longrange - DO i = 1, m_max+1 + DO i = 1, m_max + 1 Fm(i) = Fm(i)*tmp tmp = tmp*omega_corr2 END DO T = Rho*PQ2 - T = -omega2*T/(Rho+omega2) - tmp = (Pi/(Rho+omega2))**(1.5_dp)*potential_parameter%scale_gaussian - DO i = 1, m_max+1 - F(i) = EXP(T)*tmp+Fm(i) - tmp = tmp*omega2/(Rho+omega2) + T = -omega2*T/(Rho + omega2) + tmp = (Pi/(Rho + omega2))**(1.5_dp)*potential_parameter%scale_gaussian + DO i = 1, m_max + 1 + F(i) = EXP(T)*tmp + Fm(i) + tmp = tmp*omega2/(Rho + omega2) END DO factor = 1.0_dp CASE (do_potential_id) F(1) = (Pi*RhoInv)**(1.5_dp) - F(2:m_max+1) = 0.0_dp + F(2:m_max + 1) = 0.0_dp factor = 1.0_dp END SELECT tmp = (Pi*ZetapEtaInv)**3 factor = factor*S1234*SQRT(tmp) - DO i = 1, m_max+1 + DO i = 1, m_max + 1 F(i) = F(i)*factor ENDDO @@ -415,8 +415,8 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & tmp_max, tmp_max_virial, W(3), & ZetapEtaInv - m_max = n_a+n_b+n_c+n_d - m_max = m_max+1 + m_max = n_a + n_b + n_c + n_d + m_max = m_max + 1 mysize = ncoa*ncob*ncoc*ncod a_mysize = mysize @@ -430,13 +430,13 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & perm_case = 1 IF (n_a < n_b) THEN - perm_case = perm_case+1 + perm_case = perm_case + 1 END IF IF (n_c < n_d) THEN - perm_case = perm_case+2 + perm_case = perm_case + 2 END IF - IF (n_a+n_b > n_c+n_d) THEN - perm_case = perm_case+4 + IF (n_a + n_b > n_c + n_d) THEN + perm_case = perm_case + 4 END IF SELECT CASE (perm_case) @@ -462,17 +462,17 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & CALL cp_libint_get_derivs(n_d, n_c, n_b, n_a, deriv, work_forces, a_mysize) DO k = 4, 6 DO j = 1, mysize - work_forces(j, k) = -1.0_dp*(work_forces(j, k-3)+ & - work_forces(j, k+3)+ & - work_forces(j, k+6)) + work_forces(j, k) = -1.0_dp*(work_forces(j, k - 3) + & + work_forces(j, k + 3) + & + work_forces(j, k + 6)) END DO END DO DO k = 1, 12 DO j = 1, mysize - work(j, k) = work(j, k)+work_forces(j, k) + work(j, k) = work(j, k) + work_forces(j, k) END DO END DO - neris = neris+12*mysize + neris = neris + 12*mysize IF (use_virial) THEN CALL real_to_scaled(scoord(1:3), A, cell) CALL real_to_scaled(scoord(4:6), B, cell) @@ -481,7 +481,7 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & DO k = 1, 12 DO j = 1, mysize DO m = 1, 3 - work_virial(j, k, m) = work_virial(j, k, m)+work_forces(j, k)*scoord(INT((k-1)/3)*3+m) + work_virial(j, k, m) = work_virial(j, k, m) + work_forces(j, k)*scoord(INT((k - 1)/3)*3 + m) END DO END DO END DO @@ -497,13 +497,13 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & tmp_max_all = MAX(tmp_max_all, tmp_max) DO i = 1, ncoa - p1 = (i-1)*ncob + p1 = (i - 1)*ncob DO j = 1, ncob - p2 = (p1+j-1)*ncoc + p2 = (p1 + j - 1)*ncoc DO k = 1, ncoc - p3 = (p2+k-1)*ncod + p3 = (p2 + k - 1)*ncod DO l = 1, ncod - p4 = p3+l + p4 = p3 + l work2(i, j, k, l, full_perm1(n)) = work(p4, n) END DO END DO @@ -521,13 +521,13 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & tmp_max_all_virial = MAX(tmp_max_all_virial, tmp_max_virial) DO i = 1, ncoa - p1 = (i-1)*ncob + p1 = (i - 1)*ncob DO j = 1, ncob - p2 = (p1+j-1)*ncoc + p2 = (p1 + j - 1)*ncoc DO k = 1, ncoc - p3 = (p2+k-1)*ncod + p3 = (p2 + k - 1)*ncod DO l = 1, ncod - p4 = p3+l + p4 = p3 + l work2_virial(i, j, k, l, full_perm1(n), 1:3) = work_virial(p4, n, 1:3) END DO END DO @@ -557,17 +557,17 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & CALL cp_libint_get_derivs(n_d, n_c, n_a, n_b, deriv, work_forces, a_mysize) DO k = 4, 6 DO j = 1, mysize - work_forces(j, k) = -1.0_dp*(work_forces(j, k-3)+ & - work_forces(j, k+3)+ & - work_forces(j, k+6)) + work_forces(j, k) = -1.0_dp*(work_forces(j, k - 3) + & + work_forces(j, k + 3) + & + work_forces(j, k + 6)) ENDDO END DO DO k = 1, 12 DO j = 1, mysize - work(j, k) = work(j, k)+work_forces(j, k) + work(j, k) = work(j, k) + work_forces(j, k) END DO END DO - neris = neris+12*mysize + neris = neris + 12*mysize IF (use_virial) THEN CALL real_to_scaled(scoord(1:3), B, cell) CALL real_to_scaled(scoord(4:6), A, cell) @@ -576,7 +576,7 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & DO k = 1, 12 DO j = 1, mysize DO m = 1, 3 - work_virial(j, k, m) = work_virial(j, k, m)+work_forces(j, k)*scoord(INT((k-1)/3)*3+m) + work_virial(j, k, m) = work_virial(j, k, m) + work_forces(j, k)*scoord(INT((k - 1)/3)*3 + m) END DO END DO END DO @@ -592,13 +592,13 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & tmp_max_all = MAX(tmp_max_all, tmp_max) DO j = 1, ncob - p1 = (j-1)*ncoa + p1 = (j - 1)*ncoa DO i = 1, ncoa - p2 = (p1+i-1)*ncoc + p2 = (p1 + i - 1)*ncoc DO k = 1, ncoc - p3 = (p2+k-1)*ncod + p3 = (p2 + k - 1)*ncod DO l = 1, ncod - p4 = p3+l + p4 = p3 + l work2(i, j, k, l, full_perm2(n)) = work(p4, n) END DO END DO @@ -616,13 +616,13 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & tmp_max_all_virial = MAX(tmp_max_all_virial, tmp_max_virial) DO j = 1, ncob - p1 = (j-1)*ncoa + p1 = (j - 1)*ncoa DO i = 1, ncoa - p2 = (p1+i-1)*ncoc + p2 = (p1 + i - 1)*ncoc DO k = 1, ncoc - p3 = (p2+k-1)*ncod + p3 = (p2 + k - 1)*ncod DO l = 1, ncod - p4 = p3+l + p4 = p3 + l work2_virial(i, j, k, l, full_perm2(n), 1:3) = work_virial(p4, n, 1:3) END DO END DO @@ -652,17 +652,17 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & CALL cp_libint_get_derivs(n_c, n_d, n_b, n_a, deriv, work_forces, a_mysize) DO k = 4, 6 DO j = 1, mysize - work_forces(j, k) = -1.0_dp*(work_forces(j, k-3)+ & - work_forces(j, k+3)+ & - work_forces(j, k+6)) + work_forces(j, k) = -1.0_dp*(work_forces(j, k - 3) + & + work_forces(j, k + 3) + & + work_forces(j, k + 6)) END DO END DO DO k = 1, 12 DO j = 1, mysize - work(j, k) = work(j, k)+work_forces(j, k) + work(j, k) = work(j, k) + work_forces(j, k) END DO END DO - neris = neris+12*mysize + neris = neris + 12*mysize IF (use_virial) THEN CALL real_to_scaled(scoord(1:3), A, cell) CALL real_to_scaled(scoord(4:6), B, cell) @@ -671,7 +671,7 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & DO k = 1, 12 DO j = 1, mysize DO m = 1, 3 - work_virial(j, k, m) = work_virial(j, k, m)+work_forces(j, k)*scoord(INT((k-1)/3)*3+m) + work_virial(j, k, m) = work_virial(j, k, m) + work_forces(j, k)*scoord(INT((k - 1)/3)*3 + m) END DO END DO END DO @@ -687,13 +687,13 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & tmp_max_all = MAX(tmp_max_all, tmp_max) DO i = 1, ncoa - p1 = (i-1)*ncob + p1 = (i - 1)*ncob DO j = 1, ncob - p2 = (p1+j-1)*ncod + p2 = (p1 + j - 1)*ncod DO l = 1, ncod - p3 = (p2+l-1)*ncoc + p3 = (p2 + l - 1)*ncoc DO k = 1, ncoc - p4 = p3+k + p4 = p3 + k work2(i, j, k, l, full_perm3(n)) = work(p4, n) END DO END DO @@ -711,13 +711,13 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & tmp_max_all_virial = MAX(tmp_max_all_virial, tmp_max_virial) DO i = 1, ncoa - p1 = (i-1)*ncob + p1 = (i - 1)*ncob DO j = 1, ncob - p2 = (p1+j-1)*ncod + p2 = (p1 + j - 1)*ncod DO l = 1, ncod - p3 = (p2+l-1)*ncoc + p3 = (p2 + l - 1)*ncoc DO k = 1, ncoc - p4 = p3+k + p4 = p3 + k work2_virial(i, j, k, l, full_perm3(n), 1:3) = work_virial(p4, n, 1:3) END DO END DO @@ -746,17 +746,17 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & CALL cp_libint_get_derivs(n_c, n_d, n_a, n_b, deriv, work_forces, a_mysize) DO k = 4, 6 DO j = 1, mysize - work_forces(j, k) = -1.0_dp*(work_forces(j, k-3)+ & - work_forces(j, k+3)+ & - work_forces(j, k+6)) + work_forces(j, k) = -1.0_dp*(work_forces(j, k - 3) + & + work_forces(j, k + 3) + & + work_forces(j, k + 6)) END DO END DO DO k = 1, 12 DO j = 1, mysize - work(j, k) = work(j, k)+work_forces(j, k) + work(j, k) = work(j, k) + work_forces(j, k) END DO END DO - neris = neris+12*mysize + neris = neris + 12*mysize IF (use_virial) THEN CALL real_to_scaled(scoord(1:3), B, cell) CALL real_to_scaled(scoord(4:6), A, cell) @@ -765,7 +765,7 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & DO k = 1, 12 DO j = 1, mysize DO m = 1, 3 - work_virial(j, k, m) = work_virial(j, k, m)+work_forces(j, k)*scoord(INT((k-1)/3)*3+m) + work_virial(j, k, m) = work_virial(j, k, m) + work_forces(j, k)*scoord(INT((k - 1)/3)*3 + m) END DO END DO END DO @@ -781,13 +781,13 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & tmp_max_all = MAX(tmp_max_all, tmp_max) DO j = 1, ncob - p1 = (j-1)*ncoa + p1 = (j - 1)*ncoa DO i = 1, ncoa - p2 = (p1+i-1)*ncod + p2 = (p1 + i - 1)*ncod DO l = 1, ncod - p3 = (p2+l-1)*ncoc + p3 = (p2 + l - 1)*ncoc DO k = 1, ncoc - p4 = p3+k + p4 = p3 + k work2(i, j, k, l, full_perm4(n)) = work(p4, n) END DO END DO @@ -805,13 +805,13 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & tmp_max_all_virial = MAX(tmp_max_all_virial, tmp_max_virial) DO j = 1, ncob - p1 = (j-1)*ncoa + p1 = (j - 1)*ncoa DO i = 1, ncoa - p2 = (p1+i-1)*ncod + p2 = (p1 + i - 1)*ncod DO l = 1, ncod - p3 = (p2+l-1)*ncoc + p3 = (p2 + l - 1)*ncoc DO k = 1, ncoc - p4 = p3+k + p4 = p3 + k work2_virial(i, j, k, l, full_perm4(n), 1:3) = work_virial(p4, n, 1:3) END DO END DO @@ -840,17 +840,17 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & CALL cp_libint_get_derivs(n_b, n_a, n_d, n_c, deriv, work_forces, a_mysize) DO k = 4, 6 DO j = 1, mysize - work_forces(j, k) = -1.0_dp*(work_forces(j, k-3)+ & - work_forces(j, k+3)+ & - work_forces(j, k+6)) + work_forces(j, k) = -1.0_dp*(work_forces(j, k - 3) + & + work_forces(j, k + 3) + & + work_forces(j, k + 6)) END DO END DO DO k = 1, 12 DO j = 1, mysize - work(j, k) = work(j, k)+work_forces(j, k) + work(j, k) = work(j, k) + work_forces(j, k) END DO END DO - neris = neris+12*mysize + neris = neris + 12*mysize IF (use_virial) THEN CALL real_to_scaled(scoord(1:3), C, cell) CALL real_to_scaled(scoord(4:6), D, cell) @@ -859,7 +859,7 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & DO k = 1, 12 DO j = 1, mysize DO m = 1, 3 - work_virial(j, k, m) = work_virial(j, k, m)+work_forces(j, k)*scoord(INT((k-1)/3)*3+m) + work_virial(j, k, m) = work_virial(j, k, m) + work_forces(j, k)*scoord(INT((k - 1)/3)*3 + m) END DO END DO END DO @@ -875,13 +875,13 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & tmp_max_all = MAX(tmp_max_all, tmp_max) DO k = 1, ncoc - p1 = (k-1)*ncod + p1 = (k - 1)*ncod DO l = 1, ncod - p2 = (p1+l-1)*ncoa + p2 = (p1 + l - 1)*ncoa DO i = 1, ncoa - p3 = (p2+i-1)*ncob + p3 = (p2 + i - 1)*ncob DO j = 1, ncob - p4 = p3+j + p4 = p3 + j work2(i, j, k, l, full_perm5(n)) = work(p4, n) END DO END DO @@ -899,13 +899,13 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & tmp_max_all_virial = MAX(tmp_max_all_virial, tmp_max_virial) DO k = 1, ncoc - p1 = (k-1)*ncod + p1 = (k - 1)*ncod DO l = 1, ncod - p2 = (p1+l-1)*ncoa + p2 = (p1 + l - 1)*ncoa DO i = 1, ncoa - p3 = (p2+i-1)*ncob + p3 = (p2 + i - 1)*ncob DO j = 1, ncob - p4 = p3+j + p4 = p3 + j work2_virial(i, j, k, l, full_perm5(n), 1:3) = work_virial(p4, n, 1:3) END DO END DO @@ -935,17 +935,17 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & CALL cp_libint_get_derivs(n_a, n_b, n_d, n_c, deriv, work_forces, a_mysize) DO k = 4, 6 DO j = 1, mysize - work_forces(j, k) = -1.0_dp*(work_forces(j, k-3)+ & - work_forces(j, k+3)+ & - work_forces(j, k+6)) + work_forces(j, k) = -1.0_dp*(work_forces(j, k - 3) + & + work_forces(j, k + 3) + & + work_forces(j, k + 6)) END DO END DO DO k = 1, 12 DO j = 1, mysize - work(j, k) = work(j, k)+work_forces(j, k) + work(j, k) = work(j, k) + work_forces(j, k) END DO END DO - neris = neris+12*mysize + neris = neris + 12*mysize IF (use_virial) THEN CALL real_to_scaled(scoord(1:3), C, cell) CALL real_to_scaled(scoord(4:6), D, cell) @@ -954,7 +954,7 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & DO k = 1, 12 DO j = 1, mysize DO m = 1, 3 - work_virial(j, k, m) = work_virial(j, k, m)+work_forces(j, k)*scoord(INT((k-1)/3)*3+m) + work_virial(j, k, m) = work_virial(j, k, m) + work_forces(j, k)*scoord(INT((k - 1)/3)*3 + m) END DO END DO END DO @@ -970,13 +970,13 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & tmp_max_all = MAX(tmp_max_all, tmp_max) DO k = 1, ncoc - p1 = (k-1)*ncod + p1 = (k - 1)*ncod DO l = 1, ncod - p2 = (p1+l-1)*ncob + p2 = (p1 + l - 1)*ncob DO j = 1, ncob - p3 = (p2+j-1)*ncoa + p3 = (p2 + j - 1)*ncoa DO i = 1, ncoa - p4 = p3+i + p4 = p3 + i work2(i, j, k, l, full_perm6(n)) = work(p4, n) END DO END DO @@ -994,13 +994,13 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & tmp_max_all_virial = MAX(tmp_max_all_virial, tmp_max_virial) DO k = 1, ncoc - p1 = (k-1)*ncod + p1 = (k - 1)*ncod DO l = 1, ncod - p2 = (p1+l-1)*ncob + p2 = (p1 + l - 1)*ncob DO j = 1, ncob - p3 = (p2+j-1)*ncoa + p3 = (p2 + j - 1)*ncoa DO i = 1, ncoa - p4 = p3+i + p4 = p3 + i work2_virial(i, j, k, l, full_perm6(n), 1:3) = work_virial(p4, n, 1:3) END DO END DO @@ -1030,17 +1030,17 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & CALL cp_libint_get_derivs(n_b, n_a, n_c, n_d, deriv, work_forces, a_mysize) DO k = 4, 6 DO j = 1, mysize - work_forces(j, k) = -1.0_dp*(work_forces(j, k-3)+ & - work_forces(j, k+3)+ & - work_forces(j, k+6)) + work_forces(j, k) = -1.0_dp*(work_forces(j, k - 3) + & + work_forces(j, k + 3) + & + work_forces(j, k + 6)) END DO END DO DO k = 1, 12 DO j = 1, mysize - work(j, k) = work(j, k)+work_forces(j, k) + work(j, k) = work(j, k) + work_forces(j, k) END DO END DO - neris = neris+12*mysize + neris = neris + 12*mysize IF (use_virial) THEN CALL real_to_scaled(scoord(1:3), D, cell) CALL real_to_scaled(scoord(4:6), C, cell) @@ -1049,7 +1049,7 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & DO k = 1, 12 DO j = 1, mysize DO m = 1, 3 - work_virial(j, k, m) = work_virial(j, k, m)+work_forces(j, k)*scoord(INT((k-1)/3)*3+m) + work_virial(j, k, m) = work_virial(j, k, m) + work_forces(j, k)*scoord(INT((k - 1)/3)*3 + m) END DO END DO END DO @@ -1065,13 +1065,13 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & tmp_max_all = MAX(tmp_max_all, tmp_max) DO l = 1, ncod - p1 = (l-1)*ncoc + p1 = (l - 1)*ncoc DO k = 1, ncoc - p2 = (p1+k-1)*ncoa + p2 = (p1 + k - 1)*ncoa DO i = 1, ncoa - p3 = (p2+i-1)*ncob + p3 = (p2 + i - 1)*ncob DO j = 1, ncob - p4 = p3+j + p4 = p3 + j work2(i, j, k, l, full_perm7(n)) = work(p4, n) END DO END DO @@ -1089,13 +1089,13 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & tmp_max_all_virial = MAX(tmp_max_all_virial, tmp_max_virial) DO l = 1, ncod - p1 = (l-1)*ncoc + p1 = (l - 1)*ncoc DO k = 1, ncoc - p2 = (p1+k-1)*ncoa + p2 = (p1 + k - 1)*ncoa DO i = 1, ncoa - p3 = (p2+i-1)*ncob + p3 = (p2 + i - 1)*ncob DO j = 1, ncob - p4 = p3+j + p4 = p3 + j work2_virial(i, j, k, l, full_perm7(n), 1:3) = work_virial(p4, n, 1:3) END DO END DO @@ -1125,17 +1125,17 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & CALL cp_libint_get_derivs(n_a, n_b, n_c, n_d, deriv, work_forces, a_mysize) DO k = 4, 6 DO j = 1, mysize - work_forces(j, k) = -1.0_dp*(work_forces(j, k-3)+ & - work_forces(j, k+3)+ & - work_forces(j, k+6)) + work_forces(j, k) = -1.0_dp*(work_forces(j, k - 3) + & + work_forces(j, k + 3) + & + work_forces(j, k + 6)) END DO END DO DO k = 1, 12 DO j = 1, mysize - work(j, k) = work(j, k)+work_forces(j, k) + work(j, k) = work(j, k) + work_forces(j, k) END DO END DO - neris = neris+12*mysize + neris = neris + 12*mysize IF (use_virial) THEN CALL real_to_scaled(scoord(1:3), D, cell) CALL real_to_scaled(scoord(4:6), C, cell) @@ -1144,7 +1144,7 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & DO k = 1, 12 DO j = 1, mysize DO m = 1, 3 - work_virial(j, k, m) = work_virial(j, k, m)+work_forces(j, k)*scoord(INT((k-1)/3)*3+m) + work_virial(j, k, m) = work_virial(j, k, m) + work_forces(j, k)*scoord(INT((k - 1)/3)*3 + m) END DO END DO END DO @@ -1160,13 +1160,13 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & tmp_max_all = MAX(tmp_max_all, tmp_max) DO l = 1, ncod - p1 = (l-1)*ncoc + p1 = (l - 1)*ncoc DO k = 1, ncoc - p2 = (p1+k-1)*ncob + p2 = (p1 + k - 1)*ncob DO j = 1, ncob - p3 = (p2+j-1)*ncoa + p3 = (p2 + j - 1)*ncoa DO i = 1, ncoa - p4 = p3+i + p4 = p3 + i work2(i, j, k, l, full_perm8(n)) = work(p4, n) END DO END DO @@ -1184,13 +1184,13 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & tmp_max_all_virial = MAX(tmp_max_all_virial, tmp_max_virial) DO l = 1, ncod - p1 = (l-1)*ncoc + p1 = (l - 1)*ncoc DO k = 1, ncoc - p2 = (p1+k-1)*ncob + p2 = (p1 + k - 1)*ncob DO j = 1, ncob - p3 = (p2+j-1)*ncoa + p3 = (p2 + j - 1)*ncoa DO i = 1, ncoa - p4 = p3+i + p4 = p3 + i work2_virial(i, j, k, l, full_perm8(n), 1:3) = work_virial(p4, n, 1:3) END DO END DO @@ -1216,14 +1216,14 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & primitives_tmp(1, 1, 1, 1), & buffer1, buffer2) - primitives(s_offset_a+1:s_offset_a+nsoa*nl_a, & - s_offset_b+1:s_offset_b+nsob*nl_b, & - s_offset_c+1:s_offset_c+nsoc*nl_c, & - s_offset_d+1:s_offset_d+nsod*nl_d, i) = & - primitives(s_offset_a+1:s_offset_a+nsoa*nl_a, & - s_offset_b+1:s_offset_b+nsob*nl_b, & - s_offset_c+1:s_offset_c+nsoc*nl_c, & - s_offset_d+1:s_offset_d+nsod*nl_d, i)+primitives_tmp(:, :, :, :) + primitives(s_offset_a + 1:s_offset_a + nsoa*nl_a, & + s_offset_b + 1:s_offset_b + nsob*nl_b, & + s_offset_c + 1:s_offset_c + nsoc*nl_c, & + s_offset_d + 1:s_offset_d + nsod*nl_d, i) = & + primitives(s_offset_a + 1:s_offset_a + nsoa*nl_a, & + s_offset_b + 1:s_offset_b + nsob*nl_b, & + s_offset_c + 1:s_offset_c + nsoc*nl_c, & + s_offset_d + 1:s_offset_d + nsod*nl_d, i) + primitives_tmp(:, :, :, :) END DO END IF @@ -1240,14 +1240,14 @@ SUBROUTINE evaluate_deriv_eri(deriv, nproducts, pgf_product_list, & primitives_tmp_virial(1, 1, 1, 1), & buffer1, buffer2) - primitives_virial(s_offset_a+1:s_offset_a+nsoa*nl_a, & - s_offset_b+1:s_offset_b+nsob*nl_b, & - s_offset_c+1:s_offset_c+nsoc*nl_c, & - s_offset_d+1:s_offset_d+nsod*nl_d, i, m) = & - primitives_virial(s_offset_a+1:s_offset_a+nsoa*nl_a, & - s_offset_b+1:s_offset_b+nsob*nl_b, & - s_offset_c+1:s_offset_c+nsoc*nl_c, & - s_offset_d+1:s_offset_d+nsod*nl_d, i, m)+primitives_tmp_virial(:, :, :, :) + primitives_virial(s_offset_a + 1:s_offset_a + nsoa*nl_a, & + s_offset_b + 1:s_offset_b + nsob*nl_b, & + s_offset_c + 1:s_offset_c + nsoc*nl_c, & + s_offset_d + 1:s_offset_d + nsod*nl_d, i, m) = & + primitives_virial(s_offset_a + 1:s_offset_a + nsoa*nl_a, & + s_offset_b + 1:s_offset_b + nsob*nl_b, & + s_offset_c + 1:s_offset_c + nsoc*nl_c, & + s_offset_d + 1:s_offset_d + nsod*nl_d, i, m) + primitives_tmp_virial(:, :, :, :) END DO END DO END IF @@ -1295,20 +1295,20 @@ SUBROUTINE evaluate_eri_screen(libint, A, B, C, D, Zeta_A, Zeta_B, Zeta_C, Zeta_ INTEGER :: a_mysize(1), i, m_max, mysize, perm_case - m_max = n_a+n_b+n_c+n_d + m_max = n_a + n_b + n_c + n_d mysize = nco(n_a)*nco(n_b)*nco(n_c)*nco(n_d) a_mysize = mysize IF (m_max /= 0) THEN perm_case = 1 IF (n_a < n_b) THEN - perm_case = perm_case+1 + perm_case = perm_case + 1 END IF IF (n_c < n_d) THEN - perm_case = perm_case+2 + perm_case = perm_case + 2 END IF - IF (n_a+n_b > n_c+n_d) THEN - perm_case = perm_case+4 + IF (n_a + n_b > n_c + n_d) THEN + perm_case = perm_case + 4 END IF SELECT CASE (perm_case) @@ -1478,7 +1478,7 @@ SUBROUTINE evaluate_eri(libint, nproducts, pgf_product_list, & ZetapEtaInv REAL(KIND=dp), DIMENSION(prim_data_f_size) :: F - m_max = n_a+n_b+n_c+n_d + m_max = n_a + n_b + n_c + n_d mysize = ncoa*ncob*ncoc*ncod a_mysize = mysize @@ -1486,13 +1486,13 @@ SUBROUTINE evaluate_eri(libint, nproducts, pgf_product_list, & IF (m_max /= 0) THEN perm_case = 1 IF (n_a < n_b) THEN - perm_case = perm_case+1 + perm_case = perm_case + 1 END IF IF (n_c < n_d) THEN - perm_case = perm_case+2 + perm_case = perm_case + 2 END IF - IF (n_a+n_b > n_c+n_d) THEN - perm_case = perm_case+4 + IF (n_a + n_b > n_c + n_d) THEN + perm_case = perm_case + 4 END IF SELECT CASE (perm_case) CASE (1) @@ -1509,13 +1509,13 @@ SUBROUTINE evaluate_eri(libint, nproducts, pgf_product_list, & AB = pgf_product_list(i)%AB CD = pgf_product_list(i)%CD ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv - F(1:m_max+1) = pgf_product_list(i)%Fm(1:m_max+1) + F(1:m_max + 1) = pgf_product_list(i)%Fm(1:m_max + 1) CALL build_quartet_data(libint, A, B, C, D, ZetaInv, EtaInv, ZetapEtaInv, Rho, & P, Q, W, m_max, F) CALL cp_libint_get_eris(n_d, n_c, n_b, n_a, libint, p_work, a_mysize) - work(1:mysize) = work(1:mysize)+p_work(1:mysize) - neris = neris+mysize + work(1:mysize) = work(1:mysize) + p_work(1:mysize) + neris = neris + mysize END DO DO i = 1, mysize tmp_max = MAX(tmp_max, ABS(work(i))) @@ -1526,13 +1526,13 @@ SUBROUTINE evaluate_eri(libint, nproducts, pgf_product_list, & END IF DO i = 1, ncoa - p1 = (i-1)*ncob + p1 = (i - 1)*ncob DO j = 1, ncob - p2 = (p1+j-1)*ncoc + p2 = (p1 + j - 1)*ncoc DO k = 1, ncoc - p3 = (p2+k-1)*ncod + p3 = (p2 + k - 1)*ncod DO l = 1, ncod - p4 = p3+l + p4 = p3 + l work2(i, j, k, l) = work(p4) END DO END DO @@ -1552,15 +1552,15 @@ SUBROUTINE evaluate_eri(libint, nproducts, pgf_product_list, & AB = pgf_product_list(i)%AB CD = pgf_product_list(i)%CD ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv - F(1:m_max+1) = pgf_product_list(i)%Fm(1:m_max+1) + F(1:m_max + 1) = pgf_product_list(i)%Fm(1:m_max + 1) CALL build_quartet_data(libint, B, A, C, D, & ZetaInv, EtaInv, ZetapEtaInv, Rho, & P, Q, W, m_max, F) CALL cp_libint_get_eris(n_d, n_c, n_a, n_b, libint, p_work, a_mysize) - work(1:mysize) = work(1:mysize)+p_work(1:mysize) - neris = neris+mysize + work(1:mysize) = work(1:mysize) + p_work(1:mysize) + neris = neris + mysize END DO DO i = 1, mysize tmp_max = MAX(tmp_max, ABS(work(i))) @@ -1571,13 +1571,13 @@ SUBROUTINE evaluate_eri(libint, nproducts, pgf_product_list, & END IF DO j = 1, ncob - p1 = (j-1)*ncoa + p1 = (j - 1)*ncoa DO i = 1, ncoa - p2 = (p1+i-1)*ncoc + p2 = (p1 + i - 1)*ncoc DO k = 1, ncoc - p3 = (p2+k-1)*ncod + p3 = (p2 + k - 1)*ncod DO l = 1, ncod - p4 = p3+l + p4 = p3 + l work2(i, j, k, l) = work(p4) END DO END DO @@ -1597,15 +1597,15 @@ SUBROUTINE evaluate_eri(libint, nproducts, pgf_product_list, & AB = pgf_product_list(i)%AB CD = pgf_product_list(i)%CD ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv - F(1:m_max+1) = pgf_product_list(i)%Fm(1:m_max+1) + F(1:m_max + 1) = pgf_product_list(i)%Fm(1:m_max + 1) CALL build_quartet_data(libint, A, B, D, C, & ZetaInv, EtaInv, ZetapEtaInv, Rho, & P, Q, W, m_max, F) CALL cp_libint_get_eris(n_c, n_d, n_b, n_a, libint, p_work, a_mysize) - work(1:mysize) = work(1:mysize)+p_work(1:mysize) - neris = neris+mysize + work(1:mysize) = work(1:mysize) + p_work(1:mysize) + neris = neris + mysize END DO DO i = 1, mysize tmp_max = MAX(tmp_max, ABS(work(i))) @@ -1616,13 +1616,13 @@ SUBROUTINE evaluate_eri(libint, nproducts, pgf_product_list, & END IF DO i = 1, ncoa - p1 = (i-1)*ncob + p1 = (i - 1)*ncob DO j = 1, ncob - p2 = (p1+j-1)*ncod + p2 = (p1 + j - 1)*ncod DO l = 1, ncod - p3 = (p2+l-1)*ncoc + p3 = (p2 + l - 1)*ncoc DO k = 1, ncoc - p4 = p3+k + p4 = p3 + k work2(i, j, k, l) = work(p4) END DO END DO @@ -1642,15 +1642,15 @@ SUBROUTINE evaluate_eri(libint, nproducts, pgf_product_list, & AB = pgf_product_list(i)%AB CD = pgf_product_list(i)%CD ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv - F(1:m_max+1) = pgf_product_list(i)%Fm(1:m_max+1) + F(1:m_max + 1) = pgf_product_list(i)%Fm(1:m_max + 1) CALL build_quartet_data(libint, B, A, D, C, & ZetaInv, EtaInv, ZetapEtaInv, Rho, & P, Q, W, m_max, F) CALL cp_libint_get_eris(n_c, n_d, n_a, n_b, libint, p_work, a_mysize) - work(1:mysize) = work(1:mysize)+p_work(1:mysize) - neris = neris+mysize + work(1:mysize) = work(1:mysize) + p_work(1:mysize) + neris = neris + mysize END DO DO i = 1, mysize tmp_max = MAX(tmp_max, ABS(work(i))) @@ -1661,13 +1661,13 @@ SUBROUTINE evaluate_eri(libint, nproducts, pgf_product_list, & END IF DO j = 1, ncob - p1 = (j-1)*ncoa + p1 = (j - 1)*ncoa DO i = 1, ncoa - p2 = (p1+i-1)*ncod + p2 = (p1 + i - 1)*ncod DO l = 1, ncod - p3 = (p2+l-1)*ncoc + p3 = (p2 + l - 1)*ncoc DO k = 1, ncoc - p4 = p3+k + p4 = p3 + k work2(i, j, k, l) = work(p4) END DO END DO @@ -1687,15 +1687,15 @@ SUBROUTINE evaluate_eri(libint, nproducts, pgf_product_list, & AB = pgf_product_list(i)%AB CD = pgf_product_list(i)%CD ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv - F(1:m_max+1) = pgf_product_list(i)%Fm(1:m_max+1) + F(1:m_max + 1) = pgf_product_list(i)%Fm(1:m_max + 1) CALL build_quartet_data(libint, C, D, A, B, & EtaInv, ZetaInv, ZetapEtaInv, Rho, & Q, P, W, m_max, F) CALL cp_libint_get_eris(n_b, n_a, n_d, n_c, libint, p_work, a_mysize) - work(1:mysize) = work(1:mysize)+p_work(1:mysize) - neris = neris+mysize + work(1:mysize) = work(1:mysize) + p_work(1:mysize) + neris = neris + mysize END DO DO i = 1, mysize tmp_max = MAX(tmp_max, ABS(work(i))) @@ -1706,13 +1706,13 @@ SUBROUTINE evaluate_eri(libint, nproducts, pgf_product_list, & END IF DO k = 1, ncoc - p1 = (k-1)*ncod + p1 = (k - 1)*ncod DO l = 1, ncod - p2 = (p1+l-1)*ncoa + p2 = (p1 + l - 1)*ncoa DO i = 1, ncoa - p3 = (p2+i-1)*ncob + p3 = (p2 + i - 1)*ncob DO j = 1, ncob - p4 = p3+j + p4 = p3 + j work2(i, j, k, l) = work(p4) END DO END DO @@ -1732,15 +1732,15 @@ SUBROUTINE evaluate_eri(libint, nproducts, pgf_product_list, & AB = pgf_product_list(i)%AB CD = pgf_product_list(i)%CD ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv - F(1:m_max+1) = pgf_product_list(i)%Fm(1:m_max+1) + F(1:m_max + 1) = pgf_product_list(i)%Fm(1:m_max + 1) CALL build_quartet_data(libint, C, D, B, A, & EtaInv, ZetaInv, ZetapEtaInv, Rho, & Q, P, W, m_max, F) CALL cp_libint_get_eris(n_a, n_b, n_d, n_c, libint, p_work, a_mysize) - work(1:mysize) = work(1:mysize)+p_work(1:mysize) - neris = neris+mysize + work(1:mysize) = work(1:mysize) + p_work(1:mysize) + neris = neris + mysize END DO DO i = 1, mysize tmp_max = MAX(tmp_max, ABS(work(i))) @@ -1751,13 +1751,13 @@ SUBROUTINE evaluate_eri(libint, nproducts, pgf_product_list, & END IF DO k = 1, ncoc - p1 = (k-1)*ncod + p1 = (k - 1)*ncod DO l = 1, ncod - p2 = (p1+l-1)*ncob + p2 = (p1 + l - 1)*ncob DO j = 1, ncob - p3 = (p2+j-1)*ncoa + p3 = (p2 + j - 1)*ncoa DO i = 1, ncoa - p4 = p3+i + p4 = p3 + i work2(i, j, k, l) = work(p4) END DO END DO @@ -1777,15 +1777,15 @@ SUBROUTINE evaluate_eri(libint, nproducts, pgf_product_list, & AB = pgf_product_list(i)%AB CD = pgf_product_list(i)%CD ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv - F(1:m_max+1) = pgf_product_list(i)%Fm(1:m_max+1) + F(1:m_max + 1) = pgf_product_list(i)%Fm(1:m_max + 1) CALL build_quartet_data(libint, D, C, A, B, & EtaInv, ZetaInv, ZetapEtaInv, Rho, & Q, P, W, m_max, F) CALL cp_libint_get_eris(n_b, n_a, n_c, n_d, libint, p_work, a_mysize) - work(1:mysize) = work(1:mysize)+p_work(1:mysize) - neris = neris+mysize + work(1:mysize) = work(1:mysize) + p_work(1:mysize) + neris = neris + mysize END DO DO i = 1, mysize tmp_max = MAX(tmp_max, ABS(work(i))) @@ -1796,13 +1796,13 @@ SUBROUTINE evaluate_eri(libint, nproducts, pgf_product_list, & END IF DO l = 1, ncod - p1 = (l-1)*ncoc + p1 = (l - 1)*ncoc DO k = 1, ncoc - p2 = (p1+k-1)*ncoa + p2 = (p1 + k - 1)*ncoa DO i = 1, ncoa - p3 = (p2+i-1)*ncob + p3 = (p2 + i - 1)*ncob DO j = 1, ncob - p4 = p3+j + p4 = p3 + j work2(i, j, k, l) = work(p4) END DO END DO @@ -1822,15 +1822,15 @@ SUBROUTINE evaluate_eri(libint, nproducts, pgf_product_list, & AB = pgf_product_list(i)%AB CD = pgf_product_list(i)%CD ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv - F(1:m_max+1) = pgf_product_list(i)%Fm(1:m_max+1) + F(1:m_max + 1) = pgf_product_list(i)%Fm(1:m_max + 1) CALL build_quartet_data(libint, D, C, B, A, & EtaInv, ZetaInv, ZetapEtaInv, Rho, & Q, P, W, m_max, F) CALL cp_libint_get_eris(n_a, n_b, n_c, n_d, libint, p_work, a_mysize) - work(1:mysize) = work(1:mysize)+p_work(1:mysize) - neris = neris+mysize + work(1:mysize) = work(1:mysize) + p_work(1:mysize) + neris = neris + mysize END DO DO i = 1, mysize tmp_max = MAX(tmp_max, ABS(work(i))) @@ -1841,13 +1841,13 @@ SUBROUTINE evaluate_eri(libint, nproducts, pgf_product_list, & END IF DO l = 1, ncod - p1 = (l-1)*ncoc + p1 = (l - 1)*ncoc DO k = 1, ncoc - p2 = (p1+k-1)*ncob + p2 = (p1 + k - 1)*ncob DO j = 1, ncob - p3 = (p2+j-1)*ncoa + p3 = (p2 + j - 1)*ncoa DO i = 1, ncoa - p4 = p3+i + p4 = p3 + i work2(i, j, k, l) = work(p4) END DO END DO @@ -1866,13 +1866,13 @@ SUBROUTINE evaluate_eri(libint, nproducts, pgf_product_list, & Q = pgf_product_list(i)%Q W = pgf_product_list(i)%W ZetapEtaInv = pgf_product_list(i)%ZetapEtaInv - F(1:m_max+1) = pgf_product_list(i)%Fm(1:m_max+1) + F(1:m_max + 1) = pgf_product_list(i)%Fm(1:m_max + 1) CALL build_quartet_data(libint, A, B, C, D, & !todo: check ZetaInv, EtaInv, ZetapEtaInv, Rho, & P, Q, W, m_max, F) - work(1) = work(1)+F(1) - neris = neris+mysize + work(1) = work(1) + F(1) + neris = neris + mysize END DO work2(1, 1, 1, 1) = work(1) tmp_max = max_contraction*ABS(work(1)) @@ -1891,14 +1891,14 @@ SUBROUTINE evaluate_eri(libint, nproducts, pgf_product_list, & primitives_tmp, & buffer1, buffer2) - primitives(s_offset_a+1:s_offset_a+nsoa*nl_a, & - s_offset_b+1:s_offset_b+nsob*nl_b, & - s_offset_c+1:s_offset_c+nsoc*nl_c, & - s_offset_d+1:s_offset_d+nsod*nl_d) = & - primitives(s_offset_a+1:s_offset_a+nsoa*nl_a, & - s_offset_b+1:s_offset_b+nsob*nl_b, & - s_offset_c+1:s_offset_c+nsoc*nl_c, & - s_offset_d+1:s_offset_d+nsod*nl_d)+primitives_tmp(:, :, :, :) + primitives(s_offset_a + 1:s_offset_a + nsoa*nl_a, & + s_offset_b + 1:s_offset_b + nsob*nl_b, & + s_offset_c + 1:s_offset_c + nsoc*nl_c, & + s_offset_d + 1:s_offset_d + nsod*nl_d) = & + primitives(s_offset_a + 1:s_offset_a + nsoa*nl_a, & + s_offset_b + 1:s_offset_b + nsob*nl_b, & + s_offset_c + 1:s_offset_c + nsoc*nl_c, & + s_offset_d + 1:s_offset_d + nsod*nl_d) + primitives_tmp(:, :, :, :) END SUBROUTINE evaluate_eri diff --git a/src/hfx_load_balance_methods.F b/src/hfx_load_balance_methods.F index 6525685e52..8b18c3b3d8 100644 --- a/src/hfx_load_balance_methods.F +++ b/src/hfx_load_balance_methods.F @@ -218,7 +218,7 @@ SUBROUTINE hfx_load_balance(x_data, eps_schwarz, particle_set, max_set, para_env !$OMP MASTER CALL timeset(routineN//"_range", handle_range) - nblocks = MAX((natom+block_size-1)/block_size, 1) + nblocks = MAX((natom + block_size - 1)/block_size, 1) ALLOCATE (blocks_guess(nblocks)) ALLOCATE (tmp_blocks(natom)) ALLOCATE (tmp_blocks2(natom)) @@ -244,15 +244,15 @@ SUBROUTINE hfx_load_balance(x_data, eps_schwarz, particle_set, max_set, para_env total_block_self_cost = 0 DO i = 1, nblocks - total_block_self_cost = total_block_self_cost+blocks_guess(i)%cost + total_block_self_cost = total_block_self_cost + blocks_guess(i)%cost END DO CALL mp_sum(total_block_self_cost, para_env%group) objective_block_size = load_balance_parameter%block_size - objective_nblocks = MAX((natom+objective_block_size-1)/objective_block_size, 1) + objective_nblocks = MAX((natom + objective_block_size - 1)/objective_block_size, 1) - self_cost_per_block = (total_block_self_cost+objective_nblocks-1)/(objective_nblocks) + self_cost_per_block = (total_block_self_cost + objective_nblocks - 1)/(objective_nblocks) DO i = 1, nblocks tmp_blocks2(i) = blocks_guess(i) @@ -261,18 +261,18 @@ SUBROUTINE hfx_load_balance(x_data, eps_schwarz, particle_set, max_set, para_env optimized = .FALSE. i = 0 DO WHILE (.NOT. optimized) - i = i+1 + i = i + 1 current_block_id = 0 changed = .FALSE. DO atom_block = 1, nblocks - current_block_id = current_block_id+1 + current_block_id = current_block_id + 1 iatom_start = tmp_blocks2(atom_block)%istart iatom_end = tmp_blocks2(atom_block)%iend - IF (tmp_blocks2(atom_block)%cost > 1.5_dp*self_cost_per_block .AND. iatom_end-iatom_start > 0) THEN + IF (tmp_blocks2(atom_block)%cost > 1.5_dp*self_cost_per_block .AND. iatom_end - iatom_start > 0) THEN changed = .TRUE. new_iatom_start = iatom_start - new_iatom_end = (iatom_end-iatom_start+1)/2+iatom_start-1 - new_jatom_start = new_iatom_end+1 + new_iatom_end = (iatom_end - iatom_start + 1)/2 + iatom_start - 1 + new_jatom_start = new_iatom_end + 1 new_jatom_end = iatom_end tmp_blocks(current_block_id)%istart = new_iatom_start tmp_blocks(current_block_id)%iend = new_iatom_end @@ -287,7 +287,7 @@ SUBROUTINE hfx_load_balance(x_data, eps_schwarz, particle_set, max_set, para_env cell, & do_p_screening, map_atom_to_kind_atom, eval_type, & log10_eps_schwarz, log_2, coeffs_kind_max0, use_virial, atomic_pair_list) - current_block_id = current_block_id+1 + current_block_id = current_block_id + 1 tmp_blocks(current_block_id)%istart = new_jatom_start tmp_blocks(current_block_id)%iend = new_jatom_end tmp_blocks(current_block_id)%cost = estimate_block_cost( & @@ -321,18 +321,18 @@ SUBROUTINE hfx_load_balance(x_data, eps_schwarz, particle_set, max_set, para_env non_empty_blocks = 0 DO atom_block = 1, nblocks IF (tmp_blocks(atom_block)%istart == 0) CYCLE - non_empty_blocks = non_empty_blocks+1 + non_empty_blocks = non_empty_blocks + 1 END DO ALLOCATE (rcount(ncpu)) rcount = 0 - rcount(para_env%mepos+1) = non_empty_blocks + rcount(para_env%mepos + 1) = non_empty_blocks CALL mp_sum(rcount, para_env%group) ! ** sum all non_empty_blocks total_blocks = 0 DO i = 1, ncpu - total_blocks = total_blocks+rcount(i) + total_blocks = total_blocks + rcount(i) END DO ! ** calculate offsets @@ -340,7 +340,7 @@ SUBROUTINE hfx_load_balance(x_data, eps_schwarz, particle_set, max_set, para_env rcount(:) = rcount(:)*3 rdispl(1) = 0 DO i = 2, ncpu - rdispl(i) = rdispl(i-1)+rcount(i-1) + rdispl(i) = rdispl(i - 1) + rcount(i - 1) END DO ALLOCATE (buffer_in(3*non_empty_blocks)) @@ -348,10 +348,10 @@ SUBROUTINE hfx_load_balance(x_data, eps_schwarz, particle_set, max_set, para_env non_empty_blocks = 0 DO atom_block = 1, nblocks IF (tmp_blocks(atom_block)%istart == 0) CYCLE - buffer_in(non_empty_blocks*3+1) = tmp_blocks(atom_block)%istart - buffer_in(non_empty_blocks*3+2) = tmp_blocks(atom_block)%iend - buffer_in(non_empty_blocks*3+3) = tmp_blocks(atom_block)%cost - non_empty_blocks = non_empty_blocks+1 + buffer_in(non_empty_blocks*3 + 1) = tmp_blocks(atom_block)%istart + buffer_in(non_empty_blocks*3 + 2) = tmp_blocks(atom_block)%iend + buffer_in(non_empty_blocks*3 + 3) = tmp_blocks(atom_block)%cost + non_empty_blocks = non_empty_blocks + 1 END DO nblocks = total_blocks @@ -364,9 +364,9 @@ SUBROUTINE hfx_load_balance(x_data, eps_schwarz, particle_set, max_set, para_env CALL mp_allgather(buffer_in, buffer_out, rcount, rdispl, para_env%group) DO i = 1, nblocks - tmp_blocks2(i)%istart = INT(buffer_out((i-1)*3+1)) - tmp_blocks2(i)%iend = INT(buffer_out((i-1)*3+2)) - tmp_blocks2(i)%cost = buffer_out((i-1)*3+3) + tmp_blocks2(i)%istart = INT(buffer_out((i - 1)*3 + 1)) + tmp_blocks2(i)%iend = INT(buffer_out((i - 1)*3 + 2)) + tmp_blocks2(i)%cost = buffer_out((i - 1)*3 + 3) END DO ! ** Now we sort the blocks @@ -469,19 +469,19 @@ SUBROUTINE hfx_load_balance(x_data, eps_schwarz, particle_set, max_set, para_env !$OMP BARRIER cost_per_core = 0_int_8 - my_process_id = para_env%mepos*n_threads+i_thread + my_process_id = para_env%mepos*n_threads + i_thread nblocks = load_balance_parameter%nblocks - DO atom_block = my_process_id, INT(nblocks, KIND=int_8)**4-1, n_processes + DO atom_block = my_process_id, INT(nblocks, KIND=int_8)**4 - 1, n_processes - latom_block = INT(MODULO(atom_block, INT(nblocks, KIND=int_8)))+1 + latom_block = INT(MODULO(atom_block, INT(nblocks, KIND=int_8))) + 1 tmp_block = atom_block/nblocks - katom_block = INT(MODULO(tmp_block, INT(nblocks, KIND=int_8)))+1 + katom_block = INT(MODULO(tmp_block, INT(nblocks, KIND=int_8))) + 1 IF (latom_block < katom_block) CYCLE tmp_block = tmp_block/nblocks - jatom_block = INT(MODULO(tmp_block, INT(nblocks, KIND=int_8)))+1 + jatom_block = INT(MODULO(tmp_block, INT(nblocks, KIND=int_8))) + 1 tmp_block = tmp_block/nblocks - iatom_block = INT(MODULO(tmp_block, INT(nblocks, KIND=int_8)))+1 + iatom_block = INT(MODULO(tmp_block, INT(nblocks, KIND=int_8))) + 1 IF (jatom_block < iatom_block) CYCLE iatom_start = x_data%blocks(iatom_block)%istart @@ -500,30 +500,30 @@ SUBROUTINE hfx_load_balance(x_data, eps_schwarz, particle_set, max_set, para_env pmax_block(latom_block, iatom_block), & pmax_block(katom_block, jatom_block)) CASE (hfx_do_eval_forces) - pmax_blocks = MAX(pmax_block(katom_block, iatom_block)+ & + pmax_blocks = MAX(pmax_block(katom_block, iatom_block) + & pmax_block(latom_block, jatom_block), & - pmax_block(latom_block, iatom_block)+ & + pmax_block(latom_block, iatom_block) + & pmax_block(katom_block, jatom_block)) END SELECT - IF (2.0_dp*coeffs_kind_max0+pmax_blocks < log10_eps_schwarz) CYCLE + IF (2.0_dp*coeffs_kind_max0 + pmax_blocks < log10_eps_schwarz) CYCLE cost_per_core = cost_per_core & - +estimate_block_cost(natom, nkind, list_ij, list_kl, set_list_ij, set_list_kl, & - iatom_start, iatom_end, jatom_start, jatom_end, & - katom_start, katom_end, latom_start, latom_end, & - particle_set, & - coeffs_set, coeffs_kind, & - is_assoc_atomic_block_global, do_periodic, & - kind_of, basis_parameter, pmax_set, pmax_atom, pmax_blocks, & - cell, & - do_p_screening, map_atom_to_kind_atom, eval_type, & - log10_eps_schwarz, log_2, coeffs_kind_max0, use_virial, atomic_pair_list) + + estimate_block_cost(natom, nkind, list_ij, list_kl, set_list_ij, set_list_kl, & + iatom_start, iatom_end, jatom_start, jatom_end, & + katom_start, katom_end, latom_start, latom_end, & + particle_set, & + coeffs_set, coeffs_kind, & + is_assoc_atomic_block_global, do_periodic, & + kind_of, basis_parameter, pmax_set, pmax_atom, pmax_blocks, & + cell, & + do_p_screening, map_atom_to_kind_atom, eval_type, & + log10_eps_schwarz, log_2, coeffs_kind_max0, use_virial, atomic_pair_list) END DO ! atom_block nbins = load_balance_parameter%nbins - cost_per_bin = (cost_per_core+nbins-1)/(nbins) + cost_per_bin = (cost_per_core + nbins - 1)/(nbins) !$OMP BARRIER !$OMP MASTER @@ -567,19 +567,19 @@ SUBROUTINE hfx_load_balance(x_data, eps_schwarz, particle_set, max_set, para_env global_quartet_counter = 0 local_quartet_counter = 0 last_bin_needs_to_be_filled = .FALSE. - DO atom_block = my_process_id, INT(nblocks, KIND=int_8)**4-1, n_processes - latom_block = INT(MODULO(atom_block, INT(nblocks, KIND=int_8)))+1 + DO atom_block = my_process_id, INT(nblocks, KIND=int_8)**4 - 1, n_processes + latom_block = INT(MODULO(atom_block, INT(nblocks, KIND=int_8))) + 1 tmp_block = atom_block/nblocks - katom_block = INT(MODULO(tmp_block, INT(nblocks, KIND=int_8)))+1 + katom_block = INT(MODULO(tmp_block, INT(nblocks, KIND=int_8))) + 1 IF (latom_block < katom_block) CYCLE tmp_block = tmp_block/nblocks - jatom_block = INT(MODULO(tmp_block, INT(nblocks, KIND=int_8)))+1 + jatom_block = INT(MODULO(tmp_block, INT(nblocks, KIND=int_8))) + 1 tmp_block = tmp_block/nblocks - iatom_block = INT(MODULO(tmp_block, INT(nblocks, KIND=int_8)))+1 + iatom_block = INT(MODULO(tmp_block, INT(nblocks, KIND=int_8))) + 1 IF (jatom_block < iatom_block) CYCLE - distribution_counter_end = distribution_counter_end+1 - global_quartet_counter = global_quartet_counter+1 + distribution_counter_end = distribution_counter_end + 1 + global_quartet_counter = global_quartet_counter + 1 last_bin_needs_to_be_filled = .TRUE. IF (binned_dist(ibin)%istart == -1_int_8) binned_dist(ibin)%istart = atom_block @@ -600,36 +600,36 @@ SUBROUTINE hfx_load_balance(x_data, eps_schwarz, particle_set, max_set, para_env pmax_block(latom_block, iatom_block), & pmax_block(katom_block, jatom_block)) CASE (hfx_do_eval_forces) - pmax_blocks = MAX(pmax_block(katom_block, iatom_block)+ & + pmax_blocks = MAX(pmax_block(katom_block, iatom_block) + & pmax_block(latom_block, jatom_block), & - pmax_block(latom_block, iatom_block)+ & + pmax_block(latom_block, iatom_block) + & pmax_block(katom_block, jatom_block)) END SELECT - IF (2.0_dp*coeffs_kind_max0+pmax_blocks < log10_eps_schwarz) CYCLE + IF (2.0_dp*coeffs_kind_max0 + pmax_blocks < log10_eps_schwarz) CYCLE current_cost = current_cost & - +estimate_block_cost(natom, nkind, list_ij, list_kl, set_list_ij, set_list_kl, & - iatom_start, iatom_end, jatom_start, jatom_end, & - katom_start, katom_end, latom_start, latom_end, & - particle_set, & - coeffs_set, coeffs_kind, & - is_assoc_atomic_block_global, do_periodic, & - kind_of, basis_parameter, pmax_set, pmax_atom, pmax_blocks, & - cell, & - do_p_screening, map_atom_to_kind_atom, eval_type, & - log10_eps_schwarz, log_2, coeffs_kind_max0, use_virial, atomic_pair_list) + + estimate_block_cost(natom, nkind, list_ij, list_kl, set_list_ij, set_list_kl, & + iatom_start, iatom_end, jatom_start, jatom_end, & + katom_start, katom_end, latom_start, latom_end, & + particle_set, & + coeffs_set, coeffs_kind, & + is_assoc_atomic_block_global, do_periodic, & + kind_of, basis_parameter, pmax_set, pmax_atom, pmax_blocks, & + cell, & + do_p_screening, map_atom_to_kind_atom, eval_type, & + log10_eps_schwarz, log_2, coeffs_kind_max0, use_virial, atomic_pair_list) IF (current_cost >= cost_per_bin) THEN IF (ibin == nbins) THEN - binned_dist(ibin)%number_of_atom_quartets = binned_dist(ibin)%number_of_atom_quartets+ & - distribution_counter_end-distribution_counter_start+1 + binned_dist(ibin)%number_of_atom_quartets = binned_dist(ibin)%number_of_atom_quartets + & + distribution_counter_end - distribution_counter_start + 1 ELSE - binned_dist(ibin)%number_of_atom_quartets = distribution_counter_end-distribution_counter_start+1 + binned_dist(ibin)%number_of_atom_quartets = distribution_counter_end - distribution_counter_start + 1 END IF - binned_dist(ibin)%cost = binned_dist(ibin)%cost+current_cost - ibin = MIN(ibin+1, nbins) - distribution_counter_start = distribution_counter_end+1 + binned_dist(ibin)%cost = binned_dist(ibin)%cost + current_cost + ibin = MIN(ibin + 1, nbins) + distribution_counter_start = distribution_counter_end + 1 current_cost = 0 last_bin_needs_to_be_filled = .FALSE. END IF @@ -643,18 +643,18 @@ SUBROUTINE hfx_load_balance(x_data, eps_schwarz, particle_set, max_set, para_env !$OMP BARRIER !! Fill the last bin if necessary IF (last_bin_needs_to_be_filled) THEN - binned_dist(ibin)%cost = binned_dist(ibin)%cost+current_cost + binned_dist(ibin)%cost = binned_dist(ibin)%cost + current_cost IF (ibin == nbins) THEN - binned_dist(ibin)%number_of_atom_quartets = binned_dist(ibin)%number_of_atom_quartets+ & - distribution_counter_end-distribution_counter_start+1 + binned_dist(ibin)%number_of_atom_quartets = binned_dist(ibin)%number_of_atom_quartets + & + distribution_counter_end - distribution_counter_start + 1 ELSE - binned_dist(ibin)%number_of_atom_quartets = distribution_counter_end-distribution_counter_start+1 + binned_dist(ibin)%number_of_atom_quartets = distribution_counter_end - distribution_counter_start + 1 END IF END IF !! Sanity-Check DO ibin = 1, nbins - local_quartet_counter = local_quartet_counter+binned_dist(ibin)%number_of_atom_quartets + local_quartet_counter = local_quartet_counter + binned_dist(ibin)%number_of_atom_quartets END DO !$OMP BARRIER !$OMP MASTER @@ -663,9 +663,9 @@ SUBROUTINE hfx_load_balance(x_data, eps_schwarz, particle_set, max_set, para_env !$OMP END MASTER !$OMP BARRIER !$OMP ATOMIC - shm_local_quartet_counter = shm_local_quartet_counter+local_quartet_counter + shm_local_quartet_counter = shm_local_quartet_counter + local_quartet_counter !$OMP ATOMIC - shm_global_quartet_counter = shm_global_quartet_counter+global_quartet_counter + shm_global_quartet_counter = shm_global_quartet_counter + global_quartet_counter !$OMP BARRIER !$OMP MASTER @@ -688,9 +688,9 @@ SUBROUTINE hfx_load_balance(x_data, eps_schwarz, particle_set, max_set, para_env cost_matrix = 0 !$OMP END MASTER !$OMP BARRIER - icpu = para_env%mepos+1 + icpu = para_env%mepos + 1 DO i = 1, nbins - cost_matrix((icpu-1)*nbins*n_threads+i_thread*nbins+i) = binned_dist(i)%cost + cost_matrix((icpu - 1)*nbins*n_threads + i_thread*nbins + i) = binned_dist(i)%cost END DO mepos = para_env%mepos !$OMP BARRIER @@ -702,18 +702,18 @@ SUBROUTINE hfx_load_balance(x_data, eps_schwarz, particle_set, max_set, para_env ALLOCATE (sendbuffer(nbins*n_threads)) ALLOCATE (recbuffer(nbins*n_threads)) - sendbuffer = cost_matrix(mepos*nbins*n_threads+1:mepos*nbins*n_threads+nbins*n_threads) + sendbuffer = cost_matrix(mepos*nbins*n_threads + 1:mepos*nbins*n_threads + nbins*n_threads) - dest = MODULO(mepos+1, ncpu) - source = MODULO(mepos-1, ncpu) - DO icpu = 0, ncpu-1 - IF (icpu .NE. ncpu-1) THEN + dest = MODULO(mepos + 1, ncpu) + source = MODULO(mepos - 1, ncpu) + DO icpu = 0, ncpu - 1 + IF (icpu .NE. ncpu - 1) THEN CALL mp_isendrecv(sendbuffer, dest, recbuffer, source, & para_env%group, req(1), req(2), 13) ENDIF - data_from = MODULO(mepos-icpu, ncpu) - cost_matrix(data_from*nbins*n_threads+1:data_from*nbins*n_threads+nbins*n_threads) = sendbuffer - IF (icpu .NE. ncpu-1) THEN + data_from = MODULO(mepos - icpu, ncpu) + cost_matrix(data_from*nbins*n_threads + 1:data_from*nbins*n_threads + nbins*n_threads) = sendbuffer + IF (icpu .NE. ncpu - 1) THEN CALL mp_waitall(req) ENDIF swapbuffer => sendbuffer @@ -754,8 +754,8 @@ SUBROUTINE hfx_load_balance(x_data, eps_schwarz, particle_set, max_set, para_env full_dist(:, :)%time_forces = 0.0_dp !$OMP END MASTER !$OMP BARRIER - mepos = para_env%mepos+1 - full_dist((mepos-1)*n_threads+i_thread+1, :) = binned_dist(:) + mepos = para_env%mepos + 1 + full_dist((mepos - 1)*n_threads + i_thread + 1, :) = binned_dist(:) !$OMP BARRIER !$OMP MASTER @@ -764,31 +764,31 @@ SUBROUTINE hfx_load_balance(x_data, eps_schwarz, particle_set, max_set, para_env mepos = para_env%mepos DO j = 1, n_threads DO i = 1, nbins - sendbuffer((j-1)*3*nbins+(i-1)*3+1) = full_dist(mepos*n_threads+j, i)%istart - sendbuffer((j-1)*3*nbins+(i-1)*3+2) = full_dist(mepos*n_threads+j, i)%number_of_atom_quartets - sendbuffer((j-1)*3*nbins+(i-1)*3+3) = full_dist(mepos*n_threads+j, i)%cost + sendbuffer((j - 1)*3*nbins + (i - 1)*3 + 1) = full_dist(mepos*n_threads + j, i)%istart + sendbuffer((j - 1)*3*nbins + (i - 1)*3 + 2) = full_dist(mepos*n_threads + j, i)%number_of_atom_quartets + sendbuffer((j - 1)*3*nbins + (i - 1)*3 + 3) = full_dist(mepos*n_threads + j, i)%cost END DO END DO ! sync before/after ring of isendrecv CALL mp_sync(para_env%group) - dest = MODULO(mepos+1, ncpu) - source = MODULO(mepos-1, ncpu) - DO icpu = 0, ncpu-1 - IF (icpu .NE. ncpu-1) THEN + dest = MODULO(mepos + 1, ncpu) + source = MODULO(mepos - 1, ncpu) + DO icpu = 0, ncpu - 1 + IF (icpu .NE. ncpu - 1) THEN CALL mp_isendrecv(sendbuffer, dest, recbuffer, source, & para_env%group, req(1), req(2), 13) ENDIF - data_from = MODULO(mepos-icpu, ncpu) + data_from = MODULO(mepos - icpu, ncpu) DO j = 1, n_threads DO i = 1, nbins - full_dist(data_from*n_threads+j, i)%istart = sendbuffer((j-1)*3*nbins+(i-1)*3+1) - full_dist(data_from*n_threads+j, i)%number_of_atom_quartets = sendbuffer((j-1)*3*nbins+(i-1)*3+2) - full_dist(data_from*n_threads+j, i)%cost = sendbuffer((j-1)*3*nbins+(i-1)*3+3) + full_dist(data_from*n_threads + j, i)%istart = sendbuffer((j - 1)*3*nbins + (i - 1)*3 + 1) + full_dist(data_from*n_threads + j, i)%number_of_atom_quartets = sendbuffer((j - 1)*3*nbins + (i - 1)*3 + 2) + full_dist(data_from*n_threads + j, i)%cost = sendbuffer((j - 1)*3*nbins + (i - 1)*3 + 3) END DO END DO - IF (icpu .NE. ncpu-1) THEN + IF (icpu .NE. ncpu - 1) THEN CALL mp_waitall(req) ENDIF swapbuffer => sendbuffer @@ -815,18 +815,18 @@ SUBROUTINE hfx_load_balance(x_data, eps_schwarz, particle_set, max_set, para_env DO icpu = 1, n_processes DO i = 1, nbins - mepos = my_process_id+1 - IF (shm_distribution_vector((icpu-1)*nbins+i) == mepos) THEN + mepos = my_process_id + 1 + IF (shm_distribution_vector((icpu - 1)*nbins + i) == mepos) THEN tmp_dist(tmp_pos(mepos)) = full_dist(icpu, i) - tmp_pos(mepos) = tmp_pos(mepos)+1 + tmp_pos(mepos) = tmp_pos(mepos) + 1 END IF END DO END DO !! Assign the load to each process NULLIFY (ptr_to_tmp_dist) - mepos = my_process_id+1 - ptr_to_tmp_dist => tmp_dist(1:tmp_pos(mepos)-1) + mepos = my_process_id + 1 + ptr_to_tmp_dist => tmp_dist(1:tmp_pos(mepos) - 1) SELECT CASE (eval_type) CASE (hfx_do_eval_energy) CALL hfx_set_distr_energy(ptr_to_tmp_dist, x_data) @@ -993,20 +993,20 @@ SUBROUTINE hfx_recursive_load_balance(n_processes, my_process_id, nblocks, & nQ = numBins/q ! calc own position in P-Q-processor grid (PQ-grid is column-major) - pidx = MODULO(INT(my_process_id), INT(p))+1 - qidx = my_process_id/p+1 + pidx = MODULO(INT(my_process_id), INT(p)) + 1 + qidx = my_process_id/p + 1 - sizeP = SUM(blocksize((nP*(pidx-1)+1):(nP*pidx))) - sizeQ = SUM(blocksize((nQ*(qidx-1)+1):(nQ*qidx))) + sizeP = SUM(blocksize((nP*(pidx - 1) + 1):(nP*pidx))) + sizeQ = SUM(blocksize((nQ*(qidx - 1) + 1):(nQ*qidx))) - sumP = SUM(blocksize(1:(nP*(pidx-1)))) - sumQ = SUM(blocksize(1:(nQ*(qidx-1)))) + sumP = SUM(blocksize(1:(nP*(pidx - 1)))) + sumQ = SUM(blocksize(1:(nQ*(qidx - 1)))) ALLOCATE (p_atom_blocks(sizeP)) ALLOCATE (q_atom_blocks(sizeQ)) - p_atom_blocks(:) = permute((sumP+1):(sumP+sizeP)) - q_atom_blocks(:) = permute((sumQ+1):(sumQ+sizeQ)) + p_atom_blocks(:) = permute((sumP + 1):(sumP + sizeP)) + q_atom_blocks(:) = permute((sumQ + 1):(sumQ + sizeQ)) ! from here on, we are actually finished, each process has been ! assigned a (p_atom_blocks,q_atom_blocks) pair list. @@ -1021,9 +1021,9 @@ SUBROUTINE hfx_recursive_load_balance(n_processes, my_process_id, nblocks, & ! get corresponding 4D block indices out of our own P-Q-block latom_block = MODULO(q_atom_blocks(j), nblocks) - iatom_block = q_atom_blocks(j)/nblocks+1 + iatom_block = q_atom_blocks(j)/nblocks + 1 jatom_block = MODULO(p_atom_blocks(i), nblocks) - katom_block = p_atom_blocks(i)/nblocks+1 + katom_block = p_atom_blocks(i)/nblocks + 1 ! symmetry checks. IF (latom_block < katom_block) CYCLE @@ -1046,33 +1046,33 @@ SUBROUTINE hfx_recursive_load_balance(n_processes, my_process_id, nblocks, & pmax_block(latom_block, iatom_block), & pmax_block(katom_block, jatom_block)) CASE (hfx_do_eval_forces) - pmax_blocks = MAX(pmax_block(katom_block, iatom_block)+ & + pmax_blocks = MAX(pmax_block(katom_block, iatom_block) + & pmax_block(latom_block, jatom_block), & - pmax_block(latom_block, iatom_block)+ & + pmax_block(latom_block, iatom_block) + & pmax_block(katom_block, jatom_block)) END SELECT ! screening. - IF (2.0_dp*coeffs_kind_max0+pmax_blocks < log10_eps_schwarz) CYCLE + IF (2.0_dp*coeffs_kind_max0 + pmax_blocks < log10_eps_schwarz) CYCLE ! estimate the cost of this atom_block. - local_cost = local_cost+estimate_block_cost(natom, nkind, list_ij, list_kl, set_list_ij, & - set_list_kl, & - iatom_start, iatom_end, jatom_start, jatom_end, & - katom_start, katom_end, latom_start, latom_end, & - particle_set, & - coeffs_set, coeffs_kind, & - is_assoc_atomic_block_global, do_periodic, & - kind_of, basis_parameter, pmax_set, pmax_atom, pmax_blocks, & - cell, & - do_p_screening, map_atom_to_kind_atom, eval_type, & - log10_eps_schwarz, log_2, coeffs_kind_max0, use_virial, atomic_pair_list) + local_cost = local_cost + estimate_block_cost(natom, nkind, list_ij, list_kl, set_list_ij, & + set_list_kl, & + iatom_start, iatom_end, jatom_start, jatom_end, & + katom_start, katom_end, latom_start, latom_end, & + particle_set, & + coeffs_set, coeffs_kind, & + is_assoc_atomic_block_global, do_periodic, & + kind_of, basis_parameter, pmax_set, pmax_atom, pmax_blocks, & + cell, & + do_p_screening, map_atom_to_kind_atom, eval_type, & + log10_eps_schwarz, log_2, coeffs_kind_max0, use_virial, atomic_pair_list) END DO END DO ALLOCATE (local_cost_vector(n_processes)) local_cost_vector = 0 - local_cost_vector(my_process_id+1) = local_cost + local_cost_vector(my_process_id + 1) = local_cost CALL mp_sum(local_cost_vector, para_env%group) mean = SUM(local_cost_vector)/n_processes @@ -1135,7 +1135,7 @@ SUBROUTINE hfx_calculate_PQ(p, q, nBins, N) IF (MODULO(N, k) == 0) THEN p = k END IF - k = k+1 + k = k + 1 END DO q = N/p @@ -1147,9 +1147,9 @@ SUBROUTINE hfx_calculate_PQ(p, q, nBins, N) DO WHILE (b .NE. 0) IF (a > b) THEN - a = a-b + a = a - b ELSE - b = b-a + b = b - a END IF END DO ! gcd(p,q) is now saved in a @@ -1266,34 +1266,34 @@ RECURSIVE SUBROUTINE hfx_recursive_permute(blocksize, blockstart, blockend, nPro cost_vector = 0.0_dp ! loop over local atom_blocks. - DO atom_block = my_process_id, INT(nblocks, KIND=int_8)**4-1, n_processes + DO atom_block = my_process_id, INT(nblocks, KIND=int_8)**4 - 1, n_processes ! get corresponding 4D block indices - latom_block = INT(MODULO(atom_block, INT(nblocks, KIND=int_8)))+1 + latom_block = INT(MODULO(atom_block, INT(nblocks, KIND=int_8))) + 1 tmp_block = atom_block/nblocks - katom_block = INT(MODULO(tmp_block, INT(nblocks, KIND=int_8)))+1 + katom_block = INT(MODULO(tmp_block, INT(nblocks, KIND=int_8))) + 1 IF (latom_block < katom_block) CYCLE tmp_block = tmp_block/nblocks - jatom_block = INT(MODULO(tmp_block, INT(nblocks, KIND=int_8)))+1 + jatom_block = INT(MODULO(tmp_block, INT(nblocks, KIND=int_8))) + 1 tmp_block = tmp_block/nblocks - iatom_block = INT(MODULO(tmp_block, INT(nblocks, KIND=int_8)))+1 + iatom_block = INT(MODULO(tmp_block, INT(nblocks, KIND=int_8))) + 1 IF (jatom_block < iatom_block) CYCLE ! get 2D indices of this atom_block (with permutation applied) ! for this, we need to invert the permutation, this means ! find position in permutation vector where value==idx - row = (katom_block-1)*nblocks+jatom_block + row = (katom_block - 1)*nblocks + jatom_block inv_perm = 1 DO WHILE (permute(inv_perm) .NE. row) - inv_perm = inv_perm+1 + inv_perm = inv_perm + 1 END DO row = inv_perm - col = (iatom_block-1)*nblocks+latom_block + col = (iatom_block - 1)*nblocks + latom_block inv_perm = 1 DO WHILE (permute(inv_perm) .NE. col) - inv_perm = inv_perm+1 + inv_perm = inv_perm + 1 END DO col = inv_perm @@ -1318,14 +1318,14 @@ RECURSIVE SUBROUTINE hfx_recursive_permute(blocksize, blockstart, blockend, nPro pmax_block(latom_block, iatom_block), & pmax_block(katom_block, jatom_block)) CASE (hfx_do_eval_forces) - pmax_blocks = MAX(pmax_block(katom_block, iatom_block)+ & + pmax_blocks = MAX(pmax_block(katom_block, iatom_block) + & pmax_block(latom_block, jatom_block), & - pmax_block(latom_block, iatom_block)+ & + pmax_block(latom_block, iatom_block) + & pmax_block(katom_block, jatom_block)) END SELECT ! screening. - IF (2.0_dp*coeffs_kind_max0+pmax_blocks < log10_eps_schwarz) CYCLE + IF (2.0_dp*coeffs_kind_max0 + pmax_blocks < log10_eps_schwarz) CYCLE ! every second recursion step, compute row sum instead of column sum @@ -1348,7 +1348,7 @@ RECURSIVE SUBROUTINE hfx_recursive_permute(blocksize, blockstart, blockend, nPro do_p_screening, map_atom_to_kind_atom, eval_type, & log10_eps_schwarz, log_2, coeffs_kind_max0, use_virial, atomic_pair_list) - cost_vector(idx) = cost_vector(idx)+partialcost + cost_vector(idx) = cost_vector(idx) + partialcost END DO ! atom_block ! sum costvector over all processes @@ -1357,7 +1357,7 @@ RECURSIVE SUBROUTINE hfx_recursive_permute(blocksize, blockstart, blockend, nPro ! calculate next prime factor of nProc nBins = 2 DO WHILE (MODULO(INT(nProc), INT(nBins)) .NE. 0) - nBins = nBins+1 + nBins = nBins + 1 END DO nProc = nProc/nBins @@ -1365,7 +1365,7 @@ RECURSIVE SUBROUTINE hfx_recursive_permute(blocksize, blockstart, blockend, nPro ! ... do the binning... ALLOCATE (localblocksize(nBins)) - CALL hfx_permute_binning(nBins, cost_vector(blockstart:blockend), blockend-blockstart+1, bin_perm, localblocksize) + CALL hfx_permute_binning(nBins, cost_vector(blockstart:blockend), blockend - blockstart + 1, bin_perm, localblocksize) !... and update the permutation vector @@ -1376,11 +1376,11 @@ RECURSIVE SUBROUTINE hfx_recursive_permute(blocksize, blockstart, blockend, nPro IF (nProc > 1) THEN ALLOCATE (ithblocksize(nProc)) DO i = 1, nBins - startoffset = SUM(localblocksize(1:(i-1))) - endoffset = SUM(localblocksize(1:i))-1 + startoffset = SUM(localblocksize(1:(i - 1))) + endoffset = SUM(localblocksize(1:i)) - 1 - CALL hfx_recursive_permute(ithblocksize, blockstart+startoffset, blockstart+endoffset, nProc, & - permute, step+1, & + CALL hfx_recursive_permute(ithblocksize, blockstart + startoffset, blockstart + endoffset, nProc, & + permute, step + 1, & my_process_id, n_processes, nblocks, & natom, nkind, list_ij, list_kl, set_list_ij, set_list_kl, & particle_set, & @@ -1390,7 +1390,7 @@ RECURSIVE SUBROUTINE hfx_recursive_permute(blocksize, blockstart, blockend, nPro cell, x_data, para_env, pmax_block, & do_p_screening, map_atom_to_kind_atom, eval_type, & log10_eps_schwarz, log_2, coeffs_kind_max0, use_virial, atomic_pair_list) - blocksize(((i-1)*nProc+1):(i*nProc)) = ithblocksize + blocksize(((i - 1)*nProc + 1):(i*nProc)) = ithblocksize END DO DEALLOCATE (ithblocksize) ELSE @@ -1442,8 +1442,8 @@ SUBROUTINE hfx_permute_binning(nBins, costvector, maxbinsize, perm, block_count) DO i = maxbinsize, 1, -1 IF (vec(i) == 0) THEN ! spread zero-cost col/rows evenly among procs - mod_idx = MODULO(i, nBins)+1 !(note the fortran offset by one!) - block_count(mod_idx) = block_count(mod_idx)+1 + mod_idx = MODULO(i, nBins) + 1 !(note the fortran offset by one!) + block_count(mod_idx) = block_count(mod_idx) + 1 bin(mod_idx, block_count(mod_idx)) = idx(i) ELSE ! sort the bins so that the one with the lowest cost is at the @@ -1452,8 +1452,8 @@ SUBROUTINE hfx_permute_binning(nBins, costvector, maxbinsize, perm, block_count) block_count = block_count(bin_idx) bin = bin(bin_idx, :) - bincosts(1) = bincosts(1)+vec(i) - block_count(1) = block_count(1)+1 + bincosts(1) = bincosts(1) + vec(i) + block_count(1) = block_count(1) + 1 bin(1, block_count(1)) = idx(i) END IF END DO @@ -1462,9 +1462,9 @@ SUBROUTINE hfx_permute_binning(nBins, costvector, maxbinsize, perm, block_count) offset = 0 DO i = 1, nBins DO j = 1, block_count(i) - perm(offset+j) = bin(i, j) + perm(offset + j) = bin(i, j) END DO - offset = offset+block_count(i) + offset = offset + block_count(i) END DO END SUBROUTINE hfx_permute_binning @@ -1534,7 +1534,7 @@ SUBROUTINE hfx_update_load_balance(x_data, para_env, & DEALLOCATE (tmp_dist) ELSE mepos = para_env%mepos - my_process_id = para_env%mepos*n_threads+i_thread + my_process_id = para_env%mepos*n_threads + i_thread nbins = load_balance_parameter%nbins !$OMP MASTER ALLOCATE (bin_histogram(n_processes, 2)) @@ -1547,16 +1547,16 @@ SUBROUTINE hfx_update_load_balance(x_data, para_env, & CASE (hfx_do_eval_forces) my_bin_size = SIZE(x_data%distribution_forces) END SELECT - bin_histogram(my_process_id+1, 1) = my_bin_size + bin_histogram(my_process_id + 1, 1) = my_bin_size !$OMP BARRIER !$OMP MASTER CALL mp_sum(bin_histogram(:, 1), para_env%group) bin_histogram(1, 2) = bin_histogram(1, 1) DO iprocess = 2, n_processes - bin_histogram(iprocess, 2) = bin_histogram(iprocess-1, 2)+bin_histogram(iprocess, 1) + bin_histogram(iprocess, 2) = bin_histogram(iprocess - 1, 2) + bin_histogram(iprocess, 1) END DO - max_bin_size = MAXVAL(bin_histogram(para_env%mepos*n_threads+1:para_env%mepos*n_threads+n_threads, 1)) + max_bin_size = MAXVAL(bin_histogram(para_env%mepos*n_threads + 1:para_env%mepos*n_threads + n_threads, 1)) CALL mp_max(max_bin_size, para_env%group) !$OMP END MASTER !$OMP BARRIER @@ -1576,7 +1576,7 @@ SUBROUTINE hfx_update_load_balance(x_data, para_env, & SELECT CASE (eval_type) CASE (hfx_do_eval_energy) IF (.NOT. load_balance_parameter%rtp_redistribute) THEN - binned_dist(ibin)%cost = INT((binned_dist(ibin)%time_first_scf+ & + binned_dist(ibin)%cost = INT((binned_dist(ibin)%time_first_scf + & binned_dist(ibin)%time_other_scf)*10000.0_dp, int_8) ELSE binned_dist(ibin)%cost = INT((binned_dist(ibin)%time_other_scf)*10000.0_dp, int_8) @@ -1595,10 +1595,10 @@ SUBROUTINE hfx_update_load_balance(x_data, para_env, & ALLOCATE (recbuffer(max_bin_size*n_threads)) !$OMP END MASTER !$OMP BARRIER - my_global_start_idx = bin_histogram(my_process_id+1, 2)-my_bin_size - icpu = para_env%mepos+1 + my_global_start_idx = bin_histogram(my_process_id + 1, 2) - my_bin_size + icpu = para_env%mepos + 1 DO i = 1, my_bin_size - cost_matrix(my_global_start_idx+i) = binned_dist(i)%cost + cost_matrix(my_global_start_idx + i) = binned_dist(i)%cost END DO mepos = para_env%mepos @@ -1607,26 +1607,26 @@ SUBROUTINE hfx_update_load_balance(x_data, para_env, & ALLOCATE (bins_per_rank(ncpu)) bins_per_rank = 0 DO icpu = 1, ncpu - bins_per_rank(icpu) = SUM(bin_histogram((icpu-1)*n_threads+1:(icpu-1)*n_threads+n_threads, 1)) + bins_per_rank(icpu) = SUM(bin_histogram((icpu - 1)*n_threads + 1:(icpu - 1)*n_threads + n_threads, 1)) END DO - sendbuffer(1:bins_per_rank(para_env%mepos+1)) = & - cost_matrix(my_global_start_idx+1:my_global_start_idx+bins_per_rank(para_env%mepos+1)) + sendbuffer(1:bins_per_rank(para_env%mepos + 1)) = & + cost_matrix(my_global_start_idx + 1:my_global_start_idx + bins_per_rank(para_env%mepos + 1)) - dest = MODULO(mepos+1, ncpu) - source = MODULO(mepos-1, ncpu) + dest = MODULO(mepos + 1, ncpu) + source = MODULO(mepos - 1, ncpu) ! sync before/after ring of isendrecv CALL mp_sync(para_env%group) - DO icpu = 0, ncpu-1 - IF (icpu .NE. ncpu-1) THEN + DO icpu = 0, ncpu - 1 + IF (icpu .NE. ncpu - 1) THEN CALL mp_isendrecv(sendbuffer, dest, recbuffer, source, & para_env%group, req(1), req(2), 13) ENDIF - data_from = MODULO(mepos-icpu, ncpu) - start_idx = SUM(bins_per_rank(1:data_from+1))-bins_per_rank(data_from+1)+1 - end_idx = start_idx+bins_per_rank(data_from+1)-1 - cost_matrix(start_idx:end_idx) = sendbuffer(1:end_idx-start_idx+1) + data_from = MODULO(mepos - icpu, ncpu) + start_idx = SUM(bins_per_rank(1:data_from + 1)) - bins_per_rank(data_from + 1) + 1 + end_idx = start_idx + bins_per_rank(data_from + 1) - 1 + cost_matrix(start_idx:end_idx) = sendbuffer(1:end_idx - start_idx + 1) - IF (icpu .NE. ncpu-1) THEN + IF (icpu .NE. ncpu - 1) THEN CALL mp_waitall(req) ENDIF swapbuffer => sendbuffer @@ -1656,8 +1656,8 @@ SUBROUTINE hfx_update_load_balance(x_data, para_env, & !$OMP END MASTER !$OMP BARRIER - mepos = para_env%mepos+1 - full_dist((mepos-1)*n_threads+i_thread+1, 1:my_bin_size) = binned_dist(1:my_bin_size) + mepos = para_env%mepos + 1 + full_dist((mepos - 1)*n_threads + i_thread + 1, 1:my_bin_size) = binned_dist(1:my_bin_size) !$OMP BARRIER !$OMP MASTER ALLOCATE (sendbuffer(3*max_bin_size*n_threads)) @@ -1665,30 +1665,30 @@ SUBROUTINE hfx_update_load_balance(x_data, para_env, & mepos = para_env%mepos DO j = 1, n_threads DO i = 1, max_bin_size - sendbuffer((j-1)*3*max_bin_size+(i-1)*3+1) = full_dist(mepos*n_threads+j, i)%istart - sendbuffer((j-1)*3*max_bin_size+(i-1)*3+2) = full_dist(mepos*n_threads+j, i)%number_of_atom_quartets - sendbuffer((j-1)*3*max_bin_size+(i-1)*3+3) = full_dist(mepos*n_threads+j, i)%cost + sendbuffer((j - 1)*3*max_bin_size + (i - 1)*3 + 1) = full_dist(mepos*n_threads + j, i)%istart + sendbuffer((j - 1)*3*max_bin_size + (i - 1)*3 + 2) = full_dist(mepos*n_threads + j, i)%number_of_atom_quartets + sendbuffer((j - 1)*3*max_bin_size + (i - 1)*3 + 3) = full_dist(mepos*n_threads + j, i)%cost END DO END DO - dest = MODULO(mepos+1, ncpu) - source = MODULO(mepos-1, ncpu) + dest = MODULO(mepos + 1, ncpu) + source = MODULO(mepos - 1, ncpu) ! sync before/after ring of isendrecv CALL mp_sync(para_env%group) - DO icpu = 0, ncpu-1 - IF (icpu .NE. ncpu-1) THEN + DO icpu = 0, ncpu - 1 + IF (icpu .NE. ncpu - 1) THEN CALL mp_isendrecv(sendbuffer, dest, recbuffer, source, & para_env%group, req(1), req(2), 13) ENDIF - data_from = MODULO(mepos-icpu, ncpu) + data_from = MODULO(mepos - icpu, ncpu) DO j = 1, n_threads DO i = 1, max_bin_size - full_dist(data_from*n_threads+j, i)%istart = sendbuffer((j-1)*3*max_bin_size+(i-1)*3+1) - full_dist(data_from*n_threads+j, i)%number_of_atom_quartets = sendbuffer((j-1)*3*max_bin_size+(i-1)*3+2) - full_dist(data_from*n_threads+j, i)%cost = sendbuffer((j-1)*3*max_bin_size+(i-1)*3+3) + full_dist(data_from*n_threads + j, i)%istart = sendbuffer((j - 1)*3*max_bin_size + (i - 1)*3 + 1) + full_dist(data_from*n_threads + j, i)%number_of_atom_quartets = sendbuffer((j - 1)*3*max_bin_size + (i - 1)*3 + 2) + full_dist(data_from*n_threads + j, i)%cost = sendbuffer((j - 1)*3*max_bin_size + (i - 1)*3 + 3) END DO END DO - IF (icpu .NE. ncpu-1) THEN + IF (icpu .NE. ncpu - 1) THEN CALL mp_waitall(req) ENDIF swapbuffer => sendbuffer @@ -1712,20 +1712,20 @@ SUBROUTINE hfx_update_load_balance(x_data, para_env, & tmp_dist(:)%time_other_scf = 0.0_dp tmp_dist(:)%time_forces = 0.0_dp - mepos = my_process_id+1 + mepos = my_process_id + 1 DO icpu = 1, n_processes DO i = 1, bin_histogram(icpu, 1) - IF (shm_distribution_vector(bin_histogram(icpu, 2)-bin_histogram(icpu, 1)+i) == mepos) THEN + IF (shm_distribution_vector(bin_histogram(icpu, 2) - bin_histogram(icpu, 1) + i) == mepos) THEN tmp_dist(tmp_pos(mepos)) = full_dist(icpu, i) - tmp_pos(mepos) = tmp_pos(mepos)+1 + tmp_pos(mepos) = tmp_pos(mepos) + 1 END IF END DO END DO !! Assign the load to each process NULLIFY (ptr_to_tmp_dist) - mepos = my_process_id+1 - ptr_to_tmp_dist => tmp_dist(1:tmp_pos(mepos)-1) + mepos = my_process_id + 1 + ptr_to_tmp_dist => tmp_dist(1:tmp_pos(mepos) - 1) SELECT CASE (eval_type) CASE (hfx_do_eval_energy) CALL hfx_set_distr_energy(ptr_to_tmp_dist, x_data) @@ -1780,11 +1780,11 @@ FUNCTION cost_model(nsa, nsb, nsc, nsd, npgfa, npgfb, npgfc, npgfd, ratio, p1, p estimate1 = estimate_basic(p1) estimate2 = estimate_basic(p2) - mu = LOG(ABS(1.0E6_dp*p3(1))+1) + mu = LOG(ABS(1.0E6_dp*p3(1)) + 1) sigma = p3(2)*0.1_dp*mu - switch = 1.0_dp/(1.0_dp+EXP((LOG(estimate1)-mu)/sigma)) - estimate = estimate1*(1.0_dp-switch)+estimate2*switch - res = INT(estimate*0.001_dp, KIND=int_8)+1 + switch = 1.0_dp/(1.0_dp + EXP((LOG(estimate1) - mu)/sigma)) + estimate = estimate1*(1.0_dp - switch) + estimate2*switch + res = INT(estimate*0.001_dp, KIND=int_8) + 1 CONTAINS @@ -1804,9 +1804,9 @@ REAL(KIND=dp) FUNCTION estimate_basic(p) RESULT(res) p9 = p(9); p10 = p(10); p11 = p(11); p12 = p(12) res = poly2(nsa, p1, p2, p3)*poly2(nsb, p1, p2, p3)*poly2(nsc, p1, p2, p3)*poly2(nsd, p1, p2, p3)* & poly2(npgfa, p4, p5, p6)*poly2(npgfb, p4, p5, p6)*poly2(npgfc, p4, p5, p6)* & - poly2(npgfd, p4, p5, p6)*EXP(-p7*ratio+p8*ratio**2)+ & - 1000.0_dp*p9+poly2(nsa, p10, p11, p12)*poly2(nsb, p10, p11, p12)*poly2(nsc, p10, p11, p12)*poly2(nsd, p10, p11, p12) - res = 1+ABS(res) + poly2(npgfd, p4, p5, p6)*EXP(-p7*ratio + p8*ratio**2) + & + 1000.0_dp*p9 + poly2(nsa, p10, p11, p12)*poly2(nsb, p10, p11, p12)*poly2(nsc, p10, p11, p12)*poly2(nsd, p10, p11, p12) + res = 1 + ABS(res) END FUNCTION estimate_basic ! ************************************************************************************************** @@ -1821,7 +1821,7 @@ REAL(KIND=dp) FUNCTION poly2(x, a0, a1, a2) INTEGER :: x REAL(KIND=dp) :: a0, a1, a2 - poly2 = a0+a1*x+a2*x*x + poly2 = a0 + a1*x + a2*x*x END FUNCTION poly2 END FUNCTION cost_model @@ -1885,8 +1885,8 @@ SUBROUTINE optimize_distribution(total_number_of_bins, number_of_processes, bin_ END IF DO j = 1, MIN(i, nstep) itmp = tmp_cpu_index(j) - distribution_vector(tmp_index(i-j+1)) = itmp - my_cost_cpu(itmp) = my_cost_cpu(itmp)+bin_costs(tmp_index(i-j+1)) + distribution_vector(tmp_index(i - j + 1)) = itmp + my_cost_cpu(itmp) = my_cost_cpu(itmp) + bin_costs(tmp_index(i - j + 1)) ENDDO ENDDO @@ -1919,7 +1919,7 @@ PURE FUNCTION get_1D_idx(i, j, N) INTEGER(int_8) :: min_ij min_ij = MIN(i, j) - get_1D_idx = min_ij*N+MAX(i, j)-(min_ij-1)*min_ij/2-N + get_1D_idx = min_ij*N + MAX(i, j) - (min_ij - 1)*min_ij/2 - N END FUNCTION get_1D_idx @@ -2041,8 +2041,8 @@ FUNCTION estimate_block_cost(natom, nkind, list_ij, list_kl, set_list_ij, set_li katom = list_kl%elements(i_list_kl)%pair(1) latom = list_kl%elements(i_list_kl)%pair(2) - IF (.NOT. (katom+latom <= iatom+jatom)) CYCLE - IF (((iatom+jatom) .EQ. (katom+latom)) .AND. (katom < iatom)) CYCLE + IF (.NOT. (katom + latom <= iatom + jatom)) CYCLE + IF (((iatom + jatom) .EQ. (katom + latom)) .AND. (katom < iatom)) CYCLE IF (eval_type == hfx_do_eval_forces) THEN IF (.NOT. use_virial) THEN @@ -2070,11 +2070,11 @@ FUNCTION estimate_block_cost(natom, nkind, list_ij, list_kl, set_list_ij, set_li actual_pmax_atom = 0.0_dp END IF - screen_kind_ij = coeffs_kind(jkind, ikind)%x(1)*rab2+ & + screen_kind_ij = coeffs_kind(jkind, ikind)%x(1)*rab2 + & coeffs_kind(jkind, ikind)%x(2) - screen_kind_kl = coeffs_kind(lkind, kkind)%x(1)*rcd2+ & + screen_kind_kl = coeffs_kind(lkind, kkind)%x(1)*rcd2 + & coeffs_kind(lkind, kkind)%x(2) - IF (screen_kind_ij+screen_kind_kl+actual_pmax_atom < log10_eps_schwarz) CYCLE + IF (screen_kind_ij + screen_kind_kl + actual_pmax_atom < log10_eps_schwarz) CYCLE IF (.NOT. (is_assoc_atomic_block_global(latom, iatom) >= 1 .AND. & is_assoc_atomic_block_global(katom, iatom) >= 1 .AND. & @@ -2094,7 +2094,7 @@ FUNCTION estimate_block_cost(natom, nkind, list_ij, list_kl, set_list_ij, set_li ptr_p_1 => pmax_set(kind_kind_idx)%p_kind(:, :, & map_atom_to_kind_atom(iatom), & map_atom_to_kind_atom(katom)) - swap_id = swap_id+1 + swap_id = swap_id + 1 END IF kind_kind_idx = INT(get_1D_idx(lkind, jkind, INT(nkind, int_8))) IF (jkind >= lkind) THEN @@ -2105,7 +2105,7 @@ FUNCTION estimate_block_cost(natom, nkind, list_ij, list_kl, set_list_ij, set_li ptr_p_2 => pmax_set(kind_kind_idx)%p_kind(:, :, & map_atom_to_kind_atom(jatom), & map_atom_to_kind_atom(latom)) - swap_id = swap_id+2 + swap_id = swap_id + 2 END IF kind_kind_idx = INT(get_1D_idx(lkind, ikind, INT(nkind, int_8))) IF (ikind >= lkind) THEN @@ -2116,7 +2116,7 @@ FUNCTION estimate_block_cost(natom, nkind, list_ij, list_kl, set_list_ij, set_li ptr_p_3 => pmax_set(kind_kind_idx)%p_kind(:, :, & map_atom_to_kind_atom(iatom), & map_atom_to_kind_atom(latom)) - swap_id = swap_id+4 + swap_id = swap_id + 4 END IF kind_kind_idx = INT(get_1D_idx(kkind, jkind, INT(nkind, int_8))) IF (jkind >= kkind) THEN @@ -2127,7 +2127,7 @@ FUNCTION estimate_block_cost(natom, nkind, list_ij, list_kl, set_list_ij, set_li ptr_p_4 => pmax_set(kind_kind_idx)%p_kind(:, :, & map_atom_to_kind_atom(jatom), & map_atom_to_kind_atom(katom)) - swap_id = swap_id+8 + swap_id = swap_id + 8 END IF CASE (hfx_do_eval_forces) swap_id = 16 @@ -2140,7 +2140,7 @@ FUNCTION estimate_block_cost(natom, nkind, list_ij, list_kl, set_list_ij, set_li ptr_p_1 => pmax_set(kind_kind_idx)%p_kind(:, :, & map_atom_to_kind_atom(iatom), & map_atom_to_kind_atom(katom)) - swap_id = swap_id+1 + swap_id = swap_id + 1 END IF kind_kind_idx = INT(get_1D_idx(lkind, jkind, INT(nkind, int_8))) IF (jkind >= lkind) THEN @@ -2151,7 +2151,7 @@ FUNCTION estimate_block_cost(natom, nkind, list_ij, list_kl, set_list_ij, set_li ptr_p_2 => pmax_set(kind_kind_idx)%p_kind(:, :, & map_atom_to_kind_atom(jatom), & map_atom_to_kind_atom(latom)) - swap_id = swap_id+2 + swap_id = swap_id + 2 END IF kind_kind_idx = INT(get_1D_idx(lkind, ikind, INT(nkind, int_8))) IF (ikind >= lkind) THEN @@ -2162,7 +2162,7 @@ FUNCTION estimate_block_cost(natom, nkind, list_ij, list_kl, set_list_ij, set_li ptr_p_3 => pmax_set(kind_kind_idx)%p_kind(:, :, & map_atom_to_kind_atom(iatom), & map_atom_to_kind_atom(latom)) - swap_id = swap_id+4 + swap_id = swap_id + 4 END IF kind_kind_idx = INT(get_1D_idx(kkind, jkind, INT(nkind, int_8))) IF (jkind >= kkind) THEN @@ -2173,7 +2173,7 @@ FUNCTION estimate_block_cost(natom, nkind, list_ij, list_kl, set_list_ij, set_li ptr_p_4 => pmax_set(kind_kind_idx)%p_kind(:, :, & map_atom_to_kind_atom(jatom), & map_atom_to_kind_atom(katom)) - swap_id = swap_id+8 + swap_id = swap_id + 8 END IF END SELECT END IF @@ -2182,29 +2182,29 @@ FUNCTION estimate_block_cost(natom, nkind, list_ij, list_kl, set_list_ij, set_li iset = set_list_ij(i_set_list_ij)%pair(1) jset = set_list_ij(i_set_list_ij)%pair(2) - max_val1 = coeffs_set(jset, iset, jkind, ikind)%x(1)*rab2+ & + max_val1 = coeffs_set(jset, iset, jkind, ikind)%x(1)*rab2 + & coeffs_set(jset, iset, jkind, ikind)%x(2) - IF (max_val1+screen_kind_kl+actual_pmax_atom < log10_eps_schwarz) CYCLE + IF (max_val1 + screen_kind_kl + actual_pmax_atom < log10_eps_schwarz) CYCLE DO i_set_list_kl = i_set_list_kl_start, i_set_list_kl_stop kset = set_list_kl(i_set_list_kl)%pair(1) lset = set_list_kl(i_set_list_kl)%pair(2) - max_val2 = max_val1+(coeffs_set(lset, kset, lkind, kkind)%x(1)*rcd2+ & - coeffs_set(lset, kset, lkind, kkind)%x(2)) + max_val2 = max_val1 + (coeffs_set(lset, kset, lkind, kkind)%x(1)*rcd2 + & + coeffs_set(lset, kset, lkind, kkind)%x(2)) - IF (max_val2+actual_pmax_atom < log10_eps_schwarz) CYCLE + IF (max_val2 + actual_pmax_atom < log10_eps_schwarz) CYCLE IF (do_p_screening) THEN CALL get_pmax_val(ptr_p_1, ptr_p_2, ptr_p_3, ptr_p_4, & iset, jset, kset, lset, & pmax_entry, swap_id) IF (eval_type == hfx_do_eval_forces) THEN - pmax_entry = log_2+pmax_entry + pmax_entry = log_2 + pmax_entry END IF ELSE pmax_entry = 0.0_dp END IF - max_val2 = max_val2+pmax_entry + max_val2 = max_val2 + pmax_entry IF (max_val2 < log10_eps_schwarz) CYCLE SELECT CASE (eval_type) CASE (hfx_do_eval_energy) @@ -2212,13 +2212,13 @@ FUNCTION estimate_block_cost(natom, nkind, list_ij, list_kl, set_list_ij, set_li npgfa(iset), npgfb(jset), npgfc(kset), npgfd(lset), & max_val2/log10_eps_schwarz, & p1_energy, p2_energy, p3_energy) - estimate_block_cost = estimate_block_cost+INT(cost_tmp, KIND=int_8) + estimate_block_cost = estimate_block_cost + INT(cost_tmp, KIND=int_8) CASE (hfx_do_eval_forces) cost_tmp = cost_model(nsgfa(iset), nsgfb(jset), nsgfc(kset), nsgfd(lset), & npgfa(iset), npgfb(jset), npgfc(kset), npgfd(lset), & max_val2/log10_eps_schwarz, & p1_forces, p2_forces, p3_forces) - estimate_block_cost = estimate_block_cost+INT(cost_tmp, KIND=int_8) + estimate_block_cost = estimate_block_cost + INT(cost_tmp, KIND=int_8) END SELECT ENDDO ! i_set_list_kl ENDDO ! i_set_list_ij @@ -2300,13 +2300,13 @@ SUBROUTINE init_blocks(nkind, para_env, natom, block_size, nblock, blocks, & INTEGER :: atom_block, i, iatom_block, iatom_end, & iatom_start, my_cpu_rank, ncpus - DO atom_block = 0, nblock-1 - iatom_block = MODULO(atom_block, nblock)+1 - iatom_start = (iatom_block-1)*block_size+1 + DO atom_block = 0, nblock - 1 + iatom_block = MODULO(atom_block, nblock) + 1 + iatom_start = (iatom_block - 1)*block_size + 1 iatom_end = MIN(iatom_block*block_size, natom) - blocks(atom_block+1)%istart = iatom_start - blocks(atom_block+1)%iend = iatom_end - blocks(atom_block+1)%cost = 0_int_8 + blocks(atom_block + 1)%istart = iatom_start + blocks(atom_block + 1)%iend = iatom_end + blocks(atom_block + 1)%cost = 0_int_8 END DO ncpus = para_env%num_pe @@ -2370,15 +2370,15 @@ SUBROUTINE collect_load_balance_info(para_env, x_data, iw, n_threads, i_thread, !$OMP MASTER ALLOCATE (shm_bins_per_rank(n_threads)) - ALLOCATE (shm_displ(n_threads+1)) + ALLOCATE (shm_displ(n_threads + 1)) !$OMP END MASTER !$OMP BARRIER - shm_bins_per_rank(i_thread+1) = nbins + shm_bins_per_rank(i_thread + 1) = nbins !$OMP BARRIER nbins = 0 DO i = 1, n_threads - nbins = nbins+shm_bins_per_rank(i) + nbins = nbins + shm_bins_per_rank(i) END DO my_rank = para_env%mepos nranks = para_env%num_pe @@ -2388,36 +2388,36 @@ SUBROUTINE collect_load_balance_info(para_env, x_data, iw, n_threads, i_thread, ALLOCATE (bins_per_rank(nranks)) bins_per_rank = 0 - bins_per_rank(my_rank+1) = nbins + bins_per_rank(my_rank + 1) = nbins CALL mp_sum(bins_per_rank, para_env%group) total_bins = 0 DO i = 1, nranks - total_bins = total_bins+bins_per_rank(i) + total_bins = total_bins + bins_per_rank(i) END DO ALLOCATE (shm_cost_vector(2*total_bins)) shm_cost_vector = -1_int_8 shm_displ(1) = 1 DO i = 2, n_threads - shm_displ(i) = shm_displ(i-1)+shm_bins_per_rank(i-1) + shm_displ(i) = shm_displ(i - 1) + shm_bins_per_rank(i - 1) END DO - shm_displ(n_threads+1) = nbins+1 + shm_displ(n_threads + 1) = nbins + 1 !$OMP END MASTER !$OMP BARRIER j = 0 SELECT CASE (eval_type) CASE (hfx_do_eval_energy) - DO i = shm_displ(i_thread+1), shm_displ(i_thread+2)-1 - j = j+1 - shm_cost_vector(2*(i-1)+1) = x_data%distribution_energy(j)%cost + DO i = shm_displ(i_thread + 1), shm_displ(i_thread + 2) - 1 + j = j + 1 + shm_cost_vector(2*(i - 1) + 1) = x_data%distribution_energy(j)%cost shm_cost_vector(2*i) = INT(x_data%distribution_energy(j)%time_first_scf*10000.0_dp, KIND=int_8) END DO CASE (hfx_do_eval_forces) - DO i = shm_displ(i_thread+1), shm_displ(i_thread+2)-1 - j = j+1 - shm_cost_vector(2*(i-1)+1) = x_data%distribution_forces(j)%cost + DO i = shm_displ(i_thread + 1), shm_displ(i_thread + 2) - 1 + j = j + 1 + shm_cost_vector(2*(i - 1) + 1) = x_data%distribution_forces(j)%cost shm_cost_vector(2*i) = INT(x_data%distribution_forces(j)%time_forces*10000.0_dp, KIND=int_8) END DO END SELECT @@ -2428,14 +2428,14 @@ SUBROUTINE collect_load_balance_info(para_env, x_data, iw, n_threads, i_thread, bins_per_rank(:) = bins_per_rank(:)*2 rdispl(1) = 0 DO i = 2, nranks - rdispl(i) = rdispl(i-1)+bins_per_rank(i-1) + rdispl(i) = rdispl(i - 1) + bins_per_rank(i - 1) END DO ALLOCATE (buffer_in(2*nbins)) ALLOCATE (buffer_out(2*total_bins)) DO i = 1, nbins - buffer_in(2*(i-1)+1) = shm_cost_vector(2*(i-1)+1) + buffer_in(2*(i - 1) + 1) = shm_cost_vector(2*(i - 1) + 1) buffer_in(2*i) = shm_cost_vector(2*i) END DO @@ -2462,11 +2462,11 @@ SUBROUTINE collect_load_balance_info(para_env, x_data, iw, n_threads, i_thread, k = 0 DO i = 1, nranks DO j = 1, bins_per_rank(i)/2 - k = k+1 + k = k + 1 WRITE (iw, FMT="(T6,I5,T15,I5,T27,I16,T55,F19.8)") & - i-1, j, buffer_out(2*(k-1)+1), REAL(buffer_out(2*k), dp)/10000.0_dp - summary(2*(i-1)+1) = summary(2*(i-1)+1)+buffer_out(2*(k-1)+1) - summary(2*i) = summary(2*i)+buffer_out(2*k) + i - 1, j, buffer_out(2*(k - 1) + 1), REAL(buffer_out(2*k), dp)/10000.0_dp + summary(2*(i - 1) + 1) = summary(2*(i - 1) + 1) + buffer_out(2*(k - 1) + 1) + summary(2*i) = summary(2*i) + buffer_out(2*k) END DO END DO @@ -2475,7 +2475,7 @@ SUBROUTINE collect_load_balance_info(para_env, x_data, iw, n_threads, i_thread, min_bin = HUGE(min_bin) sum_bin = 0_int_8 DO i = 1, total_bins - sum_bin = sum_bin+buffer_out(2*i) + sum_bin = sum_bin + buffer_out(2*i) max_bin = MAX(max_bin, buffer_out(2*i)) min_bin = MIN(min_bin, buffer_out(2*i)) END DO @@ -2485,7 +2485,7 @@ SUBROUTINE collect_load_balance_info(para_env, x_data, iw, n_threads, i_thread, min_rank = HUGE(min_rank) sum_rank = 0_int_8 DO i = 1, nranks - sum_rank = sum_rank+summary(2*i) + sum_rank = sum_rank + summary(2*i) max_rank = MAX(max_rank, summary(2*i)) min_rank = MIN(min_rank, summary(2*i)) END DO @@ -2512,7 +2512,7 @@ SUBROUTINE collect_load_balance_info(para_env, x_data, iw, n_threads, i_thread, WRITE (iw, FMT="(T3,A,T35,A,T55,A,/)") "MPI RANK", "EST cost", "Processing time [s]" DO i = nranks, 1, -1 - WRITE (iw, FMT="(T6,I5,T27,I16,T55,F19.8)") sort_idx(i)-1, summary(2*(sort_idx(i)-1)+1), REAL(buffer(i), dp)/10000.0_dp + WRITE (iw, FMT="(T6,I5,T27,I16,T55,F19.8)") sort_idx(i) - 1, summary(2*(sort_idx(i) - 1) + 1), REAL(buffer(i), dp)/10000.0_dp END DO DEALLOCATE (summary, buffer, sort_idx) @@ -2545,9 +2545,9 @@ SUBROUTINE reshuffle(size, array, rng_stream) DO i = 1, size*10 x = next_random_number(rng_stream) - idx1 = INT(x*(size+1-1))+1 + idx1 = INT(x*(size + 1 - 1)) + 1 x = next_random_number(rng_stream) - idx2 = INT(x*(size+1-1))+1 + idx2 = INT(x*(size + 1 - 1)) + 1 tmp = array(idx1) array(idx1) = array(idx2) diff --git a/src/hfx_pair_list_methods.F b/src/hfx_pair_list_methods.F index 6439331cec..9a0c2783a4 100644 --- a/src/hfx_pair_list_methods.F +++ b/src/hfx_pair_list_methods.F @@ -101,52 +101,52 @@ SUBROUTINE build_pgf_product_list(list1, list2, product_list, nproducts, & rb = list1%image_list(i)%rb DO j = 1, nimages2 pgf_max_2 = list2%image_list(j)%pgf_max - IF (pgf_max_1+pgf_max_2+log10_pmax < log10_eps_schwarz) CYCLE + IF (pgf_max_1 + pgf_max_2 + log10_pmax < log10_eps_schwarz) CYCLE Q = list2%image_list(j)%P R2 = list2%image_list(j)%R S1234b = list2%image_list(j)%S1234 rc = list2%image_list(j)%ra rd = list2%image_list(j)%rb - ZetapEtaInv = Zeta1+Eta + ZetapEtaInv = Zeta1 + Eta ZetapEtaInv = 1.0_dp/ZetapEtaInv Rho = Zeta1*Eta*ZetapEtaInv RhoInv = 1.0_dp/Rho - S1234 = EXP(S1234a+S1234b) + S1234 = EXP(S1234a + S1234b) IF (do_periodic) THEN - temp = P-Q + temp = P - Q PQ = pbc(temp, cell) - shift = -PQ+temp - temp_CC = rc+shift - temp_DD = rd+shift + shift = -PQ + temp + temp_CC = rc + shift + temp_DD = rd + shift END IF DO k = 1, SIZE(neighbor_cells) IF (do_periodic) THEN - C11 = temp_CC+neighbor_cells(k)%cell_r(:) - tmp_D = temp_DD+neighbor_cells(k)%cell_r(:) + C11 = temp_CC + neighbor_cells(k)%cell_r(:) + tmp_D = temp_DD + neighbor_cells(k)%cell_r(:) ELSE C11 = rc tmp_D = rd END IF - Q = (Zeta_C*C11+Zeta_D*tmp_D)*EtaInv - rpq2 = (P(1)-Q(1))**2+(P(2)-Q(2))**2+(P(3)-Q(3))**2 + Q = (Zeta_C*C11 + Zeta_D*tmp_D)*EtaInv + rpq2 = (P(1) - Q(1))**2 + (P(2) - Q(2))**2 + (P(3) - Q(3))**2 IF (potential_parameter%potential_type == do_potential_truncated .OR. & potential_parameter%potential_type == do_potential_short .OR. & potential_parameter%potential_type == do_potential_mix_cl_trunc) THEN - IF (rpq2 > (R1+R2+potential_parameter%cutoff_radius)**2) CYCLE + IF (rpq2 > (R1 + R2 + potential_parameter%cutoff_radius)**2) CYCLE END IF IF (potential_parameter%potential_type == do_potential_TShPSC) THEN - IF (rpq2 > (R1+R2+potential_parameter%cutoff_radius*2.0_dp)**2) CYCLE + IF (rpq2 > (R1 + R2 + potential_parameter%cutoff_radius*2.0_dp)**2) CYCLE END IF - nproducts = nproducts+1 + nproducts = nproducts + 1 ! allocate size as needed, ! updating the global size estimate to make this a rare event in longer simulations IF (nproducts > SIZE(product_list)) THEN !$OMP ATOMIC READ tmp_i4 = pgf_product_list_size - tmp_i4 = MAX(pgf_product_list_size, (3*nproducts+1)/2) + tmp_i4 = MAX(pgf_product_list_size, (3*nproducts + 1)/2) !$OMP ATOMIC WRITE pgf_product_list_size = tmp_i4 ALLOCATE (tmp_product_list(SIZE(product_list))) @@ -175,24 +175,24 @@ SUBROUTINE build_pgf_product_list(list1, list2, product_list, nproducts, & CASE (do_potential_short) CALL fgamma(m_max, T, product_list(nproducts)%Fm(1)) omega2 = potential_parameter%omega**2 - omega_corr2 = omega2/(omega2+Rho) + omega_corr2 = omega2/(omega2 + Rho) omega_corr = SQRT(omega_corr2) T = T*omega_corr2 CALL fgamma(m_max, T, Fm) tmp = -omega_corr - DO l = 1, m_max+1 - product_list(nproducts)%Fm(l) = product_list(nproducts)%Fm(l)+Fm(l)*tmp + DO l = 1, m_max + 1 + product_list(nproducts)%Fm(l) = product_list(nproducts)%Fm(l) + Fm(l)*tmp tmp = tmp*omega_corr2 END DO factor = 2.0_dp*Pi*RhoInv CASE (do_potential_long) omega2 = potential_parameter%omega**2 - omega_corr2 = omega2/(omega2+Rho) + omega_corr2 = omega2/(omega2 + Rho) omega_corr = SQRT(omega_corr2) T = T*omega_corr2 CALL fgamma(m_max, T, product_list(nproducts)%Fm(1)) tmp = omega_corr - DO l = 1, m_max+1 + DO l = 1, m_max + 1 product_list(nproducts)%Fm(l) = product_list(nproducts)%Fm(l)*tmp tmp = tmp*omega_corr2 END DO @@ -200,15 +200,15 @@ SUBROUTINE build_pgf_product_list(list1, list2, product_list, nproducts, & CASE (do_potential_mix_cl) CALL fgamma(m_max, T, product_list(nproducts)%Fm(1)) omega2 = potential_parameter%omega**2 - omega_corr2 = omega2/(omega2+Rho) + omega_corr2 = omega2/(omega2 + Rho) omega_corr = SQRT(omega_corr2) T = T*omega_corr2 CALL fgamma(m_max, T, Fm) tmp = omega_corr - DO l = 1, m_max+1 + DO l = 1, m_max + 1 product_list(nproducts)%Fm(l) = & product_list(nproducts)%Fm(l)*potential_parameter%scale_coulomb & - +Fm(l)*tmp*potential_parameter%scale_longrange + + Fm(l)*tmp*potential_parameter%scale_longrange tmp = tmp*omega_corr2 END DO factor = 2.0_dp*Pi*RhoInv @@ -222,56 +222,56 @@ SUBROUTINE build_pgf_product_list(list1, list2, product_list, nproducts, & ! Coulomb CALL fgamma(m_max, T, Fm) - DO l = 1, m_max+1 + DO l = 1, m_max + 1 product_list(nproducts)%Fm(l) = product_list(nproducts)%Fm(l)* & - (potential_parameter%scale_coulomb+potential_parameter%scale_longrange)- & + (potential_parameter%scale_coulomb + potential_parameter%scale_longrange) - & Fm(l)*potential_parameter%scale_longrange ENDDO ! longrange omega2 = potential_parameter%omega**2 - omega_corr2 = omega2/(omega2+Rho) + omega_corr2 = omega2/(omega2 + Rho) omega_corr = SQRT(omega_corr2) T = T*omega_corr2 CALL fgamma(m_max, T, Fm) tmp = omega_corr - DO l = 1, m_max+1 - product_list(nproducts)%Fm(l) = product_list(nproducts)%Fm(l)+Fm(l)*tmp*potential_parameter%scale_longrange + DO l = 1, m_max + 1 + product_list(nproducts)%Fm(l) = product_list(nproducts)%Fm(l) + Fm(l)*tmp*potential_parameter%scale_longrange tmp = tmp*omega_corr2 END DO factor = 2.0_dp*Pi*RhoInv CASE (do_potential_gaussian) omega2 = potential_parameter%omega**2 - T = -omega2*T/(Rho+omega2) + T = -omega2*T/(Rho + omega2) tmp = 1.0_dp - DO l = 1, m_max+1 + DO l = 1, m_max + 1 product_list(nproducts)%Fm(l) = EXP(T)*tmp - tmp = tmp*omega2/(Rho+omega2) + tmp = tmp*omega2/(Rho + omega2) END DO - factor = (Pi/(Rho+omega2))**(1.5_dp) + factor = (Pi/(Rho + omega2))**(1.5_dp) CASE (do_potential_mix_lg) omega2 = potential_parameter%omega**2 - omega_corr2 = omega2/(omega2+Rho) + omega_corr2 = omega2/(omega2 + Rho) omega_corr = SQRT(omega_corr2) T = T*omega_corr2 CALL fgamma(m_max, T, Fm) tmp = omega_corr*2.0_dp*Pi*RhoInv*potential_parameter%scale_longrange - DO l = 1, m_max+1 + DO l = 1, m_max + 1 Fm(l) = Fm(l)*tmp tmp = tmp*omega_corr2 END DO T = Rho*rpq2 - T = -omega2*T/(Rho+omega2) - tmp = (Pi/(Rho+omega2))**(1.5_dp)*potential_parameter%scale_gaussian - DO l = 1, m_max+1 - product_list(nproducts)%Fm(l) = EXP(T)*tmp+Fm(l) - tmp = tmp*omega2/(Rho+omega2) + T = -omega2*T/(Rho + omega2) + tmp = (Pi/(Rho + omega2))**(1.5_dp)*potential_parameter%scale_gaussian + DO l = 1, m_max + 1 + product_list(nproducts)%Fm(l) = EXP(T)*tmp + Fm(l) + tmp = tmp*omega2/(Rho + omega2) END DO factor = 1.0_dp CASE (do_potential_id) product_list(nproducts)%Fm(1) = (Pi*RhoInv)**(1.5_dp) - DO l = 2, m_max+1 + DO l = 2, m_max + 1 product_list(nproducts)%Fm(l) = 0.0_dp END DO factor = 1.0_dp @@ -280,11 +280,11 @@ SUBROUTINE build_pgf_product_list(list1, list2, product_list, nproducts, & tmp = (Pi*ZetapEtaInv)**3 factor = factor*S1234*SQRT(tmp) - DO l = 1, m_max+1 + DO l = 1, m_max + 1 product_list(nproducts)%Fm(l) = product_list(nproducts)%Fm(l)*factor END DO - W = (Zeta1*P+Eta*Q)*ZetapEtaInv + W = (Zeta1*P + Eta*Q)*ZetapEtaInv product_list(nproducts)%ra = ra product_list(nproducts)%rb = rb product_list(nproducts)%rc = C11 @@ -295,8 +295,8 @@ SUBROUTINE build_pgf_product_list(list1, list2, product_list, nproducts, & product_list(nproducts)%P = P product_list(nproducts)%Q = Q product_list(nproducts)%W = W - product_list(nproducts)%AB = ra-rb - product_list(nproducts)%CD = C11-tmp_D + product_list(nproducts)%AB = ra - rb + product_list(nproducts)%CD = C11 - tmp_D END DO END DO END DO @@ -349,22 +349,22 @@ SUBROUTINE build_pair_list_pgf(npgfa, npgfb, list, zeta, zetb, screen1, screen2, nelements = npgfa*npgfb DO i = 1, SIZE(neighbor_cells) IF (do_periodic) THEN - im_B = rb+neighbor_cells(i)%cell_r(:) + im_B = rb + neighbor_cells(i)%cell_r(:) ELSE im_B = rb END IF - AB = ra-im_B - rab2 = AB(1)**2+AB(2)**2+AB(3)**2 - IF (screen1(1)*rab2+screen1(2)+screen2(2)+log10_pmax < log10_eps_schwarz) CYCLE + AB = ra - im_B + rab2 = AB(1)**2 + AB(2)**2 + AB(3)**2 + IF (screen1(1)*rab2 + screen1(2) + screen2(2) + log10_pmax < log10_eps_schwarz) CYCLE element_counter = 0 DO ipgf = 1, npgfa DO jpgf = 1, npgfb - element_counter = element_counter+1 - pgf_max = pgf(jpgf, ipgf)%x(1)*rab2+pgf(jpgf, ipgf)%x(2) - IF (pgf_max+screen2(2)+log10_pmax < log10_eps_schwarz) THEN + element_counter = element_counter + 1 + pgf_max = pgf(jpgf, ipgf)%x(1)*rab2 + pgf(jpgf, ipgf)%x(2) + IF (pgf_max + screen2(2) + log10_pmax < log10_eps_schwarz) THEN CYCLE END IF - nimages(element_counter) = nimages(element_counter)+1 + nimages(element_counter) = nimages(element_counter) + 1 list(element_counter)%image_list(nimages(element_counter))%pgf_max = pgf_max list(element_counter)%image_list(nimages(element_counter))%ra = ra list(element_counter)%image_list(nimages(element_counter))%rb = im_B @@ -372,7 +372,7 @@ SUBROUTINE build_pair_list_pgf(npgfa, npgfb, list, zeta, zetb, screen1, screen2, Zeta_A = zeta(ipgf) Zeta_B = zetb(jpgf) - Zeta1 = Zeta_A+Zeta_B + Zeta1 = Zeta_A + Zeta_B ZetaInv = 1.0_dp/Zeta1 IF (nimages(element_counter) == 1) THEN @@ -385,9 +385,9 @@ SUBROUTINE build_pair_list_pgf(npgfa, npgfb, list, zeta, zetb, screen1, screen2, END IF list(element_counter)%image_list(nimages(element_counter))%S1234 = (-Zeta_A*Zeta_B*ZetaInv*rab2) - list(element_counter)%image_list(nimages(element_counter))%P = (Zeta_A*ra+Zeta_B*im_B)*ZetaInv + list(element_counter)%image_list(nimages(element_counter))%P = (Zeta_A*ra + Zeta_B*im_B)*ZetaInv list(element_counter)%image_list(nimages(element_counter))%R = & - MAX(0.0_dp, R_pgf(jpgf, ipgf)%x(1)*rab2+R_pgf(jpgf, ipgf)%x(2)) + MAX(0.0_dp, R_pgf(jpgf, ipgf)%x(1)*rab2 + R_pgf(jpgf, ipgf)%x(2)) list(element_counter)%image_list(nimages(element_counter))%ra = ra list(element_counter)%image_list(nimages(element_counter))%rb = im_B list(element_counter)%image_list(nimages(element_counter))%rab2 = rab2 @@ -404,7 +404,7 @@ SUBROUTINE build_pair_list_pgf(npgfa, npgfb, list, zeta, zetb, screen1, screen2, element_counter = 0 DO j = 1, nelements IF (list(j)%nimages == 0) CYCLE - element_counter = element_counter+1 + element_counter = element_counter + 1 list(element_counter)%nimages = list(j)%nimages list(element_counter)%zetapzetb = list(j)%zetapzetb list(element_counter)%ZetaInv = list(j)%ZetaInv @@ -485,18 +485,18 @@ SUBROUTINE build_pair_list(natom, list, set_list, i_start, i_end, j_start, j_end rb = particle_set(jatom)%r(:) IF (do_periodic) THEN - temp = rb-ra + temp = rb - ra pbc_B = pbc(temp, cell) - B11 = ra+pbc_B - rab2 = (ra(1)-B11(1))**2+(ra(2)-B11(2))**2+(ra(3)-B11(3))**2 + B11 = ra + pbc_B + rab2 = (ra(1) - B11(1))**2 + (ra(2) - B11(2))**2 + (ra(3) - B11(3))**2 ELSE - rab2 = (ra(1)-rb(1))**2+(ra(2)-rb(2))**2+(ra(3)-rb(3))**2 + rab2 = (ra(1) - rb(1))**2 + (ra(2) - rb(2))**2 + (ra(3) - rb(3))**2 B11 = rb ! ra - rb END IF - IF ((coeffs_kind(jkind, ikind)%x(1)*rab2+ & - coeffs_kind(jkind, ikind)%x(2))+coeffs_kind_max0+pmax_blocks < log10_eps_schwarz) CYCLE + IF ((coeffs_kind(jkind, ikind)%x(1)*rab2 + & + coeffs_kind(jkind, ikind)%x(2)) + coeffs_kind_max0 + pmax_blocks < log10_eps_schwarz) CYCLE - n_element = n_element+1 + n_element = n_element + 1 list%elements(n_element)%pair(1) = iatom list%elements(n_element)%pair(2) = jatom list%elements(n_element)%kind_pair(1) = ikind @@ -505,12 +505,12 @@ SUBROUTINE build_pair_list(natom, list, set_list, i_start, i_end, j_start, j_end list%elements(n_element)%r2 = B11 list%elements(n_element)%dist2 = rab2 ! build a list of guaranteed overlapping sets - list%elements(n_element)%set_bounds(1) = nset_ij+1 + list%elements(n_element)%set_bounds(1) = nset_ij + 1 DO iset = 1, nseta DO jset = 1, nsetb - IF (coeffs_set(jset, iset, jkind, ikind)%x(1)*rab2+coeffs_set(jset, iset, jkind, ikind)%x(2)+ & - coeffs_kind_max0+pmax_blocks < log10_eps_schwarz) CYCLE - nset_ij = nset_ij+1 + IF (coeffs_set(jset, iset, jkind, ikind)%x(1)*rab2 + coeffs_set(jset, iset, jkind, ikind)%x(2) + & + coeffs_kind_max0 + pmax_blocks < log10_eps_schwarz) CYCLE + nset_ij = nset_ij + 1 set_list(nset_ij)%pair(1) = iset set_list(nset_ij)%pair(2) = jset END DO @@ -577,16 +577,16 @@ SUBROUTINE build_atomic_pair_list(natom, atomic_pair_list, kind_of, basis_parame rb = particle_set(jatom)%r(:) IF (do_periodic) THEN - temp = rb-ra + temp = rb - ra pbc_B = pbc(temp, cell) - B11 = ra+pbc_B - rab2 = (ra(1)-B11(1))**2+(ra(2)-B11(2))**2+(ra(3)-B11(3))**2 + B11 = ra + pbc_B + rab2 = (ra(1) - B11(1))**2 + (ra(2) - B11(2))**2 + (ra(3) - B11(3))**2 ELSE - rab2 = (ra(1)-rb(1))**2+(ra(2)-rb(2))**2+(ra(3)-rb(3))**2 + rab2 = (ra(1) - rb(1))**2 + (ra(2) - rb(2))**2 + (ra(3) - rb(3))**2 B11 = rb ! ra - rb END IF - IF ((coeffs_kind(jkind, ikind)%x(1)*rab2+ & - coeffs_kind(jkind, ikind)%x(2))+coeffs_kind_max0 < log10_eps_schwarz) CYCLE + IF ((coeffs_kind(jkind, ikind)%x(1)*rab2 + & + coeffs_kind(jkind, ikind)%x(2)) + coeffs_kind_max0 < log10_eps_schwarz) CYCLE atomic_pair_list(jatom, iatom) = .TRUE. atomic_pair_list(iatom, jatom) = .TRUE. @@ -667,18 +667,18 @@ SUBROUTINE build_pair_list_mp2(natom, list, set_list, i_start, i_end, j_start, j rb = particle_set(jatom)%r(:) IF (do_periodic) THEN - temp = rb-ra + temp = rb - ra pbc_B = pbc(temp, cell) - B11 = ra+pbc_B - rab2 = (ra(1)-B11(1))**2+(ra(2)-B11(2))**2+(ra(3)-B11(3))**2 + B11 = ra + pbc_B + rab2 = (ra(1) - B11(1))**2 + (ra(2) - B11(2))**2 + (ra(3) - B11(3))**2 ELSE - rab2 = (ra(1)-rb(1))**2+(ra(2)-rb(2))**2+(ra(3)-rb(3))**2 + rab2 = (ra(1) - rb(1))**2 + (ra(2) - rb(2))**2 + (ra(3) - rb(3))**2 B11 = rb ! ra - rb END IF - IF ((coeffs_kind(jkind, ikind)%x(1)*rab2+ & - coeffs_kind(jkind, ikind)%x(2))+coeffs_kind_max0+pmax_blocks < log10_eps_schwarz) CYCLE + IF ((coeffs_kind(jkind, ikind)%x(1)*rab2 + & + coeffs_kind(jkind, ikind)%x(2)) + coeffs_kind_max0 + pmax_blocks < log10_eps_schwarz) CYCLE - n_element = n_element+1 + n_element = n_element + 1 list%elements(n_element)%pair(1) = iatom list%elements(n_element)%pair(2) = jatom list%elements(n_element)%kind_pair(1) = ikind @@ -687,12 +687,12 @@ SUBROUTINE build_pair_list_mp2(natom, list, set_list, i_start, i_end, j_start, j list%elements(n_element)%r2 = B11 list%elements(n_element)%dist2 = rab2 ! build a list of guaranteed overlapping sets - list%elements(n_element)%set_bounds(1) = nset_ij+1 + list%elements(n_element)%set_bounds(1) = nset_ij + 1 DO iset = 1, nseta DO jset = 1, nsetb - IF (coeffs_set(jset, iset, jkind, ikind)%x(1)*rab2+coeffs_set(jset, iset, jkind, ikind)%x(2)+ & - coeffs_kind_max0+pmax_blocks < log10_eps_schwarz) CYCLE - nset_ij = nset_ij+1 + IF (coeffs_set(jset, iset, jkind, ikind)%x(1)*rab2 + coeffs_set(jset, iset, jkind, ikind)%x(2) + & + coeffs_kind_max0 + pmax_blocks < log10_eps_schwarz) CYCLE + nset_ij = nset_ij + 1 set_list(nset_ij)%pair(1) = iset set_list(nset_ij)%pair(2) = jset END DO diff --git a/src/hfx_screening_methods.F b/src/hfx_screening_methods.F index 80bcfcb633..daeff83809 100644 --- a/src/hfx_screening_methods.F +++ b/src/hfx_screening_methods.F @@ -93,7 +93,7 @@ SUBROUTINE screen4(lib, ra, rb, zeta, zetb, & max_val_temp = max_val DO ipgf = 1, npgfa DO jpgf = 1, npgfb - R1 = MAX(0.0_dp, tmp_R_1(jpgf, ipgf)%x(1)*rab2+tmp_R_1(jpgf, ipgf)%x(2)) + R1 = MAX(0.0_dp, tmp_R_1(jpgf, ipgf)%x(1)*rab2 + tmp_R_1(jpgf, ipgf)%x(2)) DO la = la_min, la_max DO lb = lb_min, lb_max !Build primitives @@ -182,14 +182,14 @@ SUBROUTINE update_pmax_mat(pmax_set, map_atom_to_kind_atom, set_offset, atomic_b pmax_tmp = 0.0_dp act_set_offset = set_offset(kset, jset, kkind, jkind) DO img = 1, nimg - i = act_set_offset+act_atomic_block_offset-1 + i = act_set_offset + act_atomic_block_offset - 1 DO mc = 1, nsgfc(kset) DO mb = 1, nsgfb(jset) pmax_tmp = MAX(pmax_tmp, ABS(full_density_alpha(i, img))) IF (ASSOCIATED(full_density_beta)) THEN pmax_tmp = MAX(pmax_tmp, ABS(full_density_beta(i, img))) END IF - i = i+1 + i = i + 1 ENDDO ENDDO ENDDO @@ -208,13 +208,13 @@ SUBROUTINE update_pmax_mat(pmax_set, map_atom_to_kind_atom, set_offset, atomic_b act_set_offset = set_offset(jset, kset, jkind, kkind) DO img = 1, nimg DO mc = 1, nsgfc(kset) - i = act_set_offset+act_atomic_block_offset-1+mc-1 + i = act_set_offset + act_atomic_block_offset - 1 + mc - 1 DO mb = 1, nsgfb(jset) pmax_tmp = MAX(pmax_tmp, ABS(full_density_alpha(i, img))) IF (ASSOCIATED(full_density_beta)) THEN pmax_tmp = MAX(pmax_tmp, ABS(full_density_beta(i, img))) END IF - i = i+nsgfc(kset) + i = i + nsgfc(kset) ENDDO ENDDO ENDDO @@ -400,19 +400,19 @@ SUBROUTINE calc_screening_functions(qs_env, basis_parameter, lib, potential_para DO iset = 1, nseta ncoa = npgfa(iset)*ncoset(la_max(iset)) sgfa = first_sgfa(1, iset) - max_contraction_a = MAXVAL((/(SUM(ABS(sphi_a(1:ncoa, i))), i=sgfa, sgfa+nsgfa(iset)-1)/)) + max_contraction_a = MAXVAL((/(SUM(ABS(sphi_a(1:ncoa, i))), i=sgfa, sgfa + nsgfa(iset) - 1)/)) DO jset = 1, nsetb ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) - max_contraction_b = MAXVAL((/(SUM(ABS(sphi_b(1:ncob, i))), i=sgfb, sgfb+nsgfb(jset)-1)/)) - radius = set_radius_a(iset)+set_radius_b(jset) + max_contraction_b = MAXVAL((/(SUM(ABS(sphi_b(1:ncob, i))), i=sgfb, sgfb + nsgfb(jset) - 1)/)) + radius = set_radius_a(iset) + set_radius_b(jset) DO ipgf = 1, npgfa(iset) DO jpgf = 1, npgfb(jset) - radius = rpgfa(ipgf, iset)+rpgfb(jpgf, jset) + radius = rpgfa(ipgf, iset) + rpgfb(jpgf, jset) DO i = i_thread, 100, n_threads - rb(1) = 0.0_dp+REAL(i, dp)*0.01_dp*radius + rb(1) = 0.0_dp + REAL(i, dp)*0.01_dp*radius max_val = 0.0_dp - R1 = MAX(0.0_dp, radii_pgf(jpgf, ipgf, jset, iset, jkind, ikind)%x(1)*rb(1)**2+ & + R1 = MAX(0.0_dp, radii_pgf(jpgf, ipgf, jset, iset, jkind, ikind)%x(1)*rb(1)**2 + & radii_pgf(jpgf, ipgf, jset, iset, jkind, ikind)%x(2)) DO la = la_min(iset), la_max(iset) DO lb = lb_min(jset), lb_max(jset) @@ -508,15 +508,15 @@ SUBROUTINE calc_screening_functions(qs_env, basis_parameter, lib, potential_para DO iset = 1, nseta ncoa = npgfa(iset)*ncoset(la_max(iset)) sgfa = first_sgfa(1, iset) - max_contraction_a = MAXVAL((/(SUM(ABS(sphi_a(1:ncoa, i))), i=sgfa, sgfa+nsgfa(iset)-1)/)) + max_contraction_a = MAXVAL((/(SUM(ABS(sphi_a(1:ncoa, i))), i=sgfa, sgfa + nsgfa(iset) - 1)/)) DO jset = 1, nsetb ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) - max_contraction_b = MAXVAL((/(SUM(ABS(sphi_b(1:ncob, i))), i=sgfb, sgfb+nsgfb(jset)-1)/)) - radius = set_radius_a(iset)+set_radius_b(jset) + max_contraction_b = MAXVAL((/(SUM(ABS(sphi_b(1:ncob, i))), i=sgfb, sgfb + nsgfb(jset) - 1)/)) + radius = set_radius_a(iset) + set_radius_b(jset) tmp_R_1 => radii_pgf(:, :, jset, iset, jkind, ikind) DO i = i_thread, 100, n_threads - rb(1) = 0.0_dp+REAL(i, dp)*0.01_dp*radius + rb(1) = 0.0_dp + REAL(i, dp)*0.01_dp*radius max_val = 0.0_dp CALL screen4(lib, ra, rb, & zeta(:, iset), zetb(:, jset), & @@ -588,17 +588,17 @@ SUBROUTINE calc_screening_functions(qs_env, basis_parameter, lib, potential_para sphi_b => basis_parameter(jkind)%sphi nsgfb => basis_parameter(jkind)%nsgf - radius = kind_radius_a+kind_radius_b + radius = kind_radius_a + kind_radius_b DO iset = 1, nseta ncoa = npgfa(iset)*ncoset(la_max(iset)) sgfa = first_sgfa(1, iset) - max_contraction_a = MAXVAL((/(SUM(ABS(sphi_a(1:ncoa, i))), i=sgfa, sgfa+nsgfa(iset)-1)/)) + max_contraction_a = MAXVAL((/(SUM(ABS(sphi_a(1:ncoa, i))), i=sgfa, sgfa + nsgfa(iset) - 1)/)) DO jset = 1, nsetb ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) - max_contraction_b = MAXVAL((/(SUM(ABS(sphi_b(1:ncob, i))), i=sgfb, sgfb+nsgfb(jset)-1)/)) + max_contraction_b = MAXVAL((/(SUM(ABS(sphi_b(1:ncob, i))), i=sgfb, sgfb + nsgfb(jset) - 1)/)) DO i = i_thread, 100, n_threads - rb(1) = 0.0_dp+REAL(i, dp)*0.01_dp*radius + rb(1) = 0.0_dp + REAL(i, dp)*0.01_dp*radius max_val = 0.0_dp tmp_R_1 => radii_pgf(:, :, jset, iset, jkind, ikind) CALL screen4(lib, ra, rb, & @@ -747,28 +747,28 @@ SUBROUTINE calc_pair_dist_radii(qs_env, basis_parameter, & DO iset = 1, nseta ncoa = npgfa(iset)*ncoset(la_max(iset)) sgfa = first_sgfa(1, iset) - max_contraction_a = MAXVAL((/(SUM(ABS(sphi_a(1:ncoa, i))), i=sgfa, sgfa+nsgfa(iset)-1)/)) + max_contraction_a = MAXVAL((/(SUM(ABS(sphi_a(1:ncoa, i))), i=sgfa, sgfa + nsgfa(iset) - 1)/)) DO jset = 1, nsetb ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) - max_contraction_b = MAXVAL((/(SUM(ABS(sphi_b(1:ncob, i))), i=sgfb, sgfb+nsgfb(jset)-1)/)) + max_contraction_b = MAXVAL((/(SUM(ABS(sphi_b(1:ncob, i))), i=sgfb, sgfb + nsgfb(jset) - 1)/)) DO ipgf = 1, npgfa(iset) DO jpgf = 1, npgfb(jset) - radius = rpgfa(ipgf, iset)+rpgfb(jpgf, jset) + radius = rpgfa(ipgf, iset) + rpgfb(jpgf, jset) DO i = i_thread, 100, n_threads - rb(1) = 0.0_dp+0.01_dp*radius*i + rb(1) = 0.0_dp + 0.01_dp*radius*i R_max = 0.0_dp DO la = la_min(iset), la_max(iset) DO lb = lb_min(jset), lb_max(jset) - zetp = zeta(ipgf, iset)+zetb(jpgf, jset) + zetp = zeta(ipgf, iset) + zetb(jpgf, jset) ff = zetb(jpgf, jset)/zetp rab = 0.0_dp rab(1) = rb(1) rab2 = rb(1)**2 prefactor = EXP(-zeta(ipgf, iset)*ff*rab2) rap(:) = ff*rab(:) - rp(:) = ra(:)+rap(:) - rb(:) = ra(:)+rab(:) + rp(:) = ra(:) + rap(:) + rb(:) = ra(:) + rab(:) cutoff = 1.0_dp R1 = exp_radius_very_extended( & la, la, lb, lb, ra=ra, rb=rb, rp=rp, & @@ -851,13 +851,13 @@ SUBROUTINE optimize_it(DATA, x, fmin) IF (opt_state%state == 2) THEN opt_state%f = 0.0_dp DO i = 0, 100 - f = x(1)*DATA(1, i)**2+x(2) + f = x(1)*DATA(1, i)**2 + x(2) IF (f > DATA(2, i)) THEN weight = small_weight ELSE weight = large_weight END IF - IF (DATA(2, i) > fmin) opt_state%f = opt_state%f+weight*(f-DATA(2, i))**2 + IF (DATA(2, i) > fmin) opt_state%f = opt_state%f + weight*(f - DATA(2, i))**2 END DO END IF @@ -894,7 +894,7 @@ PURE FUNCTION get_1D_idx(i, j, N) INTEGER(int_8) :: min_ij min_ij = MIN(i, j) - get_1D_idx = min_ij*N+MAX(i, j)-(min_ij-1)*min_ij/2-N + get_1D_idx = min_ij*N + MAX(i, j) - (min_ij - 1)*min_ij/2 - N END FUNCTION get_1D_idx diff --git a/src/hfx_types.F b/src/hfx_types.F index b5c19eb542..fd2b0d5ee2 100644 --- a/src/hfx_types.F +++ b/src/hfx_types.F @@ -723,7 +723,7 @@ SUBROUTINE hfx_create(x_data, para_env, hfx_section, natom, atomic_kind_set, qs_ ALLOCATE (actual_x_data%is_assoc_atomic_block(natom, natom)) ALLOCATE (actual_x_data%atomic_block_offset(natom, natom)) ALLOCATE (actual_x_data%set_offset(max_set, max_set, nkind, nkind)) - ALLOCATE (actual_x_data%block_offset(para_env%num_pe+1)) + ALLOCATE (actual_x_data%block_offset(para_env%num_pe + 1)) END IF ALLOCATE (actual_x_data%distribution_forces(1)) @@ -740,7 +740,7 @@ SUBROUTINE hfx_create(x_data, para_env, hfx_section, natom, atomic_kind_set, qs_ !! ** This guy is allocated on the master thread only IF (i_thread == 1) THEN ALLOCATE (actual_x_data%pmax_atom(natom, natom)) - ALLOCATE (actual_x_data%initial_p(nkind*(nkind+1)/2)) + ALLOCATE (actual_x_data%initial_p(nkind*(nkind + 1)/2)) i = 1 DO ikind = 1, nkind CALL get_atomic_kind(atomic_kind_set(ikind), natom=natom_a) @@ -750,14 +750,14 @@ SUBROUTINE hfx_create(x_data, para_env, hfx_section, natom, atomic_kind_set, qs_ nsetb = actual_x_data%basis_parameter(jkind)%nset ALLOCATE (actual_x_data%initial_p(i)%p_kind(nseta, nsetb, natom_a, natom_b)) actual_x_data%memory_parameter%size_p_screen = & - actual_x_data%memory_parameter%size_p_screen+nseta*nsetb*natom_a*natom_b - i = i+1 + actual_x_data%memory_parameter%size_p_screen + nseta*nsetb*natom_a*natom_b + i = i + 1 END DO END DO IF (actual_x_data%memory_parameter%treat_forces_in_core) THEN ALLOCATE (actual_x_data%pmax_atom_forces(natom, natom)) - ALLOCATE (actual_x_data%initial_p_forces(nkind*(nkind+1)/2)) + ALLOCATE (actual_x_data%initial_p_forces(nkind*(nkind + 1)/2)) i = 1 DO ikind = 1, nkind CALL get_atomic_kind(atomic_kind_set(ikind), natom=natom_a) @@ -767,8 +767,8 @@ SUBROUTINE hfx_create(x_data, para_env, hfx_section, natom, atomic_kind_set, qs_ nsetb = actual_x_data%basis_parameter(jkind)%nset ALLOCATE (actual_x_data%initial_p_forces(i)%p_kind(nseta, nsetb, natom_a, natom_b)) actual_x_data%memory_parameter%size_p_screen = & - actual_x_data%memory_parameter%size_p_screen+nseta*nsetb*natom_a*natom_b - i = i+1 + actual_x_data%memory_parameter%size_p_screen + nseta*nsetb*natom_a*natom_b + i = i + 1 END DO END DO END IF @@ -781,7 +781,7 @@ SUBROUTINE hfx_create(x_data, para_env, hfx_section, natom, atomic_kind_set, qs_ atom2kind = 0 DO iatom = 1, natom ikind = kind_of(iatom) - atom2kind(ikind) = atom2kind(ikind)+1 + atom2kind(ikind) = atom2kind(ikind) + 1 actual_x_data%map_atom_to_kind_atom(iatom) = atom2kind(ikind) END DO DEALLOCATE (kind_of, atom2kind) @@ -919,7 +919,7 @@ SUBROUTINE hfx_create_basis_types(basis_parameter, basis_info, qs_kind_set, do_a DO i = 0, basis_info%max_am nl_count = 0 DO j = 1, nshell(iset) - IF (basis_parameter(ikind)%nl(j, iset) == i) nl_count = nl_count+1 + IF (basis_parameter(ikind)%nl(j, iset) == i) nl_count = nl_count + 1 END DO basis_parameter(ikind)%nsgfl(i, iset) = nl_count END DO @@ -961,20 +961,20 @@ SUBROUTINE hfx_create_basis_types(basis_parameter, basis_info, qs_kind_set, do_a DO iset = 1, nseta sgfa = first_sgfa(1, iset) DO ipgf = 1, npgfa(iset) - offset_a1 = (ipgf-1)*ncoset(la_max(iset)) + offset_a1 = (ipgf - 1)*ncoset(la_max(iset)) s_offset_nl_a = 0 DO la = la_min(iset), la_max(iset) - offset_a = offset_a1+ncoset(la-1) + offset_a = offset_a1 + ncoset(la - 1) co_counter = 0 - co_counter = co_counter+1 + co_counter = co_counter + 1 so_counter = 0 - DO k = sgfa+s_offset_nl_a, sgfa+s_offset_nl_a+nso(la)*nl_a(la, iset)-1 - DO i = offset_a+1, offset_a+nco(la) - so_counter = so_counter+1 + DO k = sgfa + s_offset_nl_a, sgfa + s_offset_nl_a + nso(la)*nl_a(la, iset) - 1 + DO i = offset_a + 1, offset_a + nco(la) + so_counter = so_counter + 1 basis_parameter(ikind)%sphi_ext(so_counter, la, ipgf, iset) = sphi_a(i, k) END DO END DO - s_offset_nl_a = s_offset_nl_a+nso(la)*(nl_a(la, iset)) + s_offset_nl_a = s_offset_nl_a + nso(la)*(nl_a(la, iset)) END DO END DO END DO @@ -1105,7 +1105,7 @@ SUBROUTINE parse_memory_section(memory_parameter, hf_sub_section, storage_id, & memory_parameter%do_disk_storage = .FALSE. END IF IF (PRESENT(storage_id)) THEN - storage_id = (irep-1)*para_env%num_pe*n_threads+para_env%mepos*n_threads+i_thread-1 + storage_id = (irep - 1)*para_env%num_pe*n_threads + para_env%mepos*n_threads + i_thread - 1 END IF END SUBROUTINE parse_memory_section @@ -1310,8 +1310,8 @@ SUBROUTINE hfx_create_neighbor_cells(x_data, pbc_shells, cell, i_thread) DO jset = 1, nsetb DO ipgf = 1, npgfa(iset) DO jpgf = 1, npgfb(jset) - Zeta1 = zeta(ipgf, iset)+zetb(jpgf, jset) - R1 = 1.0_dp/SQRT(Zeta1)*mul_fact(la_max(iset)+lb_max(jset))* & + Zeta1 = zeta(ipgf, iset) + zetb(jpgf, jset) + R1 = 1.0_dp/SQRT(Zeta1)*mul_fact(la_max(iset) + lb_max(jset))* & SQRT(-LOG(x_data%screening_parameter%eps_schwarz)) R_max = MAX(R1, R_max) END DO @@ -1321,7 +1321,7 @@ SUBROUTINE hfx_create_neighbor_cells(x_data, pbc_shells, cell, i_thread) END DO END DO - R_max = 2.0_dp*R_max+x_data%potential_parameter%cutoff_radius + R_max = 2.0_dp*R_max + x_data%potential_parameter%cutoff_radius nothing_more_to_add = .FALSE. max_shell = 0 total_number_of_cells = 0 @@ -1370,13 +1370,13 @@ SUBROUTINE hfx_create_neighbor_cells(x_data, pbc_shells, cell, i_thread) ! Calculate distances to the eight points P1 to P8 image_cell_found = .FALSE. ALLOCATE (tmp_neighbor_cells(1:ub)) - DO i = 1, ub-1 + DO i = 1, ub - 1 tmp_neighbor_cells(i) = x_data%neighbor_cells(i) END DO - ub_max = (2*max_shell+1)**3 + ub_max = (2*max_shell + 1)**3 DEALLOCATE (x_data%neighbor_cells) ALLOCATE (x_data%neighbor_cells(1:ub_max)) - DO i = 1, ub-1 + DO i = 1, ub - 1 x_data%neighbor_cells(i) = tmp_neighbor_cells(i) END DO DO i = ub, ub_max @@ -1392,15 +1392,15 @@ SUBROUTINE hfx_create_neighbor_cells(x_data, pbc_shells, cell, i_thread) IF (MAX(ABS(ishell), ABS(jshell), ABS(kshell)) /= max_shell) CYCLE idx = 0 DO j = 0, 1 - x = -1.0_dp/2.0_dp+j*1.0_dp + x = -1.0_dp/2.0_dp + j*1.0_dp DO k = 0, 1 - y = -1.0_dp/2.0_dp+k*1.0_dp + y = -1.0_dp/2.0_dp + k*1.0_dp DO l = 0, 1 - z = -1.0_dp/2.0_dp+l*1.0_dp - idx = idx+1 - P(1, idx) = x+ishell - P(2, idx) = y+jshell - P(3, idx) = z+kshell + z = -1.0_dp/2.0_dp + l*1.0_dp + idx = idx + 1 + P(1, idx) = x + ishell + P(2, idx) = y + jshell + P(3, idx) = z + kshell CALL scaled_to_real(r, P(:, idx), cell) distance(idx) = SQRT(SUM(r**2)) P(1:3, idx) = r @@ -1410,97 +1410,97 @@ SUBROUTINE hfx_create_neighbor_cells(x_data, pbc_shells, cell, i_thread) ! Now check distance to Faces and only take them into account if the base point lies within quadrilateral ! Face A (1342) 1 is the reference - idx = idx+1 - plane_vector(:, 1) = P(:, 3)-P(:, 1) - plane_vector(:, 2) = P(:, 2)-P(:, 1) - cross_product(1) = plane_vector(2, 1)*plane_vector(3, 2)-plane_vector(3, 1)*plane_vector(2, 2) - cross_product(2) = plane_vector(3, 1)*plane_vector(1, 2)-plane_vector(1, 1)*plane_vector(3, 2) - cross_product(3) = plane_vector(1, 1)*plane_vector(2, 2)-plane_vector(2, 1)*plane_vector(1, 2) + idx = idx + 1 + plane_vector(:, 1) = P(:, 3) - P(:, 1) + plane_vector(:, 2) = P(:, 2) - P(:, 1) + cross_product(1) = plane_vector(2, 1)*plane_vector(3, 2) - plane_vector(3, 1)*plane_vector(2, 2) + cross_product(2) = plane_vector(3, 1)*plane_vector(1, 2) - plane_vector(1, 1)*plane_vector(3, 2) + cross_product(3) = plane_vector(1, 1)*plane_vector(2, 2) - plane_vector(2, 1)*plane_vector(1, 2) normal(:, 1) = cross_product/SQRT(SUM(cross_product**2)) - point_in_plane = -normal(:, 1)*(normal(1, 1)*P(1, 1)+normal(2, 1)*P(2, 1)+normal(3, 1)*P(3, 1)) + point_in_plane = -normal(:, 1)*(normal(1, 1)*P(1, 1) + normal(2, 1)*P(2, 1) + normal(3, 1)*P(3, 1)) IF (point_is_in_quadrilateral(P(:, 1), P(:, 3), P(:, 4), P(:, 2), point_in_plane)) THEN - distance(idx) = ABS(normal(1, 1)*P(1, 1)+normal(2, 1)*P(2, 1)+normal(3, 1)*P(3, 1)) + distance(idx) = ABS(normal(1, 1)*P(1, 1) + normal(2, 1)*P(2, 1) + normal(3, 1)*P(3, 1)) ELSE distance(idx) = HUGE(distance(idx)) END IF ! Face B (1562) 1 is the reference - idx = idx+1 - plane_vector(:, 1) = P(:, 2)-P(:, 1) - plane_vector(:, 2) = P(:, 5)-P(:, 1) - cross_product(1) = plane_vector(2, 1)*plane_vector(3, 2)-plane_vector(3, 1)*plane_vector(2, 2) - cross_product(2) = plane_vector(3, 1)*plane_vector(1, 2)-plane_vector(1, 1)*plane_vector(3, 2) - cross_product(3) = plane_vector(1, 1)*plane_vector(2, 2)-plane_vector(2, 1)*plane_vector(1, 2) + idx = idx + 1 + plane_vector(:, 1) = P(:, 2) - P(:, 1) + plane_vector(:, 2) = P(:, 5) - P(:, 1) + cross_product(1) = plane_vector(2, 1)*plane_vector(3, 2) - plane_vector(3, 1)*plane_vector(2, 2) + cross_product(2) = plane_vector(3, 1)*plane_vector(1, 2) - plane_vector(1, 1)*plane_vector(3, 2) + cross_product(3) = plane_vector(1, 1)*plane_vector(2, 2) - plane_vector(2, 1)*plane_vector(1, 2) normal(:, 1) = cross_product/SQRT(SUM(cross_product**2)) - point_in_plane = -normal(:, 1)*(normal(1, 1)*P(1, 1)+normal(2, 1)*P(2, 1)+normal(3, 1)*P(3, 1)) + point_in_plane = -normal(:, 1)*(normal(1, 1)*P(1, 1) + normal(2, 1)*P(2, 1) + normal(3, 1)*P(3, 1)) IF (point_is_in_quadrilateral(P(:, 1), P(:, 5), P(:, 6), P(:, 2), point_in_plane)) THEN - distance(idx) = ABS(normal(1, 1)*P(1, 1)+normal(2, 1)*P(2, 1)+normal(3, 1)*P(3, 1)) + distance(idx) = ABS(normal(1, 1)*P(1, 1) + normal(2, 1)*P(2, 1) + normal(3, 1)*P(3, 1)) ELSE distance(idx) = HUGE(distance(idx)) END IF ! Face C (5786) 5 is the reference - idx = idx+1 - plane_vector(:, 1) = P(:, 7)-P(:, 5) - plane_vector(:, 2) = P(:, 6)-P(:, 5) - cross_product(1) = plane_vector(2, 1)*plane_vector(3, 2)-plane_vector(3, 1)*plane_vector(2, 2) - cross_product(2) = plane_vector(3, 1)*plane_vector(1, 2)-plane_vector(1, 1)*plane_vector(3, 2) - cross_product(3) = plane_vector(1, 1)*plane_vector(2, 2)-plane_vector(2, 1)*plane_vector(1, 2) + idx = idx + 1 + plane_vector(:, 1) = P(:, 7) - P(:, 5) + plane_vector(:, 2) = P(:, 6) - P(:, 5) + cross_product(1) = plane_vector(2, 1)*plane_vector(3, 2) - plane_vector(3, 1)*plane_vector(2, 2) + cross_product(2) = plane_vector(3, 1)*plane_vector(1, 2) - plane_vector(1, 1)*plane_vector(3, 2) + cross_product(3) = plane_vector(1, 1)*plane_vector(2, 2) - plane_vector(2, 1)*plane_vector(1, 2) normal(:, 1) = cross_product/SQRT(SUM(cross_product**2)) - point_in_plane = -normal(:, 1)*(normal(1, 1)*P(1, 5)+normal(2, 1)*P(2, 5)+normal(3, 1)*P(3, 5)) + point_in_plane = -normal(:, 1)*(normal(1, 1)*P(1, 5) + normal(2, 1)*P(2, 5) + normal(3, 1)*P(3, 5)) IF (point_is_in_quadrilateral(P(:, 5), P(:, 7), P(:, 8), P(:, 6), point_in_plane)) THEN - distance(idx) = ABS(normal(1, 1)*P(1, 5)+normal(2, 1)*P(2, 5)+normal(3, 1)*P(3, 5)) + distance(idx) = ABS(normal(1, 1)*P(1, 5) + normal(2, 1)*P(2, 5) + normal(3, 1)*P(3, 5)) ELSE distance(idx) = HUGE(distance(idx)) END IF ! Face D (3784) 3 is the reference - idx = idx+1 - plane_vector(:, 1) = P(:, 7)-P(:, 3) - plane_vector(:, 2) = P(:, 4)-P(:, 3) - cross_product(1) = plane_vector(2, 1)*plane_vector(3, 2)-plane_vector(3, 1)*plane_vector(2, 2) - cross_product(2) = plane_vector(3, 1)*plane_vector(1, 2)-plane_vector(1, 1)*plane_vector(3, 2) - cross_product(3) = plane_vector(1, 1)*plane_vector(2, 2)-plane_vector(2, 1)*plane_vector(1, 2) + idx = idx + 1 + plane_vector(:, 1) = P(:, 7) - P(:, 3) + plane_vector(:, 2) = P(:, 4) - P(:, 3) + cross_product(1) = plane_vector(2, 1)*plane_vector(3, 2) - plane_vector(3, 1)*plane_vector(2, 2) + cross_product(2) = plane_vector(3, 1)*plane_vector(1, 2) - plane_vector(1, 1)*plane_vector(3, 2) + cross_product(3) = plane_vector(1, 1)*plane_vector(2, 2) - plane_vector(2, 1)*plane_vector(1, 2) normal(:, 1) = cross_product/SQRT(SUM(cross_product**2)) - point_in_plane = -normal(:, 1)*(normal(1, 1)*P(1, 3)+normal(2, 1)*P(2, 3)+normal(3, 1)*P(3, 3)) + point_in_plane = -normal(:, 1)*(normal(1, 1)*P(1, 3) + normal(2, 1)*P(2, 3) + normal(3, 1)*P(3, 3)) IF (point_is_in_quadrilateral(P(:, 3), P(:, 7), P(:, 8), P(:, 4), point_in_plane)) THEN - distance(idx) = ABS(normal(1, 1)*P(1, 3)+normal(2, 1)*P(2, 3)+normal(3, 1)*P(3, 3)) + distance(idx) = ABS(normal(1, 1)*P(1, 3) + normal(2, 1)*P(2, 3) + normal(3, 1)*P(3, 3)) ELSE distance(idx) = HUGE(distance(idx)) END IF ! Face E (2684) 2 is the reference - idx = idx+1 - plane_vector(:, 1) = P(:, 6)-P(:, 2) - plane_vector(:, 2) = P(:, 4)-P(:, 2) - cross_product(1) = plane_vector(2, 1)*plane_vector(3, 2)-plane_vector(3, 1)*plane_vector(2, 2) - cross_product(2) = plane_vector(3, 1)*plane_vector(1, 2)-plane_vector(1, 1)*plane_vector(3, 2) - cross_product(3) = plane_vector(1, 1)*plane_vector(2, 2)-plane_vector(2, 1)*plane_vector(1, 2) + idx = idx + 1 + plane_vector(:, 1) = P(:, 6) - P(:, 2) + plane_vector(:, 2) = P(:, 4) - P(:, 2) + cross_product(1) = plane_vector(2, 1)*plane_vector(3, 2) - plane_vector(3, 1)*plane_vector(2, 2) + cross_product(2) = plane_vector(3, 1)*plane_vector(1, 2) - plane_vector(1, 1)*plane_vector(3, 2) + cross_product(3) = plane_vector(1, 1)*plane_vector(2, 2) - plane_vector(2, 1)*plane_vector(1, 2) normal(:, 1) = cross_product/SQRT(SUM(cross_product**2)) - point_in_plane = -normal(:, 1)*(normal(1, 1)*P(1, 2)+normal(2, 1)*P(2, 2)+normal(3, 1)*P(3, 2)) + point_in_plane = -normal(:, 1)*(normal(1, 1)*P(1, 2) + normal(2, 1)*P(2, 2) + normal(3, 1)*P(3, 2)) IF (point_is_in_quadrilateral(P(:, 2), P(:, 6), P(:, 8), P(:, 4), point_in_plane)) THEN - distance(idx) = ABS(normal(1, 1)*P(1, 2)+normal(2, 1)*P(2, 2)+normal(3, 1)*P(3, 2)) + distance(idx) = ABS(normal(1, 1)*P(1, 2) + normal(2, 1)*P(2, 2) + normal(3, 1)*P(3, 2)) ELSE distance(idx) = HUGE(distance(idx)) END IF ! Face F (1573) 1 is the reference - idx = idx+1 - plane_vector(:, 1) = P(:, 5)-P(:, 1) - plane_vector(:, 2) = P(:, 3)-P(:, 1) - cross_product(1) = plane_vector(2, 1)*plane_vector(3, 2)-plane_vector(3, 1)*plane_vector(2, 2) - cross_product(2) = plane_vector(3, 1)*plane_vector(1, 2)-plane_vector(1, 1)*plane_vector(3, 2) - cross_product(3) = plane_vector(1, 1)*plane_vector(2, 2)-plane_vector(2, 1)*plane_vector(1, 2) + idx = idx + 1 + plane_vector(:, 1) = P(:, 5) - P(:, 1) + plane_vector(:, 2) = P(:, 3) - P(:, 1) + cross_product(1) = plane_vector(2, 1)*plane_vector(3, 2) - plane_vector(3, 1)*plane_vector(2, 2) + cross_product(2) = plane_vector(3, 1)*plane_vector(1, 2) - plane_vector(1, 1)*plane_vector(3, 2) + cross_product(3) = plane_vector(1, 1)*plane_vector(2, 2) - plane_vector(2, 1)*plane_vector(1, 2) normal(:, 1) = cross_product/SQRT(SUM(cross_product**2)) - point_in_plane = -normal(:, 1)*(normal(1, 1)*P(1, 1)+normal(2, 1)*P(2, 1)+normal(3, 1)*P(3, 1)) + point_in_plane = -normal(:, 1)*(normal(1, 1)*P(1, 1) + normal(2, 1)*P(2, 1) + normal(3, 1)*P(3, 1)) IF (point_is_in_quadrilateral(P(:, 1), P(:, 5), P(:, 7), P(:, 3), point_in_plane)) THEN - distance(idx) = ABS(normal(1, 1)*P(1, 1)+normal(2, 1)*P(2, 1)+normal(3, 1)*P(3, 1)) + distance(idx) = ABS(normal(1, 1)*P(1, 1) + normal(2, 1)*P(2, 1) + normal(3, 1)*P(3, 1)) ELSE distance(idx) = HUGE(distance(idx)) END IF @@ -1510,9 +1510,9 @@ SUBROUTINE hfx_create_neighbor_cells(x_data, pbc_shells, cell, i_thread) image_cell_found = .TRUE. END IF IF (dist_min < R_max) THEN - total_number_of_cells = total_number_of_cells+1 + total_number_of_cells = total_number_of_cells + 1 x_data%neighbor_cells(ub)%cell = REAL((/ishell, jshell, kshell/), dp) - ub = ub+1 + ub = ub + 1 image_cell_found = .TRUE. END IF @@ -1520,14 +1520,14 @@ SUBROUTINE hfx_create_neighbor_cells(x_data, pbc_shells, cell, i_thread) END DO END DO IF (image_cell_found) THEN - max_shell = max_shell+1 + max_shell = max_shell + 1 ELSE nothing_more_to_add = .TRUE. END IF END DO ! now remove what is not needed ALLOCATE (tmp_neighbor_cells(total_number_of_cells)) - DO i = 1, ub-1 + DO i = 1, ub - 1 tmp_neighbor_cells(i) = x_data%neighbor_cells(i) END DO DEALLOCATE (x_data%neighbor_cells) @@ -1552,7 +1552,7 @@ SUBROUTINE hfx_create_neighbor_cells(x_data, pbc_shells, cell, i_thread) ELSE total_number_of_cells = 0 DO i = 0, x_data%periodic_parameter%number_of_shells - total_number_of_cells = total_number_of_cells+count_cells_perd(i, x_data%periodic_parameter%perd) + total_number_of_cells = total_number_of_cells + count_cells_perd(i, x_data%periodic_parameter%perd) END DO IF (total_number_of_cells < SIZE(x_data%neighbor_cells)) THEN IF (i_thread == 1) THEN @@ -1567,7 +1567,7 @@ SUBROUTINE hfx_create_neighbor_cells(x_data, pbc_shells, cell, i_thread) END IF total_number_of_cells = 0 DO i = 0, x_data%periodic_parameter%number_of_shells - total_number_of_cells = total_number_of_cells+count_cells_perd(i, x_data%periodic_parameter%perd) + total_number_of_cells = total_number_of_cells + count_cells_perd(i, x_data%periodic_parameter%perd) END DO DEALLOCATE (x_data%neighbor_cells) @@ -1577,14 +1577,14 @@ SUBROUTINE hfx_create_neighbor_cells(x_data, pbc_shells, cell, i_thread) DO WHILE (SUM(m**2) <= x_data%periodic_parameter%number_of_shells) x_data%neighbor_cells(i)%cell = REAL(m, dp) CALL next_image_cell_perd(m, x_data%periodic_parameter%perd) - i = i+1 + i = i + 1 ENDDO END IF CASE DEFAULT total_number_of_cells = 0 IF (pbc_shells == -1) pbc_shells = 0 DO i = 0, pbc_shells - total_number_of_cells = total_number_of_cells+count_cells_perd(i, x_data%periodic_parameter%perd) + total_number_of_cells = total_number_of_cells + count_cells_perd(i, x_data%periodic_parameter%perd) END DO DEALLOCATE (x_data%neighbor_cells) @@ -1595,7 +1595,7 @@ SUBROUTINE hfx_create_neighbor_cells(x_data, pbc_shells, cell, i_thread) DO WHILE (SUM(m**2) <= pbc_shells) x_data%neighbor_cells(i)%cell = REAL(m, dp) CALL next_image_cell_perd(m, x_data%periodic_parameter%perd) - i = i+1 + i = i + 1 ENDDO END SELECT @@ -1612,7 +1612,7 @@ SUBROUTINE hfx_create_neighbor_cells(x_data, pbc_shells, cell, i_thread) DO i = 1, SIZE(x_data%neighbor_cells) R_max_stress = MAX(R_max_stress, MAXVAL(ABS(x_data%neighbor_cells(i)%cell_r(:)))) END DO - R_max_stress = R_max_stress+ABS(MAXVAL(cell%hmat(:, :))) + R_max_stress = R_max_stress + ABS(MAXVAL(cell%hmat(:, :))) x_data%periodic_parameter%R_max_stress = R_max_stress END SUBROUTINE hfx_create_neighbor_cells @@ -1650,9 +1650,9 @@ FUNCTION point_is_in_quadrilateral(A, B, C, D, P) ! ** ABC - v0 = D-A - v1 = C-A - v2 = P-A + v0 = D - A + v1 = C - A + v2 = P - A ! ** Compute dot products dot00 = DOT_PRODUCT(v0, v0) @@ -1662,17 +1662,17 @@ FUNCTION point_is_in_quadrilateral(A, B, C, D, P) dot12 = DOT_PRODUCT(v1, v2) ! ** Compute barycentric coordinates - invDenom = 1/(dot00*dot11-dot01*dot01) - u = (dot11*dot02-dot01*dot12)*invDenom - v = (dot00*dot12-dot01*dot02)*invDenom + invDenom = 1/(dot00*dot11 - dot01*dot01) + u = (dot11*dot02 - dot01*dot12)*invDenom + v = (dot00*dot12 - dot01*dot02)*invDenom ! ** Check if point is in triangle - IF ((u >= 0-fuzzy) .AND. (v >= 0-fuzzy) .AND. (u+v <= 1+fuzzy)) THEN + IF ((u >= 0 - fuzzy) .AND. (v >= 0 - fuzzy) .AND. (u + v <= 1 + fuzzy)) THEN point_is_in_quadrilateral = .TRUE. RETURN END IF - v0 = C-A - v1 = B-A - v2 = P-A + v0 = C - A + v1 = B - A + v2 = P - A ! ** Compute dot products dot00 = DOT_PRODUCT(v0, v0) @@ -1682,12 +1682,12 @@ FUNCTION point_is_in_quadrilateral(A, B, C, D, P) dot12 = DOT_PRODUCT(v1, v2) ! ** Compute barycentric coordinates - invDenom = 1/(dot00*dot11-dot01*dot01) - u = (dot11*dot02-dot01*dot12)*invDenom - v = (dot00*dot12-dot01*dot02)*invDenom + invDenom = 1/(dot00*dot11 - dot01*dot01) + u = (dot11*dot02 - dot01*dot12)*invDenom + v = (dot00*dot12 - dot01*dot02)*invDenom ! ** Check if point is in triangle - IF ((u >= 0-fuzzy) .AND. (v >= 0-fuzzy) .AND. (u+v <= 1+fuzzy)) THEN + IF ((u >= 0 - fuzzy) .AND. (v >= 0 - fuzzy) .AND. (u + v <= 1 + fuzzy)) THEN point_is_in_quadrilateral = .TRUE. RETURN END IF @@ -1807,7 +1807,7 @@ SUBROUTINE hfx_reset_memory_usage_counter(memory_parameter, subtr_size_mb) INTEGER(int_8) :: max_memory max_memory = memory_parameter%max_memory - max_memory = max_memory-subtr_size_mb + max_memory = max_memory - subtr_size_mb IF (max_memory <= 0) THEN memory_parameter%do_all_on_the_fly = .TRUE. memory_parameter%max_compression_counter = 0 diff --git a/src/hfxbase/hfx_compression_core_methods.F b/src/hfxbase/hfx_compression_core_methods.F index cc21b9cc26..972cfdb2d7 100644 --- a/src/hfxbase/hfx_compression_core_methods.F +++ b/src/hfxbase/hfx_compression_core_methods.F @@ -105,21 +105,21 @@ SUBROUTINE bits2ints_generic(Nbits, Ndata, packed_data, full_data) DO ! we've unpacked all data IF (idata == Ndata) EXIT - idata = idata+1 + idata = idata + 1 IF (ibits_remaining >= Nbits) THEN data_tmp = IAND(pack_tmp, mask_right(Nbits)) ! get the last Nbits full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ! and shift right to get the bits in place for the next - ibits_remaining = ibits_remaining-Nbits + ibits_remaining = ibits_remaining - Nbits ELSE - i_odd_bits = Nbits-ibits_remaining + i_odd_bits = Nbits - ibits_remaining data_tmp = ISHFT(pack_tmp, i_odd_bits) ! use all remaining bits, shifted left to make place for the missing bits - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) ! get new storage ibits_remaining = 64 full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(i_odd_bits))) ! and use the missing bits to assemble the data pack_tmp = ISHFT(pack_tmp, -i_odd_bits) ! shift right to get the bits in place for the next - ibits_remaining = 64-i_odd_bits + ibits_remaining = 64 - i_odd_bits ENDIF ENDDO @@ -155,31 +155,31 @@ SUBROUTINE ints2bits_generic(Nbits, Ndata, packed_data, full_data) DO ! we've packed all data IF (idata == Ndata) EXIT - idata = idata+1 + idata = idata + 1 IF (ibits_remaining >= Nbits) THEN data_tmp = full_data(idata) - data_tmp = ISHFT(data_tmp, 64-Nbits) ! put bits on the left + data_tmp = ISHFT(data_tmp, 64 - Nbits) ! put bits on the left pack_tmp = IOR(pack_tmp, data_tmp) ! add to the packed data - ibits_remaining = ibits_remaining-Nbits + ibits_remaining = ibits_remaining - Nbits pack_tmp = ISHFT(pack_tmp, -MIN(Nbits, ibits_remaining)) ! and shift to the right to make place for the next ELSE i_odd_bits = ibits_remaining data_tmp = full_data(idata) - data_tmp = ISHFT(data_tmp, 64-Nbits) ! put bits on the left + data_tmp = ISHFT(data_tmp, 64 - Nbits) ! put bits on the left data_tmp = IAND(data_tmp, mask_left(i_odd_bits)) ! restrict to those bits for which we still have space pack_tmp = IOR(pack_tmp, data_tmp) ! add them to the packed bits - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ! store the full packed data away and start with a new one data_tmp = full_data(idata) - pack_tmp = ISHFT(data_tmp, 64-Nbits+i_odd_bits) ! put the missing bits on the left if pack_tmp - ibits_remaining = 64-Nbits+i_odd_bits + pack_tmp = ISHFT(data_tmp, 64 - Nbits + i_odd_bits) ! put the missing bits on the left if pack_tmp + ibits_remaining = 64 - Nbits + i_odd_bits pack_tmp = ISHFT(pack_tmp, -MIN(Nbits, ibits_remaining)) ! shift to make place, but not more than the number of available bits ENDIF ENDDO ! cleanup this unfinished packed data and store - pack_tmp = ISHFT(pack_tmp, -MAX(0, ibits_remaining-Nbits)) - ipack = ipack+1 + pack_tmp = ISHFT(pack_tmp, -MAX(0, ibits_remaining - Nbits)) + ipack = ipack + 1 packed_data(ipack) = pack_tmp END SUBROUTINE ints2bits_generic @@ -205,332 +205,332 @@ SUBROUTINE ints2bits_1(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 63) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_1 @@ -555,267 +555,267 @@ SUBROUTINE bits2ints_1(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_1 @@ -840,337 +840,337 @@ SUBROUTINE ints2bits_2(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 62) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_2 @@ -1195,269 +1195,269 @@ SUBROUTINE bits2ints_2(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_2 @@ -1482,342 +1482,342 @@ SUBROUTINE ints2bits_3(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 61) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_3 @@ -1842,271 +1842,271 @@ SUBROUTINE bits2ints_3(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_3 @@ -2131,347 +2131,347 @@ SUBROUTINE ints2bits_4(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 60) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_4 @@ -2496,273 +2496,273 @@ SUBROUTINE bits2ints_4(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_4 @@ -2787,352 +2787,352 @@ SUBROUTINE ints2bits_5(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 59) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_5 @@ -3157,275 +3157,275 @@ SUBROUTINE bits2ints_5(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_5 @@ -3450,357 +3450,357 @@ SUBROUTINE ints2bits_6(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 58) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_6 @@ -3825,277 +3825,277 @@ SUBROUTINE bits2ints_6(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_6 @@ -4120,362 +4120,362 @@ SUBROUTINE ints2bits_7(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 57) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_7 @@ -4500,279 +4500,279 @@ SUBROUTINE bits2ints_7(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_7 @@ -4797,367 +4797,367 @@ SUBROUTINE ints2bits_8(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 56) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_8 @@ -5182,281 +5182,281 @@ SUBROUTINE bits2ints_8(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_8 @@ -5481,372 +5481,372 @@ SUBROUTINE ints2bits_9(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 55) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_9 @@ -5871,283 +5871,283 @@ SUBROUTINE bits2ints_9(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_9 @@ -6172,377 +6172,377 @@ SUBROUTINE ints2bits_10(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 54) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_10 @@ -6567,285 +6567,285 @@ SUBROUTINE bits2ints_10(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_10 @@ -6870,382 +6870,382 @@ SUBROUTINE ints2bits_11(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 53) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_11 @@ -7270,287 +7270,287 @@ SUBROUTINE bits2ints_11(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_11 @@ -7575,387 +7575,387 @@ SUBROUTINE ints2bits_12(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 52) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_12 @@ -7980,289 +7980,289 @@ SUBROUTINE bits2ints_12(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_12 @@ -8287,392 +8287,392 @@ SUBROUTINE ints2bits_13(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 51) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_13 @@ -8697,291 +8697,291 @@ SUBROUTINE bits2ints_13(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_13 @@ -9006,397 +9006,397 @@ SUBROUTINE ints2bits_14(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 50) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_14 @@ -9421,293 +9421,293 @@ SUBROUTINE bits2ints_14(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_14 @@ -9732,402 +9732,402 @@ SUBROUTINE ints2bits_15(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 49) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_15 @@ -10152,295 +10152,295 @@ SUBROUTINE bits2ints_15(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_15 @@ -10465,407 +10465,407 @@ SUBROUTINE ints2bits_16(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 48) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_16 @@ -10890,297 +10890,297 @@ SUBROUTINE bits2ints_16(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_16 @@ -11205,412 +11205,412 @@ SUBROUTINE ints2bits_17(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 47) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_17 @@ -11635,299 +11635,299 @@ SUBROUTINE bits2ints_17(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_17 @@ -11952,417 +11952,417 @@ SUBROUTINE ints2bits_18(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 46) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_18 @@ -12387,301 +12387,301 @@ SUBROUTINE bits2ints_18(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_18 @@ -12706,422 +12706,422 @@ SUBROUTINE ints2bits_19(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 47) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) data_tmp = IAND(data_tmp, mask_left(17)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 45) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_19 @@ -13146,303 +13146,303 @@ SUBROUTINE bits2ints_19(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 19) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(19))) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_19 @@ -13467,427 +13467,427 @@ SUBROUTINE ints2bits_20(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 44) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_20 @@ -13912,305 +13912,305 @@ SUBROUTINE bits2ints_20(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_20 @@ -14235,432 +14235,432 @@ SUBROUTINE ints2bits_21(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 45) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 47) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) data_tmp = IAND(data_tmp, mask_left(17)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) data_tmp = IAND(data_tmp, mask_left(19)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 43) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_21 @@ -14685,307 +14685,307 @@ SUBROUTINE bits2ints_21(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 21) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(21))) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 19) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(19))) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_21 @@ -15010,437 +15010,437 @@ SUBROUTINE ints2bits_22(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 42) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_22 @@ -15465,309 +15465,309 @@ SUBROUTINE bits2ints_22(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_22 @@ -15792,442 +15792,442 @@ SUBROUTINE ints2bits_23(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) data_tmp = IAND(data_tmp, mask_left(21)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 47) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) data_tmp = IAND(data_tmp, mask_left(19)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 45) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) data_tmp = IAND(data_tmp, mask_left(17)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 43) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 41) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_23 @@ -16252,311 +16252,311 @@ SUBROUTINE bits2ints_23(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 23) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(23))) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 19) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(19))) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 21) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(21))) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_23 @@ -16581,447 +16581,447 @@ SUBROUTINE ints2bits_24(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 40) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_24 @@ -17046,313 +17046,313 @@ SUBROUTINE bits2ints_24(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_24 @@ -17377,452 +17377,452 @@ SUBROUTINE ints2bits_25(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(17)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 45) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(23)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 43) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(21)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 41) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(19)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 47) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 39) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_25 @@ -17847,315 +17847,315 @@ SUBROUTINE bits2ints_25(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 25) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(25))) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 19) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(19))) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 21) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(21))) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 23) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(23))) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_25 @@ -18180,457 +18180,457 @@ SUBROUTINE ints2bits_26(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 38) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_26 @@ -18655,317 +18655,317 @@ SUBROUTINE bits2ints_26(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_26 @@ -18990,462 +18990,462 @@ SUBROUTINE ints2bits_27(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 47) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(23)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 43) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(19)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 39) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(25)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 45) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(21)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 41) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) data_tmp = IAND(data_tmp, mask_left(17)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 37) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_27 @@ -19470,319 +19470,319 @@ SUBROUTINE bits2ints_27(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 27) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(27))) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 21) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(21))) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 25) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(25))) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 19) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(19))) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 23) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(23))) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_27 @@ -19807,467 +19807,467 @@ SUBROUTINE ints2bits_28(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 36) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_28 @@ -20292,321 +20292,321 @@ SUBROUTINE bits2ints_28(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_28 @@ -20631,472 +20631,472 @@ SUBROUTINE ints2bits_29(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 41) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 47) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(19)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(25)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 37) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 43) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(21)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(27)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 39) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 45) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(17)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) data_tmp = IAND(data_tmp, mask_left(23)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 35) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_29 @@ -21121,323 +21121,323 @@ SUBROUTINE bits2ints_29(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 29) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(29))) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 23) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(23))) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 27) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(27))) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 21) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(21))) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 25) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(25))) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 19) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(19))) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_29 @@ -21462,477 +21462,477 @@ SUBROUTINE ints2bits_30(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 34) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_30 @@ -21957,325 +21957,325 @@ SUBROUTINE bits2ints_30(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_30 @@ -22300,482 +22300,482 @@ SUBROUTINE ints2bits_31(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 35) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 37) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 39) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 41) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 43) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 45) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 47) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(17)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(19)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(21)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(23)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(25)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(27)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) data_tmp = IAND(data_tmp, mask_left(29)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 33) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_31 @@ -22800,327 +22800,327 @@ SUBROUTINE bits2ints_31(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 31) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(31))) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 29) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(29))) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 27) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(27))) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 25) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(25))) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 23) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(23))) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 21) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(21))) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 19) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(19))) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_31 @@ -23145,487 +23145,487 @@ SUBROUTINE ints2bits_32(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 32) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_32 @@ -23650,329 +23650,329 @@ SUBROUTINE bits2ints_32(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_32 @@ -23997,492 +23997,492 @@ SUBROUTINE ints2bits_33(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(31)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(29)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(27)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(25)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(23)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(21)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(19)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(17)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 47) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 45) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 43) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 41) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 39) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 37) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 35) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 33) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 31) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_33 @@ -24507,331 +24507,331 @@ SUBROUTINE bits2ints_33(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 33) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(33))) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 19) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(19))) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 21) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(21))) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 23) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(23))) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 25) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(25))) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 27) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(27))) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 29) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(29))) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 31) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(31))) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_33 @@ -24856,497 +24856,497 @@ SUBROUTINE ints2bits_34(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 30) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_34 @@ -25371,333 +25371,333 @@ SUBROUTINE bits2ints_34(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_34 @@ -25722,502 +25722,502 @@ SUBROUTINE ints2bits_35(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(29)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(23)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(17)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 45) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 39) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 33) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(33)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(27)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(21)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 43) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 37) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 31) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(31)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(25)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(19)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 47) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 41) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 35) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 29) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_35 @@ -26242,335 +26242,335 @@ SUBROUTINE bits2ints_35(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 35) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(35))) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 19) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(19))) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 25) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(25))) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 31) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(31))) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 21) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(21))) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 27) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(27))) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 33) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(33))) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 23) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(23))) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 29) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(29))) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_35 @@ -26595,507 +26595,507 @@ SUBROUTINE ints2bits_36(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 28) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_36 @@ -27120,337 +27120,337 @@ SUBROUTINE bits2ints_36(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_36 @@ -27475,512 +27475,512 @@ SUBROUTINE ints2bits_37(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(27)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(17)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 41) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 31) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(31)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(21)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 45) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 35) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(35)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(25)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 39) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 29) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(29)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(19)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 43) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 33) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(33)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(23)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 47) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 37) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 27) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_37 @@ -28005,339 +28005,339 @@ SUBROUTINE bits2ints_37(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 37) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(37))) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 23) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(23))) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 33) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(33))) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 19) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(19))) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 29) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(29))) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 25) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(25))) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 35) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(35))) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 21) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(21))) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 31) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(31))) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 27) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(27))) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_37 @@ -28362,517 +28362,517 @@ SUBROUTINE ints2bits_38(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 26) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_38 @@ -28897,341 +28897,341 @@ SUBROUTINE bits2ints_38(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_38 @@ -29256,522 +29256,522 @@ SUBROUTINE ints2bits_39(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(25)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 47) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 33) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(33)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(19)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 41) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 27) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(27)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 35) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(35)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(21)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 43) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 29) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(29)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 37) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(37)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(23)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 45) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 31) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(31)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(17)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 39) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 25) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_39 @@ -29796,343 +29796,343 @@ SUBROUTINE bits2ints_39(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 39) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(39))) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 31) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(31))) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 23) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(23))) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 37) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(37))) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 29) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(29))) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 21) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(21))) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 35) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(35))) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 27) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(27))) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 19) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(19))) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 33) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(33))) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 25) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(25))) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_39 @@ -30157,527 +30157,527 @@ SUBROUTINE ints2bits_40(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 24) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_40 @@ -30702,345 +30702,345 @@ SUBROUTINE bits2ints_40(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_40 @@ -31065,532 +31065,532 @@ SUBROUTINE ints2bits_41(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(23)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 33) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(33)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 43) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 25) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(25)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 35) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(35)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(17)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 45) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 27) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(27)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 37) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(37)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(19)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 47) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 29) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(29)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 39) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(39)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(21)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 31) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(31)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 41) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 23) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_41 @@ -31615,347 +31615,347 @@ SUBROUTINE bits2ints_41(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 41) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(41))) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 31) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(31))) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 21) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(21))) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 39) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(39))) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 29) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(29))) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 19) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(19))) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 37) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(37))) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 27) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(27))) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 35) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(35))) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 25) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(25))) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 33) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(33))) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 23) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(23))) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_41 @@ -31980,537 +31980,537 @@ SUBROUTINE ints2bits_42(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 22) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 22) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_42 @@ -32535,349 +32535,349 @@ SUBROUTINE bits2ints_42(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 42) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(42))) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 42) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(42))) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_42 @@ -32902,542 +32902,542 @@ SUBROUTINE ints2bits_43(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(21)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(42)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 41) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(41)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(19)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 39) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(39)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(17)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 37) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(37)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 35) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(35)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 33) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(33)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 31) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(31)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 29) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(29)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 27) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(27)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 47) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 25) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(25)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 45) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 23) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(23)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 22) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 43) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 21) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_43 @@ -33462,351 +33462,351 @@ SUBROUTINE bits2ints_43(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 43) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(43))) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 23) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(23))) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 25) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(25))) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 27) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(27))) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 29) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(29))) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 31) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(31))) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 33) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(33))) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 35) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(35))) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 37) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(37))) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 39) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(39))) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 19) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(19))) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 41) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(41))) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 42) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(42))) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 21) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(21))) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_43 @@ -33831,547 +33831,547 @@ SUBROUTINE ints2bits_44(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 20) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_44 @@ -34396,353 +34396,353 @@ SUBROUTINE bits2ints_44(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_44 @@ -34767,552 +34767,552 @@ SUBROUTINE ints2bits_45(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(19)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 31) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(31)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 43) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(43)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(17)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 29) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(29)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 22) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 41) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(41)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 27) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(27)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 39) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(39)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 25) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(25)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 37) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(37)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 23) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(23)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(42)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 35) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(35)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 47) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 21) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(21)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 33) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(33)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 45) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 19) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_45 @@ -35337,355 +35337,355 @@ SUBROUTINE bits2ints_45(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 45) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(45))) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 33) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(33))) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 21) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(21))) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 35) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(35))) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 42) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(42))) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 23) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(23))) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 37) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(37))) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 25) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(25))) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 39) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(39))) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 27) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(27))) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 41) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(41))) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 29) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(29))) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 43) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(43))) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 31) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(31))) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 19) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(19))) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_45 @@ -35710,557 +35710,557 @@ SUBROUTINE ints2bits_46(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(42)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 22) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 18) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(42)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 22) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 18) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_46 @@ -36285,357 +36285,357 @@ SUBROUTINE bits2ints_46(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 46) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(46))) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 42) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(42))) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 46) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(46))) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 42) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(42))) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_46 @@ -36660,562 +36660,562 @@ SUBROUTINE ints2bits_47(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(17)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 21) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(21)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 25) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(25)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(42)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 29) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(29)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(46)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 33) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(33)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 37) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(37)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 41) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(41)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 45) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(45)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 19) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(19)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 23) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(23)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 27) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(27)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 31) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(31)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 18) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 35) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(35)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 22) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 39) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(39)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 43) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(43)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 47) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 17) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_47 @@ -37240,359 +37240,359 @@ SUBROUTINE bits2ints_47(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 47) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(47))) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 43) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(43))) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 39) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(39))) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 35) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(35))) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 31) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(31))) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 27) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(27))) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 23) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(23))) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 19) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(19))) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 45) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(45))) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 41) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(41))) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 37) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(37))) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 33) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(33))) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 46) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(46))) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 29) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(29))) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 42) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(42))) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 25) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(25))) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 21) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(21))) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_47 @@ -37617,567 +37617,567 @@ SUBROUTINE ints2bits_48(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 16) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_48 @@ -38202,361 +38202,361 @@ SUBROUTINE bits2ints_48(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_48 @@ -38581,572 +38581,572 @@ SUBROUTINE ints2bits_49(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 45) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(45)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 41) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(41)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 22) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 37) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(37)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 18) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 33) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(33)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 29) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(29)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 25) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(25)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 21) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(21)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 17) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(17)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 47) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(47)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 43) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(43)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 39) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(39)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 35) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(35)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 31) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(31)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(46)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 27) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(27)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(42)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 23) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(23)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 19) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(19)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 15) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_49 @@ -39171,363 +39171,363 @@ SUBROUTINE bits2ints_49(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 49) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(49))) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 19) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(19))) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 23) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(23))) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 42) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(42))) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 27) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(27))) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 46) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(46))) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 31) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(31))) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 35) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(35))) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 39) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(39))) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 43) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(43))) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 47) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(47))) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 21) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(21))) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 25) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(25))) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 29) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(29))) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 33) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(33))) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 37) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(37))) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 41) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(41))) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 45) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(45))) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_49 @@ -39552,577 +39552,577 @@ SUBROUTINE ints2bits_50(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(42)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 18) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(46)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 22) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 14) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(42)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 18) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(46)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 22) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 14) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_50 @@ -40147,365 +40147,365 @@ SUBROUTINE bits2ints_50(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 50) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(50))) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 46) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(46))) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 42) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(42))) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 50) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(50))) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 46) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(46))) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 42) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(42))) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_50 @@ -40530,582 +40530,582 @@ SUBROUTINE ints2bits_51(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 39) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(39)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 14) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 27) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(27)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 15) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 41) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(41)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 29) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(29)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(42)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 17) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(17)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 43) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(43)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 18) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 31) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(31)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 19) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(19)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 45) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(45)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 33) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(33)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(46)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 21) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(21)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 47) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(47)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 22) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 35) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(35)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 23) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(23)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(49)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 37) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(37)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(50)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 25) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(25)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 13) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_51 @@ -41130,367 +41130,367 @@ SUBROUTINE bits2ints_51(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 51) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(51))) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 25) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(25))) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 50) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(50))) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 37) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(37))) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 49) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(49))) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 23) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(23))) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 35) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(35))) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 47) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(47))) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 21) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(21))) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 46) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(46))) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 33) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(33))) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 45) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(45))) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 19) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(19))) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 31) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(31))) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 43) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(43))) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 42) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(42))) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 29) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(29))) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 41) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(41))) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 27) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(27))) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 39) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(39))) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_51 @@ -41515,587 +41515,587 @@ SUBROUTINE ints2bits_52(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 12) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 12) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 12) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 12) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_52 @@ -42120,369 +42120,369 @@ SUBROUTINE bits2ints_52(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 52) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(52))) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 52) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(52))) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 52) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(52))) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 52) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(52))) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_52 @@ -42507,592 +42507,592 @@ SUBROUTINE ints2bits_53(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 22) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 33) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(33)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -53) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 13) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 35) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(35)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(46)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -53) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 15) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 37) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(37)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -53) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 17) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(17)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 39) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(39)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(50)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -53) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 19) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(19)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 41) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(41)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(52)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -53) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 21) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(21)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 43) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(43)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -53) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 12) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 23) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(23)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 45) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(45)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -53) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 14) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 25) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(25)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 47) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(47)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -53) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 27) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(27)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(49)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -53) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 18) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 29) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(29)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(51)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -53) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 31) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(31)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) data_tmp = IAND(data_tmp, mask_left(42)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -53) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 11) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_53 @@ -43117,371 +43117,371 @@ SUBROUTINE bits2ints_53(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 53) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(53))) pack_tmp = ISHFT(pack_tmp, -53) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 42) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(42))) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 31) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(31))) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 51) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(51))) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 29) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(29))) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 49) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(49))) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 27) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(27))) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 47) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(47))) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 25) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(25))) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 45) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(45))) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 23) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(23))) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 43) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(43))) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 21) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(21))) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 52) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(52))) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 41) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(41))) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 19) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(19))) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 50) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(50))) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 39) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(39))) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 37) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(37))) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 46) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(46))) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 35) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(35))) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 33) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(33))) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_53 @@ -43506,597 +43506,597 @@ SUBROUTINE ints2bits_54(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(50)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(46)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 12) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 22) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(42)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(52)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 18) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 14) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 10) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(50)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(46)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 12) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 22) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(42)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(52)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 18) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 14) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 10) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_54 @@ -44121,373 +44121,373 @@ SUBROUTINE bits2ints_54(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 54) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(54))) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 52) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(52))) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 42) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(42))) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 46) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(46))) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 50) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(50))) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 54) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(54))) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 52) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(52))) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 42) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(42))) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 46) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(46))) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 50) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(50))) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_54 @@ -44512,602 +44512,602 @@ SUBROUTINE ints2bits_55(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 18) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 27) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(27)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 45) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(45)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(54)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -55) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 17) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(17)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 35) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(35)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -53) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(53)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -55) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 25) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(25)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 43) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(43)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(52)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -55) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 15) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 33) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(33)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(42)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(51)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -55) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 14) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 23) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(23)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 41) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(41)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(50)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -55) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 13) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 22) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 31) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(31)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(49)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -55) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 12) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 21) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(21)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 39) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(39)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -55) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 11) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 29) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(29)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 47) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(47)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -55) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 10) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 19) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(19)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 37) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(37)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) data_tmp = IAND(data_tmp, mask_left(46)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -55) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 9) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_55 @@ -45132,375 +45132,375 @@ SUBROUTINE bits2ints_55(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 55) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(55))) pack_tmp = ISHFT(pack_tmp, -55) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 46) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(46))) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 37) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(37))) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 19) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(19))) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 47) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(47))) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 29) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(29))) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 39) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(39))) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 21) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(21))) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 49) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(49))) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 31) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(31))) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 50) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(50))) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 41) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(41))) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 23) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(23))) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 51) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(51))) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 42) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(42))) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 33) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(33))) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 52) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(52))) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 43) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(43))) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 25) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(25))) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 53) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(53))) pack_tmp = ISHFT(pack_tmp, -53) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 35) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(35))) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 54) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(54))) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 45) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(45))) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 27) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(27))) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_55 @@ -45525,607 +45525,607 @@ SUBROUTINE ints2bits_56(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 8) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 8) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 8) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 8) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 8) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 8) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 8) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 8) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_56 @@ -46150,377 +46150,377 @@ SUBROUTINE bits2ints_56(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 56) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(56))) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 56) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(56))) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 56) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(56))) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 56) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(56))) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 56) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(56))) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 56) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(56))) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 56) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(56))) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 56) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(56))) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_56 @@ -46545,612 +46545,612 @@ SUBROUTINE ints2bits_57(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 14) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 21) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(21)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 35) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(35)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(42)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(49)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(56)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -57) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 13) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 27) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(27)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 41) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(41)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -55) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(55)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -57) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 12) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 19) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(19)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 33) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(33)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 47) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(47)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(54)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -57) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 11) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 18) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 25) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(25)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 39) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(39)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(46)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -53) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(53)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -57) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 10) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 17) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(17)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 31) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(31)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 45) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(45)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(52)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -57) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 9) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 23) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(23)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 37) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(37)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(51)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -57) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 8) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 15) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 22) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 29) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(29)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 43) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(43)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) data_tmp = IAND(data_tmp, mask_left(50)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -57) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 7) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_57 @@ -47175,379 +47175,379 @@ SUBROUTINE bits2ints_57(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 57) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(57))) pack_tmp = ISHFT(pack_tmp, -57) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 50) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(50))) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 43) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(43))) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 29) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(29))) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 51) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(51))) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 37) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(37))) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 23) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(23))) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 52) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(52))) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 45) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(45))) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 31) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(31))) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 53) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(53))) pack_tmp = ISHFT(pack_tmp, -53) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 46) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(46))) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 39) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(39))) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 25) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(25))) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 54) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(54))) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 47) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(47))) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 33) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(33))) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 19) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(19))) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 55) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(55))) pack_tmp = ISHFT(pack_tmp, -55) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 41) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(41))) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 27) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(27))) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 56) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(56))) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 49) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(49))) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 42) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(42))) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 35) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(35))) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 21) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(21))) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_57 @@ -47572,617 +47572,617 @@ SUBROUTINE ints2bits_58(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 12) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 18) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(42)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(54)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -58) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 8) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 14) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(50)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(56)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -58) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 10) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 22) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(46)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(52)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -58) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 6) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 12) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 18) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(42)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(54)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -58) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 8) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 14) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(50)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(56)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -58) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 10) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 22) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(46)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) data_tmp = IAND(data_tmp, mask_left(52)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -58) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 6) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_58 @@ -48207,381 +48207,381 @@ SUBROUTINE bits2ints_58(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 58) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(58))) pack_tmp = ISHFT(pack_tmp, -58) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 52) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(52))) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 46) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(46))) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 56) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(56))) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 50) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(50))) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 54) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(54))) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 42) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(42))) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 58) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(58))) pack_tmp = ISHFT(pack_tmp, -58) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 52) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(52))) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 46) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(46))) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 56) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(56))) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 50) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(50))) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 54) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(54))) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 42) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(42))) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_58 @@ -48606,622 +48606,622 @@ SUBROUTINE ints2bits_59(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 10) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 15) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 25) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(25)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 35) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(35)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 45) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(45)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(50)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -55) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(55)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -59) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 6) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 11) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 21) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(21)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 31) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(31)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 41) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(41)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(46)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(51)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(56)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -59) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 7) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 12) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 17) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(17)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 22) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 27) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(27)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 37) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(37)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(42)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 47) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(47)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(52)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -57) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(57)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -59) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 8) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 13) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 18) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 23) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(23)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 33) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(33)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 43) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(43)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -53) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(53)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -58) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(58)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -59) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 9) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 14) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 19) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(19)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 29) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(29)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 39) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(39)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(49)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) data_tmp = IAND(data_tmp, mask_left(54)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -59) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 5) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_59 @@ -49246,383 +49246,383 @@ SUBROUTINE bits2ints_59(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 59) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(59))) pack_tmp = ISHFT(pack_tmp, -59) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 54) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(54))) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 49) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(49))) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 39) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(39))) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 29) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(29))) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 19) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(19))) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 58) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(58))) pack_tmp = ISHFT(pack_tmp, -58) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 53) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(53))) pack_tmp = ISHFT(pack_tmp, -53) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 43) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(43))) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 33) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(33))) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 23) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(23))) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 57) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(57))) pack_tmp = ISHFT(pack_tmp, -57) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 52) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(52))) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 47) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(47))) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 42) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(42))) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 37) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(37))) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 27) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(27))) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 56) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(56))) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 51) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(51))) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 46) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(46))) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 41) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(41))) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 31) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(31))) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 21) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(21))) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 55) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(55))) pack_tmp = ISHFT(pack_tmp, -55) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 50) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(50))) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 45) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(45))) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 35) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(35))) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 25) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(25))) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_59 @@ -49647,627 +49647,627 @@ SUBROUTINE ints2bits_60(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 8) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 12) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(52)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(56)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -60) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 4) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 8) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 12) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(52)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(56)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -60) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 4) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 8) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 12) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(52)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(56)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -60) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 4) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 8) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 12) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(52)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) data_tmp = IAND(data_tmp, mask_left(56)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -60) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 4) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_60 @@ -50292,385 +50292,385 @@ SUBROUTINE bits2ints_60(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 60) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(60))) pack_tmp = ISHFT(pack_tmp, -60) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 56) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(56))) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 52) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(52))) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 60) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(60))) pack_tmp = ISHFT(pack_tmp, -60) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 56) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(56))) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 52) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(52))) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 60) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(60))) pack_tmp = ISHFT(pack_tmp, -60) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 56) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(56))) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 52) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(52))) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 60) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(60))) pack_tmp = ISHFT(pack_tmp, -60) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 56) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(56))) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 52) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(52))) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_60 @@ -50695,632 +50695,632 @@ SUBROUTINE ints2bits_61(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 6) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 9) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 12) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 15) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 18) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 21) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(21)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 27) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(27)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 33) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(33)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 39) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(39)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(42)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 45) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(45)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(51)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(54)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -57) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(57)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -60) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(60)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -61) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 5) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 8) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 11) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 14) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 17) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(17)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 23) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(23)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 29) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(29)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 35) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(35)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 41) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(41)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 47) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(47)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(50)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -53) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(53)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(56)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -59) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(59)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -61) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 4) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 7) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 10) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 13) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 19) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(19)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 22) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 25) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(25)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 31) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(31)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 37) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(37)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 43) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(43)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(46)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(49)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(52)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -55) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(55)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -58) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) data_tmp = IAND(data_tmp, mask_left(58)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -61) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 3) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_61 @@ -51345,387 +51345,387 @@ SUBROUTINE bits2ints_61(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 61) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(61))) pack_tmp = ISHFT(pack_tmp, -61) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 58) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(58))) pack_tmp = ISHFT(pack_tmp, -58) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 55) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(55))) pack_tmp = ISHFT(pack_tmp, -55) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 52) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(52))) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 49) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(49))) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 46) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(46))) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 43) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(43))) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 37) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(37))) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 31) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(31))) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 25) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(25))) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 19) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(19))) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 59) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(59))) pack_tmp = ISHFT(pack_tmp, -59) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 56) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(56))) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 53) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(53))) pack_tmp = ISHFT(pack_tmp, -53) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 50) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(50))) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 47) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(47))) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 41) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(41))) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 35) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(35))) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 29) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(29))) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 23) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(23))) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 60) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(60))) pack_tmp = ISHFT(pack_tmp, -60) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 57) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(57))) pack_tmp = ISHFT(pack_tmp, -57) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 54) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(54))) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 51) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(51))) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 45) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(45))) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 42) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(42))) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 39) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(39))) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 33) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(33))) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 27) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(27))) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 21) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(21))) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_61 @@ -51750,637 +51750,637 @@ SUBROUTINE ints2bits_62(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 4) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 6) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 8) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 10) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 12) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 14) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 18) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 22) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(42)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(46)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(50)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(52)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(54)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(56)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -58) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(58)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -60) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(60)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -62) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(0)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 2) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 4) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 6) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 8) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 10) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 12) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 14) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 18) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 22) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(42)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(46)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(50)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(52)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(54)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(56)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -58) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(58)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -60) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) data_tmp = IAND(data_tmp, mask_left(60)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -62) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 2) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_62 @@ -52405,389 +52405,389 @@ SUBROUTINE bits2ints_62(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 62) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(62))) pack_tmp = ISHFT(pack_tmp, -62) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 60) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(60))) pack_tmp = ISHFT(pack_tmp, -60) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 58) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(58))) pack_tmp = ISHFT(pack_tmp, -58) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 56) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(56))) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 54) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(54))) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 52) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(52))) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 50) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(50))) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 46) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(46))) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 42) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(42))) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 62) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(62))) pack_tmp = ISHFT(pack_tmp, -62) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 60) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(60))) pack_tmp = ISHFT(pack_tmp, -60) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 58) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(58))) pack_tmp = ISHFT(pack_tmp, -58) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 56) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(56))) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 54) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(54))) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 52) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(52))) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 50) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(50))) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 46) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(46))) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 42) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(42))) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_62 @@ -52812,642 +52812,642 @@ SUBROUTINE ints2bits_63(Ndata, packed_data, full_data) Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 pack_tmp = 0 - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(1)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 2) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(2)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 3) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(3)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 4) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(4)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 5) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(5)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 6) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(6)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 7) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(7)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 8) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(8)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 9) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(9)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 10) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(10)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 11) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(11)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 12) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(12)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 13) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(13)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 14) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(14)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 15) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(15)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 16) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(16)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 17) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(17)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 18) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(18)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 19) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(19)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 20) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(20)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 21) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(21)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 22) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(22)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 23) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(23)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 24) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(24)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 25) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(25)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 26) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(26)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 27) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(27)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 28) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(28)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 29) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(29)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 30) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(30)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 31) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(31)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 32) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(32)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 33) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(33)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 34) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(34)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 35) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(35)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 36) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(36)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 37) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(37)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 38) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(38)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 39) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(39)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 40) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(40)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 41) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(41)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 42) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(42)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 43) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(43)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 44) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(44)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 45) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(45)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 46) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(46)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 47) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(47)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 48) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(48)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 49) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(49)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 50) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(50)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 51) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(51)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 52) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(52)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 53) pack_tmp = ISHFT(pack_tmp, -53) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(53)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 54) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(54)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 55) pack_tmp = ISHFT(pack_tmp, -55) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(55)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 56) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(56)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 57) pack_tmp = ISHFT(pack_tmp, -57) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(57)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 58) pack_tmp = ISHFT(pack_tmp, -58) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(58)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 59) pack_tmp = ISHFT(pack_tmp, -59) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(59)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 60) pack_tmp = ISHFT(pack_tmp, -60) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(60)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 61) pack_tmp = ISHFT(pack_tmp, -61) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(61)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 62) pack_tmp = ISHFT(pack_tmp, -62) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) data_tmp = IAND(data_tmp, mask_left(62)) pack_tmp = IOR(pack_tmp, data_tmp) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp data_tmp = full_data(idata) pack_tmp = ISHFT(data_tmp, 63) pack_tmp = ISHFT(pack_tmp, -63) - idata = idata+1 + idata = idata + 1 data_tmp = full_data(idata) data_tmp = ISHFT(data_tmp, 1) pack_tmp = IOR(pack_tmp, data_tmp) pack_tmp = ISHFT(pack_tmp, 0) pack_tmp = ISHFT(pack_tmp, 0) - ipack = ipack+1 + ipack = ipack + 1 packed_data(ipack) = pack_tmp ENDDO IF (Ndata_rep < Ndata) THEN - CALL ints2bits_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL ints2bits_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE ints2bits_63 @@ -53472,391 +53472,391 @@ SUBROUTINE bits2ints_63(Ndata, packed_data, full_data) pack_tmp = 0 Ndata_rep = (Ndata/64)*64 DO kdata = 1, Ndata_rep, 64 - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 63) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(63))) pack_tmp = ISHFT(pack_tmp, -63) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 62) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(62))) pack_tmp = ISHFT(pack_tmp, -62) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 61) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(61))) pack_tmp = ISHFT(pack_tmp, -61) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 60) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(60))) pack_tmp = ISHFT(pack_tmp, -60) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 59) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(59))) pack_tmp = ISHFT(pack_tmp, -59) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 58) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(58))) pack_tmp = ISHFT(pack_tmp, -58) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 57) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(57))) pack_tmp = ISHFT(pack_tmp, -57) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 56) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(56))) pack_tmp = ISHFT(pack_tmp, -56) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 55) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(55))) pack_tmp = ISHFT(pack_tmp, -55) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 54) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(54))) pack_tmp = ISHFT(pack_tmp, -54) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 53) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(53))) pack_tmp = ISHFT(pack_tmp, -53) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 52) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(52))) pack_tmp = ISHFT(pack_tmp, -52) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 51) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(51))) pack_tmp = ISHFT(pack_tmp, -51) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 50) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(50))) pack_tmp = ISHFT(pack_tmp, -50) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 49) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(49))) pack_tmp = ISHFT(pack_tmp, -49) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 48) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(48))) pack_tmp = ISHFT(pack_tmp, -48) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 47) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(47))) pack_tmp = ISHFT(pack_tmp, -47) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 46) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(46))) pack_tmp = ISHFT(pack_tmp, -46) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 45) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(45))) pack_tmp = ISHFT(pack_tmp, -45) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 44) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(44))) pack_tmp = ISHFT(pack_tmp, -44) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 43) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(43))) pack_tmp = ISHFT(pack_tmp, -43) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 42) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(42))) pack_tmp = ISHFT(pack_tmp, -42) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 41) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(41))) pack_tmp = ISHFT(pack_tmp, -41) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 40) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(40))) pack_tmp = ISHFT(pack_tmp, -40) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 39) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(39))) pack_tmp = ISHFT(pack_tmp, -39) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 38) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(38))) pack_tmp = ISHFT(pack_tmp, -38) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 37) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(37))) pack_tmp = ISHFT(pack_tmp, -37) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 36) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(36))) pack_tmp = ISHFT(pack_tmp, -36) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 35) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(35))) pack_tmp = ISHFT(pack_tmp, -35) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 34) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(34))) pack_tmp = ISHFT(pack_tmp, -34) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 33) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(33))) pack_tmp = ISHFT(pack_tmp, -33) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 32) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(32))) pack_tmp = ISHFT(pack_tmp, -32) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 31) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(31))) pack_tmp = ISHFT(pack_tmp, -31) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 30) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(30))) pack_tmp = ISHFT(pack_tmp, -30) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 29) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(29))) pack_tmp = ISHFT(pack_tmp, -29) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 28) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(28))) pack_tmp = ISHFT(pack_tmp, -28) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 27) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(27))) pack_tmp = ISHFT(pack_tmp, -27) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 26) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(26))) pack_tmp = ISHFT(pack_tmp, -26) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 25) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(25))) pack_tmp = ISHFT(pack_tmp, -25) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 24) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(24))) pack_tmp = ISHFT(pack_tmp, -24) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 23) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(23))) pack_tmp = ISHFT(pack_tmp, -23) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 22) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(22))) pack_tmp = ISHFT(pack_tmp, -22) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 21) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(21))) pack_tmp = ISHFT(pack_tmp, -21) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 20) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(20))) pack_tmp = ISHFT(pack_tmp, -20) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 19) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(19))) pack_tmp = ISHFT(pack_tmp, -19) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 18) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(18))) pack_tmp = ISHFT(pack_tmp, -18) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 17) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(17))) pack_tmp = ISHFT(pack_tmp, -17) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 16) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(16))) pack_tmp = ISHFT(pack_tmp, -16) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 15) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(15))) pack_tmp = ISHFT(pack_tmp, -15) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 14) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(14))) pack_tmp = ISHFT(pack_tmp, -14) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 13) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(13))) pack_tmp = ISHFT(pack_tmp, -13) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 12) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(12))) pack_tmp = ISHFT(pack_tmp, -12) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 11) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(11))) pack_tmp = ISHFT(pack_tmp, -11) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 10) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(10))) pack_tmp = ISHFT(pack_tmp, -10) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 9) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(9))) pack_tmp = ISHFT(pack_tmp, -9) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 8) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(8))) pack_tmp = ISHFT(pack_tmp, -8) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 7) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(7))) pack_tmp = ISHFT(pack_tmp, -7) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 6) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(6))) pack_tmp = ISHFT(pack_tmp, -6) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 5) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(5))) pack_tmp = ISHFT(pack_tmp, -5) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 4) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(4))) pack_tmp = ISHFT(pack_tmp, -4) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 3) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(3))) pack_tmp = ISHFT(pack_tmp, -3) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 2) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(2))) pack_tmp = ISHFT(pack_tmp, -2) - idata = idata+1 + idata = idata + 1 data_tmp = ISHFT(pack_tmp, 1) - ipack = ipack+1 + ipack = ipack + 1 pack_tmp = packed_data(ipack) full_data(idata) = IOR(data_tmp, IAND(pack_tmp, mask_right(1))) pack_tmp = ISHFT(pack_tmp, -1) - idata = idata+1 + idata = idata + 1 data_tmp = IAND(pack_tmp, mask_right(Nbits)) full_data(idata) = data_tmp pack_tmp = ISHFT(pack_tmp, -Nbits) ENDDO IF (Ndata_rep < Ndata) THEN - CALL bits2ints_generic(Nbits, Ndata-Ndata_rep, packed_data(ipack+1), full_data(Ndata_rep+1)) + CALL bits2ints_generic(Nbits, Ndata - Ndata_rep, packed_data(ipack + 1), full_data(Ndata_rep + 1)) ENDIF END SUBROUTINE bits2ints_63 diff --git a/src/hfxbase/hfx_contract_block.F b/src/hfxbase/hfx_contract_block.F index ea3cd7dfe2..ad8658fbb3 100644 --- a/src/hfxbase/hfx_contract_block.F +++ b/src/hfxbase/hfx_contract_block.F @@ -4051,18 +4051,18 @@ SUBROUTINE block_default(ma_max, mb_max, mc_max, md_max, kbd, kbc, kad, kac, pbd DO mb = 1, mb_max ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*mb_max+mb) - p_bc = pbc((mc-1)*mb_max+mb) + p_bd = pbd((md - 1)*mb_max + mb) + p_bc = pbc((mc - 1)*mb_max + mb) DO ma = 1, ma_max - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*ma_max+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*ma_max+ma) - kad((md-1)*ma_max+ma) = kad((md-1)*ma_max+ma)-tmp*p_bc - kac((mc-1)*ma_max+ma) = kac((mc-1)*ma_max+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*ma_max + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*ma_max + ma) + kad((md - 1)*ma_max + ma) = kad((md - 1)*ma_max + ma) - tmp*p_bc + kac((mc - 1)*ma_max + ma) = kac((mc - 1)*ma_max + ma) - tmp*p_bd END DO - kbd((md-1)*mb_max+mb) = kbd((md-1)*mb_max+mb)-ks_bd - kbc((mc-1)*mb_max+mb) = kbc((mc-1)*mb_max+mb)-ks_bc + kbd((md - 1)*mb_max + mb) = kbd((md - 1)*mb_max + mb) - ks_bd + kbc((mc - 1)*mb_max + mb) = kbc((mc - 1)*mb_max + mb) - ks_bc END DO END DO END DO @@ -4098,18 +4098,18 @@ SUBROUTINE block_1_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -4145,18 +4145,18 @@ SUBROUTINE block_1_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -4192,18 +4192,18 @@ SUBROUTINE block_1_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -4239,18 +4239,18 @@ SUBROUTINE block_1_1_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -4286,18 +4286,18 @@ SUBROUTINE block_1_1_1_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -4333,18 +4333,18 @@ SUBROUTINE block_1_1_1_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -4380,18 +4380,18 @@ SUBROUTINE block_1_1_1_7(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -4427,18 +4427,18 @@ SUBROUTINE block_1_1_1_9(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -4475,18 +4475,18 @@ SUBROUTINE block_1_1_1_10(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -4523,18 +4523,18 @@ SUBROUTINE block_1_1_1_11(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -4571,18 +4571,18 @@ SUBROUTINE block_1_1_1_15(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -4618,18 +4618,18 @@ SUBROUTINE block_1_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -4665,18 +4665,18 @@ SUBROUTINE block_1_1_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -4712,18 +4712,18 @@ SUBROUTINE block_1_1_2_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -4759,18 +4759,18 @@ SUBROUTINE block_1_1_2_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -4806,18 +4806,18 @@ SUBROUTINE block_1_1_2_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -4853,18 +4853,18 @@ SUBROUTINE block_1_1_2_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -4900,18 +4900,18 @@ SUBROUTINE block_1_1_2_7(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -4947,18 +4947,18 @@ SUBROUTINE block_1_1_2_9(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -4995,18 +4995,18 @@ SUBROUTINE block_1_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -5042,18 +5042,18 @@ SUBROUTINE block_1_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -5089,18 +5089,18 @@ SUBROUTINE block_1_1_3_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -5136,18 +5136,18 @@ SUBROUTINE block_1_1_3_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -5183,18 +5183,18 @@ SUBROUTINE block_1_1_3_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -5230,18 +5230,18 @@ SUBROUTINE block_1_1_3_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -5277,18 +5277,18 @@ SUBROUTINE block_1_1_3_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -5325,18 +5325,18 @@ SUBROUTINE block_1_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -5372,18 +5372,18 @@ SUBROUTINE block_1_1_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -5419,18 +5419,18 @@ SUBROUTINE block_1_1_4_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -5466,18 +5466,18 @@ SUBROUTINE block_1_1_4_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -5513,18 +5513,18 @@ SUBROUTINE block_1_1_4_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -5561,18 +5561,18 @@ SUBROUTINE block_1_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -5608,18 +5608,18 @@ SUBROUTINE block_1_1_5_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -5655,18 +5655,18 @@ SUBROUTINE block_1_1_5_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -5702,18 +5702,18 @@ SUBROUTINE block_1_1_5_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -5750,18 +5750,18 @@ SUBROUTINE block_1_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -5797,18 +5797,18 @@ SUBROUTINE block_1_1_6_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -5844,18 +5844,18 @@ SUBROUTINE block_1_1_6_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -5891,18 +5891,18 @@ SUBROUTINE block_1_1_6_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -5939,18 +5939,18 @@ SUBROUTINE block_1_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -5986,18 +5986,18 @@ SUBROUTINE block_1_1_7_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -6033,18 +6033,18 @@ SUBROUTINE block_1_1_7_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -6081,18 +6081,18 @@ SUBROUTINE block_1_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -6128,18 +6128,18 @@ SUBROUTINE block_1_1_9_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -6175,18 +6175,18 @@ SUBROUTINE block_1_1_9_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -6223,18 +6223,18 @@ SUBROUTINE block_1_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -6271,18 +6271,18 @@ SUBROUTINE block_1_1_10_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -6319,18 +6319,18 @@ SUBROUTINE block_1_1_10(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sc DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -6367,18 +6367,18 @@ SUBROUTINE block_1_1_11_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -6415,18 +6415,18 @@ SUBROUTINE block_1_1_11(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sc DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -6463,18 +6463,18 @@ SUBROUTINE block_1_1_15_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -6511,18 +6511,18 @@ SUBROUTINE block_1_1_15(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sc DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -6558,18 +6558,18 @@ SUBROUTINE block_1_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -6605,18 +6605,18 @@ SUBROUTINE block_1_2_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -6652,18 +6652,18 @@ SUBROUTINE block_1_2_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -6699,18 +6699,18 @@ SUBROUTINE block_1_2_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -6746,18 +6746,18 @@ SUBROUTINE block_1_2_1_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -6793,18 +6793,18 @@ SUBROUTINE block_1_2_1_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -6840,18 +6840,18 @@ SUBROUTINE block_1_2_1_7(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -6887,18 +6887,18 @@ SUBROUTINE block_1_2_1_9(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -6935,18 +6935,18 @@ SUBROUTINE block_1_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -6982,18 +6982,18 @@ SUBROUTINE block_1_2_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -7029,18 +7029,18 @@ SUBROUTINE block_1_2_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -7076,18 +7076,18 @@ SUBROUTINE block_1_2_2_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -7123,18 +7123,18 @@ SUBROUTINE block_1_2_2_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -7171,18 +7171,18 @@ SUBROUTINE block_1_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -7218,18 +7218,18 @@ SUBROUTINE block_1_2_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -7265,18 +7265,18 @@ SUBROUTINE block_1_2_3_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -7312,18 +7312,18 @@ SUBROUTINE block_1_2_3_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -7360,18 +7360,18 @@ SUBROUTINE block_1_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -7407,18 +7407,18 @@ SUBROUTINE block_1_2_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -7454,18 +7454,18 @@ SUBROUTINE block_1_2_4_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -7502,18 +7502,18 @@ SUBROUTINE block_1_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -7549,18 +7549,18 @@ SUBROUTINE block_1_2_5_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -7597,18 +7597,18 @@ SUBROUTINE block_1_2_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -7644,18 +7644,18 @@ SUBROUTINE block_1_2_6_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -7692,18 +7692,18 @@ SUBROUTINE block_1_2_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -7739,18 +7739,18 @@ SUBROUTINE block_1_2_7_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -7787,18 +7787,18 @@ SUBROUTINE block_1_2_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -7834,18 +7834,18 @@ SUBROUTINE block_1_2_9_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -7882,18 +7882,18 @@ SUBROUTINE block_1_2_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -7931,18 +7931,18 @@ SUBROUTINE block_1_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -7978,18 +7978,18 @@ SUBROUTINE block_1_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -8025,18 +8025,18 @@ SUBROUTINE block_1_3_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -8072,18 +8072,18 @@ SUBROUTINE block_1_3_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -8119,18 +8119,18 @@ SUBROUTINE block_1_3_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -8166,18 +8166,18 @@ SUBROUTINE block_1_3_1_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -8213,18 +8213,18 @@ SUBROUTINE block_1_3_1_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -8261,18 +8261,18 @@ SUBROUTINE block_1_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -8308,18 +8308,18 @@ SUBROUTINE block_1_3_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -8355,18 +8355,18 @@ SUBROUTINE block_1_3_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -8402,18 +8402,18 @@ SUBROUTINE block_1_3_2_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -8450,18 +8450,18 @@ SUBROUTINE block_1_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -8497,18 +8497,18 @@ SUBROUTINE block_1_3_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -8544,18 +8544,18 @@ SUBROUTINE block_1_3_3_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -8592,18 +8592,18 @@ SUBROUTINE block_1_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -8639,18 +8639,18 @@ SUBROUTINE block_1_3_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -8687,18 +8687,18 @@ SUBROUTINE block_1_3_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -8734,18 +8734,18 @@ SUBROUTINE block_1_3_5_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -8782,18 +8782,18 @@ SUBROUTINE block_1_3_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -8829,18 +8829,18 @@ SUBROUTINE block_1_3_6_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -8877,18 +8877,18 @@ SUBROUTINE block_1_3_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -8926,18 +8926,18 @@ SUBROUTINE block_1_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -8973,18 +8973,18 @@ SUBROUTINE block_1_4_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -9020,18 +9020,18 @@ SUBROUTINE block_1_4_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -9067,18 +9067,18 @@ SUBROUTINE block_1_4_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -9114,18 +9114,18 @@ SUBROUTINE block_1_4_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -9162,18 +9162,18 @@ SUBROUTINE block_1_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -9209,18 +9209,18 @@ SUBROUTINE block_1_4_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -9256,18 +9256,18 @@ SUBROUTINE block_1_4_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -9304,18 +9304,18 @@ SUBROUTINE block_1_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -9351,18 +9351,18 @@ SUBROUTINE block_1_4_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -9399,18 +9399,18 @@ SUBROUTINE block_1_4_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -9446,18 +9446,18 @@ SUBROUTINE block_1_4_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -9494,18 +9494,18 @@ SUBROUTINE block_1_4_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -9543,18 +9543,18 @@ SUBROUTINE block_1_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -9590,18 +9590,18 @@ SUBROUTINE block_1_5_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 5 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*5+mb) - p_bc = pbc((mc-1)*5+mb) + p_bd = pbd((md - 1)*5 + mb) + p_bc = pbc((mc - 1)*5 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*5+mb) = kbd((md-1)*5+mb)-ks_bd - kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb)-ks_bc + kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd + kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc END DO END DO END DO @@ -9637,18 +9637,18 @@ SUBROUTINE block_1_5_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 5 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*5+mb) - p_bc = pbc((mc-1)*5+mb) + p_bd = pbd((md - 1)*5 + mb) + p_bc = pbc((mc - 1)*5 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*5+mb) = kbd((md-1)*5+mb)-ks_bd - kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb)-ks_bc + kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd + kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc END DO END DO END DO @@ -9684,18 +9684,18 @@ SUBROUTINE block_1_5_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 5 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*5+mb) - p_bc = pbc((mc-1)*5+mb) + p_bd = pbd((md - 1)*5 + mb) + p_bc = pbc((mc - 1)*5 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*5+mb) = kbd((md-1)*5+mb)-ks_bd - kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb)-ks_bc + kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd + kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc END DO END DO END DO @@ -9732,18 +9732,18 @@ SUBROUTINE block_1_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 5 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*5+mb) - p_bc = pbc((mc-1)*5+mb) + p_bd = pbd((md - 1)*5 + mb) + p_bc = pbc((mc - 1)*5 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*5+mb) = kbd((md-1)*5+mb)-ks_bd - kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb)-ks_bc + kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd + kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc END DO END DO END DO @@ -9779,18 +9779,18 @@ SUBROUTINE block_1_5_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 5 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*5+mb) - p_bc = pbc((mc-1)*5+mb) + p_bd = pbd((md - 1)*5 + mb) + p_bc = pbc((mc - 1)*5 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*5+mb) = kbd((md-1)*5+mb)-ks_bd - kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb)-ks_bc + kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd + kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc END DO END DO END DO @@ -9827,18 +9827,18 @@ SUBROUTINE block_1_5_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 5 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*5+mb) - p_bc = pbc((mc-1)*5+mb) + p_bd = pbd((md - 1)*5 + mb) + p_bc = pbc((mc - 1)*5 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*5+mb) = kbd((md-1)*5+mb)-ks_bd - kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb)-ks_bc + kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd + kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc END DO END DO END DO @@ -9874,18 +9874,18 @@ SUBROUTINE block_1_5_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 5 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*5+mb) - p_bc = pbc((mc-1)*5+mb) + p_bd = pbd((md - 1)*5 + mb) + p_bc = pbc((mc - 1)*5 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*5+mb) = kbd((md-1)*5+mb)-ks_bd - kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb)-ks_bc + kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd + kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc END DO END DO END DO @@ -9922,18 +9922,18 @@ SUBROUTINE block_1_5_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 5 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*5+mb) - p_bc = pbc((mc-1)*5+mb) + p_bd = pbd((md - 1)*5 + mb) + p_bc = pbc((mc - 1)*5 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*5+mb) = kbd((md-1)*5+mb)-ks_bd - kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb)-ks_bc + kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd + kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc END DO END DO END DO @@ -9971,18 +9971,18 @@ SUBROUTINE block_1_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 5 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*5+mb) - p_bc = pbc((mc-1)*5+mb) + p_bd = pbd((md - 1)*5 + mb) + p_bc = pbc((mc - 1)*5 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*5+mb) = kbd((md-1)*5+mb)-ks_bd - kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb)-ks_bc + kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd + kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc END DO END DO END DO @@ -10018,18 +10018,18 @@ SUBROUTINE block_1_6_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 6 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*6+mb) - p_bc = pbc((mc-1)*6+mb) + p_bd = pbd((md - 1)*6 + mb) + p_bc = pbc((mc - 1)*6 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*6+mb) = kbd((md-1)*6+mb)-ks_bd - kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb)-ks_bc + kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd + kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc END DO END DO END DO @@ -10065,18 +10065,18 @@ SUBROUTINE block_1_6_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 6 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*6+mb) - p_bc = pbc((mc-1)*6+mb) + p_bd = pbd((md - 1)*6 + mb) + p_bc = pbc((mc - 1)*6 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*6+mb) = kbd((md-1)*6+mb)-ks_bd - kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb)-ks_bc + kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd + kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc END DO END DO END DO @@ -10112,18 +10112,18 @@ SUBROUTINE block_1_6_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 6 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*6+mb) - p_bc = pbc((mc-1)*6+mb) + p_bd = pbd((md - 1)*6 + mb) + p_bc = pbc((mc - 1)*6 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*6+mb) = kbd((md-1)*6+mb)-ks_bd - kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb)-ks_bc + kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd + kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc END DO END DO END DO @@ -10160,18 +10160,18 @@ SUBROUTINE block_1_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 6 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*6+mb) - p_bc = pbc((mc-1)*6+mb) + p_bd = pbd((md - 1)*6 + mb) + p_bc = pbc((mc - 1)*6 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*6+mb) = kbd((md-1)*6+mb)-ks_bd - kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb)-ks_bc + kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd + kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc END DO END DO END DO @@ -10207,18 +10207,18 @@ SUBROUTINE block_1_6_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 6 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*6+mb) - p_bc = pbc((mc-1)*6+mb) + p_bd = pbd((md - 1)*6 + mb) + p_bc = pbc((mc - 1)*6 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*6+mb) = kbd((md-1)*6+mb)-ks_bd - kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb)-ks_bc + kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd + kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc END DO END DO END DO @@ -10255,18 +10255,18 @@ SUBROUTINE block_1_6_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 6 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*6+mb) - p_bc = pbc((mc-1)*6+mb) + p_bd = pbd((md - 1)*6 + mb) + p_bc = pbc((mc - 1)*6 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*6+mb) = kbd((md-1)*6+mb)-ks_bd - kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb)-ks_bc + kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd + kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc END DO END DO END DO @@ -10302,18 +10302,18 @@ SUBROUTINE block_1_6_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 6 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*6+mb) - p_bc = pbc((mc-1)*6+mb) + p_bd = pbd((md - 1)*6 + mb) + p_bc = pbc((mc - 1)*6 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*6+mb) = kbd((md-1)*6+mb)-ks_bd - kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb)-ks_bc + kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd + kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc END DO END DO END DO @@ -10350,18 +10350,18 @@ SUBROUTINE block_1_6_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 6 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*6+mb) - p_bc = pbc((mc-1)*6+mb) + p_bd = pbd((md - 1)*6 + mb) + p_bc = pbc((mc - 1)*6 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*6+mb) = kbd((md-1)*6+mb)-ks_bd - kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb)-ks_bc + kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd + kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc END DO END DO END DO @@ -10399,18 +10399,18 @@ SUBROUTINE block_1_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 6 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*6+mb) - p_bc = pbc((mc-1)*6+mb) + p_bd = pbd((md - 1)*6 + mb) + p_bc = pbc((mc - 1)*6 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*6+mb) = kbd((md-1)*6+mb)-ks_bd - kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb)-ks_bc + kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd + kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc END DO END DO END DO @@ -10446,18 +10446,18 @@ SUBROUTINE block_1_7_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 7 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*7+mb) - p_bc = pbc((mc-1)*7+mb) + p_bd = pbd((md - 1)*7 + mb) + p_bc = pbc((mc - 1)*7 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*7+mb) = kbd((md-1)*7+mb)-ks_bd - kbc((mc-1)*7+mb) = kbc((mc-1)*7+mb)-ks_bc + kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd + kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc END DO END DO END DO @@ -10493,18 +10493,18 @@ SUBROUTINE block_1_7_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 7 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*7+mb) - p_bc = pbc((mc-1)*7+mb) + p_bd = pbd((md - 1)*7 + mb) + p_bc = pbc((mc - 1)*7 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*7+mb) = kbd((md-1)*7+mb)-ks_bd - kbc((mc-1)*7+mb) = kbc((mc-1)*7+mb)-ks_bc + kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd + kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc END DO END DO END DO @@ -10541,18 +10541,18 @@ SUBROUTINE block_1_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 7 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*7+mb) - p_bc = pbc((mc-1)*7+mb) + p_bd = pbd((md - 1)*7 + mb) + p_bc = pbc((mc - 1)*7 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*7+mb) = kbd((md-1)*7+mb)-ks_bd - kbc((mc-1)*7+mb) = kbc((mc-1)*7+mb)-ks_bc + kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd + kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc END DO END DO END DO @@ -10588,18 +10588,18 @@ SUBROUTINE block_1_7_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 7 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*7+mb) - p_bc = pbc((mc-1)*7+mb) + p_bd = pbd((md - 1)*7 + mb) + p_bc = pbc((mc - 1)*7 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*7+mb) = kbd((md-1)*7+mb)-ks_bd - kbc((mc-1)*7+mb) = kbc((mc-1)*7+mb)-ks_bc + kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd + kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc END DO END DO END DO @@ -10636,18 +10636,18 @@ SUBROUTINE block_1_7_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 7 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*7+mb) - p_bc = pbc((mc-1)*7+mb) + p_bd = pbd((md - 1)*7 + mb) + p_bc = pbc((mc - 1)*7 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*7+mb) = kbd((md-1)*7+mb)-ks_bd - kbc((mc-1)*7+mb) = kbc((mc-1)*7+mb)-ks_bc + kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd + kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc END DO END DO END DO @@ -10685,18 +10685,18 @@ SUBROUTINE block_1_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 7 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*7+mb) - p_bc = pbc((mc-1)*7+mb) + p_bd = pbd((md - 1)*7 + mb) + p_bc = pbc((mc - 1)*7 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*7+mb) = kbd((md-1)*7+mb)-ks_bd - kbc((mc-1)*7+mb) = kbc((mc-1)*7+mb)-ks_bc + kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd + kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc END DO END DO END DO @@ -10732,18 +10732,18 @@ SUBROUTINE block_1_9_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 9 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*9+mb) - p_bc = pbc((mc-1)*9+mb) + p_bd = pbd((md - 1)*9 + mb) + p_bc = pbc((mc - 1)*9 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*9+mb) = kbd((md-1)*9+mb)-ks_bd - kbc((mc-1)*9+mb) = kbc((mc-1)*9+mb)-ks_bc + kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd + kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc END DO END DO END DO @@ -10779,18 +10779,18 @@ SUBROUTINE block_1_9_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 9 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*9+mb) - p_bc = pbc((mc-1)*9+mb) + p_bd = pbd((md - 1)*9 + mb) + p_bc = pbc((mc - 1)*9 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*9+mb) = kbd((md-1)*9+mb)-ks_bd - kbc((mc-1)*9+mb) = kbc((mc-1)*9+mb)-ks_bc + kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd + kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc END DO END DO END DO @@ -10827,18 +10827,18 @@ SUBROUTINE block_1_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 9 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*9+mb) - p_bc = pbc((mc-1)*9+mb) + p_bd = pbd((md - 1)*9 + mb) + p_bc = pbc((mc - 1)*9 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*9+mb) = kbd((md-1)*9+mb)-ks_bd - kbc((mc-1)*9+mb) = kbc((mc-1)*9+mb)-ks_bc + kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd + kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc END DO END DO END DO @@ -10874,18 +10874,18 @@ SUBROUTINE block_1_9_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 9 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*9+mb) - p_bc = pbc((mc-1)*9+mb) + p_bd = pbd((md - 1)*9 + mb) + p_bc = pbc((mc - 1)*9 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*9+mb) = kbd((md-1)*9+mb)-ks_bd - kbc((mc-1)*9+mb) = kbc((mc-1)*9+mb)-ks_bc + kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd + kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc END DO END DO END DO @@ -10922,18 +10922,18 @@ SUBROUTINE block_1_9_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 9 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*9+mb) - p_bc = pbc((mc-1)*9+mb) + p_bd = pbd((md - 1)*9 + mb) + p_bc = pbc((mc - 1)*9 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*9+mb) = kbd((md-1)*9+mb)-ks_bd - kbc((mc-1)*9+mb) = kbc((mc-1)*9+mb)-ks_bc + kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd + kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc END DO END DO END DO @@ -10971,18 +10971,18 @@ SUBROUTINE block_1_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 9 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*9+mb) - p_bc = pbc((mc-1)*9+mb) + p_bd = pbd((md - 1)*9 + mb) + p_bc = pbc((mc - 1)*9 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*9+mb) = kbd((md-1)*9+mb)-ks_bd - kbc((mc-1)*9+mb) = kbc((mc-1)*9+mb)-ks_bc + kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd + kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc END DO END DO END DO @@ -11019,18 +11019,18 @@ SUBROUTINE block_1_10_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 10 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*10+mb) - p_bc = pbc((mc-1)*10+mb) + p_bd = pbd((md - 1)*10 + mb) + p_bc = pbc((mc - 1)*10 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*10+mb) = kbd((md-1)*10+mb)-ks_bd - kbc((mc-1)*10+mb) = kbc((mc-1)*10+mb)-ks_bc + kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd + kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc END DO END DO END DO @@ -11067,18 +11067,18 @@ SUBROUTINE block_1_10_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sc DO mb = 1, 10 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*10+mb) - p_bc = pbc((mc-1)*10+mb) + p_bd = pbd((md - 1)*10 + mb) + p_bc = pbc((mc - 1)*10 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*10+mb) = kbd((md-1)*10+mb)-ks_bd - kbc((mc-1)*10+mb) = kbc((mc-1)*10+mb)-ks_bc + kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd + kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc END DO END DO END DO @@ -11117,18 +11117,18 @@ SUBROUTINE block_1_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 10 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*10+mb) - p_bc = pbc((mc-1)*10+mb) + p_bd = pbd((md - 1)*10 + mb) + p_bc = pbc((mc - 1)*10 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*10+mb) = kbd((md-1)*10+mb)-ks_bd - kbc((mc-1)*10+mb) = kbc((mc-1)*10+mb)-ks_bc + kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd + kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc END DO END DO END DO @@ -11165,18 +11165,18 @@ SUBROUTINE block_1_11_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 11 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*11+mb) - p_bc = pbc((mc-1)*11+mb) + p_bd = pbd((md - 1)*11 + mb) + p_bc = pbc((mc - 1)*11 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*11+mb) = kbd((md-1)*11+mb)-ks_bd - kbc((mc-1)*11+mb) = kbc((mc-1)*11+mb)-ks_bc + kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd + kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc END DO END DO END DO @@ -11213,18 +11213,18 @@ SUBROUTINE block_1_11_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sc DO mb = 1, 11 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*11+mb) - p_bc = pbc((mc-1)*11+mb) + p_bd = pbd((md - 1)*11 + mb) + p_bc = pbc((mc - 1)*11 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*11+mb) = kbd((md-1)*11+mb)-ks_bd - kbc((mc-1)*11+mb) = kbc((mc-1)*11+mb)-ks_bc + kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd + kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc END DO END DO END DO @@ -11263,18 +11263,18 @@ SUBROUTINE block_1_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 11 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*11+mb) - p_bc = pbc((mc-1)*11+mb) + p_bd = pbd((md - 1)*11 + mb) + p_bc = pbc((mc - 1)*11 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*11+mb) = kbd((md-1)*11+mb)-ks_bd - kbc((mc-1)*11+mb) = kbc((mc-1)*11+mb)-ks_bc + kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd + kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc END DO END DO END DO @@ -11311,18 +11311,18 @@ SUBROUTINE block_1_15_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 15 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*15+mb) - p_bc = pbc((mc-1)*15+mb) + p_bd = pbd((md - 1)*15 + mb) + p_bc = pbc((mc - 1)*15 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*15+mb) = kbd((md-1)*15+mb)-ks_bd - kbc((mc-1)*15+mb) = kbc((mc-1)*15+mb)-ks_bc + kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd + kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc END DO END DO END DO @@ -11359,18 +11359,18 @@ SUBROUTINE block_1_15_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sc DO mb = 1, 15 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*15+mb) - p_bc = pbc((mc-1)*15+mb) + p_bd = pbd((md - 1)*15 + mb) + p_bc = pbc((mc - 1)*15 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*15+mb) = kbd((md-1)*15+mb)-ks_bd - kbc((mc-1)*15+mb) = kbc((mc-1)*15+mb)-ks_bc + kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd + kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc END DO END DO END DO @@ -11409,18 +11409,18 @@ SUBROUTINE block_1_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 15 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*15+mb) - p_bc = pbc((mc-1)*15+mb) + p_bd = pbd((md - 1)*15 + mb) + p_bc = pbc((mc - 1)*15 + mb) DO ma = 1, 1 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*1+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*1+ma) - kad((md-1)*1+ma) = kad((md-1)*1+ma)-tmp*p_bc - kac((mc-1)*1+ma) = kac((mc-1)*1+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*1 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*1 + ma) + kad((md - 1)*1 + ma) = kad((md - 1)*1 + ma) - tmp*p_bc + kac((mc - 1)*1 + ma) = kac((mc - 1)*1 + ma) - tmp*p_bd END DO - kbd((md-1)*15+mb) = kbd((md-1)*15+mb)-ks_bd - kbc((mc-1)*15+mb) = kbc((mc-1)*15+mb)-ks_bc + kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd + kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc END DO END DO END DO @@ -11456,18 +11456,18 @@ SUBROUTINE block_2_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -11503,18 +11503,18 @@ SUBROUTINE block_2_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -11550,18 +11550,18 @@ SUBROUTINE block_2_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -11597,18 +11597,18 @@ SUBROUTINE block_2_1_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -11644,18 +11644,18 @@ SUBROUTINE block_2_1_1_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -11691,18 +11691,18 @@ SUBROUTINE block_2_1_1_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -11738,18 +11738,18 @@ SUBROUTINE block_2_1_1_7(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -11785,18 +11785,18 @@ SUBROUTINE block_2_1_1_9(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -11833,18 +11833,18 @@ SUBROUTINE block_2_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -11880,18 +11880,18 @@ SUBROUTINE block_2_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -11927,18 +11927,18 @@ SUBROUTINE block_2_1_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -11974,18 +11974,18 @@ SUBROUTINE block_2_1_2_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -12021,18 +12021,18 @@ SUBROUTINE block_2_1_2_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -12069,18 +12069,18 @@ SUBROUTINE block_2_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -12116,18 +12116,18 @@ SUBROUTINE block_2_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -12163,18 +12163,18 @@ SUBROUTINE block_2_1_3_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -12210,18 +12210,18 @@ SUBROUTINE block_2_1_3_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -12258,18 +12258,18 @@ SUBROUTINE block_2_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -12305,18 +12305,18 @@ SUBROUTINE block_2_1_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -12352,18 +12352,18 @@ SUBROUTINE block_2_1_4_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -12400,18 +12400,18 @@ SUBROUTINE block_2_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -12447,18 +12447,18 @@ SUBROUTINE block_2_1_5_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -12495,18 +12495,18 @@ SUBROUTINE block_2_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -12542,18 +12542,18 @@ SUBROUTINE block_2_1_6_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -12590,18 +12590,18 @@ SUBROUTINE block_2_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -12637,18 +12637,18 @@ SUBROUTINE block_2_1_7_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -12685,18 +12685,18 @@ SUBROUTINE block_2_1_7(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -12732,18 +12732,18 @@ SUBROUTINE block_2_1_9_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -12780,18 +12780,18 @@ SUBROUTINE block_2_1_9(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -12829,18 +12829,18 @@ SUBROUTINE block_2_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -12876,18 +12876,18 @@ SUBROUTINE block_2_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -12923,18 +12923,18 @@ SUBROUTINE block_2_2_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -12970,18 +12970,18 @@ SUBROUTINE block_2_2_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -13017,18 +13017,18 @@ SUBROUTINE block_2_2_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -13065,18 +13065,18 @@ SUBROUTINE block_2_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -13112,18 +13112,18 @@ SUBROUTINE block_2_2_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -13159,18 +13159,18 @@ SUBROUTINE block_2_2_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -13207,18 +13207,18 @@ SUBROUTINE block_2_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -13254,18 +13254,18 @@ SUBROUTINE block_2_2_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -13302,18 +13302,18 @@ SUBROUTINE block_2_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -13349,18 +13349,18 @@ SUBROUTINE block_2_2_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -13397,18 +13397,18 @@ SUBROUTINE block_2_2_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -13446,18 +13446,18 @@ SUBROUTINE block_2_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -13493,18 +13493,18 @@ SUBROUTINE block_2_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -13540,18 +13540,18 @@ SUBROUTINE block_2_3_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -13587,18 +13587,18 @@ SUBROUTINE block_2_3_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -13635,18 +13635,18 @@ SUBROUTINE block_2_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -13682,18 +13682,18 @@ SUBROUTINE block_2_3_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -13730,18 +13730,18 @@ SUBROUTINE block_2_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -13777,18 +13777,18 @@ SUBROUTINE block_2_3_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -13825,18 +13825,18 @@ SUBROUTINE block_2_3_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -13874,18 +13874,18 @@ SUBROUTINE block_2_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -13921,18 +13921,18 @@ SUBROUTINE block_2_4_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -13968,18 +13968,18 @@ SUBROUTINE block_2_4_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -14016,18 +14016,18 @@ SUBROUTINE block_2_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -14063,18 +14063,18 @@ SUBROUTINE block_2_4_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -14111,18 +14111,18 @@ SUBROUTINE block_2_4_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -14160,18 +14160,18 @@ SUBROUTINE block_2_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -14207,18 +14207,18 @@ SUBROUTINE block_2_5_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 5 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*5+mb) - p_bc = pbc((mc-1)*5+mb) + p_bd = pbd((md - 1)*5 + mb) + p_bc = pbc((mc - 1)*5 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*5+mb) = kbd((md-1)*5+mb)-ks_bd - kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb)-ks_bc + kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd + kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc END DO END DO END DO @@ -14255,18 +14255,18 @@ SUBROUTINE block_2_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 5 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*5+mb) - p_bc = pbc((mc-1)*5+mb) + p_bd = pbd((md - 1)*5 + mb) + p_bc = pbc((mc - 1)*5 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*5+mb) = kbd((md-1)*5+mb)-ks_bd - kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb)-ks_bc + kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd + kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc END DO END DO END DO @@ -14304,18 +14304,18 @@ SUBROUTINE block_2_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 5 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*5+mb) - p_bc = pbc((mc-1)*5+mb) + p_bd = pbd((md - 1)*5 + mb) + p_bc = pbc((mc - 1)*5 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*5+mb) = kbd((md-1)*5+mb)-ks_bd - kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb)-ks_bc + kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd + kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc END DO END DO END DO @@ -14351,18 +14351,18 @@ SUBROUTINE block_2_6_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 6 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*6+mb) - p_bc = pbc((mc-1)*6+mb) + p_bd = pbd((md - 1)*6 + mb) + p_bc = pbc((mc - 1)*6 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*6+mb) = kbd((md-1)*6+mb)-ks_bd - kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb)-ks_bc + kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd + kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc END DO END DO END DO @@ -14399,18 +14399,18 @@ SUBROUTINE block_2_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 6 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*6+mb) - p_bc = pbc((mc-1)*6+mb) + p_bd = pbd((md - 1)*6 + mb) + p_bc = pbc((mc - 1)*6 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*6+mb) = kbd((md-1)*6+mb)-ks_bd - kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb)-ks_bc + kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd + kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc END DO END DO END DO @@ -14448,18 +14448,18 @@ SUBROUTINE block_2_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 6 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*6+mb) - p_bc = pbc((mc-1)*6+mb) + p_bd = pbd((md - 1)*6 + mb) + p_bc = pbc((mc - 1)*6 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*6+mb) = kbd((md-1)*6+mb)-ks_bd - kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb)-ks_bc + kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd + kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc END DO END DO END DO @@ -14495,18 +14495,18 @@ SUBROUTINE block_2_7_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 7 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*7+mb) - p_bc = pbc((mc-1)*7+mb) + p_bd = pbd((md - 1)*7 + mb) + p_bc = pbc((mc - 1)*7 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*7+mb) = kbd((md-1)*7+mb)-ks_bd - kbc((mc-1)*7+mb) = kbc((mc-1)*7+mb)-ks_bc + kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd + kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc END DO END DO END DO @@ -14543,18 +14543,18 @@ SUBROUTINE block_2_7_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 7 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*7+mb) - p_bc = pbc((mc-1)*7+mb) + p_bd = pbd((md - 1)*7 + mb) + p_bc = pbc((mc - 1)*7 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*7+mb) = kbd((md-1)*7+mb)-ks_bd - kbc((mc-1)*7+mb) = kbc((mc-1)*7+mb)-ks_bc + kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd + kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc END DO END DO END DO @@ -14592,18 +14592,18 @@ SUBROUTINE block_2_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 7 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*7+mb) - p_bc = pbc((mc-1)*7+mb) + p_bd = pbd((md - 1)*7 + mb) + p_bc = pbc((mc - 1)*7 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*7+mb) = kbd((md-1)*7+mb)-ks_bd - kbc((mc-1)*7+mb) = kbc((mc-1)*7+mb)-ks_bc + kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd + kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc END DO END DO END DO @@ -14639,18 +14639,18 @@ SUBROUTINE block_2_9_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 9 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*9+mb) - p_bc = pbc((mc-1)*9+mb) + p_bd = pbd((md - 1)*9 + mb) + p_bc = pbc((mc - 1)*9 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*9+mb) = kbd((md-1)*9+mb)-ks_bd - kbc((mc-1)*9+mb) = kbc((mc-1)*9+mb)-ks_bc + kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd + kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc END DO END DO END DO @@ -14687,18 +14687,18 @@ SUBROUTINE block_2_9_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 9 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*9+mb) - p_bc = pbc((mc-1)*9+mb) + p_bd = pbd((md - 1)*9 + mb) + p_bc = pbc((mc - 1)*9 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*9+mb) = kbd((md-1)*9+mb)-ks_bd - kbc((mc-1)*9+mb) = kbc((mc-1)*9+mb)-ks_bc + kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd + kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc END DO END DO END DO @@ -14736,18 +14736,18 @@ SUBROUTINE block_2_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 9 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*9+mb) - p_bc = pbc((mc-1)*9+mb) + p_bd = pbd((md - 1)*9 + mb) + p_bc = pbc((mc - 1)*9 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*9+mb) = kbd((md-1)*9+mb)-ks_bd - kbc((mc-1)*9+mb) = kbc((mc-1)*9+mb)-ks_bc + kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd + kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc END DO END DO END DO @@ -14786,18 +14786,18 @@ SUBROUTINE block_2_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 10 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*10+mb) - p_bc = pbc((mc-1)*10+mb) + p_bd = pbd((md - 1)*10 + mb) + p_bc = pbc((mc - 1)*10 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*10+mb) = kbd((md-1)*10+mb)-ks_bd - kbc((mc-1)*10+mb) = kbc((mc-1)*10+mb)-ks_bc + kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd + kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc END DO END DO END DO @@ -14836,18 +14836,18 @@ SUBROUTINE block_2_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 11 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*11+mb) - p_bc = pbc((mc-1)*11+mb) + p_bd = pbd((md - 1)*11 + mb) + p_bc = pbc((mc - 1)*11 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*11+mb) = kbd((md-1)*11+mb)-ks_bd - kbc((mc-1)*11+mb) = kbc((mc-1)*11+mb)-ks_bc + kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd + kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc END DO END DO END DO @@ -14886,18 +14886,18 @@ SUBROUTINE block_2_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 15 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*15+mb) - p_bc = pbc((mc-1)*15+mb) + p_bd = pbd((md - 1)*15 + mb) + p_bc = pbc((mc - 1)*15 + mb) DO ma = 1, 2 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*2+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*2+ma) - kad((md-1)*2+ma) = kad((md-1)*2+ma)-tmp*p_bc - kac((mc-1)*2+ma) = kac((mc-1)*2+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*2 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*2 + ma) + kad((md - 1)*2 + ma) = kad((md - 1)*2 + ma) - tmp*p_bc + kac((mc - 1)*2 + ma) = kac((mc - 1)*2 + ma) - tmp*p_bd END DO - kbd((md-1)*15+mb) = kbd((md-1)*15+mb)-ks_bd - kbc((mc-1)*15+mb) = kbc((mc-1)*15+mb)-ks_bc + kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd + kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc END DO END DO END DO @@ -14933,18 +14933,18 @@ SUBROUTINE block_3_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -14980,18 +14980,18 @@ SUBROUTINE block_3_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -15027,18 +15027,18 @@ SUBROUTINE block_3_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -15074,18 +15074,18 @@ SUBROUTINE block_3_1_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -15121,18 +15121,18 @@ SUBROUTINE block_3_1_1_5(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -15168,18 +15168,18 @@ SUBROUTINE block_3_1_1_6(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -15216,18 +15216,18 @@ SUBROUTINE block_3_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -15263,18 +15263,18 @@ SUBROUTINE block_3_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -15310,18 +15310,18 @@ SUBROUTINE block_3_1_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -15357,18 +15357,18 @@ SUBROUTINE block_3_1_2_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -15405,18 +15405,18 @@ SUBROUTINE block_3_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -15452,18 +15452,18 @@ SUBROUTINE block_3_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -15499,18 +15499,18 @@ SUBROUTINE block_3_1_3_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -15547,18 +15547,18 @@ SUBROUTINE block_3_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -15594,18 +15594,18 @@ SUBROUTINE block_3_1_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -15642,18 +15642,18 @@ SUBROUTINE block_3_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -15689,18 +15689,18 @@ SUBROUTINE block_3_1_5_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -15737,18 +15737,18 @@ SUBROUTINE block_3_1_5(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -15784,18 +15784,18 @@ SUBROUTINE block_3_1_6_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -15832,18 +15832,18 @@ SUBROUTINE block_3_1_6(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -15881,18 +15881,18 @@ SUBROUTINE block_3_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -15928,18 +15928,18 @@ SUBROUTINE block_3_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -15975,18 +15975,18 @@ SUBROUTINE block_3_2_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -16022,18 +16022,18 @@ SUBROUTINE block_3_2_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -16070,18 +16070,18 @@ SUBROUTINE block_3_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -16117,18 +16117,18 @@ SUBROUTINE block_3_2_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -16165,18 +16165,18 @@ SUBROUTINE block_3_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -16212,18 +16212,18 @@ SUBROUTINE block_3_2_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -16260,18 +16260,18 @@ SUBROUTINE block_3_2_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -16309,18 +16309,18 @@ SUBROUTINE block_3_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -16356,18 +16356,18 @@ SUBROUTINE block_3_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -16403,18 +16403,18 @@ SUBROUTINE block_3_3_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -16451,18 +16451,18 @@ SUBROUTINE block_3_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -16498,18 +16498,18 @@ SUBROUTINE block_3_3_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -16546,18 +16546,18 @@ SUBROUTINE block_3_3_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -16595,18 +16595,18 @@ SUBROUTINE block_3_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -16642,18 +16642,18 @@ SUBROUTINE block_3_4_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -16690,18 +16690,18 @@ SUBROUTINE block_3_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -16739,18 +16739,18 @@ SUBROUTINE block_3_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -16786,18 +16786,18 @@ SUBROUTINE block_3_5_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 5 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*5+mb) - p_bc = pbc((mc-1)*5+mb) + p_bd = pbd((md - 1)*5 + mb) + p_bc = pbc((mc - 1)*5 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*5+mb) = kbd((md-1)*5+mb)-ks_bd - kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb)-ks_bc + kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd + kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc END DO END DO END DO @@ -16834,18 +16834,18 @@ SUBROUTINE block_3_5_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 5 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*5+mb) - p_bc = pbc((mc-1)*5+mb) + p_bd = pbd((md - 1)*5 + mb) + p_bc = pbc((mc - 1)*5 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*5+mb) = kbd((md-1)*5+mb)-ks_bd - kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb)-ks_bc + kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd + kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc END DO END DO END DO @@ -16883,18 +16883,18 @@ SUBROUTINE block_3_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 5 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*5+mb) - p_bc = pbc((mc-1)*5+mb) + p_bd = pbd((md - 1)*5 + mb) + p_bc = pbc((mc - 1)*5 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*5+mb) = kbd((md-1)*5+mb)-ks_bd - kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb)-ks_bc + kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd + kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc END DO END DO END DO @@ -16930,18 +16930,18 @@ SUBROUTINE block_3_6_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 6 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*6+mb) - p_bc = pbc((mc-1)*6+mb) + p_bd = pbd((md - 1)*6 + mb) + p_bc = pbc((mc - 1)*6 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*6+mb) = kbd((md-1)*6+mb)-ks_bd - kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb)-ks_bc + kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd + kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc END DO END DO END DO @@ -16978,18 +16978,18 @@ SUBROUTINE block_3_6_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 6 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*6+mb) - p_bc = pbc((mc-1)*6+mb) + p_bd = pbd((md - 1)*6 + mb) + p_bc = pbc((mc - 1)*6 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*6+mb) = kbd((md-1)*6+mb)-ks_bd - kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb)-ks_bc + kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd + kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc END DO END DO END DO @@ -17027,18 +17027,18 @@ SUBROUTINE block_3_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 6 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*6+mb) - p_bc = pbc((mc-1)*6+mb) + p_bd = pbd((md - 1)*6 + mb) + p_bc = pbc((mc - 1)*6 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*6+mb) = kbd((md-1)*6+mb)-ks_bd - kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb)-ks_bc + kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd + kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc END DO END DO END DO @@ -17076,18 +17076,18 @@ SUBROUTINE block_3_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 7 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*7+mb) - p_bc = pbc((mc-1)*7+mb) + p_bd = pbd((md - 1)*7 + mb) + p_bc = pbc((mc - 1)*7 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*7+mb) = kbd((md-1)*7+mb)-ks_bd - kbc((mc-1)*7+mb) = kbc((mc-1)*7+mb)-ks_bc + kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd + kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc END DO END DO END DO @@ -17125,18 +17125,18 @@ SUBROUTINE block_3_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 9 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*9+mb) - p_bc = pbc((mc-1)*9+mb) + p_bd = pbd((md - 1)*9 + mb) + p_bc = pbc((mc - 1)*9 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*9+mb) = kbd((md-1)*9+mb)-ks_bd - kbc((mc-1)*9+mb) = kbc((mc-1)*9+mb)-ks_bc + kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd + kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc END DO END DO END DO @@ -17175,18 +17175,18 @@ SUBROUTINE block_3_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 10 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*10+mb) - p_bc = pbc((mc-1)*10+mb) + p_bd = pbd((md - 1)*10 + mb) + p_bc = pbc((mc - 1)*10 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*10+mb) = kbd((md-1)*10+mb)-ks_bd - kbc((mc-1)*10+mb) = kbc((mc-1)*10+mb)-ks_bc + kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd + kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc END DO END DO END DO @@ -17225,18 +17225,18 @@ SUBROUTINE block_3_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 11 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*11+mb) - p_bc = pbc((mc-1)*11+mb) + p_bd = pbd((md - 1)*11 + mb) + p_bc = pbc((mc - 1)*11 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*11+mb) = kbd((md-1)*11+mb)-ks_bd - kbc((mc-1)*11+mb) = kbc((mc-1)*11+mb)-ks_bc + kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd + kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc END DO END DO END DO @@ -17275,18 +17275,18 @@ SUBROUTINE block_3_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 15 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*15+mb) - p_bc = pbc((mc-1)*15+mb) + p_bd = pbd((md - 1)*15 + mb) + p_bc = pbc((mc - 1)*15 + mb) DO ma = 1, 3 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*3+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*3+ma) - kad((md-1)*3+ma) = kad((md-1)*3+ma)-tmp*p_bc - kac((mc-1)*3+ma) = kac((mc-1)*3+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*3 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*3 + ma) + kad((md - 1)*3 + ma) = kad((md - 1)*3 + ma) - tmp*p_bc + kac((mc - 1)*3 + ma) = kac((mc - 1)*3 + ma) - tmp*p_bd END DO - kbd((md-1)*15+mb) = kbd((md-1)*15+mb)-ks_bd - kbc((mc-1)*15+mb) = kbc((mc-1)*15+mb)-ks_bc + kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd + kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc END DO END DO END DO @@ -17322,18 +17322,18 @@ SUBROUTINE block_4_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -17369,18 +17369,18 @@ SUBROUTINE block_4_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -17416,18 +17416,18 @@ SUBROUTINE block_4_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -17463,18 +17463,18 @@ SUBROUTINE block_4_1_1_4(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -17511,18 +17511,18 @@ SUBROUTINE block_4_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -17558,18 +17558,18 @@ SUBROUTINE block_4_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -17605,18 +17605,18 @@ SUBROUTINE block_4_1_2_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -17653,18 +17653,18 @@ SUBROUTINE block_4_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -17700,18 +17700,18 @@ SUBROUTINE block_4_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -17748,18 +17748,18 @@ SUBROUTINE block_4_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -17795,18 +17795,18 @@ SUBROUTINE block_4_1_4_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -17843,18 +17843,18 @@ SUBROUTINE block_4_1_4(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -17892,18 +17892,18 @@ SUBROUTINE block_4_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -17939,18 +17939,18 @@ SUBROUTINE block_4_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -17986,18 +17986,18 @@ SUBROUTINE block_4_2_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -18034,18 +18034,18 @@ SUBROUTINE block_4_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -18081,18 +18081,18 @@ SUBROUTINE block_4_2_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -18129,18 +18129,18 @@ SUBROUTINE block_4_2_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -18178,18 +18178,18 @@ SUBROUTINE block_4_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -18225,18 +18225,18 @@ SUBROUTINE block_4_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -18273,18 +18273,18 @@ SUBROUTINE block_4_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -18322,18 +18322,18 @@ SUBROUTINE block_4_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -18369,18 +18369,18 @@ SUBROUTINE block_4_4_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -18417,18 +18417,18 @@ SUBROUTINE block_4_4_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -18466,18 +18466,18 @@ SUBROUTINE block_4_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -18515,18 +18515,18 @@ SUBROUTINE block_4_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 5 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*5+mb) - p_bc = pbc((mc-1)*5+mb) + p_bd = pbd((md - 1)*5 + mb) + p_bc = pbc((mc - 1)*5 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*5+mb) = kbd((md-1)*5+mb)-ks_bd - kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb)-ks_bc + kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd + kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc END DO END DO END DO @@ -18564,18 +18564,18 @@ SUBROUTINE block_4_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 6 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*6+mb) - p_bc = pbc((mc-1)*6+mb) + p_bd = pbd((md - 1)*6 + mb) + p_bc = pbc((mc - 1)*6 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*6+mb) = kbd((md-1)*6+mb)-ks_bd - kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb)-ks_bc + kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd + kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc END DO END DO END DO @@ -18613,18 +18613,18 @@ SUBROUTINE block_4_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 7 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*7+mb) - p_bc = pbc((mc-1)*7+mb) + p_bd = pbd((md - 1)*7 + mb) + p_bc = pbc((mc - 1)*7 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*7+mb) = kbd((md-1)*7+mb)-ks_bd - kbc((mc-1)*7+mb) = kbc((mc-1)*7+mb)-ks_bc + kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd + kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc END DO END DO END DO @@ -18662,18 +18662,18 @@ SUBROUTINE block_4_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 9 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*9+mb) - p_bc = pbc((mc-1)*9+mb) + p_bd = pbd((md - 1)*9 + mb) + p_bc = pbc((mc - 1)*9 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*9+mb) = kbd((md-1)*9+mb)-ks_bd - kbc((mc-1)*9+mb) = kbc((mc-1)*9+mb)-ks_bc + kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd + kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc END DO END DO END DO @@ -18712,18 +18712,18 @@ SUBROUTINE block_4_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 10 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*10+mb) - p_bc = pbc((mc-1)*10+mb) + p_bd = pbd((md - 1)*10 + mb) + p_bc = pbc((mc - 1)*10 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*10+mb) = kbd((md-1)*10+mb)-ks_bd - kbc((mc-1)*10+mb) = kbc((mc-1)*10+mb)-ks_bc + kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd + kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc END DO END DO END DO @@ -18762,18 +18762,18 @@ SUBROUTINE block_4_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 11 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*11+mb) - p_bc = pbc((mc-1)*11+mb) + p_bd = pbd((md - 1)*11 + mb) + p_bc = pbc((mc - 1)*11 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*11+mb) = kbd((md-1)*11+mb)-ks_bd - kbc((mc-1)*11+mb) = kbc((mc-1)*11+mb)-ks_bc + kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd + kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc END DO END DO END DO @@ -18812,18 +18812,18 @@ SUBROUTINE block_4_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 15 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*15+mb) - p_bc = pbc((mc-1)*15+mb) + p_bd = pbd((md - 1)*15 + mb) + p_bc = pbc((mc - 1)*15 + mb) DO ma = 1, 4 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*4+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*4+ma) - kad((md-1)*4+ma) = kad((md-1)*4+ma)-tmp*p_bc - kac((mc-1)*4+ma) = kac((mc-1)*4+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*4 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*4 + ma) + kad((md - 1)*4 + ma) = kad((md - 1)*4 + ma) - tmp*p_bc + kac((mc - 1)*4 + ma) = kac((mc - 1)*4 + ma) - tmp*p_bd END DO - kbd((md-1)*15+mb) = kbd((md-1)*15+mb)-ks_bd - kbc((mc-1)*15+mb) = kbc((mc-1)*15+mb)-ks_bc + kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd + kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc END DO END DO END DO @@ -18859,18 +18859,18 @@ SUBROUTINE block_5_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 5 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*5+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*5+ma) - kad((md-1)*5+ma) = kad((md-1)*5+ma)-tmp*p_bc - kac((mc-1)*5+ma) = kac((mc-1)*5+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma) + kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc + kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -18906,18 +18906,18 @@ SUBROUTINE block_5_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 5 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*5+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*5+ma) - kad((md-1)*5+ma) = kad((md-1)*5+ma)-tmp*p_bc - kac((mc-1)*5+ma) = kac((mc-1)*5+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma) + kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc + kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -18953,18 +18953,18 @@ SUBROUTINE block_5_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 5 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*5+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*5+ma) - kad((md-1)*5+ma) = kad((md-1)*5+ma)-tmp*p_bc - kac((mc-1)*5+ma) = kac((mc-1)*5+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma) + kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc + kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -19001,18 +19001,18 @@ SUBROUTINE block_5_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 5 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*5+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*5+ma) - kad((md-1)*5+ma) = kad((md-1)*5+ma)-tmp*p_bc - kac((mc-1)*5+ma) = kac((mc-1)*5+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma) + kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc + kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -19048,18 +19048,18 @@ SUBROUTINE block_5_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 5 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*5+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*5+ma) - kad((md-1)*5+ma) = kad((md-1)*5+ma)-tmp*p_bc - kac((mc-1)*5+ma) = kac((mc-1)*5+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma) + kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc + kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -19096,18 +19096,18 @@ SUBROUTINE block_5_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 5 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*5+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*5+ma) - kad((md-1)*5+ma) = kad((md-1)*5+ma)-tmp*p_bc - kac((mc-1)*5+ma) = kac((mc-1)*5+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma) + kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc + kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -19143,18 +19143,18 @@ SUBROUTINE block_5_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 5 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*5+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*5+ma) - kad((md-1)*5+ma) = kad((md-1)*5+ma)-tmp*p_bc - kac((mc-1)*5+ma) = kac((mc-1)*5+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma) + kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc + kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -19191,18 +19191,18 @@ SUBROUTINE block_5_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 5 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*5+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*5+ma) - kad((md-1)*5+ma) = kad((md-1)*5+ma)-tmp*p_bc - kac((mc-1)*5+ma) = kac((mc-1)*5+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma) + kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc + kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -19240,18 +19240,18 @@ SUBROUTINE block_5_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 5 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*5+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*5+ma) - kad((md-1)*5+ma) = kad((md-1)*5+ma)-tmp*p_bc - kac((mc-1)*5+ma) = kac((mc-1)*5+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma) + kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc + kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -19287,18 +19287,18 @@ SUBROUTINE block_5_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 5 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*5+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*5+ma) - kad((md-1)*5+ma) = kad((md-1)*5+ma)-tmp*p_bc - kac((mc-1)*5+ma) = kac((mc-1)*5+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma) + kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc + kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -19335,18 +19335,18 @@ SUBROUTINE block_5_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 5 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*5+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*5+ma) - kad((md-1)*5+ma) = kad((md-1)*5+ma)-tmp*p_bc - kac((mc-1)*5+ma) = kac((mc-1)*5+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma) + kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc + kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -19384,18 +19384,18 @@ SUBROUTINE block_5_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 5 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*5+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*5+ma) - kad((md-1)*5+ma) = kad((md-1)*5+ma)-tmp*p_bc - kac((mc-1)*5+ma) = kac((mc-1)*5+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma) + kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc + kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -19431,18 +19431,18 @@ SUBROUTINE block_5_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 5 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*5+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*5+ma) - kad((md-1)*5+ma) = kad((md-1)*5+ma)-tmp*p_bc - kac((mc-1)*5+ma) = kac((mc-1)*5+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma) + kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc + kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -19479,18 +19479,18 @@ SUBROUTINE block_5_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 5 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*5+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*5+ma) - kad((md-1)*5+ma) = kad((md-1)*5+ma)-tmp*p_bc - kac((mc-1)*5+ma) = kac((mc-1)*5+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma) + kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc + kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -19528,18 +19528,18 @@ SUBROUTINE block_5_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 5 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*5+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*5+ma) - kad((md-1)*5+ma) = kad((md-1)*5+ma)-tmp*p_bc - kac((mc-1)*5+ma) = kac((mc-1)*5+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma) + kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc + kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -19577,18 +19577,18 @@ SUBROUTINE block_5_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 5 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*5+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*5+ma) - kad((md-1)*5+ma) = kad((md-1)*5+ma)-tmp*p_bc - kac((mc-1)*5+ma) = kac((mc-1)*5+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma) + kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc + kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -19626,18 +19626,18 @@ SUBROUTINE block_5_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 5 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*5+mb) - p_bc = pbc((mc-1)*5+mb) + p_bd = pbd((md - 1)*5 + mb) + p_bc = pbc((mc - 1)*5 + mb) DO ma = 1, 5 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*5+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*5+ma) - kad((md-1)*5+ma) = kad((md-1)*5+ma)-tmp*p_bc - kac((mc-1)*5+ma) = kac((mc-1)*5+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma) + kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc + kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd END DO - kbd((md-1)*5+mb) = kbd((md-1)*5+mb)-ks_bd - kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb)-ks_bc + kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd + kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc END DO END DO END DO @@ -19675,18 +19675,18 @@ SUBROUTINE block_5_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 6 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*6+mb) - p_bc = pbc((mc-1)*6+mb) + p_bd = pbd((md - 1)*6 + mb) + p_bc = pbc((mc - 1)*6 + mb) DO ma = 1, 5 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*5+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*5+ma) - kad((md-1)*5+ma) = kad((md-1)*5+ma)-tmp*p_bc - kac((mc-1)*5+ma) = kac((mc-1)*5+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma) + kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc + kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd END DO - kbd((md-1)*6+mb) = kbd((md-1)*6+mb)-ks_bd - kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb)-ks_bc + kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd + kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc END DO END DO END DO @@ -19724,18 +19724,18 @@ SUBROUTINE block_5_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 7 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*7+mb) - p_bc = pbc((mc-1)*7+mb) + p_bd = pbd((md - 1)*7 + mb) + p_bc = pbc((mc - 1)*7 + mb) DO ma = 1, 5 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*5+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*5+ma) - kad((md-1)*5+ma) = kad((md-1)*5+ma)-tmp*p_bc - kac((mc-1)*5+ma) = kac((mc-1)*5+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma) + kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc + kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd END DO - kbd((md-1)*7+mb) = kbd((md-1)*7+mb)-ks_bd - kbc((mc-1)*7+mb) = kbc((mc-1)*7+mb)-ks_bc + kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd + kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc END DO END DO END DO @@ -19773,18 +19773,18 @@ SUBROUTINE block_5_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 9 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*9+mb) - p_bc = pbc((mc-1)*9+mb) + p_bd = pbd((md - 1)*9 + mb) + p_bc = pbc((mc - 1)*9 + mb) DO ma = 1, 5 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*5+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*5+ma) - kad((md-1)*5+ma) = kad((md-1)*5+ma)-tmp*p_bc - kac((mc-1)*5+ma) = kac((mc-1)*5+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma) + kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc + kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd END DO - kbd((md-1)*9+mb) = kbd((md-1)*9+mb)-ks_bd - kbc((mc-1)*9+mb) = kbc((mc-1)*9+mb)-ks_bc + kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd + kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc END DO END DO END DO @@ -19823,18 +19823,18 @@ SUBROUTINE block_5_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 10 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*10+mb) - p_bc = pbc((mc-1)*10+mb) + p_bd = pbd((md - 1)*10 + mb) + p_bc = pbc((mc - 1)*10 + mb) DO ma = 1, 5 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*5+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*5+ma) - kad((md-1)*5+ma) = kad((md-1)*5+ma)-tmp*p_bc - kac((mc-1)*5+ma) = kac((mc-1)*5+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma) + kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc + kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd END DO - kbd((md-1)*10+mb) = kbd((md-1)*10+mb)-ks_bd - kbc((mc-1)*10+mb) = kbc((mc-1)*10+mb)-ks_bc + kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd + kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc END DO END DO END DO @@ -19873,18 +19873,18 @@ SUBROUTINE block_5_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 11 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*11+mb) - p_bc = pbc((mc-1)*11+mb) + p_bd = pbd((md - 1)*11 + mb) + p_bc = pbc((mc - 1)*11 + mb) DO ma = 1, 5 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*5+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*5+ma) - kad((md-1)*5+ma) = kad((md-1)*5+ma)-tmp*p_bc - kac((mc-1)*5+ma) = kac((mc-1)*5+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma) + kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc + kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd END DO - kbd((md-1)*11+mb) = kbd((md-1)*11+mb)-ks_bd - kbc((mc-1)*11+mb) = kbc((mc-1)*11+mb)-ks_bc + kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd + kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc END DO END DO END DO @@ -19923,18 +19923,18 @@ SUBROUTINE block_5_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 15 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*15+mb) - p_bc = pbc((mc-1)*15+mb) + p_bd = pbd((md - 1)*15 + mb) + p_bc = pbc((mc - 1)*15 + mb) DO ma = 1, 5 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*5+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*5+ma) - kad((md-1)*5+ma) = kad((md-1)*5+ma)-tmp*p_bc - kac((mc-1)*5+ma) = kac((mc-1)*5+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*5 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*5 + ma) + kad((md - 1)*5 + ma) = kad((md - 1)*5 + ma) - tmp*p_bc + kac((mc - 1)*5 + ma) = kac((mc - 1)*5 + ma) - tmp*p_bd END DO - kbd((md-1)*15+mb) = kbd((md-1)*15+mb)-ks_bd - kbc((mc-1)*15+mb) = kbc((mc-1)*15+mb)-ks_bc + kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd + kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc END DO END DO END DO @@ -19970,18 +19970,18 @@ SUBROUTINE block_6_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 6 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*6+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*6+ma) - kad((md-1)*6+ma) = kad((md-1)*6+ma)-tmp*p_bc - kac((mc-1)*6+ma) = kac((mc-1)*6+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma) + kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc + kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -20017,18 +20017,18 @@ SUBROUTINE block_6_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 6 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*6+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*6+ma) - kad((md-1)*6+ma) = kad((md-1)*6+ma)-tmp*p_bc - kac((mc-1)*6+ma) = kac((mc-1)*6+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma) + kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc + kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -20064,18 +20064,18 @@ SUBROUTINE block_6_1_1_3(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 6 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*6+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*6+ma) - kad((md-1)*6+ma) = kad((md-1)*6+ma)-tmp*p_bc - kac((mc-1)*6+ma) = kac((mc-1)*6+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma) + kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc + kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -20112,18 +20112,18 @@ SUBROUTINE block_6_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 6 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*6+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*6+ma) - kad((md-1)*6+ma) = kad((md-1)*6+ma)-tmp*p_bc - kac((mc-1)*6+ma) = kac((mc-1)*6+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma) + kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc + kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -20159,18 +20159,18 @@ SUBROUTINE block_6_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 6 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*6+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*6+ma) - kad((md-1)*6+ma) = kad((md-1)*6+ma)-tmp*p_bc - kac((mc-1)*6+ma) = kac((mc-1)*6+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma) + kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc + kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -20207,18 +20207,18 @@ SUBROUTINE block_6_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 6 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*6+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*6+ma) - kad((md-1)*6+ma) = kad((md-1)*6+ma)-tmp*p_bc - kac((mc-1)*6+ma) = kac((mc-1)*6+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma) + kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc + kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -20254,18 +20254,18 @@ SUBROUTINE block_6_1_3_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 6 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*6+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*6+ma) - kad((md-1)*6+ma) = kad((md-1)*6+ma)-tmp*p_bc - kac((mc-1)*6+ma) = kac((mc-1)*6+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma) + kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc + kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -20302,18 +20302,18 @@ SUBROUTINE block_6_1_3(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 6 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*6+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*6+ma) - kad((md-1)*6+ma) = kad((md-1)*6+ma)-tmp*p_bc - kac((mc-1)*6+ma) = kac((mc-1)*6+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma) + kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc + kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -20351,18 +20351,18 @@ SUBROUTINE block_6_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 6 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*6+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*6+ma) - kad((md-1)*6+ma) = kad((md-1)*6+ma)-tmp*p_bc - kac((mc-1)*6+ma) = kac((mc-1)*6+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma) + kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc + kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -20398,18 +20398,18 @@ SUBROUTINE block_6_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 6 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*6+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*6+ma) - kad((md-1)*6+ma) = kad((md-1)*6+ma)-tmp*p_bc - kac((mc-1)*6+ma) = kac((mc-1)*6+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma) + kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc + kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -20446,18 +20446,18 @@ SUBROUTINE block_6_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 6 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*6+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*6+ma) - kad((md-1)*6+ma) = kad((md-1)*6+ma)-tmp*p_bc - kac((mc-1)*6+ma) = kac((mc-1)*6+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma) + kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc + kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -20495,18 +20495,18 @@ SUBROUTINE block_6_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 6 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*6+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*6+ma) - kad((md-1)*6+ma) = kad((md-1)*6+ma)-tmp*p_bc - kac((mc-1)*6+ma) = kac((mc-1)*6+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma) + kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc + kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -20542,18 +20542,18 @@ SUBROUTINE block_6_3_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 6 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*6+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*6+ma) - kad((md-1)*6+ma) = kad((md-1)*6+ma)-tmp*p_bc - kac((mc-1)*6+ma) = kac((mc-1)*6+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma) + kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc + kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -20590,18 +20590,18 @@ SUBROUTINE block_6_3_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 6 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*6+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*6+ma) - kad((md-1)*6+ma) = kad((md-1)*6+ma)-tmp*p_bc - kac((mc-1)*6+ma) = kac((mc-1)*6+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma) + kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc + kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -20639,18 +20639,18 @@ SUBROUTINE block_6_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 6 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*6+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*6+ma) - kad((md-1)*6+ma) = kad((md-1)*6+ma)-tmp*p_bc - kac((mc-1)*6+ma) = kac((mc-1)*6+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma) + kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc + kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -20688,18 +20688,18 @@ SUBROUTINE block_6_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 6 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*6+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*6+ma) - kad((md-1)*6+ma) = kad((md-1)*6+ma)-tmp*p_bc - kac((mc-1)*6+ma) = kac((mc-1)*6+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma) + kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc + kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -20737,18 +20737,18 @@ SUBROUTINE block_6_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 5 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*5+mb) - p_bc = pbc((mc-1)*5+mb) + p_bd = pbd((md - 1)*5 + mb) + p_bc = pbc((mc - 1)*5 + mb) DO ma = 1, 6 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*6+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*6+ma) - kad((md-1)*6+ma) = kad((md-1)*6+ma)-tmp*p_bc - kac((mc-1)*6+ma) = kac((mc-1)*6+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma) + kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc + kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd END DO - kbd((md-1)*5+mb) = kbd((md-1)*5+mb)-ks_bd - kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb)-ks_bc + kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd + kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc END DO END DO END DO @@ -20786,18 +20786,18 @@ SUBROUTINE block_6_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 6 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*6+mb) - p_bc = pbc((mc-1)*6+mb) + p_bd = pbd((md - 1)*6 + mb) + p_bc = pbc((mc - 1)*6 + mb) DO ma = 1, 6 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*6+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*6+ma) - kad((md-1)*6+ma) = kad((md-1)*6+ma)-tmp*p_bc - kac((mc-1)*6+ma) = kac((mc-1)*6+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma) + kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc + kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd END DO - kbd((md-1)*6+mb) = kbd((md-1)*6+mb)-ks_bd - kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb)-ks_bc + kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd + kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc END DO END DO END DO @@ -20835,18 +20835,18 @@ SUBROUTINE block_6_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 7 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*7+mb) - p_bc = pbc((mc-1)*7+mb) + p_bd = pbd((md - 1)*7 + mb) + p_bc = pbc((mc - 1)*7 + mb) DO ma = 1, 6 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*6+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*6+ma) - kad((md-1)*6+ma) = kad((md-1)*6+ma)-tmp*p_bc - kac((mc-1)*6+ma) = kac((mc-1)*6+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma) + kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc + kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd END DO - kbd((md-1)*7+mb) = kbd((md-1)*7+mb)-ks_bd - kbc((mc-1)*7+mb) = kbc((mc-1)*7+mb)-ks_bc + kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd + kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc END DO END DO END DO @@ -20884,18 +20884,18 @@ SUBROUTINE block_6_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 9 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*9+mb) - p_bc = pbc((mc-1)*9+mb) + p_bd = pbd((md - 1)*9 + mb) + p_bc = pbc((mc - 1)*9 + mb) DO ma = 1, 6 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*6+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*6+ma) - kad((md-1)*6+ma) = kad((md-1)*6+ma)-tmp*p_bc - kac((mc-1)*6+ma) = kac((mc-1)*6+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma) + kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc + kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd END DO - kbd((md-1)*9+mb) = kbd((md-1)*9+mb)-ks_bd - kbc((mc-1)*9+mb) = kbc((mc-1)*9+mb)-ks_bc + kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd + kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc END DO END DO END DO @@ -20934,18 +20934,18 @@ SUBROUTINE block_6_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 10 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*10+mb) - p_bc = pbc((mc-1)*10+mb) + p_bd = pbd((md - 1)*10 + mb) + p_bc = pbc((mc - 1)*10 + mb) DO ma = 1, 6 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*6+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*6+ma) - kad((md-1)*6+ma) = kad((md-1)*6+ma)-tmp*p_bc - kac((mc-1)*6+ma) = kac((mc-1)*6+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma) + kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc + kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd END DO - kbd((md-1)*10+mb) = kbd((md-1)*10+mb)-ks_bd - kbc((mc-1)*10+mb) = kbc((mc-1)*10+mb)-ks_bc + kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd + kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc END DO END DO END DO @@ -20984,18 +20984,18 @@ SUBROUTINE block_6_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 11 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*11+mb) - p_bc = pbc((mc-1)*11+mb) + p_bd = pbd((md - 1)*11 + mb) + p_bc = pbc((mc - 1)*11 + mb) DO ma = 1, 6 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*6+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*6+ma) - kad((md-1)*6+ma) = kad((md-1)*6+ma)-tmp*p_bc - kac((mc-1)*6+ma) = kac((mc-1)*6+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma) + kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc + kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd END DO - kbd((md-1)*11+mb) = kbd((md-1)*11+mb)-ks_bd - kbc((mc-1)*11+mb) = kbc((mc-1)*11+mb)-ks_bc + kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd + kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc END DO END DO END DO @@ -21034,18 +21034,18 @@ SUBROUTINE block_6_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 15 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*15+mb) - p_bc = pbc((mc-1)*15+mb) + p_bd = pbd((md - 1)*15 + mb) + p_bc = pbc((mc - 1)*15 + mb) DO ma = 1, 6 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*6+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*6+ma) - kad((md-1)*6+ma) = kad((md-1)*6+ma)-tmp*p_bc - kac((mc-1)*6+ma) = kac((mc-1)*6+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*6 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*6 + ma) + kad((md - 1)*6 + ma) = kad((md - 1)*6 + ma) - tmp*p_bc + kac((mc - 1)*6 + ma) = kac((mc - 1)*6 + ma) - tmp*p_bd END DO - kbd((md-1)*15+mb) = kbd((md-1)*15+mb)-ks_bd - kbc((mc-1)*15+mb) = kbc((mc-1)*15+mb)-ks_bc + kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd + kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc END DO END DO END DO @@ -21081,18 +21081,18 @@ SUBROUTINE block_7_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 7 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*7+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*7+ma) - kad((md-1)*7+ma) = kad((md-1)*7+ma)-tmp*p_bc - kac((mc-1)*7+ma) = kac((mc-1)*7+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma) + kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc + kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -21128,18 +21128,18 @@ SUBROUTINE block_7_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 7 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*7+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*7+ma) - kad((md-1)*7+ma) = kad((md-1)*7+ma)-tmp*p_bc - kac((mc-1)*7+ma) = kac((mc-1)*7+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma) + kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc + kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -21176,18 +21176,18 @@ SUBROUTINE block_7_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 7 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*7+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*7+ma) - kad((md-1)*7+ma) = kad((md-1)*7+ma)-tmp*p_bc - kac((mc-1)*7+ma) = kac((mc-1)*7+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma) + kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc + kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -21223,18 +21223,18 @@ SUBROUTINE block_7_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 7 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*7+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*7+ma) - kad((md-1)*7+ma) = kad((md-1)*7+ma)-tmp*p_bc - kac((mc-1)*7+ma) = kac((mc-1)*7+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma) + kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc + kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -21271,18 +21271,18 @@ SUBROUTINE block_7_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 7 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*7+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*7+ma) - kad((md-1)*7+ma) = kad((md-1)*7+ma)-tmp*p_bc - kac((mc-1)*7+ma) = kac((mc-1)*7+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma) + kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc + kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -21320,18 +21320,18 @@ SUBROUTINE block_7_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 7 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*7+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*7+ma) - kad((md-1)*7+ma) = kad((md-1)*7+ma)-tmp*p_bc - kac((mc-1)*7+ma) = kac((mc-1)*7+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma) + kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc + kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -21367,18 +21367,18 @@ SUBROUTINE block_7_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 7 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*7+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*7+ma) - kad((md-1)*7+ma) = kad((md-1)*7+ma)-tmp*p_bc - kac((mc-1)*7+ma) = kac((mc-1)*7+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma) + kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc + kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -21415,18 +21415,18 @@ SUBROUTINE block_7_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 7 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*7+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*7+ma) - kad((md-1)*7+ma) = kad((md-1)*7+ma)-tmp*p_bc - kac((mc-1)*7+ma) = kac((mc-1)*7+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma) + kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc + kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -21464,18 +21464,18 @@ SUBROUTINE block_7_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 7 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*7+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*7+ma) - kad((md-1)*7+ma) = kad((md-1)*7+ma)-tmp*p_bc - kac((mc-1)*7+ma) = kac((mc-1)*7+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma) + kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc + kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -21513,18 +21513,18 @@ SUBROUTINE block_7_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 7 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*7+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*7+ma) - kad((md-1)*7+ma) = kad((md-1)*7+ma)-tmp*p_bc - kac((mc-1)*7+ma) = kac((mc-1)*7+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma) + kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc + kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -21562,18 +21562,18 @@ SUBROUTINE block_7_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 7 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*7+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*7+ma) - kad((md-1)*7+ma) = kad((md-1)*7+ma)-tmp*p_bc - kac((mc-1)*7+ma) = kac((mc-1)*7+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma) + kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc + kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -21611,18 +21611,18 @@ SUBROUTINE block_7_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 5 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*5+mb) - p_bc = pbc((mc-1)*5+mb) + p_bd = pbd((md - 1)*5 + mb) + p_bc = pbc((mc - 1)*5 + mb) DO ma = 1, 7 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*7+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*7+ma) - kad((md-1)*7+ma) = kad((md-1)*7+ma)-tmp*p_bc - kac((mc-1)*7+ma) = kac((mc-1)*7+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma) + kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc + kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd END DO - kbd((md-1)*5+mb) = kbd((md-1)*5+mb)-ks_bd - kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb)-ks_bc + kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd + kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc END DO END DO END DO @@ -21660,18 +21660,18 @@ SUBROUTINE block_7_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 6 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*6+mb) - p_bc = pbc((mc-1)*6+mb) + p_bd = pbd((md - 1)*6 + mb) + p_bc = pbc((mc - 1)*6 + mb) DO ma = 1, 7 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*7+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*7+ma) - kad((md-1)*7+ma) = kad((md-1)*7+ma)-tmp*p_bc - kac((mc-1)*7+ma) = kac((mc-1)*7+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma) + kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc + kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd END DO - kbd((md-1)*6+mb) = kbd((md-1)*6+mb)-ks_bd - kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb)-ks_bc + kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd + kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc END DO END DO END DO @@ -21709,18 +21709,18 @@ SUBROUTINE block_7_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 7 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*7+mb) - p_bc = pbc((mc-1)*7+mb) + p_bd = pbd((md - 1)*7 + mb) + p_bc = pbc((mc - 1)*7 + mb) DO ma = 1, 7 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*7+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*7+ma) - kad((md-1)*7+ma) = kad((md-1)*7+ma)-tmp*p_bc - kac((mc-1)*7+ma) = kac((mc-1)*7+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma) + kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc + kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd END DO - kbd((md-1)*7+mb) = kbd((md-1)*7+mb)-ks_bd - kbc((mc-1)*7+mb) = kbc((mc-1)*7+mb)-ks_bc + kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd + kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc END DO END DO END DO @@ -21758,18 +21758,18 @@ SUBROUTINE block_7_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 9 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*9+mb) - p_bc = pbc((mc-1)*9+mb) + p_bd = pbd((md - 1)*9 + mb) + p_bc = pbc((mc - 1)*9 + mb) DO ma = 1, 7 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*7+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*7+ma) - kad((md-1)*7+ma) = kad((md-1)*7+ma)-tmp*p_bc - kac((mc-1)*7+ma) = kac((mc-1)*7+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma) + kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc + kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd END DO - kbd((md-1)*9+mb) = kbd((md-1)*9+mb)-ks_bd - kbc((mc-1)*9+mb) = kbc((mc-1)*9+mb)-ks_bc + kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd + kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc END DO END DO END DO @@ -21808,18 +21808,18 @@ SUBROUTINE block_7_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 10 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*10+mb) - p_bc = pbc((mc-1)*10+mb) + p_bd = pbd((md - 1)*10 + mb) + p_bc = pbc((mc - 1)*10 + mb) DO ma = 1, 7 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*7+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*7+ma) - kad((md-1)*7+ma) = kad((md-1)*7+ma)-tmp*p_bc - kac((mc-1)*7+ma) = kac((mc-1)*7+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma) + kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc + kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd END DO - kbd((md-1)*10+mb) = kbd((md-1)*10+mb)-ks_bd - kbc((mc-1)*10+mb) = kbc((mc-1)*10+mb)-ks_bc + kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd + kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc END DO END DO END DO @@ -21858,18 +21858,18 @@ SUBROUTINE block_7_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 11 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*11+mb) - p_bc = pbc((mc-1)*11+mb) + p_bd = pbd((md - 1)*11 + mb) + p_bc = pbc((mc - 1)*11 + mb) DO ma = 1, 7 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*7+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*7+ma) - kad((md-1)*7+ma) = kad((md-1)*7+ma)-tmp*p_bc - kac((mc-1)*7+ma) = kac((mc-1)*7+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma) + kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc + kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd END DO - kbd((md-1)*11+mb) = kbd((md-1)*11+mb)-ks_bd - kbc((mc-1)*11+mb) = kbc((mc-1)*11+mb)-ks_bc + kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd + kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc END DO END DO END DO @@ -21908,18 +21908,18 @@ SUBROUTINE block_7_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 15 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*15+mb) - p_bc = pbc((mc-1)*15+mb) + p_bd = pbd((md - 1)*15 + mb) + p_bc = pbc((mc - 1)*15 + mb) DO ma = 1, 7 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*7+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*7+ma) - kad((md-1)*7+ma) = kad((md-1)*7+ma)-tmp*p_bc - kac((mc-1)*7+ma) = kac((mc-1)*7+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*7 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*7 + ma) + kad((md - 1)*7 + ma) = kad((md - 1)*7 + ma) - tmp*p_bc + kac((mc - 1)*7 + ma) = kac((mc - 1)*7 + ma) - tmp*p_bd END DO - kbd((md-1)*15+mb) = kbd((md-1)*15+mb)-ks_bd - kbc((mc-1)*15+mb) = kbc((mc-1)*15+mb)-ks_bc + kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd + kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc END DO END DO END DO @@ -21955,18 +21955,18 @@ SUBROUTINE block_9_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 9 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*9+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*9+ma) - kad((md-1)*9+ma) = kad((md-1)*9+ma)-tmp*p_bc - kac((mc-1)*9+ma) = kac((mc-1)*9+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma) + kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc + kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -22002,18 +22002,18 @@ SUBROUTINE block_9_1_1_2(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 9 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*9+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*9+ma) - kad((md-1)*9+ma) = kad((md-1)*9+ma)-tmp*p_bc - kac((mc-1)*9+ma) = kac((mc-1)*9+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma) + kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc + kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -22050,18 +22050,18 @@ SUBROUTINE block_9_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 9 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*9+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*9+ma) - kad((md-1)*9+ma) = kad((md-1)*9+ma)-tmp*p_bc - kac((mc-1)*9+ma) = kac((mc-1)*9+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma) + kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc + kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -22097,18 +22097,18 @@ SUBROUTINE block_9_1_2_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 9 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*9+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*9+ma) - kad((md-1)*9+ma) = kad((md-1)*9+ma)-tmp*p_bc - kac((mc-1)*9+ma) = kac((mc-1)*9+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma) + kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc + kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -22145,18 +22145,18 @@ SUBROUTINE block_9_1_2(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 9 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*9+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*9+ma) - kad((md-1)*9+ma) = kad((md-1)*9+ma)-tmp*p_bc - kac((mc-1)*9+ma) = kac((mc-1)*9+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma) + kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc + kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -22194,18 +22194,18 @@ SUBROUTINE block_9_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 9 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*9+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*9+ma) - kad((md-1)*9+ma) = kad((md-1)*9+ma)-tmp*p_bc - kac((mc-1)*9+ma) = kac((mc-1)*9+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma) + kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc + kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -22241,18 +22241,18 @@ SUBROUTINE block_9_2_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 9 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*9+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*9+ma) - kad((md-1)*9+ma) = kad((md-1)*9+ma)-tmp*p_bc - kac((mc-1)*9+ma) = kac((mc-1)*9+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma) + kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc + kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -22289,18 +22289,18 @@ SUBROUTINE block_9_2_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sca DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 9 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*9+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*9+ma) - kad((md-1)*9+ma) = kad((md-1)*9+ma)-tmp*p_bc - kac((mc-1)*9+ma) = kac((mc-1)*9+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma) + kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc + kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -22338,18 +22338,18 @@ SUBROUTINE block_9_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 9 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*9+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*9+ma) - kad((md-1)*9+ma) = kad((md-1)*9+ma)-tmp*p_bc - kac((mc-1)*9+ma) = kac((mc-1)*9+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma) + kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc + kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -22387,18 +22387,18 @@ SUBROUTINE block_9_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 9 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*9+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*9+ma) - kad((md-1)*9+ma) = kad((md-1)*9+ma)-tmp*p_bc - kac((mc-1)*9+ma) = kac((mc-1)*9+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma) + kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc + kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -22436,18 +22436,18 @@ SUBROUTINE block_9_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 9 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*9+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*9+ma) - kad((md-1)*9+ma) = kad((md-1)*9+ma)-tmp*p_bc - kac((mc-1)*9+ma) = kac((mc-1)*9+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma) + kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc + kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -22485,18 +22485,18 @@ SUBROUTINE block_9_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 5 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*5+mb) - p_bc = pbc((mc-1)*5+mb) + p_bd = pbd((md - 1)*5 + mb) + p_bc = pbc((mc - 1)*5 + mb) DO ma = 1, 9 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*9+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*9+ma) - kad((md-1)*9+ma) = kad((md-1)*9+ma)-tmp*p_bc - kac((mc-1)*9+ma) = kac((mc-1)*9+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma) + kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc + kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd END DO - kbd((md-1)*5+mb) = kbd((md-1)*5+mb)-ks_bd - kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb)-ks_bc + kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd + kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc END DO END DO END DO @@ -22534,18 +22534,18 @@ SUBROUTINE block_9_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 6 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*6+mb) - p_bc = pbc((mc-1)*6+mb) + p_bd = pbd((md - 1)*6 + mb) + p_bc = pbc((mc - 1)*6 + mb) DO ma = 1, 9 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*9+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*9+ma) - kad((md-1)*9+ma) = kad((md-1)*9+ma)-tmp*p_bc - kac((mc-1)*9+ma) = kac((mc-1)*9+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma) + kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc + kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd END DO - kbd((md-1)*6+mb) = kbd((md-1)*6+mb)-ks_bd - kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb)-ks_bc + kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd + kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc END DO END DO END DO @@ -22583,18 +22583,18 @@ SUBROUTINE block_9_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 7 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*7+mb) - p_bc = pbc((mc-1)*7+mb) + p_bd = pbd((md - 1)*7 + mb) + p_bc = pbc((mc - 1)*7 + mb) DO ma = 1, 9 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*9+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*9+ma) - kad((md-1)*9+ma) = kad((md-1)*9+ma)-tmp*p_bc - kac((mc-1)*9+ma) = kac((mc-1)*9+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma) + kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc + kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd END DO - kbd((md-1)*7+mb) = kbd((md-1)*7+mb)-ks_bd - kbc((mc-1)*7+mb) = kbc((mc-1)*7+mb)-ks_bc + kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd + kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc END DO END DO END DO @@ -22632,18 +22632,18 @@ SUBROUTINE block_9_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pri DO mb = 1, 9 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*9+mb) - p_bc = pbc((mc-1)*9+mb) + p_bd = pbd((md - 1)*9 + mb) + p_bc = pbc((mc - 1)*9 + mb) DO ma = 1, 9 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*9+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*9+ma) - kad((md-1)*9+ma) = kad((md-1)*9+ma)-tmp*p_bc - kac((mc-1)*9+ma) = kac((mc-1)*9+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma) + kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc + kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd END DO - kbd((md-1)*9+mb) = kbd((md-1)*9+mb)-ks_bd - kbc((mc-1)*9+mb) = kbc((mc-1)*9+mb)-ks_bc + kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd + kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc END DO END DO END DO @@ -22682,18 +22682,18 @@ SUBROUTINE block_9_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 10 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*10+mb) - p_bc = pbc((mc-1)*10+mb) + p_bd = pbd((md - 1)*10 + mb) + p_bc = pbc((mc - 1)*10 + mb) DO ma = 1, 9 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*9+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*9+ma) - kad((md-1)*9+ma) = kad((md-1)*9+ma)-tmp*p_bc - kac((mc-1)*9+ma) = kac((mc-1)*9+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma) + kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc + kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd END DO - kbd((md-1)*10+mb) = kbd((md-1)*10+mb)-ks_bd - kbc((mc-1)*10+mb) = kbc((mc-1)*10+mb)-ks_bc + kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd + kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc END DO END DO END DO @@ -22732,18 +22732,18 @@ SUBROUTINE block_9_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 11 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*11+mb) - p_bc = pbc((mc-1)*11+mb) + p_bd = pbd((md - 1)*11 + mb) + p_bc = pbc((mc - 1)*11 + mb) DO ma = 1, 9 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*9+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*9+ma) - kad((md-1)*9+ma) = kad((md-1)*9+ma)-tmp*p_bc - kac((mc-1)*9+ma) = kac((mc-1)*9+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma) + kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc + kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd END DO - kbd((md-1)*11+mb) = kbd((md-1)*11+mb)-ks_bd - kbc((mc-1)*11+mb) = kbc((mc-1)*11+mb)-ks_bc + kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd + kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc END DO END DO END DO @@ -22782,18 +22782,18 @@ SUBROUTINE block_9_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 15 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*15+mb) - p_bc = pbc((mc-1)*15+mb) + p_bd = pbd((md - 1)*15 + mb) + p_bc = pbc((mc - 1)*15 + mb) DO ma = 1, 9 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*9+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*9+ma) - kad((md-1)*9+ma) = kad((md-1)*9+ma)-tmp*p_bc - kac((mc-1)*9+ma) = kac((mc-1)*9+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*9 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*9 + ma) + kad((md - 1)*9 + ma) = kad((md - 1)*9 + ma) - tmp*p_bc + kac((mc - 1)*9 + ma) = kac((mc - 1)*9 + ma) - tmp*p_bd END DO - kbd((md-1)*15+mb) = kbd((md-1)*15+mb)-ks_bd - kbc((mc-1)*15+mb) = kbc((mc-1)*15+mb)-ks_bc + kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd + kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc END DO END DO END DO @@ -22830,18 +22830,18 @@ SUBROUTINE block_10_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 10 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*10+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*10+ma) - kad((md-1)*10+ma) = kad((md-1)*10+ma)-tmp*p_bc - kac((mc-1)*10+ma) = kac((mc-1)*10+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma) + kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc + kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -22878,18 +22878,18 @@ SUBROUTINE block_10_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sc DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 10 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*10+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*10+ma) - kad((md-1)*10+ma) = kad((md-1)*10+ma)-tmp*p_bc - kac((mc-1)*10+ma) = kac((mc-1)*10+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma) + kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc + kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -22928,18 +22928,18 @@ SUBROUTINE block_10_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 10 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*10+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*10+ma) - kad((md-1)*10+ma) = kad((md-1)*10+ma)-tmp*p_bc - kac((mc-1)*10+ma) = kac((mc-1)*10+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma) + kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc + kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -22978,18 +22978,18 @@ SUBROUTINE block_10_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 10 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*10+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*10+ma) - kad((md-1)*10+ma) = kad((md-1)*10+ma)-tmp*p_bc - kac((mc-1)*10+ma) = kac((mc-1)*10+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma) + kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc + kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -23028,18 +23028,18 @@ SUBROUTINE block_10_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 10 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*10+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*10+ma) - kad((md-1)*10+ma) = kad((md-1)*10+ma)-tmp*p_bc - kac((mc-1)*10+ma) = kac((mc-1)*10+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma) + kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc + kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -23078,18 +23078,18 @@ SUBROUTINE block_10_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 10 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*10+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*10+ma) - kad((md-1)*10+ma) = kad((md-1)*10+ma)-tmp*p_bc - kac((mc-1)*10+ma) = kac((mc-1)*10+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma) + kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc + kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -23128,18 +23128,18 @@ SUBROUTINE block_10_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 5 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*5+mb) - p_bc = pbc((mc-1)*5+mb) + p_bd = pbd((md - 1)*5 + mb) + p_bc = pbc((mc - 1)*5 + mb) DO ma = 1, 10 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*10+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*10+ma) - kad((md-1)*10+ma) = kad((md-1)*10+ma)-tmp*p_bc - kac((mc-1)*10+ma) = kac((mc-1)*10+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma) + kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc + kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd END DO - kbd((md-1)*5+mb) = kbd((md-1)*5+mb)-ks_bd - kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb)-ks_bc + kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd + kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc END DO END DO END DO @@ -23178,18 +23178,18 @@ SUBROUTINE block_10_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 6 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*6+mb) - p_bc = pbc((mc-1)*6+mb) + p_bd = pbd((md - 1)*6 + mb) + p_bc = pbc((mc - 1)*6 + mb) DO ma = 1, 10 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*10+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*10+ma) - kad((md-1)*10+ma) = kad((md-1)*10+ma)-tmp*p_bc - kac((mc-1)*10+ma) = kac((mc-1)*10+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma) + kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc + kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd END DO - kbd((md-1)*6+mb) = kbd((md-1)*6+mb)-ks_bd - kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb)-ks_bc + kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd + kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc END DO END DO END DO @@ -23228,18 +23228,18 @@ SUBROUTINE block_10_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 7 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*7+mb) - p_bc = pbc((mc-1)*7+mb) + p_bd = pbd((md - 1)*7 + mb) + p_bc = pbc((mc - 1)*7 + mb) DO ma = 1, 10 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*10+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*10+ma) - kad((md-1)*10+ma) = kad((md-1)*10+ma)-tmp*p_bc - kac((mc-1)*10+ma) = kac((mc-1)*10+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma) + kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc + kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd END DO - kbd((md-1)*7+mb) = kbd((md-1)*7+mb)-ks_bd - kbc((mc-1)*7+mb) = kbc((mc-1)*7+mb)-ks_bc + kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd + kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc END DO END DO END DO @@ -23278,18 +23278,18 @@ SUBROUTINE block_10_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 9 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*9+mb) - p_bc = pbc((mc-1)*9+mb) + p_bd = pbd((md - 1)*9 + mb) + p_bc = pbc((mc - 1)*9 + mb) DO ma = 1, 10 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*10+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*10+ma) - kad((md-1)*10+ma) = kad((md-1)*10+ma)-tmp*p_bc - kac((mc-1)*10+ma) = kac((mc-1)*10+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma) + kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc + kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd END DO - kbd((md-1)*9+mb) = kbd((md-1)*9+mb)-ks_bd - kbc((mc-1)*9+mb) = kbc((mc-1)*9+mb)-ks_bc + kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd + kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc END DO END DO END DO @@ -23328,18 +23328,18 @@ SUBROUTINE block_10_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, p DO mb = 1, 10 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*10+mb) - p_bc = pbc((mc-1)*10+mb) + p_bd = pbd((md - 1)*10 + mb) + p_bc = pbc((mc - 1)*10 + mb) DO ma = 1, 10 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*10+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*10+ma) - kad((md-1)*10+ma) = kad((md-1)*10+ma)-tmp*p_bc - kac((mc-1)*10+ma) = kac((mc-1)*10+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma) + kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc + kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd END DO - kbd((md-1)*10+mb) = kbd((md-1)*10+mb)-ks_bd - kbc((mc-1)*10+mb) = kbc((mc-1)*10+mb)-ks_bc + kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd + kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc END DO END DO END DO @@ -23378,18 +23378,18 @@ SUBROUTINE block_10_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, p DO mb = 1, 11 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*11+mb) - p_bc = pbc((mc-1)*11+mb) + p_bd = pbd((md - 1)*11 + mb) + p_bc = pbc((mc - 1)*11 + mb) DO ma = 1, 10 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*10+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*10+ma) - kad((md-1)*10+ma) = kad((md-1)*10+ma)-tmp*p_bc - kac((mc-1)*10+ma) = kac((mc-1)*10+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma) + kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc + kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd END DO - kbd((md-1)*11+mb) = kbd((md-1)*11+mb)-ks_bd - kbc((mc-1)*11+mb) = kbc((mc-1)*11+mb)-ks_bc + kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd + kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc END DO END DO END DO @@ -23428,18 +23428,18 @@ SUBROUTINE block_10_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, p DO mb = 1, 15 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*15+mb) - p_bc = pbc((mc-1)*15+mb) + p_bd = pbd((md - 1)*15 + mb) + p_bc = pbc((mc - 1)*15 + mb) DO ma = 1, 10 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*10+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*10+ma) - kad((md-1)*10+ma) = kad((md-1)*10+ma)-tmp*p_bc - kac((mc-1)*10+ma) = kac((mc-1)*10+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*10 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*10 + ma) + kad((md - 1)*10 + ma) = kad((md - 1)*10 + ma) - tmp*p_bc + kac((mc - 1)*10 + ma) = kac((mc - 1)*10 + ma) - tmp*p_bd END DO - kbd((md-1)*15+mb) = kbd((md-1)*15+mb)-ks_bd - kbc((mc-1)*15+mb) = kbc((mc-1)*15+mb)-ks_bc + kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd + kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc END DO END DO END DO @@ -23476,18 +23476,18 @@ SUBROUTINE block_11_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 11 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*11+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*11+ma) - kad((md-1)*11+ma) = kad((md-1)*11+ma)-tmp*p_bc - kac((mc-1)*11+ma) = kac((mc-1)*11+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma) + kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc + kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -23524,18 +23524,18 @@ SUBROUTINE block_11_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sc DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 11 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*11+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*11+ma) - kad((md-1)*11+ma) = kad((md-1)*11+ma)-tmp*p_bc - kac((mc-1)*11+ma) = kac((mc-1)*11+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma) + kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc + kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -23574,18 +23574,18 @@ SUBROUTINE block_11_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 11 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*11+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*11+ma) - kad((md-1)*11+ma) = kad((md-1)*11+ma)-tmp*p_bc - kac((mc-1)*11+ma) = kac((mc-1)*11+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma) + kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc + kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -23624,18 +23624,18 @@ SUBROUTINE block_11_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 11 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*11+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*11+ma) - kad((md-1)*11+ma) = kad((md-1)*11+ma)-tmp*p_bc - kac((mc-1)*11+ma) = kac((mc-1)*11+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma) + kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc + kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -23674,18 +23674,18 @@ SUBROUTINE block_11_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 11 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*11+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*11+ma) - kad((md-1)*11+ma) = kad((md-1)*11+ma)-tmp*p_bc - kac((mc-1)*11+ma) = kac((mc-1)*11+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma) + kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc + kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -23724,18 +23724,18 @@ SUBROUTINE block_11_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 11 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*11+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*11+ma) - kad((md-1)*11+ma) = kad((md-1)*11+ma)-tmp*p_bc - kac((mc-1)*11+ma) = kac((mc-1)*11+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma) + kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc + kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -23774,18 +23774,18 @@ SUBROUTINE block_11_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 5 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*5+mb) - p_bc = pbc((mc-1)*5+mb) + p_bd = pbd((md - 1)*5 + mb) + p_bc = pbc((mc - 1)*5 + mb) DO ma = 1, 11 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*11+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*11+ma) - kad((md-1)*11+ma) = kad((md-1)*11+ma)-tmp*p_bc - kac((mc-1)*11+ma) = kac((mc-1)*11+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma) + kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc + kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd END DO - kbd((md-1)*5+mb) = kbd((md-1)*5+mb)-ks_bd - kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb)-ks_bc + kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd + kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc END DO END DO END DO @@ -23824,18 +23824,18 @@ SUBROUTINE block_11_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 6 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*6+mb) - p_bc = pbc((mc-1)*6+mb) + p_bd = pbd((md - 1)*6 + mb) + p_bc = pbc((mc - 1)*6 + mb) DO ma = 1, 11 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*11+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*11+ma) - kad((md-1)*11+ma) = kad((md-1)*11+ma)-tmp*p_bc - kac((mc-1)*11+ma) = kac((mc-1)*11+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma) + kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc + kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd END DO - kbd((md-1)*6+mb) = kbd((md-1)*6+mb)-ks_bd - kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb)-ks_bc + kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd + kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc END DO END DO END DO @@ -23874,18 +23874,18 @@ SUBROUTINE block_11_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 7 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*7+mb) - p_bc = pbc((mc-1)*7+mb) + p_bd = pbd((md - 1)*7 + mb) + p_bc = pbc((mc - 1)*7 + mb) DO ma = 1, 11 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*11+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*11+ma) - kad((md-1)*11+ma) = kad((md-1)*11+ma)-tmp*p_bc - kac((mc-1)*11+ma) = kac((mc-1)*11+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma) + kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc + kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd END DO - kbd((md-1)*7+mb) = kbd((md-1)*7+mb)-ks_bd - kbc((mc-1)*7+mb) = kbc((mc-1)*7+mb)-ks_bc + kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd + kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc END DO END DO END DO @@ -23924,18 +23924,18 @@ SUBROUTINE block_11_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 9 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*9+mb) - p_bc = pbc((mc-1)*9+mb) + p_bd = pbd((md - 1)*9 + mb) + p_bc = pbc((mc - 1)*9 + mb) DO ma = 1, 11 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*11+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*11+ma) - kad((md-1)*11+ma) = kad((md-1)*11+ma)-tmp*p_bc - kac((mc-1)*11+ma) = kac((mc-1)*11+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma) + kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc + kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd END DO - kbd((md-1)*9+mb) = kbd((md-1)*9+mb)-ks_bd - kbc((mc-1)*9+mb) = kbc((mc-1)*9+mb)-ks_bc + kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd + kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc END DO END DO END DO @@ -23974,18 +23974,18 @@ SUBROUTINE block_11_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, p DO mb = 1, 10 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*10+mb) - p_bc = pbc((mc-1)*10+mb) + p_bd = pbd((md - 1)*10 + mb) + p_bc = pbc((mc - 1)*10 + mb) DO ma = 1, 11 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*11+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*11+ma) - kad((md-1)*11+ma) = kad((md-1)*11+ma)-tmp*p_bc - kac((mc-1)*11+ma) = kac((mc-1)*11+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma) + kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc + kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd END DO - kbd((md-1)*10+mb) = kbd((md-1)*10+mb)-ks_bd - kbc((mc-1)*10+mb) = kbc((mc-1)*10+mb)-ks_bc + kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd + kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc END DO END DO END DO @@ -24024,18 +24024,18 @@ SUBROUTINE block_11_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, p DO mb = 1, 11 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*11+mb) - p_bc = pbc((mc-1)*11+mb) + p_bd = pbd((md - 1)*11 + mb) + p_bc = pbc((mc - 1)*11 + mb) DO ma = 1, 11 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*11+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*11+ma) - kad((md-1)*11+ma) = kad((md-1)*11+ma)-tmp*p_bc - kac((mc-1)*11+ma) = kac((mc-1)*11+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma) + kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc + kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd END DO - kbd((md-1)*11+mb) = kbd((md-1)*11+mb)-ks_bd - kbc((mc-1)*11+mb) = kbc((mc-1)*11+mb)-ks_bc + kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd + kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc END DO END DO END DO @@ -24074,18 +24074,18 @@ SUBROUTINE block_11_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, p DO mb = 1, 15 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*15+mb) - p_bc = pbc((mc-1)*15+mb) + p_bd = pbd((md - 1)*15 + mb) + p_bc = pbc((mc - 1)*15 + mb) DO ma = 1, 11 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*11+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*11+ma) - kad((md-1)*11+ma) = kad((md-1)*11+ma)-tmp*p_bc - kac((mc-1)*11+ma) = kac((mc-1)*11+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*11 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*11 + ma) + kad((md - 1)*11 + ma) = kad((md - 1)*11 + ma) - tmp*p_bc + kac((mc - 1)*11 + ma) = kac((mc - 1)*11 + ma) - tmp*p_bd END DO - kbd((md-1)*15+mb) = kbd((md-1)*15+mb)-ks_bd - kbc((mc-1)*15+mb) = kbc((mc-1)*15+mb)-ks_bc + kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd + kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc END DO END DO END DO @@ -24122,18 +24122,18 @@ SUBROUTINE block_15_1_1_1(kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, scale) DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 15 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*15+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*15+ma) - kad((md-1)*15+ma) = kad((md-1)*15+ma)-tmp*p_bc - kac((mc-1)*15+ma) = kac((mc-1)*15+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma) + kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc + kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -24170,18 +24170,18 @@ SUBROUTINE block_15_1_1(md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, prim, sc DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 15 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*15+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*15+ma) - kad((md-1)*15+ma) = kad((md-1)*15+ma)-tmp*p_bc - kac((mc-1)*15+ma) = kac((mc-1)*15+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma) + kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc + kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -24220,18 +24220,18 @@ SUBROUTINE block_15_1(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 1 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*1+mb) - p_bc = pbc((mc-1)*1+mb) + p_bd = pbd((md - 1)*1 + mb) + p_bc = pbc((mc - 1)*1 + mb) DO ma = 1, 15 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*15+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*15+ma) - kad((md-1)*15+ma) = kad((md-1)*15+ma)-tmp*p_bc - kac((mc-1)*15+ma) = kac((mc-1)*15+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma) + kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc + kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd END DO - kbd((md-1)*1+mb) = kbd((md-1)*1+mb)-ks_bd - kbc((mc-1)*1+mb) = kbc((mc-1)*1+mb)-ks_bc + kbd((md - 1)*1 + mb) = kbd((md - 1)*1 + mb) - ks_bd + kbc((mc - 1)*1 + mb) = kbc((mc - 1)*1 + mb) - ks_bc END DO END DO END DO @@ -24270,18 +24270,18 @@ SUBROUTINE block_15_2(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 2 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*2+mb) - p_bc = pbc((mc-1)*2+mb) + p_bd = pbd((md - 1)*2 + mb) + p_bc = pbc((mc - 1)*2 + mb) DO ma = 1, 15 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*15+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*15+ma) - kad((md-1)*15+ma) = kad((md-1)*15+ma)-tmp*p_bc - kac((mc-1)*15+ma) = kac((mc-1)*15+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma) + kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc + kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd END DO - kbd((md-1)*2+mb) = kbd((md-1)*2+mb)-ks_bd - kbc((mc-1)*2+mb) = kbc((mc-1)*2+mb)-ks_bc + kbd((md - 1)*2 + mb) = kbd((md - 1)*2 + mb) - ks_bd + kbc((mc - 1)*2 + mb) = kbc((mc - 1)*2 + mb) - ks_bc END DO END DO END DO @@ -24320,18 +24320,18 @@ SUBROUTINE block_15_3(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 3 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*3+mb) - p_bc = pbc((mc-1)*3+mb) + p_bd = pbd((md - 1)*3 + mb) + p_bc = pbc((mc - 1)*3 + mb) DO ma = 1, 15 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*15+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*15+ma) - kad((md-1)*15+ma) = kad((md-1)*15+ma)-tmp*p_bc - kac((mc-1)*15+ma) = kac((mc-1)*15+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma) + kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc + kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd END DO - kbd((md-1)*3+mb) = kbd((md-1)*3+mb)-ks_bd - kbc((mc-1)*3+mb) = kbc((mc-1)*3+mb)-ks_bc + kbd((md - 1)*3 + mb) = kbd((md - 1)*3 + mb) - ks_bd + kbc((mc - 1)*3 + mb) = kbc((mc - 1)*3 + mb) - ks_bc END DO END DO END DO @@ -24370,18 +24370,18 @@ SUBROUTINE block_15_4(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 4 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*4+mb) - p_bc = pbc((mc-1)*4+mb) + p_bd = pbd((md - 1)*4 + mb) + p_bc = pbc((mc - 1)*4 + mb) DO ma = 1, 15 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*15+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*15+ma) - kad((md-1)*15+ma) = kad((md-1)*15+ma)-tmp*p_bc - kac((mc-1)*15+ma) = kac((mc-1)*15+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma) + kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc + kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd END DO - kbd((md-1)*4+mb) = kbd((md-1)*4+mb)-ks_bd - kbc((mc-1)*4+mb) = kbc((mc-1)*4+mb)-ks_bc + kbd((md - 1)*4 + mb) = kbd((md - 1)*4 + mb) - ks_bd + kbc((mc - 1)*4 + mb) = kbc((mc - 1)*4 + mb) - ks_bc END DO END DO END DO @@ -24420,18 +24420,18 @@ SUBROUTINE block_15_5(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 5 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*5+mb) - p_bc = pbc((mc-1)*5+mb) + p_bd = pbd((md - 1)*5 + mb) + p_bc = pbc((mc - 1)*5 + mb) DO ma = 1, 15 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*15+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*15+ma) - kad((md-1)*15+ma) = kad((md-1)*15+ma)-tmp*p_bc - kac((mc-1)*15+ma) = kac((mc-1)*15+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma) + kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc + kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd END DO - kbd((md-1)*5+mb) = kbd((md-1)*5+mb)-ks_bd - kbc((mc-1)*5+mb) = kbc((mc-1)*5+mb)-ks_bc + kbd((md - 1)*5 + mb) = kbd((md - 1)*5 + mb) - ks_bd + kbc((mc - 1)*5 + mb) = kbc((mc - 1)*5 + mb) - ks_bc END DO END DO END DO @@ -24470,18 +24470,18 @@ SUBROUTINE block_15_6(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 6 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*6+mb) - p_bc = pbc((mc-1)*6+mb) + p_bd = pbd((md - 1)*6 + mb) + p_bc = pbc((mc - 1)*6 + mb) DO ma = 1, 15 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*15+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*15+ma) - kad((md-1)*15+ma) = kad((md-1)*15+ma)-tmp*p_bc - kac((mc-1)*15+ma) = kac((mc-1)*15+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma) + kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc + kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd END DO - kbd((md-1)*6+mb) = kbd((md-1)*6+mb)-ks_bd - kbc((mc-1)*6+mb) = kbc((mc-1)*6+mb)-ks_bc + kbd((md - 1)*6 + mb) = kbd((md - 1)*6 + mb) - ks_bd + kbc((mc - 1)*6 + mb) = kbc((mc - 1)*6 + mb) - ks_bc END DO END DO END DO @@ -24520,18 +24520,18 @@ SUBROUTINE block_15_7(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 7 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*7+mb) - p_bc = pbc((mc-1)*7+mb) + p_bd = pbd((md - 1)*7 + mb) + p_bc = pbc((mc - 1)*7 + mb) DO ma = 1, 15 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*15+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*15+ma) - kad((md-1)*15+ma) = kad((md-1)*15+ma)-tmp*p_bc - kac((mc-1)*15+ma) = kac((mc-1)*15+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma) + kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc + kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd END DO - kbd((md-1)*7+mb) = kbd((md-1)*7+mb)-ks_bd - kbc((mc-1)*7+mb) = kbc((mc-1)*7+mb)-ks_bc + kbd((md - 1)*7 + mb) = kbd((md - 1)*7 + mb) - ks_bd + kbc((mc - 1)*7 + mb) = kbc((mc - 1)*7 + mb) - ks_bc END DO END DO END DO @@ -24570,18 +24570,18 @@ SUBROUTINE block_15_9(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, pr DO mb = 1, 9 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*9+mb) - p_bc = pbc((mc-1)*9+mb) + p_bd = pbd((md - 1)*9 + mb) + p_bc = pbc((mc - 1)*9 + mb) DO ma = 1, 15 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*15+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*15+ma) - kad((md-1)*15+ma) = kad((md-1)*15+ma)-tmp*p_bc - kac((mc-1)*15+ma) = kac((mc-1)*15+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma) + kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc + kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd END DO - kbd((md-1)*9+mb) = kbd((md-1)*9+mb)-ks_bd - kbc((mc-1)*9+mb) = kbc((mc-1)*9+mb)-ks_bc + kbd((md - 1)*9 + mb) = kbd((md - 1)*9 + mb) - ks_bd + kbc((mc - 1)*9 + mb) = kbc((mc - 1)*9 + mb) - ks_bc END DO END DO END DO @@ -24620,18 +24620,18 @@ SUBROUTINE block_15_10(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, p DO mb = 1, 10 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*10+mb) - p_bc = pbc((mc-1)*10+mb) + p_bd = pbd((md - 1)*10 + mb) + p_bc = pbc((mc - 1)*10 + mb) DO ma = 1, 15 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*15+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*15+ma) - kad((md-1)*15+ma) = kad((md-1)*15+ma)-tmp*p_bc - kac((mc-1)*15+ma) = kac((mc-1)*15+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma) + kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc + kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd END DO - kbd((md-1)*10+mb) = kbd((md-1)*10+mb)-ks_bd - kbc((mc-1)*10+mb) = kbc((mc-1)*10+mb)-ks_bc + kbd((md - 1)*10 + mb) = kbd((md - 1)*10 + mb) - ks_bd + kbc((mc - 1)*10 + mb) = kbc((mc - 1)*10 + mb) - ks_bc END DO END DO END DO @@ -24670,18 +24670,18 @@ SUBROUTINE block_15_11(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, p DO mb = 1, 11 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*11+mb) - p_bc = pbc((mc-1)*11+mb) + p_bd = pbd((md - 1)*11 + mb) + p_bc = pbc((mc - 1)*11 + mb) DO ma = 1, 15 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*15+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*15+ma) - kad((md-1)*15+ma) = kad((md-1)*15+ma)-tmp*p_bc - kac((mc-1)*15+ma) = kac((mc-1)*15+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma) + kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc + kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd END DO - kbd((md-1)*11+mb) = kbd((md-1)*11+mb)-ks_bd - kbc((mc-1)*11+mb) = kbc((mc-1)*11+mb)-ks_bc + kbd((md - 1)*11 + mb) = kbd((md - 1)*11 + mb) - ks_bd + kbc((mc - 1)*11 + mb) = kbc((mc - 1)*11 + mb) - ks_bc END DO END DO END DO @@ -24720,18 +24720,18 @@ SUBROUTINE block_15_15(mc_max, md_max, kbd, kbc, kad, kac, pbd, pbc, pad, pac, p DO mb = 1, 15 ks_bd = 0.0_dp ks_bc = 0.0_dp - p_bd = pbd((md-1)*15+mb) - p_bc = pbc((mc-1)*15+mb) + p_bd = pbd((md - 1)*15 + mb) + p_bc = pbc((mc - 1)*15 + mb) DO ma = 1, 15 - p_index = p_index+1 + p_index = p_index + 1 tmp = scale*prim(p_index) - ks_bc = ks_bc+tmp*pad((md-1)*15+ma) - ks_bd = ks_bd+tmp*pac((mc-1)*15+ma) - kad((md-1)*15+ma) = kad((md-1)*15+ma)-tmp*p_bc - kac((mc-1)*15+ma) = kac((mc-1)*15+ma)-tmp*p_bd + ks_bc = ks_bc + tmp*pad((md - 1)*15 + ma) + ks_bd = ks_bd + tmp*pac((mc - 1)*15 + ma) + kad((md - 1)*15 + ma) = kad((md - 1)*15 + ma) - tmp*p_bc + kac((mc - 1)*15 + ma) = kac((mc - 1)*15 + ma) - tmp*p_bd END DO - kbd((md-1)*15+mb) = kbd((md-1)*15+mb)-ks_bd - kbc((mc-1)*15+mb) = kbc((mc-1)*15+mb)-ks_bc + kbd((md - 1)*15 + mb) = kbd((md - 1)*15 + mb) - ks_bd + kbc((mc - 1)*15 + mb) = kbc((mc - 1)*15 + mb) - ks_bc END DO END DO END DO diff --git a/src/hfxbase/hfx_contraction_methods.F b/src/hfxbase/hfx_contraction_methods.F index b734b71255..0c8cf6f90c 100644 --- a/src/hfxbase/hfx_contraction_methods.F +++ b/src/hfxbase/hfx_contraction_methods.F @@ -12654,21 +12654,21 @@ SUBROUTINE contract_ssss(work, & imax = 1*1*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*1*1 @@ -12677,20 +12677,20 @@ SUBROUTINE contract_ssss(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_ssss #endif @@ -12742,21 +12742,21 @@ SUBROUTINE contract_sssp(work, & imax = 1*1*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*1*1 @@ -12765,26 +12765,26 @@ SUBROUTINE contract_sssp(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sssp #endif @@ -12835,19 +12835,19 @@ SUBROUTINE contract_sssd(work, & imax = 1*1*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*1*1 @@ -12856,41 +12856,41 @@ SUBROUTINE contract_sssd(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sssd #endif @@ -12941,19 +12941,19 @@ SUBROUTINE contract_sssf(work, & imax = 1*1*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*1*1 kmax = 10 @@ -12961,65 +12961,65 @@ SUBROUTINE contract_sssf(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sssf #endif @@ -13070,19 +13070,19 @@ SUBROUTINE contract_sssg(work, & imax = 1*1*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*1*1 kmax = 15 @@ -13090,101 +13090,101 @@ SUBROUTINE contract_sssg(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sssg #endif @@ -13235,21 +13235,21 @@ SUBROUTINE contract_ssps(work, & imax = 1*3*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*1*3 kmax = 1 @@ -13257,20 +13257,20 @@ SUBROUTINE contract_ssps(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_ssps #endif @@ -13321,21 +13321,21 @@ SUBROUTINE contract_sspp(work, & imax = 1*3*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*1*3 kmax = 3 @@ -13343,26 +13343,26 @@ SUBROUTINE contract_sspp(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sspp #endif @@ -13413,21 +13413,21 @@ SUBROUTINE contract_sspd(work, & imax = 1*3*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*1*3 kmax = 6 @@ -13435,41 +13435,41 @@ SUBROUTINE contract_sspd(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sspd #endif @@ -13520,21 +13520,21 @@ SUBROUTINE contract_sspf(work, & imax = 1*3*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*1*3 kmax = 10 @@ -13542,65 +13542,65 @@ SUBROUTINE contract_sspf(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sspf #endif @@ -13651,21 +13651,21 @@ SUBROUTINE contract_sspg(work, & imax = 1*3*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*1*3 kmax = 15 @@ -13673,101 +13673,101 @@ SUBROUTINE contract_sspg(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sspg #endif @@ -13818,26 +13818,26 @@ SUBROUTINE contract_ssds(work, & imax = 1*6*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*1*5 kmax = 1 @@ -13845,20 +13845,20 @@ SUBROUTINE contract_ssds(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_ssds #endif @@ -13909,26 +13909,26 @@ SUBROUTINE contract_ssdp(work, & imax = 1*6*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*1*5 kmax = 3 @@ -13936,26 +13936,26 @@ SUBROUTINE contract_ssdp(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_ssdp #endif @@ -14006,26 +14006,26 @@ SUBROUTINE contract_ssdd(work, & imax = 1*6*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*1*5 kmax = 6 @@ -14033,41 +14033,41 @@ SUBROUTINE contract_ssdd(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_ssdd #endif @@ -14118,26 +14118,26 @@ SUBROUTINE contract_ssdf(work, & imax = 1*6*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*1*5 kmax = 10 @@ -14145,65 +14145,65 @@ SUBROUTINE contract_ssdf(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_ssdf #endif @@ -14254,26 +14254,26 @@ SUBROUTINE contract_ssdg(work, & imax = 1*6*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*1*5 kmax = 15 @@ -14281,101 +14281,101 @@ SUBROUTINE contract_ssdg(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_ssdg #endif @@ -14426,34 +14426,34 @@ SUBROUTINE contract_ssfs(work, & imax = 1*10*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*1*7 kmax = 1 @@ -14461,20 +14461,20 @@ SUBROUTINE contract_ssfs(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_ssfs #endif @@ -14525,34 +14525,34 @@ SUBROUTINE contract_ssfp(work, & imax = 1*10*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*1*7 kmax = 3 @@ -14560,26 +14560,26 @@ SUBROUTINE contract_ssfp(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_ssfp #endif @@ -14630,34 +14630,34 @@ SUBROUTINE contract_ssfd(work, & imax = 1*10*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*1*7 kmax = 6 @@ -14665,41 +14665,41 @@ SUBROUTINE contract_ssfd(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_ssfd #endif @@ -14750,34 +14750,34 @@ SUBROUTINE contract_ssff(work, & imax = 1*10*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*1*7 kmax = 10 @@ -14785,65 +14785,65 @@ SUBROUTINE contract_ssff(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_ssff #endif @@ -14894,34 +14894,34 @@ SUBROUTINE contract_ssfg(work, & imax = 1*10*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*1*7 kmax = 15 @@ -14929,101 +14929,101 @@ SUBROUTINE contract_ssfg(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_ssfg #endif @@ -15074,46 +15074,46 @@ SUBROUTINE contract_ssgs(work, & imax = 1*15*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*1*9 kmax = 1 @@ -15121,20 +15121,20 @@ SUBROUTINE contract_ssgs(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_ssgs #endif @@ -15185,46 +15185,46 @@ SUBROUTINE contract_ssgp(work, & imax = 1*15*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*1*9 kmax = 3 @@ -15232,26 +15232,26 @@ SUBROUTINE contract_ssgp(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_ssgp #endif @@ -15302,46 +15302,46 @@ SUBROUTINE contract_ssgd(work, & imax = 1*15*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*1*9 kmax = 6 @@ -15349,41 +15349,41 @@ SUBROUTINE contract_ssgd(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_ssgd #endif @@ -15434,46 +15434,46 @@ SUBROUTINE contract_ssgf(work, & imax = 1*15*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*1*9 kmax = 10 @@ -15481,65 +15481,65 @@ SUBROUTINE contract_ssgf(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_ssgf #endif @@ -15590,46 +15590,46 @@ SUBROUTINE contract_ssgg(work, & imax = 1*15*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*1*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*1*9 kmax = 15 @@ -15637,101 +15637,101 @@ SUBROUTINE contract_ssgg(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_ssgg #endif @@ -15782,21 +15782,21 @@ SUBROUTINE contract_spss(work, & imax = 3*1*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*3*1 kmax = 1 @@ -15804,20 +15804,20 @@ SUBROUTINE contract_spss(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_spss #endif @@ -15868,21 +15868,21 @@ SUBROUTINE contract_spsp(work, & imax = 3*1*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*3*1 kmax = 3 @@ -15890,26 +15890,26 @@ SUBROUTINE contract_spsp(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_spsp #endif @@ -15960,21 +15960,21 @@ SUBROUTINE contract_spsd(work, & imax = 3*1*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*3*1 kmax = 6 @@ -15982,41 +15982,41 @@ SUBROUTINE contract_spsd(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_spsd #endif @@ -16067,21 +16067,21 @@ SUBROUTINE contract_spsf(work, & imax = 3*1*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*3*1 kmax = 10 @@ -16089,65 +16089,65 @@ SUBROUTINE contract_spsf(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_spsf #endif @@ -16198,21 +16198,21 @@ SUBROUTINE contract_spsg(work, & imax = 3*1*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*3*1 kmax = 15 @@ -16220,101 +16220,101 @@ SUBROUTINE contract_spsg(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_spsg #endif @@ -16365,23 +16365,23 @@ SUBROUTINE contract_spps(work, & imax = 3*3*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*3*3 kmax = 1 @@ -16389,20 +16389,20 @@ SUBROUTINE contract_spps(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_spps #endif @@ -16453,23 +16453,23 @@ SUBROUTINE contract_sppp(work, & imax = 3*3*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*3*3 kmax = 3 @@ -16477,26 +16477,26 @@ SUBROUTINE contract_sppp(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sppp #endif @@ -16547,23 +16547,23 @@ SUBROUTINE contract_sppd(work, & imax = 3*3*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*3*3 kmax = 6 @@ -16571,41 +16571,41 @@ SUBROUTINE contract_sppd(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sppd #endif @@ -16656,23 +16656,23 @@ SUBROUTINE contract_sppf(work, & imax = 3*3*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*3*3 kmax = 10 @@ -16680,65 +16680,65 @@ SUBROUTINE contract_sppf(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sppf #endif @@ -16789,23 +16789,23 @@ SUBROUTINE contract_sppg(work, & imax = 3*3*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*3*3 kmax = 15 @@ -16813,101 +16813,101 @@ SUBROUTINE contract_sppg(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sppg #endif @@ -16958,28 +16958,28 @@ SUBROUTINE contract_spds(work, & imax = 3*6*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*3*5 kmax = 1 @@ -16987,20 +16987,20 @@ SUBROUTINE contract_spds(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_spds #endif @@ -17051,28 +17051,28 @@ SUBROUTINE contract_spdp(work, & imax = 3*6*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*3*5 kmax = 3 @@ -17080,26 +17080,26 @@ SUBROUTINE contract_spdp(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_spdp #endif @@ -17150,28 +17150,28 @@ SUBROUTINE contract_spdd(work, & imax = 3*6*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*3*5 kmax = 6 @@ -17179,41 +17179,41 @@ SUBROUTINE contract_spdd(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_spdd #endif @@ -17264,28 +17264,28 @@ SUBROUTINE contract_spdf(work, & imax = 3*6*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*3*5 kmax = 10 @@ -17293,65 +17293,65 @@ SUBROUTINE contract_spdf(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_spdf #endif @@ -17402,28 +17402,28 @@ SUBROUTINE contract_spdg(work, & imax = 3*6*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*3*5 kmax = 15 @@ -17431,101 +17431,101 @@ SUBROUTINE contract_spdg(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_spdg #endif @@ -17576,36 +17576,36 @@ SUBROUTINE contract_spfs(work, & imax = 3*10*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*3*7 kmax = 1 @@ -17613,20 +17613,20 @@ SUBROUTINE contract_spfs(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_spfs #endif @@ -17677,36 +17677,36 @@ SUBROUTINE contract_spfp(work, & imax = 3*10*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*3*7 kmax = 3 @@ -17714,26 +17714,26 @@ SUBROUTINE contract_spfp(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_spfp #endif @@ -17784,36 +17784,36 @@ SUBROUTINE contract_spfd(work, & imax = 3*10*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*3*7 kmax = 6 @@ -17821,41 +17821,41 @@ SUBROUTINE contract_spfd(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_spfd #endif @@ -17906,36 +17906,36 @@ SUBROUTINE contract_spff(work, & imax = 3*10*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*3*7 kmax = 10 @@ -17943,65 +17943,65 @@ SUBROUTINE contract_spff(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_spff #endif @@ -18052,36 +18052,36 @@ SUBROUTINE contract_spfg(work, & imax = 3*10*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*3*7 kmax = 15 @@ -18089,101 +18089,101 @@ SUBROUTINE contract_spfg(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_spfg #endif @@ -18234,48 +18234,48 @@ SUBROUTINE contract_spgs(work, & imax = 3*15*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*3*9 kmax = 1 @@ -18283,20 +18283,20 @@ SUBROUTINE contract_spgs(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_spgs #endif @@ -18347,48 +18347,48 @@ SUBROUTINE contract_spgp(work, & imax = 3*15*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*3*9 kmax = 3 @@ -18396,26 +18396,26 @@ SUBROUTINE contract_spgp(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_spgp #endif @@ -18466,48 +18466,48 @@ SUBROUTINE contract_spgd(work, & imax = 3*15*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*3*9 kmax = 6 @@ -18515,41 +18515,41 @@ SUBROUTINE contract_spgd(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_spgd #endif @@ -18600,48 +18600,48 @@ SUBROUTINE contract_spgf(work, & imax = 3*15*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*3*9 kmax = 10 @@ -18649,65 +18649,65 @@ SUBROUTINE contract_spgf(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_spgf #endif @@ -18758,48 +18758,48 @@ SUBROUTINE contract_spgg(work, & imax = 3*15*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*3*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*3*9 kmax = 15 @@ -18807,101 +18807,101 @@ SUBROUTINE contract_spgg(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_spgg #endif @@ -18952,26 +18952,26 @@ SUBROUTINE contract_sdss(work, & imax = 6*1*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*5*1 kmax = 1 @@ -18979,20 +18979,20 @@ SUBROUTINE contract_sdss(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sdss #endif @@ -19043,26 +19043,26 @@ SUBROUTINE contract_sdsp(work, & imax = 6*1*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*5*1 kmax = 3 @@ -19070,26 +19070,26 @@ SUBROUTINE contract_sdsp(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sdsp #endif @@ -19140,26 +19140,26 @@ SUBROUTINE contract_sdsd(work, & imax = 6*1*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*5*1 kmax = 6 @@ -19167,41 +19167,41 @@ SUBROUTINE contract_sdsd(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sdsd #endif @@ -19252,26 +19252,26 @@ SUBROUTINE contract_sdsf(work, & imax = 6*1*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*5*1 kmax = 10 @@ -19279,65 +19279,65 @@ SUBROUTINE contract_sdsf(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sdsf #endif @@ -19388,26 +19388,26 @@ SUBROUTINE contract_sdsg(work, & imax = 6*1*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*5*1 kmax = 15 @@ -19415,101 +19415,101 @@ SUBROUTINE contract_sdsg(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sdsg #endif @@ -19560,28 +19560,28 @@ SUBROUTINE contract_sdps(work, & imax = 6*3*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*5*3 kmax = 1 @@ -19589,20 +19589,20 @@ SUBROUTINE contract_sdps(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sdps #endif @@ -19653,28 +19653,28 @@ SUBROUTINE contract_sdpp(work, & imax = 6*3*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*5*3 kmax = 3 @@ -19682,26 +19682,26 @@ SUBROUTINE contract_sdpp(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sdpp #endif @@ -19752,28 +19752,28 @@ SUBROUTINE contract_sdpd(work, & imax = 6*3*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*5*3 kmax = 6 @@ -19781,41 +19781,41 @@ SUBROUTINE contract_sdpd(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sdpd #endif @@ -19866,28 +19866,28 @@ SUBROUTINE contract_sdpf(work, & imax = 6*3*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*5*3 kmax = 10 @@ -19895,65 +19895,65 @@ SUBROUTINE contract_sdpf(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sdpf #endif @@ -20004,28 +20004,28 @@ SUBROUTINE contract_sdpg(work, & imax = 6*3*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*5*3 kmax = 15 @@ -20033,101 +20033,101 @@ SUBROUTINE contract_sdpg(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sdpg #endif @@ -20178,33 +20178,33 @@ SUBROUTINE contract_sdds(work, & imax = 6*6*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*5*5 kmax = 1 @@ -20212,20 +20212,20 @@ SUBROUTINE contract_sdds(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sdds #endif @@ -20276,33 +20276,33 @@ SUBROUTINE contract_sddp(work, & imax = 6*6*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*5*5 kmax = 3 @@ -20310,26 +20310,26 @@ SUBROUTINE contract_sddp(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sddp #endif @@ -20380,33 +20380,33 @@ SUBROUTINE contract_sddd(work, & imax = 6*6*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*5*5 kmax = 6 @@ -20414,41 +20414,41 @@ SUBROUTINE contract_sddd(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sddd #endif @@ -20499,33 +20499,33 @@ SUBROUTINE contract_sddf(work, & imax = 6*6*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*5*5 kmax = 10 @@ -20533,65 +20533,65 @@ SUBROUTINE contract_sddf(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sddf #endif @@ -20642,33 +20642,33 @@ SUBROUTINE contract_sddg(work, & imax = 6*6*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*5*5 kmax = 15 @@ -20676,101 +20676,101 @@ SUBROUTINE contract_sddg(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sddg #endif @@ -20821,41 +20821,41 @@ SUBROUTINE contract_sdfs(work, & imax = 6*10*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*5*7 kmax = 1 @@ -20863,20 +20863,20 @@ SUBROUTINE contract_sdfs(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sdfs #endif @@ -20927,41 +20927,41 @@ SUBROUTINE contract_sdfp(work, & imax = 6*10*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*5*7 kmax = 3 @@ -20969,26 +20969,26 @@ SUBROUTINE contract_sdfp(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sdfp #endif @@ -21039,41 +21039,41 @@ SUBROUTINE contract_sdfd(work, & imax = 6*10*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*5*7 kmax = 6 @@ -21081,41 +21081,41 @@ SUBROUTINE contract_sdfd(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sdfd #endif @@ -21166,41 +21166,41 @@ SUBROUTINE contract_sdff(work, & imax = 6*10*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*5*7 kmax = 10 @@ -21208,65 +21208,65 @@ SUBROUTINE contract_sdff(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sdff #endif @@ -21317,41 +21317,41 @@ SUBROUTINE contract_sdfg(work, & imax = 6*10*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*5*7 kmax = 15 @@ -21359,101 +21359,101 @@ SUBROUTINE contract_sdfg(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sdfg #endif @@ -21504,53 +21504,53 @@ SUBROUTINE contract_sdgs(work, & imax = 6*15*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*5*9 kmax = 1 @@ -21558,20 +21558,20 @@ SUBROUTINE contract_sdgs(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sdgs #endif @@ -21622,53 +21622,53 @@ SUBROUTINE contract_sdgp(work, & imax = 6*15*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*5*9 kmax = 3 @@ -21676,26 +21676,26 @@ SUBROUTINE contract_sdgp(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sdgp #endif @@ -21746,53 +21746,53 @@ SUBROUTINE contract_sdgd(work, & imax = 6*15*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*5*9 kmax = 6 @@ -21800,41 +21800,41 @@ SUBROUTINE contract_sdgd(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sdgd #endif @@ -21885,53 +21885,53 @@ SUBROUTINE contract_sdgf(work, & imax = 6*15*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*5*9 kmax = 10 @@ -21939,65 +21939,65 @@ SUBROUTINE contract_sdgf(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sdgf #endif @@ -22048,53 +22048,53 @@ SUBROUTINE contract_sdgg(work, & imax = 6*15*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*5*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*5*9 kmax = 15 @@ -22102,101 +22102,101 @@ SUBROUTINE contract_sdgg(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sdgg #endif @@ -22247,34 +22247,34 @@ SUBROUTINE contract_sfss(work, & imax = 10*1*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*7*1 kmax = 1 @@ -22282,20 +22282,20 @@ SUBROUTINE contract_sfss(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sfss #endif @@ -22346,34 +22346,34 @@ SUBROUTINE contract_sfsp(work, & imax = 10*1*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*7*1 kmax = 3 @@ -22381,26 +22381,26 @@ SUBROUTINE contract_sfsp(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sfsp #endif @@ -22451,34 +22451,34 @@ SUBROUTINE contract_sfsd(work, & imax = 10*1*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*7*1 kmax = 6 @@ -22486,41 +22486,41 @@ SUBROUTINE contract_sfsd(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sfsd #endif @@ -22571,34 +22571,34 @@ SUBROUTINE contract_sfsf(work, & imax = 10*1*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*7*1 kmax = 10 @@ -22606,65 +22606,65 @@ SUBROUTINE contract_sfsf(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sfsf #endif @@ -22715,34 +22715,34 @@ SUBROUTINE contract_sfsg(work, & imax = 10*1*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*7*1 kmax = 15 @@ -22750,101 +22750,101 @@ SUBROUTINE contract_sfsg(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sfsg #endif @@ -22895,36 +22895,36 @@ SUBROUTINE contract_sfps(work, & imax = 10*3*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*7*3 kmax = 1 @@ -22932,20 +22932,20 @@ SUBROUTINE contract_sfps(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sfps #endif @@ -22996,36 +22996,36 @@ SUBROUTINE contract_sfpp(work, & imax = 10*3*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*7*3 kmax = 3 @@ -23033,26 +23033,26 @@ SUBROUTINE contract_sfpp(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sfpp #endif @@ -23103,36 +23103,36 @@ SUBROUTINE contract_sfpd(work, & imax = 10*3*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*7*3 kmax = 6 @@ -23140,41 +23140,41 @@ SUBROUTINE contract_sfpd(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sfpd #endif @@ -23225,36 +23225,36 @@ SUBROUTINE contract_sfpf(work, & imax = 10*3*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*7*3 kmax = 10 @@ -23262,65 +23262,65 @@ SUBROUTINE contract_sfpf(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sfpf #endif @@ -23371,36 +23371,36 @@ SUBROUTINE contract_sfpg(work, & imax = 10*3*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*7*3 kmax = 15 @@ -23408,101 +23408,101 @@ SUBROUTINE contract_sfpg(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sfpg #endif @@ -23553,41 +23553,41 @@ SUBROUTINE contract_sfds(work, & imax = 10*6*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*7*5 kmax = 1 @@ -23595,20 +23595,20 @@ SUBROUTINE contract_sfds(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sfds #endif @@ -23659,41 +23659,41 @@ SUBROUTINE contract_sfdp(work, & imax = 10*6*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*7*5 kmax = 3 @@ -23701,26 +23701,26 @@ SUBROUTINE contract_sfdp(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sfdp #endif @@ -23771,41 +23771,41 @@ SUBROUTINE contract_sfdd(work, & imax = 10*6*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*7*5 kmax = 6 @@ -23813,41 +23813,41 @@ SUBROUTINE contract_sfdd(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sfdd #endif @@ -23898,41 +23898,41 @@ SUBROUTINE contract_sfdf(work, & imax = 10*6*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*7*5 kmax = 10 @@ -23940,65 +23940,65 @@ SUBROUTINE contract_sfdf(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sfdf #endif @@ -24049,41 +24049,41 @@ SUBROUTINE contract_sfdg(work, & imax = 10*6*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*7*5 kmax = 15 @@ -24091,101 +24091,101 @@ SUBROUTINE contract_sfdg(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sfdg #endif @@ -24236,49 +24236,49 @@ SUBROUTINE contract_sffs(work, & imax = 10*10*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*7*7 kmax = 1 @@ -24286,20 +24286,20 @@ SUBROUTINE contract_sffs(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sffs #endif @@ -24350,49 +24350,49 @@ SUBROUTINE contract_sffp(work, & imax = 10*10*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*7*7 kmax = 3 @@ -24400,26 +24400,26 @@ SUBROUTINE contract_sffp(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sffp #endif @@ -24470,49 +24470,49 @@ SUBROUTINE contract_sffd(work, & imax = 10*10*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*7*7 kmax = 6 @@ -24520,41 +24520,41 @@ SUBROUTINE contract_sffd(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sffd #endif @@ -24605,49 +24605,49 @@ SUBROUTINE contract_sfff(work, & imax = 10*10*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*7*7 kmax = 10 @@ -24655,65 +24655,65 @@ SUBROUTINE contract_sfff(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sfff #endif @@ -24764,49 +24764,49 @@ SUBROUTINE contract_sffg(work, & imax = 10*10*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*7*7 kmax = 15 @@ -24814,101 +24814,101 @@ SUBROUTINE contract_sffg(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sffg #endif @@ -24959,61 +24959,61 @@ SUBROUTINE contract_sfgs(work, & imax = 10*15*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*7*9 kmax = 1 @@ -25021,20 +25021,20 @@ SUBROUTINE contract_sfgs(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sfgs #endif @@ -25085,61 +25085,61 @@ SUBROUTINE contract_sfgp(work, & imax = 10*15*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*7*9 kmax = 3 @@ -25147,26 +25147,26 @@ SUBROUTINE contract_sfgp(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sfgp #endif @@ -25217,61 +25217,61 @@ SUBROUTINE contract_sfgd(work, & imax = 10*15*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*7*9 kmax = 6 @@ -25279,41 +25279,41 @@ SUBROUTINE contract_sfgd(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sfgd #endif @@ -25364,61 +25364,61 @@ SUBROUTINE contract_sfgf(work, & imax = 10*15*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*7*9 kmax = 10 @@ -25426,65 +25426,65 @@ SUBROUTINE contract_sfgf(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sfgf #endif @@ -25535,61 +25535,61 @@ SUBROUTINE contract_sfgg(work, & imax = 10*15*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*7*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*7*9 kmax = 15 @@ -25597,101 +25597,101 @@ SUBROUTINE contract_sfgg(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sfgg #endif @@ -25742,46 +25742,46 @@ SUBROUTINE contract_sgss(work, & imax = 15*1*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*9*1 kmax = 1 @@ -25789,20 +25789,20 @@ SUBROUTINE contract_sgss(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sgss #endif @@ -25853,46 +25853,46 @@ SUBROUTINE contract_sgsp(work, & imax = 15*1*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*9*1 kmax = 3 @@ -25900,26 +25900,26 @@ SUBROUTINE contract_sgsp(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sgsp #endif @@ -25970,46 +25970,46 @@ SUBROUTINE contract_sgsd(work, & imax = 15*1*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*9*1 kmax = 6 @@ -26017,41 +26017,41 @@ SUBROUTINE contract_sgsd(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sgsd #endif @@ -26102,46 +26102,46 @@ SUBROUTINE contract_sgsf(work, & imax = 15*1*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*9*1 kmax = 10 @@ -26149,65 +26149,65 @@ SUBROUTINE contract_sgsf(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sgsf #endif @@ -26258,46 +26258,46 @@ SUBROUTINE contract_sgsg(work, & imax = 15*1*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*1*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 1*9*1 kmax = 15 @@ -26305,101 +26305,101 @@ SUBROUTINE contract_sgsg(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sgsg #endif @@ -26450,48 +26450,48 @@ SUBROUTINE contract_sgps(work, & imax = 15*3*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*9*3 kmax = 1 @@ -26499,20 +26499,20 @@ SUBROUTINE contract_sgps(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sgps #endif @@ -26563,48 +26563,48 @@ SUBROUTINE contract_sgpp(work, & imax = 15*3*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*9*3 kmax = 3 @@ -26612,26 +26612,26 @@ SUBROUTINE contract_sgpp(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sgpp #endif @@ -26682,48 +26682,48 @@ SUBROUTINE contract_sgpd(work, & imax = 15*3*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*9*3 kmax = 6 @@ -26731,41 +26731,41 @@ SUBROUTINE contract_sgpd(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sgpd #endif @@ -26816,48 +26816,48 @@ SUBROUTINE contract_sgpf(work, & imax = 15*3*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*9*3 kmax = 10 @@ -26865,65 +26865,65 @@ SUBROUTINE contract_sgpf(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sgpf #endif @@ -26974,48 +26974,48 @@ SUBROUTINE contract_sgpg(work, & imax = 15*3*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*3*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 1*9*3 kmax = 15 @@ -27023,101 +27023,101 @@ SUBROUTINE contract_sgpg(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sgpg #endif @@ -27168,53 +27168,53 @@ SUBROUTINE contract_sgds(work, & imax = 15*6*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*9*5 kmax = 1 @@ -27222,20 +27222,20 @@ SUBROUTINE contract_sgds(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sgds #endif @@ -27286,53 +27286,53 @@ SUBROUTINE contract_sgdp(work, & imax = 15*6*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*9*5 kmax = 3 @@ -27340,26 +27340,26 @@ SUBROUTINE contract_sgdp(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sgdp #endif @@ -27410,53 +27410,53 @@ SUBROUTINE contract_sgdd(work, & imax = 15*6*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*9*5 kmax = 6 @@ -27464,41 +27464,41 @@ SUBROUTINE contract_sgdd(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sgdd #endif @@ -27549,53 +27549,53 @@ SUBROUTINE contract_sgdf(work, & imax = 15*6*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*9*5 kmax = 10 @@ -27603,65 +27603,65 @@ SUBROUTINE contract_sgdf(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sgdf #endif @@ -27712,53 +27712,53 @@ SUBROUTINE contract_sgdg(work, & imax = 15*6*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*6*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 1*9*5 kmax = 15 @@ -27766,101 +27766,101 @@ SUBROUTINE contract_sgdg(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sgdg #endif @@ -27911,61 +27911,61 @@ SUBROUTINE contract_sgfs(work, & imax = 15*10*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*9*7 kmax = 1 @@ -27973,20 +27973,20 @@ SUBROUTINE contract_sgfs(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sgfs #endif @@ -28037,61 +28037,61 @@ SUBROUTINE contract_sgfp(work, & imax = 15*10*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*9*7 kmax = 3 @@ -28099,26 +28099,26 @@ SUBROUTINE contract_sgfp(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sgfp #endif @@ -28169,61 +28169,61 @@ SUBROUTINE contract_sgfd(work, & imax = 15*10*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*9*7 kmax = 6 @@ -28231,41 +28231,41 @@ SUBROUTINE contract_sgfd(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sgfd #endif @@ -28316,61 +28316,61 @@ SUBROUTINE contract_sgff(work, & imax = 15*10*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*9*7 kmax = 10 @@ -28378,65 +28378,65 @@ SUBROUTINE contract_sgff(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sgff #endif @@ -28487,61 +28487,61 @@ SUBROUTINE contract_sgfg(work, & imax = 15*10*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*10*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 1*9*7 kmax = 15 @@ -28549,101 +28549,101 @@ SUBROUTINE contract_sgfg(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sgfg #endif @@ -28694,73 +28694,73 @@ SUBROUTINE contract_sggs(work, & imax = 15*15*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*9*9 kmax = 1 @@ -28768,20 +28768,20 @@ SUBROUTINE contract_sggs(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sggs #endif @@ -28832,73 +28832,73 @@ SUBROUTINE contract_sggp(work, & imax = 15*15*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*9*9 kmax = 3 @@ -28906,26 +28906,26 @@ SUBROUTINE contract_sggp(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+1 + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sggp #endif @@ -28976,73 +28976,73 @@ SUBROUTINE contract_sggd(work, & imax = 15*15*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*9*9 kmax = 6 @@ -29050,41 +29050,41 @@ SUBROUTINE contract_sggd(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sggd #endif @@ -29135,73 +29135,73 @@ SUBROUTINE contract_sggf(work, & imax = 15*15*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*9*9 kmax = 10 @@ -29209,65 +29209,65 @@ SUBROUTINE contract_sggf(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sggf #endif @@ -29318,73 +29318,73 @@ SUBROUTINE contract_sggg(work, & imax = 15*15*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 1*15*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 1*9*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 1*9*9 kmax = 15 @@ -29392,101 +29392,101 @@ SUBROUTINE contract_sggg(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 1 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+1 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 1 END DO END SUBROUTINE contract_sggg #endif @@ -29537,21 +29537,21 @@ SUBROUTINE contract_psss(work, & imax = 1*1*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*1*1 kmax = 1 @@ -29559,20 +29559,20 @@ SUBROUTINE contract_psss(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_psss #endif @@ -29623,21 +29623,21 @@ SUBROUTINE contract_pssp(work, & imax = 1*1*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*1*1 kmax = 3 @@ -29645,26 +29645,26 @@ SUBROUTINE contract_pssp(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pssp #endif @@ -29715,21 +29715,21 @@ SUBROUTINE contract_pssd(work, & imax = 1*1*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*1*1 kmax = 6 @@ -29737,41 +29737,41 @@ SUBROUTINE contract_pssd(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pssd #endif @@ -29822,21 +29822,21 @@ SUBROUTINE contract_pssf(work, & imax = 1*1*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*1*1 kmax = 10 @@ -29844,65 +29844,65 @@ SUBROUTINE contract_pssf(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pssf #endif @@ -29953,21 +29953,21 @@ SUBROUTINE contract_pssg(work, & imax = 1*1*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*1*1 kmax = 15 @@ -29975,101 +29975,101 @@ SUBROUTINE contract_pssg(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pssg #endif @@ -30120,23 +30120,23 @@ SUBROUTINE contract_psps(work, & imax = 1*3*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*1*3 kmax = 1 @@ -30144,20 +30144,20 @@ SUBROUTINE contract_psps(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_psps #endif @@ -30208,23 +30208,23 @@ SUBROUTINE contract_pspp(work, & imax = 1*3*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*1*3 kmax = 3 @@ -30232,26 +30232,26 @@ SUBROUTINE contract_pspp(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pspp #endif @@ -30302,23 +30302,23 @@ SUBROUTINE contract_pspd(work, & imax = 1*3*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*1*3 kmax = 6 @@ -30326,41 +30326,41 @@ SUBROUTINE contract_pspd(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pspd #endif @@ -30411,23 +30411,23 @@ SUBROUTINE contract_pspf(work, & imax = 1*3*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*1*3 kmax = 10 @@ -30435,65 +30435,65 @@ SUBROUTINE contract_pspf(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pspf #endif @@ -30544,23 +30544,23 @@ SUBROUTINE contract_pspg(work, & imax = 1*3*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*1*3 kmax = 15 @@ -30568,101 +30568,101 @@ SUBROUTINE contract_pspg(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pspg #endif @@ -30713,28 +30713,28 @@ SUBROUTINE contract_psds(work, & imax = 1*6*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*1*5 kmax = 1 @@ -30742,20 +30742,20 @@ SUBROUTINE contract_psds(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_psds #endif @@ -30806,28 +30806,28 @@ SUBROUTINE contract_psdp(work, & imax = 1*6*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*1*5 kmax = 3 @@ -30835,26 +30835,26 @@ SUBROUTINE contract_psdp(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_psdp #endif @@ -30905,28 +30905,28 @@ SUBROUTINE contract_psdd(work, & imax = 1*6*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*1*5 kmax = 6 @@ -30934,41 +30934,41 @@ SUBROUTINE contract_psdd(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_psdd #endif @@ -31019,28 +31019,28 @@ SUBROUTINE contract_psdf(work, & imax = 1*6*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*1*5 kmax = 10 @@ -31048,65 +31048,65 @@ SUBROUTINE contract_psdf(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_psdf #endif @@ -31157,28 +31157,28 @@ SUBROUTINE contract_psdg(work, & imax = 1*6*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*1*5 kmax = 15 @@ -31186,101 +31186,101 @@ SUBROUTINE contract_psdg(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_psdg #endif @@ -31331,36 +31331,36 @@ SUBROUTINE contract_psfs(work, & imax = 1*10*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*1*7 kmax = 1 @@ -31368,20 +31368,20 @@ SUBROUTINE contract_psfs(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_psfs #endif @@ -31432,36 +31432,36 @@ SUBROUTINE contract_psfp(work, & imax = 1*10*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*1*7 kmax = 3 @@ -31469,26 +31469,26 @@ SUBROUTINE contract_psfp(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_psfp #endif @@ -31539,36 +31539,36 @@ SUBROUTINE contract_psfd(work, & imax = 1*10*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*1*7 kmax = 6 @@ -31576,41 +31576,41 @@ SUBROUTINE contract_psfd(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_psfd #endif @@ -31661,36 +31661,36 @@ SUBROUTINE contract_psff(work, & imax = 1*10*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*1*7 kmax = 10 @@ -31698,65 +31698,65 @@ SUBROUTINE contract_psff(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_psff #endif @@ -31807,36 +31807,36 @@ SUBROUTINE contract_psfg(work, & imax = 1*10*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*1*7 kmax = 15 @@ -31844,101 +31844,101 @@ SUBROUTINE contract_psfg(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_psfg #endif @@ -31989,48 +31989,48 @@ SUBROUTINE contract_psgs(work, & imax = 1*15*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*1*9 kmax = 1 @@ -32038,20 +32038,20 @@ SUBROUTINE contract_psgs(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_psgs #endif @@ -32102,48 +32102,48 @@ SUBROUTINE contract_psgp(work, & imax = 1*15*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*1*9 kmax = 3 @@ -32151,26 +32151,26 @@ SUBROUTINE contract_psgp(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_psgp #endif @@ -32221,48 +32221,48 @@ SUBROUTINE contract_psgd(work, & imax = 1*15*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*1*9 kmax = 6 @@ -32270,41 +32270,41 @@ SUBROUTINE contract_psgd(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_psgd #endif @@ -32355,48 +32355,48 @@ SUBROUTINE contract_psgf(work, & imax = 1*15*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*1*9 kmax = 10 @@ -32404,65 +32404,65 @@ SUBROUTINE contract_psgf(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_psgf #endif @@ -32513,48 +32513,48 @@ SUBROUTINE contract_psgg(work, & imax = 1*15*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*1*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*1*9 kmax = 15 @@ -32562,101 +32562,101 @@ SUBROUTINE contract_psgg(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_psgg #endif @@ -32707,23 +32707,23 @@ SUBROUTINE contract_ppss(work, & imax = 3*1*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*3*1 kmax = 1 @@ -32731,20 +32731,20 @@ SUBROUTINE contract_ppss(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_ppss #endif @@ -32795,23 +32795,23 @@ SUBROUTINE contract_ppsp(work, & imax = 3*1*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*3*1 kmax = 3 @@ -32819,26 +32819,26 @@ SUBROUTINE contract_ppsp(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_ppsp #endif @@ -32889,23 +32889,23 @@ SUBROUTINE contract_ppsd(work, & imax = 3*1*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*3*1 kmax = 6 @@ -32913,41 +32913,41 @@ SUBROUTINE contract_ppsd(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_ppsd #endif @@ -32998,23 +32998,23 @@ SUBROUTINE contract_ppsf(work, & imax = 3*1*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*3*1 kmax = 10 @@ -33022,65 +33022,65 @@ SUBROUTINE contract_ppsf(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_ppsf #endif @@ -33131,23 +33131,23 @@ SUBROUTINE contract_ppsg(work, & imax = 3*1*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*3*1 kmax = 15 @@ -33155,101 +33155,101 @@ SUBROUTINE contract_ppsg(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_ppsg #endif @@ -33300,25 +33300,25 @@ SUBROUTINE contract_ppps(work, & imax = 3*3*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*3*3 kmax = 1 @@ -33326,20 +33326,20 @@ SUBROUTINE contract_ppps(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_ppps #endif @@ -33390,25 +33390,25 @@ SUBROUTINE contract_pppp(work, & imax = 3*3*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*3*3 kmax = 3 @@ -33416,26 +33416,26 @@ SUBROUTINE contract_pppp(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pppp #endif @@ -33486,25 +33486,25 @@ SUBROUTINE contract_pppd(work, & imax = 3*3*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*3*3 kmax = 6 @@ -33512,41 +33512,41 @@ SUBROUTINE contract_pppd(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pppd #endif @@ -33597,25 +33597,25 @@ SUBROUTINE contract_pppf(work, & imax = 3*3*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*3*3 kmax = 10 @@ -33623,65 +33623,65 @@ SUBROUTINE contract_pppf(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pppf #endif @@ -33732,25 +33732,25 @@ SUBROUTINE contract_pppg(work, & imax = 3*3*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*3*3 kmax = 15 @@ -33758,101 +33758,101 @@ SUBROUTINE contract_pppg(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pppg #endif @@ -33903,30 +33903,30 @@ SUBROUTINE contract_ppds(work, & imax = 3*6*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*3*5 kmax = 1 @@ -33934,20 +33934,20 @@ SUBROUTINE contract_ppds(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_ppds #endif @@ -33998,30 +33998,30 @@ SUBROUTINE contract_ppdp(work, & imax = 3*6*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*3*5 kmax = 3 @@ -34029,26 +34029,26 @@ SUBROUTINE contract_ppdp(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_ppdp #endif @@ -34099,30 +34099,30 @@ SUBROUTINE contract_ppdd(work, & imax = 3*6*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*3*5 kmax = 6 @@ -34130,41 +34130,41 @@ SUBROUTINE contract_ppdd(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_ppdd #endif @@ -34215,30 +34215,30 @@ SUBROUTINE contract_ppdf(work, & imax = 3*6*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*3*5 kmax = 10 @@ -34246,65 +34246,65 @@ SUBROUTINE contract_ppdf(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_ppdf #endif @@ -34355,30 +34355,30 @@ SUBROUTINE contract_ppdg(work, & imax = 3*6*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*3*5 kmax = 15 @@ -34386,101 +34386,101 @@ SUBROUTINE contract_ppdg(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_ppdg #endif @@ -34531,38 +34531,38 @@ SUBROUTINE contract_ppfs(work, & imax = 3*10*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*3*7 kmax = 1 @@ -34570,20 +34570,20 @@ SUBROUTINE contract_ppfs(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_ppfs #endif @@ -34634,38 +34634,38 @@ SUBROUTINE contract_ppfp(work, & imax = 3*10*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*3*7 kmax = 3 @@ -34673,26 +34673,26 @@ SUBROUTINE contract_ppfp(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_ppfp #endif @@ -34743,38 +34743,38 @@ SUBROUTINE contract_ppfd(work, & imax = 3*10*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*3*7 kmax = 6 @@ -34782,41 +34782,41 @@ SUBROUTINE contract_ppfd(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_ppfd #endif @@ -34867,38 +34867,38 @@ SUBROUTINE contract_ppff(work, & imax = 3*10*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*3*7 kmax = 10 @@ -34906,65 +34906,65 @@ SUBROUTINE contract_ppff(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_ppff #endif @@ -35015,38 +35015,38 @@ SUBROUTINE contract_ppfg(work, & imax = 3*10*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*3*7 kmax = 15 @@ -35054,101 +35054,101 @@ SUBROUTINE contract_ppfg(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_ppfg #endif @@ -35199,50 +35199,50 @@ SUBROUTINE contract_ppgs(work, & imax = 3*15*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*3*9 kmax = 1 @@ -35250,20 +35250,20 @@ SUBROUTINE contract_ppgs(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_ppgs #endif @@ -35314,50 +35314,50 @@ SUBROUTINE contract_ppgp(work, & imax = 3*15*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*3*9 kmax = 3 @@ -35365,26 +35365,26 @@ SUBROUTINE contract_ppgp(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_ppgp #endif @@ -35435,50 +35435,50 @@ SUBROUTINE contract_ppgd(work, & imax = 3*15*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*3*9 kmax = 6 @@ -35486,41 +35486,41 @@ SUBROUTINE contract_ppgd(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_ppgd #endif @@ -35571,50 +35571,50 @@ SUBROUTINE contract_ppgf(work, & imax = 3*15*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*3*9 kmax = 10 @@ -35622,65 +35622,65 @@ SUBROUTINE contract_ppgf(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_ppgf #endif @@ -35731,50 +35731,50 @@ SUBROUTINE contract_ppgg(work, & imax = 3*15*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*3*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*3*9 kmax = 15 @@ -35782,101 +35782,101 @@ SUBROUTINE contract_ppgg(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_ppgg #endif @@ -35927,28 +35927,28 @@ SUBROUTINE contract_pdss(work, & imax = 6*1*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*5*1 kmax = 1 @@ -35956,20 +35956,20 @@ SUBROUTINE contract_pdss(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pdss #endif @@ -36020,28 +36020,28 @@ SUBROUTINE contract_pdsp(work, & imax = 6*1*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*5*1 kmax = 3 @@ -36049,26 +36049,26 @@ SUBROUTINE contract_pdsp(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pdsp #endif @@ -36119,28 +36119,28 @@ SUBROUTINE contract_pdsd(work, & imax = 6*1*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*5*1 kmax = 6 @@ -36148,41 +36148,41 @@ SUBROUTINE contract_pdsd(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pdsd #endif @@ -36233,28 +36233,28 @@ SUBROUTINE contract_pdsf(work, & imax = 6*1*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*5*1 kmax = 10 @@ -36262,65 +36262,65 @@ SUBROUTINE contract_pdsf(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pdsf #endif @@ -36371,28 +36371,28 @@ SUBROUTINE contract_pdsg(work, & imax = 6*1*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*5*1 kmax = 15 @@ -36400,101 +36400,101 @@ SUBROUTINE contract_pdsg(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pdsg #endif @@ -36545,30 +36545,30 @@ SUBROUTINE contract_pdps(work, & imax = 6*3*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*5*3 kmax = 1 @@ -36576,20 +36576,20 @@ SUBROUTINE contract_pdps(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pdps #endif @@ -36640,30 +36640,30 @@ SUBROUTINE contract_pdpp(work, & imax = 6*3*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*5*3 kmax = 3 @@ -36671,26 +36671,26 @@ SUBROUTINE contract_pdpp(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pdpp #endif @@ -36741,30 +36741,30 @@ SUBROUTINE contract_pdpd(work, & imax = 6*3*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*5*3 kmax = 6 @@ -36772,41 +36772,41 @@ SUBROUTINE contract_pdpd(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pdpd #endif @@ -36857,30 +36857,30 @@ SUBROUTINE contract_pdpf(work, & imax = 6*3*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*5*3 kmax = 10 @@ -36888,65 +36888,65 @@ SUBROUTINE contract_pdpf(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pdpf #endif @@ -36997,30 +36997,30 @@ SUBROUTINE contract_pdpg(work, & imax = 6*3*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*5*3 kmax = 15 @@ -37028,101 +37028,101 @@ SUBROUTINE contract_pdpg(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pdpg #endif @@ -37173,35 +37173,35 @@ SUBROUTINE contract_pdds(work, & imax = 6*6*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*5*5 kmax = 1 @@ -37209,20 +37209,20 @@ SUBROUTINE contract_pdds(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pdds #endif @@ -37273,35 +37273,35 @@ SUBROUTINE contract_pddp(work, & imax = 6*6*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*5*5 kmax = 3 @@ -37309,26 +37309,26 @@ SUBROUTINE contract_pddp(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pddp #endif @@ -37379,35 +37379,35 @@ SUBROUTINE contract_pddd(work, & imax = 6*6*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*5*5 kmax = 6 @@ -37415,41 +37415,41 @@ SUBROUTINE contract_pddd(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pddd #endif @@ -37500,35 +37500,35 @@ SUBROUTINE contract_pddf(work, & imax = 6*6*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*5*5 kmax = 10 @@ -37536,65 +37536,65 @@ SUBROUTINE contract_pddf(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pddf #endif @@ -37645,35 +37645,35 @@ SUBROUTINE contract_pddg(work, & imax = 6*6*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*5*5 kmax = 15 @@ -37681,101 +37681,101 @@ SUBROUTINE contract_pddg(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pddg #endif @@ -37826,43 +37826,43 @@ SUBROUTINE contract_pdfs(work, & imax = 6*10*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*5*7 kmax = 1 @@ -37870,20 +37870,20 @@ SUBROUTINE contract_pdfs(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pdfs #endif @@ -37934,43 +37934,43 @@ SUBROUTINE contract_pdfp(work, & imax = 6*10*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*5*7 kmax = 3 @@ -37978,26 +37978,26 @@ SUBROUTINE contract_pdfp(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pdfp #endif @@ -38048,43 +38048,43 @@ SUBROUTINE contract_pdfd(work, & imax = 6*10*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*5*7 kmax = 6 @@ -38092,41 +38092,41 @@ SUBROUTINE contract_pdfd(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pdfd #endif @@ -38177,43 +38177,43 @@ SUBROUTINE contract_pdff(work, & imax = 6*10*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*5*7 kmax = 10 @@ -38221,65 +38221,65 @@ SUBROUTINE contract_pdff(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pdff #endif @@ -38330,43 +38330,43 @@ SUBROUTINE contract_pdfg(work, & imax = 6*10*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*5*7 kmax = 15 @@ -38374,101 +38374,101 @@ SUBROUTINE contract_pdfg(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pdfg #endif @@ -38519,55 +38519,55 @@ SUBROUTINE contract_pdgs(work, & imax = 6*15*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*5*9 kmax = 1 @@ -38575,20 +38575,20 @@ SUBROUTINE contract_pdgs(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pdgs #endif @@ -38639,55 +38639,55 @@ SUBROUTINE contract_pdgp(work, & imax = 6*15*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*5*9 kmax = 3 @@ -38695,26 +38695,26 @@ SUBROUTINE contract_pdgp(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pdgp #endif @@ -38765,55 +38765,55 @@ SUBROUTINE contract_pdgd(work, & imax = 6*15*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*5*9 kmax = 6 @@ -38821,41 +38821,41 @@ SUBROUTINE contract_pdgd(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pdgd #endif @@ -38906,55 +38906,55 @@ SUBROUTINE contract_pdgf(work, & imax = 6*15*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*5*9 kmax = 10 @@ -38962,65 +38962,65 @@ SUBROUTINE contract_pdgf(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pdgf #endif @@ -39071,55 +39071,55 @@ SUBROUTINE contract_pdgg(work, & imax = 6*15*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*5*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*5*9 kmax = 15 @@ -39127,101 +39127,101 @@ SUBROUTINE contract_pdgg(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pdgg #endif @@ -39272,36 +39272,36 @@ SUBROUTINE contract_pfss(work, & imax = 10*1*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*7*1 kmax = 1 @@ -39309,20 +39309,20 @@ SUBROUTINE contract_pfss(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pfss #endif @@ -39373,36 +39373,36 @@ SUBROUTINE contract_pfsp(work, & imax = 10*1*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*7*1 kmax = 3 @@ -39410,26 +39410,26 @@ SUBROUTINE contract_pfsp(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pfsp #endif @@ -39480,36 +39480,36 @@ SUBROUTINE contract_pfsd(work, & imax = 10*1*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*7*1 kmax = 6 @@ -39517,41 +39517,41 @@ SUBROUTINE contract_pfsd(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pfsd #endif @@ -39602,36 +39602,36 @@ SUBROUTINE contract_pfsf(work, & imax = 10*1*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*7*1 kmax = 10 @@ -39639,65 +39639,65 @@ SUBROUTINE contract_pfsf(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pfsf #endif @@ -39748,36 +39748,36 @@ SUBROUTINE contract_pfsg(work, & imax = 10*1*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*7*1 kmax = 15 @@ -39785,101 +39785,101 @@ SUBROUTINE contract_pfsg(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pfsg #endif @@ -39930,38 +39930,38 @@ SUBROUTINE contract_pfps(work, & imax = 10*3*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*7*3 kmax = 1 @@ -39969,20 +39969,20 @@ SUBROUTINE contract_pfps(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pfps #endif @@ -40033,38 +40033,38 @@ SUBROUTINE contract_pfpp(work, & imax = 10*3*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*7*3 kmax = 3 @@ -40072,26 +40072,26 @@ SUBROUTINE contract_pfpp(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pfpp #endif @@ -40142,38 +40142,38 @@ SUBROUTINE contract_pfpd(work, & imax = 10*3*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*7*3 kmax = 6 @@ -40181,41 +40181,41 @@ SUBROUTINE contract_pfpd(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pfpd #endif @@ -40266,38 +40266,38 @@ SUBROUTINE contract_pfpf(work, & imax = 10*3*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*7*3 kmax = 10 @@ -40305,65 +40305,65 @@ SUBROUTINE contract_pfpf(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pfpf #endif @@ -40414,38 +40414,38 @@ SUBROUTINE contract_pfpg(work, & imax = 10*3*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*7*3 kmax = 15 @@ -40453,101 +40453,101 @@ SUBROUTINE contract_pfpg(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pfpg #endif @@ -40598,43 +40598,43 @@ SUBROUTINE contract_pfds(work, & imax = 10*6*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*7*5 kmax = 1 @@ -40642,20 +40642,20 @@ SUBROUTINE contract_pfds(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pfds #endif @@ -40706,43 +40706,43 @@ SUBROUTINE contract_pfdp(work, & imax = 10*6*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*7*5 kmax = 3 @@ -40750,26 +40750,26 @@ SUBROUTINE contract_pfdp(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pfdp #endif @@ -40820,43 +40820,43 @@ SUBROUTINE contract_pfdd(work, & imax = 10*6*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*7*5 kmax = 6 @@ -40864,41 +40864,41 @@ SUBROUTINE contract_pfdd(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pfdd #endif @@ -40949,43 +40949,43 @@ SUBROUTINE contract_pfdf(work, & imax = 10*6*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*7*5 kmax = 10 @@ -40993,65 +40993,65 @@ SUBROUTINE contract_pfdf(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pfdf #endif @@ -41102,43 +41102,43 @@ SUBROUTINE contract_pfdg(work, & imax = 10*6*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*7*5 kmax = 15 @@ -41146,101 +41146,101 @@ SUBROUTINE contract_pfdg(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pfdg #endif @@ -41291,51 +41291,51 @@ SUBROUTINE contract_pffs(work, & imax = 10*10*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*7*7 kmax = 1 @@ -41343,20 +41343,20 @@ SUBROUTINE contract_pffs(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pffs #endif @@ -41407,51 +41407,51 @@ SUBROUTINE contract_pffp(work, & imax = 10*10*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*7*7 kmax = 3 @@ -41459,26 +41459,26 @@ SUBROUTINE contract_pffp(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pffp #endif @@ -41529,51 +41529,51 @@ SUBROUTINE contract_pffd(work, & imax = 10*10*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*7*7 kmax = 6 @@ -41581,41 +41581,41 @@ SUBROUTINE contract_pffd(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pffd #endif @@ -41666,51 +41666,51 @@ SUBROUTINE contract_pfff(work, & imax = 10*10*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*7*7 kmax = 10 @@ -41718,65 +41718,65 @@ SUBROUTINE contract_pfff(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pfff #endif @@ -41827,51 +41827,51 @@ SUBROUTINE contract_pffg(work, & imax = 10*10*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*7*7 kmax = 15 @@ -41879,101 +41879,101 @@ SUBROUTINE contract_pffg(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pffg #endif @@ -42024,63 +42024,63 @@ SUBROUTINE contract_pfgs(work, & imax = 10*15*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*7*9 kmax = 1 @@ -42088,20 +42088,20 @@ SUBROUTINE contract_pfgs(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pfgs #endif @@ -42152,63 +42152,63 @@ SUBROUTINE contract_pfgp(work, & imax = 10*15*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*7*9 kmax = 3 @@ -42216,26 +42216,26 @@ SUBROUTINE contract_pfgp(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pfgp #endif @@ -42286,63 +42286,63 @@ SUBROUTINE contract_pfgd(work, & imax = 10*15*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*7*9 kmax = 6 @@ -42350,41 +42350,41 @@ SUBROUTINE contract_pfgd(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pfgd #endif @@ -42435,63 +42435,63 @@ SUBROUTINE contract_pfgf(work, & imax = 10*15*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*7*9 kmax = 10 @@ -42499,65 +42499,65 @@ SUBROUTINE contract_pfgf(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pfgf #endif @@ -42608,63 +42608,63 @@ SUBROUTINE contract_pfgg(work, & imax = 10*15*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*7*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*7*9 kmax = 15 @@ -42672,101 +42672,101 @@ SUBROUTINE contract_pfgg(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pfgg #endif @@ -42817,48 +42817,48 @@ SUBROUTINE contract_pgss(work, & imax = 15*1*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*9*1 kmax = 1 @@ -42866,20 +42866,20 @@ SUBROUTINE contract_pgss(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pgss #endif @@ -42930,48 +42930,48 @@ SUBROUTINE contract_pgsp(work, & imax = 15*1*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*9*1 kmax = 3 @@ -42979,26 +42979,26 @@ SUBROUTINE contract_pgsp(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pgsp #endif @@ -43049,48 +43049,48 @@ SUBROUTINE contract_pgsd(work, & imax = 15*1*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*9*1 kmax = 6 @@ -43098,41 +43098,41 @@ SUBROUTINE contract_pgsd(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pgsd #endif @@ -43183,48 +43183,48 @@ SUBROUTINE contract_pgsf(work, & imax = 15*1*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*9*1 kmax = 10 @@ -43232,65 +43232,65 @@ SUBROUTINE contract_pgsf(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pgsf #endif @@ -43341,48 +43341,48 @@ SUBROUTINE contract_pgsg(work, & imax = 15*1*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*1*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 3*9*1 kmax = 15 @@ -43390,101 +43390,101 @@ SUBROUTINE contract_pgsg(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pgsg #endif @@ -43535,50 +43535,50 @@ SUBROUTINE contract_pgps(work, & imax = 15*3*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*9*3 kmax = 1 @@ -43586,20 +43586,20 @@ SUBROUTINE contract_pgps(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pgps #endif @@ -43650,50 +43650,50 @@ SUBROUTINE contract_pgpp(work, & imax = 15*3*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*9*3 kmax = 3 @@ -43701,26 +43701,26 @@ SUBROUTINE contract_pgpp(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pgpp #endif @@ -43771,50 +43771,50 @@ SUBROUTINE contract_pgpd(work, & imax = 15*3*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*9*3 kmax = 6 @@ -43822,41 +43822,41 @@ SUBROUTINE contract_pgpd(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pgpd #endif @@ -43907,50 +43907,50 @@ SUBROUTINE contract_pgpf(work, & imax = 15*3*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*9*3 kmax = 10 @@ -43958,65 +43958,65 @@ SUBROUTINE contract_pgpf(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pgpf #endif @@ -44067,50 +44067,50 @@ SUBROUTINE contract_pgpg(work, & imax = 15*3*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*3*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 3*9*3 kmax = 15 @@ -44118,101 +44118,101 @@ SUBROUTINE contract_pgpg(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pgpg #endif @@ -44263,55 +44263,55 @@ SUBROUTINE contract_pgds(work, & imax = 15*6*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*9*5 kmax = 1 @@ -44319,20 +44319,20 @@ SUBROUTINE contract_pgds(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pgds #endif @@ -44383,55 +44383,55 @@ SUBROUTINE contract_pgdp(work, & imax = 15*6*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*9*5 kmax = 3 @@ -44439,26 +44439,26 @@ SUBROUTINE contract_pgdp(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pgdp #endif @@ -44509,55 +44509,55 @@ SUBROUTINE contract_pgdd(work, & imax = 15*6*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*9*5 kmax = 6 @@ -44565,41 +44565,41 @@ SUBROUTINE contract_pgdd(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pgdd #endif @@ -44650,55 +44650,55 @@ SUBROUTINE contract_pgdf(work, & imax = 15*6*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*9*5 kmax = 10 @@ -44706,65 +44706,65 @@ SUBROUTINE contract_pgdf(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pgdf #endif @@ -44815,55 +44815,55 @@ SUBROUTINE contract_pgdg(work, & imax = 15*6*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*6*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 3*9*5 kmax = 15 @@ -44871,101 +44871,101 @@ SUBROUTINE contract_pgdg(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pgdg #endif @@ -45016,63 +45016,63 @@ SUBROUTINE contract_pgfs(work, & imax = 15*10*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*9*7 kmax = 1 @@ -45080,20 +45080,20 @@ SUBROUTINE contract_pgfs(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pgfs #endif @@ -45144,63 +45144,63 @@ SUBROUTINE contract_pgfp(work, & imax = 15*10*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*9*7 kmax = 3 @@ -45208,26 +45208,26 @@ SUBROUTINE contract_pgfp(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pgfp #endif @@ -45278,63 +45278,63 @@ SUBROUTINE contract_pgfd(work, & imax = 15*10*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*9*7 kmax = 6 @@ -45342,41 +45342,41 @@ SUBROUTINE contract_pgfd(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pgfd #endif @@ -45427,63 +45427,63 @@ SUBROUTINE contract_pgff(work, & imax = 15*10*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*9*7 kmax = 10 @@ -45491,65 +45491,65 @@ SUBROUTINE contract_pgff(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pgff #endif @@ -45600,63 +45600,63 @@ SUBROUTINE contract_pgfg(work, & imax = 15*10*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*10*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 3*9*7 kmax = 15 @@ -45664,101 +45664,101 @@ SUBROUTINE contract_pgfg(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pgfg #endif @@ -45809,75 +45809,75 @@ SUBROUTINE contract_pggs(work, & imax = 15*15*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*9*9 kmax = 1 @@ -45885,20 +45885,20 @@ SUBROUTINE contract_pggs(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pggs #endif @@ -45949,75 +45949,75 @@ SUBROUTINE contract_pggp(work, & imax = 15*15*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*9*9 kmax = 3 @@ -46025,26 +46025,26 @@ SUBROUTINE contract_pggp(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+3 + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pggp #endif @@ -46095,75 +46095,75 @@ SUBROUTINE contract_pggd(work, & imax = 15*15*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*9*9 kmax = 6 @@ -46171,41 +46171,41 @@ SUBROUTINE contract_pggd(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pggd #endif @@ -46256,75 +46256,75 @@ SUBROUTINE contract_pggf(work, & imax = 15*15*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*9*9 kmax = 10 @@ -46332,65 +46332,65 @@ SUBROUTINE contract_pggf(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pggf #endif @@ -46441,75 +46441,75 @@ SUBROUTINE contract_pggg(work, & imax = 15*15*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 3*15*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 3*9*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 3*9*9 kmax = 15 @@ -46517,101 +46517,101 @@ SUBROUTINE contract_pggg(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 3 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+3 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 3 END DO END SUBROUTINE contract_pggg #endif @@ -46662,26 +46662,26 @@ SUBROUTINE contract_dsss(work, & imax = 1*1*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*1*1 kmax = 1 @@ -46689,20 +46689,20 @@ SUBROUTINE contract_dsss(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dsss #endif @@ -46753,26 +46753,26 @@ SUBROUTINE contract_dssp(work, & imax = 1*1*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*1*1 kmax = 3 @@ -46780,26 +46780,26 @@ SUBROUTINE contract_dssp(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dssp #endif @@ -46850,26 +46850,26 @@ SUBROUTINE contract_dssd(work, & imax = 1*1*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*1*1 kmax = 6 @@ -46877,41 +46877,41 @@ SUBROUTINE contract_dssd(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dssd #endif @@ -46962,26 +46962,26 @@ SUBROUTINE contract_dssf(work, & imax = 1*1*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*1*1 kmax = 10 @@ -46989,65 +46989,65 @@ SUBROUTINE contract_dssf(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dssf #endif @@ -47098,26 +47098,26 @@ SUBROUTINE contract_dssg(work, & imax = 1*1*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*1*1 kmax = 15 @@ -47125,101 +47125,101 @@ SUBROUTINE contract_dssg(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dssg #endif @@ -47270,28 +47270,28 @@ SUBROUTINE contract_dsps(work, & imax = 1*3*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*1*3 kmax = 1 @@ -47299,20 +47299,20 @@ SUBROUTINE contract_dsps(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dsps #endif @@ -47363,28 +47363,28 @@ SUBROUTINE contract_dspp(work, & imax = 1*3*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*1*3 kmax = 3 @@ -47392,26 +47392,26 @@ SUBROUTINE contract_dspp(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dspp #endif @@ -47462,28 +47462,28 @@ SUBROUTINE contract_dspd(work, & imax = 1*3*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*1*3 kmax = 6 @@ -47491,41 +47491,41 @@ SUBROUTINE contract_dspd(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dspd #endif @@ -47576,28 +47576,28 @@ SUBROUTINE contract_dspf(work, & imax = 1*3*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*1*3 kmax = 10 @@ -47605,65 +47605,65 @@ SUBROUTINE contract_dspf(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dspf #endif @@ -47714,28 +47714,28 @@ SUBROUTINE contract_dspg(work, & imax = 1*3*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*1*3 kmax = 15 @@ -47743,101 +47743,101 @@ SUBROUTINE contract_dspg(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dspg #endif @@ -47888,33 +47888,33 @@ SUBROUTINE contract_dsds(work, & imax = 1*6*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*1*5 kmax = 1 @@ -47922,20 +47922,20 @@ SUBROUTINE contract_dsds(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dsds #endif @@ -47986,33 +47986,33 @@ SUBROUTINE contract_dsdp(work, & imax = 1*6*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*1*5 kmax = 3 @@ -48020,26 +48020,26 @@ SUBROUTINE contract_dsdp(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dsdp #endif @@ -48090,33 +48090,33 @@ SUBROUTINE contract_dsdd(work, & imax = 1*6*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*1*5 kmax = 6 @@ -48124,41 +48124,41 @@ SUBROUTINE contract_dsdd(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dsdd #endif @@ -48209,33 +48209,33 @@ SUBROUTINE contract_dsdf(work, & imax = 1*6*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*1*5 kmax = 10 @@ -48243,65 +48243,65 @@ SUBROUTINE contract_dsdf(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dsdf #endif @@ -48352,33 +48352,33 @@ SUBROUTINE contract_dsdg(work, & imax = 1*6*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*1*5 kmax = 15 @@ -48386,101 +48386,101 @@ SUBROUTINE contract_dsdg(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dsdg #endif @@ -48531,41 +48531,41 @@ SUBROUTINE contract_dsfs(work, & imax = 1*10*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*1*7 kmax = 1 @@ -48573,20 +48573,20 @@ SUBROUTINE contract_dsfs(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dsfs #endif @@ -48637,41 +48637,41 @@ SUBROUTINE contract_dsfp(work, & imax = 1*10*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*1*7 kmax = 3 @@ -48679,26 +48679,26 @@ SUBROUTINE contract_dsfp(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dsfp #endif @@ -48749,41 +48749,41 @@ SUBROUTINE contract_dsfd(work, & imax = 1*10*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*1*7 kmax = 6 @@ -48791,41 +48791,41 @@ SUBROUTINE contract_dsfd(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dsfd #endif @@ -48876,41 +48876,41 @@ SUBROUTINE contract_dsff(work, & imax = 1*10*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*1*7 kmax = 10 @@ -48918,65 +48918,65 @@ SUBROUTINE contract_dsff(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dsff #endif @@ -49027,41 +49027,41 @@ SUBROUTINE contract_dsfg(work, & imax = 1*10*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*1*7 kmax = 15 @@ -49069,101 +49069,101 @@ SUBROUTINE contract_dsfg(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dsfg #endif @@ -49214,53 +49214,53 @@ SUBROUTINE contract_dsgs(work, & imax = 1*15*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*1*9 kmax = 1 @@ -49268,20 +49268,20 @@ SUBROUTINE contract_dsgs(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dsgs #endif @@ -49332,53 +49332,53 @@ SUBROUTINE contract_dsgp(work, & imax = 1*15*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*1*9 kmax = 3 @@ -49386,26 +49386,26 @@ SUBROUTINE contract_dsgp(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dsgp #endif @@ -49456,53 +49456,53 @@ SUBROUTINE contract_dsgd(work, & imax = 1*15*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*1*9 kmax = 6 @@ -49510,41 +49510,41 @@ SUBROUTINE contract_dsgd(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dsgd #endif @@ -49595,53 +49595,53 @@ SUBROUTINE contract_dsgf(work, & imax = 1*15*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*1*9 kmax = 10 @@ -49649,65 +49649,65 @@ SUBROUTINE contract_dsgf(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dsgf #endif @@ -49758,53 +49758,53 @@ SUBROUTINE contract_dsgg(work, & imax = 1*15*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*1*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*1*9 kmax = 15 @@ -49812,101 +49812,101 @@ SUBROUTINE contract_dsgg(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dsgg #endif @@ -49957,28 +49957,28 @@ SUBROUTINE contract_dpss(work, & imax = 3*1*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*3*1 kmax = 1 @@ -49986,20 +49986,20 @@ SUBROUTINE contract_dpss(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dpss #endif @@ -50050,28 +50050,28 @@ SUBROUTINE contract_dpsp(work, & imax = 3*1*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*3*1 kmax = 3 @@ -50079,26 +50079,26 @@ SUBROUTINE contract_dpsp(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dpsp #endif @@ -50149,28 +50149,28 @@ SUBROUTINE contract_dpsd(work, & imax = 3*1*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*3*1 kmax = 6 @@ -50178,41 +50178,41 @@ SUBROUTINE contract_dpsd(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dpsd #endif @@ -50263,28 +50263,28 @@ SUBROUTINE contract_dpsf(work, & imax = 3*1*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*3*1 kmax = 10 @@ -50292,65 +50292,65 @@ SUBROUTINE contract_dpsf(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dpsf #endif @@ -50401,28 +50401,28 @@ SUBROUTINE contract_dpsg(work, & imax = 3*1*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*3*1 kmax = 15 @@ -50430,101 +50430,101 @@ SUBROUTINE contract_dpsg(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dpsg #endif @@ -50575,30 +50575,30 @@ SUBROUTINE contract_dpps(work, & imax = 3*3*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*3*3 kmax = 1 @@ -50606,20 +50606,20 @@ SUBROUTINE contract_dpps(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dpps #endif @@ -50670,30 +50670,30 @@ SUBROUTINE contract_dppp(work, & imax = 3*3*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*3*3 kmax = 3 @@ -50701,26 +50701,26 @@ SUBROUTINE contract_dppp(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dppp #endif @@ -50771,30 +50771,30 @@ SUBROUTINE contract_dppd(work, & imax = 3*3*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*3*3 kmax = 6 @@ -50802,41 +50802,41 @@ SUBROUTINE contract_dppd(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dppd #endif @@ -50887,30 +50887,30 @@ SUBROUTINE contract_dppf(work, & imax = 3*3*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*3*3 kmax = 10 @@ -50918,65 +50918,65 @@ SUBROUTINE contract_dppf(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dppf #endif @@ -51027,30 +51027,30 @@ SUBROUTINE contract_dppg(work, & imax = 3*3*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*3*3 kmax = 15 @@ -51058,101 +51058,101 @@ SUBROUTINE contract_dppg(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dppg #endif @@ -51203,35 +51203,35 @@ SUBROUTINE contract_dpds(work, & imax = 3*6*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*3*5 kmax = 1 @@ -51239,20 +51239,20 @@ SUBROUTINE contract_dpds(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dpds #endif @@ -51303,35 +51303,35 @@ SUBROUTINE contract_dpdp(work, & imax = 3*6*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*3*5 kmax = 3 @@ -51339,26 +51339,26 @@ SUBROUTINE contract_dpdp(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dpdp #endif @@ -51409,35 +51409,35 @@ SUBROUTINE contract_dpdd(work, & imax = 3*6*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*3*5 kmax = 6 @@ -51445,41 +51445,41 @@ SUBROUTINE contract_dpdd(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dpdd #endif @@ -51530,35 +51530,35 @@ SUBROUTINE contract_dpdf(work, & imax = 3*6*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*3*5 kmax = 10 @@ -51566,65 +51566,65 @@ SUBROUTINE contract_dpdf(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dpdf #endif @@ -51675,35 +51675,35 @@ SUBROUTINE contract_dpdg(work, & imax = 3*6*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*3*5 kmax = 15 @@ -51711,101 +51711,101 @@ SUBROUTINE contract_dpdg(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dpdg #endif @@ -51856,43 +51856,43 @@ SUBROUTINE contract_dpfs(work, & imax = 3*10*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*3*7 kmax = 1 @@ -51900,20 +51900,20 @@ SUBROUTINE contract_dpfs(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dpfs #endif @@ -51964,43 +51964,43 @@ SUBROUTINE contract_dpfp(work, & imax = 3*10*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*3*7 kmax = 3 @@ -52008,26 +52008,26 @@ SUBROUTINE contract_dpfp(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dpfp #endif @@ -52078,43 +52078,43 @@ SUBROUTINE contract_dpfd(work, & imax = 3*10*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*3*7 kmax = 6 @@ -52122,41 +52122,41 @@ SUBROUTINE contract_dpfd(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dpfd #endif @@ -52207,43 +52207,43 @@ SUBROUTINE contract_dpff(work, & imax = 3*10*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*3*7 kmax = 10 @@ -52251,65 +52251,65 @@ SUBROUTINE contract_dpff(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dpff #endif @@ -52360,43 +52360,43 @@ SUBROUTINE contract_dpfg(work, & imax = 3*10*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*3*7 kmax = 15 @@ -52404,101 +52404,101 @@ SUBROUTINE contract_dpfg(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dpfg #endif @@ -52549,55 +52549,55 @@ SUBROUTINE contract_dpgs(work, & imax = 3*15*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*3*9 kmax = 1 @@ -52605,20 +52605,20 @@ SUBROUTINE contract_dpgs(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dpgs #endif @@ -52669,55 +52669,55 @@ SUBROUTINE contract_dpgp(work, & imax = 3*15*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*3*9 kmax = 3 @@ -52725,26 +52725,26 @@ SUBROUTINE contract_dpgp(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dpgp #endif @@ -52795,55 +52795,55 @@ SUBROUTINE contract_dpgd(work, & imax = 3*15*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*3*9 kmax = 6 @@ -52851,41 +52851,41 @@ SUBROUTINE contract_dpgd(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dpgd #endif @@ -52936,55 +52936,55 @@ SUBROUTINE contract_dpgf(work, & imax = 3*15*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*3*9 kmax = 10 @@ -52992,65 +52992,65 @@ SUBROUTINE contract_dpgf(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dpgf #endif @@ -53101,55 +53101,55 @@ SUBROUTINE contract_dpgg(work, & imax = 3*15*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*3*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*3*9 kmax = 15 @@ -53157,101 +53157,101 @@ SUBROUTINE contract_dpgg(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dpgg #endif @@ -53302,33 +53302,33 @@ SUBROUTINE contract_ddss(work, & imax = 6*1*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*5*1 kmax = 1 @@ -53336,20 +53336,20 @@ SUBROUTINE contract_ddss(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_ddss #endif @@ -53400,33 +53400,33 @@ SUBROUTINE contract_ddsp(work, & imax = 6*1*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*5*1 kmax = 3 @@ -53434,26 +53434,26 @@ SUBROUTINE contract_ddsp(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_ddsp #endif @@ -53504,33 +53504,33 @@ SUBROUTINE contract_ddsd(work, & imax = 6*1*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*5*1 kmax = 6 @@ -53538,41 +53538,41 @@ SUBROUTINE contract_ddsd(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_ddsd #endif @@ -53623,33 +53623,33 @@ SUBROUTINE contract_ddsf(work, & imax = 6*1*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*5*1 kmax = 10 @@ -53657,65 +53657,65 @@ SUBROUTINE contract_ddsf(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_ddsf #endif @@ -53766,33 +53766,33 @@ SUBROUTINE contract_ddsg(work, & imax = 6*1*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*5*1 kmax = 15 @@ -53800,101 +53800,101 @@ SUBROUTINE contract_ddsg(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_ddsg #endif @@ -53945,35 +53945,35 @@ SUBROUTINE contract_ddps(work, & imax = 6*3*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*5*3 kmax = 1 @@ -53981,20 +53981,20 @@ SUBROUTINE contract_ddps(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_ddps #endif @@ -54045,35 +54045,35 @@ SUBROUTINE contract_ddpp(work, & imax = 6*3*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*5*3 kmax = 3 @@ -54081,26 +54081,26 @@ SUBROUTINE contract_ddpp(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_ddpp #endif @@ -54151,35 +54151,35 @@ SUBROUTINE contract_ddpd(work, & imax = 6*3*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*5*3 kmax = 6 @@ -54187,41 +54187,41 @@ SUBROUTINE contract_ddpd(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_ddpd #endif @@ -54272,35 +54272,35 @@ SUBROUTINE contract_ddpf(work, & imax = 6*3*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*5*3 kmax = 10 @@ -54308,65 +54308,65 @@ SUBROUTINE contract_ddpf(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_ddpf #endif @@ -54417,35 +54417,35 @@ SUBROUTINE contract_ddpg(work, & imax = 6*3*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*5*3 kmax = 15 @@ -54453,101 +54453,101 @@ SUBROUTINE contract_ddpg(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_ddpg #endif @@ -54598,40 +54598,40 @@ SUBROUTINE contract_ddds(work, & imax = 6*6*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*5*5 kmax = 1 @@ -54639,20 +54639,20 @@ SUBROUTINE contract_ddds(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_ddds #endif @@ -54703,40 +54703,40 @@ SUBROUTINE contract_dddp(work, & imax = 6*6*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*5*5 kmax = 3 @@ -54744,26 +54744,26 @@ SUBROUTINE contract_dddp(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dddp #endif @@ -54814,40 +54814,40 @@ SUBROUTINE contract_dddd(work, & imax = 6*6*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*5*5 kmax = 6 @@ -54855,41 +54855,41 @@ SUBROUTINE contract_dddd(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dddd #endif @@ -54940,40 +54940,40 @@ SUBROUTINE contract_dddf(work, & imax = 6*6*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*5*5 kmax = 10 @@ -54981,65 +54981,65 @@ SUBROUTINE contract_dddf(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dddf #endif @@ -55090,40 +55090,40 @@ SUBROUTINE contract_dddg(work, & imax = 6*6*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*5*5 kmax = 15 @@ -55131,101 +55131,101 @@ SUBROUTINE contract_dddg(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dddg #endif @@ -55276,48 +55276,48 @@ SUBROUTINE contract_ddfs(work, & imax = 6*10*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*5*7 kmax = 1 @@ -55325,20 +55325,20 @@ SUBROUTINE contract_ddfs(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_ddfs #endif @@ -55389,48 +55389,48 @@ SUBROUTINE contract_ddfp(work, & imax = 6*10*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*5*7 kmax = 3 @@ -55438,26 +55438,26 @@ SUBROUTINE contract_ddfp(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_ddfp #endif @@ -55508,48 +55508,48 @@ SUBROUTINE contract_ddfd(work, & imax = 6*10*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*5*7 kmax = 6 @@ -55557,41 +55557,41 @@ SUBROUTINE contract_ddfd(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_ddfd #endif @@ -55642,48 +55642,48 @@ SUBROUTINE contract_ddff(work, & imax = 6*10*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*5*7 kmax = 10 @@ -55691,65 +55691,65 @@ SUBROUTINE contract_ddff(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_ddff #endif @@ -55800,48 +55800,48 @@ SUBROUTINE contract_ddfg(work, & imax = 6*10*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*5*7 kmax = 15 @@ -55849,101 +55849,101 @@ SUBROUTINE contract_ddfg(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_ddfg #endif @@ -55994,60 +55994,60 @@ SUBROUTINE contract_ddgs(work, & imax = 6*15*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*5*9 kmax = 1 @@ -56055,20 +56055,20 @@ SUBROUTINE contract_ddgs(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_ddgs #endif @@ -56119,60 +56119,60 @@ SUBROUTINE contract_ddgp(work, & imax = 6*15*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*5*9 kmax = 3 @@ -56180,26 +56180,26 @@ SUBROUTINE contract_ddgp(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_ddgp #endif @@ -56250,60 +56250,60 @@ SUBROUTINE contract_ddgd(work, & imax = 6*15*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*5*9 kmax = 6 @@ -56311,41 +56311,41 @@ SUBROUTINE contract_ddgd(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_ddgd #endif @@ -56396,60 +56396,60 @@ SUBROUTINE contract_ddgf(work, & imax = 6*15*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*5*9 kmax = 10 @@ -56457,65 +56457,65 @@ SUBROUTINE contract_ddgf(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_ddgf #endif @@ -56566,60 +56566,60 @@ SUBROUTINE contract_ddgg(work, & imax = 6*15*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*5*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*5*9 kmax = 15 @@ -56627,101 +56627,101 @@ SUBROUTINE contract_ddgg(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_ddgg #endif @@ -56772,41 +56772,41 @@ SUBROUTINE contract_dfss(work, & imax = 10*1*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*7*1 kmax = 1 @@ -56814,20 +56814,20 @@ SUBROUTINE contract_dfss(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dfss #endif @@ -56878,41 +56878,41 @@ SUBROUTINE contract_dfsp(work, & imax = 10*1*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*7*1 kmax = 3 @@ -56920,26 +56920,26 @@ SUBROUTINE contract_dfsp(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dfsp #endif @@ -56990,41 +56990,41 @@ SUBROUTINE contract_dfsd(work, & imax = 10*1*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*7*1 kmax = 6 @@ -57032,41 +57032,41 @@ SUBROUTINE contract_dfsd(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dfsd #endif @@ -57117,41 +57117,41 @@ SUBROUTINE contract_dfsf(work, & imax = 10*1*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*7*1 kmax = 10 @@ -57159,65 +57159,65 @@ SUBROUTINE contract_dfsf(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dfsf #endif @@ -57268,41 +57268,41 @@ SUBROUTINE contract_dfsg(work, & imax = 10*1*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*7*1 kmax = 15 @@ -57310,101 +57310,101 @@ SUBROUTINE contract_dfsg(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dfsg #endif @@ -57455,43 +57455,43 @@ SUBROUTINE contract_dfps(work, & imax = 10*3*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*7*3 kmax = 1 @@ -57499,20 +57499,20 @@ SUBROUTINE contract_dfps(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dfps #endif @@ -57563,43 +57563,43 @@ SUBROUTINE contract_dfpp(work, & imax = 10*3*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*7*3 kmax = 3 @@ -57607,26 +57607,26 @@ SUBROUTINE contract_dfpp(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dfpp #endif @@ -57677,43 +57677,43 @@ SUBROUTINE contract_dfpd(work, & imax = 10*3*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*7*3 kmax = 6 @@ -57721,41 +57721,41 @@ SUBROUTINE contract_dfpd(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dfpd #endif @@ -57806,43 +57806,43 @@ SUBROUTINE contract_dfpf(work, & imax = 10*3*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*7*3 kmax = 10 @@ -57850,65 +57850,65 @@ SUBROUTINE contract_dfpf(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dfpf #endif @@ -57959,43 +57959,43 @@ SUBROUTINE contract_dfpg(work, & imax = 10*3*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*7*3 kmax = 15 @@ -58003,101 +58003,101 @@ SUBROUTINE contract_dfpg(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dfpg #endif @@ -58148,48 +58148,48 @@ SUBROUTINE contract_dfds(work, & imax = 10*6*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*7*5 kmax = 1 @@ -58197,20 +58197,20 @@ SUBROUTINE contract_dfds(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dfds #endif @@ -58261,48 +58261,48 @@ SUBROUTINE contract_dfdp(work, & imax = 10*6*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*7*5 kmax = 3 @@ -58310,26 +58310,26 @@ SUBROUTINE contract_dfdp(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dfdp #endif @@ -58380,48 +58380,48 @@ SUBROUTINE contract_dfdd(work, & imax = 10*6*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*7*5 kmax = 6 @@ -58429,41 +58429,41 @@ SUBROUTINE contract_dfdd(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dfdd #endif @@ -58514,48 +58514,48 @@ SUBROUTINE contract_dfdf(work, & imax = 10*6*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*7*5 kmax = 10 @@ -58563,65 +58563,65 @@ SUBROUTINE contract_dfdf(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dfdf #endif @@ -58672,48 +58672,48 @@ SUBROUTINE contract_dfdg(work, & imax = 10*6*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*7*5 kmax = 15 @@ -58721,101 +58721,101 @@ SUBROUTINE contract_dfdg(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dfdg #endif @@ -58866,56 +58866,56 @@ SUBROUTINE contract_dffs(work, & imax = 10*10*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*7*7 kmax = 1 @@ -58923,20 +58923,20 @@ SUBROUTINE contract_dffs(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dffs #endif @@ -58987,56 +58987,56 @@ SUBROUTINE contract_dffp(work, & imax = 10*10*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*7*7 kmax = 3 @@ -59044,26 +59044,26 @@ SUBROUTINE contract_dffp(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dffp #endif @@ -59114,56 +59114,56 @@ SUBROUTINE contract_dffd(work, & imax = 10*10*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*7*7 kmax = 6 @@ -59171,41 +59171,41 @@ SUBROUTINE contract_dffd(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dffd #endif @@ -59256,56 +59256,56 @@ SUBROUTINE contract_dfff(work, & imax = 10*10*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*7*7 kmax = 10 @@ -59313,65 +59313,65 @@ SUBROUTINE contract_dfff(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dfff #endif @@ -59422,56 +59422,56 @@ SUBROUTINE contract_dffg(work, & imax = 10*10*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*7*7 kmax = 15 @@ -59479,101 +59479,101 @@ SUBROUTINE contract_dffg(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dffg #endif @@ -59624,68 +59624,68 @@ SUBROUTINE contract_dfgs(work, & imax = 10*15*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*7*9 kmax = 1 @@ -59693,20 +59693,20 @@ SUBROUTINE contract_dfgs(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dfgs #endif @@ -59757,68 +59757,68 @@ SUBROUTINE contract_dfgp(work, & imax = 10*15*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*7*9 kmax = 3 @@ -59826,26 +59826,26 @@ SUBROUTINE contract_dfgp(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dfgp #endif @@ -59896,68 +59896,68 @@ SUBROUTINE contract_dfgd(work, & imax = 10*15*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*7*9 kmax = 6 @@ -59965,41 +59965,41 @@ SUBROUTINE contract_dfgd(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dfgd #endif @@ -60050,68 +60050,68 @@ SUBROUTINE contract_dfgf(work, & imax = 10*15*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*7*9 kmax = 10 @@ -60119,65 +60119,65 @@ SUBROUTINE contract_dfgf(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dfgf #endif @@ -60228,68 +60228,68 @@ SUBROUTINE contract_dfgg(work, & imax = 10*15*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*7*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*7*9 kmax = 15 @@ -60297,101 +60297,101 @@ SUBROUTINE contract_dfgg(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dfgg #endif @@ -60442,53 +60442,53 @@ SUBROUTINE contract_dgss(work, & imax = 15*1*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*9*1 kmax = 1 @@ -60496,20 +60496,20 @@ SUBROUTINE contract_dgss(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dgss #endif @@ -60560,53 +60560,53 @@ SUBROUTINE contract_dgsp(work, & imax = 15*1*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*9*1 kmax = 3 @@ -60614,26 +60614,26 @@ SUBROUTINE contract_dgsp(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dgsp #endif @@ -60684,53 +60684,53 @@ SUBROUTINE contract_dgsd(work, & imax = 15*1*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*9*1 kmax = 6 @@ -60738,41 +60738,41 @@ SUBROUTINE contract_dgsd(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dgsd #endif @@ -60823,53 +60823,53 @@ SUBROUTINE contract_dgsf(work, & imax = 15*1*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*9*1 kmax = 10 @@ -60877,65 +60877,65 @@ SUBROUTINE contract_dgsf(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dgsf #endif @@ -60986,53 +60986,53 @@ SUBROUTINE contract_dgsg(work, & imax = 15*1*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*1*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 5*9*1 kmax = 15 @@ -61040,101 +61040,101 @@ SUBROUTINE contract_dgsg(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dgsg #endif @@ -61185,55 +61185,55 @@ SUBROUTINE contract_dgps(work, & imax = 15*3*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*9*3 kmax = 1 @@ -61241,20 +61241,20 @@ SUBROUTINE contract_dgps(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dgps #endif @@ -61305,55 +61305,55 @@ SUBROUTINE contract_dgpp(work, & imax = 15*3*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*9*3 kmax = 3 @@ -61361,26 +61361,26 @@ SUBROUTINE contract_dgpp(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dgpp #endif @@ -61431,55 +61431,55 @@ SUBROUTINE contract_dgpd(work, & imax = 15*3*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*9*3 kmax = 6 @@ -61487,41 +61487,41 @@ SUBROUTINE contract_dgpd(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dgpd #endif @@ -61572,55 +61572,55 @@ SUBROUTINE contract_dgpf(work, & imax = 15*3*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*9*3 kmax = 10 @@ -61628,65 +61628,65 @@ SUBROUTINE contract_dgpf(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dgpf #endif @@ -61737,55 +61737,55 @@ SUBROUTINE contract_dgpg(work, & imax = 15*3*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*3*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 5*9*3 kmax = 15 @@ -61793,101 +61793,101 @@ SUBROUTINE contract_dgpg(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dgpg #endif @@ -61938,60 +61938,60 @@ SUBROUTINE contract_dgds(work, & imax = 15*6*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*9*5 kmax = 1 @@ -61999,20 +61999,20 @@ SUBROUTINE contract_dgds(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dgds #endif @@ -62063,60 +62063,60 @@ SUBROUTINE contract_dgdp(work, & imax = 15*6*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*9*5 kmax = 3 @@ -62124,26 +62124,26 @@ SUBROUTINE contract_dgdp(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dgdp #endif @@ -62194,60 +62194,60 @@ SUBROUTINE contract_dgdd(work, & imax = 15*6*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*9*5 kmax = 6 @@ -62255,41 +62255,41 @@ SUBROUTINE contract_dgdd(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dgdd #endif @@ -62340,60 +62340,60 @@ SUBROUTINE contract_dgdf(work, & imax = 15*6*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*9*5 kmax = 10 @@ -62401,65 +62401,65 @@ SUBROUTINE contract_dgdf(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dgdf #endif @@ -62510,60 +62510,60 @@ SUBROUTINE contract_dgdg(work, & imax = 15*6*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*6*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 5*9*5 kmax = 15 @@ -62571,101 +62571,101 @@ SUBROUTINE contract_dgdg(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dgdg #endif @@ -62716,68 +62716,68 @@ SUBROUTINE contract_dgfs(work, & imax = 15*10*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*9*7 kmax = 1 @@ -62785,20 +62785,20 @@ SUBROUTINE contract_dgfs(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dgfs #endif @@ -62849,68 +62849,68 @@ SUBROUTINE contract_dgfp(work, & imax = 15*10*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*9*7 kmax = 3 @@ -62918,26 +62918,26 @@ SUBROUTINE contract_dgfp(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dgfp #endif @@ -62988,68 +62988,68 @@ SUBROUTINE contract_dgfd(work, & imax = 15*10*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*9*7 kmax = 6 @@ -63057,41 +63057,41 @@ SUBROUTINE contract_dgfd(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dgfd #endif @@ -63142,68 +63142,68 @@ SUBROUTINE contract_dgff(work, & imax = 15*10*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*9*7 kmax = 10 @@ -63211,65 +63211,65 @@ SUBROUTINE contract_dgff(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dgff #endif @@ -63320,68 +63320,68 @@ SUBROUTINE contract_dgfg(work, & imax = 15*10*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*10*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 5*9*7 kmax = 15 @@ -63389,101 +63389,101 @@ SUBROUTINE contract_dgfg(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dgfg #endif @@ -63534,80 +63534,80 @@ SUBROUTINE contract_dggs(work, & imax = 15*15*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*9*9 kmax = 1 @@ -63615,20 +63615,20 @@ SUBROUTINE contract_dggs(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dggs #endif @@ -63679,80 +63679,80 @@ SUBROUTINE contract_dggp(work, & imax = 15*15*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*9*9 kmax = 3 @@ -63760,26 +63760,26 @@ SUBROUTINE contract_dggp(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+5 + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dggp #endif @@ -63830,80 +63830,80 @@ SUBROUTINE contract_dggd(work, & imax = 15*15*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*9*9 kmax = 6 @@ -63911,41 +63911,41 @@ SUBROUTINE contract_dggd(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dggd #endif @@ -63996,80 +63996,80 @@ SUBROUTINE contract_dggf(work, & imax = 15*15*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*9*9 kmax = 10 @@ -64077,65 +64077,65 @@ SUBROUTINE contract_dggf(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dggf #endif @@ -64186,80 +64186,80 @@ SUBROUTINE contract_dggg(work, & imax = 15*15*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 5*15*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 5*9*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 5*9*9 kmax = 15 @@ -64267,101 +64267,101 @@ SUBROUTINE contract_dggg(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 5 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+5 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 5 END DO END SUBROUTINE contract_dggg #endif @@ -64412,34 +64412,34 @@ SUBROUTINE contract_fsss(work, & imax = 1*1*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*1*1 kmax = 1 @@ -64447,20 +64447,20 @@ SUBROUTINE contract_fsss(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fsss #endif @@ -64511,34 +64511,34 @@ SUBROUTINE contract_fssp(work, & imax = 1*1*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*1*1 kmax = 3 @@ -64546,26 +64546,26 @@ SUBROUTINE contract_fssp(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fssp #endif @@ -64616,34 +64616,34 @@ SUBROUTINE contract_fssd(work, & imax = 1*1*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*1*1 kmax = 6 @@ -64651,41 +64651,41 @@ SUBROUTINE contract_fssd(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fssd #endif @@ -64736,34 +64736,34 @@ SUBROUTINE contract_fssf(work, & imax = 1*1*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*1*1 kmax = 10 @@ -64771,65 +64771,65 @@ SUBROUTINE contract_fssf(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fssf #endif @@ -64880,34 +64880,34 @@ SUBROUTINE contract_fssg(work, & imax = 1*1*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*1*1 kmax = 15 @@ -64915,101 +64915,101 @@ SUBROUTINE contract_fssg(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fssg #endif @@ -65060,36 +65060,36 @@ SUBROUTINE contract_fsps(work, & imax = 1*3*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*1*3 kmax = 1 @@ -65097,20 +65097,20 @@ SUBROUTINE contract_fsps(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fsps #endif @@ -65161,36 +65161,36 @@ SUBROUTINE contract_fspp(work, & imax = 1*3*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*1*3 kmax = 3 @@ -65198,26 +65198,26 @@ SUBROUTINE contract_fspp(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fspp #endif @@ -65268,36 +65268,36 @@ SUBROUTINE contract_fspd(work, & imax = 1*3*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*1*3 kmax = 6 @@ -65305,41 +65305,41 @@ SUBROUTINE contract_fspd(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fspd #endif @@ -65390,36 +65390,36 @@ SUBROUTINE contract_fspf(work, & imax = 1*3*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*1*3 kmax = 10 @@ -65427,65 +65427,65 @@ SUBROUTINE contract_fspf(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fspf #endif @@ -65536,36 +65536,36 @@ SUBROUTINE contract_fspg(work, & imax = 1*3*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*1*3 kmax = 15 @@ -65573,101 +65573,101 @@ SUBROUTINE contract_fspg(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fspg #endif @@ -65718,41 +65718,41 @@ SUBROUTINE contract_fsds(work, & imax = 1*6*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*1*5 kmax = 1 @@ -65760,20 +65760,20 @@ SUBROUTINE contract_fsds(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fsds #endif @@ -65824,41 +65824,41 @@ SUBROUTINE contract_fsdp(work, & imax = 1*6*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*1*5 kmax = 3 @@ -65866,26 +65866,26 @@ SUBROUTINE contract_fsdp(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fsdp #endif @@ -65936,41 +65936,41 @@ SUBROUTINE contract_fsdd(work, & imax = 1*6*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*1*5 kmax = 6 @@ -65978,41 +65978,41 @@ SUBROUTINE contract_fsdd(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fsdd #endif @@ -66063,41 +66063,41 @@ SUBROUTINE contract_fsdf(work, & imax = 1*6*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*1*5 kmax = 10 @@ -66105,65 +66105,65 @@ SUBROUTINE contract_fsdf(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fsdf #endif @@ -66214,41 +66214,41 @@ SUBROUTINE contract_fsdg(work, & imax = 1*6*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*1*5 kmax = 15 @@ -66256,101 +66256,101 @@ SUBROUTINE contract_fsdg(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fsdg #endif @@ -66401,49 +66401,49 @@ SUBROUTINE contract_fsfs(work, & imax = 1*10*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*1*7 kmax = 1 @@ -66451,20 +66451,20 @@ SUBROUTINE contract_fsfs(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fsfs #endif @@ -66515,49 +66515,49 @@ SUBROUTINE contract_fsfp(work, & imax = 1*10*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*1*7 kmax = 3 @@ -66565,26 +66565,26 @@ SUBROUTINE contract_fsfp(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fsfp #endif @@ -66635,49 +66635,49 @@ SUBROUTINE contract_fsfd(work, & imax = 1*10*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*1*7 kmax = 6 @@ -66685,41 +66685,41 @@ SUBROUTINE contract_fsfd(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fsfd #endif @@ -66770,49 +66770,49 @@ SUBROUTINE contract_fsff(work, & imax = 1*10*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*1*7 kmax = 10 @@ -66820,65 +66820,65 @@ SUBROUTINE contract_fsff(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fsff #endif @@ -66929,49 +66929,49 @@ SUBROUTINE contract_fsfg(work, & imax = 1*10*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*1*7 kmax = 15 @@ -66979,101 +66979,101 @@ SUBROUTINE contract_fsfg(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fsfg #endif @@ -67124,61 +67124,61 @@ SUBROUTINE contract_fsgs(work, & imax = 1*15*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*1*9 kmax = 1 @@ -67186,20 +67186,20 @@ SUBROUTINE contract_fsgs(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fsgs #endif @@ -67250,61 +67250,61 @@ SUBROUTINE contract_fsgp(work, & imax = 1*15*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*1*9 kmax = 3 @@ -67312,26 +67312,26 @@ SUBROUTINE contract_fsgp(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fsgp #endif @@ -67382,61 +67382,61 @@ SUBROUTINE contract_fsgd(work, & imax = 1*15*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*1*9 kmax = 6 @@ -67444,41 +67444,41 @@ SUBROUTINE contract_fsgd(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fsgd #endif @@ -67529,61 +67529,61 @@ SUBROUTINE contract_fsgf(work, & imax = 1*15*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*1*9 kmax = 10 @@ -67591,65 +67591,65 @@ SUBROUTINE contract_fsgf(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fsgf #endif @@ -67700,61 +67700,61 @@ SUBROUTINE contract_fsgg(work, & imax = 1*15*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*1*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*1*9 kmax = 15 @@ -67762,101 +67762,101 @@ SUBROUTINE contract_fsgg(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fsgg #endif @@ -67907,36 +67907,36 @@ SUBROUTINE contract_fpss(work, & imax = 3*1*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*3*1 kmax = 1 @@ -67944,20 +67944,20 @@ SUBROUTINE contract_fpss(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fpss #endif @@ -68008,36 +68008,36 @@ SUBROUTINE contract_fpsp(work, & imax = 3*1*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*3*1 kmax = 3 @@ -68045,26 +68045,26 @@ SUBROUTINE contract_fpsp(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fpsp #endif @@ -68115,36 +68115,36 @@ SUBROUTINE contract_fpsd(work, & imax = 3*1*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*3*1 kmax = 6 @@ -68152,41 +68152,41 @@ SUBROUTINE contract_fpsd(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fpsd #endif @@ -68237,36 +68237,36 @@ SUBROUTINE contract_fpsf(work, & imax = 3*1*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*3*1 kmax = 10 @@ -68274,65 +68274,65 @@ SUBROUTINE contract_fpsf(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fpsf #endif @@ -68383,36 +68383,36 @@ SUBROUTINE contract_fpsg(work, & imax = 3*1*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*3*1 kmax = 15 @@ -68420,101 +68420,101 @@ SUBROUTINE contract_fpsg(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fpsg #endif @@ -68565,38 +68565,38 @@ SUBROUTINE contract_fpps(work, & imax = 3*3*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*3*3 kmax = 1 @@ -68604,20 +68604,20 @@ SUBROUTINE contract_fpps(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fpps #endif @@ -68668,38 +68668,38 @@ SUBROUTINE contract_fppp(work, & imax = 3*3*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*3*3 kmax = 3 @@ -68707,26 +68707,26 @@ SUBROUTINE contract_fppp(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fppp #endif @@ -68777,38 +68777,38 @@ SUBROUTINE contract_fppd(work, & imax = 3*3*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*3*3 kmax = 6 @@ -68816,41 +68816,41 @@ SUBROUTINE contract_fppd(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fppd #endif @@ -68901,38 +68901,38 @@ SUBROUTINE contract_fppf(work, & imax = 3*3*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*3*3 kmax = 10 @@ -68940,65 +68940,65 @@ SUBROUTINE contract_fppf(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fppf #endif @@ -69049,38 +69049,38 @@ SUBROUTINE contract_fppg(work, & imax = 3*3*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*3*3 kmax = 15 @@ -69088,101 +69088,101 @@ SUBROUTINE contract_fppg(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fppg #endif @@ -69233,43 +69233,43 @@ SUBROUTINE contract_fpds(work, & imax = 3*6*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*3*5 kmax = 1 @@ -69277,20 +69277,20 @@ SUBROUTINE contract_fpds(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fpds #endif @@ -69341,43 +69341,43 @@ SUBROUTINE contract_fpdp(work, & imax = 3*6*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*3*5 kmax = 3 @@ -69385,26 +69385,26 @@ SUBROUTINE contract_fpdp(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fpdp #endif @@ -69455,43 +69455,43 @@ SUBROUTINE contract_fpdd(work, & imax = 3*6*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*3*5 kmax = 6 @@ -69499,41 +69499,41 @@ SUBROUTINE contract_fpdd(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fpdd #endif @@ -69584,43 +69584,43 @@ SUBROUTINE contract_fpdf(work, & imax = 3*6*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*3*5 kmax = 10 @@ -69628,65 +69628,65 @@ SUBROUTINE contract_fpdf(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fpdf #endif @@ -69737,43 +69737,43 @@ SUBROUTINE contract_fpdg(work, & imax = 3*6*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*3*5 kmax = 15 @@ -69781,101 +69781,101 @@ SUBROUTINE contract_fpdg(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fpdg #endif @@ -69926,51 +69926,51 @@ SUBROUTINE contract_fpfs(work, & imax = 3*10*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*3*7 kmax = 1 @@ -69978,20 +69978,20 @@ SUBROUTINE contract_fpfs(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fpfs #endif @@ -70042,51 +70042,51 @@ SUBROUTINE contract_fpfp(work, & imax = 3*10*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*3*7 kmax = 3 @@ -70094,26 +70094,26 @@ SUBROUTINE contract_fpfp(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fpfp #endif @@ -70164,51 +70164,51 @@ SUBROUTINE contract_fpfd(work, & imax = 3*10*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*3*7 kmax = 6 @@ -70216,41 +70216,41 @@ SUBROUTINE contract_fpfd(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fpfd #endif @@ -70301,51 +70301,51 @@ SUBROUTINE contract_fpff(work, & imax = 3*10*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*3*7 kmax = 10 @@ -70353,65 +70353,65 @@ SUBROUTINE contract_fpff(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fpff #endif @@ -70462,51 +70462,51 @@ SUBROUTINE contract_fpfg(work, & imax = 3*10*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*3*7 kmax = 15 @@ -70514,101 +70514,101 @@ SUBROUTINE contract_fpfg(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fpfg #endif @@ -70659,63 +70659,63 @@ SUBROUTINE contract_fpgs(work, & imax = 3*15*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*3*9 kmax = 1 @@ -70723,20 +70723,20 @@ SUBROUTINE contract_fpgs(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fpgs #endif @@ -70787,63 +70787,63 @@ SUBROUTINE contract_fpgp(work, & imax = 3*15*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*3*9 kmax = 3 @@ -70851,26 +70851,26 @@ SUBROUTINE contract_fpgp(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fpgp #endif @@ -70921,63 +70921,63 @@ SUBROUTINE contract_fpgd(work, & imax = 3*15*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*3*9 kmax = 6 @@ -70985,41 +70985,41 @@ SUBROUTINE contract_fpgd(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fpgd #endif @@ -71070,63 +71070,63 @@ SUBROUTINE contract_fpgf(work, & imax = 3*15*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*3*9 kmax = 10 @@ -71134,65 +71134,65 @@ SUBROUTINE contract_fpgf(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fpgf #endif @@ -71243,63 +71243,63 @@ SUBROUTINE contract_fpgg(work, & imax = 3*15*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*3*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*3*9 kmax = 15 @@ -71307,101 +71307,101 @@ SUBROUTINE contract_fpgg(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fpgg #endif @@ -71452,41 +71452,41 @@ SUBROUTINE contract_fdss(work, & imax = 6*1*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*5*1 kmax = 1 @@ -71494,20 +71494,20 @@ SUBROUTINE contract_fdss(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fdss #endif @@ -71558,41 +71558,41 @@ SUBROUTINE contract_fdsp(work, & imax = 6*1*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*5*1 kmax = 3 @@ -71600,26 +71600,26 @@ SUBROUTINE contract_fdsp(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fdsp #endif @@ -71670,41 +71670,41 @@ SUBROUTINE contract_fdsd(work, & imax = 6*1*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*5*1 kmax = 6 @@ -71712,41 +71712,41 @@ SUBROUTINE contract_fdsd(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fdsd #endif @@ -71797,41 +71797,41 @@ SUBROUTINE contract_fdsf(work, & imax = 6*1*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*5*1 kmax = 10 @@ -71839,65 +71839,65 @@ SUBROUTINE contract_fdsf(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fdsf #endif @@ -71948,41 +71948,41 @@ SUBROUTINE contract_fdsg(work, & imax = 6*1*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*5*1 kmax = 15 @@ -71990,101 +71990,101 @@ SUBROUTINE contract_fdsg(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fdsg #endif @@ -72135,43 +72135,43 @@ SUBROUTINE contract_fdps(work, & imax = 6*3*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*5*3 kmax = 1 @@ -72179,20 +72179,20 @@ SUBROUTINE contract_fdps(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fdps #endif @@ -72243,43 +72243,43 @@ SUBROUTINE contract_fdpp(work, & imax = 6*3*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*5*3 kmax = 3 @@ -72287,26 +72287,26 @@ SUBROUTINE contract_fdpp(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fdpp #endif @@ -72357,43 +72357,43 @@ SUBROUTINE contract_fdpd(work, & imax = 6*3*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*5*3 kmax = 6 @@ -72401,41 +72401,41 @@ SUBROUTINE contract_fdpd(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fdpd #endif @@ -72486,43 +72486,43 @@ SUBROUTINE contract_fdpf(work, & imax = 6*3*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*5*3 kmax = 10 @@ -72530,65 +72530,65 @@ SUBROUTINE contract_fdpf(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fdpf #endif @@ -72639,43 +72639,43 @@ SUBROUTINE contract_fdpg(work, & imax = 6*3*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*5*3 kmax = 15 @@ -72683,101 +72683,101 @@ SUBROUTINE contract_fdpg(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fdpg #endif @@ -72828,48 +72828,48 @@ SUBROUTINE contract_fdds(work, & imax = 6*6*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*5*5 kmax = 1 @@ -72877,20 +72877,20 @@ SUBROUTINE contract_fdds(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fdds #endif @@ -72941,48 +72941,48 @@ SUBROUTINE contract_fddp(work, & imax = 6*6*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*5*5 kmax = 3 @@ -72990,26 +72990,26 @@ SUBROUTINE contract_fddp(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fddp #endif @@ -73060,48 +73060,48 @@ SUBROUTINE contract_fddd(work, & imax = 6*6*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*5*5 kmax = 6 @@ -73109,41 +73109,41 @@ SUBROUTINE contract_fddd(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fddd #endif @@ -73194,48 +73194,48 @@ SUBROUTINE contract_fddf(work, & imax = 6*6*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*5*5 kmax = 10 @@ -73243,65 +73243,65 @@ SUBROUTINE contract_fddf(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fddf #endif @@ -73352,48 +73352,48 @@ SUBROUTINE contract_fddg(work, & imax = 6*6*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*5*5 kmax = 15 @@ -73401,101 +73401,101 @@ SUBROUTINE contract_fddg(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fddg #endif @@ -73546,56 +73546,56 @@ SUBROUTINE contract_fdfs(work, & imax = 6*10*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*5*7 kmax = 1 @@ -73603,20 +73603,20 @@ SUBROUTINE contract_fdfs(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fdfs #endif @@ -73667,56 +73667,56 @@ SUBROUTINE contract_fdfp(work, & imax = 6*10*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*5*7 kmax = 3 @@ -73724,26 +73724,26 @@ SUBROUTINE contract_fdfp(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fdfp #endif @@ -73794,56 +73794,56 @@ SUBROUTINE contract_fdfd(work, & imax = 6*10*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*5*7 kmax = 6 @@ -73851,41 +73851,41 @@ SUBROUTINE contract_fdfd(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fdfd #endif @@ -73936,56 +73936,56 @@ SUBROUTINE contract_fdff(work, & imax = 6*10*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*5*7 kmax = 10 @@ -73993,65 +73993,65 @@ SUBROUTINE contract_fdff(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fdff #endif @@ -74102,56 +74102,56 @@ SUBROUTINE contract_fdfg(work, & imax = 6*10*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*5*7 kmax = 15 @@ -74159,101 +74159,101 @@ SUBROUTINE contract_fdfg(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fdfg #endif @@ -74304,68 +74304,68 @@ SUBROUTINE contract_fdgs(work, & imax = 6*15*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*5*9 kmax = 1 @@ -74373,20 +74373,20 @@ SUBROUTINE contract_fdgs(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fdgs #endif @@ -74437,68 +74437,68 @@ SUBROUTINE contract_fdgp(work, & imax = 6*15*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*5*9 kmax = 3 @@ -74506,26 +74506,26 @@ SUBROUTINE contract_fdgp(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fdgp #endif @@ -74576,68 +74576,68 @@ SUBROUTINE contract_fdgd(work, & imax = 6*15*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*5*9 kmax = 6 @@ -74645,41 +74645,41 @@ SUBROUTINE contract_fdgd(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fdgd #endif @@ -74730,68 +74730,68 @@ SUBROUTINE contract_fdgf(work, & imax = 6*15*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*5*9 kmax = 10 @@ -74799,65 +74799,65 @@ SUBROUTINE contract_fdgf(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fdgf #endif @@ -74908,68 +74908,68 @@ SUBROUTINE contract_fdgg(work, & imax = 6*15*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*5*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*5*9 kmax = 15 @@ -74977,101 +74977,101 @@ SUBROUTINE contract_fdgg(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fdgg #endif @@ -75122,49 +75122,49 @@ SUBROUTINE contract_ffss(work, & imax = 10*1*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*7*1 kmax = 1 @@ -75172,20 +75172,20 @@ SUBROUTINE contract_ffss(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_ffss #endif @@ -75236,49 +75236,49 @@ SUBROUTINE contract_ffsp(work, & imax = 10*1*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*7*1 kmax = 3 @@ -75286,26 +75286,26 @@ SUBROUTINE contract_ffsp(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_ffsp #endif @@ -75356,49 +75356,49 @@ SUBROUTINE contract_ffsd(work, & imax = 10*1*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*7*1 kmax = 6 @@ -75406,41 +75406,41 @@ SUBROUTINE contract_ffsd(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_ffsd #endif @@ -75491,49 +75491,49 @@ SUBROUTINE contract_ffsf(work, & imax = 10*1*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*7*1 kmax = 10 @@ -75541,65 +75541,65 @@ SUBROUTINE contract_ffsf(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_ffsf #endif @@ -75650,49 +75650,49 @@ SUBROUTINE contract_ffsg(work, & imax = 10*1*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*7*1 kmax = 15 @@ -75700,101 +75700,101 @@ SUBROUTINE contract_ffsg(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_ffsg #endif @@ -75845,51 +75845,51 @@ SUBROUTINE contract_ffps(work, & imax = 10*3*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*7*3 kmax = 1 @@ -75897,20 +75897,20 @@ SUBROUTINE contract_ffps(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_ffps #endif @@ -75961,51 +75961,51 @@ SUBROUTINE contract_ffpp(work, & imax = 10*3*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*7*3 kmax = 3 @@ -76013,26 +76013,26 @@ SUBROUTINE contract_ffpp(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_ffpp #endif @@ -76083,51 +76083,51 @@ SUBROUTINE contract_ffpd(work, & imax = 10*3*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*7*3 kmax = 6 @@ -76135,41 +76135,41 @@ SUBROUTINE contract_ffpd(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_ffpd #endif @@ -76220,51 +76220,51 @@ SUBROUTINE contract_ffpf(work, & imax = 10*3*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*7*3 kmax = 10 @@ -76272,65 +76272,65 @@ SUBROUTINE contract_ffpf(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_ffpf #endif @@ -76381,51 +76381,51 @@ SUBROUTINE contract_ffpg(work, & imax = 10*3*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*7*3 kmax = 15 @@ -76433,101 +76433,101 @@ SUBROUTINE contract_ffpg(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_ffpg #endif @@ -76578,56 +76578,56 @@ SUBROUTINE contract_ffds(work, & imax = 10*6*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*7*5 kmax = 1 @@ -76635,20 +76635,20 @@ SUBROUTINE contract_ffds(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_ffds #endif @@ -76699,56 +76699,56 @@ SUBROUTINE contract_ffdp(work, & imax = 10*6*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*7*5 kmax = 3 @@ -76756,26 +76756,26 @@ SUBROUTINE contract_ffdp(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_ffdp #endif @@ -76826,56 +76826,56 @@ SUBROUTINE contract_ffdd(work, & imax = 10*6*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*7*5 kmax = 6 @@ -76883,41 +76883,41 @@ SUBROUTINE contract_ffdd(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_ffdd #endif @@ -76968,56 +76968,56 @@ SUBROUTINE contract_ffdf(work, & imax = 10*6*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*7*5 kmax = 10 @@ -77025,65 +77025,65 @@ SUBROUTINE contract_ffdf(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_ffdf #endif @@ -77134,56 +77134,56 @@ SUBROUTINE contract_ffdg(work, & imax = 10*6*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*7*5 kmax = 15 @@ -77191,101 +77191,101 @@ SUBROUTINE contract_ffdg(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_ffdg #endif @@ -77336,64 +77336,64 @@ SUBROUTINE contract_fffs(work, & imax = 10*10*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*7*7 kmax = 1 @@ -77401,20 +77401,20 @@ SUBROUTINE contract_fffs(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fffs #endif @@ -77465,64 +77465,64 @@ SUBROUTINE contract_fffp(work, & imax = 10*10*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*7*7 kmax = 3 @@ -77530,26 +77530,26 @@ SUBROUTINE contract_fffp(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fffp #endif @@ -77600,64 +77600,64 @@ SUBROUTINE contract_fffd(work, & imax = 10*10*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*7*7 kmax = 6 @@ -77665,41 +77665,41 @@ SUBROUTINE contract_fffd(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fffd #endif @@ -77750,64 +77750,64 @@ SUBROUTINE contract_ffff(work, & imax = 10*10*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*7*7 kmax = 10 @@ -77815,65 +77815,65 @@ SUBROUTINE contract_ffff(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_ffff #endif @@ -77924,64 +77924,64 @@ SUBROUTINE contract_fffg(work, & imax = 10*10*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*7*7 kmax = 15 @@ -77989,101 +77989,101 @@ SUBROUTINE contract_fffg(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fffg #endif @@ -78134,76 +78134,76 @@ SUBROUTINE contract_ffgs(work, & imax = 10*15*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*7*9 kmax = 1 @@ -78211,20 +78211,20 @@ SUBROUTINE contract_ffgs(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_ffgs #endif @@ -78275,76 +78275,76 @@ SUBROUTINE contract_ffgp(work, & imax = 10*15*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*7*9 kmax = 3 @@ -78352,26 +78352,26 @@ SUBROUTINE contract_ffgp(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_ffgp #endif @@ -78422,76 +78422,76 @@ SUBROUTINE contract_ffgd(work, & imax = 10*15*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*7*9 kmax = 6 @@ -78499,41 +78499,41 @@ SUBROUTINE contract_ffgd(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_ffgd #endif @@ -78584,76 +78584,76 @@ SUBROUTINE contract_ffgf(work, & imax = 10*15*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*7*9 kmax = 10 @@ -78661,65 +78661,65 @@ SUBROUTINE contract_ffgf(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_ffgf #endif @@ -78770,76 +78770,76 @@ SUBROUTINE contract_ffgg(work, & imax = 10*15*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*7*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*7*9 kmax = 15 @@ -78847,101 +78847,101 @@ SUBROUTINE contract_ffgg(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_ffgg #endif @@ -78992,61 +78992,61 @@ SUBROUTINE contract_fgss(work, & imax = 15*1*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*9*1 kmax = 1 @@ -79054,20 +79054,20 @@ SUBROUTINE contract_fgss(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fgss #endif @@ -79118,61 +79118,61 @@ SUBROUTINE contract_fgsp(work, & imax = 15*1*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*9*1 kmax = 3 @@ -79180,26 +79180,26 @@ SUBROUTINE contract_fgsp(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fgsp #endif @@ -79250,61 +79250,61 @@ SUBROUTINE contract_fgsd(work, & imax = 15*1*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*9*1 kmax = 6 @@ -79312,41 +79312,41 @@ SUBROUTINE contract_fgsd(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fgsd #endif @@ -79397,61 +79397,61 @@ SUBROUTINE contract_fgsf(work, & imax = 15*1*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*9*1 kmax = 10 @@ -79459,65 +79459,65 @@ SUBROUTINE contract_fgsf(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fgsf #endif @@ -79568,61 +79568,61 @@ SUBROUTINE contract_fgsg(work, & imax = 15*1*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*1*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 7*9*1 kmax = 15 @@ -79630,101 +79630,101 @@ SUBROUTINE contract_fgsg(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fgsg #endif @@ -79775,63 +79775,63 @@ SUBROUTINE contract_fgps(work, & imax = 15*3*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*9*3 kmax = 1 @@ -79839,20 +79839,20 @@ SUBROUTINE contract_fgps(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fgps #endif @@ -79903,63 +79903,63 @@ SUBROUTINE contract_fgpp(work, & imax = 15*3*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*9*3 kmax = 3 @@ -79967,26 +79967,26 @@ SUBROUTINE contract_fgpp(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fgpp #endif @@ -80037,63 +80037,63 @@ SUBROUTINE contract_fgpd(work, & imax = 15*3*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*9*3 kmax = 6 @@ -80101,41 +80101,41 @@ SUBROUTINE contract_fgpd(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fgpd #endif @@ -80186,63 +80186,63 @@ SUBROUTINE contract_fgpf(work, & imax = 15*3*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*9*3 kmax = 10 @@ -80250,65 +80250,65 @@ SUBROUTINE contract_fgpf(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fgpf #endif @@ -80359,63 +80359,63 @@ SUBROUTINE contract_fgpg(work, & imax = 15*3*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*3*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 7*9*3 kmax = 15 @@ -80423,101 +80423,101 @@ SUBROUTINE contract_fgpg(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fgpg #endif @@ -80568,68 +80568,68 @@ SUBROUTINE contract_fgds(work, & imax = 15*6*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*9*5 kmax = 1 @@ -80637,20 +80637,20 @@ SUBROUTINE contract_fgds(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fgds #endif @@ -80701,68 +80701,68 @@ SUBROUTINE contract_fgdp(work, & imax = 15*6*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*9*5 kmax = 3 @@ -80770,26 +80770,26 @@ SUBROUTINE contract_fgdp(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fgdp #endif @@ -80840,68 +80840,68 @@ SUBROUTINE contract_fgdd(work, & imax = 15*6*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*9*5 kmax = 6 @@ -80909,41 +80909,41 @@ SUBROUTINE contract_fgdd(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fgdd #endif @@ -80994,68 +80994,68 @@ SUBROUTINE contract_fgdf(work, & imax = 15*6*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*9*5 kmax = 10 @@ -81063,65 +81063,65 @@ SUBROUTINE contract_fgdf(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fgdf #endif @@ -81172,68 +81172,68 @@ SUBROUTINE contract_fgdg(work, & imax = 15*6*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*6*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 7*9*5 kmax = 15 @@ -81241,101 +81241,101 @@ SUBROUTINE contract_fgdg(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fgdg #endif @@ -81386,76 +81386,76 @@ SUBROUTINE contract_fgfs(work, & imax = 15*10*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*9*7 kmax = 1 @@ -81463,20 +81463,20 @@ SUBROUTINE contract_fgfs(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fgfs #endif @@ -81527,76 +81527,76 @@ SUBROUTINE contract_fgfp(work, & imax = 15*10*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*9*7 kmax = 3 @@ -81604,26 +81604,26 @@ SUBROUTINE contract_fgfp(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fgfp #endif @@ -81674,76 +81674,76 @@ SUBROUTINE contract_fgfd(work, & imax = 15*10*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*9*7 kmax = 6 @@ -81751,41 +81751,41 @@ SUBROUTINE contract_fgfd(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fgfd #endif @@ -81836,76 +81836,76 @@ SUBROUTINE contract_fgff(work, & imax = 15*10*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*9*7 kmax = 10 @@ -81913,65 +81913,65 @@ SUBROUTINE contract_fgff(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fgff #endif @@ -82022,76 +82022,76 @@ SUBROUTINE contract_fgfg(work, & imax = 15*10*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*10*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 7*9*7 kmax = 15 @@ -82099,101 +82099,101 @@ SUBROUTINE contract_fgfg(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fgfg #endif @@ -82244,88 +82244,88 @@ SUBROUTINE contract_fggs(work, & imax = 15*15*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*9*9 kmax = 1 @@ -82333,20 +82333,20 @@ SUBROUTINE contract_fggs(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fggs #endif @@ -82397,88 +82397,88 @@ SUBROUTINE contract_fggp(work, & imax = 15*15*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*9*9 kmax = 3 @@ -82486,26 +82486,26 @@ SUBROUTINE contract_fggp(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+7 + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fggp #endif @@ -82556,88 +82556,88 @@ SUBROUTINE contract_fggd(work, & imax = 15*15*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*9*9 kmax = 6 @@ -82645,41 +82645,41 @@ SUBROUTINE contract_fggd(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fggd #endif @@ -82730,88 +82730,88 @@ SUBROUTINE contract_fggf(work, & imax = 15*15*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*9*9 kmax = 10 @@ -82819,65 +82819,65 @@ SUBROUTINE contract_fggf(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fggf #endif @@ -82928,88 +82928,88 @@ SUBROUTINE contract_fggg(work, & imax = 15*15*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 7*15*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 7*9*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 7*9*9 kmax = 15 @@ -83017,101 +83017,101 @@ SUBROUTINE contract_fggg(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 7 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+7 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 7 END DO END SUBROUTINE contract_fggg #endif @@ -83162,46 +83162,46 @@ SUBROUTINE contract_gsss(work, & imax = 1*1*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*1*1 kmax = 1 @@ -83209,20 +83209,20 @@ SUBROUTINE contract_gsss(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gsss #endif @@ -83273,46 +83273,46 @@ SUBROUTINE contract_gssp(work, & imax = 1*1*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*1*1 kmax = 3 @@ -83320,26 +83320,26 @@ SUBROUTINE contract_gssp(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gssp #endif @@ -83390,46 +83390,46 @@ SUBROUTINE contract_gssd(work, & imax = 1*1*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*1*1 kmax = 6 @@ -83437,41 +83437,41 @@ SUBROUTINE contract_gssd(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gssd #endif @@ -83522,46 +83522,46 @@ SUBROUTINE contract_gssf(work, & imax = 1*1*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*1*1 kmax = 10 @@ -83569,65 +83569,65 @@ SUBROUTINE contract_gssf(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gssf #endif @@ -83678,46 +83678,46 @@ SUBROUTINE contract_gssg(work, & imax = 1*1*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*1*1 kmax = 15 @@ -83725,101 +83725,101 @@ SUBROUTINE contract_gssg(work, & DO i1 = 1, 1 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gssg #endif @@ -83870,48 +83870,48 @@ SUBROUTINE contract_gsps(work, & imax = 1*3*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*1*3 kmax = 1 @@ -83919,20 +83919,20 @@ SUBROUTINE contract_gsps(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gsps #endif @@ -83983,48 +83983,48 @@ SUBROUTINE contract_gspp(work, & imax = 1*3*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*1*3 kmax = 3 @@ -84032,26 +84032,26 @@ SUBROUTINE contract_gspp(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gspp #endif @@ -84102,48 +84102,48 @@ SUBROUTINE contract_gspd(work, & imax = 1*3*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*1*3 kmax = 6 @@ -84151,41 +84151,41 @@ SUBROUTINE contract_gspd(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gspd #endif @@ -84236,48 +84236,48 @@ SUBROUTINE contract_gspf(work, & imax = 1*3*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*1*3 kmax = 10 @@ -84285,65 +84285,65 @@ SUBROUTINE contract_gspf(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gspf #endif @@ -84394,48 +84394,48 @@ SUBROUTINE contract_gspg(work, & imax = 1*3*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*1*3 kmax = 15 @@ -84443,101 +84443,101 @@ SUBROUTINE contract_gspg(work, & DO i1 = 1, 3 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gspg #endif @@ -84588,53 +84588,53 @@ SUBROUTINE contract_gsds(work, & imax = 1*6*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*1*5 kmax = 1 @@ -84642,20 +84642,20 @@ SUBROUTINE contract_gsds(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gsds #endif @@ -84706,53 +84706,53 @@ SUBROUTINE contract_gsdp(work, & imax = 1*6*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*1*5 kmax = 3 @@ -84760,26 +84760,26 @@ SUBROUTINE contract_gsdp(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gsdp #endif @@ -84830,53 +84830,53 @@ SUBROUTINE contract_gsdd(work, & imax = 1*6*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*1*5 kmax = 6 @@ -84884,41 +84884,41 @@ SUBROUTINE contract_gsdd(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gsdd #endif @@ -84969,53 +84969,53 @@ SUBROUTINE contract_gsdf(work, & imax = 1*6*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*1*5 kmax = 10 @@ -85023,65 +85023,65 @@ SUBROUTINE contract_gsdf(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gsdf #endif @@ -85132,53 +85132,53 @@ SUBROUTINE contract_gsdg(work, & imax = 1*6*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*1*5 kmax = 15 @@ -85186,101 +85186,101 @@ SUBROUTINE contract_gsdg(work, & DO i1 = 1, 5 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gsdg #endif @@ -85331,61 +85331,61 @@ SUBROUTINE contract_gsfs(work, & imax = 1*10*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*1*7 kmax = 1 @@ -85393,20 +85393,20 @@ SUBROUTINE contract_gsfs(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gsfs #endif @@ -85457,61 +85457,61 @@ SUBROUTINE contract_gsfp(work, & imax = 1*10*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*1*7 kmax = 3 @@ -85519,26 +85519,26 @@ SUBROUTINE contract_gsfp(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gsfp #endif @@ -85589,61 +85589,61 @@ SUBROUTINE contract_gsfd(work, & imax = 1*10*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*1*7 kmax = 6 @@ -85651,41 +85651,41 @@ SUBROUTINE contract_gsfd(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gsfd #endif @@ -85736,61 +85736,61 @@ SUBROUTINE contract_gsff(work, & imax = 1*10*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*1*7 kmax = 10 @@ -85798,65 +85798,65 @@ SUBROUTINE contract_gsff(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gsff #endif @@ -85907,61 +85907,61 @@ SUBROUTINE contract_gsfg(work, & imax = 1*10*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*1*7 kmax = 15 @@ -85969,101 +85969,101 @@ SUBROUTINE contract_gsfg(work, & DO i1 = 1, 7 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gsfg #endif @@ -86114,73 +86114,73 @@ SUBROUTINE contract_gsgs(work, & imax = 1*15*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*1 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*1*9 kmax = 1 @@ -86188,20 +86188,20 @@ SUBROUTINE contract_gsgs(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gsgs #endif @@ -86252,73 +86252,73 @@ SUBROUTINE contract_gsgp(work, & imax = 1*15*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*3 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*1*9 kmax = 3 @@ -86326,26 +86326,26 @@ SUBROUTINE contract_gsgp(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+1 + s_offset_b1 = s_offset_b1 + 1 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gsgp #endif @@ -86396,73 +86396,73 @@ SUBROUTINE contract_gsgd(work, & imax = 1*15*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*6 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*1*9 kmax = 6 @@ -86470,41 +86470,41 @@ SUBROUTINE contract_gsgd(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gsgd #endif @@ -86555,73 +86555,73 @@ SUBROUTINE contract_gsgf(work, & imax = 1*15*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*10 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*1*9 kmax = 10 @@ -86629,65 +86629,65 @@ SUBROUTINE contract_gsgf(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gsgf #endif @@ -86738,73 +86738,73 @@ SUBROUTINE contract_gsgg(work, & imax = 1*15*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*15 kmax = 1 DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*1*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*1*9 kmax = 15 @@ -86812,101 +86812,101 @@ SUBROUTINE contract_gsgg(work, & DO i1 = 1, 9 DO i2 = 1, 1 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+1 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 1 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gsgg #endif @@ -86957,48 +86957,48 @@ SUBROUTINE contract_gpss(work, & imax = 3*1*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*3*1 kmax = 1 @@ -87006,20 +87006,20 @@ SUBROUTINE contract_gpss(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gpss #endif @@ -87070,48 +87070,48 @@ SUBROUTINE contract_gpsp(work, & imax = 3*1*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*3*1 kmax = 3 @@ -87119,26 +87119,26 @@ SUBROUTINE contract_gpsp(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gpsp #endif @@ -87189,48 +87189,48 @@ SUBROUTINE contract_gpsd(work, & imax = 3*1*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*3*1 kmax = 6 @@ -87238,41 +87238,41 @@ SUBROUTINE contract_gpsd(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gpsd #endif @@ -87323,48 +87323,48 @@ SUBROUTINE contract_gpsf(work, & imax = 3*1*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*3*1 kmax = 10 @@ -87372,65 +87372,65 @@ SUBROUTINE contract_gpsf(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gpsf #endif @@ -87481,48 +87481,48 @@ SUBROUTINE contract_gpsg(work, & imax = 3*1*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*3*1 kmax = 15 @@ -87530,101 +87530,101 @@ SUBROUTINE contract_gpsg(work, & DO i1 = 1, 1 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gpsg #endif @@ -87675,50 +87675,50 @@ SUBROUTINE contract_gpps(work, & imax = 3*3*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*3*3 kmax = 1 @@ -87726,20 +87726,20 @@ SUBROUTINE contract_gpps(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gpps #endif @@ -87790,50 +87790,50 @@ SUBROUTINE contract_gppp(work, & imax = 3*3*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*3*3 kmax = 3 @@ -87841,26 +87841,26 @@ SUBROUTINE contract_gppp(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gppp #endif @@ -87911,50 +87911,50 @@ SUBROUTINE contract_gppd(work, & imax = 3*3*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*3*3 kmax = 6 @@ -87962,41 +87962,41 @@ SUBROUTINE contract_gppd(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gppd #endif @@ -88047,50 +88047,50 @@ SUBROUTINE contract_gppf(work, & imax = 3*3*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*3*3 kmax = 10 @@ -88098,65 +88098,65 @@ SUBROUTINE contract_gppf(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gppf #endif @@ -88207,50 +88207,50 @@ SUBROUTINE contract_gppg(work, & imax = 3*3*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*3*3 kmax = 15 @@ -88258,101 +88258,101 @@ SUBROUTINE contract_gppg(work, & DO i1 = 1, 3 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gppg #endif @@ -88403,55 +88403,55 @@ SUBROUTINE contract_gpds(work, & imax = 3*6*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*3*5 kmax = 1 @@ -88459,20 +88459,20 @@ SUBROUTINE contract_gpds(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gpds #endif @@ -88523,55 +88523,55 @@ SUBROUTINE contract_gpdp(work, & imax = 3*6*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*3*5 kmax = 3 @@ -88579,26 +88579,26 @@ SUBROUTINE contract_gpdp(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gpdp #endif @@ -88649,55 +88649,55 @@ SUBROUTINE contract_gpdd(work, & imax = 3*6*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*3*5 kmax = 6 @@ -88705,41 +88705,41 @@ SUBROUTINE contract_gpdd(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gpdd #endif @@ -88790,55 +88790,55 @@ SUBROUTINE contract_gpdf(work, & imax = 3*6*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*3*5 kmax = 10 @@ -88846,65 +88846,65 @@ SUBROUTINE contract_gpdf(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gpdf #endif @@ -88955,55 +88955,55 @@ SUBROUTINE contract_gpdg(work, & imax = 3*6*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*3*5 kmax = 15 @@ -89011,101 +89011,101 @@ SUBROUTINE contract_gpdg(work, & DO i1 = 1, 5 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gpdg #endif @@ -89156,63 +89156,63 @@ SUBROUTINE contract_gpfs(work, & imax = 3*10*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*3*7 kmax = 1 @@ -89220,20 +89220,20 @@ SUBROUTINE contract_gpfs(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gpfs #endif @@ -89284,63 +89284,63 @@ SUBROUTINE contract_gpfp(work, & imax = 3*10*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*3*7 kmax = 3 @@ -89348,26 +89348,26 @@ SUBROUTINE contract_gpfp(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gpfp #endif @@ -89418,63 +89418,63 @@ SUBROUTINE contract_gpfd(work, & imax = 3*10*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*3*7 kmax = 6 @@ -89482,41 +89482,41 @@ SUBROUTINE contract_gpfd(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gpfd #endif @@ -89567,63 +89567,63 @@ SUBROUTINE contract_gpff(work, & imax = 3*10*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*3*7 kmax = 10 @@ -89631,65 +89631,65 @@ SUBROUTINE contract_gpff(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gpff #endif @@ -89740,63 +89740,63 @@ SUBROUTINE contract_gpfg(work, & imax = 3*10*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*3*7 kmax = 15 @@ -89804,101 +89804,101 @@ SUBROUTINE contract_gpfg(work, & DO i1 = 1, 7 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gpfg #endif @@ -89949,75 +89949,75 @@ SUBROUTINE contract_gpgs(work, & imax = 3*15*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*1 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*3*9 kmax = 1 @@ -90025,20 +90025,20 @@ SUBROUTINE contract_gpgs(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gpgs #endif @@ -90089,75 +90089,75 @@ SUBROUTINE contract_gpgp(work, & imax = 3*15*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*3 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*3*9 kmax = 3 @@ -90165,26 +90165,26 @@ SUBROUTINE contract_gpgp(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+3 + s_offset_b1 = s_offset_b1 + 3 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gpgp #endif @@ -90235,75 +90235,75 @@ SUBROUTINE contract_gpgd(work, & imax = 3*15*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*6 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*3*9 kmax = 6 @@ -90311,41 +90311,41 @@ SUBROUTINE contract_gpgd(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gpgd #endif @@ -90396,75 +90396,75 @@ SUBROUTINE contract_gpgf(work, & imax = 3*15*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*10 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*3*9 kmax = 10 @@ -90472,65 +90472,65 @@ SUBROUTINE contract_gpgf(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gpgf #endif @@ -90581,75 +90581,75 @@ SUBROUTINE contract_gpgg(work, & imax = 3*15*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*15 kmax = 3 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*3*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*3*9 kmax = 15 @@ -90657,101 +90657,101 @@ SUBROUTINE contract_gpgg(work, & DO i1 = 1, 9 DO i2 = 1, 3 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+3 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 3 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gpgg #endif @@ -90802,53 +90802,53 @@ SUBROUTINE contract_gdss(work, & imax = 6*1*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*5*1 kmax = 1 @@ -90856,20 +90856,20 @@ SUBROUTINE contract_gdss(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gdss #endif @@ -90920,53 +90920,53 @@ SUBROUTINE contract_gdsp(work, & imax = 6*1*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*5*1 kmax = 3 @@ -90974,26 +90974,26 @@ SUBROUTINE contract_gdsp(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gdsp #endif @@ -91044,53 +91044,53 @@ SUBROUTINE contract_gdsd(work, & imax = 6*1*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*5*1 kmax = 6 @@ -91098,41 +91098,41 @@ SUBROUTINE contract_gdsd(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gdsd #endif @@ -91183,53 +91183,53 @@ SUBROUTINE contract_gdsf(work, & imax = 6*1*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*5*1 kmax = 10 @@ -91237,65 +91237,65 @@ SUBROUTINE contract_gdsf(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gdsf #endif @@ -91346,53 +91346,53 @@ SUBROUTINE contract_gdsg(work, & imax = 6*1*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*5*1 kmax = 15 @@ -91400,101 +91400,101 @@ SUBROUTINE contract_gdsg(work, & DO i1 = 1, 1 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gdsg #endif @@ -91545,55 +91545,55 @@ SUBROUTINE contract_gdps(work, & imax = 6*3*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*5*3 kmax = 1 @@ -91601,20 +91601,20 @@ SUBROUTINE contract_gdps(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gdps #endif @@ -91665,55 +91665,55 @@ SUBROUTINE contract_gdpp(work, & imax = 6*3*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*5*3 kmax = 3 @@ -91721,26 +91721,26 @@ SUBROUTINE contract_gdpp(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gdpp #endif @@ -91791,55 +91791,55 @@ SUBROUTINE contract_gdpd(work, & imax = 6*3*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*5*3 kmax = 6 @@ -91847,41 +91847,41 @@ SUBROUTINE contract_gdpd(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gdpd #endif @@ -91932,55 +91932,55 @@ SUBROUTINE contract_gdpf(work, & imax = 6*3*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*5*3 kmax = 10 @@ -91988,65 +91988,65 @@ SUBROUTINE contract_gdpf(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gdpf #endif @@ -92097,55 +92097,55 @@ SUBROUTINE contract_gdpg(work, & imax = 6*3*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*5*3 kmax = 15 @@ -92153,101 +92153,101 @@ SUBROUTINE contract_gdpg(work, & DO i1 = 1, 3 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gdpg #endif @@ -92298,60 +92298,60 @@ SUBROUTINE contract_gdds(work, & imax = 6*6*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*5*5 kmax = 1 @@ -92359,20 +92359,20 @@ SUBROUTINE contract_gdds(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gdds #endif @@ -92423,60 +92423,60 @@ SUBROUTINE contract_gddp(work, & imax = 6*6*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*5*5 kmax = 3 @@ -92484,26 +92484,26 @@ SUBROUTINE contract_gddp(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gddp #endif @@ -92554,60 +92554,60 @@ SUBROUTINE contract_gddd(work, & imax = 6*6*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*5*5 kmax = 6 @@ -92615,41 +92615,41 @@ SUBROUTINE contract_gddd(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gddd #endif @@ -92700,60 +92700,60 @@ SUBROUTINE contract_gddf(work, & imax = 6*6*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*5*5 kmax = 10 @@ -92761,65 +92761,65 @@ SUBROUTINE contract_gddf(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gddf #endif @@ -92870,60 +92870,60 @@ SUBROUTINE contract_gddg(work, & imax = 6*6*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*5*5 kmax = 15 @@ -92931,101 +92931,101 @@ SUBROUTINE contract_gddg(work, & DO i1 = 1, 5 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gddg #endif @@ -93076,68 +93076,68 @@ SUBROUTINE contract_gdfs(work, & imax = 6*10*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*5*7 kmax = 1 @@ -93145,20 +93145,20 @@ SUBROUTINE contract_gdfs(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gdfs #endif @@ -93209,68 +93209,68 @@ SUBROUTINE contract_gdfp(work, & imax = 6*10*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*5*7 kmax = 3 @@ -93278,26 +93278,26 @@ SUBROUTINE contract_gdfp(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gdfp #endif @@ -93348,68 +93348,68 @@ SUBROUTINE contract_gdfd(work, & imax = 6*10*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*5*7 kmax = 6 @@ -93417,41 +93417,41 @@ SUBROUTINE contract_gdfd(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gdfd #endif @@ -93502,68 +93502,68 @@ SUBROUTINE contract_gdff(work, & imax = 6*10*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*5*7 kmax = 10 @@ -93571,65 +93571,65 @@ SUBROUTINE contract_gdff(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gdff #endif @@ -93680,68 +93680,68 @@ SUBROUTINE contract_gdfg(work, & imax = 6*10*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*5*7 kmax = 15 @@ -93749,101 +93749,101 @@ SUBROUTINE contract_gdfg(work, & DO i1 = 1, 7 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gdfg #endif @@ -93894,80 +93894,80 @@ SUBROUTINE contract_gdgs(work, & imax = 6*15*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*1 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*5*9 kmax = 1 @@ -93975,20 +93975,20 @@ SUBROUTINE contract_gdgs(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gdgs #endif @@ -94039,80 +94039,80 @@ SUBROUTINE contract_gdgp(work, & imax = 6*15*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*3 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*5*9 kmax = 3 @@ -94120,26 +94120,26 @@ SUBROUTINE contract_gdgp(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+5 + s_offset_b1 = s_offset_b1 + 5 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gdgp #endif @@ -94190,80 +94190,80 @@ SUBROUTINE contract_gdgd(work, & imax = 6*15*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*6 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*5*9 kmax = 6 @@ -94271,41 +94271,41 @@ SUBROUTINE contract_gdgd(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gdgd #endif @@ -94356,80 +94356,80 @@ SUBROUTINE contract_gdgf(work, & imax = 6*15*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*10 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*5*9 kmax = 10 @@ -94437,65 +94437,65 @@ SUBROUTINE contract_gdgf(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gdgf #endif @@ -94546,80 +94546,80 @@ SUBROUTINE contract_gdgg(work, & imax = 6*15*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*15 kmax = 6 DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*5*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*5*9 kmax = 15 @@ -94627,101 +94627,101 @@ SUBROUTINE contract_gdgg(work, & DO i1 = 1, 9 DO i2 = 1, 5 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+5 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 5 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gdgg #endif @@ -94772,61 +94772,61 @@ SUBROUTINE contract_gfss(work, & imax = 10*1*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*7*1 kmax = 1 @@ -94834,20 +94834,20 @@ SUBROUTINE contract_gfss(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gfss #endif @@ -94898,61 +94898,61 @@ SUBROUTINE contract_gfsp(work, & imax = 10*1*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*7*1 kmax = 3 @@ -94960,26 +94960,26 @@ SUBROUTINE contract_gfsp(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gfsp #endif @@ -95030,61 +95030,61 @@ SUBROUTINE contract_gfsd(work, & imax = 10*1*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*7*1 kmax = 6 @@ -95092,41 +95092,41 @@ SUBROUTINE contract_gfsd(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gfsd #endif @@ -95177,61 +95177,61 @@ SUBROUTINE contract_gfsf(work, & imax = 10*1*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*7*1 kmax = 10 @@ -95239,65 +95239,65 @@ SUBROUTINE contract_gfsf(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gfsf #endif @@ -95348,61 +95348,61 @@ SUBROUTINE contract_gfsg(work, & imax = 10*1*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*7*1 kmax = 15 @@ -95410,101 +95410,101 @@ SUBROUTINE contract_gfsg(work, & DO i1 = 1, 1 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gfsg #endif @@ -95555,63 +95555,63 @@ SUBROUTINE contract_gfps(work, & imax = 10*3*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*7*3 kmax = 1 @@ -95619,20 +95619,20 @@ SUBROUTINE contract_gfps(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gfps #endif @@ -95683,63 +95683,63 @@ SUBROUTINE contract_gfpp(work, & imax = 10*3*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*7*3 kmax = 3 @@ -95747,26 +95747,26 @@ SUBROUTINE contract_gfpp(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gfpp #endif @@ -95817,63 +95817,63 @@ SUBROUTINE contract_gfpd(work, & imax = 10*3*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*7*3 kmax = 6 @@ -95881,41 +95881,41 @@ SUBROUTINE contract_gfpd(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gfpd #endif @@ -95966,63 +95966,63 @@ SUBROUTINE contract_gfpf(work, & imax = 10*3*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*7*3 kmax = 10 @@ -96030,65 +96030,65 @@ SUBROUTINE contract_gfpf(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gfpf #endif @@ -96139,63 +96139,63 @@ SUBROUTINE contract_gfpg(work, & imax = 10*3*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*7*3 kmax = 15 @@ -96203,101 +96203,101 @@ SUBROUTINE contract_gfpg(work, & DO i1 = 1, 3 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gfpg #endif @@ -96348,68 +96348,68 @@ SUBROUTINE contract_gfds(work, & imax = 10*6*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*7*5 kmax = 1 @@ -96417,20 +96417,20 @@ SUBROUTINE contract_gfds(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gfds #endif @@ -96481,68 +96481,68 @@ SUBROUTINE contract_gfdp(work, & imax = 10*6*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*7*5 kmax = 3 @@ -96550,26 +96550,26 @@ SUBROUTINE contract_gfdp(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gfdp #endif @@ -96620,68 +96620,68 @@ SUBROUTINE contract_gfdd(work, & imax = 10*6*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*7*5 kmax = 6 @@ -96689,41 +96689,41 @@ SUBROUTINE contract_gfdd(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gfdd #endif @@ -96774,68 +96774,68 @@ SUBROUTINE contract_gfdf(work, & imax = 10*6*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*7*5 kmax = 10 @@ -96843,65 +96843,65 @@ SUBROUTINE contract_gfdf(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gfdf #endif @@ -96952,68 +96952,68 @@ SUBROUTINE contract_gfdg(work, & imax = 10*6*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*7*5 kmax = 15 @@ -97021,101 +97021,101 @@ SUBROUTINE contract_gfdg(work, & DO i1 = 1, 5 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gfdg #endif @@ -97166,76 +97166,76 @@ SUBROUTINE contract_gffs(work, & imax = 10*10*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*7*7 kmax = 1 @@ -97243,20 +97243,20 @@ SUBROUTINE contract_gffs(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gffs #endif @@ -97307,76 +97307,76 @@ SUBROUTINE contract_gffp(work, & imax = 10*10*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*7*7 kmax = 3 @@ -97384,26 +97384,26 @@ SUBROUTINE contract_gffp(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gffp #endif @@ -97454,76 +97454,76 @@ SUBROUTINE contract_gffd(work, & imax = 10*10*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*7*7 kmax = 6 @@ -97531,41 +97531,41 @@ SUBROUTINE contract_gffd(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gffd #endif @@ -97616,76 +97616,76 @@ SUBROUTINE contract_gfff(work, & imax = 10*10*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*7*7 kmax = 10 @@ -97693,65 +97693,65 @@ SUBROUTINE contract_gfff(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gfff #endif @@ -97802,76 +97802,76 @@ SUBROUTINE contract_gffg(work, & imax = 10*10*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*7*7 kmax = 15 @@ -97879,101 +97879,101 @@ SUBROUTINE contract_gffg(work, & DO i1 = 1, 7 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gffg #endif @@ -98024,88 +98024,88 @@ SUBROUTINE contract_gfgs(work, & imax = 10*15*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*1 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*7*9 kmax = 1 @@ -98113,20 +98113,20 @@ SUBROUTINE contract_gfgs(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gfgs #endif @@ -98177,88 +98177,88 @@ SUBROUTINE contract_gfgp(work, & imax = 10*15*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*3 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*7*9 kmax = 3 @@ -98266,26 +98266,26 @@ SUBROUTINE contract_gfgp(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+7 + s_offset_b1 = s_offset_b1 + 7 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gfgp #endif @@ -98336,88 +98336,88 @@ SUBROUTINE contract_gfgd(work, & imax = 10*15*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*6 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*7*9 kmax = 6 @@ -98425,41 +98425,41 @@ SUBROUTINE contract_gfgd(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gfgd #endif @@ -98510,88 +98510,88 @@ SUBROUTINE contract_gfgf(work, & imax = 10*15*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*10 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*7*9 kmax = 10 @@ -98599,65 +98599,65 @@ SUBROUTINE contract_gfgf(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gfgf #endif @@ -98708,88 +98708,88 @@ SUBROUTINE contract_gfgg(work, & imax = 10*15*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*15 kmax = 10 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*7*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*7*9 kmax = 15 @@ -98797,101 +98797,101 @@ SUBROUTINE contract_gfgg(work, & DO i1 = 1, 9 DO i2 = 1, 7 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+7 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 7 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gfgg #endif @@ -98942,73 +98942,73 @@ SUBROUTINE contract_ggss(work, & imax = 15*1*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*1 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*9*1 kmax = 1 @@ -99016,20 +99016,20 @@ SUBROUTINE contract_ggss(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_ggss #endif @@ -99080,73 +99080,73 @@ SUBROUTINE contract_ggsp(work, & imax = 15*1*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*3 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*9*1 kmax = 3 @@ -99154,26 +99154,26 @@ SUBROUTINE contract_ggsp(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+1 + s_offset_c1 = s_offset_c1 + 1 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_ggsp #endif @@ -99224,73 +99224,73 @@ SUBROUTINE contract_ggsd(work, & imax = 15*1*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*6 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*9*1 kmax = 6 @@ -99298,41 +99298,41 @@ SUBROUTINE contract_ggsd(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_ggsd #endif @@ -99383,73 +99383,73 @@ SUBROUTINE contract_ggsf(work, & imax = 15*1*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*10 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*9*1 kmax = 10 @@ -99457,65 +99457,65 @@ SUBROUTINE contract_ggsf(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_ggsf #endif @@ -99566,73 +99566,73 @@ SUBROUTINE contract_ggsg(work, & imax = 15*1*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*1*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*15 kmax = 1 DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) ENDDO imax = 9*9*1 kmax = 15 @@ -99640,101 +99640,101 @@ SUBROUTINE contract_ggsg(work, & DO i1 = 1, 1 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+1 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 1 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_ggsg #endif @@ -99785,75 +99785,75 @@ SUBROUTINE contract_ggps(work, & imax = 15*3*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*1 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*9*3 kmax = 1 @@ -99861,20 +99861,20 @@ SUBROUTINE contract_ggps(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_ggps #endif @@ -99925,75 +99925,75 @@ SUBROUTINE contract_ggpp(work, & imax = 15*3*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*3 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*9*3 kmax = 3 @@ -100001,26 +100001,26 @@ SUBROUTINE contract_ggpp(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+3 + s_offset_c1 = s_offset_c1 + 3 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_ggpp #endif @@ -100071,75 +100071,75 @@ SUBROUTINE contract_ggpd(work, & imax = 15*3*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*6 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*9*3 kmax = 6 @@ -100147,41 +100147,41 @@ SUBROUTINE contract_ggpd(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_ggpd #endif @@ -100232,75 +100232,75 @@ SUBROUTINE contract_ggpf(work, & imax = 15*3*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*10 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*9*3 kmax = 10 @@ -100308,65 +100308,65 @@ SUBROUTINE contract_ggpf(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_ggpf #endif @@ -100417,75 +100417,75 @@ SUBROUTINE contract_ggpg(work, & imax = 15*3*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*3*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*15 kmax = 3 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) ENDDO imax = 9*9*3 kmax = 15 @@ -100493,101 +100493,101 @@ SUBROUTINE contract_ggpg(work, & DO i1 = 1, 3 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+3 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 3 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_ggpg #endif @@ -100638,80 +100638,80 @@ SUBROUTINE contract_ggds(work, & imax = 15*6*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*1 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*9*5 kmax = 1 @@ -100719,20 +100719,20 @@ SUBROUTINE contract_ggds(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_ggds #endif @@ -100783,80 +100783,80 @@ SUBROUTINE contract_ggdp(work, & imax = 15*6*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*3 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*9*5 kmax = 3 @@ -100864,26 +100864,26 @@ SUBROUTINE contract_ggdp(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+5 + s_offset_c1 = s_offset_c1 + 5 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_ggdp #endif @@ -100934,80 +100934,80 @@ SUBROUTINE contract_ggdd(work, & imax = 15*6*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*6 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*9*5 kmax = 6 @@ -101015,41 +101015,41 @@ SUBROUTINE contract_ggdd(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_ggdd #endif @@ -101100,80 +101100,80 @@ SUBROUTINE contract_ggdf(work, & imax = 15*6*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*10 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*9*5 kmax = 10 @@ -101181,65 +101181,65 @@ SUBROUTINE contract_ggdf(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_ggdf #endif @@ -101290,80 +101290,80 @@ SUBROUTINE contract_ggdg(work, & imax = 15*6*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*6*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*15 kmax = 6 DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) ENDDO imax = 9*9*5 kmax = 15 @@ -101371,101 +101371,101 @@ SUBROUTINE contract_ggdg(work, & DO i1 = 1, 5 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+5 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 5 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_ggdg #endif @@ -101516,88 +101516,88 @@ SUBROUTINE contract_ggfs(work, & imax = 15*10*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*1 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*9*7 kmax = 1 @@ -101605,20 +101605,20 @@ SUBROUTINE contract_ggfs(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_ggfs #endif @@ -101669,88 +101669,88 @@ SUBROUTINE contract_ggfp(work, & imax = 15*10*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*3 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*9*7 kmax = 3 @@ -101758,26 +101758,26 @@ SUBROUTINE contract_ggfp(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+7 + s_offset_c1 = s_offset_c1 + 7 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_ggfp #endif @@ -101828,88 +101828,88 @@ SUBROUTINE contract_ggfd(work, & imax = 15*10*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*6 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*9*7 kmax = 6 @@ -101917,41 +101917,41 @@ SUBROUTINE contract_ggfd(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_ggfd #endif @@ -102002,88 +102002,88 @@ SUBROUTINE contract_ggff(work, & imax = 15*10*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*10 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*9*7 kmax = 10 @@ -102091,65 +102091,65 @@ SUBROUTINE contract_ggff(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_ggff #endif @@ -102200,88 +102200,88 @@ SUBROUTINE contract_ggfg(work, & imax = 15*10*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*10*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*15 kmax = 10 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) ENDDO imax = 9*9*7 kmax = 15 @@ -102289,101 +102289,101 @@ SUBROUTINE contract_ggfg(work, & DO i1 = 1, 7 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+7 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 7 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_ggfg #endif @@ -102434,100 +102434,100 @@ SUBROUTINE contract_gggs(work, & imax = 15*15*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*1 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*1 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*9*9 kmax = 1 @@ -102535,20 +102535,20 @@ SUBROUTINE contract_gggs(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+1 + s_offset_d1 = s_offset_d1 + 1 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gggs #endif @@ -102599,100 +102599,100 @@ SUBROUTINE contract_gggp(work, & imax = 15*15*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*3 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*3 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*9*9 kmax = 3 @@ -102700,26 +102700,26 @@ SUBROUTINE contract_gggp(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) ENDDO ENDDO ENDDO - s_offset_d1 = s_offset_d1+3 + s_offset_d1 = s_offset_d1 + 3 END DO - s_offset_c1 = s_offset_c1+9 + s_offset_c1 = s_offset_c1 + 9 END DO - s_offset_b1 = s_offset_b1+9 + s_offset_b1 = s_offset_b1 + 9 END DO - s_offset_a1 = s_offset_a1+9 + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gggp #endif @@ -102770,100 +102770,100 @@ SUBROUTINE contract_gggd(work, & imax = 15*15*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*6 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*6 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*9*9 kmax = 6 @@ -102871,41 +102871,41 @@ SUBROUTINE contract_gggd(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+5 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 5 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gggd #endif @@ -102956,100 +102956,100 @@ SUBROUTINE contract_gggf(work, & imax = 15*15*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*10 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*10 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*9*9 kmax = 10 @@ -103057,65 +103057,65 @@ SUBROUTINE contract_gggf(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+7 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 7 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gggf #endif @@ -103166,100 +103166,100 @@ SUBROUTINE contract_gggg(work, & imax = 15*15*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) ENDDO buffer2 = 0.0_dp imax = 9*15*15 kmax = 15 DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) ENDDO buffer1 = 0.0_dp imax = 9*9*15 kmax = 15 DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) ENDDO imax = 9*9*9 kmax = 15 @@ -103267,101 +103267,101 @@ SUBROUTINE contract_gggg(work, & DO i1 = 1, 9 DO i2 = 1, 9 DO i3 = 1, 9 - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) - ENDDO - ENDDO - ENDDO - s_offset_d1 = s_offset_d1+9 - END DO - s_offset_c1 = s_offset_c1+9 - END DO - s_offset_b1 = s_offset_b1+9 - END DO - s_offset_a1 = s_offset_a1+9 + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) + ENDDO + ENDDO + ENDDO + s_offset_d1 = s_offset_d1 + 9 + END DO + s_offset_c1 = s_offset_c1 + 9 + END DO + s_offset_b1 = s_offset_b1 + 9 + END DO + s_offset_a1 = s_offset_a1 + 9 END DO END SUBROUTINE contract_gggg #endif @@ -103430,80 +103430,80 @@ SUBROUTINE contract_generic(ncoa, ncob, ncoc, ncod, & SELECT CASE (kmax) CASE (1) DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(1+(i-1)*kmax)*sphi_a(1, 1+s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 1 + s_offset_a1) END DO CASE (3) DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(3+(i-1)*kmax)*sphi_a(3, 2+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 2 + s_offset_a1) END DO CASE (6) DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(1+(i-1)*kmax)*sphi_a(1, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(4+(i-1)*kmax)*sphi_a(4, 3+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(6+(i-1)*kmax)*sphi_a(6, 3+s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 3 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 3 + s_offset_a1) END DO CASE (10) DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(3+(i-1)*kmax)*sphi_a(3, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(4+(i-1)*kmax)*sphi_a(4, 7+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(8+(i-1)*kmax)*sphi_a(8, 4+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(10+(i-1)*kmax)*sphi_a(10, 4+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 7 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 4 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 4 + s_offset_a1) END DO CASE (15) DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(1+(i-1)*kmax)*sphi_a(1, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(1+(i-1)*kmax)*sphi_a(1, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(1+(i-1)*kmax)*sphi_a(1, 9+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(2+(i-1)*kmax)*sphi_a(2, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(2+(i-1)*kmax)*sphi_a(2, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(3+(i-1)*kmax)*sphi_a(3, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(3+(i-1)*kmax)*sphi_a(3, 8+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(4+(i-1)*kmax)*sphi_a(4, 5+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(4+(i-1)*kmax)*sphi_a(4, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(5+(i-1)*kmax)*sphi_a(5, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(5+(i-1)*kmax)*sphi_a(5, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(6+(i-1)*kmax)*sphi_a(6, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(6+(i-1)*kmax)*sphi_a(6, 7+s_offset_a1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+work(7+(i-1)*kmax)*sphi_a(7, 1+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(7+(i-1)*kmax)*sphi_a(7, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(8+(i-1)*kmax)*sphi_a(8, 6+s_offset_a1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+work(8+(i-1)*kmax)*sphi_a(8, 8+s_offset_a1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+work(9+(i-1)*kmax)*sphi_a(9, 3+s_offset_a1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+work(10+(i-1)*kmax)*sphi_a(10, 6+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(11+(i-1)*kmax)*sphi_a(11, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(11+(i-1)*kmax)*sphi_a(11, 7+s_offset_a1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+work(11+(i-1)*kmax)*sphi_a(11, 9+s_offset_a1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+work(12+(i-1)*kmax)*sphi_a(12, 2+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(12+(i-1)*kmax)*sphi_a(12, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(13+(i-1)*kmax)*sphi_a(13, 5+s_offset_a1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+work(13+(i-1)*kmax)*sphi_a(13, 7+s_offset_a1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+work(14+(i-1)*kmax)*sphi_a(14, 4+s_offset_a1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+work(15+(i-1)*kmax)*sphi_a(15, 5+s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(1 + (i - 1)*kmax)*sphi_a(1, 9 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(2 + (i - 1)*kmax)*sphi_a(2, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(3 + (i - 1)*kmax)*sphi_a(3, 8 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 5 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(4 + (i - 1)*kmax)*sphi_a(4, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(5 + (i - 1)*kmax)*sphi_a(5, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(6 + (i - 1)*kmax)*sphi_a(6, 7 + s_offset_a1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 1 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(7 + (i - 1)*kmax)*sphi_a(7, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 6 + s_offset_a1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + work(8 + (i - 1)*kmax)*sphi_a(8, 8 + s_offset_a1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + work(9 + (i - 1)*kmax)*sphi_a(9, 3 + s_offset_a1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + work(10 + (i - 1)*kmax)*sphi_a(10, 6 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 7 + s_offset_a1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + work(11 + (i - 1)*kmax)*sphi_a(11, 9 + s_offset_a1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 2 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(12 + (i - 1)*kmax)*sphi_a(12, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 5 + s_offset_a1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + work(13 + (i - 1)*kmax)*sphi_a(13, 7 + s_offset_a1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + work(14 + (i - 1)*kmax)*sphi_a(14, 4 + s_offset_a1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + work(15 + (i - 1)*kmax)*sphi_a(15, 5 + s_offset_a1) END DO CASE DEFAULT DO j = 1, jmax DO i = 1, imax DO k = 1, kmax - buffer1(i+imax*(j-1)) = buffer1(i+imax*(j-1))+work(k+(i-1)*kmax)*sphi_a(k, j+s_offset_a1) + buffer1(i + imax*(j - 1)) = buffer1(i + imax*(j - 1)) + work(k + (i - 1)*kmax)*sphi_a(k, j + s_offset_a1) ENDDO ENDDO ENDDO @@ -103515,80 +103515,80 @@ SUBROUTINE contract_generic(ncoa, ncob, ncoc, ncod, & SELECT CASE (kmax) CASE (1) DO i = 1, imax - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 1+s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 1 + s_offset_b1) END DO CASE (3) DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 2+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 2 + s_offset_b1) END DO CASE (6) DO i = 1, imax - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 3+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 3+s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 3 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 3 + s_offset_b1) END DO CASE (10) DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 7+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 4+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 4+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 7 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 4 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 4 + s_offset_b1) END DO CASE (15) DO i = 1, imax - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(1+(i-1)*kmax)*sphi_b(1, 9+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(2+(i-1)*kmax)*sphi_b(2, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(3+(i-1)*kmax)*sphi_b(3, 8+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 5+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(4+(i-1)*kmax)*sphi_b(4, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(5+(i-1)*kmax)*sphi_b(5, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(6+(i-1)*kmax)*sphi_b(6, 7+s_offset_b1) - buffer2(i+imax*(1-1)) = buffer2(i+imax*(1-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 1+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(7+(i-1)*kmax)*sphi_b(7, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 6+s_offset_b1) - buffer2(i+imax*(8-1)) = buffer2(i+imax*(8-1))+buffer1(8+(i-1)*kmax)*sphi_b(8, 8+s_offset_b1) - buffer2(i+imax*(3-1)) = buffer2(i+imax*(3-1))+buffer1(9+(i-1)*kmax)*sphi_b(9, 3+s_offset_b1) - buffer2(i+imax*(6-1)) = buffer2(i+imax*(6-1))+buffer1(10+(i-1)*kmax)*sphi_b(10, 6+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 7+s_offset_b1) - buffer2(i+imax*(9-1)) = buffer2(i+imax*(9-1))+buffer1(11+(i-1)*kmax)*sphi_b(11, 9+s_offset_b1) - buffer2(i+imax*(2-1)) = buffer2(i+imax*(2-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 2+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(12+(i-1)*kmax)*sphi_b(12, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 5+s_offset_b1) - buffer2(i+imax*(7-1)) = buffer2(i+imax*(7-1))+buffer1(13+(i-1)*kmax)*sphi_b(13, 7+s_offset_b1) - buffer2(i+imax*(4-1)) = buffer2(i+imax*(4-1))+buffer1(14+(i-1)*kmax)*sphi_b(14, 4+s_offset_b1) - buffer2(i+imax*(5-1)) = buffer2(i+imax*(5-1))+buffer1(15+(i-1)*kmax)*sphi_b(15, 5+s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(1 + (i - 1)*kmax)*sphi_b(1, 9 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(2 + (i - 1)*kmax)*sphi_b(2, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(3 + (i - 1)*kmax)*sphi_b(3, 8 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 5 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(4 + (i - 1)*kmax)*sphi_b(4, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(5 + (i - 1)*kmax)*sphi_b(5, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(6 + (i - 1)*kmax)*sphi_b(6, 7 + s_offset_b1) + buffer2(i + imax*(1 - 1)) = buffer2(i + imax*(1 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 1 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(7 + (i - 1)*kmax)*sphi_b(7, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 6 + s_offset_b1) + buffer2(i + imax*(8 - 1)) = buffer2(i + imax*(8 - 1)) + buffer1(8 + (i - 1)*kmax)*sphi_b(8, 8 + s_offset_b1) + buffer2(i + imax*(3 - 1)) = buffer2(i + imax*(3 - 1)) + buffer1(9 + (i - 1)*kmax)*sphi_b(9, 3 + s_offset_b1) + buffer2(i + imax*(6 - 1)) = buffer2(i + imax*(6 - 1)) + buffer1(10 + (i - 1)*kmax)*sphi_b(10, 6 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 7 + s_offset_b1) + buffer2(i + imax*(9 - 1)) = buffer2(i + imax*(9 - 1)) + buffer1(11 + (i - 1)*kmax)*sphi_b(11, 9 + s_offset_b1) + buffer2(i + imax*(2 - 1)) = buffer2(i + imax*(2 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 2 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(12 + (i - 1)*kmax)*sphi_b(12, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 5 + s_offset_b1) + buffer2(i + imax*(7 - 1)) = buffer2(i + imax*(7 - 1)) + buffer1(13 + (i - 1)*kmax)*sphi_b(13, 7 + s_offset_b1) + buffer2(i + imax*(4 - 1)) = buffer2(i + imax*(4 - 1)) + buffer1(14 + (i - 1)*kmax)*sphi_b(14, 4 + s_offset_b1) + buffer2(i + imax*(5 - 1)) = buffer2(i + imax*(5 - 1)) + buffer1(15 + (i - 1)*kmax)*sphi_b(15, 5 + s_offset_b1) END DO CASE DEFAULT DO j = 1, jmax DO i = 1, imax DO k = 1, kmax - buffer2(i+imax*(j-1)) = buffer2(i+imax*(j-1))+buffer1(k+(i-1)*kmax)*sphi_b(k, j+s_offset_b1) + buffer2(i + imax*(j - 1)) = buffer2(i + imax*(j - 1)) + buffer1(k + (i - 1)*kmax)*sphi_b(k, j + s_offset_b1) ENDDO ENDDO ENDDO @@ -103600,83 +103600,83 @@ SUBROUTINE contract_generic(ncoa, ncob, ncoc, ncod, & SELECT CASE (kmax) CASE (1) DO i = 1, imax - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 1+s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 1 + s_offset_c1) END DO CASE (3) DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 2+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 2 + s_offset_c1) END DO CASE (6) DO i = 1, imax - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 3+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 3+s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 3 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 3 + s_offset_c1) END DO CASE (10) DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 7+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 4+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 4+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 7 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 4 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 4 + s_offset_c1) END DO CASE (15) DO i = 1, imax - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(1+(i-1)*kmax)*sphi_c(1, 9+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(2+(i-1)*kmax)*sphi_c(2, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(3+(i-1)*kmax)*sphi_c(3, 8+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 5+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(4+(i-1)*kmax)*sphi_c(4, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(5+(i-1)*kmax)*sphi_c(5, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(6+(i-1)*kmax)*sphi_c(6, 7+s_offset_c1) - buffer1(i+imax*(1-1)) = buffer1(i+imax*(1-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 1+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(7+(i-1)*kmax)*sphi_c(7, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 6+s_offset_c1) - buffer1(i+imax*(8-1)) = buffer1(i+imax*(8-1))+buffer2(8+(i-1)*kmax)*sphi_c(8, 8+s_offset_c1) - buffer1(i+imax*(3-1)) = buffer1(i+imax*(3-1))+buffer2(9+(i-1)*kmax)*sphi_c(9, 3+s_offset_c1) - buffer1(i+imax*(6-1)) = buffer1(i+imax*(6-1))+buffer2(10+(i-1)*kmax)*sphi_c(10, 6+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 7+s_offset_c1) - buffer1(i+imax*(9-1)) = buffer1(i+imax*(9-1))+buffer2(11+(i-1)*kmax)*sphi_c(11, 9+s_offset_c1) - buffer1(i+imax*(2-1)) = buffer1(i+imax*(2-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 2+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(12+(i-1)*kmax)*sphi_c(12, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 5+s_offset_c1) - buffer1(i+imax*(7-1)) = buffer1(i+imax*(7-1))+buffer2(13+(i-1)*kmax)*sphi_c(13, 7+s_offset_c1) - buffer1(i+imax*(4-1)) = buffer1(i+imax*(4-1))+buffer2(14+(i-1)*kmax)*sphi_c(14, 4+s_offset_c1) - buffer1(i+imax*(5-1)) = buffer1(i+imax*(5-1))+buffer2(15+(i-1)*kmax)*sphi_c(15, 5+s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(1 + (i - 1)*kmax)*sphi_c(1, 9 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(2 + (i - 1)*kmax)*sphi_c(2, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(3 + (i - 1)*kmax)*sphi_c(3, 8 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 5 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(4 + (i - 1)*kmax)*sphi_c(4, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(5 + (i - 1)*kmax)*sphi_c(5, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(6 + (i - 1)*kmax)*sphi_c(6, 7 + s_offset_c1) + buffer1(i + imax*(1 - 1)) = buffer1(i + imax*(1 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 1 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(7 + (i - 1)*kmax)*sphi_c(7, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 6 + s_offset_c1) + buffer1(i + imax*(8 - 1)) = buffer1(i + imax*(8 - 1)) + buffer2(8 + (i - 1)*kmax)*sphi_c(8, 8 + s_offset_c1) + buffer1(i + imax*(3 - 1)) = buffer1(i + imax*(3 - 1)) + buffer2(9 + (i - 1)*kmax)*sphi_c(9, 3 + s_offset_c1) + buffer1(i + imax*(6 - 1)) = buffer1(i + imax*(6 - 1)) + buffer2(10 + (i - 1)*kmax)*sphi_c(10, 6 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 7 + s_offset_c1) + buffer1(i + imax*(9 - 1)) = buffer1(i + imax*(9 - 1)) + buffer2(11 + (i - 1)*kmax)*sphi_c(11, 9 + s_offset_c1) + buffer1(i + imax*(2 - 1)) = buffer1(i + imax*(2 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 2 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(12 + (i - 1)*kmax)*sphi_c(12, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 5 + s_offset_c1) + buffer1(i + imax*(7 - 1)) = buffer1(i + imax*(7 - 1)) + buffer2(13 + (i - 1)*kmax)*sphi_c(13, 7 + s_offset_c1) + buffer1(i + imax*(4 - 1)) = buffer1(i + imax*(4 - 1)) + buffer2(14 + (i - 1)*kmax)*sphi_c(14, 4 + s_offset_c1) + buffer1(i + imax*(5 - 1)) = buffer1(i + imax*(5 - 1)) + buffer2(15 + (i - 1)*kmax)*sphi_c(15, 5 + s_offset_c1) END DO CASE DEFAULT DO j = 1, jmax DO i = 1, imax DO k = 1, kmax - buffer1(i+imax*(j-1)) = & - buffer1(i+imax*(j-1))+ & - buffer2(k+(i-1)*kmax)* & - sphi_c(k, j+s_offset_c1) + buffer1(i + imax*(j - 1)) = & + buffer1(i + imax*(j - 1)) + & + buffer2(k + (i - 1)*kmax)* & + sphi_c(k, j + s_offset_c1) ENDDO ENDDO ENDDO @@ -103690,10 +103690,10 @@ SUBROUTINE contract_generic(ncoa, ncob, ncoc, ncod, & DO i1 = 1, nsoc DO i2 = 1, nsob DO i3 = 1, nsoa - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 1+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 1 + s_offset_d1) END DO END DO END DO @@ -103701,16 +103701,16 @@ SUBROUTINE contract_generic(ncoa, ncob, ncoc, ncod, & DO i1 = 1, nsoc DO i2 = 1, nsob DO i3 = 1, nsoa - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) & - +buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) & - +buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) & - +buffer1(3+(i-1)*kmax)*sphi_d(3, 2+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) & + + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) & + + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) & + + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 2 + s_offset_d1) END DO END DO END DO @@ -103718,31 +103718,31 @@ SUBROUTINE contract_generic(ncoa, ncob, ncoc, ncod, & DO i1 = 1, nsoc DO i2 = 1, nsob DO i3 = 1, nsoa - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 3+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 3 + s_offset_d1) END DO END DO END DO @@ -103750,55 +103750,55 @@ SUBROUTINE contract_generic(ncoa, ncob, ncoc, ncod, & DO i1 = 1, nsoc DO i2 = 1, nsob DO i3 = 1, nsoa - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 4+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 4 + s_offset_d1) END DO END DO END DO @@ -103806,91 +103806,91 @@ SUBROUTINE contract_generic(ncoa, ncob, ncoc, ncod, & DO i1 = 1, nsoc DO i2 = 1, nsob DO i3 = 1, nsoa - i = i+1 - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(1+(i-1)*kmax)*sphi_d(1, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(2+(i-1)*kmax)*sphi_d(2, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(3+(i-1)*kmax)*sphi_d(3, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(4+(i-1)*kmax)*sphi_d(4, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(5+(i-1)*kmax)*sphi_d(5, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(6+(i-1)*kmax)*sphi_d(6, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+1)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 1+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(7+(i-1)*kmax)*sphi_d(7, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+8)+ & - buffer1(8+(i-1)*kmax)*sphi_d(8, 8+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+3)+ & - buffer1(9+(i-1)*kmax)*sphi_d(9, 3+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+6)+ & - buffer1(10+(i-1)*kmax)*sphi_d(10, 6+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+9)+ & - buffer1(11+(i-1)*kmax)*sphi_d(11, 9+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+2)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 2+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(12+(i-1)*kmax)*sphi_d(12, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 5+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+7)+ & - buffer1(13+(i-1)*kmax)*sphi_d(13, 7+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+4)+ & - buffer1(14+(i-1)*kmax)*sphi_d(14, 4+s_offset_d1) - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+5)+ & - buffer1(15+(i-1)*kmax)*sphi_d(15, 5+s_offset_d1) + i = i + 1 + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(1 + (i - 1)*kmax)*sphi_d(1, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(2 + (i - 1)*kmax)*sphi_d(2, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(3 + (i - 1)*kmax)*sphi_d(3, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(4 + (i - 1)*kmax)*sphi_d(4, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(5 + (i - 1)*kmax)*sphi_d(5, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(6 + (i - 1)*kmax)*sphi_d(6, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 1) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 1 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(7 + (i - 1)*kmax)*sphi_d(7, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 8) + & + buffer1(8 + (i - 1)*kmax)*sphi_d(8, 8 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 3) + & + buffer1(9 + (i - 1)*kmax)*sphi_d(9, 3 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 6) + & + buffer1(10 + (i - 1)*kmax)*sphi_d(10, 6 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 9) + & + buffer1(11 + (i - 1)*kmax)*sphi_d(11, 9 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 2) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 2 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(12 + (i - 1)*kmax)*sphi_d(12, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 5 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 7) + & + buffer1(13 + (i - 1)*kmax)*sphi_d(13, 7 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 4) + & + buffer1(14 + (i - 1)*kmax)*sphi_d(14, 4 + s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + 5) + & + buffer1(15 + (i - 1)*kmax)*sphi_d(15, 5 + s_offset_d1) END DO END DO END DO @@ -103900,24 +103900,24 @@ SUBROUTINE contract_generic(ncoa, ncob, ncoc, ncod, & DO i1 = 1, nsoc DO i2 = 1, nsob DO i3 = 1, nsoa - i = i+1 + i = i + 1 DO k = 1, kmax - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+j) = & - primitives(s_offset_a1+i3, s_offset_b1+i2, s_offset_c1+i1, s_offset_d1+j) & - +buffer1(k+(i-1)*kmax)*sphi_d(k, j+s_offset_d1) + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + j) = & + primitives(s_offset_a1 + i3, s_offset_b1 + i2, s_offset_c1 + i1, s_offset_d1 + j) & + + buffer1(k + (i - 1)*kmax)*sphi_d(k, j + s_offset_d1) ENDDO ENDDO ENDDO ENDDO ENDDO END SELECT - s_offset_d1 = s_offset_d1+nsod + s_offset_d1 = s_offset_d1 + nsod END DO - s_offset_c1 = s_offset_c1+nsoc + s_offset_c1 = s_offset_c1 + nsoc END DO - s_offset_b1 = s_offset_b1+nsob + s_offset_b1 = s_offset_b1 + nsob END DO - s_offset_a1 = s_offset_a1+nsoa + s_offset_a1 = s_offset_a1 + nsoa END DO END SUBROUTINE contract_generic #endif diff --git a/src/hirshfeld_methods.F b/src/hirshfeld_methods.F index 564a394348..e808b43a30 100644 --- a/src/hirshfeld_methods.F +++ b/src/hirshfeld_methods.F @@ -118,13 +118,13 @@ SUBROUTINE write_hirshfeld_charges(charges, hirshfeld_env, particle_set, & CALL get_qs_kind(qs_kind_set(ikind), zeff=zeff) IF (nspin == 1) THEN WRITE (UNIT=unit_nr, FMT="(i7,T15,A2,T20,i3,T27,F8.3,T42,F8.3,T72,F8.3)") & - iatom, element_symbol, ikind, refc, charges(iatom, 1), zeff-charges(iatom, 1) + iatom, element_symbol, ikind, refc, charges(iatom, 1), zeff - charges(iatom, 1) ELSE WRITE (UNIT=unit_nr, FMT="(i7,T15,A2,T20,i3,T27,F8.3,T36,2F8.3,T61,F8.3,T72,F8.3)") & iatom, element_symbol, ikind, refc, charges(iatom, 1), charges(iatom, 2), & - charges(iatom, 1)-charges(iatom, 2), zeff-SUM(charges(iatom, :)) + charges(iatom, 1) - charges(iatom, 2), zeff - SUM(charges(iatom, :)) END IF - tc1 = tc1+(zeff-SUM(charges(iatom, :))) + tc1 = tc1 + (zeff - SUM(charges(iatom, :))) END DO WRITE (UNIT=unit_nr, FMT="(/,T3,A,T72,F8.3)") "Total Charge ", tc1 WRITE (unit_nr, '(T2,A)') '!-----------------------------------------------------------------------------!' @@ -254,7 +254,7 @@ SUBROUTINE comp_hirshfeld_charges(qs_env, hirshfeld_env, charges) CALL calculate_hirshfeld_normalization(qs_env, hirshfeld_env) ! check normalization tnfun = pw_integrate_function(hirshfeld_env%fnorm%pw) - tnfun = ABS(tnfun-SUM(hirshfeld_env%charges)) + tnfun = ABS(tnfun - SUM(hirshfeld_env%charges)) ! ALLOCATE (rhonorm) ! @@ -364,7 +364,7 @@ SUBROUTINE comp_hirshfeld_i_charges(qs_env, hirshfeld_env, charges, ounit) CALL calculate_hirshfeld_normalization(qs_env, hirshfeld_env) ! check normalization tnfun = pw_integrate_function(hirshfeld_env%fnorm%pw) - tnfun = ABS(tnfun-SUM(hirshfeld_env%charges)) + tnfun = ABS(tnfun - SUM(hirshfeld_env%charges)) ! loop over spins DO is = 1, SIZE(rho_r) IF (rho_r_valid) THEN @@ -379,7 +379,7 @@ SUBROUTINE comp_hirshfeld_i_charges(qs_env, hirshfeld_env, charges, ounit) ! residual res = 0.0_dp DO iat = 1, natom - res = res+(SUM(charges(iat, :))-hirshfeld_env%charges(iat))**2 + res = res + (SUM(charges(iat, :)) - hirshfeld_env%charges(iat))**2 END DO res = SQRT(res/REAL(natom, KIND=dp)) IF (ounit > 0) THEN @@ -466,11 +466,11 @@ SUBROUTINE calculate_hirshfeld_normalization(qs_env, hirshfeld_env) IF (rs_rho%desc%parallel .AND. .NOT. rs_rho%desc%distributed) THEN ! replicated realspace grid, split the atoms up between procs IF (MODULO(iatom, rs_rho%desc%group_size) == rs_rho%desc%my_pos) THEN - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF ELSE - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF END DO @@ -587,11 +587,11 @@ SUBROUTINE hirshfeld_integration(qs_env, hirshfeld_env, rfun, fval, fderiv) IF (rs_v%desc%parallel .AND. .NOT. rs_v%desc%distributed) THEN ! replicated realspace grid, split the atoms up between procs IF (MODULO(iatom, rs_v%desc%group_size) == rs_v%desc%my_pos) THEN - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF ELSE - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF END DO @@ -611,9 +611,9 @@ SUBROUTINE hirshfeld_integration(qs_env, hirshfeld_env, rfun, fval, fderiv) eps_gvg_rspace=eps_rho_rspace, calculate_forces=do_force, & force_a=force_a, force_b=force_b, use_virial=.FALSE., & use_subpatch=.TRUE., subpatch_pattern=0_int_8) - fval(atom_a) = fval(atom_a)+hab(1, 1)*dvol*coef + fval(atom_a) = fval(atom_a) + hab(1, 1)*dvol*coef IF (do_force) THEN - fderiv(:, atom_a) = fderiv(:, atom_a)+force_a(:)*dvol + fderiv(:, atom_a) = fderiv(:, atom_a) + force_a(:)*dvol END IF END DO diff --git a/src/input/cp_output_handling.F b/src/input/cp_output_handling.F index 4217138457..65d8003738 100644 --- a/src/input/cp_output_handling.F +++ b/src/input/cp_output_handling.F @@ -208,7 +208,7 @@ SUBROUTINE cp_print_key_section_create(print_key_section, location, name, descri usage="silent", & default_i_val=my_print_level, lone_keyword_i_val=silent_print_level, & enum_c_vals=s2a("on", "off", "silent", "low", "medium", "high", "debug"), & - enum_i_vals=(/silent_print_level-1, debug_print_level+1, & + enum_i_vals=(/silent_print_level - 1, debug_print_level + 1, & silent_print_level, low_print_level, & medium_print_level, high_print_level, debug_print_level/)) CALL section_add_keyword(print_key_section, keyword) @@ -373,19 +373,19 @@ FUNCTION cp_print_key_should_output(iteration_info, basis_section, & end_str = LEN_TRIM(print_key_path) to_path = INDEX(print_key_path, "/") IF (to_path < 1) THEN - to_path = end_str+1 + to_path = end_str + 1 END IF IF (to_path > 1) THEN print_key => section_vals_get_subs_vals(basis_section, & - print_key_path(1:(to_path-1))) + print_key_path(1:(to_path - 1))) ELSE print_key => basis_section END IF CPASSERT(ASSOCIATED(print_key)) CPASSERT(print_key%ref_count > 0) - IF (to_path+1 < end_str) THEN - CALL section_vals_val_get(print_key, print_key_path((to_path+1):end_str), & + IF (to_path + 1 < end_str) THEN + CALL section_vals_val_get(print_key, print_key_path((to_path + 1):end_str), & l_val=flags) ELSE flags = .TRUE. @@ -556,21 +556,21 @@ FUNCTION cp_iter_string(iter_info, print_key, for_file) RESULT(res) CALL section_vals_val_get(my_print_key, "ADD_LAST", i_val=add_last) CALL section_vals_val_get(my_print_key, "COMMON_ITERATION_LEVELS", i_val=c_i_level) n_rlevel = iter_info%n_rlevel - IF (my_for_file) n_rlevel = MIN(n_rlevel, MAX(0, n_rlevel-c_i_level)) + IF (my_for_file) n_rlevel = MIN(n_rlevel, MAX(0, n_rlevel - c_i_level)) DO ilevel = s_level, n_rlevel IF (iter_info%last_iter(ilevel)) THEN IF (add_last == add_last_symbolic) THEN - WRITE (res(9*ilevel-8:9*ilevel), "('l_')") + WRITE (res(9*ilevel - 8:9*ilevel), "('l_')") ELSE - WRITE (res(9*ilevel-8:9*ilevel), "(i8,'_')") iter_info%iteration(ilevel) + WRITE (res(9*ilevel - 8:9*ilevel), "(i8,'_')") iter_info%iteration(ilevel) END IF ELSE - WRITE (res(9*ilevel-8:9*ilevel), "(i8,'_')") iter_info%iteration(ilevel) + WRITE (res(9*ilevel - 8:9*ilevel), "(i8,'_')") iter_info%iteration(ilevel) END IF END DO ELSE DO ilevel = s_level, iter_info%n_rlevel - WRITE (res(9*ilevel-8:9*ilevel), "(i8,'_')") iter_info%iteration(ilevel) + WRITE (res(9*ilevel - 8:9*ilevel), "(i8,'_')") iter_info%iteration(ilevel) END DO END IF CALL compress(res, .TRUE.) @@ -613,7 +613,7 @@ SUBROUTINE cp_iterate(iteration_info, last, iter_nr, increment, iter_nr_out) iteration_info%iteration(iteration_info%n_rlevel) = iter_nr ELSE iteration_info%iteration(iteration_info%n_rlevel) = & - iteration_info%iteration(iteration_info%n_rlevel)+my_increment + iteration_info%iteration(iteration_info%n_rlevel) + my_increment END IF ! If requested provide the value of the iteration level IF (PRESENT(iter_nr_out)) iter_nr_out = iteration_info%iteration(iteration_info%n_rlevel) @@ -652,7 +652,7 @@ SUBROUTINE cp_add_iter_level(iteration_info, level_name, n_rlevel_new) END DO IF (found) THEN CALL cp_iteration_info_retain(iteration_info) - iteration_info%n_rlevel = iteration_info%n_rlevel+1 + iteration_info%n_rlevel = iteration_info%n_rlevel + 1 CALL reallocate(iteration_info%iteration, 1, iteration_info%n_rlevel) CALL reallocate(iteration_info%level_name, 1, iteration_info%n_rlevel) CALL reallocate(iteration_info%last_iter, 1, iteration_info%n_rlevel) @@ -696,7 +696,7 @@ SUBROUTINE cp_rm_iter_level(iteration_info, level_name, n_rlevel_att) ! Never remove this check.. check = iteration_info%level_name(iteration_info%n_rlevel) == level_name CPASSERT(check) - iteration_info%n_rlevel = iteration_info%n_rlevel-1 + iteration_info%n_rlevel = iteration_info%n_rlevel - 1 CALL reallocate(iteration_info%iteration, 1, iteration_info%n_rlevel) CALL reallocate(iteration_info%level_name, 1, iteration_info%n_rlevel) CALL reallocate(iteration_info%last_iter, 1, iteration_info%n_rlevel) @@ -743,7 +743,7 @@ FUNCTION cp_print_key_generate_filename(logger, print_key, middle_name, extensio CALL section_vals_val_get(print_key, "FILENAME", c_val=outPath) IF (outPath(1:1) == '=') THEN - CPASSERT(LEN(outPath)-1 <= LEN(filename)) + CPASSERT(LEN(outPath) - 1 <= LEN(filename)) filename = outPath(2:) RETURN END IF @@ -754,13 +754,13 @@ FUNCTION cp_print_key_generate_filename(logger, print_key, middle_name, extensio my_ind2 = LEN_TRIM(outPath) IF (my_ind1 /= 0) THEN has_root = .TRUE. - DO WHILE (INDEX(outPath(my_ind1+1:my_ind2), "/") /= 0) - my_ind1 = INDEX(outPath(my_ind1+1:my_ind2), "/")+my_ind1 + DO WHILE (INDEX(outPath(my_ind1 + 1:my_ind2), "/") /= 0) + my_ind1 = INDEX(outPath(my_ind1 + 1:my_ind2), "/") + my_ind1 END DO IF (my_ind1 == my_ind2) THEN outName = "" ELSE - outName = outPath(my_ind1+1:my_ind2) + outName = outPath(my_ind1 + 1:my_ind2) END IF END IF @@ -945,21 +945,21 @@ FUNCTION cp_print_key_unit_nr(logger, basis_section, print_key_path, extension, s_backup_level = 0 IF (ASSOCIATED(print_key%ibackup)) s_backup_level = SIZE(print_key%ibackup) CALL section_vals_val_get(print_key, "COMMON_ITERATION_LEVELS", i_val=c_i_level) - my_backup_level = MAX(1, iteration_info%n_rlevel-c_i_level+1) + my_backup_level = MAX(1, iteration_info%n_rlevel - c_i_level + 1) f_backup_level = MAX(s_backup_level, my_backup_level) IF (f_backup_level > s_backup_level) THEN CALL reallocate(print_key%ibackup, 1, f_backup_level) - DO i = s_backup_level+1, f_backup_level + DO i = s_backup_level + 1, f_backup_level print_key%ibackup(i) = 0 END DO END IF IF (found) THEN - print_key%ibackup(my_backup_level) = print_key%ibackup(my_backup_level)+1 + print_key%ibackup(my_backup_level) = print_key%ibackup(my_backup_level) + 1 my_nbak = print_key%ibackup(my_backup_level) ! Recent backup copies correspond to lower backup indexes DO i = MIN(nbak, my_nbak), 2, -1 filename_bak_1 = TRIM(filename)//".bak-"//ADJUSTL(cp_to_string(i)) - filename_bak_2 = TRIM(filename)//".bak-"//ADJUSTL(cp_to_string(i-1)) + filename_bak_2 = TRIM(filename)//".bak-"//ADJUSTL(cp_to_string(i - 1)) IF (do_log) THEN unit_nr = cp_logger_get_unit_nr(logger, local=my_local) IF (unit_nr > 0) & diff --git a/src/input/cp_parser_ilist_methods.F b/src/input/cp_parser_ilist_methods.F index 884b3db391..aa2205ec98 100644 --- a/src/input/cp_parser_ilist_methods.F +++ b/src/input/cp_parser_ilist_methods.F @@ -42,14 +42,14 @@ SUBROUTINE ilist_setup(ilist, token) CPASSERT(ASSOCIATED(ilist)) ind = INDEX(token, "..") - READ (UNIT=token(:ind-1), FMT=*) ilist%istart - READ (UNIT=token(ind+2:), FMT=*) ilist%iend + READ (UNIT=token(:ind - 1), FMT=*) ilist%istart + READ (UNIT=token(ind + 2:), FMT=*) ilist%iend IF (ilist%istart > ilist%iend) & CALL cp_abort(__LOCATION__, & "Invalid list range specified: "// & TRIM(ADJUSTL(cp_to_string(ilist%istart)))//".."// & TRIM(ADJUSTL(cp_to_string(ilist%iend)))) - ilist%nel_list = ilist%iend-ilist%istart+1 + ilist%nel_list = ilist%iend - ilist%istart + 1 ilist%ipresent = ilist%istart ilist%in_use = .TRUE. @@ -67,7 +67,7 @@ SUBROUTINE ilist_update(ilist) CHARACTER(len=*), PARAMETER :: routineN = 'ilist_update', routineP = moduleN//':'//routineN CPASSERT(ASSOCIATED(ilist)) - ilist%ipresent = ilist%ipresent+1 + ilist%ipresent = ilist%ipresent + 1 IF (ilist%ipresent > ilist%iend) THEN CALL ilist_reset(ilist) END IF diff --git a/src/input/cp_parser_methods.F b/src/input/cp_parser_methods.F index 8c3090e84e..b842e384be 100644 --- a/src/input/cp_parser_methods.F +++ b/src/input/cp_parser_methods.F @@ -232,7 +232,7 @@ SUBROUTINE parser_get_line_from_buffer(parser, istat) CALL parser_read_line_low(parser) END IF END IF - parser%buffer%present_line_number = parser%buffer%present_line_number+1 + parser%buffer%present_line_number = parser%buffer%present_line_number + 1 parser%input_line_number = parser%buffer%input_line_numbers(parser%buffer%present_line_number) parser%input_line = parser%buffer%input_lines(parser%buffer%present_line_number) IF ((parser%buffer%istat /= 0) .AND. & @@ -268,14 +268,14 @@ SUBROUTINE parser_read_line_low(parser) IF (parser%para_env%ionode) THEN iline = 0 istat = 0 - parser%buffer%buffer_id = parser%buffer%buffer_id+1 + parser%buffer%buffer_id = parser%buffer%buffer_id + 1 parser%buffer%present_line_number = 0 parser%buffer%last_line_number = parser%buffer%size last_buffered_line_number = parser%buffer%input_line_numbers(parser%buffer%size) DO WHILE (iline /= parser%buffer%size) ! Increment counters by 1 - iline = iline+1 - last_buffered_line_number = last_buffered_line_number+1 + iline = iline + 1 + last_buffered_line_number = last_buffered_line_number + 1 ! Try to read the next line from file parser%buffer%input_line_numbers(iline) = last_buffered_line_number @@ -302,7 +302,7 @@ SUBROUTINE parser_read_line_low(parser) islen = LEN_TRIM(parser%buffer%input_lines(iline)) ! Handle index and cycle last_buffered_line_number = 0 - iline = iline-1 + iline = iline - 1 CYCLE END IF END IF @@ -313,7 +313,7 @@ SUBROUTINE parser_read_line_low(parser) parser%buffer%input_line_numbers(iline), parser%input_unit) ! Handle index and cycle last_buffered_line_number = parser%buffer%input_line_numbers(iline) - iline = iline-1 + iline = iline - 1 CYCLE END IF END IF @@ -334,8 +334,8 @@ SUBROUTINE parser_read_line_low(parser) non_white_found = .TRUE. END IF IF (.NOT. non_white_found) THEN - iline = iline-1 - last_buffered_line_number = last_buffered_line_number-1 + iline = iline - 1 + last_buffered_line_number = last_buffered_line_number - 1 END IF END DO END IF @@ -502,7 +502,7 @@ SUBROUTINE parser_skip_space(parser) outer_loop: DO ! Increment the column counter - parser%icol = parser%icol+1 + parser%icol = parser%icol + 1 ! Quick return, if the end of line is found IF ((parser%icol > LEN_TRIM(parser%input_line)) .OR. & @@ -516,7 +516,7 @@ SUBROUTINE parser_skip_space(parser) IF (.NOT. is_whitespace(parser%input_line(parser%icol:parser%icol))) THEN ! Check for input line continuation IF (parser%input_line(parser%icol:parser%icol) == parser%continuation_character) THEN - inner_loop: DO i = parser%icol+1, LEN_TRIM(parser%input_line) + inner_loop: DO i = parser%icol + 1, LEN_TRIM(parser%input_line) IF (is_whitespace(parser%input_line(i:i))) CYCLE inner_loop IF (is_comment(parser, parser%input_line(i:i))) THEN EXIT inner_loop @@ -537,7 +537,7 @@ SUBROUTINE parser_skip_space(parser) parser%icol = 0 CYCLE outer_loop ELSE - parser%icol = parser%icol-1 + parser%icol = parser%icol - 1 parser%icol1 = parser%icol parser%icol2 = parser%icol RETURN @@ -592,11 +592,11 @@ SUBROUTINE parser_next_token(parser, string_length) IF (parser%icol == -1) & CPABORT("Unexpectetly reached EOF"//TRIM(parser_location(parser))) - length = MIN(len_trim_inputline-parser%icol1+1, length) - parser%icol1 = parser%icol+1 - parser%icol2 = parser%icol+length + length = MIN(len_trim_inputline - parser%icol1 + 1, length) + parser%icol1 = parser%icol + 1 + parser%icol2 = parser%icol + length i = INDEX(parser%input_line(parser%icol1:parser%icol2), parser%quote_character) - IF (i > 0) parser%icol2 = parser%icol+i + IF (i > 0) parser%icol2 = parser%icol + i parser%icol = parser%icol2 ELSE @@ -614,7 +614,7 @@ SUBROUTINE parser_next_token(parser, string_length) outer_loop1: DO ! Increment the column counter - parser%icol = parser%icol+1 + parser%icol = parser%icol + 1 ! Quick return, if the end of line is found IF (parser%icol > len_trim_inputline) THEN @@ -635,8 +635,8 @@ SUBROUTINE parser_next_token(parser, string_length) RETURN ELSE IF (token == parser%quote_character) THEN ! Read quoted string - parser%icol1 = parser%icol+1 - parser%icol2 = parser%icol+INDEX(parser%input_line(parser%icol1:), parser%quote_character) + parser%icol1 = parser%icol + 1 + parser%icol2 = parser%icol + INDEX(parser%input_line(parser%icol1:), parser%quote_character) IF (parser%icol2 == parser%icol) THEN parser%icol1 = parser%icol parser%icol2 = parser%icol @@ -644,13 +644,13 @@ SUBROUTINE parser_next_token(parser, string_length) "Unmatched quotation mark found"//TRIM(parser_location(parser))) ELSE parser%icol = parser%icol2 - parser%icol2 = parser%icol2-1 + parser%icol2 = parser%icol2 - 1 parser%first_separator = .TRUE. RETURN END IF ELSE IF (token == parser%continuation_character) THEN ! Check for input line continuation - inner_loop1: DO i = parser%icol+1, len_trim_inputline + inner_loop1: DO i = parser%icol + 1, len_trim_inputline IF (is_whitespace(parser%input_line(i:i))) THEN CYCLE inner_loop1 ELSE IF (is_comment(parser, parser%input_line(i:i))) THEN @@ -691,7 +691,7 @@ SUBROUTINE parser_next_token(parser, string_length) ! Search for the end of the next input string outer_loop2: DO - parser%icol = parser%icol+1 + parser%icol = parser%icol + 1 IF (parser%icol > len_trim_inputline) EXIT outer_loop2 token = parser%input_line(parser%icol:parser%icol) IF (is_whitespace(token) .OR. is_comment(parser, token) .OR. & @@ -703,7 +703,7 @@ SUBROUTINE parser_next_token(parser, string_length) END IF END DO outer_loop2 - parser%icol2 = parser%icol-1 + parser%icol2 = parser%icol - 1 IF (parser%input_line(parser%icol:parser%icol) == & parser%continuation_character) parser%icol = parser%icol2 @@ -872,7 +872,7 @@ SUBROUTINE parser_search_string(parser, string, ignore_case, found, line, begin_ IF (ipattern > 0) THEN found = .TRUE. - parser%icol = ipattern-1 + parser%icol = ipattern - 1 IF (PRESENT(line)) THEN IF (LEN(line) < LEN_TRIM(parser%input_line)) THEN CALL cp_warn(__LOCATION__, & @@ -929,16 +929,16 @@ FUNCTION integer_object(string) RESULT(contains_integer_object) istar = INDEX(string(1:n), "*") IF (idots /= 0) THEN - contains_integer_object = is_integer(string(1:idots-1)) .AND. & - is_integer(string(idots+2:n)) + contains_integer_object = is_integer(string(1:idots - 1)) .AND. & + is_integer(string(idots + 2:n)) ELSE IF (istar /= 0) THEN i = 1 DO WHILE (istar /= 0) - IF (.NOT. is_integer(string(i:i+istar-2))) THEN + IF (.NOT. is_integer(string(i:i + istar - 2))) THEN contains_integer_object = .FALSE. RETURN END IF - i = i+istar + i = i + istar istar = INDEX(string(i:n), "*") END DO contains_integer_object = is_integer(string(i:n)) @@ -1024,7 +1024,7 @@ SUBROUTINE parser_get_integer(parser, object, newline, skip_lines, & END IF IF (PRESENT(newline)) THEN - IF (newline) nline = nline+1 + IF (newline) nline = nline + 1 END IF CALL parser_get_next_line(parser, nline, at_end=my_at_end) @@ -1115,7 +1115,7 @@ SUBROUTINE parser_get_logical(parser, object, newline, skip_lines, & END IF IF (PRESENT(newline)) THEN - IF (newline) nline = nline+1 + IF (newline) nline = nline + 1 END IF CALL parser_get_next_line(parser, nline, at_end=my_at_end) @@ -1132,7 +1132,7 @@ SUBROUTINE parser_get_logical(parser, object, newline, skip_lines, & CALL parser_next_token(parser) END IF - input_string_length = parser%icol2-parser%icol1+1 + input_string_length = parser%icol2 - parser%icol1 + 1 IF (input_string_length == 0) THEN parser%icol1 = parser%icol @@ -1146,7 +1146,7 @@ SUBROUTINE parser_get_logical(parser, object, newline, skip_lines, & END IF CALL uppercase(input_string) - SELECT CASE (TRIM (input_string)) + SELECT CASE (TRIM(input_string)) CASE ("0", "F", ".F.", "FALSE", ".FALSE.", "N", "NO", "OFF") object = .FALSE. CASE ("1", "T", ".T.", "TRUE", ".TRUE.", "Y", "YES", "ON") @@ -1198,7 +1198,7 @@ SUBROUTINE parser_get_real(parser, object, newline, skip_lines, string_length, & END IF IF (PRESENT(newline)) THEN - IF (newline) nline = nline+1 + IF (newline) nline = nline + 1 END IF CALL parser_get_next_line(parser, nline, at_end=my_at_end) @@ -1270,7 +1270,7 @@ SUBROUTINE parser_get_string(parser, object, lower_to_upper, newline, skip_lines END IF IF (PRESENT(newline)) THEN - IF (newline) nline = nline+1 + IF (newline) nline = nline + 1 END IF CALL parser_get_next_line(parser, nline, at_end=my_at_end) @@ -1288,7 +1288,7 @@ SUBROUTINE parser_get_string(parser, object, lower_to_upper, newline, skip_lines CALL parser_next_token(parser) END IF - input_string_length = parser%icol2-parser%icol1+1 + input_string_length = parser%icol2 - parser%icol1 + 1 IF (input_string_length <= 0) THEN CALL cp_abort(__LOCATION__, & @@ -1300,7 +1300,7 @@ SUBROUTINE parser_get_string(parser, object, lower_to_upper, newline, skip_lines "> has more than "//cp_to_string(LEN(object))// & " characters and is therefore too long to fit in the "// & "specified variable"//TRIM(parser_location(parser))) - object = parser%input_line(parser%icol1:parser%icol1+LEN(object)-1) + object = parser%input_line(parser%icol1:parser%icol1 + LEN(object) - 1) ELSE object(:input_string_length) = parser%input_line(parser%icol1:parser%icol2) END IF @@ -1343,12 +1343,12 @@ SUBROUTINE read_float_object(string, object, error_message) parsing_done = .FALSE. DO WHILE (.NOT. parsing_done) - i = i+iop + i = i + iop islash = INDEX(string(i:n), "/") istar = INDEX(string(i:n), "*") IF ((islash == 0) .AND. (istar == 0)) THEN ! Last factor found: read it and then exit the loop - iop = n-i+2 + iop = n - i + 2 parsing_done = .TRUE. ELSE IF ((islash > 0) .AND. (istar > 0)) THEN iop = MIN(islash, istar) @@ -1357,20 +1357,20 @@ SUBROUTINE read_float_object(string, object, error_message) ELSE IF (istar > 0) THEN iop = istar END IF - READ (UNIT=string(i:i+iop-2), FMT=*, IOSTAT=istat) z + READ (UNIT=string(i:i + iop - 2), FMT=*, IOSTAT=istat) z IF (istat /= 0) THEN error_message = "A floating point type object was expected, found <"// & - string(i:i+iop-2)//">" + string(i:i + iop - 2)//">" RETURN END IF IF (i == 1) THEN object = z - ELSE IF (string(i-1:i-1) == "*") THEN + ELSE IF (string(i - 1:i - 1) == "*") THEN object = object*z ELSE IF (z == 0.0_dp) THEN error_message = "Division by zero found <"// & - string(i:i+iop-2)//">" + string(i:i + iop - 2)//">" RETURN ELSE object = object/z @@ -1411,7 +1411,7 @@ SUBROUTINE read_integer_object(string, object, error_message) parsing_done = .FALSE. DO WHILE (.NOT. parsing_done) - i = i+iop + i = i + iop ! note that INDEX always starts counting from 1 if found. Thus iop ! will give the length of the integer number plus 1 iop = INDEX(string(i:n), "*") @@ -1420,20 +1420,20 @@ SUBROUTINE read_integer_object(string, object, error_message) ! note that iop will always be the length of one integer plus 1 ! and we still need to calculate it here as it is need for fmtstr ! below to determine integer format length - iop = n-i+2 + iop = n - i + 2 parsing_done = .TRUE. END IF istat = 1 - IF (iop-1 > 0) THEN + IF (iop - 1 > 0) THEN ! need an explicit fmtstr here. With 'FMT=*' compilers from intel and pgi will also ! read float numbers as integers, without setting istat non-zero, i.e. string="0.3", istat=0, iz8=0 ! this leads to wrong CP2K results (e.g. parsing force fields). - WRITE (fmtstr, FMT='(A,I0,A)') '(I', iop-1, ')' - READ (UNIT=string(i:i+iop-2), FMT=fmtstr, IOSTAT=istat) iz8 + WRITE (fmtstr, FMT='(A,I0,A)') '(I', iop - 1, ')' + READ (UNIT=string(i:i + iop - 2), FMT=fmtstr, IOSTAT=istat) iz8 ENDIF IF (istat /= 0) THEN error_message = "An integer type object was expected, found <"// & - string(i:i+iop-2)//">" + string(i:i + iop - 2)//">" RETURN END IF IF (i == 1) THEN @@ -1442,7 +1442,7 @@ SUBROUTINE read_integer_object(string, object, error_message) object8 = object8*iz8 END IF IF (ABS(object8) > HUGE(0)) THEN - error_message = "The specified integer number <"//string(i:i+iop-2)// & + error_message = "The specified integer number <"//string(i:i + iop - 2)// & "> exceeds the allowed range of a 32-bit integer number." RETURN END IF diff --git a/src/input/cp_parser_types.F b/src/input/cp_parser_types.F index 1cdf092f1f..9ed791a161 100644 --- a/src/input/cp_parser_types.F +++ b/src/input/cp_parser_types.F @@ -112,7 +112,7 @@ SUBROUTINE parser_retain(parser) CPASSERT(ASSOCIATED(parser)) CPASSERT(parser%ref_count > 0) - parser%ref_count = parser%ref_count+1 + parser%ref_count = parser%ref_count + 1 END SUBROUTINE parser_retain ! ************************************************************************************************** @@ -129,7 +129,7 @@ SUBROUTINE parser_release(parser) IF (ASSOCIATED(parser)) THEN CPASSERT(parser%ref_count > 0) - parser%ref_count = parser%ref_count-1 + parser%ref_count = parser%ref_count - 1 IF (parser%ref_count == 0) THEN IF (parser%input_unit >= 0) THEN CALL close_file(unit_number=parser%input_unit) @@ -184,7 +184,7 @@ SUBROUTINE parser_create(parser, file_name, unit_nr, para_env, end_section_label CPASSERT(.NOT. ASSOCIATED(parser)) ALLOCATE (parser) - last_parser_id = last_parser_id+1 + last_parser_id = last_parser_id + 1 parser%id_nr = last_parser_id parser%ref_count = 1 diff --git a/src/input/input_enumeration_types.F b/src/input/input_enumeration_types.F index 27acb7c461..ad8255b2e1 100644 --- a/src/input/input_enumeration_types.F +++ b/src/input/input_enumeration_types.F @@ -75,7 +75,7 @@ SUBROUTINE enum_create(enum, c_vals, i_vals, desc, strict) CPASSERT(.NOT. ASSOCIATED(enum)) CPASSERT(SIZE(c_vals) == SIZE(i_vals)) ALLOCATE (enum) - last_enumeration_id = last_enumeration_id+1 + last_enumeration_id = last_enumeration_id + 1 enum%id_nr = last_enumeration_id enum%ref_count = 1 ALLOCATE (enum%c_vals(SIZE(c_vals))) @@ -117,7 +117,7 @@ SUBROUTINE enum_retain(enum) CPASSERT(ASSOCIATED(enum)) CPASSERT(enum%ref_count > 0) - enum%ref_count = enum%ref_count+1 + enum%ref_count = enum%ref_count + 1 END SUBROUTINE enum_retain ! ************************************************************************************************** @@ -134,7 +134,7 @@ SUBROUTINE enum_release(enum) IF (ASSOCIATED(enum)) THEN CPASSERT(enum%ref_count > 0) - enum%ref_count = enum%ref_count-1 + enum%ref_count = enum%ref_count - 1 IF (enum%ref_count == 0) THEN DEALLOCATE (enum%c_vals) DEALLOCATE (enum%i_vals) diff --git a/src/input/input_keyword_types.F b/src/input/input_keyword_types.F index 05f83d1c8b..5ace91c411 100644 --- a/src/input/input_keyword_types.F +++ b/src/input/input_keyword_types.F @@ -191,16 +191,16 @@ SUBROUTINE keyword_create(keyword, location, name, description, usage, type_of_v CPASSERT(.NOT. ASSOCIATED(keyword)) ALLOCATE (keyword) keyword%ref_count = 1 - last_keyword_id = last_keyword_id+1 + last_keyword_id = last_keyword_id + 1 keyword%id_nr = last_keyword_id NULLIFY (keyword%unit) keyword%location = location IF (PRESENT(variants)) THEN - ALLOCATE (keyword%names(SIZE(variants)+1)) + ALLOCATE (keyword%names(SIZE(variants) + 1)) keyword%names(1) = name DO i = 1, SIZE(variants) - keyword%names(i+1) = variants(i) + keyword%names(i + 1) = variants(i) END DO ELSE ALLOCATE (keyword%names(1)) @@ -399,7 +399,7 @@ SUBROUTINE keyword_retain(keyword) CPASSERT(ASSOCIATED(keyword)) CPASSERT(keyword%ref_count > 0) - keyword%ref_count = keyword%ref_count+1 + keyword%ref_count = keyword%ref_count + 1 END SUBROUTINE keyword_retain ! ************************************************************************************************** @@ -415,7 +415,7 @@ SUBROUTINE keyword_release(keyword) IF (ASSOCIATED(keyword)) THEN CPASSERT(keyword%ref_count > 0) - keyword%ref_count = keyword%ref_count-1 + keyword%ref_count = keyword%ref_count - 1 IF (keyword%ref_count == 0) THEN DEALLOCATE (keyword%names) DEALLOCATE (keyword%description) @@ -578,12 +578,12 @@ SUBROUTINE keyword_describe(keyword, unit_nr, level) l = 17 DO i = 1, SIZE(keyword%enum%c_vals) c_string = keyword%enum%c_vals(i) - IF (l+LEN_TRIM(c_string) > 72 .AND. l > 14) THEN + IF (l + LEN_TRIM(c_string) > 72 .AND. l > 14) THEN WRITE (unit_nr, "(/,' ')", advance='NO') l = 4 END IF WRITE (unit_nr, "(' ',a)", advance='NO') TRIM(c_string) - l = LEN_TRIM(c_string)+3 + l = LEN_TRIM(c_string) + 3 END DO WRITE (unit_nr, "()") END IF @@ -640,10 +640,10 @@ SUBROUTINE write_keyword_xml(keyword, level, unit_number) ! Indentation for current level, next level, etc. l0 = level - l1 = level+1 - l2 = level+2 - l3 = level+3 - l4 = level+4 + l1 = level + 1 + l2 = level + 2 + l3 = level + 3 + l4 = level + 4 IF (keyword%repeats) THEN repeats = "yes" @@ -822,16 +822,16 @@ SUBROUTINE keyword_typo_match(keyword, unknown_string, location_string, matching DO i = 1, SIZE(keyword%names) imatch = typo_match(TRIM(keyword%names(i)), TRIM(unknown_string)) IF (imatch > 0) THEN - imatch = imatch+bonus + imatch = imatch + bonus WRITE (line, '(T2,A)') " keyword "//TRIM(keyword%names(i))//" in section "//TRIM(location_string) imax = SIZE(matching_rank, 1) - irank = imax+1 + irank = imax + 1 DO k = imax, 1, -1 IF (imatch > matching_rank(k)) irank = k ENDDO IF (irank <= imax) THEN - matching_rank(irank+1:imax) = matching_rank(irank:imax-1) - matching_string(irank+1:imax) = matching_string(irank:imax-1) + matching_rank(irank + 1:imax) = matching_rank(irank:imax - 1) + matching_string(irank + 1:imax) = matching_string(irank:imax - 1) matching_rank(irank) = imatch matching_string(irank) = line ENDIF @@ -841,18 +841,18 @@ SUBROUTINE keyword_typo_match(keyword, unknown_string, location_string, matching DO j = 1, SIZE(keyword%enum%c_vals) imatch = typo_match(TRIM(keyword%enum%c_vals(j)), TRIM(unknown_string)) IF (imatch > 0) THEN - imatch = imatch+bonus + imatch = imatch + bonus WRITE (line, '(T2,A)') " enum "//TRIM(keyword%enum%c_vals(j))// & " in section "//TRIM(location_string)// & " for keyword "//TRIM(keyword%names(i)) imax = SIZE(matching_rank, 1) - irank = imax+1 + irank = imax + 1 DO k = imax, 1, -1 IF (imatch > matching_rank(k)) irank = k ENDDO IF (irank <= imax) THEN - matching_rank(irank+1:imax) = matching_rank(irank:imax-1) - matching_string(irank+1:imax) = matching_string(irank:imax-1) + matching_rank(irank + 1:imax) = matching_rank(irank:imax - 1) + matching_string(irank + 1:imax) = matching_string(irank:imax - 1) matching_rank(irank) = imatch matching_string(irank) = line ENDIF diff --git a/src/input/input_parsing.F b/src/input/input_parsing.F index e762f3908c..3092ba6d22 100644 --- a/src/input/input_parsing.F +++ b/src/input/input_parsing.F @@ -192,9 +192,9 @@ RECURSIVE SUBROUTINE section_vals_parse(section_vals, parser, default_units, roo lower_to_upper=.TRUE.) IF (token(1:1) == parser%section_character) THEN IF (token == "&END") THEN - nSub = nSub-1 + nSub = nSub - 1 ELSE - nSub = nSub+1 + nSub = nSub + 1 END IF END IF END DO @@ -228,7 +228,7 @@ RECURSIVE SUBROUTINE section_vals_parse(section_vals, parser, default_units, roo ELSE ! token is a "normal" keyword ik = section_get_keyword_index(section, token) IF (ik < 1) THEN ! don't accept pseudo keyword names - parser%icol = parser%icol1-1 ! re-read also the actual token + parser%icol = parser%icol1 - 1 ! re-read also the actual token ik = 0 IF (.NOT. ASSOCIATED(section%keywords(0)%keyword)) THEN IF (output_unit > 0) THEN @@ -646,10 +646,10 @@ SUBROUTINE get_r_val(r_val, parser, unit, default_units, c_val) "Invalid unit specifier found when parsing a number: "// & c_val) END IF - CALL cp_unit_create(my_unit, c_val(2:LEN_TRIM(c_val)-1)) + CALL cp_unit_create(my_unit, c_val(2:LEN_TRIM(c_val) - 1)) ELSE IF (c_val /= "") THEN - CALL cp_unit_create(my_unit, c_val(2:LEN_TRIM(c_val)-1)) + CALL cp_unit_create(my_unit, c_val(2:LEN_TRIM(c_val) - 1)) ELSE my_unit => unit END IF diff --git a/src/input/input_section_types.F b/src/input/input_section_types.F index f5f48002f4..fa204cf00d 100644 --- a/src/input/input_section_types.F +++ b/src/input/input_section_types.F @@ -169,7 +169,7 @@ SUBROUTINE section_create(section, location, name, description, n_keywords, & IF (PRESENT(n_subsections)) my_n_subsections = n_subsections ALLOCATE (section) - last_section_id = last_section_id+1 + last_section_id = last_section_id + 1 section%id_nr = last_section_id section%ref_count = 1 @@ -218,7 +218,7 @@ SUBROUTINE section_retain(section) CPASSERT(ASSOCIATED(section)) CPASSERT(section%ref_count > 0) - section%ref_count = section%ref_count+1 + section%ref_count = section%ref_count + 1 END SUBROUTINE section_retain ! ************************************************************************************************** @@ -236,7 +236,7 @@ RECURSIVE SUBROUTINE section_release(section) IF (ASSOCIATED(section)) THEN CPASSERT(section%ref_count > 0) - section%ref_count = section%ref_count-1 + section%ref_count = section%ref_count - 1 IF (section%ref_count == 0) THEN IF (ASSOCIATED(section%citations)) THEN DEALLOCATE (section%citations) @@ -349,7 +349,7 @@ RECURSIVE SUBROUTINE section_describe(section, unit_nr, level, hide_root, recurs DO isub = 1, section%n_subsections IF (my_recurse > 0) THEN CALL section_describe(section%subsections(isub)%section, unit_nr, & - level, recurse=my_recurse-1) + level, recurse=my_recurse - 1) ELSE WRITE (unit_nr, "(' ',a)") section%subsections(isub)%section%name END IF @@ -486,10 +486,10 @@ RECURSIVE FUNCTION section_get_keyword(section, keyword_name) RESULT(res) INTEGER :: ik, my_index IF (INDEX(keyword_name, "%") /= 0) THEN - my_index = INDEX(keyword_name, "%")+1 + my_index = INDEX(keyword_name, "%") + 1 CPASSERT(ASSOCIATED(section%subsections)) DO ik = LBOUND(section%subsections, 1), UBOUND(section%subsections, 1) - IF (section%subsections(ik)%section%name == keyword_name(1:my_index-2)) EXIT + IF (section%subsections(ik)%section%name == keyword_name(1:my_index - 2)) EXIT END DO CPASSERT(ik <= UBOUND(section%subsections, 1)) res => section_get_keyword(section%subsections(ik)%section, keyword_name(my_index:)) @@ -546,17 +546,17 @@ SUBROUTINE section_add_keyword(section, keyword) END DO IF (UBOUND(section%keywords, 1) == section%n_keywords) THEN - ALLOCATE (new_keywords(-1:section%n_keywords+10)) + ALLOCATE (new_keywords(-1:section%n_keywords + 10)) DO i = -1, section%n_keywords new_keywords(i)%keyword => section%keywords(i)%keyword END DO - DO i = section%n_keywords+1, UBOUND(new_keywords, 1) + DO i = section%n_keywords + 1, UBOUND(new_keywords, 1) NULLIFY (new_keywords(i)%keyword) END DO DEALLOCATE (section%keywords) section%keywords => new_keywords END IF - section%n_keywords = section%n_keywords+1 + section%n_keywords = section%n_keywords + 1 section%keywords(section%n_keywords)%keyword => keyword END IF END SUBROUTINE section_add_keyword @@ -580,12 +580,12 @@ SUBROUTINE section_add_subsection(section, subsection) CPASSERT(section%ref_count > 0) CPASSERT(ASSOCIATED(subsection)) CPASSERT(subsection%ref_count > 0) - IF (SIZE(section%subsections) < section%n_subsections+1) THEN - ALLOCATE (new_subsections(section%n_subsections+10)) + IF (SIZE(section%subsections) < section%n_subsections + 1) THEN + ALLOCATE (new_subsections(section%n_subsections + 10)) DO i = 1, section%n_subsections new_subsections(i)%section => section%subsections(i)%section END DO - DO i = section%n_subsections+1, SIZE(new_subsections) + DO i = section%n_subsections + 1, SIZE(new_subsections) NULLIFY (new_subsections(i)%section) END DO DEALLOCATE (section%subsections) @@ -599,7 +599,7 @@ SUBROUTINE section_add_subsection(section, subsection) //TRIM(section%name)) END DO CALL section_retain(subsection) - section%n_subsections = section%n_subsections+1 + section%n_subsections = section%n_subsections + 1 section%subsections(section%n_subsections)%section => subsection END SUBROUTINE section_add_subsection @@ -620,7 +620,7 @@ RECURSIVE SUBROUTINE section_vals_create(section_vals, section) CPASSERT(.NOT. ASSOCIATED(section_vals)) ALLOCATE (section_vals) - last_section_vals_id = last_section_vals_id+1 + last_section_vals_id = last_section_vals_id + 1 section_vals%id_nr = last_section_vals_id section_vals%ref_count = 1 CALL section_retain(section) @@ -649,7 +649,7 @@ SUBROUTINE section_vals_retain(section_vals) CPASSERT(ASSOCIATED(section_vals)) CPASSERT(section_vals%ref_count > 0) - section_vals%ref_count = section_vals%ref_count+1 + section_vals%ref_count = section_vals%ref_count + 1 END SUBROUTINE section_vals_retain ! ************************************************************************************************** @@ -669,7 +669,7 @@ RECURSIVE SUBROUTINE section_vals_release(section_vals) IF (ASSOCIATED(section_vals)) THEN CPASSERT(section_vals%ref_count > 0) - section_vals%ref_count = section_vals%ref_count-1 + section_vals%ref_count = section_vals%ref_count - 1 IF (section_vals%ref_count == 0) THEN CALL section_release(section_vals%section) DO j = 1, SIZE(section_vals%values, 2) @@ -771,7 +771,7 @@ RECURSIVE FUNCTION section_vals_get_subs_vals(section_vals, subsection_name, & ELSE is_path = .TRUE. irep = 1 - my_index = my_index-1 + my_index = my_index - 1 ENDIF CPASSERT(irep <= SIZE(section_vals%subs_vals, 2)) @@ -783,7 +783,7 @@ RECURSIVE FUNCTION section_vals_get_subs_vals(section_vals, subsection_name, & "could not find subsection "//TRIM(subsection_name(1:my_index))//" in section "// & TRIM(section_vals%section%name)//" at ") IF (is_path .AND. ASSOCIATED(res)) THEN - res => section_vals_get_subs_vals(res, subsection_name(my_index+2:LEN_TRIM(subsection_name)), & + res => section_vals_get_subs_vals(res, subsection_name(my_index + 2:LEN_TRIM(subsection_name)), & i_rep_section, can_return_null) ENDIF @@ -819,7 +819,7 @@ FUNCTION section_vals_get_subs_vals2(section_vals, i_section, i_rep_section) RES isect_att = 0 DO i = 1, section_vals%section%n_subsections IF (SIZE(section_vals%subs_vals(i, irep)%section_vals%values, 2) > 0) THEN - isect_att = isect_att+1 + isect_att = isect_att + 1 IF (isect_att == i_section) THEN res => section_vals%subs_vals(i, irep)%section_vals EXIT @@ -878,7 +878,7 @@ SUBROUTINE section_vals_add_values(section_vals) CPASSERT(ASSOCIATED(section_vals)) CPASSERT(section_vals%ref_count > 0) - ALLOCATE (new_values(-1:UBOUND(section_vals%values, 1), SIZE(section_vals%values, 2)+1)) + ALLOCATE (new_values(-1:UBOUND(section_vals%values, 1), SIZE(section_vals%values, 2) + 1)) DO j = 1, SIZE(section_vals%values, 2) DO i = -1, UBOUND(section_vals%values, 1) new_values(i, j)%list => section_vals%values(i, j)%list @@ -893,7 +893,7 @@ SUBROUTINE section_vals_add_values(section_vals) IF (SIZE(new_values, 2) > 1) THEN ALLOCATE (new_sps(SIZE(section_vals%subs_vals, 1), & - SIZE(section_vals%subs_vals, 2)+1)) + SIZE(section_vals%subs_vals, 2) + 1)) DO j = 1, SIZE(section_vals%subs_vals, 2) DO i = 1, SIZE(section_vals%subs_vals, 1) new_sps(i, j)%section_vals => section_vals%subs_vals(i, j)%section_vals @@ -1104,15 +1104,15 @@ SUBROUTINE section_vals_val_get(section_vals, keyword_name, i_rep_section, & CPASSERT(ASSOCIATED(section_vals)) CPASSERT(section_vals%ref_count > 0) - my_index = INDEX(keyword_name, '%')+1 + my_index = INDEX(keyword_name, '%') + 1 len_key = LEN_TRIM(keyword_name) IF (my_index > 1) THEN DO tmp_index = INDEX(keyword_name(my_index:len_key), "%") IF (tmp_index <= 0) EXIT - my_index = my_index+tmp_index + my_index = my_index + tmp_index END DO - s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index-2)) + s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2)) ELSE s_vals => section_vals END IF @@ -1200,15 +1200,15 @@ SUBROUTINE section_vals_list_get(section_vals, keyword_name, i_rep_section, & CPASSERT(ASSOCIATED(section_vals)) CPASSERT(section_vals%ref_count > 0) NULLIFY (list) - my_index = INDEX(keyword_name, '%')+1 + my_index = INDEX(keyword_name, '%') + 1 len_key = LEN_TRIM(keyword_name) IF (my_index > 1) THEN DO tmp_index = INDEX(keyword_name(my_index:len_key), "%") IF (tmp_index <= 0) EXIT - my_index = my_index+tmp_index + my_index = my_index + tmp_index END DO - s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index-2)) + s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2)) ELSE s_vals => section_vals END IF @@ -1283,15 +1283,15 @@ SUBROUTINE section_vals_val_set(section_vals, keyword_name, i_rep_section, i_rep CPASSERT(ASSOCIATED(section_vals)) CPASSERT(section_vals%ref_count > 0) - my_index = INDEX(keyword_name, '%')+1 + my_index = INDEX(keyword_name, '%') + 1 len_key = LEN_TRIM(keyword_name) IF (my_index > 1) THEN DO tmp_index = INDEX(keyword_name(my_index:len_key), "%") IF (tmp_index <= 0) EXIT - my_index = my_index+tmp_index + my_index = my_index + tmp_index END DO - s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index-2)) + s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2)) ELSE s_vals => section_vals END IF @@ -1360,7 +1360,7 @@ SUBROUTINE section_vals_val_set(section_vals, keyword_name, i_rep_section, i_rep old_val => cp_sll_val_get_el_at(vals, index=irk) CALL val_release(old_val) CALL cp_sll_val_set_el_at(vals, value=my_val, index=irk) - ELSE IF (irk > cp_sll_val_get_length(vals)+1) THEN + ELSE IF (irk > cp_sll_val_get_length(vals) + 1) THEN ! change? CALL cp_abort(__LOCATION__, & "cannot add extra keyword repetitions to keyword" & @@ -1406,15 +1406,15 @@ SUBROUTINE section_vals_val_unset(section_vals, keyword_name, i_rep_section, & CPASSERT(ASSOCIATED(section_vals)) CPASSERT(section_vals%ref_count > 0) - my_index = INDEX(keyword_name, '%')+1 + my_index = INDEX(keyword_name, '%') + 1 len_key = LEN_TRIM(keyword_name) IF (my_index > 1) THEN DO tmp_index = INDEX(keyword_name(my_index:len_key), "%") IF (tmp_index <= 0) EXIT - my_index = my_index+tmp_index + my_index = my_index + tmp_index END DO - s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index-2)) + s_vals => section_vals_get_subs_vals(section_vals, keyword_name(1:my_index - 2)) ELSE s_vals => section_vals END IF @@ -1439,7 +1439,7 @@ SUBROUTINE section_vals_val_unset(section_vals, keyword_name, i_rep_section, & IF (irk == -1) THEN pos => cp_sll_val_get_rest(s_vals%values(ik, irs)%list, iter=-1) ELSE - pos => cp_sll_val_get_rest(s_vals%values(ik, irs)%list, iter=irk-1) + pos => cp_sll_val_get_rest(s_vals%values(ik, irs)%list, iter=irk - 1) END IF IF (ASSOCIATED(pos)) THEN old_val => cp_sll_val_get_el_at(s_vals%values(ik, irs)%list, index=irk) @@ -1502,7 +1502,7 @@ RECURSIVE SUBROUTINE section_vals_write(section_vals, unit_nr, hide_root, hide_d END IF defaultSection = (SIZE(section_vals%values, 2) == 0) IF (.NOT. defaultSection) THEN - IF (.NOT. my_hide_root) indent = indent+2 + IF (.NOT. my_hide_root) indent = indent + 2 WRITE (myfmt, *) indent, "X" CALL compress(myfmt, full=.TRUE.) DO ik = -1, section%n_keywords @@ -1568,7 +1568,7 @@ RECURSIVE SUBROUTINE section_vals_write(section_vals, unit_nr, hide_root, hide_d END IF END IF IF (.NOT. my_hide_root) THEN - indent = indent-2 + indent = indent - 2 WRITE (UNIT=unit_nr, FMT="(A)") & REPEAT(" ", indent)//"&END "//TRIM(section%name) END IF @@ -1603,8 +1603,8 @@ RECURSIVE SUBROUTINE write_section_xml(section, level, unit_number) ! Indentation for current level, next level, etc. l0 = level - l1 = level+1 - l2 = level+2 + l1 = level + 1 + l2 = level + 2 IF (section%repeats) THEN repeats = "yes" @@ -1680,16 +1680,16 @@ RECURSIVE SUBROUTINE section_typo_match(section, section_name, unknown_string, l CPASSERT(section%ref_count > 0) imatch = typo_match(TRIM(section%name), TRIM(unknown_string)) IF (imatch > 0) THEN - imatch = imatch+bonus + imatch = imatch + bonus WRITE (line, '(T2,A)') " subsection "//TRIM(section%name)//" in section "//TRIM(location_string) imax = SIZE(matching_rank, 1) - irank = imax+1 + irank = imax + 1 DO I = imax, 1, -1 IF (imatch > matching_rank(I)) irank = i ENDDO IF (irank <= imax) THEN - matching_rank(irank+1:imax) = matching_rank(irank:imax-1) - matching_string(irank+1:imax) = matching_string(irank:imax-1) + matching_rank(irank + 1:imax) = matching_rank(irank:imax - 1) + matching_string(irank + 1:imax) = matching_string(irank:imax - 1) matching_rank(irank) = imatch matching_string(irank) = line ENDIF @@ -1748,15 +1748,15 @@ SUBROUTINE section_vals_set_subs_vals(section_vals, subsection_name, & irep = 1 IF (PRESENT(i_rep_section)) irep = i_rep_section - my_index = INDEX(subsection_name, '%')+1 + my_index = INDEX(subsection_name, '%') + 1 len_key = LEN_TRIM(subsection_name) IF (my_index > 1) THEN DO tmp_index = INDEX(subsection_name(my_index:len_key), "%") IF (tmp_index <= 0) EXIT - my_index = my_index+tmp_index + my_index = my_index + tmp_index END DO - s_vals => section_vals_get_subs_vals(section_vals, subsection_name(1:my_index-2)) + s_vals => section_vals_get_subs_vals(section_vals, subsection_name(1:my_index - 2)) ELSE s_vals => section_vals END IF @@ -1837,7 +1837,7 @@ RECURSIVE SUBROUTINE section_vals_copy(section_vals_in, section_vals_out, & CALL val_duplicate(v1%first_el, el) CALL cp_sll_val_create(v2, el) NULLIFY (el) - section_vals_out%values(ival, irep-istart+1)%list => v2 + section_vals_out%values(ival, irep - istart + 1)%list => v2 DO IF (.NOT. ASSOCIATED(v1%rest)) EXIT v1 => v1%rest @@ -1860,7 +1860,7 @@ RECURSIVE SUBROUTINE section_vals_copy(section_vals_in, section_vals_out, & DO irep = istart, iend DO isec = 1, SIZE(section_vals_in%subs_vals, 1) CALL section_vals_copy(section_vals_in%subs_vals(isec, irep)%section_vals, & - section_vals_out%subs_vals(isec, irep-istart+1)%section_vals) + section_vals_out%subs_vals(isec, irep - istart + 1)%section_vals) END DO END DO END SUBROUTINE section_vals_copy diff --git a/src/input/input_val_types.F b/src/input/input_val_types.F index ccbc19230d..61364d958a 100644 --- a/src/input/input_val_types.F +++ b/src/input/input_val_types.F @@ -131,7 +131,7 @@ SUBROUTINE val_create(val, l_val, l_vals, l_vals_ptr, i_val, i_vals, i_vals_ptr, ALLOCATE (val) NULLIFY (val%l_val, val%i_val, val%r_val, val%c_val, val%enum) val%type_of_var = no_t - last_val_id = last_val_id+1 + last_val_id = last_val_id + 1 val%id_nr = last_val_id val%ref_count = 1 @@ -140,20 +140,20 @@ SUBROUTINE val_create(val, l_val, l_vals, l_vals_ptr, i_val, i_vals, i_vals_ptr, IF (PRESENT(l_val)) THEN !FM CPPrecondition(.NOT.PRESENT(l_vals),cp_failure_level,routineP,failure) !FM CPPrecondition(.NOT.PRESENT(l_vals_ptr),cp_failure_level,routineP,failure) - narg = narg+1 + narg = narg + 1 ALLOCATE (val%l_val(1)) val%l_val(1) = l_val val%type_of_var = logical_t END IF IF (PRESENT(l_vals)) THEN !FM CPPrecondition(.NOT.PRESENT(l_vals_ptr),cp_failure_level,routineP,failure) - narg = narg+1 + narg = narg + 1 ALLOCATE (val%l_val(SIZE(l_vals))) val%l_val = l_vals val%type_of_var = logical_t END IF IF (PRESENT(l_vals_ptr)) THEN - narg = narg+1 + narg = narg + 1 val%l_val => l_vals_ptr val%type_of_var = logical_t END IF @@ -161,20 +161,20 @@ SUBROUTINE val_create(val, l_val, l_vals, l_vals_ptr, i_val, i_vals, i_vals_ptr, IF (PRESENT(r_val)) THEN !FM CPPrecondition(.NOT.PRESENT(r_vals),cp_failure_level,routineP,failure) !FM CPPrecondition(.NOT.PRESENT(r_vals_ptr),cp_failure_level,routineP,failure) - narg = narg+1 + narg = narg + 1 ALLOCATE (val%r_val(1)) val%r_val(1) = r_val val%type_of_var = real_t END IF IF (PRESENT(r_vals)) THEN !FM CPPrecondition(.NOT.PRESENT(r_vals_ptr),cp_failure_level,routineP,failure) - narg = narg+1 + narg = narg + 1 ALLOCATE (val%r_val(SIZE(r_vals))) val%r_val = r_vals val%type_of_var = real_t END IF IF (PRESENT(r_vals_ptr)) THEN - narg = narg+1 + narg = narg + 1 val%r_val => r_vals_ptr val%type_of_var = real_t END IF @@ -182,20 +182,20 @@ SUBROUTINE val_create(val, l_val, l_vals, l_vals_ptr, i_val, i_vals, i_vals_ptr, IF (PRESENT(i_val)) THEN !FM CPPrecondition(.NOT.PRESENT(i_vals),cp_failure_level,routineP,failure) !FM CPPrecondition(.NOT.PRESENT(i_vals_ptr),cp_failure_level,routineP,failure) - narg = narg+1 + narg = narg + 1 ALLOCATE (val%i_val(1)) val%i_val(1) = i_val val%type_of_var = integer_t END IF IF (PRESENT(i_vals)) THEN !FM CPPrecondition(.NOT.PRESENT(i_vals_ptr),cp_failure_level,routineP,failure) - narg = narg+1 + narg = narg + 1 ALLOCATE (val%i_val(SIZE(i_vals))) val%i_val = i_vals val%type_of_var = integer_t END IF IF (PRESENT(i_vals_ptr)) THEN - narg = narg+1 + narg = narg + 1 val%i_val => i_vals_ptr val%type_of_var = integer_t END IF @@ -204,7 +204,7 @@ SUBROUTINE val_create(val, l_val, l_vals, l_vals_ptr, i_val, i_vals, i_vals_ptr, CPASSERT(LEN_TRIM(c_val) <= default_string_length) !FM CPPrecondition(.NOT.PRESENT(c_vals),cp_failure_level,routineP,failure) !FM CPPrecondition(.NOT.PRESENT(c_vals_ptr),cp_failure_level,routineP,failure) - narg = narg+1 + narg = narg + 1 ALLOCATE (val%c_val(1)) val%c_val(1) = c_val val%type_of_var = char_t @@ -212,20 +212,20 @@ SUBROUTINE val_create(val, l_val, l_vals, l_vals_ptr, i_val, i_vals, i_vals_ptr, IF (PRESENT(c_vals)) THEN !FM CPPrecondition(.NOT.PRESENT(c_vals_ptr),cp_failure_level,routineP,failure) CPASSERT(ALL(LEN_TRIM(c_vals) <= default_string_length)) - narg = narg+1 + narg = narg + 1 ALLOCATE (val%c_val(SIZE(c_vals))) val%c_val = c_vals val%type_of_var = char_t END IF IF (PRESENT(c_vals_ptr)) THEN - narg = narg+1 + narg = narg + 1 val%c_val => c_vals_ptr val%type_of_var = char_t END IF IF (PRESENT(lc_val)) THEN !FM CPPrecondition(.NOT.PRESENT(lc_vals),cp_failure_level,routineP,failure) !FM CPPrecondition(.NOT.PRESENT(lc_vals_ptr),cp_failure_level,routineP,failure) - narg = narg+1 + narg = narg + 1 len_c = LEN_TRIM(lc_val) nVal = MAX(1, CEILING(REAL(len_c, dp)/80._dp)) ALLOCATE (val%c_val(nVal)) @@ -234,7 +234,7 @@ SUBROUTINE val_create(val, l_val, l_vals, l_vals_ptr, i_val, i_vals, i_vals_ptr, val%c_val(1) = "" ELSE DO i = 1, nVal - val%c_val(i) = lc_val((i-1)*default_string_length+1: & + val%c_val(i) = lc_val((i - 1)*default_string_length + 1: & MIN(len_c, i*default_string_length)) END DO END IF @@ -242,13 +242,13 @@ SUBROUTINE val_create(val, l_val, l_vals, l_vals_ptr, i_val, i_vals, i_vals_ptr, END IF IF (PRESENT(lc_vals)) THEN CPASSERT(ALL(LEN_TRIM(lc_vals) <= default_string_length)) - narg = narg+1 + narg = narg + 1 ALLOCATE (val%c_val(SIZE(lc_vals))) val%c_val = lc_vals val%type_of_var = lchar_t END IF IF (PRESENT(lc_vals_ptr)) THEN - narg = narg+1 + narg = narg + 1 val%c_val => lc_vals_ptr val%type_of_var = lchar_t END IF @@ -281,7 +281,7 @@ SUBROUTINE val_release(val) IF (ASSOCIATED(val)) THEN CPASSERT(val%ref_count > 0) - val%ref_count = val%ref_count-1 + val%ref_count = val%ref_count - 1 IF (val%ref_count == 0) THEN IF (ASSOCIATED(val%l_val)) THEN DEALLOCATE (val%l_val) @@ -315,7 +315,7 @@ SUBROUTINE val_retain(val) CPASSERT(ASSOCIATED(val)) CPASSERT(val%ref_count > 0) - val%ref_count = val%ref_count+1 + val%ref_count = val%ref_count + 1 END SUBROUTINE val_retain ! ************************************************************************************************** @@ -413,19 +413,19 @@ SUBROUTINE val_get(val, has_l, has_i, has_r, has_lc, has_c, l_val, l_vals, i_val IF (ASSOCIATED(val%c_val)) THEN IF (SIZE(val%c_val) > 0) THEN IF (val%type_of_var == lchar_t) THEN - l_in = default_string_length*(SIZE(val%c_val)-1)+ & + l_in = default_string_length*(SIZE(val%c_val) - 1) + & LEN_TRIM(val%c_val(SIZE(val%c_val))) IF (l_out < l_in) & CALL cp_warn(__LOCATION__, & "val_get will truncate value, value beginning with '"// & TRIM(val%c_val(1))//"' is too long for variable") DO i = 1, SIZE(val%c_val) - c_val((i-1)*default_string_length+1:MIN(l_out, i*default_string_length)) = & - val%c_val(i) (1:MIN(80, l_out-(i-1)*default_string_length)) + c_val((i - 1)*default_string_length + 1:MIN(l_out, i*default_string_length)) = & + val%c_val(i) (1:MIN(80, l_out - (i - 1)*default_string_length)) IF (l_out <= i*default_string_length) EXIT END DO IF (l_out > SIZE(val%c_val)*default_string_length) & - c_val(SIZE(val%c_val)*default_string_length+1:l_out) = "" + c_val(SIZE(val%c_val)*default_string_length + 1:l_out) = "" ELSE l_in = LEN_TRIM(val%c_val(1)) IF (l_out < l_in) & @@ -452,7 +452,7 @@ SUBROUTINE val_get(val, has_l, has_i, has_r, has_lc, has_c, l_val, l_vals, i_val IF (ASSOCIATED(val%c_val)) THEN IF (SIZE(val%c_val) > 0) THEN IF (val%type_of_var == lchar_t) THEN - len_c = default_string_length*(SIZE(val%c_val)-1)+ & + len_c = default_string_length*(SIZE(val%c_val) - 1) + & LEN_TRIM(val%c_val(SIZE(val%c_val))) ELSE len_c = LEN_TRIM(val%c_val(1)) @@ -530,20 +530,20 @@ SUBROUTINE val_write(val, unit_nr, unit, unit_str, fmt) item = 0 i = 1 loop_i: DO WHILE (i <= SIZE(val%i_val)) - item = item+1 + item = item + 1 IF (MODULO(item, 10) == 0) THEN WRITE (UNIT=unit_nr, FMT="(1X,A)") default_continuation_character WRITE (UNIT=unit_nr, FMT="("//TRIM(myfmt)//")", ADVANCE="NO") END IF iend = i - loop_j: DO j = i+1, SIZE(val%i_val) - IF (val%i_val(j-1)+1 == val%i_val(j)) THEN - iend = iend+1 + loop_j: DO j = i + 1, SIZE(val%i_val) + IF (val%i_val(j - 1) + 1 == val%i_val(j)) THEN + iend = iend + 1 ELSE EXIT loop_j END IF END DO loop_j - IF ((iend-i) > 1) THEN + IF ((iend - i) > 1) THEN WRITE (UNIT=unit_nr, FMT="(1X,I0,A2,I0)", ADVANCE="NO") & val%i_val(i), "..", val%i_val(iend) i = iend @@ -551,7 +551,7 @@ SUBROUTINE val_write(val, unit_nr, unit, unit_str, fmt) WRITE (UNIT=unit_nr, FMT="(1X,I0)", ADVANCE="NO") & val%i_val(i) END IF - i = i+1 + i = i + 1 END DO loop_i ELSE CPABORT("") @@ -578,18 +578,18 @@ SUBROUTINE val_write(val, unit_nr, unit, unit_str, fmt) l = 0 DO i = 1, SIZE(val%c_val) IF (i > 1) WRITE (unit=unit_nr, fmt="(' ')", advance="NO") - l = l+1 - IF (l > 10 .AND. l+LEN_TRIM(val%c_val(i)) > 76) THEN + l = l + 1 + IF (l > 10 .AND. l + LEN_TRIM(val%c_val(i)) > 76) THEN WRITE (unit=unit_nr, fmt="('\')") WRITE (unit=unit_nr, fmt="("//TRIM(myfmt)//")", advance="NO") l = 0 WRITE (unit=unit_nr, fmt='(a)', advance="NO") TRIM(val%c_val(i)) - l = l+LEN_TRIM(val%c_val(i))+3 + l = l + LEN_TRIM(val%c_val(i)) + 3 ELSE IF (LEN_TRIM(val%c_val(i)) > 0) THEN - l = l+LEN_TRIM(val%c_val(i)) + l = l + LEN_TRIM(val%c_val(i)) WRITE (unit=unit_nr, fmt='(a)', advance="NO") TRIM(val%c_val(i)) ELSE - l = l+3 + l = l + 3 WRITE (unit=unit_nr, fmt="(a)", advance="NO") '" "' END IF END DO @@ -599,7 +599,7 @@ SUBROUTINE val_write(val, unit_nr, unit, unit_str, fmt) CASE (lchar_t) IF (ASSOCIATED(val%c_val)) THEN l = 0 - DO i = 1, SIZE(val%c_val)-1 + DO i = 1, SIZE(val%c_val) - 1 WRITE (unit=unit_nr, fmt='(a)', advance="NO") val%c_val(i) END DO IF (SIZE(val%c_val) > 0) THEN @@ -613,12 +613,12 @@ SUBROUTINE val_write(val, unit_nr, unit, unit_str, fmt) l = 0 DO i = 1, SIZE(val%i_val) c_string = enum_i2c(val%enum, val%i_val(i)) - IF (l > 10 .AND. l+LEN_TRIM(c_string) > 76) THEN + IF (l > 10 .AND. l + LEN_TRIM(c_string) > 76) THEN WRITE (unit=unit_nr, fmt="(' ',A)") default_continuation_character WRITE (unit=unit_nr, fmt="("//TRIM(myfmt)//")", advance="NO") l = 0 ELSE - l = l+LEN_TRIM(c_string)+3 + l = l + LEN_TRIM(c_string) + 3 END IF WRITE (unit=unit_nr, fmt="(' ',a)", advance="NO") TRIM(c_string) END DO @@ -672,7 +672,7 @@ SUBROUTINE val_write_internal(val, string, unit) CASE (logical_t) IF (ASSOCIATED(val%l_val)) THEN DO i = 1, SIZE(val%l_val) - WRITE (UNIT=string(2*i-1:), FMT="(L2)") val%l_val(i) + WRITE (UNIT=string(2*i - 1:), FMT="(L2)") val%l_val(i) END DO ELSE CPABORT("") @@ -680,7 +680,7 @@ SUBROUTINE val_write_internal(val, string, unit) CASE (integer_t) IF (ASSOCIATED(val%i_val)) THEN DO i = 1, SIZE(val%i_val) - WRITE (UNIT=string(12*i-11:), FMT="(I12)") val%i_val(i) + WRITE (UNIT=string(12*i - 11:), FMT="(I12)") val%i_val(i) END DO ELSE CPABORT("") @@ -691,11 +691,11 @@ SUBROUTINE val_write_internal(val, string, unit) DO i = 1, SIZE(val%r_val) value = cp_unit_from_cp2k(value=val%r_val(i), & unit_str=cp_unit_desc(unit=unit)) - WRITE (UNIT=string(17*i-16:), FMT="(ES17.8E3)") value + WRITE (UNIT=string(17*i - 16:), FMT="(ES17.8E3)") value END DO ELSE DO i = 1, SIZE(val%r_val) - WRITE (UNIT=string(17*i-16:), FMT="(ES17.8E3)") val%r_val(i) + WRITE (UNIT=string(17*i - 16:), FMT="(ES17.8E3)") val%r_val(i) END DO END IF ELSE @@ -706,7 +706,7 @@ SUBROUTINE val_write_internal(val, string, unit) ipos = 1 DO i = 1, SIZE(val%c_val) WRITE (UNIT=string(ipos:), FMT="(A)") TRIM(ADJUSTL(val%c_val(i))) - ipos = ipos+LEN_TRIM(ADJUSTL(val%c_val(i)))+1 + ipos = ipos + LEN_TRIM(ADJUSTL(val%c_val(i))) + 1 END DO ELSE CPABORT("") @@ -748,7 +748,7 @@ SUBROUTINE val_duplicate(val_in, val_out) CPASSERT(ASSOCIATED(val_in)) CPASSERT(.NOT. ASSOCIATED(val_out)) ALLOCATE (val_out) - last_val_id = last_val_id+1 + last_val_id = last_val_id + 1 val_out%id_nr = last_val_id val_out%type_of_var = val_in%type_of_var val_out%ref_count = 1 diff --git a/src/input_cp2k_binary_restarts.F b/src/input_cp2k_binary_restarts.F index f16492992c..ca67a765ea 100644 --- a/src/input_cp2k_binary_restarts.F +++ b/src/input_cp2k_binary_restarts.F @@ -761,9 +761,9 @@ SUBROUTINE read_binary_thermostats_nose(prefix, nhc, binary_restart_file_name, & END IF CALL mp_bcast(rbuf, para_env%source, para_env%group) DO i = 1, SIZE(nhc%nvt, 2) - idx = (nhc%map_info%index(i)-1)*nhc%nhc_len + idx = (nhc%map_info%index(i) - 1)*nhc%nhc_len DO j = 1, SIZE(nhc%nvt, 1) - idx = idx+1 + idx = idx + 1 nhc%nvt(j, i)%eta = rbuf(idx) END DO END DO @@ -781,9 +781,9 @@ SUBROUTINE read_binary_thermostats_nose(prefix, nhc, binary_restart_file_name, & END IF CALL mp_bcast(rbuf, para_env%source, para_env%group) DO i = 1, SIZE(nhc%nvt, 2) - idx = (nhc%map_info%index(i)-1)*nhc%nhc_len + idx = (nhc%map_info%index(i) - 1)*nhc%nhc_len DO j = 1, SIZE(nhc%nvt, 1) - idx = idx+1 + idx = idx + 1 nhc%nvt(j, i)%v = rbuf(idx) END DO END DO @@ -801,9 +801,9 @@ SUBROUTINE read_binary_thermostats_nose(prefix, nhc, binary_restart_file_name, & END IF CALL mp_bcast(rbuf, para_env%source, para_env%group) DO i = 1, SIZE(nhc%nvt, 2) - idx = (nhc%map_info%index(i)-1)*nhc%nhc_len + idx = (nhc%map_info%index(i) - 1)*nhc%nhc_len DO j = 1, SIZE(nhc%nvt, 1) - idx = idx+1 + idx = idx + 1 nhc%nvt(j, i)%mass = rbuf(idx) END DO END DO @@ -821,9 +821,9 @@ SUBROUTINE read_binary_thermostats_nose(prefix, nhc, binary_restart_file_name, & END IF CALL mp_bcast(rbuf, para_env%source, para_env%group) DO i = 1, SIZE(nhc%nvt, 2) - idx = (nhc%map_info%index(i)-1)*nhc%nhc_len + idx = (nhc%map_info%index(i) - 1)*nhc%nhc_len DO j = 1, SIZE(nhc%nvt, 1) - idx = idx+1 + idx = idx + 1 nhc%nvt(j, i)%f = rbuf(idx) END DO END DO diff --git a/src/input_cp2k_check.F b/src/input_cp2k_check.F index 212496f12f..0c28a41f0f 100644 --- a/src/input_cp2k_check.F +++ b/src/input_cp2k_check.F @@ -623,7 +623,7 @@ SUBROUTINE handle_ext_restart(input_declaration, input_file, para_env, output_un CALL section_vals_val_get(r_section, "RESTART_TEMPERATURE_ANNEALING", l_val=flag) IF (flag .AND. check_restart(input_file, restart_file, "MOTION%MD")) THEN CALL section_vals_val_get(input_file, "MOTION%MD%TEMPERATURE_ANNEALING", r_val=myt, explicit=explicit1) - IF ((.NOT. explicit1) .OR. (ABS(1._dp-myt) <= 1.E-10_dp)) THEN + IF ((.NOT. explicit1) .OR. (ABS(1._dp - myt) <= 1.E-10_dp)) THEN CALL cp_warn(__LOCATION__, & "I'm about to override the input temperature "// & "with the temperature found in external restart "// & @@ -803,7 +803,7 @@ SUBROUTINE set_restart_info(label, restarted_infos) isize = 0 IF (ASSOCIATED(restarted_infos)) isize = SIZE(restarted_infos) - isize = isize+1 + isize = isize + 1 CALL reallocate(restarted_infos, 1, isize) restarted_infos(isize) = TRIM(label) @@ -836,23 +836,23 @@ SUBROUTINE release_restart_info(restarted_infos, r_file_path, & WRITE (output_unit, '(1X,"*",T80,"*")') i = 1 WRITE (output_unit, '(1X,"*",A,T26,A,T80,"*")') " RESTART FILE NAME: ", & - r_file_path(53*(i-1)+1:53*i) + r_file_path(53*(i - 1) + 1:53*i) DO i = 2, CEILING(REAL(LEN_TRIM(r_file_path), KIND=dp)/53.0_dp) - WRITE (output_unit, '(T1,1X,"*",T26,A,T80,"*")') r_file_path(53*(i-1)+1:53*i) + WRITE (output_unit, '(T1,1X,"*",T26,A,T80,"*")') r_file_path(53*(i - 1) + 1:53*i) END DO IF (LEN_TRIM(binary_restart_file) > 0) THEN i = 1 WRITE (output_unit, '(1X,"*",A,T26,A,T80,"*")') " BINARY RESTART FILE: ", & - binary_restart_file(53*(i-1)+1:53*i) + binary_restart_file(53*(i - 1) + 1:53*i) DO i = 2, CEILING(REAL(LEN_TRIM(binary_restart_file), KIND=dp)/53.0_dp) - WRITE (output_unit, '(T1,1X,"*",T26,A,T80,"*")') binary_restart_file(53*(i-1)+1:53*i) + WRITE (output_unit, '(T1,1X,"*",T26,A,T80,"*")') binary_restart_file(53*(i - 1) + 1:53*i) END DO END IF WRITE (output_unit, '(1X,"*",T80,"*")') WRITE (output_unit, '(1X,"*", A,T80,"*")') " RESTARTED QUANTITIES: " DO j = 1, SIZE(restarted_infos) DO i = 1, CEILING(REAL(LEN_TRIM(restarted_infos(j)), KIND=dp)/53.0_dp) - WRITE (output_unit, '(T1,1X,"*",T26,A,T80,"*")') restarted_infos(j) (53*(i-1)+1:53*i) + WRITE (output_unit, '(T1,1X,"*",T26,A,T80,"*")') restarted_infos(j) (53*(i - 1) + 1:53*i) END DO END DO WRITE (output_unit, '(1X,79("*"),/)') diff --git a/src/input_cp2k_dft.F b/src/input_cp2k_dft.F index 327925df67..07d5b1712a 100644 --- a/src/input_cp2k_dft.F +++ b/src/input_cp2k_dft.F @@ -791,17 +791,17 @@ SUBROUTINE create_localize_section(section) CALL print_wanniers(print_section) NULLIFY (subsection) ! Total Dipoles with wannier - CALL create_dipoles_section(subsection, "TOTAL_DIPOLE", debug_print_level+1) + CALL create_dipoles_section(subsection, "TOTAL_DIPOLE", debug_print_level + 1) CALL section_add_subsection(print_section, subsection) CALL section_release(subsection) ! Molecular Dipoles with wannier - CALL create_dipoles_section(subsection, "MOLECULAR_DIPOLES", debug_print_level+1) + CALL create_dipoles_section(subsection, "MOLECULAR_DIPOLES", debug_print_level + 1) CALL section_add_subsection(print_section, subsection) CALL section_release(subsection) ! Molecular Mulipole Moments with wannier CALL cp_print_key_section_create(subsection, __LOCATION__, name="MOLECULAR_MOMENTS", & description="Section controlling the calculation of molecular multipole moments.", & - print_level=debug_print_level+1, filename="__STD_OUT__") + print_level=debug_print_level + 1, filename="__STD_OUT__") CALL keyword_create(keyword, __LOCATION__, name="ORDER", & description="Maximum order of mulitpoles to be calculated.", & usage=" ORDER {integer}", default_i_val=2, type_of_var=integer_t) @@ -1843,7 +1843,7 @@ SUBROUTINE create_print_dft_section(section) NULLIFY (sub_print_key) CALL cp_print_key_section_create(sub_print_key, __LOCATION__, "MINBAS_CUBE", & description="Write the minimal basis on Cube files.", & - print_level=debug_print_level+1, add_last=add_last_numeric, filename="MINBAS") + print_level=debug_print_level + 1, add_last=add_last_numeric, filename="MINBAS") CALL keyword_create(keyword, __LOCATION__, name="STRIDE", & description="The stride (X,Y,Z) used to write the cube file "// & "(larger values result in smaller cube files). You can provide 3 numbers (for X,Y,Z) or"// & @@ -1865,7 +1865,7 @@ SUBROUTINE create_print_dft_section(section) NULLIFY (sub_print_key) CALL cp_print_key_section_create(sub_print_key, __LOCATION__, "MOS_MOLDEN", & description="Write the minimal basis in Molden file format, for visualisation.", & - print_level=debug_print_level+1, add_last=add_last_numeric, filename="MINBAS") + print_level=debug_print_level + 1, add_last=add_last_numeric, filename="MINBAS") CALL keyword_create(keyword, __LOCATION__, name="NDIGITS", & description="Specifies the number of signficiant digits retained. 3 is OK for visualization.", & usage="NDIGITS {int}", & @@ -5116,7 +5116,7 @@ SUBROUTINE create_scf_section(section) CALL cp_print_key_section_create(print_key, __LOCATION__, "MOS_MOLDEN", & description="Write the molecular orbitals in Molden file format, for visualisation.", & - print_level=debug_print_level+1, add_last=add_last_numeric, filename="MOS") + print_level=debug_print_level + 1, add_last=add_last_numeric, filename="MOS") CALL keyword_create(keyword, __LOCATION__, name="NDIGITS", & description="Specifies the number of signficiant digits retained. 3 is OK for visualization.", & usage="NDIGITS {int}", & diff --git a/src/input_cp2k_mm.F b/src/input_cp2k_mm.F index 06c4237add..01f39344cc 100644 --- a/src/input_cp2k_mm.F +++ b/src/input_cp2k_mm.F @@ -177,7 +177,7 @@ SUBROUTINE create_print_mm_section(section) CALL cp_print_key_section_create(print_key, __LOCATION__, "FF_PARAMETER_FILE", description= & "Controls the printing of Force Field parameter file", & - print_level=debug_print_level+1, filename="", common_iter_levels=2) + print_level=debug_print_level + 1, filename="", common_iter_levels=2) CALL section_add_subsection(section, print_key) CALL section_release(print_key) diff --git a/src/input_cp2k_pwdft.F b/src/input_cp2k_pwdft.F index 2149192654..e2584bf44a 100644 --- a/src/input_cp2k_pwdft.F +++ b/src/input_cp2k_pwdft.F @@ -19,13 +19,13 @@ MODULE input_cp2k_pwdft sirius_option_string_get_value #endif USE input_keyword_types, ONLY: keyword_create, & - keyword_release, & - keyword_type + keyword_release, & + keyword_type USE input_section_types, ONLY: section_add_keyword, & - section_add_subsection, & - section_create, & - section_release, & - section_type + section_add_subsection, & + section_create, & + section_release, & + section_type USE kinds, ONLY: dp #include "./base/base_uses.f90" @@ -150,7 +150,7 @@ SUBROUTINE fill_in_section(section, section_name) ALLOCATE (rvec(1:16)) ALLOCATE (lvec(1:16)) CALL sirius_option_get_length(section_name, length) - DO i = 0, length-1 + DO i = 0, length - 1 NULLIFY (keyword) name = CHAR(0) ! return a non null terminated string. Stupid fortran does not understand the \0 terminated string when comparing things @@ -237,10 +237,10 @@ SUBROUTINE fill_in_section(section, section_name) default_string_val = TRIM(ADJUSTL(default_string_val)) CALL sirius_option_get_number_of_possible_values(section_name, name, num_possible_values) IF (num_possible_values > 0) THEN - DO j = 0, num_possible_values-1 - possible_values(j+1) = CHAR(0) - CALL sirius_option_string_get_value(section_name, name, j, possible_values(j+1)) - enum_i_val(j+1) = j + DO j = 0, num_possible_values - 1 + possible_values(j + 1) = CHAR(0) + CALL sirius_option_string_get_value(section_name, name, j, possible_values(j + 1)) + enum_i_val(j + 1) = j END DO CALL keyword_create(keyword, __LOCATION__, & name=name1, & diff --git a/src/input_cp2k_subsys.F b/src/input_cp2k_subsys.F index 21066a97df..ef2661358d 100644 --- a/src/input_cp2k_subsys.F +++ b/src/input_cp2k_subsys.F @@ -479,7 +479,7 @@ SUBROUTINE create_subsys_print_section(section) CALL cp_print_key_section_create(print_key, __LOCATION__, "SYMMETRY", & description="controls the output of symmetry information", & - print_level=debug_print_level+1, filename="__STD_OUT__") + print_level=debug_print_level + 1, filename="__STD_OUT__") CALL keyword_create(keyword, __LOCATION__, name="MOLECULE", & description="Assume the system is an isolated molecule", & default_l_val=.FALSE., lone_keyword_l_val=.TRUE.) diff --git a/src/input_restart_force_eval.F b/src/input_restart_force_eval.F index 459bfe839d..7d3ef2f2c8 100644 --- a/src/input_restart_force_eval.F +++ b/src/input_restart_force_eval.F @@ -176,7 +176,7 @@ SUBROUTINE update_force_eval(force_env, root_section, & dft_section => section_vals_get_subs_vals3(force_env_sections, "DFT", & i_rep_section=i_force_eval(iforce_eval)) ALLOCATE (work(SIZE(force_env%mixed_env%strength, 2))) - work = force_env%mixed_env%strength(iforce_eval-1, :) + work = force_env%mixed_env%strength(iforce_eval - 1, :) CALL section_vals_val_set(dft_section, "QS%CDFT%STRENGTH", & r_vals_ptr=work) CALL section_vals_val_set(dft_section, "QS%CDFT%COUNTER", & @@ -581,7 +581,7 @@ SUBROUTINE section_coord_val_set(coord_section, particles, molecules, conv_facto NULLIFY (my_val) ELSE IF (last_atom < irk) THEN - imol = imol+1 + imol = imol + 1 molecule_now => molecules%els(imol) CALL get_molecule(molecule_now, last_atom=last_atom) CALL get_molecule_kind(molecule_now%molecule_kind, molname_generated=molname_generated, & @@ -761,7 +761,7 @@ SUBROUTINE update_quadrupoles_section(quadrupoles, quadrupoles_section) ind = 0 DO i = 1, 3 DO j = i, 3 - ind = ind+1 + ind = ind + 1 work(ind) = quadrupoles(j, i, irk) END DO END DO @@ -847,7 +847,7 @@ SUBROUTINE dump_coordinates_cp2k(particles, molecules, cell, conv_factor, & CALL get_atomic_kind(particles%els(iparticle)%atomic_kind, name=kind_name) IF (.NOT. core_or_shell) THEN IF (iparticle > last_atom) THEN - imolecule = imolecule+1 + imolecule = imolecule + 1 molecule => molecules%els(imolecule) CALL get_molecule(molecule, last_atom=last_atom) CALL get_molecule_kind(molecule%molecule_kind, & diff --git a/src/ipi_driver.F b/src/ipi_driver.F index 70dc6e11ce..5992a6d12e 100644 --- a/src/ipi_driver.F +++ b/src/ipi_driver.F @@ -393,7 +393,7 @@ SUBROUTINE run_driver(force_env, globenv) IF (ionode) THEN CALL readbuffer(socket, header, MSGLEN) wait_msg = 0 - DO iwait = 0, para_env%num_pe-1 + DO iwait = 0, para_env%num_pe - 1 IF (iwait /= para_env%source) THEN CALL mp_send(msg=wait_msg, dest=iwait, gid=para_env%group, tag=666) ENDIF @@ -447,7 +447,7 @@ SUBROUTINE run_driver(force_env, globenv) ii = 0 DO ip = 1, subsys%particles%n_els DO idir = 1, 3 - ii = ii+1 + ii = ii + 1 subsys%particles%els(ip)%r(idir) = combuf(ii) END DO END DO @@ -462,7 +462,7 @@ SUBROUTINE run_driver(force_env, globenv) ii = 0 DO ip = 1, subsys%particles%n_els DO idir = 1, 3 - ii = ii+1 + ii = ii + 1 combuf(ii) = subsys%particles%els(ip)%f(idir) END DO END DO diff --git a/src/iterate_matrix.F b/src/iterate_matrix.F index cd2b60ea10..8eea8ed331 100644 --- a/src/iterate_matrix.F +++ b/src/iterate_matrix.F @@ -159,9 +159,9 @@ RECURSIVE SUBROUTINE determinant(matrix, det, threshold) order=order_lanczos, & eps_lanczos=eps_lanczos, & max_iter_lanczos=max_iter_lanczos) - recursion_depth = recursion_depth+1 + recursion_depth = recursion_depth + 1 CALL determinant(tmp3, det0, threshold) - recursion_depth = recursion_depth-1 + recursion_depth = recursion_depth - 1 det = det*det0*det0 ELSE @@ -190,7 +190,7 @@ RECURSIVE SUBROUTINE determinant(matrix, det, threshold) ! get trace CALL dbcsr_trace(tmp1, trace) - trace = trace*sign_iter/(1.0_dp*(i+1)) + trace = trace*sign_iter/(1.0_dp*(i + 1)) sign_iter = -sign_iter ! update the determinant @@ -205,8 +205,8 @@ RECURSIVE SUBROUTINE determinant(matrix, det, threshold) IF (unit_nr > 0) THEN WRITE (unit_nr, '(T6,A,1X,I3,1X,F7.5,F16.10,F10.3,F11.3)') & "Determinant iter", i, occ_matrix, & - det, t2-t1, & - flop1/(1.0E6_dp*MAX(0.001_dp, t2-t1)) + det, t2 - t1, & + flop1/(1.0E6_dp*MAX(0.001_dp, t2 - t1)) CALL m_flush(unit_nr) ENDIF @@ -381,8 +381,8 @@ SUBROUTINE invert_Taylor(matrix_inverse, matrix, threshold, use_inv_as_guess, & IF (unit_nr > 0) THEN WRITE (unit_nr, '(T6,A,1X,I3,1X,F10.8,E12.3,F12.3,F13.3)') "Taylor iter", i, occ_matrix, & - maxnorm_matrix, t2-t1, & - flop2/(1.0E6_dp*MAX(0.001_dp, t2-t1)) + maxnorm_matrix, t2 - t1, & + flop2/(1.0E6_dp*MAX(0.001_dp, t2 - t1)) CALL m_flush(unit_nr) ENDIF @@ -563,7 +563,7 @@ SUBROUTINE invert_Hotelling(matrix_inverse, matrix, threshold, use_inv_as_guess, ENDIF ! 2.0 would be the correct scaling however, we should make sure here, that we are in the convergence radius - scalingf = 1.9_dp/(max_eV+min_eV) + scalingf = 1.9_dp/(max_eV + min_eV) CALL dbcsr_scale(tmp1, scalingf) CALL dbcsr_scale(matrix_inverse, scalingf) min_ev = min_ev*scalingf @@ -594,14 +594,14 @@ SUBROUTINE invert_Hotelling(matrix_inverse, matrix, threshold, use_inv_as_guess, ! use the scalar form of the algorithm to trace the EV IF (accelerator_type == 1) THEN - min_ev = min_ev*(2.0_dp-min_ev) - IF (PRESENT(norm_convergence)) maxnorm_matrix = ABS(min_eV-1.0_dp) + min_ev = min_ev*(2.0_dp - min_ev) + IF (PRESENT(norm_convergence)) maxnorm_matrix = ABS(min_eV - 1.0_dp) ENDIF IF (unit_nr > 0) THEN WRITE (unit_nr, '(T6,A,1X,I3,1X,F10.8,E12.3,F12.3,F13.3)') "Hotelling iter", i, occ_matrix, & - maxnorm_matrix, t2-t1, & - (flop1+flop2)/(1.0E6_dp*MAX(0.001_dp, t2-t1)) + maxnorm_matrix, t2 - t1, & + (flop1 + flop2)/(1.0E6_dp*MAX(0.001_dp, t2 - t1)) CALL m_flush(unit_nr) ENDIF @@ -612,8 +612,8 @@ SUBROUTINE invert_Hotelling(matrix_inverse, matrix, threshold, use_inv_as_guess, ! scale the matrix for improved convergence IF (accelerator_type == 1) THEN - min_ev = min_ev*2.0_dp/(min_ev+1.0_dp) - CALL dbcsr_scale(matrix_inverse, 2.0_dp/(min_ev+1.0_dp)) + min_ev = min_ev*2.0_dp/(min_ev + 1.0_dp) + CALL dbcsr_scale(matrix_inverse, 2.0_dp/(min_ev + 1.0_dp)) ENDIF t1 = m_walltime() @@ -718,7 +718,7 @@ SUBROUTINE matrix_sign_Newton_Schulz(matrix_sign, matrix, threshold, sign_order) ! tmp1 = X * X CALL dbcsr_multiply("N", "N", -1.0_dp, matrix_sign, matrix_sign, 0.0_dp, tmp1, & filter_eps=threshold, flop=flops) - floptot = floptot+flops + floptot = floptot + flops ! check convergence (frob norm of what should be the identity matrix minus identity matrix) frob_matrix_base = dbcsr_frobenius_norm(tmp1) @@ -771,7 +771,7 @@ SUBROUTINE matrix_sign_Newton_Schulz(matrix_sign, matrix, threshold, sign_order) ! tmp2=y^2 CALL dbcsr_multiply("N", "N", 1.0_dp, tmp2, tmp2, 1.0_dp, tmp1, & filter_eps=threshold, flop=flops) - floptot = floptot+flops + floptot = floptot + flops prefactor = 3.0_dp/8.0_dp ELSE IF (order .EQ. 4) THEN @@ -784,13 +784,13 @@ SUBROUTINE matrix_sign_Newton_Schulz(matrix_sign, matrix, threshold, sign_order) ! CALL dbcsr_multiply("N", "N", 1.0_dp, tmp3, tmp3, 0.0_dp, tmp2, & filter_eps=threshold, flop=flops) - floptot = floptot+flops + floptot = floptot + flops CALL dbcsr_add(tmp1, tmp2, 1.0_dp, 6.0_dp/5.0_dp) CALL dbcsr_multiply("N", "N", 1.0_dp, tmp2, tmp3, 1.0_dp, tmp1, & filter_eps=threshold, flop=flops) - floptot = floptot+flops + floptot = floptot + flops prefactor = 5.0_dp/16.0_dp ELSE IF (order .EQ. -5) THEN @@ -803,19 +803,19 @@ SUBROUTINE matrix_sign_Newton_Schulz(matrix_sign, matrix, threshold, sign_order) ! CALL dbcsr_multiply("N", "N", 1.0_dp, tmp3, tmp3, 0.0_dp, tmp2, & filter_eps=threshold, flop=flops) - floptot = floptot+flops + floptot = floptot + flops CALL dbcsr_add(tmp1, tmp2, 1.0_dp, 48.0_dp/35.0_dp) CALL dbcsr_multiply("N", "N", 1.0_dp, tmp2, tmp3, 0.0_dp, tmp2, & filter_eps=threshold, flop=flops) - floptot = floptot+flops + floptot = floptot + flops CALL dbcsr_add(tmp1, tmp2, 1.0_dp, 8.0_dp/7.0_dp) CALL dbcsr_multiply("N", "N", 1.0_dp, tmp2, tmp3, 1.0_dp, tmp1, & filter_eps=threshold, flop=flops) - floptot = floptot+flops + floptot = floptot + flops prefactor = 35.0_dp/128.0_dp ELSE IF (order .EQ. 5) THEN @@ -838,14 +838,14 @@ SUBROUTINE matrix_sign_Newton_Schulz(matrix_sign, matrix, threshold, sign_order) CALL dbcsr_add_on_diag(tmp3, a0) CALL dbcsr_multiply("N", "N", 1.0_dp, tmp3, tmp1, 0.0_dp, tmp3, & filter_eps=threshold, flop=flops) - floptot = floptot+flops + floptot = floptot + flops CALL dbcsr_add_on_diag(tmp3, a1) CALL dbcsr_add_on_diag(tmp1, a2) CALL dbcsr_add(tmp1, tmp3, 1.0_dp, 1.0_dp) CALL dbcsr_multiply("N", "N", 1.0_dp, tmp1, tmp3, 0.0_dp, tmp1, & filter_eps=threshold, flop=flops) - floptot = floptot+flops + floptot = floptot + flops CALL dbcsr_add_on_diag(tmp1, a3) prefactor = 35.0_dp/128.0_dp @@ -860,25 +860,25 @@ SUBROUTINE matrix_sign_Newton_Schulz(matrix_sign, matrix, threshold, sign_order) ! CALL dbcsr_multiply("N", "N", 1.0_dp, tmp3, tmp3, 0.0_dp, tmp2, & filter_eps=threshold, flop=flops) - floptot = floptot+flops + floptot = floptot + flops CALL dbcsr_add(tmp1, tmp2, 1.0_dp, 32.0_dp/21.0_dp) CALL dbcsr_multiply("N", "N", 1.0_dp, tmp2, tmp3, 0.0_dp, tmp2, & filter_eps=threshold, flop=flops) - floptot = floptot+flops + floptot = floptot + flops CALL dbcsr_add(tmp1, tmp2, 1.0_dp, 80.0_dp/63.0_dp) CALL dbcsr_multiply("N", "N", 1.0_dp, tmp2, tmp3, 0.0_dp, tmp2, & filter_eps=threshold, flop=flops) - floptot = floptot+flops + floptot = floptot + flops CALL dbcsr_add(tmp1, tmp2, 1.0_dp, 10.0_dp/9.0_dp) CALL dbcsr_multiply("N", "N", 1.0_dp, tmp2, tmp3, 1.0_dp, tmp1, & filter_eps=threshold, flop=flops) - floptot = floptot+flops + floptot = floptot + flops prefactor = 63.0_dp/256.0_dp ELSE IF (order .EQ. 7) THEN @@ -901,7 +901,7 @@ SUBROUTINE matrix_sign_Newton_Schulz(matrix_sign, matrix, threshold, sign_order) CALL dbcsr_add_on_diag(tmp3, a0) CALL dbcsr_multiply("N", "N", 1.0_dp, tmp3, tmp1, 0.0_dp, tmp3, & filter_eps=threshold, flop=flops) - floptot = floptot+flops + floptot = floptot + flops CALL dbcsr_add_on_diag(tmp3, a1) ! tmp4=w @@ -909,14 +909,14 @@ SUBROUTINE matrix_sign_Newton_Schulz(matrix_sign, matrix, threshold, sign_order) CALL dbcsr_add_on_diag(tmp4, a2) CALL dbcsr_multiply("N", "N", 1.0_dp, tmp4, tmp3, 0.0_dp, tmp4, & filter_eps=threshold, flop=flops) - floptot = floptot+flops + floptot = floptot + flops CALL dbcsr_add_on_diag(tmp4, a3) CALL dbcsr_add(tmp3, tmp4, 1.0_dp, 1.0_dp) CALL dbcsr_add_on_diag(tmp3, a4) CALL dbcsr_multiply("N", "N", 1.0_dp, tmp3, tmp4, 0.0_dp, tmp1, & filter_eps=threshold, flop=flops) - floptot = floptot+flops + floptot = floptot + flops CALL dbcsr_add_on_diag(tmp1, a5) prefactor = 231.0_dp/1024.0_dp @@ -927,7 +927,7 @@ SUBROUTINE matrix_sign_Newton_Schulz(matrix_sign, matrix, threshold, sign_order) ! tmp2 = X * prefactor * CALL dbcsr_multiply("N", "N", prefactor, matrix_sign, tmp1, 0.0_dp, tmp2, & filter_eps=threshold, flop=flops) - floptot = floptot+flops + floptot = floptot + flops ! done iterating ! CALL dbcsr_filter(tmp2,threshold) @@ -938,8 +938,8 @@ SUBROUTINE matrix_sign_Newton_Schulz(matrix_sign, matrix, threshold, sign_order) IF (unit_nr > 0) THEN WRITE (unit_nr, '(T6,A,1X,I3,1X,F10.8,E12.3,F12.3,F13.3)') "NS sign iter ", i, occ_matrix, & - frob_matrix/frob_matrix_base, t2-t1, & - floptot/(1.0E6_dp*MAX(0.001_dp, t2-t1)) + frob_matrix/frob_matrix_base, t2 - t1, & + floptot/(1.0E6_dp*MAX(0.001_dp, t2 - t1)) CALL m_flush(unit_nr) ENDIF @@ -1155,7 +1155,7 @@ SUBROUTINE matrix_sqrt_Newton_Schulz(matrix_sqrt, matrix_sqrt_inv, matrix, thres ENDIF ! conservatively assume we get a relatively large error (100*threshold_lanczos) in the estimates ! and adjust the scaling to be on the safe side - scaling = 2.0_dp/(max_ev+min_ev+100*eps_lanczos) + scaling = 2.0_dp/(max_ev + min_ev + 100*eps_lanczos) ENDIF @@ -1216,10 +1216,10 @@ SUBROUTINE matrix_sqrt_Newton_Schulz(matrix_sqrt, matrix_sqrt_inv, matrix, thres ob = 48.0_dp/35.0_dp oc = -64.0_dp/35.0_dp od = 128.0_dp/35.0_dp - a = (oa-1)/2 - b = ob*(a+1)-oc-a*(a+1)**2 - c = ob-b-a*(a+1) - d = od-b*c + a = (oa - 1)/2 + b = ob*(a + 1) - oc - a*(a + 1)**2 + c = ob - b - a*(a + 1) + d = od - b*c ! tmp2 = tmp1 ** 2 + a * tmp1 CALL dbcsr_multiply("N", "N", 1.0_dp, tmp1, tmp1, 0.0_dp, tmp2, & filter_eps=threshold, flop=flop4) @@ -1262,8 +1262,8 @@ SUBROUTINE matrix_sqrt_Newton_Schulz(matrix_sqrt, matrix_sqrt_inv, matrix, thres IF (unit_nr > 0) THEN WRITE (unit_nr, '(T6,A,1X,I3,1X,F10.8,E12.3,F12.3,F13.3)') "NS sqrt iter ", i, occ_matrix, & - conv, t2-t1, & - (flop1+flop2+flop3+flop4+flop5)/(1.0E6_dp*MAX(0.001_dp, t2-t1)) + conv, t2 - t1, & + (flop1 + flop2 + flop3 + flop4 + flop5)/(1.0E6_dp*MAX(0.001_dp, t2 - t1)) CALL m_flush(unit_nr) ENDIF @@ -1393,7 +1393,7 @@ SUBROUTINE matrix_sqrt_proot(matrix_sqrt, matrix_sqrt_inv, matrix, threshold, or ENDIF ! conservatively assume we get a relatively large error (100*threshold_lanczos) in the estimates ! and adjust the scaling to be on the safe side - scaling = 2.0_dp/(max_ev+min_ev+100*eps_lanczos) + scaling = 2.0_dp/(max_ev + min_ev + 100*eps_lanczos) CALL dbcsr_scale(matrixS, scaling) CALL dbcsr_filter(matrixS, threshold) ELSE @@ -1434,7 +1434,7 @@ SUBROUTINE matrix_sqrt_proot(matrix_sqrt, matrix_sqrt_inv, matrix, threshold, or f = 0 CALL dbcsr_multiply("N", "N", 1.0_dp, tmp2, Rmat, 0.0_dp, tmp2, & filter_eps=threshold, flop=f) - flop3 = flop3+f + flop3 = flop3 + f ENDIF CALL dbcsr_add(tmp1, tmp2, 1.0_dp, 1.0_dp) ENDDO @@ -1456,13 +1456,13 @@ SUBROUTINE matrix_sqrt_proot(matrix_sqrt, matrix_sqrt_inv, matrix, threshold, or flop3 = 0 DO j = 1, order !choose=factorial(order)/(factorial(j)*factorial(order-j)) - choose = PRODUCT((/(ii, ii=1, order)/))/(PRODUCT((/(ii, ii=1, j)/))*PRODUCT((/(ii, ii=1, order-j)/))) + choose = PRODUCT((/(ii, ii=1, order)/))/(PRODUCT((/(ii, ii=1, j)/))*PRODUCT((/(ii, ii=1, order - j)/))) CALL dbcsr_add(tmp1, tmp2, 1.0_dp, -1.0_dp*(-1)**j*choose) IF (j .LT. order) THEN f = 0 CALL dbcsr_multiply("N", "N", 1.0_dp, tmp2, BK2A, 0.0_dp, tmp2, & filter_eps=threshold, flop=f) - flop3 = flop3+f + flop3 = flop3 + f ENDIF ENDDO CALL dbcsr_release(BK2A) @@ -1480,8 +1480,8 @@ SUBROUTINE matrix_sqrt_proot(matrix_sqrt, matrix_sqrt_inv, matrix, threshold, or IF (unit_nr > 0) THEN WRITE (unit_nr, '(T6,A,1X,I3,1X,F10.8,E12.3,F12.3,F13.3)') "PROOT sqrt iter ", i, occ_matrix, & - conv, t2-t1, & - (flop1+flop2+flop3+flop4+flop5)/(1.0E6_dp*MAX(0.001_dp, t2-t1)) + conv, t2 - t1, & + (flop1 + flop2 + flop3 + flop4 + flop5)/(1.0E6_dp*MAX(0.001_dp, t2 - t1)) CALL m_flush(unit_nr) ENDIF @@ -1591,7 +1591,7 @@ SUBROUTINE matrix_exponential(matrix_exp, matrix, omega, alpha, threshold) k = 1 DO IF ((norm_scalar/2.0_dp**k) <= one) EXIT - k = k+1 + k = k + 1 END DO ! copy and scale the input matrix in matrix C and in matrix D @@ -1620,7 +1620,7 @@ SUBROUTINE matrix_exponential(matrix_exp, matrix, omega, alpha, threshold) CALL dbcsr_create(D_product, template=matrix, matrix_type=dbcsr_type_no_symmetry) i = 1 DO - i = i+1 + i = i + 1 ! compute D_product=D*C CALL dbcsr_multiply("N", "N", one, D, C, & zero, D_product, filter_eps=threshold) diff --git a/src/kg_correction.F b/src/kg_correction.F index 3b7f5ef956..e2cef00145 100644 --- a/src/kg_correction.F +++ b/src/kg_correction.F @@ -182,7 +182,7 @@ SUBROUTINE kg_ekin_embed(qs_env, kg_env, ks_matrix, ekin_mol, calc_force) DEALLOCATE (vxc_rho) ekin_mol = -ekin_imol xcvirial(1:3, 1:3) = 0.0_dp - IF (use_virial) xcvirial(1:3, 1:3) = xcvirial(1:3, 1:3)-virial%pv_xc(1:3, 1:3) + IF (use_virial) xcvirial(1:3, 1:3) = xcvirial(1:3, 1:3) - virial%pv_xc(1:3, 1:3) ! loop over all subsets DO isub = 1, kg_env%nsubsets @@ -194,7 +194,7 @@ SUBROUTINE kg_ekin_embed(qs_env, kg_env, ks_matrix, ekin_mol, calc_force) ! calc Hohenberg-Kohn kin. energy of the density corresp. to the remaining molecular block(s) CALL qs_vxc_create(ks_env=ks_env, rho_struct=rho_struct, xc_section=kg_env%xc_section_kg, & vxc_rho=vxc_rho, vxc_tau=vxc_tau, exc=ekin_imol) - ekin_mol = ekin_mol+ekin_imol + ekin_mol = ekin_mol + ekin_imol DO ispin = 1, nspins vxc_rho(ispin)%pw%cr3d = -vxc_rho(ispin)%pw%cr3d*vxc_rho(ispin)%pw%pw_grid%dvol @@ -210,7 +210,7 @@ SUBROUTINE kg_ekin_embed(qs_env, kg_env, ks_matrix, ekin_mol, calc_force) DEALLOCATE (vxc_rho) IF (use_virial) THEN - xcvirial(1:3, 1:3) = xcvirial(1:3, 1:3)+virial%pv_xc(1:3, 1:3) + xcvirial(1:3, 1:3) = xcvirial(1:3, 1:3) + virial%pv_xc(1:3, 1:3) END IF END DO @@ -330,7 +330,7 @@ SUBROUTINE kg_ekin_embed_lri(qs_env, kg_env, ks_matrix, ekin_mol, calc_force) DEALLOCATE (vxc_rho) ekin_mol = -ekin_imol xcvirial(1:3, 1:3) = 0.0_dp - IF (use_virial) xcvirial(1:3, 1:3) = xcvirial(1:3, 1:3)-virial%pv_xc(1:3, 1:3) + IF (use_virial) xcvirial(1:3, 1:3) = xcvirial(1:3, 1:3) - virial%pv_xc(1:3, 1:3) ! loop over all subsets DO isub = 1, kg_env%nsubsets @@ -346,7 +346,7 @@ SUBROUTINE kg_ekin_embed_lri(qs_env, kg_env, ks_matrix, ekin_mol, calc_force) ! calc Hohenberg-Kohn kin. energy of the density corresp. to the remaining molecular block(s) CALL qs_vxc_create(ks_env=ks_env, rho_struct=rho_struct, xc_section=kg_env%xc_section_kg, & vxc_rho=vxc_rho, vxc_tau=vxc_tau, exc=ekin_imol) - ekin_mol = ekin_mol+ekin_imol + ekin_mol = ekin_mol + ekin_imol DO ispin = 1, nspins vxc_rho(ispin)%pw%cr3d = -vxc_rho(ispin)%pw%cr3d*vxc_rho(ispin)%pw%pw_grid%dvol @@ -360,7 +360,7 @@ SUBROUTINE kg_ekin_embed_lri(qs_env, kg_env, ks_matrix, ekin_mol, calc_force) DEALLOCATE (vxc_rho) IF (use_virial) THEN - xcvirial(1:3, 1:3) = xcvirial(1:3, 1:3)+virial%pv_xc(1:3, 1:3) + xcvirial(1:3, 1:3) = xcvirial(1:3, 1:3) + virial%pv_xc(1:3, 1:3) END IF END DO @@ -485,7 +485,7 @@ SUBROUTINE kg_ekin_ri_embed(qs_env, kg_env, ks_matrix, ekin_mol, calc_force) DEALLOCATE (vxc_rho) ekin_mol = -ekin_imol xcvirial(1:3, 1:3) = 0.0_dp - IF (use_virial) xcvirial(1:3, 1:3) = xcvirial(1:3, 1:3)-virial%pv_xc(1:3, 1:3) + IF (use_virial) xcvirial(1:3, 1:3) = xcvirial(1:3, 1:3) - virial%pv_xc(1:3, 1:3) !deb ! WRITE(6,*) " E KIN (full) ",-ekin_mol !deb @@ -506,7 +506,7 @@ SUBROUTINE kg_ekin_ri_embed(qs_env, kg_env, ks_matrix, ekin_mol, calc_force) NULLIFY (vxc_rho, vxc_tau) CALL qs_vxc_create(ks_env=ks_env, rho_struct=rho_struct, xc_section=kg_env%xc_section_kg, & vxc_rho=vxc_rho, vxc_tau=vxc_tau, exc=ekin_imol) - ekin_mol = ekin_mol+ekin_imol + ekin_mol = ekin_mol + ekin_imol !deb ! WRITE(6,*) " E KIN (molecule) ",isub,ekin_imol !deb @@ -523,7 +523,7 @@ SUBROUTINE kg_ekin_ri_embed(qs_env, kg_env, ks_matrix, ekin_mol, calc_force) DEALLOCATE (vxc_rho) IF (use_virial) THEN - xcvirial(1:3, 1:3) = xcvirial(1:3, 1:3)+virial%pv_xc(1:3, 1:3) + xcvirial(1:3, 1:3) = xcvirial(1:3, 1:3) + virial%pv_xc(1:3, 1:3) END IF END DO diff --git a/src/kg_energy_corrections.F b/src/kg_energy_corrections.F index 4102e0aa97..c35943313e 100644 --- a/src/kg_energy_corrections.F +++ b/src/kg_energy_corrections.F @@ -424,9 +424,9 @@ SUBROUTINE ec_build_ks_matrix(qs_env, ec_env) END IF ! calclulate Int(vhxc*rho)dr and Int(vtau*tau)dr - evhxc = evhxc+pw_integral_ab(rho_r(ispin)%pw, v_rspace(ispin)%pw)/v_rspace(1)%pw%pw_grid%dvol + evhxc = evhxc + pw_integral_ab(rho_r(ispin)%pw, v_rspace(ispin)%pw)/v_rspace(1)%pw%pw_grid%dvol IF (ASSOCIATED(v_tau_rspace)) THEN - evhxc = evhxc+pw_integral_ab(tau_r(ispin)%pw, v_tau_rspace(ispin)%pw)/v_tau_rspace(ispin)%pw%pw_grid%dvol + evhxc = evhxc + pw_integral_ab(tau_r(ispin)%pw, v_tau_rspace(ispin)%pw)/v_tau_rspace(ispin)%pw%pw_grid%dvol END IF END DO @@ -444,7 +444,7 @@ SUBROUTINE ec_build_ks_matrix(qs_env, ec_env) CALL calculate_ecore_self(qs_env, E_self_core=eself) CALL calculate_ecore_overlap(qs_env, para_env, calculate_forces=.FALSE., E_overlap_core=eovrl) ec_env%exc = eexc - ec_env%ehartree = ehartree+eovrl+eself + ec_env%ehartree = ehartree + eovrl + eself ec_env%vhxc = evhxc ! add the core matrix @@ -775,7 +775,7 @@ SUBROUTINE ec_energy(qs_env, ec_env, unit_nr) ! dispersion through pairpotentials CALL calculate_dispersion_pairpot(qs_env, ec_env%dispersion_env, energy, .FALSE.) - ec_env%edispersion = ec_env%edispersion+energy + ec_env%edispersion = ec_env%edispersion + energy !deb ! gCP pairpotentials !deb CALL calculate_gcp_pairpot(qs_env, ec_env%gcp_env, energy, .FALSE.) !deb ec_env%edispersion = ec_env%edispersion+energy @@ -792,10 +792,10 @@ SUBROUTINE ec_energy(qs_env, ec_env, unit_nr) IF (unit_nr > 0) WRITE (unit_nr, '(T2,A,T16,F16.10)') 'Tr[PS] ', trace !dbg CALL dbcsr_dot(ec_env%matrix_ks(ispin, 1)%matrix, ec_env%matrix_p(ispin, 1)%matrix, trace) - eband = eband+trace + eband = eband + trace END DO ec_env%eband = eband - ec_env%etotal = ec_env%eband+ec_env%ehartree+ec_env%exc-ec_env%vhxc+ec_env%edispersion + ec_env%etotal = ec_env%eband + ec_env%ehartree + ec_env%exc - ec_env%vhxc + ec_env%edispersion IF (unit_nr > 0) THEN WRITE (unit_nr, '(T2,A,T16,F16.10)') "HF Etotal ", ec_env%etotal WRITE (unit_nr, '(T2,A,T16,F16.10)') "Eband ", ec_env%eband diff --git a/src/kg_environment.F b/src/kg_environment.F index daf74ccbf2..b33039c46b 100644 --- a/src/kg_environment.F +++ b/src/kg_environment.F @@ -354,13 +354,13 @@ SUBROUTINE init_kg_env(qs_env, kg_env, qs_kind_set, input) CALL allocate_intgrid(kg_env%int_grid_molecules) ig_mol => kg_env%int_grid_molecules nbatch = (natom*kg_env%int_grid_atom%nbatch)/np - nbatch = NINT((nbatch+1)*1.2_dp) + nbatch = NINT((nbatch + 1)*1.2_dp) ALLOCATE (bid(2, nbatch)) nbatch = 0 DO iatom = 1, natom DO ib = 1, kg_env%int_grid_atom%nbatch - IF (para_env%mepos == MOD(iatom+ib, np)) THEN - nbatch = nbatch+1 + IF (para_env%mepos == MOD(iatom + ib, np)) THEN + nbatch = nbatch + 1 CPASSERT(nbatch <= SIZE(bid, 2)) bid(1, nbatch) = iatom bid(2, nbatch) = ib @@ -581,7 +581,7 @@ SUBROUTINE kg_remove_duplicates(pairs_buffer, n) IF (n > 0) THEN ! represent a pair of int_4 as a single int_8 number, simplifies sorting. sort_keys(1:n) = ISHFT(INT(pairs_buffer(1, 1:n), KIND=int_8), 8*int_4_size) - sort_keys(1:n) = sort_keys(1:n)+pairs_buffer(2, 1:n) !upper + lower bytes + sort_keys(1:n) = sort_keys(1:n) + pairs_buffer(2, 1:n) !upper + lower bytes CALL sort(sort_keys, n, ind) ! add first pair, the case npairs==0 was excluded above @@ -590,8 +590,8 @@ SUBROUTINE kg_remove_duplicates(pairs_buffer, n) ! remove duplicates from the sorted list DO i = 2, n - IF (sort_keys(i) /= sort_keys(i-1)) THEN - npairs = npairs+1 + IF (sort_keys(i) /= sort_keys(i - 1)) THEN + npairs = npairs + 1 work(:, npairs) = pairs_buffer(:, ind(i)) END IF END DO @@ -713,7 +713,7 @@ SUBROUTINE kg_build_subsets(kg_env, para_env) !IF (imol graph(kmol)%vertex END DO @@ -181,7 +181,7 @@ SUBROUTINE color_graph_greedy(graph, maxdegree, ncolors) nnodes = SIZE(graph) - ALLOCATE (color_present(maxdegree+1)) + ALLOCATE (color_present(maxdegree + 1)) DO i = 1, nnodes color_present(:) = .FALSE. @@ -192,7 +192,7 @@ SUBROUTINE color_graph_greedy(graph, maxdegree, ncolors) IF (color .NE. 0) color_present(color) = .TRUE. END DO END IF - DO j = 1, maxdegree+1 !nnodes + DO j = 1, maxdegree + 1 !nnodes IF (color_present(j) .EQV. .FALSE.) THEN newcolor = j EXIT @@ -237,13 +237,13 @@ SUBROUTINE print_subsets(graph, ncolors, unit_nr) counter = 0 DO j = 1, nnodes IF (graph(j)%vertex%color .EQ. i) THEN - counter = counter+1 + counter = counter + 1 IF (MOD(counter, 13) .EQ. 0) THEN - counter = counter+1 + counter = counter + 1 WRITE (unit_nr, '()') ! line break WRITE (unit_nr, '(6X,A)', ADVANCE='NO') " |" ! indent next line END IF - WRITE (unit_nr, '(I5,1X)', ADVANCE='NO') graph(j)%vertex%id-1 + WRITE (unit_nr, '(I5,1X)', ADVANCE='NO') graph(j)%vertex%id - 1 END IF END DO WRITE (unit_nr, '()') @@ -270,7 +270,7 @@ ELEMENTAL FUNCTION kg_get_value(dsat, degree) RESULT(value) ! INTEGER, PARAMETER :: huge_4 = HUGE(0_int_4) ! PR67219 workaround ! we actually need a max_heap - value = (huge_4-INT(dsat, KIND=int_8))*huge_4+huge_4-degree + value = (huge_4 - INT(dsat, KIND=int_8))*huge_4 + huge_4 - degree END FUNCTION @@ -397,7 +397,7 @@ SUBROUTINE kg_dsatur(kg_env, graph, ncolors) this%color = 1 CYCLE END IF - DO i = 1, this%degree+1 + DO i = 1, this%degree + 1 IF (this%color_present(i) .EQV. .FALSE.) THEN this%color = i ! smallest possible EXIT @@ -410,7 +410,7 @@ SUBROUTINE kg_dsatur(kg_env, graph, ncolors) neighbor => this%neighbors(i)%vertex IF (neighbor%color_present(this%color)) CYCLE neighbor%color_present(this%color) = .TRUE. - neighbor%dsat = neighbor%dsat+1 + neighbor%dsat = neighbor%dsat + 1 IF (neighbor%color /= 0) CYCLE CALL kg_update_node(heap, neighbor) @@ -426,7 +426,7 @@ SUBROUTINE kg_dsatur(kg_env, graph, ncolors) DO j = 1, color_limit graph(i)%vertex%color_present(j) = color_present(j) END DO - DO j = color_limit+1, 2*color_limit + DO j = color_limit + 1, 2*color_limit graph(i)%vertex%color_present(j) = .FALSE. END DO END DO @@ -468,7 +468,7 @@ SUBROUTINE kg_check_switch(this, neighbor, low_col, switchable, ncolors, color_p INTEGER :: i switchable = .TRUE. - low_col = ncolors+1 + low_col = ncolors + 1 DO i = 1, this%degree IF (this%neighbors(i)%vertex%id == neighbor%id) CYCLE @@ -532,10 +532,10 @@ SUBROUTINE kg_pair_switching(graph, ncolors) DO i = 1, nnodes this => graph(i)%vertex IF (.NOT. ASSOCIATED(this%neighbors)) CYCLE - IF (graph(i)%vertex%color < ncolors-depth+1) CYCLE !Node already has a low color + IF (graph(i)%vertex%color < ncolors - depth + 1) CYCLE !Node already has a low color partner = 0 - low_col = this%color+1 + low_col = this%color + 1 DO j = 1, this%degree neighbor => this%neighbors(j)%vertex diff --git a/src/kpoint_coulomb_2c.F b/src/kpoint_coulomb_2c.F index 7996bb73c0..62eaad1697 100644 --- a/src/kpoint_coulomb_2c.F +++ b/src/kpoint_coulomb_2c.F @@ -144,17 +144,17 @@ SUBROUTINE lattice_sum(matrix_v_kp, kpoints, basis_type, cell, particle_set, & CALL get_cell(cell=cell, h=hmat, periodic=periodic) IF (MODULO(nkp_grid(1), 2) == 1) THEN - factor = 3**(size_lattice_sum-1) + factor = 3**(size_lattice_sum - 1) ELSE IF (MODULO(nkp_grid(1), 2) == 0) THEN - factor = 2**(size_lattice_sum-1) + factor = 2**(size_lattice_sum - 1) END IF IF (MODULO(nkp_grid(1), 2) == 1) THEN - x_min = -(factor*nkp_grid(1)-1)/2 - x_max = (factor*nkp_grid(1)-1)/2 + x_min = -(factor*nkp_grid(1) - 1)/2 + x_max = (factor*nkp_grid(1) - 1)/2 ELSE IF (MODULO(nkp_grid(1), 2) == 0) THEN x_min = -factor*nkp_grid(1)/2 - x_max = factor*nkp_grid(1)/2-1 + x_max = factor*nkp_grid(1)/2 - 1 END IF IF (periodic(1) == 0) THEN x_min = 0 @@ -162,11 +162,11 @@ SUBROUTINE lattice_sum(matrix_v_kp, kpoints, basis_type, cell, particle_set, & END IF IF (MODULO(nkp_grid(2), 2) == 1) THEN - y_min = -(factor*nkp_grid(2)-1)/2 - y_max = (factor*nkp_grid(2)-1)/2 + y_min = -(factor*nkp_grid(2) - 1)/2 + y_max = (factor*nkp_grid(2) - 1)/2 ELSE IF (MODULO(nkp_grid(2), 2) == 0) THEN y_min = -factor*nkp_grid(2)/2 - y_max = factor*nkp_grid(2)/2-1 + y_max = factor*nkp_grid(2)/2 - 1 END IF IF (periodic(2) == 0) THEN y_min = 0 @@ -174,11 +174,11 @@ SUBROUTINE lattice_sum(matrix_v_kp, kpoints, basis_type, cell, particle_set, & END IF IF (MODULO(nkp_grid(3), 2) == 1) THEN - z_min = -(factor*nkp_grid(3)-1)/2 - z_max = (factor*nkp_grid(3)-1)/2 + z_min = -(factor*nkp_grid(3) - 1)/2 + z_max = (factor*nkp_grid(3) - 1)/2 ELSE IF (MODULO(nkp_grid(3), 2) == 0) THEN z_min = -factor*nkp_grid(3)/2 - z_max = factor*nkp_grid(3)/2-1 + z_max = factor*nkp_grid(3)/2 - 1 END IF IF (periodic(3) == 0) THEN z_min = 0 @@ -189,17 +189,17 @@ SUBROUTINE lattice_sum(matrix_v_kp, kpoints, basis_type, cell, particle_set, & CALL allocate_blocks_of_v_L(blocks_of_v_L, matrix_v_L_tmp) CALL allocate_blocks_of_v_L(blocks_of_v_L_store, matrix_v_L_tmp) - DO i_x_inner = 0, 2*nkp_grid(1)-1 - DO j_y_inner = 0, 2*nkp_grid(2)-1 - DO k_z_inner = 0, 2*nkp_grid(3)-1 + DO i_x_inner = 0, 2*nkp_grid(1) - 1 + DO j_y_inner = 0, 2*nkp_grid(2) - 1 + DO k_z_inner = 0, 2*nkp_grid(3) - 1 - DO i_x_outer = x_min, x_max+nkp_grid(1), 2*nkp_grid(1) - DO j_y_outer = y_min, y_max+nkp_grid(2), 2*nkp_grid(2) - DO k_z_outer = z_min, z_max+nkp_grid(3), 2*nkp_grid(3) + DO i_x_outer = x_min, x_max + nkp_grid(1), 2*nkp_grid(1) + DO j_y_outer = y_min, y_max + nkp_grid(2), 2*nkp_grid(2) + DO k_z_outer = z_min, z_max + nkp_grid(3), 2*nkp_grid(3) - i_x = i_x_inner+i_x_outer - j_y = j_y_inner+j_y_outer - k_z = k_z_inner+k_z_outer + i_x = i_x_inner + i_x_outer + j_y = j_y_inner + j_y_outer + k_z = k_z_inner + k_z_outer IF (i_x > x_max .OR. i_x < x_min .OR. & j_y > y_max .OR. j_y < y_min .OR. & @@ -216,7 +216,7 @@ SUBROUTINE lattice_sum(matrix_v_kp, kpoints, basis_type, cell, particle_set, & DO i_block = 1, SIZE(blocks_of_v_L) blocks_of_v_L_store(i_block)%block(:, :) = blocks_of_v_L_store(i_block)%block(:, :) & - +blocks_of_v_L(i_block)%block(:, :) + + blocks_of_v_L(i_block)%block(:, :) END DO END DO @@ -233,9 +233,9 @@ SUBROUTINE lattice_sum(matrix_v_kp, kpoints, basis_type, cell, particle_set, & DO i_block = 1, SIZE(blocks_of_v_L) blocks_of_v_kp(ik, 1, i_block)%block(:, :) = blocks_of_v_kp(ik, 1, i_block)%block(:, :) & - +coskl*blocks_of_v_L_store(i_block)%block(:, :) + + coskl*blocks_of_v_L_store(i_block)%block(:, :) blocks_of_v_kp(ik, 2, i_block)%block(:, :) = blocks_of_v_kp(ik, 2, i_block)%block(:, :) & - +sinkl*blocks_of_v_L_store(i_block)%block(:, :) + + sinkl*blocks_of_v_L_store(i_block)%block(:, :) END DO @@ -295,7 +295,7 @@ SUBROUTINE set_blocks_to_matrix_v_kp(matrix_v_kp, blocks_of_v_kp) data_block(:, :) = blocks_of_v_kp(ik, i_real_im, i_block)%block(:, :) - i_block = i_block+1 + i_block = i_block + 1 END DO @@ -377,7 +377,7 @@ SUBROUTINE compute_v_transl(matrix_v_L_tmp, blocks_of_v_L, vec_L, particle_set, ra(1:3) = pbc(particle_set(row)%r(1:3), cell) rb(1:3) = pbc(particle_set(col)%r(1:3), cell) - rab_L(1:3) = rb(1:3)-ra(1:3)+vec_L(1:3) + rab_L(1:3) = rb(1:3) - ra(1:3) + vec_L(1:3) CALL contraction_matrix_shg(basis_set_a, contr_a) CALL contraction_matrix_shg(basis_set_b, contr_b) @@ -388,7 +388,7 @@ SUBROUTINE compute_v_transl(matrix_v_L_tmp, blocks_of_v_L, vec_L, particle_set, basis_set_a, basis_set_b, contr_a, contr_b, omega=cutoff, & calculate_forces=.FALSE.) - i_block = i_block+1 + i_block = i_block + 1 DEALLOCATE (contr_a, contr_b) @@ -481,7 +481,7 @@ SUBROUTINE allocate_blocks_of_v_L(blocks_of_v_L, matrix_v_L_tmp) CALL dbcsr_iterator_next_block(iter, row, col, data_block) - nblocks = nblocks+1 + nblocks = nblocks + 1 END DO @@ -500,7 +500,7 @@ SUBROUTINE allocate_blocks_of_v_L(blocks_of_v_L, matrix_v_L_tmp) ALLOCATE (blocks_of_v_L(i_block)%block(SIZE(data_block, 1), SIZE(data_block, 2))) blocks_of_v_L(i_block)%block = 0.0_dp - i_block = i_block+1 + i_block = i_block + 1 END DO @@ -538,7 +538,7 @@ SUBROUTINE allocate_blocks_of_v_kp(blocks_of_v_kp, matrix_v_kp) CALL dbcsr_iterator_next_block(iter, row, col, data_block) - nblocks = nblocks+1 + nblocks = nblocks + 1 END DO @@ -561,7 +561,7 @@ SUBROUTINE allocate_blocks_of_v_kp(blocks_of_v_kp, matrix_v_kp) ALLOCATE (blocks_of_v_kp(ik, i_real_img, i_block)%block(SIZE(data_block, 1), SIZE(data_block, 2))) blocks_of_v_kp(ik, i_real_img, i_block)%block = 0.0_dp - i_block = i_block+1 + i_block = i_block + 1 END DO diff --git a/src/kpoint_io.F b/src/kpoint_io.F index d8151139a6..6ee568f25a 100644 --- a/src/kpoint_io.F +++ b/src/kpoint_io.F @@ -224,7 +224,7 @@ SUBROUTINE write_kpoints_file_header(qs_kind_set, particle_set, ires) ELSEIF (ASSOCIATED(dftb_parameter)) THEN CALL get_dftb_atom_param(dftb_parameter, lmax=lmax) nset_max = MAX(nset_max, 1) - nshell_max = MAX(nshell_max, lmax+1) + nshell_max = MAX(nshell_max, lmax + 1) ELSE CPABORT("Unknown basis type.") END IF @@ -247,7 +247,7 @@ SUBROUTINE write_kpoints_file_header(qs_kind_set, particle_set, ires) basis_set=orb_basis_set, dftb_parameter=dftb_parameter) IF (ASSOCIATED(orb_basis_set)) THEN CALL get_gto_basis_set(gto_basis_set=orb_basis_set, nsgf=nsgf, nset=nset, nshell=nshell, l=l) - nao = nao+nsgf + nao = nao + nsgf nset_info(iatom) = nset DO iset = 1, nset nshell_info(iset, iatom) = nshell(iset) @@ -259,12 +259,12 @@ SUBROUTINE write_kpoints_file_header(qs_kind_set, particle_set, ires) ELSEIF (ASSOCIATED(dftb_parameter)) THEN CALL get_dftb_atom_param(dftb_parameter, lmax=lmax) nset_info(iatom) = 1 - nshell_info(1, iatom) = lmax+1 - DO ishell = 1, lmax+1 - lshell = ishell-1 + nshell_info(1, iatom) = lmax + 1 + DO ishell = 1, lmax + 1 + lshell = ishell - 1 nso_info(ishell, 1, iatom) = nso(lshell) END DO - nao = nao+(lmax+1)**2 + nao = nao + (lmax + 1)**2 ELSE CPABORT("Unknown basis set type.") END IF diff --git a/src/kpoint_methods.F b/src/kpoint_methods.F index 8af1d104a8..cd2c5ac3a7 100644 --- a/src/kpoint_methods.F +++ b/src/kpoint_methods.F @@ -201,7 +201,7 @@ SUBROUTINE kpoint_initialize(kpoint, particle_set, cell) nr = 0 DO is = 1, SIZE(crys_sym%kplink, 2) IF (crys_sym%kplink(2, is) == ik) THEN - nr = nr+1 + nr = nr + 1 ir = crys_sym%kpop(is) kpsym%rot(1:3, 1:3, nr) = crys_sym%rotations(1:3, 1:3, ir) kpsym%xkp(1:3, nr) = crys_sym%kpmesh(1:3, is) @@ -380,14 +380,14 @@ SUBROUTINE kpoint_env_initialize(kpoint) ! distribution of kpoints ALLOCATE (kpoint%kp_dist(2, nkp_grp)) DO igr = 1, nkp_grp - kpoint%kp_dist(1:2, igr) = get_limit(nkp, nkp_grp, igr-1) + kpoint%kp_dist(1:2, igr) = get_limit(nkp, nkp_grp, igr - 1) END DO ! local kpoints - kpoint%kp_range(1:2) = kpoint%kp_dist(1:2, para_env_inter_kp%mepos+1) + kpoint%kp_range(1:2) = kpoint%kp_dist(1:2, para_env_inter_kp%mepos + 1) ALLOCATE (kp_env(nkp_loc)) DO ik = 1, nkp_loc NULLIFY (kp_env(ik)%kpoint_env) - ikk = kpoint%kp_range(1)+ik-1 + ikk = kpoint%kp_range(1) + ik - 1 CALL kpoint_env_create(kp_env(ik)%kpoint_env) kp => kp_env(ik)%kpoint_env kp%nkpoint = ikk @@ -457,7 +457,7 @@ SUBROUTINE kpoint_initialize_mos(kpoint, mos, added_mos) nc = 2 END IF nspin = SIZE(mos, 1) - nkp_loc = kpoint%kp_range(2)-kpoint%kp_range(1)+1 + nkp_loc = kpoint%kp_range(2) - kpoint%kp_range(1) + 1 IF (nkp_loc > 0) THEN CPASSERT(SIZE(kpoint%kp_env) == nkp_loc) ! allocate the mo sets, correct number of kpoints (local), real/complex, spin @@ -467,7 +467,7 @@ SUBROUTINE kpoint_initialize_mos(kpoint, mos, added_mos) DO is = 1, nspin CALL get_mo_set(mos(is)%mo_set, nao=nao, nmo=nmo, nelectron=nelectron, & n_el_f=n_el_f, maxocc=maxocc, flexible_electron_count=flexible_electron_count) - nmo = MIN(nao, nmo+nadd) + nmo = MIN(nao, nmo + nadd) DO ic = 1, nc NULLIFY (kp%mos(ic, is)%mo_set) CALL allocate_mo_set(kp%mos(ic, is)%mo_set, nao, nmo, nelectron, n_el_f, maxocc, & @@ -487,7 +487,7 @@ SUBROUTINE kpoint_initialize_mos(kpoint, mos, added_mos) ! set possible new number of MOs DO is = 1, nspin CALL get_mo_set(mos(is)%mo_set, nmo=nmorig(is)) - nmo = MIN(nao, nmorig(is)+nadd) + nmo = MIN(nao, nmorig(is) + nadd) CALL set_mo_set(mos(is)%mo_set, nmo=nmo) END DO ! matrix pools for the kpoint group, information on MOs is transfered using @@ -598,7 +598,7 @@ SUBROUTINE kpoint_init_cell_index(kpoint, sab_nl, para_env, dft_control) END IF END DO IF (new) THEN - icount = icount+1 + icount = icount + 1 IF (icount > SIZE(list, 2)) THEN CALL reallocate(list, 1, 3, 1, 2*SIZE(list, 2)) END IF @@ -633,9 +633,9 @@ SUBROUTINE kpoint_init_cell_index(kpoint, sab_nl, para_env, dft_control) IF (cti(i1, i2, i3) == 0) THEN cti(i1, i2, i3) = 1000000 ELSE - ncount = ncount+1 - cti(i1, i2, i3) = (ABS(i1)+ABS(i2)+ABS(i3))*1000+ABS(i3)*100+ABS(i2)*10+ABS(i1) - cti(i1, i2, i3) = cti(i1, i2, i3)+(i1+i2+i3) + ncount = ncount + 1 + cti(i1, i2, i3) = (ABS(i1) + ABS(i2) + ABS(i3))*1000 + ABS(i3)*100 + ABS(i2)*10 + ABS(i1) + cti(i1, i2, i3) = cti(i1, i2, i3) + (i1 + i2 + i3) END IF END DO END DO @@ -648,9 +648,9 @@ SUBROUTINE kpoint_init_cell_index(kpoint, sab_nl, para_env, dft_control) index_to_cell => kpoint%index_to_cell DO ic = 1, ncount cell = MINLOC(cti) - i1 = cell(1)-1-itm(1) - i2 = cell(2)-1-itm(2) - i3 = cell(3)-1-itm(3) + i1 = cell(1) - 1 - itm(1) + i2 = cell(2) - 1 - itm(2) + i3 = cell(3) - 1 - itm(3) cti(i1, i2, i3) = 1000000 index_to_cell(1, ic) = i1 index_to_cell(2, ic) = i2 @@ -738,7 +738,7 @@ SUBROUTINE rskp_transform(rmatrix, cmatrix, rsmat, ispin, & fsym = -1.0_dp END IF - arg = REAL(cell(1), dp)*xkp(1)+REAL(cell(2), dp)*xkp(2)+REAL(cell(3), dp)*xkp(3) + arg = REAL(cell(1), dp)*xkp(1) + REAL(cell(2), dp)*xkp(2) + REAL(cell(3), dp)*xkp(3) IF (my_complex) THEN coskl = fsign*fsym*COS(twopi*arg) sinkl = fsign*SIN(twopi*arg) @@ -759,7 +759,7 @@ SUBROUTINE rskp_transform(rmatrix, cmatrix, rsmat, ispin, & CALL dbcsr_get_block_p(matrix=rmatrix, row=irow, col=icol, & block=rblock, found=found) CPASSERT(found) - rblock = rblock+coskl*rsblock + rblock = rblock + coskl*rsblock ELSE CALL dbcsr_get_block_p(matrix=rmatrix, row=irow, col=icol, & block=rblock, found=found) @@ -767,8 +767,8 @@ SUBROUTINE rskp_transform(rmatrix, cmatrix, rsmat, ispin, & CALL dbcsr_get_block_p(matrix=cmatrix, row=irow, col=icol, & block=cblock, found=found) CPASSERT(found) - rblock = rblock+coskl*rsblock - cblock = cblock+sinkl*rsblock + rblock = rblock + coskl*rsblock + cblock = cblock + sinkl*rsblock END IF END DO @@ -818,9 +818,9 @@ SUBROUTINE kpoint_set_mo_occupation(kpoint, smear) weig = 0.0_dp wocc = 0.0_dp CALL get_kpoint_info(kpoint, kp_range=kp_range) - kplocal = kp_range(2)-kp_range(1)+1 + kplocal = kp_range(2) - kp_range(1) + 1 DO ikpgr = 1, kplocal - ik = kp_range(1)+ikpgr-1 + ik = kp_range(1) + ikpgr - 1 kp => kpoint%kp_env(ikpgr)%kpoint_env DO ispin = 1, nspin mo_set => kp%mos(1, ispin)%mo_set @@ -849,7 +849,7 @@ SUBROUTINE kpoint_set_mo_occupation(kpoint, smear) CALL Fermikp(wocc(:, :, 2), mus(2), kTS, weig(:, :, 2), nel, wkp, & smear%electronic_temperature, 1.0_dp) ELSE - nel = REAL(ne_a, KIND=dp)+REAL(ne_b, KIND=dp) + nel = REAL(ne_a, KIND=dp) + REAL(ne_b, KIND=dp) CALL Fermikp2(wocc(:, :, :), mu, kTS, weig(:, :, :), nel, wkp, & smear%electronic_temperature) kTS = kTS/2._dp @@ -871,7 +871,7 @@ SUBROUTINE kpoint_set_mo_occupation(kpoint, smear) END IF END IF DO ikpgr = 1, kplocal - ik = kp_range(1)+ikpgr-1 + ik = kp_range(1) + ikpgr - 1 kp => kpoint%kp_env(ikpgr)%kpoint_env DO ispin = 1, nspin mo_set => kp%mos(1, ispin)%mo_set @@ -928,7 +928,7 @@ SUBROUTINE kpoint_density_matrices(kpoint, energy_weighted) CALL cp_fm_create(fwork, matrix_struct) CALL get_kpoint_info(kpoint, kp_range=kp_range) - kplocal = kp_range(2)-kp_range(1)+1 + kplocal = kp_range(2) - kp_range(1) + 1 DO ikpgr = 1, kplocal kp => kpoint%kp_env(ikpgr)%kpoint_env nspin = SIZE(kp%mos, 2) @@ -1067,7 +1067,7 @@ SUBROUTINE kpoint_density_transform(kpoint, denmat, wtype, tempmat, sab_nl, fmwo DO ik = 1, nkp my_kpgrp = (ik >= kpoint%kp_range(1) .AND. ik <= kpoint%kp_range(2)) IF (my_kpgrp) THEN - ikk = ik-kpoint%kp_range(1)+1 + ikk = ik - kpoint%kp_range(1) + 1 kp => kpoint%kp_env(ikk)%kpoint_env ELSE NULLIFY (kp) @@ -1077,7 +1077,7 @@ SUBROUTINE kpoint_density_transform(kpoint, denmat, wtype, tempmat, sab_nl, fmwo IF (my_kpgrp) THEN DO ic = 1, nc - indx = indx+1 + indx = indx + 1 IF (wtype) THEN CALL cp_fm_start_copy_general(kp%wmat(ic, ispin)%matrix, fmwork(ic)%matrix, para_env, info(indx)) ELSE @@ -1086,7 +1086,7 @@ SUBROUTINE kpoint_density_transform(kpoint, denmat, wtype, tempmat, sab_nl, fmwo END DO ELSE DO ic = 1, nc - indx = indx+1 + indx = indx + 1 CALL cp_fm_start_copy_general(fmdummy, fmwork(ic)%matrix, para_env, info(indx)) END DO END IF @@ -1098,7 +1098,7 @@ SUBROUTINE kpoint_density_transform(kpoint, denmat, wtype, tempmat, sab_nl, fmwo DO ispin = 1, nspin DO ik = 1, nkp DO ic = 1, nc - indx = indx+1 + indx = indx + 1 CALL cp_fm_finish_copy_general(fmwork(ic)%matrix, info(indx)) END DO @@ -1141,11 +1141,11 @@ SUBROUTINE kpoint_density_transform(kpoint, denmat, wtype, tempmat, sab_nl, fmwo DO ik = 1, nkp my_kpgrp = (ik >= kpoint%kp_range(1) .AND. ik <= kpoint%kp_range(2)) IF (my_kpgrp) THEN - ikk = ik-kpoint%kp_range(1)+1 + ikk = ik - kpoint%kp_range(1) + 1 kp => kpoint%kp_env(ikk)%kpoint_env DO ic = 1, nc - indx = indx+1 + indx = indx + 1 IF (wtype) THEN CALL cp_fm_cleanup_copy_general(kp%wmat(ic, ispin)%matrix, info(indx)) ELSE @@ -1155,7 +1155,7 @@ SUBROUTINE kpoint_density_transform(kpoint, denmat, wtype, tempmat, sab_nl, fmwo ELSE ! calls with dummy arguments, so not included ! therefore just increment counter by trip count - indx = indx+nc + indx = indx + nc END IF END DO END DO @@ -1227,7 +1227,7 @@ SUBROUTINE transform_dmat(denmat, rpmat, cpmat, ispin, real_only, sab_nl, cell_t fc = 1.0_dp END IF icell = cell_to_index(cell(1), cell(2), cell(3)) - arg = REAL(cell(1), dp)*xkp(1)+REAL(cell(2), dp)*xkp(2)+REAL(cell(3), dp)*xkp(3) + arg = REAL(cell(1), dp)*xkp(1) + REAL(cell(2), dp)*xkp(2) + REAL(cell(3), dp)*xkp(3) coskl = wkp*COS(twopi*arg) sinkl = wkp*fc*SIN(twopi*arg) @@ -1238,14 +1238,14 @@ SUBROUTINE transform_dmat(denmat, rpmat, cpmat, ispin, real_only, sab_nl, cell_t IF (real_only) THEN CALL dbcsr_get_block_p(matrix=rpmat, row=irow, col=icol, block=rblock, found=found) CPASSERT(found) - dblock = dblock+coskl*rblock + dblock = dblock + coskl*rblock ELSE CALL dbcsr_get_block_p(matrix=rpmat, row=irow, col=icol, block=rblock, found=found) CPASSERT(found) CALL dbcsr_get_block_p(matrix=cpmat, row=irow, col=icol, block=cblock, found=found) CPASSERT(found) - dblock = dblock+coskl*rblock - dblock = dblock+sinkl*cblock + dblock = dblock + coskl*rblock + dblock = dblock + sinkl*cblock END IF END DO CALL neighbor_list_iterator_release(nl_iterator) @@ -1301,8 +1301,8 @@ SUBROUTINE symtrans(smat, pmat, rot, f0, symmetric, antisymmetric) ! do we have a real rotation dorot = .FALSE. - IF (ABS(SUM(ABS(rot))-3.0_dp) > 1.e-12_dp) dorot = .TRUE. - dr = ABS(rot(1, 1)-1.0_dp)+ABS(rot(2, 2)-1.0_dp)+ABS(rot(3, 3)-1.0_dp) + IF (ABS(SUM(ABS(rot)) - 3.0_dp) > 1.e-12_dp) dorot = .TRUE. + dr = ABS(rot(1, 1) - 1.0_dp) + ABS(rot(2, 2) - 1.0_dp) + ABS(rot(3, 3) - 1.0_dp) IF (ABS(dr) > 1.e-12_dp) dorot = .TRUE. fsign = 1.0_dp diff --git a/src/kpoint_types.F b/src/kpoint_types.F index 562ab8429c..5af07ef099 100644 --- a/src/kpoint_types.F +++ b/src/kpoint_types.F @@ -538,15 +538,15 @@ SUBROUTINE read_kpoint_section(kpoint, kpoint_section, a_vec) CASE ("MONKHORST-PACK") CPASSERT(nval >= 4) DO i = 2, 4 - READ (tmpstringlist(i), *) kpoint%nkp_grid(i-1) + READ (tmpstringlist(i), *) kpoint%nkp_grid(i - 1) END DO CASE ("MACDONALD") CPASSERT(nval >= 7) DO i = 2, 4 - READ (tmpstringlist(i), *) kpoint%nkp_grid(i-1) + READ (tmpstringlist(i), *) kpoint%nkp_grid(i - 1) END DO DO i = 5, 7 - READ (tmpstringlist(i), *) kpoint%kp_shift(i-4) + READ (tmpstringlist(i), *) kpoint%kp_shift(i - 4) END DO CASE ("GENERAL") CALL section_vals_val_get(kpoint_section, "UNITS", c_val=ustr) @@ -563,12 +563,12 @@ SUBROUTINE read_kpoint_section(kpoint, kpoint_section, a_vec) CASE ("B_VECTOR") kpoint%xkp(1:3, i) = reallist(1:3) CASE ("CART_ANGSTROM") - kpoint%xkp(1:3, i) = (reallist(1)*a_vec(1, 1:3)+ & - reallist(2)*a_vec(2, 1:3)+ & + kpoint%xkp(1:3, i) = (reallist(1)*a_vec(1, 1:3) + & + reallist(2)*a_vec(2, 1:3) + & reallist(3)*a_vec(3, 1:3))/twopi*angstrom CASE ("CART_BOHR") - kpoint%xkp(1:3, i) = (reallist(1)*a_vec(1, 1:3)+ & - reallist(2)*a_vec(2, 1:3)+ & + kpoint%xkp(1:3, i) = (reallist(1)*a_vec(1, 1:3) + & + reallist(2)*a_vec(2, 1:3) + & reallist(3)*a_vec(3, 1:3))/twopi CASE DEFAULT CPABORT("Unknown Unit for kpoint definition") diff --git a/src/libint_2c_3c.F b/src/libint_2c_3c.F index 7a34c39604..377f84753a 100644 --- a/src/libint_2c_3c.F +++ b/src/libint_2c_3c.F @@ -146,49 +146,49 @@ SUBROUTINE eri_3center(int_abc, la_min, la_max, npgfa, zeta, rpgfa, ra, & !Looping over the pgfs DO ipgf = 1, npgfa zeti = zeta(ipgf) - a_start = (ipgf-1)*ncoset(la_max) + a_start = (ipgf - 1)*ncoset(la_max) DO jpgf = 1, npgfb ! screening - IF (rpgfa(ipgf)+rpgfb(jpgf)+dr_ab < dab) CYCLE + IF (rpgfa(ipgf) + rpgfb(jpgf) + dr_ab < dab) CYCLE zetj = zetb(jpgf) - b_start = (jpgf-1)*ncoset(lb_max) + b_start = (jpgf - 1)*ncoset(lb_max) DO kpgf = 1, npgfc ! screening - IF (rpgfb(jpgf)+rpgfc(kpgf)+dr_bc < dbc) CYCLE - IF (rpgfa(ipgf)+rpgfc(kpgf)+dr_ac < dac) CYCLE + IF (rpgfb(jpgf) + rpgfc(kpgf) + dr_bc < dbc) CYCLE + IF (rpgfa(ipgf) + rpgfc(kpgf) + dr_ac < dac) CYCLE zetk = zetc(kpgf) - c_start = (kpgf-1)*ncoset(lc_max) + c_start = (kpgf - 1)*ncoset(lc_max) !start with all the (c|ba) integrals (standard order) and keep to lb >= la CALL set_params_3c(lib, ra, rb, rc, la_max, lb_max, lc_max, zeti, zetj, zetk, op, & params_out=params, r_cutoff=my_r_cutoff, omega=my_omega) DO li = la_min, la_max - a_offset = a_start+ncoset(li-1) + a_offset = a_start + ncoset(li - 1) ncoa = nco(li) DO lj = MAX(li, lb_min), lb_max - b_offset = b_start+ncoset(lj-1) + b_offset = b_start + ncoset(lj - 1) ncob = nco(lj) DO lk = lc_min, lc_max - c_offset = c_start+ncoset(lk-1) + c_offset = c_start + ncoset(lk - 1) ncoc = nco(lk) a_mysize(1) = ncoa*ncob*ncoc CALL cp_libint_get_3eris(li, lj, lk, lib, p_work, a_mysize) DO k = 1, ncoc - p1 = (k-1)*ncob + p1 = (k - 1)*ncob DO j = 1, ncob - p2 = (p1+j-1)*ncoa + p2 = (p1 + j - 1)*ncoa DO i = 1, ncoa - p3 = p2+i - int_abc(a_offset+i, b_offset+j, c_offset+k) = p_work(p3) + p3 = p2 + i + int_abc(a_offset + i, b_offset + j, c_offset + k) = p_work(p3) END DO END DO END DO @@ -201,25 +201,25 @@ SUBROUTINE eri_3center(int_abc, la_min, la_max, npgfa, zeta, rpgfa, ra, & CALL set_params_3c(lib, rb, ra, rc, params_in=params) DO lj = lb_min, lb_max - b_offset = b_start+ncoset(lj-1) + b_offset = b_start + ncoset(lj - 1) ncob = nco(lj) - DO li = MAX(lj+1, la_min), la_max - a_offset = a_start+ncoset(li-1) + DO li = MAX(lj + 1, la_min), la_max + a_offset = a_start + ncoset(li - 1) ncoa = nco(li) DO lk = lc_min, lc_max - c_offset = c_start+ncoset(lk-1) + c_offset = c_start + ncoset(lk - 1) ncoc = nco(lk) a_mysize(1) = ncoa*ncob*ncoc CALL cp_libint_get_3eris(lj, li, lk, lib, p_work, a_mysize) DO k = 1, ncoc - p1 = (k-1)*ncoa + p1 = (k - 1)*ncoa DO i = 1, ncoa - p2 = (p1+i-1)*ncob + p2 = (p1 + i - 1)*ncob DO j = 1, ncob - p3 = p2+j - int_abc(a_offset+i, b_offset+j, c_offset+k) = p_work(p3) + p3 = p2 + j + int_abc(a_offset + i, b_offset + j, c_offset + k) = p_work(p3) END DO END DO END DO @@ -295,28 +295,28 @@ SUBROUTINE set_params_3c(lib, ri, rj, rk, li_max, lj_max, lk_max, zeti, zetj, ze !Note: some variable of 4-center integrals simplify with a dummy center: ! P -> rk, gammap -> zetk - params%m_max = li_max+lj_max+lk_max - gammaq = zeti+zetj + params%m_max = li_max + lj_max + lk_max + gammaq = zeti + zetj params%ZetaInv = 1._dp/zetk; params%EtaInv = 1._dp/gammaq - params%ZetapEtaInv = 1._dp/(zetk+gammaq) + params%ZetapEtaInv = 1._dp/(zetk + gammaq) - params%Q = (zeti*ri+zetj*rj)*params%EtaInv - params%W = (zetk*rk+gammaq*params%Q)*params%ZetapEtaInv - params%Rho = zetk*gammaq/(zetk+gammaq) + params%Q = (zeti*ri + zetj*rj)*params%EtaInv + params%W = (zetk*rk + gammaq*params%Q)*params%ZetapEtaInv + params%Rho = zetk*gammaq/(zetk + gammaq) params%Fm = 0.0_dp SELECT CASE (op) CASE (do_potential_coulomb) - T = params%Rho*SUM((params%Q-rk)**2) - S1234 = EXP(-zeti*zetj*params%EtaInv*SUM((rj-ri)**2)) + T = params%Rho*SUM((params%Q - rk)**2) + S1234 = EXP(-zeti*zetj*params%EtaInv*SUM((rj - ri)**2)) prefac = 2._dp*pi/params%Rho*SQRT((pi*params%ZetapEtaInv)**3)*S1234 CALL fgamma(params%m_max, T, params%Fm) params%Fm = prefac*params%Fm CASE (do_potential_truncated) R = r_cutoff*SQRT(params%Rho) - T = params%Rho*SUM((params%Q-rk)**2) - S1234 = EXP(-zeti*zetj*params%EtaInv*SUM((rj-ri)**2)) + T = params%Rho*SUM((params%Q - rk)**2) + S1234 = EXP(-zeti*zetj*params%EtaInv*SUM((rj - ri)**2)) prefac = 2._dp*pi/params%Rho*SQRT((pi*params%ZetapEtaInv)**3)*S1234 CPASSERT(get_lmax_init() .GE. params%m_max) !check if truncated coulomb init correctly @@ -324,22 +324,22 @@ SUBROUTINE set_params_3c(lib, ri, rj, rk, li_max, lj_max, lk_max, zeti, zetj, ze IF (use_gamma) CALL fgamma(params%m_max, T, params%Fm) params%Fm = prefac*params%Fm CASE (do_potential_short) - T = params%Rho*SUM((params%Q-rk)**2) - S1234 = EXP(-zeti*zetj*params%EtaInv*SUM((rj-ri)**2)) + T = params%Rho*SUM((params%Q - rk)**2) + S1234 = EXP(-zeti*zetj*params%EtaInv*SUM((rj - ri)**2)) prefac = 2._dp*pi/params%Rho*SQRT((pi*params%ZetapEtaInv)**3)*S1234 CALL fgamma(params%m_max, T, params%Fm) omega2 = omega**2 - omega_corr2 = omega2/(omega2+params%Rho) + omega_corr2 = omega2/(omega2 + params%Rho) omega_corr = SQRT(omega_corr2) T = T*omega_corr2 ALLOCATE (Fm(prim_data_f_size)) CALL fgamma(params%m_max, T, Fm) tmp = -omega_corr - DO l = 1, params%m_max+1 - params%Fm(l) = params%Fm(l)+Fm(l)*tmp + DO l = 1, params%m_max + 1 + params%Fm(l) = params%Fm(l) + Fm(l)*tmp tmp = tmp*omega_corr2 END DO params%Fm = prefac*params%Fm @@ -411,30 +411,30 @@ SUBROUTINE eri_2center(int_ab, la_min, la_max, npgfa, zeta, ra, & !Looping over the pgfs DO ipgf = 1, npgfa zeti = zeta(ipgf) - a_start = (ipgf-1)*ncoset(la_max) + a_start = (ipgf - 1)*ncoset(la_max) DO jpgf = 1, npgfb zetj = zetb(jpgf) - b_start = (jpgf-1)*ncoset(lb_max) + b_start = (jpgf - 1)*ncoset(lb_max) CALL set_params_2c(lib, ra, rb, la_max, lb_max, zeti, zetj, op, & r_cutoff=my_r_cutoff, omega=my_omega) DO li = la_min, la_max - a_offset = a_start+ncoset(li-1) + a_offset = a_start + ncoset(li - 1) ncoa = nco(li) DO lj = lb_min, lb_max - b_offset = b_start+ncoset(lj-1) + b_offset = b_start + ncoset(lj - 1) ncob = nco(lj) a_mysize(1) = ncoa*ncob CALL cp_libint_get_2eris(li, lj, lib, p_work, a_mysize) DO j = 1, ncob - p1 = (j-1)*ncoa + p1 = (j - 1)*ncoa DO i = 1, ncoa - p2 = p1+i - int_ab(a_offset+i, b_offset+j) = p_work(p2) + p2 = p1 + i + int_ab(a_offset + i, b_offset + j) = p_work(p2) END DO END DO @@ -486,23 +486,23 @@ SUBROUTINE set_params_2c(lib, rj, rk, lj_max, lk_max, zetj, zetk, & !Note: some variable of 4-center integrals simplify due to dummy centers: ! P -> rk, gammap -> zetk ! Q -> rj, gammaq -> zetj - params%m_max = lj_max+lk_max + params%m_max = lj_max + lk_max params%ZetaInv = 1._dp/zetk; params%EtaInv = 1._dp/zetj - params%ZetapEtaInv = 1._dp/(zetk+zetj) + params%ZetapEtaInv = 1._dp/(zetk + zetj) - params%W = (zetk*rk+zetj*rj)*params%ZetapEtaInv - params%Rho = zetk*zetj/(zetk+zetj) + params%W = (zetk*rk + zetj*rj)*params%ZetapEtaInv + params%Rho = zetk*zetj/(zetk + zetj) params%Fm = 0.0_dp SELECT CASE (op) CASE (do_potential_coulomb) - T = params%Rho*SUM((rj-rk)**2) + T = params%Rho*SUM((rj - rk)**2) prefac = 2._dp*pi/params%Rho*SQRT((pi*params%ZetapEtaInv)**3) CALL fgamma(params%m_max, T, params%Fm) params%Fm = prefac*params%Fm CASE (do_potential_truncated) R = r_cutoff*SQRT(params%Rho) - T = params%Rho*SUM((rj-rk)**2) + T = params%Rho*SUM((rj - rk)**2) prefac = 2._dp*pi/params%Rho*SQRT((pi*params%ZetapEtaInv)**3) CPASSERT(get_lmax_init() .GE. params%m_max) !check if truncated coulomb init correctly @@ -510,21 +510,21 @@ SUBROUTINE set_params_2c(lib, rj, rk, lj_max, lk_max, zetj, zetk, & IF (use_gamma) CALL fgamma(params%m_max, T, params%Fm) params%Fm = prefac*params%Fm CASE (do_potential_short) - T = params%Rho*SUM((rj-rk)**2) + T = params%Rho*SUM((rj - rk)**2) prefac = 2._dp*pi/params%Rho*SQRT((pi*params%ZetapEtaInv)**3) CALL fgamma(params%m_max, T, params%Fm) omega2 = omega**2 - omega_corr2 = omega2/(omega2+params%Rho) + omega_corr2 = omega2/(omega2 + params%Rho) omega_corr = SQRT(omega_corr2) T = T*omega_corr2 ALLOCATE (Fm(prim_data_f_size)) CALL fgamma(params%m_max, T, Fm) tmp = -omega_corr - DO l = 1, params%m_max+1 - params%Fm(l) = params%Fm(l)+Fm(l)*tmp + DO l = 1, params%m_max + 1 + params%Fm(l) = params%Fm(l) + Fm(l)*tmp tmp = tmp*omega_corr2 END DO params%Fm = prefac*params%Fm diff --git a/src/library_tests.F b/src/library_tests.F index 74637a609c..9449a45b22 100644 --- a/src/library_tests.F +++ b/src/library_tests.F @@ -327,7 +327,7 @@ SUBROUTINE copy_test(para_env, iw) ca(1) = REAL(j, KIND=dp) END DO tend = m_walltime() - t = tend-tstart+threshold + t = tend - tstart + threshold IF (t > 0.0_dp) THEN perf = REAL(ntim, KIND=dp)*REAL(len, KIND=dp)*1.e-6_dp/t ELSE @@ -373,7 +373,7 @@ SUBROUTINE matmul_test(para_env, test_matmul, test_dgemm, iw) siz = ABS(runtest(2)) IF (para_env%ionode) WRITE (iw, '(//,A,/)') " Test of matmul ( F95 ) " DO i = 5, siz, 2 - len = 2**i+1 + len = 2**i + 1 IF (8.0_dp*REAL(len*len, KIND=dp) > max_memory*0.3_dp) EXIT ALLOCATE (ma(len, len), STAT=ierr) IF (ierr /= 0) EXIT @@ -396,7 +396,7 @@ SUBROUTINE matmul_test(para_env, test_matmul, test_dgemm, iw) ma(1, 1) = REAL(j, KIND=dp) END DO tend = m_walltime() - t = tend-tstart+threshold + t = tend - tstart + threshold perf = REAL(ntim, KIND=dp)*2.0_dp*REAL(len, KIND=dp)**3*1.e-6_dp/t IF (para_env%ionode) THEN WRITE (iw, '(A,i6,T59,F14.4,A)') & @@ -404,11 +404,11 @@ SUBROUTINE matmul_test(para_env, test_matmul, test_dgemm, iw) END IF tstart = m_walltime() DO j = 1, ntim - mc(:, :) = mc+MATMUL(ma, mb) + mc(:, :) = mc + MATMUL(ma, mb) ma(1, 1) = REAL(j, KIND=dp) END DO tend = m_walltime() - t = tend-tstart+threshold + t = tend - tstart + threshold IF (t > 0.0_dp) THEN perf = REAL(ntim, KIND=dp)*2.0_dp*REAL(len, KIND=dp)**3*1.e-6_dp/t ELSE @@ -422,11 +422,11 @@ SUBROUTINE matmul_test(para_env, test_matmul, test_dgemm, iw) tstart = m_walltime() DO j = 1, ntim - mc(:, :) = mc+MATMUL(ma, TRANSPOSE(mb)) + mc(:, :) = mc + MATMUL(ma, TRANSPOSE(mb)) ma(1, 1) = REAL(j, KIND=dp) END DO tend = m_walltime() - t = tend-tstart+threshold + t = tend - tstart + threshold IF (t > 0.0_dp) THEN perf = REAL(ntim, KIND=dp)*2.0_dp*REAL(len, KIND=dp)**3*1.e-6_dp/t ELSE @@ -440,11 +440,11 @@ SUBROUTINE matmul_test(para_env, test_matmul, test_dgemm, iw) tstart = m_walltime() DO j = 1, ntim - mc(:, :) = mc+MATMUL(TRANSPOSE(ma), mb) + mc(:, :) = mc + MATMUL(TRANSPOSE(ma), mb) ma(1, 1) = REAL(j, KIND=dp) END DO tend = m_walltime() - t = tend-tstart+threshold + t = tend - tstart + threshold IF (t > 0.0_dp) THEN perf = REAL(ntim, KIND=dp)*2.0_dp*REAL(len, KIND=dp)**3*1.e-6_dp/t ELSE @@ -467,7 +467,7 @@ SUBROUTINE matmul_test(para_env, test_matmul, test_dgemm, iw) siz = ABS(runtest(5)) IF (para_env%ionode) WRITE (iw, '(//,A,/)') " Test of matmul ( BLAS ) " DO i = 5, siz, 2 - len = 2**i+1 + len = 2**i + 1 IF (8.0_dp*REAL(len*len, KIND=dp) > max_memory*0.3_dp) EXIT ALLOCATE (ma(len, len), STAT=ierr) IF (ierr /= 0) EXIT @@ -490,7 +490,7 @@ SUBROUTINE matmul_test(para_env, test_matmul, test_dgemm, iw) CALL dgemm("N", "N", len, len, len, 1.0_dp, ma, len, mb, len, 1.0_dp, mc, len) END DO tend = m_walltime() - t = tend-tstart+threshold + t = tend - tstart + threshold IF (t > 0.0_dp) THEN perf = REAL(ntim, KIND=dp)*2.0_dp*REAL(len, KIND=dp)**3*1.e-6_dp/t ELSE @@ -507,7 +507,7 @@ SUBROUTINE matmul_test(para_env, test_matmul, test_dgemm, iw) CALL dgemm("N", "N", len, len, len, 1.0_dp, ma, len, mb, len, 1.0_dp, mc, len) END DO tend = m_walltime() - t = tend-tstart+threshold + t = tend - tstart + threshold IF (t > 0.0_dp) THEN perf = REAL(ntim, KIND=dp)*2.0_dp*REAL(len, KIND=dp)**3*1.e-6_dp/t ELSE @@ -524,7 +524,7 @@ SUBROUTINE matmul_test(para_env, test_matmul, test_dgemm, iw) CALL dgemm("N", "T", len, len, len, 1.0_dp, ma, len, mb, len, 1.0_dp, mc, len) END DO tend = m_walltime() - t = tend-tstart+threshold + t = tend - tstart + threshold IF (t > 0.0_dp) THEN perf = REAL(ntim, KIND=dp)*2.0_dp*REAL(len, KIND=dp)**3*1.e-6_dp/t ELSE @@ -541,7 +541,7 @@ SUBROUTINE matmul_test(para_env, test_matmul, test_dgemm, iw) CALL dgemm("T", "N", len, len, len, 1.0_dp, ma, len, mb, len, 1.0_dp, mc, len) END DO tend = m_walltime() - t = tend-tstart+threshold + t = tend - tstart + threshold IF (t > 0.0_dp) THEN perf = REAL(ntim, KIND=dp)*2.0_dp*REAL(len, KIND=dp)**3*1.e-6_dp/t ELSE @@ -626,7 +626,7 @@ SUBROUTINE fft_test(para_env, iw, fftw_plan_type, wisdom_file) CALL RANDOM_NUMBER(ra) ca(:, :, :) = ra CALL RANDOM_NUMBER(ra) - ca(:, :, :) = ca+CMPLX(0.0_dp, 1.0_dp, KIND=dp)*ra + ca(:, :, :) = ca + CMPLX(0.0_dp, 1.0_dp, KIND=dp)*ra flops = REAL(len**3, KIND=dp)*15.0_dp*LOG(REAL(len, KIND=dp)) ntim = NINT(siz*1.e7_dp/flops) ntim = MAX(ntim, 1) @@ -638,7 +638,7 @@ SUBROUTINE fft_test(para_env, iw, fftw_plan_type, wisdom_file) CALL fft3d(BWFFT, n, ca, SCALE=scale) END DO tend = m_walltime() - t = tend-tstart+threshold + t = tend - tstart + threshold IF (t > 0.0_dp) THEN perf = REAL(ntim, KIND=dp)*2.0_dp*flops*1.e-6_dp/t ELSE @@ -663,10 +663,10 @@ SUBROUTINE fft_test(para_env, iw, fftw_plan_type, wisdom_file) CALL RANDOM_NUMBER(ra) ca(:, :, :) = ra CALL RANDOM_NUMBER(ra) - ca(:, :, :) = ca+CMPLX(0.0_dp, 1.0_dp, KIND=dp)*ra + ca(:, :, :) = ca + CMPLX(0.0_dp, 1.0_dp, KIND=dp)*ra cc(:, :, :) = ca CALL fft3d(FWFFT, n, ca, cb) - tdiff = MAXVAL(ABS(ca-cc)) + tdiff = MAXVAL(ABS(ca - cc)) IF (tdiff > 1.0E-12_dp) THEN IF (para_env%ionode) & WRITE (iw, '(T2,A,A,A)') ADJUSTR(method), " FWFFT ", & @@ -678,7 +678,7 @@ SUBROUTINE fft_test(para_env, iw, fftw_plan_type, wisdom_file) END IF ca(:, :, :) = cc CALL fft3d(BWFFT, n, ca, cb) - tdiff = MAXVAL(ABS(ca-cc)) + tdiff = MAXVAL(ABS(ca - cc)) IF (tdiff > 1.0E-12_dp) THEN IF (para_env%ionode) & WRITE (iw, '(T2,A,A,A)') ADJUSTR(method), " BWFFT ", & @@ -765,7 +765,7 @@ SUBROUTINE rs_pw_transfer_test(para_env, iw, globenv, rs_pw_transfer_section) ! .. rs input setting type CALL section_vals_val_get(rs_pw_transfer_section, "HALO_SIZE", i_val=halo_size) rs_grid_section => section_vals_get_subs_vals(rs_pw_transfer_section, "RS_GRID") - ns_max = 2*halo_size+1 + ns_max = 2*halo_size + 1 CALL init_input_type(input_settings, ns_max, rs_grid_section, 1, (/-1, -1, -1/)) ! .. rs type @@ -801,7 +801,7 @@ SUBROUTINE rs_pw_transfer_test(para_env, iw, globenv, rs_pw_transfer_section) CALL mp_sync(para_env%group) tend = m_walltime() IF (para_env%ionode) THEN - WRITE (iw, '(T2,I9,1X,F12.6)') i_loop, tend-tstart + WRITE (iw, '(T2,I9,1X,F12.6)') i_loop, tend - tstart ENDIF ENDDO @@ -893,7 +893,7 @@ SUBROUTINE pw_fft_test(para_env, iw, globenv, pw_transfer_section) DO p = 2, para_env%num_pe q = para_env%num_pe/p IF (p*q == para_env%num_pe) THEN - itmp = itmp+1 + itmp = itmp + 1 ENDIF ENDDO ! build list @@ -902,7 +902,7 @@ SUBROUTINE pw_fft_test(para_env, iw, globenv, pw_transfer_section) DO p = 2, para_env%num_pe q = para_env%num_pe/p IF (p*q == para_env%num_pe) THEN - itmp = itmp+1 + itmp = itmp + 1 layouts(:, itmp) = (/p, q/) ENDIF ENDDO @@ -988,19 +988,19 @@ SUBROUTINE pw_fft_test(para_env, iw, globenv, pw_transfer_section) t_end(ip) = m_walltime() END DO tend = m_walltime() - t = tend-tstart+threshold + t = tend - tstart + threshold IF (t > 0.0_dp) THEN perf = REAL(n_loop, KIND=dp)*2.0_dp*flops*1.e-6_dp/t ELSE perf = 0.0_dp END IF - em = MAXVAL(ABS(ca%pw%cc(:)-cc%pw%cc(:))) + em = MAXVAL(ABS(ca%pw%cc(:) - cc%pw%cc(:))) CALL mp_max(em, para_env%group) - et = SUM(ABS(ca%pw%cc(:)-cc%pw%cc(:))) + et = SUM(ABS(ca%pw%cc(:) - cc%pw%cc(:))) CALL mp_sum(et, para_env%group) - t_min = MINVAL(t_end-t_start) - t_max = MAXVAL(t_end-t_start) + t_min = MINVAL(t_end - t_start) + t_max = MAXVAL(t_end - t_start) IF (para_env%ionode) THEN WRITE (iw, *) @@ -1094,8 +1094,8 @@ SUBROUTINE rng_test(para_env, output_unit) tstart = m_walltime() DO i = 1, n t = next_random_number(rng_stream) - tsum = tsum+t - tsum2 = tsum2+t*t + tsum = tsum + t + tsum2 = tsum2 + t*t IF (t > tmax) tmax = t IF (t < tmin) tmin = t END DO @@ -1107,7 +1107,7 @@ SUBROUTINE rng_test(para_env, output_unit) "Maximum: ", tmax, & "Average: ", tsum/REAL(n, KIND=dp), & "Variance:", tsum2/REAL(n, KIND=dp), & - "Time [s]:", tend-tstart + "Time [s]:", tend - tstart END IF CALL delete_rng_stream(rng_stream) @@ -1127,8 +1127,8 @@ SUBROUTINE rng_test(para_env, output_unit) tstart = m_walltime() DO i = 1, n t = next_random_number(rng_stream) - tsum = tsum+t - tsum2 = tsum2+t*t + tsum = tsum + t + tsum2 = tsum2 + t*t IF (t > tmax) tmax = t IF (t < tmin) tmin = t END DO @@ -1141,7 +1141,7 @@ SUBROUTINE rng_test(para_env, output_unit) "Maximum: ", tmax, & "Average: ", tsum/REAL(n, KIND=dp), & "Variance:", tsum2/REAL(n, KIND=dp), & - "Time [s]:", tend-tstart + "Time [s]:", tend - tstart END IF CALL delete_rng_stream(rng_stream) @@ -1282,7 +1282,7 @@ SUBROUTINE eigensolver_test(para_env, iw, eigensolver_section) SELECT CASE (init_method) CASE (do_mat_random) DO j = i, n - buffer(1, j) = next_random_number(rng_stream)-0.5_dp + buffer(1, j) = next_random_number(rng_stream) - 0.5_dp END DO !MK activate/modify for a diagonal dominant symmetric matrix: !MK buffer(1,i) = 10.0_dp*buffer(1,i) @@ -1298,7 +1298,7 @@ SUBROUTINE eigensolver_test(para_env, iw, eigensolver_section) start_row=i, & start_col=i, & n_rows=1, & - n_cols=n-i+1, & + n_cols=n - i + 1, & alpha=1.0_dp, & beta=0.0_dp, & transpose=.FALSE.) @@ -1306,7 +1306,7 @@ SUBROUTINE eigensolver_test(para_env, iw, eigensolver_section) new_values=buffer, & start_row=i, & start_col=i, & - n_rows=n-i+1, & + n_rows=n - i + 1, & n_cols=1, & alpha=1.0_dp, & beta=0.0_dp, & @@ -1356,7 +1356,7 @@ SUBROUTINE eigensolver_test(para_env, iw, eigensolver_section) work_syevx=1.0_dp) END SELECT t2 = m_walltime() - IF (iw > 0) WRITE (iw, *) "Timing for loop ", i_loop, " : ", t2-t1 + IF (iw > 0) WRITE (iw, *) "Timing for loop ", i_loop, " : ", t2 - t1 ENDDO IF (iw > 0) THEN @@ -1517,17 +1517,17 @@ SUBROUTINE cp_fm_gemm_test(para_env, iw, cp_fm_gemm_test_section) CALL cp_gemm(transa, transb, k, n, m, 1.0_dp, matrix_a, matrix_b, 0.0_dp, matrix_c) t4 = m_walltime() IF (iw > 0) THEN - WRITE (iw, '(T2,A,T50,F12.6)') "cp_fm_gemm timing: ", (t4-t3) + WRITE (iw, '(T2,A,T50,F12.6)') "cp_fm_gemm timing: ", (t4 - t3) CALL m_flush(iw) ENDIF ENDDO t2 = m_walltime() IF (iw > 0) THEN - WRITE (iw, '(T2,A,T50,F12.6)') "average cp_fm_gemm timing: ", (t2-t1)/N_loop + WRITE (iw, '(T2,A,T50,F12.6)') "average cp_fm_gemm timing: ", (t2 - t1)/N_loop IF (t2 > t1) THEN WRITE (iw, '(T2,A,T50,F12.6)') "cp_fm_gemm Gflops per MPI task: ", & - 2*REAL(m, kind=dp)*REAL(n, kind=dp)*REAL(k, kind=dp)*N_loop/MAX(0.001_dp, t2-t1)/1.0E9_dp/para_env%num_pe + 2*REAL(m, kind=dp)*REAL(n, kind=dp)*REAL(k, kind=dp)*N_loop/MAX(0.001_dp, t2 - t1)/1.0E9_dp/para_env%num_pe ENDIF ENDIF diff --git a/src/linesearch.F b/src/linesearch.F index d868c0bf8a..1d166ab116 100644 --- a/src/linesearch.F +++ b/src/linesearch.F @@ -368,7 +368,7 @@ SUBROUTINE linesearch_2pnt(this, energy, slope, step_size, is_done, unit_nr, lab c = this%energies(1) b = -slope x2 = this%scan_step - a = (this%energies(2)-b*x2-c)/(x2**2) + a = (this%energies(2) - b*x2 - c)/(x2**2) IF (a < 0.0_dp) THEN IF (unit_nr > 0) WRITE (unit_nr, *) label, "LS| had to quench curvature" @@ -376,7 +376,7 @@ SUBROUTINE linesearch_2pnt(this, energy, slope, step_size, is_done, unit_nr, lab ENDIF step_size = -b/(2.0_dp*a) - pred_energy = a*step_size**2+b*step_size+c + pred_energy = a*step_size**2 + b*step_size + c IF (unit_nr > 0) WRITE (unit_nr, *) label, "LS| 2pnt suggested step_size: ", step_size IF (unit_nr > 0) WRITE (unit_nr, *) label, "LS| 2pnt predicted energy", pred_energy @@ -450,13 +450,13 @@ SUBROUTINE linesearch_3pnt(this, energy, step_size, is_done, unit_nr, label) IF (unit_nr > 0) WRITE (unit_nr, *) label, "LS| 3pnt energies: ", this%energies ! Cramer's Rule - denom = (x1-x2)*(x1-x3)*(x2-x3) - a = (x3*(y2-y1)+x2*(y1-y3)+x1*(y3-y2))/denom - b = (x3**2*(y1-y2)+x2**2*(y3-y1)+x1**2*(y2-y3))/denom - c = (x2*x3*(x2-x3)*y1+x3*x1*(x3-x1)*y2+x1*x2*(x1-x2)*y3)/denom + denom = (x1 - x2)*(x1 - x3)*(x2 - x3) + a = (x3*(y2 - y1) + x2*(y1 - y3) + x1*(y3 - y2))/denom + b = (x3**2*(y1 - y2) + x2**2*(y3 - y1) + x1**2*(y2 - y3))/denom + c = (x2*x3*(x2 - x3)*y1 + x3*x1*(x3 - x1)*y2 + x1*x2*(x1 - x2)*y3)/denom step_size = -b/(2.0_dp*a) - pred_energy = a*step_size**2+b*step_size+c + pred_energy = a*step_size**2 + b*step_size + c IF (unit_nr > 0) WRITE (unit_nr, *) label, "LS| 3pnt suggested step_size: ", step_size IF (unit_nr > 0) WRITE (unit_nr, *) label, "LS| 3pnt predicted energy", pred_energy @@ -511,7 +511,7 @@ SUBROUTINE linesearch_adapt(this, energy, step_size, is_done, unit_nr, label) y1, y2, y3 is_done = .FALSE. - this%count = this%count+1 + this%count = this%count + 1 IF (.NOT. this%have_left) THEN this%left_x = 0.0_dp @@ -568,10 +568,10 @@ SUBROUTINE linesearch_adapt(this, energy, step_size, is_done, unit_nr, label) x1 = this%left_x; x2 = this%middle_x; x3 = this%right_x ! Cramer's rule - denom = (x1-x2)*(x1-x3)*(x2-x3) - a = (x3*(y2-y1)+x2*(y1-y3)+x1*(y3-y2))/denom - b = (x3**2*(y1-y2)+x2**2*(y3-y1)+x1**2*(y2-y3))/denom - c = (x2*x3*(x2-x3)*y1+x3*x1*(x3-x1)*y2+x1*x2*(x1-x2)*y3)/denom + denom = (x1 - x2)*(x1 - x3)*(x2 - x3) + a = (x3*(y2 - y1) + x2*(y1 - y3) + x1*(y3 - y2))/denom + b = (x3**2*(y1 - y2) + x2**2*(y3 - y1) + x1**2*(y2 - y3))/denom + c = (x2*x3*(x2 - x3)*y1 + x3*x1*(x3 - x1)*y2 + x1*x2*(x1 - x2)*y3)/denom IF (ABS(a) /= 0.0_dp) THEN step_size = -b/(2.0_dp*a) @@ -580,7 +580,7 @@ SUBROUTINE linesearch_adapt(this, energy, step_size, is_done, unit_nr, label) ENDIF CPASSERT(step_size >= 0.0_dp) - pred_energy = a*step_size**2+b*step_size+c + pred_energy = a*step_size**2 + b*step_size + c IF (unit_nr > 0) WRITE (unit_nr, *) label, "LS| adapt: suggested step_size: ", step_size IF (unit_nr > 0) WRITE (unit_nr, *) label, "LS| adapt: predicted energy", pred_energy @@ -621,7 +621,7 @@ SUBROUTINE linesearch_gold(this, energy, step_size, is_done, unit_nr, label) CHARACTER(len=*), PARAMETER :: routineN = 'linesearch_gold', & routineP = moduleN//':'//routineN - REAL(KIND=dp), PARAMETER :: phi = (1.0_dp+SQRT(5.0_dp))/2.0_dp + REAL(KIND=dp), PARAMETER :: phi = (1.0_dp + SQRT(5.0_dp))/2.0_dp REAL(KIND=dp) :: a, b, d @@ -672,8 +672,8 @@ SUBROUTINE linesearch_gold(this, energy, step_size, is_done, unit_nr, label) ENDIF ELSE !up and running - a = this%middle_x-this%left_x - b = this%right_x-this%middle_x + a = this%middle_x - this%left_x + b = this%right_x - this%middle_x IF (energy < this%middle_e) THEN IF (a < b) THEN this%left_e = this%middle_e @@ -700,18 +700,18 @@ SUBROUTINE linesearch_gold(this, energy, step_size, is_done, unit_nr, label) IF (unit_nr > 0) WRITE (unit_nr, *) label, "LS| gold: ", this%left_e, this%middle_e, this%right_e IF (this%have_left .AND. this%have_middle .AND. this%have_right) THEN - a = this%middle_x-this%left_x - b = this%right_x-this%middle_x - IF (ABS(MIN(a, b)*phi-MAX(a, b)) > 1.0E-10) & + a = this%middle_x - this%left_x + b = this%right_x - this%middle_x + IF (ABS(MIN(a, b)*phi - MAX(a, b)) > 1.0E-10) & CPABORT("golden-ratio gone") IF (a < b) THEN - step_size = this%middle_x+a/phi + step_size = this%middle_x + a/phi ELSE - step_size = this%middle_x-b/phi + step_size = this%middle_x - b/phi END IF - d = ABS(this%right_x-this%left_x)/(ABS(this%middle_x)+ABS(step_size)) + d = ABS(this%right_x - this%left_x)/(ABS(this%middle_x) + ABS(step_size)) IF (d < this%eps_step_size) THEN step_size = this%middle_x this%last_step_size = step_size diff --git a/src/lri_compression.F b/src/lri_compression.F index 700579cc7a..baea324c7c 100644 --- a/src/lri_compression.F +++ b/src/lri_compression.F @@ -75,7 +75,7 @@ SUBROUTINE lri_comp(aval, amax, cont) ii = 0 DO ib = 1, nb DO ia = 1, na - ii = ii+1 + ii = ii + 1 ca%cdp(ii) = aval(ia, ib, i) END DO END DO @@ -85,7 +85,7 @@ SUBROUTINE lri_comp(aval, amax, cont) ii = 0 DO ib = 1, nb DO ia = 1, na - ii = ii+1 + ii = ii + 1 ca%csp(ii) = REAL(aval(ia, ib, i), KIND=sp) END DO END DO @@ -113,13 +113,13 @@ FUNCTION lri_cont_mem(cont) RESULT(cmem) IF (ASSOCIATED(cont%ca)) THEN DO i = 1, SIZE(cont%ca) IF (ASSOCIATED(cont%ca(i)%cdp)) THEN - cmem = cmem+SIZE(cont%ca(i)%cdp) + cmem = cmem + SIZE(cont%ca(i)%cdp) END IF IF (ASSOCIATED(cont%ca(i)%csp)) THEN - cmem = cmem+0.5_dp*SIZE(cont%ca(i)%csp) + cmem = cmem + 0.5_dp*SIZE(cont%ca(i)%csp) END IF IF (ASSOCIATED(cont%ca(i)%cip)) THEN - cmem = cmem+SIZE(cont%ca(i)%cip) + cmem = cmem + SIZE(cont%ca(i)%cip) END IF END DO END IF @@ -157,7 +157,7 @@ SUBROUTINE lri_decomp_i(aval, cont, ival) ii = 0 DO ib = 1, nb DO ia = 1, na - ii = ii+1 + ii = ii + 1 aval(ia, ib) = ca%cdp(ii) END DO END DO @@ -165,7 +165,7 @@ SUBROUTINE lri_decomp_i(aval, cont, ival) ii = 0 DO ib = 1, nb DO ia = 1, na - ii = ii+1 + ii = ii + 1 aval(ia, ib) = REAL(ca%csp(ii), KIND=dp) END DO END DO diff --git a/src/lri_environment_init.F b/src/lri_environment_init.F index 8b4e500741..230bc48ed5 100644 --- a/src/lri_environment_init.F +++ b/src/lri_environment_init.F @@ -287,9 +287,9 @@ SUBROUTINE lri_env_basis(ri_type, qs_env, lri_env, qs_kind_set) DO iat = 1, natom ikind = kind_of(iat) nribas = lri_env%ri_basis(ikind)%gto_basis_set%nsgf - lri_env%ri_fit%bas_ptr(1, iat) = nbas+1 - lri_env%ri_fit%bas_ptr(2, iat) = nbas+nribas - nbas = nbas+nribas + lri_env%ri_fit%bas_ptr(1, iat) = nbas + 1 + lri_env%ri_fit%bas_ptr(2, iat) = nbas + nribas + nbas = nbas + nribas END DO ! initialize vector t CALL get_qs_env(qs_env=qs_env, dft_control=dft_control) @@ -435,7 +435,7 @@ SUBROUTINE basis_norm_s_func(basis, norm) DO ishell = 1, basis%nshell(iset) l = basis%l(ishell, iset) IF (l /= 0) CYCLE - expa = 0.5_dp*REAL(2*l+3, dp) + expa = 0.5_dp*REAL(2*l + 3, dp) ppl = pi**(3._dp/2._dp) DO isgf = basis%first_sgf(ishell, iset), basis%last_sgf(ishell, iset) DO ipgf = 1, basis%npgf(iset) @@ -444,7 +444,7 @@ SUBROUTINE basis_norm_s_func(basis, norm) DO jpgf = 1, basis%npgf(iset) ccj = basis%gcc(jpgf, ishell, iset) aaj = basis%zet(jpgf, iset) - norm(isgf) = norm(isgf)+cci*ccj*ppl/(aai+aaj)**expa + norm(isgf) = norm(isgf) + cci*ccj*ppl/(aai + aaj)**expa END DO END DO norm(isgf) = 1.0_dp/SQRT(norm(isgf)) @@ -480,8 +480,8 @@ SUBROUTINE basis_norm_radial(basis, norm) DO iset = 1, basis%nset DO ishell = 1, basis%nshell(iset) l = basis%l(ishell, iset) - expa = 0.5_dp*REAL(2*l+3, dp) - ppl = fac(2*l+2)*SQRT(pi)/2._dp**REAL(2*l+3, dp)/fac(l+1) + expa = 0.5_dp*REAL(2*l + 3, dp) + ppl = fac(2*l + 2)*SQRT(pi)/2._dp**REAL(2*l + 3, dp)/fac(l + 1) DO isgf = basis%first_sgf(ishell, iset), basis%last_sgf(ishell, iset) DO ipgf = 1, basis%npgf(iset) cci = basis%gcc(ipgf, ishell, iset) @@ -489,7 +489,7 @@ SUBROUTINE basis_norm_radial(basis, norm) DO jpgf = 1, basis%npgf(iset) ccj = basis%gcc(jpgf, ishell, iset) aaj = basis%zet(jpgf, iset) - norm(isgf) = norm(isgf)+cci*ccj*ppl/(aai+aaj)**expa + norm(isgf) = norm(isgf) + cci*ccj*ppl/(aai + aaj)**expa END DO END DO norm(isgf) = 1.0_dp/SQRT(norm(isgf)) @@ -529,7 +529,7 @@ SUBROUTINE basis_int(basis, int_aux, norm) cc = basis%gcc(ipgf, ishell, iset) aa = basis%zet(ipgf, iset) pp = (pi/aa)**(3._dp/2._dp) - int_aux(isgf) = int_aux(isgf)+norm(isgf)*cc*pp + int_aux(isgf) = int_aux(isgf) + norm(isgf)*cc*pp END DO END DO END DO @@ -571,8 +571,8 @@ SUBROUTINE basis_ovlp(basis, ovlp, norm) lj = basis%l(jshell, jset) IF (li == lj) THEN l = li - expa = 0.5_dp*REAL(2*l+3, dp) - ppl = fac(2*l+2)*SQRT(pi)/2._dp**REAL(2*l+3, dp)/fac(l+1) + expa = 0.5_dp*REAL(2*l + 3, dp) + ppl = fac(2*l + 2)*SQRT(pi)/2._dp**REAL(2*l + 3, dp)/fac(l + 1) DO isgf = basis%first_sgf(ishell, iset), basis%last_sgf(ishell, iset) m_i = basis%m(isgf) DO jsgf = basis%first_sgf(jshell, jset), basis%last_sgf(jshell, jset) @@ -585,9 +585,9 @@ SUBROUTINE basis_ovlp(basis, ovlp, norm) DO jpgf = 1, basis%npgf(jset) ccj = basis%gcc(jpgf, jshell, jset) aaj = basis%zet(jpgf, jset) - oo = 1._dp/(aai+aaj)**expa + oo = 1._dp/(aai + aaj)**expa norm_j = norm(jsgf) - ovlp(isgf, jsgf) = ovlp(isgf, jsgf)+norm_i*norm_j*ppl*cci*ccj*oo + ovlp(isgf, jsgf) = ovlp(isgf, jsgf) + norm_i*norm_j*ppl*cci*ccj*oo END DO END DO ENDIF diff --git a/src/lri_environment_methods.F b/src/lri_environment_methods.F index 34d22c06ec..239aab9b5e 100644 --- a/src/lri_environment_methods.F +++ b/src/lri_environment_methods.F @@ -198,7 +198,7 @@ SUBROUTINE calculate_lri_integrals(lri_env, qs_env) CALL get_iterator_info(nl_iterator, mepos=mepos, ikind=ikind, jkind=jkind, & nlist=nlist, ilist=ilist, nnode=nneighbor, inode=jneighbor, & iatom=iatom, jatom=jatom, r=rab) - iac = ikind+nkind*(jkind-1) + iac = ikind + nkind*(jkind - 1) dab = SQRT(SUM(rab*rab)) obasa => lri_env%orb_basis(ikind)%gto_basis_set @@ -230,7 +230,7 @@ SUBROUTINE calculate_lri_integrals(lri_env, qs_env) IF (e1c .AND. lri_env%exact_1c_terms) THEN ! nothing to do ELSE - cptt = cptt+1.0_dp + cptt = cptt + 1.0_dp nba = obasa%nsgf nbb = obasb%nsgf @@ -251,19 +251,19 @@ SUBROUTINE calculate_lri_integrals(lri_env, qs_env) ! store abaint/abbint in compressed form IF (e1c) THEN CALL lri_comp(lriint%abaint, lrii%abascr, lrii%cabai) - cmem = cmem+lri_cont_mem(lrii%cabai) + cmem = cmem + lri_cont_mem(lrii%cabai) ELSE CALL lri_comp(lriint%abaint, lrii%abascr, lrii%cabai) - cmem = cmem+lri_cont_mem(lrii%cabai) + cmem = cmem + lri_cont_mem(lrii%cabai) CALL lri_comp(lriint%abbint, lrii%abbscr, lrii%cabbi) - cmem = cmem+lri_cont_mem(lrii%cabbi) + cmem = cmem + lri_cont_mem(lrii%cabbi) END IF ! store overlap lrii%soo(1:nba, 1:nbb) = lriint%sooint(1:nba, 1:nbb) ! Full LRI method IF (lrii%lrisr) THEN - cpsr = cpsr+1.0_dp + cpsr = cpsr + 1.0_dp ! construct and invert S matrix ! calculate Sinv*n and n*Sinv*n IF (e1c) THEN @@ -273,11 +273,11 @@ SUBROUTINE calculate_lri_integrals(lri_env, qs_env) lrii%n(1), 1, 0.0_dp, lrii%sn, 1) lrii%nsn = SUM(lrii%sn(1:nfa)*lrii%n(1:nfa)) ELSE - nn = nfa+nfb + nn = nfa + nfb CALL inverse_lri_overlap(lri_env, lrii%sinv, lri_env%bas_prop(ikind)%ri_ovlp, & lri_env%bas_prop(jkind)%ri_ovlp, lriint%sabint) lrii%n(1:nfa) = lri_env%bas_prop(ikind)%int_fbas(1:nfa) - lrii%n(nfa+1:nn) = lri_env%bas_prop(jkind)%int_fbas(1:nfb) + lrii%n(nfa + 1:nn) = lri_env%bas_prop(jkind)%int_fbas(1:nfb) CALL dgemv("N", nn, nn, 1.0_dp, lrii%sinv(1, 1), nn, & lrii%n(1), 1, 0.0_dp, lrii%sn, 1) lrii%nsn = SUM(lrii%sn(1:nn)*lrii%n(1:nn)) @@ -291,7 +291,7 @@ SUBROUTINE calculate_lri_integrals(lri_env, qs_env) ! Distant Pair methods IF (lrii%lriff) THEN - cpff = cpff+1.0_dp + cpff = cpff + 1.0_dp CPASSERT(.NOT. e1c) CPASSERT(.NOT. lri_env%store_integrals) ! calculate Sinv*n and n*Sinv*n for A and B centers @@ -311,10 +311,10 @@ SUBROUTINE calculate_lri_integrals(lri_env, qs_env) END DO !$OMP CRITICAL(UPDATE) - lri_env%stat%pairs_tt = lri_env%stat%pairs_tt+cptt - lri_env%stat%pairs_sr = lri_env%stat%pairs_sr+cpsr - lri_env%stat%pairs_ff = lri_env%stat%pairs_ff+cpff - lri_env%stat%abai_mem = lri_env%stat%abai_mem+cmem + lri_env%stat%pairs_tt = lri_env%stat%pairs_tt + cptt + lri_env%stat%pairs_sr = lri_env%stat%pairs_sr + cpsr + lri_env%stat%pairs_ff = lri_env%stat%pairs_ff + cpff + lri_env%stat%abai_mem = lri_env%stat%abai_mem + cmem !$OMP END CRITICAL(UPDATE) !$OMP END PARALLEL @@ -447,7 +447,7 @@ SUBROUTINE calculate_lri_ppl_integrals(lri_env, qs_env, calculate_forces) ALLOCATE (lri_ppl_coef(ikind)%acoef(na, nb)) lri_ppl_coef(ikind)%acoef = 0.0_dp DO ispin = 1, nspin - lri_ppl_coef(ikind)%acoef(1:na, 1:nb) = lri_ppl_coef(ikind)%acoef(1:na, 1:nb)+ & + lri_ppl_coef(ikind)%acoef(1:na, 1:nb) = lri_ppl_coef(ikind)%acoef(1:na, 1:nb) + & lri_density%lri_coefs(ispin)%lri_kinds(ikind)%acoef(1:na, 1:nb) END DO END IF @@ -529,7 +529,7 @@ SUBROUTINE calculate_lri_overlap_aabb(lri_env, qs_env) nlist=nlist, ilist=ilist, nnode=nneighbor, inode=jneighbor, & iatom=iatom, jatom=jatom, r=rab) - iac = ikind+nkind*(jkind-1) + iac = ikind + nkind*(jkind - 1) dab = SQRT(SUM(rab*rab)) obasa => lri_env%orb_basis(ikind)%gto_basis_set @@ -661,7 +661,7 @@ SUBROUTINE calculate_avec_lri(lri_env, lri_density, pmatrix, cell_to_index) jatom=jatom, nlist=nlist, ilist=ilist, nnode=nneighbor, inode=jneighbor, & r=rab, cell=cell) - iac = ikind+nkind*(jkind-1) + iac = ikind + nkind*(jkind - 1) dab = SQRT(SUM(rab*rab)) IF (.NOT. ASSOCIATED(lri_env%lri_ints%lri_atom(iac)%lri_node)) CYCLE @@ -693,7 +693,7 @@ SUBROUTINE calculate_avec_lri(lri_env, lri_density, pmatrix, cell_to_index) nfa = lrii%nfa nfb = lrii%nfb - nn = nfa+nfb + nn = nfa + nfb ! compute tvec = SUM_ab Pab *(a,b,x) and charge constraint ALLOCATE (pab(nba, nbb)) @@ -714,7 +714,7 @@ SUBROUTINE calculate_avec_lri(lri_env, lri_density, pmatrix, cell_to_index) IF (dab > lri_env%delta) THEN DO i = 1, nfb CALL lri_decomp_i(int3, lrii%cabbi, i) - lrho%tvec(nfa+i) = SUM(pab(1:nba, 1:nbb)*int3(1:nba, 1:nbb)) + lrho%tvec(nfa + i) = SUM(pab(1:nba, 1:nbb)*int3(1:nba, 1:nbb)) END DO ENDIF ! @@ -723,17 +723,17 @@ SUBROUTINE calculate_avec_lri(lri_env, lri_density, pmatrix, cell_to_index) ELSE lrho%nst = SUM(lrho%tvec(1:nn)*lrii%sn(1:nn)) ENDIF - lrho%lambda = (lrho%charge-lrho%nst)/lrii%nsn + lrho%lambda = (lrho%charge - lrho%nst)/lrii%nsn ! ! solve the linear system of equations ALLOCATE (m(nn)) m = 0._dp IF (iatom == jatom .AND. dab < lri_env%delta) THEN - m(1:nfa) = lrho%tvec(1:nfa)+lrho%lambda*lrii%n(1:nfa) + m(1:nfa) = lrho%tvec(1:nfa) + lrho%lambda*lrii%n(1:nfa) CALL dgemv("N", nfa, nfa, 1.0_dp, lrii%sinv(1, 1), nfa, & m(1), 1, 0.0_dp, lrho%avec, 1) ELSE - m(1:nn) = lrho%tvec(1:nn)+lrho%lambda*lrii%n(1:nn) + m(1:nn) = lrho%tvec(1:nn) + lrho%lambda*lrii%n(1:nn) CALL dgemv("N", nn, nn, 1.0_dp, lrii%sinv(1, 1), nn, & m(1), 1, 0.0_dp, lrho%avec, 1) ENDIF @@ -744,7 +744,7 @@ SUBROUTINE calculate_avec_lri(lri_env, lri_density, pmatrix, cell_to_index) ! distant pair approximations ALLOCATE (paa(nba, nbb), pbb(nba, nbb)) paa(1:nba, 1:nbb) = pab(1:nba, 1:nbb)*lri_env%wmat(ikind, jkind)%mat(1:nba, 1:nbb) - pbb(1:nba, 1:nbb) = pab(1:nba, 1:nbb)*(1._dp-lri_env%wmat(ikind, jkind)%mat(1:nba, 1:nbb)) + pbb(1:nba, 1:nbb) = pab(1:nba, 1:nbb)*(1._dp - lri_env%wmat(ikind, jkind)%mat(1:nba, 1:nbb)) ! threshold = lri_env%eps_o3_int/MAX(SUM(ABS(paa(1:nba, 1:nbb))), 1.0e-14_dp) lrho%chargea = SUM(paa(1:nba, 1:nbb)*lrii%soo(1:nba, 1:nbb)) @@ -769,16 +769,16 @@ SUBROUTINE calculate_avec_lri(lri_env, lri_density, pmatrix, cell_to_index) ! lrho%nsta = SUM(lrho%tveca(1:nfa)*lrii%sna(1:nfa)) lrho%nstb = SUM(lrho%tvecb(1:nfb)*lrii%snb(1:nfb)) - lrho%lambdaa = (lrho%chargea-lrho%nsta)/lrii%nsna - lrho%lambdab = (lrho%chargeb-lrho%nstb)/lrii%nsnb + lrho%lambdaa = (lrho%chargea - lrho%nsta)/lrii%nsna + lrho%lambdab = (lrho%chargeb - lrho%nstb)/lrii%nsnb ! solve the linear system of equations ALLOCATE (m(nfa)) - m(1:nfa) = lrho%tveca(1:nfa)+lrho%lambdaa*lrii%na(1:nfa) + m(1:nfa) = lrho%tveca(1:nfa) + lrho%lambdaa*lrii%na(1:nfa) CALL dgemv("N", nfa, nfa, 1.0_dp, lrii%asinv(1, 1), nfa, & m(1), 1, 0.0_dp, lrho%aveca, 1) DEALLOCATE (m) ALLOCATE (m(nfb)) - m(1:nfb) = lrho%tvecb(1:nfb)+lrho%lambdab*lrii%nb(1:nfb) + m(1:nfb) = lrho%tvecb(1:nfb) + lrho%lambdab*lrii%nb(1:nfb) CALL dgemv("N", nfb, nfb, 1.0_dp, lrii%bsinv(1, 1), nfb, & m(1), 1, 0.0_dp, lrho%avecb, 1) DEALLOCATE (m) @@ -880,7 +880,7 @@ SUBROUTINE distribute_lri_density_on_the_grid(lri_env, lri_density, qs_env, & atom_b = atom_of_kind(jatom) aci => lri_coef(ikind)%acoef(atom_a, :) acj => lri_coef(jkind)%acoef(atom_b, :) - iac = ikind+nkind*(jkind-1) + iac = ikind + nkind*(jkind - 1) lrho => lri_rho%lri_atom(iac)%lri_node(ilist)%lri_rhoab(jneighbor) lrii => lri_env%lri_ints%lri_atom(iac)%lri_node(ilist)%lri_int(jneighbor) nfa = lrho%nfa @@ -890,8 +890,8 @@ SUBROUTINE distribute_lri_density_on_the_grid(lri_env, lri_density, qs_env, & IF (iatom == jatom .AND. dab < lri_env%delta) THEN !self pair aa IF (.NOT. lri_env%exact_1c_terms) THEN - aci(1:nfa) = aci(1:nfa)+lrho%avec(1:nfa) - lri_env%stat%rho_sr = lri_env%stat%rho_sr+SUM(lrho%avec(:)*lrii%n(:)) + aci(1:nfa) = aci(1:nfa) + lrho%avec(1:nfa) + lri_env%stat%rho_sr = lri_env%stat%rho_sr + SUM(lrho%avec(:)*lrii%n(:)) END IF ELSE IF (iatom == jatom) THEN @@ -901,9 +901,9 @@ SUBROUTINE distribute_lri_density_on_the_grid(lri_env, lri_density, qs_env, & !pairs ab fw = 2.0_dp*lrii%wsr ENDIF - aci(1:nfa) = aci(1:nfa)+fw*lrho%avec(1:nfa) - acj(1:nfb) = acj(1:nfb)+fw*lrho%avec(nfa+1:nfa+nfb) - lri_env%stat%rho_sr = lri_env%stat%rho_sr+fw*SUM(lrho%avec(:)*lrii%n(:)) + aci(1:nfa) = aci(1:nfa) + fw*lrho%avec(1:nfa) + acj(1:nfb) = acj(1:nfb) + fw*lrho%avec(nfa + 1:nfa + nfb) + lri_env%stat%rho_sr = lri_env%stat%rho_sr + fw*SUM(lrho%avec(:)*lrii%n(:)) ENDIF ENDIF ! @@ -913,10 +913,10 @@ SUBROUTINE distribute_lri_density_on_the_grid(lri_env, lri_density, qs_env, & ELSE fw = 2.0_dp*lrii%wff ENDIF - aci(1:nfa) = aci(1:nfa)+fw*lrho%aveca(1:nfa) - acj(1:nfb) = acj(1:nfb)+fw*lrho%avecb(1:nfb) - lri_env%stat%rho_sr = lri_env%stat%rho_sr+fw*SUM(lrho%aveca(:)*lrii%na(:)) - lri_env%stat%rho_sr = lri_env%stat%rho_sr+fw*SUM(lrho%avecb(:)*lrii%nb(:)) + aci(1:nfa) = aci(1:nfa) + fw*lrho%aveca(1:nfa) + acj(1:nfb) = acj(1:nfb) + fw*lrho%avecb(1:nfb) + lri_env%stat%rho_sr = lri_env%stat%rho_sr + fw*SUM(lrho%aveca(:)*lrii%na(:)) + lri_env%stat%rho_sr = lri_env%stat%rho_sr + fw*SUM(lrho%avecb(:)*lrii%nb(:)) ENDIF END DO @@ -946,7 +946,7 @@ SUBROUTINE distribute_lri_density_on_the_grid(lri_env, lri_density, qs_env, & CALL dbcsr_get_block_diag(matrix_p(ispin, 1)%matrix, pmat_diag) str = 0.0_dp CALL dbcsr_dot(matrix_s(1, 1)%matrix, pmat_diag, str) - lri_env%stat%rho_1c = lri_env%stat%rho_1c+str + lri_env%stat%rho_1c = lri_env%stat%rho_1c + str CALL dbcsr_replicate_all(pmat_diag) END IF ! @@ -954,7 +954,7 @@ SUBROUTINE distribute_lri_density_on_the_grid(lri_env, lri_density, qs_env, & rho_r(ispin), qs_env, & lri_density%lri_coefs(ispin)%lri_kinds, tot_rho_r(ispin), & "LRI_AUX", lri_env%exact_1c_terms, pmat=pmat_diag) - lri_env%stat%rho_tt = lri_env%stat%rho_tt+tot_rho_r(ispin) + lri_env%stat%rho_tt = lri_env%stat%rho_tt + tot_rho_r(ispin) ! IF (lri_env%exact_1c_terms) CALL dbcsr_release(pmat_diag) ENDDO @@ -995,14 +995,14 @@ SUBROUTINE inverse_lri_overlap(lri_env, sinv, sa, sb, sab) nfa = SIZE(sa, 1) nfb = SIZE(sb, 1) - nn = nfa+nfb + nn = nfa + nfb n = SIZE(sinv, 1) CPASSERT(n == nn) ALLOCATE (s(n, n)) s(1:nfa, 1:nfa) = sa(1:nfa, 1:nfa) - s(1:nfa, nfa+1:nn) = sab(1:nfa, 1:nfb) - s(nfa+1:nn, 1:nfa) = TRANSPOSE(sab(1:nfa, 1:nfb)) - s(nfa+1:nn, nfa+1:nn) = sb(1:nfb, 1:nfb) + s(1:nfa, nfa + 1:nn) = sab(1:nfa, 1:nfb) + s(nfa + 1:nn, 1:nfa) = TRANSPOSE(sab(1:nfa, 1:nfb)) + s(nfa + 1:nn, nfa + 1:nn) = sb(1:nfb, 1:nfb) rskip = 1.E-8_dp ! parameter for pseudo inverse @@ -1068,7 +1068,7 @@ FUNCTION inv_test(amat, ainv) RESULT(delta) ALLOCATE (work(n, n)) work(1:n, 1:n) = MATMUL(amat(1:n, 1:n), ainv(1:n, 1:n)) DO i = 1, n - work(i, i) = work(i, i)-1.0_dp + work(i, i) = work(i, i) - 1.0_dp END DO delta = MAXVAL(ABS(work)) DEALLOCATE (work) @@ -1121,7 +1121,7 @@ SUBROUTINE output_debug_info(lri_env, qs_env, lri_ints, soo_list) CALL get_iterator_info(nl_iterator, ikind=ikind, jkind=jkind, & ilist=ilist, inode=jneighbor) - iac = ikind+nkind*(jkind-1) + iac = ikind + nkind*(jkind - 1) lrii => lri_ints%lri_atom(iac)%lri_node(ilist)%lri_int(jneighbor) dmax_ab = MAX(dmax_ab, lrii%dmax_ab) @@ -1196,7 +1196,7 @@ SUBROUTINE v_int_ppl_update(qs_env, lri_v_int, calculate_forces) v_int => lri_env%lri_ppl_ints%lri_ppl(ikind)%v_int CPASSERT(SIZE(v_int, 1) == natom) CPASSERT(SIZE(v_int, 2) == nfa) - lri_v_int(ikind)%v_int(:, :) = lri_v_int(ikind)%v_int(:, :)+v_int(:, :) + lri_v_int(ikind)%v_int(:, :) = lri_v_int(ikind)%v_int(:, :) + v_int(:, :) END DO IF (calculate_forces) THEN @@ -1230,7 +1230,7 @@ SUBROUTINE v_int_ppl_energy(qs_env, lri_v_int, ecore_ppl_ri) v_int => lri_env%lri_ppl_ints%lri_ppl(ikind)%v_int CPASSERT(SIZE(v_int, 1) == natom) CPASSERT(SIZE(v_int, 2) == nfa) - ecore_ppl_ri = ecore_ppl_ri+SUM(v_int(:, :)*lri_v_int(ikind)%acoef(:, :)) + ecore_ppl_ri = ecore_ppl_ri + SUM(v_int(:, :)*lri_v_int(ikind)%acoef(:, :)) END DO END SUBROUTINE v_int_ppl_energy diff --git a/src/lri_environment_types.F b/src/lri_environment_types.F index 60af1c8d74..95be7f87b8 100644 --- a/src/lri_environment_types.F +++ b/src/lri_environment_types.F @@ -396,7 +396,7 @@ SUBROUTINE lri_env_create(lri_env) ALLOCATE (lri_env) - last_lri_env_id = last_lri_env_id+1 + last_lri_env_id = last_lri_env_id + 1 lri_env%id_nr = last_lri_env_id lri_env%ref_count = 1 lri_env%in_use = 0 @@ -578,7 +578,7 @@ SUBROUTINE lri_density_create(lri_density) ALLOCATE (lri_density) - last_lri_density_id = last_lri_density_id+1 + last_lri_density_id = last_lri_density_id + 1 lri_density%id_nr = last_lri_density_id lri_density%ref_count = 1 lri_density%in_use = 0 @@ -662,7 +662,7 @@ SUBROUTINE allocate_lri_ints(lri_env, lri_ints, nkind) nlist=nlist, ilist=ilist, nnode=nneighbor, inode=jneighbor, & iatom=iatom, jatom=jatom, r=rab) - iac = ikind+nkind*(jkind-1) + iac = ikind + nkind*(jkind - 1) dab = SQRT(SUM(rab*rab)) obasa => lri_env%orb_basis(ikind)%gto_basis_set @@ -692,7 +692,7 @@ SUBROUTINE allocate_lri_ints(lri_env, lri_ints, nkind) nbb = obasb%nsgf nfa = fbasa%nsgf nfb = fbasb%nsgf - nn = nfa+nfb + nn = nfa + nfb IF (iatom == jatom .AND. dab < lri_env%delta) THEN e1c = lri_env%exact_1c_terms @@ -705,12 +705,12 @@ SUBROUTINE allocate_lri_ints(lri_env, lri_ints, nkind) lrii%abascr = 0._dp ALLOCATE (lrii%abbscr(nfb)) lrii%abbscr = 0._dp - lri_env%stat%oint_mem = lri_env%stat%oint_mem+nfa+nfb + lri_env%stat%oint_mem = lri_env%stat%oint_mem + nfa + nfb END IF IF (dpa) THEN lrii%wsr = pswitch(dab, ra, rb, 0) - lrii%wff = 1.0_dp-lrii%wsr + lrii%wff = 1.0_dp - lrii%wsr lrii%dwsr = pswitch(dab, ra, rb, 1) lrii%dwff = -lrii%dwsr lrii%lrisr = (lrii%wsr > 0.0_dp) @@ -736,24 +736,24 @@ SUBROUTINE allocate_lri_ints(lri_env, lri_ints, nkind) NULLIFY (lrii%sinv) ELSE ALLOCATE (lrii%soo(nba, nbb)) - lri_env%stat%oint_mem = lri_env%stat%oint_mem+nba*nbb + lri_env%stat%oint_mem = lri_env%stat%oint_mem + nba*nbb lrii%soo = 0._dp IF (iatom == jatom .AND. dab < lri_env%delta) THEN ALLOCATE (lrii%sinv(nfa, nfa)) - lri_env%stat%oint_mem = lri_env%stat%oint_mem+nfa*nfa + lri_env%stat%oint_mem = lri_env%stat%oint_mem + nfa*nfa ELSE ALLOCATE (lrii%sinv(nn, nn)) - lri_env%stat%oint_mem = lri_env%stat%oint_mem+nn*nn + lri_env%stat%oint_mem = lri_env%stat%oint_mem + nn*nn ENDIF lrii%sinv = 0._dp IF (iatom == jatom .AND. dab < lri_env%delta) THEN ALLOCATE (lrii%n(nfa), lrii%sn(nfa)) - lri_env%stat%oint_mem = lri_env%stat%oint_mem+2.*nfa + lri_env%stat%oint_mem = lri_env%stat%oint_mem + 2.*nfa ELSE ALLOCATE (lrii%n(nn), lrii%sn(nn)) - lri_env%stat%oint_mem = lri_env%stat%oint_mem+2.*nn + lri_env%stat%oint_mem = lri_env%stat%oint_mem + 2.*nn ENDIF lrii%n = 0._dp lrii%sn = 0._dp @@ -768,16 +768,16 @@ SUBROUTINE allocate_lri_ints(lri_env, lri_ints, nkind) lrii%asinv => lri_env%bas_prop(ikind)%ri_ovlp_inv lrii%bsinv => lri_env%bas_prop(jkind)%ri_ovlp_inv ALLOCATE (lrii%na(nfa), lrii%sna(nfa)) - lri_env%stat%oint_mem = lri_env%stat%oint_mem+2.*nfa + lri_env%stat%oint_mem = lri_env%stat%oint_mem + 2.*nfa lrii%na = 0._dp lrii%sna = 0._dp ALLOCATE (lrii%nb(nfb), lrii%snb(nfb)) - lri_env%stat%oint_mem = lri_env%stat%oint_mem+2.*nfb + lri_env%stat%oint_mem = lri_env%stat%oint_mem + 2.*nfb lrii%nb = 0._dp lrii%snb = 0._dp IF (.NOT. ALLOCATED(lrii%soo)) THEN ALLOCATE (lrii%soo(nba, nbb)) - lri_env%stat%oint_mem = lri_env%stat%oint_mem+nba*nbb + lri_env%stat%oint_mem = lri_env%stat%oint_mem + nba*nbb lrii%soo = 0._dp ELSE CPASSERT(SIZE(lrii%soo, 1) == nba .AND. SIZE(lrii%soo, 2) == nbb) @@ -829,7 +829,7 @@ SUBROUTINE allocate_lri_ppl_ints(lri_env, lri_ppl_ints, atomic_kind_set) atomic_kind => atomic_kind_set(ikind) CALL get_atomic_kind(atomic_kind=atomic_kind, natom=natom) ALLOCATE (lri_ppl_ints%lri_ppl(ikind)%v_int(natom, nfa)) - lri_env%stat%ppli_mem = lri_env%stat%ppli_mem+natom*nfa + lri_env%stat%ppli_mem = lri_env%stat%ppli_mem + natom*nfa END DO END SUBROUTINE allocate_lri_ppl_ints @@ -874,7 +874,7 @@ SUBROUTINE allocate_lri_ints_rho(lri_env, lri_ints_rho, nkind) nlist=nlist, ilist=ilist, nnode=nneighbor, inode=jneighbor, & iatom=iatom, jatom=jatom) - iac = ikind+nkind*(jkind-1) + iac = ikind + nkind*(jkind - 1) obasa => lri_env%orb_basis(ikind)%gto_basis_set obasb => lri_env%orb_basis(jkind)%gto_basis_set @@ -962,7 +962,7 @@ SUBROUTINE allocate_lri_rhos(lri_env, lri_rhos, nspin, nkind) iatom=iatom, jatom=jatom, nlist=nlist, ilist=ilist, & nnode=nneighbor, inode=jneighbor, r=rab) - iac = ikind+nkind*(jkind-1) + iac = ikind + nkind*(jkind - 1) dab = SQRT(SUM(rab*rab)) IF (.NOT. ASSOCIATED(lri_env%lri_ints%lri_atom(iac)%lri_node)) CYCLE @@ -990,7 +990,7 @@ SUBROUTINE allocate_lri_rhos(lri_env, lri_rhos, nspin, nkind) nfa = lrho%nfa nfb = lrho%nfb - nn = nfa+nfb + nn = nfa + nfb NULLIFY (lrho%avec, lrho%tvec) IF (lrii%lrisr) THEN @@ -998,12 +998,12 @@ SUBROUTINE allocate_lri_rhos(lri_env, lri_rhos, nspin, nkind) IF (.NOT. lri_env%exact_1c_terms) THEN ALLOCATE (lrho%avec(nfa)) ALLOCATE (lrho%tvec(nfa)) - lri_env%stat%rhos_mem = lri_env%stat%rhos_mem+2*nfa + lri_env%stat%rhos_mem = lri_env%stat%rhos_mem + 2*nfa END IF ELSE ALLOCATE (lrho%avec(nn)) ALLOCATE (lrho%tvec(nn)) - lri_env%stat%rhos_mem = lri_env%stat%rhos_mem+2*nn + lri_env%stat%rhos_mem = lri_env%stat%rhos_mem + 2*nn ENDIF END IF NULLIFY (lrho%aveca, lrho%tveca) @@ -1013,7 +1013,7 @@ SUBROUTINE allocate_lri_rhos(lri_env, lri_rhos, nspin, nkind) ALLOCATE (lrho%avecb(nfb)) ALLOCATE (lrho%tveca(nfa)) ALLOCATE (lrho%tvecb(nfb)) - lri_env%stat%rhos_mem = lri_env%stat%rhos_mem+2*(nfa+nfb) + lri_env%stat%rhos_mem = lri_env%stat%rhos_mem + 2*(nfa + nfb) END IF ENDDO @@ -1073,7 +1073,7 @@ SUBROUTINE allocate_lri_coefs(lri_env, lri_density, atomic_kind_set) ALLOCATE (lri_coefs(ispin)%lri_kinds(ikind)%v_dfdr(natom, 3)) lri_coefs(ispin)%lri_kinds(ikind)%v_dfdr = 0._dp ! - lri_env%stat%coef_mem = lri_env%stat%coef_mem+2._dp*natom*(nsgf+3) + lri_env%stat%coef_mem = lri_env%stat%coef_mem + 2._dp*natom*(nsgf + 3) END DO ENDDO @@ -1095,7 +1095,7 @@ SUBROUTINE allocate_lri_force_components(lri_force, nfa, nfb) INTEGER :: nn - nn = nfa+nfb + nn = nfa + nfb CPASSERT(.NOT. ASSOCIATED(lri_force)) diff --git a/src/lri_forces.F b/src/lri_forces.F index 760ba0caad..15c5433a41 100644 --- a/src/lri_forces.F +++ b/src/lri_forces.F @@ -132,7 +132,7 @@ SUBROUTINE calculate_lri_forces(lri_env, lri_density, qs_env, pmatrix, atomic_ki v_dfdr => lri_coef(ikind)%v_dfdr(iatom, :) force(ikind)%rho_lri_elec(:, iatom) = force(ikind)%rho_lri_elec(:, iatom) & - +v_dfdr(:)+v_dadr(:) + + v_dfdr(:) + v_dadr(:) END DO END DO @@ -238,7 +238,7 @@ SUBROUTINE calculate_v_dadr_sr(lri_env, lri_density, pmatrix, cell_to_index, ato iatom=iatom, jatom=jatom, nlist=nlist, ilist=ilist, & inode=jneighbor, r=rab, cell=cell) - iac = ikind+nkind*(jkind-1) + iac = ikind + nkind*(jkind - 1) IF (.NOT. ASSOCIATED(lri_env%lri_ints%lri_atom(iac)%lri_node)) CYCLE @@ -258,7 +258,7 @@ SUBROUTINE calculate_v_dadr_sr(lri_env, lri_density, pmatrix, cell_to_index, ato nfb = lrii%nfb nba = lrii%nba nbb = lrii%nbb - nn = nfa+nfb + nn = nfa + nfb IF (use_cell_mapping) THEN ic = cell_to_index(cell(1), cell(2), cell(3)) @@ -309,7 +309,7 @@ SUBROUTINE calculate_v_dadr_sr(lri_env, lri_density, pmatrix, cell_to_index, ato END DO DO i = 1, nfb IF (lrii%abbscr(i) > threshold) THEN - dtvec(nfa+i, k) = SUM(pab(1:nba, 1:nbb)*lridint%dabbint(1:nba, 1:nbb, i, k)) + dtvec(nfa + i, k) = SUM(pab(1:nba, 1:nbb)*lridint%dabbint(1:nba, 1:nbb, i, k)) END IF END DO ENDDO @@ -320,7 +320,7 @@ SUBROUTINE calculate_v_dadr_sr(lri_env, lri_density, pmatrix, cell_to_index, ato atom_b = atom_of_kind(jatom) ALLOCATE (vint(nn)) vint(1:nfa) = lri_coef(ikind)%v_int(atom_a, 1:nfa) - vint(nfa+1:nn) = lri_coef(jkind)%v_int(atom_b, 1:nfb) + vint(nfa + 1:nn) = lri_coef(jkind)%v_int(atom_b, 1:nfb) isn = SUM(vint(1:nn)*lrii%sn(1:nn)) DO k = 1, 3 @@ -333,25 +333,25 @@ SUBROUTINE calculate_v_dadr_sr(lri_env, lri_density, pmatrix, cell_to_index, ato !dS: dsaa and dsbb are zero, only work with ab blocks in following st(1:nn) = MATMUL(lrii%sinv(1:nn, 1:nn), lrho%tvec(1:nn)) DO k = 1, 3 - dsst(1:nfa, k) = MATMUL(lridint%dsabint(1:nfa, 1:nfb, k), st(nfa+1:nn)) - dsst(nfa+1:nn, k) = MATMUL(st(1:nfa), lridint%dsabint(1:nfa, 1:nfb, k)) + dsst(1:nfa, k) = MATMUL(lridint%dsabint(1:nfa, 1:nfb, k), st(nfa + 1:nn)) + dsst(nfa + 1:nn, k) = MATMUL(st(1:nfa), lridint%dsabint(1:nfa, 1:nfb, k)) nsdsst(k) = SUM(lrii%sn(1:nn)*dsst(1:nn, k)) - dssn(1:nfa, k) = MATMUL(lridint%dsabint(1:nfa, 1:nfb, k), lrii%sn(nfa+1:nn)) - dssn(nfa+1:nn, k) = MATMUL(lrii%sn(1:nfa), lridint%dsabint(1:nfa, 1:nfb, k)) + dssn(1:nfa, k) = MATMUL(lridint%dsabint(1:nfa, 1:nfb, k), lrii%sn(nfa + 1:nn)) + dssn(nfa + 1:nn, k) = MATMUL(lrii%sn(1:nfa), lridint%dsabint(1:nfa, 1:nfb, k)) nsdssn(k) = SUM(lrii%sn(1:nn)*dssn(1:nn, k)) nsdt(k) = SUM(dtvec(1:nn, k)*lrii%sn(1:nn)) ENDDO ! dlambda/dRa DO k = 1, 3 - dlambda(k) = (nsdsst(k)-nsdt(k))/lrii%nsn & - +(lrho%charge-lrho%nst)*nsdssn(k)/(lrii%nsn*lrii%nsn) + dlambda(k) = (nsdsst(k) - nsdt(k))/lrii%nsn & + + (lrho%charge - lrho%nst)*nsdssn(k)/(lrii%nsn*lrii%nsn) ENDDO DO k = 1, 3 - force_a(k) = force_a(k)+2.0_dp*fw*isn*dlambda(k) - force_b(k) = force_b(k)-2.0_dp*fw*isn*dlambda(k) + force_a(k) = force_a(k) + 2.0_dp*fw*isn*dlambda(k) + force_b(k) = force_b(k) - 2.0_dp*fw*isn*dlambda(k) ENDDO DO k = 1, 3 - st(1:nn) = dtvec(1:nn, k)-dsst(1:nn, k)-lrho%lambda*dssn(1:nn, k) + st(1:nn) = dtvec(1:nn, k) - dsst(1:nn, k) - lrho%lambda*dssn(1:nn, k) idav(k) = SUM(vint(1:nn)*MATMUL(lrii%sinv(1:nn, 1:nn), st(1:nn))) ENDDO @@ -361,15 +361,15 @@ SUBROUTINE calculate_v_dadr_sr(lri_env, lri_density, pmatrix, cell_to_index, ato ! sum over atom pairs DO k = 1, 3 ai = 2.0_dp*fw*idav(k) - force_a(k) = force_a(k)+ai - force_b(k) = force_b(k)-ai + force_a(k) = force_a(k) + ai + force_b(k) = force_b(k) - ai ENDDO IF (ABS(dfw) > 0.0_dp) THEN dab = SQRT(SUM(rab(1:3)*rab(1:3))) ai = 2.0_dp*dfw/dab*SUM(lrho%avec(1:nn)*vint(1:nn)) DO k = 1, 3 - force_a(k) = force_a(k)-ai*rab(k) - force_b(k) = force_b(k)+ai*rab(k) + force_a(k) = force_a(k) - ai*rab(k) + force_b(k) = force_b(k) + ai*rab(k) ENDDO END IF @@ -379,8 +379,8 @@ SUBROUTINE calculate_v_dadr_sr(lri_env, lri_density, pmatrix, cell_to_index, ato v_dadrb => lri_coef(jkind)%v_dadr(atom_b, :) !$OMP CRITICAL(addforces) DO k = 1, 3 - v_dadra(k) = v_dadra(k)+force_a(k) - v_dadrb(k) = v_dadrb(k)+force_b(k) + v_dadra(k) = v_dadra(k) + force_a(k) + v_dadrb(k) = v_dadrb(k) + force_b(k) ENDDO !$OMP END CRITICAL(addforces) @@ -504,7 +504,7 @@ SUBROUTINE calculate_v_dadr_ff(lri_env, lri_density, pmatrix, cell_to_index, ato iatom=iatom, jatom=jatom, nlist=nlist, ilist=ilist, & inode=jneighbor, r=rab, cell=cell) - iac = ikind+nkind*(jkind-1) + iac = ikind + nkind*(jkind - 1) IF (.NOT. ASSOCIATED(lri_env%lri_ints%lri_atom(iac)%lri_node)) CYCLE @@ -524,7 +524,7 @@ SUBROUTINE calculate_v_dadr_ff(lri_env, lri_density, pmatrix, cell_to_index, ato nfb = lrii%nfb nba = lrii%nba nbb = lrii%nbb - nn = nfa+nfb + nn = nfa + nfb IF (use_cell_mapping) THEN ic = cell_to_index(cell(1), cell(2), cell(3)) @@ -549,7 +549,7 @@ SUBROUTINE calculate_v_dadr_ff(lri_env, lri_density, pmatrix, cell_to_index, ato ALLOCATE (wab(nba, nbb), wbb(nba, nbb)) wab(1:nba, 1:nbb) = lri_env%wmat(ikind, jkind)%mat(1:nba, 1:nbb) - wbb(1:nba, 1:nbb) = 1.0_dp-lri_env%wmat(ikind, jkind)%mat(1:nba, 1:nbb) + wbb(1:nba, 1:nbb) = 1.0_dp - lri_env%wmat(ikind, jkind)%mat(1:nba, 1:nbb) obasa => lri_env%orb_basis(ikind)%gto_basis_set obasb => lri_env%orb_basis(jkind)%gto_basis_set @@ -597,16 +597,16 @@ SUBROUTINE calculate_v_dadr_ff(lri_env, lri_density, pmatrix, cell_to_index, ato isna = SUM(vinta(1:nfa)*lrii%sna(1:nfa)) isnb = SUM(vintb(1:nfb)*lrii%snb(1:nfb)) DO k = 1, 3 - ai = isna/lrii%nsna*dchargea(k)+isnb/lrii%nsnb*dchargeb(k) + ai = isna/lrii%nsna*dchargea(k) + isnb/lrii%nsnb*dchargeb(k) force_a(k) = 2.0_dp*fw*ai force_b(k) = -2.0_dp*fw*ai ENDDO DO k = 1, 3 sta(1:nfa) = MATMUL(lrii%asinv(1:nfa, 1:nfa), dtveca(1:nfa, k)) - idava(k) = SUM(vinta(1:nfa)*sta(1:nfa))-isna/lrii%nsna*SUM(lrii%na(1:nfa)*sta(1:nfa)) + idava(k) = SUM(vinta(1:nfa)*sta(1:nfa)) - isna/lrii%nsna*SUM(lrii%na(1:nfa)*sta(1:nfa)) stb(1:nfb) = MATMUL(lrii%bsinv(1:nfb, 1:nfb), dtvecb(1:nfb, k)) - idavb(k) = SUM(vintb(1:nfb)*stb(1:nfb))-isnb/lrii%nsnb*SUM(lrii%nb(1:nfb)*stb(1:nfb)) + idavb(k) = SUM(vintb(1:nfb)*stb(1:nfb)) - isnb/lrii%nsnb*SUM(lrii%nb(1:nfb)*stb(1:nfb)) ENDDO ! deallocate derivative integrals @@ -614,18 +614,18 @@ SUBROUTINE calculate_v_dadr_ff(lri_env, lri_density, pmatrix, cell_to_index, ato ! sum over atom pairs DO k = 1, 3 - ai = 2.0_dp*fw*(idava(k)+idavb(k)) - force_a(k) = force_a(k)+ai - force_b(k) = force_b(k)-ai + ai = 2.0_dp*fw*(idava(k) + idavb(k)) + force_a(k) = force_a(k) + ai + force_b(k) = force_b(k) - ai ENDDO IF (ABS(dfw) > 0.0_dp) THEN dab = SQRT(SUM(rab(1:3)*rab(1:3))) ai = 2.0_dp*dfw/dab* & - (SUM(lrho%aveca(1:nfa)*vinta(1:nfa))+ & + (SUM(lrho%aveca(1:nfa)*vinta(1:nfa)) + & SUM(lrho%avecb(1:nfb)*vintb(1:nfb))) DO k = 1, 3 - force_a(k) = force_a(k)-ai*rab(k) - force_b(k) = force_b(k)+ai*rab(k) + force_a(k) = force_a(k) - ai*rab(k) + force_b(k) = force_b(k) + ai*rab(k) ENDDO END IF v_dadra => lri_coef(ikind)%v_dadr(atom_a, :) @@ -633,8 +633,8 @@ SUBROUTINE calculate_v_dadr_ff(lri_env, lri_density, pmatrix, cell_to_index, ato !$OMP CRITICAL(addforces) DO k = 1, 3 - v_dadra(k) = v_dadra(k)+force_a(k) - v_dadrb(k) = v_dadrb(k)+force_b(k) + v_dadra(k) = v_dadra(k) + force_a(k) + v_dadrb(k) = v_dadrb(k) + force_b(k) ENDDO !$OMP END CRITICAL(addforces) @@ -721,7 +721,7 @@ SUBROUTINE calculate_ri_forces(lri_env, lri_density, qs_env, pmatrix, atomic_kin v_dfdr => lri_coef(ikind)%v_dfdr(iatom, :) force(ikind)%rho_lri_elec(:, iatom) = force(ikind)%rho_lri_elec(:, iatom) & - +v_dfdr(:)+v_dadr(:) + + v_dfdr(:) + v_dadr(:) END DO END DO @@ -809,15 +809,15 @@ SUBROUTINE calculate_v_dadr_ri(lri_env, lri_density, pmatrix, atomic_kind_set, & rij=rij, rik=rik, force_i=fi, force_j=fj, force_k=fk) i1 = bas_ptr(1, katom) i2 = bas_ptr(2, katom) - m = i2-i1+1 + m = i2 - i1 + 1 DO i = 1, 3 force_a(i) = 0.0_dp force_b(i) = 0.0_dp force_c(i) = 0.0_dp DO ispin = 1, nspin - force_a(i) = force_a(i)+SUM(fi(1:m, i)*fo(i1:i2, ispin)) - force_b(i) = force_b(i)+SUM(fj(1:m, i)*fo(i1:i2, ispin)) - force_c(i) = force_c(i)+SUM(fk(1:m, i)*fo(i1:i2, ispin)) + force_a(i) = force_a(i) + SUM(fi(1:m, i)*fo(i1:i2, ispin)) + force_b(i) = force_b(i) + SUM(fj(1:m, i)*fo(i1:i2, ispin)) + force_c(i) = force_c(i) + SUM(fk(1:m, i)*fo(i1:i2, ispin)) END DO END DO atom_a = atom_of_kind(iatom) @@ -829,12 +829,12 @@ SUBROUTINE calculate_v_dadr_ri(lri_env, lri_density, pmatrix, atomic_kind_set, & v_dadrc => lri_coef(kkind)%v_dadr(atom_c, :) ! !$OMP CRITICAL(addforce) - v_dadra(1:3) = v_dadra(1:3)+force_a(1:3) - v_dadrb(1:3) = v_dadrb(1:3)+force_b(1:3) - v_dadrc(1:3) = v_dadrc(1:3)+force_c(1:3) + v_dadra(1:3) = v_dadra(1:3) + force_a(1:3) + v_dadrb(1:3) = v_dadrb(1:3) + force_b(1:3) + v_dadrc(1:3) = v_dadrc(1:3) + force_c(1:3) ! IF (use_virial) THEN - rjk(1:3) = rik(1:3)-rij(1:3) + rjk(1:3) = rik(1:3) - rij(1:3) ! to be debugged fscal = 1.0_dp IF (iatom == jatom) fscal = 1.0_dp diff --git a/src/lri_ks_methods.F b/src/lri_ks_methods.F index ecc4d3abc7..f8afc61613 100644 --- a/src/lri_ks_methods.F +++ b/src/lri_ks_methods.F @@ -124,7 +124,7 @@ SUBROUTINE calculate_lri_ks_matrix(lri_env, lri_v_int, h_matrix, atomic_kind_set jatom=jatom, nlist=nlist, ilist=ilist, inode=jneighbor, & r=rab, cell=cell) - iac = ikind+nkind*(jkind-1) + iac = ikind + nkind*(jkind - 1) dab = SQRT(SUM(rab*rab)) IF (.NOT. ASSOCIATED(lri_env%lri_ints%lri_atom(iac)%lri_node)) CYCLE @@ -138,7 +138,7 @@ SUBROUTINE calculate_lri_ks_matrix(lri_env, lri_v_int, h_matrix, atomic_kind_set nfb = lrii%nfb nba = lrii%nba nbb = lrii%nbb - nn = nfa+nfb + nn = nfa + nfb atom_a = atom_of_kind(iatom) atom_b = atom_of_kind(jatom) @@ -162,24 +162,24 @@ SUBROUTINE calculate_lri_ks_matrix(lri_env, lri_v_int, h_matrix, atomic_kind_set nm = nn ALLOCATE (vi(nn)) vi(1:nfa) = lri_v_int(ikind)%v_int(atom_a, 1:nfa) - vi(nfa+1:nn) = lri_v_int(jkind)%v_int(atom_b, 1:nfb) + vi(nfa + 1:nn) = lri_v_int(jkind)%v_int(atom_b, 1:nfb) END IF isn = SUM(lrii%sn(1:nm)*vi(1:nm))/lrii%nsn - vi(1:nm) = MATMUL(lrii%sinv(1:nm, 1:nm), vi(1:nm))-isn*lrii%sn(1:nm) + vi(1:nm) = MATMUL(lrii%sinv(1:nm, 1:nm), vi(1:nm)) - isn*lrii%sn(1:nm) hs_work(1:nba, 1:nbb) = isn*lrii%soo(1:nba, 1:nbb) IF (iatom == jatom .AND. dab < lri_env%delta) THEN DO i = 1, nfa CALL lri_decomp_i(int3, lrii%cabai, i) - hs_work(1:nba, 1:nbb) = hs_work(1:nba, 1:nbb)+vi(i)*int3(1:nba, 1:nbb) + hs_work(1:nba, 1:nbb) = hs_work(1:nba, 1:nbb) + vi(i)*int3(1:nba, 1:nbb) ENDDO ELSE DO i = 1, nfa CALL lri_decomp_i(int3, lrii%cabai, i) - hs_work(1:nba, 1:nbb) = hs_work(1:nba, 1:nbb)+vi(i)*int3(1:nba, 1:nbb) + hs_work(1:nba, 1:nbb) = hs_work(1:nba, 1:nbb) + vi(i)*int3(1:nba, 1:nbb) ENDDO DO i = 1, nfb CALL lri_decomp_i(int3, lrii%cabbi, i) - hs_work(1:nba, 1:nbb) = hs_work(1:nba, 1:nbb)+vi(nfa+i)*int3(1:nba, 1:nbb) + hs_work(1:nba, 1:nbb) = hs_work(1:nba, 1:nbb) + vi(nfa + i)*int3(1:nba, 1:nbb) ENDDO END IF DEALLOCATE (vi) @@ -188,7 +188,7 @@ SUBROUTINE calculate_lri_ks_matrix(lri_env, lri_v_int, h_matrix, atomic_kind_set IF (lrii%lriff) THEN ALLOCATE (hf_work(nba, nbb), wab(nba, nbb), wbb(nba, nbb)) wab(1:nba, 1:nbb) = lri_env%wmat(ikind, jkind)%mat(1:nba, 1:nbb) - wbb(1:nba, 1:nbb) = 1.0_dp-lri_env%wmat(ikind, jkind)%mat(1:nba, 1:nbb) + wbb(1:nba, 1:nbb) = 1.0_dp - lri_env%wmat(ikind, jkind)%mat(1:nba, 1:nbb) ! ALLOCATE (via(nfa), vib(nfb)) via(1:nfa) = lri_v_int(ikind)%v_int(atom_a, 1:nfa) @@ -196,22 +196,22 @@ SUBROUTINE calculate_lri_ks_matrix(lri_env, lri_v_int, h_matrix, atomic_kind_set ! isna = SUM(lrii%sna(1:nfa)*via(1:nfa))/lrii%nsna isnb = SUM(lrii%snb(1:nfb)*vib(1:nfb))/lrii%nsnb - via(1:nfa) = MATMUL(lrii%asinv(1:nfa, 1:nfa), via(1:nfa))-isna*lrii%sna(1:nfa) - vib(1:nfb) = MATMUL(lrii%bsinv(1:nfb, 1:nfb), vib(1:nfb))-isnb*lrii%snb(1:nfb) + via(1:nfa) = MATMUL(lrii%asinv(1:nfa, 1:nfa), via(1:nfa)) - isna*lrii%sna(1:nfa) + vib(1:nfb) = MATMUL(lrii%bsinv(1:nfb, 1:nfb), vib(1:nfb)) - isnb*lrii%snb(1:nfb) ! - hf_work(1:nba, 1:nbb) = (isna*wab(1:nba, 1:nbb)+isnb*wbb(1:nba, 1:nbb))*lrii%soo(1:nba, 1:nbb) + hf_work(1:nba, 1:nbb) = (isna*wab(1:nba, 1:nbb) + isnb*wbb(1:nba, 1:nbb))*lrii%soo(1:nba, 1:nbb) ! DO i = 1, nfa IF (lrii%abascr(i) > threshold) THEN CALL lri_decomp_i(int3, lrii%cabai, i) - hf_work(1:nba, 1:nbb) = hf_work(1:nba, 1:nbb)+ & + hf_work(1:nba, 1:nbb) = hf_work(1:nba, 1:nbb) + & via(i)*int3(1:nba, 1:nbb)*wab(1:nba, 1:nbb) END IF ENDDO DO i = 1, nfb IF (lrii%abbscr(i) > threshold) THEN CALL lri_decomp_i(int3, lrii%cabbi, i) - hf_work(1:nba, 1:nbb) = hf_work(1:nba, 1:nbb)+ & + hf_work(1:nba, 1:nbb) = hf_work(1:nba, 1:nbb) + & vib(i)*int3(1:nba, 1:nbb)*wbb(1:nba, 1:nbb) END IF ENDDO @@ -239,17 +239,17 @@ SUBROUTINE calculate_lri_ks_matrix(lri_env, lri_v_int, h_matrix, atomic_kind_set IF (lrii%lrisr) THEN fw = lrii%wsr IF (trans) THEN - h_block(1:nbb, 1:nba) = h_block(1:nbb, 1:nba)+fw*TRANSPOSE(hs_work(1:nba, 1:nbb)) + h_block(1:nbb, 1:nba) = h_block(1:nbb, 1:nba) + fw*TRANSPOSE(hs_work(1:nba, 1:nbb)) ELSE - h_block(1:nba, 1:nbb) = h_block(1:nba, 1:nbb)+fw*hs_work(1:nba, 1:nbb) + h_block(1:nba, 1:nbb) = h_block(1:nba, 1:nbb) + fw*hs_work(1:nba, 1:nbb) ENDIF END IF IF (lrii%lriff) THEN fw = lrii%wff IF (trans) THEN - h_block(1:nbb, 1:nba) = h_block(1:nbb, 1:nba)+fw*TRANSPOSE(hf_work(1:nba, 1:nbb)) + h_block(1:nbb, 1:nba) = h_block(1:nbb, 1:nba) + fw*TRANSPOSE(hf_work(1:nba, 1:nbb)) ELSE - h_block(1:nba, 1:nbb) = h_block(1:nba, 1:nbb)+fw*hf_work(1:nba, 1:nbb) + h_block(1:nba, 1:nbb) = h_block(1:nba, 1:nbb) + fw*hf_work(1:nba, 1:nbb) ENDIF END IF !$OMP END CRITICAL(addhamiltonian) @@ -316,7 +316,7 @@ SUBROUTINE calculate_ri_ks_matrix(lri_env, lri_v_int, h_matrix, s_matrix, & atom_a = atom_of_kind(iatom) i1 = bas_ptr(1, iatom) i2 = bas_ptr(2, iatom) - n = i2-i1+1 + n = i2 - i1 + 1 fvec(i1:i2) = lri_v_int(ikind)%v_int(atom_a, 1:n) END DO DEALLOCATE (atom_of_kind, kind_of) @@ -325,7 +325,7 @@ SUBROUTINE calculate_ri_ks_matrix(lri_env, lri_v_int, h_matrix, s_matrix, & lri_env%ri_fit%ftrm1n(ispin) = ftrm1n fscal = ftrm1n/lri_env%ri_fit%ntrm1n ! renormalize fvec -> fvec - fscal * n - fvec(:) = fvec(:)-fscal*lri_env%ri_fit%nvec(:) + fvec(:) = fvec(:) - fscal*lri_env%ri_fit%nvec(:) ! solve Rx=f' CALL ri_metric_solver(mat=lri_env%ri_smat(1)%matrix, & vecr=fvec(:), & @@ -343,7 +343,7 @@ SUBROUTINE calculate_ri_ks_matrix(lri_env, lri_v_int, h_matrix, s_matrix, & DO iatom = 1, natom i1 = bas_ptr(1, iatom) i2 = bas_ptr(2, iatom) - n = i2-i1+1 + n = i2 - i1 + 1 nsize(iatom) = n END DO CALL o3c_vec_create(o3c_vec, nsize) @@ -351,7 +351,7 @@ SUBROUTINE calculate_ri_ks_matrix(lri_env, lri_v_int, h_matrix, s_matrix, & DO iatom = 1, natom i1 = bas_ptr(1, iatom) i2 = bas_ptr(2, iatom) - n = i2-i1+1 + n = i2 - i1 + 1 CALL get_o3c_vec(o3c_vec, iatom, v) v(1:n) = fout(i1:i2) END DO diff --git a/src/lri_optimize_ri_basis.F b/src/lri_optimize_ri_basis.F index efadf0afc6..e0a0f78046 100644 --- a/src/lri_optimize_ri_basis.F +++ b/src/lri_optimize_ri_basis.F @@ -234,7 +234,7 @@ SUBROUTINE calculate_lri_overlap_aabb(lri_env, qs_env) nlist=nlist, ilist=ilist, nnode=nneighbor, inode=jneighbor, & iatom=iatom, jatom=jatom, r=rab) - iac = ikind+nkind*(jkind-1) + iac = ikind + nkind*(jkind - 1) dab = SQRT(SUM(rab*rab)) obasa => lri_env%orb_basis(ikind)%gto_basis_set @@ -314,18 +314,18 @@ SUBROUTINE init_optimization(lri_env, lri_opt, lri_optbas_section, opt_state, & npgf=npgf, nset=nset, zet=zet) DO iset = 1, nset IF (lri_opt%use_geometric_seq .AND. npgf(iset) > 2) THEN - opt_state%nvar = opt_state%nvar+2 + opt_state%nvar = opt_state%nvar + 2 CALL reallocate(x, 1, opt_state%nvar) - x(n+1) = MAXVAL(zet(1:npgf(iset), iset)) - x(n+2) = MINVAL(zet(1:npgf(iset), iset)) - n = n+2 + x(n + 1) = MAXVAL(zet(1:npgf(iset), iset)) + x(n + 2) = MINVAL(zet(1:npgf(iset), iset)) + n = n + 2 ELSE - opt_state%nvar = opt_state%nvar+npgf(iset) + opt_state%nvar = opt_state%nvar + npgf(iset) CALL reallocate(x, 1, opt_state%nvar) - x(n+1:n+npgf(iset)) = zet(1:npgf(iset), iset) - n = n+npgf(iset) + x(n + 1:n + npgf(iset)) = zet(1:npgf(iset), iset) + n = n + npgf(iset) ENDIF - lri_opt%nexp = lri_opt%nexp+npgf(iset) + lri_opt%nexp = lri_opt%nexp + npgf(iset) ENDDO ENDDO @@ -357,11 +357,11 @@ SUBROUTINE init_optimization(lri_env, lri_opt, lri_optbas_section, opt_state, & n = opt_state%nvar DO iset = 1, nset DO ishell = 1, nshell(iset) - opt_state%nvar = opt_state%nvar+npgf(iset) + opt_state%nvar = opt_state%nvar + npgf(iset) CALL reallocate(x, 1, opt_state%nvar) - x(n+1:n+npgf(iset)) = gcc_orig(1:npgf(iset), ishell, iset) - lri_opt%ncoeff = lri_opt%ncoeff+npgf(iset) - n = n+npgf(iset) + x(n + 1:n + npgf(iset)) = gcc_orig(1:npgf(iset), ishell, iset) + lri_opt%ncoeff = lri_opt%ncoeff + npgf(iset) + n = n + npgf(iset) ENDDO ENDDO ENDDO @@ -473,7 +473,7 @@ SUBROUTINE update_exponents(lri_env, lri_opt, x, zet_init, nkind) NULLIFY (fbas, gcc_orig, npgf, nshell, zet_trans, zet) ! nvar_exp: number of exponents that are variables - nvar_exp = SIZE(x)-lri_opt%ncoeff + nvar_exp = SIZE(x) - lri_opt%ncoeff ALLOCATE (zet_trans(nvar_exp)) ! *** update exponents @@ -490,14 +490,14 @@ SUBROUTINE update_exponents(lri_env, lri_opt, x, zet_init, nkind) CALL get_gto_basis_set(gto_basis_set=fbas, npgf=npgf, nset=nset) DO iset = 1, nset IF (lri_opt%use_geometric_seq .AND. npgf(iset) > 2) THEN - zet_max = MAXVAL(zet_trans(n+1:n+2)) - zet_min = MINVAL(zet_trans(n+1:n+2)) + zet_max = MAXVAL(zet_trans(n + 1:n + 2)) + zet_min = MINVAL(zet_trans(n + 1:n + 2)) zet => fbas%zet(1:npgf(iset), iset) CALL geometric_progression(zet, zet_max, zet_min, npgf(iset)) - n = n+2 + n = n + 2 ELSE - fbas%zet(1:npgf(iset), iset) = zet_trans(n+1:n+npgf(iset)) - n = n+npgf(iset) + fbas%zet(1:npgf(iset), iset) = zet_trans(n + 1:n + npgf(iset)) + n = n + npgf(iset) ENDIF ENDDO ENDDO @@ -513,8 +513,8 @@ SUBROUTINE update_exponents(lri_env, lri_opt, x, zet_init, nkind) nshell=nshell, npgf=npgf, nset=nset) DO iset = 1, nset DO ishell = 1, nshell(iset) - gcc_orig(1:npgf(iset), ishell, iset) = x(n+1:n+npgf(iset)) - n = n+npgf(iset) + gcc_orig(1:npgf(iset), ishell, iset) = x(n + 1:n + npgf(iset)) + n = n + npgf(iset) ENDDO ENDDO ! *** Gram Schmidt orthonormalization @@ -546,12 +546,12 @@ SUBROUTINE transfer_exp(lri_opt, zet, zet_init, zet_trans, nvar) ALLOCATE (zet_max(nvar), zet_min(nvar)) - zet_min(:) = zet_init(:)*(1.0_dp-lri_opt%scale_exp) - zet_max(:) = zet_init(:)*(1.0_dp+lri_opt%scale_exp) + zet_min(:) = zet_init(:)*(1.0_dp - lri_opt%scale_exp) + zet_max(:) = zet_init(:)*(1.0_dp + lri_opt%scale_exp) a = lri_opt%fermi_exp - zet_trans = zet_min+(zet_max-zet_min)/(1+EXP(-a*(zet-zet_init))) + zet_trans = zet_min + (zet_max - zet_min)/(1 + EXP(-a*(zet - zet_init))) DEALLOCATE (zet_max, zet_min) @@ -576,12 +576,12 @@ SUBROUTINE geometric_progression(zet, zet_max, zet_min, nexp) INTEGER :: i, n REAL(KIND=dp) :: q - n = nexp-1 + n = nexp - 1 q = (zet_min/zet_max)**(1._dp/REAL(n, dp)) DO i = 1, nexp - zet(i) = zet_max*q**(i-1) + zet(i) = zet_max*q**(i - 1) ENDDO END SUBROUTINE geometric_progression @@ -714,7 +714,7 @@ SUBROUTINE calculate_objective(lri_env, lri_density, lri_opt, pmatrix, para_env, CALL get_iterator_info(nl_iterator, mepos=mepos, ikind=ikind, jkind=jkind, iatom=iatom, & jatom=jatom, nlist=nlist, ilist=ilist, nnode=nneighbor, inode=jneighbor) - iac = ikind+nkind*(jkind-1) + iac = ikind + nkind*(jkind - 1) IF (.NOT. ASSOCIATED(lri_env%lri_ints%lri_atom(iac)%lri_node)) CYCLE @@ -725,7 +725,7 @@ SUBROUTINE calculate_objective(lri_env, lri_density, lri_opt, pmatrix, para_env, nfb = lrii%nfb nba = lrii%nba nbb = lrii%nbb - nn = nfa+nfb + nn = nfa + nfb rhoexact_sq = 0._dp rhomix = 0._dp @@ -748,7 +748,7 @@ SUBROUTINE calculate_objective(lri_env, lri_density, lri_opt, pmatrix, para_env, DO jsgfa = 1, nba DO ksgfb = 1, nbb DO lsgfb = 1, nbb - rhoexact_sq = rhoexact_sq+pbij(ksgfb, isgfa)*pbij(lsgfb, jsgfa) & + rhoexact_sq = rhoexact_sq + pbij(ksgfb, isgfa)*pbij(lsgfb, jsgfa) & *lriir%soaabb(isgfa, jsgfa, ksgfb, lsgfb) END DO END DO @@ -759,7 +759,7 @@ SUBROUTINE calculate_objective(lri_env, lri_density, lri_opt, pmatrix, para_env, DO jsgfa = 1, nba DO ksgfb = 1, nbb DO lsgfb = 1, nbb - rhoexact_sq = rhoexact_sq+pbij(isgfa, ksgfb)*pbij(jsgfa, lsgfb) & + rhoexact_sq = rhoexact_sq + pbij(isgfa, ksgfb)*pbij(jsgfa, lsgfb) & *lriir%soaabb(isgfa, jsgfa, ksgfb, lsgfb) END DO END DO @@ -770,20 +770,20 @@ SUBROUTINE calculate_objective(lri_env, lri_density, lri_opt, pmatrix, para_env, ! *** calculate integral of the square of the fitted density rhofit_sq DO isgfa = 1, nfa DO jsgfa = 1, nfa - rhofit_sq = rhofit_sq+lrho%avec(isgfa)*lrho%avec(jsgfa) & + rhofit_sq = rhofit_sq + lrho%avec(isgfa)*lrho%avec(jsgfa) & *lri_env%bas_prop(ikind)%ri_ovlp(isgfa, jsgfa) ENDDO ENDDO IF (iatom /= jatom) THEN DO ksgfb = 1, nfb DO lsgfb = 1, nfb - rhofit_sq = rhofit_sq+lrho%avec(nfa+ksgfb)*lrho%avec(nfa+lsgfb) & + rhofit_sq = rhofit_sq + lrho%avec(nfa + ksgfb)*lrho%avec(nfa + lsgfb) & *lri_env%bas_prop(jkind)%ri_ovlp(ksgfb, lsgfb) ENDDO ENDDO DO isgfa = 1, nfa DO ksgfb = 1, nfb - rhofit_sq = rhofit_sq+2._dp*lrho%avec(isgfa)*lrho%avec(nfa+ksgfb) & + rhofit_sq = rhofit_sq + 2._dp*lrho%avec(isgfa)*lrho%avec(nfa + ksgfb) & *lrii%sab(isgfa, ksgfb) ENDDO ENDDO @@ -799,17 +799,17 @@ SUBROUTINE calculate_objective(lri_env, lri_density, lri_opt, pmatrix, para_env, ! *** calculate contribution to the objective function for pair ab ! *** taking density matrix symmetry in account, double-count for off-diagonal blocks IF (iatom == jatom) THEN - obj_ab = rhoexact_sq-2._dp*rhomix+rhofit_sq + obj_ab = rhoexact_sq - 2._dp*rhomix + rhofit_sq ELSE - obj_ab = 2.0_dp*(rhoexact_sq-2._dp*rhomix+rhofit_sq) + obj_ab = 2.0_dp*(rhoexact_sq - 2._dp*rhomix + rhofit_sq) ENDIF !$OMP CRITICAL(addfun) IF (lri_opt%use_condition_number) THEN - fobj = fobj+obj_ab+lri_opt%cond_weight*LOG(lrii%cond_num) - lri_opt%rho_diff = lri_opt%rho_diff+obj_ab + fobj = fobj + obj_ab + lri_opt%cond_weight*LOG(lrii%cond_num) + lri_opt%rho_diff = lri_opt%rho_diff + obj_ab ELSE - fobj = fobj+obj_ab + fobj = fobj + obj_ab ENDIF !$OMP END CRITICAL(addfun) @@ -873,13 +873,13 @@ SUBROUTINE get_condition_number_of_overlap(lri_env) CALL get_iterator_info(nl_iterator, mepos=mepos, ikind=ikind, jkind=jkind, iatom=iatom, & jatom=jatom, nlist=nlist, ilist=ilist, nnode=nneighbor, inode=jneighbor) - iac = ikind+nkind*(jkind-1) + iac = ikind + nkind*(jkind - 1) IF (.NOT. ASSOCIATED(lri_env%lri_ints%lri_atom(iac)%lri_node)) CYCLE lrii => lri_env%lri_ints%lri_atom(iac)%lri_node(ilist)%lri_int(jneighbor) nfa = lrii%nfa nfb = lrii%nfb - nn = nfa+nfb + nn = nfa + nfb ! build the overlap matrix IF (iatom == jatom) THEN @@ -889,14 +889,14 @@ SUBROUTINE get_condition_number_of_overlap(lri_env) ENDIF smat(1:nfa, 1:nfa) = lri_env%bas_prop(ikind)%ri_ovlp(1:nfa, 1:nfa) IF (iatom /= jatom) THEN - nn = nfa+nfb - smat(1:nfa, nfa+1:nn) = lrii%sab(1:nfa, 1:nfb) - smat(nfa+1:nn, 1:nfa) = TRANSPOSE(lrii%sab(1:nfa, 1:nfb)) - smat(nfa+1:nn, nfa+1:nn) = lri_env%bas_prop(jkind)%ri_ovlp(1:nfb, 1:nfb) + nn = nfa + nfb + smat(1:nfa, nfa + 1:nn) = lrii%sab(1:nfa, 1:nfb) + smat(nfa + 1:nn, 1:nfa) = TRANSPOSE(lrii%sab(1:nfa, 1:nfb)) + smat(nfa + 1:nn, nfa + 1:nn) = lri_env%bas_prop(jkind)%ri_ovlp(1:nfb, 1:nfb) ENDIF IF (iatom == jatom) nn = nfa - ALLOCATE (diag(nn), off_diag(nn-1), tau(nn-1), work(1)) + ALLOCATE (diag(nn), off_diag(nn - 1), tau(nn - 1), work(1)) diag = 0.0_dp off_diag = 0.0_dp tau = 0.0_dp @@ -1026,8 +1026,8 @@ SUBROUTINE write_optimized_lri_basis(lri_env, dft_section, nkind, lri_opt, & cc_l = 1 DO ishell = 1, nshell(iset) IF (ishell /= nshell(iset)) THEN - IF (l(ishell, iset) == l(ishell+1, iset)) THEN - cc_l = cc_l+1 + IF (l(ishell, iset) == l(ishell + 1, iset)) THEN + cc_l = cc_l + 1 ELSE WRITE (output_file, '(1X,I0)', advance='no') cc_l cc_l = 1 diff --git a/src/lri_optimize_ri_basis_types.F b/src/lri_optimize_ri_basis_types.F index 9bdd0de4d0..9d2552e5c6 100644 --- a/src/lri_optimize_ri_basis_types.F +++ b/src/lri_optimize_ri_basis_types.F @@ -163,7 +163,7 @@ SUBROUTINE get_original_gcc(gcc_orig, gto_basis_set, lri_opt) DO iset = 1, gto_basis_set%nset DO ishell = 1, gto_basis_set%nshell(iset) l = gto_basis_set%l(ishell, iset) - expzet = 0.25_dp*REAL(2*l+3, dp) + expzet = 0.25_dp*REAL(2*l + 3, dp) prefac = 2.0_dp**l*(2.0_dp/pi)**0.75_dp DO ipgf = 1, gto_basis_set%npgf(iset) gcca = gto_basis_set%gcc(ipgf, ishell, iset) @@ -179,7 +179,7 @@ SUBROUTINE get_original_gcc(gcc_orig, gto_basis_set, lri_opt) lmax=lmax, lmin=lmin) ALLOCATE (lri_opt%subset(nset)) DO iset = 1, gto_basis_set%nset - nl = lmax(iset)-lmin(iset)+1 + nl = lmax(iset) - lmin(iset) + 1 lri_opt%subset(iset)%nl = nl il = 1 ALLOCATE (lri_opt%subset(iset)%ncont_l(nl)) @@ -187,10 +187,10 @@ SUBROUTINE get_original_gcc(gcc_orig, gto_basis_set, lri_opt) ncont_l = 1 DO ishell = 2, gto_basis_set%nshell(iset) l = gto_basis_set%l(ishell, iset) - IF (l == gto_basis_set%l(ishell-1, iset)) THEN - ncont_l(il) = ncont_l(il)+1 + IF (l == gto_basis_set%l(ishell - 1, iset)) THEN + ncont_l(il) = ncont_l(il) + 1 ELSE - il = il+1 + il = il + 1 ncont_l(il) = 1 ENDIF ENDDO @@ -224,15 +224,15 @@ SUBROUTINE orthonormalize_gcc(gcc, gto_basis_set, lri_opt) DO iset = 1, nset istart = 1 DO il = 1, lri_opt%subset(iset)%nl - DO ishell1 = istart, istart+lri_opt%subset(iset)%ncont_l(il)-2 - DO ishell2 = ishell1+1, istart+lri_opt%subset(iset)%ncont_l(il)-1 + DO ishell1 = istart, istart + lri_opt%subset(iset)%ncont_l(il) - 2 + DO ishell2 = ishell1 + 1, istart + lri_opt%subset(iset)%ncont_l(il) - 1 gs_scale = DOT_PRODUCT(gcc(:, ishell2, iset), gcc(:, ishell1, iset))/ & DOT_PRODUCT(gcc(:, ishell1, iset), gcc(:, ishell1, iset)) - gcc(:, ishell2, iset) = gcc(:, ishell2, iset)- & + gcc(:, ishell2, iset) = gcc(:, ishell2, iset) - & gs_scale*gcc(:, ishell1, iset) ENDDO ENDDO - istart = istart+lri_opt%subset(iset)%ncont_l(il) + istart = istart + lri_opt%subset(iset)%ncont_l(il) ENDDO DO ishell = 1, gto_basis_set%nshell(iset) diff --git a/src/ls_matrix_exp.F b/src/ls_matrix_exp.F index bb01ab989c..69c265a360 100644 --- a/src/ls_matrix_exp.F +++ b/src/ls_matrix_exp.F @@ -203,7 +203,7 @@ SUBROUTINE taylor_only_imaginary_dbcsr(exp_H, im_matrix, nsquare, ntaylor, filte !the inverse of the prefactor in the taylor series tmp = 1.0_dp DO i = 1, nloop - CALL dbcsr_scale(T1, 1.0_dp/(REAL(i, dp)*2.0_dp-1.0_dp)) + CALL dbcsr_scale(T1, 1.0_dp/(REAL(i, dp)*2.0_dp - 1.0_dp)) CALL dbcsr_filter(T1, filter_eps) CALL dbcsr_multiply("N", "N", square_fac, im_matrix, T1, zero, & T2, filter_eps=filter_eps) diff --git a/src/manybody_eam.F b/src/manybody_eam.F index 03ebf0a6a5..725d215069 100644 --- a/src/manybody_eam.F +++ b/src/manybody_eam.F @@ -133,9 +133,9 @@ SUBROUTINE density_nonbond(fist_nonbond_env, particle_set, cell, para_env) atom_b = neighbor_kind_pair%list(2, ipair) fac = 1.0_dp IF (atom_a == atom_b) fac = 0.5_dp - rab = r_last_update_pbc(atom_b)%r-r_last_update_pbc(atom_a)%r - rab = rab+cell_v - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab = r_last_update_pbc(atom_b)%r - r_last_update_pbc(atom_a)%r + rab = rab + cell_v + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) IF (rab2 <= rab2_max) THEN kind_a = particle_set(atom_a)%atomic_kind%kind_number kind_b = particle_set(atom_b)%atomic_kind%kind_number @@ -186,27 +186,27 @@ SUBROUTINE get_rho_eam(eam_a, eam_b, rab2, atom_a, atom_b, rho, fac) rab = SQRT(rab2) ! Particle A - index = INT(rab/eam_b%drar)+1 + index = INT(rab/eam_b%drar) + 1 IF (index > eam_b%npoints) THEN index = eam_b%npoints ELSEIF (index < 1) THEN index = 1 ENDIF - qq = rab-eam_b%rval(index) - rhoi = eam_b%rho(index)+qq*eam_b%rhop(index) + qq = rab - eam_b%rval(index) + rhoi = eam_b%rho(index) + qq*eam_b%rhop(index) ! Particle B - index = INT(rab/eam_a%drar)+1 + index = INT(rab/eam_a%drar) + 1 IF (index > eam_a%npoints) THEN index = eam_a%npoints ELSEIF (index < 1) THEN index = 1 ENDIF - qq = rab-eam_a%rval(index) - rhoj = eam_a%rho(index)+qq*eam_a%rhop(index) + qq = rab - eam_a%rval(index) + rhoj = eam_a%rho(index) + qq*eam_a%rhop(index) - rho(atom_a) = rho(atom_a)+rhoi*fac - rho(atom_b) = rho(atom_b)+rhoj*fac + rho(atom_a) = rho(atom_a) + rhoi*fac + rho(atom_b) = rho(atom_b) + rhoj*fac END SUBROUTINE get_rho_eam ! ************************************************************************************************** @@ -235,34 +235,34 @@ SUBROUTINE get_force_eam(rab2, eam_a, eam_b, eam_data, atom_a, atom_b, f_eam) rab = SQRT(rab2) ! Particle A - index = INT(rab/eam_a%drar)+1 + index = INT(rab/eam_a%drar) + 1 IF (index > eam_a%npoints) THEN index = eam_a%npoints ELSEIF (index < 1) THEN index = 1 ENDIF - qq = rab-eam_a%rval(index) + qq = rab - eam_a%rval(index) IF (index == eam_a%npoints) THEN - denspi = eam_a%rhop(index)+qq*(eam_a%rhop(index)-eam_a%rhop(index-1))/eam_a%drar + denspi = eam_a%rhop(index) + qq*(eam_a%rhop(index) - eam_a%rhop(index - 1))/eam_a%drar ELSE - denspi = eam_a%rhop(index)+qq*(eam_a%rhop(index+1)-eam_a%rhop(index))/eam_a%drar + denspi = eam_a%rhop(index) + qq*(eam_a%rhop(index + 1) - eam_a%rhop(index))/eam_a%drar END IF ! Particle B - index = INT(rab/eam_b%drar)+1 + index = INT(rab/eam_b%drar) + 1 IF (index > eam_b%npoints) THEN index = eam_b%npoints ELSEIF (index < 1) THEN index = 1 ENDIF - qq = rab-eam_b%rval(index) + qq = rab - eam_b%rval(index) IF (index == eam_b%npoints) THEN - denspj = eam_b%rhop(index)+qq*(eam_b%rhop(index)-eam_b%rhop(index-1))/eam_b%drar + denspj = eam_b%rhop(index) + qq*(eam_b%rhop(index) - eam_b%rhop(index - 1))/eam_b%drar ELSE - denspj = eam_b%rhop(index)+qq*(eam_b%rhop(index+1)-eam_b%rhop(index))/eam_b%drar + denspj = eam_b%rhop(index) + qq*(eam_b%rhop(index + 1) - eam_b%rhop(index))/eam_b%drar END IF - fcp = denspj*eam_data(atom_a)%f_embed+denspi*eam_data(atom_b)%f_embed + fcp = denspj*eam_data(atom_a)%f_embed + denspi*eam_data(atom_b)%f_embed f_eam = fcp/rab END SUBROUTINE get_force_eam diff --git a/src/manybody_potential.F b/src/manybody_potential.F index 858bb70c8d..ae45a97cbe 100644 --- a/src/manybody_potential.F +++ b/src/manybody_potential.F @@ -127,14 +127,14 @@ SUBROUTINE energy_manybody(fist_nonbond_env, atomic_kind_set, local_particles, & nparticle_local = local_particles%n_el(ikind) DO iparticle_local = 1, nparticle_local iparticle = local_particles%list(ikind)%array(iparticle_local) - indexa = INT(eam_data(iparticle)%rho/eam%drhoar)+1 - IF (indexa > eam%npoints-1) indexa = eam%npoints-1 - qr = eam_data(iparticle)%rho-eam%rhoval(indexa) + indexa = INT(eam_data(iparticle)%rho/eam%drhoar) + 1 + IF (indexa > eam%npoints - 1) indexa = eam%npoints - 1 + qr = eam_data(iparticle)%rho - eam%rhoval(indexa) - embed = eam%frho(indexa)+qr*eam%frhop(indexa) - fembed(iparticle) = eam%frhop(indexa)+qr*(eam%frhop(indexa+1)-eam%frhop(indexa))/eam%drhoar + embed = eam%frho(indexa) + qr*eam%frhop(indexa) + fembed(iparticle) = eam%frhop(indexa) + qr*(eam%frhop(indexa + 1) - eam%frhop(indexa))/eam%drhoar - pot_manybody = pot_manybody+embed + pot_manybody = pot_manybody + embed END DO ! communicate data CALL mp_sum(fembed, para_env%group) @@ -161,7 +161,7 @@ SUBROUTINE energy_manybody(fist_nonbond_env, atomic_kind_set, local_particles, & IF (any_quip) THEN CALL quip_energy_store_force_virial(particle_set, cell, atomic_kind_set, potparm, & fist_nonbond_env, pot_quip, para_env) - pot_manybody = pot_manybody+pot_quip + pot_manybody = pot_manybody + pot_quip ENDIF ! TERSOFF IF (any_tersoff) THEN @@ -185,7 +185,7 @@ SUBROUTINE energy_manybody(fist_nonbond_env, atomic_kind_set, local_particles, & CALL matvec_3x3(cell_v, cell%hmat, cvi) pot => potparm%pot(ikind, jkind)%pot tersoff => pot%set(i)%tersoff - npairs = iend-istart+1 + npairs = iend - istart + 1 IF (npairs /= 0) THEN ALLOCATE (sort_list(2, npairs), work_list(npairs)) sort_list = list(:, istart:iend) @@ -198,8 +198,8 @@ SUBROUTINE energy_manybody(fist_nonbond_env, atomic_kind_set, local_particles, & sort_list(2, :) = work_list ! find number of unique elements of array index 1 nunique = 1 - DO ipair = 1, npairs-1 - IF (sort_list(1, ipair+1) /= sort_list(1, ipair)) nunique = nunique+1 + DO ipair = 1, npairs - 1 + IF (sort_list(1, ipair + 1) /= sort_list(1, ipair)) nunique = nunique + 1 END DO ipair = 1 junique = sort_list(1, ipair) @@ -214,24 +214,24 @@ SUBROUTINE energy_manybody(fist_nonbond_env, atomic_kind_set, local_particles, & DO mpair = ifirst, SIZE(glob_loc_list_a) IF (glob_loc_list_a(mpair) /= atom_a) EXIT END DO - ilast = mpair-1 + ilast = mpair - 1 nloc_size = 0 - IF (ifirst /= 0) nloc_size = ilast-ifirst+1 + IF (ifirst /= 0) nloc_size = ilast - ifirst + 1 DO WHILE (ipair <= npairs) IF (sort_list(1, ipair) /= junique) EXIT atom_b = sort_list(2, ipair) ! Energy terms pot_loc = 0.0_dp - rij(:) = r_last_update_pbc(atom_b)%r(:)-r_last_update_pbc(atom_a)%r(:)+cell_v + rij(:) = r_last_update_pbc(atom_b)%r(:) - r_last_update_pbc(atom_a)%r(:) + cell_v drij = DOT_PRODUCT(rij, rij) - ipair = ipair+1 + ipair = ipair + 1 IF (drij > rab2_max) CYCLE drij = SQRT(drij) CALL tersoff_energy(pot_loc, tersoff, r_last_update_pbc, atom_a, atom_b, nloc_size, & glob_loc_list(:, ifirst:ilast), glob_cell_v(:, ifirst:ilast), cell_v, drij) - pot_manybody = pot_manybody+0.5_dp*pot_loc + pot_manybody = pot_manybody + 0.5_dp*pot_loc END DO - ifirst = ilast+1 + ifirst = ilast + 1 IF (ipair <= npairs) junique = sort_list(1, ipair) END DO DEALLOCATE (sort_list, work_list) @@ -267,7 +267,7 @@ SUBROUTINE energy_manybody(fist_nonbond_env, atomic_kind_set, local_particles, & CALL matvec_3x3(cell_v, cell%hmat, cvi) pot => potparm%pot(ikind, jkind)%pot siepmann => pot%set(i)%siepmann - npairs = iend-istart+1 + npairs = iend - istart + 1 IF (npairs /= 0) THEN ALLOCATE (sort_list(2, npairs), work_list(npairs)) sort_list = list(:, istart:iend) @@ -280,8 +280,8 @@ SUBROUTINE energy_manybody(fist_nonbond_env, atomic_kind_set, local_particles, & sort_list(2, :) = work_list ! find number of unique elements of array index 1 nunique = 1 - DO ipair = 1, npairs-1 - IF (sort_list(1, ipair+1) /= sort_list(1, ipair)) nunique = nunique+1 + DO ipair = 1, npairs - 1 + IF (sort_list(1, ipair + 1) /= sort_list(1, ipair)) nunique = nunique + 1 END DO ipair = 1 junique = sort_list(1, ipair) @@ -296,25 +296,25 @@ SUBROUTINE energy_manybody(fist_nonbond_env, atomic_kind_set, local_particles, & DO mpair = ifirst, SIZE(glob_loc_list_a) IF (glob_loc_list_a(mpair) /= atom_a) EXIT END DO - ilast = mpair-1 + ilast = mpair - 1 nloc_size = 0 - IF (ifirst /= 0) nloc_size = ilast-ifirst+1 + IF (ifirst /= 0) nloc_size = ilast - ifirst + 1 DO WHILE (ipair <= npairs) IF (sort_list(1, ipair) /= junique) EXIT atom_b = sort_list(2, ipair) ! Energy terms pot_loc = 0.0_dp - rij(:) = r_last_update_pbc(atom_b)%r(:)-r_last_update_pbc(atom_a)%r(:)+cell_v + rij(:) = r_last_update_pbc(atom_b)%r(:) - r_last_update_pbc(atom_a)%r(:) + cell_v drij = DOT_PRODUCT(rij, rij) - ipair = ipair+1 + ipair = ipair + 1 IF (drij > rab2_max) CYCLE drij = SQRT(drij) CALL siepmann_energy(pot_loc, siepmann, r_last_update_pbc, atom_a, atom_b, nloc_size, & glob_loc_list(:, ifirst:ilast), cell_v, cell, drij, & particle_set, nr_oh, nr_h3O, nr_o) - pot_manybody = pot_manybody+pot_loc + pot_manybody = pot_manybody + pot_loc END DO - ifirst = ilast+1 + ifirst = ilast + 1 IF (ipair <= npairs) junique = sort_list(1, ipair) END DO DEALLOCATE (sort_list, work_list) @@ -452,9 +452,9 @@ SUBROUTINE force_nonbond_manybody(fist_nonbond_env, particle_set, cell, & !set this outside the potential type in case need multiple potentials !Do everything necessary for EAM here - rab = r_last_update_pbc(atom_b)%r-r_last_update_pbc(atom_a)%r - rab = rab+cell_v - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab = r_last_update_pbc(atom_b)%r - r_last_update_pbc(atom_a)%r + rab = rab + cell_v + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) IF (rab2 <= rab2_max) THEN CALL get_force_eam(rab2, eam_a, eam_b, eam_data, atom_a, atom_b, f_eam) f_eam = f_eam*fac @@ -462,23 +462,23 @@ SUBROUTINE force_nonbond_manybody(fist_nonbond_env, particle_set, cell, & fr(1) = -f_eam*rab(1) fr(2) = -f_eam*rab(2) fr(3) = -f_eam*rab(3) - f_nonbond(1, atom_a) = f_nonbond(1, atom_a)-fr(1) - f_nonbond(2, atom_a) = f_nonbond(2, atom_a)-fr(2) - f_nonbond(3, atom_a) = f_nonbond(3, atom_a)-fr(3) + f_nonbond(1, atom_a) = f_nonbond(1, atom_a) - fr(1) + f_nonbond(2, atom_a) = f_nonbond(2, atom_a) - fr(2) + f_nonbond(3, atom_a) = f_nonbond(3, atom_a) - fr(3) - f_nonbond(1, atom_b) = f_nonbond(1, atom_b)+fr(1) - f_nonbond(2, atom_b) = f_nonbond(2, atom_b)+fr(2) - f_nonbond(3, atom_b) = f_nonbond(3, atom_b)+fr(3) + f_nonbond(1, atom_b) = f_nonbond(1, atom_b) + fr(1) + f_nonbond(2, atom_b) = f_nonbond(2, atom_b) + fr(2) + f_nonbond(3, atom_b) = f_nonbond(3, atom_b) + fr(3) IF (use_virial) THEN - ptens11 = ptens11+rab(1)*fr(1) - ptens21 = ptens21+rab(2)*fr(1) - ptens31 = ptens31+rab(3)*fr(1) - ptens12 = ptens12+rab(1)*fr(2) - ptens22 = ptens22+rab(2)*fr(2) - ptens32 = ptens32+rab(3)*fr(2) - ptens13 = ptens13+rab(1)*fr(3) - ptens23 = ptens23+rab(2)*fr(3) - ptens33 = ptens33+rab(3)*fr(3) + ptens11 = ptens11 + rab(1)*fr(1) + ptens21 = ptens21 + rab(2)*fr(1) + ptens31 = ptens31 + rab(3)*fr(1) + ptens12 = ptens12 + rab(1)*fr(2) + ptens22 = ptens22 + rab(2)*fr(2) + ptens32 = ptens32 + rab(3)*fr(2) + ptens13 = ptens13 + rab(1)*fr(3) + ptens23 = ptens23 + rab(2)*fr(3) + ptens33 = ptens33 + rab(3)*fr(3) END IF ENDIF END DO @@ -509,7 +509,7 @@ SUBROUTINE force_nonbond_manybody(fist_nonbond_env, particle_set, cell, & DO i = 1, SIZE(pot%type) ! TERSOFF IF (pot%type(i) == tersoff_type) THEN - npairs = iend-istart+1 + npairs = iend - istart + 1 tersoff => pot%set(i)%tersoff ALLOCATE (sort_list(2, npairs), work_list(npairs)) sort_list = list(:, istart:iend) @@ -522,8 +522,8 @@ SUBROUTINE force_nonbond_manybody(fist_nonbond_env, particle_set, cell, & sort_list(2, :) = work_list ! find number of unique elements of array index 1 nunique = 1 - DO ipair = 1, npairs-1 - IF (sort_list(1, ipair+1) /= sort_list(1, ipair)) nunique = nunique+1 + DO ipair = 1, npairs - 1 + IF (sort_list(1, ipair + 1) /= sort_list(1, ipair)) nunique = nunique + 1 END DO ipair = 1 junique = sort_list(1, ipair) @@ -538,22 +538,22 @@ SUBROUTINE force_nonbond_manybody(fist_nonbond_env, particle_set, cell, & DO mpair = ifirst, SIZE(glob_loc_list_a) IF (glob_loc_list_a(mpair) /= atom_a) EXIT END DO - ilast = mpair-1 + ilast = mpair - 1 nloc_size = 0 - IF (ifirst /= 0) nloc_size = ilast-ifirst+1 + IF (ifirst /= 0) nloc_size = ilast - ifirst + 1 DO WHILE (ipair <= npairs) IF (sort_list(1, ipair) /= junique) EXIT atom_b = sort_list(2, ipair) ! Derivative terms - rtmp = r_last_update_pbc(atom_b)%r(:)-r_last_update_pbc(atom_a)%r(:)+cell_v - ipair = ipair+1 + rtmp = r_last_update_pbc(atom_b)%r(:) - r_last_update_pbc(atom_a)%r(:) + cell_v + ipair = ipair + 1 IF (DOT_PRODUCT(rtmp, rtmp) <= tersoff%rcutsq) THEN CALL tersoff_forces(tersoff, r_last_update_pbc, cell_v, & nloc_size, glob_loc_list(:, ifirst:ilast), glob_cell_v(:, ifirst:ilast), & atom_a, atom_b, f_nonbond, pv_nonbond, use_virial, tersoff%rcutsq) END IF END DO - ifirst = ilast+1 + ifirst = ilast + 1 IF (ipair <= npairs) junique = sort_list(1, ipair) END DO DEALLOCATE (sort_list, work_list) @@ -586,7 +586,7 @@ SUBROUTINE force_nonbond_manybody(fist_nonbond_env, particle_set, cell, & DO i = 1, SIZE(pot%type) ! SIEPMANN IF (pot%type(i) == siepmann_type) THEN - npairs = iend-istart+1 + npairs = iend - istart + 1 siepmann => pot%set(i)%siepmann ALLOCATE (sort_list(2, npairs), work_list(npairs)) sort_list = list(:, istart:iend) @@ -599,8 +599,8 @@ SUBROUTINE force_nonbond_manybody(fist_nonbond_env, particle_set, cell, & sort_list(2, :) = work_list ! find number of unique elements of array index 1 nunique = 1 - DO ipair = 1, npairs-1 - IF (sort_list(1, ipair+1) /= sort_list(1, ipair)) nunique = nunique+1 + DO ipair = 1, npairs - 1 + IF (sort_list(1, ipair + 1) /= sort_list(1, ipair)) nunique = nunique + 1 END DO ipair = 1 junique = sort_list(1, ipair) @@ -615,15 +615,15 @@ SUBROUTINE force_nonbond_manybody(fist_nonbond_env, particle_set, cell, & DO mpair = ifirst, SIZE(glob_loc_list_a) IF (glob_loc_list_a(mpair) /= atom_a) EXIT END DO - ilast = mpair-1 + ilast = mpair - 1 nloc_size = 0 - IF (ifirst /= 0) nloc_size = ilast-ifirst+1 + IF (ifirst /= 0) nloc_size = ilast - ifirst + 1 DO WHILE (ipair <= npairs) IF (sort_list(1, ipair) /= junique) EXIT atom_b = sort_list(2, ipair) ! Derivative terms - rtmp = r_last_update_pbc(atom_b)%r(:)-r_last_update_pbc(atom_a)%r(:)+cell_v - ipair = ipair+1 + rtmp = r_last_update_pbc(atom_b)%r(:) - r_last_update_pbc(atom_a)%r(:) + cell_v + ipair = ipair + 1 IF (DOT_PRODUCT(rtmp, rtmp) <= siepmann%rcutsq) THEN CALL siepmann_forces_v2(siepmann, r_last_update_pbc, cell_v, cell, & atom_a, atom_b, f_nonbond, use_virial, siepmann%rcutsq, & @@ -634,7 +634,7 @@ SUBROUTINE force_nonbond_manybody(fist_nonbond_env, particle_set, cell, & cell, particle_set) END IF END DO - ifirst = ilast+1 + ifirst = ilast + 1 IF (ipair <= npairs) junique = sort_list(1, ipair) END DO DEALLOCATE (sort_list, work_list) @@ -645,15 +645,15 @@ SUBROUTINE force_nonbond_manybody(fist_nonbond_env, particle_set, cell, & CALL destroy_siepmann_arrays(glob_loc_list, glob_cell_v, glob_loc_list_a) END IF IF (use_virial) THEN - pv_nonbond(1, 1) = pv_nonbond(1, 1)+ptens11 - pv_nonbond(1, 2) = pv_nonbond(1, 2)+ptens12 - pv_nonbond(1, 3) = pv_nonbond(1, 3)+ptens13 - pv_nonbond(2, 1) = pv_nonbond(2, 1)+ptens21 - pv_nonbond(2, 2) = pv_nonbond(2, 2)+ptens22 - pv_nonbond(2, 3) = pv_nonbond(2, 3)+ptens23 - pv_nonbond(3, 1) = pv_nonbond(3, 1)+ptens31 - pv_nonbond(3, 2) = pv_nonbond(3, 2)+ptens32 - pv_nonbond(3, 3) = pv_nonbond(3, 3)+ptens33 + pv_nonbond(1, 1) = pv_nonbond(1, 1) + ptens11 + pv_nonbond(1, 2) = pv_nonbond(1, 2) + ptens12 + pv_nonbond(1, 3) = pv_nonbond(1, 3) + ptens13 + pv_nonbond(2, 1) = pv_nonbond(2, 1) + ptens21 + pv_nonbond(2, 2) = pv_nonbond(2, 2) + ptens22 + pv_nonbond(2, 3) = pv_nonbond(2, 3) + ptens23 + pv_nonbond(3, 1) = pv_nonbond(3, 1) + ptens31 + pv_nonbond(3, 2) = pv_nonbond(3, 2) + ptens32 + pv_nonbond(3, 3) = pv_nonbond(3, 3) + ptens33 END IF CALL timestop(handle) END SUBROUTINE force_nonbond_manybody diff --git a/src/manybody_quip.F b/src/manybody_quip.F index 9797683551..c1ba4d4526 100644 --- a/src/manybody_quip.F +++ b/src/manybody_quip.F @@ -8,21 +8,21 @@ MODULE manybody_quip USE cp_log_handling, ONLY: cp_logger_get_default_io_unit USE atomic_kind_types, ONLY: atomic_kind_type USE bibliography, ONLY: QUIP_ref, & - cite_reference + cite_reference USE cell_types, ONLY: cell_type USE cp_para_types, ONLY: cp_para_env_type USE fist_nonbond_env_types, ONLY: fist_nonbond_env_get, & - fist_nonbond_env_set, & - fist_nonbond_env_type, & - quip_data_type + fist_nonbond_env_set, & + fist_nonbond_env_type, & + quip_data_type USE kinds, ONLY: dp USE pair_potential_types, ONLY: pair_potential_pp_type, & - pair_potential_single_type, & - quip_pot_type, & - quip_type + pair_potential_single_type, & + quip_pot_type, & + quip_type USE particle_types, ONLY: particle_type USE physcon, ONLY: angstrom, & - evolt + evolt #ifdef __QUIP USE quip_unified_wrapper_module, ONLY: quip_unified_wrapper #endif @@ -115,7 +115,7 @@ SUBROUTINE quip_energy_store_force_virial(particle_set, cell, atomic_kind_set, p iat_use = 0 DO iat = 1, n_atoms IF (.NOT. use_atom(iat)) CYCLE - iat_use = iat_use+1 + iat_use = iat_use + 1 pos(1:3, iat_use) = particle_set(iat)%r*angstrom elem_symbol(iat_use) = particle_set(iat)%atomic_kind%element_symbol END DO @@ -176,7 +176,7 @@ SUBROUTINE quip_energy_store_force_virial(particle_set, cell, atomic_kind_set, p iat_use = 0 DO iat = 1, n_atoms IF (use_atom(iat)) THEN - iat_use = iat_use+1 + iat_use = iat_use + 1 quip_data%use_indices(iat_use) = iat ENDIF END DO @@ -217,9 +217,9 @@ SUBROUTINE quip_add_force_virial(fist_nonbond_env, force, virial) DO iat_use = 1, SIZE(quip_data%use_indices) iat = quip_data%use_indices(iat_use) CPASSERT(iat >= 1 .AND. iat <= SIZE(force, 2)) - force(1:3, iat) = force(1:3, iat)+quip_data%force(1:3, iat_use) + force(1:3, iat) = force(1:3, iat) + quip_data%force(1:3, iat_use) END DO - virial = virial+quip_data%virial + virial = virial + quip_data%virial #endif END SUBROUTINE quip_add_force_virial diff --git a/src/manybody_siepmann.F b/src/manybody_siepmann.F index 78e8bddbf2..169852758d 100644 --- a/src/manybody_siepmann.F +++ b/src/manybody_siepmann.F @@ -101,7 +101,7 @@ SUBROUTINE siepmann_energy(pot_loc, siepmann, r_last_update_pbc, atom_a, atom_b, !three-body part pot_loc_v3 = E*f2*drij**(-siepmann%beta)*a_ij - pot_loc = pot_loc_v2+pot_loc_v3 + pot_loc = pot_loc_v2 + pot_loc_v3 END SUBROUTINE siepmann_energy @@ -123,7 +123,7 @@ FUNCTION siep_f2(siepmann, r) rcut = SQRT(siepmann%rcutsq) siep_f2 = 0.0_dp IF (r < rcut) THEN - siep_f2 = EXP(siepmann%B/(r-rcut)) + siep_f2 = EXP(siepmann%B/(r - rcut)) END IF END FUNCTION siep_f2 @@ -146,7 +146,7 @@ FUNCTION siep_f2_d(siepmann, r) B = siepmann%B siep_f2_d = 0.0_dp IF (r < rcut) THEN - siep_f2_d = -B*EXP(B/(r-rcut))/(r-rcut)**2 + siep_f2_d = -B*EXP(B/(r - rcut))/(r - rcut)**2 END IF END FUNCTION siep_f2_d @@ -193,7 +193,7 @@ FUNCTION siep_a_ij(siepmann, r_last_update_pbc, iparticle, jparticle, n_loc_size CALL get_atomic_kind(atomic_kind=particle_set(iparticle)%atomic_kind, & element_symbol=element_symbol) IF (element_symbol /= "O") RETURN - rji(:) = -1.0_dp*(r_last_update_pbc(jparticle)%r(:)-r_last_update_pbc(iparticle)%r(:)+cell_v) + rji(:) = -1.0_dp*(r_last_update_pbc(jparticle)%r(:) - r_last_update_pbc(iparticle)%r(:) + cell_v) drji = SQRT(DOT_PRODUCT(rji, rji)) DO ilist = 1, n_loc_size kparticle = full_loc_list(2, ilist) @@ -206,7 +206,7 @@ FUNCTION siep_a_ij(siepmann, r_last_update_pbc, iparticle, jparticle, n_loc_size IF (costheta < -1.0_dp) costheta = -1.0_dp IF (costheta > +1.0_dp) costheta = +1.0_dp theta = ACOS(costheta) - siep_a_ij = siep_a_ij+EXP(F*(COS(theta/2.0_dp))**2) + siep_a_ij = siep_a_ij + EXP(F*(COS(theta/2.0_dp))**2) END DO END FUNCTION siep_a_ij @@ -253,7 +253,7 @@ SUBROUTINE siep_a_ij_d(siepmann, r_last_update_pbc, iparticle, jparticle, f_nonb rab2_max = rcutsq F = siepmann%F - rji(:) = -1.0_dp*(r_last_update_pbc(jparticle)%r(:)-r_last_update_pbc(iparticle)%r(:)+cell_v) + rji(:) = -1.0_dp*(r_last_update_pbc(jparticle)%r(:) - r_last_update_pbc(iparticle)%r(:) + cell_v) drji = SQRT(DOT_PRODUCT(rji, rji)) rji_hat(:) = rji(:)/drji @@ -270,12 +270,12 @@ SUBROUTINE siep_a_ij_d(siepmann, r_last_update_pbc, iparticle, jparticle, f_nonb IF (costheta < -1.0_dp) costheta = -1.0_dp IF (costheta > +1.0_dp) costheta = +1.0_dp - dcosdri(:) = (1.0_dp/(drji))*(rjk_hat(:)-costheta*rji_hat(:)) - dcosdrk(:) = (1.0_dp/(drjk))*(rji_hat(:)-costheta*rjk_hat(:)) - dcosdrj(:) = -(dcosdri(:)+dcosdrk(:)) + dcosdri(:) = (1.0_dp/(drji))*(rjk_hat(:) - costheta*rji_hat(:)) + dcosdrk(:) = (1.0_dp/(drjk))*(rji_hat(:) - costheta*rjk_hat(:)) + dcosdrj(:) = -(dcosdri(:) + dcosdrk(:)) theta = ACOS(costheta) - dcos_thetahalf = -1.0_dp/(2.0_dp*SQRT(1-costheta**2)) + dcos_thetahalf = -1.0_dp/(2.0_dp*SQRT(1 - costheta**2)) d_expterm = -2.0_dp*F*COS(theta/2.0_dp)*SIN(theta/2.0_dp) & *EXP(F*(COS(theta/2.0_dp))**2) @@ -285,17 +285,17 @@ SUBROUTINE siep_a_ij_d(siepmann, r_last_update_pbc, iparticle, jparticle, f_nonb drk = d_expterm*dcos_thetahalf*dcosdrk - f_nonbond(1, iparticle) = f_nonbond(1, iparticle)+prefactor*dri(1) - f_nonbond(2, iparticle) = f_nonbond(2, iparticle)+prefactor*dri(2) - f_nonbond(3, iparticle) = f_nonbond(3, iparticle)+prefactor*dri(3) + f_nonbond(1, iparticle) = f_nonbond(1, iparticle) + prefactor*dri(1) + f_nonbond(2, iparticle) = f_nonbond(2, iparticle) + prefactor*dri(2) + f_nonbond(3, iparticle) = f_nonbond(3, iparticle) + prefactor*dri(3) - f_nonbond(1, jparticle) = f_nonbond(1, jparticle)+prefactor*drj(1) - f_nonbond(2, jparticle) = f_nonbond(2, jparticle)+prefactor*drj(2) - f_nonbond(3, jparticle) = f_nonbond(3, jparticle)+prefactor*drj(3) + f_nonbond(1, jparticle) = f_nonbond(1, jparticle) + prefactor*drj(1) + f_nonbond(2, jparticle) = f_nonbond(2, jparticle) + prefactor*drj(2) + f_nonbond(3, jparticle) = f_nonbond(3, jparticle) + prefactor*drj(3) - f_nonbond(1, kparticle) = f_nonbond(1, kparticle)+prefactor*drk(1) - f_nonbond(2, kparticle) = f_nonbond(2, kparticle)+prefactor*drk(2) - f_nonbond(3, kparticle) = f_nonbond(3, kparticle)+prefactor*drk(3) + f_nonbond(1, kparticle) = f_nonbond(1, kparticle) + prefactor*drk(1) + f_nonbond(2, kparticle) = f_nonbond(2, kparticle) + prefactor*drk(2) + f_nonbond(3, kparticle) = f_nonbond(3, kparticle) + prefactor*drk(3) IF (use_virial) THEN CALL cp_abort(__LOCATION__, & @@ -351,7 +351,7 @@ FUNCTION siep_Phi_ij(siepmann, r_last_update_pbc, iparticle, jparticle, & CALL get_atomic_kind(atomic_kind=particle_set(iparticle)%atomic_kind, & element_symbol=element_symbol) IF (element_symbol /= "O") RETURN - rji(:) = -1.0_dp*(r_last_update_pbc(jparticle)%r(:)-r_last_update_pbc(iparticle)%r(:)+cell_v) + rji(:) = -1.0_dp*(r_last_update_pbc(jparticle)%r(:) - r_last_update_pbc(iparticle)%r(:) + cell_v) drji = SQRT(DOT_PRODUCT(rji, rji)) DO iatom = 1, natom @@ -361,7 +361,7 @@ FUNCTION siep_Phi_ij(siepmann, r_last_update_pbc, iparticle, jparticle, & rih(:) = pbc(r_last_update_pbc(iparticle)%r(:), r_last_update_pbc(iatom)%r(:), cell) drih = SQRT(DOT_PRODUCT(rih, rih)) IF (drih >= h_max_dist) CYCLE - count_h = count_h+1 + count_h = count_h + 1 IF (count_h == 1) THEN index_h1 = iatom ELSEIF (count_h == 2) THEN @@ -371,21 +371,21 @@ FUNCTION siep_Phi_ij(siepmann, r_last_update_pbc, iparticle, jparticle, & IF (count_h == 0) THEN IF (siepmann%allow_o_formation) THEN - IF (PRESENT(nr_o)) nr_o = nr_o+1 + IF (PRESENT(nr_o)) nr_o = nr_o + 1 siep_Phi_ij = 0.0_dp ELSE CPABORT("No H atoms for O found") ENDIF ELSEIF (count_h == 1) THEN IF (siepmann%allow_oh_formation) THEN - IF (PRESENT(nr_oh)) nr_oh = nr_oh+1 + IF (PRESENT(nr_oh)) nr_oh = nr_oh + 1 siep_Phi_ij = 0.0_dp ELSE CPABORT("Only one H atom of O atom found") ENDIF ELSEIF (count_h == 3) THEN IF (siepmann%allow_h3o_formation) THEN - IF (PRESENT(nr_h3o)) nr_h3o = nr_h3o+1 + IF (PRESENT(nr_h3o)) nr_h3o = nr_h3o + 1 siep_Phi_ij = 0.0_dp ELSE CPABORT("Three H atoms for O atom found") @@ -398,12 +398,12 @@ FUNCTION siep_Phi_ij(siepmann, r_last_update_pbc, iparticle, jparticle, & !dipole vector rix of the H2O molecule rih1(:) = pbc(r_last_update_pbc(iparticle)%r(:), r_last_update_pbc(index_h1)%r(:), cell) rih2(:) = pbc(r_last_update_pbc(iparticle)%r(:), r_last_update_pbc(index_h2)%r(:), cell) - rix(:) = rih1(:)+rih2(:) + rix(:) = rih1(:) + rih2(:) drix = SQRT(DOT_PRODUCT(rix, rix)) cosphi = DOT_PRODUCT(rji, rix)/(drji*drix) IF (cosphi < -1.0_dp) cosphi = -1.0_dp IF (cosphi > +1.0_dp) cosphi = +1.0_dp - siep_Phi_ij = EXP(-8.0_dp*((cosphi-1)/4.0_dp)**4) + siep_Phi_ij = EXP(-8.0_dp*((cosphi - 1)/4.0_dp)**4) ENDIF END FUNCTION siep_Phi_ij @@ -455,7 +455,7 @@ SUBROUTINE siep_Phi_ij_d(siepmann, r_last_update_pbc, iparticle, jparticle, f_no Phi_ij = siep_Phi_ij(siepmann, r_last_update_pbc, iparticle, jparticle, & cell_v, cell, rcutsq, & particle_set) - rji(:) = -1.0_dp*(r_last_update_pbc(jparticle)%r(:)-r_last_update_pbc(iparticle)%r(:)+cell_v) + rji(:) = -1.0_dp*(r_last_update_pbc(jparticle)%r(:) - r_last_update_pbc(iparticle)%r(:) + cell_v) drji = SQRT(DOT_PRODUCT(rji, rji)) rji_hat(:) = rji(:)/drji @@ -466,7 +466,7 @@ SUBROUTINE siep_Phi_ij_d(siepmann, r_last_update_pbc, iparticle, jparticle, f_no rih(:) = pbc(r_last_update_pbc(iparticle)%r(:), r_last_update_pbc(iatom)%r(:), cell) drih = SQRT(DOT_PRODUCT(rih, rih)) IF (drih >= h_max_dist) CYCLE - count_h = count_h+1 + count_h = count_h + 1 IF (count_h == 1) THEN index_h1 = iatom ELSEIF (count_h == 2) THEN @@ -488,39 +488,39 @@ SUBROUTINE siep_Phi_ij_d(siepmann, r_last_update_pbc, iparticle, jparticle, f_no !dipole vector rix of the H2O molecule rih1(:) = pbc(r_last_update_pbc(iparticle)%r(:), r_last_update_pbc(index_h1)%r(:), cell) rih2(:) = pbc(r_last_update_pbc(iparticle)%r(:), r_last_update_pbc(index_h2)%r(:), cell) - rix(:) = rih1(:)+rih2(:) + rix(:) = rih1(:) + rih2(:) drix = SQRT(DOT_PRODUCT(rix, rix)) rix_hat(:) = rix(:)/drix cosphi = DOT_PRODUCT(rji, rix)/(drji*drix) IF (cosphi < -1.0_dp) cosphi = -1.0_dp IF (cosphi > +1.0_dp) cosphi = +1.0_dp - dcosdrj(:) = (1.0_dp/(drji))*(-rix_hat(:)+cosphi*rji_hat(:)) + dcosdrj(:) = (1.0_dp/(drji))*(-rix_hat(:) + cosphi*rji_hat(:)) ! for H atoms: - dcosdrh(:) = (1.0_dp/(drix))*(rji_hat(:)-cosphi*rix_hat(:)) - dcosdri(:) = -dcosdrj-2.0_dp*dcosdrh + dcosdrh(:) = (1.0_dp/(drix))*(rji_hat(:) - cosphi*rix_hat(:)) + dcosdri(:) = -dcosdrj - 2.0_dp*dcosdrh - dphi = Phi_ij*(-8.0_dp)*((cosphi-1)/4.0_dp)**3 + dphi = Phi_ij*(-8.0_dp)*((cosphi - 1)/4.0_dp)**3 dri = dphi*dcosdri drj = dphi*dcosdrj drh = dphi*dcosdrh - f_nonbond(1, iparticle) = f_nonbond(1, iparticle)+prefactor*dri(1) - f_nonbond(2, iparticle) = f_nonbond(2, iparticle)+prefactor*dri(2) - f_nonbond(3, iparticle) = f_nonbond(3, iparticle)+prefactor*dri(3) + f_nonbond(1, iparticle) = f_nonbond(1, iparticle) + prefactor*dri(1) + f_nonbond(2, iparticle) = f_nonbond(2, iparticle) + prefactor*dri(2) + f_nonbond(3, iparticle) = f_nonbond(3, iparticle) + prefactor*dri(3) - f_nonbond(1, jparticle) = f_nonbond(1, jparticle)+prefactor*drj(1) - f_nonbond(2, jparticle) = f_nonbond(2, jparticle)+prefactor*drj(2) - f_nonbond(3, jparticle) = f_nonbond(3, jparticle)+prefactor*drj(3) + f_nonbond(1, jparticle) = f_nonbond(1, jparticle) + prefactor*drj(1) + f_nonbond(2, jparticle) = f_nonbond(2, jparticle) + prefactor*drj(2) + f_nonbond(3, jparticle) = f_nonbond(3, jparticle) + prefactor*drj(3) - f_nonbond(1, index_h1) = f_nonbond(1, index_h1)+prefactor*drh(1) - f_nonbond(2, index_h1) = f_nonbond(2, index_h1)+prefactor*drh(2) - f_nonbond(3, index_h1) = f_nonbond(3, index_h1)+prefactor*drh(3) + f_nonbond(1, index_h1) = f_nonbond(1, index_h1) + prefactor*drh(1) + f_nonbond(2, index_h1) = f_nonbond(2, index_h1) + prefactor*drh(2) + f_nonbond(3, index_h1) = f_nonbond(3, index_h1) + prefactor*drh(3) - f_nonbond(1, index_h2) = f_nonbond(1, index_h2)+prefactor*drh(1) - f_nonbond(2, index_h2) = f_nonbond(2, index_h2)+prefactor*drh(2) - f_nonbond(3, index_h2) = f_nonbond(3, index_h2)+prefactor*drh(3) + f_nonbond(1, index_h2) = f_nonbond(1, index_h2) + prefactor*drh(1) + f_nonbond(2, index_h2) = f_nonbond(2, index_h2) + prefactor*drh(2) + f_nonbond(3, index_h2) = f_nonbond(3, index_h2) + prefactor*drh(3) IF (use_virial) THEN CALL cp_abort(__LOCATION__, & @@ -578,7 +578,7 @@ SUBROUTINE siepmann_forces_v3(siepmann, r_last_update_pbc, cell_v, n_loc_size, & element_symbol=element_symbol) IF (element_symbol /= "O") RETURN - rji(:) = -1.0_dp*(r_last_update_pbc(jparticle)%r(:)-r_last_update_pbc(iparticle)%r(:)+cell_v) + rji(:) = -1.0_dp*(r_last_update_pbc(jparticle)%r(:) - r_last_update_pbc(iparticle)%r(:) + cell_v) drji = SQRT(DOT_PRODUCT(rji, rji)) rji_hat(:) = rji(:)/drji @@ -590,12 +590,12 @@ SUBROUTINE siepmann_forces_v3(siepmann, r_last_update_pbc, cell_v, n_loc_size, & ! Lets do the f_A1 piece derivative of f2 f_A1 = E*f2_d*drji**(-beta)*a_ij*fac*(1.0_dp/drji) - f_nonbond(1, iparticle) = f_nonbond(1, iparticle)+f_A1*rji(1) - f_nonbond(2, iparticle) = f_nonbond(2, iparticle)+f_A1*rji(2) - f_nonbond(3, iparticle) = f_nonbond(3, iparticle)+f_A1*rji(3) - f_nonbond(1, jparticle) = f_nonbond(1, jparticle)-f_A1*rji(1) - f_nonbond(2, jparticle) = f_nonbond(2, jparticle)-f_A1*rji(2) - f_nonbond(3, jparticle) = f_nonbond(3, jparticle)-f_A1*rji(3) + f_nonbond(1, iparticle) = f_nonbond(1, iparticle) + f_A1*rji(1) + f_nonbond(2, iparticle) = f_nonbond(2, iparticle) + f_A1*rji(2) + f_nonbond(3, iparticle) = f_nonbond(3, iparticle) + f_A1*rji(3) + f_nonbond(1, jparticle) = f_nonbond(1, jparticle) - f_A1*rji(1) + f_nonbond(2, jparticle) = f_nonbond(2, jparticle) - f_A1*rji(2) + f_nonbond(3, jparticle) = f_nonbond(3, jparticle) - f_A1*rji(3) IF (use_virial) THEN CALL cp_abort(__LOCATION__, & @@ -604,13 +604,13 @@ SUBROUTINE siepmann_forces_v3(siepmann, r_last_update_pbc, cell_v, n_loc_size, & END IF ! Lets do the f_A2 piece derivative of rji**(-beta) - f_A2 = E*f2*(-beta)*drji**(-beta-1)*a_ij*fac*(1.0_dp/drji) - f_nonbond(1, iparticle) = f_nonbond(1, iparticle)+f_A2*rji(1) - f_nonbond(2, iparticle) = f_nonbond(2, iparticle)+f_A2*rji(2) - f_nonbond(3, iparticle) = f_nonbond(3, iparticle)+f_A2*rji(3) - f_nonbond(1, jparticle) = f_nonbond(1, jparticle)-f_A2*rji(1) - f_nonbond(2, jparticle) = f_nonbond(2, jparticle)-f_A2*rji(2) - f_nonbond(3, jparticle) = f_nonbond(3, jparticle)-f_A2*rji(3) + f_A2 = E*f2*(-beta)*drji**(-beta - 1)*a_ij*fac*(1.0_dp/drji) + f_nonbond(1, iparticle) = f_nonbond(1, iparticle) + f_A2*rji(1) + f_nonbond(2, iparticle) = f_nonbond(2, iparticle) + f_A2*rji(2) + f_nonbond(3, iparticle) = f_nonbond(3, iparticle) + f_A2*rji(3) + f_nonbond(1, jparticle) = f_nonbond(1, jparticle) - f_A2*rji(1) + f_nonbond(2, jparticle) = f_nonbond(2, jparticle) - f_A2*rji(2) + f_nonbond(3, jparticle) = f_nonbond(3, jparticle) - f_A2*rji(3) IF (use_virial) THEN CALL cp_abort(__LOCATION__, & @@ -666,7 +666,7 @@ SUBROUTINE siepmann_forces_v2(siepmann, r_last_update_pbc, cell_v, cell, & element_symbol=element_symbol) IF (element_symbol /= "O") RETURN - rji(:) = -1.0_dp*(r_last_update_pbc(jparticle)%r(:)-r_last_update_pbc(iparticle)%r(:)+cell_v) + rji(:) = -1.0_dp*(r_last_update_pbc(jparticle)%r(:) - r_last_update_pbc(iparticle)%r(:) + cell_v) drji = SQRT(DOT_PRODUCT(rji, rji)) fac = -1.0_dp @@ -677,12 +677,12 @@ SUBROUTINE siepmann_forces_v2(siepmann, r_last_update_pbc, cell_v, cell, & ! Lets do the f_A1 piece derivative of f2 f_A1 = -D*f2_d*drji**(-3)*Phi_ij*fac*(1.0_dp/drji) - f_nonbond(1, iparticle) = f_nonbond(1, iparticle)+f_A1*rji(1) - f_nonbond(2, iparticle) = f_nonbond(2, iparticle)+f_A1*rji(2) - f_nonbond(3, iparticle) = f_nonbond(3, iparticle)+f_A1*rji(3) - f_nonbond(1, jparticle) = f_nonbond(1, jparticle)-f_A1*rji(1) - f_nonbond(2, jparticle) = f_nonbond(2, jparticle)-f_A1*rji(2) - f_nonbond(3, jparticle) = f_nonbond(3, jparticle)-f_A1*rji(3) + f_nonbond(1, iparticle) = f_nonbond(1, iparticle) + f_A1*rji(1) + f_nonbond(2, iparticle) = f_nonbond(2, iparticle) + f_A1*rji(2) + f_nonbond(3, iparticle) = f_nonbond(3, iparticle) + f_A1*rji(3) + f_nonbond(1, jparticle) = f_nonbond(1, jparticle) - f_A1*rji(1) + f_nonbond(2, jparticle) = f_nonbond(2, jparticle) - f_A1*rji(2) + f_nonbond(3, jparticle) = f_nonbond(3, jparticle) - f_A1*rji(3) IF (use_virial) THEN CALL cp_abort(__LOCATION__, & @@ -692,12 +692,12 @@ SUBROUTINE siepmann_forces_v2(siepmann, r_last_update_pbc, cell_v, cell, & ! ! Lets do the f_A2 piece derivative of rji**(-3) f_A2 = -D*f2*(-3.0_dp)*drji**(-4)*Phi_ij*fac*(1.0_dp/drji) - f_nonbond(1, iparticle) = f_nonbond(1, iparticle)+f_A2*rji(1) - f_nonbond(2, iparticle) = f_nonbond(2, iparticle)+f_A2*rji(2) - f_nonbond(3, iparticle) = f_nonbond(3, iparticle)+f_A2*rji(3) - f_nonbond(1, jparticle) = f_nonbond(1, jparticle)-f_A2*rji(1) - f_nonbond(2, jparticle) = f_nonbond(2, jparticle)-f_A2*rji(2) - f_nonbond(3, jparticle) = f_nonbond(3, jparticle)-f_A2*rji(3) + f_nonbond(1, iparticle) = f_nonbond(1, iparticle) + f_A2*rji(1) + f_nonbond(2, iparticle) = f_nonbond(2, iparticle) + f_A2*rji(2) + f_nonbond(3, iparticle) = f_nonbond(3, iparticle) + f_A2*rji(3) + f_nonbond(1, jparticle) = f_nonbond(1, jparticle) - f_A2*rji(1) + f_nonbond(2, jparticle) = f_nonbond(2, jparticle) - f_A2*rji(2) + f_nonbond(3, jparticle) = f_nonbond(3, jparticle) - f_A2*rji(3) IF (use_virial) THEN CALL cp_abort(__LOCATION__, & @@ -761,10 +761,10 @@ SUBROUTINE setup_siepmann_arrays(nonbonded, potparm, glob_loc_list, glob_cell_v, ikind = neighbor_kind_pair%ij_kind(1, igrp) jkind = neighbor_kind_pair%ij_kind(2, igrp) pot => potparm%pot(ikind, jkind)%pot - npairs = iend-istart+1 + npairs = iend - istart + 1 IF (pot%no_mb) CYCLE DO i = 1, SIZE(pot%type) - IF (pot%type(i) == siepmann_type) npairs_tot = npairs_tot+npairs + IF (pot%type(i) == siepmann_type) npairs_tot = npairs_tot + npairs END DO END DO Kind_Group_Loop1 END DO @@ -786,17 +786,17 @@ SUBROUTINE setup_siepmann_arrays(nonbonded, potparm, glob_loc_list, glob_cell_v, list => neighbor_kind_pair%list cvi = neighbor_kind_pair%cell_vector pot => potparm%pot(ikind, jkind)%pot - npairs = iend-istart+1 + npairs = iend - istart + 1 IF (pot%no_mb) CYCLE CALL matvec_3x3(cell_v, cell%hmat, cvi) DO i = 1, SIZE(pot%type) ! SIEPMANN IF (pot%type(i) == siepmann_type) THEN DO ipair = 1, npairs - glob_loc_list(:, npairs_tot+ipair) = list(:, istart-1+ipair) - glob_cell_v(1:3, npairs_tot+ipair) = cell_v(1:3) + glob_loc_list(:, npairs_tot + ipair) = list(:, istart - 1 + ipair) + glob_cell_v(1:3, npairs_tot + ipair) = cell_v(1:3) END DO - npairs_tot = npairs_tot+npairs + npairs_tot = npairs_tot + npairs END IF END DO END DO Kind_Group_Loop2 diff --git a/src/manybody_tersoff.F b/src/manybody_tersoff.F index def5a295c6..47b4b1f7c2 100644 --- a/src/manybody_tersoff.F +++ b/src/manybody_tersoff.F @@ -68,7 +68,7 @@ SUBROUTINE tersoff_energy(pot_loc, tersoff, r_last_update_pbc, atom_a, atom_b, n f_C = ter_f_C(tersoff, drij) f_A = ter_f_A(tersoff, drij) f_R = ter_f_R(tersoff, drij) - pot_loc = f_C*(f_R+b_ij*f_A) + pot_loc = f_C*(f_R + b_ij*f_A) END SUBROUTINE tersoff_energy @@ -90,13 +90,13 @@ FUNCTION ter_f_C(tersoff, r) bigR = tersoff%bigR bigD = tersoff%bigD - RmD = tersoff%bigR-tersoff%bigD - RpD = tersoff%bigR+tersoff%bigD + RmD = tersoff%bigR - tersoff%bigD + RpD = tersoff%bigR + tersoff%bigD ter_f_C = 0.0_dp IF (r < RmD) ter_f_C = 1.0_dp IF (r > RpD) ter_f_C = 0.0_dp IF ((r < RpD) .AND. (r > RmD)) THEN - ter_f_C = 0.5_dp*(1.0_dp-SIN(0.5_dp*PI*(r-bigR)/(bigD))) + ter_f_C = 0.5_dp*(1.0_dp - SIN(0.5_dp*PI*(r - bigR)/(bigD))) END IF END FUNCTION ter_f_C @@ -118,13 +118,13 @@ FUNCTION ter_f_C_d(tersoff, r) bigR = tersoff%bigR bigD = tersoff%bigD - RmD = tersoff%bigR-tersoff%bigD - RpD = tersoff%bigR+tersoff%bigD + RmD = tersoff%bigR - tersoff%bigD + RpD = tersoff%bigR + tersoff%bigD ter_f_C_d = 0.0_dp IF (r < RmD) ter_f_C_d = 0.0_dp IF (r > RpD) ter_f_C_d = 0.0_dp IF ((r < RpD) .AND. (r > RmD)) THEN - ter_f_C_d = (0.25_dp*PI/bigD)*COS(0.5_dp*PI*(r-bigR)/(bigD))/r + ter_f_C_d = (0.25_dp*PI/bigD)*COS(0.5_dp*PI*(r - bigR)/(bigD))/r END IF END FUNCTION ter_f_C_d @@ -279,7 +279,7 @@ FUNCTION ter_b_ij(tersoff, r_last_update_pbc, iparticle, jparticle, n_loc_size, ter_b_ij = 0.0_dp zeta_ij = ter_zeta_ij(tersoff, r_last_update_pbc, iparticle, jparticle, & n_loc_size, full_loc_list, loc_cell_v, cell_v, rcutsq) - ter_b_ij = (1.0_dp+(beta*zeta_ij)**n)**(-0.5_dp/n) + ter_b_ij = (1.0_dp + (beta*zeta_ij)**n)**(-0.5_dp/n) END FUNCTION ter_b_ij @@ -319,12 +319,12 @@ FUNCTION ter_b_ij_d(tersoff, r_last_update_pbc, iparticle, jparticle, n_loc_size zeta_ij = ter_zeta_ij(tersoff, r_last_update_pbc, iparticle, jparticle, n_loc_size, & full_loc_list, loc_cell_v, cell_v, rcutsq) zeta_ij_nm1 = 0.0_dp - IF (zeta_ij > 0.0_dp) zeta_ij_nm1 = zeta_ij**(n-1.0_dp) + IF (zeta_ij > 0.0_dp) zeta_ij_nm1 = zeta_ij**(n - 1.0_dp) zeta_ij_n = zeta_ij**(n) ter_b_ij_d = 0.0_dp ter_b_ij_d = -0.5_dp*beta_n*zeta_ij_nm1* & - ((1.0_dp+beta_n*zeta_ij_n)**((-0.5_dp/n)-1.0_dp)) + ((1.0_dp + beta_n*zeta_ij_n)**((-0.5_dp/n) - 1.0_dp)) END FUNCTION ter_b_ij_d @@ -366,14 +366,14 @@ FUNCTION ter_zeta_ij(tersoff, r_last_update_pbc, iparticle, jparticle, n_loc_siz n = tersoff%n lambda3 = tersoff%lambda3 rab2_max = rcutsq - rij(:) = r_last_update_pbc(jparticle)%r(:)-r_last_update_pbc(iparticle)%r(:)+cell_v + rij(:) = r_last_update_pbc(jparticle)%r(:) - r_last_update_pbc(iparticle)%r(:) + cell_v drij = SQRT(DOT_PRODUCT(rij, rij)) ter_zeta_ij = 0.0_dp DO ilist = 1, n_loc_size kparticle = full_loc_list(2, ilist) IF (kparticle == jparticle) CYCLE cell_v_2 = loc_cell_v(:, ilist) - rik(:) = r_last_update_pbc(kparticle)%r(:)-r_last_update_pbc(iparticle)%r(:)+cell_v_2 + rik(:) = r_last_update_pbc(kparticle)%r(:) - r_last_update_pbc(iparticle)%r(:) + cell_v_2 drik = DOT_PRODUCT(rik, rik) IF (drik > rab2_max) CYCLE drik = SQRT(drik) @@ -382,8 +382,8 @@ FUNCTION ter_zeta_ij(tersoff, r_last_update_pbc, iparticle, jparticle, n_loc_siz IF (costheta > +1.0_dp) costheta = +1.0_dp f_C = ter_f_C(tersoff, drik) gterm = ter_g(tersoff, costheta) - expterm = EXP((lambda3*(drij-drik))**3) - ter_zeta_ij = ter_zeta_ij+f_C*gterm*expterm + expterm = EXP((lambda3*(drij - drik))**3) + ter_zeta_ij = ter_zeta_ij + f_C*gterm*expterm END DO END FUNCTION ter_zeta_ij @@ -435,7 +435,7 @@ SUBROUTINE ter_zeta_ij_d(tersoff, r_last_update_pbc, iparticle, jparticle, f_non lambda3 = tersoff%lambda3 rab2_max = rcutsq - rij(:) = r_last_update_pbc(jparticle)%r(:)-r_last_update_pbc(iparticle)%r(:)+cell_v + rij(:) = r_last_update_pbc(jparticle)%r(:) - r_last_update_pbc(iparticle)%r(:) + cell_v drij = SQRT(DOT_PRODUCT(rij, rij)) rij_hat(:) = rij(:)/drij @@ -444,7 +444,7 @@ SUBROUTINE ter_zeta_ij_d(tersoff, r_last_update_pbc, iparticle, jparticle, f_non kparticle = full_loc_list(2, ilist) IF (kparticle == jparticle) CYCLE cell_v_2 = loc_cell_v(:, ilist) - rik(:) = r_last_update_pbc(kparticle)%r(:)-r_last_update_pbc(iparticle)%r(:)+cell_v_2 + rik(:) = r_last_update_pbc(kparticle)%r(:) - r_last_update_pbc(iparticle)%r(:) + cell_v_2 drik = DOT_PRODUCT(rik, rik) IF (drik > rab2_max) CYCLE @@ -454,53 +454,53 @@ SUBROUTINE ter_zeta_ij_d(tersoff, r_last_update_pbc, iparticle, jparticle, f_non IF (costheta < -1.0_dp) costheta = -1.0_dp IF (costheta > +1.0_dp) costheta = +1.0_dp - dcosdrj(:) = (1.0_dp/(drij))*(rik_hat(:)-costheta*rij_hat(:)) - dcosdrk(:) = (1.0_dp/(drik))*(rij_hat(:)-costheta*rik_hat(:)) - dcosdri(:) = -(dcosdrj(:)+dcosdrk(:)) + dcosdrj(:) = (1.0_dp/(drij))*(rik_hat(:) - costheta*rij_hat(:)) + dcosdrk(:) = (1.0_dp/(drik))*(rij_hat(:) - costheta*rik_hat(:)) + dcosdri(:) = -(dcosdrj(:) + dcosdrk(:)) f_C = ter_f_C(tersoff, drik) f_C_d = ter_f_C_d(tersoff, drik) gterm = ter_g(tersoff, costheta) gterm_d = ter_g_d(tersoff, costheta) !still need d(costheta)/dR term - expterm = EXP((lambda3*(drij-drik))**3) - expterm_d = (3.0_dp)*(lambda3**3)*((drij-drik)**2)*expterm + expterm = EXP((lambda3*(drij - drik))**3) + expterm_d = (3.0_dp)*(lambda3**3)*((drij - drik)**2)*expterm dri = f_C_d*gterm*expterm*(rik) & - +f_C*gterm_d*expterm*(dcosdri) & - +f_C*gterm*expterm_d*(-rij_hat+rik_hat) + + f_C*gterm_d*expterm*(dcosdri) & + + f_C*gterm*expterm_d*(-rij_hat + rik_hat) !No f_C_d component for Rj drj = f_C*gterm_d*expterm*(dcosdrj) & - +f_C*gterm*expterm_d*(rij_hat) + + f_C*gterm*expterm_d*(rij_hat) drk = f_C_d*gterm*expterm*(-rik) & - +f_C*gterm_d*expterm*(dcosdrk) & - +f_C*gterm*expterm_d*(-rik_hat) + + f_C*gterm_d*expterm*(dcosdrk) & + + f_C*gterm*expterm_d*(-rik_hat) - f_nonbond(1, iparticle) = f_nonbond(1, iparticle)+prefactor*dri(1) - f_nonbond(2, iparticle) = f_nonbond(2, iparticle)+prefactor*dri(2) - f_nonbond(3, iparticle) = f_nonbond(3, iparticle)+prefactor*dri(3) + f_nonbond(1, iparticle) = f_nonbond(1, iparticle) + prefactor*dri(1) + f_nonbond(2, iparticle) = f_nonbond(2, iparticle) + prefactor*dri(2) + f_nonbond(3, iparticle) = f_nonbond(3, iparticle) + prefactor*dri(3) - f_nonbond(1, jparticle) = f_nonbond(1, jparticle)+prefactor*drj(1) - f_nonbond(2, jparticle) = f_nonbond(2, jparticle)+prefactor*drj(2) - f_nonbond(3, jparticle) = f_nonbond(3, jparticle)+prefactor*drj(3) + f_nonbond(1, jparticle) = f_nonbond(1, jparticle) + prefactor*drj(1) + f_nonbond(2, jparticle) = f_nonbond(2, jparticle) + prefactor*drj(2) + f_nonbond(3, jparticle) = f_nonbond(3, jparticle) + prefactor*drj(3) - f_nonbond(1, kparticle) = f_nonbond(1, kparticle)+prefactor*drk(1) - f_nonbond(2, kparticle) = f_nonbond(2, kparticle)+prefactor*drk(2) - f_nonbond(3, kparticle) = f_nonbond(3, kparticle)+prefactor*drk(3) + f_nonbond(1, kparticle) = f_nonbond(1, kparticle) + prefactor*drk(1) + f_nonbond(2, kparticle) = f_nonbond(2, kparticle) + prefactor*drk(2) + f_nonbond(3, kparticle) = f_nonbond(3, kparticle) + prefactor*drk(3) IF (use_virial) THEN - pv_nonbond(1, 1) = pv_nonbond(1, 1)+prefactor*(rij(1)*drj(1)+rik(1)*drk(1)) - pv_nonbond(1, 2) = pv_nonbond(1, 2)+prefactor*(rij(1)*drj(2)+rik(1)*drk(2)) - pv_nonbond(1, 3) = pv_nonbond(1, 3)+prefactor*(rij(1)*drj(3)+rik(1)*drk(3)) + pv_nonbond(1, 1) = pv_nonbond(1, 1) + prefactor*(rij(1)*drj(1) + rik(1)*drk(1)) + pv_nonbond(1, 2) = pv_nonbond(1, 2) + prefactor*(rij(1)*drj(2) + rik(1)*drk(2)) + pv_nonbond(1, 3) = pv_nonbond(1, 3) + prefactor*(rij(1)*drj(3) + rik(1)*drk(3)) - pv_nonbond(2, 1) = pv_nonbond(2, 1)+prefactor*(rij(2)*drj(1)+rik(2)*drk(1)) - pv_nonbond(2, 2) = pv_nonbond(2, 2)+prefactor*(rij(2)*drj(2)+rik(2)*drk(2)) - pv_nonbond(2, 3) = pv_nonbond(2, 3)+prefactor*(rij(2)*drj(3)+rik(2)*drk(3)) + pv_nonbond(2, 1) = pv_nonbond(2, 1) + prefactor*(rij(2)*drj(1) + rik(2)*drk(1)) + pv_nonbond(2, 2) = pv_nonbond(2, 2) + prefactor*(rij(2)*drj(2) + rik(2)*drk(2)) + pv_nonbond(2, 3) = pv_nonbond(2, 3) + prefactor*(rij(2)*drj(3) + rik(2)*drk(3)) - pv_nonbond(3, 1) = pv_nonbond(3, 1)+prefactor*(rij(3)*drj(1)+rik(3)*drk(1)) - pv_nonbond(3, 2) = pv_nonbond(3, 2)+prefactor*(rij(3)*drj(2)+rik(3)*drk(2)) - pv_nonbond(3, 3) = pv_nonbond(3, 3)+prefactor*(rij(3)*drj(3)+rik(3)*drk(3)) + pv_nonbond(3, 1) = pv_nonbond(3, 1) + prefactor*(rij(3)*drj(1) + rik(3)*drk(1)) + pv_nonbond(3, 2) = pv_nonbond(3, 2) + prefactor*(rij(3)*drj(2) + rik(3)*drk(2)) + pv_nonbond(3, 3) = pv_nonbond(3, 3) + prefactor*(rij(3)*drj(3) + rik(3)*drk(3)) END IF END DO END SUBROUTINE ter_zeta_ij_d @@ -527,7 +527,7 @@ FUNCTION ter_g(tersoff, costheta) c2 = c*c d2 = d*d ter_g = 0.0_dp - ter_g = 1.0_dp+(c2/d2)-(c2)/(d2+(h-costheta)**2) + ter_g = 1.0_dp + (c2/d2) - (c2)/(d2 + (h - costheta)**2) END FUNCTION ter_g @@ -552,13 +552,13 @@ FUNCTION ter_g_d(tersoff, costheta) h = tersoff%h c2 = c*c d2 = d*d - hc = h-costheta + hc = h - costheta - sintheta = SQRT(1.0-costheta**2) + sintheta = SQRT(1.0 - costheta**2) ter_g_d = 0.0_dp ! Still need d(costheta)/dR - ter_g_d = (-2.0_dp*c2*hc)/(d2+hc**2)**2 + ter_g_d = (-2.0_dp*c2*hc)/(d2 + hc**2)**2 END FUNCTION ter_g_d ! ************************************************************************************************** @@ -602,7 +602,7 @@ SUBROUTINE tersoff_forces(tersoff, r_last_update_pbc, cell_v, n_loc_size, & rij_hat(3) CALL timeset(routineN, handle) - rij(:) = r_last_update_pbc(jparticle)%r(:)-r_last_update_pbc(iparticle)%r(:)+cell_v + rij(:) = r_last_update_pbc(jparticle)%r(:) - r_last_update_pbc(iparticle)%r(:) + cell_v drij = SQRT(DOT_PRODUCT(rij, rij)) rij_hat(:) = rij(:)/drij @@ -619,85 +619,85 @@ SUBROUTINE tersoff_forces(tersoff, r_last_update_pbc, cell_v, n_loc_size, & ! Lets do the easy one first, the repulsive term ! Note a_ij = 1.0_dp so just going to ignore it... f_R1 = f_C_d*f_R*fac - f_nonbond(1, iparticle) = f_nonbond(1, iparticle)+f_R1*rij(1) - f_nonbond(2, iparticle) = f_nonbond(2, iparticle)+f_R1*rij(2) - f_nonbond(3, iparticle) = f_nonbond(3, iparticle)+f_R1*rij(3) - f_nonbond(1, jparticle) = f_nonbond(1, jparticle)-f_R1*rij(1) - f_nonbond(2, jparticle) = f_nonbond(2, jparticle)-f_R1*rij(2) - f_nonbond(3, jparticle) = f_nonbond(3, jparticle)-f_R1*rij(3) + f_nonbond(1, iparticle) = f_nonbond(1, iparticle) + f_R1*rij(1) + f_nonbond(2, iparticle) = f_nonbond(2, iparticle) + f_R1*rij(2) + f_nonbond(3, iparticle) = f_nonbond(3, iparticle) + f_R1*rij(3) + f_nonbond(1, jparticle) = f_nonbond(1, jparticle) - f_R1*rij(1) + f_nonbond(2, jparticle) = f_nonbond(2, jparticle) - f_R1*rij(2) + f_nonbond(3, jparticle) = f_nonbond(3, jparticle) - f_R1*rij(3) IF (use_virial) THEN - pv_nonbond(1, 1) = pv_nonbond(1, 1)-f_R1*rij(1)*rij(1) - pv_nonbond(1, 2) = pv_nonbond(1, 2)-f_R1*rij(1)*rij(2) - pv_nonbond(1, 3) = pv_nonbond(1, 3)-f_R1*rij(1)*rij(3) - pv_nonbond(2, 1) = pv_nonbond(2, 1)-f_R1*rij(2)*rij(1) - pv_nonbond(2, 2) = pv_nonbond(2, 2)-f_R1*rij(2)*rij(2) - pv_nonbond(2, 3) = pv_nonbond(2, 3)-f_R1*rij(2)*rij(3) - pv_nonbond(3, 1) = pv_nonbond(3, 1)-f_R1*rij(3)*rij(1) - pv_nonbond(3, 2) = pv_nonbond(3, 2)-f_R1*rij(3)*rij(2) - pv_nonbond(3, 3) = pv_nonbond(3, 3)-f_R1*rij(3)*rij(3) + pv_nonbond(1, 1) = pv_nonbond(1, 1) - f_R1*rij(1)*rij(1) + pv_nonbond(1, 2) = pv_nonbond(1, 2) - f_R1*rij(1)*rij(2) + pv_nonbond(1, 3) = pv_nonbond(1, 3) - f_R1*rij(1)*rij(3) + pv_nonbond(2, 1) = pv_nonbond(2, 1) - f_R1*rij(2)*rij(1) + pv_nonbond(2, 2) = pv_nonbond(2, 2) - f_R1*rij(2)*rij(2) + pv_nonbond(2, 3) = pv_nonbond(2, 3) - f_R1*rij(2)*rij(3) + pv_nonbond(3, 1) = pv_nonbond(3, 1) - f_R1*rij(3)*rij(1) + pv_nonbond(3, 2) = pv_nonbond(3, 2) - f_R1*rij(3)*rij(2) + pv_nonbond(3, 3) = pv_nonbond(3, 3) - f_R1*rij(3)*rij(3) END IF f_R2 = f_C*f_R_d*fac - f_nonbond(1, iparticle) = f_nonbond(1, iparticle)+f_R2*rij(1) - f_nonbond(2, iparticle) = f_nonbond(2, iparticle)+f_R2*rij(2) - f_nonbond(3, iparticle) = f_nonbond(3, iparticle)+f_R2*rij(3) - f_nonbond(1, jparticle) = f_nonbond(1, jparticle)-f_R2*rij(1) - f_nonbond(2, jparticle) = f_nonbond(2, jparticle)-f_R2*rij(2) - f_nonbond(3, jparticle) = f_nonbond(3, jparticle)-f_R2*rij(3) + f_nonbond(1, iparticle) = f_nonbond(1, iparticle) + f_R2*rij(1) + f_nonbond(2, iparticle) = f_nonbond(2, iparticle) + f_R2*rij(2) + f_nonbond(3, iparticle) = f_nonbond(3, iparticle) + f_R2*rij(3) + f_nonbond(1, jparticle) = f_nonbond(1, jparticle) - f_R2*rij(1) + f_nonbond(2, jparticle) = f_nonbond(2, jparticle) - f_R2*rij(2) + f_nonbond(3, jparticle) = f_nonbond(3, jparticle) - f_R2*rij(3) IF (use_virial) THEN - pv_nonbond(1, 1) = pv_nonbond(1, 1)-f_R2*rij(1)*rij(1) - pv_nonbond(1, 2) = pv_nonbond(1, 2)-f_R2*rij(1)*rij(2) - pv_nonbond(1, 3) = pv_nonbond(1, 3)-f_R2*rij(1)*rij(3) - pv_nonbond(2, 1) = pv_nonbond(2, 1)-f_R2*rij(2)*rij(1) - pv_nonbond(2, 2) = pv_nonbond(2, 2)-f_R2*rij(2)*rij(2) - pv_nonbond(2, 3) = pv_nonbond(2, 3)-f_R2*rij(2)*rij(3) - pv_nonbond(3, 1) = pv_nonbond(3, 1)-f_R2*rij(3)*rij(1) - pv_nonbond(3, 2) = pv_nonbond(3, 2)-f_R2*rij(3)*rij(2) - pv_nonbond(3, 3) = pv_nonbond(3, 3)-f_R2*rij(3)*rij(3) + pv_nonbond(1, 1) = pv_nonbond(1, 1) - f_R2*rij(1)*rij(1) + pv_nonbond(1, 2) = pv_nonbond(1, 2) - f_R2*rij(1)*rij(2) + pv_nonbond(1, 3) = pv_nonbond(1, 3) - f_R2*rij(1)*rij(3) + pv_nonbond(2, 1) = pv_nonbond(2, 1) - f_R2*rij(2)*rij(1) + pv_nonbond(2, 2) = pv_nonbond(2, 2) - f_R2*rij(2)*rij(2) + pv_nonbond(2, 3) = pv_nonbond(2, 3) - f_R2*rij(2)*rij(3) + pv_nonbond(3, 1) = pv_nonbond(3, 1) - f_R2*rij(3)*rij(1) + pv_nonbond(3, 2) = pv_nonbond(3, 2) - f_R2*rij(3)*rij(2) + pv_nonbond(3, 3) = pv_nonbond(3, 3) - f_R2*rij(3)*rij(3) END IF ! Lets do the f_A1 piece derivative of F_C f_A1 = f_C_d*b_ij*f_A*fac - f_nonbond(1, iparticle) = f_nonbond(1, iparticle)+f_A1*rij(1) - f_nonbond(2, iparticle) = f_nonbond(2, iparticle)+f_A1*rij(2) - f_nonbond(3, iparticle) = f_nonbond(3, iparticle)+f_A1*rij(3) - f_nonbond(1, jparticle) = f_nonbond(1, jparticle)-f_A1*rij(1) - f_nonbond(2, jparticle) = f_nonbond(2, jparticle)-f_A1*rij(2) - f_nonbond(3, jparticle) = f_nonbond(3, jparticle)-f_A1*rij(3) + f_nonbond(1, iparticle) = f_nonbond(1, iparticle) + f_A1*rij(1) + f_nonbond(2, iparticle) = f_nonbond(2, iparticle) + f_A1*rij(2) + f_nonbond(3, iparticle) = f_nonbond(3, iparticle) + f_A1*rij(3) + f_nonbond(1, jparticle) = f_nonbond(1, jparticle) - f_A1*rij(1) + f_nonbond(2, jparticle) = f_nonbond(2, jparticle) - f_A1*rij(2) + f_nonbond(3, jparticle) = f_nonbond(3, jparticle) - f_A1*rij(3) IF (use_virial) THEN - pv_nonbond(1, 1) = pv_nonbond(1, 1)-f_A1*rij(1)*rij(1) - pv_nonbond(1, 2) = pv_nonbond(1, 2)-f_A1*rij(1)*rij(2) - pv_nonbond(1, 3) = pv_nonbond(1, 3)-f_A1*rij(1)*rij(3) - pv_nonbond(2, 1) = pv_nonbond(2, 1)-f_A1*rij(2)*rij(1) - pv_nonbond(2, 2) = pv_nonbond(2, 2)-f_A1*rij(2)*rij(2) - pv_nonbond(2, 3) = pv_nonbond(2, 3)-f_A1*rij(2)*rij(3) - pv_nonbond(3, 1) = pv_nonbond(3, 1)-f_A1*rij(3)*rij(1) - pv_nonbond(3, 2) = pv_nonbond(3, 2)-f_A1*rij(3)*rij(2) - pv_nonbond(3, 3) = pv_nonbond(3, 3)-f_A1*rij(3)*rij(3) + pv_nonbond(1, 1) = pv_nonbond(1, 1) - f_A1*rij(1)*rij(1) + pv_nonbond(1, 2) = pv_nonbond(1, 2) - f_A1*rij(1)*rij(2) + pv_nonbond(1, 3) = pv_nonbond(1, 3) - f_A1*rij(1)*rij(3) + pv_nonbond(2, 1) = pv_nonbond(2, 1) - f_A1*rij(2)*rij(1) + pv_nonbond(2, 2) = pv_nonbond(2, 2) - f_A1*rij(2)*rij(2) + pv_nonbond(2, 3) = pv_nonbond(2, 3) - f_A1*rij(2)*rij(3) + pv_nonbond(3, 1) = pv_nonbond(3, 1) - f_A1*rij(3)*rij(1) + pv_nonbond(3, 2) = pv_nonbond(3, 2) - f_A1*rij(3)*rij(2) + pv_nonbond(3, 3) = pv_nonbond(3, 3) - f_A1*rij(3)*rij(3) END IF ! Lets do the f_A2 piece derivative of F_A f_A2 = f_C*b_ij*f_A_d*fac - f_nonbond(1, iparticle) = f_nonbond(1, iparticle)+f_A2*rij(1) - f_nonbond(2, iparticle) = f_nonbond(2, iparticle)+f_A2*rij(2) - f_nonbond(3, iparticle) = f_nonbond(3, iparticle)+f_A2*rij(3) - f_nonbond(1, jparticle) = f_nonbond(1, jparticle)-f_A2*rij(1) - f_nonbond(2, jparticle) = f_nonbond(2, jparticle)-f_A2*rij(2) - f_nonbond(3, jparticle) = f_nonbond(3, jparticle)-f_A2*rij(3) + f_nonbond(1, iparticle) = f_nonbond(1, iparticle) + f_A2*rij(1) + f_nonbond(2, iparticle) = f_nonbond(2, iparticle) + f_A2*rij(2) + f_nonbond(3, iparticle) = f_nonbond(3, iparticle) + f_A2*rij(3) + f_nonbond(1, jparticle) = f_nonbond(1, jparticle) - f_A2*rij(1) + f_nonbond(2, jparticle) = f_nonbond(2, jparticle) - f_A2*rij(2) + f_nonbond(3, jparticle) = f_nonbond(3, jparticle) - f_A2*rij(3) IF (use_virial) THEN - pv_nonbond(1, 1) = pv_nonbond(1, 1)-f_A2*rij(1)*rij(1) - pv_nonbond(1, 2) = pv_nonbond(1, 2)-f_A2*rij(1)*rij(2) - pv_nonbond(1, 3) = pv_nonbond(1, 3)-f_A2*rij(1)*rij(3) - pv_nonbond(2, 1) = pv_nonbond(2, 1)-f_A2*rij(2)*rij(1) - pv_nonbond(2, 2) = pv_nonbond(2, 2)-f_A2*rij(2)*rij(2) - pv_nonbond(2, 3) = pv_nonbond(2, 3)-f_A2*rij(2)*rij(3) - pv_nonbond(3, 1) = pv_nonbond(3, 1)-f_A2*rij(3)*rij(1) - pv_nonbond(3, 2) = pv_nonbond(3, 2)-f_A2*rij(3)*rij(2) - pv_nonbond(3, 3) = pv_nonbond(3, 3)-f_A2*rij(3)*rij(3) + pv_nonbond(1, 1) = pv_nonbond(1, 1) - f_A2*rij(1)*rij(1) + pv_nonbond(1, 2) = pv_nonbond(1, 2) - f_A2*rij(1)*rij(2) + pv_nonbond(1, 3) = pv_nonbond(1, 3) - f_A2*rij(1)*rij(3) + pv_nonbond(2, 1) = pv_nonbond(2, 1) - f_A2*rij(2)*rij(1) + pv_nonbond(2, 2) = pv_nonbond(2, 2) - f_A2*rij(2)*rij(2) + pv_nonbond(2, 3) = pv_nonbond(2, 3) - f_A2*rij(2)*rij(3) + pv_nonbond(3, 1) = pv_nonbond(3, 1) - f_A2*rij(3)*rij(1) + pv_nonbond(3, 2) = pv_nonbond(3, 2) - f_A2*rij(3)*rij(2) + pv_nonbond(3, 3) = pv_nonbond(3, 3) - f_A2*rij(3)*rij(3) END IF ! Lets do the f_A3 piece derivative of b_ij @@ -756,10 +756,10 @@ SUBROUTINE setup_tersoff_arrays(nonbonded, potparm, glob_loc_list, glob_cell_v, ikind = neighbor_kind_pair%ij_kind(1, igrp) jkind = neighbor_kind_pair%ij_kind(2, igrp) pot => potparm%pot(ikind, jkind)%pot - npairs = iend-istart+1 + npairs = iend - istart + 1 IF (pot%no_mb) CYCLE DO i = 1, SIZE(pot%type) - IF (pot%type(i) == tersoff_type) npairs_tot = npairs_tot+npairs + IF (pot%type(i) == tersoff_type) npairs_tot = npairs_tot + npairs END DO END DO Kind_Group_Loop1 END DO @@ -781,17 +781,17 @@ SUBROUTINE setup_tersoff_arrays(nonbonded, potparm, glob_loc_list, glob_cell_v, list => neighbor_kind_pair%list cvi = neighbor_kind_pair%cell_vector pot => potparm%pot(ikind, jkind)%pot - npairs = iend-istart+1 + npairs = iend - istart + 1 IF (pot%no_mb) CYCLE CALL matvec_3x3(cell_v, cell%hmat, cvi) DO i = 1, SIZE(pot%type) ! TERSOFF IF (pot%type(i) == tersoff_type) THEN DO ipair = 1, npairs - glob_loc_list(:, npairs_tot+ipair) = list(:, istart-1+ipair) - glob_cell_v(1:3, npairs_tot+ipair) = cell_v(1:3) + glob_loc_list(:, npairs_tot + ipair) = list(:, istart - 1 + ipair) + glob_cell_v(1:3, npairs_tot + ipair) = cell_v(1:3) END DO - npairs_tot = npairs_tot+npairs + npairs_tot = npairs_tot + npairs END IF END DO END DO Kind_Group_Loop2 diff --git a/src/mao_methods.F b/src/mao_methods.F index a1bc2327c7..c2e9d965eb 100644 --- a/src/mao_methods.F +++ b/src/mao_methods.F @@ -129,10 +129,10 @@ SUBROUTINE mao_initialization(mao_coef, pmat, smat, eps1) mbl(iatom)%n = n mbl(iatom)%ma = m DO i = 1, n - mbl(iatom)%eig(i) = w(n-i+1) - mbl(iatom)%mat(1:n, i) = amat(1:n, n-i+1) + mbl(iatom)%eig(i) = w(n - i + 1) + mbl(iatom)%mat(1:n, i) = amat(1:n, n - i + 1) END DO - cblock(1:n, 1:m) = amat(1:n, n:n-m+1:-1) + cblock(1:n, 1:m) = amat(1:n, n:n - m + 1:-1) DEALLOCATE (amat, bmat, w, work) END DO CALL dbcsr_iterator_stop(dbcsr_iter) @@ -372,7 +372,7 @@ SUBROUTINE mao_project_gradient(mao_coef, mao_grad, smat) CPASSERT(found) ALLOCATE (amat(m, m)) amat(1:m, 1:m) = MATMUL(TRANSPOSE(cblock(1:n, 1:m)), MATMUL(sblock(1:n, 1:n), gblock(1:n, 1:m))) - gblock(1:n, 1:m) = gblock(1:n, 1:m)-MATMUL(cblock(1:n, 1:m), amat(1:m, 1:m)) + gblock(1:n, 1:m) = gblock(1:n, 1:m) - MATMUL(cblock(1:n, 1:m), amat(1:m, 1:m)) DEALLOCATE (amat) END DO CALL dbcsr_iterator_stop(dbcsr_iter) @@ -407,7 +407,7 @@ FUNCTION mao_scalar_product(fmat1, fmat2) RESULT(spro) n = SIZE(ablock, 1) CALL dbcsr_get_block_p(matrix=fmat2, row=iatom, col=jatom, block=bblock, found=found) CPASSERT(found) - spro = spro+SUM(ablock(1:n, 1:m)*bblock(1:n, 1:m)) + spro = spro + SUM(ablock(1:n, 1:m)*bblock(1:n, 1:m)) END DO CALL dbcsr_iterator_stop(dbcsr_iter) @@ -466,7 +466,7 @@ SUBROUTINE calculate_p_gamma(pmat, ksmat, smat, kpoints, nmos, occ) ! diagonalize CALL cp_fm_geeig(fmksmat, fmsmat, fmvec, eigenvalues, fmwork) - de = eigenvalues(nmos+1)-eigenvalues(nmos) + de = eigenvalues(nmos + 1) - eigenvalues(nmos) IF (de < 0.001_dp) THEN CALL cp_warn(__LOCATION__, "MAO: No band gap at "// & "Gamma point. MAO analysis not reliable.") @@ -662,7 +662,7 @@ SUBROUTINE mao_basis_analysis(mao_coef, matrix_smm, mao_basis_set_list, particle DO ishell = 1, basis_set%nshell(iset) lshell = basis_set%l(ishell, iset) DO m = -lshell, lshell - iab = iab+1 + iab = iab + 1 IF (l == lshell) cmask(iab) = 1.0_dp END DO END DO @@ -745,7 +745,7 @@ SUBROUTINE mao_build_q(matrix_q, matrix_p, matrix_s, matrix_smm, matrix_smo, smm electra(ispin) = 0.0_dp DO im = 1, nim CALL dbcsr_dot(matrix_p(ispin, im)%matrix, matrix_s(1, im)%matrix, elex) - electra(ispin) = electra(ispin)+elex + electra(ispin) = electra(ispin) + elex END DO END DO @@ -786,7 +786,7 @@ SUBROUTINE mao_build_q(matrix_q, matrix_p, matrix_s, matrix_smm, matrix_smo, smm CALL rskp_transform(rmatrix=smat, rsmat=matrix_s, ispin=1, & xkp=xkp, cell_to_index=cell_to_index, sab_nl=sab_orb) norb = NINT(electra(ispin)) - nocc = MOD(2, nspin)+1 + nocc = MOD(2, nspin) + 1 CALL calculate_p_gamma(pmat, ksmat, smat, kpoints, norb, REAL(nocc, KIND=dp)) CALL dbcsr_multiply("N", "N", 1.0_dp, matrix_smo(1)%matrix, pmat, & 0.0_dp, tmat, filter_eps=eps_filter) diff --git a/src/mao_optimizer.F b/src/mao_optimizer.F index 069136daee..e2139cf1d9 100644 --- a/src/mao_optimizer.F +++ b/src/mao_optimizer.F @@ -150,7 +150,7 @@ SUBROUTINE mao_optimize(mao_coef, matrix_q, matrix_smm, electra, max_iter, eps_g END IF DO iter = 1, max_iter IF (grad_norm < eps_grad) EXIT - IF ((1.0_dp-fval/electra(ispin)) < eps_fun) EXIT + IF ((1.0_dp - fval/electra(ispin)) < eps_fun) EXIT CALL dbcsr_add(mao_coef(ispin)%matrix, cgmat, 1.0_dp, alpha) CALL mao_orthogonalization(mao_coef(ispin)%matrix, matrix_smm(1)%matrix) CALL mao_function_gradient(mao_coef(ispin)%matrix, fval, mao_grad(ispin)%matrix, & @@ -173,8 +173,8 @@ SUBROUTINE mao_optimize(mao_coef, matrix_q, matrix_smm, electra, max_iter, eps_g CALL dbcsr_add(amat, cgmat, 1.0_dp, alpha) CALL mao_orthogonalization(amat, matrix_smm(1)%matrix) CALL mao_function(amat, fa2, matrix_q(ispin)%matrix, matrix_smm(1)%matrix, binv, .TRUE.) - a2 = (4._dp*fa1-fa2-3._dp*fval)/alpha - a1 = (fa2-fval-a2*alpha)/(alpha*alpha) + a2 = (4._dp*fa1 - fa2 - 3._dp*fval)/alpha + a1 = (fa2 - fval - a2*alpha)/(alpha*alpha) IF (ABS(a1) > 1.e-14_dp) THEN an = -a2/(2._dp*a1) an = MIN(an, 2.0_dp*alpha) diff --git a/src/mao_wfn_analysis.F b/src/mao_wfn_analysis.F index c8f792fc7a..306072aa76 100644 --- a/src/mao_wfn_analysis.F +++ b/src/mao_wfn_analysis.F @@ -213,7 +213,7 @@ SUBROUTINE mao_analysis(qs_env, input_section, unit_nr) END IF CALL dbcsr_get_block_p(matrix=matrix_p(1, 1)%matrix, & row=irow, col=icol, block=block, found=found) - IF (.NOT. found) fall = fall+1 + IF (.NOT. found) fall = fall + 1 END DO CALL neighbor_list_iterator_release(nl_iterator) @@ -311,7 +311,7 @@ SUBROUTINE mao_analysis(qs_env, input_section, unit_nr) ! calculate unassigned charge : n - Tr PS DO ispin = 1, nspin CALL dbcsr_dot(mao_dmat(ispin)%matrix, mao_smat(ispin)%matrix, ua_charge(ispin)) - ua_charge(ispin) = electra(ispin)-ua_charge(ispin) + ua_charge(ispin) = electra(ispin) - ua_charge(ispin) END DO IF (unit_nr > 0) THEN WRITE (unit_nr, *) @@ -333,7 +333,7 @@ SUBROUTINE mao_analysis(qs_env, input_section, unit_nr) row=iatom, col=iatom, block=block, found=found) IF (found) THEN DO iab = 1, SIZE(block, 1) - occnumA(iatom, ispin) = occnumA(iatom, ispin)+block(iab, iab) + occnumA(iatom, ispin) = occnumA(iatom, ispin) + block(iab, iab) END DO END IF END DO @@ -352,7 +352,7 @@ SUBROUTINE mao_analysis(qs_env, input_section, unit_nr) CALL dbcsr_get_block_diag(mao_smat(ispin)%matrix, smat_diag) CALL dbcsr_replicate_all(smat_diag) DO ia = 1, natom - DO ib = ia+1, natom + DO ib = ia + 1, natom iab = 0 CALL dbcsr_get_block_p(matrix=mao_qmat(ispin)%matrix, & row=ia, col=ib, block=block, found=found) @@ -362,35 +362,35 @@ SUBROUTINE mao_analysis(qs_env, input_section, unit_nr) IF (iab == 0 .AND. para_env%ionode) THEN ! AB block is not available N_AB = N_A + N_B ! Do this only on the "source" processor - occnumAB(ia, ib, ispin) = occnumA(ia, ispin)+occnumA(ib, ispin) - occnumAB(ib, ia, ispin) = occnumA(ia, ispin)+occnumA(ib, ispin) + occnumAB(ia, ib, ispin) = occnumA(ia, ispin) + occnumA(ib, ispin) + occnumAB(ib, ia, ispin) = occnumA(ia, ispin) + occnumA(ib, ispin) ELSE IF (found) THEN ! owner of AB block performs calculation na = SIZE(block, 1) nb = SIZE(block, 2) - nab = na+nb + nab = na + nb ALLOCATE (sab(nab, nab), qab(nab, nab), sinv(nab, nab)) ! qmat - qab(1:na, na+1:nab) = block(1:na, 1:nb) - qab(na+1:nab, 1:na) = TRANSPOSE(block(1:na, 1:nb)) + qab(1:na, na + 1:nab) = block(1:na, 1:nb) + qab(na + 1:nab, 1:na) = TRANSPOSE(block(1:na, 1:nb)) CALL dbcsr_get_block_p(matrix=qmat_diag, row=ia, col=ia, block=diag, found=fo) CPASSERT(fo) qab(1:na, 1:na) = diag(1:na, 1:na) CALL dbcsr_get_block_p(matrix=qmat_diag, row=ib, col=ib, block=diag, found=fo) CPASSERT(fo) - qab(na+1:nab, na+1:nab) = diag(1:nb, 1:nb) + qab(na + 1:nab, na + 1:nab) = diag(1:nb, 1:nb) ! smat CALL dbcsr_get_block_p(matrix=mao_smat(ispin)%matrix, & row=ia, col=ib, block=block, found=fo) CPASSERT(fo) - sab(1:na, na+1:nab) = block(1:na, 1:nb) - sab(na+1:nab, 1:na) = TRANSPOSE(block(1:na, 1:nb)) + sab(1:na, na + 1:nab) = block(1:na, 1:nb) + sab(na + 1:nab, 1:na) = TRANSPOSE(block(1:na, 1:nb)) CALL dbcsr_get_block_p(matrix=smat_diag, row=ia, col=ia, block=diag, found=fo) CPASSERT(fo) sab(1:na, 1:na) = diag(1:na, 1:na) CALL dbcsr_get_block_p(matrix=smat_diag, row=ib, col=ib, block=diag, found=fo) CPASSERT(fo) - sab(na+1:nab, na+1:nab) = diag(1:nb, 1:nb) + sab(na + 1:nab, na + 1:nab) = diag(1:nb, 1:nb) ! inv smat sinv(1:nab, 1:nab) = sab(1:nab, 1:nab) CALL invmat_symm(sinv) @@ -412,8 +412,8 @@ SUBROUTINE mao_analysis(qs_env, input_section, unit_nr) selnAB = 0.0_dp DO ispin = 1, nspin DO ia = 1, natom - DO ib = ia+1, natom - selnAB(ia, ib, ispin) = occnumA(ia, ispin)+occnumA(ib, ispin)-occnumAB(ia, ib, ispin) + DO ib = ia + 1, natom + selnAB(ia, ib, ispin) = occnumA(ia, ispin) + occnumA(ib, ispin) - occnumAB(ia, ib, ispin) selnAB(ib, ia, ispin) = selnAB(ia, ib, ispin) END DO END DO @@ -421,7 +421,7 @@ SUBROUTINE mao_analysis(qs_env, input_section, unit_nr) IF (.NOT. neglect_abc) THEN ! calculate N_ABC - nabc = (natom*(natom-1)*(natom-2))/6 + nabc = (natom*(natom - 1)*(natom - 2))/6 ALLOCATE (occnumABC(nabc, nspin)) occnumABC = -1.0_dp DO ispin = 1, nspin @@ -439,10 +439,10 @@ SUBROUTINE mao_analysis(qs_env, input_section, unit_nr) CALL dbcsr_get_block_p(matrix=smat_diag, row=ia, col=ia, block=sblka, found=fo) CPASSERT(fo) na = SIZE(qblka, 1) - DO ib = ia+1, natom + DO ib = ia + 1, natom ! screen with SEN(AB) IF (selnAB(ia, ib, ispin) < eps_abc) THEN - iabc = iabc+(natom-ib) + iabc = iabc + (natom - ib) CYCLE END IF CALL dbcsr_get_block_p(matrix=qmat_diag, row=ib, col=ib, block=qblkb, found=fo) @@ -450,7 +450,7 @@ SUBROUTINE mao_analysis(qs_env, input_section, unit_nr) CALL dbcsr_get_block_p(matrix=smat_diag, row=ib, col=ib, block=sblkb, found=fo) CPASSERT(fo) nb = SIZE(qblkb, 1) - nab = na+nb + nab = na + nb ALLOCATE (qmatab(na, nb), smatab(na, nb)) CALL dbcsr_get_block_p(matrix=mao_qmat(ispin)%matrix, row=ia, col=ib, & block=block, found=found) @@ -462,10 +462,10 @@ SUBROUTINE mao_analysis(qs_env, input_section, unit_nr) smatab = 0.0_dp IF (found) smatab(1:na, 1:nb) = block(1:na, 1:nb) CALL mp_sum(smatab, para_env%group) - DO ic = ib+1, natom + DO ic = ib + 1, natom ! screen with SEN(AB) IF ((selnAB(ia, ic, ispin) < eps_abc) .OR. (selnAB(ib, ic, ispin) < eps_abc)) THEN - iabc = iabc+1 + iabc = iabc + 1 CYCLE END IF CALL dbcsr_get_block_p(matrix=qmat_diag, row=ic, col=ic, block=qblkc, found=fo) @@ -496,33 +496,33 @@ SUBROUTINE mao_analysis(qs_env, input_section, unit_nr) IF (found) smatbc(1:nb, 1:nc) = block(1:nb, 1:nc) CALL mp_sum(smatbc, para_env%group) ! - nabc = na+nb+nc + nabc = na + nb + nc ALLOCATE (sab(nabc, nabc), sinv(nabc, nabc), qab(nabc, nabc)) ! qab(1:na, 1:na) = qblka(1:na, 1:na) - qab(na+1:nab, na+1:nab) = qblkb(1:nb, 1:nb) - qab(nab+1:nabc, nab+1:nabc) = qblkc(1:nc, 1:nc) - qab(1:na, na+1:nab) = qmatab(1:na, 1:nb) - qab(na+1:nab, 1:na) = TRANSPOSE(qmatab(1:na, 1:nb)) - qab(1:na, nab+1:nabc) = qmatac(1:na, 1:nc) - qab(nab+1:nabc, 1:na) = TRANSPOSE(qmatac(1:na, 1:nc)) - qab(na+1:nab, nab+1:nabc) = qmatbc(1:nb, 1:nc) - qab(nab+1:nabc, na+1:nab) = TRANSPOSE(qmatbc(1:nb, 1:nc)) + qab(na + 1:nab, na + 1:nab) = qblkb(1:nb, 1:nb) + qab(nab + 1:nabc, nab + 1:nabc) = qblkc(1:nc, 1:nc) + qab(1:na, na + 1:nab) = qmatab(1:na, 1:nb) + qab(na + 1:nab, 1:na) = TRANSPOSE(qmatab(1:na, 1:nb)) + qab(1:na, nab + 1:nabc) = qmatac(1:na, 1:nc) + qab(nab + 1:nabc, 1:na) = TRANSPOSE(qmatac(1:na, 1:nc)) + qab(na + 1:nab, nab + 1:nabc) = qmatbc(1:nb, 1:nc) + qab(nab + 1:nabc, na + 1:nab) = TRANSPOSE(qmatbc(1:nb, 1:nc)) ! sab(1:na, 1:na) = sblka(1:na, 1:na) - sab(na+1:nab, na+1:nab) = sblkb(1:nb, 1:nb) - sab(nab+1:nabc, nab+1:nabc) = sblkc(1:nc, 1:nc) - sab(1:na, na+1:nab) = smatab(1:na, 1:nb) - sab(na+1:nab, 1:na) = TRANSPOSE(smatab(1:na, 1:nb)) - sab(1:na, nab+1:nabc) = smatac(1:na, 1:nc) - sab(nab+1:nabc, 1:na) = TRANSPOSE(smatac(1:na, 1:nc)) - sab(na+1:nab, nab+1:nabc) = smatbc(1:nb, 1:nc) - sab(nab+1:nabc, na+1:nab) = TRANSPOSE(smatbc(1:nb, 1:nc)) + sab(na + 1:nab, na + 1:nab) = sblkb(1:nb, 1:nb) + sab(nab + 1:nabc, nab + 1:nabc) = sblkc(1:nc, 1:nc) + sab(1:na, na + 1:nab) = smatab(1:na, 1:nb) + sab(na + 1:nab, 1:na) = TRANSPOSE(smatab(1:na, 1:nb)) + sab(1:na, nab + 1:nabc) = smatac(1:na, 1:nc) + sab(nab + 1:nabc, 1:na) = TRANSPOSE(smatac(1:na, 1:nc)) + sab(na + 1:nab, nab + 1:nabc) = smatbc(1:nb, 1:nc) + sab(nab + 1:nabc, na + 1:nab) = TRANSPOSE(smatbc(1:nb, 1:nc)) ! inv smat sinv(1:nabc, 1:nabc) = sab(1:nabc, 1:nabc) CALL invmat_symm(sinv) ! Tr(Q*Sinv) - iabc = iabc+1 + iabc = iabc + 1 me = MOD(iabc, para_env%num_pe) IF (me == para_env%mepos) THEN occnumABC(iabc, ispin) = SUM(qab*sinv) @@ -545,18 +545,18 @@ SUBROUTINE mao_analysis(qs_env, input_section, unit_nr) IF (.NOT. neglect_abc) THEN ! calculate shared electron numbers (ABC) - nabc = (natom*(natom-1)*(natom-2))/6 + nabc = (natom*(natom - 1)*(natom - 2))/6 ALLOCATE (selnABC(nabc, nspin)) selnABC = 0.0_dp DO ispin = 1, nspin iabc = 0 DO ia = 1, natom - DO ib = ia+1, natom - DO ic = ib+1, natom - iabc = iabc+1 + DO ib = ia + 1, natom + DO ic = ib + 1, natom + iabc = iabc + 1 IF (occnumABC(iabc, ispin) >= 0.0_dp) THEN - selnABC(iabc, ispin) = occnumA(ia, ispin)+occnumA(ib, ispin)+occnumA(ic, ispin)- & - occnumAB(ia, ib, ispin)-occnumAB(ia, ic, ispin)-occnumAB(ib, ic, ispin)+ & + selnABC(iabc, ispin) = occnumA(ia, ispin) + occnumA(ib, ispin) + occnumA(ic, ispin) - & + occnumAB(ia, ib, ispin) - occnumAB(ia, ic, ispin) - occnumAB(ib, ic, ispin) + & occnumABC(iabc, ispin) END IF END DO @@ -572,18 +572,18 @@ SUBROUTINE mao_analysis(qs_env, input_section, unit_nr) DO ia = 1, natom raq(ia, ispin) = occnumA(ia, ispin) DO ib = 1, natom - raq(ia, ispin) = raq(ia, ispin)-0.5_dp*selnAB(ia, ib, ispin) + raq(ia, ispin) = raq(ia, ispin) - 0.5_dp*selnAB(ia, ib, ispin) END DO END DO IF (.NOT. neglect_abc) THEN iabc = 0 DO ia = 1, natom - DO ib = ia+1, natom - DO ic = ib+1, natom - iabc = iabc+1 - raq(ia, ispin) = raq(ia, ispin)+selnABC(iabc, ispin)/3._dp - raq(ib, ispin) = raq(ib, ispin)+selnABC(iabc, ispin)/3._dp - raq(ic, ispin) = raq(ic, ispin)+selnABC(iabc, ispin)/3._dp + DO ib = ia + 1, natom + DO ic = ib + 1, natom + iabc = iabc + 1 + raq(ia, ispin) = raq(ia, ispin) + selnABC(iabc, ispin)/3._dp + raq(ib, ispin) = raq(ib, ispin) + selnABC(iabc, ispin)/3._dp + raq(ic, ispin) = raq(ic, ispin) + selnABC(iabc, ispin)/3._dp END DO END DO END DO @@ -592,7 +592,7 @@ SUBROUTINE mao_analysis(qs_env, input_section, unit_nr) ! calculate unassigned charge (from sum over atomic charges) DO ispin = 1, nspin - deltaq = (electra(ispin)-SUM(raq(1:natom, ispin)))-ua_charge(ispin) + deltaq = (electra(ispin) - SUM(raq(1:natom, ispin))) - ua_charge(ispin) IF (unit_nr > 0) THEN WRITE (UNIT=unit_nr, FMT="(T2,A,T32,A,i2,T55,A,F12.8)") & "Cutoff error on charge", "Spin ", ispin, "error charge =", deltaq @@ -689,7 +689,7 @@ SUBROUTINE mao_analysis(qs_env, input_section, unit_nr) filter_eps=eps_filter) ! Tr(P*A) CALL dbcsr_dot(matrix_p(ispin, 1)%matrix, amat, uaq(ia, ispin)) - uaq(ia, ispin) = uaq(ia, ispin)-electra(ispin) + uaq(ia, ispin) = uaq(ia, ispin) - electra(ispin) END DO ! CALL dbcsr_release(sumat) @@ -708,13 +708,13 @@ SUBROUTINE mao_analysis(qs_env, input_section, unit_nr) DEALLOCATE (orb_blk, mao_blk) END IF ! - raq(1:natom, 1:nspin) = raq(1:natom, 1:nspin)-uaq(1:natom, 1:nspin) + raq(1:natom, 1:nspin) = raq(1:natom, 1:nspin) - uaq(1:natom, 1:nspin) DO ispin = 1, nspin - deltaq = electra(ispin)-SUM(raq(1:natom, ispin)) + deltaq = electra(ispin) - SUM(raq(1:natom, ispin)) IF (unit_nr > 0) THEN WRITE (UNIT=unit_nr, FMT="(T2,A,T32,A,i2,T55,A,F12.8)") & "Charge/Atom redistributed", "Spin ", ispin, "delta charge =", & - (deltaq+ua_charge(ispin))/REAL(natom, KIND=dp) + (deltaq + ua_charge(ispin))/REAL(natom, KIND=dp) END IF END DO @@ -726,8 +726,8 @@ SUBROUTINE mao_analysis(qs_env, input_section, unit_nr) WRITE (unit_nr, "(/,T2,A,T40,A,T55,A,T70,A)") "MAO atomic charges ", "Atom", "Charge", "Spin Charge" END IF DO ispin = 1, nspin - deltaq = electra(ispin)-SUM(raq(1:natom, ispin)) - raq(:, ispin) = raq(:, ispin)+deltaq/REAL(natom, KIND=dp) + deltaq = electra(ispin) - SUM(raq(1:natom, ispin)) + raq(:, ispin) = raq(:, ispin) + deltaq/REAL(natom, KIND=dp) END DO total_charge = 0.0_dp total_spin = 0.0_dp @@ -736,13 +736,13 @@ SUBROUTINE mao_analysis(qs_env, input_section, unit_nr) element_symbol=element_symbol, kind_number=ikind) CALL get_qs_kind(qs_kind_set(ikind), zeff=zeff) IF (nspin == 1) THEN - WRITE (unit_nr, "(T30,I6,T42,A2,T69,F12.6)") iatom, element_symbol, zeff-raq(iatom, 1) - total_charge = total_charge+(zeff-raq(iatom, 1)) + WRITE (unit_nr, "(T30,I6,T42,A2,T69,F12.6)") iatom, element_symbol, zeff - raq(iatom, 1) + total_charge = total_charge + (zeff - raq(iatom, 1)) ELSE WRITE (unit_nr, "(T30,I6,T42,A2,T48,F12.6,T69,F12.6)") iatom, element_symbol, & - zeff-raq(iatom, 1)-raq(iatom, 2), raq(iatom, 1)-raq(iatom, 2) - total_charge = total_charge+(zeff-raq(iatom, 1)-raq(iatom, 2)) - total_spin = total_spin+(raq(iatom, 1)-raq(iatom, 2)) + zeff - raq(iatom, 1) - raq(iatom, 2), raq(iatom, 1) - raq(iatom, 2) + total_charge = total_charge + (zeff - raq(iatom, 1) - raq(iatom, 2)) + total_spin = total_spin + (raq(iatom, 1) - raq(iatom, 2)) END IF END DO IF (nspin == 1) THEN @@ -768,12 +768,12 @@ SUBROUTINE mao_analysis(qs_env, input_section, unit_nr) element_symbol=element_symbol) IF (nspin == 1) THEN WRITE (unit_nr, "(T30,I6,T42,A2,T69,F12.6)") iatom, element_symbol, uaq(iatom, 1) - total_charge = total_charge+uaq(iatom, 1) + total_charge = total_charge + uaq(iatom, 1) ELSE WRITE (unit_nr, "(T30,I6,T42,A2,T48,F12.6,T69,F12.6)") iatom, element_symbol, & - uaq(iatom, 1)+uaq(iatom, 2), uaq(iatom, 1)-uaq(iatom, 2) - total_charge = total_charge+uaq(iatom, 1)+uaq(iatom, 2) - total_spin = total_spin+uaq(iatom, 1)-uaq(iatom, 2) + uaq(iatom, 1) + uaq(iatom, 2), uaq(iatom, 1) - uaq(iatom, 2) + total_charge = total_charge + uaq(iatom, 1) + uaq(iatom, 2) + total_spin = total_spin + uaq(iatom, 1) - uaq(iatom, 2) END IF END DO IF (nspin == 1) THEN @@ -793,7 +793,7 @@ SUBROUTINE mao_analysis(qs_env, input_section, unit_nr) "SEN(1)", "SEN(2)", "SEN(total)" END IF DO ia = 1, natom - DO ib = ia+1, natom + DO ib = ia + 1, natom CALL get_atomic_kind(atomic_kind=particle_set(ia)%atomic_kind, element_symbol=esa) CALL get_atomic_kind(atomic_kind=particle_set(ib)%atomic_kind, element_symbol=esb) IF (nspin == 1) THEN @@ -801,9 +801,9 @@ SUBROUTINE mao_analysis(qs_env, input_section, unit_nr) WRITE (unit_nr, "(T26,I6,' ',A2,T35,I6,' ',A2,T69,F12.6)") ia, esa, ib, esb, selnAB(ia, ib, 1) END IF ELSE - IF ((selnAB(ia, ib, 1)+selnAB(ia, ib, 2)) > eps_ab) THEN + IF ((selnAB(ia, ib, 1) + selnAB(ia, ib, 2)) > eps_ab) THEN WRITE (unit_nr, "(T26,I6,' ',A2,T35,I6,' ',A2,T45,3F12.6)") ia, esa, ib, esb, & - selnAB(ia, ib, 1), selnAB(ia, ib, 2), (selnAB(ia, ib, 1)+selnAB(ia, ib, 2)) + selnAB(ia, ib, 1), selnAB(ia, ib, 2), (selnAB(ia, ib, 1) + selnAB(ia, ib, 2)) END IF END IF END DO @@ -818,9 +818,9 @@ SUBROUTINE mao_analysis(qs_env, input_section, unit_nr) senmax = 0.0_dp iabc = 0 DO ia = 1, natom - DO ib = ia+1, natom - DO ic = ib+1, natom - iabc = iabc+1 + DO ib = ia + 1, natom + DO ic = ib + 1, natom + iabc = iabc + 1 senabc = SUM(selnABC(iabc, :)) senmax = MAX(senmax, senabc) IF (senabc > eps_abc) THEN diff --git a/src/matrix_exp.F b/src/matrix_exp.F index 2637dc2326..28b4cfd2c9 100644 --- a/src/matrix_exp.F +++ b/src/matrix_exp.F @@ -113,7 +113,7 @@ SUBROUTINE taylor_only_imaginary(exp_H, im_matrix, nsquare, ntaylor) nloop = CEILING(REAL(ntaylor, dp)/2.0_dp) DO i = 1, nloop - tmp = tmp*(REAL(i, dp)*2.0_dp-1.0_dp) + tmp = tmp*(REAL(i, dp)*2.0_dp - 1.0_dp) CALL cp_gemm("N", "N", ndim, ndim, ndim, square_fac, im_matrix, T1, zero, & ! CALL cp_gemm("N","N",ndim,ndim,ndim,one,im_matrix,T1,zero,& T2) @@ -266,23 +266,23 @@ SUBROUTINE get_nsquare_norder(norm, nsquare, norder, eps_exp, method, do_emd) new_scale = .FALSE. eval = norm/(2.0_dp**REAL(iscale, dp)) DO q = 1, 12 - DO p = MAX(1, q-1), q + DO p = MAX(1, q - 1), q IF (p > q) EXIT D = 1.0_dp N = 1.0_dp DO i = 1, q - IF (i .LE. p) scaleN = fac(p+q-i)*fac(p)/(fac(p+q)*fac(i)*fac(p-i)) - scaleD = (-1.0)**i*fac(p+q-i)*fac(q)/(fac(p+q)*fac(i)*fac(q-i)) - IF (i .LE. p) N = N+scaleN*eval**i - D = D+scaleD*eval**i + IF (i .LE. p) scaleN = fac(p + q - i)*fac(p)/(fac(p + q)*fac(i)*fac(p - i)) + scaleD = (-1.0)**i*fac(p + q - i)*fac(q)/(fac(p + q)*fac(i)*fac(q - i)) + IF (i .LE. p) N = N + scaleN*eval**i + D = D + scaleD*eval**i END DO - IF (ABS((EXP(norm)-(N/D)**(2.0_dp**iscale))/MAX(1.0_dp, EXP(norm))) .LE. eps_exp) THEN + IF (ABS((EXP(norm) - (N/D)**(2.0_dp**iscale))/MAX(1.0_dp, EXP(norm))) .LE. eps_exp) THEN IF (do_emd) THEN - cost = iscale+q - prev_cost = orders(1)+orders(2) + cost = iscale + q + prev_cost = orders(1) + orders(2) ELSE - cost = iscale+CEILING(REAL(q, dp)/3.0_dp) - prev_cost = orders(1)+CEILING(REAL(orders(2), dp)/3.0_dp) + cost = iscale + CEILING(REAL(q, dp)/3.0_dp) + prev_cost = orders(1) + CEILING(REAL(orders(2), dp)/3.0_dp) END IF IF (cost .LT. prev_cost) THEN orders(:) = (/iscale, q, p/) @@ -294,7 +294,7 @@ SUBROUTINE get_nsquare_norder(norm, nsquare, norder, eps_exp, method, do_emd) END DO IF (new_scale) EXIT END DO - IF (iscale .GE. orders(1)+orders(2) .AND. new_scale) EXIT + IF (iscale .GE. orders(1) + orders(2) .AND. new_scale) EXIT END DO ELSE IF (method == 1) THEN q = 0 @@ -307,15 +307,15 @@ SUBROUTINE get_nsquare_norder(norm, nsquare, norder, eps_exp, method, do_emd) N = 1.0_dp DO i = 1, p scaleN = 1.0_dp/fac(i) - N = N+scaleN*(eval**REAL(i, dp)) + N = N + scaleN*(eval**REAL(i, dp)) END DO - IF (ABS((EXP(norm)-N**(2.0_dp**REAL(iscale, dp)))/MAX(1.0_dp, EXP(norm))) .LE. eps_exp) THEN + IF (ABS((EXP(norm) - N**(2.0_dp**REAL(iscale, dp)))/MAX(1.0_dp, EXP(norm))) .LE. eps_exp) THEN IF (do_emd) THEN - cost = iscale+p - prev_cost = orders(1)+orders(2) + cost = iscale + p + prev_cost = orders(1) + orders(2) ELSE - cost = iscale+CEILING(REAL(p, dp)/3.0_dp) - prev_cost = orders(1)+CEILING(REAL(orders(2), dp)/3.0_dp) + cost = iscale + CEILING(REAL(p, dp)/3.0_dp) + prev_cost = orders(1) + CEILING(REAL(orders(2), dp)/3.0_dp) END IF IF (cost .LT. prev_cost) THEN orders(:) = (/iscale, p, 0/) @@ -325,7 +325,7 @@ SUBROUTINE get_nsquare_norder(norm, nsquare, norder, eps_exp, method, do_emd) EXIT END IF END DO - IF (iscale .GE. orders(1)+orders(2) .AND. new_scale) EXIT + IF (iscale .GE. orders(1) + orders(2) .AND. new_scale) EXIT END DO END IF @@ -405,12 +405,12 @@ SUBROUTINE exp_pade_full_complex(exp_H, re_part, im_part, nsquare, npade) IF (npade .GT. 2) THEN DO i = 2, npade - IF (i .LE. p) scaleN = CMPLX(fac(p+q-i)*fac(p)/(fac(p+q)*fac(i)*fac(p-i)), 0.0_dp, kind=dp) - scaleD = CMPLX((-1.0_dp)**i*fac(p+q-i)*fac(q)/(fac(p+q)*fac(i)*fac(q-i)), 0.0_dp, kind=dp) - CALL cp_cfm_gemm("N", "N", ndim, ndim, ndim, z_one, T1, mult_p(MOD(i, 2)+1)%matrix, z_zero, & - mult_p(MOD(i+1, 2)+1)%matrix) - IF (i .LE. p) CALL cp_cfm_scale_and_add(z_one, Npq, scaleN, mult_p(MOD(i+1, 2)+1)%matrix) - IF (i .LE. q) CALL cp_cfm_scale_and_add(z_one, Dpq, scaleD, mult_p(MOD(i+1, 2)+1)%matrix) + IF (i .LE. p) scaleN = CMPLX(fac(p + q - i)*fac(p)/(fac(p + q)*fac(i)*fac(p - i)), 0.0_dp, kind=dp) + scaleD = CMPLX((-1.0_dp)**i*fac(p + q - i)*fac(q)/(fac(p + q)*fac(i)*fac(q - i)), 0.0_dp, kind=dp) + CALL cp_cfm_gemm("N", "N", ndim, ndim, ndim, z_one, T1, mult_p(MOD(i, 2) + 1)%matrix, z_zero, & + mult_p(MOD(i + 1, 2) + 1)%matrix) + IF (i .LE. p) CALL cp_cfm_scale_and_add(z_one, Npq, scaleN, mult_p(MOD(i + 1, 2) + 1)%matrix) + IF (i .LE. q) CALL cp_cfm_scale_and_add(z_one, Dpq, scaleD, mult_p(MOD(i + 1, 2) + 1)%matrix) END DO END IF @@ -420,9 +420,9 @@ SUBROUTINE exp_pade_full_complex(exp_H, re_part, im_part, nsquare, npade) mult_p(1)%matrix => Tres IF (nsquare .GT. 0) THEN DO i = 1, nsquare - CALL cp_cfm_gemm("N", "N", ndim, ndim, ndim, z_one, mult_p(MOD(i, 2)+1)%matrix, mult_p(MOD(i, 2)+1)%matrix, z_zero, & - mult_p(MOD(i+1, 2)+1)%matrix) - fin_p => mult_p(MOD(i+1, 2)+1)%matrix + CALL cp_cfm_gemm("N", "N", ndim, ndim, ndim, z_one, mult_p(MOD(i, 2) + 1)%matrix, mult_p(MOD(i, 2) + 1)%matrix, z_zero, & + mult_p(MOD(i + 1, 2) + 1)%matrix) + fin_p => mult_p(MOD(i + 1, 2) + 1)%matrix END DO ELSE fin_p => Npq @@ -507,32 +507,32 @@ SUBROUTINE exp_pade_only_imaginary(exp_H, im_part, nsquare, npade) CALL cp_cfm_set_all(Dpq, z_zero, z_one) DO i = 1, ldim - Npq%local_data(:, i) = Npq%local_data(:, i)+CMPLX(rzero, 0.5_dp*square_fac*local_data_im(:, i), dp) - Dpq%local_data(:, i) = Dpq%local_data(:, i)-CMPLX(rzero, 0.5_dp*square_fac*local_data_im(:, i), dp) + Npq%local_data(:, i) = Npq%local_data(:, i) + CMPLX(rzero, 0.5_dp*square_fac*local_data_im(:, i), dp) + Dpq%local_data(:, i) = Dpq%local_data(:, i) - CMPLX(rzero, 0.5_dp*square_fac*local_data_im(:, i), dp) END DO IF (npade .GT. 2) THEN DO j = 1, FLOOR(npade/2.0_dp) i = 2*j my_fac = (-rone)**j - IF (i .LE. p) scaleN = CMPLX(my_fac*fac(p+q-i)*fac(p)/(fac(p+q)*fac(i)*fac(p-i)), 0.0_dp, dp) - scaleD = CMPLX(my_fac*fac(p+q-i)*fac(q)/(fac(p+q)*fac(i)*fac(q-i)), 0.0_dp, dp) + IF (i .LE. p) scaleN = CMPLX(my_fac*fac(p + q - i)*fac(p)/(fac(p + q)*fac(i)*fac(p - i)), 0.0_dp, dp) + scaleD = CMPLX(my_fac*fac(p + q - i)*fac(q)/(fac(p + q)*fac(i)*fac(q - i)), 0.0_dp, dp) CALL cp_gemm("N", "N", ndim, ndim, ndim, square_fac, im_part, T2, rzero, Tres) DO k = 1, ldim - Npq%local_data(:, k) = Npq%local_data(:, k)+scaleN*Tres%local_data(:, k) - Dpq%local_data(:, k) = Dpq%local_data(:, k)+scaleD*Tres%local_data(:, k) + Npq%local_data(:, k) = Npq%local_data(:, k) + scaleN*Tres%local_data(:, k) + Dpq%local_data(:, k) = Dpq%local_data(:, k) + scaleD*Tres%local_data(:, k) END DO - IF (2*j+1 .LE. q) THEN - i = 2*j+1 - IF (i .LE. p) scaleN = CMPLX(my_fac*fac(p+q-i)*fac(p)/(fac(p+q)*fac(i)*fac(p-i)), rzero, dp) - scaleD = CMPLX(-my_fac*fac(p+q-i)*fac(q)/(fac(p+q)*fac(i)*fac(q-i)), rzero, dp) + IF (2*j + 1 .LE. q) THEN + i = 2*j + 1 + IF (i .LE. p) scaleN = CMPLX(my_fac*fac(p + q - i)*fac(p)/(fac(p + q)*fac(i)*fac(p - i)), rzero, dp) + scaleD = CMPLX(-my_fac*fac(p + q - i)*fac(q)/(fac(p + q)*fac(i)*fac(q - i)), rzero, dp) CALL cp_gemm("N", "N", ndim, ndim, ndim, square_fac, im_part, Tres, rzero, T2) DO k = 1, ldim - Npq%local_data(:, k) = Npq%local_data(:, k)+scaleN*CMPLX(rzero, T2%local_data(:, k), dp) - Dpq%local_data(:, k) = Dpq%local_data(:, k)+scaleD*CMPLX(rzero, T2%local_data(:, k), dp) + Npq%local_data(:, k) = Npq%local_data(:, k) + scaleN*CMPLX(rzero, T2%local_data(:, k), dp) + Dpq%local_data(:, k) = Dpq%local_data(:, k) + scaleD*CMPLX(rzero, T2%local_data(:, k), dp) END DO ENDIF END DO @@ -544,9 +544,9 @@ SUBROUTINE exp_pade_only_imaginary(exp_H, im_part, nsquare, npade) cmult_p(1)%matrix => T1 IF (nsquare .GT. 0) THEN DO i = 1, nsquare - CALL cp_cfm_gemm("N", "N", ndim, ndim, ndim, z_one, cmult_p(MOD(i, 2)+1)%matrix, cmult_p(MOD(i, 2)+1)%matrix, z_zero, & - cmult_p(MOD(i+1, 2)+1)%matrix) - fin_p => cmult_p(MOD(i+1, 2)+1)%matrix + CALL cp_cfm_gemm("N", "N", ndim, ndim, ndim, z_one, cmult_p(MOD(i, 2) + 1)%matrix, cmult_p(MOD(i, 2) + 1)%matrix, z_zero, & + cmult_p(MOD(i + 1, 2) + 1)%matrix) + fin_p => cmult_p(MOD(i + 1, 2) + 1)%matrix END DO ELSE fin_p => Npq @@ -627,8 +627,8 @@ SUBROUTINE exp_pade_real(exp_H, matrix, nsquare, npade) CALL cp_fm_set_all(Dpq, zero, one) DO i = 1, ldim - Npq%local_data(:, i) = Npq%local_data(:, i)+0.5_dp*local_data(:, i) - Dpq%local_data(:, i) = Dpq%local_data(:, i)-0.5_dp*local_data(:, i) + Npq%local_data(:, i) = Npq%local_data(:, i) + 0.5_dp*local_data(:, i) + Dpq%local_data(:, i) = Dpq%local_data(:, i) - 0.5_dp*local_data(:, i) END DO mult_p(1)%matrix => T2 @@ -637,14 +637,14 @@ SUBROUTINE exp_pade_real(exp_H, matrix, nsquare, npade) IF (npade .GE. 2) THEN DO j = 2, npade my_fac = (-1.0_dp)**j - scaleN = fac(p+q-j)*fac(p)/(fac(p+q)*fac(j)*fac(p-j)) - scaleD = my_fac*fac(p+q-j)*fac(q)/(fac(p+q)*fac(j)*fac(q-j)) - CALL cp_gemm("N", "N", ndim, ndim, ndim, one, mult_p(MOD(j, 2)+1)%matrix, T1, & - zero, mult_p(MOD(j+1, 2)+1)%matrix) + scaleN = fac(p + q - j)*fac(p)/(fac(p + q)*fac(j)*fac(p - j)) + scaleD = my_fac*fac(p + q - j)*fac(q)/(fac(p + q)*fac(j)*fac(q - j)) + CALL cp_gemm("N", "N", ndim, ndim, ndim, one, mult_p(MOD(j, 2) + 1)%matrix, T1, & + zero, mult_p(MOD(j + 1, 2) + 1)%matrix) DO k = 1, ldim - Npq%local_data(:, k) = Npq%local_data(:, k)+scaleN*mult_p(MOD(j+1, 2)+1)%matrix%local_data(:, k) - Dpq%local_data(:, k) = Dpq%local_data(:, k)+scaleD*mult_p(MOD(j+1, 2)+1)%matrix%local_data(:, k) + Npq%local_data(:, k) = Npq%local_data(:, k) + scaleN*mult_p(MOD(j + 1, 2) + 1)%matrix%local_data(:, k) + Dpq%local_data(:, k) = Dpq%local_data(:, k) + scaleD*mult_p(MOD(j + 1, 2) + 1)%matrix%local_data(:, k) END DO END DO END IF @@ -655,9 +655,9 @@ SUBROUTINE exp_pade_real(exp_H, matrix, nsquare, npade) mult_p(1)%matrix => T1 IF (nsquare .GT. 0) THEN DO i = 1, nsquare - CALL cp_gemm("N", "N", ndim, ndim, ndim, one, mult_p(MOD(i, 2)+1)%matrix, mult_p(MOD(i, 2)+1)%matrix, zero, & - mult_p(MOD(i+1, 2)+1)%matrix) - fin_p => mult_p(MOD(i+1, 2)+1)%matrix + CALL cp_gemm("N", "N", ndim, ndim, ndim, one, mult_p(MOD(i, 2) + 1)%matrix, mult_p(MOD(i, 2) + 1)%matrix, zero, & + mult_p(MOD(i + 1, 2) + 1)%matrix) + fin_p => mult_p(MOD(i + 1, 2) + 1)%matrix END DO ELSE fin_p => Npq @@ -726,7 +726,7 @@ SUBROUTINE arnoldi(mos_old, mos_new, eps_exp, Hre, Him, mos_next, narn_old) ALLOCATE (results(ncol_local)) ALLOCATE (norm1(ncol_local)) - ALLOCATE (V_mats(narnoldi+1)) + ALLOCATE (V_mats(narnoldi + 1)) ALLOCATE (last_norm(ncol_local)) ALLOCATE (H_approx(narnoldi, narnoldi, ncol_local)) ALLOCATE (H_approx_save(narnoldi, narnoldi, ncol_local)) @@ -738,7 +738,7 @@ SUBROUTINE arnoldi(mos_old, mos_new, eps_exp, Hre, Him, mos_next, narn_old) CALL cp_fm_struct_double(newstruct, mo_struct, mo_struct%context, double_col, double_row) H_approx_save = rzero - DO i = 1, narnoldi+1 + DO i = 1, narnoldi + 1 CALL cp_fm_create(V_mats(i)%matrix, matrix_struct=newstruct, & name="V_mat"//cp_to_string(i)) END DO @@ -748,9 +748,9 @@ SUBROUTINE arnoldi(mos_old, mos_new, eps_exp, Hre, Him, mos_next, narn_old) !$OMP PARALLEL DO PRIVATE(icol_local) DEFAULT(NONE) SHARED(V_mats,norm1,mos_old,ncol_local) DO icol_local = 1, ncol_local V_mats(1)%matrix%local_data(:, icol_local) = mos_old(1)%matrix%local_data(:, icol_local) - V_mats(1)%matrix%local_data(:, icol_local+ncol_local) = mos_old(2)%matrix%local_data(:, icol_local) + V_mats(1)%matrix%local_data(:, icol_local + ncol_local) = mos_old(2)%matrix%local_data(:, icol_local) norm1(icol_local) = SUM(V_mats(1)%matrix%local_data(:, icol_local)**2) & - +SUM(V_mats(1)%matrix%local_data(:, icol_local+ncol_local)**2) + + SUM(V_mats(1)%matrix%local_data(:, icol_local + ncol_local)**2) END DO CALL mp_sum(norm1, col_group) @@ -760,51 +760,51 @@ SUBROUTINE arnoldi(mos_old, mos_new, eps_exp, Hre, Him, mos_next, narn_old) !$OMP PARALLEL DO PRIVATE(icol_local) DEFAULT(NONE) SHARED(V_mats,norm1,ncol_local) DO icol_local = 1, ncol_local V_mats(1)%matrix%local_data(:, icol_local) = V_mats(1)%matrix%local_data(:, icol_local)/norm1(icol_local) - V_mats(1)%matrix%local_data(:, icol_local+ncol_local) = & - V_mats(1)%matrix%local_data(:, icol_local+ncol_local)/norm1(icol_local) + V_mats(1)%matrix%local_data(:, icol_local + ncol_local) = & + V_mats(1)%matrix%local_data(:, icol_local + ncol_local)/norm1(icol_local) END DO ! arnoldi subspace procedure to get H_approx - DO i = 2, narnoldi+1 + DO i = 2, narnoldi + 1 !Be careful, imaginary matrix multiplied with complex. Unfortunately requires a swap of arrays afterwards - CALL cp_gemm("N", "N", nao, newdim, nao, 1.0_dp, Him, V_mats(i-1)%matrix, 0.0_dp, V_mats(i)%matrix) + CALL cp_gemm("N", "N", nao, newdim, nao, 1.0_dp, Him, V_mats(i - 1)%matrix, 0.0_dp, V_mats(i)%matrix) !$OMP PARALLEL DO PRIVATE(icol_local) DEFAULT(NONE) SHARED(mos_new,V_mats,ncol_local,i) DO icol_local = 1, ncol_local mos_new(1)%matrix%local_data(:, icol_local) = V_mats(i)%matrix%local_data(:, icol_local) - V_mats(i)%matrix%local_data(:, icol_local) = -V_mats(i)%matrix%local_data(:, icol_local+ncol_local) - V_mats(i)%matrix%local_data(:, icol_local+ncol_local) = mos_new(1)%matrix%local_data(:, icol_local) + V_mats(i)%matrix%local_data(:, icol_local) = -V_mats(i)%matrix%local_data(:, icol_local + ncol_local) + V_mats(i)%matrix%local_data(:, icol_local + ncol_local) = mos_new(1)%matrix%local_data(:, icol_local) END DO IF (PRESENT(Hre)) THEN - CALL cp_gemm("N", "N", nao, newdim, nao, 1.0_dp, Hre, V_mats(i-1)%matrix, 1.0_dp, V_mats(i)%matrix) + CALL cp_gemm("N", "N", nao, newdim, nao, 1.0_dp, Hre, V_mats(i - 1)%matrix, 1.0_dp, V_mats(i)%matrix) END IF - DO l = 1, i-1 + DO l = 1, i - 1 !$OMP PARALLEL DO DEFAULT(NONE) SHARED(results,V_mats,ncol_local,l,i) DO icol_local = 1, ncol_local - results(icol_local) = SUM(V_mats(l)%matrix%local_data(:, icol_local)*V_mats(i)%matrix%local_data(:, icol_local))+ & - SUM(V_mats(l)%matrix%local_data(:, icol_local+ncol_local)* & - V_mats(i)%matrix%local_data(:, icol_local+ncol_local)) + results(icol_local) = SUM(V_mats(l)%matrix%local_data(:, icol_local)*V_mats(i)%matrix%local_data(:, icol_local)) + & + SUM(V_mats(l)%matrix%local_data(:, icol_local + ncol_local)* & + V_mats(i)%matrix%local_data(:, icol_local + ncol_local)) END DO CALL mp_sum(results, col_group) !$OMP PARALLEL DO DEFAULT(NONE) SHARED(H_approx_save,V_mats,ncol_local,l,i,results) DO icol_local = 1, ncol_local - H_approx_save(l, i-1, icol_local) = results(icol_local) - V_mats(i)%matrix%local_data(:, icol_local) = V_mats(i)%matrix%local_data(:, icol_local)- & + H_approx_save(l, i - 1, icol_local) = results(icol_local) + V_mats(i)%matrix%local_data(:, icol_local) = V_mats(i)%matrix%local_data(:, icol_local) - & results(icol_local)*V_mats(l)%matrix%local_data(:, icol_local) - V_mats(i)%matrix%local_data(:, icol_local+ncol_local) = & - V_mats(i)%matrix%local_data(:, icol_local+ncol_local)- & - results(icol_local)*V_mats(l)%matrix%local_data(:, icol_local+ncol_local) + V_mats(i)%matrix%local_data(:, icol_local + ncol_local) = & + V_mats(i)%matrix%local_data(:, icol_local + ncol_local) - & + results(icol_local)*V_mats(l)%matrix%local_data(:, icol_local + ncol_local) END DO END DO !$OMP PARALLEL DO DEFAULT(NONE) SHARED(ncol_local,V_mats,results,i) DO icol_local = 1, ncol_local - results(icol_local) = SUM(V_mats(i)%matrix%local_data(:, icol_local)**2)+ & - SUM(V_mats(i)%matrix%local_data(:, icol_local+ncol_local)**2) + results(icol_local) = SUM(V_mats(i)%matrix%local_data(:, icol_local)**2) + & + SUM(V_mats(i)%matrix%local_data(:, icol_local + ncol_local)**2) END DO CALL mp_sum(results, col_group) @@ -813,11 +813,11 @@ SUBROUTINE arnoldi(mos_old, mos_new, eps_exp, Hre, Him, mos_next, narn_old) !$OMP PARALLEL DO DEFAULT(NONE) SHARED(H_approx_save,last_norm,V_mats,ncol_local,i,results) DO icol_local = 1, ncol_local - H_approx_save(i, i-1, icol_local) = SQRT(results(icol_local)) + H_approx_save(i, i - 1, icol_local) = SQRT(results(icol_local)) last_norm(icol_local) = SQRT(results(icol_local)) V_mats(i)%matrix%local_data(:, icol_local) = V_mats(i)%matrix%local_data(:, icol_local)/SQRT(results(icol_local)) - V_mats(i)%matrix%local_data(:, icol_local+ncol_local) = & - V_mats(i)%matrix%local_data(:, icol_local+ncol_local)/SQRT(results(icol_local)) + V_mats(i)%matrix%local_data(:, icol_local + ncol_local) = & + V_mats(i)%matrix%local_data(:, icol_local + ncol_local)/SQRT(results(icol_local)) END DO ELSE !$OMP PARALLEL DO DEFAULT(NONE) SHARED(ncol_local,last_norm,results) @@ -853,28 +853,28 @@ SUBROUTINE arnoldi(mos_old, mos_new, eps_exp, Hre, Him, mos_next, narn_old) N(idim, idim) = rone D(idim, idim) = rone END DO - N(:, :) = N+0.5_dp*mat1 - D(:, :) = D-0.5_dp*mat1 + N(:, :) = N + 0.5_dp*mat1 + D(:, :) = D - 0.5_dp*mat1 pade_step = 1 DO idim = 1, 4 - pade_step = pade_step+1 + pade_step = pade_step + 1 CALL dgemm("N", 'N', mydim, mydim, mydim, rone, mat1(1, 1), & mydim, mat3(1, 1), mydim, rzero, mat2(1, 1), mydim) - scaleN = REAL(fac(2*npade-pade_step)*fac(npade)/ & - (fac(2*npade)*fac(pade_step)*fac(npade-pade_step)), dp) - scaleD = REAL((-1.0_dp)**pade_step*fac(2*npade-pade_step)*fac(npade)/ & - (fac(2*npade)*fac(pade_step)*fac(npade-pade_step)), dp) - N(:, :) = N+scaleN*mat2 - D(:, :) = D+scaleD*mat2 - pade_step = pade_step+1 + scaleN = REAL(fac(2*npade - pade_step)*fac(npade)/ & + (fac(2*npade)*fac(pade_step)*fac(npade - pade_step)), dp) + scaleD = REAL((-1.0_dp)**pade_step*fac(2*npade - pade_step)*fac(npade)/ & + (fac(2*npade)*fac(pade_step)*fac(npade - pade_step)), dp) + N(:, :) = N + scaleN*mat2 + D(:, :) = D + scaleD*mat2 + pade_step = pade_step + 1 CALL dgemm("N", 'N', mydim, mydim, mydim, rone, mat2(1, 1), & mydim, mat1(1, 1), mydim, rzero, mat3(1, 1), mydim) - scaleN = REAL(fac(2*npade-pade_step)*fac(npade)/ & - (fac(2*npade)*fac(pade_step)*fac(npade-pade_step)), dp) - scaleD = REAL((-1.0_dp)**pade_step*fac(2*npade-pade_step)*fac(npade)/ & - (fac(2*npade)*fac(pade_step)*fac(npade-pade_step)), dp) - N(:, :) = N+scaleN*mat3 - D(:, :) = D+scaleD*mat3 + scaleN = REAL(fac(2*npade - pade_step)*fac(npade)/ & + (fac(2*npade)*fac(pade_step)*fac(npade - pade_step)), dp) + scaleD = REAL((-1.0_dp)**pade_step*fac(2*npade - pade_step)*fac(npade)/ & + (fac(2*npade)*fac(pade_step)*fac(npade - pade_step)), dp) + N(:, :) = N + scaleN*mat3 + D(:, :) = D + scaleD*mat3 END DO CALL dgetrf(mydim, mydim, D(1, 1), mydim, ipivot, info) @@ -893,7 +893,7 @@ SUBROUTINE arnoldi(mos_old, mos_new, eps_exp, Hre, Him, mos_next, narn_old) conv_norm = 0.0_dp results = 0.0_dp DO icol_local = 1, ncol_local - results(icol_local) = last_norm(icol_local)*H_approx(i-1, 1, icol_local) + results(icol_local) = last_norm(icol_local)*H_approx(i - 1, 1, icol_local) conv_norm = MAX(conv_norm, ABS(results(icol_local))) END DO @@ -906,10 +906,10 @@ SUBROUTINE arnoldi(mos_old, mos_new, eps_exp, Hre, Him, mos_next, narn_old) DO icol_local = 1, ncol_local DO idim = 1, mydim prefac = H_approx(idim, 1, icol_local)*norm1(icol_local) - mos_new(1)%matrix%local_data(:, icol_local) = mos_new(1)%matrix%local_data(:, icol_local)+ & + mos_new(1)%matrix%local_data(:, icol_local) = mos_new(1)%matrix%local_data(:, icol_local) + & V_mats(idim)%matrix%local_data(:, icol_local)*prefac - mos_new(2)%matrix%local_data(:, icol_local) = mos_new(2)%matrix%local_data(:, icol_local)+ & - V_mats(idim)%matrix%local_data(:, icol_local+ncol_local)*prefac + mos_new(2)%matrix%local_data(:, icol_local) = mos_new(2)%matrix%local_data(:, icol_local) + & + V_mats(idim)%matrix%local_data(:, icol_local + ncol_local)*prefac END DO END DO @@ -933,17 +933,17 @@ SUBROUTINE arnoldi(mos_old, mos_new, eps_exp, Hre, Him, mos_next, narn_old) DO idim = 1, mydim prefac = H_approx(idim, 1, icol_local)*norm1(icol_local) mos_next(1)%matrix%local_data(:, icol_local) = & - mos_next(1)%matrix%local_data(:, icol_local)+ & + mos_next(1)%matrix%local_data(:, icol_local) + & V_mats(idim)%matrix%local_data(:, icol_local)*prefac mos_next(2)%matrix%local_data(:, icol_local) = & - mos_next(2)%matrix%local_data(:, icol_local)+ & - V_mats(idim)%matrix%local_data(:, icol_local+ncol_local)*prefac + mos_next(2)%matrix%local_data(:, icol_local) + & + V_mats(idim)%matrix%local_data(:, icol_local + ncol_local)*prefac END DO END DO END IF IF (conv_norm .LT. eps_exp) THEN convergence = .TRUE. - narn_old = i-1 + narn_old = i - 1 END IF END IF diff --git a/src/metadyn_tools/graph.F b/src/metadyn_tools/graph.F index fac7f4d068..9b33e7e271 100644 --- a/src/metadyn_tools/graph.F +++ b/src/metadyn_tools/graph.F @@ -10,7 +10,7 @@ !> \author Teodoro Laino [tlaino] - 06.2009 !> \par History !> 03.2006 created [tlaino] -!> teodoro.laino .at. gmail.com +!> teodoro.laino .at. gmail.com !> 11.2007 - tlaino (University of Zurich): Periodic COLVAR - cleaning. !> !> \par Note @@ -33,705 +33,701 @@ PROGRAM graph USE mathconstants, ONLY: pi #include "../base/base_uses.f90" - IMPLICIT NONE - - CHARACTER(LEN=80) :: file, out1, out2, out3, wq_char, & - path_file, out3_stride - CHARACTER(LEN=480) :: a, b - CHARACTER(LEN=default_string_length) :: active_label, per_label - INTEGER :: istat, coor, i, id, ip, & - it, iw, ix, j, ncount, ndim, & - ndw, nf, nfes, ngauss, nh, & - nprd, nt, nt_p, nwr, p, q, & - stat, unit_nr, unit_nr2 - INTEGER, POINTER :: i_map(:), idw(:), ind(:), & - inds(:), iperd(:), iprd(:), & - ngrid(:), nn(:,:), nn_max(:), & - tmp(:) - LOGICAL :: fix, l_cp2k, l_cpmd, & - l_dp, l_fes_int, l_fmin, & - l_grid, l_math, l_orac, & - l_pmin, lstride, l_popt, l_int,& - l_cube - REAL(KIND=dp) :: delta_s_glob, diff, dp2, dum, & - eps_cut, sc, ss, x0w(3), & - xfw(3) - REAL(KIND=dp), POINTER :: delta_s(:,:), dp_cut(:), dp_grid(:), fes(:), & - gauss(:,:), ss0(:,:), tmpr(:), ww(:), x0(:), xf(:) - TYPE(mep_input_data_type) :: mep_input_data - - - ! Initialize variables - nprd = 0 - ndim = 1 - ndw = 1 - nt_p = 9999999 - eps_cut = 1e-6 - file = 'HILLS' - out1 = 'fes.dat' - out2 = 'fes_int.dat' - fix = .FALSE. - l_fes_int = .FALSE. - lstride = .FALSE. - l_grid = .FALSE. - l_dp = .FALSE. - l_orac = .FALSE. - l_cp2k = .FALSE. - l_cpmd = .FALSE. - l_math = .FALSE. - l_cube = .FALSE. - l_fmin = .FALSE. - l_pmin = .FALSE. - l_popt = .FALSE. - l_int = .FALSE. - iw = 6 - - IF(COMMAND_ARGUMENT_COUNT()==0)THEN - WRITE(iw,*)'USAGE:' - WRITE(iw,*)'graf ' - WRITE(iw,*)'[-ngrid 50 .. ..] (Mesh dimension. Default :: 100)' - WRITE(iw,*)'[-dp 0.05 .. ..] (Alternative to -ngrid, allows the specification of the mesh dx)' - WRITE(iw,*)'[-ndim 3 ] (Number of collective variables NCV)' - WRITE(iw,*)'[-ndw 1 3 .. ] (CVs for the free energy surface)' - WRITE(iw,*)'[-periodic 2 3 ..] (CVs with periodic boundary conditions (-pi,pi] )' - WRITE(iw,*)'[-stride 10 ] (How often the FES is written)' - WRITE(iw,*)'[-fix 1.1 .. ..] (Define the region for the FES)' - WRITE(iw,*)' (If omitted this is automatically calculated)' - WRITE(iw,*)'[-cutoff 2. ] (The hills are cutoffed at 2)' - WRITE(iw,*)'[-file filename]' - WRITE(iw,*)'[-out filename]' - WRITE(iw,*)'[-integrated_fes] (When projecting the FES print the integrated value, ' - WRITE(iw,*)' rather then the minimum value (minimum value is default))' - WRITE(iw,*)'[-orac] (If energies are written in orac intern units)' - WRITE(iw,*)'[-cp2k] (Specify if a CP2K restart file is provided)' - WRITE(iw,*)'[-cpmd] (Specify if CPMD colvar_mtd and parvar_mtd are provided)' - WRITE(iw,*)' (With CPMD you do not need to specify -file, parvar_mtd and' - WRITE(iw,*)' colvar_mtd are expected to be present in the working directory)' - WRITE(iw,*)'[-mathlab] (File storing FES in Mathlab format. Default format Gnuplot)' - WRITE(iw,*)'[-cube] (File storing FES in GAUSSIAN CUBE format. Default format Gnuplot)' - WRITE(iw,*)'[-find-minima] (Tries to finds all minima in the computed FES)' - WRITE(iw,*)'[-find-path] (Finds MEP between all minima (found) in the computed FES)' - WRITE(iw,*)'[-point-a] (Specifies point (a) when using -find-path option)' - WRITE(iw,*)'[-point-b] (Specifies point (b) when using -find-path option)' - WRITE(iw,*)'[-opt-path filename] (Optimize initial MEP of mep-nreplica points in the same format as mep.data)' - WRITE(iw,*)'[-mep-kb] (Specifies the value of the force constant for the MEP: default 0.1_dp)' - WRITE(iw,*)'[-mep-nreplica] (Specifies the number of replica points used in the MEP: default 8)' - WRITE(iw,*)'[-mep-iter] (Specifies the maximum number of iterations used in the MEP: default 10000)' - WRITE(iw,*)'' - WRITE(iw,*)'DEFAULT OUTPUT: fes.dat' - WRITE(iw,*)'' - CPABORT("Please provide arguments to run FES!") - ENDIF - - DO i=1,COMMAND_ARGUMENT_COUNT() - CALL GET_COMMAND_ARGUMENT(i, wq_char, status=istat) - CPASSERT(istat == 0) - - IF (INDEX(wq_char,'-file').NE.0)THEN - CALL GET_COMMAND_ARGUMENT(i+1, wq_char, status=istat) - CPASSERT(istat == 0) - READ(wq_char,*)file - ENDIF - - IF (INDEX(wq_char,'-out').NE.0)THEN - CALL GET_COMMAND_ARGUMENT(i+1, wq_char, status=istat) - CPASSERT(istat == 0) - READ(wq_char,*)out1 - ! we read only 1 filename. If none is specified we differentiate between fes.dat and fes_int.dat - ! otherwise we use the one provided by the user - out2=out1 - ENDIF - - IF (INDEX(wq_char,'-ndim').NE.0)THEN - CALL GET_COMMAND_ARGUMENT(i+1, wq_char, status=istat) - CPASSERT(istat == 0) - READ(wq_char,*)ndim - ENDIF - - IF (INDEX(wq_char,'-stride').NE.0)THEN - CALL GET_COMMAND_ARGUMENT(i+1, wq_char, status=istat) - CPASSERT(istat == 0) - READ(wq_char,*)nt_p - lstride=.TRUE. - ENDIF - - IF (INDEX(wq_char,'-cutoff').NE.0)THEN - CALL GET_COMMAND_ARGUMENT(i+1, wq_char, status=istat) - CPASSERT(istat == 0) - READ(wq_char,*)eps_cut - ENDIF - - IF (INDEX(wq_char,'-integrated_fes').NE.0)THEN - l_fes_int=.TRUE. - ENDIF - - IF (INDEX(wq_char,'-orac').NE.0)THEN - l_orac=.TRUE. - ENDIF - - IF (INDEX(wq_char,'-cp2k').NE.0)THEN - l_cp2k=.TRUE. - ENDIF - - IF (INDEX(wq_char,'-cpmd').NE.0)THEN - l_cpmd=.TRUE. - ENDIF - - IF (INDEX(wq_char,'-find-minima').NE.0)THEN - l_fmin=.TRUE. - ENDIF - - IF (INDEX(wq_char,'-find-path').NE.0)THEN - l_pmin=.TRUE. - ENDIF - - IF (INDEX(wq_char,'-mathlab').NE.0)THEN - l_math=.TRUE. - ENDIF - - IF (INDEX(wq_char,'-cube').NE.0)THEN - l_cube=.TRUE. - ENDIF - - IF (INDEX(wq_char,'-opt-path').NE.0)THEN - l_popt=.TRUE. - CALL GET_COMMAND_ARGUMENT(i+1, wq_char, status=istat) - CPASSERT(istat == 0) - READ(wq_char,*)path_file - ENDIF - - END DO - IF (COUNT((/l_orac,l_cp2k,l_cpmd/))/=1) & - CPABORT("Error! You've to specify either ORAC, CP2K or CPMD!!") - - ! For CPMD move filename to colvar_mtd - IF (l_cpmd) THEN - file = "colvar_mtd" - END IF - - ! Initializing random numbers - CALL RANDOM_SEED() - CALL RANDOM_NUMBER(dum) - - ! Basic Allocation - ndw = ndim - ALLOCATE(ngrid(ndim),stat=stat) - IF (stat/=0) CPABORT("Allocation Error") - ALLOCATE(dp_grid(ndim),stat=stat) - IF (stat/=0) CPABORT("Allocation Error") - ALLOCATE(idw(ndw),stat=stat) - IF (stat/=0) CPABORT("Allocation Error") - ALLOCATE(iperd(ndim),stat=stat) - IF (stat/=0) CPABORT("Allocation Error") - ALLOCATE(iprd(nprd),stat=stat) - IF (stat/=0) CPABORT("Allocation Error") - DO i = 1, ndim - idw(i) = i - iperd(i) = 0 - END DO - - DO i=1,COMMAND_ARGUMENT_COUNT() - CALL GET_COMMAND_ARGUMENT(i, wq_char, status=istat) - CPASSERT(istat == 0) - - IF (INDEX(wq_char,'-ndw').NE.0)THEN - DEALLOCATE(idw) - - ndw=0 - ndw_loop: DO ix=i+1,COMMAND_ARGUMENT_COUNT() - CALL GET_COMMAND_ARGUMENT(ix, wq_char, status=istat) - CPASSERT(istat == 0) - IF(INDEX(wq_char,'-').EQ.0)THEN - ndw=ndw+1 - ELSE - EXIT ndw_loop - ENDIF - ENDDO ndw_loop - - ALLOCATE(idw(ndw),stat=stat) - IF (stat/=0) CPABORT("Allocation Error") - - DO id=1,ndw - CALL GET_COMMAND_ARGUMENT(i+id, wq_char, status=istat) - CPASSERT(istat == 0) - READ(wq_char,*)idw(id) - ENDDO - ENDIF - - IF (INDEX(wq_char,'-periodic').NE.0)THEN - nprd=0 - nprd_loop: DO ix=i+1,COMMAND_ARGUMENT_COUNT() - CALL GET_COMMAND_ARGUMENT(ix, wq_char, status=istat) - CPASSERT(istat == 0) - IF(INDEX(wq_char,'-').EQ.0)THEN - nprd=nprd+1 - ELSE - EXIT nprd_loop - ENDIF - ENDDO nprd_loop - - DEALLOCATE(iprd) - ALLOCATE(iprd(nprd),stat=stat) - IF (stat/=0) CPABORT("Allocation Error") - - DO id=1,nprd - CALL GET_COMMAND_ARGUMENT(i+id, wq_char, status=istat) - CPASSERT(istat == 0) - READ(wq_char,*)iprd(id) - ENDDO - ENDIF - - IF (INDEX(wq_char,'-ngrid').NE.0)THEN - DO ix=1,ndim - CALL GET_COMMAND_ARGUMENT(i+ix, wq_char, status=istat) - CPASSERT(istat == 0) - READ(wq_char,*)ngrid(ix) - l_grid=.TRUE. - END DO - ENDIF - - IF (INDEX(wq_char,'-dp').NE.0)THEN - l_dp =.TRUE. - l_grid=.FALSE. - DO ix=1,ndim - CALL GET_COMMAND_ARGUMENT(i+ix, wq_char, status=istat) - CPASSERT(istat == 0) - READ(wq_char,*)dp_grid(ix) - END DO - END IF - - IF (INDEX(wq_char,'-fix').NE.0)THEN - fix=.TRUE. - DO id=1,ndw - CALL GET_COMMAND_ARGUMENT(i+2*(id-1)+1, wq_char, status=istat) - CPASSERT(istat == 0) - READ(wq_char,*)x0w(id) - CALL GET_COMMAND_ARGUMENT(i+2*(id-1)+2, wq_char, status=istat) - CPASSERT(istat == 0) - READ(wq_char,*)xfw(id) - ENDDO - ENDIF - ENDDO - - IF (l_pmin) THEN - ALLOCATE(mep_input_data%minima(ndw,2)) - mep_input_data%minima =HUGE(0.0_dp) - mep_input_data%max_iter=10000 - mep_input_data%kb=0.1_dp - mep_input_data%nreplica=8 - ! Read for starting point (a) and (b) - DO i=1,COMMAND_ARGUMENT_COUNT() - CALL GET_COMMAND_ARGUMENT(i, wq_char, status=istat) - CPASSERT(istat == 0) - - IF (INDEX(wq_char,'-point-a').NE.0)THEN - DO id=1,ndw - CALL GET_COMMAND_ARGUMENT(i+id, wq_char, status=istat) - CPASSERT(istat == 0) - READ(wq_char,*)mep_input_data%minima(id,1) - ENDDO - ENDIF - - IF (INDEX(wq_char,'-point-b').NE.0)THEN - DO id=1,ndw - CALL GET_COMMAND_ARGUMENT(i+id, wq_char, status=istat) - CPASSERT(istat == 0) - READ(wq_char,*)mep_input_data%minima(id,2) - ENDDO - ENDIF - - IF (INDEX(wq_char,'-mep-iter').NE.0)THEN - CALL GET_COMMAND_ARGUMENT(i+1, wq_char, status=istat) - CPASSERT(istat == 0) - READ(wq_char,*)mep_input_data%max_iter - ENDIF - - IF (INDEX(wq_char,'-mep-kb').NE.0)THEN - CALL GET_COMMAND_ARGUMENT(i+1, wq_char, status=istat) - CPASSERT(istat == 0) - READ(wq_char,*)mep_input_data%kb - ENDIF - - IF (INDEX(wq_char,'-mep-nreplica').NE.0)THEN - CALL GET_COMMAND_ARGUMENT(i+1, wq_char, status=istat) - CPASSERT(istat == 0) - READ(wq_char,*)mep_input_data%nreplica - ENDIF - - END DO - IF (ANY(mep_input_data%minima==HUGE(0.0_dp))) & - CPABORT("-find-path requires the specification of -point-a and -point-b !") - ELSE - ALLOCATE(mep_input_data%minima(0,0)) - END IF - -! Read parameters for Path_optimization + IMPLICIT NONE + + CHARACTER(LEN=80) :: file, out1, out2, out3, wq_char, & + path_file, out3_stride + CHARACTER(LEN=480) :: a, b + CHARACTER(LEN=default_string_length) :: active_label, per_label + INTEGER :: istat, coor, i, id, ip, & + it, iw, ix, j, ncount, ndim, & + ndw, nf, nfes, ngauss, nh, & + nprd, nt, nt_p, nwr, p, q, & + stat, unit_nr, unit_nr2 + INTEGER, POINTER :: i_map(:), idw(:), ind(:), & + inds(:), iperd(:), iprd(:), & + ngrid(:), nn(:, :), nn_max(:), & + tmp(:) + LOGICAL :: fix, l_cp2k, l_cpmd, & + l_dp, l_fes_int, l_fmin, & + l_grid, l_math, l_orac, & + l_pmin, lstride, l_popt, l_int, & + l_cube + REAL(KIND=dp) :: delta_s_glob, diff, dp2, dum, & + eps_cut, sc, ss, x0w(3), & + xfw(3) + REAL(KIND=dp), POINTER :: delta_s(:, :), dp_cut(:), dp_grid(:), fes(:), & + gauss(:, :), ss0(:, :), tmpr(:), ww(:), x0(:), xf(:) + TYPE(mep_input_data_type) :: mep_input_data + + ! Initialize variables + nprd = 0 + ndim = 1 + ndw = 1 + nt_p = 9999999 + eps_cut = 1e-6 + file = 'HILLS' + out1 = 'fes.dat' + out2 = 'fes_int.dat' + fix = .FALSE. + l_fes_int = .FALSE. + lstride = .FALSE. + l_grid = .FALSE. + l_dp = .FALSE. + l_orac = .FALSE. + l_cp2k = .FALSE. + l_cpmd = .FALSE. + l_math = .FALSE. + l_cube = .FALSE. + l_fmin = .FALSE. + l_pmin = .FALSE. + l_popt = .FALSE. + l_int = .FALSE. + iw = 6 + + IF (COMMAND_ARGUMENT_COUNT() == 0) THEN + WRITE (iw, *) 'USAGE:' + WRITE (iw, *) 'graf ' + WRITE (iw, *) '[-ngrid 50 .. ..] (Mesh dimension. Default :: 100)' + WRITE (iw, *) '[-dp 0.05 .. ..] (Alternative to -ngrid, allows the specification of the mesh dx)' + WRITE (iw, *) '[-ndim 3 ] (Number of collective variables NCV)' + WRITE (iw, *) '[-ndw 1 3 .. ] (CVs for the free energy surface)' + WRITE (iw, *) '[-periodic 2 3 ..] (CVs with periodic boundary conditions (-pi,pi] )' + WRITE (iw, *) '[-stride 10 ] (How often the FES is written)' + WRITE (iw, *) '[-fix 1.1 .. ..] (Define the region for the FES)' + WRITE (iw, *) ' (If omitted this is automatically calculated)' + WRITE (iw, *) '[-cutoff 2. ] (The hills are cutoffed at 2)' + WRITE (iw, *) '[-file filename]' + WRITE (iw, *) '[-out filename]' + WRITE (iw, *) '[-integrated_fes] (When projecting the FES print the integrated value, ' + WRITE (iw, *) ' rather then the minimum value (minimum value is default))' + WRITE (iw, *) '[-orac] (If energies are written in orac intern units)' + WRITE (iw, *) '[-cp2k] (Specify if a CP2K restart file is provided)' + WRITE (iw, *) '[-cpmd] (Specify if CPMD colvar_mtd and parvar_mtd are provided)' + WRITE (iw, *) ' (With CPMD you do not need to specify -file, parvar_mtd and' + WRITE (iw, *) ' colvar_mtd are expected to be present in the working directory)' + WRITE (iw, *) '[-mathlab] (File storing FES in Mathlab format. Default format Gnuplot)' + WRITE (iw, *) '[-cube] (File storing FES in GAUSSIAN CUBE format. Default format Gnuplot)' + WRITE (iw, *) '[-find-minima] (Tries to finds all minima in the computed FES)' + WRITE (iw, *) '[-find-path] (Finds MEP between all minima (found) in the computed FES)' + WRITE (iw, *) '[-point-a] (Specifies point (a) when using -find-path option)' + WRITE (iw, *) '[-point-b] (Specifies point (b) when using -find-path option)' + WRITE (iw, *) '[-opt-path filename] (Optimize initial MEP of mep-nreplica points in the same format as mep.data)' + WRITE (iw, *) '[-mep-kb] (Specifies the value of the force constant for the MEP: default 0.1_dp)' + WRITE (iw, *) '[-mep-nreplica] (Specifies the number of replica points used in the MEP: default 8)' + WRITE (iw, *) '[-mep-iter] (Specifies the maximum number of iterations used in the MEP: default 10000)' + WRITE (iw, *) '' + WRITE (iw, *) 'DEFAULT OUTPUT: fes.dat' + WRITE (iw, *) '' + CPABORT("Please provide arguments to run FES!") + ENDIF + + DO i = 1, COMMAND_ARGUMENT_COUNT() + CALL GET_COMMAND_ARGUMENT(i, wq_char, status=istat) + CPASSERT(istat == 0) + + IF (INDEX(wq_char, '-file') .NE. 0) THEN + CALL GET_COMMAND_ARGUMENT(i + 1, wq_char, status=istat) + CPASSERT(istat == 0) + READ (wq_char, *) file + ENDIF + + IF (INDEX(wq_char, '-out') .NE. 0) THEN + CALL GET_COMMAND_ARGUMENT(i + 1, wq_char, status=istat) + CPASSERT(istat == 0) + READ (wq_char, *) out1 + ! we read only 1 filename. If none is specified we differentiate between fes.dat and fes_int.dat + ! otherwise we use the one provided by the user + out2 = out1 + ENDIF + + IF (INDEX(wq_char, '-ndim') .NE. 0) THEN + CALL GET_COMMAND_ARGUMENT(i + 1, wq_char, status=istat) + CPASSERT(istat == 0) + READ (wq_char, *) ndim + ENDIF + + IF (INDEX(wq_char, '-stride') .NE. 0) THEN + CALL GET_COMMAND_ARGUMENT(i + 1, wq_char, status=istat) + CPASSERT(istat == 0) + READ (wq_char, *) nt_p + lstride = .TRUE. + ENDIF + + IF (INDEX(wq_char, '-cutoff') .NE. 0) THEN + CALL GET_COMMAND_ARGUMENT(i + 1, wq_char, status=istat) + CPASSERT(istat == 0) + READ (wq_char, *) eps_cut + ENDIF + + IF (INDEX(wq_char, '-integrated_fes') .NE. 0) THEN + l_fes_int = .TRUE. + ENDIF + + IF (INDEX(wq_char, '-orac') .NE. 0) THEN + l_orac = .TRUE. + ENDIF + + IF (INDEX(wq_char, '-cp2k') .NE. 0) THEN + l_cp2k = .TRUE. + ENDIF + + IF (INDEX(wq_char, '-cpmd') .NE. 0) THEN + l_cpmd = .TRUE. + ENDIF + + IF (INDEX(wq_char, '-find-minima') .NE. 0) THEN + l_fmin = .TRUE. + ENDIF + + IF (INDEX(wq_char, '-find-path') .NE. 0) THEN + l_pmin = .TRUE. + ENDIF + + IF (INDEX(wq_char, '-mathlab') .NE. 0) THEN + l_math = .TRUE. + ENDIF + + IF (INDEX(wq_char, '-cube') .NE. 0) THEN + l_cube = .TRUE. + ENDIF + + IF (INDEX(wq_char, '-opt-path') .NE. 0) THEN + l_popt = .TRUE. + CALL GET_COMMAND_ARGUMENT(i + 1, wq_char, status=istat) + CPASSERT(istat == 0) + READ (wq_char, *) path_file + ENDIF + + END DO + IF (COUNT((/l_orac, l_cp2k, l_cpmd/)) /= 1) & + CPABORT("Error! You've to specify either ORAC, CP2K or CPMD!!") + + ! For CPMD move filename to colvar_mtd + IF (l_cpmd) THEN + file = "colvar_mtd" + END IF + + ! Initializing random numbers + CALL RANDOM_SEED() + CALL RANDOM_NUMBER(dum) + + ! Basic Allocation + ndw = ndim + ALLOCATE (ngrid(ndim), stat=stat) + IF (stat /= 0) CPABORT("Allocation Error") + ALLOCATE (dp_grid(ndim), stat=stat) + IF (stat /= 0) CPABORT("Allocation Error") + ALLOCATE (idw(ndw), stat=stat) + IF (stat /= 0) CPABORT("Allocation Error") + ALLOCATE (iperd(ndim), stat=stat) + IF (stat /= 0) CPABORT("Allocation Error") + ALLOCATE (iprd(nprd), stat=stat) + IF (stat /= 0) CPABORT("Allocation Error") + DO i = 1, ndim + idw(i) = i + iperd(i) = 0 + END DO + + DO i = 1, COMMAND_ARGUMENT_COUNT() + CALL GET_COMMAND_ARGUMENT(i, wq_char, status=istat) + CPASSERT(istat == 0) + + IF (INDEX(wq_char, '-ndw') .NE. 0) THEN + DEALLOCATE (idw) + + ndw = 0 + ndw_loop: DO ix = i + 1, COMMAND_ARGUMENT_COUNT() + CALL GET_COMMAND_ARGUMENT(ix, wq_char, status=istat) + CPASSERT(istat == 0) + IF (INDEX(wq_char, '-') .EQ. 0) THEN + ndw = ndw + 1 + ELSE + EXIT ndw_loop + ENDIF + ENDDO ndw_loop + + ALLOCATE (idw(ndw), stat=stat) + IF (stat /= 0) CPABORT("Allocation Error") + + DO id = 1, ndw + CALL GET_COMMAND_ARGUMENT(i + id, wq_char, status=istat) + CPASSERT(istat == 0) + READ (wq_char, *) idw(id) + ENDDO + ENDIF + + IF (INDEX(wq_char, '-periodic') .NE. 0) THEN + nprd = 0 + nprd_loop: DO ix = i + 1, COMMAND_ARGUMENT_COUNT() + CALL GET_COMMAND_ARGUMENT(ix, wq_char, status=istat) + CPASSERT(istat == 0) + IF (INDEX(wq_char, '-') .EQ. 0) THEN + nprd = nprd + 1 + ELSE + EXIT nprd_loop + ENDIF + ENDDO nprd_loop + + DEALLOCATE (iprd) + ALLOCATE (iprd(nprd), stat=stat) + IF (stat /= 0) CPABORT("Allocation Error") + + DO id = 1, nprd + CALL GET_COMMAND_ARGUMENT(i + id, wq_char, status=istat) + CPASSERT(istat == 0) + READ (wq_char, *) iprd(id) + ENDDO + ENDIF + + IF (INDEX(wq_char, '-ngrid') .NE. 0) THEN + DO ix = 1, ndim + CALL GET_COMMAND_ARGUMENT(i + ix, wq_char, status=istat) + CPASSERT(istat == 0) + READ (wq_char, *) ngrid(ix) + l_grid = .TRUE. + END DO + ENDIF + + IF (INDEX(wq_char, '-dp') .NE. 0) THEN + l_dp = .TRUE. + l_grid = .FALSE. + DO ix = 1, ndim + CALL GET_COMMAND_ARGUMENT(i + ix, wq_char, status=istat) + CPASSERT(istat == 0) + READ (wq_char, *) dp_grid(ix) + END DO + END IF + + IF (INDEX(wq_char, '-fix') .NE. 0) THEN + fix = .TRUE. + DO id = 1, ndw + CALL GET_COMMAND_ARGUMENT(i + 2*(id - 1) + 1, wq_char, status=istat) + CPASSERT(istat == 0) + READ (wq_char, *) x0w(id) + CALL GET_COMMAND_ARGUMENT(i + 2*(id - 1) + 2, wq_char, status=istat) + CPASSERT(istat == 0) + READ (wq_char, *) xfw(id) + ENDDO + ENDIF + ENDDO + + IF (l_pmin) THEN + ALLOCATE (mep_input_data%minima(ndw, 2)) + mep_input_data%minima = HUGE(0.0_dp) + mep_input_data%max_iter = 10000 + mep_input_data%kb = 0.1_dp + mep_input_data%nreplica = 8 + ! Read for starting point (a) and (b) + DO i = 1, COMMAND_ARGUMENT_COUNT() + CALL GET_COMMAND_ARGUMENT(i, wq_char, status=istat) + CPASSERT(istat == 0) + + IF (INDEX(wq_char, '-point-a') .NE. 0) THEN + DO id = 1, ndw + CALL GET_COMMAND_ARGUMENT(i + id, wq_char, status=istat) + CPASSERT(istat == 0) + READ (wq_char, *) mep_input_data%minima(id, 1) + ENDDO + ENDIF + + IF (INDEX(wq_char, '-point-b') .NE. 0) THEN + DO id = 1, ndw + CALL GET_COMMAND_ARGUMENT(i + id, wq_char, status=istat) + CPASSERT(istat == 0) + READ (wq_char, *) mep_input_data%minima(id, 2) + ENDDO + ENDIF + + IF (INDEX(wq_char, '-mep-iter') .NE. 0) THEN + CALL GET_COMMAND_ARGUMENT(i + 1, wq_char, status=istat) + CPASSERT(istat == 0) + READ (wq_char, *) mep_input_data%max_iter + ENDIF + + IF (INDEX(wq_char, '-mep-kb') .NE. 0) THEN + CALL GET_COMMAND_ARGUMENT(i + 1, wq_char, status=istat) + CPASSERT(istat == 0) + READ (wq_char, *) mep_input_data%kb + ENDIF + + IF (INDEX(wq_char, '-mep-nreplica') .NE. 0) THEN + CALL GET_COMMAND_ARGUMENT(i + 1, wq_char, status=istat) + CPASSERT(istat == 0) + READ (wq_char, *) mep_input_data%nreplica + ENDIF + + END DO + IF (ANY(mep_input_data%minima == HUGE(0.0_dp))) & + CPABORT("-find-path requires the specification of -point-a and -point-b !") + ELSE + ALLOCATE (mep_input_data%minima(0, 0)) + END IF + +! Read parameters for Path_optimization IF (l_popt) THEN - mep_input_data%nreplica=0 - mep_input_data%max_iter=10000 - mep_input_data%kb=0.1_dp - - DO i=1,COMMAND_ARGUMENT_COUNT() - CALL GET_COMMAND_ARGUMENT(i, wq_char, status=istat) - CPASSERT(istat == 0) - - IF (INDEX(wq_char,'-mep-kb').NE.0)THEN - CALL GET_COMMAND_ARGUMENT(i+1, wq_char, status=istat) - CPASSERT(istat == 0) - READ(wq_char,*)mep_input_data%kb - ENDIF - - IF (INDEX(wq_char,'-mep-iter').NE.0)THEN - CALL GET_COMMAND_ARGUMENT(i+1, wq_char, status=istat) - CPASSERT(istat == 0) - READ(wq_char,*)mep_input_data%max_iter - ENDIF - - IF (INDEX(wq_char,'-mep-nreplica').NE.0)THEN - CALL GET_COMMAND_ARGUMENT(i+1, wq_char, status=istat) - CPASSERT(istat == 0) - READ(wq_char,*)mep_input_data%nreplica - ENDIF - END DO - - ALLOCATE(mep_input_data%minima(ndw,mep_input_data%nreplica)) - - CALL open_file(unit_number=unit_nr,file_name=path_file,file_status="OLD") - DO id=1, mep_input_data%nreplica - READ(unit_nr,*) j, mep_input_data%minima(:,id) - END DO - CALL close_file(unit_nr) - - DO id=1, mep_input_data%nreplica - WRITE(*,*) mep_input_data%minima(:,id) - END DO - END IF - - - - - ! Defines the order of the collectiv var.: first the "wanted" ones, then the others - ALLOCATE(i_map(ndim),stat=stat) - IF (stat/=0) CPABORT("Allocation Error") - i_map = 0 - - DO id=1,ndw - i_map(idw(id))=id - ENDDO - ix=ndw - DO id=1,ndim - IF(i_map(id)==0)THEN - ix=ix+1 - i_map(id)=ix - ENDIF - ENDDO - - ! Revert the order so we can perform averages (when projecting FES) more - ! efficiently - i_map=ndim-i_map+1 - - ! Tag the periodic COLVAR according the new internal order - DO id=1,nprd - iperd(i_map(iprd(id)))=1 - END DO - - ! Grid size - IF(l_grid) THEN - ALLOCATE(tmp(ndim),stat=stat) - IF (stat/=0) CPABORT("Allocation Error") - tmp=ngrid - DO i=1,ndim - ngrid(i_map(i))=tmp(i) - END DO - DEALLOCATE(tmp) - ELSE - ngrid=100 - END IF - - WRITE(iw,'(/,70("*"))') - WRITE(iw,'("FES|",T7,A,/)')"Parsing file: <"//TRIM(file)//">" - - CALL open_file(unit_number=unit_nr,file_name=file,file_status="OLD") - IF (l_cp2k) THEN - CALL get_val_res(unit=unit_nr,section="&METADYN",keyword="NHILLS_START_VAL", i_val=nt) - ! These sections may not necessarily be present.. if not the values will be HUGE and negative.. - ! If sc>0 but p and q are not defined, it fails miserably - CALL get_val_res(unit=unit_nr,section="&METADYN",keyword="HILL_TAIL_CUTOFF", r_val=sc) - CALL get_val_res(unit=unit_nr,section="&METADYN",keyword="P_EXPONENT", i_val=p) - CALL get_val_res(unit=unit_nr,section="&METADYN",keyword="Q_EXPONENT", i_val=q) - ELSE IF (l_orac.OR.l_cpmd) THEN - nt=0 - DO WHILE (.TRUE.) - READ(unit_nr,*,END=100,ERR=100)dum - nt=nt+1 - END DO -100 REWIND(unit_nr) - END IF - - ALLOCATE( x0(ndim) , stat=stat ) - IF (stat/=0) CPABORT("Allocation Error") - ALLOCATE( xf(ndim) , stat=stat ) - IF (stat/=0) CPABORT("Allocation Error") - ALLOCATE( ss0(ndim,nt) , stat=stat ) - IF (stat/=0) CPABORT("Allocation Error") - ALLOCATE( delta_s(ndim,nt) , stat=stat ) - IF (stat/=0) CPABORT("Allocation Error") - ALLOCATE( ww(nt) , stat=stat ) - IF (stat/=0) CPABORT("Allocation Error") - ALLOCATE( ind(ndim) , stat=stat ) - IF (stat/=0) CPABORT("Allocation Error") - ALLOCATE( inds(ndim) , stat=stat ) - IF (stat/=0) CPABORT("Allocation Error") - ALLOCATE( nn(ndim,nt) , stat=stat ) - IF (stat/=0) CPABORT("Allocation Error") - ALLOCATE( nn_max(ndim) , stat=stat ) - IF (stat/=0) CPABORT("Allocation Error") - ALLOCATE( dp_cut(ndim) , stat=stat ) - IF (stat/=0) CPABORT("Allocation Error") - - IF (l_cp2k) THEN - CALL get_val_res(unit=unit_nr,section="&METADYN",subsection="&SPAWNED_HILLS_POS") - DO i = 1, nt - READ(unit_nr,'(A120)') a - DO WHILE (a(LEN_TRIM(a):LEN_TRIM(a))=='\\') - READ(unit_nr,'(A120)') b - a=a(1:LEN_TRIM(a)-1)//b(1:LEN_TRIM(b)) - END DO - READ(a,*)(ss0(i_map(id),i),id=1,ndim) - END DO - CALL get_val_res(unit=unit_nr,section="&METADYN",subsection="&SPAWNED_HILLS_SCALE") - DO i = 1, nt - READ(unit_nr,'(A120)') a - DO WHILE (a(LEN_TRIM(a):LEN_TRIM(a))=='\\') - READ(unit_nr,'(A120)') b - a=a(1:LEN_TRIM(a)-1)//b(1:LEN_TRIM(b)) - END DO - READ(a,*) (delta_s(i_map(id),i),id=1,ndim) - END DO - CALL get_val_res(unit=unit_nr,section="&METADYN",subsection="&SPAWNED_HILLS_HEIGHT") - DO i = 1, nt - READ(unit_nr,*)ww(i) - END DO - ELSE IF (l_orac) THEN - DO i = 1, nt - READ(unit_nr,*)dum,(ss0(i_map(id),i),id=1,ndim),(delta_s(i_map(id),i),id=1,ndim),ww(i) - END DO - ELSE IF (l_cpmd) THEN - CALL open_file(unit_number=unit_nr2,file_name="parvar_mtd",file_status="OLD") - DO i = 1, nt - READ(unit_nr,*)dum,(ss0(i_map(id),i),id=1,ndim),(delta_s(id,i),id=1,ndim) - READ(unit_nr2,*)dum,dum,delta_s_glob,ww(i) - delta_s(1:ndim,i)=delta_s_glob*delta_s(1:ndim,i) - END DO - CALL close_file(unit_nr2) - END IF - CALL close_file(unit_nr) - - ! ORAC conversion factor - IF(l_orac) ww = ww * 10000._dp / 4.187_dp - - ! Setting up the limit of definitions for the several colvars - DO id=1,ndim - x0(id) = HUGE(1.0_dp) - xf(id) =-HUGE(1.0_dp) - ENDDO - IF(fix) THEN - DO it=1,nt - DO id=1,ndim-ndw - x0(id)=MIN(x0(id),ss0(id,it)-3.*delta_s(id,it)) - xf(id)=MAX(xf(id),ss0(id,it)+3.*delta_s(id,it)) - ENDDO - ENDDO - it=0 - DO id=ndim,ndim-ndw+1,-1 - it=it+1 - x0(id)=x0w(it) - xf(id)=xfw(it) - ENDDO - ELSE - DO it=1,nt - DO id=ndim,1,-1 - IF (iperd(id)==1) THEN - x0(id)=-pi - xf(id)= pi - ELSE - x0(id)=MIN(x0(id),ss0(id,it)-3.*delta_s(id,it)) - xf(id)=MAX(xf(id),ss0(id,it)+3.*delta_s(id,it)) - END IF - ENDDO - ENDDO - ENDIF - - IF(l_dp)THEN - ALLOCATE(tmpr(ndim)) - tmpr=dp_grid - DO i=1,ndim - dp_grid(i_map(i))=tmpr(i) - END DO - DEALLOCATE(tmpr) - ngrid=INT((xf-x0)/dp_grid)+1 - ELSE - dp_grid=(xf-x0)/REAL(ngrid-1, KIND=dp) - END IF - - WRITE(iw,'(70("*"))') - WRITE(iw,'("FES|",T7,A,/)')"Parameters for FES:" - WRITE(iw,'("FES|",T7,A15,5x,i7)')"NDIM ::",ndim - WRITE(iw,'("FES|",T7,A15,5x,i7)')"NWD ::",ndw - WRITE(iw,'("FES|",T7,A15,5x,i7)')"HILLS ::",nt - it=0 - DO i=ndim,1,-1 - it = it + 1 - per_label = "" - active_label = "(NO MAPPED)" - IF (iperd(i)/=0) per_label = "(PERIODIC)" - IF (it<=ndw) active_label = "( MAPPED)" - j = MINLOC((i_map-i)**2,1) - WRITE(iw,'("FES|",T7,"COLVAR # ",i3," ::",5x,"(",f7.3," ,",f7.3,")",T48,A,T60,A)')& - j,x0(i),xf(i),TRIM(per_label),TRIM(active_label) - END DO - WRITE(iw,'("FES|",T7,a15,5x,7i7)' )"NGRID ::",(ngrid(id),id=ndim,ndim-ndw+1,-1) - WRITE(iw,'("FES|",T7,a15,5x,5f7.3)' )"DX ::",(dp_grid(id),id=ndim,ndim-ndw+1,-1) - WRITE(iw,'("FES|",T7,a15,5x,g10.5)' )"CUTOFF ::",eps_cut - WRITE(iw,'(70("*"),/)') - - nn_max = 0 - DO i = 1, nt - dp_cut = SQRT(LOG(ABS(ww(i))/eps_cut))*2.0_dp*delta_s(:,i) - nn(:,i) = INT(dp_cut/dp_grid) - ww(i) = ww(i)**(1.0_dp/REAL(ndim, KIND=dp)) - END DO - - nn_max = MAXVAL(nn,DIM=2) - ngauss = MAXVAL(nn_max) * 2 + 1 - nfes = PRODUCT(ngrid) - - ALLOCATE(gauss(-MAXVAL(nn_max):MAXVAL(nn_max),ndim)) - ALLOCATE(fes(nfes)) - fes=0.0_dp - - nh=1 - nf=MIN(nh+nt_p-1,nt) - - IF (lstride)THEN - nwr=nt_p - ELSE - nwr=INT(nt/10)+1 - END IF - - ncount = 0 - WRITE(iw,'(/,"FES|",T7,A)') "Computing Free Energy Surface" - - Stride : DO WHILE (nh <= nt) - Hills : DO it=nh,nf - ind=INT((ss0(:,it)-x0)/dp_grid) + 1 - gauss=0.0_dp - - DO i=1,ndim - coor = ind(i) - nn(i,it) - 1 - ss = x0(i) + coor * dp_grid(i) - dp_grid(i) - DO ip=-nn(i,it),nn(i,it) - coor = coor + 1 - ss = ss + dp_grid(i) - IF (iperd(i)==0) THEN - IF (coor .GT. ngrid(i)) CYCLE - IF (coor .LT. 1) CYCLE - END IF - diff = ss-ss0(i,it) - dp2=(diff/delta_s(i,it))**2 - gauss(ip,i)=ww(it)*EXP(-0.5_dp*dp2) - IF(sc > 0.0_dp .AND. p>0.0_dp .AND. q>0.0_dp .AND. q>p) THEN - gauss(ip,i)= gauss(ip,i) * (1-(diff/sc*delta_s(i,it))**p)/(1-(diff/sc*delta_s(i,it))**q) - END IF - END DO - END DO - inds = ind - CALL fes_compute_low(ndim,nn(:,it),fes,gauss,ind,inds,nfes,ndim,ngauss,ngrid,iperd) - - IF(.NOT. lstride .AND. MOD(it,nwr)==0)THEN - WRITE(iw,'("FES|",T7,a,i4,a2)') "Mapping Gaussians ::",INT(10*ANINT(10.*it/nt))," %" - ELSEIF(.NOT. lstride .AND. it==nt)THEN - WRITE(iw,'("FES|",T7,a,i4,a2)') "Mapping Gaussians ::",INT(10*ANINT(10.*it/nt))," %" - END IF - END DO Hills - - IF (lstride) THEN - ncount = ncount+1 - WRITE(iw,'("FES|",T7,a13,i5," |-| Gaussians from ",i6," to",i6)') "Done frame ::",ncount,nh,nf - IF (l_fes_int) THEN - out3=out2//"." - ELSE - out3=out1//"." - END IF - - IF(ncount<10) THEN - WRITE(out3_stride,'(A,i1)')TRIM(out3),ncount - ELSEIF(ncount<100) THEN - WRITE(out3_stride,'(A,i2)')TRIM(out3),ncount - ELSE - WRITE(out3_stride,'(A,i3)')TRIM(out3),ncount - END IF - CALL open_file(unit_number=unit_nr,file_name=out3_stride,file_action="WRITE",file_status="UNKNOWN",file_form="FORMATTED") - ind = 1 - CALL fes_only_write(ndim, fes, ind, ndim, ngrid, dp_grid, ndw, l_fes_int, unit_nr) - CALL close_file(unit_nr) - END IF - - nh=nh+nt_p - nf=MIN(nh+nt_p-1,nt) - END DO Stride - DEALLOCATE(gauss) - - IF (l_fes_int) THEN - out3=out2 - ELSE - out3=out1 - END IF - - WRITE(iw,'("FES|",T7,A)') "Dumping FES structure in file: < "//TRIM(out3)//" >" - CALL open_file(unit_number=unit_nr,file_name=out3,file_action="WRITE",file_status="UNKNOWN",file_form="FORMATTED") - IF (l_cube) THEN - ind = 1 - CALL fes_cube_write(ndim, fes, ind, ndim, ngrid, dp_grid, x0, ndw, l_fes_int, file) - ELSE - ix=0 - IF (l_math) WRITE(unit_nr,'(10g12.5)')(ngrid(id),id=ndim,ndim-ndw+1,-1),ix - ind = 1 - CALL fes_write(unit_nr, ndim, fes, ind, ndim, ngrid, dp_grid, x0, ndw, l_fes_int) - END IF - CALL close_file(unit_nr) - - ! If requested find minima - IF (l_fmin) CALL fes_min(fes, ndim, iperd, ngrid, dp_grid, x0, ndw) - - ! If requested find or opt path - IF ((l_pmin) .AND. (l_popt)) CPABORT("USE EITHER -find-path OR -opt-path") - IF (l_pmin) l_int=.TRUE. - IF (l_popt) l_int=.FALSE. - - IF ((l_pmin) .OR. (l_popt)) CALL fes_path(fes, ndim, ngrid, dp_grid, iperd, x0, ndw, mep_input_data, l_int) - - ! Free memory - DEALLOCATE(ngrid) - DEALLOCATE(dp_grid) - DEALLOCATE(idw) - DEALLOCATE(iperd) - DEALLOCATE(x0) - DEALLOCATE(xf) - DEALLOCATE(ss0) - DEALLOCATE(delta_s) - DEALLOCATE(ww) - DEALLOCATE(ind) - DEALLOCATE(inds) - DEALLOCATE(nn) - DEALLOCATE(nn_max) - DEALLOCATE(dp_cut) - DEALLOCATE(i_map) - DEALLOCATE(fes) - DEALLOCATE(iprd) - DEALLOCATE(mep_input_data%minima) - - ! Terminate FES - WRITE(iw,'(/,A,/)') "FES| NORMAL FES TERMINATION." + mep_input_data%nreplica = 0 + mep_input_data%max_iter = 10000 + mep_input_data%kb = 0.1_dp + + DO i = 1, COMMAND_ARGUMENT_COUNT() + CALL GET_COMMAND_ARGUMENT(i, wq_char, status=istat) + CPASSERT(istat == 0) + + IF (INDEX(wq_char, '-mep-kb') .NE. 0) THEN + CALL GET_COMMAND_ARGUMENT(i + 1, wq_char, status=istat) + CPASSERT(istat == 0) + READ (wq_char, *) mep_input_data%kb + ENDIF + + IF (INDEX(wq_char, '-mep-iter') .NE. 0) THEN + CALL GET_COMMAND_ARGUMENT(i + 1, wq_char, status=istat) + CPASSERT(istat == 0) + READ (wq_char, *) mep_input_data%max_iter + ENDIF + + IF (INDEX(wq_char, '-mep-nreplica') .NE. 0) THEN + CALL GET_COMMAND_ARGUMENT(i + 1, wq_char, status=istat) + CPASSERT(istat == 0) + READ (wq_char, *) mep_input_data%nreplica + ENDIF + END DO + + ALLOCATE (mep_input_data%minima(ndw, mep_input_data%nreplica)) + + CALL open_file(unit_number=unit_nr, file_name=path_file, file_status="OLD") + DO id = 1, mep_input_data%nreplica + READ (unit_nr, *) j, mep_input_data%minima(:, id) + END DO + CALL close_file(unit_nr) + + DO id = 1, mep_input_data%nreplica + WRITE (*, *) mep_input_data%minima(:, id) + END DO + END IF + + ! Defines the order of the collectiv var.: first the "wanted" ones, then the others + ALLOCATE (i_map(ndim), stat=stat) + IF (stat /= 0) CPABORT("Allocation Error") + i_map = 0 + + DO id = 1, ndw + i_map(idw(id)) = id + ENDDO + ix = ndw + DO id = 1, ndim + IF (i_map(id) == 0) THEN + ix = ix + 1 + i_map(id) = ix + ENDIF + ENDDO + + ! Revert the order so we can perform averages (when projecting FES) more + ! efficiently + i_map = ndim - i_map + 1 + + ! Tag the periodic COLVAR according the new internal order + DO id = 1, nprd + iperd(i_map(iprd(id))) = 1 + END DO + + ! Grid size + IF (l_grid) THEN + ALLOCATE (tmp(ndim), stat=stat) + IF (stat /= 0) CPABORT("Allocation Error") + tmp = ngrid + DO i = 1, ndim + ngrid(i_map(i)) = tmp(i) + END DO + DEALLOCATE (tmp) + ELSE + ngrid = 100 + END IF + + WRITE (iw, '(/,70("*"))') + WRITE (iw, '("FES|",T7,A,/)') "Parsing file: <"//TRIM(file)//">" + + CALL open_file(unit_number=unit_nr, file_name=file, file_status="OLD") + IF (l_cp2k) THEN + CALL get_val_res(unit=unit_nr, section="&METADYN", keyword="NHILLS_START_VAL", i_val=nt) + ! These sections may not necessarily be present.. if not the values will be HUGE and negative.. + ! If sc>0 but p and q are not defined, it fails miserably + CALL get_val_res(unit=unit_nr, section="&METADYN", keyword="HILL_TAIL_CUTOFF", r_val=sc) + CALL get_val_res(unit=unit_nr, section="&METADYN", keyword="P_EXPONENT", i_val=p) + CALL get_val_res(unit=unit_nr, section="&METADYN", keyword="Q_EXPONENT", i_val=q) + ELSE IF (l_orac .OR. l_cpmd) THEN + nt = 0 + DO WHILE (.TRUE.) + READ (unit_nr, *, END=100, ERR=100) dum + nt = nt + 1 + END DO +100 REWIND (unit_nr) + END IF + + ALLOCATE (x0(ndim), stat=stat) + IF (stat /= 0) CPABORT("Allocation Error") + ALLOCATE (xf(ndim), stat=stat) + IF (stat /= 0) CPABORT("Allocation Error") + ALLOCATE (ss0(ndim, nt), stat=stat) + IF (stat /= 0) CPABORT("Allocation Error") + ALLOCATE (delta_s(ndim, nt), stat=stat) + IF (stat /= 0) CPABORT("Allocation Error") + ALLOCATE (ww(nt), stat=stat) + IF (stat /= 0) CPABORT("Allocation Error") + ALLOCATE (ind(ndim), stat=stat) + IF (stat /= 0) CPABORT("Allocation Error") + ALLOCATE (inds(ndim), stat=stat) + IF (stat /= 0) CPABORT("Allocation Error") + ALLOCATE (nn(ndim, nt), stat=stat) + IF (stat /= 0) CPABORT("Allocation Error") + ALLOCATE (nn_max(ndim), stat=stat) + IF (stat /= 0) CPABORT("Allocation Error") + ALLOCATE (dp_cut(ndim), stat=stat) + IF (stat /= 0) CPABORT("Allocation Error") + + IF (l_cp2k) THEN + CALL get_val_res(unit=unit_nr, section="&METADYN", subsection="&SPAWNED_HILLS_POS") + DO i = 1, nt + READ (unit_nr, '(A120)') a + DO WHILE (a(LEN_TRIM(a):LEN_TRIM(a)) == '\\') + READ (unit_nr, '(A120)') b + a = a(1:LEN_TRIM(a) - 1)//b(1:LEN_TRIM(b)) + END DO + READ (a, *) (ss0(i_map(id), i), id=1, ndim) + END DO + CALL get_val_res(unit=unit_nr, section="&METADYN", subsection="&SPAWNED_HILLS_SCALE") + DO i = 1, nt + READ (unit_nr, '(A120)') a + DO WHILE (a(LEN_TRIM(a):LEN_TRIM(a)) == '\\') + READ (unit_nr, '(A120)') b + a = a(1:LEN_TRIM(a) - 1)//b(1:LEN_TRIM(b)) + END DO + READ (a, *) (delta_s(i_map(id), i), id=1, ndim) + END DO + CALL get_val_res(unit=unit_nr, section="&METADYN", subsection="&SPAWNED_HILLS_HEIGHT") + DO i = 1, nt + READ (unit_nr, *) ww(i) + END DO + ELSE IF (l_orac) THEN + DO i = 1, nt + READ (unit_nr, *) dum, (ss0(i_map(id), i), id=1, ndim), (delta_s(i_map(id), i), id=1, ndim), ww(i) + END DO + ELSE IF (l_cpmd) THEN + CALL open_file(unit_number=unit_nr2, file_name="parvar_mtd", file_status="OLD") + DO i = 1, nt + READ (unit_nr, *) dum, (ss0(i_map(id), i), id=1, ndim), (delta_s(id, i), id=1, ndim) + READ (unit_nr2, *) dum, dum, delta_s_glob, ww(i) + delta_s(1:ndim, i) = delta_s_glob*delta_s(1:ndim, i) + END DO + CALL close_file(unit_nr2) + END IF + CALL close_file(unit_nr) + + ! ORAC conversion factor + IF (l_orac) ww = ww*10000._dp/4.187_dp + + ! Setting up the limit of definitions for the several colvars + DO id = 1, ndim + x0(id) = HUGE(1.0_dp) + xf(id) = -HUGE(1.0_dp) + ENDDO + IF (fix) THEN + DO it = 1, nt + DO id = 1, ndim - ndw + x0(id) = MIN(x0(id), ss0(id, it) - 3.*delta_s(id, it)) + xf(id) = MAX(xf(id), ss0(id, it) + 3.*delta_s(id, it)) + ENDDO + ENDDO + it = 0 + DO id = ndim, ndim - ndw + 1, -1 + it = it + 1 + x0(id) = x0w(it) + xf(id) = xfw(it) + ENDDO + ELSE + DO it = 1, nt + DO id = ndim, 1, -1 + IF (iperd(id) == 1) THEN + x0(id) = -pi + xf(id) = pi + ELSE + x0(id) = MIN(x0(id), ss0(id, it) - 3.*delta_s(id, it)) + xf(id) = MAX(xf(id), ss0(id, it) + 3.*delta_s(id, it)) + END IF + ENDDO + ENDDO + ENDIF + + IF (l_dp) THEN + ALLOCATE (tmpr(ndim)) + tmpr = dp_grid + DO i = 1, ndim + dp_grid(i_map(i)) = tmpr(i) + END DO + DEALLOCATE (tmpr) + ngrid = INT((xf - x0)/dp_grid) + 1 + ELSE + dp_grid = (xf - x0)/REAL(ngrid - 1, KIND=dp) + END IF + + WRITE (iw, '(70("*"))') + WRITE (iw, '("FES|",T7,A,/)') "Parameters for FES:" + WRITE (iw, '("FES|",T7,A15,5x,i7)') "NDIM ::", ndim + WRITE (iw, '("FES|",T7,A15,5x,i7)') "NWD ::", ndw + WRITE (iw, '("FES|",T7,A15,5x,i7)') "HILLS ::", nt + it = 0 + DO i = ndim, 1, -1 + it = it + 1 + per_label = "" + active_label = "(NO MAPPED)" + IF (iperd(i) /= 0) per_label = "(PERIODIC)" + IF (it <= ndw) active_label = "( MAPPED)" + j = MINLOC((i_map - i)**2, 1) + WRITE (iw, '("FES|",T7,"COLVAR # ",i3," ::",5x,"(",f7.3," ,",f7.3,")",T48,A,T60,A)') & + j, x0(i), xf(i), TRIM(per_label), TRIM(active_label) + END DO + WRITE (iw, '("FES|",T7,a15,5x,7i7)') "NGRID ::", (ngrid(id), id=ndim, ndim - ndw + 1, -1) + WRITE (iw, '("FES|",T7,a15,5x,5f7.3)') "DX ::", (dp_grid(id), id=ndim, ndim - ndw + 1, -1) + WRITE (iw, '("FES|",T7,a15,5x,g10.5)') "CUTOFF ::", eps_cut + WRITE (iw, '(70("*"),/)') + + nn_max = 0 + DO i = 1, nt + dp_cut = SQRT(LOG(ABS(ww(i))/eps_cut))*2.0_dp*delta_s(:, i) + nn(:, i) = INT(dp_cut/dp_grid) + ww(i) = ww(i)**(1.0_dp/REAL(ndim, KIND=dp)) + END DO + + nn_max = MAXVAL(nn, DIM=2) + ngauss = MAXVAL(nn_max)*2 + 1 + nfes = PRODUCT(ngrid) + + ALLOCATE (gauss(-MAXVAL(nn_max):MAXVAL(nn_max), ndim)) + ALLOCATE (fes(nfes)) + fes = 0.0_dp + + nh = 1 + nf = MIN(nh + nt_p - 1, nt) + + IF (lstride) THEN + nwr = nt_p + ELSE + nwr = INT(nt/10) + 1 + END IF + + ncount = 0 + WRITE (iw, '(/,"FES|",T7,A)') "Computing Free Energy Surface" + + Stride: DO WHILE (nh <= nt) + Hills: DO it = nh, nf + ind = INT((ss0(:, it) - x0)/dp_grid) + 1 + gauss = 0.0_dp + + DO i = 1, ndim + coor = ind(i) - nn(i, it) - 1 + ss = x0(i) + coor*dp_grid(i) - dp_grid(i) + DO ip = -nn(i, it), nn(i, it) + coor = coor + 1 + ss = ss + dp_grid(i) + IF (iperd(i) == 0) THEN + IF (coor .GT. ngrid(i)) CYCLE + IF (coor .LT. 1) CYCLE + END IF + diff = ss - ss0(i, it) + dp2 = (diff/delta_s(i, it))**2 + gauss(ip, i) = ww(it)*EXP(-0.5_dp*dp2) + IF (sc > 0.0_dp .AND. p > 0.0_dp .AND. q > 0.0_dp .AND. q > p) THEN + gauss(ip, i) = gauss(ip, i)*(1 - (diff/sc*delta_s(i, it))**p)/(1 - (diff/sc*delta_s(i, it))**q) + END IF + END DO + END DO + inds = ind + CALL fes_compute_low(ndim, nn(:, it), fes, gauss, ind, inds, nfes, ndim, ngauss, ngrid, iperd) + + IF (.NOT. lstride .AND. MOD(it, nwr) == 0) THEN + WRITE (iw, '("FES|",T7,a,i4,a2)') "Mapping Gaussians ::", INT(10*ANINT(10.*it/nt)), " %" + ELSEIF (.NOT. lstride .AND. it == nt) THEN + WRITE (iw, '("FES|",T7,a,i4,a2)') "Mapping Gaussians ::", INT(10*ANINT(10.*it/nt)), " %" + END IF + END DO Hills + + IF (lstride) THEN + ncount = ncount + 1 + WRITE (iw, '("FES|",T7,a13,i5," |-| Gaussians from ",i6," to",i6)') "Done frame ::", ncount, nh, nf + IF (l_fes_int) THEN + out3 = out2//"." + ELSE + out3 = out1//"." + END IF + + IF (ncount < 10) THEN + WRITE (out3_stride, '(A,i1)') TRIM(out3), ncount + ELSEIF (ncount < 100) THEN + WRITE (out3_stride, '(A,i2)') TRIM(out3), ncount + ELSE + WRITE (out3_stride, '(A,i3)') TRIM(out3), ncount + END IF + CALL open_file(unit_number=unit_nr, file_name=out3_stride, file_action="WRITE", file_status="UNKNOWN", file_form="FORMATTED") + ind = 1 + CALL fes_only_write(ndim, fes, ind, ndim, ngrid, dp_grid, ndw, l_fes_int, unit_nr) + CALL close_file(unit_nr) + END IF + + nh = nh + nt_p + nf = MIN(nh + nt_p - 1, nt) + END DO Stride + DEALLOCATE (gauss) + + IF (l_fes_int) THEN + out3 = out2 + ELSE + out3 = out1 + END IF + + WRITE (iw, '("FES|",T7,A)') "Dumping FES structure in file: < "//TRIM(out3)//" >" + CALL open_file(unit_number=unit_nr, file_name=out3, file_action="WRITE", file_status="UNKNOWN", file_form="FORMATTED") + IF (l_cube) THEN + ind = 1 + CALL fes_cube_write(ndim, fes, ind, ndim, ngrid, dp_grid, x0, ndw, l_fes_int, file) + ELSE + ix = 0 + IF (l_math) WRITE (unit_nr, '(10g12.5)') (ngrid(id), id=ndim, ndim - ndw + 1, -1), ix + ind = 1 + CALL fes_write(unit_nr, ndim, fes, ind, ndim, ngrid, dp_grid, x0, ndw, l_fes_int) + END IF + CALL close_file(unit_nr) + + ! If requested find minima + IF (l_fmin) CALL fes_min(fes, ndim, iperd, ngrid, dp_grid, x0, ndw) + + ! If requested find or opt path + IF ((l_pmin) .AND. (l_popt)) CPABORT("USE EITHER -find-path OR -opt-path") + IF (l_pmin) l_int = .TRUE. + IF (l_popt) l_int = .FALSE. + + IF ((l_pmin) .OR. (l_popt)) CALL fes_path(fes, ndim, ngrid, dp_grid, iperd, x0, ndw, mep_input_data, l_int) + + ! Free memory + DEALLOCATE (ngrid) + DEALLOCATE (dp_grid) + DEALLOCATE (idw) + DEALLOCATE (iperd) + DEALLOCATE (x0) + DEALLOCATE (xf) + DEALLOCATE (ss0) + DEALLOCATE (delta_s) + DEALLOCATE (ww) + DEALLOCATE (ind) + DEALLOCATE (inds) + DEALLOCATE (nn) + DEALLOCATE (nn_max) + DEALLOCATE (dp_cut) + DEALLOCATE (i_map) + DEALLOCATE (fes) + DEALLOCATE (iprd) + DEALLOCATE (mep_input_data%minima) + + ! Terminate FES + WRITE (iw, '(/,A,/)') "FES| NORMAL FES TERMINATION." END PROGRAM graph diff --git a/src/metadyn_tools/graph_methods.F b/src/metadyn_tools/graph_methods.F index f73ba85852..0622704637 100644 --- a/src/metadyn_tools/graph_methods.F +++ b/src/metadyn_tools/graph_methods.F @@ -84,21 +84,21 @@ RECURSIVE SUBROUTINE fes_compute_low(idim, nn, fes, gauss, ind, ind0, nfes, ndim k = nn(idim) DO i = -k, k - pos(idim) = ind(idim)+i + pos(idim) = ind(idim) + i IF (iperd(idim) == 0) THEN IF (pos(idim) .GT. ngrid(idim)) CYCLE IF (pos(idim) .LT. 1) CYCLE END IF IF (idim /= 1) THEN - CALL fes_compute_low(idim-1, nn, fes, gauss, pos, ind0, nfes, ndim, ngauss, ngrid, iperd) + CALL fes_compute_low(idim - 1, nn, fes, gauss, pos, ind0, nfes, ndim, ngauss, ngrid, iperd) ELSE pnt = point_pbc(pos, iperd, ngrid, ndim) prod = 1.0_dp DO j = 1, ndim - ll(j) = pos(j)-ind0(j) + ll(j) = pos(j) - ind0(j) prod = prod*gauss(ll(j), j) END DO - fes(pnt) = fes(pnt)+prod + fes(pnt) = fes(pnt) + prod END IF END DO DEALLOCATE (pos, ll) @@ -143,48 +143,48 @@ RECURSIVE SUBROUTINE fes_write(unit_nr, idim, fes, pos, ndim, ngrid, & xx = x0 DO i = 1, ngrid(idim) pos(idim) = i - IF (idim /= ndim-ndw+1) THEN + IF (idim /= ndim - ndw + 1) THEN IF (PRESENT(array)) THEN - CALL fes_write(unit_nr, idim-1, fes, pos, ndim, ngrid, dp_grid, & + CALL fes_write(unit_nr, idim - 1, fes, pos, ndim, ngrid, dp_grid, & x0, ndw, l_fes_int, array) ELSE - CALL fes_write(unit_nr, idim-1, fes, pos, ndim, ngrid, dp_grid, & + CALL fes_write(unit_nr, idim - 1, fes, pos, ndim, ngrid, dp_grid, & x0, ndw, l_fes_int) END IF ELSE IF (PRESENT(array)) THEN ind = 1 - np = ngrid(ndim)*ngrid(ndim-1)*ngrid(ndim-2) + np = ngrid(ndim)*ngrid(ndim - 1)*ngrid(ndim - 2) DO is = 1, ndw itt = 1 - DO it = 1, is-1 - itt = itt*ngrid(ndim-it) + DO it = 1, is - 1 + itt = itt*ngrid(ndim - it) END DO - ind = ind+(pos(ndim-is+1)-1)*itt + ind = ind + (pos(ndim - is + 1) - 1)*itt END DO IF (ind > np) CPABORT("something wrong in indexing ..") END IF pnt = point_no_pbc(pos, ngrid, ndim) - xx = x0+dp_grid*(pos-1) - dimval = PRODUCT(ngrid(1:ndim-ndw)) + xx = x0 + dp_grid*(pos - 1) + dimval = PRODUCT(ngrid(1:ndim - ndw)) IF (.NOT. l_fes_int) THEN IF (PRESENT(array)) THEN - array(ind) = MINVAL(-fes(pnt:pnt+dimval-1)) + array(ind) = MINVAL(-fes(pnt:pnt + dimval - 1)) ELSE - WRITE (unit_nr, '(10f20.10)') (xx(id), id=ndim, ndim-ndw+1, -1), MINVAL(-fes(pnt:pnt+dimval-1)) + WRITE (unit_nr, '(10f20.10)') (xx(id), id=ndim, ndim - ndw + 1, -1), MINVAL(-fes(pnt:pnt + dimval - 1)) END IF ELSE sum_fes = 0.0_dp dvol = 1.0_dp - dvol = PRODUCT(dp_grid(1:ndim-ndw)) - DO is = pnt, pnt+dimval-1 - sum_fes = sum_fes+fes(is)*dvol + dvol = PRODUCT(dp_grid(1:ndim - ndw)) + DO is = pnt, pnt + dimval - 1 + sum_fes = sum_fes + fes(is)*dvol END DO IF (PRESENT(array)) THEN array(ind) = -sum_fes ELSE - WRITE (unit_nr, '(10f20.10)') (xx(id), id=ndim, ndim-ndw+1, -1), -sum_fes + WRITE (unit_nr, '(10f20.10)') (xx(id), id=ndim, ndim - ndw + 1, -1), -sum_fes END IF END IF END IF @@ -225,20 +225,20 @@ RECURSIVE SUBROUTINE fes_only_write(idim, fes, pos, ndim, ngrid, dp_grid, ndw, l DO i = 1, ngrid(idim) pos(idim) = i - IF (idim /= ndim-ndw+1) THEN - CALL fes_only_write(idim-1, fes, pos, ndim, ngrid, dp_grid, ndw, l_fes_int, unit_nr) + IF (idim /= ndim - ndw + 1) THEN + CALL fes_only_write(idim - 1, fes, pos, ndim, ngrid, dp_grid, ndw, l_fes_int, unit_nr) ELSE pnt = point_no_pbc(pos, ngrid, ndim) - dimval = PRODUCT(ngrid(1:ndim-ndw)) + dimval = PRODUCT(ngrid(1:ndim - ndw)) IF (l_fes_int) THEN - WRITE (unit_nr, '(1f12.5)') MINVAL(-fes(pnt:pnt+dimval-1)) + WRITE (unit_nr, '(1f12.5)') MINVAL(-fes(pnt:pnt + dimval - 1)) ELSE sum_fes = 0.0_dp - dvol = PRODUCT(dp_grid(1:ndim-ndw)) - DO is = pnt, pnt+dimval-1 - sum_fes = sum_fes+fes(is)*dvol + dvol = PRODUCT(dp_grid(1:ndim - ndw)) + DO is = pnt, pnt + dimval - 1 + sum_fes = sum_fes + fes(is)*dvol END DO - WRITE (unit_nr, '(1f12.5)')-sum_fes + WRITE (unit_nr, '(1f12.5)') - sum_fes END IF END IF END DO @@ -290,13 +290,13 @@ SUBROUTINE fes_min(fes, ndim, iperd, ngrid, dp_grid, x0, ndw) ! Loop over all points pnt = j DO k = ndim, 2, -1 - pos0(k) = pnt/PRODUCT(ngrid(1:k-1)) - resto = MOD(pnt, PRODUCT(ngrid(1:k-1))) + pos0(k) = pnt/PRODUCT(ngrid(1:k - 1)) + resto = MOD(pnt, PRODUCT(ngrid(1:k - 1))) IF (resto /= 0) THEN - pnt = pnt-pos0(k)*PRODUCT(ngrid(1:k-1)) - pos0(k) = pos0(k)+1 + pnt = pnt - pos0(k)*PRODUCT(ngrid(1:k - 1)) + pos0(k) = pos0(k) + 1 ELSE - pnt = PRODUCT(ngrid(1:k-1)) + pnt = PRODUCT(ngrid(1:k - 1)) END IF END DO pos0(1) = pnt @@ -304,12 +304,12 @@ SUBROUTINE fes_min(fes, ndim, iperd, ngrid, dp_grid, x0, ndw) ! Loop over the frame points unless it is periodic DO k = 1, ndim IF ((iperd(k) == 0) .AND. (pos0(k) < ntrust(k))) CYCLE Trials - IF ((iperd(k) == 0) .AND. (pos0(k) > ngrid(k)-ntrust(k))) CYCLE Trials + IF ((iperd(k) == 0) .AND. (pos0(k) > ngrid(k) - ntrust(k))) CYCLE Trials END DO ! Evaluate position and derivative pos = pos0 - xx = x0+dp_grid*(pos-1) + xx = x0 + dp_grid*(pos - 1) dx = derivative(fes, pos, iperd, ndim, ngrid, dp_grid) ! Integrate till derivative is small enough.. @@ -324,16 +324,16 @@ SUBROUTINE fes_min(fes, ndim, iperd, ngrid, dp_grid, x0, ndw) norm_dx = SQRT(DOT_PRODUCT(dx, dx)) IF (norm_dx == 0.0_dp) EXIT ! It is in a really flat region - xx = xx-MIN(0.1_dp, norm_dx)*dx/norm_dx + xx = xx - MIN(0.1_dp, norm_dx)*dx/norm_dx ! Re-evaluating pos - pos = CEILING((xx-x0)/dp_grid)+1 + pos = CEILING((xx - x0)/dp_grid) + 1 CALL pbc(pos, iperd, ngrid, ndim) ! Incremental pos dx = derivative(fes, pos, iperd, ndim, ngrid, dp_grid) pnt = point_no_pbc(pos, ngrid, ndim) fes_now = -fes(pnt) - i = i+1 + i = i + 1 END DO iter = i @@ -342,7 +342,7 @@ SUBROUTINE fes_min(fes, ndim, iperd, ngrid, dp_grid, x0, ndw) do_save = fes(pnt) >= 1.0E-3_dp IF (do_save) THEN DO i = 1, nacc - Dpos = pos-history(:, i) + Dpos = pos - history(:, i) norm_dx = DOT_PRODUCT(Dpos, Dpos) max_ntrust = MAXVAL(ntrust) ! (SQRT(REAL(norm_dx, KIND=dp)) <= MAXVAL(ntrust)) ... @@ -354,10 +354,10 @@ SUBROUTINE fes_min(fes, ndim, iperd, ngrid, dp_grid, x0, ndw) END IF IF (do_save) THEN pnt = point_no_pbc(pos, ngrid, ndim) - xx = x0+dp_grid*(pos-1) - WRITE (*, '(A,5F12.6)', ADVANCE="NO") "FES| Minimum found (", (xx(id), id=ndim, ndim-ndw+1, -1) + xx = x0 + dp_grid*(pos - 1) + WRITE (*, '(A,5F12.6)', ADVANCE="NO") "FES| Minimum found (", (xx(id), id=ndim, ndim - ndw + 1, -1) WRITE (*, '(A,F12.6,A,I6)') " ). FES value = ", -fes(pnt), " Hartree. Number of Iter: ", iter - nacc = nacc+1 + nacc = nacc + 1 history(:, nacc) = pos END IF END DO Trials @@ -412,16 +412,16 @@ SUBROUTINE fes_path(fes, ndim, ngrid, dp_grid, iperd, x0, ndw, mep_input_data, l IF (l_int) THEN id = 0 - DO i = ndim, ndim-ndw+1, -1 - id = id+1 + DO i = ndim, ndim - ndw + 1, -1 + id = id + 1 pos(i, 1) = mep_input_data%minima(id, 1) pos(i, nreplica) = mep_input_data%minima(id, 2) END DO ! Interpolate nreplica-2 points - xx = (pos(:, nreplica)-pos(:, 1))/REAL(nreplica-1, KIND=dp) - DO irep = 2, nreplica-1 - pos(:, irep) = pos(:, 1)+xx(:)*REAL(irep-1, KIND=dp) + xx = (pos(:, nreplica) - pos(:, 1))/REAL(nreplica - 1, KIND=dp) + DO irep = 2, nreplica - 1 + pos(:, irep) = pos(:, 1) + xx(:)*REAL(irep - 1, KIND=dp) END DO ELSE @@ -430,7 +430,7 @@ SUBROUTINE fes_path(fes, ndim, ngrid, dp_grid, iperd, x0, ndw, mep_input_data, l ! Compute value and derivative in all replicas DO irep = 1, nreplica - ipos = FLOOR((pos(:, irep)-x0)/dp_grid)+1 + ipos = FLOOR((pos(:, irep) - x0)/dp_grid) + 1 pnt = point_no_pbc(ipos, ngrid, ndim) dx(:, irep) = derivative(fes, ipos, iperd, ndim, ngrid, dp_grid) fes_rep(irep) = -fes(pnt) @@ -442,22 +442,22 @@ SUBROUTINE fes_path(fes, ndim, ngrid, dp_grid, iperd, x0, ndw, mep_input_data, l pos_old = pos iter = 0 DO WHILE ((.NOT. converged) .AND. (iter <= mep_input_data%max_iter)) - iter = iter+1 + iter = iter + 1 avg1 = 0.0_dp ! compute average length (distance 1) DO irep = 2, nreplica - xx = pos(:, irep)-pos(:, irep-1) - avg1 = avg1+SQRT(DOT_PRODUCT(xx, xx)) + xx = pos(:, irep) - pos(:, irep - 1) + avg1 = avg1 + SQRT(DOT_PRODUCT(xx, xx)) END DO - avg1 = avg1/REAL(nreplica-1, KIND=dp) + avg1 = avg1/REAL(nreplica - 1, KIND=dp) avg2 = 0.0_dp ! compute average length (distance 2) DO irep = 3, nreplica - xx = pos(:, irep)-pos(:, irep-2) - avg2 = avg2+SQRT(DOT_PRODUCT(xx, xx)) + xx = pos(:, irep) - pos(:, irep - 2) + avg2 = avg2 + SQRT(DOT_PRODUCT(xx, xx)) END DO - avg2 = avg2/REAL(nreplica-2, KIND=dp) + avg2 = avg2/REAL(nreplica - 2, KIND=dp) ! compute energy and derivatives dx = 0.0_dp @@ -466,7 +466,7 @@ SUBROUTINE fes_path(fes, ndim, ngrid, dp_grid, iperd, x0, ndw, mep_input_data, l nf = nreplica DO irep = 1, nreplica ! compute energy and map point replica irep - ipos = FLOOR((pos(:, irep)-x0)/dp_grid)+1 + ipos = FLOOR((pos(:, irep) - x0)/dp_grid) + 1 pnt = point_no_pbc(ipos, ngrid, ndim) fes_rep(irep) = -fes(pnt) IF ((irep == 1) .OR. (irep == nreplica)) CYCLE @@ -475,56 +475,56 @@ SUBROUTINE fes_path(fes, ndim, ngrid, dp_grid, iperd, x0, ndw, mep_input_data, l ! compute non-linear elastic terms : including only 2-d springs ! ------------------------------------------------------------- davg2 = 0.0_dp - IF (irep < nf-1) THEN - xx = pos(:, irep)-pos(:, irep+2) + IF (irep < nf - 1) THEN + xx = pos(:, irep) - pos(:, irep + 2) xx0 = SQRT(DOT_PRODUCT(xx, xx)) dxx = 1.0_dp/xx0*xx - ene = ene+0.25_dp*mep_input_data%kb*(xx0-avg2)**2 - davg2 = davg2+dxx + ene = ene + 0.25_dp*mep_input_data%kb*(xx0 - avg2)**2 + davg2 = davg2 + dxx END IF - IF (irep > ns+1) THEN - xx = pos(:, irep)-pos(:, irep-2) + IF (irep > ns + 1) THEN + xx = pos(:, irep) - pos(:, irep - 2) yy0 = SQRT(DOT_PRODUCT(xx, xx)) dyy = 1.0_dp/yy0*xx - davg2 = davg2+dyy + davg2 = davg2 + dyy END IF - davg2 = davg2/REAL(nreplica-2, KIND=dp) + davg2 = davg2/REAL(nreplica - 2, KIND=dp) - IF (irep < nf-1) THEN - dx(:, irep) = dx(:, irep)+0.5_dp*mep_input_data%kb*(xx0-avg2)*(dxx-davg2) + IF (irep < nf - 1) THEN + dx(:, irep) = dx(:, irep) + 0.5_dp*mep_input_data%kb*(xx0 - avg2)*(dxx - davg2) END IF - IF (irep > ns+1) THEN - dx(:, irep) = dx(:, irep)+0.5_dp*mep_input_data%kb*(yy0-avg2)*(dyy-davg2) + IF (irep > ns + 1) THEN + dx(:, irep) = dx(:, irep) + 0.5_dp*mep_input_data%kb*(yy0 - avg2)*(dyy - davg2) END IF ! ------------------------------------------------------------- ! Evaluation of the elastic term ! ------------------------------------------------------------- - xx = pos(:, irep)-pos(:, irep+1) + xx = pos(:, irep) - pos(:, irep + 1) yy0 = SQRT(DOT_PRODUCT(xx, xx)) dyy = 1.0_dp/yy0*xx - xx = pos(:, irep)-pos(:, irep-1) + xx = pos(:, irep) - pos(:, irep - 1) xx0 = SQRT(DOT_PRODUCT(xx, xx)) dxx = 1.0_dp/xx0*xx - davg1 = (dxx+dyy)/REAL(nreplica-1, KIND=dp) + davg1 = (dxx + dyy)/REAL(nreplica - 1, KIND=dp) - ene = ene+0.5_dp*mep_input_data%kb*(xx0-avg1)**2 - dx(:, irep) = dx(:, irep)+mep_input_data%kb*(xx0-avg1)*(dxx-davg1)+ & - mep_input_data%kb*(yy0-avg1)*(dyy-davg1) + ene = ene + 0.5_dp*mep_input_data%kb*(xx0 - avg1)**2 + dx(:, irep) = dx(:, irep) + mep_input_data%kb*(xx0 - avg1)*(dxx - davg1) + & + mep_input_data%kb*(yy0 - avg1)*(dyy - davg1) ! Evaluate the tangent - xx = pos(:, irep+1)-pos(:, irep) + xx = pos(:, irep + 1) - pos(:, irep) xx = xx/SQRT(DOT_PRODUCT(xx, xx)) - yy = pos(:, irep)-pos(:, irep-1) + yy = pos(:, irep) - pos(:, irep - 1) yy = yy/SQRT(DOT_PRODUCT(yy, yy)) - tang = xx+yy + tang = xx + yy tang = tang/SQRT(DOT_PRODUCT(tang, tang)) xx = derivative(fes, ipos, iperd, ndim, ngrid, dp_grid) - dx(:, irep) = DOT_PRODUCT(dx(:, irep), tang)*tang+ & - xx-DOT_PRODUCT(xx, tang)*tang + dx(:, irep) = DOT_PRODUCT(dx(:, irep), tang)*tang + & + xx - DOT_PRODUCT(xx, tang)*tang END DO dx(:, 1) = 0.0_dp dx(:, nreplica) = 0.0_dp @@ -532,15 +532,15 @@ SUBROUTINE fes_path(fes, ndim, ngrid, dp_grid, iperd, x0, ndw, mep_input_data, l ! propagate the band with a SD step diff = 0.0_dp DO irep = 1, nreplica - ene = ene+fes_rep(irep) + ene = ene + fes_rep(irep) IF ((irep == 1) .OR. (irep == nreplica)) CYCLE norm_dx = SQRT(DOT_PRODUCT(dx(:, irep), dx(:, irep))) IF (norm_dx /= 0.0_dp) THEN - pos(:, irep) = pos(:, irep)-MIN(0.1_dp, norm_dx)*dx(:, irep)/norm_dx + pos(:, irep) = pos(:, irep) - MIN(0.1_dp, norm_dx)*dx(:, irep)/norm_dx END IF - xx = pos(:, irep)-pos_old(:, irep) - diff = diff+DOT_PRODUCT(xx, xx) + xx = pos(:, irep) - pos_old(:, irep) + diff = diff + DOT_PRODUCT(xx, xx) END DO ! SQRT(diff) <= 0.001_dp IF (diff <= 1.0e-6_dp) THEN @@ -554,10 +554,10 @@ SUBROUTINE fes_path(fes, ndim, ngrid, dp_grid, iperd, x0, ndw, mep_input_data, l CALL open_file(unit_number=unit_nr, file_name="mep.data", file_action="WRITE", file_status="UNKNOWN", file_form="FORMATTED") DO irep = 1, nreplica ! compute energy and derivative for each single point of the replica - ipos = FLOOR((pos(:, irep)-x0)/dp_grid)+1 + ipos = FLOOR((pos(:, irep) - x0)/dp_grid) + 1 pnt = point_no_pbc(ipos, ngrid, ndim) fes_rep(irep) = -fes(pnt) - WRITE (unit_nr, *) irep, pos(:, nreplica-irep+1), fes_rep(nreplica-irep+1) + WRITE (unit_nr, *) irep, pos(:, nreplica - irep + 1), fes_rep(nreplica - irep + 1) END DO CALL close_file(unit_nr) @@ -624,8 +624,8 @@ SUBROUTINE fes_cube_write(idim, fes, pos, ndim, ngrid, dp_grid, x0, ndw, l_fes_i residual = 0.0d0 DO ix = 1, 3 - DO iy = ix+1, 3 - residual = residual+cell(ix, iy)**2 + DO iy = ix + 1, 3 + residual = residual + cell(ix, iy)**2 END DO END DO @@ -654,21 +654,21 @@ SUBROUTINE fes_cube_write(idim, fes, pos, ndim, ngrid, dp_grid, x0, ndw, l_fes_i DO ix = 1, 3 delta(ix) = rt(ix)/dr(ix) id(ix) = INT(delta(ix)) - delta(ix) = rt(ix)-id(ix)*dr(ix) + delta(ix) = rt(ix) - id(ix)*dr(ix) END DO DO iz = 1, ngrid(3) DO iy = 1, ngrid(2) DO ix = 1, ngrid(1) - iix = ix+id(1) - iiy = iy+id(2) - iiz = iz+id(3) - IF (iix .LT. 1) iix = iix+ngrid(1) - IF (iiy .LT. 1) iiy = iiy+ngrid(2) - IF (iiz .LT. 1) iiz = iiz+ngrid(3) - IF (iix .GT. ngrid(1)) iix = iix-ngrid(1) - IF (iiy .GT. ngrid(2)) iiy = iiy-ngrid(2) - IF (iiz .GT. ngrid(3)) iiz = iiz-ngrid(3) + iix = ix + id(1) + iiy = iy + id(2) + iiz = iz + id(3) + IF (iix .LT. 1) iix = iix + ngrid(1) + IF (iiy .LT. 1) iiy = iiy + ngrid(2) + IF (iiz .LT. 1) iiz = iiz + ngrid(3) + IF (iix .GT. ngrid(1)) iix = iix - ngrid(1) + IF (iiy .GT. ngrid(2)) iiy = iiy - ngrid(2) + IF (iiz .GT. ngrid(3)) iiz = iiz - ngrid(3) IF (iix .LT. 1) CPABORT("ix < 0") IF (iiy .LT. 1) CPABORT("iy < 0") @@ -676,8 +676,8 @@ SUBROUTINE fes_cube_write(idim, fes, pos, ndim, ngrid, dp_grid, x0, ndw, l_fes_i IF (iix .GT. ngrid(1)) CPABORT("ix > cell") IF (iiy .GT. ngrid(2)) CPABORT("iy > cell") IF (iiz .GT. ngrid(3)) CPABORT("iz > cell") - i = ix+(iy-1)*ngrid(1)+(iz-1)*ngrid(1)*ngrid(2) - ii = iix+(iiy-1)*ngrid(1)+(iiz-1)*ngrid(1)*ngrid(2) + i = ix + (iy - 1)*ngrid(1) + (iz - 1)*ngrid(1)*ngrid(2) + ii = iix + (iiy - 1)*ngrid(1) + (iiz - 1)*ngrid(1)*ngrid(2) rhot(ii) = rho(i) END DO END DO @@ -691,7 +691,7 @@ SUBROUTINE fes_cube_write(idim, fes, pos, ndim, ngrid, dp_grid, x0, ndw, l_fes_i DO WHILE (.TRUE.) READ (10, '(A)') line IF (INDEX(line, '&END') /= 0) EXIT - natoms = natoms+1 + natoms = natoms + 1 READ (line, *) label, (xat(natoms, ix), ix=1, 3) IF (natoms == SIZE(xat, 1)) THEN CALL reallocate(xat, 1, SIZE(xat, 1)*2, 1, 3) @@ -703,7 +703,7 @@ SUBROUTINE fes_cube_write(idim, fes, pos, ndim, ngrid, dp_grid, x0, ndw, l_fes_i CALL uppercase(labelp) IF (TRIM(label) == TRIM(labelp)) EXIT END DO - IF (i == nelem+1) THEN + IF (i == nelem + 1) THEN WRITE (*, *) TRIM(label), "In line: ", line CPABORT("Element not recognized!") END IF @@ -714,9 +714,9 @@ SUBROUTINE fes_cube_write(idim, fes, pos, ndim, ngrid, dp_grid, x0, ndw, l_fes_i DO i = 1, natoms DO ix = 1, 3 - xat(i, ix) = xat(i, ix)+rt(ix)-delta(ix) - IF (xat(i, ix) .LT. rt(ix)) xat(i, ix) = xat(i, ix)+cell(ix, ix) - IF (xat(i, ix) .GT. -rt(ix)) xat(i, ix) = xat(i, ix)-cell(ix, ix) + xat(i, ix) = xat(i, ix) + rt(ix) - delta(ix) + IF (xat(i, ix) .LT. rt(ix)) xat(i, ix) = xat(i, ix) + cell(ix, ix) + IF (xat(i, ix) .GT. -rt(ix)) xat(i, ix) = xat(i, ix) - cell(ix, ix) END DO END DO @@ -736,7 +736,7 @@ SUBROUTINE fes_cube_write(idim, fes, pos, ndim, ngrid, dp_grid, x0, ndw, l_fes_i DO ix = 1, ngrid(1) DO iy = 1, ngrid(2) - WRITE (123, '(6e13.5)') (rhot(ix+(iy-1)*ngrid(1)+(iz-1)*ngrid(1)& + WRITE (123, '(6e13.5)') (rhot(ix + (iy - 1)*ngrid(1) + (iz - 1)*ngrid(1)& &*ngrid(2)), iz=1, ngrid(3)) END DO END DO diff --git a/src/metadyn_tools/graph_utils.F b/src/metadyn_tools/graph_utils.F index 0afeb8dda2..98d080ddf1 100644 --- a/src/metadyn_tools/graph_utils.F +++ b/src/metadyn_tools/graph_utils.F @@ -9,7 +9,7 @@ !> \author Teodoro Laino [tlaino] - 06.2009 !> \par History !> 06.2009 created [tlaino] -!> teodoro.laino .at. gmail.com +!> teodoro.laino .at. gmail.com !> !> \par Note !> Please report any bug to the author @@ -18,22 +18,22 @@ MODULE graph_utils USE kinds, ONLY: dp #include "../base/base_uses.f90" - IMPLICIT NONE - PRIVATE + IMPLICIT NONE + PRIVATE - TYPE mep_input_data_type - REAL(KIND=dp), DIMENSION(:,:), POINTER :: minima - INTEGER :: max_iter - INTEGER :: nreplica - REAL(KIND=dp) :: kb - END TYPE mep_input_data_type + TYPE mep_input_data_type + REAL(KIND=dp), DIMENSION(:, :), POINTER :: minima + INTEGER :: max_iter + INTEGER :: nreplica + REAL(KIND=dp) :: kb + END TYPE mep_input_data_type - PUBLIC :: get_val_res,& - mep_input_data_type,& - point_pbc,& - point_no_pbc,& - derivative,& - pbc + PUBLIC :: get_val_res, & + mep_input_data_type, & + point_pbc, & + point_no_pbc, & + derivative, & + pbc CONTAINS @@ -48,10 +48,10 @@ MODULE graph_utils !> \return ... !> \par History !> 06.2009 created [tlaino] -!> teodoro.laino .at. gmail.com +!> teodoro.laino .at. gmail.com !> \author Teodoro Laino ! ************************************************************************************************** - FUNCTION derivative(fes, pos0, iperd, ndim, ngrid, dp_grid) RESULT(der) + FUNCTION derivative(fes, pos0, iperd, ndim, ngrid, dp_grid) RESULT(der) REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: fes INTEGER, DIMENSION(:), INTENT(IN) :: pos0, iperd INTEGER, INTENT(IN) :: ndim @@ -62,21 +62,21 @@ FUNCTION derivative(fes, pos0, iperd, ndim, ngrid, dp_grid) RESULT(der) INTEGER :: i, j, pnt INTEGER, ALLOCATABLE, DIMENSION(:) :: pos - ALLOCATE(pos(ndim)) - pos(:) = pos0 - DO i = 1, ndim - der(i) = 0.0_dp - DO j = 1,-1,-2 - pos(i) = pos0(i) + j - pnt = point_pbc(pos,iperd,ngrid,ndim) - der(i) = der(i) + REAL(j,KIND=dp)*(-fes(pnt)) - END DO - pos(i) = pos0(i) - der(i) = der(i) / (2.0_dp*dp_grid(i)) - END DO - DEALLOCATE(pos) - - END FUNCTION derivative + ALLOCATE (pos(ndim)) + pos(:) = pos0 + DO i = 1, ndim + der(i) = 0.0_dp + DO j = 1, -1, -2 + pos(i) = pos0(i) + j + pnt = point_pbc(pos, iperd, ngrid, ndim) + der(i) = der(i) + REAL(j, KIND=dp)*(-fes(pnt)) + END DO + pos(i) = pos0(i) + der(i) = der(i)/(2.0_dp*dp_grid(i)) + END DO + DEALLOCATE (pos) + + END FUNCTION derivative ! ************************************************************************************************** !> \brief Computes the pointer to the 1D array given the n-dimensional position @@ -88,36 +88,36 @@ END FUNCTION derivative !> \return ... !> \par History !> 03.2006 created [tlaino] -!> teodoro.laino .at. gmail.com +!> teodoro.laino .at. gmail.com !> \author Teodoro Laino ! ************************************************************************************************** - FUNCTION point_pbc (pos,iperd,ngrid,ndim) RESULT(pnt) + FUNCTION point_pbc(pos, iperd, ngrid, ndim) RESULT(pnt) INTEGER, DIMENSION(:), INTENT(IN) :: pos, iperd, ngrid INTEGER, INTENT(IN) :: ndim INTEGER :: pnt INTEGER :: idim, lpnt - idim=1 - pnt=pos(idim) - IF (iperd(idim) == 1) THEN - lpnt = pos(idim) - lpnt = 1000*ngrid(idim)+lpnt - lpnt = MOD(lpnt,ngrid(idim)) - IF (lpnt==0) lpnt=ngrid(idim) - pnt = lpnt - END IF - DO idim=2,ndim - lpnt = pos(idim) - IF (iperd(idim) == 1) THEN - lpnt = 1000*ngrid(idim)+lpnt - lpnt = MOD(lpnt,ngrid(idim)) - IF (lpnt==0) lpnt=ngrid(idim) - END IF - pnt=pnt+(lpnt-1) * PRODUCT(ngrid(1:idim-1)) - END DO - - END FUNCTION point_pbc + idim = 1 + pnt = pos(idim) + IF (iperd(idim) == 1) THEN + lpnt = pos(idim) + lpnt = 1000*ngrid(idim) + lpnt + lpnt = MOD(lpnt, ngrid(idim)) + IF (lpnt == 0) lpnt = ngrid(idim) + pnt = lpnt + END IF + DO idim = 2, ndim + lpnt = pos(idim) + IF (iperd(idim) == 1) THEN + lpnt = 1000*ngrid(idim) + lpnt + lpnt = MOD(lpnt, ngrid(idim)) + IF (lpnt == 0) lpnt = ngrid(idim) + END IF + pnt = pnt + (lpnt - 1)*PRODUCT(ngrid(1:idim - 1)) + END DO + + END FUNCTION point_pbc ! ************************************************************************************************** !> \brief Computes the pointer to the 1D array given the n-dimensional position @@ -128,26 +128,26 @@ END FUNCTION point_pbc !> \param ndim ... !> \par History !> 03.2006 created [tlaino] -!> teodoro.laino .at. gmail.com +!> teodoro.laino .at. gmail.com !> \author Teodoro Laino ! ************************************************************************************************** - SUBROUTINE pbc (pos,iperd,ngrid,ndim) + SUBROUTINE pbc(pos, iperd, ngrid, ndim) INTEGER, DIMENSION(:), INTENT(INOUT) :: pos INTEGER, DIMENSION(:), INTENT(IN) :: iperd, ngrid INTEGER, INTENT(IN) :: ndim INTEGER :: idim, lpnt - DO idim=1,ndim - IF (iperd(idim) == 1) THEN - lpnt = pos(idim) - lpnt = 1000*ngrid(idim)+lpnt - lpnt = MOD(lpnt,ngrid(idim)) - IF (lpnt==0) lpnt=ngrid(idim) - pos(idim) = lpnt - END IF - END DO - END SUBROUTINE pbc + DO idim = 1, ndim + IF (iperd(idim) == 1) THEN + lpnt = pos(idim) + lpnt = 1000*ngrid(idim) + lpnt + lpnt = MOD(lpnt, ngrid(idim)) + IF (lpnt == 0) lpnt = ngrid(idim) + pos(idim) = lpnt + END IF + END DO + END SUBROUTINE pbc ! ************************************************************************************************** !> \brief Computes the pointer to the 1D array given the n-dimensional position @@ -158,22 +158,22 @@ END SUBROUTINE pbc !> \return ... !> \par History !> 03.2006 created [tlaino] -!> teodoro.laino .at. gmail.com +!> teodoro.laino .at. gmail.com !> \author Teodoro Laino ! ************************************************************************************************** - FUNCTION point_no_pbc (pos, ngrid, ndim) RESULT(pnt) + FUNCTION point_no_pbc(pos, ngrid, ndim) RESULT(pnt) INTEGER, DIMENSION(:), INTENT(IN) :: pos, ngrid INTEGER, INTENT(IN) :: ndim INTEGER :: pnt INTEGER :: i - pnt=pos(1) - DO i=2,ndim - pnt=pnt+(pos(i)-1) * PRODUCT(ngrid(1:i-1)) - END DO + pnt = pos(1) + DO i = 2, ndim + pnt = pnt + (pos(i) - 1)*PRODUCT(ngrid(1:i - 1)) + END DO - END FUNCTION point_no_pbc + END FUNCTION point_no_pbc ! ************************************************************************************************** !> \brief Parser informations from the cp2k input/restart @@ -185,10 +185,10 @@ END FUNCTION point_no_pbc !> \param r_val ... !> \par History !> 03.2006 created [tlaino] -!> teodoro.laino .at. gmail.com +!> teodoro.laino .at. gmail.com !> \author Teodoro Laino ! ************************************************************************************************** - SUBROUTINE get_val_res(unit, section, keyword, subsection, i_val, r_val) + SUBROUTINE get_val_res(unit, section, keyword, subsection, i_val, r_val) INTEGER, INTENT(IN) :: unit CHARACTER(len=*) :: section CHARACTER(len=*), OPTIONAL :: keyword, subsection @@ -198,35 +198,35 @@ SUBROUTINE get_val_res(unit, section, keyword, subsection, i_val, r_val) CHARACTER(len=512) :: line INTEGER :: my_ind, stat - REWIND(unit) - CALL search(unit,TRIM(section),line,stat=stat) - - IF (stat/=0) THEN - WRITE(*,*)"Pattern: "//TRIM(section)//" not found in input file!" - CPABORT("Search failed!") - END IF - - IF (PRESENT(keyword)) THEN - CALL search(unit,TRIM(keyword),line,stat) - IF (stat/=0) THEN - ! if the keyword is not found, let's give back values that will trigger a problem.. - IF (PRESENT(i_val)) i_val=-HUGE(1) - IF (PRESENT(r_val)) r_val=-HUGE(0.0_dp) - ELSE - ! Otherwise read the value - my_ind=INDEX(line,TRIM(keyword))+LEN_TRIM(keyword)+1 - IF (PRESENT(i_val)) READ(line(my_ind:),*)i_val - IF (PRESENT(r_val)) READ(line(my_ind:),*)r_val - END IF - END IF - - IF (PRESENT(subsection)) THEN - CALL search(unit,TRIM(subsection),line,stat) - END IF - - END SUBROUTINE get_val_res - - ! ************************************************************************************************** + REWIND (unit) + CALL search(unit, TRIM(section), line, stat=stat) + + IF (stat /= 0) THEN + WRITE (*, *) "Pattern: "//TRIM(section)//" not found in input file!" + CPABORT("Search failed!") + END IF + + IF (PRESENT(keyword)) THEN + CALL search(unit, TRIM(keyword), line, stat) + IF (stat /= 0) THEN + ! if the keyword is not found, let's give back values that will trigger a problem.. + IF (PRESENT(i_val)) i_val = -HUGE(1) + IF (PRESENT(r_val)) r_val = -HUGE(0.0_dp) + ELSE + ! Otherwise read the value + my_ind = INDEX(line, TRIM(keyword)) + LEN_TRIM(keyword) + 1 + IF (PRESENT(i_val)) READ (line(my_ind:), *) i_val + IF (PRESENT(r_val)) READ (line(my_ind:), *) r_val + END IF + END IF + + IF (PRESENT(subsection)) THEN + CALL search(unit, TRIM(subsection), line, stat) + END IF + + END SUBROUTINE get_val_res + + ! ************************************************************************************************** ! ************************************************************************************************** !> \brief ... !> \param unit ... @@ -234,21 +234,21 @@ END SUBROUTINE get_val_res !> \param line ... !> \param stat ... ! ************************************************************************************************** - SUBROUTINE search(unit, key, line, stat) + SUBROUTINE search(unit, key, line, stat) INTEGER, INTENT(in) :: unit CHARACTER(LEN=*), INTENT(IN) :: key CHARACTER(LEN=512), INTENT(OUT) :: line INTEGER, INTENT(out) :: stat - stat = 99 - DO WHILE (.TRUE.) - READ(unit,'(A)',ERR=100,END=100) line - IF (INDEX(line,TRIM(key)) /= 0) THEN - stat = 0 - EXIT - END IF - END DO -100 CONTINUE - END SUBROUTINE search + stat = 99 + DO WHILE (.TRUE.) + READ (unit, '(A)', ERR=100, END=100) line + IF (INDEX(line, TRIM(key)) /= 0) THEN + stat = 0 + EXIT + END IF + END DO +100 CONTINUE + END SUBROUTINE search END MODULE graph_utils diff --git a/src/metadynamics.F b/src/metadynamics.F index 7f8b0a413c..1ebb327c68 100644 --- a/src/metadynamics.F +++ b/src/metadynamics.F @@ -15,55 +15,55 @@ MODULE metadynamics #if defined (__PLUMED2) USE ISO_C_BINDING, ONLY: C_INT, C_DOUBLE, C_CHAR USE cell_types, ONLY: cell_type, & - pbc_cp2k_plumed_getset_cell + pbc_cp2k_plumed_getset_cell #else USE cell_types, ONLY: cell_type #endif USE colvar_methods, ONLY: colvar_eval_glob_f USE colvar_types, ONLY: colvar_p_type, & - torsion_colvar_id + torsion_colvar_id USE constraint_fxd, ONLY: fix_atom_control USE cp_output_handling, ONLY: cp_add_iter_level, & - cp_iterate, & - cp_print_key_finished_output, & - cp_print_key_unit_nr, & - cp_rm_iter_level + cp_iterate, & + cp_print_key_finished_output, & + cp_print_key_unit_nr, & + cp_rm_iter_level USE cp_subsys_types, ONLY: cp_subsys_get, & - cp_subsys_type + cp_subsys_type USE force_env_types, ONLY: force_env_get, & - force_env_type + force_env_type USE input_constants, ONLY: do_wall_m, & - do_wall_p, & - do_wall_reflective + do_wall_p, & + do_wall_reflective USE input_section_types, ONLY: section_vals_get, & - section_vals_get_subs_vals, & - section_vals_type, & - section_vals_val_get + section_vals_get_subs_vals, & + section_vals_type, & + section_vals_val_get USE kinds, ONLY: dp USE message_passing, ONLY: mp_bcast, cp2k_is_parallel USE metadynamics_types, ONLY: hills_env_type, & - meta_env_type, & - metavar_type, & - multiple_walkers_type + meta_env_type, & + metavar_type, & + multiple_walkers_type USE metadynamics_utils, ONLY: add_hill_single, & - get_meta_iter_level, & - meta_walls, & - restart_hills, & - synchronize_multiple_walkers + get_meta_iter_level, & + meta_walls, & + restart_hills, & + synchronize_multiple_walkers USE parallel_rng_types, ONLY: next_random_number USE particle_list_types, ONLY: particle_list_type #if defined (__PLUMED2) USE physcon, ONLY: angstrom, & - boltzmann, & - femtoseconds, & - joule, & - kelvin, kjmol, & - picoseconds + boltzmann, & + femtoseconds, & + joule, & + kelvin, kjmol, & + picoseconds #else USE physcon, ONLY: boltzmann, & - femtoseconds, & - joule, & - kelvin + femtoseconds, & + joule, & + kelvin #endif USE reference_manager, ONLY: cite_reference USE simpar_types, ONLY: simpar_type @@ -314,9 +314,9 @@ SUBROUTINE metadyn_integrator(force_env, itimes, vel, rand) CALL plumed_gcmd_int("performCalc"//CHAR(0), 0) DO i_part = 1, natom_plumed - subsys%particles%els(i_part)%f(1) = subsys%particles%els(i_part)%f(1)+force_plumed_x(i_part) - subsys%particles%els(i_part)%f(2) = subsys%particles%els(i_part)%f(2)+force_plumed_y(i_part) - subsys%particles%els(i_part)%f(3) = subsys%particles%els(i_part)%f(3)+force_plumed_z(i_part) + subsys%particles%els(i_part)%f(1) = subsys%particles%els(i_part)%f(1) + force_plumed_x(i_part) + subsys%particles%els(i_part)%f(2) = subsys%particles%els(i_part)%f(2) + force_plumed_y(i_part) + subsys%particles%els(i_part)%f(3) = subsys%particles%els(i_part)%f(3) + force_plumed_z(i_part) END DO DEALLOCATE (pos_plumed_x, pos_plumed_y, pos_plumed_z) @@ -394,7 +394,7 @@ SUBROUTINE metadyn_forces(force_env, vel) CALL force_env_get(force_env, subsys=subsys) dt = meta_env%dt - IF (.NOT. meta_env%restart) meta_env%n_steps = meta_env%n_steps+1 + IF (.NOT. meta_env%restart) meta_env%n_steps = meta_env%n_steps + 1 ! Initialize velocity IF (meta_env%restart .AND. meta_env%extended_lagrange) THEN @@ -402,7 +402,7 @@ SUBROUTINE metadyn_forces(force_env, vel) DO i_c = 1, meta_env%n_colvar cv => meta_env%metavar(i_c) cv%vvp = next_random_number(force_env%globenv%gaussian_rng_stream) - meta_env%ekin_s = meta_env%ekin_s+0.5_dp*cv%mass*cv%vvp**2 + meta_env%ekin_s = meta_env%ekin_s + 0.5_dp*cv%mass*cv%vvp**2 END DO ekin_w = 0.5_dp*meta_env%temp_wanted*REAL(meta_env%n_colvar, KIND=dp) fac_t = SQRT(ekin_w/MAX(meta_env%ekin_s, 1.0E-8_dp)) @@ -465,15 +465,15 @@ SUBROUTINE metadyn_forces(force_env, vel) cv => meta_env%metavar(i_c) cv%epot_s = 0.0_dp cv%ff_s = 0.0_dp - meta_env%epot_walls = meta_env%epot_walls+cv%epot_walls + meta_env%epot_walls = meta_env%epot_walls + cv%epot_walls icolvar = cv%icolvar NULLIFY (particles) CALL cp_subsys_get(subsys, colvar_p=colvar_p, & particles=particles) DO ii = 1, colvar_p(icolvar)%colvar%n_atom_s i = colvar_p(icolvar)%colvar%i_atom(ii) - fft = cv%ff_hills+cv%ff_walls - particles%els(i)%f = particles%els(i)%f+fft*colvar_p(icolvar)%colvar%dsdr(:, ii) + fft = cv%ff_hills + cv%ff_walls + particles%els(i)%f = particles%els(i)%f + fft*colvar_p(icolvar)%colvar%dsdr(:, ii) ENDDO ENDDO ELSE @@ -482,7 +482,7 @@ SUBROUTINE metadyn_forces(force_env, vel) meta_env%epot_walls = 0.0_dp DO i_c = 1, meta_env%n_colvar cv => meta_env%metavar(i_c) - diff_ss = cv%ss-cv%ss0 + diff_ss = cv%ss - cv%ss0 IF (cv%periodic) THEN ! The difference of a periodic COLVAR is always within [-pi,pi] diff_ss = SIGN(1.0_dp, ASIN(SIN(diff_ss)))*ACOS(COS(diff_ss)) @@ -496,22 +496,22 @@ SUBROUTINE metadyn_forces(force_env, vel) particles=particles) DO ii = 1, colvar_p(icolvar)%colvar%n_atom_s i = colvar_p(icolvar)%colvar%i_atom(ii) - particles%els(i)%f = particles%els(i)%f-cv%ff_s*colvar_p(icolvar)%colvar%dsdr(:, ii) + particles%els(i)%f = particles%els(i)%f - cv%ff_s*colvar_p(icolvar)%colvar%dsdr(:, ii) ENDDO ! velocity verlet on the s0 if NOT langevin IF (.NOT. meta_env%langevin) THEN - fft = cv%ff_s+cv%ff_hills+cv%ff_walls - cv%vvp = cv%vvp+dt*fft/cv%mass - meta_env%ekin_s = meta_env%ekin_s+0.5_dp*cv%mass*cv%vvp**2 - meta_env%epot_s = meta_env%epot_s+cv%epot_s - meta_env%epot_walls = meta_env%epot_walls+cv%epot_walls + fft = cv%ff_s + cv%ff_hills + cv%ff_walls + cv%vvp = cv%vvp + dt*fft/cv%mass + meta_env%ekin_s = meta_env%ekin_s + 0.5_dp*cv%mass*cv%vvp**2 + meta_env%epot_s = meta_env%epot_s + cv%epot_s + meta_env%epot_walls = meta_env%epot_walls + cv%epot_walls END IF ENDDO ! velocity rescaling on the s0 IF (meta_env%tempcontrol .AND. (.NOT. meta_env%langevin)) THEN ekin_w = 0.5_dp*meta_env%temp_wanted*REAL(meta_env%n_colvar, KIND=dp) tol_ekin = 0.5_dp*meta_env%toll_temp*REAL(meta_env%n_colvar, KIND=dp) - IF (ABS(ekin_w-meta_env%ekin_s) > tol_ekin) THEN + IF (ABS(ekin_w - meta_env%ekin_s) > tol_ekin) THEN fac_t = SQRT(ekin_w/MAX(meta_env%ekin_s, 1.0E-8_dp)) DO i_c = 1, meta_env%n_colvar cv => meta_env%metavar(i_c) @@ -525,14 +525,14 @@ SUBROUTINE metadyn_forces(force_env, vel) cv => meta_env%metavar(i_c) IF (cv%do_wall) THEN DO iwall = 1, SIZE(cv%walls) - SELECT CASE (cv%walls (iwall)%id_type) + SELECT CASE (cv%walls(iwall)%id_type) CASE (do_wall_reflective) - ss0_test = cv%ss0+dt*cv%vvp + ss0_test = cv%ss0 + dt*cv%vvp IF (cv%periodic) THEN ! A periodic COLVAR is always within [-pi,pi] ss0_test = SIGN(1.0_dp, ASIN(SIN(ss0_test)))*ACOS(COS(ss0_test)) END IF - SELECT CASE (cv%walls (iwall)%id_direction) + SELECT CASE (cv%walls(iwall)%id_direction) CASE (do_wall_p) IF ((ss0_test > cv%walls(iwall)%pos) .AND. (cv%vvp > 0)) cv%vvp = -cv%vvp CASE (do_wall_m) @@ -546,7 +546,7 @@ SUBROUTINE metadyn_forces(force_env, vel) IF (.NOT. meta_env%langevin) THEN DO i_c = 1, meta_env%n_colvar cv => meta_env%metavar(i_c) - cv%ss0 = cv%ss0+dt*cv%vvp + cv%ss0 = cv%ss0 + dt*cv%vvp IF (cv%periodic) THEN ! A periodic COLVAR is always within [-pi,pi] cv%ss0 = SIGN(1.0_dp, ASIN(SIN(cv%ss0)))*ACOS(COS(cv%ss0)) @@ -562,9 +562,9 @@ SUBROUTINE metadyn_forces(force_env, vel) cv => meta_env%metavar(i_c) IF (cv%do_wall) THEN DO iwall = 1, SIZE(cv%walls) - SELECT CASE (cv%walls (iwall)%id_type) + SELECT CASE (cv%walls(iwall)%id_type) CASE (do_wall_reflective) - SELECT CASE (cv%walls (iwall)%id_direction) + SELECT CASE (cv%walls(iwall)%id_direction) CASE (do_wall_p) IF (cv%ss < cv%walls(iwall)%pos) CYCLE check_val = -1.0_dp @@ -581,20 +581,20 @@ SUBROUTINE metadyn_forces(force_env, vel) DO ii = 1, colvar_p(icolvar)%colvar%n_atom_s i = colvar_p(icolvar)%colvar%i_atom(ii) IF (PRESENT(vel)) THEN - scal = scal+vel(1, i)*colvar_p(icolvar)%colvar%dsdr(1, ii) - scal = scal+vel(2, i)*colvar_p(icolvar)%colvar%dsdr(2, ii) - scal = scal+vel(3, i)*colvar_p(icolvar)%colvar%dsdr(3, ii) + scal = scal + vel(1, i)*colvar_p(icolvar)%colvar%dsdr(1, ii) + scal = scal + vel(2, i)*colvar_p(icolvar)%colvar%dsdr(2, ii) + scal = scal + vel(3, i)*colvar_p(icolvar)%colvar%dsdr(3, ii) ELSE - scal = scal+particles%els(i)%v(1)*colvar_p(icolvar)%colvar%dsdr(1, ii) - scal = scal+particles%els(i)%v(2)*colvar_p(icolvar)%colvar%dsdr(2, ii) - scal = scal+particles%els(i)%v(3)*colvar_p(icolvar)%colvar%dsdr(3, ii) + scal = scal + particles%els(i)%v(1)*colvar_p(icolvar)%colvar%dsdr(1, ii) + scal = scal + particles%els(i)%v(2)*colvar_p(icolvar)%colvar%dsdr(2, ii) + scal = scal + particles%els(i)%v(3)*colvar_p(icolvar)%colvar%dsdr(3, ii) END IF - scalf = scalf+particles%els(i)%f(1)*colvar_p(icolvar)%colvar%dsdr(1, ii) - scalf = scalf+particles%els(i)%f(2)*colvar_p(icolvar)%colvar%dsdr(2, ii) - scalf = scalf+particles%els(i)%f(3)*colvar_p(icolvar)%colvar%dsdr(3, ii) - norm = norm+colvar_p(icolvar)%colvar%dsdr(1, ii)**2 - norm = norm+colvar_p(icolvar)%colvar%dsdr(2, ii)**2 - norm = norm+colvar_p(icolvar)%colvar%dsdr(3, ii)**2 + scalf = scalf + particles%els(i)%f(1)*colvar_p(icolvar)%colvar%dsdr(1, ii) + scalf = scalf + particles%els(i)%f(2)*colvar_p(icolvar)%colvar%dsdr(2, ii) + scalf = scalf + particles%els(i)%f(3)*colvar_p(icolvar)%colvar%dsdr(3, ii) + norm = norm + colvar_p(icolvar)%colvar%dsdr(1, ii)**2 + norm = norm + colvar_p(icolvar)%colvar%dsdr(2, ii)**2 + norm = norm + colvar_p(icolvar)%colvar%dsdr(3, ii)**2 ENDDO IF (norm /= 0.0_dp) scal = scal/norm IF (norm /= 0.0_dp) scalf = scalf/norm @@ -603,12 +603,12 @@ SUBROUTINE metadyn_forces(force_env, vel) DO ii = 1, colvar_p(icolvar)%colvar%n_atom_s i = colvar_p(icolvar)%colvar%i_atom(ii) IF (PRESENT(vel)) THEN - vel(:, i) = vel(:, i)-2.0_dp*colvar_p(icolvar)%colvar%dsdr(:, ii)*scal + vel(:, i) = vel(:, i) - 2.0_dp*colvar_p(icolvar)%colvar%dsdr(:, ii)*scal ELSE - particles%els(i)%v(:) = particles%els(i)%v(:)-2.0_dp*colvar_p(icolvar)%colvar%dsdr(:, ii)*scal + particles%els(i)%v(:) = particles%els(i)%v(:) - 2.0_dp*colvar_p(icolvar)%colvar%dsdr(:, ii)*scal END IF ! Nullify forces along the colvar (this avoids the weird behaviors of the reflective wall) - particles%els(i)%f(:) = particles%els(i)%f(:)-colvar_p(icolvar)%colvar%dsdr(:, ii)*scalf + particles%els(i)%f(:) = particles%els(i)%f(:) - colvar_p(icolvar)%colvar%dsdr(:, ii)*scalf ENDDO END SELECT END DO @@ -658,7 +658,7 @@ SUBROUTINE metadyn_velocities_colvar(force_env, rand) meta_env%epot_walls = 0.0_dp DO i_c = 1, meta_env%n_colvar cv => meta_env%metavar(i_c) - diff_ss = cv%ss-cv%ss0 + diff_ss = cv%ss - cv%ss0 IF (cv%periodic) THEN ! The difference of a periodic COLVAR is always within [-pi,pi] diff_ss = SIGN(1.0_dp, ASIN(SIN(diff_ss)))*ACOS(COS(diff_ss)) @@ -666,12 +666,12 @@ SUBROUTINE metadyn_velocities_colvar(force_env, rand) cv%epot_s = 0.5_dp*cv%lambda*(diff_ss)**2.0_dp cv%ff_s = cv%lambda*(diff_ss) - fft = cv%ff_s+cv%ff_hills + fft = cv%ff_s + cv%ff_hills sigma = SQRT((meta_env%temp_wanted*kelvin)*2.0_dp*(boltzmann/joule)*cv%gamma/cv%mass) - cv%vvp = cv%vvp+0.5_dp*dt*fft/cv%mass-0.5_dp*dt*cv%gamma*cv%vvp+ & + cv%vvp = cv%vvp + 0.5_dp*dt*fft/cv%mass - 0.5_dp*dt*cv%gamma*cv%vvp + & 0.5_dp*SQRT(dt)*sigma*rand(i_c) - meta_env%ekin_s = meta_env%ekin_s+0.5_dp*cv%mass*cv%vvp**2 - meta_env%epot_walls = meta_env%epot_walls+cv%epot_walls + meta_env%ekin_s = meta_env%ekin_s + 0.5_dp*cv%mass*cv%vvp**2 + meta_env%epot_walls = meta_env%epot_walls + cv%epot_walls ENDDO CALL timestop(handle) @@ -710,7 +710,7 @@ SUBROUTINE metadyn_position_colvar(force_env) ! Update of ss0 DO i_c = 1, meta_env%n_colvar cv => meta_env%metavar(i_c) - cv%ss0 = cv%ss0+dt*cv%vvp + cv%ss0 = cv%ss0 + dt*cv%vvp IF (cv%periodic) THEN ! A periodic COLVAR is always within [-pi,pi] cv%ss0 = SIGN(1.0_dp, ASIN(SIN(cv%ss0)))*ACOS(COS(cv%ss0)) @@ -756,7 +756,7 @@ SUBROUTINE metadyn_write_colvar(force_env) meta_env%epot_s = 0.0_dp DO i_c = 1, meta_env%n_colvar cv => meta_env%metavar(i_c) - diff_ss = cv%ss-cv%ss0 + diff_ss = cv%ss - cv%ss0 IF (cv%periodic) THEN ! The difference of a periodic COLVAR is always within [-pi,pi] diff_ss = SIGN(1.0_dp, ASIN(SIN(diff_ss)))*ACOS(COS(diff_ss)) @@ -764,8 +764,8 @@ SUBROUTINE metadyn_write_colvar(force_env) cv%epot_s = 0.5_dp*cv%lambda*(diff_ss)**2.0_dp cv%ff_s = cv%lambda*(diff_ss) - meta_env%epot_s = meta_env%epot_s+cv%epot_s - meta_env%ekin_s = meta_env%ekin_s+0.5_dp*cv%mass*cv%vvp**2 + meta_env%epot_s = meta_env%epot_s + cv%epot_s + meta_env%ekin_s = meta_env%ekin_s + 0.5_dp*cv%mass*cv%vvp**2 ENDDO END IF @@ -800,8 +800,8 @@ SUBROUTINE metadyn_write_colvar(force_env) ! Temperature for COLVAR IF (meta_env%extended_lagrange) THEN temp = meta_env%ekin_s*2.0_dp/(REAL(meta_env%n_colvar, KIND=dp))*kelvin - meta_env%avg_temp = (meta_env%avg_temp*REAL(meta_env%n_steps, KIND=dp)+ & - temp)/REAL(meta_env%n_steps+1, KIND=dp) + meta_env%avg_temp = (meta_env%avg_temp*REAL(meta_env%n_steps, KIND=dp) + & + temp)/REAL(meta_env%n_steps + 1, KIND=dp) iw = cp_print_key_unit_nr(logger, meta_env%metadyn_section, & "PRINT%TEMPERATURE_COLVAR", extension=".metadynLog") IF (iw > 0) THEN @@ -873,7 +873,7 @@ SUBROUTINE hills(meta_env) END IF ! Proceed with normal calculation - intermeta_steps = n_step-hills_env%old_hill_step + intermeta_steps = n_step - hills_env%old_hill_step force_gauss = .FALSE. IF ((hills_env%min_disp > 0.0_dp) .AND. (hills_env%old_hill_number > 0) .AND. & (intermeta_steps >= hills_env%min_nt_hills)) THEN @@ -885,12 +885,12 @@ SUBROUTINE hills(meta_env) !RG Calculate the displacement dp2 = 0.0_dp DO i = 1, n_colvar - ddp(i) = colvars(i)%ss0-local_last_hills(i) + ddp(i) = colvars(i)%ss0 - local_last_hills(i) IF (colvars(i)%periodic) THEN ! The difference of a periodic COLVAR is always within [-pi,pi] ddp(i) = SIGN(1.0_dp, ASIN(SIN(ddp(i))))*ACOS(COS(ddp(i))) END IF - dp2 = dp2+ddp(i)**2 + dp2 = dp2 + ddp(i)**2 ENDDO dp2 = SQRT(dp2) IF (dp2 > hills_env%min_disp) THEN @@ -922,25 +922,25 @@ SUBROUTINE hills(meta_env) DO ih = 1, hills_env%n_hills dp2 = 0._dp DO i = 1, n_colvar - diff = colvars(i)%ss0-hills_env%ss_history(i, ih) + diff = colvars(i)%ss0 - hills_env%ss_history(i, ih) IF (colvars(i)%periodic) THEN ! The difference of a periodic COLVAR is always within [-pi,pi] diff = SIGN(1.0_dp, ASIN(SIN(diff)))*ACOS(COS(diff)) END IF diff = (diff)/hills_env%delta_s_history(i, ih) - dp2 = dp2+diff**2 + dp2 = dp2 + diff**2 ENDDO - V_to_fes = 1.0_dp+meta_env%wttemperature*hills_env%invdt_history(ih) - V_now_here = V_now_here+hills_env%ww_history(ih)/V_to_fes*EXP(-0.5_dp*dp2) + V_to_fes = 1.0_dp + meta_env%wttemperature*hills_env%invdt_history(ih) + V_now_here = V_now_here + hills_env%ww_history(ih)/V_to_fes*EXP(-0.5_dp*dp2) ENDDO wtww = hills_env%ww*EXP(-V_now_here*meta_env%invdt) - ww = wtww*(1.0_dp+meta_env%wttemperature*meta_env%invdt) + ww = wtww*(1.0_dp + meta_env%wttemperature*meta_env%invdt) CALL add_hill_single(hills_env, colvars, ww, hills_env%n_hills, n_colvar, meta_env%invdt) ELSE CALL add_hill_single(hills_env, colvars, hills_env%ww, hills_env%n_hills, n_colvar) END IF ! Update local n_hills counter - IF (meta_env%do_multiple_walkers) multiple_walkers%n_hills_local = multiple_walkers%n_hills_local+1 + IF (meta_env%do_multiple_walkers) multiple_walkers%n_hills_local = multiple_walkers%n_hills_local + 1 hills_env%old_hill_number = hills_env%n_hills hills_env%old_hill_step = n_step @@ -988,7 +988,7 @@ SUBROUTINE hills(meta_env) iw = cp_print_key_unit_nr(logger, meta_env%metadyn_section, & "PRINT%HILLS", extension=".metadynLog") IF (iw > 0) THEN - DO i_hills = n_hills_start+1, hills_env%n_hills + DO i_hills = n_hills_start + 1, hills_env%n_hills WRITE (iw, '(f12.1,30f13.5)') meta_env%time*femtoseconds, & (hills_env%ss_history(ih, i_hills), ih=1, n_colvar), & (hills_env%delta_s_history(ih, i_hills), ih=1, n_colvar), & @@ -1012,12 +1012,12 @@ SUBROUTINE hills(meta_env) DO ih = 1, hills_env%n_hills slow_growth = 1.0_dp IF (hills_env%slow_growth .AND. (ih == hills_env%n_hills)) THEN - slow_growth = REAL(n_step-hills_env%old_hill_step, dp)/REAL(hills_env%nt_hills, dp) + slow_growth = REAL(n_step - hills_env%old_hill_step, dp)/REAL(hills_env%nt_hills, dp) END IF dp2 = 0._dp cut_func = 1.0_dp DO i = 1, n_colvar - diff_ss(i) = colvars(i)%ss0-hills_env%ss_history(i, ih) + diff_ss(i) = colvars(i)%ss0 - hills_env%ss_history(i, ih) IF (colvars(i)%periodic) THEN ! The difference of a periodic COLVAR is always within [-pi,pi] diff_ss(i) = SIGN(1.0_dp, ASIN(SIN(diff_ss(i))))*ACOS(COS(diff_ss(i))) @@ -1031,27 +1031,27 @@ SUBROUTINE hills(meta_env) ELSE ddp(i) = (diff_ss(i))/hills_env%delta_s_history(i, ih) END IF - dp2 = dp2+ddp(i)**2 + dp2 = dp2 + ddp(i)**2 IF (hills_env%tail_cutoff > 0.0_dp) THEN frac = ABS(ddp(i))/hills_env%tail_cutoff numf(i) = frac**hills_env%p_exp denf(i) = frac**hills_env%q_exp - cut_func = cut_func*(1.0_dp-numf(i))/(1.0_dp-denf(i)) + cut_func = cut_func*(1.0_dp - numf(i))/(1.0_dp - denf(i)) ENDIF ENDDO ! ff_hills contains the "force" due to the hills dfunc = hills_env%ww_history(ih)*EXP(-0.5_dp*dp2)*slow_growth - IF (meta_env%well_tempered) dfunc = dfunc/(1.0_dp+meta_env%wttemperature*hills_env%invdt_history(ih)) - hills_env%energy = hills_env%energy+dfunc*cut_func + IF (meta_env%well_tempered) dfunc = dfunc/(1.0_dp + meta_env%wttemperature*hills_env%invdt_history(ih)) + hills_env%energy = hills_env%energy + dfunc*cut_func DO i = 1, n_colvar IF (hills_env%delta_s_history(i, ih) /= 0.0_dp) THEN ! only apply a force when the Gaussian hill has a finite width in ! this direction - colvars(i)%ff_hills = colvars(i)%ff_hills+ & + colvars(i)%ff_hills = colvars(i)%ff_hills + & ddp(i)/hills_env%delta_s_history(i, ih)*dfunc*cut_func IF (hills_env%tail_cutoff > 0.0_dp .AND. ABS(diff_ss(i)) > 10.E-5_dp) THEN - colvars(i)%ff_hills = colvars(i)%ff_hills+ & - (hills_env%p_exp*numf(i)/(1.0_dp-numf(i))-hills_env%q_exp*denf(i)/(1.0_dp-denf(i)))* & + colvars(i)%ff_hills = colvars(i)%ff_hills + & + (hills_env%p_exp*numf(i)/(1.0_dp - numf(i)) - hills_env%q_exp*denf(i)/(1.0_dp - denf(i)))* & dfunc*cut_func/ABS(diff_ss(i)) END IF END IF diff --git a/src/metadynamics_types.F b/src/metadynamics_types.F index 7ad2f62b82..2993415df8 100644 --- a/src/metadynamics_types.F +++ b/src/metadynamics_types.F @@ -168,7 +168,7 @@ SUBROUTINE metadyn_create(meta_env, n_colvar, dt, para_env, metadyn_section) meta_env%metadyn_section => metadyn_section meta_env%ref_count = 1 meta_env%restart = .TRUE. - last_meta_env_id = last_meta_env_id+1 + last_meta_env_id = last_meta_env_id + 1 meta_env%id_nr = last_meta_env_id meta_env%n_colvar = n_colvar meta_env%para_env => para_env @@ -266,7 +266,7 @@ SUBROUTINE meta_env_retain(meta_env) CPASSERT(ASSOCIATED(meta_env)) CPASSERT(meta_env%ref_count > 0) - meta_env%ref_count = meta_env%ref_count+1 + meta_env%ref_count = meta_env%ref_count + 1 END SUBROUTINE meta_env_retain ! ************************************************************************************************** @@ -284,7 +284,7 @@ SUBROUTINE meta_env_release(meta_env) IF (ASSOCIATED(meta_env)) THEN CPASSERT(meta_env%ref_count > 0) - meta_env%ref_count = meta_env%ref_count-1 + meta_env%ref_count = meta_env%ref_count - 1 IF (meta_env%ref_count == 0) THEN CALL cp_para_env_release(meta_env%para_env) IF (ASSOCIATED(meta_env%metavar)) THEN diff --git a/src/metadynamics_utils.F b/src/metadynamics_utils.F index f284e9365e..1c68391846 100644 --- a/src/metadynamics_utils.F +++ b/src/metadynamics_utils.F @@ -379,7 +379,7 @@ SUBROUTINE print_metadyn_info(meta_env, n_colvar, metadyn_section) WRITE (iw, '(/,A,5X,I10,T50,A,T70,A11)') ' METAVARS| Wall Number:', j, 'Type of Wall:', & ADJUSTR(TRIM(enum_i2c(enum, meta_env%metavar(i)%walls(j)%id_type))) ! Type of wall IO - SELECT CASE (meta_env%metavar (i)%walls (j)%id_type) + SELECT CASE (meta_env%metavar(i)%walls(j)%id_type) CASE (do_wall_none) ! Do Nothing CYCLE @@ -453,7 +453,7 @@ SUBROUTINE metavar_read(metavar, extended_lagrange, langevin, icol, metavar_sect DO i = 1, n_walls CALL section_vals_val_get(wall_section, "TYPE", i_rep_section=i, i_val=metavar%walls(i)%id_type) CALL section_vals_val_get(wall_section, "POSITION", i_rep_section=i, r_val=metavar%walls(i)%pos) - SELECT CASE (metavar%walls (i)%id_type) + SELECT CASE (metavar%walls(i)%id_type) CASE (do_wall_none) ! Just cycle.. CYCLE @@ -468,11 +468,11 @@ SUBROUTINE metavar_read(metavar, extended_lagrange, langevin, icol, metavar_sect work_section => section_vals_get_subs_vals(wall_section, "QUARTIC", i_rep_section=i) CALL section_vals_val_get(work_section, "DIRECTION", i_val=metavar%walls(i)%id_direction) CALL section_vals_val_get(work_section, "K", r_val=metavar%walls(i)%k_quartic) - SELECT CASE (metavar%walls (i)%id_direction) + SELECT CASE (metavar%walls(i)%id_direction) CASE (do_wall_m) - metavar%walls(i)%pos0 = metavar%walls(i)%pos+(0.05_dp/metavar%walls(i)%k_quartic**(0.25_dp)) + metavar%walls(i)%pos0 = metavar%walls(i)%pos + (0.05_dp/metavar%walls(i)%k_quartic**(0.25_dp)) CASE (do_wall_p) - metavar%walls(i)%pos0 = metavar%walls(i)%pos-(0.05_dp/metavar%walls(i)%k_quartic**(0.25_dp)) + metavar%walls(i)%pos0 = metavar%walls(i)%pos - (0.05_dp/metavar%walls(i)%k_quartic**(0.25_dp)) END SELECT CASE (do_wall_gaussian) work_section => section_vals_get_subs_vals(wall_section, "GAUSSIAN", i_rep_section=i) @@ -568,7 +568,7 @@ SUBROUTINE synchronize_multiple_walkers(multiple_walkers, hills_env, colvars, & CYCLE END IF - i_hills = multiple_walkers%walkers_status(i)+1 + i_hills = multiple_walkers%walkers_status(i) + 1 filename = TRIM(multiple_walkers%walkers_file_name(i))//"_"// & TRIM(ADJUSTL(cp_to_string(i_hills))) @@ -607,7 +607,7 @@ SUBROUTINE synchronize_multiple_walkers(multiple_walkers, hills_env, colvars, & CALL add_hill_single(hills_env, colvars, ww, hills_env%n_hills, n_colvar) END IF - i_hills = i_hills+1 + i_hills = i_hills + 1 filename = TRIM(multiple_walkers%walkers_file_name(i))//"_"// & TRIM(ADJUSTL(cp_to_string(i_hills))) IF (para_env%ionode) THEN @@ -616,8 +616,8 @@ SUBROUTINE synchronize_multiple_walkers(multiple_walkers, hills_env, colvars, & CALL mp_bcast(exist, para_env%source, para_env%group) END DO - delta_hills = i_hills-1-multiple_walkers%walkers_status(i) - multiple_walkers%walkers_status(i) = i_hills-1 + delta_hills = i_hills - 1 - multiple_walkers%walkers_status(i) + multiple_walkers%walkers_status(i) = i_hills - 1 iw = cp_print_key_unit_nr(logger, metadyn_section, "PRINT%PROGRAM_RUN_INFO", & extension=".metadynLog") IF (iw > 0) THEN @@ -671,41 +671,41 @@ SUBROUTINE add_hill_single(hills_env, colvars, ww, n_hills, n_colvar, invdt) wtcontrol = PRESENT(invdt) NULLIFY (tmp, tnp) - IF (SIZE(hills_env%ss_history, 2) < n_hills+1) THEN - ALLOCATE (tmp(n_colvar, n_hills+100)) + IF (SIZE(hills_env%ss_history, 2) < n_hills + 1) THEN + ALLOCATE (tmp(n_colvar, n_hills + 100)) tmp(:, :n_hills) = hills_env%ss_history - tmp(:, n_hills+1:) = 0.0_dp + tmp(:, n_hills + 1:) = 0.0_dp DEALLOCATE (hills_env%ss_history) hills_env%ss_history => tmp NULLIFY (tmp) ENDIF - IF (SIZE(hills_env%delta_s_history, 2) < n_hills+1) THEN - ALLOCATE (tmp(n_colvar, n_hills+100)) + IF (SIZE(hills_env%delta_s_history, 2) < n_hills + 1) THEN + ALLOCATE (tmp(n_colvar, n_hills + 100)) tmp(:, :n_hills) = hills_env%delta_s_history - tmp(:, n_hills+1:) = 0.0_dp + tmp(:, n_hills + 1:) = 0.0_dp DEALLOCATE (hills_env%delta_s_history) hills_env%delta_s_history => tmp NULLIFY (tmp) ENDIF - IF (SIZE(hills_env%ww_history) < n_hills+1) THEN - ALLOCATE (tnp(n_hills+100)) + IF (SIZE(hills_env%ww_history) < n_hills + 1) THEN + ALLOCATE (tnp(n_hills + 100)) tnp(1:n_hills) = hills_env%ww_history - tnp(n_hills+1:) = 0.0_dp + tnp(n_hills + 1:) = 0.0_dp DEALLOCATE (hills_env%ww_history) hills_env%ww_history => tnp NULLIFY (tnp) ENDIF IF (wtcontrol) THEN - IF (SIZE(hills_env%invdt_history) < n_hills+1) THEN - ALLOCATE (tnp(n_hills+100)) + IF (SIZE(hills_env%invdt_history) < n_hills + 1) THEN + ALLOCATE (tnp(n_hills + 100)) tnp(1:n_hills) = hills_env%invdt_history - tnp(n_hills+1:) = 0.0_dp + tnp(n_hills + 1:) = 0.0_dp DEALLOCATE (hills_env%invdt_history) hills_env%invdt_history => tnp NULLIFY (tnp) ENDIF ENDIF - n_hills = n_hills+1 + n_hills = n_hills + 1 ! Now add the hill DO i = 1, n_colvar hills_env%ss_history(i, n_hills) = colvars(i)%ss0 @@ -901,52 +901,52 @@ SUBROUTINE meta_walls(meta_env) colvars(ih)%epot_walls = 0.0_dp colvars(ih)%ff_walls = 0.0_dp DO iwall = 1, SIZE(colvars(ih)%walls) - SELECT CASE (colvars (ih)%walls (iwall)%id_type) + SELECT CASE (colvars(ih)%walls(iwall)%id_type) CASE (do_wall_reflective, do_wall_none) ! Do Nothing.. treated in the main metadyn function CYCLE CASE (do_wall_quadratic) - diff_ss = colvars(ih)%ss0-colvars(ih)%walls(iwall)%pos + diff_ss = colvars(ih)%ss0 - colvars(ih)%walls(iwall)%pos IF (colvars(ih)%periodic) THEN ! The difference of a periodic COLVAR is always within [-pi,pi] diff_ss = SIGN(1.0_dp, ASIN(SIN(diff_ss)))*ACOS(COS(diff_ss)) END IF efunc = colvars(ih)%walls(iwall)%k_quadratic*diff_ss**2 dfunc = 2.0_dp*colvars(ih)%walls(iwall)%k_quadratic*diff_ss - SELECT CASE (colvars (ih)%walls (iwall)%id_direction) + SELECT CASE (colvars(ih)%walls(iwall)%id_direction) CASE (do_wall_p) IF (diff_ss > 0.0_dp) THEN - colvars(ih)%ff_walls = colvars(ih)%ff_walls-dfunc - colvars(ih)%epot_walls = colvars(ih)%epot_walls+efunc + colvars(ih)%ff_walls = colvars(ih)%ff_walls - dfunc + colvars(ih)%epot_walls = colvars(ih)%epot_walls + efunc END IF CASE (do_wall_m) IF (diff_ss < 0.0_dp) THEN - colvars(ih)%ff_walls = colvars(ih)%ff_walls-dfunc - colvars(ih)%epot_walls = colvars(ih)%epot_walls+efunc + colvars(ih)%ff_walls = colvars(ih)%ff_walls - dfunc + colvars(ih)%epot_walls = colvars(ih)%epot_walls + efunc END IF END SELECT CASE (do_wall_quartic) - diff_ss = colvars(ih)%ss0-colvars(ih)%walls(iwall)%pos0 + diff_ss = colvars(ih)%ss0 - colvars(ih)%walls(iwall)%pos0 IF (colvars(ih)%periodic) THEN ! The difference of a periodic COLVAR is always within [-pi,pi] diff_ss = SIGN(1.0_dp, ASIN(SIN(diff_ss)))*ACOS(COS(diff_ss)) END IF efunc = colvars(ih)%walls(iwall)%k_quartic*diff_ss*diff_ss**4 dfunc = 4.0_dp*colvars(ih)%walls(iwall)%k_quartic*diff_ss**3 - SELECT CASE (colvars (ih)%walls (iwall)%id_direction) + SELECT CASE (colvars(ih)%walls(iwall)%id_direction) CASE (do_wall_p) IF (diff_ss > 0.0_dp) THEN - colvars(ih)%ff_walls = colvars(ih)%ff_walls-dfunc - colvars(ih)%epot_walls = colvars(ih)%epot_walls+efunc + colvars(ih)%ff_walls = colvars(ih)%ff_walls - dfunc + colvars(ih)%epot_walls = colvars(ih)%epot_walls + efunc END IF CASE (do_wall_m) IF (diff_ss < 0.0_dp) THEN - colvars(ih)%ff_walls = colvars(ih)%ff_walls-dfunc - colvars(ih)%epot_walls = colvars(ih)%epot_walls+efunc + colvars(ih)%ff_walls = colvars(ih)%ff_walls - dfunc + colvars(ih)%epot_walls = colvars(ih)%epot_walls + efunc END IF END SELECT CASE (do_wall_gaussian) - diff_ss = colvars(ih)%ss0-colvars(ih)%walls(iwall)%pos + diff_ss = colvars(ih)%ss0 - colvars(ih)%walls(iwall)%pos IF (colvars(ih)%periodic) THEN ! The difference of a periodic COLVAR is always within [-pi,pi] diff_ss = SIGN(1.0_dp, ASIN(SIN(diff_ss)))*ACOS(COS(diff_ss)) @@ -957,8 +957,8 @@ SUBROUTINE meta_walls(meta_env) dp2 = ddp**2 efunc = ww*EXP(-0.5_dp*dp2) dfunc = -efunc*ddp/delta_s - colvars(ih)%ff_walls = colvars(ih)%ff_walls-dfunc - colvars(ih)%epot_walls = colvars(ih)%epot_walls+efunc + colvars(ih)%ff_walls = colvars(ih)%ff_walls - dfunc + colvars(ih)%epot_walls = colvars(ih)%epot_walls + efunc END SELECT END DO END IF diff --git a/src/minbas_methods.F b/src/minbas_methods.F index 13db0bc9a1..357c87c916 100644 --- a/src/minbas_methods.F +++ b/src/minbas_methods.F @@ -231,7 +231,7 @@ SUBROUTINE minbas_calculation(qs_env, mos, quambo, mao, iounit, full_ortho, eps_ IF (unit_nr > 0) THEN WRITE (unit_nr, '(T2,A,T51,A,i2,T71,I10)') 'MOs in Occupied Valence Set', 'Spin ', ispin, homo END IF - nvirt = nmo-homo + nvirt = nmo - homo NULLIFY (fm_struct_c) CALL cp_fm_struct_create(fm_struct_c, nrow_global=nvirt, ncol_global=nvirt, & para_env=para_env, context=blacs_env) @@ -239,12 +239,12 @@ SUBROUTINE minbas_calculation(qs_env, mos, quambo, mao, iounit, full_ortho, eps_ CALL cp_fm_create(fm4, fm_struct_c) ! B(vw) = a(vj)* * a(wj)* CALL cp_gemm("N", "T", nvirt, nvirt, nmao, 1.0_dp, fm2, fm2, 0.0_dp, fm3, & - a_first_row=homo+1, b_first_row=homo+1) + a_first_row=homo + 1, b_first_row=homo + 1) ALLOCATE (eigval(nvirt)) CALL choose_eigv_solver(fm3, fm4, eigval) ! SVD(B) -> select p largest eigenvalues and vectors - np = nmao-homo - np1 = nvirt-np+1 + np = nmao - homo + np1 = nvirt - np + 1 IF (unit_nr > 0) THEN WRITE (unit_nr, '(T2,A,T51,A,i2,T71,I10)') 'MOs in Virtual Valence Set', 'Spin ', ispin, np END IF @@ -263,18 +263,18 @@ SUBROUTINE minbas_calculation(qs_env, mos, quambo, mao, iounit, full_ortho, eps_ CALL cp_fm_create(fm6, fm_struct_e) ! D(j) = SUM_n (a(nj)*)^2 + SUM_vw R(vw) * a(vj)* * a(wj)* CALL cp_gemm("N", "N", nvirt, nmao, nvirt, 1.0_dp, fm3, fm2, 0.0_dp, fm5, & - b_first_row=homo+1) + b_first_row=homo + 1) CALL cp_gemm("T", "N", nmao, nmao, nvirt, 1.0_dp, fm2, fm5, 0.0_dp, fm6, & - a_first_row=homo+1) + a_first_row=homo + 1) CALL cp_fm_get_diag(fm6, dvalv(1:nmao)) CALL cp_gemm("T", "N", nmao, nmao, homo, 1.0_dp, fm2, fm2, 0.0_dp, fm6) CALL cp_fm_get_diag(fm6, dvalo(1:nmao)) DO i = 1, nmao - dval(i) = 1.0_dp/SQRT(dvalo(i)+dvalv(i)) + dval(i) = 1.0_dp/SQRT(dvalo(i) + dvalv(i)) END DO ! scale intermediate expansion CALL cp_fm_to_fm_submat(fm2, fma, homo, nmao, 1, 1, 1, 1) - CALL cp_fm_to_fm_submat(fm5, fma, nvirt, nmao, 1, 1, homo+1, 1) + CALL cp_fm_to_fm_submat(fm5, fma, nvirt, nmao, 1, 1, homo + 1, 1) CALL cp_fm_column_scale(fma, dval) ! Orthogonalization CALL cp_fm_create(fmwork, fm_struct_e) diff --git a/src/minbas_wfn_analysis.F b/src/minbas_wfn_analysis.F index a8f492a6d4..2f25fc94b0 100644 --- a/src/minbas_wfn_analysis.F +++ b/src/minbas_wfn_analysis.F @@ -294,7 +294,7 @@ SUBROUTINE minbas_analysis(qs_env, input_section, unit_nr) DO i = 1, natom, 2 IF (i < natom) THEN WRITE (unit_nr, '(T2,A,I8,T20,A,F10.6,T42,A,I8,T60,A,F10.6)') & - " Atom:", i, "Projection:", prmao(i, ispin), " Atom:", i+1, "Projection:", prmao(i+1, ispin) + " Atom:", i, "Projection:", prmao(i, ispin), " Atom:", i + 1, "Projection:", prmao(i + 1, ispin) ELSE WRITE (unit_nr, '(T2,A,I8,T20,A,F10.6)') " Atom:", i, "Projection:", prmao(i, ispin) END IF @@ -309,7 +309,7 @@ SUBROUTINE minbas_analysis(qs_env, input_section, unit_nr) WRITE (unit_nr, '(T64,A)') 'Occupied Orbitals' WRITE (unit_nr, '(8F10.6)') fnorm(1:homo, ispin) WRITE (unit_nr, '(T65,A)') 'Virtual Orbitals' - WRITE (unit_nr, '(8F10.6)') fnorm(homo+1:nmo, ispin) + WRITE (unit_nr, '(8F10.6)') fnorm(homo + 1:nmo, ispin) END IF END DO ! Mulliken population @@ -428,11 +428,11 @@ SUBROUTINE pm_extend(quambo, smao, ecount) n = SIZE(qblock, 2) wij = ABS(SUM(qblock*sblock))/REAL(n, KIND=dp) IF (wij > 0.1_dp) THEN - ecount(jatom, 1) = ecount(jatom, 1)+1 + ecount(jatom, 1) = ecount(jatom, 1) + 1 ELSEIF (wij > 0.01_dp) THEN - ecount(jatom, 2) = ecount(jatom, 2)+1 + ecount(jatom, 2) = ecount(jatom, 2) + 1 ELSEIF (wij > 0.001_dp) THEN - ecount(jatom, 3) = ecount(jatom, 3)+1 + ecount(jatom, 3) = ecount(jatom, 3) + 1 END IF END IF END DO @@ -469,7 +469,7 @@ SUBROUTINE project_mao(mao, smao, sovl, prmao) n = SIZE(qblock, 2) DO i = 1, n wi = SUM(qblock(:, i)*sblock(:, i)) - prmao(iatom) = prmao(iatom)+wi/so(i, i) + prmao(iatom) = prmao(iatom) + wi/so(i, i) END DO END IF END DO @@ -528,7 +528,7 @@ SUBROUTINE post_minbas_cubes(qs_env, print_section, minbas_coeff, ispin) CALL get_particle_set(particle_set, qs_kind_set, nmao=blk_sizes) first_bas(0) = 0 DO i = 1, natom - first_bas(i) = first_bas(i-1)+blk_sizes(i) + first_bas(i) = first_bas(i - 1) + blk_sizes(i) END DO CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool) @@ -539,7 +539,7 @@ SUBROUTINE post_minbas_cubes(qs_env, print_section, minbas_coeff, ispin) CALL section_vals_val_get(minbas_section, "ATOM_LIST", n_rep_val=n_rep) IF (n_rep == 0) THEN DO i = 1, natom - DO ivec = first_bas(i-1)+1, first_bas(i) + DO ivec = first_bas(i - 1) + 1, first_bas(i) WRITE (filename, '(a4,I5.5,a1,I1.1)') "MINBAS_", ivec, "_", ispin WRITE (title, *) "MINIMAL BASIS ", ivec, " atom ", i, " spin ", ispin mpi_io = .TRUE. @@ -557,7 +557,7 @@ SUBROUTINE post_minbas_cubes(qs_env, print_section, minbas_coeff, ispin) CALL section_vals_val_get(minbas_section, "ATOM_LIST", i_rep_val=i_rep, i_vals=ilist) DO i = 1, SIZE(ilist, 1) j = ilist(i) - DO ivec = first_bas(j-1)+1, first_bas(j) + DO ivec = first_bas(j - 1) + 1, first_bas(j) WRITE (filename, '(a4,I5.5,a1,I1.1)') "MINBAS_", ivec, "_", ispin WRITE (title, *) "MINIMAL BASIS ", ivec, " atom ", j, " spin ", ispin mpi_io = .TRUE. diff --git a/src/minimax/minimax_exp.F b/src/minimax/minimax_exp.F index 368300f4a9..4e9e2e0b69 100644 --- a/src/minimax/minimax_exp.F +++ b/src/minimax/minimax_exp.F @@ -194,24 +194,24 @@ SUBROUTINE get_best_minimax_approx_k53(k, Rc, i_mm, ge_Rc) ! find k pointer and smallest and largest R_mm value for this k i_k = 1 DO WHILE (k_mm(k_p(i_k)) .LT. k) - i_k = i_k+1 + i_k = i_k + 1 ENDDO CPASSERT(k_mm(k_p(i_k)) .EQ. k) R_k_min = R_mm(k_p(i_k)) - R_k_max = R_mm(k_p(i_k+1)-1) + R_k_max = R_mm(k_p(i_k + 1) - 1) IF (Rc .GE. R_k_max) THEN - i_mm = k_p(i_k+1)-1 ! pointer to largest Rc for current k + i_mm = k_p(i_k + 1) - 1 ! pointer to largest Rc for current k ELSE IF (Rc .LE. R_k_min) THEN i_mm = k_p(i_k) ! pointer to smallest Rc for current k ELSE i = k_p(i_k) DO WHILE (Rc .GT. R_mm(i)) - i = i+1 + i = i + 1 ENDDO i_r = i ! pointer to closest R_mm >= Rc - i_l = i-1 ! pointer to closest R_mm < Rc + i_l = i - 1 ! pointer to closest R_mm < Rc IF (PRESENT(ge_Rc)) THEN IF (ge_Rc) THEN @@ -272,8 +272,8 @@ SUBROUTINE validate_exp_minimax(n_R, iw) DEALLOCATE (aw) IF (iw > 0) WRITE (iw, '(T2,A4, I3, ES10.1, ES12.3, ES12.3, ES12.3)') & MERGE("k15", "k53", which_coeffs .EQ. mm_k15), k, R, & - mm_error, ref_error, (mm_error-ref_error)/ref_error - CPASSERT(mm_error .LE. ref_error*1.05_dp+1.0E-15_dp) + mm_error, ref_error, (mm_error - ref_error)/ref_error + CPASSERT(mm_error .LE. ref_error*1.05_dp + 1.0E-15_dp) ELSE IF (iw > 0) WRITE (iw, '(T2,A4, I3, ES10.1, 3X, A)') "k15", k, R, "missing" ENDIF @@ -284,8 +284,8 @@ SUBROUTINE validate_exp_minimax(n_R, iw) ref_error = err_mm(i_mm) DEALLOCATE (aw) IF (iw > 0) WRITE (iw, '(T2,A4,I3, ES10.1, ES12.3, ES12.3, ES12.3)') & - "k53", k, R, mm_error, ref_error, (mm_error-ref_error)/ref_error - IF (mm_error .GT. ref_error*1.05_dp+1.0E-15_dp) THEN + "k53", k, R, mm_error, ref_error, (mm_error - ref_error)/ref_error + IF (mm_error .GT. ref_error*1.05_dp + 1.0E-15_dp) THEN CPABORT("Test 1 failed: numerical error is larger than tabulated error") ENDIF ENDIF @@ -316,8 +316,8 @@ SUBROUTINE validate_exp_minimax(n_R, iw) ref_error = err_mm(i_mm) IF (iw > 0) WRITE (iw, '(T2, A4, I3, ES10.1, ES12.3, ES12.3, ES12.3)') & MERGE("k15", "k53", which_coeffs .EQ. mm_k15), k, R, & - mm_error, ref_error, (mm_error-ref_error)/ref_error - IF (mm_error .GT. ref_error*1.05_dp+1.0E-15_dp) THEN + mm_error, ref_error, (mm_error - ref_error)/ref_error + IF (mm_error .GT. ref_error*1.05_dp + 1.0E-15_dp) THEN CPABORT("Test 2 failed: numerical error is larger than tabulated error") ENDIF IF (do_exit) EXIT diff --git a/src/minimax/minimax_exp_k15.F b/src/minimax/minimax_exp_k15.F index dd214f9104..af364efa1d 100644 --- a/src/minimax/minimax_exp_k15.F +++ b/src/minimax/minimax_exp_k15.F @@ -107,12 +107,12 @@ FUNCTION get_minimax_numerical_error(Rc, aw) RESULT(numerr) k = SIZE(aw)/2 numerr = 0.0_dp DO np = 1, npoints - x = 1.0_dp+(Rc-1.0_dp)*(npoints-np)/(npoints-1) + x = 1.0_dp + (Rc - 1.0_dp)*(npoints - np)/(npoints - 1) mm = 0.0_dp DO j = 1, k - mm = mm+aw(j+k)*EXP(-aw(j)*x) + mm = mm + aw(j + k)*EXP(-aw(j)*x) ENDDO - numerr = MAX(numerr, ABS(mm-1.0_dp/x)) + numerr = MAX(numerr, ABS(mm - 1.0_dp/x)) ENDDO END FUNCTION get_minimax_numerical_error @@ -586,11 +586,11 @@ SUBROUTINE get_minimax_coeff_k15(k, Rc, aw, mm_error) IF (Rc < R_max .AND. Rc >= R_min) THEN R_transf = SQRT(L_b/Rc) - R_transf = SQRT(R_transf)*(SQRT(U_b/(U_b-L_b))-SQRT(Rc/(U_b-L_b))) + R_transf = SQRT(R_transf)*(SQRT(U_b/(U_b - L_b)) - SQRT(Rc/(U_b - L_b))) DO kkk = 1, 2*k aw(kkk) = fit_coef(0, kkk) DO icoef = 1, 12 - aw(kkk) = aw(kkk)+fit_coef(icoef, kkk)*R_transf**icoef + aw(kkk) = aw(kkk) + fit_coef(icoef, kkk)*R_transf**icoef END DO END DO END IF diff --git a/src/minimax/minimax_exp_k53.F b/src/minimax/minimax_exp_k53.F index 91b6153b36..8eddfaac32 100644 --- a/src/minimax/minimax_exp_k53.F +++ b/src/minimax/minimax_exp_k53.F @@ -27,18 +27,18 @@ MODULE minimax_exp_k53 INTEGER, PARAMETER :: k_max = 53 REAL(KIND=dp), PARAMETER :: R_max = 4.0E+12_dp - INTEGER, PARAMETER, DIMENSION(n_k+1) :: k_p = & - [1, 10, 23, 42, 64, & - 92, 121, 154, 177, 201, & - 227, 254, 282, 311, 342, & - 380, 419, 458, 497, 536, & - 575, 612, 646, 681, 717, & - 744, 789, 826, 831, 833, & - 836, 839, 843, 848, 855, & - 861, 863, 865, 867, 870, & - 873, 877, 881, 883, 885, & - 887, 890, 892, 896, 901, & - 927, 929, 931, 936] + INTEGER, PARAMETER, DIMENSION(n_k + 1) :: k_p = & + [1, 10, 23, 42, 64, & + 92, 121, 154, 177, 201, & + 227, 254, 282, 311, 342, & + 380, 419, 458, 497, 536, & + 575, 612, 646, 681, 717, & + 744, 789, 826, 831, 833, & + 836, 839, 843, 848, 855, & + 861, 863, 865, 867, 870, & + 873, 877, 881, 883, 885, & + 887, 890, 892, 896, 901, & + 927, 929, 931, 936] INTEGER, PARAMETER, DIMENSION(n_approx) :: k_mm = & [1, 1, 1, 1, 1, & diff --git a/src/minimax/minimax_rpa.F b/src/minimax/minimax_rpa.F index 63b634504b..4139d96389 100644 --- a/src/minimax/minimax_rpa.F +++ b/src/minimax/minimax_rpa.F @@ -131,11 +131,11 @@ SUBROUTINE get_rpa_minimax_coeff(k, E_range, aw, ierr, print_warning) END IF R_transf = SQRT(L_b/Rc) - R_transf = SQRT(R_transf)*(SQRT(U_b/(U_b-L_b))-SQRT(Rc/(U_b-L_b))) + R_transf = SQRT(R_transf)*(SQRT(U_b/(U_b - L_b)) - SQRT(Rc/(U_b - L_b))) DO kkk = 1, 2*k aw(kkk) = fit_coef(1, kkk) DO icoef = 1, 12 - aw(kkk) = aw(kkk)+fit_coef(icoef+1, kkk)*(R_transf**icoef) + aw(kkk) = aw(kkk) + fit_coef(icoef + 1, kkk)*(R_transf**icoef) END DO END DO diff --git a/src/mixed_cdft_methods.F b/src/mixed_cdft_methods.F index 2bcd67abb4..0a7fd51f45 100644 --- a/src/mixed_cdft_methods.F +++ b/src/mixed_cdft_methods.F @@ -213,7 +213,7 @@ SUBROUTINE mixed_cdft_init(force_env, calculate_forces) ! First determine if the calculation is pure DFT or QMMM and find the qs force_env DO iforce_eval = 1, nforce_eval IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) CYCLE - SELECT CASE (force_env%sub_force_env (iforce_eval)%force_env%in_use) + SELECT CASE (force_env%sub_force_env(iforce_eval)%force_env%in_use) CASE (use_qs_force) force_env_qs => force_env%sub_force_env(iforce_eval)%force_env CASE (use_qmmm) @@ -314,7 +314,7 @@ SUBROUTINE mixed_cdft_init(force_env, calculate_forces) md_section => section_vals_get_subs_vals(root_section, "MOTION%MD") CALL section_vals_val_get(md_section, "TIMESTEP", r_val=mixed_cdft%sim_dt) CALL section_vals_val_get(md_section, "STEP_START_VAL", i_val=mixed_cdft%sim_step) - mixed_cdft%sim_step = mixed_cdft%sim_step-1 ! to get the first step correct + mixed_cdft%sim_step = mixed_cdft%sim_step - 1 ! to get the first step correct mixed_cdft%sim_dt = cp_unit_from_cp2k(mixed_cdft%sim_dt, "fs") ! Parse constraint settings from the individual force_evals and check consistency CALL mixed_cdft_parse_settings(force_env, mixed_env, mixed_cdft, & @@ -500,7 +500,7 @@ SUBROUTINE mixed_cdft_build_weight_parallel(force_env, calculate_forces) particles=particles_mix) DO iforce_eval = 1, nforce_eval IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) CYCLE - SELECT CASE (force_env%sub_force_env (iforce_eval)%force_env%in_use) + SELECT CASE (force_env%sub_force_env(iforce_eval)%force_env%in_use) CASE (use_qs_force) force_env_qs => force_env%sub_force_env(iforce_eval)%force_env CASE (use_qmmm) @@ -533,7 +533,7 @@ SUBROUTINE mixed_cdft_build_weight_parallel(force_env, calculate_forces) natom = SIZE(particles_mix%els) CALL mixed_becke_constraint(force_env, calculate_forces) ! Start replicating the working arrays on both np/2 processor groups - mixed_cdft%sim_step = mixed_cdft%sim_step+1 + mixed_cdft%sim_step = mixed_cdft%sim_step + 1 CALL get_qs_env(qs_env, pw_env=pw_env, dft_control=dft_control) cdft_control_target => dft_control%qs_control%cdft_control CPASSERT(dft_control%qs_control%cdft) @@ -547,7 +547,7 @@ SUBROUTINE mixed_cdft_build_weight_parallel(force_env, calculate_forces) my_special_work = 1 END IF ALLOCATE (recvbuffer(SIZE(mixed_cdft%source_list))) - ALLOCATE (req_total(my_special_work*SIZE(mixed_cdft%dest_list)+SIZE(mixed_cdft%source_list))) + ALLOCATE (req_total(my_special_work*SIZE(mixed_cdft%dest_list) + SIZE(mixed_cdft%source_list))) ALLOCATE (lb(SIZE(mixed_cdft%source_list)), ub(SIZE(mixed_cdft%source_list))) IF (cdft_control%becke_control%cavity_confine) THEN ! Gaussian confinement => the bounds depend on the processor and need to be communicated @@ -561,9 +561,9 @@ SUBROUTINE mixed_cdft_build_weight_parallel(force_env, calculate_forces) END DO DO i = 1, my_special_work DO j = 1, SIZE(mixed_cdft%dest_list) - ind = j+(i-1)*SIZE(mixed_cdft%dest_list)+SIZE(mixed_cdft%source_list) + ind = j + (i - 1)*SIZE(mixed_cdft%dest_list) + SIZE(mixed_cdft%source_list) CALL mp_isend(msgin=sendbuffer_i, & - dest=mixed_cdft%dest_list(j)+(i-1)*force_env%para_env%num_pe/2, & + dest=mixed_cdft%dest_list(j) + (i - 1)*force_env%para_env%num_pe/2, & request=req_total(ind), & comm=force_env%para_env%group) END DO @@ -605,15 +605,15 @@ SUBROUTINE mixed_cdft_build_weight_parallel(force_env, calculate_forces) ! Determine the sender specific indices of grid slices that are to be received CALL timeset(routineN//"_comm", handle2) DO j = 1, SIZE(recvbuffer) - ind = j+(j/2) + ind = j + (j/2) IF (mixed_cdft%is_special) THEN recvbuffer(j)%imap = (/mixed_cdft%source_list_bo(1, j), mixed_cdft%source_list_bo(2, j), & mixed_cdft%source_list_bo(3, j), mixed_cdft%source_list_bo(4, j), & lb(j), ub(j)/) ELSE IF (mixed_cdft%is_pencil) THEN - recvbuffer(j)%imap = (/bo(1, 1), bo(2, 1), mixed_cdft%recv_bo(ind), mixed_cdft%recv_bo(ind+1), lb(j), ub(j)/) + recvbuffer(j)%imap = (/bo(1, 1), bo(2, 1), mixed_cdft%recv_bo(ind), mixed_cdft%recv_bo(ind + 1), lb(j), ub(j)/) ELSE - recvbuffer(j)%imap = (/mixed_cdft%recv_bo(ind), mixed_cdft%recv_bo(ind+1), bo(1, 2), bo(2, 2), lb(j), ub(j)/) + recvbuffer(j)%imap = (/mixed_cdft%recv_bo(ind), mixed_cdft%recv_bo(ind + 1), bo(1, 2), bo(2, 2), lb(j), ub(j)/) END IF END DO IF (mixed_cdft%dlb .AND. .NOT. mixed_cdft%is_special) THEN @@ -623,9 +623,9 @@ SUBROUTINE mixed_cdft_build_weight_parallel(force_env, calculate_forces) IF (mixed_cdft%dlb_control%recv_work_repl(j)) & recv_offset = SUM(mixed_cdft%dlb_control%recv_info(j)%target_list(2, :)) IF (mixed_cdft%is_pencil) THEN - recvbuffer(j)%imap(1) = recvbuffer(j)%imap(1)+recv_offset + recvbuffer(j)%imap(1) = recvbuffer(j)%imap(1) + recv_offset ELSE - recvbuffer(j)%imap(3) = recvbuffer(j)%imap(3)+recv_offset + recvbuffer(j)%imap(3) = recvbuffer(j)%imap(3) + recv_offset END IF END DO END IF @@ -642,10 +642,10 @@ SUBROUTINE mixed_cdft_build_weight_parallel(force_env, calculate_forces) END DO DO i = 1, my_special_work DO j = 1, SIZE(mixed_cdft%dest_list) - ind = j+(i-1)*SIZE(mixed_cdft%dest_list)+SIZE(mixed_cdft%source_list) + ind = j + (i - 1)*SIZE(mixed_cdft%dest_list) + SIZE(mixed_cdft%source_list) IF (mixed_cdft%is_special) THEN CALL mp_isend(msgin=mixed_cdft%sendbuff(j)%weight, & - dest=mixed_cdft%dest_list(j)+(i-1)*force_env%para_env%num_pe/2, & + dest=mixed_cdft%dest_list(j) + (i - 1)*force_env%para_env%num_pe/2, & request=req_total(ind), & comm=force_env%para_env%group) ELSE @@ -703,10 +703,10 @@ SUBROUTINE mixed_cdft_build_weight_parallel(force_env, calculate_forces) END DO DO i = 1, my_special_work DO j = 1, SIZE(mixed_cdft%dest_list) - ind = j+(i-1)*SIZE(mixed_cdft%dest_list)+SIZE(mixed_cdft%source_list) + ind = j + (i - 1)*SIZE(mixed_cdft%dest_list) + SIZE(mixed_cdft%source_list) IF (mixed_cdft%is_special) THEN CALL mp_isend(msgin=mixed_cdft%sendbuff(j)%cavity, & - dest=mixed_cdft%dest_list(j)+(i-1)*force_env%para_env%num_pe/2, & + dest=mixed_cdft%dest_list(j) + (i - 1)*force_env%para_env%num_pe/2, & request=req_total(ind), & comm=force_env%para_env%group) ELSE @@ -770,10 +770,10 @@ SUBROUTINE mixed_cdft_build_weight_parallel(force_env, calculate_forces) END DO DO i = 1, my_special_work DO j = 1, SIZE(mixed_cdft%dest_list) - ind = j+(i-1)*SIZE(mixed_cdft%dest_list)+SIZE(mixed_cdft%source_list) + ind = j + (i - 1)*SIZE(mixed_cdft%dest_list) + SIZE(mixed_cdft%source_list) IF (mixed_cdft%is_special) THEN CALL mp_isend(msgin=mixed_cdft%sendbuff(j)%gradients, & - dest=mixed_cdft%dest_list(j)+(i-1)*force_env%para_env%num_pe/2, & + dest=mixed_cdft%dest_list(j) + (i - 1)*force_env%para_env%num_pe/2, & request=req_total(ind), & comm=force_env%para_env%group) ELSE @@ -866,7 +866,7 @@ SUBROUTINE mixed_cdft_build_weight_parallel(force_env, calculate_forces) t2 = m_walltime() IF (iounit > 0) THEN WRITE (iounit, '(A)') ' ' - WRITE (iounit, '(T2,A,F6.1,A)') 'MIXED_CDFT| Becke constraint built in ', t2-t1, ' seconds' + WRITE (iounit, '(T2,A,F6.1,A)') 'MIXED_CDFT| Becke constraint built in ', t2 - t1, ' seconds' WRITE (iounit, '(A)') ' ' END IF CALL cp_print_key_finished_output(iounit, logger, force_env_section, & @@ -914,10 +914,10 @@ SUBROUTINE mixed_cdft_transfer_weight(force_env, calculate_forces, iforce_eval) IF (iforce_eval == 1) THEN jforce_eval = 1 ELSE - jforce_eval = iforce_eval-1 + jforce_eval = iforce_eval - 1 END IF nforce_eval = SIZE(force_env%sub_force_env) - SELECT CASE (force_env%sub_force_env (jforce_eval)%force_env%in_use) + SELECT CASE (force_env%sub_force_env(jforce_eval)%force_env%in_use) CASE (use_qs_force, use_qmmm) force_env_qs_source => force_env%sub_force_env(jforce_eval)%force_env force_env_qs_target => force_env%sub_force_env(iforce_eval)%force_env @@ -945,7 +945,7 @@ SUBROUTINE mixed_cdft_transfer_weight(force_env, calculate_forces, iforce_eval) ELSE cdft_control_source%transfer_pot = .FALSE. END IF - mixed_cdft%sim_step = mixed_cdft%sim_step+1 + mixed_cdft%sim_step = mixed_cdft%sim_step + 1 ELSE ! Transfer the constraint from the ith force_eval to the i+1th CALL get_qs_env(qs_env_source, dft_control=dft_control_source, & @@ -1083,7 +1083,7 @@ SUBROUTINE mixed_cdft_set_flags(force_env) nforce_eval = SIZE(force_env%sub_force_env) DO iforce_eval = 1, nforce_eval IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) CYCLE - SELECT CASE (force_env%sub_force_env (iforce_eval)%force_env%in_use) + SELECT CASE (force_env%sub_force_env(iforce_eval)%force_env%in_use) CASE (use_qs_force, use_qmmm) force_env_qs => force_env%sub_force_env(iforce_eval)%force_env CASE DEFAULT @@ -1117,7 +1117,7 @@ SUBROUTINE mixed_cdft_set_flags(force_env) END IF END IF END DO - mixed_cdft%sim_step = mixed_cdft%sim_step+1 + mixed_cdft%sim_step = mixed_cdft%sim_step + 1 IF (first_call) first_call = .FALSE. CALL timestop(handle) @@ -1259,7 +1259,7 @@ SUBROUTINE mixed_cdft_interaction_matrices(force_env) END DO END DO ! Allocate work - npermutations = nforce_eval*(nforce_eval-1)/2 ! Size of upper triangular part + npermutations = nforce_eval*(nforce_eval - 1)/2 ! Size of upper triangular part ALLOCATE (w_matrix_mo(nforce_eval, nforce_eval, nvar)) ALLOCATE (mo_overlap(npermutations), S_det(npermutations, nspins)) ALLOCATE (a(nspins, nvar, npermutations), b(nspins, nvar, npermutations)) @@ -1325,7 +1325,7 @@ SUBROUTINE mixed_cdft_interaction_matrices(force_env) nelectron_mismatch = .FALSE. nelectron_tot = SUM(mixed_cdft%occupations(1, ispin)%array(1:nmo)) DO istate = 2, nforce_eval - IF (ABS(SUM(mixed_cdft%occupations(istate, ispin)%array(1:nmo))-nelectron_tot) .GT. 1.0E-4_dp) & + IF (ABS(SUM(mixed_cdft%occupations(istate, ispin)%array(1:nmo)) - nelectron_tot) .GT. 1.0E-4_dp) & nelectron_mismatch = .TRUE. END DO IF (ANY(homo(:, ispin) /= nmo)) THEN @@ -1399,8 +1399,8 @@ SUBROUTINE mixed_cdft_interaction_matrices(force_env) ! calculate the MO overlaps (C_j)^T S C_i ipermutation = 0 DO istate = 1, nforce_eval - DO jstate = istate+1, nforce_eval - ipermutation = ipermutation+1 + DO jstate = istate + 1, nforce_eval + ipermutation = ipermutation + 1 CALL cp_dbcsr_sm_fm_multiply(mixed_matrix_s, mixed_mo_coeff(istate, ispin)%matrix, & tmp2, nmo, 1.0_dp, 0.0_dp) CALL cp_gemm('T', 'N', nmo, nmo, nao, 1.0_dp, & @@ -1462,7 +1462,7 @@ SUBROUTINE mixed_cdft_interaction_matrices(force_env) DO j = 1, ncol_local DO k = 1, nrow_local DO ivar = 1, nvar - b(ispin, ivar, ipermutation) = b(ispin, ivar, ipermutation)+ & + b(ispin, ivar, ipermutation) = b(ispin, ivar, ipermutation) + & w_matrix_mo(jstate, istate, ivar)%matrix%local_data(k, j)* & inverse_mat%local_data(k, j) END DO @@ -1473,7 +1473,7 @@ SUBROUTINE mixed_cdft_interaction_matrices(force_env) DO j = 1, ncol_local DO k = 1, nrow_local DO ivar = 1, nvar - a(ispin, ivar, ipermutation) = a(ispin, ivar, ipermutation)+ & + a(ispin, ivar, ipermutation) = a(ispin, ivar, ipermutation) + & w_matrix_mo(istate, jstate, ivar)%matrix%local_data(k, j)* & Tinverse%local_data(k, j) END DO @@ -1481,7 +1481,7 @@ SUBROUTINE mixed_cdft_interaction_matrices(force_env) END DO ! Handle different constraint types DO ivar = 1, nvar - SELECT CASE (mixed_cdft%constraint_type (ivar, istate)) + SELECT CASE (mixed_cdft%constraint_type(ivar, istate)) CASE (cdft_charge_constraint) ! No action needed CASE (cdft_magnetization_constraint) @@ -1495,7 +1495,7 @@ SUBROUTINE mixed_cdft_interaction_matrices(force_env) CASE DEFAULT CPABORT("Unknown constraint type.") END SELECT - SELECT CASE (mixed_cdft%constraint_type (ivar, jstate)) + SELECT CASE (mixed_cdft%constraint_type(ivar, jstate)) CASE (cdft_charge_constraint) ! No action needed CASE (cdft_magnetization_constraint) @@ -1559,7 +1559,7 @@ SUBROUTINE mixed_cdft_interaction_matrices(force_env) ! Finalize by multiplication with Sda DO ivar = 1, nvar IF (mixed_cdft%identical_constraints) THEN - Wda(ivar, ipermutation) = (SUM(a(:, ivar, ipermutation))+SUM(b(:, ivar, ipermutation)))* & + Wda(ivar, ipermutation) = (SUM(a(:, ivar, ipermutation)) + SUM(b(:, ivar, ipermutation)))* & Sda(ipermutation)/2.0_dp ELSE Wda(ivar, ipermutation) = SUM(a(:, ivar, ipermutation))*Sda(ipermutation) @@ -1635,28 +1635,28 @@ SUBROUTINE mixed_cdft_interaction_matrices(force_env) sum_b = 0.0_dp DO ivar = 1, nvar ! V_J * - sum_b(1) = sum_b(1)+strength(ivar, jstate)*W_diagonal(ivar, jstate) + sum_b(1) = sum_b(1) + strength(ivar, jstate)*W_diagonal(ivar, jstate) ! V_I * - sum_a(1) = sum_a(1)+strength(ivar, istate)*W_diagonal(ivar, istate) + sum_a(1) = sum_a(1) + strength(ivar, istate)*W_diagonal(ivar, istate) IF (mixed_cdft%identical_constraints) THEN ! V_J * W_IJ - sum_b(2) = sum_b(2)+strength(ivar, jstate)*Wda(ivar, ipermutation) + sum_b(2) = sum_b(2) + strength(ivar, jstate)*Wda(ivar, ipermutation) ! V_I * W_JI - sum_a(2) = sum_a(2)+strength(ivar, istate)*Wda(ivar, ipermutation) + sum_a(2) = sum_a(2) + strength(ivar, istate)*Wda(ivar, ipermutation) ELSE ! V_J * W_IJ - sum_b(2) = sum_b(2)+strength(ivar, jstate)*Wad(ivar, ipermutation) + sum_b(2) = sum_b(2) + strength(ivar, jstate)*Wad(ivar, ipermutation) ! V_I * W_JI - sum_a(2) = sum_a(2)+strength(ivar, istate)*Wda(ivar, ipermutation) + sum_a(2) = sum_a(2) + strength(ivar, istate)*Wda(ivar, ipermutation) END IF END DO ! Denote F_X = = E_X + V_X* ! H_IJ = F_J*S_IJ - V_J * W_IJ - c(1) = (energy(jstate)+sum_b(1))*Sda(ipermutation)-sum_b(2) + c(1) = (energy(jstate) + sum_b(1))*Sda(ipermutation) - sum_b(2) ! H_JI = F_I*S_JI - V_I * W_JI - c(2) = (energy(istate)+sum_a(1))*Sda(ipermutation)-sum_a(2) + c(2) = (energy(istate) + sum_a(1))*Sda(ipermutation) - sum_a(2) ! H''(I,J) = 0.5*(H_IJ+H_JI) = H''(J,I) - H_mat(istate, jstate) = (c(1)+c(2))*0.5_dp + H_mat(istate, jstate) = (c(1) + c(2))*0.5_dp H_mat(jstate, istate) = H_mat(istate, jstate) IF (mixed_cdft%nonortho_coupling) coupling_nonortho(ipermutation) = H_mat(istate, jstate) END DO @@ -1719,7 +1719,7 @@ SUBROUTINE mixed_cdft_calculate_coupling_low(force_env) ! Possibly computes the coupling additionally with the wavefunction overlap method nforce_eval = SIZE(mixed_cdft%results%H, 1) nvar = SIZE(mixed_cdft%results%Wda, 1) - npermutations = nforce_eval*(nforce_eval-1)/2 + npermutations = nforce_eval*(nforce_eval - 1)/2 ALLOCATE (tmp_mat(nforce_eval, nforce_eval)) IF (nvar == 1 .AND. mixed_cdft%identical_constraints) THEN use_rotation = .TRUE. @@ -1857,14 +1857,14 @@ SUBROUTINE mixed_cdft_configuration_interaction(force_env) IF (ivar == 1) THEN WRITE (iounit, '(T3,A,T58,(3X,F20.14))') 'Ground state energy:', eigenv(ivar) ELSE - WRITE (iounit, '(/,T3,A,I2,A,T58,(3X,F20.14))') 'Excited state (', ivar-1, ' ) energy:', eigenv(ivar) + WRITE (iounit, '(/,T3,A,I2,A,T58,(3X,F20.14))') 'Excited state (', ivar - 1, ' ) energy:', eigenv(ivar) END IF DO istate = 1, nforce_eval, 2 IF (istate == 1) THEN WRITE (iounit, '(T3,A,T54,(3X,2F12.6))') & - 'Expansion coefficients:', H_mat(istate, ivar), H_mat(istate+1, ivar) + 'Expansion coefficients:', H_mat(istate, ivar), H_mat(istate + 1, ivar) ELSE IF (istate .LT. nforce_eval) THEN - WRITE (iounit, '(T54,(3X,2F12.6))') H_mat(istate, ivar), H_mat(istate+1, ivar) + WRITE (iounit, '(T54,(3X,2F12.6))') H_mat(istate, ivar), H_mat(istate + 1, ivar) ELSE WRITE (iounit, '(T54,(3X,F12.6))') H_mat(istate, ivar) END IF @@ -1948,8 +1948,8 @@ SUBROUTINE mixed_cdft_block_diag(force_env) DO i = 1, nblk NULLIFY (blocks(i)%array) ALLOCATE (blocks(i)%array(2)) - blocks(i)%array = (/j, j+1/) - j = j+2 + blocks(i)%array = (/j, j + 1/) + j = j + 2 END DO ! Print info IF (iounit > 0) THEN @@ -1957,7 +1957,7 @@ SUBROUTINE mixed_cdft_block_diag(force_env) WRITE (iounit, '(T6,A)') 'Block diagonalization is continued until only two matrix blocks remain.' WRITE (iounit, '(T6,A)') 'The new blocks are formed by collecting pairs of blocks from the previous' WRITE (iounit, '(T6,A)') 'block diagonalized matrix in ascending order.' - WRITE (iounit, '(/,T3,A,I3,A,I3)') 'Recursion step:', irecursion-1, ' of ', nrecursion-1 + WRITE (iounit, '(/,T3,A,I3,A,I3)') 'Recursion step:', irecursion - 1, ' of ', nrecursion - 1 WRITE (iounit, '(/,T3,A)') 'List of old block indices for each new block' DO i = 1, nblk WRITE (iounit, '(T6,A,I3,A,6I3)') 'Block', i, ':', (blocks(i)%array(j), j=1, SIZE(blocks(i)%array)) @@ -2019,7 +2019,7 @@ SUBROUTINE mixed_cdft_calculate_metric(force_env, mixed_cdft, density_matrix_dif CALL timeset(routineN, handle) nforce_eval = SIZE(mixed_cdft%results%H, 1) - npermutations = nforce_eval*(nforce_eval-1)/2 + npermutations = nforce_eval*(nforce_eval - 1)/2 nspins = SIZE(density_matrix_diff, 2) ALLOCATE (metric(npermutations, nspins)) metric = 0.0_dp @@ -2035,7 +2035,7 @@ SUBROUTINE mixed_cdft_calculate_metric(force_env, mixed_cdft, density_matrix_dif para_env=force_env%para_env, blacs_env=mixed_cdft%blacs_env) CALL dbcsr_release_p(density_matrix_diff(ipermutation, ispin)%matrix) DO j = 1, ncol_mo(ispin) - metric(ipermutation, ispin) = metric(ipermutation, ispin)+(evals(j)**2-evals(j)**4) + metric(ipermutation, ispin) = metric(ipermutation, ispin) + (evals(j)**2 - evals(j)**4) END DO END DO DEALLOCATE (evals) @@ -2092,7 +2092,7 @@ SUBROUTINE mixed_cdft_wfn_overlap_method(force_env, mixed_cdft, ncol_mo, nrow_mo CALL timeset(routineN, handle) nforce_eval = SIZE(mixed_cdft%results%H, 1) - npermutations = nforce_eval*(nforce_eval-1)/2 + npermutations = nforce_eval*(nforce_eval - 1)/2 nspins = SIZE(nrow_mo) mixed_mo_coeff => mixed_cdft%matrix%mixed_mo_coeff mixed_matrix_s => mixed_cdft%matrix%mixed_matrix_s @@ -2208,19 +2208,19 @@ SUBROUTINE mixed_cdft_wfn_overlap_method(force_env, mixed_cdft, ncol_mo, nrow_mo END IF ! Calculate coupling using eq. 12c ! The coupling is singular if A = B (i.e. states I/J are identical or charge in ground state is fully delocalized) - IF (ABS(overlaps(1, ipermutation, 1)-overlaps(2, ipermutation, 1)) .LE. 1.0e-14_dp) THEN + IF (ABS(overlaps(1, ipermutation, 1) - overlaps(2, ipermutation, 1)) .LE. 1.0e-14_dp) THEN CALL cp_warn(__LOCATION__, & "Coupling between states is singular and set to zero. "// & "Potential causes: coupling is computed between identical CDFT states or the spin/charge "// & "density is fully delocalized in the unconstrained ground state.") coupling_wfn(ipermutation) = 0.0_dp ELSE - energy_diff = mixed_cdft%results%energy(jstate)-mixed_cdft%results%energy(istate) + energy_diff = mixed_cdft%results%energy(jstate) - mixed_cdft%results%energy(istate) Sda = mixed_cdft%results%S(istate, jstate) coupling_wfn(ipermutation) = ABS((overlaps(1, ipermutation, 1)*overlaps(2, ipermutation, 1)/ & - (overlaps(1, ipermutation, 1)**2-overlaps(2, ipermutation, 1)**2))* & - (energy_diff)/(1.0_dp-Sda**2)* & - (1.0_dp-(overlaps(1, ipermutation, 1)**2+overlaps(2, ipermutation, 1)**2)/ & + (overlaps(1, ipermutation, 1)**2 - overlaps(2, ipermutation, 1)**2))* & + (energy_diff)/(1.0_dp - Sda**2)* & + (1.0_dp - (overlaps(1, ipermutation, 1)**2 + overlaps(2, ipermutation, 1)**2)/ & (2.0_dp*overlaps(1, ipermutation, 1)*overlaps(2, ipermutation, 1))* & Sda)) END IF @@ -2438,15 +2438,15 @@ SUBROUTINE mixed_becke_constraint_init(force_env, mixed_cdft, calculate_forces, cell_v(i) = cell%hmat(i, i) END DO ALLOCATE (R12(natom, natom)) - DO iatom = 1, natom-1 - DO jatom = iatom+1, natom + DO iatom = 1, natom - 1 + DO jatom = iatom + 1, natom r = particle_set(iatom)%r r1 = particle_set(jatom)%r DO i = 1, 3 - r(i) = MODULO(r(i), cell%hmat(i, i))-cell%hmat(i, i)/2._dp - r1(i) = MODULO(r1(i), cell%hmat(i, i))-cell%hmat(i, i)/2._dp + r(i) = MODULO(r(i), cell%hmat(i, i)) - cell%hmat(i, i)/2._dp + r1(i) = MODULO(r1(i), cell%hmat(i, i)) - cell%hmat(i, i)/2._dp END DO - dist_vec = (r-r1)-ANINT((r-r1)/cell_v)*cell_v + dist_vec = (r - r1) - ANINT((r - r1)/cell_v)*cell_v IF (store_vectors) THEN position_vecs(:, iatom) = r(:) IF (iatom == 1 .AND. jatom == natom) position_vecs(:, jatom) = r1(:) @@ -2466,8 +2466,8 @@ SUBROUTINE mixed_becke_constraint_init(force_env, mixed_cdft, calculate_forces, jrcov = cdft_control%becke_control%radii(ikind) IF (ircov .NE. jrcov) THEN chi = ircov/jrcov - uij = (chi-1.0_dp)/(chi+1.0_dp) - cdft_control%becke_control%aij(iatom, jatom) = uij/(uij**2-1.0_dp) + uij = (chi - 1.0_dp)/(chi + 1.0_dp) + cdft_control%becke_control%aij(iatom, jatom) = uij/(uij**2 - 1.0_dp) IF (cdft_control%becke_control%aij(iatom, jatom) & .GT. 0.5_dp) THEN cdft_control%becke_control%aij(iatom, jatom) = 0.5_dp @@ -2578,11 +2578,11 @@ SUBROUTINE mixed_becke_constraint_init(force_env, mixed_cdft, calculate_forces, IF (rs_cavity%desc%parallel .AND. .NOT. rs_cavity%desc%distributed) THEN ! replicated realspace grid, split the atoms up between procs IF (MODULO(iatom, rs_cavity%desc%group_size) == rs_cavity%desc%my_pos) THEN - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF ELSE - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF END DO @@ -2591,7 +2591,7 @@ SUBROUTINE mixed_becke_constraint_init(force_env, mixed_cdft, calculate_forces, atom_a = atom_list(iatom) pab(1, 1) = coef IF (store_vectors) THEN - ra(:) = position_vecs(:, atom_a)+cell_v(:)/2._dp + ra(:) = position_vecs(:, atom_a) + cell_v(:)/2._dp ELSE ra(:) = pbc(particle_set(atom_a)%r, cell) END IF @@ -2615,7 +2615,7 @@ SUBROUTINE mixed_becke_constraint_init(force_env, mixed_cdft, calculate_forces, cdft_control%becke_control%eps_cavity, & just_zero=.FALSE., bounds=bounds, work=my_work) IF (bounds(2) .LT. bo(2, 3)) THEN - bounds(2) = bounds(2)-1 + bounds(2) = bounds(2) - 1 ELSE bounds(2) = bo(2, 3) END IF @@ -2623,18 +2623,18 @@ SUBROUTINE mixed_becke_constraint_init(force_env, mixed_cdft, calculate_forces, ! In the special case bounds(1) == bounds(2) == bo(2, 3), after this check ! bounds(1) > bounds(2) and the subsequent gradient allocation (:, :, :, bounds(1):bounds(2)) ! will correctly allocate a 0-sized array - bounds(1) = bounds(1)+1 + bounds(1) = bounds(1) + 1 ELSE bounds(1) = bo(1, 3) END IF IF (bounds(1) > bounds(2)) THEN my_work_size = 0 ELSE - my_work_size = (bounds(2)-bounds(1)+1) + my_work_size = (bounds(2) - bounds(1) + 1) IF (mixed_cdft%is_pencil .OR. mixed_cdft%is_special) THEN - my_work_size = my_work_size*(bo(2, 2)-bo(1, 2)+1) + my_work_size = my_work_size*(bo(2, 2) - bo(1, 2) + 1) ELSE - my_work_size = my_work_size*(bo(2, 1)-bo(1, 1)+1) + my_work_size = my_work_size*(bo(2, 1) - bo(1, 1) + 1) END IF END IF cdft_control%becke_control%confine_bounds = bounds @@ -2685,14 +2685,14 @@ SUBROUTINE mixed_becke_constraint_init(force_env, mixed_cdft, calculate_forces, bo_conf(1, 3):bo_conf(2, 3)) END DO ELSE IF (mixed_cdft%is_pencil) THEN - ALLOCATE (mixed_cdft%cavity(bo(1, 1)+offset_dlb:bo(2, 1), bo(1, 2):bo(2, 2), bo_conf(1, 3):bo_conf(2, 3))) - mixed_cdft%cavity = cdft_control%becke_control%cavity%pw%cr3d(bo(1, 1)+offset_dlb:bo(2, 1), & + ALLOCATE (mixed_cdft%cavity(bo(1, 1) + offset_dlb:bo(2, 1), bo(1, 2):bo(2, 2), bo_conf(1, 3):bo_conf(2, 3))) + mixed_cdft%cavity = cdft_control%becke_control%cavity%pw%cr3d(bo(1, 1) + offset_dlb:bo(2, 1), & bo(1, 2):bo(2, 2), & bo_conf(1, 3):bo_conf(2, 3)) ELSE - ALLOCATE (mixed_cdft%cavity(bo(1, 1):bo(2, 1), bo(1, 2)+offset_dlb:bo(2, 2), bo_conf(1, 3):bo_conf(2, 3))) + ALLOCATE (mixed_cdft%cavity(bo(1, 1):bo(2, 1), bo(1, 2) + offset_dlb:bo(2, 2), bo_conf(1, 3):bo_conf(2, 3))) mixed_cdft%cavity = cdft_control%becke_control%cavity%pw%cr3d(bo(1, 1):bo(2, 1), & - bo(1, 2)+offset_dlb:bo(2, 2), & + bo(1, 2) + offset_dlb:bo(2, 2), & bo_conf(1, 3):bo_conf(2, 3)) END IF CALL pw_pool_give_back_pw(auxbas_pw_pool, cdft_control%becke_control%cavity%pw) @@ -2704,10 +2704,10 @@ SUBROUTINE mixed_becke_constraint_init(force_env, mixed_cdft, calculate_forces, mixed_cdft%sendbuff(i)%weight = 0.0_dp END DO ELSE IF (mixed_cdft%is_pencil) THEN - ALLOCATE (mixed_cdft%weight(bo(1, 1)+offset_dlb:bo(2, 1), bo(1, 2):bo(2, 2), bo_conf(1, 3):bo_conf(2, 3))) + ALLOCATE (mixed_cdft%weight(bo(1, 1) + offset_dlb:bo(2, 1), bo(1, 2):bo(2, 2), bo_conf(1, 3):bo_conf(2, 3))) mixed_cdft%weight = 0.0_dp ELSE - ALLOCATE (mixed_cdft%weight(bo(1, 1):bo(2, 1), bo(1, 2)+offset_dlb:bo(2, 2), bo_conf(1, 3):bo_conf(2, 3))) + ALLOCATE (mixed_cdft%weight(bo(1, 1):bo(2, 1), bo(1, 2) + offset_dlb:bo(2, 2), bo_conf(1, 3):bo_conf(2, 3))) mixed_cdft%weight = 0.0_dp END IF IF (in_memory) THEN @@ -2720,13 +2720,13 @@ SUBROUTINE mixed_becke_constraint_init(force_env, mixed_cdft, calculate_forces, mixed_cdft%sendbuff(i)%gradients = 0.0_dp END DO ELSE IF (mixed_cdft%is_pencil) THEN - ALLOCATE (cdft_control%group(1)%gradients(3*natom, bo(1, 1)+offset_dlb:bo(2, 1), & + ALLOCATE (cdft_control%group(1)%gradients(3*natom, bo(1, 1) + offset_dlb:bo(2, 1), & bo(1, 2):bo(2, 2), & bo_conf(1, 3):bo_conf(2, 3))) cdft_control%group(1)%gradients = 0.0_dp ELSE ALLOCATE (cdft_control%group(1)%gradients(3*natom, bo(1, 1):bo(2, 1), & - bo(1, 2)+offset_dlb:bo(2, 2), & + bo(1, 2) + offset_dlb:bo(2, 2), & bo_conf(1, 3):bo_conf(2, 3))) cdft_control%group(1)%gradients = 0.0_dp END IF @@ -2827,20 +2827,20 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & should_warn = 0 END IF expected_work = 0 - expected_work(force_env%para_env%mepos+1) = my_work + expected_work(force_env%para_env%mepos + 1) = my_work work_size = 0 - work_size(force_env%para_env%mepos+1) = my_work_size + work_size(force_env%para_env%mepos + 1) = my_work_size IF (ASSOCIATED(mixed_cdft%dlb_control%prediction_error)) THEN IF (mixed_cdft%is_pencil .OR. mixed_cdft%is_special) THEN - work_size(force_env%para_env%mepos+1) = work_size(force_env%para_env%mepos+1)- & - NINT(REAL(mixed_cdft%dlb_control% & - prediction_error(force_env%para_env%mepos+1), dp)/ & - REAL(bo(2, 1)-bo(1, 1)+1, dp)) + work_size(force_env%para_env%mepos + 1) = work_size(force_env%para_env%mepos + 1) - & + NINT(REAL(mixed_cdft%dlb_control% & + prediction_error(force_env%para_env%mepos + 1), dp)/ & + REAL(bo(2, 1) - bo(1, 1) + 1, dp)) ELSE - work_size(force_env%para_env%mepos+1) = work_size(force_env%para_env%mepos+1)- & - NINT(REAL(mixed_cdft%dlb_control% & - prediction_error(force_env%para_env%mepos+1), dp)/ & - REAL(bo(2, 2)-bo(1, 2)+1, dp)) + work_size(force_env%para_env%mepos + 1) = work_size(force_env%para_env%mepos + 1) - & + NINT(REAL(mixed_cdft%dlb_control% & + prediction_error(force_env%para_env%mepos + 1), dp)/ & + REAL(bo(2, 2) - bo(1, 2) + 1, dp)) END IF END IF CALL mp_sum(expected_work, force_env%para_env%group) @@ -2849,23 +2849,23 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & mixed_cdft%dlb_control%expected_work = expected_work ! Take into account the prediction error of the last step IF (ASSOCIATED(mixed_cdft%dlb_control%prediction_error)) & - expected_work = expected_work-mixed_cdft%dlb_control%prediction_error + expected_work = expected_work - mixed_cdft%dlb_control%prediction_error ! average_work = REAL(SUM(expected_work), dp)/REAL(force_env%para_env%num_pe, dp) ALLOCATE (work_index(force_env%para_env%num_pe), & load_imbalance(force_env%para_env%num_pe), & targets(2, force_env%para_env%num_pe)) - load_imbalance = expected_work-NINT(average_work) + load_imbalance = expected_work - NINT(average_work) no_overloaded = 0 no_underloaded = 0 targets = 0 ! Convert the load imbalance to a multiple of the actual work size DO i = 1, force_env%para_env%num_pe IF (load_imbalance(i) .GT. 0) THEN - no_overloaded = no_overloaded+1 + no_overloaded = no_overloaded + 1 ! Allow heavily overloaded processors to dump more data since most likely they have a lot of 'real' work IF (expected_work(i) .GT. NINT(very_overloaded*average_work)) THEN - load_imbalance(i) = (CEILING(REAL(load_imbalance(i), dp)/REAL(work_size(i), dp))+more_work)*work_size(i) + load_imbalance(i) = (CEILING(REAL(load_imbalance(i), dp)/REAL(work_size(i), dp)) + more_work)*work_size(i) ELSE load_imbalance(i) = CEILING(REAL(load_imbalance(i), dp)/REAL(work_size(i), dp))*work_size(i) END IF @@ -2873,27 +2873,27 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & ! Allow the underloaded processors to take load_scale amount of additional work ! otherwise we may be unable to exhaust all overloaded processors load_imbalance(i) = NINT(load_imbalance(i)*load_scale) - no_underloaded = no_underloaded+1 + no_underloaded = no_underloaded + 1 END IF END DO CALL sort(expected_work, force_env%para_env%num_pe, indices=work_index) ! Redistribute work in order from the most overloaded processors to the most underloaded processors ! Each underloaded processor is limited to one overloaded processor - IF (load_imbalance(force_env%para_env%mepos+1) > 0) THEN + IF (load_imbalance(force_env%para_env%mepos + 1) > 0) THEN offset = 0 mixed_cdft%dlb_control%send_work = .TRUE. ! Build up the total amount of work that needs redistribution ALLOCATE (cumulative_work(force_env%para_env%num_pe)) cumulative_work = 0 - DO i = force_env%para_env%num_pe, force_env%para_env%num_pe-no_overloaded+1, -1 - IF (work_index(i) == force_env%para_env%mepos+1) THEN + DO i = force_env%para_env%num_pe, force_env%para_env%num_pe - no_overloaded + 1, -1 + IF (work_index(i) == force_env%para_env%mepos + 1) THEN EXIT ELSE - offset = offset+load_imbalance(work_index(i)) + offset = offset + load_imbalance(work_index(i)) IF (i == force_env%para_env%num_pe) THEN cumulative_work(i) = load_imbalance(work_index(i)) ELSE - cumulative_work(i) = cumulative_work(i+1)+load_imbalance(work_index(i)) + cumulative_work(i) = cumulative_work(i + 1) + load_imbalance(work_index(i)) END IF END IF END DO @@ -2906,13 +2906,13 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & IF (my_pos == force_env%para_env%num_pe) EXIT nsend = -load_imbalance(work_index(i))/work_size(work_index(j)) IF (nsend .LT. 1) nsend = 1 - nsend_max = nsend_max-nsend - IF (nsend_max .LT. 0) nsend = nsend+nsend_max - exhausted_work = exhausted_work+nsend*work_size(work_index(j)) - offset = offset-nsend*work_size(work_index(j)) + nsend_max = nsend_max - nsend + IF (nsend_max .LT. 0) nsend = nsend + nsend_max + exhausted_work = exhausted_work + nsend*work_size(work_index(j)) + offset = offset - nsend*work_size(work_index(j)) IF (offset .LT. 0) EXIT IF (exhausted_work .EQ. cumulative_work(j)) THEN - j = j-1 + j = j - 1 nsend_max = load_imbalance(work_index(j))/work_size(work_index(j)) END IF END DO @@ -2924,17 +2924,17 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & my_target = i DEALLOCATE (cumulative_work) ! Determine how much and who to send slices of my grid points - nsend_max = load_imbalance(force_env%para_env%mepos+1)/work_size(force_env%para_env%mepos+1) + nsend_max = load_imbalance(force_env%para_env%mepos + 1)/work_size(force_env%para_env%mepos + 1) ! This the actual number of available array slices IF (mixed_cdft%is_pencil .OR. mixed_cdft%is_special) THEN - nsend_limit = bo(2, 1)-bo(1, 1)+1 + nsend_limit = bo(2, 1) - bo(1, 1) + 1 ELSE - nsend_limit = bo(2, 2)-bo(1, 2)+1 + nsend_limit = bo(2, 2) - bo(1, 2) + 1 END IF IF (.NOT. mixed_cdft%is_special) THEN ALLOCATE (mixed_cdft%dlb_control%target_list(3, max_targets)) ELSE - ALLOCATE (mixed_cdft%dlb_control%target_list(3+2*SIZE(mixed_cdft%dest_list), max_targets)) + ALLOCATE (mixed_cdft%dlb_control%target_list(3 + 2*SIZE(mixed_cdft%dest_list), max_targets)) ALLOCATE (touched(SIZE(mixed_cdft%dest_list))) touched = .FALSE. END IF @@ -2946,55 +2946,55 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & send_total = 0 ! Main loop. Note, we actually allow my_pos to offload more slices than nsend_max DO - nsend = -load_imbalance(work_index(my_target))/work_size(force_env%para_env%mepos+1) + nsend = -load_imbalance(work_index(my_target))/work_size(force_env%para_env%mepos + 1) IF (nsend .LT. 1) nsend = 1 ! send at least one block ! Prevent over redistribution: leave at least (1-work_factor)*nsend_limit slices to my_pos - IF (nsend .GT. NINT(work_factor*nsend_limit-send_total)) THEN - nsend = NINT(work_factor*nsend_limit-send_total) + IF (nsend .GT. NINT(work_factor*nsend_limit - send_total)) THEN + nsend = NINT(work_factor*nsend_limit - send_total) IF (debug_this_module) & - should_warn(force_env%para_env%mepos+1) = 1 + should_warn(force_env%para_env%mepos + 1) = 1 END IF - mixed_cdft%dlb_control%target_list(1, i) = work_index(my_target)-1 ! This is the actual processor rank + mixed_cdft%dlb_control%target_list(1, i) = work_index(my_target) - 1 ! This is the actual processor rank IF (mixed_cdft%is_special) THEN mixed_cdft%dlb_control%target_list(2, i) = 0 actually_sent = nsend DO j = ispecial, SIZE(mixed_cdft%dest_list) - mixed_cdft%dlb_control%target_list(2, i) = mixed_cdft%dlb_control%target_list(2, i)+1 + mixed_cdft%dlb_control%target_list(2, i) = mixed_cdft%dlb_control%target_list(2, i) + 1 touched(j) = .TRUE. - IF (nsend .LT. mixed_cdft%dest_list_bo(2, j)-mixed_cdft%dest_list_bo(1, j)+1) THEN - mixed_cdft%dlb_control%target_list(3+2*j-1, i) = mixed_cdft%dest_list_bo(1, j) - mixed_cdft%dlb_control%target_list(3+2*j, i) = mixed_cdft%dest_list_bo(1, j)+nsend-1 - mixed_cdft%dest_list_bo(1, j) = mixed_cdft%dest_list_bo(1, j)+nsend + IF (nsend .LT. mixed_cdft%dest_list_bo(2, j) - mixed_cdft%dest_list_bo(1, j) + 1) THEN + mixed_cdft%dlb_control%target_list(3 + 2*j - 1, i) = mixed_cdft%dest_list_bo(1, j) + mixed_cdft%dlb_control%target_list(3 + 2*j, i) = mixed_cdft%dest_list_bo(1, j) + nsend - 1 + mixed_cdft%dest_list_bo(1, j) = mixed_cdft%dest_list_bo(1, j) + nsend nsend = 0 EXIT ELSE - mixed_cdft%dlb_control%target_list(3+2*j-1, i) = mixed_cdft%dest_list_bo(1, j) - mixed_cdft%dlb_control%target_list(3+2*j, i) = mixed_cdft%dest_list_bo(2, j) - nsend = nsend-(mixed_cdft%dest_list_bo(2, j)-mixed_cdft%dest_list_bo(1, j)+1) + mixed_cdft%dlb_control%target_list(3 + 2*j - 1, i) = mixed_cdft%dest_list_bo(1, j) + mixed_cdft%dlb_control%target_list(3 + 2*j, i) = mixed_cdft%dest_list_bo(2, j) + nsend = nsend - (mixed_cdft%dest_list_bo(2, j) - mixed_cdft%dest_list_bo(1, j) + 1) mixed_cdft%dest_list_bo(1:2, j) = should_deallocate END IF IF (nsend .LE. 0) EXIT END DO - IF (mixed_cdft%dest_list_bo(1, ispecial) .EQ. should_deallocate) ispecial = j+1 - actually_sent = actually_sent-nsend - nsend_max = nsend_max-actually_sent - send_total = send_total+actually_sent + IF (mixed_cdft%dest_list_bo(1, ispecial) .EQ. should_deallocate) ispecial = j + 1 + actually_sent = actually_sent - nsend + nsend_max = nsend_max - actually_sent + send_total = send_total + actually_sent ELSE mixed_cdft%dlb_control%target_list(2, i) = nsend - nsend_max = nsend_max-nsend - send_total = send_total+nsend + nsend_max = nsend_max - nsend + send_total = send_total + nsend END IF IF (nsend_max .LT. 0) nsend_max = 0 IF (nsend_max .EQ. 0) EXIT IF (my_target /= no_underloaded) THEN - my_target = my_target+1 + my_target = my_target + 1 ELSE ! If multiple processors execute this block load balancing will fail - mixed_cdft%dlb_control%target_list(2, i) = mixed_cdft%dlb_control%target_list(2, i)+nsend_max + mixed_cdft%dlb_control%target_list(2, i) = mixed_cdft%dlb_control%target_list(2, i) + nsend_max nsend_max = 0 EXIT END IF - i = i+1 + i = i + 1 IF (i .GT. max_targets) & CALL cp_abort(__LOCATION__, & "Load balancing error: increase max_targets") @@ -3002,18 +3002,18 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & IF (.NOT. mixed_cdft%is_special) THEN CALL reallocate(mixed_cdft%dlb_control%target_list, 1, 3, 1, i) ELSE - CALL reallocate(mixed_cdft%dlb_control%target_list, 1, 3+2*SIZE(mixed_cdft%dest_list), 1, i) + CALL reallocate(mixed_cdft%dlb_control%target_list, 1, 3 + 2*SIZE(mixed_cdft%dest_list), 1, i) END IF targets(2, my_pos) = my_target ! Equalize the load on the target processors IF (.NOT. mixed_cdft%is_special) THEN - IF (send_total .GT. NINT(work_factor*nsend_limit)) send_total = NINT(work_factor*nsend_limit)-1 + IF (send_total .GT. NINT(work_factor*nsend_limit)) send_total = NINT(work_factor*nsend_limit) - 1 nsend = NINT(REAL(send_total, dp)/REAL(SIZE(mixed_cdft%dlb_control%target_list, 2), dp)) mixed_cdft%dlb_control%target_list(2, :) = nsend END IF ELSE DO i = 1, no_underloaded - IF (work_index(i) == force_env%para_env%mepos+1) EXIT + IF (work_index(i) == force_env%para_env%mepos + 1) EXIT END DO my_pos = i END IF @@ -3030,9 +3030,9 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & ! check that there is one-to-one mapping between over- and underloaded processors IF (force_env%para_env%ionode) THEN consistent = .TRUE. - DO i = force_env%para_env%num_pe-1, force_env%para_env%num_pe-no_overloaded+1, -1 + DO i = force_env%para_env%num_pe - 1, force_env%para_env%num_pe - no_overloaded + 1, -1 IF (targets(1, i) .GT. no_underloaded) consistent = .FALSE. - IF (targets(1, i) .GT. targets(2, i+1)) THEN + IF (targets(1, i) .GT. targets(2, i + 1)) THEN CYCLE ELSE consistent = .FALSE. @@ -3040,7 +3040,7 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & END DO IF (.NOT. consistent) THEN IF (debug_this_module .AND. iounit > 0) THEN - DO i = force_env%para_env%num_pe-1, force_env%para_env%num_pe-no_overloaded+1, -1 + DO i = force_env%para_env%num_pe - 1, force_env%para_env%num_pe - no_overloaded + 1, -1 WRITE (iounit, '(A,I8,I8,I8,I8,I8)') & 'load balancing info', load_imbalance(i), work_index(i), & work_size(i), targets(1, i), targets(2, i) @@ -3055,10 +3055,10 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & END IF ! Tell the target processors which grid points they should compute IF (my_pos .LE. no_underloaded) THEN - DO i = force_env%para_env%num_pe, force_env%para_env%num_pe-no_overloaded+1, -1 + DO i = force_env%para_env%num_pe, force_env%para_env%num_pe - no_overloaded + 1, -1 IF (targets(1, i) .LE. my_pos .AND. targets(2, i) .GE. my_pos) THEN mixed_cdft%dlb_control%recv_work = .TRUE. - mixed_cdft%dlb_control%my_source = work_index(i)-1 + mixed_cdft%dlb_control%my_source = work_index(i) - 1 EXIT END IF END DO @@ -3099,34 +3099,34 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & DEALLOCATE (buffsize) CALL mp_wait(req(1)) DO j = 1, SIZE(mixed_cdft%dlb_control%sendbuff) - ALLOCATE (mixed_cdft%dlb_control%sendbuff(j)%cavity(mixed_cdft%dlb_control%bo(12*(j-1)+1): & - mixed_cdft%dlb_control%bo(12*(j-1)+2), & - mixed_cdft%dlb_control%bo(12*(j-1)+3): & - mixed_cdft%dlb_control%bo(12*(j-1)+4), & - mixed_cdft%dlb_control%bo(12*(j-1)+7): & - mixed_cdft%dlb_control%bo(12*(j-1)+8))) + ALLOCATE (mixed_cdft%dlb_control%sendbuff(j)%cavity(mixed_cdft%dlb_control%bo(12*(j - 1) + 1): & + mixed_cdft%dlb_control%bo(12*(j - 1) + 2), & + mixed_cdft%dlb_control%bo(12*(j - 1) + 3): & + mixed_cdft%dlb_control%bo(12*(j - 1) + 4), & + mixed_cdft%dlb_control%bo(12*(j - 1) + 7): & + mixed_cdft%dlb_control%bo(12*(j - 1) + 8))) CALL mp_irecv(msgout=mixed_cdft%dlb_control%sendbuff(j)%cavity, & source=mixed_cdft%dlb_control%my_source, & request=req_recv(j), comm=force_env%para_env%group) - ALLOCATE (mixed_cdft%dlb_control%sendbuff(j)%weight(mixed_cdft%dlb_control%bo(12*(j-1)+1): & - mixed_cdft%dlb_control%bo(12*(j-1)+2), & - mixed_cdft%dlb_control%bo(12*(j-1)+3): & - mixed_cdft%dlb_control%bo(12*(j-1)+4), & - mixed_cdft%dlb_control%bo(12*(j-1)+7): & - mixed_cdft%dlb_control%bo(12*(j-1)+8))) + ALLOCATE (mixed_cdft%dlb_control%sendbuff(j)%weight(mixed_cdft%dlb_control%bo(12*(j - 1) + 1): & + mixed_cdft%dlb_control%bo(12*(j - 1) + 2), & + mixed_cdft%dlb_control%bo(12*(j - 1) + 3): & + mixed_cdft%dlb_control%bo(12*(j - 1) + 4), & + mixed_cdft%dlb_control%bo(12*(j - 1) + 7): & + mixed_cdft%dlb_control%bo(12*(j - 1) + 8))) ALLOCATE (mixed_cdft%dlb_control%sendbuff(j)%gradients(3*natom, & - mixed_cdft%dlb_control%bo(12*(j-1)+1): & - mixed_cdft%dlb_control%bo(12*(j-1)+2), & - mixed_cdft%dlb_control%bo(12*(j-1)+3): & - mixed_cdft%dlb_control%bo(12*(j-1)+4), & - mixed_cdft%dlb_control%bo(12*(j-1)+7): & - mixed_cdft%dlb_control%bo(12*(j-1)+8))) + mixed_cdft%dlb_control%bo(12*(j - 1) + 1): & + mixed_cdft%dlb_control%bo(12*(j - 1) + 2), & + mixed_cdft%dlb_control%bo(12*(j - 1) + 3): & + mixed_cdft%dlb_control%bo(12*(j - 1) + 4), & + mixed_cdft%dlb_control%bo(12*(j - 1) + 7): & + mixed_cdft%dlb_control%bo(12*(j - 1) + 8))) mixed_cdft%dlb_control%sendbuff(j)%weight = 0.0_dp mixed_cdft%dlb_control%sendbuff(j)%gradients = 0.0_dp - mixed_cdft%dlb_control%sendbuff(j)%tag = (/mixed_cdft%dlb_control%bo(12*(j-1)+9), & - mixed_cdft%dlb_control%bo(12*(j-1)+10)/) - mixed_cdft%dlb_control%sendbuff(j)%rank = (/mixed_cdft%dlb_control%bo(12*(j-1)+11), & - mixed_cdft%dlb_control%bo(12*(j-1)+12)/) + mixed_cdft%dlb_control%sendbuff(j)%tag = (/mixed_cdft%dlb_control%bo(12*(j - 1) + 9), & + mixed_cdft%dlb_control%bo(12*(j - 1) + 10)/) + mixed_cdft%dlb_control%sendbuff(j)%rank = (/mixed_cdft%dlb_control%bo(12*(j - 1) + 11), & + mixed_cdft%dlb_control%bo(12*(j - 1) + 12)/) END DO CALL mp_waitall(req_recv) DEALLOCATE (req_recv) @@ -3138,58 +3138,58 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & ALLOCATE (sendbuffer(12)) send_total = 0 DO i = 1, SIZE(mixed_cdft%dlb_control%target_list, 2) - tags = (/(i-1)*3+1+force_env%para_env%mepos*6*max_targets, & - (i-1)*3+1+3*max_targets+force_env%para_env%mepos*6*max_targets/) ! Unique communicator tags + tags = (/(i - 1)*3 + 1 + force_env%para_env%mepos*6*max_targets, & + (i - 1)*3 + 1 + 3*max_targets + force_env%para_env%mepos*6*max_targets/) ! Unique communicator tags mixed_cdft%dlb_control%target_list(3, i) = tags(1) IF (mixed_cdft%is_pencil) THEN - sendbuffer = (/bo_conf(1, 1)+offset, & - bo_conf(1, 1)+offset+(mixed_cdft%dlb_control%target_list(2, i)-1), & + sendbuffer = (/bo_conf(1, 1) + offset, & + bo_conf(1, 1) + offset + (mixed_cdft%dlb_control%target_list(2, i) - 1), & bo_conf(1, 2), bo_conf(2, 2), bo(1, 3), bo(2, 3), bo_conf(1, 3), bo_conf(2, 3), & tags(1), tags(2), mixed_cdft%dest_list(1), mixed_cdft%dest_list(2)/) ELSE sendbuffer = (/bo_conf(1, 1), bo_conf(2, 1), & - bo_conf(1, 2)+offset, & - bo_conf(1, 2)+offset+(mixed_cdft%dlb_control%target_list(2, i)-1), & + bo_conf(1, 2) + offset, & + bo_conf(1, 2) + offset + (mixed_cdft%dlb_control%target_list(2, i) - 1), & bo(1, 3), bo(2, 3), bo_conf(1, 3), bo_conf(2, 3), tags(1), tags(2), & mixed_cdft%dest_list(1), mixed_cdft%dest_list(2)/) END IF - send_total = send_total+mixed_cdft%dlb_control%target_list(2, i)-1 + send_total = send_total + mixed_cdft%dlb_control%target_list(2, i) - 1 CALL mp_isend(msgin=sendbuffer, dest=mixed_cdft%dlb_control%target_list(1, i), & request=req(1), comm=force_env%para_env%group) CALL mp_wait(req(1)) IF (mixed_cdft%is_pencil) THEN - ALLOCATE (cavity(bo_conf(1, 1)+offset: & - bo_conf(1, 1)+offset+(mixed_cdft%dlb_control%target_list(2, i)-1), & + ALLOCATE (cavity(bo_conf(1, 1) + offset: & + bo_conf(1, 1) + offset + (mixed_cdft%dlb_control%target_list(2, i) - 1), & bo_conf(1, 2):bo_conf(2, 2), bo_conf(1, 3):bo_conf(2, 3))) - cavity = cdft_control%becke_control%cavity%pw%cr3d(bo_conf(1, 1)+offset: & - bo_conf(1, 1)+offset+ & - (mixed_cdft%dlb_control%target_list(2, i)-1), & + cavity = cdft_control%becke_control%cavity%pw%cr3d(bo_conf(1, 1) + offset: & + bo_conf(1, 1) + offset + & + (mixed_cdft%dlb_control%target_list(2, i) - 1), & bo_conf(1, 2):bo_conf(2, 2), & bo_conf(1, 3):bo_conf(2, 3)) ELSE ALLOCATE (cavity(bo_conf(1, 1):bo_conf(2, 1), & - bo_conf(1, 2)+offset: & - bo_conf(1, 2)+offset+(mixed_cdft%dlb_control%target_list(2, i)-1), & + bo_conf(1, 2) + offset: & + bo_conf(1, 2) + offset + (mixed_cdft%dlb_control%target_list(2, i) - 1), & bo_conf(1, 3):bo_conf(2, 3))) cavity = cdft_control%becke_control%cavity%pw%cr3d(bo_conf(1, 1):bo_conf(2, 1), & - bo_conf(1, 2)+offset: & - bo_conf(1, 2)+offset+ & - (mixed_cdft%dlb_control%target_list(2, i)-1), & + bo_conf(1, 2) + offset: & + bo_conf(1, 2) + offset + & + (mixed_cdft%dlb_control%target_list(2, i) - 1), & bo_conf(1, 3):bo_conf(2, 3)) END IF CALL mp_isend(msgin=cavity, & dest=mixed_cdft%dlb_control%target_list(1, i), & request=req(1), comm=force_env%para_env%group) CALL mp_wait(req(1)) - offset = offset+mixed_cdft%dlb_control%target_list(2, i) + offset = offset + mixed_cdft%dlb_control%target_list(2, i) DEALLOCATE (cavity) END DO IF (mixed_cdft%is_pencil) THEN mixed_cdft%dlb_control%distributed(1) = bo_conf(1, 1) - mixed_cdft%dlb_control%distributed(2) = bo_conf(1, 1)+offset-1 + mixed_cdft%dlb_control%distributed(2) = bo_conf(1, 1) + offset - 1 ELSE mixed_cdft%dlb_control%distributed(1) = bo_conf(1, 2) - mixed_cdft%dlb_control%distributed(2) = bo_conf(1, 2)+offset-1 + mixed_cdft%dlb_control%distributed(2) = bo_conf(1, 2) + offset - 1 END IF DEALLOCATE (sendbuffer) ELSE @@ -3197,25 +3197,25 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & DO i = 1, SIZE(mixed_cdft%dlb_control%target_list, 2) buffsize = mixed_cdft%dlb_control%target_list(2, i) ! Unique communicator tags (dont actually need these, should be removed) - tags = (/(i-1)*3+1+force_env%para_env%mepos*6*max_targets, & - (i-1)*3+1+3*max_targets+force_env%para_env%mepos*6*max_targets/) + tags = (/(i - 1)*3 + 1 + force_env%para_env%mepos*6*max_targets, & + (i - 1)*3 + 1 + 3*max_targets + force_env%para_env%mepos*6*max_targets/) DO j = 4, SIZE(mixed_cdft%dlb_control%target_list, 1) IF (mixed_cdft%dlb_control%target_list(j, i) .GT. uninitialized) EXIT END DO offset_special = j - offset_proc = j-4-(j-4)/2 + offset_proc = j - 4 - (j - 4)/2 CALL mp_isend(msgin=buffsize, & dest=mixed_cdft%dlb_control%target_list(1, i), & request=req(1), comm=force_env%para_env%group) CALL mp_wait(req(1)) ALLOCATE (sendbuffer(12*buffsize(1))) DO j = 1, buffsize(1) - sendbuffer(12*(j-1)+1:12*(j-1)+12) = (/mixed_cdft%dlb_control%target_list(offset_special+2*(j-1), i), & - mixed_cdft%dlb_control%target_list(offset_special+2*j-1, i), & - bo_conf(1, 2), bo_conf(2, 2), bo(1, 3), bo(2, 3), & - bo_conf(1, 3), bo_conf(2, 3), tags(1), tags(2), & - mixed_cdft%dest_list(j+offset_proc), & - mixed_cdft%dest_list(j+offset_proc)+force_env%para_env%num_pe/2/) + sendbuffer(12*(j - 1) + 1:12*(j - 1) + 12) = (/mixed_cdft%dlb_control%target_list(offset_special + 2*(j - 1), i), & + mixed_cdft%dlb_control%target_list(offset_special + 2*j - 1, i), & + bo_conf(1, 2), bo_conf(2, 2), bo(1, 3), bo(2, 3), & + bo_conf(1, 3), bo_conf(2, 3), tags(1), tags(2), & + mixed_cdft%dest_list(j + offset_proc), & + mixed_cdft%dest_list(j + offset_proc) + force_env%para_env%num_pe/2/) END DO CALL mp_isend(msgin=sendbuffer, & dest=mixed_cdft%dlb_control%target_list(1, i), & @@ -3223,8 +3223,8 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & CALL mp_wait(req(1)) DEALLOCATE (sendbuffer) DO j = 1, buffsize(1) - ALLOCATE (cavity(mixed_cdft%dlb_control%target_list(offset_special+2*(j-1), i): & - mixed_cdft%dlb_control%target_list(offset_special+2*j-1, i), & + ALLOCATE (cavity(mixed_cdft%dlb_control%target_list(offset_special + 2*(j - 1), i): & + mixed_cdft%dlb_control%target_list(offset_special + 2*j - 1, i), & bo_conf(1, 2):bo_conf(2, 2), bo_conf(1, 3):bo_conf(2, 3))) cavity = cdft_control%becke_control%cavity%pw%cr3d(LBOUND(cavity, 1):UBOUND(cavity, 1), & bo_conf(1, 2):bo_conf(2, 2), & @@ -3255,7 +3255,7 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & my_special_work = 1 END IF ALLOCATE (recvbuffer(SIZE(mixed_cdft%source_list)), sbuff(SIZE(mixed_cdft%dest_list))) - ALLOCATE (req_total(my_special_work*SIZE(mixed_cdft%source_list)+(my_special_work**2)*SIZE(mixed_cdft%dest_list))) + ALLOCATE (req_total(my_special_work*SIZE(mixed_cdft%source_list) + (my_special_work**2)*SIZE(mixed_cdft%dest_list))) ALLOCATE (mixed_cdft%dlb_control%recv_work_repl(SIZE(mixed_cdft%source_list))) DO i = 1, SIZE(mixed_cdft%source_list) NULLIFY (recvbuffer(i)%bv, recvbuffer(i)%iv) @@ -3266,7 +3266,7 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & IF (mixed_cdft%is_special) & CALL mp_irecv(msgout=recvbuffer(i)%iv, & source=mixed_cdft%source_list(i), & - request=req_total(i+SIZE(mixed_cdft%source_list)), & + request=req_total(i + SIZE(mixed_cdft%source_list)), & tag=2, comm=force_env%para_env%group) END DO DO i = 1, my_special_work @@ -3285,8 +3285,8 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & IF (touched(j)) THEN nsend = 0 DO ispecial = 1, SIZE(mixed_cdft%dlb_control%target_list, 2) - IF (mixed_cdft%dlb_control%target_list(4+2*(j-1), ispecial) .NE. uninitialized) & - nsend = nsend+1 + IF (mixed_cdft%dlb_control%target_list(4 + 2*(j - 1), ispecial) .NE. uninitialized) & + nsend = nsend + 1 END DO sbuff(j)%iv(3) = nsend nsend_proc(j) = nsend @@ -3294,15 +3294,15 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & END IF END IF END IF - ind = j+(i-1)*SIZE(mixed_cdft%dest_list)+my_special_work*SIZE(mixed_cdft%source_list) + ind = j + (i - 1)*SIZE(mixed_cdft%dest_list) + my_special_work*SIZE(mixed_cdft%source_list) CALL mp_isend(msgin=sbuff(j)%bv, & - dest=mixed_cdft%dest_list(j)+(i-1)*force_env%para_env%num_pe/2, & + dest=mixed_cdft%dest_list(j) + (i - 1)*force_env%para_env%num_pe/2, & request=req_total(ind), tag=1, & comm=force_env%para_env%group) IF (mixed_cdft%is_special) & CALL mp_isend(msgin=sbuff(j)%iv, & - dest=mixed_cdft%dest_list(j)+(i-1)*force_env%para_env%num_pe/2, & - request=req_total(ind+2*SIZE(mixed_cdft%dest_list)), tag=2, & + dest=mixed_cdft%dest_list(j) + (i - 1)*force_env%para_env%num_pe/2, & + request=req_total(ind + 2*SIZE(mixed_cdft%dest_list)), tag=2, & comm=force_env%para_env%group) END DO END DO @@ -3331,7 +3331,7 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & IF (.NOT. mixed_cdft%is_special) THEN IF (mixed_cdft%dlb_control%send_work) THEN - ALLOCATE (req_total(COUNT(mixed_cdft%dlb_control%recv_work_repl)+2)) + ALLOCATE (req_total(COUNT(mixed_cdft%dlb_control%recv_work_repl) + 2)) ALLOCATE (sendbuffer(6)) IF (mixed_cdft%is_pencil) THEN sendbuffer = (/SIZE(mixed_cdft%dlb_control%target_list, 2), bo_conf(1, 3), bo_conf(2, 3), & @@ -3351,12 +3351,12 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & END IF ! First communicate which grid points were distributed IF (mixed_cdft%dlb_control%send_work) THEN - ind = COUNT(mixed_cdft%dlb_control%recv_work_repl)+1 + ind = COUNT(mixed_cdft%dlb_control%recv_work_repl) + 1 DO i = 1, 2 CALL mp_isend(msgin=sendbuffer, & dest=mixed_cdft%dest_list(i), & request=req_total(ind), comm=force_env%para_env%group) - ind = ind+1 + ind = ind + 1 END DO END IF IF (ANY(mixed_cdft%dlb_control%recv_work_repl)) THEN @@ -3367,7 +3367,7 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & CALL mp_irecv(msgout=mixed_cdft%dlb_control%recv_info(i)%matrix_info, & source=mixed_cdft%source_list(i), & request=req_total(ind), comm=force_env%para_env%group) - ind = ind+1 + ind = ind + 1 END IF END DO END IF @@ -3376,14 +3376,14 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & END IF ! Now communicate which processor handles which grid points IF (mixed_cdft%dlb_control%send_work) THEN - ind = COUNT(mixed_cdft%dlb_control%recv_work_repl)+1 + ind = COUNT(mixed_cdft%dlb_control%recv_work_repl) + 1 DO i = 1, 2 IF (i == 2) & - mixed_cdft%dlb_control%target_list(3, :) = mixed_cdft%dlb_control%target_list(3, :)+3*max_targets + mixed_cdft%dlb_control%target_list(3, :) = mixed_cdft%dlb_control%target_list(3, :) + 3*max_targets CALL mp_isend(msgin=mixed_cdft%dlb_control%target_list, & dest=mixed_cdft%dest_list(i), & request=req_total(ind), comm=force_env%para_env%group) - ind = ind+1 + ind = ind + 1 END DO END IF IF (ANY(mixed_cdft%dlb_control%recv_work_repl)) THEN @@ -3395,7 +3395,7 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & CALL mp_irecv(msgout=mixed_cdft%dlb_control%recv_info(i)%target_list, & source=mixed_cdft%source_list(i), & request=req_total(ind), comm=force_env%para_env%group) - ind = ind+1 + ind = ind + 1 END IF END DO END IF @@ -3406,7 +3406,7 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & IF (ASSOCIATED(sendbuffer)) DEALLOCATE (sendbuffer) ELSE IF (mixed_cdft%dlb_control%send_work) THEN - ALLOCATE (req_total(COUNT(mixed_cdft%dlb_control%recv_work_repl)+2*COUNT(touched))) + ALLOCATE (req_total(COUNT(mixed_cdft%dlb_control%recv_work_repl) + 2*COUNT(touched))) ELSE IF (ANY(mixed_cdft%dlb_control%recv_work_repl)) THEN ALLOCATE (req_total(COUNT(mixed_cdft%dlb_control%recv_work_repl))) END IF @@ -3414,23 +3414,23 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & ind = COUNT(mixed_cdft%dlb_control%recv_work_repl) DO j = 1, SIZE(mixed_cdft%dest_list) IF (touched(j)) THEN - ALLOCATE (sbuff(j)%iv(4+3*nsend_proc(j))) + ALLOCATE (sbuff(j)%iv(4 + 3*nsend_proc(j))) sbuff(j)%iv(1:4) = (/bo_conf(1, 2), bo_conf(2, 2), bo_conf(1, 3), bo_conf(2, 3)/) offset = 5 DO i = 1, SIZE(mixed_cdft%dlb_control%target_list, 2) - IF (mixed_cdft%dlb_control%target_list(4+2*(j-1), i) .NE. uninitialized) THEN - sbuff(j)%iv(offset:offset+2) = (/mixed_cdft%dlb_control%target_list(1, i), & - mixed_cdft%dlb_control%target_list(4+2*(j-1), i), & - mixed_cdft%dlb_control%target_list(4+2*j-1, i)/) - offset = offset+3 + IF (mixed_cdft%dlb_control%target_list(4 + 2*(j - 1), i) .NE. uninitialized) THEN + sbuff(j)%iv(offset:offset + 2) = (/mixed_cdft%dlb_control%target_list(1, i), & + mixed_cdft%dlb_control%target_list(4 + 2*(j - 1), i), & + mixed_cdft%dlb_control%target_list(4 + 2*j - 1, i)/) + offset = offset + 3 END IF END DO DO ispecial = 1, my_special_work CALL mp_isend(msgin=sbuff(j)%iv, & - dest=mixed_cdft%dest_list(j)+(ispecial-1)*force_env%para_env%num_pe/2, & - request=req_total(ind+ispecial), comm=force_env%para_env%group) + dest=mixed_cdft%dest_list(j) + (ispecial - 1)*force_env%para_env%num_pe/2, & + request=req_total(ind + ispecial), comm=force_env%para_env%group) END DO - ind = ind+my_special_work + ind = ind + my_special_work END IF END DO END IF @@ -3442,11 +3442,11 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & NULLIFY (mixed_cdft%dlb_control%recv_info(j)%target_list, & mixed_cdft%dlb_control%recvbuff(j)%buffs) IF (mixed_cdft%dlb_control%recv_work_repl(j)) THEN - ALLOCATE (mixed_cdft%dlb_control%recv_info(j)%matrix_info(4+3*nrecv(j))) + ALLOCATE (mixed_cdft%dlb_control%recv_info(j)%matrix_info(4 + 3*nrecv(j))) CALL mp_irecv(mixed_cdft%dlb_control%recv_info(j)%matrix_info, & source=mixed_cdft%source_list(j), & request=req_total(ind), comm=force_env%para_env%group) - ind = ind+1 + ind = ind + 1 END IF END DO END IF @@ -3455,14 +3455,14 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & DEALLOCATE (req_total) END IF IF (ANY(mask_send)) THEN - ALLOCATE (tmp(SIZE(mixed_cdft%dest_list)-COUNT(mask_send)), & - tmp_bo(2, SIZE(mixed_cdft%dest_list)-COUNT(mask_send))) + ALLOCATE (tmp(SIZE(mixed_cdft%dest_list) - COUNT(mask_send)), & + tmp_bo(2, SIZE(mixed_cdft%dest_list) - COUNT(mask_send))) i = 1 DO j = 1, SIZE(mixed_cdft%dest_list) IF (.NOT. mask_send(j)) THEN tmp(i) = mixed_cdft%dest_list(j) tmp_bo(1:2, i) = mixed_cdft%dest_list_bo(1:2, j) - i = i+1 + i = i + 1 END IF END DO DEALLOCATE (mixed_cdft%dest_list, mixed_cdft%dest_list_bo) @@ -3472,14 +3472,14 @@ SUBROUTINE mixed_becke_constraint_dlb(force_env, mixed_cdft, my_work, & DEALLOCATE (tmp, tmp_bo) END IF IF (ANY(mask_recv)) THEN - ALLOCATE (tmp(SIZE(mixed_cdft%source_list)-COUNT(mask_recv)), & - tmp_bo(4, SIZE(mixed_cdft%source_list)-COUNT(mask_recv))) + ALLOCATE (tmp(SIZE(mixed_cdft%source_list) - COUNT(mask_recv)), & + tmp_bo(4, SIZE(mixed_cdft%source_list) - COUNT(mask_recv))) i = 1 DO j = 1, SIZE(mixed_cdft%source_list) IF (.NOT. mask_recv(j)) THEN tmp(i) = mixed_cdft%source_list(j) tmp_bo(1:4, i) = mixed_cdft%source_list_bo(1:4, j) - i = i+1 + i = i + 1 END IF END DO DEALLOCATE (mixed_cdft%source_list, mixed_cdft%source_list_bo) @@ -3642,7 +3642,7 @@ SUBROUTINE mixed_becke_constraint_low(force_env, mixed_cdft, in_memory, & IF (.NOT. mixed_cdft%is_special) THEN offset_repl = 0 IF (mixed_cdft%dlb_control%recv_work_repl(1) .AND. mixed_cdft%dlb_control%recv_work_repl(2)) THEN - ALLOCATE (req_recv(3*(SIZE(mixed_cdft%dlb_control%recv_info(1)%target_list, 2)+ & + ALLOCATE (req_recv(3*(SIZE(mixed_cdft%dlb_control%recv_info(1)%target_list, 2) + & SIZE(mixed_cdft%dlb_control%recv_info(2)%target_list, 2)))) offset_repl = 3*SIZE(mixed_cdft%dlb_control%recv_info(1)%target_list, 2) ELSE IF (mixed_cdft%dlb_control%recv_work_repl(1)) THEN @@ -3655,7 +3655,7 @@ SUBROUTINE mixed_becke_constraint_low(force_env, mixed_cdft, in_memory, & offset_repl = 1 DO j = 1, SIZE(mixed_cdft%dlb_control%recv_work_repl) IF (mixed_cdft%dlb_control%recv_work_repl(j)) THEN - nbuffs = nbuffs+(SIZE(mixed_cdft%dlb_control%recv_info(j)%matrix_info)-4)/3 + nbuffs = nbuffs + (SIZE(mixed_cdft%dlb_control%recv_info(j)%matrix_info) - 4)/3 END IF END DO ALLOCATE (req_recv(3*nbuffs)) @@ -3664,31 +3664,31 @@ SUBROUTINE mixed_becke_constraint_low(force_env, mixed_cdft, in_memory, & IF (mixed_cdft%dlb_control%recv_work_repl(j)) THEN IF (.NOT. mixed_cdft%is_special) THEN offset = 0 - index = j+(j/2) + index = j + (j/2) ALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs(SIZE(mixed_cdft%dlb_control%recv_info(j)%target_list, 2))) DO i = 1, SIZE(mixed_cdft%dlb_control%recv_info(j)%target_list, 2) IF (mixed_cdft%is_pencil) THEN ALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs(i)% & - weight(mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset: & - mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset+ & - (mixed_cdft%dlb_control%recv_info(j)%target_list(2, i)-1), & + weight(mixed_cdft%dlb_control%recv_info(j)%matrix_info(4) + offset: & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(4) + offset + & + (mixed_cdft%dlb_control%recv_info(j)%target_list(2, i) - 1), & mixed_cdft%dlb_control%recv_info(j)%matrix_info(5): & mixed_cdft%dlb_control%recv_info(j)%matrix_info(6), & mixed_cdft%dlb_control%recv_info(j)%matrix_info(2): & mixed_cdft%dlb_control%recv_info(j)%matrix_info(3))) ALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs(i)% & - cavity(mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset: & - mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset+ & - (mixed_cdft%dlb_control%recv_info(j)%target_list(2, i)-1), & + cavity(mixed_cdft%dlb_control%recv_info(j)%matrix_info(4) + offset: & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(4) + offset + & + (mixed_cdft%dlb_control%recv_info(j)%target_list(2, i) - 1), & mixed_cdft%dlb_control%recv_info(j)%matrix_info(5): & mixed_cdft%dlb_control%recv_info(j)%matrix_info(6), & mixed_cdft%dlb_control%recv_info(j)%matrix_info(2): & mixed_cdft%dlb_control%recv_info(j)%matrix_info(3))) ALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs(i)% & gradients(3*natom, & - mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset: & - mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset+ & - (mixed_cdft%dlb_control%recv_info(j)%target_list(2, i)-1), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(4) + offset: & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(4) + offset + & + (mixed_cdft%dlb_control%recv_info(j)%target_list(2, i) - 1), & mixed_cdft%dlb_control%recv_info(j)%matrix_info(5): & mixed_cdft%dlb_control%recv_info(j)%matrix_info(6), & mixed_cdft%dlb_control%recv_info(j)%matrix_info(2): & @@ -3697,88 +3697,88 @@ SUBROUTINE mixed_becke_constraint_low(force_env, mixed_cdft, in_memory, & ALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs(i)% & weight(mixed_cdft%dlb_control%recv_info(j)%matrix_info(5): & mixed_cdft%dlb_control%recv_info(j)%matrix_info(6), & - mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset: & - mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset+ & - (mixed_cdft%dlb_control%recv_info(j)%target_list(2, i)-1), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(4) + offset: & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(4) + offset + & + (mixed_cdft%dlb_control%recv_info(j)%target_list(2, i) - 1), & mixed_cdft%dlb_control%recv_info(j)%matrix_info(2): & mixed_cdft%dlb_control%recv_info(j)%matrix_info(3))) ALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs(i)% & cavity(mixed_cdft%dlb_control%recv_info(j)%matrix_info(5): & mixed_cdft%dlb_control%recv_info(j)%matrix_info(6), & - mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset: & - mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset+ & - (mixed_cdft%dlb_control%recv_info(j)%target_list(2, i)-1), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(4) + offset: & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(4) + offset + & + (mixed_cdft%dlb_control%recv_info(j)%target_list(2, i) - 1), & mixed_cdft%dlb_control%recv_info(j)%matrix_info(2): & mixed_cdft%dlb_control%recv_info(j)%matrix_info(3))) ALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs(i)% & gradients(3*natom, & mixed_cdft%dlb_control%recv_info(j)%matrix_info(5): & mixed_cdft%dlb_control%recv_info(j)%matrix_info(6), & - mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset: & - mixed_cdft%dlb_control%recv_info(j)%matrix_info(4)+offset+ & - (mixed_cdft%dlb_control%recv_info(j)%target_list(2, i)-1), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(4) + offset: & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(4) + offset + & + (mixed_cdft%dlb_control%recv_info(j)%target_list(2, i) - 1), & mixed_cdft%dlb_control%recv_info(j)%matrix_info(2): & mixed_cdft%dlb_control%recv_info(j)%matrix_info(3))) END IF CALL mp_irecv(msgout=mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%cavity, & source=mixed_cdft%dlb_control%recv_info(j)%target_list(1, i), & - request=req_recv(3*(i-1)+(j-1)*offset_repl+1), & + request=req_recv(3*(i - 1) + (j - 1)*offset_repl + 1), & comm=force_env%para_env%group, & tag=mixed_cdft%dlb_control%recv_info(j)%target_list(3, i)) CALL mp_irecv(msgout=mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%weight, & source=mixed_cdft%dlb_control%recv_info(j)%target_list(1, i), & - request=req_recv(3*(i-1)+(j-1)*offset_repl+2), & + request=req_recv(3*(i - 1) + (j - 1)*offset_repl + 2), & comm=force_env%para_env%group, & - tag=mixed_cdft%dlb_control%recv_info(j)%target_list(3, i)+1) + tag=mixed_cdft%dlb_control%recv_info(j)%target_list(3, i) + 1) CALL mp_irecv(msgout=mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%gradients, & source=mixed_cdft%dlb_control%recv_info(j)%target_list(1, i), & - request=req_recv(3*(i-1)+(j-1)*offset_repl+3), & + request=req_recv(3*(i - 1) + (j - 1)*offset_repl + 3), & comm=force_env%para_env%group, & - tag=mixed_cdft%dlb_control%recv_info(j)%target_list(3, i)+2) - offset = offset+mixed_cdft%dlb_control%recv_info(j)%target_list(2, i) + tag=mixed_cdft%dlb_control%recv_info(j)%target_list(3, i) + 2) + offset = offset + mixed_cdft%dlb_control%recv_info(j)%target_list(2, i) END DO DEALLOCATE (mixed_cdft%dlb_control%recv_info(j)%matrix_info) ELSE ALLOCATE (mixed_cdft%dlb_control%recvbuff(j)% & - buffs((SIZE(mixed_cdft%dlb_control%recv_info(j)%matrix_info)-4)/3)) + buffs((SIZE(mixed_cdft%dlb_control%recv_info(j)%matrix_info) - 4)/3)) index = 6 DO i = 1, SIZE(mixed_cdft%dlb_control%recvbuff(j)%buffs) ALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs(i)% & weight(mixed_cdft%dlb_control%recv_info(j)%matrix_info(index): & - mixed_cdft%dlb_control%recv_info(j)%matrix_info(index+1), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(index + 1), & mixed_cdft%dlb_control%recv_info(j)%matrix_info(1): & mixed_cdft%dlb_control%recv_info(j)%matrix_info(2), & mixed_cdft%dlb_control%recv_info(j)%matrix_info(3): & mixed_cdft%dlb_control%recv_info(j)%matrix_info(4))) ALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs(i)% & cavity(mixed_cdft%dlb_control%recv_info(j)%matrix_info(index): & - mixed_cdft%dlb_control%recv_info(j)%matrix_info(index+1), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(index + 1), & mixed_cdft%dlb_control%recv_info(j)%matrix_info(1): & mixed_cdft%dlb_control%recv_info(j)%matrix_info(2), & mixed_cdft%dlb_control%recv_info(j)%matrix_info(3): & mixed_cdft%dlb_control%recv_info(j)%matrix_info(4))) ALLOCATE (mixed_cdft%dlb_control%recvbuff(j)%buffs(i)% & gradients(3*natom, mixed_cdft%dlb_control%recv_info(j)%matrix_info(index): & - mixed_cdft%dlb_control%recv_info(j)%matrix_info(index+1), & + mixed_cdft%dlb_control%recv_info(j)%matrix_info(index + 1), & mixed_cdft%dlb_control%recv_info(j)%matrix_info(1): & mixed_cdft%dlb_control%recv_info(j)%matrix_info(2), & mixed_cdft%dlb_control%recv_info(j)%matrix_info(3): & mixed_cdft%dlb_control%recv_info(j)%matrix_info(4))) CALL mp_irecv(msgout=mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%cavity, & - source=mixed_cdft%dlb_control%recv_info(j)%matrix_info(index-1), & + source=mixed_cdft%dlb_control%recv_info(j)%matrix_info(index - 1), & request=req_recv(offset_repl), & comm=force_env%para_env%group, tag=1) CALL mp_irecv(msgout=mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%weight, & - source=mixed_cdft%dlb_control%recv_info(j)%matrix_info(index-1), & - request=req_recv(offset_repl+1), & + source=mixed_cdft%dlb_control%recv_info(j)%matrix_info(index - 1), & + request=req_recv(offset_repl + 1), & comm=force_env%para_env%group, tag=2) CALL mp_irecv(msgout=mixed_cdft%dlb_control%recvbuff(j)%buffs(i)%gradients, & - source=mixed_cdft%dlb_control%recv_info(j)%matrix_info(index-1), & - request=req_recv(offset_repl+2), & + source=mixed_cdft%dlb_control%recv_info(j)%matrix_info(index - 1), & + request=req_recv(offset_repl + 2), & comm=force_env%para_env%group, tag=3) - index = index+3 - offset_repl = offset_repl+3 + index = index + 3 + offset_repl = offset_repl + 3 END DO DEALLOCATE (mixed_cdft%dlb_control%recv_info(j)%matrix_info) END IF @@ -3851,8 +3851,8 @@ SUBROUTINE mixed_becke_constraint_low(force_env, mixed_cdft, in_memory, & IF (nsent(jcomm, icomm) == 1) CYCLE CALL mp_test(req_send(jcomm, icomm), completed(jcomm, icomm)) IF (completed(jcomm, icomm)) THEN - nsent(jcomm, icomm) = nsent(jcomm, icomm)+1 - nsent_total = nsent_total+1 + nsent(jcomm, icomm) = nsent(jcomm, icomm) + 1 + nsent_total = nsent_total + 1 IF (nsent_total == SIZE(nsent, 1)*SIZE(nsent, 2)) should_communicate = .FALSE. END IF IF (ALL(completed(:, icomm))) THEN @@ -3860,19 +3860,19 @@ SUBROUTINE mixed_becke_constraint_low(force_env, mixed_cdft, in_memory, & IF (.NOT. mixed_cdft%is_special) THEN DEALLOCATE (mixed_cdft%dlb_control%cavity) ELSE - DEALLOCATE (mixed_cdft%dlb_control%sendbuff((icomm-1)/3+1)%cavity) + DEALLOCATE (mixed_cdft%dlb_control%sendbuff((icomm - 1)/3 + 1)%cavity) END IF ELSE IF (MODULO(icomm, 3) == 2) THEN IF (.NOT. mixed_cdft%is_special) THEN DEALLOCATE (mixed_cdft%dlb_control%weight) ELSE - DEALLOCATE (mixed_cdft%dlb_control%sendbuff((icomm-1)/3+1)%weight) + DEALLOCATE (mixed_cdft%dlb_control%sendbuff((icomm - 1)/3 + 1)%weight) END IF ELSE IF (.NOT. mixed_cdft%is_special) THEN DEALLOCATE (mixed_cdft%dlb_control%gradients) ELSE - DEALLOCATE (mixed_cdft%dlb_control%sendbuff((icomm-1)/3+1)%gradients) + DEALLOCATE (mixed_cdft%dlb_control%sendbuff((icomm - 1)/3 + 1)%gradients) END IF END IF END IF @@ -3887,9 +3887,9 @@ SUBROUTINE mixed_becke_constraint_low(force_env, mixed_cdft, in_memory, & IF (cdft_control%becke_control%cavity_confine) THEN IF (cavity(k, j, i) < cdft_control%becke_control%eps_cavity) CYCLE END IF - grid_p(1) = k*dr(1)+shift(1) - grid_p(2) = j*dr(2)+shift(2) - grid_p(3) = i*dr(3)+shift(3) + grid_p(1) = k*dr(1) + shift(1) + grid_p(2) = j*dr(2) + shift(2) + grid_p(3) = i*dr(3) + shift(3) nskipped = 0 cell_functions = 1.0_dp skip_me = .FALSE. @@ -3903,7 +3903,7 @@ SUBROUTINE mixed_becke_constraint_low(force_env, mixed_cdft, in_memory, & IF (skip_me(iatom)) THEN cell_functions(iatom) = 0.0_dp IF (cdft_control%becke_control%should_skip) THEN - IF (is_constraint(iatom)) nskipped = nskipped+1 + IF (is_constraint(iatom)) nskipped = nskipped + 1 IF (nskipped == cdft_control%natoms) THEN IF (in_memory) THEN IF (cdft_control%becke_control%cavity_confine) THEN @@ -3918,7 +3918,7 @@ SUBROUTINE mixed_becke_constraint_low(force_env, mixed_cdft, in_memory, & IF (store_vectors) THEN IF (distances(iatom) .EQ. 0.0_dp) THEN r = position_vecs(:, iatom) - dist_vec = (r-grid_p)-ANINT((r-grid_p)/cell_v)*cell_v + dist_vec = (r - grid_p) - ANINT((r - grid_p)/cell_v)*cell_v dist1 = SQRT(DOT_PRODUCT(dist_vec, dist_vec)) distance_vecs(:, iatom) = dist_vec distances(iatom) = dist1 @@ -3929,9 +3929,9 @@ SUBROUTINE mixed_becke_constraint_low(force_env, mixed_cdft, in_memory, & ELSE r = particle_set(iatom)%r DO ip = 1, 3 - r(ip) = MODULO(r(ip), cell%hmat(ip, ip))-cell%hmat(ip, ip)/2._dp + r(ip) = MODULO(r(ip), cell%hmat(ip, ip)) - cell%hmat(ip, ip)/2._dp END DO - dist_vec = (r-grid_p)-ANINT((r-grid_p)/cell_v)*cell_v + dist_vec = (r - grid_p) - ANINT((r - grid_p)/cell_v)*cell_v dist1 = SQRT(DOT_PRODUCT(dist_vec, dist_vec)) END IF IF (dist1 .LE. cutoffs(iatom)) THEN @@ -3947,7 +3947,7 @@ SUBROUTINE mixed_becke_constraint_low(force_env, mixed_cdft, in_memory, & IF (store_vectors) THEN IF (distances(jatom) .EQ. 0.0_dp) THEN r1 = position_vecs(:, jatom) - dist_vec = (r1-grid_p)-ANINT((r1-grid_p)/cell_v)*cell_v + dist_vec = (r1 - grid_p) - ANINT((r1 - grid_p)/cell_v)*cell_v dist2 = SQRT(DOT_PRODUCT(dist_vec, dist_vec)) distance_vecs(:, jatom) = dist_vec distances(jatom) = dist2 @@ -3958,63 +3958,63 @@ SUBROUTINE mixed_becke_constraint_low(force_env, mixed_cdft, in_memory, & ELSE r1 = particle_set(jatom)%r DO ip = 1, 3 - r1(ip) = MODULO(r1(ip), cell%hmat(ip, ip))-cell%hmat(ip, ip)/2._dp + r1(ip) = MODULO(r1(ip), cell%hmat(ip, ip)) - cell%hmat(ip, ip)/2._dp END DO - dist_vec = (r1-grid_p)-ANINT((r1-grid_p)/cell_v)*cell_v + dist_vec = (r1 - grid_p) - ANINT((r1 - grid_p)/cell_v)*cell_v dist2 = SQRT(DOT_PRODUCT(dist_vec, dist_vec)) END IF IF (in_memory) THEN IF (store_vectors) THEN dr1_r2 = pair_dist_vecs(:, iatom, jatom) ELSE - dr1_r2 = (r-r1)-ANINT((r-r1)/cell_v)*cell_v + dr1_r2 = (r - r1) - ANINT((r - r1)/cell_v)*cell_v END IF IF (dist2 .LE. th) dist2 = th tmp_const = (R12(iatom, jatom)**3) dr_ij_dR(:) = dr1_r2(:)/tmp_const !derivativ w.r.t. Rj dr_j_dR = dist_vec(:)/dist2 - dmy_dR_j(:) = -(dr_j_dR(:)/R12(iatom, jatom)-(dist1-dist2)*dr_ij_dR(:)) + dmy_dR_j(:) = -(dr_j_dR(:)/R12(iatom, jatom) - (dist1 - dist2)*dr_ij_dR(:)) !derivativ w.r.t. Ri - dmy_dR_i(:) = dr_i_dR(:)/R12(iatom, jatom)-(dist1-dist2)*dr_ij_dR(:) + dmy_dR_i(:) = dr_i_dR(:)/R12(iatom, jatom) - (dist1 - dist2)*dr_ij_dR(:) END IF - my1 = (dist1-dist2)/R12(iatom, jatom) + my1 = (dist1 - dist2)/R12(iatom, jatom) IF (cdft_control%becke_control%adjust) THEN my1_homo = my1 - my1 = my1+ & - cdft_control%becke_control%aij(iatom, jatom)*(1.0_dp-my1**2) + my1 = my1 + & + cdft_control%becke_control%aij(iatom, jatom)*(1.0_dp - my1**2) END IF - myexp = 1.5_dp*my1-0.5_dp*my1**3 + myexp = 1.5_dp*my1 - 0.5_dp*my1**3 IF (in_memory) THEN - dmyexp = 1.5_dp-1.5_dp*my1**2 - tmp_const = (1.5_dp**2)*dmyexp*(1-myexp**2)* & - (1.0_dp-((1.5_dp*myexp-0.5_dp*(myexp**3))**2)) + dmyexp = 1.5_dp - 1.5_dp*my1**2 + tmp_const = (1.5_dp**2)*dmyexp*(1 - myexp**2)* & + (1.0_dp - ((1.5_dp*myexp - 0.5_dp*(myexp**3))**2)) ds_dR_i(:) = -0.5_dp*tmp_const*dmy_dR_i(:) ds_dR_j(:) = -0.5_dp*tmp_const*dmy_dR_j(:) IF (cdft_control%becke_control%adjust) THEN - tmp_const = 1.0_dp-2.0_dp*my1_homo*cdft_control%becke_control%aij(iatom, jatom) + tmp_const = 1.0_dp - 2.0_dp*my1_homo*cdft_control%becke_control%aij(iatom, jatom) ds_dR_i(:) = ds_dR_i(:)*tmp_const ds_dR_j(:) = ds_dR_j(:)*tmp_const END IF END IF - myexp = 1.5_dp*myexp-0.5_dp*myexp**3 - myexp = 1.5_dp*myexp-0.5_dp*myexp**3 - tmp_const = 0.5_dp*(1.0_dp-myexp) + myexp = 1.5_dp*myexp - 0.5_dp*myexp**3 + myexp = 1.5_dp*myexp - 0.5_dp*myexp**3 + tmp_const = 0.5_dp*(1.0_dp - myexp) cell_functions(iatom) = cell_functions(iatom)*tmp_const IF (in_memory) THEN - IF (ABS(tmp_const) .LE. th) tmp_const = tmp_const+th - dP_i_dRi(:, iatom) = dP_i_dRi(:, iatom)+ds_dR_i(:)/tmp_const + IF (ABS(tmp_const) .LE. th) tmp_const = tmp_const + th + dP_i_dRi(:, iatom) = dP_i_dRi(:, iatom) + ds_dR_i(:)/tmp_const dP_i_dRj(:, iatom, jatom) = ds_dR_j(:)/tmp_const END IF IF (dist2 .LE. cutoffs(jatom)) THEN - tmp_const = 0.5_dp*(1.0_dp+myexp) + tmp_const = 0.5_dp*(1.0_dp + myexp) cell_functions(jatom) = cell_functions(jatom)*tmp_const IF (in_memory) THEN - IF (ABS(tmp_const) .LE. th) tmp_const = tmp_const+th + IF (ABS(tmp_const) .LE. th) tmp_const = tmp_const + th dP_i_dRj(:, jatom, iatom) = -ds_dR_i(:)/tmp_const - dP_i_dRi(:, jatom) = dP_i_dRi(:, jatom)-ds_dR_j(:)/tmp_const + dP_i_dRi(:, jatom) = dP_i_dRi(:, jatom) - ds_dR_j(:)/tmp_const END IF ELSE skip_me(jatom) = .TRUE. @@ -4023,27 +4023,27 @@ SUBROUTINE mixed_becke_constraint_low(force_env, mixed_cdft, in_memory, & END DO IF (in_memory) THEN dP_i_dRi(:, iatom) = cell_functions(iatom)*dP_i_dRi(:, iatom) - d_sum_Pm_dR(:, iatom) = d_sum_Pm_dR(:, iatom)+dP_i_dRi(:, iatom) + d_sum_Pm_dR(:, iatom) = d_sum_Pm_dR(:, iatom) + dP_i_dRi(:, iatom) IF (is_constraint(iatom)) & - d_sum_const_dR(:, iatom) = d_sum_const_dR(:, iatom)+dP_i_dRi(:, iatom)* & + d_sum_const_dR(:, iatom) = d_sum_const_dR(:, iatom) + dP_i_dRi(:, iatom)* & coefficients(iatom) DO jatom = 1, natom IF (jatom .NE. iatom) THEN IF (jatom < iatom) THEN IF (.NOT. skip_me(jatom)) THEN dP_i_dRj(:, iatom, jatom) = cell_functions(iatom)*dP_i_dRj(:, iatom, jatom) - d_sum_Pm_dR(:, jatom) = d_sum_Pm_dR(:, jatom)+dP_i_dRj(:, iatom, jatom) + d_sum_Pm_dR(:, jatom) = d_sum_Pm_dR(:, jatom) + dP_i_dRj(:, iatom, jatom) IF (is_constraint(iatom)) & - d_sum_const_dR(:, jatom) = d_sum_const_dR(:, jatom)+ & + d_sum_const_dR(:, jatom) = d_sum_const_dR(:, jatom) + & dP_i_dRj(:, iatom, jatom)* & coefficients(iatom) CYCLE END IF END IF dP_i_dRj(:, iatom, jatom) = cell_functions(iatom)*dP_i_dRj(:, iatom, jatom) - d_sum_Pm_dR(:, jatom) = d_sum_Pm_dR(:, jatom)+dP_i_dRj(:, iatom, jatom) + d_sum_Pm_dR(:, jatom) = d_sum_Pm_dR(:, jatom) + dP_i_dRj(:, iatom, jatom) IF (is_constraint(iatom)) & - d_sum_const_dR(:, jatom) = d_sum_const_dR(:, jatom)+dP_i_dRj(:, iatom, jatom)* & + d_sum_const_dR(:, jatom) = d_sum_const_dR(:, jatom) + dP_i_dRj(:, iatom, jatom)* & coefficients(iatom) END IF END DO @@ -4052,7 +4052,7 @@ SUBROUTINE mixed_becke_constraint_low(force_env, mixed_cdft, in_memory, & cell_functions(iatom) = 0.0_dp skip_me(iatom) = .TRUE. IF (cdft_control%becke_control%should_skip) THEN - IF (is_constraint(iatom)) nskipped = nskipped+1 + IF (is_constraint(iatom)) nskipped = nskipped + 1 IF (nskipped == cdft_control%natoms) THEN IF (in_memory) THEN IF (cdft_control%becke_control%cavity_confine) THEN @@ -4067,19 +4067,19 @@ SUBROUTINE mixed_becke_constraint_low(force_env, mixed_cdft, in_memory, & IF (nskipped == cdft_control%natoms) CYCLE sum_cell_f_constr = 0.0_dp DO ip = 1, cdft_control%natoms - sum_cell_f_constr = sum_cell_f_constr+cell_functions(catom(ip))* & + sum_cell_f_constr = sum_cell_f_constr + cell_functions(catom(ip))* & cdft_control%group(1)%coeff(ip) END DO sum_cell_f_all = 0.0_dp - nwork = nwork+1 + nwork = nwork + 1 DO ip = 1, natom - sum_cell_f_all = sum_cell_f_all+cell_functions(ip) + sum_cell_f_all = sum_cell_f_all + cell_functions(ip) END DO IF (in_memory) THEN DO iatom = 1, natom IF (ABS(sum_cell_f_all) .GT. 0.0_dp) THEN - gradients(3*(iatom-1)+1:3*(iatom-1)+3, k, j, i) = & - d_sum_const_dR(:, iatom)/sum_cell_f_all-sum_cell_f_constr* & + gradients(3*(iatom - 1) + 1:3*(iatom - 1) + 3, k, j, i) = & + d_sum_const_dR(:, iatom)/sum_cell_f_all - sum_cell_f_constr* & d_sum_Pm_dR(:, iatom)/(sum_cell_f_all**2) END IF END DO @@ -4100,11 +4100,11 @@ SUBROUTINE mixed_becke_constraint_low(force_env, mixed_cdft, in_memory, & CALL mp_isend(msgin=mixed_cdft%dlb_control%weight, & dest=mixed_cdft%dlb_control%my_dest_repl(i), & request=req_send(i, 2), comm=force_env%para_env%group, & - tag=mixed_cdft%dlb_control%dest_tags_repl(i)+1) + tag=mixed_cdft%dlb_control%dest_tags_repl(i) + 1) CALL mp_isend(msgin=mixed_cdft%dlb_control%gradients, & dest=mixed_cdft%dlb_control%my_dest_repl(i), & request=req_send(i, 3), comm=force_env%para_env%group, & - tag=mixed_cdft%dlb_control%dest_tags_repl(i)+2) + tag=mixed_cdft%dlb_control%dest_tags_repl(i) + 2) END DO should_communicate = .TRUE. nsent_total = 0 @@ -4112,15 +4112,15 @@ SUBROUTINE mixed_becke_constraint_low(force_env, mixed_cdft, in_memory, & DO i = 1, SIZE(req_send, 1) CALL mp_isend(msgin=mixed_cdft%dlb_control%sendbuff(ispecial)%cavity, & dest=mixed_cdft%dlb_control%sendbuff(ispecial)%rank(i), & - request=req_send(i, 3*(ispecial-1)+1), & + request=req_send(i, 3*(ispecial - 1) + 1), & comm=force_env%para_env%group, tag=1) CALL mp_isend(msgin=mixed_cdft%dlb_control%sendbuff(ispecial)%weight, & dest=mixed_cdft%dlb_control%sendbuff(ispecial)%rank(i), & - request=req_send(i, 3*(ispecial-1)+2), & + request=req_send(i, 3*(ispecial - 1) + 2), & comm=force_env%para_env%group, tag=2) CALL mp_isend(msgin=mixed_cdft%dlb_control%sendbuff(ispecial)%gradients, & dest=mixed_cdft%dlb_control%sendbuff(ispecial)%rank(i), & - request=req_send(i, 3*(ispecial-1)+3), & + request=req_send(i, 3*(ispecial - 1) + 3), & comm=force_env%para_env%group, tag=3) END DO IF (ispecial .EQ. my_special_work) THEN @@ -4128,11 +4128,11 @@ SUBROUTINE mixed_becke_constraint_low(force_env, mixed_cdft, in_memory, & nsent_total = 0 END IF END IF - work(mixed_cdft%dlb_control%my_source+1) = work(mixed_cdft%dlb_control%my_source+1)+nwork - work_dlb(force_env%para_env%mepos+1) = work_dlb(force_env%para_env%mepos+1)+nwork + work(mixed_cdft%dlb_control%my_source + 1) = work(mixed_cdft%dlb_control%my_source + 1) + nwork + work_dlb(force_env%para_env%mepos + 1) = work_dlb(force_env%para_env%mepos + 1) + nwork ELSE - IF (mixed_cdft%dlb) work(force_env%para_env%mepos+1) = work(force_env%para_env%mepos+1)+nwork - IF (mixed_cdft%dlb) work_dlb(force_env%para_env%mepos+1) = work_dlb(force_env%para_env%mepos+1)+nwork + IF (mixed_cdft%dlb) work(force_env%para_env%mepos + 1) = work(force_env%para_env%mepos + 1) + nwork + IF (mixed_cdft%dlb) work_dlb(force_env%para_env%mepos + 1) = work_dlb(force_env%para_env%mepos + 1) + nwork END IF END DO ! ispecial END DO ! iwork @@ -4140,12 +4140,12 @@ SUBROUTINE mixed_becke_constraint_low(force_env, mixed_cdft, in_memory, & IF (mixed_cdft%dlb) THEN IF (mixed_cdft%dlb_control%recv_work .AND. & ANY(mixed_cdft%dlb_control%recv_work_repl)) THEN - ALLOCATE (req_total(SIZE(req_recv)+SIZE(req_send, 1)*SIZE(req_send, 2))) + ALLOCATE (req_total(SIZE(req_recv) + SIZE(req_send, 1)*SIZE(req_send, 2))) index = SIZE(req_recv) req_total(1:index) = req_recv DO i = 1, SIZE(req_send, 2) DO j = 1, SIZE(req_send, 1) - index = index+1 + index = index + 1 req_total(index) = req_send(j, i) END DO END DO @@ -4201,7 +4201,7 @@ SUBROUTINE mixed_becke_constraint_low(force_env, mixed_cdft, in_memory, & CALL mp_sum(work_dlb, force_env%para_env%group) IF (.NOT. ASSOCIATED(mixed_cdft%dlb_control%prediction_error)) & ALLOCATE (mixed_cdft%dlb_control%prediction_error(force_env%para_env%num_pe)) - mixed_cdft%dlb_control%prediction_error = mixed_cdft%dlb_control%expected_work-work + mixed_cdft%dlb_control%prediction_error = mixed_cdft%dlb_control%expected_work - work IF (debug_this_module .AND. iounit > 0) THEN DO i = 1, SIZE(work, 1) WRITE (iounit, '(A,I10,I10,I10)') & diff --git a/src/mixed_cdft_utils.F b/src/mixed_cdft_utils.F index 422ad406ea..bda380e07e 100644 --- a/src/mixed_cdft_utils.F +++ b/src/mixed_cdft_utils.F @@ -356,7 +356,7 @@ SUBROUTINE mixed_cdft_parse_settings(force_env, mixed_env, mixed_cdft, & IF (settings%coeffs(i, 1) /= settings%coeffs(i, iforce_eval)) is_match = .FALSE. END IF END DO - IF (settings%atoms(i, 1) /= 0) settings%ncdft = settings%ncdft+1 + IF (settings%atoms(i, 1) /= 0) settings%ncdft = settings%ncdft + 1 END DO IF (.NOT. is_match .AND. mixed_cdft%run_type == mixed_cdft_parallel) & CALL cp_abort(__LOCATION__, & @@ -599,7 +599,7 @@ SUBROUTINE mixed_cdft_transfer_settings(force_env, mixed_cdft, settings) CALL mp_sum(settings%cutoffs, force_env%para_env%group) DO i = 1, SIZE(settings%cutoffs, 1) IF (settings%cutoffs(i, 1) /= settings%cutoffs(i, 2)) is_match = .FALSE. - IF (settings%cutoffs(i, 1) /= 0.0_dp) nkinds = nkinds+1 + IF (settings%cutoffs(i, 1) /= 0.0_dp) nkinds = nkinds + 1 END DO IF (.NOT. is_match) & CALL cp_abort(__LOCATION__, & @@ -613,7 +613,7 @@ SUBROUTINE mixed_cdft_transfer_settings(force_env, mixed_cdft, settings) CALL mp_sum(settings%radii, force_env%para_env%group) DO i = 1, SIZE(settings%radii, 1) IF (settings%radii(i, 1) /= settings%radii(i, 2)) is_match = .FALSE. - IF (settings%radii(i, 1) /= 0.0_dp) nkinds = nkinds+1 + IF (settings%radii(i, 1) /= 0.0_dp) nkinds = nkinds + 1 END DO IF (.NOT. is_match) & CALL cp_abort(__LOCATION__, & @@ -798,7 +798,7 @@ SUBROUTINE mixed_cdft_init_structures(force_env, force_env_qs, mixed_env, mixed_ i_force_eval(2), i_force_eval(2)) rs_grid_section => section_vals_get_subs_vals(force_env_section, "DFT%MGRID%RS_GRID") CALL init_input_type(input_settings, & - nsmax=2*MAX(1, return_cube_max_iradius(mixed_cdft%pw_env%cube_info(1)))+1, & + nsmax=2*MAX(1, return_cube_max_iradius(mixed_cdft%pw_env%cube_info(1))) + 1, & rs_grid_section=rs_grid_section, ilevel=1, & higher_grid_layout=higher_grid_layout) NULLIFY (rs_descs(1)%rs_desc) @@ -833,10 +833,10 @@ SUBROUTINE mixed_cdft_init_structures(force_env, force_env_qs, mixed_env, mixed_ ALLOCATE (mixed_cdft%dest_list(2)) ALLOCATE (mixed_cdft%source_list(2)) imap = force_env%para_env%mepos/2 - mixed_cdft%dest_list = (/imap, imap+force_env%para_env%num_pe/2/) - imap = MOD(force_env%para_env%mepos, force_env%para_env%num_pe/2)+ & + mixed_cdft%dest_list = (/imap, imap + force_env%para_env%num_pe/2/) + imap = MOD(force_env%para_env%mepos, force_env%para_env%num_pe/2) + & MODULO(force_env%para_env%mepos, force_env%para_env%num_pe/2) - mixed_cdft%source_list = (/imap, imap+1/) + mixed_cdft%source_list = (/imap, imap + 1/) ! Determine bounds of the data that is replicated ALLOCATE (mixed_cdft%recv_bo(4)) ALLOCATE (sendbuffer(2), recvbuffer(2), recvbuffer2(2)) @@ -869,19 +869,19 @@ SUBROUTINE mixed_cdft_init_structures(force_env, force_env_qs, mixed_env, mixed_ CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool) ! work out the pw grid points each proc holds in the two (identical) parallel proc groups ! note we only care about the x dir since we assume the y dir is not subdivided - ALLOCATE (bounds(0:auxbas_pw_pool%pw_grid%para%group_size-1, 1:2)) - DO i = 0, auxbas_pw_pool%pw_grid%para%group_size-1 + ALLOCATE (bounds(0:auxbas_pw_pool%pw_grid%para%group_size - 1, 1:2)) + DO i = 0, auxbas_pw_pool%pw_grid%para%group_size - 1 bounds(i, 1:2) = auxbas_pw_pool%pw_grid%para%bo(1:2, 1, i, 1) - bounds(i, 1:2) = bounds(i, 1:2)-auxbas_pw_pool%pw_grid%npts(1)/2-1 + bounds(i, 1:2) = bounds(i, 1:2) - auxbas_pw_pool%pw_grid%npts(1)/2 - 1 END DO ! work out which procs to send my grid points ! first get the number of target procs per group ntargets = 0 offset = -1 - DO i = 0, auxbas_pw_pool%pw_grid%para%group_size-1 + DO i = 0, auxbas_pw_pool%pw_grid%para%group_size - 1 IF ((bounds(i, 1) .GE. bo_mixed(1, 1) .AND. bounds(i, 1) .LE. bo_mixed(2, 1)) .OR. & (bounds(i, 2) .GE. bo_mixed(1, 1) .AND. bounds(i, 2) .LE. bo_mixed(2, 1))) THEN - ntargets = ntargets+1 + ntargets = ntargets + 1 IF (offset == -1) offset = i ELSE IF (bounds(i, 2) .GT. bo_mixed(2, 1)) THEN EXIT @@ -893,11 +893,11 @@ SUBROUTINE mixed_cdft_init_structures(force_env, force_env_qs, mixed_env, mixed_ ALLOCATE (mixed_cdft%dest_list_bo(2, ntargets)) ! now determine the actual grid points to send j = 1 - DO i = offset, offset+ntargets-1 + DO i = offset, offset + ntargets - 1 mixed_cdft%dest_list(j) = i - mixed_cdft%dest_list_bo(:, j) = (/bo_mixed(1, 1)+(bounds(i, 1)-bo_mixed(1, 1)), & - bo_mixed(2, 1)+(bounds(i, 2)-bo_mixed(2, 1))/) - j = j+1 + mixed_cdft%dest_list_bo(:, j) = (/bo_mixed(1, 1) + (bounds(i, 1) - bo_mixed(1, 1)), & + bo_mixed(2, 1) + (bounds(i, 2) - bo_mixed(2, 1))/) + j = j + 1 END DO ALLOCATE (mixed_cdft%dest_list_save(ntargets), mixed_cdft%dest_bo_save(2, ntargets)) ! We need to store backups of these arrays since they might get reallocated during dlb @@ -906,19 +906,19 @@ SUBROUTINE mixed_cdft_init_structures(force_env, force_env_qs, mixed_env, mixed_ ! finally determine which procs will send me grid points ! now we need info about y dir also DEALLOCATE (bounds) - ALLOCATE (bounds(0:pw_pools(1)%pool%pw_grid%para%group_size-1, 1:4)) - DO i = 0, pw_pools(1)%pool%pw_grid%para%group_size-1 + ALLOCATE (bounds(0:pw_pools(1)%pool%pw_grid%para%group_size - 1, 1:4)) + DO i = 0, pw_pools(1)%pool%pw_grid%para%group_size - 1 bounds(i, 1:2) = pw_pools(1)%pool%pw_grid%para%bo(1:2, 1, i, 1) bounds(i, 3:4) = pw_pools(1)%pool%pw_grid%para%bo(1:2, 2, i, 1) - bounds(i, 1:2) = bounds(i, 1:2)-pw_pools(1)%pool%pw_grid%npts(1)/2-1 - bounds(i, 3:4) = bounds(i, 3:4)-pw_pools(1)%pool%pw_grid%npts(2)/2-1 + bounds(i, 1:2) = bounds(i, 1:2) - pw_pools(1)%pool%pw_grid%npts(1)/2 - 1 + bounds(i, 3:4) = bounds(i, 3:4) - pw_pools(1)%pool%pw_grid%npts(2)/2 - 1 END DO ntargets = 0 offset = -1 - DO i = 0, pw_pools(1)%pool%pw_grid%para%group_size-1 + DO i = 0, pw_pools(1)%pool%pw_grid%para%group_size - 1 IF ((bo(1, 1) .GE. bounds(i, 1) .AND. bo(1, 1) .LE. bounds(i, 2)) .OR. & (bo(2, 1) .GE. bounds(i, 1) .AND. bo(2, 1) .LE. bounds(i, 2))) THEN - ntargets = ntargets+1 + ntargets = ntargets + 1 IF (offset == -1) offset = i ELSE IF (bo(2, 1) .LT. bounds(i, 1)) THEN EXIT @@ -929,7 +929,7 @@ SUBROUTINE mixed_cdft_init_structures(force_env, force_env_qs, mixed_env, mixed_ ALLOCATE (mixed_cdft%source_list(ntargets)) ALLOCATE (mixed_cdft%source_list_bo(4, ntargets)) j = 1 - DO i = offset, offset+ntargets-1 + DO i = offset, offset + ntargets - 1 mixed_cdft%source_list(j) = i IF (bo(1, 1) .GE. bounds(i, 1) .AND. bo(2, 1) .LE. bounds(i, 2)) THEN mixed_cdft%source_list_bo(:, j) = (/bo(1, 1), bo(2, 1), & @@ -941,7 +941,7 @@ SUBROUTINE mixed_cdft_init_structures(force_env, force_env_qs, mixed_env, mixed_ mixed_cdft%source_list_bo(:, j) = (/bounds(i, 1), bo(2, 1), & bounds(i, 3), bounds(i, 4)/) END IF - j = j+1 + j = j + 1 END DO ALLOCATE (mixed_cdft%source_list_save(ntargets), mixed_cdft%source_bo_save(4, ntargets)) ! We need to store backups of these arrays since they might get reallocated during dlb @@ -954,13 +954,13 @@ SUBROUTINE mixed_cdft_init_structures(force_env, force_env_qs, mixed_env, mixed_ ! even when the states are treated in serial (the initial print of QS data [basis set etc] for ! all states unfortunately goes to the first log file) CALL force_env_get(force_env, root_section=root_section) - ALLOCATE (mixed_cdft%sub_logger(nforce_eval-1)) - DO i = 1, nforce_eval-1 + ALLOCATE (mixed_cdft%sub_logger(nforce_eval - 1)) + DO i = 1, nforce_eval - 1 IF (force_env%para_env%ionode) THEN CALL section_vals_val_get(root_section, "GLOBAL%PROJECT_NAME", & c_val=input_file_path) lp = LEN_TRIM(input_file_path) - input_file_path(lp+1:LEN(input_file_path)) = "-r-"//ADJUSTL(cp_to_string(i+1)) + input_file_path(lp + 1:LEN(input_file_path)) = "-r-"//ADJUSTL(cp_to_string(i + 1)) lp = LEN_TRIM(input_file_path) output_file_path = input_file_path(1:lp)//".out" CALL open_file(file_name=output_file_path, file_status="UNKNOWN", & @@ -1402,7 +1402,7 @@ SUBROUTINE mixed_cdft_print_couplings(force_env) CPASSERT(ALLOCATED(mixed_cdft%results%energy)) nforce_eval = SIZE(force_env%sub_force_env) nvar = SIZE(mixed_cdft%results%strength, 1) - npermutations = nforce_eval*(nforce_eval-1)/2 ! Size of upper triangular part + npermutations = nforce_eval*(nforce_eval - 1)/2 ! Size of upper triangular part IF (iounit > 0) THEN WRITE (iounit, '(/,T3,A,T66)') & '------------------------- CDFT coupling information --------------------------' @@ -1429,7 +1429,7 @@ SUBROUTINE mixed_cdft_print_couplings(force_env) WRITE (iounit, '(/,T3,A,T60,(3X,F18.12))') & 'Overlap between states I and J:', mixed_cdft%results%S(istate, jstate) WRITE (iounit, '(T3,A,T60,(3X,F18.12))') & - 'Charge transfer energy (J-I) (Hartree):', (mixed_cdft%results%energy(jstate)-mixed_cdft%results%energy(istate)) + 'Charge transfer energy (J-I) (Hartree):', (mixed_cdft%results%energy(jstate) - mixed_cdft%results%energy(istate)) WRITE (iounit, *) IF (ALLOCATED(mixed_cdft%results%rotation)) THEN IF (ABS(mixed_cdft%results%rotation(ipermutation))*1.0E3_dp .GE. 0.1_dp) THEN @@ -1529,13 +1529,13 @@ SUBROUTINE map_permutation_to_states(n, ipermutation, i, j) INTEGER :: kcol, kpermutation, krow, npermutations - npermutations = n*(n-1)/2 ! Size of upper triangular part + npermutations = n*(n - 1)/2 ! Size of upper triangular part IF (ipermutation > npermutations) & CPABORT("Permutation index out of bounds") kpermutation = 0 DO krow = 1, n - DO kcol = krow+1, n - kpermutation = kpermutation+1 + DO kcol = krow + 1, n + kpermutation = kpermutation + 1 IF (kpermutation == ipermutation) THEN i = krow j = kcol @@ -1585,8 +1585,8 @@ SUBROUTINE hfun_zero(fun, th, just_zero, bounds, work) DO i1 = 1, n1 IF (fun(i1, i2, i3) < th) THEN IF (.NOT. just_zero) THEN - nzeroed = nzeroed+1 - nzeroed_total = nzeroed_total+1 + nzeroed = nzeroed + 1 + nzeroed_total = nzeroed_total + 1 ELSE fun(i1, i2, i3) = 0.0_dp END IF @@ -1611,8 +1611,8 @@ SUBROUTINE hfun_zero(fun, th, just_zero, bounds, work) IF (.NOT. ub_final) ub = n3 bounds(1) = lb bounds(2) = ub - bounds = bounds-(n3/2)-1 - work = n3*n2*n1-nzeroed_total + bounds = bounds - (n3/2) - 1 + work = n3*n2*n1 - nzeroed_total END IF END SUBROUTINE hfun_zero @@ -1683,12 +1683,12 @@ SUBROUTINE mixed_cdft_read_block_diag(force_env, blocks, ignore_excited, nrecurs DO i = 1, nblk ! Within same block DO j = 1, SIZE(blocks(i)%array) - DO k = j+1, SIZE(blocks(i)%array) + DO k = j + 1, SIZE(blocks(i)%array) IF (blocks(i)%array(j) == blocks(i)%array(k)) has_duplicates = .TRUE. END DO END DO ! Within different blocks - DO j = i+1, nblk + DO j = i + 1, nblk DO k = 1, SIZE(blocks(i)%array) DO l = 1, SIZE(blocks(j)%array) IF (blocks(i)%array(k) == blocks(j)%array(l)) has_duplicates = .TRUE. @@ -1748,9 +1748,9 @@ SUBROUTINE mixed_cdft_get_blocks(mixed_cdft, blocks, H_block, S_block) icol = 0 DO j = 1, SIZE(blocks(i)%array) irow = 0 - icol = icol+1 + icol = icol + 1 DO k = 1, SIZE(blocks(i)%array) - irow = irow+1 + irow = irow + 1 H_block(i)%array(irow, icol) = mixed_cdft%results%H(blocks(i)%array(k), blocks(i)%array(j)) S_block(i)%array(irow, icol) = mixed_cdft%results%S(blocks(i)%array(k), blocks(i)%array(j)) END DO @@ -1869,20 +1869,20 @@ SUBROUTINE mixed_cdft_assemble_block_diag(mixed_cdft, blocks, H_block, eigenvalu DO j = 1, SIZE(eigenvalues(i)%array) H_mat(k, k) = eigenvalues(i)%array(j) S_mat(k, k) = 1.0_dp - k = k+1 + k = k + 1 IF (iounit > 0) THEN IF (j == 1) THEN WRITE (iounit, '(T9,A,T58,(3X,F20.14))') 'Ground state energy:', eigenvalues(i)%array(j) ELSE WRITE (iounit, '(T9,A,I2,A,T58,(3X,F20.14))') & - 'Excited state (', j-1, ' ) energy:', eigenvalues(i)%array(j) + 'Excited state (', j - 1, ' ) energy:', eigenvalues(i)%array(j) END IF END IF IF (ignore_excited .AND. j == 1) EXIT END DO END DO ! Transform the off-diagonal blocks using the eigenvectors of each block - npermutations = nblk*(nblk-1)/2 + npermutations = nblk*(nblk - 1)/2 IF (iounit > 0) WRITE (iounit, '(/,T3,A)') "Interactions between block diagonalized states" DO ipermutation = 1, npermutations CALL map_permutation_to_states(nblk, ipermutation, i, j) @@ -1892,9 +1892,9 @@ SUBROUTINE mixed_cdft_assemble_block_diag(mixed_cdft, blocks, H_block, eigenvalu icol = 0 DO k = 1, SIZE(blocks(j)%array) irow = 0 - icol = icol+1 + icol = icol + 1 DO l = 1, SIZE(blocks(i)%array) - irow = irow+1 + irow = irow + 1 H_offdiag(irow, icol) = mixed_cdft%results%H(blocks(i)%array(l), blocks(j)%array(k)) S_offdiag(irow, icol) = mixed_cdft%results%S(blocks(i)%array(l), blocks(j)%array(k)) END DO @@ -1931,16 +1931,16 @@ SUBROUTINE mixed_cdft_assemble_block_diag(mixed_cdft, blocks, H_block, eigenvalu ELSE irow = 1 icol = 1 - DO k = 1, i-1 - irow = irow+SIZE(blocks(k)%array) + DO k = 1, i - 1 + irow = irow + SIZE(blocks(k)%array) END DO - DO k = 1, j-1 - icol = icol+SIZE(blocks(k)%array) + DO k = 1, j - 1 + icol = icol + SIZE(blocks(k)%array) END DO - H_mat(irow:irow+SIZE(H_offdiag, 1)-1, icol:icol+SIZE(H_offdiag, 2)-1) = H_offdiag(:, :) - H_mat(icol:icol+SIZE(H_offdiag, 2)-1, irow:irow+SIZE(H_offdiag, 1)-1) = TRANSPOSE(H_offdiag) - S_mat(irow:irow+SIZE(H_offdiag, 1)-1, icol:icol+SIZE(H_offdiag, 2)-1) = S_offdiag(:, :) - S_mat(icol:icol+SIZE(H_offdiag, 2)-1, irow:irow+SIZE(H_offdiag, 1)-1) = TRANSPOSE(S_offdiag) + H_mat(irow:irow + SIZE(H_offdiag, 1) - 1, icol:icol + SIZE(H_offdiag, 2) - 1) = H_offdiag(:, :) + H_mat(icol:icol + SIZE(H_offdiag, 2) - 1, irow:irow + SIZE(H_offdiag, 1) - 1) = TRANSPOSE(H_offdiag) + S_mat(irow:irow + SIZE(H_offdiag, 1) - 1, icol:icol + SIZE(H_offdiag, 2) - 1) = S_offdiag(:, :) + S_mat(icol:icol + SIZE(H_offdiag, 2) - 1, irow:irow + SIZE(H_offdiag, 1) - 1) = TRANSPOSE(S_offdiag) END IF IF (iounit > 0) THEN WRITE (iounit, '(/,T3,A)') REPEAT('#', 39) @@ -1951,14 +1951,14 @@ SUBROUTINE mixed_cdft_assemble_block_diag(mixed_cdft, blocks, H_block, eigenvalu ilabel = "(ground state)" IF (irow > 1) THEN IF (ignore_excited) EXIT - WRITE (tmp, '(I3)') irow-1 + WRITE (tmp, '(I3)') irow - 1 ilabel = "(excited state "//TRIM(ADJUSTL(tmp))//")" END IF DO icol = 1, SIZE(H_offdiag, 2) jlabel = "(ground state)" IF (icol > 1) THEN IF (ignore_excited) EXIT - WRITE (tmp, '(I3)') icol-1 + WRITE (tmp, '(I3)') icol - 1 jlabel = "(excited state "//TRIM(ADJUSTL(tmp))//")" END IF WRITE (iounit, '(T6,A,T58,(3X,F20.14))') TRIM(ilabel)//'-'//TRIM(jlabel)//':', H_offdiag(irow, icol) @@ -1970,14 +1970,14 @@ SUBROUTINE mixed_cdft_assemble_block_diag(mixed_cdft, blocks, H_block, eigenvalu IF (irow > 1) THEN IF (ignore_excited) EXIT ilabel = "(excited state)" - WRITE (tmp, '(I3)') irow-1 + WRITE (tmp, '(I3)') irow - 1 ilabel = "(excited state "//TRIM(ADJUSTL(tmp))//")" END IF DO icol = 1, SIZE(H_offdiag, 2) jlabel = "(ground state)" IF (icol > 1) THEN IF (ignore_excited) EXIT - WRITE (tmp, '(I3)') icol-1 + WRITE (tmp, '(I3)') icol - 1 jlabel = "(excited state "//TRIM(ADJUSTL(tmp))//")" END IF WRITE (iounit, '(T6,A,T58,(3X,F20.14))') TRIM(ilabel)//'-'//TRIM(jlabel)//':', S_offdiag(irow, icol) diff --git a/src/mixed_environment_types.F b/src/mixed_environment_types.F index d29b447c2b..0432773162 100644 --- a/src/mixed_environment_types.F +++ b/src/mixed_environment_types.F @@ -220,7 +220,7 @@ SUBROUTINE init_mixed_env(mixed_env, para_env) CALL cp_para_env_retain(para_env) mixed_env%para_env => para_env mixed_env%ref_count = 1 - last_mixed_env_id_nr = last_mixed_env_id_nr+1 + last_mixed_env_id_nr = last_mixed_env_id_nr + 1 mixed_env%id_nr = last_mixed_env_id_nr END SUBROUTINE init_mixed_env @@ -354,7 +354,7 @@ SUBROUTINE mixed_env_retain(mixed_env) CPASSERT(ASSOCIATED(mixed_env)) CPASSERT(mixed_env%ref_count > 0) - mixed_env%ref_count = mixed_env%ref_count+1 + mixed_env%ref_count = mixed_env%ref_count + 1 END SUBROUTINE mixed_env_retain ! ************************************************************************************************** @@ -372,7 +372,7 @@ SUBROUTINE mixed_env_release(mixed_env) IF (ASSOCIATED(mixed_env)) THEN CPASSERT(mixed_env%ref_count > 0) - mixed_env%ref_count = mixed_env%ref_count-1 + mixed_env%ref_count = mixed_env%ref_count - 1 IF (mixed_env%ref_count < 1) THEN ngroups = SIZE(mixed_env%sub_para_env) DO i = 1, ngroups diff --git a/src/mixed_environment_utils.F b/src/mixed_environment_utils.F index e0ff0c8d84..0a340023ba 100644 --- a/src/mixed_environment_utils.F +++ b/src/mixed_environment_utils.F @@ -88,19 +88,19 @@ SUBROUTINE mixed_map_forces(particles_mix, virial_mix, results_mix, global_force IF (overwrite) THEN particles_mix%els(jparticle)%f(:) = factor*global_forces(iforce_eval)%forces(:, iparticle) ELSE - particles_mix%els(jparticle)%f(:) = particles_mix%els(jparticle)%f(:)+ & + particles_mix%els(jparticle)%f(:) = particles_mix%els(jparticle)%f(:) + & factor*global_forces(iforce_eval)%forces(:, iparticle) END IF END DO ! Mixing Virial IF (virial_mix%pv_availability) THEN IF (overwrite) CALL zero_virial(virial_mix, reset=.FALSE.) - virial_mix%pv_total = virial_mix%pv_total+factor*virials(iforce_eval)%virial%pv_total - virial_mix%pv_kinetic = virial_mix%pv_kinetic+factor*virials(iforce_eval)%virial%pv_kinetic - virial_mix%pv_virial = virial_mix%pv_virial+factor*virials(iforce_eval)%virial%pv_virial - virial_mix%pv_xc = virial_mix%pv_xc+factor*virials(iforce_eval)%virial%pv_xc - virial_mix%pv_fock_4c = virial_mix%pv_fock_4c+factor*virials(iforce_eval)%virial%pv_fock_4c - virial_mix%pv_constraint = virial_mix%pv_constraint+factor*virials(iforce_eval)%virial%pv_constraint + virial_mix%pv_total = virial_mix%pv_total + factor*virials(iforce_eval)%virial%pv_total + virial_mix%pv_kinetic = virial_mix%pv_kinetic + factor*virials(iforce_eval)%virial%pv_kinetic + virial_mix%pv_virial = virial_mix%pv_virial + factor*virials(iforce_eval)%virial%pv_virial + virial_mix%pv_xc = virial_mix%pv_xc + factor*virials(iforce_eval)%virial%pv_xc + virial_mix%pv_fock_4c = virial_mix%pv_fock_4c + factor*virials(iforce_eval)%virial%pv_fock_4c + virial_mix%pv_constraint = virial_mix%pv_constraint + factor*virials(iforce_eval)%virial%pv_constraint END IF ! Deallocate map_index array IF (ASSOCIATED(map_index)) THEN @@ -120,7 +120,7 @@ SUBROUTINE mixed_map_forces(particles_mix, virial_mix, results_mix, global_force CALL get_results(results=results(iforce_eval)%results, description=description, n_rep=nres) CALL get_results(results=results(iforce_eval)%results, description=description, & values=dip_tmp, nval=nres) - dip_mix = dip_mix+factor*dip_tmp + dip_mix = dip_mix + factor*dip_tmp CALL cp_results_erase(results=results_mix, description=description) CALL put_results(results=results_mix, description=description, values=dip_mix) END IF @@ -204,10 +204,10 @@ SUBROUTINE get_subsys_map_index(mapping_section, natom, iforce_eval, nforce_eval IF (tmp == jval) EXIT END DO CALL section_vals_val_get(fragments_sys, "_DEFAULT_KEYWORD_", i_rep_section=j, i_vals=index_glo) - DO k = 0, index_glo(2)-index_glo(1) - iatom = iatom+1 + DO k = 0, index_glo(2) - index_glo(1) + iatom = iatom + 1 CPASSERT(iatom <= natom) - map_index(iatom) = index_glo(1)+k + map_index(iatom) = index_glo(1) + k END DO END DO check = (iatom == natom) @@ -226,11 +226,11 @@ SUBROUTINE get_subsys_map_index(mapping_section, natom, iforce_eval, nforce_eval CPASSERT(j <= n_rep_sys) CALL section_vals_val_get(fragments_loc, "_DEFAULT_KEYWORD_", i_rep_section=i, i_vals=index_loc) CALL section_vals_val_get(fragments_sys, "_DEFAULT_KEYWORD_", i_rep_section=j, i_vals=index_glo) - check = ((index_loc(2)-index_loc(1)) == (index_glo(2)-index_glo(1))) + check = ((index_loc(2) - index_loc(1)) == (index_glo(2) - index_glo(1))) CPASSERT(check) ! Now let's build the real mapping - DO k = 0, index_loc(2)-index_loc(1) - map_index(index_loc(1)+k) = index_glo(1)+k + DO k = 0, index_loc(2) - index_loc(1) + map_index(index_loc(1) + k) = index_glo(1) + k END DO END DO END IF diff --git a/src/mixed_main.F b/src/mixed_main.F index 34a9349dd7..7e425dc77d 100644 --- a/src/mixed_main.F +++ b/src/mixed_main.F @@ -81,7 +81,7 @@ SUBROUTINE mixed_create_force_env(mixed_env, root_section, para_env, & CALL section_vals_val_get(force_env_section, "MIXED%GROUP_PARTITION", n_rep_val=n_rep_val) IF (n_rep_val > 0) THEN CALL section_vals_val_get(force_env_section, "MIXED%GROUP_PARTITION", i_vals=i_vals) - ALLOCATE (group_partition(0:SIZE(i_vals)-1)) + ALLOCATE (group_partition(0:SIZE(i_vals) - 1)) group_partition(:) = i_vals ngroup_wish_set = .TRUE. ngroup_wish = SIZE(i_vals) @@ -97,7 +97,7 @@ SUBROUTINE mixed_create_force_env(mixed_env, root_section, para_env, & END IF ! Split the current communicator - ALLOCATE (mixed_env%group_distribution(0:para_env%num_pe-1)) + ALLOCATE (mixed_env%group_distribution(0:para_env%num_pe - 1)) IF (group_size_wish_set) THEN CALL mp_comm_split(para_env%group, mixed_env%new_group, mixed_env%ngroups, mixed_env%group_distribution, & subgroup_min_size=group_size_wish) @@ -109,7 +109,7 @@ SUBROUTINE mixed_create_force_env(mixed_env, root_section, para_env, & IF (output_unit > 0) THEN WRITE (output_unit, FMT="(T2,A,T71,I10)") "MIXED_ENV| Number of created MPI groups:", mixed_env%ngroups WRITE (output_unit, FMT="(T2,A)", ADVANCE="NO") "MIXED_ENV| Task to group correspondence:" - DO i = 0, para_env%num_pe-1 + DO i = 0, para_env%num_pe - 1 IF (MODULO(i, 4) == 0) WRITE (output_unit, *) WRITE (output_unit, FMT='(A3,I4,A3,I4,A1)', ADVANCE="NO") & " (", i, " : ", mixed_env%group_distribution(i), ")" @@ -126,7 +126,7 @@ SUBROUTINE mixed_create_force_env(mixed_env, root_section, para_env, & ! DO i = 1, mixed_env%ngroups NULLIFY (mixed_env%sub_para_env(i)%para_env, logger) - IF (MODULO(i-1, mixed_env%ngroups) == mixed_env%group_distribution(para_env%mepos)) THEN + IF (MODULO(i - 1, mixed_env%ngroups) == mixed_env%group_distribution(para_env%mepos)) THEN ! Create sub_para_env CALL cp_para_env_create(mixed_env%sub_para_env(i)%para_env, & group=mixed_env%new_group, & @@ -137,8 +137,8 @@ SUBROUTINE mixed_create_force_env(mixed_env, root_section, para_env, & CALL section_vals_val_get(root_section, "GLOBAL%PROJECT_NAME", & c_val=input_file_path) lp = LEN_TRIM(input_file_path) - input_file_path(lp+1:LEN(input_file_path)) = "-r-"// & - ADJUSTL(cp_to_string(i)) + input_file_path(lp + 1:LEN(input_file_path)) = "-r-"// & + ADJUSTL(cp_to_string(i)) lp = LEN_TRIM(input_file_path) output_file_path = input_file_path(1:lp)//".out" CALL open_file(file_name=output_file_path, file_status="UNKNOWN", & diff --git a/src/mm_collocate_potential.F b/src/mm_collocate_potential.F index 7565e7810f..06056e1321 100644 --- a/src/mm_collocate_potential.F +++ b/src/mm_collocate_potential.F @@ -88,26 +88,26 @@ SUBROUTINE collocate_gf_rspace_NoPBC(zetp, rp, scale, W, pwgrid, cube_info, & CALL return_cube(cube_info, radius, lb_cube, ub_cube, sphere_bounds) IF (ALL(n_rep_real == 0)) THEN - cubecenter(:) = FLOOR(rpl(:)/dr(:))+gbo(1, :) - zub = MIN(bo(2, 3), cubecenter(3)+ub_cube(3)) - zlb = MAX(bo(1, 3), cubecenter(3)+lb_cube(3)) - yub = MIN(bo(2, 2), cubecenter(2)+ub_cube(2)) - ylb = MAX(bo(1, 2), cubecenter(2)+lb_cube(2)) - xub = MIN(bo(2, 1), cubecenter(1)+ub_cube(1)) - xlb = MAX(bo(1, 1), cubecenter(1)+lb_cube(1)) + cubecenter(:) = FLOOR(rpl(:)/dr(:)) + gbo(1, :) + zub = MIN(bo(2, 3), cubecenter(3) + ub_cube(3)) + zlb = MAX(bo(1, 3), cubecenter(3) + lb_cube(3)) + yub = MIN(bo(2, 2), cubecenter(2) + ub_cube(2)) + ylb = MAX(bo(1, 2), cubecenter(2) + lb_cube(2)) + xub = MIN(bo(2, 1), cubecenter(1) + ub_cube(1)) + xlb = MAX(bo(1, 1), cubecenter(1) + lb_cube(1)) IF (zlb .GT. zub .OR. ylb .GT. yub .OR. xlb .GT. xub) RETURN DO ig = zlb, zub - rpg = REAL(ig-gbo(1, 3), dp)*dr(3)-rpl(3) + rpg = REAL(ig - gbo(1, 3), dp)*dr(3) - rpl(3) zap = EXP(-zetp*rpg**2) zdat(ig) = scale*W*zap ENDDO DO ig = ylb, yub - rpg = REAL(ig-gbo(1, 2), dp)*dr(2)-rpl(2) + rpg = REAL(ig - gbo(1, 2), dp)*dr(2) - rpl(2) yap = EXP(-zetp*rpg**2) ydat(ig) = yap ENDDO DO ig = xlb, xub - rpg = REAL(ig-gbo(1, 1), dp)*dr(1)-rpl(1) + rpg = REAL(ig - gbo(1, 1), dp)*dr(1) - rpl(1) xap = EXP(-zetp*rpg**2) xdat(ig) = xap ENDDO @@ -119,27 +119,27 @@ SUBROUTINE collocate_gf_rspace_NoPBC(zetp, rp, scale, W, pwgrid, cube_info, & my_shift(2) = mm_cell%hmat(2, 2)*REAL(iy, KIND=dp) DO ix = -n_rep_real(1), n_rep_real(1) my_shift(1) = mm_cell%hmat(1, 1)*REAL(ix, KIND=dp) - rpl = rp+my_shift(:) - cubecenter(:) = FLOOR(rpl(:)/dr(:))+gbo(1, :) - zub = MIN(bo(2, 3), cubecenter(3)+ub_cube(3)) - zlb = MAX(bo(1, 3), cubecenter(3)+lb_cube(3)) - yub = MIN(bo(2, 2), cubecenter(2)+ub_cube(2)) - ylb = MAX(bo(1, 2), cubecenter(2)+lb_cube(2)) - xub = MIN(bo(2, 1), cubecenter(1)+ub_cube(1)) - xlb = MAX(bo(1, 1), cubecenter(1)+lb_cube(1)) + rpl = rp + my_shift(:) + cubecenter(:) = FLOOR(rpl(:)/dr(:)) + gbo(1, :) + zub = MIN(bo(2, 3), cubecenter(3) + ub_cube(3)) + zlb = MAX(bo(1, 3), cubecenter(3) + lb_cube(3)) + yub = MIN(bo(2, 2), cubecenter(2) + ub_cube(2)) + ylb = MAX(bo(1, 2), cubecenter(2) + lb_cube(2)) + xub = MIN(bo(2, 1), cubecenter(1) + ub_cube(1)) + xlb = MAX(bo(1, 1), cubecenter(1) + lb_cube(1)) IF (zlb .GT. zub .OR. ylb .GT. yub .OR. xlb .GT. xub) CYCLE DO ig = zlb, zub - rpg = REAL(ig-gbo(1, 3), dp)*dr(3)-rpl(3) + rpg = REAL(ig - gbo(1, 3), dp)*dr(3) - rpl(3) zap = EXP(-zetp*rpg**2) zdat(ig) = scale*W*zap ENDDO DO ig = ylb, yub - rpg = REAL(ig-gbo(1, 2), dp)*dr(2)-rpl(2) + rpg = REAL(ig - gbo(1, 2), dp)*dr(2) - rpl(2) yap = EXP(-zetp*rpg**2) ydat(ig) = yap ENDDO DO ig = xlb, xub - rpg = REAL(ig-gbo(1, 1), dp)*dr(1)-rpl(1) + rpg = REAL(ig - gbo(1, 1), dp)*dr(1) - rpl(1) xap = EXP(-zetp*rpg**2) xdat(ig) = xap ENDDO @@ -212,28 +212,28 @@ SUBROUTINE integrate_gf_rspace_NoPBC(zetp, rp, scale, W, pwgrid, cube_info, & CALL return_cube(cube_info, radius, lb_cube, ub_cube, sphere_bounds) IF (ALL(n_rep_real == 0)) THEN - cubecenter(:) = FLOOR(rpl(:)/dr(:))+gbo(1, :) - zub = MIN(bo(2, 3), cubecenter(3)+ub_cube(3)) - zlb = MAX(bo(1, 3), cubecenter(3)+lb_cube(3)) - yub = MIN(bo(2, 2), cubecenter(2)+ub_cube(2)) - ylb = MAX(bo(1, 2), cubecenter(2)+lb_cube(2)) - xub = MIN(bo(2, 1), cubecenter(1)+ub_cube(1)) - xlb = MAX(bo(1, 1), cubecenter(1)+lb_cube(1)) + cubecenter(:) = FLOOR(rpl(:)/dr(:)) + gbo(1, :) + zub = MIN(bo(2, 3), cubecenter(3) + ub_cube(3)) + zlb = MAX(bo(1, 3), cubecenter(3) + lb_cube(3)) + yub = MIN(bo(2, 2), cubecenter(2) + ub_cube(2)) + ylb = MAX(bo(1, 2), cubecenter(2) + lb_cube(2)) + xub = MIN(bo(2, 1), cubecenter(1) + ub_cube(1)) + xlb = MAX(bo(1, 1), cubecenter(1) + lb_cube(1)) IF (zlb .GT. zub .OR. ylb .GT. yub .OR. xlb .GT. xub) RETURN DO ig = zlb, zub - rpg = REAL(ig-gbo(1, 3), dp)*dr(3)-rpl(3) + rpg = REAL(ig - gbo(1, 3), dp)*dr(3) - rpl(3) zap = EXP(-zetp*rpg**2) zdat(1, ig) = scale*W*zap zdat(2, ig) = rpg*zdat(1, ig)*zetp*2.0_dp ENDDO DO ig = ylb, yub - rpg = REAL(ig-gbo(1, 2), dp)*dr(2)-rpl(2) + rpg = REAL(ig - gbo(1, 2), dp)*dr(2) - rpl(2) yap = EXP(-zetp*rpg**2) ydat(1, ig) = yap ydat(2, ig) = rpg*ydat(1, ig)*zetp*2.0_dp ENDDO DO ig = xlb, xub - rpg = REAL(ig-gbo(1, 1), dp)*dr(1)-rpl(1) + rpg = REAL(ig - gbo(1, 1), dp)*dr(1) - rpl(1) xap = EXP(-zetp*rpg**2) xdat(1, ig) = xap xdat(2, ig) = rpg*xdat(1, ig)*zetp*2.0_dp @@ -246,29 +246,29 @@ SUBROUTINE integrate_gf_rspace_NoPBC(zetp, rp, scale, W, pwgrid, cube_info, & my_shift(2) = mm_cell%hmat(2, 2)*REAL(iy, KIND=dp) DO ix = -n_rep_real(1), n_rep_real(1) my_shift(1) = mm_cell%hmat(1, 1)*REAL(ix, KIND=dp) - rpl = rp+my_shift(:) - cubecenter(:) = FLOOR(rpl(:)/dr(:))+gbo(1, :) - zub = MIN(bo(2, 3), cubecenter(3)+ub_cube(3)) - zlb = MAX(bo(1, 3), cubecenter(3)+lb_cube(3)) - yub = MIN(bo(2, 2), cubecenter(2)+ub_cube(2)) - ylb = MAX(bo(1, 2), cubecenter(2)+lb_cube(2)) - xub = MIN(bo(2, 1), cubecenter(1)+ub_cube(1)) - xlb = MAX(bo(1, 1), cubecenter(1)+lb_cube(1)) + rpl = rp + my_shift(:) + cubecenter(:) = FLOOR(rpl(:)/dr(:)) + gbo(1, :) + zub = MIN(bo(2, 3), cubecenter(3) + ub_cube(3)) + zlb = MAX(bo(1, 3), cubecenter(3) + lb_cube(3)) + yub = MIN(bo(2, 2), cubecenter(2) + ub_cube(2)) + ylb = MAX(bo(1, 2), cubecenter(2) + lb_cube(2)) + xub = MIN(bo(2, 1), cubecenter(1) + ub_cube(1)) + xlb = MAX(bo(1, 1), cubecenter(1) + lb_cube(1)) IF (zlb .GT. zub .OR. ylb .GT. yub .OR. xlb .GT. xub) CYCLE DO ig = zlb, zub - rpg = REAL(ig-gbo(1, 3), dp)*dr(3)-rpl(3) + rpg = REAL(ig - gbo(1, 3), dp)*dr(3) - rpl(3) zap = EXP(-zetp*rpg**2) zdat(1, ig) = scale*W*zap zdat(2, ig) = rpg*zdat(1, ig)*zetp*2.0_dp ENDDO DO ig = ylb, yub - rpg = REAL(ig-gbo(1, 2), dp)*dr(2)-rpl(2) + rpg = REAL(ig - gbo(1, 2), dp)*dr(2) - rpl(2) yap = EXP(-zetp*rpg**2) ydat(1, ig) = yap ydat(2, ig) = rpg*ydat(1, ig)*zetp*2.0_dp ENDDO DO ig = xlb, xub - rpg = REAL(ig-gbo(1, 1), dp)*dr(1)-rpl(1) + rpg = REAL(ig - gbo(1, 1), dp)*dr(1) - rpl(1) xap = EXP(-zetp*rpg**2) xdat(1, ig) = xap xdat(2, ig) = rpg*xdat(1, ig)*zetp*2.0_dp diff --git a/src/mode_selective.F b/src/mode_selective.F index 47b1e13d74..1bf9f755d3 100644 --- a/src/mode_selective.F +++ b/src/mode_selective.F @@ -126,8 +126,8 @@ SUBROUTINE ms_vb_anal(input, rep_env, para_env, globenv, particles, & ALLOCATE (mass(3*natoms)) DO i = 1, natoms DO j = 1, 3 - mass((i-1)*3+j) = particles(i)%atomic_kind%mass - mass((i-1)*3+j) = SQRT(mass((i-1)*3+j)) + mass((i - 1)*3 + j) = particles(i)%atomic_kind%mass + mass((i - 1)*3 + j) = SQRT(mass((i - 1)*3 + j)) END DO END DO ! Allocate working arrays @@ -150,7 +150,7 @@ SUBROUTINE ms_vb_anal(input, rep_env, para_env, globenv, particles, & ALLOCATE (ms_vib%ms_force(ncoord, nrep)) DO i = 1, natoms DO j = 1, 3 - pos0((i-1)*3+j) = particles((i))%r(j) + pos0((i - 1)*3 + j) = particles((i))%r(j) END DO END DO ncoord = 3*natoms @@ -158,7 +158,7 @@ SUBROUTINE ms_vb_anal(input, rep_env, para_env, globenv, particles, & ms_vib%ms_force = HUGE(0.0_dp) DO i = 1, nrep DO j = 1, ncoord - rep_env%r(j, i) = pos0(j)+ms_vib%step_r(i)*ms_vib%delta_vec(j, i) + rep_env%r(j, i) = pos0(j) + ms_vib%step_r(i)*ms_vib%delta_vec(j, i) END DO END DO CALL rep_env_calc_e_f(rep_env, calc_f=.TRUE.) @@ -179,7 +179,7 @@ SUBROUTINE ms_vb_anal(input, rep_env, para_env, globenv, particles, & END DO DO i = 1, nrep DO j = 1, ncoord - rep_env%r(j, i) = pos0(j)-ms_vib%step_r(i)*ms_vib%delta_vec(j, i) + rep_env%r(j, i) = pos0(j) - ms_vib%step_r(i)*ms_vib%delta_vec(j, i) END DO END DO CALL rep_env_calc_e_f(rep_env, calc_f=.TRUE.) @@ -192,7 +192,7 @@ SUBROUTINE ms_vb_anal(input, rep_env, para_env, globenv, particles, & description=description, & values=tmp_dip(i, :, 2), & nval=ip1) - ms_vib%dip_deriv(:, ms_vib%mat_size+i) = (tmp_dip(i, :, 1)-tmp_dip(i, :, 2))/(2*ms_vib%step_b(i)) + ms_vib%dip_deriv(:, ms_vib%mat_size + i) = (tmp_dip(i, :, 1) - tmp_dip(i, :, 2))/(2*ms_vib%step_b(i)) END DO END IF @@ -207,7 +207,7 @@ SUBROUTINE ms_vb_anal(input, rep_env, para_env, globenv, particles, & ALLOCATE (tmp_deriv(3, ms_vib%mat_size)) tmp_deriv = ms_vib%dip_deriv DEALLOCATE (ms_vib%dip_deriv) - ALLOCATE (ms_vib%dip_deriv(3, ms_vib%mat_size+nrep)) + ALLOCATE (ms_vib%dip_deriv(3, ms_vib%mat_size + nrep)) ms_vib%dip_deriv(:, 1:ms_vib%mat_size) = tmp_deriv(:, 1:ms_vib%mat_size) DEALLOCATE (tmp_deriv) END IF @@ -304,7 +304,7 @@ SUBROUTINE MS_initial_moves(para_env, nrep, input, globenv, ms_vib, particles, & DO k = 1, n_rep_val CALL section_vals_val_get(involved_at_section, "INVOLVED_ATOMS", i_rep_val=k, i_vals=tmplist) DO j = 1, SIZE(tmplist) - jj = jj+1 + jj = jj + 1 END DO END DO IF (jj .GE. 1) THEN @@ -340,7 +340,7 @@ SUBROUTINE MS_initial_moves(para_env, nrep, input, globenv, ms_vib, particles, & DO k = 1, n_rep_val CALL section_vals_val_get(ms_vib_section, "ATOMS", i_rep_val=k, i_vals=tmplist) DO j = 1, SIZE(tmplist) - jj = jj+1 + jj = jj + 1 END DO END DO IF (jj < 1) THEN @@ -369,7 +369,7 @@ SUBROUTINE MS_initial_moves(para_env, nrep, input, globenv, ms_vib, particles, & DO i = 1, nrep DO j = 1, natoms DO k = 1, 3 - jj = (map_atoms(j)-1)*3+k + jj = (map_atoms(j) - 1)*3 + k ms_vib%b_vec(jj, i) = ABS(next_random_number(globenv%gaussian_rng_stream)) END DO END DO @@ -383,7 +383,7 @@ SUBROUTINE MS_initial_moves(para_env, nrep, input, globenv, ms_vib, particles, & DO i = 1, nrep IF (i .NE. j) THEN ms_vib%b_vec(:, j) = & - ms_vib%b_vec(:, j)-DOT_PRODUCT(ms_vib%b_vec(:, j), ms_vib%b_vec(:, i))*ms_vib%b_vec(:, i) + ms_vib%b_vec(:, j) - DOT_PRODUCT(ms_vib%b_vec(:, j), ms_vib%b_vec(:, i))*ms_vib%b_vec(:, i) ms_vib%b_vec(:, j) = & ms_vib%b_vec(:, j)/SQRT(DOT_PRODUCT(ms_vib%b_vec(:, j), ms_vib%b_vec(:, j))) END IF @@ -498,17 +498,17 @@ SUBROUTINE bfgs_guess(ms_vib_section, ms_vib, particles, mass, para_env, nrep) CALL diamat_all(ms_vib%hes_bfgs, ms_vib%eig_bfgs) tmp(:) = 0._dp IF (ms_vib%select_id == 1) my_val = (ms_vib%sel_freq/vibfac)**2/massunit - IF (ms_vib%select_id == 2) my_val = (((ms_vib%f_range(2)+ms_vib%f_range(1))*0.5_dp)/vibfac)**2/massunit + IF (ms_vib%select_id == 2) my_val = (((ms_vib%f_range(2) + ms_vib%f_range(1))*0.5_dp)/vibfac)**2/massunit IF (ms_vib%select_id == 1 .OR. ms_vib%select_id == 2) THEN DO i = 1, ncoord - tmp(i) = ABS(my_val-ms_vib%eig_bfgs(i)) + tmp(i) = ABS(my_val - ms_vib%eig_bfgs(i)) END DO ELSE IF (ms_vib%select_id == 3) THEN DO i = 1, ncoord DO j = 1, SIZE(ms_vib%inv_atoms) DO k = 1, 3 - jj = (ms_vib%inv_atoms(j)-1)*3+k - tmp(i) = tmp(i)+SQRT(ms_vib%hes_bfgs(jj, i)**2) + jj = (ms_vib%inv_atoms(j) - 1)*3 + k + tmp(i) = tmp(i) + SQRT(ms_vib%hes_bfgs(jj, i)**2) END DO END DO IF ((SIGN(1._dp, ms_vib%eig_bfgs(i))*SQRT(ABS(ms_vib%eig_bfgs(i))*massunit)*vibfac) .LE. 400._dp) tmp(i) = 0._dp @@ -596,7 +596,7 @@ SUBROUTINE rest_guess(ms_vib_section, para_env, ms_vib, mass, ionode, particles, ALLOCATE (ms_vib%b_mat(ncoord, ms_vib%mat_size)) ALLOCATE (ms_vib%s_mat(ncoord, ms_vib%mat_size)) IF (calc_intens) THEN - ALLOCATE (ms_vib%dip_deriv(3, ms_vib%mat_size+nrep)) + ALLOCATE (ms_vib%dip_deriv(3, ms_vib%mat_size + nrep)) END IF IF (ionode) THEN statint = 0 @@ -631,7 +631,7 @@ SUBROUTINE rest_guess(ms_vib_section, para_env, ms_vib, mass, ionode, particles, ms_vib%b_vec = 0._dp DO i = 1, nrep DO j = 1, ms_vib%mat_size - ms_vib%b_vec(:, i) = ms_vib%b_vec(:, i)+approx_H(j, ind(i))*ms_vib%b_mat(:, j) + ms_vib%b_vec(:, i) = ms_vib%b_vec(:, i) + approx_H(j, ind(i))*ms_vib%b_mat(:, j) END DO ms_vib%b_vec(:, i) = ms_vib%b_vec(:, i)/SQRT(DOT_PRODUCT(ms_vib%b_vec(:, i), ms_vib%b_vec(:, i))) END DO @@ -712,24 +712,24 @@ SUBROUTINE molden_guess(ms_vib_section, input, para_env, ms_vib, mass, ncoord, n reading_vib = .FALSE. DO READ (iw, *, IOSTAT=stat) info - istat = istat+stat + istat = istat + stat IF (TRIM(ADJUSTL(info)) == "[FR-COORD]") EXIT CPASSERT(stat == 0) - IF (reading_vib) nvibs = nvibs+1 + IF (reading_vib) nvibs = nvibs + 1 IF (TRIM(ADJUSTL(info)) == "[FREQ]") reading_vib = .TRUE. END DO REWIND (iw) istat = 0 READ (iw, *, IOSTAT=stat) info - istat = istat+stat + istat = istat + stat READ (iw, *, IOSTAT=stat) info - istat = istat+stat + istat = istat + stat ! Skip [Atoms] section DO READ (iw, *, IOSTAT=stat) info - istat = istat+stat + istat = istat + stat CPASSERT(stat == 0) IF (TRIM(ADJUSTL(info)) == "[FREQ]") EXIT END DO @@ -739,21 +739,21 @@ SUBROUTINE molden_guess(ms_vib_section, input, para_env, ms_vib, mass, ncoord, n DO i = 1, nvibs READ (iw, *, IOSTAT=stat) freq(i) - istat = istat+stat + istat = istat + stat END DO READ (iw, *) info DO i = 1, ncoord/3 READ (iw, *, IOSTAT=stat) at_name, pos(:, i) - istat = istat+stat + istat = istat + stat END DO READ (iw, *) info DO i = 1, nvibs READ (iw, *) info - istat = istat+stat + istat = istat + stat DO j = 1, ncoord/3 - k = (j-1)*3+1 - READ (iw, *, IOSTAT=stat) modes(k:k+2, i) - istat = istat+stat + k = (j - 1)*3 + 1 + READ (iw, *, IOSTAT=stat) modes(k:k + 2, i) + istat = istat + stat END DO END DO IF (ms_filename .NE. "") CALL close_file(iw) @@ -769,17 +769,17 @@ SUBROUTINE molden_guess(ms_vib_section, input, para_env, ms_vib, mass, ncoord, n tmp(:) = 0.0_dp ALLOCATE (tmplist(nvibs)) IF (ms_vib%select_id == 1) my_val = ms_vib%sel_freq - IF (ms_vib%select_id == 2) my_val = (ms_vib%f_range(2)+ms_vib%f_range(1))*0.5_dp + IF (ms_vib%select_id == 2) my_val = (ms_vib%f_range(2) + ms_vib%f_range(1))*0.5_dp IF (ms_vib%select_id == 1 .OR. ms_vib%select_id == 2) THEN DO i = 1, nvibs - tmp(i) = ABS(my_val-freq(i)) + tmp(i) = ABS(my_val - freq(i)) END DO ELSE IF (ms_vib%select_id == 3) THEN DO i = 1, nvibs DO j = 1, SIZE(ms_vib%inv_atoms) DO k = 1, 3 - jj = (ms_vib%inv_atoms(j)-1)*3+k - tmp(i) = tmp(i)+SQRT(modes(jj, i)**2) + jj = (ms_vib%inv_atoms(j) - 1)*3 + k + tmp(i) = tmp(i) + SQRT(modes(jj, i)**2) END DO END DO IF (freq(i) .LE. 400._dp) tmp(i) = 0._dp @@ -870,8 +870,8 @@ SUBROUTINE evaluate_H_update_b(rep_env, ms_vib, input, nrep, & DEALLOCATE (ms_vib%s_mat) ENDIF - ALLOCATE (ms_vib%b_mat(3*natoms, ms_vib%mat_size+nrep)) - ALLOCATE (ms_vib%s_mat(3*natoms, ms_vib%mat_size+nrep)) + ALLOCATE (ms_vib%b_mat(3*natoms, ms_vib%mat_size + nrep)) + ALLOCATE (ms_vib%s_mat(3*natoms, ms_vib%mat_size + nrep)) ms_vib%s_mat = 0.0_dp @@ -883,7 +883,7 @@ SUBROUTINE evaluate_H_update_b(rep_env, ms_vib, input, nrep, & END DO END IF DO j = 1, nrep - ms_vib%b_mat(i, ms_vib%mat_size+j) = ms_vib%b_vec(i, j) + ms_vib%b_mat(i, ms_vib%mat_size + j) = ms_vib%b_vec(i, j) END DO END DO @@ -892,7 +892,7 @@ SUBROUTINE evaluate_H_update_b(rep_env, ms_vib, input, nrep, & DEALLOCATE (tmp_b) END IF - ms_vib%mat_size = ms_vib%mat_size+nrep + ms_vib%mat_size = ms_vib%mat_size + nrep ALLOCATE (approx_H(ms_vib%mat_size, ms_vib%mat_size)) ALLOCATE (H_save(ms_vib%mat_size, ms_vib%mat_size)) @@ -902,7 +902,7 @@ SUBROUTINE evaluate_H_update_b(rep_env, ms_vib, input, nrep, & DO i = 1, nrep DO j = 1, 3*natoms - ms_vib%s_mat(j, ms_vib%mat_size-nrep+i) = -(ms_vib%ms_force(j, i)-rep_env%f(j, i))/(2*ms_vib%step_b(i)*mass(j)) + ms_vib%s_mat(j, ms_vib%mat_size - nrep + i) = -(ms_vib%ms_force(j, i) - rep_env%f(j, i))/(2*ms_vib%step_b(i)*mass(j)) END DO END DO @@ -921,7 +921,7 @@ SUBROUTINE evaluate_H_update_b(rep_env, ms_vib, input, nrep, & DO i = 1, nrep DO j = 1, natoms DO k = 1, 3 - jj = (j-1)*3+k + jj = (j - 1)*3 + k ms_vib%delta_vec(jj, i) = ms_vib%b_vec(jj, i)/mass(jj) END DO END DO @@ -952,14 +952,14 @@ SUBROUTINE evaluate_H_update_b(rep_env, ms_vib, input, nrep, & END IF DO i = 1, ms_vib%mat_size DO j = 1, ms_vib%mat_size - tmp_b(:, i) = tmp_b(:, i)+approx_H(j, i)*ms_vib%b_mat(:, j)/mass(:) + tmp_b(:, i) = tmp_b(:, i) + approx_H(j, i)*ms_vib%b_mat(:, j)/mass(:) END DO tmp_b(:, i) = tmp_b(:, i)/SQRT(DOT_PRODUCT(tmp_b(:, i), tmp_b(:, i))) END DO IF (calc_intens) THEN DO i = 1, ms_vib%mat_size DO j = 1, ms_vib%mat_size - tmp_s(:, i) = tmp_s(:, i)+ms_vib%dip_deriv(:, j)*approx_H(j, i) + tmp_s(:, i) = tmp_s(:, i) + ms_vib%dip_deriv(:, j)*approx_H(j, i) END DO IF (calc_intens) intensities(i) = SQRT(DOT_PRODUCT(tmp_s(:, i), tmp_s(:, i))) END DO @@ -1031,13 +1031,13 @@ SUBROUTINE select_vector(ms_vib, nrep, mass, ncoord, approx_H, eigenval, ind, re CASE (1) my_val = (ms_vib%sel_freq/(vibfac))**2/massunit DO i = 1, ms_vib%mat_size - tmp(i) = ABS(my_val-eigenval(i)) + tmp(i) = ABS(my_val - eigenval(i)) END DO CALL sort(tmp, (ms_vib%mat_size), ind) residuum = 0._dp DO j = 1, nrep DO i = 1, ms_vib%mat_size - residuum(:, j) = residuum(:, j)+approx_H(i, ind(j))*(ms_vib%s_mat(:, i)-eigenval(ind(j))*ms_vib%b_mat(:, i)) + residuum(:, j) = residuum(:, j) + approx_H(i, ind(j))*(ms_vib%s_mat(:, i) - eigenval(ind(j))*ms_vib%b_mat(:, i)) END DO END DO CASE (2) @@ -1049,7 +1049,7 @@ SUBROUTINE select_vector(ms_vib, nrep, mass, ncoord, approx_H, eigenval, ind, re DO i = 1, ms_vib%mat_size DO j = 1, ms_vib%mat_size - tmp_b(:, i) = tmp_b(:, i)+approx_H(j, i)*ms_vib%b_mat(:, j)/mass(:) + tmp_b(:, i) = tmp_b(:, i) + approx_H(j, i)*ms_vib%b_mat(:, j)/mass(:) END DO tmp_b(:, i) = tmp_b(:, i)/SQRT(DOT_PRODUCT(tmp_b(:, i), tmp_b(:, i))) END DO @@ -1057,8 +1057,8 @@ SUBROUTINE select_vector(ms_vib, nrep, mass, ncoord, approx_H, eigenval, ind, re DO i = 1, ms_vib%mat_size DO j = 1, SIZE(ms_vib%inv_atoms) DO k = 1, 3 - jj = (ms_vib%inv_atoms(j)-1)*3+k - tmp(i) = tmp(i)+SQRT(tmp_b(jj, i)**2) + jj = (ms_vib%inv_atoms(j) - 1)*3 + k + tmp(i) = tmp(i) + SQRT(tmp_b(jj, i)**2) END DO END DO IF (.NOT. ASSOCIATED(ms_vib%inv_range)) THEN @@ -1074,7 +1074,7 @@ SUBROUTINE select_vector(ms_vib, nrep, mass, ncoord, approx_H, eigenval, ind, re DO j = 1, nrep DO i = 1, ms_vib%mat_size - residuum(:, j) = residuum(:, j)+approx_H(i, ind(j))*(ms_vib%s_mat(:, i)-eigenval(ind(j))*ms_vib%b_mat(:, i)) + residuum(:, j) = residuum(:, j) + approx_H(i, ind(j))*(ms_vib%s_mat(:, i) - eigenval(ind(j))*ms_vib%b_mat(:, i)) END DO END DO DEALLOCATE (tmp_b) @@ -1082,7 +1082,7 @@ SUBROUTINE select_vector(ms_vib, nrep, mass, ncoord, approx_H, eigenval, ind, re DO j = 1, nrep DO i = 1, ms_vib%mat_size - residuum(:, j) = residuum(:, j)-DOT_PRODUCT(residuum(:, j), ms_vib%b_mat(:, i))*ms_vib%b_mat(:, i) + residuum(:, j) = residuum(:, j) - DOT_PRODUCT(residuum(:, j), ms_vib%b_mat(:, i))*ms_vib%b_mat(:, i) END DO END DO IF (PRESENT(criteria)) THEN @@ -1100,13 +1100,13 @@ SUBROUTINE select_vector(ms_vib, nrep, mass, ncoord, approx_H, eigenval, ind, re DO k = 1, 10 DO j = 1, nrep DO i = 1, ms_vib%mat_size - residuum(:, j) = residuum(:, j)-DOT_PRODUCT(residuum(:, j), ms_vib%b_mat(:, i))*ms_vib%b_mat(:, i) + residuum(:, j) = residuum(:, j) - DOT_PRODUCT(residuum(:, j), ms_vib%b_mat(:, i))*ms_vib%b_mat(:, i) residuum(:, j) = residuum(:, j)/SQRT(DOT_PRODUCT(residuum(:, j), residuum(:, j))) END DO IF (nrep .GT. 1) THEN DO i = 1, nrep IF (i .NE. j) THEN - residuum(:, j) = residuum(:, j)-DOT_PRODUCT(residuum(:, j), residuum(:, i))*residuum(:, i) + residuum(:, j) = residuum(:, j) - DOT_PRODUCT(residuum(:, j), residuum(:, i))*residuum(:, i) residuum(:, j) = residuum(:, j)/SQRT(DOT_PRODUCT(residuum(:, j), residuum(:, j))) END IF END DO @@ -1176,10 +1176,10 @@ SUBROUTINE ms_out(iw, converged, freq, criter, ms_vib, input, nrep, & DO i = 1, SIZE(ms_vib%b_mat, 2) residuum = 0._dp DO j = 1, SIZE(ms_vib%b_mat, 2) - residuum(:) = residuum(:)+approx_H(j, i)*(ms_vib%s_mat(:, j)-eigenval(i)*ms_vib%b_mat(:, j)) + residuum(:) = residuum(:) + approx_H(j, i)*(ms_vib%s_mat(:, j) - eigenval(i)*ms_vib%b_mat(:, j)) END DO DO j = 1, ms_vib%mat_size - residuum(:) = residuum(:)-DOT_PRODUCT(residuum(:), ms_vib%b_mat(:, j))*ms_vib%b_mat(:, j) + residuum(:) = residuum(:) - DOT_PRODUCT(residuum(:), ms_vib%b_mat(:, j))*ms_vib%b_mat(:, j) END DO crit_a = MAXVAL(residuum(:)) crit_b = SQRT(DOT_PRODUCT(residuum, residuum)) @@ -1282,21 +1282,21 @@ SUBROUTINE get_vibs_in_range(ms_vib, approx_H, eigenval, residuum, nrep, ind) ALLOCATE (map1(SIZE(eigenval), 2)) ALLOCATE (tmp(SIZE(eigenval))) DO i = 1, SIZE(eigenval) - IF (ABS(eigenval(i)-myrange(1))+ABS(eigenval(i)-myrange(2)) .LE. & - ABS(myrange(1)-myrange(2))+myrange(1)*0.001_dp) THEN - count1 = count1+1 + IF (ABS(eigenval(i) - myrange(1)) + ABS(eigenval(i) - myrange(2)) .LE. & + ABS(myrange(1) - myrange(2)) + myrange(1)*0.001_dp) THEN + count1 = count1 + 1 map1(count1, 1) = i ELSE - count2 = count2+1 + count2 = count2 + 1 map1(count2, 2) = i - tmp(count2) = MIN(ABS(eigenval(i)-myrange(1)), ABS(eigenval(i)-myrange(2))) + tmp(count2) = MIN(ABS(eigenval(i) - myrange(1)), ABS(eigenval(i) - myrange(2))) END IF END DO IF (count1 .EQ. nrep) THEN DO j = 1, count1 DO i = 1, ms_vib%mat_size - residuum(:, j) = residuum(:, j)+approx_H(i, map1(j, 1))*(ms_vib%s_mat(:, i)-eigenval(map1(j, 1))*ms_vib%b_mat(:, i)) + residuum(:, j) = residuum(:, j) + approx_H(i, map1(j, 1))*(ms_vib%s_mat(:, i) - eigenval(map1(j, 1))*ms_vib%b_mat(:, i)) ind(j) = map1(j, 1) END DO END DO @@ -1307,21 +1307,21 @@ SUBROUTINE get_vibs_in_range(ms_vib, approx_H, eigenval, residuum, nrep, ind) tmp_resid = 0._dp DO j = 1, count1 DO i = 1, ms_vib%mat_size - tmp_resid(:, j) = tmp_resid(:, j)+approx_H(i, map1(j, 1))* & - (ms_vib%s_mat(:, i)-eigenval(map1(j, 1))*ms_vib%b_mat(:, i)) + tmp_resid(:, j) = tmp_resid(:, j) + approx_H(i, map1(j, 1))* & + (ms_vib%s_mat(:, i) - eigenval(map1(j, 1))*ms_vib%b_mat(:, i)) END DO END DO DO j = 1, count1 DO i = 1, ms_vib%mat_size - tmp_resid(:, j) = tmp_resid(:, j)-DOT_PRODUCT(tmp_resid(:, j), ms_vib%b_mat(:, i))*ms_vib%b_mat(:, i) + tmp_resid(:, j) = tmp_resid(:, j) - DOT_PRODUCT(tmp_resid(:, j), ms_vib%b_mat(:, i))*ms_vib%b_mat(:, i) END DO tmp(j) = MAXVAL(tmp_resid(:, j)) END DO CALL sort(tmp, count1, map2) DO j = 1, nrep - residuum(:, j) = tmp_resid(:, map2(count1+1-j)) - ind(j) = map1(map2(count1+1-j), 1) + residuum(:, j) = tmp_resid(:, map2(count1 + 1 - j)) + ind(j) = map1(map2(count1 + 1 - j), 1) END DO DEALLOCATE (tmp_resid) DEALLOCATE (tmp1) @@ -1332,19 +1332,19 @@ SUBROUTINE get_vibs_in_range(ms_vib, approx_H, eigenval, residuum, nrep, ind) IF (count1 .NE. 0) THEN DO j = 1, count1 DO i = 1, ms_vib%mat_size - residuum(:, j) = residuum(:, j)+approx_H(i, map1(j, 1))* & - (ms_vib%s_mat(:, i)-eigenval(map1(j, 1))*ms_vib%b_mat(:, i)) + residuum(:, j) = residuum(:, j) + approx_H(i, map1(j, 1))* & + (ms_vib%s_mat(:, i) - eigenval(map1(j, 1))*ms_vib%b_mat(:, i)) END DO ind(j) = map1(j, 1) END DO END IF CALL sort(tmp, count2, map2) - DO j = 1, nrep-count1 + DO j = 1, nrep - count1 DO i = 1, ms_vib%mat_size - residuum(:, count1+j) = residuum(:, count1+j)+approx_H(i, map1(map2(j), 2)) & - *(ms_vib%s_mat(:, i)-eigenval(map1(map2(j), 2))*ms_vib%b_mat(:, i)) + residuum(:, count1 + j) = residuum(:, count1 + j) + approx_H(i, map1(map2(j), 2)) & + *(ms_vib%s_mat(:, i) - eigenval(map1(map2(j), 2))*ms_vib%b_mat(:, i)) END DO - ind(count1+j) = map1(map2(j), 2) + ind(count1 + j) = map1(map2(j), 2) END DO DEALLOCATE (map2) diff --git a/src/mol_force.F b/src/mol_force.F index aba9f5612a..e96075ca97 100644 --- a/src/mol_force.F +++ b/src/mol_force.F @@ -53,30 +53,30 @@ SUBROUTINE force_bonds(id_type, rij, r0, k, cs, energy, fscalar) SELECT CASE (id_type) CASE (do_ff_quartic) dij = SQRT(DOT_PRODUCT(rij, rij)) - disp = dij-r0 - energy = (f12*k(1)+(f13*k(2)+f14*k(3)*disp)*disp)*disp*disp - fscalar = ((k(1)+(k(2)+k(3)*disp)*disp)*disp)/dij + disp = dij - r0 + energy = (f12*k(1) + (f13*k(2) + f14*k(3)*disp)*disp)*disp*disp + fscalar = ((k(1) + (k(2) + k(3)*disp)*disp)*disp)/dij CASE (do_ff_morse) dij = SQRT(DOT_PRODUCT(rij, rij)) - disp = dij-r0 - energy = k(1)*((1-EXP(-k(2)*disp))**2-1) - fscalar = 2*k(1)*k(2)*EXP(-k(2)*disp)*(1-EXP(-k(2)*disp))/dij + disp = dij - r0 + energy = k(1)*((1 - EXP(-k(2)*disp))**2 - 1) + fscalar = 2*k(1)*k(2)*EXP(-k(2)*disp)*(1 - EXP(-k(2)*disp))/dij CASE (do_ff_cubic) dij = SQRT(DOT_PRODUCT(rij, rij)) - disp = dij-r0 - energy = k(1)*disp**2*(1+cs*disp+7.0_dp/12.0_dp*cs**2*disp**2) - fscalar = (2.0_dp*k(1)*disp*(1+cs*disp+7.0_dp/12.0_dp*cs**2*disp**2)+ & - k(1)*disp**2*(cs+2.0_dp*7.0_dp/12.0_dp*cs**2*disp))/dij + disp = dij - r0 + energy = k(1)*disp**2*(1 + cs*disp + 7.0_dp/12.0_dp*cs**2*disp**2) + fscalar = (2.0_dp*k(1)*disp*(1 + cs*disp + 7.0_dp/12.0_dp*cs**2*disp**2) + & + k(1)*disp**2*(cs + 2.0_dp*7.0_dp/12.0_dp*cs**2*disp))/dij CASE (do_ff_g96) ! From GROMOS... ! V = (1/4)*Kb*(rij**2 - bij**2)**2 dij = DOT_PRODUCT(rij, rij) - disp = dij-r0*r0 + disp = dij - r0*r0 energy = f14*k(1)*disp*disp fscalar = k(1)*disp CASE (do_ff_charmm, do_ff_amber) dij = SQRT(DOT_PRODUCT(rij, rij)) - disp = dij-r0 + disp = dij - r0 IF (ABS(disp) < EPSILON(1.0_dp)) THEN energy = 0.0_dp fscalar = 0.0_dp @@ -86,7 +86,7 @@ SUBROUTINE force_bonds(id_type, rij, r0, k, cs, energy, fscalar) END IF CASE (do_ff_harmonic, do_ff_g87) dij = SQRT(DOT_PRODUCT(rij, rij)) - disp = dij-r0 + disp = dij - r0 IF (ABS(disp) < EPSILON(1.0_dp)) THEN energy = 0.0_dp fscalar = 0.0_dp @@ -97,8 +97,8 @@ SUBROUTINE force_bonds(id_type, rij, r0, k, cs, energy, fscalar) CASE (do_ff_fues) dij = SQRT(DOT_PRODUCT(rij, rij)) disp = r0/dij - energy = f12*k(1)*r0*r0*(1.0_dp+disp*(disp-2.0_dp)) - fscalar = k(1)*r0*disp*disp*(1.0_dp-disp)/dij + energy = f12*k(1)*r0*r0*(1.0_dp + disp*(disp - 2.0_dp)) + fscalar = k(1)*r0*disp*disp*(1.0_dp - disp)/dij CASE DEFAULT CPABORT("Unmatched bond kind") END SELECT @@ -154,104 +154,104 @@ SUBROUTINE force_bends(id_type, b12, b32, d12, d32, id12, id32, dist, & SELECT CASE (id_type) CASE (do_ff_g96) - energy = f12*k*(COS(theta)-theta0)**2 - fscalar = -k*(COS(theta)-theta0) - g1 = (b32*id32-b12*id12*COS(theta))*id12 - g3 = (b12*id12-b32*id32*COS(theta))*id32 - g2 = -g1-g3 + energy = f12*k*(COS(theta) - theta0)**2 + fscalar = -k*(COS(theta) - theta0) + g1 = (b32*id32 - b12*id12*COS(theta))*id12 + g3 = (b12*id12 - b32*id32*COS(theta))*id32 + g2 = -g1 - g3 CASE (do_ff_charmm, do_ff_amber) denom = id12*id12*id32*id32 - energy = k*(theta-theta0)**2 - fscalar = 2.0_dp*k*(theta-theta0)/SIN(theta) - g1 = (b32*d12*d32-dist*d32*id12*b12)*denom - g2 = (-(b12+b32)*d12*d32+dist*(d32*id12*b12+id32*d12*b32))*denom - g3 = (b12*d12*d32-dist*id32*d12*b32)*denom + energy = k*(theta - theta0)**2 + fscalar = 2.0_dp*k*(theta - theta0)/SIN(theta) + g1 = (b32*d12*d32 - dist*d32*id12*b12)*denom + g2 = (-(b12 + b32)*d12*d32 + dist*(d32*id12*b12 + id32*d12*b32))*denom + g3 = (b12*d12*d32 - dist*id32*d12*b32)*denom CASE (do_ff_cubic) denom = id12*id12*id32*id32 - energy = k*(theta-theta0)**2*(1.0_dp+cb*(theta-theta0)) - fscalar = (2.0_dp*k*(theta-theta0)*(1.0_dp+cb*(theta-theta0))+k*(theta-theta0)**2*cb)/SIN(theta) - g1 = (b32*d12*d32-dist*d32*id12*b12)*denom - g2 = (-(b12+b32)*d12*d32+dist*(d32*id12*b12+id32*d12*b32))*denom - g3 = (b12*d12*d32-dist*id32*d12*b32)*denom + energy = k*(theta - theta0)**2*(1.0_dp + cb*(theta - theta0)) + fscalar = (2.0_dp*k*(theta - theta0)*(1.0_dp + cb*(theta - theta0)) + k*(theta - theta0)**2*cb)/SIN(theta) + g1 = (b32*d12*d32 - dist*d32*id12*b12)*denom + g2 = (-(b12 + b32)*d12*d32 + dist*(d32*id12*b12 + id32*d12*b32))*denom + g3 = (b12*d12*d32 - dist*id32*d12*b32)*denom CASE (do_ff_mixed_bend_stretch) ! 1) cubic term in theta (do_ff_cubic) - energy = k*(theta-theta0)**2*(1.0_dp+cb*(theta-theta0)) - fscalar = (2.0_dp*k*(theta-theta0)*(1.0_dp+cb*(theta-theta0))+k*(theta-theta0)**2*cb)/SIN(theta) + energy = k*(theta - theta0)**2*(1.0_dp + cb*(theta - theta0)) + fscalar = (2.0_dp*k*(theta - theta0)*(1.0_dp + cb*(theta - theta0)) + k*(theta - theta0)**2*cb)/SIN(theta) denom = id12*id12*id32*id32 - g1 = (b32*d12*d32-dist*d32*id12*b12)*denom*fscalar - g2 = (-(b12+b32)*d12*d32+dist*(d32*id12*b12+id32*d12*b32))*denom*fscalar - g3 = (b12*d12*d32-dist*id32*d12*b32)*denom*fscalar + g1 = (b32*d12*d32 - dist*d32*id12*b12)*denom*fscalar + g2 = (-(b12 + b32)*d12*d32 + dist*(d32*id12*b12 + id32*d12*b32))*denom*fscalar + g3 = (b12*d12*d32 - dist*id32*d12*b32)*denom*fscalar ! 2) stretch-stretch term - disp12 = d12-r012 - disp32 = d32-r032 - energy = energy+kss*disp12*disp32 - g1 = g1-kss*disp32*id12*b12 - g2 = g2+kss*disp32*id12*b12 - g3 = g3-kss*disp12*id32*b32 - g2 = g2+kss*disp12*id32*b32 + disp12 = d12 - r012 + disp32 = d32 - r032 + energy = energy + kss*disp12*disp32 + g1 = g1 - kss*disp32*id12*b12 + g2 = g2 + kss*disp32*id12*b12 + g3 = g3 - kss*disp12*id32*b32 + g2 = g2 + kss*disp12*id32*b32 ! 3) bend-stretch term - energy = energy+kbs12*disp12*(theta-theta0)+kbs32*disp32*(theta-theta0) - fscalar = (kbs12*disp12+kbs32*disp32)/SIN(theta) + energy = energy + kbs12*disp12*(theta - theta0) + kbs32*disp32*(theta - theta0) + fscalar = (kbs12*disp12 + kbs32*disp32)/SIN(theta) denom = id12*id12*id32*id32 ! 3a) bend part - g1 = g1+(b32*d12*d32-dist*d32*id12*b12)*denom*fscalar - g2 = g2+(-(b12+b32)*d12*d32+dist*(d32*id12*b12+id32*d12*b32))*denom*fscalar - g3 = g3+(b12*d12*d32-dist*id32*d12*b32)*denom*fscalar + g1 = g1 + (b32*d12*d32 - dist*d32*id12*b12)*denom*fscalar + g2 = g2 + (-(b12 + b32)*d12*d32 + dist*(d32*id12*b12 + id32*d12*b32))*denom*fscalar + g3 = g3 + (b12*d12*d32 - dist*id32*d12*b32)*denom*fscalar ! 3b) stretch part - g1 = g1-kbs12*(theta-theta0)*id12*b12 - g2 = g2+kbs12*(theta-theta0)*id12*b12 - g3 = g3-kbs32*(theta-theta0)*id32*b32 - g2 = g2+kbs32*(theta-theta0)*id32*b32 + g1 = g1 - kbs12*(theta - theta0)*id12*b12 + g2 = g2 + kbs12*(theta - theta0)*id12*b12 + g3 = g3 - kbs32*(theta - theta0)*id32*b32 + g2 = g2 + kbs32*(theta - theta0)*id32*b32 ! fscalar is already included in g1, g2 and g3 fscalar = 1.0_dp CASE (do_ff_harmonic, do_ff_g87) denom = id12*id12*id32*id32 - energy = f12*k*(theta-theta0)**2 - fscalar = k*(theta-theta0)/SIN(theta) - g1 = (b32*d12*d32-dist*d32*id12*b12)*denom - g2 = (-(b12+b32)*d12*d32+dist*(d32*id12*b12+id32*d12*b32))*denom - g3 = (b12*d12*d32-dist*id32*d12*b32)*denom + energy = f12*k*(theta - theta0)**2 + fscalar = k*(theta - theta0)/SIN(theta) + g1 = (b32*d12*d32 - dist*d32*id12*b12)*denom + g2 = (-(b12 + b32)*d12*d32 + dist*(d32*id12*b12 + id32*d12*b32))*denom + g3 = (b12*d12*d32 - dist*id32*d12*b32)*denom CASE (do_ff_mm3) ! 1) up to sixth order in theta - energy = k*(theta-theta0)**2*(0.5_dp+(theta-theta0)* & - (-0.007_dp+(theta-theta0)*(2.8E-5_dp+(theta-theta0)* & - (-3.5E-7_dp+(theta-theta0)*4.5E-10_dp)))) + energy = k*(theta - theta0)**2*(0.5_dp + (theta - theta0)* & + (-0.007_dp + (theta - theta0)*(2.8E-5_dp + (theta - theta0)* & + (-3.5E-7_dp + (theta - theta0)*4.5E-10_dp)))) - fscalar = k*(theta-theta0)*(1.0_dp+(theta-theta0)* & - (-0.021_dp+(theta-theta0)*(1.12E-4_dp+ & - (theta-theta0)*(-1.75E-6_dp+(theta-theta0)*2.7E-9_dp))))/ & + fscalar = k*(theta - theta0)*(1.0_dp + (theta - theta0)* & + (-0.021_dp + (theta - theta0)*(1.12E-4_dp + & + (theta - theta0)*(-1.75E-6_dp + (theta - theta0)*2.7E-9_dp))))/ & SIN(theta) denom = id12*id12*id32*id32 - g1 = (b32*d12*d32-dist*d32*id12*b12)*denom*fscalar - g2 = (-(b12+b32)*d12*d32+dist*(d32*id12*b12+id32*d12*b32))*denom*fscalar - g3 = (b12*d12*d32-dist*id32*d12*b32)*denom*fscalar + g1 = (b32*d12*d32 - dist*d32*id12*b12)*denom*fscalar + g2 = (-(b12 + b32)*d12*d32 + dist*(d32*id12*b12 + id32*d12*b32))*denom*fscalar + g3 = (b12*d12*d32 - dist*id32*d12*b32)*denom*fscalar ! 2) bend-stretch term - disp12 = d12-r012 - disp32 = d32-r032 - energy = energy+kbs12*disp12*(theta-theta0)+kbs32*disp32*(theta-theta0) - fscalar = (kbs12*disp12+kbs32*disp32)/SIN(theta) + disp12 = d12 - r012 + disp32 = d32 - r032 + energy = energy + kbs12*disp12*(theta - theta0) + kbs32*disp32*(theta - theta0) + fscalar = (kbs12*disp12 + kbs32*disp32)/SIN(theta) denom = id12*id12*id32*id32 ! 2a) bend part - g1 = g1+(b32*d12*d32-dist*d32*id12*b12)*denom*fscalar - g2 = g2+(-(b12+b32)*d12*d32+dist*(d32*id12*b12+id32*d12*b32))*denom*fscalar - g3 = g3+(b12*d12*d32-dist*id32*d12*b32)*denom*fscalar + g1 = g1 + (b32*d12*d32 - dist*d32*id12*b12)*denom*fscalar + g2 = g2 + (-(b12 + b32)*d12*d32 + dist*(d32*id12*b12 + id32*d12*b32))*denom*fscalar + g3 = g3 + (b12*d12*d32 - dist*id32*d12*b32)*denom*fscalar ! 2b) stretch part - g1 = g1-kbs12*(theta-theta0)*id12*b12 - g2 = g2+kbs12*(theta-theta0)*id12*b12 - g3 = g3-kbs32*(theta-theta0)*id32*b32 - g2 = g2+kbs32*(theta-theta0)*id32*b32 + g1 = g1 - kbs12*(theta - theta0)*id12*b12 + g2 = g2 + kbs12*(theta - theta0)*id12*b12 + g3 = g3 - kbs32*(theta - theta0)*id32*b32 + g2 = g2 + kbs32*(theta - theta0)*id32*b32 ! fscalar is already included in g1, g2 and g3 fscalar = 1.0_dp @@ -301,19 +301,19 @@ SUBROUTINE force_bends(id_type, b12, b32, d12, d32, id12, id32, dist, & yd1 = 0.0d0 yd2 = 0.0d0 DO i = legendre%order, 2, -1 - y0 = (2*i-1)*ctheta*y1/i-i*y2/(i+1)+legendre%coeffs(i) + y0 = (2*i - 1)*ctheta*y1/i - i*y2/(i + 1) + legendre%coeffs(i) y2 = y1 y1 = y0 - yd0 = (2*i-1)*ctheta*yd1/(i-1)-(i+1)*yd2/i+legendre%coeffs(i) + yd0 = (2*i - 1)*ctheta*yd1/(i - 1) - (i + 1)*yd2/i + legendre%coeffs(i) yd2 = yd1 yd1 = yd0 END DO - energy = -f12*y2+ctheta*y1+legendre%coeffs(1) + energy = -f12*y2 + ctheta*y1 + legendre%coeffs(1) fscalar = -yd1 - g1 = (b32*id32-b12*id12*ctheta)*id12 - g3 = (b12*id12-b32*id32*ctheta)*id32 - g2 = -g1-g3 + g1 = (b32*id32 - b12*id12*ctheta)*id12 + g3 = (b12*id12 - b32*id32*ctheta)*id32 + g2 = -g1 - g3 CASE DEFAULT CPABORT("Unmatched bend kind") @@ -369,10 +369,10 @@ SUBROUTINE force_torsions(id_type, s32, is32, ism, isn, dist1, dist2, tm, & SELECT CASE (id_type) CASE (do_ff_charmm, do_ff_g87, do_ff_g96, do_ff_amber, do_ff_opls) ! compute energy - energy = k*(1.0_dp+COS(m*phi-phi0)) + energy = k*(1.0_dp + COS(m*phi - phi0)) ! compute fscalar - fscalar = k*m*SIN(m*phi-phi0) + fscalar = k*m*SIN(m*phi - phi0) CASE DEFAULT CPABORT("Unmatched torsion kind") END SELECT @@ -380,8 +380,8 @@ SUBROUTINE force_torsions(id_type, s32, is32, ism, isn, dist1, dist2, tm, & ! compute the gradients gt1 = (s32*ism*ism)*tm gt4 = -(s32*isn*isn)*tn - gt2 = (dist1*is32**2-1.0_dp)*gt1-dist2*is32**2*gt4 - gt3 = (dist2*is32**2-1.0_dp)*gt4-dist1*is32**2*gt1 + gt2 = (dist1*is32**2 - 1.0_dp)*gt1 - dist2*is32**2*gt4 + gt3 = (dist2*is32**2 - 1.0_dp)*gt4 - dist1*is32**2*gt1 END SUBROUTINE force_torsions ! ************************************************************************************************** @@ -433,17 +433,17 @@ SUBROUTINE force_imp_torsions(id_type, s32, is32, ism, isn, dist1, dist2, tm, & SELECT CASE (id_type) CASE (do_ff_charmm) ! compute energy - energy = k*(phi-phi0)**2 + energy = k*(phi - phi0)**2 ! compute fscalar - fscalar = -2.0_dp*k*(phi-phi0) + fscalar = -2.0_dp*k*(phi - phi0) CASE (do_ff_harmonic, do_ff_g87, do_ff_g96) ! compute energy - energy = f12*k*(phi-phi0)**2 + energy = f12*k*(phi - phi0)**2 ! compute fscalar - fscalar = -k*(phi-phi0) + fscalar = -k*(phi - phi0) CASE DEFAULT CPABORT("Unmatched improper kind") @@ -452,8 +452,8 @@ SUBROUTINE force_imp_torsions(id_type, s32, is32, ism, isn, dist1, dist2, tm, & ! compute the gradients gt1 = (s32*ism*ism)*tm gt4 = -(s32*isn*isn)*tn - gt2 = (dist1*is32**2-1.0_dp)*gt1-dist2*is32**2*gt4 - gt3 = (dist2*is32**2-1.0_dp)*gt4-dist1*is32**2*gt1 + gt2 = (dist1*is32**2 - 1.0_dp)*gt1 - dist2*is32**2*gt4 + gt3 = (dist2*is32**2 - 1.0_dp)*gt4 - dist1*is32**2*gt1 END SUBROUTINE force_imp_torsions ! ************************************************************************************************** @@ -509,7 +509,7 @@ SUBROUTINE force_opbends(id_type, s32, tm, & E = DOT_PRODUCT(-t41, tm) C = DOT_PRODUCT(tm, tm) D = E**2/C - b = DOT_PRODUCT(t41, t41)-D + b = DOT_PRODUCT(t41, t41) - D !inverse norm of t41 is41 = 1.0_dp/SQRT(DOT_PRODUCT(t41, t41)) @@ -522,17 +522,17 @@ SUBROUTINE force_opbends(id_type, s32, tm, & SELECT CASE (id_type) CASE (do_ff_mm2, do_ff_mm3, do_ff_mm4) ! compute energy - energy = k*(phi-phi0)**2 + energy = k*(phi - phi0)**2 ! compute fscalar - fscalar = 2.0_dp*k*(phi-phi0)*is41 + fscalar = 2.0_dp*k*(phi - phi0)*is41 CASE (do_ff_harmonic) ! compute energy - energy = f12*k*(phi-phi0)**2 + energy = f12*k*(phi - phi0)**2 ! compute fscalar - fscalar = k*(phi-phi0)*is41 + fscalar = k*(phi - phi0)*is41 CASE DEFAULT CPABORT("Unmatched opbend kind") @@ -541,29 +541,29 @@ SUBROUTINE force_opbends(id_type, s32, tm, & !Computing the necessary intermediate variables. dX_dqi is the gradient !of X with respect to the coordinates of particle i. - dE_dq1(1) = (t42(2)*t43(3)-t43(2)*t42(3)) - dE_dq1(2) = (-t42(1)*t43(3)+t43(1)*t42(3)) - dE_dq1(3) = (t42(1)*t43(2)-t43(1)*t42(2)) + dE_dq1(1) = (t42(2)*t43(3) - t43(2)*t42(3)) + dE_dq1(2) = (-t42(1)*t43(3) + t43(1)*t42(3)) + dE_dq1(3) = (t42(1)*t43(2) - t43(1)*t42(2)) - dE_dq2(1) = (t43(2)*t41(3)-t41(2)*t43(3)) - dE_dq2(2) = (-t43(1)*t41(3)+t41(1)*t43(3)) - dE_dq2(3) = (t43(1)*t41(2)-t41(1)*t43(2)) + dE_dq2(1) = (t43(2)*t41(3) - t41(2)*t43(3)) + dE_dq2(2) = (-t43(1)*t41(3) + t41(1)*t43(3)) + dE_dq2(3) = (t43(1)*t41(2) - t41(1)*t43(2)) - dE_dq3(1) = (t41(2)*t42(3)-t42(2)*t41(3)) - dE_dq3(2) = (-t41(1)*t42(3)+t42(1)*t41(3)) - dE_dq3(3) = (t41(1)*t42(2)-t42(1)*t41(2)) + dE_dq3(1) = (t41(2)*t42(3) - t42(2)*t41(3)) + dE_dq3(2) = (-t41(1)*t42(3) + t42(1)*t41(3)) + dE_dq3(3) = (t41(1)*t42(2) - t42(1)*t41(2)) - dC_dq1 = 2.0_dp*((t42-t41)*s32**2-(t42-t43)*DOT_PRODUCT(t42-t41, t42-t43)) - dC_dq3 = 2.0_dp*((t42-t43)*DOT_PRODUCT(t41-t42, t41-t42) & - -(t42-t41)*DOT_PRODUCT(t42-t41, t42-t43)) + dC_dq1 = 2.0_dp*((t42 - t41)*s32**2 - (t42 - t43)*DOT_PRODUCT(t42 - t41, t42 - t43)) + dC_dq3 = 2.0_dp*((t42 - t43)*DOT_PRODUCT(t41 - t42, t41 - t42) & + - (t42 - t41)*DOT_PRODUCT(t42 - t41, t42 - t43)) !C only dependent of atom 1 2 and 3, using translational invariance we find - dC_dq2 = -(dC_dq1+dC_dq3) + dC_dq2 = -(dC_dq1 + dC_dq3) - dD_dq1 = (2.0_dp*E*dE_dq1-D*dC_dq1)/C - dD_dq2 = (2.0_dp*E*dE_dq2-D*dC_dq2)/C - dD_dq3 = (2.0_dp*E*dE_dq3-D*dC_dq3)/C + dD_dq1 = (2.0_dp*E*dE_dq1 - D*dC_dq1)/C + dD_dq2 = (2.0_dp*E*dE_dq2 - D*dC_dq2)/C + dD_dq3 = (2.0_dp*E*dE_dq3 - D*dC_dq3)/C - db_dq1 = -2.0_dp*t41-dD_dq1 + db_dq1 = -2.0_dp*t41 - dD_dq1 db_dq2 = -dD_dq2 db_dq3 = -dD_dq3 @@ -576,13 +576,13 @@ SUBROUTINE force_opbends(id_type, s32, tm, & gt1 = -SIGN(1.0_dp, phi)/SQRT(C)*dE_dq1 gt2 = -SIGN(1.0_dp, phi)/SQRT(C)*dE_dq2 gt3 = -SIGN(1.0_dp, phi)/SQRT(C)*dE_dq3 - gt4 = -(gt1+gt2+gt3) + gt4 = -(gt1 + gt2 + gt3) ELSE - gt1 = (1.0_dp/(2.0_dp*SQRT(b))*db_dq1+cosphi*t41*is41)/SIN(phi) + gt1 = (1.0_dp/(2.0_dp*SQRT(b))*db_dq1 + cosphi*t41*is41)/SIN(phi) gt2 = (1.0_dp/(2.0_dp*SQRT(b))*db_dq2)/SIN(phi) gt3 = (1.0_dp/(2.0_dp*SQRT(b))*db_dq3)/SIN(phi) - gt4 = -(gt1+gt2+gt3) + gt4 = -(gt1 + gt2 + gt3) END IF END SUBROUTINE force_opbends @@ -601,15 +601,15 @@ SUBROUTINE get_pv_bond(f12, r12, pv_bond) CHARACTER(len=*), PARAMETER :: routineN = 'get_pv_bond', routineP = moduleN//':'//routineN - pv_bond(1, 1) = pv_bond(1, 1)+f12(1)*r12(1) - pv_bond(1, 2) = pv_bond(1, 2)+f12(1)*r12(2) - pv_bond(1, 3) = pv_bond(1, 3)+f12(1)*r12(3) - pv_bond(2, 1) = pv_bond(2, 1)+f12(2)*r12(1) - pv_bond(2, 2) = pv_bond(2, 2)+f12(2)*r12(2) - pv_bond(2, 3) = pv_bond(2, 3)+f12(2)*r12(3) - pv_bond(3, 1) = pv_bond(3, 1)+f12(3)*r12(1) - pv_bond(3, 2) = pv_bond(3, 2)+f12(3)*r12(2) - pv_bond(3, 3) = pv_bond(3, 3)+f12(3)*r12(3) + pv_bond(1, 1) = pv_bond(1, 1) + f12(1)*r12(1) + pv_bond(1, 2) = pv_bond(1, 2) + f12(1)*r12(2) + pv_bond(1, 3) = pv_bond(1, 3) + f12(1)*r12(3) + pv_bond(2, 1) = pv_bond(2, 1) + f12(2)*r12(1) + pv_bond(2, 2) = pv_bond(2, 2) + f12(2)*r12(2) + pv_bond(2, 3) = pv_bond(2, 3) + f12(2)*r12(3) + pv_bond(3, 1) = pv_bond(3, 1) + f12(3)*r12(1) + pv_bond(3, 2) = pv_bond(3, 2) + f12(3)*r12(2) + pv_bond(3, 3) = pv_bond(3, 3) + f12(3)*r12(3) END SUBROUTINE get_pv_bond @@ -630,24 +630,24 @@ SUBROUTINE get_pv_bend(f1, f3, r12, r32, pv_bend) CHARACTER(len=*), PARAMETER :: routineN = 'get_pv_bend', routineP = moduleN//':'//routineN - pv_bend(1, 1) = pv_bend(1, 1)+f1(1)*r12(1) - pv_bend(1, 1) = pv_bend(1, 1)+f3(1)*r32(1) - pv_bend(1, 2) = pv_bend(1, 2)+f1(1)*r12(2) - pv_bend(1, 2) = pv_bend(1, 2)+f3(1)*r32(2) - pv_bend(1, 3) = pv_bend(1, 3)+f1(1)*r12(3) - pv_bend(1, 3) = pv_bend(1, 3)+f3(1)*r32(3) - pv_bend(2, 1) = pv_bend(2, 1)+f1(2)*r12(1) - pv_bend(2, 1) = pv_bend(2, 1)+f3(2)*r32(1) - pv_bend(2, 2) = pv_bend(2, 2)+f1(2)*r12(2) - pv_bend(2, 2) = pv_bend(2, 2)+f3(2)*r32(2) - pv_bend(2, 3) = pv_bend(2, 3)+f1(2)*r12(3) - pv_bend(2, 3) = pv_bend(2, 3)+f3(2)*r32(3) - pv_bend(3, 1) = pv_bend(3, 1)+f1(3)*r12(1) - pv_bend(3, 1) = pv_bend(3, 1)+f3(3)*r32(1) - pv_bend(3, 2) = pv_bend(3, 2)+f1(3)*r12(2) - pv_bend(3, 2) = pv_bend(3, 2)+f3(3)*r32(2) - pv_bend(3, 3) = pv_bend(3, 3)+f1(3)*r12(3) - pv_bend(3, 3) = pv_bend(3, 3)+f3(3)*r32(3) + pv_bend(1, 1) = pv_bend(1, 1) + f1(1)*r12(1) + pv_bend(1, 1) = pv_bend(1, 1) + f3(1)*r32(1) + pv_bend(1, 2) = pv_bend(1, 2) + f1(1)*r12(2) + pv_bend(1, 2) = pv_bend(1, 2) + f3(1)*r32(2) + pv_bend(1, 3) = pv_bend(1, 3) + f1(1)*r12(3) + pv_bend(1, 3) = pv_bend(1, 3) + f3(1)*r32(3) + pv_bend(2, 1) = pv_bend(2, 1) + f1(2)*r12(1) + pv_bend(2, 1) = pv_bend(2, 1) + f3(2)*r32(1) + pv_bend(2, 2) = pv_bend(2, 2) + f1(2)*r12(2) + pv_bend(2, 2) = pv_bend(2, 2) + f3(2)*r32(2) + pv_bend(2, 3) = pv_bend(2, 3) + f1(2)*r12(3) + pv_bend(2, 3) = pv_bend(2, 3) + f3(2)*r32(3) + pv_bend(3, 1) = pv_bend(3, 1) + f1(3)*r12(1) + pv_bend(3, 1) = pv_bend(3, 1) + f3(3)*r32(1) + pv_bend(3, 2) = pv_bend(3, 2) + f1(3)*r12(2) + pv_bend(3, 2) = pv_bend(3, 2) + f3(3)*r32(2) + pv_bend(3, 3) = pv_bend(3, 3) + f1(3)*r12(3) + pv_bend(3, 3) = pv_bend(3, 3) + f3(3)*r32(3) END SUBROUTINE get_pv_bend @@ -671,33 +671,33 @@ SUBROUTINE get_pv_torsion(f1, f3, f4, r12, r32, r43, pv_torsion) CHARACTER(len=*), PARAMETER :: routineN = 'get_pv_torsion', routineP = moduleN//':'//routineN - pv_torsion(1, 1) = pv_torsion(1, 1)+f1(1)*r12(1) - pv_torsion(1, 1) = pv_torsion(1, 1)+(f3(1)+f4(1))*r32(1) - pv_torsion(1, 1) = pv_torsion(1, 1)+f4(1)*r43(1) - pv_torsion(1, 2) = pv_torsion(1, 2)+f1(1)*r12(2) - pv_torsion(1, 2) = pv_torsion(1, 2)+(f3(1)+f4(1))*r32(2) - pv_torsion(1, 2) = pv_torsion(1, 2)+f4(1)*r43(2) - pv_torsion(1, 3) = pv_torsion(1, 3)+f1(1)*r12(3) - pv_torsion(1, 3) = pv_torsion(1, 3)+(f3(1)+f4(1))*r32(3) - pv_torsion(1, 3) = pv_torsion(1, 3)+f4(1)*r43(3) - pv_torsion(2, 1) = pv_torsion(2, 1)+f1(2)*r12(1) - pv_torsion(2, 1) = pv_torsion(2, 1)+(f3(2)+f4(2))*r32(1) - pv_torsion(2, 1) = pv_torsion(2, 1)+f4(2)*r43(1) - pv_torsion(2, 2) = pv_torsion(2, 2)+f1(2)*r12(2) - pv_torsion(2, 2) = pv_torsion(2, 2)+(f3(2)+f4(2))*r32(2) - pv_torsion(2, 2) = pv_torsion(2, 2)+f4(2)*r43(2) - pv_torsion(2, 3) = pv_torsion(2, 3)+f1(2)*r12(3) - pv_torsion(2, 3) = pv_torsion(2, 3)+(f3(2)+f4(2))*r32(3) - pv_torsion(2, 3) = pv_torsion(2, 3)+f4(2)*r43(3) - pv_torsion(3, 1) = pv_torsion(3, 1)+f1(3)*r12(1) - pv_torsion(3, 1) = pv_torsion(3, 1)+(f3(3)+f4(3))*r32(1) - pv_torsion(3, 1) = pv_torsion(3, 1)+f4(3)*r43(1) - pv_torsion(3, 2) = pv_torsion(3, 2)+f1(3)*r12(2) - pv_torsion(3, 2) = pv_torsion(3, 2)+(f3(3)+f4(3))*r32(2) - pv_torsion(3, 2) = pv_torsion(3, 2)+f4(3)*r43(2) - pv_torsion(3, 3) = pv_torsion(3, 3)+f1(3)*r12(3) - pv_torsion(3, 3) = pv_torsion(3, 3)+(f3(3)+f4(3))*r32(3) - pv_torsion(3, 3) = pv_torsion(3, 3)+f4(3)*r43(3) + pv_torsion(1, 1) = pv_torsion(1, 1) + f1(1)*r12(1) + pv_torsion(1, 1) = pv_torsion(1, 1) + (f3(1) + f4(1))*r32(1) + pv_torsion(1, 1) = pv_torsion(1, 1) + f4(1)*r43(1) + pv_torsion(1, 2) = pv_torsion(1, 2) + f1(1)*r12(2) + pv_torsion(1, 2) = pv_torsion(1, 2) + (f3(1) + f4(1))*r32(2) + pv_torsion(1, 2) = pv_torsion(1, 2) + f4(1)*r43(2) + pv_torsion(1, 3) = pv_torsion(1, 3) + f1(1)*r12(3) + pv_torsion(1, 3) = pv_torsion(1, 3) + (f3(1) + f4(1))*r32(3) + pv_torsion(1, 3) = pv_torsion(1, 3) + f4(1)*r43(3) + pv_torsion(2, 1) = pv_torsion(2, 1) + f1(2)*r12(1) + pv_torsion(2, 1) = pv_torsion(2, 1) + (f3(2) + f4(2))*r32(1) + pv_torsion(2, 1) = pv_torsion(2, 1) + f4(2)*r43(1) + pv_torsion(2, 2) = pv_torsion(2, 2) + f1(2)*r12(2) + pv_torsion(2, 2) = pv_torsion(2, 2) + (f3(2) + f4(2))*r32(2) + pv_torsion(2, 2) = pv_torsion(2, 2) + f4(2)*r43(2) + pv_torsion(2, 3) = pv_torsion(2, 3) + f1(2)*r12(3) + pv_torsion(2, 3) = pv_torsion(2, 3) + (f3(2) + f4(2))*r32(3) + pv_torsion(2, 3) = pv_torsion(2, 3) + f4(2)*r43(3) + pv_torsion(3, 1) = pv_torsion(3, 1) + f1(3)*r12(1) + pv_torsion(3, 1) = pv_torsion(3, 1) + (f3(3) + f4(3))*r32(1) + pv_torsion(3, 1) = pv_torsion(3, 1) + f4(3)*r43(1) + pv_torsion(3, 2) = pv_torsion(3, 2) + f1(3)*r12(2) + pv_torsion(3, 2) = pv_torsion(3, 2) + (f3(3) + f4(3))*r32(2) + pv_torsion(3, 2) = pv_torsion(3, 2) + f4(3)*r43(2) + pv_torsion(3, 3) = pv_torsion(3, 3) + f1(3)*r12(3) + pv_torsion(3, 3) = pv_torsion(3, 3) + (f3(3) + f4(3))*r32(3) + pv_torsion(3, 3) = pv_torsion(3, 3) + f4(3)*r43(3) END SUBROUTINE get_pv_torsion diff --git a/src/molden_utils.F b/src/molden_utils.F index 233fba99e8..0c40d70251 100644 --- a/src/molden_utils.F +++ b/src/molden_utils.F @@ -93,7 +93,7 @@ SUBROUTINE write_mos_molden(mos, qs_kind_set, particle_set, print_section) CALL section_vals_val_get(print_section, "MOS_MOLDEN%NDIGITS", i_val=digits) fmtstr1 = "(I6,1X,ES . )" - WRITE (UNIT=fmtstr1(10:11), FMT="(I2)") digits+7 + WRITE (UNIT=fmtstr1(10:11), FMT="(I2)") digits + 7 WRITE (UNIT=fmtstr1(13:14), FMT="(I2)") digits IF (mos(1)%mo_set%use_mo_coeff_b) THEN @@ -149,7 +149,7 @@ SUBROUTINE write_mos_molden(mos, qs_kind_set, particle_set, print_section) ! functions. So we undo the normalisation factors included in the gccs ! Reverse engineered from basis_set_types, normalise_gcc_orb prefac = 2_dp**orb_basis_set%l(ishell, iset)*(2/pi)**0.75_dp - expzet = 0.25_dp*(2*orb_basis_set%l(ishell, iset)+3.0_dp) + expzet = 0.25_dp*(2*orb_basis_set%l(ishell, iset) + 3.0_dp) WRITE (UNIT=iw, & FMT="((T51,2F15.6))") & (orb_basis_set%zet(ipgf, iset), & @@ -206,8 +206,8 @@ SUBROUTINE write_mos_molden(mos, qs_kind_set, particle_set, print_section) orbtramat(lshell)%s2c, nso(lshell), & smatrix(isgf, 1), nsgf, 0.0_dp, & cmatrix(icgf, 1), ncgf) - icgf = icgf+nco(lshell) - isgf = isgf+nso(lshell) + icgf = icgf + nco(lshell) + isgf = isgf + nso(lshell) END DO END DO END IF @@ -245,9 +245,9 @@ SUBROUTINE write_mos_molden(mos, qs_kind_set, particle_set, print_section) DO ico = 1, nco(lshell) mo_coeff(shellgf) = cmatrix(irow, icol) shell_symbol(shellgf) = bcgf_symbol(icgf) - icgf = icgf+1 - shellgf = shellgf+1 - irow = irow+1 + icgf = icgf + 1 + shellgf = shellgf + 1 + irow = irow + 1 END DO ! ico !------------------------------------------------------------------------ ! convert from CP2K MOLDEN format ordering @@ -323,7 +323,7 @@ SUBROUTINE print_coeffs(iw, fmtstr1, digits, irow_in, orbmap, mo_coeff) DO orbital = 1, 15 IF (orbmap(orbital) .NE. 0) THEN IF (mo_coeff(orbmap(orbital)) .GT. 10.0**(-digits)) THEN - WRITE (iw, fmtstr1) irow_in+orbital, mo_coeff(orbmap(orbital)) + WRITE (iw, fmtstr1) irow_in + orbital, mo_coeff(orbmap(orbital)) END IF END IF END DO @@ -410,12 +410,12 @@ SUBROUTINE write_vibrations_molden(input, particles, freq, eigen_vec, intensitie l = 0 DO i = 1, SIZE(eigen_vec, 2) IF ((.NOT. dump_only_positive) .OR. (freq(i) >= 0._dp)) THEN - l = l+1 + l = l + 1 WRITE (iw, '(T2,A,1X,I6)') "vibration", l DO j = 1, SIZE(particles) IF (my_list(j) .NE. 0) THEN - k = (my_list(j)-1)*3 - WRITE (iw, '(T2,3(F12.6,3X))') eigen_vec(k+1, i), eigen_vec(k+2, i), eigen_vec(k+3, i) + k = (my_list(j) - 1)*3 + WRITE (iw, '(T2,3(F12.6,3X))') eigen_vec(k + 1, i), eigen_vec(k + 2, i), eigen_vec(k + 3, i) ELSE WRITE (iw, '(T2,3(F12.6,3X))') 0.0_dp, 0.0_dp, 0.0_dp END IF diff --git a/src/molecular_dipoles.F b/src/molecular_dipoles.F index 36ca319f6b..9bbe7a77f7 100644 --- a/src/molecular_dipoles.F +++ b/src/molecular_dipoles.F @@ -103,7 +103,7 @@ SUBROUTINE calculate_molecular_dipole(qs_env, qs_loc_env, loc_print_key, molecul para_env => qs_loc_env%para_env local_molecules => qs_loc_env%local_molecules nkind = SIZE(local_molecules%n_el) - zwfc = 3.0_dp-REAL(nspins, KIND=dp) + zwfc = 3.0_dp - REAL(nspins, KIND=dp) ALLOCATE (dipole_set(3, SIZE(molecule_set))) ALLOCATE (charge_set(SIZE(molecule_set))) @@ -125,25 +125,25 @@ SUBROUTINE calculate_molecular_dipole(qs_env, qs_loc_env, loc_print_key, molecul ! Get reference point for this molecule CALL get_reference_point(rcc, qs_env=qs_env, reference=reference, & ref_point=ref_point, ifirst=first_atom, & - ilast=first_atom+natom-1) + ilast=first_atom + natom - 1) dipole = 0.0_dp IF (do_berry) THEN rcc = pbc(rcc, cell) ! Find out the total charge of the molecule DO iatom = 1, natom - i = first_atom+iatom-1 + i = first_atom + iatom - 1 atomic_kind => particle_set(i)%atomic_kind CALL get_atomic_kind(atomic_kind, kind_number=akind) CALL get_qs_kind(qs_kind_set(akind), ghost=ghost, floating=floating) IF (.NOT. ghost .AND. .NOT. floating) THEN CALL get_qs_kind(qs_kind_set(akind), core_charge=zeff) - charge_set(imol_now) = charge_set(imol_now)+zeff + charge_set(imol_now) = charge_set(imol_now) + zeff END IF END DO ! Charges of the wfc involved DO istate = 1, SIZE(molecule_set(imol_now)%lmi(ispin)%states) - charge_set(imol_now) = charge_set(imol_now)-zwfc + charge_set(imol_now) = charge_set(imol_now) - zwfc ENDDO charge_tot = charge_set(imol_now) @@ -154,7 +154,7 @@ SUBROUTINE calculate_molecular_dipole(qs_env, qs_loc_env, loc_print_key, molecul ! Nuclear charges IF (ispin == 1) THEN DO iatom = 1, natom - i = first_atom+iatom-1 + i = first_atom + iatom - 1 atomic_kind => particle_set(i)%atomic_kind CALL get_atomic_kind(atomic_kind, kind_number=akind) CALL get_qs_kind(qs_kind_set(akind), ghost=ghost, floating=floating) @@ -190,15 +190,15 @@ SUBROUTINE calculate_molecular_dipole(qs_env, qs_loc_env, loc_print_key, molecul IF (ispin == 1) THEN ! Nuclear charges DO iatom = 1, natom - i = first_atom+iatom-1 + i = first_atom + iatom - 1 atomic_kind => particle_set(i)%atomic_kind CALL get_atomic_kind(atomic_kind, kind_number=akind) CALL get_qs_kind(qs_kind_set(akind), ghost=ghost, floating=floating) IF (.NOT. ghost .AND. .NOT. floating) THEN CALL get_qs_kind(qs_kind_set(akind), core_charge=zeff) - ria = pbc(particle_set(i)%r, cell)-rcc - dipole = dipole+zeff*(ria-rcc) - charge_set(imol_now) = charge_set(imol_now)+zeff + ria = pbc(particle_set(i)%r, cell) - rcc + dipole = dipole + zeff*(ria - rcc) + charge_set(imol_now) = charge_set(imol_now) + zeff END IF END DO END IF @@ -206,11 +206,11 @@ SUBROUTINE calculate_molecular_dipole(qs_env, qs_loc_env, loc_print_key, molecul DO istate = 1, SIZE(molecule_set(imol_now)%lmi(ispin)%states) i = molecule_set(imol_now)%lmi(ispin)%states(istate) ria = pbc(center(1:3, i), cell) - dipole = dipole-zwfc*(ria-rcc) - charge_set(imol_now) = charge_set(imol_now)-zwfc + dipole = dipole - zwfc*(ria - rcc) + charge_set(imol_now) = charge_set(imol_now) - zwfc ENDDO END IF - dipole_set(:, imol_now) = dipole_set(:, imol_now)+dipole ! a.u. + dipole_set(:, imol_now) = dipole_set(:, imol_now) + dipole ! a.u. ENDDO ENDDO END DO diff --git a/src/molecular_moments.F b/src/molecular_moments.F index 9259e57768..56d9167097 100644 --- a/src/molecular_moments.F +++ b/src/molecular_moments.F @@ -114,11 +114,11 @@ SUBROUTINE calculate_molecular_moments(qs_env, qs_loc_env, mo_local, loc_print_k CALL get_qs_env(qs_env, dft_control=dft_control) nspins = dft_control%nspins - zwfc = 3.0_dp-REAL(nspins, KIND=dp) + zwfc = 3.0_dp - REAL(nspins, KIND=dp) CALL section_vals_val_get(loc_print_key, "MOLECULAR_MOMENTS%ORDER", i_val=norder) CPASSERT(norder >= 0) - nm = ncoset(norder)-1 + nm = ncoset(norder) - 1 CALL get_qs_env(qs_env, qs_kind_set=qs_kind_set, cell=cell) particle_set => qs_loc_env%particle_set @@ -139,7 +139,7 @@ SUBROUTINE calculate_molecular_moments(qs_env, qs_loc_env, mo_local, loc_print_k ! Get reference point for this molecule CALL get_reference_point(rcc, qs_env=qs_env, reference=use_mom_ref_com, & ref_point=ref_point, ifirst=first_atom, & - ilast=first_atom+natom-1) + ilast=first_atom + natom - 1) ALLOCATE (moments(nm)) DO i = 1, nm ALLOCATE (moments(i)%matrix) @@ -184,7 +184,7 @@ SUBROUTINE calculate_molecular_moments(qs_env, qs_loc_env, mo_local, loc_print_k DO i = 1, nm CALL cp_dbcsr_sm_fm_multiply(moments(i)%matrix, mvector, omvector, ns) CALL cp_fm_schur_product(mvector, omvector, momv) - moment_set(i, imol) = moment_set(i, imol)-zwfc*SUM(momv%local_data) + moment_set(i, imol) = moment_set(i, imol) - zwfc*SUM(momv%local_data) END DO ! CALL cp_fm_release(mvector) @@ -209,41 +209,41 @@ SUBROUTINE calculate_molecular_moments(qs_env, qs_loc_env, mo_local, loc_print_k ! Get reference point for this molecule CALL get_reference_point(rcc, qs_env=qs_env, reference=use_mom_ref_com, & ref_point=ref_point, ifirst=first_atom, & - ilast=first_atom+natom-1) + ilast=first_atom + natom - 1) ! charge DO iatom = 1, natom - i = first_atom+iatom-1 + i = first_atom + iatom - 1 atomic_kind => particle_set(i)%atomic_kind CALL get_atomic_kind(atomic_kind, kind_number=akind) CALL get_qs_kind(qs_kind_set(akind), ghost=ghost, floating=floating) IF (.NOT. ghost .AND. .NOT. floating) THEN CALL get_qs_kind(qs_kind_set(akind), core_charge=zeff) - charge_set(imol_now) = charge_set(imol_now)+zeff + charge_set(imol_now) = charge_set(imol_now) + zeff END IF END DO DO ispin = 1, nspins IF (ASSOCIATED(molecule_set(imol_now)%lmi(ispin)%states)) THEN ns = SIZE(molecule_set(imol_now)%lmi(ispin)%states) - charge_set(imol_now) = charge_set(imol_now)-zwfc*ns + charge_set(imol_now) = charge_set(imol_now) - zwfc*ns END IF ENDDO ! IF (norder > 0) THEN ! nuclear contribution DO i = 1, nm - lx = indco(1, i+1) - ly = indco(2, i+1) - lz = indco(3, i+1) + lx = indco(1, i + 1) + ly = indco(2, i + 1) + lz = indco(3, i + 1) DO iatom = 1, natom - j = first_atom+iatom-1 + j = first_atom + iatom - 1 atomic_kind => particle_set(j)%atomic_kind CALL get_atomic_kind(atomic_kind, kind_number=akind) CALL get_qs_kind(qs_kind_set(akind), ghost=ghost, floating=floating) IF (.NOT. ghost .AND. .NOT. floating) THEN CALL get_qs_kind(qs_kind_set(akind), core_charge=zeff) - ria = particle_set(j)%r-rcc + ria = particle_set(j)%r - rcc ria = pbc(ria, cell) - moment_set(i, imol_now) = moment_set(i, imol_now)+ & + moment_set(i, imol_now) = moment_set(i, imol_now) + & zeff*ria(1)**lx*ria(2)**ly*ria(3)**lz END IF END DO @@ -260,8 +260,8 @@ SUBROUTINE calculate_molecular_moments(qs_env, qs_loc_env, mo_local, loc_print_k DO i = 1, SIZE(charge_set) WRITE (UNIT=iounit, FMT='(A,I6,A,F12.6)') " # molecule nr:", i, " Charge:", charge_set(I) DO n = 1, norder - n1 = ncoset(n-1) - n2 = ncoset(n)-1 + n1 = ncoset(n - 1) + n2 = ncoset(n) - 1 WRITE (UNIT=iounit, FMT='(T4,A,I2,10(T16,6F12.6))') "Order:", n, moment_set(n1:n2, i) END DO ENDDO diff --git a/src/molsym.F b/src/molsym.F index c96b80712d..a91b48c347 100644 --- a/src/molsym.F +++ b/src/molsym.F @@ -29,9 +29,9 @@ MODULE molsym CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'molsym' INTEGER, PARAMETER :: maxcn = 20, & - maxsec = maxcn+1, & - maxses = 2*maxcn+1, & - maxsig = maxcn+1, & + maxsec = maxcn + 1, & + maxses = 2*maxcn + 1, & + maxsig = maxcn + 1, & maxsn = 2*maxcn PUBLIC :: molsym_type @@ -195,20 +195,20 @@ SUBROUTINE addsec(n, a, sym) REAL(dp) :: length_of_a, scapro REAL(dp), DIMENSION(3) :: d - length_of_a = SQRT(a(1)*a(1)+a(2)*a(2)+a(3)*a(3)) + length_of_a = SQRT(a(1)*a(1) + a(2)*a(2) + a(3)*a(3)) d(:) = a(:)/length_of_a ! Check, if the current Cn axis is already in the list DO isec = 1, sym%nsec(n) - scapro = sym%sec(1, isec, n)*d(1)+sym%sec(2, isec, n)*d(2)+sym%sec(3, isec, n)*d(3) - IF (ABS(ABS(scapro)-1.0_dp) < sym%eps_geo) RETURN + scapro = sym%sec(1, isec, n)*d(1) + sym%sec(2, isec, n)*d(2) + sym%sec(3, isec, n)*d(3) + IF (ABS(ABS(scapro) - 1.0_dp) < sym%eps_geo) RETURN END DO sym%ncn = MAX(sym%ncn, n) ! Add the new Cn axis to the list sec CPASSERT(sym%nsec(n) < maxsec) - sym%nsec(1) = sym%nsec(1)+1 - sym%nsec(n) = sym%nsec(n)+1 + sym%nsec(1) = sym%nsec(1) + 1 + sym%nsec(n) = sym%nsec(n) + 1 sym%sec(:, sym%nsec(n), n) = d(:) END SUBROUTINE addsec @@ -234,20 +234,20 @@ SUBROUTINE addses(n, a, sym) REAL(dp) :: length_of_a, scapro REAL(dp), DIMENSION(3) :: d - length_of_a = SQRT(a(1)*a(1)+a(2)*a(2)+a(3)*a(3)) + length_of_a = SQRT(a(1)*a(1) + a(2)*a(2) + a(3)*a(3)) d(:) = a(:)/length_of_a ! Check, if the current Sn axis is already in the list DO ises = 1, sym%nses(n) - scapro = sym%ses(1, ises, n)*d(1)+sym%ses(2, ises, n)*d(2)+sym%ses(3, ises, n)*d(3) - IF (ABS(ABS(scapro)-1.0_dp) < sym%eps_geo) RETURN + scapro = sym%ses(1, ises, n)*d(1) + sym%ses(2, ises, n)*d(2) + sym%ses(3, ises, n)*d(3) + IF (ABS(ABS(scapro) - 1.0_dp) < sym%eps_geo) RETURN END DO sym%nsn = MAX(sym%nsn, n) ! Add the new Sn axis to the list ses CPASSERT(sym%nses(n) < maxses) - sym%nses(1) = sym%nses(1)+1 - sym%nses(n) = sym%nses(n)+1 + sym%nses(1) = sym%nses(1) + 1 + sym%nses(n) = sym%nses(n) + 1 sym%ses(:, sym%nses(n), n) = d(:) END SUBROUTINE addses @@ -271,18 +271,18 @@ SUBROUTINE addsig(a, sym) REAL(dp) :: length_of_a, scapro REAL(dp), DIMENSION(3) :: d - length_of_a = SQRT(a(1)*a(1)+a(2)*a(2)+a(3)*a(3)) + length_of_a = SQRT(a(1)*a(1) + a(2)*a(2) + a(3)*a(3)) d(:) = a(:)/length_of_a ! Check, if the normal vector of the current mirror plane is already in the list DO isig = 1, sym%nsig - scapro = sym%sig(1, isig)*d(1)+sym%sig(2, isig)*d(2)+sym%sig(3, isig)*d(3) - IF (ABS(ABS(scapro)-1.0_dp) < sym%eps_geo) RETURN + scapro = sym%sig(1, isig)*d(1) + sym%sig(2, isig)*d(2) + sym%sig(3, isig)*d(3) + IF (ABS(ABS(scapro) - 1.0_dp) < sym%eps_geo) RETURN END DO ! Add the normal vector of the new mirror plane to the list sig CPASSERT(sym%nsig < maxsig) - sym%nsig = sym%nsig+1 + sym%nsig = sym%nsig + 1 sym%sig(:, sym%nsig) = d(:) END SUBROUTINE addsig @@ -366,7 +366,7 @@ SUBROUTINE axsym(coord, sym) IF (caxis(2, a(:), sym, coord)) CALL addsec(2, a(:), sym) d(:) = vector_product(a(:), sym%z_axis(:)) IF (sigma(d(:), sym, coord)) CALL addsig(d(:), sym) - DO jatom = iatom+1, natoms + DO jatom = iatom + 1, natoms b(:) = coord(:, jatom) IF ((ABS(b(1)) > sym%eps_geo) .OR. (ABS(b(2)) > sym%eps_geo)) THEN b(3) = 0.0_dp @@ -484,24 +484,24 @@ SUBROUTINE build_symequ_list(sym, coord) a(:) = reflect_vector(coord(:, iatom), sym%sig(:, isig)) iequatom = equatom(iatom, a(:), sym, coord) IF ((iequatom > 0) .AND. (.NOT. in_symequ_list(iequatom, sym))) THEN - sym%ulequatom(sym%ngroup) = sym%ulequatom(sym%ngroup)+1 + sym%ulequatom(sym%ngroup) = sym%ulequatom(sym%ngroup) + 1 sym%symequ_list(sym%ulequatom(sym%ngroup)) = iequatom - sym%nequatom(sym%ngroup) = sym%nequatom(sym%ngroup)+1 + sym%nequatom(sym%ngroup) = sym%nequatom(sym%ngroup) + 1 END IF END DO ! Loop over all Cn axes DO icn = 2, sym%ncn DO isec = 1, sym%nsec(icn) - DO jcn = 1, icn-1 + DO jcn = 1, icn - 1 IF (newse(jcn, icn)) THEN phi = 2.0_dp*pi*REAL(jcn, KIND=dp)/REAL(icn, KIND=dp) a(:) = rotate_vector(coord(:, iatom), phi, sym%sec(:, isec, icn)) iequatom = equatom(iatom, a(:), sym, coord) IF ((iequatom > 0) .AND. (.NOT. in_symequ_list(iequatom, sym))) THEN - sym%ulequatom(sym%ngroup) = sym%ulequatom(sym%ngroup)+1 + sym%ulequatom(sym%ngroup) = sym%ulequatom(sym%ngroup) + 1 sym%symequ_list(sym%ulequatom(sym%ngroup)) = iequatom - sym%nequatom(sym%ngroup) = sym%nequatom(sym%ngroup)+1 + sym%nequatom(sym%ngroup) = sym%nequatom(sym%ngroup) + 1 END IF END IF END DO @@ -511,16 +511,16 @@ SUBROUTINE build_symequ_list(sym, coord) ! Loop over all Sn axes DO isn = 2, sym%nsn DO ises = 1, sym%nses(isn) - DO jsn = 1, isn-1, incr + DO jsn = 1, isn - 1, incr IF (newse(jsn, isn)) THEN phi = 2.0_dp*pi*REAL(jsn, KIND=dp)/REAL(isn, KIND=dp) a(:) = rotate_vector(coord(:, iatom), phi, sym%ses(:, ises, isn)) a(:) = reflect_vector(a(:), sym%ses(:, ises, isn)) iequatom = equatom(iatom, a(:), sym, coord) IF ((iequatom > 0) .AND. (.NOT. in_symequ_list(iequatom, sym))) THEN - sym%ulequatom(sym%ngroup) = sym%ulequatom(sym%ngroup)+1 + sym%ulequatom(sym%ngroup) = sym%ulequatom(sym%ngroup) + 1 sym%symequ_list(sym%ulequatom(sym%ngroup)) = iequatom - sym%nequatom(sym%ngroup) = sym%nequatom(sym%ngroup)+1 + sym%nequatom(sym%ngroup) = sym%nequatom(sym%ngroup) + 1 END IF END IF END DO @@ -534,8 +534,8 @@ SUBROUTINE build_symequ_list(sym, coord) DO jatom = 2, natoms IF (.NOT. in_symequ_list(jatom, sym)) THEN iatom = jatom - sym%ngroup = sym%ngroup+1 - sym%llequatom(sym%ngroup) = sym%ulequatom(sym%ngroup-1)+1 + sym%ngroup = sym%ngroup + 1 + sym%llequatom(sym%ngroup) = sym%ulequatom(sym%ngroup - 1) + 1 sym%ulequatom(sym%ngroup) = sym%llequatom(sym%ngroup) sym%symequ_list(sym%llequatom(sym%ngroup)) = iatom CYCLE loop @@ -577,7 +577,7 @@ FUNCTION caxis(n, a, sym, coord) REAL(KIND=dp), DIMENSION(3) :: b caxis = .FALSE. - length_of_a = SQRT(a(1)*a(1)+a(2)*a(2)+a(3)*a(3)) + length_of_a = SQRT(a(1)*a(1) + a(2)*a(2) + a(3)*a(3)) ! Check the length of the axis vector a natoms = SIZE(coord, 2) @@ -622,7 +622,7 @@ SUBROUTINE cubsym(sym, coord, failed) phidd = ATAN(0.4_dp*SQRT(5.0_dp)) ! Angle between two adjacent atoms of the icosahedron and the dodecahedron => <(C5,C3) - phidi = ATAN(3.0_dp-SQRT(5.0_dp)) + phidi = ATAN(3.0_dp - SQRT(5.0_dp)) ! Angle between two adjacent atoms of the icosahedron <(C5,C5) phiii = ATAN(2.0_dp) @@ -642,13 +642,13 @@ SUBROUTINE cubsym(sym, coord, failed) loop: DO iatom = 1, natoms a(:) = coord(:, iatom) - DO jatom = iatom+1, natoms - DO katom = jatom+1, natoms + DO jatom = iatom + 1, natoms + DO katom = jatom + 1, natoms IF ((ABS(dist(coord(:, iatom), coord(:, jatom)) & - -dist(coord(:, iatom), coord(:, katom))) < sym%eps_geo) .AND. & + - dist(coord(:, iatom), coord(:, katom))) < sym%eps_geo) .AND. & (ABS(dist(coord(:, iatom), coord(:, jatom)) & - -dist(coord(:, jatom), coord(:, katom))) < sym%eps_geo)) THEN - b(:) = a(:)+coord(:, jatom)+coord(:, katom) + - dist(coord(:, jatom), coord(:, katom))) < sym%eps_geo)) THEN + b(:) = a(:) + coord(:, jatom) + coord(:, katom) IF (caxis(3, b(:), sym, coord)) THEN CALL addsec(3, b(:), sym) IF (sym%nsec(3) > 1) EXIT loop @@ -693,12 +693,12 @@ SUBROUTINE cubsym(sym, coord, failed) a(:) = sym%sec(:, 1, 3) b(:) = sym%sec(:, 2, 3) phi1 = 0.5_dp*angle(a(:), b(:)) - IF (phi1 < 0.5_dp*pi) phi1 = phi1-0.5_dp*pi + IF (phi1 < 0.5_dp*pi) phi1 = phi1 - 0.5_dp*pi d(:) = vector_product(a(:), b(:)) b(:) = rotate_vector(a(:), phi1, d(:)) c(:) = sym%sec(:, 3, 3) phi1 = 0.5_dp*angle(a(:), c(:)) - IF (phi1 < 0.5_dp*pi) phi1 = phi1-0.5_dp*pi + IF (phi1 < 0.5_dp*pi) phi1 = phi1 - 0.5_dp*pi d(:) = vector_product(a(:), c(:)) c(:) = rotate_vector(a(:), phi1, d(:)) d(:) = vector_product(b(:), c(:)) @@ -707,7 +707,7 @@ SUBROUTINE cubsym(sym, coord, failed) IF (caxis(3, a(:), sym, coord)) THEN CALL addsec(3, a(:), sym) ELSE - phi2 = 0.5_dp*pi-phi1 + phi2 = 0.5_dp*pi - phi1 a(:) = rotate_vector(b(:), phi2, d(:)) IF (caxis(3, a(:), sym, coord)) CALL addsec(3, a(:), sym) END IF @@ -733,7 +733,7 @@ SUBROUTINE cubsym(sym, coord, failed) DO isec = 1, sym%nsec(3) a(:) = sym%sec(:, isec, 3) - DO jsec = isec+1, sym%nsec(3) + DO jsec = isec + 1, sym%nsec(3) phi1 = 0.5_dp*angle(a(:), sym%sec(:, jsec, 3)) d(:) = vector_product(a(:), sym%sec(:, jsec, 3)) @@ -742,7 +742,7 @@ SUBROUTINE cubsym(sym, coord, failed) b(:) = rotate_vector(a(:), phidi, d(:)) IF (caxis(5, b(:), sym, coord)) THEN CALL addsec(5, b(:), sym) - phi1 = phidi+phiii + phi1 = phidi + phiii b(:) = rotate_vector(a(:), phi1, d(:)) IF (caxis(5, b(:), sym, coord)) CALL addsec(5, b(:), sym) END IF @@ -750,7 +750,7 @@ SUBROUTINE cubsym(sym, coord, failed) ! Check for C4 (O,Oh), C2 and S2 (center of inversion) axis DO i = 0, 1 - phi2 = phi1-0.5_dp*REAL(i, KIND=dp)*pi + phi2 = phi1 - 0.5_dp*REAL(i, KIND=dp)*pi b(:) = rotate_vector(a(:), phi2, d(:)) IF (caxis(2, b(:), sym, coord)) THEN CALL addsec(2, b(:), sym) @@ -827,10 +827,10 @@ FUNCTION equatom(atoma, a, sym, coord) equatom = 0 natoms = SIZE(coord, 2) DO iatom = 1, natoms - IF ((ABS(sym%ain(iatom)-sym%ain(atoma)) < TINY(0.0_dp)) .AND. & - (ABS(a(1)-coord(1, iatom)) < sym%eps_geo) .AND. & - (ABS(a(2)-coord(2, iatom)) < sym%eps_geo) .AND. & - (ABS(a(3)-coord(3, iatom)) < sym%eps_geo)) THEN + IF ((ABS(sym%ain(iatom) - sym%ain(atoma)) < TINY(0.0_dp)) .AND. & + (ABS(a(1) - coord(1, iatom)) < sym%eps_geo) .AND. & + (ABS(a(2) - coord(2, iatom)) < sym%eps_geo) .AND. & + (ABS(a(3) - coord(3, iatom)) < sym%eps_geo)) THEN equatom = iatom RETURN END IF @@ -853,13 +853,13 @@ SUBROUTINE get_point_group_order(sym) ! Count all symmetry elements of the symmetry group ! First E and all mirror planes - sym%point_group_order = 1+sym%nsig + sym%point_group_order = 1 + sym%nsig ! Loop over all C axes DO icn = 2, sym%ncn DO isec = 1, sym%nsec(icn) - DO jcn = 1, icn-1 - IF (newse(jcn, icn)) sym%point_group_order = sym%point_group_order+1 + DO jcn = 1, icn - 1 + IF (newse(jcn, icn)) sym%point_group_order = sym%point_group_order + 1 END DO END DO END DO @@ -873,8 +873,8 @@ SUBROUTINE get_point_group_order(sym) DO isn = 2, sym%nsn DO ises = 1, sym%nses(isn) - DO jsn = 1, isn-1, incr - IF (newse(jsn, isn)) sym%point_group_order = sym%point_group_order+1 + DO jsn = 1, isn - 1, incr + IF (newse(jsn, isn)) sym%point_group_order = sym%point_group_order + 1 END DO END DO END DO @@ -1015,7 +1015,7 @@ SUBROUTINE init_symmetry(sym, atype, weight) END DO ! Generate atomic identification numbers (symmetry code) *** - sym%ain(:) = REAL(atype(:), KIND=dp)+sym%aw(:) + sym%ain(:) = REAL(atype(:), KIND=dp) + sym%aw(:) ! Initialize the transformation matrix for input orientation -> standard orientation CALL unit_matrix(sym%inptostd(:, :)) @@ -1164,10 +1164,10 @@ SUBROUTINE moleculesym(sym, coord) ! Calculate the molecular tensor of inertia CALL tensor(sym, coord) ! Use symmetry information from the eigenvalues of the molecular tensor of inertia - IF ((sym%tenval(3)-sym%tenval(1)) < eps_tenval) THEN + IF ((sym%tenval(3) - sym%tenval(1)) < eps_tenval) THEN ! 0 < tenval(1) = tenval(2) = tenval(3) sym%cubic = .TRUE. - ELSE IF ((sym%tenval(3)-sym%tenval(2)) < eps_tenval) THEN + ELSE IF ((sym%tenval(3) - sym%tenval(2)) < eps_tenval) THEN ! 0 < tenval(1) < tenval(2) = tenval(3) ! special case: 0 = tenval(1) < tenval(2) = tenval(3) IF (sym%tenval(1) < eps_tenval) sym%linear = .TRUE. @@ -1246,7 +1246,7 @@ SUBROUTINE moleculesym(sym, coord) ! Remove redundant S2 axes IF (sym%nses(2) > 0) THEN - sym%nses(1) = sym%nses(1)-sym%nses(2) + sym%nses(1) = sym%nses(1) - sym%nses(2) sym%nses(2) = 0 CALL addses(2, sym%z_axis(:), sym) END IF @@ -1276,22 +1276,22 @@ FUNCTION naxis(a, coord, sym) naxis = 0 natoms = SIZE(coord, 2) - length_of_a = SQRT(a(1)*a(1)+a(2)*a(2)+a(3)*a(3)) + length_of_a = SQRT(a(1)*a(1) + a(2)*a(2) + a(3)*a(3)) ! Check the length of vector a IF (length_of_a > sym%eps_geo) THEN DO iatom = 1, natoms b(:) = coord(:, iatom) - length_of_b = SQRT(b(1)*b(1)+b(2)*b(2)+b(3)*b(3)) + length_of_b = SQRT(b(1)*b(1) + b(2)*b(2) + b(3)*b(3)) ! An atom in the origin counts for each axis IF (length_of_b < sym%eps_geo) THEN - naxis = naxis+1 + naxis = naxis + 1 ELSE a_norm = a(:)/length_of_a b_norm = b(:)/length_of_b - scapro = a_norm(1)*b_norm(1)+a_norm(2)*b_norm(2)+a_norm(3)*b_norm(3) - IF (ABS(ABS(scapro)-1.0_dp) < sym%eps_geo) naxis = naxis+1 + scapro = a_norm(1)*b_norm(1) + a_norm(2)*b_norm(2) + a_norm(3)*b_norm(3) + IF (ABS(ABS(scapro) - 1.0_dp) < sym%eps_geo) naxis = naxis + 1 END IF END DO @@ -1349,22 +1349,22 @@ FUNCTION nsigma(a, sym, coord) nsigma = 0 - length_of_a = SQRT(a(1)*a(1)+a(2)*a(2)+a(3)*a(3)) + length_of_a = SQRT(a(1)*a(1) + a(2)*a(2) + a(3)*a(3)) ! Check the length of vector a IF (length_of_a > sym%eps_geo) THEN natoms = SIZE(coord, 2) DO iatom = 1, natoms b(:) = coord(:, iatom) - length_of_b = SQRT(b(1)*b(1)+b(2)*b(2)+b(3)*b(3)) + length_of_b = SQRT(b(1)*b(1) + b(2)*b(2) + b(3)*b(3)) ! An atom in the origin counts for each mirror plane IF (length_of_b < sym%eps_geo) THEN - nsigma = nsigma+1 + nsigma = nsigma + 1 ELSE a_norm = a(:)/length_of_a b_norm = b(:)/length_of_b - scapro = a_norm(1)*b_norm(1)+a_norm(2)*b_norm(2)+a_norm(3)*b_norm(3) - IF (ABS(scapro) < sym%eps_geo) nsigma = nsigma+1 + scapro = a_norm(1)*b_norm(1) + a_norm(2)*b_norm(2) + a_norm(3)*b_norm(3) + IF (ABS(scapro) < sym%eps_geo) nsigma = nsigma + 1 END IF END DO END IF @@ -1461,7 +1461,7 @@ SUBROUTINE print_symmetry(sym, coord, atype, element, z, weight, iw, plevel) string = "@ " DO isig = 1, sym%nsig - secount = secount+1 + secount = secount + 1 CALL outse(sym%sig(:, isig), sym%eps_geo) WRITE (iw, "(T24,2I5,2X,A3,3X,3F13.6)") & secount, isig, string, (sym%sig(i, isig), i=1, 3) @@ -1474,7 +1474,7 @@ SUBROUTINE print_symmetry(sym, coord, atype, element, z, weight, iw, plevel) WRITE (string, "(A1,I2)") "C", icn END IF DO isec = 1, sym%nsec(icn) - secount = secount+1 + secount = secount + 1 CALL outse(sym%sec(:, isec, icn), sym%eps_geo) WRITE (iw, "(T24,2I5,2X,A3,3X,3F13.6)") & secount, isec, string, (sym%sec(i, isec, icn), i=1, 3) @@ -1490,7 +1490,7 @@ SUBROUTINE print_symmetry(sym, coord, atype, element, z, weight, iw, plevel) WRITE (string, "(A1,I2)") "S", isn END IF DO ises = 1, sym%nses(isn) - secount = secount+1 + secount = secount + 1 CALL outse(sym%ses(:, ises, isn), sym%eps_geo) WRITE (iw, "(T24,2I5,2X,A3,3X,3F13.6)") & secount, ises, string, (sym%ses(i, ises, icn), i=1, 3) @@ -1537,7 +1537,7 @@ SUBROUTINE rotate_molecule(phi, a, sym, coord) ! Check the length of vector a - length_of_a = SQRT(a(1)*a(1)+a(2)*a(2)+a(3)*a(3)) + length_of_a = SQRT(a(1)*a(1) + a(2)*a(2) + a(3)*a(3)) IF (length_of_a > sym%eps_geo) THEN ! Build up the rotation matrix @@ -1591,7 +1591,7 @@ FUNCTION saxis(n, a, sym, coord) saxis = .FALSE. - length_of_a = SQRT(a(1)*a(1)+a(2)*a(2)+a(3)*a(3)) + length_of_a = SQRT(a(1)*a(1) + a(2)*a(2) + a(3)*a(3)) natoms = SIZE(coord, 2) @@ -1638,7 +1638,7 @@ FUNCTION sigma(a, sym, coord) sigma = .FALSE. - length_of_a = SQRT(a(1)*a(1)+a(2)*a(2)+a(3)*a(3)) + length_of_a = SQRT(a(1)*a(1) + a(2)*a(2) + a(3)*a(3)) ! Check the length of vector a IF (length_of_a > sym%eps_geo) THEN @@ -1679,13 +1679,13 @@ SUBROUTINE tensor(sym, coord) sym%center_of_mass(:) = MATMUL(coord(:, 1:natoms), sym%aw(1:natoms))/SUM(sym%aw(1:natoms)) ! Translate the center of mass of the molecule to the origin - coord(:, 1:natoms) = coord(:, 1:natoms)-SPREAD(sym%center_of_mass(:), 2, natoms) + coord(:, 1:natoms) = coord(:, 1:natoms) - SPREAD(sym%center_of_mass(:), 2, natoms) ! Build up the molecular tensor of inertia - sym%tenmat(1, 1) = DOT_PRODUCT(sym%aw(1:natoms), (coord(2, 1:natoms)**2+coord(3, 1:natoms)**2)) - sym%tenmat(2, 2) = DOT_PRODUCT(sym%aw(1:natoms), (coord(3, 1:natoms)**2+coord(1, 1:natoms)**2)) - sym%tenmat(3, 3) = DOT_PRODUCT(sym%aw(1:natoms), (coord(1, 1:natoms)**2+coord(2, 1:natoms)**2)) + sym%tenmat(1, 1) = DOT_PRODUCT(sym%aw(1:natoms), (coord(2, 1:natoms)**2 + coord(3, 1:natoms)**2)) + sym%tenmat(2, 2) = DOT_PRODUCT(sym%aw(1:natoms), (coord(3, 1:natoms)**2 + coord(1, 1:natoms)**2)) + sym%tenmat(3, 3) = DOT_PRODUCT(sym%aw(1:natoms), (coord(1, 1:natoms)**2 + coord(2, 1:natoms)**2)) sym%tenmat(1, 2) = -DOT_PRODUCT(sym%aw(1:natoms), (coord(1, 1:natoms)*coord(2, 1:natoms))) sym%tenmat(1, 3) = -DOT_PRODUCT(sym%aw(1:natoms), (coord(1, 1:natoms)*coord(3, 1:natoms))) @@ -1702,7 +1702,7 @@ SUBROUTINE tensor(sym, coord) ! Secure that the principal axes are right-handed sym%tenvec(:, 3) = vector_product(sym%tenvec(:, 1), sym%tenvec(:, 2)) - tt = SQRT(sym%tenval(1)**2+sym%tenval(2)**2+sym%tenval(3)**2) + tt = SQRT(sym%tenval(1)**2 + sym%tenval(2)**2 + sym%tenval(3)**2) CPASSERT(tt /= 0) END SUBROUTINE tensor @@ -1753,7 +1753,7 @@ FUNCTION dist(a, b) RESULT(d) REAL(KIND=dp), DIMENSION(3), INTENT(IN) :: a, b REAL(KIND=dp) :: d - d = SQRT(SUM((a-b)**2)) + d = SQRT(SUM((a - b)**2)) END FUNCTION ! ************************************************************************************************** diff --git a/src/moments_utils.F b/src/moments_utils.F index 0bc95d30f2..4a041237c6 100644 --- a/src/moments_utils.F +++ b/src/moments_utils.F @@ -112,12 +112,12 @@ SUBROUTINE get_reference_point(rpoint, drpoint, qs_env, fist_env, reference, ref ENDDO DO iatom = ifirst, ilast ria = particle_set(iatom)%r - ria = pbc(ria-center, cell)+center + ria = pbc(ria - center, cell) + center atomic_kind => particle_set(iatom)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) - rpoint(:) = rpoint(:)+mass*ria(:) - IF (PRESENT(drpoint)) drpoint = drpoint+mass*particle_set(iatom)%v - mtot = mtot+mass + rpoint(:) = rpoint(:) + mass*ria(:) + IF (PRESENT(drpoint)) drpoint = drpoint + mass*particle_set(iatom)%v + mtot = mtot + mass END DO ELSE DO ikind = 1, SIZE(local_particles%n_el) @@ -127,9 +127,9 @@ SUBROUTINE get_reference_point(rpoint, drpoint, qs_env, fist_env, reference, ref ria = pbc(ria, cell) atomic_kind => particle_set(iatom)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) - rpoint(:) = rpoint(:)+mass*ria(:) - IF (PRESENT(drpoint)) drpoint = drpoint+mass*particle_set(iatom)%v - mtot = mtot+mass + rpoint(:) = rpoint(:) + mass*ria(:) + IF (PRESENT(drpoint)) drpoint = drpoint + mass*particle_set(iatom)%v + mtot = mtot + mass END DO END DO CALL mp_sum(rpoint, para_env%group) @@ -155,13 +155,13 @@ SUBROUTINE get_reference_point(rpoint, drpoint, qs_env, fist_env, reference, ref ENDDO DO iatom = ifirst, ilast ria = particle_set(iatom)%r - ria = pbc(ria-center, cell)+center + ria = pbc(ria - center, cell) + center atomic_kind => particle_set(iatom)%atomic_kind CALL get_atomic_kind(atomic_kind, kind_number=akind) CALL get_qs_kind(qs_kind_set(akind), core_charge=charge) - rpoint(:) = rpoint(:)+charge*ria(:) - IF (PRESENT(drpoint)) drpoint = drpoint+charge*particle_set(iatom)%v - ztot = ztot+charge + rpoint(:) = rpoint(:) + charge*ria(:) + IF (PRESENT(drpoint)) drpoint = drpoint + charge*particle_set(iatom)%v + ztot = ztot + charge END DO ELSE DO ikind = 1, SIZE(local_particles%n_el) @@ -172,9 +172,9 @@ SUBROUTINE get_reference_point(rpoint, drpoint, qs_env, fist_env, reference, ref atomic_kind => particle_set(iatom)%atomic_kind CALL get_atomic_kind(atomic_kind, kind_number=akind) CALL get_qs_kind(qs_kind_set(akind), core_charge=charge) - rpoint(:) = rpoint(:)+charge*ria(:) - IF (PRESENT(drpoint)) drpoint = drpoint+charge*particle_set(iatom)%v - ztot = ztot+charge + rpoint(:) = rpoint(:) + charge*ria(:) + IF (PRESENT(drpoint)) drpoint = drpoint + charge*particle_set(iatom)%v + ztot = ztot + charge END DO END DO CALL mp_sum(rpoint, para_env%group) diff --git a/src/motion/averages_types.F b/src/motion/averages_types.F index c78719a3f5..85d59c4d90 100644 --- a/src/motion/averages_types.F +++ b/src/motion/averages_types.F @@ -95,7 +95,7 @@ SUBROUTINE create_averages(averages, averages_section, virial_avg, force_env) ! Point to the averages section averages%averages_section => averages_section ! Initialize averages - last_avg_env_id = last_avg_env_id+1 + last_avg_env_id = last_avg_env_id + 1 averages%id_nr = last_avg_env_id averages%ref_count = 1 averages%itimes_start = -1 @@ -153,7 +153,7 @@ SUBROUTINE retain_averages(averages) CPASSERT(ASSOCIATED(averages)) CPASSERT(averages%ref_count > 0) - averages%ref_count = averages%ref_count+1 + averages%ref_count = averages%ref_count + 1 END SUBROUTINE retain_averages ! ************************************************************************************************** @@ -171,7 +171,7 @@ SUBROUTINE release_averages(averages) IF (ASSOCIATED(averages)) THEN CPASSERT(averages%ref_count > 0) - averages%ref_count = averages%ref_count-1 + averages%ref_count = averages%ref_count - 1 IF (averages%ref_count == 0) THEN CALL virial_release(averages%virial) IF (ASSOCIATED(averages%avecolvar)) THEN @@ -305,7 +305,7 @@ SUBROUTINE compute_averages(averages, force_env, md_ener, cell, virial, & averages%itimes_start = itimes END IF END IF - delta_t = itimes-averages%itimes_start+1 + delta_t = itimes - averages%itimes_start + 1 ! Perform averages SELECT CASE (delta_t) @@ -452,7 +452,7 @@ SUBROUTINE get_averages_rs(avg, add, delta_t) CHARACTER(len=*), PARAMETER :: routineN = 'get_averages_rs', & routineP = moduleN//':'//routineN - avg = (avg*REAL(delta_t-1, dp)+add)/REAL(delta_t, dp) + avg = (avg*REAL(delta_t - 1, dp) + add)/REAL(delta_t, dp) END SUBROUTINE get_averages_rs ! ************************************************************************************************** @@ -476,7 +476,7 @@ SUBROUTINE get_averages_rv(avg, add, delta_t) check = SIZE(avg) == SIZE(add) CPASSERT(check) DO i = 1, SIZE(avg) - avg(i) = (avg(i)*REAL(delta_t-1, dp)+add(i))/REAL(delta_t, dp) + avg(i) = (avg(i)*REAL(delta_t - 1, dp) + add(i))/REAL(delta_t, dp) END DO END SUBROUTINE get_averages_rv @@ -504,7 +504,7 @@ SUBROUTINE get_averages_rm(avg, add, delta_t) CPASSERT(check) DO i = 1, SIZE(avg, 2) DO j = 1, SIZE(avg, 1) - avg(j, i) = (avg(j, i)*REAL(delta_t-1, dp)+add(j, i))/REAL(delta_t, dp) + avg(j, i) = (avg(j, i)*REAL(delta_t - 1, dp) + add(j, i))/REAL(delta_t, dp) END DO END DO END SUBROUTINE get_averages_rm diff --git a/src/motion/bfgs_optimizer.F b/src/motion/bfgs_optimizer.F index 015338447e..91873f70f9 100644 --- a/src/motion/bfgs_optimizer.F +++ b/src/motion/bfgs_optimizer.F @@ -72,14 +72,14 @@ MODULE bfgs_optimizer USE particle_list_types, ONLY: particle_list_type #include "../base/base_uses.f90" - IMPLICIT NONE - PRIVATE + IMPLICIT NONE + PRIVATE #include "gopt_f77_methods.h" CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'bfgs_optimizer' - LOGICAL, PARAMETER :: debug_this_module = .TRUE. + LOGICAL, PARAMETER :: debug_this_module = .TRUE. - PUBLIC :: geoopt_bfgs + PUBLIC :: geoopt_bfgs CONTAINS @@ -92,7 +92,7 @@ MODULE bfgs_optimizer !> \param gopt_env ... !> \param x0 ... ! ************************************************************************************************** - RECURSIVE SUBROUTINE geoopt_bfgs(force_env,gopt_param,globenv,geo_section,gopt_env,x0) + RECURSIVE SUBROUTINE geoopt_bfgs(force_env, gopt_param, globenv, geo_section, gopt_env, x0) TYPE(force_env_type), POINTER :: force_env TYPE(gopt_param_type), POINTER :: gopt_param @@ -124,268 +124,268 @@ RECURSIVE SUBROUTINE geoopt_bfgs(force_env,gopt_param,globenv,geo_section,gopt_e TYPE(cp_subsys_type), POINTER :: subsys TYPE(section_vals_type), POINTER :: print_key, root_section - NULLIFY(logger, g, blacs_env) - logger => cp_get_default_logger() - para_env => force_env%para_env - root_section => force_env%root_section - t_old=m_walltime() - - CALL timeset(routineN,handle) - CALL section_vals_val_get(geo_section,"BFGS%TRUST_RADIUS",r_val=rad) - print_key => section_vals_get_subs_vals(geo_section,"BFGS%RESTART") - ionode = para_env%mepos==para_env%source - maxiter = gopt_param%max_iter - conv = .FALSE. - rat = 0.0_dp - wildcard = " BFGS" - - ! Stop if not yet implemented - SELECT CASE (gopt_env%type_id) - CASE (default_ts_method_id) - CPABORT("BFGS method not yet working with DIMER") - END SELECT - - CALL section_vals_val_get(geo_section,"BFGS%USE_RAT_FUN_OPT",l_val=use_rfo) - CALL section_vals_val_get(geo_section,"BFGS%USE_MODEL_HESSIAN",l_val=use_mod_hes) - CALL section_vals_val_get(geo_section,"BFGS%RESTART_HESSIAN",l_val=hesrest) - output_unit = cp_print_key_unit_nr(logger,geo_section,"PRINT%PROGRAM_RUN_INFO",& - extension=".geoLog") - IF (output_unit > 0) THEN - IF (use_rfo) THEN - WRITE (UNIT=output_unit, FMT="(/,T2,A,T78,A3)") & - "BFGS| Use rational function optimization for step estimation: ", "YES" - ELSE - WRITE (UNIT=output_unit, FMT="(/,T2,A,T78,A3)") & - "BFGS| Use rational function optimization for step estimation: ", " NO" - END IF - IF (use_mod_hes) THEN - WRITE (UNIT=output_unit, FMT="(T2,A,T78,A3)") & - "BFGS| Use model Hessian for initial guess: ", "YES" - ELSE - WRITE (UNIT=output_unit, FMT="(T2,A,T78,A3)") & - "BFGS| Use model Hessian for initial guess: ", " NO" - END IF - IF (hesrest) THEN - WRITE (UNIT=output_unit, FMT="(T2,A,T78,A3)") & - "BFGS| Restart Hessian: ", "YES" - ELSE - WRITE (UNIT=output_unit, FMT="(T2,A,T78,A3)") & - "BFGS| Restart Hessian: ", " NO" - END IF - WRITE (UNIT=output_unit, FMT="(T2,A,T61,F20.3)") & - "BFGS| Trust radius: ", rad - END IF - - ndf = SIZE(x0) - nfree = gopt_env%nfree - IF(ndf > 3000)& - CALL cp_warn(__LOCATION__,& - "The dimension of the Hessian matrix ("//& - TRIM(ADJUSTL(cp_to_string(ndf)))//") is greater than 3000. "//& - "The diagonalisation of the full Hessian matrix needed for BFGS "//& - "is computationally expensive. You should consider to use the linear "//& - "scaling variant L-BFGS instead.") - - ! Initialize hessian (hes = unitary matrix or model hessian ) - CALL cp_blacs_env_create(blacs_env,para_env,globenv%blacs_grid_layout,& - globenv%blacs_repeatable) - CALL cp_fm_struct_create(fm_struct_hes,para_env=para_env,context=blacs_env, & - nrow_global=ndf,ncol_global=ndf) - CALL cp_fm_create(hess_mat, fm_struct_hes,name="hess_mat") - CALL cp_fm_create(hess_tmp, fm_struct_hes,name="hess_tmp") - CALL cp_fm_create(eigvec_mat, fm_struct_hes,name="eigvec_mat") - ALLOCATE (eigval(ndf)) - eigval(:) = 0.0_dp - - CALL force_env_get(force_env=force_env,subsys=subsys) - CALL cp_subsys_get(subsys,atomic_kinds=atomic_kinds) - CALL get_atomic_kind_set(atomic_kind_set=atomic_kinds%els,shell_present=shell_present) - IF (use_mod_hes) THEN - IF (shell_present) THEN - CALL cp_warn(__LOCATION__,& - "No model Hessian is available for core-shell models. "//& - "A unit matrix is used as the initial Hessian.") - use_mod_hes = .FALSE. - END IF - IF (gopt_env%type_id == default_cell_method_id) THEN - CALL cp_warn(__LOCATION__,& - "No model Hessian is available for cell optimizations. "//& - "A unit matrix is used as the initial Hessian.") - use_mod_hes = .FALSE. - END IF - END IF - - IF (use_mod_hes) THEN - CALL cp_fm_set_all(hess_mat,alpha=zero,beta=0.00_dp) - CALL construct_initial_hess(gopt_env%force_env,hess_mat) - CALL cp_fm_to_fm(hess_mat,hess_tmp) - CALL choose_eigv_solver(hess_tmp,eigvec_mat,eigval,info=info) - ! In rare cases the diagonalization of hess_mat fails (bug in scalapack?) - IF(info/=0) THEN - CALL cp_fm_set_all(hess_mat,alpha=zero,beta=one) - IF (output_unit > 0) WRITE(output_unit,*) & - "BFGS: Matrix diagonalization failed, using unity as model Hessian." - ELSE - DO its=1,SIZE(eigval) - IF(eigval(its).LT.0.1_dp)eigval(its)=0.1_dp - END DO - CALL cp_fm_to_fm(eigvec_mat,hess_tmp) - CALL cp_fm_column_scale(eigvec_mat,eigval) - CALL cp_gemm("N","T",ndf,ndf,ndf,one,hess_tmp,eigvec_mat,zero,hess_mat) - ENDIF - ELSE - CALL cp_fm_set_all(hess_mat,alpha=zero,beta=one) - END IF - - ALLOCATE (xold(ndf)) - xold(:) = x0(:) - - ALLOCATE (g(ndf)) - g(:) = 0.0_dp - - ALLOCATE (gold(ndf)) - gold(:) = 0.0_dp - - ALLOCATE (dx(ndf)) - dx(:) = 0.0_dp - - ALLOCATE (dg(ndf)) - dg(:) = 0.0_dp - - ALLOCATE (work(ndf)) - work(:) = 0.0_dp - - ALLOCATE (dr(ndf)) - dr(:) = 0.0_dp - - ! Geometry optimization starts now - CALL cp_iterate(logger%iter_info,increment=0,iter_nr_out=iter_nr) - CALL print_geo_opt_header(gopt_env, output_unit, wildcard) - - ! Calculate Energy & Gradients - CALL cp_eval_at(gopt_env, x0, etot, g, gopt_env%force_env%para_env%mepos,& - .FALSE., gopt_env%force_env%para_env) - - ! Print info at time 0 - emin = etot - t_now=m_walltime() - t_diff=t_now-t_old - t_old=t_now - CALL gopt_f_io_init(gopt_env, output_unit, etot, wildcard=wildcard, its=iter_nr, used_time=t_diff) - DO its = iter_nr+1, maxiter - CALL cp_iterate(logger%iter_info,last=(its==maxiter)) - CALL section_vals_val_set(geo_section,"STEP_START_VAL",i_val=its) - CALL gopt_f_ii(its, output_unit) - - ! Hessian update/restarting - IF (((its-iter_nr) == 1).AND.hesrest) THEN - IF (ionode) THEN - CALL section_vals_val_get(geo_section,"BFGS%RESTART_FILE_NAME",c_val=hes_filename) - CALL open_file(file_name=hes_filename,file_status="OLD",& - file_form="UNFORMATTED", file_action="READ", unit_number=hesunit_read) - END IF - CALL cp_fm_read_unformatted(hess_mat,hesunit_read) - IF (ionode) CALL close_file(unit_number=hesunit_read) - ELSE - IF( (its-iter_nr) > 1 ) THEN - DO indf = 1, ndf - dx(indf) = x0(indf) - xold(indf) - dg(indf) = g(indf) - gold(indf) - END DO + NULLIFY (logger, g, blacs_env) + logger => cp_get_default_logger() + para_env => force_env%para_env + root_section => force_env%root_section + t_old = m_walltime() + + CALL timeset(routineN, handle) + CALL section_vals_val_get(geo_section, "BFGS%TRUST_RADIUS", r_val=rad) + print_key => section_vals_get_subs_vals(geo_section, "BFGS%RESTART") + ionode = para_env%mepos == para_env%source + maxiter = gopt_param%max_iter + conv = .FALSE. + rat = 0.0_dp + wildcard = " BFGS" + + ! Stop if not yet implemented + SELECT CASE (gopt_env%type_id) + CASE (default_ts_method_id) + CPABORT("BFGS method not yet working with DIMER") + END SELECT + + CALL section_vals_val_get(geo_section, "BFGS%USE_RAT_FUN_OPT", l_val=use_rfo) + CALL section_vals_val_get(geo_section, "BFGS%USE_MODEL_HESSIAN", l_val=use_mod_hes) + CALL section_vals_val_get(geo_section, "BFGS%RESTART_HESSIAN", l_val=hesrest) + output_unit = cp_print_key_unit_nr(logger, geo_section, "PRINT%PROGRAM_RUN_INFO", & + extension=".geoLog") + IF (output_unit > 0) THEN + IF (use_rfo) THEN + WRITE (UNIT=output_unit, FMT="(/,T2,A,T78,A3)") & + "BFGS| Use rational function optimization for step estimation: ", "YES" + ELSE + WRITE (UNIT=output_unit, FMT="(/,T2,A,T78,A3)") & + "BFGS| Use rational function optimization for step estimation: ", " NO" + END IF + IF (use_mod_hes) THEN + WRITE (UNIT=output_unit, FMT="(T2,A,T78,A3)") & + "BFGS| Use model Hessian for initial guess: ", "YES" + ELSE + WRITE (UNIT=output_unit, FMT="(T2,A,T78,A3)") & + "BFGS| Use model Hessian for initial guess: ", " NO" + END IF + IF (hesrest) THEN + WRITE (UNIT=output_unit, FMT="(T2,A,T78,A3)") & + "BFGS| Restart Hessian: ", "YES" + ELSE + WRITE (UNIT=output_unit, FMT="(T2,A,T78,A3)") & + "BFGS| Restart Hessian: ", " NO" + END IF + WRITE (UNIT=output_unit, FMT="(T2,A,T61,F20.3)") & + "BFGS| Trust radius: ", rad + END IF + + ndf = SIZE(x0) + nfree = gopt_env%nfree + IF (ndf > 3000) & + CALL cp_warn(__LOCATION__, & + "The dimension of the Hessian matrix ("// & + TRIM(ADJUSTL(cp_to_string(ndf)))//") is greater than 3000. "// & + "The diagonalisation of the full Hessian matrix needed for BFGS "// & + "is computationally expensive. You should consider to use the linear "// & + "scaling variant L-BFGS instead.") + + ! Initialize hessian (hes = unitary matrix or model hessian ) + CALL cp_blacs_env_create(blacs_env, para_env, globenv%blacs_grid_layout, & + globenv%blacs_repeatable) + CALL cp_fm_struct_create(fm_struct_hes, para_env=para_env, context=blacs_env, & + nrow_global=ndf, ncol_global=ndf) + CALL cp_fm_create(hess_mat, fm_struct_hes, name="hess_mat") + CALL cp_fm_create(hess_tmp, fm_struct_hes, name="hess_tmp") + CALL cp_fm_create(eigvec_mat, fm_struct_hes, name="eigvec_mat") + ALLOCATE (eigval(ndf)) + eigval(:) = 0.0_dp + + CALL force_env_get(force_env=force_env, subsys=subsys) + CALL cp_subsys_get(subsys, atomic_kinds=atomic_kinds) + CALL get_atomic_kind_set(atomic_kind_set=atomic_kinds%els, shell_present=shell_present) + IF (use_mod_hes) THEN + IF (shell_present) THEN + CALL cp_warn(__LOCATION__, & + "No model Hessian is available for core-shell models. "// & + "A unit matrix is used as the initial Hessian.") + use_mod_hes = .FALSE. + END IF + IF (gopt_env%type_id == default_cell_method_id) THEN + CALL cp_warn(__LOCATION__, & + "No model Hessian is available for cell optimizations. "// & + "A unit matrix is used as the initial Hessian.") + use_mod_hes = .FALSE. + END IF + END IF - CALL bfgs(ndf,dx,dg,hess_mat,work,para_env) + IF (use_mod_hes) THEN + CALL cp_fm_set_all(hess_mat, alpha=zero, beta=0.00_dp) + CALL construct_initial_hess(gopt_env%force_env, hess_mat) + CALL cp_fm_to_fm(hess_mat, hess_tmp) + CALL choose_eigv_solver(hess_tmp, eigvec_mat, eigval, info=info) + ! In rare cases the diagonalization of hess_mat fails (bug in scalapack?) + IF (info /= 0) THEN + CALL cp_fm_set_all(hess_mat, alpha=zero, beta=one) + IF (output_unit > 0) WRITE (output_unit, *) & + "BFGS: Matrix diagonalization failed, using unity as model Hessian." + ELSE + DO its = 1, SIZE(eigval) + IF (eigval(its) .LT. 0.1_dp) eigval(its) = 0.1_dp + END DO + CALL cp_fm_to_fm(eigvec_mat, hess_tmp) + CALL cp_fm_column_scale(eigvec_mat, eigval) + CALL cp_gemm("N", "T", ndf, ndf, ndf, one, hess_tmp, eigvec_mat, zero, hess_mat) + ENDIF + ELSE + CALL cp_fm_set_all(hess_mat, alpha=zero, beta=one) + END IF - !Possibly dump the Hessian file - IF (BTEST(cp_print_key_should_output(logger%iter_info,print_key),cp_p_file))THEN - CALL write_bfgs_hessian(geo_section,hess_mat,logger) + ALLOCATE (xold(ndf)) + xold(:) = x0(:) + + ALLOCATE (g(ndf)) + g(:) = 0.0_dp + + ALLOCATE (gold(ndf)) + gold(:) = 0.0_dp + + ALLOCATE (dx(ndf)) + dx(:) = 0.0_dp + + ALLOCATE (dg(ndf)) + dg(:) = 0.0_dp + + ALLOCATE (work(ndf)) + work(:) = 0.0_dp + + ALLOCATE (dr(ndf)) + dr(:) = 0.0_dp + + ! Geometry optimization starts now + CALL cp_iterate(logger%iter_info, increment=0, iter_nr_out=iter_nr) + CALL print_geo_opt_header(gopt_env, output_unit, wildcard) + + ! Calculate Energy & Gradients + CALL cp_eval_at(gopt_env, x0, etot, g, gopt_env%force_env%para_env%mepos, & + .FALSE., gopt_env%force_env%para_env) + + ! Print info at time 0 + emin = etot + t_now = m_walltime() + t_diff = t_now - t_old + t_old = t_now + CALL gopt_f_io_init(gopt_env, output_unit, etot, wildcard=wildcard, its=iter_nr, used_time=t_diff) + DO its = iter_nr + 1, maxiter + CALL cp_iterate(logger%iter_info, last=(its == maxiter)) + CALL section_vals_val_set(geo_section, "STEP_START_VAL", i_val=its) + CALL gopt_f_ii(its, output_unit) + + ! Hessian update/restarting + IF (((its - iter_nr) == 1) .AND. hesrest) THEN + IF (ionode) THEN + CALL section_vals_val_get(geo_section, "BFGS%RESTART_FILE_NAME", c_val=hes_filename) + CALL open_file(file_name=hes_filename, file_status="OLD", & + file_form="UNFORMATTED", file_action="READ", unit_number=hesunit_read) + END IF + CALL cp_fm_read_unformatted(hess_mat, hesunit_read) + IF (ionode) CALL close_file(unit_number=hesunit_read) + ELSE + IF ((its - iter_nr) > 1) THEN + DO indf = 1, ndf + dx(indf) = x0(indf) - xold(indf) + dg(indf) = g(indf) - gold(indf) + END DO + + CALL bfgs(ndf, dx, dg, hess_mat, work, para_env) + + !Possibly dump the Hessian file + IF (BTEST(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN + CALL write_bfgs_hessian(geo_section, hess_mat, logger) + ENDIF ENDIF - ENDIF - END IF - - ! Setting the present positions & gradients as old - xold(:) = x0 - gold(:) = g - - ! Copying hessian hes to (ndf x ndf) matrix hes_mat for diagonalization - CALL cp_fm_to_fm(hess_mat,hess_tmp) - - CALL choose_eigv_solver(hess_tmp,eigvec_mat,eigval,info=info) - - ! In rare cases the diagonalization of hess_mat fails (bug in scalapack?) - IF (info /= 0) THEN - IF (output_unit > 0) WRITE(output_unit,*) & - "BFGS: Matrix diagonalization failed, resetting Hessian to unity." - CALL cp_fm_set_all(hess_mat,alpha=zero,beta=one) - CALL cp_fm_to_fm(hess_mat,hess_tmp) - CALL choose_eigv_solver(hess_tmp,eigvec_mat,eigval) - END IF - - IF (use_rfo) THEN - CALL set_hes_eig(ndf,eigval,work) - dx(:) = eigval - CALL rat_fun_opt(ndf,dg,eigval,work,eigvec_mat,g,para_env) - END IF - CALL geoopt_get_step(ndf,eigval,eigvec_mat,hess_tmp,dr,g,para_env,use_rfo) - CALL trust_radius(ndf,step,rad,rat,dr,output_unit) - - ! Update the atomic positions - x0 = x0 + dr - - CALL energy_predict(ndf,work,hess_mat,dr,g,conv,pred,para_env) - eold = etot - - ! Energy & Gradients at new step - CALL cp_eval_at(gopt_env, x0, etot, g, gopt_env%force_env%para_env%mepos,& - .FALSE., gopt_env%force_env%para_env) - ediff = etot - eold - - ! check for an external exit command - CALL external_control(should_stop,"GEO",globenv=globenv) - IF(should_stop) EXIT - - ! Some IO and Convergence check - t_now=m_walltime() - t_diff=t_now-t_old - t_old=t_now - CALL gopt_f_io(gopt_env, force_env, root_section, its, etot, output_unit,& - eold, emin, wildcard, gopt_param, ndf, dr, g, conv, pred, rat,& - step, rad, used_time=t_diff) - - IF (conv.OR.(its==maxiter)) EXIT - IF (etot < emin) emin = etot - IF (use_rfo) CALL update_trust_rad(rat,rad,step,ediff) - END DO - - IF (its == maxiter .AND. (.NOT.conv))THEN - CALL print_geo_opt_nc(gopt_env, output_unit) - END IF - - ! Write final information, if converged - CALL cp_iterate(logger%iter_info,last=.TRUE.,increment=0) - CALL write_bfgs_hessian(geo_section,hess_mat,logger) - CALL gopt_f_io_finalize(gopt_env, force_env, x0, conv, its, root_section,& - gopt_env%force_env%para_env, gopt_env%force_env%para_env%mepos, output_unit) - - CALL cp_fm_struct_release(fm_struct_hes) - CALL cp_fm_release(hess_mat) - CALL cp_fm_release(eigvec_mat) - CALL cp_fm_release(hess_tmp) - - CALL cp_blacs_env_release(blacs_env) - DEALLOCATE (xold) - DEALLOCATE (g) - DEALLOCATE (gold) - DEALLOCATE (dx) - DEALLOCATE (dg) - DEALLOCATE (eigval) - DEALLOCATE (work) - DEALLOCATE (dr) - - CALL cp_print_key_finished_output(output_unit,logger,geo_section,& - "PRINT%PROGRAM_RUN_INFO") - CALL timestop(handle) - - END SUBROUTINE geoopt_bfgs + END IF + + ! Setting the present positions & gradients as old + xold(:) = x0 + gold(:) = g + + ! Copying hessian hes to (ndf x ndf) matrix hes_mat for diagonalization + CALL cp_fm_to_fm(hess_mat, hess_tmp) + + CALL choose_eigv_solver(hess_tmp, eigvec_mat, eigval, info=info) + + ! In rare cases the diagonalization of hess_mat fails (bug in scalapack?) + IF (info /= 0) THEN + IF (output_unit > 0) WRITE (output_unit, *) & + "BFGS: Matrix diagonalization failed, resetting Hessian to unity." + CALL cp_fm_set_all(hess_mat, alpha=zero, beta=one) + CALL cp_fm_to_fm(hess_mat, hess_tmp) + CALL choose_eigv_solver(hess_tmp, eigvec_mat, eigval) + END IF + + IF (use_rfo) THEN + CALL set_hes_eig(ndf, eigval, work) + dx(:) = eigval + CALL rat_fun_opt(ndf, dg, eigval, work, eigvec_mat, g, para_env) + END IF + CALL geoopt_get_step(ndf, eigval, eigvec_mat, hess_tmp, dr, g, para_env, use_rfo) + CALL trust_radius(ndf, step, rad, rat, dr, output_unit) + + ! Update the atomic positions + x0 = x0 + dr + + CALL energy_predict(ndf, work, hess_mat, dr, g, conv, pred, para_env) + eold = etot + + ! Energy & Gradients at new step + CALL cp_eval_at(gopt_env, x0, etot, g, gopt_env%force_env%para_env%mepos, & + .FALSE., gopt_env%force_env%para_env) + ediff = etot - eold + + ! check for an external exit command + CALL external_control(should_stop, "GEO", globenv=globenv) + IF (should_stop) EXIT + + ! Some IO and Convergence check + t_now = m_walltime() + t_diff = t_now - t_old + t_old = t_now + CALL gopt_f_io(gopt_env, force_env, root_section, its, etot, output_unit, & + eold, emin, wildcard, gopt_param, ndf, dr, g, conv, pred, rat, & + step, rad, used_time=t_diff) + + IF (conv .OR. (its == maxiter)) EXIT + IF (etot < emin) emin = etot + IF (use_rfo) CALL update_trust_rad(rat, rad, step, ediff) + END DO + + IF (its == maxiter .AND. (.NOT. conv)) THEN + CALL print_geo_opt_nc(gopt_env, output_unit) + END IF + + ! Write final information, if converged + CALL cp_iterate(logger%iter_info, last=.TRUE., increment=0) + CALL write_bfgs_hessian(geo_section, hess_mat, logger) + CALL gopt_f_io_finalize(gopt_env, force_env, x0, conv, its, root_section, & + gopt_env%force_env%para_env, gopt_env%force_env%para_env%mepos, output_unit) + + CALL cp_fm_struct_release(fm_struct_hes) + CALL cp_fm_release(hess_mat) + CALL cp_fm_release(eigvec_mat) + CALL cp_fm_release(hess_tmp) + + CALL cp_blacs_env_release(blacs_env) + DEALLOCATE (xold) + DEALLOCATE (g) + DEALLOCATE (gold) + DEALLOCATE (dx) + DEALLOCATE (dg) + DEALLOCATE (eigval) + DEALLOCATE (work) + DEALLOCATE (dr) + + CALL cp_print_key_finished_output(output_unit, logger, geo_section, & + "PRINT%PROGRAM_RUN_INFO") + CALL timestop(handle) + + END SUBROUTINE geoopt_bfgs ! ************************************************************************************************** !> \brief ... @@ -397,7 +397,7 @@ END SUBROUTINE geoopt_bfgs !> \param g ... !> \param para_env ... ! ************************************************************************************************** - SUBROUTINE rat_fun_opt(ndf,dg,eigval,work,eigvec_mat,g,para_env) + SUBROUTINE rat_fun_opt(ndf, dg, eigval, work, eigvec_mat, g, para_env) INTEGER, INTENT(IN) :: ndf REAL(KIND=dp), INTENT(INOUT) :: dg(ndf), eigval(ndf), work(ndf) @@ -416,146 +416,146 @@ SUBROUTINE rat_fun_opt(ndf,dg,eigval,work,eigvec_mat,g,para_env) ln, lp, ssize, step, stol REAL(KIND=dp), DIMENSION(:, :), POINTER :: local_data - CALL timeset(routineN,handle) + CALL timeset(routineN, handle) - stol = 1.0E-8_dp - ssize = 0.2_dp - maxit = 999 - fail = .FALSE. - bisec = .FALSE. + stol = 1.0E-8_dp + ssize = 0.2_dp + maxit = 999 + fail = .FALSE. + bisec = .FALSE. - dg=0._dp + dg = 0._dp - CALL cp_fm_get_info(eigvec_mat,row_indices=row_indices,col_indices=col_indices, & - local_data=local_data,nrow_local=nrow_local,ncol_local=ncol_local) + CALL cp_fm_get_info(eigvec_mat, row_indices=row_indices, col_indices=col_indices, & + local_data=local_data, nrow_local=nrow_local, ncol_local=ncol_local) - DO i=1,nrow_local - j=row_indices(i) - DO k=1,ncol_local - l=col_indices(k) - dg(l)=dg(l)+local_data(i,k)*g(j) - END DO - END DO - CALL mp_sum(dg,para_env%group) + DO i = 1, nrow_local + j = row_indices(i) + DO k = 1, ncol_local + l = col_indices(k) + dg(l) = dg(l) + local_data(i, k)*g(j) + END DO + END DO + CALL mp_sum(dg, para_env%group) - set = .FALSE. + set = .FALSE. - DO + DO ! calculating Lamda - lp = 0.0_dp - iref = 1 - ln = 0.0_dp - IF(eigval(iref) < 0.0_dp )ln = eigval(iref) - 0.01_dp + lp = 0.0_dp + iref = 1 + ln = 0.0_dp + IF (eigval(iref) < 0.0_dp) ln = eigval(iref) - 0.01_dp - iter = 0 - DO - iter = iter + 1 - fun = 0.0_dp - fung = 0.0_dp - DO indf = 1, ndf - fun = fun + dg(indf)**2/(ln-eigval(indf)) - fung = fung - dg(indf)**2 /(ln-eigval(indf)**2) + iter = 0 + DO + iter = iter + 1 + fun = 0.0_dp + fung = 0.0_dp + DO indf = 1, ndf + fun = fun + dg(indf)**2/(ln - eigval(indf)) + fung = fung - dg(indf)**2/(ln - eigval(indf)**2) + END DO + fun = fun - ln + fung = fung - one + step = fun/fung + ln = ln - step + IF (ABS(step) < stol) GOTO 200 + IF (iter >= maxit) EXIT END DO - fun = fun - ln - fung = fung - one - step = fun/fung - ln = ln - step - IF(ABS(step) < stol )GOTO 200 - IF(iter >= maxit)EXIT - END DO -100 CONTINUE - bisec = .TRUE. - iter = 0 - maxit = 9999 - lam1 = 0.0_dp - IF(eigval(iref) < 0.0_dp )lam1 = eigval(iref) - 0.01_dp - fun1 = 0.0_dp - DO indf = 1, ndf - fun1 = fun1 + dg(indf)**2 / (lam1-eigval(indf)) - END DO - fun1 = fun1 - lam1 - step = ABS(lam1)/1000.0_dp - IF(step < ssize) step = ssize - DO - iter = iter + 1 - IF(iter > maxit)THEN - ln = 0.0_dp - lp = 0.0_dp - fail = .TRUE. - GOTO 300 - END IF - fun2 = 0.0_dp - lam2 = lam1 - iter * step +100 CONTINUE + bisec = .TRUE. + iter = 0 + maxit = 9999 + lam1 = 0.0_dp + IF (eigval(iref) < 0.0_dp) lam1 = eigval(iref) - 0.01_dp + fun1 = 0.0_dp DO indf = 1, ndf - fun2 = fun2 + eigval(indf)**2 / (lam2 - eigval(indf)) + fun1 = fun1 + dg(indf)**2/(lam1 - eigval(indf)) END DO - fun2 = fun2 - lam2 - IF(fun2*fun1 < 0.0_dp )THEN - iter = 0 - DO - iter = iter + 1 - IF(iter > maxit)THEN + fun1 = fun1 - lam1 + step = ABS(lam1)/1000.0_dp + IF (step < ssize) step = ssize + DO + iter = iter + 1 + IF (iter > maxit) THEN ln = 0.0_dp lp = 0.0_dp fail = .TRUE. GOTO 300 - END IF - step = (lam1+lam2)/2 - fun3 = 0.0_dp - DO indf = 1, ndf - fun3 = fun3 + dg(indf)**2/(step-eigval(indf)) - END DO - fun3 = fun3 - step - - IF( ABS(step-lam2) < stol)THEN - ln = step - GOTO 200 - END IF - - IF( fun3 * fun1 < stol )THEN - lam2 = step - ELSE - lam1 = step - END IF - END DO - END IF - END DO + END IF + fun2 = 0.0_dp + lam2 = lam1 - iter*step + DO indf = 1, ndf + fun2 = fun2 + eigval(indf)**2/(lam2 - eigval(indf)) + END DO + fun2 = fun2 - lam2 + IF (fun2*fun1 < 0.0_dp) THEN + iter = 0 + DO + iter = iter + 1 + IF (iter > maxit) THEN + ln = 0.0_dp + lp = 0.0_dp + fail = .TRUE. + GOTO 300 + END IF + step = (lam1 + lam2)/2 + fun3 = 0.0_dp + DO indf = 1, ndf + fun3 = fun3 + dg(indf)**2/(step - eigval(indf)) + END DO + fun3 = fun3 - step + + IF (ABS(step - lam2) < stol) THEN + ln = step + GOTO 200 + END IF + + IF (fun3*fun1 < stol) THEN + lam2 = step + ELSE + lam1 = step + END IF + END DO + END IF + END DO -200 CONTINUE - IF( (ln > eigval(iref)).OR. ( (ln > 0.0_dp) .AND. & - (eigval(iref) > 0.0_dp) ) )THEN +200 CONTINUE + IF ((ln > eigval(iref)) .OR. ((ln > 0.0_dp) .AND. & + (eigval(iref) > 0.0_dp))) THEN - IF(.NOT. bisec)GOTO 100 - ln = 0.0_dp - lp = 0.0_dp - fail = .TRUE. - END IF + IF (.NOT. bisec) GOTO 100 + ln = 0.0_dp + lp = 0.0_dp + fail = .TRUE. + END IF -300 CONTINUE +300 CONTINUE - IF(fail .AND. .NOT. set )THEN - set = .TRUE. - DO indf = 1, ndf - eigval(indf) = eigval(indf) * work(indf) - END DO - CYCLE - END IF + IF (fail .AND. .NOT. set) THEN + set = .TRUE. + DO indf = 1, ndf + eigval(indf) = eigval(indf)*work(indf) + END DO + CYCLE + END IF - IF(.NOT. set) THEN - work(1:ndf)=one - ENDIF + IF (.NOT. set) THEN + work(1:ndf) = one + ENDIF - DO indf = 1, ndf - eigval(indf) = eigval(indf) - ln - END DO - EXIT - END DO + DO indf = 1, ndf + eigval(indf) = eigval(indf) - ln + END DO + EXIT + END DO - CALL timestop(handle) + CALL timestop(handle) - END SUBROUTINE rat_fun_opt + END SUBROUTINE rat_fun_opt ! ************************************************************************************************** !> \brief ... @@ -566,7 +566,7 @@ END SUBROUTINE rat_fun_opt !> \param work ... !> \param para_env ... ! ************************************************************************************************** - SUBROUTINE bfgs(ndf,dx,dg,hess_mat,work,para_env) + SUBROUTINE bfgs(ndf, dx, dg, hess_mat, work, para_env) INTEGER, INTENT(IN) :: ndf REAL(KIND=dp), INTENT(INOUT) :: dx(ndf), dg(ndf) TYPE(cp_fm_type), POINTER :: hess_mat @@ -582,39 +582,39 @@ SUBROUTINE bfgs(ndf,dx,dg,hess_mat,work,para_env) REAL(KIND=dp) :: DDOT, dxw, gdx REAL(KIND=dp), DIMENSION(:, :), POINTER :: local_hes - CALL timeset(routineN,handle) + CALL timeset(routineN, handle) - CALL cp_fm_get_info(hess_mat,row_indices=row_indices,col_indices=col_indices, & - local_data=local_hes,nrow_local=nrow_local,ncol_local=ncol_local) + CALL cp_fm_get_info(hess_mat, row_indices=row_indices, col_indices=col_indices, & + local_data=local_hes, nrow_local=nrow_local, ncol_local=ncol_local) - work=zero - DO i=1,nrow_local - j=row_indices(i) - DO k=1,ncol_local - l=col_indices(k) - work(j)=work(j)+local_hes(i,k)*dx(l) - END DO - END DO + work = zero + DO i = 1, nrow_local + j = row_indices(i) + DO k = 1, ncol_local + l = col_indices(k) + work(j) = work(j) + local_hes(i, k)*dx(l) + END DO + END DO - CALL mp_sum(work,para_env%group) + CALL mp_sum(work, para_env%group) - gdx = DDOT(ndf,dg,1,dx,1) - gdx = one/gdx - dxw = DDOT(ndf,dx,1,work,1) - dxw = one/dxw + gdx = DDOT(ndf, dg, 1, dx, 1) + gdx = one/gdx + dxw = DDOT(ndf, dx, 1, work, 1) + dxw = one/dxw - DO i=1,nrow_local - j=row_indices(i) - DO k=1,ncol_local - l=col_indices(k) - local_hes(i,k)=local_hes(i,k)+gdx*dg(j)*dg(l) -& - dxw*work(j)*work(l) - END DO - END DO + DO i = 1, nrow_local + j = row_indices(i) + DO k = 1, ncol_local + l = col_indices(k) + local_hes(i, k) = local_hes(i, k) + gdx*dg(j)*dg(l) - & + dxw*work(j)*work(l) + END DO + END DO - CALL timestop(handle) + CALL timestop(handle) - END SUBROUTINE bfgs + END SUBROUTINE bfgs ! ************************************************************************************************** !> \brief ... @@ -622,7 +622,7 @@ END SUBROUTINE bfgs !> \param eigval ... !> \param work ... ! ************************************************************************************************** - SUBROUTINE set_hes_eig(ndf,eigval,work) + SUBROUTINE set_hes_eig(ndf, eigval, work) INTEGER, INTENT(IN) :: ndf REAL(KIND=dp), INTENT(INOUT) :: eigval(ndf), work(ndf) @@ -633,39 +633,39 @@ SUBROUTINE set_hes_eig(ndf,eigval,work) INTEGER :: handle, indf LOGICAL :: neg - CALL timeset(routineN,handle) - - DO indf = 1, ndf - IF(eigval(indf) < 0.0_dp )neg = .TRUE. - IF(eigval(indf) > 1000.0_dp)eigval(indf) = 1000.0_dp - END DO - DO indf = 1, ndf - IF( eigval(indf) < 0.0_dp ) THEN - IF(eigval(indf) < max_neg)THEN - eigval(indf) = max_neg - ELSE IF(eigval(indf) > - min_eig )THEN - eigval(indf) = - min_eig - END IF - ELSE IF(eigval(indf) < 1000.0_dp)THEN - IF(eigval(indf) < min_eig)THEN - eigval(indf) = min_eig - ELSE IF(eigval(indf) > max_pos)THEN - eigval(indf) = max_pos - END IF - END IF - END DO - - DO indf = 1, ndf - IF( eigval(indf) < 0.0_dp )THEN - work(indf) = - one - ELSE - work(indf) = one - END IF - END DO - - CALL timestop(handle) - - END SUBROUTINE set_hes_eig + CALL timeset(routineN, handle) + + DO indf = 1, ndf + IF (eigval(indf) < 0.0_dp) neg = .TRUE. + IF (eigval(indf) > 1000.0_dp) eigval(indf) = 1000.0_dp + END DO + DO indf = 1, ndf + IF (eigval(indf) < 0.0_dp) THEN + IF (eigval(indf) < max_neg) THEN + eigval(indf) = max_neg + ELSE IF (eigval(indf) > -min_eig) THEN + eigval(indf) = -min_eig + END IF + ELSE IF (eigval(indf) < 1000.0_dp) THEN + IF (eigval(indf) < min_eig) THEN + eigval(indf) = min_eig + ELSE IF (eigval(indf) > max_pos) THEN + eigval(indf) = max_pos + END IF + END IF + END DO + + DO indf = 1, ndf + IF (eigval(indf) < 0.0_dp) THEN + work(indf) = -one + ELSE + work(indf) = one + END IF + END DO + + CALL timestop(handle) + + END SUBROUTINE set_hes_eig ! ************************************************************************************************** !> \brief ... @@ -678,7 +678,7 @@ END SUBROUTINE set_hes_eig !> \param para_env ... !> \param use_rfo ... ! ************************************************************************************************** - SUBROUTINE geoopt_get_step(ndf,eigval,eigvec_mat,hess_tmp,dr,g,para_env,use_rfo) + SUBROUTINE geoopt_get_step(ndf, eigval, eigvec_mat, hess_tmp, dr, g, para_env, use_rfo) INTEGER, INTENT(IN) :: ndf REAL(KIND=dp), INTENT(INOUT) :: eigval(ndf) @@ -695,43 +695,43 @@ SUBROUTINE geoopt_get_step(ndf,eigval,eigvec_mat,hess_tmp,dr,g,para_env,use_rfo) TYPE(cp_fm_struct_type), POINTER :: matrix_struct TYPE(cp_fm_type), POINTER :: tmp - CALL cp_fm_to_fm(eigvec_mat,hess_tmp) - IF(use_rfo)THEN - DO indf=1,ndf - eigval(indf) = one/eigval(indf) - END DO - ELSE - DO indf=1,ndf - eigval(indf) = one/MAX(0.0001_dp,eigval(indf)) - END DO - END IF + CALL cp_fm_to_fm(eigvec_mat, hess_tmp) + IF (use_rfo) THEN + DO indf = 1, ndf + eigval(indf) = one/eigval(indf) + END DO + ELSE + DO indf = 1, ndf + eigval(indf) = one/MAX(0.0001_dp, eigval(indf)) + END DO + END IF - CALL cp_fm_column_scale(hess_tmp,eigval) - CALL cp_fm_get_info(eigvec_mat,matrix_struct=matrix_struct) - CALL cp_fm_create(tmp, matrix_struct ,name="tmp") + CALL cp_fm_column_scale(hess_tmp, eigval) + CALL cp_fm_get_info(eigvec_mat, matrix_struct=matrix_struct) + CALL cp_fm_create(tmp, matrix_struct, name="tmp") - CALL cp_gemm("N","T",ndf,ndf,ndf,one,hess_tmp,eigvec_mat,zero,tmp) + CALL cp_gemm("N", "T", ndf, ndf, ndf, one, hess_tmp, eigvec_mat, zero, tmp) - CALL cp_fm_transpose(tmp,hess_tmp) - CALL cp_fm_release(tmp) + CALL cp_fm_transpose(tmp, hess_tmp) + CALL cp_fm_release(tmp) ! ** New step ** - CALL cp_fm_get_info(hess_tmp,row_indices=row_indices,col_indices=col_indices, & - local_data=local_data,nrow_local=nrow_local,ncol_local=ncol_local) + CALL cp_fm_get_info(hess_tmp, row_indices=row_indices, col_indices=col_indices, & + local_data=local_data, nrow_local=nrow_local, ncol_local=ncol_local) - dr=0.0_dp - DO i=1,nrow_local - j=row_indices(i) - DO k=1,ncol_local - l=col_indices(k) - dr(j)=dr(j)-local_data(i,k)*g(l) - END DO - END DO + dr = 0.0_dp + DO i = 1, nrow_local + j = row_indices(i) + DO k = 1, ncol_local + l = col_indices(k) + dr(j) = dr(j) - local_data(i, k)*g(l) + END DO + END DO - CALL mp_sum(dr,para_env%group) + CALL mp_sum(dr, para_env%group) - END SUBROUTINE geoopt_get_step + END SUBROUTINE geoopt_get_step ! ************************************************************************************************** !> \brief ... @@ -742,7 +742,7 @@ END SUBROUTINE geoopt_get_step !> \param dr ... !> \param output_unit ... ! ************************************************************************************************** - SUBROUTINE trust_radius(ndf,step,rad,rat,dr,output_unit) + SUBROUTINE trust_radius(ndf, step, rad, rat, dr, output_unit) INTEGER, INTENT(IN) :: ndf REAL(KIND=dp), INTENT(INOUT) :: step, rad, rat, dr(ndf) INTEGER, INTENT(IN) :: output_unit @@ -753,24 +753,24 @@ SUBROUTINE trust_radius(ndf,step,rad,rat,dr,output_unit) INTEGER :: handle REAL(KIND=dp) :: scal - CALL timeset(routineN,handle) + CALL timeset(routineN, handle) - step = MAXVAL(ABS(dr)) - scal = MAX(one,rad/step) + step = MAXVAL(ABS(dr)) + scal = MAX(one, rad/step) - IF( step > rad )THEN - rat = rad / step - CALL DSCAL(ndf,rat,dr,1) - step = rad - IF(output_unit>0) THEN - WRITE(unit=output_unit,FMT="(/,T2,A,F8.5)") & - " Step is scaled; Scaling factor = ", rat - CALL m_flush(output_unit) - ENDIF - END IF - CALL timestop(handle) + IF (step > rad) THEN + rat = rad/step + CALL DSCAL(ndf, rat, dr, 1) + step = rad + IF (output_unit > 0) THEN + WRITE (unit=output_unit, FMT="(/,T2,A,F8.5)") & + " Step is scaled; Scaling factor = ", rat + CALL m_flush(output_unit) + ENDIF + END IF + CALL timestop(handle) - END SUBROUTINE trust_radius + END SUBROUTINE trust_radius ! ************************************************************************************************** !> \brief ... @@ -783,7 +783,7 @@ END SUBROUTINE trust_radius !> \param pred ... !> \param para_env ... ! ************************************************************************************************** - SUBROUTINE energy_predict(ndf,work,hess_mat,dr,g,conv,pred,para_env) + SUBROUTINE energy_predict(ndf, work, hess_mat, dr, g, conv, pred, para_env) INTEGER, INTENT(IN) :: ndf REAL(KIND=dp), INTENT(INOUT) :: work(ndf) @@ -802,29 +802,29 @@ SUBROUTINE energy_predict(ndf,work,hess_mat,dr,g,conv,pred,para_env) REAL(KIND=dp) :: DDOT, ener1, ener2 REAL(KIND=dp), DIMENSION(:, :), POINTER :: local_data - CALL timeset(routineN,handle) + CALL timeset(routineN, handle) - ener1 = DDOT(ndf,g,1,dr,1) + ener1 = DDOT(ndf, g, 1, dr, 1) - CALL cp_fm_get_info(hess_mat,row_indices=row_indices,col_indices=col_indices, & - local_data=local_data,nrow_local=nrow_local,ncol_local=ncol_local) + CALL cp_fm_get_info(hess_mat, row_indices=row_indices, col_indices=col_indices, & + local_data=local_data, nrow_local=nrow_local, ncol_local=ncol_local) - work=zero - DO i=1,nrow_local - j=row_indices(i) - DO k=1,ncol_local - l=col_indices(k) - work(j)=work(j)+local_data(i,k)*dr(l) - END DO - END DO + work = zero + DO i = 1, nrow_local + j = row_indices(i) + DO k = 1, ncol_local + l = col_indices(k) + work(j) = work(j) + local_data(i, k)*dr(l) + END DO + END DO - CALL mp_sum(work,para_env%group) - ener2 = DDOT(ndf,dr,1,work,1) - pred = ener1 + 0.5_dp * ener2 - conv = .FALSE. - CALL timestop(handle) + CALL mp_sum(work, para_env%group) + ener2 = DDOT(ndf, dr, 1, work, 1) + pred = ener1 + 0.5_dp*ener2 + conv = .FALSE. + CALL timestop(handle) - END SUBROUTINE energy_predict + END SUBROUTINE energy_predict ! ************************************************************************************************** !> \brief ... @@ -833,7 +833,7 @@ END SUBROUTINE energy_predict !> \param step ... !> \param ediff ... ! ************************************************************************************************** - SUBROUTINE update_trust_rad(rat,rad,step,ediff) + SUBROUTINE update_trust_rad(rat, rad, step, ediff) REAL(KIND=dp), INTENT(INOUT) :: rat, rad, step, ediff @@ -843,67 +843,67 @@ SUBROUTINE update_trust_rad(rat,rad,step,ediff) INTEGER :: handle - CALL timeset(routineN,handle) + CALL timeset(routineN, handle) - IF( rat > 4.0_dp )THEN - IF( ediff < 0.0_dp)THEN - rad = step * 0.5_dp - ELSE - rad = step * 0.25_dp - END IF - ELSE IF ( rat > 2.0_dp )THEN - IF( ediff < 0.0_dp )THEN - rad = step * 0.75_dp - ELSE - rad = step * 0.5_dp - END IF - ELSE IF ( rat > 4.0_dp/3.0_dp )THEN - IF( ediff < 0.0_dp )THEN - rad = step - ELSE - rad = step * 0.75_dp - END IF - ELSE IF (rat > 10.0_dp/9.0_dp )THEN - IF( ediff < 0.0_dp )THEN - rad = step * 1.25_dp - ELSE - rad = step - END IF - ELSE IF( rat > 0.9_dp )THEN - IF( ediff < 0.0_dp )THEN - rad = step * 1.5_dp - ELSE - rad = step * 1.25_dp - END IF - ELSE IF( rat > 0.75_dp )THEN - IF( ediff < 0.0_dp )THEN - rad = step * 1.25_dp - ELSE - rad = step - END IF - ELSE IF( rat > 0.5_dp )THEN - IF( ediff < 0.0_dp )THEN - rad = step - ELSE - rad = step * 0.75_dp - END IF - ELSE IF( rat > 0.25_dp )THEN - IF( ediff < 0.0_dp )THEN - rad = step * 0.75_dp + IF (rat > 4.0_dp) THEN + IF (ediff < 0.0_dp) THEN + rad = step*0.5_dp + ELSE + rad = step*0.25_dp + END IF + ELSE IF (rat > 2.0_dp) THEN + IF (ediff < 0.0_dp) THEN + rad = step*0.75_dp + ELSE + rad = step*0.5_dp + END IF + ELSE IF (rat > 4.0_dp/3.0_dp) THEN + IF (ediff < 0.0_dp) THEN + rad = step + ELSE + rad = step*0.75_dp + END IF + ELSE IF (rat > 10.0_dp/9.0_dp) THEN + IF (ediff < 0.0_dp) THEN + rad = step*1.25_dp + ELSE + rad = step + END IF + ELSE IF (rat > 0.9_dp) THEN + IF (ediff < 0.0_dp) THEN + rad = step*1.5_dp + ELSE + rad = step*1.25_dp + END IF + ELSE IF (rat > 0.75_dp) THEN + IF (ediff < 0.0_dp) THEN + rad = step*1.25_dp + ELSE + rad = step + END IF + ELSE IF (rat > 0.5_dp) THEN + IF (ediff < 0.0_dp) THEN + rad = step + ELSE + rad = step*0.75_dp + END IF + ELSE IF (rat > 0.25_dp) THEN + IF (ediff < 0.0_dp) THEN + rad = step*0.75_dp + ELSE + rad = step*0.5_dp + END IF + ELSE IF (ediff < 0.0_dp) THEN + rad = step*0.5_dp ELSE - rad = step * 0.5_dp + rad = step*0.25_dp END IF - ELSE IF( ediff < 0.0_dp )THEN - rad = step * 0.5_dp - ELSE - rad = step * 0.25_dp - END IF - rad = MAX(rad,min_trust) - rad = MIN(rad,max_trust) - CALL timestop(handle) + rad = MAX(rad, min_trust) + rad = MIN(rad, max_trust) + CALL timestop(handle) - END SUBROUTINE update_trust_rad + END SUBROUTINE update_trust_rad ! ************************************************************************************************** @@ -913,7 +913,7 @@ END SUBROUTINE update_trust_rad !> \param hess_mat ... !> \param logger ... ! ************************************************************************************************** - SUBROUTINE write_bfgs_hessian(geo_section,hess_mat,logger) + SUBROUTINE write_bfgs_hessian(geo_section, hess_mat, logger) TYPE(section_vals_type), POINTER :: geo_section TYPE(cp_fm_type), POINTER :: hess_mat @@ -924,19 +924,19 @@ SUBROUTINE write_bfgs_hessian(geo_section,hess_mat,logger) INTEGER :: handle, hesunit - CALL timeset(routineN,handle) + CALL timeset(routineN, handle) - hesunit = cp_print_key_unit_nr(logger,geo_section,"BFGS%RESTART",& - extension=".Hessian",file_form="UNFORMATTED",file_action="WRITE",& - file_position="REWIND") + hesunit = cp_print_key_unit_nr(logger, geo_section, "BFGS%RESTART", & + extension=".Hessian", file_form="UNFORMATTED", file_action="WRITE", & + file_position="REWIND") - CALL cp_fm_write_unformatted(hess_mat,hesunit) + CALL cp_fm_write_unformatted(hess_mat, hesunit) - CALL cp_print_key_finished_output(hesunit,logger,geo_section,"BFGS%RESTART") + CALL cp_print_key_finished_output(hesunit, logger, geo_section, "BFGS%RESTART") - CALL timestop(handle) + CALL timestop(handle) - END SUBROUTINE write_bfgs_hessian + END SUBROUTINE write_bfgs_hessian ! ************************************************************************************************** ! ************************************************************************************************** @@ -944,7 +944,7 @@ END SUBROUTINE write_bfgs_hessian !> \param force_env ... !> \param hess_mat ... ! ************************************************************************************************** - SUBROUTINE construct_initial_hess(force_env,hess_mat) + SUBROUTINE construct_initial_hess(force_env, hess_mat) TYPE(force_env_type), POINTER :: force_env TYPE(cp_fm_type), POINTER :: hess_mat @@ -965,97 +965,97 @@ SUBROUTINE construct_initial_hess(force_env,hess_mat) TYPE(cp_subsys_type), POINTER :: subsys TYPE(particle_list_type), POINTER :: particles - CALL force_env_get(force_env=force_env,subsys=subsys,cell=cell) - CALL cp_subsys_get(subsys,& - particles=particles) - - alpha(1,:)=(/1._dp,0.3949_dp,0.3949_dp/) - alpha(2,:)=(/0.3494_dp,0.2800_dp,0.2800_dp/) - alpha(3,:)=(/0.3494_dp,0.2800_dp,0.1800_dp/) - - r0(1,:)=(/1.35_dp,2.10_dp,2.53_dp/) - r0(2,:)=(/2.10_dp,2.87_dp,3.40_dp/) - r0(3,:)=(/2.53_dp,3.40_dp,3.40_dp/) - - CALL cp_fm_get_info(hess_mat,row_indices=row_indices,col_indices=col_indices, & - local_data=local_data,nrow_local=nrow_local,ncol_local=ncol_local) - natom=particles%n_els - ALLOCATE(at_row(natom)) - ALLOCATE(rho_ij(natom,natom)) - ALLOCATE(d_ij(natom,natom)) - ALLOCATE(r_ij(natom,natom,3)) - ALLOCATE(fixed(3,natom)) - fixed=1.0_dp - CALL fix_atom_control( force_env,fixed) - DO i=1,3 - CALL mp_min(fixed(i,:),hess_mat%matrix_struct%para_env%group) - END DO - rho_ij=0 + CALL force_env_get(force_env=force_env, subsys=subsys, cell=cell) + CALL cp_subsys_get(subsys, & + particles=particles) + + alpha(1, :) = (/1._dp, 0.3949_dp, 0.3949_dp/) + alpha(2, :) = (/0.3494_dp, 0.2800_dp, 0.2800_dp/) + alpha(3, :) = (/0.3494_dp, 0.2800_dp, 0.1800_dp/) + + r0(1, :) = (/1.35_dp, 2.10_dp, 2.53_dp/) + r0(2, :) = (/2.10_dp, 2.87_dp, 3.40_dp/) + r0(3, :) = (/2.53_dp, 3.40_dp, 3.40_dp/) + + CALL cp_fm_get_info(hess_mat, row_indices=row_indices, col_indices=col_indices, & + local_data=local_data, nrow_local=nrow_local, ncol_local=ncol_local) + natom = particles%n_els + ALLOCATE (at_row(natom)) + ALLOCATE (rho_ij(natom, natom)) + ALLOCATE (d_ij(natom, natom)) + ALLOCATE (r_ij(natom, natom, 3)) + ALLOCATE (fixed(3, natom)) + fixed = 1.0_dp + CALL fix_atom_control(force_env, fixed) + DO i = 1, 3 + CALL mp_min(fixed(i, :), hess_mat%matrix_struct%para_env%group) + END DO + rho_ij = 0 !XXXX insert proper rows !XXX - at_row=3 - DO i=1,natom - CALL get_atomic_kind(atomic_kind=particles%els(i)%atomic_kind,z=z) - IF(z.LE.10)at_row(i)=2 - IF(z.LE.2)at_row(i)=1 - END DO - DO i=2,natom - iat_row=at_row(i) - DO j=1,i-1 - jat_row=at_row(j) - !pbc for a distance vector - r_ij(j,i,:)=pbc(particles%els(i)%r,particles%els(j)%r,cell) - r_ij(i,j,:)=-r_ij(j,i,:) - d_ij(j,i)=SQRT(DOT_PRODUCT(r_ij(j,i,:),r_ij(j,i,:))) - d_ij(i,j)=d_ij(j,i) - rho_ij(j,i)=EXP(alpha(jat_row,iat_row)*(r0(jat_row,iat_row)**2-d_ij(j,i)**2)) - rho_ij(i,j)=rho_ij(j,i) - END DO - END DO - DO i=1,ncol_local - iglobal=col_indices(i) - iind=MOD(iglobal-1,3)+1 - iat_col=(iglobal+2)/3 - IF(iat_col.GT.natom)CYCLE - DO j=1,nrow_local - jglobal=row_indices(j) - jind=MOD(jglobal-1,3)+1 - iat_row=(jglobal+2)/3 - IF(iat_row.GT.natom)CYCLE - IF(iat_row.NE.iat_col)THEN - IF(d_ij(iat_row,iat_col).LT.6.0_dp)& - local_data(j,i)=local_data(j,i)+& - angle_second_deriv(r_ij,d_ij,rho_ij,iind,jind,iat_col,iat_row,natom) - ELSE - local_data(j,i)=local_data(j,i)+& - angle_second_deriv(r_ij,d_ij,rho_ij,iind,jind,iat_col,iat_row,natom) - END IF - IF(iat_col.NE.iat_row)THEN - IF(d_ij(iat_row,iat_col).LT.6.0_dp) & - local_data(j,i)=local_data(j,i)-& - dist_second_deriv(r_ij(iat_col,iat_row,:),& - iind,jind,d_ij(iat_row,iat_col),rho_ij(iat_row,iat_col)) - ELSE - DO k=1,natom - IF(k==iat_col)CYCLE - IF(d_ij(iat_row,k).LT.6.0_dp) & - local_data(j,i)=local_data(j,i)+& - dist_second_deriv(r_ij(iat_col,k,:),& - iind,jind,d_ij(iat_row,k),rho_ij(iat_row,k)) - END DO - END IF - IF(fixed(jind,iat_row).LT.0.5_dp.OR.fixed(iind,iat_col).LT.0.5_dp)THEN - local_data(j,i)=0.0_dp - IF(jind==iind.AND.iat_row==iat_col)local_data(j,i)=1.0_dp - END IF - END DO - END DO - DEALLOCATE(fixed) - DEALLOCATE(rho_ij) - DEALLOCATE(d_ij) - DEALLOCATE(r_ij) - DEALLOCATE(at_row) - - END SUBROUTINE construct_initial_hess + at_row = 3 + DO i = 1, natom + CALL get_atomic_kind(atomic_kind=particles%els(i)%atomic_kind, z=z) + IF (z .LE. 10) at_row(i) = 2 + IF (z .LE. 2) at_row(i) = 1 + END DO + DO i = 2, natom + iat_row = at_row(i) + DO j = 1, i - 1 + jat_row = at_row(j) + !pbc for a distance vector + r_ij(j, i, :) = pbc(particles%els(i)%r, particles%els(j)%r, cell) + r_ij(i, j, :) = -r_ij(j, i, :) + d_ij(j, i) = SQRT(DOT_PRODUCT(r_ij(j, i, :), r_ij(j, i, :))) + d_ij(i, j) = d_ij(j, i) + rho_ij(j, i) = EXP(alpha(jat_row, iat_row)*(r0(jat_row, iat_row)**2 - d_ij(j, i)**2)) + rho_ij(i, j) = rho_ij(j, i) + END DO + END DO + DO i = 1, ncol_local + iglobal = col_indices(i) + iind = MOD(iglobal - 1, 3) + 1 + iat_col = (iglobal + 2)/3 + IF (iat_col .GT. natom) CYCLE + DO j = 1, nrow_local + jglobal = row_indices(j) + jind = MOD(jglobal - 1, 3) + 1 + iat_row = (jglobal + 2)/3 + IF (iat_row .GT. natom) CYCLE + IF (iat_row .NE. iat_col) THEN + IF (d_ij(iat_row, iat_col) .LT. 6.0_dp) & + local_data(j, i) = local_data(j, i) + & + angle_second_deriv(r_ij, d_ij, rho_ij, iind, jind, iat_col, iat_row, natom) + ELSE + local_data(j, i) = local_data(j, i) + & + angle_second_deriv(r_ij, d_ij, rho_ij, iind, jind, iat_col, iat_row, natom) + END IF + IF (iat_col .NE. iat_row) THEN + IF (d_ij(iat_row, iat_col) .LT. 6.0_dp) & + local_data(j, i) = local_data(j, i) - & + dist_second_deriv(r_ij(iat_col, iat_row, :), & + iind, jind, d_ij(iat_row, iat_col), rho_ij(iat_row, iat_col)) + ELSE + DO k = 1, natom + IF (k == iat_col) CYCLE + IF (d_ij(iat_row, k) .LT. 6.0_dp) & + local_data(j, i) = local_data(j, i) + & + dist_second_deriv(r_ij(iat_col, k, :), & + iind, jind, d_ij(iat_row, k), rho_ij(iat_row, k)) + END DO + END IF + IF (fixed(jind, iat_row) .LT. 0.5_dp .OR. fixed(iind, iat_col) .LT. 0.5_dp) THEN + local_data(j, i) = 0.0_dp + IF (jind == iind .AND. iat_row == iat_col) local_data(j, i) = 1.0_dp + END IF + END DO + END DO + DEALLOCATE (fixed) + DEALLOCATE (rho_ij) + DEALLOCATE (d_ij) + DEALLOCATE (r_ij) + DEALLOCATE (at_row) + + END SUBROUTINE construct_initial_hess ! ************************************************************************************************** !> \brief ... @@ -1066,13 +1066,13 @@ END SUBROUTINE construct_initial_hess !> \param rho ... !> \return ... ! ************************************************************************************************** - FUNCTION dist_second_deriv(r1,i,j,d,rho) RESULT(deriv) + FUNCTION dist_second_deriv(r1, i, j, d, rho) RESULT(deriv) REAL(KIND=dp), DIMENSION(3) :: r1 INTEGER :: i, j REAL(KIND=dp) :: d, rho, deriv - deriv=0.45_dp*rho*(r1(i)*r1(j))/d**2 - END FUNCTION + deriv = 0.45_dp*rho*(r1(i)*r1(j))/d**2 + END FUNCTION ! ************************************************************************************************** !> \brief ... @@ -1086,108 +1086,108 @@ FUNCTION dist_second_deriv(r1,i,j,d,rho) RESULT(deriv) !> \param natom ... !> \return ... ! ************************************************************************************************** - FUNCTION angle_second_deriv(r_ij,d_ij,rho_ij,idir,jdir,iat_der,jat_der,natom) RESULT(deriv) + FUNCTION angle_second_deriv(r_ij, d_ij, rho_ij, idir, jdir, iat_der, jat_der, natom) RESULT(deriv) REAL(KIND=dp), DIMENSION(:, :, :) :: r_ij REAL(KIND=dp), DIMENSION(:, :) :: d_ij, rho_ij INTEGER :: idir, jdir, iat_der, jat_der, natom REAL(KIND=dp) :: deriv INTEGER :: i, iat, idr, j, jat, jdr - REAL(KIND=dp) :: d12, d23, d31, D_mat(3,2), denom1, & + REAL(KIND=dp) :: d12, d23, d31, D_mat(3, 2), denom1, & denom2, denom3, ka1, ka2, ka3, rho12, & rho23, rho31, rsst1, rsst2, rsst3 REAL(KIND=dp), DIMENSION(3) :: r12, r23, r31 - deriv=0._dp - IF(iat_der==jat_der)THEN - DO i=1,natom-1 - IF(rho_ij(iat_der,i).LT.0.00001)CYCLE - DO j=i+1,natom - IF(rho_ij(iat_der,j).LT.0.00001)CYCLE - IF(i==iat_der.OR.j==iat_der)CYCLE - IF(iat_der.LT.i.OR.iat_der.GT.j)THEN - r12=r_ij(iat_der,i,:); r23=r_ij(i,j,:); r31=r_ij(j,iat_der,:) - d12=d_ij(iat_der,i); d23=d_ij(i,j); d31=d_ij(j,iat_der) - rho12=rho_ij(iat_der,i); rho23=rho_ij(i,j); rho31=rho_ij(j,iat_der) - ELSE - r12=r_ij(iat_der,j,:); r23=r_ij(j,i,:); r31=r_ij(i,iat_der,:) - d12=d_ij(iat_der,j); d23=d_ij(j,i); d31=d_ij(i,iat_der) - rho12=rho_ij(iat_der,j); rho23=rho_ij(j,i); rho31=rho_ij(i,iat_der) - END IF - ka1=0.15_dp*rho12*rho23; ka2=0.15_dp*rho23*rho31; ka3=0.15_dp*rho31*rho12 - rsst1=DOT_PRODUCT(r12,r23);rsst2=DOT_PRODUCT(r23,r31);rsst3=DOT_PRODUCT(r31,r12) - denom1=1.0_dp-rsst1**2/(d12**2*d23**2); denom2=1.0_dp-rsst2**2/(d23**2*d31**2) - denom3=1.0_dp-rsst3**2/(d31**2*d12**2) - denom1=SIGN(1.0_dp,denom1)*MAX(ABS(denom1),0.01_dp) - denom2=SIGN(1.0_dp,denom2)*MAX(ABS(denom2),0.01_dp) - denom3=SIGN(1.0_dp,denom3)*MAX(ABS(denom3),0.01_dp) - D_mat(1,1)=r23(idir)/(d12*d23)-rsst1*r12(idir)/(d12**3*d23) - D_mat(1,2)=r23(jdir)/(d12*d23)-rsst1*r12(jdir)/(d12**3*d23) - D_mat(2,1)=-r23(idir)/(d23*d31)+rsst2*r31(idir)/(d23*d31**3) - D_mat(2,2)=-r23(jdir)/(d23*d31)+rsst2*r31(jdir)/(d23*d31**3) - D_mat(3,1)=(r31(idir)-r12(idir))/(d31*d12)+rsst3*r31(idir)/(d31**3*d12)-& - rsst3*r12(idir)/(d31*d12**3) - D_mat(3,2)=(r31(jdir)-r12(jdir))/(d31*d12)+rsst3*r31(jdir)/(d31**3*d12)-& - rsst3*r12(jdir)/(d31*d12**3) - IF(ABS(denom1).LE.0.011_dp)D_mat(1,1)=0.0_dp - IF(ABS(denom2).LE.0.011_dp)D_mat(2,1)=0.0_dp - IF(ABS(denom3).LE.0.011_dp)D_mat(3,1)=0.0_dp - deriv=deriv+ka1*D_mat(1,1)*D_mat(1,2)/denom1+& - ka2*D_mat(2,1)*D_mat(2,2)/denom2+& - ka3*D_mat(3,1)*D_mat(3,2)/denom3 - - END DO - END DO - ELSE - DO i=1,natom - IF(i==iat_der.OR.i==jat_der)CYCLE - IF(jat_der.LT.iat_der)THEN - iat=jat_der; jat=iat_der; idr=jdir; jdr=idir - ELSE - iat=iat_der; jat=jat_der; idr=idir; jdr=jdir - END IF - IF(jat.LT.i.OR.iat.GT.i)THEN - r12=r_ij(iat,jat,:); r23=r_ij(jat,i,:); r31=r_ij(i,iat,:) - d12=d_ij(iat,jat); d23=d_ij(jat,i); d31=d_ij(i,iat) - rho12=rho_ij(iat,jat); rho23=rho_ij(jat,i); rho31=rho_ij(i,iat) - ELSE - r12=r_ij(iat,i,:); r23=r_ij(i,jat,:); r31=r_ij(jat,iat,:) - d12=d_ij(iat,i); d23=d_ij(i,jat); d31=d_ij(jat,iat) - rho12=rho_ij(iat,i); rho23=rho_ij(i,jat); rho31=rho_ij(jat,iat) - END IF - ka1=0.15_dp*rho12*rho23; ka2=0.15_dp*rho23*rho31; ka3=0.15_dp*rho31*rho12 - rsst1=DOT_PRODUCT(r12,r23);rsst2=DOT_PRODUCT(r23,r31);rsst3=DOT_PRODUCT(r31,r12) - denom1=1.0_dp-rsst1**2/(d12**2*d23**2); denom2=1.0_dp-rsst2**2/(d23**2*d31**2) - denom3=1.0_dp-rsst3**2/(d31**2*d12**2) - denom1=SIGN(1.0_dp,denom1)*MAX(ABS(denom1),0.01_dp) - denom2=SIGN(1.0_dp,denom2)*MAX(ABS(denom2),0.01_dp) - denom3=SIGN(1.0_dp,denom3)*MAX(ABS(denom3),0.01_dp) - D_mat(1,1)=r23(idr)/(d12*d23)-rsst1*r12(idr)/(d12**3*d23) - D_mat(2,1)=-r23(idr)/(d23*d31)+rsst2*r31(idr)/(d23*d31**3) - D_mat(3,1)=(r31(idr)-r12(idr))/(d31*d12)+rsst3*r31(idr)/(d31**3*d12)-& - rsst3*r12(idr)/(d31*d12**3) - IF(jat.LT.i.OR.iat.GT.i)THEN - D_mat(1,2)=(r12(jdr)-r23(jdr))/(d12*d23)+rsst1*r12(jdr)/(d12**3*d23)-& - rsst1*r23(jdr)/(d12*d23**3) - D_mat(2,2)=r31(jdr)/(d23*d31)-rsst2*r23(jdr)/(d23**3*d31) - D_mat(3,2)=-r31(jdr)/(d31*d12)+rsst3*r12(jdr)/(d31*d12**3) - ELSE - D_mat(1,2)=-r12(jdr)/(d12*d23)+rsst1*r23(jdr)/(d12*d23**3) - D_mat(2,2)=(r23(jdr)-r31(jdr))/(d23*d31)+rsst2*r23(jdr)/(d23**3*d31)-& - rsst2*r31(jdr)/(d23*d31**3) - D_mat(3,2)=r12(jdr)/(d31*d12)-rsst3*r31(jdr)/(d31**3*d12) - END IF - IF(ABS(denom1).LE.0.011_dp)D_mat(1,1)=0.0_dp - IF(ABS(denom2).LE.0.011_dp)D_mat(2,1)=0.0_dp - IF(ABS(denom3).LE.0.011_dp)D_mat(3,1)=0.0_dp - - deriv=deriv+ka1*D_mat(1,1)*D_mat(1,2)/denom1+& - ka2*D_mat(2,1)*D_mat(2,2)/denom2+& - ka3*D_mat(3,1)*D_mat(3,2)/denom3 + deriv = 0._dp + IF (iat_der == jat_der) THEN + DO i = 1, natom - 1 + IF (rho_ij(iat_der, i) .LT. 0.00001) CYCLE + DO j = i + 1, natom + IF (rho_ij(iat_der, j) .LT. 0.00001) CYCLE + IF (i == iat_der .OR. j == iat_der) CYCLE + IF (iat_der .LT. i .OR. iat_der .GT. j) THEN + r12 = r_ij(iat_der, i, :); r23 = r_ij(i, j, :); r31 = r_ij(j, iat_der, :) + d12 = d_ij(iat_der, i); d23 = d_ij(i, j); d31 = d_ij(j, iat_der) + rho12 = rho_ij(iat_der, i); rho23 = rho_ij(i, j); rho31 = rho_ij(j, iat_der) + ELSE + r12 = r_ij(iat_der, j, :); r23 = r_ij(j, i, :); r31 = r_ij(i, iat_der, :) + d12 = d_ij(iat_der, j); d23 = d_ij(j, i); d31 = d_ij(i, iat_der) + rho12 = rho_ij(iat_der, j); rho23 = rho_ij(j, i); rho31 = rho_ij(i, iat_der) + END IF + ka1 = 0.15_dp*rho12*rho23; ka2 = 0.15_dp*rho23*rho31; ka3 = 0.15_dp*rho31*rho12 + rsst1 = DOT_PRODUCT(r12, r23); rsst2 = DOT_PRODUCT(r23, r31); rsst3 = DOT_PRODUCT(r31, r12) + denom1 = 1.0_dp - rsst1**2/(d12**2*d23**2); denom2 = 1.0_dp - rsst2**2/(d23**2*d31**2) + denom3 = 1.0_dp - rsst3**2/(d31**2*d12**2) + denom1 = SIGN(1.0_dp, denom1)*MAX(ABS(denom1), 0.01_dp) + denom2 = SIGN(1.0_dp, denom2)*MAX(ABS(denom2), 0.01_dp) + denom3 = SIGN(1.0_dp, denom3)*MAX(ABS(denom3), 0.01_dp) + D_mat(1, 1) = r23(idir)/(d12*d23) - rsst1*r12(idir)/(d12**3*d23) + D_mat(1, 2) = r23(jdir)/(d12*d23) - rsst1*r12(jdir)/(d12**3*d23) + D_mat(2, 1) = -r23(idir)/(d23*d31) + rsst2*r31(idir)/(d23*d31**3) + D_mat(2, 2) = -r23(jdir)/(d23*d31) + rsst2*r31(jdir)/(d23*d31**3) + D_mat(3, 1) = (r31(idir) - r12(idir))/(d31*d12) + rsst3*r31(idir)/(d31**3*d12) - & + rsst3*r12(idir)/(d31*d12**3) + D_mat(3, 2) = (r31(jdir) - r12(jdir))/(d31*d12) + rsst3*r31(jdir)/(d31**3*d12) - & + rsst3*r12(jdir)/(d31*d12**3) + IF (ABS(denom1) .LE. 0.011_dp) D_mat(1, 1) = 0.0_dp + IF (ABS(denom2) .LE. 0.011_dp) D_mat(2, 1) = 0.0_dp + IF (ABS(denom3) .LE. 0.011_dp) D_mat(3, 1) = 0.0_dp + deriv = deriv + ka1*D_mat(1, 1)*D_mat(1, 2)/denom1 + & + ka2*D_mat(2, 1)*D_mat(2, 2)/denom2 + & + ka3*D_mat(3, 1)*D_mat(3, 2)/denom3 + + END DO + END DO + ELSE + DO i = 1, natom + IF (i == iat_der .OR. i == jat_der) CYCLE + IF (jat_der .LT. iat_der) THEN + iat = jat_der; jat = iat_der; idr = jdir; jdr = idir + ELSE + iat = iat_der; jat = jat_der; idr = idir; jdr = jdir + END IF + IF (jat .LT. i .OR. iat .GT. i) THEN + r12 = r_ij(iat, jat, :); r23 = r_ij(jat, i, :); r31 = r_ij(i, iat, :) + d12 = d_ij(iat, jat); d23 = d_ij(jat, i); d31 = d_ij(i, iat) + rho12 = rho_ij(iat, jat); rho23 = rho_ij(jat, i); rho31 = rho_ij(i, iat) + ELSE + r12 = r_ij(iat, i, :); r23 = r_ij(i, jat, :); r31 = r_ij(jat, iat, :) + d12 = d_ij(iat, i); d23 = d_ij(i, jat); d31 = d_ij(jat, iat) + rho12 = rho_ij(iat, i); rho23 = rho_ij(i, jat); rho31 = rho_ij(jat, iat) + END IF + ka1 = 0.15_dp*rho12*rho23; ka2 = 0.15_dp*rho23*rho31; ka3 = 0.15_dp*rho31*rho12 + rsst1 = DOT_PRODUCT(r12, r23); rsst2 = DOT_PRODUCT(r23, r31); rsst3 = DOT_PRODUCT(r31, r12) + denom1 = 1.0_dp - rsst1**2/(d12**2*d23**2); denom2 = 1.0_dp - rsst2**2/(d23**2*d31**2) + denom3 = 1.0_dp - rsst3**2/(d31**2*d12**2) + denom1 = SIGN(1.0_dp, denom1)*MAX(ABS(denom1), 0.01_dp) + denom2 = SIGN(1.0_dp, denom2)*MAX(ABS(denom2), 0.01_dp) + denom3 = SIGN(1.0_dp, denom3)*MAX(ABS(denom3), 0.01_dp) + D_mat(1, 1) = r23(idr)/(d12*d23) - rsst1*r12(idr)/(d12**3*d23) + D_mat(2, 1) = -r23(idr)/(d23*d31) + rsst2*r31(idr)/(d23*d31**3) + D_mat(3, 1) = (r31(idr) - r12(idr))/(d31*d12) + rsst3*r31(idr)/(d31**3*d12) - & + rsst3*r12(idr)/(d31*d12**3) + IF (jat .LT. i .OR. iat .GT. i) THEN + D_mat(1, 2) = (r12(jdr) - r23(jdr))/(d12*d23) + rsst1*r12(jdr)/(d12**3*d23) - & + rsst1*r23(jdr)/(d12*d23**3) + D_mat(2, 2) = r31(jdr)/(d23*d31) - rsst2*r23(jdr)/(d23**3*d31) + D_mat(3, 2) = -r31(jdr)/(d31*d12) + rsst3*r12(jdr)/(d31*d12**3) + ELSE + D_mat(1, 2) = -r12(jdr)/(d12*d23) + rsst1*r23(jdr)/(d12*d23**3) + D_mat(2, 2) = (r23(jdr) - r31(jdr))/(d23*d31) + rsst2*r23(jdr)/(d23**3*d31) - & + rsst2*r31(jdr)/(d23*d31**3) + D_mat(3, 2) = r12(jdr)/(d31*d12) - rsst3*r31(jdr)/(d31**3*d12) + END IF + IF (ABS(denom1) .LE. 0.011_dp) D_mat(1, 1) = 0.0_dp + IF (ABS(denom2) .LE. 0.011_dp) D_mat(2, 1) = 0.0_dp + IF (ABS(denom3) .LE. 0.011_dp) D_mat(3, 1) = 0.0_dp + + deriv = deriv + ka1*D_mat(1, 1)*D_mat(1, 2)/denom1 + & + ka2*D_mat(2, 1)*D_mat(2, 2)/denom2 + & + ka3*D_mat(3, 1)*D_mat(3, 2)/denom3 END DO END IF - deriv=0.25_dp*deriv + deriv = 0.25_dp*deriv - END FUNCTION angle_second_deriv + END FUNCTION angle_second_deriv END MODULE bfgs_optimizer diff --git a/src/motion/cell_opt_types.F b/src/motion/cell_opt_types.F index 5e2392bc73..09f6a65d12 100644 --- a/src/motion/cell_opt_types.F +++ b/src/motion/cell_opt_types.F @@ -97,7 +97,7 @@ SUBROUTINE cell_opt_env_create(cell_env, force_env, geo_section) ALLOCATE (cell_env) NULLIFY (cell_env%ref_cell, cell, subsys, particles) cell_env%ref_count = 1 - last_cell_opt_env_id = last_cell_opt_env_id+1 + last_cell_opt_env_id = last_cell_opt_env_id + 1 cell_env%id_nr = last_cell_opt_env_id CALL force_env_get(force_env, cell=cell, subsys=subsys) CALL cell_create(cell_env%ref_cell) @@ -183,7 +183,7 @@ SUBROUTINE cell_opt_env_release(cell_env) IF (ASSOCIATED(cell_env)) THEN CPASSERT(cell_env%ref_count > 0) - cell_env%ref_count = cell_env%ref_count-1 + cell_env%ref_count = cell_env%ref_count - 1 IF (cell_env%ref_count == 0) THEN CALL cell_release(cell_env%ref_cell) DEALLOCATE (cell_env) diff --git a/src/motion/cell_opt_utils.F b/src/motion/cell_opt_utils.F index 43386047ac..17f3489f42 100644 --- a/src/motion/cell_opt_utils.F +++ b/src/motion/cell_opt_utils.F @@ -128,7 +128,7 @@ SUBROUTINE gopt_new_logger_create(new_logger, root_section, para_env, project_na input_file_path = TRIM(project_name) lp = LEN_TRIM(input_file_path) i = logger%iter_info%iteration(logger%iter_info%n_rlevel) - input_file_path(lp+1:LEN(input_file_path)) = "-"//TRIM(label)//"-"//ADJUSTL(cp_to_string(i)) + input_file_path(lp + 1:LEN(input_file_path)) = "-"//TRIM(label)//"-"//ADJUSTL(cp_to_string(i)) lp = LEN_TRIM(input_file_path) CALL section_vals_val_set(root_section, "GLOBAL%PROJECT_NAME", c_val=input_file_path(1:lp)) CALL section_vals_val_set(root_section, "GLOBAL%RUN_TYPE", i_val=id_run) @@ -221,7 +221,7 @@ SUBROUTINE read_external_press_tensor(geo_section, cell, pres_ext, mtrx, rot) ind = 0 DO i = 1, 3 DO j = 1, 3 - ind = ind+1 + ind = ind + 1 pres_ext_tens(j, i) = pvals(ind) END DO END DO @@ -229,11 +229,11 @@ SUBROUTINE read_external_press_tensor(geo_section, cell, pres_ext, mtrx, rot) ! of the simulation cell pres_ext_tens = MATMUL(TRANSPOSE(rot), pres_ext_tens) DO i = 1, 3 - pres_ext = pres_ext+pres_ext_tens(i, i) + pres_ext = pres_ext + pres_ext_tens(i, i) ENDDO pres_ext = pres_ext/3.0_dp DO i = 1, 3 - pres_ext_tens(i, i) = pres_ext_tens(i, i)-pres_ext + pres_ext_tens(i, i) = pres_ext_tens(i, i) - pres_ext ENDDO ELSE pres_ext = pvals(1) @@ -294,23 +294,23 @@ SUBROUTINE get_dg_dh(gradient, av_ptens, pres_ext, cell, mtrx, keep_angles, & ! Evaluating the internal pressure pres_int = 0.0_dp DO i = 1, 3 - pres_int = pres_int+ptens(i, i) + pres_int = pres_int + ptens(i, i) ENDDO pres_int = pres_int/3.0_dp - ptens(1, 1) = av_ptens(1, 1)-pres_ext - ptens(2, 2) = av_ptens(2, 2)-pres_ext - ptens(3, 3) = av_ptens(3, 3)-pres_ext + ptens(1, 1) = av_ptens(1, 1) - pres_ext + ptens(2, 2) = av_ptens(2, 2) - pres_ext + ptens(3, 3) = av_ptens(3, 3) - pres_ext pten_hinv_old = cell%deth*MATMUL(cell%h_inv, ptens) correction = MATMUL(mtrx, cell%hmat) - gradient(1) = pten_hinv_old(1, 1)-correction(1, 1) - gradient(2) = pten_hinv_old(2, 1)-correction(2, 1) - gradient(3) = pten_hinv_old(2, 2)-correction(2, 2) - gradient(4) = pten_hinv_old(3, 1)-correction(3, 1) - gradient(5) = pten_hinv_old(3, 2)-correction(3, 2) - gradient(6) = pten_hinv_old(3, 3)-correction(3, 3) + gradient(1) = pten_hinv_old(1, 1) - correction(1, 1) + gradient(2) = pten_hinv_old(2, 1) - correction(2, 1) + gradient(3) = pten_hinv_old(2, 2) - correction(2, 2) + gradient(4) = pten_hinv_old(3, 1) - correction(3, 1) + gradient(5) = pten_hinv_old(3, 2) - correction(3, 2) + gradient(6) = pten_hinv_old(3, 3) - correction(3, 3) CALL apply_cell_constraints(gradient, cell, my_keep_angles, my_keep_symmetry, my_constraint_id) @@ -369,7 +369,7 @@ SUBROUTINE apply_cell_constraints(gradient, cell, keep_angles, keep_symmetry, co cell_sym_orthorhombic) SELECT CASE (cell%symmetry_id) CASE (cell_sym_cubic) - g = (gradient(1)+gradient(3)+gradient(6))/3.0_dp + g = (gradient(1) + gradient(3) + gradient(6))/3.0_dp gradient(1) = g gradient(3) = g gradient(6) = g @@ -378,15 +378,15 @@ SUBROUTINE apply_cell_constraints(gradient, cell, keep_angles, keep_symmetry, co cell_sym_tetragonal_bc) SELECT CASE (cell%symmetry_id) CASE (cell_sym_tetragonal_ab) - g = 0.5_dp*(gradient(1)+gradient(3)) + g = 0.5_dp*(gradient(1) + gradient(3)) gradient(1) = g gradient(3) = g CASE (cell_sym_tetragonal_ac) - g = 0.5_dp*(gradient(1)+gradient(6)) + g = 0.5_dp*(gradient(1) + gradient(6)) gradient(1) = g gradient(6) = g CASE (cell_sym_tetragonal_bc) - g = 0.5_dp*(gradient(3)+gradient(6)) + g = 0.5_dp*(gradient(3) + gradient(6)) gradient(3) = g gradient(6) = g END SELECT @@ -397,24 +397,24 @@ SUBROUTINE apply_cell_constraints(gradient, cell, keep_angles, keep_symmetry, co gradient(4) = 0.0_dp gradient(5) = 0.0_dp CASE (cell_sym_hexagonal) - g = 0.5_dp*(gradient(1)+0.5_dp*(gradient(2)+sqrt3*gradient(3))) + g = 0.5_dp*(gradient(1) + 0.5_dp*(gradient(2) + sqrt3*gradient(3))) gradient(1) = g gradient(2) = 0.5_dp*g gradient(3) = sqrt3*gradient(2) gradient(4) = 0.0_dp gradient(5) = 0.0_dp CASE (cell_sym_rhombohedral) - a = (angle(cell%hmat(:, 3), cell%hmat(:, 2))+ & - angle(cell%hmat(:, 1), cell%hmat(:, 3))+ & + a = (angle(cell%hmat(:, 3), cell%hmat(:, 2)) + & + angle(cell%hmat(:, 1), cell%hmat(:, 3)) + & angle(cell%hmat(:, 1), cell%hmat(:, 2)))/3.0_dp cosa = COS(a) sina = SIN(a) cosah = COS(0.5_dp*a) sinah = SIN(0.5_dp*a) norm = cosa/cosah - norm_c = SQRT(1.0_dp-norm*norm) - g = (gradient(1)+gradient(2)*cosa+gradient(3)*sina+ & - gradient(4)*cosah*norm+gradient(5)*sinah*norm+gradient(6)*norm_c)/3.0_dp + norm_c = SQRT(1.0_dp - norm*norm) + g = (gradient(1) + gradient(2)*cosa + gradient(3)*sina + & + gradient(4)*cosah*norm + gradient(5)*sinah*norm + gradient(6)*norm_c)/3.0_dp gradient(1) = g gradient(2) = g*cosa gradient(3) = g*sina @@ -426,22 +426,22 @@ SUBROUTINE apply_cell_constraints(gradient, cell, keep_angles, keep_symmetry, co gradient(5) = 0.0_dp CASE (cell_sym_monoclinic_gamma_ab) ! Cell symmetry with a=b, alpha=beta=90deg and gammma unequal 90deg - a_length = SQRT(cell%hmat(1, 1)*cell%hmat(1, 1)+ & - cell%hmat(2, 1)*cell%hmat(2, 1)+ & + a_length = SQRT(cell%hmat(1, 1)*cell%hmat(1, 1) + & + cell%hmat(2, 1)*cell%hmat(2, 1) + & cell%hmat(3, 1)*cell%hmat(3, 1)) - b_length = SQRT(cell%hmat(1, 2)*cell%hmat(1, 2)+ & - cell%hmat(2, 2)*cell%hmat(2, 2)+ & + b_length = SQRT(cell%hmat(1, 2)*cell%hmat(1, 2) + & + cell%hmat(2, 2)*cell%hmat(2, 2) + & cell%hmat(3, 2)*cell%hmat(3, 2)) - ab_length = 0.5_dp*(a_length+b_length) + ab_length = 0.5_dp*(a_length + b_length) gamma = angle(cell%hmat(:, 1), cell%hmat(:, 2)) cosgamma = COS(gamma) singamma = SIN(gamma) ! Here, g is the average derivative of the cell vector length ab_length, and deriv_gamma is the derivative of the angle gamma - g = 0.5_dp*(gradient(1)+cosgamma*gradient(2)+singamma*gradient(3)) - deriv_gamma = (gradient(3)*cosgamma-gradient(2)*singamma)/b_length + g = 0.5_dp*(gradient(1) + cosgamma*gradient(2) + singamma*gradient(3)) + deriv_gamma = (gradient(3)*cosgamma - gradient(2)*singamma)/b_length gradient(1) = g - gradient(2) = g*cosgamma-ab_length*singamma*deriv_gamma - gradient(3) = g*singamma+ab_length*cosgamma*deriv_gamma + gradient(2) = g*cosgamma - ab_length*singamma*deriv_gamma + gradient(3) = g*singamma + ab_length*cosgamma*deriv_gamma gradient(4) = 0.0_dp gradient(5) = 0.0_dp CASE (cell_sym_triclinic) diff --git a/src/motion/cg_optimizer.F b/src/motion/cg_optimizer.F index c72e96266e..18ec5f448f 100644 --- a/src/motion/cg_optimizer.F +++ b/src/motion/cg_optimizer.F @@ -164,11 +164,11 @@ RECURSIVE SUBROUTINE cp_cg_main(force_env, x0, gopt_param, output_unit, globenv, ! Main Loop wildcard = " SD" t_now = m_walltime() - t_diff = t_now-t_old + t_diff = t_now - t_old t_old = t_now CALL gopt_f_io_init(gopt_env, output_unit, opt_energy, wildcard, used_time=t_diff, its=iter_nr) eold = opt_energy - DO its = iter_nr+1, maxiter + DO its = iter_nr + 1, maxiter CALL cp_iterate(logger%iter_info, last=(its == maxiter)) CALL section_vals_val_set(gopt_env%geo_section, "STEP_START_VAL", i_val=its) CALL gopt_f_ii(its, output_unit) @@ -184,10 +184,10 @@ RECURSIVE SUBROUTINE cp_cg_main(force_env, x0, gopt_param, output_unit, globenv, ! Some IO and Convergence check t_now = m_walltime() - t_diff = t_now-t_old + t_diff = t_now - t_old t_old = t_now CALL gopt_f_io(gopt_env, force_env, root_section, its, opt_energy, & - output_unit, eold, emin, wildcard, gopt_param, SIZE(x0), x0-xold, xi, conv, & + output_unit, eold, emin, wildcard, gopt_param, SIZE(x0), x0 - xold, xi, conv, & used_time=t_diff) eold = opt_energy emin = MIN(emin, opt_energy) @@ -207,7 +207,7 @@ RECURSIVE SUBROUTINE cp_cg_main(force_env, x0, gopt_param, output_unit, globenv, ! Reset Condition or Steepest Descent Requested ! ABS(DOT_PRODUCT(g, h))/SQRT((DOT_PRODUCT(g, g)*DOT_PRODUCT(h, h))) > res_lim ... IF ((DOT_PRODUCT(g, h)*DOT_PRODUCT(g, h)) > (res_lim*res_lim*DOT_PRODUCT(g, g)*DOT_PRODUCT(h, h)) & - .OR. its+1 <= max_steep_steps) THEN + .OR. its + 1 <= max_steep_steps) THEN ! Steepest Descent wildcard = " SD" h = -xi diff --git a/src/motion/cg_utils.F b/src/motion/cg_utils.F index ca2cf44ab0..9ddb94c7cd 100644 --- a/src/motion/cg_utils.F +++ b/src/motion/cg_utils.F @@ -166,7 +166,7 @@ RECURSIVE SUBROUTINE linmin_2pnt(gopt_env, x0, ls_vec, g, opt_energy, gopt_param dx = norm_ls_vec dx_thrs = gopt_param%cg_ls%max_step - x0 = x0+dx*ls_norm + x0 = x0 + dx*ls_norm ![NB] don't need consistent energies and forces if using only gradient save_consistent_energy_force = gopt_env%require_consistent_energy_force gopt_env%require_consistent_energy_force = .NOT. my_use_only_grad @@ -181,7 +181,7 @@ RECURSIVE SUBROUTINE linmin_2pnt(gopt_env, x0, ls_vec, g, opt_energy, gopt_param ! per x=0; b=norm_grad1 b = norm_grad1 ! per x=dx; a*dx+b=norm_grad2 - a = (norm_grad2-b)/dx + a = (norm_grad2 - b)/dx x_grad_zero = -b/a dx_min = x_grad_zero ELSE @@ -193,8 +193,8 @@ RECURSIVE SUBROUTINE linmin_2pnt(gopt_env, x0, ls_vec, g, opt_energy, gopt_param ! ! - a*dx**2 + c = (opt_energy2-norm_grad2*dx) ! a*dx**2 = c - (opt_energy2-norm_grad2*dx) - a = (c-(opt_energy2-norm_grad2*dx))/dx**2 - b = norm_grad2-2.0_dp*a*dx + a = (c - (opt_energy2 - norm_grad2*dx))/dx**2 + b = norm_grad2 - 2.0_dp*a*dx dx_min = 0.0_dp IF (a /= 0.0_dp) dx_min = -b/(2.0_dp*a) opt_energy = opt_energy2 @@ -203,7 +203,7 @@ RECURSIVE SUBROUTINE linmin_2pnt(gopt_env, x0, ls_vec, g, opt_energy, gopt_param ! In case the solution is larger than the maximum threshold let's assume the maximum allowed ! step length IF (ABS(dx_min) > dx_thrs) dx_min = SIGN(1.0_dp, dx_min)*dx_thrs - x0 = x0+(dx_min-dx)*ls_norm + x0 = x0 + (dx_min - dx)*ls_norm ! Print out LS info IF (output_unit > 0) THEN @@ -264,7 +264,7 @@ SUBROUTINE tslmin_2pnt(gopt_env, dimer_env, x0, tls_vec, opt_energy, gopt_param, dx_thrs = gopt_param%cg_ls%max_step ! If curvature is positive let's make the largest step allowed IF (dimer_env%rot%curvature > 0) dx = dx_thrs - x0 = x0+dx*tls_norm + x0 = x0 + dx*tls_norm CALL cp_eval_at(gopt_env, x0, opt_energy2, master=gopt_env%force_env%para_env%mepos, & final_evaluation=.FALSE., para_env=gopt_env%force_env%para_env) IF (dimer_env%rot%curvature > 0) THEN @@ -273,15 +273,15 @@ SUBROUTINE tslmin_2pnt(gopt_env, dimer_env, x0, tls_vec, opt_energy, gopt_param, dx_min_acc = dx ELSE ! First let's try to interpolate the minimum - dx_min = -opt_energy/(opt_energy2-opt_energy)*dx + dx_min = -opt_energy/(opt_energy2 - opt_energy)*dx ! In case the solution is larger than the maximum threshold let's assume the maximum allowed ! step length dx_min_save = dx_min IF (ABS(dx_min) > dx_thrs) dx_min = SIGN(1.0_dp, dx_min)*dx_thrs dx_min_acc = dx_min - dx_min = dx_min-dx + dx_min = dx_min - dx END IF - x0 = x0+dx_min*tls_norm + x0 = x0 + dx_min*tls_norm ! Print out LS info IF (output_unit > 0) THEN @@ -348,13 +348,13 @@ SUBROUTINE rotmin_2pnt(gopt_env, dimer_env, x0, theta, opt_energy) final_evaluation=.FALSE., para_env=gopt_env%force_env%para_env) curvature1 = dimer_env%rot%curvature - a1 = (curvature0-curvature1+b1*SIN(2.0_dp*angle))/(1.0_dp-COS(2.0_dp*angle)) - a0 = 2.0_dp*(curvature0-a1) + a1 = (curvature0 - curvature1 + b1*SIN(2.0_dp*angle))/(1.0_dp - COS(2.0_dp*angle)) + a0 = 2.0_dp*(curvature0 - a1) angle = 0.5_dp*ATAN(b1/a1) - curvature2 = a0/2.0_dp+a1*COS(2.0_dp*angle)+b1*SIN(2.0_dp*angle) + curvature2 = a0/2.0_dp + a1*COS(2.0_dp*angle) + b1*SIN(2.0_dp*angle) IF (curvature2 > curvature0) THEN - angle = angle+pi/2.0_dp - curvature2 = a0/2.0_dp+a1*COS(2.0_dp*angle)+b1*SIN(2.0_dp*angle) + angle = angle + pi/2.0_dp + curvature2 = a0/2.0_dp + a1*COS(2.0_dp*angle) + b1*SIN(2.0_dp*angle) END IF dimer_env%rot%angle2 = angle dimer_env%rot%curvature = curvature2 @@ -366,12 +366,12 @@ SUBROUTINE rotmin_2pnt(gopt_env, dimer_env, x0, theta, opt_energy) ! minimum of the rotational search (this is for print-out only) ALLOCATE (work(SIZE(dimer_env%nvec))) work = dimer_env%rot%g1 - work = SIN(dimer_env%rot%angle1-dimer_env%rot%angle2)/SIN(dimer_env%rot%angle1)*dimer_env%rot%g1+ & - SIN(dimer_env%rot%angle2)/SIN(dimer_env%rot%angle1)*dimer_env%rot%g1p+ & - (1.0_dp-COS(dimer_env%rot%angle2)-SIN(dimer_env%rot%angle2)*TAN(dimer_env%rot%angle1/2.0_dp))* & + work = SIN(dimer_env%rot%angle1 - dimer_env%rot%angle2)/SIN(dimer_env%rot%angle1)*dimer_env%rot%g1 + & + SIN(dimer_env%rot%angle2)/SIN(dimer_env%rot%angle1)*dimer_env%rot%g1p + & + (1.0_dp - COS(dimer_env%rot%angle2) - SIN(dimer_env%rot%angle2)*TAN(dimer_env%rot%angle1/2.0_dp))* & dimer_env%rot%g0 - work = -2.0_dp*(work-dimer_env%rot%g0) - work = work-DOT_PRODUCT(work, dimer_env%nvec)*dimer_env%nvec + work = -2.0_dp*(work - dimer_env%rot%g0) + work = work - DOT_PRODUCT(work, dimer_env%nvec)*dimer_env%nvec opt_energy = SQRT(DOT_PRODUCT(work, work)) DEALLOCATE (work) END IF @@ -439,23 +439,23 @@ SUBROUTINE linmin_fit(gopt_env, xvec, xi, opt_energy, & odim = SIZE(hist, 1) scale = 0.25_dp loc_iter = 0 - DO WHILE (ABS(hist(odim, 3)) > rms_force*scale .OR. ABS(hist(odim, 1)-hist(odim-1, 1)) > scale*rms_dr) + DO WHILE (ABS(hist(odim, 3)) > rms_force*scale .OR. ABS(hist(odim, 1) - hist(odim - 1, 1)) > scale*rms_dr) CALL external_control(should_stop, "LINFIT", globenv=globenv) IF (should_stop) EXIT ! - loc_iter = loc_iter+1 + loc_iter = loc_iter + 1 fprev = opt_energy xmin = FindMin(hist(:, 1), hist(:, 2), hist(:, 3)) - CALL reallocate(hist, 1, odim+1, 1, 3) - hist(odim+1, 1) = xmin - hist(odim+1, 3) = cg_deval1d(gopt_env, xmin, pcom, xicom, opt_energy) - hist(odim+1, 2) = opt_energy + CALL reallocate(hist, 1, odim + 1, 1, 3) + hist(odim + 1, 1) = xmin + hist(odim + 1, 3) = cg_deval1d(gopt_env, xmin, pcom, xicom, opt_energy) + hist(odim + 1, 2) = opt_energy odim = SIZE(hist, 1) END DO ! xicom = xmin*xicom step = xmin - xvec = xvec+xicom + xvec = xvec + xicom DEALLOCATE (pcom) DEALLOCATE (xicom) DEALLOCATE (hist) @@ -524,7 +524,7 @@ SUBROUTINE linmin_gold(gopt_env, xvec, xi, opt_energy, brent_tol, brent_max_iter xmin, pcom, xicom, output_unit, globenv) xicom = xmin*xicom step = xmin - xvec = xvec+xicom + xvec = xvec + xicom DEALLOCATE (pcom) DEALLOCATE (xicom) CALL timestop(handle) @@ -573,7 +573,7 @@ SUBROUTINE cg_mnbrak(gopt_env, ax, bx, cx, pcom, xicom, brack_limit, output_unit CPASSERT(.NOT. ASSOCIATED(histpoint)) ALLOCATE (histpoint(3, 3)) END IF - gold = (1.0_dp+SQRT(5.0_dp))/2.0_dp + gold = (1.0_dp + SQRT(5.0_dp))/2.0_dp IF (hist) THEN histpoint(1, 1) = ax histpoint(1, 3) = cg_deval1d(gopt_env, ax, pcom, xicom, fa) @@ -593,7 +593,7 @@ SUBROUTINE cg_mnbrak(gopt_env, ax, bx, cx, pcom, xicom, brack_limit, output_unit fb = fa fa = dum ENDIF - cx = bx+gold*(bx-ax) + cx = bx + gold*(bx - ax) IF (hist) THEN histpoint(3, 1) = cx histpoint(3, 3) = cg_deval1d(gopt_env, cx, pcom, xicom, fc) @@ -606,21 +606,21 @@ SUBROUTINE cg_mnbrak(gopt_env, ax, bx, cx, pcom, xicom, brack_limit, output_unit CALL external_control(should_stop, "MNBRACK", globenv=globenv) IF (should_stop) EXIT ! - r = (bx-ax)*(fb-fc) - q = (bx-cx)*(fb-fa) - u = bx-((bx-cx)*q-(bx-ax)*r)/(2.0_dp*SIGN(MAX(ABS(q-r), TINY(0.0_dp)), q-r)) - ulim = bx+brack_limit*(cx-bx) - IF ((bx-u)*(u-cx) .GT. 0.0_dp) THEN + r = (bx - ax)*(fb - fc) + q = (bx - cx)*(fb - fa) + u = bx - ((bx - cx)*q - (bx - ax)*r)/(2.0_dp*SIGN(MAX(ABS(q - r), TINY(0.0_dp)), q - r)) + ulim = bx + brack_limit*(cx - bx) + IF ((bx - u)*(u - cx) .GT. 0.0_dp) THEN IF (hist) THEN odim = SIZE(histpoint, 1) - CALL reallocate(histpoint, 1, odim+1, 1, 3) - histpoint(odim+1, 1) = u - histpoint(odim+1, 3) = cg_deval1d(gopt_env, u, pcom, xicom, fu) - histpoint(odim+1, 2) = fu + CALL reallocate(histpoint, 1, odim + 1, 1, 3) + histpoint(odim + 1, 1) = u + histpoint(odim + 1, 3) = cg_deval1d(gopt_env, u, pcom, xicom, fu) + histpoint(odim + 1, 2) = fu ELSE fu = cg_eval1d(gopt_env, u, pcom, xicom) END IF - loc_iter = loc_iter+1 + loc_iter = loc_iter + 1 IF (fu .LT. fc) THEN ax = bx fa = fb @@ -632,69 +632,69 @@ SUBROUTINE cg_mnbrak(gopt_env, ax, bx, cx, pcom, xicom, brack_limit, output_unit fc = fu EXIT ENDIF - u = cx+gold*(cx-bx) + u = cx + gold*(cx - bx) IF (hist) THEN odim = SIZE(histpoint, 1) - CALL reallocate(histpoint, 1, odim+1, 1, 3) - histpoint(odim+1, 1) = u - histpoint(odim+1, 3) = cg_deval1d(gopt_env, u, pcom, xicom, fu) - histpoint(odim+1, 2) = fu + CALL reallocate(histpoint, 1, odim + 1, 1, 3) + histpoint(odim + 1, 1) = u + histpoint(odim + 1, 3) = cg_deval1d(gopt_env, u, pcom, xicom, fu) + histpoint(odim + 1, 2) = fu ELSE fu = cg_eval1d(gopt_env, u, pcom, xicom) END IF - loc_iter = loc_iter+1 - ELSE IF ((cx-u)*(u-ulim) .GT. 0.) THEN + loc_iter = loc_iter + 1 + ELSE IF ((cx - u)*(u - ulim) .GT. 0.) THEN IF (hist) THEN odim = SIZE(histpoint, 1) - CALL reallocate(histpoint, 1, odim+1, 1, 3) - histpoint(odim+1, 1) = u - histpoint(odim+1, 3) = cg_deval1d(gopt_env, u, pcom, xicom, fu) - histpoint(odim+1, 2) = fu + CALL reallocate(histpoint, 1, odim + 1, 1, 3) + histpoint(odim + 1, 1) = u + histpoint(odim + 1, 3) = cg_deval1d(gopt_env, u, pcom, xicom, fu) + histpoint(odim + 1, 2) = fu ELSE fu = cg_eval1d(gopt_env, u, pcom, xicom) END IF - loc_iter = loc_iter+1 + loc_iter = loc_iter + 1 IF (fu .LT. fc) THEN bx = cx cx = u - u = cx+gold*(cx-bx) + u = cx + gold*(cx - bx) fb = fc fc = fu IF (hist) THEN odim = SIZE(histpoint, 1) - CALL reallocate(histpoint, 1, odim+1, 1, 3) - histpoint(odim+1, 1) = u - histpoint(odim+1, 3) = cg_deval1d(gopt_env, u, pcom, xicom, fu) - histpoint(odim+1, 2) = fu + CALL reallocate(histpoint, 1, odim + 1, 1, 3) + histpoint(odim + 1, 1) = u + histpoint(odim + 1, 3) = cg_deval1d(gopt_env, u, pcom, xicom, fu) + histpoint(odim + 1, 2) = fu ELSE fu = cg_eval1d(gopt_env, u, pcom, xicom) END IF - loc_iter = loc_iter+1 + loc_iter = loc_iter + 1 ENDIF - ELSE IF ((u-ulim)*(ulim-cx) .GE. 0.) THEN + ELSE IF ((u - ulim)*(ulim - cx) .GE. 0.) THEN u = ulim IF (hist) THEN odim = SIZE(histpoint, 1) - CALL reallocate(histpoint, 1, odim+1, 1, 3) - histpoint(odim+1, 1) = u - histpoint(odim+1, 3) = cg_deval1d(gopt_env, u, pcom, xicom, fu) - histpoint(odim+1, 2) = fu + CALL reallocate(histpoint, 1, odim + 1, 1, 3) + histpoint(odim + 1, 1) = u + histpoint(odim + 1, 3) = cg_deval1d(gopt_env, u, pcom, xicom, fu) + histpoint(odim + 1, 2) = fu ELSE fu = cg_eval1d(gopt_env, u, pcom, xicom) END IF - loc_iter = loc_iter+1 + loc_iter = loc_iter + 1 ELSE - u = cx+gold*(cx-bx) + u = cx + gold*(cx - bx) IF (hist) THEN odim = SIZE(histpoint, 1) - CALL reallocate(histpoint, 1, odim+1, 1, 3) - histpoint(odim+1, 1) = u - histpoint(odim+1, 3) = cg_deval1d(gopt_env, u, pcom, xicom, fu) - histpoint(odim+1, 2) = fu + CALL reallocate(histpoint, 1, odim + 1, 1, 3) + histpoint(odim + 1, 1) = u + histpoint(odim + 1, 3) = cg_deval1d(gopt_env, u, pcom, xicom, fu) + histpoint(odim + 1, 2) = fu ELSE fu = cg_eval1d(gopt_env, u, pcom, xicom) END IF - loc_iter = loc_iter+1 + loc_iter = loc_iter + 1 ENDIF ax = bx bx = cx @@ -774,21 +774,21 @@ FUNCTION cg_dbrent(gopt_env, ax, bx, cx, tol, itmax, xmin, pcom, xicom, output_u CALL external_control(should_stop, "BRENT", globenv=globenv) IF (should_stop) EXIT ! - xm = 0.5_dp*(a+b) - tol1 = tol*ABS(x)+zeps + xm = 0.5_dp*(a + b) + tol1 = tol*ABS(x) + zeps tol2 = 2.0_dp*tol1 skip0 = .FALSE. skip1 = .FALSE. - IF (ABS(x-xm) .LE. (tol2-0.5_dp*(b-a))) EXIT + IF (ABS(x - xm) .LE. (tol2 - 0.5_dp*(b - a))) EXIT IF (ABS(e) .GT. tol1) THEN - d1 = 2.0_dp*(b-a) + d1 = 2.0_dp*(b - a) d2 = d1 - IF (dw .NE. dx) d1 = (w-x)*dx/(dx-dw) - IF (dv .NE. dx) d2 = (v-x)*dx/(dx-dv) - u1 = x+d1 - u2 = x+d2 - ok1 = ((a-u1)*(u1-b) .GT. 0.0_dp) .AND. (dx*d1 .LE. 0.0_dp) - ok2 = ((a-u2)*(u2-b) .GT. 0.0_dp) .AND. (dx*d2 .LE. 0.0_dp) + IF (dw .NE. dx) d1 = (w - x)*dx/(dx - dw) + IF (dv .NE. dx) d2 = (v - x)*dx/(dx - dv) + u1 = x + d1 + u2 = x + d2 + ok1 = ((a - u1)*(u1 - b) .GT. 0.0_dp) .AND. (dx*d1 .LE. 0.0_dp) + ok2 = ((a - u2)*(u2 - b) .GT. 0.0_dp) .AND. (dx*d2 .LE. 0.0_dp) olde = e e = d IF (.NOT. (ok1 .OR. ok2)) THEN @@ -807,28 +807,28 @@ FUNCTION cg_dbrent(gopt_env, ax, bx, cx, tol, itmax, xmin, pcom, xicom, output_u IF (.NOT. skip0) THEN IF (ABS(d) .GT. ABS(0.5_dp*olde)) skip0 = .TRUE. IF (.NOT. skip0) THEN - u = x+d - IF ((u-a) .LT. tol2 .OR. (b-u) .LT. tol2) d = SIGN(tol1, xm-x) + u = x + d + IF ((u - a) .LT. tol2 .OR. (b - u) .LT. tol2) d = SIGN(tol1, xm - x) skip1 = .TRUE. END IF END IF ENDIF IF (.NOT. skip1) THEN IF (dx .GE. 0.0_dp) THEN - e = a-x + e = a - x ELSE - e = b-x + e = b - x ENDIF d = 0.5_dp*e END IF IF (ABS(d) .GE. tol1) THEN - u = x+d + u = x + d du = cg_deval1d(gopt_env, u, pcom, xicom, fu) - loc_iter = loc_iter+1 + loc_iter = loc_iter + 1 ELSE - u = x+SIGN(tol1, d) + u = x + SIGN(tol1, d) du = cg_deval1d(gopt_env, u, pcom, xicom, fu) - loc_iter = loc_iter+1 + loc_iter = loc_iter + 1 IF (fu .GT. fx) EXIT ENDIF IF (fu .LE. fx) THEN @@ -859,12 +859,12 @@ FUNCTION cg_dbrent(gopt_env, ax, bx, cx, tol, itmax, xmin, pcom, xicom, output_u WRITE (UNIT=output_unit, FMT="(/,T2,A)") REPEAT("*", 79) WRITE (UNIT=output_unit, FMT="(T2,A,T22,A,I7,T78,A)") & "***", "BRENT - NUMBER OF ENERGY EVALUATIONS : ", loc_iter, "***" - IF (iter == itmax+1) & + IF (iter == itmax + 1) & WRITE (UNIT=output_unit, FMT="(T2,A,T22,A,T78,A)") & "***", "BRENT - NUMBER OF ITERATIONS EXCEEDED ", "***" WRITE (UNIT=output_unit, FMT="(T2,A)") REPEAT("*", 79) END IF - CPASSERT(iter /= itmax+1) + CPASSERT(iter /= itmax + 1) xmin = x dbrent = fx CALL timestop(handle) @@ -897,7 +897,7 @@ FUNCTION cg_eval1d(gopt_env, x, pcom, xicom) RESULT(my_val) CALL timeset(routineN, handle) ALLOCATE (xvec(SIZE(pcom))) - xvec = pcom+x*xicom + xvec = pcom + x*xicom CALL cp_eval_at(gopt_env, xvec, my_val, master=gopt_env%force_env%para_env%mepos, & final_evaluation=.FALSE., para_env=gopt_env%force_env%para_env) DEALLOCATE (xvec) @@ -935,7 +935,7 @@ FUNCTION cg_deval1d(gopt_env, x, pcom, xicom, fval) RESULT(my_val) ALLOCATE (xvec(SIZE(pcom))) ALLOCATE (grad(SIZE(pcom))) - xvec = pcom+x*xicom + xvec = pcom + x*xicom CALL cp_eval_at(gopt_env, xvec, energy, grad, master=gopt_env%force_env%para_env%mepos, & final_evaluation=.FALSE., para_env=gopt_env%force_env%para_env) my_val = DOT_PRODUCT(grad, xicom) @@ -977,26 +977,26 @@ FUNCTION FindMin(x, y, dy) RESULT(res) sum_xx = 0._dp min_pos = 1 DO i = 1, np - sum_xx = sum_xx+x(i)**2 - sum_x = sum_x+x(i) + sum_xx = sum_xx + x(i)**2 + sum_x = sum_x + x(i) IF (y(min_pos) > y(i)) min_pos = i END DO - spread = SQRT(sum_xx/REAL(np, dp)-(sum_x/REAL(np, dp))**2) + spread = SQRT(sum_xx/REAL(np, dp) - (sum_x/REAL(np, dp))**2) DO i = 1, np - w(i) = EXP(-(REAL(np-i, dp))**2/(REAL(2*9, dp))) - w(i+np) = 2._dp*w(i) + w(i) = EXP(-(REAL(np - i, dp))**2/(REAL(2*9, dp))) + w(i + np) = 2._dp*w(i) END DO DO i = 1, np f(i, 1) = w(i) f(i, 2) = x(i)*w(i) f(i, 3) = x(i)**2*w(i) - f(i+np, 1) = 0 - f(i+np, 2) = w(i+np) - f(i+np, 3) = 2*x(i)*w(i+np) + f(i + np, 1) = 0 + f(i + np, 2) = w(i + np) + f(i + np, 3) = 2*x(i)*w(i + np) END DO DO i = 1, np b(i) = y(i)*w(i) - b(i+np) = dy(i)*w(i+np) + b(i + np) = dy(i)*w(i + np) END DO lwork = -1 CALL dgesdd('S', SIZE(f, 1), SIZE(f, 2), f, SIZE(f, 1), diag, u, SIZE(u, 1), vt, SIZE(vt, 1), tmpw, lwork, & @@ -1047,17 +1047,17 @@ SUBROUTINE get_conjugate_direction(gopt_env, Fletcher_Reeves, g, xi, h) IF (Fletcher_Reeves) THEN dgg = DOT_PRODUCT(xi, xi) ELSE - dgg = DOT_PRODUCT((xi+g), xi) + dgg = DOT_PRODUCT((xi + g), xi) END IF gam = dgg/gg g = h - h = -xi+gam*h + h = -xi + gam*h ELSE dimer_env => gopt_env%dimer_env - check = ABS(DOT_PRODUCT(g, g)-1.0_dp) < MAX(1.0E-9_dp, dimer_thrs) + check = ABS(DOT_PRODUCT(g, g) - 1.0_dp) < MAX(1.0E-9_dp, dimer_thrs) CPASSERT(check) - check = ABS(DOT_PRODUCT(xi, xi)-1.0_dp) < MAX(1.0E-9_dp, dimer_thrs) + check = ABS(DOT_PRODUCT(xi, xi) - 1.0_dp) < MAX(1.0E-9_dp, dimer_thrs) CPASSERT(check) check = ABS(DOT_PRODUCT(h, dimer_env%cg_rot%nvec_old)) < MAX(1.0E-9_dp, dimer_thrs) @@ -1067,14 +1067,14 @@ SUBROUTINE get_conjugate_direction(gopt_env, Fletcher_Reeves, g, xi, h) dgg = dimer_env%cg_rot%norm_theta**2 ELSE norm = dimer_env%cg_rot%norm_theta*dimer_env%cg_rot%norm_theta_old - dgg = dimer_env%cg_rot%norm_theta**2+DOT_PRODUCT(g, xi)*norm + dgg = dimer_env%cg_rot%norm_theta**2 + DOT_PRODUCT(g, xi)*norm END IF ! Compute Theta** and store it in nvec_old - CALL rotate_dimer(dimer_env%cg_rot%nvec_old, g, dimer_env%rot%angle2+pi/2.0_dp) + CALL rotate_dimer(dimer_env%cg_rot%nvec_old, g, dimer_env%rot%angle2 + pi/2.0_dp) gam = dgg/gg g = h - h = -xi*dimer_env%cg_rot%norm_theta+gam*dimer_env%cg_rot%norm_h*dimer_env%cg_rot%nvec_old - h = h-DOT_PRODUCT(h, dimer_env%nvec)*dimer_env%nvec + h = -xi*dimer_env%cg_rot%norm_theta + gam*dimer_env%cg_rot%norm_h*dimer_env%cg_rot%nvec_old + h = h - DOT_PRODUCT(h, dimer_env%nvec)*dimer_env%nvec norm_h = SQRT(DOT_PRODUCT(h, h)) IF (norm_h < EPSILON(0.0_dp)) THEN h = 0.0_dp diff --git a/src/motion/cp_lbfgs.F b/src/motion/cp_lbfgs.F index 227029ee12..2e6cffd611 100644 --- a/src/motion/cp_lbfgs.F +++ b/src/motion/cp_lbfgs.F @@ -21,13 +21,13 @@ MODULE cp_lbfgs USE machine, ONLY: m_walltime #include "../base/base_uses.f90" - IMPLICIT NONE + IMPLICIT NONE - PRIVATE + PRIVATE CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_lbfgs' - PUBLIC :: setulb + PUBLIC :: setulb CONTAINS @@ -171,8 +171,8 @@ MODULE cp_lbfgs !> Ciyou Zhu !> in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal. ! ************************************************************************************************** - SUBROUTINE setulb(n, m, x, lower_bound, upper_bound, nbd, f, g, factr, pgtol, wa, iwa,& - task, iprint, csave, lsave, isave, dsave, trust_radius) + SUBROUTINE setulb(n, m, x, lower_bound, upper_bound, nbd, f, g, factr, pgtol, wa, iwa, & + task, iprint, csave, lsave, isave, dsave, trust_radius) INTEGER, INTENT(in) :: n, m REAL(KIND=dp), INTENT(inout) :: x(n) @@ -211,72 +211,72 @@ SUBROUTINE setulb(n, m, x, lower_bound, upper_bound, nbd, f, g, factr, pgtol, wa IF (task == 'START') THEN CALL cite_reference(Byrd1995) - isave(1) = m*n - isave(2) = m**2 - isave(3) = 4*m**2 - ! ws m*n - isave(4) = 1 - ! wy m*n - isave(5) = isave(4) + isave(1) - ! wsy m**2 - isave(6) = isave(5) + isave(1) - ! wss m**2 - isave(7) = isave(6) + isave(2) - ! wt m**2 - isave(8) = isave(7) + isave(2) - ! wn 4*m**2 - isave(9) = isave(8) + isave(2) - ! wsnd 4*m**2 - isave(10) = isave(9) + isave(3) - ! wz n + isave(1) = m*n + isave(2) = m**2 + isave(3) = 4*m**2 + ! ws m*n + isave(4) = 1 + ! wy m*n + isave(5) = isave(4) + isave(1) + ! wsy m**2 + isave(6) = isave(5) + isave(1) + ! wss m**2 + isave(7) = isave(6) + isave(2) + ! wt m**2 + isave(8) = isave(7) + isave(2) + ! wn 4*m**2 + isave(9) = isave(8) + isave(2) + ! wsnd 4*m**2 + isave(10) = isave(9) + isave(3) + ! wz n isave(11) = isave(10) + isave(3) - ! wr n + ! wr n isave(12) = isave(11) + n - ! wd n + ! wd n isave(13) = isave(12) + n - ! wt n + ! wt n isave(14) = isave(13) + n - ! wxp n + ! wxp n isave(15) = isave(14) + n - ! wa 8*m + ! wa 8*m isave(16) = isave(15) + n END IF - lws = isave(4) - lwy = isave(5) - lsy = isave(6) - lss = isave(7) - lwt = isave(8) - lwn = isave(9) + lws = isave(4) + lwy = isave(5) + lsy = isave(6) + lss = isave(7) + lwt = isave(8) + lwn = isave(9) lsnd = isave(10) - lz = isave(11) - lr = isave(12) - ld = isave(13) - lt = isave(14) - lxp = isave(15) - lwa = isave(16) + lz = isave(11) + lr = isave(12) + ld = isave(13) + lt = isave(14) + lxp = isave(15) + lwa = isave(16) !in case we use a trust radius we set the boundaries to be one times the trust radius away from the current positions !the original implementation only allowed for boundaries that remain constant during the optimization. !This way of including a trust radius seems to work, !but the change of the boundaries during optimization might introduce some not yet discovered problems. - IF(trust_radius>=0) THEN - DO i=1,n - lower_bound(i)=x(i)-trust_radius - upper_bound(i)=x(i)+trust_radius - nbd(i)=2 - END DO + IF (trust_radius >= 0) THEN + DO i = 1, n + lower_bound(i) = x(i) - trust_radius + upper_bound(i) = x(i) + trust_radius + nbd(i) = 2 + END DO ENDIF - CALL mainlb(n,m,x,lower_bound,upper_bound,nbd,f,g,factr,pgtol, & - wa(lws),wa(lwy),wa(lsy),wa(lss), wa(lwt), & - wa(lwn),wa(lsnd),wa(lz),wa(lr),wa(ld),wa(lt),wa(lxp), & - wa(lwa), & - iwa(1),iwa(n+1),iwa(2*n+1),task,iprint, & - csave,lsave,isave(22),dsave) + CALL mainlb(n, m, x, lower_bound, upper_bound, nbd, f, g, factr, pgtol, & + wa(lws), wa(lwy), wa(lsy), wa(lss), wa(lwt), & + wa(lwn), wa(lsnd), wa(lz), wa(lr), wa(ld), wa(lt), wa(lxp), & + wa(lwa), & + iwa(1), iwa(n + 1), iwa(2*n + 1), task, iprint, & + csave, lsave, isave(22), dsave) RETURN - END SUBROUTINE setulb + END SUBROUTINE setulb ! ************************************************************************************************** !> \brief This subroutine solves bound constrained optimization problems by @@ -311,7 +311,7 @@ END SUBROUTINE setulb !> max{|proj g_i | i = 1, ..., n} <= pgtol !> !> where pg_i is the ith component of the projected gradient. -!> \param ws ws, wy, sy, and wt are working arrays used to store the following +!> \param ws ws, wy, sy, and wt are working arrays used to store the following !> information defining the limited memory BFGS matrix: !> ws stores S, the matrix of s-vectors; !> \param wy stores Y, the matrix of y-vectors; @@ -373,10 +373,10 @@ END SUBROUTINE setulb !> Ciyou Zhu !> in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal. ! ************************************************************************************************** - SUBROUTINE mainlb(n, m, x, lower_bound, upper_bound, nbd, f, g, factr, pgtol, ws, wy, & - sy, ss, wt, wn, snd, z, r, d, t, xp, wa, & - index, iwhere, indx2, task, & - iprint, csave, lsave, isave, dsave) + SUBROUTINE mainlb(n, m, x, lower_bound, upper_bound, nbd, f, g, factr, pgtol, ws, wy, & + sy, ss, wt, wn, snd, z, r, d, t, xp, wa, & + index, iwhere, indx2, task, & + iprint, csave, lsave, isave, dsave) INTEGER, INTENT(in) :: n, m REAL(KIND=dp), INTENT(inout) :: x(n) REAL(KIND=dp), INTENT(in) :: lower_bound(n), upper_bound(n) @@ -432,35 +432,35 @@ SUBROUTINE mainlb(n, m, x, lower_bound, upper_bound, nbd, f, g, factr, pgtol, ws ! Initialize counters and scalars when task='START'. ! for the limited memory BFGS matrices: - col = 0 - head = 1 - theta = one + col = 0 + head = 1 + theta = one iupdat = 0 updatd = .FALSE. - iback = 0 - itail = 0 - iword = 0 - nact = 0 + iback = 0 + itail = 0 + iword = 0 + nact = 0 ileave = 0 nenter = 0 - fold = zero - dnorm = zero - cpu1 = zero - gd = zero - step_max = zero + fold = zero + dnorm = zero + cpu1 = zero + gd = zero + step_max = zero g_inf_norm = zero - stp = zero - gdold = zero - dtd = zero + stp = zero + gdold = zero + dtd = zero ! for operation counts: - iter = 0 - nfgv = 0 - nseg = 0 + iter = 0 + nfgv = 0 + nseg = 0 nintol = 0 - nskip = 0 - nfree = n - ifun = 0 + nskip = 0 + nfree = n + ifun = 0 ! for stopping tolerance: tol = factr*epsmch @@ -478,76 +478,76 @@ SUBROUTINE mainlb(n, m, x, lower_bound, upper_bound, nbd, f, g, factr, pgtol, ws itfile = 8 IF (iprint >= 1) THEN ! open a summary file 'iterate.dat' - CALL open_file(file_name='iterate.dat',unit_number=itfile,file_action='WRITE',file_status='UNKNOWN') + CALL open_file(file_name='iterate.dat', unit_number=itfile, file_action='WRITE', file_status='UNKNOWN') END IF ! Check the input arguments for errors. - CALL errclb(n,m,factr,lower_bound,upper_bound,nbd,task,info,k) + CALL errclb(n, m, factr, lower_bound, upper_bound, nbd, task, info, k) IF (task(1:5) == 'ERROR') THEN - CALL prn3lb(n,x,f,task,iprint,info,itfile, & - iter,nfgv,nintol,nskip,nact,g_inf_norm, & - zero,nseg,word,iback,stp,xstep,k, & - cachyt,sbtime,lnscht) + CALL prn3lb(n, x, f, task, iprint, info, itfile, & + iter, nfgv, nintol, nskip, nact, g_inf_norm, & + zero, nseg, word, iback, stp, xstep, k, & + cachyt, sbtime, lnscht) RETURN END IF - CALL prn1lb(n,m,lower_bound,upper_bound,x,iprint,itfile,epsmch) + CALL prn1lb(n, m, lower_bound, upper_bound, x, iprint, itfile, epsmch) ! Initialize iwhere & project x onto the feasible set. - CALL active(n,lower_bound,upper_bound,nbd,x,iwhere,iprint,x_projected,constrained,boxed) + CALL active(n, lower_bound, upper_bound, nbd, x, iwhere, iprint, x_projected, constrained, boxed) ! The end of the initialization. task = 'FG_START' ! return to the driver to calculate f and g; reenter at 111. - CALL save_local(lsave,isave,dsave,x_projected,constrained,boxed,updatd,nintol,itfile,iback,nskip,head,col,itail,& - iter,iupdat,nseg,nfgv,info,ifun,iword,nfree,nact,ileave,nenter,theta,fold,tol,dnorm,epsmch,& - cpu1,cachyt,sbtime,lnscht,time1,gd,step_max,g_inf_norm,stp,gdold,dtd) + CALL save_local(lsave, isave, dsave, x_projected, constrained, boxed, updatd, nintol, itfile, iback, nskip, head, col, itail, & + iter, iupdat, nseg, nfgv, info, ifun, iword, nfree, nact, ileave, nenter, theta, fold, tol, dnorm, epsmch, & + cpu1, cachyt, sbtime, lnscht, time1, gd, step_max, g_inf_norm, stp, gdold, dtd) RETURN ELSE ! restore local variables. x_projected = lsave(1) constrained = lsave(2) - boxed = lsave(3) + boxed = lsave(3) updatd = lsave(4) nintol = isave(1) itfile = isave(3) - iback = isave(4) - nskip = isave(5) - head = isave(6) - col = isave(7) - itail = isave(8) - iter = isave(9) + iback = isave(4) + nskip = isave(5) + head = isave(6) + col = isave(7) + itail = isave(8) + iter = isave(9) iupdat = isave(10) - nseg = isave(12) - nfgv = isave(13) - info = isave(14) - ifun = isave(15) - iword = isave(16) - nfree = isave(17) - nact = isave(18) + nseg = isave(12) + nfgv = isave(13) + info = isave(14) + ifun = isave(15) + iword = isave(16) + nfree = isave(17) + nact = isave(18) ileave = isave(19) nenter = isave(20) - theta = dsave(1) - fold = dsave(2) - tol = dsave(3) - dnorm = dsave(4) + theta = dsave(1) + fold = dsave(2) + tol = dsave(3) + dnorm = dsave(4) epsmch = dsave(5) - cpu1 = dsave(6) + cpu1 = dsave(6) cachyt = dsave(7) sbtime = dsave(8) lnscht = dsave(9) - time1 = dsave(10) - gd = dsave(11) - step_max = dsave(12) + time1 = dsave(10) + gd = dsave(11) + step_max = dsave(12) g_inf_norm = dsave(13) - stp = dsave(14) - gdold = dsave(15) - dtd = dsave(16) + stp = dsave(14) + gdold = dsave(15) + dtd = dsave(16) ! After returning from the driver go to the point where execution ! is to resume. @@ -555,64 +555,64 @@ SUBROUTINE mainlb(n, m, x, lower_bound, upper_bound, nbd, f, g, factr, pgtol, ws IF (task(1:4) == 'STOP') THEN IF (task(7:9) == 'CPU') THEN ! restore the previous iterate. - CALL dcopy(n,t,1,x,1) - CALL dcopy(n,r,1,g,1) + CALL dcopy(n, t, 1, x, 1) + CALL dcopy(n, r, 1, g, 1) f = fold END IF CALL timer(time2) time = time2 - time1 - CALL prn3lb(n,x,f,task,iprint,info,itfile, & - iter,nfgv,nintol,nskip,nact,g_inf_norm, & - time,nseg,word,iback,stp,xstep,k, & - cachyt,sbtime,lnscht) - CALL save_local(lsave,isave,dsave,x_projected,constrained,boxed,updatd,nintol,itfile,iback,nskip,head,col,itail,& - iter,iupdat,nseg,nfgv,info,ifun,iword,nfree,nact,ileave,nenter,theta,fold,tol,dnorm,epsmch,& - cpu1,cachyt,sbtime,lnscht,time1,gd,step_max,g_inf_norm,stp,gdold,dtd) + CALL prn3lb(n, x, f, task, iprint, info, itfile, & + iter, nfgv, nintol, nskip, nact, g_inf_norm, & + time, nseg, word, iback, stp, xstep, k, & + cachyt, sbtime, lnscht) + CALL save_local(lsave, isave, dsave, x_projected, constrained, boxed, updatd, nintol, itfile, iback, nskip, head, col, itail, & + iter, iupdat, nseg, nfgv, info, ifun, iword, nfree, nact, ileave, nenter, theta, fold, tol, dnorm, epsmch, & + cpu1, cachyt, sbtime, lnscht, time1, gd, step_max, g_inf_norm, stp, gdold, dtd) RETURN END IF END IF - IF(.NOT.(task(1:5) == 'FG_LN'.OR.task(1:5) == 'NEW_X')) THEN + IF (.NOT. (task(1:5) == 'FG_LN' .OR. task(1:5) == 'NEW_X')) THEN ! Compute f0 and g0. - nfgv = 1 + nfgv = 1 ! Compute the infinity norm of the (-) projected gradient. - CALL projgr(n,lower_bound,upper_bound,nbd,x,g,g_inf_norm) + CALL projgr(n, lower_bound, upper_bound, nbd, x, g, g_inf_norm) - IF (iprint >= 1) THEN - WRITE (*,1002) iter,f,g_inf_norm - WRITE (itfile,1003) iter,nfgv,g_inf_norm,f - END IF - IF (g_inf_norm <= pgtol) THEN + IF (iprint >= 1) THEN + WRITE (*, 1002) iter, f, g_inf_norm + WRITE (itfile, 1003) iter, nfgv, g_inf_norm, f + END IF + IF (g_inf_norm <= pgtol) THEN ! terminate the algorithm. - task = 'CONVERGENCE: NORM_OF_PROJECTED_GRADIENT_<=_PGTOL' - CALL timer(time2) - time = time2 - time1 - CALL prn3lb(n,x,f,task,iprint,info,itfile, & - iter,nfgv,nintol,nskip,nact,g_inf_norm, & - time,nseg,word,iback,stp,xstep,k, & - cachyt,sbtime,lnscht) - CALL save_local(lsave,isave,dsave,x_projected,constrained,boxed,updatd,nintol,itfile,iback,nskip,head,col,itail,& - iter,iupdat,nseg,nfgv,info,ifun,iword,nfree,nact,ileave,nenter,theta,fold,tol,dnorm,epsmch,& - cpu1,cachyt,sbtime,lnscht,time1,gd,step_max,g_inf_norm,stp,gdold,dtd) - RETURN - END IF + task = 'CONVERGENCE: NORM_OF_PROJECTED_GRADIENT_<=_PGTOL' + CALL timer(time2) + time = time2 - time1 + CALL prn3lb(n, x, f, task, iprint, info, itfile, & + iter, nfgv, nintol, nskip, nact, g_inf_norm, & + time, nseg, word, iback, stp, xstep, k, & + cachyt, sbtime, lnscht) + CALL save_local(lsave, isave, dsave, x_projected, constrained, boxed, updatd, nintol, itfile, iback, nskip, head, col, itail, & + iter, iupdat, nseg, nfgv, info, ifun, iword, nfree, nact, ileave, nenter, theta, fold, tol, dnorm, epsmch, & + cpu1, cachyt, sbtime, lnscht, time1, gd, step_max, g_inf_norm, stp, gdold, dtd) + RETURN + END IF END IF - first=.TRUE. - DO WHILE(.TRUE.) - IF(.NOT.first.OR..NOT.(task(1:5) == 'FG_LN'.OR.task(1:5) == 'NEW_X')) THEN - IF (iprint >= 99) WRITE (*,1001) iter + 1 - iword = -1 + first = .TRUE. + DO WHILE (.TRUE.) + IF (.NOT. first .OR. .NOT. (task(1:5) == 'FG_LN' .OR. task(1:5) == 'NEW_X')) THEN + IF (iprint >= 99) WRITE (*, 1001) iter + 1 + iword = -1 ! - IF (.NOT. constrained .AND. col > 0) THEN + IF (.NOT. constrained .AND. col > 0) THEN ! skip the search for GCP. - CALL dcopy(n,x,1,z,1) - wrk = updatd - nseg = 0 - ELSE + CALL dcopy(n, x, 1, z, 1) + wrk = updatd + nseg = 0 + ELSE !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ! @@ -620,42 +620,42 @@ SUBROUTINE mainlb(n, m, x, lower_bound, upper_bound, nbd, f, g, factr, pgtol, ws ! !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - CALL timer(cpu1) - CALL cauchy(n,x,lower_bound,upper_bound,nbd,g,indx2,iwhere,t,d,z, & - m,wy,ws,sy,wt,theta,col,head, & - wa(1),wa(2*m+1),wa(4*m+1),wa(6*m+1),nseg, & - iprint, g_inf_norm, info, epsmch) - IF (info /= 0) THEN + CALL timer(cpu1) + CALL cauchy(n, x, lower_bound, upper_bound, nbd, g, indx2, iwhere, t, d, z, & + m, wy, ws, sy, wt, theta, col, head, & + wa(1), wa(2*m + 1), wa(4*m + 1), wa(6*m + 1), nseg, & + iprint, g_inf_norm, info, epsmch) + IF (info /= 0) THEN ! singular triangular system detected; refresh the lbfgs memory. - IF(iprint >= 1) WRITE (*, 1005) - info = 0 - col = 0 - head = 1 - theta = one - iupdat = 0 - updatd = .FALSE. + IF (iprint >= 1) WRITE (*, 1005) + info = 0 + col = 0 + head = 1 + theta = one + iupdat = 0 + updatd = .FALSE. + CALL timer(cpu2) + cachyt = cachyt + cpu2 - cpu1 + first = .FALSE. + CYCLE + END IF CALL timer(cpu2) cachyt = cachyt + cpu2 - cpu1 - first=.FALSE. - CYCLE - END IF - CALL timer(cpu2) - cachyt = cachyt + cpu2 - cpu1 - nintol = nintol + nseg + nintol = nintol + nseg ! Count the entering and leaving variables for iter > 0; ! find the index set of free and active variables at the GCP. - CALL freev(n,nfree,index,nenter,ileave,indx2, & - iwhere,wrk,updatd,constrained,iprint,iter) - nact = n - nfree + CALL freev(n, nfree, index, nenter, ileave, indx2, & + iwhere, wrk, updatd, constrained, iprint, iter) + nact = n - nfree - ENDIF + ENDIF ! If there are no free variables or B=theta*I, then ! skip the subspace minimization. - IF (.NOT.(nfree == 0 .OR. col == 0)) THEN + IF (.NOT. (nfree == 0 .OR. col == 0)) THEN !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ! @@ -663,7 +663,7 @@ SUBROUTINE mainlb(n, m, x, lower_bound, upper_bound, nbd, f, g, factr, pgtol, ws ! !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - CALL timer(cpu1) + CALL timer(cpu1) ! Form the LEL^T factorization of the indefinite ! matrix K = [-D -Y'ZZ'Y/theta L_a'-R_z' ] @@ -671,54 +671,54 @@ SUBROUTINE mainlb(n, m, x, lower_bound, upper_bound, nbd, f, g, factr, pgtol, ws ! where E = [-I 0] ! [ 0 I] - IF (wrk) CALL formk(n,nfree,index,nenter,ileave,indx2,iupdat, & - updatd,wn,snd,m,ws,wy,sy,theta,col,head,info) - IF (info /= 0) THEN + IF (wrk) CALL formk(n, nfree, index, nenter, ileave, indx2, iupdat, & + updatd, wn, snd, m, ws, wy, sy, theta, col, head, info) + IF (info /= 0) THEN ! nonpositive definiteness in Cholesky factorization; ! refresh the lbfgs memory and restart the iteration. - IF(iprint >= 1) WRITE (*, 1006) - info = 0 - col = 0 - head = 1 - theta = one - iupdat = 0 - updatd = .FALSE. - CALL timer(cpu2) - sbtime = sbtime + cpu2 - cpu1 - first=.FALSE. - CYCLE - END IF + IF (iprint >= 1) WRITE (*, 1006) + info = 0 + col = 0 + head = 1 + theta = one + iupdat = 0 + updatd = .FALSE. + CALL timer(cpu2) + sbtime = sbtime + cpu2 - cpu1 + first = .FALSE. + CYCLE + END IF ! compute r=-Z'B(xcp-xk)-Z'g (using wa(2m+1)=W'(xcp-x) ! from 'cauchy'). - CALL cmprlb(n,m,x,g,ws,wy,sy,wt,z,r,wa,index, & - theta,col,head,nfree,constrained,info) - IF (info == 0) THEN + CALL cmprlb(n, m, x, g, ws, wy, sy, wt, z, r, wa, index, & + theta, col, head, nfree, constrained, info) + IF (info == 0) THEN ! call the direct method. - CALL subsm( n, m, nfree, index, lower_bound, upper_bound, nbd, z, r, xp, ws, wy, & - theta, x, g, col, head, iword, wa, wn, iprint, info) - END IF - IF (info /= 0) THEN + CALL subsm(n, m, nfree, index, lower_bound, upper_bound, nbd, z, r, xp, ws, wy, & + theta, x, g, col, head, iword, wa, wn, iprint, info) + END IF + IF (info /= 0) THEN ! singular triangular system detected; ! refresh the lbfgs memory and restart the iteration. - IF(iprint >= 1) WRITE (*, 1005) - info = 0 - col = 0 - head = 1 - theta = one - iupdat = 0 - updatd = .FALSE. - CALL timer(cpu2) - sbtime = sbtime + cpu2 - cpu1 - first=.FALSE. - CYCLE - END IF + IF (iprint >= 1) WRITE (*, 1005) + info = 0 + col = 0 + head = 1 + theta = one + iupdat = 0 + updatd = .FALSE. + CALL timer(cpu2) + sbtime = sbtime + cpu2 - cpu1 + first = .FALSE. + CYCLE + END IF - CALL timer(cpu2) - sbtime = sbtime + cpu2 - cpu1 - END IF + CALL timer(cpu2) + sbtime = sbtime + cpu2 - cpu1 + END IF !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ! @@ -728,82 +728,82 @@ SUBROUTINE mainlb(n, m, x, lower_bound, upper_bound, nbd, f, g, factr, pgtol, ws ! Generate the search direction d:=z-x. - DO i = 1, n - d(i) = z(i) - x(i) - END DO - CALL timer(cpu1) + DO i = 1, n + d(i) = z(i) - x(i) + END DO + CALL timer(cpu1) ENDIF - IF(.NOT.first.OR..NOT.(task(1:5) == 'NEW_X')) THEN - CALL lnsrlb(n,lower_bound,upper_bound,nbd,x,f,fold,gd,gdold,g,d,r,t,z,stp,dnorm, & - dtd,xstep,step_max,iter,ifun,iback,nfgv,info,task, & - boxed,constrained,csave,isave(22),dsave(17)) - IF (info /= 0 .OR. iback >= 20) THEN + IF (.NOT. first .OR. .NOT. (task(1:5) == 'NEW_X')) THEN + CALL lnsrlb(n, lower_bound, upper_bound, nbd, x, f, fold, gd, gdold, g, d, r, t, z, stp, dnorm, & + dtd, xstep, step_max, iter, ifun, iback, nfgv, info, task, & + boxed, constrained, csave, isave(22), dsave(17)) + IF (info /= 0 .OR. iback >= 20) THEN ! restore the previous iterate. - CALL dcopy(n,t,1,x,1) - CALL dcopy(n,r,1,g,1) - f = fold - IF (col == 0) THEN + CALL dcopy(n, t, 1, x, 1) + CALL dcopy(n, r, 1, g, 1) + f = fold + IF (col == 0) THEN ! abnormal termination. - IF (info == 0) THEN - info = -9 + IF (info == 0) THEN + info = -9 ! restore the actual number of f and g evaluations etc. - nfgv = nfgv - 1 - ifun = ifun - 1 - iback = iback - 1 + nfgv = nfgv - 1 + ifun = ifun - 1 + iback = iback - 1 + END IF + task = 'ABNORMAL_TERMINATION_IN_LNSRCH' + iter = iter + 1 + CALL timer(time2) + time = time2 - time1 + CALL prn3lb(n, x, f, task, iprint, info, itfile, & + iter, nfgv, nintol, nskip, nact, g_inf_norm, & + time, nseg, word, iback, stp, xstep, k, & + cachyt, sbtime, lnscht) + CALL save_local(lsave, isave, dsave, x_projected, constrained, boxed, updatd, nintol, itfile, iback, nskip, head, col, itail, & + iter, iupdat, nseg, nfgv, info, ifun, iword, nfree, nact, ileave, nenter, theta, fold, tol, dnorm, epsmch, & + cpu1, cachyt, sbtime, lnscht, time1, gd, step_max, g_inf_norm, stp, gdold, dtd) + RETURN + ELSE +! refresh the lbfgs memory and restart the iteration. + IF (iprint >= 1) WRITE (*, 1008) + IF (info == 0) nfgv = nfgv - 1 + info = 0 + col = 0 + head = 1 + theta = one + iupdat = 0 + updatd = .FALSE. + task = 'RESTART_FROM_LNSRCH' + CALL timer(cpu2) + lnscht = lnscht + cpu2 - cpu1 + first = .FALSE. + CYCLE END IF - task = 'ABNORMAL_TERMINATION_IN_LNSRCH' - iter = iter + 1 - CALL timer(time2) - time = time2 - time1 - CALL prn3lb(n,x,f,task,iprint,info,itfile, & - iter,nfgv,nintol,nskip,nact,g_inf_norm, & - time,nseg,word,iback,stp,xstep,k, & - cachyt,sbtime,lnscht) - CALL save_local(lsave,isave,dsave,x_projected,constrained,boxed,updatd,nintol,itfile,iback,nskip,head,col,itail,& - iter,iupdat,nseg,nfgv,info,ifun,iword,nfree,nact,ileave,nenter,theta,fold,tol,dnorm,epsmch,& - cpu1,cachyt,sbtime,lnscht,time1,gd,step_max,g_inf_norm,stp,gdold,dtd) + ELSE IF (task(1:5) == 'FG_LN') THEN +! return to the driver for calculating f and g; reenter at 666. + CALL save_local(lsave, isave, dsave, x_projected, constrained, boxed, updatd, nintol, itfile, iback, nskip, head, col, itail, & + iter, iupdat, nseg, nfgv, info, ifun, iword, nfree, nact, ileave, nenter, theta, fold, tol, dnorm, epsmch, & + cpu1, cachyt, sbtime, lnscht, time1, gd, step_max, g_inf_norm, stp, gdold, dtd) RETURN ELSE -! refresh the lbfgs memory and restart the iteration. - IF(iprint >= 1) WRITE (*, 1008) - IF (info == 0) nfgv = nfgv - 1 - info = 0 - col = 0 - head = 1 - theta = one - iupdat = 0 - updatd = .FALSE. - task = 'RESTART_FROM_LNSRCH' +! calculate and print out the quantities related to the new X. CALL timer(cpu2) lnscht = lnscht + cpu2 - cpu1 - first=.FALSE. - CYCLE - END IF - ELSE IF (task(1:5) == 'FG_LN') THEN -! return to the driver for calculating f and g; reenter at 666. - CALL save_local(lsave,isave,dsave,x_projected,constrained,boxed,updatd,nintol,itfile,iback,nskip,head,col,itail,& - iter,iupdat,nseg,nfgv,info,ifun,iword,nfree,nact,ileave,nenter,theta,fold,tol,dnorm,epsmch,& - cpu1,cachyt,sbtime,lnscht,time1,gd,step_max,g_inf_norm,stp,gdold,dtd) - RETURN - ELSE -! calculate and print out the quantities related to the new X. - CALL timer(cpu2) - lnscht = lnscht + cpu2 - cpu1 - iter = iter + 1 + iter = iter + 1 ! Compute the infinity norm of the projected (-)gradient. - CALL projgr(n,lower_bound,upper_bound,nbd,x,g,g_inf_norm) + CALL projgr(n, lower_bound, upper_bound, nbd, x, g, g_inf_norm) ! Print iteration information. - CALL prn2lb(n,x,f,g,iprint,itfile,iter,nfgv,nact, & - g_inf_norm,nseg,word,iword,iback,stp,xstep) - CALL save_local(lsave,isave,dsave,x_projected,constrained,boxed,updatd,nintol,itfile,iback,nskip,head,col,itail,& - iter,iupdat,nseg,nfgv,info,ifun,iword,nfree,nact,ileave,nenter,theta,fold,tol,dnorm,epsmch,& - cpu1,cachyt,sbtime,lnscht,time1,gd,step_max,g_inf_norm,stp,gdold,dtd) - RETURN - END IF + CALL prn2lb(n, x, f, g, iprint, itfile, iter, nfgv, nact, & + g_inf_norm, nseg, word, iword, iback, stp, xstep) + CALL save_local(lsave, isave, dsave, x_projected, constrained, boxed, updatd, nintol, itfile, iback, nskip, head, col, itail, & + iter, iupdat, nseg, nfgv, info, ifun, iword, nfree, nact, ileave, nenter, theta, fold, tol, dnorm, epsmch, & + cpu1, cachyt, sbtime, lnscht, time1, gd, step_max, g_inf_norm, stp, gdold, dtd) + RETURN + END IF ENDIF ! Test for termination. @@ -813,13 +813,13 @@ SUBROUTINE mainlb(n, m, x, lower_bound, upper_bound, nbd, f, g, factr, pgtol, ws task = 'CONVERGENCE: NORM_OF_PROJECTED_GRADIENT_<=_PGTOL' CALL timer(time2) time = time2 - time1 - CALL prn3lb(n,x,f,task,iprint,info,itfile, & - iter,nfgv,nintol,nskip,nact,g_inf_norm, & - time,nseg,word,iback,stp,xstep,k, & - cachyt,sbtime,lnscht) - CALL save_local(lsave,isave,dsave,x_projected,constrained,boxed,updatd,nintol,itfile,iback,nskip,head,col,itail,& - iter,iupdat,nseg,nfgv,info,ifun,iword,nfree,nact,ileave,nenter,theta,fold,tol,dnorm,epsmch,& - cpu1,cachyt,sbtime,lnscht,time1,gd,step_max,g_inf_norm,stp,gdold,dtd) + CALL prn3lb(n, x, f, task, iprint, info, itfile, & + iter, nfgv, nintol, nskip, nact, g_inf_norm, & + time, nseg, word, iback, stp, xstep, k, & + cachyt, sbtime, lnscht) + CALL save_local(lsave, isave, dsave, x_projected, constrained, boxed, updatd, nintol, itfile, iback, nskip, head, col, itail, & + iter, iupdat, nseg, nfgv, info, ifun, iword, nfree, nact, ileave, nenter, theta, fold, tol, dnorm, epsmch, & + cpu1, cachyt, sbtime, lnscht, time1, gd, step_max, g_inf_norm, stp, gdold, dtd) RETURN END IF @@ -831,13 +831,13 @@ SUBROUTINE mainlb(n, m, x, lower_bound, upper_bound, nbd, f, g, factr, pgtol, ws ! i.e., to issue a warning if iback>10 in the line search. CALL timer(time2) time = time2 - time1 - CALL prn3lb(n,x,f,task,iprint,info,itfile, & - iter,nfgv,nintol,nskip,nact,g_inf_norm, & - time,nseg,word,iback,stp,xstep,k, & - cachyt,sbtime,lnscht) - CALL save_local(lsave,isave,dsave,x_projected,constrained,boxed,updatd,nintol,itfile,iback,nskip,head,col,itail,& - iter,iupdat,nseg,nfgv,info,ifun,iword,nfree,nact,ileave,nenter,theta,fold,tol,dnorm,epsmch,& - cpu1,cachyt,sbtime,lnscht,time1,gd,step_max,g_inf_norm,stp,gdold,dtd) + CALL prn3lb(n, x, f, task, iprint, info, itfile, & + iter, nfgv, nintol, nskip, nact, g_inf_norm, & + time, nseg, word, iback, stp, xstep, k, & + cachyt, sbtime, lnscht) + CALL save_local(lsave, isave, dsave, x_projected, constrained, boxed, updatd, nintol, itfile, iback, nskip, head, col, itail, & + iter, iupdat, nseg, nfgv, info, ifun, iword, nfree, nact, ileave, nenter, theta, fold, tol, dnorm, epsmch, & + cpu1, cachyt, sbtime, lnscht, time1, gd, step_max, g_inf_norm, stp, gdold, dtd) RETURN END IF @@ -846,13 +846,13 @@ SUBROUTINE mainlb(n, m, x, lower_bound, upper_bound, nbd, f, g, factr, pgtol, ws DO i = 1, n r(i) = g(i) - r(i) END DO - rr = ddot(n,r,1,r,1) + rr = ddot(n, r, 1, r, 1) IF (stp == one) THEN dr = gd - gdold ddum = -gdold ELSE dr = (gd - gdold)*stp - CALL dscal(n,stp,d,1) + CALL dscal(n, stp, d, 1) ddum = -gdold*stp END IF @@ -860,8 +860,8 @@ SUBROUTINE mainlb(n, m, x, lower_bound, upper_bound, nbd, f, g, factr, pgtol, ws ! skip the L-BFGS update. nskip = nskip + 1 updatd = .FALSE. - IF (iprint >= 1) WRITE (*,1004) dr, ddum - first=.FALSE. + IF (iprint >= 1) WRITE (*, 1004) dr, ddum + first = .FALSE. CYCLE END IF @@ -876,20 +876,20 @@ SUBROUTINE mainlb(n, m, x, lower_bound, upper_bound, nbd, f, g, factr, pgtol, ws ! Update matrices WS and WY and form the middle matrix in B. - CALL matupd(n,m,ws,wy,sy,ss,d,r,itail, & - iupdat,col,head,theta,rr,dr,stp,dtd) + CALL matupd(n, m, ws, wy, sy, ss, d, r, itail, & + iupdat, col, head, theta, rr, dr, stp, dtd) ! Form the upper half of the pds T = theta*SS + L*D^(-1)*L'; ! Store T in the upper triangular of the array wt; ! Cholesky factorize T to J*J' with ! J' stored in the upper triangular of wt. - CALL formt(m,wt,sy,ss,col,theta,info) + CALL formt(m, wt, sy, ss, col, theta, info) IF (info /= 0) THEN ! nonpositive definiteness in Cholesky factorization; ! refresh the lbfgs memory and restart the iteration. - IF(iprint >= 1) WRITE (*, 1007) + IF (iprint >= 1) WRITE (*, 1007) info = 0 col = 0 head = 1 @@ -903,31 +903,31 @@ SUBROUTINE mainlb(n, m, x, lower_bound, upper_bound, nbd, f, g, factr, pgtol, ws ! [ D^(1/2) O ] [ -D^(1/2) D^(-1/2)*L' ] ! [ -L*D^(-1/2) J ] [ 0 J' ] - first=.FALSE. + first = .FALSE. END DO - 1001 FORMAT (//,'ITERATION ',i5) - 1002 FORMAT & - & (/,'At iterate',i5,4x,'f= ',1p,d12.5,4x,'|proj g|= ',1p,d12.5) - 1003 FORMAT (2(1x,i4),5x,'-',5x,'-',3x,'-',5x,'-',5x,'-',8x,'-',3x, & - 1p,2(1x,d10.3)) - 1004 FORMAT (' ys=',1p,e10.3,' -gs=',1p,e10.3,' BFGS update SKIPPED') - 1005 FORMAT (/, & - &' Singular triangular system detected;',/, & - &' refresh the lbfgs memory and restart the iteration.') - 1006 FORMAT (/, & - &' Nonpositive definiteness in Cholesky factorization in formk;',/,& - &' refresh the lbfgs memory and restart the iteration.') - 1007 FORMAT (/, & - &' Nonpositive definiteness in Cholesky factorization in formt;',/,& - &' refresh the lbfgs memory and restart the iteration.') - 1008 FORMAT (/, & - &' Bad direction in the line search;',/, & - &' refresh the lbfgs memory and restart the iteration.') +1001 FORMAT(//, 'ITERATION ', i5) +1002 FORMAT & + & (/, 'At iterate', i5, 4x, 'f= ', 1p, d12.5, 4x, '|proj g|= ', 1p, d12.5) +1003 FORMAT(2(1x, i4), 5x, '-', 5x, '-', 3x, '-', 5x, '-', 5x, '-', 8x, '-', 3x, & + 1p, 2(1x, d10.3)) +1004 FORMAT(' ys=', 1p, e10.3, ' -gs=', 1p, e10.3, ' BFGS update SKIPPED') +1005 FORMAT(/, & + &' Singular triangular system detected;', /, & + &' refresh the lbfgs memory and restart the iteration.') +1006 FORMAT(/, & + &' Nonpositive definiteness in Cholesky factorization in formk;', /,& + &' refresh the lbfgs memory and restart the iteration.') +1007 FORMAT(/, & + &' Nonpositive definiteness in Cholesky factorization in formt;', /,& + &' refresh the lbfgs memory and restart the iteration.') +1008 FORMAT(/, & + &' Bad direction in the line search;', /, & + &' refresh the lbfgs memory and restart the iteration.') RETURN - END SUBROUTINE mainlb + END SUBROUTINE mainlb ! ************************************************************************************************** !> \brief This subroutine initializes iwhere and projects the initial x to the feasible set if necessary. @@ -951,8 +951,8 @@ END SUBROUTINE mainlb !> Ciyou Zhu !> in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal. ! ************************************************************************************************** - SUBROUTINE active(n, lower_bound,upper_bound, nbd, x, iwhere, iprint, & - x_projected, constrained, boxed) + SUBROUTINE active(n, lower_bound, upper_bound, nbd, x, iwhere, iprint, & + x_projected, constrained, boxed) INTEGER, INTENT(in) :: n REAL(KIND=dp), INTENT(in) :: lower_bound(n), upper_bound(n) @@ -1004,7 +1004,7 @@ SUBROUTINE active(n, lower_bound,upper_bound, nbd, x, iwhere, iprint, ! otherwise set x(i)=mid(x(i), u(i), l(i)). ELSE - constrained= .TRUE. + constrained = .TRUE. IF (nbd(i) == 2 .AND. upper_bound(i) - lower_bound(i) <= zero) THEN ! this variable is always fixed iwhere(i) = 3 @@ -1015,19 +1015,19 @@ SUBROUTINE active(n, lower_bound,upper_bound, nbd, x, iwhere, iprint, END DO IF (iprint >= 0) THEN - IF (x_projected) WRITE (*,*) & + IF (x_projected) WRITE (*, *) & & 'The initial X is infeasible. Restart with its projection.' - IF (.NOT. constrained) & - WRITE (*,*) 'This problem is unconstrained.' + IF (.NOT. constrained) & + WRITE (*, *) 'This problem is unconstrained.' END IF - IF (iprint > 0) WRITE (*,1001) nbdd + IF (iprint > 0) WRITE (*, 1001) nbdd - 1001 FORMAT (/,'At X0 ',i9,' variables are exactly at the bounds') +1001 FORMAT(/, 'At X0 ', i9, ' variables are exactly at the bounds') RETURN - END SUBROUTINE active + END SUBROUTINE active ! ************************************************************************************************** !> \brief This subroutine computes the product of the 2m x 2m middle matrix @@ -1051,7 +1051,7 @@ END SUBROUTINE active !> Ciyou Zhu !> in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal. ! ************************************************************************************************** - SUBROUTINE bmv(m, sy, wt, col, v, p, info) + SUBROUTINE bmv(m, sy, wt, col, v, p, info) INTEGER :: m REAL(KIND=dp) :: sy(m, m), wt(m, m) @@ -1074,42 +1074,42 @@ SUBROUTINE bmv(m, sy, wt, col, v, p, info) i2 = col + i sum = 0.0_dp DO k = 1, i - 1 - sum = sum + sy(i,k)*v(k)/sy(k,k) + sum = sum + sy(i, k)*v(k)/sy(k, k) END DO p(i2) = v(i2) + sum END DO ! Solve the triangular system - CALL dtrsl(wt,m,col,p(col+1),11,info) + CALL dtrsl(wt, m, col, p(col + 1), 11, info) IF (info /= 0) RETURN ! solve D^(1/2)p1=v1. DO i = 1, col - p(i) = v(i)/SQRT(sy(i,i)) + p(i) = v(i)/SQRT(sy(i, i)) END DO ! PART II: solve [ -D^(1/2) D^(-1/2)*L' ] [ p1 ] = [ p1 ] ! [ 0 J' ] [ p2 ] [ p2 ]. ! solve J^Tp2=p2. - CALL dtrsl(wt,m,col,p(col+1),01,info) + CALL dtrsl(wt, m, col, p(col + 1), 01, info) IF (info /= 0) RETURN ! compute p1=-D^(-1/2)(p1-D^(-1/2)L'p2) ! =-D^(-1/2)p1+D^(-1)L'p2. DO i = 1, col - p(i) = -p(i)/SQRT(sy(i,i)) + p(i) = -p(i)/SQRT(sy(i, i)) END DO DO i = 1, col sum = 0._dp DO k = i + 1, col - sum = sum + sy(k,i)*p(col+k)/sy(i,i) + sum = sum + sy(k, i)*p(col + k)/sy(i, i) END DO p(i) = p(i) + sum END DO RETURN - END SUBROUTINE bmv + END SUBROUTINE bmv ! ************************************************************************************************** !> \brief For given x, l, u, g (with g_inf_norm > 0), and a limited memory @@ -1190,9 +1190,9 @@ END SUBROUTINE bmv !> Ciyou Zhu !> in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal. ! ************************************************************************************************** - SUBROUTINE cauchy(n, x, lower_bound, upper_bound, nbd, g, iorder, iwhere, t, d, xcp, & - m, wy, ws, sy, wt, theta, col, head, p, c, wbp, & - v, nseg, iprint, g_inf_norm, info, epsmch) + SUBROUTINE cauchy(n, x, lower_bound, upper_bound, nbd, g, iorder, iwhere, t, d, xcp, & + m, wy, ws, sy, wt, theta, col, head, p, c, wbp, & + v, nseg, iprint, g_inf_norm, info, epsmch) INTEGER, INTENT(in) :: n REAL(KIND=dp), INTENT(in) :: x(n), lower_bound(n), upper_bound(n) INTEGER, INTENT(in) :: nbd(n) @@ -1240,8 +1240,8 @@ SUBROUTINE cauchy(n, x, lower_bound, upper_bound, nbd, g, iorder, iwhere, t, d, ! the derivative f1 and the vector p = W'd (for theta = 1). IF (g_inf_norm <= zero) THEN - IF (iprint >= 0) WRITE (*,*) 'Subgnorm = 0. GCP = X.' - CALL dcopy(n,x,1,xcp,1) + IF (iprint >= 0) WRITE (*, *) 'Subgnorm = 0. GCP = X.' + CALL dcopy(n, x, 1, xcp, 1) RETURN END IF bnded = .TRUE. @@ -1251,7 +1251,7 @@ SUBROUTINE cauchy(n, x, lower_bound, upper_bound, nbd, g, iorder, iwhere, t, d, bkmin = zero col2 = 2*col f1 = zero - IF (iprint >= 99) WRITE (*,3010) + IF (iprint >= 99) WRITE (*, 3010) ! We set p to zero and build it up as we determine d. @@ -1294,9 +1294,9 @@ SUBROUTINE cauchy(n, x, lower_bound, upper_bound, nbd, g, iorder, iwhere, t, d, f1 = f1 - neggi*neggi ! calculate p := p - W'e_i* (g_i). DO j = 1, col - p(j) = p(j) + wy(i,pointr)* neggi - p(col + j) = p(col + j) + ws(i,pointr)*neggi - pointr = MOD(pointr,m) + 1 + p(j) = p(j) + wy(i, pointr)*neggi + p(col + j) = p(col + j) + ws(i, pointr)*neggi + pointr = MOD(pointr, m) + 1 END DO IF (nbd(i) <= 2 .AND. nbd(i) /= 0 & & .AND. neggi < zero) THEN @@ -1332,16 +1332,16 @@ SUBROUTINE cauchy(n, x, lower_bound, upper_bound, nbd, g, iorder, iwhere, t, d, IF (theta /= one) THEN ! complete the initialization of p for theta not= one. - CALL dscal(col,theta,p(col+1),1) + CALL dscal(col, theta, p(col + 1), 1) END IF ! Initialize GCP xcp = x. - CALL dcopy(n,x,1,xcp,1) + CALL dcopy(n, x, 1, xcp, 1) IF (nbreak == 0 .AND. nfree == n + 1) THEN ! is a zero vector, return with the initial xcp as GCP. - IF (iprint > 100) WRITE (*,1010) (xcp(i), i = 1, n) + IF (iprint > 100) WRITE (*, 1010) (xcp(i), i=1, n) RETURN END IF @@ -1353,35 +1353,32 @@ SUBROUTINE cauchy(n, x, lower_bound, upper_bound, nbd, g, iorder, iwhere, t, d, ! Initialize derivative f2. - f2 = -theta*f1 - f2_org = f2 + f2 = -theta*f1 + f2_org = f2 IF (col > 0) THEN - CALL bmv(m,sy,wt,col,p,v,info) + CALL bmv(m, sy, wt, col, p, v, info) IF (info /= 0) RETURN - f2 = f2 - ddot(col2,v,1,p,1) + f2 = f2 - ddot(col2, v, 1, p, 1) END IF dtm = -f1/f2 tsum = zero nseg = 1 - IF (iprint >= 99) & - WRITE (*,*) 'There are ',nbreak,' breakpoints ' - - + IF (iprint >= 99) & + WRITE (*, *) 'There are ', nbreak, ' breakpoints ' nleft = nbreak iter = 1 - tj = zero ! If there are no breakpoints, locate the GCP and return. IF (nleft == 0) THEN IF (iprint >= 99) THEN - WRITE (*,*) - WRITE (*,*) 'GCP found in this segment' - WRITE (*,4010) nseg,f1,f2 - WRITE (*,6010) dtm + WRITE (*, *) + WRITE (*, *) 'GCP found in this segment' + WRITE (*, 4010) nseg, f1, f2 + WRITE (*, 6010) dtm END IF IF (dtm <= zero) dtm = zero tsum = tsum + dtm @@ -1389,177 +1386,177 @@ SUBROUTINE cauchy(n, x, lower_bound, upper_bound, nbd, g, iorder, iwhere, t, d, ! Move free variables (i.e., the ones w/o breakpoints) and ! the variables whose breakpoints haven't been reached. - CALL daxpy(n,tsum,d,1,xcp,1) + CALL daxpy(n, tsum, d, 1, xcp, 1) END IF - DO WHILE(nleft>0) + DO WHILE (nleft > 0) ! Find the next smallest breakpoint; ! compute dt = t(nleft) - t(nleft + 1). - tj0 = tj - IF (iter == 1) THEN + tj0 = tj + IF (iter == 1) THEN ! Since we already have the smallest breakpoint we need not do ! heapsort yet. Often only one breakpoint is used and the ! cost of heapsort is avoided. - tj = bkmin - ibp = iorder(ibkmin) - ELSE - IF (iter == 2) THEN + tj = bkmin + ibp = iorder(ibkmin) + ELSE + IF (iter == 2) THEN ! Replace the already used smallest breakpoint with the ! breakpoint numbered nbreak > nlast, before heapsort call. - IF (ibkmin /= nbreak) THEN - t(ibkmin) = t(nbreak) - iorder(ibkmin) = iorder(nbreak) - END IF + IF (ibkmin /= nbreak) THEN + t(ibkmin) = t(nbreak) + iorder(ibkmin) = iorder(nbreak) + END IF ! Update heap structure of breakpoints ! (if iter=2, initialize heap). + END IF + CALL hpsolb(nleft, t, iorder, iter - 2) + tj = t(nleft) + ibp = iorder(nleft) END IF - CALL hpsolb(nleft,t,iorder,iter-2) - tj = t(nleft) - ibp = iorder(nleft) - END IF - dt = tj - tj0 + dt = tj - tj0 - IF (dt /= zero .AND. iprint >= 100) THEN - WRITE (*,4011) nseg,f1,f2 - WRITE (*,5010) dt - WRITE (*,6010) dtm - END IF + IF (dt /= zero .AND. iprint >= 100) THEN + WRITE (*, 4011) nseg, f1, f2 + WRITE (*, 5010) dt + WRITE (*, 6010) dtm + END IF ! If a minimizer is within this interval, locate the GCP and return. - IF (dtm < dt) THEN - IF (iprint >= 99) THEN - WRITE (*,*) - WRITE (*,*) 'GCP found in this segment' - WRITE (*,4010) nseg,f1,f2 - WRITE (*,6010) dtm - END IF - IF (dtm <= zero) dtm = zero - tsum = tsum + dtm + IF (dtm < dt) THEN + IF (iprint >= 99) THEN + WRITE (*, *) + WRITE (*, *) 'GCP found in this segment' + WRITE (*, 4010) nseg, f1, f2 + WRITE (*, 6010) dtm + END IF + IF (dtm <= zero) dtm = zero + tsum = tsum + dtm ! Move free variables (i.e., the ones w/o breakpoints) and ! the variables whose breakpoints haven't been reached. - CALL daxpy(n,tsum,d,1,xcp,1) - EXIT - END IF + CALL daxpy(n, tsum, d, 1, xcp, 1) + EXIT + END IF ! Otherwise fix one variable and ! reset the corresponding component of d to zero. - tsum = tsum + dt - nleft = nleft - 1 - iter = iter + 1 - dibp = d(ibp) - d(ibp) = zero - IF (dibp > zero) THEN - zibp = upper_bound(ibp) - x(ibp) - xcp(ibp) = upper_bound(ibp) - iwhere(ibp) = 2 - ELSE - zibp = lower_bound(ibp) - x(ibp) - xcp(ibp) = lower_bound(ibp) - iwhere(ibp) = 1 - END IF - IF (iprint >= 100) WRITE (*,*) 'Variable ',ibp,' is fixed.' - IF (nleft == 0 .AND. nbreak == n) THEN + tsum = tsum + dt + nleft = nleft - 1 + iter = iter + 1 + dibp = d(ibp) + d(ibp) = zero + IF (dibp > zero) THEN + zibp = upper_bound(ibp) - x(ibp) + xcp(ibp) = upper_bound(ibp) + iwhere(ibp) = 2 + ELSE + zibp = lower_bound(ibp) - x(ibp) + xcp(ibp) = lower_bound(ibp) + iwhere(ibp) = 1 + END IF + IF (iprint >= 100) WRITE (*, *) 'Variable ', ibp, ' is fixed.' + IF (nleft == 0 .AND. nbreak == n) THEN ! all n variables are fixed, ! return with xcp as GCP. - dtm = dt - EXIT - END IF + dtm = dt + EXIT + END IF ! Update the derivative information. - nseg = nseg + 1 - dibp2 = dibp**2 + nseg = nseg + 1 + dibp2 = dibp**2 ! Update f1 and f2. ! temporarily set f1 and f2 for col=0. - f1 = f1 + dt*f2 + dibp2 - theta*dibp*zibp - f2 = f2 - theta*dibp2 + f1 = f1 + dt*f2 + dibp2 - theta*dibp*zibp + f2 = f2 - theta*dibp2 - IF (col > 0) THEN + IF (col > 0) THEN ! update c = c + dt*p. - CALL daxpy(col2,dt,p,1,c,1) + CALL daxpy(col2, dt, p, 1, c, 1) ! choose wbp, ! the row of W corresponding to the breakpoint encountered. - pointr = head - DO j = 1,col - wbp(j) = wy(ibp,pointr) - wbp(col + j) = theta*ws(ibp,pointr) - pointr = MOD(pointr,m) + 1 - END DO + pointr = head + DO j = 1, col + wbp(j) = wy(ibp, pointr) + wbp(col + j) = theta*ws(ibp, pointr) + pointr = MOD(pointr, m) + 1 + END DO ! compute (wbp)Mc, (wbp)Mp, and (wbp)M(wbp)'. - CALL bmv(m,sy,wt,col,wbp,v,info) - IF (info /= 0) RETURN - wmc = ddot(col2,c,1,v,1) - wmp = ddot(col2,p,1,v,1) - wmw = ddot(col2,wbp,1,v,1) + CALL bmv(m, sy, wt, col, wbp, v, info) + IF (info /= 0) RETURN + wmc = ddot(col2, c, 1, v, 1) + wmp = ddot(col2, p, 1, v, 1) + wmw = ddot(col2, wbp, 1, v, 1) ! update p = p - dibp*wbp. - CALL daxpy(col2,-dibp,wbp,1,p,1) + CALL daxpy(col2, -dibp, wbp, 1, p, 1) ! complete updating f1 and f2 while col > 0. - f1 = f1 + dibp*wmc - f2 = f2 + 2.0_dp*dibp*wmp - dibp2*wmw - END IF + f1 = f1 + dibp*wmc + f2 = f2 + 2.0_dp*dibp*wmp - dibp2*wmw + END IF - f2 = MAX(epsmch*f2_org,f2) - IF (nleft > 0) THEN - dtm = -f1/f2 - CYCLE + f2 = MAX(epsmch*f2_org, f2) + IF (nleft > 0) THEN + dtm = -f1/f2 + CYCLE ! to repeat the loop for unsearched intervals. - ELSE - IF(bnded) THEN - f1 = zero - f2 = zero - dtm = zero ELSE - dtm = -f1/f2 - END IF - IF (iprint >= 99) THEN - WRITE (*,*) - WRITE (*,*) 'GCP found in this segment' - WRITE (*,4010) nseg,f1,f2 - WRITE (*,6010) dtm - END IF - IF (dtm <= zero) dtm = zero - tsum = tsum + dtm + IF (bnded) THEN + f1 = zero + f2 = zero + dtm = zero + ELSE + dtm = -f1/f2 + END IF + IF (iprint >= 99) THEN + WRITE (*, *) + WRITE (*, *) 'GCP found in this segment' + WRITE (*, 4010) nseg, f1, f2 + WRITE (*, 6010) dtm + END IF + IF (dtm <= zero) dtm = zero + tsum = tsum + dtm ! Move free variables (i.e., the ones w/o breakpoints) and ! the variables whose breakpoints haven't been reached. - CALL daxpy(n,tsum,d,1,xcp,1) - EXIT - END IF + CALL daxpy(n, tsum, d, 1, xcp, 1) + EXIT + END IF END DO ! Update c = c + dtm*p = W'(x^c - x) ! which will be used in computing r = Z'(B(x^c - x) + g). - IF (col > 0) CALL daxpy(col2,dtm,p,1,c,1) - IF (iprint > 100) WRITE (*,1010) (xcp(i),i = 1,n) - IF (iprint >= 99) WRITE (*,2010) + IF (col > 0) CALL daxpy(col2, dtm, p, 1, c, 1) + IF (iprint > 100) WRITE (*, 1010) (xcp(i), i=1, n) + IF (iprint >= 99) WRITE (*, 2010) - 1010 FORMAT ('Cauchy X = ',/,(4x,1p,6(1x,d11.4))) - 2010 FORMAT (/,'---------------- exit CAUCHY----------------------',/) - 3010 FORMAT (/,'---------------- CAUCHY entered-------------------') - 4010 FORMAT ('Piece ',i3,' --f1, f2 at start point ',1p,2(1x,d11.4)) - 4011 FORMAT (/,'Piece ',i3,' --f1, f2 at start point ', & - 1p,2(1x,d11.4)) - 5010 FORMAT ('Distance to the next break point = ',1p,d11.4) - 6010 FORMAT ('Distance to the stationary point = ',1p,d11.4) +1010 FORMAT('Cauchy X = ', /, (4x, 1p, 6(1x, d11.4))) +2010 FORMAT(/, '---------------- exit CAUCHY----------------------',/) +3010 FORMAT(/, '---------------- CAUCHY entered-------------------') +4010 FORMAT('Piece ', i3, ' --f1, f2 at start point ', 1p, 2(1x, d11.4)) +4011 FORMAT(/, 'Piece ', i3, ' --f1, f2 at start point ', & + 1p, 2(1x, d11.4)) +5010 FORMAT('Distance to the next break point = ', 1p, d11.4) +6010 FORMAT('Distance to the stationary point = ', 1p, d11.4) RETURN - END SUBROUTINE cauchy + END SUBROUTINE cauchy ! ************************************************************************************************** !> \brief This subroutine computes r=-Z'B(xcp-xk)-Z'g by using @@ -1589,8 +1586,8 @@ END SUBROUTINE cauchy !> Ciyou Zhu !> in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal. ! ************************************************************************************************** - SUBROUTINE cmprlb(n, m, x, g, ws, wy, sy, wt, z, r, wa, index, & - theta, col, head, nfree, constrained, info) + SUBROUTINE cmprlb(n, m, x, g, ws, wy, sy, wt, z, r, wa, index, & + theta, col, head, nfree, constrained, info) INTEGER, INTENT(in) :: n, m REAL(KIND=dp), INTENT(in) :: x(n), g(n), ws(n, m), wy(n, m), & @@ -1614,7 +1611,7 @@ SUBROUTINE cmprlb(n, m, x, g, ws, wy, sy, wt, z, r, wa, index, & k = INDEX(i) r(i) = -theta*(z(k) - x(k)) - g(k) END DO - CALL bmv(m,sy,wt,col,wa(2*m+1),wa(1),info) + CALL bmv(m, sy, wt, col, wa(2*m + 1), wa(1), info) IF (info /= 0) THEN info = -8 RETURN @@ -1625,15 +1622,15 @@ SUBROUTINE cmprlb(n, m, x, g, ws, wy, sy, wt, z, r, wa, index, & a2 = theta*wa(col + j) DO i = 1, nfree k = INDEX(i) - r(i) = r(i) + wy(k,pointr)*a1 + ws(k,pointr)*a2 + r(i) = r(i) + wy(k, pointr)*a1 + ws(k, pointr)*a2 END DO - pointr = MOD(pointr,m) + 1 + pointr = MOD(pointr, m) + 1 END DO END IF RETURN - END SUBROUTINE cmprlb + END SUBROUTINE cmprlb ! ************************************************************************************************** !> \brief This subroutine checks the validity of the input data. @@ -1653,7 +1650,7 @@ END SUBROUTINE cmprlb !> Ciyou Zhu !> in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal. ! ************************************************************************************************** - SUBROUTINE errclb(n, m, factr, lower_bound, upper_bound, nbd, task, info, k) + SUBROUTINE errclb(n, m, factr, lower_bound, upper_bound, nbd, task, info, k) INTEGER, INTENT(in) :: n, m REAL(KIND=dp), INTENT(in) :: factr, lower_bound(n), upper_bound(n) @@ -1692,7 +1689,7 @@ SUBROUTINE errclb(n, m, factr, lower_bound, upper_bound, nbd, task, info, k) RETURN - END SUBROUTINE errclb + END SUBROUTINE errclb ! ************************************************************************************************** !> \brief This subroutine forms the LEL^T factorization of the indefinite @@ -1741,9 +1738,9 @@ END SUBROUTINE errclb !> Ciyou Zhu !> in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal. ! ************************************************************************************************** - SUBROUTINE formk(n, nsub, ind, nenter, ileave, indx2, iupdat, & - updatd, wn, wn1, m, ws, wy, sy, theta, col, & - head, info) + SUBROUTINE formk(n, nsub, ind, nenter, ileave, indx2, iupdat, & + updatd, wn, wn1, m, ws, wy, sy, theta, col, & + head, info) INTEGER, INTENT(in) :: n, nsub, ind(n), nenter, ileave, & indx2(n), iupdat @@ -1787,9 +1784,9 @@ SUBROUTINE formk(n, nsub, ind, nenter, ileave, indx2, iupdat, & ! shift old part of WN1. DO jy = 1, m - 1 js = m + jy - CALL dcopy(m-jy,wn1(jy+1,jy+1),1,wn1(jy,jy),1) - CALL dcopy(m-jy,wn1(js+1,js+1),1,wn1(js,js),1) - CALL dcopy(m-1,wn1(m+2,jy+1),1,wn1(m+1,jy),1) + CALL dcopy(m - jy, wn1(jy + 1, jy + 1), 1, wn1(jy, jy), 1) + CALL dcopy(m - jy, wn1(js + 1, js + 1), 1, wn1(js, js), 1) + CALL dcopy(m - 1, wn1(m + 2, jy + 1), 1, wn1(m + 1, jy), 1) END DO END IF @@ -1811,18 +1808,18 @@ SUBROUTINE formk(n, nsub, ind, nenter, ileave, indx2, iupdat, & ! compute element jy of row 'col' of Y'ZZ'Y DO k = pbegin, pend k1 = ind(k) - temp1 = temp1 + wy(k1,ipntr)*wy(k1,jpntr) + temp1 = temp1 + wy(k1, ipntr)*wy(k1, jpntr) END DO ! compute elements jy of row 'col' of L_a and S'AA'S DO k = dbegin, dend k1 = ind(k) - temp2 = temp2 + ws(k1,ipntr)*ws(k1,jpntr) - temp3 = temp3 + ws(k1,ipntr)*wy(k1,jpntr) + temp2 = temp2 + ws(k1, ipntr)*ws(k1, jpntr) + temp3 = temp3 + ws(k1, ipntr)*wy(k1, jpntr) END DO - wn1(iy,jy) = temp1 - wn1(is,js) = temp2 - wn1(is,jy) = temp3 - jpntr = MOD(jpntr,m) + 1 + wn1(iy, jy) = temp1 + wn1(is, js) = temp2 + wn1(is, jy) = temp3 + jpntr = MOD(jpntr, m) + 1 END DO ! put new column in block (2,1). @@ -1836,10 +1833,10 @@ SUBROUTINE formk(n, nsub, ind, nenter, ileave, indx2, iupdat, & ! compute element i of column 'col' of R_z DO k = pbegin, pend k1 = ind(k) - temp3 = temp3 + ws(k1,ipntr)*wy(k1,jpntr) + temp3 = temp3 + ws(k1, ipntr)*wy(k1, jpntr) END DO - ipntr = MOD(ipntr,m) + 1 - wn1(is,jy) = temp3 + ipntr = MOD(ipntr, m) + 1 + wn1(is, jy) = temp3 END DO upcl = col - 1 ELSE @@ -1860,19 +1857,19 @@ SUBROUTINE formk(n, nsub, ind, nenter, ileave, indx2, iupdat, & temp4 = zero DO k = 1, nenter k1 = indx2(k) - temp1 = temp1 + wy(k1,ipntr)*wy(k1,jpntr) - temp2 = temp2 + ws(k1,ipntr)*ws(k1,jpntr) + temp1 = temp1 + wy(k1, ipntr)*wy(k1, jpntr) + temp2 = temp2 + ws(k1, ipntr)*ws(k1, jpntr) END DO DO k = ileave, n k1 = indx2(k) - temp3 = temp3 + wy(k1,ipntr)*wy(k1,jpntr) - temp4 = temp4 + ws(k1,ipntr)*ws(k1,jpntr) + temp3 = temp3 + wy(k1, ipntr)*wy(k1, jpntr) + temp4 = temp4 + ws(k1, ipntr)*ws(k1, jpntr) END DO - wn1(iy,jy) = wn1(iy,jy) + temp1 - temp3 - wn1(is,js) = wn1(is,js) - temp2 + temp4 - jpntr = MOD(jpntr,m) + 1 + wn1(iy, jy) = wn1(iy, jy) + temp1 - temp3 + wn1(is, js) = wn1(is, js) - temp2 + temp4 + jpntr = MOD(jpntr, m) + 1 END DO - ipntr = MOD(ipntr,m) + 1 + ipntr = MOD(ipntr, m) + 1 END DO ! modify the old parts in block (2,1). @@ -1884,20 +1881,20 @@ SUBROUTINE formk(n, nsub, ind, nenter, ileave, indx2, iupdat, & temp3 = zero DO k = 1, nenter k1 = indx2(k) - temp1 = temp1 + ws(k1,ipntr)*wy(k1,jpntr) + temp1 = temp1 + ws(k1, ipntr)*wy(k1, jpntr) END DO DO k = ileave, n k1 = indx2(k) - temp3 = temp3 + ws(k1,ipntr)*wy(k1,jpntr) + temp3 = temp3 + ws(k1, ipntr)*wy(k1, jpntr) END DO - IF (is <= jy + m) THEN - wn1(is,jy) = wn1(is,jy) + temp1 - temp3 + IF (is <= jy + m) THEN + wn1(is, jy) = wn1(is, jy) + temp1 - temp3 ELSE - wn1(is,jy) = wn1(is,jy) - temp1 + temp3 + wn1(is, jy) = wn1(is, jy) - temp1 + temp3 END IF - jpntr = MOD(jpntr,m) + 1 + jpntr = MOD(jpntr, m) + 1 END DO - ipntr = MOD(ipntr,m) + 1 + ipntr = MOD(ipntr, m) + 1 END DO ! Form the upper triangle of WN = [D+Y' ZZ'Y/theta -L_a'+R_z' ] @@ -1910,16 +1907,16 @@ SUBROUTINE formk(n, nsub, ind, nenter, ileave, indx2, iupdat, & DO jy = 1, iy js = col + jy js1 = m + jy - wn(jy,iy) = wn1(iy,jy)/theta - wn(js,is) = wn1(is1,js1)*theta + wn(jy, iy) = wn1(iy, jy)/theta + wn(js, is) = wn1(is1, js1)*theta END DO DO jy = 1, iy - 1 - wn(jy,is) = -wn1(is1,jy) + wn(jy, is) = -wn1(is1, jy) END DO DO jy = iy, col - wn(jy,is) = wn1(is1,jy) + wn(jy, is) = wn1(is1, jy) END DO - wn(iy,iy) = wn(iy,iy) + sy(iy,iy) + wn(iy, iy) = wn(iy, iy) + sy(iy, iy) END DO ! Form the upper triangle of WN= [ LL' L^-1(-L_a'+R_z')] @@ -1927,30 +1924,29 @@ SUBROUTINE formk(n, nsub, ind, nenter, ileave, indx2, iupdat, & ! first Cholesky factor (1,1) block of wn to get LL' ! with L' stored in the upper triangle of wn. - CALL dpofa(wn,m2,col,info) + CALL dpofa(wn, m2, col, info) IF (info /= 0) THEN info = -1 RETURN END IF ! then form L^-1(-L_a'+R_z') in the (1,2) block. col2 = 2*col - DO js = col+1 ,col2 - CALL dtrsl(wn,m2,col,wn(1,js),11,info) + DO js = col + 1, col2 + CALL dtrsl(wn, m2, col, wn(1, js), 11, info) END DO ! Form S'AA'S*theta + (L^-1(-L_a'+R_z'))'L^-1(-L_a'+R_z') in the ! upper triangle of (2,2) block of wn. - - DO is = col+1, col2 + DO is = col + 1, col2 DO js = is, col2 - wn(is,js) = wn(is,js) + ddot(col,wn(1,is),1,wn(1,js),1) + wn(is, js) = wn(is, js) + ddot(col, wn(1, is), 1, wn(1, js), 1) END DO END DO ! Cholesky factorization of (2,2) block of wn. - CALL dpofa(wn(col+1,col+1),m2,col,info) + CALL dpofa(wn(col + 1, col + 1), m2, col, info) IF (info /= 0) THEN info = -2 RETURN @@ -1958,7 +1954,7 @@ SUBROUTINE formk(n, nsub, ind, nenter, ileave, indx2, iupdat, & RETURN - END SUBROUTINE formk + END SUBROUTINE formk ! ************************************************************************************************** !> \brief This subroutine forms the upper half of the pos. def. and symm. @@ -1979,7 +1975,7 @@ END SUBROUTINE formk !> Ciyou Zhu !> in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal. ! ************************************************************************************************** - SUBROUTINE formt(m, wt, sy, ss, col, theta, info) + SUBROUTINE formt(m, wt, sy, ss, col, theta, info) INTEGER :: m REAL(KIND=dp) :: wt(m, m), sy(m, m), ss(m, m) @@ -1996,30 +1992,30 @@ SUBROUTINE formt(m, wt, sy, ss, col, theta, info) ! store T in the upper triangle of the array wt. DO j = 1, col - wt(1,j) = theta*ss(1,j) + wt(1, j) = theta*ss(1, j) END DO DO i = 2, col DO j = i, col - k1 = MIN(i,j) - 1 - ddum = zero + k1 = MIN(i, j) - 1 + ddum = zero DO k = 1, k1 - ddum = ddum + sy(i,k)*sy(j,k)/sy(k,k) + ddum = ddum + sy(i, k)*sy(j, k)/sy(k, k) END DO - wt(i,j) = ddum + theta*ss(i,j) + wt(i, j) = ddum + theta*ss(i, j) END DO END DO ! Cholesky factorize T to J*J' with ! J' stored in the upper triangle of wt. - CALL dpofa(wt,m,col,info) + CALL dpofa(wt, m, col, info) IF (info /= 0) THEN info = -3 END IF RETURN - END SUBROUTINE formt + END SUBROUTINE formt ! ************************************************************************************************** !> \brief This subroutine counts the entering and leaving variables when @@ -2052,8 +2048,8 @@ END SUBROUTINE formt !> Ciyou Zhu !> in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal. ! ************************************************************************************************** - SUBROUTINE freev(n, nfree, index, nenter, ileave, indx2, & - iwhere, wrk, updatd, constrained, iprint, iter) + SUBROUTINE freev(n, nfree, index, nenter, ileave, indx2, & + iwhere, wrk, updatd, constrained, iprint, iter) INTEGER :: n, nfree INTEGER, INTENT(inout) :: INDEX(n) @@ -2078,8 +2074,8 @@ SUBROUTINE freev(n, nfree, index, nenter, ileave, indx2, & IF (iwhere(k) > 0) THEN ileave = ileave - 1 indx2(ileave) = k - IF (iprint >= 100) WRITE (*,*) & - & 'Variable ',k,' leaves the set of free variables' + IF (iprint >= 100) WRITE (*, *) & + & 'Variable ', k, ' leaves the set of free variables' END IF END DO DO i = 1 + nfree, n @@ -2087,14 +2083,14 @@ SUBROUTINE freev(n, nfree, index, nenter, ileave, indx2, & IF (iwhere(k) <= 0) THEN nenter = nenter + 1 indx2(nenter) = k - IF (iprint >= 100) WRITE (*,*) & - & 'Variable ',k,' enters the set of free variables' + IF (iprint >= 100) WRITE (*, *) & + & 'Variable ', k, ' enters the set of free variables' END IF END DO - IF (iprint >= 99) WRITE (*,*) & - n+1-ileave,' variables leave; ',nenter,' variables enter' + IF (iprint >= 99) WRITE (*, *) & + n + 1 - ileave, ' variables leave; ', nenter, ' variables enter' END IF - wrk = (ileave < n+1) .OR. (nenter > 0) .OR. updatd + wrk = (ileave < n + 1) .OR. (nenter > 0) .OR. updatd ! Find the index set of free and active variables at the GCP. @@ -2109,12 +2105,12 @@ SUBROUTINE freev(n, nfree, index, nenter, ileave, indx2, & INDEX(iact) = i END IF END DO - IF (iprint >= 99) WRITE (*,*) & - nfree,' variables are free at GCP ',iter + 1 + IF (iprint >= 99) WRITE (*, *) & + nfree, ' variables are free at GCP ', iter + 1 RETURN - END SUBROUTINE freev + END SUBROUTINE freev ! ************************************************************************************************** !> \brief This subroutine sorts out the least element of t, and puts the @@ -2136,7 +2132,7 @@ END SUBROUTINE freev !> Ciyou Zhu !> in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal. ! ************************************************************************************************** - SUBROUTINE hpsolb(n, t, iorder, iheap) + SUBROUTINE hpsolb(n, t, iorder, iheap) INTEGER, INTENT(in) :: n REAL(KIND=dp), INTENT(inout) :: t(n) INTEGER, INTENT(inout) :: iorder(n) @@ -2156,12 +2152,12 @@ SUBROUTINE hpsolb(n, t, iorder, iheap) ! Rearrange the elements t(1) to t(n) to form a heap. DO k = 2, n - ddum = t(k) + ddum = t(k) indxin = iorder(k) ! Add ddum to the heap. i = k - DO WHILE (i> 1) + DO WHILE (i > 1) j = i/2 IF (ddum < t(j)) THEN t(i) = t(j) @@ -2184,21 +2180,21 @@ SUBROUTINE hpsolb(n, t, iorder, iheap) i = 1 out = t(1) indxou = iorder(1) - ddum = t(n) - indxin = iorder(n) + ddum = t(n) + indxin = iorder(n) ! Restore the heap j = 2*i - DO WHILE (j<= n-1) - IF (t(j+1) < t(j)) j = j+1 - IF (t(j) < ddum ) THEN + DO WHILE (j <= n - 1) + IF (t(j + 1) < t(j)) j = j + 1 + IF (t(j) < ddum) THEN t(i) = t(j) iorder(i) = iorder(j) i = j ELSE EXIT END IF - j=2*i + j = 2*i END DO t(i) = ddum iorder(i) = indxin @@ -2211,7 +2207,7 @@ SUBROUTINE hpsolb(n, t, iorder, iheap) RETURN - END SUBROUTINE hpsolb + END SUBROUTINE hpsolb ! ************************************************************************************************** !> \brief This subroutine calls subroutine dcsrch from the Minpack2 library @@ -2254,10 +2250,10 @@ END SUBROUTINE hpsolb !> Ciyou Zhu !> in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal. ! ************************************************************************************************** - SUBROUTINE lnsrlb(n, lower_bound, upper_bound, nbd, x, f, fold, gd, gdold, g, d, r, t,& - z, stp, dnorm, dtd, xstep, step_max, iter, ifun, & - iback, nfgv, info, task, boxed, constrained, csave, & - isave, dsave) + SUBROUTINE lnsrlb(n, lower_bound, upper_bound, nbd, x, f, fold, gd, gdold, g, d, r, t, & + z, stp, dnorm, dtd, xstep, step_max, iter, ifun, & + iback, nfgv, info, task, boxed, constrained, csave, & + isave, dsave) INTEGER, INTENT(in) :: n REAL(KIND=dp), INTENT(in) :: lower_bound(n), upper_bound(n) @@ -2279,67 +2275,67 @@ SUBROUTINE lnsrlb(n, lower_bound, upper_bound, nbd, x, f, fold, gd, gdold, g, d, INTEGER :: i REAL(KIND=dp) :: a1, a2, ddot - IF (.NOT.(task(1:5) == 'FG_LN')) THEN + IF (.NOT. (task(1:5) == 'FG_LN')) THEN - dtd = ddot(n,d,1,d,1) - dnorm = SQRT(dtd) + dtd = ddot(n, d, 1, d, 1) + dnorm = SQRT(dtd) ! Determine the maximum step length. - step_max = big - IF (constrained) THEN - IF (iter == 0) THEN - step_max = one - ELSE - DO i = 1, n - a1 = d(i) - IF (nbd(i) /= 0) THEN - IF (a1 < zero .AND. nbd(i) <= 2) THEN - a2 = lower_bound(i) - x(i) - IF (a2 >= zero) THEN - step_max = zero - ELSE IF (a1*step_max < a2) THEN - step_max = a2/a1 - END IF - ELSE IF (a1 > zero .AND. nbd(i) >= 2) THEN - a2 = upper_bound(i) - x(i) - IF (a2 <= zero) THEN - step_max = zero - ELSE IF (a1*step_max > a2) THEN - step_max = a2/a1 + step_max = big + IF (constrained) THEN + IF (iter == 0) THEN + step_max = one + ELSE + DO i = 1, n + a1 = d(i) + IF (nbd(i) /= 0) THEN + IF (a1 < zero .AND. nbd(i) <= 2) THEN + a2 = lower_bound(i) - x(i) + IF (a2 >= zero) THEN + step_max = zero + ELSE IF (a1*step_max < a2) THEN + step_max = a2/a1 + END IF + ELSE IF (a1 > zero .AND. nbd(i) >= 2) THEN + a2 = upper_bound(i) - x(i) + IF (a2 <= zero) THEN + step_max = zero + ELSE IF (a1*step_max > a2) THEN + step_max = a2/a1 + END IF END IF END IF - END IF - END DO + END DO + END IF END IF - END IF - IF (iter == 0 .AND. .NOT. boxed) THEN - stp = MIN(one/dnorm, step_max) - ELSE - stp = one - END IF + IF (iter == 0 .AND. .NOT. boxed) THEN + stp = MIN(one/dnorm, step_max) + ELSE + stp = one + END IF - CALL dcopy(n,x,1,t,1) - CALL dcopy(n,g,1,r,1) - fold = f - ifun = 0 - iback = 0 - csave = 'START' + CALL dcopy(n, x, 1, t, 1) + CALL dcopy(n, g, 1, r, 1) + fold = f + ifun = 0 + iback = 0 + csave = 'START' ENDIF - gd = ddot(n,g,1,d,1) + gd = ddot(n, g, 1, d, 1) IF (ifun == 0) THEN - gdold=gd + gdold = gd IF (gd >= zero) THEN ! the directional derivative >=0. ! Line search is impossible. - WRITE(*,*)' ascent direction in projection gd = ', gd + WRITE (*, *) ' ascent direction in projection gd = ', gd info = -4 RETURN END IF END IF - CALL dcsrch(f,gd,stp,ftol,gtol,xtol,zero,step_max,csave,isave,dsave) + CALL dcsrch(f, gd, stp, ftol, gtol, xtol, zero, step_max, csave, isave, dsave) xstep = stp*dnorm IF (csave(1:4) /= 'CONV' .AND. csave(1:4) /= 'WARN') THEN @@ -2348,7 +2344,7 @@ SUBROUTINE lnsrlb(n, lower_bound, upper_bound, nbd, x, f, fold, gd, gdold, g, d, nfgv = nfgv + 1 iback = ifun - 1 IF (stp == one) THEN - CALL dcopy(n,z,1,x,1) + CALL dcopy(n, z, 1, x, 1) ELSE DO i = 1, n x(i) = stp*d(i) + t(i) @@ -2360,7 +2356,7 @@ SUBROUTINE lnsrlb(n, lower_bound, upper_bound, nbd, x, f, fold, gd, gdold, g, d, RETURN - END SUBROUTINE lnsrlb + END SUBROUTINE lnsrlb ! ************************************************************************************************** !> \brief This subroutine updates matrices WS and WY, and forms the middle matrix in B. @@ -2388,8 +2384,8 @@ END SUBROUTINE lnsrlb !> Ciyou Zhu !> in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal. ! ************************************************************************************************** - SUBROUTINE matupd(n, m, ws, wy, sy, ss, d, r, itail, & - iupdat, col, head, theta, rr, dr, stp, dtd) + SUBROUTINE matupd(n, m, ws, wy, sy, ss, d, r, itail, & + iupdat, col, head, theta, rr, dr, stp, dtd) INTEGER :: n, m REAL(KIND=dp) :: ws(n, m), wy(n, m), sy(m, m), ss(m, m), & @@ -2407,16 +2403,16 @@ SUBROUTINE matupd(n, m, ws, wy, sy, ss, d, r, itail, & IF (iupdat <= m) THEN col = iupdat - itail = MOD(head+iupdat-2,m) + 1 + itail = MOD(head + iupdat - 2, m) + 1 ELSE - itail = MOD(itail,m) + 1 - head = MOD(head,m) + 1 + itail = MOD(itail, m) + 1 + head = MOD(head, m) + 1 END IF ! Update matrices WS and WY. - CALL dcopy(n,d,1,ws(1,itail),1) - CALL dcopy(n,r,1,wy(1,itail),1) + CALL dcopy(n, d, 1, ws(1, itail), 1) + CALL dcopy(n, r, 1, wy(1, itail), 1) ! Set theta=yy/ys. @@ -2429,28 +2425,28 @@ SUBROUTINE matupd(n, m, ws, wy, sy, ss, d, r, itail, & IF (iupdat > m) THEN ! move old information DO j = 1, col - 1 - CALL dcopy(j,ss(2,j+1),1,ss(1,j),1) - CALL dcopy(col-j,sy(j+1,j+1),1,sy(j,j),1) + CALL dcopy(j, ss(2, j + 1), 1, ss(1, j), 1) + CALL dcopy(col - j, sy(j + 1, j + 1), 1, sy(j, j), 1) END DO END IF ! add new information: the last row of SY ! and the last column of SS: pointr = head DO j = 1, col - 1 - sy(col,j) = ddot(n,d,1,wy(1,pointr),1) - ss(j,col) = ddot(n,ws(1,pointr),1,d,1) - pointr = MOD(pointr,m) + 1 + sy(col, j) = ddot(n, d, 1, wy(1, pointr), 1) + ss(j, col) = ddot(n, ws(1, pointr), 1, d, 1) + pointr = MOD(pointr, m) + 1 END DO IF (stp == one) THEN - ss(col,col) = dtd + ss(col, col) = dtd ELSE - ss(col,col) = stp*stp*dtd + ss(col, col) = stp*stp*dtd END IF - sy(col,col) = dr + sy(col, col) = dr RETURN - END SUBROUTINE matupd + END SUBROUTINE matupd ! ************************************************************************************************** !> \brief This subroutine prints the input data, initial point, upper and @@ -2472,7 +2468,7 @@ END SUBROUTINE matupd !> Ciyou Zhu !> in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal. ! ************************************************************************************************** - SUBROUTINE prn1lb(n, m, lower_bound, upper_bound, x, iprint, itfile, epsmch) + SUBROUTINE prn1lb(n, m, lower_bound, upper_bound, x, iprint, itfile, epsmch) INTEGER, INTENT(in) :: n, m REAL(KIND=dp), INTENT(in) :: lower_bound(n), upper_bound(n), x(n) @@ -2482,45 +2478,45 @@ SUBROUTINE prn1lb(n, m, lower_bound, upper_bound, x, iprint, itfile, epsmch) INTEGER :: i IF (iprint >= 0) THEN - WRITE (*,7001) epsmch - WRITE (*,*) 'N = ',n,' M = ',m + WRITE (*, 7001) epsmch + WRITE (*, *) 'N = ', n, ' M = ', m IF (iprint >= 1) THEN - WRITE (itfile,2001) epsmch - WRITE (itfile,*)'N = ',n,' M = ',m - WRITE (itfile,9001) + WRITE (itfile, 2001) epsmch + WRITE (itfile, *) 'N = ', n, ' M = ', m + WRITE (itfile, 9001) IF (iprint > 100) THEN - WRITE (*,1004) 'L =',(lower_bound(i),i = 1,n) - WRITE (*,1004) 'X0 =',(x(i),i = 1,n) - WRITE (*,1004) 'U =',(upper_bound(i),i = 1,n) + WRITE (*, 1004) 'L =', (lower_bound(i), i=1, n) + WRITE (*, 1004) 'X0 =', (x(i), i=1, n) + WRITE (*, 1004) 'U =', (upper_bound(i), i=1, n) END IF END IF END IF - 1004 FORMAT (/,a4, 1p, 6(1x,d11.4),/,(4x,1p,6(1x,d11.4))) - 2001 FORMAT ('RUNNING THE L-BFGS-B CODE',/,/, & - & 'it = iteration number',/, & - & 'nf = number of function evaluations',/, & - & 'nseg = number of segments explored during the Cauchy search',/,& - & 'nact = number of active bounds at the generalized Cauchy point'& - & ,/, & - & 'sub = manner in which the subspace minimization terminated:' & - & ,/,' con = converged, bnd = a bound was reached',/, & - & 'itls = number of iterations performed in the line search',/, & - & 'stepl = step length used',/, & - & 'tstep = norm of the displacement (total step)',/, & - & 'projg = norm of the projected gradient',/, & - & 'f = function value',/,/, & - & ' * * *',/,/, & - & 'Machine precision =',1p,d10.3) - 7001 FORMAT ('RUNNING THE L-BFGS-B CODE',/,/, & - & ' * * *',/,/, & - & 'Machine precision =',1p,d10.3) - 9001 FORMAT (/,3x,'it',3x,'nf',2x,'nseg',2x,'nact',2x,'sub',2x,'itls', & - 2x,'stepl',4x,'tstep',5x,'projg',8x,'f') +1004 FORMAT(/, a4, 1p, 6(1x, d11.4), /, (4x, 1p, 6(1x, d11.4))) +2001 FORMAT('RUNNING THE L-BFGS-B CODE', /, /, & + & 'it = iteration number', /, & + & 'nf = number of function evaluations', /, & + & 'nseg = number of segments explored during the Cauchy search', /,& + & 'nact = number of active bounds at the generalized Cauchy point'& + & , /, & + & 'sub = manner in which the subspace minimization terminated:' & + & , /, ' con = converged, bnd = a bound was reached', /, & + & 'itls = number of iterations performed in the line search', /, & + & 'stepl = step length used', /, & + & 'tstep = norm of the displacement (total step)', /, & + & 'projg = norm of the projected gradient', /, & + & 'f = function value', /, /, & + & ' * * *', /, /, & + & 'Machine precision =', 1p, d10.3) +7001 FORMAT('RUNNING THE L-BFGS-B CODE', /, /, & + & ' * * *', /, /, & + & 'Machine precision =', 1p, d10.3) +9001 FORMAT(/, 3x, 'it', 3x, 'nf', 2x, 'nseg', 2x, 'nact', 2x, 'sub', 2x, 'itls', & + 2x, 'stepl', 4x, 'tstep', 5x, 'projg', 8x, 'f') RETURN - END SUBROUTINE prn1lb + END SUBROUTINE prn1lb ! ************************************************************************************************** !> \brief This subroutine prints out new information after a successful line search. @@ -2547,8 +2543,8 @@ END SUBROUTINE prn1lb !> Ciyou Zhu !> in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal. ! ************************************************************************************************** - SUBROUTINE prn2lb(n, x, f, g, iprint, itfile, iter, nfgv, nact, & - g_inf_norm, nseg, word, iword, iback, stp, xstep) + SUBROUTINE prn2lb(n, x, f, g, iprint, itfile, iter, nfgv, nact, & + g_inf_norm, nseg, word, iword, iback, stp, xstep) INTEGER, INTENT(in) :: n REAL(KIND=dp), INTENT(in) :: x(n), f, g(n) @@ -2576,27 +2572,27 @@ SUBROUTINE prn2lb(n, x, f, g, iprint, itfile, iter, nfgv, nact, & word = '---' END IF IF (iprint >= 99) THEN - WRITE (*,*) 'LINE SEARCH',iback,' times; norm of step = ',xstep - WRITE (*,2001) iter,f,g_inf_norm + WRITE (*, *) 'LINE SEARCH', iback, ' times; norm of step = ', xstep + WRITE (*, 2001) iter, f, g_inf_norm IF (iprint > 100) THEN - WRITE (*,1004) 'X =',(x(i), i = 1, n) - WRITE (*,1004) 'G =',(g(i), i = 1, n) + WRITE (*, 1004) 'X =', (x(i), i=1, n) + WRITE (*, 1004) 'G =', (g(i), i=1, n) END IF ELSE IF (iprint > 0) THEN - imod = MOD(iter,iprint) - IF (imod == 0) WRITE (*,2001) iter,f,g_inf_norm + imod = MOD(iter, iprint) + IF (imod == 0) WRITE (*, 2001) iter, f, g_inf_norm END IF - IF (iprint >= 1) WRITE (itfile,3001) & - iter,nfgv,nseg,nact,word,iback,stp,xstep,g_inf_norm,f + IF (iprint >= 1) WRITE (itfile, 3001) & + iter, nfgv, nseg, nact, word, iback, stp, xstep, g_inf_norm, f - 1004 FORMAT (/,a4, 1p, 6(1x,d11.4),/,(4x,1p,6(1x,d11.4))) - 2001 FORMAT & - & (/,'At iterate',i5,4x,'f= ',1p,d12.5,4x,'|proj g|= ',1p,d12.5) - 3001 FORMAT(2(1x,i4),2(1x,i5),2x,a3,1x,i4,1p,2(2x,d7.1),1p,2(1x,d10.3)) +1004 FORMAT(/, a4, 1p, 6(1x, d11.4), /, (4x, 1p, 6(1x, d11.4))) +2001 FORMAT & + & (/, 'At iterate', i5, 4x, 'f= ', 1p, d12.5, 4x, '|proj g|= ', 1p, d12.5) +3001 FORMAT(2(1x, i4), 2(1x, i5), 2x, a3, 1x, i4, 1p, 2(2x, d7.1), 1p, 2(1x, d10.3)) RETURN - END SUBROUTINE prn2lb + END SUBROUTINE prn2lb ! ************************************************************************************************** !> \brief This subroutine prints out information when either a built-in @@ -2632,10 +2628,10 @@ END SUBROUTINE prn2lb !> Ciyou Zhu !> in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal. ! ************************************************************************************************** - SUBROUTINE prn3lb(n, x, f, task, iprint, info, itfile, & - iter, nfgv, nintol, nskip, nact, g_inf_norm, & - time, nseg, word, iback, stp, xstep, k, & - cachyt, sbtime, lnscht) + SUBROUTINE prn3lb(n, x, f, task, iprint, info, itfile, & + iter, nfgv, nintol, nskip, nact, g_inf_norm, & + time, nseg, word, iback, stp, xstep, k, & + cachyt, sbtime, lnscht) INTEGER, INTENT(in) :: n REAL(KIND=dp), INTENT(in) :: x(n), f @@ -2652,97 +2648,97 @@ SUBROUTINE prn3lb(n, x, f, task, iprint, info, itfile, & INTEGER :: i - IF (iprint >= 0.AND..NOT.(task(1:5) == 'ERROR')) THEN - WRITE(*,3003) - WRITE(*,3004) - WRITE(*,3005) n,iter,nfgv,nintol,nskip,nact,g_inf_norm,f + IF (iprint >= 0 .AND. .NOT. (task(1:5) == 'ERROR')) THEN + WRITE (*, 3003) + WRITE (*, 3004) + WRITE (*, 3005) n, iter, nfgv, nintol, nskip, nact, g_inf_norm, f IF (iprint >= 100) THEN - WRITE (*,1004) 'X =',(x(i),i = 1,n) + WRITE (*, 1004) 'X =', (x(i), i=1, n) END IF - IF (iprint >= 1) WRITE (*,*) ' F =',f + IF (iprint >= 1) WRITE (*, *) ' F =', f END IF IF (iprint >= 0) THEN - WRITE (*,3009) task + WRITE (*, 3009) task IF (info /= 0) THEN - IF (info == -1) WRITE (*,9011) - IF (info == -2) WRITE (*,9012) - IF (info == -3) WRITE (*,9013) - IF (info == -4) WRITE (*,9014) - IF (info == -5) WRITE (*,9015) - IF (info == -6) WRITE (*,*)' Input nbd(',k,') is invalid.' - IF (info == -7) & - WRITE (*,*)' l(',k,') > u(',k,'). No feasible solution.' - IF (info == -8) WRITE (*,9018) - IF (info == -9) WRITE (*,9019) + IF (info == -1) WRITE (*, 9011) + IF (info == -2) WRITE (*, 9012) + IF (info == -3) WRITE (*, 9013) + IF (info == -4) WRITE (*, 9014) + IF (info == -5) WRITE (*, 9015) + IF (info == -6) WRITE (*, *) ' Input nbd(', k, ') is invalid.' + IF (info == -7) & + WRITE (*, *) ' l(', k, ') > u(', k, '). No feasible solution.' + IF (info == -8) WRITE (*, 9018) + IF (info == -9) WRITE (*, 9019) END IF - IF (iprint >= 1) WRITE (*,3007) cachyt,sbtime,lnscht - WRITE (*,3008) time + IF (iprint >= 1) WRITE (*, 3007) cachyt, sbtime, lnscht + WRITE (*, 3008) time IF (iprint >= 1) THEN IF (info == -4 .OR. info == -9) THEN - WRITE (itfile,3002) & - iter,nfgv,nseg,nact,word,iback,stp,xstep + WRITE (itfile, 3002) & + iter, nfgv, nseg, nact, word, iback, stp, xstep END IF - WRITE (itfile,3009) task + WRITE (itfile, 3009) task IF (info /= 0) THEN - IF (info == -1) WRITE (itfile,9011) - IF (info == -2) WRITE (itfile,9012) - IF (info == -3) WRITE (itfile,9013) - IF (info == -4) WRITE (itfile,9014) - IF (info == -5) WRITE (itfile,9015) - IF (info == -8) WRITE (itfile,9018) - IF (info == -9) WRITE (itfile,9019) + IF (info == -1) WRITE (itfile, 9011) + IF (info == -2) WRITE (itfile, 9012) + IF (info == -3) WRITE (itfile, 9013) + IF (info == -4) WRITE (itfile, 9014) + IF (info == -5) WRITE (itfile, 9015) + IF (info == -8) WRITE (itfile, 9018) + IF (info == -9) WRITE (itfile, 9019) END IF - WRITE (itfile,3008) time + WRITE (itfile, 3008) time END IF END IF - 1004 FORMAT (/,a4, 1p, 6(1x,d11.4),/,(4x,1p,6(1x,d11.4))) - 3002 FORMAT(2(1x,i4),2(1x,i5),2x,a3,1x,i4,1p,2(2x,d7.1),6x,'-',10x,'-') - 3003 FORMAT (/, & - & ' * * *',/,/, & - & 'Tit = total number of iterations',/, & - & 'Tnf = total number of function evaluations',/, & - & 'Tnint = total number of segments explored during', & - & ' Cauchy searches',/, & - & 'Skip = number of BFGS updates skipped',/, & - & 'Nact = number of active bounds at final generalized', & - & ' Cauchy point',/, & - & 'Projg = norm of the final projected gradient',/, & - & 'F = final function value',/,/, & - & ' * * *') - 3004 FORMAT (/,3x,'N',4x,'Tit',5x,'Tnf',2x,'Tnint',2x, & - & 'Skip',2x,'Nact',5x,'Projg',8x,'F') - 3005 FORMAT (i5,2(1x,i6),(1x,i6),(2x,i4),(1x,i5),1p,2(2x,d10.3)) - 3007 FORMAT (/,' Cauchy time',1p,e10.3,' seconds.',/ & - & ' Subspace minimization time',1p,e10.3,' seconds.',/ & - & ' Line search time',1p,e10.3,' seconds.') - 3008 FORMAT (/,' Total User time',1p,e10.3,' seconds.',/) - 3009 FORMAT (/,a60) - 9011 FORMAT (/, & - &' Matrix in 1st Cholesky factorization in formk is not Pos. Def.') - 9012 FORMAT (/, & - &' Matrix in 2st Cholesky factorization in formk is not Pos. Def.') - 9013 FORMAT (/, & - &' Matrix in the Cholesky factorization in formt is not Pos. Def.') - 9014 FORMAT (/, & - &' Derivative >= 0, backtracking line search impossible.',/, & - &' Previous x, f and g restored.',/, & - &' Possible causes: 1 error in function or gradient evaluation;',/,& - &' 2 rounding errors dominate computation.') - 9015 FORMAT (/, & - &' Warning: more than 10 function and gradient',/, & - &' evaluations in the last line search. Termination',/, & - &' may possibly be caused by a bad search direction.') - 9018 FORMAT (/,' The triangular system is singular.') - 9019 FORMAT (/, & - &' Line search cannot locate an adequate point after 20 function',/& - &,' and gradient evaluations. Previous x, f and g restored.',/, & - &' Possible causes: 1 error in function or gradient evaluation;',/,& - &' 2 rounding error dominate computation.') +1004 FORMAT(/, a4, 1p, 6(1x, d11.4), /, (4x, 1p, 6(1x, d11.4))) +3002 FORMAT(2(1x, i4), 2(1x, i5), 2x, a3, 1x, i4, 1p, 2(2x, d7.1), 6x, '-', 10x, '-') +3003 FORMAT(/, & + & ' * * *', /, /, & + & 'Tit = total number of iterations', /, & + & 'Tnf = total number of function evaluations', /, & + & 'Tnint = total number of segments explored during', & + & ' Cauchy searches', /, & + & 'Skip = number of BFGS updates skipped', /, & + & 'Nact = number of active bounds at final generalized', & + & ' Cauchy point', /, & + & 'Projg = norm of the final projected gradient', /, & + & 'F = final function value', /, /, & + & ' * * *') +3004 FORMAT(/, 3x, 'N', 4x, 'Tit', 5x, 'Tnf', 2x, 'Tnint', 2x, & + & 'Skip', 2x, 'Nact', 5x, 'Projg', 8x, 'F') +3005 FORMAT(i5, 2(1x, i6), (1x, i6), (2x, i4), (1x, i5), 1p, 2(2x, d10.3)) +3007 FORMAT(/, ' Cauchy time', 1p, e10.3, ' seconds.', / & + & ' Subspace minimization time', 1p, e10.3, ' seconds.', / & + & ' Line search time', 1p, e10.3, ' seconds.') +3008 FORMAT(/, ' Total User time', 1p, e10.3, ' seconds.',/) +3009 FORMAT(/, a60) +9011 FORMAT(/, & + &' Matrix in 1st Cholesky factorization in formk is not Pos. Def.') +9012 FORMAT(/, & + &' Matrix in 2st Cholesky factorization in formk is not Pos. Def.') +9013 FORMAT(/, & + &' Matrix in the Cholesky factorization in formt is not Pos. Def.') +9014 FORMAT(/, & + &' Derivative >= 0, backtracking line search impossible.', /, & + &' Previous x, f and g restored.', /, & + &' Possible causes: 1 error in function or gradient evaluation;', /,& + &' 2 rounding errors dominate computation.') +9015 FORMAT(/, & + &' Warning: more than 10 function and gradient', /, & + &' evaluations in the last line search. Termination', /, & + &' may possibly be caused by a bad search direction.') +9018 FORMAT(/, ' The triangular system is singular.') +9019 FORMAT(/, & + &' Line search cannot locate an adequate point after 20 function', /& + &, ' and gradient evaluations. Previous x, f and g restored.', /, & + &' Possible causes: 1 error in function or gradient evaluation;', /,& + &' 2 rounding error dominate computation.') RETURN - END SUBROUTINE prn3lb + END SUBROUTINE prn3lb ! ************************************************************************************************** !> \brief This subroutine computes the infinity norm of the projected gradient. @@ -2760,7 +2756,7 @@ END SUBROUTINE prn3lb !> Ciyou Zhu !> in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal. ! ************************************************************************************************** - SUBROUTINE projgr(n, lower_bound, upper_bound, nbd, x, g, g_inf_norm) + SUBROUTINE projgr(n, lower_bound, upper_bound, nbd, x, g, g_inf_norm) INTEGER, INTENT(in) :: n REAL(KIND=dp), INTENT(in) :: lower_bound(n), upper_bound(n) @@ -2773,22 +2769,22 @@ SUBROUTINE projgr(n, lower_bound, upper_bound, nbd, x, g, g_inf_norm) INTEGER :: i REAL(KIND=dp) :: gi - g_inf_norm=zero + g_inf_norm = zero DO i = 1, n - gi = g(i) - IF (nbd(i) /= 0) THEN - IF (gi < zero) THEN - IF (nbd(i) >= 2) gi = MAX((x(i)-upper_bound(i)),gi) - ELSE - IF (nbd(i) <= 2) gi = MIN((x(i)-lower_bound(i)),gi) - END IF - END IF - g_inf_norm = MAX(g_inf_norm,ABS(gi)) + gi = g(i) + IF (nbd(i) /= 0) THEN + IF (gi < zero) THEN + IF (nbd(i) >= 2) gi = MAX((x(i) - upper_bound(i)), gi) + ELSE + IF (nbd(i) <= 2) gi = MIN((x(i) - lower_bound(i)), gi) + END IF + END IF + g_inf_norm = MAX(g_inf_norm, ABS(gi)) END DO RETURN - END SUBROUTINE projgr + END SUBROUTINE projgr ! ************************************************************************************************** !> \brief This routine contains the major changes in the updated version. @@ -2895,9 +2891,9 @@ END SUBROUTINE projgr !> Ciyou Zhu !> in collaboration with R.H. Byrd, P. Lu-Chen and J. Nocedal. ! ************************************************************************************************** - SUBROUTINE subsm ( n, m, nsub, ind, lower_bound, upper_bound, nbd, x, d, xp, ws, wy, & - theta, xx, gg, & - col, head, iword, wv, wn, iprint, info ) + SUBROUTINE subsm(n, m, nsub, ind, lower_bound, upper_bound, nbd, x, d, xp, ws, wy, & + theta, xx, gg, & + col, head, iword, wv, wn, iprint, info) INTEGER, INTENT(in) :: n, m, nsub, ind(nsub) REAL(KIND=dp), INTENT(in) :: lower_bound(n), upper_bound(n) INTEGER, INTENT(in) :: nbd(n) @@ -2928,7 +2924,7 @@ SUBROUTINE subsm ( n, m, nsub, ind, lower_bound, upper_bound, nbd, x, d, xp, ws, ! IF (nsub <= 0) RETURN - IF (iprint >= 99) WRITE (*,1001) + IF (iprint >= 99) WRITE (*, 1001) ! Compute wv = W'Zd. @@ -2938,24 +2934,24 @@ SUBROUTINE subsm ( n, m, nsub, ind, lower_bound, upper_bound, nbd, x, d, xp, ws, temp2 = zero DO j = 1, nsub k = ind(j) - temp1 = temp1 + wy(k,pointr)*d(j) - temp2 = temp2 + ws(k,pointr)*d(j) + temp1 = temp1 + wy(k, pointr)*d(j) + temp2 = temp2 + ws(k, pointr)*d(j) END DO wv(i) = temp1 wv(col + i) = theta*temp2 - pointr = MOD(pointr,m) + 1 + pointr = MOD(pointr, m) + 1 END DO ! Compute wv:=K^(-1)wv. m2 = 2*m col2 = 2*col - CALL dtrsl(wn,m2,col2,wv,11,info) + CALL dtrsl(wn, m2, col2, wv, 11, info) IF (info /= 0) RETURN DO i = 1, col wv(i) = -wv(i) END DO - CALL dtrsl(wn,m2,col2,wv,01,info) + CALL dtrsl(wn, m2, col2, wv, 01, info) IF (info /= 0) RETURN ! Compute d = (1/theta)d + (1/theta**2)Z'W wv. @@ -2965,121 +2961,121 @@ SUBROUTINE subsm ( n, m, nsub, ind, lower_bound, upper_bound, nbd, x, d, xp, ws, js = col + jy DO i = 1, nsub k = ind(i) - d(i) = d(i) + wy(k,pointr)*wv(jy)/theta & - & + ws(k,pointr)*wv(js) + d(i) = d(i) + wy(k, pointr)*wv(jy)/theta & + & + ws(k, pointr)*wv(js) END DO - pointr = MOD(pointr,m) + 1 + pointr = MOD(pointr, m) + 1 END DO - CALL dscal( nsub, one/theta, d, 1 ) + CALL dscal(nsub, one/theta, d, 1) ! !----------------------------------------------------------------- ! Let us try the projection, d is the Newton direction iword = 0 - CALL dcopy ( n, x, 1, xp, 1 ) + CALL dcopy(n, x, 1, xp, 1) ! - DO i=1, nsub - k = ind(i) + DO i = 1, nsub + k = ind(i) dk = d(i) xk = x(k) - IF ( nbd(k) /= 0 ) THEN + IF (nbd(k) /= 0) THEN ! - ! lower bounds only - IF ( nbd(k).EQ.1 ) THEN - x(k) = MAX( lower_bound(k), xk + dk ) - IF ( x(k).EQ.lower_bound(k) ) iword = 1 + ! lower bounds only + IF (nbd(k) .EQ. 1) THEN + x(k) = MAX(lower_bound(k), xk + dk) + IF (x(k) .EQ. lower_bound(k)) iword = 1 ELSE ! - ! upper and lower bounds - IF ( nbd(k).EQ.2 ) THEN - xk = MAX( lower_bound(k), xk + dk ) - x(k) = MIN( upper_bound(k), xk ) - IF ( x(k).EQ.lower_bound(k) .OR. x(k).EQ.upper_bound(k) ) iword = 1 + ! upper and lower bounds + IF (nbd(k) .EQ. 2) THEN + xk = MAX(lower_bound(k), xk + dk) + x(k) = MIN(upper_bound(k), xk) + IF (x(k) .EQ. lower_bound(k) .OR. x(k) .EQ. upper_bound(k)) iword = 1 ELSE ! - ! upper bounds only - IF ( nbd(k).EQ.3 ) THEN - x(k) = MIN( upper_bound(k), xk + dk ) - IF ( x(k).EQ.upper_bound(k) ) iword = 1 + ! upper bounds only + IF (nbd(k) .EQ. 3) THEN + x(k) = MIN(upper_bound(k), xk + dk) + IF (x(k) .EQ. upper_bound(k)) iword = 1 END IF END IF END IF ! - ! free variables + ! free variables ELSE x(k) = xk + dk END IF END DO ! - IF ( .NOT.(iword.EQ.0) ) THEN + IF (.NOT. (iword .EQ. 0)) THEN ! ! check sign of the directional derivative ! - dd_p = zero - DO i=1, n - dd_p = dd_p + (x(i) - xx(i))*gg(i) - END DO - IF ( dd_p .GT.zero ) THEN - CALL dcopy( n, xp, 1, x, 1 ) - IF(iprint >0) WRITE(*,*) ' Positive dir derivative in projection ' - IF(iprint >0) WRITE(*,*) ' Using the backtracking step ' - alpha = one - temp1 = alpha - ibd = 0 - DO i = 1, nsub - k = ind(i) - dk = d(i) - IF (nbd(k) /= 0) THEN - IF (dk < zero .AND. nbd(k) <= 2) THEN - temp2 = lower_bound(k) - x(k) - IF (temp2 >= zero) THEN - temp1 = zero - ELSE IF (dk*alpha < temp2) THEN - temp1 = temp2/dk + dd_p = zero + DO i = 1, n + dd_p = dd_p + (x(i) - xx(i))*gg(i) + END DO + IF (dd_p .GT. zero) THEN + CALL dcopy(n, xp, 1, x, 1) + IF (iprint > 0) WRITE (*, *) ' Positive dir derivative in projection ' + IF (iprint > 0) WRITE (*, *) ' Using the backtracking step ' + alpha = one + temp1 = alpha + ibd = 0 + DO i = 1, nsub + k = ind(i) + dk = d(i) + IF (nbd(k) /= 0) THEN + IF (dk < zero .AND. nbd(k) <= 2) THEN + temp2 = lower_bound(k) - x(k) + IF (temp2 >= zero) THEN + temp1 = zero + ELSE IF (dk*alpha < temp2) THEN + temp1 = temp2/dk + END IF + ELSE IF (dk > zero .AND. nbd(k) >= 2) THEN + temp2 = upper_bound(k) - x(k) + IF (temp2 <= zero) THEN + temp1 = zero + ELSE IF (dk*alpha > temp2) THEN + temp1 = temp2/dk + END IF END IF - ELSE IF (dk > zero .AND. nbd(k) >= 2) THEN - temp2 = upper_bound(k) - x(k) - IF (temp2 <= zero) THEN - temp1 = zero - ELSE IF (dk*alpha > temp2) THEN - temp1 = temp2/dk + IF (temp1 < alpha) THEN + alpha = temp1 + ibd = i END IF END IF - IF (temp1 < alpha) THEN - alpha = temp1 - ibd = i - END IF - END IF - END DO + END DO - IF (alpha < one) THEN - dk = d(ibd) - k = ind(ibd) - IF (dk > zero) THEN - x(k) = upper_bound(k) - d(ibd) = zero - ELSE IF (dk < zero) THEN - x(k) = lower_bound(k) - d(ibd) = zero + IF (alpha < one) THEN + dk = d(ibd) + k = ind(ibd) + IF (dk > zero) THEN + x(k) = upper_bound(k) + d(ibd) = zero + ELSE IF (dk < zero) THEN + x(k) = lower_bound(k) + d(ibd) = zero + END IF END IF + DO i = 1, nsub + k = ind(i) + x(k) = x(k) + alpha*d(i) + END DO END IF - DO i = 1, nsub - k = ind(i) - x(k) = x(k) + alpha*d(i) - END DO - END IF END IF - IF (iprint >= 99) WRITE (*,1004) + IF (iprint >= 99) WRITE (*, 1004) - 1001 FORMAT (/,'----------------SUBSM entered-----------------',/) - 1004 FORMAT (/,'----------------exit SUBSM --------------------',/) +1001 FORMAT(/, '----------------SUBSM entered-----------------',/) +1004 FORMAT(/, '----------------exit SUBSM --------------------',/) RETURN - END SUBROUTINE subsm + END SUBROUTINE subsm ! ************************************************************************************************** !> \brief This subroutine finds a step that satisfies a sufficient @@ -3167,8 +3163,8 @@ END SUBROUTINE subsm !> \param isave is work array !> \param dsave is a work array ! ************************************************************************************************** - SUBROUTINE dcsrch(f,g,stp,ftol,gtol,xtol,stpmin,stpmax, & - task,isave,dsave) + SUBROUTINE dcsrch(f, g, stp, ftol, gtol, xtol, stpmin, stpmax, & + task, isave, dsave) REAL(KIND=dp) :: f, g REAL(KIND=dp), INTENT(inout) :: stp REAL(KIND=dp) :: ftol, gtol, xtol, stpmin, stpmax @@ -3273,102 +3269,100 @@ SUBROUTINE dcsrch(f,g,stp,ftol,gtol,xtol,stpmin,stpmax, & ! algorithm enters the second stage. ftest = finit + stp*gtest - IF (stage == 1 .AND. f <= ftest .AND. g >= zero) & + IF (stage == 1 .AND. f <= ftest .AND. g >= zero) & stage = 2 ! Test for warnings. - IF (brackt .AND. (stp <= stmin .OR. stp >= stmax)) & + IF (brackt .AND. (stp <= stmin .OR. stp >= stmax)) & task = 'WARNING: ROUNDING ERRORS PREVENT PROGRESS' - IF (brackt .AND. stmax - stmin <= xtol*stmax) & + IF (brackt .AND. stmax - stmin <= xtol*stmax) & task = 'WARNING: XTOL TEST SATISFIED' - IF (stp == stpmax .AND. f <= ftest .AND. g <= gtest) & + IF (stp == stpmax .AND. f <= ftest .AND. g <= gtest) & task = 'WARNING: STP = STPMAX' - IF (stp == stpmin .AND. (f > ftest .OR. g >= gtest)) & + IF (stp == stpmin .AND. (f > ftest .OR. g >= gtest)) & task = 'WARNING: STP = STPMIN' ! Test for convergence. - IF (f <= ftest .AND. ABS(g) <= gtol*(-ginit)) & + IF (f <= ftest .AND. ABS(g) <= gtol*(-ginit)) & task = 'CONVERGENCE' ! Test for termination. - - - IF (.NOT.(task(1:4) == 'WARN' .OR. task(1:4) == 'CONV')) THEN + IF (.NOT. (task(1:4) == 'WARN' .OR. task(1:4) == 'CONV')) THEN ! A modified function is used to predict the step during the ! first stage if a lower function value has been obtained but ! the decrease is not sufficient. - IF (stage == 1 .AND. f <= fx .AND. f > ftest) THEN + IF (stage == 1 .AND. f <= fx .AND. f > ftest) THEN ! Define the modified function and derivative values. - fm = f - stp*gtest - fxm = fx - stx*gtest - fym = fy - sty*gtest - gm = g - gtest - gxm = gx - gtest - gym = gy - gtest + fm = f - stp*gtest + fxm = fx - stx*gtest + fym = fy - sty*gtest + gm = g - gtest + gxm = gx - gtest + gym = gy - gtest ! Call dcstep to update stx, sty, and to compute the new step. - CALL dcstep(stx,fxm,gxm,sty,fym,gym,stp,fm,gm, & - brackt,stmin,stmax) + CALL dcstep(stx, fxm, gxm, sty, fym, gym, stp, fm, gm, & + brackt, stmin, stmax) ! Reset the function and derivative values for f. - fx = fxm + stx*gtest - fy = fym + sty*gtest - gx = gxm + gtest - gy = gym + gtest + fx = fxm + stx*gtest + fy = fym + sty*gtest + gx = gxm + gtest + gy = gym + gtest - ELSE + ELSE ! Call dcstep to update stx, sty, and to compute the new step. - CALL dcstep(stx,fx,gx,sty,fy,gy,stp,f,g, & - brackt,stmin,stmax) + CALL dcstep(stx, fx, gx, sty, fy, gy, stp, f, g, & + brackt, stmin, stmax) - END IF + END IF ! Decide if a bisection step is needed. - IF (brackt) THEN - IF (ABS(sty-stx) >= p66*width1) stp = stx + p5*(sty - stx) - width1 = width - width = ABS(sty-stx) - END IF + IF (brackt) THEN + IF (ABS(sty - stx) >= p66*width1) stp = stx + p5*(sty - stx) + width1 = width + width = ABS(sty - stx) + END IF ! Set the minimum and maximum steps allowed for stp. - IF (brackt) THEN - stmin = MIN(stx,sty) - stmax = MAX(stx,sty) - ELSE - stmin = stp + xtrapl*(stp - stx) - stmax = stp + xtrapu*(stp - stx) - END IF + IF (brackt) THEN + stmin = MIN(stx, sty) + stmax = MAX(stx, sty) + ELSE + stmin = stp + xtrapl*(stp - stx) + stmax = stp + xtrapu*(stp - stx) + END IF ! Force the step to be within the bounds stpmax and stpmin. - stp = MAX(stp,stpmin) - stp = MIN(stp,stpmax) + stp = MAX(stp, stpmin) + stp = MIN(stp, stpmax) ! If further progress is not possible, let stp be the best ! point obtained during the search. - IF (brackt .AND. (stp <= stmin .OR. stp >= stmax) & - .OR. (brackt .AND. stmax-stmin <= xtol*stmax)) stp = stx + IF (brackt .AND. (stp <= stmin .OR. stp >= stmax) & + .OR. (brackt .AND. stmax - stmin <= xtol*stmax)) stp = stx ! Obtain another function and derivative. - task = 'FG' + task = 'FG' - ENDIF - ENDIF + ENDIF + ENDIF ! Save local variables. @@ -3378,22 +3372,22 @@ SUBROUTINE dcsrch(f,g,stp,ftol,gtol,xtol,stpmin,stpmax, & isave(1) = 0 END IF isave(2) = stage - dsave(1) = ginit - dsave(2) = gtest - dsave(3) = gx - dsave(4) = gy - dsave(5) = finit - dsave(6) = fx - dsave(7) = fy - dsave(8) = stx - dsave(9) = sty + dsave(1) = ginit + dsave(2) = gtest + dsave(3) = gx + dsave(4) = gy + dsave(5) = finit + dsave(6) = fx + dsave(7) = fy + dsave(8) = stx + dsave(9) = sty dsave(10) = stmin dsave(11) = stmax dsave(12) = width dsave(13) = width1 RETURN - END SUBROUTINE dcsrch + END SUBROUTINE dcsrch ! ************************************************************************************************** !> \brief This subroutine computes a safeguarded step for a search @@ -3438,8 +3432,8 @@ END SUBROUTINE dcsrch !> \param stpmin stpmin is a lower bound for the step. !> \param stpmax stpmax is an upper bound for the step. ! ************************************************************************************************** - SUBROUTINE dcstep(stx,fx,dx,sty,fy,dy,stp,fp,dp_loc,brackt, & - stpmin,stpmax) + SUBROUTINE dcstep(stx, fx, dx, sty, fy, dy, stp, fp, dp_loc, brackt, & + stpmin, stpmax) REAL(KIND=dp), INTENT(inout) :: stx, fx, dx, sty, fy, dy, stp REAL(KIND=dp), INTENT(in) :: fp, dp_loc LOGICAL, INTENT(inout) :: brackt @@ -3462,7 +3456,7 @@ SUBROUTINE dcstep(stx,fx,dx,sty,fy,dy,stp,fp,dp_loc,brackt, & ! ! ********** - sgnd = dp_loc*SIGN(1.0_dp,dx) + sgnd = dp_loc*SIGN(1.0_dp, dx) ! First case: A higher function value. The minimum is bracketed. ! If the cubic step is closer to stx than the quadratic step, the @@ -3471,7 +3465,7 @@ SUBROUTINE dcstep(stx,fx,dx,sty,fy,dy,stp,fp,dp_loc,brackt, & IF (fp > fx) THEN theta = three*(fx - fp)/(stp - stx) + dx + dp_loc - s = MAX(ABS(theta),ABS(dx),ABS(dp_loc)) + s = MAX(ABS(theta), ABS(dx), ABS(dp_loc)) gamma = s*SQRT((theta/s)**2 - (dx/s)*(dp_loc/s)) IF (stp < stx) gamma = -gamma p = (gamma - dx) + theta @@ -3480,7 +3474,7 @@ SUBROUTINE dcstep(stx,fx,dx,sty,fy,dy,stp,fp,dp_loc,brackt, & stpc = stx + r*(stp - stx) stpq = stx + ((dx/((fx - fp)/(stp - stx) + dx))/two)* & & (stp - stx) - IF (ABS(stpc-stx) < ABS(stpq-stx)) THEN + IF (ABS(stpc - stx) < ABS(stpq - stx)) THEN stpf = stpc ELSE stpf = stpc + (stpq - stpc)/two @@ -3494,7 +3488,7 @@ SUBROUTINE dcstep(stx,fx,dx,sty,fy,dy,stp,fp,dp_loc,brackt, & ELSE IF (sgnd < zero) THEN theta = three*(fx - fp)/(stp - stx) + dx + dp_loc - s = MAX(ABS(theta),ABS(dx),ABS(dp_loc)) + s = MAX(ABS(theta), ABS(dx), ABS(dp_loc)) gamma = s*SQRT((theta/s)**2 - (dx/s)*(dp_loc/s)) IF (stp > stx) gamma = -gamma p = (gamma - dp_loc) + theta @@ -3502,7 +3496,7 @@ SUBROUTINE dcstep(stx,fx,dx,sty,fy,dy,stp,fp,dp_loc,brackt, & r = p/q stpc = stp + r*(stx - stp) stpq = stp + (dp_loc/(dp_loc - dx))*(stx - stp) - IF (ABS(stpc-stp) > ABS(stpq-stp)) THEN + IF (ABS(stpc - stp) > ABS(stpq - stp)) THEN stpf = stpc ELSE stpf = stpq @@ -3520,12 +3514,12 @@ SUBROUTINE dcstep(stx,fx,dx,sty,fy,dy,stp,fp,dp_loc,brackt, & ! secant step. theta = three*(fx - fp)/(stp - stx) + dx + dp_loc - s = MAX(ABS(theta),ABS(dx),ABS(dp_loc)) + s = MAX(ABS(theta), ABS(dx), ABS(dp_loc)) ! The case gamma = 0 only arises if the cubic does not tend ! to infinity in the direction of the step. - gamma = s*SQRT(MAX(zero,(theta/s)**2-(dx/s)*(dp_loc/s))) + gamma = s*SQRT(MAX(zero, (theta/s)**2 - (dx/s)*(dp_loc/s))) IF (stp > stx) gamma = -gamma p = (gamma - dp_loc) + theta q = (gamma + (dx - dp_loc)) + gamma @@ -3545,15 +3539,15 @@ SUBROUTINE dcstep(stx,fx,dx,sty,fy,dy,stp,fp,dp_loc,brackt, & ! closer to stp than the secant step, the cubic step is ! taken, otherwise the secant step is taken. - IF (ABS(stpc-stp) < ABS(stpq-stp)) THEN + IF (ABS(stpc - stp) < ABS(stpq - stp)) THEN stpf = stpc ELSE stpf = stpq END IF IF (stp > stx) THEN - stpf = MIN(stp+p66*(sty-stp),stpf) + stpf = MIN(stp + p66*(sty - stp), stpf) ELSE - stpf = MAX(stp+p66*(sty-stp),stpf) + stpf = MAX(stp + p66*(sty - stp), stpf) END IF ELSE @@ -3561,13 +3555,13 @@ SUBROUTINE dcstep(stx,fx,dx,sty,fy,dy,stp,fp,dp_loc,brackt, & ! farther from stp than the secant step, the cubic step is ! taken, otherwise the secant step is taken. - IF (ABS(stpc-stp) > ABS(stpq-stp)) THEN + IF (ABS(stpc - stp) > ABS(stpq - stp)) THEN stpf = stpc ELSE stpf = stpq END IF - stpf = MIN(stpmax,stpf) - stpf = MAX(stpmin,stpf) + stpf = MIN(stpmax, stpf) + stpf = MAX(stpmin, stpf) END IF ! Fourth case: A lower function value, derivatives of the same sign, @@ -3578,7 +3572,7 @@ SUBROUTINE dcstep(stx,fx,dx,sty,fy,dy,stp,fp,dp_loc,brackt, & ELSE IF (brackt) THEN theta = three*(fp - fy)/(sty - stp) + dy + dp_loc - s = MAX(ABS(theta),ABS(dy),ABS(dp_loc)) + s = MAX(ABS(theta), ABS(dy), ABS(dp_loc)) gamma = s*SQRT((theta/s)**2 - (dy/s)*(dp_loc/s)) IF (stp > sty) gamma = -gamma p = (gamma - dp_loc) + theta @@ -3615,7 +3609,7 @@ SUBROUTINE dcstep(stx,fx,dx,sty,fy,dy,stp,fp,dp_loc,brackt, & stp = stpf RETURN - END SUBROUTINE dcstep + END SUBROUTINE dcstep !MK LINPACK @@ -3639,9 +3633,9 @@ END SUBROUTINE dcstep !> = k signals an error condition. the leading minor !> of order k is not positive definite. ! ************************************************************************************************** - SUBROUTINE dpofa(a,lda,n,info) + SUBROUTINE dpofa(a, lda, n, info) INTEGER, INTENT(in) :: lda - REAL(KIND=dp) :: a(lda,*) + REAL(KIND=dp) :: a(lda, *) INTEGER, INTENT(in) :: n INTEGER :: info @@ -3656,26 +3650,26 @@ SUBROUTINE dpofa(a,lda,n,info) ! ! - DO j = 1, n - info = j - s = 0.0_dp - jm1 = j - 1 - IF (.NOT.(jm1 < 1)) THEN - DO k = 1, jm1 - t = a(k,j) - ddot(k-1,a(1,k),1,a(1,j),1) - t = t/a(k,k) - a(k,j) = t - s = s + t*t - END DO - END IF - s = a(j,j) - s + DO j = 1, n + info = j + s = 0.0_dp + jm1 = j - 1 + IF (.NOT. (jm1 < 1)) THEN + DO k = 1, jm1 + t = a(k, j) - ddot(k - 1, a(1, k), 1, a(1, j), 1) + t = t/a(k, k) + a(k, j) = t + s = s + t*t + END DO + END IF + s = a(j, j) - s ! ......exit - IF (s <= 0.0_dp) EXIT - a(j,j) = SQRT(s) - info=0 - END DO + IF (s <= 0.0_dp) EXIT + a(j, j) = SQRT(s) + info = 0 + END DO RETURN - END SUBROUTINE dpofa + END SUBROUTINE dpofa ! ************************************************************************************************** !> \brief dtrsl solves systems of the form @@ -3707,9 +3701,9 @@ END SUBROUTINE dpofa !> otherwise info contains the index of !> the first zero diagonal element of t. ! ************************************************************************************************** - SUBROUTINE dtrsl(t,ldt,n,b,job,info) + SUBROUTINE dtrsl(t, ldt, n, b, job, info) INTEGER, INTENT(in) :: ldt - REAL(KIND=dp), INTENT(in) :: t(ldt,*) + REAL(KIND=dp), INTENT(in) :: t(ldt, *) INTEGER, INTENT(in) :: n REAL(KIND=dp), INTENT(inout) :: b(*) INTEGER, INTENT(in) :: job @@ -3728,83 +3722,83 @@ SUBROUTINE dtrsl(t,ldt,n,b,job,info) ! check for zero diagonal elements. ! - DO info = 1, n + DO info = 1, n ! ......exit - IF (t(info,info) == 0.0_dp) RETURN - END DO - info = 0 + IF (t(info, info) == 0.0_dp) RETURN + END DO + info = 0 ! ! determine the task and go to it. ! - CASE = 1 - IF (MOD(job,10) /= 0) CASE = 2 - IF (MOD(job,100)/10 /= 0) CASE = CASE + 2 + CASE = 1 + IF (MOD(job, 10) /= 0) CASE = 2 + IF (MOD(job, 100)/10 /= 0) CASE = CASE + 2 - SELECT CASE(CASE) - CASE(1) + SELECT CASE (CASE) + CASE (1) ! ! solve t*x=b for t lower triangular ! - b(1) = b(1)/t(1,1) - IF (n>1) THEN - DO j = 2, n - temp = -b(j-1) - CALL daxpy(n-j+1,temp,t(j,j-1),1,b(j),1) - b(j) = b(j)/t(j,j) - END DO - END IF - CASE(2) + b(1) = b(1)/t(1, 1) + IF (n > 1) THEN + DO j = 2, n + temp = -b(j - 1) + CALL daxpy(n - j + 1, temp, t(j, j - 1), 1, b(j), 1) + b(j) = b(j)/t(j, j) + END DO + END IF + CASE (2) ! ! solve t*x=b for t upper triangular. ! - b(n) = b(n)/t(n,n) - IF (n>1) THEN - DO jj = 2, n - j = n - jj + 1 - temp = -b(j+1) - CALL daxpy(j,temp,t(1,j+1),1,b(1),1) - b(j) = b(j)/t(j,j) - END DO - END IF - CASE(3) + b(n) = b(n)/t(n, n) + IF (n > 1) THEN + DO jj = 2, n + j = n - jj + 1 + temp = -b(j + 1) + CALL daxpy(j, temp, t(1, j + 1), 1, b(1), 1) + b(j) = b(j)/t(j, j) + END DO + END IF + CASE (3) ! ! solve trans(t)*x=b for t lower triangular. ! - b(n) = b(n)/t(n,n) - IF (n>1) THEN - DO jj = 2, n - j = n - jj + 1 - b(j) = b(j) - ddot(jj-1,t(j+1,j),1,b(j+1),1) - b(j) = b(j)/t(j,j) - END DO - END IF - CASE(4) + b(n) = b(n)/t(n, n) + IF (n > 1) THEN + DO jj = 2, n + j = n - jj + 1 + b(j) = b(j) - ddot(jj - 1, t(j + 1, j), 1, b(j + 1), 1) + b(j) = b(j)/t(j, j) + END DO + END IF + CASE (4) ! ! solve trans(t)*x=b for t upper triangular. ! - b(1) = b(1)/t(1,1) - IF (.NOT.(n < 2)) THEN - DO j = 2, n - b(j) = b(j) - ddot(j-1,t(1,j),1,b(1),1) - b(j) = b(j)/t(j,j) - END DO - END IF - CASE DEFAULT - CPABORT("unexpected case") - END SELECT + b(1) = b(1)/t(1, 1) + IF (.NOT. (n < 2)) THEN + DO j = 2, n + b(j) = b(j) - ddot(j - 1, t(1, j), 1, b(1), 1) + b(j) = b(j)/t(j, j) + END DO + END IF + CASE DEFAULT + CPABORT("unexpected case") + END SELECT RETURN - END SUBROUTINE dtrsl + END SUBROUTINE dtrsl !MK Timer -! ************************************************************************************************** +! ************************************************************************************************** !> \brief This routine computes cpu time in double precision; it makes use o !> the intrinsic f90 cpu_time therefore a conversion type is !> needed. !> \param ttime ... ! ************************************************************************************************** - SUBROUTINE timer(ttime) + SUBROUTINE timer(ttime) REAL(KIND=dp) :: ttime ! @@ -3824,11 +3818,11 @@ SUBROUTINE timer(ttime) !MK CALL cpu_time(temp) !MK ttime = REAL(temp, KIND=dp) - ttime = m_walltime() + ttime = m_walltime() - END SUBROUTINE timer + END SUBROUTINE timer -! ************************************************************************************************** +! ************************************************************************************************** !> \brief Saves the lcoal variables, long term this should be replaces by a lbfgs type !> \param lsave lsave is a working array !> On exit with 'task' = NEW_X, the following information is available: @@ -3914,8 +3908,8 @@ END SUBROUTINE timer ! ************************************************************************************************** SUBROUTINE save_local(lsave,isave,dsave,x_projected,constrained,boxed,updatd,nintol,itfile,iback,nskip,head,col,itail,& - iter,iupdat,nseg,nfgv,info,ifun,iword,nfree,nact,ileave,nenter,theta,fold,tol,dnorm,epsmch,cpu1,& - cachyt,sbtime,lnscht,time1,gd,step_max,g_inf_norm,stp,gdold,dtd) + iter, iupdat, nseg, nfgv, info, ifun, iword, nfree, nact, ileave, nenter, theta, fold, tol, dnorm, epsmch, cpu1, & + cachyt, sbtime, lnscht, time1, gd, step_max, g_inf_norm, stp, gdold, dtd) LOGICAL, INTENT(out) :: lsave(4) INTEGER, INTENT(out) :: isave(23) REAL(KIND=dp), INTENT(out) :: dsave(29) @@ -3928,19 +3922,19 @@ SUBROUTINE save_local(lsave,isave,dsave,x_projected,constrained,boxed,updatd,nin cachyt, sbtime, lnscht, time1, gd, & step_max, g_inf_norm, stp, gdold, dtd - lsave(1) = x_projected - lsave(2) = constrained - lsave(3) = boxed - lsave(4) = updatd - - isave(1) = nintol - isave(3) = itfile - isave(4) = iback - isave(5) = nskip - isave(6) = head - isave(7) = col - isave(8) = itail - isave(9) = iter + lsave(1) = x_projected + lsave(2) = constrained + lsave(3) = boxed + lsave(4) = updatd + + isave(1) = nintol + isave(3) = itfile + isave(4) = iback + isave(5) = nskip + isave(6) = head + isave(7) = col + isave(8) = itail + isave(9) = iter isave(10) = iupdat isave(12) = nseg isave(13) = nfgv @@ -3952,15 +3946,15 @@ SUBROUTINE save_local(lsave,isave,dsave,x_projected,constrained,boxed,updatd,nin isave(19) = ileave isave(20) = nenter - dsave(1) = theta - dsave(2) = fold - dsave(3) = tol - dsave(4) = dnorm - dsave(5) = epsmch - dsave(6) = cpu1 - dsave(7) = cachyt - dsave(8) = sbtime - dsave(9) = lnscht + dsave(1) = theta + dsave(2) = fold + dsave(3) = tol + dsave(4) = dnorm + dsave(5) = epsmch + dsave(6) = cpu1 + dsave(7) = cachyt + dsave(8) = sbtime + dsave(9) = lnscht dsave(10) = time1 dsave(11) = gd dsave(12) = step_max @@ -3969,6 +3963,6 @@ SUBROUTINE save_local(lsave,isave,dsave,x_projected,constrained,boxed,updatd,nin dsave(15) = gdold dsave(16) = dtd - END SUBROUTINE save_local + END SUBROUTINE save_local END MODULE cp_lbfgs diff --git a/src/motion/cp_lbfgs_geo.F b/src/motion/cp_lbfgs_geo.F index 602a61e4ee..c0461fccce 100644 --- a/src/motion/cp_lbfgs_geo.F +++ b/src/motion/cp_lbfgs_geo.F @@ -107,7 +107,7 @@ RECURSIVE SUBROUTINE geoopt_lbfgs(force_env, gopt_param, globenv, geo_section, g CALL cp_iterate(logger%iter_info, increment=0, iter_nr_out=iter_nr) converged = .FALSE. - DO its = iter_nr+1, gopt_param%max_iter + DO its = iter_nr + 1, gopt_param%max_iter CALL cp_iterate(logger%iter_info, last=(its == gopt_param%max_iter)) CALL section_vals_val_set(geo_section, "STEP_START_VAL", i_val=its) CALL gopt_f_ii(its, output_unit) diff --git a/src/motion/cp_lbfgs_optimizer_gopt.F b/src/motion/cp_lbfgs_optimizer_gopt.F index c3dd9940a1..9f784856d4 100644 --- a/src/motion/cp_lbfgs_optimizer_gopt.F +++ b/src/motion/cp_lbfgs_optimizer_gopt.F @@ -228,7 +228,7 @@ SUBROUTINE cp_opt_gopt_create(optimizer, para_env, obj_funct, x0, m, print_every optimizer%para_env, & optimizer%obj_funct) optimizer%ref_count = 0 - last_lbfgs_optimizer_id = last_lbfgs_optimizer_id+1 + last_lbfgs_optimizer_id = last_lbfgs_optimizer_id + 1 optimizer%id_nr = last_lbfgs_optimizer_id n = SIZE(x0) optimizer%m = 4 @@ -249,7 +249,7 @@ SUBROUTINE cp_opt_gopt_create(optimizer, para_env, obj_funct, x0, m, print_every IF (PRESENT(master)) optimizer%master = master IF (optimizer%master == optimizer%para_env%mepos) THEN !MK This has to be adapted for a new L-BFGS version possibly - lenwa = 2*optimizer%m*n+5*n+11*optimizer%m*optimizer%m+8*optimizer%m + lenwa = 2*optimizer%m*n + 5*n + 11*optimizer%m*optimizer%m + 8*optimizer%m ALLOCATE (optimizer%kind_of_bound(n), optimizer%i_work_array(3*n), & optimizer%isave(44)) ALLOCATE (optimizer%x(n), optimizer%lower_bound(n), & @@ -306,7 +306,7 @@ SUBROUTINE cp_opt_gopt_retain(optimizer) CPASSERT(ASSOCIATED(optimizer)) CPASSERT(optimizer%ref_count > 0) - optimizer%ref_count = optimizer%ref_count+1 + optimizer%ref_count = optimizer%ref_count + 1 END SUBROUTINE cp_opt_gopt_retain ! ************************************************************************************************** @@ -329,7 +329,7 @@ SUBROUTINE cp_opt_gopt_release(optimizer) IF (ASSOCIATED(optimizer)) THEN CPASSERT(optimizer%ref_count > 0) - optimizer%ref_count = optimizer%ref_count-1 + optimizer%ref_count = optimizer%ref_count - 1 IF (optimizer%ref_count == 0) THEN optimizer%status = 6 IF (ASSOCIATED(optimizer%kind_of_bound)) THEN @@ -637,11 +637,11 @@ RECURSIVE SUBROUTINE cp_opt_gopt_step(optimizer, n_iter, f, last_f, & ! Some IO and Convergence check t_now = m_walltime() - t_diff = t_now-t_old + t_diff = t_now - t_old t_old = t_now CALL gopt_f_io(optimizer%obj_funct, force_env, force_env%root_section, & its, optimizer%f, dataunit, optimizer%eold, optimizer%emin, wildcard, gopt_param, & - SIZE(optimizer%x), optimizer%x-xold, optimizer%gradient, conv, used_time=t_diff) + SIZE(optimizer%x), optimizer%x - xold, optimizer%gradient, conv, used_time=t_diff) CALL mp_bcast(conv, optimizer%master, optimizer%para_env%group) CALL cp_print_key_finished_output(dataunit, logger, geo_section, & "PRINT%PROGRAM_RUN_INFO") diff --git a/src/motion/dimer_methods.F b/src/motion/dimer_methods.F index 55500a498b..c1cbba75f4 100644 --- a/src/motion/dimer_methods.F +++ b/src/motion/dimer_methods.F @@ -101,13 +101,13 @@ RECURSIVE SUBROUTINE cp_eval_at_ts(gopt_env, x, f, gradient, calc_force) ELSE angle1 = dimer_env%rot%angle1 angle2 = dimer_env%rot%angle2 - dimer_env%rot%g1 = SIN(angle1-angle2)/SIN(angle1)*dimer_env%rot%g1+ & - SIN(angle2)/SIN(angle1)*dimer_env%rot%g1p+ & - (1.0_dp-COS(angle2)-SIN(angle2)*TAN(angle1/2.0_dp))*dimer_env%rot%g0 + dimer_env%rot%g1 = SIN(angle1 - angle2)/SIN(angle1)*dimer_env%rot%g1 + & + SIN(angle2)/SIN(angle1)*dimer_env%rot%g1p + & + (1.0_dp - COS(angle2) - SIN(angle2)*TAN(angle1/2.0_dp))*dimer_env%rot%g0 END IF ! Determine the theta vector (i.e. the search direction for line minimization) - gradient = -2.0_dp*(dimer_env%rot%g1-dimer_env%rot%g0) + gradient = -2.0_dp*(dimer_env%rot%g1 - dimer_env%rot%g0) IF (debug_this_module .AND. (iw > 0)) THEN WRITE (iw, '(A)') "G1 vector:" WRITE (iw, '(3F15.9)') dimer_env%rot%g1 @@ -125,21 +125,21 @@ RECURSIVE SUBROUTINE cp_eval_at_ts(gopt_env, x, f, gradient, calc_force) END IF ! Compute curvature and derivative of the curvature w.r.t. the rotational angle - dimer_env%rot%curvature = DOT_PRODUCT(dimer_env%rot%g1-dimer_env%rot%g0, dimer_env%nvec)/dimer_env%dr - dimer_env%rot%dCdp = 2.0_dp*DOT_PRODUCT(dimer_env%rot%g1-dimer_env%rot%g0, gradient)/dimer_env%dr + dimer_env%rot%curvature = DOT_PRODUCT(dimer_env%rot%g1 - dimer_env%rot%g0, dimer_env%nvec)/dimer_env%dr + dimer_env%rot%dCdp = 2.0_dp*DOT_PRODUCT(dimer_env%rot%g1 - dimer_env%rot%g0, gradient)/dimer_env%dr dimer_env%rot%rotation_step = do_second_rotation_step gradient = -gradient CASE (do_second_rotation_step) ! Compute energy, gradients and rotation vector for R1 CALL cp_eval_at_ts_low(gopt_env, x, 1, dimer_env, calc_force, f1, dimer_env%rot%g1p) - dimer_env%rot%curvature = DOT_PRODUCT(dimer_env%rot%g1p-dimer_env%rot%g0, dimer_env%nvec)/dimer_env%dr + dimer_env%rot%curvature = DOT_PRODUCT(dimer_env%rot%g1p - dimer_env%rot%g0, dimer_env%nvec)/dimer_env%dr dimer_env%rot%rotation_step = do_third_rotation_step ! Determine the theta vector (i.e. the search direction for line minimization) ! This is never used for getting a new theta but is consistent in order to ! give back the right value of f - gradient = -2.0_dp*(dimer_env%rot%g1p-dimer_env%rot%g0) + gradient = -2.0_dp*(dimer_env%rot%g1p - dimer_env%rot%g0) CALL get_theta(gradient, dimer_env, norm) f = norm @@ -173,11 +173,11 @@ RECURSIVE SUBROUTINE cp_eval_at_ts(gopt_env, x, f, gradient, calc_force) IF (iw > 0) THEN WRITE (iw, '(T2,A)') "DIMER| Correcting gradients for Translation with K-DIMER method" END IF - swf = 1.0_dp+EXP(dimer_env%beta*dimer_env%rot%curvature) - gm2 = 1.0_dp-(1.0_dp/swf) - gm1 = (2.0_dp/swf)-1.0_dp - gradient = gm2*(dimer_env%rot%g0-2.0_dp*DOT_PRODUCT(dimer_env%rot%g0, dimer_env%nvec)*dimer_env%nvec) & - -gm1*(DOT_PRODUCT(dimer_env%rot%g0, dimer_env%nvec)*dimer_env%nvec) + swf = 1.0_dp + EXP(dimer_env%beta*dimer_env%rot%curvature) + gm2 = 1.0_dp - (1.0_dp/swf) + gm1 = (2.0_dp/swf) - 1.0_dp + gradient = gm2*(dimer_env%rot%g0 - 2.0_dp*DOT_PRODUCT(dimer_env%rot%g0, dimer_env%nvec)*dimer_env%nvec) & + - gm1*(DOT_PRODUCT(dimer_env%rot%g0, dimer_env%nvec)*dimer_env%nvec) CALL remove_rot_transl_component(gopt_env, gradient, print_section) IF (debug_this_module .AND. (iw > 0)) WRITE (iw, *) "K-DIMER", dimer_env%beta, dimer_env%rot%curvature, & dimer_env%rot%dCdp, gm1, gm2, swf @@ -189,7 +189,7 @@ RECURSIVE SUBROUTINE cp_eval_at_ts(gopt_env, x, f, gradient, calc_force) gradient = -DOT_PRODUCT(dimer_env%rot%g0, dimer_env%nvec)*dimer_env%nvec CALL remove_rot_transl_component(gopt_env, gradient, print_section) ELSE - gradient = dimer_env%rot%g0-2.0_dp*DOT_PRODUCT(dimer_env%rot%g0, dimer_env%nvec)*dimer_env%nvec + gradient = dimer_env%rot%g0 - 2.0_dp*DOT_PRODUCT(dimer_env%rot%g0, dimer_env%nvec)*dimer_env%nvec CALL remove_rot_transl_component(gopt_env, gradient, print_section) END IF END IF @@ -247,14 +247,14 @@ SUBROUTINE remove_rot_transl_component(gopt_env, gradient, print_section) ! Check First orthogonality in the first element of the basis set DO i = 1, dof D(:, i) = mat(:, i) - DO j = i+1, dof + DO j = i + 1, dof norm = DOT_PRODUCT(mat(:, i), mat(:, j)) CPASSERT(ABS(norm) < thrs_motion) END DO END DO DO i = 1, dof norm = DOT_PRODUCT(gradient, D(:, i)) - gradient = gradient-norm*D(:, i) + gradient = gradient - norm*D(:, i) END DO DEALLOCATE (D) DEALLOCATE (mat) @@ -301,8 +301,8 @@ SUBROUTINE cp_eval_at_ts_low(gopt_env, x, dimer_index, dimer_env, calc_force, & CALL cp_subsys_get(subsys, particles=particles) DO ip = 1, particles%n_els DO idir = 1, 3 - idg = idg+1 - particles%els(ip)%r(idir) = x(idg)+REAL(dimer_index, KIND=dp)*dimer_env%nvec(idg)*dimer_env%dr + idg = idg + 1 + particles%els(ip)%r(idir) = x(idg) + REAL(dimer_index, KIND=dp)*dimer_env%nvec(idg)*dimer_env%dr END DO END DO @@ -320,7 +320,7 @@ SUBROUTINE cp_eval_at_ts_low(gopt_env, x, dimer_index, dimer_env, calc_force, & CALL cp_subsys_get(subsys, particles=particles) DO ip = 1, particles%n_els DO idir = 1, 3 - idg = idg+1 + idg = idg + 1 CPASSERT(SIZE(gradient) >= idg) gradient(idg) = -particles%els(ip)%f(idir) END DO diff --git a/src/motion/dimer_types.F b/src/motion/dimer_types.F index b0ec8b83b4..f63bdb3ca5 100644 --- a/src/motion/dimer_types.F +++ b/src/motion/dimer_types.F @@ -133,7 +133,7 @@ SUBROUTINE dimer_env_create(dimer_env, subsys, globenv, dimer_section) CPASSERT(.NOT. ASSOCIATED(dimer_env)) ALLOCATE (dimer_env) dimer_env%ref_count = 1 - last_dimer_id = last_dimer_id+1 + last_dimer_id = last_dimer_id + 1 dimer_env%id_nr = last_dimer_id ! Setup NVEC NULLIFY (dimer_env%nvec, dimer_env%rot%g0, dimer_env%rot%g1, dimer_env%rot%g1p, & @@ -156,7 +156,7 @@ SUBROUTINE dimer_env_create(dimer_env, subsys, globenv, dimer_section) DO i = 1, n_rep_val CALL section_vals_val_get(nvec_section, "_DEFAULT_KEYWORD_", r_vals=array, i_rep_val=i) DO j = 1, SIZE(array) - isize = isize+1 + isize = isize + 1 dimer_env%nvec(isize) = array(j) END DO END DO @@ -169,16 +169,16 @@ SUBROUTINE dimer_env_create(dimer_env, subsys, globenv, dimer_section) xval = 0.0_dp DO j = 1, natom DO k = 1, 3 - i = (j-1)*3+k - xval(k) = xval(k)+dimer_env%nvec(i) + i = (j - 1)*3 + k + xval(k) = xval(k) + dimer_env%nvec(i) END DO END DO ! Subtract net translations xval = xval/REAL(natom*3, KIND=dp) DO j = 1, natom DO k = 1, 3 - i = (j-1)*3+k - dimer_env%nvec(i) = dimer_env%nvec(i)-xval(k) + i = (j - 1)*3 + k + dimer_env%nvec(i) = dimer_env%nvec(i) - xval(k) END DO END DO END IF @@ -223,7 +223,7 @@ SUBROUTINE dimer_env_retain(dimer_env) CPASSERT(ASSOCIATED(dimer_env)) CPASSERT(dimer_env%ref_count > 0) - dimer_env%ref_count = dimer_env%ref_count+1 + dimer_env%ref_count = dimer_env%ref_count + 1 END SUBROUTINE dimer_env_retain ! ************************************************************************************************** @@ -241,7 +241,7 @@ SUBROUTINE dimer_env_release(dimer_env) IF (ASSOCIATED(dimer_env)) THEN CPASSERT(dimer_env%ref_count > 0) - dimer_env%ref_count = dimer_env%ref_count-1 + dimer_env%ref_count = dimer_env%ref_count - 1 IF (dimer_env%ref_count == 0) THEN IF (ASSOCIATED(dimer_env%nvec)) THEN DEALLOCATE (dimer_env%nvec) @@ -309,28 +309,28 @@ SUBROUTINE dimer_fixed_atom_control(vec, subsys) DO ii = 1, nfixed_atoms IF (.NOT. fixd_list(ii)%restraint%active) THEN iparticle = fixd_list(ii)%fixd - ind = (iparticle-1)*3 + ind = (iparticle - 1)*3 ! apply constraint to nvec - SELECT CASE (fixd_list (ii)%itype) + SELECT CASE (fixd_list(ii)%itype) CASE (use_perd_x) - vec(ind+1) = 0.0_dp + vec(ind + 1) = 0.0_dp CASE (use_perd_y) - vec(ind+2) = 0.0_dp + vec(ind + 2) = 0.0_dp CASE (use_perd_z) - vec(ind+3) = 0.0_dp + vec(ind + 3) = 0.0_dp CASE (use_perd_xy) - vec(ind+1) = 0.0_dp - vec(ind+2) = 0.0_dp + vec(ind + 1) = 0.0_dp + vec(ind + 2) = 0.0_dp CASE (use_perd_xz) - vec(ind+1) = 0.0_dp - vec(ind+3) = 0.0_dp + vec(ind + 1) = 0.0_dp + vec(ind + 3) = 0.0_dp CASE (use_perd_yz) - vec(ind+2) = 0.0_dp - vec(ind+3) = 0.0_dp + vec(ind + 2) = 0.0_dp + vec(ind + 3) = 0.0_dp CASE (use_perd_xyz) - vec(ind+1) = 0.0_dp - vec(ind+2) = 0.0_dp - vec(ind+3) = 0.0_dp + vec(ind + 1) = 0.0_dp + vec(ind + 2) = 0.0_dp + vec(ind + 3) = 0.0_dp END SELECT END IF ! .NOT.fixd_list(ii)%restraint%active END DO ! ii diff --git a/src/motion/dimer_utils.F b/src/motion/dimer_utils.F index 772c02e0ab..c0eff36818 100644 --- a/src/motion/dimer_utils.F +++ b/src/motion/dimer_utils.F @@ -58,7 +58,7 @@ SUBROUTINE rotate_dimer(nvec, theta, dt) ABS(DOT_PRODUCT(nvec, theta)) END IF CPASSERT(check) - nvec = nvec*COS(dt)+theta*SIN(dt) + nvec = nvec*COS(dt) + theta*SIN(dt) END SUBROUTINE rotate_dimer @@ -91,9 +91,9 @@ SUBROUTINE update_dimer_vec(dimer_env, motion_section) i_rep_val = 0 Main_Loop: DO i = 1, SIZE(dimer_env%nvec), size_array ALLOCATE (array(size_array)) - i_rep_val = i_rep_val+1 + i_rep_val = i_rep_val + 1 DO j = 1, size_array - isize = isize+1 + isize = isize + 1 array(j) = dimer_env%nvec(isize) IF (isize == SIZE(dimer_env%nvec)) THEN CALL reallocate(array, 1, j) @@ -124,7 +124,7 @@ SUBROUTINE get_theta(gradient, dimer_env, norm) CHARACTER(len=*), PARAMETER :: routineN = 'get_theta', routineP = moduleN//':'//routineN - gradient = gradient-DOT_PRODUCT(gradient, dimer_env%nvec)*dimer_env%nvec + gradient = gradient - DOT_PRODUCT(gradient, dimer_env%nvec)*dimer_env%nvec norm = SQRT(DOT_PRODUCT(gradient, gradient)) IF (norm < EPSILON(0.0_dp)) THEN ! This means that NVEC is totally aligned with minimum curvature mode diff --git a/src/motion/free_energy_methods.F b/src/motion/free_energy_methods.F index d15350864f..12cf394fac 100644 --- a/src/motion/free_energy_methods.F +++ b/src/motion/free_energy_methods.F @@ -98,7 +98,7 @@ SUBROUTINE free_energy_evaluate(md_env, converged, fe_section) CASE (do_fe_ui) ! Umbrella Integration.. CALL force_env_get(force_env, subsys=subsys) - fe_env%nr_points = fe_env%nr_points+1 + fe_env%nr_points = fe_env%nr_points + 1 output_unit = cp_logger_get_default_io_unit(logger) DO ic = 1, fe_env%ncolvar cv => fe_env%uivar(ic) @@ -110,7 +110,7 @@ SUBROUTINE free_energy_evaluate(md_env, converged, fe_section) WRITE (output_unit, *) "COLVAR::", cv%ss(fe_env%nr_points) END IF END DO - stat_sign_points = fe_env%nr_points-fe_env%nr_rejected + stat_sign_points = fe_env%nr_points - fe_env%nr_rejected IF (output_unit > 0) THEN WRITE (output_unit, *) fe_env%nr_points, stat_sign_points END IF @@ -122,7 +122,7 @@ SUBROUTINE free_energy_evaluate(md_env, converged, fe_section) CALL print_fe_prolog(output_unit) ! Trend test.. recomputes the number of statistically significant points.. CALL ui_check_trend(fe_env, fe_env%conv_par%test_k, stat_sign_points, output_unit) - stat_sign_points = fe_env%nr_points-fe_env%nr_rejected + stat_sign_points = fe_env%nr_points - fe_env%nr_rejected ! Normality and serial correlation tests.. IF (fe_env%conv_par%cg_width*fe_env%conv_par%cg_points <= stat_sign_points .AND. & fe_env%conv_par%test_k) THEN @@ -235,18 +235,18 @@ SUBROUTINE ui_check_trend(fe_env, trend_free, nr_points, output_unit) ii = 1 DO i = ng_points, 1, -1 wrk(ii) = fe_env%cg_data(i)%avg(j) - ii = ii+1 + ii = ii + 1 END DO - DO i = my_reject+1, ng_points - IF ((ng_points-my_reject) .LT. min_sample_size) THEN - my_reject = MAX(0, my_reject-1) + DO i = my_reject + 1, ng_points + IF ((ng_points - my_reject) .LT. min_sample_size) THEN + my_reject = MAX(0, my_reject - 1) test_avg = .FALSE. EXIT END IF - CALL k_test(wrk, my_reject+1, ng_points, tau, z, prob) + CALL k_test(wrk, my_reject + 1, ng_points, tau, z, prob) PRINT *, prob, fe_env%conv_par%k_conf_lm IF (prob < fe_env%conv_par%k_conf_lm) EXIT - my_reject = my_reject+1 + my_reject = my_reject + 1 END DO my_reject = MIN(ng_points, my_reject) END DO @@ -254,7 +254,7 @@ SUBROUTINE ui_check_trend(fe_env, trend_free, nr_points, output_unit) ! Print some info IF (output_unit > 0) THEN WRITE (output_unit, *) "Kendall trend test (Average)", test_avg, & - "number of points rejected:", rejected_points+fe_env%nr_rejected + "number of points rejected:", rejected_points + fe_env%nr_rejected WRITE (output_unit, *) "Reject Nr.", my_reject, " coarse grained points testing average" END IF ! Test on coarse grained covariance matrix @@ -263,24 +263,24 @@ SUBROUTINE ui_check_trend(fe_env, trend_free, nr_points, output_unit) ii = 1 DO i = ng_points, 1, -1 wrk(ii) = fe_env%cg_data(i)%var(j, k) - ii = ii+1 + ii = ii + 1 END DO - DO i = my_reject+1, ng_points - IF ((ng_points-my_reject) .LT. min_sample_size) THEN - my_reject = MAX(0, my_reject-1) + DO i = my_reject + 1, ng_points + IF ((ng_points - my_reject) .LT. min_sample_size) THEN + my_reject = MAX(0, my_reject - 1) test_std = .FALSE. EXIT END IF - CALL k_test(wrk, my_reject+1, ng_points, tau, z, prob) + CALL k_test(wrk, my_reject + 1, ng_points, tau, z, prob) PRINT *, prob, fe_env%conv_par%k_conf_lm IF (prob < fe_env%conv_par%k_conf_lm) EXIT - my_reject = my_reject+1 + my_reject = my_reject + 1 END DO my_reject = MIN(ng_points, my_reject) END DO END DO rejected_points = my_reject*fe_env%conv_par%cg_width - fe_env%nr_rejected = fe_env%nr_rejected+rejected_points + fe_env%nr_rejected = fe_env%nr_rejected + rejected_points trend_free = test_avg .AND. test_std ! Print some info IF (output_unit > 0) THEN @@ -369,8 +369,8 @@ SUBROUTINE create_csg_data(fe_env, ng_points, output_unit) INTEGER :: i, iend, istart DO i = 1, ng_points - istart = fe_env%nr_points-(i)*fe_env%conv_par%cg_width+1 - iend = fe_env%nr_points-(i-1)*fe_env%conv_par%cg_width + istart = fe_env%nr_points - (i)*fe_env%conv_par%cg_width + 1 + iend = fe_env%nr_points - (i - 1)*fe_env%conv_par%cg_width IF (output_unit > 0) THEN WRITE (output_unit, *) istart, iend END IF @@ -408,7 +408,7 @@ SUBROUTINE ui_check_norm_sc(fe_env, test_passed, nr_points, output_unit) CALL ui_check_norm_sc_low(fe_env, nr_points, output_unit) test_passed = fe_env%conv_par%test_vn .AND. fe_env%conv_par%test_sw IF (test_passed) EXIT - fe_env%conv_par%cg_width = fe_env%conv_par%cg_width+1 + fe_env%conv_par%cg_width = fe_env%conv_par%cg_width + 1 IF (output_unit > 0) THEN WRITE (output_unit, *) "New coarse grained width:", fe_env%conv_par%cg_width END IF @@ -460,8 +460,8 @@ SUBROUTINE ui_check_norm_sc_low(fe_env, nr_points, output_unit) ! Test of Shapiro - Wilks for normality ! - Average CALL sw_test(wrk, ng_points, w, pw) - PRINT *, 1.0_dp-pw, fe_env%conv_par%sw_conf_lm - avg_test_passed = (1.0_dp-pw) <= fe_env%conv_par%sw_conf_lm + PRINT *, 1.0_dp - pw, fe_env%conv_par%sw_conf_lm + avg_test_passed = (1.0_dp - pw) <= fe_env%conv_par%sw_conf_lm fe_env%conv_par%test_sw = avg_test_passed IF (output_unit > 0) THEN WRITE (output_unit, *) "Shapiro-Wilks normality test (Avg)", avg_test_passed @@ -487,8 +487,8 @@ SUBROUTINE ui_check_norm_sc_low(fe_env, nr_points, output_unit) ! Test of Shapiro - Wilks for normality ! - Standard Deviation CALL sw_test(wrk, ng_points, w, pw) - PRINT *, 1.0_dp-pw, fe_env%conv_par%sw_conf_lm - sdv_test_passed = (1.0_dp-pw) <= fe_env%conv_par%sw_conf_lm + PRINT *, 1.0_dp - pw, fe_env%conv_par%sw_conf_lm + sdv_test_passed = (1.0_dp - pw) <= fe_env%conv_par%sw_conf_lm fe_env%conv_par%test_sw = fe_env%conv_par%test_sw .AND. sdv_test_passed IF (output_unit > 0) THEN WRITE (output_unit, *) "Shapiro-Wilks normality test (Std. Dev.)", sdv_test_passed @@ -548,13 +548,13 @@ SUBROUTINE ui_check_convergence(fe_env, converged, nr_points, output_unit) CALL create_csg_data(fe_env, ng_points, output_unit) ALLOCATE (covmx(ncolvar, ncolvar)) ALLOCATE (avgmx(ncolvar)) - ALLOCATE (cov_std(ncolvar*(ncolvar+1)/2, ncolvar*(ncolvar+1)/2)) + ALLOCATE (cov_std(ncolvar*(ncolvar + 1)/2, ncolvar*(ncolvar + 1)/2)) ALLOCATE (avg_std(ncolvar)) covmx = 0.0_dp avgmx = 0.0_dp DO i = 1, ng_points - covmx = covmx+fe_env%cg_data(i)%var - avgmx = avgmx+fe_env%cg_data(i)%avg + covmx = covmx + fe_env%cg_data(i)%var + avgmx = avgmx + fe_env%cg_data(i)%avg END DO covmx = covmx/REAL(ng_points, KIND=dp) avgmx = avgmx/REAL(ng_points, KIND=dp) @@ -641,17 +641,17 @@ SUBROUTINE compute_avg_std_errors(fe_env, ncolvar, avgmx, covmx, avg_std, cov_st DO k = 1, SIZE(fe_env%cg_data) DO j = 1, nvar DO i = j, nvar - wrk(i, j) = wrk(i, j)+fe_env%cg_data(k)%avg(i)*fe_env%cg_data(k)%avg(j) + wrk(i, j) = wrk(i, j) + fe_env%cg_data(k)%avg(i)*fe_env%cg_data(k)%avg(j) END DO END DO END DO DO j = 1, nvar DO i = j, nvar - wrk(i, j) = wrk(i, j)-avgmx(i)*avgmx(j)*fac + wrk(i, j) = wrk(i, j) - avgmx(i)*avgmx(j)*fac wrk(j, i) = wrk(i, j) END DO END DO - wrk = wrk/(fac-1.0_dp) + wrk = wrk/(fac - 1.0_dp) ! Diagonalize the covariance matrix and check for the maximum error CALL diamat_all(wrk, eig) DO i = 1, nvar @@ -660,7 +660,7 @@ SUBROUTINE compute_avg_std_errors(fe_env, ncolvar, avgmx, covmx, avg_std, cov_st DEALLOCATE (wrk) DEALLOCATE (eig) ! Standard Deviations - nvar = ncolvar*(ncolvar+1)/2 + nvar = ncolvar*(ncolvar + 1)/2 ALLOCATE (wrk(nvar, nvar)) ALLOCATE (eig(nvar)) ALLOCATE (awrk(nvar)) @@ -670,7 +670,7 @@ SUBROUTINE compute_avg_std_errors(fe_env, ncolvar, avgmx, covmx, avg_std, cov_st ind = 0 DO i = 1, ncolvar DO j = i, ncolvar - ind = ind+1 + ind = ind + 1 awrk(ind) = covmx(i, j) END DO END DO @@ -678,29 +678,29 @@ SUBROUTINE compute_avg_std_errors(fe_env, ncolvar, avgmx, covmx, avg_std, cov_st ind = 0 DO i = 1, ncolvar DO j = i, ncolvar - ind = ind+1 + ind = ind + 1 tmp(ind) = fe_env%cg_data(k)%var(i, j) END DO END DO DO i = 1, nvar DO j = i, nvar - wrk(i, j) = wrk(i, j)+tmp(i)*tmp(j)-awrk(i)*awrk(j) + wrk(i, j) = wrk(i, j) + tmp(i)*tmp(j) - awrk(i)*awrk(j) END DO END DO END DO DO i = 1, nvar DO j = i, nvar - wrk(i, j) = wrk(i, j)-fac*awrk(i)*awrk(j) + wrk(i, j) = wrk(i, j) - fac*awrk(i)*awrk(j) wrk(j, i) = wrk(i, j) END DO END DO - wrk = wrk/(fac-1.0_dp) + wrk = wrk/(fac - 1.0_dp) ! Diagonalize the covariance matrix and check for the maximum error CALL diamat_all(wrk, eig) ind = 0 DO i = 1, ncolvar DO j = i, ncolvar - ind = ind+1 + ind = ind + 1 cov_std(i, j) = eig(ind) cov_std(j, i) = cov_std(i, j) END DO @@ -739,7 +739,7 @@ SUBROUTINE eval_cov_matrix(fe_env, cg_index, istart, iend, output_unit, covmx, a CALL timeset(routineN, handle) ncolvar = fe_env%ncolvar - nlength = iend-istart+1 + nlength = iend - istart + 1 fe_env%cg_data(cg_index)%avg = 0.0_dp fe_env%cg_data(cg_index)%var = 0.0_dp IF (nlength > 1) THEN @@ -748,7 +748,7 @@ SUBROUTINE eval_cov_matrix(fe_env, cg_index, istart, iend, output_unit, covmx, a DO ic = 1, ncolvar cv => fe_env%uivar(ic) tmp_ic = cv%ss(jstep) - fe_env%cg_data(cg_index)%avg(ic) = fe_env%cg_data(cg_index)%avg(ic)+tmp_ic + fe_env%cg_data(cg_index)%avg(ic) = fe_env%cg_data(cg_index)%avg(ic) + tmp_ic END DO DO ic = 1, ncolvar cv => fe_env%uivar(ic) @@ -756,20 +756,20 @@ SUBROUTINE eval_cov_matrix(fe_env, cg_index, istart, iend, output_unit, covmx, a DO jc = 1, ic cv => fe_env%uivar(jc) tmp_jc = cv%ss(jstep) - fe_env%cg_data(cg_index)%var(jc, ic) = fe_env%cg_data(cg_index)%var(jc, ic)+tmp_ic*tmp_jc + fe_env%cg_data(cg_index)%var(jc, ic) = fe_env%cg_data(cg_index)%var(jc, ic) + tmp_ic*tmp_jc END DO END DO END DO ! Normalized the variances and the averages ! Unbiased estimator - fe_env%cg_data(cg_index)%var = fe_env%cg_data(cg_index)%var/REAL(nlength-1, KIND=dp) + fe_env%cg_data(cg_index)%var = fe_env%cg_data(cg_index)%var/REAL(nlength - 1, KIND=dp) fe_env%cg_data(cg_index)%avg = fe_env%cg_data(cg_index)%avg/REAL(nlength, KIND=dp) ! Compute the covariance matrix DO ic = 1, ncolvar tmp_ic = fe_env%cg_data(cg_index)%avg(ic) DO jc = 1, ic - tmp_jc = fe_env%cg_data(cg_index)%avg(jc)*REAL(nlength, KIND=dp)/REAL(nlength-1, KIND=dp) - fe_env%cg_data(cg_index)%var(jc, ic) = fe_env%cg_data(cg_index)%var(jc, ic)-tmp_ic*tmp_jc + tmp_jc = fe_env%cg_data(cg_index)%avg(jc)*REAL(nlength, KIND=dp)/REAL(nlength - 1, KIND=dp) + fe_env%cg_data(cg_index)%var(jc, ic) = fe_env%cg_data(cg_index)%var(jc, ic) - tmp_ic*tmp_jc fe_env%cg_data(cg_index)%var(ic, jc) = fe_env%cg_data(cg_index)%var(jc, ic) END DO END DO @@ -860,10 +860,10 @@ SUBROUTINE dump_ac_info(my_val, my_par, dx, lerr, fe_section, nforce_eval, cum_r CALL section_vals_val_get(alch_section, "NEQUIL_STEPS", i_val=NEquilStep) ! Store results IF (istep > NEquilStep) THEN - isize = SIZE(cum_res, 2)+1 + isize = SIZE(cum_res, 2) + 1 CALL reallocate(cum_res, 1, 3, 1, isize) cum_res(1, isize) = dedf - cum_res(2, isize) = dedf-d_ene_w + cum_res(2, isize) = dedf - d_ene_w cum_res(3, isize) = ene_w ! Compute derivative of biased and total energy ! Total Free Energy @@ -873,19 +873,19 @@ SUBROUTINE dump_ac_info(my_val, my_par, dx, lerr, fe_section, nforce_eval, cum_r avg_BP = SUM(cum_res(3, 1:isize))/REAL(isize, KIND=dp) wfac = 0.0_dp DO j = 1, isize - wfac = wfac+EXP(beta*(cum_res(3, j)-avg_BP)) + wfac = wfac + EXP(beta*(cum_res(3, j) - avg_BP)) END DO avg_DUE = 0.0_dp std_DUE = 0.0_dp DO j = 1, isize tmp = cum_res(2, j) - tmp2 = EXP(beta*(cum_res(3, j)-avg_BP))/wfac - avg_DUE = avg_DUE+tmp*tmp2 - std_DUE = std_DUE+tmp**2*tmp2 + tmp2 = EXP(beta*(cum_res(3, j) - avg_BP))/wfac + avg_DUE = avg_DUE + tmp*tmp2 + std_DUE = std_DUE + tmp**2*tmp2 END DO IF (isize > 1) THEN - Err_DUE = SQRT(std_DUE-avg_DUE**2)/SQRT(REAL(isize-1, KIND=dp)) - Err_DET = SQRT(std_DET-avg_DET**2)/SQRT(REAL(isize-1, KIND=dp)) + Err_DUE = SQRT(std_DUE - avg_DUE**2)/SQRT(REAL(isize - 1, KIND=dp)) + Err_DET = SQRT(std_DET - avg_DET**2)/SQRT(REAL(isize - 1, KIND=dp)) END IF ! Print info iw = cp_print_key_unit_nr(logger, fe_section, "FREE_ENERGY_INFO", & @@ -899,7 +899,7 @@ SUBROUTINE dump_ac_info(my_val, my_par, dx, lerr, fe_section, nforce_eval, cum_r WRITE (iw, '(T2,"ALCHEMICAL CHANGE| DERIVATIVE OF TOTAL ENERGY [ PARAMETER (",A,") ]",T66,F15.9)') & TRIM(par), dedf WRITE (iw, '(T2,"ALCHEMICAL CHANGE| DERIVATIVE OF BIASED ENERGY [ PARAMETER (",A,") ]",T66,F15.9)') & - TRIM(par), dedf-d_ene_w + TRIM(par), dedf - d_ene_w WRITE (iw, '(T2,"ALCHEMICAL CHANGE| BIASING UMBRELLA POTENTIAL ",T66,F15.9)') & ene_w diff --git a/src/motion/glbopt_callback.F b/src/motion/glbopt_callback.F index 66be1b5c31..aef57216a9 100644 --- a/src/motion/glbopt_callback.F +++ b/src/motion/glbopt_callback.F @@ -70,18 +70,18 @@ SUBROUTINE glbopt_md_callback(mdctrl_data, md_env, should_stop) ! check if we passed a minimum passed_minimum = .TRUE. DO i = 1, mdctrl_data%bump_steps_upwards - IF (mdctrl_data%epot_history(i) <= mdctrl_data%epot_history(i+1)) & + IF (mdctrl_data%epot_history(i) <= mdctrl_data%epot_history(i + 1)) & passed_minimum = .FALSE. END DO - DO i = mdctrl_data%bump_steps_upwards+1, mdctrl_data%bump_steps_upwards+mdctrl_data%bump_steps_downwards - IF (mdctrl_data%epot_history(i) >= mdctrl_data%epot_history(i+1)) & + DO i = mdctrl_data%bump_steps_upwards + 1, mdctrl_data%bump_steps_upwards + mdctrl_data%bump_steps_downwards + IF (mdctrl_data%epot_history(i) >= mdctrl_data%epot_history(i + 1)) & passed_minimum = .FALSE. END DO ! count the passed bumps and stop md_run when md_bumps_max is reached. IF (passed_minimum) & - mdctrl_data%md_bump_counter = mdctrl_data%md_bump_counter+1 + mdctrl_data%md_bump_counter = mdctrl_data%md_bump_counter + 1 IF (mdctrl_data%md_bump_counter >= mdctrl_data%md_bumps_max) THEN should_stop = .TRUE. diff --git a/src/motion/gopt_f77_methods.F b/src/motion/gopt_f77_methods.F index bd25d71f2a..ac23bf22f7 100644 --- a/src/motion/gopt_f77_methods.F +++ b/src/motion/gopt_f77_methods.F @@ -23,55 +23,55 @@ RECURSIVE SUBROUTINE cp_eval_at(gopt_env, x, f, gradient, master, & USE cp_log_handling, ONLY: cp_logger_type USE averages_types, ONLY: average_quantities_type, & - create_averages, & - release_averages + create_averages, & + release_averages USE bibliography, ONLY: Henkelman1999, & - cite_reference + cite_reference USE cell_opt_utils, ONLY: get_dg_dh, & - gopt_new_logger_create, & - gopt_new_logger_release + gopt_new_logger_create, & + gopt_new_logger_release USE cell_types, ONLY: cell_type USE cell_methods, ONLY: write_cell USE cp_para_types, ONLY: cp_para_env_type USE cp_subsys_types, ONLY: cp_subsys_get, & - cp_subsys_type, & - pack_subsys_particles, & - unpack_subsys_particles + cp_subsys_type, & + pack_subsys_particles, & + unpack_subsys_particles USE dimer_methods, ONLY: cp_eval_at_ts USE force_env_methods, ONLY: force_env_calc_energy_force USE force_env_types, ONLY: force_env_get, & - force_env_get_nparticle + force_env_get_nparticle USE geo_opt, ONLY: cp_geo_opt USE gopt_f_types, ONLY: gopt_f_type USE gopt_f_methods, ONLY: apply_cell_change USE input_constants, ONLY: default_minimization_method_id, & - default_ts_method_id, & - default_cell_direct_id, & - default_cell_method_id, & - default_cell_geo_opt_id, & - default_cell_md_id, & - default_shellcore_method_id, & - nvt_ensemble, & - mol_dyn_run, & - geo_opt_run, & - cell_opt_run + default_ts_method_id, & + default_cell_direct_id, & + default_cell_method_id, & + default_cell_geo_opt_id, & + default_cell_md_id, & + default_shellcore_method_id, & + nvt_ensemble, & + mol_dyn_run, & + geo_opt_run, & + cell_opt_run USE input_section_types, ONLY: section_vals_get, & - section_vals_get_subs_vals, & - section_vals_type, & - section_vals_val_get + section_vals_get_subs_vals, & + section_vals_type, & + section_vals_val_get USE md_run, ONLY: qs_mol_dyn USE message_passing, ONLY: mp_bcast USE kinds, ONLY: dp, & - default_string_length + default_string_length USE particle_list_types, ONLY: particle_list_type USE particle_methods, ONLY: write_structure_data USE virial_methods, ONLY: virial_update USE virial_types, ONLY: cp_virial, & - virial_create, & - virial_release, & - virial_type + virial_create, & + virial_release, & + virial_type USE cp_log_handling, ONLY: cp_add_default_logger, & - cp_rm_default_logger + cp_rm_default_logger #include "../base/base_uses.f90" IMPLICIT NONE @@ -199,10 +199,10 @@ RECURSIVE SUBROUTINE cp_eval_at(gopt_env, x, f, gradient, master, & CPASSERT(ASSOCIATED(gradient)) nparticle = force_env_get_nparticle(gopt_env%force_env) nsize = 3*nparticle - CPASSERT((SIZE(gradient) == nsize+6)) + CPASSERT((SIZE(gradient) == nsize + 6)) CALL pack_subsys_particles(subsys=subsys, f=gradient(1:nsize), fscale=-1.0_dp) CALL apply_cell_change(gopt_env, cell, gradient, update_forces=.TRUE.) - cell_gradient => gradient(nsize+1:nsize+6) + cell_gradient => gradient(nsize + 1:nsize + 6) cell_gradient = 0.0_dp CALL get_dg_dh(cell_gradient, av_ptens, gopt_env%cell_env%pres_ext, cell, gopt_env%cell_env%mtrx, & keep_angles=gopt_env%cell_env%keep_angles, & @@ -307,8 +307,8 @@ RECURSIVE SUBROUTINE cp_eval_at(gopt_env, x, f, gradient, master, & shell_index = particles%els(ip)%shell_index IF (shell_index /= 0) THEN DO idir = 1, 3 - idg = 3*(shell_index-1)+idir - shell_particles%els(shell_index)%r(idir) = core_particles%els(ip)%r(idir)-x(idg) + idg = 3*(shell_index - 1) + idir + shell_particles%els(shell_index)%r(idir) = core_particles%els(ip)%r(idir) - x(idg) END DO END IF END DO @@ -331,8 +331,8 @@ RECURSIVE SUBROUTINE cp_eval_at(gopt_env, x, f, gradient, master, & idg = 0 DO ip = 1, shell_particles%n_els DO idir = 1, 3 - idg = idg+1 - gradient(idg) = -(core_particles%els(ip)%f(idir)-shell_particles%els(ip)%f(idir)) + idg = idg + 1 + gradient(idg) = -(core_particles%els(ip)%f(idir) - shell_particles%els(ip)%f(idir)) END DO END DO END IF diff --git a/src/motion/gopt_f_methods.F b/src/motion/gopt_f_methods.F index 8438259bfd..11aa341270 100644 --- a/src/motion/gopt_f_methods.F +++ b/src/motion/gopt_f_methods.F @@ -122,12 +122,12 @@ SUBROUTINE gopt_f_create_x0(gopt_env, x0) IF (gopt_env%force_env%in_use == use_qmmmx) & CALL apply_qmmmx_translate(gopt_env%force_env%qmmmx_env) nparticle = force_env_get_nparticle(gopt_env%force_env) - ALLOCATE (x0(3*nparticle+6)) + ALLOCATE (x0(3*nparticle + 6)) CALL pack_subsys_particles(subsys=subsys, r=x0) idg = 3*nparticle DO i = 1, 3 DO j = 1, i - idg = idg+1 + idg = idg + 1 x0(idg) = cell%hmat(j, i) END DO END DO @@ -137,7 +137,7 @@ SUBROUTINE gopt_f_create_x0(gopt_env, x0) idg = 0 DO i = 1, 3 DO j = 1, i - idg = idg+1 + idg = idg + 1 x0(idg) = cell%hmat(j, i) END DO END DO @@ -265,7 +265,7 @@ SUBROUTINE gopt_f_io(gopt_env, force_env, root_section, its, opt_energy, & IF (.NOT. gopt_env%dimer_rotation) THEN CALL geo_opt_io(force_env=force_env, root_section=root_section, & motion_section=gopt_env%motion_section, its=its, opt_energy=opt_energy) - CALL write_cycle_infos(output_unit, its, etot=opt_energy, ediff=opt_energy-eold, & + CALL write_cycle_infos(output_unit, its, etot=opt_energy, ediff=opt_energy - eold, & pred=pred, rat=rat, step=step, rad=rad, emin=emin, wildcard=wildcard, used_time=used_time) ! Possibly check convergence IF (PRESENT(conv)) THEN @@ -277,7 +277,7 @@ SUBROUTINE gopt_f_io(gopt_env, force_env, root_section, its, opt_energy, & ELSE CALL update_dimer_vec(gopt_env%dimer_env, gopt_env%motion_section) CALL write_restart(force_env=force_env, root_section=root_section) - CALL write_rot_cycle_infos(output_unit, its, opt_energy, opt_energy-eold, emin, gopt_env%dimer_env, & + CALL write_rot_cycle_infos(output_unit, its, opt_energy, opt_energy - eold, emin, gopt_env%dimer_env, & used_time=used_time, wildcard=wildcard) ! Possibly check convergence IF (PRESENT(conv)) THEN @@ -287,12 +287,12 @@ SUBROUTINE gopt_f_io(gopt_env, force_env, root_section, its, opt_energy, & END IF CASE (default_cell_method_id) ! Cell Optimization - pres_diff = gopt_env%cell_env%pres_int-gopt_env%cell_env%pres_ext + pres_diff = gopt_env%cell_env%pres_int - gopt_env%cell_env%pres_ext pres_int = gopt_env%cell_env%pres_int pres_tol = gopt_env%cell_env%pres_tol CALL geo_opt_io(force_env=force_env, root_section=root_section, & motion_section=gopt_env%motion_section, its=its, opt_energy=opt_energy) - CALL write_cycle_infos(output_unit, its, etot=opt_energy, ediff=opt_energy-eold, & + CALL write_cycle_infos(output_unit, its, etot=opt_energy, ediff=opt_energy - eold, & pred=pred, rat=rat, step=step, rad=rad, emin=emin, pres_int=pres_int, wildcard=wildcard, & used_time=used_time) ! Possibly check convergence @@ -303,7 +303,7 @@ SUBROUTINE gopt_f_io(gopt_env, force_env, root_section, its, opt_energy, & CALL check_converg(ndf, dx, xi, output_unit, conv, gopt_param, pres_diff, pres_tol) END IF CASE (default_shellcore_method_id) - CALL write_cycle_infos(output_unit, its, etot=opt_energy, ediff=opt_energy-eold, & + CALL write_cycle_infos(output_unit, its, etot=opt_energy, ediff=opt_energy - eold, & pred=pred, rat=rat, step=step, rad=rad, emin=emin, wildcard=wildcard, used_time=used_time) ! Possibly check convergence IF (PRESENT(conv)) THEN @@ -531,7 +531,7 @@ SUBROUTINE check_converg(ndf, dr, g, output_unit, conv, gopt_param, pres_diff, p dumm = 0.0_dp DO indf = 1, ndf IF (indf == 1) maxdum(1) = ABS(dr(indf)) - dumm = dumm+dr(indf)**2 + dumm = dumm + dr(indf)**2 IF (ABS(dr(indf)) > dxcon) conv_dx = .FALSE. IF (ABS(dr(indf)) > maxdum(1)) maxdum(1) = ABS(dr(indf)) END DO @@ -542,7 +542,7 @@ SUBROUTINE check_converg(ndf, dr, g, output_unit, conv, gopt_param, pres_diff, p dumm = 0.0_dp DO indf = 1, ndf IF (indf == 1) maxdum(3) = ABS(g(indf)) - dumm = dumm+g(indf)**2 + dumm = dumm + g(indf)**2 IF (ABS(g(indf)) > gcon) conv_g = .FALSE. IF (ABS(g(indf)) > maxdum(3)) maxdum(3) = ABS(g(indf)) END DO @@ -725,7 +725,7 @@ RECURSIVE SUBROUTINE write_final_info(output_unit, conv, it, gopt_env, x0, maste CALL cp_subsys_get(subsys=subsys, particles=particles) particle_set => particles%els IF (conv) THEN - it = it+1 + it = it + 1 CALL write_structure_data(particle_set, cell, motion_section) CALL write_restart(force_env=force_env, root_section=root_section) @@ -830,13 +830,13 @@ SUBROUTINE print_geo_opt_header(gopt_env, output_unit, label) my_label = "STARTING "//gopt_env%tag(1:8)//" OPTIMIZATION" END IF - ix = (80-7-LEN_TRIM(my_label))/2 - ix = ix+5 + ix = (80 - 7 - LEN_TRIM(my_label))/2 + ix = ix + 5 my_format = "(T2,A,T"//cp_to_string(ix)//",A,T78,A)" WRITE (UNIT=output_unit, FMT=TRIM(my_format)) "***", TRIM(my_label), "***" - ix = (80-7-LEN_TRIM(label))/2 - ix = ix+5 + ix = (80 - 7 - LEN_TRIM(label))/2 + ix = ix + 5 my_format = "(T2,A,T"//cp_to_string(ix)//",A,T78,A)" WRITE (UNIT=output_unit, FMT=TRIM(my_format)) "***", TRIM(label), "***" @@ -983,16 +983,16 @@ SUBROUTINE apply_cell_change(gopt_env, cell, x, update_forces) CASE (default_cell_geo_opt_id, default_cell_md_id) idg = 0 END SELECT - CPASSERT((SIZE(x) == idg+6)) + CPASSERT((SIZE(x) == idg + 6)) IF (update_forces) THEN ! Transform particle forces back to reference cell idg = 1 DO iatom = 1, natom - CALL real_to_scaled(s, x(idg:idg+2), cell) - CALL scaled_to_real(x(idg:idg+2), s, cell_ref) - idg = idg+3 + CALL real_to_scaled(s, x(idg:idg + 2), cell) + CALL scaled_to_real(x(idg:idg + 2), s, cell_ref) + idg = idg + 3 END DO ELSE @@ -1000,7 +1000,7 @@ SUBROUTINE apply_cell_change(gopt_env, cell, x, update_forces) ! Update cell DO i = 1, 3 DO j = 1, i - idg = idg+1 + idg = idg + 1 cell%hmat(j, i) = x(idg) END DO END DO @@ -1012,23 +1012,23 @@ SUBROUTINE apply_cell_change(gopt_env, cell, x, update_forces) CASE (default_cell_direct_id) idg = 1 DO iatom = 1, natom - CALL real_to_scaled(s, x(idg:idg+2), cell_ref) + CALL real_to_scaled(s, x(idg:idg + 2), cell_ref) shell_index = particles%els(iatom)%shell_index IF (shell_index == 0) THEN CALL scaled_to_real(particles%els(iatom)%r, s, cell) ELSE CALL scaled_to_real(core_particles%els(shell_index)%r, s, cell) - i = 3*(natom+shell_index-1)+1 - CALL real_to_scaled(s, x(i:i+2), cell_ref) + i = 3*(natom + shell_index - 1) + 1 + CALL real_to_scaled(s, x(i:i + 2), cell_ref) CALL scaled_to_real(shell_particles%els(shell_index)%r, s, cell) ! Update atomic position due to core and shell motion mass = particles%els(iatom)%atomic_kind%mass fc = core_particles%els(shell_index)%atomic_kind%shell%mass_core/mass fs = shell_particles%els(shell_index)%atomic_kind%shell%mass_shell/mass - particles%els(iatom)%r(1:3) = fc*core_particles%els(shell_index)%r(1:3)+ & + particles%els(iatom)%r(1:3) = fc*core_particles%els(shell_index)%r(1:3) + & fs*shell_particles%els(shell_index)%r(1:3) END IF - idg = idg+3 + idg = idg + 3 END DO CASE (default_cell_geo_opt_id, default_cell_md_id) DO iatom = 1, natom @@ -1039,14 +1039,14 @@ SUBROUTINE apply_cell_change(gopt_env, cell, x, update_forces) ELSE CALL real_to_scaled(s, core_particles%els(shell_index)%r, cell_ref) CALL scaled_to_real(core_particles%els(shell_index)%r, s, cell) - i = 3*(natom+shell_index-1)+1 + i = 3*(natom + shell_index - 1) + 1 CALL real_to_scaled(s, shell_particles%els(shell_index)%r, cell_ref) CALL scaled_to_real(shell_particles%els(shell_index)%r, s, cell) ! Update atomic position due to core and shell motion mass = particles%els(iatom)%atomic_kind%mass fc = core_particles%els(shell_index)%atomic_kind%shell%mass_core/mass fs = shell_particles%els(shell_index)%atomic_kind%shell%mass_shell/mass - particles%els(iatom)%r(1:3) = fc*core_particles%els(shell_index)%r(1:3)+ & + particles%els(iatom)%r(1:3) = fc*core_particles%els(shell_index)%r(1:3) + & fs*shell_particles%els(shell_index)%r(1:3) END IF END DO diff --git a/src/motion/gopt_f_types.F b/src/motion/gopt_f_types.F index 6191715afc..c81ff16dee 100644 --- a/src/motion/gopt_f_types.F +++ b/src/motion/gopt_f_types.F @@ -110,7 +110,7 @@ RECURSIVE SUBROUTINE gopt_f_create(gopt_env, gopt_param, force_env, globenv, geo NULLIFY (gopt_env%dimer_env, gopt_env%gopt_dimer_env, gopt_env%gopt_dimer_param, gopt_env%cell_env) gopt_env%ref_count = 1 - last_gopt_f_id = last_gopt_f_id+1 + last_gopt_f_id = last_gopt_f_id + 1 gopt_env%id_nr = last_gopt_f_id gopt_env%dimer_rotation = .FALSE. gopt_env%do_line_search = .FALSE. @@ -132,7 +132,7 @@ RECURSIVE SUBROUTINE gopt_f_create(gopt_env, gopt_param, force_env, globenv, geo shell_particles=shell_particles) IF (ASSOCIATED(shell_particles)) nshell = shell_particles%n_els ! The same number of shell and core particles is assumed - gopt_env%nfree = particles%n_els+nshell + gopt_env%nfree = particles%n_els + nshell gopt_env%label = "GEO_OPT" gopt_env%tag = "GEOMETRY" SELECT CASE (gopt_param%type_id) @@ -187,7 +187,7 @@ SUBROUTINE gopt_f_retain(gopt_env) CPASSERT(ASSOCIATED(gopt_env)) CPASSERT(gopt_env%ref_count > 0) - gopt_env%ref_count = gopt_env%ref_count+1 + gopt_env%ref_count = gopt_env%ref_count + 1 END SUBROUTINE gopt_f_retain ! ************************************************************************************************** @@ -203,7 +203,7 @@ RECURSIVE SUBROUTINE gopt_f_release(gopt_env) IF (ASSOCIATED(gopt_env)) THEN CPASSERT(gopt_env%ref_count > 0) - gopt_env%ref_count = gopt_env%ref_count-1 + gopt_env%ref_count = gopt_env%ref_count - 1 IF (gopt_env%ref_count == 0) THEN CALL force_env_release(gopt_env%force_env) NULLIFY (gopt_env%force_env, & diff --git a/src/motion/gopt_param_types.F b/src/motion/gopt_param_types.F index d7cb8bc1d5..0ee087d625 100644 --- a/src/motion/gopt_param_types.F +++ b/src/motion/gopt_param_types.F @@ -84,7 +84,7 @@ SUBROUTINE gopt_param_create(gopt_param) ALLOCATE (gopt_param) - last_gopt_param_id = last_gopt_param_id+1 + last_gopt_param_id = last_gopt_param_id + 1 gopt_param%id_nr = last_gopt_param_id gopt_param%ref_count = 1 END SUBROUTINE gopt_param_create @@ -176,7 +176,7 @@ SUBROUTINE gopt_param_retain(gopt_param) CPASSERT(ASSOCIATED(gopt_param)) CPASSERT(gopt_param%ref_count > 0) - gopt_param%ref_count = gopt_param%ref_count+1 + gopt_param%ref_count = gopt_param%ref_count + 1 END SUBROUTINE gopt_param_retain ! ************************************************************************************************** @@ -193,7 +193,7 @@ SUBROUTINE gopt_param_release(gopt_param) IF (ASSOCIATED(gopt_param)) THEN CPASSERT(gopt_param%ref_count > 0) - gopt_param%ref_count = gopt_param%ref_count-1 + gopt_param%ref_count = gopt_param%ref_count - 1 IF (gopt_param%ref_count == 0) THEN DEALLOCATE (gopt_param) END IF diff --git a/src/motion/helium_common.F b/src/motion/helium_common.F index b2dc1542c0..b4b0476ccc 100644 --- a/src/motion/helium_common.F +++ b/src/motion/helium_common.F @@ -122,27 +122,27 @@ SUBROUTINE helium_pbc_cube(helium, r) s = helium%cell_size_inv*r(1) IF (s > 0.5_dp) THEN - s = s-REAL(INT(s+0.5_dp), dp) + s = s - REAL(INT(s + 0.5_dp), dp) ELSEIF (s < -0.5_dp) THEN - s = s-REAL(INT(s-0.5_dp), dp) + s = s - REAL(INT(s - 0.5_dp), dp) END IF r(1) = s*helium%cell_size ! y coordinate s = helium%cell_size_inv*r(2) IF (s > 0.5_dp) THEN - s = s-REAL(INT(s+0.5_dp), dp) + s = s - REAL(INT(s + 0.5_dp), dp) ELSEIF (s < -0.5_dp) THEN - s = s-REAL(INT(s-0.5_dp), dp) + s = s - REAL(INT(s - 0.5_dp), dp) END IF r(2) = s*helium%cell_size ! z coordinate s = helium%cell_size_inv*r(3) IF (s > 0.5_dp) THEN - s = s-REAL(INT(s+0.5_dp), dp) + s = s - REAL(INT(s + 0.5_dp), dp) ELSEIF (s < -0.5_dp) THEN - s = s-REAL(INT(s-0.5_dp), dp) + s = s - REAL(INT(s - 0.5_dp), dp) END IF r(3) = s*helium%cell_size @@ -178,13 +178,13 @@ SUBROUTINE helium_pbc_trocta(helium, r) ry = r(2)*helium%cell_size_inv rz = r(3)*helium%cell_size_inv - rx = rx-ANINT(rx) - ry = ry-ANINT(ry) - rz = rz-ANINT(rz) - corr = 0.5_dp*AINT(r75*(ABS(rx)+ABS(ry)+ABS(rz))) - rx = rx-SIGN(corr, rx) - ry = ry-SIGN(corr, ry) - rz = rz-SIGN(corr, rz) + rx = rx - ANINT(rx) + ry = ry - ANINT(ry) + rz = rz - ANINT(rz) + corr = 0.5_dp*AINT(r75*(ABS(rx) + ABS(ry) + ABS(rz))) + rx = rx - SIGN(corr, rx) + ry = ry - SIGN(corr, ry) + rz = rz - SIGN(corr, rz) r(1) = rx*helium%cell_size r(2) = ry*helium%cell_size @@ -217,51 +217,51 @@ SUBROUTINE helium_pbc_trocta_opt(helium, r) rx = r(1)*cell_size_inv IF (rx > 0.5_dp) THEN - rx = rx-REAL(INT(rx+0.5_dp), dp) + rx = rx - REAL(INT(rx + 0.5_dp), dp) ELSEIF (rx < -0.5_dp) THEN - rx = rx-REAL(INT(rx-0.5_dp), dp) + rx = rx - REAL(INT(rx - 0.5_dp), dp) END IF ry = r(2)*cell_size_inv IF (ry > 0.5_dp) THEN - ry = ry-REAL(INT(ry+0.5_dp), dp) + ry = ry - REAL(INT(ry + 0.5_dp), dp) ELSEIF (ry < -0.5_dp) THEN - ry = ry-REAL(INT(ry-0.5_dp), dp) + ry = ry - REAL(INT(ry - 0.5_dp), dp) END IF rz = r(3)*cell_size_inv IF (rz > 0.5_dp) THEN - rz = rz-REAL(INT(rz+0.5_dp), dp) + rz = rz - REAL(INT(rz + 0.5_dp), dp) ELSEIF (rz < -0.5_dp) THEN - rz = rz-REAL(INT(rz-0.5_dp), dp) + rz = rz - REAL(INT(rz - 0.5_dp), dp) END IF corr = 0.0_dp IF (rx > 0.0_dp) THEN - corr = corr+rx + corr = corr + rx sx = 0.5_dp ELSE - corr = corr-rx + corr = corr - rx sx = -0.5_dp END IF IF (ry > 0.0_dp) THEN - corr = corr+ry + corr = corr + ry sy = 0.5_dp ELSE - corr = corr-ry + corr = corr - ry sy = -0.5_dp END IF IF (rz > 0.0_dp) THEN - corr = corr+rz + corr = corr + rz sz = 0.5_dp ELSE - corr = corr-rz + corr = corr - rz sz = -0.5_dp END IF IF (corr > 0.75_dp) THEN - rx = rx-sx - ry = ry-sy - rz = rz-sz + rx = rx - sx + ry = ry - sy + rz = rz - sz END IF r(1) = rx*cell_size @@ -290,9 +290,9 @@ SUBROUTINE helium_boxmean_3d(helium, a, b, c) REAL(KIND=dp), DIMENSION(3), INTENT(IN) :: a, b REAL(KIND=dp), DIMENSION(3), INTENT(OUT) :: c - c(:) = b(:)-a(:) + c(:) = b(:) - a(:) CALL helium_pbc(helium, c) - c(:) = a(:)+0.5_dp*c(:) + c(:) = a(:) + 0.5_dp*c(:) CALL helium_pbc(helium, c) RETURN END SUBROUTINE helium_boxmean_3d @@ -336,7 +336,7 @@ SUBROUTINE helium_calc_atom_cycle_length(helium) path_end_reached = .FALSE. curr_idx = start_idx DO ia = 1, helium%atoms - clen = clen+1 + clen = clen + 1 atoms_in_cycle(clen) = curr_idx atom_was_used(curr_idx) = .TRUE. @@ -418,12 +418,12 @@ FUNCTION helium_calc_cycles(permutation) RESULT(cycles) cur_cycle => helium_cycle_of(curat, permutation) ! include the current cycle in the pool of "used" indices - nused = nused+SIZE(cur_cycle) + nused = nused + SIZE(cur_cycle) CALL reallocate(used_indices, 1, nused) - used_indices(nused-SIZE(cur_cycle)+1:nused) = cur_cycle(1:SIZE(cur_cycle)) + used_indices(nused - SIZE(cur_cycle) + 1:nused) = cur_cycle(1:SIZE(cur_cycle)) ! store the pointer to the current cycle - ncycl = ncycl+1 + ncycl = ncycl + 1 my_cycles(ncycl)%iap => cur_cycle ! free the local pointer @@ -431,7 +431,7 @@ FUNCTION helium_calc_cycles(permutation) RESULT(cycles) ! try to increment the current atom index DO WHILE (ANY(used_indices .EQ. curat)) - curat = curat+1 + curat = curat + 1 END DO END DO @@ -560,7 +560,7 @@ SUBROUTINE helium_calc_rho(helium) wn = helium_cycle_winding_number(helium, cycles(ic)%iap, helium%pos) DO id = 1, 3 IF (ABS(wn(id)) .GT. 100.0_dp*EPSILON(0.0_dp)) THEN - nw(id) = nw(id)+SIZE(cycles(ic)%iap) + nw(id) = nw(id) + SIZE(cycles(ic)%iap) END IF END DO END DO @@ -609,13 +609,13 @@ SUBROUTINE helium_calc_rho(helium) ! bin the bead positions of the current atom using the increments set above DO ib = 1, helium%beads ! map the current bead position to the corresponding voxel - r(:) = helium%pos(:, ia, ib)-helium%center(:) + r(:) = helium%pos(:, ia, ib) - helium%center(:) ! enforce PBC even if this is a non-periodic calc to avoid density leakage CALL helium_pbc(helium, r, enforce=.TRUE.) ! set up bin indices (translate by L/2 to avoid non-positive array indices) - bx = INT((r(1)+maxr_half(1))*invdr)+1 - by = INT((r(2)+maxr_half(2))*invdr)+1 - bz = INT((r(3)+maxr_half(3))*invdr)+1 + bx = INT((r(1) + maxr_half(1))*invdr) + 1 + by = INT((r(2) + maxr_half(2))*invdr) + 1 + bz = INT((r(3) + maxr_half(3))*invdr) + 1 ! check that the resulting bin numbers are within array bounds ltmp1 = (0 .LT. bx) .AND. (bx .LE. nbin) ltmp2 = (0 .LT. by) .AND. (by .LE. nbin) @@ -624,10 +624,10 @@ SUBROUTINE helium_calc_rho(helium) ! increment all the estimators (those that the current atom does not ! contribute to have increment incr(ic)==0) DO ic = 1, helium%rho_num_act - helium%rho_inst(ic, bx, by, bz) = helium%rho_inst(ic, bx, by, bz)+helium%rho_incr(ic, ia, ib) + helium%rho_inst(ic, bx, by, bz) = helium%rho_inst(ic, bx, by, bz) + helium%rho_incr(ic, ia, ib) END DO ELSE - n_out_of_range = n_out_of_range+1 + n_out_of_range = n_out_of_range + 1 END IF END DO END DO @@ -684,16 +684,16 @@ SUBROUTINE helium_norm_rho(helium, rho) CASE (denominator_rperp2) ndim = helium%rho_nbin - ro(:) = helium%center(:)-0.5_dp*(helium%rho_maxr-helium%rho_delr) + ro(:) = helium%center(:) - 0.5_dp*(helium%rho_maxr - helium%rho_delr) DO ix = 1, ndim DO iy = 1, ndim DO iz = 1, ndim - rx = ro(1)+REAL(ix-1, dp)*helium%rho_delr - ry = ro(2)+REAL(iy-1, dp)*helium%rho_delr - rz = ro(3)+REAL(iz-1, dp)*helium%rho_delr - invrperp(1) = 1.0_dp/(ry*ry+rz*rz) - invrperp(2) = 1.0_dp/(rz*rz+rx*rx) - invrperp(3) = 1.0_dp/(rx*rx+ry*ry) + rx = ro(1) + REAL(ix - 1, dp)*helium%rho_delr + ry = ro(2) + REAL(iy - 1, dp)*helium%rho_delr + rz = ro(3) + REAL(iz - 1, dp)*helium%rho_delr + invrperp(1) = 1.0_dp/(ry*ry + rz*rz) + invrperp(2) = 1.0_dp/(rz*rz + rx*rx) + invrperp(3) = 1.0_dp/(rx*rx + ry*ry) rho(2, ix, iy, iz) = rho(2, ix, iy, iz)*invrperp(1) rho(3, ix, iy, iz) = rho(3, ix, iy, iz)*invrperp(2) rho(4, ix, iy, iz) = rho(4, ix, iy, iz)*invrperp(3) @@ -750,15 +750,15 @@ SUBROUTINE helium_calc_rdf(helium) DO ic = 1, helium%atoms IF (ia == ic) CYCLE - r(:) = helium%pos(:, ic, ib)-r0(:) + r(:) = helium%pos(:, ic, ib) - r0(:) CALL helium_pbc(helium, r) - ri = SQRT(r(1)*r(1)+r(2)*r(2)+r(3)*r(3)) - bin = INT(ri*invdr)+1 + ri = SQRT(r(1)*r(1) + r(2)*r(2) + r(3)*r(3)) + bin = INT(ri*invdr) + 1 IF ((0 .LT. bin) .AND. (bin .LE. nbin)) THEN ! increment the RDF value for He atoms inside the r_6 sphere - helium%rdf_inst(ind_hehe, bin) = helium%rdf_inst(ind_hehe, bin)+1.0_dp + helium%rdf_inst(ind_hehe, bin) = helium%rdf_inst(ind_hehe, bin) + 1.0_dp ELSE - n_out_of_range = n_out_of_range+1 + n_out_of_range = n_out_of_range + 1 END IF END DO END DO @@ -769,18 +769,18 @@ SUBROUTINE helium_calc_rdf(helium) IF (helium%solute_present .AND. helium%rdf_sol_he) THEN DO ib = 1, helium%beads DO ia = 1, helium%solute_atoms - r0(:) = helium%rdf_centers(ib, 3*(ia-1)+1:3*(ia-1)+3) + r0(:) = helium%rdf_centers(ib, 3*(ia - 1) + 1:3*(ia - 1) + 3) DO ic = 1, helium%atoms - r(:) = helium%pos(:, ic, ib)-r0(:) + r(:) = helium%pos(:, ic, ib) - r0(:) CALL helium_pbc(helium, r) - ri = SQRT(r(1)*r(1)+r(2)*r(2)+r(3)*r(3)) - bin = INT(ri*invdr)+1 + ri = SQRT(r(1)*r(1) + r(2)*r(2) + r(3)*r(3)) + bin = INT(ri*invdr) + 1 IF ((0 .LT. bin) .AND. (bin .LE. nbin)) THEN ! increment the RDF value for He atoms inside the r_6 sphere - helium%rdf_inst(ind_hehe+ia, bin) = helium%rdf_inst(ind_hehe+ia, bin)+1.0_dp + helium%rdf_inst(ind_hehe + ia, bin) = helium%rdf_inst(ind_hehe + ia, bin) + 1.0_dp ELSE - n_out_of_range = n_out_of_range+1 + n_out_of_range = n_out_of_range + 1 END IF END DO END DO @@ -806,29 +806,29 @@ SUBROUTINE helium_calc_rdf(helium) pref(:) = helium%density*helium%beads*helium%atoms ! Correct for He-He-RDF IF (helium%rdf_he_he) THEN - pref(1) = pref(1)/helium%atoms*(helium%atoms-1) + pref(1) = pref(1)/helium%atoms*(helium%atoms - 1) END IF ELSE ! Non-periodic case has density of 0, use integral for normalzation ! This leads to a unit of 1/volume of the RDF pref(:) = 0.5_dp*helium%rdf_inst(:, 1) - DO bin = 2, helium%rdf_nbin-1 - pref(:) = pref(:)+helium%rdf_inst(:, bin) + DO bin = 2, helium%rdf_nbin - 1 + pref(:) = pref(:) + helium%rdf_inst(:, bin) END DO - pref(:) = pref(:)+0.5_dp*helium%rdf_inst(:, helium%rdf_nbin) + pref(:) = pref(:) + 0.5_dp*helium%rdf_inst(:, helium%rdf_nbin) !set integral of histogram to number of atoms: pref(:) = pref(:)/helium%atoms ! Correct for He-He-RDF IF (helium%rdf_he_he) THEN - pref(1) = pref(1)*helium%atoms/(helium%atoms-1) + pref(1) = pref(1)*helium%atoms/(helium%atoms - 1) END IF END IF ! Volume integral first: DO bin = 1, helium%rdf_nbin - rlower = REAL(bin-1, dp)*helium%rdf_delr - rupper = rlower+helium%rdf_delr - nideal = (rupper**3-rlower**3)*4.0_dp*pi/3.0_dp + rlower = REAL(bin - 1, dp)*helium%rdf_delr + rupper = rlower + helium%rdf_delr + nideal = (rupper**3 - rlower**3)*4.0_dp*pi/3.0_dp helium%rdf_inst(:, bin) = helium%rdf_inst(:, bin)/nideal END DO ! No normalization for density @@ -869,10 +869,10 @@ SUBROUTINE helium_calc_plength(helium) k = 1 DO IF (j == i) EXIT - k = k+1 + k = k + 1 j = helium%permutation(j) END DO - helium%plength_inst(k) = helium%plength_inst(k)+1 + helium%plength_inst(k) = helium%plength_inst(k) + 1 END DO helium%plength_inst(:) = helium%plength_inst(:)/helium%atoms @@ -902,18 +902,18 @@ SUBROUTINE helium_rotate(helium, nslices) b = helium%beads n = helium%atoms i = MOD(nslices, b) - IF (i < 0) i = i+b + IF (i < 0) i = i + b IF ((i >= b) .OR. (i < 1)) RETURN - helium%relrot = MOD(helium%relrot+i, b) + helium%relrot = MOD(helium%relrot + i, b) DO k = 1, i helium%work(:, :, k) = helium%pos(:, :, k) END DO - DO k = i+1, b - helium%pos(:, :, k-i) = helium%pos(:, :, k) + DO k = i + 1, b + helium%pos(:, :, k - i) = helium%pos(:, :, k) END DO DO k = 1, i DO j = 1, n - helium%pos(:, j, b-i+k) = helium%work(:, helium%permutation(j), k) + helium%pos(:, j, b - i + k) = helium%work(:, helium%permutation(j), k) END DO END DO RETURN @@ -947,45 +947,45 @@ FUNCTION helium_eval_expansion(helium, r, rp, tab, cut) RESULT(res) CALL helium_pbc(helium, br) CALL helium_pbc(helium, brp) - ar = SQRT(br(1)**2+br(2)**2+br(3)**2) - arp = SQRT(brp(1)**2+brp(2)**2+brp(3)**2) - q = 0.5_dp*(ar+arp) + ar = SQRT(br(1)**2 + br(2)**2 + br(3)**2) + arp = SQRT(brp(1)**2 + brp(2)**2 + brp(3)**2) + q = 0.5_dp*(ar + arp) IF (helium%periodic .AND. ((ar > 0.5_dp*helium%cell_size) & .OR. (arp > 0.5_dp*helium%cell_size))) THEN v = 0.0_dp IF (arp > 0.5_dp*helium%cell_size) THEN - v = v+REAL(cut, dp)*helium_spline(tab(1, 1)%spline_data, 0.5_dp*helium%cell_size) + v = v + REAL(cut, dp)*helium_spline(tab(1, 1)%spline_data, 0.5_dp*helium%cell_size) ELSE - v = v+helium_spline(tab(1, 1)%spline_data, arp) + v = v + helium_spline(tab(1, 1)%spline_data, arp) END IF IF (ar > 0.5_dp*helium%cell_size) THEN - v = v+REAL(cut, dp)*helium_spline(tab(1, 1)%spline_data, 0.5_dp*helium%cell_size) + v = v + REAL(cut, dp)*helium_spline(tab(1, 1)%spline_data, 0.5_dp*helium%cell_size) ELSE - v = v+helium_spline(tab(1, 1)%spline_data, ar) + v = v + helium_spline(tab(1, 1)%spline_data, ar) END IF res = 0.5_dp*v ELSE ! end-point action (first term): - v = 0.5_dp*(helium_spline(tab(1, 1)%spline_data, ar)+helium_spline(tab(1, 1)%spline_data, arp)) + v = 0.5_dp*(helium_spline(tab(1, 1)%spline_data, ar) + helium_spline(tab(1, 1)%spline_data, arp)) DO i = 1, 3 - br(i) = br(i)-brp(i) + br(i) = br(i) - brp(i) END DO CALL helium_pbc(helium, br) - s = br(1)**2+br(2)**2+br(3)**2 - z = (ar-arp)**2 + s = br(1)**2 + br(2)**2 + br(3)**2 + z = (ar - arp)**2 arp = 1.0_dp ! j=0 terms DO i = 2, SIZE(tab, 1) arp = arp*s - v = v+arp*helium_spline(tab(i, 1)%spline_data, q) + v = v + arp*helium_spline(tab(i, 1)%spline_data, q) END DO ar = 1.0_dp DO j = 2, SIZE(tab, 2) ar = ar*z arp = ar DO i = j, SIZE(tab, 1) - v = v+arp*helium_spline(tab(i, j)%spline_data, q) + v = v + arp*helium_spline(tab(i, j)%spline_data, q) arp = arp*s END DO END DO @@ -1018,7 +1018,7 @@ SUBROUTINE helium_update_transition_matrix(helium) ALLOCATE (p(2*nb)) ALLOCATE (order(nb)) ALLOCATE (lens(2*nb)) - b = helium%beads-helium%bisection+1 + b = helium%beads - helium%bisection + 1 f = -0.5_dp/(helium%hb2m*helium%tau*helium%bisection) tmatrix => helium%tmatrix pmatrix => helium%pmatrix @@ -1029,19 +1029,19 @@ SUBROUTINE helium_update_transition_matrix(helium) DO i = 1, nb DO j = 1, nb v = 0.0_dp - r(:) = pos(:, i, b)-pos(:, j, 1) + r(:) = pos(:, i, b) - pos(:, j, 1) CALL helium_pbc(helium, r) - v = v+r(1)*r(1)+r(2)*r(2)+r(3)*r(3) + v = v + r(1)*r(1) + r(2)*r(2) + r(3)*r(3) pmatrix(i, j) = f*v END DO t = pmatrix(i, perm(i)) ! just some reference v = 0.0_dp DO j = 1, nb - tmatrix(i, j) = EXP(pmatrix(i, j)-t) - v = v+tmatrix(i, j) + tmatrix(i, j) = EXP(pmatrix(i, j) - t) + v = v + tmatrix(i, j) END DO ! normalize - q = t+LOG(v) + q = t + LOG(v) t = 1.0_dp/v DO j = 1, nb tmatrix(i, j) = tmatrix(i, j)*t @@ -1092,12 +1092,12 @@ SUBROUTINE helium_update_transition_matrix(helium) p(j) = tmatrix(i, j) END DO IF (nb > 1) THEN ! if nb = 1 it is already sorted. - k = nb/2+1 + k = nb/2 + 1 c = nb DO IF (k > 1) THEN ! building up the heap: - k = k-1 + k = k - 1 n = order(k) v = p(k) ELSE @@ -1106,7 +1106,7 @@ SUBROUTINE helium_update_transition_matrix(helium) v = p(c) order(c) = order(1) p(c) = p(1) - c = c-1 + c = c - 1 IF (c == 1) THEN order(1) = n p(1) = v @@ -1119,7 +1119,7 @@ SUBROUTINE helium_update_transition_matrix(helium) DO IF (j > c) EXIT IF (j < c) THEN - IF (p(j) < p(j+1)) j = j+1 + IF (p(j) < p(j + 1)) j = j + 1 END IF IF (v >= p(j)) EXIT order(m) = order(j) @@ -1141,35 +1141,35 @@ SUBROUTINE helium_update_transition_matrix(helium) ! by combining older elements/nodes ! first fill unused part of array with guard values: - DO j = nb+1, 2*nb + DO j = nb + 1, 2*nb p(j) = 2.0_dp END DO ! j - head of leaf queue ! c+1 - head of node queue in p (c in lens) ! m+1 - tail of node queue in p (m in lens) - c = nb+1 + c = nb + 1 j = 1 - DO m = nb+1, 2*nb-1 + DO m = nb + 1, 2*nb - 1 ! get next smallest element - IF (p(j) < p(c+1)) THEN + IF (p(j) < p(c + 1)) THEN v = p(j) lens(j) = m - j = j+1 + j = j + 1 ELSE - v = p(c+1) + v = p(c + 1) lens(c) = m - c = c+1 + c = c + 1 END IF ! get the second next smallest element - IF (p(j) < p(c+1)) THEN - p(m+1) = v+p(j) + IF (p(j) < p(c + 1)) THEN + p(m + 1) = v + p(j) lens(j) = m - j = j+1 + j = j + 1 ELSE - p(m+1) = v+p(c+1) + p(m + 1) = v + p(c + 1) lens(c) = m - c = c+1 + c = c + 1 END IF END DO @@ -1177,9 +1177,9 @@ SUBROUTINE helium_update_transition_matrix(helium) ! the root of the tree is at 2*nb-1 ! calculate the depth of each node in the tree now: (root = 0) - lens(2*nb-1) = 0 - DO m = 2*nb-2, 1, -1 - lens(m) = lens(lens(m))+1 + lens(2*nb - 1) = 0 + DO m = 2*nb - 2, 1, -1 + lens(m) = lens(lens(m)) + 1 END DO ! lens(:) now has the depths of the nodes/leafs @@ -1188,15 +1188,15 @@ SUBROUTINE helium_update_transition_matrix(helium) ! calculate average search depth (for information only) v = 0.0_dp DO j = 1, nb - v = v+p(j)*lens(j) + v = v + p(j)*lens(j) END DO PRINT *, "Expected number of comparisons with i=", i, v #endif ! reset the nodes, for the canonical tree we just need the leaf info DO j = 1, nb - lens(j+nb) = 0 - p(j+nb) = 0.0_dp + lens(j + nb) = 0 + p(j + nb) = 0.0_dp END DO ! build the canonical tree (number of decisions on average are @@ -1205,22 +1205,22 @@ SUBROUTINE helium_update_transition_matrix(helium) ! c head of leafs ! m head of interior nodes c = 1 - m = nb+1 - DO k = 1, 2*nb-2 - j = nb+1+(k-1)/2 - IF (lens(c) > lens(m+1)) THEN + m = nb + 1 + DO k = 1, 2*nb - 2 + j = nb + 1 + (k - 1)/2 + IF (lens(c) > lens(m + 1)) THEN nmatrix(i, k) = -order(c) - lens(j+1) = lens(c)-1 + lens(j + 1) = lens(c) - 1 v = p(c) - c = c+1 + c = c + 1 ELSE - nmatrix(i, k) = m-nb - lens(j+1) = lens(m+1)-1 + nmatrix(i, k) = m - nb + lens(j + 1) = lens(m + 1) - 1 v = p(m) - m = m+1 + m = m + 1 END IF - p(j) = p(j)+v - IF (MOD(k, 2) == 1) tmatrix(i, j-nb) = v + p(j) = p(j) + v + IF (MOD(k, 2) == 1) tmatrix(i, j - nb) = v END DO ! now: @@ -1235,19 +1235,19 @@ SUBROUTINE helium_update_transition_matrix(helium) ! fix offsets for decision tree: - p(nb-1) = 0.0_dp - DO m = nb-1, 1, -1 + p(nb - 1) = 0.0_dp + DO m = nb - 1, 1, -1 ! if right child is a node, set its offset and ! change its decision value IF (nmatrix(i, 2*m) > 0) THEN p(nmatrix(i, 2*m)) = tmatrix(i, m) - tmatrix(i, nmatrix(i, 2*m)) = tmatrix(i, nmatrix(i, 2*m))+tmatrix(i, m) + tmatrix(i, nmatrix(i, 2*m)) = tmatrix(i, nmatrix(i, 2*m)) + tmatrix(i, m) END IF ! if left child is a node, set its offset and ! change its decision value - IF (nmatrix(i, 2*m-1) > 0) THEN - p(nmatrix(i, 2*m-1)) = p(m) - tmatrix(i, nmatrix(i, 2*m-1)) = tmatrix(i, nmatrix(i, 2*m-1))+p(m) + IF (nmatrix(i, 2*m - 1) > 0) THEN + p(nmatrix(i, 2*m - 1)) = p(m) + tmatrix(i, nmatrix(i, 2*m - 1)) = tmatrix(i, nmatrix(i, 2*m - 1)) + p(m) END IF END DO @@ -1264,10 +1264,10 @@ SUBROUTINE helium_update_transition_matrix(helium) DO j = 1, c v = next_random_number(helium%rng_stream_uniform) ! walk down the search tree: - k = nb-1 + k = nb - 1 DO IF (tmatrix(i, k) > v) THEN - k = nmatrix(i, 2*k-1) + k = nmatrix(i, 2*k - 1) ELSE k = nmatrix(i, 2*k) END IF @@ -1275,14 +1275,14 @@ SUBROUTINE helium_update_transition_matrix(helium) END DO k = -k ! increment the counter for this particle index - lens(k) = lens(k)+1 + lens(k) = lens(k) + 1 END DO ! search for maximum deviation from expectation value ! (relative to the expected variance) v = 0.0_dp k = -1 DO j = 1, nb - q = ABS((lens(j)-c*p(j))/SQRT(c*p(j))) + q = ABS((lens(j) - c*p(j))/SQRT(c*p(j))) !PRINT *,j,lens(j),c*p(j) IF (q > v) THEN v = q @@ -1298,36 +1298,36 @@ SUBROUTINE helium_update_transition_matrix(helium) #if 0 !additional test code: p(:) = -1.0_dp - p(nb-1) = 0.0_dp - p(2*nb-1) = 1.0_dp - DO j = nb-1, 1, -1 + p(nb - 1) = 0.0_dp + p(2*nb - 1) = 1.0_dp + DO j = nb - 1, 1, -1 ! right child IF (nmatrix(i, 2*j) > 0) THEN c = nmatrix(i, 2*j) p(c) = tmatrix(i, j) - p(c+nb) = p(j+nb) + p(c + nb) = p(j + nb) ELSE c = -nmatrix(i, 2*j) !PRINT *,c,1.0/ipmatrix(i,c),p(j+nb)-tmatrix(i,j) - IF (ABS(1.0/ipmatrix(i, c)-(p(j+nb)-tmatrix(i, j))) > & + IF (ABS(1.0/ipmatrix(i, c) - (p(j + nb) - tmatrix(i, j))) > & 10.0_dp*EPSILON(1.0_dp)) THEN PRINT *, "Probability mismatch for particle i->j", i, c - PRINT *, "Got", p(j+nb)-tmatrix(i, j), "should be", 1.0/ipmatrix(i, c) + PRINT *, "Got", p(j + nb) - tmatrix(i, j), "should be", 1.0/ipmatrix(i, c) STOP END IF END IF ! left child - IF (nmatrix(i, 2*j-1) > 0) THEN - c = nmatrix(i, 2*j-1) - p(c+nb) = tmatrix(i, j) + IF (nmatrix(i, 2*j - 1) > 0) THEN + c = nmatrix(i, 2*j - 1) + p(c + nb) = tmatrix(i, j) p(c) = p(j) ELSE - c = -nmatrix(i, 2*j-1) + c = -nmatrix(i, 2*j - 1) !PRINT *,c,1.0/ipmatrix(i,c),tmatrix(i,j)-p(j) - IF (ABS(1.0/ipmatrix(i, c)-(tmatrix(i, j)-p(j))) > & + IF (ABS(1.0/ipmatrix(i, c) - (tmatrix(i, j) - p(j))) > & 10.0_dp*EPSILON(1.0_dp)) THEN PRINT *, "Probability mismatch for particle i->j", i, c - PRINT *, "Got", tmatrix(i, j)-p(j), "should be", 1.0/ipmatrix(i, c) + PRINT *, "Got", tmatrix(i, j) - p(j), "should be", 1.0/ipmatrix(i, c) STOP END IF END IF @@ -1342,7 +1342,7 @@ SUBROUTINE helium_update_transition_matrix(helium) helium%pweight = 0.0_dp t = next_random_number(helium%rng_stream_uniform) - helium%ptable(1) = 1+INT(t*nb) + helium%ptable(1) = 1 + INT(t*nb) helium%ptable(2) = -1 ! recalculate inverse permutation table (just in case) @@ -1373,13 +1373,13 @@ FUNCTION helium_spline(spl, xx) RESULT(res) REAL(KIND=dp) :: a, b IF (xx < spl%x1) THEN - b = spl%invh*(xx-spl%x1) - a = 1.0_dp-b - res = a*spl%y(1)+b*(spl%y(2)-spl%y2(2)*spl%h26) + b = spl%invh*(xx - spl%x1) + a = 1.0_dp - b + res = a*spl%y(1) + b*(spl%y(2) - spl%y2(2)*spl%h26) ELSE IF (xx > spl%xn) THEN - b = spl%invh*(xx-spl%xn)+1.0_dp - a = 1.0_dp-b - res = b*spl%y(spl%n)+a*(spl%y(spl%n-1)-spl%y2(spl%n-1)*spl%h26) + b = spl%invh*(xx - spl%xn) + 1.0_dp + a = 1.0_dp - b + res = b*spl%y(spl%n) + a*(spl%y(spl%n - 1) - spl%y2(spl%n - 1)*spl%h26) ELSE res = spline_value(spl, xx) END IF @@ -1406,10 +1406,10 @@ FUNCTION helium_bead_rij(helium, ia, ib, ja, jb) RESULT(rij) REAL(KIND=dp) :: dx, dy, dz - dx = helium%pos(1, ia, ib)-helium%pos(1, ja, jb) - dy = helium%pos(2, ia, ib)-helium%pos(2, ja, jb) - dz = helium%pos(3, ia, ib)-helium%pos(3, ja, jb) - rij = SQRT(dx*dx+dy*dy+dz*dz) + dx = helium%pos(1, ia, ib) - helium%pos(1, ja, jb) + dy = helium%pos(2, ia, ib) - helium%pos(2, ja, jb) + dz = helium%pos(3, ia, ib) - helium%pos(3, ja, jb) + rij = SQRT(dx*dx + dy*dy + dz*dz) RETURN END FUNCTION helium_bead_rij @@ -1481,7 +1481,7 @@ FUNCTION helium_cycle_number(helium, atom_number, permutation) RESULT(cycle_numb IF (new_cycle) THEN ! increase number of cycles and update the current cycle's index - num_cycles = num_cycles+1 + num_cycles = num_cycles + 1 cycle_index(num_cycles) = cycle_idx END IF @@ -1554,7 +1554,7 @@ FUNCTION helium_path_length(helium, atom_number, permutation) RESULT(path_length path_length = 0 path_end_reached = .FALSE. DO ia = 1, helium%atoms - path_length = path_length+1 + path_length = path_length + 1 atom_idx = permutation(atom_idx) IF (atom_idx .EQ. atom_number) THEN path_end_reached = .TRUE. @@ -1603,7 +1603,7 @@ FUNCTION helium_cycle_of(element, permutation) RESULT(CYCLE) icur = element cycle_end_reached = .FALSE. DO ia = 1, nsize - len = len+1 + len = len + 1 my_cycle(len) = icur icur = permutation(icur) IF (icur .EQ. element) THEN @@ -1650,19 +1650,19 @@ FUNCTION helium_total_winding_number(helium) RESULT(wnum) wnum(:) = 0.0_dp DO ia = 1, helium%atoms ! sum of contributions from the rest of bead pairs - DO ib = 1, helium%beads-1 + DO ib = 1, helium%beads - 1 ri => helium%pos(:, ia, ib) - rj => helium%pos(:, ia, ib+1) - rcur(:) = ri(:)-rj(:) + rj => helium%pos(:, ia, ib + 1) + rcur(:) = ri(:) - rj(:) CALL helium_pbc(helium, rcur) - wnum(:) = wnum(:)+rcur(:) + wnum(:) = wnum(:) + rcur(:) END DO ! contribution from the last and the first bead ri => helium%pos(:, ia, helium%beads) rj => helium%pos(:, helium%permutation(ia), 1) - rcur(:) = ri(:)-rj(:) + rcur(:) = ri(:) - rj(:) CALL helium_pbc(helium, rcur) - wnum(:) = wnum(:)+rcur(:) + wnum(:) = wnum(:) + rcur(:) END DO END FUNCTION helium_total_winding_number @@ -1697,11 +1697,11 @@ FUNCTION helium_link_winding_number(helium, ia, ib) RESULT(wnum) ja1 = ia ja2 = ia jb1 = ib - jb2 = ib+1 + jb2 = ib + 1 END IF r1 => helium%pos(:, ja1, jb1) r2 => helium%pos(:, ja2, jb2) - wnum(:) = r1(:)-r2(:) + wnum(:) = r1(:) - r2(:) CALL helium_pbc(helium, wnum) RETURN @@ -1728,7 +1728,7 @@ FUNCTION helium_total_winding_number_linkwise(helium) RESULT(wnum) wnum(:) = 0.0_dp DO ia = 1, helium%atoms DO ib = 1, helium%beads - wnum(:) = wnum(:)+helium_link_winding_number(helium, ia, ib) + wnum(:) = wnum(:) + helium_link_winding_number(helium, ia, ib) END DO END DO @@ -1764,12 +1764,12 @@ FUNCTION helium_cycle_winding_number(helium, CYCLE, pos) RESULT(wnum) wnum(:) = 0.0_dp DO ia = 1, nsize ! contributions from all bead pairs of the current atom - DO ib = 1, helium%beads-1 + DO ib = 1, helium%beads - 1 ri => pos(:, CYCLE(ia), ib) - rj => pos(:, CYCLE(ia), ib+1) - rcur(:) = ri(:)-rj(:) + rj => pos(:, CYCLE(ia), ib + 1) + rcur(:) = ri(:) - rj(:) CALL helium_pbc(helium, rcur) - wnum(:) = wnum(:)+rcur(:) + wnum(:) = wnum(:) + rcur(:) END DO ! contribution from the last bead of the current atom ! and the first bead of the next atom @@ -1777,13 +1777,13 @@ FUNCTION helium_cycle_winding_number(helium, CYCLE, pos) RESULT(wnum) IF (ia .EQ. nsize) THEN i2 = CYCLE(1) ELSE - i2 = CYCLE(ia+1) + i2 = CYCLE(ia + 1) END IF ri => pos(:, i1, helium%beads) rj => pos(:, i2, 1) - rcur(:) = ri(:)-rj(:) + rcur(:) = ri(:) - rj(:) CALL helium_pbc(helium, rcur) - wnum(:) = wnum(:)+rcur(:) + wnum(:) = wnum(:) + rcur(:) END DO RETURN @@ -1817,7 +1817,7 @@ FUNCTION helium_total_winding_number_cyclewise(helium) RESULT(wnum) wnum(:) = 0.0_dp DO ic = 1, SIZE(cycles) wn = helium_cycle_winding_number(helium, cycles(ic)%iap, helium%pos) - wnum(:) = wnum(:)+wn(:) + wnum(:) = wnum(:) + wn(:) END DO DEALLOCATE (cycles) @@ -1846,34 +1846,34 @@ FUNCTION helium_total_projected_area(helium) RESULT(area) area(:) = 0.0_dp DO ia = 1, helium%atoms ! contributions from all links of the current atom - DO ib = 1, helium%beads-1 + DO ib = 1, helium%beads - 1 r1(:) = helium%pos(:, ia, ib) - r2(:) = helium%pos(:, ia, ib+1) + r2(:) = helium%pos(:, ia, ib + 1) ! comment out for non-PBC version --> - r12(:) = r2(:)-r1(:) + r12(:) = r2(:) - r1(:) CALL helium_pbc(helium, r1) CALL helium_pbc(helium, r12) - r2(:) = r1(:)+r12(:) + r2(:) = r1(:) + r12(:) ! comment out for non-PBC version <-- - rcur(1) = r1(2)*r2(3)-r1(3)*r2(2) - rcur(2) = r1(3)*r2(1)-r1(1)*r2(3) - rcur(3) = r1(1)*r2(2)-r1(2)*r2(1) - area(:) = area(:)+rcur(:) + rcur(1) = r1(2)*r2(3) - r1(3)*r2(2) + rcur(2) = r1(3)*r2(1) - r1(1)*r2(3) + rcur(3) = r1(1)*r2(2) - r1(2)*r2(1) + area(:) = area(:) + rcur(:) END DO ! contribution from the last bead of the current atom ! and the first bead of the next atom r1(:) = helium%pos(:, ia, helium%beads) r2(:) = helium%pos(:, helium%permutation(ia), 1) ! comment out for non-PBC version --> - r12(:) = r2(:)-r1(:) + r12(:) = r2(:) - r1(:) CALL helium_pbc(helium, r1) CALL helium_pbc(helium, r12) - r2(:) = r1(:)+r12(:) + r2(:) = r1(:) + r12(:) ! comment out for non-PBC version <-- - rcur(1) = r1(2)*r2(3)-r1(3)*r2(2) - rcur(2) = r1(3)*r2(1)-r1(1)*r2(3) - rcur(3) = r1(1)*r2(2)-r1(2)*r2(1) - area(:) = area(:)+rcur(:) + rcur(1) = r1(2)*r2(3) - r1(3)*r2(2) + rcur(2) = r1(3)*r2(1) - r1(1)*r2(3) + rcur(3) = r1(1)*r2(2) - r1(2)*r2(1) + area(:) = area(:) + rcur(:) END DO area(:) = 0.5_dp*area(:) @@ -1910,19 +1910,19 @@ FUNCTION helium_link_projected_area(helium, ia, ib) RESULT(area) ja1 = ia ja2 = ia jb1 = ib - jb2 = ib+1 + jb2 = ib + 1 END IF r1(:) = helium%pos(:, ja1, jb1) r2(:) = helium%pos(:, ja2, jb2) ! comment out for non-PBC version --> - r12(:) = r2(:)-r1(:) + r12(:) = r2(:) - r1(:) CALL helium_pbc(helium, r1) CALL helium_pbc(helium, r12) - r2(:) = r1(:)+r12(:) + r2(:) = r1(:) + r12(:) ! comment out for non-PBC version <-- - area(1) = r1(2)*r2(3)-r1(3)*r2(2) - area(2) = r1(3)*r2(1)-r1(1)*r2(3) - area(3) = r1(1)*r2(2)-r1(2)*r2(1) + area(1) = r1(2)*r2(3) - r1(3)*r2(2) + area(2) = r1(3)*r2(1) - r1(1)*r2(3) + area(3) = r1(1)*r2(2) - r1(2)*r2(1) area(:) = 0.5_dp*area(:) RETURN @@ -1949,7 +1949,7 @@ FUNCTION helium_total_projected_area_linkwise(helium) RESULT(area) area(:) = 0.0_dp DO ia = 1, helium%atoms DO ib = 1, helium%beads - area(:) = area(:)+helium_link_projected_area(helium, ia, ib) + area(:) = area(:) + helium_link_projected_area(helium, ia, ib) END DO END DO @@ -1982,13 +1982,13 @@ FUNCTION helium_cycle_projected_area(helium, CYCLE) RESULT(area) rsum(:) = 0.0_dp DO ia = 1, nsize ! contributions from all bead pairs of the current atom - DO ib = 1, helium%beads-1 + DO ib = 1, helium%beads - 1 ri => helium%pos(:, CYCLE(ia), ib) - rj => helium%pos(:, CYCLE(ia), ib+1) - rcur(1) = ri(2)*rj(3)-ri(3)*rj(2) - rcur(2) = ri(3)*rj(1)-ri(1)*rj(3) - rcur(3) = ri(1)*rj(2)-ri(2)*rj(1) - rsum(:) = rsum(:)+rcur(:) + rj => helium%pos(:, CYCLE(ia), ib + 1) + rcur(1) = ri(2)*rj(3) - ri(3)*rj(2) + rcur(2) = ri(3)*rj(1) - ri(1)*rj(3) + rcur(3) = ri(1)*rj(2) - ri(2)*rj(1) + rsum(:) = rsum(:) + rcur(:) END DO ! contribution from the last bead of the current atom ! and the first bead of the next atom @@ -1996,14 +1996,14 @@ FUNCTION helium_cycle_projected_area(helium, CYCLE) RESULT(area) IF (ia .EQ. nsize) THEN i2 = CYCLE(1) ELSE - i2 = CYCLE(ia+1) + i2 = CYCLE(ia + 1) END IF ri => helium%pos(:, i1, helium%beads) rj => helium%pos(:, i2, 1) - rcur(1) = ri(2)*rj(3)-ri(3)*rj(2) - rcur(2) = ri(3)*rj(1)-ri(1)*rj(3) - rcur(3) = ri(1)*rj(2)-ri(2)*rj(1) - rsum(:) = rsum(:)+rcur(:) + rcur(1) = ri(2)*rj(3) - ri(3)*rj(2) + rcur(2) = ri(3)*rj(1) - ri(1)*rj(3) + rcur(3) = ri(1)*rj(2) - ri(2)*rj(1) + rsum(:) = rsum(:) + rcur(:) END DO area(:) = 0.5_dp*rsum(:) @@ -2037,17 +2037,17 @@ FUNCTION helium_cycle_projected_area_pbc(helium, CYCLE) RESULT(area) area(:) = 0.0_dp DO ia = 1, nsize ! contributions from all bead pairs of the current atom - DO ib = 1, helium%beads-1 + DO ib = 1, helium%beads - 1 r1(:) = helium%pos(:, CYCLE(ia), ib) - r2(:) = helium%pos(:, CYCLE(ia), ib+1) - r12(:) = r2(:)-r1(:) + r2(:) = helium%pos(:, CYCLE(ia), ib + 1) + r12(:) = r2(:) - r1(:) CALL helium_pbc(helium, r1) CALL helium_pbc(helium, r12) - r2(:) = r1(:)+r12(:) - rcur(1) = r1(2)*r2(3)-r1(3)*r2(2) - rcur(2) = r1(3)*r2(1)-r1(1)*r2(3) - rcur(3) = r1(1)*r2(2)-r1(2)*r2(1) - area(:) = area(:)+rcur(:) + r2(:) = r1(:) + r12(:) + rcur(1) = r1(2)*r2(3) - r1(3)*r2(2) + rcur(2) = r1(3)*r2(1) - r1(1)*r2(3) + rcur(3) = r1(1)*r2(2) - r1(2)*r2(1) + area(:) = area(:) + rcur(:) END DO ! contribution from the last bead of the current atom ! and the first bead of the next atom @@ -2055,18 +2055,18 @@ FUNCTION helium_cycle_projected_area_pbc(helium, CYCLE) RESULT(area) IF (ia .EQ. nsize) THEN i2 = CYCLE(1) ELSE - i2 = CYCLE(ia+1) + i2 = CYCLE(ia + 1) END IF r1(:) = helium%pos(:, i1, helium%beads) r2(:) = helium%pos(:, i2, 1) - r12(:) = r2(:)-r1(:) + r12(:) = r2(:) - r1(:) CALL helium_pbc(helium, r1) CALL helium_pbc(helium, r12) - r2(:) = r1(:)+r12(:) - rcur(1) = r1(2)*r2(3)-r1(3)*r2(2) - rcur(2) = r1(3)*r2(1)-r1(1)*r2(3) - rcur(3) = r1(1)*r2(2)-r1(2)*r2(1) - area(:) = area(:)+rcur(:) + r2(:) = r1(:) + r12(:) + rcur(1) = r1(2)*r2(3) - r1(3)*r2(2) + rcur(2) = r1(3)*r2(1) - r1(1)*r2(3) + rcur(3) = r1(1)*r2(2) - r1(2)*r2(1) + area(:) = area(:) + rcur(:) END DO area(:) = 0.5_dp*area(:) @@ -2101,7 +2101,7 @@ FUNCTION helium_total_projected_area_cyclewise(helium) RESULT(area) area(:) = 0.0_dp DO ic = 1, SIZE(cycles) pa = helium_cycle_projected_area(helium, cycles(ic)%iap) - area(:) = area(:)+pa(:) + area(:) = area(:) + pa(:) END DO RETURN @@ -2130,34 +2130,34 @@ FUNCTION helium_total_moment_of_inertia(helium) RESULT(moit) moit(:) = 0.0_dp DO ia = 1, helium%atoms ! contributions from all the links of the current atom - DO ib = 1, helium%beads-1 - r1(:) = helium%pos(:, ia, ib)-com(:) - r2(:) = helium%pos(:, ia, ib+1)-com(:) + DO ib = 1, helium%beads - 1 + r1(:) = helium%pos(:, ia, ib) - com(:) + r2(:) = helium%pos(:, ia, ib + 1) - com(:) ! comment out for non-PBC version --> - r12(:) = r2(:)-r1(:) + r12(:) = r2(:) - r1(:) CALL helium_pbc(helium, r1) CALL helium_pbc(helium, r12) - r2(:) = r1(:)+r12(:) + r2(:) = r1(:) + r12(:) ! comment out for non-PBC version <-- - rcur(1) = r1(2)*r2(2)+r1(3)*r2(3) - rcur(2) = r1(3)*r2(3)+r1(1)*r2(1) - rcur(3) = r1(1)*r2(1)+r1(2)*r2(2) - moit(:) = moit(:)+rcur(:) + rcur(1) = r1(2)*r2(2) + r1(3)*r2(3) + rcur(2) = r1(3)*r2(3) + r1(1)*r2(1) + rcur(3) = r1(1)*r2(1) + r1(2)*r2(2) + moit(:) = moit(:) + rcur(:) END DO ! contribution from the last bead of the current atom ! and the first bead of the next atom - r1(:) = helium%pos(:, ia, helium%beads)-com(:) - r2(:) = helium%pos(:, helium%permutation(ia), 1)-com(:) + r1(:) = helium%pos(:, ia, helium%beads) - com(:) + r2(:) = helium%pos(:, helium%permutation(ia), 1) - com(:) ! comment out for non-PBC version --> - r12(:) = r2(:)-r1(:) + r12(:) = r2(:) - r1(:) CALL helium_pbc(helium, r1) CALL helium_pbc(helium, r12) - r2(:) = r1(:)+r12(:) + r2(:) = r1(:) + r12(:) ! comment out for non-PBC version <-- - rcur(1) = r1(2)*r2(2)+r1(3)*r2(3) - rcur(2) = r1(3)*r2(3)+r1(1)*r2(1) - rcur(3) = r1(1)*r2(1)+r1(2)*r2(2) - moit(:) = moit(:)+rcur(:) + rcur(1) = r1(2)*r2(2) + r1(3)*r2(3) + rcur(2) = r1(3)*r2(3) + r1(1)*r2(1) + rcur(3) = r1(1)*r2(1) + r1(2)*r2(2) + moit(:) = moit(:) + rcur(:) END DO moit(:) = moit(:)/helium%beads @@ -2196,19 +2196,19 @@ FUNCTION helium_link_moment_of_inertia(helium, ia, ib) RESULT(moit) ja1 = ia ja2 = ia jb1 = ib - jb2 = ib+1 + jb2 = ib + 1 END IF - r1(:) = helium%pos(:, ja1, jb1)-com(:) - r2(:) = helium%pos(:, ja2, jb2)-com(:) + r1(:) = helium%pos(:, ja1, jb1) - com(:) + r2(:) = helium%pos(:, ja2, jb2) - com(:) ! comment out for non-PBC version --> - r12(:) = r2(:)-r1(:) + r12(:) = r2(:) - r1(:) CALL helium_pbc(helium, r1) CALL helium_pbc(helium, r12) - r2(:) = r1(:)+r12(:) + r2(:) = r1(:) + r12(:) ! comment out for non-PBC version <-- - moit(1) = r1(2)*r2(2)+r1(3)*r2(3) - moit(2) = r1(3)*r2(3)+r1(1)*r2(1) - moit(3) = r1(1)*r2(1)+r1(2)*r2(2) + moit(1) = r1(2)*r2(2) + r1(3)*r2(3) + moit(2) = r1(3)*r2(3) + r1(1)*r2(1) + moit(3) = r1(1)*r2(1) + r1(2)*r2(2) moit(:) = moit(:)/helium%beads RETURN @@ -2235,7 +2235,7 @@ FUNCTION helium_total_moment_of_inertia_linkwise(helium) RESULT(moit) moit(:) = 0.0_dp DO ia = 1, helium%atoms DO ib = 1, helium%beads - moit(:) = moit(:)+helium_link_moment_of_inertia(helium, ia, ib) + moit(:) = moit(:) + helium_link_moment_of_inertia(helium, ia, ib) END DO END DO @@ -2270,13 +2270,13 @@ FUNCTION helium_cycle_moment_of_inertia(helium, CYCLE, pos) RESULT(moit) com(:) = helium_com(helium) DO ia = 1, nsize ! contributions from all bead pairs of the current atom - DO ib = 1, helium%beads-1 - ri = pos(:, CYCLE(ia), ib)-com(:) - rj = pos(:, CYCLE(ia), ib+1)-com(:) - rcur(1) = ri(2)*rj(2)+ri(3)*rj(3) - rcur(2) = ri(3)*rj(3)+ri(1)*rj(1) - rcur(3) = ri(1)*rj(1)+ri(2)*rj(2) - moit(:) = moit(:)+rcur(:) + DO ib = 1, helium%beads - 1 + ri = pos(:, CYCLE(ia), ib) - com(:) + rj = pos(:, CYCLE(ia), ib + 1) - com(:) + rcur(1) = ri(2)*rj(2) + ri(3)*rj(3) + rcur(2) = ri(3)*rj(3) + ri(1)*rj(1) + rcur(3) = ri(1)*rj(1) + ri(2)*rj(2) + moit(:) = moit(:) + rcur(:) END DO ! contribution from the last bead of the current atom ! and the first bead of the next atom @@ -2284,15 +2284,15 @@ FUNCTION helium_cycle_moment_of_inertia(helium, CYCLE, pos) RESULT(moit) IF (ia .EQ. nsize) THEN i2 = CYCLE(1) ELSE - i2 = CYCLE(ia+1) + i2 = CYCLE(ia + 1) END IF ! rotation invariant bead index - ri = pos(:, i1, helium%beads)-com(:) - rj = pos(:, i2, 1)-com(:) - rcur(1) = ri(2)*rj(2)+ri(3)*rj(3) - rcur(2) = ri(3)*rj(3)+ri(1)*rj(1) - rcur(3) = ri(1)*rj(1)+ri(2)*rj(2) - moit(:) = moit(:)+rcur(:) + ri = pos(:, i1, helium%beads) - com(:) + rj = pos(:, i2, 1) - com(:) + rcur(1) = ri(2)*rj(2) + ri(3)*rj(3) + rcur(2) = ri(3)*rj(3) + ri(1)*rj(1) + rcur(3) = ri(1)*rj(1) + ri(2)*rj(2) + moit(:) = moit(:) + rcur(:) END DO moit(:) = moit(:)/helium%beads @@ -2327,7 +2327,7 @@ FUNCTION helium_total_moment_of_inertia_cyclewise(helium) RESULT(moit) moit(:) = 0.0_dp DO ic = 1, SIZE(cycles) pa = helium_cycle_moment_of_inertia(helium, cycles(ic)%iap, helium%pos) - moit(:) = moit(:)+pa(:) + moit(:) = moit(:) + pa(:) END DO DEALLOCATE (cycles) @@ -2391,7 +2391,7 @@ SUBROUTINE helium_set_rdf_coord_system(helium, pint_env) IF (helium%solute_present .AND. helium%rdf_sol_he) THEN ! Account for unequal number of beads for solute and helium DO i = 1, helium%beads - j = ((i-1)*helium%solute_beads)/helium%beads+1 + j = ((i - 1)*helium%solute_beads)/helium%beads + 1 helium%rdf_centers(i, :) = pint_env%x(j, :) END DO END IF @@ -2418,7 +2418,7 @@ FUNCTION helium_com(helium) RESULT(com) com(:) = 0.0_dp DO ia = 1, helium%atoms DO ib = 1, helium%beads - com(:) = com(:)+helium%pos(:, ia, ib) + com(:) = com(:) + helium%pos(:, ia, ib) END DO END DO com(:) = com(:)/helium%atoms/helium%beads @@ -2455,11 +2455,11 @@ FUNCTION helium_link_vector(helium, ia, ib) RESULT(lvec) ia1 = ia ia2 = ia ib1 = ib - ib2 = ib+1 + ib2 = ib + 1 END IF r1 => helium%pos(:, ia1, ib1) r2 => helium%pos(:, ia2, ib2) - lvec(:) = r2(:)-r1(:) + lvec(:) = r2(:) - r1(:) CALL helium_pbc(helium, lvec) END FUNCTION helium_link_vector @@ -2483,9 +2483,9 @@ FUNCTION helium_rperpendicular(helium, ia, ib) RESULT(rperp) REAL(KIND=dp), DIMENSION(:), POINTER :: ri ri => helium%pos(:, ia, ib) - rperp(1) = SQRT(ri(2)*ri(2)+ri(3)*ri(3)) - rperp(2) = SQRT(ri(3)*ri(3)+ri(1)*ri(1)) - rperp(3) = SQRT(ri(1)*ri(1)+ri(2)*ri(2)) + rperp(1) = SQRT(ri(2)*ri(2) + ri(3)*ri(3)) + rperp(2) = SQRT(ri(3)*ri(3) + ri(1)*ri(1)) + rperp(3) = SQRT(ri(1)*ri(1) + ri(2)*ri(2)) RETURN END FUNCTION helium_rperpendicular diff --git a/src/motion/helium_interactions.F b/src/motion/helium_interactions.F index 62a97c626f..b2f87d659d 100644 --- a/src/motion/helium_interactions.F +++ b/src/motion/helium_interactions.F @@ -82,39 +82,39 @@ SUBROUTINE helium_calc_energy(helium, pint_env) pot = 0.0_dp rmin = 1.0e20_dp rmax = 0.0_dp - DO i = 1, n-1 - DO j = i+1, n - rp(:) = pos(:, i, 1)-pos(:, j, 1) + DO i = 1, n - 1 + DO j = i + 1, n + rp(:) = pos(:, i, 1) - pos(:, j, 1) CALL helium_pbc(helium, rp) DO bead = 2, b a = 0.0_dp DO c = 1, 3 r(c) = rp(c) - a = a+r(c)**2 - rp(c) = pos(c, i, bead)-pos(c, j, bead) + a = a + r(c)**2 + rp(c) = pos(c, i, bead) - pos(c, j, bead) END DO CALL helium_pbc(helium, rp) - en = en+helium_eval_expansion(helium, r, rp, eij, 0) + en = en + helium_eval_expansion(helium, r, rp, eij, 0) a = SQRT(a) IF (a < rmin) rmin = a IF (a > rmax) rmax = a IF ((a < cell_size) .OR. nperiodic) THEN - pot = pot+helium_vij(a) + pot = pot + helium_vij(a) END IF END DO a = 0.0_dp DO c = 1, 3 r(c) = rp(c) - a = a+r(c)**2 - rp(c) = pos(c, perm(i), 1)-pos(c, perm(j), 1) + a = a + r(c)**2 + rp(c) = pos(c, perm(i), 1) - pos(c, perm(j), 1) END DO CALL helium_pbc(helium, rp) - en = en+helium_eval_expansion(helium, r, rp, eij, 0) + en = en + helium_eval_expansion(helium, r, rp, eij, 0) a = SQRT(a) IF (a < rmin) rmin = a IF (a > rmax) rmax = a IF ((a < cell_size) .OR. nperiodic) THEN - pot = pot+helium_vij(a) + pot = pot + helium_vij(a) END IF END DO END DO @@ -134,16 +134,16 @@ SUBROUTINE helium_calc_energy(helium, pint_env) kin = 0.0_dp DO i = 1, n - r(:) = pos(:, i, b)-pos(:, perm(i), 1) + r(:) = pos(:, i, b) - pos(:, perm(i), 1) CALL helium_pbc(helium, r) - kin = kin+r(1)*r(1)+r(2)*r(2)+r(3)*r(3) + kin = kin + r(1)*r(1) + r(2)*r(2) + r(3)*r(3) DO bead = 2, b - r(:) = pos(:, i, bead-1)-pos(:, i, bead) + r(:) = pos(:, i, bead - 1) - pos(:, i, bead) CALL helium_pbc(helium, r) - kin = kin+r(1)*r(1)+r(2)*r(2)+r(3)*r(3) + kin = kin + r(1)*r(1) + r(2)*r(2) + r(3)*r(3) END DO END DO - kin = 1.5_dp*n/helium%tau-0.5*kin/(b*helium%tau**2*helium%hb2m) + kin = 1.5_dp*n/helium%tau - 0.5*kin/(b*helium%tau**2*helium%hb2m) ! TODO: move printing somwhere else ? ! print *,"POT = ",(pot/n+helium%e_corr)*kelvin,"K" @@ -157,10 +157,10 @@ SUBROUTINE helium_calc_energy(helium, pint_env) !! print *,"ACTION= ",kin ! print *,"WINDING#= ",helium_calc_winding(helium) - helium%energy_inst(e_id_potential) = pot/n+helium%e_corr - helium%energy_inst(e_id_kinetic) = (en-pot+kin)/n + helium%energy_inst(e_id_potential) = pot/n + helium%e_corr + helium%energy_inst(e_id_kinetic) = (en - pot + kin)/n helium%energy_inst(e_id_interact) = interac - helium%energy_inst(e_id_thermo) = (en+kin)/n+helium%e_corr + helium%energy_inst(e_id_thermo) = (en + kin)/n + helium%e_corr helium%energy_inst(e_id_virial) = vkin ! 0.0_dp at the moment helium%energy_inst(e_id_total) = helium%energy_inst(e_id_thermo) ! Once vkin is properly implemented, switch to: @@ -192,18 +192,18 @@ REAL(KIND=dp) FUNCTION helium_total_link_action(helium) RESULT(linkaction) ! Harmonic Link action ! (r(m-1) - r(m))**2/(4*lambda*tau) - DO ibead = 1, helium%beads-1 + DO ibead = 1, helium%beads - 1 DO iatom = 1, helium%atoms - r(:) = helium%pos(:, iatom, ibead)-helium%pos(:, iatom, ibead+1) + r(:) = helium%pos(:, iatom, ibead) - helium%pos(:, iatom, ibead + 1) CALL helium_pbc(helium, r) - linkaction = linkaction+(r(1)*r(1)+r(2)*r(2)+r(3)*r(3)) + linkaction = linkaction + (r(1)*r(1) + r(2)*r(2) + r(3)*r(3)) END DO END DO DO iatom = 1, helium%atoms ! choose last bead connection according to permutation table - r(:) = helium%pos(:, iatom, helium%beads)-helium%pos(:, perm(iatom), 1) + r(:) = helium%pos(:, iatom, helium%beads) - helium%pos(:, perm(iatom), 1) CALL helium_pbc(helium, r) - linkaction = linkaction+(r(1)*r(1)+r(2)*r(2)+r(3)*r(3)) + linkaction = linkaction + (r(1)*r(1) + r(2)*r(2) + r(3)*r(3)) END DO linkaction = linkaction/(2.0_dp*helium%tau*helium%hb2m) @@ -233,21 +233,21 @@ REAL(KIND=dp) FUNCTION helium_total_pair_action(helium) RESULT(pairaction) pairaction = 0.0_dp ! He-He pair action - DO ibead = 1, helium%beads-1 - DO iatom = 1, helium%atoms-1 - DO jatom = iatom+1, helium%atoms - r(:) = helium%pos(:, iatom, ibead)-helium%pos(:, jatom, ibead) - rp(:) = helium%pos(:, iatom, ibead+1)-helium%pos(:, jatom, ibead+1) - pairaction = pairaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + DO ibead = 1, helium%beads - 1 + DO iatom = 1, helium%atoms - 1 + DO jatom = iatom + 1, helium%atoms + r(:) = helium%pos(:, iatom, ibead) - helium%pos(:, jatom, ibead) + rp(:) = helium%pos(:, iatom, ibead + 1) - helium%pos(:, jatom, ibead + 1) + pairaction = pairaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO END DO END DO !Ensure right permutation for pair action of last and first beads. - DO iatom = 1, helium%atoms-1 - DO jatom = iatom+1, helium%atoms - r(:) = helium%pos(:, iatom, helium%beads)-helium%pos(:, jatom, helium%beads) - rp(:) = helium%pos(:, perm(iatom), 1)-helium%pos(:, perm(jatom), 1) - pairaction = pairaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + DO iatom = 1, helium%atoms - 1 + DO jatom = iatom + 1, helium%atoms + r(:) = helium%pos(:, iatom, helium%beads) - helium%pos(:, jatom, helium%beads) + rp(:) = helium%pos(:, perm(iatom), 1) - helium%pos(:, perm(jatom), 1) + pairaction = pairaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO END DO @@ -263,13 +263,13 @@ REAL(KIND=dp) FUNCTION helium_total_pair_action(helium) RESULT(pairaction) IF (jatom == helium%worm_atom_idx) CYCLE opatom = helium%iperm(jatom) ! substract pair action for closed link - r(:) = helium%pos(:, iatom, 1)-helium%pos(:, jatom, 1) - rp(:) = helium%pos(:, patom, helium%beads)-helium%pos(:, opatom, helium%beads) - pairaction = pairaction-helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = helium%pos(:, iatom, 1) - helium%pos(:, jatom, 1) + rp(:) = helium%pos(:, patom, helium%beads) - helium%pos(:, opatom, helium%beads) + pairaction = pairaction - helium_eval_expansion(helium, r, rp, helium%uij, 1) ! and add corrected extra link ! rp stays the same - r(:) = helium%worm_xtra_bead(:)-helium%pos(:, jatom, 1) - pairaction = pairaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = helium%worm_xtra_bead(:) - helium%pos(:, jatom, 1) + pairaction = pairaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO ELSE ! bead stays constant @@ -278,13 +278,13 @@ REAL(KIND=dp) FUNCTION helium_total_pair_action(helium) RESULT(pairaction) DO jatom = 1, helium%atoms IF (jatom == helium%worm_atom_idx) CYCLE ! substract pair action for closed link - r(:) = helium%pos(:, iatom, ibead)-helium%pos(:, jatom, ibead) - rp(:) = helium%pos(:, iatom, ibead-1)-helium%pos(:, jatom, ibead-1) - pairaction = pairaction-helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = helium%pos(:, iatom, ibead) - helium%pos(:, jatom, ibead) + rp(:) = helium%pos(:, iatom, ibead - 1) - helium%pos(:, jatom, ibead - 1) + pairaction = pairaction - helium_eval_expansion(helium, r, rp, helium%uij, 1) ! and add corrected extra link ! rp stays the same - r(:) = helium%worm_xtra_bead(:)-helium%pos(:, jatom, ibead) - pairaction = pairaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = helium%worm_xtra_bead(:) - helium%pos(:, jatom, ibead) + pairaction = pairaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO END IF END IF @@ -320,7 +320,7 @@ REAL(KIND=dp) FUNCTION helium_total_inter_action(pint_env, helium) RESULT(intera CALL helium_bead_solute_e_f(pint_env, helium, & iatom, ibead, helium%pos(:, iatom, ibead), e) - interaction = interaction+e + interaction = interaction + e END DO END DO IF (helium%sampling_method == helium_sampling_worm) THEN @@ -329,12 +329,12 @@ REAL(KIND=dp) FUNCTION helium_total_inter_action(pint_env, helium) RESULT(intera CALL helium_bead_solute_e_f(pint_env, helium, & helium%worm_atom_idx, helium%worm_bead_idx, & helium%pos(:, helium%worm_atom_idx, helium%worm_bead_idx), e) - interaction = interaction-0.5_dp*e + interaction = interaction - 0.5_dp*e ! add half of head bead interaction CALL helium_bead_solute_e_f(pint_env, helium, & helium%worm_atom_idx, helium%worm_bead_idx, & helium%worm_xtra_bead, e) - interaction = interaction+0.5_dp*e + interaction = interaction + 0.5_dp*e END IF END IF END IF @@ -378,9 +378,9 @@ SUBROUTINE helium_bead_solute_e_f(pint_env, helium, helium_part_index, & hbeads = helium%beads ! helium bead index that is invariant wrt the rotations - hi = MOD(helium_slice_index-1+hbeads+helium%relrot, hbeads)+1 + hi = MOD(helium_slice_index - 1 + hbeads + helium%relrot, hbeads) + 1 ! solute bead index that belongs to hi helium index - qi = ((hi-1)*pint_env%p)/hbeads+1 + qi = ((hi - 1)*pint_env%p)/hbeads + 1 ! coordinates of the helium bead IF (PRESENT(helium_r_opt)) THEN @@ -464,10 +464,10 @@ SUBROUTINE helium_solute_e_f(pint_env, helium, energy) DO ib = 1, helium%beads CALL helium_bead_solute_e_f(pint_env, helium, ia, ib, & energy=my_energy, force=helium%rtmp_p_ndim_2d) - energy = energy+my_energy + energy = energy + my_energy DO jb = 1, pint_env%p DO jc = 1, pint_env%ndim - force(jb, jc) = force(jb, jc)+helium%rtmp_p_ndim_2d(jb, jc) + force(jb, jc) = force(jb, jc) + helium%rtmp_p_ndim_2d(jb, jc) END DO END DO END DO @@ -497,7 +497,7 @@ SUBROUTINE helium_solute_e(pint_env, helium, energy) DO ia = 1, helium%atoms DO ib = 1, helium%beads CALL helium_bead_solute_e_f(pint_env, helium, ia, ib, energy=my_energy) - energy = energy+my_energy + energy = energy + my_energy END DO END DO @@ -535,28 +535,28 @@ SUBROUTINE helium_intpot_scan(pint_env, helium_env) helium_env(k)%helium%rho_inst(1, :, :, :) = 0.0_dp nbin = helium_env(k)%helium%rho_nbin delr = helium_env(k)%helium%rho_delr - ox = helium_env(k)%helium%center(1)-helium_env(k)%helium%rho_maxr/2.0_dp - oy = helium_env(k)%helium%center(2)-helium_env(k)%helium%rho_maxr/2.0_dp - oz = helium_env(k)%helium%center(3)-helium_env(k)%helium%rho_maxr/2.0_dp + ox = helium_env(k)%helium%center(1) - helium_env(k)%helium%rho_maxr/2.0_dp + oy = helium_env(k)%helium%center(2) - helium_env(k)%helium%rho_maxr/2.0_dp + oz = helium_env(k)%helium%center(3) - helium_env(k)%helium%rho_maxr/2.0_dp DO ix = 1, nbin DO iy = 1, nbin DO iz = 1, nbin ! put the probe in the center of the current voxel - pos(:) = (/ox+(ix-0.5_dp)*delr, oy+(iy-0.5_dp)*delr, oz+(iz-0.5_dp)*delr/) + pos(:) = (/ox + (ix - 0.5_dp)*delr, oy + (iy - 0.5_dp)*delr, oz + (iz - 0.5_dp)*delr/) ! calc interaction energy for the current probe position helium_env(k)%helium%pos(:, 1, 1) = pos(:) CALL helium_bead_solute_e_f(pint_env, helium_env(k)%helium, 1, 1, energy=my_en) ! check if the probe fits within the unit cell - pbc1(:) = pos(:)-helium_env(k)%helium%center + pbc1(:) = pos(:) - helium_env(k)%helium%center pbc2(:) = pbc1(:) CALL helium_pbc(helium_env(k)%helium, pbc2) wrapped = .FALSE. DO ic = 1, 3 - IF (ABS(pbc1(ic)-pbc2(ic)) .GT. 10.0_dp*EPSILON(0.0_dp)) THEN + IF (ABS(pbc1(ic) - pbc2(ic)) .GT. 10.0_dp*EPSILON(0.0_dp)) THEN wrapped = .TRUE. END IF END DO @@ -615,52 +615,52 @@ SUBROUTINE helium_intpot_model_water(solute_x, helium, helium_x, energy, force) s1 = 0.0_dp DO i = 1, SIZE(helium%solute_element) IF (helium%solute_element(i) == "H ") THEN - ig = i-1 - solute_r(1) = solute_x(3*ig+1) - solute_r(2) = solute_x(3*ig+2) - solute_r(3) = solute_x(3*ig+3) - dr(:) = solute_r(:)-helium_x(:) + ig = i - 1 + solute_r(1) = solute_x(3*ig + 1) + solute_r(2) = solute_x(3*ig + 2) + solute_r(3) = solute_x(3*ig + 3) + dr(:) = solute_r(:) - helium_x(:) CALL helium_pbc(helium, dr) - d2 = dr(1)*dr(1)+dr(2)*dr(2)+dr(3)*dr(3) + d2 = dr(1)*dr(1) + dr(2)*dr(2) + dr(3)*dr(3) d = SQRT(d2) dd = (sig/d)**6 - ep = 4.0_dp*eps*dd*(dd-1.0_dp) - s1 = s1+ep - s2 = 24.0_dp*eps*dd*(2.0_dp*dd-1.0_dp)/d2 + ep = 4.0_dp*eps*dd*(dd - 1.0_dp) + s1 = s1 + ep + s2 = 24.0_dp*eps*dd*(2.0_dp*dd - 1.0_dp)/d2 IF (PRESENT(force)) THEN - force(3*ig+1) = force(3*ig+1)+s2*dr(1) - force(3*ig+2) = force(3*ig+2)+s2*dr(2) - force(3*ig+3) = force(3*ig+3)+s2*dr(3) + force(3*ig + 1) = force(3*ig + 1) + s2*dr(1) + force(3*ig + 2) = force(3*ig + 2) + s2*dr(2) + force(3*ig + 3) = force(3*ig + 3) + s2*dr(3) END IF END IF END DO ! i = 1, num_hydrogen - energy = energy+s1 + energy = energy + s1 sig = 5.01_dp ! 2.6 Angstrom eps = 104.5e-6_dp ! 33 K s1 = 0.0_dp DO i = 1, SIZE(helium%solute_element) IF (helium%solute_element(i) == "O ") THEN - ig = i-1 - solute_r(1) = solute_x(3*ig+1) - solute_r(2) = solute_x(3*ig+2) - solute_r(3) = solute_x(3*ig+3) - dr(:) = solute_r(:)-helium_x(:) + ig = i - 1 + solute_r(1) = solute_x(3*ig + 1) + solute_r(2) = solute_x(3*ig + 2) + solute_r(3) = solute_x(3*ig + 3) + dr(:) = solute_r(:) - helium_x(:) CALL helium_pbc(helium, dr) - d2 = dr(1)*dr(1)+dr(2)*dr(2)+dr(3)*dr(3) + d2 = dr(1)*dr(1) + dr(2)*dr(2) + dr(3)*dr(3) d = SQRT(d2) dd = (sig/d)**6 - ep = 4.0_dp*eps*dd*(dd-1.0_dp) - s1 = s1+ep - s2 = 24.0_dp*eps*dd*(2.0_dp*dd-1.0_dp)/d2 + ep = 4.0_dp*eps*dd*(dd - 1.0_dp) + s1 = s1 + ep + s2 = 24.0_dp*eps*dd*(2.0_dp*dd - 1.0_dp)/d2 IF (PRESENT(force)) THEN - force(3*ig+1) = force(3*ig+1)+s2*dr(1) - force(3*ig+2) = force(3*ig+2)+s2*dr(2) - force(3*ig+3) = force(3*ig+3)+s2*dr(3) + force(3*ig + 1) = force(3*ig + 1) + s2*dr(1) + force(3*ig + 2) = force(3*ig + 2) + s2*dr(2) + force(3*ig + 3) = force(3*ig + 3) + s2*dr(3) END IF END IF END DO ! i = 1, num_chlorine - energy = energy+s1 + energy = energy + s1 RETURN @@ -680,14 +680,14 @@ FUNCTION helium_vij(r) RESULT(vij) x = angstrom*r/2.9673_dp IF (x < 1.241314_dp) THEN - x2 = 1.241314_dp/x-1.0_dp + x2 = 1.241314_dp/x - 1.0_dp f = EXP(-x2*x2) ELSE f = 1.0_dp END IF x2 = 1.0_dp/(x*x) - vij = 10.8_dp/kelvin*(544850.4_dp*EXP(-13.353384_dp*x)-f* & - ((0.1781_dp*x2+0.4253785_dp)*x2+1.3732412_dp)*x2*x2*x2) + vij = 10.8_dp/kelvin*(544850.4_dp*EXP(-13.353384_dp*x) - f* & + ((0.1781_dp*x2 + 0.4253785_dp)*x2 + 1.3732412_dp)*x2*x2*x2) RETURN END FUNCTION helium_vij @@ -711,18 +711,18 @@ FUNCTION helium_d_vij(r) RESULT(dvij) x = r/2.9673_dp x2 = 1.0_dp/(x*x) IF (x < 1.241314_dp) THEN - y = 1.241314_dp/x-1.0_dp + y = 1.241314_dp/x - 1.0_dp f = EXP(-y*y) fp = 2.0_dp*1.241314_dp*f*y* & - ((0.1781_dp*x2+0.4253785_dp)*x2+1.3732412_dp)*x2*x2*x2*x2 + ((0.1781_dp*x2 + 0.4253785_dp)*x2 + 1.3732412_dp)*x2*x2*x2*x2 ELSE f = 1.0_dp fp = 0.0_dp END IF dvij = angstrom*(10.8_dp/2.9673_dp)*( & - (-13.353384_dp*544850.4_dp)*EXP(-13.353384_dp*x)-fp+ & - f*(((10.0_dp*0.1781_dp)*x2+(8.0_dp*0.4253785_dp))*x2+(6.0_dp*1.3732412_dp))* & + (-13.353384_dp*544850.4_dp)*EXP(-13.353384_dp*x) - fp + & + f*(((10.0_dp*0.1781_dp)*x2 + (8.0_dp*0.4253785_dp))*x2 + (6.0_dp*1.3732412_dp))* & x2*x2*x2/x)/(r*kelvin) RETURN END FUNCTION helium_d_vij @@ -747,56 +747,56 @@ FUNCTION helium_atom_action(helium, n, i) RESULT(res) t = 0.0_dp IF (n < helium%beads) THEN DO c = 1, 3 - r(c) = helium%pos(c, i, n)-helium%pos(c, i, n+1) + r(c) = helium%pos(c, i, n) - helium%pos(c, i, n + 1) END DO CALL helium_pbc(helium, r) - t = r(1)*r(1)+r(2)*r(2)+r(3)*r(3) - DO j = 1, i-1 + t = r(1)*r(1) + r(2)*r(2) + r(3)*r(3) + DO j = 1, i - 1 DO c = 1, 3 - r(c) = helium%pos(c, i, n)-helium%pos(c, j, n) - rp(c) = helium%pos(c, i, n+1)-helium%pos(c, j, n+1) + r(c) = helium%pos(c, i, n) - helium%pos(c, j, n) + rp(c) = helium%pos(c, i, n + 1) - helium%pos(c, j, n + 1) END DO CALL helium_pbc(helium, r) CALL helium_pbc(helium, rp) - s = s+helium_eval_expansion(helium, r, rp, helium%uij, 1) + s = s + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO - DO j = i+1, helium%atoms + DO j = i + 1, helium%atoms DO c = 1, 3 - r(c) = helium%pos(c, i, n)-helium%pos(c, j, n) - rp(c) = helium%pos(c, i, n+1)-helium%pos(c, j, n+1) + r(c) = helium%pos(c, i, n) - helium%pos(c, j, n) + rp(c) = helium%pos(c, i, n + 1) - helium%pos(c, j, n + 1) END DO CALL helium_pbc(helium, r) CALL helium_pbc(helium, rp) - s = s+helium_eval_expansion(helium, r, rp, helium%uij, 1) + s = s + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO ELSE DO c = 1, 3 - r(c) = helium%pos(c, i, n)-helium%pos(c, helium%permutation(i), 1) + r(c) = helium%pos(c, i, n) - helium%pos(c, helium%permutation(i), 1) END DO CALL helium_pbc(helium, r) - t = r(1)*r(1)+r(2)*r(2)+r(3)*r(3) - DO j = 1, i-1 + t = r(1)*r(1) + r(2)*r(2) + r(3)*r(3) + DO j = 1, i - 1 DO c = 1, 3 - r(c) = helium%pos(c, i, n)-helium%pos(c, j, n) - rp(c) = helium%pos(c, helium%permutation(i), 1)-helium%pos(c, helium%permutation(j), 1) + r(c) = helium%pos(c, i, n) - helium%pos(c, j, n) + rp(c) = helium%pos(c, helium%permutation(i), 1) - helium%pos(c, helium%permutation(j), 1) END DO CALL helium_pbc(helium, r) CALL helium_pbc(helium, rp) - s = s+helium_eval_expansion(helium, r, rp, helium%uij, 1) + s = s + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO - DO j = i+1, helium%atoms + DO j = i + 1, helium%atoms DO c = 1, 3 - r(c) = helium%pos(c, i, n)-helium%pos(c, j, n) - rp(c) = helium%pos(c, helium%permutation(i), 1)-helium%pos(c, helium%permutation(j), 1) + r(c) = helium%pos(c, i, n) - helium%pos(c, j, n) + rp(c) = helium%pos(c, helium%permutation(i), 1) - helium%pos(c, helium%permutation(j), 1) END DO CALL helium_pbc(helium, r) CALL helium_pbc(helium, rp) - s = s+helium_eval_expansion(helium, r, rp, helium%uij, 1) + s = s + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO END IF t = t/(2.0_dp*helium%tau*helium%hb2m) s = s*0.5_dp - res = s+t + res = s + t RETURN END FUNCTION helium_atom_action @@ -821,40 +821,40 @@ FUNCTION helium_link_action(helium, n) RESULT(res) IF (n < helium%beads) THEN DO i = 1, helium%atoms DO c = 1, 3 - r(c) = helium%pos(c, i, n)-helium%pos(c, i, n+1) + r(c) = helium%pos(c, i, n) - helium%pos(c, i, n + 1) END DO CALL helium_pbc(helium, r) - t = t+r(1)*r(1)+r(2)*r(2)+r(3)*r(3) - DO j = 1, i-1 + t = t + r(1)*r(1) + r(2)*r(2) + r(3)*r(3) + DO j = 1, i - 1 DO c = 1, 3 - r(c) = helium%pos(c, i, n)-helium%pos(c, j, n) - rp(c) = helium%pos(c, i, n+1)-helium%pos(c, j, n+1) + r(c) = helium%pos(c, i, n) - helium%pos(c, j, n) + rp(c) = helium%pos(c, i, n + 1) - helium%pos(c, j, n + 1) END DO CALL helium_pbc(helium, r) CALL helium_pbc(helium, rp) - s = s+helium_eval_expansion(helium, r, rp, helium%uij, 1) + s = s + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO END DO ELSE DO i = 1, helium%atoms DO c = 1, 3 - r(c) = helium%pos(c, i, n)-helium%pos(c, helium%permutation(i), 1) + r(c) = helium%pos(c, i, n) - helium%pos(c, helium%permutation(i), 1) END DO CALL helium_pbc(helium, r) - t = t+r(1)*r(1)+r(2)*r(2)+r(3)*r(3) - DO j = 1, i-1 + t = t + r(1)*r(1) + r(2)*r(2) + r(3)*r(3) + DO j = 1, i - 1 DO c = 1, 3 - r(c) = helium%pos(c, i, n)-helium%pos(c, j, n) - rp(c) = helium%pos(c, helium%permutation(i), 1)-helium%pos(c, helium%permutation(j), 1) + r(c) = helium%pos(c, i, n) - helium%pos(c, j, n) + rp(c) = helium%pos(c, helium%permutation(i), 1) - helium%pos(c, helium%permutation(j), 1) END DO CALL helium_pbc(helium, r) CALL helium_pbc(helium, rp) - s = s+helium_eval_expansion(helium, r, rp, helium%uij, 1) + s = s + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO END DO END IF t = t/(2.0_dp*helium%tau*helium%hb2m) - res = s+t + res = s + t RETURN END FUNCTION helium_link_action @@ -874,7 +874,7 @@ FUNCTION helium_total_action(helium) RESULT(res) s = 0.0_dp DO i = 1, helium%beads - s = s+helium_link_action(helium, i) + s = s + helium_link_action(helium, i) END DO res = s RETURN @@ -907,18 +907,18 @@ SUBROUTINE helium_delta_pos(helium, part, ref_bead, delta_bead, d) db = delta_bead DO IF (db < 1) EXIT - nbead = bead+1 + nbead = bead + 1 np = p IF (nbead > b) THEN - nbead = nbead-b + nbead = nbead - b np = helium%permutation(np) END IF - r(:) = helium%pos(:, p, bead)-helium%pos(:, np, nbead) + r(:) = helium%pos(:, p, bead) - helium%pos(:, np, nbead) CALL helium_pbc(helium, r) - d(:) = d(:)+r(:) + d(:) = d(:) + r(:) bead = nbead p = np - db = db-1 + db = db - 1 END DO ELSEIF (delta_bead < 0) THEN bead = ref_bead @@ -926,18 +926,18 @@ SUBROUTINE helium_delta_pos(helium, part, ref_bead, delta_bead, d) db = delta_bead DO IF (db >= 0) EXIT - nbead = bead-1 + nbead = bead - 1 np = p IF (nbead < 1) THEN - nbead = nbead+b + nbead = nbead + b np = helium%iperm(np) END IF - r(:) = helium%pos(:, p, bead)-helium%pos(:, np, nbead) + r(:) = helium%pos(:, p, bead) - helium%pos(:, np, nbead) CALL helium_pbc(helium, r) - d(:) = d(:)+r(:) + d(:) = d(:) + r(:) bead = nbead p = np - db = db+1 + db = db + 1 END DO END IF RETURN diff --git a/src/motion/helium_io.F b/src/motion/helium_io.F index ca02cd7a59..ac73c733e6 100644 --- a/src/motion/helium_io.F +++ b/src/motion/helium_io.F @@ -143,7 +143,7 @@ SUBROUTINE helium_read_xyz(coords, file_name, para_env) Frames: DO ! Atom number CALL parser_get_object(parser, natom) - frame = frame+1 + frame = frame + 1 IF (frame == 1) THEN ALLOCATE (coords(3*natom)) ELSE @@ -158,12 +158,12 @@ SUBROUTINE helium_read_xyz(coords, file_name, para_env) DO j = 1, natom ! Atom coordinates READ (parser%input_line, *) strtmp, & - coords(3*(j-1)+1), & - coords(3*(j-1)+2), & - coords(3*(j-1)+3) - coords(3*(j-1)+1) = cp_unit_to_cp2k(coords(3*(j-1)+1), "angstrom") - coords(3*(j-1)+2) = cp_unit_to_cp2k(coords(3*(j-1)+2), "angstrom") - coords(3*(j-1)+3) = cp_unit_to_cp2k(coords(3*(j-1)+3), "angstrom") + coords(3*(j - 1) + 1), & + coords(3*(j - 1) + 2), & + coords(3*(j - 1) + 3) + coords(3*(j - 1) + 1) = cp_unit_to_cp2k(coords(3*(j - 1) + 1), "angstrom") + coords(3*(j - 1) + 2) = cp_unit_to_cp2k(coords(3*(j - 1) + 2), "angstrom") + coords(3*(j - 1) + 3) = cp_unit_to_cp2k(coords(3*(j - 1) + 3), "angstrom") ! If there's a white line or end of file exit.. otherwise go on CALL parser_get_next_line(parser, 1, at_end=my_end) my_end = my_end .OR. (LEN_TRIM(parser%input_line) == 0) @@ -253,7 +253,7 @@ SUBROUTINE helium_write_setup(helium) ! first step gets incremented during first iteration WRITE (unit_nr, '(T2,A,1X,I0)') TRIM(my_label)// & - " First MC step :", helium%first_step+1 + " First MC step :", helium%first_step + 1 WRITE (unit_nr, '(T2,A,1X,I0)') TRIM(my_label)// & " Last MC step :", helium%last_step WRITE (unit_nr, '(T2,A,1X,I0)') TRIM(my_label)// & @@ -504,16 +504,16 @@ SUBROUTINE helium_print_energy(helium_env) IF (cepsample) THEN ntot = 0.0_dp DO k = 1, SIZE(helium_env) - ntot = ntot+helium_env(1)%helium%iter_norot*helium_env(1)%helium%iter_rot + ntot = ntot + helium_env(1)%helium%iter_norot*helium_env(1)%helium%iter_rot DO m = 1, helium_env(k)%helium%maxcycle - naccptd = naccptd+helium_env(k)%helium%num_accepted(helium_env(k)%helium%bisctlog2+2, m) + naccptd = naccptd + helium_env(k)%helium%num_accepted(helium_env(k)%helium%bisctlog2 + 2, m) END DO END DO ELSE !(wormsample) ntot = 0.0_dp DO k = 1, SIZE(helium_env) - naccptd = naccptd+helium_env(k)%helium%num_accepted(1, 1) - ntot = ntot+helium_env(k)%helium%num_accepted(2, 1) + naccptd = naccptd + helium_env(k)%helium%num_accepted(1, 1) + ntot = ntot + helium_env(k)%helium%num_accepted(2, 1) END DO END IF CALL mp_sum(naccptd, helium_env(1)%comm) @@ -633,8 +633,8 @@ SUBROUTINE helium_print_vector(helium_env, pkey, DATA, uconv, col_label, cmmnt, ! average data over all processors and environments avg_data(:) = 0.0_dp msglen = SIZE(avg_data) - DO i = 0, SIZE(helium_env)-1 - avg_data(:) = avg_data(:)+DATA(msglen*i+1:msglen*(i+1)) + DO i = 0, SIZE(helium_env) - 1 + avg_data(:) = avg_data(:) + DATA(msglen*i + 1:msglen*(i + 1)) END DO CALL mp_sum(avg_data, helium_env(1)%comm) nenv = helium_env(1)%helium%num_env @@ -643,13 +643,13 @@ SUBROUTINE helium_print_vector(helium_env, pkey, DATA, uconv, col_label, cmmnt, ! gather data from all processors offset = 0 DO i = 1, logger%para_env%mepos - offset = offset+helium_env(1)%env_all(i) + offset = offset + helium_env(1)%env_all(i) END DO helium_env(1)%helium%rtmp_3_np_1d = 0.0_dp msglen = SIZE(avg_data) - DO i = 0, SIZE(helium_env)-1 - helium_env(1)%helium%rtmp_3_np_1d(msglen*(offset+i)+1:msglen*(offset+i+1)) = DATA(msglen*i+1:msglen*(i+1)) + DO i = 0, SIZE(helium_env) - 1 + helium_env(1)%helium%rtmp_3_np_1d(msglen*(offset + i) + 1:msglen*(offset + i + 1)) = DATA(msglen*i + 1:msglen*(i + 1)) END DO CALL mp_sum(helium_env(1)%helium%rtmp_3_np_1d, & helium_env(1)%comm) @@ -691,8 +691,8 @@ SUBROUTINE helium_print_vector(helium_env, pkey, DATA, uconv, col_label, cmmnt, DO irank = 1, helium_env(1)%helium%num_env ! unpack data (actually point to the right fragment only) msglen = SIZE(avg_data) - offset = (irank-1)*msglen - data_p => helium_env(1)%helium%rtmp_3_np_1d(offset+1:offset+msglen) + offset = (irank - 1)*msglen + data_p => helium_env(1)%helium%rtmp_3_np_1d(offset + 1:offset + msglen) ! write out the data DO i = 1, 3 WRITE (unit_nr, '(E27.20)', ADVANCE='NO') uconv*data_p(i) @@ -767,7 +767,7 @@ SUBROUTINE helium_print_accepts(helium_env) DO i = 1, helium_env(1)%helium%maxcycle WRITE (unit_nr, '(I3)', ADVANCE='NO') i - DO j = 1, helium_env(1)%helium%bisctlog2+2 + DO j = 1, helium_env(1)%helium%bisctlog2 + 2 WRITE (unit_nr, '(1X,F20.2)', ADVANCE='NO') helium_env(1)%helium%num_accepted(j, i) END DO WRITE (unit_nr, '(A)') "" @@ -817,7 +817,7 @@ SUBROUTINE helium_print_perm(helium_env) ! determine offset for arrays offset = 0 DO i = 1, logger%para_env%mepos - offset = offset+helium_env(1)%env_all(i) + offset = offset + helium_env(1)%env_all(i) END DO print_key => section_vals_get_subs_vals(helium_env(1)%helium%input, & @@ -838,7 +838,7 @@ SUBROUTINE helium_print_perm(helium_env) helium_env(1)%helium%rtmp_3_atoms_beads_np_1d = 0.0_dp j = SIZE(helium_env(1)%helium%rtmp_3_atoms_beads_1d) DO i = 1, SIZE(helium_env) - helium_env(1)%helium%rtmp_3_atoms_beads_np_1d(j*(offset+i-1)+1:j*(offset+i)) = & + helium_env(1)%helium%rtmp_3_atoms_beads_np_1d(j*(offset + i - 1) + 1:j*(offset + i)) = & PACK(helium_env(i)%helium%pos(:, :, 1:helium_env(1)%helium%beads), .TRUE.) END DO CALL mp_sum(helium_env(1)%helium%rtmp_3_atoms_beads_np_1d, & @@ -851,7 +851,7 @@ SUBROUTINE helium_print_perm(helium_env) helium_env(1)%helium%itmp_atoms_np_1d(:) = 0 msglen = SIZE(helium_env(1)%helium%permutation) DO i = 1, SIZE(helium_env) - helium_env(1)%helium%itmp_atoms_np_1d(msglen*(offset+i-1)+1:msglen*(offset+i)) = helium_env(i)%helium%permutation + helium_env(1)%helium%itmp_atoms_np_1d(msglen*(offset + i - 1) + 1:msglen*(offset + i)) = helium_env(i)%helium%permutation END DO CALL mp_sum(helium_env(1)%helium%itmp_atoms_np_1d, & @@ -873,7 +873,7 @@ SUBROUTINE helium_print_perm(helium_env) extension=".dat") ! unpack permutation state (actually point to the right section only) - lb = (irank-1)*helium_env(1)%helium%atoms+1 + lb = (irank - 1)*helium_env(1)%helium%atoms + 1 ub = irank*helium_env(1)%helium%atoms my_perm => helium_env(1)%helium%itmp_atoms_np_1d(lb:ub) @@ -884,9 +884,9 @@ SUBROUTINE helium_print_perm(helium_env) ! unpack coordinates (necessary only for winding path delimiters) msglen = SIZE(helium_env(1)%helium%rtmp_3_atoms_beads_1d) - offset = (irank-1)*msglen + offset = (irank - 1)*msglen helium_env(1)%helium%work(:, :, 1:helium_env(1)%helium%beads) = & - UNPACK(helium_env(1)%helium%rtmp_3_atoms_beads_np_1d(offset+1:offset+msglen), & + UNPACK(helium_env(1)%helium%rtmp_3_atoms_beads_np_1d(offset + 1:offset + msglen), & MASK=helium_env(1)%helium%ltmp_3_atoms_beads_3d, FIELD=0.0_dp) curat = 1 @@ -898,9 +898,9 @@ SUBROUTINE helium_print_perm(helium_env) my_cycle => helium_cycle_of(curat, my_perm) ! include the current cycle in the pool of "used" indices - nused = nused+SIZE(my_cycle) + nused = nused + SIZE(my_cycle) CALL reallocate(used_indices, 1, nused) - used_indices(nused-SIZE(my_cycle)+1:nused) = my_cycle(1:SIZE(my_cycle)) + used_indices(nused - SIZE(my_cycle) + 1:nused) = my_cycle(1:SIZE(my_cycle)) ! select delimiters accoring to the cycle's winding state IF (helium_is_winding(helium_env(1)%helium, curat, helium_env(1)%helium%work, my_perm)) THEN @@ -937,7 +937,7 @@ SUBROUTINE helium_print_perm(helium_env) ! try to increment the current atom index DO WHILE (ANY(used_indices .EQ. curat)) - curat = curat+1 + curat = curat + 1 END DO END DO @@ -1013,7 +1013,7 @@ SUBROUTINE helium_print_action(pint_env, helium_env) ! determine offset for arrays offset = 0 DO i = 1, logger%para_env%mepos - offset = offset+helium_env(1)%env_all(i) + offset = offset + helium_env(1)%env_all(i) END DO print_key => section_vals_get_subs_vals(helium_env(1)%helium%input, & @@ -1044,9 +1044,9 @@ SUBROUTINE helium_print_action(pint_env, helium_env) tmp_inter_action(:) = 0.0_dp ! gather Action from all processors to logger%para_env%source DO k = 1, SIZE(helium_env) - tmp_link_action(offset+k) = helium_env(k)%helium%link_action - tmp_pair_action(offset+k) = helium_env(k)%helium%pair_action - tmp_inter_action(offset+k) = helium_env(k)%helium%inter_action + tmp_link_action(offset + k) = helium_env(k)%helium%link_action + tmp_pair_action(offset + k) = helium_env(k)%helium%pair_action + tmp_inter_action(offset + k) = helium_env(k)%helium%inter_action END DO CALL mp_sum(tmp_link_action, helium_env(1)%comm) CALL mp_sum(tmp_pair_action, helium_env(1)%comm) @@ -1136,7 +1136,7 @@ SUBROUTINE helium_print_coordinates(helium_env) ! determine offset for arrays offset = 0 DO i = 1, logger%para_env%mepos - offset = offset+helium_env(1)%env_all(i) + offset = offset + helium_env(1)%env_all(i) END DO print_key => section_vals_get_subs_vals(helium_env(1)%helium%input, & @@ -1155,18 +1155,18 @@ SUBROUTINE helium_print_coordinates(helium_env) r0(:) = helium_env(k)%helium%center(:) DO ia = 1, helium_env(k)%helium%atoms DO ib = 1, helium_env(k)%helium%beads - r1(:) = helium_env(k)%helium%pos(:, ia, ib)-r0(:) - r2(:) = helium_env(k)%helium%pos(:, ia, ib)-r0(:) + r1(:) = helium_env(k)%helium%pos(:, ia, ib) - r0(:) + r2(:) = helium_env(k)%helium%pos(:, ia, ib) - r0(:) CALL helium_pbc(helium_env(k)%helium, r2) ltmp = .FALSE. DO ic = 1, 3 - IF (ABS(r1(ic)-r2(ic)) .GT. 100.0_dp*EPSILON(0.0_dp)) THEN + IF (ABS(r1(ic) - r2(ic)) .GT. 100.0_dp*EPSILON(0.0_dp)) THEN ltmp = .TRUE. CYCLE END IF END DO IF (ltmp) THEN - helium_env(k)%helium%work(:, ia, ib) = r0(:)+r2(:) + helium_env(k)%helium%work(:, ia, ib) = r0(:) + r2(:) ELSE helium_env(k)%helium%work(:, ia, ib) = helium_env(k)%helium%pos(:, ia, ib) END IF @@ -1178,7 +1178,7 @@ SUBROUTINE helium_print_coordinates(helium_env) helium_env(1)%helium%rtmp_3_atoms_beads_np_1d = 0.0_dp j = SIZE(helium_env(1)%helium%rtmp_3_atoms_beads_1d) DO i = 1, SIZE(helium_env) - helium_env(1)%helium%rtmp_3_atoms_beads_np_1d(j*(offset+i-1)+1:j*(offset+i)) = & + helium_env(1)%helium%rtmp_3_atoms_beads_np_1d(j*(offset + i - 1) + 1:j*(offset + i)) = & PACK(helium_env(i)%helium%pos(:, :, 1:helium_env(1)%helium%beads), .TRUE.) END DO CALL mp_sum(helium_env(1)%helium%rtmp_3_atoms_beads_np_1d, & @@ -1188,7 +1188,7 @@ SUBROUTINE helium_print_coordinates(helium_env) helium_env(1)%helium%itmp_atoms_np_1d(:) = 0 j = SIZE(helium_env(1)%helium%permutation) DO i = 1, SIZE(helium_env) - helium_env(1)%helium%itmp_atoms_np_1d(j*(offset+i-1)+1:j*(offset+i)) = helium_env(i)%helium%permutation + helium_env(1)%helium%itmp_atoms_np_1d(j*(offset + i - 1) + 1:j*(offset + i)) = helium_env(i)%helium%permutation END DO CALL mp_sum(helium_env(1)%helium%itmp_atoms_np_1d, & @@ -1216,7 +1216,7 @@ SUBROUTINE helium_print_coordinates(helium_env) fmt_string = "(A6,3F9.3,3F7.2,1X,A11,1X,I3)" xtmp = helium_env(1)%helium%cell_size xtmp = cp_unit_from_cp2k(xtmp, "angstrom") - SELECT CASE (helium_env (1)%helium%cell_shape) + SELECT CASE (helium_env(1)%helium%cell_shape) CASE (helium_cell_shape_cube) stmp = "C " CASE (helium_cell_shape_octahedron) @@ -1231,15 +1231,15 @@ SUBROUTINE helium_print_coordinates(helium_env) ! unpack coordinates msglen = SIZE(helium_env(1)%helium%rtmp_3_atoms_beads_1d) - offset = (irank-1)*msglen + offset = (irank - 1)*msglen helium_env(1)%helium%work(:, :, 1:helium_env(1)%helium%beads) = & - UNPACK(helium_env(1)%helium%rtmp_3_atoms_beads_np_1d(offset+1:offset+msglen), & + UNPACK(helium_env(1)%helium%rtmp_3_atoms_beads_np_1d(offset + 1:offset + msglen), & MASK=helium_env(1)%helium%ltmp_3_atoms_beads_3d, FIELD=0.0_dp) ! unpack permutation state (actually point to the right section only) msglen = SIZE(helium_env(1)%helium%permutation) - offset = (irank-1)*msglen - my_perm => helium_env(1)%helium%itmp_atoms_np_1d(offset+1:offset+msglen) + offset = (irank - 1)*msglen + my_perm => helium_env(1)%helium%itmp_atoms_np_1d(offset + 1:offset + msglen) ! write out coordinates fmt_string = & @@ -1260,7 +1260,7 @@ SUBROUTINE helium_print_coordinates(helium_env) ztmp = helium_env(1)%helium%work(3, ia, ib) ztmp = cp_unit_from_cp2k(ztmp, "angstrom") WRITE (unit_nr, fmt_string) "ATOM ", & - (ia-1)*helium_env(1)%helium%beads+ib, & + (ia - 1)*helium_env(1)%helium%beads + ib, & " He ", " ", resName, "X", & icycle, & " ", & @@ -1278,14 +1278,14 @@ SUBROUTINE helium_print_coordinates(helium_env) CYCLE END IF - DO ib = 1, helium_env(1)%helium%beads-1 + DO ib = 1, helium_env(1)%helium%beads - 1 ! check wheather the consecutive beads belong to the same box - r1(:) = helium_env(1)%helium%work(:, ia, ib)-helium_env(1)%helium%work(:, ia, ib+1) + r1(:) = helium_env(1)%helium%work(:, ia, ib) - helium_env(1)%helium%work(:, ia, ib + 1) r2(:) = r1(:) CALL helium_pbc(helium_env(1)%helium, r2) are_connected = .TRUE. DO ic = 1, 3 - IF (ABS(r1(ic)-r2(ic)) .GT. 100.0_dp*EPSILON(0.0_dp)) THEN + IF (ABS(r1(ic) - r2(ic)) .GT. 100.0_dp*EPSILON(0.0_dp)) THEN ! if the distance betw ib and ib+1 changes upon applying ! PBC do not connect them are_connected = .FALSE. @@ -1293,8 +1293,8 @@ SUBROUTINE helium_print_coordinates(helium_env) END IF END DO IF (are_connected) THEN - tmp1 = (ia-1)*helium_env(1)%helium%beads+ib - tmp2 = (ia-1)*helium_env(1)%helium%beads+ib+1 + tmp1 = (ia - 1)*helium_env(1)%helium%beads + ib + tmp2 = (ia - 1)*helium_env(1)%helium%beads + ib + 1 ! smaller value has to go first IF (tmp1 .LT. tmp2) THEN ib1 = tmp1 @@ -1309,12 +1309,12 @@ SUBROUTINE helium_print_coordinates(helium_env) ! last bead of atom connects to the first bead ! of the next atom in the permutation cycle - r1(:) = helium_env(1)%helium%work(:, ia, helium_env(1)%helium%beads)-helium_env(1)%helium%work(:, my_perm(ia), 1) + r1(:) = helium_env(1)%helium%work(:, ia, helium_env(1)%helium%beads) - helium_env(1)%helium%work(:, my_perm(ia), 1) r2(:) = r1(:) CALL helium_pbc(helium_env(1)%helium, r2) are_connected = .TRUE. DO ic = 1, 3 - IF (ABS(r1(ic)-r2(ic)) .GT. 100.0_dp*EPSILON(0.0_dp)) THEN + IF (ABS(r1(ic) - r2(ic)) .GT. 100.0_dp*EPSILON(0.0_dp)) THEN ! if the distance betw ib and ib+1 changes upon applying ! PBC do not connect them are_connected = .FALSE. @@ -1323,7 +1323,7 @@ SUBROUTINE helium_print_coordinates(helium_env) END DO IF (are_connected) THEN tmp1 = ia*helium_env(1)%helium%beads - tmp2 = (my_perm(ia)-1)*helium_env(1)%helium%beads+1 + tmp2 = (my_perm(ia) - 1)*helium_env(1)%helium%beads + 1 IF (tmp1 .LT. tmp2) THEN ib1 = tmp1 ib2 = tmp2 @@ -1391,7 +1391,7 @@ SUBROUTINE helium_print_rdf(helium_env) ! save accumulated data of different env on same core in first temp helium_env(1)%helium%rdf_inst(:, :) = 0.0_dp DO k = 1, SIZE(helium_env) - helium_env(1)%helium%rdf_inst(:, :) = helium_env(1)%helium%rdf_inst(:, :)+ & + helium_env(1)%helium%rdf_inst(:, :) = helium_env(1)%helium%rdf_inst(:, :) + & helium_env(k)%helium%rdf_accu(:, :) END DO @@ -1404,15 +1404,15 @@ SUBROUTINE helium_print_rdf(helium_env) helium_env(1)%helium%rdf_inst(:, :) = helium_env(1)%helium%rdf_inst(:, :)*inv_norm ! average over steps performed so far in this run - nsteps = helium_env(1)%helium%current_step-helium_env(1)%helium%first_step + nsteps = helium_env(1)%helium%current_step - helium_env(1)%helium%first_step inv_norm = 1.0_dp/REAL(nsteps, dp) helium_env(1)%helium%rdf_inst(:, :) = helium_env(1)%helium%rdf_inst(:, :)*inv_norm iweight = helium_env(1)%helium%rdf_iweight ! average over the old and the current density (observe the weights!) - helium_env(1)%helium%rdf_inst(:, :) = nsteps*helium_env(1)%helium%rdf_inst(:, :)+ & + helium_env(1)%helium%rdf_inst(:, :) = nsteps*helium_env(1)%helium%rdf_inst(:, :) + & iweight*helium_env(1)%helium%rdf_rstr(:, :) - helium_env(1)%helium%rdf_inst(:, :) = helium_env(1)%helium%rdf_inst(:, :)/REAL(nsteps+iweight, dp) + helium_env(1)%helium%rdf_inst(:, :) = helium_env(1)%helium%rdf_inst(:, :)/REAL(nsteps + iweight, dp) IF (logger%para_env%ionode) THEN @@ -1438,7 +1438,7 @@ SUBROUTINE helium_print_rdf(helium_env) do_backup=.FALSE.) DO ic = 1, helium_env(1)%helium%rdf_nbin - WRITE (unit_nr, '(F20.10)', ADVANCE='NO') (REAL(ic, dp)-0.5_dp)*helium_env(1)%helium%rdf_delr*rtmp + WRITE (unit_nr, '(F20.10)', ADVANCE='NO') (REAL(ic, dp) - 0.5_dp)*helium_env(1)%helium%rdf_delr*rtmp WRITE (unit_nr, '(F20.10)', ADVANCE='NO') helium_env(1)%helium%rdf_inst(ia, ic)*rtmp2 WRITE (unit_nr, *) END DO @@ -1460,8 +1460,8 @@ SUBROUTINE helium_print_rdf(helium_env) do_backup=.FALSE.) DO ic = 1, helium_env(1)%helium%rdf_nbin - WRITE (unit_nr, '(F20.10)', ADVANCE='NO') (REAL(ic, dp)-0.5_dp)*helium_env(1)%helium%rdf_delr*rtmp - DO id = 1+ia, helium_env(1)%helium%rdf_num + WRITE (unit_nr, '(F20.10)', ADVANCE='NO') (REAL(ic, dp) - 0.5_dp)*helium_env(1)%helium%rdf_delr*rtmp + DO id = 1 + ia, helium_env(1)%helium%rdf_num WRITE (unit_nr, '(F20.10)', ADVANCE='NO') helium_env(1)%helium%rdf_inst(id, ic)*rtmp2 END DO WRITE (unit_nr, *) @@ -1525,7 +1525,7 @@ SUBROUTINE helium_print_rho(helium_env) ! save accumulated data of different env on same core in first temp helium_env(1)%helium%rho_inst(:, :, :, :) = 0.0_dp DO k = 1, SIZE(helium_env) - helium_env(1)%helium%rho_inst(:, :, :, :) = helium_env(1)%helium%rho_inst(:, :, :, :)+ & + helium_env(1)%helium%rho_inst(:, :, :, :) = helium_env(1)%helium%rho_inst(:, :, :, :) + & helium_env(k)%helium%rho_accu(:, :, :, :) END DO @@ -1536,15 +1536,15 @@ SUBROUTINE helium_print_rho(helium_env) helium_env(1)%helium%rho_inst(:, :, :, :) = helium_env(1)%helium%rho_inst(:, :, :, :)*invproc ! average over steps performed so far in this run - nsteps = helium_env(1)%helium%current_step-helium_env(1)%helium%first_step + nsteps = helium_env(1)%helium%current_step - helium_env(1)%helium%first_step inv_norm = 1.0_dp/REAL(nsteps, dp) helium_env(1)%helium%rho_inst(:, :, :, :) = helium_env(1)%helium%rho_inst(:, :, :, :)*inv_norm iweight = helium_env(1)%helium%rho_iweight ! average over the old and the current density (observe the weights!) - helium_env(1)%helium%rho_inst(:, :, :, :) = nsteps*helium_env(1)%helium%rho_inst(:, :, :, :)+ & + helium_env(1)%helium%rho_inst(:, :, :, :) = nsteps*helium_env(1)%helium%rho_inst(:, :, :, :) + & iweight*helium_env(1)%helium%rho_rstr(:, :, :, :) - helium_env(1)%helium%rho_inst(:, :, :, :) = helium_env(1)%helium%rho_inst(:, :, :, :)/REAL(nsteps+iweight, dp) + helium_env(1)%helium%rho_inst(:, :, :, :) = helium_env(1)%helium%rho_inst(:, :, :, :)/REAL(nsteps + iweight, dp) ! set center of the cubefile IF (helium_env(1)%helium%solute_present) THEN @@ -1589,7 +1589,7 @@ SUBROUTINE helium_print_rho(helium_env) CALL helium_write_cubefile( & unit_nr, & comment, & - center-0.5_dp*(helium_env(1)%helium%rho_maxr-helium_env(1)%helium%rho_delr), & + center - 0.5_dp*(helium_env(1)%helium%rho_maxr - helium_env(1)%helium%rho_delr), & helium_env(1)%helium%rho_delr, & helium_env(1)%helium%rho_nbin, & cubdata) @@ -1654,7 +1654,7 @@ SUBROUTINE helium_write_cubefile(unit, comment, origin, deltar, ndim, DATA) DO iy = 1, ndim DO iz = 1, ndim WRITE (unit, '(1X,E13.5)', ADVANCE='NO') inva3*DATA(ix, iy, iz) - nw = nw+1 + nw = nw + 1 IF (MOD(nw, 6) .EQ. 0) THEN nw = 0 WRITE (unit, *) @@ -1792,7 +1792,7 @@ SUBROUTINE helium_print_force(helium_env) idim = 0 DO ia = 1, helium_env(1)%helium%solute_atoms DO ic = 1, 3 - idim = idim+1 + idim = idim + 1 WRITE (unit_nr, '(F20.10)', ADVANCE='NO') helium_env(1)%helium%force_avrg(ib, idim) END DO END DO @@ -1878,13 +1878,13 @@ SUBROUTINE helium_print_force_inst(helium) extension=".dat") ! unpack and actually print the forces - all components in one line - offset = (irank-1)*SIZE(helium%rtmp_p_ndim_1d) + offset = (irank - 1)*SIZE(helium%rtmp_p_ndim_1d) idim = 0 DO ib = 1, helium%solute_beads DO ia = 1, helium%solute_atoms DO ic = 1, 3 - idim = idim+1 - WRITE (unit_nr, '(F20.10)', ADVANCE='NO') helium%rtmp_p_ndim_np_1d(offset+idim) + idim = idim + 1 + WRITE (unit_nr, '(F20.10)', ADVANCE='NO') helium%rtmp_p_ndim_np_1d(offset + idim) END DO END DO END DO diff --git a/src/motion/helium_methods.F b/src/motion/helium_methods.F index 93b836dcab..3f7018d996 100644 --- a/src/motion/helium_methods.F +++ b/src/motion/helium_methods.F @@ -150,7 +150,7 @@ SUBROUTINE helium_create(helium_env, input, solute) END IF ! calculate number of tasks for each processor mepos = num_env/logger%para_env%num_pe & - +MIN(MOD(num_env, logger%para_env%num_pe)/(logger%para_env%mepos+1), 1) + + MIN(MOD(num_env, logger%para_env%num_pe)/(logger%para_env%mepos + 1), 1) ! gather result NULLIFY (env_all) ALLOCATE (env_all(logger%para_env%num_pe)) @@ -213,7 +213,7 @@ SUBROUTINE helium_create(helium_env, input, solute) ) helium_env(k)%helium%ref_count = 1 - last_helium_id = last_helium_id+1 + last_helium_id = last_helium_id + 1 helium_env(k)%helium%id_nr = last_helium_id helium_env(k)%helium%accepts = 0 helium_env(k)%helium%relrot = 0 @@ -254,13 +254,13 @@ SUBROUTINE helium_create(helium_env, input, solute) i_val=itmp) helium_env(k)%helium%last_step = itmp helium_env(k)%helium%num_steps = helium_env(k)%helium%last_step & - -helium_env(k)%helium%first_step + - helium_env(k)%helium%first_step ELSE CALL section_vals_val_get(input, "MOTION%PINT%NUM_STEPS", & i_val=itmp) helium_env(k)%helium%num_steps = itmp helium_env(k)%helium%last_step = helium_env(k)%helium%first_step & - +helium_env(k)%helium%num_steps + + helium_env(k)%helium%num_steps END IF ! boundary conditions @@ -297,8 +297,8 @@ SUBROUTINE helium_create(helium_env, input, solute) CALL section_vals_val_get(helium_section, "CELL_SIZE", & r_val=helium_env(k)%helium%cell_size) ! only more work if not all three values are consistent: - IF (ABS(helium_env(k)%helium%cell_size-rtmp) .GT. 100.0_dp*EPSILON(0.0_dp)* & - (ABS(helium_env(k)%helium%cell_size)+rtmp)) THEN + IF (ABS(helium_env(k)%helium%cell_size - rtmp) .GT. 100.0_dp*EPSILON(0.0_dp)* & + (ABS(helium_env(k)%helium%cell_size) + rtmp)) THEN IF (expl_dens .AND. expl_nats) THEN msg_str = "DENSITY, NATOMS and CELL_SIZE options "// & "contradict each other" @@ -320,8 +320,8 @@ SUBROUTINE helium_create(helium_env, input, solute) ! (should be a small correction) rtmp = (cgeof*helium_env(k)%helium%atoms/helium_env(k)%helium%density & )**(1.0_dp/3.0_dp) - IF (ABS(helium_env(k)%helium%cell_size-rtmp) .GT. 100.0_dp*EPSILON(0.0_dp) & - *(ABS(helium_env(k)%helium%cell_size)+rtmp)) THEN + IF (ABS(helium_env(k)%helium%cell_size - rtmp) .GT. 100.0_dp*EPSILON(0.0_dp) & + *(ABS(helium_env(k)%helium%cell_size) + rtmp)) THEN msg_str = "Adjusting actual cell size "// & "to maintain correct density." CPWARN(msg_str) @@ -335,7 +335,7 @@ SUBROUTINE helium_create(helium_env, input, solute) ! correctly defined. ! set the M matrix for winding number calculations - SELECT CASE (helium_env (k)%helium%cell_shape) + SELECT CASE (helium_env(k)%helium%cell_shape) CASE (helium_cell_shape_octahedron) helium_env(k)%helium%cell_m(1, 1) = helium_env(k)%helium%cell_size @@ -392,14 +392,14 @@ SUBROUTINE helium_create(helium_env, input, solute) CALL section_vals_val_get(helium_section, "SAMPLING_METHOD", & i_val=helium_env(k)%helium%sampling_method) - SELECT CASE (helium_env (k)%helium%sampling_method) + SELECT CASE (helium_env(k)%helium%sampling_method) CASE (helium_sampling_ceperley) ! check value of maxcycle CALL section_vals_val_get(helium_section, "CEPERLEY%MAX_PERM_CYCLE", & i_val=helium_env(k)%helium%maxcycle) i = helium_env(k)%helium%maxcycle CPASSERT(i >= 0) - i = helium_env(k)%helium%atoms-helium_env(k)%helium%maxcycle + i = helium_env(k)%helium%atoms - helium_env(k)%helium%maxcycle CPASSERT(i >= 0) ! set m-distribution parameters @@ -424,12 +424,12 @@ SUBROUTINE helium_create(helium_env, input, solute) ! precheck bisection value (not all invalids are filtered out here yet) i = helium_env(k)%helium%bisection CPASSERT(i > 1) - i = helium_env(k)%helium%beads-helium_env(k)%helium%bisection + i = helium_env(k)%helium%beads - helium_env(k)%helium%bisection CPASSERT(i > 0) ! itmp = helium_env(k)%helium%bisection rtmp = 2.0_dp**(ANINT(LOG(REAL(itmp, dp))/LOG(2.0_dp))) - tcheck = ABS(REAL(itmp, KIND=dp)-rtmp) + tcheck = ABS(REAL(itmp, KIND=dp) - rtmp) IF (tcheck > 100.0_dp*EPSILON(0.0_dp)) THEN msg_str = "BISECTION should be integer power of 2." CPABORT(msg_str) @@ -452,7 +452,7 @@ SUBROUTINE helium_create(helium_env, input, solute) CALL section_vals_val_get(helium_section, "WORM%ALLOW_OPEN", & l_val=helium_env(k)%helium%worm_allow_open) - IF (helium_env(k)%helium%worm_staging_l+1 >= helium_env(k)%helium%beads) THEN + IF (helium_env(k)%helium%worm_staging_l + 1 >= helium_env(k)%helium%beads) THEN msg_str = "STAGING_L for worm sampling is to large" CPABORT(msg_str) ELSE IF (helium_env(k)%helium%worm_staging_l < 1) THEN @@ -487,39 +487,39 @@ SUBROUTINE helium_create(helium_env, input, solute) i_val=itmp) helium_env(k)%helium%worm_centroid_min = 1 helium_env(k)%helium%worm_centroid_max = itmp - helium_env(k)%helium%worm_all_limit = helium_env(k)%helium%worm_all_limit+itmp + helium_env(k)%helium%worm_all_limit = helium_env(k)%helium%worm_all_limit + itmp CALL section_vals_val_get(helium_section, "WORM%STAGING_WEIGHT", & i_val=itmp) - helium_env(k)%helium%worm_staging_min = helium_env(k)%helium%worm_centroid_max+1 - helium_env(k)%helium%worm_staging_max = helium_env(k)%helium%worm_centroid_max+itmp - helium_env(k)%helium%worm_all_limit = helium_env(k)%helium%worm_all_limit+itmp + helium_env(k)%helium%worm_staging_min = helium_env(k)%helium%worm_centroid_max + 1 + helium_env(k)%helium%worm_staging_max = helium_env(k)%helium%worm_centroid_max + itmp + helium_env(k)%helium%worm_all_limit = helium_env(k)%helium%worm_all_limit + itmp IF (helium_env(k)%helium%worm_allow_open) THEN CALL section_vals_val_get(helium_section, "WORM%CRAWL_WEIGHT", & i_val=itmp) - helium_env(k)%helium%worm_fcrawl_min = helium_env(k)%helium%worm_staging_max+1 - helium_env(k)%helium%worm_fcrawl_max = helium_env(k)%helium%worm_staging_max+itmp - helium_env(k)%helium%worm_all_limit = helium_env(k)%helium%worm_all_limit+itmp - helium_env(k)%helium%worm_bcrawl_min = helium_env(k)%helium%worm_fcrawl_max+1 - helium_env(k)%helium%worm_bcrawl_max = helium_env(k)%helium%worm_fcrawl_max+itmp - helium_env(k)%helium%worm_all_limit = helium_env(k)%helium%worm_all_limit+itmp + helium_env(k)%helium%worm_fcrawl_min = helium_env(k)%helium%worm_staging_max + 1 + helium_env(k)%helium%worm_fcrawl_max = helium_env(k)%helium%worm_staging_max + itmp + helium_env(k)%helium%worm_all_limit = helium_env(k)%helium%worm_all_limit + itmp + helium_env(k)%helium%worm_bcrawl_min = helium_env(k)%helium%worm_fcrawl_max + 1 + helium_env(k)%helium%worm_bcrawl_max = helium_env(k)%helium%worm_fcrawl_max + itmp + helium_env(k)%helium%worm_all_limit = helium_env(k)%helium%worm_all_limit + itmp CALL section_vals_val_get(helium_section, "WORM%HEAD_TAIL_WEIGHT", & i_val=itmp) - helium_env(k)%helium%worm_head_min = helium_env(k)%helium%worm_bcrawl_max+1 - helium_env(k)%helium%worm_head_max = helium_env(k)%helium%worm_bcrawl_max+itmp - helium_env(k)%helium%worm_all_limit = helium_env(k)%helium%worm_all_limit+itmp - helium_env(k)%helium%worm_tail_min = helium_env(k)%helium%worm_head_max+1 - helium_env(k)%helium%worm_tail_max = helium_env(k)%helium%worm_head_max+itmp - helium_env(k)%helium%worm_all_limit = helium_env(k)%helium%worm_all_limit+itmp + helium_env(k)%helium%worm_head_min = helium_env(k)%helium%worm_bcrawl_max + 1 + helium_env(k)%helium%worm_head_max = helium_env(k)%helium%worm_bcrawl_max + itmp + helium_env(k)%helium%worm_all_limit = helium_env(k)%helium%worm_all_limit + itmp + helium_env(k)%helium%worm_tail_min = helium_env(k)%helium%worm_head_max + 1 + helium_env(k)%helium%worm_tail_max = helium_env(k)%helium%worm_head_max + itmp + helium_env(k)%helium%worm_all_limit = helium_env(k)%helium%worm_all_limit + itmp CALL section_vals_val_get(helium_section, "WORM%SWAP_WEIGHT", & i_val=itmp) - helium_env(k)%helium%worm_swap_min = helium_env(k)%helium%worm_tail_max+1 - helium_env(k)%helium%worm_swap_max = helium_env(k)%helium%worm_tail_max+itmp - helium_env(k)%helium%worm_all_limit = helium_env(k)%helium%worm_all_limit+itmp + helium_env(k)%helium%worm_swap_min = helium_env(k)%helium%worm_tail_max + 1 + helium_env(k)%helium%worm_swap_max = helium_env(k)%helium%worm_tail_max + itmp + helium_env(k)%helium%worm_all_limit = helium_env(k)%helium%worm_all_limit + itmp CALL section_vals_val_get(helium_section, "WORM%OPEN_CLOSE_WEIGHT", & i_val=itmp) - helium_env(k)%helium%worm_open_close_min = helium_env(k)%helium%worm_swap_max+1 - helium_env(k)%helium%worm_open_close_max = helium_env(k)%helium%worm_swap_max+itmp - helium_env(k)%helium%worm_all_limit = helium_env(k)%helium%worm_all_limit+itmp + helium_env(k)%helium%worm_open_close_min = helium_env(k)%helium%worm_swap_max + 1 + helium_env(k)%helium%worm_open_close_max = helium_env(k)%helium%worm_swap_max + itmp + helium_env(k)%helium%worm_all_limit = helium_env(k)%helium%worm_all_limit + itmp CALL section_vals_val_get(helium_section, "WORM%CRAWL_REPETITION", & i_val=helium_env(k)%helium%worm_repeat_crawl) END IF @@ -555,7 +555,7 @@ SUBROUTINE helium_create(helium_env, input, solute) helium_env(1)%comm) CALL mp_bcast(dx, logger%para_env%source, & helium_env(1)%comm) - isize = (pdx+1)*(pdx+2) + isize = (pdx + 1)*(pdx + 2) ALLOCATE (pot_transfer(nlines, isize)) IF (logger%para_env%ionode) THEN DO i = 1, nlines @@ -581,7 +581,7 @@ SUBROUTINE helium_create(helium_env, input, solute) helium_env(k)%helium%wpref = (((1e-20/h_bar)*mHe)/h_bar)*boltzmann*T helium_env(k)%helium%apref = (((4e-20/h_bar)*mHe)/h_bar)*boltzmann*T - isize = helium_env(k)%helium%pdx+1 + isize = helium_env(k)%helium%pdx + 1 ALLOCATE (helium_env(k)%helium%uij(isize, isize)) ALLOCATE (helium_env(k)%helium%eij(isize, isize)) DO i = 1, isize @@ -594,8 +594,8 @@ SUBROUTINE helium_create(helium_env, input, solute) helium_env(k)%helium%eij(i, j)%spline_data%x1 = x_spline END DO END DO - DO i = 1, isize-1 - DO j = i+1, isize + DO i = 1, isize - 1 + DO j = i + 1, isize helium_env(k)%helium%uij(i, j) = helium_env(k)%helium%uij(j, i) CALL spline_data_retain(helium_env(k)%helium%uij(i, j)%spline_data) helium_env(k)%helium%eij(i, j) = helium_env(k)%helium%eij(j, i) @@ -603,22 +603,22 @@ SUBROUTINE helium_create(helium_env, input, solute) END DO END DO - isize = helium_env(k)%helium%pdx+1 + isize = helium_env(k)%helium%pdx + 1 ntab = 1 DO i = 1, isize DO j = 1, i helium_env(k)%helium%uij(i, j)%spline_data%y(:) = pot_transfer(:, ntab)* & - angstrom**(2*i-2) + angstrom**(2*i - 2) CALL init_spline(helium_env(k)%helium%uij(i, j)%spline_data, dx=dx) - ntab = ntab+1 + ntab = ntab + 1 END DO END DO DO i = 1, isize DO j = 1, i helium_env(k)%helium%eij(i, j)%spline_data%y(:) = pot_transfer(:, ntab)* & - angstrom**(2*i-2)/kelvin + angstrom**(2*i - 2)/kelvin CALL init_spline(helium_env(k)%helium%eij(i, j)%spline_data, dx=dx) - ntab = ntab+1 + ntab = ntab + 1 END DO END DO @@ -628,14 +628,14 @@ SUBROUTINE helium_create(helium_env, input, solute) ALLOCATE (helium_env(k)%helium%pos(3, i, j)) helium_env(k)%helium%pos = 0.0_dp ALLOCATE (helium_env(k)%helium%work(3, i, j)) - ALLOCATE (helium_env(k)%helium%ptable(helium_env(k)%helium%maxcycle+1)) + ALLOCATE (helium_env(k)%helium%ptable(helium_env(k)%helium%maxcycle + 1)) ALLOCATE (helium_env(k)%helium%permutation(i)) ALLOCATE (helium_env(k)%helium%iperm(i)) ALLOCATE (helium_env(k)%helium%tmatrix(i, i)) ALLOCATE (helium_env(k)%helium%nmatrix(i, 2*i)) ALLOCATE (helium_env(k)%helium%pmatrix(i, i)) ALLOCATE (helium_env(k)%helium%ipmatrix(i, i)) - itmp = helium_env(k)%helium%bisctlog2+2 + itmp = helium_env(k)%helium%bisctlog2 + 2 ALLOCATE (helium_env(k)%helium%num_accepted(itmp, helium_env(k)%helium%maxcycle)) ALLOCATE (helium_env(k)%helium%plength_avrg(helium_env(k)%helium%atoms)) ALLOCATE (helium_env(k)%helium%plength_inst(helium_env(k)%helium%atoms)) @@ -670,7 +670,7 @@ SUBROUTINE helium_create(helium_env, input, solute) helium_env(k)%helium%bead_ratio = helium_env(k)%helium%solute_beads/ & helium_env(k)%helium%beads ! check if bead numbers are commensurate: - i = helium_env(k)%helium%bead_ratio*helium_env(k)%helium%beads-helium_env(k)%helium%solute_beads + i = helium_env(k)%helium%bead_ratio*helium_env(k)%helium%beads - helium_env(k)%helium%solute_beads IF (i /= 0) THEN msg_str = "Adjust number of solute beads to multiple of solvent beads." CPABORT(msg_str) @@ -685,7 +685,7 @@ SUBROUTINE helium_create(helium_env, input, solute) helium_env(k)%helium%bead_ratio = helium_env(k)%helium%beads/ & helium_env(k)%helium%solute_beads ! check if bead numbers are commensurate: - i = helium_env(k)%helium%bead_ratio*helium_env(k)%helium%solute_beads-helium_env(k)%helium%beads + i = helium_env(k)%helium%bead_ratio*helium_env(k)%helium%solute_beads - helium_env(k)%helium%beads IF (i /= 0) THEN msg_str = "Adjust number of solvent beads to multiple of solute beads." CPABORT(msg_str) @@ -698,7 +698,7 @@ SUBROUTINE helium_create(helium_env, input, solute) !TODO Adjust helium bead number if not comm. and if coords not given expl. ! check if tau, temperature and bead number are consistent: - tcheck = ABS((helium_env(k)%helium%tau*helium_env(k)%helium%beads-solute%beta)/solute%beta) + tcheck = ABS((helium_env(k)%helium%tau*helium_env(k)%helium%beads - solute%beta)/solute%beta) IF (tcheck > 1.0e-14_dp) THEN msg_str = "Tau, temperature and bead number are inconsistent." CPABORT(msg_str) @@ -736,8 +736,8 @@ SUBROUTINE helium_create(helium_env, input, solute) ! since 2.9673 is in Angstrom helium_env(k)%helium%e_corr = (twopi*helium_env(k)%helium%density/angstrom**3*10.8_dp* & (544850.4_dp*EXP(-13.353384_dp*x1/2.9673_dp)*(2.9673_dp/13.353384_dp)**3* & - (2.0_dp+2.0_dp*13.353384_dp*x1/2.9673_dp+(13.353384_dp*x1/2.9673_dp)**2)- & - (((0.1781_dp/7.0_dp*(2.9673_dp/x1)**2+0.4253785_dp/5.0_dp)*(2.9673_dp/x1)**2+ & + (2.0_dp + 2.0_dp*13.353384_dp*x1/2.9673_dp + (13.353384_dp*x1/2.9673_dp)**2) - & + (((0.1781_dp/7.0_dp*(2.9673_dp/x1)**2 + 0.4253785_dp/5.0_dp)*(2.9673_dp/x1)**2 + & 1.3732412_dp/3.0_dp)*(2.9673_dp/x1)**3)*2.9673_dp**3))/kelvin END IF END IF @@ -790,7 +790,7 @@ SUBROUTINE helium_release(helium_env) DEALLOCATE (helium_env(k)%env_all) END IF NULLIFY (helium_env(k)%env_all) - helium_env(k)%helium%ref_count = helium_env(k)%helium%ref_count-1 + helium_env(k)%helium%ref_count = helium_env(k)%helium%ref_count - 1 IF (helium_env(k)%helium%ref_count < 1) THEN ! DEALLOCATE temporary arrays @@ -1172,29 +1172,29 @@ SUBROUTINE helium_coord_init(helium_env, initkT, solute_radius) invalidpos = .TRUE. iter = 0 DO WHILE (invalidpos) - iter = iter+1 + iter = iter + 1 invalidpos = .FALSE. ! if sampling fails to often, reduce he he criterion !CS TODO: !minHeHedsttmp = 0.90_dp**(iter/100)*minHeHedst - minHeHedsttmp = 0.90_dp**MIN(0, iter-2)*minHeHedst + minHeHedsttmp = 0.90_dp**MIN(0, iter - 2)*minHeHedst DO ic = 1, 3 r1 = next_random_number(helium_env(k)%helium%rng_stream_uniform) - r1 = 2.0_dp*r1-1.0_dp + r1 = 2.0_dp*r1 - 1.0_dp r1 = r1*helium_env(k)%helium%cell_size centroids(ic, ia) = r1 END DO ! check if helium is outside of cell tvek(:) = centroids(:, ia) CALL helium_pbc(helium_env(k)%helium, tvek(:)) - rvek(:) = tvek(:)-centroids(:, ia) + rvek(:) = tvek(:) - centroids(:, ia) r2 = DOT_PRODUCT(rvek, rvek) IF (r2 > 1.0_dp*10.0_dp**(-6)) THEN invalidpos = .TRUE. ELSE ! check for helium-helium collision - DO id = 1, ia-1 - rvek = centroids(:, ia)-centroids(:, id) + DO id = 1, ia - 1 + rvek = centroids(:, ia) - centroids(:, id) CALL helium_pbc(helium_env(k)%helium, rvek) r2 = DOT_PRODUCT(rvek, rvek) IF (r2 < minHeHedsttmp**2) THEN @@ -1206,7 +1206,7 @@ SUBROUTINE helium_coord_init(helium_env, initkT, solute_radius) IF (.NOT. invalidpos) THEN ! check if centroid collides with molecule IF (helium_env(k)%helium%solute_present) THEN - rvek(:) = (cvek(:)-centroids(:, ia)) + rvek(:) = (cvek(:) - centroids(:, ia)) r2 = DOT_PRODUCT(rvek, rvek) IF (r2 <= solute_radius**2) invalidpos = .TRUE. END IF @@ -1229,12 +1229,12 @@ SUBROUTINE helium_coord_init(helium_env, initkT, solute_radius) CALL helium_pbc(helium_env(k)%helium, helium_env(k)%helium%pos(:, ia, ib)) ! check if bead collides with molecule IF (helium_env(k)%helium%solute_present) THEN - rvek(:) = (cvek(:)-helium_env(k)%helium%pos(:, ia, ib)) + rvek(:) = (cvek(:) - helium_env(k)%helium%pos(:, ia, ib)) r2 = DOT_PRODUCT(rvek, rvek) IF (r2 <= solute_radius**2) THEN r1 = SQRT(r2) helium_env(k)%helium%pos(:, ia, ib) = & - cvek(:)+solute_radius/r1*rvek(:) + cvek(:) + solute_radius/r1*rvek(:) END IF END IF END DO @@ -1245,12 +1245,12 @@ SUBROUTINE helium_coord_init(helium_env, initkT, solute_radius) invalidpos = .TRUE. DO WHILE (invalidpos) invalidpos = .FALSE. - iter = iter+1 + iter = iter + 1 ! if sampling fails to often, reduce he he criterion - minHeHedsttmp = 0.90_dp**MIN(0, iter-2)*minHeHedst + minHeHedsttmp = 0.90_dp**MIN(0, iter - 2)*minHeHedst DO ic = 1, 3 rvek(ic) = next_random_number(helium_env(k)%helium%rng_stream_uniform) - rvek(ic) = 2.0_dp*rvek(ic)-1.0_dp + rvek(ic) = 2.0_dp*rvek(ic) - 1.0_dp rvek(ic) = rvek(ic)*helium_env(k)%helium%droplet_radius END DO centroids(:, ia) = rvek(:) @@ -1260,8 +1260,8 @@ SUBROUTINE helium_coord_init(helium_env, initkT, solute_radius) invalidpos = .TRUE. ELSE ! check for helium-helium collision - DO id = 1, ia-1 - rvek = centroids(:, ia)-centroids(:, id) + DO id = 1, ia - 1 + rvek = centroids(:, ia) - centroids(:, id) r2 = DOT_PRODUCT(rvek, rvek) IF (r2 < minHeHedsttmp**2) THEN invalidpos = .TRUE. @@ -1272,7 +1272,7 @@ SUBROUTINE helium_coord_init(helium_env, initkT, solute_radius) IF (.NOT. invalidpos) THEN ! make sure the helium does not collide with the solute IF (helium_env(k)%helium%solute_present) THEN - rvek(:) = (cvek(:)-centroids(:, ia)) + rvek(:) = (cvek(:) - centroids(:, ia)) r2 = DOT_PRODUCT(rvek, rvek) IF (r2 <= solute_radius**2) invalidpos = .TRUE. END IF @@ -1310,7 +1310,7 @@ SUBROUTINE helium_coord_init(helium_env, initkT, solute_radius) END IF ! transfer to position around actual center of droplet helium_env(k)%helium%pos(:, ia, ib) = & - helium_env(k)%helium%pos(:, ia, ib)+ & + helium_env(k)%helium%pos(:, ia, ib) + & helium_env(k)%helium%center(:) END DO END DO @@ -1353,20 +1353,20 @@ SUBROUTINE helium_thermal_gaussian_beads_init(helium_env, centroids, kbT) ! set up normal mode backtransform matrix u2x(:, :) = 0.0_dp u2x(:, 1) = invsqrtp - DO i = 2, p/2+1 + DO i = 2, p/2 + 1 DO j = 1, p - u2x(j, i) = sqrt2p*COS(twopip*(i-1)*(j-1)) + u2x(j, i) = sqrt2p*COS(twopip*(i - 1)*(j - 1)) END DO END DO - DO i = p/2+2, p + DO i = p/2 + 2, p DO j = 1, p - u2x(j, i) = sqrt2p*SIN(twopip*(i-1)*(j-1)) + u2x(j, i) = sqrt2p*SIN(twopip*(i - 1)*(j - 1)) END DO END DO IF (MOD(p, 2) == 0) THEN - DO i = 1, p-1, 2 - u2x(i, p/2+1) = invsqrtp - u2x(i+1, p/2+1) = -1.0_dp*invsqrtp + DO i = 1, p - 1, 2 + u2x(i, p/2 + 1) = invsqrtp + u2x(i + 1, p/2 + 1) = -1.0_dp*invsqrtp END DO END IF @@ -1374,7 +1374,7 @@ SUBROUTINE helium_thermal_gaussian_beads_init(helium_env, centroids, kbT) DO idim = 1, 3 nmhecoords(1) = sqrtp*centroids(idim, iatom) DO imode = 2, p - omega = 2.0_dp*p*kbT*SIN((imode-1)*pip) + omega = 2.0_dp*p*kbT*SIN((imode - 1)*pip) variance = kbT*p/(helium_env%he_mass_au*omega**2) rand = next_random_number(helium_env%rng_stream_gaussian) nmhecoords(imode) = rand*SQRT(variance) @@ -1444,19 +1444,19 @@ SUBROUTINE helium_coord_restore(helium_env) offset = 0 DO i = 1, logger%para_env%mepos - offset = offset+helium_env(1)%env_all(i) + offset = offset + helium_env(1)%env_all(i) END DO ! distribute coordinates over processors (no message passing) DO k = 1, SIZE(helium_env) msglen = helium_env(k)%helium%atoms*helium_env(k)%helium%beads*3 - off = msglen*MOD(offset+k-1, num_env_restart) + off = msglen*MOD(offset + k - 1, num_env_restart) NULLIFY (m, f) ALLOCATE (m(3, helium_env(k)%helium%atoms, helium_env(k)%helium%beads)) ALLOCATE (f(3, helium_env(k)%helium%atoms, helium_env(k)%helium%beads)) m(:, :, :) = .TRUE. f(:, :, :) = 0.0_dp - helium_env(k)%helium%pos(:, :, 1:helium_env(k)%helium%beads) = UNPACK(message(off+1:off+msglen), MASK=m, FIELD=f) + helium_env(k)%helium%pos(:, :, 1:helium_env(k)%helium%beads) = UNPACK(message(off + 1:off + msglen), MASK=m, FIELD=f) DEALLOCATE (f, m) END DO @@ -1648,13 +1648,13 @@ SUBROUTINE helium_perm_restore(helium_env) ! distribute permutation state over processors offset = 0 DO i = 1, logger%para_env%mepos - offset = offset+helium_env(1)%env_all(i) + offset = offset + helium_env(1)%env_all(i) END DO DO k = 1, SIZE(helium_env) msglen = helium_env(k)%helium%atoms - off = msglen*MOD(k-1+offset, num_env_restart) - helium_env(k)%helium%permutation(:) = message(off+1:off+msglen) + off = msglen*MOD(k - 1 + offset, num_env_restart) + helium_env(k)%helium%permutation(:) = message(off + 1:off + msglen) END DO END IF @@ -1665,7 +1665,7 @@ SUBROUTINE helium_perm_restore(helium_env) DO ia = 1, msglen IF ((helium_env(k)%helium%permutation(ia) > 0) .AND. (helium_env(k)%helium%permutation(ia) <= msglen)) THEN helium_env(k)%helium%iperm(helium_env(k)%helium%permutation(ia)) = ia - ic = ic+1 + ic = ic + 1 END IF END DO err_str = "Invalid HELIUM%PERM state: some numbers not within (1," @@ -1708,7 +1708,7 @@ SUBROUTINE helium_averages_restore(helium_env) offset = 0 DO i = 1, logger%para_env%mepos - offset = offset+helium_env(1)%env_all(i) + offset = offset + helium_env(1)%env_all(i) END DO ! restore projected area @@ -1723,8 +1723,8 @@ SUBROUTINE helium_averages_restore(helium_env) num_env_restart = SIZE(message)/3 ! apparent number of environments msglen = 3 DO k = 1, SIZE(helium_env) - off = msglen*MOD(offset+k-1, num_env_restart) - helium_env(k)%helium%proarea%rstr(:) = message(off+1:off+msglen) + off = msglen*MOD(offset + k - 1, num_env_restart) + helium_env(k)%helium%proarea%rstr(:) = message(off + 1:off + msglen) END DO ELSE DO k = 1, SIZE(helium_env) @@ -1744,8 +1744,8 @@ SUBROUTINE helium_averages_restore(helium_env) num_env_restart = SIZE(message)/3 ! apparent number of environments msglen = 3 DO k = 1, SIZE(helium_env) - off = msglen*MOD(offset+k-1, num_env_restart) - helium_env(k)%helium%prarea2%rstr(:) = message(off+1:off+msglen) + off = msglen*MOD(offset + k - 1, num_env_restart) + helium_env(k)%helium%prarea2%rstr(:) = message(off + 1:off + msglen) END DO ELSE DO k = 1, SIZE(helium_env) @@ -1765,8 +1765,8 @@ SUBROUTINE helium_averages_restore(helium_env) num_env_restart = SIZE(message)/3 ! apparent number of environments msglen = 3 DO k = 1, SIZE(helium_env) - off = msglen*MOD(offset+k-1, num_env_restart) - helium_env(k)%helium%wnmber2%rstr(:) = message(off+1:off+msglen) + off = msglen*MOD(offset + k - 1, num_env_restart) + helium_env(k)%helium%wnmber2%rstr(:) = message(off + 1:off + msglen) END DO ELSE DO k = 1, SIZE(helium_env) @@ -1786,8 +1786,8 @@ SUBROUTINE helium_averages_restore(helium_env) num_env_restart = SIZE(message)/3 ! apparent number of environments msglen = 3 DO k = 1, SIZE(helium_env) - off = msglen*MOD(offset+k-1, num_env_restart) - helium_env(k)%helium%mominer%rstr(:) = message(off+1:off+msglen) + off = msglen*MOD(offset + k - 1, num_env_restart) + helium_env(k)%helium%mominer%rstr(:) = message(off + 1:off + msglen) END DO ELSE DO k = 1, SIZE(helium_env) @@ -1910,20 +1910,20 @@ SUBROUTINE helium_rng_init(helium_env) offset = 0 DO i = 1, logger%para_env%mepos - offset = offset+helium_env(1)%env_all(i) + offset = offset + helium_env(1)%env_all(i) END DO IF (ASSOCIATED(helium_env)) THEN DO i = 1, SIZE(helium_env) NULLIFY (helium_env(i)%helium%rng_stream_uniform, & helium_env(i)%helium%rng_stream_gaussian) - helium_env(i)%helium%rng_stream_uniform => uniform_array(offset+i)%stream - helium_env(i)%helium%rng_stream_gaussian => gaussian_array(offset+i)%stream + helium_env(i)%helium%rng_stream_uniform => uniform_array(offset + i)%stream + helium_env(i)%helium%rng_stream_gaussian => gaussian_array(offset + i)%stream END DO END IF DO i = 1, helium_env(1)%helium%num_env - IF (i .LE. offset .OR. i .GT. offset+SIZE(helium_env)) THEN + IF (i .LE. offset .OR. i .GT. offset + SIZE(helium_env)) THEN CALL delete_rng_stream(uniform_array(i)%stream) CALL delete_rng_stream(gaussian_array(i)%stream) END IF @@ -1999,19 +1999,19 @@ SUBROUTINE helium_rng_restore(helium_env) ! unpack the buffer at each processor, set RNG state offset = 0 DO i = 1, logger%para_env%mepos - offset = offset+helium_env(1)%env_all(i) + offset = offset + helium_env(1)%env_all(i) END DO DO k = 1, SIZE(helium_env) msglen = 40 - off = msglen*(offset+k-1) + off = msglen*(offset + k - 1) m(:, :) = .TRUE. f(:, :) = 0.0_dp - bg(:, :) = UNPACK(message(off+1:off+6), MASK=m, FIELD=f) - cg(:, :) = UNPACK(message(off+7:off+12), MASK=m, FIELD=f) - ig(:, :) = UNPACK(message(off+13:off+18), MASK=m, FIELD=f) - bf = message(off+19) - bu = message(off+20) + bg(:, :) = UNPACK(message(off + 1:off + 6), MASK=m, FIELD=f) + cg(:, :) = UNPACK(message(off + 7:off + 12), MASK=m, FIELD=f) + ig(:, :) = UNPACK(message(off + 13:off + 18), MASK=m, FIELD=f) + bf = message(off + 19) + bu = message(off + 20) IF (bf .GT. 0) THEN lbf = .TRUE. ELSE @@ -2019,11 +2019,11 @@ SUBROUTINE helium_rng_restore(helium_env) END IF CALL set_rng_stream(helium_env(k)%helium%rng_stream_uniform, bg=bg, cg=cg, ig=ig, & buffer=bu, buffer_filled=lbf) - bg(:, :) = UNPACK(message(off+21:off+26), MASK=m, FIELD=f) - cg(:, :) = UNPACK(message(off+27:off+32), MASK=m, FIELD=f) - ig(:, :) = UNPACK(message(off+33:off+38), MASK=m, FIELD=f) - bf = message(off+39) - bu = message(off+40) + bg(:, :) = UNPACK(message(off + 21:off + 26), MASK=m, FIELD=f) + cg(:, :) = UNPACK(message(off + 27:off + 32), MASK=m, FIELD=f) + ig(:, :) = UNPACK(message(off + 33:off + 38), MASK=m, FIELD=f) + bf = message(off + 39) + bu = message(off + 40) IF (bf .GT. 0) THEN lbf = .TRUE. ELSE @@ -2089,7 +2089,7 @@ SUBROUTINE helium_rdf_init(helium) END IF IF (helium%rdf_he_he) THEN - helium%rdf_num = helium%rdf_num+1 + helium%rdf_num = helium%rdf_num + 1 END IF ! set the flag for RDF and either proceed or return @@ -2474,7 +2474,7 @@ SUBROUTINE helium_rho_init(helium) l_val=ltmp) IF (ltmp) THEN helium%rho_property(rho_atom_number)%is_calculated = .TRUE. - helium%rho_num_act = helium%rho_num_act+1 + helium%rho_num_act = helium%rho_num_act + 1 helium%rho_property(rho_atom_number)%component_index(1) = helium%rho_num_act END IF @@ -2486,7 +2486,7 @@ SUBROUTINE helium_rho_init(helium) IF (ltmp) THEN helium%rho_property(rho_projected_area)%is_calculated = .TRUE. DO ii = 1, helium%rho_property(rho_projected_area)%num_components - helium%rho_num_act = helium%rho_num_act+1 + helium%rho_num_act = helium%rho_num_act + 1 helium%rho_property(rho_projected_area)%component_index(ii) = helium%rho_num_act END DO END IF @@ -2499,7 +2499,7 @@ SUBROUTINE helium_rho_init(helium) IF (ltmp) THEN helium%rho_property(rho_winding_number)%is_calculated = .TRUE. DO ii = 1, helium%rho_property(rho_winding_number)%num_components - helium%rho_num_act = helium%rho_num_act+1 + helium%rho_num_act = helium%rho_num_act + 1 helium%rho_property(rho_winding_number)%component_index(ii) = helium%rho_num_act END DO END IF @@ -2512,7 +2512,7 @@ SUBROUTINE helium_rho_init(helium) IF (ltmp) THEN helium%rho_property(rho_winding_cycle)%is_calculated = .TRUE. DO ii = 1, helium%rho_property(rho_winding_cycle)%num_components - helium%rho_num_act = helium%rho_num_act+1 + helium%rho_num_act = helium%rho_num_act + 1 helium%rho_property(rho_winding_cycle)%component_index(ii) = helium%rho_num_act END DO END IF @@ -2525,7 +2525,7 @@ SUBROUTINE helium_rho_init(helium) IF (ltmp) THEN helium%rho_property(rho_moment_of_inertia)%is_calculated = .TRUE. DO ii = 1, helium%rho_property(rho_moment_of_inertia)%num_components - helium%rho_num_act = helium%rho_num_act+1 + helium%rho_num_act = helium%rho_num_act + 1 helium%rho_property(rho_moment_of_inertia)%component_index(ii) = helium%rho_num_act END DO END IF @@ -2553,7 +2553,7 @@ SUBROUTINE helium_rho_init(helium) itmp = SIZE(helium%rho_min_len_wdg_vals) IF (itmp .GT. 0) THEN helium%rho_num_min_len_wdg = itmp - helium%rho_num_act = helium%rho_num_act+itmp + helium%rho_num_act = helium%rho_num_act + itmp END IF END IF @@ -2572,7 +2572,7 @@ SUBROUTINE helium_rho_init(helium) itmp = SIZE(helium%rho_min_len_non_vals) IF (itmp .GT. 0) THEN helium%rho_num_min_len_non = itmp - helium%rho_num_act = helium%rho_num_act+itmp + helium%rho_num_act = helium%rho_num_act + itmp END IF END IF @@ -2591,7 +2591,7 @@ SUBROUTINE helium_rho_init(helium) itmp = SIZE(helium%rho_min_len_all_vals) IF (itmp .GT. 0) THEN helium%rho_num_min_len_all = itmp - helium%rho_num_act = helium%rho_num_act+itmp + helium%rho_num_act = helium%rho_num_act + itmp END IF END IF diff --git a/src/motion/helium_sampling.F b/src/motion/helium_sampling.F index 71fc729359..457463d470 100644 --- a/src/motion/helium_sampling.F +++ b/src/motion/helium_sampling.F @@ -128,7 +128,7 @@ SUBROUTINE helium_do_run(helium_env, globenv) DO step = 1, num_steps - tot_steps = tot_steps+1 + tot_steps = tot_steps + 1 IF (ASSOCIATED(helium_env)) THEN DO k = 1, SIZE(helium_env) @@ -212,7 +212,7 @@ SUBROUTINE helium_sample(helium_env, pint_env) ! runs independent helium simulation, the properties and forces are ! averaged over parallel helium environments once per step. inv_xn = 0.0_dp - SELECT CASE (helium_env (k)%helium%sampling_method) + SELECT CASE (helium_env(k)%helium%sampling_method) CASE (helium_sampling_worm) @@ -238,15 +238,15 @@ SUBROUTINE helium_sample(helium_env, pint_env) IF (helium_env(k)%helium%solute_present) THEN IF (helium_env(k)%helium%get_helium_forces == helium_forces_average) THEN CALL helium_solute_e_f(pint_env, helium_env(k)%helium, rtmp) - helium_env(k)%helium%force_avrg(:, :) = helium_env(k)%helium%force_avrg(:, :)+ & + helium_env(k)%helium%force_avrg(:, :) = helium_env(k)%helium%force_avrg(:, :) + & helium_env(k)%helium%force_inst(:, :) END IF END IF CALL helium_calc_energy(helium_env(k)%helium, pint_env) - helium_env(k)%helium%energy_avrg(:) = helium_env(k)%helium%energy_avrg(:)+helium_env(k)%helium%energy_inst(:) + helium_env(k)%helium%energy_avrg(:) = helium_env(k)%helium%energy_avrg(:) + helium_env(k)%helium%energy_inst(:) CALL helium_calc_plength(helium_env(k)%helium) - helium_env(k)%helium%plength_avrg(:) = helium_env(k)%helium%plength_avrg(:)+helium_env(k)%helium%plength_inst(:) + helium_env(k)%helium%plength_avrg(:) = helium_env(k)%helium%plength_avrg(:) + helium_env(k)%helium%plength_inst(:) ! instantaneous force output according to HELIUM%PRINT%FORCES_INST ! Warning: file I/O here may cost A LOT of cpu time! @@ -290,33 +290,33 @@ SUBROUTINE helium_sample(helium_env, pint_env) helium_env(k)%helium%mominer%inst(:) = helium_total_moment_of_inertia(helium_env(k)%helium) ! properties accumulated over the whole MC process - helium_env(k)%helium%proarea%accu(:) = helium_env(k)%helium%proarea%accu(:)+helium_env(k)%helium%proarea%inst(:) - helium_env(k)%helium%prarea2%accu(:) = helium_env(k)%helium%prarea2%accu(:)+helium_env(k)%helium%prarea2%inst(:) - helium_env(k)%helium%wnmber2%accu(:) = helium_env(k)%helium%wnmber2%accu(:)+helium_env(k)%helium%wnmber2%inst(:) - helium_env(k)%helium%mominer%accu(:) = helium_env(k)%helium%mominer%accu(:)+helium_env(k)%helium%mominer%inst(:) + helium_env(k)%helium%proarea%accu(:) = helium_env(k)%helium%proarea%accu(:) + helium_env(k)%helium%proarea%inst(:) + helium_env(k)%helium%prarea2%accu(:) = helium_env(k)%helium%prarea2%accu(:) + helium_env(k)%helium%prarea2%inst(:) + helium_env(k)%helium%wnmber2%accu(:) = helium_env(k)%helium%wnmber2%accu(:) + helium_env(k)%helium%wnmber2%inst(:) + helium_env(k)%helium%mominer%accu(:) = helium_env(k)%helium%mominer%accu(:) + helium_env(k)%helium%mominer%inst(:) IF (helium_env(k)%helium%rho_present) THEN CALL helium_calc_rho(helium_env(k)%helium) - helium_env(k)%helium%rho_accu(:, :, :, :) = helium_env(k)%helium%rho_accu(:, :, :, :)+ & + helium_env(k)%helium%rho_accu(:, :, :, :) = helium_env(k)%helium%rho_accu(:, :, :, :) + & helium_env(k)%helium%rho_inst(:, :, :, :) END IF IF (helium_env(k)%helium%rdf_present) THEN CALL helium_set_rdf_coord_system(helium_env(k)%helium, pint_env) CALL helium_calc_rdf(helium_env(k)%helium) - helium_env(k)%helium%rdf_accu(:, :) = helium_env(k)%helium%rdf_accu(:, :)+helium_env(k)%helium%rdf_inst(:, :) + helium_env(k)%helium%rdf_accu(:, :) = helium_env(k)%helium%rdf_accu(:, :) + helium_env(k)%helium%rdf_inst(:, :) END IF ! running averages (restart-aware) - nsteps = helium_env(k)%helium%current_step-helium_env(k)%helium%first_step + nsteps = helium_env(k)%helium%current_step - helium_env(k)%helium%first_step iweight = helium_env(k)%helium%averages_iweight rweight = REAL(iweight, dp) - rtmp = 1.0_dp/(REAL(MAX(1, nsteps+iweight), dp)) - helium_env(k)%helium%proarea%ravr(:) = (helium_env(k)%helium%proarea%accu(:)+ & + rtmp = 1.0_dp/(REAL(MAX(1, nsteps + iweight), dp)) + helium_env(k)%helium%proarea%ravr(:) = (helium_env(k)%helium%proarea%accu(:) + & rweight*helium_env(k)%helium%proarea%rstr(:))*rtmp - helium_env(k)%helium%prarea2%ravr(:) = (helium_env(k)%helium%prarea2%accu(:)+ & + helium_env(k)%helium%prarea2%ravr(:) = (helium_env(k)%helium%prarea2%accu(:) + & rweight*helium_env(k)%helium%prarea2%rstr(:))*rtmp - helium_env(k)%helium%wnmber2%ravr(:) = (helium_env(k)%helium%wnmber2%accu(:)+ & + helium_env(k)%helium%wnmber2%ravr(:) = (helium_env(k)%helium%wnmber2%accu(:) + & rweight*helium_env(k)%helium%wnmber2%rstr(:))*rtmp - helium_env(k)%helium%mominer%ravr(:) = (helium_env(k)%helium%mominer%accu(:)+ & + helium_env(k)%helium%mominer%ravr(:) = (helium_env(k)%helium%mominer%accu(:) + & rweight*helium_env(k)%helium%mominer%rstr(:))*rtmp END DO @@ -328,7 +328,7 @@ SUBROUTINE helium_sample(helium_env, pint_env) !energy_avrg: DO k = 2, SIZE(helium_env) - helium_env(1)%helium%energy_avrg(:) = helium_env(1)%helium%energy_avrg(:)+ & + helium_env(1)%helium%energy_avrg(:) = helium_env(1)%helium%energy_avrg(:) + & helium_env(k)%helium%energy_avrg(:) END DO CALL mp_sum(helium_env(1)%helium%energy_avrg(:), helium_env(1)%comm) @@ -339,7 +339,7 @@ SUBROUTINE helium_sample(helium_env, pint_env) !plength_avrg: DO k = 2, SIZE(helium_env) - helium_env(1)%helium%plength_avrg(:) = helium_env(1)%helium%plength_avrg(:)+ & + helium_env(1)%helium%plength_avrg(:) = helium_env(1)%helium%plength_avrg(:) + & helium_env(k)%helium%plength_avrg(:) END DO CALL mp_sum(helium_env(1)%helium%plength_avrg(:), helium_env(1)%comm) @@ -350,7 +350,7 @@ SUBROUTINE helium_sample(helium_env, pint_env) !num_accepted: DO k = 2, SIZE(helium_env) - helium_env(1)%helium%num_accepted(:, :) = helium_env(1)%helium%num_accepted(:, :)+ & + helium_env(1)%helium%num_accepted(:, :) = helium_env(1)%helium%num_accepted(:, :) + & helium_env(k)%helium%num_accepted(:, :) END DO CALL mp_sum(helium_env(1)%helium%num_accepted(:, :), helium_env(1)%comm) @@ -363,7 +363,7 @@ SUBROUTINE helium_sample(helium_env, pint_env) IF (helium_env(1)%helium%solute_present) THEN IF (helium_env(1)%helium%get_helium_forces == helium_forces_average) THEN DO k = 2, SIZE(helium_env) - helium_env(1)%helium%force_avrg(:, :) = helium_env(1)%helium%force_avrg(:, :)+ & + helium_env(1)%helium%force_avrg(:, :) = helium_env(1)%helium%force_avrg(:, :) + & helium_env(k)%helium%force_avrg(:, :) END DO CALL mp_sum(helium_env(1)%helium%force_avrg(:, :), helium_env(1)%comm) @@ -380,13 +380,13 @@ SUBROUTINE helium_sample(helium_env, pint_env) offset = 0 DO i = 1, logger%para_env%mepos - offset = offset+helium_env(1)%env_all(i) + offset = offset + helium_env(1)%env_all(i) END DO ALLOCATE (work_2d(SIZE(helium_env(1)%helium%force_avrg, 1), & SIZE(helium_env(1)%helium%force_avrg, 2))) work_2d(:, :) = 0.0_dp - IF (sel_mp_source .GE. offset .AND. sel_mp_source .LT. offset+SIZE(helium_env)) THEN - work_2d(:, :) = helium_env(sel_mp_source-offset+1)%helium%force_avrg(:, :) + IF (sel_mp_source .GE. offset .AND. sel_mp_source .LT. offset + SIZE(helium_env)) THEN + work_2d(:, :) = helium_env(sel_mp_source - offset + 1)%helium%force_avrg(:, :) END IF CALL mp_sum(work_2d(:, :), helium_env(1)%comm) DO k = 1, SIZE(helium_env) @@ -445,7 +445,7 @@ SUBROUTINE helium_step(helium_env, pint_env) WRITE (stmp, *) helium_env(1)%helium%apref DATA(:) = 0.0_dp DO k = 1, SIZE(helium_env) - DATA((k-1)*3+1:k*3) = helium_env(k)%helium%proarea%inst(:) + DATA((k - 1)*3 + 1:k*3) = helium_env(k)%helium%proarea%inst(:) END DO CALL helium_print_vector(helium_env, & "MOTION%PINT%HELIUM%PRINT%PROJECTED_AREA", & @@ -457,7 +457,7 @@ SUBROUTINE helium_step(helium_env, pint_env) DATA(:) = 0.0_dp DO k = 1, SIZE(helium_env) - DATA((k-1)*3+1:k*3) = helium_env(k)%helium%prarea2%ravr(:) + DATA((k - 1)*3 + 1:k*3) = helium_env(k)%helium%prarea2%ravr(:) END DO CALL helium_print_vector(helium_env, & "MOTION%PINT%HELIUM%PRINT%PROJECTED_AREA_2_AVG", & @@ -471,7 +471,7 @@ SUBROUTINE helium_step(helium_env, pint_env) DATA(:) = 0.0_dp DO k = 1, SIZE(helium_env) - DATA((k-1)*3+1:k*3) = helium_env(k)%helium%mominer%inst(:) + DATA((k - 1)*3 + 1:k*3) = helium_env(k)%helium%mominer%inst(:) END DO CALL helium_print_vector(helium_env, & "MOTION%PINT%HELIUM%PRINT%MOMENT_OF_INERTIA", & @@ -483,7 +483,7 @@ SUBROUTINE helium_step(helium_env, pint_env) DATA(:) = 0.0_dp DO k = 1, SIZE(helium_env) - DATA((k-1)*3+1:k*3) = helium_env(k)%helium%mominer%ravr + DATA((k - 1)*3 + 1:k*3) = helium_env(k)%helium%mominer%ravr END DO CALL helium_print_vector(helium_env, & "MOTION%PINT%HELIUM%PRINT%MOMENT_OF_INERTIA_AVG", & @@ -497,7 +497,7 @@ SUBROUTINE helium_step(helium_env, pint_env) DATA(:) = 0.0_dp DO k = 1, SIZE(helium_env) - DATA((k-1)*3+1:k*3) = helium_env(k)%helium%wnumber%inst + DATA((k - 1)*3 + 1:k*3) = helium_env(k)%helium%wnumber%inst END DO WRITE (stmp, *) helium_env(1)%helium%wpref CALL helium_print_vector(helium_env, & @@ -510,7 +510,7 @@ SUBROUTINE helium_step(helium_env, pint_env) DATA(:) = 0.0_dp DO k = 1, SIZE(helium_env) - DATA((k-1)*3+1:k*3) = helium_env(k)%helium%wnmber2%ravr + DATA((k - 1)*3 + 1:k*3) = helium_env(k)%helium%wnmber2%ravr END DO CALL helium_print_vector(helium_env, & "MOTION%PINT%HELIUM%PRINT%WINDING_NUMBER_2_AVG", & @@ -524,7 +524,7 @@ SUBROUTINE helium_step(helium_env, pint_env) DEALLOCATE (DATA) time_stop = m_walltime() - time_used = time_stop-time_start + time_used = time_stop - time_start time_unit = "sec" IF (time_used .GE. 60.0_dp) THEN time_used = time_used/60.0_dp @@ -592,7 +592,7 @@ SUBROUTINE helium_try_permutations(helium, pint_env) DO ni = 1, helium%iter_norot ! set the probability threshold for m_value: 1/(1+(m-1)/helium%m_ratio) - r = 1.0_dp/(1.0_dp+(helium%maxcycle-1)/helium%m_ratio) + r = 1.0_dp/(1.0_dp + (helium%maxcycle - 1)/helium%m_ratio) ! draw permutation length for this trial from the distribution of choice ! @@ -613,7 +613,7 @@ SUBROUTINE helium_try_permutations(helium, pint_env) ELSE DO x = next_random_number(helium%rng_stream_uniform) - cyclen = INT(helium%maxcycle*x)+1 + cyclen = INT(helium%maxcycle*x) + 1 IF (cyclen .NE. helium%m_value) EXIT END DO END IF @@ -626,7 +626,7 @@ SUBROUTINE helium_try_permutations(helium, pint_env) DO x = next_random_number(helium%rng_stream_uniform) y = SQRT(2.0_dp*x) - cyclen = INT(helium%maxcycle*y/SQRT(2.0_dp))+1 + cyclen = INT(helium%maxcycle*y/SQRT(2.0_dp)) + 1 IF (cyclen .NE. helium%m_value) EXIT END DO END IF @@ -640,7 +640,7 @@ SUBROUTINE helium_try_permutations(helium, pint_env) x = next_random_number(helium%rng_stream_uniform) y = (3.0_dp*x)**(1.0_dp/3.0_dp) z = 3.0_dp**(1.0_dp/3.0_dp) - cyclen = INT(helium%maxcycle*y/z)+1 + cyclen = INT(helium%maxcycle*y/z) + 1 IF (cyclen .NE. helium%m_value) EXIT END DO END IF @@ -656,8 +656,8 @@ SUBROUTINE helium_try_permutations(helium, pint_env) IF (x .GE. 0.01_dp) EXIT END DO z = -LOG(0.01_dp) - y = LOG(x)/z+1.0_dp; - cyclen = INT(helium%maxcycle*y)+1 + y = LOG(x)/z + 1.0_dp; + cyclen = INT(helium%maxcycle*y) + 1 IF (cyclen .NE. helium%m_value) EXIT END DO END IF @@ -669,7 +669,7 @@ SUBROUTINE helium_try_permutations(helium, pint_env) ELSE DO x = next_random_number(helium%rng_stream_gaussian) - cyclen = INT(x*0.75_dp+helium%m_value-0.5_dp)+1 + cyclen = INT(x*0.75_dp + helium%m_value - 0.5_dp) + 1 IF (cyclen .NE. 1) EXIT END DO END IF @@ -684,12 +684,12 @@ SUBROUTINE helium_try_permutations(helium, pint_env) IF (cyclen < 1) cyclen = 1 IF (cyclen > helium%maxcycle) cyclen = helium%maxcycle - helium%num_accepted(1, cyclen) = helium%num_accepted(1, cyclen)+1 + helium%num_accepted(1, cyclen) = helium%num_accepted(1, cyclen) + 1 ! check, if permutation of this length can be constructed IF (cyclen == 1) THEN rnd = next_random_number(helium%rng_stream_uniform) - helium%ptable(1) = 1+INT(rnd*helium%atoms) + helium%ptable(1) = 1 + INT(rnd*helium%atoms) helium%ptable(2) = -1 helium%pweight = 0.0_dp selected = .TRUE. @@ -767,7 +767,7 @@ FUNCTION helium_slice_metro_cyclic(helium, pint_env, cyclen) RESULT(res) p => helium%ptable prev_ds = helium%pweight - helium%num_accepted(2, cyclen) = helium%num_accepted(2, cyclen)+1 + helium%num_accepted(2, cyclen) = helium%num_accepted(2, cyclen) + 1 level = 1 res = .FALSE. @@ -789,7 +789,7 @@ FUNCTION helium_slice_metro_cyclic(helium, pint_env, cyclen) RESULT(res) nperiodic = .NOT. helium%periodic pds = prev_ds - ifix = helium%beads-helium%bisection+1 + ifix = helium%beads - helium%bisection + 1 ! sanity checks ! @@ -828,18 +828,18 @@ FUNCTION helium_slice_metro_cyclic(helium, pint_env, cyclen) RESULT(res) dtk = 0.0_dp ds = 0.0_dp - j = ifix+stride/2 + j = ifix + stride/2 DO - IF (j > helium%beads-stride/2) EXIT - pk1 = j-stride/2 - pk2 = j+stride/2 + IF (j > helium%beads - stride/2) EXIT + pk1 = j - stride/2 + pk2 = j + stride/2 ! calculate log(T(s)): DO k = 1, cyclen CALL helium_boxmean_3d(helium, pos(:, p(k), pk1), pos(:, p(k), pk2), bis) - tmp1(:) = bis(:)-pos(:, p(k), j) + tmp1(:) = bis(:) - pos(:, p(k), j) CALL helium_pbc(helium, tmp1) tmp1(:) = tmp1(:)/sigma - dtk = dtk-0.5_dp*(tmp1(1)*tmp1(1)+tmp1(2)*tmp1(2)+tmp1(3)*tmp1(3)) + dtk = dtk - 0.5_dp*(tmp1(1)*tmp1(1) + tmp1(2)*tmp1(2) + tmp1(3)*tmp1(3)) END DO ! calculate log(T(sprime)) and sprime itself DO k = 1, cyclen @@ -847,116 +847,116 @@ FUNCTION helium_slice_metro_cyclic(helium, pint_env, cyclen) RESULT(res) DO c = 1, 3 x = next_random_number(rng_stream=helium%rng_stream_gaussian, variance=1.0_dp) x = sigma*x - tmp1(c) = tmp1(c)+x + tmp1(c) = tmp1(c) + x tmp2(c) = x END DO CALL helium_pbc(helium, tmp1) CALL helium_pbc(helium, tmp2) work(:, p(k), j) = tmp1(:) tmp2(:) = tmp2(:)/sigma - dtk = dtk+0.5_dp*(tmp2(1)*tmp2(1)+tmp2(2)*tmp2(2)+tmp2(3)*tmp2(3)) + dtk = dtk + 0.5_dp*(tmp2(1)*tmp2(1) + tmp2(2)*tmp2(2) + tmp2(3)*tmp2(3)) END DO - j = j+stride + j = j + stride END DO - j = helium%beads-stride/2+1 - pk1 = j-stride/2 + j = helium%beads - stride/2 + 1 + pk1 = j - stride/2 DO k = 1, cyclen CALL helium_boxmean_3d(helium, pos(:, p(k), pk1), pos(:, perm(p(k)), 1), bis) - tmp1(:) = bis(:)-pos(:, p(k), j) + tmp1(:) = bis(:) - pos(:, p(k), j) CALL helium_pbc(helium, tmp1) tmp1(:) = tmp1(:)/sigma - dtk = dtk-0.5_dp*(tmp1(1)*tmp1(1)+tmp1(2)*tmp1(2)+tmp1(3)*tmp1(3)) + dtk = dtk - 0.5_dp*(tmp1(1)*tmp1(1) + tmp1(2)*tmp1(2) + tmp1(3)*tmp1(3)) END DO DO k = 1, cyclen - CALL helium_boxmean_3d(helium, work(:, p(k), pk1), work(:, perm(p(1+MOD(k, cyclen))), 1), tmp1) + CALL helium_boxmean_3d(helium, work(:, p(k), pk1), work(:, perm(p(1 + MOD(k, cyclen))), 1), tmp1) DO c = 1, 3 x = next_random_number(rng_stream=helium%rng_stream_gaussian, variance=1.0_dp) x = sigma*x - tmp1(c) = tmp1(c)+x + tmp1(c) = tmp1(c) + x tmp2(c) = x END DO CALL helium_pbc(helium, tmp1) CALL helium_pbc(helium, tmp2) work(:, p(k), j) = tmp1(:) tmp2(:) = tmp2(:)/sigma - dtk = dtk+0.5_dp*(tmp2(1)*tmp2(1)+tmp2(2)*tmp2(2)+tmp2(3)*tmp2(3)) + dtk = dtk + 0.5_dp*(tmp2(1)*tmp2(1) + tmp2(2)*tmp2(2) + tmp2(3)*tmp2(3)) END DO ! ok we got the new positions ! calculate action_k(s)-action_k(sprime) x = 1.0_dp/(helium%tau*helium%hb2m*stride) j = ifix DO - IF (j > helium%beads-stride/2) EXIT - pk1 = j+stride/2 + IF (j > helium%beads - stride/2) EXIT + pk1 = j + stride/2 DO k = 1, cyclen - tmp1(:) = pos(:, p(k), j)-pos(:, p(k), pk1) + tmp1(:) = pos(:, p(k), j) - pos(:, p(k), pk1) CALL helium_pbc(helium, tmp1) - ds = ds+x*(tmp1(1)*tmp1(1)+tmp1(2)*tmp1(2)+tmp1(3)*tmp1(3)) - tmp1(:) = work(:, p(k), j)-work(:, p(k), pk1) + ds = ds + x*(tmp1(1)*tmp1(1) + tmp1(2)*tmp1(2) + tmp1(3)*tmp1(3)) + tmp1(:) = work(:, p(k), j) - work(:, p(k), pk1) CALL helium_pbc(helium, tmp1) - ds = ds-x*(tmp1(1)*tmp1(1)+tmp1(2)*tmp1(2)+tmp1(3)*tmp1(3)) + ds = ds - x*(tmp1(1)*tmp1(1) + tmp1(2)*tmp1(2) + tmp1(3)*tmp1(3)) ! interaction change IF (helium%solute_present) THEN CALL helium_bead_solute_e_f(pint_env, helium, p(k), pk1, energy=e1) CALL helium_bead_solute_e_f(pint_env, helium, p(k), pk1, work(:, p(k), pk1), e2) - ds = ds+(stride/2)*(e1-e2)*helium%tau + ds = ds + (stride/2)*(e1 - e2)*helium%tau END IF DO l = 1, helium%atoms IF (l /= p(k)) THEN - tmp1(:) = pos(:, p(k), pk1)-pos(:, l, pk1) + tmp1(:) = pos(:, p(k), pk1) - pos(:, l, pk1) CALL helium_pbc(helium, tmp1) - r = tmp1(1)*tmp1(1)+tmp1(2)*tmp1(2)+tmp1(3)*tmp1(3) + r = tmp1(1)*tmp1(1) + tmp1(2)*tmp1(2) + tmp1(3)*tmp1(3) IF ((r < cell_size) .OR. nperiodic) THEN r = SQRT(r) - ds = ds+REAL(stride/2, dp)*helium_spline(uij(1, 1)%spline_data, r) + ds = ds + REAL(stride/2, dp)*helium_spline(uij(1, 1)%spline_data, r) END IF - tmp1(:) = work(:, p(k), pk1)-work(:, l, pk1) + tmp1(:) = work(:, p(k), pk1) - work(:, l, pk1) CALL helium_pbc(helium, tmp1) - r = tmp1(1)*tmp1(1)+tmp1(2)*tmp1(2)+tmp1(3)*tmp1(3) + r = tmp1(1)*tmp1(1) + tmp1(2)*tmp1(2) + tmp1(3)*tmp1(3) IF ((r < cell_size) .OR. nperiodic) THEN r = SQRT(r) - ds = ds-REAL(stride/2, dp)*helium_spline(uij(1, 1)%spline_data, r) + ds = ds - REAL(stride/2, dp)*helium_spline(uij(1, 1)%spline_data, r) END IF END IF END DO ! counted p[k], p[m] twice. subtract those again IF (k < cyclen) THEN - DO l = k+1, cyclen - tmp1(:) = pos(:, p(k), pk1)-pos(:, p(l), pk1) + DO l = k + 1, cyclen + tmp1(:) = pos(:, p(k), pk1) - pos(:, p(l), pk1) CALL helium_pbc(helium, tmp1) - r = tmp1(1)*tmp1(1)+tmp1(2)*tmp1(2)+tmp1(3)*tmp1(3) + r = tmp1(1)*tmp1(1) + tmp1(2)*tmp1(2) + tmp1(3)*tmp1(3) IF ((r < cell_size) .OR. nperiodic) THEN r = SQRT(r) - ds = ds-REAL(stride/2, dp)*helium_spline(uij(1, 1)%spline_data, r) + ds = ds - REAL(stride/2, dp)*helium_spline(uij(1, 1)%spline_data, r) END IF - tmp1(:) = work(:, p(k), pk1)-work(:, p(l), pk1) + tmp1(:) = work(:, p(k), pk1) - work(:, p(l), pk1) CALL helium_pbc(helium, tmp1) - r = tmp1(1)*tmp1(1)+tmp1(2)*tmp1(2)+tmp1(3)*tmp1(3) + r = tmp1(1)*tmp1(1) + tmp1(2)*tmp1(2) + tmp1(3)*tmp1(3) IF ((r < cell_size) .OR. nperiodic) THEN r = SQRT(r) - ds = ds+REAL(stride/2, dp)*helium_spline(uij(1, 1)%spline_data, r) + ds = ds + REAL(stride/2, dp)*helium_spline(uij(1, 1)%spline_data, r) END IF END DO END IF END DO - j = j+stride/2 + j = j + stride/2 END DO ! last link - pk1 = helium%beads-stride/2+1 + pk1 = helium%beads - stride/2 + 1 DO k = 1, cyclen - tmp1(:) = pos(:, p(k), pk1)-pos(:, perm(p(k)), 1) + tmp1(:) = pos(:, p(k), pk1) - pos(:, perm(p(k)), 1) CALL helium_pbc(helium, tmp1) - ds = ds+x*(tmp1(1)*tmp1(1)+tmp1(2)*tmp1(2)+tmp1(3)*tmp1(3)) - tmp1(:) = work(:, p(k), pk1)-work(:, perm(p(1+MOD(k, cyclen))), 1) + ds = ds + x*(tmp1(1)*tmp1(1) + tmp1(2)*tmp1(2) + tmp1(3)*tmp1(3)) + tmp1(:) = work(:, p(k), pk1) - work(:, perm(p(1 + MOD(k, cyclen))), 1) CALL helium_pbc(helium, tmp1) - ds = ds-x*(tmp1(1)*tmp1(1)+tmp1(2)*tmp1(2)+tmp1(3)*tmp1(3)) + ds = ds - x*(tmp1(1)*tmp1(1) + tmp1(2)*tmp1(2) + tmp1(3)*tmp1(3)) END DO ! ok now accept or reject: rtmp = next_random_number(helium%rng_stream_uniform) ! IF ((dtk+ds-pds < 0.0_dp).AND.(EXP(dtk+ds-pds) 1) THEN !k,c,l c = perm(p(1)) - DO k = 1, cyclen-1 - perm(p(k)) = perm(p(k+1)) + DO k = 1, cyclen - 1 + perm(p(k)) = perm(p(k + 1)) END DO perm(p(cyclen)) = c END IF DO k = 1, cyclen DO l = 1, helium%atoms IF (l /= p(k)) THEN - rm1(:) = work(:, p(k), j)-work(:, l, j) - rm2(:) = work(:, perm(p(k)), 1)-work(:, perm(l), 1) - ds = ds-helium_eval_expansion(helium, rm1, rm2, uij, 1) + rm1(:) = work(:, p(k), j) - work(:, l, j) + rm2(:) = work(:, perm(p(k)), 1) - work(:, perm(l), 1) + ds = ds - helium_eval_expansion(helium, rm1, rm2, uij, 1) END IF END DO ! counted p[k], p[m] twice. subtract those again IF (k < cyclen) THEN - DO l = k+1, cyclen - rm1(:) = work(:, p(k), j)-work(:, p(l), j) - rm2(:) = work(:, perm(p(k)), 1)-work(:, perm(p(l)), 1) - ds = ds+helium_eval_expansion(helium, rm1, rm2, uij, 1) + DO l = k + 1, cyclen + rm1(:) = work(:, p(k), j) - work(:, p(l), j) + rm2(:) = work(:, perm(p(k)), 1) - work(:, perm(p(l)), 1) + ds = ds + helium_eval_expansion(helium, rm1, rm2, uij, 1) END DO END IF END DO ! ok now accept or reject: rtmp = next_random_number(helium%rng_stream_uniform) ! IF ((dtk+ds-pds<0.0_dp).AND.(EXP(dtk+ds-pds) 1) THEN c = perm(p(cyclen)) - DO k = cyclen-1, 1, -1 - perm(p(k+1)) = perm(p(k)) + DO k = cyclen - 1, 1, -1 + perm(p(k + 1)) = perm(p(k)) END DO perm(p(1)) = c END IF @@ -1155,7 +1155,7 @@ FUNCTION helium_slice_metro_cyclic(helium, pint_env, cyclen) RESULT(res) new_com(:) = 0.0_dp DO k = 1, helium%atoms DO l = 1, helium%beads - new_com(:) = new_com(:)+helium%work(:, k, l) + new_com(:) = new_com(:) + helium%work(:, k, l) END DO END DO new_com(:) = new_com(:)/helium%atoms/helium%beads @@ -1166,7 +1166,7 @@ FUNCTION helium_slice_metro_cyclic(helium, pint_env, cyclen) RESULT(res) bis(:) = 0.0_dp DO ib = 1, helium%beads DO ic = 1, 3 - bis(ic) = bis(ic)+work(ic, ia, ib)-new_com(ic) + bis(ic) = bis(ic) + work(ic, ia, ib) - new_com(ic) END DO END DO bis(:) = bis(:)/helium%beads @@ -1175,7 +1175,7 @@ FUNCTION helium_slice_metro_cyclic(helium, pint_env, cyclen) RESULT(res) biso(:) = 0.0_dp DO ib = 1, helium%beads DO ic = 1, 3 - biso(ic) = biso(ic)+pos(ic, ia, ib)-helium%center(ic) + biso(ic) = biso(ic) + pos(ic, ia, ib) - helium%center(ic) END DO END DO biso(:) = biso(:)/helium%beads @@ -1197,8 +1197,8 @@ FUNCTION helium_slice_metro_cyclic(helium, pint_env, cyclen) RESULT(res) END DO IF (cyclen > 1) THEN c = perm(p(cyclen)) - DO k = cyclen-1, 1, -1 - perm(p(k+1)) = perm(p(k)) + DO k = cyclen - 1, 1, -1 + perm(p(k + 1)) = perm(p(k)) END DO perm(p(1)) = c END IF @@ -1216,7 +1216,7 @@ FUNCTION helium_slice_metro_cyclic(helium, pint_env, cyclen) RESULT(res) DO k = 1, cyclen helium%iperm(perm(p(k))) = p(k) END DO - helium%num_accepted(level+2, cyclen) = helium%num_accepted(level+2, cyclen)+1 + helium%num_accepted(level + 2, cyclen) = helium%num_accepted(level + 2, cyclen) + 1 res = .TRUE. RETURN @@ -1252,17 +1252,17 @@ FUNCTION helium_select_permutation(helium, len) RESULT(res) p => helium%ptable nmatrix => helium%nmatrix - p(len+1) = -1 + p(len + 1) = -1 rnd = next_random_number(helium%rng_stream_uniform) - p(1) = INT(n*rnd)+1 - DO k = 1, len-1 + p(1) = INT(n*rnd) + 1 + DO k = 1, len - 1 t = next_random_number(helium%rng_stream_uniform) ! find the corresponding path to connect to ! using the precalculated optimal decision tree: - i = n-1 + i = n - 1 DO IF (tmatrix(p(k), i) > t) THEN - i = nmatrix(p(k), 2*i-1) + i = nmatrix(p(k), 2*i - 1) ELSE i = nmatrix(p(k), 2*i) END IF @@ -1270,19 +1270,19 @@ FUNCTION helium_select_permutation(helium, len) RESULT(res) END DO i = -i ! which particle was it previously connected to? - p(k+1) = iperm(i) + p(k + 1) = iperm(i) ! is it unique? quit if it was already part of the permutation DO j = 1, k - IF (p(j) == p(k+1)) RETURN + IF (p(j) == p(k + 1)) RETURN END DO ! acummulate the needed values for the final ! accept/reject step: - s1 = s1+ipmatrix(p(k), i) - s2 = s2+ipmatrix(p(k), perm(p(k))) + s1 = s1 + ipmatrix(p(k), i) + s2 = s2 + ipmatrix(p(k), perm(p(k))) END DO ! close the permutation loop: - s1 = s1+ipmatrix(p(len), perm(p(1))) - s2 = s2+ipmatrix(p(len), perm(p(len))) + s1 = s1 + ipmatrix(p(len), perm(p(1))) + s2 = s2 + ipmatrix(p(len), perm(p(len))) ! final accept/reject: rnd = next_random_number(helium%rng_stream_uniform) t = s1*rnd @@ -1290,9 +1290,9 @@ FUNCTION helium_select_permutation(helium, len) RESULT(res) ! ok, we have accepted the permutation ! calculate the action bias for the subsequent resampling ! of the paths: - s1 = pmatrix(p(len), perm(p(1)))-pmatrix(p(len), perm(p(len))) - DO k = 1, len-1 - s1 = s1+pmatrix(p(k), perm(p(k+1)))-pmatrix(p(k), perm(p(k))) + s1 = pmatrix(p(len), perm(p(1))) - pmatrix(p(len), perm(p(len))) + DO k = 1, len - 1 + s1 = s1 + pmatrix(p(k), perm(p(k + 1))) - pmatrix(p(k), perm(p(k))) END DO helium%pweight = s1 res = .TRUE. diff --git a/src/motion/helium_worm.F b/src/motion/helium_worm.F index 4886208634..c2d729b629 100644 --- a/src/motion/helium_worm.F +++ b/src/motion/helium_worm.F @@ -104,19 +104,19 @@ SUBROUTINE helium_sample_worm(helium, pint_env) iatom = next_random_number(helium%rng_stream_uniform, 1, helium%atoms) CALL worm_centroid_move(pint_env, helium, & iatom, helium%worm_centroid_drmax, ac) - ncentratt = ncentratt+1 - ncentracc = ncentracc+ac + ncentratt = ncentratt + 1 + ncentracc = ncentracc + ac ! Note: weights for open and centroid move are taken from open sampling ! staging is adjusted to conserve these weights - ELSE IF ((imove >= helium%worm_centroid_max+1) .AND. (imove <= helium%worm_open_close_min-1)) THEN + ELSE IF ((imove >= helium%worm_centroid_max + 1) .AND. (imove <= helium%worm_open_close_min - 1)) THEN ! staging move iatom = next_random_number(helium%rng_stream_uniform, 1, helium%atoms) ibead = next_random_number(helium%rng_stream_uniform, 1, helium%beads) staging_l = next_random_number(helium%rng_stream_uniform, 2, helium%worm_staging_l) CALL worm_staging_move(pint_env, helium, & iatom, ibead, staging_l, ac) - nstagatt = nstagatt+1 - nstagacc = nstagacc+ac + nstagatt = nstagatt + 1 + nstagacc = nstagacc + ac ELSE IF ((imove >= helium%worm_open_close_min) .AND. (imove <= helium%worm_open_close_max)) THEN ! attempt opening of worm iatom = next_random_number(helium%rng_stream_uniform, 1, helium%atoms) @@ -124,8 +124,8 @@ SUBROUTINE helium_sample_worm(helium, pint_env) staging_l = next_random_number(helium%rng_stream_uniform, 2, helium%worm_staging_l) CALL worm_open_move(pint_env, helium, & iatom, ibead, staging_l, ac) - nopenatt = nopenatt+1 - nopenacc = nopenacc+ac + nopenatt = nopenatt + 1 + nopenacc = nopenacc + ac ELSE ! this must not occur CPABORT("Undefined move selected in helium worm sampling!") @@ -136,8 +136,8 @@ SUBROUTINE helium_sample_worm(helium, pint_env) iatom = next_random_number(helium%rng_stream_uniform, 1, helium%atoms) CALL worm_centroid_move(pint_env, helium, & iatom, helium%worm_centroid_drmax, ac) - ncentratt = ncentratt+1 - ncentracc = ncentracc+ac + ncentratt = ncentratt + 1 + ncentracc = ncentracc + ac ELSE IF ((imove >= helium%worm_staging_min) .AND. (imove <= helium%worm_staging_max)) THEN ! staging move iatom = next_random_number(helium%rng_stream_uniform, 1, helium%atoms) @@ -145,16 +145,16 @@ SUBROUTINE helium_sample_worm(helium, pint_env) staging_l = next_random_number(helium%rng_stream_uniform, 2, helium%worm_staging_l) CALL worm_staging_move(pint_env, helium, & iatom, ibead, staging_l, ac) - nstagatt = nstagatt+1 - nstagacc = nstagacc+ac + nstagatt = nstagatt + 1 + nstagacc = nstagacc + ac ELSE IF ((imove >= helium%worm_fcrawl_min) .AND. (imove <= helium%worm_fcrawl_max)) THEN ! crawl forward DO icrawl = 1, helium%worm_repeat_crawl staging_l = next_random_number(helium%rng_stream_uniform, 2, helium%worm_staging_l) CALL worm_crawl_move_forward(pint_env, helium, & staging_l, ac) - ncrawlfwdatt = ncrawlfwdatt+1 - ncrawlfwdacc = ncrawlfwdacc+ac + ncrawlfwdatt = ncrawlfwdatt + 1 + ncrawlfwdacc = ncrawlfwdacc + ac END DO ELSE IF ((imove >= helium%worm_bcrawl_min) .AND. (imove <= helium%worm_bcrawl_max)) THEN ! crawl backward @@ -162,37 +162,37 @@ SUBROUTINE helium_sample_worm(helium, pint_env) staging_l = next_random_number(helium%rng_stream_uniform, 2, helium%worm_staging_l) CALL worm_crawl_move_backward(pint_env, helium, & staging_l, ac) - ncrawlbwdatt = ncrawlbwdatt+1 - ncrawlbwdacc = ncrawlbwdacc+ac + ncrawlbwdatt = ncrawlbwdatt + 1 + ncrawlbwdacc = ncrawlbwdacc + ac END DO ELSE IF ((imove >= helium%worm_head_min) .AND. (imove <= helium%worm_head_max)) THEN ! move head staging_l = next_random_number(helium%rng_stream_uniform, 2, helium%worm_staging_l) CALL worm_head_move(pint_env, helium, & staging_l, ac) - nmoveheadatt = nmoveheadatt+1 - nmoveheadacc = nmoveheadacc+ac + nmoveheadatt = nmoveheadatt + 1 + nmoveheadacc = nmoveheadacc + ac ELSE IF ((imove >= helium%worm_tail_min) .AND. (imove <= helium%worm_tail_max)) THEN ! move tail staging_l = next_random_number(helium%rng_stream_uniform, 2, helium%worm_staging_l) CALL worm_tail_move(pint_env, helium, & staging_l, ac) - nmovetailatt = nmovetailatt+1 - nmovetailacc = nmovetailacc+ac + nmovetailatt = nmovetailatt + 1 + nmovetailacc = nmovetailacc + ac ELSE IF ((imove >= helium%worm_swap_min) .AND. (imove <= helium%worm_swap_max)) THEN staging_l = next_random_number(helium%rng_stream_uniform, 2, helium%worm_staging_l) CALL worm_swap_move(pint_env, helium, & helium%atoms, staging_l, ac) - npswapacc = npswapacc+ac - nswapacc = nswapacc+ac - nswapatt = nswapatt+1 + npswapacc = npswapacc + ac + nswapacc = nswapacc + ac + nswapatt = nswapatt + 1 ELSE IF ((imove >= helium%worm_open_close_min) .AND. (imove <= helium%worm_open_close_max)) THEN ! attempt closing of worm staging_l = next_random_number(helium%rng_stream_uniform, 2, helium%worm_staging_l) CALL worm_close_move(pint_env, helium, & staging_l, ac) - ncloseatt = ncloseatt+1 - ncloseacc = ncloseacc+ac + ncloseatt = ncloseatt + 1 + ncloseacc = ncloseacc + ac ELSE ! this must not occur CPABORT("Undefined move selected in helium worm sampling!") @@ -201,16 +201,16 @@ SUBROUTINE helium_sample_worm(helium, pint_env) ! Accumulate statistics if we are in the Z-sector: IF (helium%worm_is_closed) THEN - nstat = nstat+1 + nstat = nstat + 1 IF (helium%solute_present) THEN IF (helium%get_helium_forces == helium_forces_average) THEN !TODO needs proper averaging! CALL helium_solute_e_f(pint_env, helium, rtmp) - helium%force_avrg(:, :) = helium%force_avrg(:, :)+helium%force_inst(:, :) + helium%force_avrg(:, :) = helium%force_avrg(:, :) + helium%force_inst(:, :) END IF END IF END IF - ntot = ntot+1 + ntot = ntot + 1 END DO ! MC loop IF (helium%worm_is_closed) THEN @@ -228,39 +228,39 @@ SUBROUTINE helium_sample_worm(helium, pint_env) iatom = next_random_number(helium%rng_stream_uniform, 1, helium%atoms) CALL worm_centroid_move(pint_env, helium, & iatom, helium%worm_centroid_drmax, ac) - ncentratt = ncentratt+1 - ncentracc = ncentracc+ac + ncentratt = ncentratt + 1 + ncentracc = ncentracc + ac ELSE IF ((imove >= helium%worm_staging_min) .AND. (imove <= helium%worm_staging_max)) THEN ! staging move iatom = next_random_number(helium%rng_stream_uniform, 1, helium%atoms) ibead = next_random_number(helium%rng_stream_uniform, 1, helium%beads) CALL worm_staging_move(pint_env, helium, & iatom, ibead, helium%worm_staging_l, ac) - nstagatt = nstagatt+1 - nstagacc = nstagacc+ac + nstagatt = nstagatt + 1 + nstagacc = nstagacc + ac ELSE ! this must not occour CPABORT("Undefined move selected in helium worm sampling!") END IF ! Accumulate statistics if we are in closed configurations (which we always are) - nstat = nstat+1 - ntot = ntot+1 + nstat = nstat + 1 + ntot = ntot + 1 IF (helium%solute_present) THEN IF (helium%get_helium_forces == helium_forces_average) THEN ! TODO: needs proper averaging CALL helium_solute_e_f(pint_env, helium, rtmp) - helium%force_avrg(:, :) = helium%force_avrg(:, :)+helium%force_inst(:, :) + helium%force_avrg(:, :) = helium%force_avrg(:, :) + helium%force_inst(:, :) END IF END IF END DO ! MC loop END IF ! Save naccepted and ntot - helium%num_accepted(1, 1) = ncentracc+nstagacc+nopenacc+ncloseacc+nswapacc+ & - nmoveheadacc+nmovetailacc+ncrawlfwdacc+ncrawlbwdacc - helium%num_accepted(2, 1) = ncentratt+nstagatt+nopenatt+ncloseatt+nswapatt+ & - nmoveheadatt+nmovetailatt+ncrawlfwdatt+ncrawlbwdatt + helium%num_accepted(1, 1) = ncentracc + nstagacc + nopenacc + ncloseacc + nswapacc + & + nmoveheadacc + nmovetailacc + ncrawlfwdacc + ncrawlbwdacc + helium%num_accepted(2, 1) = ncentratt + nstagatt + nopenatt + ncloseatt + nswapatt + & + nmoveheadatt + nmovetailatt + ncrawlfwdatt + ncrawlbwdatt helium%worm_nstat = nstat ! Calculate energy and permutation path length @@ -275,7 +275,7 @@ SUBROUTINE helium_sample_worm(helium, pint_env) IF (helium%solute_present) THEN IF (helium%get_helium_forces == helium_forces_last) THEN CALL helium_solute_e_f(pint_env, helium, rtmp) - helium%force_avrg(:, :) = helium%force_avrg(:, :)+helium%force_inst(:, :) + helium%force_avrg(:, :) = helium%force_avrg(:, :) + helium%force_inst(:, :) END IF END IF @@ -322,7 +322,7 @@ SUBROUTINE helium_sample_worm(helium, pint_env) REAL(nswapacc, dp)/REAL(MAX(1, nswapatt), dp), & nswapacc, nswapatt CALL helium_write_line(stmp) - WRITE (stmp, *) "Open State Probability: ", REAL(ntot-nstat, dp)/REAL(MAX(1, ntot), dp), ntot-nstat, ntot + WRITE (stmp, *) "Open State Probability: ", REAL(ntot - nstat, dp)/REAL(MAX(1, ntot), dp), ntot - nstat, ntot CALL helium_write_line(stmp) WRITE (stmp, *) "Closed State Probability: ", REAL(nstat, dp)/REAL(MAX(1, ntot), dp), nstat, ntot CALL helium_write_line(stmp) @@ -357,20 +357,20 @@ SUBROUTINE worm_centroid_move(pint_env, helium, iatom, drmax, ac) DO ic = 1, 3 rtmp = next_random_number(helium%rng_stream_uniform) - dr(ic) = (2.0_dp*rtmp-1.0_dp)*drmax + dr(ic) = (2.0_dp*rtmp - 1.0_dp)*drmax END DO IF (helium%worm_is_closed) THEN worm_in_moved_cycle = .FALSE. ! Perform move for first atom DO ib = 1, helium%beads - helium%work(:, iatom, ib) = helium%work(:, iatom, ib)+dr(:) + helium%work(:, iatom, ib) = helium%work(:, iatom, ib) + dr(:) END DO ! move along permutation cycle jatom = helium%permutation(iatom) DO WHILE (jatom /= iatom) DO ib = 1, helium%beads - helium%work(:, jatom, ib) = helium%work(:, jatom, ib)+dr(:) + helium%work(:, jatom, ib) = helium%work(:, jatom, ib) + dr(:) END DO ! next atom in chain jatom = helium%permutation(jatom) @@ -380,13 +380,13 @@ SUBROUTINE worm_centroid_move(pint_env, helium, iatom, drmax, ac) ! while moving, check if worm is in moved cycle ! Perform move for first atom DO ib = 1, helium%beads - helium%work(:, iatom, ib) = helium%work(:, iatom, ib)+dr(:) + helium%work(:, iatom, ib) = helium%work(:, iatom, ib) + dr(:) END DO ! move along permutation cycle jatom = helium%permutation(iatom) DO WHILE (jatom /= iatom) DO ib = 1, helium%beads - helium%work(:, jatom, ib) = helium%work(:, jatom, ib)+dr(:) + helium%work(:, jatom, ib) = helium%work(:, jatom, ib) + dr(:) END DO worm_in_moved_cycle = worm_in_moved_cycle .OR. (helium%worm_atom_idx == jatom) ! next atom in chain @@ -394,7 +394,7 @@ SUBROUTINE worm_centroid_move(pint_env, helium, iatom, drmax, ac) END DO ! if atom contains had bead move that as well IF (worm_in_moved_cycle) THEN - helium%worm_xtra_bead_work(:) = helium%worm_xtra_bead(:)+dr(:) + helium%worm_xtra_bead_work(:) = helium%worm_xtra_bead(:) + dr(:) END IF END IF @@ -405,14 +405,14 @@ SUBROUTINE worm_centroid_move(pint_env, helium, iatom, drmax, ac) helium%worm_xtra_bead_work, worm_in_moved_cycle) IF (helium%solute_present) THEN - sold = sold+worm_centroid_move_inter_action(pint_env, helium, helium%pos, iatom, & - helium%worm_xtra_bead, worm_in_moved_cycle) - snew = snew+worm_centroid_move_inter_action(pint_env, helium, helium%work, iatom, & - helium%worm_xtra_bead_work, worm_in_moved_cycle) + sold = sold + worm_centroid_move_inter_action(pint_env, helium, helium%pos, iatom, & + helium%worm_xtra_bead, worm_in_moved_cycle) + snew = snew + worm_centroid_move_inter_action(pint_env, helium, helium%work, iatom, & + helium%worm_xtra_bead_work, worm_in_moved_cycle) END IF ! Metropolis: - sdiff = sold-snew + sdiff = sold - snew IF (sdiff < 0) THEN should_reject = .FALSE. IF (sdiff < -100.0_dp) THEN ! To protect from exponential underflow @@ -456,7 +456,7 @@ SUBROUTINE worm_centroid_move(pint_env, helium, iatom, drmax, ac) new_com(:) = 0.0_dp DO ia = 1, helium%atoms DO ib = 1, helium%beads - new_com(:) = new_com(:)+helium%work(:, ia, ib) + new_com(:) = new_com(:) + helium%work(:, ia, ib) END DO END DO new_com(:) = new_com(:)/(REAL(helium%atoms*helium%beads, dp)) @@ -464,7 +464,7 @@ SUBROUTINE worm_centroid_move(pint_env, helium, iatom, drmax, ac) old_com(:) = 0.0_dp DO ia = 1, helium%atoms DO ib = 1, helium%beads - old_com(:) = old_com(:)+helium%pos(:, ia, ib) + old_com(:) = old_com(:) + helium%pos(:, ia, ib) END DO END DO old_com(:) = old_com(:)/(REAL(helium%atoms*helium%beads, dp)) @@ -473,14 +473,14 @@ SUBROUTINE worm_centroid_move(pint_env, helium, iatom, drmax, ac) atom: DO ia = 1, helium%atoms dr(:) = 0.0_dp DO ib = 1, helium%beads - dr(:) = dr(:)+helium%work(:, ia, ib)-new_com(:) + dr(:) = dr(:) + helium%work(:, ia, ib) - new_com(:) END DO dr(:) = dr(:)/REAL(helium%beads, dp) rtmp = DOT_PRODUCT(dr, dr) IF (rtmp >= helium%droplet_radius**2) THEN dro(:) = 0.0_dp DO ib = 1, helium%beads - dro(:) = dro(:)+helium%pos(:, ia, ib)-old_com(:) + dro(:) = dro(:) + helium%pos(:, ia, ib) - old_com(:) END DO dro(:) = dro(:)/REAL(helium%beads, dp) rtmpo = DOT_PRODUCT(dro, dro) @@ -578,14 +578,14 @@ REAL(KIND=dp) FUNCTION worm_centroid_move_action(helium, pos, iatom, xtrapos, wi END DO IF (incycle) CYCLE ! if not in cycle, compute pair action - DO ib = 1, helium%beads-1 - r(:) = pos(:, ia, ib)-pos(:, jatom, ib) - rp(:) = pos(:, ia, ib+1)-pos(:, jatom, ib+1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) - END DO - r(:) = pos(:, ia, helium%beads)-pos(:, jatom, helium%beads) - rp(:) = pos(:, helium%permutation(ia), 1)-pos(:, helium%permutation(jatom), 1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + DO ib = 1, helium%beads - 1 + r(:) = pos(:, ia, ib) - pos(:, jatom, ib) + rp(:) = pos(:, ia, ib + 1) - pos(:, jatom, ib + 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) + END DO + r(:) = pos(:, ia, helium%beads) - pos(:, jatom, helium%beads) + rp(:) = pos(:, helium%permutation(ia), 1) - pos(:, helium%permutation(jatom), 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO ! all other cycle atoms with non-in-cycle atoms jatom = helium%permutation(iatom) @@ -603,14 +603,14 @@ REAL(KIND=dp) FUNCTION worm_centroid_move_action(helium, pos, iatom, xtrapos, wi END DO IF (incycle) CYCLE ! if not in cycle, compute pair action - DO ib = 1, helium%beads-1 - r(:) = pos(:, ia, ib)-pos(:, jatom, ib) - rp(:) = pos(:, ia, ib+1)-pos(:, jatom, ib+1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + DO ib = 1, helium%beads - 1 + r(:) = pos(:, ia, ib) - pos(:, jatom, ib) + rp(:) = pos(:, ia, ib + 1) - pos(:, jatom, ib + 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO - r(:) = pos(:, ia, helium%beads)-pos(:, jatom, helium%beads) - rp(:) = pos(:, helium%permutation(ia), 1)-pos(:, helium%permutation(jatom), 1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = pos(:, ia, helium%beads) - pos(:, jatom, helium%beads) + rp(:) = pos(:, helium%permutation(ia), 1) - pos(:, helium%permutation(jatom), 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO jatom = helium%permutation(jatom) END DO @@ -639,13 +639,13 @@ REAL(KIND=dp) FUNCTION worm_centroid_move_action(helium, pos, iatom, xtrapos, wi opatom = helium%iperm(ia) ! if not in cycle, compute pair action ! substract pair action for closed link - r(:) = pos(:, helium%worm_atom_idx, 1)-pos(:, ia, 1) - rp(:) = pos(:, patom, helium%beads)-pos(:, opatom, helium%beads) - partaction = partaction-helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = pos(:, helium%worm_atom_idx, 1) - pos(:, ia, 1) + rp(:) = pos(:, patom, helium%beads) - pos(:, opatom, helium%beads) + partaction = partaction - helium_eval_expansion(helium, r, rp, helium%uij, 1) ! and add corrected extra link ! rp stays the same - r(:) = xtrapos(:)-pos(:, ia, 1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = xtrapos(:) - pos(:, ia, 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO ELSE ! bead index /= 1 ! atom index is constant @@ -664,13 +664,13 @@ REAL(KIND=dp) FUNCTION worm_centroid_move_action(helium, pos, iatom, xtrapos, wi IF (incycle) CYCLE ! if not in cycle, compute pair action ! substract pair action for closed link - r(:) = pos(:, helium%worm_atom_idx, wbead)-pos(:, ia, wbead) - rp(:) = pos(:, helium%worm_atom_idx, wbead-1)-pos(:, ia, wbead-1) - partaction = partaction-helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = pos(:, helium%worm_atom_idx, wbead) - pos(:, ia, wbead) + rp(:) = pos(:, helium%worm_atom_idx, wbead - 1) - pos(:, ia, wbead - 1) + partaction = partaction - helium_eval_expansion(helium, r, rp, helium%uij, 1) ! and add corrected extra link ! rp stays the same - r(:) = xtrapos(:)-pos(:, ia, wbead) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = xtrapos(:) - pos(:, ia, wbead) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO END IF ELSE ! worm is not the moved cycle @@ -679,48 +679,48 @@ REAL(KIND=dp) FUNCTION worm_centroid_move_action(helium, pos, iatom, xtrapos, wi patom = helium%iperm(helium%worm_atom_idx) opatom = helium%iperm(iatom) !correct action contribution for first atom in moved cycle - r(:) = pos(:, helium%worm_atom_idx, 1)-pos(:, iatom, 1) - rp(:) = pos(:, patom, helium%beads)-pos(:, opatom, helium%beads) - partaction = partaction-helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = pos(:, helium%worm_atom_idx, 1) - pos(:, iatom, 1) + rp(:) = pos(:, patom, helium%beads) - pos(:, opatom, helium%beads) + partaction = partaction - helium_eval_expansion(helium, r, rp, helium%uij, 1) ! and add corrected extra link ! rp stays the same - r(:) = xtrapos(:)-pos(:, iatom, 1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = xtrapos(:) - pos(:, iatom, 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) ! go through all other atoms, not in the exchange cycle, and correct pair action ia = helium%permutation(iatom) DO WHILE (ia /= iatom) opatom = helium%iperm(ia) ! substract pair action for closed link - r(:) = pos(:, helium%worm_atom_idx, 1)-pos(:, ia, 1) - rp(:) = pos(:, patom, helium%beads)-pos(:, opatom, helium%beads) - partaction = partaction-helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = pos(:, helium%worm_atom_idx, 1) - pos(:, ia, 1) + rp(:) = pos(:, patom, helium%beads) - pos(:, opatom, helium%beads) + partaction = partaction - helium_eval_expansion(helium, r, rp, helium%uij, 1) ! and add corrected extra link ! rp stays the same - r(:) = xtrapos(:)-pos(:, ia, 1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = xtrapos(:) - pos(:, ia, 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) ia = helium%permutation(ia) END DO ELSE ! bead index /= 1 ! patom is the atom in front of the lone head bead !correct action contribution for first atom in moved cycle - r(:) = pos(:, helium%worm_atom_idx, wbead)-pos(:, iatom, wbead) - rp(:) = pos(:, helium%worm_atom_idx, wbead-1)-pos(:, iatom, wbead-1) - partaction = partaction-helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = pos(:, helium%worm_atom_idx, wbead) - pos(:, iatom, wbead) + rp(:) = pos(:, helium%worm_atom_idx, wbead - 1) - pos(:, iatom, wbead - 1) + partaction = partaction - helium_eval_expansion(helium, r, rp, helium%uij, 1) ! and add corrected extra link ! rp stays the same - r(:) = xtrapos(:)-pos(:, iatom, wbead) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = xtrapos(:) - pos(:, iatom, wbead) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) ! go through all other atoms, not in the exchange cycle, and correct pair action ia = helium%permutation(iatom) DO WHILE (ia /= iatom) ! substract pair action for closed link - r(:) = pos(:, helium%worm_atom_idx, wbead)-pos(:, ia, wbead) - rp(:) = pos(:, helium%worm_atom_idx, wbead-1)-pos(:, ia, wbead-1) - partaction = partaction-helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = pos(:, helium%worm_atom_idx, wbead) - pos(:, ia, wbead) + rp(:) = pos(:, helium%worm_atom_idx, wbead - 1) - pos(:, ia, wbead - 1) + partaction = partaction - helium_eval_expansion(helium, r, rp, helium%uij, 1) ! and add corrected extra link ! rp stays the same - r(:) = xtrapos(:)-pos(:, ia, wbead) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = xtrapos(:) - pos(:, ia, wbead) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) ia = helium%permutation(ia) END DO END IF @@ -762,64 +762,64 @@ REAL(KIND=dp) FUNCTION worm_centroid_move_inter_action(pint_env, helium, pos, ia ! if it is worm atom it gets special treatment IF (jatom == helium%worm_atom_idx) THEN ! up to worm intersection - DO jbead = 1, helium%worm_bead_idx-1 + DO jbead = 1, helium%worm_bead_idx - 1 CALL helium_bead_solute_e_f(pint_env, helium, & jatom, jbead, pos(:, jatom, jbead), energy=energy) - partaction = partaction+energy + partaction = partaction + energy END DO ! head and tail each with 1/2 weight jbead = helium%worm_bead_idx ! tail CALL helium_bead_solute_e_f(pint_env, helium, & jatom, jbead, pos(:, jatom, jbead), energy=energy) - partaction = partaction+0.5_dp*energy + partaction = partaction + 0.5_dp*energy ! head CALL helium_bead_solute_e_f(pint_env, helium, & jatom, jbead, xtrapos, energy=energy) - partaction = partaction+0.5_dp*energy + partaction = partaction + 0.5_dp*energy ! rest of ring polymer - DO jbead = helium%worm_bead_idx+1, helium%beads + DO jbead = helium%worm_bead_idx + 1, helium%beads CALL helium_bead_solute_e_f(pint_env, helium, & jatom, jbead, pos(:, jatom, jbead), energy=energy) - partaction = partaction+energy + partaction = partaction + energy END DO ELSE DO jbead = 1, helium%beads CALL helium_bead_solute_e_f(pint_env, helium, & jatom, jbead, pos(:, jatom, jbead), energy=energy) - partaction = partaction+energy + partaction = partaction + energy END DO END IF jatom = helium%permutation(iatom) DO WHILE (jatom /= iatom) IF (jatom == helium%worm_atom_idx) THEN ! up to worm intersection - DO jbead = 1, helium%worm_bead_idx-1 + DO jbead = 1, helium%worm_bead_idx - 1 CALL helium_bead_solute_e_f(pint_env, helium, & jatom, jbead, pos(:, jatom, jbead), energy=energy) - partaction = partaction+energy + partaction = partaction + energy END DO ! head and tail each with 1/2 weight jbead = helium%worm_bead_idx ! tail CALL helium_bead_solute_e_f(pint_env, helium, & jatom, jbead, pos(:, jatom, jbead), energy=energy) - partaction = partaction+0.5_dp*energy + partaction = partaction + 0.5_dp*energy ! head CALL helium_bead_solute_e_f(pint_env, helium, & jatom, jbead, xtrapos, energy=energy) - partaction = partaction+0.5_dp*energy + partaction = partaction + 0.5_dp*energy ! rest of ring polymer - DO jbead = helium%worm_bead_idx+1, helium%beads + DO jbead = helium%worm_bead_idx + 1, helium%beads CALL helium_bead_solute_e_f(pint_env, helium, & jatom, jbead, pos(:, jatom, jbead), energy=energy) - partaction = partaction+energy + partaction = partaction + energy END DO ELSE DO jbead = 1, helium%beads CALL helium_bead_solute_e_f(pint_env, helium, & jatom, jbead, pos(:, jatom, jbead), energy=energy) - partaction = partaction+energy + partaction = partaction + energy END DO END IF jatom = helium%permutation(jatom) @@ -831,14 +831,14 @@ REAL(KIND=dp) FUNCTION worm_centroid_move_inter_action(pint_env, helium, pos, ia DO jbead = 1, helium%beads CALL helium_bead_solute_e_f(pint_env, helium, & jatom, jbead, pos(:, jatom, jbead), energy=energy) - partaction = partaction+energy + partaction = partaction + energy END DO jatom = helium%permutation(iatom) DO WHILE (jatom /= iatom) DO jbead = 1, helium%beads CALL helium_bead_solute_e_f(pint_env, helium, & jatom, jbead, pos(:, jatom, jbead), energy=energy) - partaction = partaction+energy + partaction = partaction + energy END DO jatom = helium%permutation(jatom) END DO @@ -874,14 +874,14 @@ SUBROUTINE path_construct(helium, ri, rj, l, new_path) imass = 1.0_dp/(he_mass*massunit) ! dealing with periodicity rs(:) = ri(:) - re(:) = rj(:)-rs(:) + re(:) = rj(:) - rs(:) CALL helium_pbc(helium, re) - re(:) = re(:)+rs(:) + re(:) = re(:) + rs(:) ! first construction by hand ! reusable weight factor 1/(l+1) rk = REAL(l, dp) - weight = 1.0_dp/(rk+1.0_dp) + weight = 1.0_dp/(rk + 1.0_dp) ! staging mass needed for modified variance invstagemass = rk*weight*imass ! proposing new positions @@ -889,12 +889,12 @@ SUBROUTINE path_construct(helium, ri, rj, l, new_path) new_path(idim, 1) = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%tau*invstagemass) END DO - new_path(:, 1) = new_path(:, 1)+weight*(re(:)+rk*rs(:)) + new_path(:, 1) = new_path(:, 1) + weight*(re(:) + rk*rs(:)) DO istage = 2, l ! reusable weight factor 1/(k+1) - rk = REAL(l-istage+1, dp) - weight = 1.0_dp/(rk+1.0_dp) + rk = REAL(l - istage + 1, dp) + weight = 1.0_dp/(rk + 1.0_dp) ! staging mass needed for modified variance invstagemass = rk*weight*imass ! proposing new positions @@ -902,7 +902,7 @@ SUBROUTINE path_construct(helium, ri, rj, l, new_path) new_path(idim, istage) = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%tau*invstagemass) END DO - new_path(:, istage) = new_path(:, istage)+weight*(rk*new_path(:, istage-1)+re(:)) + new_path(:, istage) = new_path(:, istage) + weight*(rk*new_path(:, istage - 1) + re(:)) END DO RETURN @@ -933,11 +933,11 @@ SUBROUTINE worm_staging_move(pint_env, helium, startatom, startbead, l, ac) REAL(KIND=dp), DIMENSION(3, l) :: newsection ac = 0 - endbead = startbead+l+1 + endbead = startbead + l + 1 ! Check if the imaginary time section belongs to two atoms IF (endbead > helium%beads) THEN endatom = helium%permutation(startatom) - endbead = endbead-helium%beads + endbead = endbead - helium%beads ELSE endatom = startatom END IF @@ -976,8 +976,8 @@ SUBROUTINE worm_staging_move(pint_env, helium, startatom, startbead, l, ac) IF (helium%solute_present) THEN ! no special head treatment needed, because a swap can't go over ! the worm gap and due to primitive coupling no cross bead terms are considered - sold = sold+worm_path_inter_action(pint_env, helium, helium%pos, & - startatom, startbead, endatom, endbead) + sold = sold + worm_path_inter_action(pint_env, helium, helium%pos, & + startatom, startbead, endatom, endbead) END IF ! construct a new path connecting the start and endbead @@ -989,15 +989,15 @@ SUBROUTINE worm_staging_move(pint_env, helium, startatom, startbead, l, ac) ! write new path segment to work array ! first the part that is guaranteed to fit on the coorinates of startatom jbead = 1 - DO ibead = startbead+1, MIN(helium%beads, startbead+l) + DO ibead = startbead + 1, MIN(helium%beads, startbead + l) helium%work(:, startatom, ibead) = newsection(:, jbead) - jbead = jbead+1 + jbead = jbead + 1 END DO ! transfer the rest of the beads to coordinates of endatom if neccessary - IF (helium%beads < startbead+l) THEN - DO ibead = 1, endbead-1 + IF (helium%beads < startbead + l) THEN + DO ibead = 1, endbead - 1 helium%work(:, endatom, ibead) = newsection(:, jbead) - jbead = jbead+1 + jbead = jbead + 1 END DO END IF @@ -1014,12 +1014,12 @@ SUBROUTINE worm_staging_move(pint_env, helium, startatom, startbead, l, ac) IF (helium%solute_present) THEN ! no special head treatment needed, because a swap can't go over ! the worm gap and due to primitive coupling no cross bead terms are considered - snew = snew+worm_path_inter_action(pint_env, helium, helium%work, & - startatom, startbead, endatom, endbead) + snew = snew + worm_path_inter_action(pint_env, helium, helium%work, & + startatom, startbead, endatom, endbead) END IF ! Metropolis: - sdiff = sold-snew + sdiff = sold - snew IF (sdiff < 0) THEN should_reject = .FALSE. IF (sdiff < -100.0_dp) THEN ! To protect from exponential underflow @@ -1034,15 +1034,15 @@ SUBROUTINE worm_staging_move(pint_env, helium, startatom, startbead, l, ac) ! rejected ! ! write back only changed atoms jbead = 1 - DO ibead = startbead+1, MIN(helium%beads, startbead+l) + DO ibead = startbead + 1, MIN(helium%beads, startbead + l) helium%work(:, startatom, ibead) = helium%pos(:, startatom, ibead) - jbead = jbead+1 + jbead = jbead + 1 END DO ! transfer the rest of the beads to coordinates of endatom if neccessary - IF (helium%beads < startbead+l) THEN - DO ibead = 1, endbead-1 + IF (helium%beads < startbead + l) THEN + DO ibead = 1, endbead - 1 helium%work(:, endatom, ibead) = helium%pos(:, endatom, ibead) - jbead = jbead+1 + jbead = jbead + 1 END DO END IF ac = 0 @@ -1062,7 +1062,7 @@ SUBROUTINE worm_staging_move(pint_env, helium, startatom, startbead, l, ac) new_com(:) = 0.0_dp DO ia = 1, helium%atoms DO ib = 1, helium%beads - new_com(:) = new_com(:)+helium%work(:, ia, ib) + new_com(:) = new_com(:) + helium%work(:, ia, ib) END DO END DO new_com(:) = new_com(:)/(REAL(helium%atoms*helium%beads, dp)) @@ -1070,7 +1070,7 @@ SUBROUTINE worm_staging_move(pint_env, helium, startatom, startbead, l, ac) old_com(:) = 0.0_dp DO ia = 1, helium%atoms DO ib = 1, helium%beads - old_com(:) = old_com(:)+helium%pos(:, ia, ib) + old_com(:) = old_com(:) + helium%pos(:, ia, ib) END DO END DO old_com(:) = old_com(:)/(REAL(helium%atoms*helium%beads, dp)) @@ -1079,14 +1079,14 @@ SUBROUTINE worm_staging_move(pint_env, helium, startatom, startbead, l, ac) atom: DO ia = 1, helium%atoms dr(:) = 0.0_dp DO ib = 1, helium%beads - dr(:) = dr(:)+helium%work(:, ia, ib)-new_com(:) + dr(:) = dr(:) + helium%work(:, ia, ib) - new_com(:) END DO dr(:) = dr(:)/REAL(helium%beads, dp) rtmp = DOT_PRODUCT(dr, dr) IF (rtmp >= helium%droplet_radius**2) THEN dro(:) = 0.0_dp DO ib = 1, helium%beads - dro(:) = dro(:)+helium%pos(:, ia, ib)-old_com(:) + dro(:) = dro(:) + helium%pos(:, ia, ib) - old_com(:) END DO dro(:) = dro(:)/REAL(helium%beads, dp) rtmpo = DOT_PRODUCT(dro, dro) @@ -1102,15 +1102,15 @@ SUBROUTINE worm_staging_move(pint_env, helium, startatom, startbead, l, ac) ! restore original coordinates ! write back only changed atoms jbead = 1 - DO ibead = startbead+1, MIN(helium%beads, startbead+l) + DO ibead = startbead + 1, MIN(helium%beads, startbead + l) helium%work(:, startatom, ibead) = helium%pos(:, startatom, ibead) - jbead = jbead+1 + jbead = jbead + 1 END DO ! transfer the rest of the beads to coordinates of endatom if neccessary - IF (helium%beads < startbead+l) THEN - DO ibead = 1, endbead-1 + IF (helium%beads < startbead + l) THEN + DO ibead = 1, endbead - 1 helium%work(:, endatom, ibead) = helium%pos(:, endatom, ibead) - jbead = jbead+1 + jbead = jbead + 1 END DO END IF ac = 0 @@ -1122,15 +1122,15 @@ SUBROUTINE worm_staging_move(pint_env, helium, startatom, startbead, l, ac) ac = 1 ! write changed coordinates to position array jbead = 1 - DO ibead = startbead+1, MIN(helium%beads, startbead+l) + DO ibead = startbead + 1, MIN(helium%beads, startbead + l) helium%pos(:, startatom, ibead) = helium%work(:, startatom, ibead) - jbead = jbead+1 + jbead = jbead + 1 END DO ! transfer the rest of the beads to coordinates of endatom if neccessary - IF (helium%beads < startbead+l) THEN - DO ibead = 1, endbead-1 + IF (helium%beads < startbead + l) THEN + DO ibead = 1, endbead - 1 helium%pos(:, endatom, ibead) = helium%work(:, endatom, ibead) - jbead = jbead+1 + jbead = jbead + 1 END DO END IF @@ -1167,12 +1167,12 @@ SUBROUTINE worm_open_move(pint_env, helium, endatom, endbead, l, ac) IF (l < endbead) THEN ! startbead belongs to the same atom startatom = endatom - startbead = endbead-l + startbead = endbead - l ELSE ! startbead belongs to a different atom ! find previous atom (assuming l < nbeads) startatom = helium%iperm(endatom) - startbead = endbead+helium%beads-l + startbead = endbead + helium%beads - l END IF sold = worm_path_action(helium, helium%pos, & startatom, startbead, endatom, endbead) @@ -1181,9 +1181,9 @@ SUBROUTINE worm_open_move(pint_env, helium, endatom, endbead, l, ac) ! yes this is correct, as the bead, that splits into tail and head only changes half ! therefore only half of its action needs to be considred ! and is cheated in here by passing it as head bead - sold = sold+worm_path_inter_action_head(pint_env, helium, helium%pos, & - startatom, startbead, & - helium%pos(:, endatom, endbead), endatom, endbead) + sold = sold + worm_path_inter_action_head(pint_env, helium, helium%pos, & + startatom, startbead, & + helium%pos(:, endatom, endbead), endatom, endbead) END IF helium%worm_is_closed = .FALSE. @@ -1194,63 +1194,63 @@ SUBROUTINE worm_open_move(pint_env, helium, endatom, endbead, l, ac) IF (startbead < endbead) THEN ! everything belongs to the same atom ! gro head from startbead - DO kbead = startbead+1, endbead-1 + DO kbead = startbead + 1, endbead - 1 DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%work(idim, startatom, kbead) = helium%work(idim, startatom, kbead-1)+xr + helium%work(idim, startatom, kbead) = helium%work(idim, startatom, kbead - 1) + xr END DO END DO ! last grow head bead DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%worm_xtra_bead_work(idim) = helium%work(idim, startatom, endbead-1)+xr + helium%worm_xtra_bead_work(idim) = helium%work(idim, startatom, endbead - 1) + xr END DO ELSE IF (endbead /= 1) THEN ! is distributed among two atoms ! grow from startbead - DO kbead = startbead+1, helium%beads + DO kbead = startbead + 1, helium%beads DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%work(idim, startatom, kbead) = helium%work(idim, startatom, kbead-1)+xr + helium%work(idim, startatom, kbead) = helium%work(idim, startatom, kbead - 1) + xr END DO END DO ! bead one of endatom relative to last on startatom DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%work(idim, endatom, 1) = helium%work(idim, startatom, helium%beads)+xr + helium%work(idim, endatom, 1) = helium%work(idim, startatom, helium%beads) + xr END DO ! everything on endatom - DO kbead = 2, endbead-1 + DO kbead = 2, endbead - 1 DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%work(idim, endatom, kbead) = helium%work(idim, endatom, kbead-1)+xr + helium%work(idim, endatom, kbead) = helium%work(idim, endatom, kbead - 1) + xr END DO END DO DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%worm_xtra_bead_work(idim) = helium%work(idim, endatom, endbead-1)+xr + helium%worm_xtra_bead_work(idim) = helium%work(idim, endatom, endbead - 1) + xr END DO ELSE ! imagtimewrap and headbead = 1 ! is distributed among two atoms ! grow from startbead - DO kbead = startbead+1, helium%beads + DO kbead = startbead + 1, helium%beads DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%work(idim, startatom, kbead) = helium%work(idim, startatom, kbead-1)+xr + helium%work(idim, startatom, kbead) = helium%work(idim, startatom, kbead - 1) + xr END DO END DO ! bead one of endatom relative to last on startatom DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%worm_xtra_bead_work(idim) = helium%work(idim, startatom, helium%beads)+xr + helium%worm_xtra_bead_work(idim) = helium%work(idim, startatom, helium%beads) + xr END DO END IF @@ -1259,22 +1259,22 @@ SUBROUTINE worm_open_move(pint_env, helium, endatom, endbead, l, ac) helium%worm_xtra_bead_work, helium%worm_atom_idx_work, helium%worm_bead_idx_work) IF (helium%solute_present) THEN - snew = snew+worm_path_inter_action_head(pint_env, helium, helium%work, & - startatom, startbead, & - helium%worm_xtra_bead_work, helium%worm_atom_idx_work, helium%worm_bead_idx_work) + snew = snew + worm_path_inter_action_head(pint_env, helium, helium%work, & + startatom, startbead, & + helium%worm_xtra_bead_work, helium%worm_atom_idx_work, helium%worm_bead_idx_work) END IF ! Metropolis: ! first compute ln of free density matrix - distvec(:) = helium%pos(:, startatom, startbead)-helium%pos(:, endatom, endbead) + distvec(:) = helium%pos(:, startatom, startbead) - helium%pos(:, endatom, endbead) CALL helium_pbc(helium, distvec) distsq = DOT_PRODUCT(distvec, distvec) ! action difference - sdiff = sold-snew + sdiff = sold - snew ! modify action difference due to extra bead - sdiff = sdiff+distsq/(2.0_dp*helium%hb2m*REAL(l, dp)*helium%tau) - sdiff = sdiff+1.5_dp*LOG(REAL(l, dp)*helium%tau) - sdiff = sdiff+helium%worm_ln_openclose_scale + sdiff = sdiff + distsq/(2.0_dp*helium%hb2m*REAL(l, dp)*helium%tau) + sdiff = sdiff + 1.5_dp*LOG(REAL(l, dp)*helium%tau) + sdiff = sdiff + helium%worm_ln_openclose_scale IF (sdiff < 0) THEN should_reject = .FALSE. IF (sdiff < -100.0_dp) THEN ! To protect from exponential underflow @@ -1291,17 +1291,17 @@ SUBROUTINE worm_open_move(pint_env, helium, endatom, endbead, l, ac) ! transfer the new coordinates to work array IF (startbead < endbead) THEN ! everything belongs to the same atom - DO kbead = startbead+1, endbead-1 + DO kbead = startbead + 1, endbead - 1 helium%work(:, endatom, kbead) = helium%pos(:, endatom, kbead) END DO ELSE ! is distributed among two atoms ! transfer to atom not containing the head bead - DO kbead = startbead+1, helium%beads + DO kbead = startbead + 1, helium%beads helium%work(:, startatom, kbead) = helium%pos(:, startatom, kbead) END DO ! transfer to atom containing the head bead - DO kbead = 1, endbead-1 + DO kbead = 1, endbead - 1 helium%work(:, endatom, kbead) = helium%pos(:, endatom, kbead) END DO END IF @@ -1323,7 +1323,7 @@ SUBROUTINE worm_open_move(pint_env, helium, endatom, endbead, l, ac) new_com(:) = 0.0_dp DO ia = 1, helium%atoms DO ib = 1, helium%beads - new_com(:) = new_com(:)+helium%work(:, ia, ib) + new_com(:) = new_com(:) + helium%work(:, ia, ib) END DO END DO new_com(:) = new_com(:)/(REAL(helium%atoms*helium%beads, dp)) @@ -1331,7 +1331,7 @@ SUBROUTINE worm_open_move(pint_env, helium, endatom, endbead, l, ac) old_com(:) = 0.0_dp DO ia = 1, helium%atoms DO ib = 1, helium%beads - old_com(:) = old_com(:)+helium%pos(:, ia, ib) + old_com(:) = old_com(:) + helium%pos(:, ia, ib) END DO END DO old_com(:) = old_com(:)/(REAL(helium%atoms*helium%beads, dp)) @@ -1340,14 +1340,14 @@ SUBROUTINE worm_open_move(pint_env, helium, endatom, endbead, l, ac) atom: DO ia = 1, helium%atoms dr(:) = 0.0_dp DO ib = 1, helium%beads - dr(:) = dr(:)+helium%work(:, ia, ib)-new_com(:) + dr(:) = dr(:) + helium%work(:, ia, ib) - new_com(:) END DO dr(:) = dr(:)/REAL(helium%beads, dp) rtmp = DOT_PRODUCT(dr, dr) IF (rtmp >= helium%droplet_radius**2) THEN dro(:) = 0.0_dp DO ib = 1, helium%beads - dro(:) = dro(:)+helium%pos(:, ia, ib)-old_com(:) + dro(:) = dro(:) + helium%pos(:, ia, ib) - old_com(:) END DO dro(:) = dro(:)/REAL(helium%beads, dp) rtmpo = DOT_PRODUCT(dro, dro) @@ -1364,17 +1364,17 @@ SUBROUTINE worm_open_move(pint_env, helium, endatom, endbead, l, ac) ! write back only changed atoms IF (startbead < endbead) THEN ! everything belongs to the same atom - DO kbead = startbead+1, endbead-1 + DO kbead = startbead + 1, endbead - 1 helium%work(:, endatom, kbead) = helium%pos(:, endatom, kbead) END DO ELSE ! is distributed among two atoms ! transfer to atom not containing the head bead - DO kbead = startbead+1, helium%beads + DO kbead = startbead + 1, helium%beads helium%work(:, startatom, kbead) = helium%pos(:, startatom, kbead) END DO ! transfer to atom containing the head bead - DO kbead = 1, endbead-1 + DO kbead = 1, endbead - 1 helium%work(:, endatom, kbead) = helium%pos(:, endatom, kbead) END DO END IF @@ -1391,17 +1391,17 @@ SUBROUTINE worm_open_move(pint_env, helium, endatom, endbead, l, ac) ! write changed coordinates to position array IF (startbead < endbead) THEN ! everything belongs to the same atom - DO kbead = startbead+1, endbead-1 + DO kbead = startbead + 1, endbead - 1 helium%pos(:, endatom, kbead) = helium%work(:, endatom, kbead) END DO ELSE ! is distributed among two atoms ! transfer to atom not containing the head bead - DO kbead = startbead+1, helium%beads + DO kbead = startbead + 1, helium%beads helium%pos(:, startatom, kbead) = helium%work(:, startatom, kbead) END DO ! transfer to atom containing the head bead - DO kbead = 1, endbead-1 + DO kbead = 1, endbead - 1 helium%pos(:, endatom, kbead) = helium%work(:, endatom, kbead) END DO END IF @@ -1444,49 +1444,49 @@ SUBROUTINE worm_close_move(pint_env, helium, l, ac) IF (l < endbead) THEN ! startbead belongs to the same atom startatom = endatom - startbead = endbead-l + startbead = endbead - l ELSE ! startbead belongs to a different atom ! find previous atom (assuming l < nbeads) startatom = helium%iperm(endatom) - startbead = endbead+helium%beads-l + startbead = endbead + helium%beads - l END IF sold = worm_path_action_worm_corrected(helium, helium%pos, & startatom, startbead, endatom, endbead, & helium%worm_xtra_bead, helium%worm_atom_idx, helium%worm_bead_idx) IF (helium%solute_present) THEN - sold = sold+worm_path_inter_action_head(pint_env, helium, helium%pos, & - startatom, startbead, & - helium%worm_xtra_bead, helium%worm_atom_idx, helium%worm_bead_idx) + sold = sold + worm_path_inter_action_head(pint_env, helium, helium%pos, & + startatom, startbead, & + helium%worm_xtra_bead, helium%worm_atom_idx, helium%worm_bead_idx) END IF ! close between head and tail ! only l-1 beads need to be reconstructed CALL path_construct(helium, & helium%pos(:, startatom, startbead), & - helium%pos(:, endatom, endbead), l-1, & + helium%pos(:, endatom, endbead), l - 1, & newsection) ! transfer the new coordinates to work array jbead = 1 IF (startbead < endbead) THEN ! everything belongs to the same atom - DO kbead = startbead+1, endbead-1 + DO kbead = startbead + 1, endbead - 1 helium%work(:, endatom, kbead) = newsection(:, jbead) - jbead = jbead+1 + jbead = jbead + 1 END DO ELSE ! is distributed among two atoms ! transfer to atom not containing the head bead - DO kbead = startbead+1, helium%beads + DO kbead = startbead + 1, helium%beads helium%work(:, startatom, kbead) = newsection(:, jbead) - jbead = jbead+1 + jbead = jbead + 1 END DO ! transfer to atom containing the head bead - DO kbead = 1, endbead-1 + DO kbead = 1, endbead - 1 helium%work(:, endatom, kbead) = newsection(:, jbead) - jbead = jbead+1 + jbead = jbead + 1 END DO END IF @@ -1499,22 +1499,22 @@ SUBROUTINE worm_close_move(pint_env, helium, l, ac) ! yes this is correct, as the bead, that was split into tail and head only changes half ! therefore only half of its action needs to be considred ! and is cheated in here by passing it as head bead - snew = snew+worm_path_inter_action_head(pint_env, helium, helium%work, & - startatom, startbead, & - helium%work(:, endatom, endbead), endatom, endbead) + snew = snew + worm_path_inter_action_head(pint_env, helium, helium%work, & + startatom, startbead, & + helium%work(:, endatom, endbead), endatom, endbead) END IF ! Metropolis: ! first compute ln of free density matrix - distvec(:) = helium%pos(:, startatom, startbead)-helium%pos(:, endatom, endbead) + distvec(:) = helium%pos(:, startatom, startbead) - helium%pos(:, endatom, endbead) CALL helium_pbc(helium, distvec) distsq = DOT_PRODUCT(distvec, distvec) ! action difference - sdiff = sold-snew + sdiff = sold - snew ! modify action difference due to extra bead - sdiff = sdiff-distsq/(2.0_dp*helium%hb2m*REAL(l, dp)*helium%tau) - sdiff = sdiff-1.5_dp*LOG(REAL(l, dp)*helium%tau) - sdiff = sdiff-helium%worm_ln_openclose_scale + sdiff = sdiff - distsq/(2.0_dp*helium%hb2m*REAL(l, dp)*helium%tau) + sdiff = sdiff - 1.5_dp*LOG(REAL(l, dp)*helium%tau) + sdiff = sdiff - helium%worm_ln_openclose_scale IF (sdiff < 0) THEN should_reject = .FALSE. IF (sdiff < -100.0_dp) THEN ! To protect from exponential underflow @@ -1531,17 +1531,17 @@ SUBROUTINE worm_close_move(pint_env, helium, l, ac) ! transfer the new coordinates to work array IF (startbead < endbead) THEN ! everything belongs to the same atom - DO kbead = startbead+1, endbead-1 + DO kbead = startbead + 1, endbead - 1 helium%work(:, endatom, kbead) = helium%pos(:, endatom, kbead) END DO ELSE ! is distributed among two atoms ! transfer to atom not containing the head bead - DO kbead = startbead+1, helium%beads + DO kbead = startbead + 1, helium%beads helium%work(:, startatom, kbead) = helium%pos(:, startatom, kbead) END DO ! transfer to atom containing the head bead - DO kbead = 1, endbead-1 + DO kbead = 1, endbead - 1 helium%work(:, endatom, kbead) = helium%pos(:, endatom, kbead) END DO END IF @@ -1563,7 +1563,7 @@ SUBROUTINE worm_close_move(pint_env, helium, l, ac) new_com(:) = 0.0_dp DO ia = 1, helium%atoms DO ib = 1, helium%beads - new_com(:) = new_com(:)+helium%work(:, ia, ib) + new_com(:) = new_com(:) + helium%work(:, ia, ib) END DO END DO new_com(:) = new_com(:)/(REAL(helium%atoms*helium%beads, dp)) @@ -1571,7 +1571,7 @@ SUBROUTINE worm_close_move(pint_env, helium, l, ac) old_com(:) = 0.0_dp DO ia = 1, helium%atoms DO ib = 1, helium%beads - old_com(:) = old_com(:)+helium%pos(:, ia, ib) + old_com(:) = old_com(:) + helium%pos(:, ia, ib) END DO END DO old_com(:) = old_com(:)/(REAL(helium%atoms*helium%beads, dp)) @@ -1580,14 +1580,14 @@ SUBROUTINE worm_close_move(pint_env, helium, l, ac) atom: DO ia = 1, helium%atoms dr(:) = 0.0_dp DO ib = 1, helium%beads - dr(:) = dr(:)+helium%work(:, ia, ib)-new_com(:) + dr(:) = dr(:) + helium%work(:, ia, ib) - new_com(:) END DO dr(:) = dr(:)/REAL(helium%beads, dp) rtmp = DOT_PRODUCT(dr, dr) IF (rtmp >= helium%droplet_radius**2) THEN dro(:) = 0.0_dp DO ib = 1, helium%beads - dro(:) = dro(:)+helium%pos(:, ia, ib)-old_com(:) + dro(:) = dro(:) + helium%pos(:, ia, ib) - old_com(:) END DO dro(:) = dro(:)/REAL(helium%beads, dp) rtmpo = DOT_PRODUCT(dro, dro) @@ -1604,17 +1604,17 @@ SUBROUTINE worm_close_move(pint_env, helium, l, ac) ! write back only changed atoms IF (startbead < endbead) THEN ! everything belongs to the same atom - DO kbead = startbead+1, endbead-1 + DO kbead = startbead + 1, endbead - 1 helium%work(:, endatom, kbead) = helium%pos(:, endatom, kbead) END DO ELSE ! is distributed among two atoms ! transfer to atom not containing the head bead - DO kbead = startbead+1, helium%beads + DO kbead = startbead + 1, helium%beads helium%work(:, startatom, kbead) = helium%pos(:, startatom, kbead) END DO ! transfer to atom containing the head bead - DO kbead = 1, endbead-1 + DO kbead = 1, endbead - 1 helium%work(:, endatom, kbead) = helium%pos(:, endatom, kbead) END DO END IF @@ -1629,17 +1629,17 @@ SUBROUTINE worm_close_move(pint_env, helium, l, ac) ! write changed coordinates to position array IF (startbead < endbead) THEN ! everything belongs to the same atom - DO kbead = startbead+1, endbead-1 + DO kbead = startbead + 1, endbead - 1 helium%pos(:, endatom, kbead) = helium%work(:, endatom, kbead) END DO ELSE ! is distributed among two atoms ! transfer to atom not containing the head bead - DO kbead = startbead+1, helium%beads + DO kbead = startbead + 1, helium%beads helium%pos(:, startatom, kbead) = helium%work(:, startatom, kbead) END DO ! transfer to atom containing the head bead - DO kbead = 1, endbead-1 + DO kbead = 1, endbead - 1 helium%pos(:, endatom, kbead) = helium%work(:, endatom, kbead) END DO END IF @@ -1677,12 +1677,12 @@ SUBROUTINE worm_head_move(pint_env, helium, l, ac) IF (l < endbead) THEN ! startbead belongs to the same atom startatom = endatom - startbead = endbead-l + startbead = endbead - l ELSE ! startbead belongs to a different atom ! find previous atom (assuming l < nbeads) startatom = helium%iperm(endatom) - startbead = endbead+helium%beads-l + startbead = endbead + helium%beads - l END IF sold = worm_path_action_worm_corrected(helium, helium%pos, & @@ -1690,72 +1690,72 @@ SUBROUTINE worm_head_move(pint_env, helium, l, ac) helium%worm_xtra_bead, helium%worm_atom_idx, helium%worm_bead_idx) IF (helium%solute_present) THEN - sold = sold+worm_path_inter_action_head(pint_env, helium, helium%pos, & - startatom, startbead, & - helium%worm_xtra_bead, helium%worm_atom_idx, helium%worm_bead_idx) + sold = sold + worm_path_inter_action_head(pint_env, helium, helium%pos, & + startatom, startbead, & + helium%worm_xtra_bead, helium%worm_atom_idx, helium%worm_bead_idx) END IF ! alternative grow with consecutive gaussians IF (startbead < endbead) THEN ! everything belongs to the same atom ! gro head from startbead - DO kbead = startbead+1, endbead-1 + DO kbead = startbead + 1, endbead - 1 DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%work(idim, startatom, kbead) = helium%work(idim, startatom, kbead-1)+xr + helium%work(idim, startatom, kbead) = helium%work(idim, startatom, kbead - 1) + xr END DO END DO ! last grow head bead DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%worm_xtra_bead_work(idim) = helium%work(idim, startatom, endbead-1)+xr + helium%worm_xtra_bead_work(idim) = helium%work(idim, startatom, endbead - 1) + xr END DO ELSE IF (endbead /= 1) THEN ! is distributed among two atoms ! grow from startbead - DO kbead = startbead+1, helium%beads + DO kbead = startbead + 1, helium%beads DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%work(idim, startatom, kbead) = helium%work(idim, startatom, kbead-1)+xr + helium%work(idim, startatom, kbead) = helium%work(idim, startatom, kbead - 1) + xr END DO END DO ! bead one of endatom relative to last on startatom DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%work(idim, endatom, 1) = helium%work(idim, startatom, helium%beads)+xr + helium%work(idim, endatom, 1) = helium%work(idim, startatom, helium%beads) + xr END DO ! everything on endatom - DO kbead = 2, endbead-1 + DO kbead = 2, endbead - 1 DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%work(idim, endatom, kbead) = helium%work(idim, endatom, kbead-1)+xr + helium%work(idim, endatom, kbead) = helium%work(idim, endatom, kbead - 1) + xr END DO END DO DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%worm_xtra_bead_work(idim) = helium%work(idim, endatom, endbead-1)+xr + helium%worm_xtra_bead_work(idim) = helium%work(idim, endatom, endbead - 1) + xr END DO ELSE ! imagtimewrap and headbead = 1 ! is distributed among two atoms ! grow from startbead - DO kbead = startbead+1, helium%beads + DO kbead = startbead + 1, helium%beads DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%work(idim, startatom, kbead) = helium%work(idim, startatom, kbead-1)+xr + helium%work(idim, startatom, kbead) = helium%work(idim, startatom, kbead - 1) + xr END DO END DO ! bead one of endatom relative to last on startatom DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%worm_xtra_bead_work(idim) = helium%work(idim, startatom, helium%beads)+xr + helium%worm_xtra_bead_work(idim) = helium%work(idim, startatom, helium%beads) + xr END DO END IF @@ -1764,14 +1764,14 @@ SUBROUTINE worm_head_move(pint_env, helium, l, ac) helium%worm_xtra_bead_work, helium%worm_atom_idx_work, helium%worm_bead_idx_work) IF (helium%solute_present) THEN - snew = snew+worm_path_inter_action_head(pint_env, helium, helium%work, & - startatom, startbead, & - helium%worm_xtra_bead_work, helium%worm_atom_idx_work, helium%worm_bead_idx_work) + snew = snew + worm_path_inter_action_head(pint_env, helium, helium%work, & + startatom, startbead, & + helium%worm_xtra_bead_work, helium%worm_atom_idx_work, helium%worm_bead_idx_work) END IF ! Metropolis: ! action difference - sdiff = sold-snew + sdiff = sold - snew ! modify action difference due to extra bead IF (sdiff < 0) THEN should_reject = .FALSE. @@ -1789,17 +1789,17 @@ SUBROUTINE worm_head_move(pint_env, helium, l, ac) ! transfer the new coordinates to work array IF (startbead < endbead) THEN ! everything belongs to the same atom - DO kbead = startbead+1, endbead-1 + DO kbead = startbead + 1, endbead - 1 helium%work(:, endatom, kbead) = helium%pos(:, endatom, kbead) END DO ELSE ! is distributed among two atoms ! transfer to atom not containing the head bead - DO kbead = startbead+1, helium%beads + DO kbead = startbead + 1, helium%beads helium%work(:, startatom, kbead) = helium%pos(:, startatom, kbead) END DO ! transfer to atom containing the head bead - DO kbead = 1, endbead-1 + DO kbead = 1, endbead - 1 helium%work(:, endatom, kbead) = helium%pos(:, endatom, kbead) END DO END IF @@ -1821,7 +1821,7 @@ SUBROUTINE worm_head_move(pint_env, helium, l, ac) new_com(:) = 0.0_dp DO ia = 1, helium%atoms DO ib = 1, helium%beads - new_com(:) = new_com(:)+helium%work(:, ia, ib) + new_com(:) = new_com(:) + helium%work(:, ia, ib) END DO END DO new_com(:) = new_com(:)/(REAL(helium%atoms*helium%beads, dp)) @@ -1829,7 +1829,7 @@ SUBROUTINE worm_head_move(pint_env, helium, l, ac) old_com(:) = 0.0_dp DO ia = 1, helium%atoms DO ib = 1, helium%beads - old_com(:) = old_com(:)+helium%pos(:, ia, ib) + old_com(:) = old_com(:) + helium%pos(:, ia, ib) END DO END DO old_com(:) = old_com(:)/(REAL(helium%atoms*helium%beads, dp)) @@ -1838,14 +1838,14 @@ SUBROUTINE worm_head_move(pint_env, helium, l, ac) atom: DO ia = 1, helium%atoms dr(:) = 0.0_dp DO ib = 1, helium%beads - dr(:) = dr(:)+helium%work(:, ia, ib)-new_com(:) + dr(:) = dr(:) + helium%work(:, ia, ib) - new_com(:) END DO dr(:) = dr(:)/REAL(helium%beads, dp) rtmp = DOT_PRODUCT(dr, dr) IF (rtmp >= helium%droplet_radius**2) THEN dro(:) = 0.0_dp DO ib = 1, helium%beads - dro(:) = dro(:)+helium%pos(:, ia, ib)-old_com(:) + dro(:) = dro(:) + helium%pos(:, ia, ib) - old_com(:) END DO dro(:) = dro(:)/REAL(helium%beads, dp) rtmpo = DOT_PRODUCT(dro, dro) @@ -1862,17 +1862,17 @@ SUBROUTINE worm_head_move(pint_env, helium, l, ac) ! write back only changed atoms IF (startbead < endbead) THEN ! everything belongs to the same atom - DO kbead = startbead+1, endbead-1 + DO kbead = startbead + 1, endbead - 1 helium%work(:, endatom, kbead) = helium%pos(:, endatom, kbead) END DO ELSE ! is distributed among two atoms ! transfer to atom not containing the head bead - DO kbead = startbead+1, helium%beads + DO kbead = startbead + 1, helium%beads helium%work(:, startatom, kbead) = helium%pos(:, startatom, kbead) END DO ! transfer to atom containing the head bead - DO kbead = 1, endbead-1 + DO kbead = 1, endbead - 1 helium%work(:, endatom, kbead) = helium%pos(:, endatom, kbead) END DO END IF @@ -1887,17 +1887,17 @@ SUBROUTINE worm_head_move(pint_env, helium, l, ac) ! write changed coordinates to position array IF (startbead < endbead) THEN ! everything belongs to the same atom - DO kbead = startbead+1, endbead-1 + DO kbead = startbead + 1, endbead - 1 helium%pos(:, endatom, kbead) = helium%work(:, endatom, kbead) END DO ELSE ! is distributed among two atoms ! transfer to atom not containing the head bead - DO kbead = startbead+1, helium%beads + DO kbead = startbead + 1, helium%beads helium%pos(:, startatom, kbead) = helium%work(:, startatom, kbead) END DO ! transfer to atom containing the head bead - DO kbead = 1, endbead-1 + DO kbead = 1, endbead - 1 helium%pos(:, endatom, kbead) = helium%work(:, endatom, kbead) END DO END IF @@ -1933,7 +1933,7 @@ SUBROUTINE worm_tail_move(pint_env, helium, l, ac) ! get index of the atom and bead, where the resampling of the tail ends startatom = helium%worm_atom_idx startbead = helium%worm_bead_idx - endbead = startbead+l + endbead = startbead + l IF (endbead <= helium%beads) THEN ! endbead belongs to the same atom @@ -1942,7 +1942,7 @@ SUBROUTINE worm_tail_move(pint_env, helium, l, ac) ! endbead belongs to a different atom ! find next atom (assuming l < nbeads) endatom = helium%permutation(startatom) - endbead = endbead-helium%beads + endbead = endbead - helium%beads END IF !yes this is correct, as the head does not play any role here @@ -1950,30 +1950,30 @@ SUBROUTINE worm_tail_move(pint_env, helium, l, ac) startatom, startbead, endatom, endbead) IF (helium%solute_present) THEN - sold = sold+worm_path_inter_action_tail(pint_env, helium, helium%pos, & - endatom, endbead, & - helium%worm_atom_idx, helium%worm_bead_idx) + sold = sold + worm_path_inter_action_tail(pint_env, helium, helium%pos, & + endatom, endbead, & + helium%worm_atom_idx, helium%worm_bead_idx) END IF ! alternative grow with consecutive gaussians IF (startbead < endbead) THEN ! everything belongs to the same atom ! gro tail from endbead to startbead (confusing eh?) - DO kbead = endbead-1, startbead, -1 + DO kbead = endbead - 1, startbead, -1 DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%work(idim, startatom, kbead) = helium%work(idim, startatom, kbead+1)+xr + helium%work(idim, startatom, kbead) = helium%work(idim, startatom, kbead + 1) + xr END DO END DO ELSE ! is distributed among two atoms ! grow from endbead - DO kbead = endbead-1, 1, -1 + DO kbead = endbead - 1, 1, -1 DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%work(idim, endatom, kbead) = helium%work(idim, endatom, kbead+1)+xr + helium%work(idim, endatom, kbead) = helium%work(idim, endatom, kbead + 1) + xr END DO END DO @@ -1981,15 +1981,15 @@ SUBROUTINE worm_tail_move(pint_env, helium, l, ac) DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%work(idim, startatom, helium%beads) = helium%work(idim, endatom, 1)+xr + helium%work(idim, startatom, helium%beads) = helium%work(idim, endatom, 1) + xr END DO ! rest on startatom - DO kbead = helium%beads-1, startbead, -1 + DO kbead = helium%beads - 1, startbead, -1 DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%work(idim, startatom, kbead) = helium%work(idim, startatom, kbead+1)+xr + helium%work(idim, startatom, kbead) = helium%work(idim, startatom, kbead + 1) + xr END DO END DO END IF @@ -1999,14 +1999,14 @@ SUBROUTINE worm_tail_move(pint_env, helium, l, ac) startatom, startbead, endatom, endbead) IF (helium%solute_present) THEN - snew = snew+worm_path_inter_action_tail(pint_env, helium, helium%work, & - endatom, endbead, & - helium%worm_atom_idx_work, helium%worm_bead_idx_work) + snew = snew + worm_path_inter_action_tail(pint_env, helium, helium%work, & + endatom, endbead, & + helium%worm_atom_idx_work, helium%worm_bead_idx_work) END IF ! Metropolis: ! action difference - sdiff = sold-snew + sdiff = sold - snew ! modify action difference due to extra bead IF (sdiff < 0) THEN should_reject = .FALSE. @@ -2024,7 +2024,7 @@ SUBROUTINE worm_tail_move(pint_env, helium, l, ac) ! transfer the new coordinates to work array IF (startbead < endbead) THEN ! everything belongs to the same atom - DO kbead = startbead, endbead-1 + DO kbead = startbead, endbead - 1 helium%work(:, endatom, kbead) = helium%pos(:, endatom, kbead) END DO ELSE @@ -2034,7 +2034,7 @@ SUBROUTINE worm_tail_move(pint_env, helium, l, ac) helium%work(:, startatom, kbead) = helium%pos(:, startatom, kbead) END DO ! transfer to atom containing the tail bead - DO kbead = 1, endbead-1 + DO kbead = 1, endbead - 1 helium%work(:, endatom, kbead) = helium%pos(:, endatom, kbead) END DO END IF @@ -2056,7 +2056,7 @@ SUBROUTINE worm_tail_move(pint_env, helium, l, ac) new_com(:) = 0.0_dp DO ia = 1, helium%atoms DO ib = 1, helium%beads - new_com(:) = new_com(:)+helium%work(:, ia, ib) + new_com(:) = new_com(:) + helium%work(:, ia, ib) END DO END DO new_com(:) = new_com(:)/(REAL(helium%atoms*helium%beads, dp)) @@ -2064,7 +2064,7 @@ SUBROUTINE worm_tail_move(pint_env, helium, l, ac) old_com(:) = 0.0_dp DO ia = 1, helium%atoms DO ib = 1, helium%beads - old_com(:) = old_com(:)+helium%pos(:, ia, ib) + old_com(:) = old_com(:) + helium%pos(:, ia, ib) END DO END DO old_com(:) = old_com(:)/(REAL(helium%atoms*helium%beads, dp)) @@ -2073,14 +2073,14 @@ SUBROUTINE worm_tail_move(pint_env, helium, l, ac) atom: DO ia = 1, helium%atoms dr(:) = 0.0_dp DO ib = 1, helium%beads - dr(:) = dr(:)+helium%work(:, ia, ib)-new_com(:) + dr(:) = dr(:) + helium%work(:, ia, ib) - new_com(:) END DO dr(:) = dr(:)/REAL(helium%beads, dp) rtmp = DOT_PRODUCT(dr, dr) IF (rtmp >= helium%droplet_radius**2) THEN dro(:) = 0.0_dp DO ib = 1, helium%beads - dro(:) = dro(:)+helium%pos(:, ia, ib)-old_com(:) + dro(:) = dro(:) + helium%pos(:, ia, ib) - old_com(:) END DO dro(:) = dro(:)/REAL(helium%beads, dp) rtmpo = DOT_PRODUCT(dro, dro) @@ -2097,7 +2097,7 @@ SUBROUTINE worm_tail_move(pint_env, helium, l, ac) ! write back only changed atoms IF (startbead < endbead) THEN ! everything belongs to the same atom - DO kbead = startbead, endbead-1 + DO kbead = startbead, endbead - 1 helium%work(:, endatom, kbead) = helium%pos(:, endatom, kbead) END DO ELSE @@ -2107,7 +2107,7 @@ SUBROUTINE worm_tail_move(pint_env, helium, l, ac) helium%work(:, startatom, kbead) = helium%pos(:, startatom, kbead) END DO ! transfer to atom containing the tail bead - DO kbead = 1, endbead-1 + DO kbead = 1, endbead - 1 helium%work(:, endatom, kbead) = helium%pos(:, endatom, kbead) END DO END IF @@ -2122,7 +2122,7 @@ SUBROUTINE worm_tail_move(pint_env, helium, l, ac) ! write changed coordinates to position array IF (startbead < endbead) THEN ! everything belongs to the same atom - DO kbead = startbead, endbead-1 + DO kbead = startbead, endbead - 1 helium%pos(:, endatom, kbead) = helium%work(:, endatom, kbead) END DO ELSE @@ -2132,7 +2132,7 @@ SUBROUTINE worm_tail_move(pint_env, helium, l, ac) helium%pos(:, startatom, kbead) = helium%work(:, startatom, kbead) END DO ! transfer to atom containing the tail bead - DO kbead = 1, endbead-1 + DO kbead = 1, endbead - 1 helium%pos(:, endatom, kbead) = helium%work(:, endatom, kbead) END DO END IF @@ -2166,9 +2166,9 @@ SUBROUTINE worm_crawl_move_forward(pint_env, helium, l, ac) mass = he_mass*massunit ! determine position of new head in imaginary time - helium%worm_bead_idx_work = helium%worm_bead_idx+l + helium%worm_bead_idx_work = helium%worm_bead_idx + l IF (helium%worm_bead_idx_work > helium%beads) THEN - helium%worm_bead_idx_work = helium%worm_bead_idx_work-helium%beads + helium%worm_bead_idx_work = helium%worm_bead_idx_work - helium%beads helium%worm_atom_idx_work = helium%permutation(helium%worm_atom_idx) ELSE helium%worm_atom_idx_work = helium%worm_atom_idx @@ -2182,9 +2182,9 @@ SUBROUTINE worm_crawl_move_forward(pint_env, helium, l, ac) IF (helium%solute_present) THEN !this will leave out the old and new tail bead ! due to efficiency reasons they are treated separately - sold = sold+worm_path_inter_action(pint_env, helium, helium%pos, & - helium%worm_atom_idx, helium%worm_bead_idx, & - helium%worm_atom_idx_work, helium%worm_bead_idx_work) + sold = sold + worm_path_inter_action(pint_env, helium, helium%pos, & + helium%worm_atom_idx, helium%worm_bead_idx, & + helium%worm_atom_idx_work, helium%worm_bead_idx_work) ! compute old/new head/tail interactions ! old tail @@ -2210,7 +2210,7 @@ SUBROUTINE worm_crawl_move_forward(pint_env, helium, l, ac) ! new head is not known yet - sold = sold+0.5_dp*(oldtailpot+oldheadpot)+newtailpot + sold = sold + 0.5_dp*(oldtailpot + oldheadpot) + newtailpot END IF ! copy over old head position to working array and grow from there @@ -2220,63 +2220,63 @@ SUBROUTINE worm_crawl_move_forward(pint_env, helium, l, ac) IF (helium%worm_bead_idx < helium%worm_bead_idx_work) THEN ! everything belongs to the same atom ! gro head from startbead - DO kbead = helium%worm_bead_idx+1, helium%worm_bead_idx_work-1 + DO kbead = helium%worm_bead_idx + 1, helium%worm_bead_idx_work - 1 DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%work(idim, helium%worm_atom_idx, kbead) = helium%work(idim, helium%worm_atom_idx, kbead-1)+xr + helium%work(idim, helium%worm_atom_idx, kbead) = helium%work(idim, helium%worm_atom_idx, kbead - 1) + xr END DO END DO ! last grow head bead DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%worm_xtra_bead_work(idim) = helium%work(idim, helium%worm_atom_idx, helium%worm_bead_idx_work-1)+xr + helium%worm_xtra_bead_work(idim) = helium%work(idim, helium%worm_atom_idx, helium%worm_bead_idx_work - 1) + xr END DO ELSE IF (helium%worm_bead_idx_work /= 1) THEN ! is distributed among two atoms ! grow from startbead - DO kbead = helium%worm_bead_idx+1, helium%beads + DO kbead = helium%worm_bead_idx + 1, helium%beads DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%work(idim, helium%worm_atom_idx, kbead) = helium%work(idim, helium%worm_atom_idx, kbead-1)+xr + helium%work(idim, helium%worm_atom_idx, kbead) = helium%work(idim, helium%worm_atom_idx, kbead - 1) + xr END DO END DO ! bead one of endatom relative to last on helium%worm_atom_idx DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%work(idim, helium%worm_atom_idx_work, 1) = helium%work(idim, helium%worm_atom_idx, helium%beads)+xr + helium%work(idim, helium%worm_atom_idx_work, 1) = helium%work(idim, helium%worm_atom_idx, helium%beads) + xr END DO ! everything on endatom - DO kbead = 2, helium%worm_bead_idx_work-1 + DO kbead = 2, helium%worm_bead_idx_work - 1 DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%work(idim, helium%worm_atom_idx_work, kbead) = helium%work(idim, helium%worm_atom_idx_work, kbead-1)+xr + helium%work(idim, helium%worm_atom_idx_work, kbead) = helium%work(idim, helium%worm_atom_idx_work, kbead - 1) + xr END DO END DO DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%worm_xtra_bead_work(idim) = helium%work(idim, helium%worm_atom_idx_work, helium%worm_bead_idx_work-1)+xr + helium%worm_xtra_bead_work(idim) = helium%work(idim, helium%worm_atom_idx_work, helium%worm_bead_idx_work - 1) + xr END DO ELSE ! imagtimewrap and headbead = 1 ! is distributed among two atoms ! grow from startbead - DO kbead = helium%worm_bead_idx+1, helium%beads + DO kbead = helium%worm_bead_idx + 1, helium%beads DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%work(idim, helium%worm_atom_idx, kbead) = helium%work(idim, helium%worm_atom_idx, kbead-1)+xr + helium%work(idim, helium%worm_atom_idx, kbead) = helium%work(idim, helium%worm_atom_idx, kbead - 1) + xr END DO END DO ! bead one of endatom relative to last on helium%worm_atom_idx DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%worm_xtra_bead_work(idim) = helium%work(idim, helium%worm_atom_idx, helium%beads)+xr + helium%worm_xtra_bead_work(idim) = helium%work(idim, helium%worm_atom_idx, helium%beads) + xr END DO END IF @@ -2286,15 +2286,15 @@ SUBROUTINE worm_crawl_move_forward(pint_env, helium, l, ac) helium%worm_xtra_bead_work, helium%worm_atom_idx_work, helium%worm_bead_idx_work) IF (helium%solute_present) THEN - snew = snew+worm_path_inter_action_head(pint_env, helium, helium%work, & - helium%worm_atom_idx, helium%worm_bead_idx, & - helium%worm_xtra_bead_work, helium%worm_atom_idx_work, helium%worm_bead_idx_work) - snew = snew+0.5_dp*newtailpot+oldheadpot + snew = snew + worm_path_inter_action_head(pint_env, helium, helium%work, & + helium%worm_atom_idx, helium%worm_bead_idx, & + helium%worm_xtra_bead_work, helium%worm_atom_idx_work, helium%worm_bead_idx_work) + snew = snew + 0.5_dp*newtailpot + oldheadpot END IF ! Metropolis: ! action difference - sdiff = sold-snew + sdiff = sold - snew ! modify action difference due to extra bead IF (sdiff < 0) THEN should_reject = .FALSE. @@ -2312,7 +2312,7 @@ SUBROUTINE worm_crawl_move_forward(pint_env, helium, l, ac) ! transfer the new coordinates to work array IF (helium%worm_bead_idx < helium%worm_bead_idx_work) THEN ! everything belongs to the same atom - DO kbead = helium%worm_bead_idx, helium%worm_bead_idx_work-1 + DO kbead = helium%worm_bead_idx, helium%worm_bead_idx_work - 1 helium%work(:, helium%worm_atom_idx_work, kbead) = helium%pos(:, helium%worm_atom_idx_work, kbead) END DO ELSE @@ -2322,7 +2322,7 @@ SUBROUTINE worm_crawl_move_forward(pint_env, helium, l, ac) helium%work(:, helium%worm_atom_idx, kbead) = helium%pos(:, helium%worm_atom_idx, kbead) END DO ! transfer to atom containing the head bead - DO kbead = 1, helium%worm_bead_idx_work-1 + DO kbead = 1, helium%worm_bead_idx_work - 1 helium%work(:, helium%worm_atom_idx_work, kbead) = helium%pos(:, helium%worm_atom_idx_work, kbead) END DO END IF @@ -2346,7 +2346,7 @@ SUBROUTINE worm_crawl_move_forward(pint_env, helium, l, ac) new_com(:) = 0.0_dp DO ia = 1, helium%atoms DO ib = 1, helium%beads - new_com(:) = new_com(:)+helium%work(:, ia, ib) + new_com(:) = new_com(:) + helium%work(:, ia, ib) END DO END DO new_com(:) = new_com(:)/(REAL(helium%atoms*helium%beads, dp)) @@ -2354,7 +2354,7 @@ SUBROUTINE worm_crawl_move_forward(pint_env, helium, l, ac) old_com(:) = 0.0_dp DO ia = 1, helium%atoms DO ib = 1, helium%beads - old_com(:) = old_com(:)+helium%pos(:, ia, ib) + old_com(:) = old_com(:) + helium%pos(:, ia, ib) END DO END DO old_com(:) = old_com(:)/(REAL(helium%atoms*helium%beads, dp)) @@ -2363,14 +2363,14 @@ SUBROUTINE worm_crawl_move_forward(pint_env, helium, l, ac) atom: DO ia = 1, helium%atoms dr(:) = 0.0_dp DO ib = 1, helium%beads - dr(:) = dr(:)+helium%work(:, ia, ib)-new_com(:) + dr(:) = dr(:) + helium%work(:, ia, ib) - new_com(:) END DO dr(:) = dr(:)/REAL(helium%beads, dp) rtmp = DOT_PRODUCT(dr, dr) IF (rtmp >= helium%droplet_radius**2) THEN dro(:) = 0.0_dp DO ib = 1, helium%beads - dro(:) = dro(:)+helium%pos(:, ia, ib)-old_com(:) + dro(:) = dro(:) + helium%pos(:, ia, ib) - old_com(:) END DO dro(:) = dro(:)/REAL(helium%beads, dp) rtmpo = DOT_PRODUCT(dro, dro) @@ -2387,7 +2387,7 @@ SUBROUTINE worm_crawl_move_forward(pint_env, helium, l, ac) ! write back only changed atoms IF (helium%worm_bead_idx < helium%worm_bead_idx_work) THEN ! everything belongs to the same atom - DO kbead = helium%worm_bead_idx, helium%worm_bead_idx_work-1 + DO kbead = helium%worm_bead_idx, helium%worm_bead_idx_work - 1 helium%work(:, helium%worm_atom_idx_work, kbead) = helium%pos(:, helium%worm_atom_idx_work, kbead) END DO ELSE @@ -2397,7 +2397,7 @@ SUBROUTINE worm_crawl_move_forward(pint_env, helium, l, ac) helium%work(:, helium%worm_atom_idx, kbead) = helium%pos(:, helium%worm_atom_idx, kbead) END DO ! transfer to atom containing the head bead - DO kbead = 1, helium%worm_bead_idx_work-1 + DO kbead = 1, helium%worm_bead_idx_work - 1 helium%work(:, helium%worm_atom_idx_work, kbead) = helium%pos(:, helium%worm_atom_idx_work, kbead) END DO END IF @@ -2414,7 +2414,7 @@ SUBROUTINE worm_crawl_move_forward(pint_env, helium, l, ac) ! write changed coordinates to position array IF (helium%worm_bead_idx < helium%worm_bead_idx_work) THEN ! everything belongs to the same atom - DO kbead = helium%worm_bead_idx, helium%worm_bead_idx_work-1 + DO kbead = helium%worm_bead_idx, helium%worm_bead_idx_work - 1 helium%pos(:, helium%worm_atom_idx_work, kbead) = helium%work(:, helium%worm_atom_idx_work, kbead) END DO ELSE @@ -2424,7 +2424,7 @@ SUBROUTINE worm_crawl_move_forward(pint_env, helium, l, ac) helium%pos(:, helium%worm_atom_idx, kbead) = helium%work(:, helium%worm_atom_idx, kbead) END DO ! transfer to atom containing the head bead - DO kbead = 1, helium%worm_bead_idx_work-1 + DO kbead = 1, helium%worm_bead_idx_work - 1 helium%pos(:, helium%worm_atom_idx_work, kbead) = helium%work(:, helium%worm_atom_idx_work, kbead) END DO END IF @@ -2461,9 +2461,9 @@ SUBROUTINE worm_crawl_move_backward(pint_env, helium, l, ac) mass = he_mass*massunit ! determine position of new head in imaginary time - helium%worm_bead_idx_work = helium%worm_bead_idx-l + helium%worm_bead_idx_work = helium%worm_bead_idx - l IF (helium%worm_bead_idx_work < 1) THEN - helium%worm_bead_idx_work = helium%worm_bead_idx_work+helium%beads + helium%worm_bead_idx_work = helium%worm_bead_idx_work + helium%beads helium%worm_atom_idx_work = helium%iperm(helium%worm_atom_idx) ELSE helium%worm_atom_idx_work = helium%worm_atom_idx @@ -2479,9 +2479,9 @@ SUBROUTINE worm_crawl_move_backward(pint_env, helium, l, ac) IF (helium%solute_present) THEN !this will leave out the old and new tail bead ! due to efficiency reasons they are treated separately - sold = sold+worm_path_inter_action(pint_env, helium, helium%pos, & - helium%worm_atom_idx_work, helium%worm_bead_idx_work, & - helium%worm_atom_idx, helium%worm_bead_idx) + sold = sold + worm_path_inter_action(pint_env, helium, helium%pos, & + helium%worm_atom_idx_work, helium%worm_bead_idx_work, & + helium%worm_atom_idx, helium%worm_bead_idx) ! compute old/new head/tail interactions ! old tail @@ -2507,7 +2507,7 @@ SUBROUTINE worm_crawl_move_backward(pint_env, helium, l, ac) ! new tail not known yet - sold = sold+0.5_dp*(oldtailpot+oldheadpot)+newheadpot + sold = sold + 0.5_dp*(oldtailpot + oldheadpot) + newheadpot END IF ! copy position to the head bead @@ -2517,22 +2517,22 @@ SUBROUTINE worm_crawl_move_backward(pint_env, helium, l, ac) IF (helium%worm_bead_idx_work < helium%worm_bead_idx) THEN ! everything belongs to the same atom ! gro tail from endbead to startbead (confusing eh?) - DO kbead = helium%worm_bead_idx-1, helium%worm_bead_idx_work, -1 + DO kbead = helium%worm_bead_idx - 1, helium%worm_bead_idx_work, -1 DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%work(idim, helium%worm_atom_idx, kbead) = helium%work(idim, helium%worm_atom_idx, kbead+1)+xr + helium%work(idim, helium%worm_atom_idx, kbead) = helium%work(idim, helium%worm_atom_idx, kbead + 1) + xr END DO END DO ELSE ! is distributed among two atoms ! grow from endbead - DO kbead = helium%worm_bead_idx-1, 1, -1 + DO kbead = helium%worm_bead_idx - 1, 1, -1 DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%work(idim, helium%worm_atom_idx, kbead) = helium%work(idim, helium%worm_atom_idx, kbead+1)+xr + helium%work(idim, helium%worm_atom_idx, kbead) = helium%work(idim, helium%worm_atom_idx, kbead + 1) + xr END DO END DO @@ -2540,15 +2540,15 @@ SUBROUTINE worm_crawl_move_backward(pint_env, helium, l, ac) DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%work(idim, helium%worm_atom_idx_work, helium%beads) = helium%work(idim, helium%worm_atom_idx, 1)+xr + helium%work(idim, helium%worm_atom_idx_work, helium%beads) = helium%work(idim, helium%worm_atom_idx, 1) + xr END DO ! rest on startatom - DO kbead = helium%beads-1, helium%worm_bead_idx_work, -1 + DO kbead = helium%beads - 1, helium%worm_bead_idx_work, -1 DO idim = 1, 3 xr = next_random_number(rng_stream=helium%rng_stream_gaussian, & variance=helium%hb2m*helium%tau) - helium%work(idim, helium%worm_atom_idx_work, kbead) = helium%work(idim, helium%worm_atom_idx_work, kbead+1)+xr + helium%work(idim, helium%worm_atom_idx_work, kbead) = helium%work(idim, helium%worm_atom_idx_work, kbead + 1) + xr END DO END DO END IF @@ -2558,15 +2558,15 @@ SUBROUTINE worm_crawl_move_backward(pint_env, helium, l, ac) helium%worm_atom_idx, helium%worm_bead_idx) IF (helium%solute_present) THEN - snew = snew+worm_path_inter_action_tail(pint_env, helium, helium%work, & - helium%worm_atom_idx, helium%worm_bead_idx, & - helium%worm_atom_idx_work, helium%worm_bead_idx_work) - snew = snew+0.5_dp*newheadpot+oldtailpot + snew = snew + worm_path_inter_action_tail(pint_env, helium, helium%work, & + helium%worm_atom_idx, helium%worm_bead_idx, & + helium%worm_atom_idx_work, helium%worm_bead_idx_work) + snew = snew + 0.5_dp*newheadpot + oldtailpot END IF ! Metropolis: ! action difference - sdiff = sold-snew + sdiff = sold - snew ! modify action difference due to extra bead IF (sdiff < 0) THEN should_reject = .FALSE. @@ -2584,7 +2584,7 @@ SUBROUTINE worm_crawl_move_backward(pint_env, helium, l, ac) ! transfer the new coordinates to work array IF (helium%worm_bead_idx_work < helium%worm_bead_idx) THEN ! everything belongs to the same atom - DO kbead = helium%worm_bead_idx_work, helium%worm_bead_idx-1 + DO kbead = helium%worm_bead_idx_work, helium%worm_bead_idx - 1 helium%work(:, helium%worm_atom_idx, kbead) = helium%pos(:, helium%worm_atom_idx, kbead) END DO ELSE @@ -2594,7 +2594,7 @@ SUBROUTINE worm_crawl_move_backward(pint_env, helium, l, ac) helium%work(:, helium%worm_atom_idx_work, kbead) = helium%pos(:, helium%worm_atom_idx_work, kbead) END DO ! transfer to atom containing the tail bead - DO kbead = 1, helium%worm_bead_idx-1 + DO kbead = 1, helium%worm_bead_idx - 1 helium%work(:, helium%worm_atom_idx, kbead) = helium%pos(:, helium%worm_atom_idx, kbead) END DO END IF @@ -2618,7 +2618,7 @@ SUBROUTINE worm_crawl_move_backward(pint_env, helium, l, ac) new_com(:) = 0.0_dp DO ia = 1, helium%atoms DO ib = 1, helium%beads - new_com(:) = new_com(:)+helium%work(:, ia, ib) + new_com(:) = new_com(:) + helium%work(:, ia, ib) END DO END DO new_com(:) = new_com(:)/(REAL(helium%atoms*helium%beads, dp)) @@ -2626,7 +2626,7 @@ SUBROUTINE worm_crawl_move_backward(pint_env, helium, l, ac) old_com(:) = 0.0_dp DO ia = 1, helium%atoms DO ib = 1, helium%beads - old_com(:) = old_com(:)+helium%pos(:, ia, ib) + old_com(:) = old_com(:) + helium%pos(:, ia, ib) END DO END DO old_com(:) = old_com(:)/(REAL(helium%atoms*helium%beads, dp)) @@ -2635,14 +2635,14 @@ SUBROUTINE worm_crawl_move_backward(pint_env, helium, l, ac) atom: DO ia = 1, helium%atoms dr(:) = 0.0_dp DO ib = 1, helium%beads - dr(:) = dr(:)+helium%work(:, ia, ib)-new_com(:) + dr(:) = dr(:) + helium%work(:, ia, ib) - new_com(:) END DO dr(:) = dr(:)/REAL(helium%beads, dp) rtmp = DOT_PRODUCT(dr, dr) IF (rtmp >= helium%droplet_radius**2) THEN dro(:) = 0.0_dp DO ib = 1, helium%beads - dro(:) = dro(:)+helium%pos(:, ia, ib)-old_com(:) + dro(:) = dro(:) + helium%pos(:, ia, ib) - old_com(:) END DO dro(:) = dro(:)/REAL(helium%beads, dp) rtmpo = DOT_PRODUCT(dro, dro) @@ -2661,7 +2661,7 @@ SUBROUTINE worm_crawl_move_backward(pint_env, helium, l, ac) ! transfer the new coordinates to work array IF (helium%worm_bead_idx_work < helium%worm_bead_idx) THEN ! everything belongs to the same atom - DO kbead = helium%worm_bead_idx_work, helium%worm_bead_idx-1 + DO kbead = helium%worm_bead_idx_work, helium%worm_bead_idx - 1 helium%work(:, helium%worm_atom_idx, kbead) = helium%pos(:, helium%worm_atom_idx, kbead) END DO ELSE @@ -2671,7 +2671,7 @@ SUBROUTINE worm_crawl_move_backward(pint_env, helium, l, ac) helium%work(:, helium%worm_atom_idx_work, kbead) = helium%pos(:, helium%worm_atom_idx_work, kbead) END DO ! transfer to atom containing the tail bead - DO kbead = 1, helium%worm_bead_idx-1 + DO kbead = 1, helium%worm_bead_idx - 1 helium%work(:, helium%worm_atom_idx, kbead) = helium%pos(:, helium%worm_atom_idx, kbead) END DO END IF @@ -2689,7 +2689,7 @@ SUBROUTINE worm_crawl_move_backward(pint_env, helium, l, ac) ! write back only changed atoms IF (helium%worm_bead_idx_work < helium%worm_bead_idx) THEN ! everything belongs to the same atom - DO kbead = helium%worm_bead_idx_work, helium%worm_bead_idx-1 + DO kbead = helium%worm_bead_idx_work, helium%worm_bead_idx - 1 helium%pos(:, helium%worm_atom_idx, kbead) = helium%work(:, helium%worm_atom_idx, kbead) END DO ELSE @@ -2699,7 +2699,7 @@ SUBROUTINE worm_crawl_move_backward(pint_env, helium, l, ac) helium%pos(:, helium%worm_atom_idx_work, kbead) = helium%work(:, helium%worm_atom_idx_work, kbead) END DO ! transfer to atom containing the tail bead - DO kbead = 1, helium%worm_bead_idx-1 + DO kbead = 1, helium%worm_bead_idx - 1 helium%pos(:, helium%worm_atom_idx, kbead) = helium%work(:, helium%worm_atom_idx, kbead) END DO END IF @@ -2729,7 +2729,7 @@ REAL(KIND=dp) FUNCTION free_density_matrix(helium, startpos, endpos, l) RESULT(r REAL(KIND=dp) :: distsq, prefac REAL(KIND=dp), DIMENSION(3) :: dvec - dvec(:) = startpos(:)-endpos(:) + dvec(:) = startpos(:) - endpos(:) CALL helium_pbc(helium, dvec) distsq = DOT_PRODUCT(dvec, dvec) @@ -2773,24 +2773,24 @@ SUBROUTINE worm_swap_move(pint_env, helium, natoms, l, ac) ! first the endbead of the reconstruction is needed startbead = helium%worm_bead_idx - endbead = helium%worm_bead_idx+l+1 + endbead = helium%worm_bead_idx + l + 1 fstartatom = helium%worm_atom_idx excludeatom = fstartatom ! compute the atomwise probabilities to be the worms swap partner ! Check if the imaginary time section belongs to two atoms IF (endbead > helium%beads) THEN - endbead = endbead-helium%beads + endbead = endbead - helium%beads ! exclude atom is the one not to connect to because it will result in an unnatural state excludeatom = helium%permutation(excludeatom) END IF - DO iatom = 1, excludeatom-1 + DO iatom = 1, excludeatom - 1 forwarddensmat(iatom) = free_density_matrix(helium, helium%worm_xtra_bead(:), & - helium%pos(:, iatom, endbead), l+1) + helium%pos(:, iatom, endbead), l + 1) END DO forwarddensmat(excludeatom) = 0.0_dp - DO iatom = excludeatom+1, natoms + DO iatom = excludeatom + 1, natoms forwarddensmat(iatom) = free_density_matrix(helium, helium%worm_xtra_bead(:), & - helium%pos(:, iatom, endbead), l+1) + helium%pos(:, iatom, endbead), l + 1) END DO forwarddensmatsum = SUM(forwarddensmat) @@ -2798,8 +2798,8 @@ SUBROUTINE worm_swap_move(pint_env, helium, natoms, l, ac) rtmp = next_random_number(helium%rng_stream_uniform)*forwarddensmatsum fendatom = 1 DO WHILE (rtmp >= forwarddensmat(fendatom)) - rtmp = rtmp-forwarddensmat(fendatom) - fendatom = fendatom+1 + rtmp = rtmp - forwarddensmat(fendatom) + fendatom = fendatom + 1 END DO ! just for numerical safety fendatom = MIN(fendatom, natoms) @@ -2812,16 +2812,16 @@ SUBROUTINE worm_swap_move(pint_env, helium, natoms, l, ac) END IF bendatom = fendatom - DO iatom = 1, excludeatom-1 + DO iatom = 1, excludeatom - 1 backwarddensmat(iatom) = free_density_matrix(helium, & helium%pos(:, bstartatom, startbead), & - helium%pos(:, iatom, endbead), l+1) + helium%pos(:, iatom, endbead), l + 1) END DO backwarddensmat(excludeatom) = 0.0_dp - DO iatom = excludeatom+1, natoms + DO iatom = excludeatom + 1, natoms backwarddensmat(iatom) = free_density_matrix(helium, & helium%pos(:, bstartatom, startbead), & - helium%pos(:, iatom, endbead), l+1) + helium%pos(:, iatom, endbead), l + 1) END DO backwarddensmatsum = SUM(backwarddensmat) @@ -2835,8 +2835,8 @@ SUBROUTINE worm_swap_move(pint_env, helium, natoms, l, ac) IF (helium%solute_present) THEN ! no special head treatment needed, as it will change due to swapping ! the worm gap and due to primitive coupling no cross bead terms are considered - sold = sold+worm_path_inter_action(pint_env, helium, helium%pos, & - bstartatom, startbead, fendatom, endbead) + sold = sold + worm_path_inter_action(pint_env, helium, helium%pos, & + bstartatom, startbead, fendatom, endbead) ! compute potential of old and new head here (only once, as later only a rescaling is neccessary) CALL helium_bead_solute_e_f(pint_env, helium, & fstartatom, startbead, helium%worm_xtra_bead, & @@ -2848,7 +2848,7 @@ SUBROUTINE worm_swap_move(pint_env, helium, natoms, l, ac) energy=newheadpotential) newheadpotential = newheadpotential*helium%tau - sold = sold+0.5_dp*oldheadpotential+newheadpotential + sold = sold + 0.5_dp*oldheadpotential + newheadpotential END IF ! construct a new path connecting the start and endbead @@ -2863,21 +2863,21 @@ SUBROUTINE worm_swap_move(pint_env, helium, natoms, l, ac) jbead = 1 IF (startbead < endbead) THEN ! everything belongs to the same atom - DO kbead = startbead+1, endbead-1 + DO kbead = startbead + 1, endbead - 1 helium%work(:, fstartatom, kbead) = newsection(:, jbead) - jbead = jbead+1 + jbead = jbead + 1 END DO ELSE ! is distributed among two atoms ! transfer to atom not containing the head bead - DO kbead = startbead+1, helium%beads + DO kbead = startbead + 1, helium%beads helium%work(:, fstartatom, kbead) = newsection(:, jbead) - jbead = jbead+1 + jbead = jbead + 1 END DO ! rest to the second atom - DO ibead = 1, endbead-1 + DO ibead = 1, endbead - 1 helium%work(:, fendatom, ibead) = newsection(:, jbead) - jbead = jbead+1 + jbead = jbead + 1 END DO END IF @@ -2913,11 +2913,11 @@ SUBROUTINE worm_swap_move(pint_env, helium, natoms, l, ac) IF (helium%solute_present) THEN ! no special head treatment needed, because a swap can't go over ! the worm gap and due to primitive coupling no cross bead terms are considered - snew = snew+worm_path_inter_action(pint_env, helium, helium%work, & - fstartatom, startbead, fstartatom, endbead) + snew = snew + worm_path_inter_action(pint_env, helium, helium%work, & + fstartatom, startbead, fstartatom, endbead) ! add the previously computed old and new head actions - snew = snew+oldheadpotential+0.5_dp*newheadpotential + snew = snew + oldheadpotential + 0.5_dp*newheadpotential END IF ELSE snew = worm_path_action(helium, helium%work, & @@ -2925,17 +2925,17 @@ SUBROUTINE worm_swap_move(pint_env, helium, natoms, l, ac) IF (helium%solute_present) THEN ! no special head treatment needed, because a swap can't go over ! the worm gap and due to primitive coupling no cross bead terms are considered - snew = snew+worm_path_inter_action(pint_env, helium, helium%work, & - fstartatom, startbead, helium%permutation(fstartatom), endbead) + snew = snew + worm_path_inter_action(pint_env, helium, helium%work, & + fstartatom, startbead, helium%permutation(fstartatom), endbead) ! add the previously computed old and new head actions - snew = snew+oldheadpotential+0.5_dp*newheadpotential + snew = snew + oldheadpotential + 0.5_dp*newheadpotential END IF END IF ! Metropolis: - sdiff = sold-snew - sdiff = sdiff+LOG(forwarddensmatsum/backwarddensmatsum) + sdiff = sold - snew + sdiff = sdiff + LOG(forwarddensmatsum/backwarddensmatsum) IF (sdiff < 0) THEN should_reject = .FALSE. IF (sdiff < -100.0_dp) THEN ! To protect from exponential underflow @@ -2987,7 +2987,7 @@ SUBROUTINE worm_swap_move(pint_env, helium, natoms, l, ac) new_com(:) = 0.0_dp DO ia = 1, helium%atoms DO ib = 1, helium%beads - new_com(:) = new_com(:)+helium%work(:, ia, ib) + new_com(:) = new_com(:) + helium%work(:, ia, ib) END DO END DO new_com(:) = new_com(:)/(REAL(helium%atoms*helium%beads, dp)) @@ -2995,7 +2995,7 @@ SUBROUTINE worm_swap_move(pint_env, helium, natoms, l, ac) old_com(:) = 0.0_dp DO ia = 1, helium%atoms DO ib = 1, helium%beads - old_com(:) = old_com(:)+helium%pos(:, ia, ib) + old_com(:) = old_com(:) + helium%pos(:, ia, ib) END DO END DO old_com(:) = old_com(:)/(REAL(helium%atoms*helium%beads, dp)) @@ -3004,14 +3004,14 @@ SUBROUTINE worm_swap_move(pint_env, helium, natoms, l, ac) atom: DO ia = 1, helium%atoms dr(:) = 0.0_dp DO ib = 1, helium%beads - dr(:) = dr(:)+helium%work(:, ia, ib)-new_com(:) + dr(:) = dr(:) + helium%work(:, ia, ib) - new_com(:) END DO dr(:) = dr(:)/REAL(helium%beads, dp) rtmp = DOT_PRODUCT(dr, dr) IF (rtmp >= helium%droplet_radius**2) THEN dro(:) = 0.0_dp DO ib = 1, helium%beads - dro(:) = dro(:)+helium%pos(:, ia, ib)-old_com(:) + dro(:) = dro(:) + helium%pos(:, ia, ib) - old_com(:) END DO dro(:) = dro(:)/REAL(helium%beads, dp) rtmpo = DOT_PRODUCT(dro, dro) @@ -3105,10 +3105,10 @@ REAL(KIND=dp) FUNCTION worm_path_action(helium, pos, & IF (iatom == startatom) CYCLE ! first the section up to the worm gap ! two less, because we need to work on the worm intersection separately - DO ibead = startbead, endbead-1 - r(:) = pos(:, iatom, ibead)-pos(:, startatom, ibead) - rp(:) = pos(:, iatom, ibead+1)-pos(:, startatom, ibead+1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + DO ibead = startbead, endbead - 1 + r(:) = pos(:, iatom, ibead) - pos(:, startatom, ibead) + rp(:) = pos(:, iatom, ibead + 1) - pos(:, startatom, ibead + 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO END DO ELSE !(startbead > endbead) @@ -3119,16 +3119,16 @@ REAL(KIND=dp) FUNCTION worm_path_action(helium, pos, & IF (iatom == startatom) CYCLE ! first the section up to the worm gap ! two less, because we need to work on the worm intersection separately - DO ibead = startbead, helium%beads-1 - r(:) = pos(:, iatom, ibead)-pos(:, startatom, ibead) - rp(:) = pos(:, iatom, ibead+1)-pos(:, startatom, ibead+1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + DO ibead = startbead, helium%beads - 1 + r(:) = pos(:, iatom, ibead) - pos(:, startatom, ibead) + rp(:) = pos(:, iatom, ibead + 1) - pos(:, startatom, ibead + 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO ! wrapping bond - r(:) = pos(:, iatom, helium%beads)-pos(:, startatom, helium%beads) - rp(:) = pos(:, helium%permutation(iatom), 1)-pos(:, endatom, 1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = pos(:, iatom, helium%beads) - pos(:, startatom, helium%beads) + rp(:) = pos(:, helium%permutation(iatom), 1) - pos(:, endatom, 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO ! ending atom @@ -3136,10 +3136,10 @@ REAL(KIND=dp) FUNCTION worm_path_action(helium, pos, & ! avoid self interaction IF (iatom == endatom) CYCLE !from first to endbead - DO ibead = 1, endbead-1 - r(:) = pos(:, iatom, ibead)-pos(:, endatom, ibead) - rp(:) = pos(:, iatom, ibead+1)-pos(:, endatom, ibead+1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + DO ibead = 1, endbead - 1 + r(:) = pos(:, iatom, ibead) - pos(:, endatom, ibead) + rp(:) = pos(:, iatom, ibead + 1) - pos(:, endatom, ibead + 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO END DO @@ -3187,16 +3187,16 @@ REAL(KIND=dp) FUNCTION worm_path_action_worm_corrected(helium, pos, & IF (iatom == startatom) CYCLE ! first the section up to the worm gap ! two less, because we need to work on the worm intersection separately - DO ibead = startbead, worm_bead_idx-2 - r(:) = pos(:, iatom, ibead)-pos(:, startatom, ibead) - rp(:) = pos(:, iatom, ibead+1)-pos(:, startatom, ibead+1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + DO ibead = startbead, worm_bead_idx - 2 + r(:) = pos(:, iatom, ibead) - pos(:, startatom, ibead) + rp(:) = pos(:, iatom, ibead + 1) - pos(:, startatom, ibead + 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO - DO ibead = worm_bead_idx, endbead-1 - r(:) = pos(:, iatom, ibead)-pos(:, startatom, ibead) - rp(:) = pos(:, iatom, ibead+1)-pos(:, startatom, ibead+1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + DO ibead = worm_bead_idx, endbead - 1 + r(:) = pos(:, iatom, ibead) - pos(:, startatom, ibead) + rp(:) = pos(:, iatom, ibead + 1) - pos(:, startatom, ibead + 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO END DO @@ -3204,21 +3204,21 @@ REAL(KIND=dp) FUNCTION worm_path_action_worm_corrected(helium, pos, & DO iatom = 1, helium%atoms IF (iatom == startatom) CYCLE IF (iatom == worm_atom_idx) CYCLE - r(:) = pos(:, iatom, worm_bead_idx-1)-pos(:, startatom, worm_bead_idx-1) - rp(:) = pos(:, iatom, worm_bead_idx)-pos(:, startatom, worm_bead_idx) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = pos(:, iatom, worm_bead_idx - 1) - pos(:, startatom, worm_bead_idx - 1) + rp(:) = pos(:, iatom, worm_bead_idx) - pos(:, startatom, worm_bead_idx) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO ! add pair action with worm - r(:) = pos(:, startatom, worm_bead_idx-1)-pos(:, worm_atom_idx, worm_bead_idx-1) - rp(:) = pos(:, startatom, worm_bead_idx)-xtrapos(:) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = pos(:, startatom, worm_bead_idx - 1) - pos(:, worm_atom_idx, worm_bead_idx - 1) + rp(:) = pos(:, startatom, worm_bead_idx) - xtrapos(:) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) ELSE ! worm intersection DO iatom = 1, helium%atoms IF (iatom == startatom) CYCLE - r(:) = pos(:, iatom, worm_bead_idx-1)-pos(:, startatom, worm_bead_idx-1) - rp(:) = pos(:, iatom, worm_bead_idx)-xtrapos(:) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = pos(:, iatom, worm_bead_idx - 1) - pos(:, startatom, worm_bead_idx - 1) + rp(:) = pos(:, iatom, worm_bead_idx) - xtrapos(:) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO END IF ELSE !(startbead > endbead) @@ -3231,23 +3231,23 @@ REAL(KIND=dp) FUNCTION worm_path_action_worm_corrected(helium, pos, & IF (iatom == startatom) CYCLE ! first the section up to the worm gap ! two less, because we need to work on the worm intersection separately - DO ibead = startbead, worm_bead_idx-2 - r(:) = pos(:, iatom, ibead)-pos(:, startatom, ibead) - rp(:) = pos(:, iatom, ibead+1)-pos(:, startatom, ibead+1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + DO ibead = startbead, worm_bead_idx - 2 + r(:) = pos(:, iatom, ibead) - pos(:, startatom, ibead) + rp(:) = pos(:, iatom, ibead + 1) - pos(:, startatom, ibead + 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO ! up to the wrapping border - DO ibead = worm_bead_idx, helium%beads-1 - r(:) = pos(:, iatom, ibead)-pos(:, startatom, ibead) - rp(:) = pos(:, iatom, ibead+1)-pos(:, startatom, ibead+1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + DO ibead = worm_bead_idx, helium%beads - 1 + r(:) = pos(:, iatom, ibead) - pos(:, startatom, ibead) + rp(:) = pos(:, iatom, ibead + 1) - pos(:, startatom, ibead + 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO ! wrapping bond - r(:) = pos(:, iatom, helium%beads)-pos(:, startatom, helium%beads) - rp(:) = pos(:, helium%permutation(iatom), 1)-pos(:, helium%permutation(startatom), 1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = pos(:, iatom, helium%beads) - pos(:, startatom, helium%beads) + rp(:) = pos(:, helium%permutation(iatom), 1) - pos(:, helium%permutation(startatom), 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO @@ -3256,10 +3256,10 @@ REAL(KIND=dp) FUNCTION worm_path_action_worm_corrected(helium, pos, & ! avoid self interaction IF (iatom == endatom) CYCLE !from first to endbead - DO ibead = 1, endbead-1 - r(:) = pos(:, iatom, ibead)-pos(:, endatom, ibead) - rp(:) = pos(:, iatom, ibead+1)-pos(:, endatom, ibead+1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + DO ibead = 1, endbead - 1 + r(:) = pos(:, iatom, ibead) - pos(:, endatom, ibead) + rp(:) = pos(:, iatom, ibead + 1) - pos(:, endatom, ibead + 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO END DO @@ -3267,21 +3267,21 @@ REAL(KIND=dp) FUNCTION worm_path_action_worm_corrected(helium, pos, & DO iatom = 1, helium%atoms IF (iatom == startatom) CYCLE IF (iatom == worm_atom_idx) CYCLE - r(:) = pos(:, iatom, worm_bead_idx-1)-pos(:, startatom, worm_bead_idx-1) - rp(:) = pos(:, iatom, worm_bead_idx)-pos(:, startatom, worm_bead_idx) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = pos(:, iatom, worm_bead_idx - 1) - pos(:, startatom, worm_bead_idx - 1) + rp(:) = pos(:, iatom, worm_bead_idx) - pos(:, startatom, worm_bead_idx) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO ! add pair action with worm - r(:) = pos(:, startatom, worm_bead_idx-1)-pos(:, worm_atom_idx, worm_bead_idx-1) - rp(:) = pos(:, startatom, worm_bead_idx)-xtrapos(:) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = pos(:, startatom, worm_bead_idx - 1) - pos(:, worm_atom_idx, worm_bead_idx - 1) + rp(:) = pos(:, startatom, worm_bead_idx) - xtrapos(:) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) ELSE ! worm intersection DO iatom = 1, helium%atoms IF (iatom == startatom) CYCLE - r(:) = pos(:, iatom, worm_bead_idx-1)-pos(:, startatom, worm_bead_idx-1) - rp(:) = pos(:, iatom, worm_bead_idx)-xtrapos(:) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = pos(:, iatom, worm_bead_idx - 1) - pos(:, startatom, worm_bead_idx - 1) + rp(:) = pos(:, iatom, worm_bead_idx) - xtrapos(:) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO END IF ELSE !(worm_bead_idx < endbead) @@ -3291,16 +3291,16 @@ REAL(KIND=dp) FUNCTION worm_path_action_worm_corrected(helium, pos, & IF (iatom == startatom) CYCLE ! first the section up to the end of the atom ! one less, because we need to work on the wrapping separately - DO ibead = startbead, helium%beads-1 - r(:) = pos(:, iatom, ibead)-pos(:, startatom, ibead) - rp(:) = pos(:, iatom, ibead+1)-pos(:, startatom, ibead+1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + DO ibead = startbead, helium%beads - 1 + r(:) = pos(:, iatom, ibead) - pos(:, startatom, ibead) + rp(:) = pos(:, iatom, ibead + 1) - pos(:, startatom, ibead + 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO ! wrapping bond - r(:) = pos(:, iatom, helium%beads)-pos(:, startatom, helium%beads) - rp(:) = pos(:, helium%permutation(iatom), 1)-pos(:, helium%permutation(startatom), 1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = pos(:, iatom, helium%beads) - pos(:, startatom, helium%beads) + rp(:) = pos(:, helium%permutation(iatom), 1) - pos(:, helium%permutation(startatom), 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO ! ending atom @@ -3308,16 +3308,16 @@ REAL(KIND=dp) FUNCTION worm_path_action_worm_corrected(helium, pos, & ! avoid self interaction IF (iatom == endatom) CYCLE !from first to two before the worm gap - DO ibead = 1, worm_bead_idx-2 - r(:) = pos(:, iatom, ibead)-pos(:, endatom, ibead) - rp(:) = pos(:, iatom, ibead+1)-pos(:, endatom, ibead+1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + DO ibead = 1, worm_bead_idx - 2 + r(:) = pos(:, iatom, ibead) - pos(:, endatom, ibead) + rp(:) = pos(:, iatom, ibead + 1) - pos(:, endatom, ibead + 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO - DO ibead = worm_bead_idx, endbead-1 - r(:) = pos(:, iatom, ibead)-pos(:, endatom, ibead) - rp(:) = pos(:, iatom, ibead+1)-pos(:, endatom, ibead+1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + DO ibead = worm_bead_idx, endbead - 1 + r(:) = pos(:, iatom, ibead) - pos(:, endatom, ibead) + rp(:) = pos(:, iatom, ibead + 1) - pos(:, endatom, ibead + 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO END DO @@ -3325,21 +3325,21 @@ REAL(KIND=dp) FUNCTION worm_path_action_worm_corrected(helium, pos, & DO iatom = 1, helium%atoms IF (iatom == endatom) CYCLE IF (iatom == worm_atom_idx) CYCLE - r(:) = pos(:, iatom, worm_bead_idx-1)-pos(:, endatom, worm_bead_idx-1) - rp(:) = pos(:, iatom, worm_bead_idx)-pos(:, endatom, worm_bead_idx) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = pos(:, iatom, worm_bead_idx - 1) - pos(:, endatom, worm_bead_idx - 1) + rp(:) = pos(:, iatom, worm_bead_idx) - pos(:, endatom, worm_bead_idx) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO ! add pair action with worm - r(:) = pos(:, endatom, worm_bead_idx-1)-pos(:, worm_atom_idx, worm_bead_idx-1) - rp(:) = pos(:, endatom, worm_bead_idx)-xtrapos(:) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = pos(:, endatom, worm_bead_idx - 1) - pos(:, worm_atom_idx, worm_bead_idx - 1) + rp(:) = pos(:, endatom, worm_bead_idx) - xtrapos(:) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) ELSE ! worm intersection DO iatom = 1, helium%atoms IF (iatom == endatom) CYCLE - r(:) = pos(:, iatom, worm_bead_idx-1)-pos(:, endatom, worm_bead_idx-1) - rp(:) = pos(:, iatom, worm_bead_idx)-xtrapos(:) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = pos(:, iatom, worm_bead_idx - 1) - pos(:, endatom, worm_bead_idx - 1) + rp(:) = pos(:, iatom, worm_bead_idx) - xtrapos(:) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO END IF ELSE !(worm_bead_idx == 1) @@ -3349,19 +3349,19 @@ REAL(KIND=dp) FUNCTION worm_path_action_worm_corrected(helium, pos, & IF (iatom == startatom) CYCLE ! first the section up to the end of the atom ! one less, because we need to work on the wrapping separately - DO ibead = startbead, helium%beads-1 - r(:) = pos(:, iatom, ibead)-pos(:, startatom, ibead) - rp(:) = pos(:, iatom, ibead+1)-pos(:, startatom, ibead+1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + DO ibead = startbead, helium%beads - 1 + r(:) = pos(:, iatom, ibead) - pos(:, startatom, ibead) + rp(:) = pos(:, iatom, ibead + 1) - pos(:, startatom, ibead + 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO END DO ! ending atom DO iatom = 1, helium%atoms - DO ibead = 1, endbead-1 - r(:) = pos(:, iatom, ibead)-pos(:, endatom, ibead) - rp(:) = pos(:, iatom, ibead+1)-pos(:, endatom, ibead+1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + DO ibead = 1, endbead - 1 + r(:) = pos(:, iatom, ibead) - pos(:, endatom, ibead) + rp(:) = pos(:, iatom, ibead + 1) - pos(:, endatom, ibead + 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO END DO @@ -3369,21 +3369,21 @@ REAL(KIND=dp) FUNCTION worm_path_action_worm_corrected(helium, pos, & DO iatom = 1, helium%atoms IF (iatom == endatom) CYCLE IF (iatom == worm_atom_idx) CYCLE - r(:) = pos(:, helium%iperm(iatom), helium%beads)-pos(:, startatom, helium%beads) - rp(:) = pos(:, iatom, 1)-pos(:, endatom, 1) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = pos(:, helium%iperm(iatom), helium%beads) - pos(:, startatom, helium%beads) + rp(:) = pos(:, iatom, 1) - pos(:, endatom, 1) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO ! add pair action with worm - r(:) = pos(:, startatom, helium%beads)-pos(:, helium%iperm(worm_atom_idx), helium%beads) - rp(:) = pos(:, endatom, 1)-xtrapos(:) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = pos(:, startatom, helium%beads) - pos(:, helium%iperm(worm_atom_idx), helium%beads) + rp(:) = pos(:, endatom, 1) - xtrapos(:) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) ELSE ! worm intersection DO iatom = 1, helium%atoms IF (iatom == endatom) CYCLE - r(:) = pos(:, helium%iperm(iatom), helium%beads)-pos(:, startatom, helium%beads) - rp(:) = pos(:, iatom, 1)-xtrapos(:) - partaction = partaction+helium_eval_expansion(helium, r, rp, helium%uij, 1) + r(:) = pos(:, helium%iperm(iatom), helium%beads) - pos(:, startatom, helium%beads) + rp(:) = pos(:, iatom, 1) - xtrapos(:) + partaction = partaction + helium_eval_expansion(helium, r, rp, helium%uij, 1) END DO END IF END IF @@ -3427,26 +3427,26 @@ REAL(KIND=dp) FUNCTION worm_path_inter_action(pint_env, helium, pos, & ! interaction is only beadwise due to primitive coupling ! startatom and endatom are the same - DO ibead = startbead+1, endbead-1 + DO ibead = startbead + 1, endbead - 1 CALL helium_bead_solute_e_f(pint_env, helium, & startatom, ibead, pos(:, startatom, ibead), energy=energy) - partaction = partaction+energy + partaction = partaction + energy END DO ELSE !(startbead > endbead) ! interaction is only beadwise due to primitive coupling ! startatom and endatom are different - DO ibead = startbead+1, helium%beads + DO ibead = startbead + 1, helium%beads CALL helium_bead_solute_e_f(pint_env, helium, & startatom, ibead, pos(:, startatom, ibead), energy=energy) - partaction = partaction+energy + partaction = partaction + energy END DO ! second atom after imaginary time wrap - DO ibead = 1, endbead-1 + DO ibead = 1, endbead - 1 CALL helium_bead_solute_e_f(pint_env, helium, & endatom, ibead, pos(:, endatom, ibead), energy=energy) - partaction = partaction+energy + partaction = partaction + energy END DO END IF @@ -3488,28 +3488,28 @@ REAL(KIND=dp) FUNCTION worm_path_inter_action_head(pint_env, helium, pos, & ! helium interaction with the solute ! if coordinates are not wrapping IF (startbead < worm_bead_idx) THEN - DO ibead = startbead+1, worm_bead_idx-1 + DO ibead = startbead + 1, worm_bead_idx - 1 CALL helium_bead_solute_e_f(pint_env, helium, & startatom, ibead, pos(:, startatom, ibead), energy=energy) - partaction = partaction+energy + partaction = partaction + energy END DO CALL helium_bead_solute_e_f(pint_env, helium, & startatom, ibead, xtrapos, energy=energy) - partaction = partaction+0.5_dp*energy + partaction = partaction + 0.5_dp*energy ELSE !(startbead > worm_bead_idx) - DO ibead = startbead+1, helium%beads + DO ibead = startbead + 1, helium%beads CALL helium_bead_solute_e_f(pint_env, helium, & startatom, ibead, pos(:, startatom, ibead), energy=energy) - partaction = partaction+energy + partaction = partaction + energy END DO - DO ibead = 1, worm_bead_idx-1 + DO ibead = 1, worm_bead_idx - 1 CALL helium_bead_solute_e_f(pint_env, helium, & worm_atom_idx, ibead, pos(:, worm_atom_idx, ibead), energy=energy) - partaction = partaction+energy + partaction = partaction + energy END DO CALL helium_bead_solute_e_f(pint_env, helium, & worm_atom_idx, ibead, xtrapos, energy=energy) - partaction = partaction+0.5_dp*energy + partaction = partaction + 0.5_dp*energy END IF partaction = partaction*helium%tau @@ -3550,25 +3550,25 @@ REAL(KIND=dp) FUNCTION worm_path_inter_action_tail(pint_env, helium, pos, & IF (worm_bead_idx < endbead) THEN CALL helium_bead_solute_e_f(pint_env, helium, & worm_atom_idx, worm_bead_idx, pos(:, worm_atom_idx, worm_bead_idx), energy=energy) - partaction = partaction+0.5_dp*energy - DO ibead = worm_bead_idx+1, endbead-1 + partaction = partaction + 0.5_dp*energy + DO ibead = worm_bead_idx + 1, endbead - 1 CALL helium_bead_solute_e_f(pint_env, helium, & endatom, ibead, pos(:, endatom, ibead), energy=energy) - partaction = partaction+energy + partaction = partaction + energy END DO ELSE !(worm_bead_idx > endbead) CALL helium_bead_solute_e_f(pint_env, helium, & worm_atom_idx, worm_bead_idx, pos(:, worm_atom_idx, worm_bead_idx), energy=energy) - partaction = partaction+0.5_dp*energy - DO ibead = worm_bead_idx+1, helium%beads + partaction = partaction + 0.5_dp*energy + DO ibead = worm_bead_idx + 1, helium%beads CALL helium_bead_solute_e_f(pint_env, helium, & worm_atom_idx, ibead, pos(:, worm_atom_idx, ibead), energy=energy) - partaction = partaction+energy + partaction = partaction + energy END DO - DO ibead = 1, endbead-1 + DO ibead = 1, endbead - 1 CALL helium_bead_solute_e_f(pint_env, helium, & endatom, ibead, pos(:, endatom, ibead), energy=energy) - partaction = partaction+energy + partaction = partaction + energy END DO END IF diff --git a/src/motion/input_cp2k_md.F b/src/motion/input_cp2k_md.F index 7527520fb3..d2aa83d797 100644 --- a/src/motion/input_cp2k_md.F +++ b/src/motion/input_cp2k_md.F @@ -1180,7 +1180,7 @@ SUBROUTINE create_avgs_section(section) CALL cp_print_key_section_create(print_key, __LOCATION__, "PRINT_AVERAGES", & description="Controls the output the averaged quantities", & - print_level=debug_print_level+1, common_iter_levels=1, & + print_level=debug_print_level + 1, common_iter_levels=1, & filename="") CALL section_add_subsection(section, print_key) CALL section_release(print_key) diff --git a/src/motion/input_cp2k_restarts.F b/src/motion/input_cp2k_restarts.F index 56fed70593..9394311117 100644 --- a/src/motion/input_cp2k_restarts.F +++ b/src/motion/input_cp2k_restarts.F @@ -256,7 +256,7 @@ SUBROUTINE update_subsys_release(md_env, force_env, root_section) IF (.NOT. explicit) CYCLE ! Nothing to update... my_force_b => my_force_env - IF (iforce_eval > 1) my_force_b => my_force_env%sub_force_env(iforce_eval-1)%force_env + IF (iforce_eval > 1) my_force_b => my_force_env%sub_force_env(iforce_eval - 1)%force_env CALL force_env_get(my_force_b, subsys=subsys) @@ -664,7 +664,7 @@ SUBROUTINE update_motion(motion_section, md_env, force_env, logger, & ! SAVE THERMOSTAT target TEMPERATURE when doing TEMPERATURE_ANNEALING IF (PRESENT(md_env)) THEN IF (ASSOCIATED(simpar)) THEN - IF (simpar%temperature_annealing .AND. ABS(1._dp-simpar%f_temperature_annealing) > 1.E-10_dp) THEN + IF (simpar%temperature_annealing .AND. ABS(1._dp - simpar%f_temperature_annealing) > 1.E-10_dp) THEN CALL section_vals_val_set(motion_section, "MD%TEMPERATURE", r_val=simpar%temp_ext) END IF END IF @@ -712,7 +712,7 @@ SUBROUTINE update_motion(motion_section, md_env, force_env, logger, & counter = 0 DO i = 1, SIZE(nhc%nvt, 1) DO j = 1, SIZE(nhc%nvt, 2) - counter = counter+1 + counter = counter + 1 eta(counter) = nhc%nvt(i, j)%eta veta(counter) = nhc%nvt(i, j)%v fnhc(counter) = nhc%nvt(i, j)%f @@ -737,7 +737,7 @@ SUBROUTINE update_motion(motion_section, md_env, force_env, logger, & counter = 0 DO i = 1, SIZE(npt, 1) DO j = 1, SIZE(npt, 2) - counter = counter+1 + counter = counter + 1 veta(counter) = npt(i, j)%v mnhc(counter) = npt(i, j)%mass END DO @@ -937,7 +937,7 @@ SUBROUTINE update_motion_pint(motion_section, pint_env) DO iatom = 1, pint_env%ndim DO ibead = 1, pint_env%p r_vals(i) = pint_env%x(ibead, iatom) - i = i+1 + i = i + 1 END DO END DO CALL section_vals_val_set(pint_section, "BEADS%COORD%_DEFAULT_KEYWORD_", & @@ -951,7 +951,7 @@ SUBROUTINE update_motion_pint(motion_section, pint_env) DO iatom = 1, pint_env%ndim DO ibead = 1, pint_env%p r_vals(i) = pint_env%v(ibead, iatom) - i = i+1 + i = i + 1 END DO END DO CALL section_vals_val_set(pint_section, "BEADS%VELOCITY%_DEFAULT_KEYWORD_", & @@ -977,7 +977,7 @@ SUBROUTINE update_motion_pint(motion_section, pint_env) DO ibead = 1, pint_env%p DO inos = 1, pint_env%nnos r_vals(i) = pint_env%tx(inos, ibead, iatom) - i = i+1 + i = i + 1 END DO END DO END DO @@ -992,7 +992,7 @@ SUBROUTINE update_motion_pint(motion_section, pint_env) DO ibead = 1, pint_env%p DO inos = 1, pint_env%nnos r_vals(i) = pint_env%tv(inos, ibead, iatom) - i = i+1 + i = i + 1 END DO END DO END DO @@ -1030,14 +1030,14 @@ SUBROUTINE update_motion_pint(motion_section, pint_env) ascii=ascii) ! update thermostat velocities in the global input structure NULLIFY (r_vals) - ALLOCATE (r_vals((pint_env%piglet_therm%nsp1-1)* & + ALLOCATE (r_vals((pint_env%piglet_therm%nsp1 - 1)* & pint_env%piglet_therm%ndim* & pint_env%piglet_therm%p)) i = 1 DO isp = 2, pint_env%piglet_therm%nsp1 DO ibead = 1, pint_env%piglet_therm%p*pint_env%piglet_therm%ndim r_vals(i) = pint_env%piglet_therm%smalls(isp, ibead) - i = i+1 + i = i + 1 END DO END DO CALL section_vals_val_set(pint_section, "PIGLET%EXTRA_DOF%_DEFAULT_KEYWORD_", & @@ -1087,7 +1087,7 @@ SUBROUTINE update_motion_helium(helium_env) ! determine offset for arrays offset = 0 DO i = 1, logger%para_env%mepos - offset = offset+helium_env(1)%env_all(i) + offset = offset + helium_env(1)%env_all(i) END DO IF (.NOT. helium_env(1)%helium%solute_present) THEN @@ -1144,7 +1144,7 @@ SUBROUTINE update_motion_helium(helium_env) ! pass the message from all processors to logger%para_env%source int_msg_gather(:) = 0 DO i = 1, SIZE(helium_env) - int_msg_gather((offset+i-1)*msglen+1:(offset+i)*msglen) = helium_env(i)%helium%permutation + int_msg_gather((offset + i - 1)*msglen + 1:(offset + i)*msglen) = helium_env(i)%helium%permutation END DO CALL mp_sum(int_msg_gather, helium_env(1)%comm) @@ -1165,9 +1165,9 @@ SUBROUTINE update_motion_helium(helium_env) ! update the weighting factor itmp = helium_env(1)%helium%averages_iweight IF (itmp .LT. 0) THEN - itmp = helium_env(1)%helium%current_step-helium_env(1)%helium%first_step + itmp = helium_env(1)%helium%current_step - helium_env(1)%helium%first_step ELSE - itmp = itmp+helium_env(1)%helium%current_step-helium_env(1)%helium%first_step + itmp = itmp + helium_env(1)%helium%current_step - helium_env(1)%helium%first_step END IF DO i = 1, SIZE(helium_env) CALL section_vals_val_set(helium_env(i)%helium%input, & @@ -1183,7 +1183,7 @@ SUBROUTINE update_motion_helium(helium_env) real_msg_gather(:) = 0.0_dp ! gather projected area from all processors DO i = 1, SIZE(helium_env) - real_msg_gather((i-1+offset)*msglen+1:(i+offset)*msglen) = helium_env(i)%helium%proarea%ravr(:) + real_msg_gather((i - 1 + offset)*msglen + 1:(i + offset)*msglen) = helium_env(i)%helium%proarea%ravr(:) END DO CALL mp_sum(real_msg_gather, helium_env(1)%comm) @@ -1200,7 +1200,7 @@ SUBROUTINE update_motion_helium(helium_env) real_msg_gather(:) = 0.0_dp ! gather projected area squared from all processors DO i = 1, SIZE(helium_env) - real_msg_gather((i-1+offset)*msglen+1:(i+offset)*msglen) = helium_env(i)%helium%prarea2%ravr(:) + real_msg_gather((i - 1 + offset)*msglen + 1:(i + offset)*msglen) = helium_env(i)%helium%prarea2%ravr(:) END DO CALL mp_sum(real_msg_gather, helium_env(1)%comm) @@ -1217,7 +1217,7 @@ SUBROUTINE update_motion_helium(helium_env) real_msg_gather(:) = 0.0_dp ! gather winding number squared from all processors DO i = 1, SIZE(helium_env) - real_msg_gather((i-1+offset)*msglen+1:(i+offset)*msglen) = helium_env(i)%helium%wnmber2%ravr(:) + real_msg_gather((i - 1 + offset)*msglen + 1:(i + offset)*msglen) = helium_env(i)%helium%wnmber2%ravr(:) END DO CALL mp_sum(real_msg_gather, helium_env(1)%comm) @@ -1234,7 +1234,7 @@ SUBROUTINE update_motion_helium(helium_env) real_msg_gather(:) = 0.0_dp ! gather moment of inertia from all processors DO i = 1, SIZE(helium_env) - real_msg_gather((i-1+offset)*msglen+1:(i+offset)*msglen) = helium_env(i)%helium%mominer%ravr(:) + real_msg_gather((i - 1 + offset)*msglen + 1:(i + offset)*msglen) = helium_env(i)%helium%mominer%ravr(:) END DO CALL mp_sum(real_msg_gather, helium_env(1)%comm) @@ -1264,31 +1264,31 @@ SUBROUTINE update_motion_helium(helium_env) CALL get_rng_stream(helium_env(i)%helium%rng_stream_uniform, bg=bg, cg=cg, ig=ig, & buffer=bu, buffer_filled=lbf) off = 0 - real_msg(off+1:off+6) = PACK(bg, .TRUE.) - real_msg(off+7:off+12) = PACK(cg, .TRUE.) - real_msg(off+13:off+18) = PACK(ig, .TRUE.) + real_msg(off + 1:off + 6) = PACK(bg, .TRUE.) + real_msg(off + 7:off + 12) = PACK(cg, .TRUE.) + real_msg(off + 13:off + 18) = PACK(ig, .TRUE.) IF (lbf) THEN bf = 1.0_dp ELSE bf = -1.0_dp END IF - real_msg(off+19) = bf - real_msg(off+20) = bu + real_msg(off + 19) = bf + real_msg(off + 20) = bu CALL get_rng_stream(helium_env(i)%helium%rng_stream_gaussian, bg=bg, cg=cg, ig=ig, & buffer=bu, buffer_filled=lbf) off = 20 - real_msg(off+1:off+6) = PACK(bg, .TRUE.) - real_msg(off+7:off+12) = PACK(cg, .TRUE.) - real_msg(off+13:off+18) = PACK(ig, .TRUE.) + real_msg(off + 1:off + 6) = PACK(bg, .TRUE.) + real_msg(off + 7:off + 12) = PACK(cg, .TRUE.) + real_msg(off + 13:off + 18) = PACK(ig, .TRUE.) IF (lbf) THEN bf = 1.0_dp ELSE bf = -1.0_dp END IF - real_msg(off+19) = bf - real_msg(off+20) = bu + real_msg(off + 19) = bf + real_msg(off + 20) = bu - real_msg_gather((offset+i-1)*msglen+1:(offset+i)*msglen) = real_msg(:) + real_msg_gather((offset + i - 1)*msglen + 1:(offset + i)*msglen) = real_msg(:) END DO ! Gather RNG state (in real_msg_gather vector) from all processors at @@ -1352,7 +1352,7 @@ SUBROUTINE update_motion_helium(helium_env) ! work on the temporary array so that accumulated data remains intact helium_env(1)%helium%rdf_inst(:, :) = 0.0_dp DO i = 1, SIZE(helium_env) - helium_env(1)%helium%rdf_inst(:, :) = helium_env(1)%helium%rdf_inst(:, :)+ & + helium_env(1)%helium%rdf_inst(:, :) = helium_env(1)%helium%rdf_inst(:, :) + & helium_env(i)%helium%rdf_accu(:, :) END DO @@ -1362,13 +1362,13 @@ SUBROUTINE update_motion_helium(helium_env) invproc = 1.0_dp/REAL(itmp, dp) helium_env(1)%helium%rdf_inst(:, :) = helium_env(1)%helium%rdf_inst(:, :)*invproc - nsteps = helium_env(1)%helium%current_step-helium_env(1)%helium%first_step + nsteps = helium_env(1)%helium%current_step - helium_env(1)%helium%first_step helium_env(1)%helium%rdf_inst(:, :) = helium_env(1)%helium%rdf_inst(:, :)/REAL(nsteps, dp) iweight = helium_env(1)%helium%rdf_iweight ! average over the old and the current density (observe the weights!) - helium_env(1)%helium%rdf_inst(:, :) = nsteps*helium_env(1)%helium%rdf_inst(:, :)+ & + helium_env(1)%helium%rdf_inst(:, :) = nsteps*helium_env(1)%helium%rdf_inst(:, :) + & iweight*helium_env(1)%helium%rdf_rstr(:, :) - helium_env(1)%helium%rdf_inst(:, :) = helium_env(1)%helium%rdf_inst(:, :)/REAL(nsteps+iweight, dp) + helium_env(1)%helium%rdf_inst(:, :) = helium_env(1)%helium%rdf_inst(:, :)/REAL(nsteps + iweight, dp) ! update in the global input structure NULLIFY (real_msg) msglen = SIZE(helium_env(1)%helium%rdf_inst) @@ -1390,7 +1390,7 @@ SUBROUTINE update_motion_helium(helium_env) ! work on the temporary array so that accumulated data remains intact helium_env(1)%helium%rho_inst(:, :, :, :) = 0.0_dp DO i = 1, SIZE(helium_env) - helium_env(1)%helium%rho_inst(:, :, :, :) = helium_env(1)%helium%rho_inst(:, :, :, :)+ & + helium_env(1)%helium%rho_inst(:, :, :, :) = helium_env(1)%helium%rho_inst(:, :, :, :) + & helium_env(i)%helium%rho_accu(:, :, :, :) END DO @@ -1400,13 +1400,13 @@ SUBROUTINE update_motion_helium(helium_env) invproc = 1.0_dp/REAL(itmp, dp) helium_env(1)%helium%rho_inst(:, :, :, :) = helium_env(1)%helium%rho_inst(:, :, :, :)*invproc - nsteps = helium_env(1)%helium%current_step-helium_env(1)%helium%first_step + nsteps = helium_env(1)%helium%current_step - helium_env(1)%helium%first_step helium_env(1)%helium%rho_inst(:, :, :, :) = helium_env(1)%helium%rho_inst(:, :, :, :)/REAL(nsteps, dp) iweight = helium_env(1)%helium%averages_iweight ! average over the old and the current density (observe the weights!) - helium_env(1)%helium%rho_inst(:, :, :, :) = nsteps*helium_env(1)%helium%rho_inst(:, :, :, :)+ & + helium_env(1)%helium%rho_inst(:, :, :, :) = nsteps*helium_env(1)%helium%rho_inst(:, :, :, :) + & iweight*helium_env(1)%helium%rho_rstr(:, :, :, :) - helium_env(1)%helium%rho_inst(:, :, :, :) = helium_env(1)%helium%rho_inst(:, :, :, :)/REAL(nsteps+iweight, dp) + helium_env(1)%helium%rho_inst(:, :, :, :) = helium_env(1)%helium%rho_inst(:, :, :, :)/REAL(nsteps + iweight, dp) ! update the densities in the global input structure NULLIFY (real_msg) @@ -1710,12 +1710,12 @@ SUBROUTINE dump_gle_restart_info(gle, para_env, gle_section) DO iproc = 1, para_env%num_pe CALL reallocate(work, 1, gle_per_proc(iproc)*(gle%ndim)) CALL reallocate(index, 1, gle_per_proc(iproc)) - IF (para_env%mepos == (iproc-1)) THEN + IF (para_env%mepos == (iproc - 1)) THEN INDEX(:) = 0 counter = 0 DO i = 1, gle%ndim DO j = 1, gle%loc_num_gle - counter = counter+1 + counter = counter + 1 work(counter) = gle%nvt(j)%s(i) INDEX(j) = gle%map_info%index(j) END DO @@ -1723,13 +1723,13 @@ SUBROUTINE dump_gle_restart_info(gle, para_env, gle_section) ELSE work(:) = 0.0_dp END IF - CALL mp_bcast(work, iproc-1, para_env%group) - CALL mp_bcast(index, iproc-1, para_env%group) + CALL mp_bcast(work, iproc - 1, para_env%group) + CALL mp_bcast(index, iproc - 1, para_env%group) counter = 0 DO i = 1, gle%ndim DO j = 1, gle_per_proc(iproc) - counter = counter+1 - s_tmp((INDEX(j)-1)*(gle%ndim)+i) = work(counter) + counter = counter + 1 + s_tmp((INDEX(j) - 1)*(gle%ndim) + i) = work(counter) END DO END DO END DO @@ -1793,12 +1793,12 @@ SUBROUTINE collect_nose_restart_info(nhc, para_env, eta, veta, fnhc, mnhc) DO iproc = 1, para_env%num_pe CALL reallocate(work, 1, nhc_per_proc(iproc)*nhc_len) CALL reallocate(index, 1, nhc_per_proc(iproc)) - IF (para_env%mepos == (iproc-1)) THEN + IF (para_env%mepos == (iproc - 1)) THEN INDEX(:) = 0 counter = 0 DO i = 1, nhc_len DO j = 1, num_nhc - counter = counter+1 + counter = counter + 1 work(counter) = nhc%nvt(i, j)%eta INDEX(j) = map_info%index(j) END DO @@ -1806,13 +1806,13 @@ SUBROUTINE collect_nose_restart_info(nhc, para_env, eta, veta, fnhc, mnhc) ELSE work(:) = 0.0_dp END IF - CALL mp_bcast(work, iproc-1, para_env%group) - CALL mp_bcast(index, iproc-1, para_env%group) + CALL mp_bcast(work, iproc - 1, para_env%group) + CALL mp_bcast(index, iproc - 1, para_env%group) counter = 0 DO i = 1, nhc_len DO j = 1, nhc_per_proc(iproc) - counter = counter+1 - eta((INDEX(j)-1)*nhc_len+i) = work(counter) + counter = counter + 1 + eta((INDEX(j) - 1)*nhc_len + i) = work(counter) END DO END DO END DO @@ -1824,12 +1824,12 @@ SUBROUTINE collect_nose_restart_info(nhc, para_env, eta, veta, fnhc, mnhc) DO iproc = 1, para_env%num_pe CALL reallocate(work, 1, nhc_per_proc(iproc)*nhc_len) CALL reallocate(index, 1, nhc_per_proc(iproc)) - IF (para_env%mepos == (iproc-1)) THEN + IF (para_env%mepos == (iproc - 1)) THEN INDEX(:) = 0 counter = 0 DO i = 1, nhc_len DO j = 1, num_nhc - counter = counter+1 + counter = counter + 1 work(counter) = nhc%nvt(i, j)%v INDEX(j) = map_info%index(j) END DO @@ -1837,13 +1837,13 @@ SUBROUTINE collect_nose_restart_info(nhc, para_env, eta, veta, fnhc, mnhc) ELSE work(:) = 0.0_dp END IF - CALL mp_bcast(work, iproc-1, para_env%group) - CALL mp_bcast(index, iproc-1, para_env%group) + CALL mp_bcast(work, iproc - 1, para_env%group) + CALL mp_bcast(index, iproc - 1, para_env%group) counter = 0 DO i = 1, nhc_len DO j = 1, nhc_per_proc(iproc) - counter = counter+1 - veta((INDEX(j)-1)*nhc_len+i) = work(counter) + counter = counter + 1 + veta((INDEX(j) - 1)*nhc_len + i) = work(counter) END DO END DO END DO @@ -1855,12 +1855,12 @@ SUBROUTINE collect_nose_restart_info(nhc, para_env, eta, veta, fnhc, mnhc) DO iproc = 1, para_env%num_pe CALL reallocate(work, 1, nhc_per_proc(iproc)*nhc_len) CALL reallocate(index, 1, nhc_per_proc(iproc)) - IF (para_env%mepos == (iproc-1)) THEN + IF (para_env%mepos == (iproc - 1)) THEN INDEX(:) = 0 counter = 0 DO i = 1, nhc_len DO j = 1, num_nhc - counter = counter+1 + counter = counter + 1 work(counter) = nhc%nvt(i, j)%f INDEX(j) = map_info%index(j) END DO @@ -1868,13 +1868,13 @@ SUBROUTINE collect_nose_restart_info(nhc, para_env, eta, veta, fnhc, mnhc) ELSE work(:) = 0.0_dp END IF - CALL mp_bcast(work, iproc-1, para_env%group) - CALL mp_bcast(index, iproc-1, para_env%group) + CALL mp_bcast(work, iproc - 1, para_env%group) + CALL mp_bcast(index, iproc - 1, para_env%group) counter = 0 DO i = 1, nhc_len DO j = 1, nhc_per_proc(iproc) - counter = counter+1 - fnhc((INDEX(j)-1)*nhc_len+i) = work(counter) + counter = counter + 1 + fnhc((INDEX(j) - 1)*nhc_len + i) = work(counter) END DO END DO END DO @@ -1886,12 +1886,12 @@ SUBROUTINE collect_nose_restart_info(nhc, para_env, eta, veta, fnhc, mnhc) DO iproc = 1, para_env%num_pe CALL reallocate(work, 1, nhc_per_proc(iproc)*nhc_len) CALL reallocate(index, 1, nhc_per_proc(iproc)) - IF (para_env%mepos == (iproc-1)) THEN + IF (para_env%mepos == (iproc - 1)) THEN INDEX(:) = 0 counter = 0 DO i = 1, nhc_len DO j = 1, num_nhc - counter = counter+1 + counter = counter + 1 work(counter) = nhc%nvt(i, j)%mass INDEX(j) = map_info%index(j) END DO @@ -1899,13 +1899,13 @@ SUBROUTINE collect_nose_restart_info(nhc, para_env, eta, veta, fnhc, mnhc) ELSE work(:) = 0.0_dp END IF - CALL mp_bcast(work, iproc-1, para_env%group) - CALL mp_bcast(index, iproc-1, para_env%group) + CALL mp_bcast(work, iproc - 1, para_env%group) + CALL mp_bcast(index, iproc - 1, para_env%group) counter = 0 DO i = 1, nhc_len DO j = 1, nhc_per_proc(iproc) - counter = counter+1 - mnhc((INDEX(j)-1)*nhc_len+i) = work(counter) + counter = counter + 1 + mnhc((INDEX(j) - 1)*nhc_len + i) = work(counter) END DO END DO END DO @@ -2466,7 +2466,7 @@ SUBROUTINE write_binary_restart(output_unit, log_unit, root_section, md_env, for "Number of molecules", nmolecule END IF - n_int_size = n_int_size+6 + n_int_size = n_int_size + 6 END IF WRITE (UNIT=output_unit, IOSTAT=istat) & @@ -2483,7 +2483,7 @@ SUBROUTINE write_binary_restart(output_unit, log_unit, root_section, md_env, for IF (istat /= 0) CALL stop_write("atomic_kinds%els(ikind)%name "// & "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) - n_char_size = n_char_size+LEN(atomic_kinds%els(ikind)%name) + n_char_size = n_char_size + LEN(atomic_kinds%els(ikind)%name) END DO ! Write atomic kind numbers of all atoms @@ -2495,7 +2495,7 @@ SUBROUTINE write_binary_restart(output_unit, log_unit, root_section, md_env, for IF (istat /= 0) CALL stop_write("ibuf(1:natom) -> atomic kind numbers "// & "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) - n_int_size = n_int_size+natom + n_int_size = n_int_size + natom ! Write atomic coordinates ALLOCATE (rbuf(3, natom)) DO iatom = 1, natom @@ -2505,7 +2505,7 @@ SUBROUTINE write_binary_restart(output_unit, log_unit, root_section, md_env, for IF (istat /= 0) CALL stop_write("rbuf(1:3,1:natom) -> atomic coordinates "// & "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) - n_dp_size = n_dp_size+3*natom + n_dp_size = n_dp_size + 3*natom DEALLOCATE (rbuf) ! Write molecule information if available @@ -2516,7 +2516,7 @@ SUBROUTINE write_binary_restart(output_unit, log_unit, root_section, md_env, for IF (istat /= 0) CALL stop_write("molecule_kinds%els(ikind)%name "// & "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) - n_char_size = n_char_size+LEN(molecule_kinds%els(ikind)%name) + n_char_size = n_char_size + LEN(molecule_kinds%els(ikind)%name) END DO ! Write molecule (kind) index numbers for all atoms ibuf(:) = 0 @@ -2535,13 +2535,13 @@ SUBROUTINE write_binary_restart(output_unit, log_unit, root_section, md_env, for IF (istat /= 0) CALL stop_write("ibuf(1:natom) -> molecule kind index numbers "// & "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) - n_int_size = n_int_size+natom + n_int_size = n_int_size + natom ! Write molecule index number for each atom WRITE (UNIT=output_unit, IOSTAT=istat) imol(1:natom) IF (istat /= 0) CALL stop_write("imol(1:natom) -> molecule index numbers "// & "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) - n_int_size = n_int_size+natom + n_int_size = n_int_size + natom DEALLOCATE (imol) END IF ! molecules @@ -2553,8 +2553,8 @@ SUBROUTINE write_binary_restart(output_unit, log_unit, root_section, md_env, for IF (istat /= 0) CALL stop_write("section_label, nshell "// & "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) - n_char_size = n_char_size+LEN(section_label) - n_int_size = n_int_size+1 + n_char_size = n_char_size + LEN(section_label) + n_int_size = n_int_size + 1 IF (nshell > 0) THEN ! Write shell coordinates ALLOCATE (rbuf(3, nshell)) @@ -2565,7 +2565,7 @@ SUBROUTINE write_binary_restart(output_unit, log_unit, root_section, md_env, for IF (istat /= 0) CALL stop_write("rbuf(1:3,1:nshell) -> shell coordinates "// & "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) - n_dp_size = n_dp_size+3*nshell + n_dp_size = n_dp_size + 3*nshell DEALLOCATE (rbuf) ! Write atomic indices, i.e. number of the atom the shell belongs to ALLOCATE (ibuf(nshell)) @@ -2576,7 +2576,7 @@ SUBROUTINE write_binary_restart(output_unit, log_unit, root_section, md_env, for IF (istat /= 0) CALL stop_write("ibuf(1:nshell) -> atomic indices "// & "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) - n_int_size = n_int_size+nshell + n_int_size = n_int_size + nshell DEALLOCATE (ibuf) END IF @@ -2585,8 +2585,8 @@ SUBROUTINE write_binary_restart(output_unit, log_unit, root_section, md_env, for IF (istat /= 0) CALL stop_write("section_label, ncore "// & "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) - n_char_size = n_char_size+LEN(section_label) - n_int_size = n_int_size+1 + n_char_size = n_char_size + LEN(section_label) + n_int_size = n_int_size + 1 IF (ncore > 0) THEN ! Write core coordinates ALLOCATE (rbuf(3, ncore)) @@ -2597,7 +2597,7 @@ SUBROUTINE write_binary_restart(output_unit, log_unit, root_section, md_env, for IF (istat /= 0) CALL stop_write("rbuf(1:3,1:ncore) -> core coordinates "// & "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) - n_dp_size = n_dp_size+3*ncore + n_dp_size = n_dp_size + 3*ncore DEALLOCATE (rbuf) ! Write atomic indices, i.e. number of the atom the core belongs to ALLOCATE (ibuf(ncore)) @@ -2608,7 +2608,7 @@ SUBROUTINE write_binary_restart(output_unit, log_unit, root_section, md_env, for IF (istat /= 0) CALL stop_write("ibuf(1:ncore) -> atomic indices "// & "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) - n_int_size = n_int_size+ncore + n_int_size = n_int_size + ncore DEALLOCATE (ibuf) END IF END IF ! ionode only @@ -2633,8 +2633,8 @@ SUBROUTINE write_binary_restart(output_unit, log_unit, root_section, md_env, for "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) ENDIF - n_char_size = n_char_size+LEN(section_label) - n_int_size = n_int_size+1 + n_char_size = n_char_size + LEN(section_label) + n_int_size = n_int_size + 1 IF (output_unit > 0 .AND. log_unit > 0) THEN ! only ionode IF (print_info) THEN WRITE (UNIT=log_unit, FMT="(T3,A,T71,I10)") & @@ -2661,8 +2661,8 @@ SUBROUTINE write_binary_restart(output_unit, log_unit, root_section, md_env, for "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) ENDIF - n_char_size = n_char_size+LEN(section_label) - n_int_size = n_int_size+1 + n_char_size = n_char_size + LEN(section_label) + n_int_size = n_int_size + 1 IF (output_unit > 0 .AND. log_unit > 0) THEN ! only ionode IF (print_info) THEN WRITE (UNIT=log_unit, FMT="(T3,A,T71,I10)") & @@ -2682,8 +2682,8 @@ SUBROUTINE write_binary_restart(output_unit, log_unit, root_section, md_env, for "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) ENDIF - n_char_size = n_char_size+LEN(section_label) - n_int_size = n_int_size+1 + n_char_size = n_char_size + LEN(section_label) + n_int_size = n_int_size + 1 IF (print_info .AND. log_unit > 0) THEN WRITE (UNIT=log_unit, FMT="(T3,A,T78,A3)") & "Write "//TRIM(ADJUSTL(section_label))//" section", MERGE("YES", " NO", write_velocities) @@ -2698,7 +2698,7 @@ SUBROUTINE write_binary_restart(output_unit, log_unit, root_section, md_env, for IF (istat /= 0) CALL stop_write("rbuf(1:3,1:natom) -> atomic velocities "// & "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) - n_dp_size = n_dp_size+3*natom + n_dp_size = n_dp_size + 3*natom DEALLOCATE (rbuf) END IF ! Write shell velocities @@ -2707,8 +2707,8 @@ SUBROUTINE write_binary_restart(output_unit, log_unit, root_section, md_env, for IF (istat /= 0) CALL stop_write(TRIM(section_label)//", write_velocities "// & "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) - n_char_size = n_char_size+LEN(section_label) - n_int_size = n_int_size+1 + n_char_size = n_char_size + LEN(section_label) + n_int_size = n_int_size + 1 IF (print_info .AND. log_unit > 0) THEN WRITE (UNIT=log_unit, FMT="(T3,A,T78,A3)") & "Write "//TRIM(ADJUSTL(section_label))//" section", MERGE("YES", " NO", write_velocities) @@ -2723,7 +2723,7 @@ SUBROUTINE write_binary_restart(output_unit, log_unit, root_section, md_env, for IF (istat /= 0) CALL stop_write("rbuf(1:3,1:nshell) -> shell velocities "// & "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) - n_dp_size = n_dp_size+3*nshell + n_dp_size = n_dp_size + 3*nshell DEALLOCATE (rbuf) END IF END IF @@ -2733,8 +2733,8 @@ SUBROUTINE write_binary_restart(output_unit, log_unit, root_section, md_env, for IF (istat /= 0) CALL stop_write(TRIM(section_label)//", write_velocities "// & "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) - n_char_size = n_char_size+LEN(section_label) - n_int_size = n_int_size+1 + n_char_size = n_char_size + LEN(section_label) + n_int_size = n_int_size + 1 IF (print_info .AND. log_unit > 0) THEN WRITE (UNIT=log_unit, FMT="(T3,A,T78,A3)") & "Write "//TRIM(ADJUSTL(section_label))//" section", MERGE("YES", " NO", write_velocities) @@ -2749,7 +2749,7 @@ SUBROUTINE write_binary_restart(output_unit, log_unit, root_section, md_env, for IF (istat /= 0) CALL stop_write("rbuf(1:3,1:ncore) -> core velocities "// & "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) - n_dp_size = n_dp_size+3*ncore + n_dp_size = n_dp_size + 3*ncore DEALLOCATE (rbuf) END IF END IF @@ -2821,8 +2821,8 @@ SUBROUTINE write_binary_thermostats_nose(nhc, output_unit, log_unit, section_lab IF (istat /= 0) CALL stop_write("nhc_size "// & "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) - n_char_size = n_char_size+LEN(section_label) - n_int_size = n_int_size+1 + n_char_size = n_char_size + LEN(section_label) + n_int_size = n_int_size + 1 IF (print_info .AND. log_unit > 0) THEN WRITE (UNIT=log_unit, FMT="(T3,A,T71,I10)") & "NHC size ("//TRIM(ADJUSTL(section_label))//")", nhc_size @@ -2832,7 +2832,7 @@ SUBROUTINE write_binary_thermostats_nose(nhc, output_unit, log_unit, section_lab IF (istat /= 0) CALL stop_write("eta(1:nhc_size) "// & "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) - n_dp_size = n_dp_size+nhc_size + n_dp_size = n_dp_size + nhc_size END IF ! ionode only DEALLOCATE (eta) @@ -2843,7 +2843,7 @@ SUBROUTINE write_binary_thermostats_nose(nhc, output_unit, log_unit, section_lab IF (istat /= 0) CALL stop_write("veta(1:nhc_size) "// & "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) - n_dp_size = n_dp_size+nhc_size + n_dp_size = n_dp_size + nhc_size END IF ! ionode only DEALLOCATE (veta) @@ -2854,7 +2854,7 @@ SUBROUTINE write_binary_thermostats_nose(nhc, output_unit, log_unit, section_lab IF (istat /= 0) CALL stop_write("mnhc(1:nhc_size) "// & "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) - n_dp_size = n_dp_size+nhc_size + n_dp_size = n_dp_size + nhc_size END IF ! ionode only DEALLOCATE (mnhc) @@ -2865,7 +2865,7 @@ SUBROUTINE write_binary_thermostats_nose(nhc, output_unit, log_unit, section_lab IF (istat /= 0) CALL stop_write("fnhc(1:nhc_size) "// & "(IOSTAT = "//TRIM(ADJUSTL(cp_to_string(istat)))//")", & output_unit) - n_dp_size = n_dp_size+nhc_size + n_dp_size = n_dp_size + nhc_size END IF ! ionode only DEALLOCATE (fnhc) diff --git a/src/motion/integrator.F b/src/motion/integrator.F index f294ce3c13..4f0e38184c 100644 --- a/src/motion/integrator.F +++ b/src/motion/integrator.F @@ -100,15 +100,14 @@ MODULE integrator USE virial_types, ONLY: virial_type #include "../base/base_uses.f90" - IMPLICIT NONE + IMPLICIT NONE - PRIVATE + PRIVATE CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'integrator' - PUBLIC :: isokin, langevin, nve, nvt, npt_i, npt_f, nve_respa - PUBLIC :: nph_uniaxial_damped, nph_uniaxial, nvt_adiabatic, reftraj - + PUBLIC :: isokin, langevin, nve, nvt, npt_i, npt_f, nve_respa + PUBLIC :: nph_uniaxial_damped, nph_uniaxial, nvt_adiabatic, reftraj CONTAINS @@ -126,7 +125,7 @@ MODULE integrator !> (01.12.2013, LT) !> \author Matthias Krack ! ************************************************************************************************** - SUBROUTINE langevin(md_env) + SUBROUTINE langevin(md_env) TYPE(md_environment_type), POINTER :: md_env @@ -161,219 +160,219 @@ SUBROUTINE langevin(md_env) TYPE(thermal_regions_type), POINTER :: thermal_regions TYPE(virial_type), POINTER :: virial - NULLIFY(cell, para_env, gci, force_env) - NULLIFY(atomic_kinds, local_particles,subsys,local_molecules,molecule_kinds,molecules) - NULLIFY(molecule_kind_set,molecule_set,particles,particle_set,rng_stream,simpar,virial) - NULLIFY(thermal_region, thermal_regions, itimes) - - CALL get_md_env(md_env=md_env, simpar=simpar, force_env=force_env,& - para_env=para_env, thermal_regions=thermal_regions, & - itimes=itimes) - - dt = simpar%dt - gam = simpar%gamma+simpar%shadow_gamma - nshell = 0 - - CALL force_env_get(force_env=force_env,subsys=subsys,cell=cell) - - ! Do some checks on coordinates and box - CALL apply_qmmm_walls_reflective(force_env) - - CALL cp_subsys_get(subsys=subsys,& - atomic_kinds=atomic_kinds,& - gci=gci,& - local_particles=local_particles,& - local_molecules=local_molecules,& - molecules=molecules,& - molecule_kinds=molecule_kinds,& - nshell=nshell,& - particles=particles,& - virial=virial) - IF(nshell /= 0)& - CPABORT("Langevin dynamics is not yet implemented for core-shell models") - - nparticle_kind = atomic_kinds%n_els - atomic_kind_set => atomic_kinds%els - molecule_kind_set => molecule_kinds%els - - nparticle = particles%n_els - particle_set => particles%els - molecule_set => molecules%els - - ! Setup the langevin regions information - ALLOCATE(do_langevin(nparticle)) - IF (simpar%do_thermal_region) THEN - DO iparticle = 1, nparticle - do_langevin(iparticle) = thermal_regions%do_langevin(iparticle) - END DO - ELSE - do_langevin(1:nparticle) = .TRUE. - END IF - - ! Allocate the temperature dependent variance (var_w) of the - ! random variable for each atom. It may be different for different - ! atoms because of the possiblity of Langevin regions, and var_w - ! for each region should depend on the temperature defined in the - ! region - ! RZK explains: sigma is the variance of the Wiener process associated - ! with the stochastic term, sigma = m*var_w = m*(2*k_B*T*gamma*dt), - ! noisy_gamma adds excessive noise that is not balanced by the damping term - ALLOCATE(var_w(nparticle)) - var_w(1:nparticle) = simpar%var_w - IF (simpar%do_thermal_region) THEN - DO ireg = 1, thermal_regions%nregions - thermal_region => thermal_regions%thermal_region(ireg) - noisy_gamma_region = thermal_region%noisy_gamma_region - DO iparticle_reg = 1, thermal_region%npart - iparticle = thermal_region%part_index(iparticle_reg) - reg_temp = thermal_region%temp_expected - var_w(iparticle) = 2.0_dp*reg_temp*simpar%dt*(simpar%gamma + noisy_gamma_region) - END DO - END DO - END IF - - ! Allocate work storage - ALLOCATE (pos(3,nparticle)) - pos(:,:) = 0.0_dp - - ALLOCATE (vel(3,nparticle)) - vel(:,:) = 0.0_dp - - ALLOCATE (w(3,nparticle)) - w(:,:) = 0.0_dp - - IF (simpar%constraint) CALL getold(gci,local_molecules,molecule_set,& - molecule_kind_set, particle_set,cell) - - ! Generate random variables - DO iparticle_kind=1,nparticle_kind - atomic_kind => atomic_kind_set(iparticle_kind) - CALL get_atomic_kind(atomic_kind=atomic_kind,mass=mass) - nparticle_local = local_particles%n_el(iparticle_kind) - DO iparticle_local=1,nparticle_local - iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) - IF (do_langevin(iparticle)) THEN - sigma = var_w(iparticle)*mass - rng_stream => local_particles%local_particle_set(iparticle_kind)%& - rng(iparticle_local)%stream - w(1,iparticle) = next_random_number(rng_stream,variance=sigma) - w(2,iparticle) = next_random_number(rng_stream,variance=sigma) - w(3,iparticle) = next_random_number(rng_stream,variance=sigma) - END IF - END DO - END DO - - DEALLOCATE(var_w) - - ! Apply fix atom constraint - CALL fix_atom_control(force_env,w) - - ! Velocity Verlet (first part) - c = EXP(-0.25_dp*dt*gam) - c2 = c*c - c4 = c2*c2 - c1 = dt*c2 - - DO iparticle_kind=1,nparticle_kind - atomic_kind => atomic_kind_set(iparticle_kind) - CALL get_atomic_kind(atomic_kind=atomic_kind,mass=mass) - nparticle_local = local_particles%n_el(iparticle_kind) - dm = 0.5_dp*dt/mass - c3 = dm/c2 - DO iparticle_local=1,nparticle_local - iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) - IF (do_langevin(iparticle)) THEN - vel(:,iparticle) = particle_set(iparticle)%v(:) +& - c3*particle_set(iparticle)%f(:) - pos(:,iparticle) = particle_set(iparticle)%r(:) +& - c1*particle_set(iparticle)%v(:) +& - c*dm*(dt*particle_set(iparticle)%f(:) +& - w(:,iparticle)) - ELSE - vel(:,iparticle) = particle_set(iparticle)%v(:) +& - dm*particle_set(iparticle)%f(:) - pos(:,iparticle) = particle_set(iparticle)%r(:) +& - dt*particle_set(iparticle)%v(:) +& - dm*dt*particle_set(iparticle)%f(:) - END IF - END DO - END DO - - IF (simpar%constraint) THEN - ! Possibly update the target values - CALL shake_update_targets(gci, local_molecules, molecule_set, & - molecule_kind_set, dt, force_env%root_section) - - CALL shake_control(gci,local_molecules,molecule_set,molecule_kind_set,& - particle_set,pos,vel,dt,simpar%shake_tol,& - simpar%info_constraint,simpar%lagrange_multipliers,& - simpar%dump_lm,cell,para_env%group,local_particles) - END IF - - ! Broadcast the new particle positions - CALL update_particle_set(particle_set,para_env%group,pos=pos) - - DEALLOCATE(pos) - - ! Update forces - CALL force_env_calc_energy_force(force_env) - - ! Metadynamics - CALL metadyn_integrator(force_env, itimes, vel) - - ! Update Verlet (second part) - DO iparticle_kind=1,nparticle_kind - atomic_kind => atomic_kind_set(iparticle_kind) - CALL get_atomic_kind(atomic_kind=atomic_kind,mass=mass) - dm = 0.5_dp*dt/mass - c3 = dm/c2 - nparticle_local = local_particles%n_el(iparticle_kind) - DO iparticle_local=1,nparticle_local - iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) - IF (do_langevin(iparticle)) THEN - vel(1,iparticle) = vel(1,iparticle) + c3*particle_set(iparticle)%f(1) - vel(2,iparticle) = vel(2,iparticle) + c3*particle_set(iparticle)%f(2) - vel(3,iparticle) = vel(3,iparticle) + c3*particle_set(iparticle)%f(3) - vel(1,iparticle) = c4*vel(1,iparticle) + c2*w(1,iparticle)/mass - vel(2,iparticle) = c4*vel(2,iparticle) + c2*w(2,iparticle)/mass - vel(3,iparticle) = c4*vel(3,iparticle) + c2*w(3,iparticle)/mass - ELSE - vel(1,iparticle) = vel(1,iparticle) + dm*particle_set(iparticle)%f(1) - vel(2,iparticle) = vel(2,iparticle) + dm*particle_set(iparticle)%f(2) - vel(3,iparticle) = vel(3,iparticle) + dm*particle_set(iparticle)%f(3) - END IF - END DO - END DO - - IF (simpar%temperature_annealing) THEN - simpar%temp_ext = simpar%temp_ext*simpar%f_temperature_annealing - simpar%var_w = simpar%var_w*simpar%f_temperature_annealing - END IF - - IF (simpar%constraint) THEN - CALL rattle_control(gci,local_molecules,molecule_set,molecule_kind_set,& - particle_set,vel,dt,simpar%shake_tol,& - simpar%info_constraint,simpar%lagrange_multipliers,& - simpar%dump_lm,cell,para_env%group,local_particles) - END IF - - ! Broadcast the new particle velocities - CALL update_particle_set(particle_set,para_env%group,vel=vel) - - DEALLOCATE(vel) - - DEALLOCATE(w) - - DEALLOCATE(do_langevin) - - ! Update virial - IF (simpar%constraint) CALL pv_constraint(gci,local_molecules,molecule_set,& - molecule_kind_set, particle_set,virial,para_env%group) - - CALL virial_evaluate(atomic_kind_set,particle_set,local_particles,& - virial,para_env%group) - - END SUBROUTINE langevin + NULLIFY (cell, para_env, gci, force_env) + NULLIFY (atomic_kinds, local_particles, subsys, local_molecules, molecule_kinds, molecules) + NULLIFY (molecule_kind_set, molecule_set, particles, particle_set, rng_stream, simpar, virial) + NULLIFY (thermal_region, thermal_regions, itimes) + + CALL get_md_env(md_env=md_env, simpar=simpar, force_env=force_env, & + para_env=para_env, thermal_regions=thermal_regions, & + itimes=itimes) + + dt = simpar%dt + gam = simpar%gamma + simpar%shadow_gamma + nshell = 0 + + CALL force_env_get(force_env=force_env, subsys=subsys, cell=cell) + + ! Do some checks on coordinates and box + CALL apply_qmmm_walls_reflective(force_env) + + CALL cp_subsys_get(subsys=subsys, & + atomic_kinds=atomic_kinds, & + gci=gci, & + local_particles=local_particles, & + local_molecules=local_molecules, & + molecules=molecules, & + molecule_kinds=molecule_kinds, & + nshell=nshell, & + particles=particles, & + virial=virial) + IF (nshell /= 0) & + CPABORT("Langevin dynamics is not yet implemented for core-shell models") + + nparticle_kind = atomic_kinds%n_els + atomic_kind_set => atomic_kinds%els + molecule_kind_set => molecule_kinds%els + + nparticle = particles%n_els + particle_set => particles%els + molecule_set => molecules%els + + ! Setup the langevin regions information + ALLOCATE (do_langevin(nparticle)) + IF (simpar%do_thermal_region) THEN + DO iparticle = 1, nparticle + do_langevin(iparticle) = thermal_regions%do_langevin(iparticle) + END DO + ELSE + do_langevin(1:nparticle) = .TRUE. + END IF + + ! Allocate the temperature dependent variance (var_w) of the + ! random variable for each atom. It may be different for different + ! atoms because of the possiblity of Langevin regions, and var_w + ! for each region should depend on the temperature defined in the + ! region + ! RZK explains: sigma is the variance of the Wiener process associated + ! with the stochastic term, sigma = m*var_w = m*(2*k_B*T*gamma*dt), + ! noisy_gamma adds excessive noise that is not balanced by the damping term + ALLOCATE (var_w(nparticle)) + var_w(1:nparticle) = simpar%var_w + IF (simpar%do_thermal_region) THEN + DO ireg = 1, thermal_regions%nregions + thermal_region => thermal_regions%thermal_region(ireg) + noisy_gamma_region = thermal_region%noisy_gamma_region + DO iparticle_reg = 1, thermal_region%npart + iparticle = thermal_region%part_index(iparticle_reg) + reg_temp = thermal_region%temp_expected + var_w(iparticle) = 2.0_dp*reg_temp*simpar%dt*(simpar%gamma + noisy_gamma_region) + END DO + END DO + END IF + + ! Allocate work storage + ALLOCATE (pos(3, nparticle)) + pos(:, :) = 0.0_dp + + ALLOCATE (vel(3, nparticle)) + vel(:, :) = 0.0_dp + + ALLOCATE (w(3, nparticle)) + w(:, :) = 0.0_dp + + IF (simpar%constraint) CALL getold(gci, local_molecules, molecule_set, & + molecule_kind_set, particle_set, cell) + + ! Generate random variables + DO iparticle_kind = 1, nparticle_kind + atomic_kind => atomic_kind_set(iparticle_kind) + CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) + nparticle_local = local_particles%n_el(iparticle_kind) + DO iparticle_local = 1, nparticle_local + iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) + IF (do_langevin(iparticle)) THEN + sigma = var_w(iparticle)*mass + rng_stream => local_particles%local_particle_set(iparticle_kind)% & + rng(iparticle_local)%stream + w(1, iparticle) = next_random_number(rng_stream, variance=sigma) + w(2, iparticle) = next_random_number(rng_stream, variance=sigma) + w(3, iparticle) = next_random_number(rng_stream, variance=sigma) + END IF + END DO + END DO + + DEALLOCATE (var_w) + + ! Apply fix atom constraint + CALL fix_atom_control(force_env, w) + + ! Velocity Verlet (first part) + c = EXP(-0.25_dp*dt*gam) + c2 = c*c + c4 = c2*c2 + c1 = dt*c2 + + DO iparticle_kind = 1, nparticle_kind + atomic_kind => atomic_kind_set(iparticle_kind) + CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) + nparticle_local = local_particles%n_el(iparticle_kind) + dm = 0.5_dp*dt/mass + c3 = dm/c2 + DO iparticle_local = 1, nparticle_local + iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) + IF (do_langevin(iparticle)) THEN + vel(:, iparticle) = particle_set(iparticle)%v(:) + & + c3*particle_set(iparticle)%f(:) + pos(:, iparticle) = particle_set(iparticle)%r(:) + & + c1*particle_set(iparticle)%v(:) + & + c*dm*(dt*particle_set(iparticle)%f(:) + & + w(:, iparticle)) + ELSE + vel(:, iparticle) = particle_set(iparticle)%v(:) + & + dm*particle_set(iparticle)%f(:) + pos(:, iparticle) = particle_set(iparticle)%r(:) + & + dt*particle_set(iparticle)%v(:) + & + dm*dt*particle_set(iparticle)%f(:) + END IF + END DO + END DO + + IF (simpar%constraint) THEN + ! Possibly update the target values + CALL shake_update_targets(gci, local_molecules, molecule_set, & + molecule_kind_set, dt, force_env%root_section) + + CALL shake_control(gci, local_molecules, molecule_set, molecule_kind_set, & + particle_set, pos, vel, dt, simpar%shake_tol, & + simpar%info_constraint, simpar%lagrange_multipliers, & + simpar%dump_lm, cell, para_env%group, local_particles) + END IF + + ! Broadcast the new particle positions + CALL update_particle_set(particle_set, para_env%group, pos=pos) + + DEALLOCATE (pos) + + ! Update forces + CALL force_env_calc_energy_force(force_env) + + ! Metadynamics + CALL metadyn_integrator(force_env, itimes, vel) + + ! Update Verlet (second part) + DO iparticle_kind = 1, nparticle_kind + atomic_kind => atomic_kind_set(iparticle_kind) + CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) + dm = 0.5_dp*dt/mass + c3 = dm/c2 + nparticle_local = local_particles%n_el(iparticle_kind) + DO iparticle_local = 1, nparticle_local + iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) + IF (do_langevin(iparticle)) THEN + vel(1, iparticle) = vel(1, iparticle) + c3*particle_set(iparticle)%f(1) + vel(2, iparticle) = vel(2, iparticle) + c3*particle_set(iparticle)%f(2) + vel(3, iparticle) = vel(3, iparticle) + c3*particle_set(iparticle)%f(3) + vel(1, iparticle) = c4*vel(1, iparticle) + c2*w(1, iparticle)/mass + vel(2, iparticle) = c4*vel(2, iparticle) + c2*w(2, iparticle)/mass + vel(3, iparticle) = c4*vel(3, iparticle) + c2*w(3, iparticle)/mass + ELSE + vel(1, iparticle) = vel(1, iparticle) + dm*particle_set(iparticle)%f(1) + vel(2, iparticle) = vel(2, iparticle) + dm*particle_set(iparticle)%f(2) + vel(3, iparticle) = vel(3, iparticle) + dm*particle_set(iparticle)%f(3) + END IF + END DO + END DO + + IF (simpar%temperature_annealing) THEN + simpar%temp_ext = simpar%temp_ext*simpar%f_temperature_annealing + simpar%var_w = simpar%var_w*simpar%f_temperature_annealing + END IF + + IF (simpar%constraint) THEN + CALL rattle_control(gci, local_molecules, molecule_set, molecule_kind_set, & + particle_set, vel, dt, simpar%shake_tol, & + simpar%info_constraint, simpar%lagrange_multipliers, & + simpar%dump_lm, cell, para_env%group, local_particles) + END IF + + ! Broadcast the new particle velocities + CALL update_particle_set(particle_set, para_env%group, vel=vel) + + DEALLOCATE (vel) + + DEALLOCATE (w) + + DEALLOCATE (do_langevin) + + ! Update virial + IF (simpar%constraint) CALL pv_constraint(gci, local_molecules, molecule_set, & + molecule_kind_set, particle_set, virial, para_env%group) + + CALL virial_evaluate(atomic_kind_set, particle_set, local_particles, & + virial, para_env%group) + + END SUBROUTINE langevin ! ************************************************************************************************** !> \brief nve integrator for particle positions & momenta @@ -384,7 +383,7 @@ END SUBROUTINE langevin !> - usage of fragments retrieved from the force environment (Oct. 2003,MK) !> \author CJM ! ************************************************************************************************** - SUBROUTINE nve ( md_env, globenv) + SUBROUTINE nve(md_env, globenv) TYPE(md_environment_type), POINTER :: md_env TYPE(global_environment_type), POINTER :: globenv @@ -422,167 +421,167 @@ SUBROUTINE nve ( md_env, globenv) TYPE(tmp_variables_type), POINTER :: tmp TYPE(virial_type), POINTER :: virial - NULLIFY (thermostat_coeff, tmp) - NULLIFY (subsys, simpar, para_env, cell, gci, force_env, virial) - NULLIFY (atomic_kinds, local_particles, molecules, molecule_kind_set, molecule_set, particle_set) - NULLIFY (shell_particles, shell_particle_set, core_particles, & - core_particle_set, thermostat_shell, dft_control, itimes) - CALL get_md_env(md_env=md_env,simpar=simpar,force_env=force_env,& - thermostat_coeff=thermostat_coeff,thermostat_shell=thermostat_shell,& - para_env=para_env, ehrenfest_md=ehrenfest_md, itimes=itimes) - dt = simpar%dt - CALL force_env_get(force_env=force_env, subsys=subsys,cell=cell) - - ! Do some checks on coordinates and box - CALL apply_qmmm_walls_reflective(force_env) - - CALL cp_subsys_get(subsys=subsys,atomic_kinds=atomic_kinds,local_particles=local_particles,& - particles=particles,local_molecules=local_molecules,molecules=molecules, & - molecule_kinds=molecule_kinds,gci=gci,virial=virial) - - nparticle_kind = atomic_kinds%n_els - atomic_kind_set => atomic_kinds%els - molecule_kind_set => molecule_kinds%els - - nparticle = particles%n_els - particle_set => particles%els - molecule_set => molecules%els - - CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set,& - shell_present=shell_present,shell_adiabatic=shell_adiabatic,& - shell_check_distance=shell_check_distance) - - IF(shell_present) THEN - CALL cp_subsys_get(subsys=subsys,shell_particles=shell_particles,& - core_particles=core_particles) - shell_particle_set => shell_particles%els - nshell = SIZE(shell_particles%els) - - IF(shell_adiabatic) THEN - core_particle_set => core_particles%els - END IF - END IF - - CALL allocate_tmp(md_env, tmp, nparticle,nshell,shell_adiabatic) - - ! Apply thermostat over the full set of shells if required - IF(shell_adiabatic) THEN - CALL apply_thermostat_shells(thermostat_shell, atomic_kind_set, particle_set,& - local_particles, para_env%group, shell_particle_set=shell_particle_set,& - core_particle_set=core_particle_set) - END IF - - IF (simpar%constraint) CALL getold(gci,local_molecules, molecule_set, & - molecule_kind_set, particle_set, cell) - - ! Velocity Verlet (first part) - CALL vv_first(tmp,atomic_kind_set, local_particles, particle_set, & - core_particle_set, shell_particle_set, nparticle_kind, shell_adiabatic, dt) - - IF(simpar%variable_dt) CALL variable_timestep(md_env,tmp, dt, simpar, para_env, atomic_kind_set,& - local_particles, particle_set, core_particle_set, shell_particle_set,& - nparticle_kind, shell_adiabatic) - - IF (simpar%constraint) THEN - ! Possibly update the target values - CALL shake_update_targets(gci, local_molecules, molecule_set, & - molecule_kind_set, dt, force_env%root_section) - - CALL shake_control(gci,local_molecules, molecule_set,& - molecule_kind_set, particle_set, tmp%pos, tmp%vel, dt,simpar%shake_tol, & - simpar%info_constraint,simpar%lagrange_multipliers,simpar%dump_lm,& - cell,para_env%group,local_particles) - END IF - - ! Broadcast the new particle positions and deallocate pos part of temporary - CALL update_dealloc_tmp ( tmp, particle_set, shell_particle_set, & - core_particle_set, para_env, shell_adiabatic, pos=.TRUE.) - - IF(shell_adiabatic .AND. shell_check_distance) THEN - CALL optimize_shell_core(force_env, particle_set,& - shell_particle_set, core_particle_set, globenv, tmp=tmp, check=.TRUE.) - END IF - - ! Update forces - ! In case of ehrenfest dynamics, velocities need to be iterated - IF(ehrenfest_md)THEN - ALLOCATE(v_old(3,SIZE(tmp%vel,2))) - v_old(:,:)=tmp%vel - CALL vv_second(tmp, atomic_kind_set, local_particles, particle_set, & - core_particle_set, shell_particle_set, nparticle_kind, shell_adiabatic, dt) - CALL update_dealloc_tmp ( tmp, particle_set, shell_particle_set, & - core_particle_set, para_env, shell_adiabatic, vel=.TRUE.,& - should_deall_vel=.FALSE.) - tmp%vel=v_old - CALL get_qs_env(force_env%qs_env, dft_control=dft_control) - n_iter=dft_control%rtp_control%max_iter - ELSE - n_iter=1 - END IF - - DO i_iter=1,n_iter - - IF(ehrenfest_md)THEN - CALL get_qs_env(qs_env=force_env%qs_env,rtp=rtp) - rtp%iter=i_iter - tmp%vel=v_old - CALL propagation_step(force_env%qs_env, rtp, dft_control%rtp_control) - END IF - - ![NB] let nve work with force mixing which does not have consistent energies and forces - CALL force_env_calc_energy_force(force_env,require_consistent_energy_force=.FALSE.) - - IF(ehrenfest_md)THEN - CALL rt_prop_output(force_env%qs_env,ehrenfest,delta_iter=force_env%qs_env%rtp%delta_iter) - ENDIF - - ! Metadynamics - CALL metadyn_integrator(force_env, itimes, tmp%vel) - - ! Velocity Verlet (second part) - CALL vv_second(tmp, atomic_kind_set, local_particles, particle_set, & - core_particle_set, shell_particle_set, nparticle_kind, shell_adiabatic, dt) - - IF (simpar%constraint) CALL rattle_control(gci,local_molecules, molecule_set, & - molecule_kind_set, particle_set, tmp%vel, dt,simpar%shake_tol,& - simpar%info_constraint,simpar%lagrange_multipliers,simpar%dump_lm,& - cell,para_env%group,local_particles) - - ! Apply thermostat over the full set of shell if required - IF (shell_adiabatic) THEN - CALL apply_thermostat_shells(thermostat_shell,atomic_kind_set, particle_set,& - local_particles, para_env%group, vel=tmp%vel, & - shell_vel=tmp%shell_vel, core_vel=tmp%core_vel) - END IF - - IF (simpar%annealing) THEN - tmp%vel(:,:)=tmp%vel(:,:)*simpar%f_annealing - IF (shell_adiabatic) THEN - CALL shell_scale_comv(atomic_kind_set,local_particles,particle_set,& - tmp%vel,tmp%shell_vel,tmp%core_vel) - END IF - END IF - - IF(ehrenfest_md) deallocate_vel=force_env%qs_env%rtp%converged - IF(i_iter.EQ.n_iter) deallocate_vel=.TRUE. - ! Broadcast the new particle velocities and deallocate the full temporary - CALL update_dealloc_tmp ( tmp, particle_set, shell_particle_set, & - core_particle_set, para_env, shell_adiabatic, vel=.TRUE.,& - should_deall_vel=deallocate_vel) - IF(ehrenfest_md)THEN - IF(force_env%qs_env%rtp%converged)EXIT - END IF - - END DO - - ! Update virial - IF ( simpar%constraint ) CALL pv_constraint ( gci, local_molecules, & - molecule_set,molecule_kind_set,particle_set, virial,para_env%group ) - - CALL virial_evaluate ( atomic_kind_set, particle_set, & - local_particles, virial, para_env%group) - - END SUBROUTINE nve + NULLIFY (thermostat_coeff, tmp) + NULLIFY (subsys, simpar, para_env, cell, gci, force_env, virial) + NULLIFY (atomic_kinds, local_particles, molecules, molecule_kind_set, molecule_set, particle_set) + NULLIFY (shell_particles, shell_particle_set, core_particles, & + core_particle_set, thermostat_shell, dft_control, itimes) + CALL get_md_env(md_env=md_env, simpar=simpar, force_env=force_env, & + thermostat_coeff=thermostat_coeff, thermostat_shell=thermostat_shell, & + para_env=para_env, ehrenfest_md=ehrenfest_md, itimes=itimes) + dt = simpar%dt + CALL force_env_get(force_env=force_env, subsys=subsys, cell=cell) + + ! Do some checks on coordinates and box + CALL apply_qmmm_walls_reflective(force_env) + + CALL cp_subsys_get(subsys=subsys, atomic_kinds=atomic_kinds, local_particles=local_particles, & + particles=particles, local_molecules=local_molecules, molecules=molecules, & + molecule_kinds=molecule_kinds, gci=gci, virial=virial) + + nparticle_kind = atomic_kinds%n_els + atomic_kind_set => atomic_kinds%els + molecule_kind_set => molecule_kinds%els + + nparticle = particles%n_els + particle_set => particles%els + molecule_set => molecules%els + + CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, & + shell_present=shell_present, shell_adiabatic=shell_adiabatic, & + shell_check_distance=shell_check_distance) + + IF (shell_present) THEN + CALL cp_subsys_get(subsys=subsys, shell_particles=shell_particles, & + core_particles=core_particles) + shell_particle_set => shell_particles%els + nshell = SIZE(shell_particles%els) + + IF (shell_adiabatic) THEN + core_particle_set => core_particles%els + END IF + END IF + + CALL allocate_tmp(md_env, tmp, nparticle, nshell, shell_adiabatic) + + ! Apply thermostat over the full set of shells if required + IF (shell_adiabatic) THEN + CALL apply_thermostat_shells(thermostat_shell, atomic_kind_set, particle_set, & + local_particles, para_env%group, shell_particle_set=shell_particle_set, & + core_particle_set=core_particle_set) + END IF + + IF (simpar%constraint) CALL getold(gci, local_molecules, molecule_set, & + molecule_kind_set, particle_set, cell) + + ! Velocity Verlet (first part) + CALL vv_first(tmp, atomic_kind_set, local_particles, particle_set, & + core_particle_set, shell_particle_set, nparticle_kind, shell_adiabatic, dt) + + IF (simpar%variable_dt) CALL variable_timestep(md_env, tmp, dt, simpar, para_env, atomic_kind_set, & + local_particles, particle_set, core_particle_set, shell_particle_set, & + nparticle_kind, shell_adiabatic) + + IF (simpar%constraint) THEN + ! Possibly update the target values + CALL shake_update_targets(gci, local_molecules, molecule_set, & + molecule_kind_set, dt, force_env%root_section) + + CALL shake_control(gci, local_molecules, molecule_set, & + molecule_kind_set, particle_set, tmp%pos, tmp%vel, dt, simpar%shake_tol, & + simpar%info_constraint, simpar%lagrange_multipliers, simpar%dump_lm, & + cell, para_env%group, local_particles) + END IF + + ! Broadcast the new particle positions and deallocate pos part of temporary + CALL update_dealloc_tmp(tmp, particle_set, shell_particle_set, & + core_particle_set, para_env, shell_adiabatic, pos=.TRUE.) + + IF (shell_adiabatic .AND. shell_check_distance) THEN + CALL optimize_shell_core(force_env, particle_set, & + shell_particle_set, core_particle_set, globenv, tmp=tmp, check=.TRUE.) + END IF + + ! Update forces + ! In case of ehrenfest dynamics, velocities need to be iterated + IF (ehrenfest_md) THEN + ALLOCATE (v_old(3, SIZE(tmp%vel, 2))) + v_old(:, :) = tmp%vel + CALL vv_second(tmp, atomic_kind_set, local_particles, particle_set, & + core_particle_set, shell_particle_set, nparticle_kind, shell_adiabatic, dt) + CALL update_dealloc_tmp(tmp, particle_set, shell_particle_set, & + core_particle_set, para_env, shell_adiabatic, vel=.TRUE., & + should_deall_vel=.FALSE.) + tmp%vel = v_old + CALL get_qs_env(force_env%qs_env, dft_control=dft_control) + n_iter = dft_control%rtp_control%max_iter + ELSE + n_iter = 1 + END IF + + DO i_iter = 1, n_iter + + IF (ehrenfest_md) THEN + CALL get_qs_env(qs_env=force_env%qs_env, rtp=rtp) + rtp%iter = i_iter + tmp%vel = v_old + CALL propagation_step(force_env%qs_env, rtp, dft_control%rtp_control) + END IF + + ![NB] let nve work with force mixing which does not have consistent energies and forces + CALL force_env_calc_energy_force(force_env, require_consistent_energy_force=.FALSE.) + + IF (ehrenfest_md) THEN + CALL rt_prop_output(force_env%qs_env, ehrenfest, delta_iter=force_env%qs_env%rtp%delta_iter) + ENDIF + + ! Metadynamics + CALL metadyn_integrator(force_env, itimes, tmp%vel) + + ! Velocity Verlet (second part) + CALL vv_second(tmp, atomic_kind_set, local_particles, particle_set, & + core_particle_set, shell_particle_set, nparticle_kind, shell_adiabatic, dt) + + IF (simpar%constraint) CALL rattle_control(gci, local_molecules, molecule_set, & + molecule_kind_set, particle_set, tmp%vel, dt, simpar%shake_tol, & + simpar%info_constraint, simpar%lagrange_multipliers, simpar%dump_lm, & + cell, para_env%group, local_particles) + + ! Apply thermostat over the full set of shell if required + IF (shell_adiabatic) THEN + CALL apply_thermostat_shells(thermostat_shell, atomic_kind_set, particle_set, & + local_particles, para_env%group, vel=tmp%vel, & + shell_vel=tmp%shell_vel, core_vel=tmp%core_vel) + END IF + + IF (simpar%annealing) THEN + tmp%vel(:, :) = tmp%vel(:, :)*simpar%f_annealing + IF (shell_adiabatic) THEN + CALL shell_scale_comv(atomic_kind_set, local_particles, particle_set, & + tmp%vel, tmp%shell_vel, tmp%core_vel) + END IF + END IF + + IF (ehrenfest_md) deallocate_vel = force_env%qs_env%rtp%converged + IF (i_iter .EQ. n_iter) deallocate_vel = .TRUE. + ! Broadcast the new particle velocities and deallocate the full temporary + CALL update_dealloc_tmp(tmp, particle_set, shell_particle_set, & + core_particle_set, para_env, shell_adiabatic, vel=.TRUE., & + should_deall_vel=deallocate_vel) + IF (ehrenfest_md) THEN + IF (force_env%qs_env%rtp%converged) EXIT + END IF + + END DO + + ! Update virial + IF (simpar%constraint) CALL pv_constraint(gci, local_molecules, & + molecule_set, molecule_kind_set, particle_set, virial, para_env%group) + + CALL virial_evaluate(atomic_kind_set, particle_set, & + local_particles, virial, para_env%group) + + END SUBROUTINE nve ! ************************************************************************************************** !> \brief simplest version of the isokinetic gaussian thermostat @@ -598,7 +597,7 @@ END SUBROUTINE nve !> - Zhang F. , JCP 106, 6102 (1997) !> - Minary P. et al, JCP 118, 2510 (2003) ! ************************************************************************************************** - SUBROUTINE isokin ( md_env) + SUBROUTINE isokin(md_env) TYPE(md_environment_type), POINTER :: md_env @@ -621,93 +620,92 @@ SUBROUTINE isokin ( md_env) TYPE(simpar_type), POINTER :: simpar TYPE(tmp_variables_type), POINTER :: tmp - NULLIFY(force_env, tmp, simpar, itimes) - NULLIFY(atomic_kinds,para_env,subsys,local_particles) - NULLIFY(core_particles,particles,shell_particles) - NULLIFY(core_particle_set,particle_set,shell_particle_set) + NULLIFY (force_env, tmp, simpar, itimes) + NULLIFY (atomic_kinds, para_env, subsys, local_particles) + NULLIFY (core_particles, particles, shell_particles) + NULLIFY (core_particle_set, particle_set, shell_particle_set) - CALL get_md_env(md_env=md_env,simpar=simpar,force_env=force_env,& - para_env=para_env, itimes=itimes) + CALL get_md_env(md_env=md_env, simpar=simpar, force_env=force_env, & + para_env=para_env, itimes=itimes) - dt = simpar%dt + dt = simpar%dt - CALL force_env_get(force_env=force_env,subsys=subsys) + CALL force_env_get(force_env=force_env, subsys=subsys) - ! Do some checks on coordinates and box - CALL apply_qmmm_walls_reflective(force_env) + ! Do some checks on coordinates and box + CALL apply_qmmm_walls_reflective(force_env) - IF (simpar%constraint) THEN - CPABORT("Constraints not yet implemented") - END IF - - CALL cp_subsys_get(subsys=subsys,atomic_kinds=atomic_kinds,& - local_particles=local_particles,& - particles=particles) + IF (simpar%constraint) THEN + CPABORT("Constraints not yet implemented") + END IF - nparticle_kind = atomic_kinds%n_els - atomic_kind_set => atomic_kinds%els - nparticle = particles%n_els - particle_set => particles%els + CALL cp_subsys_get(subsys=subsys, atomic_kinds=atomic_kinds, & + local_particles=local_particles, & + particles=particles) - CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set,& - shell_present=shell_present, shell_adiabatic=shell_adiabatic) + nparticle_kind = atomic_kinds%n_els + atomic_kind_set => atomic_kinds%els + nparticle = particles%n_els + particle_set => particles%els - IF(shell_present) THEN - CALL cp_subsys_get(subsys=subsys,shell_particles=shell_particles,& - core_particles=core_particles) - shell_particle_set => shell_particles%els - nshell = SIZE(shell_particles%els) + CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, & + shell_present=shell_present, shell_adiabatic=shell_adiabatic) - IF(shell_adiabatic) THEN - core_particle_set => core_particles%els - END IF - END IF + IF (shell_present) THEN + CALL cp_subsys_get(subsys=subsys, shell_particles=shell_particles, & + core_particles=core_particles) + shell_particle_set => shell_particles%els + nshell = SIZE(shell_particles%els) - CALL allocate_tmp (md_env,tmp, nparticle, nshell, shell_adiabatic) + IF (shell_adiabatic) THEN + core_particle_set => core_particles%els + END IF + END IF - ! compute s,ds - CALL get_s_ds(tmp, nparticle_kind, atomic_kind_set, local_particles, particle_set,& - dt, para_env) + CALL allocate_tmp(md_env, tmp, nparticle, nshell, shell_adiabatic) - ! Velocity Verlet (first part) - tmp%scale_v(1:3) = SQRT(1.0_dp/tmp%ds) - tmp%poly_v(1:3) = 2.0_dp*tmp%s/SQRT(tmp%ds)/dt - CALL vv_first(tmp, atomic_kind_set, local_particles, particle_set, & - core_particle_set, shell_particle_set, nparticle_kind,& - shell_adiabatic, dt) + ! compute s,ds + CALL get_s_ds(tmp, nparticle_kind, atomic_kind_set, local_particles, particle_set, & + dt, para_env) + ! Velocity Verlet (first part) + tmp%scale_v(1:3) = SQRT(1.0_dp/tmp%ds) + tmp%poly_v(1:3) = 2.0_dp*tmp%s/SQRT(tmp%ds)/dt + CALL vv_first(tmp, atomic_kind_set, local_particles, particle_set, & + core_particle_set, shell_particle_set, nparticle_kind, & + shell_adiabatic, dt) - IF(simpar%variable_dt) CALL variable_timestep(md_env,tmp, dt, simpar,para_env,atomic_kind_set, & - local_particles, particle_set, core_particle_set, shell_particle_set,& - nparticle_kind, shell_adiabatic) + IF (simpar%variable_dt) CALL variable_timestep(md_env, tmp, dt, simpar, para_env, atomic_kind_set, & + local_particles, particle_set, core_particle_set, shell_particle_set, & + nparticle_kind, shell_adiabatic) - ! Broadcast the new particle positions and deallocate the pos components of temporary - CALL update_dealloc_tmp ( tmp, particle_set, shell_particle_set, & - core_particle_set, para_env, shell_adiabatic, pos=.TRUE.) + ! Broadcast the new particle positions and deallocate the pos components of temporary + CALL update_dealloc_tmp(tmp, particle_set, shell_particle_set, & + core_particle_set, para_env, shell_adiabatic, pos=.TRUE.) - CALL force_env_calc_energy_force(force_env) + CALL force_env_calc_energy_force(force_env) - ! Metadynamics - CALL metadyn_integrator(force_env, itimes, tmp%vel) + ! Metadynamics + CALL metadyn_integrator(force_env, itimes, tmp%vel) - ! compute s,ds - CALL get_s_ds(tmp, nparticle_kind, atomic_kind_set, local_particles, particle_set,& - dt, para_env, tmpv=.TRUE.) + ! compute s,ds + CALL get_s_ds(tmp, nparticle_kind, atomic_kind_set, local_particles, particle_set, & + dt, para_env, tmpv=.TRUE.) - ! Velocity Verlet (second part) - tmp%scale_v(1:3) = SQRT(1.0_dp/tmp%ds) - tmp%poly_v(1:3) = 2.0_dp*tmp%s/SQRT(tmp%ds)/dt - CALL vv_second(tmp, atomic_kind_set, local_particles, particle_set, & - core_particle_set, shell_particle_set, nparticle_kind,& - shell_adiabatic, dt) + ! Velocity Verlet (second part) + tmp%scale_v(1:3) = SQRT(1.0_dp/tmp%ds) + tmp%poly_v(1:3) = 2.0_dp*tmp%s/SQRT(tmp%ds)/dt + CALL vv_second(tmp, atomic_kind_set, local_particles, particle_set, & + core_particle_set, shell_particle_set, nparticle_kind, & + shell_adiabatic, dt) - IF (simpar%annealing) tmp%vel(:,:)=tmp%vel(:,:)*simpar%f_annealing + IF (simpar%annealing) tmp%vel(:, :) = tmp%vel(:, :)*simpar%f_annealing - ! Broadcast the new particle velocities and deallocate the temporary - CALL update_dealloc_tmp ( tmp, particle_set, shell_particle_set, & - core_particle_set, para_env, shell_adiabatic, vel=.TRUE.) + ! Broadcast the new particle velocities and deallocate the temporary + CALL update_dealloc_tmp(tmp, particle_set, shell_particle_set, & + core_particle_set, para_env, shell_adiabatic, vel=.TRUE.) - END SUBROUTINE isokin + END SUBROUTINE isokin ! ************************************************************************************************** !> \brief nvt adiabatic integrator for particle positions & momenta !> \param md_env ... @@ -717,7 +715,7 @@ END SUBROUTINE isokin !> - usage of fragments retrieved from the force environment (Oct. 2003,MK) !> \author CJM ! ************************************************************************************************** - SUBROUTINE nvt_adiabatic ( md_env, globenv) + SUBROUTINE nvt_adiabatic(md_env, globenv) TYPE(md_environment_type), POINTER :: md_env TYPE(global_environment_type), POINTER :: globenv @@ -753,173 +751,172 @@ SUBROUTINE nvt_adiabatic ( md_env, globenv) TYPE(tmp_variables_type), POINTER :: tmp TYPE(virial_type), POINTER :: virial - NULLIFY(gci, force_env, thermostat_coeff, tmp, & - thermostat_fast, thermostat_slow, thermostat_shell, cell, shell_particles, & - shell_particle_set, core_particles, core_particle_set, rand) - NULLIFY(para_env, subsys, local_molecules, local_particles, molecule_kinds,& - molecules, molecule_kind_set, molecule_set, atomic_kinds,particles) - NULLIFY(simpar,itimes) - - CALL get_md_env(md_env=md_env,simpar=simpar,force_env=force_env,& - thermostat_fast=thermostat_fast, thermostat_slow=thermostat_slow,& - thermostat_coeff=thermostat_coeff, thermostat_shell=thermostat_shell, & - para_env=para_env, itimes=itimes) - dt = simpar%dt - - CALL force_env_get(force_env=force_env, subsys=subsys, cell=cell) - - ! Do some checks on coordinates and box - CALL apply_qmmm_walls_reflective(force_env) - - CALL cp_subsys_get(subsys=subsys,atomic_kinds=atomic_kinds,local_particles=local_particles,& - particles=particles,local_molecules=local_molecules,molecules=molecules,& - molecule_kinds=molecule_kinds,gci=gci,virial=virial) - - nparticle_kind = atomic_kinds%n_els - atomic_kind_set => atomic_kinds%els - molecule_kind_set => molecule_kinds%els - - nparticle = particles%n_els - particle_set => particles%els - molecule_set => molecules%els - - CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set,& - shell_present=shell_present,shell_adiabatic=shell_adiabatic,& - shell_check_distance=shell_check_distance) - - IF (ASSOCIATED(force_env%meta_env)) THEN - ! Allocate random number for Langevin Thermostat acting on COLVARS - IF(force_env%meta_env%langevin) THEN - ALLOCATE (rand(force_env%meta_env%n_colvar)) - rand(:) = 0.0_dp - ENDIF - ENDIF - - ! Allocate work storage for positions and velocities - IF(shell_present) THEN - CALL cp_subsys_get(subsys=subsys,shell_particles=shell_particles,& - core_particles=core_particles) - shell_particle_set => shell_particles%els - nshell = SIZE(shell_particles%els) - - IF(shell_adiabatic) THEN - core_particle_set => core_particles%els - END IF - END IF - - CALL allocate_tmp(md_env, tmp, nparticle,nshell,shell_adiabatic) - - ! Apply Thermostat over the full set of particles - IF(shell_adiabatic) THEN + NULLIFY (gci, force_env, thermostat_coeff, tmp, & + thermostat_fast, thermostat_slow, thermostat_shell, cell, shell_particles, & + shell_particle_set, core_particles, core_particle_set, rand) + NULLIFY (para_env, subsys, local_molecules, local_particles, molecule_kinds, & + molecules, molecule_kind_set, molecule_set, atomic_kinds, particles) + NULLIFY (simpar, itimes) + + CALL get_md_env(md_env=md_env, simpar=simpar, force_env=force_env, & + thermostat_fast=thermostat_fast, thermostat_slow=thermostat_slow, & + thermostat_coeff=thermostat_coeff, thermostat_shell=thermostat_shell, & + para_env=para_env, itimes=itimes) + dt = simpar%dt + + CALL force_env_get(force_env=force_env, subsys=subsys, cell=cell) + + ! Do some checks on coordinates and box + CALL apply_qmmm_walls_reflective(force_env) + + CALL cp_subsys_get(subsys=subsys, atomic_kinds=atomic_kinds, local_particles=local_particles, & + particles=particles, local_molecules=local_molecules, molecules=molecules, & + molecule_kinds=molecule_kinds, gci=gci, virial=virial) + + nparticle_kind = atomic_kinds%n_els + atomic_kind_set => atomic_kinds%els + molecule_kind_set => molecule_kinds%els + + nparticle = particles%n_els + particle_set => particles%els + molecule_set => molecules%els + + CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, & + shell_present=shell_present, shell_adiabatic=shell_adiabatic, & + shell_check_distance=shell_check_distance) + + IF (ASSOCIATED(force_env%meta_env)) THEN + ! Allocate random number for Langevin Thermostat acting on COLVARS + IF (force_env%meta_env%langevin) THEN + ALLOCATE (rand(force_env%meta_env%n_colvar)) + rand(:) = 0.0_dp + ENDIF + ENDIF + + ! Allocate work storage for positions and velocities + IF (shell_present) THEN + CALL cp_subsys_get(subsys=subsys, shell_particles=shell_particles, & + core_particles=core_particles) + shell_particle_set => shell_particles%els + nshell = SIZE(shell_particles%els) + + IF (shell_adiabatic) THEN + core_particle_set => core_particles%els + END IF + END IF + + CALL allocate_tmp(md_env, tmp, nparticle, nshell, shell_adiabatic) + + ! Apply Thermostat over the full set of particles + IF (shell_adiabatic) THEN ! CALL apply_thermostat_particles(thermostat_part, molecule_kind_set, molecule_set,& ! particle_set, local_molecules, para_env%group, shell_adiabatic=shell_adiabatic,& ! shell_particle_set=shell_particle_set, core_particle_set=core_particle_set) - CALL apply_thermostat_shells(thermostat_shell, atomic_kind_set, particle_set,& - local_particles, para_env%group, shell_particle_set=shell_particle_set,& - core_particle_set=core_particle_set) - ELSE - CALL apply_thermostat_particles(thermostat_fast, force_env, molecule_kind_set, molecule_set,& - particle_set, local_molecules, local_particles, para_env%group) - - CALL apply_thermostat_particles(thermostat_slow, force_env, molecule_kind_set, molecule_set,& - particle_set, local_molecules, local_particles, para_env%group) - END IF - - IF (simpar%constraint) CALL getold( gci, local_molecules, molecule_set, & - molecule_kind_set, particle_set, cell) - - ! *** Velocity Verlet for Langeving *** v(t)--> v(t+1/2) - IF (ASSOCIATED(force_env%meta_env)) THEN - IF(force_env%meta_env%langevin) THEN - DO ivar = 1 , force_env%meta_env%n_colvar - rng_stream => force_env%meta_env%rng(ivar)%stream - rand(ivar)=next_random_number(rng_stream) - ENDDO - CALL metadyn_velocities_colvar(force_env,rand) - ENDIF - ENDIF - - ! Velocity Verlet (first part) - CALL vv_first(tmp, atomic_kind_set, local_particles, particle_set, & - core_particle_set, shell_particle_set, nparticle_kind, shell_adiabatic, dt) - - IF(simpar%variable_dt) CALL variable_timestep(md_env,tmp, dt, simpar,para_env,atomic_kind_set,& - local_particles, particle_set, core_particle_set, shell_particle_set,& - nparticle_kind, shell_adiabatic) - - IF (simpar%constraint) THEN - ! Possibly update the target values - CALL shake_update_targets(gci, local_molecules, molecule_set, & - molecule_kind_set, dt, force_env%root_section) - - CALL shake_control( gci, local_molecules, molecule_set, & - molecule_kind_set, particle_set,tmp%pos, tmp%vel, dt,simpar%shake_tol,& - simpar%info_constraint,simpar%lagrange_multipliers,simpar%dump_lm,& - cell, para_env%group,local_particles) - END IF - - ! Broadcast the new particle positions and deallocate pos components of temporary - CALL update_dealloc_tmp ( tmp, particle_set, shell_particle_set, & - core_particle_set, para_env, shell_adiabatic, pos=.TRUE.) - - IF(shell_adiabatic .AND. shell_check_distance) THEN - CALL optimize_shell_core(force_env, particle_set,& - shell_particle_set, core_particle_set, globenv, tmp=tmp, check=.TRUE.) - END IF - - ! Update forces - CALL force_env_calc_energy_force(force_env) - - ! Metadynamics - CALL metadyn_integrator(force_env, itimes, tmp%vel, rand=rand) - - ! Velocity Verlet (second part) - CALL vv_second(tmp, atomic_kind_set, local_particles, particle_set, & - core_particle_set, shell_particle_set, nparticle_kind, shell_adiabatic, dt) - - IF (simpar%constraint) CALL rattle_control( gci, local_molecules, molecule_set, & - molecule_kind_set, particle_set, tmp%vel, dt,simpar%shake_tol,& - simpar%info_constraint,simpar%lagrange_multipliers,simpar%dump_lm,& - cell,para_env%group,local_particles) - - ! Apply Thermostat over the full set of particles - IF (shell_adiabatic) THEN - ! CALL apply_thermostat_particles(thermostat_part,molecule_kind_set, molecule_set, & - ! particle_set, local_molecules, para_env%group, shell_adiabatic=shell_adiabatic,& - ! vel= tmp%vel, shell_vel= tmp%shell_vel, core_vel= tmp%core_vel) - - CALL apply_thermostat_shells(thermostat_shell,atomic_kind_set, particle_set,& - local_particles, para_env%group, vel= tmp%vel, shell_vel= tmp%shell_vel, & - core_vel= tmp%core_vel) - ELSE - CALL apply_thermostat_particles(thermostat_slow, force_env,molecule_kind_set, molecule_set, & - particle_set, local_molecules, local_particles, para_env%group, vel= tmp%vel) - - CALL apply_thermostat_particles(thermostat_fast, force_env,molecule_kind_set, molecule_set, & - particle_set, local_molecules, local_particles, para_env%group, vel= tmp%vel) - END IF - - ! Broadcast the new particle velocities and deallocate temporary - CALL update_dealloc_tmp ( tmp, particle_set, shell_particle_set, & - core_particle_set, para_env, shell_adiabatic, vel=.TRUE.) - - IF (ASSOCIATED(force_env%meta_env)) THEN - IF(force_env%meta_env%langevin) THEN - DEALLOCATE(rand) - ENDIF - ENDIF - - ! Update constraint virial - IF ( simpar%constraint ) CALL pv_constraint ( gci, local_molecules, & - molecule_set,molecule_kind_set,particle_set, virial,para_env%group ) - - ! ** Evaluate Virial - CALL virial_evaluate ( atomic_kind_set, particle_set, & - local_particles, virial, para_env%group) - - END SUBROUTINE nvt_adiabatic + CALL apply_thermostat_shells(thermostat_shell, atomic_kind_set, particle_set, & + local_particles, para_env%group, shell_particle_set=shell_particle_set, & + core_particle_set=core_particle_set) + ELSE + CALL apply_thermostat_particles(thermostat_fast, force_env, molecule_kind_set, molecule_set, & + particle_set, local_molecules, local_particles, para_env%group) + + CALL apply_thermostat_particles(thermostat_slow, force_env, molecule_kind_set, molecule_set, & + particle_set, local_molecules, local_particles, para_env%group) + END IF + + IF (simpar%constraint) CALL getold(gci, local_molecules, molecule_set, & + molecule_kind_set, particle_set, cell) + + ! *** Velocity Verlet for Langeving *** v(t)--> v(t+1/2) + IF (ASSOCIATED(force_env%meta_env)) THEN + IF (force_env%meta_env%langevin) THEN + DO ivar = 1, force_env%meta_env%n_colvar + rng_stream => force_env%meta_env%rng(ivar)%stream + rand(ivar) = next_random_number(rng_stream) + ENDDO + CALL metadyn_velocities_colvar(force_env, rand) + ENDIF + ENDIF + + ! Velocity Verlet (first part) + CALL vv_first(tmp, atomic_kind_set, local_particles, particle_set, & + core_particle_set, shell_particle_set, nparticle_kind, shell_adiabatic, dt) + + IF (simpar%variable_dt) CALL variable_timestep(md_env, tmp, dt, simpar, para_env, atomic_kind_set, & + local_particles, particle_set, core_particle_set, shell_particle_set, & + nparticle_kind, shell_adiabatic) + + IF (simpar%constraint) THEN + ! Possibly update the target values + CALL shake_update_targets(gci, local_molecules, molecule_set, & + molecule_kind_set, dt, force_env%root_section) + + CALL shake_control(gci, local_molecules, molecule_set, & + molecule_kind_set, particle_set, tmp%pos, tmp%vel, dt, simpar%shake_tol, & + simpar%info_constraint, simpar%lagrange_multipliers, simpar%dump_lm, & + cell, para_env%group, local_particles) + END IF + + ! Broadcast the new particle positions and deallocate pos components of temporary + CALL update_dealloc_tmp(tmp, particle_set, shell_particle_set, & + core_particle_set, para_env, shell_adiabatic, pos=.TRUE.) + + IF (shell_adiabatic .AND. shell_check_distance) THEN + CALL optimize_shell_core(force_env, particle_set, & + shell_particle_set, core_particle_set, globenv, tmp=tmp, check=.TRUE.) + END IF + + ! Update forces + CALL force_env_calc_energy_force(force_env) + + ! Metadynamics + CALL metadyn_integrator(force_env, itimes, tmp%vel, rand=rand) + + ! Velocity Verlet (second part) + CALL vv_second(tmp, atomic_kind_set, local_particles, particle_set, & + core_particle_set, shell_particle_set, nparticle_kind, shell_adiabatic, dt) + + IF (simpar%constraint) CALL rattle_control(gci, local_molecules, molecule_set, & + molecule_kind_set, particle_set, tmp%vel, dt, simpar%shake_tol, & + simpar%info_constraint, simpar%lagrange_multipliers, simpar%dump_lm, & + cell, para_env%group, local_particles) + + ! Apply Thermostat over the full set of particles + IF (shell_adiabatic) THEN + ! CALL apply_thermostat_particles(thermostat_part,molecule_kind_set, molecule_set, & + ! particle_set, local_molecules, para_env%group, shell_adiabatic=shell_adiabatic,& + ! vel= tmp%vel, shell_vel= tmp%shell_vel, core_vel= tmp%core_vel) + + CALL apply_thermostat_shells(thermostat_shell, atomic_kind_set, particle_set, & + local_particles, para_env%group, vel=tmp%vel, shell_vel=tmp%shell_vel, & + core_vel=tmp%core_vel) + ELSE + CALL apply_thermostat_particles(thermostat_slow, force_env, molecule_kind_set, molecule_set, & + particle_set, local_molecules, local_particles, para_env%group, vel=tmp%vel) + + CALL apply_thermostat_particles(thermostat_fast, force_env, molecule_kind_set, molecule_set, & + particle_set, local_molecules, local_particles, para_env%group, vel=tmp%vel) + END IF + + ! Broadcast the new particle velocities and deallocate temporary + CALL update_dealloc_tmp(tmp, particle_set, shell_particle_set, & + core_particle_set, para_env, shell_adiabatic, vel=.TRUE.) + + IF (ASSOCIATED(force_env%meta_env)) THEN + IF (force_env%meta_env%langevin) THEN + DEALLOCATE (rand) + ENDIF + ENDIF + + ! Update constraint virial + IF (simpar%constraint) CALL pv_constraint(gci, local_molecules, & + molecule_set, molecule_kind_set, particle_set, virial, para_env%group) + + ! ** Evaluate Virial + CALL virial_evaluate(atomic_kind_set, particle_set, & + local_particles, virial, para_env%group) + END SUBROUTINE nvt_adiabatic ! ************************************************************************************************** !> \brief nvt integrator for particle positions & momenta @@ -930,7 +927,7 @@ END SUBROUTINE nvt_adiabatic !> - usage of fragments retrieved from the force environment (Oct. 2003,MK) !> \author CJM ! ************************************************************************************************** - SUBROUTINE nvt ( md_env, globenv) + SUBROUTINE nvt(md_env, globenv) TYPE(md_environment_type), POINTER :: md_env TYPE(global_environment_type), POINTER :: globenv @@ -966,204 +963,204 @@ SUBROUTINE nvt ( md_env, globenv) TYPE(tmp_variables_type), POINTER :: tmp TYPE(virial_type), POINTER :: virial - NULLIFY(gci, force_env, thermostat_coeff, tmp, & - thermostat_part, thermostat_shell, cell, shell_particles, & - shell_particle_set, core_particles, core_particle_set, rand) - NULLIFY(para_env, subsys, local_molecules, local_particles, molecule_kinds,& - molecules, molecule_kind_set, molecule_set, atomic_kinds,particles) - NULLIFY(simpar, thermostat_coeff, thermostat_part, thermostat_shell, itimes) - - CALL get_md_env(md_env=md_env,simpar=simpar,force_env=force_env,& - thermostat_part=thermostat_part, thermostat_coeff=thermostat_coeff,& - thermostat_shell=thermostat_shell,para_env=para_env,& - itimes=itimes) - dt = simpar%dt - - CALL force_env_get(force_env=force_env, subsys=subsys, cell=cell) - - ! Do some checks on coordinates and box - CALL apply_qmmm_walls_reflective(force_env) - - CALL cp_subsys_get(subsys=subsys,atomic_kinds=atomic_kinds,local_particles=local_particles,& - particles=particles,local_molecules=local_molecules,molecules=molecules,& - molecule_kinds=molecule_kinds,gci=gci,virial=virial) - - nparticle_kind = atomic_kinds%n_els - atomic_kind_set => atomic_kinds%els - molecule_kind_set => molecule_kinds%els - - nparticle = particles%n_els - particle_set => particles%els - molecule_set => molecules%els - - CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set,& - shell_present=shell_present,shell_adiabatic=shell_adiabatic,& - shell_check_distance=shell_check_distance) - - IF (ASSOCIATED(force_env%meta_env)) THEN - ! Allocate random number for Langevin Thermostat acting on COLVARS - IF(force_env%meta_env%langevin) THEN - ALLOCATE (rand(force_env%meta_env%n_colvar)) - rand(:) = 0.0_dp - ENDIF - ENDIF - - ! Allocate work storage for positions and velocities - IF(shell_present) THEN - CALL cp_subsys_get(subsys=subsys,shell_particles=shell_particles,& - core_particles=core_particles) - shell_particle_set => shell_particles%els - nshell = SIZE(shell_particles%els) - - IF(shell_adiabatic) THEN - core_particle_set => core_particles%els - END IF - END IF - - CALL allocate_tmp(md_env, tmp, nparticle,nshell,shell_adiabatic) - - ! Apply Thermostat over the full set of particles - IF(shell_adiabatic) THEN - CALL apply_thermostat_particles(thermostat_part, force_env, molecule_kind_set, molecule_set,& - particle_set, local_molecules, local_particles, para_env%group, shell_adiabatic=shell_adiabatic,& - shell_particle_set=shell_particle_set, core_particle_set=core_particle_set) - - CALL apply_thermostat_shells(thermostat_shell, atomic_kind_set, particle_set,& - local_particles, para_env%group, shell_particle_set=shell_particle_set,& - core_particle_set=core_particle_set) - ELSE - CALL apply_thermostat_particles(thermostat_part, force_env, molecule_kind_set, molecule_set,& - particle_set, local_molecules, local_particles, para_env%group) - END IF - - IF (simpar%constraint) CALL getold( gci, local_molecules, molecule_set, & - molecule_kind_set, particle_set, cell) - - ! *** Velocity Verlet for Langeving *** v(t)--> v(t+1/2) - IF (ASSOCIATED(force_env%meta_env)) THEN - IF(force_env%meta_env%langevin) THEN - DO ivar = 1 , force_env%meta_env%n_colvar - rng_stream => force_env%meta_env%rng(ivar)%stream - rand(ivar)=next_random_number(rng_stream) - ENDDO - CALL metadyn_velocities_colvar(force_env,rand) - ENDIF - ENDIF - - ! Velocity Verlet (first part) - CALL vv_first(tmp, atomic_kind_set, local_particles, particle_set, & - core_particle_set, shell_particle_set, nparticle_kind, shell_adiabatic, dt) - - IF(simpar%variable_dt) CALL variable_timestep(md_env,tmp, dt, simpar,para_env,atomic_kind_set,& - local_particles, particle_set, core_particle_set, shell_particle_set,& - nparticle_kind, shell_adiabatic) - - IF (simpar%constraint) THEN - ! Possibly update the target values - CALL shake_update_targets(gci, local_molecules, molecule_set, & - molecule_kind_set, dt, force_env%root_section) - - CALL shake_control( gci, local_molecules, molecule_set, & - molecule_kind_set, particle_set,tmp%pos, tmp%vel, dt,simpar%shake_tol,& - simpar%info_constraint,simpar%lagrange_multipliers,simpar%dump_lm,& - cell, para_env%group,local_particles) - END IF - - ! Broadcast the new particle positions and deallocate pos components of temporary - CALL update_dealloc_tmp ( tmp, particle_set, shell_particle_set, & - core_particle_set, para_env, shell_adiabatic, pos=.TRUE.) - - IF(shell_adiabatic .AND. shell_check_distance) THEN - CALL optimize_shell_core(force_env, particle_set,& - shell_particle_set, core_particle_set, globenv, tmp=tmp, check=.TRUE.) - END IF - - ![ADAPT] update input structure with new coordinates, make new labels - CALL qmmmx_update_force_env(force_env, force_env%root_section) - - ![NB] recreate pointers changed by creation of new subsys in qmmm_update_force_mixing_env - ![NB] ugly hack, which is why adaptivity isn't implemented in most other ensembles - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - CALL force_env_get(force_env=force_env, subsys=subsys, cell=cell) - - CALL cp_subsys_get(subsys=subsys,atomic_kinds=atomic_kinds,local_particles=local_particles,& - particles=particles,local_molecules=local_molecules,molecules=molecules,& - molecule_kinds=molecule_kinds,gci=gci,virial=virial) - - nparticle_kind = atomic_kinds%n_els - atomic_kind_set => atomic_kinds%els - molecule_kind_set => molecule_kinds%els - - nparticle = particles%n_els - particle_set => particles%els - molecule_set => molecules%els - - CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set,& - shell_present=shell_present,shell_adiabatic=shell_adiabatic,& - shell_check_distance=shell_check_distance) - - ! Allocate work storage for positions and velocities - IF(shell_present) THEN - CALL cp_subsys_get(subsys=subsys,shell_particles=shell_particles,& - core_particles=core_particles) - shell_particle_set => shell_particles%els - nshell = SIZE(shell_particles%els) - - IF(shell_adiabatic) THEN - core_particle_set => core_particles%els - END IF - END IF - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! Update forces - ![NB] let nvt work with force mixing which does not have consistent energies and forces - CALL force_env_calc_energy_force(force_env,require_consistent_energy_force=.FALSE.) - - ! Metadynamics - CALL metadyn_integrator(force_env, itimes, tmp%vel, rand=rand) - - ! Velocity Verlet (second part) - CALL vv_second(tmp, atomic_kind_set, local_particles, particle_set, & - core_particle_set, shell_particle_set, nparticle_kind, shell_adiabatic, dt) - - IF (simpar%constraint) CALL rattle_control( gci, local_molecules, molecule_set, & - molecule_kind_set, particle_set, tmp%vel, dt,simpar%shake_tol,& - simpar%info_constraint,simpar%lagrange_multipliers,simpar%dump_lm,& - cell,para_env%group,local_particles) - - ! Apply Thermostat over the full set of particles - IF (shell_adiabatic) THEN - CALL apply_thermostat_particles(thermostat_part, force_env,molecule_kind_set, molecule_set, & - particle_set, local_molecules, local_particles, para_env%group, shell_adiabatic=shell_adiabatic,& - vel= tmp%vel, shell_vel= tmp%shell_vel, core_vel= tmp%core_vel) - - CALL apply_thermostat_shells(thermostat_shell,atomic_kind_set, particle_set,& - local_particles, para_env%group, vel= tmp%vel, shell_vel= tmp%shell_vel, & - core_vel= tmp%core_vel) - ELSE - CALL apply_thermostat_particles(thermostat_part, force_env,molecule_kind_set, molecule_set, & - particle_set, local_molecules, local_particles, para_env%group, vel= tmp%vel) - END IF - - ! Broadcast the new particle velocities and deallocate temporary - CALL update_dealloc_tmp ( tmp, particle_set, shell_particle_set, & - core_particle_set, para_env, shell_adiabatic, vel=.TRUE.) - - IF (ASSOCIATED(force_env%meta_env)) THEN - IF(force_env%meta_env%langevin) THEN - DEALLOCATE(rand) - ENDIF - ENDIF - - ! Update constraint virial - IF ( simpar%constraint ) CALL pv_constraint ( gci, local_molecules, & - molecule_set,molecule_kind_set,particle_set, virial,para_env%group ) - - ! ** Evaluate Virial - CALL virial_evaluate ( atomic_kind_set, particle_set, & - local_particles, virial, para_env%group) - - END SUBROUTINE nvt + NULLIFY (gci, force_env, thermostat_coeff, tmp, & + thermostat_part, thermostat_shell, cell, shell_particles, & + shell_particle_set, core_particles, core_particle_set, rand) + NULLIFY (para_env, subsys, local_molecules, local_particles, molecule_kinds, & + molecules, molecule_kind_set, molecule_set, atomic_kinds, particles) + NULLIFY (simpar, thermostat_coeff, thermostat_part, thermostat_shell, itimes) + + CALL get_md_env(md_env=md_env, simpar=simpar, force_env=force_env, & + thermostat_part=thermostat_part, thermostat_coeff=thermostat_coeff, & + thermostat_shell=thermostat_shell, para_env=para_env, & + itimes=itimes) + dt = simpar%dt + + CALL force_env_get(force_env=force_env, subsys=subsys, cell=cell) + + ! Do some checks on coordinates and box + CALL apply_qmmm_walls_reflective(force_env) + + CALL cp_subsys_get(subsys=subsys, atomic_kinds=atomic_kinds, local_particles=local_particles, & + particles=particles, local_molecules=local_molecules, molecules=molecules, & + molecule_kinds=molecule_kinds, gci=gci, virial=virial) + + nparticle_kind = atomic_kinds%n_els + atomic_kind_set => atomic_kinds%els + molecule_kind_set => molecule_kinds%els + + nparticle = particles%n_els + particle_set => particles%els + molecule_set => molecules%els + + CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, & + shell_present=shell_present, shell_adiabatic=shell_adiabatic, & + shell_check_distance=shell_check_distance) + + IF (ASSOCIATED(force_env%meta_env)) THEN + ! Allocate random number for Langevin Thermostat acting on COLVARS + IF (force_env%meta_env%langevin) THEN + ALLOCATE (rand(force_env%meta_env%n_colvar)) + rand(:) = 0.0_dp + ENDIF + ENDIF + + ! Allocate work storage for positions and velocities + IF (shell_present) THEN + CALL cp_subsys_get(subsys=subsys, shell_particles=shell_particles, & + core_particles=core_particles) + shell_particle_set => shell_particles%els + nshell = SIZE(shell_particles%els) + + IF (shell_adiabatic) THEN + core_particle_set => core_particles%els + END IF + END IF + + CALL allocate_tmp(md_env, tmp, nparticle, nshell, shell_adiabatic) + + ! Apply Thermostat over the full set of particles + IF (shell_adiabatic) THEN + CALL apply_thermostat_particles(thermostat_part, force_env, molecule_kind_set, molecule_set, & + particle_set, local_molecules, local_particles, para_env%group, shell_adiabatic=shell_adiabatic, & + shell_particle_set=shell_particle_set, core_particle_set=core_particle_set) + + CALL apply_thermostat_shells(thermostat_shell, atomic_kind_set, particle_set, & + local_particles, para_env%group, shell_particle_set=shell_particle_set, & + core_particle_set=core_particle_set) + ELSE + CALL apply_thermostat_particles(thermostat_part, force_env, molecule_kind_set, molecule_set, & + particle_set, local_molecules, local_particles, para_env%group) + END IF + + IF (simpar%constraint) CALL getold(gci, local_molecules, molecule_set, & + molecule_kind_set, particle_set, cell) + + ! *** Velocity Verlet for Langeving *** v(t)--> v(t+1/2) + IF (ASSOCIATED(force_env%meta_env)) THEN + IF (force_env%meta_env%langevin) THEN + DO ivar = 1, force_env%meta_env%n_colvar + rng_stream => force_env%meta_env%rng(ivar)%stream + rand(ivar) = next_random_number(rng_stream) + ENDDO + CALL metadyn_velocities_colvar(force_env, rand) + ENDIF + ENDIF + + ! Velocity Verlet (first part) + CALL vv_first(tmp, atomic_kind_set, local_particles, particle_set, & + core_particle_set, shell_particle_set, nparticle_kind, shell_adiabatic, dt) + + IF (simpar%variable_dt) CALL variable_timestep(md_env, tmp, dt, simpar, para_env, atomic_kind_set, & + local_particles, particle_set, core_particle_set, shell_particle_set, & + nparticle_kind, shell_adiabatic) + + IF (simpar%constraint) THEN + ! Possibly update the target values + CALL shake_update_targets(gci, local_molecules, molecule_set, & + molecule_kind_set, dt, force_env%root_section) + + CALL shake_control(gci, local_molecules, molecule_set, & + molecule_kind_set, particle_set, tmp%pos, tmp%vel, dt, simpar%shake_tol, & + simpar%info_constraint, simpar%lagrange_multipliers, simpar%dump_lm, & + cell, para_env%group, local_particles) + END IF + + ! Broadcast the new particle positions and deallocate pos components of temporary + CALL update_dealloc_tmp(tmp, particle_set, shell_particle_set, & + core_particle_set, para_env, shell_adiabatic, pos=.TRUE.) + + IF (shell_adiabatic .AND. shell_check_distance) THEN + CALL optimize_shell_core(force_env, particle_set, & + shell_particle_set, core_particle_set, globenv, tmp=tmp, check=.TRUE.) + END IF + + ![ADAPT] update input structure with new coordinates, make new labels + CALL qmmmx_update_force_env(force_env, force_env%root_section) + + ![NB] recreate pointers changed by creation of new subsys in qmmm_update_force_mixing_env + ![NB] ugly hack, which is why adaptivity isn't implemented in most other ensembles + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + CALL force_env_get(force_env=force_env, subsys=subsys, cell=cell) + + CALL cp_subsys_get(subsys=subsys, atomic_kinds=atomic_kinds, local_particles=local_particles, & + particles=particles, local_molecules=local_molecules, molecules=molecules, & + molecule_kinds=molecule_kinds, gci=gci, virial=virial) + + nparticle_kind = atomic_kinds%n_els + atomic_kind_set => atomic_kinds%els + molecule_kind_set => molecule_kinds%els + + nparticle = particles%n_els + particle_set => particles%els + molecule_set => molecules%els + + CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, & + shell_present=shell_present, shell_adiabatic=shell_adiabatic, & + shell_check_distance=shell_check_distance) + + ! Allocate work storage for positions and velocities + IF (shell_present) THEN + CALL cp_subsys_get(subsys=subsys, shell_particles=shell_particles, & + core_particles=core_particles) + shell_particle_set => shell_particles%els + nshell = SIZE(shell_particles%els) + + IF (shell_adiabatic) THEN + core_particle_set => core_particles%els + END IF + END IF + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + ! Update forces + ![NB] let nvt work with force mixing which does not have consistent energies and forces + CALL force_env_calc_energy_force(force_env, require_consistent_energy_force=.FALSE.) + + ! Metadynamics + CALL metadyn_integrator(force_env, itimes, tmp%vel, rand=rand) + + ! Velocity Verlet (second part) + CALL vv_second(tmp, atomic_kind_set, local_particles, particle_set, & + core_particle_set, shell_particle_set, nparticle_kind, shell_adiabatic, dt) + + IF (simpar%constraint) CALL rattle_control(gci, local_molecules, molecule_set, & + molecule_kind_set, particle_set, tmp%vel, dt, simpar%shake_tol, & + simpar%info_constraint, simpar%lagrange_multipliers, simpar%dump_lm, & + cell, para_env%group, local_particles) + + ! Apply Thermostat over the full set of particles + IF (shell_adiabatic) THEN + CALL apply_thermostat_particles(thermostat_part, force_env, molecule_kind_set, molecule_set, & + particle_set, local_molecules, local_particles, para_env%group, shell_adiabatic=shell_adiabatic, & + vel=tmp%vel, shell_vel=tmp%shell_vel, core_vel=tmp%core_vel) + + CALL apply_thermostat_shells(thermostat_shell, atomic_kind_set, particle_set, & + local_particles, para_env%group, vel=tmp%vel, shell_vel=tmp%shell_vel, & + core_vel=tmp%core_vel) + ELSE + CALL apply_thermostat_particles(thermostat_part, force_env, molecule_kind_set, molecule_set, & + particle_set, local_molecules, local_particles, para_env%group, vel=tmp%vel) + END IF + + ! Broadcast the new particle velocities and deallocate temporary + CALL update_dealloc_tmp(tmp, particle_set, shell_particle_set, & + core_particle_set, para_env, shell_adiabatic, vel=.TRUE.) + + IF (ASSOCIATED(force_env%meta_env)) THEN + IF (force_env%meta_env%langevin) THEN + DEALLOCATE (rand) + ENDIF + ENDIF + + ! Update constraint virial + IF (simpar%constraint) CALL pv_constraint(gci, local_molecules, & + molecule_set, molecule_kind_set, particle_set, virial, para_env%group) + + ! ** Evaluate Virial + CALL virial_evaluate(atomic_kind_set, particle_set, & + local_particles, virial, para_env%group) + + END SUBROUTINE nvt ! ************************************************************************************************** !> \brief npt_i integrator for particle positions & momenta @@ -1174,7 +1171,7 @@ END SUBROUTINE nvt !> none !> \author CJM ! ************************************************************************************************** - SUBROUTINE npt_i ( md_env, globenv) + SUBROUTINE npt_i(md_env, globenv) TYPE(md_environment_type), POINTER :: md_env TYPE(global_environment_type), POINTER :: globenv @@ -1205,7 +1202,7 @@ SUBROUTINE npt_i ( md_env, globenv) TYPE(molecule_kind_type), DIMENSION(:), POINTER :: molecule_kind_set TYPE(molecule_list_type), POINTER :: molecules TYPE(molecule_type), DIMENSION(:), POINTER :: molecule_set - TYPE(npt_info_type), POINTER :: npt(:,:) + TYPE(npt_info_type), POINTER :: npt(:, :) TYPE(old_variables_type), POINTER :: old TYPE(particle_list_type), POINTER :: core_particles, particles, & shell_particles @@ -1218,285 +1215,282 @@ SUBROUTINE npt_i ( md_env, globenv) TYPE(tmp_variables_type), POINTER :: tmp TYPE(virial_type), POINTER :: virial - NULLIFY(gci,thermostat_baro,thermostat_part,thermostat_shell,force_env) - NULLIFY(atomic_kinds,cell,para_env,subsys,local_molecules,local_particles) - NULLIFY(molecule_kinds,molecules,molecule_kind_set,npt) - NULLIFY(core_particles,particles,shell_particles, tmp, old) - NULLIFY(core_particle_set,particle_set,shell_particle_set) - NULLIFY(simpar,virial,rand,itimes) - - CALL get_md_env(md_env=md_env,simpar=simpar,force_env=force_env,& - thermostat_part=thermostat_part, thermostat_baro=thermostat_baro,& - thermostat_shell=thermostat_shell, npt=npt, first_time=first_time,& - para_env=para_env, itimes=itimes) - dt = simpar%dt - infree = 1.0_dp / REAL ( simpar%nfree,KIND=dp) - - CALL force_env_get(force_env=force_env, subsys=subsys, cell=cell) - - ! Do some checks on coordinates and box - CALL apply_qmmm_walls_reflective(force_env) - - CALL cp_subsys_get(subsys=subsys,atomic_kinds=atomic_kinds,local_particles=local_particles,& - particles=particles,local_molecules=local_molecules,molecules=molecules, & - gci=gci,molecule_kinds=molecule_kinds,virial=virial) - - nparticle_kind = atomic_kinds%n_els - atomic_kind_set => atomic_kinds%els - molecule_kind_set => molecule_kinds%els - - nparticle = particles%n_els - particle_set => particles%els - molecule_set => molecules%els - - CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set,& - shell_present=shell_present,shell_adiabatic=shell_adiabatic,& - shell_check_distance=shell_check_distance) - - IF ( first_time ) THEN - CALL virial_evaluate ( atomic_kind_set, particle_set, & - local_particles, virial, para_env%group) - END IF - - ! Allocate work storage for positions and velocities - CALL allocate_old ( old, particle_set, npt) - - IF (ASSOCIATED(force_env%meta_env)) THEN - ! Allocate random number for Langevin Thermostat acting on COLVARS - IF(force_env%meta_env%langevin) THEN - ALLOCATE (rand(force_env%meta_env%n_colvar)) - rand(:) = 0.0_dp - ENDIF - ENDIF - - IF(shell_present) THEN - CALL cp_subsys_get(subsys=subsys,& - shell_particles=shell_particles, core_particles=core_particles) - shell_particle_set => shell_particles%els - nshell = SIZE(shell_particles%els) - IF(shell_adiabatic) THEN - core_particle_set => core_particles%els - END IF - END IF - - CALL allocate_tmp(md_env, tmp, nparticle, nshell, shell_adiabatic) - - ! Initialize eps_0 the first time through - IF ( first_time ) eps_0 = npt (1,1)%eps - - ! Apply thermostat to barostat - CALL apply_thermostat_baro( thermostat_baro, npt, para_env%group) - - ! Apply Thermostat over the full set of particles - IF(simpar% ensemble /= npe_i_ensemble) THEN - IF(shell_adiabatic) THEN - CALL apply_thermostat_particles(thermostat_part, force_env, molecule_kind_set, molecule_set,& - particle_set, local_molecules, local_particles, para_env%group,shell_adiabatic=shell_adiabatic,& - shell_particle_set=shell_particle_set, core_particle_set=core_particle_set) + NULLIFY (gci, thermostat_baro, thermostat_part, thermostat_shell, force_env) + NULLIFY (atomic_kinds, cell, para_env, subsys, local_molecules, local_particles) + NULLIFY (molecule_kinds, molecules, molecule_kind_set, npt) + NULLIFY (core_particles, particles, shell_particles, tmp, old) + NULLIFY (core_particle_set, particle_set, shell_particle_set) + NULLIFY (simpar, virial, rand, itimes) - ELSE - CALL apply_thermostat_particles(thermostat_part, force_env, molecule_kind_set, molecule_set,& - particle_set, local_molecules, local_particles, para_env%group) + CALL get_md_env(md_env=md_env, simpar=simpar, force_env=force_env, & + thermostat_part=thermostat_part, thermostat_baro=thermostat_baro, & + thermostat_shell=thermostat_shell, npt=npt, first_time=first_time, & + para_env=para_env, itimes=itimes) + dt = simpar%dt + infree = 1.0_dp/REAL(simpar%nfree, KIND=dp) + + CALL force_env_get(force_env=force_env, subsys=subsys, cell=cell) + + ! Do some checks on coordinates and box + CALL apply_qmmm_walls_reflective(force_env) + + CALL cp_subsys_get(subsys=subsys, atomic_kinds=atomic_kinds, local_particles=local_particles, & + particles=particles, local_molecules=local_molecules, molecules=molecules, & + gci=gci, molecule_kinds=molecule_kinds, virial=virial) + + nparticle_kind = atomic_kinds%n_els + atomic_kind_set => atomic_kinds%els + molecule_kind_set => molecule_kinds%els + + nparticle = particles%n_els + particle_set => particles%els + molecule_set => molecules%els + + CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, & + shell_present=shell_present, shell_adiabatic=shell_adiabatic, & + shell_check_distance=shell_check_distance) + + IF (first_time) THEN + CALL virial_evaluate(atomic_kind_set, particle_set, & + local_particles, virial, para_env%group) END IF - END IF - - ! Apply Thermostat over the core-shell motion - CALL apply_thermostat_shells(thermostat_shell, atomic_kind_set, particle_set,& - local_particles, para_env%group, shell_particle_set=shell_particle_set,& - core_particle_set=core_particle_set) - - IF (simpar%constraint) THEN - ! Possibly update the target values - CALL shake_update_targets(gci, local_molecules, molecule_set, & - molecule_kind_set, dt, force_env%root_section) - END IF - - ! setting up for ROLL: saving old variables - IF (simpar%constraint) THEN - roll_tol_thrs = simpar%roll_tol - iroll = 1 - CALL set ( old, atomic_kind_set, particle_set, local_particles, cell, npt, 'F' ) - CALL getold ( gci, local_molecules, molecule_set, & - molecule_kind_set, particle_set, cell) - ELSE - roll_tol_thrs = EPSILON(0.0_dp) - ENDIF - roll_tol = -roll_tol_thrs - - ! *** Velocity Verlet for Langeving *** v(t)--> v(t+1/2) - IF (ASSOCIATED(force_env%meta_env)) THEN - IF(force_env%meta_env%langevin) THEN - DO ivar = 1 , force_env%meta_env%n_colvar - rng_stream => force_env%meta_env%rng(ivar)%stream - rand(ivar)=next_random_number(rng_stream) - ENDDO - CALL metadyn_velocities_colvar(force_env,rand) - ENDIF - ENDIF - - SR: DO WHILE (ABS(roll_tol)>=roll_tol_thrs) ! SHAKE-ROLL LOOP - - IF (simpar%constraint) THEN - CALL set ( old, atomic_kind_set, particle_set, local_particles, cell, npt, 'B' ) - END IF - - CALL update_pv ( gci, simpar, atomic_kind_set, particle_set, & - local_molecules, molecule_set, molecule_kind_set, & - local_particles, kin, pv_kin, virial, para_env%group ) - CALL update_veps ( cell, npt, simpar, pv_kin, kin, virial, infree ) - - tmp%arg_r(1) = ( 0.5_dp * npt ( 1, 1 )%v * dt ) * & - ( 0.5_dp * npt ( 1, 1 )%v * dt ) - tmp%poly_r(1:3) = 1.0_dp + e2*tmp%arg_r(1) + e4*tmp%arg_r(1)*tmp%arg_r(1) + & - e6*tmp%arg_r(1)**3 + e8*tmp%arg_r(1)**4 - - tmp%arg_v(1) = ( 0.25_dp * npt ( 1, 1 )%v * dt * & - (1.0_dp + 3.0_dp * infree ) )*( 0.25_dp * npt ( 1, 1 )%v * & - dt * ( 1.0_dp + 3.0_dp * infree ) ) - tmp%poly_v(1:3) = 1.0_dp + e2*tmp%arg_v(1) + e4*tmp%arg_v(1)*tmp%arg_v(1) + & - e6*tmp%arg_v(1)**3 + e8*tmp%arg_v(1)**4 - - tmp%scale_r(1:3) = EXP( 0.5_dp * dt * npt ( 1, 1 )%v ) - tmp%scale_v(1:3) = EXP( -0.25_dp * dt * npt ( 1, 1 )%v * & - (1.0_dp + 3.0_dp * infree ) ) - - ! first half of velocity verlet - CALL vv_first( tmp, atomic_kind_set, local_particles, particle_set, & - core_particle_set, shell_particle_set, nparticle_kind,& - shell_adiabatic, dt) - - IF(simpar%variable_dt) CALL variable_timestep(md_env,tmp, dt, simpar,para_env,& - atomic_kind_set, local_particles, particle_set, core_particle_set,& - shell_particle_set, nparticle_kind, shell_adiabatic, npt=npt) - - - roll_tol = 0.0_dp - vector_r ( : ) = tmp%scale_r(:) * tmp%poly_r(:) - vector_v ( : ) = tmp%scale_v(:) * tmp%poly_v(:) - - IF ( simpar%constraint ) CALL shake_roll_control( gci, local_molecules, & - molecule_set, molecule_kind_set, particle_set, tmp%pos, tmp%vel, dt, simpar, & - roll_tol, iroll, vector_r, vector_v, para_env%group, cell=cell, & - local_particles=local_particles) - END DO SR - - ! Update eps: - npt ( :, : )%eps = npt ( :, : )%eps + dt * npt ( :, : )%v - - ! Update h_mat - cell%hmat ( :, : ) = cell%hmat ( :, : ) * EXP ( npt ( 1, 1 )%eps - eps_0 ) - - eps_0 = npt ( 1, 1 )%eps - - ! Update the inverse - CALL init_cell ( cell ) - - ! Broadcast the new particle positions and deallocate the pos components of temporary - CALL update_dealloc_tmp ( tmp, particle_set, shell_particle_set, & - core_particle_set, para_env, shell_adiabatic, pos=.TRUE.) - - IF(shell_adiabatic .AND. shell_check_distance) THEN - CALL optimize_shell_core(force_env, particle_set,& - shell_particle_set, core_particle_set, globenv, tmp=tmp, check=.TRUE.) - END IF - - ! Update forces - CALL force_env_calc_energy_force(force_env) - - ! Metadynamics - CALL metadyn_integrator(force_env, itimes, tmp%vel, rand=rand) - - ! Velocity Verlet (second part) - CALL vv_second(tmp, atomic_kind_set, local_particles, particle_set, & - core_particle_set, shell_particle_set, nparticle_kind,& - shell_adiabatic, dt) - - IF (simpar%constraint) THEN - roll_tol_thrs = simpar%roll_tol - first = .TRUE. - iroll = 1 - CALL set ( old, atomic_kind_set, particle_set, tmp%vel, local_particles, cell, npt, 'F' ) - ELSE - roll_tol_thrs = EPSILON(0.0_dp) - ENDIF - roll_tol = -roll_tol_thrs - - RR: DO WHILE (ABS(roll_tol)>=roll_tol_thrs) ! RATTLE-ROLL LOOP - roll_tol = 0.0_dp - IF ( simpar%constraint ) CALL rattle_roll_setup ( old, gci, atomic_kind_set, & - particle_set, local_particles, molecule_kind_set, molecule_set, & - local_molecules, tmp%vel, dt, cell, npt, simpar, virial, vector_v, & - roll_tol, iroll, infree, first, para_env) - - CALL update_pv ( gci, simpar, atomic_kind_set, tmp%vel, particle_set, & - local_molecules, molecule_set, molecule_kind_set, & - local_particles, kin, pv_kin, virial, para_env%group ) - CALL update_veps ( cell, npt, simpar, pv_kin, kin, virial, infree ) - END DO RR - - ! Apply Thermostat over the full set of particles - IF(simpar% ensemble /= npe_i_ensemble) THEN - IF (shell_adiabatic) THEN - CALL apply_thermostat_particles(thermostat_part, force_env,molecule_kind_set, molecule_set, & - particle_set, local_molecules, local_particles, para_env%group, shell_adiabatic=shell_adiabatic,& - vel=tmp%vel, shell_vel=tmp%shell_vel, core_vel=tmp%core_vel) + + ! Allocate work storage for positions and velocities + CALL allocate_old(old, particle_set, npt) + + IF (ASSOCIATED(force_env%meta_env)) THEN + ! Allocate random number for Langevin Thermostat acting on COLVARS + IF (force_env%meta_env%langevin) THEN + ALLOCATE (rand(force_env%meta_env%n_colvar)) + rand(:) = 0.0_dp + ENDIF + ENDIF + + IF (shell_present) THEN + CALL cp_subsys_get(subsys=subsys, & + shell_particles=shell_particles, core_particles=core_particles) + shell_particle_set => shell_particles%els + nshell = SIZE(shell_particles%els) + IF (shell_adiabatic) THEN + core_particle_set => core_particles%els + END IF + END IF + + CALL allocate_tmp(md_env, tmp, nparticle, nshell, shell_adiabatic) + + ! Initialize eps_0 the first time through + IF (first_time) eps_0 = npt(1, 1)%eps + + ! Apply thermostat to barostat + CALL apply_thermostat_baro(thermostat_baro, npt, para_env%group) + + ! Apply Thermostat over the full set of particles + IF (simpar%ensemble /= npe_i_ensemble) THEN + IF (shell_adiabatic) THEN + CALL apply_thermostat_particles(thermostat_part, force_env, molecule_kind_set, molecule_set, & + particle_set, local_molecules, local_particles, para_env%group, shell_adiabatic=shell_adiabatic, & + shell_particle_set=shell_particle_set, core_particle_set=core_particle_set) + + ELSE + CALL apply_thermostat_particles(thermostat_part, force_env, molecule_kind_set, molecule_set, & + particle_set, local_molecules, local_particles, para_env%group) + END IF + END IF + + ! Apply Thermostat over the core-shell motion + CALL apply_thermostat_shells(thermostat_shell, atomic_kind_set, particle_set, & + local_particles, para_env%group, shell_particle_set=shell_particle_set, & + core_particle_set=core_particle_set) + + IF (simpar%constraint) THEN + ! Possibly update the target values + CALL shake_update_targets(gci, local_molecules, molecule_set, & + molecule_kind_set, dt, force_env%root_section) + END IF + + ! setting up for ROLL: saving old variables + IF (simpar%constraint) THEN + roll_tol_thrs = simpar%roll_tol + iroll = 1 + CALL set(old, atomic_kind_set, particle_set, local_particles, cell, npt, 'F') + CALL getold(gci, local_molecules, molecule_set, & + molecule_kind_set, particle_set, cell) ELSE - CALL apply_thermostat_particles(thermostat_part, force_env,molecule_kind_set, molecule_set, & - particle_set, local_molecules, local_particles, para_env%group, vel=tmp%vel) + roll_tol_thrs = EPSILON(0.0_dp) + ENDIF + roll_tol = -roll_tol_thrs + + ! *** Velocity Verlet for Langeving *** v(t)--> v(t+1/2) + IF (ASSOCIATED(force_env%meta_env)) THEN + IF (force_env%meta_env%langevin) THEN + DO ivar = 1, force_env%meta_env%n_colvar + rng_stream => force_env%meta_env%rng(ivar)%stream + rand(ivar) = next_random_number(rng_stream) + ENDDO + CALL metadyn_velocities_colvar(force_env, rand) + ENDIF + ENDIF + + SR: DO WHILE (ABS(roll_tol) >= roll_tol_thrs) ! SHAKE-ROLL LOOP + + IF (simpar%constraint) THEN + CALL set(old, atomic_kind_set, particle_set, local_particles, cell, npt, 'B') + END IF + + CALL update_pv(gci, simpar, atomic_kind_set, particle_set, & + local_molecules, molecule_set, molecule_kind_set, & + local_particles, kin, pv_kin, virial, para_env%group) + CALL update_veps(cell, npt, simpar, pv_kin, kin, virial, infree) + + tmp%arg_r(1) = (0.5_dp*npt(1, 1)%v*dt)* & + (0.5_dp*npt(1, 1)%v*dt) + tmp%poly_r(1:3) = 1.0_dp + e2*tmp%arg_r(1) + e4*tmp%arg_r(1)*tmp%arg_r(1) + & + e6*tmp%arg_r(1)**3 + e8*tmp%arg_r(1)**4 + + tmp%arg_v(1) = (0.25_dp*npt(1, 1)%v*dt* & + (1.0_dp + 3.0_dp*infree))*(0.25_dp*npt(1, 1)%v* & + dt*(1.0_dp + 3.0_dp*infree)) + tmp%poly_v(1:3) = 1.0_dp + e2*tmp%arg_v(1) + e4*tmp%arg_v(1)*tmp%arg_v(1) + & + e6*tmp%arg_v(1)**3 + e8*tmp%arg_v(1)**4 + + tmp%scale_r(1:3) = EXP(0.5_dp*dt*npt(1, 1)%v) + tmp%scale_v(1:3) = EXP(-0.25_dp*dt*npt(1, 1)%v* & + (1.0_dp + 3.0_dp*infree)) + + ! first half of velocity verlet + CALL vv_first(tmp, atomic_kind_set, local_particles, particle_set, & + core_particle_set, shell_particle_set, nparticle_kind, & + shell_adiabatic, dt) + + IF (simpar%variable_dt) CALL variable_timestep(md_env, tmp, dt, simpar, para_env, & + atomic_kind_set, local_particles, particle_set, core_particle_set, & + shell_particle_set, nparticle_kind, shell_adiabatic, npt=npt) + + roll_tol = 0.0_dp + vector_r(:) = tmp%scale_r(:)*tmp%poly_r(:) + vector_v(:) = tmp%scale_v(:)*tmp%poly_v(:) + + IF (simpar%constraint) CALL shake_roll_control(gci, local_molecules, & + molecule_set, molecule_kind_set, particle_set, tmp%pos, tmp%vel, dt, simpar, & + roll_tol, iroll, vector_r, vector_v, para_env%group, cell=cell, & + local_particles=local_particles) + END DO SR + + ! Update eps: + npt(:, :)%eps = npt(:, :)%eps + dt*npt(:, :)%v + + ! Update h_mat + cell%hmat(:, :) = cell%hmat(:, :)*EXP(npt(1, 1)%eps - eps_0) + + eps_0 = npt(1, 1)%eps + + ! Update the inverse + CALL init_cell(cell) + + ! Broadcast the new particle positions and deallocate the pos components of temporary + CALL update_dealloc_tmp(tmp, particle_set, shell_particle_set, & + core_particle_set, para_env, shell_adiabatic, pos=.TRUE.) + + IF (shell_adiabatic .AND. shell_check_distance) THEN + CALL optimize_shell_core(force_env, particle_set, & + shell_particle_set, core_particle_set, globenv, tmp=tmp, check=.TRUE.) END IF - END IF + ! Update forces + CALL force_env_calc_energy_force(force_env) - ! Apply Thermostat over the core-shell motion - IF(ASSOCIATED(thermostat_shell)) THEN - CALL apply_thermostat_shells(thermostat_shell,atomic_kind_set, particle_set,& - local_particles, para_env%group, vel=tmp%vel, shell_vel=tmp%shell_vel, & - core_vel=tmp%core_vel) - END IF + ! Metadynamics + CALL metadyn_integrator(force_env, itimes, tmp%vel, rand=rand) - ! Apply Thermostat to Barostat - CALL apply_thermostat_baro( thermostat_baro, npt, para_env%group) + ! Velocity Verlet (second part) + CALL vv_second(tmp, atomic_kind_set, local_particles, particle_set, & + core_particle_set, shell_particle_set, nparticle_kind, & + shell_adiabatic, dt) - ! Annealing of particle velocities is only possible when no thermostat is active - IF (simpar% ensemble == npe_i_ensemble .AND. simpar%annealing) THEN - tmp%vel(:,:)=tmp%vel(:,:)*simpar%f_annealing - IF (shell_adiabatic) THEN - CALL shell_scale_comv(atomic_kind_set,local_particles,particle_set,& - tmp%vel,tmp%shell_vel,tmp%core_vel) - END IF - END IF - ! Annealing of CELL velocities is only possible when no thermostat is active - IF (simpar% ensemble == npe_i_ensemble .AND. simpar%annealing_cell) THEN - npt(1,1)%v = npt(1,1)%v * simpar%f_annealing_cell - END IF + IF (simpar%constraint) THEN + roll_tol_thrs = simpar%roll_tol + first = .TRUE. + iroll = 1 + CALL set(old, atomic_kind_set, particle_set, tmp%vel, local_particles, cell, npt, 'F') + ELSE + roll_tol_thrs = EPSILON(0.0_dp) + ENDIF + roll_tol = -roll_tol_thrs + + RR: DO WHILE (ABS(roll_tol) >= roll_tol_thrs) ! RATTLE-ROLL LOOP + roll_tol = 0.0_dp + IF (simpar%constraint) CALL rattle_roll_setup(old, gci, atomic_kind_set, & + particle_set, local_particles, molecule_kind_set, molecule_set, & + local_molecules, tmp%vel, dt, cell, npt, simpar, virial, vector_v, & + roll_tol, iroll, infree, first, para_env) + + CALL update_pv(gci, simpar, atomic_kind_set, tmp%vel, particle_set, & + local_molecules, molecule_set, molecule_kind_set, & + local_particles, kin, pv_kin, virial, para_env%group) + CALL update_veps(cell, npt, simpar, pv_kin, kin, virial, infree) + END DO RR + + ! Apply Thermostat over the full set of particles + IF (simpar%ensemble /= npe_i_ensemble) THEN + IF (shell_adiabatic) THEN + CALL apply_thermostat_particles(thermostat_part, force_env, molecule_kind_set, molecule_set, & + particle_set, local_molecules, local_particles, para_env%group, shell_adiabatic=shell_adiabatic, & + vel=tmp%vel, shell_vel=tmp%shell_vel, core_vel=tmp%core_vel) + ELSE + CALL apply_thermostat_particles(thermostat_part, force_env, molecule_kind_set, molecule_set, & + particle_set, local_molecules, local_particles, para_env%group, vel=tmp%vel) + END IF + END IF + ! Apply Thermostat over the core-shell motion + IF (ASSOCIATED(thermostat_shell)) THEN + CALL apply_thermostat_shells(thermostat_shell, atomic_kind_set, particle_set, & + local_particles, para_env%group, vel=tmp%vel, shell_vel=tmp%shell_vel, & + core_vel=tmp%core_vel) + END IF - ! Broadcast the new particle velocities and deallocate temporary - CALL update_dealloc_tmp ( tmp, particle_set, shell_particle_set, & - core_particle_set, para_env, shell_adiabatic, vel=.TRUE.) + ! Apply Thermostat to Barostat + CALL apply_thermostat_baro(thermostat_baro, npt, para_env%group) - ! Update constraint virial - IF ( simpar%constraint ) CALL pv_constraint ( gci, local_molecules, & - molecule_set, molecule_kind_set, particle_set, virial, para_env%group ) + ! Annealing of particle velocities is only possible when no thermostat is active + IF (simpar%ensemble == npe_i_ensemble .AND. simpar%annealing) THEN + tmp%vel(:, :) = tmp%vel(:, :)*simpar%f_annealing + IF (shell_adiabatic) THEN + CALL shell_scale_comv(atomic_kind_set, local_particles, particle_set, & + tmp%vel, tmp%shell_vel, tmp%core_vel) + END IF + END IF + ! Annealing of CELL velocities is only possible when no thermostat is active + IF (simpar%ensemble == npe_i_ensemble .AND. simpar%annealing_cell) THEN + npt(1, 1)%v = npt(1, 1)%v*simpar%f_annealing_cell + END IF - CALL virial_evaluate ( atomic_kind_set, particle_set, & - local_particles, virial, para_env%group) + ! Broadcast the new particle velocities and deallocate temporary + CALL update_dealloc_tmp(tmp, particle_set, shell_particle_set, & + core_particle_set, para_env, shell_adiabatic, vel=.TRUE.) - ! Deallocate old variables - CALL deallocate_old (old) + ! Update constraint virial + IF (simpar%constraint) CALL pv_constraint(gci, local_molecules, & + molecule_set, molecule_kind_set, particle_set, virial, para_env%group) - IF (ASSOCIATED(force_env%meta_env)) THEN - IF(force_env%meta_env%langevin) THEN - DEALLOCATE(rand) - ENDIF - ENDIF + CALL virial_evaluate(atomic_kind_set, particle_set, & + local_particles, virial, para_env%group) - IF (first_time) THEN - first_time = .FALSE. - CALL set_md_env(md_env, first_time=first_time) - END IF + ! Deallocate old variables + CALL deallocate_old(old) + + IF (ASSOCIATED(force_env%meta_env)) THEN + IF (force_env%meta_env%langevin) THEN + DEALLOCATE (rand) + ENDIF + ENDIF + + IF (first_time) THEN + first_time = .FALSE. + CALL set_md_env(md_env, first_time=first_time) + END IF - END SUBROUTINE npt_i + END SUBROUTINE npt_i ! ************************************************************************************************** !> \brief uses coordinates in a file and generates frame after frame of these @@ -1507,7 +1501,7 @@ END SUBROUTINE npt_i !> \note !> it can be used to compute some properties on already available trajectories ! ************************************************************************************************** - SUBROUTINE reftraj ( md_env) + SUBROUTINE reftraj(md_env) TYPE(md_environment_type), POINTER :: md_env CHARACTER(len=*), PARAMETER :: routineN = 'reftraj', routineP = moduleN//':'//routineN @@ -1517,7 +1511,7 @@ SUBROUTINE reftraj ( md_env) trj_itimes INTEGER, POINTER :: itimes LOGICAL :: init, my_end, test_ok - REAL(KIND=dp) :: cell_time, h(3,3), trj_epot, trj_time, & + REAL(KIND=dp) :: cell_time, h(3, 3), trj_epot, trj_time, & vol REAL(KIND=dp), POINTER :: time TYPE(cell_type), POINTER :: cell @@ -1529,115 +1523,114 @@ SUBROUTINE reftraj ( md_env) TYPE(reftraj_type), POINTER :: reftraj_env TYPE(simpar_type), POINTER :: simpar - NULLIFY(reftraj_env, particle_set, particles, force_env, subsys, simpar, para_env, cell, itimes, time) - CALL get_md_env(md_env=md_env, init=init, reftraj=reftraj_env, force_env=force_env,& - para_env=para_env, simpar=simpar) - - CALL force_env_get(force_env=force_env, cell=cell, subsys=subsys) - reftraj_env%isnap = reftraj_env%isnap + reftraj_env%info%stride - - ! Do some checks on coordinates and box - CALL apply_qmmm_walls_reflective(force_env) - CALL cp_subsys_get(subsys=subsys, particles=particles) - nparticle = particles%n_els - particle_set => particles%els - - ! SnapShots read from an external file (parsers calls are buffered! please - ! don't put any additional MPI call!) [tlaino] - CALL parser_read_line(reftraj_env%info%traj_parser,1) - READ(reftraj_env%info%traj_parser%input_line,FMT="(I8)") nread - CPASSERT(nread==nparticle) - CALL parser_read_line(reftraj_env%info%traj_parser,1) - test_ok = .FALSE. - READ(reftraj_env%info%traj_parser%input_line,FMT="(T6,I8,T23,F12.3,T41,F20.10)",ERR=999)& + NULLIFY (reftraj_env, particle_set, particles, force_env, subsys, simpar, para_env, cell, itimes, time) + CALL get_md_env(md_env=md_env, init=init, reftraj=reftraj_env, force_env=force_env, & + para_env=para_env, simpar=simpar) + + CALL force_env_get(force_env=force_env, cell=cell, subsys=subsys) + reftraj_env%isnap = reftraj_env%isnap + reftraj_env%info%stride + + ! Do some checks on coordinates and box + CALL apply_qmmm_walls_reflective(force_env) + CALL cp_subsys_get(subsys=subsys, particles=particles) + nparticle = particles%n_els + particle_set => particles%els + + ! SnapShots read from an external file (parsers calls are buffered! please + ! don't put any additional MPI call!) [tlaino] + CALL parser_read_line(reftraj_env%info%traj_parser, 1) + READ (reftraj_env%info%traj_parser%input_line, FMT="(I8)") nread + CPASSERT(nread == nparticle) + CALL parser_read_line(reftraj_env%info%traj_parser, 1) + test_ok = .FALSE. + READ (reftraj_env%info%traj_parser%input_line, FMT="(T6,I8,T23,F12.3,T41,F20.10)", ERR=999) & trj_itimes, trj_time, trj_epot - test_ok = .TRUE. -999 IF (.NOT.test_ok) THEN - ! Handling properly the error when reading the title of an XYZ - CALL get_md_env(md_env, itimes=itimes) - trj_itimes = itimes - trj_time = 0.0_dp - trj_epot = 0.0_dp - END IF - DO i = 1,nread-1 - CALL parser_read_line(reftraj_env%info%traj_parser,1) - READ(reftraj_env%info%traj_parser%input_line(1:LEN_TRIM(reftraj_env%info%traj_parser%input_line)),*) AA,particle_set(i)%r - particle_set(i)%r = particle_set(i)%r*bohr - END DO - ! End of file is properly addressed in the previous call.. - ! Let's check directly (providing some info) also for the last - ! line of this frame.. - CALL parser_read_line(reftraj_env%info%traj_parser,1,at_end=my_end) - READ(unit=reftraj_env%info%traj_parser%input_line,fmt=*) AA,particle_set(i)%r - particle_set(i)%r(1) = cp_unit_to_cp2k(particle_set(i)%r(1),"angstrom") - particle_set(i)%r(2) = cp_unit_to_cp2k(particle_set(i)%r(2),"angstrom") - particle_set(i)%r(3) = cp_unit_to_cp2k(particle_set(i)%r(3),"angstrom") - - ! Check if we reached the end of the file and provide some info.. - IF (my_end) THEN - IF(reftraj_env%isnap/=(simpar%nsteps-1))& - CALL cp_abort(__LOCATION__,& - "Reached the end of the Trajectory frames in the TRAJECTORY file. Number of "//& - "missing frames ("//cp_to_string((simpar%nsteps-1)-reftraj_env%isnap)//").") - END IF - - IF(reftraj_env%info%variable_volume)THEN - CALL parser_get_next_line(reftraj_env%info%cell_parser,1,at_end=my_end) - CALL parse_cell_line(reftraj_env%info%cell_parser%input_line, cell_itimes, cell_time, h, vol) - CPASSERT(trj_itimes==cell_itimes) - ! Check if we reached the end of the file and provide some info.. - IF (my_end) THEN - IF(reftraj_env%isnap/=(simpar%nsteps-1))& - CALL cp_abort(__LOCATION__,& - "Reached the end of the cell info frames in the CELL file. Number of "//& - "missing frames ("//cp_to_string((simpar%nsteps-1)-reftraj_env%isnap)//").") - END IF - END IF - - IF (init) THEN - reftraj_env%time0 = trj_time - reftraj_env%epot0 = trj_epot - reftraj_env%itimes0 = trj_itimes - END IF - - IF (trj_itimes/=0.0_dp.AND.trj_time/=0.0_dp) simpar%dt = (trj_time/femtoseconds)/REAL(trj_itimes,KIND=dp) - - reftraj_env%epot = trj_epot - reftraj_env%itimes = trj_itimes - reftraj_env%time = trj_time/femtoseconds - CALL get_md_env(md_env, t=time) - time = reftraj_env%time - - - IF(reftraj_env%info%variable_volume)THEN - cell%hmat = h - CALL init_cell(cell) - END IF - - ![ADAPT] update input structure with new coordinates, make new labels - CALL qmmmx_update_force_env(force_env, force_env%root_section) - ! no pointers into force_env%subsys to update - - ! Task to perform on the reference trajectory - ! Compute energy and forces - ![NB] let reftraj work with force mixing which does not have consistent energies and forces - CALL force_env_calc_energy_force(force_env,calc_force=reftraj_env%info%eval_forces,eval_energy_forces=reftraj_env%info%eval_EF,& - require_consistent_energy_force=.FALSE.) - - ! Metadynamics - CALL metadyn_integrator(force_env, trj_itimes) - - ! Compute MSD with respect to a reference configuration - IF(reftraj_env%info%msd) THEN - CALL compute_msd_reftraj(reftraj_env,md_env, particle_set) - END IF - - ! Skip according the stride both Trajectory and Cell (if possible) - CALL parser_get_next_line(reftraj_env%info%traj_parser,(reftraj_env%info%stride-1)*(nparticle+2)) - IF(reftraj_env%info%variable_volume)THEN - CALL parser_get_next_line(reftraj_env%info%cell_parser,(reftraj_env%info%stride-1)) - END IF - END SUBROUTINE reftraj + test_ok = .TRUE. +999 IF (.NOT. test_ok) THEN + ! Handling properly the error when reading the title of an XYZ + CALL get_md_env(md_env, itimes=itimes) + trj_itimes = itimes + trj_time = 0.0_dp + trj_epot = 0.0_dp + END IF + DO i = 1, nread - 1 + CALL parser_read_line(reftraj_env%info%traj_parser, 1) + READ (reftraj_env%info%traj_parser%input_line(1:LEN_TRIM(reftraj_env%info%traj_parser%input_line)), *) AA, particle_set(i)%r + particle_set(i)%r = particle_set(i)%r*bohr + END DO + ! End of file is properly addressed in the previous call.. + ! Let's check directly (providing some info) also for the last + ! line of this frame.. + CALL parser_read_line(reftraj_env%info%traj_parser, 1, at_end=my_end) + READ (unit=reftraj_env%info%traj_parser%input_line, fmt=*) AA, particle_set(i)%r + particle_set(i)%r(1) = cp_unit_to_cp2k(particle_set(i)%r(1), "angstrom") + particle_set(i)%r(2) = cp_unit_to_cp2k(particle_set(i)%r(2), "angstrom") + particle_set(i)%r(3) = cp_unit_to_cp2k(particle_set(i)%r(3), "angstrom") + + ! Check if we reached the end of the file and provide some info.. + IF (my_end) THEN + IF (reftraj_env%isnap /= (simpar%nsteps - 1)) & + CALL cp_abort(__LOCATION__, & + "Reached the end of the Trajectory frames in the TRAJECTORY file. Number of "// & + "missing frames ("//cp_to_string((simpar%nsteps - 1) - reftraj_env%isnap)//").") + END IF + + IF (reftraj_env%info%variable_volume) THEN + CALL parser_get_next_line(reftraj_env%info%cell_parser, 1, at_end=my_end) + CALL parse_cell_line(reftraj_env%info%cell_parser%input_line, cell_itimes, cell_time, h, vol) + CPASSERT(trj_itimes == cell_itimes) + ! Check if we reached the end of the file and provide some info.. + IF (my_end) THEN + IF (reftraj_env%isnap /= (simpar%nsteps - 1)) & + CALL cp_abort(__LOCATION__, & + "Reached the end of the cell info frames in the CELL file. Number of "// & + "missing frames ("//cp_to_string((simpar%nsteps - 1) - reftraj_env%isnap)//").") + END IF + END IF + + IF (init) THEN + reftraj_env%time0 = trj_time + reftraj_env%epot0 = trj_epot + reftraj_env%itimes0 = trj_itimes + END IF + + IF (trj_itimes /= 0.0_dp .AND. trj_time /= 0.0_dp) simpar%dt = (trj_time/femtoseconds)/REAL(trj_itimes, KIND=dp) + + reftraj_env%epot = trj_epot + reftraj_env%itimes = trj_itimes + reftraj_env%time = trj_time/femtoseconds + CALL get_md_env(md_env, t=time) + time = reftraj_env%time + + IF (reftraj_env%info%variable_volume) THEN + cell%hmat = h + CALL init_cell(cell) + END IF + + ![ADAPT] update input structure with new coordinates, make new labels + CALL qmmmx_update_force_env(force_env, force_env%root_section) + ! no pointers into force_env%subsys to update + + ! Task to perform on the reference trajectory + ! Compute energy and forces + ![NB] let reftraj work with force mixing which does not have consistent energies and forces + CALL force_env_calc_energy_force(force_env, calc_force=reftraj_env%info%eval_forces, eval_energy_forces=reftraj_env%info%eval_EF, & + require_consistent_energy_force=.FALSE.) + + ! Metadynamics + CALL metadyn_integrator(force_env, trj_itimes) + + ! Compute MSD with respect to a reference configuration + IF (reftraj_env%info%msd) THEN + CALL compute_msd_reftraj(reftraj_env, md_env, particle_set) + END IF + + ! Skip according the stride both Trajectory and Cell (if possible) + CALL parser_get_next_line(reftraj_env%info%traj_parser, (reftraj_env%info%stride - 1)*(nparticle + 2)) + IF (reftraj_env%info%variable_volume) THEN + CALL parser_get_next_line(reftraj_env%info%cell_parser, (reftraj_env%info%stride - 1)) + END IF + END SUBROUTINE reftraj ! ************************************************************************************************** !> \brief nph_uniaxial integrator (non-Hamiltonian version) @@ -1650,7 +1643,7 @@ END SUBROUTINE reftraj !> none !> \author CJM ! ************************************************************************************************** - SUBROUTINE nph_uniaxial ( md_env) + SUBROUTINE nph_uniaxial(md_env) TYPE(md_environment_type), POINTER :: md_env @@ -1677,7 +1670,7 @@ SUBROUTINE nph_uniaxial ( md_env) TYPE(molecule_kind_type), DIMENSION(:), POINTER :: molecule_kind_set TYPE(molecule_list_type), POINTER :: molecules TYPE(molecule_type), DIMENSION(:), POINTER :: molecule_set - TYPE(npt_info_type), POINTER :: npt( :, : ) + TYPE(npt_info_type), POINTER :: npt(:, :) TYPE(old_variables_type), POINTER :: old TYPE(particle_list_type), POINTER :: core_particles, particles, & shell_particles @@ -1687,201 +1680,200 @@ SUBROUTINE nph_uniaxial ( md_env) TYPE(tmp_variables_type), POINTER :: tmp TYPE(virial_type), POINTER :: virial - NULLIFY(gci, force_env) - NULLIFY(atomic_kinds,cell,para_env,subsys,local_molecules,local_particles) - NULLIFY(molecule_kinds,molecules,molecule_kind_set,npt) - NULLIFY(core_particles,particles,shell_particles, tmp, old) - NULLIFY(core_particle_set,particle_set,shell_particle_set) - NULLIFY(simpar,virial,itimes) - - CALL get_md_env(md_env=md_env,simpar=simpar,force_env=force_env,npt = npt,& - first_time=first_time, para_env=para_env, itimes=itimes) - dt = simpar%dt - infree = 1.0_dp / REAL ( simpar%nfree, dp ) - - CALL force_env_get(force_env, subsys=subsys, cell=cell) - - ! Do some checks on coordinates and box - CALL apply_qmmm_walls_reflective(force_env) - - CALL cp_subsys_get(subsys=subsys,atomic_kinds=atomic_kinds,local_particles=local_particles,& - particles=particles,local_molecules=local_molecules, molecules=molecules, gci=gci,& - molecule_kinds=molecule_kinds,virial=virial) - - nparticle_kind = atomic_kinds%n_els - atomic_kind_set => atomic_kinds%els - molecule_kind_set => molecule_kinds%els - - nparticle = particles%n_els - particle_set => particles%els - molecule_set => molecules%els - - IF ( first_time ) THEN - CALL virial_evaluate ( atomic_kind_set, particle_set, & - local_particles, virial, para_env%group) - END IF - - CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set,& - shell_present=shell_present,shell_adiabatic=shell_adiabatic) - - ! Allocate work storage for positions and velocities - CALL allocate_old ( old, particle_set, npt) - - IF(shell_present) THEN - CALL cp_subsys_get(subsys=subsys,& - shell_particles=shell_particles, core_particles=core_particles) - shell_particle_set => shell_particles%els - nshell = SIZE(shell_particles%els) - IF(shell_adiabatic) THEN - core_particle_set => core_particles%els - END IF - END IF - - CALL allocate_tmp(md_env, tmp,nparticle, nshell, shell_adiabatic) - - IF (simpar%constraint) THEN - ! Possibly update the target values - CALL shake_update_targets(gci, local_molecules, molecule_set, & - molecule_kind_set, dt, force_env%root_section) - END IF - - ! setting up for ROLL: saving old variables - IF (simpar%constraint) THEN - roll_tol_thrs = simpar%roll_tol - iroll = 1 - CALL set ( old, atomic_kind_set, particle_set, local_particles, cell, npt, 'F' ) - CALL getold ( gci, local_molecules, molecule_set, & - molecule_kind_set, particle_set, cell) - ELSE - roll_tol_thrs = EPSILON(0.0_dp) - ENDIF - roll_tol = -roll_tol_thrs - - SR: DO WHILE (ABS(roll_tol)>=roll_tol_thrs) ! SHAKE-ROLL LOOP - - IF (simpar%constraint) THEN - CALL set ( old, atomic_kind_set, particle_set, local_particles, cell, npt, 'B' ) - END IF - CALL update_pv ( gci, simpar, atomic_kind_set, particle_set, & - local_molecules, molecule_set, molecule_kind_set, & - local_particles, kin, pv_kin, virial, para_env%group ) - CALL update_veps ( cell, npt, simpar, pv_kin, kin, virial, infree ) - - tmp%arg_r(1) = ( 0.5_dp * npt ( 1, 1 )%v * dt ) * & - ( 0.5_dp * npt ( 1, 1 )%v * dt ) - tmp%poly_r(1) = 1._dp + e2*tmp%arg_r(1) + e4*tmp%arg_r(1)*tmp%arg_r(1) + & - e6*tmp%arg_r(1)**3 + e8*tmp%arg_r(1)**4 - tmp%poly_r(2) = 1.0_dp - tmp%poly_r(3) = 1.0_dp - - tmp%arg_v(1) = ( 0.25_dp * npt ( 1, 1 )%v * dt * & - (1._dp + infree ) )*( 0.25_dp * npt ( 1, 1 )%v * & - dt * ( 1._dp + infree ) ) - tmp%arg_v(2) = ( 0.25_dp * npt ( 1, 1 )%v * dt * infree) * & - ( 0.25_dp * npt ( 1, 1 )%v * dt * infree ) - tmp%poly_v(1) = 1._dp + e2*tmp%arg_v(1) + e4*tmp%arg_v(1)*tmp%arg_v(1) + & - e6*tmp%arg_v(1)**3 + e8*tmp%arg_v(1)**4 - tmp%poly_v(2) = 1._dp + e2*tmp%arg_v(2) + e4*tmp%arg_v(2)*tmp%arg_v(2) + & - e6*tmp%arg_v(2)**3 + e8*tmp%arg_v(2)**4 - tmp%poly_v(3) = 1._dp + e2*tmp%arg_v(2) + e4*tmp%arg_v(2)*tmp%arg_v(2) + & - e6*tmp%arg_v(2)**3 + e8*tmp%arg_v(2)**4 - - tmp%scale_r(1) = EXP( 0.5_dp * dt * npt ( 1, 1 )%v ) - tmp%scale_r(2) = 1.0_dp - tmp%scale_r(3) = 1.0_dp - - tmp%scale_v(1) = EXP( -0.25_dp * dt * npt ( 1, 1 )%v * & - (1._dp + infree ) ) - tmp%scale_v(2) = EXP( -0.25_dp * dt * npt ( 1, 1 )%v * infree ) - tmp%scale_v(3) = EXP( -0.25_dp * dt * npt ( 1, 1 )%v * infree ) - - ! first half of velocity verlet - CALL vv_first( tmp, atomic_kind_set, local_particles, particle_set, & - core_particle_set, shell_particle_set, nparticle_kind,& - shell_adiabatic, dt) - - IF(simpar%variable_dt) CALL variable_timestep(md_env,tmp, dt, simpar,para_env,& - atomic_kind_set, local_particles, particle_set, core_particle_set,& - shell_particle_set, nparticle_kind, shell_adiabatic, npt=npt) - - - roll_tol = 0._dp - vector_r ( : ) = 0._dp - vector_v ( : ) = tmp%scale_v(:) * tmp%poly_v(:) - vector_r ( 1 ) = tmp%scale_r(1) * tmp%poly_r(1) - - IF ( simpar%constraint ) CALL shake_roll_control( gci, local_molecules, & - molecule_set, molecule_kind_set, particle_set, tmp%pos, tmp%vel, dt, simpar,& - roll_tol, iroll, vector_r, vector_v, para_env%group, cell=cell, & - local_particles=local_particles) - END DO SR - - ! Update h_mat - cell%hmat ( 1, 1 ) = cell%hmat ( 1, 1 ) * tmp%scale_r(1) * tmp%scale_r(1) - - ! Update the cell - CALL init_cell ( cell ) - - ! Broadcast the new particle positions and deallocate the pos component of temporary - CALL update_dealloc_tmp (tmp, particle_set, shell_particle_set, & - core_particle_set, para_env, shell_adiabatic, pos=.TRUE.) - - ! Update forces (and stress) - CALL force_env_calc_energy_force(force_env) - - ! Metadynamics - CALL metadyn_integrator(force_env, itimes, tmp%vel) - - ! Velocity Verlet (second part) - CALL vv_second(tmp, atomic_kind_set, local_particles, particle_set, & - core_particle_set, shell_particle_set, nparticle_kind,& - shell_adiabatic, dt) - - IF (simpar%constraint) THEN - roll_tol_thrs = simpar%roll_tol - first = .TRUE. - iroll = 1 - CALL set ( old, atomic_kind_set, particle_set, tmp%vel, local_particles, cell, npt, 'F' ) - ELSE - roll_tol_thrs = EPSILON(0.0_dp) - ENDIF - roll_tol = -roll_tol_thrs - - RR: DO WHILE (ABS(roll_tol)>=roll_tol_thrs) ! RATTLE-ROLL LOOP - roll_tol = 0._dp - IF ( simpar%constraint ) CALL rattle_roll_setup ( old, gci, atomic_kind_set, & - particle_set, local_particles, molecule_kind_set, molecule_set, & - local_molecules, tmp%vel, dt, cell, npt, simpar, virial, vector_v, & - roll_tol, iroll, infree, first, para_env) - - CALL update_pv ( gci, simpar, atomic_kind_set, tmp%vel, particle_set, & - local_molecules, molecule_set, molecule_kind_set, & - local_particles, kin, pv_kin, virial, para_env%group ) - CALL update_veps ( cell, npt, simpar, pv_kin, kin, virial, infree ) - END DO RR - - IF (simpar%annealing) tmp%vel(:,:)=tmp%vel(:,:)*simpar%f_annealing - - ! Broadcast the new particle velocities and deallocate the temporary - CALL update_dealloc_tmp (tmp, particle_set, shell_particle_set, & - core_particle_set, para_env, shell_adiabatic, vel=.TRUE.) - - ! Update constraint virial - IF ( simpar%constraint ) CALL pv_constraint ( gci, local_molecules, & - molecule_set,molecule_kind_set,particle_set, virial, para_env%group ) - - CALL virial_evaluate ( atomic_kind_set, particle_set, & - local_particles, virial, para_env%group) - - ! Deallocate old variables - CALL deallocate_old ( old) - - IF (first_time) THEN - first_time = .FALSE. - CALL set_md_env(md_env, first_time=first_time) - END IF - - END SUBROUTINE nph_uniaxial + NULLIFY (gci, force_env) + NULLIFY (atomic_kinds, cell, para_env, subsys, local_molecules, local_particles) + NULLIFY (molecule_kinds, molecules, molecule_kind_set, npt) + NULLIFY (core_particles, particles, shell_particles, tmp, old) + NULLIFY (core_particle_set, particle_set, shell_particle_set) + NULLIFY (simpar, virial, itimes) + + CALL get_md_env(md_env=md_env, simpar=simpar, force_env=force_env, npt=npt, & + first_time=first_time, para_env=para_env, itimes=itimes) + dt = simpar%dt + infree = 1.0_dp/REAL(simpar%nfree, dp) + + CALL force_env_get(force_env, subsys=subsys, cell=cell) + + ! Do some checks on coordinates and box + CALL apply_qmmm_walls_reflective(force_env) + + CALL cp_subsys_get(subsys=subsys, atomic_kinds=atomic_kinds, local_particles=local_particles, & + particles=particles, local_molecules=local_molecules, molecules=molecules, gci=gci, & + molecule_kinds=molecule_kinds, virial=virial) + + nparticle_kind = atomic_kinds%n_els + atomic_kind_set => atomic_kinds%els + molecule_kind_set => molecule_kinds%els + + nparticle = particles%n_els + particle_set => particles%els + molecule_set => molecules%els + + IF (first_time) THEN + CALL virial_evaluate(atomic_kind_set, particle_set, & + local_particles, virial, para_env%group) + END IF + + CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, & + shell_present=shell_present, shell_adiabatic=shell_adiabatic) + + ! Allocate work storage for positions and velocities + CALL allocate_old(old, particle_set, npt) + + IF (shell_present) THEN + CALL cp_subsys_get(subsys=subsys, & + shell_particles=shell_particles, core_particles=core_particles) + shell_particle_set => shell_particles%els + nshell = SIZE(shell_particles%els) + IF (shell_adiabatic) THEN + core_particle_set => core_particles%els + END IF + END IF + + CALL allocate_tmp(md_env, tmp, nparticle, nshell, shell_adiabatic) + + IF (simpar%constraint) THEN + ! Possibly update the target values + CALL shake_update_targets(gci, local_molecules, molecule_set, & + molecule_kind_set, dt, force_env%root_section) + END IF + + ! setting up for ROLL: saving old variables + IF (simpar%constraint) THEN + roll_tol_thrs = simpar%roll_tol + iroll = 1 + CALL set(old, atomic_kind_set, particle_set, local_particles, cell, npt, 'F') + CALL getold(gci, local_molecules, molecule_set, & + molecule_kind_set, particle_set, cell) + ELSE + roll_tol_thrs = EPSILON(0.0_dp) + ENDIF + roll_tol = -roll_tol_thrs + + SR: DO WHILE (ABS(roll_tol) >= roll_tol_thrs) ! SHAKE-ROLL LOOP + + IF (simpar%constraint) THEN + CALL set(old, atomic_kind_set, particle_set, local_particles, cell, npt, 'B') + END IF + CALL update_pv(gci, simpar, atomic_kind_set, particle_set, & + local_molecules, molecule_set, molecule_kind_set, & + local_particles, kin, pv_kin, virial, para_env%group) + CALL update_veps(cell, npt, simpar, pv_kin, kin, virial, infree) + + tmp%arg_r(1) = (0.5_dp*npt(1, 1)%v*dt)* & + (0.5_dp*npt(1, 1)%v*dt) + tmp%poly_r(1) = 1._dp + e2*tmp%arg_r(1) + e4*tmp%arg_r(1)*tmp%arg_r(1) + & + e6*tmp%arg_r(1)**3 + e8*tmp%arg_r(1)**4 + tmp%poly_r(2) = 1.0_dp + tmp%poly_r(3) = 1.0_dp + + tmp%arg_v(1) = (0.25_dp*npt(1, 1)%v*dt* & + (1._dp + infree))*(0.25_dp*npt(1, 1)%v* & + dt*(1._dp + infree)) + tmp%arg_v(2) = (0.25_dp*npt(1, 1)%v*dt*infree)* & + (0.25_dp*npt(1, 1)%v*dt*infree) + tmp%poly_v(1) = 1._dp + e2*tmp%arg_v(1) + e4*tmp%arg_v(1)*tmp%arg_v(1) + & + e6*tmp%arg_v(1)**3 + e8*tmp%arg_v(1)**4 + tmp%poly_v(2) = 1._dp + e2*tmp%arg_v(2) + e4*tmp%arg_v(2)*tmp%arg_v(2) + & + e6*tmp%arg_v(2)**3 + e8*tmp%arg_v(2)**4 + tmp%poly_v(3) = 1._dp + e2*tmp%arg_v(2) + e4*tmp%arg_v(2)*tmp%arg_v(2) + & + e6*tmp%arg_v(2)**3 + e8*tmp%arg_v(2)**4 + + tmp%scale_r(1) = EXP(0.5_dp*dt*npt(1, 1)%v) + tmp%scale_r(2) = 1.0_dp + tmp%scale_r(3) = 1.0_dp + + tmp%scale_v(1) = EXP(-0.25_dp*dt*npt(1, 1)%v* & + (1._dp + infree)) + tmp%scale_v(2) = EXP(-0.25_dp*dt*npt(1, 1)%v*infree) + tmp%scale_v(3) = EXP(-0.25_dp*dt*npt(1, 1)%v*infree) + + ! first half of velocity verlet + CALL vv_first(tmp, atomic_kind_set, local_particles, particle_set, & + core_particle_set, shell_particle_set, nparticle_kind, & + shell_adiabatic, dt) + + IF (simpar%variable_dt) CALL variable_timestep(md_env, tmp, dt, simpar, para_env, & + atomic_kind_set, local_particles, particle_set, core_particle_set, & + shell_particle_set, nparticle_kind, shell_adiabatic, npt=npt) + + roll_tol = 0._dp + vector_r(:) = 0._dp + vector_v(:) = tmp%scale_v(:)*tmp%poly_v(:) + vector_r(1) = tmp%scale_r(1)*tmp%poly_r(1) + + IF (simpar%constraint) CALL shake_roll_control(gci, local_molecules, & + molecule_set, molecule_kind_set, particle_set, tmp%pos, tmp%vel, dt, simpar, & + roll_tol, iroll, vector_r, vector_v, para_env%group, cell=cell, & + local_particles=local_particles) + END DO SR + + ! Update h_mat + cell%hmat(1, 1) = cell%hmat(1, 1)*tmp%scale_r(1)*tmp%scale_r(1) + + ! Update the cell + CALL init_cell(cell) + + ! Broadcast the new particle positions and deallocate the pos component of temporary + CALL update_dealloc_tmp(tmp, particle_set, shell_particle_set, & + core_particle_set, para_env, shell_adiabatic, pos=.TRUE.) + + ! Update forces (and stress) + CALL force_env_calc_energy_force(force_env) + + ! Metadynamics + CALL metadyn_integrator(force_env, itimes, tmp%vel) + + ! Velocity Verlet (second part) + CALL vv_second(tmp, atomic_kind_set, local_particles, particle_set, & + core_particle_set, shell_particle_set, nparticle_kind, & + shell_adiabatic, dt) + + IF (simpar%constraint) THEN + roll_tol_thrs = simpar%roll_tol + first = .TRUE. + iroll = 1 + CALL set(old, atomic_kind_set, particle_set, tmp%vel, local_particles, cell, npt, 'F') + ELSE + roll_tol_thrs = EPSILON(0.0_dp) + ENDIF + roll_tol = -roll_tol_thrs + + RR: DO WHILE (ABS(roll_tol) >= roll_tol_thrs) ! RATTLE-ROLL LOOP + roll_tol = 0._dp + IF (simpar%constraint) CALL rattle_roll_setup(old, gci, atomic_kind_set, & + particle_set, local_particles, molecule_kind_set, molecule_set, & + local_molecules, tmp%vel, dt, cell, npt, simpar, virial, vector_v, & + roll_tol, iroll, infree, first, para_env) + + CALL update_pv(gci, simpar, atomic_kind_set, tmp%vel, particle_set, & + local_molecules, molecule_set, molecule_kind_set, & + local_particles, kin, pv_kin, virial, para_env%group) + CALL update_veps(cell, npt, simpar, pv_kin, kin, virial, infree) + END DO RR + + IF (simpar%annealing) tmp%vel(:, :) = tmp%vel(:, :)*simpar%f_annealing + + ! Broadcast the new particle velocities and deallocate the temporary + CALL update_dealloc_tmp(tmp, particle_set, shell_particle_set, & + core_particle_set, para_env, shell_adiabatic, vel=.TRUE.) + + ! Update constraint virial + IF (simpar%constraint) CALL pv_constraint(gci, local_molecules, & + molecule_set, molecule_kind_set, particle_set, virial, para_env%group) + + CALL virial_evaluate(atomic_kind_set, particle_set, & + local_particles, virial, para_env%group) + + ! Deallocate old variables + CALL deallocate_old(old) + + IF (first_time) THEN + first_time = .FALSE. + CALL set_md_env(md_env, first_time=first_time) + END IF + + END SUBROUTINE nph_uniaxial ! ************************************************************************************************** !> \brief nph_uniaxial integrator (non-Hamiltonian version) @@ -1895,7 +1887,7 @@ END SUBROUTINE nph_uniaxial !> none !> \author CJM ! ************************************************************************************************** - SUBROUTINE nph_uniaxial_damped ( md_env) + SUBROUTINE nph_uniaxial_damped(md_env) TYPE(md_environment_type), POINTER :: md_env @@ -1924,7 +1916,7 @@ SUBROUTINE nph_uniaxial_damped ( md_env) TYPE(molecule_kind_type), DIMENSION(:), POINTER :: molecule_kind_set TYPE(molecule_list_type), POINTER :: molecules TYPE(molecule_type), DIMENSION(:), POINTER :: molecule_set - TYPE(npt_info_type), POINTER :: npt( :, : ) + TYPE(npt_info_type), POINTER :: npt(:, :) TYPE(old_variables_type), POINTER :: old TYPE(particle_list_type), POINTER :: core_particles, particles, & shell_particles @@ -1934,214 +1926,212 @@ SUBROUTINE nph_uniaxial_damped ( md_env) TYPE(tmp_variables_type), POINTER :: tmp TYPE(virial_type), POINTER :: virial - NULLIFY(gci, force_env) - NULLIFY(atomic_kinds,cell,para_env,subsys,local_molecules,local_particles) - NULLIFY(molecule_kinds,molecules,molecule_kind_set,npt) - NULLIFY(core_particles,particles,shell_particles,tmp,old) - NULLIFY(core_particle_set,particle_set,shell_particle_set) - NULLIFY(simpar,virial,itimes) - - CALL get_md_env(md_env=md_env,simpar=simpar,force_env=force_env,npt = npt,& - first_time=first_time, para_env=para_env, itimes=itimes) - dt = simpar%dt - infree = 1.0_dp / REAL ( simpar%nfree, dp ) - gamma1 = simpar%gamma_nph - - CALL force_env_get(force_env, subsys=subsys, cell = cell) - - CALL cp_subsys_get(subsys=subsys,atomic_kinds=atomic_kinds,local_particles=local_particles,& - particles=particles,local_molecules=local_molecules,molecules=molecules,gci=gci,& - molecule_kinds=molecule_kinds,virial=virial) - - nparticle_kind = atomic_kinds%n_els - atomic_kind_set => atomic_kinds%els - molecule_kind_set => molecule_kinds%els - - nparticle = particles%n_els - particle_set => particles%els - molecule_set => molecules%els - - IF ( first_time ) THEN - CALL virial_evaluate ( atomic_kind_set, particle_set, & - local_particles, virial, para_env%group) - END IF - - CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set,& - shell_present=shell_present,shell_adiabatic=shell_adiabatic) - - ! Allocate work storage for positions and velocities - CALL allocate_old ( old, particle_set, npt) - - IF(shell_present) THEN - CALL cp_subsys_get(subsys=subsys,& - shell_particles=shell_particles, core_particles=core_particles) - shell_particle_set => shell_particles%els - nshell = SIZE(shell_particles%els) - IF(shell_adiabatic) THEN - core_particle_set => core_particles%els - END IF - END IF - - CALL allocate_tmp(md_env, tmp,nparticle, nshell, shell_adiabatic) - - ! perform damping on velocities - CALL damp_v ( molecule_kind_set, molecule_set, particle_set, local_molecules,& - gamma1, npt(1,1), dt, para_env%group ) - - IF (simpar%constraint) THEN - ! Possibly update the target values - CALL shake_update_targets(gci, local_molecules, molecule_set, & - molecule_kind_set, dt, force_env%root_section) - END IF - - ! setting up for ROLL: saving old variables - IF (simpar%constraint) THEN - roll_tol_thrs = simpar%roll_tol - iroll = 1 - CALL set ( old, atomic_kind_set, particle_set, local_particles, cell, npt, 'F' ) - CALL getold ( gci, local_molecules, molecule_set, & - molecule_kind_set, particle_set, cell) - ELSE - roll_tol_thrs = EPSILON(0.0_dp) - ENDIF - roll_tol = -roll_tol_thrs - - SR: DO WHILE (ABS(roll_tol)>=roll_tol_thrs) ! SHAKE-ROLL LOOP - - ! perform damping on the barostat momentum - CALL damp_veps ( npt ( 1, 1 ), gamma1, dt ) - - IF (simpar%constraint) THEN - CALL set ( old, atomic_kind_set, particle_set, local_particles, cell, npt, 'B' ) - END IF - CALL update_pv ( gci, simpar, atomic_kind_set, particle_set, & - local_molecules, molecule_set, molecule_kind_set, & - local_particles, kin, pv_kin, virial, para_env%group ) - CALL update_veps ( cell, npt, simpar, pv_kin, kin, virial, infree ) - - ! perform damping on the barostat momentum - CALL damp_veps ( npt ( 1, 1 ), gamma1, dt ) - - tmp%arg_r(1) = ( 0.5_dp * npt ( 1, 1 )%v * dt ) * & - ( 0.5_dp * npt ( 1, 1 )%v * dt ) - tmp%poly_r(1) = 1._dp + e2*tmp%arg_r(1) + e4*tmp%arg_r(1)*tmp%arg_r(1) +& - e6*tmp%arg_r(1)**3 + e8*tmp%arg_r(1)**4 - - aax = npt ( 1, 1 )%v * ( 1.0_dp + infree ) - tmp%arg_v(1) = ( 0.25_dp * dt * aax ) * ( 0.25_dp * dt * aax ) - tmp%poly_v(1) = 1._dp + e2*tmp%arg_v(1) + e4*tmp%arg_v(1)*tmp%arg_v(1) +& - e6*tmp%arg_v(1)**3 + e8*tmp%arg_v(1)**4 - - aa = npt ( 1, 1 )%v * infree - tmp%arg_v(2) = ( 0.25_dp * dt * aa ) * ( 0.25_dp * dt * aa ) - tmp%poly_v(2) = 1._dp + e2*tmp%arg_v(2) + e4*tmp%arg_v(2)*tmp%arg_v(2) +& - e6*tmp%arg_v(2)**3 + e8*tmp%arg_v(2)**4 - tmp%poly_v(3) = 1._dp + e2*tmp%arg_v(2) + e4*tmp%arg_v(2)*tmp%arg_v(2) +& - e6*tmp%arg_v(2)**3 + e8*tmp%arg_v(2)**4 - - tmp%scale_r(1) = EXP( 0.5_dp * dt * npt ( 1, 1 )%v ) - tmp%scale_v(1) = EXP( -0.25_dp * dt * aax ) - tmp%scale_v(2) = EXP( -0.25_dp * dt * aa ) - tmp%scale_v(3) = EXP( -0.25_dp * dt * aa ) - - ! first half of velocity verlet - CALL vv_first( tmp, atomic_kind_set, local_particles, particle_set, & - core_particle_set, shell_particle_set, nparticle_kind,& - shell_adiabatic, dt) - - - IF(simpar%variable_dt) CALL variable_timestep(md_env,tmp, dt, simpar,para_env,& - atomic_kind_set, local_particles, particle_set, core_particle_set,& - shell_particle_set, nparticle_kind, shell_adiabatic, npt=npt) - - - roll_tol = 0._dp - vector_r ( : ) = 0._dp - vector_v ( : ) = tmp%scale_v(:) * tmp%poly_v(:) - vector_r ( 1 ) = tmp%scale_r(1) * tmp%poly_r(1) - - IF ( simpar%constraint ) CALL shake_roll_control( gci, local_molecules, & - molecule_set, molecule_kind_set, particle_set, tmp%pos,tmp%vel, dt, simpar,& - roll_tol, iroll, vector_r, vector_v, para_env%group, cell=cell,& - local_particles=local_particles) - END DO SR - - ! Update h_mat - cell%hmat ( 1, 1 ) = cell%hmat ( 1, 1 ) * tmp%scale_r(1) * tmp%scale_r(1) - - ! Update the inverse - CALL init_cell ( cell ) - - ! Broadcast the new particle positions and deallocate the pos components of temporary - CALL update_dealloc_tmp (tmp,particle_set, shell_particle_set, & - core_particle_set, para_env, shell_adiabatic, pos=.TRUE.) - - ! Update forces - CALL force_env_calc_energy_force(force_env) - - ! Metadynamics - CALL metadyn_integrator(force_env, itimes, tmp%vel) - - ! Velocity Verlet (second part) - CALL vv_second(tmp, atomic_kind_set, local_particles, particle_set, & - core_particle_set, shell_particle_set, nparticle_kind,& - shell_adiabatic, dt) - - IF (simpar%constraint) THEN - roll_tol_thrs = simpar%roll_tol - first = .TRUE. - iroll = 1 - CALL set ( old, atomic_kind_set, particle_set, tmp%vel, local_particles, cell, npt, 'F' ) - ELSE - roll_tol_thrs = EPSILON(0.0_dp) - ENDIF - roll_tol = -roll_tol_thrs - - RR: DO WHILE (ABS(roll_tol)>=roll_tol_thrs) ! RATTLE-ROLL LOOP - roll_tol = 0._dp - IF ( simpar%constraint ) CALL rattle_roll_setup ( old, gci, atomic_kind_set, & - particle_set, local_particles, molecule_kind_set, molecule_set, local_molecules,& - tmp%vel, dt, cell, npt, simpar, virial, vector_v, roll_tol, iroll, infree, first,& - para_env) - ! perform damping on the barostat momentum - CALL damp_veps ( npt ( 1, 1 ), gamma1, dt ) + NULLIFY (gci, force_env) + NULLIFY (atomic_kinds, cell, para_env, subsys, local_molecules, local_particles) + NULLIFY (molecule_kinds, molecules, molecule_kind_set, npt) + NULLIFY (core_particles, particles, shell_particles, tmp, old) + NULLIFY (core_particle_set, particle_set, shell_particle_set) + NULLIFY (simpar, virial, itimes) - CALL update_pv ( gci, simpar, atomic_kind_set, tmp%vel, particle_set, & - local_molecules, molecule_set, molecule_kind_set, & - local_particles, kin, pv_kin, virial, para_env%group ) - CALL update_veps ( cell, npt, simpar, pv_kin, kin, virial, infree ) - - ! perform damping on the barostat momentum - CALL damp_veps ( npt ( 1, 1 ), gamma1, dt ) - - END DO RR - - ! perform damping on velocities - CALL damp_v ( molecule_kind_set, molecule_set, particle_set, local_molecules,& - tmp%vel, gamma1, npt ( 1, 1 ), dt, para_env%group ) - - IF (simpar%annealing) tmp%vel(:,:)=tmp%vel(:,:)*simpar%f_annealing + CALL get_md_env(md_env=md_env, simpar=simpar, force_env=force_env, npt=npt, & + first_time=first_time, para_env=para_env, itimes=itimes) + dt = simpar%dt + infree = 1.0_dp/REAL(simpar%nfree, dp) + gamma1 = simpar%gamma_nph - ! Broadcast the new particle velocities and deallocate temporary - CALL update_dealloc_tmp (tmp,particle_set, shell_particle_set, & - core_particle_set, para_env, shell_adiabatic, vel=.TRUE.) + CALL force_env_get(force_env, subsys=subsys, cell=cell) - ! Update constraint virial - IF ( simpar%constraint ) CALL pv_constraint ( gci, local_molecules, & - molecule_set, molecule_kind_set, particle_set, virial, para_env%group ) + CALL cp_subsys_get(subsys=subsys, atomic_kinds=atomic_kinds, local_particles=local_particles, & + particles=particles, local_molecules=local_molecules, molecules=molecules, gci=gci, & + molecule_kinds=molecule_kinds, virial=virial) - CALL virial_evaluate ( atomic_kind_set, particle_set, & - local_particles, virial, para_env%group) + nparticle_kind = atomic_kinds%n_els + atomic_kind_set => atomic_kinds%els + molecule_kind_set => molecule_kinds%els - ! Deallocate old variables - CALL deallocate_old ( old) + nparticle = particles%n_els + particle_set => particles%els + molecule_set => molecules%els + + IF (first_time) THEN + CALL virial_evaluate(atomic_kind_set, particle_set, & + local_particles, virial, para_env%group) + END IF - IF (first_time) THEN - first_time = .FALSE. - CALL set_md_env(md_env, first_time=first_time) - END IF + CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, & + shell_present=shell_present, shell_adiabatic=shell_adiabatic) + + ! Allocate work storage for positions and velocities + CALL allocate_old(old, particle_set, npt) + + IF (shell_present) THEN + CALL cp_subsys_get(subsys=subsys, & + shell_particles=shell_particles, core_particles=core_particles) + shell_particle_set => shell_particles%els + nshell = SIZE(shell_particles%els) + IF (shell_adiabatic) THEN + core_particle_set => core_particles%els + END IF + END IF - END SUBROUTINE nph_uniaxial_damped + CALL allocate_tmp(md_env, tmp, nparticle, nshell, shell_adiabatic) + + ! perform damping on velocities + CALL damp_v(molecule_kind_set, molecule_set, particle_set, local_molecules, & + gamma1, npt(1, 1), dt, para_env%group) + + IF (simpar%constraint) THEN + ! Possibly update the target values + CALL shake_update_targets(gci, local_molecules, molecule_set, & + molecule_kind_set, dt, force_env%root_section) + END IF + + ! setting up for ROLL: saving old variables + IF (simpar%constraint) THEN + roll_tol_thrs = simpar%roll_tol + iroll = 1 + CALL set(old, atomic_kind_set, particle_set, local_particles, cell, npt, 'F') + CALL getold(gci, local_molecules, molecule_set, & + molecule_kind_set, particle_set, cell) + ELSE + roll_tol_thrs = EPSILON(0.0_dp) + ENDIF + roll_tol = -roll_tol_thrs + + SR: DO WHILE (ABS(roll_tol) >= roll_tol_thrs) ! SHAKE-ROLL LOOP + + ! perform damping on the barostat momentum + CALL damp_veps(npt(1, 1), gamma1, dt) + + IF (simpar%constraint) THEN + CALL set(old, atomic_kind_set, particle_set, local_particles, cell, npt, 'B') + END IF + CALL update_pv(gci, simpar, atomic_kind_set, particle_set, & + local_molecules, molecule_set, molecule_kind_set, & + local_particles, kin, pv_kin, virial, para_env%group) + CALL update_veps(cell, npt, simpar, pv_kin, kin, virial, infree) + + ! perform damping on the barostat momentum + CALL damp_veps(npt(1, 1), gamma1, dt) + + tmp%arg_r(1) = (0.5_dp*npt(1, 1)%v*dt)* & + (0.5_dp*npt(1, 1)%v*dt) + tmp%poly_r(1) = 1._dp + e2*tmp%arg_r(1) + e4*tmp%arg_r(1)*tmp%arg_r(1) + & + e6*tmp%arg_r(1)**3 + e8*tmp%arg_r(1)**4 + + aax = npt(1, 1)%v*(1.0_dp + infree) + tmp%arg_v(1) = (0.25_dp*dt*aax)*(0.25_dp*dt*aax) + tmp%poly_v(1) = 1._dp + e2*tmp%arg_v(1) + e4*tmp%arg_v(1)*tmp%arg_v(1) + & + e6*tmp%arg_v(1)**3 + e8*tmp%arg_v(1)**4 + + aa = npt(1, 1)%v*infree + tmp%arg_v(2) = (0.25_dp*dt*aa)*(0.25_dp*dt*aa) + tmp%poly_v(2) = 1._dp + e2*tmp%arg_v(2) + e4*tmp%arg_v(2)*tmp%arg_v(2) + & + e6*tmp%arg_v(2)**3 + e8*tmp%arg_v(2)**4 + tmp%poly_v(3) = 1._dp + e2*tmp%arg_v(2) + e4*tmp%arg_v(2)*tmp%arg_v(2) + & + e6*tmp%arg_v(2)**3 + e8*tmp%arg_v(2)**4 + + tmp%scale_r(1) = EXP(0.5_dp*dt*npt(1, 1)%v) + tmp%scale_v(1) = EXP(-0.25_dp*dt*aax) + tmp%scale_v(2) = EXP(-0.25_dp*dt*aa) + tmp%scale_v(3) = EXP(-0.25_dp*dt*aa) + + ! first half of velocity verlet + CALL vv_first(tmp, atomic_kind_set, local_particles, particle_set, & + core_particle_set, shell_particle_set, nparticle_kind, & + shell_adiabatic, dt) + + IF (simpar%variable_dt) CALL variable_timestep(md_env, tmp, dt, simpar, para_env, & + atomic_kind_set, local_particles, particle_set, core_particle_set, & + shell_particle_set, nparticle_kind, shell_adiabatic, npt=npt) + + roll_tol = 0._dp + vector_r(:) = 0._dp + vector_v(:) = tmp%scale_v(:)*tmp%poly_v(:) + vector_r(1) = tmp%scale_r(1)*tmp%poly_r(1) + + IF (simpar%constraint) CALL shake_roll_control(gci, local_molecules, & + molecule_set, molecule_kind_set, particle_set, tmp%pos, tmp%vel, dt, simpar, & + roll_tol, iroll, vector_r, vector_v, para_env%group, cell=cell, & + local_particles=local_particles) + END DO SR + + ! Update h_mat + cell%hmat(1, 1) = cell%hmat(1, 1)*tmp%scale_r(1)*tmp%scale_r(1) + + ! Update the inverse + CALL init_cell(cell) + + ! Broadcast the new particle positions and deallocate the pos components of temporary + CALL update_dealloc_tmp(tmp, particle_set, shell_particle_set, & + core_particle_set, para_env, shell_adiabatic, pos=.TRUE.) + + ! Update forces + CALL force_env_calc_energy_force(force_env) + + ! Metadynamics + CALL metadyn_integrator(force_env, itimes, tmp%vel) + + ! Velocity Verlet (second part) + CALL vv_second(tmp, atomic_kind_set, local_particles, particle_set, & + core_particle_set, shell_particle_set, nparticle_kind, & + shell_adiabatic, dt) + + IF (simpar%constraint) THEN + roll_tol_thrs = simpar%roll_tol + first = .TRUE. + iroll = 1 + CALL set(old, atomic_kind_set, particle_set, tmp%vel, local_particles, cell, npt, 'F') + ELSE + roll_tol_thrs = EPSILON(0.0_dp) + ENDIF + roll_tol = -roll_tol_thrs + + RR: DO WHILE (ABS(roll_tol) >= roll_tol_thrs) ! RATTLE-ROLL LOOP + roll_tol = 0._dp + IF (simpar%constraint) CALL rattle_roll_setup(old, gci, atomic_kind_set, & + particle_set, local_particles, molecule_kind_set, molecule_set, local_molecules, & + tmp%vel, dt, cell, npt, simpar, virial, vector_v, roll_tol, iroll, infree, first, & + para_env) + ! perform damping on the barostat momentum + CALL damp_veps(npt(1, 1), gamma1, dt) + + CALL update_pv(gci, simpar, atomic_kind_set, tmp%vel, particle_set, & + local_molecules, molecule_set, molecule_kind_set, & + local_particles, kin, pv_kin, virial, para_env%group) + CALL update_veps(cell, npt, simpar, pv_kin, kin, virial, infree) + + ! perform damping on the barostat momentum + CALL damp_veps(npt(1, 1), gamma1, dt) + + END DO RR + + ! perform damping on velocities + CALL damp_v(molecule_kind_set, molecule_set, particle_set, local_molecules, & + tmp%vel, gamma1, npt(1, 1), dt, para_env%group) + + IF (simpar%annealing) tmp%vel(:, :) = tmp%vel(:, :)*simpar%f_annealing + + ! Broadcast the new particle velocities and deallocate temporary + CALL update_dealloc_tmp(tmp, particle_set, shell_particle_set, & + core_particle_set, para_env, shell_adiabatic, vel=.TRUE.) + + ! Update constraint virial + IF (simpar%constraint) CALL pv_constraint(gci, local_molecules, & + molecule_set, molecule_kind_set, particle_set, virial, para_env%group) + + CALL virial_evaluate(atomic_kind_set, particle_set, & + local_particles, virial, para_env%group) + + ! Deallocate old variables + CALL deallocate_old(old) + + IF (first_time) THEN + first_time = .FALSE. + CALL set_md_env(md_env, first_time=first_time) + END IF + + END SUBROUTINE nph_uniaxial_damped ! ************************************************************************************************** !> \brief Velocity Verlet integrator for the NPT ensemble with fully flexible cell @@ -2151,7 +2141,7 @@ END SUBROUTINE nph_uniaxial_damped !> none !> \author CJM ! ************************************************************************************************** - SUBROUTINE npt_f ( md_env, globenv) + SUBROUTINE npt_f(md_env, globenv) TYPE(md_environment_type), POINTER :: md_env TYPE(global_environment_type), POINTER :: globenv @@ -2182,7 +2172,7 @@ SUBROUTINE npt_f ( md_env, globenv) TYPE(molecule_kind_type), DIMENSION(:), POINTER :: molecule_kind_set TYPE(molecule_list_type), POINTER :: molecules TYPE(molecule_type), DIMENSION(:), POINTER :: molecule_set - TYPE(npt_info_type), POINTER :: npt( :, : ) + TYPE(npt_info_type), POINTER :: npt(:, :) TYPE(old_variables_type), POINTER :: old TYPE(particle_list_type), POINTER :: core_particles, particles, & shell_particles @@ -2194,270 +2184,270 @@ SUBROUTINE npt_f ( md_env, globenv) TYPE(tmp_variables_type), POINTER :: tmp TYPE(virial_type), POINTER :: virial - NULLIFY(gci,thermostat_baro,thermostat_part,thermostat_shell,force_env) - NULLIFY(atomic_kinds,cell,para_env,subsys,local_molecules,local_particles) - NULLIFY(molecule_kinds,molecules,molecule_kind_set,npt,barostat) - NULLIFY(core_particles,particles,shell_particles,tmp,old) - NULLIFY(core_particle_set,particle_set,shell_particle_set) - NULLIFY(simpar,virial,itimes) - - CALL get_md_env(md_env=md_env,simpar=simpar,force_env=force_env,& - thermostat_part=thermostat_part, thermostat_baro=thermostat_baro,& - thermostat_shell=thermostat_shell, npt=npt, first_time=first_time,& - para_env=para_env, barostat=barostat, itimes=itimes) - dt = simpar%dt - infree = 1.0_dp / REAL ( simpar%nfree,KIND=dp) - - CALL force_env_get(force_env, subsys=subsys, cell=cell) - - ! Do some checks on coordinates and box - CALL apply_qmmm_walls_reflective(force_env) - - CALL cp_subsys_get(subsys=subsys,atomic_kinds=atomic_kinds, local_particles=local_particles,& - particles=particles,local_molecules=local_molecules,molecules=molecules, & - gci=gci,molecule_kinds=molecule_kinds,virial=virial) - - nparticle_kind = atomic_kinds%n_els - atomic_kind_set => atomic_kinds%els - molecule_kind_set => molecule_kinds%els - - nparticle = particles%n_els - particle_set => particles%els - molecule_set => molecules%els - - CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set,& - shell_present=shell_present,shell_adiabatic=shell_adiabatic,& - shell_check_distance=shell_check_distance) - - IF ( first_time ) THEN - CALL virial_evaluate ( atomic_kind_set, particle_set, & - local_particles, virial, para_env%group) - END IF - - ! Allocate work storage for positions and velocities - CALL allocate_old ( old, particle_set, npt) - - IF(shell_present) THEN - CALL cp_subsys_get(subsys=subsys,& - shell_particles=shell_particles, core_particles=core_particles) - shell_particle_set => shell_particles%els - nshell = SIZE(shell_particles%els) - IF(shell_adiabatic) THEN - core_particle_set => core_particles%els - END IF - END IF - - CALL allocate_tmp(md_env, tmp,nparticle, nshell, shell_adiabatic) - - ! Apply Thermostat to Barostat - CALL apply_thermostat_baro(thermostat_baro, npt, para_env%group) - - ! Apply Thermostat over the full set of particles - IF(simpar% ensemble /= npe_f_ensemble) THEN - IF(shell_adiabatic) THEN - CALL apply_thermostat_particles(thermostat_part, force_env, molecule_kind_set, molecule_set,& - particle_set, local_molecules, local_particles, para_env%group,shell_adiabatic=shell_adiabatic,& - shell_particle_set=shell_particle_set,core_particle_set=core_particle_set) - ELSE - CALL apply_thermostat_particles(thermostat_part, force_env, molecule_kind_set, molecule_set,& - particle_set, local_molecules, local_particles, para_env%group) + NULLIFY (gci, thermostat_baro, thermostat_part, thermostat_shell, force_env) + NULLIFY (atomic_kinds, cell, para_env, subsys, local_molecules, local_particles) + NULLIFY (molecule_kinds, molecules, molecule_kind_set, npt, barostat) + NULLIFY (core_particles, particles, shell_particles, tmp, old) + NULLIFY (core_particle_set, particle_set, shell_particle_set) + NULLIFY (simpar, virial, itimes) + + CALL get_md_env(md_env=md_env, simpar=simpar, force_env=force_env, & + thermostat_part=thermostat_part, thermostat_baro=thermostat_baro, & + thermostat_shell=thermostat_shell, npt=npt, first_time=first_time, & + para_env=para_env, barostat=barostat, itimes=itimes) + dt = simpar%dt + infree = 1.0_dp/REAL(simpar%nfree, KIND=dp) + + CALL force_env_get(force_env, subsys=subsys, cell=cell) + + ! Do some checks on coordinates and box + CALL apply_qmmm_walls_reflective(force_env) + + CALL cp_subsys_get(subsys=subsys, atomic_kinds=atomic_kinds, local_particles=local_particles, & + particles=particles, local_molecules=local_molecules, molecules=molecules, & + gci=gci, molecule_kinds=molecule_kinds, virial=virial) + + nparticle_kind = atomic_kinds%n_els + atomic_kind_set => atomic_kinds%els + molecule_kind_set => molecule_kinds%els + + nparticle = particles%n_els + particle_set => particles%els + molecule_set => molecules%els + + CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, & + shell_present=shell_present, shell_adiabatic=shell_adiabatic, & + shell_check_distance=shell_check_distance) + + IF (first_time) THEN + CALL virial_evaluate(atomic_kind_set, particle_set, & + local_particles, virial, para_env%group) + END IF + + ! Allocate work storage for positions and velocities + CALL allocate_old(old, particle_set, npt) + + IF (shell_present) THEN + CALL cp_subsys_get(subsys=subsys, & + shell_particles=shell_particles, core_particles=core_particles) + shell_particle_set => shell_particles%els + nshell = SIZE(shell_particles%els) + IF (shell_adiabatic) THEN + core_particle_set => core_particles%els + END IF + END IF + + CALL allocate_tmp(md_env, tmp, nparticle, nshell, shell_adiabatic) + + ! Apply Thermostat to Barostat + CALL apply_thermostat_baro(thermostat_baro, npt, para_env%group) + + ! Apply Thermostat over the full set of particles + IF (simpar%ensemble /= npe_f_ensemble) THEN + IF (shell_adiabatic) THEN + CALL apply_thermostat_particles(thermostat_part, force_env, molecule_kind_set, molecule_set, & + particle_set, local_molecules, local_particles, para_env%group, shell_adiabatic=shell_adiabatic, & + shell_particle_set=shell_particle_set, core_particle_set=core_particle_set) + ELSE + CALL apply_thermostat_particles(thermostat_part, force_env, molecule_kind_set, molecule_set, & + particle_set, local_molecules, local_particles, para_env%group) + END IF + END IF + + ! Apply Thermostat over the core-shell motion + CALL apply_thermostat_shells(thermostat_shell, atomic_kind_set, particle_set, & + local_particles, para_env%group, shell_particle_set=shell_particle_set, & + core_particle_set=core_particle_set) + + IF (simpar%constraint) THEN + ! Possibly update the target values + CALL shake_update_targets(gci, local_molecules, molecule_set, & + molecule_kind_set, dt, force_env%root_section) END IF - END IF - - ! Apply Thermostat over the core-shell motion - CALL apply_thermostat_shells(thermostat_shell, atomic_kind_set, particle_set,& - local_particles, para_env%group, shell_particle_set=shell_particle_set,& - core_particle_set=core_particle_set) - - IF (simpar%constraint) THEN - ! Possibly update the target values - CALL shake_update_targets(gci, local_molecules, molecule_set, & - molecule_kind_set, dt, force_env%root_section) - END IF - - ! setting up for ROLL: saving old variables - IF (simpar%constraint) THEN - roll_tol_thrs = simpar%roll_tol - iroll = 1 - CALL set ( old, atomic_kind_set, particle_set, local_particles, cell, npt, 'F' ) - CALL getold ( gci, local_molecules, molecule_set, & - molecule_kind_set, particle_set, cell) - ELSE - roll_tol_thrs = EPSILON(0.0_dp) - ENDIF - roll_tol = -roll_tol_thrs - - SR: DO WHILE (ABS(roll_tol)>=roll_tol_thrs) ! SHAKE-ROLL LOOP - - IF (simpar%constraint) THEN - CALL set ( old, atomic_kind_set, particle_set, local_particles, cell, npt, 'B' ) - END IF - CALL update_pv ( gci, simpar, atomic_kind_set, particle_set, & - local_molecules, molecule_set, molecule_kind_set, & - local_particles, kin, pv_kin, virial, para_env%group ) - CALL update_veps ( cell, npt, simpar, pv_kin, kin, virial, infree,& - virial_components=barostat%virial_components) - trvg = npt ( 1, 1 )%v + npt ( 2, 2 )%v + npt ( 3, 3 )%v - ! - ! find eigenvalues and eigenvectors of npt ( :, : )%v - ! - - CALL diagonalise ( matrix = npt(:,:)%v, mysize = 3, & - storageform = "UPPER", eigenvalues = tmp%e_val, eigenvectors = tmp%u ) - - tmp%arg_r ( : ) = 0.5_dp * tmp%e_val ( : ) * dt * & - 0.5_dp * tmp%e_val ( : ) * dt - tmp%poly_r = 1.0_dp + e2*tmp%arg_r + e4*tmp%arg_r*tmp%arg_r + & - e6*tmp%arg_r**3 + e8*tmp%arg_r**4 - tmp%scale_r ( : ) = EXP ( 0.5_dp * dt * tmp%e_val ( : ) ) - - tmp%arg_v ( : ) = 0.25_dp * dt * ( tmp%e_val ( : ) + trvg * infree ) *& - 0.25_dp * dt * ( tmp%e_val ( : ) + trvg * infree ) - tmp%poly_v = 1.0_dp + e2*tmp%arg_v + e4*tmp%arg_v*tmp%arg_v +& - e6*tmp%arg_v**3 + e8*tmp%arg_v**4 - tmp%scale_v ( : ) = EXP ( -0.25_dp * dt * ( tmp%e_val( : ) + trvg * infree ) ) - - CALL vv_first(tmp, atomic_kind_set, local_particles, particle_set, & - core_particle_set, shell_particle_set, nparticle_kind,& - shell_adiabatic, dt, u=tmp%u) - - IF(simpar%variable_dt) CALL variable_timestep(md_env,tmp, dt, simpar,para_env,& - atomic_kind_set, local_particles, particle_set, core_particle_set,& - shell_particle_set, nparticle_kind, shell_adiabatic,npt=npt) - - roll_tol = 0.0_dp - vector_r = tmp%scale_r*tmp%poly_r - vector_v = tmp%scale_v*tmp%poly_v - - IF ( simpar%constraint ) CALL shake_roll_control( gci, local_molecules, & - molecule_set, molecule_kind_set, particle_set, tmp%pos, tmp%vel, dt,& - simpar, roll_tol, iroll, vector_r, vector_v, & - para_env%group, u=tmp%u, cell=cell,& - local_particles=local_particles) - END DO SR - - ! Update h_mat - uh = MATMUL_3X3 ( TRANSPOSE_3D ( tmp%u ), cell%hmat ) - - DO i = 1, 3 - DO j = 1, 3 - uh ( i, j ) = uh ( i, j ) * tmp%scale_r ( i ) * tmp%scale_r ( i ) - END DO - END DO - - cell%hmat = MATMUL_3x3 ( tmp%u, uh ) - ! Update the inverse - CALL init_cell ( cell ) - - ! Broadcast the new particle positions and deallocate the pos components of temporary - CALL update_dealloc_tmp (tmp,particle_set, shell_particle_set, & - core_particle_set, para_env, shell_adiabatic, pos=.TRUE.) - - IF(shell_adiabatic .AND. shell_check_distance) THEN - CALL optimize_shell_core(force_env, particle_set,& - shell_particle_set, core_particle_set, globenv, tmp=tmp, check=.TRUE.) - END IF - - ! Update forces - CALL force_env_calc_energy_force(force_env) - - ! Metadynamics - CALL metadyn_integrator(force_env, itimes, tmp%vel) - - ! Velocity Verlet (second part) - CALL vv_second (tmp, atomic_kind_set, local_particles, particle_set,& - core_particle_set, shell_particle_set, nparticle_kind,& - shell_adiabatic, dt, tmp%u) - - IF (simpar%constraint) THEN - roll_tol_thrs = simpar%roll_tol - first = .TRUE. - iroll = 1 - CALL set (old, atomic_kind_set, particle_set, tmp%vel, local_particles, cell, npt, 'F' ) - ELSE - roll_tol_thrs = EPSILON(0.0_dp) - ENDIF - roll_tol = -roll_tol_thrs - - RR: DO WHILE (ABS(roll_tol)>=roll_tol_thrs) ! RATTLE-ROLL LOOP - roll_tol = 0.0_dp - IF ( simpar%constraint ) CALL rattle_roll_setup ( old, gci, atomic_kind_set, & - particle_set, local_particles, molecule_kind_set, molecule_set, & - local_molecules, tmp%vel, dt, cell, npt, simpar, virial, vector_v, & - roll_tol, iroll, infree, first, para_env, u=tmp%u) - - CALL update_pv ( gci, simpar, atomic_kind_set, tmp%vel, particle_set, & - local_molecules, molecule_set, molecule_kind_set, & - local_particles, kin, pv_kin, virial, para_env%group ) - CALL update_veps ( cell, npt, simpar, pv_kin, kin, virial, infree,& + ! setting up for ROLL: saving old variables + IF (simpar%constraint) THEN + roll_tol_thrs = simpar%roll_tol + iroll = 1 + CALL set(old, atomic_kind_set, particle_set, local_particles, cell, npt, 'F') + CALL getold(gci, local_molecules, molecule_set, & + molecule_kind_set, particle_set, cell) + ELSE + roll_tol_thrs = EPSILON(0.0_dp) + ENDIF + roll_tol = -roll_tol_thrs + + SR: DO WHILE (ABS(roll_tol) >= roll_tol_thrs) ! SHAKE-ROLL LOOP + + IF (simpar%constraint) THEN + CALL set(old, atomic_kind_set, particle_set, local_particles, cell, npt, 'B') + END IF + CALL update_pv(gci, simpar, atomic_kind_set, particle_set, & + local_molecules, molecule_set, molecule_kind_set, & + local_particles, kin, pv_kin, virial, para_env%group) + CALL update_veps(cell, npt, simpar, pv_kin, kin, virial, infree, & virial_components=barostat%virial_components) - END DO RR - ! Apply Thermostat over the full set of particles - IF(simpar% ensemble /= npe_f_ensemble) THEN - IF (shell_adiabatic) THEN - CALL apply_thermostat_particles(thermostat_part, force_env,molecule_kind_set, molecule_set, & - particle_set, local_molecules, local_particles, para_env%group,shell_adiabatic=shell_adiabatic,& - vel=tmp%vel, shell_vel=tmp%shell_vel, core_vel=tmp%core_vel) + trvg = npt(1, 1)%v + npt(2, 2)%v + npt(3, 3)%v + ! + ! find eigenvalues and eigenvectors of npt ( :, : )%v + ! + + CALL diagonalise(matrix=npt(:, :)%v, mysize=3, & + storageform="UPPER", eigenvalues=tmp%e_val, eigenvectors=tmp%u) + + tmp%arg_r(:) = 0.5_dp*tmp%e_val(:)*dt* & + 0.5_dp*tmp%e_val(:)*dt + tmp%poly_r = 1.0_dp + e2*tmp%arg_r + e4*tmp%arg_r*tmp%arg_r + & + e6*tmp%arg_r**3 + e8*tmp%arg_r**4 + tmp%scale_r(:) = EXP(0.5_dp*dt*tmp%e_val(:)) + + tmp%arg_v(:) = 0.25_dp*dt*(tmp%e_val(:) + trvg*infree)* & + 0.25_dp*dt*(tmp%e_val(:) + trvg*infree) + tmp%poly_v = 1.0_dp + e2*tmp%arg_v + e4*tmp%arg_v*tmp%arg_v + & + e6*tmp%arg_v**3 + e8*tmp%arg_v**4 + tmp%scale_v(:) = EXP(-0.25_dp*dt*(tmp%e_val(:) + trvg*infree)) + + CALL vv_first(tmp, atomic_kind_set, local_particles, particle_set, & + core_particle_set, shell_particle_set, nparticle_kind, & + shell_adiabatic, dt, u=tmp%u) + + IF (simpar%variable_dt) CALL variable_timestep(md_env, tmp, dt, simpar, para_env, & + atomic_kind_set, local_particles, particle_set, core_particle_set, & + shell_particle_set, nparticle_kind, shell_adiabatic, npt=npt) + + roll_tol = 0.0_dp + vector_r = tmp%scale_r*tmp%poly_r + vector_v = tmp%scale_v*tmp%poly_v + + IF (simpar%constraint) CALL shake_roll_control(gci, local_molecules, & + molecule_set, molecule_kind_set, particle_set, tmp%pos, tmp%vel, dt, & + simpar, roll_tol, iroll, vector_r, vector_v, & + para_env%group, u=tmp%u, cell=cell, & + local_particles=local_particles) + END DO SR + + ! Update h_mat + uh = MATMUL_3X3(TRANSPOSE_3D(tmp%u), cell%hmat) + + DO i = 1, 3 + DO j = 1, 3 + uh(i, j) = uh(i, j)*tmp%scale_r(i)*tmp%scale_r(i) + END DO + END DO + + cell%hmat = MATMUL_3x3(tmp%u, uh) + ! Update the inverse + CALL init_cell(cell) + + ! Broadcast the new particle positions and deallocate the pos components of temporary + CALL update_dealloc_tmp(tmp, particle_set, shell_particle_set, & + core_particle_set, para_env, shell_adiabatic, pos=.TRUE.) + + IF (shell_adiabatic .AND. shell_check_distance) THEN + CALL optimize_shell_core(force_env, particle_set, & + shell_particle_set, core_particle_set, globenv, tmp=tmp, check=.TRUE.) + END IF + + ! Update forces + CALL force_env_calc_energy_force(force_env) + + ! Metadynamics + CALL metadyn_integrator(force_env, itimes, tmp%vel) + + ! Velocity Verlet (second part) + CALL vv_second(tmp, atomic_kind_set, local_particles, particle_set, & + core_particle_set, shell_particle_set, nparticle_kind, & + shell_adiabatic, dt, tmp%u) + IF (simpar%constraint) THEN + roll_tol_thrs = simpar%roll_tol + first = .TRUE. + iroll = 1 + CALL set(old, atomic_kind_set, particle_set, tmp%vel, local_particles, cell, npt, 'F') ELSE - CALL apply_thermostat_particles(thermostat_part, force_env,molecule_kind_set, molecule_set, & - particle_set, local_molecules, local_particles, para_env%group, vel=tmp%vel) + roll_tol_thrs = EPSILON(0.0_dp) + ENDIF + roll_tol = -roll_tol_thrs + + RR: DO WHILE (ABS(roll_tol) >= roll_tol_thrs) ! RATTLE-ROLL LOOP + roll_tol = 0.0_dp + IF (simpar%constraint) CALL rattle_roll_setup(old, gci, atomic_kind_set, & + particle_set, local_particles, molecule_kind_set, molecule_set, & + local_molecules, tmp%vel, dt, cell, npt, simpar, virial, vector_v, & + roll_tol, iroll, infree, first, para_env, u=tmp%u) + + CALL update_pv(gci, simpar, atomic_kind_set, tmp%vel, particle_set, & + local_molecules, molecule_set, molecule_kind_set, & + local_particles, kin, pv_kin, virial, para_env%group) + CALL update_veps(cell, npt, simpar, pv_kin, kin, virial, infree, & + virial_components=barostat%virial_components) + END DO RR + + ! Apply Thermostat over the full set of particles + IF (simpar%ensemble /= npe_f_ensemble) THEN + IF (shell_adiabatic) THEN + CALL apply_thermostat_particles(thermostat_part, force_env, molecule_kind_set, molecule_set, & + particle_set, local_molecules, local_particles, para_env%group, shell_adiabatic=shell_adiabatic, & + vel=tmp%vel, shell_vel=tmp%shell_vel, core_vel=tmp%core_vel) + + ELSE + CALL apply_thermostat_particles(thermostat_part, force_env, molecule_kind_set, molecule_set, & + particle_set, local_molecules, local_particles, para_env%group, vel=tmp%vel) + END IF + END IF + + ! Apply Thermostat over the core-shell motion + IF (ASSOCIATED(thermostat_shell)) THEN + CALL apply_thermostat_shells(thermostat_shell, atomic_kind_set, particle_set, & + local_particles, para_env%group, vel=tmp%vel, shell_vel=tmp%shell_vel, & + core_vel=tmp%core_vel) + END IF + + ! Apply Thermostat to Barostat + CALL apply_thermostat_baro(thermostat_baro, npt, para_env%group) + + ! Annealing of particle velocities is only possible when no thermostat is active + IF (simpar%ensemble == npe_f_ensemble .AND. simpar%annealing) THEN + tmp%vel(:, :) = tmp%vel(:, :)*simpar%f_annealing + IF (shell_adiabatic) THEN + CALL shell_scale_comv(atomic_kind_set, local_particles, particle_set, & + tmp%vel, tmp%shell_vel, tmp%core_vel) + END IF + END IF + ! Annealing of CELL velocities is only possible when no thermostat is active + IF (simpar%ensemble == npe_f_ensemble .AND. simpar%annealing_cell) THEN + npt(:, :)%v = npt(:, :)%v*simpar%f_annealing_cell END IF - END IF - - ! Apply Thermostat over the core-shell motion - IF(ASSOCIATED(thermostat_shell)) THEN - CALL apply_thermostat_shells(thermostat_shell,atomic_kind_set, particle_set,& - local_particles, para_env%group, vel=tmp%vel, shell_vel=tmp%shell_vel, & - core_vel=tmp%core_vel) - END IF - - ! Apply Thermostat to Barostat - CALL apply_thermostat_baro( thermostat_baro, npt, para_env%group) - - ! Annealing of particle velocities is only possible when no thermostat is active - IF (simpar% ensemble == npe_f_ensemble .AND. simpar%annealing) THEN - tmp%vel(:,:)=tmp%vel(:,:)*simpar%f_annealing - IF (shell_adiabatic) THEN - CALL shell_scale_comv(atomic_kind_set,local_particles,particle_set,& - tmp%vel,tmp%shell_vel,tmp%core_vel) - END IF - END IF - ! Annealing of CELL velocities is only possible when no thermostat is active - IF (simpar% ensemble == npe_f_ensemble .AND. simpar%annealing_cell) THEN - npt(:,:)%v = npt(:,:)%v * simpar%f_annealing_cell - END IF - - ! Broadcast the new particle velocities and deallocate temporary - CALL update_dealloc_tmp (tmp,particle_set, shell_particle_set, & - core_particle_set, para_env, shell_adiabatic, vel=.TRUE.) - - ! Update constraint virial - IF ( simpar%constraint ) & - CALL pv_constraint ( gci, local_molecules, molecule_set, & - molecule_kind_set, particle_set, virial, para_env%group ) - - CALL virial_evaluate ( atomic_kind_set, particle_set, & - local_particles, virial, para_env%group) - - ! Deallocate old variables - CALL deallocate_old ( old) - - IF (first_time) THEN - first_time = .FALSE. - CALL set_md_env(md_env, first_time=first_time) - END IF - - END SUBROUTINE npt_f + + ! Broadcast the new particle velocities and deallocate temporary + CALL update_dealloc_tmp(tmp, particle_set, shell_particle_set, & + core_particle_set, para_env, shell_adiabatic, vel=.TRUE.) + + ! Update constraint virial + IF (simpar%constraint) & + CALL pv_constraint(gci, local_molecules, molecule_set, & + molecule_kind_set, particle_set, virial, para_env%group) + + CALL virial_evaluate(atomic_kind_set, particle_set, & + local_particles, virial, para_env%group) + + ! Deallocate old variables + CALL deallocate_old(old) + + IF (first_time) THEN + first_time = .FALSE. + CALL set_md_env(md_env, first_time=first_time) + END IF + + END SUBROUTINE npt_f ! ************************************************************************************************** !> \brief RESPA integrator for nve ensemble for particle positions & momenta !> \param md_env ... !> \author FS ! ************************************************************************************************** - SUBROUTINE nve_respa ( md_env) + SUBROUTINE nve_respa(md_env) TYPE(md_environment_type), POINTER :: md_env @@ -2487,146 +2477,146 @@ SUBROUTINE nve_respa ( md_env) TYPE(particle_type), DIMENSION(:), POINTER :: particle_set, particle_set_respa TYPE(simpar_type), POINTER :: simpar - NULLIFY (para_env,cell,subsys_respa,particles_respa, particle_set_respa, gci, force_env, atomic_kinds) - NULLIFY (atomic_kind_set,simpar,subsys,particles,particle_set) - NULLIFY (local_molecules,molecule_kinds, molecules,molecule_kind_set, local_particles,itimes) - CALL get_md_env(md_env=md_env,simpar=simpar,force_env=force_env, & - para_env=para_env, itimes=itimes) - dt = simpar%dt - - n_time_steps=simpar%n_time_steps - - CALL force_env_get(force_env,subsys=subsys,cell=cell) - CALL force_env_get(force_env%sub_force_env(1)%force_env,subsys=subsys_respa) - - ! Do some checks on coordinates and box - CALL apply_qmmm_walls_reflective(force_env) - - CALL cp_subsys_get(subsys=subsys,atomic_kinds=atomic_kinds,local_particles=local_particles,& - particles=particles, local_molecules=local_molecules, molecules=molecules,& - gci=gci, molecule_kinds=molecule_kinds) - - CALL cp_subsys_get (subsys=subsys_respa, particles=particles_respa) - particle_set_respa => particles_respa%els - - nparticle_kind = atomic_kinds%n_els - atomic_kind_set => atomic_kinds%els - molecule_kind_set => molecule_kinds%els - - nparticle = particles%n_els - particle_set => particles%els - molecule_set => molecules%els - - ! Allocate work storage for positions and velocities - ALLOCATE (pos(3,nparticle)) - ALLOCATE (vel(3,nparticle)) - vel(:,:) = 0.0_dp - - IF (simpar%constraint) CALL getold(gci, local_molecules, molecule_set, & - molecule_kind_set, particle_set, cell) - - ! Multiple time step (first part) - DO iparticle_kind=1,nparticle_kind - atomic_kind => atomic_kind_set(iparticle_kind) - CALL get_atomic_kind(atomic_kind=atomic_kind,mass=mass) - dm = 0.5_dp * dt / mass - nparticle_local = local_particles%n_el(iparticle_kind) - DO iparticle_local=1,nparticle_local - iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) - vel (:,iparticle) = particle_set(iparticle)%v(:) +& - dm * (particle_set(iparticle)%f(:)-& - particle_set_respa(iparticle)%f(:)) - END DO - END DO - - ! Velocity Verlet (first part) - DO i_step=1,n_time_steps - pos(:,:) = 0.0_dp - DO iparticle_kind=1,nparticle_kind - atomic_kind => atomic_kind_set(iparticle_kind) - CALL get_atomic_kind(atomic_kind=atomic_kind,mass=mass) - dm = 0.5_dp*dt/(n_time_steps*mass) - nparticle_local = local_particles%n_el(iparticle_kind) - DO iparticle_local=1,nparticle_local - iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) - vel (:,iparticle) = vel(:,iparticle) +& - dm * particle_set_respa(iparticle)%f(:) - pos (:,iparticle) = particle_set(iparticle)%r(:) +& - (dt/n_time_steps) * vel ( :, iparticle ) - END DO - END DO - - IF (simpar%constraint) THEN - ! Possibly update the target values - CALL shake_update_targets(gci, local_molecules, molecule_set, & - molecule_kind_set, dt, force_env%root_section) - - CALL shake_control( gci, local_molecules, molecule_set,& - molecule_kind_set, particle_set,pos, vel, dt, simpar%shake_tol,& - simpar%info_constraint, simpar%lagrange_multipliers,simpar%dump_lm, cell,& - para_env%group, local_particles) - END IF - - ! Broadcast the new particle positions - CALL update_particle_set ( particle_set, para_env%group, pos = pos) - DO iparticle = 1, SIZE(particle_set) - particle_set_respa(iparticle)%r = particle_set(iparticle)%r - END DO - - ! Update forces - CALL force_env_calc_energy_force(force_env%sub_force_env(1)%force_env) - - ! Metadynamics - CALL metadyn_integrator(force_env, itimes, vel) - - ! Velocity Verlet (second part) - DO iparticle_kind=1,nparticle_kind - atomic_kind => atomic_kind_set(iparticle_kind) - CALL get_atomic_kind(atomic_kind=atomic_kind,mass=mass) - dm = 0.5_dp*dt /(n_time_steps * mass) - nparticle_local = local_particles%n_el(iparticle_kind) - DO iparticle_local=1,nparticle_local - iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) - vel ( 1, iparticle) = vel ( 1, iparticle) + dm*particle_set_respa(iparticle)%f(1) - vel ( 2, iparticle) = vel ( 2, iparticle) + dm*particle_set_respa(iparticle)%f(2) - vel ( 3, iparticle) = vel ( 3, iparticle) + dm*particle_set_respa(iparticle)%f(3) - END DO - END DO - - IF (simpar%constraint) CALL rattle_control( gci,local_molecules, molecule_set, & - molecule_kind_set, particle_set, vel, dt,simpar%shake_tol,& - simpar%info_constraint, simpar%lagrange_multipliers,& - simpar%dump_lm, cell, para_env%group,local_particles) - - IF (simpar%annealing) vel(:,:)=vel(:,:)*simpar%f_annealing - END DO - DEALLOCATE (pos) - - ! Multiple time step (second part) - ! Compute forces for respa force_env - CALL force_env_calc_energy_force(force_env) - - ! Metadynamics - CALL metadyn_integrator(force_env, itimes, vel) - - DO iparticle_kind=1,nparticle_kind - atomic_kind => atomic_kind_set(iparticle_kind) - CALL get_atomic_kind(atomic_kind=atomic_kind,mass=mass) - dm = 0.5_dp * dt / mass - nparticle_local = local_particles%n_el(iparticle_kind) - DO iparticle_local=1,nparticle_local - iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) - vel (1,iparticle) = vel(1, iparticle)+dm*(particle_set(iparticle)%f(1)-particle_set_respa(iparticle)%f(1)) - vel (2,iparticle) = vel(2, iparticle)+dm*(particle_set(iparticle)%f(2)-particle_set_respa(iparticle)%f(2)) - vel (3,iparticle) = vel(3, iparticle)+dm*(particle_set(iparticle)%f(3)-particle_set_respa(iparticle)%f(3)) - END DO - END DO - - ! Broadcast the new particle velocities - CALL update_particle_set ( particle_set, para_env%group, vel = vel) - - DEALLOCATE (vel) - - END SUBROUTINE nve_respa + NULLIFY (para_env, cell, subsys_respa, particles_respa, particle_set_respa, gci, force_env, atomic_kinds) + NULLIFY (atomic_kind_set, simpar, subsys, particles, particle_set) + NULLIFY (local_molecules, molecule_kinds, molecules, molecule_kind_set, local_particles, itimes) + CALL get_md_env(md_env=md_env, simpar=simpar, force_env=force_env, & + para_env=para_env, itimes=itimes) + dt = simpar%dt + + n_time_steps = simpar%n_time_steps + + CALL force_env_get(force_env, subsys=subsys, cell=cell) + CALL force_env_get(force_env%sub_force_env(1)%force_env, subsys=subsys_respa) + + ! Do some checks on coordinates and box + CALL apply_qmmm_walls_reflective(force_env) + + CALL cp_subsys_get(subsys=subsys, atomic_kinds=atomic_kinds, local_particles=local_particles, & + particles=particles, local_molecules=local_molecules, molecules=molecules, & + gci=gci, molecule_kinds=molecule_kinds) + + CALL cp_subsys_get(subsys=subsys_respa, particles=particles_respa) + particle_set_respa => particles_respa%els + + nparticle_kind = atomic_kinds%n_els + atomic_kind_set => atomic_kinds%els + molecule_kind_set => molecule_kinds%els + + nparticle = particles%n_els + particle_set => particles%els + molecule_set => molecules%els + + ! Allocate work storage for positions and velocities + ALLOCATE (pos(3, nparticle)) + ALLOCATE (vel(3, nparticle)) + vel(:, :) = 0.0_dp + + IF (simpar%constraint) CALL getold(gci, local_molecules, molecule_set, & + molecule_kind_set, particle_set, cell) + + ! Multiple time step (first part) + DO iparticle_kind = 1, nparticle_kind + atomic_kind => atomic_kind_set(iparticle_kind) + CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) + dm = 0.5_dp*dt/mass + nparticle_local = local_particles%n_el(iparticle_kind) + DO iparticle_local = 1, nparticle_local + iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) + vel(:, iparticle) = particle_set(iparticle)%v(:) + & + dm*(particle_set(iparticle)%f(:) - & + particle_set_respa(iparticle)%f(:)) + END DO + END DO + + ! Velocity Verlet (first part) + DO i_step = 1, n_time_steps + pos(:, :) = 0.0_dp + DO iparticle_kind = 1, nparticle_kind + atomic_kind => atomic_kind_set(iparticle_kind) + CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) + dm = 0.5_dp*dt/(n_time_steps*mass) + nparticle_local = local_particles%n_el(iparticle_kind) + DO iparticle_local = 1, nparticle_local + iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) + vel(:, iparticle) = vel(:, iparticle) + & + dm*particle_set_respa(iparticle)%f(:) + pos(:, iparticle) = particle_set(iparticle)%r(:) + & + (dt/n_time_steps)*vel(:, iparticle) + END DO + END DO + + IF (simpar%constraint) THEN + ! Possibly update the target values + CALL shake_update_targets(gci, local_molecules, molecule_set, & + molecule_kind_set, dt, force_env%root_section) + + CALL shake_control(gci, local_molecules, molecule_set, & + molecule_kind_set, particle_set, pos, vel, dt, simpar%shake_tol, & + simpar%info_constraint, simpar%lagrange_multipliers, simpar%dump_lm, cell, & + para_env%group, local_particles) + END IF + + ! Broadcast the new particle positions + CALL update_particle_set(particle_set, para_env%group, pos=pos) + DO iparticle = 1, SIZE(particle_set) + particle_set_respa(iparticle)%r = particle_set(iparticle)%r + END DO + + ! Update forces + CALL force_env_calc_energy_force(force_env%sub_force_env(1)%force_env) + + ! Metadynamics + CALL metadyn_integrator(force_env, itimes, vel) + + ! Velocity Verlet (second part) + DO iparticle_kind = 1, nparticle_kind + atomic_kind => atomic_kind_set(iparticle_kind) + CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) + dm = 0.5_dp*dt/(n_time_steps*mass) + nparticle_local = local_particles%n_el(iparticle_kind) + DO iparticle_local = 1, nparticle_local + iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) + vel(1, iparticle) = vel(1, iparticle) + dm*particle_set_respa(iparticle)%f(1) + vel(2, iparticle) = vel(2, iparticle) + dm*particle_set_respa(iparticle)%f(2) + vel(3, iparticle) = vel(3, iparticle) + dm*particle_set_respa(iparticle)%f(3) + END DO + END DO + + IF (simpar%constraint) CALL rattle_control(gci, local_molecules, molecule_set, & + molecule_kind_set, particle_set, vel, dt, simpar%shake_tol, & + simpar%info_constraint, simpar%lagrange_multipliers, & + simpar%dump_lm, cell, para_env%group, local_particles) + + IF (simpar%annealing) vel(:, :) = vel(:, :)*simpar%f_annealing + END DO + DEALLOCATE (pos) + + ! Multiple time step (second part) + ! Compute forces for respa force_env + CALL force_env_calc_energy_force(force_env) + + ! Metadynamics + CALL metadyn_integrator(force_env, itimes, vel) + + DO iparticle_kind = 1, nparticle_kind + atomic_kind => atomic_kind_set(iparticle_kind) + CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) + dm = 0.5_dp*dt/mass + nparticle_local = local_particles%n_el(iparticle_kind) + DO iparticle_local = 1, nparticle_local + iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) + vel(1, iparticle) = vel(1, iparticle) + dm*(particle_set(iparticle)%f(1) - particle_set_respa(iparticle)%f(1)) + vel(2, iparticle) = vel(2, iparticle) + dm*(particle_set(iparticle)%f(2) - particle_set_respa(iparticle)%f(2)) + vel(3, iparticle) = vel(3, iparticle) + dm*(particle_set(iparticle)%f(3) - particle_set_respa(iparticle)%f(3)) + END DO + END DO + + ! Broadcast the new particle velocities + CALL update_particle_set(particle_set, para_env%group, vel=vel) + + DEALLOCATE (vel) + + END SUBROUTINE nve_respa END MODULE integrator diff --git a/src/motion/integrator_utils.F b/src/motion/integrator_utils.F index a83608ba0e..5897c35baa 100644 --- a/src/motion/integrator_utils.F +++ b/src/motion/integrator_utils.F @@ -366,16 +366,16 @@ SUBROUTINE get_s_ds(tmp, nparticle_kind, atomic_kind_set, local_particles, parti IF (my_tmpv) THEN DO iparticle_local = 1, nparticle_local iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) - K = K+0.5_dp*mass*DOT_PRODUCT(tmp%vel(:, iparticle), tmp%vel(:, iparticle)) - a = a+DOT_PRODUCT(tmp%vel(:, iparticle), particle_set(iparticle)%f(:)) - b = b+(1.0_dp/mass)*DOT_PRODUCT(particle_set(iparticle)%f(:), particle_set(iparticle)%f(:)) + K = K + 0.5_dp*mass*DOT_PRODUCT(tmp%vel(:, iparticle), tmp%vel(:, iparticle)) + a = a + DOT_PRODUCT(tmp%vel(:, iparticle), particle_set(iparticle)%f(:)) + b = b + (1.0_dp/mass)*DOT_PRODUCT(particle_set(iparticle)%f(:), particle_set(iparticle)%f(:)) END DO ELSE DO iparticle_local = 1, nparticle_local iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) - K = K+0.5_dp*mass*DOT_PRODUCT(particle_set(iparticle)%v(:), particle_set(iparticle)%v(:)) - a = a+DOT_PRODUCT(particle_set(iparticle)%v(:), particle_set(iparticle)%f(:)) - b = b+(1.0_dp/mass)*DOT_PRODUCT(particle_set(iparticle)%f(:), particle_set(iparticle)%f(:)) + K = K + 0.5_dp*mass*DOT_PRODUCT(particle_set(iparticle)%v(:), particle_set(iparticle)%v(:)) + a = a + DOT_PRODUCT(particle_set(iparticle)%v(:), particle_set(iparticle)%f(:)) + b = b + (1.0_dp/mass)*DOT_PRODUCT(particle_set(iparticle)%f(:), particle_set(iparticle)%f(:)) END DO END IF END IF @@ -386,8 +386,8 @@ SUBROUTINE get_s_ds(tmp, nparticle_kind, atomic_kind_set, local_particles, parti a = a/(2.0_dp*K) b = b/(2.0_dp*K) rb = SQRT(b) - tmp%s = (a/b)*(COSH(dt*rb/2.0_dp)-1)+SINH(dt*rb/2.0_dp)/rb - tmp%ds = (a/b)*(SINH(dt*rb/2.0_dp)*rb)+COSH(dt*rb/2.0_dp) + tmp%s = (a/b)*(COSH(dt*rb/2.0_dp) - 1) + SINH(dt*rb/2.0_dp)/rb + tmp%ds = (a/b)*(SINH(dt*rb/2.0_dp)*rb) + COSH(dt*rb/2.0_dp) END SUBROUTINE get_s_ds @@ -562,11 +562,11 @@ SUBROUTINE damp_v_particle_set(molecule_kind_set, molecule_set, & DO ipart = first_atom, last_atom atomic_kind => particle_set(ipart)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) - kin = kin+mass*particle_set(ipart)%v(1)* & + kin = kin + mass*particle_set(ipart)%v(1)* & particle_set(ipart)%v(1) - kin = kin+mass*particle_set(ipart)%v(2)* & + kin = kin + mass*particle_set(ipart)%v(2)* & particle_set(ipart)%v(2) - kin = kin+mass*particle_set(ipart)%v(3)* & + kin = kin + mass*particle_set(ipart)%v(3)* & particle_set(ipart)%v(3) END DO END DO @@ -577,7 +577,7 @@ SUBROUTINE damp_v_particle_set(molecule_kind_set, molecule_set, & ikin = 1.0_dp/kin scale = 1.0_dp alpha = 2.0_dp*npt%mass*npt%v*npt%v*gamma1*ikin - scale = scale*SQRT(1.0_dp+alpha*0.5_dp*dt) + scale = scale*SQRT(1.0_dp + alpha*0.5_dp*dt) ! Scale DO ikind = 1, SIZE(molecule_kind_set) nmol_local = local_molecules%n_el(ikind) @@ -642,9 +642,9 @@ SUBROUTINE damp_v_velocity(molecule_kind_set, molecule_set, & DO ipart = first_atom, last_atom atomic_kind => particle_set(ipart)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) - kin = kin+mass*vel(1, ipart)*vel(1, ipart) - kin = kin+mass*vel(2, ipart)*vel(2, ipart) - kin = kin+mass*vel(3, ipart)*vel(3, ipart) + kin = kin + mass*vel(1, ipart)*vel(1, ipart) + kin = kin + mass*vel(2, ipart)*vel(2, ipart) + kin = kin + mass*vel(3, ipart)*vel(3, ipart) END DO END DO END DO @@ -654,7 +654,7 @@ SUBROUTINE damp_v_velocity(molecule_kind_set, molecule_set, & ikin = 1.0_dp/kin scale = 1.0_dp alpha = 2.0_dp*npt%mass*npt%v*npt%v*gamma1*ikin - scale = scale*SQRT(1.0_dp+alpha*0.5_dp*dt) + scale = scale*SQRT(1.0_dp + alpha*0.5_dp*dt) ! Scale DO ikind = 1, SIZE(molecule_kind_set) nmol_local = local_molecules%n_el(ikind) @@ -835,11 +835,11 @@ SUBROUTINE update_pv_particle_set(gci, simpar, atomic_kind_set, particle_set, & iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) DO i = 1, 3 DO j = 1, 3 - pv_kin(i, j) = pv_kin(i, j)+ & + pv_kin(i, j) = pv_kin(i, j) + & mass*particle_set(iparticle)%v(i)* & particle_set(iparticle)%v(j) END DO - kin = kin+mass*particle_set(iparticle)%v(i)* & + kin = kin + mass*particle_set(iparticle)%v(i)* & particle_set(iparticle)%v(i) END DO END DO @@ -909,10 +909,10 @@ SUBROUTINE update_pv_velocity(gci, simpar, atomic_kind_set, vel, particle_set, & iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) DO i = 1, 3 DO j = 1, 3 - pv_kin(i, j) = pv_kin(i, j)+ & + pv_kin(i, j) = pv_kin(i, j) + & mass*vel(i, iparticle)*vel(j, iparticle) END DO - kin = kin+mass*vel(i, iparticle)*vel(i, iparticle) + kin = kin + mass*vel(i, iparticle)*vel(i, iparticle) END DO END DO END DO @@ -971,20 +971,20 @@ SUBROUTINE update_veps(box, npt, simpar, pv_kin, kin, virial, infree, virial_com ! get force on barostat fdotr = 0.0_dp DO ii = 1, 3 - fdotr = fdotr+virial%pv_virial(ii, ii)+ & + fdotr = fdotr + virial%pv_virial(ii, ii) + & virial%pv_constraint(ii, ii) END DO - npt(:, :)%f = (1.0_dp+(3.0_dp*infree))*kin+fdotr- & + npt(:, :)%f = (1.0_dp + (3.0_dp*infree))*kin + fdotr - & 3.0_dp*simpar%p_ext*box%deth ELSEIF (simpar%ensemble == npt_f_ensemble .OR. & simpar%ensemble == npe_f_ensemble) THEN - npt(:, :)%f = virial%pv_virial(:, :)+ & - pv_kin(:, :)+virial%pv_constraint(:, :)- & - unit(:, :)*simpar%p_ext*box%deth+ & + npt(:, :)%f = virial%pv_virial(:, :) + & + pv_kin(:, :) + virial%pv_constraint(:, :) - & + unit(:, :)*simpar%p_ext*box%deth + & infree*kin*unit(:, :) IF (debug_isotropic_limit) THEN - trace = npt(1, 1)%f+npt(2, 2)%f+npt(3, 3)%f + trace = npt(1, 1)%f + npt(2, 2)%f + npt(3, 3)%f trace = trace/3.0_dp npt(:, :)%f = trace*unit(:, :) END IF @@ -997,25 +997,25 @@ SUBROUTINE update_veps(box, npt, simpar, pv_kin, kin, virial, infree, virial_com ! orthorhombic box ONLY ! Chooses only the compressive solution IF (v < v0) THEN - npt(1, 1)%f = virial%pv_virial(1, 1)+ & - pv_kin(1, 1)+virial%pv_constraint(1, 1)- & - simpar%p0*v-simpar%v_shock*simpar%v_shock* & - v*v0i*(1._dp-v*v0i)+infree*kin + npt(1, 1)%f = virial%pv_virial(1, 1) + & + pv_kin(1, 1) + virial%pv_constraint(1, 1) - & + simpar%p0*v - simpar%v_shock*simpar%v_shock* & + v*v0i*(1._dp - v*v0i) + infree*kin ELSE - npt(1, 1)%f = virial%pv_virial(1, 1)+ & - pv_kin(1, 1)+virial%pv_constraint(1, 1)- & - simpar%p0*v+infree*kin + npt(1, 1)%f = virial%pv_virial(1, 1) + & + pv_kin(1, 1) + virial%pv_constraint(1, 1) - & + simpar%p0*v + infree*kin ENDIF IF (debug_uniaxial_limit) THEN ! orthorhombic box ONLY - npt(1, 1)%f = virial%pv_virial(1, 1)+ & - pv_kin(1, 1)+virial%pv_constraint(1, 1)- & - simpar%p0*box%deth+infree*kin + npt(1, 1)%f = virial%pv_virial(1, 1) + & + pv_kin(1, 1) + virial%pv_constraint(1, 1) - & + simpar%p0*box%deth + infree*kin END IF ENDIF ! update barostat velocities - npt(:, :)%v = npt(:, :)%v+ & + npt(:, :)%v = npt(:, :)%v + & 0.5_dp*simpar%dt*npt(:, :)%f/npt(:, :)%mass ! Screen the dynamics of the barostat according user request @@ -1190,31 +1190,31 @@ SUBROUTINE vv_first(tmp, atomic_kind_set, local_particles, particle_set, & shell_index, u, dmc, dt, tmp%poly_v, tmp%poly_r, tmp%scale_v, tmp%scale_r) ! Derive velocities and positions of the COM - tmp%vel(:, iparticle) = fac_masss*tmp%shell_vel(:, shell_index)+ & + tmp%vel(:, iparticle) = fac_masss*tmp%shell_vel(:, shell_index) + & fac_massc*tmp%core_vel(:, shell_index) - tmp%pos(:, iparticle) = fac_masss*tmp%shell_pos(:, shell_index)+ & + tmp%pos(:, iparticle) = fac_masss*tmp%shell_pos(:, shell_index) + & fac_massc*tmp%core_pos(:, shell_index) tmp%max_vel = MAX(tmp%max_vel, ABS(tmp%vel(1, iparticle)), & ABS(tmp%vel(2, iparticle)), ABS(tmp%vel(3, iparticle))) tmp%max_vel_sc = MAX(tmp%max_vel_sc, & - ABS(tmp%shell_vel(1, shell_index)-tmp%core_vel(1, shell_index)), & - ABS(tmp%shell_vel(2, shell_index)-tmp%core_vel(2, shell_index)), & - ABS(tmp%shell_vel(3, shell_index)-tmp%core_vel(3, shell_index))) + ABS(tmp%shell_vel(1, shell_index) - tmp%core_vel(1, shell_index)), & + ABS(tmp%shell_vel(2, shell_index) - tmp%core_vel(2, shell_index)), & + ABS(tmp%shell_vel(3, shell_index) - tmp%core_vel(3, shell_index))) tmp%max_dr = MAX(tmp%max_dr, & - ABS(particle_set(iparticle)%r(1)-tmp%pos(1, iparticle)), & - ABS(particle_set(iparticle)%r(2)-tmp%pos(2, iparticle)), & - ABS(particle_set(iparticle)%r(3)-tmp%pos(3, iparticle))) + ABS(particle_set(iparticle)%r(1) - tmp%pos(1, iparticle)), & + ABS(particle_set(iparticle)%r(2) - tmp%pos(2, iparticle)), & + ABS(particle_set(iparticle)%r(3) - tmp%pos(3, iparticle))) tmp%max_dvel = MAX(tmp%max_dvel, & - ABS(particle_set(iparticle)%v(1)-tmp%vel(1, iparticle)), & - ABS(particle_set(iparticle)%v(2)-tmp%vel(2, iparticle)), & - ABS(particle_set(iparticle)%v(3)-tmp%vel(3, iparticle))) + ABS(particle_set(iparticle)%v(1) - tmp%vel(1, iparticle)), & + ABS(particle_set(iparticle)%v(2) - tmp%vel(2, iparticle)), & + ABS(particle_set(iparticle)%v(3) - tmp%vel(3, iparticle))) - dsc(:) = tmp%shell_pos(:, shell_index)-tmp%core_pos(:, shell_index)- & - shell_particle_set(shell_index)%r(:)+core_particle_set(shell_index)%r(:) + dsc(:) = tmp%shell_pos(:, shell_index) - tmp%core_pos(:, shell_index) - & + shell_particle_set(shell_index)%r(:) + core_particle_set(shell_index)%r(:) tmp%max_dsc = MAX(tmp%max_dsc, ABS(dsc(1)), ABS(dsc(2)), ABS(dsc(3))) - dvsc(:) = tmp%shell_vel(:, shell_index)-tmp%core_vel(:, shell_index)- & - shell_particle_set(shell_index)%v(:)+core_particle_set(shell_index)%v(:) + dvsc(:) = tmp%shell_vel(:, shell_index) - tmp%core_vel(:, shell_index) - & + shell_particle_set(shell_index)%v(:) + core_particle_set(shell_index)%v(:) tmp%max_dvel_sc = MAX(tmp%max_dvel_sc, ABS(dvsc(1)), ABS(dvsc(2)), ABS(dvsc(3))) END DO ! iparticle_local ELSE @@ -1222,41 +1222,41 @@ SUBROUTINE vv_first(tmp, atomic_kind_set, local_particles, particle_set, & iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) shell_index = particle_set(iparticle)%shell_index tmp%shell_vel(:, shell_index) = & - shell_particle_set(shell_index)%v(:)*tmp%scale_v(:)*tmp%scale_v(:)+ & + shell_particle_set(shell_index)%v(:)*tmp%scale_v(:)*tmp%scale_v(:) + & tmp%scale_v(:)*tmp%poly_v(:)*dms*shell_particle_set(shell_index)%f(:) tmp%shell_pos(:, shell_index) = & - shell_particle_set(shell_index)%r(:)*tmp%scale_r(:)*tmp%scale_r(:)+ & + shell_particle_set(shell_index)%r(:)*tmp%scale_r(:)*tmp%scale_r(:) + & tmp%scale_r(:)*tmp%poly_r(:)*dt*tmp%shell_vel(:, shell_index) tmp%core_vel(:, shell_index) = & - core_particle_set(shell_index)%v(:)*tmp%scale_v(:)*tmp%scale_v(:)+ & + core_particle_set(shell_index)%v(:)*tmp%scale_v(:)*tmp%scale_v(:) + & tmp%scale_v(:)*tmp%poly_v(:)*dmc*core_particle_set(shell_index)%f(:) tmp%core_pos(:, shell_index) = & - core_particle_set(shell_index)%r(:)*tmp%scale_r(:)*tmp%scale_r(:)+ & + core_particle_set(shell_index)%r(:)*tmp%scale_r(:)*tmp%scale_r(:) + & tmp%scale_r(:)*tmp%poly_r(:)*dt*tmp%core_vel(:, shell_index) - tmp%vel(:, iparticle) = fac_masss*tmp%shell_vel(:, shell_index)+ & + tmp%vel(:, iparticle) = fac_masss*tmp%shell_vel(:, shell_index) + & fac_massc*tmp%core_vel(:, shell_index) - tmp%pos(:, iparticle) = fac_masss*tmp%shell_pos(:, shell_index)+ & + tmp%pos(:, iparticle) = fac_masss*tmp%shell_pos(:, shell_index) + & fac_massc*tmp%core_pos(:, shell_index) tmp%max_vel = MAX(tmp%max_vel, & ABS(tmp%vel(1, iparticle)), ABS(tmp%vel(2, iparticle)), ABS(tmp%vel(3, iparticle))) tmp%max_vel_sc = MAX(tmp%max_vel_sc, & - ABS(tmp%shell_vel(1, shell_index)-tmp%core_vel(1, shell_index)), & - ABS(tmp%shell_vel(2, shell_index)-tmp%core_vel(2, shell_index)), & - ABS(tmp%shell_vel(3, shell_index)-tmp%core_vel(3, shell_index))) + ABS(tmp%shell_vel(1, shell_index) - tmp%core_vel(1, shell_index)), & + ABS(tmp%shell_vel(2, shell_index) - tmp%core_vel(2, shell_index)), & + ABS(tmp%shell_vel(3, shell_index) - tmp%core_vel(3, shell_index))) tmp%max_dr = MAX(tmp%max_dr, & - ABS(particle_set(iparticle)%r(1)-tmp%pos(1, iparticle)), & - ABS(particle_set(iparticle)%r(2)-tmp%pos(2, iparticle)), & - ABS(particle_set(iparticle)%r(3)-tmp%pos(3, iparticle))) + ABS(particle_set(iparticle)%r(1) - tmp%pos(1, iparticle)), & + ABS(particle_set(iparticle)%r(2) - tmp%pos(2, iparticle)), & + ABS(particle_set(iparticle)%r(3) - tmp%pos(3, iparticle))) tmp%max_dvel = MAX(tmp%max_dvel, & - ABS(particle_set(iparticle)%v(1)-tmp%vel(1, iparticle)), & - ABS(particle_set(iparticle)%v(2)-tmp%vel(2, iparticle)), & - ABS(particle_set(iparticle)%v(3)-tmp%vel(3, iparticle))) - dsc(:) = tmp%shell_pos(:, shell_index)-tmp%core_pos(:, shell_index)- & - shell_particle_set(shell_index)%r(:)+core_particle_set(shell_index)%r(:) + ABS(particle_set(iparticle)%v(1) - tmp%vel(1, iparticle)), & + ABS(particle_set(iparticle)%v(2) - tmp%vel(2, iparticle)), & + ABS(particle_set(iparticle)%v(3) - tmp%vel(3, iparticle))) + dsc(:) = tmp%shell_pos(:, shell_index) - tmp%core_pos(:, shell_index) - & + shell_particle_set(shell_index)%r(:) + core_particle_set(shell_index)%r(:) tmp%max_dsc = MAX(tmp%max_dsc, ABS(dsc(1)), ABS(dsc(2)), ABS(dsc(3))) - dvsc(:) = tmp%shell_vel(:, shell_index)-tmp%core_vel(:, shell_index)- & - shell_particle_set(shell_index)%v(:)+core_particle_set(shell_index)%v(:) + dvsc(:) = tmp%shell_vel(:, shell_index) - tmp%core_vel(:, shell_index) - & + shell_particle_set(shell_index)%v(:) + core_particle_set(shell_index)%v(:) tmp%max_dvel_sc = MAX(tmp%max_dvel_sc, ABS(dvsc(1)), ABS(dvsc(2)), ABS(dvsc(3))) END DO ! iparticle_local END IF @@ -1271,46 +1271,46 @@ SUBROUTINE vv_first(tmp, atomic_kind_set, local_particles, particle_set, & tmp%max_vel = MAX(tmp%max_vel, & ABS(tmp%vel(1, iparticle)), ABS(tmp%vel(2, iparticle)), ABS(tmp%vel(3, iparticle))) - tmp%max_dr = MAX(tmp%max_dr, ABS(particle_set(iparticle)%r(1)-tmp%pos(1, iparticle)), & - ABS(particle_set(iparticle)%r(2)-tmp%pos(2, iparticle)), & - ABS(particle_set(iparticle)%r(3)-tmp%pos(3, iparticle))) + tmp%max_dr = MAX(tmp%max_dr, ABS(particle_set(iparticle)%r(1) - tmp%pos(1, iparticle)), & + ABS(particle_set(iparticle)%r(2) - tmp%pos(2, iparticle)), & + ABS(particle_set(iparticle)%r(3) - tmp%pos(3, iparticle))) tmp%max_dvel = MAX(tmp%max_dvel, & - ABS(particle_set(iparticle)%v(1)-tmp%vel(1, iparticle)), & - ABS(particle_set(iparticle)%v(2)-tmp%vel(2, iparticle)), & - ABS(particle_set(iparticle)%v(3)-tmp%vel(3, iparticle))) + ABS(particle_set(iparticle)%v(1) - tmp%vel(1, iparticle)), & + ABS(particle_set(iparticle)%v(2) - tmp%vel(2, iparticle)), & + ABS(particle_set(iparticle)%v(3) - tmp%vel(3, iparticle))) END DO ! iparticle_local ELSE DO iparticle_local = 1, nparticle_local iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) tmp%vel(1, iparticle) = & - particle_set(iparticle)%v(1)*tmp%scale_v(1)*tmp%scale_v(1)+ & + particle_set(iparticle)%v(1)*tmp%scale_v(1)*tmp%scale_v(1) + & tmp%scale_v(1)*tmp%poly_v(1)*dm*particle_set(iparticle)%f(1) tmp%vel(2, iparticle) = & - particle_set(iparticle)%v(2)*tmp%scale_v(2)*tmp%scale_v(2)+ & + particle_set(iparticle)%v(2)*tmp%scale_v(2)*tmp%scale_v(2) + & tmp%scale_v(2)*tmp%poly_v(2)*dm*particle_set(iparticle)%f(2) tmp%vel(3, iparticle) = & - particle_set(iparticle)%v(3)*tmp%scale_v(3)*tmp%scale_v(3)+ & + particle_set(iparticle)%v(3)*tmp%scale_v(3)*tmp%scale_v(3) + & tmp%scale_v(3)*tmp%poly_v(3)*dm*particle_set(iparticle)%f(3) tmp%pos(1, iparticle) = & - particle_set(iparticle)%r(1)*tmp%scale_r(1)*tmp%scale_r(1)+ & + particle_set(iparticle)%r(1)*tmp%scale_r(1)*tmp%scale_r(1) + & tmp%scale_r(1)*tmp%poly_r(1)*dt*tmp%vel(1, iparticle) tmp%pos(2, iparticle) = & - particle_set(iparticle)%r(2)*tmp%scale_r(2)*tmp%scale_r(2)+ & + particle_set(iparticle)%r(2)*tmp%scale_r(2)*tmp%scale_r(2) + & tmp%scale_r(2)*tmp%poly_r(2)*dt*tmp%vel(2, iparticle) tmp%pos(3, iparticle) = & - particle_set(iparticle)%r(3)*tmp%scale_r(3)*tmp%scale_r(3)+ & + particle_set(iparticle)%r(3)*tmp%scale_r(3)*tmp%scale_r(3) + & tmp%scale_r(3)*tmp%poly_r(3)*dt*tmp%vel(3, iparticle) tmp%max_vel = MAX(tmp%max_vel, & ABS(tmp%vel(1, iparticle)), ABS(tmp%vel(2, iparticle)), ABS(tmp%vel(3, iparticle))) tmp%max_dr = MAX(tmp%max_dr, & - ABS(particle_set(iparticle)%r(1)-tmp%pos(1, iparticle)), & - ABS(particle_set(iparticle)%r(2)-tmp%pos(2, iparticle)), & - ABS(particle_set(iparticle)%r(3)-tmp%pos(3, iparticle))) + ABS(particle_set(iparticle)%r(1) - tmp%pos(1, iparticle)), & + ABS(particle_set(iparticle)%r(2) - tmp%pos(2, iparticle)), & + ABS(particle_set(iparticle)%r(3) - tmp%pos(3, iparticle))) tmp%max_dvel = MAX(tmp%max_dvel, & - ABS(particle_set(iparticle)%v(1)-tmp%vel(1, iparticle)), & - ABS(particle_set(iparticle)%v(2)-tmp%vel(2, iparticle)), & - ABS(particle_set(iparticle)%v(3)-tmp%vel(3, iparticle))) + ABS(particle_set(iparticle)%v(1) - tmp%vel(1, iparticle)), & + ABS(particle_set(iparticle)%v(2) - tmp%vel(2, iparticle)), & + ABS(particle_set(iparticle)%v(3) - tmp%vel(3, iparticle))) END DO END IF END IF @@ -1388,11 +1388,11 @@ SUBROUTINE vv_second(tmp, atomic_kind_set, local_particles, particle_set, & u, dmc, tmp%poly_v, tmp%scale_v) ! Derive velocties of the COM - tmp%vel(1, iparticle) = fac_masss*tmp%shell_vel(1, shell_index)+ & + tmp%vel(1, iparticle) = fac_masss*tmp%shell_vel(1, shell_index) + & fac_massc*tmp%core_vel(1, shell_index) - tmp%vel(2, iparticle) = fac_masss*tmp%shell_vel(2, shell_index)+ & + tmp%vel(2, iparticle) = fac_masss*tmp%shell_vel(2, shell_index) + & fac_massc*tmp%core_vel(2, shell_index) - tmp%vel(3, iparticle) = fac_masss*tmp%shell_vel(3, shell_index)+ & + tmp%vel(3, iparticle) = fac_masss*tmp%shell_vel(3, shell_index) + & fac_massc*tmp%core_vel(3, shell_index) END DO ! iparticle_local ELSE @@ -1400,29 +1400,29 @@ SUBROUTINE vv_second(tmp, atomic_kind_set, local_particles, particle_set, & iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) shell_index = particle_set(iparticle)%shell_index tmp%shell_vel(1, shell_index) = & - tmp%shell_vel(1, shell_index)*tmp%scale_v(1)*tmp%scale_v(1)+ & + tmp%shell_vel(1, shell_index)*tmp%scale_v(1)*tmp%scale_v(1) + & tmp%scale_v(1)*tmp%poly_v(1)*dms*shell_particle_set(shell_index)%f(1) tmp%shell_vel(2, shell_index) = & - tmp%shell_vel(2, shell_index)*tmp%scale_v(2)*tmp%scale_v(2)+ & + tmp%shell_vel(2, shell_index)*tmp%scale_v(2)*tmp%scale_v(2) + & tmp%scale_v(2)*tmp%poly_v(2)*dms*shell_particle_set(shell_index)%f(2) tmp%shell_vel(3, shell_index) = & - tmp%shell_vel(3, shell_index)*tmp%scale_v(3)*tmp%scale_v(3)+ & + tmp%shell_vel(3, shell_index)*tmp%scale_v(3)*tmp%scale_v(3) + & tmp%scale_v(3)*tmp%poly_v(3)*dms*shell_particle_set(shell_index)%f(3) tmp%core_vel(1, shell_index) = & - tmp%core_vel(1, shell_index)*tmp%scale_v(1)*tmp%scale_v(1)+ & + tmp%core_vel(1, shell_index)*tmp%scale_v(1)*tmp%scale_v(1) + & tmp%scale_v(1)*tmp%poly_v(1)*dmc*core_particle_set(shell_index)%f(1) tmp%core_vel(2, shell_index) = & - tmp%core_vel(2, shell_index)*tmp%scale_v(2)*tmp%scale_v(2)+ & + tmp%core_vel(2, shell_index)*tmp%scale_v(2)*tmp%scale_v(2) + & tmp%scale_v(2)*tmp%poly_v(2)*dmc*core_particle_set(shell_index)%f(2) tmp%core_vel(3, shell_index) = & - tmp%core_vel(3, shell_index)*tmp%scale_v(3)*tmp%scale_v(3)+ & + tmp%core_vel(3, shell_index)*tmp%scale_v(3)*tmp%scale_v(3) + & tmp%scale_v(3)*tmp%poly_v(3)*dmc*core_particle_set(shell_index)%f(3) - tmp%vel(1, iparticle) = fac_masss*tmp%shell_vel(1, shell_index)+ & + tmp%vel(1, iparticle) = fac_masss*tmp%shell_vel(1, shell_index) + & fac_massc*tmp%core_vel(1, shell_index) - tmp%vel(2, iparticle) = fac_masss*tmp%shell_vel(2, shell_index)+ & + tmp%vel(2, iparticle) = fac_masss*tmp%shell_vel(2, shell_index) + & fac_massc*tmp%core_vel(2, shell_index) - tmp%vel(3, iparticle) = fac_masss*tmp%shell_vel(3, shell_index)+ & + tmp%vel(3, iparticle) = fac_masss*tmp%shell_vel(3, shell_index) + & fac_massc*tmp%core_vel(3, shell_index) END DO ! iparticle_local END IF @@ -1438,13 +1438,13 @@ SUBROUTINE vv_second(tmp, atomic_kind_set, local_particles, particle_set, & DO iparticle_local = 1, nparticle_local iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) tmp%vel(1, iparticle) = & - tmp%vel(1, iparticle)*tmp%scale_v(1)*tmp%scale_v(1)+ & + tmp%vel(1, iparticle)*tmp%scale_v(1)*tmp%scale_v(1) + & tmp%scale_v(1)*tmp%poly_v(1)*dm*particle_set(iparticle)%f(1) tmp%vel(2, iparticle) = & - tmp%vel(2, iparticle)*tmp%scale_v(2)*tmp%scale_v(2)+ & + tmp%vel(2, iparticle)*tmp%scale_v(2)*tmp%scale_v(2) + & tmp%scale_v(2)*tmp%poly_v(2)*dm*particle_set(iparticle)%f(2) tmp%vel(3, iparticle) = & - tmp%vel(3, iparticle)*tmp%scale_v(3)*tmp%scale_v(3)+ & + tmp%vel(3, iparticle)*tmp%scale_v(3)*tmp%scale_v(3) + & tmp%scale_v(3)*tmp%poly_v(3)*dm*particle_set(iparticle)%f(3) END DO END IF @@ -1490,13 +1490,13 @@ SUBROUTINE transform_first(particle_set, pos, vel, index, u, dm, dt, poly_v, & CALL matvec_3x3(uv, TRANSPOSE_3D(u), particle_set(index)%v(:)) CALL matvec_3x3(uf, TRANSPOSE_3D(u), particle_set(index)%f(:)) ! - uv(1) = uv(1)*scale_v(1)*scale_v(1)+uf(1)*scale_v(1)*poly_v(1)*dm - uv(2) = uv(2)*scale_v(2)*scale_v(2)+uf(2)*scale_v(2)*poly_v(2)*dm - uv(3) = uv(3)*scale_v(3)*scale_v(3)+uf(3)*scale_v(3)*poly_v(3)*dm + uv(1) = uv(1)*scale_v(1)*scale_v(1) + uf(1)*scale_v(1)*poly_v(1)*dm + uv(2) = uv(2)*scale_v(2)*scale_v(2) + uf(2)*scale_v(2)*poly_v(2)*dm + uv(3) = uv(3)*scale_v(3)*scale_v(3) + uf(3)*scale_v(3)*poly_v(3)*dm - ur(1) = ur(1)*scale_r(1)*scale_r(1)+uv(1)*scale_r(1)*poly_r(1)*dt - ur(2) = ur(2)*scale_r(2)*scale_r(2)+uv(2)*scale_r(2)*poly_r(2)*dt - ur(3) = ur(3)*scale_r(3)*scale_r(3)+uv(3)*scale_r(3)*poly_r(3)*dt + ur(1) = ur(1)*scale_r(1)*scale_r(1) + uv(1)*scale_r(1)*poly_r(1)*dt + ur(2) = ur(2)*scale_r(2)*scale_r(2) + uv(2)*scale_r(2)*poly_r(2)*dt + ur(3) = ur(3)*scale_r(3)*scale_r(3) + uv(3)*scale_r(3)*poly_r(3)*dt ! CALL MATVEC_3x3(pos(:, index), u, ur) CALL MATVEC_3x3(vel(:, index), u, uv) @@ -1532,9 +1532,9 @@ SUBROUTINE transform_second(particle_set, vel, index, u, dm, poly_v, scale_v) CALL matvec_3x3(uv, TRANSPOSE_3D(u), vel(:, index)) CALL matvec_3x3(uf, TRANSPOSE_3D(u), particle_set(index)%f(:)) ! - uv(1) = uv(1)*scale_v(1)*scale_v(1)+uf(1)*scale_v(1)*poly_v(1)*dm - uv(2) = uv(2)*scale_v(2)*scale_v(2)+uf(2)*scale_v(2)*poly_v(2)*dm - uv(3) = uv(3)*scale_v(3)*scale_v(3)+uf(3)*scale_v(3)*poly_v(3)*dm + uv(1) = uv(1)*scale_v(1)*scale_v(1) + uf(1)*scale_v(1)*poly_v(1)*dm + uv(2) = uv(2)*scale_v(2)*scale_v(2) + uf(2)*scale_v(2)*poly_v(2)*dm + uv(3) = uv(3)*scale_v(3)*scale_v(3) + uf(3)*scale_v(3)*poly_v(3)*dm CALL MATVEC_3x3(vel(:, index), u, uv) @@ -1593,7 +1593,7 @@ SUBROUTINE variable_timestep(md_env, tmp, dt, simpar, para_env, atomic_kind_set, simpar%dt_fact = 1.0_dp NULLIFY (thermostats) - itime = itime+1 + itime = itime + 1 CALL mp_max(tmp%max_dr, para_env%group) IF (tmp%max_dr > simpar%dr_tol) THEN CALL mp_max(tmp%max_dvel, para_env%group) @@ -1647,7 +1647,7 @@ SUBROUTINE variable_timestep(md_env, tmp, dt, simpar, para_env, atomic_kind_set, simpar%dt_fact = dt_fact_f*dt_fact_v IF (simpar%dt_fact < 1.0_dp) THEN CALL get_md_env(md_env, t=time, thermostats=thermostats) - time = time-dt_old+dt_old*simpar%dt_fact + time = time - dt_old + dt_old*simpar%dt_fact IF (ASSOCIATED(thermostats)) THEN CALL set_thermostats(thermostats, dt_fact=simpar%dt_fact) END IF @@ -1714,25 +1714,25 @@ SUBROUTINE rescaled_vv_first(tmp, dt, simpar, atomic_kind_set, local_particles, CASE (npt_i_ensemble, npe_i_ensemble) arg_r = arg_r*simpar%dt_fact*simpar%dt_fact - tmp%poly_r(1:3) = 1.0_dp+e2*arg_r(1)+e4*arg_r(1)*arg_r(1)+e6*arg_r(1)**3+e8*arg_r(1)**4 + tmp%poly_r(1:3) = 1.0_dp + e2*arg_r(1) + e4*arg_r(1)*arg_r(1) + e6*arg_r(1)**3 + e8*arg_r(1)**4 arg_v = arg_v*simpar%dt_fact*simpar%dt_fact - tmp%poly_v(1:3) = 1.0_dp+e2*arg_v(1)+e4*arg_v(1)*arg_v(1)+e6*arg_v(1)**3+e8*arg_v(1)**4 + tmp%poly_v(1:3) = 1.0_dp + e2*arg_v(1) + e4*arg_v(1)*arg_v(1) + e6*arg_v(1)**3 + e8*arg_v(1)**4 tmp%scale_r(1:3) = EXP(0.5_dp*dt*npt(1, 1)%v) tmp%scale_v(1:3) = EXP(-0.25_dp*dt*npt(1, 1)%v* & - (1.0_dp+3.0_dp*infree)) + (1.0_dp + 3.0_dp*infree)) CALL vv_first(tmp, atomic_kind_set, local_particles, particle_set, & core_particle_set, shell_particle_set, nparticle_kind, & shell_adiabatic, dt) CASE (npt_f_ensemble, npe_f_ensemble) - trvg = npt(1, 1)%v+npt(2, 2)%v+npt(3, 3)%v + trvg = npt(1, 1)%v + npt(2, 2)%v + npt(3, 3)%v arg_r(:) = arg_r(:)*simpar%dt_fact*simpar%dt_fact - tmp%poly_r = 1._dp+e2*arg_r+e4*arg_r*arg_r+e6*arg_r**3+e8*arg_r**4 + tmp%poly_r = 1._dp + e2*arg_r + e4*arg_r*arg_r + e6*arg_r**3 + e8*arg_r**4 tmp%scale_r(:) = EXP(0.5_dp*dt*e_val(:)) arg_v(:) = arg_v(:)*simpar%dt_fact*simpar%dt_fact - tmp%poly_v = 1.0_dp+e2*arg_v+e4*arg_v*arg_v+e6*arg_v**3+e8*arg_v**4 + tmp%poly_v = 1.0_dp + e2*arg_v + e4*arg_v*arg_v + e6*arg_v**3 + e8*arg_v**4 tmp%scale_v(:) = EXP(-0.25_dp*dt*( & - e_val(:)+trvg*infree)) + e_val(:) + trvg*infree)) CALL vv_first(tmp, atomic_kind_set, local_particles, particle_set, & core_particle_set, shell_particle_set, nparticle_kind, & @@ -1740,15 +1740,15 @@ SUBROUTINE rescaled_vv_first(tmp, dt, simpar, atomic_kind_set, local_particles, CASE (nph_uniaxial_ensemble, nph_uniaxial_damped_ensemble) arg_r = arg_r*simpar%dt_fact*simpar%dt_fact - tmp%poly_r(1) = 1._dp+e2*arg_r(1)+e4*arg_r(1)*arg_r(1)+e6*arg_r(1)**3+e8*arg_r(1)**4 + tmp%poly_r(1) = 1._dp + e2*arg_r(1) + e4*arg_r(1)*arg_r(1) + e6*arg_r(1)**3 + e8*arg_r(1)**4 arg_v(2) = arg_v(2)*simpar%dt_fact*simpar%dt_fact arg_v(1) = arg_v(1)*simpar%dt_fact*simpar%dt_fact - tmp%poly_v(1) = 1._dp+e2*arg_v(1)+e4*arg_v(1)*arg_v(1)+e6*arg_v(1)**3+e8*arg_v(1)**4 - tmp%poly_v(2) = 1._dp+e2*arg_v(2)+e4*arg_v(2)*arg_v(2)+e6*arg_v(2)**3+e8*arg_v(2)**4 - tmp%poly_v(3) = 1._dp+e2*arg_v(2)+e4*arg_v(2)*arg_v(2)+e6*arg_v(2)**3+e8*arg_v(2)**4 + tmp%poly_v(1) = 1._dp + e2*arg_v(1) + e4*arg_v(1)*arg_v(1) + e6*arg_v(1)**3 + e8*arg_v(1)**4 + tmp%poly_v(2) = 1._dp + e2*arg_v(2) + e4*arg_v(2)*arg_v(2) + e6*arg_v(2)**3 + e8*arg_v(2)**4 + tmp%poly_v(3) = 1._dp + e2*arg_v(2) + e4*arg_v(2)*arg_v(2) + e6*arg_v(2)**3 + e8*arg_v(2)**4 tmp%scale_r(1) = EXP(0.5_dp*dt*npt(1, 1)%v) tmp%scale_v(1) = EXP(-0.25_dp*dt*npt(1, 1)%v* & - (1._dp+infree)) + (1._dp + infree)) tmp%scale_v(2) = EXP(-0.25_dp*dt*npt(1, 1)%v*infree) tmp%scale_v(3) = EXP(-0.25_dp*dt*npt(1, 1)%v*infree) CALL vv_first(tmp, atomic_kind_set, local_particles, particle_set, & diff --git a/src/motion/mc/mc_control.F b/src/motion/mc/mc_control.F index b1f860b3f0..cd85147069 100644 --- a/src/motion/mc/mc_control.F +++ b/src/motion/mc/mc_control.F @@ -141,7 +141,7 @@ SUBROUTINE write_mc_restart(nnstep, mc_par, nchains, force_env) WRITE (unit, '(1X,A,1X,3(F15.10,3X))') & TRIM(ADJUSTL(name)), & particles%els(iparticle)%r(1:3)*angstrom - iparticle = iparticle+1 + iparticle = iparticle + 1 ENDDO ENDDO ENDDO @@ -228,7 +228,7 @@ SUBROUTINE read_mc_restart(mc_par, force_env, iw, mc_nunits_tot, rng_stream) CALL mp_bcast(nchains, source, group) ! do some checking - IF (ABS(temperature-mc_temp) .GT. 0.01E0_dp) THEN + IF (ABS(temperature - mc_temp) .GT. 0.01E0_dp) THEN IF (ionode) THEN WRITE (iw, *) 'The temperature in the restart file is ', & 'not the same as the input file.' @@ -268,9 +268,9 @@ SUBROUTINE read_mc_restart(mc_par, force_env, iw, mc_nunits_tot, rng_stream) box_length(1:3) = box_length(1:3)/angstrom ! convert to a.u. ENDIF CALL mp_bcast(box_length, source, group) - IF (ABS(box_length(1)-abc(1)) .GT. 0.0001E0_dp .OR. & - ABS(box_length(2)-abc(2)) .GT. 0.0001E0_dp .OR. & - ABS(box_length(3)-abc(3)) .GT. 0.0001E0_dp) THEN + IF (ABS(box_length(1) - abc(1)) .GT. 0.0001E0_dp .OR. & + ABS(box_length(2) - abc(2)) .GT. 0.0001E0_dp .OR. & + ABS(box_length(3) - abc(3)) .GT. 0.0001E0_dp) THEN IF (ionode) THEN WRITE (iw, *) 'The cell length in the restart file is ', & 'not the same as the input file.' @@ -317,7 +317,7 @@ SUBROUTINE read_mc_restart(mc_par, force_env, iw, mc_nunits_tot, rng_stream) ! advance the random number sequence based on the restart step IF (ionode) THEN - DO i = 1, nstart+1 + DO i = 1, nstart + 1 rand = next_random_number(rng_stream) ENDDO ENDIF diff --git a/src/motion/mc/mc_coordinates.F b/src/motion/mc/mc_coordinates.F index 41bb6fdb03..582920e84d 100644 --- a/src/motion/mc/mc_coordinates.F +++ b/src/motion/mc/mc_coordinates.F @@ -116,7 +116,7 @@ SUBROUTINE check_for_overlap(force_env, nchains, nunits, loverlap, mol_type, & DO imol = 1, SUM(nchains) nunit = nunits(mol_type(imol)) DO iunit = 1, nunit - junit = junit+1 + junit = junit + 1 r(1:3, iunit, imol) = particles%els(junit)%r(1:3) ENDDO ENDDO @@ -134,7 +134,7 @@ SUBROUTINE check_for_overlap(force_env, nchains, nunits, loverlap, mol_type, & nend = SUM(nchains(:)) ENDIF DO imol = nstart, nend - IF (lall) jstart = imol+1 + IF (lall) jstart = imol + 1 nunits_i = nunits(mol_type(imol)) DO jmol = jstart, SUM(nchains(:)) IF (imol == jmol) CYCLE @@ -143,17 +143,17 @@ SUBROUTINE check_for_overlap(force_env, nchains, nunits, loverlap, mol_type, & DO iunit = 1, nunits_i DO junit = 1, nunits_j ! find the minimum image distance - RIJ(1) = r(1, iunit, imol)-r(1, junit, jmol)- & + RIJ(1) = r(1, iunit, imol) - r(1, junit, jmol) - & box_length(1)*ANINT( & - (r(1, iunit, imol)-r(1, junit, jmol))/box_length(1)) - RIJ(2) = r(2, iunit, imol)-r(2, junit, jmol)- & + (r(1, iunit, imol) - r(1, junit, jmol))/box_length(1)) + RIJ(2) = r(2, iunit, imol) - r(2, junit, jmol) - & box_length(2)*ANINT( & - (r(2, iunit, imol)-r(2, junit, jmol))/box_length(2)) - RIJ(3) = r(3, iunit, imol)-r(3, junit, jmol)- & + (r(2, iunit, imol) - r(2, junit, jmol))/box_length(2)) + RIJ(3) = r(3, iunit, imol) - r(3, junit, jmol) - & box_length(3)*ANINT( & - (r(3, iunit, imol)-r(3, junit, jmol))/box_length(3)) + (r(3, iunit, imol) - r(3, junit, jmol))/box_length(3)) - dist = RIJ(1)**2+RIJ(2)**2+RIJ(3)**2 + dist = RIJ(1)**2 + RIJ(2)**2 + RIJ(3)**2 IF (dist < rmin) THEN loverlap = .TRUE. @@ -208,7 +208,7 @@ SUBROUTINE get_center_of_mass(coordinates, natom, center_of_mass, & DO iatom = 1, natom DO i = 1, 3 - center_of_mass(i) = center_of_mass(i)+ & + center_of_mass(i) = center_of_mass(i) + & mass(iatom)*coordinates(i, iatom) ENDDO ENDDO @@ -259,17 +259,17 @@ SUBROUTINE mc_coordinate_fold(coordinates, nchains_tot, mol_type, mass, nunits, DO imolecule = 1, nchains_tot molecule_type = mol_type(imolecule) natoms = nunits(molecule_type) - start_atom = end_atom+1 - end_atom = start_atom+natoms-1 + start_atom = end_atom + 1 + end_atom = start_atom + natoms - 1 CALL get_center_of_mass(coordinates(:, start_atom:end_atom), & natoms, center_of_mass(:), mass(:, molecule_type)) DO iatom = 1, natoms - jatom = iatom+start_atom-1 - coordinates(1, jatom) = coordinates(1, jatom)- & + jatom = iatom + start_atom - 1 + coordinates(1, jatom) = coordinates(1, jatom) - & box_length(1)*FLOOR(center_of_mass(1)/box_length(1)) - coordinates(2, jatom) = coordinates(2, jatom)- & + coordinates(2, jatom) = coordinates(2, jatom) - & box_length(2)*FLOOR(center_of_mass(2)/box_length(2)) - coordinates(3, jatom) = coordinates(3, jatom)- & + coordinates(3, jatom) = coordinates(3, jatom) - & box_length(3)*FLOOR(center_of_mass(3)/box_length(2)) ENDDO @@ -415,7 +415,7 @@ SUBROUTINE generate_cbmc_swap_config(force_env, BETA, max_val, min_val, exp_max_ ENDDO ! figure out the numbers of the first and last atoms in the molecule - end_atom = start_atom+nunits_mol-1 + end_atom = start_atom + nunits_mol - 1 ! figure out which molecule number we're on molecule_number = 0 atom_number = 1 @@ -424,7 +424,7 @@ SUBROUTINE generate_cbmc_swap_config(force_env, BETA, max_val, min_val, exp_max_ molecule_number = imolecule EXIT ENDIF - atom_number = atom_number+nunits(mol_type(imolecule)) + atom_number = atom_number + nunits(mol_type(imolecule)) ENDDO IF (molecule_number == 0) CALL cp_abort(__LOCATION__, & 'CBMC swap move cannot find which molecule number it needs') @@ -457,7 +457,7 @@ SUBROUTINE generate_cbmc_swap_config(force_env, BETA, max_val, min_val, exp_max_ move_type, r_insert(:), abc(:), rng_stream) DO i = 1, 3 - diff(i) = r_insert(i)-r_old(i, start_atom+avbmc_atom-1) + diff(i) = r_insert(i) - r_old(i, start_atom + avbmc_atom - 1) ENDDO ELSE @@ -474,13 +474,13 @@ SUBROUTINE generate_cbmc_swap_config(force_env, BETA, max_val, min_val, exp_max_ ! move the molecule to the insertion point DO i = 1, 3 - diff(i) = r_insert(i)-center_of_mass(i) + diff(i) = r_insert(i) - center_of_mass(i) ENDDO ENDIF DO iatom = start_atom, end_atom - r(1:3, iatom, imove) = r(1:3, iatom, imove)+diff(1:3) + r(1:3, iatom, imove) = r(1:3, iatom, imove) + diff(1:3) ENDDO ! rotate the molecule...this routine is only made for serial use @@ -513,7 +513,7 @@ SUBROUTINE generate_cbmc_swap_config(force_env, BETA, max_val, min_val, exp_max_ CALL force_env_get(force_env, & potential_energy=bias_energy) - trial_energy(imove) = (bias_energy-old_energy) + trial_energy(imove) = (bias_energy - old_energy) exponent = -BETA*trial_energy(imove) IF (exponent .GT. exp_max_val) THEN @@ -555,7 +555,7 @@ SUBROUTINE generate_cbmc_swap_config(force_env, BETA, max_val, min_val, exp_max_ DO imove = 1, nswapmoves IF (loverlap_array(imove)) CYCLE all_overlaps = .FALSE. - total_running_weight = total_running_weight+boltz_weights(imove) + total_running_weight = total_running_weight + boltz_weights(imove) IF (total_running_weight .GE. rand*rosenbluth_weight) THEN choosen = imove EXIT @@ -650,7 +650,7 @@ SUBROUTINE rotate_molecule(r, mass, natoms, rng_stream) ! call a random number to figure out how far we're moving rand = next_random_number(rng_stream) - dgamma = pi*(rand-0.5E0_dp)*2.0E0_dp + dgamma = pi*(rand - 0.5E0_dp)*2.0E0_dp ! *** set up the rotation matrix *** @@ -660,39 +660,39 @@ SUBROUTINE rotate_molecule(r, mass, natoms, rng_stream) ! *** ROTATE UNITS OF I AROUND X-AXIS *** DO iunit = 1, natoms - ry = r(2, iunit)-center_of_mass(2) - rz = r(3, iunit)-center_of_mass(3) - rynew = cosdg*ry+sindg*rz - rznew = cosdg*rz-sindg*ry + ry = r(2, iunit) - center_of_mass(2) + rz = r(3, iunit) - center_of_mass(3) + rynew = cosdg*ry + sindg*rz + rznew = cosdg*rz - sindg*ry - r(2, iunit) = rynew+center_of_mass(2) - r(3, iunit) = rznew+center_of_mass(3) + r(2, iunit) = rynew + center_of_mass(2) + r(3, iunit) = rznew + center_of_mass(3) ENDDO ! *** ROTATE UNITS OF I AROUND y-AXIS *** DO iunit = 1, natoms - rx = r(1, iunit)-center_of_mass(1) - rz = r(3, iunit)-center_of_mass(3) - rxnew = cosdg*rx+sindg*rz - rznew = cosdg*rz-sindg*rx + rx = r(1, iunit) - center_of_mass(1) + rz = r(3, iunit) - center_of_mass(3) + rxnew = cosdg*rx + sindg*rz + rznew = cosdg*rz - sindg*rx - r(1, iunit) = rxnew+center_of_mass(1) - r(3, iunit) = rznew+center_of_mass(3) + r(1, iunit) = rxnew + center_of_mass(1) + r(3, iunit) = rznew + center_of_mass(3) ENDDO ! *** ROTATE UNITS OF I AROUND z-AXIS *** DO iunit = 1, natoms - rx = r(1, iunit)-center_of_mass(1) - ry = r(2, iunit)-center_of_mass(2) - rxnew = cosdg*rx+sindg*ry - rynew = cosdg*ry-sindg*rx + rx = r(1, iunit) - center_of_mass(1) + ry = r(2, iunit) - center_of_mass(2) + rxnew = cosdg*rx + sindg*ry + rynew = cosdg*ry - sindg*rx - r(1, iunit) = rxnew+center_of_mass(1) - r(2, iunit) = rynew+center_of_mass(2) + r(1, iunit) = rxnew + center_of_mass(1) + r(2, iunit) = rynew + center_of_mass(2) ENDDO @@ -751,18 +751,18 @@ SUBROUTINE find_mc_test_molecule(mc_molecule_info, start_atom, & molecule_number = CEILING(rand*REAL(nchains(molecule_type_old, box), KIND=dp)) start_mol = 1 - DO jbox = 1, box-1 - start_mol = start_mol+SUM(nchains(:, jbox)) + DO jbox = 1, box - 1 + start_mol = start_mol + SUM(nchains(:, jbox)) ENDDO ! adjust to take into account molecules of other types in the box - DO imol_type = 1, molecule_type_old-1 - molecule_number = molecule_number+nchains(imol_type, box) + DO imol_type = 1, molecule_type_old - 1 + molecule_number = molecule_number + nchains(imol_type, box) ENDDO start_atom = 1 - DO imolecule = 1, molecule_number-1 - start_atom = start_atom+nunits(mol_type(start_mol+imolecule-1)) + DO imolecule = 1, molecule_number - 1 + start_atom = start_atom + nunits(mol_type(start_mol + imolecule - 1)) ENDDO ELSEIF (PRESENT(box)) THEN @@ -771,16 +771,16 @@ SUBROUTINE find_mc_test_molecule(mc_molecule_info, start_atom, & molecule_number = CEILING(rand*REAL(SUM(nchains(:, box)), KIND=dp)) start_mol = 1 - DO jbox = 1, box-1 - start_mol = start_mol+SUM(nchains(:, jbox)) + DO jbox = 1, box - 1 + start_mol = start_mol + SUM(nchains(:, jbox)) ENDDO - molecule_type = mol_type(start_mol+molecule_number-1) + molecule_type = mol_type(start_mol + molecule_number - 1) ! now the starting atom start_atom = 1 - DO imolecule = 1, molecule_number-1 - start_atom = start_atom+nunits(mol_type(start_mol+imolecule-1)) + DO imolecule = 1, molecule_number - 1 + start_atom = start_atom + nunits(mol_type(start_mol + imolecule - 1)) ENDDO ELSEIF (PRESENT(molecule_type_old)) THEN @@ -795,28 +795,28 @@ SUBROUTINE find_mc_test_molecule(mc_molecule_info, start_atom, & box_number = ibox EXIT ENDIF - molecule_number = molecule_number-nchains(molecule_type_old, ibox) + molecule_number = molecule_number - nchains(molecule_type_old, ibox) ENDDO start_mol = 1 - DO jbox = 1, box_number-1 - start_mol = start_mol+SUM(nchains(:, jbox)) + DO jbox = 1, box_number - 1 + start_mol = start_mol + SUM(nchains(:, jbox)) ENDDO ! now find the starting atom number - DO imol_type = 1, molecule_type_old-1 - molecule_number = molecule_number+nchains(imol_type, box_number) + DO imol_type = 1, molecule_type_old - 1 + molecule_number = molecule_number + nchains(imol_type, box_number) ENDDO start_atom = 1 - DO imolecule = 1, molecule_number-1 - start_atom = start_atom+nunits(mol_type(start_mol+imolecule-1)) + DO imolecule = 1, molecule_number - 1 + start_atom = start_atom + nunits(mol_type(start_mol + imolecule - 1)) ENDDO ELSE ! no restrictions...need to find all pieces of data nchains_tot = 0 DO ibox = 1, SIZE(nchains(1, :)) - nchains_tot = nchains_tot+SUM(nchains(:, ibox)) + nchains_tot = nchains_tot + SUM(nchains(:, ibox)) ENDDO rand = next_random_number(rng_stream) molecule_number = CEILING(rand*REAL(nchains_tot, KIND=dp)) @@ -829,17 +829,17 @@ SUBROUTINE find_mc_test_molecule(mc_molecule_info, start_atom, & box_number = ibox EXIT ENDIF - molecule_number = molecule_number-SUM(nchains(:, ibox)) + molecule_number = molecule_number - SUM(nchains(:, ibox)) ENDDO ! now find the starting atom number start_mol = 1 - DO jbox = 1, box_number-1 - start_mol = start_mol+SUM(nchains(:, jbox)) + DO jbox = 1, box_number - 1 + start_mol = start_mol + SUM(nchains(:, jbox)) ENDDO start_atom = 1 - DO imolecule = 1, molecule_number-1 - start_atom = start_atom+nunits(mol_type(start_mol+imolecule-1)) + DO imolecule = 1, molecule_number - 1 + start_atom = start_atom + nunits(mol_type(start_mol + imolecule - 1)) ENDDO ENDIF @@ -881,8 +881,8 @@ SUBROUTINE create_discrete_array(cell, discrete_array, step_size) discrete_array(:, :) = 0 - length1 = ABS(cell(1)-cell(2)) - length2 = ABS(cell(2)-cell(3)) + length1 = ABS(cell(1) - cell(2)) + length2 = ABS(cell(2) - cell(3)) ! now let's figure out all the different cases IF (length1 .LT. 0.01_dp*step_size .AND. & @@ -902,7 +902,7 @@ SUBROUTINE create_discrete_array(cell, discrete_array, step_size) DO iside = 1, 3 ! now we see if the value is a high value or a low value...it can only be ! one of the two - IF (ABS(cell(iside)-low_value) .LT. 0.01_dp*step_size) THEN + IF (ABS(cell(iside) - low_value) .LT. 0.01_dp*step_size) THEN ! low value, we can only increase the cell size discrete_array(iside, 1) = 1 discrete_array(iside, 2) = 0 @@ -952,21 +952,21 @@ SUBROUTINE generate_avbmc_insertion(rmin, rmax, r_target, & DO eta_1 = next_random_number(rng_stream) eta_2 = next_random_number(rng_stream) - eta_sq = eta_1**2+eta_2**2 + eta_sq = eta_1**2 + eta_2**2 IF (eta_sq .LT. 1.0_dp) THEN - r_insert(1) = 2.0_dp*eta_1*SQRT(1.0_dp-eta_sq) - r_insert(2) = 2.0_dp*eta_2*SQRT(1.0_dp-eta_sq) - r_insert(3) = 1.0_dp-2.0_dp*eta_sq + r_insert(1) = 2.0_dp*eta_1*SQRT(1.0_dp - eta_sq) + r_insert(2) = 2.0_dp*eta_2*SQRT(1.0_dp - eta_sq) + r_insert(3) = 1.0_dp - 2.0_dp*eta_sq EXIT ENDIF ENDDO ! now scale that vector to be within the "in" region rand = next_random_number(rng_stream) - r_insert(1:3) = r_insert(1:3)*(rand*(rmax**3-rmin**3)+rmin**3)** & + r_insert(1:3) = r_insert(1:3)*(rand*(rmax**3 - rmin**3) + rmin**3)** & (1.0_dp/3.0_dp) - r_insert(1:3) = r_target(1:3)+r_insert(1:3) + r_insert(1:3) = r_target(1:3) + r_insert(1:3) ELSE ! find a new insertion point somewhere in the box @@ -977,14 +977,14 @@ SUBROUTINE generate_avbmc_insertion(rmin, rmax, r_target, & ENDDO ! make sure it's not in the "in" region - RIJ(1) = r_insert(1)-r_target(1)-abc(1)* & - ANINT((r_insert(1)-r_target(1))/abc(1)) - RIJ(2) = r_insert(2)-r_target(2)-abc(2)* & - ANINT((r_insert(2)-r_target(2))/abc(2)) - RIJ(3) = r_insert(3)-r_target(3)-abc(3)* & - ANINT((r_insert(3)-r_target(3))/abc(3)) + RIJ(1) = r_insert(1) - r_target(1) - abc(1)* & + ANINT((r_insert(1) - r_target(1))/abc(1)) + RIJ(2) = r_insert(2) - r_target(2) - abc(2)* & + ANINT((r_insert(2) - r_target(2))/abc(2)) + RIJ(3) = r_insert(3) - r_target(3) - abc(3)* & + ANINT((r_insert(3) - r_target(3))/abc(3)) - dist = RIJ(1)**2+RIJ(2)**2+RIJ(3)**2 + dist = RIJ(1)**2 + RIJ(2)**2 + RIJ(3)**2 IF (dist .LT. rmin**2 .OR. dist .GT. rmax**2) THEN EXIT @@ -1058,7 +1058,7 @@ SUBROUTINE cluster_search(mc_par, force_env, cluster, nchains, nunits, mol_type, DO imol = 1, nend nunit = nunits(mol_type(imol)) DO iunit = 1, nunit - junit = junit+1 + junit = junit + 1 r(1:3, iunit, imol) = particles%els(junit)%r(1:3) ENDDO ENDDO @@ -1079,7 +1079,7 @@ SUBROUTINE cluster_search(mc_par, force_env, cluster, nchains, nunits, mol_type, DO WHILE (SUM(decision) .LT. nend) DO nstart = 1, nend IF (clusmat(nstart) .EQ. 0) THEN - counter = counter+1 + counter = counter + 1 clusmat(nstart) = counter EXIT END IF @@ -1110,13 +1110,13 @@ SUBROUTINE cluster_search(mc_par, force_env, cluster, nchains, nunits, mol_type, !Calculating the distance between atoms DO iunit = 1, nunits_i DO junit = 1, nunits_j - dx = xcoord(iunit)-r(1, junit, jmol) - dy = ycoord(iunit)-r(2, junit, jmol) - dz = zcoord(iunit)-r(3, junit, jmol) - dx = dx-abc(1)*ANINT(dx/abc(1)) - dy = dy-abc(2)*ANINT(dy/abc(2)) - dz = dz-abc(3)*ANINT(dz/abc(3)) - rsquare = (dx*dx)+(dy*dy)+(dz*dz) + dx = xcoord(iunit) - r(1, junit, jmol) + dy = ycoord(iunit) - r(2, junit, jmol) + dz = zcoord(iunit) - r(3, junit, jmol) + dx = dx - abc(1)*ANINT(dx/abc(1)) + dy = dy - abc(2)*ANINT(dy/abc(2)) + dz = dz - abc(3)*ANINT(dz/abc(3)) + rsquare = (dx*dx) + (dy*dy) + (dz*dz) !Checking the distance based on rclus square(rclussq) IF (rsquare .LT. rclussquare) THEN clusmat(jmol) = counter diff --git a/src/motion/mc/mc_ensembles.F b/src/motion/mc/mc_ensembles.F index e5181137ce..87f374e715 100644 --- a/src/motion/mc/mc_ensembles.F +++ b/src/motion/mc/mc_ensembles.F @@ -298,10 +298,10 @@ SUBROUTINE mc_run_ensemble(mc_env, para_env, globenv, input_declaration, nboxes, IF (.NOT. lhmc) THEN ! check for overlaps start_mol = 1 - DO jbox = 1, ibox-1 - start_mol = start_mol+SUM(nchains(:, jbox)) + DO jbox = 1, ibox - 1 + start_mol = start_mol + SUM(nchains(:, jbox)) ENDDO - end_mol = start_mol+SUM(nchains(:, ibox))-1 + end_mol = start_mol + SUM(nchains(:, ibox)) - 1 CALL check_for_overlap(force_env(ibox)%force_env, nchains(:, ibox), & nunits, loverlap, mol_type(start_mol:end_mol)) IF (loverlap) CPABORT("overlap in an initial configuration") @@ -326,10 +326,10 @@ SUBROUTINE mc_run_ensemble(mc_env, para_env, globenv, input_declaration, nboxes, atom_number = 1 DO imolecule = 1, SUM(nchains(:, ibox)) - DO iunit = 1, nunits(mol_type(imolecule+start_mol-1)) + DO iunit = 1, nunits(mol_type(imolecule + start_mol - 1)) atom_names_box(atom_number) = & - atom_names(iunit, mol_type(imolecule+start_mol-1)) - atom_number = atom_number+1 + atom_names(iunit, mol_type(imolecule + start_mol - 1)) + atom_number = atom_number + 1 ENDDO ENDDO @@ -437,7 +437,7 @@ SUBROUTINE mc_run_ensemble(mc_env, para_env, globenv, input_declaration, nboxes, iupvolume = iupvolume*nchain_total ENDIF - DO nnstep = nstart+1, nstart+nstep + DO nnstep = nstart + 1, nstart + nstep IF (MOD(nnstep, iprint) == 0 .AND. (iw > 0)) THEN WRITE (iw, *) @@ -505,16 +505,16 @@ SUBROUTINE mc_run_ensemble(mc_env, para_env, globenv, input_declaration, nboxes, ! determine the atom names of every particle ALLOCATE (atom_names_box(1:nunits_tot(ibox))) start_mol = 1 - DO jbox = 1, ibox-1 - start_mol = start_mol+SUM(nchains(:, jbox)) + DO jbox = 1, ibox - 1 + start_mol = start_mol + SUM(nchains(:, jbox)) ENDDO - end_mol = start_mol+SUM(nchains(:, ibox))-1 + end_mol = start_mol + SUM(nchains(:, ibox)) - 1 atom_number = 1 DO imolecule = 1, SUM(nchains(:, ibox)) - DO iunit = 1, nunits(mol_type(imolecule+start_mol-1)) + DO iunit = 1, nunits(mol_type(imolecule + start_mol - 1)) atom_names_box(atom_number) = & - atom_names(iunit, mol_type(imolecule+start_mol-1)) - atom_number = atom_number+1 + atom_names(iunit, mol_type(imolecule + start_mol - 1)) + atom_number = atom_number + 1 ENDDO ENDDO @@ -631,7 +631,7 @@ SUBROUTINE mc_run_ensemble(mc_env, para_env, globenv, input_declaration, nboxes, IF (SUM(nchains(:, box_number)) .LE. 1) THEN ! indicate that we tried a move moves(molecule_type_swap, box_number)%moves%empty_avbmc = & - moves(molecule_type_swap, box_number)%moves%empty_avbmc+1 + moves(molecule_type_swap, box_number)%moves%empty_avbmc + 1 ELSE ! pick a molecule to be swapped in the box @@ -646,8 +646,8 @@ SUBROUTINE mc_run_ensemble(mc_env, para_env, globenv, input_declaration, nboxes, start_atom_target, idum, molecule_type_target, & rng_stream, box=box_number) IF (start_atom_swap .NE. start_atom_target) THEN - start_atom_target = start_atom_target+ & - avbmc_atom(molecule_type_target)-1 + start_atom_target = start_atom_target + & + avbmc_atom(molecule_type_target) - 1 EXIT ENDIF ENDDO @@ -726,7 +726,7 @@ SUBROUTINE mc_run_ensemble(mc_env, para_env, globenv, input_declaration, nboxes, IF (nchains(molecule_type, box_number) == 0) THEN ! indicate that we tried a move moves(molecule_type, box_number)%moves%empty_conf = & - moves(molecule_type, box_number)%moves%empty_conf+1 + moves(molecule_type, box_number)%moves%empty_conf + 1 ELSE ! pick a molecule in the box IF (ionode) THEN @@ -746,7 +746,7 @@ SUBROUTINE mc_run_ensemble(mc_env, para_env, globenv, input_declaration, nboxes, ! figure out what kind of move we're doing IF (rand .LT. conf_prob(1, molecule_type)) THEN move_type = 'bond' - ELSEIF (rand .LT. (conf_prob(1, molecule_type)+ & + ELSEIF (rand .LT. (conf_prob(1, molecule_type) + & conf_prob(2, molecule_type))) THEN move_type = 'angle' ELSE @@ -915,18 +915,18 @@ SUBROUTINE mc_run_ensemble(mc_env, para_env, globenv, input_declaration, nboxes, DO ibox = 1, nboxes ! compute some averages averages(ibox)%averages%ave_energy = & - averages(ibox)%averages%ave_energy*REAL(nnstep- & - nstart-1, dp)/REAL(nnstep-nstart, dp)+ & - old_energy(ibox)/REAL(nnstep-nstart, dp) + averages(ibox)%averages%ave_energy*REAL(nnstep - & + nstart - 1, dp)/REAL(nnstep - nstart, dp) + & + old_energy(ibox)/REAL(nnstep - nstart, dp) averages(ibox)%averages%molecules = & - averages(ibox)%averages%molecules*REAL(nnstep- & - nstart-1, dp)/REAL(nnstep-nstart, dp)+ & - REAL(SUM(nchains(:, ibox)), dp)/REAL(nnstep-nstart, dp) + averages(ibox)%averages%molecules*REAL(nnstep - & + nstart - 1, dp)/REAL(nnstep - nstart, dp) + & + REAL(SUM(nchains(:, ibox)), dp)/REAL(nnstep - nstart, dp) averages(ibox)%averages%ave_volume = & averages(ibox)%averages%ave_volume* & - REAL(nnstep-nstart-1, dp)/REAL(nnstep-nstart, dp)+ & + REAL(nnstep - nstart - 1, dp)/REAL(nnstep - nstart, dp) + & abc(1, ibox)*abc(2, ibox)*abc(3, ibox)/ & - REAL(nnstep-nstart, dp) + REAL(nnstep - nstart, dp) ! flush the buffers to the files CALL m_flush(data_unit(ibox)) @@ -954,7 +954,7 @@ SUBROUTINE mc_run_ensemble(mc_env, para_env, globenv, input_declaration, nboxes, ! update the move displacements, if necessary DO ibox = 1, nboxes - IF (MOD(nnstep-nstart, iuptrans) == 0) THEN + IF (MOD(nnstep - nstart, iuptrans) == 0) THEN DO itype = 1, nmol_types CALL mc_move_update(mc_par(ibox)%mc_par, & move_updates(itype, ibox)%moves, itype, & @@ -962,7 +962,7 @@ SUBROUTINE mc_run_ensemble(mc_env, para_env, globenv, input_declaration, nboxes, ENDDO ENDIF - IF (MOD(nnstep-nstart, iupvolume) == 0) THEN + IF (MOD(nnstep - nstart, iupvolume) == 0) THEN CALL mc_move_update(mc_par(ibox)%mc_par, & move_updates(1, ibox)%moves, 1337, & "volume", nnstep, ionode) @@ -975,10 +975,10 @@ SUBROUTINE mc_run_ensemble(mc_env, para_env, globenv, input_declaration, nboxes, DO ibox = 1, nboxes IF (SUM(nchains(:, ibox)) .NE. 0) THEN start_mol = 1 - DO jbox = 1, ibox-1 - start_mol = start_mol+SUM(nchains(:, jbox)) + DO jbox = 1, ibox - 1 + start_mol = start_mol + SUM(nchains(:, jbox)) ENDDO - end_mol = start_mol+SUM(nchains(:, ibox))-1 + end_mol = start_mol + SUM(nchains(:, ibox)) - 1 CALL check_for_overlap(force_env(ibox)%force_env, & nchains(:, ibox), nunits, loverlap, & mol_type(start_mol:end_mol)) @@ -1037,13 +1037,13 @@ SUBROUTINE mc_run_ensemble(mc_env, para_env, globenv, input_declaration, nboxes, test_energy = 0.0E0_dp ENDIF - IF (ABS(initial_energy(ibox)+energy_check(ibox)- & + IF (ABS(initial_energy(ibox) + energy_check(ibox) - & test_energy) .GT. 0.0000001E0_dp) THEN IF (iw > 0) THEN WRITE (iw, *) '!!!!!!! We have an energy problem. !!!!!!!!' WRITE (iw, '(A,T64,F16.10)') 'Final Energy = ', test_energy WRITE (iw, '(A,T64,F16.10)') 'Inital Energy+energy_check=', & - initial_energy(ibox)+energy_check(ibox) + initial_energy(ibox) + energy_check(ibox) WRITE (iw, *) 'Box ', ibox WRITE (iw, *) 'nchains ', nchains(:, ibox) END IF @@ -1213,8 +1213,8 @@ SUBROUTINE mc_compute_virial(mc_env, rng_stream) virial_stepsize(2) = 0.1 virial_stepsize(3) = 0.2 - nbins = CEILING(virial_cutoffs(1)/virial_stepsize(1)+(virial_cutoffs(2)-virial_cutoffs(1))/ & - virial_stepsize(2)+(virial_cutoffs(3)-virial_cutoffs(2))/virial_stepsize(3)) + nbins = CEILING(virial_cutoffs(1)/virial_stepsize(1) + (virial_cutoffs(2) - virial_cutoffs(1))/ & + virial_stepsize(2) + (virial_cutoffs(3) - virial_cutoffs(2))/virial_stepsize(3)) ! figure out what the default write unit is iw = cp_logger_get_default_io_unit() @@ -1290,7 +1290,7 @@ SUBROUTINE mc_compute_virial(mc_env, rng_stream) CALL get_center_of_mass(r_old(:, start_atom:end_atom), nunits(mol_type(1)), & center_of_mass(:), mass(1:nunits(mol_type(1)), mol_type(1))) DO iunit = start_atom, end_atom - r_old(:, iunit) = r_old(:, iunit)-center_of_mass(:) + r_old(:, iunit) = r_old(:, iunit) - center_of_mass(:) ENDDO ! set them in the force_env, so the first molecule is ready for the energy calc DO iparticle = start_atom, end_atom @@ -1311,12 +1311,12 @@ SUBROUTINE mc_compute_virial(mc_env, rng_stream) DO ivirial = 1, nvirial ! move molecule two back to the origin - start_atom = nunits(mol_type(1))+1 + start_atom = nunits(mol_type(1)) + 1 end_atom = nunits_tot(1) CALL get_center_of_mass(r_old(:, start_atom:end_atom), nunits(mol_type(2)), & center_of_mass(:), mass(1:nunits(mol_type(2)), mol_type(2))) DO iunit = start_atom, end_atom - r_old(:, iunit) = r_old(:, iunit)-center_of_mass(:) + r_old(:, iunit) = r_old(:, iunit) - center_of_mass(:) ENDDO ! now we need a random orientation for molecule 2...this routine is @@ -1334,17 +1334,17 @@ SUBROUTINE mc_compute_virial(mc_env, rng_stream) ! find out what our stepsize is current_division = 0 DO idivision = 1, nintegral_divisions - IF (distance .LT. virial_cutoffs(idivision)-virial_stepsize(idivision)/2.0E0_dp) THEN + IF (distance .LT. virial_cutoffs(idivision) - virial_stepsize(idivision)/2.0E0_dp) THEN current_division = idivision EXIT ENDIF ENDDO IF (current_division == 0) EXIT - distance = distance+virial_stepsize(current_division) + distance = distance + virial_stepsize(current_division) ! move the second molecule only along the x direction DO iparticle = start_atom, end_atom - particles(1)%list%els(iparticle)%r(1) = r_old(1, iparticle)+distance + particles(1)%list%els(iparticle)%r(1) = r_old(1, iparticle) + distance particles(1)%list%els(iparticle)%r(2) = r_old(2, iparticle) particles(1)%list%els(iparticle)%r(3) = r_old(3, iparticle) ENDDO @@ -1356,7 +1356,7 @@ SUBROUTINE mc_compute_virial(mc_env, rng_stream) ! exponent is exp(-beta*energy)-1, also called the Mayer term IF (loverlap) THEN DO itemp = 1, nvirial_temps - mayer(itemp, ibin) = mayer(itemp, ibin)-1.0_dp + mayer(itemp, ibin) = mayer(itemp, ibin) - 1.0_dp ENDDO ELSE CALL force_env_calc_energy_force(force_env(1)%force_env, & @@ -1373,11 +1373,11 @@ SUBROUTINE mc_compute_virial(mc_env, rng_stream) ELSEIF (exponent .LT. exp_min_val) THEN exponent = exp_min_val ENDIF - mayer(itemp, ibin) = mayer(itemp, ibin)+EXP(exponent)-1.0_dp + mayer(itemp, ibin) = mayer(itemp, ibin) + EXP(exponent) - 1.0_dp ENDDO ENDIF - ibin = ibin+1 + ibin = ibin + 1 ENDDO ! write out some info that keeps track of where we are IF (iw > 0) THEN @@ -1397,13 +1397,13 @@ SUBROUTINE mc_compute_virial(mc_env, rng_stream) DO current_division = 0 DO idivision = 1, nintegral_divisions - IF (distance .LT. virial_cutoffs(idivision)-virial_stepsize(idivision)/2.0E0_dp) THEN + IF (distance .LT. virial_cutoffs(idivision) - virial_stepsize(idivision)/2.0E0_dp) THEN current_division = idivision EXIT ENDIF ENDDO IF (current_division == 0) EXIT - distance = distance+virial_stepsize(current_division) + distance = distance + virial_stepsize(current_division) ! now we need to integrate, using the trapazoidal method ! first, find the value of the square @@ -1411,11 +1411,11 @@ SUBROUTINE mc_compute_virial(mc_env, rng_stream) square_value = previous_value*virial_stepsize(current_division) ! now the triangle that sits on top of it, which is half the size of this square... ! notice this is negative if the current value is less than the previous value - triangle_value = 0.5E0_dp*((current_value-previous_value)*virial_stepsize(current_division)) + triangle_value = 0.5E0_dp*((current_value - previous_value)*virial_stepsize(current_division)) - integral = integral+square_value+triangle_value + integral = integral + square_value + triangle_value previous_value = current_value - ibin = ibin+1 + ibin = ibin + 1 ENDDO ! now that the integration is done, compute the second virial that results diff --git a/src/motion/mc/mc_environment_types.F b/src/motion/mc/mc_environment_types.F index b194c18b96..c75aa64e23 100644 --- a/src/motion/mc/mc_environment_types.F +++ b/src/motion/mc/mc_environment_types.F @@ -56,7 +56,7 @@ SUBROUTINE mc_env_create(mc_env) ALLOCATE (mc_env) - last_mc_env_id = last_mc_env_id+1 + last_mc_env_id = last_mc_env_id + 1 mc_env%id_nr = last_mc_env_id mc_env%ref_count = 1 mc_env%in_use = 0 @@ -126,7 +126,7 @@ SUBROUTINE mc_env_release(mc_env) IF (ASSOCIATED(mc_env)) THEN CPASSERT(mc_env%ref_count > 0) - mc_env%ref_count = mc_env%ref_count-1 + mc_env%ref_count = mc_env%ref_count - 1 IF (mc_env%ref_count == 0) THEN mc_env%ref_count = 1 NULLIFY (mc_env%mc_par) diff --git a/src/motion/mc/mc_ge_moves.F b/src/motion/mc/mc_ge_moves.F index 64bbd2bf19..1dec290d18 100644 --- a/src/motion/mc/mc_ge_moves.F +++ b/src/motion/mc/mc_ge_moves.F @@ -163,7 +163,7 @@ SUBROUTINE mc_Quickstep_move(mc_par, force_env, bias_env, moves, & ! record the attempt...we really only care about molecule type 1 and box ! type 1, since the acceptance will be identical for all boxes and molecules moves(1, 1)%moves%Quickstep%attempts = & - moves(1, 1)%moves%Quickstep%attempts+1 + moves(1, 1)%moves%Quickstep%attempts + 1 ! grab the coordinates for the force_env DO ibox = 1, nboxes @@ -235,10 +235,10 @@ SUBROUTINE mc_Quickstep_move(mc_par, force_env, bias_env, moves, & IF (SUM(nchains(:, ibox)) .NE. 0) THEN ! find the molecule bounds start_mol = 1 - DO jbox = 1, ibox-1 - start_mol = start_mol+SUM(nchains(:, jbox)) + DO jbox = 1, ibox - 1 + start_mol = start_mol + SUM(nchains(:, jbox)) ENDDO - end_mol = start_mol+SUM(nchains(:, ibox))-1 + end_mol = start_mol + SUM(nchains(:, ibox)) - 1 CALL check_for_overlap(bias_env(ibox)%force_env, & nchains(:, ibox), nunits(:), loverlap, mol_type(start_mol:end_mol)) IF (loverlap) & @@ -247,8 +247,8 @@ SUBROUTINE mc_Quickstep_move(mc_par, force_env, bias_env, moves, & bias_energy_old(ibox) = last_bias_energy(ibox) ENDDO - energies = -BETA*((SUM(new_energy(:))-SUM(bias_energy_new(:))) & - -(SUM(old_energy(:))-SUM(bias_energy_old(:)))) + energies = -BETA*((SUM(new_energy(:)) - SUM(bias_energy_new(:))) & + - (SUM(old_energy(:)) - SUM(bias_energy_old(:)))) ! used to prevent over and underflows IF (energies .GE. -1.0E-8) THEN @@ -261,13 +261,13 @@ SUBROUTINE mc_Quickstep_move(mc_par, force_env, bias_env, moves, & IF (ionode) THEN DO ibox = 1, nboxes - WRITE (diff(ibox), *) nnstep, new_energy(ibox)- & + WRITE (diff(ibox), *) nnstep, new_energy(ibox) - & old_energy(ibox), & - bias_energy_new(ibox)-bias_energy_old(ibox) + bias_energy_new(ibox) - bias_energy_old(ibox) ENDDO ENDIF ELSE - energies = -BETA*(SUM(new_energy(:))-SUM(old_energy(:))) + energies = -BETA*(SUM(new_energy(:)) - SUM(old_energy(:))) ! used to prevent over and underflows IF (energies .GE. 0.0_dp) THEN w = 1.0_dp @@ -292,7 +292,7 @@ SUBROUTINE mc_Quickstep_move(mc_par, force_env, bias_env, moves, & ! accept the move moves(1, 1)%moves%Quickstep%successes = & - moves(1, 1)%moves%Quickstep%successes+1 + moves(1, 1)%moves%Quickstep%successes + 1 DO ibox = 1, nboxes ! remember what kind of move we did for lbias=.false. @@ -318,8 +318,8 @@ SUBROUTINE mc_Quickstep_move(mc_par, force_env, bias_env, moves, & ENDDO ! update energies - energy_check(ibox) = energy_check(ibox)+ & - (new_energy(ibox)-old_energy(ibox)) + energy_check(ibox) = energy_check(ibox) + & + (new_energy(ibox) - old_energy(ibox)) old_energy(ibox) = new_energy(ibox) ENDDO @@ -542,14 +542,14 @@ SUBROUTINE mc_ge_swap_move(mc_par, force_env, bias_env, moves, & ! record the attempt for the box the particle is to be inserted into moves(molecule_type, insert_box)%moves%swap%attempts = & - moves(molecule_type, insert_box)%moves%swap%attempts+1 + moves(molecule_type, insert_box)%moves%swap%attempts + 1 ! now choose a random molecule to remove from the removal box, checking ! to make sure the box isn't empty IF (nchains(molecule_type, remove_box) == 0) THEN loverlap = .TRUE. moves(molecule_type, insert_box)%moves%empty = & - moves(molecule_type, insert_box)%moves%empty+1 + moves(molecule_type, insert_box)%moves%empty + 1 ELSE IF (ionode) rand = next_random_number(rng_stream) @@ -559,28 +559,28 @@ SUBROUTINE mc_ge_swap_move(mc_par, force_env, bias_env, moves, & start_atom_rem = 1 DO itype = 1, nmol_types IF (itype == molecule_type) THEN - start_atom_rem = start_atom_rem+(imolecule-1)*nunits(itype) + start_atom_rem = start_atom_rem + (imolecule - 1)*nunits(itype) EXIT ELSE - start_atom_rem = start_atom_rem+nchains(itype, remove_box)*nunits(itype) + start_atom_rem = start_atom_rem + nchains(itype, remove_box)*nunits(itype) ENDIF ENDDO ! check for overlap start_mol = 1 - DO jbox = 1, remove_box-1 - start_mol = start_mol+SUM(nchains(:, jbox)) + DO jbox = 1, remove_box - 1 + start_mol = start_mol + SUM(nchains(:, jbox)) ENDDO - end_mol = start_mol+SUM(nchains(:, remove_box))-1 + end_mol = start_mol + SUM(nchains(:, remove_box)) - 1 CALL check_for_overlap(force_env(remove_box)%force_env, & nchains(:, remove_box), nunits, loverlap, mol_type(start_mol:end_mol)) IF (loverlap) CALL cp_abort(__LOCATION__, & 'CBMC swap move found an overlap in the old remove config') start_mol = 1 - DO jbox = 1, insert_box-1 - start_mol = start_mol+SUM(nchains(:, jbox)) + DO jbox = 1, insert_box - 1 + start_mol = start_mol + SUM(nchains(:, jbox)) ENDDO - end_mol = start_mol+SUM(nchains(:, insert_box))-1 + end_mol = start_mol + SUM(nchains(:, insert_box)) - 1 CALL check_for_overlap(force_env(insert_box)%force_env, & nchains(:, insert_box), nunits, loverlap, mol_type(start_mol:end_mol)) IF (loverlap) CALL cp_abort(__LOCATION__, & @@ -595,8 +595,8 @@ SUBROUTINE mc_ge_swap_move(mc_par, force_env, bias_env, moves, & ENDIF ! figure out how many atoms will be in each box after the move - ins_atoms = nunits_tot(insert_box)+nunits(molecule_type) - rem_atoms = nunits_tot(remove_box)-nunits(molecule_type) + ins_atoms = nunits_tot(insert_box) + nunits(molecule_type) + rem_atoms = nunits_tot(remove_box) - nunits(molecule_type) ! now allocate the arrays that will hold the coordinates and the ! atom name, for writing to the dat file IF (rem_atoms == 0) THEN @@ -637,10 +637,10 @@ SUBROUTINE mc_ge_swap_move(mc_par, force_env, bias_env, moves, & ALLOCATE (r_insert_mol(1:3, 1:nunits(molecule_type))) iiatom = 1 - DO iatom = start_atom_rem, start_atom_rem+nunits(molecule_type)-1 + DO iatom = start_atom_rem, start_atom_rem + nunits(molecule_type) - 1 r_insert_mol(1:3, iiatom) = & particles_old(remove_box)%list%els(iatom)%r(1:3) - iiatom = iiatom+1 + iiatom = iiatom + 1 ENDDO ! find the center of mass of the molecule @@ -648,9 +648,9 @@ SUBROUTINE mc_ge_swap_move(mc_par, force_env, bias_env, moves, & center_of_mass(:), mass(:, molecule_type)) ! move the center of mass to the insertion point - displace_molecule(1:3) = pos_insert(1:3)-center_of_mass(1:3) + displace_molecule(1:3) = pos_insert(1:3) - center_of_mass(1:3) DO iatom = 1, nunits(molecule_type) - r_insert_mol(1:3, iatom) = r_insert_mol(1:3, iatom)+ & + r_insert_mol(1:3, iatom) = r_insert_mol(1:3, iatom) + & displace_molecule(1:3) ENDDO @@ -661,7 +661,7 @@ SUBROUTINE mc_ge_swap_move(mc_par, force_env, bias_env, moves, & DO iatom = 1, nunits(molecule_type) insert_coords(1:3, iatom) = r_insert_mol(1:3, iatom) atom_names_insert(iatom) = & - particles_old(remove_box)%list%els(start_atom_rem+iatom-1)%atomic_kind%name + particles_old(remove_box)%list%els(start_atom_rem + iatom - 1)%atomic_kind%name ENDDO start_atom_ins = 1 ELSE @@ -672,42 +672,42 @@ SUBROUTINE mc_ge_swap_move(mc_par, force_env, bias_env, moves, & ! remember the start number for the CBMC stuff start_atom_ins = 1 DO itype = 1, nmol_types - start_atom_ins = start_atom_ins+ & + start_atom_ins = start_atom_ins + & nchains(itype, insert_box)*nunits(itype) IF (itype == molecule_type) EXIT ENDDO - DO iatom = 1, start_atom_ins-1 + DO iatom = 1, start_atom_ins - 1 insert_coords(1:3, iatom) = & particles_old(insert_box)%list%els(iatom)%r(1:3) atom_names_insert(iatom) = & particles_old(insert_box)%list%els(iatom)%atomic_kind%name ENDDO iiatom = 1 - DO iatom = start_atom_ins, start_atom_ins+nunits(molecule_type)-1 + DO iatom = start_atom_ins, start_atom_ins + nunits(molecule_type) - 1 insert_coords(1:3, iatom) = r_insert_mol(1:3, iiatom) atom_names_insert(iatom) = atom_names(iiatom, molecule_type) - iiatom = iiatom+1 + iiatom = iiatom + 1 ENDDO - DO iatom = start_atom_ins+nunits(molecule_type), ins_atoms + DO iatom = start_atom_ins + nunits(molecule_type), ins_atoms insert_coords(1:3, iatom) = & - particles_old(insert_box)%list%els(iatom-nunits(molecule_type))%r(1:3) + particles_old(insert_box)%list%els(iatom - nunits(molecule_type))%r(1:3) atom_names_insert(iatom) = & - particles_old(insert_box)%list%els(iatom-nunits(molecule_type))%atomic_kind%name + particles_old(insert_box)%list%els(iatom - nunits(molecule_type))%atomic_kind%name ENDDO ENDIF ! fold the coordinates into the box and check for overlaps start_mol = 1 - DO jbox = 1, insert_box-1 - start_mol = start_mol+SUM(nchains(:, jbox)) + DO jbox = 1, insert_box - 1 + start_mol = start_mol + SUM(nchains(:, jbox)) ENDDO - end_mol = start_mol+SUM(nchains(:, insert_box))-1 + end_mol = start_mol + SUM(nchains(:, insert_box)) - 1 ! make the .dat file IF (ionode) THEN - nchains(molecule_type, insert_box) = nchains(molecule_type, insert_box)+1 + nchains(molecule_type, insert_box) = nchains(molecule_type, insert_box) + 1 IF (lbias) THEN CALL get_mc_par(mc_par(insert_box)%mc_par, mc_bias_file=mc_bias_file) CALL mc_make_dat_file_new(insert_coords(:, :), atom_names_insert(:), ins_atoms, & @@ -719,7 +719,7 @@ SUBROUTINE mc_ge_swap_move(mc_par, force_env, bias_env, moves, & abc_insert(:), dat_file(insert_box), nchains(:, insert_box), & mc_input_file) ENDIF - nchains(molecule_type, insert_box) = nchains(molecule_type, insert_box)-1 + nchains(molecule_type, insert_box) = nchains(molecule_type, insert_box) - 1 ENDIF @@ -733,7 +733,7 @@ SUBROUTINE mc_ge_swap_move(mc_par, force_env, bias_env, moves, & ! need to adjust nchains, because otherwise if we are removing a molecule type ! that is not the first molecule, the dat file will have two molecules in it but ! only the coordinates for one - nchains(molecule_type, remove_box) = nchains(molecule_type, remove_box)-1 + nchains(molecule_type, remove_box) = nchains(molecule_type, remove_box) - 1 IF (ionode) THEN IF (lbias) THEN CALL get_mc_par(mc_par(remove_box)%mc_par, mc_bias_file=mc_bias_file) @@ -748,25 +748,25 @@ SUBROUTINE mc_ge_swap_move(mc_par, force_env, bias_env, moves, & ENDIF ENDIF - nchains(molecule_type, remove_box) = nchains(molecule_type, remove_box)+1 + nchains(molecule_type, remove_box) = nchains(molecule_type, remove_box) + 1 ELSE - DO iatom = 1, start_atom_rem-1 + DO iatom = 1, start_atom_rem - 1 remove_coords(1:3, iatom) = & particles_old(remove_box)%list%els(iatom)%r(1:3) atom_names_remove(iatom) = & particles_old(remove_box)%list%els(iatom)%atomic_kind%name ENDDO - DO iatom = start_atom_rem+nunits(molecule_type), nunits_tot(remove_box) - remove_coords(1:3, iatom-nunits(molecule_type)) = & + DO iatom = start_atom_rem + nunits(molecule_type), nunits_tot(remove_box) + remove_coords(1:3, iatom - nunits(molecule_type)) = & particles_old(remove_box)%list%els(iatom)%r(1:3) - atom_names_remove(iatom-nunits(molecule_type)) = & + atom_names_remove(iatom - nunits(molecule_type)) = & particles_old(remove_box)%list%els(iatom)%atomic_kind%name ENDDO ! make the .dat file IF (ionode) THEN - nchains(molecule_type, remove_box) = nchains(molecule_type, remove_box)-1 + nchains(molecule_type, remove_box) = nchains(molecule_type, remove_box) - 1 IF (lbias) THEN CALL get_mc_par(mc_par(remove_box)%mc_par, mc_bias_file=mc_bias_file) CALL mc_make_dat_file_new(remove_coords(:, :), atom_names_remove(:), rem_atoms, & @@ -778,7 +778,7 @@ SUBROUTINE mc_ge_swap_move(mc_par, force_env, bias_env, moves, & abc_remove(:), dat_file(remove_box), nchains(:, remove_box), & mc_input_file) ENDIF - nchains(molecule_type, remove_box) = nchains(molecule_type, remove_box)+1 + nchains(molecule_type, remove_box) = nchains(molecule_type, remove_box) + 1 ENDIF ENDIF @@ -814,10 +814,10 @@ SUBROUTINE mc_ge_swap_move(mc_par, force_env, bias_env, moves, & ! figure out the position of the molecule we're inserting, and the ! Rosenbluth weight start_mol = 1 - DO jbox = 1, insert_box-1 - start_mol = start_mol+SUM(nchains_test(:, jbox)) + DO jbox = 1, insert_box - 1 + start_mol = start_mol + SUM(nchains_test(:, jbox)) ENDDO - end_mol = start_mol+SUM(nchains_test(:, insert_box))-1 + end_mol = start_mol + SUM(nchains_test(:, insert_box)) - 1 IF (lbias) THEN CALL generate_cbmc_swap_config(test_env(insert_box)%force_env, & @@ -831,7 +831,7 @@ SUBROUTINE mc_ge_swap_move(mc_par, force_env, bias_env, moves, & ! the real energy for the acceptance rule...we don't do this for the ! lbias=.false. case because it doesn't appear in the acceptance rule, and ! we compensate in case of acceptance - bias_energy_new(insert_box) = bias_energy_new(insert_box)+ & + bias_energy_new(insert_box) = bias_energy_new(insert_box) + & bias_energy_old(insert_box) ELSE CALL generate_cbmc_swap_config(test_env(insert_box)%force_env, & @@ -883,7 +883,7 @@ SUBROUTINE mc_ge_swap_move(mc_par, force_env, bias_env, moves, & ! if we made it this far, we have no overlaps moves(molecule_type, insert_box)%moves%grown = & - moves(molecule_type, insert_box)%moves%grown+1 + moves(molecule_type, insert_box)%moves%grown + 1 ! if we're biasing, we need to make environments with the non-biasing ! potentials, and calculate the energies @@ -953,10 +953,10 @@ SUBROUTINE mc_ge_swap_move(mc_par, force_env, bias_env, moves, & ! had a molecule removed for the CBMC configurations, and therefore nchains ! and mol_type instead of nchains_test and mol_type_test start_mol = 1 - DO jbox = 1, remove_box-1 - start_mol = start_mol+SUM(nchains(:, jbox)) + DO jbox = 1, remove_box - 1 + start_mol = start_mol + SUM(nchains(:, jbox)) ENDDO - end_mol = start_mol+SUM(nchains(:, remove_box))-1 + end_mol = start_mol + SUM(nchains(:, remove_box)) - 1 IF (lbias) THEN CALL generate_cbmc_swap_config(bias_env(remove_box)%force_env, & BETA, max_val, min_val, exp_max_val, & @@ -977,16 +977,16 @@ SUBROUTINE mc_ge_swap_move(mc_par, force_env, bias_env, moves, & ! rule, based on numbers of particles and volumes prefactor = REAL(nchains(molecule_type, remove_box), dp)/ & - REAL(nchains(molecule_type, insert_box)+1, dp)* & + REAL(nchains(molecule_type, insert_box) + 1, dp)* & vol_insert/vol_remove IF (lbias) THEN - del_quickstep_energy = (-BETA)*(new_energy(insert_box)- & - old_energy(insert_box)+new_energy(remove_box)- & - old_energy(remove_box)-(bias_energy_new(insert_box)+ & - bias_energy_new(remove_box)-bias_energy_old(insert_box) & - -bias_energy_old(remove_box))) + del_quickstep_energy = (-BETA)*(new_energy(insert_box) - & + old_energy(insert_box) + new_energy(remove_box) - & + old_energy(remove_box) - (bias_energy_new(insert_box) + & + bias_energy_new(remove_box) - bias_energy_old(insert_box) & + - bias_energy_old(remove_box))) IF (del_quickstep_energy .GT. exp_max_val) THEN del_quickstep_energy = max_val @@ -996,11 +996,11 @@ SUBROUTINE mc_ge_swap_move(mc_par, force_env, bias_env, moves, & del_quickstep_energy = EXP(del_quickstep_energy) ENDIF w = prefactor*del_quickstep_energy*weight_new/weight_old & - *EXP(BETA*(eta_remove(molecule_type)-eta_insert(molecule_type))) + *EXP(BETA*(eta_remove(molecule_type) - eta_insert(molecule_type))) ELSE w = prefactor*weight_new/weight_old & - *EXP(BETA*(eta_remove(molecule_type)-eta_insert(molecule_type))) + *EXP(BETA*(eta_remove(molecule_type) - eta_insert(molecule_type))) ENDIF @@ -1019,19 +1019,19 @@ SUBROUTINE mc_ge_swap_move(mc_par, force_env, bias_env, moves, & ! accept the move moves(molecule_type, insert_box)%moves%swap%successes = & - moves(molecule_type, insert_box)%moves%swap%successes+1 + moves(molecule_type, insert_box)%moves%swap%successes + 1 ! we need to compensate for the fact that we take the difference in ! generate_cbmc_config to keep the exponetials small IF (.NOT. lbias) THEN - new_energy(insert_box) = new_energy(insert_box)+ & + new_energy(insert_box) = new_energy(insert_box) + & old_energy(insert_box) ENDIF DO ibox = 1, 2 ! update energies - energy_check(ibox) = energy_check(ibox)+(new_energy(ibox)- & - old_energy(ibox)) + energy_check(ibox) = energy_check(ibox) + (new_energy(ibox) - & + old_energy(ibox)) old_energy(ibox) = new_energy(ibox) ! if we're biasing the update the biasing energy IF (lbias) THEN @@ -1206,9 +1206,9 @@ SUBROUTINE mc_ge_volume_move(mc_par, force_env, moves, move_updates, & ! record the attempt DO ibox = 1, 2 moves(1, ibox)%moves%volume%attempts = & - moves(1, ibox)%moves%volume%attempts+1 + moves(1, ibox)%moves%volume%attempts + 1 move_updates(1, ibox)%moves%volume%attempts = & - move_updates(1, ibox)%moves%volume%attempts+1 + move_updates(1, ibox)%moves%volume%attempts + 1 ENDDO ! now let's grab the cell length and particle positions @@ -1240,20 +1240,20 @@ SUBROUTINE mc_ge_volume_move(mc_par, force_env, moves, move_updates, & IF (ionode) rand = next_random_number(rng_stream) CALL mp_bcast(rand, source, group) - vol_dis = rmvolume*(rand-0.5E0_dp)*2.0E0_dp + vol_dis = rmvolume*(rand - 0.5E0_dp)*2.0E0_dp ! add to one box, subtract from the other IF (old_cell_length(1, 1)*old_cell_length(2, 1)* & - old_cell_length(3, 1)+vol_dis .LE. (3.0E0_dp/angstrom)**3) & + old_cell_length(3, 1) + vol_dis .LE. (3.0E0_dp/angstrom)**3) & CPABORT('GE_volume moves are trying to make box 1 smaller than 3') IF (old_cell_length(1, 2)*old_cell_length(2, 2)* & - old_cell_length(3, 2)+vol_dis .LE. (3.0E0_dp/angstrom)**3) & + old_cell_length(3, 2) + vol_dis .LE. (3.0E0_dp/angstrom)**3) & CPABORT('GE_volume moves are trying to make box 2 smaller than 3') DO iside = 1, 3 - new_cell_length(iside, 1) = (old_cell_length(1, 1)**3+ & + new_cell_length(iside, 1) = (old_cell_length(1, 1)**3 + & vol_dis)**(1.0E0_dp/3.0E0_dp) - new_cell_length(iside, 2) = (old_cell_length(1, 2)**3- & + new_cell_length(iside, 2) = (old_cell_length(1, 2)**3 - & vol_dis)**(1.0E0_dp/3.0E0_dp) ENDDO @@ -1281,16 +1281,16 @@ SUBROUTINE mc_ge_volume_move(mc_par, force_env, moves, move_updates, & ! center of mass start_atom = 1 molecule_index = 1 - DO jbox = 1, ibox-1 + DO jbox = 1, ibox - 1 IF (jbox == ibox) EXIT - molecule_index = molecule_index+SUM(nchains(:, jbox)) + molecule_index = molecule_index + SUM(nchains(:, jbox)) ENDDO DO imolecule = 1, SUM(nchains(:, ibox)) - molecule_type = mol_type(imolecule+molecule_index-1) + molecule_type = mol_type(imolecule + molecule_index - 1) IF (imolecule .NE. 1) THEN - start_atom = start_atom+nunits(mol_type(imolecule+molecule_index-2)) + start_atom = start_atom + nunits(mol_type(imolecule + molecule_index - 2)) ENDIF - end_atom = start_atom+nunits(molecule_type)-1 + end_atom = start_atom + nunits(molecule_type) - 1 ! now find the center of mass CALL get_center_of_mass(r(:, start_atom:end_atom, ibox), & @@ -1301,11 +1301,11 @@ SUBROUTINE mc_ge_volume_move(mc_par, force_env, moves, move_updates, & center_of_mass_new(1:3) = center_of_mass(1:3)* & new_cell_length(1:3, ibox)/old_cell_length(1:3, ibox) DO j = 1, 3 - diff(j) = center_of_mass_new(j)-center_of_mass(j) + diff(j) = center_of_mass_new(j) - center_of_mass(j) ! now change the particle positions DO jatom = start_atom, end_atom particles_old(ibox)%list%els(jatom)%r(j) = & - particles_old(ibox)%list%els(jatom)%r(j)+diff(j) + particles_old(ibox)%list%els(jatom)%r(j) + diff(j) ENDDO ENDDO @@ -1313,10 +1313,10 @@ SUBROUTINE mc_ge_volume_move(mc_par, force_env, moves, move_updates, & ! check for any overlaps we might have start_mol = 1 - DO jbox = 1, ibox-1 - start_mol = start_mol+SUM(nchains(:, jbox)) + DO jbox = 1, ibox - 1 + start_mol = start_mol + SUM(nchains(:, jbox)) ENDDO - end_mol = start_mol+SUM(nchains(:, ibox))-1 + end_mol = start_mol + SUM(nchains(:, ibox)) - 1 CALL check_for_overlap(force_env(ibox)%force_env, & nchains(:, ibox), nunits, loverlap(ibox), mol_type(start_mol:end_mol), & cell_length=new_cell_length(:, ibox)) @@ -1354,8 +1354,8 @@ SUBROUTINE mc_ge_volume_move(mc_par, force_env, moves, move_updates, & w = 0.0E0_dp ELSE w = prefactor*EXP(-BETA* & - (new_energy(1)+new_energy(2)- & - old_energy(1)-old_energy(2))) + (new_energy(1) + new_energy(2) - & + old_energy(1) - old_energy(2))) ENDIF @@ -1383,13 +1383,13 @@ SUBROUTINE mc_ge_volume_move(mc_par, force_env, moves, move_updates, & DO ibox = 1, 2 ! accept the move moves(1, ibox)%moves%volume%successes = & - moves(1, ibox)%moves%volume%successes+1 + moves(1, ibox)%moves%volume%successes + 1 move_updates(1, ibox)%moves%volume%successes = & - move_updates(1, ibox)%moves%volume%successes+1 + move_updates(1, ibox)%moves%volume%successes + 1 ! update energies - energy_check(ibox) = energy_check(ibox)+(new_energy(ibox)- & - old_energy(ibox)) + energy_check(ibox) = energy_check(ibox) + (new_energy(ibox) - & + old_energy(ibox)) old_energy(ibox) = new_energy(ibox) ! and the new "old" coordiantes diff --git a/src/motion/mc/mc_misc.F b/src/motion/mc/mc_misc.F index 119e2f9f1d..4425949af8 100644 --- a/src/motion/mc/mc_misc.F +++ b/src/motion/mc/mc_misc.F @@ -144,7 +144,7 @@ SUBROUTINE final_mc_write(mc_par, all_moves, iw, energy_check, initial_energy, & mc_molecule_info=mc_molecule_info) CALL get_mc_molecule_info(mc_molecule_info, nmol_types=nmol_types) WRITE (molecule_string, '(I2)') nmol_types - WRITE (tab_string, '(I4)') 81-11*nmol_types + WRITE (tab_string, '(I4)') 81 - 11*nmol_types format_string = "(A,T"//TRIM(ADJUSTL(tab_string))//","//TRIM(ADJUSTL(molecule_string))//"(2X,F9.6))" ! write out some data averaged over the whole simulation @@ -241,13 +241,13 @@ SUBROUTINE final_mc_write(mc_par, all_moves, iw, energy_check, initial_energy, & WRITE (iw, '(A,T43,A)') "Conformational Moves", & "Attempted Accepted Percent" WRITE (iw, '(T46,I6,9X,I6,7X,F7.3)') & - moves%bond%attempts+moves%angle%attempts+ & + moves%bond%attempts + moves%angle%attempts + & moves%dihedral%attempts, & - moves%bond%successes+moves%angle%successes+ & + moves%bond%successes + moves%angle%successes + & moves%dihedral%successes, & - REAL(moves%bond%successes+moves%angle%successes+ & + REAL(moves%bond%successes + moves%angle%successes + & moves%dihedral%successes, dp)/ & - REAL(moves%bond%attempts+moves%angle%attempts+ & + REAL(moves%bond%attempts + moves%angle%attempts + & moves%dihedral%attempts, dp)*100.0E0_dp string2 = "Attempted Accepted Percent" string1 = "Bond Changes" @@ -364,12 +364,12 @@ SUBROUTINE final_mc_write(mc_par, all_moves, iw, energy_check, initial_energy, & ENDDO ! see if the energies add up properly - IF (ABS(initial_energy+energy_check-final_energy) .GT. 0.0000001E0_dp) & + IF (ABS(initial_energy + energy_check - final_energy) .GT. 0.0000001E0_dp) & THEN WRITE (iw, *) '!!!!!!! We have an energy problem. !!!!!!!!' WRITE (iw, '(A,T64,F16.10)') 'Final Energy = ', final_energy WRITE (iw, '(A,T64,F16.10)') 'Inital Energy + energy_check =', & - initial_energy+energy_check + initial_energy + energy_check ENDIF WRITE (iw, '(A,A)') '****************************************************', & '****************************' @@ -498,17 +498,17 @@ SUBROUTINE mc_make_dat_file_new(coordinates, atom_names, nunits_tot, & nmol_types = SIZE(nchains) ! first, write all the information up to the cell lengths - DO iline = 1, cell_row-1 + DO iline = 1, cell_row - 1 WRITE (unit, '(A)') TRIM(text(iline)) ENDDO ! substitute in the current cell lengths WRITE (cell_string, '(3(F13.8,2X))') box_length(1:3)*angstrom line_text = text(cell_row) - line_text(cell_column:cell_column+50) = cell_string(1:51) + line_text(cell_column:cell_column + 50) = cell_string(1:51) WRITE (unit, '(A)') TRIM(line_text) ! now write everything until the coordinates - DO iline = cell_row+1, coord_row_start + DO iline = cell_row + 1, coord_row_start WRITE (unit, '(A)') TRIM(text(iline)) ENDDO @@ -530,7 +530,7 @@ SUBROUTINE mc_make_dat_file_new(coordinates, atom_names, nunits_tot, & ! now we need to write the MOL_SET section start_line = coord_row_end DO itype = 1, nmol_types - DO iline = start_line, mol_set_nmol_row(itype)-1 + DO iline = start_line, mol_set_nmol_row(itype) - 1 WRITE (unit, '(A)') TRIM(text(iline)) ENDDO @@ -542,15 +542,15 @@ SUBROUTINE mc_make_dat_file_new(coordinates, atom_names, nunits_tot, & ENDIF line_text = text(mol_set_nmol_row(itype)) - line_text(mol_set_nmol_column(itype):mol_set_nmol_column(itype)+9) = & + line_text(mol_set_nmol_column(itype):mol_set_nmol_column(itype) + 9) = & mol_string(1:10) WRITE (unit, '(A)') TRIM(line_text) - start_line = mol_set_nmol_row(itype)+1 + start_line = mol_set_nmol_row(itype) + 1 ENDDO ! write up to the RUN_TYPE...tailor this for the type of environment, so ! that we can easily do ./cp2k.sdbg input.dat and have it run - DO iline = mol_set_nmol_row(nmol_types)+1, run_type_row-1 + DO iline = mol_set_nmol_row(nmol_types) + 1, run_type_row - 1 WRITE (unit, '(A)') TRIM(text(iline)) ENDDO SELECT CASE (in_use) @@ -559,7 +559,7 @@ SUBROUTINE mc_make_dat_file_new(coordinates, atom_names, nunits_tot, & CASE (use_qs_force) WRITE (unit, '(A)') ' RUN_TYPE ENERGY_FORCE' END SELECT - DO iline = run_type_row+1, global_row_end + DO iline = run_type_row + 1, global_row_end WRITE (unit, '(A)') TRIM(text(iline)) ENDDO DO iline = motion_row_start, motion_row_end diff --git a/src/motion/mc/mc_move_control.F b/src/motion/mc/mc_move_control.F index f64daac92e..78d1895eba 100644 --- a/src/motion/mc/mc_move_control.F +++ b/src/motion/mc/mc_move_control.F @@ -10,7 +10,7 @@ !> \author Matthew J. McGrath (10.16.2003) ! ************************************************************************************************** MODULE mc_move_control - + USE kinds, ONLY: dp USE mathconstants, ONLY: pi USE mc_types, ONLY: get_mc_molecule_info,& @@ -22,17 +22,17 @@ MODULE mc_move_control USE physcon, ONLY: angstrom #include "../../base/base_uses.f90" - IMPLICIT NONE + IMPLICIT NONE - PRIVATE + PRIVATE ! *** Global parameters *** CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'mc_move_control' - PUBLIC :: init_mc_moves, & - mc_move_update,move_q_reinit,q_move_accept,mc_moves_release,& - write_move_stats + PUBLIC :: init_mc_moves, & + mc_move_update, move_q_reinit, q_move_accept, mc_moves_release, & + write_move_stats CONTAINS @@ -44,7 +44,7 @@ MODULE mc_move_control !> Suitable for parallel. !> \author MJM ! ************************************************************************************************** - SUBROUTINE init_mc_moves ( moves ) + SUBROUTINE init_mc_moves(moves) TYPE(mc_moves_type), POINTER :: moves @@ -54,7 +54,7 @@ SUBROUTINE init_mc_moves ( moves ) ! begin the timing of the subroutine - CALL timeset(routineN,handle) + CALL timeset(routineN, handle) ! allocate all the structures ALLOCATE (moves) @@ -79,81 +79,81 @@ SUBROUTINE init_mc_moves ( moves ) ALLOCATE (moves%swap) ALLOCATE (moves%Quickstep) ! set all the counters equal to zero - moves%bias_bond%attempts=0 - moves%bias_bond%successes=0 - moves%bias_bond%qsuccesses=0 - moves%bias_angle%attempts=0 - moves%bias_angle%successes=0 - moves%bias_angle%qsuccesses=0 - moves%bias_dihedral%attempts=0 - moves%bias_dihedral%successes=0 - moves%bias_dihedral%qsuccesses=0 - moves%bias_trans%attempts=0 - moves%bias_trans%successes=0 - moves%bias_trans%qsuccesses=0 - moves%bias_cltrans%attempts=0 - moves%bias_cltrans%successes=0 - moves%bias_cltrans%qsuccesses=0 - moves%bias_rot%attempts=0 - moves%bias_rot%successes=0 - moves%bias_rot%qsuccesses=0 - - moves%bond%attempts=0 - moves%bond%successes=0 - moves%bond%qsuccesses=0 - moves%angle%attempts=0 - moves%angle%successes=0 - moves%angle%qsuccesses=0 - moves%dihedral%attempts=0 - moves%dihedral%successes=0 - moves%dihedral%qsuccesses=0 - moves%trans%attempts=0 - moves%trans%successes=0 - moves%trans%qsuccesses=0 - moves%cltrans%attempts=0 - moves%cltrans%successes=0 - moves%cltrans%qsuccesses=0 - moves%rot%attempts=0 - moves%rot%successes=0 - moves%rot%qsuccesses=0 - moves%avbmc_inin%attempts=0 - moves%avbmc_inin%successes=0 - moves%avbmc_inin%qsuccesses=0 - moves%avbmc_inout%attempts=0 - moves%avbmc_inout%successes=0 - moves%avbmc_inout%qsuccesses=0 - moves%avbmc_outin%attempts=0 - moves%avbmc_outin%successes=0 - moves%avbmc_outin%qsuccesses=0 - moves%avbmc_outout%attempts=0 - moves%avbmc_outout%successes=0 - moves%avbmc_outout%qsuccesses=0 - moves%volume%attempts=0 - moves%volume%successes=0 - moves%volume%qsuccesses=0 - moves%hmc%attempts=0 - moves%hmc%successes=0 - moves%hmc%qsuccesses=0 - moves%swap%attempts=0 - moves%swap%successes=0 - moves%swap%qsuccesses=0 - moves%Quickstep%attempts=0 - moves%Quickstep%successes=0 - moves%Quickstep%qsuccesses=0 - moves%trans_dis=0.0E0_dp - moves%qtrans_dis=0.0E0_dp - moves%cltrans_dis=0.0E0_dp - moves%qcltrans_dis=0.0E0_dp - moves%empty=0 - moves%empty_conf=0 - moves%empty_avbmc=0 - moves%grown=0 + moves%bias_bond%attempts = 0 + moves%bias_bond%successes = 0 + moves%bias_bond%qsuccesses = 0 + moves%bias_angle%attempts = 0 + moves%bias_angle%successes = 0 + moves%bias_angle%qsuccesses = 0 + moves%bias_dihedral%attempts = 0 + moves%bias_dihedral%successes = 0 + moves%bias_dihedral%qsuccesses = 0 + moves%bias_trans%attempts = 0 + moves%bias_trans%successes = 0 + moves%bias_trans%qsuccesses = 0 + moves%bias_cltrans%attempts = 0 + moves%bias_cltrans%successes = 0 + moves%bias_cltrans%qsuccesses = 0 + moves%bias_rot%attempts = 0 + moves%bias_rot%successes = 0 + moves%bias_rot%qsuccesses = 0 + + moves%bond%attempts = 0 + moves%bond%successes = 0 + moves%bond%qsuccesses = 0 + moves%angle%attempts = 0 + moves%angle%successes = 0 + moves%angle%qsuccesses = 0 + moves%dihedral%attempts = 0 + moves%dihedral%successes = 0 + moves%dihedral%qsuccesses = 0 + moves%trans%attempts = 0 + moves%trans%successes = 0 + moves%trans%qsuccesses = 0 + moves%cltrans%attempts = 0 + moves%cltrans%successes = 0 + moves%cltrans%qsuccesses = 0 + moves%rot%attempts = 0 + moves%rot%successes = 0 + moves%rot%qsuccesses = 0 + moves%avbmc_inin%attempts = 0 + moves%avbmc_inin%successes = 0 + moves%avbmc_inin%qsuccesses = 0 + moves%avbmc_inout%attempts = 0 + moves%avbmc_inout%successes = 0 + moves%avbmc_inout%qsuccesses = 0 + moves%avbmc_outin%attempts = 0 + moves%avbmc_outin%successes = 0 + moves%avbmc_outin%qsuccesses = 0 + moves%avbmc_outout%attempts = 0 + moves%avbmc_outout%successes = 0 + moves%avbmc_outout%qsuccesses = 0 + moves%volume%attempts = 0 + moves%volume%successes = 0 + moves%volume%qsuccesses = 0 + moves%hmc%attempts = 0 + moves%hmc%successes = 0 + moves%hmc%qsuccesses = 0 + moves%swap%attempts = 0 + moves%swap%successes = 0 + moves%swap%qsuccesses = 0 + moves%Quickstep%attempts = 0 + moves%Quickstep%successes = 0 + moves%Quickstep%qsuccesses = 0 + moves%trans_dis = 0.0E0_dp + moves%qtrans_dis = 0.0E0_dp + moves%cltrans_dis = 0.0E0_dp + moves%qcltrans_dis = 0.0E0_dp + moves%empty = 0 + moves%empty_conf = 0 + moves%empty_avbmc = 0 + moves%grown = 0 ! moves%force_create=1 - ! end the timing + ! end the timing CALL timestop(handle) - END SUBROUTINE init_mc_moves + END SUBROUTINE init_mc_moves ! ************************************************************************************************** !> \brief deallocates all the structures and nullifies the pointer @@ -162,7 +162,7 @@ END SUBROUTINE init_mc_moves !> Suitable for parallel. !> \author MJM ! ************************************************************************************************** - SUBROUTINE mc_moves_release ( moves ) + SUBROUTINE mc_moves_release(moves) TYPE(mc_moves_type), POINTER :: moves @@ -173,7 +173,7 @@ SUBROUTINE mc_moves_release ( moves ) ! begin the timing of the subroutine - CALL timeset(routineN,handle) + CALL timeset(routineN, handle) ! allocate all the structures DEALLOCATE (moves%bond) @@ -200,12 +200,12 @@ SUBROUTINE mc_moves_release ( moves ) DEALLOCATE (moves) ! now nullify the moves - NULLIFY(moves) + NULLIFY (moves) - ! end the timing + ! end the timing CALL timestop(handle) - END SUBROUTINE mc_moves_release + END SUBROUTINE mc_moves_release ! ************************************************************************************************** !> \brief sets all qsuccess counters back to zero @@ -216,7 +216,7 @@ END SUBROUTINE mc_moves_release !> Suitable for parallel. !> \author MJM ! ************************************************************************************************** -SUBROUTINE move_q_reinit ( moves , lbias ) + SUBROUTINE move_q_reinit(moves, lbias) TYPE(mc_moves_type), POINTER :: moves LOGICAL, INTENT(IN) :: lbias @@ -227,33 +227,33 @@ SUBROUTINE move_q_reinit ( moves , lbias ) ! begin the timing of the subroutine - CALL timeset(routineN,handle) + CALL timeset(routineN, handle) ! set all the counters equal to zero - IF(lbias) THEN - moves%bias_bond%qsuccesses=0 - moves%bias_angle%qsuccesses=0 - moves%bias_dihedral%qsuccesses=0 - moves%bias_trans%qsuccesses=0 - moves%bias_cltrans%qsuccesses=0 - moves%bias_rot%qsuccesses=0 + IF (lbias) THEN + moves%bias_bond%qsuccesses = 0 + moves%bias_angle%qsuccesses = 0 + moves%bias_dihedral%qsuccesses = 0 + moves%bias_trans%qsuccesses = 0 + moves%bias_cltrans%qsuccesses = 0 + moves%bias_rot%qsuccesses = 0 ELSE - moves%bond%qsuccesses=0 - moves%angle%qsuccesses=0 - moves%dihedral%qsuccesses=0 - moves%trans%qsuccesses=0 - moves%cltrans%qsuccesses=0 - moves%rot%qsuccesses=0 - moves%volume%qsuccesses=0 - moves%hmc%qsuccesses=0 - moves%qtrans_dis=0.0E0_dp - moves%qcltrans_dis=0.0E0_dp + moves%bond%qsuccesses = 0 + moves%angle%qsuccesses = 0 + moves%dihedral%qsuccesses = 0 + moves%trans%qsuccesses = 0 + moves%cltrans%qsuccesses = 0 + moves%rot%qsuccesses = 0 + moves%volume%qsuccesses = 0 + moves%hmc%qsuccesses = 0 + moves%qtrans_dis = 0.0E0_dp + moves%qcltrans_dis = 0.0E0_dp ENDIF - ! end the timing + ! end the timing CALL timestop(handle) - END SUBROUTINE move_q_reinit + END SUBROUTINE move_q_reinit ! ************************************************************************************************** !> \brief updates accepted moves in the given structure...assumes you've been @@ -266,7 +266,7 @@ END SUBROUTINE move_q_reinit !> Suitable for parallel. !> \author MJM ! ************************************************************************************************** -SUBROUTINE q_move_accept(moves,lbias) + SUBROUTINE q_move_accept(moves, lbias) TYPE(mc_moves_type), POINTER :: moves LOGICAL, INTENT(IN) :: lbias @@ -277,57 +277,57 @@ SUBROUTINE q_move_accept(moves,lbias) ! begin the timing of the subroutine - CALL timeset(routineN,handle) + CALL timeset(routineN, handle) - IF(lbias) THEN + IF (lbias) THEN ! change the number of successful moves for the total move counter - moves%bias_bond%successes=moves%bias_bond%successes& - +moves%bias_bond%qsuccesses - moves%bias_angle%successes=moves%bias_angle%successes& - +moves%bias_angle%qsuccesses - moves%bias_dihedral%successes=moves%bias_dihedral%successes& - +moves%bias_dihedral%qsuccesses - moves%bias_trans%successes=moves%bias_trans%successes& - +moves%bias_trans%qsuccesses - moves%bias_cltrans%successes=moves%bias_cltrans%successes& - +moves%bias_cltrans%qsuccesses - moves%bias_rot%successes=moves%bias_rot%successes& - +moves%bias_rot%qsuccesses + moves%bias_bond%successes = moves%bias_bond%successes & + + moves%bias_bond%qsuccesses + moves%bias_angle%successes = moves%bias_angle%successes & + + moves%bias_angle%qsuccesses + moves%bias_dihedral%successes = moves%bias_dihedral%successes & + + moves%bias_dihedral%qsuccesses + moves%bias_trans%successes = moves%bias_trans%successes & + + moves%bias_trans%qsuccesses + moves%bias_cltrans%successes = moves%bias_cltrans%successes & + + moves%bias_cltrans%qsuccesses + moves%bias_rot%successes = moves%bias_rot%successes & + + moves%bias_rot%qsuccesses ELSE ! change the number of successful moves for the total move counter - moves%bond%successes=moves%bond%successes& - +moves%bond%qsuccesses - moves%angle%successes=moves%angle%successes& - +moves%angle%qsuccesses - moves%dihedral%successes=moves%dihedral%successes& - +moves%dihedral%qsuccesses - moves%trans%successes=moves%trans%successes& - +moves%trans%qsuccesses - moves%cltrans%successes=moves%cltrans%successes& - +moves%cltrans%qsuccesses - moves%rot%successes=moves%rot%successes& - +moves%rot%qsuccesses - moves%hmc%successes=moves%hmc%successes& - +moves%hmc%qsuccesses - moves%volume%successes=moves%volume%successes& - +moves%volume%qsuccesses - moves%avbmc_inin%successes=moves%avbmc_inin%successes& - +moves%avbmc_inin%qsuccesses - moves%avbmc_inout%successes=moves%avbmc_inout%successes& - +moves%avbmc_inout%qsuccesses - moves%avbmc_outin%successes=moves%avbmc_outin%successes& - +moves%avbmc_outin%qsuccesses - moves%avbmc_outout%successes=moves%avbmc_outout%successes& - +moves%avbmc_outout%qsuccesses - - moves%trans_dis=moves%trans_dis+moves%qtrans_dis - moves%cltrans_dis=moves%cltrans_dis+moves%qcltrans_dis + moves%bond%successes = moves%bond%successes & + + moves%bond%qsuccesses + moves%angle%successes = moves%angle%successes & + + moves%angle%qsuccesses + moves%dihedral%successes = moves%dihedral%successes & + + moves%dihedral%qsuccesses + moves%trans%successes = moves%trans%successes & + + moves%trans%qsuccesses + moves%cltrans%successes = moves%cltrans%successes & + + moves%cltrans%qsuccesses + moves%rot%successes = moves%rot%successes & + + moves%rot%qsuccesses + moves%hmc%successes = moves%hmc%successes & + + moves%hmc%qsuccesses + moves%volume%successes = moves%volume%successes & + + moves%volume%qsuccesses + moves%avbmc_inin%successes = moves%avbmc_inin%successes & + + moves%avbmc_inin%qsuccesses + moves%avbmc_inout%successes = moves%avbmc_inout%successes & + + moves%avbmc_inout%qsuccesses + moves%avbmc_outin%successes = moves%avbmc_outin%successes & + + moves%avbmc_outin%qsuccesses + moves%avbmc_outout%successes = moves%avbmc_outout%successes & + + moves%avbmc_outout%qsuccesses + + moves%trans_dis = moves%trans_dis + moves%qtrans_dis + moves%cltrans_dis = moves%cltrans_dis + moves%qcltrans_dis ENDIF ! end the timing CALL timestop(handle) - END SUBROUTINE q_move_accept + END SUBROUTINE q_move_accept ! ************************************************************************************************** !> \brief writes the number of accepted and attempted moves to a file for @@ -339,7 +339,7 @@ END SUBROUTINE q_move_accept !> Use only in serial. !> \author MJM ! ************************************************************************************************** -SUBROUTINE write_move_stats(moves,nnstep,unit) + SUBROUTINE write_move_stats(moves, nnstep, unit) TYPE(mc_moves_type), POINTER :: moves INTEGER, INTENT(IN) :: nnstep, unit @@ -351,64 +351,64 @@ SUBROUTINE write_move_stats(moves,nnstep,unit) ! begin the timing of the subroutine - CALL timeset(routineN,handle) - - WRITE(unit,1000) nnstep,' bias_bond ',& - moves%bias_bond%successes,moves%bias_bond%attempts - WRITE(unit,1000) nnstep,' bias_angle ',& - moves%bias_angle%successes,moves%bias_angle%attempts - WRITE(unit,1000) nnstep,' bias_dihedral ',& - moves%bias_dihedral%successes,moves%bias_dihedral%attempts - WRITE(unit,1000) nnstep,' bias_trans ',& - moves%bias_trans%successes,moves%bias_trans%attempts - WRITE(unit,1000) nnstep,' bias_cltrans ',& - moves%bias_cltrans%successes,moves%bias_cltrans%attempts - WRITE(unit,1000) nnstep,' bias_rot ',& - moves%bias_rot%successes,moves%bias_rot%attempts - - WRITE(unit,1000) nnstep,' bond ',& - moves%bond%successes,moves%bond%attempts - WRITE(unit,1000) nnstep,' angle ',& - moves%angle%successes,moves%angle%attempts - WRITE(unit,1000) nnstep,' dihedral ',& - moves%dihedral%successes,moves%dihedral%attempts - WRITE(unit,1000) nnstep,' trans ',& - moves%trans%successes,moves%trans%attempts - WRITE(unit,1000) nnstep,' cltrans ',& - moves%cltrans%successes,moves%cltrans%attempts - WRITE(unit,1000) nnstep,' rot ',& - moves%rot%successes,moves%rot%attempts - WRITE(unit,1000) nnstep,' swap ',& - moves%swap%successes,moves%swap%attempts - WRITE(unit,1001) nnstep,' grown ',& - moves%grown - WRITE(unit,1001) nnstep,' empty_swap ',& - moves%empty - WRITE(unit,1001) nnstep,' empty_conf ',& - moves%empty_conf - WRITE(unit,1000) nnstep,' volume ',& - moves%volume%successes,moves%volume%attempts - WRITE(unit,1000) nnstep,' HMC ',& - moves%hmc%successes,moves%hmc%attempts - WRITE(unit,1000) nnstep,' avbmc_inin ',& - moves%avbmc_inin%successes,moves%avbmc_inin%attempts - WRITE(unit,1000) nnstep,' avbmc_inout ',& - moves%avbmc_inout%successes,moves%avbmc_inout%attempts - WRITE(unit,1000) nnstep,' avbmc_outin ',& - moves%avbmc_outin%successes,moves%avbmc_outin%attempts - WRITE(unit,1000) nnstep,' avbmc_outout ',& - moves%avbmc_outout%successes,moves%avbmc_outout%attempts - WRITE(unit,1001) nnstep,' empty_avbmc ',& - moves%empty_avbmc - WRITE(unit,1000) nnstep,' Quickstep ',& - moves%quickstep%successes,moves%quickstep%attempts - -1000 FORMAT(I10,2X,A,2X,I10,2X,I10) -1001 FORMAT(I10,2X,A,2X,I10) + CALL timeset(routineN, handle) + + WRITE (unit, 1000) nnstep, ' bias_bond ', & + moves%bias_bond%successes, moves%bias_bond%attempts + WRITE (unit, 1000) nnstep, ' bias_angle ', & + moves%bias_angle%successes, moves%bias_angle%attempts + WRITE (unit, 1000) nnstep, ' bias_dihedral ', & + moves%bias_dihedral%successes, moves%bias_dihedral%attempts + WRITE (unit, 1000) nnstep, ' bias_trans ', & + moves%bias_trans%successes, moves%bias_trans%attempts + WRITE (unit, 1000) nnstep, ' bias_cltrans ', & + moves%bias_cltrans%successes, moves%bias_cltrans%attempts + WRITE (unit, 1000) nnstep, ' bias_rot ', & + moves%bias_rot%successes, moves%bias_rot%attempts + + WRITE (unit, 1000) nnstep, ' bond ', & + moves%bond%successes, moves%bond%attempts + WRITE (unit, 1000) nnstep, ' angle ', & + moves%angle%successes, moves%angle%attempts + WRITE (unit, 1000) nnstep, ' dihedral ', & + moves%dihedral%successes, moves%dihedral%attempts + WRITE (unit, 1000) nnstep, ' trans ', & + moves%trans%successes, moves%trans%attempts + WRITE (unit, 1000) nnstep, ' cltrans ', & + moves%cltrans%successes, moves%cltrans%attempts + WRITE (unit, 1000) nnstep, ' rot ', & + moves%rot%successes, moves%rot%attempts + WRITE (unit, 1000) nnstep, ' swap ', & + moves%swap%successes, moves%swap%attempts + WRITE (unit, 1001) nnstep, ' grown ', & + moves%grown + WRITE (unit, 1001) nnstep, ' empty_swap ', & + moves%empty + WRITE (unit, 1001) nnstep, ' empty_conf ', & + moves%empty_conf + WRITE (unit, 1000) nnstep, ' volume ', & + moves%volume%successes, moves%volume%attempts + WRITE (unit, 1000) nnstep, ' HMC ', & + moves%hmc%successes, moves%hmc%attempts + WRITE (unit, 1000) nnstep, ' avbmc_inin ', & + moves%avbmc_inin%successes, moves%avbmc_inin%attempts + WRITE (unit, 1000) nnstep, ' avbmc_inout ', & + moves%avbmc_inout%successes, moves%avbmc_inout%attempts + WRITE (unit, 1000) nnstep, ' avbmc_outin ', & + moves%avbmc_outin%successes, moves%avbmc_outin%attempts + WRITE (unit, 1000) nnstep, ' avbmc_outout ', & + moves%avbmc_outout%successes, moves%avbmc_outout%attempts + WRITE (unit, 1001) nnstep, ' empty_avbmc ', & + moves%empty_avbmc + WRITE (unit, 1000) nnstep, ' Quickstep ', & + moves%quickstep%successes, moves%quickstep%attempts + +1000 FORMAT(I10, 2X, A, 2X, I10, 2X, I10) +1001 FORMAT(I10, 2X, A, 2X, I10) ! end the timing CALL timestop(handle) - END SUBROUTINE write_move_stats + END SUBROUTINE write_move_stats ! ************************************************************************************************** !> \brief updates the maximum displacements of a Monte Carlo simulation, @@ -426,8 +426,8 @@ END SUBROUTINE write_move_stats !> Suitable for parallel. !> \author MJM ! ************************************************************************************************** - SUBROUTINE mc_move_update ( mc_par,move_updates,molecule_type,flag,& - nnstep,ionode ) + SUBROUTINE mc_move_update(mc_par, move_updates, molecule_type, flag, & + nnstep, ionode) TYPE(mc_simpar_type), POINTER :: mc_par TYPE(mc_moves_type), POINTER :: move_updates @@ -446,257 +446,256 @@ SUBROUTINE mc_move_update ( mc_par,move_updates,molecule_type,flag,& ! begin the timing of the subroutine - CALL timeset(routineN,handle) + CALL timeset(routineN, handle) - NULLIFY(rmangle,rmbond,rmdihedral,rmrot,rmtrans) + NULLIFY (rmangle, rmbond, rmdihedral, rmrot, rmtrans) ! grab some stuff from mc_par - CALL get_mc_par(mc_par,rmbond=rmbond,rmangle=rmangle,rmrot=rmrot,& - rmtrans=rmtrans,rmcltrans=rmcltrans,rmvolume=rmvolume,rm=rm,rmdihedral=rmdihedral,& - mc_molecule_info=mc_molecule_info) - CALL get_mc_molecule_info(mc_molecule_info,nmol_types=nmol_types) + CALL get_mc_par(mc_par, rmbond=rmbond, rmangle=rmangle, rmrot=rmrot, & + rmtrans=rmtrans, rmcltrans=rmcltrans, rmvolume=rmvolume, rm=rm, rmdihedral=rmdihedral, & + mc_molecule_info=mc_molecule_info) + CALL get_mc_molecule_info(mc_molecule_info, nmol_types=nmol_types) SELECT CASE (flag) CASE DEFAULT - WRITE(*,*) 'flag =',flag + WRITE (*, *) 'flag =', flag CPABORT("Wrong option passed") CASE ("trans") ! we need to update all the displacements for every molecule type - IF(ionode) WRITE(rm,*) nnstep,' Data for molecule type ',& - molecule_type + IF (ionode) WRITE (rm, *) nnstep, ' Data for molecule type ', & + molecule_type ! update the maximum displacement for bond length change - IF( move_updates%bias_bond%attempts .GT. 0 ) THEN + IF (move_updates%bias_bond%attempts .GT. 0) THEN ! first account for the extreme cases - IF ( move_updates%bias_bond%successes == 0 ) THEN - rmbond(molecule_type)=rmbond(molecule_type)/2.0E0_dp - ELSEIF ( move_updates%bias_bond%successes == & - move_updates%bias_bond%attempts ) THEN - rmbond(molecule_type)=rmbond(molecule_type)*2.0E0_dp + IF (move_updates%bias_bond%successes == 0) THEN + rmbond(molecule_type) = rmbond(molecule_type)/2.0E0_dp + ELSEIF (move_updates%bias_bond%successes == & + move_updates%bias_bond%attempts) THEN + rmbond(molecule_type) = rmbond(molecule_type)*2.0E0_dp ELSE ! now for the middle case - test_ratio=REAL(move_updates%bias_bond%successes,dp)& - /REAL(move_updates%bias_bond%attempts,dp)/0.5E0_dp - IF (test_ratio .GT. 2.0E0_dp) test_ratio=2.0E0_dp - IF (test_ratio .LT. 0.5E0_dp) test_ratio=0.5E0_dp - rmbond(molecule_type)=rmbond(molecule_type)*test_ratio + test_ratio = REAL(move_updates%bias_bond%successes, dp) & + /REAL(move_updates%bias_bond%attempts, dp)/0.5E0_dp + IF (test_ratio .GT. 2.0E0_dp) test_ratio = 2.0E0_dp + IF (test_ratio .LT. 0.5E0_dp) test_ratio = 0.5E0_dp + rmbond(molecule_type) = rmbond(molecule_type)*test_ratio ENDIF ! update and clear the counters - move_updates%bias_bond%attempts=0 - move_updates%bias_bond%successes=0 + move_updates%bias_bond%attempts = 0 + move_updates%bias_bond%successes = 0 ! write the new displacement to a file - IF(ionode) WRITE(rm,*) nnstep,' rmbond = ',& - rmbond(molecule_type)*angstrom,' angstroms' + IF (ionode) WRITE (rm, *) nnstep, ' rmbond = ', & + rmbond(molecule_type)*angstrom, ' angstroms' ENDIF ! update the maximum displacement for bond angle change - IF( move_updates%bias_angle%attempts .GT. 0 ) THEN + IF (move_updates%bias_angle%attempts .GT. 0) THEN ! first account for the extreme cases - IF ( move_updates%bias_angle%successes == 0 ) THEN - rmangle(molecule_type)=rmangle(molecule_type)/2.0E0_dp - ELSEIF ( move_updates%bias_angle%successes == & - move_updates%bias_angle%attempts ) THEN - rmangle(molecule_type)=rmangle(molecule_type)*2.0E0_dp + IF (move_updates%bias_angle%successes == 0) THEN + rmangle(molecule_type) = rmangle(molecule_type)/2.0E0_dp + ELSEIF (move_updates%bias_angle%successes == & + move_updates%bias_angle%attempts) THEN + rmangle(molecule_type) = rmangle(molecule_type)*2.0E0_dp ELSE ! now for the middle case - test_ratio=REAL(move_updates%bias_angle%successes,dp)& - /REAL(move_updates%bias_angle%attempts,dp)/0.5E0_dp - IF (test_ratio .GT. 2.0E0_dp) test_ratio=2.0E0_dp - IF (test_ratio .LT. 0.5E0_dp) test_ratio=0.5E0_dp - rmangle(molecule_type)=rmangle(molecule_type)*test_ratio + test_ratio = REAL(move_updates%bias_angle%successes, dp) & + /REAL(move_updates%bias_angle%attempts, dp)/0.5E0_dp + IF (test_ratio .GT. 2.0E0_dp) test_ratio = 2.0E0_dp + IF (test_ratio .LT. 0.5E0_dp) test_ratio = 0.5E0_dp + rmangle(molecule_type) = rmangle(molecule_type)*test_ratio ENDIF ! more than pi changes meaningless - IF (rmangle(molecule_type) .GT. pi) rmangle(molecule_type)=pi + IF (rmangle(molecule_type) .GT. pi) rmangle(molecule_type) = pi ! clear the counters - move_updates%bias_angle%attempts=0 - move_updates%bias_angle%successes=0 + move_updates%bias_angle%attempts = 0 + move_updates%bias_angle%successes = 0 ! write the new displacement to a file - IF(ionode) WRITE(rm,*) nnstep,' rmangle = ',& - rmangle(molecule_type)/pi*180.0E0_dp,' degrees' + IF (ionode) WRITE (rm, *) nnstep, ' rmangle = ', & + rmangle(molecule_type)/pi*180.0E0_dp, ' degrees' ENDIF ! update the maximum displacement for a dihedral change - IF( move_updates%bias_dihedral%attempts .GT. 0 ) THEN + IF (move_updates%bias_dihedral%attempts .GT. 0) THEN ! first account for the extreme cases - IF ( move_updates%bias_dihedral%successes == 0 ) THEN - rmdihedral(molecule_type)=rmdihedral(molecule_type)/2.0E0_dp - ELSEIF ( move_updates%bias_dihedral%successes == & - move_updates%bias_dihedral%attempts ) THEN - rmdihedral(molecule_type)=rmdihedral(molecule_type)*2.0E0_dp + IF (move_updates%bias_dihedral%successes == 0) THEN + rmdihedral(molecule_type) = rmdihedral(molecule_type)/2.0E0_dp + ELSEIF (move_updates%bias_dihedral%successes == & + move_updates%bias_dihedral%attempts) THEN + rmdihedral(molecule_type) = rmdihedral(molecule_type)*2.0E0_dp ELSE ! now for the middle case - test_ratio=REAL(move_updates%bias_dihedral%successes,dp)& - /REAL(move_updates%bias_dihedral%attempts,dp)/0.5E0_dp - IF (test_ratio .GT. 2.0E0_dp) test_ratio=2.0E0_dp - IF (test_ratio .LT. 0.5E0_dp) test_ratio=0.5E0_dp - rmdihedral(molecule_type)=rmdihedral(molecule_type)*test_ratio + test_ratio = REAL(move_updates%bias_dihedral%successes, dp) & + /REAL(move_updates%bias_dihedral%attempts, dp)/0.5E0_dp + IF (test_ratio .GT. 2.0E0_dp) test_ratio = 2.0E0_dp + IF (test_ratio .LT. 0.5E0_dp) test_ratio = 0.5E0_dp + rmdihedral(molecule_type) = rmdihedral(molecule_type)*test_ratio ENDIF ! more than pi changes meaningless - IF (rmdihedral(molecule_type) .GT. pi) rmdihedral(molecule_type)=pi + IF (rmdihedral(molecule_type) .GT. pi) rmdihedral(molecule_type) = pi ! clear the counters - move_updates%bias_dihedral%attempts=0 - move_updates%bias_dihedral%successes=0 + move_updates%bias_dihedral%attempts = 0 + move_updates%bias_dihedral%successes = 0 ! write the new displacement to a file - IF(ionode) WRITE(rm,*) nnstep,' rmdihedral = ',& - rmdihedral(molecule_type)/pi*180.0E0_dp,' degrees' + IF (ionode) WRITE (rm, *) nnstep, ' rmdihedral = ', & + rmdihedral(molecule_type)/pi*180.0E0_dp, ' degrees' ENDIF ! update the maximum displacement for molecule translation - IF( move_updates%bias_trans%attempts .GT. 0 ) THEN + IF (move_updates%bias_trans%attempts .GT. 0) THEN ! first account for the extreme cases - IF ( move_updates%bias_trans%successes == 0 ) THEN - rmtrans(molecule_type)=rmtrans(molecule_type)/2.0E0_dp - ELSEIF ( move_updates%bias_trans%successes == & - move_updates%bias_trans%attempts ) THEN - rmtrans(molecule_type)=rmtrans(molecule_type)*2.0E0_dp + IF (move_updates%bias_trans%successes == 0) THEN + rmtrans(molecule_type) = rmtrans(molecule_type)/2.0E0_dp + ELSEIF (move_updates%bias_trans%successes == & + move_updates%bias_trans%attempts) THEN + rmtrans(molecule_type) = rmtrans(molecule_type)*2.0E0_dp ELSE ! now for the middle case - test_ratio=REAL(move_updates%bias_trans%successes,dp)& - /REAL(move_updates%bias_trans%attempts,dp)/0.5E0_dp - IF (test_ratio .GT. 2.0E0_dp) test_ratio=2.0E0_dp - IF (test_ratio .LT. 0.5E0_dp) test_ratio=0.5E0_dp - rmtrans(molecule_type)=rmtrans(molecule_type)*test_ratio + test_ratio = REAL(move_updates%bias_trans%successes, dp) & + /REAL(move_updates%bias_trans%attempts, dp)/0.5E0_dp + IF (test_ratio .GT. 2.0E0_dp) test_ratio = 2.0E0_dp + IF (test_ratio .LT. 0.5E0_dp) test_ratio = 0.5E0_dp + rmtrans(molecule_type) = rmtrans(molecule_type)*test_ratio ENDIF - ! make an upper bound...10 a.u. + ! make an upper bound...10 a.u. IF (rmtrans(molecule_type) .GT. 10.0E0_dp) & - rmtrans(molecule_type )= 10.0E0_dp + rmtrans(molecule_type) = 10.0E0_dp - ! clear the counters - move_updates%bias_trans%attempts=0 - move_updates%bias_trans%successes=0 + ! clear the counters + move_updates%bias_trans%attempts = 0 + move_updates%bias_trans%successes = 0 ! write the new displacement to a file - IF(ionode) WRITE(rm,*) nnstep,' rmtrans = ',& - rmtrans(molecule_type)*angstrom,' angstroms' + IF (ionode) WRITE (rm, *) nnstep, ' rmtrans = ', & + rmtrans(molecule_type)*angstrom, ' angstroms' ENDIF ! update the maximum displacement for cluster translation - IF( move_updates%bias_cltrans%attempts .GT. 0 ) THEN + IF (move_updates%bias_cltrans%attempts .GT. 0) THEN ! first account for the extreme cases - IF ( move_updates%bias_cltrans%successes == 0 ) THEN - rmcltrans=rmcltrans/2.0E0_dp - ELSEIF ( move_updates%bias_cltrans%successes == & - move_updates%bias_cltrans%attempts ) THEN - rmcltrans=rmcltrans*2.0E0_dp + IF (move_updates%bias_cltrans%successes == 0) THEN + rmcltrans = rmcltrans/2.0E0_dp + ELSEIF (move_updates%bias_cltrans%successes == & + move_updates%bias_cltrans%attempts) THEN + rmcltrans = rmcltrans*2.0E0_dp ELSE ! now for the middle case - test_ratio=REAL(move_updates%bias_cltrans%successes,dp)& - /REAL(move_updates%bias_cltrans%attempts,dp)/0.5E0_dp - IF (test_ratio .GT. 2.0E0_dp) test_ratio=2.0E0_dp - IF (test_ratio .LT. 0.5E0_dp) test_ratio=0.5E0_dp - rmcltrans=rmcltrans*test_ratio + test_ratio = REAL(move_updates%bias_cltrans%successes, dp) & + /REAL(move_updates%bias_cltrans%attempts, dp)/0.5E0_dp + IF (test_ratio .GT. 2.0E0_dp) test_ratio = 2.0E0_dp + IF (test_ratio .LT. 0.5E0_dp) test_ratio = 0.5E0_dp + rmcltrans = rmcltrans*test_ratio ENDIF - ! make an upper bound...10 a.u. + ! make an upper bound...10 a.u. IF (rmcltrans .GT. 10.0E0_dp) & - rmcltrans= 10.0E0_dp + rmcltrans = 10.0E0_dp - ! clear the counters - move_updates%bias_cltrans%attempts=0 - move_updates%bias_cltrans%successes=0 + ! clear the counters + move_updates%bias_cltrans%attempts = 0 + move_updates%bias_cltrans%successes = 0 ! write the new displacement to a file - IF(ionode) WRITE(rm,*) nnstep,' rmcltrans = ',& - rmcltrans*angstrom,' angstroms' + IF (ionode) WRITE (rm, *) nnstep, ' rmcltrans = ', & + rmcltrans*angstrom, ' angstroms' ENDIF - ! update the maximum displacement for molecule rotation - IF( move_updates%bias_rot%attempts .GT. 0 ) THEN + IF (move_updates%bias_rot%attempts .GT. 0) THEN ! first account for the extreme cases - IF ( move_updates%bias_rot%successes == 0 ) THEN - rmrot=rmrot/2.0E0_dp + IF (move_updates%bias_rot%successes == 0) THEN + rmrot = rmrot/2.0E0_dp - IF (rmrot(molecule_type) .GT. pi) rmrot(molecule_type)=pi + IF (rmrot(molecule_type) .GT. pi) rmrot(molecule_type) = pi - ELSEIF ( move_updates%bias_rot%successes == & - move_updates%bias_rot%attempts ) THEN - rmrot(molecule_type)=rmrot(molecule_type)*2.0E0_dp + ELSEIF (move_updates%bias_rot%successes == & + move_updates%bias_rot%attempts) THEN + rmrot(molecule_type) = rmrot(molecule_type)*2.0E0_dp ! more than pi rotation is meaningless - IF (rmrot(molecule_type) .GT. pi) rmrot(molecule_type)=pi + IF (rmrot(molecule_type) .GT. pi) rmrot(molecule_type) = pi ELSE ! now for the middle case - test_ratio=REAL(move_updates%bias_rot%successes,dp)& - /REAL(move_updates%bias_rot%attempts,dp)/0.5E0_dp - IF (test_ratio .GT. 2.0E0_dp) test_ratio=2.0E0_dp - IF (test_ratio .LT. 0.5E0_dp) test_ratio=0.5E0_dp - rmrot(molecule_type)=rmrot(molecule_type)*test_ratio + test_ratio = REAL(move_updates%bias_rot%successes, dp) & + /REAL(move_updates%bias_rot%attempts, dp)/0.5E0_dp + IF (test_ratio .GT. 2.0E0_dp) test_ratio = 2.0E0_dp + IF (test_ratio .LT. 0.5E0_dp) test_ratio = 0.5E0_dp + rmrot(molecule_type) = rmrot(molecule_type)*test_ratio ! more than pi rotation is meaningless - IF (rmrot(molecule_type) .GT. pi) rmrot(molecule_type)=pi + IF (rmrot(molecule_type) .GT. pi) rmrot(molecule_type) = pi ENDIF ! clear the counters - move_updates%bias_rot%attempts=0 - move_updates%bias_rot%successes=0 + move_updates%bias_rot%attempts = 0 + move_updates%bias_rot%successes = 0 ! write the new displacement to a file - IF(ionode) WRITE(rm,*) nnstep,' rmrot = ',& - rmrot(molecule_type)/pi*180.0E0_dp,' degrees' + IF (ionode) WRITE (rm, *) nnstep, ' rmrot = ', & + rmrot(molecule_type)/pi*180.0E0_dp, ' degrees' ENDIF CASE ("volume") ! update the maximum displacement for volume displacement - IF ( move_updates%volume%attempts .NE. 0) THEN + IF (move_updates%volume%attempts .NE. 0) THEN ! first account for the extreme cases - IF ( move_updates%volume%successes == 0 ) THEN - rmvolume=rmvolume/2.0E0_dp + IF (move_updates%volume%successes == 0) THEN + rmvolume = rmvolume/2.0E0_dp - ELSEIF ( move_updates%volume%successes == & - move_updates%volume%attempts ) THEN - rmvolume=rmvolume*2.0E0_dp + ELSEIF (move_updates%volume%successes == & + move_updates%volume%attempts) THEN + rmvolume = rmvolume*2.0E0_dp ELSE ! now for the middle case - test_ratio=REAL(move_updates%volume%successes,dp)/& - REAL(move_updates%volume%attempts,dp)/0.5E0_dp - IF (test_ratio .GT. 2.0E0_dp) test_ratio=2.0E0_dp - IF (test_ratio .LT. 0.5E0_dp) test_ratio=0.5E0_dp - rmvolume=rmvolume*test_ratio + test_ratio = REAL(move_updates%volume%successes, dp)/ & + REAL(move_updates%volume%attempts, dp)/0.5E0_dp + IF (test_ratio .GT. 2.0E0_dp) test_ratio = 2.0E0_dp + IF (test_ratio .LT. 0.5E0_dp) test_ratio = 0.5E0_dp + rmvolume = rmvolume*test_ratio ENDIF ! clear the counters - move_updates%volume%attempts=0 - move_updates%volume%successes=0 + move_updates%volume%attempts = 0 + move_updates%volume%successes = 0 ! write the new displacement to a file - IF(ionode) WRITE(rm,*) nnstep,' rmvolume = ',& - rmvolume*angstrom**3,' angstroms^3' + IF (ionode) WRITE (rm, *) nnstep, ' rmvolume = ', & + rmvolume*angstrom**3, ' angstroms^3' ENDIF END SELECT ! set some of the MC parameters - CALL set_mc_par(mc_par,rmbond=rmbond,rmangle=rmangle,rmrot=rmrot,& - rmtrans=rmtrans,rmcltrans=rmcltrans,rmvolume=rmvolume,rmdihedral=rmdihedral) + CALL set_mc_par(mc_par, rmbond=rmbond, rmangle=rmangle, rmrot=rmrot, & + rmtrans=rmtrans, rmcltrans=rmcltrans, rmvolume=rmvolume, rmdihedral=rmdihedral) ! end the timing CALL timestop(handle) - END SUBROUTINE mc_move_update + END SUBROUTINE mc_move_update END MODULE mc_move_control diff --git a/src/motion/mc/mc_moves.F b/src/motion/mc/mc_moves.F index cc0cd3cb59..138a24c4e2 100644 --- a/src/motion/mc/mc_moves.F +++ b/src/motion/mc/mc_moves.F @@ -189,13 +189,13 @@ SUBROUTINE mc_conformation_change(mc_par, force_env, bias_env, moves, & ! find out some bounds for mol_type start_mol = 1 - DO jbox = 1, box_number-1 - start_mol = start_mol+SUM(nchains(:, jbox)) + DO jbox = 1, box_number - 1 + start_mol = start_mol + SUM(nchains(:, jbox)) ENDDO - end_mol = start_mol+SUM(nchains(:, box_number))-1 + end_mol = start_mol + SUM(nchains(:, box_number)) - 1 ! figure out which molecule number we are - end_atom = start_atom+nunits_mol-1 + end_atom = start_atom + nunits_mol - 1 molecule_number = 0 atom_number = 1 DO imolecule = 1, SUM(nchains(:, box_number)) @@ -203,7 +203,7 @@ SUBROUTINE mc_conformation_change(mc_par, force_env, bias_env, moves, & molecule_number = imolecule EXIT ENDIF - atom_number = atom_number+nunits(mol_type(imolecule+start_mol-1)) + atom_number = atom_number + nunits(mol_type(imolecule + start_mol - 1)) ENDDO IF (molecule_number == 0) CPABORT('Cannot find the molecule number') @@ -235,7 +235,7 @@ SUBROUTINE mc_conformation_change(mc_par, force_env, bias_env, moves, & ! save the coordinates DO ipart = start_atom, end_atom - r_old(1:3, ipart-start_atom+1) = particles%els(ipart)%r(1:3) + r_old(1:3, ipart - start_atom + 1) = particles%els(ipart)%r(1:3) ENDDO IF (.NOT. ASSOCIATED(molecule_kind)) CPABORT('Cannot find the molecule type') @@ -243,17 +243,17 @@ SUBROUTINE mc_conformation_change(mc_par, force_env, bias_env, moves, & IF (move_type == 'bond') THEN ! record the attempt - moves%bond%attempts = moves%bond%attempts+1 - move_updates%bond%attempts = move_updates%bond%attempts+1 - moves%bias_bond%attempts = moves%bias_bond%attempts+1 - move_updates%bias_bond%attempts = move_updates%bias_bond%attempts+1 + moves%bond%attempts = moves%bond%attempts + 1 + move_updates%bond%attempts = move_updates%bond%attempts + 1 + moves%bias_bond%attempts = moves%bias_bond%attempts + 1 + move_updates%bias_bond%attempts = move_updates%bias_bond%attempts + 1 IF (.NOT. lbias) THEN - moves%bond%qsuccesses = moves%bond%qsuccesses+1 + moves%bond%qsuccesses = moves%bond%qsuccesses + 1 move_updates%bond%qsuccesses = & - move_updates%bond%qsuccesses+1 - moves%bias_bond%qsuccesses = moves%bias_bond%qsuccesses+1 + move_updates%bond%qsuccesses + 1 + moves%bias_bond%qsuccesses = moves%bias_bond%qsuccesses + 1 move_updates%bias_bond%qsuccesses = & - move_updates%bias_bond%qsuccesses+1 + move_updates%bias_bond%qsuccesses + 1 ENDIF ! do the move @@ -263,17 +263,17 @@ SUBROUTINE mc_conformation_change(mc_par, force_env, bias_env, moves, & ELSEIF (move_type == 'angle') THEN ! record the attempt - moves%angle%attempts = moves%angle%attempts+1 - move_updates%angle%attempts = move_updates%angle%attempts+1 - moves%bias_angle%attempts = moves%bias_angle%attempts+1 - move_updates%bias_angle%attempts = move_updates%bias_angle%attempts+1 + moves%angle%attempts = moves%angle%attempts + 1 + move_updates%angle%attempts = move_updates%angle%attempts + 1 + moves%bias_angle%attempts = moves%bias_angle%attempts + 1 + move_updates%bias_angle%attempts = move_updates%bias_angle%attempts + 1 IF (.NOT. lbias) THEN - moves%angle%qsuccesses = moves%angle%qsuccesses+1 + moves%angle%qsuccesses = moves%angle%qsuccesses + 1 move_updates%angle%qsuccesses = & - move_updates%angle%qsuccesses+1 - moves%bias_angle%qsuccesses = moves%bias_angle%qsuccesses+1 + move_updates%angle%qsuccesses + 1 + moves%bias_angle%qsuccesses = moves%bias_angle%qsuccesses + 1 move_updates%bias_angle%qsuccesses = & - move_updates%bias_angle%qsuccesses+1 + move_updates%bias_angle%qsuccesses + 1 ENDIF ! do the move @@ -282,17 +282,17 @@ SUBROUTINE mc_conformation_change(mc_par, force_env, bias_env, moves, & dis_length = 1.0E0_dp ELSE ! record the attempt - moves%dihedral%attempts = moves%dihedral%attempts+1 - move_updates%dihedral%attempts = move_updates%dihedral%attempts+1 - moves%bias_dihedral%attempts = moves%bias_dihedral%attempts+1 - move_updates%bias_dihedral%attempts = move_updates%bias_dihedral%attempts+1 + moves%dihedral%attempts = moves%dihedral%attempts + 1 + move_updates%dihedral%attempts = move_updates%dihedral%attempts + 1 + moves%bias_dihedral%attempts = moves%bias_dihedral%attempts + 1 + move_updates%bias_dihedral%attempts = move_updates%bias_dihedral%attempts + 1 IF (.NOT. lbias) THEN - moves%dihedral%qsuccesses = moves%dihedral%qsuccesses+1 + moves%dihedral%qsuccesses = moves%dihedral%qsuccesses + 1 move_updates%dihedral%qsuccesses = & - move_updates%dihedral%qsuccesses+1 - moves%bias_dihedral%qsuccesses = moves%bias_dihedral%qsuccesses+1 + move_updates%dihedral%qsuccesses + 1 + moves%bias_dihedral%qsuccesses = moves%bias_dihedral%qsuccesses + 1 move_updates%bias_dihedral%qsuccesses = & - move_updates%bias_dihedral%qsuccesses+1 + move_updates%bias_dihedral%qsuccesses + 1 ENDIF ! do the move @@ -304,7 +304,7 @@ SUBROUTINE mc_conformation_change(mc_par, force_env, bias_env, moves, & ! set the coordinates DO ipart = start_atom, end_atom - particles%els(ipart)%r(1:3) = r_new(1:3, ipart-start_atom+1) + particles%els(ipart)%r(1:3) = r_new(1:3, ipart - start_atom + 1) ENDDO ! check for overlap @@ -334,7 +334,7 @@ SUBROUTINE mc_conformation_change(mc_par, force_env, bias_env, moves, & ! accept or reject the move based on the Metropolis rule with a ! correction factor for the change in phase space...dis_length is ! made unitless in change_bond_length - value = -BETA*(bias_energy_new-bias_energy_old) + value = -BETA*(bias_energy_new - bias_energy_old) IF (value .GT. exp_max_val) THEN w = 10.0_dp ELSEIF (value .LT. exp_min_val) THEN @@ -359,29 +359,29 @@ SUBROUTINE mc_conformation_change(mc_par, force_env, bias_env, moves, & ! accept the move IF (move_type == 'bond') THEN - moves%bond%qsuccesses = moves%bond%qsuccesses+1 + moves%bond%qsuccesses = moves%bond%qsuccesses + 1 move_updates%bond%successes = & - move_updates%bond%successes+1 - moves%bias_bond%successes = moves%bias_bond%successes+1 + move_updates%bond%successes + 1 + moves%bias_bond%successes = moves%bias_bond%successes + 1 move_updates%bias_bond%successes = & - move_updates%bias_bond%successes+1 + move_updates%bias_bond%successes + 1 ELSEIF (move_type == 'angle') THEN - moves%angle%qsuccesses = moves%angle%qsuccesses+1 + moves%angle%qsuccesses = moves%angle%qsuccesses + 1 move_updates%angle%successes = & - move_updates%angle%successes+1 - moves%bias_angle%successes = moves%bias_angle%successes+1 + move_updates%angle%successes + 1 + moves%bias_angle%successes = moves%bias_angle%successes + 1 move_updates%bias_angle%successes = & - move_updates%bias_angle%successes+1 + move_updates%bias_angle%successes + 1 ELSE - moves%dihedral%qsuccesses = moves%dihedral%qsuccesses+1 + moves%dihedral%qsuccesses = moves%dihedral%qsuccesses + 1 move_updates%dihedral%successes = & - move_updates%dihedral%successes+1 - moves%bias_dihedral%successes = moves%bias_dihedral%successes+1 + move_updates%dihedral%successes + 1 + moves%bias_dihedral%successes = moves%bias_dihedral%successes + 1 move_updates%bias_dihedral%successes = & - move_updates%bias_dihedral%successes+1 + move_updates%bias_dihedral%successes + 1 ENDIF - bias_energy = bias_energy+bias_energy_new- & + bias_energy = bias_energy + bias_energy_new - & bias_energy_old ELSE @@ -391,7 +391,7 @@ SUBROUTINE mc_conformation_change(mc_par, force_env, bias_env, moves, & CALL force_env_get(bias_env, subsys=subsys) CALL cp_subsys_get(subsys, particles=particles) DO ipart = start_atom, end_atom - particles%els(ipart)%r(1:3) = r_old(1:3, ipart-start_atom+1) + particles%els(ipart)%r(1:3) = r_old(1:3, ipart - start_atom + 1) ENDDO CALL cp_subsys_set(subsys, particles=particles) @@ -477,17 +477,17 @@ SUBROUTINE mc_molecule_translation(mc_par, force_env, bias_env, moves, & ! find out some bounds for mol_type start_mol = 1 - DO jbox = 1, box_number-1 - start_mol = start_mol+SUM(nchains(:, jbox)) + DO jbox = 1, box_number - 1 + start_mol = start_mol + SUM(nchains(:, jbox)) ENDDO - end_mol = start_mol+SUM(nchains(:, box_number))-1 + end_mol = start_mol + SUM(nchains(:, box_number)) - 1 ! do some allocation ALLOCATE (r_old(1:3, 1:nunits_tot(box_number))) ! find the index of the last atom of this molecule, and the molecule number nunits_mol = nunits(molecule_type) - end_atom = start_atom+nunits_mol-1 + end_atom = start_atom + nunits_mol - 1 molecule_number = 0 atom_number = 1 DO imolecule = 1, SUM(nchains(:, box_number)) @@ -495,7 +495,7 @@ SUBROUTINE mc_molecule_translation(mc_par, force_env, bias_env, moves, & molecule_number = imolecule EXIT ENDIF - atom_number = atom_number+nunits(mol_type(imolecule+start_mol-1)) + atom_number = atom_number + nunits(mol_type(imolecule + start_mol - 1)) ENDDO IF (molecule_number == 0) CPABORT('Cannot find the molecule number') @@ -522,15 +522,15 @@ SUBROUTINE mc_molecule_translation(mc_par, force_env, bias_env, moves, & ENDIF ! record the attempt - moves%trans%attempts = moves%trans%attempts+1 - move_updates%trans%attempts = move_updates%trans%attempts+1 - moves%bias_trans%attempts = moves%bias_trans%attempts+1 - move_updates%bias_trans%attempts = move_updates%bias_trans%attempts+1 + moves%trans%attempts = moves%trans%attempts + 1 + move_updates%trans%attempts = move_updates%trans%attempts + 1 + moves%bias_trans%attempts = moves%bias_trans%attempts + 1 + move_updates%bias_trans%attempts = move_updates%bias_trans%attempts + 1 IF (.NOT. lbias) THEN - moves%trans%qsuccesses = moves%trans%qsuccesses+1 - move_updates%trans%qsuccesses = move_updates%trans%qsuccesses+1 - moves%bias_trans%qsuccesses = moves%bias_trans%qsuccesses+1 - move_updates%bias_trans%qsuccesses = move_updates%bias_trans%qsuccesses+1 + moves%trans%qsuccesses = moves%trans%qsuccesses + 1 + move_updates%trans%qsuccesses = move_updates%trans%qsuccesses + 1 + moves%bias_trans%qsuccesses = moves%bias_trans%qsuccesses + 1 + move_updates%bias_trans%qsuccesses = move_updates%bias_trans%qsuccesses + 1 ENDIF ! move one molecule in the system @@ -539,17 +539,17 @@ SUBROUTINE mc_molecule_translation(mc_par, force_env, bias_env, moves, & IF (ionode) rand = next_random_number(rng_stream) CALL mp_bcast(rand, source, group) ! 1,2,3 with equal prob - move_direction = INT(3*rand)+1 + move_direction = INT(3*rand) + 1 ! call a random number to figure out how far we're moving IF (ionode) rand = next_random_number(rng_stream) CALL mp_bcast(rand, source, group) - dis_mol = rmtrans(molecule_type)*(rand-0.5E0_dp)*2.0E0_dp + dis_mol = rmtrans(molecule_type)*(rand - 0.5E0_dp)*2.0E0_dp ! do the move DO iparticle = start_atom, end_atom particles%els(iparticle)%r(move_direction) = & - particles%els(iparticle)%r(move_direction)+dis_mol + particles%els(iparticle)%r(move_direction) + dis_mol ENDDO CALL cp_subsys_set(subsys, particles=particles) @@ -577,7 +577,7 @@ SUBROUTINE mc_molecule_translation(mc_par, force_env, bias_env, moves, & CALL force_env_get(bias_env, & potential_energy=bias_energy_new) ! accept or reject the move based on the Metropolis rule - value = -BETA*(bias_energy_new-bias_energy_old) + value = -BETA*(bias_energy_new - bias_energy_old) IF (value .GT. exp_max_val) THEN w = 10.0_dp ELSEIF (value .LT. exp_min_val) THEN @@ -599,13 +599,13 @@ SUBROUTINE mc_molecule_translation(mc_par, force_env, bias_env, moves, & IF (rand .LT. w) THEN ! accept the move - moves%bias_trans%successes = moves%bias_trans%successes+1 - move_updates%bias_trans%successes = move_updates%bias_trans%successes+1 - moves%trans%qsuccesses = moves%trans%qsuccesses+1 + moves%bias_trans%successes = moves%bias_trans%successes + 1 + move_updates%bias_trans%successes = move_updates%bias_trans%successes + 1 + moves%trans%qsuccesses = moves%trans%qsuccesses + 1 move_updates%trans%successes = & - move_updates%trans%successes+1 - moves%qtrans_dis = moves%qtrans_dis+ABS(dis_mol) - bias_energy = bias_energy+bias_energy_new- & + move_updates%trans%successes + 1 + moves%qtrans_dis = moves%qtrans_dis + ABS(dis_mol) + bias_energy = bias_energy + bias_energy_new - & bias_energy_old ELSE @@ -700,10 +700,10 @@ SUBROUTINE mc_molecule_rotation(mc_par, force_env, bias_env, moves, & ! figure out some bounds for mol_type start_mol = 1 - DO jbox = 1, box_number-1 - start_mol = start_mol+SUM(nchains(:, jbox)) + DO jbox = 1, box_number - 1 + start_mol = start_mol + SUM(nchains(:, jbox)) ENDDO - end_mol = start_mol+SUM(nchains(:, box_number))-1 + end_mol = start_mol + SUM(nchains(:, box_number)) - 1 nunits_mol = nunits(molecule_type) @@ -719,7 +719,7 @@ SUBROUTINE mc_molecule_rotation(mc_par, force_env, bias_env, moves, & ! determine what the final atom in the molecule is numbered, and which ! molecule number this is - end_atom = start_atom+nunits_mol-1 + end_atom = start_atom + nunits_mol - 1 molecule_number = 0 atom_number = 1 DO imolecule = 1, SUM(nchains(:, box_number)) @@ -727,7 +727,7 @@ SUBROUTINE mc_molecule_rotation(mc_par, force_env, bias_env, moves, & molecule_number = imolecule EXIT ENDIF - atom_number = atom_number+nunits(mol_type(imolecule+start_mol-1)) + atom_number = atom_number + nunits(mol_type(imolecule + start_mol - 1)) ENDDO IF (molecule_number == 0) CPABORT('Cannot find the molecule number') @@ -757,15 +757,15 @@ SUBROUTINE mc_molecule_rotation(mc_par, force_env, bias_env, moves, & masstot = SUM(mass(1:nunits(molecule_type), molecule_type)) ! record the attempt - moves%bias_rot%attempts = moves%bias_rot%attempts+1 - move_updates%bias_rot%attempts = move_updates%bias_rot%attempts+1 - moves%rot%attempts = moves%rot%attempts+1 - move_updates%rot%attempts = move_updates%rot%attempts+1 + moves%bias_rot%attempts = moves%bias_rot%attempts + 1 + move_updates%bias_rot%attempts = move_updates%bias_rot%attempts + 1 + moves%rot%attempts = moves%rot%attempts + 1 + move_updates%rot%attempts = move_updates%rot%attempts + 1 IF (.NOT. lbias) THEN - moves%rot%qsuccesses = moves%rot%qsuccesses+1 - move_updates%rot%qsuccesses = move_updates%rot%qsuccesses+1 - moves%bias_rot%qsuccesses = moves%bias_rot%qsuccesses+1 - move_updates%bias_rot%qsuccesses = move_updates%bias_rot%qsuccesses+1 + moves%rot%qsuccesses = moves%rot%qsuccesses + 1 + move_updates%rot%qsuccesses = move_updates%rot%qsuccesses + 1 + moves%bias_rot%qsuccesses = moves%bias_rot%qsuccesses + 1 + move_updates%bias_rot%qsuccesses = move_updates%bias_rot%qsuccesses + 1 ENDIF ! rotate one molecule in the system @@ -775,7 +775,7 @@ SUBROUTINE mc_molecule_rotation(mc_par, force_env, bias_env, moves, & ! CALL RANDOM_NUMBER(rand) CALL mp_bcast(rand, source, group) ! 1,2,3 with equal prob - dir = INT(3*rand)+1 + dir = INT(3*rand) + 1 IF (dir .EQ. 1) THEN lx = .TRUE. @@ -789,9 +789,9 @@ SUBROUTINE mc_molecule_rotation(mc_par, force_env, bias_env, moves, & nycm = 0.0E0_dp nzcm = 0.0E0_dp DO ii = 1, nunits_mol - nxcm = nxcm+particles%els(start_atom-1+ii)%r(1)*mass(ii, molecule_type) - nycm = nycm+particles%els(start_atom-1+ii)%r(2)*mass(ii, molecule_type) - nzcm = nzcm+particles%els(start_atom-1+ii)%r(3)*mass(ii, molecule_type) + nxcm = nxcm + particles%els(start_atom - 1 + ii)%r(1)*mass(ii, molecule_type) + nycm = nycm + particles%els(start_atom - 1 + ii)%r(2)*mass(ii, molecule_type) + nzcm = nzcm + particles%els(start_atom - 1 + ii)%r(3)*mass(ii, molecule_type) ENDDO nxcm = nxcm/masstot nycm = nycm/masstot @@ -800,7 +800,7 @@ SUBROUTINE mc_molecule_rotation(mc_par, force_env, bias_env, moves, & ! call a random number to figure out how far we're moving IF (ionode) rand = next_random_number(rng_stream) CALL mp_bcast(rand, source, group) - dgamma = rmrot(molecule_type)*(rand-0.5E0_dp)*2.0E0_dp + dgamma = rmrot(molecule_type)*(rand - 0.5E0_dp)*2.0E0_dp ! *** set up the rotation matrix *** @@ -812,13 +812,13 @@ SUBROUTINE mc_molecule_rotation(mc_par, force_env, bias_env, moves, & ! *** ROTATE UNITS OF I AROUND X-AXIS *** DO iunit = start_atom, end_atom - ry = particles%els(iunit)%r(2)-nycm - rz = particles%els(iunit)%r(3)-nzcm - rynew = cosdg*ry-sindg*rz - rznew = cosdg*rz+sindg*ry + ry = particles%els(iunit)%r(2) - nycm + rz = particles%els(iunit)%r(3) - nzcm + rynew = cosdg*ry - sindg*rz + rznew = cosdg*rz + sindg*ry - particles%els(iunit)%r(2) = rynew+nycm - particles%els(iunit)%r(3) = rznew+nzcm + particles%els(iunit)%r(2) = rynew + nycm + particles%els(iunit)%r(3) = rznew + nzcm ENDDO ELSEIF (ly) THEN @@ -826,13 +826,13 @@ SUBROUTINE mc_molecule_rotation(mc_par, force_env, bias_env, moves, & ! *** ROTATE UNITS OF I AROUND y-AXIS *** DO iunit = start_atom, end_atom - rx = particles%els(iunit)%r(1)-nxcm - rz = particles%els(iunit)%r(3)-nzcm - rxnew = cosdg*rx+sindg*rz - rznew = cosdg*rz-sindg*rx + rx = particles%els(iunit)%r(1) - nxcm + rz = particles%els(iunit)%r(3) - nzcm + rxnew = cosdg*rx + sindg*rz + rznew = cosdg*rz - sindg*rx - particles%els(iunit)%r(1) = rxnew+nxcm - particles%els(iunit)%r(3) = rznew+nzcm + particles%els(iunit)%r(1) = rxnew + nxcm + particles%els(iunit)%r(3) = rznew + nzcm ENDDO @@ -841,14 +841,14 @@ SUBROUTINE mc_molecule_rotation(mc_par, force_env, bias_env, moves, & ! *** ROTATE UNITS OF I AROUND z-AXIS *** DO iunit = start_atom, end_atom - rx = particles%els(iunit)%r(1)-nxcm - ry = particles%els(iunit)%r(2)-nycm + rx = particles%els(iunit)%r(1) - nxcm + ry = particles%els(iunit)%r(2) - nycm - rxnew = cosdg*rx-sindg*ry - rynew = cosdg*ry+sindg*rx + rxnew = cosdg*rx - sindg*ry + rynew = cosdg*ry + sindg*rx - particles%els(iunit)%r(1) = rxnew+nxcm - particles%els(iunit)%r(2) = rynew+nycm + particles%els(iunit)%r(1) = rxnew + nxcm + particles%els(iunit)%r(2) = rynew + nycm ENDDO @@ -880,7 +880,7 @@ SUBROUTINE mc_molecule_rotation(mc_par, force_env, bias_env, moves, & CALL force_env_get(bias_env, & potential_energy=bias_energy_new) ! accept or reject the move based on the Metropolis rule - value = -BETA*(bias_energy_new-bias_energy_old) + value = -BETA*(bias_energy_new - bias_energy_old) IF (value .GT. exp_max_val) THEN w = 10.0_dp ELSEIF (value .LT. exp_min_val) THEN @@ -902,11 +902,11 @@ SUBROUTINE mc_molecule_rotation(mc_par, force_env, bias_env, moves, & IF (rand .LT. w) THEN ! accept the move - moves%bias_rot%successes = moves%bias_rot%successes+1 - move_updates%bias_rot%successes = move_updates%bias_rot%successes+1 - moves%rot%qsuccesses = moves%rot%qsuccesses+1 - move_updates%rot%successes = move_updates%rot%successes+1 - bias_energy = bias_energy+bias_energy_new- & + moves%bias_rot%successes = moves%bias_rot%successes + 1 + move_updates%bias_rot%successes = move_updates%bias_rot%successes + 1 + moves%rot%qsuccesses = moves%rot%qsuccesses + 1 + move_updates%rot%successes = move_updates%rot%successes + 1 + bias_energy = bias_energy + bias_energy_new - & bias_energy_old ELSE @@ -1010,10 +1010,10 @@ SUBROUTINE mc_volume_move(mc_par, force_env, moves, move_updates, & mass=mass) ! figure out some bounds for mol_type start_mol = 1 - DO jbox = 1, box_number-1 - start_mol = start_mol+SUM(nchains(:, jbox)) + DO jbox = 1, box_number - 1 + start_mol = start_mol + SUM(nchains(:, jbox)) ENDDO - end_mol = start_mol+SUM(nchains(:, box_number))-1 + end_mol = start_mol + SUM(nchains(:, box_number)) - 1 print_level = 1 ! hack, printlevel is for print_keys @@ -1024,8 +1024,8 @@ SUBROUTINE mc_volume_move(mc_par, force_env, moves, move_updates, & ALLOCATE (r(1:3, 1:nunits_tot(box_number))) ! record the attempt - moves%volume%attempts = moves%volume%attempts+1 - move_updates%volume%attempts = move_updates%volume%attempts+1 + moves%volume%attempts = moves%volume%attempts + 1 + move_updates%volume%attempts = move_updates%volume%attempts + 1 ! now let's grab the cell length and particle positions CALL force_env_get(force_env, subsys=oldsys, cell=cell) @@ -1068,7 +1068,7 @@ SUBROUTINE mc_volume_move(mc_par, force_env, moves, move_updates, & iside_change = CEILING(3.0_dp*rand) IF (discrete_array(iside_change, 1) .EQ. 1) THEN new_cell_length(iside_change) = & - new_cell_length(iside_change)+discrete_step + new_cell_length(iside_change) + discrete_step EXIT ENDIF ENDDO @@ -1079,17 +1079,17 @@ SUBROUTINE mc_volume_move(mc_par, force_env, moves, move_updates, & iside_change = CEILING(3.0_dp*rand) IF (discrete_array(iside_change, 2) .EQ. 1) THEN new_cell_length(iside_change) = & - new_cell_length(iside_change)-discrete_step + new_cell_length(iside_change) - discrete_step EXIT ENDIF ENDDO ENDIF vol_dis = (new_cell_length(1)*new_cell_length(2)*new_cell_length(3)) & - -old_cell_length(1)*old_cell_length(2)*old_cell_length(3) + - old_cell_length(1)*old_cell_length(2)*old_cell_length(3) ELSE ! now for the not discrete volume move !!!!!!!!!!!!!!!! for E_V curves - vol_dis = rmvolume*(rand-0.5E0_dp)*2.0E0_dp + vol_dis = rmvolume*(rand - 0.5E0_dp)*2.0E0_dp ! WRITE(output_unit,*) '************************ be sure to change back!',& ! old_cell_length(1),14.64_dp/angstrom ! vol_dis=-56.423592_dp/angstrom**3 @@ -1098,7 +1098,7 @@ SUBROUTINE mc_volume_move(mc_par, force_env, moves, move_updates, & ! WRITE(output_unit,*) 'Found the correct box length!' ! ENDIF - temp_var = vol_dis+ & + temp_var = vol_dis + & old_cell_length(1)*old_cell_length(2)* & old_cell_length(3) @@ -1141,12 +1141,12 @@ SUBROUTINE mc_volume_move(mc_par, force_env, moves, move_updates, & ! center of mass end_atom = 0 DO imolecule = 1, SUM(nchains(:, box_number)) - nunits_mol = nunits(mol_type(imolecule+start_mol-1)) - start_atom = end_atom+1 - end_atom = start_atom+nunits_mol-1 + nunits_mol = nunits(mol_type(imolecule + start_mol - 1)) + start_atom = end_atom + 1 + end_atom = start_atom + nunits_mol - 1 ! now find the center of mass CALL get_center_of_mass(r(:, start_atom:end_atom), nunits_mol, & - center_of_mass(:), mass(:, mol_type(imolecule+start_mol-1))) + center_of_mass(:), mass(:, mol_type(imolecule + start_mol - 1))) ! scale the center of mass and determine the vector that points from the ! old COM to the new one @@ -1156,11 +1156,11 @@ SUBROUTINE mc_volume_move(mc_par, force_env, moves, move_updates, & ENDDO DO idim = 1, 3 - diff(idim) = center_of_mass_new(idim)-center_of_mass(idim) + diff(idim) = center_of_mass_new(idim) - center_of_mass(idim) ! now change the particle positions DO iunit = start_atom, end_atom particles_old%els(iunit)%r(idim) = & - particles_old%els(iunit)%r(idim)+diff(idim) + particles_old%els(iunit)%r(idim) + diff(idim) ENDDO ENDDO ENDDO @@ -1217,13 +1217,13 @@ SUBROUTINE mc_volume_move(mc_par, force_env, moves, move_updates, & ! accept or reject the move ! to prevent overflows - energy_term = new_energy-old_energy + energy_term = new_energy - old_energy volume_term = -REAL(SUM(nchains(:, box_number)), dp)/BETA* & LOG(new_cell_length(1)*new_cell_length(2)*new_cell_length(3)/ & (old_cell_length(1)*old_cell_length(2)*old_cell_length(3))) pressure_term = pressure*vol_dis - value = -BETA*(energy_term+volume_term+pressure_term) + value = -BETA*(energy_term + volume_term + pressure_term) IF (value .GT. exp_max_val) THEN w = 10.0_dp ELSEIF (value .LT. exp_min_val) THEN @@ -1247,11 +1247,11 @@ SUBROUTINE mc_volume_move(mc_par, force_env, moves, move_updates, & IF (rand .LT. w) THEN ! accept the move - moves%volume%successes = moves%volume%successes+1 - move_updates%volume%successes = move_updates%volume%successes+1 + moves%volume%successes = moves%volume%successes + 1 + move_updates%volume%successes = move_updates%volume%successes + 1 ! update energies - energy_check = energy_check+(new_energy-old_energy) + energy_check = energy_check + (new_energy - old_energy) old_energy = new_energy DO iatom = 1, nunits_tot(box_number) @@ -1371,10 +1371,10 @@ SUBROUTINE change_bond_length(r_old, r_new, mc_par, molecule_type, molecule_kind DO iatom = 1, natom DO ibond = 1, nbond IF (bond_list(ibond)%a == iatom) THEN - counter(iatom) = counter(iatom)+1 + counter(iatom) = counter(iatom) + 1 connectivity(counter(iatom), iatom) = bond_list(ibond)%b ELSEIF (bond_list(ibond)%b == iatom) THEN - counter(iatom) = counter(iatom)+1 + counter(iatom) = counter(iatom) + 1 connectivity(counter(iatom), iatom) = bond_list(ibond)%a ENDIF ENDDO @@ -1399,9 +1399,9 @@ SUBROUTINE change_bond_length(r_old, r_new, mc_par, molecule_type, molecule_kind CALL get_atomic_kind(particles%els(iatom)%atomic_kind, & mass=atom_mass) IF (atom_a(iatom) == 1) THEN - mass_a = mass_a+atom_mass + mass_a = mass_a + atom_mass ELSE - mass_b = mass_b+atom_mass + mass_b = mass_b + atom_mass ENDIF ENDDO @@ -1409,11 +1409,11 @@ SUBROUTINE change_bond_length(r_old, r_new, mc_par, molecule_type, molecule_kind IF (ionode) rand = next_random_number(rng_stream) CALL mp_bcast(rand, source, group) - dis_length = rmbond(molecule_type)*2.0E0_dp*(rand-0.5E0_dp) + dis_length = rmbond(molecule_type)*2.0E0_dp*(rand - 0.5E0_dp) ! find the bond vector that atom a will be moving DO i = 1, 3 - bond_a(i) = r_new(i, bond_list(bond_number)%a)- & + bond_a(i) = r_new(i, bond_list(bond_number)%a) - & r_new(i, bond_list(bond_number)%b) bond_b(i) = -bond_a(i) ENDDO @@ -1421,8 +1421,8 @@ SUBROUTINE change_bond_length(r_old, r_new, mc_par, molecule_type, molecule_kind ! notice we weight by the opposite masses...therefore lighter segments ! will move further old_length = SQRT(DOT_PRODUCT(bond_a, bond_a)) - new_length_a = dis_length*mass_b/(mass_a+mass_b) - new_length_b = dis_length*mass_a/(mass_a+mass_b) + new_length_a = dis_length*mass_b/(mass_a + mass_b) + new_length_b = dis_length*mass_a/(mass_a + mass_b) DO i = 1, 3 bond_a(i) = bond_a(i)/old_length*new_length_a @@ -1431,18 +1431,18 @@ SUBROUTINE change_bond_length(r_old, r_new, mc_par, molecule_type, molecule_kind DO iatom = 1, natom IF (atom_a(iatom) == 1) THEN - r_new(1, iatom) = r_new(1, iatom)+bond_a(1) - r_new(2, iatom) = r_new(2, iatom)+bond_a(2) - r_new(3, iatom) = r_new(3, iatom)+bond_a(3) + r_new(1, iatom) = r_new(1, iatom) + bond_a(1) + r_new(2, iatom) = r_new(2, iatom) + bond_a(2) + r_new(3, iatom) = r_new(3, iatom) + bond_a(3) ELSE - r_new(1, iatom) = r_new(1, iatom)+bond_b(1) - r_new(2, iatom) = r_new(2, iatom)+bond_b(2) - r_new(3, iatom) = r_new(3, iatom)+bond_b(3) + r_new(1, iatom) = r_new(1, iatom) + bond_b(1) + r_new(2, iatom) = r_new(2, iatom) + bond_b(2) + r_new(3, iatom) = r_new(3, iatom) + bond_b(3) ENDIF ENDDO ! correct the value of dis_length for the acceptance rule - dis_length = (old_length+dis_length)/old_length + dis_length = (old_length + dis_length)/old_length DEALLOCATE (connection) DEALLOCATE (connectivity) @@ -1541,10 +1541,10 @@ SUBROUTINE change_bond_angle(r_old, r_new, mc_par, molecule_type, molecule_kind, DO iatom = 1, natom DO ibond = 1, nbond IF (bond_list(ibond)%a == iatom) THEN - counter(iatom) = counter(iatom)+1 + counter(iatom) = counter(iatom) + 1 connectivity(counter(iatom), iatom) = bond_list(ibond)%b ELSEIF (bond_list(ibond)%b == iatom) THEN - counter(iatom) = counter(iatom)+1 + counter(iatom) = counter(iatom) + 1 connectivity(counter(iatom), iatom) = bond_list(ibond)%a ENDIF ENDDO @@ -1568,15 +1568,15 @@ SUBROUTINE change_bond_angle(r_old, r_new, mc_par, molecule_type, molecule_kind, DO iatom = 1, natom CALL get_atomic_kind(particles%els(iatom)%atomic_kind, & mass=atom_mass) - IF (atom_a(iatom) == 1) mass_a = mass_a+atom_mass - IF (atom_c(iatom) == 1) mass_c = mass_c+atom_mass + IF (atom_a(iatom) == 1) mass_a = mass_a + atom_mass + IF (atom_c(iatom) == 1) mass_c = mass_c + atom_mass ENDDO ! choose a displacement IF (ionode) rand = next_random_number(rng_stream) CALL mp_bcast(rand, source, group) - dis_angle = rmangle(molecule_type)*2.0E0_dp*(rand-0.5E0_dp) + dis_angle = rmangle(molecule_type)*2.0E0_dp*(rand - 0.5E0_dp) ! need to find the A-B-C bisector @@ -1586,9 +1586,9 @@ SUBROUTINE change_bond_angle(r_old, r_new, mc_par, molecule_type, molecule_kind, ! find the bond vectors DO i = 1, 3 - bond_a(i) = r_new(i, bend_list(bend_number)%a)- & + bond_a(i) = r_new(i, bend_list(bend_number)%a) - & r_new(i, bend_list(bend_number)%b) - bond_c(i) = r_new(i, bend_list(bend_number)%c)- & + bond_c(i) = r_new(i, bend_list(bend_number)%c) - & r_new(i, bend_list(bend_number)%b) ENDDO old_length_a = SQRT(DOT_PRODUCT(bond_a, bond_a)) @@ -1596,7 +1596,7 @@ SUBROUTINE change_bond_angle(r_old, r_new, mc_par, molecule_type, molecule_kind, old_angle = ACOS(DOT_PRODUCT(bond_a, bond_c)/(old_length_a*old_length_c)) DO i = 1, 3 - bisector(i) = bond_a(i)/old_length_a+ & ! not yet normalized + bisector(i) = bond_a(i)/old_length_a + & ! not yet normalized bond_c(i)/old_length_c ENDDO bis_length = SQRT(DOT_PRODUCT(bisector, bisector)) @@ -1604,15 +1604,15 @@ SUBROUTINE change_bond_angle(r_old, r_new, mc_par, molecule_type, molecule_kind, ! now we need to find the cross product of the B-A and B-C vectors and normalize ! it, so we have a vector that defines the bend plane - cross_prod(1) = bond_a(2)*bond_c(3)-bond_a(3)*bond_c(2) - cross_prod(2) = bond_a(3)*bond_c(1)-bond_a(1)*bond_c(3) - cross_prod(3) = bond_a(1)*bond_c(2)-bond_a(2)*bond_c(1) + cross_prod(1) = bond_a(2)*bond_c(3) - bond_a(3)*bond_c(2) + cross_prod(2) = bond_a(3)*bond_c(1) - bond_a(1)*bond_c(3) + cross_prod(3) = bond_a(1)*bond_c(2) - bond_a(2)*bond_c(1) cross_prod(1:3) = cross_prod(1:3)/SQRT(DOT_PRODUCT(cross_prod, cross_prod)) ! we have two axis of a coordinate system...let's get the third - cross_prod_plane(1) = cross_prod(2)*bisector(3)-cross_prod(3)*bisector(2) - cross_prod_plane(2) = cross_prod(3)*bisector(1)-cross_prod(1)*bisector(3) - cross_prod_plane(3) = cross_prod(1)*bisector(2)-cross_prod(2)*bisector(1) + cross_prod_plane(1) = cross_prod(2)*bisector(3) - cross_prod(3)*bisector(2) + cross_prod_plane(2) = cross_prod(3)*bisector(1) - cross_prod(1)*bisector(3) + cross_prod_plane(3) = cross_prod(1)*bisector(2) - cross_prod(2)*bisector(1) cross_prod_plane(1:3) = cross_prod_plane(1:3)/ & SQRT(DOT_PRODUCT(cross_prod_plane, cross_prod_plane)) @@ -1620,20 +1620,20 @@ SUBROUTINE change_bond_angle(r_old, r_new, mc_par, molecule_type, molecule_kind, ! and cross_prod is z ! shift the molecule so that atom b is at the origin DO iatom = 1, natom - r_new(1:3, iatom) = r_new(1:3, iatom)- & + r_new(1:3, iatom) = r_new(1:3, iatom) - & r_old(1:3, bend_list(bend_number)%b) ENDDO ! figure out how much we move each side, since we're mass-weighting, by the ! opposite masses, so lighter moves farther..this angle is the angle between ! the bond vector BA or BC and the bisector - dis_angle_a = dis_angle*mass_c/(mass_a+mass_c) - dis_angle_c = dis_angle*mass_a/(mass_a+mass_c) + dis_angle_a = dis_angle*mass_c/(mass_a + mass_c) + dis_angle_c = dis_angle*mass_a/(mass_a + mass_c) ! now loop through all the atoms, moving the ones that are connected to a or c DO iatom = 1, natom ! subtract out the z component (perpendicular to the angle plane) - temp(1:3) = r_new(1:3, iatom)- & + temp(1:3) = r_new(1:3, iatom) - & DOT_PRODUCT(cross_prod(1:3), r_new(1:3, iatom))* & cross_prod(1:3) temp_length = SQRT(DOT_PRODUCT(temp, temp)) @@ -1649,20 +1649,20 @@ SUBROUTINE change_bond_angle(r_old, r_new, mc_par, molecule_type, molecule_kind, ! need to figure out the current iatom-B-bisector angle, so we know what the new angle is new_angle_a = ACOS(DOT_PRODUCT(bisector, temp(1:3))/ & - (temp_length))+dis_angle_a + (temp_length)) + dis_angle_a - r_new(1:3, iatom) = COS(new_angle_a)*temp_length*bisector(1:3)- & - SIN(new_angle_a)*temp_length*cross_prod_plane(1:3)+ & + r_new(1:3, iatom) = COS(new_angle_a)*temp_length*bisector(1:3) - & + SIN(new_angle_a)*temp_length*cross_prod_plane(1:3) + & DOT_PRODUCT(cross_prod(1:3), r_new(1:3, iatom))* & cross_prod(1:3) ELSE ! need to figure out the current iatom-B-bisector angle, so we know what the new angle is new_angle_a = ACOS(DOT_PRODUCT(bisector, temp(1:3))/ & - (temp_length))-dis_angle_a + (temp_length)) - dis_angle_a - r_new(1:3, iatom) = COS(new_angle_a)*temp_length*bisector(1:3)+ & - SIN(new_angle_a)*temp_length*cross_prod_plane(1:3)+ & + r_new(1:3, iatom) = COS(new_angle_a)*temp_length*bisector(1:3) + & + SIN(new_angle_a)*temp_length*cross_prod_plane(1:3) + & DOT_PRODUCT(cross_prod(1:3), r_new(1:3, iatom))* & cross_prod(1:3) ENDIF @@ -1675,18 +1675,18 @@ SUBROUTINE change_bond_angle(r_old, r_new, mc_par, molecule_type, molecule_kind, .LT. 0.0_dp) THEN ! need to figure out the current iatom-B-bisector angle, so we know what the new angle is new_angle_c = ACOS(DOT_PRODUCT(bisector(1:3), temp(1:3))/ & - (temp_length))-dis_angle_c + (temp_length)) - dis_angle_c - r_new(1:3, iatom) = COS(new_angle_c)*temp_length*bisector(1:3)- & - SIN(new_angle_c)*temp_length*cross_prod_plane(1:3)+ & + r_new(1:3, iatom) = COS(new_angle_c)*temp_length*bisector(1:3) - & + SIN(new_angle_c)*temp_length*cross_prod_plane(1:3) + & DOT_PRODUCT(cross_prod(1:3), r_new(1:3, iatom))* & cross_prod(1:3) ELSE new_angle_c = ACOS(DOT_PRODUCT(bisector(1:3), temp(1:3))/ & - (temp_length))+dis_angle_c + (temp_length)) + dis_angle_c - r_new(1:3, iatom) = COS(new_angle_c)*temp_length*bisector(1:3)+ & - SIN(new_angle_c)*temp_length*cross_prod_plane(1:3)+ & + r_new(1:3, iatom) = COS(new_angle_c)*temp_length*bisector(1:3) + & + SIN(new_angle_c)*temp_length*cross_prod_plane(1:3) + & DOT_PRODUCT(cross_prod(1:3), r_new(1:3, iatom))* & cross_prod(1:3) ENDIF @@ -1695,7 +1695,7 @@ SUBROUTINE change_bond_angle(r_old, r_new, mc_par, molecule_type, molecule_kind, ENDDO DO iatom = 1, natom - r_new(1:3, iatom) = r_new(1:3, iatom)+ & + r_new(1:3, iatom) = r_new(1:3, iatom) + & r_old(1:3, bend_list(bend_number)%b) ENDDO @@ -1804,10 +1804,10 @@ SUBROUTINE change_dihedral(r_old, r_new, mc_par, molecule_type, molecule_kind, & DO iatom = 1, natom DO ibond = 1, nbond IF (bond_list(ibond)%a == iatom) THEN - counter(iatom) = counter(iatom)+1 + counter(iatom) = counter(iatom) + 1 connectivity(counter(iatom), iatom) = bond_list(ibond)%b ELSEIF (bond_list(ibond)%b == iatom) THEN - counter(iatom) = counter(iatom)+1 + counter(iatom) = counter(iatom) + 1 connectivity(counter(iatom), iatom) = bond_list(ibond)%a ENDIF ENDDO @@ -1832,19 +1832,19 @@ SUBROUTINE change_dihedral(r_old, r_new, mc_par, molecule_type, molecule_kind, & DO iatom = 1, natom CALL get_atomic_kind(particles%els(iatom)%atomic_kind, & mass=atom_mass) - IF (atom_a(iatom) == 1) mass_a = mass_a+atom_mass - IF (atom_d(iatom) == 1) mass_d = mass_d+atom_mass + IF (atom_a(iatom) == 1) mass_a = mass_a + atom_mass + IF (atom_d(iatom) == 1) mass_d = mass_d + atom_mass ENDDO ! choose a displacement IF (ionode) rand = next_random_number(rng_stream) CALL mp_bcast(rand, source, group) - dis_angle = rmdihedral(molecule_type)*2.0E0_dp*(rand-0.5E0_dp) + dis_angle = rmdihedral(molecule_type)*2.0E0_dp*(rand - 0.5E0_dp) ! find the bond vectors, B-C, so we know what to rotate around DO i = 1, 3 - bond_a(i) = r_new(i, torsion_list(torsion_number)%c)- & + bond_a(i) = r_new(i, torsion_list(torsion_number)%c) - & r_new(i, torsion_list(torsion_number)%b) ENDDO old_length_a = SQRT(DOT_PRODUCT(bond_a, bond_a)) @@ -1853,14 +1853,14 @@ SUBROUTINE change_dihedral(r_old, r_new, mc_par, molecule_type, molecule_kind, & ! figure out how much we move each side, since we're mass-weighting, by the ! opposite masses, so lighter moves farther...we take the opposite sign of d ! so we're not rotating both angles in the same direction - dis_angle_a = dis_angle*mass_d/(mass_a+mass_d) - dis_angle_d = -dis_angle*mass_a/(mass_a+mass_d) + dis_angle_a = dis_angle*mass_d/(mass_a + mass_d) + dis_angle_d = -dis_angle*mass_a/(mass_a + mass_d) DO iatom = 1, natom IF (atom_a(iatom) == 1) THEN ! shift the coords so b is at the origin - r_new(1:3, iatom) = r_new(1:3, iatom)- & + r_new(1:3, iatom) = r_new(1:3, iatom) - & r_new(1:3, torsion_list(torsion_number)%b) ! multiply by the rotation matrix @@ -1870,21 +1870,21 @@ SUBROUTINE change_dihedral(r_old, r_new, mc_par, molecule_type, molecule_kind, & x = r_new(1, iatom) y = r_new(2, iatom) z = r_new(3, iatom) - temp(1) = (u*(u*x+v*y+w*z)+(x*(v**2+w**2)-u*(v*y+w*z))*COS(dis_angle_a)+ & - SQRT(u**2+v**2+w**2)*(v*z-w*y)*SIN(dis_angle_a))/(u**2+v**2+w**2) - temp(2) = (v*(u*x+v*y+w*z)+(y*(u**2+w**2)-v*(u*x+w*z))*COS(dis_angle_a)+ & - SQRT(u**2+v**2+w**2)*(w*x-u*z)*SIN(dis_angle_a))/(u**2+v**2+w**2) - temp(3) = (w*(u*x+v*y+w*z)+(z*(v**2+u**2)-w*(u*x+v*y))*COS(dis_angle_a)+ & - SQRT(u**2+v**2+w**2)*(u*y-v*x)*SIN(dis_angle_a))/(u**2+v**2+w**2) + temp(1) = (u*(u*x + v*y + w*z) + (x*(v**2 + w**2) - u*(v*y + w*z))*COS(dis_angle_a) + & + SQRT(u**2 + v**2 + w**2)*(v*z - w*y)*SIN(dis_angle_a))/(u**2 + v**2 + w**2) + temp(2) = (v*(u*x + v*y + w*z) + (y*(u**2 + w**2) - v*(u*x + w*z))*COS(dis_angle_a) + & + SQRT(u**2 + v**2 + w**2)*(w*x - u*z)*SIN(dis_angle_a))/(u**2 + v**2 + w**2) + temp(3) = (w*(u*x + v*y + w*z) + (z*(v**2 + u**2) - w*(u*x + v*y))*COS(dis_angle_a) + & + SQRT(u**2 + v**2 + w**2)*(u*y - v*x)*SIN(dis_angle_a))/(u**2 + v**2 + w**2) ! shift back to the original position - temp(1:3) = temp(1:3)+r_new(1:3, torsion_list(torsion_number)%b) + temp(1:3) = temp(1:3) + r_new(1:3, torsion_list(torsion_number)%b) r_new(1:3, iatom) = temp(1:3) ELSEIF (atom_d(iatom) == 1) THEN ! shift the coords so c is at the origin - r_new(1:3, iatom) = r_new(1:3, iatom)- & + r_new(1:3, iatom) = r_new(1:3, iatom) - & r_new(1:3, torsion_list(torsion_number)%c) ! multiply by the rotation matrix @@ -1894,15 +1894,15 @@ SUBROUTINE change_dihedral(r_old, r_new, mc_par, molecule_type, molecule_kind, & x = r_new(1, iatom) y = r_new(2, iatom) z = r_new(3, iatom) - temp(1) = (u*(u*x+v*y+w*z)+(x*(v**2+w**2)-u*(v*y+w*z))*COS(dis_angle_d)+ & - SQRT(u**2+v**2+w**2)*(v*z-w*y)*SIN(dis_angle_d))/(u**2+v**2+w**2) - temp(2) = (v*(u*x+v*y+w*z)+(y*(u**2+w**2)-v*(u*x+w*z))*COS(dis_angle_d)+ & - SQRT(u**2+v**2+w**2)*(w*x-u*z)*SIN(dis_angle_d))/(u**2+v**2+w**2) - temp(3) = (w*(u*x+v*y+w*z)+(z*(v**2+u**2)-w*(u*x+v*y))*COS(dis_angle_d)+ & - SQRT(u**2+v**2+w**2)*(u*y-v*x)*SIN(dis_angle_d))/(u**2+v**2+w**2) + temp(1) = (u*(u*x + v*y + w*z) + (x*(v**2 + w**2) - u*(v*y + w*z))*COS(dis_angle_d) + & + SQRT(u**2 + v**2 + w**2)*(v*z - w*y)*SIN(dis_angle_d))/(u**2 + v**2 + w**2) + temp(2) = (v*(u*x + v*y + w*z) + (y*(u**2 + w**2) - v*(u*x + w*z))*COS(dis_angle_d) + & + SQRT(u**2 + v**2 + w**2)*(w*x - u*z)*SIN(dis_angle_d))/(u**2 + v**2 + w**2) + temp(3) = (w*(u*x + v*y + w*z) + (z*(v**2 + u**2) - w*(u*x + v*y))*COS(dis_angle_d) + & + SQRT(u**2 + v**2 + w**2)*(u*y - v*x)*SIN(dis_angle_d))/(u**2 + v**2 + w**2) ! shift back to the original position - temp(1:3) = temp(1:3)+r_new(1:3, torsion_list(torsion_number)%c) + temp(1:3) = temp(1:3) + r_new(1:3, torsion_list(torsion_number)%c) r_new(1:3, iatom) = temp(1:3) ENDIF ENDDO @@ -1998,10 +1998,10 @@ SUBROUTINE mc_avbmc_move(mc_par, force_env, bias_env, moves, & mass=mass, nunits=nunits, nunits_tot=nunits_tot, mol_type=mol_type) ! figure out some bounds for mol_type start_mol = 1 - DO jbox = 1, box_number-1 - start_mol = start_mol+SUM(nchains(:, jbox)) + DO jbox = 1, box_number - 1 + start_mol = start_mol + SUM(nchains(:, jbox)) ENDDO - end_mol = start_mol+SUM(nchains(:, box_number))-1 + end_mol = start_mol + SUM(nchains(:, box_number)) - 1 ! nullify some pointers NULLIFY (particles, subsys, molecule_kinds, molecule_kind, & @@ -2039,19 +2039,19 @@ SUBROUTINE mc_avbmc_move(mc_par, force_env, bias_env, moves, & ! let's determine if the molecule to be moved is in the "in" region or the ! "out" region of the target - RIJ(1) = particles%els(start_atom_swap+avbmc_atom(molecule_type)-1)%r(1)- & - particles%els(target_atom)%r(1)-abc(1)*ANINT( & - (particles%els(start_atom_swap+avbmc_atom(molecule_type)-1)%r(1)- & + RIJ(1) = particles%els(start_atom_swap + avbmc_atom(molecule_type) - 1)%r(1) - & + particles%els(target_atom)%r(1) - abc(1)*ANINT( & + (particles%els(start_atom_swap + avbmc_atom(molecule_type) - 1)%r(1) - & particles%els(target_atom)%r(1))/abc(1)) - RIJ(2) = particles%els(start_atom_swap+avbmc_atom(molecule_type)-1)%r(2)- & - particles%els(target_atom)%r(2)-abc(2)*ANINT( & - (particles%els(start_atom_swap+avbmc_atom(molecule_type)-1)%r(2)- & + RIJ(2) = particles%els(start_atom_swap + avbmc_atom(molecule_type) - 1)%r(2) - & + particles%els(target_atom)%r(2) - abc(2)*ANINT( & + (particles%els(start_atom_swap + avbmc_atom(molecule_type) - 1)%r(2) - & particles%els(target_atom)%r(2))/abc(2)) - RIJ(3) = particles%els(start_atom_swap+avbmc_atom(molecule_type)-1)%r(3)- & - particles%els(target_atom)%r(3)-abc(3)*ANINT( & - (particles%els(start_atom_swap+avbmc_atom(molecule_type)-1)%r(3)- & + RIJ(3) = particles%els(start_atom_swap + avbmc_atom(molecule_type) - 1)%r(3) - & + particles%els(target_atom)%r(3) - abc(3)*ANINT( & + (particles%els(start_atom_swap + avbmc_atom(molecule_type) - 1)%r(3) - & particles%els(target_atom)%r(3))/abc(3)) - distance = SQRT(RIJ(1)**2+RIJ(2)**2+RIJ(3)**2) + distance = SQRT(RIJ(1)**2 + RIJ(2)**2 + RIJ(3)**2) IF (distance .LE. avbmc_rmax(molecule_type) .AND. distance .GE. avbmc_rmin(molecule_type)) THEN lin = .TRUE. ELSE @@ -2063,18 +2063,18 @@ SUBROUTINE mc_avbmc_move(mc_par, force_env, bias_env, moves, & IF (lin) THEN IF (move_type == 'in') THEN moves%avbmc_inin%attempts = & - moves%avbmc_inin%attempts+1 + moves%avbmc_inin%attempts + 1 ELSE moves%avbmc_inout%attempts = & - moves%avbmc_inout%attempts+1 + moves%avbmc_inout%attempts + 1 ENDIF ELSE IF (move_type == 'in') THEN moves%avbmc_outin%attempts = & - moves%avbmc_outin%attempts+1 + moves%avbmc_outin%attempts + 1 ELSE moves%avbmc_outout%attempts = & - moves%avbmc_outout%attempts+1 + moves%avbmc_outout%attempts + 1 ENDIF ENDIF @@ -2123,7 +2123,7 @@ SUBROUTINE mc_avbmc_move(mc_par, force_env, bias_env, moves, & ! the real energy for the acceptance rule...we don't do this for the ! lbias=.false. case because it doesn't appear in the acceptance rule, and ! we compensate in case of acceptance - bias_energy_new = bias_energy_new+bias_energy_old + bias_energy_new = bias_energy_new + bias_energy_old ELSE @@ -2207,25 +2207,25 @@ SUBROUTINE mc_avbmc_move(mc_par, force_env, bias_env, moves, & ENDIF - volume_in = 4.0_dp/3.0_dp*pi*(avbmc_rmax(molecule_type)**3-avbmc_rmin(molecule_type)**3) - volume_out = abc(1)*abc(2)*abc(3)-volume_in + volume_in = 4.0_dp/3.0_dp*pi*(avbmc_rmax(molecule_type)**3 - avbmc_rmin(molecule_type)**3) + volume_out = abc(1)*abc(2)*abc(3) - volume_in IF (lin .AND. move_type == 'in' .OR. & .NOT. lin .AND. move_type == 'out') THEN ! standard Metropolis rule prefactor = 1.0_dp ELSEIF (.NOT. lin .AND. move_type == 'in') THEN - prefactor = (1.0_dp-pbias(molecule_type))*volume_in/(pbias(molecule_type)*volume_out) + prefactor = (1.0_dp - pbias(molecule_type))*volume_in/(pbias(molecule_type)*volume_out) ELSE - prefactor = pbias(molecule_type)*volume_out/((1.0_dp-pbias(molecule_type))*volume_in) + prefactor = pbias(molecule_type)*volume_out/((1.0_dp - pbias(molecule_type))*volume_in) ENDIF IF (lbias) THEN ! AVBMC with CBMC and a biasing potential...notice that if the biasing ! potential equals the quickstep potential, this cancels out to the ! acceptance below - del_quickstep_energy = (-BETA)*(new_energy-old_energy- & - (bias_energy_new-bias_energy_old)) + del_quickstep_energy = (-BETA)*(new_energy - old_energy - & + (bias_energy_new - bias_energy_old)) IF (del_quickstep_energy .GT. exp_max_val) THEN del_quickstep_energy = max_val @@ -2258,29 +2258,29 @@ SUBROUTINE mc_avbmc_move(mc_par, force_env, bias_env, moves, & IF (lin) THEN IF (move_type == 'in') THEN moves%avbmc_inin%successes = & - moves%avbmc_inin%successes+1 + moves%avbmc_inin%successes + 1 ELSE moves%avbmc_inout%successes = & - moves%avbmc_inout%successes+1 + moves%avbmc_inout%successes + 1 ENDIF ELSE IF (move_type == 'in') THEN moves%avbmc_outin%successes = & - moves%avbmc_outin%successes+1 + moves%avbmc_outin%successes + 1 ELSE moves%avbmc_outout%successes = & - moves%avbmc_outout%successes+1 + moves%avbmc_outout%successes + 1 ENDIF ENDIF ! we need to compensate for the fact that we take the difference in ! generate_cbmc_config to keep the exponetials small IF (.NOT. lbias) THEN - new_energy = new_energy+old_energy + new_energy = new_energy + old_energy ENDIF ! update energies - energy_check = energy_check+(new_energy-old_energy) + energy_check = energy_check + (new_energy - old_energy) old_energy = new_energy ! if we're biasing the update the biasing energy @@ -2389,8 +2389,8 @@ SUBROUTINE mc_hmc_move(mc_par, force_env, globenv, moves, move_updates, & ALLOCATE (hmc_ekin) ! record the attempt - moves%hmc%attempts = moves%hmc%attempts+1 - move_updates%hmc%attempts = move_updates%hmc%attempts+1 + moves%hmc%attempts = moves%hmc%attempts + 1 + move_updates%hmc%attempts = move_updates%hmc%attempts + 1 ! now let's grab the particle positions CALL force_env_get(force_env, subsys=oldsys) @@ -2410,7 +2410,7 @@ SUBROUTINE mc_hmc_move(mc_par, force_env, globenv, moves, move_updates, & ! accept or reject the move ! to prevent overflows - energy_term = new_energy+hmc_ekin%final_ekin-old_energy-hmc_ekin%initial_ekin + energy_term = new_energy + hmc_ekin%final_ekin - old_energy - hmc_ekin%initial_ekin value = -BETA*(energy_term) IF (value .GT. exp_max_val) THEN @@ -2432,11 +2432,11 @@ SUBROUTINE mc_hmc_move(mc_par, force_env, globenv, moves, move_updates, & IF (rand .LT. w) THEN ! accept the move - moves%hmc%successes = moves%hmc%successes+1 - move_updates%hmc%successes = move_updates%hmc%successes+1 + moves%hmc%successes = moves%hmc%successes + 1 + move_updates%hmc%successes = move_updates%hmc%successes + 1 ! update energies - energy_check = energy_check+(new_energy-old_energy) + energy_check = energy_check + (new_energy - old_energy) old_energy = new_energy DO iatom = 1, nunits_tot(box_number) @@ -2527,10 +2527,10 @@ SUBROUTINE mc_cluster_translation(mc_par, force_env, bias_env, moves, & ! find out some bounds for mol_type start_mol = 1 - DO jbox = 1, box_number-1 - start_mol = start_mol+SUM(nchains(:, jbox)) + DO jbox = 1, box_number - 1 + start_mol = start_mol + SUM(nchains(:, jbox)) ENDDO - end_mol = start_mol+SUM(nchains(:, box_number))-1 + end_mol = start_mol + SUM(nchains(:, box_number)) - 1 ! do some allocation ALLOCATE (r_old(1:3, 1:nunits_tot(box_number))) @@ -2574,31 +2574,31 @@ SUBROUTINE mc_cluster_translation(mc_par, force_env, bias_env, moves, & ENDIF ! record the attempt - moves%cltrans%attempts = moves%cltrans%attempts+1 - move_updates%cltrans%attempts = move_updates%cltrans%attempts+1 - moves%bias_cltrans%attempts = moves%bias_cltrans%attempts+1 - move_updates%bias_cltrans%attempts = move_updates%bias_cltrans%attempts+1 + moves%cltrans%attempts = moves%cltrans%attempts + 1 + move_updates%cltrans%attempts = move_updates%cltrans%attempts + 1 + moves%bias_cltrans%attempts = moves%bias_cltrans%attempts + 1 + move_updates%bias_cltrans%attempts = move_updates%bias_cltrans%attempts + 1 IF (.NOT. lbias) THEN - moves%cltrans%qsuccesses = moves%cltrans%qsuccesses+1 - move_updates%cltrans%qsuccesses = move_updates%cltrans%qsuccesses+1 - moves%bias_cltrans%qsuccesses = moves%bias_cltrans%qsuccesses+1 - move_updates%bias_cltrans%qsuccesses = move_updates%bias_cltrans%qsuccesses+1 + moves%cltrans%qsuccesses = moves%cltrans%qsuccesses + 1 + move_updates%cltrans%qsuccesses = move_updates%cltrans%qsuccesses + 1 + moves%bias_cltrans%qsuccesses = moves%bias_cltrans%qsuccesses + 1 + move_updates%bias_cltrans%qsuccesses = move_updates%bias_cltrans%qsuccesses + 1 ENDIF ! call a random number to figure out which direction we're moving IF (ionode) rand = next_random_number(rng_stream) CALL mp_bcast(rand, source, group) - move_direction = INT(3*rand)+1 + move_direction = INT(3*rand) + 1 ! call a random number to figure out how far we're moving IF (ionode) rand = next_random_number(rng_stream) CALL mp_bcast(rand, source, group) - dis_mol = rmcltrans*(rand-0.5E0_dp)*2.0E0_dp + dis_mol = rmcltrans*(rand - 0.5E0_dp)*2.0E0_dp ! choosing cluster IF (ionode) rand = next_random_number(rng_stream) CALL mp_bcast(rand, source, group) - jpart = INT(1+rand*total_clus) + jpart = INT(1 + rand*total_clus) ! do the cluster move DO cstart = 1, nend @@ -2606,15 +2606,15 @@ SUBROUTINE mc_cluster_translation(mc_par, force_env, bias_env, moves, & IF (cluster(jpart, cstart) .NE. 0) THEN imol = cluster(jpart, cstart) iunit = 1 - DO ipart = 1, imol-1 - nunit = nunits(mol_type(ipart+start_mol-1)) - iunit = iunit+nunit + DO ipart = 1, imol - 1 + nunit = nunits(mol_type(ipart + start_mol - 1)) + iunit = iunit + nunit END DO - nunit = nunits(mol_type(imol+start_mol-1)) - junit = iunit+nunit-1 + nunit = nunits(mol_type(imol + start_mol - 1)) + junit = iunit + nunit - 1 DO iparticle = iunit, junit particles%els(iparticle)%r(move_direction) = & - particles%els(iparticle)%r(move_direction)+dis_mol + particles%els(iparticle)%r(move_direction) + dis_mol ENDDO END IF END DO @@ -2670,7 +2670,7 @@ SUBROUTINE mc_cluster_translation(mc_par, force_env, bias_env, moves, & CALL force_env_get(bias_env, & potential_energy=bias_energy_new) ! accept or reject the move based on the Metropolis rule - value = -BETA*(bias_energy_new-bias_energy_old) + value = -BETA*(bias_energy_new - bias_energy_old) IF (value .GT. exp_max_val) THEN w = 10.0_dp ELSEIF (value .LT. exp_min_val) THEN @@ -2691,13 +2691,13 @@ SUBROUTINE mc_cluster_translation(mc_par, force_env, bias_env, moves, & IF (rand .LT. w) THEN ! accept the move - moves%bias_cltrans%successes = moves%bias_cltrans%successes+1 - move_updates%bias_cltrans%successes = move_updates%bias_cltrans%successes+1 - moves%cltrans%qsuccesses = moves%cltrans%qsuccesses+1 + moves%bias_cltrans%successes = moves%bias_cltrans%successes + 1 + move_updates%bias_cltrans%successes = move_updates%bias_cltrans%successes + 1 + moves%cltrans%qsuccesses = moves%cltrans%qsuccesses + 1 move_updates%cltrans%successes = & - move_updates%cltrans%successes+1 - moves%qcltrans_dis = moves%qcltrans_dis+ABS(dis_mol) - bias_energy = bias_energy+bias_energy_new- & + move_updates%cltrans%successes + 1 + moves%qcltrans_dis = moves%qcltrans_dis + ABS(dis_mol) + bias_energy = bias_energy + bias_energy_new - & bias_energy_old ELSE diff --git a/src/motion/mc/mc_types.F b/src/motion/mc/mc_types.F index 2447345965..191f162b4e 100644 --- a/src/motion/mc/mc_types.F +++ b/src/motion/mc/mc_types.F @@ -973,7 +973,7 @@ SUBROUTINE mc_input_file_create(mc_input_file, input_file_name, & DO READ (unit, '(A)', IOSTAT=io_stat) line IF (io_stat .NE. 0) EXIT - nlines = nlines+1 + nlines = nlines + 1 ENDDO ALLOCATE (mc_input_file%text(1:nlines)) @@ -1031,7 +1031,7 @@ SUBROUTINE mc_input_file_create(mc_input_file, input_file_name, & ! now the RUN_TYPE CALL mc_parse_text(mc_input_file%text, 1, nlines, "RUN_TYPE", .FALSE., & mc_input_file%run_type_row, mc_input_file%run_type_column) - mc_input_file%run_type_column = mc_input_file%run_type_column+9 + mc_input_file%run_type_column = mc_input_file%run_type_column + 9 IF (mc_input_file%run_type_row == 0) THEN IF (iw > 0) THEN WRITE (iw, *) @@ -1046,17 +1046,17 @@ SUBROUTINE mc_input_file_create(mc_input_file, input_file_name, & CALL mc_parse_text(mc_input_file%text, 1, nlines, "&CELL", .FALSE., & mc_input_file%cell_row, mc_input_file%cell_column) ! now find the ABC input line after CELL - CALL mc_parse_text(mc_input_file%text, mc_input_file%cell_row+1, nlines, & + CALL mc_parse_text(mc_input_file%text, mc_input_file%cell_row + 1, nlines, & "ABC", .FALSE., abc_row, abc_column) ! is there a &CELL inbetween? If so, that ABC will be for the ref_cell ! and we need to find the next one - CALL mc_parse_text(mc_input_file%text, mc_input_file%cell_row+1, abc_row, & + CALL mc_parse_text(mc_input_file%text, mc_input_file%cell_row + 1, abc_row, & "&CELL", .FALSE., cell_row, cell_column) IF (cell_row == 0) THEN ! nothing in between...we found the correct ABC mc_input_file%cell_row = abc_row - mc_input_file%cell_column = abc_column+4 + mc_input_file%cell_column = abc_column + 4 ELSE - CALL mc_parse_text(mc_input_file%text, abc_row+1, nlines, & + CALL mc_parse_text(mc_input_file%text, abc_row + 1, nlines, & "ABC", .FALSE., mc_input_file%cell_row, mc_input_file%cell_column) ENDIF IF (mc_input_file%cell_row == 0) THEN @@ -1076,12 +1076,12 @@ SUBROUTINE mc_input_file_create(mc_input_file, input_file_name, & CALL mc_parse_text(mc_input_file%text, nstart, nlines, "&MOLECULE", & .FALSE., row_number, idum) IF (row_number == 0) EXIT - nstart = row_number+1 - irep = irep+1 + nstart = row_number + 1 + irep = irep + 1 CALL mc_parse_text(mc_input_file%text, nstart, nlines, "NMOL", & .FALSE., mc_input_file%mol_set_nmol_row(irep), & mc_input_file%mol_set_nmol_column(irep)) - mc_input_file%mol_set_nmol_column(irep) = mc_input_file%mol_set_nmol_column(irep)+5 + mc_input_file%mol_set_nmol_column(irep) = mc_input_file%mol_set_nmol_column(irep) + 5 ENDDO IF (irep .NE. nmol_types) THEN @@ -1103,7 +1103,7 @@ SUBROUTINE mc_input_file_create(mc_input_file, input_file_name, & "METHOD", .FALSE., line_number, idum) READ (mc_input_file%text(line_number), *) cdum, method_name CALL uppercase(method_name) - SELECT CASE (TRIM (ADJUSTL (method_name))) + SELECT CASE (TRIM(ADJUSTL(method_name))) CASE ("FIST") mc_input_file%in_use = use_fist_force CASE ("QS", "QUICKSTEP") @@ -1181,7 +1181,7 @@ SUBROUTINE mc_parse_text(text, nstart, nend, string_search, lend, & ELSE IF (PRESENT(start_row_number)) start_row_number = iline column_number = index_string - DO jline = iline+1, nend + DO jline = iline + 1, nend ! now we find the &END that matches up with this one... ! I need proper indentation because I'm not very smart text_temp = text(jline) @@ -1275,7 +1275,7 @@ SUBROUTINE read_mc_section(mc_par, para_env, globenv, input_file_name, input_fil mc_par%displacement_file = mc_par%program(ia:ie) & //'.max_displacements' mc_par%data_file = mc_par%program(ia:ie)//'.data' - stop_num = ie-3 + stop_num = ie - 3 mc_par%dat_file = mc_par%program(ia:stop_num)//'dat' ! set them into the input parameter structure as the new defaults @@ -1326,7 +1326,7 @@ SUBROUTINE read_mc_section(mc_par, para_env, globenv, input_file_name, input_fil ! now an integer array CALL section_vals_val_get(mc_section, "AVBMC%AVBMC_ATOM", i_vals=temp_i_array) - IF (mc_par%pmhmc-mc_par%pmswap >= 1.0_dp .AND. mc_par%pmhmc == 1.0_dp) THEN + IF (mc_par%pmhmc - mc_par%pmswap >= 1.0_dp .AND. mc_par%pmhmc == 1.0_dp) THEN mc_par%lhmc = .TRUE. ELSE mc_par%lhmc = .FALSE. @@ -1534,9 +1534,9 @@ SUBROUTINE read_mc_section(mc_par, para_env, globenv, input_file_name, input_fil IF (iw > 0) THEN WRITE (box_string, '(I2)') mc_par%mc_molecule_info%nboxes WRITE (molecule_string, '(I2)') mc_par%mc_molecule_info%nmol_types - WRITE (tab_string, '(I4)') 81-10*mc_par%mc_molecule_info%nmol_types - WRITE (tab_box_string, '(I4)') 81-10*mc_par%mc_molecule_info%nboxes - WRITE (tab_string_int, '(I4)') 81-5*mc_par%mc_molecule_info%nmol_types + WRITE (tab_string, '(I4)') 81 - 10*mc_par%mc_molecule_info%nmol_types + WRITE (tab_box_string, '(I4)') 81 - 10*mc_par%mc_molecule_info%nboxes + WRITE (tab_string_int, '(I4)') 81 - 5*mc_par%mc_molecule_info%nmol_types format_string = "(A,T"//TRIM(ADJUSTL(tab_string))//","//TRIM(ADJUSTL(molecule_string))//"(2X,F8.4))" format_box_string = "(A,T"//TRIM(ADJUSTL(tab_box_string))//","//TRIM(ADJUSTL(box_string))//"(2X,F8.4))" format_string_int = "(A,T"//TRIM(ADJUSTL(tab_string))//","//TRIM(ADJUSTL(molecule_string))//"(I3,2X))" @@ -1849,7 +1849,7 @@ SUBROUTINE mc_determine_molecule_info(force_env, mc_molecule_info, box_number, & CALL cp_subsys_get(subsys, & molecule_kinds=molecule_kinds(ibox)%list, & particles=particles(ibox)%list) - ntypes = ntypes+SIZE(molecule_kinds(ibox)%list%els(:)) + ntypes = ntypes + SIZE(molecule_kinds(ibox)%list%els(:)) ENDDO ALLOCATE (names_init(1:ntypes)) @@ -1865,19 +1865,19 @@ SUBROUTINE mc_determine_molecule_info(force_env, mc_molecule_info, box_number, & CALL get_molecule_kind(molecule_kind, name=names_init(itype), & natom=natom) IF (natom .GT. natoms_large) natoms_large = natom - itype = itype+1 + itype = itype + 1 ENDDO ENDDO nmol_types = 0 DO itype = 1, ntypes lnew_type = .TRUE. - DO jtype = 1, itype-1 + DO jtype = 1, itype - 1 IF (TRIM(names_init(itype)) .EQ. TRIM(names_init(jtype))) & lnew_type = .FALSE. ENDDO IF (lnew_type) THEN - nmol_types = nmol_types+1 + nmol_types = nmol_types + 1 ELSE names_init(itype) = '' ENDIF @@ -1900,9 +1900,9 @@ SUBROUTINE mc_determine_molecule_info(force_env, mc_molecule_info, box_number, & DO ibox = 1, nboxes IF (ibox == skip_box) CYCLE DO imolecule = 1, SIZE(molecule_kinds(ibox)%list%els(:)) - itype = itype+1 + itype = itype + 1 IF (names_init(itype) .EQ. '') CYCLE - iunique = iunique+1 + iunique = iunique + 1 mc_molecule_info%names(iunique) = names_init(itype) molecule_kind => molecule_kinds(ibox)%list%els(imolecule) CALL get_molecule_kind(molecule_kind, natom=mc_molecule_info%nunits(iunique), & @@ -1916,7 +1916,7 @@ SUBROUTINE mc_determine_molecule_info(force_env, mc_molecule_info, box_number, & ENDDO ! compute the probabilities of doing any particular kind of conformation change - total = nbond+nbend+ntorsion + total = nbond + nbend + ntorsion IF (total == 0) THEN mc_molecule_info%conf_prob(:, iunique) = 0.0e0_dp @@ -1948,7 +1948,7 @@ SUBROUTINE mc_determine_molecule_info(force_env, mc_molecule_info, box_number, & CALL get_molecule_kind(molecule_kind, nmolecule=nmolecule, & name=name) IF (TRIM(name) .NE. mc_molecule_info%names(iunique)) CYCLE - mc_molecule_info%nchains(iunique, ibox) = mc_molecule_info%nchains(iunique, ibox)+nmolecule + mc_molecule_info%nchains(iunique, ibox) = mc_molecule_info%nchains(iunique, ibox) + nmolecule ENDDO ENDDO ENDDO @@ -1957,10 +1957,10 @@ SUBROUTINE mc_determine_molecule_info(force_env, mc_molecule_info, box_number, & mc_molecule_info%nunits_tot(ibox) = 0 IF (ibox == skip_box) CYCLE DO iunique = 1, nmol_types - mc_molecule_info%nunits_tot(ibox) = mc_molecule_info%nunits_tot(ibox)+ & + mc_molecule_info%nunits_tot(ibox) = mc_molecule_info%nunits_tot(ibox) + & mc_molecule_info%nunits(iunique)*mc_molecule_info%nchains(iunique, ibox) ENDDO - mc_molecule_info%nchain_total = mc_molecule_info%nchain_total+SUM(mc_molecule_info%nchains(:, ibox)) + mc_molecule_info%nchain_total = mc_molecule_info%nchain_total + SUM(mc_molecule_info%nchains(:, ibox)) ENDDO ! now we need to figure out which type every molecule is, @@ -1971,8 +1971,8 @@ SUBROUTINE mc_determine_molecule_info(force_env, mc_molecule_info, box_number, & last_mol = 0 DO ibox = 1, nboxes IF (ibox == skip_box) CYCLE - first_mol = last_mol+1 - last_mol = first_mol+SUM(mc_molecule_info%nchains(:, ibox))-1 + first_mol = last_mol + 1 + last_mol = first_mol + SUM(mc_molecule_info%nchains(:, ibox)) - 1 mc_molecule_info%in_box(first_mol:last_mol) = ibox DO imolecule = 1, SIZE(molecule_kinds(ibox)%list%els(:)) molecule_kind => molecule_kinds(ibox)%list%els(imolecule) @@ -1986,7 +1986,7 @@ SUBROUTINE mc_determine_molecule_info(force_env, mc_molecule_info, box_number, & ENDIF ENDDO DO imol = 1, SIZE(molecule_list(:)) - mc_molecule_info%mol_type(first_mol+molecule_list(imol)-1) = this_molecule + mc_molecule_info%mol_type(first_mol + molecule_list(imol) - 1) = this_molecule ENDDO ENDDO ENDDO diff --git a/src/motion/mc/tamc_run.F b/src/motion/mc/tamc_run.F index ba29c3e296..a8a39907e8 100644 --- a/src/motion/mc/tamc_run.F +++ b/src/motion/mc/tamc_run.F @@ -436,7 +436,7 @@ SUBROUTINE qs_tamc(force_env, globenv, averages) IF (force_env%meta_env%langevin) THEN CALL create_wiener_process_cv(force_env%meta_env) NULLIFY (rng_stream) - DO j = 1, (rand2skip-1)/nmccycles + DO j = 1, (rand2skip - 1)/nmccycles DO i = 1, force_env%meta_env%n_colvar rng_stream => force_env%meta_env%rng(i)%stream auxRandom = next_random_number(rng_stream) @@ -485,7 +485,7 @@ SUBROUTINE qs_tamc(force_env, globenv, averages) ELSE CALL get_md_env(md_env, reftraj=reftraj) CALL initialize_reftraj(reftraj, reftraj_section, md_env) - itimes = reftraj%info%first_snapshot-1 + itimes = reftraj%info%first_snapshot - 1 md_stride = reftraj%info%stride END IF @@ -533,7 +533,7 @@ SUBROUTINE qs_tamc(force_env, globenv, averages) CALL HMCsampler(globenv, force_env, MCaverages, r, mc_par, moves, gmoves, rng_stream_mc, output_unit, & fz, zbuff, nskip=rand2skip) CALL cp_iterate(logger%iter_info, last=.FALSE., iter_nr=0) - CALL section_vals_val_set(mc_section, "RANDOMTOSKIP", i_val=rand2skip+nmccycles) + CALL section_vals_val_set(mc_section, "RANDOMTOSKIP", i_val=rand2skip + nmccycles) CALL write_restart(md_env=md_env, root_section=force_env%root_section) ENDIF IF (output_unit > 0) THEN @@ -545,8 +545,8 @@ SUBROUTINE qs_tamc(force_env, globenv, averages) DO istep = 1, force_env%meta_env%TAMCSteps ! Increase counters - itimes = itimes+1 - time = time+force_env%meta_env%dt + itimes = itimes + 1 + time = time + force_env%meta_env%dt IF (output_unit > 0) THEN WRITE (output_unit, '(a)') "HMC|===================================" WRITE (output_unit, '(a,1x,i0)') "HMC| on z step ", istep @@ -613,7 +613,7 @@ SUBROUTINE qs_tamc(force_env, globenv, averages) ! END IF time_iter_stop = m_walltime() - used_time = time_iter_stop-time_iter_start + used_time = time_iter_stop - time_iter_start time_iter_start = time_iter_stop !!!!! this writes the restart... @@ -631,8 +631,8 @@ SUBROUTINE qs_tamc(force_env, globenv, averages) CALL cp_iterate(logger%iter_info, last=.TRUE., iter_nr=itimes) force_env%qs_env%sim_time = 0.0_dp force_env%qs_env%sim_step = 0 - rand2skip = rand2skip+nmccycles*force_env%meta_env%TAMCSteps - IF (initialStep == 0) rand2skip = rand2skip+nmccycles + rand2skip = rand2skip + nmccycles*force_env%meta_env%TAMCSteps + IF (initialStep == 0) rand2skip = rand2skip + nmccycles CALL section_vals_val_set(mc_section, "RANDOMTOSKIP", i_val=rand2skip) CALL write_restart(md_env=md_env, root_section=force_env%root_section) @@ -701,10 +701,10 @@ SUBROUTINE tamc_velocities_colvar(force_env, An) meta_env%epot_walls = 0.0_dp DO i_c = 1, meta_env%n_colvar cv => meta_env%metavar(i_c) - fft = cv%ff_s+cv%ff_hills + fft = cv%ff_s + cv%ff_hills sigma = SQRT((meta_env%temp_wanted*kelvin)*2.0_dp*(boltzmann/joule)*cv%gamma/cv%mass) - cv%vvp = cv%vvp+0.5_dp*dt*(fft/cv%mass-cv%gamma*cv%vvp)*(1.0_dp-0.25_dp*dt*cv%gamma)+An(i_c) - meta_env%epot_walls = meta_env%epot_walls+cv%epot_walls + cv%vvp = cv%vvp + 0.5_dp*dt*(fft/cv%mass - cv%gamma*cv%vvp)*(1.0_dp - 0.25_dp*dt*cv%gamma) + An(i_c) + meta_env%epot_walls = meta_env%epot_walls + cv%epot_walls ENDDO CALL timestop(handle) END SUBROUTINE tamc_velocities_colvar @@ -745,7 +745,7 @@ SUBROUTINE tamc_position_colvar(force_env, xieta) cv => meta_env%metavar(i_c) sigma = SQRT((meta_env%temp_wanted*kelvin)*2.0_dp*(boltzmann/joule)*cv%gamma/cv%mass) ! cv%ss0 =cv%ss0 +dt*cv%vvp - cv%ss0 = cv%ss0+dt*cv%vvp+dt*SQRT(dt/12.0_dp)*sigma*xieta(i_c+meta_env%n_colvar) + cv%ss0 = cv%ss0 + dt*cv%vvp + dt*SQRT(dt/12.0_dp)*sigma*xieta(i_c + meta_env%n_colvar) IF (cv%periodic) THEN ! A periodic COLVAR is always within [-pi,pi] cv%ss0 = SIGN(1.0_dp, ASIN(SIN(cv%ss0)))*ACOS(COS(cv%ss0)) @@ -789,7 +789,7 @@ SUBROUTINE tamc_force(force_env, zpot) CALL force_env_get(force_env, subsys=subsys) dt = meta_env%dt - IF (.NOT. meta_env%restart) meta_env%n_steps = meta_env%n_steps+1 + IF (.NOT. meta_env%restart) meta_env%n_steps = meta_env%n_steps + 1 ! compute ss and the derivative of ss with respect to the atomic positions DO i_c = 1, meta_env%n_colvar cv => meta_env%metavar(i_c) @@ -838,19 +838,19 @@ SUBROUTINE tamc_force(force_env, zpot) meta_env%epot_walls = 0.0_dp DO i_c = 1, meta_env%n_colvar cv => meta_env%metavar(i_c) - diff_ss = cv%ss-cv%ss0 + diff_ss = cv%ss - cv%ss0 IF (cv%periodic) THEN ! The difference of a periodic COLVAR is always within [-pi,pi] diff_ss = SIGN(1.0_dp, ASIN(SIN(diff_ss)))*ACOS(COS(diff_ss)) END IF cv%epot_s = 0.5_dp*cv%lambda*diff_ss*diff_ss cv%ff_s = cv%lambda*(diff_ss) - meta_env%epot_s = meta_env%epot_s+cv%epot_s + meta_env%epot_s = meta_env%epot_s + cv%epot_s icolvar = cv%icolvar DO ii = 1, colvar_p(icolvar)%colvar%n_atom_s i = colvar_p(icolvar)%colvar%i_atom(ii) - particles%els(i)%f = particles%els(i)%f-cv%ff_s*colvar_p(icolvar)%colvar%dsdr(:, ii) + particles%els(i)%f = particles%els(i)%f - cv%ff_s*colvar_p(icolvar)%colvar%dsdr(:, ii) ENDDO ENDDO @@ -957,12 +957,12 @@ SUBROUTINE langevinVEC(md_env, globenv, mc_env, moves, gmoves, r, & DO ivar = 1, force_env%meta_env%n_colvar rng_stream => force_env%meta_env%rng(ivar)%stream xieta(ivar) = next_random_number(rng_stream) - xieta(ivar+force_env%meta_env%n_colvar) = next_random_number(rng_stream) + xieta(ivar + force_env%meta_env%n_colvar) = next_random_number(rng_stream) gamma = force_env%meta_env%metavar(ivar)%gamma mass = force_env%meta_env%metavar(ivar)%mass sigma = SQRT((force_env%meta_env%temp_wanted*kelvin)*2.0_dp*(boltzmann/joule)*gamma/mass) - An(ivar) = 0.5_dp*SQRT(dt)*sigma*(xieta(ivar)*(1.0_dp-0.5_dp*dt*gamma)- & - dt*gamma*xieta(ivar+force_env%meta_env%n_colvar)/SQRT(12.0_dp)) + An(ivar) = 0.5_dp*SQRT(dt)*sigma*(xieta(ivar)*(1.0_dp - 0.5_dp*dt*gamma) - & + dt*gamma*xieta(ivar + force_env%meta_env%n_colvar)/SQRT(12.0_dp)) ENDDO ! *** Velocity Verlet for Langeving *** v(t)--> v(t+1/2) CALL tamc_velocities_colvar(force_env, An) @@ -1046,15 +1046,15 @@ SUBROUTINE HMCsampler(globenv, force_env, averages, r, mc_par, moves, gmoves, rn IF (output_unit > 0) THEN WRITE (output_unit, '(a,l4)') "HMC|restart? ", force_env%meta_env%restart WRITE (output_unit, '(a,3(f16.8,1x))') & - "HMC|Ep, Epx, Epz ", old_epx+force_env%meta_env%epot_s, old_epx, force_env%meta_env%epot_s + "HMC|Ep, Epx, Epz ", old_epx + force_env%meta_env%epot_s, old_epx, force_env%meta_env%epot_s WRITE (output_unit, '(a)') "#HMC| No | z.. | theta.. | ff_z... | ff_z/n |" ENDIF DO i = 1, nstep IF (MOD(i, iprint) == 0 .AND. (output_unit > 0)) THEN - WRITE (output_unit, '(a,1x,i0)') "HMC|========== On Monte Carlo cycle ", i+ishift + WRITE (output_unit, '(a,1x,i0)') "HMC|========== On Monte Carlo cycle ", i + ishift WRITE (output_unit, '(a)') "HMC| Attempting a minitrajectory move" - WRITE (output_unit, '(a,1x,i0)') "HMC| start mini-trajectory", i+ishift - WRITE (output_unit, '(a,1x,i0,1x)', advance="no") "#HMC|0 ", i+ishift + WRITE (output_unit, '(a,1x,i0)') "HMC| start mini-trajectory", i + ishift + WRITE (output_unit, '(a,1x,i0,1x)', advance="no") "#HMC|0 ", i + ishift DO j = 1, force_env%meta_env%n_colvar WRITE (output_unit, '(f16.8,1x,f16.8,1x,f16.8)', advance="no") force_env%meta_env%metavar(j)%ss0, & force_env%meta_env%metavar(j)%ss, & @@ -1067,27 +1067,27 @@ SUBROUTINE HMCsampler(globenv, force_env, averages, r, mc_par, moves, gmoves, rn r, output_unit, rng_stream_mc, zbuff) ! check averages... ! force average for z needed too... - averages%ave_energy = averages%ave_energy*REAL(i-1, dp)/REAL(i, dp)+ & + averages%ave_energy = averages%ave_energy*REAL(i - 1, dp)/REAL(i, dp) + & old_epx/REAL(i, dp) DO j = 1, force_env%meta_env%n_colvar - fz(j) = fz(j)+force_env%meta_env%metavar(j)%ff_s + fz(j) = fz(j) + force_env%meta_env%metavar(j)%ff_s ENDDO IF (output_unit > 0) THEN - WRITE (output_unit, '(a,1x,i0)') "HMC|end mini-trajectory", i+ishift + WRITE (output_unit, '(a,1x,i0)') "HMC|end mini-trajectory", i + ishift !!!!!!!! this prints z and theta(x) --ss0,ss-- needed to determine an acceptable k then ! the instanteneous force and some instanteneous average for force - WRITE (output_unit, '(a,1x,i0,1x)', advance="no") "#HMC|1 ", i+ishift + WRITE (output_unit, '(a,1x,i0,1x)', advance="no") "#HMC|1 ", i + ishift DO j = 1, force_env%meta_env%n_colvar WRITE (output_unit, '(f16.8,1x,f16.8,1x,f16.8,1x,f16.8)', advance="no") force_env%meta_env%metavar(j)%ss0, & force_env%meta_env%metavar(j)%ss, & - force_env%meta_env%metavar(j)%ff_s, fz(j)/REAL(i+ishift, dp) + force_env%meta_env%metavar(j)%ff_s, fz(j)/REAL(i + ishift, dp) ENDDO WRITE (output_unit, *) ENDIF - nsamples = nsamples+1 + nsamples = nsamples + 1 IF (MOD(i, iprint) == 0 .AND. (output_unit > 0)) THEN WRITE (output_unit, '(a,f16.8)') "HMC| Running average for potential energy ", averages%ave_energy - WRITE (output_unit, '(a,1x,i0)') "HMC|======== End Monte Carlo cycle ", i+ishift + WRITE (output_unit, '(a,1x,i0)') "HMC|======== End Monte Carlo cycle ", i + ishift ENDIF ! IF (lrestart) THEN ! k=nstep/5 @@ -1186,8 +1186,8 @@ SUBROUTINE mc_hmc_move(mc_par, force_env, globenv, moves, gmoves, old_epx, old_e ALLOCATE (hmc_ekin) ! record the attempt - moves%hmc%attempts = moves%hmc%attempts+1 - gmoves%hmc%attempts = gmoves%hmc%attempts+1 + moves%hmc%attempts = moves%hmc%attempts + 1 + gmoves%hmc%attempts = gmoves%hmc%attempts + 1 ! save the old coordinates just in case we need to go back DO iatom = 1, nAtoms @@ -1197,7 +1197,7 @@ SUBROUTINE mc_hmc_move(mc_par, force_env, globenv, moves, gmoves, old_epx, old_e ! the same for collective variables data should be made,ss first half and ff_s the last half DO j = 1, force_env%meta_env%n_colvar zbuff(j) = force_env%meta_env%metavar(j)%ss - zbuff(j+force_env%meta_env%n_colvar) = force_env%meta_env%metavar(j)%ff_s + zbuff(j + force_env%meta_env%n_colvar) = force_env%meta_env%metavar(j)%ff_s IF ((oldsys%colvar_p(force_env%meta_env%metavar(j)%icolvar)%colvar%type_id == HBP_colvar_id) .OR. & (oldsys%colvar_p(force_env%meta_env%metavar(j)%icolvar)%colvar%type_id == WC_colvar_id)) THEN localise = .FALSE. @@ -1222,13 +1222,13 @@ SUBROUTINE mc_hmc_move(mc_par, force_env, globenv, moves, gmoves, old_epx, old_e force_env%meta_env => meta_env_saved CALL tamc_force(force_env, zpot=new_epz) - new_energy = new_epx+new_epz + new_energy = new_epx + new_epz IF (output_unit > 0) THEN WRITE (output_unit, '(a,4(f16.8,1x))') & - "HMC|old Ep, Ekx, Epz, Epx ", old_epx+old_epz, hmc_ekin%initial_ekin, old_epz, old_epx + "HMC|old Ep, Ekx, Epz, Epx ", old_epx + old_epz, hmc_ekin%initial_ekin, old_epz, old_epx WRITE (output_unit, '(a,4(f16.8,1x))') "HMC|new Ep, Ekx, Epz, Epx ", new_energy, hmc_ekin%final_ekin, new_epz, new_epx ENDIF - energy_term = new_energy-old_epx-old_epz+hmc_ekin%final_ekin-hmc_ekin%initial_ekin + energy_term = new_energy - old_epx - old_epz + hmc_ekin%final_ekin - hmc_ekin%initial_ekin value = -BETA*(energy_term) ! to prevent overflows @@ -1243,10 +1243,10 @@ SUBROUTINE mc_hmc_move(mc_par, force_env, globenv, moves, gmoves, old_epx, old_e rand = next_random_number(rng_stream) IF (rand < w) THEN ! accept the move - moves%hmc%successes = moves%hmc%successes+1 - gmoves%hmc%successes = gmoves%hmc%successes+1 + moves%hmc%successes = moves%hmc%successes + 1 + gmoves%hmc%successes = gmoves%hmc%successes + 1 ! update energies - energy_check = energy_check+(new_energy-old_epx-old_epz) + energy_check = energy_check + (new_energy - old_epx - old_epz) old_epx = new_epx old_epz = new_epz ELSE @@ -1256,7 +1256,7 @@ SUBROUTINE mc_hmc_move(mc_par, force_env, globenv, moves, gmoves, old_epx, old_e ENDDO DO j = 1, force_env%meta_env%n_colvar force_env%meta_env%metavar(j)%ss = zbuff(j) - force_env%meta_env%metavar(j)%ff_s = zbuff(j+force_env%meta_env%n_colvar) + force_env%meta_env%metavar(j)%ff_s = zbuff(j + force_env%meta_env%n_colvar) ENDDO ENDIF @@ -1304,27 +1304,27 @@ SUBROUTINE metadyn_write_colvar_header(force_env) DO i = 1, meta_env%n_colvar WRITE (aux, '(a,i0)') "z_", i label1 = TRIM(label1)//TRIM(aux) - m = 15*i-LEN_TRIM(label1)-1 + m = 15*i - LEN_TRIM(label1) - 1 label1 = TRIM(label1)//REPEAT(" ", m)//"|" WRITE (aux, '(a,i0)') "Theta_", i label2 = TRIM(label2)//TRIM(aux) - m = 15*i-LEN_TRIM(label2)-1 + m = 15*i - LEN_TRIM(label2) - 1 label2 = TRIM(label2)//REPEAT(" ", m)//"|" WRITE (aux, '(a,i0)') "F_z", i label3 = TRIM(label3)//TRIM(aux) - m = 15*i-LEN_TRIM(label3)-1 + m = 15*i - LEN_TRIM(label3) - 1 label3 = TRIM(label3)//REPEAT(" ", m)//"|" WRITE (aux, '(a,i0)') "F_h", i label4 = TRIM(label4)//TRIM(aux) - m = 15*i-LEN_TRIM(label4)-1 + m = 15*i - LEN_TRIM(label4) - 1 label4 = TRIM(label4)//REPEAT(" ", m)//"|" WRITE (aux, '(a,i0)') "F_w", i label5 = TRIM(label5)//TRIM(aux) - m = 15*i-LEN_TRIM(label5)-1 + m = 15*i - LEN_TRIM(label5) - 1 label5 = TRIM(label5)//REPEAT(" ", m)//"|" WRITE (aux, '(a,i0)') "v_z", i label6 = TRIM(label6)//TRIM(aux) - m = 15*i-LEN_TRIM(label6)-1 + m = 15*i - LEN_TRIM(label6) - 1 label6 = TRIM(label6)//REPEAT(" ", m)//"|" ENDDO WRITE (fmt, '("(a17,6a",i0 ,",4a15)")') meta_env%n_colvar*15 @@ -1376,7 +1376,7 @@ SUBROUTINE metadyn_write_colvar(force_env) ! meta_env%epot_s = 0.0_dp DO i_c = 1, meta_env%n_colvar cv => meta_env%metavar(i_c) - meta_env%ekin_s = meta_env%ekin_s+0.5_dp*cv%mass*cv%vvp**2 + meta_env%ekin_s = meta_env%ekin_s + 0.5_dp*cv%mass*cv%vvp**2 ENDDO END IF @@ -1410,8 +1410,8 @@ SUBROUTINE metadyn_write_colvar(force_env) ! Temperature for COLVAR IF (meta_env%extended_lagrange) THEN temp = meta_env%ekin_s*2.0_dp/(REAL(meta_env%n_colvar, KIND=dp))*kelvin - meta_env%avg_temp = (meta_env%avg_temp*REAL(meta_env%n_steps, KIND=dp)+ & - temp)/REAL(meta_env%n_steps+1, KIND=dp) + meta_env%avg_temp = (meta_env%avg_temp*REAL(meta_env%n_steps, KIND=dp) + & + temp)/REAL(meta_env%n_steps + 1, KIND=dp) iw = cp_print_key_unit_nr(logger, meta_env%metadyn_section, & "PRINT%TEMPERATURE_COLVAR", extension=".metadynLog") IF (iw > 0) THEN @@ -1445,7 +1445,7 @@ SUBROUTINE setup_velocities_z(force_env) DO i_c = 1, meta_env%n_colvar cv => meta_env%metavar(i_c) cv%vvp = next_random_number(force_env%globenv%gaussian_rng_stream) - meta_env%ekin_s = meta_env%ekin_s+0.5_dp*cv%mass*cv%vvp**2 + meta_env%ekin_s = meta_env%ekin_s + 0.5_dp*cv%mass*cv%vvp**2 END DO ekin_w = 0.5_dp*meta_env%temp_wanted*REAL(meta_env%n_colvar, KIND=dp) fac_t = SQRT(ekin_w/MAX(meta_env%ekin_s, 1.0E-8_dp)) diff --git a/src/motion/md_conserved_quantities.F b/src/motion/md_conserved_quantities.F index c22986dbbb..079b908c50 100644 --- a/src/motion/md_conserved_quantities.F +++ b/src/motion/md_conserved_quantities.F @@ -160,7 +160,7 @@ SUBROUTINE compute_conserved_quantity(md_env, md_ener, tkind, tshell, & CALL get_econs_nph_uniaxial(md_env, md_ener) md_ener%temp_baro = md_ener%temp_baro*kelvin CASE (langevin_ensemble) - md_ener%constant = md_ener%ekin+md_ener%epot + md_ener%constant = md_ener%ekin + md_ener%epot CASE (npe_f_ensemble, npe_i_ensemble) CALL get_econs_npe(md_env, md_ener, para_env) md_ener%temp_baro = md_ener%temp_baro*kelvin @@ -176,7 +176,7 @@ SUBROUTINE compute_conserved_quantity(md_env, md_ener, tkind, tshell, & END IF ELSE CALL get_md_env(md_env=md_env, constant=constant) - md_ener%delta_cons = (md_ener%constant-constant)/REAL(natom, KIND=dp)*kelvin + md_ener%delta_cons = (md_ener%constant - constant)/REAL(natom, KIND=dp)*kelvin END IF END SUBROUTINE compute_conserved_quantity @@ -230,7 +230,7 @@ FUNCTION calc_nfree_qm(md_env, md_ener) RESULT(nfree_qm) nfree_qm = 0 DO ip = 1, SIZE(cur_indices) IF (cur_labels(ip) >= force_mixing_label_QM_dynamics) THEN ! this is a QM atom - nfree_qm = nfree_qm+3 + nfree_qm = nfree_qm + 3 END IF END DO END IF @@ -261,11 +261,11 @@ SUBROUTINE get_econs_nve(md_env, md_ener, para_env) CALL get_md_env(md_env, force_env=force_env, thermostat_coeff=thermostat_coeff, & thermostat_shell=thermostat_shell) - md_ener%constant = md_ener%ekin+md_ener%epot+md_ener%ekin_shell + md_ener%constant = md_ener%ekin + md_ener%epot + md_ener%ekin_shell CALL get_thermostat_energies(thermostat_shell, md_ener%thermostat_shell_pot, & md_ener%thermostat_shell_kin, para_env) - md_ener%constant = md_ener%constant+md_ener%thermostat_shell_kin+md_ener%thermostat_shell_pot + md_ener%constant = md_ener%constant + md_ener%thermostat_shell_kin + md_ener%thermostat_shell_pot END SUBROUTINE get_econs_nve @@ -294,12 +294,12 @@ SUBROUTINE get_econs_nvt_adiabatic(md_env, md_ener, para_env) thermostat_slow=thermostat_slow) CALL get_thermostat_energies(thermostat_fast, md_ener%thermostat_fast_pot, & md_ener%thermostat_fast_kin, para_env) - md_ener%constant = md_ener%ekin+md_ener%epot+ & - md_ener%thermostat_fast_kin+md_ener%thermostat_fast_pot + md_ener%constant = md_ener%ekin + md_ener%epot + & + md_ener%thermostat_fast_kin + md_ener%thermostat_fast_pot CALL get_thermostat_energies(thermostat_slow, md_ener%thermostat_slow_pot, & md_ener%thermostat_slow_kin, para_env) - md_ener%constant = md_ener%constant+ & - md_ener%thermostat_slow_kin+md_ener%thermostat_slow_pot + md_ener%constant = md_ener%constant + & + md_ener%thermostat_slow_kin + md_ener%thermostat_slow_pot END SUBROUTINE get_econs_nvt_adiabatic @@ -328,12 +328,12 @@ SUBROUTINE get_econs_nvt(md_env, md_ener, para_env) thermostat_coeff=thermostat_coeff, thermostat_shell=thermostat_shell) CALL get_thermostat_energies(thermostat_part, md_ener%thermostat_part_pot, & md_ener%thermostat_part_kin, para_env) - md_ener%constant = md_ener%ekin+md_ener%epot+md_ener%ekin_shell+ & - md_ener%thermostat_part_kin+md_ener%thermostat_part_pot + md_ener%constant = md_ener%ekin + md_ener%epot + md_ener%ekin_shell + & + md_ener%thermostat_part_kin + md_ener%thermostat_part_pot CALL get_thermostat_energies(thermostat_shell, md_ener%thermostat_shell_pot, & md_ener%thermostat_shell_kin, para_env) - md_ener%constant = md_ener%constant+md_ener%thermostat_shell_kin+md_ener%thermostat_shell_pot + md_ener%constant = md_ener%constant + md_ener%thermostat_shell_kin + md_ener%thermostat_shell_pot END SUBROUTINE get_econs_nvt @@ -368,12 +368,12 @@ SUBROUTINE get_econs_npe(md_env, md_ener, para_env) nfree = SIZE(npt, 1)*SIZE(npt, 2) md_ener%temp_baro = 2.0_dp*md_ener%baro_kin/nfree - md_ener%constant = md_ener%ekin+md_ener%epot+md_ener%ekin_shell & - +md_ener%baro_kin+md_ener%baro_pot + md_ener%constant = md_ener%ekin + md_ener%epot + md_ener%ekin_shell & + + md_ener%baro_kin + md_ener%baro_pot CALL get_thermostat_energies(thermostat_shell, md_ener%thermostat_shell_pot, & md_ener%thermostat_shell_kin, para_env) - md_ener%constant = md_ener%constant+md_ener%thermostat_shell_kin+ & + md_ener%constant = md_ener%constant + md_ener%thermostat_shell_kin + & md_ener%thermostat_shell_pot END SUBROUTINE get_econs_npe @@ -412,14 +412,14 @@ SUBROUTINE get_econs_npt(md_env, md_ener, para_env) nfree = SIZE(npt, 1)*SIZE(npt, 2) md_ener%temp_baro = 2.0_dp*md_ener%baro_kin/nfree - md_ener%constant = md_ener%ekin+md_ener%epot+md_ener%ekin_shell & - +md_ener%thermostat_part_kin+md_ener%thermostat_part_pot & - +md_ener%thermostat_baro_kin+md_ener%thermostat_baro_pot & - +md_ener%baro_kin+md_ener%baro_pot + md_ener%constant = md_ener%ekin + md_ener%epot + md_ener%ekin_shell & + + md_ener%thermostat_part_kin + md_ener%thermostat_part_pot & + + md_ener%thermostat_baro_kin + md_ener%thermostat_baro_pot & + + md_ener%baro_kin + md_ener%baro_pot CALL get_thermostat_energies(thermostat_shell, md_ener%thermostat_shell_pot, & md_ener%thermostat_shell_kin, para_env) - md_ener%constant = md_ener%constant+md_ener%thermostat_shell_kin+md_ener%thermostat_shell_pot + md_ener%constant = md_ener%constant + md_ener%thermostat_shell_kin + md_ener%thermostat_shell_pot END SUBROUTINE get_econs_npt @@ -446,7 +446,7 @@ SUBROUTINE get_econs_nph_uniaxial(md_env, md_ener) CALL get_baro_energies(box, simpar, npt, md_ener%baro_kin, md_ener%baro_pot) md_ener%temp_baro = 2.0_dp*md_ener%baro_kin - md_ener%constant = md_ener%ekin+md_ener%epot+md_ener%baro_kin+md_ener%baro_pot + md_ener%constant = md_ener%ekin + md_ener%epot + md_ener%baro_kin + md_ener%baro_pot END SUBROUTINE get_econs_nph_uniaxial ! ************************************************************************************************** @@ -532,31 +532,31 @@ SUBROUTINE get_part_ke(md_env, md_ener, tkind, tshell, group) !ekin ekin_com = 0.5_dp*mass* & (particle_set(iparticle)%v(1)*particle_set(iparticle)%v(1) & - +particle_set(iparticle)%v(2)*particle_set(iparticle)%v(2) & - +particle_set(iparticle)%v(3)*particle_set(iparticle)%v(3)) + + particle_set(iparticle)%v(2)*particle_set(iparticle)%v(2) & + + particle_set(iparticle)%v(3)*particle_set(iparticle)%v(3)) !vcom - md_ener%vcom(1) = md_ener%vcom(1)+particle_set(iparticle)%v(1)*mass - md_ener%vcom(2) = md_ener%vcom(2)+particle_set(iparticle)%v(2)*mass - md_ener%vcom(3) = md_ener%vcom(3)+particle_set(iparticle)%v(3)*mass - md_ener%total_mass = md_ener%total_mass+mass + md_ener%vcom(1) = md_ener%vcom(1) + particle_set(iparticle)%v(1)*mass + md_ener%vcom(2) = md_ener%vcom(2) + particle_set(iparticle)%v(2)*mass + md_ener%vcom(3) = md_ener%vcom(3) + particle_set(iparticle)%v(3)*mass + md_ener%total_mass = md_ener%total_mass + mass - md_ener%ekin = md_ener%ekin+ekin_com + md_ener%ekin = md_ener%ekin + ekin_com ekin_c = 0.5_dp*shell%mass_core* & (core_particle_set(shell_index)%v(1)*core_particle_set(shell_index)%v(1) & - +core_particle_set(shell_index)%v(2)*core_particle_set(shell_index)%v(2) & - +core_particle_set(shell_index)%v(3)*core_particle_set(shell_index)%v(3)) + + core_particle_set(shell_index)%v(2)*core_particle_set(shell_index)%v(2) & + + core_particle_set(shell_index)%v(3)*core_particle_set(shell_index)%v(3)) ekin_s = 0.5_dp*shell%mass_shell* & (shell_particle_set(shell_index)%v(1)*shell_particle_set(shell_index)%v(1) & - +shell_particle_set(shell_index)%v(2)*shell_particle_set(shell_index)%v(2) & - +shell_particle_set(shell_index)%v(3)*shell_particle_set(shell_index)%v(3)) - md_ener%ekin_shell = md_ener%ekin_shell+ekin_c+ekin_s-ekin_com + + shell_particle_set(shell_index)%v(2)*shell_particle_set(shell_index)%v(2) & + + shell_particle_set(shell_index)%v(3)*shell_particle_set(shell_index)%v(3)) + md_ener%ekin_shell = md_ener%ekin_shell + ekin_c + ekin_s - ekin_com IF (tkind) THEN - md_ener%ekin_kind(iparticle_kind) = md_ener%ekin_kind(iparticle_kind)+ekin_com - md_ener%nfree_kind(iparticle_kind) = md_ener%nfree_kind(iparticle_kind)+3 - md_ener%ekin_shell_kind(iparticle_kind) = md_ener%ekin_shell_kind(iparticle_kind)+ & - ekin_c+ekin_s-ekin_com - md_ener%nfree_shell_kind(iparticle_kind) = md_ener%nfree_shell_kind(iparticle_kind)+3 + md_ener%ekin_kind(iparticle_kind) = md_ener%ekin_kind(iparticle_kind) + ekin_com + md_ener%nfree_kind(iparticle_kind) = md_ener%nfree_kind(iparticle_kind) + 3 + md_ener%ekin_shell_kind(iparticle_kind) = md_ener%ekin_shell_kind(iparticle_kind) + & + ekin_c + ekin_s - ekin_com + md_ener%nfree_shell_kind(iparticle_kind) = md_ener%nfree_shell_kind(iparticle_kind) + 3 END IF END DO ! iparticle_local @@ -565,18 +565,18 @@ SUBROUTINE get_part_ke(md_env, md_ener, tkind, tshell, group) iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) ekin_com = 0.5_dp*mass* & (particle_set(iparticle)%v(1)*particle_set(iparticle)%v(1) & - +particle_set(iparticle)%v(2)*particle_set(iparticle)%v(2) & - +particle_set(iparticle)%v(3)*particle_set(iparticle)%v(3)) + + particle_set(iparticle)%v(2)*particle_set(iparticle)%v(2) & + + particle_set(iparticle)%v(3)*particle_set(iparticle)%v(3)) !vcom - md_ener%vcom(1) = md_ener%vcom(1)+particle_set(iparticle)%v(1)*mass - md_ener%vcom(2) = md_ener%vcom(2)+particle_set(iparticle)%v(2)*mass - md_ener%vcom(3) = md_ener%vcom(3)+particle_set(iparticle)%v(3)*mass - md_ener%total_mass = md_ener%total_mass+mass + md_ener%vcom(1) = md_ener%vcom(1) + particle_set(iparticle)%v(1)*mass + md_ener%vcom(2) = md_ener%vcom(2) + particle_set(iparticle)%v(2)*mass + md_ener%vcom(3) = md_ener%vcom(3) + particle_set(iparticle)%v(3)*mass + md_ener%total_mass = md_ener%total_mass + mass - md_ener%ekin = md_ener%ekin+ekin_com + md_ener%ekin = md_ener%ekin + ekin_com IF (tkind) THEN - md_ener%ekin_kind(iparticle_kind) = md_ener%ekin_kind(iparticle_kind)+ekin_com - md_ener%nfree_kind(iparticle_kind) = md_ener%nfree_kind(iparticle_kind)+3 + md_ener%ekin_kind(iparticle_kind) = md_ener%ekin_kind(iparticle_kind) + ekin_com + md_ener%nfree_kind(iparticle_kind) = md_ener%nfree_kind(iparticle_kind) + 3 END IF END DO ! iparticle_local END IF @@ -599,19 +599,19 @@ SUBROUTINE get_part_ke(md_env, md_ener, tkind, tshell, group) ! ekin ekin_com = 0.5_dp*mass* & (particle_set(iparticle)%v(1)*particle_set(iparticle)%v(1) & - +particle_set(iparticle)%v(2)*particle_set(iparticle)%v(2) & - +particle_set(iparticle)%v(3)*particle_set(iparticle)%v(3)) + + particle_set(iparticle)%v(2)*particle_set(iparticle)%v(2) & + + particle_set(iparticle)%v(3)*particle_set(iparticle)%v(3)) !vcom - md_ener%vcom(1) = md_ener%vcom(1)+particle_set(iparticle)%v(1)*mass - md_ener%vcom(2) = md_ener%vcom(2)+particle_set(iparticle)%v(2)*mass - md_ener%vcom(3) = md_ener%vcom(3)+particle_set(iparticle)%v(3)*mass - md_ener%total_mass = md_ener%total_mass+mass + md_ener%vcom(1) = md_ener%vcom(1) + particle_set(iparticle)%v(1)*mass + md_ener%vcom(2) = md_ener%vcom(2) + particle_set(iparticle)%v(2)*mass + md_ener%vcom(3) = md_ener%vcom(3) + particle_set(iparticle)%v(3)*mass + md_ener%total_mass = md_ener%total_mass + mass - md_ener%ekin = md_ener%ekin+ekin_com + md_ener%ekin = md_ener%ekin + ekin_com IF (tkind) THEN - md_ener%ekin_kind(iparticle_kind) = md_ener%ekin_kind(iparticle_kind)+ekin_com - md_ener%nfree_kind(iparticle_kind) = md_ener%nfree_kind(iparticle_kind)+3 + md_ener%ekin_kind(iparticle_kind) = md_ener%ekin_kind(iparticle_kind) + ekin_com + md_ener%nfree_kind(iparticle_kind) = md_ener%nfree_kind(iparticle_kind) + 3 END IF END DO END DO ! iparticle_kind @@ -633,10 +633,10 @@ SUBROUTINE get_part_ke(md_env, md_ener, tkind, tshell, group) DO i = 1, SIZE(qmmm_env%qm%qm_atom_index) iparticle = qmmm_env%qm%qm_atom_index(i) mass = particle_set(iparticle)%atomic_kind%mass - md_ener%ekin_qm = md_ener%ekin_qm+0.5_dp*mass* & + md_ener%ekin_qm = md_ener%ekin_qm + 0.5_dp*mass* & (particle_set(iparticle)%v(1)*particle_set(iparticle)%v(1) & - +particle_set(iparticle)%v(2)*particle_set(iparticle)%v(2) & - +particle_set(iparticle)%v(3)*particle_set(iparticle)%v(3)) + + particle_set(iparticle)%v(2)*particle_set(iparticle)%v(2) & + + particle_set(iparticle)%v(3)*particle_set(iparticle)%v(3)) END DO END IF @@ -647,10 +647,10 @@ SUBROUTINE get_part_ke(md_env, md_ener, tkind, tshell, group) IF (cur_labels(i) >= force_mixing_label_QM_dynamics) THEN ! this is a QM atom iparticle = cur_indices(i) mass = particle_set(iparticle)%atomic_kind%mass - md_ener%ekin_qm = md_ener%ekin_qm+0.5_dp*mass* & + md_ener%ekin_qm = md_ener%ekin_qm + 0.5_dp*mass* & (particle_set(iparticle)%v(1)*particle_set(iparticle)%v(1) & - +particle_set(iparticle)%v(2)*particle_set(iparticle)%v(2) & - +particle_set(iparticle)%v(3)*particle_set(iparticle)%v(3)) + + particle_set(iparticle)%v(2)*particle_set(iparticle)%v(2) & + + particle_set(iparticle)%v(3)*particle_set(iparticle)%v(3)) END IF END DO END IF diff --git a/src/motion/md_ener_types.F b/src/motion/md_ener_types.F index 20411a8055..6fd9886369 100644 --- a/src/motion/md_ener_types.F +++ b/src/motion/md_ener_types.F @@ -69,7 +69,7 @@ SUBROUTINE create_md_ener(md_ener) CPASSERT(.NOT. ASSOCIATED(md_ener)) ALLOCATE (md_ener) - last_md_ener_id = last_md_ener_id+1 + last_md_ener_id = last_md_ener_id + 1 md_ener%id_nr = last_md_ener_id md_ener%ref_count = 1 @@ -96,7 +96,7 @@ SUBROUTINE retain_md_ener(md_ener) CPASSERT(ASSOCIATED(md_ener)) CPASSERT(md_ener%ref_count > 0) - md_ener%ref_count = md_ener%ref_count+1 + md_ener%ref_count = md_ener%ref_count + 1 END SUBROUTINE retain_md_ener ! ************************************************************************************************** @@ -114,7 +114,7 @@ SUBROUTINE release_md_ener(md_ener) IF (ASSOCIATED(md_ener)) THEN CPASSERT(md_ener%ref_count > 0) - md_ener%ref_count = md_ener%ref_count-1 + md_ener%ref_count = md_ener%ref_count - 1 IF (md_ener%ref_count == 0) THEN IF (ASSOCIATED(md_ener%temp_kind)) THEN DEALLOCATE (md_ener%temp_kind) diff --git a/src/motion/md_energies.F b/src/motion/md_energies.F index 0607ea1964..4ce69025a1 100644 --- a/src/motion/md_energies.F +++ b/src/motion/md_energies.F @@ -233,7 +233,7 @@ SUBROUTINE md_ener_reftraj(md_env, md_ener) CALL force_env_get(force_env, potential_energy=md_ener%epot) ELSE md_ener%epot = reftraj%epot - md_ener%delta_epot = (reftraj%epot-reftraj%epot0)/REAL(reftraj%natom, kind=dp)*kelvin + md_ener%delta_epot = (reftraj%epot - reftraj%epot0)/REAL(reftraj%natom, kind=dp)*kelvin END IF END SUBROUTINE md_ener_reftraj @@ -320,7 +320,7 @@ SUBROUTINE md_write_output(md_env) IF (virial%pv_availability) THEN pv_scalar = 0._dp DO i = 1, 3 - pv_scalar = pv_scalar+virial%pv_total(i, i) + pv_scalar = pv_scalar + virial%pv_total(i, i) END DO pv_scalar = pv_scalar/3._dp/cell%deth pv_scalar = cp_unit_from_cp2k(pv_scalar, "bar") @@ -357,17 +357,17 @@ SUBROUTINE md_write_output(md_env) ! Computing the Hugoniot for NPH calculations IF (simpar%ensemble == nph_uniaxial_ensemble .OR. & simpar%ensemble == nph_uniaxial_damped_ensemble) THEN - IF (simpar%e0 == 0._dp) simpar%e0 = md_ener%epot+md_ener%ekin - hugoniot = md_ener%epot+md_ener%ekin-simpar%e0-0.5_dp*(pv_xx_nc+simpar%p0)* & - (simpar%v0-cell%deth) + IF (simpar%e0 == 0._dp) simpar%e0 = md_ener%epot + md_ener%ekin + hugoniot = md_ener%epot + md_ener%ekin - simpar%e0 - 0.5_dp*(pv_xx_nc + simpar%p0)* & + (simpar%v0 - cell%deth) ENDIF IF (simpar%ensemble == reftraj_ensemble) reftraj%init = init ELSE ! Performing protocol for anything beyond the first step of MD IF (simpar%ensemble == nph_uniaxial_ensemble .OR. simpar%ensemble == nph_uniaxial_damped_ensemble) THEN - hugoniot = md_ener%epot+md_ener%ekin-simpar%e0-0.5_dp*(pv_xx_nc+simpar%p0)* & - (simpar%v0-cell%deth) + hugoniot = md_ener%epot + md_ener%ekin - simpar%e0 - 0.5_dp*(pv_xx_nc + simpar%p0)* & + (simpar%v0 - cell%deth) END IF IF (simpar%ensemble == reftraj_ensemble) THEN diff --git a/src/motion/md_environment_types.F b/src/motion/md_environment_types.F index a23646e935..4ce91575b0 100644 --- a/src/motion/md_environment_types.F +++ b/src/motion/md_environment_types.F @@ -108,7 +108,7 @@ SUBROUTINE md_env_create(md_env, md_section, para_env, force_env) TYPE(section_vals_type), POINTER :: averages_section ALLOCATE (md_env) - last_md_env_id = last_md_env_id+1 + last_md_env_id = last_md_env_id + 1 md_env%id_nr = last_md_env_id md_env%ref_count = 1 @@ -159,7 +159,7 @@ SUBROUTINE md_env_release(md_env) IF (ASSOCIATED(md_env)) THEN CPASSERT(md_env%ref_count > 0) - md_env%ref_count = md_env%ref_count-1 + md_env%ref_count = md_env%ref_count - 1 IF (md_env%ref_count == 0) THEN CALL fe_env_release(md_env%fe_env) CALL cp_para_env_release(md_env%para_env) diff --git a/src/motion/md_run.F b/src/motion/md_run.F index f8279022bf..efe2989a71 100644 --- a/src/motion/md_run.F +++ b/src/motion/md_run.F @@ -387,9 +387,9 @@ SUBROUTINE qs_mol_dyn_low(md_env, md_section, motion_section, force_env, globenv IF (force_env%meta_env%well_tempered) THEN force_env%meta_env%wttemperature = simpar%temp_ext IF (force_env%meta_env%wtgamma > EPSILON(1._dp)) THEN - dummy = force_env%meta_env%wttemperature*(force_env%meta_env%wtgamma-1._dp) + dummy = force_env%meta_env%wttemperature*(force_env%meta_env%wtgamma - 1._dp) IF (force_env%meta_env%delta_t > EPSILON(1._dp)) THEN - check = ABS(force_env%meta_env%delta_t-dummy) < 1.E+3_dp*EPSILON(1._dp) + check = ABS(force_env%meta_env%delta_t - dummy) < 1.E+3_dp*EPSILON(1._dp) IF (.NOT. check) & CALL cp_abort(__LOCATION__, & "Inconsistency between DELTA_T and WTGAMMA (both specified):"// & @@ -399,7 +399,7 @@ SUBROUTINE qs_mol_dyn_low(md_env, md_section, motion_section, force_env, globenv ENDIF ELSE force_env%meta_env%wtgamma = 1._dp & - +force_env%meta_env%delta_t/force_env%meta_env%wttemperature + + force_env%meta_env%delta_t/force_env%meta_env%wttemperature ENDIF force_env%meta_env%invdt = 1._dp/force_env%meta_env%delta_t ENDIF @@ -427,7 +427,7 @@ SUBROUTINE qs_mol_dyn_low(md_env, md_section, motion_section, force_env, globenv ELSE CALL get_md_env(md_env, reftraj=reftraj) CALL initialize_reftraj(reftraj, reftraj_section, md_env) - itimes = reftraj%info%first_snapshot-1 + itimes = reftraj%info%first_snapshot - 1 md_stride = reftraj%info%stride IF (ASSOCIATED(force_env%meta_env)) THEN IF (force_env%meta_env%use_plumed .EQV. .TRUE.) THEN @@ -450,8 +450,8 @@ SUBROUTINE qs_mol_dyn_low(md_env, md_section, motion_section, force_env, globenv ! Real MD Loop DO istep = 1, simpar%nsteps, md_stride ! Increase counters - itimes = itimes+1 - time = time+simpar%dt + itimes = itimes + 1 + time = time + simpar%dt !needed when electric field fields are applied IF (ASSOCIATED(force_env%qs_env)) THEN force_env%qs_env%sim_time = time @@ -529,7 +529,7 @@ SUBROUTINE qs_mol_dyn_low(md_env, md_section, motion_section, force_env, globenv END IF time_iter_stop = m_walltime() - used_time = time_iter_stop-time_iter_start + used_time = time_iter_stop - time_iter_start time_iter_start = time_iter_stop CALL md_output(md_env, md_section, force_env%root_section, should_stop) diff --git a/src/motion/md_vel_utils.F b/src/motion/md_vel_utils.F index 6235aac269..39b79d9ba2 100644 --- a/src/motion/md_vel_utils.F +++ b/src/motion/md_vel_utils.F @@ -81,16 +81,15 @@ MODULE md_vel_utils thermal_regions_type #include "../base/base_uses.f90" - IMPLICIT NONE + IMPLICIT NONE - PRIVATE + PRIVATE CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'md_vel_utils' - - PUBLIC :: temperature_control,& - comvel_control,& - angvel_control,& - setup_velocities + PUBLIC :: temperature_control, & + comvel_control, & + angvel_control, & + setup_velocities CONTAINS @@ -104,7 +103,7 @@ MODULE md_vel_utils !> 2007-11-6: created !> \author Toon Verstraelen ! ************************************************************************************************** - SUBROUTINE compute_rcom(part,is_fixed,rcom) + SUBROUTINE compute_rcom(part, is_fixed, rcom) TYPE(particle_type), DIMENSION(:), POINTER :: part INTEGER, DIMENSION(:), INTENT(IN) :: is_fixed REAL(KIND=dp), DIMENSION(3), INTENT(OUT) :: rcom @@ -115,22 +114,22 @@ SUBROUTINE compute_rcom(part,is_fixed,rcom) REAL(KIND=dp) :: denom, mass TYPE(atomic_kind_type), POINTER :: atomic_kind - rcom(:) = 0.0_dp - denom = 0.0_dp - DO i = 1, SIZE(part) - atomic_kind => part(i)%atomic_kind - CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) - SELECT CASE(is_fixed(i)) - CASE(use_perd_x,use_perd_y,use_perd_z,use_perd_xy,use_perd_xz,use_perd_yz,use_perd_none) - rcom(1) = rcom(1) + part(i)%r(1) * mass - rcom(2) = rcom(2) + part(i)%r(2) * mass - rcom(3) = rcom(3) + part(i)%r(3) * mass - denom = denom + mass - END SELECT - END DO - rcom = rcom/denom - - END SUBROUTINE compute_rcom + rcom(:) = 0.0_dp + denom = 0.0_dp + DO i = 1, SIZE(part) + atomic_kind => part(i)%atomic_kind + CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) + SELECT CASE (is_fixed(i)) + CASE (use_perd_x, use_perd_y, use_perd_z, use_perd_xy, use_perd_xz, use_perd_yz, use_perd_none) + rcom(1) = rcom(1) + part(i)%r(1)*mass + rcom(2) = rcom(2) + part(i)%r(2)*mass + rcom(3) = rcom(3) + part(i)%r(3)*mass + denom = denom + mass + END SELECT + END DO + rcom = rcom/denom + + END SUBROUTINE compute_rcom ! ************************************************************************************************** !> \brief compute center of mass velocity @@ -143,7 +142,7 @@ END SUBROUTINE compute_rcom !> 2007-11-6: created !> \author Toon Verstraelen ! ************************************************************************************************** - SUBROUTINE compute_vcom(part,is_fixed,vcom,ecom) + SUBROUTINE compute_vcom(part, is_fixed, vcom, ecom) TYPE(particle_type), DIMENSION(:), POINTER :: part INTEGER, DIMENSION(:), INTENT(IN) :: is_fixed REAL(KIND=dp), DIMENSION(3), INTENT(OUT) :: vcom @@ -155,27 +154,27 @@ SUBROUTINE compute_vcom(part,is_fixed,vcom,ecom) REAL(KIND=dp) :: denom, mass TYPE(atomic_kind_type), POINTER :: atomic_kind - vcom = 0.0_dp - denom = 0.0_dp - DO i = 1, SIZE(part) - atomic_kind => part(i)%atomic_kind - CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) - IF (mass.NE.0.0) THEN - SELECT CASE(is_fixed(i)) - CASE(use_perd_x,use_perd_y,use_perd_z,use_perd_xy,use_perd_xz,use_perd_yz,use_perd_none) - vcom(1) = vcom(1) + part(i)%v(1) * mass - vcom(2) = vcom(2) + part(i)%v(2) * mass - vcom(3) = vcom(3) + part(i)%v(3) * mass - denom = denom + mass - END SELECT - END IF - END DO - vcom = vcom/denom - IF (PRESENT(ecom)) THEN - ecom = 0.5_dp*denom*SUM(vcom*vcom) - END IF - - END SUBROUTINE compute_vcom + vcom = 0.0_dp + denom = 0.0_dp + DO i = 1, SIZE(part) + atomic_kind => part(i)%atomic_kind + CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) + IF (mass .NE. 0.0) THEN + SELECT CASE (is_fixed(i)) + CASE (use_perd_x, use_perd_y, use_perd_z, use_perd_xy, use_perd_xz, use_perd_yz, use_perd_none) + vcom(1) = vcom(1) + part(i)%v(1)*mass + vcom(2) = vcom(2) + part(i)%v(2)*mass + vcom(3) = vcom(3) + part(i)%v(3)*mass + denom = denom + mass + END SELECT + END IF + END DO + vcom = vcom/denom + IF (PRESENT(ecom)) THEN + ecom = 0.5_dp*denom*SUM(vcom*vcom) + END IF + + END SUBROUTINE compute_vcom ! ************************************************************************************************** !> \brief Copy atom velocities into core and shell velocities @@ -187,7 +186,7 @@ END SUBROUTINE compute_vcom !> 2007-11-6: created !> \author Toon Verstraelen ! ************************************************************************************************** - SUBROUTINE clone_core_shell_vel(part,shell_part,core_part) + SUBROUTINE clone_core_shell_vel(part, shell_part, core_part) TYPE(particle_type), DIMENSION(:), POINTER :: part, shell_part, core_part CHARACTER(len=*), PARAMETER :: routineN = 'clone_core_shell_vel', & @@ -197,16 +196,16 @@ SUBROUTINE clone_core_shell_vel(part,shell_part,core_part) LOGICAL :: is_shell TYPE(atomic_kind_type), POINTER :: atomic_kind - DO i = 1, SIZE(part) - atomic_kind => part(i)%atomic_kind - CALL get_atomic_kind(atomic_kind=atomic_kind, shell_active=is_shell) - IF (is_shell) THEN - shell_part( part(i)%shell_index )%v(:) = part(i)%v(:) - core_part( part(i)%shell_index )%v(:) = part(i)%v(:) - END IF - END DO + DO i = 1, SIZE(part) + atomic_kind => part(i)%atomic_kind + CALL get_atomic_kind(atomic_kind=atomic_kind, shell_active=is_shell) + IF (is_shell) THEN + shell_part(part(i)%shell_index)%v(:) = part(i)%v(:) + core_part(part(i)%shell_index)%v(:) = part(i)%v(:) + END IF + END DO - END SUBROUTINE clone_core_shell_vel + END SUBROUTINE clone_core_shell_vel ! ************************************************************************************************** !> \brief Compute the kinetic energy. Does not subtract the center of mass kinetic @@ -219,7 +218,7 @@ END SUBROUTINE clone_core_shell_vel !> 2007-11-6: created !> \author Toon Verstraelen ! ************************************************************************************************** - FUNCTION compute_ekin(part,ireg) RESULT(ekin) + FUNCTION compute_ekin(part, ireg) RESULT(ekin) TYPE(particle_type), DIMENSION(:), POINTER :: part INTEGER, INTENT(IN), OPTIONAL :: ireg REAL(KIND=dp) :: ekin @@ -230,25 +229,25 @@ FUNCTION compute_ekin(part,ireg) RESULT(ekin) REAL(KIND=dp) :: mass TYPE(atomic_kind_type), POINTER :: atomic_kind - NULLIFY(atomic_kind) - ekin = 0.0_dp - IF(PRESENT(ireg)) THEN - DO i = 1, SIZE(part) - IF(part(i)%t_region_index==ireg) THEN - atomic_kind => part(i)%atomic_kind - CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) - ekin = ekin + 0.5_dp * mass * SUM(part(i)%v(:) * part(i)%v(:)) - END IF - END DO - ELSE - DO i = 1, SIZE(part) - atomic_kind => part(i)%atomic_kind - CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) - ekin = ekin + 0.5_dp * mass * SUM(part(i)%v(:) * part(i)%v(:)) - END DO - END IF + NULLIFY (atomic_kind) + ekin = 0.0_dp + IF (PRESENT(ireg)) THEN + DO i = 1, SIZE(part) + IF (part(i)%t_region_index == ireg) THEN + atomic_kind => part(i)%atomic_kind + CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) + ekin = ekin + 0.5_dp*mass*SUM(part(i)%v(:)*part(i)%v(:)) + END IF + END DO + ELSE + DO i = 1, SIZE(part) + atomic_kind => part(i)%atomic_kind + CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) + ekin = ekin + 0.5_dp*mass*SUM(part(i)%v(:)*part(i)%v(:)) + END DO + END IF - END FUNCTION compute_ekin + END FUNCTION compute_ekin ! ************************************************************************************************** !> \brief Rescale the velocity to mimic the given external kinetic temperature. @@ -265,7 +264,7 @@ END FUNCTION compute_ekin !> 2007-11-6: created !> \author Toon Verstraelen ! ************************************************************************************************** - SUBROUTINE rescale_vel(part,simpar,ekin,vcom,ireg,nfree,temp) + SUBROUTINE rescale_vel(part, simpar, ekin, vcom, ireg, nfree, temp) TYPE(particle_type), DIMENSION(:), POINTER :: part TYPE(simpar_type), POINTER :: simpar REAL(KIND=dp), INTENT(INOUT) :: ekin @@ -279,43 +278,43 @@ SUBROUTINE rescale_vel(part,simpar,ekin,vcom,ireg,nfree,temp) INTEGER :: i, my_ireg, my_nfree REAL(KIND=dp) :: factor, my_temp - IF(PRESENT(ireg).AND.PRESENT(nfree).AND.PRESENT(temp)) THEN - my_ireg = ireg - my_nfree = nfree - my_temp = temp - ELSEIF(PRESENT(nfree)) THEN - my_ireg = 0 - my_nfree = nfree - my_temp = simpar%temp_ext - ELSE - my_ireg = 0 - my_nfree = simpar%nfree - my_temp = simpar%temp_ext - END IF - IF (my_nfree/=0) THEN - factor = my_temp / ( 2.0_dp * ekin ) * REAL(my_nfree,KIND=dp) - ELSE - factor = 0.0_dp - ENDIF - ! Note: - ! this rescaling is still wrong, it should take the masses into account - ! rescaling is generally not correct, so needs fixing - ekin = ekin * factor - factor = SQRT(factor) - IF(PRESENT(ireg)) THEN - DO i = 1, SIZE(part) - IF(part(i)%t_region_index == my_ireg) part(i)%v(:) = factor*part(i)%v(:) - END DO - ELSE - DO i = 1, SIZE(part) - part(i)%v(:) = factor*part(i)%v(:) - END DO - IF (PRESENT(vcom)) THEN - vcom = factor*vcom + IF (PRESENT(ireg) .AND. PRESENT(nfree) .AND. PRESENT(temp)) THEN + my_ireg = ireg + my_nfree = nfree + my_temp = temp + ELSEIF (PRESENT(nfree)) THEN + my_ireg = 0 + my_nfree = nfree + my_temp = simpar%temp_ext + ELSE + my_ireg = 0 + my_nfree = simpar%nfree + my_temp = simpar%temp_ext + END IF + IF (my_nfree /= 0) THEN + factor = my_temp/(2.0_dp*ekin)*REAL(my_nfree, KIND=dp) + ELSE + factor = 0.0_dp + ENDIF + ! Note: + ! this rescaling is still wrong, it should take the masses into account + ! rescaling is generally not correct, so needs fixing + ekin = ekin*factor + factor = SQRT(factor) + IF (PRESENT(ireg)) THEN + DO i = 1, SIZE(part) + IF (part(i)%t_region_index == my_ireg) part(i)%v(:) = factor*part(i)%v(:) + END DO + ELSE + DO i = 1, SIZE(part) + part(i)%v(:) = factor*part(i)%v(:) + END DO + IF (PRESENT(vcom)) THEN + vcom = factor*vcom + END IF END IF - END IF - END SUBROUTINE rescale_vel + END SUBROUTINE rescale_vel ! ************************************************************************************************** !> \brief Rescale the velocity of separated regions independently @@ -326,7 +325,7 @@ END SUBROUTINE rescale_vel !> 2008-11 !> \author MI ! ************************************************************************************************** - SUBROUTINE rescale_vel_region(part,md_env,simpar) + SUBROUTINE rescale_vel_region(part, md_env, simpar) TYPE(particle_type), DIMENSION(:), POINTER :: part TYPE(md_environment_type), POINTER :: md_env @@ -340,31 +339,31 @@ SUBROUTINE rescale_vel_region(part,md_env,simpar) TYPE(thermal_region_type), POINTER :: t_region TYPE(thermal_regions_type), POINTER :: thermal_regions - NULLIFY(thermal_regions, t_region) - - CALL get_md_env(md_env,thermal_regions=thermal_regions) - nfree_done = 0 - DO ireg = 1,thermal_regions%nregions - NULLIFY(t_region) - t_region => thermal_regions%thermal_region(ireg) - nfree = t_region%npart*3 - ekin = compute_ekin(part,ireg) - temp = t_region%temp_expected - CALL rescale_vel(part,simpar,ekin,ireg=ireg,nfree=nfree,temp=temp) - nfree_done = nfree_done+nfree - ekin = compute_ekin(part,ireg) - temp = 2.0_dp* ekin/REAL(nfree,dp)*kelvin - t_region%temperature = temp - END DO - nfree0 = simpar%nfree - nfree_done - IF(nfree0>0) THEN - ekin = compute_ekin(part,0) - CALL rescale_vel(part,simpar,ekin,ireg=0,nfree=nfree0,temp=simpar%temp_ext) - ekin = compute_ekin(part,0) - temp = 2.0_dp* ekin/REAL(nfree0,dp)*kelvin - thermal_regions%temp_reg0 = temp - END IF - END SUBROUTINE rescale_vel_region + NULLIFY (thermal_regions, t_region) + + CALL get_md_env(md_env, thermal_regions=thermal_regions) + nfree_done = 0 + DO ireg = 1, thermal_regions%nregions + NULLIFY (t_region) + t_region => thermal_regions%thermal_region(ireg) + nfree = t_region%npart*3 + ekin = compute_ekin(part, ireg) + temp = t_region%temp_expected + CALL rescale_vel(part, simpar, ekin, ireg=ireg, nfree=nfree, temp=temp) + nfree_done = nfree_done + nfree + ekin = compute_ekin(part, ireg) + temp = 2.0_dp*ekin/REAL(nfree, dp)*kelvin + t_region%temperature = temp + END DO + nfree0 = simpar%nfree - nfree_done + IF (nfree0 > 0) THEN + ekin = compute_ekin(part, 0) + CALL rescale_vel(part, simpar, ekin, ireg=0, nfree=nfree0, temp=simpar%temp_ext) + ekin = compute_ekin(part, 0) + temp = 2.0_dp*ekin/REAL(nfree0, dp)*kelvin + thermal_regions%temp_reg0 = temp + END IF + END SUBROUTINE rescale_vel_region ! ************************************************************************************************** !> \brief subtract center of mass velocity @@ -376,7 +375,7 @@ END SUBROUTINE rescale_vel_region !> 2007-11-6: created !> \author Toon Verstraelen ! ************************************************************************************************** - SUBROUTINE subtract_vcom(part,is_fixed,vcom) + SUBROUTINE subtract_vcom(part, is_fixed, vcom) TYPE(particle_type), DIMENSION(:), POINTER :: part INTEGER, DIMENSION(:), INTENT(IN) :: is_fixed REAL(KIND=dp), DIMENSION(3), INTENT(IN) :: vcom @@ -385,28 +384,28 @@ SUBROUTINE subtract_vcom(part,is_fixed,vcom) INTEGER :: i - DO i = 1, SIZE(part) - SELECT CASE(is_fixed(i)) - CASE(use_perd_x) - part(i)%v(2) = part(i)%v(2) - vcom(2) - part(i)%v(3) = part(i)%v(3) - vcom(3) - CASE(use_perd_y) - part(i)%v(1) = part(i)%v(1) - vcom(1) - part(i)%v(3) = part(i)%v(3) - vcom(3) - CASE(use_perd_z) - part(i)%v(1) = part(i)%v(1) - vcom(1) - part(i)%v(2) = part(i)%v(2) - vcom(2) - CASE(use_perd_xy) - part(i)%v(3) = part(i)%v(3) - vcom(3) - CASE(use_perd_xz) - part(i)%v(2) = part(i)%v(2) - vcom(2) - CASE(use_perd_yz) - part(i)%v(1) = part(i)%v(1) - vcom(1) - CASE(use_perd_none) - part(i)%v(:) = part(i)%v(:) - vcom(:) - END SELECT - END DO - END SUBROUTINE subtract_vcom + DO i = 1, SIZE(part) + SELECT CASE (is_fixed(i)) + CASE (use_perd_x) + part(i)%v(2) = part(i)%v(2) - vcom(2) + part(i)%v(3) = part(i)%v(3) - vcom(3) + CASE (use_perd_y) + part(i)%v(1) = part(i)%v(1) - vcom(1) + part(i)%v(3) = part(i)%v(3) - vcom(3) + CASE (use_perd_z) + part(i)%v(1) = part(i)%v(1) - vcom(1) + part(i)%v(2) = part(i)%v(2) - vcom(2) + CASE (use_perd_xy) + part(i)%v(3) = part(i)%v(3) - vcom(3) + CASE (use_perd_xz) + part(i)%v(2) = part(i)%v(2) - vcom(2) + CASE (use_perd_yz) + part(i)%v(1) = part(i)%v(1) - vcom(1) + CASE (use_perd_none) + part(i)%v(:) = part(i)%v(:) - vcom(:) + END SELECT + END DO + END SUBROUTINE subtract_vcom ! ************************************************************************************************** !> \brief compute the angular velocity @@ -419,7 +418,7 @@ END SUBROUTINE subtract_vcom !> 2007-11-9: created !> \author Toon Verstraelen ! ************************************************************************************************** - SUBROUTINE compute_vang(part,is_fixed,rcom,vang) + SUBROUTINE compute_vang(part, is_fixed, rcom, vang) TYPE(particle_type), DIMENSION(:), POINTER :: part INTEGER, DIMENSION(:), INTENT(IN) :: is_fixed REAL(KIND=dp), DIMENSION(3), INTENT(IN) :: rcom @@ -433,49 +432,49 @@ SUBROUTINE compute_vang(part,is_fixed,rcom,vang) REAL(KIND=dp), DIMENSION(3, 3) :: iner TYPE(atomic_kind_type), POINTER :: atomic_kind - NULLIFY(atomic_kind) - mang(:) = 0.0_dp - iner(:,:) = 0.0_dp - DO i=1,SIZE(part) - ! compute angular momentum and inertia tensor - SELECT CASE(is_fixed(i)) - CASE(use_perd_x,use_perd_y,use_perd_z,use_perd_xy,use_perd_xz,use_perd_yz,use_perd_none) - r(:) = part(i)%r(:) - rcom(:) - atomic_kind => part(i)%atomic_kind - CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) - mang(1) = mang(1) + mass*(r(2)*part(i)%v(3) - r(3)*part(i)%v(2)) - mang(2) = mang(2) + mass*(r(3)*part(i)%v(1) - r(1)*part(i)%v(3)) - mang(3) = mang(3) + mass*(r(1)*part(i)%v(2) - r(2)*part(i)%v(1)) - - iner(1,1) = iner(1,1) + mass*(r(2)*r(2) + r(3)*r(3)) - iner(2,2) = iner(2,2) + mass*(r(3)*r(3) + r(1)*r(1)) - iner(3,3) = iner(3,3) + mass*(r(1)*r(1) + r(2)*r(2)) - - iner(1,2) = iner(1,2) - mass*r(1)*r(2) - iner(2,3) = iner(2,3) - mass*r(2)*r(3) - iner(3,1) = iner(3,1) - mass*r(3)*r(1) - END SELECT - END DO - iner(2,1) = iner(1,2) - iner(3,2) = iner(2,3) - iner(1,3) = iner(3,1) - - ! Take the safest route, i.e. diagonalize the inertia tensor and solve - ! the angular velocity only with the non-zero eigenvalues. A plain inversion - ! would fail for linear molecules. - CALL diamat_all(iner, evals) - - vang(:) = 0.0_dp - DO i=1,3 - IF (evals(i) > 0.0_dp) THEN - proj = SUM(iner(:,i)*mang)/evals(i) - vang(1) = vang(1) + proj*iner(1,i) - vang(2) = vang(2) + proj*iner(2,i) - vang(3) = vang(3) + proj*iner(3,i) - END IF - END DO - - END SUBROUTINE compute_vang + NULLIFY (atomic_kind) + mang(:) = 0.0_dp + iner(:, :) = 0.0_dp + DO i = 1, SIZE(part) + ! compute angular momentum and inertia tensor + SELECT CASE (is_fixed(i)) + CASE (use_perd_x, use_perd_y, use_perd_z, use_perd_xy, use_perd_xz, use_perd_yz, use_perd_none) + r(:) = part(i)%r(:) - rcom(:) + atomic_kind => part(i)%atomic_kind + CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) + mang(1) = mang(1) + mass*(r(2)*part(i)%v(3) - r(3)*part(i)%v(2)) + mang(2) = mang(2) + mass*(r(3)*part(i)%v(1) - r(1)*part(i)%v(3)) + mang(3) = mang(3) + mass*(r(1)*part(i)%v(2) - r(2)*part(i)%v(1)) + + iner(1, 1) = iner(1, 1) + mass*(r(2)*r(2) + r(3)*r(3)) + iner(2, 2) = iner(2, 2) + mass*(r(3)*r(3) + r(1)*r(1)) + iner(3, 3) = iner(3, 3) + mass*(r(1)*r(1) + r(2)*r(2)) + + iner(1, 2) = iner(1, 2) - mass*r(1)*r(2) + iner(2, 3) = iner(2, 3) - mass*r(2)*r(3) + iner(3, 1) = iner(3, 1) - mass*r(3)*r(1) + END SELECT + END DO + iner(2, 1) = iner(1, 2) + iner(3, 2) = iner(2, 3) + iner(1, 3) = iner(3, 1) + + ! Take the safest route, i.e. diagonalize the inertia tensor and solve + ! the angular velocity only with the non-zero eigenvalues. A plain inversion + ! would fail for linear molecules. + CALL diamat_all(iner, evals) + + vang(:) = 0.0_dp + DO i = 1, 3 + IF (evals(i) > 0.0_dp) THEN + proj = SUM(iner(:, i)*mang)/evals(i) + vang(1) = vang(1) + proj*iner(1, i) + vang(2) = vang(2) + proj*iner(2, i) + vang(3) = vang(3) + proj*iner(3, i) + END IF + END DO + + END SUBROUTINE compute_vang ! ************************************************************************************************** !> \brief subtract the angular velocity @@ -488,7 +487,7 @@ END SUBROUTINE compute_vang !> 2007-11-9: created !> \author Toon Verstraelen ! ************************************************************************************************** - SUBROUTINE subtract_vang(part,is_fixed,rcom,vang) + SUBROUTINE subtract_vang(part, is_fixed, rcom, vang) TYPE(particle_type), DIMENSION(:), POINTER :: part INTEGER, DIMENSION(:), INTENT(IN) :: is_fixed REAL(KIND=dp), DIMENSION(3), INTENT(IN) :: rcom, vang @@ -498,32 +497,32 @@ SUBROUTINE subtract_vang(part,is_fixed,rcom,vang) INTEGER :: i REAL(KIND=dp), DIMENSION(3) :: r - DO i=1,SIZE(part) - r(:) = part(i)%r(:) - rcom(:) - SELECT CASE(is_fixed(i)) - CASE(use_perd_x) - part(i)%v(2) = part(i)%v(2) - (vang(3)*r(1) - vang(1)*r(3)) - part(i)%v(3) = part(i)%v(3) - (vang(1)*r(2) - vang(2)*r(1)) - CASE(use_perd_y) - part(i)%v(1) = part(i)%v(1) - (vang(2)*r(3) - vang(3)*r(2)) - part(i)%v(3) = part(i)%v(3) - (vang(1)*r(2) - vang(2)*r(1)) - CASE(use_perd_z) - part(i)%v(1) = part(i)%v(1) - (vang(2)*r(3) - vang(3)*r(2)) - part(i)%v(2) = part(i)%v(2) - (vang(3)*r(1) - vang(1)*r(3)) - CASE(use_perd_xy) - part(i)%v(3) = part(i)%v(3) - (vang(1)*r(2) - vang(2)*r(1)) - CASE(use_perd_xz) - part(i)%v(2) = part(i)%v(2) - (vang(3)*r(1) - vang(1)*r(3)) - CASE(use_perd_yz) - part(i)%v(1) = part(i)%v(1) - (vang(2)*r(3) - vang(3)*r(2)) - CASE(use_perd_none) - part(i)%v(1) = part(i)%v(1) - (vang(2)*r(3) - vang(3)*r(2)) - part(i)%v(2) = part(i)%v(2) - (vang(3)*r(1) - vang(1)*r(3)) - part(i)%v(3) = part(i)%v(3) - (vang(1)*r(2) - vang(2)*r(1)) - END SELECT - END DO - - END SUBROUTINE subtract_vang + DO i = 1, SIZE(part) + r(:) = part(i)%r(:) - rcom(:) + SELECT CASE (is_fixed(i)) + CASE (use_perd_x) + part(i)%v(2) = part(i)%v(2) - (vang(3)*r(1) - vang(1)*r(3)) + part(i)%v(3) = part(i)%v(3) - (vang(1)*r(2) - vang(2)*r(1)) + CASE (use_perd_y) + part(i)%v(1) = part(i)%v(1) - (vang(2)*r(3) - vang(3)*r(2)) + part(i)%v(3) = part(i)%v(3) - (vang(1)*r(2) - vang(2)*r(1)) + CASE (use_perd_z) + part(i)%v(1) = part(i)%v(1) - (vang(2)*r(3) - vang(3)*r(2)) + part(i)%v(2) = part(i)%v(2) - (vang(3)*r(1) - vang(1)*r(3)) + CASE (use_perd_xy) + part(i)%v(3) = part(i)%v(3) - (vang(1)*r(2) - vang(2)*r(1)) + CASE (use_perd_xz) + part(i)%v(2) = part(i)%v(2) - (vang(3)*r(1) - vang(1)*r(3)) + CASE (use_perd_yz) + part(i)%v(1) = part(i)%v(1) - (vang(2)*r(3) - vang(3)*r(2)) + CASE (use_perd_none) + part(i)%v(1) = part(i)%v(1) - (vang(2)*r(3) - vang(3)*r(2)) + part(i)%v(2) = part(i)%v(2) - (vang(3)*r(1) - vang(1)*r(3)) + part(i)%v(3) = part(i)%v(3) - (vang(1)*r(2) - vang(2)*r(1)) + END SELECT + END DO + + END SUBROUTINE subtract_vang ! ************************************************************************************************** !> \brief Initializes the velocities to the Maxwellian distribution @@ -548,21 +547,21 @@ END SUBROUTINE subtract_vang !> - 2007-11-09: Added angvel_zero feature !> \author CJM,MK,Toon Verstraelen ! ************************************************************************************************** - SUBROUTINE initialize_velocities(simpar, & - part, & - force_env, & - globenv, & - md_env, & - molecule_kinds, & - label, & - print_section, & - subsys_section, & - shell_present,& - shell_part, & - core_part, & - force_rescaling, & - para_env, & - write_binary_restart_file) + SUBROUTINE initialize_velocities(simpar, & + part, & + force_env, & + globenv, & + md_env, & + molecule_kinds, & + label, & + print_section, & + subsys_section, & + shell_present, & + shell_part, & + core_part, & + force_rescaling, & + para_env, & + write_binary_restart_file) TYPE(simpar_type), POINTER :: simpar TYPE(particle_type), DIMENSION(:), POINTER :: part @@ -596,106 +595,105 @@ SUBROUTINE initialize_velocities(simpar, & TYPE(molecule_kind_type), POINTER :: molecule_kind TYPE(section_vals_type), POINTER :: md_section, root_section, vib_section - CALL timeset(routineN,handle) - - ! Initializing parameters - natoms = SIZE(part) - NULLIFY (atomic_kind, fixd_list, logger, molecule_kind) - NULLIFY (molecule_kind_set) - - ! Logging - logger => cp_get_default_logger() - iw=cp_print_key_unit_nr(logger,print_section,"PROGRAM_RUN_INFO",extension=".log") - IF (iw>0) THEN - num_x = (79-LEN_TRIM(ADJUSTL(label))-2)/2 - WRITE(my_format,'(A,I0,A,I0,A)')'(1X,',num_x,'("*"),1X,A,1X,',num_x,'("*"))' - WRITE ( iw, TRIM(my_format))TRIM(ADJUSTL(label)) - END IF - - ! Build a list of all fixed atoms (if any) - ALLOCATE (is_fixed(natoms)) - - is_fixed = use_perd_none - molecule_kind_set => molecule_kinds%els - DO imolecule_kind=1,molecule_kinds%n_els - molecule_kind => molecule_kind_set(imolecule_kind) - CALL get_molecule_kind(molecule_kind=molecule_kind,fixd_list=fixd_list) - IF (ASSOCIATED(fixd_list)) THEN - DO ifixd=1,SIZE(fixd_list) - IF (.NOT.fixd_list(ifixd)%restraint%active) is_fixed(fixd_list(ifixd)%fixd) = fixd_list(ifixd)%itype - END DO - END IF - END DO - - ! Compute the total mass when needed - IF ( simpar%ensemble == nph_uniaxial_ensemble .OR.& - simpar%ensemble == nph_uniaxial_damped_ensemble ) THEN - mass_tot = 0.0_dp - DO i = 1, natoms - atomic_kind => part(i)%atomic_kind - CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) - mass_tot = mass_tot + mass - END DO - simpar%v_shock = simpar%v_shock * SQRT ( mass_tot ) - END IF - - CALL read_input_velocities(simpar, part, force_env, md_env, subsys_section,& - shell_present, shell_part, core_part, force_rescaling, para_env, is_fixed, success) - IF (.NOT.success) THEN - SELECT CASE (simpar%initialization_method) - CASE (md_init_default) - CALL generate_velocities(simpar, part, force_env, globenv, md_env, shell_present,& - shell_part, core_part, is_fixed, iw) - CASE (md_init_vib) - CALL force_env_get(force_env=force_env, root_section=root_section) - md_section => section_vals_get_subs_vals(root_section, "MOTION%MD") - vib_section => section_vals_get_subs_vals(root_section, "VIBRATIONAL_ANALYSIS") - CALL generate_coords_vels_vib(simpar, & - part, & - md_section, & - vib_section, & - force_env, & - globenv, & - shell_present, & - shell_part, & - core_part, & - is_fixed) - ! update restart file for the modified coordinates and velocities - CALL update_subsys(subsys_section, force_env, .FALSE., write_binary_restart_file) - END SELECT - END IF - - IF (iw>0) THEN - ! Recompute vcom, ecom and ekin for IO - CALL compute_vcom(part,is_fixed,vcom,ecom) - ekin = compute_ekin(part) - ecom - IF (simpar%nfree == 0) THEN - CPASSERT(ekin==0.0_dp) - temp = 0.0_dp - ELSE - temp = 2.0_dp * ekin / REAL ( simpar%nfree,KIND=dp) - END IF - tmp_r1 = cp_unit_from_cp2k(temp,"K") - WRITE (iw, '( A, T61, F18.2, A2 )' ) ' Initial Temperature ', tmp_r1, " K" - WRITE (iw, '( A, T21, F20.12 , F20.12 , F20.12 )' ) ' COM velocity:', vcom ( 1 ), vcom ( 2 ), vcom ( 3 ) - - ! compute and log rcom and vang if not periodic - CALL force_env_get(force_env, cell=cell) - IF (SUM(cell%perd(1:3)) == 0) THEN - CALL compute_rcom(part,is_fixed,rcom) - CALL compute_vang(part,is_fixed,rcom,vang) - WRITE (iw, '( A, T21, F20.12 , F20.12 , F20.12 )' ) ' COM position:', rcom ( 1 ), rcom ( 2 ), rcom ( 3 ) - WRITE (iw, '( A, T21, F20.12 , F20.12 , F20.12 )' ) ' Angular velocity:', vang ( 1 ), vang ( 2 ), vang ( 3 ) - END IF - WRITE ( iw, '( 1X,79("*"),/)' ) - END IF - - DEALLOCATE (is_fixed) - CALL cp_print_key_finished_output(iw,logger,print_section,"PROGRAM_RUN_INFO") - CALL timestop(handle) - - END SUBROUTINE initialize_velocities + CALL timeset(routineN, handle) + + ! Initializing parameters + natoms = SIZE(part) + NULLIFY (atomic_kind, fixd_list, logger, molecule_kind) + NULLIFY (molecule_kind_set) + + ! Logging + logger => cp_get_default_logger() + iw = cp_print_key_unit_nr(logger, print_section, "PROGRAM_RUN_INFO", extension=".log") + IF (iw > 0) THEN + num_x = (79 - LEN_TRIM(ADJUSTL(label)) - 2)/2 + WRITE (my_format, '(A,I0,A,I0,A)') '(1X,', num_x, '("*"),1X,A,1X,', num_x, '("*"))' + WRITE (iw, TRIM(my_format)) TRIM(ADJUSTL(label)) + END IF + + ! Build a list of all fixed atoms (if any) + ALLOCATE (is_fixed(natoms)) + + is_fixed = use_perd_none + molecule_kind_set => molecule_kinds%els + DO imolecule_kind = 1, molecule_kinds%n_els + molecule_kind => molecule_kind_set(imolecule_kind) + CALL get_molecule_kind(molecule_kind=molecule_kind, fixd_list=fixd_list) + IF (ASSOCIATED(fixd_list)) THEN + DO ifixd = 1, SIZE(fixd_list) + IF (.NOT. fixd_list(ifixd)%restraint%active) is_fixed(fixd_list(ifixd)%fixd) = fixd_list(ifixd)%itype + END DO + END IF + END DO + + ! Compute the total mass when needed + IF (simpar%ensemble == nph_uniaxial_ensemble .OR. & + simpar%ensemble == nph_uniaxial_damped_ensemble) THEN + mass_tot = 0.0_dp + DO i = 1, natoms + atomic_kind => part(i)%atomic_kind + CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) + mass_tot = mass_tot + mass + END DO + simpar%v_shock = simpar%v_shock*SQRT(mass_tot) + END IF + + CALL read_input_velocities(simpar, part, force_env, md_env, subsys_section, & + shell_present, shell_part, core_part, force_rescaling, para_env, is_fixed, success) + IF (.NOT. success) THEN + SELECT CASE (simpar%initialization_method) + CASE (md_init_default) + CALL generate_velocities(simpar, part, force_env, globenv, md_env, shell_present, & + shell_part, core_part, is_fixed, iw) + CASE (md_init_vib) + CALL force_env_get(force_env=force_env, root_section=root_section) + md_section => section_vals_get_subs_vals(root_section, "MOTION%MD") + vib_section => section_vals_get_subs_vals(root_section, "VIBRATIONAL_ANALYSIS") + CALL generate_coords_vels_vib(simpar, & + part, & + md_section, & + vib_section, & + force_env, & + globenv, & + shell_present, & + shell_part, & + core_part, & + is_fixed) + ! update restart file for the modified coordinates and velocities + CALL update_subsys(subsys_section, force_env, .FALSE., write_binary_restart_file) + END SELECT + END IF + + IF (iw > 0) THEN + ! Recompute vcom, ecom and ekin for IO + CALL compute_vcom(part, is_fixed, vcom, ecom) + ekin = compute_ekin(part) - ecom + IF (simpar%nfree == 0) THEN + CPASSERT(ekin == 0.0_dp) + temp = 0.0_dp + ELSE + temp = 2.0_dp*ekin/REAL(simpar%nfree, KIND=dp) + END IF + tmp_r1 = cp_unit_from_cp2k(temp, "K") + WRITE (iw, '( A, T61, F18.2, A2 )') ' Initial Temperature ', tmp_r1, " K" + WRITE (iw, '( A, T21, F20.12 , F20.12 , F20.12 )') ' COM velocity:', vcom(1), vcom(2), vcom(3) + + ! compute and log rcom and vang if not periodic + CALL force_env_get(force_env, cell=cell) + IF (SUM(cell%perd(1:3)) == 0) THEN + CALL compute_rcom(part, is_fixed, rcom) + CALL compute_vang(part, is_fixed, rcom, vang) + WRITE (iw, '( A, T21, F20.12 , F20.12 , F20.12 )') ' COM position:', rcom(1), rcom(2), rcom(3) + WRITE (iw, '( A, T21, F20.12 , F20.12 , F20.12 )') ' Angular velocity:', vang(1), vang(2), vang(3) + END IF + WRITE (iw, '( 1X,79("*"),/)') + END IF + DEALLOCATE (is_fixed) + CALL cp_print_key_finished_output(iw, logger, print_section, "PROGRAM_RUN_INFO") + CALL timestop(handle) + + END SUBROUTINE initialize_velocities ! ************************************************************************************************** !> \brief Read velocities from binary restart file if available @@ -713,8 +711,8 @@ END SUBROUTINE initialize_velocities !> \param success ... !> \author CJM,MK,Toon Verstraelen ! ************************************************************************************************** - SUBROUTINE read_input_velocities(simpar, part, force_env, md_env, subsys_section,& - shell_present, shell_part, core_part, force_rescaling, para_env, is_fixed, success) + SUBROUTINE read_input_velocities(simpar, part, force_env, md_env, subsys_section, & + shell_present, shell_part, core_part, force_rescaling, para_env, is_fixed, success) TYPE(simpar_type), POINTER :: simpar TYPE(particle_type), DIMENSION(:), POINTER :: part TYPE(force_env_type), POINTER :: force_env @@ -746,136 +744,135 @@ SUBROUTINE read_input_velocities(simpar, part, force_env, md_env, subsys_section ! Initializing parameters - success = .FALSE. - natoms = SIZE(part) - atomvel_read = .FALSE. - corevel_read = .FALSE. - shellvel_read = .FALSE. - NULLIFY (vel, atomic_kind, atom_list, core_list, shell_list) - NULLIFY (atomvel_section,shellvel_section, corevel_section) - NULLIFY (shell, thermal_regions, val) - - - ! Core-Shell Model - nshell = 0 - IF (shell_present) THEN - CPASSERT(ASSOCIATED(core_part)) - CPASSERT(ASSOCIATED(shell_part)) - nshell = SIZE(shell_part) - END IF - - atomvel_section => section_vals_get_subs_vals(subsys_section,"VELOCITY") - shellvel_section => section_vals_get_subs_vals(subsys_section,"SHELL_VELOCITY") - corevel_section => section_vals_get_subs_vals(subsys_section,"CORE_VELOCITY") - - ! Read or initialize the particle velocities - CALL section_vals_get(atomvel_section,explicit=atomvel_explicit) - CALL section_vals_get(shellvel_section,explicit=shellvel_explicit) - CALL section_vals_get(corevel_section,explicit=corevel_explicit) - CPASSERT(shellvel_explicit.EQV.corevel_explicit) - - CALL read_binary_velocities("",part,force_env%root_section,para_env,& - subsys_section,atomvel_read) - CALL read_binary_velocities("SHELL",shell_part,force_env%root_section,para_env,& - subsys_section,shellvel_read) - CALL read_binary_velocities("CORE",core_part,force_env%root_section,para_env,& - subsys_section,corevel_read) - - IF (.NOT.(atomvel_explicit.OR.atomvel_read)) RETURN - success = .TRUE. - - IF (.NOT.atomvel_read) THEN - ! Read the atom velocities if explicitly given in the input file - CALL section_vals_list_get(atomvel_section,"_DEFAULT_KEYWORD_",list=atom_list) - DO i = 1, natoms - is_ok = cp_sll_val_next(atom_list,val) - CALL val_get(val,r_vals=vel) - part(i)%v = vel - END DO - END IF - DO i = 1, natoms - SELECT CASE(is_fixed(i)) - CASE (use_perd_x) - part(i)%v(1) = 0.0_dp - CASE (use_perd_y) - part(i)%v(2) = 0.0_dp - CASE (use_perd_z) - part(i)%v(3) = 0.0_dp - CASE (use_perd_xy) - part(i)%v(1) = 0.0_dp - part(i)%v(2) = 0.0_dp - CASE (use_perd_xz) - part(i)%v(1) = 0.0_dp - part(i)%v(3) = 0.0_dp - CASE (use_perd_yz) - part(i)%v(2) = 0.0_dp - part(i)%v(3) = 0.0_dp - CASE (use_perd_xyz) - part(i)%v = 0.0_dp - END SELECT - END DO - IF (shell_present) THEN - IF (shellvel_explicit) THEN - ! If the atoms positions are given (?) and core and shell velocities are - ! present in the input, read the latter. - CALL section_vals_list_get(shellvel_section,"_DEFAULT_KEYWORD_",list=shell_list) - CALL section_vals_list_get(corevel_section,"_DEFAULT_KEYWORD_",list=core_list) - DO i=1,nshell - is_ok = cp_sll_val_next(shell_list,val) - CALL val_get(val,r_vals=vel) - shell_part(i)%v = vel - is_ok = cp_sll_val_next(core_list,val) - CALL val_get(val,r_vals=vel) - core_part(i)%v = vel - END DO - ELSE - IF (.NOT.(shellvel_read.AND.corevel_read)) THEN - ! Otherwise, just copy atom velocties into shell and core velocities. - CALL clone_core_shell_vel(part,shell_part,core_part) - END IF - END IF - END IF - - ! compute vcom, ecom and ekin - CALL compute_vcom(part,is_fixed,vcom,ecom) - ekin = compute_ekin(part) - ecom - - IF(simpar%do_thermal_region) THEN - CALL get_md_env (md_env, thermal_regions=thermal_regions) - IF(ASSOCIATED(thermal_regions)) THEN - rescale_regions = thermal_regions%force_rescaling - END IF - ELSE - rescale_regions = .FALSE. - END IF - IF (simpar%nfree /= 0 .AND. (force_rescaling .OR. rescale_regions)) THEN - IF(simpar%do_thermal_region) THEN - CALL rescale_vel_region(part,md_env,simpar) - ELSE - CALL rescale_vel(part,simpar,ekin,vcom=vcom) - END IF - - ! After rescaling, the core and shell velocities must also adapt. - DO i = 1, natoms - shell_index = part(i)%shell_index - IF(shell_present .AND. shell_index/=0) THEN - atomic_kind => part(i)%atomic_kind - CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass, shell=shell) - fac_masss = shell%mass_shell/mass - fac_massc = shell%mass_core/mass - vs = shell_part(shell_index)%v - vc = core_part(shell_index)%v - - shell_part(shell_index)%v(1) = part(i)%v(1) + fac_massc*(vs(1)-vc(1)) - shell_part(shell_index)%v(2) = part(i)%v(2) + fac_massc*(vs(2)-vc(2)) - shell_part(shell_index)%v(3) = part(i)%v(3) + fac_massc*(vs(3)-vc(3)) - core_part(shell_index)%v(1) = part(i)%v(1) + fac_masss*(vc(1)-vs(1)) - core_part(shell_index)%v(2) = part(i)%v(2) + fac_masss*(vc(2)-vs(2)) - core_part(shell_index)%v(3) = part(i)%v(3) + fac_masss*(vc(3)-vs(3)) - END IF - END DO - END IF - END SUBROUTINE read_input_velocities + success = .FALSE. + natoms = SIZE(part) + atomvel_read = .FALSE. + corevel_read = .FALSE. + shellvel_read = .FALSE. + NULLIFY (vel, atomic_kind, atom_list, core_list, shell_list) + NULLIFY (atomvel_section, shellvel_section, corevel_section) + NULLIFY (shell, thermal_regions, val) + + ! Core-Shell Model + nshell = 0 + IF (shell_present) THEN + CPASSERT(ASSOCIATED(core_part)) + CPASSERT(ASSOCIATED(shell_part)) + nshell = SIZE(shell_part) + END IF + + atomvel_section => section_vals_get_subs_vals(subsys_section, "VELOCITY") + shellvel_section => section_vals_get_subs_vals(subsys_section, "SHELL_VELOCITY") + corevel_section => section_vals_get_subs_vals(subsys_section, "CORE_VELOCITY") + + ! Read or initialize the particle velocities + CALL section_vals_get(atomvel_section, explicit=atomvel_explicit) + CALL section_vals_get(shellvel_section, explicit=shellvel_explicit) + CALL section_vals_get(corevel_section, explicit=corevel_explicit) + CPASSERT(shellvel_explicit .EQV. corevel_explicit) + + CALL read_binary_velocities("", part, force_env%root_section, para_env, & + subsys_section, atomvel_read) + CALL read_binary_velocities("SHELL", shell_part, force_env%root_section, para_env, & + subsys_section, shellvel_read) + CALL read_binary_velocities("CORE", core_part, force_env%root_section, para_env, & + subsys_section, corevel_read) + + IF (.NOT. (atomvel_explicit .OR. atomvel_read)) RETURN + success = .TRUE. + + IF (.NOT. atomvel_read) THEN + ! Read the atom velocities if explicitly given in the input file + CALL section_vals_list_get(atomvel_section, "_DEFAULT_KEYWORD_", list=atom_list) + DO i = 1, natoms + is_ok = cp_sll_val_next(atom_list, val) + CALL val_get(val, r_vals=vel) + part(i)%v = vel + END DO + END IF + DO i = 1, natoms + SELECT CASE (is_fixed(i)) + CASE (use_perd_x) + part(i)%v(1) = 0.0_dp + CASE (use_perd_y) + part(i)%v(2) = 0.0_dp + CASE (use_perd_z) + part(i)%v(3) = 0.0_dp + CASE (use_perd_xy) + part(i)%v(1) = 0.0_dp + part(i)%v(2) = 0.0_dp + CASE (use_perd_xz) + part(i)%v(1) = 0.0_dp + part(i)%v(3) = 0.0_dp + CASE (use_perd_yz) + part(i)%v(2) = 0.0_dp + part(i)%v(3) = 0.0_dp + CASE (use_perd_xyz) + part(i)%v = 0.0_dp + END SELECT + END DO + IF (shell_present) THEN + IF (shellvel_explicit) THEN + ! If the atoms positions are given (?) and core and shell velocities are + ! present in the input, read the latter. + CALL section_vals_list_get(shellvel_section, "_DEFAULT_KEYWORD_", list=shell_list) + CALL section_vals_list_get(corevel_section, "_DEFAULT_KEYWORD_", list=core_list) + DO i = 1, nshell + is_ok = cp_sll_val_next(shell_list, val) + CALL val_get(val, r_vals=vel) + shell_part(i)%v = vel + is_ok = cp_sll_val_next(core_list, val) + CALL val_get(val, r_vals=vel) + core_part(i)%v = vel + END DO + ELSE + IF (.NOT. (shellvel_read .AND. corevel_read)) THEN + ! Otherwise, just copy atom velocties into shell and core velocities. + CALL clone_core_shell_vel(part, shell_part, core_part) + END IF + END IF + END IF + + ! compute vcom, ecom and ekin + CALL compute_vcom(part, is_fixed, vcom, ecom) + ekin = compute_ekin(part) - ecom + + IF (simpar%do_thermal_region) THEN + CALL get_md_env(md_env, thermal_regions=thermal_regions) + IF (ASSOCIATED(thermal_regions)) THEN + rescale_regions = thermal_regions%force_rescaling + END IF + ELSE + rescale_regions = .FALSE. + END IF + IF (simpar%nfree /= 0 .AND. (force_rescaling .OR. rescale_regions)) THEN + IF (simpar%do_thermal_region) THEN + CALL rescale_vel_region(part, md_env, simpar) + ELSE + CALL rescale_vel(part, simpar, ekin, vcom=vcom) + END IF + + ! After rescaling, the core and shell velocities must also adapt. + DO i = 1, natoms + shell_index = part(i)%shell_index + IF (shell_present .AND. shell_index /= 0) THEN + atomic_kind => part(i)%atomic_kind + CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass, shell=shell) + fac_masss = shell%mass_shell/mass + fac_massc = shell%mass_core/mass + vs = shell_part(shell_index)%v + vc = core_part(shell_index)%v + + shell_part(shell_index)%v(1) = part(i)%v(1) + fac_massc*(vs(1) - vc(1)) + shell_part(shell_index)%v(2) = part(i)%v(2) + fac_massc*(vs(2) - vc(2)) + shell_part(shell_index)%v(3) = part(i)%v(3) + fac_massc*(vs(3) - vc(3)) + core_part(shell_index)%v(1) = part(i)%v(1) + fac_masss*(vc(1) - vs(1)) + core_part(shell_index)%v(2) = part(i)%v(2) + fac_masss*(vc(2) - vs(2)) + core_part(shell_index)%v(3) = part(i)%v(3) + fac_masss*(vc(3) - vs(3)) + END IF + END DO + END IF + END SUBROUTINE read_input_velocities ! ************************************************************************************************** !> \brief Initializing velocities AND positions randomly on all processors, based on vibrational @@ -894,16 +891,16 @@ END SUBROUTINE read_input_velocities !> cartesian components are fixed !> \author CJM,MK,Toon Verstraelen , Ole Schuett ! ************************************************************************************************** - SUBROUTINE generate_coords_vels_vib(simpar, & - particles, & - md_section, & - vib_section, & - force_env, & - global_env, & - shell_present, & - shell_particles, & - core_particles, & - is_fixed) + SUBROUTINE generate_coords_vels_vib(simpar, & + particles, & + md_section, & + vib_section, & + force_env, & + global_env, & + shell_present, & + shell_particles, & + core_particles, & + is_fixed) TYPE(simpar_type), POINTER :: simpar TYPE(particle_type), DIMENSION(:), POINTER :: particles TYPE(section_vals_type), POINTER :: md_section, vib_section @@ -925,152 +922,152 @@ SUBROUTINE generate_coords_vels_vib(simpar, & TYPE(cp_para_env_type), POINTER :: para_env TYPE(rng_stream_type), POINTER :: random_stream - NULLIFY(random_stream) - CALL cite_reference(West2006) - natoms = SIZE(particles) - temperature = simpar%temp_ext - my_dof = 3*natoms - ALLOCATE (eigenvalues(my_dof)) - ALLOCATE (eigenvectors(my_dof,my_dof)) - ALLOCATE (phase(my_dof)) - ALLOCATE (random(my_dof)) - ALLOCATE (dr(3,natoms)) - CALL force_env_get(force_env=force_env, para_env=para_env) - ! read vibration modes - CALL read_vib_eigs_unformatted(md_section, & - vib_section, & - para_env, & - dof, & - eigenvalues, & - eigenvectors) - IF (my_dof .NE. dof) THEN - CALL cp_abort(__LOCATION__, & - "number of degrees of freedom in vibrational analysis data "// & - "do not match total number of cartesian degrees of freedom") - END IF - ! read phases - CALL section_vals_val_get(md_section, "INITIAL_VIBRATION%PHASE", r_val=my_phase) - my_phase = MIN(1.0_dp, my_phase) - ! generate random numbers - CALL create_rng_stream(random_stream, name="MD_INIT_VIB", distribution_type=UNIFORM) - CALL random_numbers(random, random_stream) - IF (my_phase .LT. 0.0_dp) THEN - CALL random_numbers(phase, random_stream) - ELSE - phase = my_phase - END IF - CALL delete_rng_stream(random_stream) - ! the first three modes are acoustic with zero frequencies, - ! exclude these from considerations - my_dof = dof - 3 - ! randomly selects energy from distribution about kT, all - ! energies are scaled so that the sum over vibration modes gives - ! exactly my_dof*kT. Note that k = 1.0 in atomic units - Erand = 0.0_dp - DO imode = 4, dof - Erand = Erand - temperature*LOG(1.0_dp-random(imode)) - END DO - ! need to take into account of fixed constraints too - fixed_dof = 0 - DO iatom = 1, natoms - SELECT CASE (is_fixed(iatom)) - CASE (use_perd_x, use_perd_y, use_perd_z) - fixed_dof = fixed_dof + 1 - CASE (use_perd_xy, use_perd_xz, use_perd_yz) - fixed_dof = fixed_dof + 2 - CASE (use_perd_xyz) - fixed_dof = fixed_dof + 3 - END SELECT - END DO - my_dof = my_dof - fixed_dof - ratio = REAL(my_dof,KIND=dp)*temperature/Erand - ! update velocities AND positions - DO iatom = 1, natoms - atomic_kind => particles(iatom)%atomic_kind - CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) - SELECT CASE (is_fixed(iatom)) - CASE (use_perd_x) - DO ii = 2, 3 - dr(ii, iatom) = dr_from_vib_data(iatom, ii, mass, temperature, eigenvalues, & - eigenvectors, random, phase, dof, ratio) - particles(iatom)%v(ii) = dv_from_vib_data(iatom, ii, mass, temperature, & - eigenvectors, random, phase, dof, & - ratio) - END DO - CASE (use_perd_y) - DO ii = 1, 3, 2 - dr(ii, iatom) = dr_from_vib_data(iatom, ii, mass, temperature, eigenvalues, & - eigenvectors, random, phase, dof, ratio) - particles(iatom)%v(ii) = dv_from_vib_data(iatom, ii, mass, temperature, & - eigenvectors, random, phase, dof, & - ratio) - END DO - CASE (use_perd_z) - DO ii = 1, 2 - dr(ii, iatom) = dr_from_vib_data(iatom, ii, mass, temperature, eigenvalues, & - eigenvectors, random, phase, dof, ratio) - particles(iatom)%v(ii) = dv_from_vib_data(iatom, ii, mass, temperature, & - eigenvectors, random, phase, dof, & - ratio) - END DO - CASE (use_perd_xy) - dr(3, iatom) = dr_from_vib_data(iatom, 3, mass, temperature, eigenvalues, & + NULLIFY (random_stream) + CALL cite_reference(West2006) + natoms = SIZE(particles) + temperature = simpar%temp_ext + my_dof = 3*natoms + ALLOCATE (eigenvalues(my_dof)) + ALLOCATE (eigenvectors(my_dof, my_dof)) + ALLOCATE (phase(my_dof)) + ALLOCATE (random(my_dof)) + ALLOCATE (dr(3, natoms)) + CALL force_env_get(force_env=force_env, para_env=para_env) + ! read vibration modes + CALL read_vib_eigs_unformatted(md_section, & + vib_section, & + para_env, & + dof, & + eigenvalues, & + eigenvectors) + IF (my_dof .NE. dof) THEN + CALL cp_abort(__LOCATION__, & + "number of degrees of freedom in vibrational analysis data "// & + "do not match total number of cartesian degrees of freedom") + END IF + ! read phases + CALL section_vals_val_get(md_section, "INITIAL_VIBRATION%PHASE", r_val=my_phase) + my_phase = MIN(1.0_dp, my_phase) + ! generate random numbers + CALL create_rng_stream(random_stream, name="MD_INIT_VIB", distribution_type=UNIFORM) + CALL random_numbers(random, random_stream) + IF (my_phase .LT. 0.0_dp) THEN + CALL random_numbers(phase, random_stream) + ELSE + phase = my_phase + END IF + CALL delete_rng_stream(random_stream) + ! the first three modes are acoustic with zero frequencies, + ! exclude these from considerations + my_dof = dof - 3 + ! randomly selects energy from distribution about kT, all + ! energies are scaled so that the sum over vibration modes gives + ! exactly my_dof*kT. Note that k = 1.0 in atomic units + Erand = 0.0_dp + DO imode = 4, dof + Erand = Erand - temperature*LOG(1.0_dp - random(imode)) + END DO + ! need to take into account of fixed constraints too + fixed_dof = 0 + DO iatom = 1, natoms + SELECT CASE (is_fixed(iatom)) + CASE (use_perd_x, use_perd_y, use_perd_z) + fixed_dof = fixed_dof + 1 + CASE (use_perd_xy, use_perd_xz, use_perd_yz) + fixed_dof = fixed_dof + 2 + CASE (use_perd_xyz) + fixed_dof = fixed_dof + 3 + END SELECT + END DO + my_dof = my_dof - fixed_dof + ratio = REAL(my_dof, KIND=dp)*temperature/Erand + ! update velocities AND positions + DO iatom = 1, natoms + atomic_kind => particles(iatom)%atomic_kind + CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) + SELECT CASE (is_fixed(iatom)) + CASE (use_perd_x) + DO ii = 2, 3 + dr(ii, iatom) = dr_from_vib_data(iatom, ii, mass, temperature, eigenvalues, & + eigenvectors, random, phase, dof, ratio) + particles(iatom)%v(ii) = dv_from_vib_data(iatom, ii, mass, temperature, & + eigenvectors, random, phase, dof, & + ratio) + END DO + CASE (use_perd_y) + DO ii = 1, 3, 2 + dr(ii, iatom) = dr_from_vib_data(iatom, ii, mass, temperature, eigenvalues, & + eigenvectors, random, phase, dof, ratio) + particles(iatom)%v(ii) = dv_from_vib_data(iatom, ii, mass, temperature, & + eigenvectors, random, phase, dof, & + ratio) + END DO + CASE (use_perd_z) + DO ii = 1, 2 + dr(ii, iatom) = dr_from_vib_data(iatom, ii, mass, temperature, eigenvalues, & + eigenvectors, random, phase, dof, ratio) + particles(iatom)%v(ii) = dv_from_vib_data(iatom, ii, mass, temperature, & + eigenvectors, random, phase, dof, & + ratio) + END DO + CASE (use_perd_xy) + dr(3, iatom) = dr_from_vib_data(iatom, 3, mass, temperature, eigenvalues, & + eigenvectors, random, phase, dof, ratio) + particles(iatom)%v(3) = dv_from_vib_data(iatom, 3, mass, temperature, & + eigenvectors, random, phase, dof, & + ratio) + CASE (use_perd_xz) + dr(2, iatom) = dr_from_vib_data(iatom, 2, mass, temperature, eigenvalues, & eigenvectors, random, phase, dof, ratio) - particles(iatom)%v(3) = dv_from_vib_data(iatom, 3, mass, temperature, & - eigenvectors, random, phase, dof, & - ratio) - CASE (use_perd_xz) - dr(2, iatom) = dr_from_vib_data(iatom, 2, mass, temperature, eigenvalues, & - eigenvectors, random, phase, dof, ratio) - particles(iatom)%v(2) = dv_from_vib_data(iatom, 2, mass, temperature, & - eigenvectors, random, phase, dof, & - ratio) - CASE (use_perd_yz) - dr(1, iatom) = dr_from_vib_data(iatom, 1, mass, temperature, eigenvalues, & - eigenvectors, random, phase, dof, ratio) - particles(iatom)%v(1) = dv_from_vib_data(iatom, 1, mass, temperature, & - eigenvectors, random, phase, dof, & - ratio) - CASE (use_perd_none) - DO ii = 1, 3 - dr(ii, iatom) = dr_from_vib_data(iatom, ii, mass, temperature, eigenvalues, & - eigenvectors, random, phase, dof, ratio) - particles(iatom)%v(ii) = dv_from_vib_data(iatom, ii, mass, temperature, & - eigenvectors, random, phase, dof, & - ratio) - END DO - END SELECT - END DO ! iatom - ! free memory - DEALLOCATE (eigenvalues) - DEALLOCATE (eigenvectors) - DEALLOCATE (phase) - DEALLOCATE (random) - ! update particle coordinates - DO iatom = 1, natoms - particles(iatom)%r(:) = particles(iatom)%r(:) + dr(:,iatom) - END DO - ! update core-shell model coordinates - IF (shell_present) THEN - ! particles have moved, and for core-shell model this means - ! the cores and shells must also move by the same amount. The - ! shell positions will then be optimised if needed - shell_index = particles(iatom)%shell_index - IF (shell_index .NE. 0) THEN - core_particles(shell_index)%r(:) = core_particles(shell_index)%r(:) + & - dr(:,iatom) - shell_particles(shell_index)%r(:) = shell_particles(shell_index)%r(:) + & - dr(:,iatom) - END IF - CALL optimize_shell_core(force_env, & - particles, & - shell_particles, & - core_particles, & - global_env) - END IF - ! cleanup - DEALLOCATE(dr) - END SUBROUTINE generate_coords_vels_vib + particles(iatom)%v(2) = dv_from_vib_data(iatom, 2, mass, temperature, & + eigenvectors, random, phase, dof, & + ratio) + CASE (use_perd_yz) + dr(1, iatom) = dr_from_vib_data(iatom, 1, mass, temperature, eigenvalues, & + eigenvectors, random, phase, dof, ratio) + particles(iatom)%v(1) = dv_from_vib_data(iatom, 1, mass, temperature, & + eigenvectors, random, phase, dof, & + ratio) + CASE (use_perd_none) + DO ii = 1, 3 + dr(ii, iatom) = dr_from_vib_data(iatom, ii, mass, temperature, eigenvalues, & + eigenvectors, random, phase, dof, ratio) + particles(iatom)%v(ii) = dv_from_vib_data(iatom, ii, mass, temperature, & + eigenvectors, random, phase, dof, & + ratio) + END DO + END SELECT + END DO ! iatom + ! free memory + DEALLOCATE (eigenvalues) + DEALLOCATE (eigenvectors) + DEALLOCATE (phase) + DEALLOCATE (random) + ! update particle coordinates + DO iatom = 1, natoms + particles(iatom)%r(:) = particles(iatom)%r(:) + dr(:, iatom) + END DO + ! update core-shell model coordinates + IF (shell_present) THEN + ! particles have moved, and for core-shell model this means + ! the cores and shells must also move by the same amount. The + ! shell positions will then be optimised if needed + shell_index = particles(iatom)%shell_index + IF (shell_index .NE. 0) THEN + core_particles(shell_index)%r(:) = core_particles(shell_index)%r(:) + & + dr(:, iatom) + shell_particles(shell_index)%r(:) = shell_particles(shell_index)%r(:) + & + dr(:, iatom) + END IF + CALL optimize_shell_core(force_env, & + particles, & + shell_particles, & + core_particles, & + global_env) + END IF + ! cleanup + DEALLOCATE (dr) + END SUBROUTINE generate_coords_vels_vib ! ************************************************************************************************** !> \brief calculates componbent of initial velocity of an atom from vibreational modes @@ -1091,17 +1088,17 @@ END SUBROUTINE generate_coords_vels_vib !> \return : outputs icart-th cartesian component of initial position of atom iatom !> \author Lianheng Tong, lianheng.tong@kcl.ac.uk ! ************************************************************************************************** - PURE FUNCTION dr_from_vib_data(iatom, & - icart, & - mass, & - temperature, & - eigenvalues, & - eigenvectors, & - random, & - phase, & - dof, & - scale) & - RESULT(res) + PURE FUNCTION dr_from_vib_data(iatom, & + icart, & + mass, & + temperature, & + eigenvalues, & + eigenvectors, & + random, & + phase, & + dof, & + scale) & + RESULT(res) INTEGER, INTENT(IN) :: iatom, icart REAL(KIND=dp), INTENT(IN) :: mass, temperature REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: eigenvalues @@ -1116,23 +1113,23 @@ PURE FUNCTION dr_from_vib_data(iatom, & INTEGER :: imode, ind - res = 0.0_dp - ! assuming the eigenvalues are sorted in accending order, the - ! first three modes are acoustic with zero frequencies. These are - ! excluded from considerations, and should have been reflected in - ! the calculation of scale outside this function - IF (mass .GT. 0.0_dp) THEN - ! eigenvector rows assumed to be grouped in atomic blocks - ind = (iatom - 1)*3 + icart - DO imode = 4, dof - res = res + & - SQRT(-2.0_dp*scale*temperature*LOG(1-random(imode))/mass) / & - eigenvalues(imode) * & - eigenvectors(ind,imode) * & - COS(2.0_dp*pi*phase(imode)) - END DO - END IF - END FUNCTION dr_from_vib_data + res = 0.0_dp + ! assuming the eigenvalues are sorted in accending order, the + ! first three modes are acoustic with zero frequencies. These are + ! excluded from considerations, and should have been reflected in + ! the calculation of scale outside this function + IF (mass .GT. 0.0_dp) THEN + ! eigenvector rows assumed to be grouped in atomic blocks + ind = (iatom - 1)*3 + icart + DO imode = 4, dof + res = res + & + SQRT(-2.0_dp*scale*temperature*LOG(1 - random(imode))/mass)/ & + eigenvalues(imode)* & + eigenvectors(ind, imode)* & + COS(2.0_dp*pi*phase(imode)) + END DO + END IF + END FUNCTION dr_from_vib_data ! ************************************************************************************************** !> \brief calculates componbent of initial velocity of an atom from vibreational modes @@ -1152,16 +1149,16 @@ END FUNCTION dr_from_vib_data !> \return : outputs icart-th cartesian component of initial velocity of atom iatom !> \author Lianheng Tong, lianheng.tong@kcl.ac.uk ! ************************************************************************************************** - PURE FUNCTION dv_from_vib_data(iatom, & - icart, & - mass, & - temperature, & - eigenvectors, & - random, & - phase, & - dof, & - scale) & - RESULT(res) + PURE FUNCTION dv_from_vib_data(iatom, & + icart, & + mass, & + temperature, & + eigenvectors, & + random, & + phase, & + dof, & + scale) & + RESULT(res) INTEGER, INTENT(IN) :: iatom, icart REAL(KIND=dp), INTENT(IN) :: mass, temperature REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: eigenvectors @@ -1175,22 +1172,22 @@ PURE FUNCTION dv_from_vib_data(iatom, & INTEGER :: imode, ind - res = 0.0_dp - ! assuming the eigenvalues are sorted in accending order, the - ! first three modes are acoustic with zero frequencies. These are - ! excluded from considerations, and should have been reflected in - ! the calculation of scale outside this function - IF (mass .GT. 0.0_dp) THEN - ! eigenvector rows assumed to be grouped in atomic blocks - ind = (iatom - 1)*3 + icart - DO imode = 4, dof - res = res - & - SQRT(-2.0_dp*scale*temperature*LOG(1-random(imode))/mass) * & - eigenvectors(ind,imode) * & - SIN(2.0_dp*pi*phase(imode)) - END DO - END IF - END FUNCTION dv_from_vib_data + res = 0.0_dp + ! assuming the eigenvalues are sorted in accending order, the + ! first three modes are acoustic with zero frequencies. These are + ! excluded from considerations, and should have been reflected in + ! the calculation of scale outside this function + IF (mass .GT. 0.0_dp) THEN + ! eigenvector rows assumed to be grouped in atomic blocks + ind = (iatom - 1)*3 + icart + DO imode = 4, dof + res = res - & + SQRT(-2.0_dp*scale*temperature*LOG(1 - random(imode))/mass)* & + eigenvectors(ind, imode)* & + SIN(2.0_dp*pi*phase(imode)) + END DO + END IF + END FUNCTION dv_from_vib_data ! ************************************************************************************************** !> \brief Initializing velocities deterministically on all processors, if not given in input @@ -1206,8 +1203,8 @@ END FUNCTION dv_from_vib_data !> \param iw ... !> \author CJM,MK,Toon Verstraelen , Ole Schuett ! ************************************************************************************************** - SUBROUTINE generate_velocities(simpar, part, force_env, globenv, md_env,& - shell_present, shell_part, core_part, is_fixed, iw) + SUBROUTINE generate_velocities(simpar, part, force_env, globenv, md_env, & + shell_present, shell_part, core_part, is_fixed, iw) TYPE(simpar_type), POINTER :: simpar TYPE(particle_type), DIMENSION(:), POINTER :: part TYPE(force_env_type), POINTER :: force_env @@ -1225,49 +1222,49 @@ SUBROUTINE generate_velocities(simpar, part, force_env, globenv, md_env,& REAL(KIND=dp) :: mass TYPE(atomic_kind_type), POINTER :: atomic_kind - NULLIFY (atomic_kind) - natoms = SIZE(part) - - DO i = 1, natoms - atomic_kind => part(i)%atomic_kind - CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) - part(i)%v(1) = 0.0_dp - part(i)%v(2) = 0.0_dp - part(i)%v(3) = 0.0_dp - IF (mass.NE.0.0) THEN - SELECT CASE(is_fixed(i)) - CASE (use_perd_x) - part(i)%v(2) = next_random_number(globenv%gaussian_rng_stream) / SQRT(mass) - part(i)%v(3) = next_random_number(globenv%gaussian_rng_stream) / SQRT(mass) - CASE (use_perd_y) - part(i)%v(1) = next_random_number(globenv%gaussian_rng_stream) / SQRT(mass) - part(i)%v(3) = next_random_number(globenv%gaussian_rng_stream) / SQRT(mass) - CASE (use_perd_z) - part(i)%v(1) = next_random_number(globenv%gaussian_rng_stream) / SQRT(mass) - part(i)%v(2) = next_random_number(globenv%gaussian_rng_stream) / SQRT(mass) - CASE (use_perd_xy) - part(i)%v(3) = next_random_number(globenv%gaussian_rng_stream) / SQRT(mass) - CASE (use_perd_xz) - part(i)%v(2) = next_random_number(globenv%gaussian_rng_stream) / SQRT(mass) - CASE (use_perd_yz) - part(i)%v(1) = next_random_number(globenv%gaussian_rng_stream) / SQRT(mass) - CASE (use_perd_none) - part(i)%v(1) = next_random_number(globenv%gaussian_rng_stream) / SQRT(mass) - part(i)%v(2) = next_random_number(globenv%gaussian_rng_stream) / SQRT(mass) - part(i)%v(3) = next_random_number(globenv%gaussian_rng_stream) / SQRT(mass) - END SELECT - END IF - END DO - - CALL normalize_velocities(simpar, part, force_env, md_env, is_fixed) - CALL soften_velocities(simpar, part, force_env, md_env, is_fixed, iw) - - ! Initialize the core and the shell velocity. Atom velocities are just - ! copied so that the initial relative core-shell velocity is zero. - IF (shell_present) THEN - CALL optimize_shell_core(force_env,part,shell_part, core_part, globenv) - ENDIF - END SUBROUTINE generate_velocities + NULLIFY (atomic_kind) + natoms = SIZE(part) + + DO i = 1, natoms + atomic_kind => part(i)%atomic_kind + CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) + part(i)%v(1) = 0.0_dp + part(i)%v(2) = 0.0_dp + part(i)%v(3) = 0.0_dp + IF (mass .NE. 0.0) THEN + SELECT CASE (is_fixed(i)) + CASE (use_perd_x) + part(i)%v(2) = next_random_number(globenv%gaussian_rng_stream)/SQRT(mass) + part(i)%v(3) = next_random_number(globenv%gaussian_rng_stream)/SQRT(mass) + CASE (use_perd_y) + part(i)%v(1) = next_random_number(globenv%gaussian_rng_stream)/SQRT(mass) + part(i)%v(3) = next_random_number(globenv%gaussian_rng_stream)/SQRT(mass) + CASE (use_perd_z) + part(i)%v(1) = next_random_number(globenv%gaussian_rng_stream)/SQRT(mass) + part(i)%v(2) = next_random_number(globenv%gaussian_rng_stream)/SQRT(mass) + CASE (use_perd_xy) + part(i)%v(3) = next_random_number(globenv%gaussian_rng_stream)/SQRT(mass) + CASE (use_perd_xz) + part(i)%v(2) = next_random_number(globenv%gaussian_rng_stream)/SQRT(mass) + CASE (use_perd_yz) + part(i)%v(1) = next_random_number(globenv%gaussian_rng_stream)/SQRT(mass) + CASE (use_perd_none) + part(i)%v(1) = next_random_number(globenv%gaussian_rng_stream)/SQRT(mass) + part(i)%v(2) = next_random_number(globenv%gaussian_rng_stream)/SQRT(mass) + part(i)%v(3) = next_random_number(globenv%gaussian_rng_stream)/SQRT(mass) + END SELECT + END IF + END DO + + CALL normalize_velocities(simpar, part, force_env, md_env, is_fixed) + CALL soften_velocities(simpar, part, force_env, md_env, is_fixed, iw) + + ! Initialize the core and the shell velocity. Atom velocities are just + ! copied so that the initial relative core-shell velocity is zero. + IF (shell_present) THEN + CALL optimize_shell_core(force_env, part, shell_part, core_part, globenv) + ENDIF + END SUBROUTINE generate_velocities ! ************************************************************************************************** !> \brief Direct velocities along a low-curvature direction in order to @@ -1281,7 +1278,7 @@ END SUBROUTINE generate_velocities !> \param iw ... !> \author Ole Schuett ! ************************************************************************************************** - SUBROUTINE soften_velocities(simpar, part, force_env, md_env, is_fixed, iw) + SUBROUTINE soften_velocities(simpar, part, force_env, md_env, is_fixed, iw) TYPE(simpar_type), POINTER :: simpar TYPE(particle_type), DIMENSION(:), POINTER :: part TYPE(force_env_type), POINTER :: force_env @@ -1295,51 +1292,50 @@ SUBROUTINE soften_velocities(simpar, part, force_env, md_env, is_fixed, iw) INTEGER :: i, k REAL(KIND=dp), DIMENSION(SIZE(part), 3) :: F, F_t, N, x0 - IF(simpar%soften_nsteps <= 0) RETURN !nothing todo + IF (simpar%soften_nsteps <= 0) RETURN !nothing todo - IF(ANY(is_fixed/=use_perd_none))& - CPABORT("Velocitiy softening with constraints is not supported.") + IF (ANY(is_fixed /= use_perd_none)) & + CPABORT("Velocitiy softening with constraints is not supported.") - !backup positions - DO i = 1, SIZE(part) - x0(i,:) = part(i)%r - END DO - - DO k=1, simpar%soften_nsteps + !backup positions + DO i = 1, SIZE(part) + x0(i, :) = part(i)%r + END DO - !use normalized velocities as displace direction - DO i = 1, SIZE(part) - N(i,:) = part(i)%v - END DO - N = N / SQRT(SUM(N**2)) + DO k = 1, simpar%soften_nsteps - ! displace system temporarly to calculate forces - DO i = 1, SIZE(part) - part(i)%r = part(i)%r + simpar%soften_delta * N(i,:) - END DO - CALL force_env_calc_energy_force(force_env) + !use normalized velocities as displace direction + DO i = 1, SIZE(part) + N(i, :) = part(i)%v + END DO + N = N/SQRT(SUM(N**2)) - ! calculate velocity update direction F_t - DO i = 1, SIZE(part) - F(i,:) = part(i)%f - END DO - F_t = F - N * SUM(N*F) + ! displace system temporarly to calculate forces + DO i = 1, SIZE(part) + part(i)%r = part(i)%r + simpar%soften_delta*N(i, :) + END DO + CALL force_env_calc_energy_force(force_env) - ! restore positions and update velocities - DO i = 1, SIZE(part) - part(i)%r = x0(i,:) - part(i)%v = part(i)%v + simpar%soften_alpha * F_t(i,:) - END DO + ! calculate velocity update direction F_t + DO i = 1, SIZE(part) + F(i, :) = part(i)%f + END DO + F_t = F - N*SUM(N*F) - CALL normalize_velocities(simpar, part, force_env, md_env, is_fixed) - END DO + ! restore positions and update velocities + DO i = 1, SIZE(part) + part(i)%r = x0(i, :) + part(i)%v = part(i)%v + simpar%soften_alpha*F_t(i, :) + END DO - IF(iw>0) THEN - WRITE (iw, "(A,T71, I10)") " Velocities softening Steps: ",simpar%soften_nsteps - WRITE (iw, "(A,T71, E10.3)") " Velocities softening NORM(F_t): ",SQRT(SUM(F_t**2)) - END IF - END SUBROUTINE soften_velocities + CALL normalize_velocities(simpar, part, force_env, md_env, is_fixed) + END DO + IF (iw > 0) THEN + WRITE (iw, "(A,T71, I10)") " Velocities softening Steps: ", simpar%soften_nsteps + WRITE (iw, "(A,T71, E10.3)") " Velocities softening NORM(F_t): ", SQRT(SUM(F_t**2)) + END IF + END SUBROUTINE soften_velocities ! ************************************************************************************************** !> \brief Scale velocities according to temperature and remove rigid body motion. @@ -1350,7 +1346,7 @@ END SUBROUTINE soften_velocities !> \param is_fixed ... !> \author CJM,MK,Toon Verstraelen , Ole Schuett ! ************************************************************************************************** - SUBROUTINE normalize_velocities(simpar, part, force_env, md_env, is_fixed) + SUBROUTINE normalize_velocities(simpar, part, force_env, md_env, is_fixed) TYPE(simpar_type), POINTER :: simpar TYPE(particle_type), DIMENSION(:), POINTER :: part TYPE(force_env_type), POINTER :: force_env @@ -1364,27 +1360,26 @@ SUBROUTINE normalize_velocities(simpar, part, force_env, md_env, is_fixed) REAL(KIND=dp), DIMENSION(3) :: rcom, vang, vcom TYPE(cell_type), POINTER :: cell - NULLIFY(cell) - - ! Subtract the vcom - CALL compute_vcom(part,is_fixed,vcom) - CALL subtract_vcom(part,is_fixed,vcom) - ! If requested and the system is not periodic, subtract the angular velocity - CALL force_env_get(force_env, cell=cell) - IF (SUM(cell%perd(1:3)) == 0 .AND. simpar%angvel_zero) THEN - CALL compute_rcom(part,is_fixed,rcom) - CALL compute_vang(part,is_fixed,rcom,vang) - CALL subtract_vang(part,is_fixed,rcom,vang) - END IF - ! Rescale the velocities - IF(simpar%do_thermal_region) THEN - CALL rescale_vel_region(part,md_env,simpar) - ELSE - ekin = compute_ekin(part) - CALL rescale_vel(part,simpar,ekin) - END IF - END SUBROUTINE normalize_velocities - + NULLIFY (cell) + + ! Subtract the vcom + CALL compute_vcom(part, is_fixed, vcom) + CALL subtract_vcom(part, is_fixed, vcom) + ! If requested and the system is not periodic, subtract the angular velocity + CALL force_env_get(force_env, cell=cell) + IF (SUM(cell%perd(1:3)) == 0 .AND. simpar%angvel_zero) THEN + CALL compute_rcom(part, is_fixed, rcom) + CALL compute_vang(part, is_fixed, rcom, vang) + CALL subtract_vang(part, is_fixed, rcom, vang) + END IF + ! Rescale the velocities + IF (simpar%do_thermal_region) THEN + CALL rescale_vel_region(part, md_env, simpar) + ELSE + ekin = compute_ekin(part) + CALL rescale_vel(part, simpar, ekin) + END IF + END SUBROUTINE normalize_velocities ! ************************************************************************************************** !> \brief Computes Ekin, VCOM and Temp for particles @@ -1394,7 +1389,7 @@ END SUBROUTINE normalize_velocities !> \par History !> Teodoro Laino - University of Zurich - 09.2007 [tlaino] ! ************************************************************************************************** - SUBROUTINE reset_vcom(subsys, md_ener, vsubtract) + SUBROUTINE reset_vcom(subsys, md_ener, vsubtract) TYPE(cp_subsys_type), POINTER :: subsys TYPE(md_ener_type), POINTER :: md_ener REAL(KIND=dp), DIMENSION(3), INTENT(IN) :: vsubtract @@ -1413,69 +1408,69 @@ SUBROUTINE reset_vcom(subsys, md_ener, vsubtract) shell_particles TYPE(shell_kind_type), POINTER :: shell - NULLIFY(particles, atomic_kind, atomic_kinds, atom_list, shell) - CALL timeset(routineN,handle) - - CALL cp_subsys_get(subsys,& - atomic_kinds=atomic_kinds,& - particles=particles,& - shell_particles=shell_particles,& - core_particles=core_particles) - - ekin_old = md_ener%ekin - ! Possibly subtract a quantity from all velocities - DO ikind=1,atomic_kinds%n_els - atomic_kind => atomic_kinds%els(ikind) - CALL get_atomic_kind(atomic_kind=atomic_kind, atom_list=atom_list,& - natom=natom, mass=mass, shell_active=is_shell, shell=shell) - IF (is_shell) THEN - tmp = 0.5_dp*vsubtract*mass - imass_s = 1.0_dp/shell%mass_shell - imass_c = 1.0_dp/shell%mass_core - DO iatom = 1, natom - atom = atom_list(iatom) - shell_index = particles%els(atom)%shell_index - shell_particles%els(shell_index)%v = shell_particles%els(shell_index)%v - tmp*imass_s - core_particles%els(shell_index)%v = core_particles%els(shell_index)%v - tmp*imass_c - particles%els(atom)%v = particles%els(atom)%v - vsubtract - END DO - ELSE - DO iatom = 1, natom - atom = atom_list(iatom) - particles%els(atom)%v = particles%els(atom)%v - vsubtract - END DO - END IF - END DO - ! Compute Kinetic Energy and COM Velocity - md_ener%vcom = 0.0_dp - md_ener%total_mass = 0.0_dp - md_ener%ekin = 0.0_dp - DO ikind=1,atomic_kinds%n_els - atomic_kind => atomic_kinds%els(ikind) - CALL get_atomic_kind(atomic_kind=atomic_kind, atom_list=atom_list, mass=mass, natom=natom) - v2 = 0.0_dp - v = 0.0_dp - DO iatom = 1, natom - atom = atom_list(iatom) - v2 = v2 + SUM(particles%els(atom)%v**2) - v(1) = v(1) + particles%els(atom)%v(1) - v(2) = v(2) + particles%els(atom)%v(2) - v(3) = v(3) + particles%els(atom)%v(3) - END DO - md_ener%ekin = md_ener%ekin + 0.5_dp*mass*v2 - md_ener%vcom(1) = md_ener%vcom(1) + mass*v(1) - md_ener%vcom(2) = md_ener%vcom(2) + mass*v(2) - md_ener%vcom(3) = md_ener%vcom(3) + mass*v(3) - md_ener%total_mass = md_ener%total_mass + REAL(natom,KIND=dp)*mass - END DO - md_ener%vcom = md_ener%vcom / md_ener%total_mass - md_ener%constant = md_ener%constant - ekin_old + md_ener%ekin - IF (md_ener%nfree /=0) THEN - md_ener%temp_part = 2.0_dp*md_ener%ekin/REAL(md_ener%nfree,KIND=dp)*kelvin - END IF - CALL timestop(handle) - - END SUBROUTINE reset_vcom + NULLIFY (particles, atomic_kind, atomic_kinds, atom_list, shell) + CALL timeset(routineN, handle) + + CALL cp_subsys_get(subsys, & + atomic_kinds=atomic_kinds, & + particles=particles, & + shell_particles=shell_particles, & + core_particles=core_particles) + + ekin_old = md_ener%ekin + ! Possibly subtract a quantity from all velocities + DO ikind = 1, atomic_kinds%n_els + atomic_kind => atomic_kinds%els(ikind) + CALL get_atomic_kind(atomic_kind=atomic_kind, atom_list=atom_list, & + natom=natom, mass=mass, shell_active=is_shell, shell=shell) + IF (is_shell) THEN + tmp = 0.5_dp*vsubtract*mass + imass_s = 1.0_dp/shell%mass_shell + imass_c = 1.0_dp/shell%mass_core + DO iatom = 1, natom + atom = atom_list(iatom) + shell_index = particles%els(atom)%shell_index + shell_particles%els(shell_index)%v = shell_particles%els(shell_index)%v - tmp*imass_s + core_particles%els(shell_index)%v = core_particles%els(shell_index)%v - tmp*imass_c + particles%els(atom)%v = particles%els(atom)%v - vsubtract + END DO + ELSE + DO iatom = 1, natom + atom = atom_list(iatom) + particles%els(atom)%v = particles%els(atom)%v - vsubtract + END DO + END IF + END DO + ! Compute Kinetic Energy and COM Velocity + md_ener%vcom = 0.0_dp + md_ener%total_mass = 0.0_dp + md_ener%ekin = 0.0_dp + DO ikind = 1, atomic_kinds%n_els + atomic_kind => atomic_kinds%els(ikind) + CALL get_atomic_kind(atomic_kind=atomic_kind, atom_list=atom_list, mass=mass, natom=natom) + v2 = 0.0_dp + v = 0.0_dp + DO iatom = 1, natom + atom = atom_list(iatom) + v2 = v2 + SUM(particles%els(atom)%v**2) + v(1) = v(1) + particles%els(atom)%v(1) + v(2) = v(2) + particles%els(atom)%v(2) + v(3) = v(3) + particles%els(atom)%v(3) + END DO + md_ener%ekin = md_ener%ekin + 0.5_dp*mass*v2 + md_ener%vcom(1) = md_ener%vcom(1) + mass*v(1) + md_ener%vcom(2) = md_ener%vcom(2) + mass*v(2) + md_ener%vcom(3) = md_ener%vcom(3) + mass*v(3) + md_ener%total_mass = md_ener%total_mass + REAL(natom, KIND=dp)*mass + END DO + md_ener%vcom = md_ener%vcom/md_ener%total_mass + md_ener%constant = md_ener%constant - ekin_old + md_ener%ekin + IF (md_ener%nfree /= 0) THEN + md_ener%temp_part = 2.0_dp*md_ener%ekin/REAL(md_ener%nfree, KIND=dp)*kelvin + END IF + CALL timestop(handle) + + END SUBROUTINE reset_vcom ! ************************************************************************************************** !> \brief Scale velocities to get the correct temperature @@ -1487,7 +1482,7 @@ END SUBROUTINE reset_vcom !> \par History !> Teodoro Laino - University of Zurich - 09.2007 [tlaino] ! ************************************************************************************************** - SUBROUTINE scale_velocity(subsys, md_ener, temp_expected, temp_tol, iw) + SUBROUTINE scale_velocity(subsys, md_ener, temp_expected, temp_tol, iw) TYPE(cp_subsys_type), POINTER :: subsys TYPE(md_ener_type), POINTER :: md_ener REAL(KIND=dp), INTENT(IN) :: temp_expected, temp_tol @@ -1497,28 +1492,28 @@ SUBROUTINE scale_velocity(subsys, md_ener, temp_expected, temp_tol, iw) REAL(KIND=dp) :: ekin_old, scale, temp_old - IF (ABS(temp_expected - md_ener%temp_part/kelvin) > temp_tol) THEN - scale = 0.0_dp - IF (md_ener%temp_part>0.0_dp) scale = SQRT((temp_expected/md_ener%temp_part)*kelvin) - ekin_old = md_ener%ekin - temp_old = md_ener%temp_part - md_ener%ekin = 0.0_dp - md_ener%temp_part = 0.0_dp - md_ener%vcom = 0.0_dp - md_ener%total_mass = 0.0_dp - - CALL scale_velocity_low(subsys,scale,ireg=0,ekin=md_ener%ekin,vcom=md_ener%vcom) - IF(md_ener%nfree /=0) THEN - md_ener%temp_part = 2.0_dp*md_ener%ekin/REAL(md_ener%nfree,KIND=dp)*kelvin - END IF - md_ener%constant = md_ener%constant - ekin_old + md_ener%ekin - - IF (iw>0) THEN - WRITE (UNIT=iw,FMT="(/,T2,A,F10.2,A,F10.2,A)")"Temperature scaled to requested temperature:",& - temp_old," K ->",md_ener%temp_part," K" - END IF - END IF - END SUBROUTINE scale_velocity + IF (ABS(temp_expected - md_ener%temp_part/kelvin) > temp_tol) THEN + scale = 0.0_dp + IF (md_ener%temp_part > 0.0_dp) scale = SQRT((temp_expected/md_ener%temp_part)*kelvin) + ekin_old = md_ener%ekin + temp_old = md_ener%temp_part + md_ener%ekin = 0.0_dp + md_ener%temp_part = 0.0_dp + md_ener%vcom = 0.0_dp + md_ener%total_mass = 0.0_dp + + CALL scale_velocity_low(subsys, scale, ireg=0, ekin=md_ener%ekin, vcom=md_ener%vcom) + IF (md_ener%nfree /= 0) THEN + md_ener%temp_part = 2.0_dp*md_ener%ekin/REAL(md_ener%nfree, KIND=dp)*kelvin + END IF + md_ener%constant = md_ener%constant - ekin_old + md_ener%ekin + + IF (iw > 0) THEN + WRITE (UNIT=iw, FMT="(/,T2,A,F10.2,A,F10.2,A)") "Temperature scaled to requested temperature:", & + temp_old, " K ->", md_ener%temp_part, " K" + END IF + END IF + END SUBROUTINE scale_velocity ! ************************************************************************************************** !> \brief Scale velocities of set of regions @@ -1529,7 +1524,7 @@ END SUBROUTINE scale_velocity !> \param iw ... !> \par author MI ! ************************************************************************************************** - SUBROUTINE scale_velocity_region(md_env, subsys, md_ener, simpar, iw) + SUBROUTINE scale_velocity_region(md_env, subsys, md_ener, simpar, iw) TYPE(md_environment_type), POINTER :: md_env TYPE(cp_subsys_type), POINTER :: subsys @@ -1549,66 +1544,66 @@ SUBROUTINE scale_velocity_region(md_env, subsys, md_ener, simpar, iw) TYPE(thermal_region_type), POINTER :: t_region TYPE(thermal_regions_type), POINTER :: thermal_regions - NULLIFY( particles, part, thermal_regions, t_region) - CALL cp_subsys_get(subsys, particles=particles) - part => particles%els - CALL get_md_env(md_env, thermal_regions=thermal_regions) - - nregions = thermal_regions%nregions - nfree_done = 0 - ekin_total_new = 0.0_dp - ekin_old = md_ener%ekin - vcom_total = 0.0_dp - ALLOCATE(temp_new(0:nregions),temp_old(0:nregions)) - temp_new = 0.0_dp - temp_old = 0.0_dp - !loop regions - DO ireg = 1,nregions - NULLIFY(t_region) - t_region => thermal_regions%thermal_region(ireg) - nfree = 3*t_region%npart - ekin = compute_ekin(part,ireg) - IF(nfree > 0) t_region%temperature = 2.0_dp*ekin/REAL(nfree,KIND=dp)*kelvin - temp_old(ireg) = t_region%temperature - IF(t_region%temp_tol > 0.0_dp .AND. & - ABS(t_region%temp_expected - t_region%temperature/kelvin) > t_region%temp_tol) THEN - fscale = SQRT((t_region%temp_expected/t_region%temperature)*kelvin) - CALL scale_velocity_low(subsys,fscale,ireg,ekin,vcom) - t_region%temperature = 2.0_dp*ekin/REAL(nfree,KIND=dp)*kelvin - temp_new(ireg) = t_region%temperature - END IF - nfree_done = nfree_done + nfree - ekin_total_new = ekin_total_new + ekin - END DO - nfree = simpar%nfree - nfree_done - ekin = compute_ekin(part,ireg=0) - IF(nfree>0) thermal_regions%temp_reg0 = 2.0_dp*ekin/REAL(nfree,KIND=dp)*kelvin - temp_old(0) = thermal_regions%temp_reg0 - IF(simpar%temp_tol > 0.0_dp .AND. nfree>0) THEN - IF (ABS(simpar%temp_ext - thermal_regions%temp_reg0/kelvin) > simpar%temp_tol) THEN - fscale = SQRT((simpar%temp_ext/thermal_regions%temp_reg0)*kelvin) - CALL scale_velocity_low(subsys,fscale,0,ekin,vcom) - thermal_regions%temp_reg0 = 2.0_dp*ekin/REAL(nfree,KIND=dp)*kelvin - temp_new(0) = thermal_regions%temp_reg0 - END IF - END IF - ekin_total_new = ekin_total_new + ekin - - md_ener%ekin = ekin_total_new - IF(md_ener%nfree /=0) THEN - md_ener%temp_part = 2.0_dp*md_ener%ekin/REAL(md_ener%nfree,KIND=dp)*kelvin - END IF - md_ener%constant = md_ener%constant - ekin_old + md_ener%ekin - - DO ireg = 0,nregions - IF (iw>0 .AND. temp_new(ireg)>0.0_dp) THEN - WRITE (UNIT=iw,FMT="(/,T2,A,I5, A,F10.2,A,F10.2,A)")"Temperature region ", ireg, & - " rescaled from:",temp_old(ireg)," K to ",temp_new(ireg)," K" - END IF - END DO - DEALLOCATE(temp_new,temp_old) - - END SUBROUTINE scale_velocity_region + NULLIFY (particles, part, thermal_regions, t_region) + CALL cp_subsys_get(subsys, particles=particles) + part => particles%els + CALL get_md_env(md_env, thermal_regions=thermal_regions) + + nregions = thermal_regions%nregions + nfree_done = 0 + ekin_total_new = 0.0_dp + ekin_old = md_ener%ekin + vcom_total = 0.0_dp + ALLOCATE (temp_new(0:nregions), temp_old(0:nregions)) + temp_new = 0.0_dp + temp_old = 0.0_dp + !loop regions + DO ireg = 1, nregions + NULLIFY (t_region) + t_region => thermal_regions%thermal_region(ireg) + nfree = 3*t_region%npart + ekin = compute_ekin(part, ireg) + IF (nfree > 0) t_region%temperature = 2.0_dp*ekin/REAL(nfree, KIND=dp)*kelvin + temp_old(ireg) = t_region%temperature + IF (t_region%temp_tol > 0.0_dp .AND. & + ABS(t_region%temp_expected - t_region%temperature/kelvin) > t_region%temp_tol) THEN + fscale = SQRT((t_region%temp_expected/t_region%temperature)*kelvin) + CALL scale_velocity_low(subsys, fscale, ireg, ekin, vcom) + t_region%temperature = 2.0_dp*ekin/REAL(nfree, KIND=dp)*kelvin + temp_new(ireg) = t_region%temperature + END IF + nfree_done = nfree_done + nfree + ekin_total_new = ekin_total_new + ekin + END DO + nfree = simpar%nfree - nfree_done + ekin = compute_ekin(part, ireg=0) + IF (nfree > 0) thermal_regions%temp_reg0 = 2.0_dp*ekin/REAL(nfree, KIND=dp)*kelvin + temp_old(0) = thermal_regions%temp_reg0 + IF (simpar%temp_tol > 0.0_dp .AND. nfree > 0) THEN + IF (ABS(simpar%temp_ext - thermal_regions%temp_reg0/kelvin) > simpar%temp_tol) THEN + fscale = SQRT((simpar%temp_ext/thermal_regions%temp_reg0)*kelvin) + CALL scale_velocity_low(subsys, fscale, 0, ekin, vcom) + thermal_regions%temp_reg0 = 2.0_dp*ekin/REAL(nfree, KIND=dp)*kelvin + temp_new(0) = thermal_regions%temp_reg0 + END IF + END IF + ekin_total_new = ekin_total_new + ekin + + md_ener%ekin = ekin_total_new + IF (md_ener%nfree /= 0) THEN + md_ener%temp_part = 2.0_dp*md_ener%ekin/REAL(md_ener%nfree, KIND=dp)*kelvin + END IF + md_ener%constant = md_ener%constant - ekin_old + md_ener%ekin + + DO ireg = 0, nregions + IF (iw > 0 .AND. temp_new(ireg) > 0.0_dp) THEN + WRITE (UNIT=iw, FMT="(/,T2,A,I5, A,F10.2,A,F10.2,A)") "Temperature region ", ireg, & + " rescaled from:", temp_old(ireg), " K to ", temp_new(ireg), " K" + END IF + END DO + DEALLOCATE (temp_new, temp_old) + + END SUBROUTINE scale_velocity_region ! ************************************************************************************************** !> \brief Scale velocities for a specific region @@ -1619,7 +1614,7 @@ END SUBROUTINE scale_velocity_region !> \param vcom ... !> \par author MI ! ************************************************************************************************** - SUBROUTINE scale_velocity_low(subsys,fscale,ireg,ekin,vcom) + SUBROUTINE scale_velocity_low(subsys, fscale, ireg, ekin, vcom) TYPE(cp_subsys_type), POINTER :: subsys REAL(KIND=dp), INTENT(IN) :: fscale @@ -1641,78 +1636,78 @@ SUBROUTINE scale_velocity_low(subsys,fscale,ireg,ekin,vcom) shell_particles TYPE(shell_kind_type), POINTER :: shell - NULLIFY(atomic_kinds,particles,shell_particles,core_particles,shell,atom_list) - - my_ireg = ireg - ekin = 0.0_dp - tmass = 0.0_dp - vcom = 0.0_dp - - CALL cp_subsys_get(subsys, atomic_kinds=atomic_kinds, particles=particles,& - shell_particles=shell_particles, core_particles=core_particles) - - DO ikind=1,atomic_kinds%n_els - atomic_kind => atomic_kinds%els(ikind) - CALL get_atomic_kind(atomic_kind=atomic_kind, atom_list=atom_list, mass=mass,& - natom=natom, shell_active=is_shell, shell=shell) - IF(is_shell) THEN - imass = 1.0_dp / mass - v2 = 0.0_dp - v = 0.0_dp - DO iatom=1,natom - atom = atom_list(iatom) - !check region - IF( particles%els(atom)%t_region_index/=my_ireg) CYCLE - - particles%els(atom)%v(:) = fscale*particles%els(atom)%v - shell_index = particles%els(atom)%shell_index - vs = shell_particles%els(shell_index)%v - vc = core_particles %els(shell_index)%v - tmp(1) = imass*(vs(1)-vc(1)) - tmp(2) = imass*(vs(2)-vc(2)) - tmp(3) = imass*(vs(3)-vc(3)) - - shell_particles%els(shell_index)%v(1) = particles%els(atom)%v(1) + tmp(1)*shell%mass_core - shell_particles%els(shell_index)%v(2) = particles%els(atom)%v(2) + tmp(2)*shell%mass_core - shell_particles%els(shell_index)%v(3) = particles%els(atom)%v(3) + tmp(3)*shell%mass_core - - core_particles%els(shell_index)%v(1) = particles%els(atom)%v(1) - tmp(1)*shell%mass_shell - core_particles%els(shell_index)%v(2) = particles%els(atom)%v(2) - tmp(2)*shell%mass_shell - core_particles%els(shell_index)%v(3) = particles%els(atom)%v(3) - tmp(3)*shell%mass_shell - - ! kinetic energy and velocity of COM - v2 = v2 + SUM(particles%els(atom)%v**2) - v(1) = v(1) + particles%els(atom)%v(1) - v(2) = v(2) + particles%els(atom)%v(2) - v(3) = v(3) + particles%els(atom)%v(3) - tmass = tmass + mass - END DO - ELSE - v2 = 0.0_dp - v = 0.0_dp - DO iatom=1,natom - atom = atom_list(iatom) - !check region - IF( particles%els(atom)%t_region_index/=my_ireg) CYCLE - - particles%els(atom)%v(:) = fscale*particles%els(atom)%v - ! kinetic energy and velocity of COM - v2 = v2 + SUM(particles%els(atom)%v**2) - v(1) = v(1) + particles%els(atom)%v(1) - v(2) = v(2) + particles%els(atom)%v(2) - v(3) = v(3) + particles%els(atom)%v(3) - tmass = tmass + mass - END DO - END IF - ekin = ekin + 0.5_dp*mass*v2 - vcom(1) = vcom(1) + mass*v(1) - vcom(2) = vcom(2) + mass*v(2) - vcom(3) = vcom(3) + mass*v(3) - - END DO - vcom = vcom / tmass - - END SUBROUTINE scale_velocity_low + NULLIFY (atomic_kinds, particles, shell_particles, core_particles, shell, atom_list) + + my_ireg = ireg + ekin = 0.0_dp + tmass = 0.0_dp + vcom = 0.0_dp + + CALL cp_subsys_get(subsys, atomic_kinds=atomic_kinds, particles=particles, & + shell_particles=shell_particles, core_particles=core_particles) + + DO ikind = 1, atomic_kinds%n_els + atomic_kind => atomic_kinds%els(ikind) + CALL get_atomic_kind(atomic_kind=atomic_kind, atom_list=atom_list, mass=mass, & + natom=natom, shell_active=is_shell, shell=shell) + IF (is_shell) THEN + imass = 1.0_dp/mass + v2 = 0.0_dp + v = 0.0_dp + DO iatom = 1, natom + atom = atom_list(iatom) + !check region + IF (particles%els(atom)%t_region_index /= my_ireg) CYCLE + + particles%els(atom)%v(:) = fscale*particles%els(atom)%v + shell_index = particles%els(atom)%shell_index + vs = shell_particles%els(shell_index)%v + vc = core_particles%els(shell_index)%v + tmp(1) = imass*(vs(1) - vc(1)) + tmp(2) = imass*(vs(2) - vc(2)) + tmp(3) = imass*(vs(3) - vc(3)) + + shell_particles%els(shell_index)%v(1) = particles%els(atom)%v(1) + tmp(1)*shell%mass_core + shell_particles%els(shell_index)%v(2) = particles%els(atom)%v(2) + tmp(2)*shell%mass_core + shell_particles%els(shell_index)%v(3) = particles%els(atom)%v(3) + tmp(3)*shell%mass_core + + core_particles%els(shell_index)%v(1) = particles%els(atom)%v(1) - tmp(1)*shell%mass_shell + core_particles%els(shell_index)%v(2) = particles%els(atom)%v(2) - tmp(2)*shell%mass_shell + core_particles%els(shell_index)%v(3) = particles%els(atom)%v(3) - tmp(3)*shell%mass_shell + + ! kinetic energy and velocity of COM + v2 = v2 + SUM(particles%els(atom)%v**2) + v(1) = v(1) + particles%els(atom)%v(1) + v(2) = v(2) + particles%els(atom)%v(2) + v(3) = v(3) + particles%els(atom)%v(3) + tmass = tmass + mass + END DO + ELSE + v2 = 0.0_dp + v = 0.0_dp + DO iatom = 1, natom + atom = atom_list(iatom) + !check region + IF (particles%els(atom)%t_region_index /= my_ireg) CYCLE + + particles%els(atom)%v(:) = fscale*particles%els(atom)%v + ! kinetic energy and velocity of COM + v2 = v2 + SUM(particles%els(atom)%v**2) + v(1) = v(1) + particles%els(atom)%v(1) + v(2) = v(2) + particles%els(atom)%v(2) + v(3) = v(3) + particles%els(atom)%v(3) + tmass = tmass + mass + END DO + END IF + ekin = ekin + 0.5_dp*mass*v2 + vcom(1) = vcom(1) + mass*v(1) + vcom(2) = vcom(2) + mass*v(2) + vcom(3) = vcom(3) + mass*v(3) + + END DO + vcom = vcom/tmass + + END SUBROUTINE scale_velocity_low ! ************************************************************************************************** !> \brief Scale internal motion of CORE-SHELL model to the correct temperature @@ -1724,7 +1719,7 @@ END SUBROUTINE scale_velocity_low !> \par History !> Teodoro Laino - University of Zurich - 09.2007 [tlaino] ! ************************************************************************************************** - SUBROUTINE scale_velocity_internal(subsys, md_ener, temp_expected, temp_tol, iw) + SUBROUTINE scale_velocity_internal(subsys, md_ener, temp_expected, temp_tol, iw) TYPE(cp_subsys_type), POINTER :: subsys TYPE(md_ener_type), POINTER :: md_ener REAL(KIND=dp), INTENT(IN) :: temp_expected, temp_tol @@ -1745,65 +1740,65 @@ SUBROUTINE scale_velocity_internal(subsys, md_ener, temp_expected, temp_tol, iw shell_particles TYPE(shell_kind_type), POINTER :: shell - NULLIFY(atom_list,atomic_kinds,atomic_kind,core_particles,particles,shell_particles,shell) - IF (ABS(temp_expected - md_ener%temp_shell/kelvin) > temp_tol) THEN - scale = 0.0_dp - IF (md_ener%temp_shell>EPSILON(0.0_dp)) scale = SQRT((temp_expected/md_ener%temp_shell)*kelvin) - ekin_shell_old = md_ener%ekin_shell - temp_shell_old = md_ener%temp_shell - md_ener%ekin_shell = 0.0_dp - md_ener%temp_shell = 0.0_dp - - CALL cp_subsys_get(subsys, atomic_kinds=atomic_kinds, particles=particles, shell_particles=shell_particles,& - core_particles=core_particles) - - DO ikind=1,atomic_kinds%n_els - atomic_kind => atomic_kinds%els(ikind) - CALL get_atomic_kind(atomic_kind=atomic_kind, atom_list=atom_list, mass=mass, natom=natom,& - shell_active=is_shell, shell=shell) - IF(is_shell) THEN - fac_mass = 1.0_dp/mass - v2 = 0.0_dp - DO iatom= 1, natom - atom = atom_list(iatom) - shell_index = particles%els(atom)%shell_index - vs = shell_particles%els(shell_index)%v - vc = core_particles%els(shell_index)%v - v = particles%els(atom)%v - tmp(1) = fac_mass*(vc(1)-vs(1)) - tmp(2) = fac_mass*(vc(2)-vs(2)) - tmp(3) = fac_mass*(vc(3)-vs(3)) - - shell_particles%els(shell_index)%v(1) = v(1) - shell%mass_core*scale*tmp(1) - shell_particles%els(shell_index)%v(2) = v(2) - shell%mass_core*scale*tmp(2) - shell_particles%els(shell_index)%v(3) = v(3) - shell%mass_core*scale*tmp(3) - - core_particles%els(shell_index)%v(1) = v(1) + shell%mass_shell*scale*tmp(1) - core_particles%els(shell_index)%v(2) = v(2) + shell%mass_shell*scale*tmp(2) - core_particles%els(shell_index)%v(3) = v(3) + shell%mass_shell*scale*tmp(3) - - vs = shell_particles%els(shell_index)%v - vc = core_particles%els(shell_index)%v - tmp(1) = vc(1) - vs(1) - tmp(2) = vc(2) - vs(2) - tmp(3) = vc(3) - vs(3) - v2 = v2 + SUM(tmp**2) - END DO - md_ener%ekin_shell = md_ener%ekin_shell + 0.5_dp*shell%mass_core*shell%mass_shell*fac_mass*v2 - END IF - END DO - IF(md_ener%nfree_shell>0)THEN - md_ener%temp_shell = 2.0_dp*md_ener%ekin_shell/REAL(md_ener%nfree_shell,KIND=dp)*kelvin - END IF - md_ener%constant = md_ener%constant - ekin_shell_old + md_ener%ekin_shell - - IF (iw>0) THEN - WRITE (UNIT=iw,FMT="(/,T2,A,F10.2,A,F10.2,A)")& - "Temperature shell internal motion scaled to requested temperature:",& - temp_shell_old," K ->",md_ener%temp_shell," K" - END IF - ENDIF - END SUBROUTINE scale_velocity_internal + NULLIFY (atom_list, atomic_kinds, atomic_kind, core_particles, particles, shell_particles, shell) + IF (ABS(temp_expected - md_ener%temp_shell/kelvin) > temp_tol) THEN + scale = 0.0_dp + IF (md_ener%temp_shell > EPSILON(0.0_dp)) scale = SQRT((temp_expected/md_ener%temp_shell)*kelvin) + ekin_shell_old = md_ener%ekin_shell + temp_shell_old = md_ener%temp_shell + md_ener%ekin_shell = 0.0_dp + md_ener%temp_shell = 0.0_dp + + CALL cp_subsys_get(subsys, atomic_kinds=atomic_kinds, particles=particles, shell_particles=shell_particles, & + core_particles=core_particles) + + DO ikind = 1, atomic_kinds%n_els + atomic_kind => atomic_kinds%els(ikind) + CALL get_atomic_kind(atomic_kind=atomic_kind, atom_list=atom_list, mass=mass, natom=natom, & + shell_active=is_shell, shell=shell) + IF (is_shell) THEN + fac_mass = 1.0_dp/mass + v2 = 0.0_dp + DO iatom = 1, natom + atom = atom_list(iatom) + shell_index = particles%els(atom)%shell_index + vs = shell_particles%els(shell_index)%v + vc = core_particles%els(shell_index)%v + v = particles%els(atom)%v + tmp(1) = fac_mass*(vc(1) - vs(1)) + tmp(2) = fac_mass*(vc(2) - vs(2)) + tmp(3) = fac_mass*(vc(3) - vs(3)) + + shell_particles%els(shell_index)%v(1) = v(1) - shell%mass_core*scale*tmp(1) + shell_particles%els(shell_index)%v(2) = v(2) - shell%mass_core*scale*tmp(2) + shell_particles%els(shell_index)%v(3) = v(3) - shell%mass_core*scale*tmp(3) + + core_particles%els(shell_index)%v(1) = v(1) + shell%mass_shell*scale*tmp(1) + core_particles%els(shell_index)%v(2) = v(2) + shell%mass_shell*scale*tmp(2) + core_particles%els(shell_index)%v(3) = v(3) + shell%mass_shell*scale*tmp(3) + + vs = shell_particles%els(shell_index)%v + vc = core_particles%els(shell_index)%v + tmp(1) = vc(1) - vs(1) + tmp(2) = vc(2) - vs(2) + tmp(3) = vc(3) - vs(3) + v2 = v2 + SUM(tmp**2) + END DO + md_ener%ekin_shell = md_ener%ekin_shell + 0.5_dp*shell%mass_core*shell%mass_shell*fac_mass*v2 + END IF + END DO + IF (md_ener%nfree_shell > 0) THEN + md_ener%temp_shell = 2.0_dp*md_ener%ekin_shell/REAL(md_ener%nfree_shell, KIND=dp)*kelvin + END IF + md_ener%constant = md_ener%constant - ekin_shell_old + md_ener%ekin_shell + + IF (iw > 0) THEN + WRITE (UNIT=iw, FMT="(/,T2,A,F10.2,A,F10.2,A)") & + "Temperature shell internal motion scaled to requested temperature:", & + temp_shell_old, " K ->", md_ener%temp_shell, " K" + END IF + ENDIF + END SUBROUTINE scale_velocity_internal ! ************************************************************************************************** !> \brief Scale barostat velocities to get the desired temperature @@ -1815,7 +1810,7 @@ END SUBROUTINE scale_velocity_internal !> \par History !> MI 02.2008 ! ************************************************************************************************** - SUBROUTINE scale_velocity_baro(md_env, md_ener, temp_expected, temp_tol, iw) + SUBROUTINE scale_velocity_baro(md_env, md_ener, temp_expected, temp_tol, iw) TYPE(md_environment_type), POINTER :: md_env TYPE(md_ener_type), POINTER :: md_ener REAL(KIND=dp), INTENT(IN) :: temp_expected, temp_tol @@ -1826,40 +1821,40 @@ SUBROUTINE scale_velocity_baro(md_env, md_ener, temp_expected, temp_tol, iw) INTEGER :: i, j, nfree REAL(KIND=dp) :: ekin_old, scale, temp_old - TYPE(npt_info_type), POINTER :: npt( :, : ) + TYPE(npt_info_type), POINTER :: npt(:, :) TYPE(simpar_type), POINTER :: simpar - NULLIFY( npt, simpar) - CALL get_md_env ( md_env, simpar = simpar, npt = npt) - IF (ABS(temp_expected - md_ener%temp_baro/kelvin) > temp_tol) THEN - scale = 0.0_dp - IF (md_ener%temp_baro>0.0_dp) scale = SQRT((temp_expected/md_ener%temp_baro)*kelvin) - ekin_old = md_ener%baro_kin - temp_old = md_ener%temp_baro - md_ener%baro_kin = 0.0_dp - md_ener%temp_baro = 0.0_dp - IF ( simpar%ensemble==npt_i_ensemble .OR. simpar%ensemble==npe_i_ensemble) THEN - npt ( 1, 1 )%v = npt ( 1, 1 )%v*scale - md_ener%baro_kin = 0.5_dp * npt ( 1, 1 )%v**2 * npt ( 1, 1 )%mass - ELSE IF (simpar%ensemble==npt_f_ensemble .OR. simpar%ensemble==npe_f_ensemble) THEN + NULLIFY (npt, simpar) + CALL get_md_env(md_env, simpar=simpar, npt=npt) + IF (ABS(temp_expected - md_ener%temp_baro/kelvin) > temp_tol) THEN + scale = 0.0_dp + IF (md_ener%temp_baro > 0.0_dp) scale = SQRT((temp_expected/md_ener%temp_baro)*kelvin) + ekin_old = md_ener%baro_kin + temp_old = md_ener%temp_baro md_ener%baro_kin = 0.0_dp - DO i = 1, 3 - DO j = 1, 3 - npt(i,j)%v = npt(i,j)%v*scale - md_ener%baro_kin = md_ener%baro_kin + 0.5_dp * npt(i,j)%v**2 * npt ( i, j )%mass + md_ener%temp_baro = 0.0_dp + IF (simpar%ensemble == npt_i_ensemble .OR. simpar%ensemble == npe_i_ensemble) THEN + npt(1, 1)%v = npt(1, 1)%v*scale + md_ener%baro_kin = 0.5_dp*npt(1, 1)%v**2*npt(1, 1)%mass + ELSE IF (simpar%ensemble == npt_f_ensemble .OR. simpar%ensemble == npe_f_ensemble) THEN + md_ener%baro_kin = 0.0_dp + DO i = 1, 3 + DO j = 1, 3 + npt(i, j)%v = npt(i, j)%v*scale + md_ener%baro_kin = md_ener%baro_kin + 0.5_dp*npt(i, j)%v**2*npt(i, j)%mass + END DO END DO - END DO - END IF - - nfree = SIZE ( npt, 1 ) * SIZE ( npt, 2 ) - md_ener%temp_baro = 2.0_dp * md_ener%baro_kin / REAL(nfree,dp)*kelvin - IF (iw>0) THEN - WRITE (UNIT=iw,FMT="(/,T2,A,F10.2,A,F10.2,A)")& - "Temperature of barostat motion scaled to requested temperature:",& - temp_old," K ->",md_ener%temp_baro," K" + END IF + + nfree = SIZE(npt, 1)*SIZE(npt, 2) + md_ener%temp_baro = 2.0_dp*md_ener%baro_kin/REAL(nfree, dp)*kelvin + IF (iw > 0) THEN + WRITE (UNIT=iw, FMT="(/,T2,A,F10.2,A,F10.2,A)") & + "Temperature of barostat motion scaled to requested temperature:", & + temp_old, " K ->", md_ener%temp_baro, " K" + END IF END IF - END IF - END SUBROUTINE scale_velocity_baro + END SUBROUTINE scale_velocity_baro ! ************************************************************************************************** !> \brief Perform all temperature manipulations during a QS MD run. @@ -1873,7 +1868,7 @@ END SUBROUTINE scale_velocity_baro !> adapted to force_env (05.10.2003,fawzi) !> Cleaned (09.2007) Teodoro Laino [tlaino] - University of Zurich ! ************************************************************************************************** - SUBROUTINE temperature_control(simpar, md_env, md_ener,force_env,logger) + SUBROUTINE temperature_control(simpar, md_env, md_ener, force_env, logger) TYPE(simpar_type), POINTER :: simpar TYPE(md_environment_type), POINTER :: md_env @@ -1888,40 +1883,40 @@ SUBROUTINE temperature_control(simpar, md_env, md_ener,force_env,logger) TYPE(cp_para_env_type), POINTER :: para_env TYPE(cp_subsys_type), POINTER :: subsys - CALL timeset(routineN,handle) - NULLIFY(subsys, para_env) - CPASSERT(ASSOCIATED(simpar)) - CPASSERT(ASSOCIATED(md_ener)) - CPASSERT(ASSOCIATED(force_env)) - CALL force_env_get(force_env,subsys=subsys,para_env=para_env) - iw = cp_print_key_unit_nr(logger,force_env%root_section,"MOTION%MD%PRINT%PROGRAM_RUN_INFO",& - extension=".mdLog") - - ! Control the particle motion - IF(simpar%do_thermal_region) THEN - CALL scale_velocity_region(md_env, subsys, md_ener, simpar, iw) - ELSE - IF (simpar%temp_tol > 0.0_dp ) THEN - CALL scale_velocity(subsys, md_ener, simpar%temp_ext, simpar%temp_tol, iw) + CALL timeset(routineN, handle) + NULLIFY (subsys, para_env) + CPASSERT(ASSOCIATED(simpar)) + CPASSERT(ASSOCIATED(md_ener)) + CPASSERT(ASSOCIATED(force_env)) + CALL force_env_get(force_env, subsys=subsys, para_env=para_env) + iw = cp_print_key_unit_nr(logger, force_env%root_section, "MOTION%MD%PRINT%PROGRAM_RUN_INFO", & + extension=".mdLog") + + ! Control the particle motion + IF (simpar%do_thermal_region) THEN + CALL scale_velocity_region(md_env, subsys, md_ener, simpar, iw) + ELSE + IF (simpar%temp_tol > 0.0_dp) THEN + CALL scale_velocity(subsys, md_ener, simpar%temp_ext, simpar%temp_tol, iw) + END IF + END IF + ! Control the internal core-shell motion + IF (simpar%temp_sh_tol > 0.0_dp) THEN + CALL scale_velocity_internal(subsys, md_ener, simpar%temp_sh_ext, simpar%temp_sh_tol, iw) END IF - END IF - ! Control the internal core-shell motion - IF(simpar%temp_sh_tol > 0.0_dp) THEN - CALL scale_velocity_internal(subsys, md_ener, simpar%temp_sh_ext, simpar%temp_sh_tol, iw) - END IF - ! Control cell motion - SELECT CASE (simpar%ensemble) - CASE( nph_uniaxial_damped_ensemble, nph_uniaxial_ensemble, & + ! Control cell motion + SELECT CASE (simpar%ensemble) + CASE (nph_uniaxial_damped_ensemble, nph_uniaxial_ensemble, & npt_f_ensemble, npt_i_ensemble, npe_f_ensemble, npe_i_ensemble) - IF(simpar%temp_baro_tol > 0.0_dp) THEN - CALL scale_velocity_baro(md_env, md_ener, simpar%temp_baro_ext, simpar%temp_baro_tol, iw) - END IF - END SELECT + IF (simpar%temp_baro_tol > 0.0_dp) THEN + CALL scale_velocity_baro(md_env, md_ener, simpar%temp_baro_ext, simpar%temp_baro_tol, iw) + END IF + END SELECT - CALL cp_print_key_finished_output(iw,logger,force_env%root_section,& - "MOTION%MD%PRINT%PROGRAM_RUN_INFO") - CALL timestop(handle) - END SUBROUTINE temperature_control + CALL cp_print_key_finished_output(iw, logger, force_env%root_section, & + "MOTION%MD%PRINT%PROGRAM_RUN_INFO") + CALL timestop(handle) + END SUBROUTINE temperature_control ! ************************************************************************************************** !> \brief Set to 0 the velocity of the COM along MD runs, if required. @@ -1933,7 +1928,7 @@ END SUBROUTINE temperature_control !> Creation (29.04.2007,MI) !> Cleaned (09.2007) Teodoro Laino [tlaino] - University of Zurich ! ************************************************************************************************** - SUBROUTINE comvel_control(md_ener,force_env, md_section, logger) + SUBROUTINE comvel_control(md_ener, force_env, md_section, logger) TYPE(md_ener_type), POINTER :: md_ener TYPE(force_env_type), POINTER :: force_env @@ -1948,45 +1943,45 @@ SUBROUTINE comvel_control(md_ener,force_env, md_section, logger) REAL(KIND=dp), DIMENSION(3) :: vcom_old TYPE(cp_subsys_type), POINTER :: subsys - CALL timeset(routineN,handle) - NULLIFY(subsys) - CPASSERT(ASSOCIATED(force_env)) - CALL force_env_get(force_env,subsys=subsys) - - ! Print COMVEL and COM Position - iw = cp_print_key_unit_nr(logger,md_section,"PRINT%CENTER_OF_MASS",extension=".mdLog") - IF (iw>0) THEN - WRITE (UNIT=iw,FMT="(/,T2,A,(T58,A3,F20.10))")& - "Centre of mass motion (COM):","x =",md_ener%vcom(1),"y =",md_ener%vcom(2),"z =",md_ener%vcom(3) - END IF - CALL cp_print_key_finished_output(iw,logger,md_section,"PRINT%CENTER_OF_MASS") - - ! If requested rescale COMVEL - CALL section_vals_val_get(md_section,"COMVEL_TOL",explicit=explicit) - IF ( explicit ) THEN - CALL section_vals_val_get(md_section,"COMVEL_TOL",r_val=comvel_tol) - iw = cp_print_key_unit_nr(logger,md_section,"PRINT%PROGRAM_RUN_INFO",& - extension=".mdLog") - vel_com = SQRT(md_ener%vcom(1)**2+md_ener%vcom(2)**2+md_ener%vcom(3)**2) - - ! Subtract the velocity of the COM, if requested - IF (vel_com > comvel_tol) THEN - temp_old = md_ener%temp_part/kelvin - vcom_old = md_ener%vcom - CALL reset_vcom( subsys, md_ener, vsubtract=vcom_old) - CALL scale_velocity(subsys, md_ener, temp_old, 0.0_dp, iw) - IF (iw>0) THEN - WRITE (UNIT=iw,FMT="(T2,'MD| ',A,3F16.10,A)") & - "Old VCOM = ",vcom_old(1:3)," a.u.",& - "New VCOM = ",md_ener%vcom(1:3)," a.u" - END IF - END IF - CALL cp_print_key_finished_output(iw,logger,md_section,& - "PRINT%PROGRAM_RUN_INFO") - END IF - - CALL timestop(handle) - END SUBROUTINE comvel_control + CALL timeset(routineN, handle) + NULLIFY (subsys) + CPASSERT(ASSOCIATED(force_env)) + CALL force_env_get(force_env, subsys=subsys) + + ! Print COMVEL and COM Position + iw = cp_print_key_unit_nr(logger, md_section, "PRINT%CENTER_OF_MASS", extension=".mdLog") + IF (iw > 0) THEN + WRITE (UNIT=iw, FMT="(/,T2,A,(T58,A3,F20.10))") & + "Centre of mass motion (COM):", "x =", md_ener%vcom(1), "y =", md_ener%vcom(2), "z =", md_ener%vcom(3) + END IF + CALL cp_print_key_finished_output(iw, logger, md_section, "PRINT%CENTER_OF_MASS") + + ! If requested rescale COMVEL + CALL section_vals_val_get(md_section, "COMVEL_TOL", explicit=explicit) + IF (explicit) THEN + CALL section_vals_val_get(md_section, "COMVEL_TOL", r_val=comvel_tol) + iw = cp_print_key_unit_nr(logger, md_section, "PRINT%PROGRAM_RUN_INFO", & + extension=".mdLog") + vel_com = SQRT(md_ener%vcom(1)**2 + md_ener%vcom(2)**2 + md_ener%vcom(3)**2) + + ! Subtract the velocity of the COM, if requested + IF (vel_com > comvel_tol) THEN + temp_old = md_ener%temp_part/kelvin + vcom_old = md_ener%vcom + CALL reset_vcom(subsys, md_ener, vsubtract=vcom_old) + CALL scale_velocity(subsys, md_ener, temp_old, 0.0_dp, iw) + IF (iw > 0) THEN + WRITE (UNIT=iw, FMT="(T2,'MD| ',A,3F16.10,A)") & + "Old VCOM = ", vcom_old(1:3), " a.u.", & + "New VCOM = ", md_ener%vcom(1:3), " a.u" + END IF + END IF + CALL cp_print_key_finished_output(iw, logger, md_section, & + "PRINT%PROGRAM_RUN_INFO") + END IF + + CALL timestop(handle) + END SUBROUTINE comvel_control ! ************************************************************************************************** !> \brief Set to 0 the angular velocity along MD runs, if required. @@ -1997,7 +1992,7 @@ END SUBROUTINE comvel_control !> \par History !> Creation (10.2009) Teodoro Laino [tlaino] ! ************************************************************************************************** - SUBROUTINE angvel_control(md_ener, force_env, md_section, logger) + SUBROUTINE angvel_control(md_ener, force_env, md_section, logger) TYPE(md_ener_type), POINTER :: md_ener TYPE(force_env_type), POINTER :: force_env @@ -2019,66 +2014,66 @@ SUBROUTINE angvel_control(md_ener, force_env, md_section, logger) TYPE(molecule_kind_type), POINTER :: molecule_kind TYPE(particle_list_type), POINTER :: particles - CALL timeset(routineN,handle) - ! If requested rescale ANGVEL - CALL section_vals_val_get(md_section,"ANGVEL_TOL",explicit=explicit) - IF ( explicit ) THEN - NULLIFY(subsys, cell) - CPASSERT(ASSOCIATED(force_env)) - CALL force_env_get(force_env,subsys=subsys,cell=cell) - - IF (SUM(cell%perd(1:3)) == 0) THEN - CALL section_vals_val_get(md_section,"ANGVEL_TOL",r_val=angvel_tol) - iw = cp_print_key_unit_nr(logger,md_section,"PRINT%PROGRAM_RUN_INFO",& - extension=".mdLog") - - CALL cp_subsys_get(subsys,molecule_kinds=molecule_kinds,& - particles=particles) - - natoms = SIZE(particles%els) - ! Build a list of all fixed atoms (if any) - ALLOCATE (is_fixed(natoms)) - - is_fixed = use_perd_none - molecule_kind_set => molecule_kinds%els - DO imolecule_kind=1,molecule_kinds%n_els - molecule_kind => molecule_kind_set(imolecule_kind) - CALL get_molecule_kind(molecule_kind=molecule_kind,fixd_list=fixd_list) - IF (ASSOCIATED(fixd_list)) THEN - DO ifixd=1,SIZE(fixd_list) - IF (.NOT.fixd_list(ifixd)%restraint%active) & + CALL timeset(routineN, handle) + ! If requested rescale ANGVEL + CALL section_vals_val_get(md_section, "ANGVEL_TOL", explicit=explicit) + IF (explicit) THEN + NULLIFY (subsys, cell) + CPASSERT(ASSOCIATED(force_env)) + CALL force_env_get(force_env, subsys=subsys, cell=cell) + + IF (SUM(cell%perd(1:3)) == 0) THEN + CALL section_vals_val_get(md_section, "ANGVEL_TOL", r_val=angvel_tol) + iw = cp_print_key_unit_nr(logger, md_section, "PRINT%PROGRAM_RUN_INFO", & + extension=".mdLog") + + CALL cp_subsys_get(subsys, molecule_kinds=molecule_kinds, & + particles=particles) + + natoms = SIZE(particles%els) + ! Build a list of all fixed atoms (if any) + ALLOCATE (is_fixed(natoms)) + + is_fixed = use_perd_none + molecule_kind_set => molecule_kinds%els + DO imolecule_kind = 1, molecule_kinds%n_els + molecule_kind => molecule_kind_set(imolecule_kind) + CALL get_molecule_kind(molecule_kind=molecule_kind, fixd_list=fixd_list) + IF (ASSOCIATED(fixd_list)) THEN + DO ifixd = 1, SIZE(fixd_list) + IF (.NOT. fixd_list(ifixd)%restraint%active) & is_fixed(fixd_list(ifixd)%fixd) = fixd_list(ifixd)%itype - END DO - END IF - END DO - - ! If requested and the system is not periodic, subtract the angular velocity - CALL compute_rcom(particles%els,is_fixed,rcom) - CALL compute_vang(particles%els,is_fixed,rcom,vang) - ! SQRT(DOT_PRODUCT(vang,vang))>angvel_tol - IF (DOT_PRODUCT(vang, vang) > (angvel_tol * angvel_tol)) THEN - CALL subtract_vang(particles%els,is_fixed,rcom,vang) - - ! Rescale velocities after removal - temp_old = md_ener%temp_part/kelvin - CALL scale_velocity(subsys, md_ener, temp_old, 0.0_dp, iw) - CALL compute_vang(particles%els,is_fixed,rcom,vang_new) - IF (iw>0) THEN - WRITE (UNIT=iw,FMT="(T2,'MD| ',A,3F16.10,A)") & - "Old VANG = ",vang(1:3)," a.u.",& - "New VANG = ",vang_new(1:3)," a.u" - END IF - END IF - - DEALLOCATE (is_fixed) - - CALL cp_print_key_finished_output(iw,logger,md_section,& - "PRINT%PROGRAM_RUN_INFO") - END IF - END IF - - CALL timestop(handle) - END SUBROUTINE angvel_control + END DO + END IF + END DO + + ! If requested and the system is not periodic, subtract the angular velocity + CALL compute_rcom(particles%els, is_fixed, rcom) + CALL compute_vang(particles%els, is_fixed, rcom, vang) + ! SQRT(DOT_PRODUCT(vang,vang))>angvel_tol + IF (DOT_PRODUCT(vang, vang) > (angvel_tol*angvel_tol)) THEN + CALL subtract_vang(particles%els, is_fixed, rcom, vang) + + ! Rescale velocities after removal + temp_old = md_ener%temp_part/kelvin + CALL scale_velocity(subsys, md_ener, temp_old, 0.0_dp, iw) + CALL compute_vang(particles%els, is_fixed, rcom, vang_new) + IF (iw > 0) THEN + WRITE (UNIT=iw, FMT="(T2,'MD| ',A,3F16.10,A)") & + "Old VANG = ", vang(1:3), " a.u.", & + "New VANG = ", vang_new(1:3), " a.u" + END IF + END IF + + DEALLOCATE (is_fixed) + + CALL cp_print_key_finished_output(iw, logger, md_section, & + "PRINT%PROGRAM_RUN_INFO") + END IF + END IF + + CALL timestop(handle) + END SUBROUTINE angvel_control ! ************************************************************************************************** !> \brief Initialize Velocities for MD runs @@ -2092,8 +2087,8 @@ END SUBROUTINE angvel_control !> \par History !> Teodoro Laino - University of Zurich - 09.2007 [tlaino] ! ************************************************************************************************** - SUBROUTINE setup_velocities(force_env, simpar, globenv, md_env, md_section, & - constraint_section, write_binary_restart_file) + SUBROUTINE setup_velocities(force_env, simpar, globenv, md_env, md_section, & + constraint_section, write_binary_restart_file) TYPE(force_env_type), POINTER :: force_env TYPE(simpar_type), POINTER :: simpar @@ -2120,118 +2115,118 @@ SUBROUTINE setup_velocities(force_env, simpar, globenv, md_env, md_section, & TYPE(section_vals_type), POINTER :: force_env_section, print_section, & subsys_section - CALL timeset(routineN,handle) - - NULLIFY (atomic_kinds,cell,para_env,subsys,molecule_kinds,core_particles,particles) - NULLIFY (shell_particles,core_particle_set,particle_set,shell_particle_set) - NULLIFY (force_env_section,print_section,subsys_section) - - print_section => section_vals_get_subs_vals(md_section,"PRINT") - apply_cns0 = .FALSE. - IF (simpar%constraint) THEN - CALL section_vals_val_get(constraint_section,"CONSTRAINT_INIT",l_val=apply_cns0) - END IF - ! Always initialize velocities and possibly restart them - CALL force_env_get(force_env, subsys=subsys, cell=cell, para_env=para_env,& - force_env_section=force_env_section) - subsys_section => section_vals_get_subs_vals(force_env_section,"SUBSYS") - - CALL cp_subsys_get(subsys,& - atomic_kinds=atomic_kinds,& - core_particles=core_particles,& - molecule_kinds=molecule_kinds,& - particles=particles,& - shell_particles=shell_particles) - - CALL get_atomic_kind_set(atomic_kind_set=atomic_kinds%els,& - shell_present=shell_present,& - shell_adiabatic=shell_adiabatic) - - NULLIFY (core_particle_set) - NULLIFY (particle_set) - NULLIFY (shell_particle_set) - particle_set => particles%els - - IF (shell_present.AND.shell_adiabatic) THEN - ! Constraints are not yet implemented for core-shell models generally - CALL get_molecule_kind_set(molecule_kind_set=molecule_kinds%els,& - nconstraint=nconstraint,& - nconstraint_fixd=nconstraint_fixd) - IF(nconstraint - nconstraint_fixd /= 0)& - CPABORT("Only the fixed atom constraint is implemented for core-shell models") + CALL timeset(routineN, handle) + + NULLIFY (atomic_kinds, cell, para_env, subsys, molecule_kinds, core_particles, particles) + NULLIFY (shell_particles, core_particle_set, particle_set, shell_particle_set) + NULLIFY (force_env_section, print_section, subsys_section) + + print_section => section_vals_get_subs_vals(md_section, "PRINT") + apply_cns0 = .FALSE. + IF (simpar%constraint) THEN + CALL section_vals_val_get(constraint_section, "CONSTRAINT_INIT", l_val=apply_cns0) + END IF + ! Always initialize velocities and possibly restart them + CALL force_env_get(force_env, subsys=subsys, cell=cell, para_env=para_env, & + force_env_section=force_env_section) + subsys_section => section_vals_get_subs_vals(force_env_section, "SUBSYS") + + CALL cp_subsys_get(subsys, & + atomic_kinds=atomic_kinds, & + core_particles=core_particles, & + molecule_kinds=molecule_kinds, & + particles=particles, & + shell_particles=shell_particles) + + CALL get_atomic_kind_set(atomic_kind_set=atomic_kinds%els, & + shell_present=shell_present, & + shell_adiabatic=shell_adiabatic) + + NULLIFY (core_particle_set) + NULLIFY (particle_set) + NULLIFY (shell_particle_set) + particle_set => particles%els + + IF (shell_present .AND. shell_adiabatic) THEN + ! Constraints are not yet implemented for core-shell models generally + CALL get_molecule_kind_set(molecule_kind_set=molecule_kinds%els, & + nconstraint=nconstraint, & + nconstraint_fixd=nconstraint_fixd) + IF (nconstraint - nconstraint_fixd /= 0) & + CPABORT("Only the fixed atom constraint is implemented for core-shell models") !MK CPPostcondition(.NOT.simpar%constraint,cp_failure_level,routineP,failure) - CPASSERT(ASSOCIATED(shell_particles)) - CPASSERT(ASSOCIATED(core_particles)) - shell_particle_set => shell_particles%els - core_particle_set => core_particles%els - END IF - - CALL initialize_velocities(simpar, & - particle_set, & - molecule_kinds=molecule_kinds, & - force_env=force_env, & - globenv=globenv, & - md_env=md_env, & - label="Velocities initialization", & - print_section=print_section, & - subsys_section=subsys_section, & - shell_present=(shell_present.AND.shell_adiabatic), & - shell_part=shell_particle_set, & - core_part=core_particle_set, & - force_rescaling=.FALSE., & - para_env=para_env, & - write_binary_restart_file=write_binary_restart_file) - - ! Apply constraints if required and rescale velocities.. - IF (simpar%ensemble /= reftraj_ensemble) THEN - IF (apply_cns0) THEN - CALL force_env_calc_energy_force(force_env, calc_force=.TRUE.) - CALL force_env_shake(force_env, & - shake_tol=simpar%shake_tol,& - log_unit=simpar%info_constraint, & - lagrange_mult=simpar%lagrange_multipliers,& - dump_lm=simpar%dump_lm, & - compold=.TRUE.) - CALL force_env_rattle(force_env,shake_tol=simpar%shake_tol,& - log_unit=simpar%info_constraint,lagrange_mult=simpar%lagrange_multipliers,& - dump_lm=simpar%dump_lm,reset=.TRUE.) - IF (simpar%do_respa)THEN - CALL force_env_calc_energy_force (force_env%sub_force_env(1)%force_env,& - calc_force=.TRUE.) - CALL force_env_shake(force_env%sub_force_env(1)%force_env,& - shake_tol=simpar%shake_tol,log_unit=simpar%info_constraint,& - lagrange_mult=simpar%lagrange_multipliers,dump_lm=simpar%dump_lm,compold=.TRUE.) - CALL force_env_rattle(force_env%sub_force_env(1)%force_env,& - shake_tol=simpar%shake_tol,log_unit=simpar%info_constraint,& - lagrange_mult=simpar%lagrange_multipliers,dump_lm=simpar%dump_lm,reset=.TRUE.) - END IF - ! Reinitialize velocities rescaling properly after rattle - subsys_section => section_vals_get_subs_vals(force_env_section,"SUBSYS") - CALL update_subsys(subsys_section,force_env,.FALSE.,write_binary_restart_file) - CALL initialize_velocities(simpar, & - particle_set, & - molecule_kinds=molecule_kinds,& - force_env=force_env, & - globenv=globenv, & - md_env=md_env, & - label="Re-Initializing velocities after applying constraints", & - print_section=print_section, & - subsys_section=subsys_section, & - shell_present=(shell_present.AND.shell_adiabatic), & - shell_part=shell_particle_set, & - core_part=core_particle_set, & - force_rescaling=.TRUE., & - para_env=para_env, & - write_binary_restart_file=write_binary_restart_file) - END IF - END IF - - ! Perform setup for a cascade run - CALL initialize_cascade(simpar,particle_set,molecule_kinds,md_section) - - CALL timestop(handle) - - END SUBROUTINE setup_velocities + CPASSERT(ASSOCIATED(shell_particles)) + CPASSERT(ASSOCIATED(core_particles)) + shell_particle_set => shell_particles%els + core_particle_set => core_particles%els + END IF + + CALL initialize_velocities(simpar, & + particle_set, & + molecule_kinds=molecule_kinds, & + force_env=force_env, & + globenv=globenv, & + md_env=md_env, & + label="Velocities initialization", & + print_section=print_section, & + subsys_section=subsys_section, & + shell_present=(shell_present .AND. shell_adiabatic), & + shell_part=shell_particle_set, & + core_part=core_particle_set, & + force_rescaling=.FALSE., & + para_env=para_env, & + write_binary_restart_file=write_binary_restart_file) + + ! Apply constraints if required and rescale velocities.. + IF (simpar%ensemble /= reftraj_ensemble) THEN + IF (apply_cns0) THEN + CALL force_env_calc_energy_force(force_env, calc_force=.TRUE.) + CALL force_env_shake(force_env, & + shake_tol=simpar%shake_tol, & + log_unit=simpar%info_constraint, & + lagrange_mult=simpar%lagrange_multipliers, & + dump_lm=simpar%dump_lm, & + compold=.TRUE.) + CALL force_env_rattle(force_env, shake_tol=simpar%shake_tol, & + log_unit=simpar%info_constraint, lagrange_mult=simpar%lagrange_multipliers, & + dump_lm=simpar%dump_lm, reset=.TRUE.) + IF (simpar%do_respa) THEN + CALL force_env_calc_energy_force(force_env%sub_force_env(1)%force_env, & + calc_force=.TRUE.) + CALL force_env_shake(force_env%sub_force_env(1)%force_env, & + shake_tol=simpar%shake_tol, log_unit=simpar%info_constraint, & + lagrange_mult=simpar%lagrange_multipliers, dump_lm=simpar%dump_lm, compold=.TRUE.) + CALL force_env_rattle(force_env%sub_force_env(1)%force_env, & + shake_tol=simpar%shake_tol, log_unit=simpar%info_constraint, & + lagrange_mult=simpar%lagrange_multipliers, dump_lm=simpar%dump_lm, reset=.TRUE.) + END IF + ! Reinitialize velocities rescaling properly after rattle + subsys_section => section_vals_get_subs_vals(force_env_section, "SUBSYS") + CALL update_subsys(subsys_section, force_env, .FALSE., write_binary_restart_file) + CALL initialize_velocities(simpar, & + particle_set, & + molecule_kinds=molecule_kinds, & + force_env=force_env, & + globenv=globenv, & + md_env=md_env, & + label="Re-Initializing velocities after applying constraints", & + print_section=print_section, & + subsys_section=subsys_section, & + shell_present=(shell_present .AND. shell_adiabatic), & + shell_part=shell_particle_set, & + core_part=core_particle_set, & + force_rescaling=.TRUE., & + para_env=para_env, & + write_binary_restart_file=write_binary_restart_file) + END IF + END IF + + ! Perform setup for a cascade run + CALL initialize_cascade(simpar, particle_set, molecule_kinds, md_section) + + CALL timestop(handle) + + END SUBROUTINE setup_velocities ! ************************************************************************************************** !> \brief Perform the initialization for a cascade run @@ -2243,7 +2238,7 @@ END SUBROUTINE setup_velocities !> \author Matthias Krack (MK) !> \version 1.0 ! ************************************************************************************************** - SUBROUTINE initialize_cascade(simpar,particle_set,molecule_kinds,md_section) + SUBROUTINE initialize_cascade(simpar, particle_set, molecule_kinds, md_section) TYPE(simpar_type), POINTER :: simpar TYPE(particle_type), DIMENSION(:), POINTER :: particle_set @@ -2273,150 +2268,149 @@ SUBROUTINE initialize_cascade(simpar,particle_set,molecule_kinds,md_section) print_section TYPE(val_type), POINTER :: val - CALL timeset(routineN,handle) - - - NULLIFY (atom_list) - NULLIFY (atom_list_section) - NULLIFY (atomic_kind) - NULLIFY (cascade_section) - NULLIFY (fixd_list) - NULLIFY (molecule_kind) - NULLIFY (molecule_kind_set) - NULLIFY (logger) - NULLIFY (val) - - logger => cp_get_default_logger() - print_section => section_vals_get_subs_vals(md_section,"PRINT") - iw = cp_print_key_unit_nr(logger,print_section,"PROGRAM_RUN_INFO",extension=".log") - - cascade_section => section_vals_get_subs_vals(md_section,"CASCADE") - CALL section_vals_val_get(cascade_section,"_SECTION_PARAMETERS_",l_val=init_cascade) - - nparticle = SIZE(particle_set) - - IF (init_cascade) THEN - - CALL section_vals_val_get(cascade_section,"ENERGY",r_val=energy) - IF(energy < 0.0_dp)& - CPABORT("Error occurred reading &CASCADE section: Negative energy found") - - IF (iw > 0) THEN - ekin = cp_unit_from_cp2k(energy,"keV") - WRITE (UNIT=iw,FMT="(T2,A,T61,F20.6)")& - "CASCADE| Energy [keV]",ekin - WRITE (UNIT=iw,FMT="(T2,A)")& - "CASCADE|" - END IF - - ! Read the atomic velocities given in the input file - atom_list_section => section_vals_get_subs_vals(cascade_section,"ATOM_LIST") - CALL section_vals_val_get(atom_list_section,"_DEFAULT_KEYWORD_",n_rep_val=natom) - CALL section_vals_list_get(atom_list_section,"_DEFAULT_KEYWORD_",list=atom_list) - IF(natom <= 0)& - CPABORT("Error occurred reading &CASCADE section: No atom list found") - - IF (iw > 0) THEN - WRITE (UNIT=iw,FMT="(T2,A,T11,A,3(11X,A),9X,A)")& - "CASCADE| ","Atom index","v(x)","v(y)","v(z)","weight" - END IF - - ALLOCATE (atom_index(natom)) - ALLOCATE (matom(natom)) - ALLOCATE (vatom(3,natom)) - ALLOCATE (weight(natom)) - - DO iatom=1,natom - is_ok = cp_sll_val_next(atom_list,val) - CALL val_get(val,c_val=line) - ! Read atomic index, velocity vector, and weight - no_read_error = .FALSE. - READ (UNIT=line,FMT=*,ERR=999) atom_index(iatom),vatom(1:3,iatom),weight(iatom) - no_read_error = .TRUE. -999 IF(.NOT.no_read_error)& - CPABORT("Error occurred reading &CASCADE section. Last line read <"//TRIM(line)//">") - IF((atom_index(iatom) <= 0).OR.((atom_index(iatom) > nparticle)))& - CPABORT("Error occurred reading &CASCADE section: Invalid atom index found") - IF(weight(iatom) < 0.0_dp)& - CPABORT("Error occurred reading &CASCADE section: Negative weight found") - IF (iw > 0) THEN - WRITE (UNIT=iw,FMT="(T2,A,I10,4(1X,F14.6))")& - "CASCADE| ",atom_index(iatom),vatom(1:3,iatom),weight(iatom) - END IF - END DO - - ! Normalise velocities and weights - norm = 0.0_dp - DO iatom=1,natom - iparticle = atom_index(iatom) - IF(particle_set(iparticle)%shell_index /= 0)& - CPWARN("Warning: The primary knock-on atom is a core-shell atom") - atomic_kind => particle_set(iparticle)%atomic_kind - CALL get_atomic_kind(atomic_kind=atomic_kind,mass=matom(iatom)) - norm = norm + matom(iatom)*weight(iatom) - END DO - weight(:) = matom(:)*weight(:)*energy/norm - DO iatom=1,natom - norm = SQRT(DOT_PRODUCT(vatom(1:3,iatom),vatom(1:3,iatom))) - vatom(1:3,iatom) = vatom(1:3,iatom)/norm - END DO - - IF (iw > 0) THEN - WRITE (UNIT=iw,FMT="(T2,A)")& - "CASCADE|",& - "CASCADE| Normalised velocities and additional kinetic energy [keV]",& - "CASCADE|" - WRITE (UNIT=iw,FMT="(T2,A,T11,A,3(11X,A),9X,A)")& - "CASCADE| ","Atom index","v(x)","v(y)","v(z)","E(kin)" - DO iatom=1,natom - ekin = cp_unit_from_cp2k(weight(iatom),"keV") - WRITE (UNIT=iw,FMT="(T2,A,I10,4(1X,F14.6))")& - "CASCADE| ",atom_index(iatom),vatom(1:3,iatom),ekin - END DO - END IF - - ! Apply velocity modifications - DO iatom=1,natom - iparticle = atom_index(iatom) - particle_set(iparticle)%v(:) = particle_set(iparticle)%v(:) +& - SQRT(2.0_dp*weight(iatom)/matom(iatom))*vatom(1:3,iatom) - END DO - - DEALLOCATE (atom_index) - DEALLOCATE (matom) - DEALLOCATE (vatom) - DEALLOCATE (weight) - - IF (iw > 0) THEN - ! Build a list of all fixed atoms (if any) - ALLOCATE (is_fixed(nparticle)) - is_fixed = use_perd_none - molecule_kind_set => molecule_kinds%els - DO imolecule_kind=1,molecule_kinds%n_els - molecule_kind => molecule_kind_set(imolecule_kind) - CALL get_molecule_kind(molecule_kind=molecule_kind,fixd_list=fixd_list) - IF (ASSOCIATED(fixd_list)) THEN - DO ifixd=1,SIZE(fixd_list) - IF (.NOT.fixd_list(ifixd)%restraint%active) is_fixed(fixd_list(ifixd)%fixd) = fixd_list(ifixd)%itype - END DO - END IF - END DO - ! Compute vcom, ecom and ekin for printout - CALL compute_vcom(particle_set,is_fixed,vcom,ecom) - ekin = compute_ekin(particle_set) - ecom - IF (simpar%nfree == 0) THEN - CPASSERT(ekin == 0.0_dp) - temp = 0.0_dp - ELSE - temp = 2.0_dp*ekin/REAL(simpar%nfree,KIND=dp) - END IF - temperature = cp_unit_from_cp2k(temp,"K") - WRITE (UNIT=iw,FMT="(T2,A)")& - "CASCADE|" - WRITE (UNIT=iw,FMT="(T2,A,T61,F18.2,A2)")& - "CASCADE| Temperature after cascade initialization",temperature," K" - WRITE (UNIT=iw,FMT="(T2,A,T30,3(1X,ES16.8),/)")& - "CASCADE| COM velocity: ",vcom(1:3) + CALL timeset(routineN, handle) + + NULLIFY (atom_list) + NULLIFY (atom_list_section) + NULLIFY (atomic_kind) + NULLIFY (cascade_section) + NULLIFY (fixd_list) + NULLIFY (molecule_kind) + NULLIFY (molecule_kind_set) + NULLIFY (logger) + NULLIFY (val) + + logger => cp_get_default_logger() + print_section => section_vals_get_subs_vals(md_section, "PRINT") + iw = cp_print_key_unit_nr(logger, print_section, "PROGRAM_RUN_INFO", extension=".log") + + cascade_section => section_vals_get_subs_vals(md_section, "CASCADE") + CALL section_vals_val_get(cascade_section, "_SECTION_PARAMETERS_", l_val=init_cascade) + + nparticle = SIZE(particle_set) + + IF (init_cascade) THEN + + CALL section_vals_val_get(cascade_section, "ENERGY", r_val=energy) + IF (energy < 0.0_dp) & + CPABORT("Error occurred reading &CASCADE section: Negative energy found") + + IF (iw > 0) THEN + ekin = cp_unit_from_cp2k(energy, "keV") + WRITE (UNIT=iw, FMT="(T2,A,T61,F20.6)") & + "CASCADE| Energy [keV]", ekin + WRITE (UNIT=iw, FMT="(T2,A)") & + "CASCADE|" + END IF + + ! Read the atomic velocities given in the input file + atom_list_section => section_vals_get_subs_vals(cascade_section, "ATOM_LIST") + CALL section_vals_val_get(atom_list_section, "_DEFAULT_KEYWORD_", n_rep_val=natom) + CALL section_vals_list_get(atom_list_section, "_DEFAULT_KEYWORD_", list=atom_list) + IF (natom <= 0) & + CPABORT("Error occurred reading &CASCADE section: No atom list found") + + IF (iw > 0) THEN + WRITE (UNIT=iw, FMT="(T2,A,T11,A,3(11X,A),9X,A)") & + "CASCADE| ", "Atom index", "v(x)", "v(y)", "v(z)", "weight" + END IF + + ALLOCATE (atom_index(natom)) + ALLOCATE (matom(natom)) + ALLOCATE (vatom(3, natom)) + ALLOCATE (weight(natom)) + + DO iatom = 1, natom + is_ok = cp_sll_val_next(atom_list, val) + CALL val_get(val, c_val=line) + ! Read atomic index, velocity vector, and weight + no_read_error = .FALSE. + READ (UNIT=line, FMT=*, ERR=999) atom_index(iatom), vatom(1:3, iatom), weight(iatom) + no_read_error = .TRUE. +999 IF (.NOT. no_read_error) & + CPABORT("Error occurred reading &CASCADE section. Last line read <"//TRIM(line)//">") + IF ((atom_index(iatom) <= 0) .OR. ((atom_index(iatom) > nparticle))) & + CPABORT("Error occurred reading &CASCADE section: Invalid atom index found") + IF (weight(iatom) < 0.0_dp) & + CPABORT("Error occurred reading &CASCADE section: Negative weight found") + IF (iw > 0) THEN + WRITE (UNIT=iw, FMT="(T2,A,I10,4(1X,F14.6))") & + "CASCADE| ", atom_index(iatom), vatom(1:3, iatom), weight(iatom) + END IF + END DO + + ! Normalise velocities and weights + norm = 0.0_dp + DO iatom = 1, natom + iparticle = atom_index(iatom) + IF (particle_set(iparticle)%shell_index /= 0) & + CPWARN("Warning: The primary knock-on atom is a core-shell atom") + atomic_kind => particle_set(iparticle)%atomic_kind + CALL get_atomic_kind(atomic_kind=atomic_kind, mass=matom(iatom)) + norm = norm + matom(iatom)*weight(iatom) + END DO + weight(:) = matom(:)*weight(:)*energy/norm + DO iatom = 1, natom + norm = SQRT(DOT_PRODUCT(vatom(1:3, iatom), vatom(1:3, iatom))) + vatom(1:3, iatom) = vatom(1:3, iatom)/norm + END DO + + IF (iw > 0) THEN + WRITE (UNIT=iw, FMT="(T2,A)") & + "CASCADE|", & + "CASCADE| Normalised velocities and additional kinetic energy [keV]", & + "CASCADE|" + WRITE (UNIT=iw, FMT="(T2,A,T11,A,3(11X,A),9X,A)") & + "CASCADE| ", "Atom index", "v(x)", "v(y)", "v(z)", "E(kin)" + DO iatom = 1, natom + ekin = cp_unit_from_cp2k(weight(iatom), "keV") + WRITE (UNIT=iw, FMT="(T2,A,I10,4(1X,F14.6))") & + "CASCADE| ", atom_index(iatom), vatom(1:3, iatom), ekin + END DO + END IF + + ! Apply velocity modifications + DO iatom = 1, natom + iparticle = atom_index(iatom) + particle_set(iparticle)%v(:) = particle_set(iparticle)%v(:) + & + SQRT(2.0_dp*weight(iatom)/matom(iatom))*vatom(1:3, iatom) + END DO + + DEALLOCATE (atom_index) + DEALLOCATE (matom) + DEALLOCATE (vatom) + DEALLOCATE (weight) + + IF (iw > 0) THEN + ! Build a list of all fixed atoms (if any) + ALLOCATE (is_fixed(nparticle)) + is_fixed = use_perd_none + molecule_kind_set => molecule_kinds%els + DO imolecule_kind = 1, molecule_kinds%n_els + molecule_kind => molecule_kind_set(imolecule_kind) + CALL get_molecule_kind(molecule_kind=molecule_kind, fixd_list=fixd_list) + IF (ASSOCIATED(fixd_list)) THEN + DO ifixd = 1, SIZE(fixd_list) + IF (.NOT. fixd_list(ifixd)%restraint%active) is_fixed(fixd_list(ifixd)%fixd) = fixd_list(ifixd)%itype + END DO + END IF + END DO + ! Compute vcom, ecom and ekin for printout + CALL compute_vcom(particle_set, is_fixed, vcom, ecom) + ekin = compute_ekin(particle_set) - ecom + IF (simpar%nfree == 0) THEN + CPASSERT(ekin == 0.0_dp) + temp = 0.0_dp + ELSE + temp = 2.0_dp*ekin/REAL(simpar%nfree, KIND=dp) + END IF + temperature = cp_unit_from_cp2k(temp, "K") + WRITE (UNIT=iw, FMT="(T2,A)") & + "CASCADE|" + WRITE (UNIT=iw, FMT="(T2,A,T61,F18.2,A2)") & + "CASCADE| Temperature after cascade initialization", temperature, " K" + WRITE (UNIT=iw, FMT="(T2,A,T30,3(1X,ES16.8),/)") & + "CASCADE| COM velocity: ", vcom(1:3) !MK ! compute and log rcom and vang if not periodic !MK CALL force_env_get(force_env,cell=cell) !MK IF (SUM(cell%perd(1:3)) == 0) THEN @@ -2425,15 +2419,15 @@ SUBROUTINE initialize_cascade(simpar,particle_set,molecule_kinds,md_section) !MK WRITE (iw, '( A, T21, F20.12 , F20.12 , F20.12 )' ) ' COM position:',rcom(1:3) !MK WRITE (iw, '( A, T21, F20.12 , F20.12 , F20.12 )' ) ' Angular velocity:',vang(1:3) !MK END IF - DEALLOCATE (is_fixed) - END IF + DEALLOCATE (is_fixed) + END IF - END IF + END IF - CALL cp_print_key_finished_output(iw,logger,print_section,"PROGRAM_RUN_INFO") + CALL cp_print_key_finished_output(iw, logger, print_section, "PROGRAM_RUN_INFO") - CALL timestop(handle) + CALL timestop(handle) - END SUBROUTINE initialize_cascade + END SUBROUTINE initialize_cascade END MODULE md_vel_utils diff --git a/src/motion/neb_io.F b/src/motion/neb_io.F index ae0c6153c0..b4cf23d099 100644 --- a/src/motion/neb_io.F +++ b/src/motion/neb_io.F @@ -192,11 +192,11 @@ SUBROUTINE dump_neb_info(neb_env, coords, vels, forces, particle_set, logger, & TYPE(section_vals_type), POINTER :: tc_section, vc_section CALL timeset(routineN, handle) - ndig = CEILING(LOG10(REAL(neb_env%number_of_replica+1, KIND=dp))) + ndig = CEILING(LOG10(REAL(neb_env%number_of_replica + 1, KIND=dp))) CALL force_env_get(neb_env%force_env, cell=cell) DO irep = 1, neb_env%number_of_replica - ndigl = CEILING(LOG10(REAL(irep+1, KIND=dp))) - WRITE (line, '(A,'//cp_to_string(ndig)//'("0"),T'//cp_to_string(11+ndig+1-ndigl)//',I0)') "Replica_nr_", irep + ndigl = CEILING(LOG10(REAL(irep + 1, KIND=dp))) + WRITE (line, '(A,'//cp_to_string(ndig)//'("0"),T'//cp_to_string(11 + ndig + 1 - ndigl)//',I0)') "Replica_nr_", irep crd = cp_print_key_unit_nr(logger, neb_env%motion_print_section, "TRAJECTORY", & extension=".xyz", file_form="FORMATTED", middle_name="pos-"//TRIM(line)) IF (PRESENT(vels)) THEN @@ -319,11 +319,11 @@ SUBROUTINE dump_neb_info(neb_env, coords, vels, forces, particle_set, logger, & ' REPLICA TEMPERATURES (K) =', temperatures(1:MIN(4, SIZE(temperatures))) DO i = 5, SIZE(temperatures), 4 WRITE (output_unit, '( T33,4(1X,F11.5))') & - temperatures(i:MIN(i+3, SIZE(temperatures))) + temperatures(i:MIN(i + 3, SIZE(temperatures))) END DO END IF WRITE (output_unit, '( A,T56,F25.14)') & - ' BAND TOTAL ENERGY [au] =', SUM(energies(:)+ekin(:))+ & + ' BAND TOTAL ENERGY [au] =', SUM(energies(:) + ekin(:)) + & neb_env%spring_energy WRITE (output_unit, FMT='(A,A)') ' **************************************', & '*****************************************' @@ -334,7 +334,7 @@ SUBROUTINE dump_neb_info(neb_env, coords, vels, forces, particle_set, logger, & ener = cp_print_key_unit_nr(logger, neb_env%neb_section, "ENERGY", & extension=".ener", file_form="FORMATTED") IF (ener > 0) THEN - WRITE (line, '(I0)') 2*neb_env%number_of_replica-1 + WRITE (line, '(I0)') 2*neb_env%number_of_replica - 1 WRITE (ener, '(I10,'//TRIM(line)//'(1X,F20.9))') istep, & energies, distances END IF @@ -419,7 +419,7 @@ SUBROUTINE handle_band_file_names(rep_env, irep, n_rep, istep) handle=handle2) logger => cp_get_default_logger() CALL force_env_get(f_env%force_env, root_section=root_section) - j = irep+(rep_env%local_rep_indices(1)-1) + j = irep + (rep_env%local_rep_indices(1) - 1) ! Get replica_project_name replica_proj_name = get_replica_project_name(rep_env, n_rep, j) lp = LEN_TRIM(replica_proj_name) @@ -444,7 +444,7 @@ SUBROUTINE handle_band_file_names(rep_env, irep, n_rep, istep) WRITE (UNIT=logger%default_global_unit_nr, FMT="(T2,A,T79,A)") "**", "**" WRITE (UNIT=logger%default_global_unit_nr, FMT="(T2,A,T79,A)") "**", "**" WRITE (UNIT=logger%default_global_unit_nr, FMT="(T2,A,I5,T41,A,I5,T79,A)") & - "** Replica Env Nr. :", rep_env%local_rep_indices(1)-1, "Replica Band Nr. :", j, "**" + "** Replica Env Nr. :", rep_env%local_rep_indices(1) - 1, "Replica Band Nr. :", j, "**" WRITE (UNIT=logger%default_global_unit_nr, FMT="(T2,A,I5,T79,A)") & "** Band Step Nr. :", istep, "**" WRITE (UNIT=logger%default_global_unit_nr, FMT="(T2,A79)") & @@ -455,7 +455,7 @@ SUBROUTINE handle_band_file_names(rep_env, irep, n_rep, istep) SELECT CASE (f_env%force_env%in_use) CASE (use_mixed_force) DO i = 1, f_env%force_env%mixed_env%ngroups - IF (MODULO(i-1, f_env%force_env%mixed_env%ngroups) == & + IF (MODULO(i - 1, f_env%force_env%mixed_env%ngroups) == & f_env%force_env%mixed_env%group_distribution(f_env%force_env%mixed_env%para_env%mepos)) THEN sub_logger => f_env%force_env%mixed_env%sub_logger(i)%p sub_logger%iter_info%project_name = replica_proj_name(1:lp)//"-r-"//TRIM(ADJUSTL(cp_to_string(i))) @@ -502,15 +502,15 @@ FUNCTION get_replica_project_name(rep_env, n_rep, j) RESULT(replica_proj_name) replica_proj_name = rep_env%original_project_name ! Find padding - ndigits = CEILING(LOG10(REAL(n_rep+1, KIND=dp)))- & - CEILING(LOG10(REAL(j+1, KIND=dp))) + ndigits = CEILING(LOG10(REAL(n_rep + 1, KIND=dp))) - & + CEILING(LOG10(REAL(j + 1, KIND=dp))) padding = "" DO i = 1, ndigits padding(i:i) = "0" END DO lp = LEN_TRIM(replica_proj_name) - replica_proj_name(lp+1:LEN(replica_proj_name)) = "-BAND"// & - TRIM(padding)//ADJUSTL(cp_to_string(j)) + replica_proj_name(lp + 1:LEN(replica_proj_name)) = "-BAND"// & + TRIM(padding)//ADJUSTL(cp_to_string(j)) END FUNCTION get_replica_project_name ! ************************************************************************************************** @@ -546,16 +546,16 @@ SUBROUTINE neb_rep_env_map_info(rep_env, neb_env) "** MAPPING OF BAND REPLICA TO REPLICA ENV **", & "*******************************************************************************" WRITE (UNIT=output_unit, FMT='(T2,A,I6,T32,A,T79,A)') & - "** Replica Env Nr.: ", rep_env%local_rep_indices(1)-1, & + "** Replica Env Nr.: ", rep_env%local_rep_indices(1) - 1, & "working on the following BAND replicas", "**" WRITE (UNIT=output_unit, FMT='(T2,A79)') & "** **" END IF DO irep = 1, n_rep_neb, n_rep - replica_proj_name = get_replica_project_name(rep_env, n_rep_neb, irep+rep_env%local_rep_indices(1)-1) + replica_proj_name = get_replica_project_name(rep_env, n_rep_neb, irep + rep_env%local_rep_indices(1) - 1) IF (output_unit > 0) THEN WRITE (UNIT=output_unit, FMT='(T2,A,I6,T32,A,T79,A)') & - "** Band Replica Nr.: ", irep+rep_env%local_rep_indices(1)-1, & + "** Band Replica Nr.: ", irep + rep_env%local_rep_indices(1) - 1, & "Output available on file: "//TRIM(replica_proj_name)//".out", "**" END IF END DO diff --git a/src/motion/neb_md_utils.F b/src/motion/neb_md_utils.F index 8ea7f49500..b8db85d170 100644 --- a/src/motion/neb_md_utils.F +++ b/src/motion/neb_md_utils.F @@ -100,9 +100,9 @@ SUBROUTINE neb_initialize_velocity(vels, neb_section, particle_set, i_rep, iw, & ELSE DO iatom = 1, natom mass = particle_set(iatom)%atomic_kind%mass - mass_tot = mass_tot+mass + mass_tot = mass_tot + mass v(1:3) = get_particle_pos_or_vel(iatom, particle_set, vels(:, i_rep)) - vcom(1:3) = vcom(1:3)+mass*v(1:3) + vcom(1:3) = vcom(1:3) + mass*v(1:3) END DO vcom(1:3) = vcom(1:3)/mass_tot END IF @@ -110,14 +110,14 @@ SUBROUTINE neb_initialize_velocity(vels, neb_section, particle_set, i_rep, iw, & akin = 0.0_dp IF (neb_env%use_colvar) THEN DO ivar = 1, nvar - akin = akin+0.5_dp*massunit*vels(ivar, i_rep)*vels(ivar, i_rep) + akin = akin + 0.5_dp*massunit*vels(ivar, i_rep)*vels(ivar, i_rep) END DO ELSE DO iatom = 1, natom mass = particle_set(iatom)%atomic_kind%mass v(1:3) = -vcom(1:3) CALL update_particle_pos_or_vel(iatom, particle_set, v(1:3), vels(:, i_rep)) - akin = akin+0.5_dp*mass*DOT_PRODUCT(v(1:3), v(1:3)) + akin = akin + 0.5_dp*mass*DOT_PRODUCT(v(1:3), v(1:3)) END DO nvar = 3*natom END IF @@ -130,14 +130,14 @@ SUBROUTINE neb_initialize_velocity(vels, neb_section, particle_set, i_rep, iw, & vcom = 0.0_dp IF (neb_env%use_colvar) THEN DO ivar = 1, nvar - akin = akin+0.5_dp*massunit*vels(ivar, i_rep)*vels(ivar, i_rep) + akin = akin + 0.5_dp*massunit*vels(ivar, i_rep)*vels(ivar, i_rep) END DO ELSE DO iatom = 1, natom mass = particle_set(iatom)%atomic_kind%mass v(1:3) = get_particle_pos_or_vel(iatom, particle_set, vels(:, i_rep)) - vcom(1:3) = vcom(1:3)+mass*v(1:3) - akin = akin+0.5_dp*mass*DOT_PRODUCT(v(1:3), v(1:3)) + vcom(1:3) = vcom(1:3) + mass*v(1:3) + akin = akin + 0.5_dp*mass*DOT_PRODUCT(v(1:3), v(1:3)) END DO END IF vcom(1:3) = vcom(1:3)/mass_tot @@ -196,9 +196,9 @@ SUBROUTINE control_vels_a(vels, particle_set, tc_section, vc_section, & CALL get_temperatures(vels, particle_set, temperatures, factor=1.0_dp) ! Possibly rescale IF (istep <= temp_tol_steps) THEN - DO i = 2, SIZE(vels%wrk, 2)-1 + DO i = 2, SIZE(vels%wrk, 2) - 1 temploc = temperatures(i) - IF (ABS(temploc-ext_temp) > temp_tol) THEN + IF (ABS(temploc - ext_temp) > temp_tol) THEN IF (output_unit > 0) THEN tmp_r1 = cp_unit_from_cp2k(temploc, "K") tmp_r2 = cp_unit_from_cp2k(ext_temp, "K") @@ -218,7 +218,7 @@ SUBROUTINE control_vels_a(vels, particle_set, tc_section, vc_section, & CALL section_vals_get(vc_section, explicit=explicit) IF (explicit) THEN CALL section_vals_val_get(vc_section, "ANNEALING", r_val=f_annealing) - DO i = 2, SIZE(vels%wrk, 2)-1 + DO i = 2, SIZE(vels%wrk, 2) - 1 vels%wrk(:, i) = f_annealing*vels%wrk(:, i) END DO END IF @@ -247,7 +247,7 @@ SUBROUTINE control_vels_b(vels, forces, vc_section) IF (explicit) THEN CALL section_vals_val_get(vc_section, "PROJ_VELOCITY_VERLET", l_val=lval) IF (lval) THEN - DO i = 2, SIZE(vels%wrk, 2)-1 + DO i = 2, SIZE(vels%wrk, 2) - 1 norm = DOT_PRODUCT(forces%wrk(:, i), forces%wrk(:, i)) factor = DOT_PRODUCT(vels%wrk(:, i), forces%wrk(:, i)) IF (factor > 0 .AND. (norm >= EPSILON(0.0_dp))) THEN @@ -259,7 +259,7 @@ SUBROUTINE control_vels_b(vels, forces, vc_section) END IF CALL section_vals_val_get(vc_section, "SD_LIKE", l_val=lval) IF (lval) THEN - DO i = 2, SIZE(vels%wrk, 2)-1 + DO i = 2, SIZE(vels%wrk, 2) - 1 vels%wrk(:, i) = 0.0_dp END DO END IF @@ -299,17 +299,17 @@ SUBROUTINE get_temperatures(vels, particle_set, temperatures, ekin, factor) nvar = SIZE(vels%wrk, 1) n_rep = SIZE(vels%wrk, 2) natom = SIZE(particle_set) - DO i_rep = 2, n_rep-1 + DO i_rep = 2, n_rep - 1 akin = 0.0_dp IF (vels%in_use == do_band_collective) THEN DO ivar = 1, nvar - akin = akin+0.5_dp*massunit*vels%wrk(ivar, i_rep)*vels%wrk(ivar, i_rep) + akin = akin + 0.5_dp*massunit*vels%wrk(ivar, i_rep)*vels%wrk(ivar, i_rep) END DO ELSE DO iatom = 1, natom mass = particle_set(iatom)%atomic_kind%mass v(1:3) = get_particle_pos_or_vel(iatom, particle_set, vels%wrk(:, i_rep)) - akin = akin+0.5_dp*mass*DOT_PRODUCT(v(1:3), v(1:3)) + akin = akin + 0.5_dp*mass*DOT_PRODUCT(v(1:3), v(1:3)) END DO nvar = 3*natom END IF diff --git a/src/motion/neb_methods.F b/src/motion/neb_methods.F index 51d50e0442..246d4e1b94 100644 --- a/src/motion/neb_methods.F +++ b/src/motion/neb_methods.F @@ -129,7 +129,7 @@ SUBROUTINE neb(input, input_declaration, para_env, globenv) "is not compatible with the number of processors requested per replica ("// & TRIM(ADJUSTL(cp_to_string(prep)))//") and the number of replicas ("// & TRIM(ADJUSTL(cp_to_string(nrep)))//") . ["// & - TRIM(ADJUSTL(cp_to_string(para_env%num_pe-nrep*prep)))//"] processors will be wasted!") + TRIM(ADJUSTL(cp_to_string(para_env%num_pe - nrep*prep)))//"] processors will be wasted!") ENDIF force_env_section => section_vals_get_subs_vals(input, "FORCE_EVAL") ! Create Replica Environments @@ -261,21 +261,21 @@ SUBROUTINE neb_md(rep_env, neb_env, coords, vels, forces, particle_set, output_u CALL neb_var_create(Dcoords, neb_env) ALLOCATE (mass(SIZE(coords%wrk, 1), neb_env%number_of_replica)) ALLOCATE (energies(neb_env%number_of_replica)) - ALLOCATE (distances(neb_env%number_of_replica-1)) + ALLOCATE (distances(neb_env%number_of_replica - 1)) ! Setting up the mass array IF (neb_env%use_colvar) THEN mass(:, :) = 0.5_dp*dt/massunit ELSE natom = SIZE(particle_set) DO iatom = 1, natom - ic = 3*(iatom-1) + ic = 3*(iatom - 1) shell_index = particle_set(iatom)%shell_index IF (shell_index == 0) THEN - mass(ic+1:ic+3, :) = 0.5_dp*dt/particle_set(iatom)%atomic_kind%mass + mass(ic + 1:ic + 3, :) = 0.5_dp*dt/particle_set(iatom)%atomic_kind%mass ELSE - is = 3*(natom+shell_index-1) - mass(ic+1:ic+3, :) = 0.5_dp*dt/particle_set(iatom)%atomic_kind%shell%mass_core - mass(is+1:is+3, :) = 0.5_dp*dt/particle_set(iatom)%atomic_kind%shell%mass_shell + is = 3*(natom + shell_index - 1) + mass(ic + 1:ic + 3, :) = 0.5_dp*dt/particle_set(iatom)%atomic_kind%shell%mass_core + mass(is + 1:is + 3, :) = 0.5_dp*dt/particle_set(iatom)%atomic_kind%shell%mass_shell END IF END DO END IF @@ -301,13 +301,13 @@ SUBROUTINE neb_md(rep_env, neb_env, coords, vels, forces, particle_set, output_u ! Save the optimization step counter neb_env%istep = istep ! Velocity Verlet (first part) - vels%wrk(:, :) = vels%wrk(:, :)+mass(:, :)*forces%wrk(:, :) + vels%wrk(:, :) = vels%wrk(:, :) + mass(:, :)*forces%wrk(:, :) ! Control on velocity - I part [rescale, annealing] CALL control_vels_a(vels, particle_set, tc_section, vc_section, output_unit, & istep) ! Coordinate step Dcoords%wrk(:, :) = dt*vels%wrk(:, :) - coords%wrk(:, :) = coords%wrk(:, :)+Dcoords%wrk(:, :) + coords%wrk(:, :) = coords%wrk(:, :) + Dcoords%wrk(:, :) CALL reorient_images(neb_env%rotate_frames, particle_set, coords, vels, & output_unit, distances, neb_env%number_of_replica) @@ -320,7 +320,7 @@ SUBROUTINE neb_md(rep_env, neb_env, coords, vels, forces, particle_set, output_u ! Control on velocity - II part [check vels VS forces, Steepest Descent like] CALL control_vels_b(vels, forces, vc_section) ! Velocity Verlet (second part) - vels%wrk(:, :) = vels%wrk(:, :)+mass(:, :)*forces%wrk(:, :) + vels%wrk(:, :) = vels%wrk(:, :) + mass(:, :)*forces%wrk(:, :) ! Dump Infos CALL dump_neb_info(neb_env=neb_env, & coords=coords, & @@ -410,7 +410,7 @@ SUBROUTINE neb_diis(rep_env, neb_env, coords, vels, forces, particle_set, output ALLOCATE (crr(PRODUCT(coords%size_wrk), n_diis)) ALLOCATE (set_err(n_diis)) ALLOCATE (energies(neb_env%number_of_replica)) - ALLOCATE (distances(neb_env%number_of_replica-1)) + ALLOCATE (distances(neb_env%number_of_replica - 1)) ! Initializing forces array CALL reorient_images(neb_env%rotate_frames, particle_set, coords, vels, & output_unit, distances, neb_env%number_of_replica) @@ -468,7 +468,7 @@ SUBROUTINE neb_diis(rep_env, neb_env, coords, vels, forces, particle_set, output END IF do_ls = .TRUE. IF (COUNT(set_err == -1) == 1) do_ls = .FALSE. - coords%wrk = coords%wrk+sline%wrk + coords%wrk = coords%wrk + sline%wrk ! Compute forces CALL reorient_images(neb_env%rotate_frames, particle_set, coords, vels, & output_unit, distances, neb_env%number_of_replica) diff --git a/src/motion/neb_opt_utils.F b/src/motion/neb_opt_utils.F index 34bcff622a..282f99206a 100644 --- a/src/motion/neb_opt_utils.F +++ b/src/motion/neb_opt_utils.F @@ -98,7 +98,7 @@ FUNCTION accept_diis_step(apply_diis, n_diis, err, crr, set_err, sline, coords, IF (iw2 > 0) WRITE (iw2, '(A)') "Applying DIIS equations" ! Apply DIIS.. DO jv = 2, n_diis - np = jv+1 + np = jv + 1 IF (iw2 > 0) WRITE (iw2, '(A,I5,A)') "Applying DIIS equations with the last", & jv, " error vectors" ALLOCATE (wrk(np, np)) @@ -111,9 +111,9 @@ FUNCTION accept_diis_step(apply_diis, n_diis, err, crr, set_err, sline, coords, wrk(np, np) = 0.0_dp awrk(np) = 1.0_dp DO i = 1, jv - indi = n_diis-i+1 + indi = n_diis - i + 1 DO j = i, jv - indj = n_diis-j+1 + indj = n_diis - j + 1 wrk(i, j) = DOT_PRODUCT(err(:, indi), err(:, indj)) wrk(j, i) = wrk(i, j) END DO @@ -157,11 +157,11 @@ FUNCTION accept_diis_step(apply_diis, n_diis, err, crr, set_err, sline, coords, ! Check the DIIS solution step = 0.0_dp ind = 0 - DO i = n_diis, n_diis-jv+1, -1 - ind = ind+1 - step = step+(crr(:, i)+err(:, i))*cwrk(ind) + DO i = n_diis, n_diis - jv + 1, -1 + ind = ind + 1 + step = step + (crr(:, i) + err(:, i))*cwrk(ind) END DO - step = step-crr(:, n_diis) + step = step - crr(:, n_diis) ref = err(:, n_diis) increase_error = check_diis_solution(jv, cwrk, step, ref, & iw2, check_diis) @@ -192,16 +192,16 @@ FUNCTION accept_diis_step(apply_diis, n_diis, err, crr, set_err, sline, coords, ! always delete the last error vector from the history vectors ! move error vectors and the set_err in order to have free space ! at the end of the err array - istart = MAX(2, n_diis-jv+2) + istart = MAX(2, n_diis - jv + 2) iend = n_diis indi = 0 DO iv = istart, iend - indi = indi+1 + indi = indi + 1 err(:, indi) = err(:, iv) crr(:, indi) = crr(:, iv) set_err(indi) = 1 END DO - DO iv = indi+1, iend + DO iv = indi + 1, iend set_err(iv) = -1 END DO END IF @@ -335,20 +335,20 @@ SUBROUTINE neb_ls(stepsize, sline, rep_env, neb_env, coords, energies, forces, & Icoord(:, :) = coords%wrk xa = 0.0_dp ya = SUM(sline%wrk*forces%wrk) - xb = xa+MIN(ya*stepsize, max_stepsize) + xb = xa + MIN(ya*stepsize, max_stepsize) xc_cray = xb i = 1 - DO WHILE (i <= np-1) - i = i+1 - coords%wrk = Icoord+xb*sline%wrk + DO WHILE (i <= np - 1) + i = i + 1 + coords%wrk = Icoord + xb*sline%wrk CALL reorient_images(neb_env%rotate_frames, particle_set, coords, vels, & output_unit, distances, neb_env%number_of_replica) neb_env%avg_distance = SQRT(SUM(distances*distances)/REAL(SIZE(distances), KIND=dp)) CALL neb_calc_energy_forces(rep_env, neb_env, coords, energies, forces, & particle_set, iw) yb = SUM(sline%wrk*forces%wrk) - a = (ya-yb)/(2.0_dp*(xa-xb)) - b = ya-2.0_dp*a*xa + a = (ya - yb)/(2.0_dp*(xa - xb)) + b = ya - 2.0_dp*a*xa xc_cray = -b/(2.0_dp*a) IF (xc_cray > max_stepsize) THEN IF (iw2 > 0) WRITE (iw2, '(T2,2(A,F6.3),A)') & @@ -358,10 +358,10 @@ SUBROUTINE neb_ls(stepsize, sline, rep_env, neb_env, coords, energies, forces, & EXIT END IF ! No Extrapolation .. only interpolation - IF ((xc_cray <= MIN(xa, xb) .OR. xc_cray >= MAX(xa, xb)) .AND. (ABS(xa-xb) > 1.0E-5_dp)) THEN + IF ((xc_cray <= MIN(xa, xb) .OR. xc_cray >= MAX(xa, xb)) .AND. (ABS(xa - xb) > 1.0E-5_dp)) THEN IF (iw2 > 0) WRITE (iw2, '(T2,2(A,I5),A)') & - "LS| Increasing the number of point from ", np, " to ", np+1, "." - np = np+1 + "LS| Increasing the number of point from ", np, " to ", np + 1, "." + np = np + 1 END IF ! IF (ABS(yb) < ABS(ya)) THEN diff --git a/src/motion/neb_utils.F b/src/motion/neb_utils.F index d14476ba22..b412e1dbc2 100644 --- a/src/motion/neb_utils.F +++ b/src/motion/neb_utils.F @@ -120,8 +120,8 @@ SUBROUTINE neb_replica_distance(particle_set, coords, i0, i, distance, iw, rotat CALL rmsd3(particle_set, coords%xyz(:, i), coords%xyz(:, i0), & iw, rotate=my_rotate) END IF - distance = SQRT(DOT_PRODUCT(coords%wrk(:, i)-coords%wrk(:, i0), & - coords%wrk(:, i)-coords%wrk(:, i0))) + distance = SQRT(DOT_PRODUCT(coords%wrk(:, i) - coords%wrk(:, i0), & + coords%wrk(:, i) - coords%wrk(:, i0))) END SUBROUTINE neb_replica_distance @@ -199,13 +199,13 @@ SUBROUTINE build_replica_coords(neb_section, particle_set, & DO iatom = 1, natom CALL section_vals_val_get(coord_section, "_DEFAULT_KEYWORD_", & i_rep_val=iatom, r_vals=rptr) - ic = 3*(iatom-1) - coords%xyz(ic+1:ic+3, i_rep) = rptr(1:3)*bohr + ic = 3*(iatom - 1) + coords%xyz(ic + 1:ic + 3, i_rep) = rptr(1:3)*bohr ! Initially core and shell positions are set to the atomic positions shell_index = particle_set(iatom)%shell_index IF (shell_index /= 0) THEN - is = 3*(natom+shell_index-1) - coords%xyz(is+1:is+3, i_rep) = coords%xyz(ic+1:ic+3, i_rep) + is = 3*(natom + shell_index - 1) + coords%xyz(is + 1:is + 3, i_rep) = coords%xyz(ic + 1:ic + 3, i_rep) END IF END DO ELSE @@ -227,13 +227,13 @@ SUBROUTINE build_replica_coords(neb_section, particle_set, & " Error in XYZ format for REPLICA coordinates. Very probably the"// & " line with title is missing or is empty. Please check the XYZ file and rerun your job!") READ (parser%input_line, *) dummy_char, r(1:3) - ic = 3*(iatom-1) - coords%xyz(ic+1:ic+3, i_rep) = r(1:3)*bohr + ic = 3*(iatom - 1) + coords%xyz(ic + 1:ic + 3, i_rep) = r(1:3)*bohr ! Initially core and shell positions are set to the atomic positions shell_index = particle_set(iatom)%shell_index IF (shell_index /= 0) THEN - is = 3*(natom+shell_index-1) - coords%xyz(is+1:is+3, i_rep) = coords%xyz(ic+1:ic+3, i_rep) + is = 3*(natom + shell_index - 1) + coords%xyz(is + 1:is + 3, i_rep) = coords%xyz(ic + 1:ic + 3, i_rep) END IF END DO CALL parser_release(parser) @@ -281,22 +281,22 @@ SUBROUTINE build_replica_coords(neb_section, particle_set, & DO iatom = 1, natom CALL section_vals_val_get(vel_section, "_DEFAULT_KEYWORD_", & i_rep_val=iatom, r_vals=rptr) - ic = 3*(iatom-1) - vels%wrk(ic+1:ic+3, i_rep) = rptr(1:3) + ic = 3*(iatom - 1) + vels%wrk(ic + 1:ic + 3, i_rep) = rptr(1:3) ! Initially set shell velocities to core velocity shell_index = particle_set(iatom)%shell_index IF (shell_index /= 0) THEN - is = 3*(natom+shell_index-1) - vels%wrk(is+1:is+3, i_rep) = vels%wrk(ic+1:ic+3, i_rep) + is = 3*(natom + shell_index - 1) + vels%wrk(is + 1:is + 3, i_rep) = vels%wrk(ic + 1:ic + 3, i_rep) END IF END DO END IF END IF END DO ! i_rep - ALLOCATE (distance(neb_nr_replica-1)) + ALLOCATE (distance(neb_nr_replica - 1)) IF (input_nr_replica < neb_nr_replica) THEN ! Interpolate missing replicas - nr_replica_to_interpolate = neb_nr_replica-input_nr_replica + nr_replica_to_interpolate = neb_nr_replica - input_nr_replica distance = 0.0_dp IF (iw > 0) THEN WRITE (iw, '(T2,A,I0,A)') 'NEB| Interpolating ', nr_replica_to_interpolate, ' missing Replica.' @@ -304,35 +304,35 @@ SUBROUTINE build_replica_coords(neb_section, particle_set, & DO WHILE (nr_replica_to_interpolate > 0) ! Compute distances between known images to find the interval ! where to add a new image - DO j = 1, input_nr_replica-1 - CALL neb_replica_distance(particle_set, coords, j, j+1, distance(j), iw, & + DO j = 1, input_nr_replica - 1 + CALL neb_replica_distance(particle_set, coords, j, j + 1, distance(j), iw, & rotate=neb_env%align_frames) END DO jtarg = MAXLOC(distance(1:input_nr_replica), 1) IF (iw > 0) THEN WRITE (iw, '(T2,3(A,I0),A)') 'NEB| Interpolating Nr. ', & nr_replica_to_interpolate, ' missing Replica between Replica Nr. ', & - jtarg, ' and ', jtarg+1, '.' + jtarg, ' and ', jtarg + 1, '.' END IF - input_nr_replica = input_nr_replica+1 - nr_replica_to_interpolate = nr_replica_to_interpolate-1 + input_nr_replica = input_nr_replica + 1 + nr_replica_to_interpolate = nr_replica_to_interpolate - 1 ! Interpolation is a simple bisection in XYZ - coords%xyz(:, jtarg+2:input_nr_replica) = coords%xyz(:, jtarg+1:input_nr_replica-1) - coords%xyz(:, jtarg+1) = (coords%xyz(:, jtarg)+coords%xyz(:, jtarg+2))/2.0_dp + coords%xyz(:, jtarg + 2:input_nr_replica) = coords%xyz(:, jtarg + 1:input_nr_replica - 1) + coords%xyz(:, jtarg + 1) = (coords%xyz(:, jtarg) + coords%xyz(:, jtarg + 2))/2.0_dp IF (neb_env%use_colvar) THEN ! Interpolation is a simple bisection also in internal coordinates ! in this case the XYZ coordinates need only as a starting point for computing ! the potential energy function. The reference are the internal coordinates ! interpolated here after.. - coords%int(:, jtarg+2:input_nr_replica) = coords%int(:, jtarg+1:input_nr_replica-1) - coords%int(:, jtarg+1) = (coords%int(:, jtarg)+coords%int(:, jtarg+2))/2.0_dp + coords%int(:, jtarg + 2:input_nr_replica) = coords%int(:, jtarg + 1:input_nr_replica - 1) + coords%int(:, jtarg + 1) = (coords%int(:, jtarg) + coords%int(:, jtarg + 2))/2.0_dp END IF - vels%wrk(:, jtarg+2:input_nr_replica) = vels%wrk(:, jtarg+1:input_nr_replica-1) - vels%wrk(:, jtarg+1) = 0.0_dp - CALL dump_replica_coordinates(particle_set, coords, jtarg+1, & + vels%wrk(:, jtarg + 2:input_nr_replica) = vels%wrk(:, jtarg + 1:input_nr_replica - 1) + vels%wrk(:, jtarg + 1) = 0.0_dp + CALL dump_replica_coordinates(particle_set, coords, jtarg + 1, & input_nr_replica, iw, neb_env%use_colvar) CALL neb_initialize_velocity(vels%wrk, neb_section, particle_set, & - jtarg+1, iw, globenv, neb_env) + jtarg + 1, iw, globenv, neb_env) END DO END IF vels%wrk(:, 1) = 0.0_dp @@ -341,8 +341,8 @@ SUBROUTINE build_replica_coords(neb_section, particle_set, & IF (neb_env%opt_type == band_diis_opt) vels%wrk = 0.0_dp ! Compute distances between replicas and in case of Cartesian Coordinates ! Rotate the frames in order to minimize the RMSD - DO j = 1, input_nr_replica-1 - CALL neb_replica_distance(particle_set, coords, j, j+1, distance(j), iw, & + DO j = 1, input_nr_replica - 1 + CALL neb_replica_distance(particle_set, coords, j, j + 1, distance(j), iw, & rotate=neb_env%align_frames) END DO DEALLOCATE (distance) @@ -393,13 +393,13 @@ SUBROUTINE neb_calc_energy_forces(rep_env, neb_env, coords, energies, forces, & ALLOCATE (Mmatrix(n_int*n_int, n_rep_neb)) IF (output_unit > 0) WRITE (output_unit, '(/,T2,A)') "NEB| Computing Energies and Forces" DO irep = 1, n_rep_neb, n_rep - DO j = 0, n_rep-1 - IF (irep+j <= n_rep_neb) THEN + DO j = 0, n_rep - 1 + IF (irep + j <= n_rep_neb) THEN ! If the number of replica in replica_env and the number of replica ! used in the NEB does not match, the other replica in replica_env ! just compute energies and forces keeping the fixed coordinates and ! forces - rep_env%r(:, j+1) = coords%xyz(:, irep+j) + rep_env%r(:, j + 1) = coords%xyz(:, irep + j) END IF END DO ! Fix file name for BAND replicas.. Each BAND replica has its own file @@ -418,41 +418,41 @@ SUBROUTINE neb_calc_energy_forces(rep_env, neb_env, coords, energies, forces, & CALL perform_replica_geo(rep_env, coords, irep, n_rep_neb, cvalues, Mmatrix_tmp) END SELECT - DO j = 0, n_rep-1 - IF (irep+j <= n_rep_neb) THEN + DO j = 0, n_rep - 1 + IF (irep + j <= n_rep_neb) THEN ! Copy back Forces and Energies - forces%wrk(:, irep+j) = rep_env%f(1:nsize_wrk, j+1) - energies(irep+j) = rep_env%f(rep_env%ndim+1, j+1) + forces%wrk(:, irep + j) = rep_env%f(1:nsize_wrk, j + 1) + energies(irep + j) = rep_env%f(rep_env%ndim + 1, j + 1) SELECT CASE (neb_env%pot_type) CASE (pot_neb_full) ! Dump Info IF (output_unit > 0) THEN WRITE (output_unit, '(T2,A,I5,A,I5,A)') & - "NEB| REPLICA Nr.", irep+j, "- Energy and Forces" + "NEB| REPLICA Nr.", irep + j, "- Energy and Forces" WRITE (output_unit, '(T2,A,T42,A,9X,F15.9)') & - "NEB|", " Total Energy: ", rep_env%f(rep_env%ndim+1, j+1) + "NEB|", " Total Energy: ", rep_env%f(rep_env%ndim + 1, j + 1) WRITE (output_unit, '(T2,"NEB|",T10,"ATOM",T33,3(9X,A,7X))') lab(1), lab(2), lab(3) DO i = 1, SIZE(particle_set) WRITE (output_unit, '(T2,"NEB|",T12,A,T30,3(2X,F15.9))') & particle_set(i)%atomic_kind%name, & - rep_env%f((i-1)*3+1:(i-1)*3+3, j+1) + rep_env%f((i - 1)*3 + 1:(i - 1)*3 + 3, j + 1) END DO END IF CASE (pot_neb_fe, pot_neb_me) ! Let's update the cartesian coordinates. This will make ! easier the next evaluation of energies and forces... - coords%xyz(:, irep+j) = rep_env%r(1:rep_env%ndim, j+1) - Mmatrix(:, irep+j) = Mmatrix_tmp(:, j+1) + coords%xyz(:, irep + j) = rep_env%r(1:rep_env%ndim, j + 1) + Mmatrix(:, irep + j) = Mmatrix_tmp(:, j + 1) IF (output_unit > 0) THEN WRITE (output_unit, '(/,T2,A,I5,A,I5,A)') & - "NEB| REPLICA Nr.", irep+j, "- Energy, Collective Variables, Forces" + "NEB| REPLICA Nr.", irep + j, "- Energy, Collective Variables, Forces" WRITE (output_unit, '(T2,A,T42,A,9X,F15.9)') & - "NEB|", " Total Energy: ", rep_env%f(rep_env%ndim+1, j+1) + "NEB|", " Total Energy: ", rep_env%f(rep_env%ndim + 1, j + 1) WRITE (output_unit, & '(T2,"NEB|",T10,"CV Nr.",12X,"Expected COLVAR",5X,"Present COLVAR",10X,"Forces")') DO i = 1, n_int WRITE (output_unit, '(T2,"NEB|",T12,I2,7X,3(5X,F15.9))') & - i, coords%int(i, irep+j), cvalues(i, j+1), rep_env%f(i, j+1) + i, coords%int(i, irep + j), cvalues(i, j + 1), rep_env%f(i, j + 1) END DO END IF END SELECT @@ -464,7 +464,7 @@ SUBROUTINE neb_calc_energy_forces(rep_env, neb_env, coords, energies, forces, & IF (PRESENT(neb_env)) THEN ! First identify the image of the chain with the higher potential energy ! First and last point of the band are never considered - neb_env%nr_HE_image = MAXLOC(energies(2:n_rep_neb-1), 1)+1 + neb_env%nr_HE_image = MAXLOC(energies(2:n_rep_neb - 1), 1) + 1 ALLOCATE (tangent(nsize_wrk)) ! Then modify image forces accordingly to the scheme chosen for the ! calculation. @@ -529,38 +529,38 @@ SUBROUTINE perform_replica_md(rep_env, coords, irep, n_rep_neb, cvalues, Mmatrix logger => cp_get_default_logger() CALL force_env_get(f_env%force_env, globenv=globenv, & root_section=root_section) - j = rep_env%local_rep_indices(1)-1 + j = rep_env%local_rep_indices(1) - 1 n_el = 3*rep_env%nparticle Mmatrix = 0.0_dp ! Syncronize position on the replica procs - CALL set_pos(rep_env%f_env_id, rep_env%r(:, j+1), n_el, ierr) + CALL set_pos(rep_env%f_env_id, rep_env%r(:, j + 1), n_el, ierr) CPASSERT(ierr == 0) ! - IF (irep+j <= n_rep_neb) THEN - logger%iter_info%iteration(2) = irep+j + IF (irep + j <= n_rep_neb) THEN + logger%iter_info%iteration(2) = irep + j CALL remove_restart_info(root_section) md_section => section_vals_get_subs_vals(root_section, "MOTION%MD") CALL section_vals_get(md_section, explicit=explicit) CPASSERT(explicit) ! Let's syncronize the target of Collective Variables for this run - CALL set_colvars_target(coords%int(:, irep+j), f_env%force_env) + CALL set_colvars_target(coords%int(:, irep + j), f_env%force_env) ! Do a molecular dynamics and get back the derivative ! of the free energy w.r.t. the colvar and the metric tensor CALL qs_mol_dyn(f_env%force_env, globenv=globenv) ! Collect the equilibrated coordinates - CALL get_pos(rep_env%f_env_id, rep_env%r(1:n_el, j+1), n_el, ierr) + CALL get_pos(rep_env%f_env_id, rep_env%r(1:n_el, j + 1), n_el, ierr) CPASSERT(ierr == 0) ! Write he gradients in the colvar coordinates into the replica_env array ! and copy back also the metric tensor.. ! work in progress.. CPABORT("") - rep_env%f(:, j+1) = 0.0_dp + rep_env%f(:, j + 1) = 0.0_dp Mmatrix = 0.0_dp ELSE - rep_env%r(:, j+1) = 0.0_dp - rep_env%f(:, j+1) = 0.0_dp - cvalues(:, j+1) = 0.0_dp - Mmatrix(:, j+1) = 0.0_dp + rep_env%r(:, j + 1) = 0.0_dp + rep_env%f(:, j + 1) = 0.0_dp + cvalues(:, j + 1) = 0.0_dp + Mmatrix(:, j + 1) = 0.0_dp END IF CALL rep_env_sync(rep_env, rep_env%f) CALL rep_env_sync(rep_env, rep_env%r) @@ -605,20 +605,20 @@ SUBROUTINE perform_replica_geo(rep_env, coords, irep, n_rep_neb, cvalues, Mmatri logger => cp_get_default_logger() CALL force_env_get(f_env%force_env, globenv=globenv, & root_section=root_section) - j = rep_env%local_rep_indices(1)-1 + j = rep_env%local_rep_indices(1) - 1 n_el = 3*rep_env%nparticle Mmatrix = 0.0_dp ! Syncronize position on the replica procs - CALL set_pos(rep_env%f_env_id, rep_env%r(:, j+1), n_el, ierr) + CALL set_pos(rep_env%f_env_id, rep_env%r(:, j + 1), n_el, ierr) CPASSERT(ierr == 0) - IF (irep+j <= n_rep_neb) THEN - logger%iter_info%iteration(2) = irep+j + IF (irep + j <= n_rep_neb) THEN + logger%iter_info%iteration(2) = irep + j CALL remove_restart_info(root_section) geoopt_section => section_vals_get_subs_vals(root_section, "MOTION%GEO_OPT") CALL section_vals_get(geoopt_section, explicit=explicit) CPASSERT(explicit) ! Let's syncronize the target of Collective Variables for this run - CALL set_colvars_target(coords%int(:, irep+j), f_env%force_env) + CALL set_colvars_target(coords%int(:, irep + j), f_env%force_env) ! Do a geometry optimization.. CALL cp_geo_opt(f_env%force_env, globenv=globenv) ! Once the geometry optimization is ended let's do a single run @@ -626,22 +626,22 @@ SUBROUTINE perform_replica_geo(rep_env, coords, irep, n_rep_neb, cvalues, Mmatri CALL force_env_calc_energy_force(f_env%force_env, & calc_force=.TRUE., skip_external_control=.TRUE.) ! Collect the optimized coordinates - CALL get_pos(rep_env%f_env_id, rep_env%r(1:n_el, j+1), n_el, ierr) + CALL get_pos(rep_env%f_env_id, rep_env%r(1:n_el, j + 1), n_el, ierr) CPASSERT(ierr == 0) ! Collect the gradients in cartesian coordinates - CALL get_force(rep_env%f_env_id, rep_env%f(1:n_el, j+1), n_el, ierr) + CALL get_force(rep_env%f_env_id, rep_env%f(1:n_el, j + 1), n_el, ierr) CPASSERT(ierr == 0) ! Copy the energy - CALL get_energy(rep_env%f_env_id, rep_env%f(n_el+1, j+1), ierr) + CALL get_energy(rep_env%f_env_id, rep_env%f(n_el + 1, j + 1), ierr) CPASSERT(ierr == 0) ! The gradients in the colvar coordinates - CALL get_clv_force(f_env%force_env, rep_env%f(1:n_el, j+1), rep_env%r(1:n_el, j+1), & - SIZE(coords%xyz, 1), SIZE(coords%wrk, 1), cvalues(:, j+1), Mmatrix(:, j+1)) + CALL get_clv_force(f_env%force_env, rep_env%f(1:n_el, j + 1), rep_env%r(1:n_el, j + 1), & + SIZE(coords%xyz, 1), SIZE(coords%wrk, 1), cvalues(:, j + 1), Mmatrix(:, j + 1)) ELSE - rep_env%r(:, j+1) = 0.0_dp - rep_env%f(:, j+1) = 0.0_dp - cvalues(:, j+1) = 0.0_dp - Mmatrix(:, j+1) = 0.0_dp + rep_env%r(:, j + 1) = 0.0_dp + rep_env%f(:, j + 1) = 0.0_dp + cvalues(:, j + 1) = 0.0_dp + Mmatrix(:, j + 1) = 0.0_dp END IF CALL rep_env_sync(rep_env, rep_env%f) CALL rep_env_sync(rep_env, rep_env%r) @@ -684,24 +684,24 @@ SUBROUTINE get_tangent(neb_env, coords, i, tangent, energies, iw) CASE (do_eb) tangent(:) = 0.0_dp CASE (do_b_neb) - CALL neb_replica_distance(coords=coords, i0=i, i=i-1, distance=distance1, iw=iw, & + CALL neb_replica_distance(coords=coords, i0=i, i=i - 1, distance=distance1, iw=iw, & rotate=.FALSE.) - CALL neb_replica_distance(coords=coords, i0=i+1, i=i, distance=distance2, iw=iw, & + CALL neb_replica_distance(coords=coords, i0=i + 1, i=i, distance=distance2, iw=iw, & rotate=.FALSE.) - tangent(:) = (coords%wrk(:, i)-coords%wrk(:, i-1))/distance1+ & - (coords%wrk(:, i+1)-coords%wrk(:, i))/distance2 + tangent(:) = (coords%wrk(:, i) - coords%wrk(:, i - 1))/distance1 + & + (coords%wrk(:, i + 1) - coords%wrk(:, i))/distance2 CASE (do_it_neb, do_ci_neb, do_d_neb) - IF ((energies(i+1) .GT. energies(i)) .AND. (energies(i) .GT. (energies(i-1)))) THEN - tangent(:) = coords%wrk(:, i+1)-coords%wrk(:, i) - ELSE IF ((energies(i+1) .LT. energies(i)) .AND. (energies(i) .LT. (energies(i-1)))) THEN - tangent(:) = coords%wrk(:, i)-coords%wrk(:, i-1) + IF ((energies(i + 1) .GT. energies(i)) .AND. (energies(i) .GT. (energies(i - 1)))) THEN + tangent(:) = coords%wrk(:, i + 1) - coords%wrk(:, i) + ELSE IF ((energies(i + 1) .LT. energies(i)) .AND. (energies(i) .LT. (energies(i - 1)))) THEN + tangent(:) = coords%wrk(:, i) - coords%wrk(:, i - 1) ELSE - DVmax = MAX(ABS(energies(i+1)-energies(i)), ABS(energies(i-1)-energies(i))) - DVmin = MIN(ABS(energies(i+1)-energies(i)), ABS(energies(i-1)-energies(i))) - IF (energies(i+1) .GE. energies(i-1)) THEN - tangent(:) = (coords%wrk(:, i+1)-coords%wrk(:, i))*DVmax+(coords%wrk(:, i)-coords%wrk(:, i-1))*DVmin + DVmax = MAX(ABS(energies(i + 1) - energies(i)), ABS(energies(i - 1) - energies(i))) + DVmin = MIN(ABS(energies(i + 1) - energies(i)), ABS(energies(i - 1) - energies(i))) + IF (energies(i + 1) .GE. energies(i - 1)) THEN + tangent(:) = (coords%wrk(:, i + 1) - coords%wrk(:, i))*DVmax + (coords%wrk(:, i) - coords%wrk(:, i - 1))*DVmin ELSE - tangent(:) = (coords%wrk(:, i+1)-coords%wrk(:, i))*DVmin+(coords%wrk(:, i)-coords%wrk(:, i-1))*DVmax + tangent(:) = (coords%wrk(:, i + 1) - coords%wrk(:, i))*DVmin + (coords%wrk(:, i) - coords%wrk(:, i - 1))*DVmax END IF END IF CASE (do_sm) @@ -761,10 +761,10 @@ RECURSIVE SUBROUTINE get_neb_force(neb_env, tangent, coords, i, forces, tag, Mma ! otherwise proceeed normally.. ALLOCATE (wrk(nsize_wrk)) ! Spring Energy - CALL neb_replica_distance(coords=coords, i0=i-1, i=i, distance=distance1, iw=iw, & + CALL neb_replica_distance(coords=coords, i0=i - 1, i=i, distance=distance1, iw=iw, & rotate=.FALSE.) - tmp = distance1-neb_env%avg_distance - neb_env%spring_energy = neb_env%spring_energy+0.5_dp*neb_env%k*tmp**2 + tmp = distance1 - neb_env%avg_distance + neb_env%spring_energy = neb_env%spring_energy + 0.5_dp*neb_env%k*tmp**2 SELECT CASE (my_tag) CASE (do_eb) CALL cite_reference(Elber1987) @@ -772,40 +772,40 @@ RECURSIVE SUBROUTINE get_neb_force(neb_env, tangent, coords, i, forces, tag, Mma ! formulation ALLOCATE (dtmp1(nsize_wrk)) ! derivatives of the spring - tmp = distance1-neb_env%avg_distance - dtmp1(:) = 1.0_dp/distance1*(coords%wrk(:, i)-coords%wrk(:, i-1)) + tmp = distance1 - neb_env%avg_distance + dtmp1(:) = 1.0_dp/distance1*(coords%wrk(:, i) - coords%wrk(:, i - 1)) wrk(:) = neb_env%k*tmp*dtmp1 - forces%wrk(:, i) = forces%wrk(:, i)-wrk - forces%wrk(:, i-1) = forces%wrk(:, i-1)+wrk + forces%wrk(:, i) = forces%wrk(:, i) - wrk + forces%wrk(:, i - 1) = forces%wrk(:, i - 1) + wrk ! derivatives due to the average length of the spring - fac = 1.0_dp/(neb_env%avg_distance*REAL(neb_env%number_of_replica-1, KIND=dp)) - wrk(:) = neb_env%k*fac*(coords%wrk(:, i)-coords%wrk(:, i-1)) + fac = 1.0_dp/(neb_env%avg_distance*REAL(neb_env%number_of_replica - 1, KIND=dp)) + wrk(:) = neb_env%k*fac*(coords%wrk(:, i) - coords%wrk(:, i - 1)) tmp = 0.0_dp DO j = 2, neb_env%number_of_replica - CALL neb_replica_distance(coords=coords, i0=j-1, i=j, distance=distance1, iw=iw, & + CALL neb_replica_distance(coords=coords, i0=j - 1, i=j, distance=distance1, iw=iw, & rotate=.FALSE.) - tmp = tmp+distance1-neb_env%avg_distance + tmp = tmp + distance1 - neb_env%avg_distance END DO - forces%wrk(:, i) = forces%wrk(:, i)+wrk*tmp - forces%wrk(:, i-1) = forces%wrk(:, i-1)-wrk*tmp + forces%wrk(:, i) = forces%wrk(:, i) + wrk*tmp + forces%wrk(:, i - 1) = forces%wrk(:, i - 1) - wrk*tmp DEALLOCATE (dtmp1) CASE (do_b_neb) ! Bisection NEB CALL cite_reference(Jonsson1998) - wrk(:) = (coords%wrk(:, i+1)-2.0_dp*coords%wrk(:, i)+coords%wrk(:, i-1)) + wrk(:) = (coords%wrk(:, i + 1) - 2.0_dp*coords%wrk(:, i) + coords%wrk(:, i - 1)) tmp = neb_env%k*DOT_PRODUCT(wrk, tangent) - wrk(:) = forces%wrk(:, i)-dot_product_band(neb_env, forces%wrk(:, i), tangent, Mmatrix)*tangent - forces%wrk(:, i) = wrk+tmp*tangent + wrk(:) = forces%wrk(:, i) - dot_product_band(neb_env, forces%wrk(:, i), tangent, Mmatrix)*tangent + forces%wrk(:, i) = wrk + tmp*tangent CASE (do_it_neb) ! Improved tangent NEB CALL cite_reference(Jonsson2000_1) - CALL neb_replica_distance(coords=coords, i0=i, i=i+1, distance=distance1, iw=iw, & + CALL neb_replica_distance(coords=coords, i0=i, i=i + 1, distance=distance1, iw=iw, & rotate=.FALSE.) - CALL neb_replica_distance(coords=coords, i0=i-1, i=i, distance=distance2, iw=iw, & + CALL neb_replica_distance(coords=coords, i0=i - 1, i=i, distance=distance2, iw=iw, & rotate=.FALSE.) - tmp = neb_env%k*(distance1-distance2) - wrk(:) = forces%wrk(:, i)-dot_product_band(neb_env, forces%wrk(:, i), tangent, Mmatrix)*tangent - forces%wrk(:, i) = wrk+tmp*tangent + tmp = neb_env%k*(distance1 - distance2) + wrk(:) = forces%wrk(:, i) - dot_product_band(neb_env, forces%wrk(:, i), tangent, Mmatrix)*tangent + forces%wrk(:, i) = wrk + tmp*tangent CASE (do_ci_neb) ! Climbing Image NEB CALL cite_reference(Jonsson2000_2) @@ -814,22 +814,22 @@ RECURSIVE SUBROUTINE get_neb_force(neb_env, tangent, coords, i, forces, tag, Mma ELSE wrk(:) = forces%wrk(:, i) tmp = -2.0_dp*dot_product_band(neb_env, wrk, tangent, Mmatrix) - forces%wrk(:, i) = wrk+tmp*tangent + forces%wrk(:, i) = wrk + tmp*tangent END IF CASE (do_d_neb) ! Doubly NEB CALL cite_reference(Wales2004) ALLOCATE (dtmp1(nsize_wrk)) - dtmp1(:) = forces%wrk(:, i)-dot_product_band(neb_env, forces%wrk(:, i), tangent, Mmatrix)*tangent + dtmp1(:) = forces%wrk(:, i) - dot_product_band(neb_env, forces%wrk(:, i), tangent, Mmatrix)*tangent forces%wrk(:, i) = dtmp1 tmp = SQRT(DOT_PRODUCT(dtmp1, dtmp1)) dtmp1(:) = dtmp1(:)/tmp ! Project out only the spring component interfering with the ! orthogonal gradient of the band - wrk(:) = (coords%wrk(:, i+1)-2.0_dp*coords%wrk(:, i)+coords%wrk(:, i-1)) + wrk(:) = (coords%wrk(:, i + 1) - 2.0_dp*coords%wrk(:, i) + coords%wrk(:, i - 1)) tmp = DOT_PRODUCT(wrk, dtmp1) - dtmp1(:) = neb_env%k*(wrk(:)-tmp*dtmp1(:)) - forces%wrk(:, i) = forces%wrk(:, i)+dtmp1(:) + dtmp1(:) = neb_env%k*(wrk(:) - tmp*dtmp1(:)) + forces%wrk(:, i) = forces%wrk(:, i) + dtmp1(:) DEALLOCATE (dtmp1) END SELECT DEALLOCATE (wrk) @@ -910,21 +910,21 @@ SUBROUTINE reorient_images(rotate_frames, particle_set, coords, vels, iw, & ! The rotation of the replica is enabled exclusively when working in ! cartesian coordinates IF (rotate_frames .AND. (coords%in_use == do_band_cartesian)) THEN - CALL rmsd3(particle_set, coords%xyz(:, i), coords%xyz(:, i-1), iw, & + CALL rmsd3(particle_set, coords%xyz(:, i), coords%xyz(:, i - 1), iw, & rotate=.TRUE., rot=rot) ! Rotate velocities DO k = 1, SIZE(vels%xyz, 1)/3 - kind = (k-1)*3 - tmp = vels%xyz(kind+1:kind+3, i) - CALL matvec_3x3(vels%xyz(kind+1:kind+3, i), TRANSPOSE(rot), tmp) + kind = (k - 1)*3 + tmp = vels%xyz(kind + 1:kind + 3, i) + CALL matvec_3x3(vels%xyz(kind + 1:kind + 3, i), TRANSPOSE(rot), tmp) END DO END IF IF (PRESENT(distances)) THEN - check = SIZE(distances) == (number_of_replica-1) + check = SIZE(distances) == (number_of_replica - 1) CPASSERT(check) - xtmp = DOT_PRODUCT(coords%wrk(:, i)-coords%wrk(:, i-1), & - coords%wrk(:, i)-coords%wrk(:, i-1)) - distances(i-1) = SQRT(xtmp) + xtmp = DOT_PRODUCT(coords%wrk(:, i) - coords%wrk(:, i - 1), & + coords%wrk(:, i) - coords%wrk(:, i - 1)) + distances(i - 1) = SQRT(xtmp) END IF END DO END SUBROUTINE reorient_images @@ -959,42 +959,42 @@ SUBROUTINE reparametrize_images(reparametrize_frames, spline_order, smoothing, & ALLOCATE (tmp_coords(SIZE(coords, 1), SIZE(coords, 2))) tmp_coords(:, :) = coords ! Smoothing - DO i = 2, SIZE(coords, 2)-1 - coords(:, i) = tmp_coords(:, i)*(1.0_dp-2.0_dp*smoothing)+ & - tmp_coords(:, i-1)*smoothing+tmp_coords(:, i+1)*smoothing + DO i = 2, SIZE(coords, 2) - 1 + coords(:, i) = tmp_coords(:, i)*(1.0_dp - 2.0_dp*smoothing) + & + tmp_coords(:, i - 1)*smoothing + tmp_coords(:, i + 1)*smoothing END DO - sline = coords-tmp_coords+sline + sline = coords - tmp_coords + sline tmp_coords(:, :) = coords ! Reparametrization SELECT CASE (spline_order) CASE (1) ! Compute distances DO i = 2, SIZE(coords, 2) - xtmp = DOT_PRODUCT(coords(:, i)-coords(:, i-1), coords(:, i)-coords(:, i-1)) - distances(i-1) = SQRT(xtmp) + xtmp = DOT_PRODUCT(coords(:, i) - coords(:, i - 1), coords(:, i) - coords(:, i - 1)) + distances(i - 1) = SQRT(xtmp) END DO - avg_distance = SUM(distances)/REAL(SIZE(coords, 2)-1, KIND=dp) + avg_distance = SUM(distances)/REAL(SIZE(coords, 2) - 1, KIND=dp) ! Redistribute frames - DO i = 2, SIZE(coords, 2)-1 + DO i = 2, SIZE(coords, 2) - 1 xtmp = 0.0_dp - DO j = 1, SIZE(coords, 2)-1 - xtmp = xtmp+distances(j) - IF (xtmp > avg_distance*REAL(i-1, KIND=dp)) THEN - xtmp = (xtmp-avg_distance*REAL(i-1, KIND=dp))/distances(j) - coords(:, i) = (1.0_dp-xtmp)*tmp_coords(:, j+1)+xtmp*tmp_coords(:, j) + DO j = 1, SIZE(coords, 2) - 1 + xtmp = xtmp + distances(j) + IF (xtmp > avg_distance*REAL(i - 1, KIND=dp)) THEN + xtmp = (xtmp - avg_distance*REAL(i - 1, KIND=dp))/distances(j) + coords(:, i) = (1.0_dp - xtmp)*tmp_coords(:, j + 1) + xtmp*tmp_coords(:, j) EXIT END IF END DO END DO ! Re-compute distances DO i = 2, SIZE(coords, 2) - xtmp = DOT_PRODUCT(coords(:, i)-coords(:, i-1), coords(:, i)-coords(:, i-1)) - distances(i-1) = SQRT(xtmp) + xtmp = DOT_PRODUCT(coords(:, i) - coords(:, i - 1), coords(:, i) - coords(:, i - 1)) + distances(i - 1) = SQRT(xtmp) END DO CASE DEFAULT CPWARN("String Method: Spline order greater than 1 not implemented.") END SELECT - sline = coords-tmp_coords+sline + sline = coords - tmp_coords + sline DEALLOCATE (tmp_coords) END IF END SUBROUTINE reparametrize_images diff --git a/src/motion/pint_gle.F b/src/motion/pint_gle.F index d03dea0365..b610e3d33e 100644 --- a/src/motion/pint_gle.F +++ b/src/motion/pint_gle.F @@ -41,7 +41,7 @@ SUBROUTINE pint_calc_gle_energy(pint_env) pint_env%e_gle = 0._dp IF (ASSOCIATED(pint_env%gle)) THEN DO i = 1, pint_env%gle%loc_num_gle - pint_env%e_gle = pint_env%e_gle+pint_env%gle%nvt(i)%thermostat_energy + pint_env%e_gle = pint_env%e_gle + pint_env%gle%nvt(i)%thermostat_energy END DO END IF END SUBROUTINE @@ -60,8 +60,8 @@ SUBROUTINE pint_gle_init(pint_env) CALL gle_cholesky_stab(pint_env%gle%c_mat, cc, pint_env%gle%ndim) DO i = 1, pint_env%gle%loc_num_gle imap = pint_env%gle%map_info%index(i) - ib = 1+(imap-1)/pint_env%ndim - idim = 1+MOD(imap-1, pint_env%ndim) + ib = 1 + (imap - 1)/pint_env%ndim + idim = 1 + MOD(imap - 1, pint_env%ndim) mf = 1.0_dp/SQRT(pint_env%mass_fict(ib, idim)) rng_stream => pint_env%gle%nvt(i)%gaussian_rng_stream DO j = 1, pint_env%gle%ndim @@ -101,12 +101,12 @@ SUBROUTINE pint_gle_step(pint_env) DO ideg = 1, gle%loc_num_gle imap = gle%map_info%index(ideg) - ib = 1+(imap-1)/pint_env%ndim - idim = 1+MOD(imap-1, pint_env%ndim) + ib = 1 + (imap - 1)/pint_env%ndim + idim = 1 + MOD(imap - 1, pint_env%ndim) gle%nvt(ideg)%s(1) = pint_env%uv_t(ib, idim) gle%nvt(ideg)%thermostat_energy = gle%nvt(ideg)%thermostat_energy & - +0.5_dp*pint_env%mass_fict(ib, idim)*gle%nvt(ideg)%s(1)**2 + + 0.5_dp*pint_env%mass_fict(ib, idim)*gle%nvt(ideg)%s(1)**2 s_tmp(1, imap) = gle%nvt(ideg)%s(1) rng_stream => gle%nvt(ideg)%gaussian_rng_stream rr = next_random_number(rng_stream) @@ -135,11 +135,11 @@ SUBROUTINE pint_gle_step(pint_env) DO iadd = 1, ndim gle%nvt(ideg)%s(iadd) = h_tmp(iadd, imap) END DO - ib = 1+(imap-1)/pint_env%ndim - idim = 1+MOD(imap-1, pint_env%ndim) + ib = 1 + (imap - 1)/pint_env%ndim + idim = 1 + MOD(imap - 1, pint_env%ndim) pint_env%uv_t(ib, idim) = gle%nvt(ideg)%s(1) gle%nvt(ideg)%thermostat_energy = gle%nvt(ideg)%thermostat_energy & - -0.5_dp*pint_env%mass_fict(ib, idim)*gle%nvt(ideg)%s(1)**2 + - 0.5_dp*pint_env%mass_fict(ib, idim)*gle%nvt(ideg)%s(1)**2 END DO pint_env%e_kin_t = 0.0_dp DEALLOCATE (e_tmp, s_tmp, h_tmp) diff --git a/src/motion/pint_io.F b/src/motion/pint_io.F index f3e9713630..9b7a3be974 100644 --- a/src/motion/pint_io.F +++ b/src/motion/pint_io.F @@ -194,13 +194,13 @@ SUBROUTINE pint_write_centroids(pint_env) idim = 0 DO iat = 1, pint_env%ndim/3 DO idir = 1, 3 - idim = idim+1 + idim = idim + 1 ss = 0.0_dp vv = 0.0_dp ! ss2=0.0_dp DO ib = 1, pint_env%p - ss = ss+pint_env%x(ib, idim) - vv = vv+pint_env%v(ib, idim) + ss = ss + pint_env%x(ib, idim) + vv = vv + pint_env%v(ib, idim) ! ss2=ss2+pint_env%x(ib,idim)**2 END DO particles%els(iat)%r(idir) = ss/nb @@ -354,7 +354,7 @@ SUBROUTINE pint_write_trajectory(pint_env) idim = 0 DO iat = 1, pint_env%ndim/3 DO idir = 1, 3 - idim = idim+1 + idim = idim + 1 particles%els(iat)%r(idir) = pint_env%x(ib, idim) particles%els(iat)%v(idir) = pint_env%v(ib, idim) particles%els(iat)%f(idir) = pint_env%f(ib, idim) @@ -542,7 +542,7 @@ SUBROUTINE pint_write_ener(pint_env) ndof = pint_env%p IF (pint_env%first_propagated_mode .EQ. 2) THEN - ndof = ndof-1 + ndof = ndof - 1 END IF temp = cp_unit_from_cp2k(2.0_dp*pint_env%e_kin_beads/ & REAL(ndof, dp)/REAL(pint_env%ndim, dp), & @@ -746,10 +746,10 @@ SUBROUTINE pint_write_rgyr(pint_env) idim = 0 DO ia = 1, pint_env%ndim/3 DO ic = 1, 3 - idim = idim+1 + idim = idim + 1 ss = 0.0_dp DO ib = 1, pint_env%p - ss = ss+pint_env%x(ib, idim) + ss = ss + pint_env%x(ib, idim) END DO pint_env%rtmp_ndim(idim) = ss/nb END DO @@ -760,9 +760,9 @@ SUBROUTINE pint_write_rgyr(pint_env) DO ia = 1, pint_env%ndim/3 ss = 0.0_dp DO ic = 1, 3 - idim = idim+1 + idim = idim + 1 DO ib = 1, pint_env%p - ss = ss+(pint_env%x(ib, idim)-pint_env%rtmp_ndim(idim))**2 + ss = ss + (pint_env%x(ib, idim) - pint_env%rtmp_ndim(idim))**2 END DO END DO pint_env%rtmp_natom(ia) = SQRT(ss/nb)*unit_conv diff --git a/src/motion/pint_methods.F b/src/motion/pint_methods.F index a54dcea694..96df595f2d 100644 --- a/src/motion/pint_methods.F +++ b/src/motion/pint_methods.F @@ -242,7 +242,7 @@ SUBROUTINE pint_create(pint_env, input, input_declaration, para_env) pint_env%logger => cp_get_default_logger() CALL cp_add_iter_level(pint_env%logger%iter_info, "PINT") - last_pint_id = last_pint_id+1 + last_pint_id = last_pint_id + 1 pint_env%id_nr = last_pint_id pint_env%ref_count = 1 NULLIFY (pint_env%replicas, pint_env%input, pint_env%staging_env, & @@ -264,12 +264,12 @@ SUBROUTINE pint_create(pint_env, input, input_declaration, para_env) CALL section_vals_val_get(input, "MOTION%PINT%MAX_STEP", & i_val=itmp) pint_env%last_step = itmp - pint_env%num_steps = pint_env%last_step-pint_env%first_step + pint_env%num_steps = pint_env%last_step - pint_env%first_step ELSE CALL section_vals_val_get(input, "MOTION%PINT%NUM_STEPS", & i_val=itmp) pint_env%num_steps = itmp - pint_env%last_step = pint_env%first_step+pint_env%num_steps + pint_env%last_step = pint_env%first_step + pint_env%num_steps END IF CALL section_vals_val_get(pint_section, "DT", & @@ -427,7 +427,7 @@ SUBROUTINE pint_create(pint_env, input, input_declaration, para_env) DO iat = 1, pint_env%ndim/3 CALL get_atomic_kind(particles%els(iat)%atomic_kind, mass=mass) DO idir = 1, 3 - idim = idim+1 + idim = idim + 1 pint_env%mass(idim) = mass END DO END DO @@ -474,8 +474,8 @@ SUBROUTINE pint_create(pint_env, input, input_declaration, para_env) CALL gle_matrix_exp((-pint_env%dt/pint_env%nrespa*0.5_dp)*pint_env%gle%a_mat, & pint_env%gle%ndim, 15, 15, pint_env%gle%gle_t) ! stochastic part - CALL gle_cholesky_stab(pint_env%gle%c_mat-MATMUL(pint_env%gle%gle_t, & - MATMUL(pint_env%gle%c_mat, TRANSPOSE(pint_env%gle%gle_t))), & + CALL gle_cholesky_stab(pint_env%gle%c_mat - MATMUL(pint_env%gle%gle_t, & + MATMUL(pint_env%gle%c_mat, TRANSPOSE(pint_env%gle%gle_t))), & pint_env%gle%gle_s, pint_env%gle%ndim) ! and initialize the additional momenta CALL pint_gle_init(pint_env) @@ -666,14 +666,14 @@ SUBROUTINE pint_create(pint_env, input, input_declaration, para_env) pint_env%n_atoms_constraints = 0 DO ig = 1, gci%ncolv%ntot ! Double counts, if the same atom is involved in different collective variables - pint_env%n_atoms_constraints = pint_env%n_atoms_constraints+SIZE(gci%colv_list(ig)%i_atoms) + pint_env%n_atoms_constraints = pint_env%n_atoms_constraints + SIZE(gci%colv_list(ig)%i_atoms) END DO ALLOCATE (pint_env%atoms_constraints(pint_env%n_atoms_constraints)) icont = 0 DO ig = 1, gci%ncolv%ntot DO iat = 1, SIZE(gci%colv_list(ig)%i_atoms) - icont = icont+1 + icont = icont + 1 pint_env%atoms_constraints(icont) = gci%colv_list(ig)%i_atoms(iat) END DO END DO @@ -682,7 +682,7 @@ SUBROUTINE pint_create(pint_env, input, input_declaration, para_env) CALL section_vals_val_get(pint_section, "kT_CORRECTION", & l_val=ltmp) IF (ltmp) THEN - pint_env%kTcorr = 1.0_dp+REAL(3*pint_env%n_atoms_constraints, dp)/(REAL(pint_env%ndim, dp)*REAL(pint_env%p, dp)) + pint_env%kTcorr = 1.0_dp + REAL(3*pint_env%n_atoms_constraints, dp)/(REAL(pint_env%ndim, dp)*REAL(pint_env%p, dp)) END IF END IF @@ -703,7 +703,7 @@ SUBROUTINE pint_retain(pint_env) CPASSERT(ASSOCIATED(pint_env)) CPASSERT(pint_env%ref_count > 0) - pint_env%ref_count = pint_env%ref_count+1 + pint_env%ref_count = pint_env%ref_count + 1 RETURN END SUBROUTINE pint_retain @@ -721,7 +721,7 @@ SUBROUTINE pint_release(pint_env) IF (ASSOCIATED(pint_env)) THEN CPASSERT(pint_env%ref_count > 0) - pint_env%ref_count = pint_env%ref_count-1 + pint_env%ref_count = pint_env%ref_count - 1 IF (pint_env%ref_count == 0) THEN CALL rep_env_release(pint_env%replicas) CALL section_vals_release(pint_env%input) @@ -829,7 +829,7 @@ SUBROUTINE pint_test(para_env, input, input_declaration) CALL pint_u2x(pint_env) err = 0._dp DO i = 1, pint_env%ndim - err = MAX(err, ABS(x1(1, i)-pint_env%x(1, i))) + err = MAX(err, ABS(x1(1, i) - pint_env%x(1, i))) END DO IF (unit_nr > 0) WRITE (unit_nr, *) "diff_r1="//cp_to_string(err) @@ -838,17 +838,17 @@ SUBROUTINE pint_test(para_env, input, input_declaration) pint_env%f = 0._dp DO idim = 1, pint_env%ndim DO ib = 1, pint_env%p - pint_env%f(ib, idim) = pint_env%f(ib, idim)+ & + pint_env%f(ib, idim) = pint_env%f(ib, idim) + & c*(2._dp*pint_env%x(ib, idim) & - -pint_env%x(MODULO(ib-2, pint_env%p)+1, idim) & - -pint_env%x(MODULO(ib, pint_env%p)+1, idim)) + - pint_env%x(MODULO(ib - 2, pint_env%p) + 1, idim) & + - pint_env%x(MODULO(ib, pint_env%p) + 1, idim)) END DO END DO CALL pint_f2uf(pint_env) err = 0._dp DO idim = 1, pint_env%ndim DO ib = 1, pint_env%p - err = MAX(err, ABS(pint_env%uf(ib, idim)-pint_env%uf_h(ib, idim))) + err = MAX(err, ABS(pint_env%uf(ib, idim) - pint_env%uf_h(ib, idim))) END DO END DO IF (unit_nr > 0) WRITE (unit_nr, *) "diff_f_h="//cp_to_string(err) @@ -1099,9 +1099,9 @@ SUBROUTINE pint_init_x(pint_env) DO ia = 1, pint_env%ndim/3 var = SQRT(1.0_dp/(pint_env%kT*tcorr*pint_env%mass(3*ia))) DO ic = 1, 3 - idim = idim+1 + idim = idim + 1 DO ib = 1, pint_env%p - pint_env%x(ib, idim) = pint_env%x(ib, idim)+bx(3*(ib-1)+ic)*var + pint_env%x(ib, idim) = pint_env%x(ib, idim) + bx(3*(ib - 1) + ic)*var END DO END DO END DO @@ -1111,15 +1111,15 @@ SUBROUTINE pint_init_x(pint_env) ! uncorrelated bead initialization - distinct Levy walk for each atom idim = 0 DO ia = 1, pint_env%ndim/3 - x0(1) = pint_env%x(1, 3*(ia-1)+1) - x0(2) = pint_env%x(1, 3*(ia-1)+2) - x0(3) = pint_env%x(1, 3*(ia-1)+3) + x0(1) = pint_env%x(1, 3*(ia - 1) + 1) + x0(2) = pint_env%x(1, 3*(ia - 1) + 2) + x0(3) = pint_env%x(1, 3*(ia - 1) + 3) var = SQRT(1.0_dp/(pint_env%kT*tcorr*pint_env%mass(3*ia))) CALL pint_levy_walk(x0, pint_env%p, var, bx, rng_gaussian) DO ic = 1, 3 - idim = idim+1 + idim = idim + 1 DO ib = 1, pint_env%p - pint_env%x(ib, idim) = pint_env%x(ib, idim)+bx(3*(ib-1)+ic) + pint_env%x(ib, idim) = pint_env%x(ib, idim) + bx(3*(ib - 1) + ic) END DO END DO END DO @@ -1148,7 +1148,7 @@ SUBROUTINE pint_init_x(pint_env) ic = 0 DO idim = 1, pint_env%ndim DO ib = 1, pint_env%p - ic = ic+1 + ic = ic + 1 pint_env%x(ib, idim) = r_vals(ic) END DO END DO @@ -1163,7 +1163,7 @@ SUBROUTINE pint_init_x(pint_env) IF (ltmp) THEN DO idim = 1, pint_env%ndim DO ib = 1, pint_env%p - pint_env%x(ib, idim) = pint_env%x(ib, idim)+ & + pint_env%x(ib, idim) = pint_env%x(ib, idim) + & next_random_number(rng_stream=pint_env%randomG, & variance=pint_env%beta/ & SQRT(12.0_dp*pint_env%mass(idim))) @@ -1325,7 +1325,7 @@ SUBROUTINE pint_init_v(pint_env) CPABORT(msg) DO ib = 1, pint_env%p DO ic = 1, 3 - idim = 3*(ia-1)+ic + idim = 3*(ia - 1) + ic pint_env%v(ib, idim) = r_vals(ic)*unit_conv END DO END DO @@ -1341,10 +1341,10 @@ SUBROUTINE pint_init_v(pint_env) DO ia = 1, pint_env%ndim/3 rtmp = 0.0_dp DO ic = 1, 3 - idim = 3*(ia-1)+ic - rtmp = rtmp+pint_env%v(1, idim)*pint_env%v(1, idim) + idim = 3*(ia - 1) + ic + rtmp = rtmp + pint_env%v(1, idim)*pint_env%v(1, idim) END DO - ek = ek+0.5_dp*pint_env%mass(idim)*rtmp + ek = ek + 0.5_dp*pint_env%mass(idim)*rtmp END DO actual_t = 2.0_dp*ek/pint_env%ndim ELSE @@ -1364,7 +1364,7 @@ SUBROUTINE pint_init_v(pint_env) DO ia = 1, pint_env%ndim/3 DO ib = 1, pint_env%p DO ic = 1, 3 - idim = 3*(ia-1)+ic + idim = 3*(ia - 1) + ic pint_env%v(ib, idim) = rtmp*pint_env%v(ib, idim) END DO END DO @@ -1403,7 +1403,7 @@ SUBROUTINE pint_init_v(pint_env) variance=pint_env%mass(idim)*pint_env%kT) & /pint_env%mass(idim) DO ib = 1, pint_env%p - pint_env%v(ib, idim) = pint_env%v(ib, idim)+rtmp + pint_env%v(ib, idim) = pint_env%v(ib, idim) + rtmp END DO END DO CALL pint_x2u(pint_env, ux=pint_env%uv, x=pint_env%v) @@ -1445,7 +1445,7 @@ SUBROUTINE pint_init_v(pint_env) itmp = 0 DO idim = 1, pint_env%ndim DO ib = 1, pint_env%p - itmp = itmp+1 + itmp = itmp + 1 pint_env%v(ib, idim) = r_vals(itmp) END DO END DO @@ -1503,7 +1503,7 @@ SUBROUTINE pint_init_v(pint_env) IF (pint_env%logger%para_env%ionode) THEN DO i = 1, nparticle DO j = 1, 3 - vel(j, i) = pint_env%uv(1, j+(i-1)*3)/factor + vel(j, i) = pint_env%uv(1, j + (i - 1)*3)/factor END DO END DO @@ -1528,7 +1528,7 @@ SUBROUTINE pint_init_v(pint_env) DO i = 1, nparticle DO j = 1, 3 - pint_env%uv(1, j+(i-1)*3) = vel(j, i)*factor + pint_env%uv(1, j + (i - 1)*3) = vel(j, i)*factor END DO END DO @@ -1592,7 +1592,7 @@ SUBROUTINE pint_init_t(pint_env, kT) DO idim = 1, pint_env%ndim DO ib = 1, pint_env%p DO inos = 1, pint_env%nnos - ii = ii+1 + ii = ii + 1 pint_env%tx(inos, ib, idim) = r_vals(ii) END DO END DO @@ -1617,7 +1617,7 @@ SUBROUTINE pint_init_t(pint_env, kT) DO idim = 1, pint_env%ndim DO ib = 1, pint_env%p DO inos = 1, pint_env%nnos - ii = ii+1 + ii = ii + 1 pint_env%tv(inos, ib, idim) = r_vals(ii) END DO END DO @@ -1675,7 +1675,7 @@ SUBROUTINE pint_init_f(pint_env, helium_env) ! contains proper forces in force_avrg array at ionode IF (PRESENT(helium_env)) THEN IF (logger%para_env%ionode) THEN - pint_env%f(:, :) = pint_env%f(:, :)+helium_env(1)%helium%force_avrg(:, :) + pint_env%f(:, :) = pint_env%f(:, :) + helium_env(1)%helium%force_avrg(:, :) END IF CALL mp_bcast(pint_env%f, & logger%para_env%source, & @@ -1700,19 +1700,19 @@ SUBROUTINE pint_init_f(pint_env, helium_env) DO idim = 1, SIZE(pint_env%uf_h, 2) DO ib = 1, SIZE(pint_env%uf_h, 1) pint_env%tf(1, ib, idim) = (pint_env%mass_fict(ib, idim)* & - pint_env%uv(ib, idim)**2-pint_env%kT)/pint_env%Q(ib) + pint_env%uv(ib, idim)**2 - pint_env%kT)/pint_env%Q(ib) END DO END DO DO idim = 1, pint_env%ndim DO ib = 1, pint_env%p - DO inos = 1, pint_env%nnos-1 - pint_env%tf(inos+1, ib, idim) = pint_env%tv(inos, ib, idim)**2- & - pint_env%kT/pint_env%Q(ib) + DO inos = 1, pint_env%nnos - 1 + pint_env%tf(inos + 1, ib, idim) = pint_env%tv(inos, ib, idim)**2 - & + pint_env%kT/pint_env%Q(ib) END DO - DO inos = 1, pint_env%nnos-1 + DO inos = 1, pint_env%nnos - 1 pint_env%tf(inos, ib, idim) = pint_env%tf(inos, ib, idim) & - -pint_env%tv(inos, ib, idim)*pint_env%tv(inos+1, ib, idim) + - pint_env%tv(inos, ib, idim)*pint_env%tv(inos + 1, ib, idim) END DO END DO END DO @@ -1801,18 +1801,18 @@ SUBROUTINE pint_do_run(pint_env, globenv, helium_env) ! main PIMD loop DO step = 1, pint_env%num_steps - pint_env%iter = pint_env%iter+1 + pint_env%iter = pint_env%iter + 1 CALL cp_iterate(pint_env%logger%iter_info, & last=(step == pint_env%num_steps), & iter_nr=pint_env%iter) CALL cp_iterate(logger%iter_info, & last=(step == pint_env%num_steps), & iter_nr=pint_env%iter) - pint_env%t = pint_env%t+pint_env%dt + pint_env%t = pint_env%t + pint_env%dt IF (pint_env%t_tol > 0.0_dp) THEN IF (ABS(2._dp*pint_env%e_kin_beads/(pint_env%p*pint_env%ndim) & - -pint_env%kT) > pint_env%t_tol) THEN + - pint_env%kT) > pint_env%t_tol) THEN scal = SQRT(pint_env%kT*(pint_env%p*pint_env%ndim)/(2.0_dp*pint_env%e_kin_beads)) pint_env%uv = scal*pint_env%uv CALL pint_init_f(pint_env, helium_env=helium_env) @@ -1893,8 +1893,8 @@ SUBROUTINE pint_run_scan(pint_env, helium_env) CALL helium_write_cubefile( & unit_nr, & comment, & - helium_env(1)%helium%center-0.5_dp* & - (helium_env(1)%helium%rho_maxr-helium_env(1)%helium%rho_delr), & + helium_env(1)%helium%center - 0.5_dp* & + (helium_env(1)%helium%rho_maxr - helium_env(1)%helium%rho_delr), & helium_env(1)%helium%rho_delr, & helium_env(1)%helium%rho_nbin, & DATA) @@ -2022,39 +2022,39 @@ SUBROUTINE pint_step(pint_env, helium_env) IF (pint_env%simpar%constraint) THEN DO k = 1, pint_env%n_atoms_constraints ia = pint_env%atoms_constraints(k) - DO j = 3*(ia-1)+1, 3*ia + DO j = 3*(ia - 1) + 1, 3*ia pint_env%tv(:, 1, j) = 0.0_dp END DO END DO END IF DO i = pint_env%first_propagated_mode, pint_env%p - pint_env%ux(i, :) = pint_env%ux(i, :)- & + pint_env%ux(i, :) = pint_env%ux(i, :) - & dti22*pint_env%uv(i, :)*pint_env%tv(1, i, :) END DO - pint_env%tx = pint_env%tx+dti*pint_env%tv+dti22*pint_env%tf + pint_env%tx = pint_env%tx + dti*pint_env%tv + dti22*pint_env%tf END IF !Integrate position in harmonic springs (uf_h) and physical potential !(uf) DO i = pint_env%first_propagated_mode, pint_env%p - pint_env%ux_t(i, :) = pint_env%ux(i, :)+ & - dti*pint_env%uv(i, :)+ & - dti22*(pint_env%uf_h(i, :)+ & + pint_env%ux_t(i, :) = pint_env%ux(i, :) + & + dti*pint_env%uv(i, :) + & + dti22*(pint_env%uf_h(i, :) + & pint_env%uf(i, :)) END DO ! apply thermostats to velocities SELECT CASE (pint_env%pimd_thermostat) CASE (thermostat_nose) - pint_env%uv_t = pint_env%uv-dti2* & + pint_env%uv_t = pint_env%uv - dti2* & pint_env%uv*pint_env%tv(1, :, :) tmp => pint_env%tv_t pint_env%tv_t => pint_env%tv pint_env%tv => tmp - pint_env%tv = pint_env%tv_old+tdti*pint_env%tf + pint_env%tv = pint_env%tv_old + tdti*pint_env%tf pint_env%tv_old = pint_env%tv_t - pint_env%tv_t = pint_env%tv_t+dti2*pint_env%tf + pint_env%tv_t = pint_env%tv_t + dti2*pint_env%tf CASE DEFAULT pint_env%uv_t = pint_env%uv END SELECT @@ -2063,7 +2063,7 @@ SUBROUTINE pint_step(pint_env, helium_env) IF (pint_env%simpar%constraint) THEN DO k = 1, pint_env%n_atoms_constraints ia = pint_env%atoms_constraints(k) - DO j = 3*(ia-1)+1, 3*ia + DO j = 3*(ia - 1) + 1, 3*ia pint_env%tv(:, 1, j) = 0.0_dp pint_env%tv_t(:, 1, j) = 0.0_dp END DO @@ -2071,7 +2071,7 @@ SUBROUTINE pint_step(pint_env, helium_env) END IF !Integrate harmonic velocities and physical velocities - pint_env%uv_t = pint_env%uv_t+dti2*(pint_env%uf_h+pint_env%uf) + pint_env%uv_t = pint_env%uv_t + dti2*(pint_env%uf_h + pint_env%uf) ! physical forces are only applied in first respa step. pint_env%uf = 0.0_dp @@ -2083,8 +2083,8 @@ SUBROUTINE pint_step(pint_env, helium_env) IF (pint_env%logger%para_env%ionode) THEN DO i = 1, nparticle DO j = 1, 3 - pos(j, i) = pint_env%ux(1, j+(i-1)*3) - vel(j, i) = pint_env%uv_t(1, j+(i-1)*3) + pos(j, i) = pint_env%ux(1, j + (i - 1)*3) + vel(j, i) = pint_env%uv_t(1, j + (i - 1)*3) END DO END DO @@ -2110,15 +2110,15 @@ SUBROUTINE pint_step(pint_env, helium_env) ! Transform back to normal modes: DO i = 1, nparticle DO j = 1, 3 - pint_env%ux(1, j+(i-1)*3) = pos(j, i) - pint_env%uv_t(1, j+(i-1)*3) = vel(j, i) + pint_env%ux(1, j + (i - 1)*3) = pos(j, i) + pint_env%uv_t(1, j + (i - 1)*3) = vel(j, i) END DO END DO END IF CALL pint_calc_uf_h(pint_env=pint_env, e_h=e_h) - pint_env%uv_t = pint_env%uv_t+dti2*(pint_env%uf_h+pint_env%uf) + pint_env%uv_t = pint_env%uv_t + dti2*(pint_env%uf_h + pint_env%uf) ! For last respa step include integration of physical and helium ! forces @@ -2130,7 +2130,7 @@ SUBROUTINE pint_step(pint_env, helium_env) CALL helium_step(helium_env, pint_env) !Update force of solute in pint_env IF (pint_env%logger%para_env%ionode) THEN - pint_env%f(:, :) = pint_env%f(:, :)+helium_env(1)%helium%force_avrg(:, :) + pint_env%f(:, :) = pint_env%f(:, :) + helium_env(1)%helium%force_avrg(:, :) END IF CALL mp_bcast(pint_env%f, & pint_env%logger%para_env%source, & @@ -2145,7 +2145,7 @@ SUBROUTINE pint_step(pint_env, helium_env) !Scale physical forces and integrate velocities with physical !forces pint_env%uf = pint_env%uf*rn - pint_env%uv_t = pint_env%uv_t+dti2*pint_env%uf + pint_env%uv_t = pint_env%uv_t + dti2*pint_env%uf END IF @@ -2158,7 +2158,7 @@ SUBROUTINE pint_step(pint_env, helium_env) DO idim = 1, pint_env%ndim DO ib = 1, pint_env%p pint_env%tf(1, ib, idim) = (pint_env%mass_fict(ib, idim)* & - pint_env%uv_new(ib, idim)**2-pint_env%kT*pint_env%kTcorr)/ & + pint_env%uv_new(ib, idim)**2 - pint_env%kT*pint_env%kTcorr)/ & pint_env%Q(ib) END DO END DO @@ -2167,7 +2167,7 @@ SUBROUTINE pint_step(pint_env, helium_env) IF (pint_env%simpar%constraint) THEN DO k = 1, pint_env%n_atoms_constraints ia = pint_env%atoms_constraints(k) - DO j = 3*(ia-1)+1, 3*ia + DO j = 3*(ia - 1) + 1, 3*ia pint_env%tf(:, 1, j) = 0.0_dp END DO END DO @@ -2175,21 +2175,21 @@ SUBROUTINE pint_step(pint_env, helium_env) DO idim = 1, pint_env%ndim DO ib = 1, pint_env%p - DO inos = 1, pint_env%nnos-1 + DO inos = 1, pint_env%nnos - 1 pint_env%tv_new(inos, ib, idim) = & - (pint_env%tv_t(inos, ib, idim)+dti2*pint_env%tf(inos, ib, idim))/ & - (1._dp+dti2*pint_env%tv(inos+1, ib, idim)) - pint_env%tf(inos+1, ib, idim) = & - (pint_env%tv_new(inos, ib, idim)**2- & + (pint_env%tv_t(inos, ib, idim) + dti2*pint_env%tf(inos, ib, idim))/ & + (1._dp + dti2*pint_env%tv(inos + 1, ib, idim)) + pint_env%tf(inos + 1, ib, idim) = & + (pint_env%tv_new(inos, ib, idim)**2 - & pint_env%kT*pint_env%kTcorr/pint_env%Q(ib)) tol = MAX(tol, ABS(pint_env%tv(inos, ib, idim) & - -pint_env%tv_new(inos, ib, idim))) + - pint_env%tv_new(inos, ib, idim))) END DO !Set thermostat action of constrained DoF to zero: IF (pint_env%simpar%constraint) THEN DO k = 1, pint_env%n_atoms_constraints ia = pint_env%atoms_constraints(k) - DO j = 3*(ia-1)+1, 3*ia + DO j = 3*(ia - 1) + 1, 3*ia pint_env%tv_new(:, 1, j) = 0.0_dp pint_env%tf(:, 1, j) = 0.0_dp END DO @@ -2197,17 +2197,17 @@ SUBROUTINE pint_step(pint_env, helium_env) END IF pint_env%tv_new(pint_env%nnos, ib, idim) = & - pint_env%tv_t(pint_env%nnos, ib, idim)+ & + pint_env%tv_t(pint_env%nnos, ib, idim) + & dti2*pint_env%tf(pint_env%nnos, ib, idim) tol = MAX(tol, ABS(pint_env%tv(pint_env%nnos, ib, idim) & - -pint_env%tv_new(pint_env%nnos, ib, idim))) + - pint_env%tv_new(pint_env%nnos, ib, idim))) tol = MAX(tol, ABS(pint_env%uv(ib, idim) & - -pint_env%uv_new(ib, idim))) + - pint_env%uv_new(ib, idim))) !Set thermostat action of constrained DoF to zero: IF (pint_env%simpar%constraint) THEN DO k = 1, pint_env%n_atoms_constraints ia = pint_env%atoms_constraints(k) - DO j = 3*(ia-1)+1, 3*ia + DO j = 3*(ia - 1) + 1, 3*ia pint_env%tv_new(:, 1, j) = 0.0_dp END DO END DO @@ -2227,8 +2227,8 @@ SUBROUTINE pint_step(pint_env, helium_env) ! Reset particle r, due to force calc: DO i = 1, nparticle DO j = 1, 3 - vel(j, i) = pint_env%uv(1, j+(i-1)*3) - particle_set(i)%r(j) = pint_env%ux(1, j+(i-1)*3) + vel(j, i) = pint_env%uv(1, j + (i - 1)*3) + particle_set(i)%r(j) = pint_env%ux(1, j + (i - 1)*3) END DO END DO @@ -2255,14 +2255,14 @@ SUBROUTINE pint_step(pint_env, helium_env) DO i = 1, nparticle DO j = 1, 3 - pint_env%uv(1, j+(i-1)*3) = vel(j, i) + pint_env%uv(1, j + (i - 1)*3) = vel(j, i) END DO END DO END IF - DO inos = 1, pint_env%nnos-1 + DO inos = 1, pint_env%nnos - 1 pint_env%tf(inos, :, :) = pint_env%tf(inos, :, :) & - -pint_env%tv(inos, :, :)*pint_env%tv(inos+1, :, :) + - pint_env%tv(inos, :, :)*pint_env%tv(inos + 1, :, :) END DO CASE (thermostat_gle) @@ -2310,14 +2310,14 @@ SUBROUTINE pint_step(pint_env, helium_env) END SELECT ! 2. 1/2*Physical integration - pint_env%uv_t = pint_env%uv_t+dti2*pint_env%uf + pint_env%uv_t = pint_env%uv_t + dti2*pint_env%uf ! 3. Exact harmonic integration IF (pint_env%first_propagated_mode == 1) THEN ! The centroid is integrated via standard velocity-verlet ! Commented out code is only there to show similarities to ! Numeric integrator - pint_env%ux_t(1, :) = pint_env%ux(1, :)+ & + pint_env%ux_t(1, :) = pint_env%ux(1, :) + & dti*pint_env%uv_t(1, :) !+ & ! dti22*pint_env%uf_h(1, :) !pint_env%uv_t(1, :) = pint_env%uv_t(1, :)+ & @@ -2329,8 +2329,8 @@ SUBROUTINE pint_step(pint_env, helium_env) ! Transform positions and velocities to Cartesian coordinates: DO i = 1, nparticle DO j = 1, 3 - pos(j, i) = pint_env%ux_t(1, j+(i-1)*3)/factor - vel(j, i) = pint_env%uv_t(1, j+(i-1)*3)/factor + pos(j, i) = pint_env%ux_t(1, j + (i - 1)*3)/factor + vel(j, i) = pint_env%uv_t(1, j + (i - 1)*3)/factor END DO END DO @@ -2356,8 +2356,8 @@ SUBROUTINE pint_step(pint_env, helium_env) ! Transform back to normal modes: DO i = 1, nparticle DO j = 1, 3 - pint_env%ux_t(1, j+(i-1)*3) = pos(j, i)*factor - pint_env%uv_t(1, j+(i-1)*3) = vel(j, i)*factor + pint_env%ux_t(1, j + (i - 1)*3) = pos(j, i)*factor + pint_env%uv_t(1, j + (i - 1)*3) = vel(j, i)*factor END DO END DO @@ -2371,9 +2371,9 @@ SUBROUTINE pint_step(pint_env, helium_env) DO i = 2, pint_env%p pint_env%ux_t(i, :) = pint_env%cosex(i)*pint_env%ux(i, :) & - +pint_env%iwsinex(i)*pint_env%uv_t(i, :) + + pint_env%iwsinex(i)*pint_env%uv_t(i, :) pint_env%uv_t(i, :) = pint_env%cosex(i)*pint_env%uv_t(i, :) & - -pint_env%wsinex(i)*pint_env%ux(i, :) + - pint_env%wsinex(i)*pint_env%ux(i, :) END DO pint_env%ux = pint_env%ux_t @@ -2387,7 +2387,7 @@ SUBROUTINE pint_step(pint_env, helium_env) CALL helium_step(helium_env, pint_env) !Update force of solute in pint_env IF (pint_env%logger%para_env%ionode) THEN - pint_env%f(:, :) = pint_env%f(:, :)+helium_env(1)%helium%force_avrg(:, :) + pint_env%f(:, :) = pint_env%f(:, :) + helium_env(1)%helium%force_avrg(:, :) END IF CALL mp_bcast(pint_env%f, & pint_env%logger%para_env%source, & @@ -2398,7 +2398,7 @@ SUBROUTINE pint_step(pint_env, helium_env) IF (pint_env%first_propagated_mode .EQ. 2) THEN pint_env%uf(1, :) = 0.0_dp END IF - pint_env%uv_t = pint_env%uv_t+dti2*pint_env%uf + pint_env%uv_t = pint_env%uv_t + dti2*pint_env%uf ! 5. Apply thermostats SELECT CASE (pint_env%pimd_thermostat) @@ -2434,8 +2434,8 @@ SUBROUTINE pint_step(pint_env, helium_env) ! Reset particle r, due to force calc: DO i = 1, nparticle DO j = 1, 3 - vel(j, i) = pint_env%uv(1, j+(i-1)*3)/factor - particle_set(i)%r(j) = pint_env%ux(1, j+(i-1)*3)/factor + vel(j, i) = pint_env%uv(1, j + (i - 1)*3)/factor + particle_set(i)%r(j) = pint_env%ux(1, j + (i - 1)*3)/factor END DO END DO CALL rattle_control(gci, local_molecules, & @@ -2457,7 +2457,7 @@ SUBROUTINE pint_step(pint_env, helium_env) ! Multiply with SQRT(n_beads) due to normal mode transformation DO i = 1, nparticle DO j = 1, 3 - pint_env%uv(1, j+(i-1)*3) = vel(j, i)*factor + pint_env%uv(1, j + (i - 1)*3) = vel(j, i)*factor END DO END DO @@ -2484,7 +2484,7 @@ SUBROUTINE pint_step(pint_env, helium_env) ! CALL f_env_rm_defaults(f_env,new_error,ierr) time_stop = m_walltime() - pint_env%time_per_step = time_stop-time_start + pint_env%time_per_step = time_stop - time_start CALL pint_write_step_info(pint_env) CALL timestop(handle) @@ -2526,18 +2526,18 @@ SUBROUTINE pint_calc_energy(pint_env) END SELECT pint_env%energy(e_kin_thermo_id) = & - (0.5_dp*REAL(pint_env%p, dp)*REAL(pint_env%ndim, dp)*pint_env%kT- & + (0.5_dp*REAL(pint_env%p, dp)*REAL(pint_env%ndim, dp)*pint_env%kT - & pint_env%e_pot_h)*pint_env%propagator%temp_sim2phys pint_env%energy(e_potential_id) = SUM(pint_env%e_pot_bead) pint_env%energy(e_conserved_id) = & - pint_env%energy(e_potential_id)*pint_env%propagator%physpotscale+ & - pint_env%e_pot_h+ & - pint_env%e_kin_beads+ & - pint_env%e_pot_t+ & - pint_env%e_kin_t+ & - pint_env%e_gle+pint_env%e_pile+pint_env%e_piglet+pint_env%e_qtb + pint_env%energy(e_potential_id)*pint_env%propagator%physpotscale + & + pint_env%e_pot_h + & + pint_env%e_kin_beads + & + pint_env%e_pot_t + & + pint_env%e_kin_t + & + pint_env%e_gle + pint_env%e_pile + pint_env%e_piglet + pint_env%e_qtb pint_env%energy(e_potential_id) = & pint_env%energy(e_potential_id)/REAL(pint_env%p, dp) @@ -2660,7 +2660,7 @@ SUBROUTINE pint_calc_e_kin_beads_u(pint_env, uv, e_k) res = 0._dp DO idim = 1, pint_env%ndim DO ib = 1, pint_env%p - res = res+pint_env%mass_fict(ib, idim)*my_uv(ib, idim)**2 + res = res + pint_env%mass_fict(ib, idim)*my_uv(ib, idim)**2 END DO END DO res = res*0.5 @@ -2695,15 +2695,15 @@ SUBROUTINE pint_calc_e_vir(pint_env, e_vir) ! calculate the centroid xcentroid = 0._dp DO ib = 1, pint_env%p - xcentroid = xcentroid+pint_env%x(ib, idim) + xcentroid = xcentroid + pint_env%x(ib, idim) END DO xcentroid = xcentroid/REAL(pint_env%p, dp) DO ib = 1, pint_env%p - res = res+(pint_env%x(ib, idim)-xcentroid)*pint_env%f(ib, idim) + res = res + (pint_env%x(ib, idim) - xcentroid)*pint_env%f(ib, idim) END DO END DO res = 0.5_dp*(REAL(pint_env%ndim, dp)* & - (pint_env%kT*pint_env%propagator%temp_sim2phys)-res/REAL(pint_env%p, dp)) + (pint_env%kT*pint_env%propagator%temp_sim2phys) - res/REAL(pint_env%p, dp)) pint_env%energy(e_kin_virial_id) = res IF (PRESENT(e_vir)) e_vir = res RETURN @@ -2730,7 +2730,7 @@ SUBROUTINE pint_calc_nh_energy(pint_env) DO idim = 1, pint_env%ndim DO ib = 1, pint_env%p DO inos = 1, pint_env%nnos - ekin = ekin+pint_env%Q(ib)*pint_env%tv(inos, ib, idim)**2 + ekin = ekin + pint_env%Q(ib)*pint_env%tv(inos, ib, idim)**2 END DO END DO END DO @@ -2739,7 +2739,7 @@ SUBROUTINE pint_calc_nh_energy(pint_env) DO idim = 1, pint_env%ndim DO ib = 1, pint_env%p DO inos = 1, pint_env%nnos - epot = epot+pint_env%tx(inos, ib, idim) + epot = epot + pint_env%tx(inos, ib, idim) END DO END DO END DO @@ -2772,21 +2772,21 @@ FUNCTION pint_calc_total_link_action(pint_env) RESULT(link_action) link_action = 0.0_dp DO iatom = 1, pint_env%ndim/3 ! hbar / (2.0*m) - hb2m = 1.0_dp/pint_env%mass((iatom-1)*3+1) + hb2m = 1.0_dp/pint_env%mass((iatom - 1)*3 + 1) tmp_link_action = 0.0_dp - DO ibead = 1, pint_env%p-1 + DO ibead = 1, pint_env%p - 1 DO idim = 1, 3 - indx = (iatom-1)*3+idim - r(idim) = pint_env%x(ibead, indx)-pint_env%x(ibead+1, indx) + indx = (iatom - 1)*3 + idim + r(idim) = pint_env%x(ibead, indx) - pint_env%x(ibead + 1, indx) END DO - tmp_link_action = tmp_link_action+(r(1)*r(1)+r(2)*r(2)+r(3)*r(3)) + tmp_link_action = tmp_link_action + (r(1)*r(1) + r(2)*r(2) + r(3)*r(3)) END DO DO idim = 1, 3 - indx = (iatom-1)*3+idim - r(idim) = pint_env%x(pint_env%p, indx)-pint_env%x(1, indx) + indx = (iatom - 1)*3 + idim + r(idim) = pint_env%x(pint_env%p, indx) - pint_env%x(1, indx) END DO - tmp_link_action = tmp_link_action+(r(1)*r(1)+r(2)*r(2)+r(3)*r(3)) - link_action = link_action+tmp_link_action/hb2m + tmp_link_action = tmp_link_action + (r(1)*r(1) + r(2)*r(2) + r(3)*r(3)) + link_action = link_action + tmp_link_action/hb2m END DO link_action = link_action/(2.0_dp*tau) diff --git a/src/motion/pint_normalmode.F b/src/motion/pint_normalmode.F index 34c652d1b9..30d74cc482 100644 --- a/src/motion/pint_normalmode.F +++ b/src/motion/pint_normalmode.F @@ -69,7 +69,7 @@ SUBROUTINE normalmode_env_create(normalmode_env, normalmode_section, p, kT, prop ALLOCATE (normalmode_env%x2u(p, p)) ALLOCATE (normalmode_env%u2x(p, p)) ALLOCATE (normalmode_env%lambda(p)) - last_normalmode_id = last_normalmode_id+1 + last_normalmode_id = last_normalmode_id + 1 normalmode_env%id_nr = last_normalmode_id normalmode_env%ref_count = 1 @@ -95,12 +95,12 @@ SUBROUTINE normalmode_env_create(normalmode_env, normalmode_section, p, kT, prop ! set up the transformation matrices DO i = 1, p - normalmode_env%lambda(i) = 2.0_dp*(1.0_dp-COS(pi*(i/2)*2.0_dp/p)) + normalmode_env%lambda(i) = 2.0_dp*(1.0_dp - COS(pi*(i/2)*2.0_dp/p)) DO j = 1, p - k = ((i/2)*(j-1))/p - k = (i/2)*(j-1)-k*p - li = 2*(i-2*(i/2))*p-p - normalmode_env%u2x(j, i) = SQRT(2.0_dp/p)*SIN(twopi*(k+0.125_dp*li)/p) + k = ((i/2)*(j - 1))/p + k = (i/2)*(j - 1) - k*p + li = 2*(i - 2*(i/2))*p - p + normalmode_env%u2x(j, i) = SQRT(2.0_dp/p)*SIN(twopi*(k + 0.125_dp*li)/p) END DO END DO normalmode_env%lambda(1) = 1.0_dp/(p*normalmode_env%modefactor) @@ -128,17 +128,17 @@ SUBROUTINE normalmode_env_create(normalmode_env, normalmode_section, p, kT, prop normalmode_env%x2u(:, :) = 0.0_dp normalmode_env%x2u(1, :) = invsqrtp DO j = 1, p - DO i = 2, p/2+1 - normalmode_env%x2u(i, j) = sqrt2p*COS(twopip*(i-1)*(j-1)) + DO i = 2, p/2 + 1 + normalmode_env%x2u(i, j) = sqrt2p*COS(twopip*(i - 1)*(j - 1)) END DO - DO i = p/2+2, p - normalmode_env%x2u(i, j) = sqrt2p*SIN(twopip*(i-1)*(j-1)) + DO i = p/2 + 2, p + normalmode_env%x2u(i, j) = sqrt2p*SIN(twopip*(i - 1)*(j - 1)) END DO END DO IF (MOD(p, 2) == 0) THEN - DO i = 1, p-1, 2 - normalmode_env%x2u(p/2+1, i) = invsqrtp - normalmode_env%x2u(p/2+1, i+1) = -1.0_dp*invsqrtp + DO i = 1, p - 1, 2 + normalmode_env%x2u(p/2 + 1, i) = invsqrtp + normalmode_env%x2u(p/2 + 1, i + 1) = -1.0_dp*invsqrtp END DO END IF @@ -147,7 +147,7 @@ SUBROUTINE normalmode_env_create(normalmode_env, normalmode_section, p, kT, prop ! Setting up propagator frequencies for rpmd normalmode_env%lambda(1) = 0.0_dp DO i = 2, p - normalmode_env%lambda(i) = 2.0_dp*normalmode_env%harm*SIN((i-1)*pip) + normalmode_env%lambda(i) = 2.0_dp*normalmode_env%harm*SIN((i - 1)*pip) normalmode_env%lambda(i) = normalmode_env%lambda(i)*normalmode_env%lambda(i) END DO normalmode_env%harm = kT*kT @@ -172,7 +172,7 @@ SUBROUTINE normalmode_release(normalmode_env) IF (ASSOCIATED(normalmode_env)) THEN CPASSERT(normalmode_env%ref_count > 0) - normalmode_env%ref_count = normalmode_env%ref_count-1 + normalmode_env%ref_count = normalmode_env%ref_count - 1 IF (normalmode_env%ref_count == 0) THEN DEALLOCATE (normalmode_env%x2u) DEALLOCATE (normalmode_env%u2x) @@ -199,7 +199,7 @@ SUBROUTINE normalmode_retain(normalmode_env) CPASSERT(ASSOCIATED(normalmode_env)) CPASSERT(normalmode_env%ref_count > 0) - normalmode_env%ref_count = normalmode_env%ref_count+1 + normalmode_env%ref_count = normalmode_env%ref_count + 1 RETURN END SUBROUTINE normalmode_retain @@ -353,7 +353,7 @@ SUBROUTINE normalmode_calc_uf_h(normalmode_env, mass_beads, ux, uf_h, e_h) f = -mass_beads(ibead, idim)*normalmode_env%lambda(ibead)*ux(ibead, idim) uf_h(ibead, idim) = f ! - to cancel the - in the force f. - e_h = e_h-0.5_dp*ux(ibead, idim)*f + e_h = e_h - 0.5_dp*ux(ibead, idim)*f END DO END DO diff --git a/src/motion/pint_piglet.F b/src/motion/pint_piglet.F index 35dd8cc54c..bf647a87d2 100644 --- a/src/motion/pint_piglet.F +++ b/src/motion/pint_piglet.F @@ -108,7 +108,7 @@ SUBROUTINE pint_piglet_create(piglet_therm, pint_env, section) CALL section_vals_val_get(section, "NEXTRA_DOF", i_val=piglet_therm%nsp1) !add real degree of freedom to ns to reach nsp1 - piglet_therm%nsp1 = piglet_therm%nsp1+1 + piglet_therm%nsp1 = piglet_therm%nsp1 + 1 p = pint_env%p piglet_therm%p = pint_env%p ndim = pint_env%ndim @@ -222,8 +222,8 @@ SUBROUTINE pint_piglet_init(piglet_therm, pint_env, section, dt, para_env) propagator=pint_env%propagator%prop_kind, & targettemp=pint_env%kT*pint_env%propagator%temp_sim2phys) ELSE IF (INDEX(temp_input, "A MATRIX") /= 0) THEN - obrac = INDEX(temp_input, "(")+1 - cbrac = INDEX(temp_input, ")")-1 + obrac = INDEX(temp_input, "(") + 1 + cbrac = INDEX(temp_input, ")") - 1 read_unit = temp_input(obrac:cbrac) DO imode = 1, p READ (input_unit, default_format) temp_input @@ -231,7 +231,7 @@ SUBROUTINE pint_piglet_init(piglet_therm, pint_env, section, dt, para_env) READ (input_unit, *, iostat=read_err) & (piglet_therm%a_mat(i, j, imode), j=1, piglet_therm%nsp1) IF (read_err /= 0) THEN - WRITE (UNIT=msg, FMT=*) "Invalid PIGLET A-matrix Nr.", i-1 + WRITE (UNIT=msg, FMT=*) "Invalid PIGLET A-matrix Nr.", i - 1 CPABORT(msg) EXIT END IF @@ -243,8 +243,8 @@ SUBROUTINE pint_piglet_init(piglet_therm, pint_env, section, dt, para_env) piglet_therm%nsp1, read_unit, msg) END IF ELSE IF (INDEX(temp_input, "C MATRIX") /= 0) THEN - obrac = INDEX(temp_input, "(")+1 - cbrac = INDEX(temp_input, ")")-1 + obrac = INDEX(temp_input, "(") + 1 + cbrac = INDEX(temp_input, ")") - 1 read_unit = temp_input(obrac:cbrac) DO imode = 1, p READ (input_unit, default_format) temp_input @@ -252,7 +252,7 @@ SUBROUTINE pint_piglet_init(piglet_therm, pint_env, section, dt, para_env) READ (input_unit, *, iostat=read_err) & (piglet_therm%c_mat(i, j, imode), j=1, piglet_therm%nsp1) IF (read_err /= 0) THEN - WRITE (UNIT=msg, FMT=*) "Invalid PIGLET C-matrix Nr.", i-1 + WRITE (UNIT=msg, FMT=*) "Invalid PIGLET C-matrix Nr.", i - 1 CPABORT(msg) EXIT END IF @@ -334,7 +334,7 @@ SUBROUTINE pint_piglet_init(piglet_therm, pint_env, section, dt, para_env) Mtmp, & ! result matrix: Mtmp piglet_therm%nsp1) ! leading dimension of Mtmp ! C - T*C*TRANSPOSE(T): - Mtmp(:, :) = piglet_therm%c_mat(:, :, i)-Mtmp(:, :) + Mtmp(:, :) = piglet_therm%c_mat(:, :, i) - Mtmp(:, :) IF (matrix_init == matrix_init_cholesky) THEN ! Get S by cholesky decomposition of Mtmp @@ -367,7 +367,7 @@ SUBROUTINE pint_piglet_init(piglet_therm, pint_env, section, dt, para_env) DO isp = 2, piglet_therm%nsp1 DO ibead = 1, piglet_therm%p*piglet_therm%ndim piglet_therm%smalls(isp, ibead) = smallstmp(i) - i = i+1 + i = i + 1 END DO END DO ELSE @@ -404,7 +404,7 @@ SUBROUTINE pint_piglet_init(piglet_therm, pint_env, section, dt, para_env) piglet_therm%nsp1) ! leading dimension of result matrix DO idim = 1, piglet_therm%ndim - j = (idim-1)*piglet_therm%p+ibead + j = (idim - 1)*piglet_therm%p + ibead DO i = 1, piglet_therm%nsp1 piglet_therm%smalls(i, j) = piglet_therm%temp1(i, idim) END DO @@ -462,7 +462,7 @@ SUBROUTINE pint_piglet_step(vold, vnew, first_mode, masses, piglet_therm) ! copy the extra degrees of freedom to the temp1 matrix DO idim = 1, ndim DO i = 2, nsp1 - piglet_therm%temp1(i, idim) = piglet_therm%smalls(i, (ibead-1)*ndim+idim) + piglet_therm%temp1(i, idim) = piglet_therm%smalls(i, (ibead - 1)*ndim + idim) END DO END DO @@ -474,7 +474,7 @@ SUBROUTINE pint_piglet_step(vold, vnew, first_mode, masses, piglet_therm) END DO END DO - i = (ibead-1)*piglet_therm%ndim+1 + i = (ibead - 1)*piglet_therm%ndim + 1 !smalls(:,i) = 1*S*temp2 + 0 * smalls CALL DGEMM("N", & ! S-matrix should not be transposed "N", & ! tmp2 matrix shoud not be transposed @@ -511,15 +511,15 @@ SUBROUTINE pint_piglet_step(vold, vnew, first_mode, masses, piglet_therm) delta_ekin = 0.0_dp DO idim = 1, ndim DO ibead = 1, p - vnew(ibead, idim) = piglet_therm%smalls(1, (ibead-1)*ndim+idim)/piglet_therm%sqrtmass(ibead, idim) - delta_ekin = delta_ekin+masses(ibead, idim)*( & - vnew(ibead, idim)*vnew(ibead, idim)- & + vnew(ibead, idim) = piglet_therm%smalls(1, (ibead - 1)*ndim + idim)/piglet_therm%sqrtmass(ibead, idim) + delta_ekin = delta_ekin + masses(ibead, idim)*( & + vnew(ibead, idim)*vnew(ibead, idim) - & vold(ibead, idim)*vold(ibead, idim)) END DO END DO ! the piglet is such a strong thermostat, that it messes up the "exact" integration. The thermostats energy will rise lineary, because "it will suck up its own mess" (quote from Michele Ceriotti) - piglet_therm%thermostat_energy = piglet_therm%thermostat_energy-0.5_dp*delta_ekin + piglet_therm%thermostat_energy = piglet_therm%thermostat_energy - 0.5_dp*delta_ekin CALL timestop(handle) @@ -544,7 +544,7 @@ SUBROUTINE pint_piglet_release(piglet_therm) routineP = moduleN//':'//routineN IF (ASSOCIATED(piglet_therm)) THEN - piglet_therm%ref_count = piglet_therm%ref_count-1 + piglet_therm%ref_count = piglet_therm%ref_count - 1 IF (piglet_therm%ref_count == 0) THEN DEALLOCATE (piglet_therm%a_mat) DEALLOCATE (piglet_therm%c_mat) @@ -588,7 +588,7 @@ SUBROUTINE a_mat_to_cp2k(a_mat, p, nsp1, myunit, msg) INTEGER :: i, imode, j msg = "" - SELECT CASE (TRIM (myunit)) + SELECT CASE (TRIM(myunit)) CASE ("femtoseconds^-1") isunit = "fs^-1" CASE ("picoseconds^-1") @@ -636,7 +636,7 @@ SUBROUTINE c_mat_to_cp2k(c_mat, p, nsp1, myunit, msg) INTEGER :: i, imode, j msg = "" - SELECT CASE (TRIM (myunit)) + SELECT CASE (TRIM(myunit)) CASE ("eV") isunit = "eV" CASE ("K") @@ -682,28 +682,28 @@ SUBROUTINE check_temperature(line, propagator, targettemp) REAL(KIND=dp) :: convttemp, deviation, matrixtemp, ttemp deviation = 100.0d0 - posnumber = INDEX(line, "T=")+2 + posnumber = INDEX(line, "T=") + 2 IF (propagator == propagator_rpmd) ttemp = targettemp !Get the matrix temperature READ (line(posnumber:), *) matrixtemp msg = "" IF (INDEX(line, "K") /= 0) THEN convttemp = cp_unit_from_cp2k(ttemp, "K") - IF (ABS(convttemp-matrixtemp) > convttemp/deviation) THEN + IF (ABS(convttemp - matrixtemp) > convttemp/deviation) THEN WRITE (UNIT=msg, FMT=*) "PIGLET Simulation temperature (", & convttemp, "K) /= matrix temperature (", matrixtemp, "K)" CPWARN(msg) END IF ELSE IF (INDEX(line, "eV") /= 0) THEN convttemp = cp_unit_from_cp2k(ttemp, "K")/11604.505_dp - IF (ABS(convttemp-matrixtemp) > convttemp/deviation) THEN + IF (ABS(convttemp - matrixtemp) > convttemp/deviation) THEN WRITE (UNIT=msg, FMT=*) "PIGLET Simulation temperature (", & convttemp, "K) /= matrix temperature (", matrixtemp, "K)" CPWARN(msg) END IF ELSE IF (INDEX(line, "atomic energy units") /= 0) THEN convttemp = ttemp - IF (ABS(convttemp-matrixtemp) > convttemp/deviation) THEN + IF (ABS(convttemp - matrixtemp) > convttemp/deviation) THEN WRITE (UNIT=msg, FMT=*) "PIGLET Simulation temperature (", & convttemp, "K) /= matrix temperature (", matrixtemp, "K)" CPWARN(msg) @@ -712,7 +712,7 @@ SUBROUTINE check_temperature(line, propagator, targettemp) WRITE (UNIT=msg, FMT=*) "Unknown PIGLET matrix temperature. Assuming a.u." CPWARN(msg) convttemp = ttemp - IF (ABS(convttemp-matrixtemp) > convttemp/deviation) THEN + IF (ABS(convttemp - matrixtemp) > convttemp/deviation) THEN WRITE (UNIT=msg, FMT=*) "PIGLET Simulation temperature (", & convttemp, "K) /= matrix temperature (", matrixtemp, "K)" CPWARN(msg) @@ -803,7 +803,7 @@ SUBROUTINE sqrt_pos_def_mat(n, SST, S) -1, & ! size of temporary real work array info) ! information about success - lwork = INT(tmplwork+0.5_dp) + lwork = INT(tmplwork + 0.5_dp) ALLOCATE (work(lwork)) work(:) = 0.0_dp diff --git a/src/motion/pint_pile.F b/src/motion/pint_pile.F index 48f908213d..a312863698 100644 --- a/src/motion/pint_pile.F +++ b/src/motion/pint_pile.F @@ -95,7 +95,7 @@ SUBROUTINE pint_pile_init(pile_therm, pint_env, normalmode_env, section) ex = -dti2*pile_therm%g_fric(i) pile_therm%c1(i) = EXP(ex) ex = pile_therm%c1(i)*pile_therm%c1(i) - pile_therm%c2(i) = SQRT(1.0_dp-ex) + pile_therm%c2(i) = SQRT(1.0_dp - ex) END DO DO j = 1, pint_env%ndim DO i = 1, pint_env%p @@ -149,15 +149,15 @@ SUBROUTINE pint_pile_step(vold, vnew, p, ndim, first_mode, masses, pile_therm) delta_ekin = 0.0_dp DO idim = 1, ndim DO ibead = first_mode, p - vnew(ibead, idim) = pile_therm%c1(ibead)*vold(ibead, idim)+ & + vnew(ibead, idim) = pile_therm%c1(ibead)*vold(ibead, idim) + & pile_therm%massfact(ibead, idim)*pile_therm%c2(ibead)* & next_random_number(pile_therm%gaussian_rng_stream) - delta_ekin = delta_ekin+masses(ibead, idim)*( & - vnew(ibead, idim)*vnew(ibead, idim)- & + delta_ekin = delta_ekin + masses(ibead, idim)*( & + vnew(ibead, idim)*vnew(ibead, idim) - & vold(ibead, idim)*vold(ibead, idim)) END DO END DO - pile_therm%thermostat_energy = pile_therm%thermostat_energy-0.5_dp*delta_ekin + pile_therm%thermostat_energy = pile_therm%thermostat_energy - 0.5_dp*delta_ekin CALL timestop(handle) END SUBROUTINE pint_pile_step @@ -179,7 +179,7 @@ SUBROUTINE pint_pile_release(pile_therm) routineP = moduleN//':'//routineN IF (ASSOCIATED(pile_therm)) THEN - pile_therm%ref_count = pile_therm%ref_count-1 + pile_therm%ref_count = pile_therm%ref_count - 1 IF (pile_therm%ref_count == 0) THEN DEALLOCATE (pile_therm%c1) DEALLOCATE (pile_therm%c2) diff --git a/src/motion/pint_public.F b/src/motion/pint_public.F index 07e474d2d0..6dc5147bb8 100644 --- a/src/motion/pint_public.F +++ b/src/motion/pint_public.F @@ -57,9 +57,9 @@ FUNCTION pint_com_pos(pint_env) RESULT(com_r) DO ia = 1, pint_env%ndim/3 DO ib = 1, pint_env%p DO ic = 1, 3 - com_r(ic) = com_r(ic)+ & - pint_env%x(ib, (ia-1)*3+ic)*pint_env%mass((ia-1)*3+ic) - tmass = tmass+pint_env%mass((ia-1)*3+ic) + com_r(ic) = com_r(ic) + & + pint_env%x(ib, (ia - 1)*3 + ic)*pint_env%mass((ia - 1)*3 + ic) + tmass = tmass + pint_env%mass((ia - 1)*3 + ic) END DO END DO END DO @@ -94,7 +94,7 @@ FUNCTION pint_cog_pos(pint_env) RESULT(cntrd_r) DO ia = 1, natoms DO ib = 1, pint_env%p DO ic = 1, 3 - cntrd_r(ic) = cntrd_r(ic)+pint_env%x(ib, (ia-1)*3+ic) + cntrd_r(ic) = cntrd_r(ic) + pint_env%x(ib, (ia - 1)*3 + ic) END DO END DO END DO @@ -143,7 +143,7 @@ SUBROUTINE pint_free_part_bead_x(n, t, rng_gaussian, x, nout) ! if number of beads is not a power of 2 return nlevels = NINT(LOG(REAL(n, KIND=dp))/LOG(2.0_dp)) rtmp = 2**nlevels - tcheck = ABS(REAL(n, KIND=dp)-rtmp) + tcheck = ABS(REAL(n, KIND=dp) - rtmp) IF (tcheck > 100.0_dp*EPSILON(0.0_dp)) THEN RETURN END IF @@ -156,32 +156,32 @@ SUBROUTINE pint_free_part_bead_x(n, t, rng_gaussian, x, nout) ! loop over Levy levels vrnc = 2.0_dp*t - DO il = 0, nlevels-1 + DO il = 0, nlevels - 1 np = 2**il ! number of points to be generated at this level dl = n/(2*np) ! interval betw points (in index numbers) vrnc = vrnc/2.0_dp; ! variance at this level (=t at level 0) ! loop over points added in this level - DO ip = 0, np-1 + DO ip = 0, np - 1 - j = (2*ip+1)*dl ! index of currently generated point + j = (2*ip + 1)*dl ! index of currently generated point ! indices of two points betw which to generate a new point i1 = 2*dl*ip - i2 = 2*dl*(ip+1) + i2 = 2*dl*(ip + 1) IF (i2 .EQ. n) THEN i2 = 0 END IF ! generate new point and save it under j DO ic = 1, 3 - xc = (x(3*i1+ic)+x(3*i2+ic))/2.0 - xc = xc+next_random_number(rng_stream=rng_gaussian, & - variance=vrnc) - x(3*j+ic) = xc + xc = (x(3*i1 + ic) + x(3*i2 + ic))/2.0 + xc = xc + next_random_number(rng_stream=rng_gaussian, & + variance=vrnc) + x(3*j + ic) = xc END DO - nout = nout+1 + nout = nout + 1 END DO END DO @@ -190,13 +190,13 @@ SUBROUTINE pint_free_part_bead_x(n, t, rng_gaussian, x, nout) cntrd_r(:) = 0.0_dp DO ib = 1, n DO ic = 1, 3 - cntrd_r(ic) = cntrd_r(ic)+x((ib-1)*3+ic) + cntrd_r(ic) = cntrd_r(ic) + x((ib - 1)*3 + ic) END DO END DO cntrd_r(:) = cntrd_r(:)/REAL(n, dp) DO ib = 1, n DO ic = 1, 3 - x((ib-1)*3+ic) = x((ib-1)*3+ic)-cntrd_r(ic) + x((ib - 1)*3 + ic) = x((ib - 1)*3 + ic) - cntrd_r(ic) END DO END DO @@ -231,20 +231,20 @@ SUBROUTINE pint_levy_walk(x0, n, v, x, rng_gaussian) x(1) = x0(1) x(2) = x0(2) x(3) = x0(3) - DO ib = 1, n-1 + DO ib = 1, n - 1 DO ic = 1, 3 r = next_random_number(rng_stream=rng_gaussian, & variance=1.0_dp) - tau_i = (REAL(ib, dp)-1.0_dp)/REAL(n, dp) - tau_i1 = (REAL(ib+1, dp)-1.0_dp)/REAL(n, dp) - x(ib*3+ic) = (x((ib-1)*3+ic)*(1.0_dp-tau_i1)+ & - x(ic)*(tau_i1-tau_i))/ & - (1.0_dp-tau_i)+ & - r*v*SQRT( & - (tau_i1-tau_i)* & - (1.0_dp-tau_i1)/ & - (1.0_dp-tau_i) & - ) + tau_i = (REAL(ib, dp) - 1.0_dp)/REAL(n, dp) + tau_i1 = (REAL(ib + 1, dp) - 1.0_dp)/REAL(n, dp) + x(ib*3 + ic) = (x((ib - 1)*3 + ic)*(1.0_dp - tau_i1) + & + x(ic)*(tau_i1 - tau_i))/ & + (1.0_dp - tau_i) + & + r*v*SQRT( & + (tau_i1 - tau_i)* & + (1.0_dp - tau_i1)/ & + (1.0_dp - tau_i) & + ) END DO END DO @@ -252,13 +252,13 @@ SUBROUTINE pint_levy_walk(x0, n, v, x, rng_gaussian) cntrd_r(:) = 0.0_dp DO ib = 1, n DO ic = 1, 3 - cntrd_r(ic) = cntrd_r(ic)+x((ib-1)*3+ic) + cntrd_r(ic) = cntrd_r(ic) + x((ib - 1)*3 + ic) END DO END DO cntrd_r(:) = cntrd_r(:)/REAL(n, dp) DO ib = 1, n DO ic = 1, 3 - x((ib-1)*3+ic) = x((ib-1)*3+ic)-cntrd_r(ic) + x((ib - 1)*3 + ic) = x((ib - 1)*3 + ic) - cntrd_r(ic) END DO END DO @@ -289,7 +289,7 @@ SUBROUTINE pint_calc_centroid(pint_env) pint_env%centroid(:) = 0.0_dp DO ia = 1, pint_env%ndim DO ib = 1, pint_env%p - pint_env%centroid(ia) = pint_env%centroid(ia)+pint_env%x(ib, ia) + pint_env%centroid(ia) = pint_env%centroid(ia) + pint_env%x(ib, ia) END DO pint_env%centroid(ia) = pint_env%centroid(ia)*invp END DO diff --git a/src/motion/pint_qtb.F b/src/motion/pint_qtb.F index d73a76b0d4..dee035468d 100644 --- a/src/motion/pint_qtb.F +++ b/src/motion/pint_qtb.F @@ -111,14 +111,14 @@ SUBROUTINE pint_qtb_init(qtb_therm, pint_env, normalmode_env, section) !Initialize everything qtb_therm%g_fric(1) = 1.0_dp/qtb_therm%tau DO i = 2, p - qtb_therm%g_fric(i) = SQRT((1.d0/qtb_therm%tau)**2+(qtb_therm%lamb)**2* & + qtb_therm%g_fric(i) = SQRT((1.d0/qtb_therm%tau)**2 + (qtb_therm%lamb)**2* & normalmode_env%lambda(i)) END DO DO i = 1, p ex = -dti2*qtb_therm%g_fric(i) qtb_therm%c1(i) = EXP(ex) ex = qtb_therm%c1(i)*qtb_therm%c1(i) - qtb_therm%c2(i) = SQRT(1.0_dp-ex) + qtb_therm%c2(i) = SQRT(1.0_dp - ex) END DO DO j = 1, pint_env%ndim DO i = 1, pint_env%p @@ -175,27 +175,27 @@ SUBROUTINE pint_qtb_step(vold, vnew, p, ndim, masses, qtb_therm) !update random forces DO ibead = 1, p - qtb_therm%cpt(ibead) = qtb_therm%cpt(ibead)+1 + qtb_therm%cpt(ibead) = qtb_therm%cpt(ibead) + 1 !new random forces at every qtb_therm%step IF (qtb_therm%cpt(ibead) == 2*qtb_therm%step(ibead)) THEN IF (ibead == 1) THEN !update the rng status - DO i = 1, qtb_therm%nf-1 - qtb_therm%rng_status(i) = qtb_therm%rng_status(i+1) + DO i = 1, qtb_therm%nf - 1 + qtb_therm%rng_status(i) = qtb_therm%rng_status(i + 1) END DO CALL dump_rng_stream(rng_stream=qtb_therm%gaussian_rng_stream, & rng_record=qtb_therm%rng_status(qtb_therm%nf)) END IF DO idim = 1, ndim !update random numbers - DO i = 1, qtb_therm%nf-1 - qtb_therm%r(i, ibead, idim) = qtb_therm%r(i+1, ibead, idim) + DO i = 1, qtb_therm%nf - 1 + qtb_therm%r(i, ibead, idim) = qtb_therm%r(i + 1, ibead, idim) END DO qtb_therm%r(qtb_therm%nf, ibead, idim) = next_random_number(qtb_therm%gaussian_rng_stream) !compute new random force through the convolution product qtb_therm%rf(ibead, idim) = 0.0_dp DO i = 1, qtb_therm%nf - qtb_therm%rf(ibead, idim) = qtb_therm%rf(ibead, idim)+ & + qtb_therm%rf(ibead, idim) = qtb_therm%rf(ibead, idim) + & qtb_therm%h(i, ibead)*qtb_therm%r(i, ibead, idim) END DO END DO @@ -206,16 +206,16 @@ SUBROUTINE pint_qtb_step(vold, vnew, p, ndim, masses, qtb_therm) !perform MD step DO idim = 1, ndim DO ibead = 1, p - vnew(ibead, idim) = qtb_therm%c1(ibead)*vold(ibead, idim)+ & + vnew(ibead, idim) = qtb_therm%c1(ibead)*vold(ibead, idim) + & qtb_therm%massfact(ibead, idim)*qtb_therm%c2(ibead)* & qtb_therm%rf(ibead, idim) - delta_ekin = delta_ekin+masses(ibead, idim)*( & - vnew(ibead, idim)*vnew(ibead, idim)- & + delta_ekin = delta_ekin + masses(ibead, idim)*( & + vnew(ibead, idim)*vnew(ibead, idim) - & vold(ibead, idim)*vold(ibead, idim)) END DO END DO - qtb_therm%thermostat_energy = qtb_therm%thermostat_energy-0.5_dp*delta_ekin + qtb_therm%thermostat_energy = qtb_therm%thermostat_energy - 0.5_dp*delta_ekin CALL timestop(handle) END SUBROUTINE pint_qtb_step @@ -236,7 +236,7 @@ SUBROUTINE pint_qtb_release(qtb_therm) routineP = moduleN//':'//routineN IF (ASSOCIATED(qtb_therm)) THEN - qtb_therm%ref_count = qtb_therm%ref_count-1 + qtb_therm%ref_count = qtb_therm%ref_count - 1 IF (qtb_therm%ref_count == 0) THEN DEALLOCATE (qtb_therm%c1) DEALLOCATE (qtb_therm%c2) @@ -318,7 +318,7 @@ SUBROUTINE pint_qtb_forces_init(pint_env, normalmode_env, qtb_therm, restart) p = pint_env%p ndim = pint_env%ndim dt = pint_env%dt - IF (MOD(qtb_therm%nf, 2) /= 0) qtb_therm%nf = qtb_therm%nf+1 + IF (MOD(qtb_therm%nf, 2) /= 0) qtb_therm%nf = qtb_therm%nf + 1 nf = qtb_therm%nf para_env => pint_env%logger%para_env @@ -338,7 +338,7 @@ SUBROUTINE pint_qtb_forces_init(pint_env, normalmode_env, qtb_therm, restart) kT = pint_env%kT*pint_env%propagator%temp_sim2phys ALLOCATE (fp(nf/2)) - ALLOCATE (filter(0:nf-1)) + ALLOCATE (filter(0:nf - 1)) IF (print_level == debug_print_level) THEN !create log file if print_level is debug @@ -354,7 +354,7 @@ SUBROUTINE pint_qtb_forces_init(pint_env, normalmode_env, qtb_therm, restart) DO ibead = 1, p !fcut is adapted to the NM freq. !Note that lambda is the angular free ring freq. squared - fcut = SQRT((1.d0/qtb_therm%taucut)**2+(qtb_therm%lambcut)**2* & + fcut = SQRT((1.d0/qtb_therm%taucut)**2 + (qtb_therm%lambcut)**2* & normalmode_env%lambda(ibead)) fcut = fcut/twopi !new random forces are drawn every step @@ -397,7 +397,7 @@ SUBROUTINE pint_qtb_forces_init(pint_env, normalmode_env, qtb_therm, restart) tmp = 0.5_dp*w*h correct = SIN(tmp)/tmp filter(i) = SQRT(fp(i))/correct*(1.0_dp, 0.0_dp) - filter(nf-i) = CONJG(filter(i)) + filter(nf - i) = CONJG(filter(i)) END DO !compute the filter in time space - FFT @@ -407,14 +407,14 @@ SUBROUTINE pint_qtb_forces_init(pint_env, normalmode_env, qtb_therm, restart) !take into account the effective timestep h = step*dt and !1/sqrt(2.0_dp) is to take into account the fact that the !same random force is used for the two thermostat "half-steps" - DO i = 0, nf/2-1 + DO i = 0, nf/2 - 1 tmp1 = filter(i)/(nf*SQRT(2.0_dp*step)) - filter(i) = filter(nf/2+i)/(nf*SQRT(2.0_dp*step)) - filter(nf/2+i) = tmp1 + filter(i) = filter(nf/2 + i)/(nf*SQRT(2.0_dp*step)) + filter(nf/2 + i) = tmp1 END DO - DO i = 0, nf-1 - qtb_therm%h(i+1, ibead) = REAL(filter(i), dp) + DO i = 0, nf - 1 + qtb_therm%h(i + 1, ibead) = REAL(filter(i), dp) END DO END DO @@ -454,7 +454,7 @@ SUBROUTINE pint_qtb_forces_init(pint_env, normalmode_env, qtb_therm, restart) DO ibead = 1, p qtb_therm%rf(ibead, idim) = 0.0_dp DO i = 1, nf - qtb_therm%rf(ibead, idim) = qtb_therm%rf(ibead, idim)+ & + qtb_therm%rf(ibead, idim) = qtb_therm%rf(ibead, idim) + & qtb_therm%h(i, ibead)*qtb_therm%r(i, ibead, idim) END DO END DO @@ -479,8 +479,8 @@ SUBROUTINE pint_qtb_restart(pint_env, qtb_therm) INTEGER :: begin, i, ibead, idim, istep - begin = pint_env%first_step-MOD(pint_env%first_step, qtb_therm%step(1))- & - (qtb_therm%nf-1)*qtb_therm%step(1) + begin = pint_env%first_step - MOD(pint_env%first_step, qtb_therm%step(1)) - & + (qtb_therm%nf - 1)*qtb_therm%step(1) IF (begin <= 0) THEN qtb_therm%cpt = 0 @@ -499,32 +499,32 @@ SUBROUTINE pint_qtb_restart(pint_env, qtb_therm) END DO begin = 1 ELSE - qtb_therm%cpt(1) = 2*(qtb_therm%step(1)-1) + qtb_therm%cpt(1) = 2*(qtb_therm%step(1) - 1) DO ibead = 2, pint_env%p - qtb_therm%cpt(ibead) = 2*MOD(begin-1, qtb_therm%step(ibead)) + qtb_therm%cpt(ibead) = 2*MOD(begin - 1, qtb_therm%step(ibead)) END DO END IF !from istep = 1,2*(the last previous MD step - begin) because !the thermostat step is called two times per MD step !DO istep = 2*begin, 2*pint_env%first_step - DO istep = 1, 2*(pint_env%first_step-begin+1) + DO istep = 1, 2*(pint_env%first_step - begin + 1) DO ibead = 1, pint_env%p - qtb_therm%cpt(ibead) = qtb_therm%cpt(ibead)+1 + qtb_therm%cpt(ibead) = qtb_therm%cpt(ibead) + 1 !new random forces at every qtb_therm%step IF (qtb_therm%cpt(ibead) == 2*qtb_therm%step(ibead)) THEN IF (ibead == 1) THEN !update the rng status - DO i = 1, qtb_therm%nf-1 - qtb_therm%rng_status(i) = qtb_therm%rng_status(i+1) + DO i = 1, qtb_therm%nf - 1 + qtb_therm%rng_status(i) = qtb_therm%rng_status(i + 1) END DO CALL dump_rng_stream(rng_stream=qtb_therm%gaussian_rng_stream, & rng_record=qtb_therm%rng_status(qtb_therm%nf)) END IF DO idim = 1, pint_env%ndim !update random numbers - DO i = 1, qtb_therm%nf-1 - qtb_therm%r(i, ibead, idim) = qtb_therm%r(i+1, ibead, idim) + DO i = 1, qtb_therm%nf - 1 + qtb_therm%r(i, ibead, idim) = qtb_therm%r(i + 1, ibead, idim) END DO qtb_therm%r(qtb_therm%nf, ibead, idim) = next_random_number(qtb_therm%gaussian_rng_stream) END DO @@ -585,7 +585,7 @@ SUBROUTINE pint_qtb_computefp0(pint_env, fp, fp1, dw, aa, bb, log_unit, ibead, p DO j = 1, n w = j*dw tmp = hbokT*w - fp(j) = tmp*(0.5_dp+1.0_dp/(EXP(tmp)-1.0_dp)) + fp(j) = tmp*(0.5_dp + 1.0_dp/(EXP(tmp) - 1.0_dp)) END DO IF (print_level == debug_print_level) THEN @@ -603,8 +603,8 @@ SUBROUTINE pint_qtb_computefp0(pint_env, fp, fp1, dw, aa, bb, log_unit, ibead, p xmin = 1.0e-7_dp !these values allows for an acceptable dx = 0.05_dp !ratio between accuracy, computing time and xmax = 10000.0_dp !memory requirement - tested for P up to 1024 - nx = INT((xmax-xmin)/dx)+1 - nx = nx+nx/5 !add 20% points to avoid any problems at the end + nx = INT((xmax - xmin)/dx) + 1 + nx = nx + nx/5 !add 20% points to avoid any problems at the end !of the interval (probably unnecessary) IF (ibead == 1) THEN op = 1.0_dp/p @@ -625,25 +625,25 @@ SUBROUTINE pint_qtb_computefp0(pint_env, fp, fp1, dw, aa, bb, log_unit, ibead, p ALLOCATE (x2(nx)) ALLOCATE (h(nx)) ALLOCATE (fp1(nx)) - ALLOCATE (xk(p-1, nx)) - ALLOCATE (xk2(p-1, nx)) - ALLOCATE (kk(p-1, nx)) - ALLOCATE (fpxk(p-1, nx)) + ALLOCATE (xk(p - 1, nx)) + ALLOCATE (xk2(p - 1, nx)) + ALLOCATE (kk(p - 1, nx)) + ALLOCATE (fpxk(p - 1, nx)) ! initialize fp(x) ! fp1 = fp(x) = h(x/P) ! fpxk = fp(xk) = h(xk/P) DO j = 1, nx - x(j) = xmin+(j-1)*dx + x(j) = xmin + (j - 1)*dx x2(j) = x(j)**2 h(j) = x(j)/TANH(x(j)) IF (x(j) <= 1.0e-10_dp) h(j) = 1.0_dp fp1(j) = op*x(j)/TANH(x(j)*op) IF (x(j)*op <= 1.0e-10_dp) fp1(j) = 1.0_dp - DO k = 1, p-1 - xk2(k, j) = x2(j)+(p*SIN(k*pi*op))**2 + DO k = 1, p - 1 + xk2(k, j) = x2(j) + (p*SIN(k*pi*op))**2 xk(k, j) = SQRT(xk2(k, j)) - kk(k, j) = NINT((xk(k, j)-xmin)/dx)+1 + kk(k, j) = NINT((xk(k, j) - xmin)/dx) + 1 fpxk(k, j) = xk(k, j)*op/TANH(xk(k, j)*op) IF (xk(k, j)*op <= 1.0e-10_dp) fpxk(k, j) = 1.0_dp END DO @@ -655,12 +655,12 @@ SUBROUTINE pint_qtb_computefp0(pint_env, fp, fp1, dw, aa, bb, log_unit, ibead, p err = 0.0_dp DO j = 1, nx tmp = 0.0_dp - DO k = 1, p-1 - tmp = tmp+fpxk(k, j)*x2(j)/xk2(k, j) + DO k = 1, p - 1 + tmp = tmp + fpxk(k, j)*x2(j)/xk2(k, j) END DO fprev = fp1(j) - fp1(j) = malpha*(h(j)-tmp)+(1.0_dp-malpha)*fp1(j) - IF (j <= n) err = err+ABS(1.0_dp-fp1(j)/fprev) ! compute "errors" + fp1(j) = malpha*(h(j) - tmp) + (1.0_dp - malpha)*fp1(j) + IF (j <= n) err = err + ABS(1.0_dp - fp1(j)/fprev) ! compute "errors" END DO err = err/n @@ -671,12 +671,12 @@ SUBROUTINE pint_qtb_computefp0(pint_env, fp, fp1, dw, aa, bb, log_unit, ibead, p ! through linear interpolation ! or linear extrapolation if outside of the range DO j = 1, nx - DO k = 1, p-1 + DO k = 1, p - 1 IF (kk(k, j) < nx) THEN - fpxk(k, j) = fp1(kk(k, j))+(fp1(kk(k, j)+1)-fp1(kk(k, j)))/dx* & - (xk(k, j)-x(kk(k, j))) + fpxk(k, j) = fp1(kk(k, j)) + (fp1(kk(k, j) + 1) - fp1(kk(k, j)))/dx* & + (xk(k, j) - x(kk(k, j))) ELSE - fpxk(k, j) = aa*xk(k, j)+bb + fpxk(k, j) = aa*xk(k, j) + bb ENDIF END DO END DO @@ -710,7 +710,7 @@ SUBROUTINE pint_qtb_computefp0(pint_env, fp, fp1, dw, aa, bb, log_unit, ibead, p WRITE (log_unit, '(A)') ' # computed fp function' WRITE (log_unit, '(A)') ' # i, w(a.u.), x, fp' DO j = 1, nx - WRITE (log_unit, *) j, j*dw, xmin+(j-1)*dx, fp1(j) + WRITE (log_unit, *) j, j*dw, xmin + (j - 1)*dx, fp1(j) END DO END IF @@ -727,18 +727,18 @@ SUBROUTINE pint_qtb_computefp0(pint_env, fp, fp1, dw, aa, bb, log_unit, ibead, p ! through linear interpolation / regression DO j = 1, n x1 = j*dx1 - k = NINT((x1-xmin)/dx)+1 + k = NINT((x1 - xmin)/dx) + 1 IF (k > nx) THEN - fp(j) = aa*x1+bb + fp(j) = aa*x1 + bb ELSE IF (k <= 0) THEN CALL pint_write_line("QTB| error in fp computation x < xmin") CPABORT("Error in fp computation (x < xmin) in intialization of QTB random forces") ELSE - xx = xmin+(k-1)*dx + xx = xmin + (k - 1)*dx IF (x1 > xx) THEN - fp(j) = fp1(k)+(fp1(k+1)-fp1(k))/dx*(x1-xx) + fp(j) = fp1(k) + (fp1(k + 1) - fp1(k))/dx*(x1 - xx) ELSE - fp(j) = fp1(k)+(fp1(k)-fp1(k-1))/dx*(x1-xx) + fp(j) = fp1(k) + (fp1(k) - fp1(k - 1))/dx*(x1 - xx) END IF END IF END DO @@ -803,12 +803,12 @@ SUBROUTINE pint_qtb_computefp1(pint_env, fp, fp1, dw, aa, bb, log_unit, ibead, p xmin = 1.0e-3_dp !these values allows for an acceptable dx = 0.05_dp !ratio between accuracy, computing time and xmax = 10000.0_dp !memory requirement - tested for P up to 1024 - nx = INT((xmax-xmin)/dx)+1 - nx = nx+nx/5 !add 20% points to avoid problem at the end + nx = INT((xmax - xmin)/dx) + 1 + nx = nx + nx/5 !add 20% points to avoid problem at the end !of the interval (probably unnecessary) op = 1.0_dp/p IF (ibead == 2) THEN - op1 = 1.0_dp/(p-1) + op1 = 1.0_dp/(p - 1) malpha = op !mixing parameter alpha = 1/P niter = 40 !40 iterations are enough to converge @@ -827,25 +827,25 @@ SUBROUTINE pint_qtb_computefp1(pint_env, fp, fp1, dw, aa, bb, log_unit, ibead, p ALLOCATE (x2(nx)) ALLOCATE (h(nx)) ALLOCATE (fp1(nx)) - ALLOCATE (xk(p-1, nx)) - ALLOCATE (xk2(p-1, nx)) - ALLOCATE (kk(p-1, nx)) - ALLOCATE (fpxk(p-1, nx)) + ALLOCATE (xk(p - 1, nx)) + ALLOCATE (xk2(p - 1, nx)) + ALLOCATE (kk(p - 1, nx)) + ALLOCATE (fpxk(p - 1, nx)) ! initialize F_P(x) = f_P(x_1) ! fp1 = fp(x) = h(x/(P-1)) ! fpxk = fp(xk) = h(xk/(P-1)) DO j = 1, nx - x(j) = xmin+(j-1)*dx + x(j) = xmin + (j - 1)*dx x2(j) = x(j)**2 h(j) = x(j)/TANH(x(j)) IF (x(j) <= 1.0e-10_dp) h(j) = 1.0_dp fp1(j) = op1*x(j)/TANH(x(j)*op1) IF (x(j)*op1 <= 1.0e-10_dp) fp1(j) = 1.0_dp - DO k = 1, p-1 - xk2(k, j) = x2(j)+(p*SIN(k*pi*op))**2 - xk(k, j) = SQRT(xk2(k, j)-(p*SIN(pi*op))**2) - kk(k, j) = NINT((xk(k, j)-xmin)/dx)+1 + DO k = 1, p - 1 + xk2(k, j) = x2(j) + (p*SIN(k*pi*op))**2 + xk(k, j) = SQRT(xk2(k, j) - (p*SIN(pi*op))**2) + kk(k, j) = NINT((xk(k, j) - xmin)/dx) + 1 fpxk(k, j) = xk(k, j)*op1/TANH(xk(k, j)*op1) IF (xk(k, j)*op1 <= 1.0e-10_dp) fpxk(k, j) = 1.0_dp END DO @@ -857,13 +857,13 @@ SUBROUTINE pint_qtb_computefp1(pint_env, fp, fp1, dw, aa, bb, log_unit, ibead, p err = 0.0_dp DO j = 1, nx tmp = 0.0_dp - DO k = 2, p-1 - tmp = tmp+fpxk(k, j)*x2(j)/xk2(k, j) + DO k = 2, p - 1 + tmp = tmp + fpxk(k, j)*x2(j)/xk2(k, j) END DO fprev = fp1(j) - tmp1 = 1.0_dp+(p*SIN(pi*op)/x(j))**2 - fp1(j) = malpha*tmp1*(h(j)-1.0_dp-tmp)+(1.0_dp-malpha)*fp1(j) - IF (j <= n) err = err+ABS(1.0_dp-fp1(j)/fprev) ! compute "errors" + tmp1 = 1.0_dp + (p*SIN(pi*op)/x(j))**2 + fp1(j) = malpha*tmp1*(h(j) - 1.0_dp - tmp) + (1.0_dp - malpha)*fp1(j) + IF (j <= n) err = err + ABS(1.0_dp - fp1(j)/fprev) ! compute "errors" END DO err = err/n @@ -874,12 +874,12 @@ SUBROUTINE pint_qtb_computefp1(pint_env, fp, fp1, dw, aa, bb, log_unit, ibead, p ! through linear interpolation ! or linear extrapolation if outside of the range DO j = 1, nx - DO k = 1, p-1 + DO k = 1, p - 1 IF (kk(k, j) < nx) THEN - fpxk(k, j) = fp1(kk(k, j))+(fp1(kk(k, j)+1)-fp1(kk(k, j)))/dx* & - (xk(k, j)-x(kk(k, j))) + fpxk(k, j) = fp1(kk(k, j)) + (fp1(kk(k, j) + 1) - fp1(kk(k, j)))/dx* & + (xk(k, j) - x(kk(k, j))) ELSE - fpxk(k, j) = aa*xk(k, j)+bb + fpxk(k, j) = aa*xk(k, j) + bb END IF END DO END DO @@ -907,7 +907,7 @@ SUBROUTINE pint_qtb_computefp1(pint_env, fp, fp1, dw, aa, bb, log_unit, ibead, p WRITE (log_unit, '(A)') ' # computed fp function' WRITE (log_unit, '(A)') ' # i, w(a.u.), x, fp' DO j = 1, nx - WRITE (log_unit, *) j, j*dw, xmin+(j-1)*dx, fp1(j) + WRITE (log_unit, *) j, j*dw, xmin + (j - 1)*dx, fp1(j) END DO END IF @@ -922,22 +922,22 @@ SUBROUTINE pint_qtb_computefp1(pint_env, fp, fp1, dw, aa, bb, log_unit, ibead, p ! compute values of fP on the grid points for the current NM ! trough linear interpolation / regression DO j = 1, n - tmp = (j*dx1)**2-(p*SIN(pi*op))**2 + tmp = (j*dx1)**2 - (p*SIN(pi*op))**2 IF (tmp < 0.d0) THEN fp(j) = fp1(1) ELSE tmp = SQRT(tmp) - k = NINT((tmp-xmin)/dx)+1 + k = NINT((tmp - xmin)/dx) + 1 IF (k > nx) THEN - fp(j) = aa*tmp+bb + fp(j) = aa*tmp + bb ELSE IF (k <= 0) THEN fp(j) = fp1(1) ELSE - xx = xmin+(k-1)*dx + xx = xmin + (k - 1)*dx IF (tmp > xx) THEN - fp(j) = fp1(k)+(fp1(k+1)-fp1(k))/dx*(tmp-xx) + fp(j) = fp1(k) + (fp1(k + 1) - fp1(k))/dx*(tmp - xx) ELSE - fp(j) = fp1(k)+(fp1(k)-fp1(k-1))/dx*(tmp-xx) + fp(j) = fp1(k) + (fp1(k) - fp1(k - 1))/dx*(tmp - xx) END IF END IF END IF @@ -982,24 +982,24 @@ SUBROUTINE pint_qtb_linreg(y, x, a, b, r2, log_unit, print_level) yvar = 0.0_dp DO i = 1, n - xav = xav+x(i) - yav = yav+y(i) - xycov = xycov+x(i)*y(i) - xvar = xvar+x(i)**2 - yvar = yvar+y(i)**2 + xav = xav + x(i) + yav = yav + y(i) + xycov = xycov + x(i)*y(i) + xvar = xvar + x(i)**2 + yvar = yvar + y(i)**2 END DO xav = xav/n yav = yav/n xycov = xycov/n - xycov = xycov-xav*yav + xycov = xycov - xav*yav xvar = xvar/n - xvar = xvar-xav**2 + xvar = xvar - xav**2 yvar = yvar/n - yvar = yvar-yav**2 + yvar = yvar - yav**2 a = xycov/xvar - b = yav-a*xav + b = yav - a*xav r2 = xycov/SQRT(xvar*yvar) diff --git a/src/motion/pint_staging.F b/src/motion/pint_staging.F index cc9c96c06f..cdd2619e72 100644 --- a/src/motion/pint_staging.F +++ b/src/motion/pint_staging.F @@ -52,7 +52,7 @@ SUBROUTINE staging_env_create(staging_env, staging_section, p, kT) CPASSERT(.NOT. ASSOCIATED(staging_env)) ALLOCATE (staging_env) - last_staging_id = last_staging_id+1 + last_staging_id = last_staging_id + 1 staging_env%id_nr = last_staging_id staging_env%ref_count = 1 @@ -83,7 +83,7 @@ SUBROUTINE staging_release(staging_env) IF (ASSOCIATED(staging_env)) THEN CPASSERT(staging_env%ref_count > 0) - staging_env%ref_count = staging_env%ref_count-1 + staging_env%ref_count = staging_env%ref_count - 1 IF (staging_env%ref_count == 0) THEN DEALLOCATE (staging_env) END IF @@ -104,7 +104,7 @@ SUBROUTINE staging_retain(staging_env) CPASSERT(ASSOCIATED(staging_env)) CPASSERT(staging_env%ref_count > 0) - staging_env%ref_count = staging_env%ref_count+1 + staging_env%ref_count = staging_env%ref_count + 1 RETURN END SUBROUTINE staging_retain @@ -145,7 +145,7 @@ SUBROUTINE staging_init_masses(staging_env, mass, mass_beads, mass_fict, & ALLOCATE (scal(staging_env%p)) DO iseg = 1, staging_env%nseg DO i = 1, staging_env%j ! check order!!! - scal(staging_env%j*(iseg-1)+i) = REAL(i, dp)/REAL(MAX(1, i-1), dp) + scal(staging_env%j*(iseg - 1) + i) = REAL(i, dp)/REAL(MAX(1, i - 1), dp) END DO END DO ! scal=zeros(staging_env%j,Float64) @@ -192,12 +192,12 @@ SUBROUTINE staging_x2u(staging_env, ux, x) CPASSERT(ASSOCIATED(staging_env)) CPASSERT(staging_env%ref_count > 0) ux = x - DO s = 0, staging_env%nseg-1 + DO s = 0, staging_env%nseg - 1 DO k = 2, staging_env%j - ux(staging_env%j*s+k, :) = ux(staging_env%j*s+k, :) & - -((REAL(k-1, dp)/REAL(k, dp) & - *x(MODULO((staging_env%j*s+k+1), staging_env%p), :)+ & - x(staging_env%j*s+1, :)/REAL(k, dp))) + ux(staging_env%j*s + k, :) = ux(staging_env%j*s + k, :) & + - ((REAL(k - 1, dp)/REAL(k, dp) & + *x(MODULO((staging_env%j*s + k + 1), staging_env%p), :) + & + x(staging_env%j*s + 1, :)/REAL(k, dp))) END DO END DO RETURN @@ -225,27 +225,27 @@ SUBROUTINE staging_u2x(staging_env, ux, x) CPASSERT(ASSOCIATED(staging_env)) CPASSERT(staging_env%ref_count > 0) j = staging_env%j - const = REAL(j-1, dp)/REAL(j, dp) + const = REAL(j - 1, dp)/REAL(j, dp) const2 = 1._dp/REAL(j, dp) ALLOCATE (iii(staging_env%nseg), jjj(staging_env%nseg)) DO i = 1, staging_env%nseg - iii(i) = staging_env%j*(i-1)+1 !first el + iii(i) = staging_env%j*(i - 1) + 1 !first el END DO - DO i = 1, staging_env%nseg-1 - jjj(i) = iii(i)+j ! next first el (pbc) + DO i = 1, staging_env%nseg - 1 + jjj(i) = iii(i) + j ! next first el (pbc) END DO jjj(staging_env%nseg) = 1 x = ux DO i = 1, staging_env%nseg - x(j-1+iii(i), :) = x(j-1+iii(i), :)+ & - const*ux(jjj(i), :)+ux(iii(i), :)*const2 + x(j - 1 + iii(i), :) = x(j - 1 + iii(i), :) + & + const*ux(jjj(i), :) + ux(iii(i), :)*const2 END DO DO ist = 1, staging_env%nseg - DO i = staging_env%j-2, 2, -1 - x(i+iii(ist), :) = x(i+iii(ist), :)+ & - REAL(i-1, dp)/REAL(i, dp)*x(i+iii(ist)+1, :) & - +ux(iii(ist), :)/REAL(i, dp) + DO i = staging_env%j - 2, 2, -1 + x(i + iii(ist), :) = x(i + iii(ist), :) + & + REAL(i - 1, dp)/REAL(i, dp)*x(i + iii(ist) + 1, :) & + + ux(iii(ist), :)/REAL(i, dp) END DO END DO RETURN @@ -271,13 +271,13 @@ SUBROUTINE staging_f2uf(staging_env, uf, f) CPASSERT(ASSOCIATED(staging_env)) CPASSERT(staging_env%ref_count > 0) - const = REAL(staging_env%j-1, dp)/REAL(staging_env%j, dp) + const = REAL(staging_env%j - 1, dp)/REAL(staging_env%j, dp) ALLOCATE (iii(staging_env%j), jjj(staging_env%j), & kkk(staging_env%j)) - DO ist = 1, staging_env%j-1 - iii(ist) = (ist-1)*staging_env%j+1 ! first el - jjj(ist) = iii(ist)+staging_env%j-1 ! last el - kkk(ist) = iii(ist)-1 ! prev el + DO ist = 1, staging_env%j - 1 + iii(ist) = (ist - 1)*staging_env%j + 1 ! first el + jjj(ist) = iii(ist) + staging_env%j - 1 ! last el + kkk(ist) = iii(ist) - 1 ! prev el END DO kkk(1) = staging_env%p @@ -285,19 +285,19 @@ SUBROUTINE staging_f2uf(staging_env, uf, f) ! staging beads DO k = 1, staging_env%nseg DO i = 2, staging_env%j - uf(i+iii(k), :) = uf(i+iii(k), :) & - +REAL(i-1, dp)/REAL(i, dp)*uf(i+iii(k)-1, :) + uf(i + iii(k), :) = uf(i + iii(k), :) & + + REAL(i - 1, dp)/REAL(i, dp)*uf(i + iii(k) - 1, :) END DO END DO ! end point beads DO idim = 1, SIZE(uf, 2) DO k = 1, staging_env%nseg sum_f = 0._dp - DO ij = 2, staging_env%j-1 - sum_f = sum_f+uf((k-1)*staging_env%j+ij, idim) + DO ij = 2, staging_env%j - 1 + sum_f = sum_f + uf((k - 1)*staging_env%j + ij, idim) END DO - uf(iii(k), idim) = uf(iii(k), idim)+ & - sum_f-const*(uf(jjj(k), idim)-uf(kkk(k), idim)) + uf(iii(k), idim) = uf(iii(k), idim) + & + sum_f - const*(uf(jjj(k), idim) - uf(kkk(k), idim)) END DO END DO RETURN @@ -330,27 +330,27 @@ SUBROUTINE staging_calc_uf_h(staging_env, mass_beads, ux, uf_h, e_h) kkk(staging_env%nseg)) DO ist = 1, staging_env%nseg - iii(ist) = (ist-1)*staging_env%j+1 ! first el - jjj(ist) = iii(ist)+staging_env%j ! next fisrt (pbc) - kkk(ist) = iii(ist)-staging_env%j ! prev first el (pbc) + iii(ist) = (ist - 1)*staging_env%j + 1 ! first el + jjj(ist) = iii(ist) + staging_env%j ! next fisrt (pbc) + kkk(ist) = iii(ist) - staging_env%j ! prev first el (pbc) END DO jjj(staging_env%nseg) = 1 - kkk(1) = staging_env%p-staging_env%j + kkk(1) = staging_env%p - staging_env%j DO idim = 1, SIZE(mass_beads, 2) DO ist = 1, staging_env%nseg - e_h = e_h+0.5*mass_beads(1, idim)*staging_env%w_j**2* & - (ux(iii(ist), idim)-ux(jjj(ist), idim))**2 + e_h = e_h + 0.5*mass_beads(1, idim)*staging_env%w_j**2* & + (ux(iii(ist), idim) - ux(jjj(ist), idim))**2 uf_h(iii(ist), idim) = mass_beads(1, idim)*staging_env%w_j**2*( & 2._dp*ux(iii(ist), idim) & - -ux(jjj(ist), idim) & - -ux(kkk(ist), idim) & + - ux(jjj(ist), idim) & + - ux(kkk(ist), idim) & ) DO isg = 2, staging_env%j ! use 3 as start? - d = ux((ist-1)*staging_env%j+isg, idim) - f = mass_beads((ist-1)*staging_env%j+isg, idim)*staging_env%w_j**2*d - e_h = e_h+0.5_dp*f*d - uf_h((ist-1)*staging_env%j+isg, idim) = f + d = ux((ist - 1)*staging_env%j + isg, idim) + f = mass_beads((ist - 1)*staging_env%j + isg, idim)*staging_env%w_j**2*d + e_h = e_h + 0.5_dp*f*d + uf_h((ist - 1)*staging_env%j + isg, idim) = f END DO END DO END DO diff --git a/src/motion/reftraj_types.F b/src/motion/reftraj_types.F index 795d8ce59c..1b6ea35b65 100644 --- a/src/motion/reftraj_types.F +++ b/src/motion/reftraj_types.F @@ -140,7 +140,7 @@ SUBROUTINE retain_reftraj(reftraj) IF (ASSOCIATED(reftraj)) THEN CPASSERT(reftraj%ref_count > 0) - reftraj%ref_count = reftraj%ref_count+1 + reftraj%ref_count = reftraj%ref_count + 1 END IF END SUBROUTINE retain_reftraj @@ -161,7 +161,7 @@ SUBROUTINE release_reftraj(reftraj) IF (ASSOCIATED(reftraj)) THEN CPASSERT(reftraj%ref_count > 0) - reftraj%ref_count = reftraj%ref_count-1 + reftraj%ref_count = reftraj%ref_count - 1 IF (reftraj%ref_count < 1) THEN CALL parser_release(reftraj%info%traj_parser) CALL parser_release(reftraj%info%cell_parser) diff --git a/src/motion/reftraj_util.F b/src/motion/reftraj_util.F index 765a734c1c..627ab836e6 100644 --- a/src/motion/reftraj_util.F +++ b/src/motion/reftraj_util.F @@ -57,13 +57,13 @@ MODULE reftraj_util USE util, ONLY: get_limit #include "../base/base_uses.f90" - IMPLICIT NONE + IMPLICIT NONE - PRIVATE + PRIVATE CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'reftraj_util' - PUBLIC :: initialize_reftraj, compute_msd_reftraj, write_output_reftraj + PUBLIC :: initialize_reftraj, compute_msd_reftraj, write_output_reftraj CONTAINS @@ -76,7 +76,7 @@ MODULE reftraj_util !> 10.2007 created !> \author MI ! ************************************************************************************************** - SUBROUTINE initialize_reftraj(reftraj,reftraj_section,md_env) + SUBROUTINE initialize_reftraj(reftraj, reftraj_section, md_env) TYPE(reftraj_type), POINTER :: reftraj TYPE(section_vals_type), POINTER :: reftraj_section @@ -94,54 +94,53 @@ SUBROUTINE initialize_reftraj(reftraj,reftraj_section,md_env) TYPE(section_vals_type), POINTER :: msd_section TYPE(simpar_type), POINTER :: simpar - NULLIFY (force_env, msd_section, particles, simpar, subsys) - CALL get_md_env(md_env=md_env, force_env=force_env, para_env=para_env,& - simpar=simpar) - CALL force_env_get(force_env=force_env, subsys=subsys) - CALL cp_subsys_get(subsys=subsys, particles=particles) - natom = particles%n_els - - my_end = .FALSE. - nline_to_skip = 0 - - nskip = reftraj%info%first_snapshot-1 - CPASSERT(nskip>=0) - - IF(nskip > 0 ) THEN - nline_to_skip = (natom+2)*nskip - CALL parser_get_next_line(reftraj%info%traj_parser,nline_to_skip,at_end=my_end) - END IF - - reftraj%isnap = nskip - IF(my_end)& - CALL cp_abort(__LOCATION__,& - "Reached the end of the trajectory file for REFTRAJ. Number of steps skipped "//& - "equal to the number of steps present in the file.") - - ! Cell File - IF(reftraj%info%variable_volume) THEN - IF(nskip > 0 ) THEN - CALL parser_get_next_line(reftraj%info%cell_parser,nskip,at_end=my_end) - END IF - IF(my_end)& - CALL cp_abort(__LOCATION__,& - "Reached the end of the cell file for REFTRAJ. Number of steps skipped "//& - "equal to the number of steps present in the file.") - END IF - - - reftraj%natom = natom - IF(reftraj%info%last_snapshot>0) THEN - simpar%nsteps = (reftraj%info%last_snapshot - reftraj%info%first_snapshot + 1) - END IF - - IF(reftraj%info%msd) THEN - msd_section => section_vals_get_subs_vals(reftraj_section,"MSD") - ! set up and printout - CALL initialize_msd_reftraj(reftraj%msd,msd_section,reftraj,md_env) - END IF - - END SUBROUTINE initialize_reftraj + NULLIFY (force_env, msd_section, particles, simpar, subsys) + CALL get_md_env(md_env=md_env, force_env=force_env, para_env=para_env, & + simpar=simpar) + CALL force_env_get(force_env=force_env, subsys=subsys) + CALL cp_subsys_get(subsys=subsys, particles=particles) + natom = particles%n_els + + my_end = .FALSE. + nline_to_skip = 0 + + nskip = reftraj%info%first_snapshot - 1 + CPASSERT(nskip >= 0) + + IF (nskip > 0) THEN + nline_to_skip = (natom + 2)*nskip + CALL parser_get_next_line(reftraj%info%traj_parser, nline_to_skip, at_end=my_end) + END IF + + reftraj%isnap = nskip + IF (my_end) & + CALL cp_abort(__LOCATION__, & + "Reached the end of the trajectory file for REFTRAJ. Number of steps skipped "// & + "equal to the number of steps present in the file.") + + ! Cell File + IF (reftraj%info%variable_volume) THEN + IF (nskip > 0) THEN + CALL parser_get_next_line(reftraj%info%cell_parser, nskip, at_end=my_end) + END IF + IF (my_end) & + CALL cp_abort(__LOCATION__, & + "Reached the end of the cell file for REFTRAJ. Number of steps skipped "// & + "equal to the number of steps present in the file.") + END IF + + reftraj%natom = natom + IF (reftraj%info%last_snapshot > 0) THEN + simpar%nsteps = (reftraj%info%last_snapshot - reftraj%info%first_snapshot + 1) + END IF + + IF (reftraj%info%msd) THEN + msd_section => section_vals_get_subs_vals(reftraj_section, "MSD") + ! set up and printout + CALL initialize_msd_reftraj(reftraj%msd, msd_section, reftraj, md_env) + END IF + + END SUBROUTINE initialize_reftraj ! ************************************************************************************************** !> \brief ... @@ -153,7 +152,7 @@ END SUBROUTINE initialize_reftraj !> 10.2007 created !> \author MI ! ************************************************************************************************** - SUBROUTINE initialize_msd_reftraj(msd,msd_section,reftraj,md_env) + SUBROUTINE initialize_msd_reftraj(msd, msd_section, reftraj, md_env) TYPE(reftraj_msd_type), POINTER :: msd TYPE(section_vals_type), POINTER :: msd_section TYPE(reftraj_type), POINTER :: reftraj @@ -182,132 +181,132 @@ SUBROUTINE initialize_msd_reftraj(msd,msd_section,reftraj,md_env) TYPE(particle_list_type), POINTER :: particles TYPE(particle_type), DIMENSION(:), POINTER :: particle_set - NULLIFY (molecule, molecules, molecule_kind, molecule_kind_set,& - molecule_kinds, molecule_set, subsys, force_env, particles, particle_set) - CPASSERT(.NOT. ASSOCIATED(msd)) - - ALLOCATE(msd) - - NULLIFY(msd%ref0_pos) - NULLIFY(msd%ref0_com_molecule) - NULLIFY(msd%val_msd_kind) - NULLIFY(msd%val_msd_molecule) - NULLIFY(msd%disp_atom_index) - NULLIFY(msd%disp_atom_dr) - - CALL get_md_env(md_env=md_env, force_env=force_env, para_env=para_env) - CALL force_env_get(force_env=force_env,subsys=subsys) - CALL cp_subsys_get(subsys=subsys, particles=particles) - particle_set => particles%els - npart = SIZE(particle_set,1) - - msd%ref0_unit = -1 - CALL section_vals_val_get(msd_section,"REF0_FILENAME",c_val=filename) - CALL open_file(TRIM(filename),unit_number=msd%ref0_unit) - - ALLOCATE(msd%ref0_pos(3,reftraj%natom)) - msd%ref0_pos = 0.0_dp - - IF (para_env%mepos==para_env%source) THEN - REWIND(msd%ref0_unit) - READ(msd%ref0_unit,*,ERR=999,END=998) natom_read - CPASSERT(natom_read==reftraj%natom) - READ(msd%ref0_unit,'(A)',ERR=999,END=998) title - msd%total_mass = 0.0_dp - msd%ref0_com = 0.0_dp - DO iatom = 1,natom_read - READ(msd%ref0_unit,*,ERR=999,END=998) AA, x, y, z - name=TRIM(particle_set(iatom)%atomic_kind%element_symbol) - CPASSERT((TRIM(AA)==name)) - - x = cp_unit_to_cp2k(x,"angstrom") - y = cp_unit_to_cp2k(y,"angstrom") - z = cp_unit_to_cp2k(z,"angstrom") - msd%ref0_pos(1,iatom) = x - msd%ref0_pos(2,iatom) = y - msd%ref0_pos(3,iatom) = z - mass = particle_set(iatom)%atomic_kind%mass - msd%ref0_com(1) = msd%ref0_com(1) + x * mass - msd%ref0_com(2) = msd%ref0_com(2) + y * mass - msd%ref0_com(3) = msd%ref0_com(3) + z * mass - msd%total_mass = msd%total_mass + mass - END DO - msd%ref0_com = msd%ref0_com / msd%total_mass - END IF - CALL close_file(unit_number=msd%ref0_unit) - - CALL mp_bcast(msd%total_mass,para_env%source,para_env%group) - CALL mp_bcast(msd%ref0_pos,para_env%source,para_env%group) - CALL mp_bcast(msd%ref0_com,para_env%source,para_env%group) - - CALL section_vals_val_get(msd_section,"MSD_PER_KIND",l_val=msd%msd_kind) - CALL section_vals_val_get(msd_section,"MSD_PER_MOLKIND",l_val=msd%msd_molecule) - CALL section_vals_val_get(msd_section,"MSD_PER_REGION",l_val=msd%msd_region) - - CALL section_vals_val_get(msd_section,"DISPLACED_ATOM",l_val=msd%disp_atom) - IF(msd%disp_atom) THEN - ALLOCATE(msd%disp_atom_index(npart)) - msd%disp_atom_index = 0 - ALLOCATE(msd%disp_atom_dr(3,npart)) - msd%disp_atom_dr = 0.0_dp - msd%msd_kind = .TRUE. - END IF - CALL section_vals_val_get(msd_section,"DISPLACEMENT_TOL",r_val=tol) - msd%disp_atom_tol = tol*tol - - IF(msd%msd_kind) THEN - CALL cp_subsys_get(subsys=subsys,atomic_kinds=atomic_kinds) - nkind = atomic_kinds%n_els - - ALLOCATE(msd%val_msd_kind(4,nkind)) - msd%val_msd_kind = 0.0_dp - END IF - - IF(msd%msd_molecule) THEN - CALL cp_subsys_get(subsys=subsys, molecules=molecules,& - molecule_kinds=molecule_kinds) - nmolkind = molecule_kinds%n_els - ALLOCATE(msd%val_msd_molecule(4,nmolkind)) - - molecule_kind_set => molecule_kinds%els - molecule_set => molecules%els - nmol = molecules%n_els - - ALLOCATE(msd%ref0_com_molecule(3,nmol)) - - DO ikind = 1, nmolkind - molecule_kind => molecule_kind_set(ikind) - CALL get_molecule_kind (molecule_kind=molecule_kind, nmolecule=nmolecule ) - DO imol = 1,nmolecule - molecule => molecule_set(molecule_kind%molecule_list(imol)) - CALL get_molecule ( molecule=molecule, first_atom = first_atom, last_atom = last_atom ) - com = 0.0_dp - mass_mol = 0.0_dp - DO iatom = first_atom, last_atom - mass = particle_set(iatom)%atomic_kind%mass - com(1) = com(1) + msd%ref0_pos(1,iatom)*mass - com(2) = com(2) + msd%ref0_pos(2,iatom)*mass - com(3) = com(3) + msd%ref0_pos(3,iatom)*mass - mass_mol = mass_mol+mass - ENDDO ! iatom - msd%ref0_com_molecule(1,molecule_kind%molecule_list(imol)) = com(1)/mass_mol - msd%ref0_com_molecule(2,molecule_kind%molecule_list(imol)) = com(2)/mass_mol - msd%ref0_com_molecule(3,molecule_kind%molecule_list(imol)) = com(3)/mass_mol - END DO ! imol - ENDDO ! ikind - END IF - - IF(msd%msd_region) THEN - - END IF - - RETURN -998 CONTINUE ! end of file - CPABORT("End of reference positions file reached") -999 CONTINUE ! error - CPABORT("Error reading reference positions file") - - END SUBROUTINE initialize_msd_reftraj + NULLIFY (molecule, molecules, molecule_kind, molecule_kind_set, & + molecule_kinds, molecule_set, subsys, force_env, particles, particle_set) + CPASSERT(.NOT. ASSOCIATED(msd)) + + ALLOCATE (msd) + + NULLIFY (msd%ref0_pos) + NULLIFY (msd%ref0_com_molecule) + NULLIFY (msd%val_msd_kind) + NULLIFY (msd%val_msd_molecule) + NULLIFY (msd%disp_atom_index) + NULLIFY (msd%disp_atom_dr) + + CALL get_md_env(md_env=md_env, force_env=force_env, para_env=para_env) + CALL force_env_get(force_env=force_env, subsys=subsys) + CALL cp_subsys_get(subsys=subsys, particles=particles) + particle_set => particles%els + npart = SIZE(particle_set, 1) + + msd%ref0_unit = -1 + CALL section_vals_val_get(msd_section, "REF0_FILENAME", c_val=filename) + CALL open_file(TRIM(filename), unit_number=msd%ref0_unit) + + ALLOCATE (msd%ref0_pos(3, reftraj%natom)) + msd%ref0_pos = 0.0_dp + + IF (para_env%mepos == para_env%source) THEN + REWIND (msd%ref0_unit) + READ (msd%ref0_unit, *, ERR=999, END=998) natom_read + CPASSERT(natom_read == reftraj%natom) + READ (msd%ref0_unit, '(A)', ERR=999, END=998) title + msd%total_mass = 0.0_dp + msd%ref0_com = 0.0_dp + DO iatom = 1, natom_read + READ (msd%ref0_unit, *, ERR=999, END=998) AA, x, y, z + name = TRIM(particle_set(iatom)%atomic_kind%element_symbol) + CPASSERT((TRIM(AA) == name)) + + x = cp_unit_to_cp2k(x, "angstrom") + y = cp_unit_to_cp2k(y, "angstrom") + z = cp_unit_to_cp2k(z, "angstrom") + msd%ref0_pos(1, iatom) = x + msd%ref0_pos(2, iatom) = y + msd%ref0_pos(3, iatom) = z + mass = particle_set(iatom)%atomic_kind%mass + msd%ref0_com(1) = msd%ref0_com(1) + x*mass + msd%ref0_com(2) = msd%ref0_com(2) + y*mass + msd%ref0_com(3) = msd%ref0_com(3) + z*mass + msd%total_mass = msd%total_mass + mass + END DO + msd%ref0_com = msd%ref0_com/msd%total_mass + END IF + CALL close_file(unit_number=msd%ref0_unit) + + CALL mp_bcast(msd%total_mass, para_env%source, para_env%group) + CALL mp_bcast(msd%ref0_pos, para_env%source, para_env%group) + CALL mp_bcast(msd%ref0_com, para_env%source, para_env%group) + + CALL section_vals_val_get(msd_section, "MSD_PER_KIND", l_val=msd%msd_kind) + CALL section_vals_val_get(msd_section, "MSD_PER_MOLKIND", l_val=msd%msd_molecule) + CALL section_vals_val_get(msd_section, "MSD_PER_REGION", l_val=msd%msd_region) + + CALL section_vals_val_get(msd_section, "DISPLACED_ATOM", l_val=msd%disp_atom) + IF (msd%disp_atom) THEN + ALLOCATE (msd%disp_atom_index(npart)) + msd%disp_atom_index = 0 + ALLOCATE (msd%disp_atom_dr(3, npart)) + msd%disp_atom_dr = 0.0_dp + msd%msd_kind = .TRUE. + END IF + CALL section_vals_val_get(msd_section, "DISPLACEMENT_TOL", r_val=tol) + msd%disp_atom_tol = tol*tol + + IF (msd%msd_kind) THEN + CALL cp_subsys_get(subsys=subsys, atomic_kinds=atomic_kinds) + nkind = atomic_kinds%n_els + + ALLOCATE (msd%val_msd_kind(4, nkind)) + msd%val_msd_kind = 0.0_dp + END IF + + IF (msd%msd_molecule) THEN + CALL cp_subsys_get(subsys=subsys, molecules=molecules, & + molecule_kinds=molecule_kinds) + nmolkind = molecule_kinds%n_els + ALLOCATE (msd%val_msd_molecule(4, nmolkind)) + + molecule_kind_set => molecule_kinds%els + molecule_set => molecules%els + nmol = molecules%n_els + + ALLOCATE (msd%ref0_com_molecule(3, nmol)) + + DO ikind = 1, nmolkind + molecule_kind => molecule_kind_set(ikind) + CALL get_molecule_kind(molecule_kind=molecule_kind, nmolecule=nmolecule) + DO imol = 1, nmolecule + molecule => molecule_set(molecule_kind%molecule_list(imol)) + CALL get_molecule(molecule=molecule, first_atom=first_atom, last_atom=last_atom) + com = 0.0_dp + mass_mol = 0.0_dp + DO iatom = first_atom, last_atom + mass = particle_set(iatom)%atomic_kind%mass + com(1) = com(1) + msd%ref0_pos(1, iatom)*mass + com(2) = com(2) + msd%ref0_pos(2, iatom)*mass + com(3) = com(3) + msd%ref0_pos(3, iatom)*mass + mass_mol = mass_mol + mass + ENDDO ! iatom + msd%ref0_com_molecule(1, molecule_kind%molecule_list(imol)) = com(1)/mass_mol + msd%ref0_com_molecule(2, molecule_kind%molecule_list(imol)) = com(2)/mass_mol + msd%ref0_com_molecule(3, molecule_kind%molecule_list(imol)) = com(3)/mass_mol + END DO ! imol + ENDDO ! ikind + END IF + + IF (msd%msd_region) THEN + + END IF + + RETURN +998 CONTINUE ! end of file + CPABORT("End of reference positions file reached") +999 CONTINUE ! error + CPABORT("Error reading reference positions file") + + END SUBROUTINE initialize_msd_reftraj ! ************************************************************************************************** !> \brief ... @@ -318,7 +317,7 @@ END SUBROUTINE initialize_msd_reftraj !> 10.2007 created !> \author MI ! ************************************************************************************************** - SUBROUTINE compute_msd_reftraj(reftraj,md_env,particle_set) + SUBROUTINE compute_msd_reftraj(reftraj, md_env, particle_set) TYPE(reftraj_type), POINTER :: reftraj TYPE(md_environment_type), POINTER :: md_env @@ -345,140 +344,139 @@ SUBROUTINE compute_msd_reftraj(reftraj,md_env,particle_set) TYPE(molecule_type), DIMENSION(:), POINTER :: molecule_set TYPE(molecule_type), POINTER :: molecule - NULLIFY(force_env,para_env,subsys) - NULLIFY(atomic_kind,atomic_kinds,atom_list) - NULLIFY(local_molecules, molecule, molecule_kind, molecule_kinds,& - molecule_kind_set, molecules, molecule_set) - - CALL get_md_env(md_env=md_env, force_env=force_env, para_env=para_env) - CALL force_env_get(force_env=force_env,subsys=subsys) - CALL cp_subsys_get(subsys=subsys, atomic_kinds=atomic_kinds) + NULLIFY (force_env, para_env, subsys) + NULLIFY (atomic_kind, atomic_kinds, atom_list) + NULLIFY (local_molecules, molecule, molecule_kind, molecule_kinds, & + molecule_kind_set, molecules, molecule_set) - num_pe = para_env%num_pe - mepos = para_env%mepos + CALL get_md_env(md_env=md_env, force_env=force_env, para_env=para_env) + CALL force_env_get(force_env=force_env, subsys=subsys) + CALL cp_subsys_get(subsys=subsys, atomic_kinds=atomic_kinds) + num_pe = para_env%num_pe + mepos = para_env%mepos - IF(reftraj%msd%msd_kind)THEN - reftraj%msd%val_msd_kind = 0.0_dp - reftraj%msd%num_disp_atom = 0 - reftraj%msd%disp_atom_dr = 0.0_dp + IF (reftraj%msd%msd_kind) THEN + reftraj%msd%val_msd_kind = 0.0_dp + reftraj%msd%num_disp_atom = 0 + reftraj%msd%disp_atom_dr = 0.0_dp ! compute com - rcom = 0.0_dp - DO ikind=1,atomic_kinds%n_els - atomic_kind => atomic_kinds%els(ikind) - CALL get_atomic_kind(atomic_kind=atomic_kind,& - atom_list=atom_list,& - natom=natom_kind, mass=mass) - bo = get_limit(natom_kind,num_pe,mepos) - DO iatom = bo(1), bo(2) - atom = atom_list(iatom) - rcom(1) = rcom(1) + particle_set(atom)%r(1)*mass - rcom(2) = rcom(2) + particle_set(atom)%r(2)*mass - rcom(3) = rcom(3) + particle_set(atom)%r(3)*mass - END DO - END DO - CALL mp_sum(rcom,para_env%group) - rcom = rcom / reftraj%msd%total_mass - reftraj%msd%drcom (1) = rcom(1) - reftraj%msd%ref0_com(1) - reftraj%msd%drcom (2) = rcom(2) - reftraj%msd%ref0_com(2) - reftraj%msd%drcom (3) = rcom(3) - reftraj%msd%ref0_com(3) + rcom = 0.0_dp + DO ikind = 1, atomic_kinds%n_els + atomic_kind => atomic_kinds%els(ikind) + CALL get_atomic_kind(atomic_kind=atomic_kind, & + atom_list=atom_list, & + natom=natom_kind, mass=mass) + bo = get_limit(natom_kind, num_pe, mepos) + DO iatom = bo(1), bo(2) + atom = atom_list(iatom) + rcom(1) = rcom(1) + particle_set(atom)%r(1)*mass + rcom(2) = rcom(2) + particle_set(atom)%r(2)*mass + rcom(3) = rcom(3) + particle_set(atom)%r(3)*mass + END DO + END DO + CALL mp_sum(rcom, para_env%group) + rcom = rcom/reftraj%msd%total_mass + reftraj%msd%drcom(1) = rcom(1) - reftraj%msd%ref0_com(1) + reftraj%msd%drcom(2) = rcom(2) - reftraj%msd%ref0_com(2) + reftraj%msd%drcom(3) = rcom(3) - reftraj%msd%ref0_com(3) ! IF(para_env%ionode) WRITE(*,'(A,T50,3f10.5)') ' COM displacement (dx,dy,dz) [angstrom]: ', & ! drcom(1)*angstrom,drcom(2)*angstrom,drcom(3)*angstrom ! compute_com - DO ikind=1,atomic_kinds%n_els - atomic_kind => atomic_kinds%els(ikind) - CALL get_atomic_kind(atomic_kind=atomic_kind,& - atom_list=atom_list,& - natom=natom_kind) - bo = get_limit(natom_kind,num_pe,mepos) - DO iatom = bo(1), bo(2) - atom = atom_list(iatom) - dx = particle_set(atom)%r(1)-reftraj%msd%ref0_pos(1,atom) - & - reftraj%msd%drcom(1) - dy = particle_set(atom)%r(2)-reftraj%msd%ref0_pos(2,atom) - & - reftraj%msd%drcom(2) - dz = particle_set(atom)%r(3)-reftraj%msd%ref0_pos(3,atom) - & - reftraj%msd%drcom(3) - dr2 = dx*dx + dy*dy + dz*dz - - reftraj%msd%val_msd_kind(1,ikind) = reftraj%msd%val_msd_kind(1,ikind) + dx*dx - reftraj%msd%val_msd_kind(2,ikind) = reftraj%msd%val_msd_kind(2,ikind) + dy*dy - reftraj%msd%val_msd_kind(3,ikind) = reftraj%msd%val_msd_kind(3,ikind) + dz*dz - reftraj%msd%val_msd_kind(4,ikind) = reftraj%msd%val_msd_kind(4,ikind) + dr2 - - IF(reftraj%msd%disp_atom) THEN - IF( dr2 > reftraj%msd%disp_atom_tol ) THEN - reftraj%msd%num_disp_atom = reftraj%msd%num_disp_atom +1 - reftraj%msd%disp_atom_dr(1, atom) = dx - reftraj%msd%disp_atom_dr(2, atom) = dy - reftraj%msd%disp_atom_dr(3, atom) = dz - END IF - END IF - END DO !iatom - reftraj%msd%val_msd_kind(1:4,ikind) = & - reftraj%msd%val_msd_kind(1:4,ikind)/REAL(natom_kind,KIND=dp) - - END DO ! ikind - ENDIF - CALL mp_sum(reftraj%msd%val_msd_kind,para_env%group) - CALL mp_sum(reftraj%msd%num_disp_atom,para_env%group) - CALL mp_sum(reftraj%msd%disp_atom_dr,para_env%group) - - IF(reftraj%msd%msd_molecule) THEN - CALL cp_subsys_get(subsys=subsys, local_molecules=local_molecules, & - molecules=molecules, molecule_kinds=molecule_kinds) - - nmolkind = molecule_kinds%n_els - molecule_kind_set => molecule_kinds%els - molecule_set => molecules%els - - reftraj%msd%val_msd_molecule = 0.0_dp - DO ikind = 1,nmolkind - molecule_kind => molecule_kind_set(ikind) - CALL get_molecule_kind (molecule_kind=molecule_kind, nmolecule=nmolecule ) - nmol_per_kind = local_molecules%n_el(ikind) - msd_mkind = 0.0_dp - DO imol = 1, nmol_per_kind - imol_global = local_molecules%list(ikind)%array(imol) - molecule => molecule_set ( imol_global ) - CALL get_molecule (molecule,first_atom=first_atom,last_atom=last_atom) - - com = 0.0_dp - mass_mol = 0.0_dp - DO iatom = first_atom, last_atom - mass = particle_set(iatom)%atomic_kind%mass - com(1) = com(1) + particle_set(iatom)%r(1)*mass - com(2) = com(2) + particle_set(iatom)%r(2)*mass - com(3) = com(3) + particle_set(iatom)%r(3)*mass - mass_mol = mass_mol+mass - ENDDO ! iatom - com(1) = com(1)/mass_mol - com(2) = com(2)/mass_mol - com(3) = com(3)/mass_mol - diff2_com(1) = com(1)- reftraj%msd%ref0_com_molecule(1,imol_global) - diff2_com(2) = com(2)- reftraj%msd%ref0_com_molecule(2,imol_global) - diff2_com(3) = com(3)- reftraj%msd%ref0_com_molecule(3,imol_global) - diff2_com(1) = diff2_com(1)*diff2_com(1) - diff2_com(2) = diff2_com(2)*diff2_com(2) - diff2_com(3) = diff2_com(3)*diff2_com(3) - diff2_com(4) = diff2_com(1) + diff2_com(2) + diff2_com(3) - msd_mkind(1) = msd_mkind(1) + diff2_com(1) - msd_mkind(2) = msd_mkind(2) + diff2_com(2) - msd_mkind(3) = msd_mkind(3) + diff2_com(3) - msd_mkind(4) = msd_mkind(4) + diff2_com(4) - ENDDO ! imol - - reftraj%msd%val_msd_molecule(1,ikind) = msd_mkind(1)/REAL(nmolecule,KIND=dp) - reftraj%msd%val_msd_molecule(2,ikind) = msd_mkind(2)/REAL(nmolecule,KIND=dp) - reftraj%msd%val_msd_molecule(3,ikind) = msd_mkind(3)/REAL(nmolecule,KIND=dp) - reftraj%msd%val_msd_molecule(4,ikind) = msd_mkind(4)/REAL(nmolecule,KIND=dp) - END DO ! ikind - CALL mp_sum(reftraj%msd%val_msd_molecule, para_env%group) - - END IF - - END SUBROUTINE compute_msd_reftraj + DO ikind = 1, atomic_kinds%n_els + atomic_kind => atomic_kinds%els(ikind) + CALL get_atomic_kind(atomic_kind=atomic_kind, & + atom_list=atom_list, & + natom=natom_kind) + bo = get_limit(natom_kind, num_pe, mepos) + DO iatom = bo(1), bo(2) + atom = atom_list(iatom) + dx = particle_set(atom)%r(1) - reftraj%msd%ref0_pos(1, atom) - & + reftraj%msd%drcom(1) + dy = particle_set(atom)%r(2) - reftraj%msd%ref0_pos(2, atom) - & + reftraj%msd%drcom(2) + dz = particle_set(atom)%r(3) - reftraj%msd%ref0_pos(3, atom) - & + reftraj%msd%drcom(3) + dr2 = dx*dx + dy*dy + dz*dz + + reftraj%msd%val_msd_kind(1, ikind) = reftraj%msd%val_msd_kind(1, ikind) + dx*dx + reftraj%msd%val_msd_kind(2, ikind) = reftraj%msd%val_msd_kind(2, ikind) + dy*dy + reftraj%msd%val_msd_kind(3, ikind) = reftraj%msd%val_msd_kind(3, ikind) + dz*dz + reftraj%msd%val_msd_kind(4, ikind) = reftraj%msd%val_msd_kind(4, ikind) + dr2 + + IF (reftraj%msd%disp_atom) THEN + IF (dr2 > reftraj%msd%disp_atom_tol) THEN + reftraj%msd%num_disp_atom = reftraj%msd%num_disp_atom + 1 + reftraj%msd%disp_atom_dr(1, atom) = dx + reftraj%msd%disp_atom_dr(2, atom) = dy + reftraj%msd%disp_atom_dr(3, atom) = dz + END IF + END IF + END DO !iatom + reftraj%msd%val_msd_kind(1:4, ikind) = & + reftraj%msd%val_msd_kind(1:4, ikind)/REAL(natom_kind, KIND=dp) + + END DO ! ikind + ENDIF + CALL mp_sum(reftraj%msd%val_msd_kind, para_env%group) + CALL mp_sum(reftraj%msd%num_disp_atom, para_env%group) + CALL mp_sum(reftraj%msd%disp_atom_dr, para_env%group) + + IF (reftraj%msd%msd_molecule) THEN + CALL cp_subsys_get(subsys=subsys, local_molecules=local_molecules, & + molecules=molecules, molecule_kinds=molecule_kinds) + + nmolkind = molecule_kinds%n_els + molecule_kind_set => molecule_kinds%els + molecule_set => molecules%els + + reftraj%msd%val_msd_molecule = 0.0_dp + DO ikind = 1, nmolkind + molecule_kind => molecule_kind_set(ikind) + CALL get_molecule_kind(molecule_kind=molecule_kind, nmolecule=nmolecule) + nmol_per_kind = local_molecules%n_el(ikind) + msd_mkind = 0.0_dp + DO imol = 1, nmol_per_kind + imol_global = local_molecules%list(ikind)%array(imol) + molecule => molecule_set(imol_global) + CALL get_molecule(molecule, first_atom=first_atom, last_atom=last_atom) + + com = 0.0_dp + mass_mol = 0.0_dp + DO iatom = first_atom, last_atom + mass = particle_set(iatom)%atomic_kind%mass + com(1) = com(1) + particle_set(iatom)%r(1)*mass + com(2) = com(2) + particle_set(iatom)%r(2)*mass + com(3) = com(3) + particle_set(iatom)%r(3)*mass + mass_mol = mass_mol + mass + ENDDO ! iatom + com(1) = com(1)/mass_mol + com(2) = com(2)/mass_mol + com(3) = com(3)/mass_mol + diff2_com(1) = com(1) - reftraj%msd%ref0_com_molecule(1, imol_global) + diff2_com(2) = com(2) - reftraj%msd%ref0_com_molecule(2, imol_global) + diff2_com(3) = com(3) - reftraj%msd%ref0_com_molecule(3, imol_global) + diff2_com(1) = diff2_com(1)*diff2_com(1) + diff2_com(2) = diff2_com(2)*diff2_com(2) + diff2_com(3) = diff2_com(3)*diff2_com(3) + diff2_com(4) = diff2_com(1) + diff2_com(2) + diff2_com(3) + msd_mkind(1) = msd_mkind(1) + diff2_com(1) + msd_mkind(2) = msd_mkind(2) + diff2_com(2) + msd_mkind(3) = msd_mkind(3) + diff2_com(3) + msd_mkind(4) = msd_mkind(4) + diff2_com(4) + ENDDO ! imol + + reftraj%msd%val_msd_molecule(1, ikind) = msd_mkind(1)/REAL(nmolecule, KIND=dp) + reftraj%msd%val_msd_molecule(2, ikind) = msd_mkind(2)/REAL(nmolecule, KIND=dp) + reftraj%msd%val_msd_molecule(3, ikind) = msd_mkind(3)/REAL(nmolecule, KIND=dp) + reftraj%msd%val_msd_molecule(4, ikind) = msd_mkind(4)/REAL(nmolecule, KIND=dp) + END DO ! ikind + CALL mp_sum(reftraj%msd%val_msd_molecule, para_env%group) + + END IF + + END SUBROUTINE compute_msd_reftraj ! ************************************************************************************************** !> \brief ... @@ -487,7 +485,7 @@ END SUBROUTINE compute_msd_reftraj !> 10.2007 created !> \author MI ! ************************************************************************************************** - SUBROUTINE write_output_reftraj(md_env) + SUBROUTINE write_output_reftraj(md_env) TYPE(md_environment_type), POINTER :: md_env CHARACTER(len=*), PARAMETER :: routineN = 'write_output_reftraj', & @@ -501,92 +499,92 @@ SUBROUTINE write_output_reftraj(md_env) TYPE(reftraj_type), POINTER :: reftraj TYPE(section_vals_type), POINTER :: reftraj_section, root_section - NULLIFY(logger) - logger => cp_get_default_logger() - - NULLIFY(reftraj) - NULLIFY(reftraj_section,root_section) - - CALL get_md_env(md_env=md_env, force_env=force_env, & - reftraj=reftraj) - - CALL force_env_get(force_env=force_env,root_section=root_section) - - reftraj_section => section_vals_get_subs_vals(root_section,& - "MOTION%MD%REFTRAJ") - - my_pos = "APPEND" - my_act = "WRITE" - - IF(reftraj%init.AND.(reftraj%isnap==reftraj%info%first_snapshot)) THEN - my_pos = "REWIND" - first_entry = .TRUE. - END IF - - IF(reftraj%info%msd) THEN - IF(reftraj%msd%msd_kind)THEN - nkind = SIZE(reftraj%msd%val_msd_kind,2) - DO ikind = 1,nkind - my_mittle ="k"//TRIM(ADJUSTL(cp_to_string(ikind))) - out_msd = cp_print_key_unit_nr(logger,reftraj_section,"PRINT%MSD_KIND",& - extension=".msd", file_position=my_pos, file_action=my_act,& - file_form="FORMATTED", middle_name=TRIM(my_mittle)) - IF(out_msd>0) THEN - WRITE(UNIT=out_msd,FMT="(I8, F12.3,4F20.10)") reftraj%itimes, & - reftraj%time*femtoseconds, & - reftraj%msd%val_msd_kind(1:4,ikind)*angstrom*angstrom - CALL m_flush(out_msd) - END IF - CALL cp_print_key_finished_output(out_msd,logger,reftraj_section,& - "PRINT%MSD_KIND") - END DO - END IF - IF(reftraj%msd%msd_molecule) THEN - nkind = SIZE(reftraj%msd%val_msd_molecule,2) - DO ikind = 1,nkind - my_mittle ="mk"//TRIM(ADJUSTL(cp_to_string(ikind))) - out_msd = cp_print_key_unit_nr(logger,reftraj_section,"PRINT%MSD_MOLECULE",& - extension=".msd", file_position=my_pos, file_action=my_act,& - file_form="FORMATTED", middle_name=TRIM(my_mittle)) - IF(out_msd>0) THEN - WRITE(UNIT=out_msd,FMT="(I8, F12.3,4F20.10)") reftraj%itimes, & - reftraj%time*femtoseconds, & - reftraj%msd%val_msd_molecule(1:4,ikind)*angstrom*angstrom - CALL m_flush(out_msd) - END IF - CALL cp_print_key_finished_output(out_msd,logger,reftraj_section,& - "PRINT%MSD_MOLECULE") - END DO + NULLIFY (logger) + logger => cp_get_default_logger() + + NULLIFY (reftraj) + NULLIFY (reftraj_section, root_section) + + CALL get_md_env(md_env=md_env, force_env=force_env, & + reftraj=reftraj) + + CALL force_env_get(force_env=force_env, root_section=root_section) + + reftraj_section => section_vals_get_subs_vals(root_section, & + "MOTION%MD%REFTRAJ") + + my_pos = "APPEND" + my_act = "WRITE" + + IF (reftraj%init .AND. (reftraj%isnap == reftraj%info%first_snapshot)) THEN + my_pos = "REWIND" + first_entry = .TRUE. END IF - IF(reftraj%msd%disp_atom) THEN - - IF(first_entry) my_pos = "REWIND" - my_mittle ="disp_at" - out_msd = cp_print_key_unit_nr(logger,reftraj_section,"PRINT%DISPLACED_ATOM",& - extension=".msd", file_position=my_pos, file_action=my_act,& - file_form="FORMATTED", middle_name=TRIM(my_mittle)) - IF(out_msd>0 .AND. reftraj%msd%num_disp_atom>0) THEN - IF(first_entry) THEN - first_entry = .FALSE. - END IF - WRITE(UNIT=out_msd,FMT="(A,T7,I8, A, T29, F12.3, A, T50, I10)") "# i = ", reftraj%itimes, " time (fs) = ",& - reftraj%time*femtoseconds, " nat = ", reftraj%msd%num_disp_atom - DO iat = 1,SIZE(reftraj%msd%disp_atom_dr,2) - IF(ABS(reftraj%msd%disp_atom_dr(1,iat)) > 0.0_dp) THEN - WRITE(UNIT=out_msd,FMT="(I8, 3F20.10)") iat,& !reftraj%msd%disp_atom_index(iat),& - reftraj%msd%disp_atom_dr(1,iat)*angstrom, & - reftraj%msd%disp_atom_dr(2,iat)*angstrom,& - reftraj%msd%disp_atom_dr(3,iat)*angstrom + + IF (reftraj%info%msd) THEN + IF (reftraj%msd%msd_kind) THEN + nkind = SIZE(reftraj%msd%val_msd_kind, 2) + DO ikind = 1, nkind + my_mittle = "k"//TRIM(ADJUSTL(cp_to_string(ikind))) + out_msd = cp_print_key_unit_nr(logger, reftraj_section, "PRINT%MSD_KIND", & + extension=".msd", file_position=my_pos, file_action=my_act, & + file_form="FORMATTED", middle_name=TRIM(my_mittle)) + IF (out_msd > 0) THEN + WRITE (UNIT=out_msd, FMT="(I8, F12.3,4F20.10)") reftraj%itimes, & + reftraj%time*femtoseconds, & + reftraj%msd%val_msd_kind(1:4, ikind)*angstrom*angstrom + CALL m_flush(out_msd) END IF + CALL cp_print_key_finished_output(out_msd, logger, reftraj_section, & + "PRINT%MSD_KIND") END DO - ENDIF - CALL cp_print_key_finished_output(out_msd,logger,reftraj_section,& - "PRINT%DISPLACED_ATOM") - END IF - ENDIF ! msd - reftraj%init = .FALSE. - - END SUBROUTINE write_output_reftraj + END IF + IF (reftraj%msd%msd_molecule) THEN + nkind = SIZE(reftraj%msd%val_msd_molecule, 2) + DO ikind = 1, nkind + my_mittle = "mk"//TRIM(ADJUSTL(cp_to_string(ikind))) + out_msd = cp_print_key_unit_nr(logger, reftraj_section, "PRINT%MSD_MOLECULE", & + extension=".msd", file_position=my_pos, file_action=my_act, & + file_form="FORMATTED", middle_name=TRIM(my_mittle)) + IF (out_msd > 0) THEN + WRITE (UNIT=out_msd, FMT="(I8, F12.3,4F20.10)") reftraj%itimes, & + reftraj%time*femtoseconds, & + reftraj%msd%val_msd_molecule(1:4, ikind)*angstrom*angstrom + CALL m_flush(out_msd) + END IF + CALL cp_print_key_finished_output(out_msd, logger, reftraj_section, & + "PRINT%MSD_MOLECULE") + END DO + END IF + IF (reftraj%msd%disp_atom) THEN + + IF (first_entry) my_pos = "REWIND" + my_mittle = "disp_at" + out_msd = cp_print_key_unit_nr(logger, reftraj_section, "PRINT%DISPLACED_ATOM", & + extension=".msd", file_position=my_pos, file_action=my_act, & + file_form="FORMATTED", middle_name=TRIM(my_mittle)) + IF (out_msd > 0 .AND. reftraj%msd%num_disp_atom > 0) THEN + IF (first_entry) THEN + first_entry = .FALSE. + END IF + WRITE (UNIT=out_msd, FMT="(A,T7,I8, A, T29, F12.3, A, T50, I10)") "# i = ", reftraj%itimes, " time (fs) = ", & + reftraj%time*femtoseconds, " nat = ", reftraj%msd%num_disp_atom + DO iat = 1, SIZE(reftraj%msd%disp_atom_dr, 2) + IF (ABS(reftraj%msd%disp_atom_dr(1, iat)) > 0.0_dp) THEN + WRITE (UNIT=out_msd, FMT="(I8, 3F20.10)") iat, & !reftraj%msd%disp_atom_index(iat),& + reftraj%msd%disp_atom_dr(1, iat)*angstrom, & + reftraj%msd%disp_atom_dr(2, iat)*angstrom, & + reftraj%msd%disp_atom_dr(3, iat)*angstrom + END IF + END DO + ENDIF + CALL cp_print_key_finished_output(out_msd, logger, reftraj_section, & + "PRINT%DISPLACED_ATOM") + END IF + ENDIF ! msd + reftraj%init = .FALSE. + + END SUBROUTINE write_output_reftraj END MODULE reftraj_util diff --git a/src/motion/rt_propagation.F b/src/motion/rt_propagation.F index 88728958ce..a24158bf1a 100644 --- a/src/motion/rt_propagation.F +++ b/src/motion/rt_propagation.F @@ -215,7 +215,7 @@ SUBROUTINE init_propagation_run(qs_env) ENDIF ELSE DO i = 1, SIZE(mos) - CALL cp_fm_to_fm(mos(i)%mo_set%mo_coeff, mos_old(2*i-1)%matrix) + CALL cp_fm_to_fm(mos(i)%mo_set%mo_coeff, mos_old(2*i - 1)%matrix) CALL cp_fm_set_all(mos_old(2*i)%matrix, zero, zero) END DO ENDIF @@ -238,7 +238,7 @@ SUBROUTINE init_propagation_run(qs_env) !The wavefunction was minimized using a linear scaling method. The density matrix is therefore taken from the ls_scf_env. CALL get_rtp(rtp=rtp, rho_old=rho_old, rho_new=rho_new) DO ispin = 1, SIZE(rho_old)/2 - re = 2*ispin-1 + re = 2*ispin - 1 CALL dbcsr_copy(rho_old(re)%matrix, qs_env%ls_scf_env%matrix_p(ispin)) CALL dbcsr_copy(rho_new(re)%matrix, qs_env%ls_scf_env%matrix_p(ispin)) END DO @@ -291,7 +291,7 @@ SUBROUTINE run_propagation(qs_env, force_env, globenv) CALL get_qs_env(qs_env=qs_env, dft_control=dft_control, rtp=rtp, energy=energy) rtp_control => dft_control%rtp_control - max_steps = MIN(rtp%i_start+rtp%nsteps, rtp%max_steps) + max_steps = MIN(rtp%i_start + rtp%nsteps, rtp%max_steps) max_iter = rtp_control%max_iter eps_ener = rtp_control%eps_ener @@ -303,20 +303,20 @@ SUBROUTINE run_propagation(qs_env, force_env, globenv) CALL cp_iterate(logger%iter_info, iter_nr=0) IF (rtp%i_start >= max_steps) CALL cp_abort(__LOCATION__, & "maximum step number smaller than initial step value") - DO i_step = rtp%i_start+1, max_steps + DO i_step = rtp%i_start + 1, max_steps energy%efield_core = 0.0_dp qs_env%sim_time = REAL(i_step, dp)*rtp%dt CALL get_qs_env(qs_env, pw_env=pw_env) pw_env%poisson_env%parameters%dbc_params%time = qs_env%sim_time qs_env%sim_step = i_step - rtp%istep = i_step-rtp%i_start + rtp%istep = i_step - rtp%i_start CALL calculate_ecore_efield(qs_env, .FALSE.) CALL external_c_potential(qs_env, calculate_forces=.FALSE.) CALL external_e_potential(qs_env) CALL cp_iterate(logger%iter_info, last=(i_step == max_steps), iter_nr=i_step) rtp%converged = .FALSE. DO i_iter = 1, max_iter - IF (i_step == rtp%i_start+1 .AND. i_iter == 2 .AND. rtp_control%hfx_redistribute) & + IF (i_step == rtp%i_start + 1 .AND. i_iter == 2 .AND. rtp_control%hfx_redistribute) & CALL qs_ks_did_change(qs_env%ks_env, s_mstruct_changed=.TRUE.) rtp%iter = i_iter CALL propagation_step(qs_env, rtp, rtp_control) @@ -329,7 +329,7 @@ SUBROUTINE run_propagation(qs_env, force_env, globenv) CALL external_control(should_stop, "MD", globenv=globenv) IF (should_stop) CALL cp_iterate(logger%iter_info, last=.TRUE., iter_nr=i_step) time_iter_stop = m_walltime() - used_time = time_iter_stop-time_iter_start + used_time = time_iter_stop - time_iter_start time_iter_start = time_iter_stop CALL rt_prop_output(qs_env, real_time_propagation, delta_iter=rtp%delta_iter, used_time=used_time) CALL rt_write_input_restart(force_env=force_env) diff --git a/src/motion/shell_opt.F b/src/motion/shell_opt.F index 0557de9a8e..ad1419e0fc 100644 --- a/src/motion/shell_opt.F +++ b/src/motion/shell_opt.F @@ -120,9 +120,9 @@ SUBROUTINE optimize_shell_core(force_env, particle_set, shell_particle_set, core ALLOCATE (dvec_sc(3*nshell)) ALLOCATE (dvec_sc_0(3*nshell)) DO i = 1, nshell - dvec_sc(1+3*(i-1)) = core_particle_set(i)%r(1)-shell_particle_set(i)%r(1) - dvec_sc(2+3*(i-1)) = core_particle_set(i)%r(2)-shell_particle_set(i)%r(2) - dvec_sc(3+3*(i-1)) = core_particle_set(i)%r(3)-shell_particle_set(i)%r(3) + dvec_sc(1 + 3*(i - 1)) = core_particle_set(i)%r(1) - shell_particle_set(i)%r(1) + dvec_sc(2 + 3*(i - 1)) = core_particle_set(i)%r(2) - shell_particle_set(i)%r(2) + dvec_sc(3 + 3*(i - 1)) = core_particle_set(i)%r(3) - shell_particle_set(i)%r(3) END DO dvec_sc_0 = dvec_sc @@ -136,9 +136,9 @@ SUBROUTINE optimize_shell_core(force_env, particle_set, shell_particle_set, core geo_section, gopt_env, dvec_sc, do_update=do_update) IF (.NOT. do_update) THEN DO i = 1, nshell - shell_particle_set(i)%r(1) = -dvec_sc_0(1+3*(i-1))+core_particle_set(i)%r(1) - shell_particle_set(i)%r(2) = -dvec_sc_0(2+3*(i-1))+core_particle_set(i)%r(2) - shell_particle_set(i)%r(3) = -dvec_sc_0(3+3*(i-1))+core_particle_set(i)%r(3) + shell_particle_set(i)%r(1) = -dvec_sc_0(1 + 3*(i - 1)) + core_particle_set(i)%r(1) + shell_particle_set(i)%r(2) = -dvec_sc_0(2 + 3*(i - 1)) + core_particle_set(i)%r(2) + shell_particle_set(i)%r(3) = -dvec_sc_0(3 + 3*(i - 1)) + core_particle_set(i)%r(3) END DO END IF CALL cp_rm_iter_level(logger%iter_info, "SHELL_OPT") @@ -216,7 +216,7 @@ SUBROUTINE check_shell_core_distance(atomic_kinds, local_particles, particle_set rc(:) = core_particle_set(shell_index)%r(:) rs(:) = shell_particle_set(shell_index)%r(:) - dsc = SQRT((rc(1)-rs(1))**2+(rc(2)-rs(2))**2+(rc(3)-rs(3))**2) + dsc = SQRT((rc(1) - rs(1))**2 + (rc(2) - rs(2))**2 + (rc(3) - rs(3))**2) IF (dsc > shell%max_dist) THEN itest = 1 END IF diff --git a/src/motion/simpar_methods.F b/src/motion/simpar_methods.F index 3675e45052..857ad8c56b 100644 --- a/src/motion/simpar_methods.F +++ b/src/motion/simpar_methods.F @@ -85,7 +85,7 @@ SUBROUTINE read_md_section(simpar, motion_section, md_section) CALL cite_reference(Ricci2003) IF (simpar%noisy_gamma > 0.0_dp) CALL cite_reference(Kuhne2007) ! Normalization factor using a normal Gaussian random number distribution - simpar%var_w = 2.0_dp*simpar%temp_ext*simpar%dt*(simpar%gamma+simpar%noisy_gamma) + simpar%var_w = 2.0_dp*simpar%temp_ext*simpar%dt*(simpar%gamma + simpar%noisy_gamma) IF (iw > 0) THEN tmp_r1 = cp_unit_from_cp2k(simpar%gamma, "fs^-1") tmp_r2 = cp_unit_from_cp2k(simpar%noisy_gamma, "fs^-1") diff --git a/src/motion/thermal_region_types.F b/src/motion/thermal_region_types.F index 28663eaf73..c7ba281bae 100644 --- a/src/motion/thermal_region_types.F +++ b/src/motion/thermal_region_types.F @@ -80,7 +80,7 @@ SUBROUTINE retain_thermal_regions(thermal_regions) IF (ASSOCIATED(thermal_regions)) THEN CPASSERT(thermal_regions%ref_count > 0) - thermal_regions%ref_count = thermal_regions%ref_count+1 + thermal_regions%ref_count = thermal_regions%ref_count + 1 END IF END SUBROUTINE retain_thermal_regions @@ -104,7 +104,7 @@ SUBROUTINE release_thermal_regions(thermal_regions) IF (check) THEN check = thermal_regions%ref_count > 0 CPASSERT(check) - thermal_regions%ref_count = thermal_regions%ref_count-1 + thermal_regions%ref_count = thermal_regions%ref_count - 1 IF (thermal_regions%ref_count < 1) THEN IF (ASSOCIATED(thermal_regions%thermal_region)) THEN DO ireg = 1, SIZE(thermal_regions%thermal_region) diff --git a/src/motion/thermal_region_utils.F b/src/motion/thermal_region_utils.F index c6fa224c09..af62a76fc0 100644 --- a/src/motion/thermal_region_utils.F +++ b/src/motion/thermal_region_utils.F @@ -146,11 +146,11 @@ SUBROUTINE create_thermal_regions(thermal_regions, md_section, simpar, force_env DO il = 1, nlist CALL section_vals_val_get(region_sections, "LIST", i_rep_section=ireg, & i_rep_val=il, i_vals=tmplist) - CALL reallocate(t_region%part_index, 1, t_region%npart+SIZE(tmplist)) + CALL reallocate(t_region%part_index, 1, t_region%npart + SIZE(tmplist)) DO i = 1, SIZE(tmplist) ipart = tmplist(i) CPASSERT(((ipart > 0) .AND. (ipart <= particles%n_els))) - t_region%npart = t_region%npart+1 + t_region%npart = t_region%npart + 1 t_region%part_index(t_region%npart) = ipart particles%els(ipart)%t_region_index = ireg IF (simpar%ensemble == langevin_ensemble) THEN @@ -248,7 +248,7 @@ SUBROUTINE print_thermal_regions_temperature(thermal_regions, itimes, time, pos, DO ireg = 1, nregions temp(ireg) = thermal_regions%thermal_region(ireg)%temperature END DO - fmd = "(I10,F20.3,"//TRIM(ADJUSTL(cp_to_string(nregions+1)))//"F20.6)" + fmd = "(I10,F20.3,"//TRIM(ADJUSTL(cp_to_string(nregions + 1)))//"F20.6)" fmd = TRIM(fmd) WRITE (UNIT=unit, FMT=fmd) itimes, time, temp(0:nregions) DEALLOCATE (temp) diff --git a/src/motion/thermostat/al_system_dynamics.F b/src/motion/thermostat/al_system_dynamics.F index 22f2a5973d..d6575a2e8a 100644 --- a/src/motion/thermostat/al_system_dynamics.F +++ b/src/motion/thermostat/al_system_dynamics.F @@ -200,7 +200,7 @@ SUBROUTINE al_OU_step(step, al, force_env, map_info, molecule_kind_set, molecule ! drag on velocities IF (al%tau_langevin > 0.0_dp) THEN map_info%v_scale(imap) = EXP(-step*al%dt/al%tau_langevin) - map_info%s_kin(imap) = SQRT((al%nvt(i)%nkt/al%nvt(i)%degrees_of_freedom)*(1.0_dp-map_info%v_scale(imap)**2)) + map_info%s_kin(imap) = SQRT((al%nvt(i)%nkt/al%nvt(i)%degrees_of_freedom)*(1.0_dp - map_info%v_scale(imap)**2)) ELSE map_info%v_scale(imap) = 1.0_dp map_info%s_kin(imap) = 0.0_dp @@ -239,14 +239,14 @@ SUBROUTINE al_OU_step(step, al, force_env, map_info, molecule_kind_set, molecule molecule => molecule_set(imol) CALL get_molecule(molecule, first_atom=first_atom, last_atom=last_atom) DO ipart = first_atom, last_atom - ii = ii+1 + ii = ii + 1 atomic_kind => particle_set(ipart)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) IF (present_vel) THEN - vel(:, ipart) = vel(:, ipart)*map_info%v_scale(ii)+ & + vel(:, ipart) = vel(:, ipart)*map_info%v_scale(ii) + & map_info%s_kin(ii)/SQRT(mass)*w(:, ipart) ELSE - particle_set(ipart)%v(:) = particle_set(ipart)%v(:)*map_info%v_scale(ii)+ & + particle_set(ipart)%v(:) = particle_set(ipart)%v(:)*map_info%v_scale(ii) + & map_info%s_kin(ii)/SQRT(mass)*w(:, ipart) ENDIF END DO @@ -280,8 +280,8 @@ SUBROUTINE al_NH_quarter_step(al, map_info, set_half_step_vel_factors) DO i = 1, al%loc_num_al IF (al%nvt(i)%mass > 0.0_dp) THEN imap = map_info%map_index(i) - delta_K = 0.5_dp*(map_info%s_kin(imap)-al%nvt(i)%nkt) - al%nvt(i)%chi = al%nvt(i)%chi+0.5_dp*al%dt*delta_K/al%nvt(i)%mass + delta_K = 0.5_dp*(map_info%s_kin(imap) - al%nvt(i)%nkt) + al%nvt(i)%chi = al%nvt(i)%chi + 0.5_dp*al%dt*delta_K/al%nvt(i)%mass IF (set_half_step_vel_factors) THEN decay = EXP(-0.5_dp*al%dt*al%nvt(i)%chi) map_info%v_scale(imap) = decay diff --git a/src/motion/thermostat/al_system_mapping.F b/src/motion/thermostat/al_system_mapping.F index e84839e88a..6637c3cfa9 100644 --- a/src/motion/thermostat/al_system_mapping.F +++ b/src/motion/thermostat/al_system_mapping.F @@ -91,7 +91,7 @@ SUBROUTINE al_to_particle_mapping(thermostat_info, simpar, local_molecules, & map_info%s_kin = 0.0_dp DO i = 1, 3 DO j = 1, natoms_local - map_info%p_kin(i, j)%point = map_info%p_kin(i, j)%point+1 + map_info%p_kin(i, j)%point = map_info%p_kin(i, j)%point + 1 END DO END DO @@ -101,7 +101,7 @@ SUBROUTINE al_to_particle_mapping(thermostat_info, simpar, local_molecules, & ! We know the total number of system thermostats. IF ((sum_of_thermostats == 1) .AND. (map_info%dis_type /= do_thermo_no_communication)) THEN - fac = map_info%s_kin(1)-deg_of_freedom(1)-simpar%nfree_rot_transl + fac = map_info%s_kin(1) - deg_of_freedom(1) - simpar%nfree_rot_transl IF (fac == 0.0_dp) THEN CPABORT('Zero degrees of freedom. Nothing to thermalize!') END IF @@ -110,7 +110,7 @@ SUBROUTINE al_to_particle_mapping(thermostat_info, simpar, local_molecules, & ELSE DO i = 1, al%loc_num_al imap = map_info%map_index(i) - fac = (map_info%s_kin(imap)-deg_of_freedom(i)) + fac = (map_info%s_kin(imap) - deg_of_freedom(i)) al%nvt(i)%nkt = simpar%temp_ext*fac al%nvt(i)%degrees_of_freedom = FLOOR(fac) END DO diff --git a/src/motion/thermostat/barostat_types.F b/src/motion/thermostat/barostat_types.F index 94e52bc4f4..1e165a7603 100644 --- a/src/motion/thermostat/barostat_types.F +++ b/src/motion/thermostat/barostat_types.F @@ -99,7 +99,7 @@ SUBROUTINE create_barostat_type(barostat, md_section, force_env, simpar, & simpar%ensemble == nph_uniaxial_ensemble .OR. & simpar%ensemble == nph_uniaxial_damped_ensemble) THEN ALLOCATE (barostat) - last_barostat_id_nr = last_barostat_id_nr+1 + last_barostat_id_nr = last_barostat_id_nr + 1 barostat%id_nr = last_barostat_id_nr barostat%ref_count = 1 barostat%section => barostat_section @@ -148,7 +148,7 @@ SUBROUTINE retain_barostat_type(barostat) IF (ASSOCIATED(barostat)) THEN CPASSERT(barostat%ref_count > 0) - barostat%ref_count = barostat%ref_count+1 + barostat%ref_count = barostat%ref_count + 1 END IF END SUBROUTINE retain_barostat_type @@ -170,7 +170,7 @@ SUBROUTINE release_barostat_type(barostat) IF (ASSOCIATED(barostat)) THEN check = barostat%ref_count > 0 CPASSERT(check) - barostat%ref_count = barostat%ref_count-1 + barostat%ref_count = barostat%ref_count - 1 IF (barostat%ref_count < 1) THEN IF (ASSOCIATED(barostat%npt)) THEN DEALLOCATE (barostat%npt) diff --git a/src/motion/thermostat/barostat_utils.F b/src/motion/thermostat/barostat_utils.F index 9cd28ad5ab..372db873db 100644 --- a/src/motion/thermostat/barostat_utils.F +++ b/src/motion/thermostat/barostat_utils.F @@ -71,7 +71,7 @@ SUBROUTINE get_baro_energies(cell, simpar, npt, baro_kin, baro_pot) baro_kin = 0.0_dp DO i = 1, 3 DO j = 1, 3 - baro_kin = baro_kin+0.5_dp*npt(i, j)%v**2*npt(i, j)%mass + baro_kin = baro_kin + 0.5_dp*npt(i, j)%v**2*npt(i, j)%mass END DO END DO ELSEIF (simpar%ensemble == nph_uniaxial_ensemble .OR. simpar%ensemble == nph_uniaxial_damped_ensemble) THEN @@ -80,7 +80,7 @@ SUBROUTINE get_baro_energies(cell, simpar, npt, baro_kin, baro_pot) v_shock = simpar%v_shock ! Valid only for orthorhombic cell - baro_pot = -0.5_dp*v_shock*v_shock*(1._dp-cell%deth*iv0)**2-simpar%p0*(v0-cell%deth) + baro_pot = -0.5_dp*v_shock*v_shock*(1._dp - cell%deth*iv0)**2 - simpar%p0*(v0 - cell%deth) ! Valid only for orthorhombic cell baro_kin = 0.5_dp*npt(1, 1)%v*npt(1, 1)%v*npt(1, 1)%mass END IF diff --git a/src/motion/thermostat/csvr_system_dynamics.F b/src/motion/thermostat/csvr_system_dynamics.F index fa93b015d4..a2daa88fb4 100644 --- a/src/motion/thermostat/csvr_system_dynamics.F +++ b/src/motion/thermostat/csvr_system_dynamics.F @@ -251,8 +251,8 @@ SUBROUTINE do_csvr_eval_energy(csvr, map_info) imap = map_info%map_index(i) kin_energy_br = csvr%nvt(i)%region_kin_energy kin_energy_ar = map_info%s_kin(imap) - csvr%nvt(i)%thermostat_energy = csvr%nvt(i)%thermostat_energy+ & - 0.5_dp*(kin_energy_br-kin_energy_ar) + csvr%nvt(i)%thermostat_energy = csvr%nvt(i)%thermostat_energy + & + 0.5_dp*(kin_energy_br - kin_energy_ar) END DO END SUBROUTINE do_csvr_eval_energy diff --git a/src/motion/thermostat/csvr_system_mapping.F b/src/motion/thermostat/csvr_system_mapping.F index 17644a6f1c..f39f802559 100644 --- a/src/motion/thermostat/csvr_system_mapping.F +++ b/src/motion/thermostat/csvr_system_mapping.F @@ -144,7 +144,7 @@ SUBROUTINE csvr_to_particle_mapping(thermostat_info, simpar, local_molecules, & map_info%s_kin = 0.0_dp DO i = 1, 3 DO j = 1, natoms_local - map_info%p_kin(i, j)%point = map_info%p_kin(i, j)%point+1 + map_info%p_kin(i, j)%point = map_info%p_kin(i, j)%point + 1 END DO END DO @@ -154,7 +154,7 @@ SUBROUTINE csvr_to_particle_mapping(thermostat_info, simpar, local_molecules, & ! We know the total number of system thermostats. IF ((sum_of_thermostats == 1) .AND. (map_info%dis_type /= do_thermo_no_communication)) THEN - fac = map_info%s_kin(1)-deg_of_freedom(1)-simpar%nfree_rot_transl + fac = map_info%s_kin(1) - deg_of_freedom(1) - simpar%nfree_rot_transl IF (fac == 0.0_dp) THEN CPABORT('Zero degrees of freedom. Nothing to thermalize!') END IF @@ -163,7 +163,7 @@ SUBROUTINE csvr_to_particle_mapping(thermostat_info, simpar, local_molecules, & ELSE DO i = 1, csvr%loc_num_csvr imap = map_info%map_index(i) - fac = (map_info%s_kin(imap)-deg_of_freedom(i)) + fac = (map_info%s_kin(imap) - deg_of_freedom(i)) csvr%nvt(i)%nkt = simpar%temp_ext*fac csvr%nvt(i)%degrees_of_freedom = FLOOR(fac) END DO @@ -290,7 +290,7 @@ SUBROUTINE csvr_to_shell_mapping(thermostat_info, simpar, local_molecules, & map_info%s_kin = 0.0_dp DO j = 1, nshell_local DO i = 1, 3 - map_info%p_kin(i, j)%point = map_info%p_kin(i, j)%point+1 + map_info%p_kin(i, j)%point = map_info%p_kin(i, j)%point + 1 END DO END DO diff --git a/src/motion/thermostat/extended_system_dynamics.F b/src/motion/thermostat/extended_system_dynamics.F index 68ae231204..5e576817a7 100644 --- a/src/motion/thermostat/extended_system_dynamics.F +++ b/src/motion/thermostat/extended_system_dynamics.F @@ -211,7 +211,7 @@ SUBROUTINE do_nhc(nhc, map_info) DO n = 1, nhc%loc_num_nhc imap = nhc%map_info%map_index(n) IF (nhc%nvt(1, n)%nkt == 0.0_dp) CYCLE - nhc%nvt(1, n)%f = (map_info%s_kin(imap)-nhc%nvt(1, n)%nkt)/nhc%nvt(1, n)%mass + nhc%nvt(1, n)%f = (map_info%s_kin(imap) - nhc%nvt(1, n)%nkt)/nhc%nvt(1, n)%mass END DO ! Perform multiple time stepping using Yoshida @@ -266,12 +266,12 @@ SUBROUTINE shell_scale_comv(atomic_kind_set, local_particles, particle_set, & shell_index = particle_set(iparticle)%shell_index vs(1:3) = shell_vel(1:3, shell_index) vc(1:3) = core_vel(1:3, shell_index) - shell_vel(1, shell_index) = com_vel(1, iparticle)+fac_massc*(vs(1)-vc(1)) - shell_vel(2, shell_index) = com_vel(2, iparticle)+fac_massc*(vs(2)-vc(2)) - shell_vel(3, shell_index) = com_vel(3, iparticle)+fac_massc*(vs(3)-vc(3)) - core_vel(1, shell_index) = com_vel(1, iparticle)+fac_masss*(vc(1)-vs(1)) - core_vel(2, shell_index) = com_vel(2, iparticle)+fac_masss*(vc(2)-vs(2)) - core_vel(3, shell_index) = com_vel(3, iparticle)+fac_masss*(vc(3)-vs(3)) + shell_vel(1, shell_index) = com_vel(1, iparticle) + fac_massc*(vs(1) - vc(1)) + shell_vel(2, shell_index) = com_vel(2, iparticle) + fac_massc*(vs(2) - vc(2)) + shell_vel(3, shell_index) = com_vel(3, iparticle) + fac_massc*(vs(3) - vc(3)) + core_vel(1, shell_index) = com_vel(1, iparticle) + fac_masss*(vc(1) - vs(1)) + core_vel(2, shell_index) = com_vel(2, iparticle) + fac_masss*(vc(2) - vs(2)) + core_vel(3, shell_index) = com_vel(3, iparticle) + fac_masss*(vc(3) - vs(3)) END DO END IF ! is_shell END DO ! iparticle_kind @@ -303,16 +303,16 @@ SUBROUTINE multiple_step_yoshida(nhc) YOSH: DO iyosh = 1, nhc%nyosh ! update velocity on the last thermostat in the chain ! O1 - nhc%nvt(nhc%nhc_len, :)%v = nhc%nvt(nhc%nhc_len, :)%v+ & + nhc%nvt(nhc%nhc_len, :)%v = nhc%nvt(nhc%nhc_len, :)%v + & nhc%nvt(nhc%nhc_len, :)%f*0.25_dp*nhc%dt_yosh(iyosh)*nhc%dt_fact ! update velocity of other thermostats on chain (from nhc_len-1 to 1) ! O2 DO n = 1, nhc%loc_num_nhc IF (nhc%nvt(1, n)%nkt == 0.0_dp) CYCLE - DO inhc = nhc%nhc_len-1, 1, -1 - scale = EXP(-0.125_dp*nhc%nvt(inhc+1, n)%v*nhc%dt_yosh(iyosh)*nhc%dt_fact) + DO inhc = nhc%nhc_len - 1, 1, -1 + scale = EXP(-0.125_dp*nhc%nvt(inhc + 1, n)%v*nhc%dt_yosh(iyosh)*nhc%dt_fact) nhc%nvt(inhc, n)%v = nhc%nvt(inhc, n)%v*scale ! scale - nhc%nvt(inhc, n)%v = nhc%nvt(inhc, n)%v+ & + nhc%nvt(inhc, n)%v = nhc%nvt(inhc, n)%v + & nhc%nvt(inhc, n)%f*0.25_dp*nhc%dt_yosh(iyosh)*nhc%dt_fact ! shift nhc%nvt(inhc, n)%v = nhc%nvt(inhc, n)%v*scale ! scale END DO @@ -320,7 +320,7 @@ SUBROUTINE multiple_step_yoshida(nhc) ! the core of the operator ----- START------ ! update nhc positions - nhc%nvt(:, :)%eta = nhc%nvt(:, :)%eta+ & + nhc%nvt(:, :)%eta = nhc%nvt(:, :)%eta + & 0.5_dp*nhc%nvt(:, :)%v*nhc%dt_yosh(iyosh)*nhc%dt_fact ! now accumulate the scale factor for particle velocities @@ -336,16 +336,16 @@ SUBROUTINE multiple_step_yoshida(nhc) imap = nhc%map_info%map_index(n) IF (nhc%nvt(1, n)%nkt == 0.0_dp) CYCLE nhc%nvt(1, n)%f = (map_info%s_kin(imap)*map_info%v_scale(imap)* & - map_info%v_scale(imap)-nhc%nvt(1, n)%nkt)/nhc%nvt(1, n)%mass + map_info%v_scale(imap) - nhc%nvt(1, n)%nkt)/nhc%nvt(1, n)%mass END DO ! update velocity of other thermostats on chain (from 1 to nhc_len-1) ! O2 - DO inhc = 1, nhc%nhc_len-1 + DO inhc = 1, nhc%nhc_len - 1 DO n = 1, nhc%loc_num_nhc IF (nhc%nvt(1, n)%nkt == 0.0_dp) CYCLE - scale = EXP(-0.125_dp*nhc%nvt(inhc+1, n)%v*nhc%dt_yosh(iyosh)*nhc%dt_fact) + scale = EXP(-0.125_dp*nhc%nvt(inhc + 1, n)%v*nhc%dt_yosh(iyosh)*nhc%dt_fact) nhc%nvt(inhc, n)%v = nhc%nvt(inhc, n)%v*scale ! scale - nhc%nvt(inhc, n)%v = nhc%nvt(inhc, n)%v+ & + nhc%nvt(inhc, n)%v = nhc%nvt(inhc, n)%v + & nhc%nvt(inhc, n)%f*0.25_dp*nhc%dt_yosh(iyosh)*nhc%dt_fact ! shift nhc%nvt(inhc, n)%v = nhc%nvt(inhc, n)%v*scale ! scale END DO @@ -353,12 +353,12 @@ SUBROUTINE multiple_step_yoshida(nhc) ! updating the forces on all the thermostats DO n = 1, nhc%loc_num_nhc IF (nhc%nvt(1, n)%nkt == 0.0_dp) CYCLE - nhc%nvt(inhc+1, n)%f = (nhc%nvt(inhc, n)%mass*nhc%nvt(inhc, n)%v & - *nhc%nvt(inhc, n)%v-nhc%nvt(inhc+1, n)%nkt)/nhc%nvt(inhc+1, n)%mass + nhc%nvt(inhc + 1, n)%f = (nhc%nvt(inhc, n)%mass*nhc%nvt(inhc, n)%v & + *nhc%nvt(inhc, n)%v - nhc%nvt(inhc + 1, n)%nkt)/nhc%nvt(inhc + 1, n)%mass END DO END DO ! update velocity on last thermostat ! O1 - nhc%nvt(nhc%nhc_len, :)%v = nhc%nvt(nhc%nhc_len, :)%v+ & + nhc%nvt(nhc%nhc_len, :)%v = nhc%nvt(nhc%nhc_len, :)%v + & nhc%nvt(nhc%nhc_len, :)%f*0.25_dp*nhc%dt_yosh(iyosh)*nhc%dt_fact END DO YOSH END DO NCLOOP diff --git a/src/motion/thermostat/extended_system_init.F b/src/motion/thermostat/extended_system_init.F index 5d2e9edd67..6b0ba2f239 100644 --- a/src/motion/thermostat/extended_system_init.F +++ b/src/motion/thermostat/extended_system_init.F @@ -135,7 +135,7 @@ SUBROUTINE initialize_npt(simpar, globenv, npt_info, cell, work_section) ind = 0 DO i = 1, SIZE(npt_info, 1) DO j = 1, SIZE(npt_info, 2) - ind = ind+1 + ind = ind + 1 npt_info(i, j)%v = buffer(ind) END DO END DO @@ -143,7 +143,7 @@ SUBROUTINE initialize_npt(simpar, globenv, npt_info, cell, work_section) ind = 0 DO i = 1, SIZE(npt_info, 1) DO j = 1, SIZE(npt_info, 2) - ind = ind+1 + ind = ind + 1 npt_info(i, j)%mass = buffer(ind) END DO END DO @@ -514,20 +514,20 @@ SUBROUTINE set_yoshida_coef(nhc, dt) CASE (1) yosh_wt(1) = 1.0_dp CASE (3) - yosh_wt(1) = 1.0_dp/(2.0_dp-(2.0_dp)**(1.0_dp/3.0_dp)) - yosh_wt(2) = 1.0_dp-2.0_dp*yosh_wt(1) + yosh_wt(1) = 1.0_dp/(2.0_dp - (2.0_dp)**(1.0_dp/3.0_dp)) + yosh_wt(2) = 1.0_dp - 2.0_dp*yosh_wt(1) yosh_wt(3) = yosh_wt(1) CASE (5) - yosh_wt(1) = 1.0_dp/(4.0_dp-(4.0_dp)**(1.0_dp/3.0_dp)) + yosh_wt(1) = 1.0_dp/(4.0_dp - (4.0_dp)**(1.0_dp/3.0_dp)) yosh_wt(2) = yosh_wt(1) yosh_wt(4) = yosh_wt(1) yosh_wt(5) = yosh_wt(1) - yosh_wt(3) = 1.0_dp-4.0_dp*yosh_wt(1) + yosh_wt(3) = 1.0_dp - 4.0_dp*yosh_wt(1) CASE (7) yosh_wt(1) = .78451361047756_dp yosh_wt(2) = .235573213359357_dp yosh_wt(3) = -1.17767998417887_dp - yosh_wt(4) = 1.0_dp-2.0_dp*(yosh_wt(1)+yosh_wt(2)+yosh_wt(3)) + yosh_wt(4) = 1.0_dp - 2.0_dp*(yosh_wt(1) + yosh_wt(2) + yosh_wt(3)) yosh_wt(5) = yosh_wt(3) yosh_wt(6) = yosh_wt(2) yosh_wt(7) = yosh_wt(1) @@ -536,8 +536,8 @@ SUBROUTINE set_yoshida_coef(nhc, dt) yosh_wt(2) = 0.554910818409783619692725006662999_dp yosh_wt(3) = 0.124659619941888644216504240951585_dp yosh_wt(4) = -0.843182063596933505315033808282941_dp - yosh_wt(5) = 1.0_dp-2.0_dp*(yosh_wt(1)+yosh_wt(2)+ & - yosh_wt(3)+yosh_wt(4)) + yosh_wt(5) = 1.0_dp - 2.0_dp*(yosh_wt(1) + yosh_wt(2) + & + yosh_wt(3) + yosh_wt(4)) yosh_wt(6) = yosh_wt(4) yosh_wt(7) = yosh_wt(3) yosh_wt(8) = yosh_wt(2) @@ -550,8 +550,8 @@ SUBROUTINE set_yoshida_coef(nhc, dt) yosh_wt(5) = -0.144485223686048e1_dp yosh_wt(6) = 0.253693336566229_dp yosh_wt(7) = 0.914844246229740_dp - yosh_wt(8) = 1.0_dp-2.0_dp*(yosh_wt(1)+yosh_wt(2)+ & - yosh_wt(3)+yosh_wt(4)+yosh_wt(5)+yosh_wt(6)+yosh_wt(7)) + yosh_wt(8) = 1.0_dp - 2.0_dp*(yosh_wt(1) + yosh_wt(2) + & + yosh_wt(3) + yosh_wt(4) + yosh_wt(5) + yosh_wt(6) + yosh_wt(7)) yosh_wt(9) = yosh_wt(7) yosh_wt(10) = yosh_wt(6) yosh_wt(11) = yosh_wt(5) @@ -645,36 +645,36 @@ SUBROUTINE restart_nose(nhc, nose_section, save_mem, restart, & CALL section_vals_val_get(nose_section, "COORD%_DEFAULT_KEYWORD_", r_vals=buffer) DO i = 1, SIZE(nhc%nvt, 2) ind = map_info%index(i) - ind = (ind-1)*nhc%nhc_len + ind = (ind - 1)*nhc%nhc_len DO j = 1, SIZE(nhc%nvt, 1) - ind = ind+1 + ind = ind + 1 nhc%nvt(j, i)%eta = buffer(ind) END DO END DO CALL section_vals_val_get(nose_section, "VELOCITY%_DEFAULT_KEYWORD_", r_vals=buffer) DO i = 1, SIZE(nhc%nvt, 2) ind = map_info%index(i) - ind = (ind-1)*nhc%nhc_len + ind = (ind - 1)*nhc%nhc_len DO j = 1, SIZE(nhc%nvt, 1) - ind = ind+1 + ind = ind + 1 nhc%nvt(j, i)%v = buffer(ind) END DO END DO CALL section_vals_val_get(nose_section, "MASS%_DEFAULT_KEYWORD_", r_vals=buffer) DO i = 1, SIZE(nhc%nvt, 2) ind = map_info%index(i) - ind = (ind-1)*nhc%nhc_len + ind = (ind - 1)*nhc%nhc_len DO j = 1, SIZE(nhc%nvt, 1) - ind = ind+1 + ind = ind + 1 nhc%nvt(j, i)%mass = buffer(ind) END DO END DO CALL section_vals_val_get(nose_section, "FORCE%_DEFAULT_KEYWORD_", r_vals=buffer) DO i = 1, SIZE(nhc%nvt, 2) ind = map_info%index(i) - ind = (ind-1)*nhc%nhc_len + ind = (ind - 1)*nhc%nhc_len DO j = 1, SIZE(nhc%nvt, 1) - ind = ind+1 + ind = ind + 1 nhc%nvt(j, i)%f = buffer(ind) END DO END DO @@ -757,9 +757,9 @@ SUBROUTINE init_nhc_variables(nhc, temp_ext, para_env, globenv) akin = 0.0_dp DO i = 1, nhc%loc_num_nhc DO j = 1, nhc%nhc_len - akin = akin+0.5_dp*(nhc%nvt(j, i)%mass* & - nhc%nvt(j, i)%v* & - nhc%nvt(j, i)%v) + akin = akin + 0.5_dp*(nhc%nvt(j, i)%mass* & + nhc%nvt(j, i)%v* & + nhc%nvt(j, i)%v) END DO END DO number = nhc%loc_num_nhc @@ -777,8 +777,8 @@ SUBROUTINE init_nhc_variables(nhc, temp_ext, para_env, globenv) ! initializing all of the forces on the thermostats DO i = 1, nhc%loc_num_nhc DO j = 2, nhc%nhc_len - nhc%nvt(j, i)%f = nhc%nvt(j-1, i)%mass*nhc%nvt(j-1, i)%v* & - nhc%nvt(j-1, i)%v-nhc%nvt(j, i)%nkt + nhc%nvt(j, i)%f = nhc%nvt(j - 1, i)%mass*nhc%nvt(j - 1, i)%v* & + nhc%nvt(j - 1, i)%v - nhc%nvt(j, i)%nkt IF (nhc%nvt(j, i)%mass > 0.0_dp) THEN nhc%nvt(j, i)%f = nhc%nvt(j, i)%f/nhc%nvt(j, i)%mass END IF @@ -792,9 +792,9 @@ SUBROUTINE init_nhc_variables(nhc, temp_ext, para_env, globenv) ! Map deterministically determined random number to nhc % v DO i = 1, nhc%loc_num_nhc icount = map_info%index(i) - icount = (icount-1)*nhc%nhc_len + icount = (icount - 1)*nhc%nhc_len DO j = 1, nhc%nhc_len - icount = icount+1 + icount = icount + 1 nhc%nvt(j, i)%v = array_of_rn(icount) ! WRITE ( *, * ) 'VEL', para_env%mepos, i,j, nhc%nvt(j,i)%v nhc%nvt(j, i)%eta = 0.0_dp @@ -817,8 +817,8 @@ SUBROUTINE init_nhc_variables(nhc, temp_ext, para_env, globenv) ! initializing all of the forces on the thermostats DO i = 1, nhc%loc_num_nhc DO j = 2, nhc%nhc_len - nhc%nvt(j, i)%f = nhc%nvt(j-1, i)%mass*nhc%nvt(j-1, i)%v* & - nhc%nvt(j-1, i)%v-nhc%nvt(j, i)%nkt + nhc%nvt(j, i)%f = nhc%nvt(j - 1, i)%mass*nhc%nvt(j - 1, i)%v* & + nhc%nvt(j - 1, i)%v - nhc%nvt(j, i)%nkt IF (nhc%nvt(j, i)%mass > 0.0_dp) THEN nhc%nvt(j, i)%f = nhc%nvt(j, i)%f/nhc%nvt(j, i)%mass END IF @@ -871,15 +871,15 @@ SUBROUTINE init_barostat_variables(npt, tau_cell, temp_ext, nfree, ensemble, & npt(:, :)%f = 0.0_dp SELECT CASE (ensemble) CASE (npt_i_ensemble) - npt(:, :)%mass = REAL(nfree+3, KIND=dp)*temp_ext*tau_cell**2 + npt(:, :)%mass = REAL(nfree + 3, KIND=dp)*temp_ext*tau_cell**2 CASE (npt_f_ensemble) - npt(:, :)%mass = REAL(nfree+3, KIND=dp)*temp_ext*tau_cell**2/3.0_dp + npt(:, :)%mass = REAL(nfree + 3, KIND=dp)*temp_ext*tau_cell**2/3.0_dp CASE (nph_uniaxial_ensemble, nph_uniaxial_damped_ensemble) npt(:, :)%mass = cmass CASE (npe_f_ensemble) - npt(:, :)%mass = REAL(nfree+3, KIND=dp)*temp_ext*tau_cell**2/3.0_dp + npt(:, :)%mass = REAL(nfree + 3, KIND=dp)*temp_ext*tau_cell**2/3.0_dp CASE (npe_i_ensemble) - npt(:, :)%mass = REAL(nfree+3, KIND=dp)*temp_ext*tau_cell**2 + npt(:, :)%mass = REAL(nfree + 3, KIND=dp)*temp_ext*tau_cell**2 END SELECT ! initializing velocities DO i = 1, SIZE(npt, 1) @@ -895,7 +895,7 @@ SUBROUTINE init_barostat_variables(npt, tau_cell, temp_ext, nfree, ensemble, & akin = 0.0_dp DO i = 1, SIZE(npt, 1) DO j = 1, SIZE(npt, 2) - akin = akin+0.5_dp*(npt(j, i)%mass*npt(j, i)%v*npt(j, i)%v) + akin = akin + 0.5_dp*(npt(j, i)%mass*npt(j, i)%v*npt(j, i)%v) END DO END DO @@ -949,8 +949,8 @@ SUBROUTINE init_nhc_forces(nhc) ! assign the forces DO i = 1, SIZE(nhc%nvt, 2) DO j = 2, SIZE(nhc%nvt, 1) - nhc%nvt(j, i)%f = nhc%nvt(j-1, i)%mass* & - nhc%nvt(j-1, i)%v**2- & + nhc%nvt(j, i)%f = nhc%nvt(j - 1, i)%mass* & + nhc%nvt(j - 1, i)%v**2 - & nhc%nvt(j, i)%nkt IF (nhc%nvt(j, i)%mass > 0.0_dp) THEN nhc%nvt(j, i)%f = nhc%nvt(j, i)%f/nhc%nvt(j, i)%mass diff --git a/src/motion/thermostat/extended_system_mapping.F b/src/motion/thermostat/extended_system_mapping.F index 64dd279216..7a0a87853d 100644 --- a/src/motion/thermostat/extended_system_mapping.F +++ b/src/motion/thermostat/extended_system_mapping.F @@ -172,7 +172,7 @@ SUBROUTINE nhc_to_particle_mapping(thermostat_info, simpar, local_molecules, & map_info%s_kin = 0.0_dp DO i = 1, 3 DO j = 1, natoms_local - map_info%p_kin(i, j)%point = map_info%p_kin(i, j)%point+1 + map_info%p_kin(i, j)%point = map_info%p_kin(i, j)%point + 1 END DO END DO @@ -182,7 +182,7 @@ SUBROUTINE nhc_to_particle_mapping(thermostat_info, simpar, local_molecules, & ! We know the total number of system thermostats. IF ((sum_of_thermostats == 1) .AND. (map_info%dis_type /= do_thermo_no_communication)) THEN - fac = map_info%s_kin(1)-deg_of_freedom(1)-simpar%nfree_rot_transl + fac = map_info%s_kin(1) - deg_of_freedom(1) - simpar%nfree_rot_transl IF (fac == 0.0_dp) THEN CPABORT('Zero degrees of freedom. Nothing to thermalize!') END IF @@ -191,7 +191,7 @@ SUBROUTINE nhc_to_particle_mapping(thermostat_info, simpar, local_molecules, & ELSE DO i = 1, nhc%loc_num_nhc imap = map_info%map_index(i) - fac = (map_info%s_kin(imap)-deg_of_freedom(i)) + fac = (map_info%s_kin(imap) - deg_of_freedom(i)) nhc%nvt(1, i)%nkt = simpar%temp_ext*fac nhc%nvt(1, i)%degrees_of_freedom = FLOOR(fac) END DO @@ -337,7 +337,7 @@ SUBROUTINE nhc_to_particle_mapping_slow(thermostat_info, simpar, local_molecules DO i = 1, 3 DO j = 1, natoms_local IF (ASSOCIATED(map_info%p_kin(i, j)%point)) & - map_info%p_kin(i, j)%point = map_info%p_kin(i, j)%point+1 + map_info%p_kin(i, j)%point = map_info%p_kin(i, j)%point + 1 END DO END DO @@ -347,7 +347,7 @@ SUBROUTINE nhc_to_particle_mapping_slow(thermostat_info, simpar, local_molecules ! We know the total number of system thermostats. IF ((sum_of_thermostats == 1) .AND. (map_info%dis_type /= do_thermo_no_communication)) THEN - fac = map_info%s_kin(1)-deg_of_freedom(1)-simpar%nfree_rot_transl + fac = map_info%s_kin(1) - deg_of_freedom(1) - simpar%nfree_rot_transl IF (fac == 0.0_dp) THEN CPABORT('Zero degrees of freedom. Nothing to thermalize!') END IF @@ -356,7 +356,7 @@ SUBROUTINE nhc_to_particle_mapping_slow(thermostat_info, simpar, local_molecules ELSE DO i = 1, nhc%loc_num_nhc imap = map_info%map_index(i) - fac = (map_info%s_kin(imap)-deg_of_freedom(i)) + fac = (map_info%s_kin(imap) - deg_of_freedom(i)) nhc%nvt(1, i)%nkt = simpar%temp_slow*fac nhc%nvt(1, i)%degrees_of_freedom = FLOOR(fac) END DO @@ -433,7 +433,7 @@ SUBROUTINE nhc_to_particle_mapping_fast(thermostat_info, simpar, local_molecules DO i = 1, 3 DO j = 1, natoms_local IF (ASSOCIATED(map_info%p_kin(i, j)%point)) & - map_info%p_kin(i, j)%point = map_info%p_kin(i, j)%point+1 + map_info%p_kin(i, j)%point = map_info%p_kin(i, j)%point + 1 END DO END DO @@ -443,7 +443,7 @@ SUBROUTINE nhc_to_particle_mapping_fast(thermostat_info, simpar, local_molecules ! We know the total number of system thermostats. IF ((sum_of_thermostats == 1) .AND. (map_info%dis_type /= do_thermo_no_communication)) THEN - fac = map_info%s_kin(1)-deg_of_freedom(1)-simpar%nfree_rot_transl + fac = map_info%s_kin(1) - deg_of_freedom(1) - simpar%nfree_rot_transl IF (fac == 0.0_dp) THEN CPABORT('Zero degrees of freedom. Nothing to thermalize!') END IF @@ -452,7 +452,7 @@ SUBROUTINE nhc_to_particle_mapping_fast(thermostat_info, simpar, local_molecules ELSE DO i = 1, nhc%loc_num_nhc imap = map_info%map_index(i) - fac = (map_info%s_kin(imap)-deg_of_freedom(i)) + fac = (map_info%s_kin(imap) - deg_of_freedom(i)) nhc%nvt(1, i)%nkt = simpar%temp_fast*fac nhc%nvt(1, i)%degrees_of_freedom = FLOOR(fac) END DO @@ -599,7 +599,7 @@ SUBROUTINE nhc_to_shell_mapping(thermostat_info, simpar, local_molecules, & map_info%s_kin = 0.0_dp DO j = 1, nshell_local DO i = 1, 3 - map_info%p_kin(i, j)%point = map_info%p_kin(i, j)%point+1 + map_info%p_kin(i, j)%point = map_info%p_kin(i, j)%point + 1 END DO END DO diff --git a/src/motion/thermostat/gle_system_dynamics.F b/src/motion/thermostat/gle_system_dynamics.F index d41fbd7813..59dac6ac3a 100644 --- a/src/motion/thermostat/gle_system_dynamics.F +++ b/src/motion/thermostat/gle_system_dynamics.F @@ -159,8 +159,8 @@ SUBROUTINE gle_particles(gle, molecule_kind_set, molecule_set, particle_set, loc local_molecules, molecule_set, group, vel) DO ideg = 1, gle%loc_num_gle imap = gle%map_info%map_index(ideg) - gle%nvt(ideg)%thermostat_energy = gle%nvt(ideg)%thermostat_energy+ & - 0.5_dp*(gle%nvt(ideg)%kin_energy-map_info%s_kin(imap)) + gle%nvt(ideg)%thermostat_energy = gle%nvt(ideg)%thermostat_energy + & + 0.5_dp*(gle%nvt(ideg)%kin_energy - map_info%s_kin(imap)) END DO DEALLOCATE (e_tmp, s_tmp, h_tmp) @@ -217,7 +217,7 @@ SUBROUTINE initialize_gle_part(thermostat_info, simpar, local_molecules, & ! deterministic part of the propagator CALL gle_matrix_exp((-simpar%dt*0.5_dp)*gle%a_mat, gle%ndim, 15, 15, gle%gle_t) ! stochastic part - Mtmp = gle%c_mat-MATMUL(gle%gle_t, MATMUL(gle%c_mat, TRANSPOSE(gle%gle_t))) + Mtmp = gle%c_mat - MATMUL(gle%gle_t, MATMUL(gle%c_mat, TRANSPOSE(gle%gle_t))) CALL gle_cholesky_stab(Mtmp, gle%gle_s, gle%ndim) END SUBROUTINE initialize_gle_part @@ -240,25 +240,25 @@ SUBROUTINE gle_matrix_exp(M, n, j, k, EM) REAL(dp), INTENT(out) :: EM(n, n) INTEGER :: i, p - REAL(dp) :: SM(n, n), tc(j+1) + REAL(dp) :: SM(n, n), tc(j + 1) tc(1) = 1._dp DO i = 1, j - tc(i+1) = tc(i)/REAL(i, KIND=dp) + tc(i + 1) = tc(i)/REAL(i, KIND=dp) ENDDO !scale SM = M*(1._dp/2._dp**k) EM = 0._dp DO i = 1, n - EM(i, i) = tc(j+1) + EM(i, i) = tc(j + 1) ENDDO !taylor exp of scaled matrix DO p = j, 1, -1 EM = MATMUL(SM, EM) DO i = 1, n - EM(i, i) = EM(i, i)+tc(p) + EM(i, i) = EM(i, i) + tc(p) ENDDO ENDDO @@ -293,21 +293,21 @@ SUBROUTINE gle_cholesky_stab(SST, S, n) DO i = 1, n L(i, i) = 1.0_dp D(i) = SST(i, i) - DO j = 1, i-1 + DO j = 1, i - 1 L(i, j) = SST(i, j); - DO k = 1, j-1 - L(i, j) = L(i, j)-L(i, k)*L(j, k)*D(k) + DO k = 1, j - 1 + L(i, j) = L(i, j) - L(i, k)*L(j, k)*D(k) ENDDO IF (ABS(D(j)) > EPSILON(1.0_dp)) L(i, j) = L(i, j)/D(j) ENDDO - DO k = 1, i-1 - D(i) = D(i)-L(i, k)*L(i, k)*D(k) + DO k = 1, i - 1 + D(i) = D(i) - L(i, k)*L(i, k)*D(k) END DO ENDDO DO i = 1, n DO j = 1, i IF ((ABS(D(j)) > EPSILON(1.0_dp)) .AND. (D(j) > 0.0_dp)) THEN - S(i, j) = S(i, j)+L(i, j)*SQRT(D(j)) + S(i, j) = S(i, j) + L(i, j)*SQRT(D(j)) END IF ENDDO ENDDO @@ -384,7 +384,7 @@ SUBROUTINE gle_to_particle_mapping(thermostat_info, simpar, local_molecules, & map_info%s_kin = 0.0_dp DO i = 1, 3 DO j = 1, natoms_local - map_info%p_kin(i, j)%point = map_info%p_kin(i, j)%point+1 + map_info%p_kin(i, j)%point = map_info%p_kin(i, j)%point + 1 END DO END DO @@ -394,7 +394,7 @@ SUBROUTINE gle_to_particle_mapping(thermostat_info, simpar, local_molecules, & ! We know the total number of system thermostats. IF ((sum_of_thermostats == 1) .AND. (map_info%dis_type /= do_thermo_no_communication)) THEN - fac = map_info%s_kin(1)-deg_of_freedom(1)-simpar%nfree_rot_transl + fac = map_info%s_kin(1) - deg_of_freedom(1) - simpar%nfree_rot_transl IF (fac == 0.0_dp) THEN CPABORT("Zero degrees of freedom. Nothing to thermalize!") END IF @@ -403,7 +403,7 @@ SUBROUTINE gle_to_particle_mapping(thermostat_info, simpar, local_molecules, & ELSE DO i = 1, gle%loc_num_gle imap = map_info%map_index(i) - fac = (map_info%s_kin(imap)-deg_of_freedom(i)) + fac = (map_info%s_kin(imap) - deg_of_freedom(i)) gle%nvt(i)%nkt = simpar%temp_ext*fac gle%nvt(i)%degrees_of_freedom = FLOOR(fac) END DO @@ -453,9 +453,9 @@ SUBROUTINE restart_gle(gle, gle_section, save_mem, restart) CALL section_vals_val_get(gle_section, "S%_DEFAULT_KEYWORD_", r_vals=buffer) DO i = 1, SIZE(gle%nvt, 1) ind = map_info%index(i) - ind = (ind-1)*(gle%ndim) + ind = (ind - 1)*(gle%ndim) DO j = 1, SIZE(gle%nvt(i)%s, 1) - ind = ind+1 + ind = ind + 1 gle%nvt(i)%s(j) = buffer(ind) END DO END DO diff --git a/src/motion/thermostat/thermostat_mapping.F b/src/motion/thermostat/thermostat_mapping.F index a4cad9c4a5..aa1204af1a 100644 --- a/src/motion/thermostat/thermostat_mapping.F +++ b/src/motion/thermostat/thermostat_mapping.F @@ -202,7 +202,7 @@ SUBROUTINE adiabatic_mapping_region_low(region, map_info, nkind, point, & number = 0 ntherm = 0 nglob_cns = 0 - IF (global_constraints) nglob_cns = gci%ntot-gci%nrestraint + IF (global_constraints) nglob_cns = gci%ntot - gci%nrestraint IF (region == do_region_global) THEN ! Global Region check = (map_info%dis_type == do_thermo_communication) @@ -221,12 +221,12 @@ SUBROUTINE adiabatic_mapping_region_low(region, map_info, nkind, point, & END DO ENDIF END DO - deg_of_freedom(1) = deg_of_freedom(1)+tot_const(ikind) + deg_of_freedom(1) = deg_of_freedom(1) + tot_const(ikind) map_info%index(1) = 1 map_info%map_index(1) = 1 number = 1 END DO - deg_of_freedom(1) = deg_of_freedom(1)+nglob_cns + deg_of_freedom(1) = deg_of_freedom(1) + nglob_cns ELSE IF (region == do_region_molecule) THEN ! Molecular Region IF (map_info%dis_type == do_thermo_no_communication) THEN @@ -235,7 +235,7 @@ SUBROUTINE adiabatic_mapping_region_low(region, map_info, nkind, point, & nmol_local = local_molecules%n_el(ikind) DO imol_local = 1, nmol_local imol = local_molecules%list(ikind)%array(imol_local) - number = number+1 + number = number + 1 have_thermostat = .TRUE. ! determine if the local molecule belongs to a thermostat DO kk = point(1, number), point(2, number) @@ -251,7 +251,7 @@ SUBROUTINE adiabatic_mapping_region_low(region, map_info, nkind, point, & ! We can test to make sure all atoms in the local molecule belong to the same ! global thermostat as a way to detect errors. glob_therm_num = map_loc_thermo_gen(point(1, number)) - ntherm = ntherm+1 + ntherm = ntherm + 1 CALL reallocate(map_info%index, 1, ntherm) CALL reallocate(map_info%map_index, 1, ntherm) CALL reallocate(deg_of_freedom, 1, ntherm) @@ -279,11 +279,11 @@ SUBROUTINE adiabatic_mapping_region_low(region, map_info, nkind, point, & ! This case is quite rare and happens only when we have one molecular ! kind and one molecule.. CPASSERT(nkind == 1) - number = number+1 - ntherm = ntherm+1 + number = number + 1 + ntherm = ntherm + 1 map_info%index(ntherm) = ntherm map_info%map_index(ntherm) = ntherm - deg_of_freedom(ntherm) = deg_of_freedom(ntherm)+tot_const(nkind) + deg_of_freedom(ntherm) = deg_of_freedom(ntherm) + tot_const(nkind) DO kk = point(1, nkind), point(2, nkind) IF (map_loc_thermo_gen(kk) /= HUGE(0)) THEN DO jj = 1, 3 @@ -310,7 +310,7 @@ SUBROUTINE adiabatic_mapping_region_low(region, map_info, nkind, point, & DO ikind = 1, nkind nmol_local = local_molecules%n_el(ikind) DO imol_local = 1, nmol_local - icount = icount+1 + icount = icount + 1 imol = local_molecules%list(ikind)%array(imol_local) molecule => molecule_set(imol) CALL get_molecule(molecule, first_atom=first_atom, last_atom=last_atom, & @@ -335,14 +335,14 @@ SUBROUTINE adiabatic_mapping_region_low(region, map_info, nkind, point, & IF (have_thermostat) THEN DO ii = point(1, icount), point(2, icount) - ipart = first_atom+k + ipart = first_atom + k ielement = locate(massive_atom_list, ipart) - k = k+1 + k = k + 1 DO jj = 1, 3 - ntherm = ntherm+1 + ntherm = ntherm + 1 CALL reallocate(map_info%index, 1, ntherm) CALL reallocate(map_info%map_index, 1, ntherm) - map_info%index(ntherm) = (ielement-1)*3+jj + map_info%index(ntherm) = (ielement - 1)*3 + jj map_info%map_index(ntherm) = ntherm map_info%p_kin(jj, ii)%point => map_info%s_kin(ntherm) map_info%p_scale(jj, ii)%point => map_info%v_scale(ntherm) @@ -356,7 +356,7 @@ SUBROUTINE adiabatic_mapping_region_low(region, map_info, nkind, point, & END DO END DO END IF - IF (first_atom+k-1 /= last_atom) THEN + IF (first_atom + k - 1 /= last_atom) THEN CPABORT("Inconsistent mapping of particles") END IF END DO @@ -418,12 +418,12 @@ SUBROUTINE adiabatic_region_evaluate(dis_type, natoms_local, nmol_local, const_m CALL get_molecule_kind(molecule_kind, natom=natom, nshell=nshell) IF (shell) THEN IF (nshell /= 0) THEN - natoms_local = natoms_local+nshell*local_molecules%n_el(ikind) - nmol_local = nmol_local+local_molecules%n_el(ikind) + natoms_local = natoms_local + nshell*local_molecules%n_el(ikind) + nmol_local = nmol_local + local_molecules%n_el(ikind) END IF ELSE - natoms_local = natoms_local+natom*local_molecules%n_el(ikind) - nmol_local = nmol_local+local_molecules%n_el(ikind) + natoms_local = natoms_local + natom*local_molecules%n_el(ikind) + nmol_local = nmol_local + local_molecules%n_el(ikind) END IF END DO @@ -445,9 +445,9 @@ SUBROUTINE adiabatic_region_evaluate(dis_type, natoms_local, nmol_local, const_m fixd_list=fixd_list, nshell=nshell) IF (shell) natom = nshell DO imol_local = 1, nmol_per_kind - icount = icount+1 - point(1, icount) = atm_offset+1 - point(2, icount) = atm_offset+natom + icount = icount + 1 + point(1, icount) = atm_offset + 1 + point(2, icount) = atm_offset + natom IF (.NOT. shell) THEN ! nc keeps track of all constraints but not fixed ones.. ! Let's identify fixed atoms for this molecule @@ -460,19 +460,19 @@ SUBROUTINE adiabatic_region_evaluate(dis_type, natoms_local, nmol_local, const_m DO ilist = 1, SIZE(fixd_list) IF ((katom == fixd_list(ilist)%fixd) .AND. & (.NOT. fixd_list(ilist)%restraint%active)) THEN - SELECT CASE (fixd_list (ilist)%itype) + SELECT CASE (fixd_list(ilist)%itype) CASE (use_perd_x, use_perd_y, use_perd_z) - nfixd = nfixd+1 + nfixd = nfixd + 1 CASE (use_perd_xy, use_perd_xz, use_perd_yz) - nfixd = nfixd+2 + nfixd = nfixd + 2 CASE (use_perd_xyz) - nfixd = nfixd+3 + nfixd = nfixd + 3 END SELECT END IF END DO END DO END IF - const_mol(icount) = nc+nfixd + const_mol(icount) = nc + nfixd tot_const(icount) = const_mol(icount) END IF atm_offset = point(2, icount) @@ -495,10 +495,10 @@ SUBROUTINE adiabatic_region_evaluate(dis_type, natoms_local, nmol_local, const_m const_mol(ikind) = nc ! Let's consider the fixed atoms only for the total number of constraints ! in case we are in REPLICATED/INTERACTING thermostats - tot_const(ikind) = const_mol(ikind)*nmolecule+nfixd + tot_const(ikind) = const_mol(ikind)*nmolecule + nfixd END IF - point(1, ikind) = atm_offset+1 - point(2, ikind) = atm_offset+natom*nmol_per_kind + point(1, ikind) = atm_offset + 1 + point(2, ikind) = atm_offset + natom*nmol_per_kind atm_offset = point(2, ikind) END DO ENDIF @@ -653,7 +653,7 @@ SUBROUTINE thermostat_mapping_region_low(region, map_info, nkind, point, & icount = 0 number = 0 nglob_cns = 0 - IF (global_constraints) nglob_cns = gci%ntot-gci%nrestraint + IF (global_constraints) nglob_cns = gci%ntot - gci%nrestraint IF (region == do_region_global) THEN ! Global Region check = (map_info%dis_type == do_thermo_communication) @@ -665,12 +665,12 @@ SUBROUTINE thermostat_mapping_region_low(region, map_info, nkind, point, & map_info%p_scale(ii, jj)%point => map_info%v_scale(1) END DO END DO - deg_of_freedom(1) = deg_of_freedom(1)+tot_const(ikind) + deg_of_freedom(1) = deg_of_freedom(1) + tot_const(ikind) map_info%index(1) = 1 map_info%map_index(1) = 1 number = 1 END DO - deg_of_freedom(1) = deg_of_freedom(1)+nglob_cns + deg_of_freedom(1) = deg_of_freedom(1) + nglob_cns ELSE IF (region == do_region_defined) THEN ! User defined Region to thermostat check = (map_info%dis_type == do_thermo_communication) @@ -686,8 +686,8 @@ SUBROUTINE thermostat_mapping_region_low(region, map_info, nkind, point, & map_info%map_index(number) = tmp(1) deg_of_freedom(number) = tot_const(tmp(1)) DO i = 2, itmp - IF (tmp(i) /= tmp(i-1)) THEN - number = number+1 + IF (tmp(i) /= tmp(i - 1)) THEN + number = number + 1 map_info%index(number) = tmp(i) map_info%map_index(number) = tmp(i) deg_of_freedom(number) = tot_const(tmp(i)) @@ -714,7 +714,7 @@ SUBROUTINE thermostat_mapping_region_low(region, map_info, nkind, point, & nmol_local = local_molecules%n_el(ikind) DO imol_local = 1, nmol_local imol = local_molecules%list(ikind)%array(imol_local) - number = number+1 + number = number + 1 map_info%index(number) = imol map_info%map_index(number) = number deg_of_freedom(number) = const_mol(number) @@ -730,10 +730,10 @@ SUBROUTINE thermostat_mapping_region_low(region, map_info, nkind, point, & ! This case is quite rare and happens only when we have one molecular ! kind and one molecule.. CPASSERT(nkind == 1) - number = number+1 + number = number + 1 map_info%index(number) = number map_info%map_index(number) = number - deg_of_freedom(number) = deg_of_freedom(number)+tot_const(nkind) + deg_of_freedom(number) = deg_of_freedom(number) + tot_const(nkind) DO kk = point(1, nkind), point(2, nkind) DO jj = 1, 3 map_info%p_kin(jj, kk)%point => map_info%s_kin(number) @@ -753,7 +753,7 @@ SUBROUTINE thermostat_mapping_region_low(region, map_info, nkind, point, & DO ikind = 1, nkind nmol_local = local_molecules%n_el(ikind) DO imol_local = 1, nmol_local - icount = icount+1 + icount = icount + 1 imol = local_molecules%list(ikind)%array(imol_local) molecule => molecule_set(imol) CALL get_molecule(molecule, first_atom=first_atom, last_atom=last_atom, & @@ -768,18 +768,18 @@ SUBROUTINE thermostat_mapping_region_low(region, map_info, nkind, point, & END IF k = 0 DO ii = point(1, icount), point(2, icount) - ipart = first_atom+k + ipart = first_atom + k ielement = locate(massive_atom_list, ipart) - k = k+1 + k = k + 1 DO jj = 1, 3 - number = number+1 - map_info%index(number) = (ielement-1)*3+jj + number = number + 1 + map_info%index(number) = (ielement - 1)*3 + jj map_info%map_index(number) = number map_info%p_kin(jj, ii)%point => map_info%s_kin(number) map_info%p_scale(jj, ii)%point => map_info%v_scale(number) END DO END DO - IF (first_atom+k-1 /= last_atom) THEN + IF (first_atom + k - 1 /= last_atom) THEN CPABORT("Inconsistent mapping of particles") END IF END DO @@ -855,12 +855,12 @@ SUBROUTINE mapping_region_evaluate(dis_type, natoms_local, nmol_local, const_mol CALL get_molecule_kind(molecule_kind, natom=natom, nshell=nshell) IF (shell) THEN IF (nshell /= 0) THEN - natoms_local = natoms_local+nshell*local_molecules%n_el(ikind) - nmol_local = nmol_local+local_molecules%n_el(ikind) + natoms_local = natoms_local + nshell*local_molecules%n_el(ikind) + nmol_local = nmol_local + local_molecules%n_el(ikind) END IF ELSE - natoms_local = natoms_local+natom*local_molecules%n_el(ikind) - nmol_local = nmol_local+local_molecules%n_el(ikind) + natoms_local = natoms_local + natom*local_molecules%n_el(ikind) + nmol_local = nmol_local + local_molecules%n_el(ikind) END IF END DO @@ -882,9 +882,9 @@ SUBROUTINE mapping_region_evaluate(dis_type, natoms_local, nmol_local, const_mol fixd_list=fixd_list, nshell=nshell) IF (shell) natom = nshell DO imol_local = 1, nmol_per_kind - icount = icount+1 - point(1, icount) = atm_offset+1 - point(2, icount) = atm_offset+natom + icount = icount + 1 + point(1, icount) = atm_offset + 1 + point(2, icount) = atm_offset + natom IF (.NOT. shell) THEN ! nc keeps track of all constraints but not fixed ones.. ! Let's identify fixed atoms for this molecule @@ -897,19 +897,19 @@ SUBROUTINE mapping_region_evaluate(dis_type, natoms_local, nmol_local, const_mol DO ilist = 1, SIZE(fixd_list) IF ((katom == fixd_list(ilist)%fixd) .AND. & (.NOT. fixd_list(ilist)%restraint%active)) THEN - SELECT CASE (fixd_list (ilist)%itype) + SELECT CASE (fixd_list(ilist)%itype) CASE (use_perd_x, use_perd_y, use_perd_z) - nfixd = nfixd+1 + nfixd = nfixd + 1 CASE (use_perd_xy, use_perd_xz, use_perd_yz) - nfixd = nfixd+2 + nfixd = nfixd + 2 CASE (use_perd_xyz) - nfixd = nfixd+3 + nfixd = nfixd + 3 END SELECT END IF END DO END DO END IF - const_mol(icount) = nc+nfixd + const_mol(icount) = nc + nfixd tot_const(icount) = const_mol(icount) END IF atm_offset = point(2, icount) @@ -938,11 +938,11 @@ SUBROUTINE mapping_region_evaluate(dis_type, natoms_local, nmol_local, const_mol ! are in the same thermostatting region.. imol = local_molecules%list(ikind)%array(imol_local) molecule => molecule_set(imol) - id_region = map_loc_thermo_gen(atm_offset+1) - IF (ALL(map_loc_thermo_gen(atm_offset+1:atm_offset+natom) == id_region)) THEN + id_region = map_loc_thermo_gen(atm_offset + 1) + IF (ALL(map_loc_thermo_gen(atm_offset + 1:atm_offset + natom) == id_region)) THEN ! All the atoms of a molecule are within the same thermostatting ! region.. this is the easy case.. - tot_const(id_region) = tot_const(id_region)+nc + tot_const(id_region) = tot_const(id_region) + nc ELSE ! If not let's check the single constraints defined for this molecule ! and continue only when atoms involved in the constraint belong to @@ -950,9 +950,9 @@ SUBROUTINE mapping_region_evaluate(dis_type, natoms_local, nmol_local, const_mol IF (ASSOCIATED(colv_list)) THEN DO i = 1, SIZE(colv_list) IF (.NOT. colv_list(i)%restraint%active) THEN - iatm = atm_offset+colv_list(i)%i_atoms(1) + iatm = atm_offset + colv_list(i)%i_atoms(1) DO j = 2, SIZE(colv_list(i)%i_atoms) - jatm = atm_offset+colv_list(i)%i_atoms(j) + jatm = atm_offset + colv_list(i)%i_atoms(j) IF (map_loc_thermo_gen(iatm) /= map_loc_thermo_gen(jatm)) THEN CALL cp_abort(__LOCATION__, & "User Defined Region: "// & @@ -961,22 +961,22 @@ SUBROUTINE mapping_region_evaluate(dis_type, natoms_local, nmol_local, const_mol END IF END DO id_region = map_loc_thermo_gen(iatm) - tot_const(id_region) = tot_const(id_region)+1 + tot_const(id_region) = tot_const(id_region) + 1 END IF END DO END IF IF (ASSOCIATED(g3x3_list)) THEN DO i = 1, SIZE(g3x3_list) IF (.NOT. g3x3_list(i)%restraint%active) THEN - iatm = atm_offset+g3x3_list(i)%a - jatm = atm_offset+g3x3_list(i)%b + iatm = atm_offset + g3x3_list(i)%a + jatm = atm_offset + g3x3_list(i)%b IF (map_loc_thermo_gen(iatm) /= map_loc_thermo_gen(jatm)) THEN CALL cp_abort(__LOCATION__, & "User Defined Region: "// & "A constraint (G3X3) was defined between two thermostatting regions! "// & "This is not allowed!") END IF - jatm = atm_offset+g3x3_list(i)%c + jatm = atm_offset + g3x3_list(i)%c IF (map_loc_thermo_gen(iatm) /= map_loc_thermo_gen(jatm)) THEN CALL cp_abort(__LOCATION__, & "User Defined Region: "// & @@ -985,28 +985,28 @@ SUBROUTINE mapping_region_evaluate(dis_type, natoms_local, nmol_local, const_mol END IF END IF id_region = map_loc_thermo_gen(iatm) - tot_const(id_region) = tot_const(id_region)+3 + tot_const(id_region) = tot_const(id_region) + 3 END DO END IF IF (ASSOCIATED(g4x6_list)) THEN DO i = 1, SIZE(g4x6_list) IF (.NOT. g4x6_list(i)%restraint%active) THEN - iatm = atm_offset+g4x6_list(i)%a - jatm = atm_offset+g4x6_list(i)%b + iatm = atm_offset + g4x6_list(i)%a + jatm = atm_offset + g4x6_list(i)%b IF (map_loc_thermo_gen(iatm) /= map_loc_thermo_gen(jatm)) THEN CALL cp_abort(__LOCATION__, & " User Defined Region: "// & "A constraint (G4X6) was defined between two thermostatting regions! "// & "This is not allowed!") END IF - jatm = atm_offset+g4x6_list(i)%c + jatm = atm_offset + g4x6_list(i)%c IF (map_loc_thermo_gen(iatm) /= map_loc_thermo_gen(jatm)) THEN CALL cp_abort(__LOCATION__, & " User Defined Region: "// & "A constraint (G4X6) was defined between two thermostatting regions! "// & "This is not allowed!") END IF - jatm = atm_offset+g4x6_list(i)%d + jatm = atm_offset + g4x6_list(i)%d IF (map_loc_thermo_gen(iatm) /= map_loc_thermo_gen(jatm)) THEN CALL cp_abort(__LOCATION__, & " User Defined Region: "// & @@ -1015,7 +1015,7 @@ SUBROUTINE mapping_region_evaluate(dis_type, natoms_local, nmol_local, const_mol END IF END IF id_region = map_loc_thermo_gen(iatm) - tot_const(id_region) = tot_const(id_region)+6 + tot_const(id_region) = tot_const(id_region) + 6 END DO END IF END IF @@ -1024,25 +1024,25 @@ SUBROUTINE mapping_region_evaluate(dis_type, natoms_local, nmol_local, const_mol CALL get_molecule(molecule, first_atom=first_atom, last_atom=last_atom) iatm = 0 DO katom = first_atom, last_atom - iatm = iatm+1 + iatm = iatm + 1 DO ilist = 1, SIZE(fixd_list) IF ((katom == fixd_list(ilist)%fixd) .AND. & (.NOT. fixd_list(ilist)%restraint%active)) THEN - id_region = map_loc_thermo_gen(atm_offset+iatm) - SELECT CASE (fixd_list (ilist)%itype) + id_region = map_loc_thermo_gen(atm_offset + iatm) + SELECT CASE (fixd_list(ilist)%itype) CASE (use_perd_x, use_perd_y, use_perd_z) - tot_const(id_region) = tot_const(id_region)+1 + tot_const(id_region) = tot_const(id_region) + 1 CASE (use_perd_xy, use_perd_xz, use_perd_yz) - tot_const(id_region) = tot_const(id_region)+2 + tot_const(id_region) = tot_const(id_region) + 2 CASE (use_perd_xyz) - tot_const(id_region) = tot_const(id_region)+3 + tot_const(id_region) = tot_const(id_region) + 3 END SELECT END IF END DO END DO END IF END IF - atm_offset = atm_offset+natom + atm_offset = atm_offset + natom END DO END DO CALL mp_sum(tot_const, para_env%group) @@ -1063,10 +1063,10 @@ SUBROUTINE mapping_region_evaluate(dis_type, natoms_local, nmol_local, const_mol const_mol(ikind) = nc ! Let's consider the fixed atoms only for the total number of constraints ! in case we are in REPLICATED/INTERACTING thermostats - tot_const(ikind) = const_mol(ikind)*nmolecule+nfixd + tot_const(ikind) = const_mol(ikind)*nmolecule + nfixd END IF - point(1, ikind) = atm_offset+1 - point(2, ikind) = atm_offset+natom*nmol_per_kind + point(1, ikind) = atm_offset + 1 + point(2, ikind) = atm_offset + natom*nmol_per_kind atm_offset = point(2, ikind) END DO END IF @@ -1129,14 +1129,14 @@ SUBROUTINE massive_list_generate(molecule_set, molecule_kind_set, & IF (shell) THEN natom = nshell END IF - num_massive_atm_local = num_massive_atm_local+natom + num_massive_atm_local = num_massive_atm_local + natom CALL reallocate(local_atm_list, 1, num_massive_atm_local) CALL get_molecule(molecule, first_atom=first_atom, first_shell=first_shell) IF (shell) THEN first_atom = first_shell END IF DO j = 1, natom - local_atm_list(num_massive_atm_local-natom+j) = first_atom-1+j + local_atm_list(num_massive_atm_local - natom + j) = first_atom - 1 + j END DO END IF END DO @@ -1152,19 +1152,19 @@ SUBROUTINE massive_list_generate(molecule_set, molecule_kind_set, & DO iproc = 1, para_env%num_pe ncount = array_num_massive_atm(iproc) ALLOCATE (work(ncount)) - IF (para_env%mepos == (iproc-1)) THEN + IF (para_env%mepos == (iproc - 1)) THEN DO i = 1, ncount work(i) = local_atm_list(i) END DO ELSE work(:) = 0 END IF - CALL mp_bcast(work, iproc-1, para_env%group) + CALL mp_bcast(work, iproc - 1, para_env%group) DO i = 1, ncount - massive_atom_list(offset+i) = work(i) + massive_atom_list(offset + i) = work(i) END DO DEALLOCATE (work) - offset = offset+array_num_massive_atm(iproc) + offset = offset + array_num_massive_atm(iproc) END DO ! Sort atom list diff --git a/src/motion/thermostat/thermostat_types.F b/src/motion/thermostat/thermostat_types.F index 1a4e77741b..1db78eeda9 100644 --- a/src/motion/thermostat/thermostat_types.F +++ b/src/motion/thermostat/thermostat_types.F @@ -119,7 +119,7 @@ SUBROUTINE allocate_thermostats(thermostats) ! Preliminary allocation for thermostats ALLOCATE (thermostats) - last_thermostats_id_nr = last_thermostats_id_nr+1 + last_thermostats_id_nr = last_thermostats_id_nr + 1 thermostats%id_nr = last_thermostats_id_nr thermostats%ref_count = 1 @@ -161,7 +161,7 @@ SUBROUTINE retain_thermostats(thermostats) IF (ASSOCIATED(thermostats)) THEN CPASSERT(thermostats%ref_count > 0) - thermostats%ref_count = thermostats%ref_count+1 + thermostats%ref_count = thermostats%ref_count + 1 END IF END SUBROUTINE retain_thermostats @@ -185,7 +185,7 @@ SUBROUTINE release_thermostats(thermostats) IF (check) THEN check = thermostats%ref_count > 0 CPASSERT(check) - thermostats%ref_count = thermostats%ref_count-1 + thermostats%ref_count = thermostats%ref_count - 1 IF (thermostats%ref_count < 1) THEN CALL release_thermostat_info(thermostats%thermostat_info_part) CALL release_thermostat_info(thermostats%thermostat_info_shell) @@ -245,7 +245,7 @@ SUBROUTINE create_thermostat_type(thermostat, simpar, section, skip_region, labe skip_region_loc = .FALSE. IF (PRESENT(skip_region)) skip_region_loc = skip_region ALLOCATE (thermostat) - last_thermostat_id_nr = last_thermostat_id_nr+1 + last_thermostat_id_nr = last_thermostat_id_nr + 1 thermostat%id_nr = last_thermostat_id_nr thermostat%ref_count = 1 thermostat%section => section @@ -324,7 +324,7 @@ SUBROUTINE release_thermostat_type(thermostat) IF (check) THEN check = thermostat%ref_count > 0 CPASSERT(check) - thermostat%ref_count = thermostat%ref_count-1 + thermostat%ref_count = thermostat%ref_count - 1 IF (thermostat%ref_count < 1) THEN NULLIFY (thermostat%section) IF (ASSOCIATED(thermostat%nhc)) THEN diff --git a/src/motion/thermostat/thermostat_utils.F b/src/motion/thermostat/thermostat_utils.F index 90abe41aa4..5e5f239147 100644 --- a/src/motion/thermostat/thermostat_utils.F +++ b/src/motion/thermostat/thermostat_utils.F @@ -119,14 +119,14 @@ SUBROUTINE compute_nfree(cell, simpar, molecule_kind_set, & print_section=print_section, keep_rotations=.FALSE., & mass_weighted=.TRUE., natoms=natom) - roto_trasl_dof = roto_trasl_dof-MIN(SUM(cell%perd(1:3)), rot_dof) + roto_trasl_dof = roto_trasl_dof - MIN(SUM(cell%perd(1:3)), rot_dof) ! Saving this value of simpar preliminar to the real count of constraints.. simpar%nfree_rot_transl = roto_trasl_dof ! compute the total number of degrees of freedom for temperature - nconstraint_ext = gci%ntot-gci%nrestraint - simpar%nfree = 3*natom-nconstraint_int-nconstraint_ext-roto_trasl_dof + nconstraint_ext = gci%ntot - gci%nrestraint + simpar%nfree = 3*natom - nconstraint_int - nconstraint_ext - roto_trasl_dof END SUBROUTINE compute_nfree @@ -180,7 +180,7 @@ SUBROUTINE compute_degrees_of_freedom(thermostats, cell, simpar, molecule_kind_s print_section=print_section, keep_rotations=.FALSE., & mass_weighted=.TRUE., natoms=natom) - roto_trasl_dof = roto_trasl_dof-MIN(SUM(cell%perd(1:3)), rot_dof) + roto_trasl_dof = roto_trasl_dof - MIN(SUM(cell%perd(1:3)), rot_dof) ! Collect info about thermostats CALL setup_thermostat_info(thermostats%thermostat_info_part, molecule_kind_set, & @@ -191,8 +191,8 @@ SUBROUTINE compute_degrees_of_freedom(thermostats, cell, simpar, molecule_kind_s simpar%nfree_rot_transl = roto_trasl_dof ! compute the total number of degrees of freedom for temperature - nconstraint_ext = gci%ntot-gci%nrestraint - simpar%nfree = 3*natom-nconstraint_int-nconstraint_ext-roto_trasl_dof + nconstraint_ext = gci%ntot - gci%nrestraint + simpar%nfree = 3*natom - nconstraint_int - nconstraint_ext - roto_trasl_dof logger => cp_get_default_logger() iw = cp_print_key_unit_nr(logger, print_section, "PROGRAM_RUN_INFO", & @@ -307,7 +307,7 @@ SUBROUTINE setup_adiabatic_thermostat_info(thermostat_info, molecule_kind_set, l END IF END DO IF (on_therm) THEN - itherm = itherm+1 + itherm = itherm + 1 DO katom = first_atom, last_atom thermolist(katom) = itherm END DO @@ -318,7 +318,7 @@ SUBROUTINE setup_adiabatic_thermostat_info(thermostat_info, molecule_kind_set, l molecule_kind => molecule_kind_set(i) CALL get_molecule_kind(molecule_kind, nmolecule=nmolecule, nshell=nshell) IF ((do_shell) .AND. (nshell == 0)) nmolecule = 0 - sum_of_thermostats = sum_of_thermostats+nmolecule + sum_of_thermostats = sum_of_thermostats + nmolecule END DO ! If we have ONE kind and ONE molecule, then effectively we have a GLOBAL thermostat ! and the degrees of freedom will be computed correctly for this special case @@ -330,7 +330,7 @@ SUBROUTINE setup_adiabatic_thermostat_info(thermostat_info, molecule_kind_set, l CALL get_molecule_kind(molecule_kind, nmolecule=nmolecule, & natom=natom, nshell=nshell) IF (do_shell) natom = nshell - sum_of_thermostats = sum_of_thermostats+3*natom*nmolecule + sum_of_thermostats = sum_of_thermostats + 3*natom*nmolecule END DO END SELECT @@ -342,7 +342,7 @@ SUBROUTINE setup_adiabatic_thermostat_info(thermostat_info, molecule_kind_set, l molecule => molecule_set(i) CALL get_molecule(molecule, first_atom=first_atom, last_atom=last_atom) DO ipart = first_atom, last_atom - natom_local = natom_local+1 + natom_local = natom_local + 1 END DO END DO END DO @@ -359,7 +359,7 @@ SUBROUTINE setup_adiabatic_thermostat_info(thermostat_info, molecule_kind_set, l molecule => molecule_set(i) CALL get_molecule(molecule, first_atom=first_atom, last_atom=last_atom) DO ipart = first_atom, last_atom - natom_local = natom_local+1 + natom_local = natom_local + 1 ! only map the correct region to the thermostat IF (thermolist(ipart) /= HUGE(0)) & thermostat_info%map_loc_thermo_gen(natom_local) = thermolist(ipart) @@ -385,9 +385,9 @@ SUBROUTINE setup_adiabatic_thermostat_info(thermostat_info, molecule_kind_set, l IF (nshell == 0) nmol_local = 0 END IF IF (region == do_region_molecule) THEN - number = number+nmol_local + number = number + nmol_local ELSE IF (region == do_region_massive) THEN - number = number+3*nmol_local*natom + number = number + 3*nmol_local*natom ELSE CPABORT('Invalid region setup') END IF @@ -468,7 +468,7 @@ SUBROUTINE get_adiabatic_region_info(region_sections, sum_of_thermostats, & ipart = tmplist(i) CPASSERT(((ipart > 0) .AND. (ipart <= particles%n_els))) IF (thermolist(ipart) == HUGE(0)) THEN - itherm = itherm+1 + itherm = itherm + 1 thermolist(ipart) = itherm ELSE CPABORT("") @@ -487,7 +487,7 @@ SUBROUTINE get_adiabatic_region_info(region_sections, sum_of_thermostats, & CALL get_molecule(molecule, first_atom=first_atom, last_atom=last_atom) DO ipart = first_atom, last_atom IF (thermolist(ipart) == HUGE(0)) THEN - itherm = itherm+1 + itherm = itherm + 1 thermolist(ipart) = itherm ELSE CPABORT("") @@ -612,7 +612,7 @@ SUBROUTINE setup_thermostat_info(thermostat_info, molecule_kind_set, local_molec molecule_kind => molecule_kind_set(i) CALL get_molecule_kind(molecule_kind, nmolecule=nmolecule, nshell=nshell) IF ((do_shell) .AND. (nshell == 0)) nmolecule = 0 - sum_of_thermostats = sum_of_thermostats+nmolecule + sum_of_thermostats = sum_of_thermostats + nmolecule END DO ! If we have ONE kind and ONE molecule, then effectively we have a GLOBAL thermostat ! and the degrees of freedom will be computed correctly for this special case @@ -624,7 +624,7 @@ SUBROUTINE setup_thermostat_info(thermostat_info, molecule_kind_set, local_molec CALL get_molecule_kind(molecule_kind, nmolecule=nmolecule, & natom=natom, nshell=nshell) IF (do_shell) natom = nshell - sum_of_thermostats = sum_of_thermostats+3*natom*nmolecule + sum_of_thermostats = sum_of_thermostats + 3*natom*nmolecule END DO CASE (do_region_defined) ! User defined region to thermostat.. @@ -655,9 +655,9 @@ SUBROUTINE setup_thermostat_info(thermostat_info, molecule_kind_set, local_molec IF (nshell == 0) nmol_local = 0 END IF IF (region == do_region_molecule) THEN - number = number+nmol_local + number = number + nmol_local ELSE IF (region == do_region_massive) THEN - number = number+3*nmol_local*natom + number = number + 3*nmol_local*natom ELSE CPABORT('Invalid region setup') END IF @@ -783,13 +783,13 @@ SUBROUTINE get_defined_region_info(region_sections, number, sum_of_thermostats, ! Dump IO warning for not thermalized particles IF (ANY(thermolist == HUGE(0))) THEN - nregions = nregions+1 - sum_of_thermostats = sum_of_thermostats+1 + nregions = nregions + 1 + sum_of_thermostats = sum_of_thermostats + 1 ALLOCATE (tmp(COUNT(thermolist == HUGE(0)))) ilist = 0 DO i = 1, SIZE(thermolist) IF (thermolist(i) == HUGE(0)) THEN - ilist = ilist+1 + ilist = ilist + 1 tmp(ilist) = i thermolist(i) = nregions END IF @@ -814,7 +814,7 @@ SUBROUTINE get_defined_region_info(region_sections, number, sum_of_thermostats, molecule => molecule_set(i) CALL get_molecule(molecule, first_atom=first_atom, last_atom=last_atom) DO ipart = first_atom, last_atom - natom_local = natom_local+1 + natom_local = natom_local + 1 tmp(thermolist(ipart)) = 1 END DO END DO @@ -832,7 +832,7 @@ SUBROUTINE get_defined_region_info(region_sections, number, sum_of_thermostats, molecule => molecule_set(i) CALL get_molecule(molecule, first_atom=first_atom, last_atom=last_atom) DO ipart = first_atom, last_atom - natom_local = natom_local+1 + natom_local = natom_local + 1 map_loc_thermo_gen(natom_local) = thermolist(ipart) END DO END DO @@ -925,8 +925,8 @@ SUBROUTINE setup_thermostat_subsys(region_sections, qmmm_env, thermolist, & END DO END SELECT ELSE - sum_of_thermostats = sum_of_thermostats-1 - nregions = nregions-1 + sum_of_thermostats = sum_of_thermostats - 1 + nregions = nregions - 1 END IF END IF END SUBROUTINE setup_thermostat_subsys @@ -953,9 +953,9 @@ SUBROUTINE ke_region_baro(map_info, npt, group) ncoef = 0 DO i = 1, SIZE(npt, 1) DO j = 1, SIZE(npt, 2) - ncoef = ncoef+1 + ncoef = ncoef + 1 map_info%p_kin(1, ncoef)%point = map_info%p_kin(1, ncoef)%point & - +npt(i, j)%mass*npt(i, j)%v**2 + + npt(i, j)%mass*npt(i, j)%v**2 END DO END DO @@ -982,7 +982,7 @@ SUBROUTINE vel_rescale_baro(map_info, npt) ncoef = 0 DO i = 1, SIZE(npt, 1) DO j = 1, SIZE(npt, 2) - ncoef = ncoef+1 + ncoef = ncoef + 1 npt(i, j)%v = npt(i, j)%v*map_info%p_scale(1, ncoef)%point END DO END DO @@ -1032,23 +1032,23 @@ SUBROUTINE ke_region_particles(map_info, particle_set, molecule_kind_set, & molecule => molecule_set(imol) CALL get_molecule(molecule, first_atom=first_atom, last_atom=last_atom) DO ipart = first_atom, last_atom - ii = ii+1 + ii = ii + 1 atomic_kind => particle_set(ipart)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) IF (present_vel) THEN IF (ASSOCIATED(map_info%p_kin(1, ii)%point)) & - map_info%p_kin(1, ii)%point = map_info%p_kin(1, ii)%point+mass*vel(1, ipart)**2 + map_info%p_kin(1, ii)%point = map_info%p_kin(1, ii)%point + mass*vel(1, ipart)**2 IF (ASSOCIATED(map_info%p_kin(2, ii)%point)) & - map_info%p_kin(2, ii)%point = map_info%p_kin(2, ii)%point+mass*vel(2, ipart)**2 + map_info%p_kin(2, ii)%point = map_info%p_kin(2, ii)%point + mass*vel(2, ipart)**2 IF (ASSOCIATED(map_info%p_kin(3, ii)%point)) & - map_info%p_kin(3, ii)%point = map_info%p_kin(3, ii)%point+mass*vel(3, ipart)**2 + map_info%p_kin(3, ii)%point = map_info%p_kin(3, ii)%point + mass*vel(3, ipart)**2 ELSE IF (ASSOCIATED(map_info%p_kin(1, ii)%point)) & - map_info%p_kin(1, ii)%point = map_info%p_kin(1, ii)%point+mass*particle_set(ipart)%v(1)**2 + map_info%p_kin(1, ii)%point = map_info%p_kin(1, ii)%point + mass*particle_set(ipart)%v(1)**2 IF (ASSOCIATED(map_info%p_kin(2, ii)%point)) & - map_info%p_kin(2, ii)%point = map_info%p_kin(2, ii)%point+mass*particle_set(ipart)%v(2)**2 + map_info%p_kin(2, ii)%point = map_info%p_kin(2, ii)%point + mass*particle_set(ipart)%v(2)**2 IF (ASSOCIATED(map_info%p_kin(3, ii)%point)) & - map_info%p_kin(3, ii)%point = map_info%p_kin(3, ii)%point+mass*particle_set(ipart)%v(3)**2 + map_info%p_kin(3, ii)%point = map_info%p_kin(3, ii)%point + mass*particle_set(ipart)%v(3)**2 END IF END DO END DO @@ -1101,17 +1101,17 @@ SUBROUTINE momentum_region_particles(map_info, particle_set, molecule_kind_set, molecule => molecule_set(imol) CALL get_molecule(molecule, first_atom=first_atom, last_atom=last_atom) DO ipart = first_atom, last_atom - ii = ii+1 + ii = ii + 1 atomic_kind => particle_set(ipart)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass) IF (present_vel) THEN - map_info%p_kin(1, ii)%point = map_info%p_kin(1, ii)%point+SQRT(mass)*vel(1, ipart) - map_info%p_kin(2, ii)%point = map_info%p_kin(2, ii)%point+SQRT(mass)*vel(2, ipart) - map_info%p_kin(3, ii)%point = map_info%p_kin(3, ii)%point+SQRT(mass)*vel(3, ipart) + map_info%p_kin(1, ii)%point = map_info%p_kin(1, ii)%point + SQRT(mass)*vel(1, ipart) + map_info%p_kin(2, ii)%point = map_info%p_kin(2, ii)%point + SQRT(mass)*vel(2, ipart) + map_info%p_kin(3, ii)%point = map_info%p_kin(3, ii)%point + SQRT(mass)*vel(3, ipart) ELSE - map_info%p_kin(1, ii)%point = map_info%p_kin(1, ii)%point+SQRT(mass)*particle_set(ipart)%v(1) - map_info%p_kin(2, ii)%point = map_info%p_kin(2, ii)%point+SQRT(mass)*particle_set(ipart)%v(2) - map_info%p_kin(3, ii)%point = map_info%p_kin(3, ii)%point+SQRT(mass)*particle_set(ipart)%v(3) + map_info%p_kin(1, ii)%point = map_info%p_kin(1, ii)%point + SQRT(mass)*particle_set(ipart)%v(1) + map_info%p_kin(2, ii)%point = map_info%p_kin(2, ii)%point + SQRT(mass)*particle_set(ipart)%v(2) + map_info%p_kin(3, ii)%point = map_info%p_kin(3, ii)%point + SQRT(mass)*particle_set(ipart)%v(3) END IF END DO END DO @@ -1185,7 +1185,7 @@ SUBROUTINE vel_rescale_particles(map_info, molecule_kind_set, molecule_set, & molecule => molecule_set(imol) CALL get_molecule(molecule, first_atom=first_atom, last_atom=last_atom) Particle: DO ipart = first_atom, last_atom - ii = ii+1 + ii = ii + 1 IF (present_vel) THEN vel(1, ipart) = vel(1, ipart)*map_info%p_scale(1, ii)%point vel(2, ipart) = vel(2, ipart)*map_info%p_scale(2, ii)%point @@ -1199,7 +1199,7 @@ SUBROUTINE vel_rescale_particles(map_info, molecule_kind_set, molecule_set, & IF (shell_adiabatic) THEN shell_index = particle_set(ipart)%shell_index IF (shell_index /= 0) THEN - jj = jj+2 + jj = jj + 2 atomic_kind => particle_set(ipart)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass, shell=shell) fac_masss = shell%mass_shell/mass @@ -1207,21 +1207,21 @@ SUBROUTINE vel_rescale_particles(map_info, molecule_kind_set, molecule_set, & IF (present_vel) THEN vs(1:3) = shell_vel(1:3, shell_index) vc(1:3) = core_vel(1:3, shell_index) - shell_vel(1, shell_index) = vel(1, ipart)+fac_massc*(vs(1)-vc(1)) - shell_vel(2, shell_index) = vel(2, ipart)+fac_massc*(vs(2)-vc(2)) - shell_vel(3, shell_index) = vel(3, ipart)+fac_massc*(vs(3)-vc(3)) - core_vel(1, shell_index) = vel(1, ipart)+fac_masss*(vc(1)-vs(1)) - core_vel(2, shell_index) = vel(2, ipart)+fac_masss*(vc(2)-vs(2)) - core_vel(3, shell_index) = vel(3, ipart)+fac_masss*(vc(3)-vs(3)) + shell_vel(1, shell_index) = vel(1, ipart) + fac_massc*(vs(1) - vc(1)) + shell_vel(2, shell_index) = vel(2, ipart) + fac_massc*(vs(2) - vc(2)) + shell_vel(3, shell_index) = vel(3, ipart) + fac_massc*(vs(3) - vc(3)) + core_vel(1, shell_index) = vel(1, ipart) + fac_masss*(vc(1) - vs(1)) + core_vel(2, shell_index) = vel(2, ipart) + fac_masss*(vc(2) - vs(2)) + core_vel(3, shell_index) = vel(3, ipart) + fac_masss*(vc(3) - vs(3)) ELSE vs(1:3) = shell_particle_set(shell_index)%v(1:3) vc(1:3) = core_particle_set(shell_index)%v(1:3) - shell_particle_set(shell_index)%v(1) = particle_set(ipart)%v(1)+fac_massc*(vs(1)-vc(1)) - shell_particle_set(shell_index)%v(2) = particle_set(ipart)%v(2)+fac_massc*(vs(2)-vc(2)) - shell_particle_set(shell_index)%v(3) = particle_set(ipart)%v(3)+fac_massc*(vs(3)-vc(3)) - core_particle_set(shell_index)%v(1) = particle_set(ipart)%v(1)+fac_masss*(vc(1)-vs(1)) - core_particle_set(shell_index)%v(2) = particle_set(ipart)%v(2)+fac_masss*(vc(2)-vs(2)) - core_particle_set(shell_index)%v(3) = particle_set(ipart)%v(3)+fac_masss*(vc(3)-vs(3)) + shell_particle_set(shell_index)%v(1) = particle_set(ipart)%v(1) + fac_massc*(vs(1) - vc(1)) + shell_particle_set(shell_index)%v(2) = particle_set(ipart)%v(2) + fac_massc*(vs(2) - vc(2)) + shell_particle_set(shell_index)%v(3) = particle_set(ipart)%v(3) + fac_massc*(vs(3) - vc(3)) + core_particle_set(shell_index)%v(1) = particle_set(ipart)%v(1) + fac_masss*(vc(1) - vs(1)) + core_particle_set(shell_index)%v(2) = particle_set(ipart)%v(2) + fac_masss*(vc(2) - vs(2)) + core_particle_set(shell_index)%v(3) = particle_set(ipart)%v(3) + fac_masss*(vc(3) - vs(3)) END IF END IF END IF @@ -1291,21 +1291,21 @@ SUBROUTINE ke_region_shells(map_info, particle_set, atomic_kind_set, & DO iparticle_local = 1, nparticle_local iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) shell_index = particle_set(iparticle)%shell_index - ii = ii+1 + ii = ii + 1 IF (present_vel) THEN - v_sc(1) = core_vel(1, shell_index)-shell_vel(1, shell_index) - v_sc(2) = core_vel(2, shell_index)-shell_vel(2, shell_index) - v_sc(3) = core_vel(3, shell_index)-shell_vel(3, shell_index) - map_info%p_kin(1, ii)%point = map_info%p_kin(1, ii)%point+mu_mass*v_sc(1)**2 - map_info%p_kin(2, ii)%point = map_info%p_kin(2, ii)%point+mu_mass*v_sc(2)**2 - map_info%p_kin(3, ii)%point = map_info%p_kin(3, ii)%point+mu_mass*v_sc(3)**2 + v_sc(1) = core_vel(1, shell_index) - shell_vel(1, shell_index) + v_sc(2) = core_vel(2, shell_index) - shell_vel(2, shell_index) + v_sc(3) = core_vel(3, shell_index) - shell_vel(3, shell_index) + map_info%p_kin(1, ii)%point = map_info%p_kin(1, ii)%point + mu_mass*v_sc(1)**2 + map_info%p_kin(2, ii)%point = map_info%p_kin(2, ii)%point + mu_mass*v_sc(2)**2 + map_info%p_kin(3, ii)%point = map_info%p_kin(3, ii)%point + mu_mass*v_sc(3)**2 ELSE - v_sc(1) = core_particle_set(shell_index)%v(1)-shell_particle_set(shell_index)%v(1) - v_sc(2) = core_particle_set(shell_index)%v(2)-shell_particle_set(shell_index)%v(2) - v_sc(3) = core_particle_set(shell_index)%v(3)-shell_particle_set(shell_index)%v(3) - map_info%p_kin(1, ii)%point = map_info%p_kin(1, ii)%point+mu_mass*v_sc(1)**2 - map_info%p_kin(2, ii)%point = map_info%p_kin(2, ii)%point+mu_mass*v_sc(2)**2 - map_info%p_kin(3, ii)%point = map_info%p_kin(3, ii)%point+mu_mass*v_sc(3)**2 + v_sc(1) = core_particle_set(shell_index)%v(1) - shell_particle_set(shell_index)%v(1) + v_sc(2) = core_particle_set(shell_index)%v(2) - shell_particle_set(shell_index)%v(2) + v_sc(3) = core_particle_set(shell_index)%v(3) - shell_particle_set(shell_index)%v(3) + map_info%p_kin(1, ii)%point = map_info%p_kin(1, ii)%point + mu_mass*v_sc(1)**2 + map_info%p_kin(2, ii)%point = map_info%p_kin(2, ii)%point + mu_mass*v_sc(2)**2 + map_info%p_kin(3, ii)%point = map_info%p_kin(3, ii)%point + mu_mass*v_sc(3)**2 END IF END DO END IF @@ -1375,27 +1375,27 @@ SUBROUTINE vel_rescale_shells(map_info, atomic_kind_set, particle_set, local_par Particles: DO iparticle_local = 1, nparticle_local iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) shell_index = particle_set(iparticle)%shell_index - ii = ii+1 + ii = ii + 1 IF (present_vel) THEN vc(1:3) = core_vel(1:3, shell_index) vs(1:3) = shell_vel(1:3, shell_index) v(1:3) = vel(1:3, iparticle) - shell_vel(1, shell_index) = v(1)+map_info%p_scale(1, ii)%point*massc*(vs(1)-vc(1)) - shell_vel(2, shell_index) = v(2)+map_info%p_scale(2, ii)%point*massc*(vs(2)-vc(2)) - shell_vel(3, shell_index) = v(3)+map_info%p_scale(3, ii)%point*massc*(vs(3)-vc(3)) - core_vel(1, shell_index) = v(1)+map_info%p_scale(1, ii)%point*masss*(vc(1)-vs(1)) - core_vel(2, shell_index) = v(2)+map_info%p_scale(2, ii)%point*masss*(vc(2)-vs(2)) - core_vel(3, shell_index) = v(3)+map_info%p_scale(3, ii)%point*masss*(vc(3)-vs(3)) + shell_vel(1, shell_index) = v(1) + map_info%p_scale(1, ii)%point*massc*(vs(1) - vc(1)) + shell_vel(2, shell_index) = v(2) + map_info%p_scale(2, ii)%point*massc*(vs(2) - vc(2)) + shell_vel(3, shell_index) = v(3) + map_info%p_scale(3, ii)%point*massc*(vs(3) - vc(3)) + core_vel(1, shell_index) = v(1) + map_info%p_scale(1, ii)%point*masss*(vc(1) - vs(1)) + core_vel(2, shell_index) = v(2) + map_info%p_scale(2, ii)%point*masss*(vc(2) - vs(2)) + core_vel(3, shell_index) = v(3) + map_info%p_scale(3, ii)%point*masss*(vc(3) - vs(3)) ELSE vc(1:3) = core_particle_set(shell_index)%v(1:3) vs(1:3) = shell_particle_set(shell_index)%v(1:3) v(1:3) = particle_set(iparticle)%v(1:3) - shell_particle_set(shell_index)%v(1) = v(1)+map_info%p_scale(1, ii)%point*massc*(vs(1)-vc(1)) - shell_particle_set(shell_index)%v(2) = v(2)+map_info%p_scale(2, ii)%point*massc*(vs(2)-vc(2)) - shell_particle_set(shell_index)%v(3) = v(3)+map_info%p_scale(3, ii)%point*massc*(vs(3)-vc(3)) - core_particle_set(shell_index)%v(1) = v(1)+map_info%p_scale(1, ii)%point*masss*(vc(1)-vs(1)) - core_particle_set(shell_index)%v(2) = v(2)+map_info%p_scale(2, ii)%point*masss*(vc(2)-vs(2)) - core_particle_set(shell_index)%v(3) = v(3)+map_info%p_scale(3, ii)%point*masss*(vc(3)-vs(3)) + shell_particle_set(shell_index)%v(1) = v(1) + map_info%p_scale(1, ii)%point*massc*(vs(1) - vc(1)) + shell_particle_set(shell_index)%v(2) = v(2) + map_info%p_scale(2, ii)%point*massc*(vs(2) - vc(2)) + shell_particle_set(shell_index)%v(3) = v(3) + map_info%p_scale(3, ii)%point*massc*(vs(3) - vc(3)) + core_particle_set(shell_index)%v(1) = v(1) + map_info%p_scale(1, ii)%point*masss*(vc(1) - vs(1)) + core_particle_set(shell_index)%v(2) = v(2) + map_info%p_scale(2, ii)%point*masss*(vc(2) - vs(2)) + core_particle_set(shell_index)%v(3) = v(3) + map_info%p_scale(3, ii)%point*masss*(vc(3) - vs(3)) END IF END DO Particles END IF @@ -1435,8 +1435,8 @@ SUBROUTINE get_nhc_energies(nhc, nhc_pot, nhc_kin, para_env, array_kin, array_po DO n = 1, nhc%loc_num_nhc imap = nhc%map_info%index(n) DO l = 1, nhc%nhc_len - akin(imap) = akin(imap)+0.5_dp*nhc%nvt(l, n)%mass*nhc%nvt(l, n)%v**2 - vpot(imap) = vpot(imap)+nhc%nvt(l, n)%nkt*nhc%nvt(l, n)%eta + akin(imap) = akin(imap) + 0.5_dp*nhc%nvt(l, n)%mass*nhc%nvt(l, n)%v**2 + vpot(imap) = vpot(imap) + nhc%nvt(l, n)%nkt*nhc%nvt(l, n)%eta END DO END DO @@ -1835,11 +1835,11 @@ SUBROUTINE print_thermostat_status(thermostat, para_env, my_pos, my_act, itimes, WRITE (UNIT=unit, FMT="(I8, F12.3,6X,2F20.10)") itimes, time*femtoseconds, thermo_kin, thermo_pot WRITE (unit, '(A,4F20.10)') "# KINETIC ENERGY REGIONS: ", array_kin(1:MIN(4, SIZE(array_kin))) DO i = 5, SIZE(array_kin), 4 - WRITE (UNIT=unit, FMT='("#",25X,4F20.10)') array_kin(i:MIN(i+3, SIZE(array_kin))) + WRITE (UNIT=unit, FMT='("#",25X,4F20.10)') array_kin(i:MIN(i + 3, SIZE(array_kin))) END DO WRITE (unit, '(A,4F20.10)') "# POTENT. ENERGY REGIONS: ", array_pot(1:MIN(4, SIZE(array_pot))) DO i = 5, SIZE(array_pot), 4 - WRITE (UNIT=unit, FMT='("#",25X,4F20.10)') array_pot(i:MIN(i+3, SIZE(array_pot))) + WRITE (UNIT=unit, FMT='("#",25X,4F20.10)') array_pot(i:MIN(i + 3, SIZE(array_pot))) END DO CALL m_flush(unit) END IF @@ -1862,7 +1862,7 @@ SUBROUTINE print_thermostat_status(thermostat, para_env, my_pos, my_act, itimes, WRITE (UNIT=unit, FMT="(I8, F12.3,3X,F20.10)") itimes, time*femtoseconds, tot_temperature WRITE (unit, '(A,I10)') "# TEMPERATURE REGIONS: ", SIZE(array_temp) DO i = 1, SIZE(array_temp), 4 - WRITE (UNIT=unit, FMT='("#",22X,4F20.10)') array_temp(i:MIN(i+3, SIZE(array_temp))) + WRITE (UNIT=unit, FMT='("#",22X,4F20.10)') array_temp(i:MIN(i + 3, SIZE(array_temp))) END DO CALL m_flush(unit) END IF @@ -1893,7 +1893,7 @@ SUBROUTINE communication_thermo_low1(array, number, para_env) ALLOCATE (work(para_env%num_pe)) DO i = 1, number work = 0.0_dp - work(para_env%mepos+1) = array(i) + work(para_env%mepos + 1) = array(i) CALL mp_sum(work, para_env%group) ncheck = COUNT(work /= 0.0_dp) array(i) = 0.0_dp @@ -1902,7 +1902,7 @@ SUBROUTINE communication_thermo_low1(array, number, para_env) ncheck = 0 DO icheck = 1, para_env%num_pe IF (work(icheck) /= 0.0_dp) THEN - ncheck = ncheck+1 + ncheck = ncheck + 1 work2(ncheck) = work(icheck) END IF END DO @@ -1938,12 +1938,12 @@ SUBROUTINE communication_thermo_low2(array, number1, number2, para_env) ALLOCATE (work(number1, para_env%num_pe)) DO i = 1, number2 work = 0 - work(:, para_env%mepos+1) = array(:, i) + work(:, para_env%mepos + 1) = array(:, i) CALL mp_sum(work, para_env%group) ncheck = 0 DO j = 1, para_env%num_pe IF (ANY(work(:, j) /= 0)) THEN - ncheck = ncheck+1 + ncheck = ncheck + 1 END IF END DO array(:, i) = 0 @@ -1952,7 +1952,7 @@ SUBROUTINE communication_thermo_low2(array, number1, number2, para_env) ncheck = 0 DO icheck = 1, para_env%num_pe IF (ANY(work(:, icheck) /= 0)) THEN - ncheck = ncheck+1 + ncheck = ncheck + 1 work2(:, ncheck) = work(:, icheck) END IF END DO diff --git a/src/motion/vibrational_analysis.F b/src/motion/vibrational_analysis.F index ca1c734068..84da9fd55e 100644 --- a/src/motion/vibrational_analysis.F +++ b/src/motion/vibrational_analysis.F @@ -200,15 +200,15 @@ SUBROUTINE vb_anal(input, input_declaration, para_env, globenv) Clist = 0 DO i = 1, natoms imap = Mlist(i) - Clist((i-1)*3+1) = (imap-1)*3+1 - Clist((i-1)*3+2) = (imap-1)*3+2 - Clist((i-1)*3+3) = (imap-1)*3+3 + Clist((i - 1)*3 + 1) = (imap - 1)*3 + 1 + Clist((i - 1)*3 + 2) = (imap - 1)*3 + 2 + Clist((i - 1)*3 + 3) = (imap - 1)*3 + 3 mass(i) = particles(imap)%atomic_kind%mass CPASSERT(mass(i) > 0.0_dp) mass(i) = SQRT(mass(i)) - pos0((i-1)*3+1) = particles(imap)%r(1) - pos0((i-1)*3+2) = particles(imap)%r(2) - pos0((i-1)*3+3) = particles(imap)%r(3) + pos0((i - 1)*3 + 1) = particles(imap)%r(1) + pos0((i - 1)*3 + 2) = particles(imap)%r(2) + pos0((i - 1)*3 + 3) = particles(imap)%r(3) END DO ! ! Determine the principal axes of inertia. @@ -230,120 +230,120 @@ SUBROUTINE vb_anal(input, input_declaration, para_env, globenv) Hessian = HUGE(0.0_dp) IF (output_unit > 0) WRITE (output_unit, '(/,T2,A)') "VIB| Vibrational Analysis Info" DO icoordp = 1, ncoord, nrep - icoord = icoordp-1 + icoord = icoordp - 1 DO j = 1, nrep DO i = 1, ncoord imap = Clist(i) rep_env%r(imap, j) = pos0(i) END DO - IF (icoord+j <= ncoord) THEN - imap = Clist(icoord+j) - rep_env%r(imap, j) = rep_env%r(imap, j)+Dx + IF (icoord + j <= ncoord) THEN + imap = Clist(icoord + j) + rep_env%r(imap, j) = rep_env%r(imap, j) + Dx END IF END DO CALL rep_env_calc_e_f(rep_env, calc_f=.TRUE.) DO j = 1, nrep IF (calc_intens) THEN - IF (icoord+j <= ncoord) THEN + IF (icoord + j <= ncoord) THEN CALL get_results(results=rep_env%results(j)%results, & description=description, & n_rep=nres) CALL get_results(results=rep_env%results(j)%results, & description=description, & - values=tmp_dip(icoord+j, :, 1), & + values=tmp_dip(icoord + j, :, 1), & nval=nres) END IF END IF - IF (icoord+j <= ncoord) THEN + IF (icoord + j <= ncoord) THEN DO i = 1, ncoord imap = Clist(i) - Hessian(i, icoord+j) = rep_env%f(imap, j) + Hessian(i, icoord + j) = rep_env%f(imap, j) END DO - imap = Clist(icoord+j) + imap = Clist(icoord + j) ! Dump Info IF (output_unit > 0) THEN iparticle1 = imap/3 - IF (MOD(imap, 3) /= 0) iparticle1 = iparticle1+1 + IF (MOD(imap, 3) /= 0) iparticle1 = iparticle1 + 1 WRITE (output_unit, '(T2,A,I5,A,I5,3A)') & "VIB| REPLICA Nr.", j, "- Energy and Forces for particle:", & - iparticle1, " coordinate: ", lab(imap-(iparticle1-1)*3), & - " + D"//TRIM(lab(imap-(iparticle1-1)*3)) + iparticle1, " coordinate: ", lab(imap - (iparticle1 - 1)*3), & + " + D"//TRIM(lab(imap - (iparticle1 - 1)*3)) ! WRITE (output_unit, '(T2,A,T42,A,9X,F15.9)') & - "VIB|", " Total Energy: ", rep_env%f(rep_env%ndim+1, j) + "VIB|", " Total Energy: ", rep_env%f(rep_env%ndim + 1, j) WRITE (output_unit, '(T2,"VIB|",T10,"ATOM",T33,3(9X,A,7X))') lab(1), lab(2), lab(3) DO i = 1, natoms imap = Mlist(i) WRITE (output_unit, '(T2,"VIB|",T12,A,T30,3(2X,F15.9))') & particles(imap)%atomic_kind%name, & - rep_env%f((imap-1)*3+1:(imap-1)*3+3, j) + rep_env%f((imap - 1)*3 + 1:(imap - 1)*3 + 3, j) END DO END IF END IF END DO END DO DO icoordm = 1, ncoord, nrep - icoord = icoordm-1 + icoord = icoordm - 1 DO j = 1, nrep DO i = 1, ncoord imap = Clist(i) rep_env%r(imap, j) = pos0(i) END DO - IF (icoord+j <= ncoord) THEN - imap = Clist(icoord+j) - rep_env%r(imap, j) = rep_env%r(imap, j)-Dx + IF (icoord + j <= ncoord) THEN + imap = Clist(icoord + j) + rep_env%r(imap, j) = rep_env%r(imap, j) - Dx END IF END DO CALL rep_env_calc_e_f(rep_env, calc_f=.TRUE.) DO j = 1, nrep IF (calc_intens) THEN - IF (icoord+j <= ncoord) THEN - k = (icoord+j+2)/3 + IF (icoord + j <= ncoord) THEN + k = (icoord + j + 2)/3 CALL get_results(results=rep_env%results(j)%results, & description=description, & n_rep=nres) CALL get_results(results=rep_env%results(j)%results, & description=description, & - values=tmp_dip(icoord+j, :, 2), & + values=tmp_dip(icoord + j, :, 2), & nval=nres) - tmp_dip(icoord+j, :, 1) = (tmp_dip(icoord+j, :, 1)-tmp_dip(icoord+j, :, 2))/(2.0_dp*Dx*mass(k)) + tmp_dip(icoord + j, :, 1) = (tmp_dip(icoord + j, :, 1) - tmp_dip(icoord + j, :, 2))/(2.0_dp*Dx*mass(k)) END IF END IF - IF (icoord+j <= ncoord) THEN - imap = Clist(icoord+j) + IF (icoord + j <= ncoord) THEN + imap = Clist(icoord + j) iparticle1 = imap/3 - IF (MOD(imap, 3) /= 0) iparticle1 = iparticle1+1 - ip1 = (icoord+j)/3 - IF (MOD(icoord+j, 3) /= 0) ip1 = ip1+1 + IF (MOD(imap, 3) /= 0) iparticle1 = iparticle1 + 1 + ip1 = (icoord + j)/3 + IF (MOD(icoord + j, 3) /= 0) ip1 = ip1 + 1 ! Dump Info IF (output_unit > 0) THEN WRITE (output_unit, '(T2,A,I5,A,I5,3A)') & "VIB| REPLICA Nr.", j, "- Energy and Forces for particle:", & - iparticle1, " coordinate: ", lab(imap-(iparticle1-1)*3), & - " - D"//TRIM(lab(imap-(iparticle1-1)*3)) + iparticle1, " coordinate: ", lab(imap - (iparticle1 - 1)*3), & + " - D"//TRIM(lab(imap - (iparticle1 - 1)*3)) ! WRITE (output_unit, '(T2,A,T42,A,9X,F15.9)') & - "VIB|", " Total Energy: ", rep_env%f(rep_env%ndim+1, j) + "VIB|", " Total Energy: ", rep_env%f(rep_env%ndim + 1, j) WRITE (output_unit, '(T2,"VIB|",T10,"ATOM",T33,3(9X,A,7X))') lab(1), lab(2), lab(3) DO i = 1, natoms imap = Mlist(i) WRITE (output_unit, '(T2,"VIB|",T12,A,T30,3(2X,F15.9))') & particles(imap)%atomic_kind%name, & - rep_env%f((imap-1)*3+1:(imap-1)*3+3, j) + rep_env%f((imap - 1)*3 + 1:(imap - 1)*3 + 3, j) END DO END IF DO iseq = 1, ncoord imap = Clist(iseq) iparticle2 = imap/3 - IF (MOD(imap, 3) /= 0) iparticle2 = iparticle2+1 + IF (MOD(imap, 3) /= 0) iparticle2 = iparticle2 + 1 ip2 = iseq/3 - IF (MOD(iseq, 3) /= 0) ip2 = ip2+1 - tmp = Hessian(iseq, icoord+j)-rep_env%f(imap, j) + IF (MOD(iseq, 3) /= 0) ip2 = ip2 + 1 + tmp = Hessian(iseq, icoord + j) - rep_env%f(imap, j) tmp = -tmp/(2.0_dp*Dx*mass(ip1)*mass(ip2))*1E6_dp ! Mass weighted Hessian - Hessian(iseq, icoord+j) = tmp + Hessian(iseq, icoord + j) = tmp END DO END IF @@ -353,7 +353,7 @@ SUBROUTINE vb_anal(input, input_declaration, para_env, globenv) ! restore original particle positions for output DO i = 1, natoms imap = Mlist(i) - particles(imap)%r(1:3) = pos0((i-1)*3+1:(i-1)*3+3) + particles(imap)%r(1:3) = pos0((i - 1)*3 + 1:(i - 1)*3 + 3) ENDDO DO j = 1, nrep DO i = 1, ncoord @@ -363,19 +363,19 @@ SUBROUTINE vb_anal(input, input_declaration, para_env, globenv) ENDDO CALL rep_env_calc_e_f(rep_env, calc_f=.TRUE.) j = 1 - minimum_energy = rep_env%f(rep_env%ndim+1, j) + minimum_energy = rep_env%f(rep_env%ndim + 1, j) IF (output_unit > 0) THEN WRITE (output_unit, '(T2,A)') & "VIB| ", " Minimum Structure - Energy and Forces:" ! WRITE (output_unit, '(T2,A,T42,A,9X,F15.9)') & - "VIB|", " Total Energy: ", rep_env%f(rep_env%ndim+1, j) + "VIB|", " Total Energy: ", rep_env%f(rep_env%ndim + 1, j) WRITE (output_unit, '(T2,"VIB|",T10,"ATOM",T33,3(9X,A,7X))') lab(1), lab(2), lab(3) DO i = 1, natoms imap = Mlist(i) WRITE (output_unit, '(T2,"VIB|",T12,A,T30,3(2X,F15.9))') & particles(imap)%atomic_kind%name, & - rep_env%f((imap-1)*3+1:(imap-1)*3+3, j) + rep_env%f((imap - 1)*3 + 1:(imap - 1)*3 + 3, j) END DO END IF @@ -402,12 +402,12 @@ SUBROUTINE vb_anal(input, input_declaration, para_env, globenv) IF (print_grrm > 0) THEN DO i = 1, natoms imap = Mlist(i) - particles(imap)%f(1:3) = rep_env%f((imap-1)*3+1:(imap-1)*3+3, 1) + particles(imap)%f(1:3) = rep_env%f((imap - 1)*3 + 1:(imap - 1)*3 + 3, 1) ENDDO ALLOCATE (Hint1(ncoord, ncoord), rmass(ncoord)) DO i = 1, natoms imap = Mlist(i) - rmass(3*(imap-1)+1:3*(imap-1)+3) = mass(imap) + rmass(3*(imap - 1) + 1:3*(imap - 1) + 3) = mass(imap) ENDDO DO i = 1, ncoord DO j = 1, ncoord @@ -419,7 +419,7 @@ SUBROUTINE vb_anal(input, input_declaration, para_env, globenv) END IF CALL cp_print_key_finished_output(print_grrm, logger, force_env_section, "PRINT%GRRM") ! - nvib = ncoord-nRotTrM + nvib = ncoord - nRotTrM ALLOCATE (H_eigval1(ncoord)) ALLOCATE (H_eigval2(SIZE(D, 2))) ALLOCATE (Hint1(ncoord, ncoord)) @@ -462,7 +462,7 @@ SUBROUTINE vb_anal(input, input_declaration, para_env, globenv) Hessian = 0.0_dp DO i = 1, natoms DO j = 1, 3 - Hessian((i-1)*3+j, (i-1)*3+j) = 1.0_dp/mass(i) + Hessian((i - 1)*3 + j, (i - 1)*3 + j) = 1.0_dp/mass(i) END DO END DO ! Cartesian displacements of the normal modes @@ -479,7 +479,7 @@ SUBROUTINE vb_anal(input, input_declaration, para_env, globenv) IF (calc_intens) THEN D_deriv = 0._dp DO j = 1, nvib - D_deriv(:) = D_deriv(:)+dip_deriv(:, j)*Hint2(j, i) + D_deriv(:) = D_deriv(:) + dip_deriv(:, j)*Hint2(j, i) END DO intensities(i) = SQRT(DOT_PRODUCT(D_deriv, D_deriv)) END IF @@ -567,9 +567,9 @@ SUBROUTINE get_moving_atoms(force_env, Ilist) DO ikind = 1, nkind molecule_kind => molecule_kind_set(ikind) CALL get_molecule_kind(molecule_kind, nfixd=nfixed_atoms) - nfixed_atoms_total = nfixed_atoms_total+nfixed_atoms + nfixed_atoms_total = nfixed_atoms_total + nfixed_atoms END DO - ndim = SIZE(particle_set)-nfixed_atoms_total + ndim = SIZE(particle_set) - nfixed_atoms_total CPASSERT(ndim >= 0) ALLOCATE (Ilist(ndim)) @@ -583,7 +583,7 @@ SUBROUTINE get_moving_atoms(force_env, Ilist) IF (ASSOCIATED(fixd_list)) THEN DO ii = 1, SIZE(fixd_list) IF (.NOT. fixd_list(ii)%restraint%active) THEN - nfixed_atoms_total = nfixed_atoms_total+1 + nfixed_atoms_total = nfixed_atoms_total + 1 ifixd_list(nfixed_atoms_total) = fixd_list(ii)%fixd END IF END DO @@ -595,11 +595,11 @@ SUBROUTINE get_moving_atoms(force_env, Ilist) j = 1 Loop_count: DO i = 1, SIZE(particle_set) DO WHILE (i > ifixd_list(j)) - j = j+1 + j = j + 1 IF (j > nfixed_atoms_total) EXIT Loop_count END DO IF (i /= ifixd_list(j)) THEN - ndim = ndim+1 + ndim = ndim + 1 Ilist(ndim) = i END IF END DO Loop_count @@ -610,7 +610,7 @@ SUBROUTINE get_moving_atoms(force_env, Ilist) ndim = 0 END IF DO j = i, SIZE(particle_set) - ndim = ndim+1 + ndim = ndim + 1 Ilist(ndim) = j END DO CALL timestop(handle) @@ -647,7 +647,7 @@ SUBROUTINE vib_out(iw, nvib, D, k, m, freq, particles, Mlist, intensities) WRITE (UNIT=iw, FMT="(T2,'VIB|')") DO jatom = 1, nvib, 3 from = jatom - to = MIN(from+2, nvib) + to = MIN(from + 2, nvib) WRITE (UNIT=iw, FMT="(T2,'VIB|',13X,3(8X,I5,8X))") & (icol, icol=from, to) WRITE (UNIT=iw, FMT="(T2,'VIB|Frequency (cm^-1)',3(1X,F12.6,8X))") & @@ -663,12 +663,12 @@ SUBROUTINE vib_out(iw, nvib, D, k, m, freq, particles, Mlist, intensities) WRITE (UNIT=iw, FMT="(T2,' ATOM',2X,'EL',7X,3(4X,' X ',1X,' Y ',1X,' Z '))") DO iatom = 1, natom, 3 katom = iatom/3 - IF (MOD(iatom, 3) /= 0) katom = katom+1 + IF (MOD(iatom, 3) /= 0) katom = katom + 1 CALL get_atomic_kind(atomic_kind=particles(Mlist(katom))%atomic_kind, & element_symbol=element_symbol) WRITE (UNIT=iw, FMT="(T2,I5,2X,A2,7X,3(4X,2(F5.2,1X),F5.2))") & Mlist(katom), element_symbol, & - ((D(iatom+j, icol), j=0, 2), icol=from, to) + ((D(iatom + j, icol), j=0, 2), icol=from, to) END DO WRITE (UNIT=iw, FMT="(/)") END DO @@ -704,13 +704,13 @@ SUBROUTINE build_D_matrix(mat, dof, Dout, full, natoms) my_full = .TRUE. IF (PRESENT(full)) my_full = full ! Generate the missing vectors of the orthogonal basis set - nvib = 3*natoms-dof + nvib = 3*natoms - dof ALLOCATE (work(3*natoms)) ALLOCATE (D(3*natoms, 3*natoms)) ! Check First orthogonality in the first element of the basis set DO i = 1, dof D(:, i) = mat(:, i) - DO j = i+1, dof + DO j = i + 1, dof norm = DOT_PRODUCT(mat(:, i), mat(:, j)) CPASSERT(ABS(norm) < thrs_motion) END DO @@ -719,30 +719,30 @@ SUBROUTINE build_D_matrix(mat, dof, Dout, full, natoms) iseq = 0 ifound = 0 DO WHILE (ifound /= nvib) - iseq = iseq+1 + iseq = iseq + 1 CPASSERT(iseq <= 3*natoms) work = 0.0_dp work(iseq) = 1.0_dp ! Gram Schmidt orthogonalization - DO i = 1, dof+ifound + DO i = 1, dof + ifound norm = DOT_PRODUCT(work, D(:, i)) - work(:) = work-norm*D(:, i) + work(:) = work - norm*D(:, i) END DO ! Check norm of the new generated vector norm = SQRT(DOT_PRODUCT(work, work)) IF (norm >= 10E4_dp*thrs_motion) THEN ! Accept new vector - ifound = ifound+1 - D(:, dof+ifound) = work/norm + ifound = ifound + 1 + D(:, dof + ifound) = work/norm END IF END DO - CPASSERT(dof+ifound == 3*natoms) + CPASSERT(dof + ifound == 3*natoms) IF (my_full) THEN ALLOCATE (Dout(3*natoms, 3*natoms)) Dout = D ELSE ALLOCATE (Dout(3*natoms, nvib)) - Dout = D(:, dof+1:) + Dout = D(:, dof + 1:) END IF DEALLOCATE (work) DEALLOCATE (D) @@ -791,7 +791,7 @@ SUBROUTINE get_thch_values(freqs, iw, mass, nvib, inertia, spin, totene, temp, p freqsum = 0.0_dp DO i = 1, nvib - freqsum = freqsum+freqs(i) + freqsum = freqsum + freqs(i) ENDDO ! ZPE @@ -811,7 +811,7 @@ SUBROUTINE get_thch_values(freqs, iw, mass, nvib, inertia, spin, totene, temp, p IF (inertia_kg(1)*inertia_kg(2)*inertia_kg(3) > 1.0_dp) THEN rot_part_func = fact*fact*fact*inertia_kg(1)*inertia_kg(2)*inertia_kg(3)*pi rot_part_func = SQRT(rot_part_func) - rot_entropy = n_avogadro*boltzmann*(LOG(rot_part_func)+1.5_dp) + rot_entropy = n_avogadro*boltzmann*(LOG(rot_part_func) + 1.5_dp) rot_energy = 1.5_dp*n_avogadro*boltzmann*temp rot_cv = 1.5_dp*n_avogadro*boltzmann ELSE @@ -823,14 +823,14 @@ SUBROUTINE get_thch_values(freqs, iw, mass, nvib, inertia, spin, totene, temp, p ELSE rot_part_func = fact*inertia_kg(3) END IF - rot_entropy = n_avogadro*boltzmann*(LOG(rot_part_func)+1.0_dp) + rot_entropy = n_avogadro*boltzmann*(LOG(rot_part_func) + 1.0_dp) rot_energy = n_avogadro*boltzmann*temp rot_cv = n_avogadro*boltzmann END IF ! TRANSLATIONAL: Partition function and Entropy tran_part_func = (boltzmann*temp)**2.5_dp/(pressure*(h_bar*2.0_dp*pi)**3.0_dp)*(2.0_dp*pi*mass_tot)**1.5_dp - tran_entropy = n_avogadro*boltzmann*(LOG(tran_part_func)+2.5_dp) + tran_entropy = n_avogadro*boltzmann*(LOG(tran_part_func) + 2.5_dp) tran_energy = 1.5_dp*n_avogadro*boltzmann*temp tran_enthalpy = 2.5_dp*n_avogadro*boltzmann*temp tran_cv = 2.5_dp*n_avogadro*boltzmann @@ -845,18 +845,18 @@ SUBROUTINE get_thch_values(freqs, iw, mass, nvib, inertia, spin, totene, temp, p DO i = 1, nvib freq_arg = fact*freqs(i) freq_arg2 = fact2*freqs(i) - exp_min_one = EXP(freq_arg)-1.0_dp - one_min_exp = 1.0_dp-EXP(-freq_arg) + exp_min_one = EXP(freq_arg) - 1.0_dp + one_min_exp = 1.0_dp - EXP(-freq_arg) !dbg ! write(*,*) 'freq ', i, freqs(i), exp_min_one , one_min_exp ! vib_part_func = vib_part_func*(1.0_dp/(1.0_dp - exp(-fact*freqs(i)))) vib_part_func = vib_part_func*(1.0_dp/one_min_exp) ! vib_energy = vib_energy + fact2*freqs(i)*0.5_dp+fact2*freqs(i)/(exp(fact*freqs(i))-1.0_dp) - vib_energy = vib_energy+freq_arg2*0.5_dp+freq_arg2/exp_min_one + vib_energy = vib_energy + freq_arg2*0.5_dp + freq_arg2/exp_min_one ! vib_entropy = vib_entropy +fact*freqs(i)/(exp(fact*freqs(i))-1.0_dp)-log(1.0_dp - exp(-fact*freqs(i))) - vib_entropy = vib_entropy+freq_arg/exp_min_one-LOG(one_min_exp) + vib_entropy = vib_entropy + freq_arg/exp_min_one - LOG(one_min_exp) ! vib_cv = vib_cv + fact*fact*freqs(i)*freqs(i)*exp(fact*freqs(i))/(exp(fact*freqs(i))-1.0_dp)/(exp(fact*freqs(i))-1.0_dp) - vib_cv = vib_cv+freq_arg*freq_arg*EXP(freq_arg)/exp_min_one/exp_min_one + vib_cv = vib_cv + freq_arg*freq_arg*EXP(freq_arg)/exp_min_one/exp_min_one ENDDO vib_energy = vib_energy*n_avogadro ! it contains already ZPE vib_entropy = vib_entropy*(n_avogadro*boltzmann) @@ -869,17 +869,17 @@ SUBROUTINE get_thch_values(freqs, iw, mass, nvib, inertia, spin, totene, temp, p !dbg ! write(*,*) 'entropy ', el_entropy,rot_entropy,tran_entropy,vib_entropy - entropy = el_entropy+rot_entropy+tran_entropy+vib_entropy + entropy = el_entropy + rot_entropy + tran_entropy + vib_entropy !dbg ! write(*,*) 'energy ', rot_energy , tran_enthalpy , vib_energy, totene*kjmol*1000.0_dp - rotvibtra = rot_energy+tran_enthalpy+vib_energy + rotvibtra = rot_energy + tran_enthalpy + vib_energy !dbg ! write(*,*) 'cv ', rot_cv, tran_cv, vib_cv - heat_capacity = vib_cv+tran_cv+rot_cv + heat_capacity = vib_cv + tran_cv + rot_cv ! Free energy in J/mol: internal energy + PV - TS - Gibbs = vib_energy+rot_energy+tran_enthalpy-temp*entropy + Gibbs = vib_energy + rot_energy + tran_enthalpy - temp*entropy DEALLOCATE (mass_kg) diff --git a/src/motion/wiener_process.F b/src/motion/wiener_process.F index 32c1e7b6d3..db09862cb3 100644 --- a/src/motion/wiener_process.F +++ b/src/motion/wiener_process.F @@ -119,7 +119,7 @@ SUBROUTINE create_wiener_process(md_env) seed(:, :, 1) = subsys%seed(:, :) DO iparticle = 2, nparticle - seed(:, :, iparticle) = next_rng_seed(seed(:, :, iparticle-1)) + seed(:, :, iparticle) = next_rng_seed(seed(:, :, iparticle - 1)) END DO ! Update initial seed @@ -238,7 +238,7 @@ SUBROUTINE create_wiener_process_cv(meta_env) seed(:, :, 1) = initial_seed DO i_c = 2, meta_env%n_colvar - seed(:, :, i_c) = next_rng_seed(seed(:, :, i_c-1)) + seed(:, :, i_c) = next_rng_seed(seed(:, :, i_c - 1)) END DO ! Update initial seed diff --git a/src/motion_utils.F b/src/motion_utils.F index 0475a8493b..2338083597 100644 --- a/src/motion_utils.F +++ b/src/motion_utils.F @@ -110,8 +110,8 @@ SUBROUTINE rot_ana(particles, mat, dof, print_section, keep_rotations, mass_weig mass = 1.0_dp IF (mass_weighted) mass = particles(iparticle)%atomic_kind%mass CPASSERT(mass >= 0.0_dp) - masst = masst+mass - rcom = particles(iparticle)%r*mass+rcom + masst = masst + mass + rcom = particles(iparticle)%r*mass + rcom END DO CPASSERT(masst > 0.0_dp) rcom = rcom/masst @@ -120,13 +120,13 @@ SUBROUTINE rot_ana(particles, mat, dof, print_section, keep_rotations, mass_weig DO iparticle = 1, natoms mass = 1.0_dp IF (mass_weighted) mass = particles(iparticle)%atomic_kind%mass - rm = particles(iparticle)%r-rcom - Ip(1, 1) = Ip(1, 1)+mass*(rm(2)**2+rm(3)**2) - Ip(2, 2) = Ip(2, 2)+mass*(rm(1)**2+rm(3)**2) - Ip(3, 3) = Ip(3, 3)+mass*(rm(1)**2+rm(2)**2) - Ip(1, 2) = Ip(1, 2)-mass*(rm(1)*rm(2)) - Ip(1, 3) = Ip(1, 3)-mass*(rm(1)*rm(3)) - Ip(2, 3) = Ip(2, 3)-mass*(rm(2)*rm(3)) + rm = particles(iparticle)%r - rcom + Ip(1, 1) = Ip(1, 1) + mass*(rm(2)**2 + rm(3)**2) + Ip(2, 2) = Ip(2, 2) + mass*(rm(1)**2 + rm(3)**2) + Ip(3, 3) = Ip(3, 3) + mass*(rm(1)**2 + rm(2)**2) + Ip(1, 2) = Ip(1, 2) - mass*(rm(1)*rm(2)) + Ip(1, 3) = Ip(1, 3) - mass*(rm(1)*rm(3)) + Ip(2, 3) = Ip(2, 3) - mass*(rm(2)*rm(3)) END DO ! Diagonalize the Inertia Tensor CALL diamat_all(Ip, Ip_eigval) @@ -162,7 +162,7 @@ SUBROUTINE rot_ana(particles, mat, dof, print_section, keep_rotations, mass_weig mass = 1.0_dp IF (mass_weighted) mass = SQRT(particles(iparticle)%atomic_kind%mass) DO j = 1, 3 - iseq = iseq+1 + iseq = iseq + 1 IF (j == k) Tr(iseq, k) = mass END DO END DO @@ -180,22 +180,22 @@ SUBROUTINE rot_ana(particles, mat, dof, print_section, keep_rotations, mass_weig DO iparticle = 1, natoms mass = 1.0_dp IF (mass_weighted) mass = SQRT(particles(iparticle)%atomic_kind%mass) - rm = particles(iparticle)%r-rcom - cp(1) = rm(1)*Ip(1, 1)+rm(2)*Ip(2, 1)+rm(3)*Ip(3, 1) - cp(2) = rm(1)*Ip(1, 2)+rm(2)*Ip(2, 2)+rm(3)*Ip(3, 2) - cp(3) = rm(1)*Ip(1, 3)+rm(2)*Ip(2, 3)+rm(3)*Ip(3, 3) + rm = particles(iparticle)%r - rcom + cp(1) = rm(1)*Ip(1, 1) + rm(2)*Ip(2, 1) + rm(3)*Ip(3, 1) + cp(2) = rm(1)*Ip(1, 2) + rm(2)*Ip(2, 2) + rm(3)*Ip(3, 2) + cp(3) = rm(1)*Ip(1, 3) + rm(2)*Ip(2, 3) + rm(3)*Ip(3, 3) ! X Rot - Rot((iparticle-1)*3+1, 1) = (cp(2)*Ip(1, 3)-Ip(1, 2)*cp(3))*mass - Rot((iparticle-1)*3+2, 1) = (cp(2)*Ip(2, 3)-Ip(2, 2)*cp(3))*mass - Rot((iparticle-1)*3+3, 1) = (cp(2)*Ip(3, 3)-Ip(3, 2)*cp(3))*mass + Rot((iparticle - 1)*3 + 1, 1) = (cp(2)*Ip(1, 3) - Ip(1, 2)*cp(3))*mass + Rot((iparticle - 1)*3 + 2, 1) = (cp(2)*Ip(2, 3) - Ip(2, 2)*cp(3))*mass + Rot((iparticle - 1)*3 + 3, 1) = (cp(2)*Ip(3, 3) - Ip(3, 2)*cp(3))*mass ! Y Rot - Rot((iparticle-1)*3+1, 2) = (cp(3)*Ip(1, 1)-Ip(1, 3)*cp(1))*mass - Rot((iparticle-1)*3+2, 2) = (cp(3)*Ip(2, 1)-Ip(2, 3)*cp(1))*mass - Rot((iparticle-1)*3+3, 2) = (cp(3)*Ip(3, 1)-Ip(3, 3)*cp(1))*mass + Rot((iparticle - 1)*3 + 1, 2) = (cp(3)*Ip(1, 1) - Ip(1, 3)*cp(1))*mass + Rot((iparticle - 1)*3 + 2, 2) = (cp(3)*Ip(2, 1) - Ip(2, 3)*cp(1))*mass + Rot((iparticle - 1)*3 + 3, 2) = (cp(3)*Ip(3, 1) - Ip(3, 3)*cp(1))*mass ! Z Rot - Rot((iparticle-1)*3+1, 3) = (cp(1)*Ip(1, 2)-Ip(1, 1)*cp(2))*mass - Rot((iparticle-1)*3+2, 3) = (cp(1)*Ip(2, 2)-Ip(2, 1)*cp(2))*mass - Rot((iparticle-1)*3+3, 3) = (cp(1)*Ip(3, 2)-Ip(3, 1)*cp(2))*mass + Rot((iparticle - 1)*3 + 1, 3) = (cp(1)*Ip(1, 2) - Ip(1, 1)*cp(2))*mass + Rot((iparticle - 1)*3 + 2, 3) = (cp(1)*Ip(2, 2) - Ip(2, 1)*cp(2))*mass + Rot((iparticle - 1)*3 + 3, 3) = (cp(1)*Ip(3, 2) - Ip(3, 1)*cp(2))*mass END DO ! Normalize Rotations and count the number of degree of freedom @@ -210,13 +210,13 @@ SUBROUTINE rot_ana(particles, mat, dof, print_section, keep_rotations, mass_weig ! Clean Rotational modes for spurious/numerical contamination IF (i < 3) THEN DO j = 1, i - Rot(:, i+1) = Rot(:, i+1)-DOT_PRODUCT(Rot(:, i+1), Rot(:, j))*Rot(:, j) + Rot(:, i + 1) = Rot(:, i + 1) - DOT_PRODUCT(Rot(:, i + 1), Rot(:, j))*Rot(:, j) END DO END IF END DO END IF IF (PRESENT(rot_dof)) rot_dof = COUNT(lrot == 1) - dof = dof+COUNT(lrot == 1) + dof = dof + COUNT(lrot == 1) iw = cp_print_key_unit_nr(logger, print_section, "ROTATIONAL_INFO", extension=".vibLog") IF (iw > 0) THEN WRITE (iw, '(T2,A,I6)') "ROT| Number of Rotovibrational vectors:", dof @@ -231,8 +231,8 @@ SUBROUTINE rot_ana(particles, mat, dof, print_section, keep_rotations, mass_weig DO i = 1, 3 mat(:, i) = Tr(:, i) IF (lrot(i) == 1) THEN - iseq = iseq+1 - mat(:, 3+iseq) = Rot(:, i) + iseq = iseq + 1 + mat(:, 3 + iseq) = Rot(:, i) END IF END DO END IF @@ -310,7 +310,7 @@ SUBROUTINE write_trajectory(force_env, root_section, it, time, dtime, etot, pk_n IF (PRESENT(act)) my_act = act IF (PRESENT(pk_name)) my_pk_name = pk_name - SELECT CASE (TRIM (my_pk_name)) + SELECT CASE (TRIM(my_pk_name)) CASE ("TRAJECTORY", "SHELL_TRAJECTORY", "CORE_TRAJECTORY") id_dcd = "CORD" id_wpc = "POS" @@ -432,7 +432,7 @@ SUBROUTINE write_trajectory(force_env, root_section, it, time, dtime, etot, pk_n DO i = 1, SIZE(force_mixing_indices) ii = force_mixing_indices(i) CPASSERT(ii <= SIZE(particle_set)) - fml_array((ii-1)*3+1:(ii-1)*3+3) = force_mixing_labels(i) + fml_array((ii - 1)*3 + 1:(ii - 1)*3 + 3) = force_mixing_labels(i) END DO ENDIF ENDIF diff --git a/src/mp2.F b/src/mp2.F index bc018c0857..cc9c16f6ef 100644 --- a/src/mp2.F +++ b/src/mp2.F @@ -306,9 +306,9 @@ SUBROUTINE mp2_main(qs_env, calc_forces) (mp2_env%method .NE. ri_rpa_method_gpw) .AND. & (mp2_env%method .NE. ri_mp2_laplace)) THEN CALL m_memory(mem) - mem_real = (mem+1024*1024-1)/(1024*1024) + mem_real = (mem + 1024*1024 - 1)/(1024*1024) CALL mp_max(mem_real, para_env%group) - mp2_env%mp2_memory = mp2_env%mp2_memory-mem_real + mp2_env%mp2_memory = mp2_env%mp2_memory - mem_real IF (mp2_env%mp2_memory < 0.0_dp) mp2_env%mp2_memory = 1.0_dp IF (unit_nr > 0) WRITE (unit_nr, '(T3,A,T68,F9.2,A4)') 'Available memory per MPI process for MP2:', & @@ -354,7 +354,7 @@ SUBROUTINE mp2_main(qs_env, calc_forces) max_nset = 0 DO iatom = 1, natom ikind = kind_of(iatom) - dimen = dimen+SUM(basis_parameter(ikind)%nsgf) + dimen = dimen + SUM(basis_parameter(ikind)%nsgf) max_nset = MAX(max_nset, basis_parameter(ikind)%nset) END DO @@ -478,8 +478,8 @@ SUBROUTINE mp2_main(qs_env, calc_forces) !$ n_threads = omp_get_max_threads() DO irep = 1, n_rep_hf - DO i_thread = 0, n_threads-1 - actual_x_data => qs_env%x_data(irep, i_thread+1) + DO i_thread = 0, n_threads - 1 + actual_x_data => qs_env%x_data(irep, i_thread + 1) do_dynamic_load_balancing = .TRUE. IF (n_threads == 1 .OR. actual_x_data%memory_parameter%do_disk_storage) do_dynamic_load_balancing = .FALSE. @@ -575,12 +575,12 @@ SUBROUTINE mp2_main(qs_env, calc_forces) IF (unit_nr > 0) WRITE (unit_nr, '(T3,A,T56,F25.14)') 'MP2 Energy Alpha-Beta= ', Emp2_AB IF (unit_nr > 0) WRITE (unit_nr, *) - Emp2 = Emp2_AA+Emp2_BB+Emp2_AB*2.0_dp !+Emp2_BA - Emp2_Cou = Emp2_AA_Cou+Emp2_BB_Cou+Emp2_AB_Cou*2.0_dp !+Emp2_BA - Emp2_ex = Emp2_AA_ex+Emp2_BB_ex+Emp2_AB_ex*2.0_dp !+Emp2_BA + Emp2 = Emp2_AA + Emp2_BB + Emp2_AB*2.0_dp !+Emp2_BA + Emp2_Cou = Emp2_AA_Cou + Emp2_BB_Cou + Emp2_AB_Cou*2.0_dp !+Emp2_BA + Emp2_ex = Emp2_AA_ex + Emp2_BB_ex + Emp2_AB_ex*2.0_dp !+Emp2_BA Emp2_S = Emp2_AB*2.0_dp - Emp2_T = Emp2_AA+Emp2_BB + Emp2_T = Emp2_AA + Emp2_BB ELSE @@ -689,7 +689,7 @@ SUBROUTINE mp2_main(qs_env, calc_forces) t2 = m_walltime() IF (unit_nr > 0) WRITE (unit_nr, *) IF (mp2_env%method .NE. ri_rpa_method_gpw) THEN - IF (unit_nr > 0) WRITE (unit_nr, '(T3,A,T56,F25.6)') 'Total MP2 Time=', t2-t1 + IF (unit_nr > 0) WRITE (unit_nr, '(T3,A,T56,F25.6)') 'Total MP2 Time=', t2 - t1 IF (mp2_env%method == ri_mp2_laplace) THEN Emp2_S = Emp2 Emp2_T = 0.0_dp @@ -702,7 +702,7 @@ SUBROUTINE mp2_main(qs_env, calc_forces) ! valid only in the closed shell case Emp2_S = Emp2_Cou/2.0_dp IF (calc_ex) THEN - Emp2_T = Emp2_ex+Emp2_Cou/2.0_dp + Emp2_T = Emp2_ex + Emp2_Cou/2.0_dp ELSE ! unknown if Emp2_ex is not computed Emp2_T = 0.0_dp @@ -715,10 +715,10 @@ SUBROUTINE mp2_main(qs_env, calc_forces) END IF Emp2_S = Emp2_S*mp2_env%scale_S Emp2_T = Emp2_T*mp2_env%scale_T - Emp2 = Emp2_S+Emp2_T + Emp2 = Emp2_S + Emp2_T IF (unit_nr > 0) WRITE (unit_nr, '(T3,A,T56,F25.14)') 'Second order perturbation energy = ', Emp2 ELSE - IF (unit_nr > 0) WRITE (unit_nr, '(T3,A,T56,F25.6)') 'Total RI-RPA Time=', t2-t1 + IF (unit_nr > 0) WRITE (unit_nr, '(T3,A,T56,F25.6)') 'Total RI-RPA Time=', t2 - t1 IF (unit_nr > 0) WRITE (unit_nr, '(T3,A,T56,F25.14)') 'RI-RPA energy = ', Emp2 IF (mp2_env%ri_rpa%do_ri_axk) THEN IF (unit_nr > 0) WRITE (unit_nr, '(T3,A,T56,F25.14)') 'RI-RPA-AXK energy=', mp2_env%ri_rpa%ener_axk @@ -734,13 +734,13 @@ SUBROUTINE mp2_main(qs_env, calc_forces) ! we have it !!!! IF (mp2_env%ri_rpa%do_ri_axk) THEN - Emp2 = Emp2+mp2_env%ri_rpa%ener_axk + Emp2 = Emp2 + mp2_env%ri_rpa%ener_axk ENDIF IF (mp2_env%ri_rpa%do_rse) THEN - Emp2 = Emp2+mp2_env%ri_rpa%rse_corr + Emp2 = Emp2 + mp2_env%ri_rpa%rse_corr ENDIF energy%mp2 = Emp2 - energy%total = energy%total+Emp2 + energy%total = energy%total + Emp2 DO ispin = 1, nspins CALL deallocate_mo_set(mo_set=mos_mp2(ispin)%mo_set) @@ -751,8 +751,8 @@ SUBROUTINE mp2_main(qs_env, calc_forces) IF (free_hfx_buffer .AND. (.NOT. calc_forces)) THEN CALL timeset(routineN//"_alloc_hfx", handle2) DO irep = 1, n_rep_hf - DO i_thread = 0, n_threads-1 - actual_x_data => qs_env%x_data(irep, i_thread+1) + DO i_thread = 0, n_threads - 1 + actual_x_data => qs_env%x_data(irep, i_thread + 1) do_dynamic_load_balancing = .TRUE. IF (n_threads == 1 .OR. actual_x_data%memory_parameter%do_disk_storage) do_dynamic_load_balancing = .FALSE. @@ -824,8 +824,8 @@ PURE SUBROUTINE build_index_table(natom, max_nset, index_table, basis_parameter, ikind = kind_of(iatom) nset = basis_parameter(ikind)%nset DO iset = 1, nset - index_table(iatom, iset) = counter+1 - counter = counter+basis_parameter(ikind)%nsgf(iset) + index_table(iatom, iset) = counter + 1 + counter = counter + basis_parameter(ikind)%nsgf(iset) END DO END DO @@ -944,10 +944,10 @@ SUBROUTINE mp2_direct_energy(dimen, occ_i, occ_j, mp2_biel, mp2_env, C_i, Auto_i ! Distribute the I index and the J index over groups total_I_size_batch_group = occ_i/number_i_subset IF (total_I_size_batch_group < 1) total_I_size_batch_group = 1 - ALLOCATE (vector_batch_I_size_group(0:number_i_subset-1)) + ALLOCATE (vector_batch_I_size_group(0:number_i_subset - 1)) vector_batch_I_size_group = 0 - DO i = 0, number_i_subset-1 + DO i = 0, number_i_subset - 1 vector_batch_I_size_group(i) = total_I_size_batch_group END DO IF (SUM(vector_batch_I_size_group) /= occ_i) THEN @@ -955,19 +955,19 @@ SUBROUTINE mp2_direct_energy(dimen, occ_i, occ_j, mp2_biel, mp2_env, C_i, Auto_i IF (SUM(vector_batch_I_size_group) > occ_i) one = -1 i = -1 DO - i = i+1 - vector_batch_I_size_group(i) = vector_batch_I_size_group(i)+one + i = i + 1 + vector_batch_I_size_group(i) = vector_batch_I_size_group(i) + one IF (SUM(vector_batch_I_size_group) == occ_i) EXIT - IF (i == number_i_subset-1) i = -1 + IF (i == number_i_subset - 1) i = -1 END DO END IF total_J_size_batch_group = occ_j/number_j_subset IF (total_J_size_batch_group < 1) total_J_size_batch_group = 1 - ALLOCATE (vector_batch_J_size_group(0:number_j_subset-1)) + ALLOCATE (vector_batch_J_size_group(0:number_j_subset - 1)) vector_batch_J_size_group = 0 - DO i = 0, number_J_subset-1 + DO i = 0, number_J_subset - 1 vector_batch_J_size_group(i) = total_J_size_batch_group END DO IF (SUM(vector_batch_J_size_group) /= occ_j) THEN @@ -975,10 +975,10 @@ SUBROUTINE mp2_direct_energy(dimen, occ_i, occ_j, mp2_biel, mp2_env, C_i, Auto_i IF (SUM(vector_batch_J_size_group) > occ_j) one = -1 i = -1 DO - i = i+1 - vector_batch_J_size_group(i) = vector_batch_J_size_group(i)+one + i = i + 1 + vector_batch_J_size_group(i) = vector_batch_J_size_group(i) + one IF (SUM(vector_batch_J_size_group) == occ_j) EXIT - IF (i == number_J_subset-1) i = -1 + IF (i == number_J_subset - 1) i = -1 END DO END IF @@ -986,22 +986,22 @@ SUBROUTINE mp2_direct_energy(dimen, occ_i, occ_j, mp2_biel, mp2_env, C_i, Auto_i group_counter = 0 i_group_counter = 0 my_I_occupied_start = 1 - DO i = 0, number_i_subset-1 + DO i = 0, number_i_subset - 1 my_J_occupied_start = 1 j_group_counter = 0 - DO j = 0, number_j_subset-1 - group_counter = group_counter+1 - IF (color_sub == group_counter-1) EXIT - my_J_occupied_start = my_J_occupied_start+vector_batch_J_size_group(j) - j_group_counter = j_group_counter+1 + DO j = 0, number_j_subset - 1 + group_counter = group_counter + 1 + IF (color_sub == group_counter - 1) EXIT + my_J_occupied_start = my_J_occupied_start + vector_batch_J_size_group(j) + j_group_counter = j_group_counter + 1 END DO - IF (color_sub == group_counter-1) EXIT - my_I_occupied_start = my_I_occupied_start+vector_batch_I_size_group(i) - i_group_counter = i_group_counter+1 + IF (color_sub == group_counter - 1) EXIT + my_I_occupied_start = my_I_occupied_start + vector_batch_I_size_group(i) + i_group_counter = i_group_counter + 1 END DO - my_I_occupied_end = my_I_occupied_start+vector_batch_I_size_group(i_group_counter)-1 + my_I_occupied_end = my_I_occupied_start + vector_batch_I_size_group(i_group_counter) - 1 my_I_batch_size = vector_batch_I_size_group(i_group_counter) - my_J_occupied_end = my_J_occupied_start+vector_batch_J_size_group(j_group_counter)-1 + my_J_occupied_end = my_J_occupied_start + vector_batch_J_size_group(j_group_counter) - 1 my_J_batch_size = vector_batch_J_size_group(j_group_counter) DEALLOCATE (vector_batch_I_size_group) @@ -1010,10 +1010,10 @@ SUBROUTINE mp2_direct_energy(dimen, occ_i, occ_j, mp2_biel, mp2_env, C_i, Auto_i max_batch_size = MIN( & MAX(1, & INT(mp2_env%mp2_memory*INT(1024, KIND=int_8)**2/ & - (8*(2*dimen-occ_i)*INT(dimen, KIND=int_8)*my_J_batch_size/para_env_sub%num_pe))) & + (8*(2*dimen - occ_i)*INT(dimen, KIND=int_8)*my_J_batch_size/para_env_sub%num_pe))) & , my_I_batch_size) IF (max_batch_size < 1) THEN - max_batch_size = INT((8*(occ_i+1)*INT(dimen, KIND=int_8)**2/para_env%num_pe)/1024**2) + max_batch_size = INT((8*(occ_i + 1)*INT(dimen, KIND=int_8)**2/para_env%num_pe)/1024**2) IF (unit_nr > 0) WRITE (unit_nr, '(T3,A,T72,I6,A3)') 'More memory required, at least:', max_batch_size, 'MiB' max_batch_size = 1 END IF @@ -1026,12 +1026,12 @@ SUBROUTINE mp2_direct_energy(dimen, occ_i, occ_j, mp2_biel, mp2_env, C_i, Auto_i batch_number = 0 DO i = 1, my_batch_size IF (i*max_batch_size > my_batch_size) EXIT - batch_number = batch_number+1 + batch_number = batch_number + 1 batch_sizes(i) = max_batch_size END DO - last_batch = my_batch_size-max_batch_size*batch_number + last_batch = my_batch_size - max_batch_size*batch_number IF (last_batch > 0) THEN - batch_number = batch_number+1 + batch_number = batch_number + 1 batch_sizes(batch_number) = last_batch END IF @@ -1055,16 +1055,16 @@ SUBROUTINE mp2_direct_energy(dimen, occ_i, occ_j, mp2_biel, mp2_env, C_i, Auto_i ! Batches sizes exceed the occupied orbitals allocated for group CPASSERT(SUM(batch_sizes) <= my_batch_size) - virt_i = dimen-occ_i - virt_j = dimen-occ_j + virt_i = dimen - occ_i + virt_j = dimen - occ_j natom = SIZE(mp2_biel%index_table, 1) CALL mp_sync(para_env%group) Emp2 = zero Emp2_Cou = zero Emp2_ex = zero - i_batch_start = my_I_occupied_start-1 - j_batch_start = my_J_occupied_start-1 + i_batch_start = my_I_occupied_start - 1 + j_batch_start = my_J_occupied_start - 1 Nj_occupied = my_J_batch_size DO i_batch = 1, batch_number @@ -1076,9 +1076,9 @@ SUBROUTINE mp2_direct_energy(dimen, occ_i, occ_j, mp2_biel, mp2_env, C_i, Auto_i ij_matrix = 0 DO i = 1, Ni_occupied DO j = 1, Nj_occupied - counter = counter+1 + counter = counter + 1 IF (MOD(counter, para_env_sub%num_pe) == para_env_sub%mepos) THEN - ij_matrix(i, j) = ij_matrix(i, j)+1 + ij_matrix(i, j) = ij_matrix(i, j) + 1 END IF END DO END DO @@ -1089,7 +1089,7 @@ SUBROUTINE mp2_direct_energy(dimen, occ_i, occ_j, mp2_biel, mp2_env, C_i, Auto_i DO i = 1, Ni_occupied DO j = 1, Nj_occupied IF (ij_matrix(i, j) == 0) CYCLE - elements_ij_proc = elements_ij_proc+1 + elements_ij_proc = elements_ij_proc + 1 ij_list_proc_temp(elements_ij_proc, 1) = i ij_list_proc_temp(elements_ij_proc, 2) = j END DO @@ -1114,7 +1114,7 @@ SUBROUTINE mp2_direct_energy(dimen, occ_i, occ_j, mp2_biel, mp2_env, C_i, Auto_i occ_j, C_j, Auto_j) END IF - i_batch_start = i_batch_start+Ni_occupied + i_batch_start = i_batch_start + Ni_occupied DEALLOCATE (ij_list_proc) @@ -1196,7 +1196,7 @@ SUBROUTINE calculate_exx(qs_env, unit_nr, do_gw, do_admm, E_ex_from_GW, t3) END DO ! Remove the Exchange-correlation energy contributions from the total energy - energy%total = energy%total-(energy%exc+energy%exc1+energy%ex+energy%exc_aux_fit) + energy%total = energy%total - (energy%exc + energy%exc1 + energy%ex + energy%exc_aux_fit) energy%exc = 0.0_dp energy%exc1 = 0.0_dp @@ -1205,7 +1205,7 @@ SUBROUTINE calculate_exx(qs_env, unit_nr, do_gw, do_admm, E_ex_from_GW, t3) ! take the exact exchange energy from GW or calculate it IF (do_gw) THEN - energy%total = energy%total+E_ex_from_GW + energy%total = energy%total + E_ex_from_GW energy%ex = E_ex_from_GW ELSE @@ -1223,17 +1223,17 @@ SUBROUTINE calculate_exx(qs_env, unit_nr, do_gw, do_admm, E_ex_from_GW, t3) rho_ao_2d, hfx_sections, & para_env, .TRUE., irep, .TRUE., & ispin=1) - ehfx = ehfx+eh1 + ehfx = ehfx + eh1 END DO ! include the EXX contribution to the total energy energy%ex = ehfx - energy%total = energy%total+energy%ex + energy%total = energy%total + energy%ex END IF t2 = m_walltime() - IF (unit_nr > 0) WRITE (unit_nr, '(T3,A,T56,F25.6)') 'Total EXX Time=', t2-t1+t3 + IF (unit_nr > 0) WRITE (unit_nr, '(T3,A,T56,F25.6)') 'Total EXX Time=', t2 - t1 + t3 IF (unit_nr > 0) WRITE (unit_nr, '(T3,A,T56,F25.14)') 'EXX energy = ', energy%ex ! reset to zero the Hartree-Fock energy @@ -1561,7 +1561,7 @@ SUBROUTINE compute_vec_Sigma_x_minus_vxc_gw(qs_env, mp2_env, mos_mp2, energy_ex, rho_ao_2d, hfx_sections, & para_env, .TRUE., irep, .TRUE., & ispin=1) - ehfx = ehfx+eh1 + ehfx = ehfx + eh1 END DO END IF energy_ex = ehfx @@ -1613,16 +1613,16 @@ SUBROUTINE compute_vec_Sigma_x_minus_vxc_gw(qs_env, mp2_env, mos_mp2, energy_ex, ! if corrected occ/virt levels exceed the number of occ/virt levels, ! correct all occ/virt level energies IF (gw_corr_lev_occ > homo) gw_corr_lev_occ = homo - IF (gw_corr_lev_virt > dimen-homo) gw_corr_lev_virt = dimen-homo + IF (gw_corr_lev_virt > dimen - homo) gw_corr_lev_virt = dimen - homo IF (ispin == 1) THEN mp2_env%ri_g0w0%corr_mos_occ = gw_corr_lev_occ mp2_env%ri_g0w0%corr_mos_virt = gw_corr_lev_virt ELSE IF (ispin == 2) THEN ! ensure that the total number of corrected MOs is the same for alpha and beta, important ! for parallelization - IF (mp2_env%ri_g0w0%corr_mos_occ+mp2_env%ri_g0w0%corr_mos_virt /= & - gw_corr_lev_occ+gw_corr_lev_virt) THEN - gw_corr_lev_virt = mp2_env%ri_g0w0%corr_mos_occ+mp2_env%ri_g0w0%corr_mos_virt-gw_corr_lev_occ + IF (mp2_env%ri_g0w0%corr_mos_occ + mp2_env%ri_g0w0%corr_mos_virt /= & + gw_corr_lev_occ + gw_corr_lev_virt) THEN + gw_corr_lev_virt = mp2_env%ri_g0w0%corr_mos_occ + mp2_env%ri_g0w0%corr_mos_virt - gw_corr_lev_occ END IF mp2_env%ri_g0w0%corr_mos_occ_beta = gw_corr_lev_occ mp2_env%ri_g0w0%corr_mos_virt_beta = gw_corr_lev_virt @@ -1630,12 +1630,12 @@ SUBROUTINE compute_vec_Sigma_x_minus_vxc_gw(qs_env, mp2_env, mos_mp2, energy_ex, END IF CALL dbcsr_multiply('N', 'N', 1.0_dp, matrix_sigma_x_minus_vxc(ispin, 1)%matrix, & - mo_coeff_b, 0.0_dp, matrix_tmp, first_column=homo+1-gw_corr_lev_occ, & - last_column=homo+gw_corr_lev_virt) + mo_coeff_b, 0.0_dp, matrix_tmp, first_column=homo + 1 - gw_corr_lev_occ, & + last_column=homo + gw_corr_lev_virt) CALL dbcsr_multiply('T', 'N', 1.0_dp, mo_coeff_b, & - matrix_tmp, 0.0_dp, matrix_tmp_2, first_row=homo+1-gw_corr_lev_occ, & - last_row=homo+gw_corr_lev_virt) + matrix_tmp, 0.0_dp, matrix_tmp_2, first_row=homo + 1 - gw_corr_lev_occ, & + last_row=homo + gw_corr_lev_virt) CALL dbcsr_get_diag(matrix_tmp_2, vec_Sigma_x_minus_vxc_gw(:, ispin, 1)) @@ -1677,9 +1677,9 @@ SUBROUTINE compute_vec_Sigma_x_minus_vxc_gw(qs_env, mp2_env, mos_mp2, energy_ex, WRITE (unit_nr, '(T3,A)') '-----------------' WRITE (unit_nr, '(T3,A)') '' WRITE (unit_nr, '(T6,2A)') 'MO Sigma_x-vxc' - DO n_level_gw = 1, gw_corr_lev_occ+gw_corr_lev_virt + DO n_level_gw = 1, gw_corr_lev_occ + gw_corr_lev_virt - n_level_gw_ref = n_level_gw+homo-gw_corr_lev_occ + n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ IF (n_level_gw <= gw_corr_lev_occ) THEN occ_virt = 'occ' ELSE @@ -1741,7 +1741,7 @@ SUBROUTINE compute_vec_Sigma_x_minus_vxc_gw(qs_env, mp2_env, mos_mp2, energy_ex, t2 = m_walltime() - t3 = t2-t1 + t3 = t2 - t1 CALL timestop(handle) @@ -1887,16 +1887,16 @@ SUBROUTINE transform_sigma_x_minus_vxc_to_MO_basis(kpoints, matrix_sigma_x_minus ! if corrected occ/virt levels exceed the number of occ/virt levels, ! correct all occ/virt level energies IF (gw_corr_lev_occ > homo) gw_corr_lev_occ = homo - IF (gw_corr_lev_virt > dimen-homo) gw_corr_lev_virt = dimen-homo + IF (gw_corr_lev_virt > dimen - homo) gw_corr_lev_virt = dimen - homo IF (ispin == 1) THEN mp2_env%ri_g0w0%corr_mos_occ = gw_corr_lev_occ mp2_env%ri_g0w0%corr_mos_virt = gw_corr_lev_virt ELSE IF (ispin == 2) THEN ! ensure that the total number of corrected MOs is the same for alpha and beta, important ! for parallelization - IF (mp2_env%ri_g0w0%corr_mos_occ+mp2_env%ri_g0w0%corr_mos_virt /= & - gw_corr_lev_occ+gw_corr_lev_virt) THEN - gw_corr_lev_virt = mp2_env%ri_g0w0%corr_mos_occ+mp2_env%ri_g0w0%corr_mos_virt-gw_corr_lev_occ + IF (mp2_env%ri_g0w0%corr_mos_occ + mp2_env%ri_g0w0%corr_mos_virt /= & + gw_corr_lev_occ + gw_corr_lev_virt) THEN + gw_corr_lev_virt = mp2_env%ri_g0w0%corr_mos_occ + mp2_env%ri_g0w0%corr_mos_virt - gw_corr_lev_occ END IF mp2_env%ri_g0w0%corr_mos_occ_beta = gw_corr_lev_occ mp2_env%ri_g0w0%corr_mos_virt_beta = gw_corr_lev_virt diff --git a/src/mp2_cphf.F b/src/mp2_cphf.F index 9cf81535a5..358c070798 100644 --- a/src/mp2_cphf.F +++ b/src/mp2_cphf.F @@ -192,10 +192,10 @@ SUBROUTINE solve_z_vector_eq(qs_env, mp2_env, para_env, dft_control, & ! start collecting stuff dimen = nmo - virtual = dimen-homo + virtual = dimen - homo potential_type = mp2_env%potential_parameter%potential_type omega = mp2_env%potential_parameter%omega - IF (alpha_beta) virtual_beta = dimen-homo_beta + IF (alpha_beta) virtual_beta = dimen - homo_beta NULLIFY (input, pw_env, matrix_s, blacs_env, rho, energy, force, virial, matrix_w_mp2, & matrix_p_mp2, matrix_ks, rho_core, sab_orb) CALL get_qs_env(qs_env, & @@ -300,7 +300,7 @@ SUBROUTINE solve_z_vector_eq(qs_env, mp2_env, para_env, dft_control, & CALL cp_fm_set_all(mo_coeff_v, 0.0_dp) CALL cp_fm_to_fm_submat(msource=mo_coeff, mtarget=mo_coeff_v, & nrow=dimen, ncol=virtual, & - s_firstrow=1, s_firstcol=homo+1, & + s_firstrow=1, s_firstcol=homo + 1, & t_firstrow=1, t_firstcol=1) IF (alpha_beta) THEN @@ -323,7 +323,7 @@ SUBROUTINE solve_z_vector_eq(qs_env, mp2_env, para_env, dft_control, & CALL cp_fm_set_all(mo_coeff_v_beta, 0.0_dp) CALL cp_fm_to_fm_submat(msource=mo_coeff_beta, mtarget=mo_coeff_v_beta, & nrow=dimen, ncol=virtual_beta, & - s_firstrow=1, s_firstcol=homo_beta+1, & + s_firstrow=1, s_firstcol=homo_beta + 1, & t_firstrow=1, t_firstcol=1) ENDIF @@ -339,8 +339,8 @@ SUBROUTINE solve_z_vector_eq(qs_env, mp2_env, para_env, dft_control, & !$ n_threads = omp_get_max_threads() DO irep = 1, n_rep_hf - DO i_thread = 0, n_threads-1 - actual_x_data => qs_env%x_data(irep, i_thread+1) + DO i_thread = 0, n_threads - 1 + actual_x_data => qs_env%x_data(irep, i_thread + 1) do_dynamic_load_balancing = .TRUE. IF (n_threads == 1 .OR. actual_x_data%memory_parameter%do_disk_storage) do_dynamic_load_balancing = .FALSE. @@ -517,7 +517,7 @@ SUBROUTINE solve_z_vector_eq(qs_env, mp2_env, para_env, dft_control, & CALL cp_fm_to_fm_submat(msource=P_ia, mtarget=P_mo, & nrow=homo, ncol=virtual, & s_firstrow=1, s_firstcol=1, & - t_firstrow=1, t_firstcol=homo+1) + t_firstrow=1, t_firstcol=homo + 1) CALL cp_fm_release(P_ia) ! transpose P_MO matrix (easy way to symmetrize) CALL cp_fm_set_all(fm_back, 0.0_dp) @@ -528,7 +528,7 @@ SUBROUTINE solve_z_vector_eq(qs_env, mp2_env, para_env, dft_control, & CALL cp_fm_to_fm_submat(msource=P_ia_beta, mtarget=P_mo_beta, & nrow=homo_beta, ncol=virtual_beta, & s_firstrow=1, s_firstcol=1, & - t_firstrow=1, t_firstcol=homo_beta+1) + t_firstrow=1, t_firstcol=homo_beta + 1) CALL cp_fm_release(P_ia_beta) ! transpose P_MO matrix (easy way to symmetrize) CALL cp_fm_set_all(fm_back, 0.0_dp) @@ -547,17 +547,17 @@ SUBROUTINE solve_z_vector_eq(qs_env, mp2_env, para_env, dft_control, & IF (j_global <= homo) THEN DO iiB = 1, nrow_local i_global = row_indices(iiB) - W_mo%local_data(iiB, jjB) = W_mo%local_data(iiB, jjB)-P_mo%local_data(iiB, jjB)*Eigenval(j_global) + W_mo%local_data(iiB, jjB) = W_mo%local_data(iiB, jjB) - P_mo%local_data(iiB, jjB)*Eigenval(j_global) END DO ELSE DO iiB = 1, nrow_local i_global = row_indices(iiB) IF (i_global <= homo) THEN ! virt-occ - W_mo%local_data(iiB, jjB) = W_mo%local_data(iiB, jjB)-P_mo%local_data(iiB, jjB)*Eigenval(i_global) + W_mo%local_data(iiB, jjB) = W_mo%local_data(iiB, jjB) - P_mo%local_data(iiB, jjB)*Eigenval(i_global) ELSE ! virt-virt - W_mo%local_data(iiB, jjB) = W_mo%local_data(iiB, jjB)-P_mo%local_data(iiB, jjB)*Eigenval(j_global) + W_mo%local_data(iiB, jjB) = W_mo%local_data(iiB, jjB) - P_mo%local_data(iiB, jjB)*Eigenval(j_global) END IF END DO END IF @@ -574,7 +574,7 @@ SUBROUTINE solve_z_vector_eq(qs_env, mp2_env, para_env, dft_control, & DO iiB = 1, nrow_local i_global = row_indices(iiB) W_mo_beta%local_data(iiB, jjB) = & - W_mo_beta%local_data(iiB, jjB)-P_mo_beta%local_data(iiB, jjB)*Eigenval_beta(j_global) + W_mo_beta%local_data(iiB, jjB) - P_mo_beta%local_data(iiB, jjB)*Eigenval_beta(j_global) END DO ELSE DO iiB = 1, nrow_local @@ -582,11 +582,11 @@ SUBROUTINE solve_z_vector_eq(qs_env, mp2_env, para_env, dft_control, & IF (i_global <= homo_beta) THEN ! virt-occ W_mo_beta%local_data(iiB, jjB) = & - W_mo_beta%local_data(iiB, jjB)-P_mo_beta%local_data(iiB, jjB)*Eigenval_beta(i_global) + W_mo_beta%local_data(iiB, jjB) - P_mo_beta%local_data(iiB, jjB)*Eigenval_beta(i_global) ELSE ! virt-virt W_mo_beta%local_data(iiB, jjB) = & - W_mo_beta%local_data(iiB, jjB)-P_mo_beta%local_data(iiB, jjB)*Eigenval_beta(j_global) + W_mo_beta%local_data(iiB, jjB) - P_mo_beta%local_data(iiB, jjB)*Eigenval_beta(j_global) END IF END DO END IF @@ -845,11 +845,11 @@ SUBROUTINE solve_z_vector_eq(qs_env, mp2_env, para_env, dft_control, & h_stress(alpha, alpha) = -e_hartree DO beta = alpha, 3 h_stress(alpha, beta) = h_stress(alpha, beta) & - -2.0_dp*pw_integral_ab(rho_g%pw, dvg(beta)%pw)/fourpi + - 2.0_dp*pw_integral_ab(rho_g%pw, dvg(beta)%pw)/fourpi h_stress(beta, alpha) = h_stress(alpha, beta) END DO END DO - virial%pv_virial = virial%pv_virial+h_stress/REAL(para_env%num_pe, dp) + virial%pv_virial = virial%pv_virial + h_stress/REAL(para_env%num_pe, dp) ! free stuff CALL pw_pool_give_back_pw(auxbas_pw_pool, temp_pw_g%pw) @@ -1033,8 +1033,8 @@ SUBROUTINE cphf_like_update(qs_env, para_env, homo, virtual, dimen, & mo_coeff_v, fm_mo, 0.0_dp, fm_back, & a_first_col=1, & a_first_row=1, & - b_first_col=homo+1, & - b_first_row=homo+1, & + b_first_col=homo + 1, & + b_first_row=homo + 1, & c_first_col=1, & c_first_row=1) CALL cp_fm_set_all(fm_ao, 0.0_dp) @@ -1052,8 +1052,8 @@ SUBROUTINE cphf_like_update(qs_env, para_env, homo, virtual, dimen, & mo_coeff_v_beta, fm_mo, 0.0_dp, fm_back, & a_first_col=1, & a_first_row=1, & - b_first_col=homo_beta+1, & - b_first_row=homo_beta+1, & + b_first_col=homo_beta + 1, & + b_first_row=homo_beta + 1, & c_first_col=1, & c_first_row=1) CALL cp_fm_set_all(fm_ao, 0.0_dp) @@ -1117,7 +1117,7 @@ SUBROUTINE cphf_like_update(qs_env, para_env, homo, virtual, dimen, & DO iiB = 1, nrow_local i_global = row_indices(iiB) fm_mo_out%local_data(iiB, jjB) = fm_mo_out%local_data(iiB, jjB)* & - (Eigenval(j_global+homo)-Eigenval(i_global)) + (Eigenval(j_global + homo) - Eigenval(i_global)) END DO END DO ELSE @@ -1394,7 +1394,7 @@ SUBROUTINE solve_z_vector_eq_low(qs_env, mp2_env, para_env, homo, virtual, dimen factor = 4.0_dp IF (PRESENT(homo_beta) .AND. PRESENT(Eigenval_beta)) alpha_beta = .TRUE. IF (alpha_beta) THEN - virtual_beta = dimen-homo_beta + virtual_beta = dimen - homo_beta factor = 2.0_dp ENDIF @@ -1446,7 +1446,7 @@ SUBROUTINE solve_z_vector_eq_low(qs_env, mp2_env, para_env, homo, virtual, dimen DO iiB = 1, nrow_local i_global = row_indices(iiB) precond%local_data(iiB, jjB) = precond%local_data(iiB, jjB)/ & - (Eigenval(j_global+homo)-Eigenval(i_global)) + (Eigenval(j_global + homo) - Eigenval(i_global)) END DO END DO @@ -1499,7 +1499,7 @@ SUBROUTINE solve_z_vector_eq_low(qs_env, mp2_env, para_env, homo, virtual, dimen DO iiB = 1, nrow_local_b i_global = row_indices(iiB) precond_b%local_data(iiB, jjB) = precond_b%local_data(iiB, jjB)/ & - (Eigenval_beta(j_global+homo_beta)-Eigenval_beta(i_global)) + (Eigenval_beta(j_global + homo_beta) - Eigenval_beta(i_global)) END DO END DO @@ -1523,7 +1523,7 @@ SUBROUTINE solve_z_vector_eq_low(qs_env, mp2_env, para_env, homo, virtual, dimen cycle_counter = 0 DO iiter = 1, max_num_iter - cycle_counter = cycle_counter+1 + cycle_counter = cycle_counter + 1 t1 = m_walltime() @@ -1535,8 +1535,8 @@ SUBROUTINE solve_z_vector_eq_low(qs_env, mp2_env, para_env, homo, virtual, dimen IF (.NOT. alpha_beta) THEN ! first compute the projection of the actual b_i into all previous x_i ! already scaled with the norm of each x_i - ALLOCATE (proj_bi_xj(iiter-1)) - DO iiB = 1, iiter-1 + ALLOCATE (proj_bi_xj(iiter - 1)) + DO iiB = 1, iiter - 1 proj_bi_xj(iiB) = 0.0_dp proj_bi_xj(iiB) = accurate_sum(b_i%local_data(1:nrow_local, 1:ncol_local)* & xn(iiB)%matrix%local_data(1:nrow_local, 1:ncol_local)) @@ -1546,8 +1546,8 @@ SUBROUTINE solve_z_vector_eq_low(qs_env, mp2_env, para_env, homo, virtual, dimen ! update actual x_i xn(iiter)%matrix%local_data(:, :) = b_i%local_data(:, :) - DO iiB = 1, iiter-1 - xn(iiter)%matrix%local_data(:, :) = xn(iiter)%matrix%local_data(:, :)- & + DO iiB = 1, iiter - 1 + xn(iiter)%matrix%local_data(:, :) = xn(iiter)%matrix%local_data(:, :) - & xn(iiB)%matrix%local_data(:, :)*proj_bi_xj(iiB) END DO DEALLOCATE (proj_bi_xj) @@ -1560,25 +1560,25 @@ SUBROUTINE solve_z_vector_eq_low(qs_env, mp2_env, para_env, homo, virtual, dimen ! first compute the projection of the actual b_i into all previous x_i ! already scaled with the norm of each x_i - ALLOCATE (proj_bi_xj(iiter-1)) - DO iiB = 1, iiter-1 + ALLOCATE (proj_bi_xj(iiter - 1)) + DO iiB = 1, iiter - 1 proj_bi_xj(iiB) = 0.0_dp proj_bi_xj(iiB) = & accurate_sum(b_i%local_data(1:nrow_local, 1:ncol_local)* & - xn(iiB)%matrix%local_data(1:nrow_local, 1:ncol_local))+ & + xn(iiB)%matrix%local_data(1:nrow_local, 1:ncol_local)) + & accurate_sum(b_i_b%local_data(1:nrow_local_b, 1:ncol_local_b)* & xn_b(iiB)%matrix%local_data(1:nrow_local_b, 1:ncol_local_b)) - proj_bi_xj(iiB) = proj_bi_xj(iiB)/(x_norm(iib)+x_norm_b(iib)) + proj_bi_xj(iiB) = proj_bi_xj(iiB)/(x_norm(iib) + x_norm_b(iib)) END DO CALL mp_sum(proj_bi_xj, para_env%group) ! update actual x_i xn(iiter)%matrix%local_data(:, :) = b_i%local_data(:, :) xn_b(iiter)%matrix%local_data(:, :) = b_i_b%local_data(:, :) - DO iiB = 1, iiter-1 - xn(iiter)%matrix%local_data(:, :) = xn(iiter)%matrix%local_data(:, :)- & + DO iiB = 1, iiter - 1 + xn(iiter)%matrix%local_data(:, :) = xn(iiter)%matrix%local_data(:, :) - & xn(iiB)%matrix%local_data(:, :)*proj_bi_xj(iiB) - xn_b(iiter)%matrix%local_data(:, :) = xn_b(iiter)%matrix%local_data(:, :)- & + xn_b(iiter)%matrix%local_data(:, :) = xn_b(iiter)%matrix%local_data(:, :) - & xn_b(iiB)%matrix%local_data(:, :)*proj_bi_xj(iiB) END DO DEALLOCATE (proj_bi_xj) @@ -1645,44 +1645,44 @@ SUBROUTINE solve_z_vector_eq_low(qs_env, mp2_env, para_env, homo, virtual, dimen ! iiter+1 -> ! iiter+2 -> - ALLOCATE (temp_vals(iiter+2)) + ALLOCATE (temp_vals(iiter + 2)) temp_vals = 0.0_dp ! DO iiB = 1, iiter temp_vals(iiB) = accurate_sum(Ax(iiter)%matrix%local_data(1:nrow_local, 1:ncol_local)* & xn(iiB)%matrix%local_data(1:nrow_local, 1:ncol_local)) IF (alpha_beta) THEN - temp_vals(iiB) = temp_vals(iib)+ & + temp_vals(iiB) = temp_vals(iib) + & accurate_sum(Ax_ab(iiter)%matrix%local_data(1:nrow_local, 1:ncol_local)* & - xn(iiB)%matrix%local_data(1:nrow_local, 1:ncol_local))+ & + xn(iiB)%matrix%local_data(1:nrow_local, 1:ncol_local)) + & accurate_sum(Ax_bb(iiter)%matrix%local_data(1:nrow_local_b, 1:ncol_local_b)* & - xn_b(iiB)%matrix%local_data(1:nrow_local_b, 1:ncol_local_b))+ & + xn_b(iiB)%matrix%local_data(1:nrow_local_b, 1:ncol_local_b)) + & accurate_sum(Ax_ba(iiter)%matrix%local_data(1:nrow_local_b, 1:ncol_local_b)* & xn_b(iiB)%matrix%local_data(1:nrow_local_b, 1:ncol_local_b)) ENDIF END DO ! - temp_vals(iiter+1) = accurate_sum(xn(iiter)%matrix%local_data(1:nrow_local, 1:ncol_local)* & - L_jb%local_data(1:nrow_local, 1:ncol_local)) + temp_vals(iiter + 1) = accurate_sum(xn(iiter)%matrix%local_data(1:nrow_local, 1:ncol_local)* & + L_jb%local_data(1:nrow_local, 1:ncol_local)) ! norm - temp_vals(iiter+2) = accurate_sum(xn(iiter)%matrix%local_data(1:nrow_local, 1:ncol_local)* & - xn(iiter)%matrix%local_data(1:nrow_local, 1:ncol_local)) + temp_vals(iiter + 2) = accurate_sum(xn(iiter)%matrix%local_data(1:nrow_local, 1:ncol_local)* & + xn(iiter)%matrix%local_data(1:nrow_local, 1:ncol_local)) IF (alpha_beta) THEN ! - temp_vals(iiter+1) = temp_vals(iiter+1)+ & - accurate_sum(xn_b(iiter)%matrix%local_data(1:nrow_local_b, 1:ncol_local_b)* & - L_jb_beta%local_data(1:nrow_local_b, 1:ncol_local_b)) + temp_vals(iiter + 1) = temp_vals(iiter + 1) + & + accurate_sum(xn_b(iiter)%matrix%local_data(1:nrow_local_b, 1:ncol_local_b)* & + L_jb_beta%local_data(1:nrow_local_b, 1:ncol_local_b)) ! norm - temp_vals(iiter+2) = temp_vals(iiter+2)+ & - accurate_sum(xn_b(iiter)%matrix%local_data(1:nrow_local_b, 1:ncol_local_b)* & - xn_b(iiter)%matrix%local_data(1:nrow_local_b, 1:ncol_local_b)) + temp_vals(iiter + 2) = temp_vals(iiter + 2) + & + accurate_sum(xn_b(iiter)%matrix%local_data(1:nrow_local_b, 1:ncol_local_b)* & + xn_b(iiter)%matrix%local_data(1:nrow_local_b, 1:ncol_local_b)) ENDIF CALL mp_sum(temp_vals, para_env%group) ! update , and norm xi_Axi(iiter, 1:iiter) = temp_vals(1:iiter) xi_Axi(1:iiter, iiter) = temp_vals(1:iiter) - xi_b(iiter) = temp_vals(iiter+1) - x_norm(iiter) = temp_vals(iiter+2) + xi_b(iiter) = temp_vals(iiter + 1) + x_norm(iiter) = temp_vals(iiter + 2) DEALLOCATE (temp_vals) ! solve reduced system @@ -1700,10 +1700,10 @@ SUBROUTINE solve_z_vector_eq_low(qs_env, mp2_env, para_env, homo, virtual, dimen IF (.NOT. alpha_beta) THEN DO iiB = 1, iiter residual%local_data(1:nrow_local, 1:ncol_local) = & - residual%local_data(1:nrow_local, 1:ncol_local)+ & + residual%local_data(1:nrow_local, 1:ncol_local) + & b_small(iiB, 1)*Ax(iiB)%matrix%local_data(1:nrow_local, 1:ncol_local) END DO - residual%local_data(1:nrow_local, 1:ncol_local) = residual%local_data(1:nrow_local, 1:ncol_local)- & + residual%local_data(1:nrow_local, 1:ncol_local) = residual%local_data(1:nrow_local, 1:ncol_local) - & L_jb%local_data(1:nrow_local, 1:ncol_local) conv = 0.0_dp conv = accurate_sum(residual%local_data(1:nrow_local, 1:ncol_local)* & @@ -1715,34 +1715,34 @@ SUBROUTINE solve_z_vector_eq_low(qs_env, mp2_env, para_env, homo, virtual, dimen CALL cp_fm_set_all(residual_b, 0.0_dp) DO iiB = 1, iiter residual%local_data(1:nrow_local, 1:ncol_local) = & - residual%local_data(1:nrow_local, 1:ncol_local)+ & - b_small(iiB, 1)*Ax(iiB)%matrix%local_data(1:nrow_local, 1:ncol_local)+ & + residual%local_data(1:nrow_local, 1:ncol_local) + & + b_small(iiB, 1)*Ax(iiB)%matrix%local_data(1:nrow_local, 1:ncol_local) + & b_small(iiB, 1)*Ax_ab(iiB)%matrix%local_data(1:nrow_local, 1:ncol_local) residual_b%local_data(1:nrow_local_b, 1:ncol_local_b) = & - residual_b%local_data(1:nrow_local_b, 1:ncol_local_b)+ & - b_small(iiB, 1)*Ax_bb(iiB)%matrix%local_data(1:nrow_local_b, 1:ncol_local_b)+ & + residual_b%local_data(1:nrow_local_b, 1:ncol_local_b) + & + b_small(iiB, 1)*Ax_bb(iiB)%matrix%local_data(1:nrow_local_b, 1:ncol_local_b) + & b_small(iiB, 1)*Ax_ba(iiB)%matrix%local_data(1:nrow_local_b, 1:ncol_local_b) END DO - residual%local_data(1:nrow_local, 1:ncol_local) = residual%local_data(1:nrow_local, 1:ncol_local)- & + residual%local_data(1:nrow_local, 1:ncol_local) = residual%local_data(1:nrow_local, 1:ncol_local) - & L_jb%local_data(1:nrow_local, 1:ncol_local) conv = 0.0_dp conv = accurate_sum(residual%local_data(1:nrow_local, 1:ncol_local)* & residual%local_data(1:nrow_local, 1:ncol_local)) CALL mp_sum(conv, para_env%group) conv = SQRT(conv) - residual_b%local_data(1:nrow_local_b, 1:ncol_local_b) = residual_b%local_data(1:nrow_local_b, 1:ncol_local_b)- & + residual_b%local_data(1:nrow_local_b, 1:ncol_local_b) = residual_b%local_data(1:nrow_local_b, 1:ncol_local_b) - & L_jb_beta%local_data(1:nrow_local_b, 1:ncol_local_b) conv_b = 0.0_dp conv_b = accurate_sum(residual_b%local_data(1:nrow_local_b, 1:ncol_local_b)* & residual_b%local_data(1:nrow_local_b, 1:ncol_local_b)) CALL mp_sum(conv_b, para_env%group) - conv = conv+SQRT(conv_b) + conv = conv + SQRT(conv_b) ENDIF t2 = m_walltime() IF (unit_nr > 0) THEN - WRITE (unit_nr, '(T3,I5,T13,F6.1,11X,F14.8)') iiter, t2-t1, conv + WRITE (unit_nr, '(T3,I5,T13,F6.1,11X,F14.8)') iiter, t2 - t1, conv END IF IF (conv <= eps_conv) THEN @@ -1756,9 +1756,9 @@ SUBROUTINE solve_z_vector_eq_low(qs_env, mp2_env, para_env, homo, virtual, dimen ELSE b_i%local_data(:, :) = precond%local_data(:, :)* & (Ax(iiter)%matrix%local_data(:, :) & - +Ax_ab(iiter)%matrix%local_data(:, :)) + + Ax_ab(iiter)%matrix%local_data(:, :)) b_i_b%local_data(:, :) = precond_b%local_data(:, :)* & - (Ax_bb(iiter)%matrix%local_data(:, :)+ & + (Ax_bb(iiter)%matrix%local_data(:, :) + & Ax_ba(iiter)%matrix%local_data(:, :)) ENDIF @@ -1766,12 +1766,12 @@ SUBROUTINE solve_z_vector_eq_low(qs_env, mp2_env, para_env, homo, virtual, dimen ! store solution into P_ia DO iiter = 1, cycle_counter - P_ia%local_data(1:nrow_local, 1:ncol_local) = P_ia%local_data(1:nrow_local, 1:ncol_local)+ & + P_ia%local_data(1:nrow_local, 1:ncol_local) = P_ia%local_data(1:nrow_local, 1:ncol_local) + & b_small(iiter, 1)*xn(iiter)%matrix%local_data(1:nrow_local, 1:ncol_local) ! The same for beta IF (alpha_beta) THEN P_ia_beta%local_data(1:nrow_local_b, 1:ncol_local_b) = & - P_ia_beta%local_data(1:nrow_local_b, 1:ncol_local_b)+ & + P_ia_beta%local_data(1:nrow_local_b, 1:ncol_local_b) + & b_small(iiter, 1)*xn_b(iiter)%matrix%local_data(1:nrow_local_b, 1:ncol_local_b) ENDIF END DO diff --git a/src/mp2_direct_method.F b/src/mp2_direct_method.F index e066014a93..1339a2d096 100644 --- a/src/mp2_direct_method.F +++ b/src/mp2_direct_method.F @@ -261,25 +261,25 @@ SUBROUTINE mp2_canonical_direct_single_batch(Emp2, Emp2_Cou, Emp2_ex, mp2_env, q ! for negative and positive number > num_pe ! needed to know which is the processor, to respect to another one, ! for a given shift - ALLOCATE (proc_map(-para_env%num_pe:2*para_env%num_pe-1)) - DO iiB = 0, para_env%num_pe-1 + ALLOCATE (proc_map(-para_env%num_pe:2*para_env%num_pe - 1)) + DO iiB = 0, para_env%num_pe - 1 proc_map(iiB) = iiB - proc_map(-iiB-1) = para_env%num_pe-iiB-1 - proc_map(para_env%num_pe+iiB) = iiB + proc_map(-iiB - 1) = para_env%num_pe - iiB - 1 + proc_map(para_env%num_pe + iiB) = iiB END DO ! calculate the minimum multiple of num_pe >= to Ni_occupied*occupied, in such a way ! that the i, j loop is performed exactly the same number of time for each procewssor multiple = 0 DO - multiple = multiple+para_env%num_pe + multiple = multiple + para_env%num_pe IF (multiple >= Ni_occupied*Nj_occupied) EXIT END DO ! proc_num_task contains the numer of time second occupied ! orbital transformation is called for each processor, needs for balancing ! the point to point send - ALLOCATE (proc_num_task(0:para_env%num_pe-1)) + ALLOCATE (proc_num_task(0:para_env%num_pe - 1)) proc_num_task = 0 @@ -300,10 +300,10 @@ SUBROUTINE mp2_canonical_direct_single_batch(Emp2, Emp2_Cou, Emp2_ex, mp2_env, q jset = set_list_ij(i_set_list_ij)%pair(2) IF (iatom == jatom .AND. jset < iset) CYCLE - counter_proc = counter_proc+1 + counter_proc = counter_proc + 1 proc_num = MOD(counter_proc, para_env%num_pe) - proc_num_task(proc_num) = proc_num_task(proc_num)+1 + proc_num_task(proc_num) = proc_num_task(proc_num) + 1 END DO END DO @@ -334,11 +334,11 @@ SUBROUTINE mp2_canonical_direct_single_batch(Emp2, Emp2_Cou, Emp2_ex, mp2_env, q jset = set_list_ij(i_set_list_ij)%pair(2) IF (iatom == jatom .AND. jset < iset) CYCLE - counter_proc = counter_proc+1 + counter_proc = counter_proc + 1 proc_num = MOD(counter_proc, para_env%num_pe) IF (proc_num == para_env%mepos) THEN - elements_kl_proc = elements_kl_proc+1 + elements_kl_proc = elements_kl_proc + 1 kl_list_proc(elements_kl_proc, 1) = i_list_ij kl_list_proc(elements_kl_proc, 2) = i_set_list_ij kl_list_proc(elements_kl_proc, 3) = counter_proc @@ -401,7 +401,7 @@ SUBROUTINE mp2_canonical_direct_single_batch(Emp2, Emp2_Cou, Emp2_ex, mp2_env, q jset = set_list_ij(i_set_list_ij)%pair(2) ncob = npgfb(jset)*ncoset(lb_max(jset)) - max_val1 = screen_coeffs_set(jset, iset, jkind, ikind)%x(1)*rab2+ & + max_val1 = screen_coeffs_set(jset, iset, jkind, ikind)%x(1)*rab2 + & screen_coeffs_set(jset, iset, jkind, ikind)%x(2) sphi_a_ext_set => sphi_a_ext(:, :, :, iset) @@ -434,15 +434,15 @@ SUBROUTINE mp2_canonical_direct_single_batch(Emp2, Emp2_Cou, Emp2_ex, mp2_env, q pmax_atom = 0.0_dp - screen_kind_ij = screen_coeffs_kind(jkind, ikind)%x(1)*rab2+ & + screen_kind_ij = screen_coeffs_kind(jkind, ikind)%x(1)*rab2 + & screen_coeffs_kind(jkind, ikind)%x(2) - screen_kind_kl = screen_coeffs_kind(lkind, kkind)%x(1)*rcd2+ & + screen_kind_kl = screen_coeffs_kind(lkind, kkind)%x(1)*rcd2 + & screen_coeffs_kind(lkind, kkind)%x(2) !!!!! Change the loop order - IF (max_val1+screen_kind_kl+pmax_atom < log10_eps_schwarz) CYCLE + IF (max_val1 + screen_kind_kl + pmax_atom < log10_eps_schwarz) CYCLE !!!!! - IF (screen_kind_ij+screen_kind_kl+pmax_atom < log10_eps_schwarz) CYCLE + IF (screen_kind_ij + screen_kind_kl + pmax_atom < log10_eps_schwarz) CYCLE lc_max => basis_parameter(kkind)%lmax lc_min => basis_parameter(kkind)%lmin @@ -472,19 +472,19 @@ SUBROUTINE mp2_canonical_direct_single_batch(Emp2, Emp2_Cou, Emp2_ex, mp2_env, q IF (katom == latom .AND. lset < kset) CYCLE - max_val2_set = (screen_coeffs_set(lset, kset, lkind, kkind)%x(1)*rcd2+ & + max_val2_set = (screen_coeffs_set(lset, kset, lkind, kkind)%x(1)*rcd2 + & screen_coeffs_set(lset, kset, lkind, kkind)%x(2)) - max_val2 = max_val1+max_val2_set + max_val2 = max_val1 + max_val2_set !! Near field screening - IF (max_val2+pmax_atom < log10_eps_schwarz) CYCLE + IF (max_val2 + pmax_atom < log10_eps_schwarz) CYCLE sphi_c_ext_set => sphi_c_ext(:, :, :, kset) sphi_d_ext_set => sphi_d_ext(:, :, :, lset) !! get max_vals if we screen on initial density pmax_entry = 0.0_dp log10_pmax = pmax_entry - max_val2 = max_val2+log10_pmax + max_val2 = max_val2 + log10_pmax IF (max_val2 < log10_eps_schwarz) CYCLE pmax_entry = EXP(log10_pmax*ln_10) @@ -531,12 +531,12 @@ SUBROUTINE mp2_canonical_direct_single_batch(Emp2, Emp2_Cou, Emp2_ex, mp2_env, q nimages, do_periodic, p_work) nints = nsgfa(iset)*nsgfb(jset)*nsgfc(kset)*nsgfd(lset) - neris_total = neris_total+nints - nprim_ints = nprim_ints+neris_tmp + neris_total = neris_total + nints + nprim_ints = nprim_ints + neris_tmp IF (cartesian_estimate == 0.0_dp) cartesian_estimate = TINY(cartesian_estimate) estimate_to_store_int = EXPONENT(cartesian_estimate) estimate_to_store_int = MAX(estimate_to_store_int, -15_int_8) - cartesian_estimate = SET_EXPONENT(1.0_dp, estimate_to_store_int+1) + cartesian_estimate = SET_EXPONENT(1.0_dp, estimate_to_store_int + 1) IF (cartesian_estimate < eps_schwarz) CYCLE @@ -545,7 +545,7 @@ SUBROUTINE mp2_canonical_direct_single_batch(Emp2, Emp2_Cou, Emp2_ex, mp2_env, q DO kkB = 1, nsgfc(kset) DO jjB = 1, nsgfb(jset) DO iiB = 1, nsgfa(iset) - primitive_counter = primitive_counter+1 + primitive_counter = primitive_counter + 1 MNRS(llB, kkB, jjB, iiB) = primitive_integrals(primitive_counter) END DO END DO @@ -558,21 +558,21 @@ SUBROUTINE mp2_canonical_direct_single_batch(Emp2, Emp2_Cou, Emp2_ex, mp2_env, q i_batch_start, Ni_occupied, & MNRS, C_T, mp2_biel, BI1) ELSE - task_counter_RS(global_counter, 4) = task_counter_RS(global_counter, 4)+1 + task_counter_RS(global_counter, 4) = task_counter_RS(global_counter, 4) + 1 cost_tmp = 0.0_dp cost_tmp = cost_model(nsgfd(lset), nsgfc(kset), nsgfb(jset), nsgfa(iset), & npgfd(lset), npgfc(kset), npgfb(jset), npgfa(iset), & max_val2/log10_eps_schwarz, & p1_energy, p2_energy, p3_energy) - cost_RS(global_counter) = cost_RS(global_counter)+cost_tmp + cost_RS(global_counter) = cost_RS(global_counter) + cost_tmp END IF END DO ! i_set_list_kl END DO ! i_list_kl IF (case_index == 2) THEN - my_num_call_sec_transf = my_num_call_sec_transf+1 + my_num_call_sec_transf = my_num_call_sec_transf + 1 IF (.NOT. alpha_beta_case) THEN IF (.NOT. mp2_env%direct_canonical%big_send) THEN CALL transform_occupied_orbitals_second(dimen, iatom, jatom, iset, jset, & @@ -612,21 +612,21 @@ SUBROUTINE mp2_canonical_direct_single_batch(Emp2, Emp2_Cou, Emp2_ex, mp2_env, q ALLOCATE (cost_RS_temp(total_num_RS_task)) step_size = 1 - ALLOCATE (same_size_kl_elements_counter((nsgf_max**2+1)/step_size+1)) + ALLOCATE (same_size_kl_elements_counter((nsgf_max**2 + 1)/step_size + 1)) same_size_kl_elements_counter = 0 same_size_kl_index = 0 global_counter = 0 - DO iiB = nsgf_max**2+1, 0, -step_size + DO iiB = nsgf_max**2 + 1, 0, -step_size DO jjB = 1, total_num_RS_task - IF (task_counter_RS(jjB, 3) > iiB-step_size .AND. task_counter_RS(jjB, 3) <= iiB) THEN - global_counter = global_counter+1 + IF (task_counter_RS(jjB, 3) > iiB - step_size .AND. task_counter_RS(jjB, 3) <= iiB) THEN + global_counter = global_counter + 1 task_counter_RS_temp(global_counter, 1:4) = task_counter_RS(jjB, 1:4) cost_RS_temp(global_counter) = cost_RS(jjB) END IF END DO - same_size_kl_index = same_size_kl_index+1 + same_size_kl_index = same_size_kl_index + 1 same_size_kl_elements_counter(same_size_kl_index) = global_counter END DO @@ -636,7 +636,7 @@ SUBROUTINE mp2_canonical_direct_single_batch(Emp2, Emp2_Cou, Emp2_ex, mp2_env, q i_start = 1 DO same_size_kl_index = 1, SIZE(same_size_kl_elements_counter) DO iiB = i_start, same_size_kl_elements_counter(same_size_kl_index) - DO jjB = iiB+1, same_size_kl_elements_counter(same_size_kl_index) + DO jjB = iiB + 1, same_size_kl_elements_counter(same_size_kl_index) IF (cost_RS_temp(jjB) >= cost_RS_temp(iiB)) THEN RS_counter_temp = task_counter_RS_temp(iiB, 1:4) @@ -649,13 +649,13 @@ SUBROUTINE mp2_canonical_direct_single_batch(Emp2, Emp2_Cou, Emp2_ex, mp2_env, q END IF END DO END DO - i_start = same_size_kl_elements_counter(same_size_kl_index)+1 + i_start = same_size_kl_elements_counter(same_size_kl_index) + 1 END DO proc_num_task = 0 DO counter_proc = 1, total_num_RS_task proc_num = MOD(counter_proc, para_env%num_pe) - proc_num_task(proc_num) = proc_num_task(proc_num)+1 + proc_num_task(proc_num) = proc_num_task(proc_num) + 1 END DO max_num_call_sec_transf = MAXVAL(proc_num_task) @@ -669,7 +669,7 @@ SUBROUTINE mp2_canonical_direct_single_batch(Emp2, Emp2_Cou, Emp2_ex, mp2_env, q DO counter_proc = 1, total_num_RS_task proc_num = MOD(counter_proc, para_env%num_pe) IF (proc_num == para_env%mepos) THEN - elements_kl_proc = elements_kl_proc+1 + elements_kl_proc = elements_kl_proc + 1 kl_list_proc(elements_kl_proc, 1) = task_counter_RS_temp(counter_proc, 1) kl_list_proc(elements_kl_proc, 2) = task_counter_RS_temp(counter_proc, 2) END IF @@ -691,11 +691,11 @@ SUBROUTINE mp2_canonical_direct_single_batch(Emp2, Emp2_Cou, Emp2_ex, mp2_env, q END IF - DO iiB = my_num_call_sec_transf+1, max_num_call_sec_transf - DO index_proc_shift = 0, para_env%num_pe-1 + DO iiB = my_num_call_sec_transf + 1, max_num_call_sec_transf + DO index_proc_shift = 0, para_env%num_pe - 1 - proc_send = proc_map(para_env%mepos+index_proc_shift) - proc_receive = proc_map(para_env%mepos-index_proc_shift) + proc_send = proc_map(para_env%mepos + index_proc_shift) + proc_receive = proc_map(para_env%mepos - index_proc_shift) case_send_receive = (proc_send /= para_env%mepos) @@ -710,9 +710,9 @@ SUBROUTINE mp2_canonical_direct_single_batch(Emp2, Emp2_Cou, Emp2_ex, mp2_env, q S_offset_rec = size_parameter_rec(4) elements_ij_proc_rec = size_parameter_rec(5) IF (.NOT. mp2_env%direct_canonical%big_send) THEN - ALLOCATE (BIb_RS_mat_rec(dimen, Rsize_rec+Ssize_rec)) + ALLOCATE (BIb_RS_mat_rec(dimen, Rsize_rec + Ssize_rec)) ELSE - ALLOCATE (BIb_RS_mat_rec_big(dimen, Rsize_rec+Ssize_rec, ij_elem_max)) + ALLOCATE (BIb_RS_mat_rec_big(dimen, Rsize_rec + Ssize_rec, ij_elem_max)) END IF ELSE elements_ij_proc_rec = elements_ij_proc @@ -721,7 +721,7 @@ SUBROUTINE mp2_canonical_direct_single_batch(Emp2, Emp2_Cou, Emp2_ex, mp2_env, q IF (.NOT. mp2_env%direct_canonical%big_send) THEN index_ij_send = 0 index_ij_rec = 0 - DO index_proc_ij = proc_send+1, multiple, para_env%num_pe + DO index_proc_ij = proc_send + 1, multiple, para_env%num_pe zero_mat = 0.D+00 @@ -729,16 +729,16 @@ SUBROUTINE mp2_canonical_direct_single_batch(Emp2, Emp2_Cou, Emp2_ex, mp2_env, q CALL mp_sendrecv(zero_mat, proc_send, BIb_RS_mat_rec, proc_receive, para_env%group) - index_ij_rec = index_ij_rec+1 + index_ij_rec = index_ij_rec + 1 IF (index_ij_rec <= elements_ij_proc .AND. elements_ij_proc > 0) THEN - BIb(1:dimen, R_offset_rec+1:R_offset_rec+Rsize_rec, index_ij_rec) = & - BIb(1:dimen, R_offset_rec+1:R_offset_rec+Rsize_rec, index_ij_rec)+ & + BIb(1:dimen, R_offset_rec + 1:R_offset_rec + Rsize_rec, index_ij_rec) = & + BIb(1:dimen, R_offset_rec + 1:R_offset_rec + Rsize_rec, index_ij_rec) + & BIb_RS_mat_rec(1:dimen, 1:Rsize_rec) - BIb(1:dimen, S_offset_rec+1:S_offset_rec+Ssize_rec, index_ij_rec) = & - BIb(1:dimen, S_offset_rec+1:S_offset_rec+Ssize_rec, index_ij_rec)+ & - BIb_RS_mat_rec(1:dimen, Rsize_rec+1:Rsize_rec+Ssize_rec) + BIb(1:dimen, S_offset_rec + 1:S_offset_rec + Ssize_rec, index_ij_rec) = & + BIb(1:dimen, S_offset_rec + 1:S_offset_rec + Ssize_rec, index_ij_rec) + & + BIb_RS_mat_rec(1:dimen, Rsize_rec + 1:Rsize_rec + Ssize_rec) END IF END IF @@ -751,13 +751,13 @@ SUBROUTINE mp2_canonical_direct_single_batch(Emp2, Emp2_Cou, Emp2_ex, mp2_env, q CALL mp_sendrecv(zero_mat_big, proc_send, BIb_RS_mat_rec_big, proc_receive, para_env%group) - BIb(1:dimen, R_offset_rec+1:R_offset_rec+Rsize_rec, 1:elements_ij_proc) = & - BIb(1:dimen, R_offset_rec+1:R_offset_rec+Rsize_rec, 1:elements_ij_proc)+ & + BIb(1:dimen, R_offset_rec + 1:R_offset_rec + Rsize_rec, 1:elements_ij_proc) = & + BIb(1:dimen, R_offset_rec + 1:R_offset_rec + Rsize_rec, 1:elements_ij_proc) + & BIb_RS_mat_rec_big(1:dimen, 1:Rsize_rec, 1:elements_ij_proc) - BIb(1:dimen, S_offset_rec+1:S_offset_rec+Ssize_rec, 1:elements_ij_proc) = & - BIb(1:dimen, S_offset_rec+1:S_offset_rec+Ssize_rec, 1:elements_ij_proc)+ & - BIb_RS_mat_rec_big(1:dimen, Rsize_rec+1:Rsize_rec+Ssize_rec, 1:elements_ij_proc) + BIb(1:dimen, S_offset_rec + 1:S_offset_rec + Ssize_rec, 1:elements_ij_proc) = & + BIb(1:dimen, S_offset_rec + 1:S_offset_rec + Ssize_rec, 1:elements_ij_proc) + & + BIb_RS_mat_rec_big(1:dimen, Rsize_rec + 1:Rsize_rec + Ssize_rec, 1:elements_ij_proc) END IF END IF @@ -782,12 +782,12 @@ SUBROUTINE mp2_canonical_direct_single_batch(Emp2, Emp2_Cou, Emp2_ex, mp2_env, q DEALLOCATE (primitive_integrals) IF (.NOT. alpha_beta_case) THEN - CALL transform_virtual_orbitals_and_accumulate(dimen, occupied, dimen-occupied, i_batch_start, & + CALL transform_virtual_orbitals_and_accumulate(dimen, occupied, dimen - occupied, i_batch_start, & j_batch_start, BIb, C, Auto, elements_ij_proc, ij_list_proc, & nspins, Emp2, Emp2_Cou, Emp2_ex) ELSE CALL transform_virtual_orbitals_and_accumulate_ABcase( & - dimen, occupied, occupied_beta, dimen-occupied, dimen-occupied_beta, & + dimen, occupied, occupied_beta, dimen - occupied, dimen - occupied_beta, & i_batch_start, j_batch_start, & BIb, C, C_beta, Auto, Auto_beta, & elements_ij_proc, ij_list_proc, Emp2, Emp2_Cou) @@ -796,20 +796,20 @@ SUBROUTINE mp2_canonical_direct_single_batch(Emp2, Emp2_Cou, Emp2_ex, mp2_env, q IF (copy_integrals) THEN IF (.NOT. alpha_beta_case) THEN - ALLOCATE (Integ_MP2(dimen-occupied, dimen-occupied, occupied, occupied)) + ALLOCATE (Integ_MP2(dimen - occupied, dimen - occupied, occupied, occupied)) Integ_MP2 = 0.0_dp DO i = 1, elements_ij_proc iiB = ij_list_proc(i, 1) jjB = ij_list_proc(i, 2) - Integ_MP2(:, :, iiB+i_batch_start, jjB+j_batch_start) = BIb(1:dimen-occupied, 1:dimen-occupied, i) + Integ_MP2(:, :, iiB + i_batch_start, jjB + j_batch_start) = BIb(1:dimen - occupied, 1:dimen - occupied, i) END DO ELSE - ALLOCATE (Integ_MP2(dimen-occupied, dimen-occupied_beta, occupied, occupied_beta)) + ALLOCATE (Integ_MP2(dimen - occupied, dimen - occupied_beta, occupied, occupied_beta)) Integ_MP2 = 0.0_dp DO i = 1, elements_ij_proc iiB = ij_list_proc(i, 1) jjB = ij_list_proc(i, 2) - Integ_MP2(:, :, iiB+i_batch_start, jjB+j_batch_start) = BIb(1:dimen-occupied, 1:dimen-occupied_beta, i) + Integ_MP2(:, :, iiB + i_batch_start, jjB + j_batch_start) = BIb(1:dimen - occupied, 1:dimen - occupied_beta, i) END DO END IF END IF @@ -889,10 +889,10 @@ SUBROUTINE transform_occupied_orbitals_first(dimen, latom, katom, jatom, iatom, R_offset, R_start, s, S_offset REAL(KIND=dp) :: MNRS_element - N_offset = mp2_biel%index_table(jatom, jset)-1 - M_offset = mp2_biel%index_table(iatom, iset)-1 - S_offset = mp2_biel%index_table(latom, lset)-1 - R_offset = mp2_biel%index_table(katom, kset)-1 + N_offset = mp2_biel%index_table(jatom, jset) - 1 + M_offset = mp2_biel%index_table(iatom, iset) - 1 + S_offset = mp2_biel%index_table(latom, lset) - 1 + R_offset = mp2_biel%index_table(katom, kset) - 1 DO S = 1, Ssize R_start = 1 @@ -901,26 +901,26 @@ SUBROUTINE transform_occupied_orbitals_first(dimen, latom, katom, jatom, iatom, ! fast i don't know why DO N = 1, Nsize - N_global = N+N_offset + N_global = N + N_offset M_start = 1 IF (iatom == jatom .AND. iset == jset) THEN M = N - M_global = M+M_offset + M_global = M + M_offset MNRS_element = MNRS(M, N, R, S) DO i = 1, Ni_occupied - i_global = i+i_batch_start - BI1(N_global, i, R, S) = BI1(N_global, i, R, S)+C_T(i_global, M_global)*MNRS_element + i_global = i + i_batch_start + BI1(N_global, i, R, S) = BI1(N_global, i, R, S) + C_T(i_global, M_global)*MNRS_element END DO - M_start = N+1 + M_start = N + 1 END IF DO M = M_start, Msize - M_global = M+M_offset + M_global = M + M_offset MNRS_element = MNRS(M, N, R, S) DO i = 1, Ni_occupied - i_global = i+i_batch_start - BI1(N_global, i, R, S) = BI1(N_global, i, R, S)+C_T(i_global, M_global)*MNRS_element - BI1(M_global, i, R, S) = BI1(M_global, i, R, S)+C_T(i_global, N_global)*MNRS_element + i_global = i + i_batch_start + BI1(N_global, i, R, S) = BI1(N_global, i, R, S) + C_T(i_global, M_global)*MNRS_element + BI1(M_global, i, R, S) = BI1(M_global, i, R, S) + C_T(i_global, N_global)*MNRS_element END DO END DO END DO @@ -987,8 +987,8 @@ SUBROUTINE transform_occupied_orbitals_second(dimen, latom, katom, lset, kset, & CALL timeset(routineN, handle) - S_offset = mp2_biel%index_table(latom, lset)-1 - R_offset = mp2_biel%index_table(katom, kset)-1 + S_offset = mp2_biel%index_table(latom, lset) - 1 + R_offset = mp2_biel%index_table(katom, kset) - 1 size_parameter_send(1) = Rsize size_parameter_send(2) = Ssize @@ -996,10 +996,10 @@ SUBROUTINE transform_occupied_orbitals_second(dimen, latom, katom, lset, kset, & size_parameter_send(4) = S_offset size_parameter_send(5) = elements_ij_proc - DO index_proc_shift = 0, para_env%num_pe-1 + DO index_proc_shift = 0, para_env%num_pe - 1 - proc_send = proc_map(para_env%mepos+index_proc_shift) - proc_receive = proc_map(para_env%mepos-index_proc_shift) + proc_send = proc_map(para_env%mepos + index_proc_shift) + proc_receive = proc_map(para_env%mepos - index_proc_shift) case_send_receive = (proc_send /= para_env%mepos) @@ -1013,7 +1013,7 @@ SUBROUTINE transform_occupied_orbitals_second(dimen, latom, katom, lset, kset, & R_offset_rec = size_parameter_rec(3) S_offset_rec = size_parameter_rec(4) elements_ij_proc_rec = size_parameter_rec(5) - ALLOCATE (BIb_RS_mat_rec(dimen, Rsize_rec+Ssize_rec)) + ALLOCATE (BIb_RS_mat_rec(dimen, Rsize_rec + Ssize_rec)) ELSE elements_ij_proc_rec = elements_ij_proc @@ -1021,36 +1021,36 @@ SUBROUTINE transform_occupied_orbitals_second(dimen, latom, katom, lset, kset, & index_ij_send = 0 index_ij_rec = 0 - DO index_proc_ij = proc_send+1, multiple, para_env%num_pe + DO index_proc_ij = proc_send + 1, multiple, para_env%num_pe BIb_RS_mat = zero IF (index_proc_ij <= Ni_occupied*Nj_occupied) THEN - index_ij_send = index_ij_send+1 + index_ij_send = index_ij_send + 1 - i = (index_proc_ij-1)/Nj_occupied+1 - j = index_proc_ij-(i-1)*Nj_occupied+j_batch_start + i = (index_proc_ij - 1)/Nj_occupied + 1 + j = index_proc_ij - (i - 1)*Nj_occupied + j_batch_start DO S = 1, Ssize - S_global = S+S_offset + S_global = S + S_offset R_start = 1 IF (katom == latom .AND. kset == lset) R_start = S DO R = R_start, Rsize - R_global = R+R_offset + R_global = R + R_offset IF (R_global /= S_global) THEN C_T_R = C_T(j, R_global) C_T_S = C_T(j, S_global) DO N = 1, dimen - BIb_RS_mat(N, R) = BIb_RS_mat(N, R)+C_T_S*BI1(N, i, R, S) + BIb_RS_mat(N, R) = BIb_RS_mat(N, R) + C_T_S*BI1(N, i, R, S) END DO DO N = 1, dimen - BIb_RS_mat(N, Rsize+S) = BIb_RS_mat(N, Rsize+S)+C_T_R*BI1(N, i, R, S) + BIb_RS_mat(N, Rsize + S) = BIb_RS_mat(N, Rsize + S) + C_T_R*BI1(N, i, R, S) END DO ELSE C_T_S = C_T(j, S_global) DO N = 1, dimen - BIb_RS_mat(N, R) = BIb_RS_mat(N, R)+C_T_S*BI1(N, i, R, S) + BIb_RS_mat(N, R) = BIb_RS_mat(N, R) + C_T_S*BI1(N, i, R, S) END DO END IF @@ -1063,27 +1063,27 @@ SUBROUTINE transform_occupied_orbitals_second(dimen, latom, katom, lset, kset, & CALL mp_sendrecv(BIb_RS_mat, proc_send, BIb_RS_mat_rec, proc_receive, para_env%group) - index_ij_rec = index_ij_rec+1 + index_ij_rec = index_ij_rec + 1 IF (index_ij_rec <= elements_ij_proc .AND. elements_ij_proc > 0) THEN - BIb(1:dimen, R_offset_rec+1:R_offset_rec+Rsize_rec, index_ij_rec) = & - BIb(1:dimen, R_offset_rec+1:R_offset_rec+Rsize_rec, index_ij_rec)+ & + BIb(1:dimen, R_offset_rec + 1:R_offset_rec + Rsize_rec, index_ij_rec) = & + BIb(1:dimen, R_offset_rec + 1:R_offset_rec + Rsize_rec, index_ij_rec) + & BIb_RS_mat_rec(1:dimen, 1:Rsize_rec) - BIb(1:dimen, S_offset_rec+1:S_offset_rec+Ssize_rec, index_ij_rec) = & - BIb(1:dimen, S_offset_rec+1:S_offset_rec+Ssize_rec, index_ij_rec)+ & - BIb_RS_mat_rec(1:dimen, Rsize_rec+1:Rsize_rec+Ssize_rec) + BIb(1:dimen, S_offset_rec + 1:S_offset_rec + Ssize_rec, index_ij_rec) = & + BIb(1:dimen, S_offset_rec + 1:S_offset_rec + Ssize_rec, index_ij_rec) + & + BIb_RS_mat_rec(1:dimen, Rsize_rec + 1:Rsize_rec + Ssize_rec) END IF ELSE ! the processor is the sender and receiver itself IF (index_ij_send <= elements_ij_proc .AND. elements_ij_proc > 0) THEN - BIb(1:dimen, R_offset+1:R_offset+Rsize, index_ij_send) = & - BIb(1:dimen, R_offset+1:R_offset+Rsize, index_ij_send)+BIb_RS_mat(1:dimen, 1:Rsize) + BIb(1:dimen, R_offset + 1:R_offset + Rsize, index_ij_send) = & + BIb(1:dimen, R_offset + 1:R_offset + Rsize, index_ij_send) + BIb_RS_mat(1:dimen, 1:Rsize) - BIb(1:dimen, S_offset+1:S_offset+Ssize, index_ij_send) = & - BIb(1:dimen, S_offset+1:S_offset+Ssize, index_ij_send)+BIb_RS_mat(1:dimen, Rsize+1:Rsize+Ssize) + BIb(1:dimen, S_offset + 1:S_offset + Ssize, index_ij_send) = & + BIb(1:dimen, S_offset + 1:S_offset + Ssize, index_ij_send) + BIb_RS_mat(1:dimen, Rsize + 1:Rsize + Ssize) END IF END IF @@ -1158,8 +1158,8 @@ SUBROUTINE transform_occupied_orbitals_second_big(dimen, latom, katom, lset, kse CALL timeset(routineN, handle) - S_offset = mp2_biel%index_table(latom, lset)-1 - R_offset = mp2_biel%index_table(katom, kset)-1 + S_offset = mp2_biel%index_table(latom, lset) - 1 + R_offset = mp2_biel%index_table(katom, kset) - 1 size_parameter_send(1) = Rsize size_parameter_send(2) = Ssize @@ -1167,10 +1167,10 @@ SUBROUTINE transform_occupied_orbitals_second_big(dimen, latom, katom, lset, kse size_parameter_send(4) = S_offset size_parameter_send(5) = elements_ij_proc - DO index_proc_shift = 0, para_env%num_pe-1 + DO index_proc_shift = 0, para_env%num_pe - 1 - proc_send = proc_map(para_env%mepos+index_proc_shift) - proc_receive = proc_map(para_env%mepos-index_proc_shift) + proc_send = proc_map(para_env%mepos + index_proc_shift) + proc_receive = proc_map(para_env%mepos - index_proc_shift) case_send_receive = (proc_send /= para_env%mepos) @@ -1184,7 +1184,7 @@ SUBROUTINE transform_occupied_orbitals_second_big(dimen, latom, katom, lset, kse R_offset_rec = size_parameter_rec(3) S_offset_rec = size_parameter_rec(4) elements_ij_proc_rec = size_parameter_rec(5) - ALLOCATE (BIb_RS_mat_rec(dimen, Rsize_rec+Ssize_rec, ij_elem_max)) + ALLOCATE (BIb_RS_mat_rec(dimen, Rsize_rec + Ssize_rec, ij_elem_max)) ELSE elements_ij_proc_rec = elements_ij_proc END IF @@ -1193,33 +1193,33 @@ SUBROUTINE transform_occupied_orbitals_second_big(dimen, latom, katom, lset, kse index_ij_rec = 0 BIb_RS_mat = zero - DO index_proc_ij = proc_send+1, Ni_occupied*Nj_occupied, para_env%num_pe + DO index_proc_ij = proc_send + 1, Ni_occupied*Nj_occupied, para_env%num_pe - index_ij_send = index_ij_send+1 + index_ij_send = index_ij_send + 1 - i = (index_proc_ij-1)/Nj_occupied+1 - j = index_proc_ij-(i-1)*Nj_occupied+j_batch_start + i = (index_proc_ij - 1)/Nj_occupied + 1 + j = index_proc_ij - (i - 1)*Nj_occupied + j_batch_start DO S = 1, Ssize - S_global = S+S_offset + S_global = S + S_offset R_start = 1 IF (katom == latom .AND. kset == lset) R_start = S DO R = R_start, Rsize - R_global = R+R_offset + R_global = R + R_offset IF (R_global /= S_global) THEN C_T_R = C_T(j, R_global) C_T_S = C_T(j, S_global) DO N = 1, dimen - BIb_RS_mat(N, R, index_ij_send) = BIb_RS_mat(N, R, index_ij_send)+C_T_S*BI1(N, i, R, S) + BIb_RS_mat(N, R, index_ij_send) = BIb_RS_mat(N, R, index_ij_send) + C_T_S*BI1(N, i, R, S) END DO DO N = 1, dimen - BIb_RS_mat(N, Rsize+S, index_ij_send) = BIb_RS_mat(N, Rsize+S, index_ij_send)+C_T_R*BI1(N, i, R, S) + BIb_RS_mat(N, Rsize + S, index_ij_send) = BIb_RS_mat(N, Rsize + S, index_ij_send) + C_T_R*BI1(N, i, R, S) END DO ELSE C_T_S = C_T(j, S_global) DO N = 1, dimen - BIb_RS_mat(N, R, index_ij_send) = BIb_RS_mat(N, R, index_ij_send)+C_T_S*BI1(N, i, R, S) + BIb_RS_mat(N, R, index_ij_send) = BIb_RS_mat(N, R, index_ij_send) + C_T_S*BI1(N, i, R, S) END DO END IF @@ -1232,24 +1232,24 @@ SUBROUTINE transform_occupied_orbitals_second_big(dimen, latom, katom, lset, kse CALL mp_sendrecv(BIb_RS_mat, proc_send, BIb_RS_mat_rec, proc_receive, para_env%group) - BIb(1:dimen, R_offset_rec+1:R_offset_rec+Rsize_rec, 1:elements_ij_proc) = & - BIb(1:dimen, R_offset_rec+1:R_offset_rec+Rsize_rec, 1:elements_ij_proc)+ & + BIb(1:dimen, R_offset_rec + 1:R_offset_rec + Rsize_rec, 1:elements_ij_proc) = & + BIb(1:dimen, R_offset_rec + 1:R_offset_rec + Rsize_rec, 1:elements_ij_proc) + & BIb_RS_mat_rec(1:dimen, 1:Rsize_rec, 1:elements_ij_proc) - BIb(1:dimen, S_offset_rec+1:S_offset_rec+Ssize_rec, 1:elements_ij_proc) = & - BIb(1:dimen, S_offset_rec+1:S_offset_rec+Ssize_rec, 1:elements_ij_proc)+ & - BIb_RS_mat_rec(1:dimen, Rsize_rec+1:Rsize_rec+Ssize_rec, 1:elements_ij_proc) + BIb(1:dimen, S_offset_rec + 1:S_offset_rec + Ssize_rec, 1:elements_ij_proc) = & + BIb(1:dimen, S_offset_rec + 1:S_offset_rec + Ssize_rec, 1:elements_ij_proc) + & + BIb_RS_mat_rec(1:dimen, Rsize_rec + 1:Rsize_rec + Ssize_rec, 1:elements_ij_proc) DEALLOCATE (BIb_RS_mat_rec) ELSE ! the processor is the sender and receiver itself - BIb(1:dimen, R_offset+1:R_offset+Rsize, 1:elements_ij_proc) = & - BIb(1:dimen, R_offset+1:R_offset+Rsize, 1:elements_ij_proc)+ & + BIb(1:dimen, R_offset + 1:R_offset + Rsize, 1:elements_ij_proc) = & + BIb(1:dimen, R_offset + 1:R_offset + Rsize, 1:elements_ij_proc) + & BIb_RS_mat(1:dimen, 1:Rsize, 1:elements_ij_proc) - BIb(1:dimen, S_offset+1:S_offset+Ssize, 1:elements_ij_proc) = & - BIb(1:dimen, S_offset+1:S_offset+Ssize, 1:elements_ij_proc)+ & - BIb_RS_mat(1:dimen, Rsize+1:Rsize+Ssize, 1:elements_ij_proc) + BIb(1:dimen, S_offset + 1:S_offset + Ssize, 1:elements_ij_proc) = & + BIb(1:dimen, S_offset + 1:S_offset + Ssize, 1:elements_ij_proc) + & + BIb_RS_mat(1:dimen, Rsize + 1:Rsize + Ssize, 1:elements_ij_proc) END IF @@ -1309,7 +1309,7 @@ SUBROUTINE transform_virtual_orbitals_and_accumulate(dimen, occupied, virtual, i DO index_ij = 1, elements_ij_proc CALL DGEMM('T', 'N', dimen, virtual, dimen, 1.0_dp, Bib(1, 1, index_ij), & - dimen, C(1, occupied+1), dimen, 0.0_dp, Bia(1, 1), dimen) + dimen, C(1, occupied + 1), dimen, 0.0_dp, Bia(1, 1), dimen) Bib(1:dimen, 1:virtual, index_ij) = Bia(1:dimen, 1:virtual) END DO @@ -1320,7 +1320,7 @@ SUBROUTINE transform_virtual_orbitals_and_accumulate(dimen, occupied, virtual, i BIa = zero DO index_ij = 1, elements_ij_proc - CALL DGEMM('T', 'N', virtual, virtual, dimen, 1.0_dp, Bib(1, 1, index_ij), dimen, C(1, occupied+1), dimen, 0.0_dp, & + CALL DGEMM('T', 'N', virtual, virtual, dimen, 1.0_dp, Bib(1, 1, index_ij), dimen, C(1, occupied + 1), dimen, 0.0_dp, & BIa(1, 1), virtual) BIb(1:virtual, 1:virtual, index_ij) = BIa(1:virtual, 1:virtual) @@ -1330,22 +1330,22 @@ SUBROUTINE transform_virtual_orbitals_and_accumulate(dimen, occupied, virtual, i DO index_ij = 1, elements_ij_proc i = ij_list_proc(index_ij, 1) j = ij_list_proc(index_ij, 2) - i_global = i+i_batch_start - j_global = j+j_batch_start + i_global = i + i_batch_start + j_global = j + j_batch_start DO a = 1, virtual - a_global = a+occupied + a_global = a + occupied DO b = 1, virtual - b_global = b+occupied + b_global = b + occupied iajb = BIb(a, b, index_ij) ibja = BIb(b, a, index_ij) - parz = iajb/(Auto(i_global)+Auto(j_global)-Auto(a_global)-Auto(b_global)) + parz = iajb/(Auto(i_global) + Auto(j_global) - Auto(a_global) - Auto(b_global)) ! parz=parz*(two*iajb-ibja) !Full ! parz=parz*(iajb) !Coulomb ! parz=parz*(ibja) !Coulomb ! Emp2=Emp2+parz/nspins - Emp2_Cou = Emp2_Cou+parz*two*(iajb)/nspins - Emp2_ex = Emp2_ex-parz*(ibja)/nspins - Emp2 = Emp2+parz*(two*iajb-ibja)/nspins + Emp2_Cou = Emp2_Cou + parz*two*(iajb)/nspins + Emp2_ex = Emp2_ex - parz*(ibja)/nspins + Emp2 = Emp2 + parz*(two*iajb - ibja)/nspins END DO END DO END DO @@ -1407,11 +1407,11 @@ SUBROUTINE transform_virtual_orbitals_and_accumulate_ABcase(dimen, occ_i, occ_j, DO index_ij = 1, elements_ij_proc DO a = 1, virt_i - a_global = a+occ_i + a_global = a + occ_i DO S = 1, dimen parz = zero DO N = 1, dimen - parz = parz+C_i(N, a_global)*BIb(N, S, index_ij) + parz = parz + C_i(N, a_global)*BIb(N, S, index_ij) END DO BIa(S, a) = parz END DO @@ -1428,10 +1428,10 @@ SUBROUTINE transform_virtual_orbitals_and_accumulate_ABcase(dimen, occ_i, occ_j, DO a = 1, virt_i DO b = 1, virt_j - b_global = b+occ_j + b_global = b + occ_j parz = zero DO S = 1, dimen - parz = parz+C_j(S, b_global)*BIb(S, a, index_ij) + parz = parz + C_j(S, b_global)*BIb(S, a, index_ij) END DO BIa(a, b) = parz END DO @@ -1444,16 +1444,16 @@ SUBROUTINE transform_virtual_orbitals_and_accumulate_ABcase(dimen, occ_i, occ_j, DO index_ij = 1, elements_ij_proc i = ij_list_proc(index_ij, 1) j = ij_list_proc(index_ij, 2) - i_global = i+i_batch_start - j_global = j+j_batch_start + i_global = i + i_batch_start + j_global = j + j_batch_start DO a = 1, virt_i - a_global = a+occ_i + a_global = a + occ_i DO b = 1, virt_j - b_global = b+occ_j + b_global = b + occ_j iajb = BIb(a, b, index_ij) - parz = iajb*iajb/(Auto_i(i_global)+Auto_j(j_global)-Auto_i(a_global)-Auto_j(b_global)) - Emp2_Cou = Emp2_Cou+parz/two - Emp2 = Emp2+parz/two + parz = iajb*iajb/(Auto_i(i_global) + Auto_j(j_global) - Auto_i(a_global) - Auto_j(b_global)) + Emp2_Cou = Emp2_Cou + parz/two + Emp2 = Emp2 + parz/two END DO END DO END DO diff --git a/src/mp2_eri_gpw.F b/src/mp2_eri_gpw.F index c1c9512b29..b4d6b3480d 100644 --- a/src/mp2_eri_gpw.F +++ b/src/mp2_eri_gpw.F @@ -216,7 +216,7 @@ SUBROUTINE mp2_eri_2c_integrate_gpw(qs_env, para_env_sub, dimen_RI, mo_coeff, my i_counter = 0 DO LLL = my_group_L_start, my_group_L_end - i_counter = i_counter+1 + i_counter = i_counter + 1 wf_vector = 0.0_dp wf_vector(LLL) = 1.0_dp @@ -280,14 +280,14 @@ SUBROUTINE mp2_eri_2c_integrate_gpw(qs_env, para_env_sub, dimen_RI, mo_coeff, my tp(dir) = FLOOR(DOT_PRODUCT(cell%h_inv(dir, :), ra)*rs_v(igrid_level)%rs_grid%desc%npts(dir)) tp(dir) = MODULO(tp(dir), rs_v(igrid_level)%rs_grid%desc%npts(dir)) IF (rs_v(igrid_level)%rs_grid%desc%perd(dir) .NE. 1) THEN - lb(dir) = rs_v(igrid_level)%rs_grid%lb_local(dir)+rs_v(igrid_level)%rs_grid%desc%border - ub(dir) = rs_v(igrid_level)%rs_grid%ub_local(dir)-rs_v(igrid_level)%rs_grid%desc%border + lb(dir) = rs_v(igrid_level)%rs_grid%lb_local(dir) + rs_v(igrid_level)%rs_grid%desc%border + ub(dir) = rs_v(igrid_level)%rs_grid%ub_local(dir) - rs_v(igrid_level)%rs_grid%desc%border ELSE lb(dir) = rs_v(igrid_level)%rs_grid%lb_local(dir) ub(dir) = rs_v(igrid_level)%rs_grid%ub_local(dir) ENDIF ! distributed grid, only map if it is local to the grid - location(dir) = tp(dir)+rs_v(igrid_level)%rs_grid%desc%lb(dir) + location(dir) = tp(dir) + rs_v(igrid_level)%rs_grid%desc%lb(dir) ENDDO IF (lb(1) <= location(1) .AND. location(1) <= ub(1) .AND. & lb(2) <= location(2) .AND. location(2) <= ub(2) .AND. & @@ -299,13 +299,13 @@ SUBROUTINE mp2_eri_2c_integrate_gpw(qs_env, para_env_sub, dimen_RI, mo_coeff, my IF (MODULO(offset, para_env_sub%num_pe) == para_env_sub%mepos) map_it_here = .TRUE. ENDIF - offset = offset+nsgfa(iset) + offset = offset + nsgfa(iset) IF (map_it_here) THEN DO ipgf = 1, npgfa(iset) sgfa = first_sgfa(1, iset) - na1 = (ipgf-1)*ncoset(la_max(iset))+1 + na1 = (ipgf - 1)*ncoset(la_max(iset)) + 1 na2 = ipgf*ncoset(la_max(iset)) igrid_level = gaussian_gridlevel(pw_env_sub%gridlevel_info, zeta(ipgf, iset)) @@ -317,7 +317,7 @@ SUBROUTINE mp2_eri_2c_integrate_gpw(qs_env, para_env_sub, dimen_RI, mo_coeff, my cell=cell, & cube_info=pw_env_sub%cube_info(igrid_level), & hab=I_tmp2, & - o1=na1-1, & + o1=na1 - 1, & o2=0, & map_consistent=.TRUE., & eps_gvg_rspace=dft_control%qs_control%eps_gvg_rspace, & @@ -329,7 +329,7 @@ SUBROUTINE mp2_eri_2c_integrate_gpw(qs_env, para_env_sub, dimen_RI, mo_coeff, my I_tmp2(1, 1), SIZE(I_tmp2, 1), & 1.0_dp, I_ab(1, 1), SIZE(I_ab, 1)) - L_local_col(offset-nsgfa(iset)+1:offset, i_counter) = I_ab(1:nsgfa(iset), 1) + L_local_col(offset - nsgfa(iset) + 1:offset, i_counter) = I_ab(1:nsgfa(iset), 1) END IF DEALLOCATE (I_tmp2) @@ -410,7 +410,7 @@ SUBROUTINE prepare_gpw(qs_env, dft_control, e_cutoff_old, cutoff_old, relative_c dft_control%qs_control%cutoff = qs_env%mp2_env%mp2_gpw%cutoff*0.5_dp dft_control%qs_control%e_cutoff(1) = dft_control%qs_control%cutoff DO i_multigrid = 2, n_multigrid - dft_control%qs_control%e_cutoff(i_multigrid) = dft_control%qs_control%e_cutoff(i_multigrid-1) & + dft_control%qs_control%e_cutoff(i_multigrid) = dft_control%qs_control%e_cutoff(i_multigrid - 1) & /progression_factor END DO diff --git a/src/mp2_gpw.F b/src/mp2_gpw.F index 0f7dfcfab8..a147dc1409 100644 --- a/src/mp2_gpw.F +++ b/src/mp2_gpw.F @@ -778,11 +778,11 @@ SUBROUTINE mp2_gpw_main(qs_env, mp2_env, Emp2, Emp2_Cou, Emp2_EX, Emp2_S, Emp2_T Emp2_EX_BB = Emp2_EX_BB*0.5_dp Emp2_S = Emp2_AB - Emp2_T = Emp2_Cou+Emp2_Cou_BB+Emp2_EX+Emp2_EX_BB + Emp2_T = Emp2_Cou + Emp2_Cou_BB + Emp2_EX + Emp2_EX_BB - Emp2_Cou = Emp2_Cou+Emp2_Cou_BB+Emp2_AB - Emp2_EX = Emp2_EX+Emp2_EX_BB - Emp2 = Emp2_EX+Emp2_Cou + Emp2_Cou = Emp2_Cou + Emp2_Cou_BB + Emp2_AB + Emp2_EX = Emp2_EX + Emp2_EX_BB + Emp2 = Emp2_EX + Emp2_Cou END IF END IF @@ -897,11 +897,11 @@ SUBROUTINE replicate_mat_to_subgroup(mp2_env, para_env, para_env_sub, mo_coeff, ! for negative and positive number > num_pe ! needed to know which is the processor, to respect to another one, ! for a given shift - ALLOCATE (proc_map(-para_env%num_pe:2*para_env%num_pe-1)) - DO iiB = 0, para_env%num_pe-1 + ALLOCATE (proc_map(-para_env%num_pe:2*para_env%num_pe - 1)) + DO iiB = 0, para_env%num_pe - 1 proc_map(iiB) = iiB - proc_map(-iiB-1) = para_env%num_pe-iiB-1 - proc_map(para_env%num_pe+iiB) = iiB + proc_map(-iiB - 1) = para_env%num_pe - iiB - 1 + proc_map(para_env%num_pe + iiB) = iiB END DO CALL cp_fm_get_info(matrix=mo_coeff, & @@ -936,17 +936,17 @@ SUBROUTINE replicate_mat_to_subgroup(mp2_env, para_env, para_env_sub, mo_coeff, IF (i_global >= my_mu_start .AND. i_global <= my_mu_end) THEN DO jjB = 1, ncol_local j_global = col_indices(jjB) - C(i_global-my_mu_start+1, j_global) = local_C(iiB, jjB) + C(i_global - my_mu_start + 1, j_global) = local_C(iiB, jjB) END DO END IF END DO ! start ring communication for collecting the data from the other - proc_send_static = proc_map(para_env%mepos+1) - proc_receive_static = proc_map(para_env%mepos-1) - DO proc_shift = 1, para_env%num_pe-1 - proc_send = proc_map(para_env%mepos+proc_shift) - proc_receive = proc_map(para_env%mepos-proc_shift) + proc_send_static = proc_map(para_env%mepos + 1) + proc_receive_static = proc_map(para_env%mepos - 1) + DO proc_shift = 1, para_env%num_pe - 1 + proc_send = proc_map(para_env%mepos + proc_shift) + proc_receive = proc_map(para_env%mepos - proc_shift) ! first exchange information on the local data rec_col_row_info = 0 @@ -972,7 +972,7 @@ SUBROUTINE replicate_mat_to_subgroup(mp2_env, para_env, para_env_sub, mo_coeff, IF (i_global >= my_mu_start .AND. i_global <= my_mu_end) THEN DO jjB = 1, ncol_rec j_global = col_indices_rec(jjB) - C(i_global-my_mu_start+1, j_global) = rec_C(iiB, jjB) + C(i_global - my_mu_start + 1, j_global) = rec_C(iiB, jjB) END DO END IF END DO @@ -992,20 +992,20 @@ SUBROUTINE replicate_mat_to_subgroup(mp2_env, para_env, para_env_sub, mo_coeff, DEALLOCATE (proc_map) ! proc_map, for the sub_group - ALLOCATE (proc_map(-para_env_sub%num_pe:2*para_env_sub%num_pe-1)) - DO iiB = 0, para_env_sub%num_pe-1 + ALLOCATE (proc_map(-para_env_sub%num_pe:2*para_env_sub%num_pe - 1)) + DO iiB = 0, para_env_sub%num_pe - 1 proc_map(iiB) = iiB - proc_map(-iiB-1) = para_env_sub%num_pe-iiB-1 - proc_map(para_env_sub%num_pe+iiB) = iiB + proc_map(-iiB - 1) = para_env_sub%num_pe - iiB - 1 + proc_map(para_env_sub%num_pe + iiB) = iiB END DO ! split the C matrix into occupied and virtual ALLOCATE (Cocc(my_mu_size, homo)) Cocc(1:my_mu_size, 1:homo) = C(1:my_mu_size, 1:homo) - virtual = dimen-homo + virtual = dimen - homo ALLOCATE (Cvirt(my_mu_size, virtual)) - Cvirt(1:my_mu_size, 1:virtual) = C(1:my_mu_size, homo+1:dimen) + Cvirt(1:my_mu_size, 1:virtual) = C(1:my_mu_size, homo + 1:dimen) IF (.NOT. my_only_mo_coeff_all) THEN ! create and fill mo_coeff_o, mo_coeff_v and mo_coeff_all @@ -1024,11 +1024,11 @@ SUBROUTINE replicate_mat_to_subgroup(mp2_env, para_env, para_env_sub, mo_coeff, IF (my_do_gw) THEN ! also cut levels homo-gw_corr_lev_occ+1, ..., lumo+gw_corr_lev_virt-1 of C - ALLOCATE (Cgw(my_mu_size, gw_corr_lev_occ+gw_corr_lev_virt)) - Cgw(1:my_mu_size, 1:(gw_corr_lev_occ+gw_corr_lev_virt)) = & - C(1:my_mu_size, homo-gw_corr_lev_occ+1:homo+gw_corr_lev_virt) + ALLOCATE (Cgw(my_mu_size, gw_corr_lev_occ + gw_corr_lev_virt)) + Cgw(1:my_mu_size, 1:(gw_corr_lev_occ + gw_corr_lev_virt)) = & + C(1:my_mu_size, homo - gw_corr_lev_occ + 1:homo + gw_corr_lev_virt) CALL build_mo_coeff_v_o_all(mp2_env, para_env_sub, mo_coeff_gw, Cgw, & - gw_corr_lev_occ+gw_corr_lev_virt, my_mu_start, my_mu_end, & + gw_corr_lev_occ + gw_corr_lev_virt, my_mu_start, my_mu_end, & mat_munu, gd_array, proc_map) END IF @@ -1100,11 +1100,11 @@ SUBROUTINE build_mo_coeff_v_o_all(mp2_env, para_env_sub, mo_coeff_to_build, Crea row_size=row_size, col_size=col_size, & row_offset=row_offset, col_offset=col_offset) DO i = 1, row_size - i_global = row_offset+i-1 + i_global = row_offset + i - 1 IF (i_global >= my_mu_start .AND. i_global <= my_mu_end) THEN DO j = 1, col_size - j_global = col_offset+j-1 - data_block(i, j) = Cread(i_global-my_mu_start+1, col_offset+j-1) + j_global = col_offset + j - 1 + data_block(i, j) = Cread(i_global - my_mu_start + 1, col_offset + j - 1) ENDDO END IF ENDDO @@ -1113,9 +1113,9 @@ SUBROUTINE build_mo_coeff_v_o_all(mp2_env, para_env_sub, mo_coeff_to_build, Crea ! start ring communication in the subgroup for collecting the data from the other ! proc (occupied) - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_send = proc_map(para_env_sub%mepos+proc_shift) - proc_receive = proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_send = proc_map(para_env_sub%mepos + proc_shift) + proc_receive = proc_map(para_env_sub%mepos - proc_shift) CALL get_group_dist(gd_array, proc_receive, rec_mu_start, rec_mu_end, rec_mu_size) @@ -1132,11 +1132,11 @@ SUBROUTINE build_mo_coeff_v_o_all(mp2_env, para_env_sub, mo_coeff_to_build, Crea row_size=row_size, col_size=col_size, & row_offset=row_offset, col_offset=col_offset) DO i = 1, row_size - i_global = row_offset+i-1 + i_global = row_offset + i - 1 IF (i_global >= rec_mu_start .AND. i_global <= rec_mu_end) THEN DO j = 1, col_size - j_global = col_offset+j-1 - data_block(i, j) = rec_C(i_global-rec_mu_start+1, col_offset+j-1) + j_global = col_offset + j - 1 + data_block(i, j) = rec_C(i_global - rec_mu_start + 1, col_offset + j - 1) ENDDO END IF ENDDO @@ -1695,7 +1695,7 @@ SUBROUTINE create_dbcsr_matrices_im_time(mat_munu, mat_P_local, mat_P_global, ma DO igroup = 1, ngroup - itmp = get_limit(nfullrows_total, ngroup, igroup-1) + itmp = get_limit(nfullrows_total, ngroup, igroup - 1) CALL get_start_end_size_indx(mp2_env%ri_rpa_im_time%starts_array_cm(igroup), & mp2_env%ri_rpa_im_time%ends_array_cm(igroup), & @@ -1727,7 +1727,7 @@ SUBROUTINE create_dbcsr_matrices_im_time(mat_munu, mat_P_local, mat_P_global, ma ! the same for MAOs for occ and virt DO igroup = 1, ngroup - itmp = get_limit(size_mao_occ, ngroup, igroup-1) + itmp = get_limit(size_mao_occ, ngroup, igroup - 1) CALL get_start_end_size_indx(mp2_env%ri_rpa_im_time%starts_array_cm_mao_occ(igroup), & mp2_env%ri_rpa_im_time%ends_array_cm_mao_occ(igroup), & @@ -1739,7 +1739,7 @@ SUBROUTINE create_dbcsr_matrices_im_time(mat_munu, mat_P_local, mat_P_global, ma DO igroup = 1, ngroup - itmp = get_limit(size_mao_virt, ngroup, igroup-1) + itmp = get_limit(size_mao_virt, ngroup, igroup - 1) CALL get_start_end_size_indx(mp2_env%ri_rpa_im_time%starts_array_cm_mao_virt(igroup), & mp2_env%ri_rpa_im_time%ends_array_cm_mao_virt(igroup), & @@ -1768,21 +1768,21 @@ SUBROUTINE create_dbcsr_matrices_im_time(mat_munu, mat_P_local, mat_P_global, ma DO i_mem = 1, cut_memory - ALLOCATE (mp2_env%ri_rpa_im_time_util(i_mem)%sizes_array_prim_row(0:ngroup-1)) + ALLOCATE (mp2_env%ri_rpa_im_time_util(i_mem)%sizes_array_prim_row(0:ngroup - 1)) mp2_env%ri_rpa_im_time_util(i_mem)%sizes_array_prim_row = 0 - ALLOCATE (mp2_env%ri_rpa_im_time_util(i_mem)%starts_array_prim_row(0:ngroup-1)) + ALLOCATE (mp2_env%ri_rpa_im_time_util(i_mem)%starts_array_prim_row(0:ngroup - 1)) mp2_env%ri_rpa_im_time_util(i_mem)%starts_array_prim_row = 0 - ALLOCATE (mp2_env%ri_rpa_im_time_util(i_mem)%ends_array_prim_row(0:ngroup-1)) + ALLOCATE (mp2_env%ri_rpa_im_time_util(i_mem)%ends_array_prim_row(0:ngroup - 1)) mp2_env%ri_rpa_im_time_util(i_mem)%ends_array_prim_row = 0 - ALLOCATE (mp2_env%ri_rpa_im_time_util(i_mem)%sizes_array_prim_fullrow(0:ngroup-1)) + ALLOCATE (mp2_env%ri_rpa_im_time_util(i_mem)%sizes_array_prim_fullrow(0:ngroup - 1)) mp2_env%ri_rpa_im_time_util(i_mem)%sizes_array_prim_fullrow = 0 - ALLOCATE (mp2_env%ri_rpa_im_time_util(i_mem)%starts_array_prim_fullrow(0:ngroup-1)) + ALLOCATE (mp2_env%ri_rpa_im_time_util(i_mem)%starts_array_prim_fullrow(0:ngroup - 1)) mp2_env%ri_rpa_im_time_util(i_mem)%starts_array_prim_fullrow = 0 - ALLOCATE (mp2_env%ri_rpa_im_time_util(i_mem)%ends_array_prim_fullrow(0:ngroup-1)) + ALLOCATE (mp2_env%ri_rpa_im_time_util(i_mem)%ends_array_prim_fullrow(0:ngroup - 1)) mp2_env%ri_rpa_im_time_util(i_mem)%ends_array_prim_fullrow = 0 - DO igroup = 0, ngroup-1 + DO igroup = 0, ngroup - 1 nfullrows_to_split = mp2_env%ri_rpa_im_time%sizes_array_cm_mao_occ(i_mem) @@ -1792,31 +1792,31 @@ SUBROUTINE create_dbcsr_matrices_im_time(mat_munu, mat_P_local, mat_P_global, ma mp2_env%ri_rpa_im_time_util(i_mem)%starts_array_prim_fullrow(igroup) = itmp(1) mp2_env%ri_rpa_im_time_util(i_mem)%ends_array_prim_fullrow(igroup) = itmp(2) - mp2_env%ri_rpa_im_time_util(i_mem)%sizes_array_prim_fullrow(igroup) = itmp(2)-itmp(1)+1 + mp2_env%ri_rpa_im_time_util(i_mem)%sizes_array_prim_fullrow(igroup) = itmp(2) - itmp(1) + 1 CALL get_blk_from_indx(indx=itmp(1), blk=blk_start, blk_offset=row_blk_offset, blk_sizes=row_blk_sizes_prim) CALL get_blk_from_indx(indx=itmp(2), blk=blk_end, blk_offset=row_blk_offset, blk_sizes=row_blk_sizes_prim) mp2_env%ri_rpa_im_time_util(i_mem)%starts_array_prim_row(igroup) = blk_start mp2_env%ri_rpa_im_time_util(i_mem)%ends_array_prim_row(igroup) = blk_end - mp2_env%ri_rpa_im_time_util(i_mem)%sizes_array_prim_row(igroup) = blk_end-blk_start+1 + mp2_env%ri_rpa_im_time_util(i_mem)%sizes_array_prim_row(igroup) = blk_end - blk_start + 1 ELSE - offset_fullrow = mp2_env%ri_rpa_im_time_util(i_mem-1)%ends_array_prim_fullrow(ngroup-1) + offset_fullrow = mp2_env%ri_rpa_im_time_util(i_mem - 1)%ends_array_prim_fullrow(ngroup - 1) - mp2_env%ri_rpa_im_time_util(i_mem)%starts_array_prim_fullrow(igroup) = itmp(1)+offset_fullrow - mp2_env%ri_rpa_im_time_util(i_mem)%ends_array_prim_fullrow(igroup) = itmp(2)+offset_fullrow - mp2_env%ri_rpa_im_time_util(i_mem)%sizes_array_prim_fullrow(igroup) = itmp(2)-itmp(1)+1 + mp2_env%ri_rpa_im_time_util(i_mem)%starts_array_prim_fullrow(igroup) = itmp(1) + offset_fullrow + mp2_env%ri_rpa_im_time_util(i_mem)%ends_array_prim_fullrow(igroup) = itmp(2) + offset_fullrow + mp2_env%ri_rpa_im_time_util(i_mem)%sizes_array_prim_fullrow(igroup) = itmp(2) - itmp(1) + 1 - CALL get_blk_from_indx(indx=(itmp(1)+offset_fullrow), blk=blk_start, & + CALL get_blk_from_indx(indx=(itmp(1) + offset_fullrow), blk=blk_start, & blk_offset=row_blk_offset, blk_sizes=row_blk_sizes_prim) - CALL get_blk_from_indx(indx=(itmp(2)+offset_fullrow), blk=blk_end, & + CALL get_blk_from_indx(indx=(itmp(2) + offset_fullrow), blk=blk_end, & blk_offset=row_blk_offset, blk_sizes=row_blk_sizes_prim) mp2_env%ri_rpa_im_time_util(i_mem)%starts_array_prim_row(igroup) = blk_start mp2_env%ri_rpa_im_time_util(i_mem)%ends_array_prim_row(igroup) = blk_end - mp2_env%ri_rpa_im_time_util(i_mem)%sizes_array_prim_row(igroup) = blk_end-blk_start+1 + mp2_env%ri_rpa_im_time_util(i_mem)%sizes_array_prim_row(igroup) = blk_end - blk_start + 1 END IF @@ -1831,21 +1831,21 @@ SUBROUTINE create_dbcsr_matrices_im_time(mat_munu, mat_P_local, mat_P_global, ma DO j_mem = 1, cut_memory - ALLOCATE (mp2_env%ri_rpa_im_time_util(j_mem)%sizes_array_prim_col(0:ngroup-1)) + ALLOCATE (mp2_env%ri_rpa_im_time_util(j_mem)%sizes_array_prim_col(0:ngroup - 1)) mp2_env%ri_rpa_im_time_util(j_mem)%sizes_array_prim_col = 0 - ALLOCATE (mp2_env%ri_rpa_im_time_util(j_mem)%starts_array_prim_col(0:ngroup-1)) + ALLOCATE (mp2_env%ri_rpa_im_time_util(j_mem)%starts_array_prim_col(0:ngroup - 1)) mp2_env%ri_rpa_im_time_util(j_mem)%starts_array_prim_col = 0 - ALLOCATE (mp2_env%ri_rpa_im_time_util(j_mem)%ends_array_prim_col(0:ngroup-1)) + ALLOCATE (mp2_env%ri_rpa_im_time_util(j_mem)%ends_array_prim_col(0:ngroup - 1)) mp2_env%ri_rpa_im_time_util(j_mem)%ends_array_prim_col = 0 - ALLOCATE (mp2_env%ri_rpa_im_time_util(j_mem)%sizes_array_prim_fullcol(0:ngroup-1)) + ALLOCATE (mp2_env%ri_rpa_im_time_util(j_mem)%sizes_array_prim_fullcol(0:ngroup - 1)) mp2_env%ri_rpa_im_time_util(j_mem)%sizes_array_prim_fullcol = 0 - ALLOCATE (mp2_env%ri_rpa_im_time_util(j_mem)%starts_array_prim_fullcol(0:ngroup-1)) + ALLOCATE (mp2_env%ri_rpa_im_time_util(j_mem)%starts_array_prim_fullcol(0:ngroup - 1)) mp2_env%ri_rpa_im_time_util(j_mem)%starts_array_prim_fullcol = 0 - ALLOCATE (mp2_env%ri_rpa_im_time_util(j_mem)%ends_array_prim_fullcol(0:ngroup-1)) + ALLOCATE (mp2_env%ri_rpa_im_time_util(j_mem)%ends_array_prim_fullcol(0:ngroup - 1)) mp2_env%ri_rpa_im_time_util(j_mem)%ends_array_prim_fullcol = 0 - DO igroup = 0, ngroup-1 + DO igroup = 0, ngroup - 1 nfullcols_to_split = mp2_env%ri_rpa_im_time%sizes_array_cm_mao_virt(j_mem) @@ -1855,31 +1855,31 @@ SUBROUTINE create_dbcsr_matrices_im_time(mat_munu, mat_P_local, mat_P_global, ma mp2_env%ri_rpa_im_time_util(j_mem)%starts_array_prim_fullcol(igroup) = itmp(1) mp2_env%ri_rpa_im_time_util(j_mem)%ends_array_prim_fullcol(igroup) = itmp(2) - mp2_env%ri_rpa_im_time_util(j_mem)%sizes_array_prim_fullcol(igroup) = itmp(2)-itmp(1)+1 + mp2_env%ri_rpa_im_time_util(j_mem)%sizes_array_prim_fullcol(igroup) = itmp(2) - itmp(1) + 1 CALL get_blk_from_indx(indx=itmp(1), blk=blk_start, blk_offset=col_blk_offset, blk_sizes=col_blk_sizes_prim) CALL get_blk_from_indx(indx=itmp(2), blk=blk_end, blk_offset=col_blk_offset, blk_sizes=col_blk_sizes_prim) mp2_env%ri_rpa_im_time_util(j_mem)%starts_array_prim_col(igroup) = blk_start mp2_env%ri_rpa_im_time_util(j_mem)%ends_array_prim_col(igroup) = blk_end - mp2_env%ri_rpa_im_time_util(j_mem)%sizes_array_prim_col(igroup) = blk_end-blk_start+1 + mp2_env%ri_rpa_im_time_util(j_mem)%sizes_array_prim_col(igroup) = blk_end - blk_start + 1 ELSE - offset_fullcol = mp2_env%ri_rpa_im_time_util(j_mem-1)%ends_array_prim_fullcol(ngroup-1) + offset_fullcol = mp2_env%ri_rpa_im_time_util(j_mem - 1)%ends_array_prim_fullcol(ngroup - 1) - mp2_env%ri_rpa_im_time_util(j_mem)%starts_array_prim_fullcol(igroup) = itmp(1)+offset_fullcol - mp2_env%ri_rpa_im_time_util(j_mem)%ends_array_prim_fullcol(igroup) = itmp(2)+offset_fullcol - mp2_env%ri_rpa_im_time_util(j_mem)%sizes_array_prim_fullcol(igroup) = itmp(2)-itmp(1)+1 + mp2_env%ri_rpa_im_time_util(j_mem)%starts_array_prim_fullcol(igroup) = itmp(1) + offset_fullcol + mp2_env%ri_rpa_im_time_util(j_mem)%ends_array_prim_fullcol(igroup) = itmp(2) + offset_fullcol + mp2_env%ri_rpa_im_time_util(j_mem)%sizes_array_prim_fullcol(igroup) = itmp(2) - itmp(1) + 1 - CALL get_blk_from_indx(indx=(itmp(1)+offset_fullcol), blk=blk_start, & + CALL get_blk_from_indx(indx=(itmp(1) + offset_fullcol), blk=blk_start, & blk_offset=col_blk_offset, blk_sizes=col_blk_sizes_prim) - CALL get_blk_from_indx(indx=(itmp(2)+offset_fullcol), blk=blk_end, & + CALL get_blk_from_indx(indx=(itmp(2) + offset_fullcol), blk=blk_end, & blk_offset=col_blk_offset, blk_sizes=col_blk_sizes_prim) mp2_env%ri_rpa_im_time_util(j_mem)%starts_array_prim_col(igroup) = blk_start mp2_env%ri_rpa_im_time_util(j_mem)%ends_array_prim_col(igroup) = blk_end - mp2_env%ri_rpa_im_time_util(j_mem)%sizes_array_prim_col(igroup) = blk_end-blk_start+1 + mp2_env%ri_rpa_im_time_util(j_mem)%sizes_array_prim_col(igroup) = blk_end - blk_start + 1 END IF @@ -1898,13 +1898,13 @@ SUBROUTINE create_dbcsr_matrices_im_time(mat_munu, mat_P_local, mat_P_global, ma n_local_row_prim = mp2_env%ri_rpa_im_time_util(i_mem)%sizes_array_prim_row(color_sub_row) row_start_local = mp2_env%ri_rpa_im_time_util(i_mem)%starts_array_prim_row(color_sub_row) - row_end_local = row_start_local+n_local_row_prim-1 + row_end_local = row_start_local + n_local_row_prim - 1 ALLOCATE (mp2_env%ri_rpa_im_time_util(i_mem)%start_row_data_block(row_start_local: & - row_start_local+n_local_row_prim-1)) + row_start_local + n_local_row_prim - 1)) mp2_env%ri_rpa_im_time_util(i_mem)%start_row_data_block = 0 ALLOCATE (mp2_env%ri_rpa_im_time_util(i_mem)%end_row_data_block(row_start_local: & - row_start_local+n_local_row_prim-1)) + row_start_local + n_local_row_prim - 1)) mp2_env%ri_rpa_im_time_util(i_mem)%end_row_data_block = 0 END DO @@ -1913,13 +1913,13 @@ SUBROUTINE create_dbcsr_matrices_im_time(mat_munu, mat_P_local, mat_P_global, ma n_local_col_prim = mp2_env%ri_rpa_im_time_util(j_mem)%sizes_array_prim_col(color_sub_col) col_start_local = mp2_env%ri_rpa_im_time_util(j_mem)%starts_array_prim_col(color_sub_col) - col_end_local = col_start_local+n_local_col_prim-1 + col_end_local = col_start_local + n_local_col_prim - 1 ALLOCATE (mp2_env%ri_rpa_im_time_util(j_mem)%start_col_data_block(col_start_local: & - col_start_local+n_local_col_prim-1)) + col_start_local + n_local_col_prim - 1)) mp2_env%ri_rpa_im_time_util(j_mem)%start_col_data_block = 0 ALLOCATE (mp2_env%ri_rpa_im_time_util(j_mem)%end_col_data_block(col_start_local: & - col_start_local+n_local_col_prim-1)) + col_start_local + n_local_col_prim - 1)) mp2_env%ri_rpa_im_time_util(j_mem)%end_col_data_block = 0 END DO @@ -1933,35 +1933,35 @@ SUBROUTINE create_dbcsr_matrices_im_time(mat_munu, mat_P_local, mat_P_global, ma n_local_row_prim = mp2_env%ri_rpa_im_time_util(i_mem)%sizes_array_prim_row(color_sub_row) row_start_local = mp2_env%ri_rpa_im_time_util(i_mem)%starts_array_prim_row(color_sub_row) - row_end_local = row_start_local+n_local_row_prim-1 + row_end_local = row_start_local + n_local_row_prim - 1 DO j_mem = 1, cut_memory n_local_col_prim = mp2_env%ri_rpa_im_time_util(j_mem)%sizes_array_prim_col(color_sub_col) col_start_local = mp2_env%ri_rpa_im_time_util(j_mem)%starts_array_prim_col(color_sub_col) - col_end_local = col_start_local+n_local_col_prim-1 + col_end_local = col_start_local + n_local_col_prim - 1 ALLOCATE (mp2_env%ri_rpa_im_time_2d_util(i_mem, j_mem)%offset_combi_block( & - row_start_local:row_start_local+n_local_row_prim-1, & - col_start_local:col_start_local+n_local_col_prim-1)) + row_start_local:row_start_local + n_local_row_prim - 1, & + col_start_local:col_start_local + n_local_col_prim - 1)) mp2_env%ri_rpa_im_time_2d_util(i_mem, j_mem)%offset_combi_block = 0 DO icol = 1, n_local_row_prim*n_local_col_prim - ref_row = (icol-1)/n_local_col_prim+1+row_start_local-1 + ref_row = (icol - 1)/n_local_col_prim + 1 + row_start_local - 1 - ref_col = MODULO(icol-1, n_local_col_prim)+1+col_start_local-1 + ref_col = MODULO(icol - 1, n_local_col_prim) + 1 + col_start_local - 1 IF (ref_row == row_start_local) THEN start_row = mp2_env%ri_rpa_im_time_util(i_mem)%starts_array_prim_fullrow(color_sub_row) - end_row = row_blk_offset(ref_row)+row_blk_sizes_prim(ref_row)-1 - size_row = end_row-start_row+1 + end_row = row_blk_offset(ref_row) + row_blk_sizes_prim(ref_row) - 1 + size_row = end_row - start_row + 1 end_row_data_block = row_blk_sizes_prim(ref_row) - start_row_data_block = end_row_data_block-size_row+1 + start_row_data_block = end_row_data_block - size_row + 1 ELSE IF (ref_row == row_end_local) THEN start_row = row_blk_offset(ref_row) end_row = mp2_env%ri_rpa_im_time_util(i_mem)%ends_array_prim_fullrow(color_sub_row) - size_row = end_row-start_row+1 + size_row = end_row - start_row + 1 start_row_data_block = 1 end_row_data_block = size_row ELSE @@ -1974,10 +1974,10 @@ SUBROUTINE create_dbcsr_matrices_im_time(mat_munu, mat_P_local, mat_P_global, ma IF (row_start_local == row_end_local) THEN start_row = mp2_env%ri_rpa_im_time_util(i_mem)%starts_array_prim_fullrow(color_sub_row) end_row = mp2_env%ri_rpa_im_time_util(i_mem)%ends_array_prim_fullrow(color_sub_row) - size_row = end_row-start_row+1 - start_row_data_block = mp2_env%ri_rpa_im_time_util(i_mem)%starts_array_prim_fullrow(color_sub_row)- & - row_blk_offset(ref_row)+1 - end_row_data_block = start_row_data_block+size_row-1 + size_row = end_row - start_row + 1 + start_row_data_block = mp2_env%ri_rpa_im_time_util(i_mem)%starts_array_prim_fullrow(color_sub_row) - & + row_blk_offset(ref_row) + 1 + end_row_data_block = start_row_data_block + size_row - 1 END IF mp2_env%ri_rpa_im_time_util(i_mem)%start_row_data_block(ref_row) = start_row_data_block @@ -1985,14 +1985,14 @@ SUBROUTINE create_dbcsr_matrices_im_time(mat_munu, mat_P_local, mat_P_global, ma IF (ref_col == col_start_local) THEN start_col = mp2_env%ri_rpa_im_time_util(j_mem)%starts_array_prim_fullcol(color_sub_col) - end_col = col_blk_offset(ref_col)+col_blk_sizes_prim(ref_col)-1 - size_col = end_col-start_col+1 + end_col = col_blk_offset(ref_col) + col_blk_sizes_prim(ref_col) - 1 + size_col = end_col - start_col + 1 end_col_data_block = col_blk_sizes_prim(ref_col) - start_col_data_block = end_col_data_block-size_col+1 + start_col_data_block = end_col_data_block - size_col + 1 ELSE IF (ref_col == col_end_local) THEN start_col = col_blk_offset(ref_col) end_col = mp2_env%ri_rpa_im_time_util(j_mem)%ends_array_prim_fullcol(color_sub_col) - size_col = end_col-start_col+1 + size_col = end_col - start_col + 1 start_col_data_block = 1 end_col_data_block = size_col ELSE @@ -2004,10 +2004,10 @@ SUBROUTINE create_dbcsr_matrices_im_time(mat_munu, mat_P_local, mat_P_global, ma IF (col_start_local == col_end_local) THEN start_col = mp2_env%ri_rpa_im_time_util(j_mem)%starts_array_prim_fullcol(color_sub_col) end_col = mp2_env%ri_rpa_im_time_util(j_mem)%ends_array_prim_fullcol(color_sub_col) - size_col = end_col-start_col+1 - start_col_data_block = mp2_env%ri_rpa_im_time_util(j_mem)%starts_array_prim_fullcol(color_sub_col)- & - col_blk_offset(ref_col)+1 - end_col_data_block = start_col_data_block+size_col-1 + size_col = end_col - start_col + 1 + start_col_data_block = mp2_env%ri_rpa_im_time_util(j_mem)%starts_array_prim_fullcol(color_sub_col) - & + col_blk_offset(ref_col) + 1 + end_col_data_block = start_col_data_block + size_col - 1 END IF mp2_env%ri_rpa_im_time_util(j_mem)%start_col_data_block(ref_col) = start_col_data_block @@ -2016,7 +2016,7 @@ SUBROUTINE create_dbcsr_matrices_im_time(mat_munu, mat_P_local, mat_P_global, ma mp2_env%ri_rpa_im_time_2d_util(i_mem, j_mem)%offset_combi_block(ref_row, ref_col) = & col_blk_sizes_cut_memory(i_mem, j_mem) - col_blk_sizes_cut_memory(i_mem, j_mem) = col_blk_sizes_cut_memory(i_mem, j_mem)+size_row*size_col + col_blk_sizes_cut_memory(i_mem, j_mem) = col_blk_sizes_cut_memory(i_mem, j_mem) + size_row*size_col END DO @@ -2312,7 +2312,7 @@ SUBROUTINE build_scaled_dm_occ(scaled_dm_for_maos_occ, rho_ao_kp, mo_coeff, & CALL cp_fm_set_all(fm_mo_coeff_occ_scaled, 0.0_dp) CALL cp_fm_to_fm(mo_coeff, fm_mo_coeff_occ_scaled) - e_lumo = mo_eigenvalues(homo+1) + e_lumo = mo_eigenvalues(homo + 1) DO jjB = 1, nrow_local DO iiB = 1, ncol_local @@ -2322,7 +2322,7 @@ SUBROUTINE build_scaled_dm_occ(scaled_dm_for_maos_occ, rho_ao_kp, mo_coeff, & IF (i_global .LE. homo) THEN fm_mo_coeff_occ_scaled%local_data(jjB, iiB) = & - mo_coeff%local_data(jjB, iiB)/(e_lumo-mo_eigenvalues(i_global)) + mo_coeff%local_data(jjB, iiB)/(e_lumo - mo_eigenvalues(i_global)) ELSE @@ -2345,7 +2345,7 @@ SUBROUTINE build_scaled_dm_occ(scaled_dm_for_maos_occ, rho_ao_kp, mo_coeff, & CALL cp_fm_set_all(fm_mo_coeff_occ_scaled_beta, 0.0_dp) CALL cp_fm_to_fm(mo_coeff_beta, fm_mo_coeff_occ_scaled_beta) - e_lumo_beta = mo_eigenvalues_beta(homo_beta+1) + e_lumo_beta = mo_eigenvalues_beta(homo_beta + 1) DO jjB = 1, nrow_local DO iiB = 1, ncol_local @@ -2355,7 +2355,7 @@ SUBROUTINE build_scaled_dm_occ(scaled_dm_for_maos_occ, rho_ao_kp, mo_coeff, & IF (i_global .LE. homo) THEN fm_mo_coeff_occ_scaled_beta%local_data(jjB, iiB) = & - mo_coeff_beta%local_data(jjB, iiB)/(e_lumo_beta-mo_eigenvalues_beta(i_global)) + mo_coeff_beta%local_data(jjB, iiB)/(e_lumo_beta - mo_eigenvalues_beta(i_global)) ELSE @@ -2760,7 +2760,7 @@ PURE SUBROUTINE generate_integer_product(num_pe, n_group_row, n_group_col) DO WHILE (stay_while) - square_real = (CEILING(SQRT(num_pe_real))+offset_real)**2-num_pe_real + square_real = (CEILING(SQRT(num_pe_real)) + offset_real)**2 - num_pe_real square_int = NINT(square_real) @@ -2772,16 +2772,16 @@ PURE SUBROUTINE generate_integer_product(num_pe, n_group_row, n_group_col) ELSE - offset_real = offset_real+1.0_dp + offset_real = offset_real + 1.0_dp END IF END DO - x_int = NINT(CEILING(SQRT(num_pe_real))+offset_real) + x_int = NINT(CEILING(SQRT(num_pe_real)) + offset_real) - n_group_row = (x_int+sqrt_int)*b_int - n_group_col = (x_int-sqrt_int)*a_int + n_group_row = (x_int + sqrt_int)*b_int + n_group_col = (x_int - sqrt_int)*a_int ! additional balancing IF (n_group_row == 2*(n_group_row/2) .AND. n_group_row > 2*n_group_col) THEN @@ -2825,13 +2825,13 @@ PURE SUBROUTINE get_start_end_size_indx(start_indx, end_indx, size_indx, nblkrow start_indx = row_blk_offset(blk) END IF - end_indx = row_blk_offset(blk)+row_blk_sizes(blk)-1 + end_indx = row_blk_offset(blk) + row_blk_sizes(blk) - 1 END IF END DO - size_indx = end_indx-start_indx+1 + size_indx = end_indx - start_indx + 1 ! have a check that if there is nothing to be done for the specific memory_cut, then we know it IF (start_indx == 0 .AND. end_indx == 0) THEN @@ -2860,7 +2860,7 @@ PURE SUBROUTINE get_blk_from_indx(indx, blk, blk_offset, blk_sizes) DO iblk = 1, nblkrows_total - IF (blk_offset(iblk) <= indx .AND. blk_offset(iblk)+blk_sizes(iblk)-1 >= indx) THEN + IF (blk_offset(iblk) <= indx .AND. blk_offset(iblk) + blk_sizes(iblk) - 1 >= indx) THEN blk = iblk diff --git a/src/mp2_gpw_method.F b/src/mp2_gpw_method.F index d1a1246460..bc9db7a1ff 100644 --- a/src/mp2_gpw_method.F +++ b/src/mp2_gpw_method.F @@ -188,7 +188,7 @@ SUBROUTINE mp2_gpw_compute(Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_s CALL dbcsr_create(matrix_ia_jnu, template=mo_coeff_o) ! Allocate Sparse matrices: (ia|jb) - CALL cp_dbcsr_m_by_n_from_template(matrix_ia_jb, template=mo_coeff_o, m=homo, n=nmo-homo, & + CALL cp_dbcsr_m_by_n_from_template(matrix_ia_jb, template=mo_coeff_o, m=homo, n=nmo - homo, & sym=dbcsr_type_no_symmetry) ! set all to zero in such a way that the memory is actually allocated @@ -232,10 +232,10 @@ SUBROUTINE mp2_gpw_compute(Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_s CALL dbcsr_create(matrix_ia_jnu_beta, template=mo_coeff_o_beta) ! Allocate Sparse matrices: (ia|jb) - CALL cp_dbcsr_m_by_n_from_template(matrix_ia_jb_beta, template=mo_coeff_o_beta, m=homo_beta, n=nmo-homo_beta, & + CALL cp_dbcsr_m_by_n_from_template(matrix_ia_jb_beta, template=mo_coeff_o_beta, m=homo_beta, n=nmo - homo_beta, & sym=dbcsr_type_no_symmetry) - virtual_beta = nmo-homo_beta + virtual_beta = nmo - homo_beta CALL dbcsr_set(matrix_ia_jnu_beta, 0.0_dp) CALL dbcsr_set(matrix_ia_jb_beta, 0.0_dp) @@ -245,7 +245,7 @@ SUBROUTINE mp2_gpw_compute(Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_s CALL prepare_gpw(qs_env, dft_control, e_cutoff_old, cutoff_old, relative_cutoff_old, para_env_sub, pw_env_sub, & auxbas_pw_pool, poisson_env, task_list_sub, rho_r, rho_g, pot_g, psi_a, sab_orb_sub) - virtual = nmo-homo + virtual = nmo - homo wfn_size = REAL(SIZE(rho_r%pw%cr3d), KIND=dp) CALL mp_max(wfn_size, para_env%group) @@ -272,12 +272,12 @@ SUBROUTINE mp2_gpw_compute(Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_s mem_min, ' MB' CALL m_memory(mem) - mem_real = (mem+1024*1024-1)/(1024*1024) + mem_real = (mem + 1024*1024 - 1)/(1024*1024) ! mp_min .... a hack.. it should be mp_max, but as it turns out, on some processes the previously freed memory (hfx) ! has not been given back to the OS yet. CALL mp_min(mem_real, para_env%group) - mem_real = mp2_memory-mem_real + mem_real = mp2_memory - mem_real mem_real = MAX(mem_real, mem_min) IF (unit_nr > 0) WRITE (unit_nr, '(T3,A,T69,F9.2,A3)') 'Available memory per MPI process for MP2:', & mem_real, ' MB' @@ -290,7 +290,7 @@ SUBROUTINE mp2_gpw_compute(Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_s CALL estimate_memory_usage(wfn_size, p, q, para_env_sub%num_pe, nmo, virtual, homo, calc_ex, mem_try) IF (mem_try > mem_real) CYCLE - wfn_calc = ((homo+p-1)/p)+((virtual+q-1)/q) + wfn_calc = ((homo + p - 1)/p) + ((virtual + q - 1)/q) IF (wfn_calc < wfn_calc_best) THEN wfn_calc_best = wfn_calc p_best = p @@ -298,8 +298,8 @@ SUBROUTINE mp2_gpw_compute(Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_s ENDIF ENDDO - max_batch_size_I = (homo+p_best-1)/p_best - max_batch_size_A = (virtual+q_best-1)/q_best + max_batch_size_I = (homo + p_best - 1)/p_best + max_batch_size_A = (virtual + q_best - 1)/q_best IF (unit_nr > 0) THEN WRITE (UNIT=unit_nr, FMT="(T3,A,T77,i4)") & @@ -315,25 +315,25 @@ SUBROUTINE mp2_gpw_compute(Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_s group_counter = 0 a_group_counter = 0 my_A_virtual_start = 1 - DO j = 0, q_best-1 + DO j = 0, q_best - 1 my_I_occupied_start = 1 i_group_counter = 0 - DO i = 0, p_best-1 - group_counter = group_counter+1 - IF (color_sub == group_counter-1) EXIT - my_I_occupied_start = my_I_occupied_start+vector_batch_I_size_group(i) - i_group_counter = i_group_counter+1 + DO i = 0, p_best - 1 + group_counter = group_counter + 1 + IF (color_sub == group_counter - 1) EXIT + my_I_occupied_start = my_I_occupied_start + vector_batch_I_size_group(i) + i_group_counter = i_group_counter + 1 END DO my_q_position = j - IF (color_sub == group_counter-1) EXIT - my_A_virtual_start = my_A_virtual_start+vector_batch_A_size_group(j) - a_group_counter = a_group_counter+1 + IF (color_sub == group_counter - 1) EXIT + my_A_virtual_start = my_A_virtual_start + vector_batch_A_size_group(j) + a_group_counter = a_group_counter + 1 END DO !XXXXXXXXXXXXX inverse group distribution - my_I_occupied_end = my_I_occupied_start+vector_batch_I_size_group(i_group_counter)-1 + my_I_occupied_end = my_I_occupied_start + vector_batch_I_size_group(i_group_counter) - 1 my_I_batch_size = vector_batch_I_size_group(i_group_counter) - my_A_virtual_end = my_A_virtual_start+vector_batch_A_size_group(a_group_counter)-1 + my_A_virtual_end = my_A_virtual_start + vector_batch_A_size_group(a_group_counter) - 1 my_A_batch_size = vector_batch_A_size_group(a_group_counter) DEALLOCATE (vector_batch_I_size_group) @@ -349,18 +349,18 @@ SUBROUTINE mp2_gpw_compute(Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_s ! divide the b states in the sub_group in such a way to create ! b_start and b_end for each proc inside the sub_group - max_b_size = (virtual+para_env_sub%num_pe-1)/para_env_sub%num_pe + max_b_size = (virtual + para_env_sub%num_pe - 1)/para_env_sub%num_pe CALL get_vector_batch(vector_B_sizes, para_env_sub%num_pe, max_b_size, virtual) ! now give to each proc its b_start and b_end b_group_counter = 0 my_B_virtual_start = 1 - DO j = 0, para_env_sub%num_pe-1 - b_group_counter = b_group_counter+1 - IF (b_group_counter-1 == para_env_sub%mepos) EXIT - my_B_virtual_start = my_B_virtual_start+vector_B_sizes(j) + DO j = 0, para_env_sub%num_pe - 1 + b_group_counter = b_group_counter + 1 + IF (b_group_counter - 1 == para_env_sub%mepos) EXIT + my_B_virtual_start = my_B_virtual_start + vector_B_sizes(j) END DO - my_B_virtual_end = my_B_virtual_start+vector_B_sizes(para_env_sub%mepos)-1 + my_B_virtual_end = my_B_virtual_start + vector_B_sizes(para_env_sub%mepos) - 1 my_B_size = vector_B_sizes(para_env_sub%mepos) DEALLOCATE (vector_B_sizes) @@ -368,12 +368,12 @@ SUBROUTINE mp2_gpw_compute(Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_s ! create an array containing a different "color" for each pair of ! A_start and B_start, communication will take place only among ! those proc that have the same A_start and B_start - ALLOCATE (color_array(0:para_env_sub%num_pe-1, 0:q_best-1)) + ALLOCATE (color_array(0:para_env_sub%num_pe - 1, 0:q_best - 1)) color_array = 0 color_counter = 0 - DO j = 0, q_best-1 - DO i = 0, para_env_sub%num_pe-1 - color_counter = color_counter+1 + DO j = 0, q_best - 1 + DO i = 0, para_env_sub%num_pe - 1 + color_counter = color_counter + 1 color_array(i, j) = color_counter END DO END DO @@ -389,18 +389,18 @@ SUBROUTINE mp2_gpw_compute(Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_s CALL cp_para_env_create(para_env_exchange, comm_exchange) ! crate the proc maps - ALLOCATE (proc_map(-para_env_exchange%num_pe:2*para_env_exchange%num_pe-1)) - DO i = 0, para_env_exchange%num_pe-1 + ALLOCATE (proc_map(-para_env_exchange%num_pe:2*para_env_exchange%num_pe - 1)) + DO i = 0, para_env_exchange%num_pe - 1 proc_map(i) = i - proc_map(-i-1) = para_env_exchange%num_pe-i-1 - proc_map(para_env_exchange%num_pe+i) = i + proc_map(-i - 1) = para_env_exchange%num_pe - i - 1 + proc_map(para_env_exchange%num_pe + i) = i END DO - ALLOCATE (sub_proc_map(-para_env_sub%num_pe:2*para_env_sub%num_pe-1)) - DO i = 0, para_env_sub%num_pe-1 + ALLOCATE (sub_proc_map(-para_env_sub%num_pe:2*para_env_sub%num_pe - 1)) + DO i = 0, para_env_sub%num_pe - 1 sub_proc_map(i) = i - sub_proc_map(-i-1) = para_env_sub%num_pe-i-1 - sub_proc_map(para_env_sub%num_pe+i) = i + sub_proc_map(-i - 1) = para_env_sub%num_pe - i - 1 + sub_proc_map(para_env_sub%num_pe + i) = i END DO ! create an array containing the information for communication @@ -417,7 +417,7 @@ SUBROUTINE mp2_gpw_compute(Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_s in_space=REALSPACE) CALL calculate_wavefunction(mo_coeff, i, psi_i(i), rho_g, atomic_kind_set, & qs_kind_set, cell, dft_control, particle_set, & - pw_env_sub, external_vector=my_Cocc(:, i-my_I_occupied_start+1)) + pw_env_sub, external_vector=my_Cocc(:, i - my_I_occupied_start + 1)) END DO potential_type = qs_env%mp2_env%potential_parameter%potential_type @@ -432,17 +432,17 @@ SUBROUTINE mp2_gpw_compute(Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_s END IF CALL timeset(routineN//"_loop", handle2) - DO a = homo+my_A_virtual_start, homo+my_A_virtual_end + DO a = homo + my_A_virtual_start, homo + my_A_virtual_end IF (calc_ex) BIb_C = 0.0_dp ! psi_a CALL calculate_wavefunction(mo_coeff, a, psi_a, rho_g, atomic_kind_set, & qs_kind_set, cell, dft_control, particle_set, & - pw_env_sub, external_vector=my_Cvirt(:, a-(homo+my_A_virtual_start)+1)) + pw_env_sub, external_vector=my_Cvirt(:, a - (homo + my_A_virtual_start) + 1)) i_counter = 0 DO i = my_I_occupied_start, my_I_occupied_end - i_counter = i_counter+1 + i_counter = i_counter + 1 ! potential rho_r%pw%cr3d = psi_i(i)%pw%cr3d*psi_a%pw%cr3d @@ -485,8 +485,8 @@ SUBROUTINE mp2_gpw_compute(Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_s DO b = 1, col_size DO j = 1, row_size ! Compute the coulomb MP2 energy - Emp2_Cou = Emp2_Cou-2.0_dp*data_block(j, b)**2/ & - (Eigenval(a)+Eigenval(homo+col_offset+b-1)-Eigenval(i)-Eigenval(row_offset+j-1)) + Emp2_Cou = Emp2_Cou - 2.0_dp*data_block(j, b)**2/ & + (Eigenval(a) + Eigenval(homo + col_offset + b - 1) - Eigenval(i) - Eigenval(row_offset + j - 1)) ENDDO ENDDO ENDDO @@ -501,8 +501,8 @@ SUBROUTINE mp2_gpw_compute(Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_s DO b = 1, col_size DO j = 1, row_size ! Compute the coulomb MP2 energy alpha beta case - Emp2_AB = Emp2_AB-data_block(j, b)**2/ & - (Eigenval(a)+Eigenval_beta(homo_beta+col_offset+b-1)-Eigenval(i)-Eigenval_beta(row_offset+j-1)) + Emp2_AB = Emp2_AB - data_block(j, b)**2/ & + (Eigenval(a) + Eigenval_beta(homo_beta + col_offset + b - 1) - Eigenval(i) - Eigenval_beta(row_offset + j - 1)) ENDDO ENDDO ENDDO @@ -529,18 +529,18 @@ SUBROUTINE mp2_gpw_compute(Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_s DO i = 1, my_I_batch_size DO j = my_I_occupied_start, my_I_occupied_end DO b = 1, my_B_size - b_global = b-1+my_B_virtual_start - Emp2_EX = Emp2_EX+BIb_C(b, j, i)*BIb_C(b, i+my_I_occupied_start-1, j-my_I_occupied_start+1) & - /(Eigenval(a)+Eigenval(homo+b_global)-Eigenval(i+my_I_occupied_start-1)-Eigenval(j)) + b_global = b - 1 + my_B_virtual_start + Emp2_EX = Emp2_EX + BIb_C(b, j, i)*BIb_C(b, i + my_I_occupied_start - 1, j - my_I_occupied_start + 1) & + /(Eigenval(a) + Eigenval(homo + b_global) - Eigenval(i + my_I_occupied_start - 1) - Eigenval(j)) END DO END DO END DO ! start communicating and collecting exchange contributions from ! other processes in my exchange group - DO index_proc_shift = 1, size_of_exchange_group-1 - proc_send = proc_map(mepos_in_EX_group+index_proc_shift) - proc_receive = proc_map(mepos_in_EX_group-index_proc_shift) + DO index_proc_shift = 1, size_of_exchange_group - 1 + proc_send = proc_map(mepos_in_EX_group + index_proc_shift) + proc_receive = proc_map(mepos_in_EX_group - index_proc_shift) CALL get_group_dist(gd_exchange, proc_receive, EX_start, EX_end, size_EX) @@ -559,10 +559,10 @@ SUBROUTINE mp2_gpw_compute(Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_s DO i = 1, my_I_batch_size DO j = 1, size_EX DO b = 1, my_B_size - b_global = b-1+my_B_virtual_start - Emp2_EX = Emp2_EX+BIb_C(b, j+EX_start-1, i)*BIb_EX(b, i, j) & - /(Eigenval(a)+Eigenval(homo+b_global)-Eigenval(i+my_I_occupied_start-1) & - -Eigenval(j+EX_start-1)) + b_global = b - 1 + my_B_virtual_start + Emp2_EX = Emp2_EX + BIb_C(b, j + EX_start - 1, i)*BIb_EX(b, i, j) & + /(Eigenval(a) + Eigenval(homo + b_global) - Eigenval(i + my_I_occupied_start - 1) & + - Eigenval(j + EX_start - 1)) END DO END DO END DO @@ -579,7 +579,7 @@ SUBROUTINE mp2_gpw_compute(Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_s CALL mp_sum(Emp2_Cou, para_env%group) CALL mp_sum(Emp2_EX, para_env%group) - Emp2 = Emp2_Cou+Emp2_EX + Emp2 = Emp2_Cou + Emp2_EX IF (do_alpha_beta) CALL mp_sum(Emp2_AB, para_env%group) DEALLOCATE (my_Cocc) @@ -635,20 +635,20 @@ ELEMENTAL SUBROUTINE estimate_memory_usage(wfn_size, p, q, num_w, nmo, virtual, mem_try = 0.0_dp ! integrals - mem_try = mem_try+virtual*REAL(homo, KIND=dp)**2/(p*num_w) + mem_try = mem_try + virtual*REAL(homo, KIND=dp)**2/(p*num_w) ! array for the coefficient matrix and wave vectors - mem_try = mem_try+REAL(homo, KIND=dp)*nmo/p+ & - REAL(virtual, KIND=dp)*nmo/q+ & + mem_try = mem_try + REAL(homo, KIND=dp)*nmo/p + & + REAL(virtual, KIND=dp)*nmo/q + & 2.0_dp*MAX(REAL(homo, KIND=dp)*nmo/p, REAL(virtual, KIND=dp)*nmo/q) ! temporary array for MO integrals and MO integrals to be exchanged IF (calc_ex) THEN - mem_try = mem_try+2.0_dp*MAX(virtual*REAL(homo, KIND=dp)*MIN(1, num_w-1)/num_w, & - virtual*REAL(homo, KIND=dp)**2/(p*p*num_w)) + mem_try = mem_try + 2.0_dp*MAX(virtual*REAL(homo, KIND=dp)*MIN(1, num_w - 1)/num_w, & + virtual*REAL(homo, KIND=dp)**2/(p*p*num_w)) ELSE - mem_try = mem_try+2.0_dp*virtual*REAL(homo, KIND=dp) + mem_try = mem_try + 2.0_dp*virtual*REAL(homo, KIND=dp) END IF ! wfn - mem_try = mem_try+((homo+p-1)/p)*wfn_size + mem_try = mem_try + ((homo + p - 1)/p)*wfn_size ! Mb mem_try = mem_try*8.0D+00/1024.0D+00**2 @@ -667,7 +667,7 @@ PURE SUBROUTINE get_vector_batch(vector_batch_I_size_group, p_best, max_batch_si INTEGER :: i, one - ALLOCATE (vector_batch_I_size_group(0:p_best-1)) + ALLOCATE (vector_batch_I_size_group(0:p_best - 1)) vector_batch_I_size_group = max_batch_size_I IF (SUM(vector_batch_I_size_group) /= homo) THEN @@ -675,10 +675,10 @@ PURE SUBROUTINE get_vector_batch(vector_batch_I_size_group, p_best, max_batch_si IF (SUM(vector_batch_I_size_group) > homo) one = -1 i = -1 DO - i = i+1 - vector_batch_I_size_group(i) = vector_batch_I_size_group(i)+one + i = i + 1 + vector_batch_I_size_group(i) = vector_batch_I_size_group(i) + one IF (SUM(vector_batch_I_size_group) == homo) EXIT - IF (i == p_best-1) i = -1 + IF (i == p_best - 1) i = -1 END DO END IF @@ -735,7 +735,7 @@ SUBROUTINE grep_my_integrals(para_env_sub, fm_BIb_jb, BIb_jb, max_row_col_local, IF (j_global >= my_B_virtual_start .AND. j_global <= my_B_virtual_end) THEN DO iiB = 1, nrow_rec i_global = row_indices_rec(iiB) - BIb_jb(j_global-my_B_virtual_start+1, i_global) = fm_BIb_jb%local_data(iiB, jjB) + BIb_jb(j_global - my_B_virtual_start + 1, i_global) = fm_BIb_jb%local_data(iiB, jjB) END DO END IF END DO @@ -747,9 +747,9 @@ SUBROUTINE grep_my_integrals(para_env_sub, fm_BIb_jb, BIb_jb, max_row_col_local, ALLOCATE (local_BI(nrow_rec, ncol_rec)) local_BI(1:nrow_rec, 1:ncol_rec) = fm_BIb_jb%local_data(1:nrow_rec, 1:ncol_rec) - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_send = proc_map(para_env_sub%mepos+proc_shift) - proc_receive = proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_send = proc_map(para_env_sub%mepos + proc_shift) + proc_receive = proc_map(para_env_sub%mepos - proc_shift) ! first exchange information on the local data rec_col_row_info = 0 @@ -775,7 +775,7 @@ SUBROUTINE grep_my_integrals(para_env_sub, fm_BIb_jb, BIb_jb, max_row_col_local, IF (j_global >= my_B_virtual_start .AND. j_global <= my_B_virtual_end) THEN DO iiB = 1, nrow_rec i_global = row_indices_rec(iiB) - BIb_jb(j_global-my_B_virtual_start+1, i_global) = rec_BI(iiB, jjB) + BIb_jb(j_global - my_B_virtual_start + 1, i_global) = rec_BI(iiB, jjB) END DO END IF END DO @@ -843,11 +843,11 @@ SUBROUTINE grep_occ_virt_wavefunc(para_env_sub, dimen, & row_size=row_size, col_size=col_size, & row_offset=row_offset, col_offset=col_offset) DO j = 1, col_size - j_global = col_offset+j-1 + j_global = col_offset + j - 1 IF (j_global >= my_I_occupied_start .AND. j_global <= my_I_occupied_end) THEN DO i = 1, row_size - i_global = row_offset+i-1 - my_Cocc(i_global, j_global-my_I_occupied_start+1) = data_block(i, j) + i_global = row_offset + i - 1 + my_Cocc(i_global, j_global - my_I_occupied_start + 1) = data_block(i, j) END DO END IF END DO @@ -863,11 +863,11 @@ SUBROUTINE grep_occ_virt_wavefunc(para_env_sub, dimen, & row_size=row_size, col_size=col_size, & row_offset=row_offset, col_offset=col_offset) DO j = 1, col_size - j_global = col_offset+j-1 + j_global = col_offset + j - 1 IF (j_global >= my_A_virtual_start .AND. j_global <= my_A_virtual_end) THEN DO i = 1, row_size - i_global = row_offset+i-1 - my_Cvirt(i_global, j_global-my_A_virtual_start+1) = data_block(i, j) + i_global = row_offset + i - 1 + my_Cvirt(i_global, j_global - my_A_virtual_start + 1) = data_block(i, j) END DO END IF END DO diff --git a/src/mp2_integrals.F b/src/mp2_integrals.F index ba76389c5c..02e0c6fba9 100644 --- a/src/mp2_integrals.F +++ b/src/mp2_integrals.F @@ -324,8 +324,8 @@ SUBROUTINE mp2_ri_gpw_compute_in(BIb_C, BIb_C_gw, BIb_C_bse_ij, BIb_C_bse_ab, gd ! imag. time only without Coulomb metric implemented CPASSERT(.NOT. (ri_metric == do_potential_coulomb .AND. do_im_time)) - virtual = nmo-homo - gw_corr_lev_total = gw_corr_lev_virt+gw_corr_lev_occ + virtual = nmo - homo + gw_corr_lev_total = gw_corr_lev_virt + gw_corr_lev_occ eri_method = qs_env%mp2_env%eri_method eri_param => qs_env%mp2_env%eri_mme_param @@ -366,7 +366,7 @@ SUBROUTINE mp2_ri_gpw_compute_in(BIb_C, BIb_C_gw, BIb_C_bse_ij, BIb_C_bse_ab, gd IF (do_alpha_beta) THEN - virtual_beta = nmo-homo_beta + virtual_beta = nmo - homo_beta CALL create_intermediate_matrices(matrix_ia_jnu_beta, matrix_ia_jb_beta, mo_coeff_o_beta, & virtual_beta, homo_beta, & @@ -492,7 +492,7 @@ SUBROUTINE mp2_ri_gpw_compute_in(BIb_C, BIb_C_gw, BIb_C_bse_ij, BIb_C_bse_ab, gd ! we need (P|Q)^(-1/2) for future use, just save it ! in a fully (home made) distributed way itmp = get_limit(dimen_RI, para_env_sub%num_pe, para_env_sub%mepos) - lll = itmp(2)-itmp(1)+1 + lll = itmp(2) - itmp(1) + 1 ALLOCATE (qs_env%mp2_env%ri_grad%PQ_half(lll, my_group_L_size)) qs_env%mp2_env%ri_grad%PQ_half(:, :) = my_Lrows(itmp(1):itmp(2), 1:my_group_L_size) END IF @@ -508,8 +508,8 @@ SUBROUTINE mp2_ri_gpw_compute_in(BIb_C, BIb_C_gw, BIb_C_bse_ij, BIb_C_bse_ab, gd END IF mem_for_iaK = dimen_RI*REAL(homo, KIND=dp)*virtual*8.0_dp/(1024_dp**2) - IF (do_alpha_beta) mem_for_iaK = mem_for_iaK+ & - dimen_RI*REAL(homo_beta, KIND=dp)*(nmo-homo_beta)*8.0_dp/(1024_dp**2) + IF (do_alpha_beta) mem_for_iaK = mem_for_iaK + & + dimen_RI*REAL(homo_beta, KIND=dp)*(nmo - homo_beta)*8.0_dp/(1024_dp**2) WRITE (unit_nr, '(T3,A,T66,F11.2,A4)') 'RI_INFO| Total memory for (ia|K) integrals:', & mem_for_iaK, ' MiB' @@ -527,11 +527,11 @@ SUBROUTINE mp2_ri_gpw_compute_in(BIb_C, BIb_C_gw, BIb_C_bse_ij, BIb_C_bse_ab, gd ! in case we do imaginary time, we need the overlap matrix (alpha beta P) IF (.NOT. do_im_time) THEN - ALLOCATE (sub_proc_map(-para_env_sub%num_pe:2*para_env_sub%num_pe-1)) - DO i = 0, para_env_sub%num_pe-1 + ALLOCATE (sub_proc_map(-para_env_sub%num_pe:2*para_env_sub%num_pe - 1)) + DO i = 0, para_env_sub%num_pe - 1 sub_proc_map(i) = i - sub_proc_map(-i-1) = para_env_sub%num_pe-i-1 - sub_proc_map(para_env_sub%num_pe+i) = i + sub_proc_map(-i - 1) = para_env_sub%num_pe - i - 1 + sub_proc_map(para_env_sub%num_pe + i) = i END DO ! array that will store the (ia|K) integrals @@ -980,20 +980,20 @@ SUBROUTINE split_block_sizes(blk_sizes, blk_sizes_split, max_size) isplit_sum = 0 DO i = 1, SIZE(blk_sizes) - nsplit = (blk_sizes(i)+max_size-1)/max_size - isplit_sum = isplit_sum+nsplit + nsplit = (blk_sizes(i) + max_size - 1)/max_size + isplit_sum = isplit_sum + nsplit ENDDO ALLOCATE (blk_sizes_split(isplit_sum)) isplit_sum = 0 DO i = 1, SIZE(blk_sizes) - nsplit = (blk_sizes(i)+max_size-1)/max_size + nsplit = (blk_sizes(i) + max_size - 1)/max_size blk_remainder = blk_sizes(i) DO isplit = 1, nsplit - isplit_sum = isplit_sum+1 + isplit_sum = isplit_sum + 1 blk_sizes_split(isplit_sum) = MIN(max_size, blk_remainder) - blk_remainder = blk_remainder-max_size + blk_remainder = blk_remainder - max_size ENDDO ENDDO @@ -1045,8 +1045,8 @@ SUBROUTINE create_tensor_M_3c(t_3c_M, pgrid_t3c_M, mem_cut, sizes_AO, sizes_RI, bsum = 0 DO imem = 1, mem_cut - starts_array_mc(imem) = bsum+1 - bsum = bsum+SUM(sizes_AO(starts_array_mc_block(imem):ends_array_mc_block(imem))) + starts_array_mc(imem) = bsum + 1 + bsum = bsum + SUM(sizes_AO(starts_array_mc_block(imem):ends_array_mc_block(imem))) ends_array_mc(imem) = bsum ENDDO @@ -1054,7 +1054,7 @@ SUBROUTINE create_tensor_M_3c(t_3c_M, pgrid_t3c_M, mem_cut, sizes_AO, sizes_RI, ALLOCATE (dist_ao_2(size_AO)) DO imem = 1, mem_cut - size_AO_cut = ends_array_mc_block(imem)-starts_array_mc_block(imem)+1 + size_AO_cut = ends_array_mc_block(imem) - starts_array_mc_block(imem) + 1 IF (size_AO_cut < MIN(pdims(2), pdims(3))) THEN CPABORT("use smaller MEMORY_CUT or use less MPI ranks") @@ -1202,7 +1202,7 @@ SUBROUTINE contract_B_L(BIb_C, my_Lrows, sizes_B, sizes_L, blk_size, ngroup, igr CALL mp_environ(nproc_glob, iproc_glob, mp_comm) ! local block index for R/P and a - loc_P = igroup+1; loc_a = iproc+1 + loc_P = igroup + 1; loc_a = iproc + 1 CPASSERT(SIZE(sizes_L) .EQ. ngroup) CPASSERT(SIZE(sizes_B) .EQ. nproc) @@ -1236,9 +1236,9 @@ SUBROUTINE contract_B_L(BIb_C, my_Lrows, sizes_B, sizes_L, blk_size, ngroup, igr ! setup distribution vectors such that distribution matches parallel data layout of BIb_C and my_Lrows dist_B_i = [0] - dist_B_a = (/(i, i=0, nproc-1)/) - dist_L_R = (/(MODULO(i, nproc), i=0, ngroup-1)/) ! R index is replicated in my_Lrows, we impose a cyclic distribution - dist_L_P = (/(i, i=0, ngroup-1)/) + dist_B_a = (/(i, i=0, nproc - 1)/) + dist_L_R = (/(MODULO(i, nproc), i=0, ngroup - 1)/) ! R index is replicated in my_Lrows, we impose a cyclic distribution + dist_L_P = (/(i, i=0, ngroup - 1)/) ! create distributions and tensors CALL dbcsr_t_distribution_new(dist_B, mp_comm_B, map_B_1, map_B_2, dist_L_P, dist_B_a, dist_B_i) @@ -1261,14 +1261,14 @@ SUBROUTINE contract_B_L(BIb_C, my_Lrows, sizes_B, sizes_L, blk_size, ngroup, igr ! in my_Lrows, R index is replicated. For (R|P), we distribute quadratic blocks cyclically over ! the processes in a subgroup. ! There are NG blocks, so each process holds at most NG/Nw+1 blocks. - ALLOCATE (block_ind_L_R(ngroup/nproc+1)) - ALLOCATE (block_ind_L_P(ngroup/nproc+1)) + ALLOCATE (block_ind_L_R(ngroup/nproc + 1)) + ALLOCATE (block_ind_L_P(ngroup/nproc + 1)) block_ind_L_R(:) = 0; block_ind_L_P(:) = 0 ii = 0 DO i = 1, ngroup CALL dbcsr_t_get_stored_coordinates(tL, [i, loc_P], check_proc) IF (check_proc == iproc_glob) THEN - ii = ii+1 + ii = ii + 1 block_ind_L_R(ii) = i block_ind_L_P(ii) = loc_P ENDIF @@ -1281,8 +1281,8 @@ SUBROUTINE contract_B_L(BIb_C, my_Lrows, sizes_B, sizes_L, blk_size, ngroup, igr ! insert (R|P) blocks ioff = 0 DO i = 1, ngroup - istart = ioff+1; iend = ioff+sizes_L(i) - ioff = ioff+sizes_L(i) + istart = ioff + 1; iend = ioff + sizes_L(i) + ioff = ioff + sizes_L(i) CALL dbcsr_t_get_stored_coordinates(tL, [i, loc_P], check_proc) IF (check_proc == iproc_glob) THEN CALL dbcsr_t_put_block(tL, [i, loc_P], [sizes_L(i), sizes_L(loc_P)], my_Lrows(istart:iend, :)) @@ -1511,7 +1511,7 @@ SUBROUTINE compute_kpoints(qs_env, kpoints, unit_nr) nkp_grid(1:3) = qs_env%mp2_env%ri_rpa_im_time%kp_grid(1:3) kpoints%nkp_grid(1:3) = nkp_grid(1:3) - num_dim = periodic(1)+periodic(2)+periodic(3) + num_dim = periodic(1) + periodic(2) + periodic(3) DO i_dim = 1, 3 IF (periodic(i_dim) == 1) THEN @@ -1540,12 +1540,12 @@ SUBROUTINE compute_kpoints(qs_env, kpoints, unit_nr) DO iy = 1, nkp_grid(2) DO iz = 1, nkp_grid(3) - i = i+1 + i = i + 1 IF (i > nkp) CYCLE - kpoints%xkp(1, i) = REAL(2*ix-nkp_grid(1)-1, KIND=dp)/(2._dp*REAL(nkp_grid(1), KIND=dp)) - kpoints%xkp(2, i) = REAL(2*iy-nkp_grid(2)-1, KIND=dp)/(2._dp*REAL(nkp_grid(2), KIND=dp)) - kpoints%xkp(3, i) = REAL(2*iz-nkp_grid(3)-1, KIND=dp)/(2._dp*REAL(nkp_grid(3), KIND=dp)) + kpoints%xkp(1, i) = REAL(2*ix - nkp_grid(1) - 1, KIND=dp)/(2._dp*REAL(nkp_grid(1), KIND=dp)) + kpoints%xkp(2, i) = REAL(2*iy - nkp_grid(2) - 1, KIND=dp)/(2._dp*REAL(nkp_grid(2), KIND=dp)) + kpoints%xkp(3, i) = REAL(2*iz - nkp_grid(3) - 1, KIND=dp)/(2._dp*REAL(nkp_grid(3), KIND=dp)) END DO END DO @@ -1599,11 +1599,11 @@ SUBROUTINE grep_Lcols(para_env, dimen_RI, fm_matrix_L, & ! for negative and positive number > num_pe ! needed to know which is the processor, to respect to another one, ! for a given shift - ALLOCATE (proc_map(-para_env%num_pe:2*para_env%num_pe-1)) - DO iiB = 0, para_env%num_pe-1 + ALLOCATE (proc_map(-para_env%num_pe:2*para_env%num_pe - 1)) + DO iiB = 0, para_env%num_pe - 1 proc_map(iiB) = iiB - proc_map(-iiB-1) = para_env%num_pe-iiB-1 - proc_map(para_env%num_pe+iiB) = iiB + proc_map(-iiB - 1) = para_env%num_pe - iiB - 1 + proc_map(para_env%num_pe + iiB) = iiB END DO CALL cp_fm_get_info(matrix=fm_matrix_L, & @@ -1636,19 +1636,19 @@ SUBROUTINE grep_Lcols(para_env, dimen_RI, fm_matrix_L, & IF (j_global >= my_group_L_start .AND. j_global <= my_group_L_end) THEN DO iiB = 1, nrow_local i_global = row_indices(iiB) - my_Lrows(i_global, j_global-my_group_L_start+1) = local_L(iiB, jjB) + my_Lrows(i_global, j_global - my_group_L_start + 1) = local_L(iiB, jjB) END DO END IF END DO - proc_send_static = proc_map(para_env%mepos+1) - proc_receive_static = proc_map(para_env%mepos-1) + proc_send_static = proc_map(para_env%mepos + 1) + proc_receive_static = proc_map(para_env%mepos - 1) CALL timeset(routineN//"_comm", handle2) - DO proc_shift = 1, para_env%num_pe-1 - proc_send = proc_map(para_env%mepos+proc_shift) - proc_receive = proc_map(para_env%mepos-proc_shift) + DO proc_shift = 1, para_env%num_pe - 1 + proc_send = proc_map(para_env%mepos + proc_shift) + proc_receive = proc_map(para_env%mepos - proc_shift) ! first exchange information on the local data rec_col_row_info = 0 @@ -1674,7 +1674,7 @@ SUBROUTINE grep_Lcols(para_env, dimen_RI, fm_matrix_L, & IF (j_global >= my_group_L_start .AND. j_global <= my_group_L_end) THEN DO iiB = 1, nrow_rec i_global = row_indices_rec(iiB) - my_Lrows(i_global, j_global-my_group_L_start+1) = rec_L(iiB, jjB) + my_Lrows(i_global, j_global - my_group_L_start + 1) = rec_L(iiB, jjB) END DO END IF END DO @@ -1750,7 +1750,7 @@ SUBROUTINE grep_my_integrals(para_env_sub, fm_BIb_jb, BIb_jb, max_row_col_local, IF (j_global >= my_B_virtual_start .AND. j_global <= my_B_virtual_end) THEN DO iiB = 1, nrow_rec i_global = row_indices_rec(iiB) - BIb_jb(j_global-my_B_virtual_start+1, i_global) = fm_BIb_jb%local_data(iiB, jjB) + BIb_jb(j_global - my_B_virtual_start + 1, i_global) = fm_BIb_jb%local_data(iiB, jjB) END DO END IF END DO @@ -1762,9 +1762,9 @@ SUBROUTINE grep_my_integrals(para_env_sub, fm_BIb_jb, BIb_jb, max_row_col_local, ALLOCATE (local_BI(nrow_rec, ncol_rec)) local_BI(1:nrow_rec, 1:ncol_rec) = fm_BIb_jb%local_data(1:nrow_rec, 1:ncol_rec) - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_send = proc_map(para_env_sub%mepos+proc_shift) - proc_receive = proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_send = proc_map(para_env_sub%mepos + proc_shift) + proc_receive = proc_map(para_env_sub%mepos - proc_shift) ! first exchange information on the local data rec_col_row_info = 0 @@ -1790,7 +1790,7 @@ SUBROUTINE grep_my_integrals(para_env_sub, fm_BIb_jb, BIb_jb, max_row_col_local, IF (j_global >= my_B_virtual_start .AND. j_global <= my_B_virtual_end) THEN DO iiB = 1, nrow_rec i_global = row_indices_rec(iiB) - BIb_jb(j_global-my_B_virtual_start+1, i_global) = rec_BI(iiB, jjB) + BIb_jb(j_global - my_B_virtual_start + 1, i_global) = rec_BI(iiB, jjB) END DO END IF END DO @@ -2078,7 +2078,7 @@ SUBROUTINE compute_3c_overlap_int(mat_3c_overl_int, mat_3c_overl_int_mao_for_occ IF (.NOT. (acell == i_img)) CYCLE - bcellvec = -outer_cell_vec+cell_vec + bcellvec = -outer_cell_vec + cell_vec IF (bcellvec(1) < minval_1) CYCLE IF (bcellvec(1) > maxval_1) CYCLE @@ -2094,7 +2094,7 @@ SUBROUTINE compute_3c_overlap_int(mat_3c_overl_int, mat_3c_overl_int_mao_for_occ END IF raRI = rab_outer - rbRI = raRI-rab + rbRI = raRI - rab ELSE IF (atom_RI .EQ. iatom_outer .AND. & iatom .EQ. jatom_outer) THEN @@ -2105,7 +2105,7 @@ SUBROUTINE compute_3c_overlap_int(mat_3c_overl_int, mat_3c_overl_int_mao_for_occ END IF raRI = -rab_outer - rbRI = raRI-rab + rbRI = raRI - rab ELSE IF (jatom .EQ. iatom_outer .AND. & atom_RI .EQ. jatom_outer) THEN @@ -2116,7 +2116,7 @@ SUBROUTINE compute_3c_overlap_int(mat_3c_overl_int, mat_3c_overl_int_mao_for_occ END IF rbRI = rab_outer - raRI = rbRI+rab + raRI = rbRI + rab ELSE IF (atom_RI .EQ. iatom_outer .AND. & jatom .EQ. jatom_outer) THEN @@ -2127,7 +2127,7 @@ SUBROUTINE compute_3c_overlap_int(mat_3c_overl_int, mat_3c_overl_int_mao_for_occ END IF rbRI = -rab_outer - raRI = rbRI+rab + raRI = rbRI + rab END IF @@ -2165,12 +2165,12 @@ SUBROUTINE compute_3c_overlap_int(mat_3c_overl_int, mat_3c_overl_int_mao_for_occ DO iset = 1, nseta - IF (set_radius_a(iset)+set_radius_RI(set_RI) < daRI) CYCLE + IF (set_radius_a(iset) + set_radius_RI(set_RI) < daRI) CYCLE DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE - IF (set_radius_b(jset)+set_radius_RI(set_RI) < dbRI) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE + IF (set_radius_b(jset) + set_radius_RI(set_RI) < dbRI) CYCLE nco_RI = npgf_RI(set_RI)*ncoset(l_max_RI(set_RI)) ncoa = npgfa(iset)*ncoset(la_max(iset)) @@ -2180,11 +2180,11 @@ SUBROUTINE compute_3c_overlap_int(mat_3c_overl_int, mat_3c_overl_int_mao_for_occ sgfa = first_sgfa(1, iset) sgfb = first_sgfb(1, jset) - LLL_set_start = 1+sgf_RI-1-my_group_L_start+1+row_blk_start(atom_RI)-1 + LLL_set_start = 1 + sgf_RI - 1 - my_group_L_start + 1 + row_blk_start(atom_RI) - 1 IF (LLL_set_start > my_group_L_size) CYCLE - LLL_set_end = nsgf_RI(set_RI)+sgf_RI-1-my_group_L_start+1+row_blk_start(atom_RI)-1 + LLL_set_end = nsgf_RI(set_RI) + sgf_RI - 1 - my_group_L_start + 1 + row_blk_start(atom_RI) - 1 IF (LLL_set_end < 1) CYCLE @@ -2217,7 +2217,7 @@ SUBROUTINE compute_3c_overlap_int(mat_3c_overl_int, mat_3c_overl_int_mao_for_occ DO isgf_RI = 1, nsgf_RI(set_RI) - LLL = isgf_RI+sgf_RI-1-my_group_L_start+1+row_blk_start(atom_RI)-1 + LLL = isgf_RI + sgf_RI - 1 - my_group_L_start + 1 + row_blk_start(atom_RI) - 1 IF (LLL < 1) CYCLE IF (LLL > my_group_L_size) CYCLE @@ -2244,49 +2244,49 @@ SUBROUTINE compute_3c_overlap_int(mat_3c_overl_int, mat_3c_overl_int_mao_for_occ ALLOCATE (block_transposed(col_blk_sizes(col), row_blk_sizes(row)*my_group_L_size)) block_transposed = 0.0_dp - offset_row_from_LLL = (LLL-1)*row_blk_sizes(row) - offset_col_from_LLL = (LLL-1)*col_blk_sizes(col) + offset_row_from_LLL = (LLL - 1)*row_blk_sizes(row) + offset_col_from_LLL = (LLL - 1)*col_blk_sizes(col) IF (iatom < jatom) THEN block_start_row = sgfa - block_end_row = sgfa+nsgfa(iset)-1 + block_end_row = sgfa + nsgfa(iset) - 1 block_start_col = sgfb - block_end_col = sgfb+nsgfb(jset)-1 + block_end_col = sgfb + nsgfb(jset) - 1 ! factor 0.5 is necessary due to double filling due to double iterate loop block(block_start_row:block_end_row, & - block_start_col+offset_col_from_LLL:block_end_col+offset_col_from_LLL) = & + block_start_col + offset_col_from_LLL:block_end_col + offset_col_from_LLL) = & 0.5_dp*s_abRI_contr(:, :, isgf_RI) block_transposed(block_start_col:block_end_col, & - block_start_row+offset_row_from_LLL: & - block_end_row+offset_row_from_LLL) = & + block_start_row + offset_row_from_LLL: & + block_end_row + offset_row_from_LLL) = & 0.5_dp*s_abRI_contr_transposed(:, :, isgf_RI) ELSE IF (iatom > jatom) THEN block_start_row = sgfb - block_end_row = sgfb+nsgfb(jset)-1 + block_end_row = sgfb + nsgfb(jset) - 1 block_start_col = sgfa - block_end_col = sgfa+nsgfa(iset)-1 + block_end_col = sgfa + nsgfa(iset) - 1 ! factor 0.5 is necessary due to double filling due to double iterate loop block(block_start_row:block_end_row, & - block_start_col+offset_col_from_LLL:block_end_col+offset_col_from_LLL) = & + block_start_col + offset_col_from_LLL:block_end_col + offset_col_from_LLL) = & 0.5_dp*s_abRI_contr_transposed(:, :, isgf_RI) block_transposed(block_start_col:block_end_col, & - block_start_row+offset_row_from_LLL: & - block_end_row+offset_row_from_LLL) = & + block_start_row + offset_row_from_LLL: & + block_end_row + offset_row_from_LLL) = & 0.5_dp*s_abRI_contr(:, :, isgf_RI) ELSE IF (iatom .EQ. jatom) THEN block_start_row = sgfa - block_end_row = sgfa+nsgfa(iset)-1 - block_start_col = sgfb+offset_col_from_LLL - block_end_col = sgfb+nsgfb(jset)-1+offset_col_from_LLL + block_end_row = sgfa + nsgfa(iset) - 1 + block_start_col = sgfb + offset_col_from_LLL + block_end_col = sgfb + nsgfb(jset) - 1 + offset_col_from_LLL block(block_start_row:block_end_row, & block_start_col:block_end_col) = s_abRI_contr(:, :, isgf_RI) @@ -2336,22 +2336,22 @@ SUBROUTINE compute_3c_overlap_int(mat_3c_overl_int, mat_3c_overl_int_mao_for_occ ! transform from the primary Gaussian basis into the MAO basis CALL ab_contract(temp_mat_mao_occ_virt(:, :), s_abRI_contr(:, :, isgf_RI), & - mao_coeff_repl_occ(iatom)%array(sgfa:sgfa+nsgfa(iset)-1, :), & - mao_coeff_repl_virt(jatom)%array(sgfb:sgfb+nsgfb(jset)-1, :), & + mao_coeff_repl_occ(iatom)%array(sgfa:sgfa + nsgfa(iset) - 1, :), & + mao_coeff_repl_virt(jatom)%array(sgfb:sgfb + nsgfb(jset) - 1, :), & nsgfa(iset), nsgfb(jset), & iatom_basis_size_mao_occ, jatom_basis_size_mao_virt) CALL ab_contract(temp_mat_mao_virt_occ(:, :), s_abRI_contr(:, :, isgf_RI), & - mao_coeff_repl_virt(iatom)%array(sgfa:sgfa+nsgfa(iset)-1, :), & - mao_coeff_repl_occ(jatom)%array(sgfb:sgfb+nsgfb(jset)-1, :), & + mao_coeff_repl_virt(iatom)%array(sgfa:sgfa + nsgfa(iset) - 1, :), & + mao_coeff_repl_occ(jatom)%array(sgfb:sgfb + nsgfb(jset) - 1, :), & nsgfa(iset), nsgfb(jset), & iatom_basis_size_mao_virt, jatom_basis_size_mao_occ) - start_row_from_LLL_mao_occ = (LLL-1)*row_basis_size_mao_occ+1 - start_col_from_LLL_mao_occ = (LLL-1)*col_basis_size_mao_occ+1 + start_row_from_LLL_mao_occ = (LLL - 1)*row_basis_size_mao_occ + 1 + start_col_from_LLL_mao_occ = (LLL - 1)*col_basis_size_mao_occ + 1 - start_row_from_LLL_mao_virt = (LLL-1)*row_basis_size_mao_virt+1 - start_col_from_LLL_mao_virt = (LLL-1)*col_basis_size_mao_virt+1 + start_row_from_LLL_mao_virt = (LLL - 1)*row_basis_size_mao_virt + 1 + start_col_from_LLL_mao_virt = (LLL - 1)*col_basis_size_mao_virt + 1 end_row_from_LLL_mao_occ = LLL*row_basis_size_mao_occ end_col_from_LLL_mao_occ = LLL*col_basis_size_mao_occ @@ -2773,24 +2773,24 @@ SUBROUTINE reserve_blocks_3c(mat_3c_overl_int, mat_munu, qs_env, dimen_RI, & IF (outer_cell_vec(3) < minval_3) CYCLE IF (outer_cell_vec(3) > maxval_3) CYCLE - IF (-outer_cell_vec(1)+cell_vec(1) < minval_1) CYCLE - IF (-outer_cell_vec(1)+cell_vec(1) > maxval_1) CYCLE - IF (-outer_cell_vec(2)+cell_vec(2) < minval_2) CYCLE - IF (-outer_cell_vec(2)+cell_vec(2) > maxval_2) CYCLE - IF (-outer_cell_vec(3)+cell_vec(3) < minval_3) CYCLE - IF (-outer_cell_vec(3)+cell_vec(3) > maxval_3) CYCLE + IF (-outer_cell_vec(1) + cell_vec(1) < minval_1) CYCLE + IF (-outer_cell_vec(1) + cell_vec(1) > maxval_1) CYCLE + IF (-outer_cell_vec(2) + cell_vec(2) < minval_2) CYCLE + IF (-outer_cell_vec(2) + cell_vec(2) > maxval_2) CYCLE + IF (-outer_cell_vec(3) + cell_vec(3) < minval_3) CYCLE + IF (-outer_cell_vec(3) + cell_vec(3) > maxval_3) CYCLE acell = cell_to_index(-outer_cell_vec(1), -outer_cell_vec(2), -outer_cell_vec(3)) IF (.NOT. (acell == i_img)) CYCLE - bcell = cell_to_index(-outer_cell_vec(1)+cell_vec(1), & - -outer_cell_vec(2)+cell_vec(2), & - -outer_cell_vec(3)+cell_vec(3)) + bcell = cell_to_index(-outer_cell_vec(1) + cell_vec(1), & + -outer_cell_vec(2) + cell_vec(2), & + -outer_cell_vec(3) + cell_vec(3)) IF (.NOT. (bcell == j_img)) CYCLE END IF raRI = rab_outer - rbRI = raRI-rab + rbRI = raRI - rab ELSE IF (atom_RI .EQ. iatom_outer .AND. & iatom .EQ. jatom_outer) THEN @@ -2801,7 +2801,7 @@ SUBROUTINE reserve_blocks_3c(mat_3c_overl_int, mat_munu, qs_env, dimen_RI, & END IF raRI = -rab_outer - rbRI = raRI-rab + rbRI = raRI - rab ELSE IF (jatom .EQ. iatom_outer .AND. & atom_RI .EQ. jatom_outer) THEN @@ -2812,7 +2812,7 @@ SUBROUTINE reserve_blocks_3c(mat_3c_overl_int, mat_munu, qs_env, dimen_RI, & END IF rbRI = rab_outer - raRI = rbRI+rab + raRI = rbRI + rab ELSE IF (atom_RI .EQ. iatom_outer .AND. & jatom .EQ. jatom_outer) THEN @@ -2823,7 +2823,7 @@ SUBROUTINE reserve_blocks_3c(mat_3c_overl_int, mat_munu, qs_env, dimen_RI, & END IF rbRI = -rab_outer - raRI = rbRI+rab + raRI = rbRI + rab END IF @@ -2866,12 +2866,12 @@ SUBROUTINE reserve_blocks_3c(mat_3c_overl_int, mat_munu, qs_env, dimen_RI, & DO iset = 1, nseta - IF (set_radius_a(iset)+set_radius_RI(set_RI) < daRI) CYCLE + IF (set_radius_a(iset) + set_radius_RI(set_RI) < daRI) CYCLE DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE - IF (set_radius_b(jset)+set_radius_RI(set_RI) < dbRI) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE + IF (set_radius_b(jset) + set_radius_RI(set_RI) < dbRI) CYCLE nco_RI = npgf_RI(set_RI)*ncoset(l_max_RI(set_RI)) ncoa = npgfa(iset)*ncoset(la_max(iset)) @@ -2881,11 +2881,11 @@ SUBROUTINE reserve_blocks_3c(mat_3c_overl_int, mat_munu, qs_env, dimen_RI, & sgfa = first_sgfa(1, iset) sgfb = first_sgfb(1, jset) - LLL_set_start = 1+sgf_RI-1-my_group_L_start+1+row_blk_start(atom_RI)-1 + LLL_set_start = 1 + sgf_RI - 1 - my_group_L_start + 1 + row_blk_start(atom_RI) - 1 IF (LLL_set_start > my_group_L_size) CYCLE - LLL_set_end = nsgf_RI(set_RI)+sgf_RI-1-my_group_L_start+1+row_blk_start(atom_RI)-1 + LLL_set_end = nsgf_RI(set_RI) + sgf_RI - 1 - my_group_L_start + 1 + row_blk_start(atom_RI) - 1 IF (LLL_set_end < 1) CYCLE @@ -2893,7 +2893,7 @@ SUBROUTINE reserve_blocks_3c(mat_3c_overl_int, mat_munu, qs_env, dimen_RI, & DO isgf_RI = 1, nsgf_RI(set_RI) - LLL = isgf_RI+sgf_RI-1-my_group_L_start+1+row_blk_start(atom_RI)-1 + LLL = isgf_RI + sgf_RI - 1 - my_group_L_start + 1 + row_blk_start(atom_RI) - 1 IF (LLL < 1) CYCLE IF (LLL > my_group_L_size) CYCLE @@ -2965,14 +2965,14 @@ SUBROUTINE reserve_blocks_3c(mat_3c_overl_int, mat_munu, qs_env, dimen_RI, & ALLOCATE (tmp(blk_cnt)) tmp(1:blk_cnt) = rows_to_alloc(i_img_outer, j_img_outer)%array(1:blk_cnt) DEALLOCATE (rows_to_alloc(i_img_outer, j_img_outer)%array) - ALLOCATE (rows_to_alloc(i_img_outer, j_img_outer)%array(blk_cnt+1)) + ALLOCATE (rows_to_alloc(i_img_outer, j_img_outer)%array(blk_cnt + 1)) rows_to_alloc(i_img_outer, j_img_outer)%array(1:blk_cnt) = tmp(1:blk_cnt) - rows_to_alloc(i_img_outer, j_img_outer)%array(blk_cnt+1) = row + rows_to_alloc(i_img_outer, j_img_outer)%array(blk_cnt + 1) = row tmp(1:blk_cnt) = cols_to_alloc(i_img_outer, j_img_outer)%array(1:blk_cnt) DEALLOCATE (cols_to_alloc(i_img_outer, j_img_outer)%array) - ALLOCATE (cols_to_alloc(i_img_outer, j_img_outer)%array(blk_cnt+1)) + ALLOCATE (cols_to_alloc(i_img_outer, j_img_outer)%array(blk_cnt + 1)) cols_to_alloc(i_img_outer, j_img_outer)%array(1:blk_cnt) = tmp(1:blk_cnt) - cols_to_alloc(i_img_outer, j_img_outer)%array(blk_cnt+1) = col + cols_to_alloc(i_img_outer, j_img_outer)%array(blk_cnt + 1) = col DEALLOCATE (tmp) old_row(i_img_outer, j_img_outer) = row @@ -2983,16 +2983,16 @@ SUBROUTINE reserve_blocks_3c(mat_3c_overl_int, mat_munu, qs_env, dimen_RI, & ALLOCATE (tmp(blk_cnt)) tmp(1:blk_cnt) = rows_to_alloc(i_img_outer, j_img_outer)%array(1:blk_cnt) DEALLOCATE (rows_to_alloc(i_img_outer, j_img_outer)%array) - ALLOCATE (rows_to_alloc(i_img_outer, j_img_outer)%array(blk_cnt+2)) + ALLOCATE (rows_to_alloc(i_img_outer, j_img_outer)%array(blk_cnt + 2)) rows_to_alloc(i_img_outer, j_img_outer)%array(1:blk_cnt) = tmp(1:blk_cnt) - rows_to_alloc(i_img_outer, j_img_outer)%array(blk_cnt+1) = row - rows_to_alloc(i_img_outer, j_img_outer)%array(blk_cnt+2) = col + rows_to_alloc(i_img_outer, j_img_outer)%array(blk_cnt + 1) = row + rows_to_alloc(i_img_outer, j_img_outer)%array(blk_cnt + 2) = col tmp(1:blk_cnt) = cols_to_alloc(i_img_outer, j_img_outer)%array(1:blk_cnt) DEALLOCATE (cols_to_alloc(i_img_outer, j_img_outer)%array) - ALLOCATE (cols_to_alloc(i_img_outer, j_img_outer)%array(blk_cnt+2)) + ALLOCATE (cols_to_alloc(i_img_outer, j_img_outer)%array(blk_cnt + 2)) cols_to_alloc(i_img_outer, j_img_outer)%array(1:blk_cnt) = tmp(1:blk_cnt) - cols_to_alloc(i_img_outer, j_img_outer)%array(blk_cnt+1) = col - cols_to_alloc(i_img_outer, j_img_outer)%array(blk_cnt+2) = row + cols_to_alloc(i_img_outer, j_img_outer)%array(blk_cnt + 1) = col + cols_to_alloc(i_img_outer, j_img_outer)%array(blk_cnt + 2) = row DEALLOCATE (tmp) old_row(i_img_outer, j_img_outer) = row @@ -3160,10 +3160,10 @@ SUBROUTINE replicate_mao_coeff(mao_coeff_repl, mao_coeff, local_atoms_for_mao_ba ALLOCATE (mao_coeff_repl(1:natom)) - ALLOCATE (num_entries_atoms_send(0:2*para_env%num_pe-1)) + ALLOCATE (num_entries_atoms_send(0:2*para_env%num_pe - 1)) num_entries_atoms_send(:) = 0 - ALLOCATE (num_entries_atoms_rec(0:2*para_env%num_pe-1)) + ALLOCATE (num_entries_atoms_rec(0:2*para_env%num_pe - 1)) num_entries_atoms_rec(:) = 0 DO iatom = 1, natom @@ -3177,8 +3177,8 @@ SUBROUTINE replicate_mao_coeff(mao_coeff_repl, mao_coeff, local_atoms_for_mao_ba CALL dbcsr_get_stored_coordinates(mao_coeff(1)%matrix, iatom, iatom, imepos) - num_entries_atoms_rec(2*imepos) = num_entries_atoms_rec(2*imepos)+prim_size*mao_size - num_entries_atoms_rec(2*imepos+1) = num_entries_atoms_rec(2*imepos+1)+1 + num_entries_atoms_rec(2*imepos) = num_entries_atoms_rec(2*imepos) + prim_size*mao_size + num_entries_atoms_rec(2*imepos + 1) = num_entries_atoms_rec(2*imepos + 1) + 1 END IF @@ -3190,11 +3190,11 @@ SUBROUTINE replicate_mao_coeff(mao_coeff_repl, mao_coeff, local_atoms_for_mao_ba num_entries_atoms_send(0:1) = num_entries_atoms_rec(0:1) END IF - ALLOCATE (buffer_rec(0:para_env%num_pe-1)) - ALLOCATE (buffer_send(0:para_env%num_pe-1)) + ALLOCATE (buffer_rec(0:para_env%num_pe - 1)) + ALLOCATE (buffer_send(0:para_env%num_pe - 1)) ! allocate data message and corresponding indices - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 ALLOCATE (buffer_rec(imepos)%msg(num_entries_atoms_rec(2*imepos))) buffer_rec(imepos)%msg = 0.0_dp @@ -3202,18 +3202,18 @@ SUBROUTINE replicate_mao_coeff(mao_coeff_repl, mao_coeff, local_atoms_for_mao_ba ALLOCATE (buffer_send(imepos)%msg(num_entries_atoms_send(2*imepos))) buffer_send(imepos)%msg = 0.0_dp - ALLOCATE (buffer_rec(imepos)%indx(num_entries_atoms_rec(2*imepos+1), 6)) + ALLOCATE (buffer_rec(imepos)%indx(num_entries_atoms_rec(2*imepos + 1), 6)) buffer_rec(imepos)%indx = 0 - ALLOCATE (buffer_send(imepos)%indx(num_entries_atoms_send(2*imepos+1), 6)) + ALLOCATE (buffer_send(imepos)%indx(num_entries_atoms_send(2*imepos + 1), 6)) buffer_send(imepos)%indx = 0 END DO - ALLOCATE (entry_counter(0:para_env%num_pe-1)) + ALLOCATE (entry_counter(0:para_env%num_pe - 1)) entry_counter(:) = 0 - ALLOCATE (atom_counter(0:para_env%num_pe-1)) + ALLOCATE (atom_counter(0:para_env%num_pe - 1)) atom_counter = 0 DO iatom = 1, natom @@ -3223,7 +3223,7 @@ SUBROUTINE replicate_mao_coeff(mao_coeff_repl, mao_coeff, local_atoms_for_mao_ba CALL dbcsr_get_stored_coordinates(mao_coeff(1)%matrix, iatom, iatom, imepos) - atom_counter(imepos) = atom_counter(imepos)+1 + atom_counter(imepos) = atom_counter(imepos) + 1 buffer_rec(imepos)%indx(atom_counter(imepos), 1) = iatom @@ -3233,10 +3233,10 @@ SUBROUTINE replicate_mao_coeff(mao_coeff_repl, mao_coeff, local_atoms_for_mao_ba ALLOCATE (req_array(1:para_env%num_pe, 4)) - ALLOCATE (sizes_rec(0:para_env%num_pe-1)) - ALLOCATE (sizes_send(0:para_env%num_pe-1)) + ALLOCATE (sizes_rec(0:para_env%num_pe - 1)) + ALLOCATE (sizes_send(0:para_env%num_pe - 1)) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 sizes_send(imepos) = num_entries_atoms_send(2*imepos) sizes_rec(imepos) = num_entries_atoms_rec(2*imepos) @@ -3258,18 +3258,18 @@ SUBROUTINE replicate_mao_coeff(mao_coeff_repl, mao_coeff, local_atoms_for_mao_ba ! for the mao trafo matrix, only the diagonal blocks should be allocated CPASSERT(row == col) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 IF (ANY(buffer_send(imepos)%indx(:, 1) == row)) THEN block_size = row_size*col_size - start_msg = entry_counter(imepos)+1 - end_msg = entry_counter(imepos)+block_size + start_msg = entry_counter(imepos) + 1 + end_msg = entry_counter(imepos) + block_size buffer_send(imepos)%msg(start_msg:end_msg) = RESHAPE(data_block(1:row_size, 1:col_size), (/block_size/)) - entry_counter(imepos) = entry_counter(imepos)+block_size - atom_counter(imepos) = atom_counter(imepos)+1 + entry_counter(imepos) = entry_counter(imepos) + block_size + atom_counter(imepos) = atom_counter(imepos) + 1 buffer_send(imepos)%indx(atom_counter(imepos), 2) = row buffer_send(imepos)%indx(atom_counter(imepos), 3) = row_size @@ -3291,9 +3291,9 @@ SUBROUTINE replicate_mao_coeff(mao_coeff_repl, mao_coeff, local_atoms_for_mao_ba DEALLOCATE (req_array, sizes_rec, sizes_send) ! fill mao_coeff_repl - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 - num_atom_from_imepos = num_entries_atoms_rec(2*imepos+1) + num_atom_from_imepos = num_entries_atoms_rec(2*imepos + 1) DO atom_rec = 1, num_atom_from_imepos @@ -3312,7 +3312,7 @@ SUBROUTINE replicate_mao_coeff(mao_coeff_repl, mao_coeff, local_atoms_for_mao_ba DEALLOCATE (num_entries_atoms_send, num_entries_atoms_rec, entry_counter, atom_counter) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 DEALLOCATE (buffer_rec(imepos)%msg) DEALLOCATE (buffer_rec(imepos)%indx) DEALLOCATE (buffer_send(imepos)%msg) @@ -3409,14 +3409,14 @@ SUBROUTINE setup_group_L_im_time(my_group_L_starts_im_time, my_group_L_ends_im_t ALLOCATE (my_group_L_ends_im_time(1:cut_memory)) my_group_L_ends_im_time = 0 - DO icut = 0, cut_memory-1 + DO icut = 0, cut_memory - 1 CALL get_group_dist(gd_array_mem_cut, icut, sizes=size_RI, starts=start_RI) itmp = get_limit(size_RI, ngroup, color_sub) - my_group_L_starts_im_time(icut+1) = itmp(1)+start_RI-1 - my_group_L_ends_im_time(icut+1) = itmp(2)+start_RI-1 + my_group_L_starts_im_time(icut + 1) = itmp(1) + start_RI - 1 + my_group_L_ends_im_time(icut + 1) = itmp(2) + start_RI - 1 END DO @@ -3444,12 +3444,12 @@ SUBROUTINE setup_group_L_im_time(my_group_L_starts_im_time, my_group_L_ends_im_t row_blk_offset_RI(1) = 1 DO iblk_RI = 2, nblks_RI - row_blk_offset_RI(iblk_RI) = row_blk_offset_RI(iblk_RI-1)+row_blk_sizes_RI(iblk_RI-1) + row_blk_offset_RI(iblk_RI) = row_blk_offset_RI(iblk_RI - 1) + row_blk_sizes_RI(iblk_RI - 1) END DO row_blk_end_RI(nblks_RI) = dimen_RI - DO iblk_RI = 1, nblks_RI-1 - row_blk_end_RI(iblk_RI) = row_blk_offset_RI(iblk_RI+1)-1 + DO iblk_RI = 1, nblks_RI - 1 + row_blk_end_RI(iblk_RI) = row_blk_offset_RI(iblk_RI + 1) - 1 END DO cut_RI = cut_memory @@ -3467,10 +3467,10 @@ SUBROUTINE setup_group_L_im_time(my_group_L_starts_im_time, my_group_L_ends_im_t row_blk_offset_RI(iblk_RI) <= my_group_L_ends_im_time(icut) .AND. & row_blk_end_RI(iblk_RI) < my_group_L_ends_im_time(icut)) THEN - cut_RI = cut_RI+1 + cut_RI = cut_RI + 1 - ALLOCATE (my_group_L_starts_im_time_tmp(cut_RI-1)) - ALLOCATE (my_group_L_ends_im_time_tmp(cut_RI-1)) + ALLOCATE (my_group_L_starts_im_time_tmp(cut_RI - 1)) + ALLOCATE (my_group_L_ends_im_time_tmp(cut_RI - 1)) my_group_L_starts_im_time_tmp(:) = my_group_L_starts_im_time(:) my_group_L_ends_im_time_tmp(:) = my_group_L_ends_im_time(:) @@ -3482,16 +3482,16 @@ SUBROUTINE setup_group_L_im_time(my_group_L_starts_im_time, my_group_L_ends_im_t ALLOCATE (my_group_L_ends_im_time(cut_RI)) my_group_L_starts_im_time(1:icut) = my_group_L_starts_im_time_tmp(1:icut) - my_group_L_starts_im_time(icut+1) = row_blk_offset_RI(iblk_RI+1) - IF (cut_RI >= icut+2) THEN - my_group_L_starts_im_time(icut+2:cut_RI) = my_group_L_starts_im_time_tmp(icut+1:cut_RI-1) + my_group_L_starts_im_time(icut + 1) = row_blk_offset_RI(iblk_RI + 1) + IF (cut_RI >= icut + 2) THEN + my_group_L_starts_im_time(icut + 2:cut_RI) = my_group_L_starts_im_time_tmp(icut + 1:cut_RI - 1) END IF - IF (icut-1 >= 1) THEN - my_group_L_ends_im_time(1:icut-1) = my_group_L_ends_im_time_tmp(1:icut-1) + IF (icut - 1 >= 1) THEN + my_group_L_ends_im_time(1:icut - 1) = my_group_L_ends_im_time_tmp(1:icut - 1) END IF - my_group_L_ends_im_time(icut) = row_blk_offset_RI(iblk_RI+1)-1 - my_group_L_ends_im_time(icut+1:cut_RI) = my_group_L_ends_im_time_tmp(icut:cut_RI-1) + my_group_L_ends_im_time(icut) = row_blk_offset_RI(iblk_RI + 1) - 1 + my_group_L_ends_im_time(icut + 1:cut_RI) = my_group_L_ends_im_time_tmp(icut:cut_RI - 1) DEALLOCATE (my_group_L_starts_im_time_tmp) DEALLOCATE (my_group_L_ends_im_time_tmp) @@ -3505,7 +3505,7 @@ SUBROUTINE setup_group_L_im_time(my_group_L_starts_im_time, my_group_L_ends_im_t END DO ALLOCATE (my_group_L_sizes_im_time(cut_RI)) - my_group_L_sizes_im_time(:) = my_group_L_ends_im_time(:)-my_group_L_starts_im_time(:)+1 + my_group_L_sizes_im_time(:) = my_group_L_ends_im_time(:) - my_group_L_starts_im_time(:) + 1 ALLOCATE (qs_env%mp2_env%ri_rpa_im_time_util(cut_memory)) diff --git a/src/mp2_laplace.F b/src/mp2_laplace.F index 2a79e80fd2..bbd4cc5326 100644 --- a/src/mp2_laplace.F +++ b/src/mp2_laplace.F @@ -64,10 +64,10 @@ SUBROUTINE calc_fm_mat_S_laplace(fm_mat_S, first_cycle, homo, virtual, Eigenval, DO iiB = 1, nrow_local i_global = row_indices(iiB) - iocc = MAX(1, i_global-1)/virtual+1 - avirt = i_global-(iocc-1)*virtual + iocc = MAX(1, i_global - 1)/virtual + 1 + avirt = i_global - (iocc - 1)*virtual - laplace_transf = EXP(Eigenval(iocc)*ajquad)*EXP(-Eigenval(avirt+homo)*ajquad) + laplace_transf = EXP(Eigenval(iocc)*ajquad)*EXP(-Eigenval(avirt + homo)*ajquad) laplace_transf = SQRT(laplace_transf) fm_mat_S%local_data(iiB, jjB) = fm_mat_S%local_data(iiB, jjB)*laplace_transf @@ -79,10 +79,10 @@ SUBROUTINE calc_fm_mat_S_laplace(fm_mat_S, first_cycle, homo, virtual, Eigenval, DO iiB = 1, nrow_local i_global = row_indices(iiB) - iocc = MAX(1, i_global-1)/virtual+1 - avirt = i_global-(iocc-1)*virtual + iocc = MAX(1, i_global - 1)/virtual + 1 + avirt = i_global - (iocc - 1)*virtual - laplace_transf = EXP(Eigenval(iocc)*(ajquad-alpha_old))*EXP(-Eigenval(avirt+homo)*(ajquad-alpha_old)) + laplace_transf = EXP(Eigenval(iocc)*(ajquad - alpha_old))*EXP(-Eigenval(avirt + homo)*(ajquad - alpha_old)) laplace_transf = SQRT(laplace_transf) fm_mat_S%local_data(iiB, jjB) = fm_mat_S%local_data(iiB, jjB)*laplace_transf @@ -128,14 +128,14 @@ SUBROUTINE SOS_MP2_postprocessing(fm_mat_Q, Erpa, tau_wjquad, fm_mat_Q_beta) trace_XX = 0.0_dp IF (my_open_shell) THEN DO jjB = 1, ncol_local - trace_XX = trace_XX+DOT_PRODUCT(fm_mat_Q%local_data(:, jjB), fm_mat_Q_beta%local_data(:, jjB)) + trace_XX = trace_XX + DOT_PRODUCT(fm_mat_Q%local_data(:, jjB), fm_mat_Q_beta%local_data(:, jjB)) END DO ELSE trace_XX = NORM2(fm_mat_Q%local_data) trace_XX = trace_XX*trace_XX END IF - Erpa = Erpa-trace_XX*tau_wjquad + Erpa = Erpa - trace_XX*tau_wjquad CALL timestop(handle) diff --git a/src/mp2_optimize_ri_basis.F b/src/mp2_optimize_ri_basis.F index b99b8914e9..6bd75c8b2f 100644 --- a/src/mp2_optimize_ri_basis.F +++ b/src/mp2_optimize_ri_basis.F @@ -142,7 +142,7 @@ SUBROUTINE optimize_ri_basis_main(Emp2, Emp2_Cou, Emp2_ex, Emp2_S, Emp2_T, dimen open_shell_case = .FALSE. IF (PRESENT(homo_beta) .AND. PRESENT(C_beta) .AND. PRESENT(Auto_beta)) open_shell_case = .TRUE. - virtual = dimen-homo + virtual = dimen - homo eps_DRI = mp2_env%ri_opt_param%DRI eps_DI_rel = mp2_env%ri_opt_param%DI_rel @@ -157,7 +157,7 @@ SUBROUTINE optimize_ri_basis_main(Emp2, Emp2_Cou, Emp2_ex, Emp2_S, Emp2_T, dimen Emp2_T = 0.0_dp IF (open_shell_case) THEN ! open shell case - virtual_beta = dimen-homo_beta + virtual_beta = dimen - homo_beta ! alpha-aplha case Emp2_AA = 0.0_dp @@ -201,12 +201,12 @@ SUBROUTINE optimize_ri_basis_main(Emp2, Emp2_Cou, Emp2_ex, Emp2_S, Emp2_T, dimen CALL mp_sum(Emp2_AB, para_env%group) DEALLOCATE (ij_list_proc) - Emp2 = Emp2_AA+Emp2_BB+Emp2_AB*2.0_dp !+Emp2_BA - Emp2_Cou = Emp2_AA_Cou+Emp2_BB_Cou+Emp2_AB_Cou*2.0_dp !+Emp2_BA - Emp2_ex = Emp2_AA_ex+Emp2_BB_ex+Emp2_AB_ex*2.0_dp !+Emp2_BA + Emp2 = Emp2_AA + Emp2_BB + Emp2_AB*2.0_dp !+Emp2_BA + Emp2_Cou = Emp2_AA_Cou + Emp2_BB_Cou + Emp2_AB_Cou*2.0_dp !+Emp2_BA + Emp2_ex = Emp2_AA_ex + Emp2_BB_ex + Emp2_AB_ex*2.0_dp !+Emp2_BA Emp2_S = Emp2_AB*2.0_dp - Emp2_T = Emp2_AA+Emp2_BB + Emp2_T = Emp2_AA + Emp2_BB ! Replicate the MO-ERI's over all processes CALL mp_sum(Integ_MP2_AA, para_env%group) @@ -258,7 +258,7 @@ SUBROUTINE optimize_ri_basis_main(Emp2, Emp2_Cou, Emp2_ex, Emp2_S, Emp2_T, dimen max_l_am = 0 DO ikind = 1, nkind DO iset = 1, RI_basis_parameter(ikind)%nset - ndof = ndof+1 + ndof = ndof + 1 max_l_am = MAX(max_l_am, MAXVAL(RI_basis_parameter(ikind)%lmax)) END DO END DO @@ -348,7 +348,7 @@ SUBROUTINE optimize_ri_basis_main(Emp2, Emp2_Cou, Emp2_ex, Emp2_S, Emp2_T, dimen IF (unit_nr > 0) WRITE (unit_nr, '(T3,A,I5)') 'OPTIMIZATION STEP NUMBER', iiter ! perform step - pnew(:) = p+xi + pnew(:) = p + xi CALL p2basis(nkind, RI_basis_parameter, lower_B, max_dev, pnew) ! check if we have to reset boundaries @@ -357,7 +357,7 @@ SUBROUTINE optimize_ri_basis_main(Emp2, Emp2_Cou, Emp2_ex, Emp2_S, Emp2_T, dimen i = 0 DO ikind = 1, nkind DO iset = 1, RI_basis_parameter(ikind)%nset - i = i+1 + i = i + 1 CALL transf_val(lower_B(i), max_dev(i), pnew(i), expon) IF (ABS(pnew(i)) > reset_edge .OR. expon < exp_limits(1, ikind) .OR. expon > exp_limits(2, ikind)) THEN reset_boundary = .TRUE. @@ -403,7 +403,7 @@ SUBROUTINE optimize_ri_basis_main(Emp2, Emp2_Cou, Emp2_ex, Emp2_S, Emp2_T, dimen g(:) = deriv xi(:) = -g - pnew(:) = p+xi + pnew(:) = p + xi CALL p2basis(nkind, RI_basis_parameter, lower_B, max_dev, pnew) END IF @@ -418,7 +418,7 @@ SUBROUTINE optimize_ri_basis_main(Emp2, Emp2_Cou, Emp2_ex, Emp2_S, Emp2_T, dimen ! update energy and direction DI = DI_new - xi(:) = pnew-p + xi(:) = pnew - p p(:) = pnew ! check for convergence @@ -463,7 +463,7 @@ SUBROUTINE optimize_ri_basis_main(Emp2, Emp2_Cou, Emp2_ex, Emp2_S, Emp2_T, dimen deriv) ! g is the vector containing the old gradient - dg(:) = deriv-g + dg(:) = deriv - g g(:) = deriv hdg(:) = MATMUL(hessin, dg) @@ -476,12 +476,12 @@ SUBROUTINE optimize_ri_basis_main(Emp2, Emp2_Cou, Emp2_ex, Emp2_S, Emp2_T, dimen IF (fac**2 > sumdg*sumxi*3.0E-8_dp) THEN fac = 1.0_dp/fac fad = 1.0_dp/fae - dg(:) = fac*xi-fad*hdg + dg(:) = fac*xi - fad*hdg DO i = 1, ndof DO j = 1, ndof - hessin(i, j) = hessin(i, j)+fac*xi(i)*xi(j) & - -fad*hdg(i)*hdg(j) & - +fae*dg(i)*dg(j) + hessin(i, j) = hessin(i, j) + fac*xi(i)*xi(j) & + - fad*hdg(i)*hdg(j) & + + fae*dg(i)*dg(j) END DO END DO ELSE @@ -638,7 +638,7 @@ SUBROUTINE calc_energy_func_der(Emp2, Emp2_AA, Emp2_BB, Emp2_AB, DI_ref, & nseta = RI_basis_parameter(ikind)%nset DO iset = 1, nseta ! for now only uncontracted aux basis set - ideriv = ideriv+1 + ideriv = ideriv + 1 IF (MOD(ideriv, number_groups) /= color_sub) CYCLE ! ! calculate the numerical derivative @@ -654,7 +654,7 @@ SUBROUTINE calc_energy_func_der(Emp2, Emp2_AA, Emp2_BB, Emp2_AB, DI_ref, & CPASSERT(RI_basis_parameter(ikind)%npgf(iset) == 1) orig_basis_val = RI_basis_parameter(ikind)%zet(1, iset) - temp = p(ideriv)+step + temp = p(ideriv) + step CALL transf_val(lower_B(ideriv), max_dev(ideriv), temp, new_basis_val) RI_basis_parameter(ikind)%zet(1, iset) = new_basis_val @@ -790,9 +790,9 @@ SUBROUTINE calc_energy_func(Emp2, Emp2_AA, Emp2_BB, Emp2_AB, Emp2_RI, DRI, DI, & Auto, Auto_beta, Integ_MP2_AB, & Lai, Lai_beta, para_env) - Emp2_RI = Emp2_RI_AA+Emp2_RI_BB+Emp2_RI_AB - DRI = DRI_AA+DRI_BB+DRI_AB - DI = DI_AA+DI_BB+DI_AB + Emp2_RI = Emp2_RI_AA + Emp2_RI_BB + Emp2_RI_AB + DRI = DRI_AA + DRI_BB + DRI_AB + DI = DI_AA + DI_BB + DI_AB ELSE CALL contract_integrals(DI, Emp2_RI, DRI, Emp2, homo, homo, virtual, virtual, & 2.0_dp, 1.0_dp, .TRUE., & @@ -834,8 +834,8 @@ SUBROUTINE init_transf(nkind, RI_basis_parameter, lower_B, max_dev, max_rel_dev) ipos = 0 DO ikind = 1, nkind DO iset = 1, RI_basis_parameter(ikind)%nset - ipos = ipos+1 - lower_B(ipos) = RI_basis_parameter(ikind)%zet(1, iset)*(1.0_dp-max_rel_dev(ipos)) + ipos = ipos + 1 + lower_B(ipos) = RI_basis_parameter(ikind)%zet(1, iset)*(1.0_dp - max_rel_dev(ipos)) max_dev(ipos) = RI_basis_parameter(ikind)%zet(1, iset)*2.0_dp*max_rel_dev(ipos) END DO END DO @@ -861,7 +861,7 @@ SUBROUTINE p2basis(nkind, RI_basis_parameter, Lower_B, max_dev, p) ipos = 0 DO ikind = 1, nkind DO iset = 1, RI_basis_parameter(ikind)%nset - ipos = ipos+1 + ipos = ipos + 1 CALL transf_val(lower_B(ipos), max_dev(ipos), p(ipos), valout) RI_basis_parameter(ikind)%zet(1, iset) = valout END DO @@ -911,7 +911,7 @@ SUBROUTINE reset_basis(nkind, ndof, RI_basis_parameter, reset_edge, & ipos = 0 DO ikind = 1, nkind DO iset = 1, RI_basis_parameter(ikind)%nset - ipos = ipos+1 + ipos = ipos + 1 old_expo(ipos) = RI_basis_parameter(ikind)%zet(1, iset) END DO END DO @@ -937,7 +937,7 @@ SUBROUTINE reset_basis(nkind, ndof, RI_basis_parameter, reset_edge, & DO iset = 1, RI_basis_parameter(ikind)%nset la = RI_basis_parameter(ikind)%lmax(iset) expo = RI_basis_parameter(ikind)%zet(1, iset) - nf_per_l(la) = nf_per_l(la)+1 + nf_per_l(la) = nf_per_l(la) + 1 IF (expo <= max_min_exp_per_l(1, la)) max_min_exp_per_l(1, la) = expo IF (expo >= max_min_exp_per_l(2, la)) max_min_exp_per_l(2, la) = expo END DO @@ -956,7 +956,7 @@ SUBROUTINE reset_basis(nkind, ndof, RI_basis_parameter, reset_edge, & DO la = 0, am_max pmax = -HUGE(0) DO iexpo = 1, nf_per_l(la) - ipos_p = ipos_p+1 + ipos_p = ipos_p + 1 IF (ABS(old_pnew(ipos_p)) >= pmax) pmax = ABS(old_pnew(ipos_p)) ! check if any of the exponents go out of range CALL transf_val(old_lower_B(ipos_p), old_max_dev(ipos_p), old_pnew(ipos_p), expo) @@ -967,14 +967,14 @@ SUBROUTINE reset_basis(nkind, ndof, RI_basis_parameter, reset_edge, & DO la = 0, am_max IF (nf_per_l(la) == 1) THEN - ipos = ipos+1 + ipos = ipos + 1 new_expo(ipos) = max_min_exp_per_l(1, la) IF (new_expo(ipos) >= exp_limits(1, ikind) .AND. new_expo(ipos) <= exp_limits(2, ikind)) THEN - max_rel_dev(ipos) = (new_expo(ipos)-old_lower_B(ipos))/new_expo(ipos) + max_rel_dev(ipos) = (new_expo(ipos) - old_lower_B(ipos))/new_expo(ipos) IF (max_rel_dev(ipos) <= 0.1_dp) max_rel_dev(ipos) = 0.8_dp ELSE - new_expo(ipos) = (exp_limits(2, ikind)+exp_limits(1, ikind))/2.0_dp - max_rel_dev(ipos) = (new_expo(ipos)-exp_limits(1, ikind))/new_expo(ipos) + new_expo(ipos) = (exp_limits(2, ikind) + exp_limits(1, ikind))/2.0_dp + max_rel_dev(ipos) = (new_expo(ipos) - exp_limits(1, ikind))/new_expo(ipos) END IF IF (has_to_be_changed(la)) change_expo(ipos) = 1 ELSE @@ -982,11 +982,11 @@ SUBROUTINE reset_basis(nkind, ndof, RI_basis_parameter, reset_edge, & max_min_exp_per_l(1, la) = max_min_exp_per_l(1, la)*0.5 max_min_exp_per_l(2, la) = max_min_exp_per_l(2, la)*1.5 END IF - geom_fact = (max_min_exp_per_l(2, la)/max_min_exp_per_l(1, la))**(1.0_dp/REAL(nf_per_l(la)-1, dp)) + geom_fact = (max_min_exp_per_l(2, la)/max_min_exp_per_l(1, la))**(1.0_dp/REAL(nf_per_l(la) - 1, dp)) DO iexpo = 1, nf_per_l(la) - ipos = ipos+1 - new_expo(ipos) = max_min_exp_per_l(1, la)*(geom_fact**(iexpo-1)) - max_rel_dev(ipos) = (geom_fact-1.0_dp)/(geom_fact+1.0_dp)*0.9_dp + ipos = ipos + 1 + new_expo(ipos) = max_min_exp_per_l(1, la)*(geom_fact**(iexpo - 1)) + max_rel_dev(ipos) = (geom_fact - 1.0_dp)/(geom_fact + 1.0_dp)*0.9_dp IF (has_to_be_changed(la)) change_expo(ipos) = 1 END DO END IF @@ -1001,7 +1001,7 @@ SUBROUTINE reset_basis(nkind, ndof, RI_basis_parameter, reset_edge, & ipos = 0 DO ikind = 1, nkind DO iset = 1, RI_basis_parameter(ikind)%nset - ipos = ipos+1 + ipos = ipos + 1 RI_basis_parameter(ikind)%zet(1, iset) = new_expo(ipos) END DO END DO @@ -1011,7 +1011,7 @@ SUBROUTINE reset_basis(nkind, ndof, RI_basis_parameter, reset_edge, & ipos = 0 DO ikind = 1, nkind DO iset = 1, RI_basis_parameter(ikind)%nset - ipos = ipos+1 + ipos = ipos + 1 IF (change_expo(ipos) == 0) THEN ! restore original pnew(ipos) = old_pnew(ipos) @@ -1072,25 +1072,25 @@ SUBROUTINE contract_integrals(DI, Emp2_RI, DRI, Emp2, homo, homo_beta, virtual, ij_counter = 0 DO j = 1, homo_beta DO i = 1, homo - ij_counter = ij_counter+1 + ij_counter = ij_counter + 1 IF (MOD(ij_counter, para_env%num_pe) /= para_env%mepos) CYCLE mat_ab = 0.0_dp mat_ab(:, :) = MATMUL(TRANSPOSE(Lai(:, :, i)), Lai_beta(:, :, j)) DO b = 1, virtual_beta DO a = 1, virtual IF (calc_ex) THEN - t_iajb = fact*abij(a, b, i, j)-abij(b, a, i, j) - t_iajb_RI = fact*mat_ab(a, b)-mat_ab(b, a) + t_iajb = fact*abij(a, b, i, j) - abij(b, a, i, j) + t_iajb_RI = fact*mat_ab(a, b) - mat_ab(b, a) ELSE t_iajb = fact*abij(a, b, i, j) t_iajb_RI = fact*mat_ab(a, b) END IF - t_iajb = t_iajb/(MOenerg(a+homo)+MOenerg_beta(b+homo_beta)-MOenerg(i)-MOenerg_beta(j)) - t_iajb_RI = t_iajb_RI/(MOenerg(a+homo)+MOenerg_beta(b+homo_beta)-MOenerg(i)-MOenerg_beta(j)) + t_iajb = t_iajb/(MOenerg(a + homo) + MOenerg_beta(b + homo_beta) - MOenerg(i) - MOenerg_beta(j)) + t_iajb_RI = t_iajb_RI/(MOenerg(a + homo) + MOenerg_beta(b + homo_beta) - MOenerg(i) - MOenerg_beta(j)) - Emp2_RI = Emp2_RI-t_iajb_RI*mat_ab(a, b)*fact2 + Emp2_RI = Emp2_RI - t_iajb_RI*mat_ab(a, b)*fact2 - DI = DI-t_iajb*mat_ab(a, b)*fact2 + DI = DI - t_iajb*mat_ab(a, b)*fact2 END DO END DO @@ -1099,8 +1099,8 @@ SUBROUTINE contract_integrals(DI, Emp2_RI, DRI, Emp2, homo, homo_beta, virtual, CALL mp_sum(DI, para_env%group) CALL mp_sum(Emp2_RI, para_env%group) - DRI = Emp2-Emp2_RI - DI = 2.0D+00*DI-Emp2-Emp2_RI + DRI = Emp2 - Emp2_RI + DI = 2.0D+00*DI - Emp2 - Emp2_RI DEALLOCATE (mat_ab) @@ -1129,8 +1129,8 @@ SUBROUTINE calc_elem_ij_proc(homo, homo_beta, para_env, elements_ij_proc, ij_lis ij_counter = -1 DO i = 1, homo DO j = 1, homo_beta - ij_counter = ij_counter+1 - IF (MOD(ij_counter, para_env%num_pe) == para_env%mepos) elements_ij_proc = elements_ij_proc+1 + ij_counter = ij_counter + 1 + IF (MOD(ij_counter, para_env%num_pe) == para_env%mepos) elements_ij_proc = elements_ij_proc + 1 END DO END DO @@ -1140,9 +1140,9 @@ SUBROUTINE calc_elem_ij_proc(homo, homo_beta, para_env, elements_ij_proc, ij_lis elements_ij_proc = 0 DO i = 1, homo DO j = 1, homo_beta - ij_counter = ij_counter+1 + ij_counter = ij_counter + 1 IF (MOD(ij_counter, para_env%num_pe) == para_env%mepos) THEN - elements_ij_proc = elements_ij_proc+1 + elements_ij_proc = elements_ij_proc + 1 ij_list_proc(elements_ij_proc, 1) = i ij_list_proc(elements_ij_proc, 2) = j END IF @@ -1164,7 +1164,7 @@ SUBROUTINE transf_val(lower_B, max_dev, valin, valout) REAL(KIND=dp), PARAMETER :: alpha = 2.633915794_dp valout = 0.0_dp - valout = lower_B+max_dev/(1.0_dp+EXP(-alpha*valin)) + valout = lower_B + max_dev/(1.0_dp + EXP(-alpha*valin)) END SUBROUTINE @@ -1252,8 +1252,8 @@ SUBROUTINE generate_RI_init_basis(qs_env, mp2_env, nkind, max_rel_dev_output, ba RI_nset = 0 DO iset = 1, nseta DO la = la_min(iset), la_max(iset) - RI_nset = RI_nset+1 - RI_num_sgf_per_l(la) = RI_num_sgf_per_l(la)+1 + RI_nset = RI_nset + 1 + RI_num_sgf_per_l(la) = RI_num_sgf_per_l(la) + 1 IF (npgfa(iset) > 1) THEN CALL cp_warn(__LOCATION__, & "The RI basis set optimizer can not handle contracted Gaussian. "// & @@ -1269,7 +1269,7 @@ SUBROUTINE generate_RI_init_basis(qs_env, mp2_env, nkind, max_rel_dev_output, ba DO iset = 1, nseta DO la = la_min(iset), la_max(iset) IF (la /= iii) CYCLE - iexpo = iexpo+1 + iexpo = iexpo + 1 exp_tab(iexpo, iii) = zet(1, iset) END DO END DO @@ -1291,7 +1291,7 @@ SUBROUTINE generate_RI_init_basis(qs_env, mp2_env, nkind, max_rel_dev_output, ba iset = 0 DO iii = 0, RI_max_am DO iexpo = 1, RI_num_sgf_per_l(iii) - iset = iset+1 + iset = iset + 1 RI_l_expo(iset) = iii RI_exponents(iset) = exp_tab(iexpo, iii) END DO @@ -1303,16 +1303,16 @@ SUBROUTINE generate_RI_init_basis(qs_env, mp2_env, nkind, max_rel_dev_output, ba iset = 0 DO iii = 0, RI_max_am IF (RI_num_sgf_per_l(iii) == 1) THEN - iset = iset+1 + iset = iset + 1 max_rel_dev(iset) = 0.35_dp ELSE - iset = iset+1 - max_rel_dev(iset) = (RI_exponents(iset+1)+RI_exponents(iset))/2.0_dp - max_rel_dev(iset) = max_rel_dev(iset)/RI_exponents(iset)-1.0_dp + iset = iset + 1 + max_rel_dev(iset) = (RI_exponents(iset + 1) + RI_exponents(iset))/2.0_dp + max_rel_dev(iset) = max_rel_dev(iset)/RI_exponents(iset) - 1.0_dp DO iexpo = 2, RI_num_sgf_per_l(iii) - iset = iset+1 - max_rel_dev(iset) = (RI_exponents(iset)+RI_exponents(iset-1))/2.0_dp - max_rel_dev(iset) = 1.0_dp-max_rel_dev(iset)/RI_exponents(iset) + iset = iset + 1 + max_rel_dev(iset) = (RI_exponents(iset) + RI_exponents(iset - 1))/2.0_dp + max_rel_dev(iset) = 1.0_dp - max_rel_dev(iset)/RI_exponents(iset) END DO END IF END DO @@ -1345,10 +1345,10 @@ SUBROUTINE generate_RI_init_basis(qs_env, mp2_env, nkind, max_rel_dev_output, ba DO ishell = 1, nshell(iset) DO la = la_min(iset), la_max(iset) IF (ishell > 1) THEN - IF (nl(ishell, iset) == nl(ishell-1, iset)) CYCLE + IF (nl(ishell, iset) == nl(ishell - 1, iset)) CYCLE END IF IF (la /= nl(ishell, iset)) CYCLE - nexpo_shell = nexpo_shell+npgfa(iset) + nexpo_shell = nexpo_shell + npgfa(iset) END DO END DO END DO @@ -1364,15 +1364,15 @@ SUBROUTINE generate_RI_init_basis(qs_env, mp2_env, nkind, max_rel_dev_output, ba DO ishell = 1, nshell(iset) DO la = la_min(iset), la_max(iset) IF (ishell > 1) THEN - IF (nl(ishell, iset) == nl(ishell-1, iset)) CYCLE + IF (nl(ishell, iset) == nl(ishell - 1, iset)) CYCLE END IF IF (la /= nl(ishell, iset)) CYCLE DO ipgf = 1, npgfa(iset) - iexpo = iexpo+1 + iexpo = iexpo + 1 exponents(iexpo) = zet(ipgf, iset) l_expo(iexpo) = la END DO - num_sgf_per_l(la) = num_sgf_per_l(la)+1 + num_sgf_per_l(la) = num_sgf_per_l(la) + 1 END DO END DO END DO @@ -1385,11 +1385,11 @@ SUBROUTINE generate_RI_init_basis(qs_env, mp2_env, nkind, max_rel_dev_output, ba tot_num_exp_per_l = 0 DO iexpo = 1, nexpo_shell DO jexpo = iexpo, nexpo_shell - exp_tab(jexpo, iexpo) = exponents(jexpo)+exponents(iexpo) + exp_tab(jexpo, iexpo) = exponents(jexpo) + exponents(iexpo) exp_tab(iexpo, jexpo) = exp_tab(jexpo, iexpo) - l_tab(jexpo, iexpo) = l_expo(jexpo)+l_expo(iexpo) + l_tab(jexpo, iexpo) = l_expo(jexpo) + l_expo(iexpo) l_tab(iexpo, jexpo) = l_tab(jexpo, iexpo) - tot_num_exp_per_l(l_tab(jexpo, iexpo)) = tot_num_exp_per_l(l_tab(jexpo, iexpo))+1 + tot_num_exp_per_l(l_tab(jexpo, iexpo)) = tot_num_exp_per_l(l_tab(jexpo, iexpo)) + 1 END DO END DO DEALLOCATE (l_expo) @@ -1438,7 +1438,7 @@ SUBROUTINE generate_RI_init_basis(qs_env, mp2_env, nkind, max_rel_dev_output, ba IF (external_num_of_func) THEN ! cp2k can not exceed angular momentum 7 - RI_max_am = MIN(SIZE(mp2_env%ri_opt_param%RI_nset_per_l)-1, 7) + RI_max_am = MIN(SIZE(mp2_env%ri_opt_param%RI_nset_per_l) - 1, 7) IF (RI_max_am > max_am*2) THEN DEALLOCATE (RI_num_sgf_per_l) ALLOCATE (RI_num_sgf_per_l(0:RI_max_am)) @@ -1448,16 +1448,16 @@ SUBROUTINE generate_RI_init_basis(qs_env, mp2_env, nkind, max_rel_dev_output, ba RI_num_sgf_per_l(la) = mp2_env%ri_opt_param%RI_nset_per_l(la) END DO ELSE - RI_num_sgf_per_l(0) = num_sgf_per_l(0)*2+prog_func + RI_num_sgf_per_l(0) = num_sgf_per_l(0)*2 + prog_func DO la = 1, max_am - RI_num_sgf_per_l(la) = RI_num_sgf_per_l(la-1)-1 + RI_num_sgf_per_l(la) = RI_num_sgf_per_l(la - 1) - 1 IF (RI_num_sgf_per_l(la) == 0) THEN RI_num_sgf_per_l(la) = 1 EXIT END IF END DO - DO la = max_am+1, max_am*2 - RI_num_sgf_per_l(la) = RI_num_sgf_per_l(la-1)-prog_l + DO la = max_am + 1, max_am*2 + RI_num_sgf_per_l(la) = RI_num_sgf_per_l(la - 1) - prog_l IF (RI_num_sgf_per_l(la) == 0) THEN RI_num_sgf_per_l(la) = 1 END IF @@ -1466,7 +1466,7 @@ SUBROUTINE generate_RI_init_basis(qs_env, mp2_env, nkind, max_rel_dev_output, ba RI_max_am = MIN(max_am*2, 7) DO la = 0, MIN(max_am*2, 7) IF (RI_num_sgf_per_l(la) == 0) THEN - RI_max_am = la-1 + RI_max_am = la - 1 EXIT END IF END DO @@ -1479,11 +1479,11 @@ SUBROUTINE generate_RI_init_basis(qs_env, mp2_env, nkind, max_rel_dev_output, ba iii = tot_num_exp_per_l(la) jjj = la END IF - nsgfa_RI = nsgfa_RI+RI_num_sgf_per_l(la)*(la*2+1) + nsgfa_RI = nsgfa_RI + RI_num_sgf_per_l(la)*(la*2 + 1) END DO DEALLOCATE (tot_num_exp_per_l) IF (REAL(nsgfa_RI, KIND=dp)/REAL(nsgfa, KIND=dp) <= 2.5_dp) THEN - RI_num_sgf_per_l(jjj) = RI_num_sgf_per_l(jjj)+1 + RI_num_sgf_per_l(jjj) = RI_num_sgf_per_l(jjj) + 1 END IF END IF @@ -1501,19 +1501,19 @@ SUBROUTINE generate_RI_init_basis(qs_env, mp2_env, nkind, max_rel_dev_output, ba iset = 0 DO la = 0, RI_max_am IF (RI_num_sgf_per_l(la) == 1) THEN - iset = iset+1 - RI_exponents(iset) = (max_min_exp_l(2, la)+max_min_exp_l(1, la))/2.0_dp + iset = iset + 1 + RI_exponents(iset) = (max_min_exp_l(2, la) + max_min_exp_l(1, la))/2.0_dp RI_l_expo(iset) = la geom_fact = max_min_exp_l(2, la)/max_min_exp_l(1, la) - max_rel_dev(iset) = (geom_fact-1.0_dp)/(geom_fact+1.0_dp)*0.9_dp + max_rel_dev(iset) = (geom_fact - 1.0_dp)/(geom_fact + 1.0_dp)*0.9_dp ELSE - geom_fact = (max_min_exp_l(2, la)/max_min_exp_l(1, la))**(1.0_dp/REAL(RI_num_sgf_per_l(la)-1, dp)) + geom_fact = (max_min_exp_l(2, la)/max_min_exp_l(1, la))**(1.0_dp/REAL(RI_num_sgf_per_l(la) - 1, dp)) DO iexpo = 1, RI_num_sgf_per_l(la) - iset = iset+1 - RI_exponents(iset) = max_min_exp_l(1, la)*(geom_fact**(iexpo-1)) + iset = iset + 1 + RI_exponents(iset) = max_min_exp_l(1, la)*(geom_fact**(iexpo - 1)) RI_l_expo(iset) = la - max_rel_dev(iset) = (geom_fact-1.0_dp)/(geom_fact+1.0_dp)*0.9_dp + max_rel_dev(iset) = (geom_fact - 1.0_dp)/(geom_fact + 1.0_dp)*0.9_dp END DO END IF END DO @@ -1542,9 +1542,9 @@ SUBROUTINE generate_RI_init_basis(qs_env, mp2_env, nkind, max_rel_dev_output, ba max_rel_dev_prev(:) = max_rel_dev_output DEALLOCATE (max_rel_dev_output) ! reallocate and copy - ALLOCATE (max_rel_dev_output(RI_prev_size+RI_nset)) + ALLOCATE (max_rel_dev_output(RI_prev_size + RI_nset)) max_rel_dev_output(1:RI_prev_size) = max_rel_dev_prev - max_rel_dev_output(RI_prev_size+1:RI_prev_size+RI_nset) = max_rel_dev + max_rel_dev_output(RI_prev_size + 1:RI_prev_size + RI_nset) = max_rel_dev DEALLOCATE (max_rel_dev_prev) END IF DEALLOCATE (max_rel_dev) @@ -1649,9 +1649,9 @@ SUBROUTINE create_ri_basis(gto_basis_set, RI_nset, RI_l_expo, RI_exponents) END IF nshell(iset) = 0 DO lshell = lmin(iset), lmax(iset) - nmin = n(1, iset)+lshell-lmin(iset) + nmin = n(1, iset) + lshell - lmin(iset) ishell = 1 - nshell(iset) = nshell(iset)+ishell + nshell(iset) = nshell(iset) + ishell IF (nshell(iset) > maxshell) THEN maxshell = nshell(iset) CALL reallocate(n, 1, maxshell, 1, nset) @@ -1659,8 +1659,8 @@ SUBROUTINE create_ri_basis(gto_basis_set, RI_nset, RI_l_expo, RI_exponents) CALL reallocate(gcc, 1, maxpgf, 1, maxshell, 1, nset) END IF DO i = 1, ishell - n(nshell(iset)-ishell+i, iset) = nmin+i-1 - l(nshell(iset)-ishell+i, iset) = lshell + n(nshell(iset) - ishell + i, iset) = nmin + i - 1 + l(nshell(iset) - ishell + i, iset) = lshell END DO END DO @@ -1723,16 +1723,16 @@ SUBROUTINE create_ri_basis(gto_basis_set, RI_nset, RI_l_expo, RI_exponents) gto_basis_set%nsgf_set(iset) = 0 DO ishell = 1, nshell(iset) lshell = gto_basis_set%l(ishell, iset) - gto_basis_set%first_cgf(ishell, iset) = ncgf+1 - ncgf = ncgf+nco(lshell) + gto_basis_set%first_cgf(ishell, iset) = ncgf + 1 + ncgf = ncgf + nco(lshell) gto_basis_set%last_cgf(ishell, iset) = ncgf gto_basis_set%ncgf_set(iset) = & - gto_basis_set%ncgf_set(iset)+nco(lshell) - gto_basis_set%first_sgf(ishell, iset) = nsgf+1 - nsgf = nsgf+nso(lshell) + gto_basis_set%ncgf_set(iset) + nco(lshell) + gto_basis_set%first_sgf(ishell, iset) = nsgf + 1 + nsgf = nsgf + nso(lshell) gto_basis_set%last_sgf(ishell, iset) = nsgf gto_basis_set%nsgf_set(iset) = & - gto_basis_set%nsgf_set(iset)+nso(lshell) + gto_basis_set%nsgf_set(iset) + nso(lshell) END DO maxco = MAX(maxco, npgf(iset)*ncoset(lmax(iset))) END DO @@ -1758,8 +1758,8 @@ SUBROUTINE create_ri_basis(gto_basis_set, RI_nset, RI_l_expo, RI_exponents) DO iset = 1, nset DO ishell = 1, nshell(iset) lshell = gto_basis_set%l(ishell, iset) - DO ico = ncoset(lshell-1)+1, ncoset(lshell) - ncgf = ncgf+1 + DO ico = ncoset(lshell - 1) + 1, ncoset(lshell) + ncgf = ncgf + 1 gto_basis_set%lx(ncgf) = indco(1, ico) gto_basis_set%ly(ncgf) = indco(2, ico) gto_basis_set%lz(ncgf) = indco(3, ico) @@ -1769,7 +1769,7 @@ SUBROUTINE create_ri_basis(gto_basis_set, RI_nset, RI_l_expo, RI_exponents) gto_basis_set%lz(ncgf)/)) END DO DO m = -lshell, lshell - nsgf = nsgf+1 + nsgf = nsgf + 1 gto_basis_set%m(nsgf) = m gto_basis_set%sgf_symbol(nsgf) = & sgf_symbol(n(ishell, iset), lshell, m) diff --git a/src/mp2_ri_2c.F b/src/mp2_ri_2c.F index b0163a83d0..2dbdc0a4cf 100644 --- a/src/mp2_ri_2c.F +++ b/src/mp2_ri_2c.F @@ -336,7 +336,7 @@ SUBROUTINE decomp_mat_L(fm_matrix_L, do_svd, eps_svd, num_small_eigen, cond_num, IF (do_svd) THEN CALL matrix_root_with_svd(fm_matrix_L, eps_svd, num_small_eigen, cond_num, do_inversion, para_env) - dimen_RI_red = dimen_RI-num_small_eigen + dimen_RI_red = dimen_RI - num_small_eigen ! We changed the size of fm_matrix_L in matrix_root_with_svd. ! So, we have to get new group sizes @@ -710,7 +710,7 @@ SUBROUTINE compute_2c_integrals(qs_env, eri_method, eri_param, para_env, para_en DO iatom = 1, natom ikind = kind_of(iatom) CALL get_qs_kind(qs_kind=qs_kind_set(ikind), nsgf=nsgf, basis_type="RI_AUX") - dimen_RI = dimen_RI+nsgf + dimen_RI = dimen_RI + nsgf END DO ! check that very small systems are not running on too many processes @@ -754,9 +754,9 @@ SUBROUTINE compute_2c_integrals(qs_env, eri_method, eri_param, para_env, para_en min_mem_for_QK = REAL(dimen_RI, KIND=dp)*dimen_RI*3.0_dp*8.0_dp/1024_dp/1024_dp - group_size = strat_group_size-1 + group_size = strat_group_size - 1 DO iproc = strat_group_size, para_env%num_pe - group_size = group_size+1 + group_size = group_size + 1 ! check that group_size is a multiple of sub_group_size and a divisor of ! the total num of proc IF (MOD(para_env%num_pe, group_size) /= 0 .OR. MOD(group_size, para_env_sub%num_pe) /= 0) CYCLE @@ -791,11 +791,11 @@ SUBROUTINE compute_2c_integrals(qs_env, eri_method, eri_param, para_env, para_en CALL cp_para_env_create(para_env_exchange, comm_exchange) ! crate the proc maps - ALLOCATE (proc_map(-para_env_exchange%num_pe:2*para_env_exchange%num_pe-1)) - DO i = 0, para_env_exchange%num_pe-1 + ALLOCATE (proc_map(-para_env_exchange%num_pe:2*para_env_exchange%num_pe - 1)) + DO i = 0, para_env_exchange%num_pe - 1 proc_map(i) = i - proc_map(-i-1) = para_env_exchange%num_pe-i-1 - proc_map(para_env_exchange%num_pe+i) = i + proc_map(-i - 1) = para_env_exchange%num_pe - i - 1 + proc_map(para_env_exchange%num_pe + i) = i END DO CALL create_group_dist(gd_sub_array, my_group_L_start, & @@ -824,17 +824,17 @@ SUBROUTINE compute_2c_integrals(qs_env, eri_method, eri_param, para_env, para_en IF (j_global >= my_group_L_start .AND. j_global <= my_group_L_end) THEN DO iiB = 1, nrow_local i_global = row_indices(iiB) - fm_matrix_L%local_data(iiB, jjB) = L_local_col(i_global, j_global-my_group_L_start+1) + fm_matrix_L%local_data(iiB, jjB) = L_local_col(i_global, j_global - my_group_L_start + 1) END DO END IF END DO - proc_send_static = proc_map(para_env_exchange%mepos+1) - proc_receive_static = proc_map(para_env_exchange%mepos-1) + proc_send_static = proc_map(para_env_exchange%mepos + 1) + proc_receive_static = proc_map(para_env_exchange%mepos - 1) - DO proc_shift = 1, para_env_exchange%num_pe-1 - proc_send = proc_map(para_env_exchange%mepos+proc_shift) - proc_receive = proc_map(para_env_exchange%mepos-proc_shift) + DO proc_shift = 1, para_env_exchange%num_pe - 1 + proc_send = proc_map(para_env_exchange%mepos + proc_shift) + proc_receive = proc_map(para_env_exchange%mepos - proc_shift) CALL get_group_dist(gd_sub_array, proc_receive, rec_L_start, rec_L_end, rec_L_size) @@ -848,7 +848,7 @@ SUBROUTINE compute_2c_integrals(qs_env, eri_method, eri_param, para_env, para_en IF (j_global >= rec_L_start .AND. j_global <= rec_L_end) THEN DO iiB = 1, nrow_local i_global = row_indices(iiB) - fm_matrix_L%local_data(iiB, jjB) = L_external_col(i_global, j_global-rec_L_start+1) + fm_matrix_L%local_data(iiB, jjB) = L_external_col(i_global, j_global - rec_L_start + 1) END DO END IF END DO @@ -898,7 +898,7 @@ SUBROUTINE compute_2c_integrals(qs_env, eri_method, eri_param, para_env, para_en num_small_eigen = 0 DO iiB = 1, dimen_RI - IF (ABS(egen_L(iiB)) < 0.001_dp) num_small_eigen = num_small_eigen+1 + IF (ABS(egen_L(iiB)) < 0.001_dp) num_small_eigen = num_small_eigen + 1 END DO cond_num = MAXVAL(ABS(egen_L))/MINVAL(ABS(egen_L)) @@ -962,21 +962,21 @@ SUBROUTINE matrix_root_with_svd(matrix, eps_svd, num_small_evals, cond_num, do_i num_small_evals = 0 DO ii = 1, nrow IF (evals(ii) > eps_svd) THEN - num_small_evals = ii-1 + num_small_evals = ii - 1 EXIT END IF END DO - needed_evals = nrow-num_small_evals + needed_evals = nrow - num_small_evals ! Get the condition number w.r.t. considered eigenvalues - cond_num = evals(nrow)/evals(num_small_evals+1) + cond_num = evals(nrow)/evals(num_small_evals + 1) ! Determine the eigenvalues of the request matrix root or its inverse evals(1:num_small_evals) = 0.0_dp IF (do_inversion) THEN - evals(num_small_evals+1:nrow) = 1.0_dp/SQRT(evals(num_small_evals+1:nrow)) + evals(num_small_evals + 1:nrow) = 1.0_dp/SQRT(evals(num_small_evals + 1:nrow)) ELSE - evals(num_small_evals+1:nrow) = SQRT(evals(num_small_evals+1:nrow)) + evals(num_small_evals + 1:nrow) = SQRT(evals(num_small_evals + 1:nrow)) END IF CALL cp_fm_column_scale(evecs, evals) @@ -990,7 +990,7 @@ SUBROUTINE matrix_root_with_svd(matrix, eps_svd, num_small_evals, cond_num, do_i NULLIFY (para_env_exchange) CALL cp_para_env_create(para_env_exchange, comm_exchange) - ALLOCATE (num_eval(0:group_size_L-1)) + ALLOCATE (num_eval(0:group_size_L - 1)) num_eval = 0 num_eval(para_env_exchange%mepos) = num_small_evals CALL mp_sum(num_eval, para_env_exchange%group) @@ -999,14 +999,14 @@ SUBROUTINE matrix_root_with_svd(matrix, eps_svd, num_small_evals, cond_num, do_i IF (num_small_evals /= MAXVAL(num_eval)) THEN ! Step 2: Get position of maximum value - DO ii = 0, group_size_L-1 + DO ii = 0, group_size_L - 1 IF (num_eval(ii) == num_small_evals) THEN pos_max = ii EXIT END IF END DO num_small_evals = num_eval(pos_max) - needed_evals = nrow-num_small_evals + needed_evals = nrow - num_small_evals ! Step 3: Broadcast your local data to all other processes CALL mp_bcast(evecs%local_data, pos_max, para_env_exchange%group) @@ -1020,7 +1020,7 @@ SUBROUTINE matrix_root_with_svd(matrix, eps_svd, num_small_evals, cond_num, do_i CALL reset_size_matrix(matrix, needed_evals, matrix%matrix_struct) ! Copy the needed eigenvectors - CALL cp_fm_to_fm(evecs, matrix, needed_evals, num_small_evals+1) + CALL cp_fm_to_fm(evecs, matrix, needed_evals, num_small_evals + 1) CALL cp_fm_release(evecs) @@ -1110,8 +1110,8 @@ SUBROUTINE fill_fm_L_from_L_loc_non_blocking(fm_matrix_L, L_local_col, para_env, nprow = fm_matrix_L%matrix_struct%context%num_pe(1) npcol = fm_matrix_L%matrix_struct%context%num_pe(2) - ALLOCATE (num_entries_rec(0:para_env%num_pe-1)) - ALLOCATE (num_entries_send(0:para_env%num_pe-1)) + ALLOCATE (num_entries_rec(0:para_env%num_pe - 1)) + ALLOCATE (num_entries_send(0:para_env%num_pe - 1)) num_entries_rec(:) = 0 num_entries_send(:) = 0 @@ -1131,7 +1131,7 @@ SUBROUTINE fill_fm_L_from_L_loc_non_blocking(fm_matrix_L, L_local_col, para_env, proc_send = fm_matrix_L%matrix_struct%context%blacs2mpi(send_prow, send_pcol) - num_entries_send(proc_send) = num_entries_send(proc_send)+1 + num_entries_send(proc_send) = num_entries_send(proc_send) + 1 END DO @@ -1148,11 +1148,11 @@ SUBROUTINE fill_fm_L_from_L_loc_non_blocking(fm_matrix_L, L_local_col, para_env, CALL timeset(routineN//"_3", handle2) ! allocate buffers to send the entries and the information of the entries - ALLOCATE (buffer_rec(0:para_env%num_pe-1)) - ALLOCATE (buffer_send(0:para_env%num_pe-1)) + ALLOCATE (buffer_rec(0:para_env%num_pe - 1)) + ALLOCATE (buffer_send(0:para_env%num_pe - 1)) ! allocate data message and corresponding indices - DO iproc = 0, para_env%num_pe-1 + DO iproc = 0, para_env%num_pe - 1 ALLOCATE (buffer_rec(iproc)%msg(num_entries_rec(iproc))) buffer_rec(iproc)%msg = 0.0_dp @@ -1163,7 +1163,7 @@ SUBROUTINE fill_fm_L_from_L_loc_non_blocking(fm_matrix_L, L_local_col, para_env, CALL timeset(routineN//"_4", handle2) - DO iproc = 0, para_env%num_pe-1 + DO iproc = 0, para_env%num_pe - 1 ALLOCATE (buffer_send(iproc)%msg(num_entries_send(iproc))) buffer_send(iproc)%msg = 0.0_dp @@ -1174,7 +1174,7 @@ SUBROUTINE fill_fm_L_from_L_loc_non_blocking(fm_matrix_L, L_local_col, para_env, CALL timeset(routineN//"_5", handle2) - DO iproc = 0, para_env%num_pe-1 + DO iproc = 0, para_env%num_pe - 1 ALLOCATE (buffer_rec(iproc)%indx(num_entries_rec(iproc), 2)) buffer_rec(iproc)%indx = 0 @@ -1185,7 +1185,7 @@ SUBROUTINE fill_fm_L_from_L_loc_non_blocking(fm_matrix_L, L_local_col, para_env, CALL timeset(routineN//"_6", handle2) - DO iproc = 0, para_env%num_pe-1 + DO iproc = 0, para_env%num_pe - 1 ALLOCATE (buffer_send(iproc)%indx(num_entries_send(iproc), 2)) buffer_send(iproc)%indx = 0 @@ -1196,7 +1196,7 @@ SUBROUTINE fill_fm_L_from_L_loc_non_blocking(fm_matrix_L, L_local_col, para_env, CALL timeset(routineN//"_7", handle2) - ALLOCATE (entry_counter(0:para_env%num_pe-1)) + ALLOCATE (entry_counter(0:para_env%num_pe - 1)) entry_counter(:) = 0 ! get the process, where the elements from L_local_col have to be sent and @@ -1213,10 +1213,10 @@ SUBROUTINE fill_fm_L_from_L_loc_non_blocking(fm_matrix_L, L_local_col, para_env, proc_send = fm_matrix_L%matrix_struct%context%blacs2mpi(send_prow, send_pcol) - entry_counter(proc_send) = entry_counter(proc_send)+1 + entry_counter(proc_send) = entry_counter(proc_send) + 1 buffer_send(proc_send)%msg(entry_counter(proc_send)) = & - L_local_col(LLL, MMM-my_group_L_start+1) + L_local_col(LLL, MMM - my_group_L_start + 1) buffer_send(proc_send)%indx(entry_counter(proc_send), 1) = LLL buffer_send(proc_send)%indx(entry_counter(proc_send), 2) = MMM @@ -1242,7 +1242,7 @@ SUBROUTINE fill_fm_L_from_L_loc_non_blocking(fm_matrix_L, L_local_col, para_env, CALL timeset(routineN//"_9", handle2) ! fill fm_matrix_L with the entries from buffer_rec - DO iproc = 0, para_env%num_pe-1 + DO iproc = 0, para_env%num_pe - 1 DO i_entry_rec = 1, num_entries_rec(iproc) @@ -1273,7 +1273,7 @@ SUBROUTINE fill_fm_L_from_L_loc_non_blocking(fm_matrix_L, L_local_col, para_env, CALL timeset(routineN//"_10", handle2) - DO iproc = 0, para_env%num_pe-1 + DO iproc = 0, para_env%num_pe - 1 DEALLOCATE (buffer_rec(iproc)%msg) DEALLOCATE (buffer_rec(iproc)%indx) DEALLOCATE (buffer_send(iproc)%msg) diff --git a/src/mp2_ri_gpw.F b/src/mp2_ri_gpw.F index 76de26d6ce..7588ce6a9f 100644 --- a/src/mp2_ri_gpw.F +++ b/src/mp2_ri_gpw.F @@ -162,8 +162,8 @@ SUBROUTINE mp2_ri_gpw_compute_en(Emp2, Emp2_Cou, Emp2_EX, BIb_C, mp2_env, para_e IF (my_alpha_beta_case) amp_fac = 1.0_dp - virtual = nmo-homo - IF (my_alpha_beta_case) virtual_beta = nmo-homo_beta + virtual = nmo - homo + IF (my_alpha_beta_case) virtual_beta = nmo - homo_beta CALL mp2_ri_get_sizes( & mp2_env, para_env, para_env_sub, gd_array, gd_B_virtual, & @@ -204,7 +204,7 @@ SUBROUTINE mp2_ri_gpw_compute_en(Emp2, Emp2_Cou, Emp2_EX, BIb_C, mp2_env, para_e CALL mp2_ri_communication(my_alpha_beta_case, total_ij_pairs, homo, my_homo_beta, num_IJ_blocks, & block_size, ngroup, ij_map, color_sub, my_ij_pairs, my_open_shell_SS, unit_nr) - ALLOCATE (num_ij_pairs(0:para_env_exchange%num_pe-1)) + ALLOCATE (num_ij_pairs(0:para_env_exchange%num_pe - 1)) num_ij_pairs = 0 num_ij_pairs(para_env_exchange%mepos) = my_ij_pairs CALL mp_sum(num_ij_pairs, para_env_exchange%group) @@ -238,24 +238,24 @@ SUBROUTINE mp2_ri_gpw_compute_en(Emp2, Emp2_Cou, Emp2_EX, BIb_C, mp2_env, para_e IF (ij_index <= my_ij_pairs) THEN ! We have work to do - ij_counter = (ij_index-MIN(1, color_sub))*ngroup+color_sub + ij_counter = (ij_index - MIN(1, color_sub))*ngroup + color_sub my_i = ij_map(ij_counter, 1) my_j = ij_map(ij_counter, 2) my_block_size = ij_map(ij_counter, 3) local_i_aL = 0.0_dp - DO irep = 0, num_integ_group-1 + DO irep = 0, num_integ_group - 1 Lstart_pos = ranges_info_array(1, irep, para_env_exchange%mepos) Lend_pos = ranges_info_array(2, irep, para_env_exchange%mepos) start_point = ranges_info_array(3, irep, para_env_exchange%mepos) end_point = ranges_info_array(4, irep, para_env_exchange%mepos) local_i_aL(Lstart_pos:Lend_pos, 1:my_B_size, 1:my_block_size) = & - BIb_C(start_point:end_point, 1:my_B_size, my_i:my_i+my_block_size-1) + BIb_C(start_point:end_point, 1:my_B_size, my_i:my_i + my_block_size - 1) END DO local_j_aL = 0.0_dp - DO irep = 0, num_integ_group-1 + DO irep = 0, num_integ_group - 1 Lstart_pos = ranges_info_array(1, irep, para_env_exchange%mepos) Lend_pos = ranges_info_array(2, irep, para_env_exchange%mepos) start_point = ranges_info_array(3, irep, para_env_exchange%mepos) @@ -263,18 +263,18 @@ SUBROUTINE mp2_ri_gpw_compute_en(Emp2, Emp2_Cou, Emp2_EX, BIb_C, mp2_env, para_e IF (.NOT. my_alpha_beta_case) THEN local_j_aL(Lstart_pos:Lend_pos, 1:my_B_size, 1:my_block_size) = & - BIb_C(start_point:end_point, 1:my_B_size, my_j:my_j+my_block_size-1) + BIb_C(start_point:end_point, 1:my_B_size, my_j:my_j + my_block_size - 1) ELSE local_j_aL(Lstart_pos:Lend_pos, 1:my_B_size_beta, 1:my_block_size) = & - BIb_C_beta(start_point:end_point, 1:my_B_size_beta, my_j:my_j+my_block_size-1) + BIb_C_beta(start_point:end_point, 1:my_B_size_beta, my_j:my_j + my_block_size - 1) END IF END DO ! collect data from other proc CALL timeset(routineN//"_comm", handle3) - DO proc_shift = 1, para_env_exchange%num_pe-1 - proc_send = proc_map(para_env_exchange%mepos+proc_shift) - proc_receive = proc_map(para_env_exchange%mepos-proc_shift) + DO proc_shift = 1, para_env_exchange%num_pe - 1 + proc_send = proc_map(para_env_exchange%mepos + proc_shift) + proc_receive = proc_map(para_env_exchange%mepos - proc_shift) send_ij_index = num_ij_pairs(proc_send) @@ -282,7 +282,7 @@ SUBROUTINE mp2_ri_gpw_compute_en(Emp2, Emp2_Cou, Emp2_EX, BIb_C, mp2_env, para_e ALLOCATE (BI_C_rec(rec_L_size, MAX(my_B_size, my_B_size_beta), my_block_size)) IF (ij_index <= send_ij_index) THEN - ij_counter_send = (ij_index-MIN(1, integ_group_pos2color_sub(proc_send)))*ngroup+ & + ij_counter_send = (ij_index - MIN(1, integ_group_pos2color_sub(proc_send)))*ngroup + & integ_group_pos2color_sub(proc_send) send_i = ij_map(ij_counter_send, 1) send_j = ij_map(ij_counter_send, 2) @@ -290,10 +290,10 @@ SUBROUTINE mp2_ri_gpw_compute_en(Emp2, Emp2_Cou, Emp2_EX, BIb_C, mp2_env, para_e ! occupied i BI_C_rec = 0.0_dp - CALL mp_sendrecv(BIb_C(1:my_group_L_size, 1:my_B_size, send_i:send_i+send_block_size-1), proc_send, & + CALL mp_sendrecv(BIb_C(1:my_group_L_size, 1:my_B_size, send_i:send_i + send_block_size - 1), proc_send, & BI_C_rec(1:rec_L_size, 1:my_B_size, 1:my_block_size), proc_receive, & para_env_exchange%group) - DO irep = 0, num_integ_group-1 + DO irep = 0, num_integ_group - 1 Lstart_pos = ranges_info_array(1, irep, proc_receive) Lend_pos = ranges_info_array(2, irep, proc_receive) start_point = ranges_info_array(3, irep, proc_receive) @@ -307,16 +307,16 @@ SUBROUTINE mp2_ri_gpw_compute_en(Emp2, Emp2_Cou, Emp2_EX, BIb_C, mp2_env, para_e ! occupied j BI_C_rec = 0.0_dp IF (.NOT. my_alpha_beta_case) THEN - CALL mp_sendrecv(BIb_C(1:my_group_L_size, 1:my_B_size, send_j:send_j+send_block_size-1), proc_send, & + CALL mp_sendrecv(BIb_C(1:my_group_L_size, 1:my_B_size, send_j:send_j + send_block_size - 1), proc_send, & BI_C_rec(1:rec_L_size, 1:my_B_size, 1:my_block_size), proc_receive, & para_env_exchange%group) ELSE - CALL mp_sendrecv(BIb_C_beta(1:my_group_L_size, 1:my_B_size_beta, send_j:send_j+send_block_size-1), proc_send, & + CALL mp_sendrecv(BIb_C_beta(1:my_group_L_size, 1:my_B_size_beta, send_j:send_j + send_block_size - 1), proc_send, & BI_C_rec(1:rec_L_size, 1:my_B_size_beta, 1:my_block_size), proc_receive, & para_env_exchange%group) END IF - DO irep = 0, num_integ_group-1 + DO irep = 0, num_integ_group - 1 Lstart_pos = ranges_info_array(1, irep, proc_receive) Lend_pos = ranges_info_array(2, irep, proc_receive) start_point = ranges_info_array(3, irep, proc_receive) @@ -341,7 +341,7 @@ SUBROUTINE mp2_ri_gpw_compute_en(Emp2, Emp2_Cou, Emp2_EX, BIb_C, mp2_env, para_e BI_C_rec(1:rec_L_size, 1:my_B_size, 1:my_block_size), proc_receive, & para_env_exchange%group) - DO irep = 0, num_integ_group-1 + DO irep = 0, num_integ_group - 1 Lstart_pos = ranges_info_array(1, irep, proc_receive) Lend_pos = ranges_info_array(2, irep, proc_receive) start_point = ranges_info_array(3, irep, proc_receive) @@ -363,7 +363,7 @@ SUBROUTINE mp2_ri_gpw_compute_en(Emp2, Emp2_Cou, Emp2_EX, BIb_C, mp2_env, para_e BI_C_rec(1:rec_L_size, 1:my_B_size_beta, 1:my_block_size), proc_receive, & para_env_exchange%group) END IF - DO irep = 0, num_integ_group-1 + DO irep = 0, num_integ_group - 1 Lstart_pos = ranges_info_array(1, irep, proc_receive) Lend_pos = ranges_info_array(2, irep, proc_receive) start_point = ranges_info_array(3, irep, proc_receive) @@ -400,9 +400,9 @@ SUBROUTINE mp2_ri_gpw_compute_en(Emp2, Emp2_Cou, Emp2_EX, BIb_C, mp2_env, para_e local_i_aL(:, :, iiB), dimen_RI, local_j_aL(:, :, jjB), dimen_RI, & 0.0_dp, local_ab(my_B_virtual_start:my_B_virtual_end, 1:my_B_size_beta), my_B_size) t_end = m_walltime() - actual_flop_rate = 2.0_dp*my_B_size*my_B_size_beta*REAL(dimen_RI, KIND=dp)/(MAX(0.01_dp, t_end-t_start)) - my_flop_rate = my_flop_rate+actual_flop_rate - my_num_dgemm_call = my_num_dgemm_call+1 + actual_flop_rate = 2.0_dp*my_B_size*my_B_size_beta*REAL(dimen_RI, KIND=dp)/(MAX(0.01_dp, t_end - t_start)) + my_flop_rate = my_flop_rate + actual_flop_rate + my_num_dgemm_call = my_num_dgemm_call + 1 ! Additional integrals only for alpha_beta case and forces IF ((my_alpha_beta_case) .AND. (calc_forces)) THEN t_start = m_walltime() @@ -410,14 +410,14 @@ SUBROUTINE mp2_ri_gpw_compute_en(Emp2, Emp2_Cou, Emp2_EX, BIb_C, mp2_env, para_e local_j_aL(:, :, iiB), dimen_RI, local_i_aL(:, :, jjB), dimen_RI, & 0.0_dp, local_ba(my_B_virtual_start_beta:my_B_virtual_end_beta, 1:my_B_size), my_B_size_beta) t_end = m_walltime() - actual_flop_rate = 2.0_dp*my_B_size*my_B_size_beta*REAL(dimen_RI, KIND=dp)/(MAX(0.01_dp, t_end-t_start)) - my_flop_rate = my_flop_rate+actual_flop_rate - my_num_dgemm_call = my_num_dgemm_call+1 + actual_flop_rate = 2.0_dp*my_B_size*my_B_size_beta*REAL(dimen_RI, KIND=dp)/(MAX(0.01_dp, t_end - t_start)) + my_flop_rate = my_flop_rate + actual_flop_rate + my_num_dgemm_call = my_num_dgemm_call + 1 ENDIF ! ... and from the other of my subgroup - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_send = sub_proc_map(para_env_sub%mepos+proc_shift) - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_send = sub_proc_map(para_env_sub%mepos + proc_shift) + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) CALL get_group_dist(gd_B_virtual, proc_receive, rec_B_virtual_start, rec_B_virtual_end, rec_B_size) @@ -434,9 +434,9 @@ SUBROUTINE mp2_ri_gpw_compute_en(Emp2, Emp2_Cou, Emp2_EX, BIb_C, mp2_env, para_e 0.0_dp, local_ab(rec_B_virtual_start:rec_B_virtual_end, 1:my_B_size_beta), rec_B_size) t_end = m_walltime() - actual_flop_rate = 2.0_dp*rec_B_size*my_B_size_beta*REAL(dimen_RI, KIND=dp)/(MAX(0.01_dp, t_end-t_start)) - my_flop_rate = my_flop_rate+actual_flop_rate - my_num_dgemm_call = my_num_dgemm_call+1 + actual_flop_rate = 2.0_dp*rec_B_size*my_B_size_beta*REAL(dimen_RI, KIND=dp)/(MAX(0.01_dp, t_end - t_start)) + my_flop_rate = my_flop_rate + actual_flop_rate + my_num_dgemm_call = my_num_dgemm_call + 1 DEALLOCATE (external_i_aL) ! Additional integrals only for alpha_beta case and forces @@ -456,9 +456,9 @@ SUBROUTINE mp2_ri_gpw_compute_en(Emp2, Emp2_Cou, Emp2_EX, BIb_C, mp2_env, para_e external_i_aL, dimen_RI, local_i_aL(:, :, iiB), dimen_RI, & 0.0_dp, local_ba(rec_B_virtual_start:rec_B_virtual_end, 1:my_B_size), rec_B_size) t_end = m_walltime() - actual_flop_rate = 2.0_dp*rec_B_size*my_B_size*REAL(dimen_RI, KIND=dp)/(MAX(0.01_dp, t_end-t_start)) - my_flop_rate = my_flop_rate+actual_flop_rate - my_num_dgemm_call = my_num_dgemm_call+1 + actual_flop_rate = 2.0_dp*rec_B_size*my_B_size*REAL(dimen_RI, KIND=dp)/(MAX(0.01_dp, t_end - t_start)) + my_flop_rate = my_flop_rate + actual_flop_rate + my_num_dgemm_call = my_num_dgemm_call + 1 DEALLOCATE (external_i_aL) ENDIF @@ -475,19 +475,19 @@ SUBROUTINE mp2_ri_gpw_compute_en(Emp2, Emp2_Cou, Emp2_EX, BIb_C, mp2_env, para_e IF (my_i == my_j) sym_fac = 1.0_dp IF (.NOT. my_alpha_beta_case) THEN DO b = 1, my_B_size - b_global = b+my_B_virtual_start-1 + b_global = b + my_B_virtual_start - 1 DO a = 1, virtual - Emp2_Cou = Emp2_Cou-sym_fac*2.0_dp*local_ab(a, b)**2/ & - (Eigenval(homo+a)+Eigenval(homo+b_global)-Eigenval(my_i+iiB-1)-Eigenval(my_j+jjB-1)) + Emp2_Cou = Emp2_Cou - sym_fac*2.0_dp*local_ab(a, b)**2/ & + (Eigenval(homo + a) + Eigenval(homo + b_global) - Eigenval(my_i + iiB - 1) - Eigenval(my_j + jjB - 1)) END DO END DO ELSE DO b = 1, my_B_size_beta - b_global = b+my_B_virtual_start_beta-1 + b_global = b + my_B_virtual_start_beta - 1 DO a = 1, virtual - Emp2_Cou = Emp2_Cou-local_ab(a, b)**2/ & - (Eigenval(homo+a)+Eigenval_beta(homo_beta+b_global)- & - Eigenval(my_i+iiB-1)-Eigenval_beta(my_j+jjB-1)) + Emp2_Cou = Emp2_Cou - local_ab(a, b)**2/ & + (Eigenval(homo + a) + Eigenval_beta(homo_beta + b_global) - & + Eigenval(my_i + iiB - 1) - Eigenval_beta(my_j + jjB - 1)) END DO END DO END IF @@ -498,21 +498,21 @@ SUBROUTINE mp2_ri_gpw_compute_en(Emp2, Emp2_Cou, Emp2_EX, BIb_C, mp2_env, para_e ! IF(my_open_shell_SS) sym_fac=sym_fac*2.0_dp IF (calc_forces .AND. (.NOT. my_alpha_beta_case)) t_ab = 0.0_dp DO b = 1, my_B_size - b_global = b+my_B_virtual_start-1 + b_global = b + my_B_virtual_start - 1 DO a = 1, my_B_size - a_global = a+my_B_virtual_start-1 - Emp2_Ex = Emp2_Ex+sym_fac*local_ab(a_global, b)*local_ab(b_global, a)/ & - (Eigenval(homo+a_global)+Eigenval(homo+b_global)-Eigenval(my_i+iiB-1)-Eigenval(my_j+jjB-1)) + a_global = a + my_B_virtual_start - 1 + Emp2_Ex = Emp2_Ex + sym_fac*local_ab(a_global, b)*local_ab(b_global, a)/ & + (Eigenval(homo + a_global) + Eigenval(homo + b_global) - Eigenval(my_i + iiB - 1) - Eigenval(my_j + jjB - 1)) IF (calc_forces .AND. (.NOT. my_alpha_beta_case)) & - t_ab(a_global, b) = -(amp_fac*local_ab(a_global, b)-local_ab(b_global, a))/ & - (Eigenval(homo+a_global)+Eigenval(homo+b_global)- & - Eigenval(my_i+iiB-1)-Eigenval(my_j+jjB-1)) + t_ab(a_global, b) = -(amp_fac*local_ab(a_global, b) - local_ab(b_global, a))/ & + (Eigenval(homo + a_global) + Eigenval(homo + b_global) - & + Eigenval(my_i + iiB - 1) - Eigenval(my_j + jjB - 1)) END DO END DO ! ... and then with external data - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_send = sub_proc_map(para_env_sub%mepos+proc_shift) - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_send = sub_proc_map(para_env_sub%mepos + proc_shift) + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) CALL get_group_dist(gd_B_virtual, proc_receive, rec_B_virtual_start, rec_B_virtual_end, rec_B_size) @@ -526,15 +526,15 @@ SUBROUTINE mp2_ri_gpw_compute_en(Emp2, Emp2_Cou, Emp2_EX, BIb_C, mp2_env, para_e para_env_sub%group) DO b = 1, my_B_size - b_global = b+my_B_virtual_start-1 + b_global = b + my_B_virtual_start - 1 DO a = 1, rec_B_size - a_global = a+rec_B_virtual_start-1 - Emp2_Ex = Emp2_Ex+sym_fac*local_ab(a_global, b)*external_ab(b, a)/ & - (Eigenval(homo+a_global)+Eigenval(homo+b_global)-Eigenval(my_i+iiB-1)-Eigenval(my_j+jjB-1)) + a_global = a + rec_B_virtual_start - 1 + Emp2_Ex = Emp2_Ex + sym_fac*local_ab(a_global, b)*external_ab(b, a)/ & + (Eigenval(homo + a_global) + Eigenval(homo + b_global) - Eigenval(my_i + iiB - 1) - Eigenval(my_j + jjB - 1)) IF (calc_forces .AND. (.NOT. my_alpha_beta_case)) & - t_ab(a_global, b) = -(amp_fac*local_ab(a_global, b)-external_ab(b, a))/ & - (Eigenval(homo+a_global)+Eigenval(homo+b_global)- & - Eigenval(my_i+iiB-1)-Eigenval(my_j+jjB-1)) + t_ab(a_global, b) = -(amp_fac*local_ab(a_global, b) - external_ab(b, a))/ & + (Eigenval(homo + a_global) + Eigenval(homo + b_global) - & + Eigenval(my_i + iiB - 1) - Eigenval(my_j + jjB - 1)) END DO END DO @@ -573,31 +573,31 @@ SUBROUTINE mp2_ri_gpw_compute_en(Emp2, Emp2_Cou, Emp2_EX, BIb_C, mp2_env, para_e ELSE ! No work to do and we know that we have to receive nothing, but send something ! send data to other proc - DO proc_shift = 1, para_env_exchange%num_pe-1 - proc_send = proc_map(para_env_exchange%mepos+proc_shift) - proc_receive = proc_map(para_env_exchange%mepos-proc_shift) + DO proc_shift = 1, para_env_exchange%num_pe - 1 + proc_send = proc_map(para_env_exchange%mepos + proc_shift) + proc_receive = proc_map(para_env_exchange%mepos - proc_shift) send_ij_index = num_ij_pairs(proc_send) IF (ij_index <= send_ij_index) THEN ! something to send - ij_counter_send = (ij_index-MIN(1, integ_group_pos2color_sub(proc_send)))*ngroup+ & + ij_counter_send = (ij_index - MIN(1, integ_group_pos2color_sub(proc_send)))*ngroup + & integ_group_pos2color_sub(proc_send) send_i = ij_map(ij_counter_send, 1) send_j = ij_map(ij_counter_send, 2) send_block_size = ij_map(ij_counter_send, 3) ! occupied i - CALL mp_sendrecv(BIb_C(1:my_group_L_size, 1:my_B_size, send_i:send_i+send_block_size-1), proc_send, & + CALL mp_sendrecv(BIb_C(1:my_group_L_size, 1:my_B_size, send_i:send_i + send_block_size - 1), proc_send, & null_mat_rec, proc_receive, & para_env_exchange%group) ! occupied j IF (.NOT. my_alpha_beta_case) THEN - CALL mp_sendrecv(BIb_C(1:my_group_L_size, 1:my_B_size, send_j:send_j+send_block_size-1), proc_send, & + CALL mp_sendrecv(BIb_C(1:my_group_L_size, 1:my_B_size, send_j:send_j + send_block_size - 1), proc_send, & null_mat_rec, proc_receive, & para_env_exchange%group) ELSE - CALL mp_sendrecv(BIb_C_beta(1:my_group_L_size, 1:my_B_size_beta, send_j:send_j+send_block_size-1), proc_send, & + CALL mp_sendrecv(BIb_C_beta(1:my_group_L_size, 1:my_B_size_beta, send_j:send_j + send_block_size - 1), proc_send, & null_mat_rec, proc_receive, & para_env_exchange%group) END IF @@ -715,7 +715,7 @@ SUBROUTINE mp2_ri_gpw_compute_en(Emp2, Emp2_Cou, Emp2_EX, BIb_C, mp2_env, para_e ! recover original information (before replication) DEALLOCATE (gd_array%sizes) iiB = SIZE(sizes_array_orig) - ALLOCATE (gd_array%sizes(0:iiB-1)) + ALLOCATE (gd_array%sizes(0:iiB - 1)) gd_array%sizes(:) = sizes_array_orig DEALLOCATE (sizes_array_orig) @@ -744,10 +744,10 @@ SUBROUTINE mp2_ri_gpw_compute_en(Emp2, Emp2_Cou, Emp2_EX, BIb_C, mp2_env, para_e ! sum Gamma and dereplicate ALLOCATE (BIb_C(homo, my_B_size, my_group_L_size)) IF (my_alpha_beta_case) ALLOCATE (BIb_C_beta(homo_beta, my_B_size_beta, my_group_L_size)) - DO proc_shift = 1, para_env_rep%num_pe-1 + DO proc_shift = 1, para_env_rep%num_pe - 1 ! invert order - proc_send = proc_map_rep(para_env_rep%mepos-proc_shift) - proc_receive = proc_map_rep(para_env_rep%mepos+proc_shift) + proc_send = proc_map_rep(para_env_rep%mepos - proc_shift) + proc_receive = proc_map_rep(para_env_rep%mepos + proc_shift) start_point = ranges_info_array(3, proc_shift, para_env_exchange%mepos) end_point = ranges_info_array(4, proc_shift, para_env_exchange%mepos) @@ -758,20 +758,20 @@ SUBROUTINE mp2_ri_gpw_compute_en(Emp2, Emp2_Cou, Emp2_EX, BIb_C, mp2_env, para_e CALL mp_sendrecv(mp2_env%ri_grad%Gamma_P_ia(1:homo, 1:my_B_size, start_point:end_point), & proc_send, BIb_C, proc_receive, para_env_rep%group) mp2_env%ri_grad%Gamma_P_ia(1:homo, 1:my_B_size, 1:my_group_L_size) = & - mp2_env%ri_grad%Gamma_P_ia(1:homo, 1:my_B_size, 1:my_group_L_size)+BIb_C + mp2_env%ri_grad%Gamma_P_ia(1:homo, 1:my_B_size, 1:my_group_L_size) + BIb_C ENDIF ! Beta-beta IF (my_beta_beta_case) THEN CALL mp_sendrecv(mp2_env%ri_grad%Gamma_P_ia_beta(1:homo, 1:my_B_size, start_point:end_point), & proc_send, BIb_C, proc_receive, para_env_rep%group) mp2_env%ri_grad%Gamma_P_ia_beta(1:homo, 1:my_B_size, 1:my_group_L_size) = & - mp2_env%ri_grad%Gamma_P_ia_beta(1:homo, 1:my_B_size, 1:my_group_L_size)+BIb_C + mp2_env%ri_grad%Gamma_P_ia_beta(1:homo, 1:my_B_size, 1:my_group_L_size) + BIb_C ENDIF IF (my_alpha_beta_case) THEN ! Beta-beta part of alpha-beta case CALL mp_sendrecv(mp2_env%ri_grad%Gamma_P_ia_beta(1:homo_beta, 1:my_B_size_beta, start_point:end_point), & proc_send, BIb_C_beta, proc_receive, para_env_rep%group) mp2_env%ri_grad%Gamma_P_ia_beta(1:homo_beta, 1:my_B_size_beta, 1:my_group_L_size) = & - mp2_env%ri_grad%Gamma_P_ia_beta(1:homo_beta, 1:my_B_size_beta, 1:my_group_L_size)+BIb_C_beta + mp2_env%ri_grad%Gamma_P_ia_beta(1:homo_beta, 1:my_B_size_beta, 1:my_group_L_size) + BIb_C_beta ENDIF END DO @@ -823,7 +823,7 @@ SUBROUTINE mp2_ri_gpw_compute_en(Emp2, Emp2_Cou, Emp2_EX, BIb_C, mp2_env, para_e END IF - Emp2 = Emp2_Cou+Emp2_EX + Emp2 = Emp2_Cou + Emp2_EX DEALLOCATE (proc_map) DEALLOCATE (sub_proc_map) @@ -905,32 +905,32 @@ SUBROUTINE replicate_iaK_2intgroup(BIb_C, para_env, para_env_sub, para_env_excha CALL timeset(routineN, handle) ! create the replication group - sub_sub_color = para_env_sub%mepos*para_env_exchange%num_pe+para_env_exchange%mepos + sub_sub_color = para_env_sub%mepos*para_env_exchange%num_pe + para_env_exchange%mepos CALL mp_comm_split_direct(para_env%group, comm_rep, sub_sub_color) NULLIFY (para_env_rep) CALL cp_para_env_create(para_env_rep, comm_rep) ! crate the proc maps - ALLOCATE (proc_map_rep(-para_env_rep%num_pe:2*para_env_rep%num_pe-1)) - DO i = 0, para_env_rep%num_pe-1 + ALLOCATE (proc_map_rep(-para_env_rep%num_pe:2*para_env_rep%num_pe - 1)) + DO i = 0, para_env_rep%num_pe - 1 proc_map_rep(i) = i - proc_map_rep(-i-1) = para_env_rep%num_pe-i-1 - proc_map_rep(para_env_rep%num_pe+i) = i + proc_map_rep(-i - 1) = para_env_rep%num_pe - i - 1 + proc_map_rep(para_env_rep%num_pe + i) = i END DO ! create the new limits for K according to the size ! of the integral group - ALLOCATE (new_sizes_array(0:para_env_exchange%num_pe-1)) + ALLOCATE (new_sizes_array(0:para_env_exchange%num_pe - 1)) new_sizes_array = 0 - ALLOCATE (ranges_info_array(4, 0:para_env_rep%num_pe-1, 0:para_env_exchange%num_pe-1)) + ALLOCATE (ranges_info_array(4, 0:para_env_rep%num_pe - 1, 0:para_env_exchange%num_pe - 1)) ranges_info_array = 0 ! info array for replication - ALLOCATE (rep_ends_array(0:para_env_rep%num_pe-1)) + ALLOCATE (rep_ends_array(0:para_env_rep%num_pe - 1)) rep_ends_array = 0 - ALLOCATE (rep_starts_array(0:para_env_rep%num_pe-1)) + ALLOCATE (rep_starts_array(0:para_env_rep%num_pe - 1)) rep_starts_array = 0 - ALLOCATE (rep_sizes_array(0:para_env_rep%num_pe-1)) + ALLOCATE (rep_sizes_array(0:para_env_rep%num_pe - 1)) rep_sizes_array = 0 rep_sizes_array(para_env_rep%mepos) = my_group_L_size @@ -948,15 +948,15 @@ SUBROUTINE replicate_iaK_2intgroup(BIb_C, para_env, para_env_sub, para_env_excha ranges_info_array(3, 0, para_env_exchange%mepos) = 1 ranges_info_array(4, 0, para_env_exchange%mepos) = my_group_L_size - DO proc_shift = 1, para_env_rep%num_pe-1 - proc_send = proc_map_rep(para_env_rep%mepos+proc_shift) - proc_receive = proc_map_rep(para_env_rep%mepos-proc_shift) + DO proc_shift = 1, para_env_rep%num_pe - 1 + proc_send = proc_map_rep(para_env_rep%mepos + proc_shift) + proc_receive = proc_map_rep(para_env_rep%mepos - proc_shift) - my_new_group_L_size = my_new_group_L_size+rep_sizes_array(proc_receive) + my_new_group_L_size = my_new_group_L_size + rep_sizes_array(proc_receive) ranges_info_array(1, proc_shift, para_env_exchange%mepos) = rep_starts_array(proc_receive) ranges_info_array(2, proc_shift, para_env_exchange%mepos) = rep_ends_array(proc_receive) - ranges_info_array(3, proc_shift, para_env_exchange%mepos) = ranges_info_array(4, proc_shift-1, para_env_exchange%mepos)+1 + ranges_info_array(3, proc_shift, para_env_exchange%mepos) = ranges_info_array(4, proc_shift - 1, para_env_exchange%mepos) + 1 ranges_info_array(4, proc_shift, para_env_exchange%mepos) = my_new_group_L_size END DO @@ -975,7 +975,7 @@ SUBROUTINE replicate_iaK_2intgroup(BIb_C, para_env, para_env_sub, para_env_excha DEALLOCATE (BIb_C) - ALLOCATE (BIb_C_gather(max_L_size, my_B_size, homo, 0:para_env_rep%num_pe-1)) + ALLOCATE (BIb_C_gather(max_L_size, my_B_size, homo, 0:para_env_rep%num_pe - 1)) BIb_C_gather = 0.0_dp CALL mp_allgather(BIb_C_copy, BIb_C_gather, para_env_rep%group) @@ -986,15 +986,15 @@ SUBROUTINE replicate_iaK_2intgroup(BIb_C, para_env, para_env_sub, para_env_excha BIb_C = 0.0_dp ! reorder data - DO proc_shift = 0, para_env_rep%num_pe-1 - proc_send = proc_map_rep(para_env_rep%mepos+proc_shift) - proc_receive = proc_map_rep(para_env_rep%mepos-proc_shift) + DO proc_shift = 0, para_env_rep%num_pe - 1 + proc_send = proc_map_rep(para_env_rep%mepos + proc_shift) + proc_receive = proc_map_rep(para_env_rep%mepos - proc_shift) start_point = ranges_info_array(3, proc_shift, para_env_exchange%mepos) end_point = ranges_info_array(4, proc_shift, para_env_exchange%mepos) BIb_C(start_point:end_point, 1:my_B_size, 1:homo) = & - BIb_C_gather(1:end_point-start_point+1, 1:my_B_size, 1:homo, proc_receive) + BIb_C_gather(1:end_point - start_point + 1, 1:my_B_size, 1:homo, proc_receive) END DO @@ -1142,19 +1142,19 @@ SUBROUTINE mp2_ri_communication(my_alpha_beta_case, total_ij_pairs, homo, homo_b CALL timeset(routineN, handle) IF (.NOT. my_alpha_beta_case) THEN - total_ij_pairs = homo*(1+homo)/2 - num_IJ_blocks = homo/block_size-1 + total_ij_pairs = homo*(1 + homo)/2 + num_IJ_blocks = homo/block_size - 1 first_I_block = 1 - last_i_block = block_size*(num_IJ_blocks-1) + last_i_block = block_size*(num_IJ_blocks - 1) - first_J_block = block_size+1 - last_J_block = block_size*(num_IJ_blocks+1) + first_J_block = block_size + 1 + last_J_block = block_size*(num_IJ_blocks + 1) ij_block_counter = 0 DO iiB = first_I_block, last_i_block, block_size - DO jjB = iiB+block_size, last_J_block, block_size - ij_block_counter = ij_block_counter+1 + DO jjB = iiB + block_size, last_J_block, block_size + ij_block_counter = ij_block_counter + 1 END DO END DO @@ -1162,7 +1162,7 @@ SUBROUTINE mp2_ri_communication(my_alpha_beta_case, total_ij_pairs, homo, homo_b num_block_per_group = total_ij_block/ngroup assigned_blocks = num_block_per_group*ngroup - total_ij_pairs_blocks = assigned_blocks+(total_ij_pairs-assigned_blocks*(block_size**2)) + total_ij_pairs_blocks = assigned_blocks + (total_ij_pairs - assigned_blocks*(block_size**2)) ALLOCATE (ij_marker(homo, homo)) ij_marker = 0 @@ -1171,24 +1171,24 @@ SUBROUTINE mp2_ri_communication(my_alpha_beta_case, total_ij_pairs, homo, homo_b ij_counter = 0 my_ij_pairs = 0 DO iiB = first_I_block, last_i_block, block_size - DO jjB = iiB+block_size, last_J_block, block_size - IF (ij_counter+1 > assigned_blocks) EXIT - ij_counter = ij_counter+1 - ij_marker(iiB:iiB+block_size-1, jjB:jjB+block_size-1) = 1 + DO jjB = iiB + block_size, last_J_block, block_size + IF (ij_counter + 1 > assigned_blocks) EXIT + ij_counter = ij_counter + 1 + ij_marker(iiB:iiB + block_size - 1, jjB:jjB + block_size - 1) = 1 ij_map(ij_counter, 1) = iiB ij_map(ij_counter, 2) = jjB ij_map(ij_counter, 3) = block_size - IF (MOD(ij_counter, ngroup) == color_sub) my_ij_pairs = my_ij_pairs+1 + IF (MOD(ij_counter, ngroup) == color_sub) my_ij_pairs = my_ij_pairs + 1 END DO END DO DO iiB = 1, homo DO jjB = iiB, homo IF (ij_marker(iiB, jjB) == 0) THEN - ij_counter = ij_counter+1 + ij_counter = ij_counter + 1 ij_map(ij_counter, 1) = iiB ij_map(ij_counter, 2) = jjB ij_map(ij_counter, 3) = 1 - IF (MOD(ij_counter, ngroup) == color_sub) my_ij_pairs = my_ij_pairs+1 + IF (MOD(ij_counter, ngroup) == color_sub) my_ij_pairs = my_ij_pairs + 1 END IF END DO END DO @@ -1202,7 +1202,7 @@ SUBROUTINE mp2_ri_communication(my_alpha_beta_case, total_ij_pairs, homo, homo_b ELSE WRITE (UNIT=unit_nr, FMT="(T3,A,T66,F15.1)") & "RI_INFO| Percentage of ij pairs communicated with block size 1:", & - 100.0_dp*REAL((total_ij_pairs-assigned_blocks*(block_size**2)), KIND=dp)/REAL(total_ij_pairs, KIND=dp) + 100.0_dp*REAL((total_ij_pairs - assigned_blocks*(block_size**2)), KIND=dp)/REAL(total_ij_pairs, KIND=dp) END IF CALL m_flush(unit_nr) END IF @@ -1217,11 +1217,11 @@ SUBROUTINE mp2_ri_communication(my_alpha_beta_case, total_ij_pairs, homo, homo_b my_ij_pairs = 0 DO iiB = 1, homo DO jjB = 1, homo_beta - ij_counter = ij_counter+1 + ij_counter = ij_counter + 1 ij_map(ij_counter, 1) = iiB ij_map(ij_counter, 2) = jjB ij_map(ij_counter, 3) = 1 - IF (MOD(ij_counter, ngroup) == color_sub) my_ij_pairs = my_ij_pairs+1 + IF (MOD(ij_counter, ngroup) == color_sub) my_ij_pairs = my_ij_pairs + 1 END DO END DO END IF @@ -1297,24 +1297,24 @@ SUBROUTINE mp2_ri_create_group(BIb_C, para_env, para_env_sub, homo, color_sub, & CALL timeset(routineN, handle) ! - sub_sub_color = para_env_sub%mepos*num_integ_group+color_sub/integ_group_size + sub_sub_color = para_env_sub%mepos*num_integ_group + color_sub/integ_group_size CALL mp_comm_split_direct(para_env%group, comm_exchange, sub_sub_color) NULLIFY (para_env_exchange) CALL cp_para_env_create(para_env_exchange, comm_exchange) ! create the proc maps - ALLOCATE (proc_map(-para_env_exchange%num_pe:2*para_env_exchange%num_pe-1)) - DO i = 0, para_env_exchange%num_pe-1 + ALLOCATE (proc_map(-para_env_exchange%num_pe:2*para_env_exchange%num_pe - 1)) + DO i = 0, para_env_exchange%num_pe - 1 proc_map(i) = i - proc_map(-i-1) = para_env_exchange%num_pe-i-1 - proc_map(para_env_exchange%num_pe+i) = i + proc_map(-i - 1) = para_env_exchange%num_pe - i - 1 + proc_map(para_env_exchange%num_pe + i) = i END DO - ALLOCATE (sub_proc_map(-para_env_sub%num_pe:2*para_env_sub%num_pe-1)) - DO i = 0, para_env_sub%num_pe-1 + ALLOCATE (sub_proc_map(-para_env_sub%num_pe:2*para_env_sub%num_pe - 1)) + DO i = 0, para_env_sub%num_pe - 1 sub_proc_map(i) = i - sub_proc_map(-i-1) = para_env_sub%num_pe-i-1 - sub_proc_map(para_env_sub%num_pe+i) = i + sub_proc_map(-i - 1) = para_env_sub%num_pe - i - 1 + sub_proc_map(para_env_sub%num_pe + i) = i END DO CALL replicate_iaK_2intgroup(BIb_C, para_env, para_env_sub, para_env_exchange, para_env_rep, & @@ -1324,14 +1324,14 @@ SUBROUTINE mp2_ri_create_group(BIb_C, para_env, para_env_sub, homo, color_sub, & my_group_L_size, my_group_L_start, my_group_L_end, & my_new_group_L_size, new_sizes_array, ranges_info_array) - ALLOCATE (integ_group_pos2color_sub(0:para_env_exchange%num_pe-1)) + ALLOCATE (integ_group_pos2color_sub(0:para_env_exchange%num_pe - 1)) integ_group_pos2color_sub = 0 integ_group_pos2color_sub(para_env_exchange%mepos) = color_sub CALL mp_sum(integ_group_pos2color_sub, para_env_exchange%group) IF (calc_forces) THEN iiB = SIZE(sizes_array) - ALLOCATE (sizes_array_orig(0:iiB-1)) + ALLOCATE (sizes_array_orig(0:iiB - 1)) sizes_array_orig(:) = sizes_array END IF @@ -1339,7 +1339,7 @@ SUBROUTINE mp2_ri_create_group(BIb_C, para_env, para_env_sub, homo, color_sub, & my_group_L_size = my_new_group_L_size DEALLOCATE (sizes_array) - ALLOCATE (sizes_array(0:integ_group_size-1)) + ALLOCATE (sizes_array(0:integ_group_size - 1)) sizes_array(:) = new_sizes_array DEALLOCATE (new_sizes_array) @@ -1424,13 +1424,13 @@ SUBROUTINE mp2_ri_get_sizes(mp2_env, para_env, para_env_sub, gd_array, gd_B_virt mem_for_aK = REAL(virtual, KIND=dp)*dimen_RI*8.0_dp/(1024_dp**2) CALL m_memory(mem) - mem_real = (mem+1024*1024-1)/(1024*1024) + mem_real = (mem + 1024*1024 - 1)/(1024*1024) ! mp_min .... a hack.. it should be mp_max, but as it turns out, on some processes the previously freed memory (hfx) ! has not been given back to the OS yet. CALL mp_min(mem_real, para_env%group) mem_min = 2.0_dp*REAL(homo, KIND=dp)*maxsize(gd_B_virtual)*maxsize(gd_array)*8.0_dp/(1024**2) - mem_min = mem_min+3.0_dp*maxsize(gd_B_virtual)*REAL(dimen_RI, KIND=dp)*8.0_dp/(1024**2) + mem_min = mem_min + 3.0_dp*maxsize(gd_B_virtual)*REAL(dimen_RI, KIND=dp)*8.0_dp/(1024**2) IF ((.NOT. my_open_shell_SS) .AND. (.NOT. my_alpha_beta_case)) THEN IF (unit_nr > 0) WRITE (unit_nr, '(T3,A,T68,F9.2,A4)') 'RI_INFO| Minimum required memory per MPI process:', & @@ -1450,16 +1450,16 @@ SUBROUTINE mp2_ri_get_sizes(mp2_env, para_env, para_env_sub, gd_array, gd_B_virt ! Here we split the memory half for the communication, half for replication IF (mp2_env%ri_mp2%block_size > 0) THEN best_block_size = mp2_env%ri_mp2%block_size - mem_for_rep = MAX(mem_min, mem_per_group-2.0_dp*mem_for_aK*best_block_size) + mem_for_rep = MAX(mem_min, mem_per_group - 2.0_dp*mem_for_aK*best_block_size) ELSE mem_for_rep = mem_per_group/2.0_dp END IF ! calculate the minimum replication group size according to the available memory min_integ_group_size = CEILING(2.0_dp*mem_for_iaK/mem_for_rep) - integ_group_size = MIN(min_integ_group_size, ngroup)-1 - DO iiB = min_integ_group_size+1, ngroup - integ_group_size = integ_group_size+1 + integ_group_size = MIN(min_integ_group_size, ngroup) - 1 + DO iiB = min_integ_group_size + 1, ngroup + integ_group_size = integ_group_size + 1 ! check that the ngroup is a multiple of integ_group_size IF (MOD(ngroup, integ_group_size) /= 0) CYCLE ! check that the integ group size is not too small (10% is empirical for now) @@ -1470,20 +1470,20 @@ SUBROUTINE mp2_ri_get_sizes(mp2_env, para_env, para_env_sub, gd_array, gd_B_virt END DO IF (.NOT. (mp2_env%ri_mp2%block_size > 0)) THEN - mem_for_comm = mem_per_group-2.0_dp*mem_for_iaK/best_integ_group_size + mem_for_comm = mem_per_group - 2.0_dp*mem_for_iaK/best_integ_group_size DO num_IJ_blocks = (homo/best_block_size) - num_IJ_blocks = (num_IJ_blocks*num_IJ_blocks-num_IJ_blocks)/2 + num_IJ_blocks = (num_IJ_blocks*num_IJ_blocks - num_IJ_blocks)/2 IF (num_IJ_blocks > ngroup .OR. best_block_size == 1) THEN EXIT ELSE - best_block_size = best_block_size-1 + best_block_size = best_block_size - 1 END IF END DO END IF ! check that best_block_size is not bigger than homo/2-1 - best_block_size = MIN(MAX(homo/2-1+MOD(homo, 2), 1), best_block_size) + best_block_size = MIN(MAX(homo/2 - 1 + MOD(homo, 2), 1), best_block_size) END IF integ_group_size = best_integ_group_size @@ -1606,30 +1606,30 @@ SUBROUTINE mp2_update_P_gamma(mp2_env, para_env_sub, gd_B_virtual, & ! divide the (ia|jb) integrals by Delta_ij^ab IF (.NOT. alpha_beta) THEN DO b = 1, my_B_size - b_global = b+my_B_virtual_start-1 + b_global = b + my_B_virtual_start - 1 DO a = 1, virtual local_ab(a, b) = -local_ab(a, b)/ & - (Eigenval(homo+a)+Eigenval(homo+b_global)-Eigenval(my_i+iiB-1)-Eigenval(my_j+jjB-1)) + (Eigenval(homo + a) + Eigenval(homo + b_global) - Eigenval(my_i + iiB - 1) - Eigenval(my_j + jjB - 1)) END DO END DO ! update diagonal part of P_ij P_ij_diag = -SUM(local_ab*t_ab)*factor ELSE DO b = 1, my_B_size_beta - b_global = b+my_B_virtual_start_beta-1 + b_global = b + my_B_virtual_start_beta - 1 DO a = 1, virtual local_ab(a, b) = -local_ab(a, b)/ & - (Eigenval(homo+a)+Eigenval_beta(homo_beta+b_global)-Eigenval(my_i+iiB-1)-Eigenval_beta(my_j+jjB-1)) + (Eigenval(homo + a) + Eigenval_beta(homo_beta + b_global) - Eigenval(my_i + iiB - 1) - Eigenval_beta(my_j + jjB - 1)) END DO END DO ! update diagonal part of P_ij P_ij_diag = -SUM(local_ab*local_ab) ! More integrals needed only for alpha-beta case: local_ba DO b = 1, my_B_size - b_global = b+my_B_virtual_start-1 + b_global = b + my_B_virtual_start - 1 DO a = 1, virtual_beta local_ba(a, b) = -local_ba(a, b)/ & - (Eigenval_beta(homo_beta+a)+Eigenval(homo+b_global)-Eigenval(my_i+iiB-1)-Eigenval_beta(my_j+jjB-1)) + (Eigenval_beta(homo_beta + a) + Eigenval(homo + b_global) - Eigenval(my_i + iiB - 1) - Eigenval_beta(my_j + jjB - 1)) END DO END DO ENDIF @@ -1641,16 +1641,16 @@ SUBROUTINE mp2_update_P_gamma(mp2_env, para_env_sub, gd_B_virtual, & CALL dgemm('T', 'N', my_B_size, my_B_size, virtual, 1.0_dp, & t_ab(:, :), virtual, local_ab(:, :), virtual, & 1.0_dp, mp2_env%ri_grad%P_ab(1:my_B_size, my_B_virtual_start:my_B_virtual_end), my_B_size) - mp2_env%ri_grad%P_ij(my_i+iiB-1, my_i+iiB-1) = & - mp2_env%ri_grad%P_ij(my_i+iiB-1, my_i+iiB-1)+P_ij_diag + mp2_env%ri_grad%P_ij(my_i + iiB - 1, my_i + iiB - 1) = & + mp2_env%ri_grad%P_ij(my_i + iiB - 1, my_i + iiB - 1) + P_ij_diag ENDIF ! Beta_beta case IF (beta_beta) THEN CALL dgemm('T', 'N', my_B_size, my_B_size, virtual, 1.0_dp, & t_ab(:, :), virtual, local_ab(:, :), virtual, & 1.0_dp, mp2_env%ri_grad%P_ab_beta(1:my_B_size, my_B_virtual_start:my_B_virtual_end), my_B_size) - mp2_env%ri_grad%P_ij_beta(my_i+iiB-1, my_i+iiB-1) = & - mp2_env%ri_grad%P_ij_beta(my_i+iiB-1, my_i+iiB-1)+P_ij_diag + mp2_env%ri_grad%P_ij_beta(my_i + iiB - 1, my_i + iiB - 1) = & + mp2_env%ri_grad%P_ij_beta(my_i + iiB - 1, my_i + iiB - 1) + P_ij_diag ENDIF ! Alpha_beta case IF (alpha_beta) THEN @@ -1658,14 +1658,14 @@ SUBROUTINE mp2_update_P_gamma(mp2_env, para_env_sub, gd_B_virtual, & local_ba(:, :), virtual_beta, local_ba(:, :), virtual_beta, 1.0_dp, & mp2_env%ri_grad%P_ab(1:my_B_size, my_B_virtual_start: & my_B_virtual_end), my_B_size) - mp2_env%ri_grad%P_ij(my_i+iiB-1, my_i+iiB-1) = & - mp2_env%ri_grad%P_ij(my_i+iiB-1, my_i+iiB-1)+P_ij_diag + mp2_env%ri_grad%P_ij(my_i + iiB - 1, my_i + iiB - 1) = & + mp2_env%ri_grad%P_ij(my_i + iiB - 1, my_i + iiB - 1) + P_ij_diag CALL dgemm('T', 'N', my_B_size_beta, my_B_size_beta, virtual, 1.0_dp, & local_ab(:, :), virtual, local_ab(:, :), virtual, 1.0_dp, & mp2_env%ri_grad%P_ab_beta(1:my_B_size_beta, my_B_virtual_start_beta: & my_B_virtual_end_beta), my_B_size_beta) - mp2_env%ri_grad%P_ij_beta(my_j+jjB-1, my_j+jjB-1) = & - mp2_env%ri_grad%P_ij_beta(my_j+jjB-1, my_j+jjB-1)+P_ij_diag + mp2_env%ri_grad%P_ij_beta(my_j + jjB - 1, my_j + jjB - 1) = & + mp2_env%ri_grad%P_ij_beta(my_j + jjB - 1, my_j + jjB - 1) + P_ij_diag ENDIF ! The summation is over unique pairs. In alpha-beta case, all pairs are unique: subroutine is called for ! both i^alpha,j^beta and i^beta,j^alpha. Formally, my_i can be equal to my_j, but they are different @@ -1677,8 +1677,8 @@ SUBROUTINE mp2_update_P_gamma(mp2_env, para_env_sub, gd_B_virtual, & t_ab(my_B_virtual_start:my_B_virtual_end, 1:my_B_size), my_B_size, & local_ab(:, :), virtual, & 1.0_dp, mp2_env%ri_grad%P_ab(1:my_B_size, 1:virtual), my_B_size) - mp2_env%ri_grad%P_ij(my_j+jjB-1, my_j+jjB-1) = & - mp2_env%ri_grad%P_ij(my_j+jjB-1, my_j+jjB-1)+P_ij_diag + mp2_env%ri_grad%P_ij(my_j + jjB - 1, my_j + jjB - 1) = & + mp2_env%ri_grad%P_ij(my_j + jjB - 1, my_j + jjB - 1) + P_ij_diag ENDIF ! Beta_beta_case IF (beta_beta) THEN @@ -1686,13 +1686,13 @@ SUBROUTINE mp2_update_P_gamma(mp2_env, para_env_sub, gd_B_virtual, & t_ab(my_B_virtual_start:my_B_virtual_end, 1:my_B_size), my_B_size, & local_ab(:, :), virtual, & 1.0_dp, mp2_env%ri_grad%P_ab_beta(1:my_B_size, 1:virtual), my_B_size) - mp2_env%ri_grad%P_ij_beta(my_j+jjB-1, my_j+jjB-1) = & - mp2_env%ri_grad%P_ij_beta(my_j+jjB-1, my_j+jjB-1)+P_ij_diag + mp2_env%ri_grad%P_ij_beta(my_j + jjB - 1, my_j + jjB - 1) = & + mp2_env%ri_grad%P_ij_beta(my_j + jjB - 1, my_j + jjB - 1) + P_ij_diag ENDIF END IF - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_send = sub_proc_map(para_env_sub%mepos+proc_shift) - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_send = sub_proc_map(para_env_sub%mepos + proc_shift) + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) ! Alpha-alpha, beta-beta, closed shell IF (.NOT. alpha_beta) THEN CALL get_group_dist(gd_B_virtual, proc_receive, rec_B_virtual_start, rec_B_virtual_end, rec_B_size) @@ -1772,10 +1772,10 @@ SUBROUTINE mp2_update_P_gamma(mp2_env, para_env_sub, gd_B_virtual, & ! Alpha_alpha or closed-shell case IF (((.NOT. open_ss) .AND. (.NOT. alpha_beta)) .OR. alpha_alpha) & - mp2_env%ri_grad%P_ab(:, :) = mp2_env%ri_grad%P_ab+external_ab + mp2_env%ri_grad%P_ab(:, :) = mp2_env%ri_grad%P_ab + external_ab ! Beta_beta case IF (beta_beta) & - mp2_env%ri_grad%P_ab_beta(:, :) = mp2_env%ri_grad%P_ab_beta+external_ab + mp2_env%ri_grad%P_ab_beta(:, :) = mp2_env%ri_grad%P_ab_beta + external_ab DEALLOCATE (external_ab) DEALLOCATE (send_ab) @@ -1808,9 +1808,9 @@ SUBROUTINE mp2_update_P_gamma(mp2_env, para_env_sub, gd_B_virtual, & ALLOCATE (external_ab(my_B_size, dimen_RI)) external_ab = 0.0_dp ! - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_send = sub_proc_map(para_env_sub%mepos+proc_shift) - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_send = sub_proc_map(para_env_sub%mepos + proc_shift) + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) CALL get_group_dist(gd_B_virtual, proc_receive, rec_B_virtual_start, rec_B_virtual_end, rec_B_size) @@ -1827,7 +1827,7 @@ SUBROUTINE mp2_update_P_gamma(mp2_env, para_env_sub, gd_B_virtual, & ! Alpha-alpha, beta-beta and closed shell Y_i_aP(1:my_B_size, 1:dimen_RI, iiB) = & - Y_i_aP(1:my_B_size, 1:dimen_RI, iiB)+external_ab + Y_i_aP(1:my_B_size, 1:dimen_RI, iiB) + external_ab DEALLOCATE (send_ab) ELSE ! Alpha-beta case @@ -1840,7 +1840,7 @@ SUBROUTINE mp2_update_P_gamma(mp2_env, para_env_sub, gd_B_virtual, & 0.0_dp, send_ab(1:send_B_size, 1:dimen_RI), send_B_size) CALL mp_sendrecv(send_ab, proc_send, external_ab, proc_receive, para_env_sub%group) Y_i_aP(1:my_B_size, 1:dimen_RI, iiB) = & - Y_i_aP(1:my_B_size, 1:dimen_RI, iiB)+external_ab + Y_i_aP(1:my_B_size, 1:dimen_RI, iiB) + external_ab DEALLOCATE (send_ab) ENDIF END DO @@ -1850,9 +1850,9 @@ SUBROUTINE mp2_update_P_gamma(mp2_env, para_env_sub, gd_B_virtual, & ! For beta-beta part (in alpha-beta case) we need a new parallel code ALLOCATE (external_ab(my_B_size_beta, dimen_RI)) external_ab = 0.0_dp - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_send = sub_proc_map(para_env_sub%mepos+proc_shift) - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_send = sub_proc_map(para_env_sub%mepos + proc_shift) + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) CALL get_group_dist(gd_B_virtual_beta, proc_send, send_B_virtual_start, send_B_virtual_end, send_B_size) ALLOCATE (send_ab(send_B_size, dimen_RI)) @@ -1864,7 +1864,7 @@ SUBROUTINE mp2_update_P_gamma(mp2_env, para_env_sub, gd_B_virtual, & 0.0_dp, send_ab(1:send_B_size, 1:dimen_RI), send_B_size) CALL mp_sendrecv(send_ab, proc_send, external_ab, proc_receive, para_env_sub%group) Y_j_aP(1:my_B_size_beta, 1:dimen_RI, jjB) = & - Y_j_aP(1:my_B_size_beta, 1:dimen_RI, jjB)+external_ab + Y_j_aP(1:my_B_size_beta, 1:dimen_RI, jjB) + external_ab DEALLOCATE (send_ab) END DO @@ -1878,9 +1878,9 @@ SUBROUTINE mp2_update_P_gamma(mp2_env, para_env_sub, gd_B_virtual, & local_i_aL(1:dimen_RI, 1:my_B_size, iiB), dimen_RI, & 1.0_dp, Y_j_aP(1:my_B_size, 1:dimen_RI, jjB), my_B_size) - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_send = sub_proc_map(para_env_sub%mepos+proc_shift) - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_send = sub_proc_map(para_env_sub%mepos + proc_shift) + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) CALL get_group_dist(gd_B_virtual, proc_receive, rec_B_virtual_start, rec_B_virtual_end, rec_B_size) @@ -1975,7 +1975,7 @@ SUBROUTINE mp2_redistribute_gamma(mp2_env, ij_index, my_B_size, & ! somethig to send ! start with myself CALL timeset(routineN//"_comm2_w", handle2) - DO irep = 0, num_integ_group-1 + DO irep = 0, num_integ_group - 1 Lstart_pos = ranges_info_array(1, irep, para_env_exchange%mepos) Lend_pos = ranges_info_array(2, irep, para_env_exchange%mepos) start_point = ranges_info_array(3, irep, para_env_exchange%mepos) @@ -1986,15 +1986,15 @@ SUBROUTINE mp2_redistribute_gamma(mp2_env, ij_index, my_B_size, & !$OMP mp2_env,my_i,iiB,my_B_size,Y_i_aP,& !$OMP alpha_alpha,beta_beta,open_shell) DO kkk = start_point, end_point - lll = kkk-start_point+Lstart_pos + lll = kkk - start_point + Lstart_pos IF (alpha_alpha .OR. (.NOT. open_shell)) THEN - mp2_env%ri_grad%Gamma_P_ia(my_i+iiB-1, 1:my_B_size, kkk) = & - mp2_env%ri_grad%Gamma_P_ia(my_i+iiB-1, 1:my_B_size, kkk)+ & + mp2_env%ri_grad%Gamma_P_ia(my_i + iiB - 1, 1:my_B_size, kkk) = & + mp2_env%ri_grad%Gamma_P_ia(my_i + iiB - 1, 1:my_B_size, kkk) + & Y_i_aP(1:my_B_size, lll, iiB) ENDIF IF (beta_beta) THEN - mp2_env%ri_grad%Gamma_P_ia_beta(my_i+iiB-1, 1:my_B_size, kkk) = & - mp2_env%ri_grad%Gamma_P_ia_beta(my_i+iiB-1, 1:my_B_size, kkk)+ & + mp2_env%ri_grad%Gamma_P_ia_beta(my_i + iiB - 1, 1:my_B_size, kkk) = & + mp2_env%ri_grad%Gamma_P_ia_beta(my_i + iiB - 1, 1:my_B_size, kkk) + & Y_i_aP(1:my_B_size, lll, iiB) ENDIF END DO @@ -2007,15 +2007,15 @@ SUBROUTINE mp2_redistribute_gamma(mp2_env, ij_index, my_B_size, & !$OMP mp2_env,my_j,jjB,my_B_size,Y_j_aP,& !$OMP alpha_alpha,beta_beta,open_shell) DO kkk = start_point, end_point - lll = kkk-start_point+Lstart_pos + lll = kkk - start_point + Lstart_pos IF (alpha_alpha .OR. (.NOT. open_shell)) THEN - mp2_env%ri_grad%Gamma_P_ia(my_j+jjB-1, 1:my_B_size, kkk) = & - mp2_env%ri_grad%Gamma_P_ia(my_j+jjB-1, 1:my_B_size, kkk)+ & + mp2_env%ri_grad%Gamma_P_ia(my_j + jjB - 1, 1:my_B_size, kkk) = & + mp2_env%ri_grad%Gamma_P_ia(my_j + jjB - 1, 1:my_B_size, kkk) + & Y_j_aP(1:my_B_size, lll, jjB) ENDIF IF (beta_beta) THEN - mp2_env%ri_grad%Gamma_P_ia_beta(my_j+jjB-1, 1:my_B_size, kkk) = & - mp2_env%ri_grad%Gamma_P_ia_beta(my_j+jjB-1, 1:my_B_size, kkk)+ & + mp2_env%ri_grad%Gamma_P_ia_beta(my_j + jjB - 1, 1:my_B_size, kkk) = & + mp2_env%ri_grad%Gamma_P_ia_beta(my_j + jjB - 1, 1:my_B_size, kkk) + & Y_j_aP(1:my_B_size, lll, jjB) ENDIF END DO @@ -2025,9 +2025,9 @@ SUBROUTINE mp2_redistribute_gamma(mp2_env, ij_index, my_B_size, & !$OMP SHARED(start_point,end_point,Lstart_pos,Lend_pos,& !$OMP mp2_env,my_j,jjB,my_B_size_beta,Y_j_aP) DO kkk = start_point, end_point - lll = kkk-start_point+Lstart_pos - mp2_env%ri_grad%Gamma_P_ia_beta(my_j+jjB-1, 1:my_B_size_beta, kkk) = & - mp2_env%ri_grad%Gamma_P_ia_beta(my_j+jjB-1, 1:my_B_size_beta, kkk)+ & + lll = kkk - start_point + Lstart_pos + mp2_env%ri_grad%Gamma_P_ia_beta(my_j + jjB - 1, 1:my_B_size_beta, kkk) = & + mp2_env%ri_grad%Gamma_P_ia_beta(my_j + jjB - 1, 1:my_B_size_beta, kkk) + & Y_j_aP(1:my_B_size_beta, lll, jjB) ENDDO !$OMP END PARALLEL DO @@ -2038,9 +2038,9 @@ SUBROUTINE mp2_redistribute_gamma(mp2_env, ij_index, my_B_size, & ! Y_i_aP(my_B_size,dimen_RI,block_size) - DO proc_shift = 1, para_env_exchange%num_pe-1 - proc_send = proc_map(para_env_exchange%mepos+proc_shift) - proc_receive = proc_map(para_env_exchange%mepos-proc_shift) + DO proc_shift = 1, para_env_exchange%num_pe - 1 + proc_send = proc_map(para_env_exchange%mepos + proc_shift) + proc_receive = proc_map(para_env_exchange%mepos - proc_shift) send_L_size = sizes_array(proc_send) IF (.NOT. alpha_beta) THEN @@ -2052,7 +2052,7 @@ SUBROUTINE mp2_redistribute_gamma(mp2_env, ij_index, my_B_size, & CALL timeset(routineN//"_comm2_w", handle2) BI_C_send = 0.0_dp IF (alpha_beta) BI_C_send_beta = 0.0_dp - DO irep = 0, num_integ_group-1 + DO irep = 0, num_integ_group - 1 Lstart_pos = ranges_info_array(1, irep, proc_send) Lend_pos = ranges_info_array(2, irep, proc_send) start_point = ranges_info_array(3, irep, proc_send) @@ -2062,7 +2062,7 @@ SUBROUTINE mp2_redistribute_gamma(mp2_env, ij_index, my_B_size, & !$OMP SHARED(start_point,end_point,Lstart_pos,Lend_pos,& !$OMP BI_C_send,iiB,my_B_size,Y_i_aP) DO kkk = start_point, end_point - lll = kkk-start_point+Lstart_pos + lll = kkk - start_point + Lstart_pos BI_C_send(iiB, 1:my_B_size, kkk) = Y_i_aP(1:my_B_size, lll, iiB) END DO !$OMP END PARALLEL DO @@ -2073,8 +2073,8 @@ SUBROUTINE mp2_redistribute_gamma(mp2_env, ij_index, my_B_size, & !$OMP SHARED(start_point,end_point,Lstart_pos,Lend_pos,my_block_size,& !$OMP BI_C_send,jjB,my_B_size,Y_j_aP) DO kkk = start_point, end_point - lll = kkk-start_point+Lstart_pos - BI_C_send(jjB+my_block_size, 1:my_B_size, kkk) = Y_j_aP(1:my_B_size, lll, jjB) + lll = kkk - start_point + Lstart_pos + BI_C_send(jjB + my_block_size, 1:my_B_size, kkk) = Y_j_aP(1:my_B_size, lll, jjB) END DO !$OMP END PARALLEL DO ELSE @@ -2082,7 +2082,7 @@ SUBROUTINE mp2_redistribute_gamma(mp2_env, ij_index, my_B_size, & !$OMP SHARED(start_point,end_point,Lstart_pos,Lend_pos,& !$OMP BI_C_send_beta,jjB,my_B_size_beta,Y_j_aP) DO kkk = start_point, end_point - lll = kkk-start_point+Lstart_pos + lll = kkk - start_point + Lstart_pos BI_C_send_beta(jjB, 1:my_B_size_beta, kkk) = Y_j_aP(1:my_B_size_beta, lll, jjB) END DO !$OMP END PARALLEL DO @@ -2096,7 +2096,7 @@ SUBROUTINE mp2_redistribute_gamma(mp2_env, ij_index, my_B_size, & IF (ij_index <= rec_ij_index) THEN ! we know that proc_receive has something to send for us, let's see what ij_counter_rec = & - (ij_index-MIN(1, integ_group_pos2color_sub(proc_receive)))*ngroup+integ_group_pos2color_sub(proc_receive) + (ij_index - MIN(1, integ_group_pos2color_sub(proc_receive)))*ngroup + integ_group_pos2color_sub(proc_receive) rec_i = ij_map(ij_counter_rec, 1) rec_j = ij_map(ij_counter_rec, 2) @@ -2122,7 +2122,7 @@ SUBROUTINE mp2_redistribute_gamma(mp2_env, ij_index, my_B_size, & ENDIF CALL timeset(routineN//"_comm2_w", handle2) - DO irep = 0, num_integ_group-1 + DO irep = 0, num_integ_group - 1 Lstart_pos = ranges_info_array(1, irep, para_env_exchange%mepos) Lend_pos = ranges_info_array(2, irep, para_env_exchange%mepos) start_point = ranges_info_array(3, irep, para_env_exchange%mepos) @@ -2134,13 +2134,13 @@ SUBROUTINE mp2_redistribute_gamma(mp2_env, ij_index, my_B_size, & !$OMP alpha_alpha,beta_beta,open_shell) DO kkk = start_point, end_point IF (alpha_alpha .OR. (.NOT. open_shell)) THEN - mp2_env%ri_grad%Gamma_P_ia(rec_i+iiB-1, 1:my_B_size, kkk) = & - mp2_env%ri_grad%Gamma_P_ia(rec_i+iiB-1, 1:my_B_size, kkk)+ & + mp2_env%ri_grad%Gamma_P_ia(rec_i + iiB - 1, 1:my_B_size, kkk) = & + mp2_env%ri_grad%Gamma_P_ia(rec_i + iiB - 1, 1:my_B_size, kkk) + & BI_C_rec(iiB, 1:my_B_size, kkk) ENDIF IF (beta_beta) THEN - mp2_env%ri_grad%Gamma_P_ia_beta(rec_i+iiB-1, 1:my_B_size, kkk) = & - mp2_env%ri_grad%Gamma_P_ia_beta(rec_i+iiB-1, 1:my_B_size, kkk)+ & + mp2_env%ri_grad%Gamma_P_ia_beta(rec_i + iiB - 1, 1:my_B_size, kkk) = & + mp2_env%ri_grad%Gamma_P_ia_beta(rec_i + iiB - 1, 1:my_B_size, kkk) + & BI_C_rec(iiB, 1:my_B_size, kkk) ENDIF END DO @@ -2154,14 +2154,14 @@ SUBROUTINE mp2_redistribute_gamma(mp2_env, ij_index, my_B_size, & !$OMP alpha_alpha,beta_beta,open_shell) DO kkk = start_point, end_point IF (alpha_alpha .OR. (.NOT. open_shell)) THEN - mp2_env%ri_grad%Gamma_P_ia(rec_j+jjB-1, 1:my_B_size, kkk) = & - mp2_env%ri_grad%Gamma_P_ia(rec_j+jjB-1, 1:my_B_size, kkk)+ & - BI_C_rec(jjB+rec_block_size, 1:my_B_size, kkk) + mp2_env%ri_grad%Gamma_P_ia(rec_j + jjB - 1, 1:my_B_size, kkk) = & + mp2_env%ri_grad%Gamma_P_ia(rec_j + jjB - 1, 1:my_B_size, kkk) + & + BI_C_rec(jjB + rec_block_size, 1:my_B_size, kkk) ENDIF IF (beta_beta) THEN - mp2_env%ri_grad%Gamma_P_ia_beta(rec_j+jjB-1, 1:my_B_size, kkk) = & - mp2_env%ri_grad%Gamma_P_ia_beta(rec_j+jjB-1, 1:my_B_size, kkk)+ & - BI_C_rec(jjB+rec_block_size, 1:my_B_size, kkk) + mp2_env%ri_grad%Gamma_P_ia_beta(rec_j + jjB - 1, 1:my_B_size, kkk) = & + mp2_env%ri_grad%Gamma_P_ia_beta(rec_j + jjB - 1, 1:my_B_size, kkk) + & + BI_C_rec(jjB + rec_block_size, 1:my_B_size, kkk) ENDIF END DO !$OMP END PARALLEL DO @@ -2170,8 +2170,8 @@ SUBROUTINE mp2_redistribute_gamma(mp2_env, ij_index, my_B_size, & !$OMP SHARED(start_point,end_point,& !$OMP mp2_env,rec_j,jjB,my_B_size_beta,BI_C_rec_beta) DO kkk = start_point, end_point - mp2_env%ri_grad%Gamma_P_ia_beta(rec_j+jjB-1, 1:my_B_size_beta, kkk) = & - mp2_env%ri_grad%Gamma_P_ia_beta(rec_j+jjB-1, 1:my_B_size_beta, kkk)+ & + mp2_env%ri_grad%Gamma_P_ia_beta(rec_j + jjB - 1, 1:my_B_size_beta, kkk) = & + mp2_env%ri_grad%Gamma_P_ia_beta(rec_j + jjB - 1, 1:my_B_size_beta, kkk) + & BI_C_rec_beta(jjB, 1:my_B_size_beta, kkk) END DO !$OMP END PARALLEL DO @@ -2203,15 +2203,15 @@ SUBROUTINE mp2_redistribute_gamma(mp2_env, ij_index, my_B_size, & ELSE ! noting to send check if we have to receive - DO proc_shift = 1, para_env_exchange%num_pe-1 - proc_send = proc_map(para_env_exchange%mepos+proc_shift) - proc_receive = proc_map(para_env_exchange%mepos-proc_shift) + DO proc_shift = 1, para_env_exchange%num_pe - 1 + proc_send = proc_map(para_env_exchange%mepos + proc_shift) + proc_receive = proc_map(para_env_exchange%mepos - proc_shift) rec_ij_index = num_ij_pairs(proc_receive) IF (ij_index <= rec_ij_index) THEN ! we know that proc_receive has something to send for us, let's see what ij_counter_rec = & - (ij_index-MIN(1, integ_group_pos2color_sub(proc_receive)))*ngroup+integ_group_pos2color_sub(proc_receive) + (ij_index - MIN(1, integ_group_pos2color_sub(proc_receive)))*ngroup + integ_group_pos2color_sub(proc_receive) rec_i = ij_map(ij_counter_rec, 1) rec_j = ij_map(ij_counter_rec, 2) @@ -2237,7 +2237,7 @@ SUBROUTINE mp2_redistribute_gamma(mp2_env, ij_index, my_B_size, & ENDIF CALL timeset(routineN//"_comm2_w", handle2) - DO irep = 0, num_integ_group-1 + DO irep = 0, num_integ_group - 1 Lstart_pos = ranges_info_array(1, irep, para_env_exchange%mepos) Lend_pos = ranges_info_array(2, irep, para_env_exchange%mepos) start_point = ranges_info_array(3, irep, para_env_exchange%mepos) @@ -2249,13 +2249,13 @@ SUBROUTINE mp2_redistribute_gamma(mp2_env, ij_index, my_B_size, & !$OMP alpha_alpha,beta_beta,open_shell) DO kkk = start_point, end_point IF (alpha_alpha .OR. (.NOT. open_shell)) THEN - mp2_env%ri_grad%Gamma_P_ia(rec_i+iiB-1, 1:my_B_size, kkk) = & - mp2_env%ri_grad%Gamma_P_ia(rec_i+iiB-1, 1:my_B_size, kkk)+ & + mp2_env%ri_grad%Gamma_P_ia(rec_i + iiB - 1, 1:my_B_size, kkk) = & + mp2_env%ri_grad%Gamma_P_ia(rec_i + iiB - 1, 1:my_B_size, kkk) + & BI_C_rec(iiB, 1:my_B_size, kkk) ENDIF IF (beta_beta) THEN - mp2_env%ri_grad%Gamma_P_ia_beta(rec_i+iiB-1, 1:my_B_size, kkk) = & - mp2_env%ri_grad%Gamma_P_ia_beta(rec_i+iiB-1, 1:my_B_size, kkk)+ & + mp2_env%ri_grad%Gamma_P_ia_beta(rec_i + iiB - 1, 1:my_B_size, kkk) = & + mp2_env%ri_grad%Gamma_P_ia_beta(rec_i + iiB - 1, 1:my_B_size, kkk) + & BI_C_rec(iiB, 1:my_B_size, kkk) ENDIF END DO @@ -2269,14 +2269,14 @@ SUBROUTINE mp2_redistribute_gamma(mp2_env, ij_index, my_B_size, & !$OMP alpha_alpha,beta_beta,open_shell) DO kkk = start_point, end_point IF (alpha_alpha .OR. (.NOT. open_shell)) THEN - mp2_env%ri_grad%Gamma_P_ia(rec_j+jjB-1, 1:my_B_size, kkk) = & - mp2_env%ri_grad%Gamma_P_ia(rec_j+jjB-1, 1:my_B_size, kkk)+ & - BI_C_rec(jjB+rec_block_size, 1:my_B_size, kkk) + mp2_env%ri_grad%Gamma_P_ia(rec_j + jjB - 1, 1:my_B_size, kkk) = & + mp2_env%ri_grad%Gamma_P_ia(rec_j + jjB - 1, 1:my_B_size, kkk) + & + BI_C_rec(jjB + rec_block_size, 1:my_B_size, kkk) ENDIF IF (beta_beta) THEN - mp2_env%ri_grad%Gamma_P_ia_beta(rec_j+jjB-1, 1:my_B_size, kkk) = & - mp2_env%ri_grad%Gamma_P_ia_beta(rec_j+jjB-1, 1:my_B_size, kkk)+ & - BI_C_rec(jjB+rec_block_size, 1:my_B_size, kkk) + mp2_env%ri_grad%Gamma_P_ia_beta(rec_j + jjB - 1, 1:my_B_size, kkk) = & + mp2_env%ri_grad%Gamma_P_ia_beta(rec_j + jjB - 1, 1:my_B_size, kkk) + & + BI_C_rec(jjB + rec_block_size, 1:my_B_size, kkk) ENDIF END DO !$OMP END PARALLEL DO @@ -2285,8 +2285,8 @@ SUBROUTINE mp2_redistribute_gamma(mp2_env, ij_index, my_B_size, & !$OMP SHARED(start_point,end_point,& !$OMP mp2_env,rec_j,jjB,my_B_size_beta,BI_C_rec_beta) DO kkk = start_point, end_point - mp2_env%ri_grad%Gamma_P_ia_beta(rec_j+jjB-1, 1:my_B_size_beta, kkk) = & - mp2_env%ri_grad%Gamma_P_ia_beta(rec_j+jjB-1, 1:my_B_size_beta, kkk)+ & + mp2_env%ri_grad%Gamma_P_ia_beta(rec_j + jjB - 1, 1:my_B_size_beta, kkk) = & + mp2_env%ri_grad%Gamma_P_ia_beta(rec_j + jjB - 1, 1:my_B_size_beta, kkk) + & BI_C_rec_beta(jjB, 1:my_B_size_beta, kkk) END DO !$OMP END PARALLEL DO @@ -2460,7 +2460,7 @@ SUBROUTINE quasi_degenerate_P_ij(mp2_env, Eigenval, homo, virtual, open_shell, & IF (iloops .EQ. 2) my_ijk = my_ijk_beta IF (ijk_index <= my_ijk) THEN ! work to be done - ijk_counter = (ijk_index-MIN(1, color_sub))*ngroup+color_sub + ijk_counter = (ijk_index - MIN(1, color_sub))*ngroup + color_sub IF (iloops .EQ. 1) THEN my_i = ijk_map(ijk_counter, 1) my_j = ijk_map(ijk_counter, 2) @@ -2474,7 +2474,7 @@ SUBROUTINE quasi_degenerate_P_ij(mp2_env, Eigenval, homo, virtual, open_shell, & local_i_aL = 0.0_dp local_j_al = 0.0_dp local_k_al = 0.0_dp - DO irep = 0, num_integ_group-1 + DO irep = 0, num_integ_group - 1 Lstart_pos = ranges_info_array(1, irep, para_env_exchange%mepos) Lend_pos = ranges_info_array(2, irep, para_env_exchange%mepos) start_point = ranges_info_array(3, irep, para_env_exchange%mepos) @@ -2497,9 +2497,9 @@ SUBROUTINE quasi_degenerate_P_ij(mp2_env, Eigenval, homo, virtual, open_shell, & ENDIF END DO - DO proc_shift = 1, para_env_exchange%num_pe-1 - proc_send = proc_map(para_env_exchange%mepos+proc_shift) - proc_receive = proc_map(para_env_exchange%mepos-proc_shift) + DO proc_shift = 1, para_env_exchange%num_pe - 1 + proc_send = proc_map(para_env_exchange%mepos + proc_shift) + proc_receive = proc_map(para_env_exchange%mepos - proc_shift) send_ijk_index = num_ijk(proc_send) IF (iloops .EQ. 2) send_ijk_index = num_ijk_beta(proc_send) @@ -2509,8 +2509,8 @@ SUBROUTINE quasi_degenerate_P_ij(mp2_env, Eigenval, homo, virtual, open_shell, & IF (ijk_index <= send_ijk_index) THEN ! something to send - ijk_counter_send = (ijk_index-MIN(1, integ_group_pos2color_sub(proc_send)))* & - ngroup+integ_group_pos2color_sub(proc_send) + ijk_counter_send = (ijk_index - MIN(1, integ_group_pos2color_sub(proc_send)))* & + ngroup + integ_group_pos2color_sub(proc_send) IF (iloops .EQ. 1) THEN send_i = ijk_map(ijk_counter_send, 1) send_j = ijk_map(ijk_counter_send, 2) @@ -2540,7 +2540,7 @@ SUBROUTINE quasi_degenerate_P_ij(mp2_env, Eigenval, homo, virtual, open_shell, & BI_C_rec(1:rec_L_size, 1:size_B_i, 1:1), proc_receive, & para_env_exchange%group) END IF - DO irep = 0, num_integ_group-1 + DO irep = 0, num_integ_group - 1 Lstart_pos = ranges_info_array(1, irep, proc_receive) Lend_pos = ranges_info_array(2, irep, proc_receive) start_point = ranges_info_array(3, irep, proc_receive) @@ -2567,7 +2567,7 @@ SUBROUTINE quasi_degenerate_P_ij(mp2_env, Eigenval, homo, virtual, open_shell, & BI_C_rec(1:rec_L_size, 1:size_B_j, 1:1), proc_receive, & para_env_exchange%group) END IF - DO irep = 0, num_integ_group-1 + DO irep = 0, num_integ_group - 1 Lstart_pos = ranges_info_array(1, irep, proc_receive) Lend_pos = ranges_info_array(2, irep, proc_receive) start_point = ranges_info_array(3, irep, proc_receive) @@ -2605,7 +2605,7 @@ SUBROUTINE quasi_degenerate_P_ij(mp2_env, Eigenval, homo, virtual, open_shell, & BI_C_rec(1:rec_L_size, 1:size_B_k, 1:1), proc_receive, & para_env_exchange%group) END IF - DO irep = 0, num_integ_group-1 + DO irep = 0, num_integ_group - 1 Lstart_pos = ranges_info_array(1, irep, proc_receive) Lend_pos = ranges_info_array(2, irep, proc_receive) start_point = ranges_info_array(3, irep, proc_receive) @@ -2632,9 +2632,9 @@ SUBROUTINE quasi_degenerate_P_ij(mp2_env, Eigenval, homo, virtual, open_shell, & local_i_aL(:, :, 1), dimen_RI, local_k_aL(:, :, 1), dimen_RI, & 0.0_dp, local_ab(my_B_virtual_start:my_B_virtual_end, 1:size_B_k), size_B_i) ENDIF - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_send = sub_proc_map(para_env_sub%mepos+proc_shift) - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_send = sub_proc_map(para_env_sub%mepos + proc_shift) + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) IF (iloops .EQ. 1) THEN CALL get_group_dist(gd_B_virtual, proc_receive, rec_B_virtual_start, rec_B_virtual_end, rec_B_size) @@ -2663,41 +2663,41 @@ SUBROUTINE quasi_degenerate_P_ij(mp2_env, Eigenval, homo, virtual, open_shell, & ! Alpha-alpha, beta-beta and closed shell IF (.NOT. alpha_beta) THEN DO b = 1, size_B_k - b_global = b+my_B_virtual_start-1 + b_global = b + my_B_virtual_start - 1 DO a = 1, my_B_size - a_global = a+my_B_virtual_start-1 - t_ab(a_global, b) = (amp_fac*local_ab(a_global, b)-local_ab(b_global, a))/ & - (Eigenval(my_i)+Eigenval(my_k)-Eigenval(homo+a_global)-Eigenval(homo+b_global)) + a_global = a + my_B_virtual_start - 1 + t_ab(a_global, b) = (amp_fac*local_ab(a_global, b) - local_ab(b_global, a))/ & + (Eigenval(my_i) + Eigenval(my_k) - Eigenval(homo + a_global) - Eigenval(homo + b_global)) END DO END DO ELSE IF (iloops .EQ. 1) THEN ! Alpha-beta for alpha-alpha density DO b = 1, size_B_k - b_global = b+my_B_virtual_start_beta-1 + b_global = b + my_B_virtual_start_beta - 1 DO a = 1, my_B_size - a_global = a+my_B_virtual_start-1 + a_global = a + my_B_virtual_start - 1 t_ab(a_global, b) = local_ab(a_global, b)/ & - (Eigenval(my_i)+Eigenval_beta(my_k)-Eigenval(homo+a_global)- & - Eigenval_beta(homo_beta+b_global)) + (Eigenval(my_i) + Eigenval_beta(my_k) - Eigenval(homo + a_global) - & + Eigenval_beta(homo_beta + b_global)) END DO END DO ELSE ! Alpha-beta for beta-beta density DO b = 1, size_B_k - b_global = b+my_B_virtual_start-1 + b_global = b + my_B_virtual_start - 1 DO a = 1, my_B_size_beta - a_global = a+my_B_virtual_start_beta-1 + a_global = a + my_B_virtual_start_beta - 1 t_ab(a_global, b) = local_ab(a_global, b)/ & - (Eigenval_beta(my_i)+Eigenval(my_k)-Eigenval_beta(homo_beta+a_global)- & - Eigenval(homo+b_global)) + (Eigenval_beta(my_i) + Eigenval(my_k) - Eigenval_beta(homo_beta + a_global) - & + Eigenval(homo + b_global)) END DO END DO ENDIF ENDIF IF (.NOT. alpha_beta) THEN - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_send = sub_proc_map(para_env_sub%mepos+proc_shift) - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_send = sub_proc_map(para_env_sub%mepos + proc_shift) + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) CALL get_group_dist(gd_B_virtual, proc_receive, rec_B_virtual_start, rec_B_virtual_end, rec_B_size) CALL get_group_dist(gd_B_virtual, proc_send, send_B_virtual_start, send_B_virtual_end, send_B_size) @@ -2707,11 +2707,11 @@ SUBROUTINE quasi_degenerate_P_ij(mp2_env, Eigenval, homo, virtual, open_shell, & external_ab(1:size_B_i, 1:rec_B_size), proc_receive, para_env_sub%group) DO b = 1, my_B_size - b_global = b+my_B_virtual_start-1 + b_global = b + my_B_virtual_start - 1 DO a = 1, rec_B_size - a_global = a+rec_B_virtual_start-1 - t_ab(a_global, b) = (amp_fac*local_ab(a_global, b)-external_ab(b, a))/ & - (Eigenval(my_i)+Eigenval(my_k)-Eigenval(homo+a_global)-Eigenval(homo+b_global)) + a_global = a + rec_B_virtual_start - 1 + t_ab(a_global, b) = (amp_fac*local_ab(a_global, b) - external_ab(b, a))/ & + (Eigenval(my_i) + Eigenval(my_k) - Eigenval(homo + a_global) - Eigenval(homo + b_global)) END DO END DO @@ -2734,9 +2734,9 @@ SUBROUTINE quasi_degenerate_P_ij(mp2_env, Eigenval, homo, virtual, open_shell, & 0.0_dp, local_ab(my_B_virtual_start:my_B_virtual_end, 1:size_B_k), size_B_j) ENDIF - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_send = sub_proc_map(para_env_sub%mepos+proc_shift) - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_send = sub_proc_map(para_env_sub%mepos + proc_shift) + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) IF (iloops .EQ. 1) THEN CALL get_group_dist(gd_B_virtual, proc_receive, rec_B_virtual_start, rec_B_virtual_end, rec_B_size) @@ -2763,32 +2763,32 @@ SUBROUTINE quasi_degenerate_P_ij(mp2_env, Eigenval, homo, virtual, open_shell, & ! Alpha-alpha, beta-beta and closed shell IF (.NOT. alpha_beta) THEN DO b = 1, size_B_k - b_global = b+my_B_virtual_start-1 + b_global = b + my_B_virtual_start - 1 DO a = 1, my_B_size - a_global = a+my_B_virtual_start-1 + a_global = a + my_B_virtual_start - 1 local_ab(a_global, b) = local_ab(a_global, b)/ & - (Eigenval(my_j)+Eigenval(my_k)-Eigenval(homo+a_global)-Eigenval(homo+b_global)) + (Eigenval(my_j) + Eigenval(my_k) - Eigenval(homo + a_global) - Eigenval(homo + b_global)) END DO END DO ELSE IF (iloops .EQ. 1) THEN ! Alpha-beta for alpha-alpha density DO b = 1, size_B_k - b_global = b+my_B_virtual_start_beta-1 + b_global = b + my_B_virtual_start_beta - 1 DO a = 1, my_B_size - a_global = a+my_B_virtual_start-1 + a_global = a + my_B_virtual_start - 1 local_ab(a_global, b) = local_ab(a_global, b)/ & - (Eigenval(my_j)+Eigenval_beta(my_k)-Eigenval(homo+a_global)- & - Eigenval_beta(homo_beta+b_global)) + (Eigenval(my_j) + Eigenval_beta(my_k) - Eigenval(homo + a_global) - & + Eigenval_beta(homo_beta + b_global)) END DO END DO ELSE ! Alpha-beta for beta-beta density DO b = 1, size_B_k - b_global = b+my_B_virtual_start-1 + b_global = b + my_B_virtual_start - 1 DO a = 1, my_B_size_beta - a_global = a+my_B_virtual_start_beta-1 + a_global = a + my_B_virtual_start_beta - 1 local_ab(a_global, b) = local_ab(a_global, b)/ & - (Eigenval_beta(my_j)+Eigenval(my_k)-Eigenval_beta(homo_beta+a_global)- & - Eigenval(homo+b_global)) + (Eigenval_beta(my_j) + Eigenval(my_k) - Eigenval_beta(homo_beta + a_global) - & + Eigenval(homo + b_global)) END DO END DO ENDIF @@ -2799,25 +2799,25 @@ SUBROUTINE quasi_degenerate_P_ij(mp2_env, Eigenval, homo, virtual, open_shell, & P_ij_elem = P_ij_elem*2.0_dp ENDIF IF ((beta_beta) .OR. (iloops .EQ. 2)) THEN - mp2_env%ri_grad%P_ij_beta(my_i, my_j) = mp2_env%ri_grad%P_ij_beta(my_i, my_j)-P_ij_elem - mp2_env%ri_grad%P_ij_beta(my_j, my_i) = mp2_env%ri_grad%P_ij_beta(my_j, my_i)-P_ij_elem + mp2_env%ri_grad%P_ij_beta(my_i, my_j) = mp2_env%ri_grad%P_ij_beta(my_i, my_j) - P_ij_elem + mp2_env%ri_grad%P_ij_beta(my_j, my_i) = mp2_env%ri_grad%P_ij_beta(my_j, my_i) - P_ij_elem ELSE - mp2_env%ri_grad%P_ij(my_i, my_j) = mp2_env%ri_grad%P_ij(my_i, my_j)-P_ij_elem - mp2_env%ri_grad%P_ij(my_j, my_i) = mp2_env%ri_grad%P_ij(my_j, my_i)-P_ij_elem + mp2_env%ri_grad%P_ij(my_i, my_j) = mp2_env%ri_grad%P_ij(my_i, my_j) - P_ij_elem + mp2_env%ri_grad%P_ij(my_j, my_i) = mp2_env%ri_grad%P_ij(my_j, my_i) - P_ij_elem ENDIF CALL timestop(handle2) ELSE ! no work to be done, possible messeges to be exchanged - DO proc_shift = 1, para_env_exchange%num_pe-1 - proc_send = proc_map(para_env_exchange%mepos+proc_shift) - proc_receive = proc_map(para_env_exchange%mepos-proc_shift) + DO proc_shift = 1, para_env_exchange%num_pe - 1 + proc_send = proc_map(para_env_exchange%mepos + proc_shift) + proc_receive = proc_map(para_env_exchange%mepos - proc_shift) send_ijk_index = num_ijk(proc_send) IF (iloops .EQ. 2) send_ijk_index = num_ijk_beta(proc_send) IF (ijk_index <= send_ijk_index) THEN ! somethig to send - ijk_counter_send = (ijk_index-MIN(1, integ_group_pos2color_sub(proc_send)))*ngroup+ & + ijk_counter_send = (ijk_index - MIN(1, integ_group_pos2color_sub(proc_send)))*ngroup + & integ_group_pos2color_sub(proc_send) IF (iloops .EQ. 1) THEN send_i = ijk_map(ijk_counter_send, 1) @@ -2953,9 +2953,9 @@ SUBROUTINE Find_quasi_degenerate_ij(my_ijk, homo, Eigenval, mp2_env, ijk_map, un num_sing_ij = 0 DO iiB = 1, homo ! diagonal elements already updated - DO jjB = iiB+1, homo - IF (ABS(Eigenval(jjB)-Eigenval(iiB)) < mp2_env%ri_mp2%eps_canonical) & - num_sing_ij = num_sing_ij+1 + DO jjB = iiB + 1, homo + IF (ABS(Eigenval(jjB) - Eigenval(iiB)) < mp2_env%ri_mp2%eps_canonical) & + num_sing_ij = num_sing_ij + 1 END DO END DO IF (.NOT. beta_beta) THEN @@ -2977,19 +2977,19 @@ SUBROUTINE Find_quasi_degenerate_ij(my_ijk, homo, Eigenval, mp2_env, ijk_map, un ijk_counter = 0 DO iiB = 1, homo ! diagonal elements already updated - DO jjB = iiB+1, homo - IF (ABS(Eigenval(jjB)-Eigenval(iiB)) >= mp2_env%ri_mp2%eps_canonical) CYCLE + DO jjB = iiB + 1, homo + IF (ABS(Eigenval(jjB) - Eigenval(iiB)) >= mp2_env%ri_mp2%eps_canonical) CYCLE DO kkB = 1, my_homo - ijk_counter = ijk_counter+1 + ijk_counter = ijk_counter + 1 ijk_map(ijk_counter, 1) = iiB ijk_map(ijk_counter, 2) = jjB ijk_map(ijk_counter, 3) = kkB - IF (MOD(ijk_counter, ngroup) == color_sub) my_ijk = my_ijk+1 + IF (MOD(ijk_counter, ngroup) == color_sub) my_ijk = my_ijk + 1 END DO END DO END DO - ALLOCATE (num_ijk(0:para_env_exchange%num_pe-1)) + ALLOCATE (num_ijk(0:para_env_exchange%num_pe - 1)) num_ijk = 0 num_ijk(para_env_exchange%mepos) = my_ijk CALL mp_sum(num_ijk, para_env_exchange%group) @@ -3000,9 +3000,9 @@ SUBROUTINE Find_quasi_degenerate_ij(my_ijk, homo, Eigenval, mp2_env, ijk_map, un num_sing_ij = 0 DO iiB = 1, homo_beta ! diagonal elements already updated - DO jjB = iiB+1, homo_beta - IF (ABS(Eigenval_beta(jjB)-Eigenval_beta(iiB)) < mp2_env%ri_mp2%eps_canonical) & - num_sing_ij = num_sing_ij+1 + DO jjB = iiB + 1, homo_beta + IF (ABS(Eigenval_beta(jjB) - Eigenval_beta(iiB)) < mp2_env%ri_mp2%eps_canonical) & + num_sing_ij = num_sing_ij + 1 END DO END DO ! total number of elemets that have to be computed @@ -3013,18 +3013,18 @@ SUBROUTINE Find_quasi_degenerate_ij(my_ijk, homo, Eigenval, mp2_env, ijk_map, un ijk_counter = 0 DO iiB = 1, homo_beta ! diagonal elements already updated - DO jjB = iiB+1, homo_beta - IF (ABS(Eigenval_beta(jjB)-Eigenval_beta(iiB)) >= mp2_env%ri_mp2%eps_canonical) CYCLE + DO jjB = iiB + 1, homo_beta + IF (ABS(Eigenval_beta(jjB) - Eigenval_beta(iiB)) >= mp2_env%ri_mp2%eps_canonical) CYCLE DO kkB = 1, homo - ijk_counter = ijk_counter+1 + ijk_counter = ijk_counter + 1 ijk_map_beta(ijk_counter, 1) = iiB ijk_map_beta(ijk_counter, 2) = jjB ijk_map_beta(ijk_counter, 3) = kkB - IF (MOD(ijk_counter, ngroup) == color_sub) my_ijk_beta = my_ijk_beta+1 + IF (MOD(ijk_counter, ngroup) == color_sub) my_ijk_beta = my_ijk_beta + 1 END DO END DO END DO - ALLOCATE (num_ijk_beta(0:para_env_exchange%num_pe-1)) + ALLOCATE (num_ijk_beta(0:para_env_exchange%num_pe - 1)) num_ijk_beta = 0 num_ijk_beta(para_env_exchange%mepos) = my_ijk_beta CALL mp_sum(num_ijk_beta, para_env_exchange%group) diff --git a/src/mp2_ri_grad.F b/src/mp2_ri_grad.F index cbf3bc693b..5bf35e188e 100644 --- a/src/mp2_ri_grad.F +++ b/src/mp2_ri_grad.F @@ -216,10 +216,10 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par IF (PRESENT(homo_beta) .AND. PRESENT(Eigenval_beta)) alpha_beta = .TRUE. dimen = nmo - virtual = dimen-homo + virtual = dimen - homo potential_type = mp2_env%potential_parameter%potential_type omega = mp2_env%potential_parameter%omega - IF (alpha_beta) virtual_beta = dimen-homo_beta + IF (alpha_beta) virtual_beta = dimen - homo_beta eps_filter = mp2_env%mp2_gpw%eps_filter NULLIFY (mo_coeff_o, mo_coeff_v, G_P_ia, ks_env) mo_coeff_o => mp2_env%ri_grad%mo_coeff_o @@ -236,7 +236,7 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par itmp = get_limit(dimen_RI, para_env_sub%num_pe, para_env_sub%mepos) my_P_start = itmp(1) my_P_end = itmp(2) - my_P_size = itmp(2)-itmp(1)+1 + my_P_size = itmp(2) - itmp(1) + 1 ALLOCATE (G_PQ_local(dimen_RI, my_group_L_size)) G_PQ_local = 0.0_dp @@ -244,7 +244,7 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par G_PQ_local(my_P_start:my_P_end, 1:my_group_L_size) = mp2_env%ri_grad%Gamma_PQ ELSE G_PQ_local(my_P_start:my_P_end, 1:my_group_L_size) = & - 0.50_dp*(mp2_env%ri_grad%Gamma_PQ+mp2_env%ri_grad%Gamma_PQ_beta) + 0.50_dp*(mp2_env%ri_grad%Gamma_PQ + mp2_env%ri_grad%Gamma_PQ_beta) ENDIF DEALLOCATE (mp2_env%ri_grad%Gamma_PQ) IF (alpha_beta) THEN @@ -298,7 +298,7 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par ALLOCATE (mat_munu_local(my_group_L_size)) L_counter = 0 DO LLL = my_group_L_start, my_group_L_end - L_counter = L_counter+1 + L_counter = L_counter + 1 ALLOCATE (matrix_P_munu_local(L_counter)%matrix) ALLOCATE (mat_munu_local(L_counter)%matrix) CALL dbcsr_create(matrix_P_munu_local(L_counter)%matrix, template=mat_munu%matrix, & @@ -337,7 +337,7 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par L_counter = 0 DO LLL = my_group_L_start, my_group_L_end - L_counter = L_counter+1 + L_counter = L_counter + 1 ! we recompute matrix_P_inu CALL dbcsr_multiply("N", "T", 1.0_dp, mo_coeff_v, G_P_ia(L_counter)%matrix, & 0.0_dp, matrix_P_inu%matrix, filter_eps=eps_filter) @@ -360,9 +360,9 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par ENDDO DO ikind = 1, SIZE(force) - force(ikind)%mp2_non_sep(:, :) = -4.0_dp*force_2c(ikind)%forces(:, :)+ & - force_3c_orb_mu(ikind)%forces(:, :)+ & - force_3c_orb_nu(ikind)%forces(:, :)+ & + force(ikind)%mp2_non_sep(:, :) = -4.0_dp*force_2c(ikind)%forces(:, :) + & + force_3c_orb_mu(ikind)%forces(:, :) + & + force_3c_orb_nu(ikind)%forces(:, :) + & force_3c_aux(ikind)%forces(:, :) END DO @@ -423,7 +423,7 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par L_counter = 0 DO LLL = my_group_L_start, my_group_L_end - L_counter = L_counter+1 + L_counter = L_counter + 1 IF (alpha_beta) THEN CALL G_P_transform_MO_to_AO(matrix_P_munu, matrix_P_munu_nosym, mat_munu, & @@ -528,7 +528,7 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par ALLOCATE (pab(ncoa, 1)) pab = 0.0_dp - I_ab(1:nsgfa(iset), 1) = -4.0_dp*G_PQ_local(offset+1:offset+nsgfa(iset), L_counter) + I_ab(1:nsgfa(iset), 1) = -4.0_dp*G_PQ_local(offset + 1:offset + nsgfa(iset), L_counter) CALL dgemm("N", "N", ncoa, 1, nsgfa(iset), & 1.0_dp, sphi_a(1, sgfa), SIZE(sphi_a, 1), & @@ -545,14 +545,14 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par tp(dir) = FLOOR(DOT_PRODUCT(cell%h_inv(dir, :), ra)*rs_v(igrid_level)%rs_grid%desc%npts(dir)) tp(dir) = MODULO(tp(dir), rs_v(igrid_level)%rs_grid%desc%npts(dir)) IF (rs_v(igrid_level)%rs_grid%desc%perd(dir) .NE. 1) THEN - lb(dir) = rs_v(igrid_level)%rs_grid%lb_local(dir)+rs_v(igrid_level)%rs_grid%desc%border - ub(dir) = rs_v(igrid_level)%rs_grid%ub_local(dir)-rs_v(igrid_level)%rs_grid%desc%border + lb(dir) = rs_v(igrid_level)%rs_grid%lb_local(dir) + rs_v(igrid_level)%rs_grid%desc%border + ub(dir) = rs_v(igrid_level)%rs_grid%ub_local(dir) - rs_v(igrid_level)%rs_grid%desc%border ELSE lb(dir) = rs_v(igrid_level)%rs_grid%lb_local(dir) ub(dir) = rs_v(igrid_level)%rs_grid%ub_local(dir) ENDIF ! distributed grid, only map if it is local to the grid - location(dir) = tp(dir)+rs_v(igrid_level)%rs_grid%desc%lb(dir) + location(dir) = tp(dir) + rs_v(igrid_level)%rs_grid%desc%lb(dir) ENDDO IF (lb(1) <= location(1) .AND. location(1) <= ub(1) .AND. & lb(2) <= location(2) .AND. location(2) <= ub(2) .AND. & @@ -564,11 +564,11 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par IF (MODULO(offset, para_env_sub%num_pe) == para_env_sub%mepos) map_it_here = .TRUE. ENDIF - offset = offset+nsgfa(iset) + offset = offset + nsgfa(iset) IF (map_it_here) THEN DO ipgf = 1, npgfa(iset) - na1 = (ipgf-1)*ncoset(la_max(iset))+1 + na1 = (ipgf - 1)*ncoset(la_max(iset)) + 1 na2 = ipgf*ncoset(la_max(iset)) igrid_level = gaussian_gridlevel(pw_env_sub%gridlevel_info, zeta(ipgf, iset)) @@ -580,7 +580,7 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par cube_info=pw_env_sub%cube_info(igrid_level), & hab=I_tmp2, & pab=pab, & - o1=na1-1, & + o1=na1 - 1, & o2=0, & map_consistent=.TRUE., & eps_gvg_rspace=dft_control%qs_control%eps_gvg_rspace, & @@ -604,9 +604,9 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par END DO force(ikind)%rho_elec(:, atom_a) = & - force(ikind)%rho_elec(:, atom_a)+force_a(:)+force_b + force(ikind)%rho_elec(:, atom_a) + force_a(:) + force_b IF (use_virial) THEN - virial%pv_virial = virial%pv_virial+my_virial_a+my_virial_b + virial%pv_virial = virial%pv_virial + my_virial_a + my_virial_b END IF END DO @@ -669,11 +669,11 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par h_stress(alpha, alpha) = -e_hartree DO beta = alpha, 3 h_stress(alpha, beta) = h_stress(alpha, beta) & - -2.0_dp*pw_integral_ab(rho_g%pw, dvg(beta)%pw)/fourpi + - 2.0_dp*pw_integral_ab(rho_g%pw, dvg(beta)%pw)/fourpi h_stress(beta, alpha) = h_stress(alpha, beta) END DO END DO - virial%pv_virial = virial%pv_virial+h_stress/REAL(para_env_sub%num_pe, dp) + virial%pv_virial = virial%pv_virial + h_stress/REAL(para_env_sub%num_pe, dp) CALL timestop(handle3) END IF @@ -709,11 +709,11 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par h_stress(alpha, alpha) = -e_hartree DO beta = alpha, 3 h_stress(alpha, beta) = h_stress(alpha, beta) & - -2.0_dp*pw_integral_ab(rho_g%pw, dvg(beta)%pw)/fourpi + - 2.0_dp*pw_integral_ab(rho_g%pw, dvg(beta)%pw)/fourpi h_stress(beta, alpha) = h_stress(alpha, beta) END DO END DO - virial%pv_virial = virial%pv_virial+h_stress/REAL(para_env_sub%num_pe, dp) + virial%pv_virial = virial%pv_virial + h_stress/REAL(para_env_sub%num_pe, dp) CALL timestop(handle3) END IF @@ -768,14 +768,14 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par skip_shell = .TRUE. DO iorb = 1, nsgfa(iset) - IF (iorb+offset == LLL) THEN + IF (iorb + offset == LLL) THEN I_ab(iorb, 1) = 1.0_dp skip_shell = .FALSE. END IF END DO IF (skip_shell) THEN - offset = offset+nsgfa(iset) + offset = offset + nsgfa(iset) DEALLOCATE (I_tmp2) DEALLOCATE (I_ab) DEALLOCATE (pab) @@ -796,14 +796,14 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par tp(dir) = FLOOR(DOT_PRODUCT(cell%h_inv(dir, :), ra)*rs_v(igrid_level)%rs_grid%desc%npts(dir)) tp(dir) = MODULO(tp(dir), rs_v(igrid_level)%rs_grid%desc%npts(dir)) IF (rs_v(igrid_level)%rs_grid%desc%perd(dir) .NE. 1) THEN - lb(dir) = rs_v(igrid_level)%rs_grid%lb_local(dir)+rs_v(igrid_level)%rs_grid%desc%border - ub(dir) = rs_v(igrid_level)%rs_grid%ub_local(dir)-rs_v(igrid_level)%rs_grid%desc%border + lb(dir) = rs_v(igrid_level)%rs_grid%lb_local(dir) + rs_v(igrid_level)%rs_grid%desc%border + ub(dir) = rs_v(igrid_level)%rs_grid%ub_local(dir) - rs_v(igrid_level)%rs_grid%desc%border ELSE lb(dir) = rs_v(igrid_level)%rs_grid%lb_local(dir) ub(dir) = rs_v(igrid_level)%rs_grid%ub_local(dir) ENDIF ! distributed grid, only map if it is local to the grid - location(dir) = tp(dir)+rs_v(igrid_level)%rs_grid%desc%lb(dir) + location(dir) = tp(dir) + rs_v(igrid_level)%rs_grid%desc%lb(dir) ENDDO IF (lb(1) <= location(1) .AND. location(1) <= ub(1) .AND. & lb(2) <= location(2) .AND. location(2) <= ub(2) .AND. & @@ -815,11 +815,11 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par IF (MODULO(offset, para_env_sub%num_pe) == para_env_sub%mepos) map_it_here = .TRUE. ENDIF - offset = offset+nsgfa(iset) + offset = offset + nsgfa(iset) IF (map_it_here) THEN DO ipgf = 1, npgfa(iset) - na1 = (ipgf-1)*ncoset(la_max(iset))+1 + na1 = (ipgf - 1)*ncoset(la_max(iset)) + 1 na2 = ipgf*ncoset(la_max(iset)) igrid_level = gaussian_gridlevel(pw_env_sub%gridlevel_info, zeta(ipgf, iset)) @@ -831,7 +831,7 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par cube_info=pw_env_sub%cube_info(igrid_level), & hab=I_tmp2, & pab=pab, & - o1=na1-1, & + o1=na1 - 1, & o2=0, & map_consistent=.TRUE., & eps_gvg_rspace=dft_control%qs_control%eps_gvg_rspace, & @@ -852,9 +852,9 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par END DO force(ikind)%rho_elec(:, atom_a) = & - force(ikind)%rho_elec(:, atom_a)+force_a(:)+force_b(:) + force(ikind)%rho_elec(:, atom_a) + force_a(:) + force_b(:) IF (use_virial) THEN - virial%pv_virial = virial%pv_virial+my_virial_a+my_virial_b + virial%pv_virial = virial%pv_virial + my_virial_a + my_virial_b END IF END DO @@ -1255,17 +1255,17 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, CALL cp_fm_set_all(L_mu_q, 0.0_dp) ! create all information array - ALLOCATE (pos_info(0:para_env%num_pe-1)) + ALLOCATE (pos_info(0:para_env%num_pe - 1)) pos_info = 0 pos_info(para_env%mepos) = para_env_sub%mepos CALL mp_sum(pos_info, para_env%group) - ALLOCATE (sub_proc_map(-para_env_sub%num_pe:2*para_env_sub%num_pe-1)) + ALLOCATE (sub_proc_map(-para_env_sub%num_pe:2*para_env_sub%num_pe - 1)) sub_proc_map = 0 - DO i = 0, para_env_sub%num_pe-1 + DO i = 0, para_env_sub%num_pe - 1 sub_proc_map(i) = i - sub_proc_map(-i-1) = para_env_sub%num_pe-i-1 - sub_proc_map(para_env_sub%num_pe+i) = i + sub_proc_map(-i - 1) = para_env_sub%num_pe - i - 1 + sub_proc_map(para_env_sub%num_pe + i) = i END DO ! get matrix information for the global @@ -1281,7 +1281,7 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, nprow = L_mu_q%matrix_struct%context%num_pe(1) npcol = L_mu_q%matrix_struct%context%num_pe(2) - ALLOCATE (grid_2_mepos(0:nprow-1, 0:npcol-1)) + ALLOCATE (grid_2_mepos(0:nprow - 1, 0:npcol - 1)) grid_2_mepos = 0 grid_2_mepos(myprow, mypcol) = para_env%mepos CALL mp_sum(grid_2_mepos, para_env%group) @@ -1299,13 +1299,13 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, nprow_1i = L1_mu_i%matrix_struct%context%num_pe(1) npcol_1i = L1_mu_i%matrix_struct%context%num_pe(2) - ALLOCATE (mepos_2_grid_1i(0:para_env_sub%num_pe-1, 2)) + ALLOCATE (mepos_2_grid_1i(0:para_env_sub%num_pe - 1, 2)) mepos_2_grid_1i = 0 mepos_2_grid_1i(para_env_sub%mepos, 1) = myprow_1i mepos_2_grid_1i(para_env_sub%mepos, 2) = mypcol_1i CALL mp_sum(mepos_2_grid_1i, para_env_sub%group) - ALLOCATE (sizes_1i(2, 0:para_env_sub%num_pe-1)) + ALLOCATE (sizes_1i(2, 0:para_env_sub%num_pe - 1)) sizes_1i = 0 sizes_1i(1, para_env_sub%mepos) = nrow_local_1i sizes_1i(2, para_env_sub%mepos) = ncol_local_1i @@ -1324,13 +1324,13 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, nprow_2a = L2_nu_a%matrix_struct%context%num_pe(1) npcol_2a = L2_nu_a%matrix_struct%context%num_pe(2) - ALLOCATE (mepos_2_grid_2a(0:para_env_sub%num_pe-1, 2)) + ALLOCATE (mepos_2_grid_2a(0:para_env_sub%num_pe - 1, 2)) mepos_2_grid_2a = 0 mepos_2_grid_2a(para_env_sub%mepos, 1) = myprow_2a mepos_2_grid_2a(para_env_sub%mepos, 2) = mypcol_2a CALL mp_sum(mepos_2_grid_2a, para_env_sub%group) - ALLOCATE (sizes_2a(2, 0:para_env_sub%num_pe-1)) + ALLOCATE (sizes_2a(2, 0:para_env_sub%num_pe - 1)) sizes_2a = 0 sizes_2a(1, para_env_sub%mepos) = nrow_local_2a sizes_2a(2, para_env_sub%mepos) = ncol_local_2a @@ -1350,17 +1350,17 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, NULLIFY (para_env_exchange) CALL cp_para_env_create(para_env_exchange, comm_exchange) ! crate the proc maps exchange and info - ALLOCATE (proc_map_ex(-para_env_exchange%num_pe:2*para_env_exchange%num_pe-1)) - DO i = 0, para_env_exchange%num_pe-1 + ALLOCATE (proc_map_ex(-para_env_exchange%num_pe:2*para_env_exchange%num_pe - 1)) + DO i = 0, para_env_exchange%num_pe - 1 proc_map_ex(i) = i - proc_map_ex(-i-1) = para_env_exchange%num_pe-i-1 - proc_map_ex(para_env_exchange%num_pe+i) = i + proc_map_ex(-i - 1) = para_env_exchange%num_pe - i - 1 + proc_map_ex(para_env_exchange%num_pe + i) = i END DO - ALLOCATE (pos_info_ex(0:para_env%num_pe-1)) + ALLOCATE (pos_info_ex(0:para_env%num_pe - 1)) pos_info_ex = 0 pos_info_ex(para_env%mepos) = para_env_exchange%mepos CALL mp_sum(pos_info_ex, para_env%group) - ALLOCATE (sizes(2, 0:para_env_exchange%num_pe-1)) + ALLOCATE (sizes(2, 0:para_env_exchange%num_pe - 1)) sizes = 0 sizes(1, para_env_exchange%mepos) = nrow_local sizes(2, para_env_exchange%mepos) = ncol_local @@ -1371,8 +1371,8 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, ! matrix L1_mu_i max_row_size = MAXVAL(sizes_1i(1, :)) max_col_size = MAXVAL(sizes_1i(2, :)) - ALLOCATE (row_indeces_info_1i(2, max_row_size, 0:para_env_sub%num_pe-1)) - ALLOCATE (col_indeces_info_1i(2, max_col_size, 0:para_env_sub%num_pe-1)) + ALLOCATE (row_indeces_info_1i(2, max_row_size, 0:para_env_sub%num_pe - 1)) + ALLOCATE (col_indeces_info_1i(2, max_col_size, 0:para_env_sub%num_pe - 1)) row_indeces_info_1i = 0 col_indeces_info_1i = 0 dummy_proc = 0 @@ -1402,8 +1402,8 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, ! matrix L2_nu_a max_row_size = MAXVAL(sizes_2a(1, :)) max_col_size = MAXVAL(sizes_2a(2, :)) - ALLOCATE (row_indeces_info_2a(2, max_row_size, 0:para_env_sub%num_pe-1)) - ALLOCATE (col_indeces_info_2a(2, max_col_size, 0:para_env_sub%num_pe-1)) + ALLOCATE (row_indeces_info_2a(2, max_row_size, 0:para_env_sub%num_pe - 1)) + ALLOCATE (col_indeces_info_2a(2, max_col_size, 0:para_env_sub%num_pe - 1)) row_indeces_info_2a = 0 col_indeces_info_2a = 0 ! row @@ -1418,7 +1418,7 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, END DO ! col DO jjB = 1, ncol_local_2a - j_global = col_indices_2a(jjB)+homo + j_global = col_indices_2a(jjB) + homo send_pcol = cp_fm_indxg2p(j_global, ncol_block, dummy_proc, & L_mu_q%matrix_struct%first_p_pos(2), npcol) j_local = cp_fm_indxg2l(j_global, ncol_block, dummy_proc, & @@ -1432,7 +1432,7 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, ! 1) define the map for sending data in the subgroup starting with L1_mu_i CALL timeset(routineN//"_subinfo", handle2) - ALLOCATE (map_send_size(0:para_env_sub%num_pe-1)) + ALLOCATE (map_send_size(0:para_env_sub%num_pe - 1)) map_send_size = 0 DO jjB = 1, ncol_local_1i ! j_global=col_indices_1i(jjB) @@ -1446,7 +1446,7 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, send_prow = row_indeces_info_1i(1, iiB, para_env_sub%mepos) proc_send = grid_2_mepos(send_prow, send_pcol) proc_send_sub = pos_info(proc_send) - map_send_size(proc_send_sub) = map_send_size(proc_send_sub)+1 + map_send_size(proc_send_sub) = map_send_size(proc_send_sub) + 1 END DO END DO ! and the same for L2_nu_a @@ -1462,11 +1462,11 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, send_prow = row_indeces_info_2a(1, iiB, para_env_sub%mepos) proc_send = grid_2_mepos(send_prow, send_pcol) proc_send_sub = pos_info(proc_send) - map_send_size(proc_send_sub) = map_send_size(proc_send_sub)+1 + map_send_size(proc_send_sub) = map_send_size(proc_send_sub) + 1 END DO END DO ! and exchange data in order to create map_rec_size - ALLOCATE (map_rec_size(0:para_env_sub%num_pe-1)) + ALLOCATE (map_rec_size(0:para_env_sub%num_pe - 1)) map_rec_size = 0 CALL mp_alltoall(map_send_size, map_rec_size, 1, para_env_sub%group) CALL timestop(handle2) @@ -1475,22 +1475,22 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, CALL timeset(routineN//"_sub_Bsend", handle2) ! count the number of messages (include myself) number_of_send = 0 - DO proc_shift = 0, para_env_sub%num_pe-1 - proc_send = sub_proc_map(para_env_sub%mepos+proc_shift) + DO proc_shift = 0, para_env_sub%num_pe - 1 + proc_send = sub_proc_map(para_env_sub%mepos + proc_shift) IF (map_send_size(proc_send) > 0) THEN - number_of_send = number_of_send+1 + number_of_send = number_of_send + 1 END IF END DO ! allocate the structure that will hold the messages to be sent ALLOCATE (buffer_send(number_of_send)) send_counter = 0 - ALLOCATE (proc_2_send_pos(0:para_env_sub%num_pe-1)) + ALLOCATE (proc_2_send_pos(0:para_env_sub%num_pe - 1)) proc_2_send_pos = 0 - DO proc_shift = 0, para_env_sub%num_pe-1 - proc_send = sub_proc_map(para_env_sub%mepos+proc_shift) + DO proc_shift = 0, para_env_sub%num_pe - 1 + proc_send = sub_proc_map(para_env_sub%mepos + proc_shift) size_send_buffer = map_send_size(proc_send) IF (map_send_size(proc_send) > 0) THEN - send_counter = send_counter+1 + send_counter = send_counter + 1 ! allocate the sending buffer (msg) ALLOCATE (buffer_send(send_counter)%msg(size_send_buffer)) buffer_send(send_counter)%msg = 0.0_dp @@ -1516,7 +1516,7 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, proc_send = grid_2_mepos(send_prow, send_pcol) proc_send_sub = pos_info(proc_send) send_counter = proc_2_send_pos(proc_send_sub) - iii_vet(send_counter) = iii_vet(send_counter)+1 + iii_vet(send_counter) = iii_vet(send_counter) + 1 iii = iii_vet(send_counter) buffer_send(send_counter)%msg(iii) = L1_mu_i%local_data(iiB, jjB) END DO @@ -1537,7 +1537,7 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, proc_send = grid_2_mepos(send_prow, send_pcol) proc_send_sub = pos_info(proc_send) send_counter = proc_2_send_pos(proc_send_sub) - iii_vet(send_counter) = iii_vet(send_counter)+1 + iii_vet(send_counter) = iii_vet(send_counter) + 1 iii = iii_vet(send_counter) buffer_send(send_counter)%msg(iii) = L2_nu_a%local_data(iiB, jjB) END DO @@ -1552,19 +1552,19 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, CALL timeset(routineN//"_sub_isendrecv", handle2) ! count the number of messages to be received number_of_rec = 0 - DO proc_shift = 0, para_env_sub%num_pe-1 - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 0, para_env_sub%num_pe - 1 + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) IF (map_rec_size(proc_receive) > 0) THEN - number_of_rec = number_of_rec+1 + number_of_rec = number_of_rec + 1 END IF END DO ALLOCATE (buffer_rec(number_of_rec)) rec_counter = 0 - DO proc_shift = 0, para_env_sub%num_pe-1 - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 0, para_env_sub%num_pe - 1 + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) size_rec_buffer = map_rec_size(proc_receive) IF (map_rec_size(proc_receive) > 0) THEN - rec_counter = rec_counter+1 + rec_counter = rec_counter + 1 ! prepare the buffer for receive ALLOCATE (buffer_rec(rec_counter)%msg(size_rec_buffer)) buffer_rec(rec_counter)%msg = 0.0_dp @@ -1580,10 +1580,10 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, ALLOCATE (req_send(number_of_send)) req_send = mp_request_null send_counter = 0 - DO proc_shift = 0, para_env_sub%num_pe-1 - proc_send = sub_proc_map(para_env_sub%mepos+proc_shift) + DO proc_shift = 0, para_env_sub%num_pe - 1 + proc_send = sub_proc_map(para_env_sub%mepos + proc_shift) IF (map_send_size(proc_send) > 0) THEN - send_counter = send_counter+1 + send_counter = send_counter + 1 IF (proc_send == para_env_sub%mepos) THEN buffer_rec(send_counter)%msg = buffer_send(send_counter)%msg ELSE @@ -1602,8 +1602,8 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, ! subgroup CALL timeset(routineN//"_Bcyclic", handle2) ! first allocata new structure - ALLOCATE (buffer_cyclic(0:para_env_exchange%num_pe-1)) - DO iproc = 0, para_env_exchange%num_pe-1 + ALLOCATE (buffer_cyclic(0:para_env_exchange%num_pe - 1)) + DO iproc = 0, para_env_exchange%num_pe - 1 rec_row_size = sizes(1, iproc) rec_col_size = sizes(2, iproc) ALLOCATE (buffer_cyclic(iproc)%msg(rec_row_size, rec_col_size)) @@ -1612,11 +1612,11 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, ! now collect data from other member of the subgroup and fill ! buffer_cyclic rec_counter = 0 - DO proc_shift = 0, para_env_sub%num_pe-1 - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 0, para_env_sub%num_pe - 1 + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) size_rec_buffer = map_rec_size(proc_receive) IF (map_rec_size(proc_receive) > 0) THEN - rec_counter = rec_counter+1 + rec_counter = rec_counter + 1 ! wait for the message IF (proc_receive /= para_env_sub%mepos) CALL mp_wait(buffer_rec(rec_counter)%msg_req) @@ -1641,7 +1641,7 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, proc_send = grid_2_mepos(send_prow, send_pcol) proc_send_sub = pos_info(proc_send) IF (proc_send_sub /= para_env_sub%mepos) CYCLE - iii = iii+1 + iii = iii + 1 ! i_local=cp_fm_indxg2l(i_global,nrow_block,dummy_proc,& ! L_mu_q%matrix_struct%first_p_pos(1),nprow) i_local = row_indeces_info_1i(2, iiB, proc_receive) @@ -1668,7 +1668,7 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, proc_send = grid_2_mepos(send_prow, send_pcol) proc_send_sub = pos_info(proc_send) IF (proc_send_sub /= para_env_sub%mepos) CYCLE - iii = iii+1 + iii = iii + 1 ! i_local=cp_fm_indxg2l(i_global,nrow_block,dummy_proc,& ! L_mu_q%matrix_struct%first_p_pos(1),nprow) i_local = row_indeces_info_2a(2, iiB, proc_receive) @@ -1702,8 +1702,8 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, ! 6) Start with ring communication CALL timeset(routineN//"_ring", handle2) - proc_send_static = proc_map_ex(para_env_exchange%mepos+1) - proc_receive_static = proc_map_ex(para_env_exchange%mepos-1) + proc_send_static = proc_map_ex(para_env_exchange%mepos + 1) + proc_receive_static = proc_map_ex(para_env_exchange%mepos - 1) max_row_size = MAXVAL(sizes(1, :)) max_col_size = MAXVAL(sizes(2, :)) ALLOCATE (mat_send(max_row_size, max_col_size)) @@ -1711,9 +1711,9 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, mat_send = 0.0_dp mat_send(1:nrow_local, 1:ncol_local) = buffer_cyclic(para_env_exchange%mepos)%msg(:, :) DEALLOCATE (buffer_cyclic(para_env_exchange%mepos)%msg) - DO proc_shift = 1, para_env_exchange%num_pe-1 - proc_send = proc_map_ex(para_env_exchange%mepos+proc_shift) - proc_receive = proc_map_ex(para_env_exchange%mepos-proc_shift) + DO proc_shift = 1, para_env_exchange%num_pe - 1 + proc_send = proc_map_ex(para_env_exchange%mepos + proc_shift) + proc_receive = proc_map_ex(para_env_exchange%mepos - proc_shift) rec_row_size = sizes(1, proc_receive) rec_col_size = sizes(2, proc_receive) @@ -1724,7 +1724,7 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, para_env_exchange%group) mat_send = 0.0_dp - mat_send(1:rec_row_size, 1:rec_col_size) = mat_rec(1:rec_row_size, 1:rec_col_size)+ & + mat_send(1:rec_row_size, 1:rec_col_size) = mat_rec(1:rec_row_size, 1:rec_col_size) + & buffer_cyclic(proc_receive)%msg(:, :) DEALLOCATE (buffer_cyclic(proc_receive)%msg) @@ -1794,13 +1794,13 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, ! diagonal elements alreasy updated IF (j_global == i_global) CYCLE ! check if the given element is above the threshold - IF (ABS(Eigenval(j_global)-Eigenval(i_global)) < mp2_env%ri_mp2%eps_canonical) CYCLE + IF (ABS(Eigenval(j_global) - Eigenval(i_global)) < mp2_env%ri_mp2%eps_canonical) CYCLE IF (.NOT. alpha_beta) THEN mp2_env%ri_grad%P_ij(i_global, j_global) = & - factor*fm_P_ij%local_data(iiB, jjB)/(Eigenval(j_global)-Eigenval(i_global)) + factor*fm_P_ij%local_data(iiB, jjB)/(Eigenval(j_global) - Eigenval(i_global)) ELSE mp2_env%ri_grad%P_ij_beta(i_global, j_global) = & - factor*fm_P_ij%local_data(iiB, jjB)/(Eigenval(j_global)-Eigenval(i_global)) + factor*fm_P_ij%local_data(iiB, jjB)/(Eigenval(j_global) - Eigenval(i_global)) ENDIF END DO END DO @@ -1871,17 +1871,17 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, IF (i_global <= homo .AND. j_global <= homo) THEN mp2_env%ri_grad%P_mo%local_data(iiB, jjB) = mp2_env%ri_grad%P_ij(i_global, j_global) END IF - IF ((my_B_virtual_start <= i_global-homo .AND. i_global-homo <= my_B_virtual_end) .AND. (j_global > homo)) THEN + IF ((my_B_virtual_start <= i_global - homo .AND. i_global - homo <= my_B_virtual_end) .AND. (j_global > homo)) THEN mp2_env%ri_grad%P_mo%local_data(iiB, jjB) = & - mp2_env%ri_grad%P_ab(i_global-homo-my_B_virtual_start+1, j_global-homo) + mp2_env%ri_grad%P_ab(i_global - homo - my_B_virtual_start + 1, j_global - homo) END IF ELSE IF (i_global <= homo .AND. j_global <= homo) THEN mp2_env%ri_grad%P_mo_beta%local_data(iiB, jjB) = mp2_env%ri_grad%P_ij_beta(i_global, j_global) END IF - IF ((my_B_virtual_start <= i_global-homo .AND. i_global-homo <= my_B_virtual_end) .AND. (j_global > homo)) THEN + IF ((my_B_virtual_start <= i_global - homo .AND. i_global - homo <= my_B_virtual_end) .AND. (j_global > homo)) THEN mp2_env%ri_grad%P_mo_beta%local_data(iiB, jjB) = & - mp2_env%ri_grad%P_ab_beta(i_global-homo-my_B_virtual_start+1, j_global-homo) + mp2_env%ri_grad%P_ab_beta(i_global - homo - my_B_virtual_start + 1, j_global - homo) END IF ENDIF END DO @@ -1895,22 +1895,22 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, ! send around the sub_group the local data and check if we ! have to update our block with external elements - ALLOCATE (mepos_2_grid(0:para_env_sub%num_pe-1, 2)) + ALLOCATE (mepos_2_grid(0:para_env_sub%num_pe - 1, 2)) mepos_2_grid = 0 mepos_2_grid(para_env_sub%mepos, 1) = myprow mepos_2_grid(para_env_sub%mepos, 2) = mypcol CALL mp_sum(mepos_2_grid, para_env_sub%group) - ALLOCATE (sizes(2, 0:para_env_sub%num_pe-1)) + ALLOCATE (sizes(2, 0:para_env_sub%num_pe - 1)) sizes = 0 sizes(1, para_env_sub%mepos) = nrow_local sizes(2, para_env_sub%mepos) = ncol_local CALL mp_sum(sizes, para_env_sub%group) ALLOCATE (ab_rec(nrow_local, ncol_local)) - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_send = sub_proc_map(para_env_sub%mepos+proc_shift) - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_send = sub_proc_map(para_env_sub%mepos + proc_shift) + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) send_prow = mepos_2_grid(proc_send, 1) send_pcol = mepos_2_grid(proc_send, 2) @@ -1926,7 +1926,7 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, i_global = cp_fm_indxl2g(iiB, nrow_block, send_prow, & mp2_env%ri_grad%P_mo%matrix_struct%first_p_pos(1), nprow) IF (i_global <= homo) CYCLE - i_global = i_global-homo + i_global = i_global - homo IF (.NOT. (my_B_virtual_start <= i_global .AND. i_global <= my_B_virtual_end)) CYCLE DO jjB = 1, send_col_size IF (.NOT. alpha_beta) THEN @@ -1937,11 +1937,11 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, mp2_env%ri_grad%P_mo_beta%matrix_struct%first_p_pos(2), npcol) ENDIF IF (j_global <= homo) CYCLE - j_global = j_global-homo + j_global = j_global - homo IF (.NOT. alpha_beta) THEN - ab_send(iiB, jjB) = mp2_env%ri_grad%P_ab(i_global-my_B_virtual_start+1, j_global) + ab_send(iiB, jjB) = mp2_env%ri_grad%P_ab(i_global - my_B_virtual_start + 1, j_global) ELSE - ab_send(iiB, jjB) = mp2_env%ri_grad%P_ab_beta(i_global-my_B_virtual_start+1, j_global) + ab_send(iiB, jjB) = mp2_env%ri_grad%P_ab_beta(i_global - my_B_virtual_start + 1, j_global) ENDIF END DO END DO @@ -1952,11 +1952,11 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, para_env_sub%group) IF (.NOT. alpha_beta) THEN mp2_env%ri_grad%P_mo%local_data(1:nrow_local, 1:ncol_local) = & - mp2_env%ri_grad%P_mo%local_data(1:nrow_local, 1:ncol_local)+ & + mp2_env%ri_grad%P_mo%local_data(1:nrow_local, 1:ncol_local) + & ab_rec(1:nrow_local, 1:ncol_local) ELSE mp2_env%ri_grad%P_mo_beta%local_data(1:nrow_local, 1:ncol_local) = & - mp2_env%ri_grad%P_mo_beta%local_data(1:nrow_local, 1:ncol_local)+ & + mp2_env%ri_grad%P_mo_beta%local_data(1:nrow_local, 1:ncol_local) + & ab_rec(1:nrow_local, 1:ncol_local) ENDIF @@ -2007,9 +2007,9 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, mo_coeff, L_mu_q, 0.0_dp, mp2_env%ri_grad%W_mo, & a_first_col=1, & a_first_row=1, & - b_first_col=homo+1, & + b_first_col=homo + 1, & b_first_row=1, & - c_first_col=homo+1, & + c_first_col=homo + 1, & c_first_row=1) ELSE NULLIFY (mp2_env%ri_grad%W_mo_beta) @@ -2042,9 +2042,9 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, mo_coeff, L_mu_q, 0.0_dp, mp2_env%ri_grad%W_mo_beta, & a_first_col=1, & a_first_row=1, & - b_first_col=homo+1, & + b_first_col=homo + 1, & b_first_row=1, & - c_first_col=homo+1, & + c_first_col=homo + 1, & c_first_row=1) ENDIF CALL timestop(handle2) @@ -2064,7 +2064,7 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, L_mu_q, mo_coeff, 0.0_dp, mp2_env%ri_grad%L_jb, & a_first_col=1, & a_first_row=1, & - b_first_col=homo+1, & + b_first_col=homo + 1, & b_first_row=1, & c_first_col=1, & c_first_row=1) @@ -2073,7 +2073,7 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, mo_coeff, L_mu_q, 1.0_dp, mp2_env%ri_grad%L_jb, & a_first_col=1, & a_first_row=1, & - b_first_col=homo+1, & + b_first_col=homo + 1, & b_first_row=1, & c_first_col=1, & c_first_row=1) @@ -2090,7 +2090,7 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, L_mu_q, mo_coeff, 0.0_dp, mp2_env%ri_grad%L_jb_beta, & a_first_col=1, & a_first_row=1, & - b_first_col=homo+1, & + b_first_col=homo + 1, & b_first_row=1, & c_first_col=1, & c_first_row=1) @@ -2099,7 +2099,7 @@ SUBROUTINE create_W_P(qs_env, mp2_env, mo_coeff, homo, virtual, dimen, para_env, mo_coeff, L_mu_q, 1.0_dp, mp2_env%ri_grad%L_jb_beta, & a_first_col=1, & a_first_row=1, & - b_first_col=homo+1, & + b_first_col=homo + 1, & b_first_row=1, & c_first_col=1, & c_first_row=1) diff --git a/src/mp2_ri_grad_util.F b/src/mp2_ri_grad_util.F index fe5b4f322c..fa1082d594 100644 --- a/src/mp2_ri_grad_util.F +++ b/src/mp2_ri_grad_util.F @@ -131,16 +131,16 @@ SUBROUTINE complete_gamma(mp2_env, B_ia_Q, dimen_RI, homo, virtual, para_env, pa DO iiB = 1, homo DO jjB = 1, my_B_size - ia_global = (iiB-1)*virtual+my_B_virtual_start+jjB-1 + ia_global = (iiB - 1)*virtual + my_B_virtual_start + jjB - 1 IF (ia_global >= my_ia_start .AND. ia_global <= my_ia_end) THEN - BIb_C_2D(ia_global-my_ia_start+1, 1:my_group_L_size) = B_ia_Q(iiB, jjB, 1:my_group_L_size) + BIb_C_2D(ia_global - my_ia_start + 1, 1:my_group_L_size) = B_ia_Q(iiB, jjB, 1:my_group_L_size) END IF END DO END DO - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_send = sub_proc_map(para_env_sub%mepos+proc_shift) - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_send = sub_proc_map(para_env_sub%mepos + proc_shift) + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) CALL get_group_dist(gd_B_virtual, proc_receive, rec_B_virtual_start, rec_B_virtual_end, rec_B_size) @@ -153,9 +153,9 @@ SUBROUTINE complete_gamma(mp2_env, B_ia_Q, dimen_RI, homo, virtual, para_env, pa DO iiB = 1, homo DO jjB = 1, rec_B_size - ia_global = (iiB-1)*virtual+rec_B_virtual_start+jjB-1 + ia_global = (iiB - 1)*virtual + rec_B_virtual_start + jjB - 1 IF (ia_global >= my_ia_start .AND. ia_global <= my_ia_end) THEN - BIb_C_2D(ia_global-my_ia_start+1, 1:my_group_L_size) = BIb_C_rec(iiB, jjB, 1:my_group_L_size) + BIb_C_2D(ia_global - my_ia_start + 1, 1:my_group_L_size) = BIb_C_rec(iiB, jjB, 1:my_group_L_size) END IF END DO END DO @@ -170,23 +170,23 @@ SUBROUTINE complete_gamma(mp2_env, B_ia_Q, dimen_RI, homo, virtual, para_env, pa DO iiB = 1, homo DO jjB = 1, my_B_size - ia_global = (iiB-1)*virtual+my_B_virtual_start+jjB-1 + ia_global = (iiB - 1)*virtual + my_B_virtual_start + jjB - 1 IF (ia_global >= my_ia_start .AND. ia_global <= my_ia_end) THEN ! Closed-shell, open-shell alpha-alpha component IF (alpha_case) THEN - Gamma_2D(ia_global-my_ia_start+1, 1:my_group_L_size) = & + Gamma_2D(ia_global - my_ia_start + 1, 1:my_group_L_size) = & mp2_env%ri_grad%Gamma_P_ia(iiB, jjB, 1:my_group_L_size) ELSE ! Open-shell beta-beta component - Gamma_2D(ia_global-my_ia_start+1, 1:my_group_L_size) = & + Gamma_2D(ia_global - my_ia_start + 1, 1:my_group_L_size) = & mp2_env%ri_grad%Gamma_P_ia_beta(iiB, jjB, 1:my_group_L_size) ENDIF END IF END DO END DO - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_send = sub_proc_map(para_env_sub%mepos+proc_shift) - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_send = sub_proc_map(para_env_sub%mepos + proc_shift) + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) CALL get_group_dist(gd_B_virtual, proc_receive, rec_B_virtual_start, rec_B_virtual_end, rec_B_size) @@ -205,9 +205,9 @@ SUBROUTINE complete_gamma(mp2_env, B_ia_Q, dimen_RI, homo, virtual, para_env, pa DO iiB = 1, homo DO jjB = 1, rec_B_size - ia_global = (iiB-1)*virtual+rec_B_virtual_start+jjB-1 + ia_global = (iiB - 1)*virtual + rec_B_virtual_start + jjB - 1 IF (ia_global >= my_ia_start .AND. ia_global <= my_ia_end) THEN - Gamma_2D(ia_global-my_ia_start+1, 1:my_group_L_size) = BIb_C_rec(iiB, jjB, 1:my_group_L_size) + Gamma_2D(ia_global - my_ia_start + 1, 1:my_group_L_size) = BIb_C_rec(iiB, jjB, 1:my_group_L_size) END IF END DO END DO @@ -231,7 +231,7 @@ SUBROUTINE complete_gamma(mp2_env, B_ia_Q, dimen_RI, homo, virtual, para_env, pa CALL prepare_redistribution(para_env, para_env_sub, ngroup, proc_map, & group_grid_2_mepos, mepos_2_grid_group, pos_info=pos_info) - DO i = 0, para_env%num_pe-1 + DO i = 0, para_env%num_pe - 1 ! calculate position of the group pos_group = i/para_env_sub%num_pe ! calculate position in the subgroup @@ -340,7 +340,7 @@ SUBROUTINE complete_gamma(mp2_env, B_ia_Q, dimen_RI, homo, virtual, para_env, pa CALL cp_fm_get_info(matrix=fm_Gamma, & nrow_local=nrow_local, & ncol_local=ncol_local) - ALLOCATE (sizes(2, 0:para_env%num_pe-1)) + ALLOCATE (sizes(2, 0:para_env%num_pe - 1)) sizes = 0 sizes(1, para_env%mepos) = nrow_local sizes(2, para_env%mepos) = ncol_local @@ -489,9 +489,9 @@ SUBROUTINE array2fm(mat2D, fm_struct, num_rows, num_cols, para_env, proc_map, & ! 0) create array containing the processes position ! and supporting infos CALL timeset(routineN//"_info", handle2) - ALLOCATE (grid_2_mepos(0:nprow-1, 0:npcol-1)) + ALLOCATE (grid_2_mepos(0:nprow - 1, 0:npcol - 1)) grid_2_mepos = 0 - ALLOCATE (mepos_2_grid(0:para_env%num_pe-1, 2)) + ALLOCATE (mepos_2_grid(0:para_env%num_pe - 1, 2)) mepos_2_grid = 0 ! fill the info array grid_2_mepos(myprow, mypcol) = para_env%mepos @@ -502,7 +502,7 @@ SUBROUTINE array2fm(mat2D, fm_struct, num_rows, num_cols, para_env, proc_map, & CALL mp_sum(mepos_2_grid, para_env%group) ! 1) loop over my local data and define a map for the proc to send data - ALLOCATE (map_send_size(0:para_env%num_pe-1)) + ALLOCATE (map_send_size(0:para_env%num_pe - 1)) map_send_size = 0 dummy_proc = 0 DO jjB = my_start_col, my_end_col @@ -512,12 +512,12 @@ SUBROUTINE array2fm(mat2D, fm_struct, num_rows, num_cols, para_env, proc_map, & send_prow = cp_fm_indxg2p(iiB, nrow_block, dummy_proc, & fm_mat%matrix_struct%first_p_pos(1), nprow) proc_send = grid_2_mepos(send_prow, send_pcol) - map_send_size(proc_send) = map_send_size(proc_send)+1 + map_send_size(proc_send) = map_send_size(proc_send) + 1 END DO END DO ! 2) loop over my local data of fm_mat and define a map for the proc from which rec data - ALLOCATE (map_rec_size(0:para_env%num_pe-1)) + ALLOCATE (map_rec_size(0:para_env%num_pe - 1)) map_rec_size = 0 part_row = REAL(num_rows, KIND=dp)/REAL(ngroup_row, KIND=dp) part_col = REAL(num_cols, KIND=dp)/REAL(ngroup_col, KIND=dp) @@ -530,14 +530,14 @@ SUBROUTINE array2fm(mat2D, fm_struct, num_rows, num_cols, para_env, proc_map, & j_global = col_indices(jjB) ! check the group holding this element ! dirty way, if someone has a better idea ... - rec_pcol = INT(REAL(j_global-1, KIND=dp)/part_col) + rec_pcol = INT(REAL(j_global - 1, KIND=dp)/part_col) rec_pcol = MAX(0, rec_pcol) - rec_pcol = MIN(rec_pcol, ngroup_col-1) + rec_pcol = MIN(rec_pcol, ngroup_col - 1) DO itmp = get_limit(num_cols, ngroup_col, rec_pcol) IF (j_global >= itmp(1) .AND. j_global <= itmp(2)) EXIT - IF (j_global < itmp(1)) rec_pcol = rec_pcol-1 - IF (j_global > itmp(2)) rec_pcol = rec_pcol+1 + IF (j_global < itmp(1)) rec_pcol = rec_pcol - 1 + IF (j_global > itmp(2)) rec_pcol = rec_pcol + 1 END DO IF (convert_pos) THEN @@ -550,19 +550,19 @@ SUBROUTINE array2fm(mat2D, fm_struct, num_rows, num_cols, para_env, proc_map, & DO iiB = 1, nrow_local i_global = row_indices(iiB) ! check the process in the group holding this element - rec_prow = INT(REAL(i_global-1, KIND=dp)/part_row) + rec_prow = INT(REAL(i_global - 1, KIND=dp)/part_row) rec_prow = MAX(0, rec_prow) - rec_prow = MIN(rec_prow, ngroup_row-1) + rec_prow = MIN(rec_prow, ngroup_row - 1) DO itmp = get_limit(num_rows, ngroup_row, rec_prow) IF (i_global >= itmp(1) .AND. i_global <= itmp(2)) EXIT - IF (i_global < itmp(1)) rec_prow = rec_prow-1 - IF (i_global > itmp(2)) rec_prow = rec_prow+1 + IF (i_global < itmp(1)) rec_prow = rec_prow - 1 + IF (i_global > itmp(2)) rec_prow = rec_prow + 1 END DO proc_receive = group_grid_2_mepos(rec_prow, rec_pcol) - map_rec_size(proc_receive) = map_rec_size(proc_receive)+1 + map_rec_size(proc_receive) = map_rec_size(proc_receive) + 1 END DO ! i_global END DO ! j_global @@ -575,7 +575,7 @@ SUBROUTINE array2fm(mat2D, fm_struct, num_rows, num_cols, para_env, proc_map, & DO iiB = 1, nrow_local i_global = row_indices(iiB) IF (i_global >= my_start_row .AND. i_global <= my_end_row) THEN - fm_mat%local_data(iiB, jjB) = mat2D(i_global-my_start_row+1, j_global-my_start_col+1) + fm_mat%local_data(iiB, jjB) = mat2D(i_global - my_start_row + 1, j_global - my_start_col + 1) END IF END DO END IF @@ -587,10 +587,10 @@ SUBROUTINE array2fm(mat2D, fm_struct, num_rows, num_cols, para_env, proc_map, & CALL timeset(routineN//"_buffer_send", handle2) ! count the number of messages to send number_of_send = 0 - DO proc_shift = 1, para_env%num_pe-1 - proc_send = proc_map(para_env%mepos+proc_shift) + DO proc_shift = 1, para_env%num_pe - 1 + proc_send = proc_map(para_env%mepos + proc_shift) IF (map_send_size(proc_send) > 0) THEN - number_of_send = number_of_send+1 + number_of_send = number_of_send + 1 END IF END DO ! allocate the structure that will hold the messages to be sent @@ -598,16 +598,16 @@ SUBROUTINE array2fm(mat2D, fm_struct, num_rows, num_cols, para_env, proc_map, & ! grid_ref_2_send_pos is an array (map) that given a pair ! (ref_send_prow,ref_send_pcol) returns ! the position in the buffer_send associated to that process - ALLOCATE (grid_ref_2_send_pos(0:nprow-1, 0:npcol-1)) + ALLOCATE (grid_ref_2_send_pos(0:nprow - 1, 0:npcol - 1)) grid_ref_2_send_pos = 0 ! finalize the allocation of buffer_send with the actual size ! of each message (actual size is size_send_buffer) send_counter = 0 - DO proc_shift = 1, para_env%num_pe-1 - proc_send = proc_map(para_env%mepos+proc_shift) + DO proc_shift = 1, para_env%num_pe - 1 + proc_send = proc_map(para_env%mepos + proc_shift) size_send_buffer = map_send_size(proc_send) IF (map_send_size(proc_send) > 0) THEN - send_counter = send_counter+1 + send_counter = send_counter + 1 ! allocate the sending buffer (msg) ALLOCATE (buffer_send(send_counter)%msg(size_send_buffer)) buffer_send(send_counter)%msg = 0.0_dp @@ -636,9 +636,9 @@ SUBROUTINE array2fm(mat2D, fm_struct, num_rows, num_cols, para_env, proc_map, & IF (grid_2_mepos(send_prow, send_pcol) == para_env%mepos) CYCLE send_counter = grid_ref_2_send_pos(send_prow, send_pcol) - iii_vet(send_counter) = iii_vet(send_counter)+1 + iii_vet(send_counter) = iii_vet(send_counter) + 1 iii = iii_vet(send_counter) - buffer_send(send_counter)%msg(iii) = mat2D(iiB-my_start_row+1, jjB-my_start_col+1) + buffer_send(send_counter)%msg(iii) = mat2D(iiB - my_start_row + 1, jjB - my_start_col + 1) END DO END DO @@ -653,21 +653,21 @@ SUBROUTINE array2fm(mat2D, fm_struct, num_rows, num_cols, para_env, proc_map, & CALL timeset(routineN//"_isendrecv", handle2) ! count the number of messages to be received number_of_rec = 0 - DO proc_shift = 1, para_env%num_pe-1 - proc_receive = proc_map(para_env%mepos-proc_shift) + DO proc_shift = 1, para_env%num_pe - 1 + proc_receive = proc_map(para_env%mepos - proc_shift) IF (map_rec_size(proc_receive) > 0) THEN - number_of_rec = number_of_rec+1 + number_of_rec = number_of_rec + 1 END IF END DO ALLOCATE (buffer_rec(number_of_rec)) rec_counter = 0 - DO proc_shift = 1, para_env%num_pe-1 - proc_receive = proc_map(para_env%mepos-proc_shift) + DO proc_shift = 1, para_env%num_pe - 1 + proc_receive = proc_map(para_env%mepos - proc_shift) size_rec_buffer = map_rec_size(proc_receive) IF (map_rec_size(proc_receive) > 0) THEN - rec_counter = rec_counter+1 + rec_counter = rec_counter + 1 ! prepare the buffer for receive ALLOCATE (buffer_rec(rec_counter)%msg(size_rec_buffer)) buffer_rec(rec_counter)%msg = 0.0_dp @@ -681,10 +681,10 @@ SUBROUTINE array2fm(mat2D, fm_struct, num_rows, num_cols, para_env, proc_map, & ! send messages ALLOCATE (req_send(number_of_send)) send_counter = 0 - DO proc_shift = 1, para_env%num_pe-1 - proc_send = proc_map(para_env%mepos+proc_shift) + DO proc_shift = 1, para_env%num_pe - 1 + proc_send = proc_map(para_env%mepos + proc_shift) IF (map_send_size(proc_send) > 0) THEN - send_counter = send_counter+1 + send_counter = send_counter + 1 CALL mp_isend(buffer_send(send_counter)%msg, proc_send, para_env%group, & buffer_send(send_counter)%msg_req) req_send(send_counter) = buffer_send(send_counter)%msg_req @@ -699,46 +699,46 @@ SUBROUTINE array2fm(mat2D, fm_struct, num_rows, num_cols, para_env, proc_map, & ! ranges of the blocks over which a given process hold its local data. ! Start with the rows ... my_num_row_blocks = 1 - DO iiB = 1, nrow_local-1 - IF (ABS(row_indices(iiB+1)-row_indices(iiB)) == 1) CYCLE - my_num_row_blocks = my_num_row_blocks+1 + DO iiB = 1, nrow_local - 1 + IF (ABS(row_indices(iiB + 1) - row_indices(iiB)) == 1) CYCLE + my_num_row_blocks = my_num_row_blocks + 1 END DO ALLOCATE (blocks_ranges_row(2, my_num_row_blocks)) blocks_ranges_row = 0 blocks_ranges_row(1, 1) = row_indices(1) iii = 1 - DO iiB = 1, nrow_local-1 - IF (ABS(row_indices(iiB+1)-row_indices(iiB)) == 1) CYCLE - iii = iii+1 - blocks_ranges_row(2, iii-1) = row_indices(iiB) - blocks_ranges_row(1, iii) = row_indices(iiB+1) + DO iiB = 1, nrow_local - 1 + IF (ABS(row_indices(iiB + 1) - row_indices(iiB)) == 1) CYCLE + iii = iii + 1 + blocks_ranges_row(2, iii - 1) = row_indices(iiB) + blocks_ranges_row(1, iii) = row_indices(iiB + 1) END DO blocks_ranges_row(2, my_num_row_blocks) = row_indices(MAX(nrow_local, 1)) ! ... and columns my_num_col_blocks = 1 - DO jjB = 1, ncol_local-1 - IF (ABS(col_indices(jjB+1)-col_indices(jjB)) == 1) CYCLE - my_num_col_blocks = my_num_col_blocks+1 + DO jjB = 1, ncol_local - 1 + IF (ABS(col_indices(jjB + 1) - col_indices(jjB)) == 1) CYCLE + my_num_col_blocks = my_num_col_blocks + 1 END DO ALLOCATE (blocks_ranges_col(2, my_num_col_blocks)) blocks_ranges_col = 0 blocks_ranges_col(1, 1) = col_indices(1) iii = 1 - DO jjB = 1, ncol_local-1 - IF (ABS(col_indices(jjB+1)-col_indices(jjB)) == 1) CYCLE - iii = iii+1 - blocks_ranges_col(2, iii-1) = col_indices(jjB) - blocks_ranges_col(1, iii) = col_indices(jjB+1) + DO jjB = 1, ncol_local - 1 + IF (ABS(col_indices(jjB + 1) - col_indices(jjB)) == 1) CYCLE + iii = iii + 1 + blocks_ranges_col(2, iii - 1) = col_indices(jjB) + blocks_ranges_col(1, iii) = col_indices(jjB + 1) END DO blocks_ranges_col(2, my_num_col_blocks) = col_indices(MAX(ncol_local, 1)) rec_counter = 0 - DO proc_shift = 1, para_env%num_pe-1 - proc_receive = proc_map(para_env%mepos-proc_shift) + DO proc_shift = 1, para_env%num_pe - 1 + proc_receive = proc_map(para_env%mepos - proc_shift) size_rec_buffer = map_rec_size(proc_receive) IF (map_rec_size(proc_receive) > 0) THEN - rec_counter = rec_counter+1 + rec_counter = rec_counter + 1 CALL get_group_dist(gd_col, proc_receive, rec_col_start, rec_col_end, rec_col_size) @@ -748,7 +748,7 @@ SUBROUTINE array2fm(mat2D, fm_struct, num_rows, num_cols, para_env, proc_map, & start_col_block = MAX(blocks_ranges_col(1, jjB), rec_col_start) end_col_block = MIN(blocks_ranges_col(2, jjB), rec_col_end) DO j_sub = start_col_block, end_col_block - num_rec_cols = num_rec_cols+1 + num_rec_cols = num_rec_cols + 1 END DO END DO ALLOCATE (index_col_rec(num_rec_cols)) @@ -758,7 +758,7 @@ SUBROUTINE array2fm(mat2D, fm_struct, num_rows, num_cols, para_env, proc_map, & start_col_block = MAX(blocks_ranges_col(1, jjB), rec_col_start) end_col_block = MIN(blocks_ranges_col(2, jjB), rec_col_end) DO j_sub = start_col_block, end_col_block - iii = iii+1 + iii = iii + 1 j_local = cp_fm_indxg2l(j_sub, ncol_block, dummy_proc, & fm_mat%matrix_struct%first_p_pos(2), npcol) index_col_rec(iii) = j_local @@ -779,7 +779,7 @@ SUBROUTINE array2fm(mat2D, fm_struct, num_rows, num_cols, para_env, proc_map, & i_local = cp_fm_indxg2l(i_sub, nrow_block, dummy_proc, & fm_mat%matrix_struct%first_p_pos(1), nprow) DO jjB = 1, num_rec_cols - iii = iii+1 + iii = iii + 1 j_local = index_col_rec(jjB) fm_mat%local_data(i_local, j_local) = buffer_rec(rec_counter)%msg(iii) END DO @@ -894,9 +894,9 @@ SUBROUTINE fm2array(mat2D, num_rows, num_cols, para_env, proc_map, & ! 0) create array containing the processes position ! and supporting infos CALL timeset(routineN//"_info", handle2) - ALLOCATE (grid_2_mepos(0:nprow-1, 0:npcol-1)) + ALLOCATE (grid_2_mepos(0:nprow - 1, 0:npcol - 1)) grid_2_mepos = 0 - ALLOCATE (mepos_2_grid(0:para_env%num_pe-1, 2)) + ALLOCATE (mepos_2_grid(0:para_env%num_pe - 1, 2)) mepos_2_grid = 0 ! ALLOCATE(mepos_2_grid_group(0:para_env%num_pe-1,2),STAT=stat) @@ -912,7 +912,7 @@ SUBROUTINE fm2array(mat2D, num_rows, num_cols, para_env, proc_map, & CALL mp_sum(mepos_2_grid, para_env%group) ! 1) loop over my local data and define a map for the proc to send data - ALLOCATE (map_send_size(0:para_env%num_pe-1)) + ALLOCATE (map_send_size(0:para_env%num_pe - 1)) map_send_size = 0 part_row = REAL(num_rows, KIND=dp)/REAL(ngroup_row, KIND=dp) part_col = REAL(num_cols, KIND=dp)/REAL(ngroup_col, KIND=dp) @@ -921,38 +921,38 @@ SUBROUTINE fm2array(mat2D, num_rows, num_cols, para_env, proc_map, & j_global = col_indices(jjB) ! check the group holding this element ! dirty way, if someone has a better idea ... - send_pcol = INT(REAL(j_global-1, KIND=dp)/part_col) + send_pcol = INT(REAL(j_global - 1, KIND=dp)/part_col) send_pcol = MAX(0, send_pcol) - send_pcol = MIN(send_pcol, ngroup_col-1) + send_pcol = MIN(send_pcol, ngroup_col - 1) DO itmp = get_limit(num_cols, ngroup_col, send_pcol) IF (j_global >= itmp(1) .AND. j_global <= itmp(2)) EXIT - IF (j_global < itmp(1)) send_pcol = send_pcol-1 - IF (j_global > itmp(2)) send_pcol = send_pcol+1 + IF (j_global < itmp(1)) send_pcol = send_pcol - 1 + IF (j_global > itmp(2)) send_pcol = send_pcol + 1 END DO DO iiB = 1, nrow_local i_global = row_indices(iiB) ! check the process in the group holding this element - send_prow = INT(REAL(i_global-1, KIND=dp)/part_row) + send_prow = INT(REAL(i_global - 1, KIND=dp)/part_row) send_prow = MAX(0, send_prow) - send_prow = MIN(send_prow, ngroup_row-1) + send_prow = MIN(send_prow, ngroup_row - 1) DO itmp = get_limit(num_rows, ngroup_row, send_prow) IF (i_global >= itmp(1) .AND. i_global <= itmp(2)) EXIT - IF (i_global < itmp(1)) send_prow = send_prow-1 - IF (i_global > itmp(2)) send_prow = send_prow+1 + IF (i_global < itmp(1)) send_prow = send_prow - 1 + IF (i_global > itmp(2)) send_prow = send_prow + 1 END DO proc_send = group_grid_2_mepos(send_prow, send_pcol) - map_send_size(proc_send) = map_send_size(proc_send)+1 + map_send_size(proc_send) = map_send_size(proc_send) + 1 END DO ! i_global END DO ! j_global ! 2) loop over my local data of the array and define a map for the proc from which rec data - ALLOCATE (map_rec_size(0:para_env%num_pe-1)) + ALLOCATE (map_rec_size(0:para_env%num_pe - 1)) map_rec_size = 0 dummy_proc = 0 DO jjB = my_start_col, my_end_col @@ -962,7 +962,7 @@ SUBROUTINE fm2array(mat2D, num_rows, num_cols, para_env, proc_map, & rec_prow = cp_fm_indxg2p(iiB, nrow_block, dummy_proc, & fm_mat%matrix_struct%first_p_pos(1), nprow) proc_receive = grid_2_mepos(rec_prow, rec_pcol) - map_rec_size(proc_receive) = map_rec_size(proc_receive)+1 + map_rec_size(proc_receive) = map_rec_size(proc_receive) + 1 END DO END DO @@ -974,7 +974,7 @@ SUBROUTINE fm2array(mat2D, num_rows, num_cols, para_env, proc_map, & DO iiB = 1, nrow_local i_global = row_indices(iiB) IF (i_global >= my_start_row .AND. i_global <= my_end_row) THEN - mat2D(i_global-my_start_row+1, j_global-my_start_col+1) = fm_mat%local_data(iiB, jjB) + mat2D(i_global - my_start_row + 1, j_global - my_start_col + 1) = fm_mat%local_data(iiB, jjB) END IF END DO END IF @@ -986,10 +986,10 @@ SUBROUTINE fm2array(mat2D, num_rows, num_cols, para_env, proc_map, & CALL timeset(routineN//"_buffer_send", handle2) ! count the number of messages to send number_of_send = 0 - DO proc_shift = 1, para_env%num_pe-1 - proc_send = proc_map(para_env%mepos+proc_shift) + DO proc_shift = 1, para_env%num_pe - 1 + proc_send = proc_map(para_env%mepos + proc_shift) IF (map_send_size(proc_send) > 0) THEN - number_of_send = number_of_send+1 + number_of_send = number_of_send + 1 END IF END DO ! allocate the structure that will hold the messages to be sent @@ -998,17 +998,17 @@ SUBROUTINE fm2array(mat2D, num_rows, num_cols, para_env, proc_map, & ! (ref_send_prow,ref_send_pcol) returns ! the position in the buffer_send associated to that process - ALLOCATE (grid_ref_2_send_pos(0:ngroup_row-1, 0:ngroup_col-1)) + ALLOCATE (grid_ref_2_send_pos(0:ngroup_row - 1, 0:ngroup_col - 1)) grid_ref_2_send_pos = 0 ! finalize the allocation of buffer_send with the actual size ! of each message (actual size is size_send_buffer) send_counter = 0 - DO proc_shift = 1, para_env%num_pe-1 - proc_send = proc_map(para_env%mepos+proc_shift) + DO proc_shift = 1, para_env%num_pe - 1 + proc_send = proc_map(para_env%mepos + proc_shift) size_send_buffer = map_send_size(proc_send) IF (map_send_size(proc_send) > 0) THEN - send_counter = send_counter+1 + send_counter = send_counter + 1 ! allocate the sending buffer (msg) ALLOCATE (buffer_send(send_counter)%msg(size_send_buffer)) buffer_send(send_counter)%msg = 0.0_dp @@ -1031,33 +1031,33 @@ SUBROUTINE fm2array(mat2D, num_rows, num_cols, para_env, proc_map, & j_global = col_indices(jjB) ! check the group holding this element ! dirty way, if someone has a better idea ... - send_pcol = INT(REAL(j_global-1, KIND=dp)/part_col) + send_pcol = INT(REAL(j_global - 1, KIND=dp)/part_col) send_pcol = MAX(0, send_pcol) - send_pcol = MIN(send_pcol, ngroup_col-1) + send_pcol = MIN(send_pcol, ngroup_col - 1) DO itmp = get_limit(num_cols, ngroup_col, send_pcol) IF (j_global >= itmp(1) .AND. j_global <= itmp(2)) EXIT - IF (j_global < itmp(1)) send_pcol = send_pcol-1 - IF (j_global > itmp(2)) send_pcol = send_pcol+1 + IF (j_global < itmp(1)) send_pcol = send_pcol - 1 + IF (j_global > itmp(2)) send_pcol = send_pcol + 1 END DO DO iiB = 1, nrow_local i_global = row_indices(iiB) ! check the process in the group holding this element - send_prow = INT(REAL(i_global-1, KIND=dp)/part_row) + send_prow = INT(REAL(i_global - 1, KIND=dp)/part_row) send_prow = MAX(0, send_prow) - send_prow = MIN(send_prow, ngroup_row-1) + send_prow = MIN(send_prow, ngroup_row - 1) DO itmp = get_limit(num_rows, ngroup_row, send_prow) IF (i_global >= itmp(1) .AND. i_global <= itmp(2)) EXIT - IF (i_global < itmp(1)) send_prow = send_prow-1 - IF (i_global > itmp(2)) send_prow = send_prow+1 + IF (i_global < itmp(1)) send_prow = send_prow - 1 + IF (i_global > itmp(2)) send_prow = send_prow + 1 END DO ! we don't need to send to ourselves IF (group_grid_2_mepos(send_prow, send_pcol) == para_env%mepos) CYCLE send_counter = grid_ref_2_send_pos(send_prow, send_pcol) - iii_vet(send_counter) = iii_vet(send_counter)+1 + iii_vet(send_counter) = iii_vet(send_counter) + 1 iii = iii_vet(send_counter) buffer_send(send_counter)%msg(iii) = fm_mat%local_data(iiB, jjB) END DO @@ -1073,21 +1073,21 @@ SUBROUTINE fm2array(mat2D, num_rows, num_cols, para_env, proc_map, & CALL timeset(routineN//"_isendrecv", handle2) ! count the number of messages to be received number_of_rec = 0 - DO proc_shift = 1, para_env%num_pe-1 - proc_receive = proc_map(para_env%mepos-proc_shift) + DO proc_shift = 1, para_env%num_pe - 1 + proc_receive = proc_map(para_env%mepos - proc_shift) IF (map_rec_size(proc_receive) > 0) THEN - number_of_rec = number_of_rec+1 + number_of_rec = number_of_rec + 1 END IF END DO ALLOCATE (buffer_rec(number_of_rec)) rec_counter = 0 - DO proc_shift = 1, para_env%num_pe-1 - proc_receive = proc_map(para_env%mepos-proc_shift) + DO proc_shift = 1, para_env%num_pe - 1 + proc_receive = proc_map(para_env%mepos - proc_shift) size_rec_buffer = map_rec_size(proc_receive) IF (map_rec_size(proc_receive) > 0) THEN - rec_counter = rec_counter+1 + rec_counter = rec_counter + 1 ! prepare the buffer for receive ALLOCATE (buffer_rec(rec_counter)%msg(size_rec_buffer)) buffer_rec(rec_counter)%msg = 0.0_dp @@ -1101,10 +1101,10 @@ SUBROUTINE fm2array(mat2D, num_rows, num_cols, para_env, proc_map, & ! send messages ALLOCATE (req_send(number_of_send)) send_counter = 0 - DO proc_shift = 1, para_env%num_pe-1 - proc_send = proc_map(para_env%mepos+proc_shift) + DO proc_shift = 1, para_env%num_pe - 1 + proc_send = proc_map(para_env%mepos + proc_shift) IF (map_send_size(proc_send) > 0) THEN - send_counter = send_counter+1 + send_counter = send_counter + 1 CALL mp_isend(buffer_send(send_counter)%msg, proc_send, para_env%group, & buffer_send(send_counter)%msg_req) req_send(send_counter) = buffer_send(send_counter)%msg_req @@ -1119,12 +1119,12 @@ SUBROUTINE fm2array(mat2D, num_rows, num_cols, para_env, proc_map, & ALLOCATE (index_row_rec(iiB)) index_row_rec = 0 rec_counter = 0 - DO proc_shift = 1, para_env%num_pe-1 - proc_receive = proc_map(para_env%mepos-proc_shift) + DO proc_shift = 1, para_env%num_pe - 1 + proc_receive = proc_map(para_env%mepos - proc_shift) size_rec_buffer = map_rec_size(proc_receive) IF (map_rec_size(proc_receive) > 0) THEN - rec_counter = rec_counter+1 + rec_counter = rec_counter + 1 rec_col_size = sizes(2, proc_receive) rec_row_size = sizes(1, proc_receive) @@ -1135,7 +1135,7 @@ SUBROUTINE fm2array(mat2D, num_rows, num_cols, para_env, proc_map, & i_global = cp_fm_indxl2g(iiB, nrow_block, mepos_2_grid(proc_receive, 1), & fm_mat%matrix_struct%first_p_pos(1), nprow) IF (i_global >= my_start_row .AND. i_global <= my_end_row) THEN - num_rec_rows = num_rec_rows+1 + num_rec_rows = num_rec_rows + 1 index_row_rec(num_rec_rows) = i_global END IF END DO @@ -1149,8 +1149,8 @@ SUBROUTINE fm2array(mat2D, num_rows, num_cols, para_env, proc_map, & IF (j_global >= my_start_col .AND. j_global <= my_end_col) THEN DO iiB = 1, num_rec_rows i_global = index_row_rec(iiB) - iii = iii+1 - mat2D(i_global-my_start_row+1, j_global-my_start_col+1) = buffer_rec(rec_counter)%msg(iii) + iii = iii + 1 + mat2D(i_global - my_start_row + 1, j_global - my_start_col + 1) = buffer_rec(rec_counter)%msg(iii) END DO END IF END DO @@ -1267,9 +1267,9 @@ SUBROUTINE create_dbcsr_gamma(Gamma_2D, homo, virtual, dimen_ia, para_env_sub, s npcol = fm_ia%matrix_struct%context%num_pe(2) ! 0) create array containing the processes position and supporting infos - ALLOCATE (grid_2_mepos(0:nprow-1, 0:npcol-1)) + ALLOCATE (grid_2_mepos(0:nprow - 1, 0:npcol - 1)) grid_2_mepos = 0 - ALLOCATE (mepos_2_grid(0:para_env_sub%num_pe-1, 2)) + ALLOCATE (mepos_2_grid(0:para_env_sub%num_pe - 1, 2)) mepos_2_grid = 0 ! fill the info array grid_2_mepos(myprow, mypcol) = para_env_sub%mepos @@ -1280,22 +1280,22 @@ SUBROUTINE create_dbcsr_gamma(Gamma_2D, homo, virtual, dimen_ia, para_env_sub, s CALL mp_sum(mepos_2_grid, para_env_sub%group) ! loop over local index range and define the sending map - ALLOCATE (map_send_size(0:para_env_sub%num_pe-1)) + ALLOCATE (map_send_size(0:para_env_sub%num_pe - 1)) map_send_size = 0 dummy_proc = 0 DO iaia = my_ia_start, my_ia_end - i_global = (iaia-1)/virtual+1 - j_global = MOD(iaia-1, virtual)+1 + i_global = (iaia - 1)/virtual + 1 + j_global = MOD(iaia - 1, virtual) + 1 send_prow = cp_fm_indxg2p(i_global, nrow_block, dummy_proc, & fm_ia%matrix_struct%first_p_pos(1), nprow) send_pcol = cp_fm_indxg2p(j_global, ncol_block, dummy_proc, & fm_ia%matrix_struct%first_p_pos(2), npcol) proc_send = grid_2_mepos(send_prow, send_pcol) - map_send_size(proc_send) = map_send_size(proc_send)+1 + map_send_size(proc_send) = map_send_size(proc_send) + 1 END DO ! loop over local data of fm_ia and define the receiving map - ALLOCATE (map_rec_size(0:para_env_sub%num_pe-1)) + ALLOCATE (map_rec_size(0:para_env_sub%num_pe - 1)) map_rec_size = 0 part_ia = REAL(dimen_ia, KIND=dp)/REAL(para_env_sub%num_pe, KIND=dp) @@ -1303,40 +1303,40 @@ SUBROUTINE create_dbcsr_gamma(Gamma_2D, homo, virtual, dimen_ia, para_env_sub, s i_global = row_indices(iiB) DO jjB = 1, ncol_local j_global = col_indices(jjB) - iaia = (i_global-1)*virtual+j_global - proc_receive = INT(REAL(iaia-1, KIND=dp)/part_ia) + iaia = (i_global - 1)*virtual + j_global + proc_receive = INT(REAL(iaia - 1, KIND=dp)/part_ia) proc_receive = MAX(0, proc_receive) - proc_receive = MIN(proc_receive, para_env_sub%num_pe-1) + proc_receive = MIN(proc_receive, para_env_sub%num_pe - 1) DO itmp = get_limit(dimen_ia, para_env_sub%num_pe, proc_receive) IF (iaia >= itmp(1) .AND. iaia <= itmp(2)) EXIT - IF (iaia < itmp(1)) proc_receive = proc_receive-1 - IF (iaia > itmp(2)) proc_receive = proc_receive+1 + IF (iaia < itmp(1)) proc_receive = proc_receive - 1 + IF (iaia > itmp(2)) proc_receive = proc_receive + 1 END DO - map_rec_size(proc_receive) = map_rec_size(proc_receive)+1 + map_rec_size(proc_receive) = map_rec_size(proc_receive) + 1 END DO END DO ! allocate the buffer for sending data number_of_send = 0 - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_send = sub_proc_map(para_env_sub%mepos+proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_send = sub_proc_map(para_env_sub%mepos + proc_shift) IF (map_send_size(proc_send) > 0) THEN - number_of_send = number_of_send+1 + number_of_send = number_of_send + 1 END IF END DO ! allocate the structure that will hold the messages to be sent ALLOCATE (buffer_send(number_of_send)) ! and the map from the grid of processess to the message position - ALLOCATE (grid_ref_2_send_pos(0:nprow-1, 0:npcol-1)) + ALLOCATE (grid_ref_2_send_pos(0:nprow - 1, 0:npcol - 1)) grid_ref_2_send_pos = 0 ! finally allocate each message send_counter = 0 - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_send = sub_proc_map(para_env_sub%mepos+proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_send = sub_proc_map(para_env_sub%mepos + proc_shift) size_send_buffer = map_send_size(proc_send) IF (map_send_size(proc_send) > 0) THEN - send_counter = send_counter+1 + send_counter = send_counter + 1 ! allocate the sending buffer (msg) ALLOCATE (buffer_send(send_counter)%msg(size_send_buffer)) buffer_send(send_counter)%proc = proc_send @@ -1351,10 +1351,10 @@ SUBROUTINE create_dbcsr_gamma(Gamma_2D, homo, virtual, dimen_ia, para_env_sub, s ! allocate the buffer for receiving data number_of_rec = 0 - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) IF (map_rec_size(proc_receive) > 0) THEN - number_of_rec = number_of_rec+1 + number_of_rec = number_of_rec + 1 END IF END DO ! allocate the structure that will hold the messages to be received @@ -1363,11 +1363,11 @@ SUBROUTINE create_dbcsr_gamma(Gamma_2D, homo, virtual, dimen_ia, para_env_sub, s ALLOCATE (indeces_rec(number_of_rec)) ! finally allocate each message and fill the array of indeces rec_counter = 0 - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) size_rec_buffer = map_rec_size(proc_receive) IF (map_rec_size(proc_receive) > 0) THEN - rec_counter = rec_counter+1 + rec_counter = rec_counter + 1 ! prepare the buffer for receive ALLOCATE (buffer_rec(rec_counter)%msg(size_rec_buffer)) buffer_rec(rec_counter)%proc = proc_receive @@ -1377,14 +1377,14 @@ SUBROUTINE create_dbcsr_gamma(Gamma_2D, homo, virtual, dimen_ia, para_env_sub, s CALL get_group_dist(gd_ia, proc_receive, rec_iaia_start, rec_iaia_end, rec_iaia_size) iii = 0 DO iaia = rec_iaia_start, rec_iaia_end - i_global = (iaia-1)/virtual+1 - j_global = MOD(iaia-1, virtual)+1 + i_global = (iaia - 1)/virtual + 1 + j_global = MOD(iaia - 1, virtual) + 1 rec_prow = cp_fm_indxg2p(i_global, nrow_block, dummy_proc, & fm_ia%matrix_struct%first_p_pos(1), nprow) rec_pcol = cp_fm_indxg2p(j_global, ncol_block, dummy_proc, & fm_ia%matrix_struct%first_p_pos(2), npcol) IF (grid_2_mepos(rec_prow, rec_pcol) /= para_env_sub%mepos) CYCLE - iii = iii+1 + iii = iii + 1 i_local = cp_fm_indxg2l(i_global, nrow_block, dummy_proc, & fm_ia%matrix_struct%first_p_pos(1), nprow) j_local = cp_fm_indxg2l(j_global, ncol_block, dummy_proc, & @@ -1401,14 +1401,14 @@ SUBROUTINE create_dbcsr_gamma(Gamma_2D, homo, virtual, dimen_ia, para_env_sub, s indeces_map_my = 0 iii = 0 DO iaia = my_ia_start, my_ia_end - i_global = (iaia-1)/virtual+1 - j_global = MOD(iaia-1, virtual)+1 + i_global = (iaia - 1)/virtual + 1 + j_global = MOD(iaia - 1, virtual) + 1 rec_prow = cp_fm_indxg2p(i_global, nrow_block, dummy_proc, & fm_ia%matrix_struct%first_p_pos(1), nprow) rec_pcol = cp_fm_indxg2p(j_global, ncol_block, dummy_proc, & fm_ia%matrix_struct%first_p_pos(2), npcol) IF (grid_2_mepos(rec_prow, rec_pcol) /= para_env_sub%mepos) CYCLE - iii = iii+1 + iii = iii + 1 i_local = cp_fm_indxg2l(i_global, nrow_block, dummy_proc, & fm_ia%matrix_struct%first_p_pos(1), nprow) j_local = cp_fm_indxg2l(j_global, ncol_block, dummy_proc, & @@ -1428,10 +1428,10 @@ SUBROUTINE create_dbcsr_gamma(Gamma_2D, homo, virtual, dimen_ia, para_env_sub, s ! zero the matries of the buffers and post the messages to be received CALL cp_fm_set_all(matrix=fm_ia, alpha=0.0_dp) rec_counter = 0 - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) IF (map_rec_size(proc_receive) > 0) THEN - rec_counter = rec_counter+1 + rec_counter = rec_counter + 1 buffer_rec(rec_counter)%msg = 0.0_dp CALL mp_irecv(buffer_rec(rec_counter)%msg, proc_receive, para_env_sub%group, & buffer_rec(rec_counter)%msg_req) @@ -1444,8 +1444,8 @@ SUBROUTINE create_dbcsr_gamma(Gamma_2D, homo, virtual, dimen_ia, para_env_sub, s iii_vet = 0 jjj = 0 DO iaia = my_ia_start, my_ia_end - i_global = (iaia-1)/virtual+1 - j_global = MOD(iaia-1, virtual)+1 + i_global = (iaia - 1)/virtual + 1 + j_global = MOD(iaia - 1, virtual) + 1 send_prow = cp_fm_indxg2p(i_global, nrow_block, dummy_proc, & fm_ia%matrix_struct%first_p_pos(1), nprow) send_pcol = cp_fm_indxg2p(j_global, ncol_block, dummy_proc, & @@ -1454,23 +1454,23 @@ SUBROUTINE create_dbcsr_gamma(Gamma_2D, homo, virtual, dimen_ia, para_env_sub, s ! we don't need to send to ourselves IF (grid_2_mepos(send_prow, send_pcol) == para_env_sub%mepos) THEN ! filling fm_ia with local data - jjj = jjj+1 + jjj = jjj + 1 i_local = indeces_map_my(1, jjj) j_local = indeces_map_my(2, jjj) - fm_ia%local_data(i_local, j_local) = Gamma_2D(iaia-my_ia_start+1, kkB) + fm_ia%local_data(i_local, j_local) = Gamma_2D(iaia - my_ia_start + 1, kkB) ELSE send_counter = grid_ref_2_send_pos(send_prow, send_pcol) - iii_vet(send_counter) = iii_vet(send_counter)+1 + iii_vet(send_counter) = iii_vet(send_counter) + 1 iii = iii_vet(send_counter) - buffer_send(send_counter)%msg(iii) = Gamma_2D(iaia-my_ia_start+1, kkB) + buffer_send(send_counter)%msg(iii) = Gamma_2D(iaia - my_ia_start + 1, kkB) END IF END DO req_send = 0 send_counter = 0 - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_send = sub_proc_map(para_env_sub%mepos+proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_send = sub_proc_map(para_env_sub%mepos + proc_shift) IF (map_send_size(proc_send) > 0) THEN - send_counter = send_counter+1 + send_counter = send_counter + 1 CALL mp_isend(buffer_send(send_counter)%msg, proc_send, para_env_sub%group, & buffer_send(send_counter)%msg_req) req_send(send_counter) = buffer_send(send_counter)%msg_req @@ -1479,11 +1479,11 @@ SUBROUTINE create_dbcsr_gamma(Gamma_2D, homo, virtual, dimen_ia, para_env_sub, s ! receive the massages and fill the fm_ia rec_counter = 0 - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) size_rec_buffer = map_rec_size(proc_receive) IF (map_rec_size(proc_receive) > 0) THEN - rec_counter = rec_counter+1 + rec_counter = rec_counter + 1 ! wait for the message CALL mp_wait(buffer_rec(rec_counter)%msg_req) DO iii = 1, size_rec_buffer @@ -1572,22 +1572,22 @@ SUBROUTINE prepare_redistribution(para_env, para_env_sub, ngroup, & pos_sub INTEGER, ALLOCATABLE, DIMENSION(:) :: my_pos_info - ALLOCATE (proc_map(-para_env%num_pe:2*para_env%num_pe-1)) + ALLOCATE (proc_map(-para_env%num_pe:2*para_env%num_pe - 1)) proc_map = 0 - ALLOCATE (my_pos_info(0:para_env%num_pe-1)) + ALLOCATE (my_pos_info(0:para_env%num_pe - 1)) my_pos_info = 0 my_pos_info(para_env%mepos) = para_env_sub%mepos CALL mp_sum(my_pos_info, para_env%group) - ALLOCATE (group_grid_2_mepos(0:para_env_sub%num_pe-1, 0:ngroup-1)) + ALLOCATE (group_grid_2_mepos(0:para_env_sub%num_pe - 1, 0:ngroup - 1)) group_grid_2_mepos = 0 - ALLOCATE (mepos_2_grid_group(0:para_env%num_pe-1, 2)) + ALLOCATE (mepos_2_grid_group(0:para_env%num_pe - 1, 2)) mepos_2_grid_group = 0 - DO i = 0, para_env%num_pe-1 + DO i = 0, para_env%num_pe - 1 proc_map(i) = i - proc_map(-i-1) = para_env%num_pe-i-1 - proc_map(para_env%num_pe+i) = i + proc_map(-i - 1) = para_env%num_pe - i - 1 + proc_map(para_env%num_pe + i) = i ! calculate position of the group pos_group = i/para_env_sub%num_pe ! calculate position in the subgroup @@ -1604,7 +1604,7 @@ SUBROUTINE prepare_redistribution(para_env, para_env_sub, ngroup, & nrow_local=nrow_local, & ncol_local=ncol_local) - ALLOCATE (sizes(2, 0:para_env%num_pe-1)) + ALLOCATE (sizes(2, 0:para_env%num_pe - 1)) sizes = 0 sizes(1, para_env%mepos) = nrow_local sizes(2, para_env%mepos) = ncol_local diff --git a/src/mp2_ri_libint.F b/src/mp2_ri_libint.F index cff02d987d..1610d5f07a 100644 --- a/src/mp2_ri_libint.F +++ b/src/mp2_ri_libint.F @@ -269,7 +269,7 @@ SUBROUTINE read_RI_basis_set(qs_env, RI_basis_parameter, RI_basis_info, & DO i = 0, RI_basis_info%max_am nl_count = 0 DO j = 1, nshell(iset) - IF (RI_basis_parameter(ikind)%nl(j, iset) == i) nl_count = nl_count+1 + IF (RI_basis_parameter(ikind)%nl(j, iset) == i) nl_count = nl_count + 1 END DO RI_basis_parameter(ikind)%nsgfl(i, iset) = nl_count END DO @@ -311,20 +311,20 @@ SUBROUTINE read_RI_basis_set(qs_env, RI_basis_parameter, RI_basis_info, & DO iset = 1, nseta sgfa = first_sgfa(1, iset) DO ipgf = 1, npgfa(iset) - offset_a1 = (ipgf-1)*ncoset(la_max(iset)) + offset_a1 = (ipgf - 1)*ncoset(la_max(iset)) s_offset_nl_a = 0 DO la = la_min(iset), la_max(iset) - offset_a = offset_a1+ncoset(la-1) + offset_a = offset_a1 + ncoset(la - 1) co_counter = 0 - co_counter = co_counter+1 + co_counter = co_counter + 1 so_counter = 0 - DO k = sgfa+s_offset_nl_a, sgfa+s_offset_nl_a+nso(la)*nl_a(la, iset)-1 - DO i = offset_a+1, offset_a+nco(la) - so_counter = so_counter+1 + DO k = sgfa + s_offset_nl_a, sgfa + s_offset_nl_a + nso(la)*nl_a(la, iset) - 1 + DO i = offset_a + 1, offset_a + nco(la) + so_counter = so_counter + 1 RI_basis_parameter(ikind)%sphi_ext(so_counter, la, ipgf, iset) = sphi_a(i, k) END DO END DO - s_offset_nl_a = s_offset_nl_a+nso(la)*(nl_a(la, iset)) + s_offset_nl_a = s_offset_nl_a + nso(la)*(nl_a(la, iset)) END DO END DO END DO @@ -338,9 +338,9 @@ SUBROUTINE read_RI_basis_set(qs_env, RI_basis_parameter, RI_basis_info, & ikind = kind_of(iatom) nset = RI_basis_parameter(ikind)%nset DO iset = 1, nset - RI_index_table(iatom, iset) = counter+1 - counter = counter+RI_basis_parameter(ikind)%nsgf(iset) - RI_dimen = RI_dimen+RI_basis_parameter(ikind)%nsgf(iset) + RI_index_table(iatom, iset) = counter + 1 + counter = counter + RI_basis_parameter(ikind)%nsgf(iset) + RI_dimen = RI_dimen + RI_basis_parameter(ikind)%nsgf(iset) END DO END DO @@ -601,20 +601,20 @@ SUBROUTINE calc_lai_libint(mp2_env, qs_env, para_env, & sphi_b_ext_set => sphi_b_ext(:, :, :, jset) L_B_i_start = RI_index_table(iatom, iset) - L_B_i_end = RI_index_table(iatom, iset)+nsgfa(iset)-1 + L_B_i_end = RI_index_table(iatom, iset) + nsgfa(iset) - 1 kset_start = 1 IF (iatom == katom) kset_start = iset DO kset = kset_start, nsetc - counter_L_blocks = counter_L_blocks+1 + counter_L_blocks = counter_L_blocks + 1 IF (MOD(counter_L_blocks, para_env%num_pe) /= para_env%mepos) CYCLE sphi_c_ext_set => sphi_c_ext(:, :, :, kset) sphi_d_ext_set => sphi_d_ext(:, :, :, lset) L_B_k_start = RI_index_table(katom, kset) - L_B_k_end = RI_index_table(katom, kset)+nsgfc(kset)-1 + L_B_k_end = RI_index_table(katom, kset) + nsgfc(kset) - 1 pmax_entry = 0.0_dp log10_pmax = pmax_entry @@ -656,7 +656,7 @@ SUBROUTINE calc_lai_libint(mp2_env, qs_env, para_env, & DO kkB = 1, nsgfc(kset) DO jjB = 1, nsgfb(jset) DO iiB = 1, nsgfa(iset) - primitive_counter = primitive_counter+1 + primitive_counter = primitive_counter + 1 L_block(iiB, kkB) = primitive_integrals(primitive_counter) END DO END DO @@ -706,7 +706,7 @@ SUBROUTINE calc_lai_libint(mp2_env, qs_env, para_env, & ! clean lower part DO iiB = 1, RI_dimen - L_full_matrix(iiB+1:RI_dimen, iiB) = 0.0_dp + L_full_matrix(iiB + 1:RI_dimen, iiB) = 0.0_dp END DO ALLOCATE (list_kl%elements(natom**2)) @@ -736,7 +736,7 @@ SUBROUTINE calc_lai_libint(mp2_env, qs_env, para_env, & coeffs_kind_max0, log10_eps_schwarz, cell, 0.D+00, & shm_atomic_pair_list) - virtual = dimen-occupied + virtual = dimen - occupied ALLOCATE (Lai(RI_dimen, virtual, occupied)) Lai = 0.0_dp @@ -776,7 +776,7 @@ SUBROUTINE calc_lai_libint(mp2_env, qs_env, para_env, & jset = 1 DO iset = 1, nseta - counter_L_blocks = counter_L_blocks+1 + counter_L_blocks = counter_L_blocks + 1 IF (MOD(counter_L_blocks, para_env%num_pe) /= para_env%mepos) CYCLE ncob = npgfb(jset)*ncoset(lb_max(jset)) @@ -784,7 +784,7 @@ SUBROUTINE calc_lai_libint(mp2_env, qs_env, para_env, & sphi_b_ext_set => sphi_b_ext(:, :, :, jset) L_B_i_start = RI_index_table(iatom, iset) - L_B_i_end = RI_index_table(iatom, iset)+nsgfa(iset)-1 + L_B_i_end = RI_index_table(iatom, iset) + nsgfa(iset) - 1 ALLOCATE (BI1(dimen, dimen, nsgfa(iset))) BI1 = 0.0_dp @@ -832,9 +832,9 @@ SUBROUTINE calc_lai_libint(mp2_env, qs_env, para_env, & IF (katom == latom .AND. lset < kset) CYCLE orb_k_start = mp2_biel%index_table(katom, kset) - orb_k_end = orb_k_start+nsgfc(kset)-1 + orb_k_end = orb_k_start + nsgfc(kset) - 1 orb_l_start = mp2_biel%index_table(latom, lset) - orb_l_end = orb_l_start+nsgfd(lset)-1 + orb_l_end = orb_l_start + nsgfd(lset) - 1 !! get max_vals if we screen on initial density pmax_entry = 0.0_dp @@ -880,19 +880,19 @@ SUBROUTINE calc_lai_libint(mp2_env, qs_env, para_env, & nimages, do_periodic, p_work) nints = nsgfa(iset)*nsgfb(jset)*nsgfc(kset)*nsgfd(lset) - neris_total = neris_total+nints - nprim_ints = nprim_ints+neris_tmp + neris_total = neris_total + nints + nprim_ints = nprim_ints + neris_tmp IF (cartesian_estimate == 0.0_dp) cartesian_estimate = TINY(cartesian_estimate) estimate_to_store_int = EXPONENT(cartesian_estimate) estimate_to_store_int = MAX(estimate_to_store_int, -15_int_8) - cartesian_estimate = SET_EXPONENT(1.0_dp, estimate_to_store_int+1) + cartesian_estimate = SET_EXPONENT(1.0_dp, estimate_to_store_int + 1) primitive_counter = 0 DO llB = 1, nsgfd(lset) DO kkB = 1, nsgfc(kset) DO jjB = 1, nsgfb(jset) DO iiB = 1, nsgfa(iset) - primitive_counter = primitive_counter+1 + primitive_counter = primitive_counter + 1 MNRS(llB, kkB, iiB) = primitive_integrals(primitive_counter) END DO END DO @@ -908,9 +908,9 @@ SUBROUTINE calc_lai_libint(mp2_env, qs_env, para_env, & END DO ! i_list_kl DO iiB = 1, nsgfa(iset) - BI1(1:virtual, 1:occupied, iiB) = MATMUL(TRANSPOSE(C(1:dimen, occupied+1:dimen)), & + BI1(1:virtual, 1:occupied, iiB) = MATMUL(TRANSPOSE(C(1:dimen, occupied + 1:dimen)), & MATMUL(BI1(1:dimen, 1:dimen, iiB), C(1:dimen, 1:occupied))) - Lai(L_B_i_start+iiB-1, 1:virtual, 1:occupied) = BI1(1:virtual, 1:occupied, iiB) + Lai(L_B_i_start + iiB - 1, 1:virtual, 1:occupied) = BI1(1:virtual, 1:occupied, iiB) END DO DEALLOCATE (BI1) @@ -1084,7 +1084,7 @@ SUBROUTINE prepare_integral_calc(cell, qs_env, mp2_env, para_env, mp2_potential_ i_thread = 0 - actual_x_data => qs_env%x_data(irep, i_thread+1) + actual_x_data => qs_env%x_data(irep, i_thread + 1) shm_master_x_data => qs_env%x_data(irep, 1) @@ -1301,7 +1301,7 @@ SUBROUTINE get_max_contraction(max_contraction, max_set, natom, max_pgf, kind_of sgfb = first_sgfb(1, jset) ! if the primitives are assumed to be all of max_val2, max_val2*p2s_b becomes ! the maximum value after multiplication with sphi_b - max_contraction(jset, jatom) = MAXVAL((/(SUM(ABS(sphi_b(1:ncob, i))), i=sgfb, sgfb+nsgfb(jset)-1)/)) + max_contraction(jset, jatom) = MAXVAL((/(SUM(ABS(sphi_b(1:ncob, i))), i=sgfb, sgfb + nsgfb(jset) - 1)/)) max_pgf = MAX(max_pgf, npgfb(jset)) ENDDO ENDDO diff --git a/src/mp2_setup.F b/src/mp2_setup.F index 73f378abf5..a4eebf1a90 100644 --- a/src/mp2_setup.F +++ b/src/mp2_setup.F @@ -349,10 +349,10 @@ SUBROUTINE read_mp2_section(input, mp2_env) CALL section_vals_val_get(mp2_section, "OPT_RI_BASIS%NUM_FUNC", & i_vals=tmplist) IF (tmplist(1) > 0) THEN - ALLOCATE (mp2_env%ri_opt_param%RI_nset_per_l(0:SIZE(tmplist)-1)) + ALLOCATE (mp2_env%ri_opt_param%RI_nset_per_l(0:SIZE(tmplist) - 1)) mp2_env%ri_opt_param%RI_nset_per_l = 0 DO ival = 1, SIZE(tmplist) - mp2_env%ri_opt_param%RI_nset_per_l(ival-1) = tmplist(ival) + mp2_env%ri_opt_param%RI_nset_per_l(ival - 1) = tmplist(ival) END DO END IF diff --git a/src/mp2_weights.F b/src/mp2_weights.F index c54ea02772..239a4aee01 100644 --- a/src/mp2_weights.F +++ b/src/mp2_weights.F @@ -135,12 +135,12 @@ SUBROUTINE get_minimax_weights(para_env, unit_nr, homo, Eigenval, num_integ_poin ELSE - Emin = Eigenval(homo+1)-Eigenval(homo) - Emax = MAXVAL(Eigenval)-MINVAL(Eigenval) + Emin = Eigenval(homo + 1) - Eigenval(homo) + Emax = MAXVAL(Eigenval) - MINVAL(Eigenval) IF (my_open_shell) THEN IF (homo_beta > 0) THEN - Emin_beta = Eigenval_beta(homo_beta+1)-Eigenval_beta(homo_beta) - Emax_beta = MAXVAL(Eigenval_beta)-MINVAL(Eigenval_beta) + Emin_beta = Eigenval_beta(homo_beta + 1) - Eigenval_beta(homo_beta) + Emax_beta = MAXVAL(Eigenval_beta) - MINVAL(Eigenval_beta) Emin = MIN(Emin, Emin_beta) Emax = MAX(Emax, Emax_beta) END IF @@ -163,7 +163,7 @@ SUBROUTINE get_minimax_weights(para_env, unit_nr, homo, Eigenval, num_integ_poin DO jquad = 1, num_integ_points tj(jquad) = x_tw(jquad) - wj(jquad) = x_tw(jquad+num_integ_points) + wj(jquad) = x_tw(jquad + num_integ_points) END DO DEALLOCATE (x_tw) @@ -208,7 +208,7 @@ SUBROUTINE get_minimax_weights(para_env, unit_nr, homo, Eigenval, num_integ_poin DO jquad = 1, num_integ_points tau_tj(jquad) = x_tw(jquad)/scaling - tau_wj(jquad) = x_tw(jquad+num_integ_points)/scaling + tau_wj(jquad) = x_tw(jquad + num_integ_points)/scaling END DO DEALLOCATE (x_tw) @@ -333,7 +333,7 @@ SUBROUTINE get_clenshaw_weights(para_env, para_env_RPA, unit_nr, homo, virtual, ALLOCATE (wj(num_integ_points)) wj = 0.0_dp - DO jquad = 1, num_integ_points-1 + DO jquad = 1, num_integ_points - 1 tj(jquad) = jquad*pi/(2.0_dp*num_integ_points) wj(jquad) = pi/(num_integ_points*SIN(tj(jquad))**2) END DO @@ -440,7 +440,7 @@ SUBROUTINE calc_scaling_factor(a_scaling_ext, para_env, para_env_RPA, homo, virt CALL calc_ia_ia_integrals(para_env_RPA, homo_beta, virtual_beta, nrow_local_beta, right_term_ref_beta, Eigenval_beta, & D_ia_beta, iaia_RI_beta, M_ia_beta, fm_mat_S_beta, para_env_row_beta) - right_term_ref = right_term_ref+right_term_ref_beta + right_term_ref = right_term_ref + right_term_ref_beta END IF ! bcast the result @@ -467,19 +467,19 @@ SUBROUTINE calc_scaling_factor(a_scaling_ext, para_env, para_env_RPA, homo, virt para_env, para_env_row, para_env_row_beta) left_term = left_term/4.0_dp/pi*a_scaling - IF (ABS(left_term) > ABS(right_term) .OR. ABS(left_term+right_term) <= conv_param) EXIT + IF (ABS(left_term) > ABS(right_term) .OR. ABS(left_term + right_term) <= conv_param) EXIT a_low = a_high - a_high = a_high+step + a_high = a_high + step END DO - IF (ABS(left_term+right_term) >= conv_param) THEN + IF (ABS(left_term + right_term) >= conv_param) THEN IF (a_scaling >= 2*num_integ_points*step) THEN a_scaling = 1.0_dp ELSE DO icycle = 1, num_integ_points*2 - a_scaling = (a_low+a_high)/2.0_dp + a_scaling = (a_low + a_high)/2.0_dp CALL calculate_objfunc(a_scaling, left_term, first_deriv, num_integ_points, my_open_shell, & M_ia, cottj, wj_ext, D_ia, D_ia_beta, M_ia_beta, & @@ -493,7 +493,7 @@ SUBROUTINE calc_scaling_factor(a_scaling_ext, para_env, para_env_RPA, homo, virt a_low = a_scaling END IF - IF (ABS(a_high-a_low) < 1.0e-5_dp) EXIT + IF (ABS(a_high - a_low) < 1.0e-5_dp) EXIT END DO @@ -577,7 +577,7 @@ SUBROUTINE calc_ia_ia_integrals(para_env_RPA, homo, virtual, nrow_local, right_t ! 2) perform the local multiplication SUM_K (ia|K)*(ia|K) DO jjB = 1, ncol_local DO iiB = 1, nrow_local - iaia_RI_dp(iiB) = iaia_RI_dp(iiB)+fm_mat_S%local_data(iiB, jjB)*fm_mat_S%local_data(iiB, jjB) + iaia_RI_dp(iiB) = iaia_RI_dp(iiB) + fm_mat_S%local_data(iiB, jjB)*fm_mat_S%local_data(iiB, jjB) END DO END DO @@ -621,20 +621,20 @@ SUBROUTINE calc_ia_ia_integrals(para_env_RPA, homo, virtual, nrow_local, right_t DO iiB = 1, nrow_local i_global = row_indices(iiB) - iocc = MAX(1, i_global-1)/virtual+1 - avirt = i_global-(iocc-1)*virtual - eigen_diff = Eigenval(avirt+homo)-Eigenval(iocc) + iocc = MAX(1, i_global - 1)/virtual + 1 + avirt = i_global - (iocc - 1)*virtual + eigen_diff = Eigenval(avirt + homo) - Eigenval(iocc) D_ia(iiB) = eigen_diff END DO DO iiB = 1, nrow_local - M_ia(iiB) = D_ia(iiB)*D_ia(iiB)+2.0_dp*D_ia(iiB)*iaia_RI(iiB) + M_ia(iiB) = D_ia(iiB)*D_ia(iiB) + 2.0_dp*D_ia(iiB)*iaia_RI(iiB) END DO right_term_ref = 0.0_dp DO iiB = 1, nrow_local - right_term_ref = right_term_ref+(SQRT(M_ia(iiB))-D_ia(iiB)-iaia_RI(iiB)) + right_term_ref = right_term_ref + (SQRT(M_ia(iiB)) - D_ia(iiB) - iaia_RI(iiB)) END DO right_term_ref = right_term_ref/2.0_dp @@ -705,11 +705,11 @@ SUBROUTINE calculate_objfunc(a_scaling, left_term, first_deriv, num_integ_points ! parallelize over ia elements in the para_env_row group IF (MODULO(iiB, para_env_row%num_pe) /= para_env_row%mepos) CYCLE ! calculate left_term - left_term = left_term+wj(jquad)* & - (LOG(1.0_dp+(M_ia(iiB)-D_ia(iiB)**2)/(omega**2+D_ia(iiB)**2))- & - (M_ia(iiB)-D_ia(iiB)**2)/(omega**2+D_ia(iiB)**2)) - first_deriv = first_deriv+wj(jquad)*cottj(jquad)**2* & - ((-M_ia(iiB)+D_ia(iiB)**2)**2/((omega**2+D_ia(iiB)**2)**2*(omega**2+M_ia(iiB)))) + left_term = left_term + wj(jquad)* & + (LOG(1.0_dp + (M_ia(iiB) - D_ia(iiB)**2)/(omega**2 + D_ia(iiB)**2)) - & + (M_ia(iiB) - D_ia(iiB)**2)/(omega**2 + D_ia(iiB)**2)) + first_deriv = first_deriv + wj(jquad)*cottj(jquad)**2* & + ((-M_ia(iiB) + D_ia(iiB)**2)**2/((omega**2 + D_ia(iiB)**2)**2*(omega**2 + M_ia(iiB)))) END DO IF (my_open_shell) THEN @@ -717,12 +717,12 @@ SUBROUTINE calculate_objfunc(a_scaling, left_term, first_deriv, num_integ_points ! parallelize over ia elements in the para_env_row group IF (MODULO(iiB, para_env_row_beta%num_pe) /= para_env_row_beta%mepos) CYCLE ! calculate left_term - left_term_beta = left_term_beta+wj(jquad)* & - (LOG(1.0_dp+(M_ia_beta(iiB)-D_ia_beta(iiB)**2)/(omega**2+D_ia_beta(iiB)**2))- & - (M_ia_beta(iiB)-D_ia_beta(iiB)**2)/(omega**2+D_ia_beta(iiB)**2)) + left_term_beta = left_term_beta + wj(jquad)* & + (LOG(1.0_dp + (M_ia_beta(iiB) - D_ia_beta(iiB)**2)/(omega**2 + D_ia_beta(iiB)**2)) - & + (M_ia_beta(iiB) - D_ia_beta(iiB)**2)/(omega**2 + D_ia_beta(iiB)**2)) first_deriv_beta = & - first_deriv_beta+wj(jquad)*cottj(jquad)**2* & - ((-M_ia_beta(iiB)+D_ia_beta(iiB)**2)**2/((omega**2+D_ia_beta(iiB)**2)**2*(omega**2+M_ia_beta(iiB)))) + first_deriv_beta + wj(jquad)*cottj(jquad)**2* & + ((-M_ia_beta(iiB) + D_ia_beta(iiB)**2)**2/((omega**2 + D_ia_beta(iiB)**2)**2*(omega**2 + M_ia_beta(iiB)))) END DO END IF @@ -736,8 +736,8 @@ SUBROUTINE calculate_objfunc(a_scaling, left_term, first_deriv, num_integ_points CALL mp_sum(left_term_beta, para_env%group) CALL mp_sum(first_deriv_beta, para_env%group) - left_term = left_term+left_term_beta - first_deriv = first_deriv+first_deriv_beta + left_term = left_term + left_term_beta + first_deriv = first_deriv + first_deriv_beta END IF END SUBROUTINE calculate_objfunc @@ -782,7 +782,7 @@ SUBROUTINE get_l_sq_wghts_cos_tf_t_to_w(num_integ_points, tau_tj, weights_cos_tf CALL timeset(routineN, handle) ! take num_points_per_magnitude points per 10-interval - num_x_nodes = (INT(LOG10(E_max/E_min))+1)*num_points_per_magnitude + num_x_nodes = (INT(LOG10(E_max/E_min)) + 1)*num_points_per_magnitude ! take at least as many x points as integration points to have clear ! input for the singular value decomposition @@ -806,7 +806,7 @@ SUBROUTINE get_l_sq_wghts_cos_tf_t_to_w(num_integ_points, tau_tj, weights_cos_tf mat_SinvVSinvT = 0.0_dp ! double the value nessary for 'A' to achieve good performance - lwork = 8*num_integ_points*num_integ_points+12*num_integ_points+2*num_x_nodes + lwork = 8*num_integ_points*num_integ_points + 12*num_integ_points + 2*num_x_nodes ALLOCATE (work(lwork)) work = 0.0_dp ALLOCATE (iwork(8*num_integ_points)) @@ -824,16 +824,16 @@ SUBROUTINE get_l_sq_wghts_cos_tf_t_to_w(num_integ_points, tau_tj, weights_cos_tf chi2_min_jquad = 100.0_dp ! set the x-values logarithmically in the interval [Emin,Emax] - multiplicator = (E_max/E_min)**(1.0_dp/(REAL(num_x_nodes, KIND=dp)-1.0_dp)) + multiplicator = (E_max/E_min)**(1.0_dp/(REAL(num_x_nodes, KIND=dp) - 1.0_dp)) DO iii = 1, num_x_nodes - x_values(iii) = E_min*multiplicator**(iii-1) + x_values(iii) = E_min*multiplicator**(iii - 1) END DO omega = omega_tj(jquad) ! y=2x/(x^2+omega_k^2) DO iii = 1, num_x_nodes - y_values(iii) = 2.0_dp*x_values(iii)/((x_values(iii))**2+omega**2) + y_values(iii) = 2.0_dp*x_values(iii)/((x_values(iii))**2 + omega**2) END DO ! calculate mat_A @@ -919,7 +919,7 @@ SUBROUTINE get_l_sq_wghts_sin_tf_t_to_w(num_integ_points, tau_tj, weights_sin_tf CALL timeset(routineN, handle) ! take num_points_per_magnitude points per 10-interval - num_x_nodes = (INT(LOG10(E_max/E_min))+1)*num_points_per_magnitude + num_x_nodes = (INT(LOG10(E_max/E_min)) + 1)*num_points_per_magnitude ! take at least as many x points as integration points to have clear ! input for the singular value decomposition @@ -943,7 +943,7 @@ SUBROUTINE get_l_sq_wghts_sin_tf_t_to_w(num_integ_points, tau_tj, weights_sin_tf mat_SinvVSinvT = 0.0_dp ! double the value nessary for 'A' to achieve good performance - lwork = 8*num_integ_points*num_integ_points+12*num_integ_points+2*num_x_nodes + lwork = 8*num_integ_points*num_integ_points + 12*num_integ_points + 2*num_x_nodes ALLOCATE (work(lwork)) work = 0.0_dp ALLOCATE (iwork(8*num_integ_points)) @@ -961,9 +961,9 @@ SUBROUTINE get_l_sq_wghts_sin_tf_t_to_w(num_integ_points, tau_tj, weights_sin_tf chi2_min_jquad = 100.0_dp ! set the x-values logarithmically in the interval [Emin,Emax] - multiplicator = (E_max/E_min)**(1.0_dp/(REAL(num_x_nodes, KIND=dp)-1.0_dp)) + multiplicator = (E_max/E_min)**(1.0_dp/(REAL(num_x_nodes, KIND=dp) - 1.0_dp)) DO iii = 1, num_x_nodes - x_values(iii) = E_min*multiplicator**(iii-1) + x_values(iii) = E_min*multiplicator**(iii - 1) END DO omega = omega_tj(jquad) @@ -971,7 +971,7 @@ SUBROUTINE get_l_sq_wghts_sin_tf_t_to_w(num_integ_points, tau_tj, weights_sin_tf ! y=2x/(x^2+omega_k^2) DO iii = 1, num_x_nodes ! y_values(iii) = 2.0_dp*x_values(iii)/((x_values(iii))**2+omega**2) - y_values(iii) = 2.0_dp*omega/((x_values(iii))**2+omega**2) + y_values(iii) = 2.0_dp*omega/((x_values(iii))**2 + omega**2) END DO ! calculate mat_A @@ -1050,8 +1050,8 @@ PURE SUBROUTINE calc_max_error_fit_tau_grid_with_cosine(max_error, omega, tau_tj CALL eval_fit_func_tau_grid_cosine(func_val, x_values(kkk), num_integ_points, tau_tj, tau_wj_work, omega) - IF (ABS(y_values(kkk)-func_val) > max_error_tmp) THEN - max_error_tmp = ABS(y_values(kkk)-func_val) + IF (ABS(y_values(kkk) - func_val) > max_error_tmp) THEN + max_error_tmp = ABS(y_values(kkk) - func_val) func_val_temp = func_val END IF @@ -1093,7 +1093,7 @@ PURE SUBROUTINE eval_fit_func_tau_grid_cosine(func_val, x_value, num_integ_point DO iii = 1, num_integ_points ! calculate value of the fit function - func_val = func_val+tau_wj_work(iii)*COS(omega*tau_tj(iii))*EXP(-x_value*tau_tj(iii)) + func_val = func_val + tau_wj_work(iii)*COS(omega*tau_tj(iii))*EXP(-x_value*tau_tj(iii)) END DO @@ -1127,7 +1127,7 @@ PURE SUBROUTINE eval_fit_func_tau_grid_sine(func_val, x_value, num_integ_points, DO iii = 1, num_integ_points ! calculate value of the fit function - func_val = func_val+tau_wj_work(iii)*SIN(omega*tau_tj(iii))*EXP(-x_value*tau_tj(iii)) + func_val = func_val + tau_wj_work(iii)*SIN(omega*tau_tj(iii))*EXP(-x_value*tau_tj(iii)) END DO @@ -1166,8 +1166,8 @@ PURE SUBROUTINE calc_max_error_fit_tau_grid_with_sine(max_error, omega, tau_tj, CALL eval_fit_func_tau_grid_sine(func_val, x_values(kkk), num_integ_points, tau_tj, tau_wj_work, omega) - IF (ABS(y_values(kkk)-func_val) > max_error_tmp) THEN - max_error_tmp = ABS(y_values(kkk)-func_val) + IF (ABS(y_values(kkk) - func_val) > max_error_tmp) THEN + max_error_tmp = ABS(y_values(kkk) - func_val) func_val_temp = func_val END IF @@ -1197,7 +1197,7 @@ SUBROUTINE test_least_square_ft(nR, iw) Rc_max = 1.0E+7 - multiplicator = Rc_max**(1.0_dp/(REAL(nR, KIND=dp)-1.0_dp)) + multiplicator = Rc_max**(1.0_dp/(REAL(nR, KIND=dp) - 1.0_dp)) DO num_integ_points = 1, 20 @@ -1214,7 +1214,7 @@ SUBROUTINE test_least_square_ft(nR, iw) ALLOCATE (wj(num_integ_points)) wj = 0.0_dp - DO iR = 0, nR-1 + DO iR = 0, nR - 1 Rc = 2.0_dp*multiplicator**iR @@ -1223,7 +1223,7 @@ SUBROUTINE test_least_square_ft(nR, iw) DO jquad = 1, num_integ_points tj(jquad) = x_tw(jquad) - wj(jquad) = x_tw(jquad+num_integ_points) + wj(jquad) = x_tw(jquad + num_integ_points) END DO x_tw = 0.0_dp @@ -1232,7 +1232,7 @@ SUBROUTINE test_least_square_ft(nR, iw) DO jquad = 1, num_integ_points tau_tj(jquad) = x_tw(jquad)/2.0_dp - tau_wj(jquad) = x_tw(jquad+num_integ_points)/2.0_dp + tau_wj(jquad) = x_tw(jquad + num_integ_points)/2.0_dp END DO CALL get_l_sq_wghts_cos_tf_t_to_w(num_integ_points, tau_tj, weights_cos_tf_t_to_w, tj, & @@ -1291,7 +1291,7 @@ SUBROUTINE get_l_sq_wghts_cos_tf_w_to_t(num_integ_points, tau_tj, weights_cos_tf CALL timeset(routineN, handle) ! take num_points_per_magnitude points per 10-interval - num_x_nodes = (INT(LOG10(E_max/E_min))+1)*num_points_per_magnitude + num_x_nodes = (INT(LOG10(E_max/E_min)) + 1)*num_points_per_magnitude ! take at least as many x points as integration points to have clear ! input for the singular value decomposition @@ -1315,7 +1315,7 @@ SUBROUTINE get_l_sq_wghts_cos_tf_w_to_t(num_integ_points, tau_tj, weights_cos_tf mat_SinvVSinvT = 0.0_dp ! double the value nessary for 'A' to achieve good performance - lwork = 8*num_integ_points*num_integ_points+12*num_integ_points+2*num_x_nodes + lwork = 8*num_integ_points*num_integ_points + 12*num_integ_points + 2*num_x_nodes ALLOCATE (work(lwork)) work = 0.0_dp ALLOCATE (iwork(8*num_integ_points)) @@ -1326,9 +1326,9 @@ SUBROUTINE get_l_sq_wghts_cos_tf_w_to_t(num_integ_points, tau_tj, weights_cos_tf vec_UTy = 0.0_dp ! set the x-values logarithmically in the interval [Emin,Emax] - multiplicator = (E_max/E_min)**(1.0_dp/(REAL(num_x_nodes, KIND=dp)-1.0_dp)) + multiplicator = (E_max/E_min)**(1.0_dp/(REAL(num_x_nodes, KIND=dp) - 1.0_dp)) DO iii = 1, num_x_nodes - x_values(iii) = E_min*multiplicator**(iii-1) + x_values(iii) = E_min*multiplicator**(iii - 1) END DO max_error = 0.0_dp @@ -1350,7 +1350,7 @@ SUBROUTINE get_l_sq_wghts_cos_tf_w_to_t(num_integ_points, tau_tj, weights_cos_tf DO iii = 1, num_x_nodes omega = omega_tj(jjj) x_value = x_values(iii) - mat_A(iii, jjj) = COS(tau*omega)*2.0_dp*x_value/(x_value**2+omega**2) + mat_A(iii, jjj) = COS(tau*omega)*2.0_dp*x_value/(x_value**2 + omega**2) END DO END DO @@ -1427,8 +1427,8 @@ SUBROUTINE calc_max_error_fit_omega_grid_with_cosine(max_error, tau, omega_tj, o CALL eval_fit_func_omega_grid_cosine(func_val, x_values(kkk), num_integ_points, omega_tj, omega_wj_work, tau) - IF (ABS(y_values(kkk)-func_val) > max_error_tmp) THEN - max_error_tmp = ABS(y_values(kkk)-func_val) + IF (ABS(y_values(kkk) - func_val) > max_error_tmp) THEN + max_error_tmp = ABS(y_values(kkk) - func_val) func_val_temp = func_val END IF @@ -1473,7 +1473,7 @@ PURE SUBROUTINE eval_fit_func_omega_grid_cosine(func_val, x_value, num_integ_poi ! calculate value of the fit function omega = omega_tj(iii) - func_val = func_val+omega_wj_work(iii)*COS(tau*omega)*2.0_dp*x_value/(x_value**2+omega**2) + func_val = func_val + omega_wj_work(iii)*COS(tau*omega)*2.0_dp*x_value/(x_value**2 + omega**2) END DO @@ -1516,7 +1516,7 @@ SUBROUTINE gap_and_max_eig_diff_kpoints(qs_env, para_env, gap, max_eig_diff, e_f CALL get_mo_set(mo_set, nmo=nmo) CALL get_kpoint_info(kpoint, kp_range=kp_range) - kplocal = kp_range(2)-kp_range(1)+1 + kplocal = kp_range(2) - kp_range(1) + 1 gap = 1000.0_dp max_eig_diff = 0.0_dp @@ -1530,24 +1530,24 @@ SUBROUTINE gap_and_max_eig_diff_kpoints(qs_env, para_env, gap, max_eig_diff, e_f mo_set => kp%mos(1, ispin)%mo_set CALL get_mo_set(mo_set, eigenvalues=eigenvalues, homo=homo) e_homo_temp = eigenvalues(homo) - e_lumo_temp = eigenvalues(homo+1) + e_lumo_temp = eigenvalues(homo + 1) IF (e_homo_temp > e_homo) e_homo = e_homo_temp IF (e_lumo_temp < e_lumo) e_lumo = e_lumo_temp - IF (eigenvalues(nmo)-eigenvalues(1) > max_eig_diff) max_eig_diff = eigenvalues(nmo)-eigenvalues(1) + IF (eigenvalues(nmo) - eigenvalues(1) > max_eig_diff) max_eig_diff = eigenvalues(nmo) - eigenvalues(1) END DO END DO - ALLOCATE (e_homo_array(0:para_env%num_pe-1)) + ALLOCATE (e_homo_array(0:para_env%num_pe - 1)) e_homo_array = 0.0_dp e_homo_array(para_env%mepos) = e_homo - ALLOCATE (e_lumo_array(0:para_env%num_pe-1)) + ALLOCATE (e_lumo_array(0:para_env%num_pe - 1)) e_lumo_array = 0.0_dp e_lumo_array(para_env%mepos) = e_lumo - ALLOCATE (max_eig_diff_array(0:para_env%num_pe-1)) + ALLOCATE (max_eig_diff_array(0:para_env%num_pe - 1)) max_eig_diff_array = 0.0_dp max_eig_diff_array(para_env%mepos) = max_eig_diff @@ -1557,9 +1557,9 @@ SUBROUTINE gap_and_max_eig_diff_kpoints(qs_env, para_env, gap, max_eig_diff, e_f CALL mp_sum(max_eig_diff_array, para_env%group) - gap = MINVAL(e_lumo_array)-MAXVAL(e_homo_array) + gap = MINVAL(e_lumo_array) - MAXVAL(e_homo_array) - e_fermi = (MAXVAL(e_homo_array)+MINVAL(e_lumo_array))/2.0_dp + e_fermi = (MAXVAL(e_homo_array) + MINVAL(e_lumo_array))/2.0_dp max_eig_diff = MAXVAL(max_eig_diff_array) diff --git a/src/mscfg_methods.F b/src/mscfg_methods.F index 0004894ed3..bee758328a 100644 --- a/src/mscfg_methods.F +++ b/src/mscfg_methods.F @@ -197,7 +197,7 @@ SUBROUTINE calcs_on_isolated_molecules(force_env, globenv, nfrags, & IF (smear_almo_scf) THEN scf_section => section_vals_get_subs_vals(dft_section, "SCF") CALL section_vals_val_get(scf_section, "added_mos", i_val=tot_added_mos) !! Get total number of added MOs - tot_isize = last_atom_of_frag(nfrags)-first_atom_of_frag(1)+1 !! Get total number of atoms (assume consecutive atoms) + tot_isize = last_atom_of_frag(nfrags) - first_atom_of_frag(1) + 1 !! Get total number of atoms (assume consecutive atoms) !! Check that number of added MOs matches the number of atoms !! (to ensure compatibility, since each fragment will be computed with such parameters) IF (tot_isize .NE. tot_added_mos) THEN @@ -258,7 +258,7 @@ SUBROUTINE calcs_on_isolated_molecules(force_env, globenv, nfrags, & ! It is important to have a linear scaling procedure here first_atom = first_atom_of_frag(ifrag) last_atom = last_atom_of_frag(ifrag) - isize = last_atom-first_atom+1 + isize = last_atom - first_atom + 1 ALLOCATE (atom_index(isize)) atom_index(1:isize) = (/(i, i=first_atom, last_atom)/) ! @@ -324,10 +324,10 @@ SUBROUTINE calcs_on_isolated_molecules(force_env, globenv, nfrags, & IF (smear_almo_scf) THEN !! Store MOs energies for ALMO smearing purpose nmo_of_frag = SIZE(mos_of_frag(imo)%mo_set%eigenvalues) - almo_scf_env%mo_energies(nb_eigenval_stored+1:nb_eigenval_stored+nmo_of_frag, imo) & + almo_scf_env%mo_energies(nb_eigenval_stored + 1:nb_eigenval_stored + nmo_of_frag, imo) & = mos_of_frag(imo)%mo_set%eigenvalues(:) !! update stored energies offset. Assumes nmosets_of_frag == 1 (general smearing ALMO assumption) - nb_eigenval_stored = nb_eigenval_stored+nmo_of_frag + nb_eigenval_stored = nb_eigenval_stored + nmo_of_frag END IF END IF !! ALMO diff --git a/src/mscfg_types.F b/src/mscfg_types.F index 97f5599794..f53d528913 100644 --- a/src/mscfg_types.F +++ b/src/mscfg_types.F @@ -166,8 +166,8 @@ SUBROUTINE get_matrix_from_submatrices(mscfg_env, matrix_out, iset) CALL dbcsr_add(matrix_out, matrix_temp, 1.0_dp, 1.0_dp) - offset(1) = offset(1)+submatrix_size(1) - offset(2) = offset(2)+submatrix_size(2) + offset(1) = offset(1) + submatrix_size(1) + offset(2) = offset(2) + submatrix_size(2) ENDDO @@ -225,13 +225,13 @@ SUBROUTINE copy_submatrix_into_matrix(submatrix_in, matrix_out, & add_blocks_before(dimen) = 0 add_blocks_after = 0 start_index = 1 - trailing_size = matrix_size(dimen)-offset(dimen)-submatrix_size(dimen) + trailing_size = matrix_size(dimen) - offset(dimen) - submatrix_size(dimen) IF (offset(dimen) .GT. 0) THEN - add_blocks_before(dimen) = add_blocks_before(dimen)+1 + add_blocks_before(dimen) = add_blocks_before(dimen) + 1 start_index = 2 ENDIF IF (trailing_size .GT. 0) THEN - add_blocks_after = add_blocks_after+1 + add_blocks_after = add_blocks_after + 1 ENDIF IF (dimen == 1) THEN !rows @@ -243,7 +243,7 @@ SUBROUTINE copy_submatrix_into_matrix(submatrix_in, matrix_out, & ENDIF nblocks = SIZE(blk_sizes) ! number of blocks in the small matrix - nblocks_new = nblocks+add_blocks_before(dimen)+add_blocks_after + nblocks_new = nblocks + add_blocks_before(dimen) + add_blocks_after ALLOCATE (block_sizes_new(nblocks_new)) ALLOCATE (distr_new_array(nblocks_new)) !IF (ASSOCIATED(cluster_distr)) THEN @@ -256,8 +256,8 @@ SUBROUTINE copy_submatrix_into_matrix(submatrix_in, matrix_out, & !cluster_distr_new(1) = 0 !END IF ENDIF - block_sizes_new(start_index:nblocks+start_index-1) = blk_sizes(1:nblocks) - distr_new_array(start_index:nblocks+start_index-1) = blk_distr(1:nblocks) + block_sizes_new(start_index:nblocks + start_index - 1) = blk_sizes(1:nblocks) + distr_new_array(start_index:nblocks + start_index - 1) = blk_distr(1:nblocks) !IF (ASSOCIATED(cluster_distr)) THEN !cluster_distr_new(start_index:nblocks+start_index-1) = cluster_distr(1:nblocks) !END IF @@ -313,8 +313,8 @@ SUBROUTINE copy_submatrix_into_matrix(submatrix_in, matrix_out, & ! to work NULLIFY (p_new_block) CALL dbcsr_reserve_block2d(matrix_new, & - iblock_row+add_blocks_before(1), & - iblock_col+add_blocks_before(2), & + iblock_row + add_blocks_before(1), & + iblock_col + add_blocks_before(2), & p_new_block) CPASSERT(ASSOCIATED(p_new_block)) diff --git a/src/mulliken.F b/src/mulliken.F index 5ac1ea6e0b..b864ca7894 100644 --- a/src/mulliken.F +++ b/src/mulliken.F @@ -121,10 +121,10 @@ SUBROUTINE mulliken_restraint(mulliken_restraint_control, para_env, & IF (.NOT. (ASSOCIATED(s_block) .AND. ASSOCIATED(ks_block))) THEN CPABORT("Unexpected s / ks structure") END IF - mult = 0.5_dp*charges_deriv(iblock_row, ispin)+ & + mult = 0.5_dp*charges_deriv(iblock_row, ispin) + & 0.5_dp*charges_deriv(iblock_col, ispin) - ks_block = ks_block+mult*s_block + ks_block = ks_block + mult*s_block ENDDO CALL dbcsr_iterator_stop(iter) @@ -146,9 +146,9 @@ SUBROUTINE mulliken_restraint(mulliken_restraint_control, para_env, & ! minus sign relates to convention for W mult = -0.5_dp*charges_deriv(iblock_row, ispin) & - -0.5_dp*charges_deriv(iblock_col, ispin) + - 0.5_dp*charges_deriv(iblock_col, ispin) - w_block = w_block+mult*p_block + w_block = w_block + mult*p_block END DO CALL dbcsr_iterator_stop(iter) @@ -189,13 +189,13 @@ SUBROUTINE restraint_functional(mulliken_restraint_control, charges, & order_p = 0.0_dp DO I = 1, mulliken_restraint_control%natoms - order_p = order_p+charges(mulliken_restraint_control%atoms(I), 1) & - -charges(mulliken_restraint_control%atoms(I), 2) ! spin density on the relevant atoms + order_p = order_p + charges(mulliken_restraint_control%atoms(I), 1) & + - charges(mulliken_restraint_control%atoms(I), 2) ! spin density on the relevant atoms ENDDO ! energy - energy = mulliken_restraint_control%strength*(order_p-mulliken_restraint_control%target)**2 + energy = mulliken_restraint_control%strength*(order_p - mulliken_restraint_control%target)**2 ! derivative - dum = 2*mulliken_restraint_control%strength*(order_p-mulliken_restraint_control%target) + dum = 2*mulliken_restraint_control%strength*(order_p - mulliken_restraint_control%target) DO I = 1, mulliken_restraint_control%natoms charges_deriv(mulliken_restraint_control%atoms(I), 1) = dum charges_deriv(mulliken_restraint_control%atoms(I), 2) = -dum @@ -245,9 +245,9 @@ SUBROUTINE compute_charges(p_matrix, s_matrix, charges, para_env) ELSE mult = 1.0_dp ENDIF - charges(iblock_row, ispin) = charges(iblock_row, ispin)+ & + charges(iblock_row, ispin) = charges(iblock_row, ispin) + & mult*SUM(p_block*s_block) - charges(iblock_col, ispin) = charges(iblock_col, ispin)+ & + charges(iblock_col, ispin) = charges(iblock_col, ispin) + & mult*SUM(p_block*s_block) ENDDO @@ -294,8 +294,8 @@ SUBROUTINE compute_charges_single(p_matrix, s_matrix, charges, para_env) ELSE mult = 1.0_dp ENDIF - charges(iblock_row) = charges(iblock_row)+mult*SUM(p_block*s_block) - charges(iblock_col) = charges(iblock_col)+mult*SUM(p_block*s_block) + charges(iblock_row) = charges(iblock_row) + mult*SUM(p_block*s_block) + charges(iblock_col) = charges(iblock_col) + mult*SUM(p_block*s_block) ENDDO CALL dbcsr_iterator_stop(iter) @@ -346,13 +346,13 @@ SUBROUTINE compute_dcharges(p_matrix, s_matrix, charges, dcharges, para_env) ELSE mult = 1.0_dp ENDIF - charges(iblock_row, ispin) = charges(iblock_row, ispin)+mult*SUM(p_block*s_block) - charges(iblock_col, ispin) = charges(iblock_col, ispin)+mult*SUM(p_block*s_block) + charges(iblock_row, ispin) = charges(iblock_row, ispin) + mult*SUM(p_block*s_block) + charges(iblock_col, ispin) = charges(iblock_col, ispin) + mult*SUM(p_block*s_block) DO ider = 1, 3 - CALL dbcsr_get_block_p(matrix=s_matrix(ider+1)%matrix, & + CALL dbcsr_get_block_p(matrix=s_matrix(ider + 1)%matrix, & row=iblock_row, col=iblock_col, BLOCK=ds_block, found=found) - dcharges(iblock_row, ider) = dcharges(iblock_row, ider)+mult*SUM(p_block*ds_block) - dcharges(iblock_col, ider) = dcharges(iblock_col, ider)+mult*SUM(p_block*ds_block) + dcharges(iblock_row, ider) = dcharges(iblock_row, ider) + mult*SUM(p_block*ds_block) + dcharges(iblock_col, ider) = dcharges(iblock_col, ider) + mult*SUM(p_block*ds_block) END DO ENDDO @@ -541,7 +541,7 @@ SUBROUTINE mulliken_charges_akp(p_matrix_kp, s_matrix_kp, para_env, particle_set s_matrix => s_matrix_kp(1, ic)%matrix charges_im = 0.0_dp CALL compute_charges(p_matrix, s_matrix, charges_im, para_env) - charges(:, :) = charges(:, :)+charges_im(:, :) + charges(:, :) = charges(:, :) + charges_im(:, :) END DO CALL print_atomic_charges(particle_set, qs_kind_set, scr, title, electronic_charges=charges) @@ -588,7 +588,7 @@ SUBROUTINE mulliken_charges_bkp(p_matrix_kp, s_matrix_kp, para_env, mcharge) s_matrix => s_matrix_kp(1, ic)%matrix IF (ASSOCIATED(p_matrix) .AND. ASSOCIATED(s_matrix)) THEN CALL compute_charges(p_matrix, s_matrix, mcharge_im, para_env) - mcharge(:, :) = mcharge(:, :)+mcharge_im(:, :) + mcharge(:, :) = mcharge(:, :) + mcharge_im(:, :) END IF END DO @@ -639,8 +639,8 @@ SUBROUTINE mulliken_charges_ckp(p_matrix_kp, s_matrix_kp, para_env, & s_matrix => s_matrix_kp(:, ic) IF (ASSOCIATED(p_matrix) .AND. ASSOCIATED(s_matrix)) THEN CALL compute_dcharges(p_matrix, s_matrix, mcharge_im, dmcharge_im, para_env) - mcharge(:, :) = mcharge(:, :)+mcharge_im(:, :) - dmcharge(:, :) = dmcharge(:, :)+dmcharge_im(:, :) + mcharge(:, :) = mcharge(:, :) + mcharge_im(:, :) + dmcharge(:, :) = dmcharge(:, :) + dmcharge_im(:, :) END IF END DO @@ -679,7 +679,7 @@ SUBROUTINE compute_bond_order(psmat, spmat, bond_order) IF (.NOT. found) CYCLE IF (.NOT. (ASSOCIATED(sp) .AND. ASSOCIATED(ps))) CYCLE - bond_order(iat, jat) = bond_order(iat, jat)+SUM(ps*sp) + bond_order(iat, jat) = bond_order(iat, jat) + SUM(ps*sp) ENDDO CALL dbcsr_iterator_stop(iter) @@ -731,13 +731,13 @@ SUBROUTINE ao_charges_1(p_matrix, s_matrix, charges, iatom, para_env) IF (iblock_row == iatom) THEN DO j = 1, SIZE(p_block, 2) DO i = 1, SIZE(p_block, 1) - charges(i) = charges(i)+p_block(i, j)*s_block(i, j) + charges(i) = charges(i) + p_block(i, j)*s_block(i, j) END DO END DO ELSEIF (iblock_col == iatom) THEN DO j = 1, SIZE(p_block, 2) DO i = 1, SIZE(p_block, 1) - charges(j) = charges(j)+p_block(i, j)*s_block(i, j) + charges(j) = charges(j) + p_block(i, j)*s_block(i, j) END DO END DO END IF @@ -793,13 +793,13 @@ SUBROUTINE ao_charges_2(p_matrix, s_matrix, charges, para_env) DO j = 1, SIZE(p_block, 2) DO i = 1, SIZE(p_block, 1) - charges(i, iblock_row) = charges(i, iblock_row)+p_block(i, j)*s_block(i, j) + charges(i, iblock_row) = charges(i, iblock_row) + p_block(i, j)*s_block(i, j) END DO END DO IF (iblock_col /= iblock_row) THEN DO j = 1, SIZE(p_block, 2) DO i = 1, SIZE(p_block, 1) - charges(j, iblock_col) = charges(j, iblock_col)+p_block(i, j)*s_block(i, j) + charges(j, iblock_col) = charges(j, iblock_col) + p_block(i, j)*s_block(i, j) END DO END DO END IF @@ -849,7 +849,7 @@ SUBROUTINE ao_charges_kp(p_matrix_kp, s_matrix_kp, charges, iatom, para_env) s_matrix => s_matrix_kp(1, ic)%matrix IF (ASSOCIATED(p_matrix) .AND. ASSOCIATED(s_matrix)) THEN CALL ao_charges_1(p_matrix, s_matrix, charge_im, iatom, para_env) - charges(:) = charges(:)+charge_im(:) + charges(:) = charges(:) + charge_im(:) END IF END DO @@ -897,7 +897,7 @@ SUBROUTINE ao_charges_kp_2(p_matrix_kp, s_matrix_kp, charges, para_env) s_matrix => s_matrix_kp(1, ic)%matrix IF (ASSOCIATED(p_matrix) .AND. ASSOCIATED(s_matrix)) THEN CALL ao_charges_2(p_matrix, s_matrix, charge_im, para_env) - charges(:, :) = charges(:, :)+charge_im(:, :) + charges(:, :) = charges(:, :) + charge_im(:, :) END IF END DO diff --git a/src/negf_atom_map.F b/src/negf_atom_map.F index 60a1b14468..dbcacffe72 100644 --- a/src/negf_atom_map.F +++ b/src/negf_atom_map.F @@ -117,11 +117,11 @@ SUBROUTINE negf_map_atomic_indices(atom_map, atom_list, subsys_device, subsys_co ! loop over matching atoms DO iatom_kind = 1, kind_groups_contact(ikind_contact)%natoms - coords(1:3) = particle_set_device(atom_index_device)%r(1:3)- & + coords(1:3) = particle_set_device(atom_index_device)%r(1:3) - & kind_groups_contact(ikind_contact)%r(1:3, iatom_kind) CALL real_to_scaled(coords_scaled, coords, cell_contact) - coords_error = coords_scaled-REAL(NINT(coords_scaled), kind=dp) + coords_error = coords_scaled - REAL(NINT(coords_scaled), kind=dp) IF (SQRT(DOT_PRODUCT(coords_error, coords_error)) < eps_geometry) THEN atom_map(iatom)%iatom = kind_groups_contact(ikind_contact)%atom_list(iatom_kind) @@ -186,7 +186,7 @@ SUBROUTINE qs_kind_groups_create(kind_groups, particle_set, qs_kind_set) DO iatom = 1, natoms CALL get_atomic_kind(particle_set(iatom)%atomic_kind, kind_number=ikind) - kind_groups(ikind)%natoms = kind_groups(ikind)%natoms+1 + kind_groups(ikind)%natoms = kind_groups(ikind)%natoms + 1 END DO DO ikind = 1, nkinds @@ -198,7 +198,7 @@ SUBROUTINE qs_kind_groups_create(kind_groups, particle_set, qs_kind_set) DO iatom = 1, natoms CALL get_atomic_kind(particle_set(iatom)%atomic_kind, kind_number=ikind) - kind_groups(ikind)%natoms = kind_groups(ikind)%natoms+1 + kind_groups(ikind)%natoms = kind_groups(ikind)%natoms + 1 kind_groups(ikind)%atom_list(kind_groups(ikind)%natoms) = iatom kind_groups(ikind)%r(1:3, kind_groups(ikind)%natoms) = particle_set(iatom)%r(1:3) diff --git a/src/negf_control_types.F b/src/negf_control_types.F index 633ec94d7e..d2bb826e53 100644 --- a/src/negf_control_types.F +++ b/src/negf_control_types.F @@ -354,16 +354,16 @@ SUBROUTINE read_negf_control(negf_control, input, subsys) END IF IF (n_rep > 0) THEN - delta_npoles_min = NINT(0.5_dp*(negf_control%eta/(pi*MAXVAL(negf_control%contacts(:)%temperature))+1.0_dp)) + delta_npoles_min = NINT(0.5_dp*(negf_control%eta/(pi*MAXVAL(negf_control%contacts(:)%temperature)) + 1.0_dp)) ELSE delta_npoles_min = 1 END IF IF (negf_control%delta_npoles < delta_npoles_min) THEN IF (n_rep > 0) THEN - eta_max = REAL(2*negf_control%delta_npoles-1, kind=dp)*pi*MAXVAL(negf_control%contacts(:)%temperature) + eta_max = REAL(2*negf_control%delta_npoles - 1, kind=dp)*pi*MAXVAL(negf_control%contacts(:)%temperature) temp_current = MAXVAL(negf_control%contacts(:)%temperature)*kelvin - temp_min = negf_control%eta/(pi*REAL(2*negf_control%delta_npoles-1, kind=dp))*kelvin + temp_min = negf_control%eta/(pi*REAL(2*negf_control%delta_npoles - 1, kind=dp))*kelvin WRITE (eta_current_str, '(ES11.4E2)') negf_control%eta WRITE (eta_max_str, '(ES11.4E2)') eta_max @@ -398,7 +398,7 @@ SUBROUTINE read_negf_control(negf_control, input, subsys) DO i_rep = 1, n_rep IF (ALLOCATED(negf_control%contacts(i_rep)%atomlist_screening)) THEN IF (ALLOCATED(negf_control%contacts(i_rep)%atomlist_screening)) & - natoms_total = natoms_total+SIZE(negf_control%contacts(i_rep)%atomlist_screening) + natoms_total = natoms_total + SIZE(negf_control%contacts(i_rep)%atomlist_screening) END IF END DO @@ -415,10 +415,10 @@ SUBROUTINE read_negf_control(negf_control, input, subsys) IF (ALLOCATED(negf_control%contacts(i_rep)%atomlist_screening)) THEN natoms_current = SIZE(negf_control%contacts(i_rep)%atomlist_screening) - negf_control%atomlist_S_screening(natoms_total+1:natoms_total+natoms_current) = & + negf_control%atomlist_S_screening(natoms_total + 1:natoms_total + natoms_current) = & negf_control%contacts(i_rep)%atomlist_screening(1:natoms_current) - natoms_total = natoms_total+natoms_current + natoms_total = natoms_total + natoms_current END IF END DO @@ -428,9 +428,9 @@ SUBROUTINE read_negf_control(negf_control, input, subsys) DEALLOCATE (inds) natoms_current = 1 - DO i_rep = natoms_current+1, natoms_total + DO i_rep = natoms_current + 1, natoms_total IF (negf_control%atomlist_S_screening(i_rep) /= negf_control%atomlist_S_screening(natoms_current)) THEN - natoms_current = natoms_current+1 + natoms_current = natoms_current + 1 negf_control%atomlist_S_screening(natoms_current) = negf_control%atomlist_S_screening(i_rep) END IF END DO @@ -513,7 +513,7 @@ SUBROUTINE read_negf_atomlist(atomlist, input_section, i_rep_section, subsys) END IF END DO - natoms_total = natoms_total+natoms_current + natoms_total = natoms_total + natoms_current END DO END IF @@ -534,8 +534,8 @@ SUBROUTINE read_negf_atomlist(atomlist, input_section, i_rep_section, subsys) DO imol = 1, nmols molecule => molecule_set(iptr(imol)) CALL get_molecule(molecule, first_atom=first_atom, last_atom=last_atom) - natoms_current = last_atom-first_atom+1 - natoms_total = natoms_total+natoms_current + natoms_current = last_atom - first_atom + 1 + natoms_total = natoms_total + natoms_current END DO ELSE CALL cp_abort(__LOCATION__, & @@ -557,8 +557,8 @@ SUBROUTINE read_negf_atomlist(atomlist, input_section, i_rep_section, subsys) CALL section_vals_val_get(input_section, "LIST", i_rep_section=i_rep_section, i_rep_val=irep, i_vals=iptr) natoms_current = SIZE(iptr) - atomlist(natoms_total+1:natoms_total+natoms_current) = iptr(1:natoms_current) - natoms_total = natoms_total+natoms_current + atomlist(natoms_total + 1:natoms_total + natoms_current) = iptr(1:natoms_current) + natoms_total = natoms_total + natoms_current END DO END IF @@ -581,7 +581,7 @@ SUBROUTINE read_negf_atomlist(atomlist, input_section, i_rep_section, subsys) CALL get_molecule(molecule, first_atom=first_atom, last_atom=last_atom) DO natoms_current = first_atom, last_atom - natoms_total = natoms_total+1 + natoms_total = natoms_total + 1 atomlist(natoms_total) = natoms_current END DO END DO @@ -596,9 +596,9 @@ SUBROUTINE read_negf_atomlist(atomlist, input_section, i_rep_section, subsys) DEALLOCATE (inds) natoms_current = 1 - DO iatom = natoms_current+1, natoms_total + DO iatom = natoms_current + 1, natoms_total IF (atomlist(iatom) /= atomlist(natoms_current)) THEN - natoms_current = natoms_current+1 + natoms_current = natoms_current + 1 atomlist(natoms_current) = atomlist(iatom) END IF END DO diff --git a/src/negf_env_types.F b/src/negf_env_types.F index d7c407b66d..cd3ea0f936 100644 --- a/src/negf_env_types.F +++ b/src/negf_env_types.F @@ -610,21 +610,21 @@ SUBROUTINE negf_env_contact_init_matrices_gamma(contact_env, contact_control, su origin = particle_set(contact_control%atomlist_screening(1))%r DO iatom = 2, SIZE(contact_control%atomlist_screening) - origin = origin+particle_set(contact_control%atomlist_screening(iatom))%r + origin = origin + particle_set(contact_control%atomlist_screening(iatom))%r END DO origin = origin/REAL(SIZE(contact_control%atomlist_screening), kind=dp) DO icell = 1, 2 direction_vector = particle_set(contact_control%atomlist_cell(icell)%vector(1))%r DO iatom = 2, SIZE(contact_control%atomlist_cell(icell)%vector) - direction_vector = direction_vector+particle_set(contact_control%atomlist_cell(icell)%vector(iatom))%r + direction_vector = direction_vector + particle_set(contact_control%atomlist_cell(icell)%vector(iatom))%r END DO direction_vector = direction_vector/REAL(SIZE(contact_control%atomlist_cell(icell)%vector), kind=dp) - direction_vector = direction_vector-origin + direction_vector = direction_vector - origin r2_origin_cell(icell) = DOT_PRODUCT(direction_vector, direction_vector) END DO - IF (SQRT(ABS(r2_origin_cell(1)-r2_origin_cell(2))) < eps_geometry) THEN + IF (SQRT(ABS(r2_origin_cell(1) - r2_origin_cell(2))) < eps_geometry) THEN ! primary and secondary bulk unit cells should not overlap; ! currently we check that they are different by at least one atom that is, indeed, not sufficient. CALL cp_abort(__LOCATION__, & @@ -883,7 +883,7 @@ SUBROUTINE negf_env_init_v_hartree(v_hartree, contact_env, contact_control) CPASSERT(SIZE(contact_control) == ncontacts) CPASSERT(ncontacts == 2) - dirvector_bias = contact_env(2)%origin_bias-contact_env(1)%origin_bias + dirvector_bias = contact_env(2)%origin_bias - contact_env(1)%origin_bias v1 = contact_control(1)%v_external v2 = contact_control(2)%v_external @@ -901,17 +901,17 @@ SUBROUTINE negf_env_init_v_hartree(v_hartree, contact_env, contact_control) dvol = v_hartree%pw_grid%dvol DO iz = lz, uz - point_indices(3) = REAL(iz+dz, kind=dp) + point_indices(3) = REAL(iz + dz, kind=dp) DO iy = ly, uy - point_indices(2) = REAL(iy+dy, kind=dp) + point_indices(2) = REAL(iy + dy, kind=dp) DO ix = lx, ux - point_indices(1) = REAL(ix+dx, kind=dp) + point_indices(1) = REAL(ix + dx, kind=dp) point_coord(:) = MATMUL(v_hartree%pw_grid%dh, point_indices) - vector = point_coord-contact_env(1)%origin_bias + vector = point_coord - contact_env(1)%origin_bias proj = projection_on_direction_vector(vector, dirvector_bias) - IF (proj+threshold >= 0.0_dp .AND. proj-threshold <= 1.0_dp) THEN + IF (proj + threshold >= 0.0_dp .AND. proj - threshold <= 1.0_dp) THEN ! scattering region ! proj == 0 we are at the first contact boundary ! proj == 1 we are at the second contact boundary @@ -920,14 +920,14 @@ SUBROUTINE negf_env_init_v_hartree(v_hartree, contact_env, contact_control) ELSE IF (proj > 1.0_dp) THEN proj = 1.0_dp END IF - pot = v1+(v2-v1)*proj + pot = v1 + (v2 - v1)*proj ELSE pot = 0.0_dp DO icontact = 1, ncontacts - vector = point_coord-contact_env(icontact)%origin_bias + vector = point_coord - contact_env(icontact)%origin_bias proj = projection_on_direction_vector(vector, contact_env(icontact)%direction_vector_bias) - IF (proj+threshold >= 0.0_dp .AND. proj-threshold <= 1.0_dp) THEN + IF (proj + threshold >= 0.0_dp .AND. proj - threshold <= 1.0_dp) THEN pot = contact_control(icontact)%v_external EXIT END IF @@ -977,7 +977,7 @@ FUNCTION contact_direction_axis(direction_vector, subsys_contact, eps_geometry) ELSE direction_axis = -i END IF - naxes = naxes+1 + naxes = naxes + 1 END IF END DO @@ -1022,7 +1022,7 @@ SUBROUTINE negf_homo_energy_estimate(homo_energy, qs_env) ! looking for a processor that holds the gamma point IF (para_env_kp%mepos == 0 .AND. kp_range(1) <= gamma_point .AND. kp_range(2) >= gamma_point) THEN - kplocal = kp_range(2)-kp_range(1)+1 + kplocal = kp_range(2) - kp_range(1) + 1 DO ikpgr = 1, kplocal CALL get_kpoint_env(kp_env(ikpgr)%kpoint_env, nkpoint=ikpoint, mos=mos_kp) @@ -1113,7 +1113,7 @@ SUBROUTINE list_atoms_in_bulk_primary_unit_cell(atomlist_cell0, atom_map_cell0, proj_min = 1.0_dp atom_min = 1 DO iatom = 1, natoms_bulk - vector = particle_set(atomlist_bulk(iatom))%r-origin + vector = particle_set(atomlist_bulk(iatom))%r - origin proj = projection_on_direction_vector(vector, direction_vector) IF (proj < proj_min) THEN @@ -1127,7 +1127,7 @@ SUBROUTINE list_atoms_in_bulk_primary_unit_cell(atomlist_cell0, atom_map_cell0, natoms_cell0 = 0 DO iatom = 1, natoms_bulk IF (atom_map(iatom)%cell(direction_axis_abs) == dir_axis_min) & - natoms_cell0 = natoms_cell0+1 + natoms_cell0 = natoms_cell0 + 1 END DO ALLOCATE (atomlist_cell0(natoms_cell0)) @@ -1136,7 +1136,7 @@ SUBROUTINE list_atoms_in_bulk_primary_unit_cell(atomlist_cell0, atom_map_cell0, natoms_cell0 = 0 DO iatom = 1, natoms_bulk IF (atom_map(iatom)%cell(direction_axis_abs) == dir_axis_min) THEN - natoms_cell0 = natoms_cell0+1 + natoms_cell0 = natoms_cell0 + 1 atomlist_cell0(natoms_cell0) = atomlist_bulk(iatom) atom_map_cell0(natoms_cell0) = atom_map(iatom) END IF @@ -1195,7 +1195,7 @@ SUBROUTINE list_atoms_in_bulk_secondary_unit_cell(atomlist_cell1, atom_map_cell1 proj_min = 1.0_dp atom_min = 1 DO iatom = 1, natoms_bulk - vector = particle_set(atomlist_bulk(iatom))%r-origin + vector = particle_set(atomlist_bulk(iatom))%r - origin proj = projection_on_direction_vector(vector, direction_vector) IF (proj < proj_min) THEN @@ -1208,8 +1208,8 @@ SUBROUTINE list_atoms_in_bulk_secondary_unit_cell(atomlist_cell1, atom_map_cell1 natoms_cell1 = 0 DO iatom = 1, natoms_bulk - IF (atom_map(iatom)%cell(direction_axis_abs) == dir_axis_min+offset) & - natoms_cell1 = natoms_cell1+1 + IF (atom_map(iatom)%cell(direction_axis_abs) == dir_axis_min + offset) & + natoms_cell1 = natoms_cell1 + 1 END DO ALLOCATE (atomlist_cell1(natoms_cell1)) @@ -1217,8 +1217,8 @@ SUBROUTINE list_atoms_in_bulk_secondary_unit_cell(atomlist_cell1, atom_map_cell1 natoms_cell1 = 0 DO iatom = 1, natoms_bulk - IF (atom_map(iatom)%cell(direction_axis_abs) == dir_axis_min+offset) THEN - natoms_cell1 = natoms_cell1+1 + IF (atom_map(iatom)%cell(direction_axis_abs) == dir_axis_min + offset) THEN + natoms_cell1 = natoms_cell1 + 1 atomlist_cell1(natoms_cell1) = atomlist_bulk(iatom) atom_map_cell1(natoms_cell1) = atom_map(iatom) atom_map_cell1(natoms_cell1)%cell(direction_axis_abs) = dir_axis_min diff --git a/src/negf_green_cache.F b/src/negf_green_cache.F index 61919a2247..2e14d768fe 100644 --- a/src/negf_green_cache.F +++ b/src/negf_green_cache.F @@ -65,7 +65,7 @@ SUBROUTINE green_functions_cache_expand(cache, ncontacts, nnodes_extra) nentries_exist = 0 END IF - ALLOCATE (g_surf_contacts(ncontacts, nentries_exist+nnodes_extra)) + ALLOCATE (g_surf_contacts(ncontacts, nentries_exist + nnodes_extra)) IF (is_alloc) THEN DO i = 1, nentries_exist @@ -79,7 +79,7 @@ SUBROUTINE green_functions_cache_expand(cache, ncontacts, nnodes_extra) DO i = 1, nnodes_extra DO icontact = 1, ncontacts - NULLIFY (g_surf_contacts(icontact, nentries_exist+i)%matrix) + NULLIFY (g_surf_contacts(icontact, nentries_exist + i)%matrix) END DO END DO diff --git a/src/negf_green_methods.F b/src/negf_green_methods.F index f208bb4fe2..d871e6fc58 100644 --- a/src/negf_green_methods.F +++ b/src/negf_green_methods.F @@ -179,7 +179,7 @@ SUBROUTINE do_sancho(g_surf, omega, h0, s0, h1, s1, conv, transp, work) END IF ! actually compute the Green's function - DO WHILE (cp_cfm_norm(work%b, 'M')+cp_cfm_norm(work%c, 'M') > conv) + DO WHILE (cp_cfm_norm(work%b, 'M') + cp_cfm_norm(work%c, 'M') > conv) ! A_n^-1 CALL cp_cfm_to_cfm(work%a, work%a_inv) CALL cp_cfm_lu_invert(work%a_inv) diff --git a/src/negf_integr_cc.F b/src/negf_integr_cc.F index 7763598ce1..99e85dbb1d 100644 --- a/src/negf_integr_cc.F +++ b/src/negf_integr_cc.F @@ -129,7 +129,7 @@ SUBROUTINE ccquad_init(cc_env, xnodes, nnodes, a, b, interval_id, shape_id, weig CPASSERT(ASSOCIATED(weights)) ! ensure that MOD(nnodes-1, 2) == 0 - nnodes = 2*((nnodes-1)/2)+1 + nnodes = 2*((nnodes - 1)/2) + 1 cc_env%interval_id = interval_id cc_env%shape_id = shape_id @@ -151,7 +151,7 @@ SUBROUTINE ccquad_init(cc_env, xnodes, nnodes, a, b, interval_id, shape_id, weig SELECT CASE (interval_id) CASE (cc_interval_full) - nnodes_half = nnodes/2+1 + nnodes_half = nnodes/2 + 1 CASE (cc_interval_half) nnodes_half = nnodes CASE DEFAULT @@ -169,17 +169,17 @@ SUBROUTINE ccquad_init(cc_env, xnodes, nnodes, a, b, interval_id, shape_id, weig ! Moreover, by applying this rescaling transformation to the end-points we cannot guarantee the exact ! result due to rounding errors in evaluation of COS function. IF (nnodes_half > 2) & - CALL rescale_nodes_cos(nnodes_half-2, cc_env%tnodes(2:)) + CALL rescale_nodes_cos(nnodes_half - 2, cc_env%tnodes(2:)) SELECT CASE (interval_id) CASE (cc_interval_full) ! reflect symmetric nodes - DO ipoint = nnodes_half-1, 1, -1 - cc_env%tnodes(nnodes_half+ipoint) = -cc_env%tnodes(nnodes_half-ipoint) + DO ipoint = nnodes_half - 1, 1, -1 + cc_env%tnodes(nnodes_half + ipoint) = -cc_env%tnodes(nnodes_half - ipoint) END DO CASE (cc_interval_half) ! rescale half-interval : [-1 .. 0] -> [-1 .. 1] - cc_env%tnodes(1:nnodes_half) = 2.0_dp*cc_env%tnodes(1:nnodes_half)+1.0_dp + cc_env%tnodes(1:nnodes_half) = 2.0_dp*cc_env%tnodes(1:nnodes_half) + 1.0_dp END SELECT END IF @@ -257,7 +257,7 @@ SUBROUTINE ccquad_double_number_of_points(cc_env, xnodes_next) nnodes_exist = SIZE(cc_env%zdata_cache) ! new nodes will be placed between the existed ones, so the number of nodes ! on the left half-interval [-1 .. 0] is equal to nnodes_exist - 1 - nnodes_half = nnodes_exist-1 + nnodes_half = nnodes_exist - 1 SELECT CASE (cc_env%interval_id) CASE (cc_interval_full) @@ -272,7 +272,7 @@ SUBROUTINE ccquad_double_number_of_points(cc_env, xnodes_next) ALLOCATE (xnodes_next(nnodes_next)) ALLOCATE (tnodes(nnodes_next)) - CALL equidistant_nodes_a_b(0.5_dp/REAL(nnodes_half, kind=dp)-1.0_dp, & + CALL equidistant_nodes_a_b(0.5_dp/REAL(nnodes_half, kind=dp) - 1.0_dp, & -0.5_dp/REAL(nnodes_half, kind=dp), & nnodes_half, tnodes) @@ -282,20 +282,20 @@ SUBROUTINE ccquad_double_number_of_points(cc_env, xnodes_next) CASE (cc_interval_full) ! reflect symmetric nodes DO ipoint = 1, nnodes_half - tnodes(nnodes_half+ipoint) = -tnodes(nnodes_half-ipoint+1) + tnodes(nnodes_half + ipoint) = -tnodes(nnodes_half - ipoint + 1) END DO CASE (cc_interval_half) ! rescale half-interval : [-1 .. 0] -> [-1 .. 1] - tnodes(1:nnodes_half) = 2.0_dp*tnodes(1:nnodes_half)+1.0_dp + tnodes(1:nnodes_half) = 2.0_dp*tnodes(1:nnodes_half) + 1.0_dp END SELECT ! append new tnodes to the cache CALL MOVE_ALLOC(cc_env%tnodes, tnodes_old) nnodes_exist = SIZE(tnodes_old) - ALLOCATE (cc_env%tnodes(nnodes_exist+nnodes_next)) + ALLOCATE (cc_env%tnodes(nnodes_exist + nnodes_next)) cc_env%tnodes(1:nnodes_exist) = tnodes_old(1:nnodes_exist) - cc_env%tnodes(nnodes_exist+1:nnodes_exist+nnodes_next) = tnodes(1:nnodes_next) + cc_env%tnodes(nnodes_exist + 1:nnodes_exist + nnodes_next) = tnodes(1:nnodes_next) DEALLOCATE (tnodes_old) ! rescale nodes [-1 .. 1] -> [a .. b] according to the shape @@ -340,7 +340,7 @@ SUBROUTINE ccquad_reduce_and_append_zdata(cc_env, zdata_next) CPASSERT(nnodes_exist >= nnodes_next) ALLOCATE (zscale(nnodes_next)) - CALL rescale_normalised_nodes(nnodes_next, cc_env%tnodes(nnodes_exist-nnodes_next+1:nnodes_exist), & + CALL rescale_normalised_nodes(nnodes_next, cc_env%tnodes(nnodes_exist - nnodes_next + 1:nnodes_exist), & cc_env%a, cc_env%b, cc_env%shape_id, weights=zscale) IF (cc_env%interval_id == cc_interval_half) zscale(:) = 2.0_dp*zscale(:) @@ -361,15 +361,15 @@ SUBROUTINE ccquad_reduce_and_append_zdata(cc_env, zdata_next) SELECT CASE (cc_env%interval_id) CASE (cc_interval_full) IF (ALLOCATED(cc_env%zdata_cache)) THEN - CPASSERT(nnodes_exist == nnodes_next/2+1) - nnodes_half = nnodes_exist-1 + CPASSERT(nnodes_exist == nnodes_next/2 + 1) + nnodes_half = nnodes_exist - 1 ELSE CPASSERT(MOD(nnodes_next, 2) == 1) - nnodes_half = nnodes_next/2+1 + nnodes_half = nnodes_next/2 + 1 END IF CASE (cc_interval_half) IF (ALLOCATED(cc_env%zdata_cache)) THEN - CPASSERT(nnodes_exist == nnodes_next+1) + CPASSERT(nnodes_exist == nnodes_next + 1) END IF nnodes_half = nnodes_next @@ -377,20 +377,20 @@ SUBROUTINE ccquad_reduce_and_append_zdata(cc_env, zdata_next) IF (cc_env%interval_id == cc_interval_full) THEN DO ipoint = nnodes_next/2, 1, -1 - CALL cp_cfm_scale_and_add(z_one, zdata_next(ipoint)%matrix, z_one, zdata_next(nnodes_next-ipoint+1)%matrix) + CALL cp_cfm_scale_and_add(z_one, zdata_next(ipoint)%matrix, z_one, zdata_next(nnodes_next - ipoint + 1)%matrix) END DO END IF IF (ALLOCATED(cc_env%zdata_cache)) THEN ! note that nnodes_half+1 == nnodes_exist for both half- and full-intervals - ALLOCATE (zdata_tmp(nnodes_half+nnodes_exist)) + ALLOCATE (zdata_tmp(nnodes_half + nnodes_exist)) DO ipoint = 1, nnodes_half - zdata_tmp(2*ipoint-1)%matrix => cc_env%zdata_cache(ipoint)%matrix + zdata_tmp(2*ipoint - 1)%matrix => cc_env%zdata_cache(ipoint)%matrix zdata_tmp(2*ipoint)%matrix => zdata_next(ipoint)%matrix NULLIFY (zdata_next(ipoint)%matrix) END DO - zdata_tmp(nnodes_half+nnodes_exist)%matrix => cc_env%zdata_cache(nnodes_exist)%matrix + zdata_tmp(nnodes_half + nnodes_exist)%matrix => cc_env%zdata_cache(nnodes_exist)%matrix DEALLOCATE (cc_env%zdata_cache) CALL MOVE_ALLOC(zdata_tmp, cc_env%zdata_cache) @@ -436,10 +436,10 @@ SUBROUTINE ccquad_refine_integral(cc_env) CPASSERT(ALLOCATED(cc_env%zdata_cache)) nintervals_half_plus_1 = SIZE(cc_env%zdata_cache) - nintervals_half = nintervals_half_plus_1-1 - nintervals_half_plus_2 = nintervals_half_plus_1+1 + nintervals_half = nintervals_half_plus_1 - 1 + nintervals_half_plus_2 = nintervals_half_plus_1 + 1 nintervals = 2*nintervals_half - nintervals_plus_2 = nintervals+2 + nintervals_plus_2 = nintervals + 2 CPASSERT(nintervals_half > 1) IF (.NOT. ASSOCIATED(cc_env%integral)) THEN @@ -464,12 +464,12 @@ SUBROUTINE ccquad_refine_integral(cc_env) ! omit the trivial weights(1) = 0.5 DO ipoint = 2, nintervals_half - rscale = REAL(2*(ipoint-1), kind=dp) - weights(ipoint) = 1.0_dp/(1.0_dp-rscale*rscale) + rscale = REAL(2*(ipoint - 1), kind=dp) + weights(ipoint) = 1.0_dp/(1.0_dp - rscale*rscale) END DO ! weights(1) <- weights(intervals_half + 1) rscale = REAL(nintervals, kind=dp) - weights(1) = 1.0_dp/(1.0_dp-rscale*rscale) + weights(1) = 1.0_dp/(1.0_dp - rscale*rscale) ! 1.0 / nintervals rscale = 1.0_dp/rscale @@ -486,7 +486,7 @@ SUBROUTINE ccquad_refine_integral(cc_env) END DO DO ipoint = 2, nintervals_half - ztmp(nintervals_half+ipoint, irow, icol) = ztmp(nintervals_half_plus_2-ipoint, irow, icol) + ztmp(nintervals_half + ipoint, irow, icol) = ztmp(nintervals_half_plus_2 - ipoint, irow, icol) END DO END DO END DO @@ -506,8 +506,8 @@ SUBROUTINE ccquad_refine_integral(cc_env) DO irow = 1, nrows_local ztmp_dct(1, irow, icol) = 0.5_dp*ztmp_dct(1, irow, icol) DO ipoint = 2, nintervals_half - ztmp_dct(ipoint, irow, icol) = 0.5_dp*weights(ipoint)*(ztmp_dct(ipoint, irow, icol)+ & - ztmp_dct(nintervals_plus_2-ipoint, irow, icol)) + ztmp_dct(ipoint, irow, icol) = 0.5_dp*weights(ipoint)*(ztmp_dct(ipoint, irow, icol) + & + ztmp_dct(nintervals_plus_2 - ipoint, irow, icol)) END DO ztmp_dct(nintervals_half_plus_1, irow, icol) = weights(1)*ztmp_dct(nintervals_half_plus_1, irow, icol) diff --git a/src/negf_integr_simpson.F b/src/negf_integr_simpson.F index b75e3025a1..01da6a1e8c 100644 --- a/src/negf_integr_simpson.F +++ b/src/negf_integr_simpson.F @@ -141,7 +141,7 @@ SUBROUTINE simpsonrule_init(sr_env, xnodes, nnodes, a, b, shape_id, conv, weight CPASSERT(ASSOCIATED(weights)) ! ensure that MOD(nnodes-1, 4) == 0 - nnodes = 4*((nnodes-1)/4)+1 + nnodes = 4*((nnodes - 1)/4) + 1 sr_env%shape_id = shape_id sr_env%a = a @@ -248,9 +248,9 @@ SUBROUTINE simpsonrule_get_next_nodes(sr_env, xnodes_next, nnodes) CALL MOVE_ALLOC(sr_env%tnodes, tnodes_old) nnodes_old = SIZE(tnodes_old) - ALLOCATE (sr_env%tnodes(nnodes_old+nnodes)) + ALLOCATE (sr_env%tnodes(nnodes_old + nnodes)) sr_env%tnodes(1:nnodes_old) = tnodes_old(1:nnodes_old) - sr_env%tnodes(nnodes_old+1:nnodes_old+nnodes) = tnodes(1:nnodes) + sr_env%tnodes(nnodes_old + 1:nnodes_old + nnodes) = tnodes(1:nnodes) DEALLOCATE (tnodes_old) CALL rescale_normalised_nodes(nnodes, tnodes, sr_env%a, sr_env%b, sr_env%shape_id, xnodes_next) @@ -291,13 +291,13 @@ SUBROUTINE simpsonrule_get_next_nodes_real(sr_env, xnodes_unity, nnodes) nintervals = SIZE(xnodes_unity)/4 DO interval = 1, nintervals - xnodes_unity(4*interval-3) = 0.125_dp* & - (7.0_dp*sr_env%subintervals(interval)%lb+sr_env%subintervals(interval)%ub) - xnodes_unity(4*interval-2) = 0.125_dp* & - (5.0_dp*sr_env%subintervals(interval)%lb+3.0_dp*sr_env%subintervals(interval)%ub) - xnodes_unity(4*interval-1) = 0.125_dp* & - (3.0_dp*sr_env%subintervals(interval)%lb+5.0_dp*sr_env%subintervals(interval)%ub) - xnodes_unity(4*interval) = 0.125_dp*(sr_env%subintervals(interval)%lb+7.0_dp*sr_env%subintervals(interval)%ub) + xnodes_unity(4*interval - 3) = 0.125_dp* & + (7.0_dp*sr_env%subintervals(interval)%lb + sr_env%subintervals(interval)%ub) + xnodes_unity(4*interval - 2) = 0.125_dp* & + (5.0_dp*sr_env%subintervals(interval)%lb + 3.0_dp*sr_env%subintervals(interval)%ub) + xnodes_unity(4*interval - 1) = 0.125_dp* & + (3.0_dp*sr_env%subintervals(interval)%lb + 5.0_dp*sr_env%subintervals(interval)%ub) + xnodes_unity(4*interval) = 0.125_dp*(sr_env%subintervals(interval)%lb + 7.0_dp*sr_env%subintervals(interval)%ub) END DO END IF @@ -352,7 +352,7 @@ SUBROUTINE simpsonrule_refine_integral(sr_env, zdata_next) CPASSERT(nintervals_exist >= npoints) ALLOCATE (zscale(npoints)) - CALL rescale_normalised_nodes(npoints, sr_env%tnodes(nintervals_exist-npoints+1:nintervals_exist), & + CALL rescale_normalised_nodes(npoints, sr_env%tnodes(nintervals_exist - npoints + 1:nintervals_exist), & sr_env%a, sr_env%b, sr_env%shape_id, weights=zscale) ! rescale integrand values @@ -369,36 +369,36 @@ SUBROUTINE simpsonrule_refine_integral(sr_env, zdata_next) nintervals_exist = SIZE(sr_env%subintervals) CPASSERT(nintervals <= nintervals_exist) - ALLOCATE (subintervals(nintervals_exist+nintervals)) + ALLOCATE (subintervals(nintervals_exist + nintervals)) DO interval = 1, nintervals - subintervals(2*interval-1)%lb = sr_env%subintervals(interval)%lb - subintervals(2*interval-1)%ub = 0.5_dp*(sr_env%subintervals(interval)%lb+sr_env%subintervals(interval)%ub) - subintervals(2*interval-1)%conv = 0.5_dp*sr_env%subintervals(interval)%conv - subintervals(2*interval-1)%fa => sr_env%subintervals(interval)%fa - subintervals(2*interval-1)%fb => zdata_next(4*interval-3)%matrix - subintervals(2*interval-1)%fc => sr_env%subintervals(interval)%fb - subintervals(2*interval-1)%fd => zdata_next(4*interval-2)%matrix - subintervals(2*interval-1)%fe => sr_env%subintervals(interval)%fc - CALL cp_cfm_retain(subintervals(2*interval-1)%fe) - - subintervals(2*interval)%lb = subintervals(2*interval-1)%ub + subintervals(2*interval - 1)%lb = sr_env%subintervals(interval)%lb + subintervals(2*interval - 1)%ub = 0.5_dp*(sr_env%subintervals(interval)%lb + sr_env%subintervals(interval)%ub) + subintervals(2*interval - 1)%conv = 0.5_dp*sr_env%subintervals(interval)%conv + subintervals(2*interval - 1)%fa => sr_env%subintervals(interval)%fa + subintervals(2*interval - 1)%fb => zdata_next(4*interval - 3)%matrix + subintervals(2*interval - 1)%fc => sr_env%subintervals(interval)%fb + subintervals(2*interval - 1)%fd => zdata_next(4*interval - 2)%matrix + subintervals(2*interval - 1)%fe => sr_env%subintervals(interval)%fc + CALL cp_cfm_retain(subintervals(2*interval - 1)%fe) + + subintervals(2*interval)%lb = subintervals(2*interval - 1)%ub subintervals(2*interval)%ub = sr_env%subintervals(interval)%ub - subintervals(2*interval)%conv = subintervals(2*interval-1)%conv + subintervals(2*interval)%conv = subintervals(2*interval - 1)%conv subintervals(2*interval)%fa => sr_env%subintervals(interval)%fc - subintervals(2*interval)%fb => zdata_next(4*interval-1)%matrix + subintervals(2*interval)%fb => zdata_next(4*interval - 1)%matrix subintervals(2*interval)%fc => sr_env%subintervals(interval)%fd subintervals(2*interval)%fd => zdata_next(4*interval)%matrix subintervals(2*interval)%fe => sr_env%subintervals(interval)%fe - NULLIFY (zdata_next(4*interval-3)%matrix) - NULLIFY (zdata_next(4*interval-2)%matrix) - NULLIFY (zdata_next(4*interval-1)%matrix) + NULLIFY (zdata_next(4*interval - 3)%matrix) + NULLIFY (zdata_next(4*interval - 2)%matrix) + NULLIFY (zdata_next(4*interval - 1)%matrix) NULLIFY (zdata_next(4*interval)%matrix) END DO - DO interval = nintervals+1, nintervals_exist - subintervals(interval+nintervals) = sr_env%subintervals(interval) + DO interval = nintervals + 1, nintervals_exist + subintervals(interval + nintervals) = sr_env%subintervals(interval) END DO DEALLOCATE (sr_env%subintervals) ELSE @@ -418,19 +418,19 @@ SUBROUTINE simpsonrule_refine_integral(sr_env, zdata_next) DO interval = 1, nintervals ! lower bound: point with indices 1, 5, 9, ..., 4*nintervals+1 - subintervals(interval)%lb = sr_env%tnodes(4*interval-3) - subintervals(interval)%ub = sr_env%tnodes(4*interval+1) + subintervals(interval)%lb = sr_env%tnodes(4*interval - 3) + subintervals(interval)%ub = sr_env%tnodes(4*interval + 1) subintervals(interval)%conv = rscale*sr_env%conv - subintervals(interval)%fa => zdata_next(4*interval-3)%matrix - subintervals(interval)%fb => zdata_next(4*interval-2)%matrix - subintervals(interval)%fc => zdata_next(4*interval-1)%matrix + subintervals(interval)%fa => zdata_next(4*interval - 3)%matrix + subintervals(interval)%fb => zdata_next(4*interval - 2)%matrix + subintervals(interval)%fc => zdata_next(4*interval - 1)%matrix subintervals(interval)%fd => zdata_next(4*interval)%matrix - subintervals(interval)%fe => zdata_next(4*interval+1)%matrix + subintervals(interval)%fe => zdata_next(4*interval + 1)%matrix CALL cp_cfm_retain(subintervals(interval)%fe) END DO - CALL cp_cfm_release(zdata_next(4*nintervals+1)%matrix) + CALL cp_cfm_release(zdata_next(4*nintervals + 1)%matrix) END IF ! we kept the originals matrices for internal use, so nullify the pointers @@ -448,7 +448,7 @@ SUBROUTINE simpsonrule_refine_integral(sr_env, zdata_next) nintervals_exist = SIZE(subintervals) DO interval = 1, nintervals_exist - rscale = subintervals(interval)%ub-subintervals(interval)%lb + rscale = subintervals(interval)%ub - subintervals(interval)%lb CALL do_simpson_rule(sr_env%integral_ace, & subintervals(interval)%fa, & subintervals(interval)%fc, & @@ -484,12 +484,12 @@ SUBROUTINE simpsonrule_refine_integral(sr_env, zdata_next) error_rdata(:, :) = ABS(error_zdata(:, :)) CALL cp_fm_trace(sr_env%error_fm, sr_env%weights, subintervals(interval)%error) - sr_env%error = sr_env%error+subintervals(interval)%error + sr_env%error = sr_env%error + subintervals(interval)%error ! add contributions from converged subintervals, so we could drop them afterward IF (subintervals(interval)%error <= subintervals(interval)%conv) THEN CALL cp_cfm_scale_and_add(z_one, sr_env%integral_conv, z_one, sr_env%integral_abc) - sr_env%error_conv = sr_env%error_conv+subintervals(interval)%error + sr_env%error_conv = sr_env%error_conv + subintervals(interval)%error END IF END DO @@ -519,7 +519,7 @@ SUBROUTINE simpsonrule_refine_integral(sr_env, zdata_next) errors(interval) = subintervals(interval)%error IF (subintervals(interval)%error > subintervals(interval)%conv) & - nintervals = nintervals+1 + nintervals = nintervals + 1 END DO CALL sort(errors, nintervals_exist, inds) @@ -532,7 +532,7 @@ SUBROUTINE simpsonrule_refine_integral(sr_env, zdata_next) interval = inds(ipoint) IF (subintervals(interval)%error > subintervals(interval)%conv) THEN - nintervals = nintervals+1 + nintervals = nintervals + 1 sr_env%subintervals(nintervals) = subintervals(interval) ELSE diff --git a/src/negf_matrix_utils.F b/src/negf_matrix_utils.F index 726f3a55d9..fcf74395b3 100644 --- a/src/negf_matrix_utils.F +++ b/src/negf_matrix_utils.F @@ -70,7 +70,7 @@ FUNCTION number_of_atomic_orbitals(subsys, atom_list) RESULT(nao) nao = 0 DO iatom = 1, natoms - nao = nao+nsgfs(atom_list(iatom)) + nao = nao + nsgfs(atom_list(iatom)) END DO ELSE nao = SUM(nsgfs) @@ -142,14 +142,14 @@ SUBROUTINE negf_copy_fm_submat_to_dbcsr(fm, matrix, atomlist_row, atomlist_col, ncols = nsgfs(atomlist_col(iatom_col)) DO icol = 1, ncols DO irow = 1, nrows - sm_block(irow, icol) = fm_block(first_sgf_row+irow-1, first_sgf_col+icol-1) + sm_block(irow, icol) = fm_block(first_sgf_row + irow - 1, first_sgf_col + icol - 1) END DO END DO END IF - first_sgf_row = first_sgf_row+nsgfs(atomlist_row(iatom_row)) + first_sgf_row = first_sgf_row + nsgfs(atomlist_row(iatom_row)) END DO - first_sgf_col = first_sgf_col+nsgfs(atomlist_col(iatom_col)) + first_sgf_col = first_sgf_col + nsgfs(atomlist_col(iatom_col)) END DO DEALLOCATE (fm_block) @@ -247,7 +247,7 @@ SUBROUTINE negf_copy_sym_dbcsr_to_fm_submat(matrix, fm, atomlist_row, atomlist_c IF (do_upper_diag) THEN DO icol = nsgfs(atomlist_col(iatom_col)), 1, -1 DO irow = nsgfs(atomlist_row(iatom_row)), 1, -1 - r2d(offset_sgf_row+irow, offset_sgf_col+icol) = sm_block(irow, icol) + r2d(offset_sgf_row + irow, offset_sgf_col + icol) = sm_block(irow, icol) END DO END DO END IF @@ -255,16 +255,16 @@ SUBROUTINE negf_copy_sym_dbcsr_to_fm_submat(matrix, fm, atomlist_row, atomlist_c IF (do_lower) THEN DO icol = nsgfs(atomlist_col(iatom_col)), 1, -1 DO irow = nsgfs(atomlist_row(iatom_row)), 1, -1 - r2d(offset_sgf_row+irow, offset_sgf_col+icol) = sm_block(icol, irow) + r2d(offset_sgf_row + irow, offset_sgf_col + icol) = sm_block(icol, irow) END DO END DO END IF END IF END IF - offset_sgf_row = offset_sgf_row+nsgfs(atomlist_row(iatom_row)) + offset_sgf_row = offset_sgf_row + nsgfs(atomlist_row(iatom_row)) END DO - offset_sgf_col = offset_sgf_col+nsgfs(atomlist_col(iatom_col)) + offset_sgf_col = offset_sgf_col + nsgfs(atomlist_col(iatom_col)) END DO CALL mp_sum(r2d, mpi_comm_global) @@ -379,7 +379,7 @@ SUBROUTINE negf_copy_contact_matrix(fm_cell0, fm_cell1, direction_axis, matrix_k IF (found) THEN ! it should be much safe to rely on atomic indices (iatom / jatom) obtained using a neighbour list iterator: ! phase == 1 when iatom <= jatom, and phase == -1 when iatom > jatom - IF (MOD(iatom_col-iatom_row, 2) == 0) THEN + IF (MOD(iatom_col - iatom_row, 2) == 0) THEN phase = 1 ELSE phase = -1 @@ -390,13 +390,13 @@ SUBROUTINE negf_copy_contact_matrix(fm_cell0, fm_cell1, direction_axis, matrix_k block=block_dest, found=found) CPASSERT(found) - error_same = MAXVAL(ABS(block_dest(:, :)-block_src(:, :))) + error_same = MAXVAL(ABS(block_dest(:, :) - block_src(:, :))) CALL dbcsr_get_block_p(matrix=matrix_cells_raw(phase)%matrix, & row=iatom_row, col=iatom_col, & block=block_dest, found=found) CPASSERT(found) - error_diff = MAXVAL(ABS(block_dest(:, :)-block_src(:, :))) + error_diff = MAXVAL(ABS(block_dest(:, :) - block_src(:, :))) IF (error_same <= error_diff) THEN is_same_cell(iatom_row, iatom_col) = 0 @@ -415,7 +415,7 @@ SUBROUTINE negf_copy_contact_matrix(fm_cell0, fm_cell1, direction_axis, matrix_k IF (found) THEN ! it should be much safe to rely on a neighbour list iterator - IF (MOD(iatom_col-iatom_row, 2) == 0) THEN + IF (MOD(iatom_col - iatom_row, 2) == 0) THEN phase = 1 ELSE phase = -1 @@ -436,7 +436,7 @@ SUBROUTINE negf_copy_contact_matrix(fm_cell0, fm_cell1, direction_axis, matrix_k CALL dbcsr_get_block_p(matrix=matrix_cell_1, & row=iatom_row, col=iatom_col, block=block_dest, found=found) CPASSERT(found) - CALL dbcsr_get_block_p(matrix=matrix_cells_raw(rep+phase)%matrix, & + CALL dbcsr_get_block_p(matrix=matrix_cells_raw(rep + phase)%matrix, & row=iatom_row, col=iatom_col, block=block_src, found=found) CPASSERT(found) block_dest(:, :) = block_src(:, :) @@ -447,7 +447,7 @@ SUBROUTINE negf_copy_contact_matrix(fm_cell0, fm_cell1, direction_axis, matrix_k CALL dbcsr_get_block_p(matrix=matrix_cell_minus1, & row=iatom_row, col=iatom_col, block=block_dest, found=found) CPASSERT(found) - CALL dbcsr_get_block_p(matrix=matrix_cells_raw(rep-phase)%matrix, & + CALL dbcsr_get_block_p(matrix=matrix_cells_raw(rep - phase)%matrix, & row=iatom_row, col=iatom_col, block=block_src, found=found) CPASSERT(found) block_dest(:, :) = block_src(:, :) @@ -519,7 +519,7 @@ SUBROUTINE negf_reference_contact_matrix(matrix_contact, matrix_device, atom_lis DIMENSION(:) :: recv_packed_blocks, send_packed_blocks CALL timeset(routineN, handle) - mepos_plus1 = para_env%mepos+1 + mepos_plus1 = para_env%mepos + 1 natoms = SIZE(atom_list) max_atom = 0 @@ -579,14 +579,14 @@ SUBROUTINE negf_reference_contact_matrix(matrix_contact, matrix_device, atom_lis IF (found) THEN iproc = rank_contact(irow, icol) IF (iproc > 0) & - send_nelems(iproc) = send_nelems(iproc)+SIZE(rblock) + send_nelems(iproc) = send_nelems(iproc) + SIZE(rblock) END IF CALL dbcsr_get_block_p(matrix=matrix_contact, row=irow, col=icol, block=rblock, found=found) IF (found) THEN iproc = rank_device(irow, icol) IF (iproc > 0) & - recv_nelems(iproc) = recv_nelems(iproc)+SIZE(rblock) + recv_nelems(iproc) = recv_nelems(iproc) + SIZE(rblock) END IF END DO END DO @@ -630,16 +630,16 @@ SUBROUTINE negf_reference_contact_matrix(matrix_contact, matrix_device, atom_lis IF (transp) THEN DO i1 = 1, n1 DO i2 = 1, n2 - send_packed_blocks(iproc)%vector(offset+i2) = rblock(i1, i2) + send_packed_blocks(iproc)%vector(offset + i2) = rblock(i1, i2) END DO - offset = offset+n2 + offset = offset + n2 END DO ELSE DO i2 = 1, n2 DO i1 = 1, n1 - send_packed_blocks(iproc)%vector(offset+i1) = rblock(i1, i2) + send_packed_blocks(iproc)%vector(offset + i1) = rblock(i1, i2) END DO - offset = offset+n1 + offset = offset + n1 END DO END IF @@ -654,7 +654,7 @@ SUBROUTINE negf_reference_contact_matrix(matrix_contact, matrix_device, atom_lis DO iproc = 1, para_env%num_pe IF (iproc /= mepos_plus1 .AND. send_nelems(iproc) > 0) THEN - CALL mp_isend(send_packed_blocks(iproc)%vector, iproc-1, para_env%group, send_handlers(iproc), 1) + CALL mp_isend(send_packed_blocks(iproc)%vector, iproc - 1, para_env%group, send_handlers(iproc), 1) END IF END DO @@ -662,7 +662,7 @@ SUBROUTINE negf_reference_contact_matrix(matrix_contact, matrix_device, atom_lis DO iproc = 1, para_env%num_pe IF (iproc /= mepos_plus1) THEN IF (recv_nelems(iproc) > 0) THEN - CALL mp_irecv(recv_packed_blocks(iproc)%vector, iproc-1, para_env%group, recv_handlers(iproc), 1) + CALL mp_irecv(recv_packed_blocks(iproc)%vector, iproc - 1, para_env%group, recv_handlers(iproc), 1) END IF ELSE IF (ALLOCATED(send_packed_blocks(iproc)%vector)) & @@ -698,9 +698,9 @@ SUBROUTINE negf_reference_contact_matrix(matrix_contact, matrix_device, atom_lis DO i2 = 1, n2 DO i1 = 1, n1 - rblock(i1, i2) = recv_packed_blocks(iproc)%vector(offset+i1) + rblock(i1, i2) = recv_packed_blocks(iproc)%vector(offset + i1) END DO - offset = offset+n1 + offset = offset + n1 END DO recv_nelems(iproc) = offset diff --git a/src/negf_methods.F b/src/negf_methods.F index c0f521a8e2..17465b7ba2 100644 --- a/src/negf_methods.F +++ b/src/negf_methods.F @@ -428,12 +428,12 @@ SUBROUTINE guess_fermi_level(contact_id, negf_env, negf_control, sub_env, qs_env IF (index_to_cell(direction_axis_abs, image) == 0) THEN DO ispin = 1, nspins CALL dbcsr_dot(rho_ao_qs_kp(ispin, image)%matrix, matrix_s_kp(1, image)%matrix, trace) - nelectrons_qs_cell0 = nelectrons_qs_cell0+trace + nelectrons_qs_cell0 = nelectrons_qs_cell0 + trace END DO ELSE IF (ABS(index_to_cell(direction_axis_abs, image)) == 1) THEN DO ispin = 1, nspins CALL dbcsr_dot(rho_ao_qs_kp(ispin, image)%matrix, matrix_s_kp(1, image)%matrix, trace) - nelectrons_qs_cell1 = nelectrons_qs_cell1+trace + nelectrons_qs_cell1 = nelectrons_qs_cell1 + trace END DO END IF END DO @@ -444,7 +444,7 @@ SUBROUTINE guess_fermi_level(contact_id, negf_env, negf_control, sub_env, qs_env WRITE (log_unit, '(/,T2,A,I0,A)') "COMPUTE FERMI LEVEL OF CONTACT ", & contact_id, " AT "//TRIM(ADJUSTL(temperature_str))//" KELVIN" WRITE (log_unit, '(/,T2,A,T60,F20.10,/)') "Electronic density of the isolated contact unit cell:", & - -1.0_dp*(nelectrons_qs_cell0+nelectrons_qs_cell1) + -1.0_dp*(nelectrons_qs_cell0 + nelectrons_qs_cell1) WRITE (log_unit, '(T3,A)') "Step Integration method Time Fermi level Convergence (density)" WRITE (log_unit, '(T3,78("-"))') END IF @@ -453,7 +453,7 @@ SUBROUTINE guess_fermi_level(contact_id, negf_env, negf_control, sub_env, qs_env DO ispin = 1, nspins CALL cp_fm_trace(negf_env%contacts(contact_id)%rho_00(ispin)%matrix, & negf_env%contacts(contact_id)%s_00, trace) - nelectrons_qs_cell0 = nelectrons_qs_cell0+trace + nelectrons_qs_cell0 = nelectrons_qs_cell0 + trace END DO ! Use orbital energies of HOMO and LUMO as reference points and then @@ -464,14 +464,14 @@ SUBROUTINE guess_fermi_level(contact_id, negf_env, negf_control, sub_env, qs_env ELSE fermi_level_min = negf_env%contacts(contact_id)%homo_energy END IF - fermi_level_max = fermi_level_min+negf_control%homo_lumo_gap + fermi_level_max = fermi_level_min + negf_control%homo_lumo_gap ELSE IF (negf_control%contacts(contact_id)%refine_fermi_level) THEN fermi_level_max = negf_control%contacts(contact_id)%fermi_level ELSE fermi_level_max = negf_env%contacts(contact_id)%homo_energy END IF - fermi_level_min = fermi_level_max+negf_control%homo_lumo_gap + fermi_level_min = fermi_level_max + negf_control%homo_lumo_gap END IF step = 0 @@ -482,7 +482,7 @@ SUBROUTINE guess_fermi_level(contact_id, negf_env, negf_control, sub_env, qs_env t1 = m_walltime() DO - step = step+1 + step = step + 1 SELECT CASE (step) CASE (1) @@ -490,15 +490,15 @@ SUBROUTINE guess_fermi_level(contact_id, negf_env, negf_control, sub_env, qs_env CASE (2) fermi_level_guess = fermi_level_max CASE DEFAULT - fermi_level_guess = fermi_level_min-(nelectrons_min-nelectrons_qs_cell0)* & - (fermi_level_max-fermi_level_min)/(nelectrons_max-nelectrons_min) + fermi_level_guess = fermi_level_min - (nelectrons_min - nelectrons_qs_cell0)* & + (fermi_level_max - fermi_level_min)/(nelectrons_max - nelectrons_min) END SELECT negf_control%contacts(contact_id)%fermi_level = fermi_level_guess nelectrons_guess = 0.0_dp - lbound_lpath = CMPLX(fermi_level_guess-offset_au, delta_au, kind=dp) - ubound_lpath = CMPLX(fermi_level_guess+energy_ubound_minus_fermi, delta_au, kind=dp) + lbound_lpath = CMPLX(fermi_level_guess - offset_au, delta_au, kind=dp) + ubound_lpath = CMPLX(fermi_level_guess + energy_ubound_minus_fermi, delta_au, kind=dp) CALL integration_status_reset(stats) @@ -548,7 +548,7 @@ SUBROUTINE guess_fermi_level(contact_id, negf_env, negf_control, sub_env, qs_env CALL green_functions_cache_release(g_surf_cache) CALL cp_fm_trace(rho_ao_fm, matrix_s_fm, trace) - nelectrons_guess = nelectrons_guess+trace + nelectrons_guess = nelectrons_guess + trace END DO nelectrons_guess = nelectrons_guess*rscale @@ -557,10 +557,10 @@ SUBROUTINE guess_fermi_level(contact_id, negf_env, negf_control, sub_env, qs_env IF (log_unit > 0) THEN WRITE (log_unit, '(T2,I5,T12,A,T32,F8.1,T42,F15.8,T60,ES20.5E2)') & step, get_method_description_string(stats, negf_control%integr_method), & - t2-t1, fermi_level_guess, nelectrons_guess-nelectrons_qs_cell0 + t2 - t1, fermi_level_guess, nelectrons_guess - nelectrons_qs_cell0 END IF - IF (ABS(nelectrons_qs_cell0-nelectrons_guess) < negf_control%conv_density) EXIT + IF (ABS(nelectrons_qs_cell0 - nelectrons_guess) < negf_control%conv_density) EXIT SELECT CASE (step) CASE (1) @@ -578,7 +578,7 @@ SUBROUTINE guess_fermi_level(contact_id, negf_env, negf_control, sub_env, qs_env nelectrons_min = nelectrons_max fermi_level_max = fermi_level_guess nelectrons_max = nelectrons_guess - ELSE IF (fermi_level_max-fermi_level_guess < fermi_level_guess-fermi_level_min) THEN + ELSE IF (fermi_level_max - fermi_level_guess < fermi_level_guess - fermi_level_min) THEN fermi_level_max = fermi_level_guess nelectrons_max = nelectrons_guess ELSE @@ -708,7 +708,7 @@ SUBROUTINE shift_potential(negf_env, negf_control, sub_env, qs_env, base_contact do_upper_diag=.TRUE., do_lower=.TRUE.) CALL cp_fm_trace(rho_ao_fm(ispin)%matrix, matrix_s_fm, trace) - nelectrons_ref = nelectrons_ref+trace + nelectrons_ref = nelectrons_ref + trace END DO IF (log_unit > 0) THEN @@ -722,15 +722,15 @@ SUBROUTINE shift_potential(negf_env, negf_control, sub_env, qs_env, base_contact ! integration limits: C-path (arch) lbound_cpath = CMPLX(negf_control%energy_lbound, negf_control%eta, kind=dp) - ubound_cpath = CMPLX(mu_base-REAL(negf_control%gamma_kT, kind=dp)*temperature, & + ubound_cpath = CMPLX(mu_base - REAL(negf_control%gamma_kT, kind=dp)*temperature, & REAL(negf_control%delta_npoles, kind=dp)*twopi*temperature, kind=dp) ! integration limits: L-path (linear) - ubound_lpath = CMPLX(mu_base-LOG(negf_control%conv_density)*temperature, & + ubound_lpath = CMPLX(mu_base - LOG(negf_control%conv_density)*temperature, & REAL(negf_control%delta_npoles, kind=dp)*twopi*temperature, kind=dp) v_shift_min = negf_control%v_shift - v_shift_max = negf_control%v_shift+negf_control%v_shift_offset + v_shift_max = negf_control%v_shift + negf_control%v_shift_offset ALLOCATE (g_surf_circular(nspins), g_surf_linear(nspins)) @@ -741,8 +741,8 @@ SUBROUTINE shift_potential(negf_env, negf_control, sub_env, qs_env, base_contact CASE (2) v_shift_guess = v_shift_max CASE DEFAULT - v_shift_guess = v_shift_min-(nelectrons_min-nelectrons_ref)* & - (v_shift_max-v_shift_min)/(nelectrons_max-nelectrons_min) + v_shift_guess = v_shift_min - (nelectrons_min - nelectrons_ref)* & + (v_shift_max - v_shift_min)/(nelectrons_max - nelectrons_min) END SELECT ! compute an updated density matrix @@ -811,10 +811,10 @@ SUBROUTINE shift_potential(negf_env, negf_control, sub_env, qs_env, base_contact IF (log_unit > 0) THEN WRITE (log_unit, '(T2,I5,T12,A,T32,F8.1,T42,F15.8,T60,ES20.5E2)') & iter_count, get_method_description_string(stats, negf_control%integr_method), & - t2-t1, v_shift_guess, nelectrons_guess-nelectrons_ref + t2 - t1, v_shift_guess, nelectrons_guess - nelectrons_ref END IF - IF (ABS(nelectrons_guess-nelectrons_ref) < negf_control%conv_scf) EXIT + IF (ABS(nelectrons_guess - nelectrons_ref) < negf_control%conv_scf) EXIT ! compute correction SELECT CASE (iter_count) @@ -833,7 +833,7 @@ SUBROUTINE shift_potential(negf_env, negf_control, sub_env, qs_env, base_contact nelectrons_min = nelectrons_max v_shift_max = v_shift_guess nelectrons_max = nelectrons_guess - ELSE IF (v_shift_max-v_shift_guess < v_shift_guess-v_shift_min) THEN + ELSE IF (v_shift_max - v_shift_guess < v_shift_guess - v_shift_min) THEN v_shift_max = v_shift_guess nelectrons_max = nelectrons_guess ELSE @@ -960,7 +960,7 @@ SUBROUTINE converge_density(negf_env, negf_control, sub_env, qs_env, v_shift, ba nimages = dft_control%nimages v_base = negf_control%contacts(base_contact)%v_external - mu_base = negf_control%contacts(base_contact)%fermi_level+v_base + mu_base = negf_control%contacts(base_contact)%fermi_level + v_base ! the current subroutine works for the general case as well, but the Poisson solver does not IF (ncontacts > 2) THEN @@ -1004,7 +1004,7 @@ SUBROUTINE converge_density(negf_env, negf_control, sub_env, qs_env, v_shift, ba do_upper_diag=.TRUE., do_lower=.TRUE.) CALL cp_fm_trace(rho_ao_delta_fm(ispin)%matrix, matrix_s_fm, trace) - nelectrons = nelectrons+trace + nelectrons = nelectrons + trace END DO NULLIFY (ao_ao_fm_global) @@ -1038,11 +1038,11 @@ SUBROUTINE converge_density(negf_env, negf_control, sub_env, qs_env, v_shift, ba ! integration limits: C-path (arch) lbound_cpath = CMPLX(negf_control%energy_lbound, negf_control%eta, kind=dp) - ubound_cpath = CMPLX(mu_base-REAL(negf_control%gamma_kT, kind=dp)*temperature, & + ubound_cpath = CMPLX(mu_base - REAL(negf_control%gamma_kT, kind=dp)*temperature, & REAL(negf_control%delta_npoles, kind=dp)*twopi*temperature, kind=dp) ! integration limits: L-path (linear) - ubound_lpath = CMPLX(mu_base-LOG(negf_control%conv_density)*temperature, & + ubound_lpath = CMPLX(mu_base - LOG(negf_control%conv_density)*temperature, & REAL(negf_control%delta_npoles, kind=dp)*twopi*temperature, kind=dp) ALLOCATE (g_surf_circular(nspins), g_surf_linear(nspins), g_surf_nonequiv(nspins)) @@ -1099,7 +1099,7 @@ SUBROUTINE converge_density(negf_env, negf_control, sub_env, qs_env, v_shift, ba CALL green_functions_cache_release(g_surf_linear(ispin)) ! non-equilibrium part - IF (ABS(negf_control%contacts(icontact)%v_external- & + IF (ABS(negf_control%contacts(icontact)%v_external - & negf_control%contacts(base_contact)%v_external) >= threshold) THEN CALL negf_add_rho_nonequiv(rho_ao_fm=rho_ao_new_fm(ispin)%matrix, & stats=stats, & @@ -1122,12 +1122,12 @@ SUBROUTINE converge_density(negf_env, negf_control, sub_env, qs_env, v_shift, ba nelectrons_diff = 0.0_dp DO ispin = 1, nspins CALL cp_fm_trace(rho_ao_new_fm(ispin)%matrix, matrix_s_fm, trace) - nelectrons = nelectrons+trace + nelectrons = nelectrons + trace ! rho_ao_delta_fm contains the original (non-mixed) density matrix from the previous iteration CALL cp_fm_scale_and_add(1.0_dp, rho_ao_delta_fm(ispin)%matrix, -1.0_dp, rho_ao_new_fm(ispin)%matrix) CALL cp_fm_trace(rho_ao_delta_fm(ispin)%matrix, matrix_s_fm, trace) - nelectrons_diff = nelectrons_diff+trace + nelectrons_diff = nelectrons_diff + trace ! rho_ao_new_fm -> rho_ao_delta_fm CALL cp_fm_to_fm(rho_ao_new_fm(ispin)%matrix, rho_ao_delta_fm(ispin)%matrix) @@ -1138,7 +1138,7 @@ SUBROUTINE converge_density(negf_env, negf_control, sub_env, qs_env, v_shift, ba IF (log_unit > 0) THEN WRITE (log_unit, '(T2,I5,T12,A,T32,F8.1,T43,F20.8,T65,ES15.5E2)') & iter_count, get_method_description_string(stats, negf_control%integr_method), & - t2-t1, -1.0_dp*nelectrons, nelectrons_diff + t2 - t1, -1.0_dp*nelectrons, nelectrons_diff END IF IF (ABS(nelectrons_diff) < negf_control%conv_scf) EXIT @@ -1215,7 +1215,7 @@ SUBROUTINE converge_density(negf_env, negf_control, sub_env, qs_env, v_shift, ba IF (iter_count <= negf_control%max_scf) THEN WRITE (log_unit, '(/,T11,1X,A,I0,A)') "*** NEGF run converged in ", iter_count, " iteration(s) ***" ELSE - WRITE (log_unit, '(/,T11,1X,A,I0,A)') "*** NEGF run did NOT converge after ", iter_count-1, " iteration(s) ***" + WRITE (log_unit, '(/,T11,1X,A,I0,A)') "*** NEGF run did NOT converge after ", iter_count - 1, " iteration(s) ***" END IF END IF @@ -1297,13 +1297,13 @@ SUBROUTINE negf_surface_green_function_batch(g_surf, omega, h0, s0, h1, s1, sub_ NULLIFY (g_surf(ipoint)%matrix) END DO - DO ipoint = igroup+1, npoints, sub_env%ngroups + DO ipoint = igroup + 1, npoints, sub_env%ngroups IF (debug_this_module) THEN CPASSERT(.NOT. ASSOCIATED(g_surf(ipoint)%matrix)) END IF CALL cp_cfm_create(g_surf(ipoint)%matrix, fm_struct) - CALL do_sancho(g_surf(ipoint)%matrix, omega(ipoint)-v_external, & + CALL do_sancho(g_surf(ipoint)%matrix, omega(ipoint) - v_external, & h0, s0, h1, s1, conv, transp, work) END DO @@ -1547,7 +1547,7 @@ SUBROUTINE negf_retarded_green_function_batch(omega, v_shift, ignore_bias, negf_ IF (.NOT. ignore_bias) v_external = negf_control%contacts(icontact)%v_external CALL negf_contact_self_energy(self_energy_c=self_energy_contacts(icontact)%matrix, & - omega=omega(ipoint)-v_external, & + omega=omega(ipoint) - v_external, & g_surf_c=g_surf_contacts(icontact, ipoint)%matrix, & h_sc0=negf_env%h_sc(ispin, icontact)%matrix, & s_sc0=negf_env%s_sc(icontact)%matrix, & @@ -1574,21 +1574,21 @@ SUBROUTINE negf_retarded_green_function_batch(omega, v_shift, ignore_bias, negf_ ! retarded Green's function for the scattering region IF (PRESENT(just_contact)) THEN CALL negf_retarded_green_function(g_ret_s=g_ret_s_group(ipoint)%matrix, & - omega=omega(ipoint)-v_shift, & + omega=omega(ipoint) - v_shift, & self_energy_ret_sum=self_energy_contacts(1)%matrix, & h_s=negf_env%contacts(just_contact)%h_00(ispin)%matrix, & s_s=negf_env%contacts(just_contact)%s_00, & v_hartree_s=null()) ELSE IF (ignore_bias) THEN CALL negf_retarded_green_function(g_ret_s=g_ret_s_group(ipoint)%matrix, & - omega=omega(ipoint)-v_shift, & + omega=omega(ipoint) - v_shift, & self_energy_ret_sum=self_energy_contacts(1)%matrix, & h_s=negf_env%h_s(ispin)%matrix, & s_s=negf_env%s_s, & v_hartree_s=null()) ELSE CALL negf_retarded_green_function(g_ret_s=g_ret_s_group(ipoint)%matrix, & - omega=omega(ipoint)-v_shift, & + omega=omega(ipoint) - v_shift, & self_energy_ret_sum=self_energy_contacts(1)%matrix, & h_s=negf_env%h_s(ispin)%matrix, & s_s=negf_env%s_s, & @@ -1868,7 +1868,7 @@ PURE FUNCTION fermi_function(omega, temperature) RESULT(val) IF (REAL(omega, kind=dp) <= temperature*max_ln_omega_over_T) THEN ! exp(omega / T) < huge(0), so EXP() should not return infinity - val = z_one/(EXP(omega/temperature)+z_one) + val = z_one/(EXP(omega/temperature) + z_one) ELSE val = z_zero END IF @@ -1918,7 +1918,7 @@ SUBROUTINE negf_init_rho_equiv_residuals(rho_ao_fm, v_shift, ignore_bias, negf_e mu_base = negf_control%contacts(base_contact)%fermi_level v_external = 0.0_dp ELSE - mu_base = negf_control%contacts(base_contact)%fermi_level+negf_control%contacts(base_contact)%v_external + mu_base = negf_control%contacts(base_contact)%fermi_level + negf_control%contacts(base_contact)%v_external END IF pi_temperature = pi*temperature @@ -1940,7 +1940,7 @@ SUBROUTINE negf_init_rho_equiv_residuals(rho_ao_fm, v_shift, ignore_bias, negf_e NULLIFY (g_ret_s(ipole)%matrix) CALL cp_cfm_create(g_ret_s(ipole)%matrix, fm_struct) - omega(ipole) = CMPLX(mu_base, REAL(2*ipole-1, kind=dp)*pi_temperature, kind=dp) + omega(ipole) = CMPLX(mu_base, REAL(2*ipole - 1, kind=dp)*pi_temperature, kind=dp) END DO CALL green_functions_cache_expand(g_surf_cache, ncontacts, npoles) @@ -2068,7 +2068,7 @@ SUBROUTINE negf_add_rho_equiv_low(rho_ao_fm, stats, v_shift, ignore_bias, negf_e mu_base = negf_control%contacts(base_contact)%fermi_level v_external = 0.0_dp ELSE - mu_base = negf_control%contacts(base_contact)%fermi_level+negf_control%contacts(base_contact)%v_external + mu_base = negf_control%contacts(base_contact)%fermi_level + negf_control%contacts(base_contact)%v_external END IF min_points = negf_control%integr_min_points @@ -2129,7 +2129,7 @@ SUBROUTINE negf_add_rho_equiv_low(rho_ao_fm, stats, v_shift, ignore_bias, negf_e IF (PRESENT(just_contact)) THEN ! do not apply the external potential when computing the Fermi level of a bulk contact. DO icontact = 1, ncontacts - CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, npoints_total+1:), & + CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, npoints_total + 1:), & omega=xnodes(1:npoints), & h0=negf_env%contacts(just_contact)%h_00(ispin)%matrix, & s0=negf_env%contacts(just_contact)%s_00, & @@ -2142,7 +2142,7 @@ SUBROUTINE negf_add_rho_equiv_low(rho_ao_fm, stats, v_shift, ignore_bias, negf_e DO icontact = 1, ncontacts IF (.NOT. ignore_bias) v_external = negf_control%contacts(icontact)%v_external - CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, npoints_total+1:), & + CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, npoints_total + 1:), & omega=xnodes(1:npoints), & h0=negf_env%contacts(icontact)%h_00(ispin)%matrix, & s0=negf_env%contacts(icontact)%s_00, & @@ -2159,7 +2159,7 @@ SUBROUTINE negf_add_rho_equiv_low(rho_ao_fm, stats, v_shift, ignore_bias, negf_e IF (temperature >= 0.0_dp) THEN DO ipoint = 1, npoints - zscale(ipoint) = fermi_function(xnodes(ipoint)-mu_base, temperature) + zscale(ipoint) = fermi_function(xnodes(ipoint) - mu_base, temperature) END DO ELSE zscale(:) = z_one @@ -2172,13 +2172,13 @@ SUBROUTINE negf_add_rho_equiv_low(rho_ao_fm, stats, v_shift, ignore_bias, negf_e negf_control=negf_control, & sub_env=sub_env, & ispin=ispin, & - g_surf_contacts=g_surf_cache%g_surf_contacts(:, npoints_total+1:), & + g_surf_contacts=g_surf_cache%g_surf_contacts(:, npoints_total + 1:), & g_ret_s=zdata(1:npoints), & g_ret_scale=zscale(1:npoints), & just_contact=just_contact) DEALLOCATE (xnodes, zscale) - npoints_total = npoints_total+npoints + npoints_total = npoints_total + npoints CALL ccquad_reduce_and_append_zdata(cc_env, zdata) CALL MOVE_ALLOC(zdata, zdata_tmp) @@ -2186,7 +2186,7 @@ SUBROUTINE negf_add_rho_equiv_low(rho_ao_fm, stats, v_shift, ignore_bias, negf_e CALL ccquad_refine_integral(cc_env) IF (cc_env%error <= conv_integr) EXIT - IF (2*(npoints_total-1)+1 > max_points) EXIT + IF (2*(npoints_total - 1) + 1 > max_points) EXIT ! all cached points have been reused at the first iteration; ! we need to compute surface Green's function at extra points if the integral has not been converged @@ -2201,20 +2201,20 @@ SUBROUTINE negf_add_rho_equiv_low(rho_ao_fm, stats, v_shift, ignore_bias, negf_e npoints_exist = 0 DO ipoint = 1, npoints_tmp IF (ASSOCIATED(zdata_tmp(ipoint)%matrix)) THEN - npoints_exist = npoints_exist+1 + npoints_exist = npoints_exist + 1 zdata(npoints_exist)%matrix => zdata_tmp(ipoint)%matrix END IF END DO DEALLOCATE (zdata_tmp) - DO ipoint = npoints_exist+1, npoints + DO ipoint = npoints_exist + 1, npoints NULLIFY (zdata(ipoint)%matrix) CALL cp_cfm_create(zdata(ipoint)%matrix, fm_struct) END DO END DO ! the obtained integral will be scaled by -1/pi, so scale the error extimate as well - stats%error = stats%error+cc_env%error/pi + stats%error = stats%error + cc_env%error/pi DO ipoint = SIZE(zdata_tmp), 1, -1 IF (ASSOCIATED(zdata_tmp(ipoint)%matrix)) CALL cp_cfm_release(zdata_tmp(ipoint)%matrix) @@ -2259,7 +2259,7 @@ SUBROUTINE negf_add_rho_equiv_low(rho_ao_fm, stats, v_shift, ignore_bias, negf_e IF (PRESENT(just_contact)) THEN ! do not apply the external potential when computing the Fermi level of a bulk contact. DO icontact = 1, ncontacts - CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, npoints_total+1:), & + CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, npoints_total + 1:), & omega=xnodes(1:npoints), & h0=negf_env%contacts(just_contact)%h_00(ispin)%matrix, & s0=negf_env%contacts(just_contact)%s_00, & @@ -2272,7 +2272,7 @@ SUBROUTINE negf_add_rho_equiv_low(rho_ao_fm, stats, v_shift, ignore_bias, negf_e DO icontact = 1, ncontacts IF (.NOT. ignore_bias) v_external = negf_control%contacts(icontact)%v_external - CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, npoints_total+1:), & + CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(icontact, npoints_total + 1:), & omega=xnodes(1:npoints), & h0=negf_env%contacts(icontact)%h_00(ispin)%matrix, & s0=negf_env%contacts(icontact)%s_00, & @@ -2287,7 +2287,7 @@ SUBROUTINE negf_add_rho_equiv_low(rho_ao_fm, stats, v_shift, ignore_bias, negf_e IF (temperature >= 0.0_dp) THEN DO ipoint = 1, npoints - zscale(ipoint) = fermi_function(xnodes(ipoint)-mu_base, temperature) + zscale(ipoint) = fermi_function(xnodes(ipoint) - mu_base, temperature) END DO ELSE zscale(:) = z_one @@ -2300,12 +2300,12 @@ SUBROUTINE negf_add_rho_equiv_low(rho_ao_fm, stats, v_shift, ignore_bias, negf_e negf_control=negf_control, & sub_env=sub_env, & ispin=ispin, & - g_surf_contacts=g_surf_cache%g_surf_contacts(:, npoints_total+1:), & + g_surf_contacts=g_surf_cache%g_surf_contacts(:, npoints_total + 1:), & g_ret_s=zdata(1:npoints), & g_ret_scale=zscale(1:npoints), & just_contact=just_contact) - npoints_total = npoints_total+npoints + npoints_total = npoints_total + npoints CALL simpsonrule_refine_integral(sr_env, zdata(1:npoints)) @@ -2316,7 +2316,7 @@ SUBROUTINE negf_add_rho_equiv_low(rho_ao_fm, stats, v_shift, ignore_bias, negf_e ! in order to add more points do_surface_green = .TRUE. - npoints = max_points-npoints_total + npoints = max_points - npoints_total IF (npoints <= 0) EXIT IF (npoints > SIZE(xnodes)) npoints = SIZE(xnodes) @@ -2324,7 +2324,7 @@ SUBROUTINE negf_add_rho_equiv_low(rho_ao_fm, stats, v_shift, ignore_bias, negf_e END DO ! the obtained integral will be scaled by -1/pi, so scale the error extimate as well - stats%error = stats%error+sr_env%error/pi + stats%error = stats%error + sr_env%error/pi CALL cp_cfm_to_fm(sr_env%integral, mtargeti=integral_imag) @@ -2340,7 +2340,7 @@ SUBROUTINE negf_add_rho_equiv_low(rho_ao_fm, stats, v_shift, ignore_bias, negf_e CPABORT("Unimplemented integration method") END SELECT - stats%npoints = stats%npoints+npoints_total + stats%npoints = stats%npoints + npoints_total CALL cp_fm_scale_and_add(1.0_dp, rho_ao_fm, -1.0_dp/pi, integral_imag) CALL cp_fm_release(integral_imag) @@ -2402,7 +2402,7 @@ SUBROUTINE negf_add_rho_nonequiv(rho_ao_fm, stats, v_shift, negf_env, negf_contr CPABORT("Poisson solver does not support the general NEGF setup (>2 contacts).") END IF - mu_base = negf_control%contacts(base_contact)%fermi_level+negf_control%contacts(base_contact)%v_external + mu_base = negf_control%contacts(base_contact)%fermi_level + negf_control%contacts(base_contact)%v_external min_points = negf_control%integr_min_points max_points = negf_control%integr_max_points temperature_base = negf_control%contacts(base_contact)%temperature @@ -2416,13 +2416,13 @@ SUBROUTINE negf_add_rho_nonequiv(rho_ao_fm, stats, v_shift, negf_env, negf_contr DO icontact = 1, ncontacts IF (icontact /= base_contact) THEN - mu_contact = negf_control%contacts(icontact)%fermi_level+negf_control%contacts(icontact)%v_external + mu_contact = negf_control%contacts(icontact)%fermi_level + negf_control%contacts(icontact)%v_external temperature_contact = negf_control%contacts(icontact)%temperature - integr_lbound = CMPLX(MIN(mu_base+ln_conv_density*temperature_base, & - mu_contact+ln_conv_density*temperature_contact), eta, kind=dp) - integr_ubound = CMPLX(MAX(mu_base-ln_conv_density*temperature_base, & - mu_contact-ln_conv_density*temperature_contact), eta, kind=dp) + integr_lbound = CMPLX(MIN(mu_base + ln_conv_density*temperature_base, & + mu_contact + ln_conv_density*temperature_contact), eta, kind=dp) + integr_ubound = CMPLX(MAX(mu_base - ln_conv_density*temperature_base, & + mu_contact - ln_conv_density*temperature_contact), eta, kind=dp) do_surface_green = .NOT. ALLOCATED(g_surf_cache%tnodes) @@ -2455,7 +2455,7 @@ SUBROUTINE negf_add_rho_nonequiv(rho_ao_fm, stats, v_shift, negf_env, negf_contr CALL green_functions_cache_expand(g_surf_cache, ncontacts, npoints) DO jcontact = 1, ncontacts - CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(jcontact, npoints_total+1:), & + CALL negf_surface_green_function_batch(g_surf=g_surf_cache%g_surf_contacts(jcontact, npoints_total + 1:), & omega=xnodes(1:npoints), & h0=negf_env%contacts(jcontact)%h_00(ispin)%matrix, & s0=negf_env%contacts(jcontact)%s_00, & @@ -2478,18 +2478,18 @@ SUBROUTINE negf_add_rho_nonequiv(rho_ao_fm, stats, v_shift, negf_env, negf_contr negf_control=negf_control, & sub_env=sub_env, & ispin=ispin, & - g_surf_contacts=g_surf_cache%g_surf_contacts(:, npoints_total+1:), & + g_surf_contacts=g_surf_cache%g_surf_contacts(:, npoints_total + 1:), & gret_gamma_gadv=zdata(:, 1:npoints)) DO ipoint = 1, npoints - fermi_base = fermi_function(CMPLX(REAL(xnodes(ipoint), kind=dp)-mu_base, 0.0_dp, kind=dp), & + fermi_base = fermi_function(CMPLX(REAL(xnodes(ipoint), kind=dp) - mu_base, 0.0_dp, kind=dp), & temperature_base) - fermi_contact = fermi_function(CMPLX(REAL(xnodes(ipoint), kind=dp)-mu_contact, 0.0_dp, kind=dp), & + fermi_contact = fermi_function(CMPLX(REAL(xnodes(ipoint), kind=dp) - mu_contact, 0.0_dp, kind=dp), & temperature_contact) - CALL cp_cfm_scale(fermi_contact-fermi_base, zdata(icontact, ipoint)%matrix) + CALL cp_cfm_scale(fermi_contact - fermi_base, zdata(icontact, ipoint)%matrix) END DO - npoints_total = npoints_total+npoints + npoints_total = npoints_total + npoints CALL simpsonrule_refine_integral(sr_env, zdata(icontact, 1:npoints)) @@ -2498,7 +2498,7 @@ SUBROUTINE negf_add_rho_nonequiv(rho_ao_fm, stats, v_shift, negf_env, negf_contr ! not enought cached points to achieve target accuracy do_surface_green = .TRUE. - npoints = max_points-npoints_total + npoints = max_points - npoints_total IF (npoints <= 0) EXIT IF (npoints > SIZE(xnodes)) npoints = SIZE(xnodes) @@ -2515,8 +2515,8 @@ SUBROUTINE negf_add_rho_nonequiv(rho_ao_fm, stats, v_shift, negf_env, negf_contr DEALLOCATE (xnodes, zdata) - stats%error = stats%error+sr_env%error*0.5_dp/pi - stats%npoints = stats%npoints+npoints_total + stats%error = stats%error + sr_env%error*0.5_dp/pi + stats%npoints = stats%npoints + npoints_total ! keep the cache IF (do_surface_green) THEN @@ -2627,11 +2627,11 @@ FUNCTION negf_compute_current(contact_id1, contact_id2, v_shift, negf_env, negf_ CPASSERT(contact_id1 /= contact_id2) v_contact1 = negf_control%contacts(contact_id1)%v_external - mu_contact1 = negf_control%contacts(contact_id1)%fermi_level+v_contact1 + mu_contact1 = negf_control%contacts(contact_id1)%fermi_level + v_contact1 v_contact2 = negf_control%contacts(contact_id2)%v_external - mu_contact2 = negf_control%contacts(contact_id2)%fermi_level+v_contact2 + mu_contact2 = negf_control%contacts(contact_id2)%fermi_level + v_contact2 - IF (ABS(mu_contact1-mu_contact2) < threshold) THEN + IF (ABS(mu_contact1 - mu_contact2) < threshold) THEN CALL timestop(handle) RETURN END IF @@ -2644,10 +2644,10 @@ FUNCTION negf_compute_current(contact_id1, contact_id2, v_shift, negf_env, negf_ conv_density = negf_control%conv_density ln_conv_density = LOG(conv_density) - integr_lbound = CMPLX(MIN(mu_contact1+ln_conv_density*temperature_contact1, & - mu_contact2+ln_conv_density*temperature_contact2), eta, kind=dp) - integr_ubound = CMPLX(MAX(mu_contact1-ln_conv_density*temperature_contact1, & - mu_contact2-ln_conv_density*temperature_contact2), eta, kind=dp) + integr_lbound = CMPLX(MIN(mu_contact1 + ln_conv_density*temperature_contact1, & + mu_contact2 + ln_conv_density*temperature_contact2), eta, kind=dp) + integr_ubound = CMPLX(MAX(mu_contact1 - ln_conv_density*temperature_contact1, & + mu_contact2 - ln_conv_density*temperature_contact2), eta, kind=dp) npoints_total = 0 npoints = min_points @@ -2693,22 +2693,22 @@ FUNCTION negf_compute_current(contact_id1, contact_id2, v_shift, negf_env, negf_ CALL cp_cfm_create(zdata(ipoint)%matrix, fm_struct_single) energy = REAL(xnodes(ipoint), kind=dp) - fermi_contact1 = fermi_function(CMPLX(energy-mu_contact1, 0.0_dp, kind=dp), temperature_contact1) - fermi_contact2 = fermi_function(CMPLX(energy-mu_contact2, 0.0_dp, kind=dp), temperature_contact2) + fermi_contact1 = fermi_function(CMPLX(energy - mu_contact1, 0.0_dp, kind=dp), temperature_contact1) + fermi_contact2 = fermi_function(CMPLX(energy - mu_contact2, 0.0_dp, kind=dp), temperature_contact2) - transmission(1, 1) = transm_coeff(ipoint)*(fermi_contact1-fermi_contact2) + transmission(1, 1) = transm_coeff(ipoint)*(fermi_contact1 - fermi_contact2) CALL cp_cfm_set_submatrix(zdata(ipoint)%matrix, transmission) END DO CALL green_functions_cache_release(g_surf_cache) - npoints_total = npoints_total+npoints + npoints_total = npoints_total + npoints CALL simpsonrule_refine_integral(sr_env, zdata(1:npoints)) IF (sr_env%error <= negf_control%conv_density) EXIT - npoints = max_points-npoints_total + npoints = max_points - npoints_total IF (npoints <= 0) EXIT IF (npoints > SIZE(xnodes)) npoints = SIZE(xnodes) @@ -2819,8 +2819,8 @@ SUBROUTINE negf_print_dos(log_unit, energy_min, energy_max, npoints, v_shift, ne IF (npoints > 1) THEN DO ipoint = 1, npoints_bundle - xnodes(ipoint) = CMPLX(energy_min+REAL(npoints-npoints_remain+ipoint-1, kind=dp)/ & - REAL(npoints-1, kind=dp)*(energy_max-energy_min), negf_control%eta, kind=dp) + xnodes(ipoint) = CMPLX(energy_min + REAL(npoints - npoints_remain + ipoint - 1, kind=dp)/ & + REAL(npoints - 1, kind=dp)*(energy_max - energy_min), negf_control%eta, kind=dp) END DO ELSE xnodes(ipoint) = CMPLX(energy_min, negf_control%eta, kind=dp) @@ -2880,7 +2880,7 @@ SUBROUTINE negf_print_dos(log_unit, energy_min, energy_max, npoints, v_shift, ne END DO END IF - npoints_remain = npoints_remain-npoints_bundle + npoints_remain = npoints_remain - npoints_bundle END DO DEALLOCATE (dos, xnodes) @@ -2968,8 +2968,8 @@ SUBROUTINE negf_print_transmission(log_unit, energy_min, energy_max, npoints, v_ IF (npoints > 1) THEN DO ipoint = 1, npoints_bundle - xnodes(ipoint) = CMPLX(energy_min+REAL(npoints-npoints_remain+ipoint-1, kind=dp)/ & - REAL(npoints-1, kind=dp)*(energy_max-energy_min), negf_control%eta, kind=dp) + xnodes(ipoint) = CMPLX(energy_min + REAL(npoints - npoints_remain + ipoint - 1, kind=dp)/ & + REAL(npoints - 1, kind=dp)*(energy_max - energy_min), negf_control%eta, kind=dp) END DO ELSE xnodes(ipoint) = CMPLX(energy_min, negf_control%eta, kind=dp) @@ -3019,7 +3019,7 @@ SUBROUTINE negf_print_transmission(log_unit, energy_min, energy_max, npoints, v_ END DO END IF - npoints_remain = npoints_remain-npoints_bundle + npoints_remain = npoints_remain - npoints_bundle END DO DEALLOCATE (transm_coeff, xnodes) diff --git a/src/negf_subgroup_types.F b/src/negf_subgroup_types.F index 6587d84068..2fc021cf51 100644 --- a/src/negf_subgroup_types.F +++ b/src/negf_subgroup_types.F @@ -95,7 +95,7 @@ SUBROUTINE negf_sub_env_create(sub_env, negf_control, blacs_env_global, blacs_gr is_split = negf_control%nprocs > 0 .AND. negf_control%nprocs*2 <= para_env_global%num_pe IF (is_split) THEN - ALLOCATE (sub_env%group_distribution(0:para_env_global%num_pe-1)) + ALLOCATE (sub_env%group_distribution(0:para_env_global%num_pe - 1)) CALL mp_comm_split(comm=para_env_global%group, sub_comm=sub_env%mpi_comm, ngroups=sub_env%ngroups, & group_distribution=sub_env%group_distribution, subgroup_min_size=negf_control%nprocs) @@ -111,7 +111,7 @@ SUBROUTINE negf_sub_env_create(sub_env, negf_control, blacs_env_global, blacs_gr sub_env%mpi_comm = para_env_global%group sub_env%ngroups = 1 - ALLOCATE (sub_env%group_distribution(0:para_env_global%num_pe-1)) + ALLOCATE (sub_env%group_distribution(0:para_env_global%num_pe - 1)) sub_env%group_distribution(:) = 0 sub_env%blacs_env => blacs_env_global diff --git a/src/negf_vectors.F b/src/negf_vectors.F index 7dd84ffc66..0c0c6c1b24 100644 --- a/src/negf_vectors.F +++ b/src/negf_vectors.F @@ -67,26 +67,26 @@ SUBROUTINE contact_direction_vector(origin, direction_vector, origin_bias, direc ! geometrical centre of the first contact unit cell origin = particle_set(atomlist_screening(1))%r DO iatom = 2, natoms_screening - origin = origin+particle_set(atomlist_screening(iatom))%r + origin = origin + particle_set(atomlist_screening(iatom))%r END DO origin = origin/REAL(natoms_screening, kind=dp) ! geometrical centre of the second contact unit cell direction_vector = particle_set(atomlist_bulk(1))%r DO iatom = 2, natoms_bulk - direction_vector = direction_vector+particle_set(atomlist_bulk(iatom))%r + direction_vector = direction_vector + particle_set(atomlist_bulk(iatom))%r END DO direction_vector = direction_vector/REAL(natoms_bulk, kind=dp) ! vector between the geometrical centers of the first and the second contact unit cells - direction_vector = direction_vector-origin + direction_vector = direction_vector - origin ! the point 'center_of_coords0' belongs to the first unit cell, so the lowest projection of any point ! from the first unit cell on the direction vector 'center_of_coords1 - center_of_coords0' should be <= 0 proj_min = 0.0_dp proj_min_bias = 0.0_dp DO iatom = 1, natoms_screening - vector = particle_set(atomlist_screening(iatom))%r-origin + vector = particle_set(atomlist_screening(iatom))%r - origin proj = projection_on_direction_vector(vector, direction_vector) IF (proj < proj_min) proj_min = proj @@ -96,20 +96,20 @@ SUBROUTINE contact_direction_vector(origin, direction_vector, origin_bias, direc ! the point 'center_of_coords1' belongs to the given contact, so the highest projection should be >= 1 proj_max = 1.0_dp DO iatom = 1, nparticles - vector = particle_set(iatom)%r-origin + vector = particle_set(iatom)%r - origin proj = projection_on_direction_vector(vector, direction_vector) IF (proj > proj_max) proj_max = proj END DO ! adjust the origin, so it lies on a plane between the given contact and the scattering region - origin_bias = origin+proj_min_bias*direction_vector - origin = origin+proj_min*direction_vector + origin_bias = origin + proj_min_bias*direction_vector + origin = origin + proj_min*direction_vector ! rescale the vector, so the last atom of the given contact and the point 'origin + direction_vector' lie on ! the same plane parallel to the 'origin' plane -- which separates the contact from the scattering region. - direction_vector_bias = (proj_max-proj_min_bias)*direction_vector - direction_vector = (proj_max-proj_min)*direction_vector + direction_vector_bias = (proj_max - proj_min_bias)*direction_vector + direction_vector = (proj_max - proj_min)*direction_vector CALL timestop(handle) END SUBROUTINE contact_direction_vector @@ -136,11 +136,11 @@ PURE FUNCTION projection_on_direction_vector(vector, vector0) RESULT(proj) REAL(kind=dp) :: len2, len2_v0, len2_v1 REAL(kind=dp), DIMENSION(3) :: vector1 - vector1 = vector-vector0 + vector1 = vector - vector0 len2 = DOT_PRODUCT(vector, vector) len2_v0 = DOT_PRODUCT(vector0, vector0) len2_v1 = DOT_PRODUCT(vector1, vector1) - proj = 0.5_dp*((len2-len2_v1)/len2_v0+1.0_dp) + proj = 0.5_dp*((len2 - len2_v1)/len2_v0 + 1.0_dp) END FUNCTION projection_on_direction_vector END MODULE negf_vectors diff --git a/src/optbas_fenv_manipulation.F b/src/optbas_fenv_manipulation.F index 4e1f1bf9aa..2db02ad7a5 100644 --- a/src/optbas_fenv_manipulation.F +++ b/src/optbas_fenv_manipulation.F @@ -123,7 +123,7 @@ SUBROUTINE modify_input_settings(basis_optimization, bas_id, input_file) ! add the new basis file containing the templates to the basis file list CALL section_vals_val_get(dft_section, "BASIS_SET_FILE_NAME", n_rep_val=nbasis) - CALL section_vals_val_set(dft_section, "BASIS_SET_FILE_NAME", i_rep_val=nbasis+1, & + CALL section_vals_val_set(dft_section, "BASIS_SET_FILE_NAME", i_rep_val=nbasis + 1, & c_val=basis_optimization%work_basis_file) ! Set the auxilarry basis in the kind sections diff --git a/src/optbas_opt_utils.F b/src/optbas_opt_utils.F index 0a604e09ac..52a40944e7 100644 --- a/src/optbas_opt_utils.F +++ b/src/optbas_opt_utils.F @@ -69,7 +69,7 @@ SUBROUTINE evaluate_energy(mos, matrix_ks, S_inv_orb, Q, tmp1, energy) CALL cp_gemm('N', 'T', naux, naux, norb, 1.0_dp, tmp, QS_inv, 0.0_dp, tmp1) CALL cp_gemm('N', 'T', naux, naux, nmo, 1.0_dp, mo_coeff, mo_coeff, 0.0_dp, tmp2) CALL cp_fm_trace(tmp1, tmp2, tmp_energy) - energy = energy+tmp_energy*(3.0_dp-REAL(SIZE(matrix_ks), dp)) + energy = energy + tmp_energy*(3.0_dp - REAL(SIZE(matrix_ks), dp)) END DO @@ -119,7 +119,7 @@ SUBROUTINE evaluate_fval(mos, mos_aux_fit, Q, Snew, admm_env, fval, S_cond_numbe CALL cp_gemm('N', 'N', nao_aux_fit, nmo, nao_orb, -2.0_dp, admm_env%Q, mo_coeff, & 0.0_dp, admm_env%work_aux_nmo(ispin)%matrix) CALL cp_fm_trace(mo_coeff_aux_fit, admm_env%work_aux_nmo(ispin)%matrix, trace) - fval = fval+trace+2.0_dp*nmo + fval = fval + trace + 2.0_dp*nmo END DO ALLOCATE (eigenvalues(nao_aux_fit)) diff --git a/src/optimize_basis.F b/src/optimize_basis.F index 6cd83ad2c5..18446053a1 100644 --- a/src/optimize_basis.F +++ b/src/optimize_basis.F @@ -121,7 +121,7 @@ SUBROUTINE driver_para_opt_basis(opt_bas, input_declaration, para_env) group_distribution_p => group_distribution CALL mp_comm_split(para_env%group, opt_group, n_groups_created, group_distribution_p, & n_subgroups=SIZE(opt_bas%group_partition), group_partition=opt_bas%group_partition) - opt_bas%opt_id = group_distribution(para_env%mepos)+1 + opt_bas%opt_id = group_distribution(para_env%mepos) + 1 CALL driver_optimization_para_low(opt_bas, input_declaration, para_env, opt_group) @@ -264,7 +264,7 @@ SUBROUTINE compute_residuum_vectors(opt_bas, f_env_id, matrix_S_inv, tot_time, & ALLOCATE (start_time(SIZE(opt_bas%comp_group(mp_id)%member_list))) DO icalc = 1, SIZE(opt_bas%comp_group(mp_id)%member_list) - my_id = opt_bas%comp_group(mp_id)%member_list(icalc)+1 + my_id = opt_bas%comp_group(mp_id)%member_list(icalc) + 1 ! setup timings start_time(icalc) = m_walltime() @@ -288,7 +288,7 @@ SUBROUTINE compute_residuum_vectors(opt_bas, f_env_id, matrix_S_inv, tot_time, & CALL evaluate_energy(qs_env%mos_aux_fit, matrix_ks, matrix_s_inv(icalc)%matrix, qs_env%admm_env%Q, & qs_env%admm_env%work_aux_aux, energy(my_id)) - my_time(my_id) = m_walltime()-start_time(icalc) + my_time(my_id) = m_walltime() - start_time(icalc) END DO IF (.NOT. para_env%ionode) THEN f_vec = 0.0_dp; cond_vec = 0.0_dp; my_time = 0.0_dp; energy = 0.0_dp @@ -302,11 +302,11 @@ SUBROUTINE compute_residuum_vectors(opt_bas, f_env_id, matrix_S_inv, tot_time, & CALL mp_sum(energy, para_env_top%group) opt_bas%powell_param%f = 0.0_dp DO icalc = 1, SIZE(f_vec) - icomb = MOD(icalc-1, opt_bas%ncombinations) - opt_bas%powell_param%f = opt_bas%powell_param%f+ & - (f_vec(icalc)+energy(icalc))*opt_bas%fval_weight(icomb) + icomb = MOD(icalc - 1, opt_bas%ncombinations) + opt_bas%powell_param%f = opt_bas%powell_param%f + & + (f_vec(icalc) + energy(icalc))*opt_bas%fval_weight(icomb) IF (opt_bas%use_condition_number) & - opt_bas%powell_param%f = opt_bas%powell_param%f+ & + opt_bas%powell_param%f = opt_bas%powell_param%f + & LOG(cond_vec(icalc))*opt_bas%condition_weight(icomb) END DO @@ -454,12 +454,12 @@ SUBROUTINE update_subset_freevars(subset, ix, x) CALL timeset(routineN, handle) DO iexp = 1, subset%nexp IF (subset%opt_exps(iexp)) THEN - ix = ix+1 + ix = ix + 1 subset%exps(iexp) = ABS(x(ix)) IF (subset%exp_has_const(iexp)) THEN !use a fermi function to keep expoenents in a given range around their initial value - fermi_f = 1.0_dp/(EXP((x(ix)-1.0_dp)/0.5_dp)+1.0_dp) - subset%exps(iexp) = (2.0_dp*fermi_f-1.0_dp)*subset%exp_const(iexp)%var_fac*subset%exp_const(iexp)%init+ & + fermi_f = 1.0_dp/(EXP((x(ix) - 1.0_dp)/0.5_dp) + 1.0_dp) + subset%exps(iexp) = (2.0_dp*fermi_f - 1.0_dp)*subset%exp_const(iexp)%var_fac*subset%exp_const(iexp)%init + & subset%exp_const(iexp)%init ELSE @@ -467,7 +467,7 @@ SUBROUTINE update_subset_freevars(subset, ix, x) END IF DO icont = 1, subset%ncon_tot IF (subset%opt_coeff(iexp, icont)) THEN - ix = ix+1 + ix = ix + 1 subset%coeff(iexp, icont) = x(ix) END IF END DO @@ -476,14 +476,14 @@ SUBROUTINE update_subset_freevars(subset, ix, x) ! orthonormalize contraction coefficients using gram schmidt istart = 1 DO il = 1, subset%nl - DO icon1 = istart, istart+subset%l(il)-2 - DO icon2 = icon1+1, istart+subset%l(il)-1 + DO icon1 = istart, istart + subset%l(il) - 2 + DO icon2 = icon1 + 1, istart + subset%l(il) - 1 gs_scale = DOT_PRODUCT(subset%coeff(:, icon2), subset%coeff(:, icon1))/ & DOT_PRODUCT(subset%coeff(:, icon1), subset%coeff(:, icon1)) - subset%coeff(:, icon2) = subset%coeff(:, icon2)-gs_scale*subset%coeff(:, icon1) + subset%coeff(:, icon2) = subset%coeff(:, icon2) - gs_scale*subset%coeff(:, icon1) END DO END DO - istart = istart+subset%l(il) + istart = istart + subset%l(il) END DO DO icon1 = 1, subset%ncon_tot @@ -542,13 +542,13 @@ SUBROUTINE init_subset_freevars(subset, ix, x) DO iexp = 1, subset%nexp IF (subset%opt_exps(iexp)) THEN - ix = ix+1 + ix = ix + 1 x(ix) = subset%exps(iexp) IF (subset%exp_has_const(iexp)) THEN IF (subset%exp_const(iexp)%const_type == 0) THEN - fract = 1.0_dp+(subset%exps(iexp)-subset%exp_const(iexp)%init)/ & + fract = 1.0_dp + (subset%exps(iexp) - subset%exp_const(iexp)%init)/ & (subset%exp_const(iexp)%init*subset%exp_const(iexp)%var_fac) - x(ix) = 0.5_dp*LOG((2.0_dp/fract-1.0_dp))+1.0_dp + x(ix) = 0.5_dp*LOG((2.0_dp/fract - 1.0_dp)) + 1.0_dp END IF IF (subset%exp_const(iexp)%const_type == 1) THEN x(ix) = 1.0_dp @@ -557,7 +557,7 @@ SUBROUTINE init_subset_freevars(subset, ix, x) END IF DO icont = 1, subset%ncon_tot IF (subset%opt_coeff(iexp, icont)) THEN - ix = ix+1 + ix = ix + 1 x(ix) = subset%coeff(iexp, icont) END IF END DO @@ -593,7 +593,7 @@ SUBROUTINE output_opt_info(f_vec, cond_vec, my_time, tot_time, opt_bas, iopt, pa CALL timeset(routineN, handle) logger => cp_get_default_logger() - tot_time = tot_time+my_time + tot_time = tot_time + my_time unit_nr = -1 IF (para_env_top%ionode .AND. (MOD(iopt, opt_bas%write_frequency) == 0 .OR. iopt == opt_bas%powell_param%maxfun)) & @@ -606,7 +606,7 @@ SUBROUTINE output_opt_info(f_vec, cond_vec, my_time, tot_time, opt_bas, iopt, pa icalc = 0 DO iset = 1, opt_bas%ntraining_sets DO ibasis = 1, opt_bas%ncombinations - icalc = icalc+1 + icalc = icalc + 1 WRITE (unit_nr, '(1X,A,2(5X,I3,5X,A),2(1X,E14.8,1X,A),1X,F8.3)') & 'BASOPT| ', iset, "|", ibasis, "|", f_vec(icalc), "|", cond_vec(icalc), "|", tot_time(icalc) END DO diff --git a/src/optimize_basis_types.F b/src/optimize_basis_types.F index 37b1c99176..108db101ad 100644 --- a/src/optimize_basis_types.F +++ b/src/optimize_basis_types.F @@ -172,7 +172,7 @@ SUBROUTINE deallocate_kind_basis(kind) INTEGER :: ibasis, icont, iinfo, iset IF (ALLOCATED(kind%deriv_info)) THEN - DO iinfo = 0, SIZE(kind%deriv_info)-1 + DO iinfo = 0, SIZE(kind%deriv_info) - 1 IF (ALLOCATED(kind%deriv_info(iinfo)%remove_contr)) DEALLOCATE (kind%deriv_info(iinfo)%remove_contr) IF (ALLOCATED(kind%deriv_info(iinfo)%remove_set)) DEALLOCATE (kind%deriv_info(iinfo)%remove_set) IF (ALLOCATED(kind%deriv_info(iinfo)%in_use_set)) DEALLOCATE (kind%deriv_info(iinfo)%in_use_set) @@ -188,7 +188,7 @@ SUBROUTINE deallocate_kind_basis(kind) END IF IF (ALLOCATED(kind%flex_basis)) THEN - DO ibasis = 0, SIZE(kind%flex_basis)-1 + DO ibasis = 0, SIZE(kind%flex_basis) - 1 IF (ALLOCATED(kind%flex_basis(ibasis)%subset)) THEN DO iset = 1, SIZE(kind%flex_basis(ibasis)%subset) IF (ALLOCATED(kind%flex_basis(ibasis)%subset(iset)%l)) & diff --git a/src/optimize_basis_utils.F b/src/optimize_basis_utils.F index e91befe370..d78035aa07 100644 --- a/src/optimize_basis_utils.F +++ b/src/optimize_basis_utils.F @@ -107,7 +107,7 @@ SUBROUTINE optimize_basis_init_read_input(opt_bas, root_section, para_env) ALLOCATE (opt_bas%fval_weight(0:opt_bas%ncombinations)) opt_bas%fval_weight = 1.0_dp DO iweight = 1, nrep - CALL section_vals_val_get(optbas_section, "RESIDUUM_WEIGHT", r_val=opt_bas%fval_weight(iweight-1), & + CALL section_vals_val_get(optbas_section, "RESIDUUM_WEIGHT", r_val=opt_bas%fval_weight(iweight - 1), & i_rep_val=iweight) END DO @@ -115,7 +115,7 @@ SUBROUTINE optimize_basis_init_read_input(opt_bas, root_section, para_env) ALLOCATE (opt_bas%condition_weight(0:opt_bas%ncombinations)) opt_bas%condition_weight = 1.0_dp DO iweight = 1, nrep - CALL section_vals_val_get(optbas_section, "CONDITION_WEIGHT", r_val=opt_bas%condition_weight(iweight-1), & + CALL section_vals_val_get(optbas_section, "CONDITION_WEIGHT", r_val=opt_bas%condition_weight(iweight - 1), & i_rep_val=iweight) END DO @@ -192,10 +192,10 @@ SUBROUTINE generate_basis_combinations(opt_bas, optbas_section) DO j = 1, opt_bas%nkind opt_bas%combination(i, j) = tmp_i2(j) END DO - tmp_i2(opt_bas%nkind) = tmp_i2(opt_bas%nkind)+1 + tmp_i2(opt_bas%nkind) = tmp_i2(opt_bas%nkind) + 1 raise = .FALSE. DO j = opt_bas%nkind, 1, -1 - IF (raise) tmp_i2(j) = tmp_i2(j)+1 + IF (raise) tmp_i2(j) = tmp_i2(j) + 1 IF (tmp_i2(j) .GT. tmp_i(j)) THEN tmp_i2(j) = 0 raise = .TRUE. @@ -239,8 +239,8 @@ SUBROUTINE get_set_and_basis_id(calc_id, opt_bas, set_id, bas_id) ncom = opt_bas%ncombinations nset = opt_bas%ntraining_sets - set_id = (calc_id)/ncom+1 - bas_id = MOD(calc_id, ncom)+1 + set_id = (calc_id)/ncom + 1 + bas_id = MOD(calc_id, ncom) + 1 END SUBROUTINE @@ -276,27 +276,27 @@ SUBROUTINE generate_computation_groups(opt_bas, optbas_section, para_env) iadd1 = nproc/ncalc iadd2 = MOD(nproc, ncalc) ALLOCATE (opt_bas%comp_group(ncalc)) - ALLOCATE (opt_bas%group_partition(0:ncalc-1)) - DO igroup = 0, ncalc-1 - ALLOCATE (opt_bas%comp_group(igroup+1)%member_list(1)) - opt_bas%comp_group(igroup+1)%member_list(1) = igroup + ALLOCATE (opt_bas%group_partition(0:ncalc - 1)) + DO igroup = 0, ncalc - 1 + ALLOCATE (opt_bas%comp_group(igroup + 1)%member_list(1)) + opt_bas%comp_group(igroup + 1)%member_list(1) = igroup opt_bas%group_partition(igroup) = iadd1 - IF (igroup .LT. iadd2) opt_bas%group_partition(igroup) = opt_bas%group_partition(igroup)+1 + IF (igroup .LT. iadd2) opt_bas%group_partition(igroup) = opt_bas%group_partition(igroup) + 1 END DO ELSE iadd1 = ncalc/nproc iadd2 = MOD(ncalc, nproc) ALLOCATE (opt_bas%comp_group(nproc)) - ALLOCATE (opt_bas%group_partition(0:nproc-1)) + ALLOCATE (opt_bas%group_partition(0:nproc - 1)) icount = 0 - DO igroup = 0, nproc-1 + DO igroup = 0, nproc - 1 opt_bas%group_partition(igroup) = 1 isize = iadd1 - IF (igroup .LT. iadd2) isize = isize+1 - ALLOCATE (opt_bas%comp_group(igroup+1)%member_list(isize)) + IF (igroup .LT. iadd2) isize = isize + 1 + ALLOCATE (opt_bas%comp_group(igroup + 1)%member_list(isize)) DO j = 1, isize - opt_bas%comp_group(igroup+1)%member_list(j) = icount - icount = icount+1 + opt_bas%comp_group(igroup + 1)%member_list(j) = icount + icount = icount + 1 END DO END DO END IF @@ -316,26 +316,26 @@ SUBROUTINE generate_computation_groups(opt_bas, optbas_section, para_env) " Please change input.") CPASSERT(nptot == nproc) ALLOCATE (opt_bas%comp_group(isize)) - ALLOCATE (opt_bas%group_partition(0:isize-1)) + ALLOCATE (opt_bas%group_partition(0:isize - 1)) IF (isize .LT. ncalc) THEN iadd1 = ncalc/isize iadd2 = MOD(ncalc, isize) icount = 0 - DO igroup = 0, isize-1 - opt_bas%group_partition(igroup) = i_vals(igroup+1) + DO igroup = 0, isize - 1 + opt_bas%group_partition(igroup) = i_vals(igroup + 1) isize = iadd1 - IF (igroup .LT. iadd2) isize = isize+1 - ALLOCATE (opt_bas%comp_group(igroup+1)%member_list(isize)) + IF (igroup .LT. iadd2) isize = isize + 1 + ALLOCATE (opt_bas%comp_group(igroup + 1)%member_list(isize)) DO j = 1, isize - opt_bas%comp_group(igroup+1)%member_list(j) = icount - icount = icount+1 + opt_bas%comp_group(igroup + 1)%member_list(j) = icount + icount = icount + 1 END DO END DO ELSE - DO igroup = 0, isize-1 - opt_bas%group_partition(igroup) = i_vals(igroup+1) - ALLOCATE (opt_bas%comp_group(igroup+1)%member_list(1)) - opt_bas%comp_group(igroup+1)%member_list(1) = igroup + DO igroup = 0, isize - 1 + opt_bas%group_partition(igroup) = i_vals(igroup + 1) + ALLOCATE (opt_bas%comp_group(igroup + 1)%member_list(1)) + opt_bas%comp_group(igroup + 1)%member_list(1) = igroup END DO END IF END IF @@ -407,12 +407,12 @@ SUBROUTINE update_used_parts(info_new, basis, basis_new) jset = 0 DO iset = 1, basis%nsets IF (info_new%in_use_set(iset)) THEN - jset = jset+1 + jset = jset + 1 basis_new%subset(jset)%exps(:) = basis%subset(iset)%exps jcont = 0 DO icont = 1, basis%subset(iset)%ncon_tot IF (info_new%use_contr(iset)%in_use(icont)) THEN - jcont = jcont+1 + jcont = jcont + 1 basis_new%subset(jset)%coeff(:, jcont) = basis%subset(iset)%coeff(:, icont) END IF END DO @@ -548,14 +548,14 @@ SUBROUTINE setup_used_parts_init_basis(info_new, info_ref, basis, basis_new) nsets = 0 DO i = 1, basis%nsets - IF (info_new%in_use_set(i)) nsets = nsets+1 + IF (info_new%in_use_set(i)) nsets = nsets + 1 END DO basis_new%nsets = nsets ALLOCATE (basis_new%subset(nsets)) jset = 0 DO i = 1, basis%nsets IF (info_new%in_use_set(i)) THEN - jset = jset+1 + jset = jset + 1 CALL create_new_subset(basis%subset(i), basis_new%subset(jset), info_new%use_contr(jset)%in_use) END IF END DO @@ -583,17 +583,17 @@ SUBROUTINE create_new_subset(subset, subset_new, in_use) ALLOCATE (tmp_l(SIZE(subset%l))) tmp_l(:) = subset%l subset_new%lmin = subset%lmin - subset_new%lmax = subset%lmin-1 + subset_new%lmax = subset%lmin - 1 subset_new%nexp = subset%nexp subset_new%n = subset%n DO il = 1, SIZE(subset%l) DO icon = 1, subset%l(il) - iind = convert_l_contr_to_entry(subset%lmin, subset%l, icon, subset%lmin+il-1) - IF (.NOT. in_use(iind)) tmp_l(il) = tmp_l(il)-1 + iind = convert_l_contr_to_entry(subset%lmin, subset%l, icon, subset%lmin + il - 1) + IF (.NOT. in_use(iind)) tmp_l(il) = tmp_l(il) - 1 END DO - IF (tmp_l(il) .GT. 0) subset_new%lmax = subset_new%lmax+1 + IF (tmp_l(il) .GT. 0) subset_new%lmax = subset_new%lmax + 1 END DO - subset_new%nl = subset_new%lmax-subset_new%lmin+1 + subset_new%nl = subset_new%lmax - subset_new%lmin + 1 subset_new%ncon_tot = SUM(tmp_l) ALLOCATE (subset_new%l(subset_new%nl)) ALLOCATE (subset_new%coeff(subset_new%nexp, subset_new%ncon_tot)) @@ -607,7 +607,7 @@ SUBROUTINE create_new_subset(subset, subset_new, in_use) iind = 0 DO icon = 1, subset%ncon_tot IF (in_use(icon)) THEN - iind = iind+1 + iind = iind + 1 subset_new%coeff(:, iind) = subset%coeff(:, icon) END IF END DO @@ -685,7 +685,7 @@ SUBROUTINE generate_initial_basis(kind_section, opt_bas, para_env) CALL parse_derived_basis(kind_section, opt_bas%kind_basis(ikind)%deriv_info, ikind) - variable_counter = variable_counter+opt_bas%kind_basis(ikind)%flex_basis(0)%nopt + variable_counter = variable_counter + opt_bas%kind_basis(ikind)%flex_basis(0)%nopt END DO ALLOCATE (opt_bas%x_opt(variable_counter)) @@ -720,12 +720,12 @@ SUBROUTINE parse_derived_basis(kind_section, deriv_info, ikind) LOGICAL :: explicit TYPE(section_vals_type), POINTER :: set1_section - nsets = SIZE(deriv_info)-1 + nsets = SIZE(deriv_info) - 1 set1_section => section_vals_get_subs_vals(kind_section, "DERIVED_BASIS_SETS", & i_rep_section=ikind) DO jset = 1, nsets ! stracnge but as derive info is allcated from 0 to n the count over here has to be shifted - iset = jset+1 + iset = jset + 1 CALL section_vals_val_get(set1_section, "BASIS_SET_NAME", c_val=deriv_info(iset)%basis_name, & i_rep_section=jset) CALL section_vals_val_get(set1_section, "REFERENCE_SET", i_vals=i_vals, i_rep_section=jset) @@ -865,7 +865,7 @@ SUBROUTINE set_constraint(flex_basis, iset, ipgf, const_section, is_bound, is_va " to"//cp_to_string(MAXVAL(r_vals))// & " Please change input.") flex_basis%subset(iset)%exp_const(ipgf)%init = SUM(r_vals)/2.0_dp - flex_basis%subset(iset)%exp_const(ipgf)%var_fac = MAXVAL(r_vals)/flex_basis%subset(iset)%exp_const(ipgf)%init-1.0_dp + flex_basis%subset(iset)%exp_const(ipgf)%var_fac = MAXVAL(r_vals)/flex_basis%subset(iset)%exp_const(ipgf)%init - 1.0_dp END IF IF (is_varlim) THEN flex_basis%subset(iset)%exp_const(ipgf)%const_type = 1 @@ -897,13 +897,13 @@ SUBROUTINE assign_x_to_basis(x, basis, x_ind) DO iset = 1, basis%nsets DO ipgf = 1, basis%subset(iset)%nexp IF (basis%subset(iset)%opt_exps(ipgf)) THEN - x_ind = x_ind+1 + x_ind = x_ind + 1 basis%subset(iset)%exp_x_ind(ipgf) = x_ind x(x_ind) = basis%subset(iset)%exps(ipgf) END IF DO icont = 1, basis%subset(iset)%ncon_tot IF (basis%subset(iset)%opt_coeff(ipgf, icont)) THEN - x_ind = x_ind+1 + x_ind = x_ind + 1 basis%subset(iset)%coeff_x_ind(ipgf, icont) = x_ind x(x_ind) = basis%subset(iset)%coeff(ipgf, icont) END IF @@ -992,7 +992,7 @@ SUBROUTINE fill_basis_template(kind1_section, flex_basis, template_basis_file, e CALL section_vals_val_get(kind1_section, "SWITCH_SET_STATE", i_rep_val=irep, & i_rep_section=ikind, i_vals=switch) DO ipgf = 1, flex_basis%subset(switch(2))%nexp - SELECT CASE (switch (1)) + SELECT CASE (switch(1)) CASE (0) ! switch all states in the set DO icont = 1, flex_basis%subset(switch(2))%ncon_tot flex_basis%subset(switch(2))%opt_coeff(ipgf, icont) = & @@ -1026,9 +1026,9 @@ SUBROUTINE fill_basis_template(kind1_section, flex_basis, template_basis_file, e DO irep = 1, flex_basis%nsets DO ipgf = 1, flex_basis%subset(irep)%nexp DO icont = 1, flex_basis%subset(irep)%ncon_tot - IF (flex_basis%subset(irep)%opt_coeff(ipgf, icont)) flex_basis%nopt = flex_basis%nopt+1 + IF (flex_basis%subset(irep)%opt_coeff(ipgf, icont)) flex_basis%nopt = flex_basis%nopt + 1 END DO - IF (flex_basis%subset(irep)%opt_exps(ipgf)) flex_basis%nopt = flex_basis%nopt+1 + IF (flex_basis%subset(irep)%opt_exps(ipgf)) flex_basis%nopt = flex_basis%nopt + 1 END DO END DO @@ -1052,12 +1052,12 @@ FUNCTION convert_l_contr_to_entry(lmin, nl, icontr, l) RESULT(ientry) INTEGER :: i, icon2l, iwork - iwork = l-lmin + iwork = l - lmin icon2l = 0 DO i = 1, iwork - icon2l = icon2l+nl(i) + icon2l = icon2l + nl(i) END DO - ientry = icon2l+icontr + ientry = icon2l + icontr END FUNCTION convert_l_contr_to_entry @@ -1102,8 +1102,8 @@ SUBROUTINE parse_basis(flex_basis, template_basis_file, element, basis_name, par line2 = " "//line//" " element2 = " "//TRIM(element)//" " basis_name2 = " "//TRIM(basis_name)//" " - strlen1 = LEN_TRIM(element2)+1 - strlen2 = LEN_TRIM(basis_name2)+1 + strlen1 = LEN_TRIM(element2) + 1 + strlen2 = LEN_TRIM(basis_name2) + 1 IF ((INDEX(line2, element2(:strlen1)) > 0) .AND. & (INDEX(line2, basis_name2(:strlen2)) > 0)) match = .TRUE. IF (match) THEN @@ -1151,7 +1151,7 @@ SUBROUTINE parse_subset(parser, subset) CALL parser_get_object(parser, subset%lmin) CALL parser_get_object(parser, subset%lmax) CALL parser_get_object(parser, subset%nexp) - subset%nl = subset%lmax-subset%lmin+1 + subset%nl = subset%lmax - subset%lmin + 1 ALLOCATE (r_val) ALLOCATE (subset%l(subset%nl)) ALLOCATE (subset%exps(subset%nexp)) @@ -1181,14 +1181,14 @@ SUBROUTINE parse_subset(parser, subset) ! orthonormalize contraction coefficients using gram schmidt istart = 1 DO il = 1, subset%nl - DO icon1 = istart, istart+subset%l(il)-2 - DO icon2 = icon1+1, istart+subset%l(il)-1 + DO icon1 = istart, istart + subset%l(il) - 2 + DO icon2 = icon1 + 1, istart + subset%l(il) - 1 gs_scale = DOT_PRODUCT(subset%coeff(:, icon2), subset%coeff(:, icon1))/ & DOT_PRODUCT(subset%coeff(:, icon1), subset%coeff(:, icon1)) - subset%coeff(:, icon2) = subset%coeff(:, icon2)-gs_scale*subset%coeff(:, icon1) + subset%coeff(:, icon2) = subset%coeff(:, icon2) - gs_scale*subset%coeff(:, icon1) END DO END DO - istart = istart+subset%l(il) + istart = istart + subset%l(il) END DO ! just to get an understandable basis normalize coefficients diff --git a/src/optimize_embedding_potential.F b/src/optimize_embedding_potential.F index 62ea66f7cc..a6f61d27b6 100644 --- a/src/optimize_embedding_potential.F +++ b/src/optimize_embedding_potential.F @@ -167,22 +167,22 @@ SUBROUTINE understand_spin_states(force_env, ref_subsys_number, change_spin, ope IF (all_nspins(3) .EQ. 1) THEN total_spin = 0 ELSE - total_spin = all_spins(1, 3)-all_spins(2, 3) + total_spin = all_spins(1, 3) - all_spins(2, 3) ENDIF IF (all_nspins(1) .EQ. 1) THEN sub_spin_1 = 0 ELSE - sub_spin_1 = all_spins(1, 1)-all_spins(2, 1) + sub_spin_1 = all_spins(1, 1) - all_spins(2, 1) ENDIF IF (all_nspins(2) .EQ. 1) THEN sub_spin_2 = 0 ELSE - sub_spin_2 = all_spins(1, 2)-all_spins(2, 2) + sub_spin_2 = all_spins(1, 2) - all_spins(2, 2) ENDIF - IF ((sub_spin_1+sub_spin_2) .EQ. total_spin) THEN + IF ((sub_spin_1 + sub_spin_2) .EQ. total_spin) THEN change_spin = .FALSE. ELSE - IF (ABS(sub_spin_1-sub_spin_2) .EQ. total_spin) THEN + IF (ABS(sub_spin_1 - sub_spin_2) .EQ. total_spin) THEN change_spin = .TRUE. ELSE CPABORT("Spin states of subsystems are not compatible.") @@ -288,8 +288,8 @@ SUBROUTINE init_embed_pot(qs_env, embed_pot, add_const_pot, Fermi_Amaldi, const_ CALL pw_copy(v_hartree_r_space%pw, embed_pot%pw) ! Calculate the number of electrons - nelectrons = nelectron_spin(1)+nelectron_spin(2) - factor = (REAL(nelectrons)-1.0_dp)/(REAL(nelectrons)) + nelectrons = nelectron_spin(1) + nelectron_spin(2) + factor = (REAL(nelectrons) - 1.0_dp)/(REAL(nelectrons)) ! Scale the Hartree potential to get Fermi-Amaldi CALL pw_scale(embed_pot%pw, a=factor) @@ -420,7 +420,7 @@ SUBROUTINE prepare_embed_opt(qs_env, opt_embed, opt_embed_section) CALL get_qs_env(qs_env=qs_env, pw_env=pw_env) CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool) NULLIFY (opt_embed%prev_subsys_dens) - size_prev_dens = SUM(opt_embed%all_nspins(1:(SIZE(opt_embed%all_nspins)-1))) + size_prev_dens = SUM(opt_embed%all_nspins(1:(SIZE(opt_embed%all_nspins) - 1))) ALLOCATE (opt_embed%prev_subsys_dens(size_prev_dens)) DO i_dens = 1, size_prev_dens CALL pw_pool_create_pw(auxbas_pw_pool, opt_embed%prev_subsys_dens(i_dens)%pw, & @@ -610,7 +610,7 @@ SUBROUTINE find_aux_dimen(qs_env, dimen_aux) DO iatom = 1, natom ikind = kind_of(iatom) CALL get_qs_kind(qs_kind=qs_kind_set(ikind), nsgf=nsgf, basis_type="RI_AUX") - dimen_aux = dimen_aux+nsgf + dimen_aux = dimen_aux + nsgf END DO DEALLOCATE (kind_of) @@ -1217,7 +1217,7 @@ SUBROUTINE calculate_embed_pot_grad(qs_env, diff_rho_r, diff_rho_spin, opt_embed CALL cp_fm_to_fm_submat(msource=opt_embed%embed_pot_coef, & mtarget=embed_pot_coeff_spin, & nrow=opt_embed%dimen_aux, ncol=1, & - s_firstrow=opt_embed%dimen_aux+1, s_firstcol=1, & + s_firstrow=opt_embed%dimen_aux + 1, s_firstcol=1, & t_firstrow=1, t_firstcol=1) ! Multiply CALL cp_gemm(transa="N", transb="N", m=opt_embed%dimen_aux, n=1, & @@ -1238,7 +1238,7 @@ SUBROUTINE calculate_embed_pot_grad(qs_env, diff_rho_r, diff_rho_spin, opt_embed mtarget=regular_term, & nrow=opt_embed%dimen_aux, ncol=1, & s_firstrow=1, s_firstcol=1, & - t_firstrow=opt_embed%dimen_aux+1, t_firstcol=1) + t_firstrow=opt_embed%dimen_aux + 1, t_firstcol=1) ! Release internally used auxiliary structures CALL cp_fm_release(embed_pot_coeff_spinless) CALL cp_fm_release(embed_pot_coeff_spin) @@ -1335,8 +1335,8 @@ SUBROUTINE calculate_embed_pot_grad_inner(qs_env, dimen_aux, rho_r, rho_spin, em DO ikind = 1, SIZE(lri) DO iatom = 1, SIZE(lri(ikind)%v_int, DIM=1) nsgf = SIZE(lri(ikind)%v_int(iatom, :)) - pot_grad(start_pos:start_pos+nsgf-1) = lri(ikind)%v_int(iatom, :) - start_pos = start_pos+nsgf + pot_grad(start_pos:start_pos + nsgf - 1) = lri(ikind)%v_int(iatom, :) + start_pos = start_pos + nsgf ENDDO ENDDO @@ -1352,12 +1352,12 @@ SUBROUTINE calculate_embed_pot_grad_inner(qs_env, dimen_aux, rho_r, rho_spin, em CALL mp_sum(lri(ikind)%v_int, para_env%group) END DO - start_pos = dimen_aux+1 + start_pos = dimen_aux + 1 DO ikind = 1, SIZE(lri) DO iatom = 1, SIZE(lri(ikind)%v_int, DIM=1) nsgf = SIZE(lri(ikind)%v_int(iatom, :)) - pot_grad(start_pos:start_pos+nsgf-1) = lri(ikind)%v_int(iatom, :) - start_pos = start_pos+nsgf + pot_grad(start_pos:start_pos + nsgf - 1) = lri(ikind)%v_int(iatom, :) + start_pos = start_pos + nsgf ENDDO ENDDO ENDIF @@ -1521,9 +1521,9 @@ SUBROUTINE grid_regularize(potential, pw_env, lambda, reg_term) DO j = lb(2), ub(2) DO i = lb(1), ub(1) square_norm_dpot%cr3d(i, j, k) = (dpot(1)%pw%cr3d(i, j, k)* & - dpot(1)%pw%cr3d(i, j, k)+ & + dpot(1)%pw%cr3d(i, j, k) + & dpot(2)%pw%cr3d(i, j, k)* & - dpot(2)%pw%cr3d(i, j, k)+ & + dpot(2)%pw%cr3d(i, j, k) + & dpot(3)%pw%cr3d(i, j, k)* & dpot(3)%pw%cr3d(i, j, k)) END DO @@ -1766,12 +1766,12 @@ SUBROUTINE grid_based_step(diff_rho_r, diff_rho_spin, pw_env, opt_embed, embed_p CALL pw_axpy(diff_rho_r%pw, embed_pot%pw, opt_embed%step_len) ! Regularize CALL grid_regularize(embed_pot, pw_env, opt_embed%lambda, my_reg_term) - opt_embed%reg_term = opt_embed%reg_term+my_reg_term + opt_embed%reg_term = opt_embed%reg_term + my_reg_term IF (opt_embed%open_shell_embed) THEN CALL pw_axpy(diff_rho_spin%pw, spin_embed_pot%pw, opt_embed%step_len) CALL grid_regularize(spin_embed_pot, pw_env, opt_embed%lambda, my_reg_term) - opt_embed%reg_term = opt_embed%reg_term+my_reg_term + opt_embed%reg_term = opt_embed%reg_term + my_reg_term ENDIF CALL timestop(handle) @@ -1871,7 +1871,7 @@ SUBROUTINE update_embed_pot(embed_pot_coef, dimen_aux, embed_pot, spin_embed_pot CALL cp_fm_to_fm_submat(embed_pot_coef, & mtarget=embed_pot_coef_spin, & nrow=dimen_aux, ncol=1, & - s_firstrow=dimen_aux+1, s_firstcol=1, & + s_firstrow=dimen_aux + 1, s_firstcol=1, & t_firstrow=1, t_firstcol=1) ! Spinless potential @@ -2047,7 +2047,7 @@ SUBROUTINE inv_Hessian_update(grad, prev_grad, step, prev_inv_Hess, inv_Hess) CALL cp_fm_trace(y, B_inv_y, y_dot_B_inv_y) - factor1 = (s_dot_y+y_dot_B_inv_y)/(s_dot_y)**2 + factor1 = (s_dot_y + y_dot_B_inv_y)/(s_dot_y)**2 CALL cp_fm_scale_and_add(1.0_dp, inv_Hess, factor1, s_s) @@ -2295,10 +2295,10 @@ SUBROUTINE step_control(opt_embed) beta=0.0_dp, matrix_c=H_b) CALL cp_fm_trace(opt_embed%step, H_b, quad_term) - pred_ener_change = lin_term+0.5_dp*quad_term + pred_ener_change = lin_term + 0.5_dp*quad_term ! Reveal actual energy change - actual_ener_change = opt_embed%w_func(opt_embed%i_iter)- & + actual_ener_change = opt_embed%w_func(opt_embed%i_iter) - & opt_embed%w_func(opt_embed%last_accepted) ener_ratio = actual_ener_change/pred_ener_change @@ -2374,7 +2374,7 @@ SUBROUTINE level_shift(opt_embed, diag_grad, eigenval, diag_step) !shift_min = -2.0_dp*(diag_grad_norm/opt_embed%trust_rad - min(hess_min, 0.0_dp)) !shift_max = max(0.0_dp, -hess_min + 0.5_dp*grad_min/opt_embed%trust_rad) !shift_max = MIN(-hess_min+0.5_dp*grad_min/opt_embed%trust_rad, 0.0_dp) - shift_max = hess_min+0.1 + shift_max = hess_min + 0.1 shift_min = diag_grad_norm/opt_embed%trust_rad shift_min = 10.0_dp !If (abs(shift_max) .LE. thresh) then @@ -2397,7 +2397,7 @@ SUBROUTINE level_shift(opt_embed, diag_grad, eigenval, diag_step) shift = shift_min ELSE DO i_iter = 1, max_iter - shift = 0.5_dp*(shift_max+shift_min) + shift = 0.5_dp*(shift_max + shift_min) step_minus_trad = shifted_step(diag_grad, eigenval, shift, opt_embed%trust_rad) IF (i_iter .EQ. 1) step_minus_trad_first = step_minus_trad IF (step_minus_trad .GT. 0.0_dp) shift_max = shift @@ -2415,7 +2415,7 @@ SUBROUTINE level_shift(opt_embed, diag_grad, eigenval, diag_step) l_global = row_indices(LLL) IF (ABS(eigenval(l_global)) .GE. thresh) THEN diag_step%local_data(LLL, 1) = & - -diag_grad%local_data(LLL, 1)/(eigenval(l_global)-shift) + -diag_grad%local_data(LLL, 1)/(eigenval(l_global) - shift) ELSE diag_step%local_data(LLL, 1) = 0.0_dp ENDIF @@ -2447,7 +2447,7 @@ SUBROUTINE level_shift(opt_embed, diag_grad, eigenval, diag_step) IF (red_eigenval_map(l_global) .EQ. 0) THEN IF (ABS(eigenval(l_global)) .GE. thresh) THEN diag_step%local_data(LLL, 1) = & - -diag_grad%local_data(LLL, 1)/(eigenval(l_global)-shift) + -diag_grad%local_data(LLL, 1)/(eigenval(l_global) - shift) ELSE diag_step%local_data(LLL, 1) = 0.0_dp ENDIF @@ -2494,14 +2494,14 @@ FUNCTION shifted_step(diag_grad, eigenval, shift, trust_rad) RESULT(step_minus_t DO LLL = 1, nrow_local l_global = row_indices(LLL) IF ((ABS(eigenval(l_global)) .GE. thresh) .AND. (ABS(diag_grad%local_data(LLL, 1)) .GE. thresh)) THEN - step_1d = -diag_grad%local_data(LLL, 1)/(eigenval(l_global)+shift) - step = step+step_1d**2 + step_1d = -diag_grad%local_data(LLL, 1)/(eigenval(l_global) + shift) + step = step + step_1d**2 ENDIF ENDDO CALL mp_sum(step, para_env%group) - step_minus_trad = SQRT(step)-trust_rad + step_minus_trad = SQRT(step) - trust_rad END FUNCTION shifted_step @@ -2616,7 +2616,7 @@ SUBROUTINE Leeuwen_Baerends_potential_update(pw_env, embed_pot, spin_embed_pot, my_rho = rho_cutoff ENDIF new_embed_pot(1)%pw%cr3d(i, j, k) = step_len*embed_pot%pw%cr3d(i, j, k)* & - (diff_rho_r%pw%cr3d(i, j, k)+rho_r_ref(1)%pw%cr3d(i, j, k))/my_rho + (diff_rho_r%pw%cr3d(i, j, k) + rho_r_ref(1)%pw%cr3d(i, j, k))/my_rho END DO END DO END DO @@ -3034,7 +3034,7 @@ SUBROUTINE Von_Weizsacker(rho_r, v_w, qs_env, vw_cutoff, vw_smooth_cutoff_range) ELSE my_rho = rho_cutoff ENDIF - v_w(1)%pw%cr3d(i, j, k) = one_8*rho_set%norm_drhoa(i, j, k)**2/my_rho**2- & + v_w(1)%pw%cr3d(i, j, k) = one_8*rho_set%norm_drhoa(i, j, k)**2/my_rho**2 - & one_4*rho_set%laplace_rhoa(i, j, k)/my_rho IF (rho_r(2)%pw%cr3d(i, j, k) .GT. rho_cutoff) THEN @@ -3042,7 +3042,7 @@ SUBROUTINE Von_Weizsacker(rho_r, v_w, qs_env, vw_cutoff, vw_smooth_cutoff_range) ELSE my_rho = rho_cutoff ENDIF - v_w(2)%pw%cr3d(i, j, k) = one_8*rho_set%norm_drhob(i, j, k)**2/my_rho**2- & + v_w(2)%pw%cr3d(i, j, k) = one_8*rho_set%norm_drhob(i, j, k)**2/my_rho**2 - & one_4*rho_set%laplace_rhob(i, j, k)/my_rho END DO END DO @@ -3057,7 +3057,7 @@ SUBROUTINE Von_Weizsacker(rho_r, v_w, qs_env, vw_cutoff, vw_smooth_cutoff_range) DO i = lb(1), ub(1) IF (rho_r(1)%pw%cr3d(i, j, k) .GT. rho_cutoff) THEN my_rho = rho_r(1)%pw%cr3d(i, j, k) - v_w(1)%pw%cr3d(i, j, k) = one_8*rho_set%norm_drho(i, j, k)**2/my_rho**2- & + v_w(1)%pw%cr3d(i, j, k) = one_8*rho_set%norm_drho(i, j, k)**2/my_rho**2 - & one_4*rho_set%laplace_rho(i, j, k)/my_rho ELSE v_w(1)%pw%cr3d(i, j, k) = 0.0_dp @@ -3485,15 +3485,15 @@ SUBROUTINE print_folded_coordinates(qs_env, input) END DO ! Fold the coordinates - center(:) = cell%hmat(:, 1)/2.0_dp+cell%hmat(:, 2)/2.0_dp+cell%hmat(:, 3)/2.0_dp + center(:) = cell%hmat(:, 1)/2.0_dp + cell%hmat(:, 2)/2.0_dp + cell%hmat(:, 3)/2.0_dp ! Print folded coordinates to file DO iat = 1, SIZE(particles_el) - r_pbc(:) = particles_r(:, iat)-center + r_pbc(:) = particles_r(:, iat) - center s = MATMUL(cell%h_inv, r_pbc) - s = s-ANINT(s) + s = s - ANINT(s) r_pbc = MATMUL(cell%hmat, s) - r_pbc = r_pbc+center + r_pbc = r_pbc + center WRITE (unit_nr, '(a4,4f12.6)') particles_el(iat), r_pbc(:) END DO @@ -3525,8 +3525,8 @@ SUBROUTINE print_emb_opt_info(output_unit, step_num, opt_embed) " Functional value = ", opt_embed%w_func(step_num) IF (step_num .GT. 1) THEN WRITE (UNIT=output_unit, FMT="(T2,A,F20.10)") & - " Real energy change = ", opt_embed%w_func(step_num)- & - opt_embed%w_func(step_num-1) + " Real energy change = ", opt_embed%w_func(step_num) - & + opt_embed%w_func(step_num - 1) WRITE (UNIT=output_unit, FMT="(T2,A,F20.10)") & " Step size = ", opt_embed%step_len @@ -3562,10 +3562,10 @@ SUBROUTINE get_prev_density(opt_embed, force_env, subsys_num) nspins = opt_embed%all_nspins(subsys_num) - i_dens_start = SUM(opt_embed%all_nspins(1:subsys_num))-nspins+1 + i_dens_start = SUM(opt_embed%all_nspins(1:subsys_num)) - nspins + 1 DO i_spin = 1, nspins - opt_embed%prev_subsys_dens(i_dens_start+i_spin-1)%pw%cr3d(:, :, :) = & + opt_embed%prev_subsys_dens(i_dens_start + i_spin - 1)%pw%cr3d(:, :, :) = & rho_r(i_spin)%pw%cr3d(:, :, :) ENDDO @@ -3592,13 +3592,13 @@ SUBROUTINE get_max_subsys_diff(opt_embed, force_env, subsys_num) nspins = opt_embed%all_nspins(subsys_num) - i_dens_start = SUM(opt_embed%all_nspins(1:subsys_num))-nspins+1 + i_dens_start = SUM(opt_embed%all_nspins(1:subsys_num)) - nspins + 1 DO i_spin = 1, nspins - opt_embed%prev_subsys_dens(i_dens_start+i_spin-1)%pw%cr3d(:, :, :) = & - rho_r(i_spin)%pw%cr3d(:, :, :)-opt_embed%prev_subsys_dens(i_dens_start+i_spin-1)%pw%cr3d(:, :, :) - opt_embed%max_subsys_dens_diff(i_dens_start+i_spin-1) = & - max_dens_diff(opt_embed%prev_subsys_dens(i_dens_start+i_spin-1)) + opt_embed%prev_subsys_dens(i_dens_start + i_spin - 1)%pw%cr3d(:, :, :) = & + rho_r(i_spin)%pw%cr3d(:, :, :) - opt_embed%prev_subsys_dens(i_dens_start + i_spin - 1)%pw%cr3d(:, :, :) + opt_embed%max_subsys_dens_diff(i_dens_start + i_spin - 1) = & + max_dens_diff(opt_embed%prev_subsys_dens(i_dens_start + i_spin - 1)) ENDDO END SUBROUTINE get_max_subsys_diff @@ -3745,12 +3745,12 @@ SUBROUTINE conv_check_embed(opt_embed, diff_rho_r, diff_rho_spin, output_unit) ! Maximum subsystem density change WRITE (UNIT=output_unit, FMT="(/,T2,A)") & " Maximum density change in:" - DO i_dens = 1, (SIZE(opt_embed%all_nspins)-1) - i_dens_start = SUM(opt_embed%all_nspins(1:i_dens))-opt_embed%all_nspins(i_dens)+1 + DO i_dens = 1, (SIZE(opt_embed%all_nspins) - 1) + i_dens_start = SUM(opt_embed%all_nspins(1:i_dens)) - opt_embed%all_nspins(i_dens) + 1 DO i_spin = 1, opt_embed%all_nspins(i_dens) WRITE (UNIT=output_unit, FMT="(T4,A10,I3,A6,I3,A1,F20.10)") & " subsystem ", i_dens, ', spin', i_spin, ":", & - opt_embed%max_subsys_dens_diff(i_dens_start+i_spin-1) + opt_embed%max_subsys_dens_diff(i_dens_start + i_spin - 1) ENDDO ENDDO diff --git a/src/optimize_input.F b/src/optimize_input.F index 8f8cce88a0..c5a03f3fdb 100644 --- a/src/optimize_input.F +++ b/src/optimize_input.F @@ -54,45 +54,45 @@ MODULE optimize_input powell_optimize #include "./base/base_uses.f90" - IMPLICIT NONE - PRIVATE - - PUBLIC :: run_optimize_input - - TYPE fm_env_type - CHARACTER(LEN=default_path_length) :: optimize_file_name - - CHARACTER(LEN=default_path_length) :: ref_traj_file_name - CHARACTER(LEN=default_path_length) :: ref_force_file_name - CHARACTER(LEN=default_path_length) :: ref_cell_file_name - - INTEGER :: group_size - - REAL(KIND=dp) :: energy_weight - REAL(KIND=dp) :: shift_mm - REAL(KIND=dp) :: shift_qm - LOGICAL :: shift_average - INTEGER :: frame_start,frame_stop,frame_stride,frame_count - END TYPE - - TYPE variable_type - CHARACTER(LEN=default_string_length) :: label - REAL(KIND=dp) :: value - LOGICAL :: fixed - END TYPE - - TYPE oi_env_type - INTEGER :: method - INTEGER :: seed - CHARACTER(LEN=default_path_length) :: project_name - TYPE(fm_env_type) :: fm_env - TYPE(variable_type), DIMENSION(:), ALLOCATABLE :: variables - REAL(KIND=dp) :: rhobeg,rhoend - INTEGER :: maxfun - INTEGER :: iter_start_val - REAL(KIND=dp) :: randomize_variables - REAL(KIND=dp) :: start_time,target_time - END TYPE + IMPLICIT NONE + PRIVATE + + PUBLIC :: run_optimize_input + + TYPE fm_env_type + CHARACTER(LEN=default_path_length) :: optimize_file_name + + CHARACTER(LEN=default_path_length) :: ref_traj_file_name + CHARACTER(LEN=default_path_length) :: ref_force_file_name + CHARACTER(LEN=default_path_length) :: ref_cell_file_name + + INTEGER :: group_size + + REAL(KIND=dp) :: energy_weight + REAL(KIND=dp) :: shift_mm + REAL(KIND=dp) :: shift_qm + LOGICAL :: shift_average + INTEGER :: frame_start, frame_stop, frame_stride, frame_count + END TYPE + + TYPE variable_type + CHARACTER(LEN=default_string_length) :: label + REAL(KIND=dp) :: value + LOGICAL :: fixed + END TYPE + + TYPE oi_env_type + INTEGER :: method + INTEGER :: seed + CHARACTER(LEN=default_path_length) :: project_name + TYPE(fm_env_type) :: fm_env + TYPE(variable_type), DIMENSION(:), ALLOCATABLE :: variables + REAL(KIND=dp) :: rhobeg, rhoend + INTEGER :: maxfun + INTEGER :: iter_start_val + REAL(KIND=dp) :: randomize_variables + REAL(KIND=dp) :: start_time, target_time + END TYPE CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'optimize_input' @@ -105,7 +105,7 @@ MODULE optimize_input !> \param para_env ... !> \author Joost VandeVondele ! ************************************************************************************************** - SUBROUTINE run_optimize_input(input_declaration, root_section, para_env) + SUBROUTINE run_optimize_input(input_declaration, root_section, para_env) TYPE(section_type), POINTER :: input_declaration TYPE(section_vals_type), POINTER :: root_section TYPE(cp_para_env_type), POINTER :: para_env @@ -114,43 +114,43 @@ SUBROUTINE run_optimize_input(input_declaration, root_section, para_env) routineP = moduleN//':'//routineN INTEGER :: handle, i_var - REAL(KIND=dp) :: random_number, seed(3,2) + REAL(KIND=dp) :: random_number, seed(3, 2) TYPE(oi_env_type) :: oi_env TYPE(rng_stream_type), POINTER :: rng_stream - CALL timeset(routineN,handle) + CALL timeset(routineN, handle) - oi_env%start_time=m_walltime() + oi_env%start_time = m_walltime() - CALL parse_input(oi_env,root_section) + CALL parse_input(oi_env, root_section) - ! if we have been asked to randomize the variables, we do this. - IF (oi_env%randomize_variables.NE.0.0_dp) THEN - NULLIFY(rng_stream) - seed=REAL(oi_env%seed,KIND=dp) - CALL create_rng_stream(rng_stream,"run_optimize_input",distribution_type=UNIFORM,seed=seed) - DO i_var=1,SIZE(oi_env%variables,1) - IF (.NOT.oi_env%variables(i_var)%fixed) THEN - ! change with a random percentage the variable - random_number = next_random_number(rng_stream) - oi_env%variables(i_var)%value=oi_env%variables(i_var)%value* & - (1.0_dp+(2*random_number-1.0_dp)*oi_env%randomize_variables/100.0_dp) - ENDIF - ENDDO - CALL delete_rng_stream(rng_stream) - ENDIF + ! if we have been asked to randomize the variables, we do this. + IF (oi_env%randomize_variables .NE. 0.0_dp) THEN + NULLIFY (rng_stream) + seed = REAL(oi_env%seed, KIND=dp) + CALL create_rng_stream(rng_stream, "run_optimize_input", distribution_type=UNIFORM, seed=seed) + DO i_var = 1, SIZE(oi_env%variables, 1) + IF (.NOT. oi_env%variables(i_var)%fixed) THEN + ! change with a random percentage the variable + random_number = next_random_number(rng_stream) + oi_env%variables(i_var)%value = oi_env%variables(i_var)%value* & + (1.0_dp + (2*random_number - 1.0_dp)*oi_env%randomize_variables/100.0_dp) + ENDIF + ENDDO + CALL delete_rng_stream(rng_stream) + ENDIF - ! proceed to actual methods - SELECT CASE(oi_env%method) - CASE(opt_force_matching) - CALL force_matching(oi_env,input_declaration,root_section,para_env) - CASE DEFAULT - CPABORT("") - END SELECT + ! proceed to actual methods + SELECT CASE (oi_env%method) + CASE (opt_force_matching) + CALL force_matching(oi_env, input_declaration, root_section, para_env) + CASE DEFAULT + CPABORT("") + END SELECT - CALL timestop(handle) + CALL timestop(handle) - END SUBROUTINE run_optimize_input + END SUBROUTINE run_optimize_input ! ************************************************************************************************** !> \brief optimizes parameters by force/energy matching results against reference values @@ -160,7 +160,7 @@ END SUBROUTINE run_optimize_input !> \param para_env ... !> \author Joost VandeVondele ! ************************************************************************************************** - SUBROUTINE force_matching(oi_env,input_declaration,root_section,para_env) + SUBROUTINE force_matching(oi_env, input_declaration, root_section, para_env) TYPE(oi_env_type) :: oi_env TYPE(section_type), POINTER :: input_declaration TYPE(section_vals_type), POINTER :: root_section @@ -190,325 +190,321 @@ SUBROUTINE force_matching(oi_env,input_declaration,root_section,para_env) TYPE(opt_state_type) :: ostate TYPE(section_vals_type), POINTER :: oi_section, variable_section - CALL timeset(routineN,handle) - - logger=>cp_get_default_logger() - CALL cp_add_iter_level(logger%iter_info,"POWELL_OPT") - output_unit = cp_logger_get_default_io_unit(logger) - - IF (output_unit>0) THEN - WRITE(output_unit,'(T2,A)') 'FORCE_MATCHING| good morning....' - ENDIF - - ! do IO of ref traj / frc / cell - NULLIFY(cell_traj_read,force_traj_read,pos_traj_read,energy_traj_read) - CALL read_reference_data(oi_env,para_env,force_traj_read,pos_traj_read,energy_traj_read,cell_traj_read) - n_atom=SIZE(pos_traj_read,2) - - ! adjust read data with respect to start/stop/stride - IF (oi_env%fm_env%frame_stop<0) oi_env%fm_env%frame_stop=SIZE(pos_traj_read,3) - - IF (oi_env%fm_env%frame_count>0) THEN - oi_env%fm_env%frame_stride=(oi_env%fm_env%frame_stop-oi_env%fm_env%frame_start+1+ & - oi_env%fm_env%frame_count-1)/(oi_env%fm_env%frame_count) - ENDIF - n_frames=(oi_env%fm_env%frame_stop-oi_env%fm_env%frame_start+oi_env%fm_env%frame_stride)/oi_env%fm_env%frame_stride - - ALLOCATE(force_traj(3,n_atom,n_frames),pos_traj(3,n_atom,n_frames),energy_traj(n_frames)) - IF (ASSOCIATED(cell_traj_read)) ALLOCATE(cell_traj(3,3,n_frames)) - - n_frames=0 - DO i_frame=oi_env%fm_env%frame_start,oi_env%fm_env%frame_stop,oi_env%fm_env%frame_stride - n_frames=n_frames+1 - force_traj(:,:,n_frames)=force_traj_read(:,:,i_frame) - pos_traj(:,:,n_frames)=pos_traj_read(:,:,i_frame) - energy_traj(n_frames)=energy_traj_read(i_frame) - IF (ASSOCIATED(cell_traj)) cell_traj(:,:,n_frames)=cell_traj_read(:,:,i_frame) - ENDDO - DEALLOCATE(force_traj_read,pos_traj_read,energy_traj_read) - IF (ASSOCIATED(cell_traj_read)) DEALLOCATE(cell_traj_read) - - n_el=3*n_atom - ALLOCATE(pos(n_el), force(n_el)) - ALLOCATE(energy_var(n_frames),force_var(3,n_atom,n_frames)) - - - ! split the para_env in a set of sub_para_envs that will do the force_env communications - mpi_comm_master=para_env%group - num_pe_master =para_env%num_pe - mepos_master =para_env%mepos - ALLOCATE(group_distribution(0:num_pe_master-1)) - IF (oi_env%fm_env%group_size>para_env%num_pe) oi_env%fm_env%group_size=para_env%num_pe - - CALL mp_comm_split(mpi_comm_master,mpi_comm_slave,n_groups,group_distribution,subgroup_min_size=oi_env%fm_env%group_size) - CALL mp_environ(num_pe_slave,mepos_slave,mpi_comm_slave) - color=0 - IF (mepos_slave==0) color=1 - CALL mp_comm_split_direct(mpi_comm_master,mpi_comm_slave_primus,color) - - ! assign initial variables - n_var=SIZE(oi_env%variables,1) - ALLOCATE(initial_variables(2,n_var)) - n_free_var=0 - DO i_var=1,n_var - initial_variables(1,i_var)=oi_env%variables(i_var)%label - WRITE(initial_variables(2,i_var),*) oi_env%variables(i_var)%value - IF (.NOT.oi_env%variables(i_var)%fixed) n_free_var=n_free_var+1 - ENDDO - ALLOCATE(free_vars(n_free_var),free_var_index(n_free_var)) - i_free_var=0 - DO i_var=1,n_var - IF (.NOT.oi_env%variables(i_var)%fixed) THEN - i_free_var=i_free_var+1 - free_var_index(i_free_var)=i_var - free_vars(i_free_var)=oi_env%variables(free_var_index(i_free_var))%value - ENDIF - ENDDO - - ! create input and output file names. - input_path=oi_env%fm_env%optimize_file_name - WRITE(output_path,'(A,I0,A)') TRIM(oi_env%project_name)//"-worker-",group_distribution(mepos_master),".out" - - ! initialize the powell optimizer - energy_weight=oi_env%fm_env%energy_weight - shift_mm=oi_env%fm_env%shift_mm - shift_qm=oi_env%fm_env%shift_qm - - IF (para_env%mepos==para_env%source) THEN - ostate%nf = 0 - ostate%nvar = n_free_var - ostate%rhoend = oi_env%rhoend - ostate%rhobeg = oi_env%rhobeg - ostate%maxfun = oi_env%maxfun - ostate%iprint = 1 - ostate%unit = output_unit - ostate%state = 0 - ENDIF - - IF (output_unit>0) THEN - WRITE(output_unit,'(T2,A,T60,I20)') 'FORCE_MATCHING| number of atoms per frame ',n_atom - WRITE(output_unit,'(T2,A,T60,I20)') 'FORCE_MATCHING| number of frames ',n_frames - WRITE(output_unit,'(T2,A,T60,I20)') 'FORCE_MATCHING| number of parallel groups ',n_groups - WRITE(output_unit,'(T2,A,T60,I20)') 'FORCE_MATCHING| number of variables ',n_var - WRITE(output_unit,'(T2,A,T60,I20)') 'FORCE_MATCHING| number of free variables ',n_free_var - WRITE(output_unit,'(T2,A,A)') 'FORCE_MATCHING| optimize file name ',TRIM(input_path) - WRITE(output_unit,'(T2,A,T60,F20.12)') 'FORCE_MATCHING| accuracy',ostate%rhoend - WRITE(output_unit,'(T2,A,T60,F20.12)') 'FORCE_MATCHING| step size',ostate%rhobeg - WRITE(output_unit,'(T2,A,T60,I20)') 'FORCE_MATCHING| max function evaluation',ostate%maxfun - WRITE(output_unit,'(T2,A,T60,L20)') 'FORCE_MATCHING| shift average',oi_env%fm_env%shift_average - WRITE(output_unit,'(T2,A)') 'FORCE_MATCHING| initial values:' - DO i_var=1,n_var - WRITE(output_unit,'(T2,A,1X,E28.16)') TRIM(oi_env%variables(i_var)%label),oi_env%variables(i_var)%value - ENDDO - WRITE(output_unit,'(T2,A)') 'FORCE_MATCHING| switching to POWELL optimization of the free parameters' - WRITE(output_unit,'()') - WRITE(output_unit,'(T2,A20,A20,A11,A11)') 'iteration number','function value','time','time Force' - CALL m_flush(output_unit) - ENDIF - - - t1 = m_walltime() - - DO - - - ! globalize the state - IF (para_env%mepos==para_env%source) state=ostate%state - CALL mp_bcast(state,para_env%source,para_env%group) - - ! if required get the energy of this set of params - IF (state == 2) THEN - - CALL cp_iterate(logger%iter_info,last=.FALSE.) - - ! create a new force env, updating the free vars as needed - DO i_free_var=1,n_free_var - WRITE(initial_variables(2,free_var_index(i_free_var)),*) free_vars(i_free_var) - oi_env%variables(free_var_index(i_free_var))%value=free_vars(i_free_var) + CALL timeset(routineN, handle) + + logger => cp_get_default_logger() + CALL cp_add_iter_level(logger%iter_info, "POWELL_OPT") + output_unit = cp_logger_get_default_io_unit(logger) + + IF (output_unit > 0) THEN + WRITE (output_unit, '(T2,A)') 'FORCE_MATCHING| good morning....' + ENDIF + + ! do IO of ref traj / frc / cell + NULLIFY (cell_traj_read, force_traj_read, pos_traj_read, energy_traj_read) + CALL read_reference_data(oi_env, para_env, force_traj_read, pos_traj_read, energy_traj_read, cell_traj_read) + n_atom = SIZE(pos_traj_read, 2) + + ! adjust read data with respect to start/stop/stride + IF (oi_env%fm_env%frame_stop < 0) oi_env%fm_env%frame_stop = SIZE(pos_traj_read, 3) + + IF (oi_env%fm_env%frame_count > 0) THEN + oi_env%fm_env%frame_stride = (oi_env%fm_env%frame_stop - oi_env%fm_env%frame_start + 1 + & + oi_env%fm_env%frame_count - 1)/(oi_env%fm_env%frame_count) + ENDIF + n_frames = (oi_env%fm_env%frame_stop - oi_env%fm_env%frame_start + oi_env%fm_env%frame_stride)/oi_env%fm_env%frame_stride + + ALLOCATE (force_traj(3, n_atom, n_frames), pos_traj(3, n_atom, n_frames), energy_traj(n_frames)) + IF (ASSOCIATED(cell_traj_read)) ALLOCATE (cell_traj(3, 3, n_frames)) + + n_frames = 0 + DO i_frame = oi_env%fm_env%frame_start, oi_env%fm_env%frame_stop, oi_env%fm_env%frame_stride + n_frames = n_frames + 1 + force_traj(:, :, n_frames) = force_traj_read(:, :, i_frame) + pos_traj(:, :, n_frames) = pos_traj_read(:, :, i_frame) + energy_traj(n_frames) = energy_traj_read(i_frame) + IF (ASSOCIATED(cell_traj)) cell_traj(:, :, n_frames) = cell_traj_read(:, :, i_frame) + ENDDO + DEALLOCATE (force_traj_read, pos_traj_read, energy_traj_read) + IF (ASSOCIATED(cell_traj_read)) DEALLOCATE (cell_traj_read) + + n_el = 3*n_atom + ALLOCATE (pos(n_el), force(n_el)) + ALLOCATE (energy_var(n_frames), force_var(3, n_atom, n_frames)) + + ! split the para_env in a set of sub_para_envs that will do the force_env communications + mpi_comm_master = para_env%group + num_pe_master = para_env%num_pe + mepos_master = para_env%mepos + ALLOCATE (group_distribution(0:num_pe_master - 1)) + IF (oi_env%fm_env%group_size > para_env%num_pe) oi_env%fm_env%group_size = para_env%num_pe + + CALL mp_comm_split(mpi_comm_master, mpi_comm_slave, n_groups, group_distribution, subgroup_min_size=oi_env%fm_env%group_size) + CALL mp_environ(num_pe_slave, mepos_slave, mpi_comm_slave) + color = 0 + IF (mepos_slave == 0) color = 1 + CALL mp_comm_split_direct(mpi_comm_master, mpi_comm_slave_primus, color) + + ! assign initial variables + n_var = SIZE(oi_env%variables, 1) + ALLOCATE (initial_variables(2, n_var)) + n_free_var = 0 + DO i_var = 1, n_var + initial_variables(1, i_var) = oi_env%variables(i_var)%label + WRITE (initial_variables(2, i_var), *) oi_env%variables(i_var)%value + IF (.NOT. oi_env%variables(i_var)%fixed) n_free_var = n_free_var + 1 + ENDDO + ALLOCATE (free_vars(n_free_var), free_var_index(n_free_var)) + i_free_var = 0 + DO i_var = 1, n_var + IF (.NOT. oi_env%variables(i_var)%fixed) THEN + i_free_var = i_free_var + 1 + free_var_index(i_free_var) = i_var + free_vars(i_free_var) = oi_env%variables(free_var_index(i_free_var))%value + ENDIF + ENDDO + + ! create input and output file names. + input_path = oi_env%fm_env%optimize_file_name + WRITE (output_path, '(A,I0,A)') TRIM(oi_env%project_name)//"-worker-", group_distribution(mepos_master), ".out" + + ! initialize the powell optimizer + energy_weight = oi_env%fm_env%energy_weight + shift_mm = oi_env%fm_env%shift_mm + shift_qm = oi_env%fm_env%shift_qm + + IF (para_env%mepos == para_env%source) THEN + ostate%nf = 0 + ostate%nvar = n_free_var + ostate%rhoend = oi_env%rhoend + ostate%rhobeg = oi_env%rhobeg + ostate%maxfun = oi_env%maxfun + ostate%iprint = 1 + ostate%unit = output_unit + ostate%state = 0 + ENDIF + + IF (output_unit > 0) THEN + WRITE (output_unit, '(T2,A,T60,I20)') 'FORCE_MATCHING| number of atoms per frame ', n_atom + WRITE (output_unit, '(T2,A,T60,I20)') 'FORCE_MATCHING| number of frames ', n_frames + WRITE (output_unit, '(T2,A,T60,I20)') 'FORCE_MATCHING| number of parallel groups ', n_groups + WRITE (output_unit, '(T2,A,T60,I20)') 'FORCE_MATCHING| number of variables ', n_var + WRITE (output_unit, '(T2,A,T60,I20)') 'FORCE_MATCHING| number of free variables ', n_free_var + WRITE (output_unit, '(T2,A,A)') 'FORCE_MATCHING| optimize file name ', TRIM(input_path) + WRITE (output_unit, '(T2,A,T60,F20.12)') 'FORCE_MATCHING| accuracy', ostate%rhoend + WRITE (output_unit, '(T2,A,T60,F20.12)') 'FORCE_MATCHING| step size', ostate%rhobeg + WRITE (output_unit, '(T2,A,T60,I20)') 'FORCE_MATCHING| max function evaluation', ostate%maxfun + WRITE (output_unit, '(T2,A,T60,L20)') 'FORCE_MATCHING| shift average', oi_env%fm_env%shift_average + WRITE (output_unit, '(T2,A)') 'FORCE_MATCHING| initial values:' + DO i_var = 1, n_var + WRITE (output_unit, '(T2,A,1X,E28.16)') TRIM(oi_env%variables(i_var)%label), oi_env%variables(i_var)%value ENDDO + WRITE (output_unit, '(T2,A)') 'FORCE_MATCHING| switching to POWELL optimization of the free parameters' + WRITE (output_unit, '()') + WRITE (output_unit, '(T2,A20,A20,A11,A11)') 'iteration number', 'function value', 'time', 'time Force' + CALL m_flush(output_unit) + ENDIF - ierr=0 - CALL create_force_env(new_env_id=new_env_id, input_declaration=input_declaration,& - input_path=input_path, output_path=output_path, & - mpi_comm=mpi_comm_slave,initial_variables=initial_variables,ierr=ierr) + t1 = m_walltime() - ! set to zero initialy, for easier mp_summing - energy_var=0.0_dp - force_var=0.0_dp + DO - ! compute energies and forces for all frames, doing the work on a slave sub group based on round robin - t5 = 0.0_dp - DO i_frame=group_distribution(mepos_master)+1,n_frames,n_groups + ! globalize the state + IF (para_env%mepos == para_env%source) state = ostate%state + CALL mp_bcast(state, para_env%source, para_env%group) - ! set new cell if needed - IF (ASSOCIATED(cell_traj)) THEN - CALL set_cell(env_id=new_env_id, new_cell=cell_traj(:,:,i_frame), ierr=ierr) - ENDIF + ! if required get the energy of this set of params + IF (state == 2) THEN - ! copy pos from ref - i_el=0 - DO i_atom=1,n_atom - pos(i_el+1)=pos_traj(1,i_atom,i_frame) - pos(i_el+2)=pos_traj(2,i_atom,i_frame) - pos(i_el+3)=pos_traj(3,i_atom,i_frame) - i_el=i_el+3 + CALL cp_iterate(logger%iter_info, last=.FALSE.) + + ! create a new force env, updating the free vars as needed + DO i_free_var = 1, n_free_var + WRITE (initial_variables(2, free_var_index(i_free_var)), *) free_vars(i_free_var) + oi_env%variables(free_var_index(i_free_var))%value = free_vars(i_free_var) ENDDO - ! evaluate energy/force with new pos - t3 = m_walltime() - CALL calc_force(env_id=new_env_id,pos=pos,n_el_pos=n_el,e_pot=e_pot,force=force,n_el_force=n_el,ierr=ierr) - t4 = m_walltime() - t5 = t5 + t4-t3 - - ! copy force and energy in place - energy_var(i_frame)=e_pot - i_el=0 - DO i_atom=1,n_atom - force_var(1,i_atom,i_frame)=force(i_el+1) - force_var(2,i_atom,i_frame)=force(i_el+2) - force_var(3,i_atom,i_frame)=force(i_el+3) - i_el=i_el+3 + ierr = 0 + CALL create_force_env(new_env_id=new_env_id, input_declaration=input_declaration, & + input_path=input_path, output_path=output_path, & + mpi_comm=mpi_comm_slave, initial_variables=initial_variables, ierr=ierr) + + ! set to zero initialy, for easier mp_summing + energy_var = 0.0_dp + force_var = 0.0_dp + + ! compute energies and forces for all frames, doing the work on a slave sub group based on round robin + t5 = 0.0_dp + DO i_frame = group_distribution(mepos_master) + 1, n_frames, n_groups + + ! set new cell if needed + IF (ASSOCIATED(cell_traj)) THEN + CALL set_cell(env_id=new_env_id, new_cell=cell_traj(:, :, i_frame), ierr=ierr) + ENDIF + + ! copy pos from ref + i_el = 0 + DO i_atom = 1, n_atom + pos(i_el + 1) = pos_traj(1, i_atom, i_frame) + pos(i_el + 2) = pos_traj(2, i_atom, i_frame) + pos(i_el + 3) = pos_traj(3, i_atom, i_frame) + i_el = i_el + 3 + ENDDO + + ! evaluate energy/force with new pos + t3 = m_walltime() + CALL calc_force(env_id=new_env_id, pos=pos, n_el_pos=n_el, e_pot=e_pot, force=force, n_el_force=n_el, ierr=ierr) + t4 = m_walltime() + t5 = t5 + t4 - t3 + + ! copy force and energy in place + energy_var(i_frame) = e_pot + i_el = 0 + DO i_atom = 1, n_atom + force_var(1, i_atom, i_frame) = force(i_el + 1) + force_var(2, i_atom, i_frame) = force(i_el + 2) + force_var(3, i_atom, i_frame) = force(i_el + 3) + i_el = i_el + 3 + ENDDO + ENDDO - ENDDO + ! clean up force env, get ready for the next round + CALL destroy_force_env(env_id=new_env_id, ierr=ierr) - ! clean up force env, get ready for the next round - CALL destroy_force_env(env_id=new_env_id,ierr=ierr) + ! get data everywhere on the master group, we could reduce the amount of data by reducing to partial RMSD first + ! furthermore, we should only do this operation among the masters of the slave group + IF (mepos_slave == 0) THEN + CALL mp_sum(energy_var, mpi_comm_slave_primus) + CALL mp_sum(force_var, mpi_comm_slave_primus) + ENDIF - ! get data everywhere on the master group, we could reduce the amount of data by reducing to partial RMSD first - ! furthermore, we should only do this operation among the masters of the slave group - IF (mepos_slave==0) THEN - CALL mp_sum(energy_var,mpi_comm_slave_primus) - CALL mp_sum(force_var,mpi_comm_slave_primus) - ENDIF + ! now evaluate the target function to be minimized (only valid on mepos_slave==0) + IF (para_env%mepos == para_env%source) THEN + rf = SQRT(SUM((force_var - force_traj)**2)/(REAL(n_frames, KIND=dp)*REAL(n_atom, KIND=dp))) + IF (oi_env%fm_env%shift_average) THEN + shift_mm = SUM(energy_var)/n_frames + shift_qm = SUM(energy_traj)/n_frames + ENDIF + re = SQRT(SUM(((energy_var - shift_mm) - (energy_traj - shift_qm))**2)/n_frames) + ostate%f = energy_weight*re + rf + t2 = m_walltime() + WRITE (output_unit, '(T2,I20,F20.12,F11.3,F11.3)') oi_env%iter_start_val + ostate%nf, ostate%f, t2 - t1, t5 + CALL m_flush(output_unit) + t1 = m_walltime() + ENDIF + + ! the history file with the trajectory of the parameters + history_unit = cp_print_key_unit_nr(logger, root_section, "OPTIMIZE_INPUT%HISTORY", & + extension=".dat") + IF (history_unit > 0) THEN + WRITE (UNIT=history_unit, FMT="(I20,F20.12,1000F20.12)") oi_env%iter_start_val + ostate%nf, ostate%f, free_vars + END IF + CALL cp_print_key_finished_output(history_unit, logger, root_section, "OPTIMIZE_INPUT%HISTORY") + + ! the energy profile for all frames + energies_unit = cp_print_key_unit_nr(logger, root_section, "OPTIMIZE_INPUT%FORCE_MATCHING%COMPARE_ENERGIES", & + file_position="REWIND", extension=".dat") + IF (energies_unit > 0) THEN + WRITE (UNIT=energies_unit, FMT="(A20,A20,A20,A20)") "#frame", "ref", "fit", "diff" + DO i_frame = 1, n_frames + e1 = energy_traj(i_frame) - shift_qm + e2 = energy_var(i_frame) - shift_mm + WRITE (UNIT=energies_unit, FMT="(I20,F20.12,F20.12,F20.12)") i_frame, e1, e2, e1 - e2 + ENDDO + END IF + CALL cp_print_key_finished_output(energies_unit, logger, root_section, "OPTIMIZE_INPUT%FORCE_MATCHING%COMPARE_ENERGIES") + + ! the force profile for all frames + energies_unit = cp_print_key_unit_nr(logger, root_section, "OPTIMIZE_INPUT%FORCE_MATCHING%COMPARE_FORCES", & + file_position="REWIND", extension=".dat") + IF (energies_unit > 0) THEN + WRITE (UNIT=energies_unit, FMT="(A20,A20,A20,A20)") "#frame", "normalized diff", "diff", "ref", "ref sum" + DO i_frame = 1, n_frames + e1 = SQRT(SUM((force_var(:, :, i_frame) - force_traj(:, :, i_frame))**2)) + e2 = SQRT(SUM((force_traj(:, :, i_frame))**2)) + e3 = SQRT(SUM(SUM(force_traj(:, :, i_frame), DIM=2)**2)) + e4 = SQRT(SUM(SUM(force_var(:, :, i_frame), DIM=2)**2)) + WRITE (UNIT=energies_unit, FMT="(I20,F20.12,F20.12,F20.12,2F20.12)") i_frame, e1/e2, e1, e2, e3, e4 + ENDDO + END IF + CALL cp_print_key_finished_output(energies_unit, logger, root_section, "OPTIMIZE_INPUT%FORCE_MATCHING%COMPARE_FORCES") + + ! a restart file with the current values of the parameters + restart_unit = cp_print_key_unit_nr(logger, root_section, "OPTIMIZE_INPUT%RESTART", extension=".restart", & + file_position="REWIND", do_backup=.TRUE.) + IF (restart_unit > 0) THEN + oi_section => section_vals_get_subs_vals(root_section, "OPTIMIZE_INPUT") + CALL section_vals_val_set(oi_section, "ITER_START_VAL", i_val=oi_env%iter_start_val + ostate%nf) + variable_section => section_vals_get_subs_vals(oi_section, "VARIABLE") + DO i_free_var = 1, n_free_var + CALL section_vals_val_set(variable_section, "VALUE", i_rep_section=free_var_index(i_free_var), & + r_val=free_vars(i_free_var)) + ENDDO + CALL write_restart_header(restart_unit) + CALL section_vals_write(root_section, unit_nr=restart_unit, hide_root=.TRUE.) + ENDIF + CALL cp_print_key_finished_output(restart_unit, logger, root_section, "OPTIMIZE_INPUT%RESTART") - ! now evaluate the target function to be minimized (only valid on mepos_slave==0) - IF (para_env%mepos==para_env%source) THEN - rf = SQRT(SUM((force_var-force_traj)**2)/(REAL(n_frames,KIND=dp) * REAL(n_atom,KIND=dp))) - IF (oi_env%fm_env%shift_average) THEN - shift_mm=SUM(energy_var)/n_frames - shift_qm=SUM(energy_traj)/n_frames - ENDIF - re = SQRT(SUM(((energy_var-shift_mm)-(energy_traj-shift_qm))**2)/n_frames) - ostate%f= energy_weight * re + rf - t2 = m_walltime() - WRITE(output_unit,'(T2,I20,F20.12,F11.3,F11.3)') oi_env%iter_start_val + ostate%nf, ostate%f, t2-t1, t5 - CALL m_flush(output_unit) - t1 = m_walltime() ENDIF - ! the history file with the trajectory of the parameters - history_unit=cp_print_key_unit_nr(logger,root_section,"OPTIMIZE_INPUT%HISTORY", & - extension=".dat") - IF (history_unit>0) THEN - WRITE (UNIT=history_unit,FMT="(I20,F20.12,1000F20.12)") oi_env%iter_start_val + ostate%nf, ostate%f, free_vars - END IF - CALL cp_print_key_finished_output(history_unit,logger,root_section,"OPTIMIZE_INPUT%HISTORY") - - ! the energy profile for all frames - energies_unit=cp_print_key_unit_nr(logger,root_section,"OPTIMIZE_INPUT%FORCE_MATCHING%COMPARE_ENERGIES", & - file_position="REWIND",extension=".dat") - IF (energies_unit>0) THEN - WRITE (UNIT=energies_unit,FMT="(A20,A20,A20,A20)") "#frame","ref","fit","diff" - DO i_frame=1,n_frames - e1=energy_traj(i_frame)-shift_qm - e2=energy_var(i_frame)-shift_mm - WRITE (UNIT=energies_unit,FMT="(I20,F20.12,F20.12,F20.12)") i_frame,e1,e2,e1-e2 - ENDDO - END IF - CALL cp_print_key_finished_output(energies_unit,logger,root_section,"OPTIMIZE_INPUT%FORCE_MATCHING%COMPARE_ENERGIES") - - ! the force profile for all frames - energies_unit=cp_print_key_unit_nr(logger,root_section,"OPTIMIZE_INPUT%FORCE_MATCHING%COMPARE_FORCES", & - file_position="REWIND",extension=".dat") - IF (energies_unit>0) THEN - WRITE (UNIT=energies_unit,FMT="(A20,A20,A20,A20)") "#frame","normalized diff","diff","ref","ref sum" - DO i_frame=1,n_frames - e1=SQRT(SUM((force_var(:,:,i_frame)-force_traj(:,:,i_frame))**2)) - e2=SQRT(SUM((force_traj(:,:,i_frame))**2)) - e3=SQRT(SUM(SUM(force_traj(:,:,i_frame),DIM=2)**2)) - e4=SQRT(SUM(SUM(force_var(:,:,i_frame),DIM=2)**2)) - WRITE (UNIT=energies_unit,FMT="(I20,F20.12,F20.12,F20.12,2F20.12)") i_frame,e1/e2,e1,e2,e3,e4 - ENDDO - END IF - CALL cp_print_key_finished_output(energies_unit,logger,root_section,"OPTIMIZE_INPUT%FORCE_MATCHING%COMPARE_FORCES") - - - ! a restart file with the current values of the parameters - restart_unit = cp_print_key_unit_nr(logger,root_section,"OPTIMIZE_INPUT%RESTART", extension=".restart",& - file_position="REWIND", do_backup=.TRUE.) - IF (restart_unit>0) THEN - oi_section => section_vals_get_subs_vals(root_section,"OPTIMIZE_INPUT") - CALL section_vals_val_set(oi_section,"ITER_START_VAL",i_val=oi_env%iter_start_val + ostate%nf) - variable_section => section_vals_get_subs_vals(oi_section,"VARIABLE") - DO i_free_var=1,n_free_var - CALL section_vals_val_set(variable_section,"VALUE",i_rep_section=free_var_index(i_free_var), & - r_val=free_vars(i_free_var)) - ENDDO - CALL write_restart_header(restart_unit) - CALL section_vals_write(root_section,unit_nr=restart_unit,hide_root=.TRUE.) + IF (state == -1) EXIT + + CALL external_control(should_stop, "OPTIMIZE_INPUT", target_time=oi_env%target_time, start_time=oi_env%start_time) + + IF (should_stop) EXIT + + ! do a powell step if needed + IF (para_env%mepos == para_env%source) THEN + CALL powell_optimize(ostate%nvar, free_vars, ostate) ENDIF - CALL cp_print_key_finished_output(restart_unit,logger,root_section,"OPTIMIZE_INPUT%RESTART") + CALL mp_bcast(free_vars, para_env%source, para_env%group) + ENDDO + + ! finally, get the best set of variables + IF (para_env%mepos == para_env%source) THEN + ostate%state = 8 + CALL powell_optimize(ostate%nvar, free_vars, ostate) + ENDIF + CALL mp_bcast(free_vars, para_env%source, para_env%group) + DO i_free_var = 1, n_free_var + WRITE (initial_variables(2, free_var_index(i_free_var)), *) free_vars(i_free_var) + oi_env%variables(free_var_index(i_free_var))%value = free_vars(i_free_var) + ENDDO + IF (para_env%mepos == para_env%source) THEN + WRITE (output_unit, '(T2,A)') '' + WRITE (output_unit, '(T2,A,T60,F20.12)') 'FORCE_MATCHING| optimal function value found so far:', ostate%fopt + WRITE (output_unit, '(T2,A)') 'FORCE_MATCHING| optimal variables found so far:' + DO i_var = 1, n_var + WRITE (output_unit, '(T2,A,1X,E28.16)') TRIM(oi_env%variables(i_var)%label), oi_env%variables(i_var)%value + ENDDO ENDIF - IF ( state == -1 ) EXIT + CALL cp_rm_iter_level(logger%iter_info, "POWELL_OPT") - CALL external_control(should_stop,"OPTIMIZE_INPUT",target_time=oi_env%target_time,start_time=oi_env%start_time) + ! deallocate for cleanup + IF (ASSOCIATED(cell_traj)) DEALLOCATE (cell_traj) + DEALLOCATE (pos, force, force_traj, pos_traj, force_var) + DEALLOCATE (group_distribution, energy_traj, energy_var) + CALL mp_comm_free(mpi_comm_slave) + CALL mp_comm_free(mpi_comm_slave_primus) - IF (should_stop) EXIT + CALL timestop(handle) - ! do a powell step if needed - IF (para_env%mepos==para_env%source) THEN - CALL powell_optimize (ostate%nvar, free_vars , ostate) - ENDIF - CALL mp_bcast(free_vars,para_env%source,para_env%group) - - ENDDO - - ! finally, get the best set of variables - IF (para_env%mepos==para_env%source) THEN - ostate%state = 8 - CALL powell_optimize (ostate%nvar, free_vars , ostate) - ENDIF - CALL mp_bcast(free_vars,para_env%source,para_env%group) - DO i_free_var=1,n_free_var - WRITE(initial_variables(2,free_var_index(i_free_var)),*) free_vars(i_free_var) - oi_env%variables(free_var_index(i_free_var))%value=free_vars(i_free_var) - ENDDO - IF (para_env%mepos==para_env%source) THEN - WRITE(output_unit,'(T2,A)') '' - WRITE(output_unit,'(T2,A,T60,F20.12)') 'FORCE_MATCHING| optimal function value found so far:',ostate%fopt - WRITE(output_unit,'(T2,A)') 'FORCE_MATCHING| optimal variables found so far:' - DO i_var=1,n_var - WRITE(output_unit,'(T2,A,1X,E28.16)') TRIM(oi_env%variables(i_var)%label),oi_env%variables(i_var)%value - ENDDO - ENDIF - - CALL cp_rm_iter_level(logger%iter_info,"POWELL_OPT") - - ! deallocate for cleanup - IF (ASSOCIATED(cell_traj)) DEALLOCATE(cell_traj) - DEALLOCATE(pos,force,force_traj, pos_traj, force_var) - DEALLOCATE(group_distribution,energy_traj, energy_var) - CALL mp_comm_free(mpi_comm_slave) - CALL mp_comm_free(mpi_comm_slave_primus) - - CALL timestop(handle) - - END SUBROUTINE force_matching + END SUBROUTINE force_matching ! ************************************************************************************************** !> \brief reads the reference data for force matching results, the format of the files needs to be the CP2K xyz trajectory format !> \param oi_env ... !> \param para_env ... -!> \param force_traj forces -!> \param pos_traj position +!> \param force_traj forces +!> \param pos_traj position !> \param energy_traj energies, as extracted from the forces file -!> \param cell_traj cell parameters, as extracted from a CP2K cell file +!> \param cell_traj cell parameters, as extracted from a CP2K cell file !> \author Joost VandeVondele ! ************************************************************************************************** - SUBROUTINE read_reference_data(oi_env,para_env,force_traj,pos_traj,energy_traj,cell_traj) + SUBROUTINE read_reference_data(oi_env, para_env, force_traj, pos_traj, energy_traj, cell_traj) TYPE(oi_env_type) :: oi_env TYPE(cp_para_env_type), POINTER :: para_env REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: force_traj, pos_traj @@ -528,93 +524,92 @@ SUBROUTINE read_reference_data(oi_env,para_env,force_traj,pos_traj,energy_traj,c vol TYPE(cp_parser_type), POINTER :: local_parser - CALL timeset(routineN,handle) - - ! do IO of ref traj / frc / cell - - ! trajectory - n_frames=0 - n_frames_current=0 - NULLIFY(local_parser,pos_traj,energy_traj,force_traj) - filename=oi_env%fm_env%ref_traj_file_name - IF(filename.EQ."")& - CPABORT("The reference trajectory file name is empty") - CALL parser_create(local_parser,filename,para_env=para_env) - DO - CALL parser_read_line(local_parser,1,at_end=at_end) - IF (at_end) EXIT - READ(local_parser%input_line,FMT="(I8)") nread - n_frames=n_frames+1 - - IF (n_frames>n_frames_current) THEN - n_frames_current=5*(n_frames_current+10)/3 - CALL reallocate(pos_traj,1,3,1,nread,1,n_frames_current) - ENDIF - - ! title line - CALL parser_read_line(local_parser,1) - - ! actual coordinates - DO i = 1,nread - CALL parser_read_line(local_parser,1) - READ(local_parser%input_line(1:LEN_TRIM(local_parser%input_line)),*) AA,vec - pos_traj(:,i,n_frames)=vec*bohr - END DO - - ENDDO - CALL parser_release(local_parser) - - n_frames_current=n_frames - CALL reallocate(energy_traj,1,n_frames_current) - CALL reallocate(force_traj,1,3,1,nread,1,n_frames_current) - CALL reallocate(pos_traj,1,3,1,nread,1,n_frames_current) - - ! now force reference trajectory - filename=oi_env%fm_env%ref_force_file_name - IF(filename.EQ."")& - CPABORT("The reference force file name is empty") - CALL parser_create(local_parser,filename,para_env=para_env) - DO iframe=1,n_frames - CALL parser_read_line(local_parser,1) - READ(local_parser%input_line,FMT="(I8)") nread - - ! title line - test_ok = .FALSE. - CALL parser_read_line(local_parser,1) - READ(local_parser%input_line,FMT="(T6,I8,T23,F12.3,T41,F20.10)",ERR=999) trj_itimes, trj_time, trj_epot - test_ok = .TRUE. -999 CONTINUE - IF (.NOT. test_ok) THEN - CPABORT("Could not parse the title line of the trajectory file") - END IF - energy_traj(iframe)=trj_epot - - ! actual forces, in a.u. - DO i = 1,nread - CALL parser_read_line(local_parser,1) - READ(local_parser%input_line(1:LEN_TRIM(local_parser%input_line)),*) AA,vec - force_traj(:,i,iframe)=vec - END DO - ENDDO - CALL parser_release(local_parser) - - - ! and cell, which is optional - NULLIFY(cell_traj) - filename=oi_env%fm_env%ref_cell_file_name - IF (filename.NE."") THEN - CALL parser_create(local_parser,filename,para_env=para_env) - ALLOCATE(cell_traj(3,3,n_frames)) - DO iframe=1,n_frames - CALL parser_read_line(local_parser,1) - CALL parse_cell_line(local_parser%input_line, cell_itimes, cell_time, cell_traj(:,:,iframe), vol) - ENDDO - CALL parser_release(local_parser) - ENDIF - - CALL timestop(handle) - - END SUBROUTINE read_reference_data + CALL timeset(routineN, handle) + + ! do IO of ref traj / frc / cell + + ! trajectory + n_frames = 0 + n_frames_current = 0 + NULLIFY (local_parser, pos_traj, energy_traj, force_traj) + filename = oi_env%fm_env%ref_traj_file_name + IF (filename .EQ. "") & + CPABORT("The reference trajectory file name is empty") + CALL parser_create(local_parser, filename, para_env=para_env) + DO + CALL parser_read_line(local_parser, 1, at_end=at_end) + IF (at_end) EXIT + READ (local_parser%input_line, FMT="(I8)") nread + n_frames = n_frames + 1 + + IF (n_frames > n_frames_current) THEN + n_frames_current = 5*(n_frames_current + 10)/3 + CALL reallocate(pos_traj, 1, 3, 1, nread, 1, n_frames_current) + ENDIF + + ! title line + CALL parser_read_line(local_parser, 1) + + ! actual coordinates + DO i = 1, nread + CALL parser_read_line(local_parser, 1) + READ (local_parser%input_line(1:LEN_TRIM(local_parser%input_line)), *) AA, vec + pos_traj(:, i, n_frames) = vec*bohr + END DO + + ENDDO + CALL parser_release(local_parser) + + n_frames_current = n_frames + CALL reallocate(energy_traj, 1, n_frames_current) + CALL reallocate(force_traj, 1, 3, 1, nread, 1, n_frames_current) + CALL reallocate(pos_traj, 1, 3, 1, nread, 1, n_frames_current) + + ! now force reference trajectory + filename = oi_env%fm_env%ref_force_file_name + IF (filename .EQ. "") & + CPABORT("The reference force file name is empty") + CALL parser_create(local_parser, filename, para_env=para_env) + DO iframe = 1, n_frames + CALL parser_read_line(local_parser, 1) + READ (local_parser%input_line, FMT="(I8)") nread + + ! title line + test_ok = .FALSE. + CALL parser_read_line(local_parser, 1) + READ (local_parser%input_line, FMT="(T6,I8,T23,F12.3,T41,F20.10)", ERR=999) trj_itimes, trj_time, trj_epot + test_ok = .TRUE. +999 CONTINUE + IF (.NOT. test_ok) THEN + CPABORT("Could not parse the title line of the trajectory file") + END IF + energy_traj(iframe) = trj_epot + + ! actual forces, in a.u. + DO i = 1, nread + CALL parser_read_line(local_parser, 1) + READ (local_parser%input_line(1:LEN_TRIM(local_parser%input_line)), *) AA, vec + force_traj(:, i, iframe) = vec + END DO + ENDDO + CALL parser_release(local_parser) + + ! and cell, which is optional + NULLIFY (cell_traj) + filename = oi_env%fm_env%ref_cell_file_name + IF (filename .NE. "") THEN + CALL parser_create(local_parser, filename, para_env=para_env) + ALLOCATE (cell_traj(3, 3, n_frames)) + DO iframe = 1, n_frames + CALL parser_read_line(local_parser, 1) + CALL parse_cell_line(local_parser%input_line, cell_itimes, cell_time, cell_traj(:, :, iframe), vol) + ENDDO + CALL parser_release(local_parser) + ENDIF + + CALL timestop(handle) + + END SUBROUTINE read_reference_data ! ************************************************************************************************** !> \brief parses the input section, and stores in the optimize input environment @@ -622,7 +617,7 @@ END SUBROUTINE read_reference_data !> \param root_section ... !> \author Joost VandeVondele ! ************************************************************************************************** - SUBROUTINE parse_input(oi_env,root_section) + SUBROUTINE parse_input(oi_env, root_section) TYPE(oi_env_type) :: oi_env TYPE(section_vals_type), POINTER :: root_section @@ -632,60 +627,60 @@ SUBROUTINE parse_input(oi_env,root_section) LOGICAL :: explicit TYPE(section_vals_type), POINTER :: fm_section, oi_section, variable_section - CALL timeset(routineN,handle) + CALL timeset(routineN, handle) - CALL section_vals_val_get(root_section,"GLOBAL%PROJECT",c_val=oi_env%project_name) - CALL section_vals_val_get(root_section,"GLOBAL%SEED",i_val=oi_env%seed) - CALL cp2k_get_walltime(section=root_section, keyword_name="GLOBAL%WALLTIME", & + CALL section_vals_val_get(root_section, "GLOBAL%PROJECT", c_val=oi_env%project_name) + CALL section_vals_val_get(root_section, "GLOBAL%SEED", i_val=oi_env%seed) + CALL cp2k_get_walltime(section=root_section, keyword_name="GLOBAL%WALLTIME", & walltime=oi_env%target_time) - oi_section => section_vals_get_subs_vals(root_section,"OPTIMIZE_INPUT") - variable_section => section_vals_get_subs_vals(oi_section,"VARIABLE") - - CALL section_vals_val_get(oi_section,"ACCURACY", r_val=oi_env%rhoend) - CALL section_vals_val_get(oi_section,"STEP_SIZE", r_val=oi_env%rhobeg) - CALL section_vals_val_get(oi_section,"MAX_FUN", i_val=oi_env%maxfun) - CALL section_vals_val_get(oi_section,"ITER_START_VAL", i_val=oi_env%iter_start_val) - CALL section_vals_val_get(oi_section,"RANDOMIZE_VARIABLES", r_val=oi_env%randomize_variables) - - CALL section_vals_get(variable_section,explicit=explicit, n_repetition=n_var) - IF (explicit) THEN - ALLOCATE(oi_env%variables(1:n_var)) - DO ivar=1,n_var - CALL section_vals_val_get(variable_section,"VALUE",i_rep_section=ivar, & - r_val=oi_env%variables(ivar)%value) - CALL section_vals_val_get(variable_section,"FIXED",i_rep_section=ivar, & - l_val=oi_env%variables(ivar)%fixed) - CALL section_vals_val_get(variable_section,"LABEL",i_rep_section=ivar, & - c_val=oi_env%variables(ivar)%label) - ENDDO - ENDIF - - CALL section_vals_val_get(oi_section,"METHOD",i_val=oi_env%method) - SELECT CASE(oi_env%method) - CASE(opt_force_matching) - fm_section => section_vals_get_subs_vals(oi_section,"FORCE_MATCHING") - CALL section_vals_val_get(fm_section,"REF_TRAJ_FILE_NAME",c_val=oi_env%fm_env%ref_traj_file_name) - CALL section_vals_val_get(fm_section,"REF_FORCE_FILE_NAME",c_val=oi_env%fm_env%ref_force_file_name) - CALL section_vals_val_get(fm_section,"REF_CELL_FILE_NAME",c_val=oi_env%fm_env%ref_cell_file_name) - CALL section_vals_val_get(fm_section,"OPTIMIZE_FILE_NAME",c_val=oi_env%fm_env%optimize_file_name) - CALL section_vals_val_get(fm_section,"FRAME_START",i_val=oi_env%fm_env%frame_start) - CALL section_vals_val_get(fm_section,"FRAME_STOP",i_val=oi_env%fm_env%frame_stop) - CALL section_vals_val_get(fm_section,"FRAME_STRIDE",i_val=oi_env%fm_env%frame_stride) - CALL section_vals_val_get(fm_section,"FRAME_COUNT",i_val=oi_env%fm_env%frame_count) - - CALL section_vals_val_get(fm_section,"GROUP_SIZE",i_val=oi_env%fm_env%group_size) - - CALL section_vals_val_get(fm_section,"ENERGY_WEIGHT",r_val=oi_env%fm_env%energy_weight) - CALL section_vals_val_get(fm_section,"SHIFT_MM",r_val=oi_env%fm_env%shift_mm) - CALL section_vals_val_get(fm_section,"SHIFT_QM",r_val=oi_env%fm_env%shift_qm) - CALL section_vals_val_get(fm_section,"SHIFT_AVERAGE",l_val=oi_env%fm_env%shift_average) - CASE DEFAULT - CPABORT("") - END SELECT - - CALL timestop(handle) - - END SUBROUTINE parse_input + oi_section => section_vals_get_subs_vals(root_section, "OPTIMIZE_INPUT") + variable_section => section_vals_get_subs_vals(oi_section, "VARIABLE") + + CALL section_vals_val_get(oi_section, "ACCURACY", r_val=oi_env%rhoend) + CALL section_vals_val_get(oi_section, "STEP_SIZE", r_val=oi_env%rhobeg) + CALL section_vals_val_get(oi_section, "MAX_FUN", i_val=oi_env%maxfun) + CALL section_vals_val_get(oi_section, "ITER_START_VAL", i_val=oi_env%iter_start_val) + CALL section_vals_val_get(oi_section, "RANDOMIZE_VARIABLES", r_val=oi_env%randomize_variables) + + CALL section_vals_get(variable_section, explicit=explicit, n_repetition=n_var) + IF (explicit) THEN + ALLOCATE (oi_env%variables(1:n_var)) + DO ivar = 1, n_var + CALL section_vals_val_get(variable_section, "VALUE", i_rep_section=ivar, & + r_val=oi_env%variables(ivar)%value) + CALL section_vals_val_get(variable_section, "FIXED", i_rep_section=ivar, & + l_val=oi_env%variables(ivar)%fixed) + CALL section_vals_val_get(variable_section, "LABEL", i_rep_section=ivar, & + c_val=oi_env%variables(ivar)%label) + ENDDO + ENDIF + + CALL section_vals_val_get(oi_section, "METHOD", i_val=oi_env%method) + SELECT CASE (oi_env%method) + CASE (opt_force_matching) + fm_section => section_vals_get_subs_vals(oi_section, "FORCE_MATCHING") + CALL section_vals_val_get(fm_section, "REF_TRAJ_FILE_NAME", c_val=oi_env%fm_env%ref_traj_file_name) + CALL section_vals_val_get(fm_section, "REF_FORCE_FILE_NAME", c_val=oi_env%fm_env%ref_force_file_name) + CALL section_vals_val_get(fm_section, "REF_CELL_FILE_NAME", c_val=oi_env%fm_env%ref_cell_file_name) + CALL section_vals_val_get(fm_section, "OPTIMIZE_FILE_NAME", c_val=oi_env%fm_env%optimize_file_name) + CALL section_vals_val_get(fm_section, "FRAME_START", i_val=oi_env%fm_env%frame_start) + CALL section_vals_val_get(fm_section, "FRAME_STOP", i_val=oi_env%fm_env%frame_stop) + CALL section_vals_val_get(fm_section, "FRAME_STRIDE", i_val=oi_env%fm_env%frame_stride) + CALL section_vals_val_get(fm_section, "FRAME_COUNT", i_val=oi_env%fm_env%frame_count) + + CALL section_vals_val_get(fm_section, "GROUP_SIZE", i_val=oi_env%fm_env%group_size) + + CALL section_vals_val_get(fm_section, "ENERGY_WEIGHT", r_val=oi_env%fm_env%energy_weight) + CALL section_vals_val_get(fm_section, "SHIFT_MM", r_val=oi_env%fm_env%shift_mm) + CALL section_vals_val_get(fm_section, "SHIFT_QM", r_val=oi_env%fm_env%shift_qm) + CALL section_vals_val_get(fm_section, "SHIFT_AVERAGE", l_val=oi_env%fm_env%shift_average) + CASE DEFAULT + CPABORT("") + END SELECT + + CALL timestop(handle) + + END SUBROUTINE parse_input END MODULE optimize_input diff --git a/src/pair_potential.F b/src/pair_potential.F index b72ebe7933..7b8fffbdce 100644 --- a/src/pair_potential.F +++ b/src/pair_potential.F @@ -88,7 +88,7 @@ SUBROUTINE init_genpot(potparm, ntype) DO i = 1, ntype ! i: first atom type DO j = 1, i ! j: second atom type pot => potparm%pot(i, j)%pot - ngp = ngp+COUNT(pot%type == gp_type) + ngp = ngp + COUNT(pot%type == gp_type) END DO END DO CALL initf(ngp) @@ -98,7 +98,7 @@ SUBROUTINE init_genpot(potparm, ntype) pot => potparm%pot(i, j)%pot DO k = 1, SIZE(pot%type) IF (pot%type(k) == gp_type) THEN - ngp = ngp+1 + ngp = ngp + 1 pot%set(k)%gp%myid = ngp CALL parsef(ngp, TRIM(pot%set(k)%gp%potential), pot%set(k)%gp%parameters) END IF @@ -157,7 +157,7 @@ SUBROUTINE spline_nonbond_control(spline_env, potparm, atomic_kind_set, & CALL timeset(routineN, handle) IF (iw3 > 0) THEN WRITE (iw3, "(/,T2,A,I0,A,I0,A)") & - "SPLINE_INFO| Generating ", (ntype*(ntype+1))/2, " splines for "// & + "SPLINE_INFO| Generating ", (ntype*(ntype + 1))/2, " splines for "// & TRIM(ADJUSTL(nonbonded_type))//" interactions " WRITE (iw3, "(T2,A,I0,A)") & " Due to ", ntype, " different atomic kinds" @@ -169,9 +169,9 @@ SUBROUTINE spline_nonbond_control(spline_env, potparm, atomic_kind_set, & DO j = 1, i pot => potparm%pot(i, j)%pot IF (iw3 > 0 .AND. iw <= 0) THEN - IF (MOD(i*(i-1)/2+j, MAX(1, (ntype*(ntype+1))/(2*10))) == 0) THEN - WRITE (UNIT=iw3, ADVANCE="NO", FMT='(2X,A3,I0)') '...', i*(i-1)/2+j - ip = ip+1 + IF (MOD(i*(i - 1)/2 + j, MAX(1, (ntype*(ntype + 1))/(2*10))) == 0) THEN + WRITE (UNIT=iw3, ADVANCE="NO", FMT='(2X,A3,I0)') '...', i*(i - 1)/2 + j + ip = ip + 1 IF (ip >= 11) THEN WRITE (iw3, *) ip = 0 @@ -182,7 +182,7 @@ SUBROUTINE spline_nonbond_control(spline_env, potparm, atomic_kind_set, & pot%no_pp = .TRUE. pot%no_mb = .TRUE. DO k = 1, SIZE(pot%type) - SELECT CASE (pot%type (k)) + SELECT CASE (pot%type(k)) CASE (lj_type, lj_charmm_type, wl_type, gw_type, ft_type, ftd_type, ip_type, & b4_type, bm_type, gp_type, ea_type, quip_type) pot%no_pp = .FALSE. @@ -197,7 +197,7 @@ SUBROUTINE spline_nonbond_control(spline_env, potparm, atomic_kind_set, & CPABORT("") END SELECT ! Special case for EAM - SELECT CASE (pot%type (k)) + SELECT CASE (pot%type(k)) CASE (ea_type, quip_type) pot%no_mb = .FALSE. END SELECT @@ -205,7 +205,7 @@ SUBROUTINE spline_nonbond_control(spline_env, potparm, atomic_kind_set, & ! Starting SetUp of splines IF (.NOT. pot%undef) CYCLE - ncount = ncount+1 + ncount = ncount + 1 n = spline_env%spltab(i, j) locut = rlow_nb hicut0 = SQRT(pot%rcutsq) @@ -240,7 +240,7 @@ SUBROUTINE spline_nonbond_control(spline_env, potparm, atomic_kind_set, & END IF ! Correct Cutoff... IF (shift_cutoff) THEN - pot%spl_f%cutoff = pot%spl_f%cutoff*pot%spl_f%fscale(1)- & + pot%spl_f%cutoff = pot%spl_f%cutoff*pot%spl_f%fscale(1) - & ener_pot(pot, hicut0, 0.0_dp) END IF END DO @@ -292,7 +292,7 @@ SUBROUTINE get_spline_cutoff(hicut, locut, found_locut, pot, do_zbl, & INTEGER :: ilevel, jx REAL(KIND=dp) :: dx2, e, locut_found, x - dx2 = (hicut-locut) + dx2 = (hicut - locut) x = hicut locut_found = locut found_locut = .FALSE. @@ -301,16 +301,16 @@ SUBROUTINE get_spline_cutoff(hicut, locut, found_locut, pot, do_zbl, & DO jx = 1, 100 e = ener_pot(pot, x, energy_cutoff) IF (do_zbl) THEN - e = e+ener_zbl(pot, x) + e = e + ener_zbl(pot, x) END IF IF (ABS(e) > emax_spline) THEN locut_found = x found_locut = .TRUE. EXIT END IF - x = x-dx2 + x = x - dx2 END DO - x = x+dx2 + x = x + dx2 ENDDO locut = locut_found @@ -383,24 +383,24 @@ SUBROUTINE generate_spline_low(spl_p, npoints, locut, hicut, eps_spline, & ENDIF spline_data => spl_p(1)%spline_data DO WHILE (.TRUE.) - CALL init_splinexy(spline_data, npoints+1) - dx2 = (1.0_dp/locut**2-1.0_dp/hicut**2)/REAL(npoints, KIND=dp) + CALL init_splinexy(spline_data, npoints + 1) + dx2 = (1.0_dp/locut**2 - 1.0_dp/hicut**2)/REAL(npoints, KIND=dp) x2 = 1.0_dp/hicut**2 spline_data%x1 = x2 - DO jx = 1, npoints+1 + DO jx = 1, npoints + 1 ! jx: loop over 1/distance**2 x = SQRT(1.0_dp/x2) e = ener_pot(pot, x, energy_cutoff) IF (do_zbl) THEN - e = e+ener_zbl(pot, x) + e = e + ener_zbl(pot, x) END IF spline_data%y(jx) = e - x2 = x2+dx2 + x2 = x2 + dx2 END DO CALL init_spline(spline_data, dx=dx2) ! This is the check for required accuracy on spline setup - dx2 = (hicut-locut)/REAL(mfac*npoints+1, KIND=dp) - x2 = locut+dx2 + dx2 = (hicut - locut)/REAL(mfac*npoints + 1, KIND=dp) + x2 = locut + dx2 diffmax = -1.0_dp xsav = hicut ! if a fixed number of points is requested, no check on its error @@ -409,14 +409,14 @@ SUBROUTINE generate_spline_low(spl_p, npoints, locut, hicut, eps_spline, & x = x2 e = ener_pot(pot, x, energy_cutoff) IF (do_zbl) THEN - e = e+ener_zbl(pot, x) + e = e + ener_zbl(pot, x) END IF IF (ABS(e) < max_energy) THEN - xdum1 = ABS(e-potential_s(spl_p, x*x, xdum, spl_f, logger)) + xdum1 = ABS(e - potential_s(spl_p, x*x, xdum, spl_f, logger)) diffmax = MAX(diffmax, xdum1) xsav = MIN(x, xsav) END IF - x2 = x2+dx2 + x2 = x2 + dx2 IF (x2 > hicut) EXIT END DO IF (npoints > MAX_POINTS) THEN @@ -446,8 +446,8 @@ SUBROUTINE generate_spline_low(spl_p, npoints, locut, hicut, eps_spline, & " SPLINE_INFO| Achieved accuracy [Hartree]: ", diffmax, & " SPLINE_INFO| Spline range [bohr]: ", locut, hicut, & " SPLINE_INFO| Spline range used to achieve accuracy [bohr]:", xsav, hicut - dx2 = (hicut-locut)/REAL(npoints+1, KIND=dp) - x = locut+dx2 + dx2 = (hicut - locut)/REAL(npoints + 1, KIND=dp) + x = locut + dx2 WRITE (UNIT=iw, FMT='(A,ES17.9)') & " SPLINE_INFO| Spline value at RMIN [Hartree]: ", potential_s(spl_p, x*x, xdum, spl_f, logger), & " SPLINE_INFO| Spline value at RMAX [Hartree]: ", potential_s(spl_p, hicut*hicut, xdum, spl_f, logger), & @@ -491,12 +491,12 @@ SUBROUTINE generate_spline_low(spl_p, npoints, locut, hicut, eps_spline, & IF (x > hicut) x = hicut IF (x > locut) THEN e = ener_pot(pot, x, energy_cutoff) - IF (do_zbl) e = e+ener_zbl(pot, x) + IF (do_zbl) e = e + ener_zbl(pot, x) e_spline = potential_s(spl_p, x*x, xdum, spl_f, logger) WRITE (UNIT=unit_number, FMT="(5ES25.12)") & - x/bohr, e*evolt, e_spline*evolt, -bohr*x*xdum*evolt, ABS((e-e_spline)*evolt) + x/bohr, e*evolt, e_spline*evolt, -bohr*x*xdum*evolt, ABS((e - e_spline)*evolt) END IF - x = x+dx + x = x + dx END DO CALL close_file(unit_number=unit_number) !MK Write table.xvf for GROMACS 4.5.5 @@ -523,7 +523,7 @@ SUBROUTINE generate_spline_low(spl_p, npoints, locut, hicut, eps_spline, & e_spline = potential_s(spl_p, x*x, xdum, spl_f, logger) f = 1.0_dp/r df = -1.0_dp/r**2 - g = -1.0_dp/r**6+1.0_dp/rcut**6 + g = -1.0_dp/r**6 + 1.0_dp/rcut**6 dg = 6.0_dp/r**7 h = e_spline*kjmol dh = -10.0_dp*bohr*x*xdum*kjmol @@ -532,7 +532,7 @@ SUBROUTINE generate_spline_low(spl_p, npoints, locut, hicut, eps_spline, & g, -dg, & ! g(r), -g'(r) => not used, if C = 0 h, -dh ! h(r), -h'(r) => used, if A = 1 END IF - x = x+dx + x = x + dx END DO CALL close_file(unit_number=unit_number) END IF @@ -590,7 +590,7 @@ SUBROUTINE get_nonbond_storage(spline_env, potparm, atomic_kind_set, do_zbl, & IF (potparm%pot(i, j)%pot%type(1) == pot_target) THEN tmp_index(i, j) = 1 tmp_index(j, i) = 1 - ndim = ndim+1 + ndim = ndim + 1 END IF END DO END DO @@ -598,31 +598,31 @@ SUBROUTINE get_nonbond_storage(spline_env, potparm, atomic_kind_set, do_zbl, & nvar = 0 SELECT CASE (pot_target) CASE (lj_type, lj_charmm_type) - nvar = 3+nvar + nvar = 3 + nvar CASE (wl_type) - nvar = 3+nvar + nvar = 3 + nvar CASE (gw_type) - nvar = 5+nvar + nvar = 5 + nvar CASE (ea_type) - nvar = 4+nvar + nvar = 4 + nvar CASE (quip_type) - nvar = 1+nvar + nvar = 1 + nvar CASE (ft_type) - nvar = 4+nvar + nvar = 4 + nvar CASE (ftd_type) - nvar = 5+nvar + nvar = 5 + nvar CASE (ip_type) - nvar = 3+nvar + nvar = 3 + nvar CASE (b4_type) - nvar = 6+nvar + nvar = 6 + nvar CASE (bm_type) - nvar = 9+nvar + nvar = 9 + nvar CASE (gp_type) - nvar = 2+nvar + nvar = 2 + nvar CASE (tersoff_type) - nvar = 13+nvar + nvar = 13 + nvar CASE (siepmann_type) - nvar = 5+nvar + nvar = 5 + nvar CASE (nn_type) nvar = nvar CASE DEFAULT @@ -634,10 +634,10 @@ SUBROUTINE get_nonbond_storage(spline_env, potparm, atomic_kind_set, do_zbl, & nk = 0 DO i = 1, ntype DO j = 1, i - n = n+1 + n = n + 1 IF (SIZE(potparm%pot(i, j)%pot%type) /= 1) CYCLE IF (potparm%pot(i, j)%pot%type(1) == pot_target) THEN - nk = nk+1 + nk = nk + 1 my_index(nk) = n END IF END DO @@ -648,10 +648,10 @@ SUBROUTINE get_nonbond_storage(spline_env, potparm, atomic_kind_set, do_zbl, & nk = 0 DO i = 1, ntype DO j = 1, i - n = n+1 + n = n + 1 IF (SIZE(potparm%pot(i, j)%pot%type) /= 1) CYCLE IF (potparm%pot(i, j)%pot%type(1) == pot_target) THEN - nk = nk+1 + nk = nk + 1 my_index(nk) = n SELECT CASE (pot_target) CASE (lj_type, lj_charmm_type) @@ -763,32 +763,32 @@ SUBROUTINE get_nonbond_storage(spline_env, potparm, atomic_kind_set, do_zbl, & END DO ! Iterative sorting DO k = 2, nvar - wtmp(1:k-1) = pot_par(1, 1:k-1) + wtmp(1:k - 1) = pot_par(1, 1:k - 1) istart = 1 at_least_one = .FALSE. DO j = 1, ndim Rwork(j) = pot_par(j, k) - IF (ALL(pot_par(j, 1:k-1) == wtmp(1:k-1))) CYCLE - iend = j-1 - wtmp(1:k-1) = pot_par(j, 1:k-1) + IF (ALL(pot_par(j, 1:k - 1) == wtmp(1:k - 1))) CYCLE + iend = j - 1 + wtmp(1:k - 1) = pot_par(j, 1:k - 1) ! If the ordered array has no two same consecutive elements ! does not make any sense to proceed ordering the others ! related parameters.. - idim = iend-istart+1 + idim = iend - istart + 1 CALL sort(Rwork(istart:iend), idim, Iwork1(istart:iend)) - Iwork1(istart:iend) = Iwork1(istart:iend)-1+istart + Iwork1(istart:iend) = Iwork1(istart:iend) - 1 + istart IF (idim /= 1) at_least_one = .TRUE. istart = j END DO iend = ndim - idim = iend-istart+1 + idim = iend - istart + 1 CALL sort(Rwork(istart:iend), idim, Iwork1(istart:iend)) - Iwork1(istart:iend) = Iwork1(istart:iend)-1+istart + Iwork1(istart:iend) = Iwork1(istart:iend) - 1 + istart IF (idim /= 1) at_least_one = .TRUE. pot_par(:, k) = Rwork IF (.NOT. at_least_one) EXIT ! Sort other components - DO j = k+1, nvar + DO j = k + 1, nvar Rwork(:) = pot_par(:, j) DO i = 1, ndim pot_par(i, j) = Rwork(Iwork1(i)) @@ -845,8 +845,8 @@ SUBROUTINE get_nonbond_storage(spline_env, potparm, atomic_kind_set, do_zbl, & END SELECT IF (ALL(Cwork == pot_par(j, :)) .AND. check) CYCLE Cwork(:) = pot_par(j, :) - nunique = nunique+1 - iend = j-1 + nunique = nunique + 1 + iend = j - 1 CALL set_potparm_index(potparm, my_index(istart:iend), pot_target, & ntype, tmpij, atomic_kind_set, shift_cutoff, do_zbl) ! @@ -860,7 +860,7 @@ SUBROUTINE get_nonbond_storage(spline_env, potparm, atomic_kind_set, do_zbl, & locij = my_index(j) CALL get_indexes(locij, ntype, tmpij0) END DO - nunique = nunique+1 + nunique = nunique + 1 iend = ndim CALL set_potparm_index(potparm, my_index(istart:iend), pot_target, & ntype, tmpij, atomic_kind_set, shift_cutoff, do_zbl) @@ -873,7 +873,7 @@ SUBROUTINE get_nonbond_storage(spline_env, potparm, atomic_kind_set, do_zbl, & DEALLOCATE (Cwork) DEALLOCATE (pot_par) ELSE - nunique = nunique+1 + nunique = nunique + 1 CALL set_potparm_index(potparm, my_index, pot_target, ntype, tmpij, & atomic_kind_set, shift_cutoff, do_zbl) END IF @@ -883,9 +883,9 @@ SUBROUTINE get_nonbond_storage(spline_env, potparm, atomic_kind_set, do_zbl, & n = 0 DO i = 1, ntype DO j = 1, i - n = n+1 + n = n + 1 IF (SIZE(potparm%pot(i, j)%pot%type) == 1) CYCLE - nunique = nunique+1 + nunique = nunique + 1 tmp_index(i, j) = nunique tmp_index(j, i) = nunique ! @@ -1050,7 +1050,7 @@ SUBROUTINE set_potparm_index(potparm, my_index, pot_target, ntype, tmpij_out, & pot => potparm%pot(tmpij(1), tmpij(2))%pot IF (value == min_val) CYCLE ! Cutoff NonBonded - pot%spl_f%cutoff = pot_ref%spl_f%cutoff*pot%spl_f%fscale(1)-pot%spl_f%cutoff + pot%spl_f%cutoff = pot_ref%spl_f%cutoff*pot%spl_f%fscale(1) - pot%spl_f%cutoff END DO END IF CALL finalizef() @@ -1075,10 +1075,10 @@ SUBROUTINE get_indexes(Inind, ndim, ij) tmp = 0 ij = HUGE(0) DO i = 1, ndim - tmp = tmp+i + tmp = tmp + i IF (tmp >= Inind) THEN ij(1) = i - ij(2) = Inind-tmp+i + ij(2) = Inind - tmp + i EXIT END IF END DO diff --git a/src/pair_potential_coulomb.F b/src/pair_potential_coulomb.F index 7bd4f85d86..e24b6f3605 100644 --- a/src/pair_potential_coulomb.F +++ b/src/pair_potential_coulomb.F @@ -50,28 +50,28 @@ FUNCTION potential_coulomb(r2, fscalar, qfac, ewald_type, alpha, beta, & IF (ewald_type == do_ewald_none) THEN x2 = r*beta potential_coulomb = erf(x2)/r - fscalar = fscalar+qfac*(potential_coulomb- & - two_over_sqrt_pi*EXP(-x2*x2)*beta)/r2 + fscalar = fscalar + qfac*(potential_coulomb - & + two_over_sqrt_pi*EXP(-x2*x2)*beta)/r2 ELSE x1 = alpha*r x2 = r*beta - potential_coulomb = (erf(x2)-erf(x1))/r - fscalar = fscalar+qfac*(potential_coulomb+ & - two_over_sqrt_pi*(EXP(-x1*x1)*alpha-EXP(-x2*x2)*beta))/r2 + potential_coulomb = (erf(x2) - erf(x1))/r + fscalar = fscalar + qfac*(potential_coulomb + & + two_over_sqrt_pi*(EXP(-x1*x1)*alpha - EXP(-x2*x2)*beta))/r2 END IF ELSE IF (ewald_type == do_ewald_none) THEN potential_coulomb = 1.0_dp/r - fscalar = fscalar+qfac*potential_coulomb/r2 + fscalar = fscalar + qfac*potential_coulomb/r2 ELSE x1 = alpha*r potential_coulomb = erfc(x1)/r - fscalar = fscalar+qfac*(potential_coulomb+ & - two_over_sqrt_pi*EXP(-x1*x1)*alpha)/r2 + fscalar = fscalar + qfac*(potential_coulomb + & + two_over_sqrt_pi*EXP(-x1*x1)*alpha)/r2 END IF END IF - potential_coulomb = qfac*(potential_coulomb-interaction_cutoff) + potential_coulomb = qfac*(potential_coulomb - interaction_cutoff) END FUNCTION potential_coulomb diff --git a/src/pair_potential_types.F b/src/pair_potential_types.F index 76525ffc4f..7acb3f5a37 100644 --- a/src/pair_potential_types.F +++ b/src/pair_potential_types.F @@ -316,7 +316,7 @@ SUBROUTINE compare_pot(pot1, pot2, compare) CPASSERT(ASSOCIATED(pot2%set)) DO i = 1, SIZE(pot1%type) mycompare = .FALSE. - SELECT CASE (pot1%type (i)) + SELECT CASE (pot1%type(i)) CASE (lj_type, lj_charmm_type) IF ((pot1%set(i)%lj%epsilon == pot2%set(i)%lj%epsilon) .AND. & (pot1%set(i)%lj%sigma6 == pot2%set(i)%lj%sigma6) .AND. & @@ -337,14 +337,14 @@ SUBROUTINE compare_pot(pot1, pot2, compare) IF ((pot1%set(i)%eam%drar == pot2%set(i)%eam%drar) .AND. & (pot1%set(i)%eam%drhoar == pot2%set(i)%eam%drhoar) .AND. & (pot1%set(i)%eam%acutal == pot2%set(i)%eam%acutal) .AND. & - (SUM(ABS(pot1%set(i)%eam%rho-pot2%set(i)%eam%rho)) == 0.0_dp) .AND. & - (SUM(ABS(pot1%set(i)%eam%phi-pot2%set(i)%eam%phi)) == 0.0_dp) .AND. & - (SUM(ABS(pot1%set(i)%eam%frho-pot2%set(i)%eam%frho)) == 0.0_dp) .AND. & - (SUM(ABS(pot1%set(i)%eam%rhoval-pot2%set(i)%eam%rhoval)) == 0.0_dp) .AND. & - (SUM(ABS(pot1%set(i)%eam%rval-pot2%set(i)%eam%rval)) == 0.0_dp) .AND. & - (SUM(ABS(pot1%set(i)%eam%rhop-pot2%set(i)%eam%rhop)) == 0.0_dp) .AND. & - (SUM(ABS(pot1%set(i)%eam%phip-pot2%set(i)%eam%phip)) == 0.0_dp) .AND. & - (SUM(ABS(pot1%set(i)%eam%frhop-pot2%set(i)%eam%frhop)) == 0.0_dp)) mycompare = .TRUE. + (SUM(ABS(pot1%set(i)%eam%rho - pot2%set(i)%eam%rho)) == 0.0_dp) .AND. & + (SUM(ABS(pot1%set(i)%eam%phi - pot2%set(i)%eam%phi)) == 0.0_dp) .AND. & + (SUM(ABS(pot1%set(i)%eam%frho - pot2%set(i)%eam%frho)) == 0.0_dp) .AND. & + (SUM(ABS(pot1%set(i)%eam%rhoval - pot2%set(i)%eam%rhoval)) == 0.0_dp) .AND. & + (SUM(ABS(pot1%set(i)%eam%rval - pot2%set(i)%eam%rval)) == 0.0_dp) .AND. & + (SUM(ABS(pot1%set(i)%eam%rhop - pot2%set(i)%eam%rhop)) == 0.0_dp) .AND. & + (SUM(ABS(pot1%set(i)%eam%phip - pot2%set(i)%eam%phip)) == 0.0_dp) .AND. & + (SUM(ABS(pot1%set(i)%eam%frhop - pot2%set(i)%eam%frhop)) == 0.0_dp)) mycompare = .TRUE. END IF CASE (quip_type) IF ((pot1%set(i)%quip%quip_file_name == pot2%set(i)%quip%quip_file_name) .AND. & @@ -362,7 +362,7 @@ SUBROUTINE compare_pot(pot1, pot2, compare) (pot1%set(i)%ftd%D == pot2%set(i)%ftd%D) .AND. & (pot1%set(i)%ftd%BD == pot2%set(i)%ftd%BD)) mycompare = .TRUE. CASE (ip_type) - IF ((SUM(ABS(pot1%set(i)%ipbv%a-pot2%set(i)%ipbv%a)) == 0.0_dp) .AND. & + IF ((SUM(ABS(pot1%set(i)%ipbv%a - pot2%set(i)%ipbv%a)) == 0.0_dp) .AND. & (pot1%set(i)%ipbv%rcore == pot2%set(i)%ipbv%rcore) .AND. & (pot1%set(i)%ipbv%m == pot2%set(i)%ipbv%m) .AND. & (pot1%set(i)%ipbv%b == pot2%set(i)%ipbv%b)) mycompare = .TRUE. @@ -613,7 +613,7 @@ SUBROUTINE pair_potential_single_add(potparm_source, potparm_dest) NULLIFY (potparm_tmp) CALL pair_potential_single_copy(potparm_dest, potparm_tmp) CALL pair_potential_single_release(potparm_dest) - CALL pair_potential_single_create(potparm_dest, size_dest+size_source) + CALL pair_potential_single_create(potparm_dest, size_dest + size_source) ! Copy back original informations.. potparm_dest%shell_type = potparm_tmp%shell_type potparm_dest%undef = potparm_tmp%undef @@ -652,8 +652,8 @@ SUBROUTINE pair_potential_single_add(potparm_source, potparm_dest) (potparm_dest%rcutsq == potparm_source%rcutsq) CPASSERT(check) ! Now copy the new pair_potential type - DO i = size_dest+1, size_dest+size_source - j = i-size_dest + DO i = size_dest + 1, size_dest + size_source + j = i - size_dest potparm_dest%type(i) = potparm_source%type(j) potparm_dest%set(i)%rmin = potparm_source%set(j)%rmin potparm_dest%set(i)%rmax = potparm_source%set(j)%rmax @@ -1030,7 +1030,7 @@ SUBROUTINE pair_potential_reallocate(p, lb1_new, ub1_new, lj, lj_charmm, william CALL pair_potential_p_copy(work, p, istart=lb1_old, iend=ub1_old) END IF std_dim = 1 - DO i = ub1_old+1, ub1_new + DO i = ub1_old + 1, ub1_new check = (SIZE(p%pot(i)%pot%type) == std_dim) .AND. (SIZE(p%pot(i)%pot%type) == std_dim) CPASSERT(check) p%pot(i)%pot%type = nn_type diff --git a/src/pair_potential_util.F b/src/pair_potential_util.F index 72bae8bb97..953d6be804 100644 --- a/src/pair_potential_util.F +++ b/src/pair_potential_util.F @@ -60,30 +60,30 @@ FUNCTION ener_pot(pot, r, energy_cutoff) RESULT(value) ! If within limits let's compute the potential... IF (pot%type(j) == lj_charmm_type) THEN lvalue = & - 4.0_dp*pot%set(j)%lj%epsilon*(pot%set(j)%lj%sigma12*r**(-12)-pot%set(j)%lj% & + 4.0_dp*pot%set(j)%lj%epsilon*(pot%set(j)%lj%sigma12*r**(-12) - pot%set(j)%lj% & sigma6*r**(-6)) ELSE IF (pot%type(j) == lj_type) THEN lvalue = pot%set(j)%lj%epsilon* & - (pot%set(j)%lj%sigma12*r**(-12)-pot%set(j)%lj%sigma6*r**(-6)) + (pot%set(j)%lj%sigma12*r**(-12) - pot%set(j)%lj%sigma6*r**(-6)) ELSE IF (pot%type(j) == ip_type) THEN lvalue = 0._dp IF (r > pot%set(j)%ipbv%rcore) THEN DO i = 2, 15 - lvalue = lvalue+pot%set(j)%ipbv%a(i)/(r**(i-1)*REAL(i-1, dp)) + lvalue = lvalue + pot%set(j)%ipbv%a(i)/(r**(i - 1)*REAL(i - 1, dp)) END DO ELSE ! use a linear potential - lvalue = pot%set(j)%ipbv%m*r+pot%set(j)%ipbv%b + lvalue = pot%set(j)%ipbv%m*r + pot%set(j)%ipbv%b ENDIF lvalue = lvalue ELSE IF (pot%type(j) == wl_type) THEN - lvalue = pot%set(j)%willis%a*EXP(-pot%set(j)%willis%b*r)-pot%set(j)%willis%c/r**6 + lvalue = pot%set(j)%willis%a*EXP(-pot%set(j)%willis%b*r) - pot%set(j)%willis%c/r**6 ELSE IF (pot%type(j) == gw_type) THEN - scale = EXP(pot%set(j)%goodwin%m*(-(r/pot%set(j)%goodwin%dc)**pot%set(j)%goodwin%mc+ & + scale = EXP(pot%set(j)%goodwin%m*(-(r/pot%set(j)%goodwin%dc)**pot%set(j)%goodwin%mc + & (pot%set(j)%goodwin%d/pot%set(j)%goodwin%dc)**pot%set(j)%goodwin%mc)) lvalue = scale*pot%set(j)%goodwin%vr0*(pot%set(j)%goodwin%d/r)**pot%set(j)%goodwin%m ELSE IF (pot%type(j) == ft_type) THEN - lvalue = pot%set(j)%ft%a*EXP(-pot%set(j)%ft%b*r)-pot%set(j)%ft%c/r**6-pot%set(j)%ft%d/r**8 + lvalue = pot%set(j)%ft%a*EXP(-pot%set(j)%ft%b*r) - pot%set(j)%ft%c/r**6 - pot%set(j)%ft%d/r**8 ELSE IF (pot%type(j) == ftd_type) THEN dampsum = 1.0_dp xf = 1.0_dp @@ -93,25 +93,25 @@ FUNCTION ener_pot(pot, r, energy_cutoff) RESULT(value) DO i = 1, 6 xf = xf*damp*r factorial = factorial*REAL(i, KIND=dp) - dampsum = dampsum+xf/factorial + dampsum = dampsum + xf/factorial ENDDO - f6 = 1.0_dp-dampexp*dampsum + f6 = 1.0_dp - dampexp*dampsum DO i = 7, 8 xf = xf*damp*r factorial = factorial*REAL(i, KIND=dp) - dampsum = dampsum+xf/factorial + dampsum = dampsum + xf/factorial ENDDO - f8 = 1.0_dp-dampexp*dampsum - lvalue = pot%set(j)%ftd%a*EXP(-pot%set(j)%ftd%b*r)-f6*pot%set(j)%ftd%c/r**6-f8*pot%set(j)%ftd%d/r**8 + f8 = 1.0_dp - dampexp*dampsum + lvalue = pot%set(j)%ftd%a*EXP(-pot%set(j)%ftd%b*r) - f6*pot%set(j)%ftd%c/r**6 - f8*pot%set(j)%ftd%d/r**8 ELSE IF (pot%type(j) == ea_type) THEN - index = INT(r/pot%set(j)%eam%drar)+1 + index = INT(r/pot%set(j)%eam%drar) + 1 IF (index > pot%set(j)%eam%npoints) THEN index = pot%set(j)%eam%npoints ELSEIF (index < 1) THEN index = 1 ENDIF - qq = r-pot%set(j)%eam%rval(index) - pp = pot%set(j)%eam%phi(index)+ & + qq = r - pot%set(j)%eam%rval(index) + pp = pot%set(j)%eam%phi(index) + & qq*pot%set(j)%eam%phip(index) lvalue = pp ELSE IF (pot%type(j) == b4_type) THEN @@ -120,23 +120,23 @@ FUNCTION ener_pot(pot, r, energy_cutoff) RESULT(value) ELSEIF (r > pot%set(j)%buck4r%r1 .AND. r <= pot%set(j)%buck4r%r2) THEN pp = 0.0_dp DO n = 0, pot%set(j)%buck4r%npoly1 - pp = pp+pot%set(j)%buck4r%poly1(n)*r**n + pp = pp + pot%set(j)%buck4r%poly1(n)*r**n END DO ELSEIF (r > pot%set(j)%buck4r%r2 .AND. r <= pot%set(j)%buck4r%r3) THEN pp = 0.0_dp DO n = 0, pot%set(j)%buck4r%npoly2 - pp = pp+pot%set(j)%buck4r%poly2(n)*r**n + pp = pp + pot%set(j)%buck4r%poly2(n)*r**n END DO ELSEIF (r > pot%set(j)%buck4r%r3) THEN pp = -pot%set(j)%buck4r%c/r**6 END IF lvalue = pp ELSE IF (pot%type(j) == bm_type) THEN - lvalue = pot%set(j)%buckmo%f0*(pot%set(j)%buckmo%b1+pot%set(j)%buckmo%b2)* & - EXP((pot%set(j)%buckmo%a1+pot%set(j)%buckmo%a2-r)/(pot%set(j)%buckmo%b1+pot%set(j)%buckmo%b2)) & - -pot%set(j)%buckmo%c/r**6 & - +pot%set(j)%buckmo%d*(EXP(-2._dp*pot%set(j)%buckmo%beta*(r-pot%set(j)%buckmo%r0))- & - 2.0_dp*EXP(-pot%set(j)%buckmo%beta*(r-pot%set(j)%buckmo%r0))) + lvalue = pot%set(j)%buckmo%f0*(pot%set(j)%buckmo%b1 + pot%set(j)%buckmo%b2)* & + EXP((pot%set(j)%buckmo%a1 + pot%set(j)%buckmo%a2 - r)/(pot%set(j)%buckmo%b1 + pot%set(j)%buckmo%b2)) & + - pot%set(j)%buckmo%c/r**6 & + + pot%set(j)%buckmo%d*(EXP(-2._dp*pot%set(j)%buckmo%beta*(r - pot%set(j)%buckmo%r0)) - & + 2.0_dp*EXP(-pot%set(j)%buckmo%beta*(r - pot%set(j)%buckmo%r0))) ELSE IF (pot%type(j) == gp_type) THEN pot%set(j)%gp%values(1) = r lvalue = evalf(pot%set(j)%gp%myid, pot%set(j)%gp%values) @@ -145,9 +145,9 @@ FUNCTION ener_pot(pot, r, energy_cutoff) RESULT(value) ELSE lvalue = 0.0_dp END IF - value = value+lvalue + value = value + lvalue END DO - value = value-energy_cutoff + value = value - energy_cutoff END FUNCTION ener_pot ! ************************************************************************************************** @@ -168,14 +168,14 @@ FUNCTION ener_zbl(pot, r) ener_zbl = 0.0_dp IF (r <= pot%zbl_rcut(1)) THEN - au = 0.88534_dp*bohr/(pot%z1**0.23_dp+pot%z2**0.23_dp) + au = 0.88534_dp*bohr/(pot%z1**0.23_dp + pot%z2**0.23_dp) x = r/au fac = pot%z1*pot%z2/evolt - ener_zbl = fac/r*(0.1818_dp*EXP(-3.2_dp*x)+0.5099_dp*EXP(-0.9423_dp*x)+ & - 0.2802_dp*EXP(-0.4029_dp*x)+0.02817_dp*EXP(-0.2016_dp*x)) + ener_zbl = fac/r*(0.1818_dp*EXP(-3.2_dp*x) + 0.5099_dp*EXP(-0.9423_dp*x) + & + 0.2802_dp*EXP(-0.4029_dp*x) + 0.02817_dp*EXP(-0.2016_dp*x)) ELSEIF (r > pot%zbl_rcut(1) .AND. r <= pot%zbl_rcut(2)) THEN - ener_zbl = pot%zbl_poly(0)+pot%zbl_poly(1)*r+pot%zbl_poly(2)*r*r+pot%zbl_poly(3)*r*r*r+ & - pot%zbl_poly(4)*r*r*r*r+pot%zbl_poly(5)*r*r*r*r*r + ener_zbl = pot%zbl_poly(0) + pot%zbl_poly(1)*r + pot%zbl_poly(2)*r*r + pot%zbl_poly(3)*r*r*r + & + pot%zbl_poly(4)*r*r*r*r + pot%zbl_poly(5)*r*r*r*r*r ELSE ener_zbl = 0.0_dp END IF @@ -201,31 +201,31 @@ SUBROUTINE zbl_matching_polinomial(pot, rcov1, rcov2, z1, z2) REAL(KIND=dp) :: au, d1, d2, dd1, dd2, fac, v1, v2, x, & x1, x2 - pot%zbl_rcut(1) = (rcov1+rcov2)*(1.0_dp-0.2_dp)*bohr - pot%zbl_rcut(2) = (rcov1+rcov2)*bohr + pot%zbl_rcut(1) = (rcov1 + rcov2)*(1.0_dp - 0.2_dp)*bohr + pot%zbl_rcut(2) = (rcov1 + rcov2)*bohr x1 = pot%zbl_rcut(1) x2 = pot%zbl_rcut(2) pot%z1 = z1 pot%z2 = z2 - au = 0.88534_dp*bohr/(z1**0.23_dp+z2**0.23_dp) + au = 0.88534_dp*bohr/(z1**0.23_dp + z2**0.23_dp) x = x1/au fac = z1*z2/evolt - v1 = fac/x1*(0.1818_dp*EXP(-3.2_dp*x)+0.5099_dp*EXP(-0.9423_dp*x)+ & - 0.2802_dp*EXP(-0.4029_dp*x)+0.02817_dp*EXP(-0.2016_dp*x)) - d1 = fac/x1/au*(-3.2_dp*0.1818_dp*EXP(-3.2_dp*x)-0.9423_dp*0.5099_dp*EXP(-0.9423_dp*x) & - -0.4029_dp*0.2802_dp*EXP(-0.4029_dp*x)-0.2016_dp*0.02817_dp*EXP(-0.2016_dp*x)) & - -fac/x1/x1*(0.1818_dp*EXP(-3.2_dp*x)+0.5099_dp*EXP(-0.9423_dp*x)+ & - 0.2802_dp*EXP(-0.4029_dp*x)+0.02817_dp*EXP(-0.2016_dp*x)) + v1 = fac/x1*(0.1818_dp*EXP(-3.2_dp*x) + 0.5099_dp*EXP(-0.9423_dp*x) + & + 0.2802_dp*EXP(-0.4029_dp*x) + 0.02817_dp*EXP(-0.2016_dp*x)) + d1 = fac/x1/au*(-3.2_dp*0.1818_dp*EXP(-3.2_dp*x) - 0.9423_dp*0.5099_dp*EXP(-0.9423_dp*x) & + - 0.4029_dp*0.2802_dp*EXP(-0.4029_dp*x) - 0.2016_dp*0.02817_dp*EXP(-0.2016_dp*x)) & + - fac/x1/x1*(0.1818_dp*EXP(-3.2_dp*x) + 0.5099_dp*EXP(-0.9423_dp*x) + & + 0.2802_dp*EXP(-0.4029_dp*x) + 0.02817_dp*EXP(-0.2016_dp*x)) dd1 = 2.0_dp*fac/x1**3*(0.1818_dp*EXP(-0.32E1_dp*x) & - +0.5099_dp*EXP(-0.9423_dp*x)+0.2802_dp*EXP(-0.4029_dp*x) & - +0.2817E-1_dp*EXP(-0.2016_dp*x)) & - -0.2E1_dp*fac/x1**2/au*(-0.58176_dp*EXP(-0.32E1_dp*x)-0.48047877_dp*EXP(-0.9423_dp*x) & - -0.11289258_dp*EXP(-0.4029_dp*x)-0.5679072E-2_dp*EXP(-0.2016_dp*x)) & - +fac/x1/au**2*(0.1861632E1_dp*EXP(-0.32E1_dp*x)+ & - 0.4527551450_dp*EXP(-0.9423_dp*x)+0.4548442048E-1_dp*EXP(-0.4029_dp*x)+ & - 0.1144900915E-2_dp*EXP(-0.2016_dp*x)) + + 0.5099_dp*EXP(-0.9423_dp*x) + 0.2802_dp*EXP(-0.4029_dp*x) & + + 0.2817E-1_dp*EXP(-0.2016_dp*x)) & + - 0.2E1_dp*fac/x1**2/au*(-0.58176_dp*EXP(-0.32E1_dp*x) - 0.48047877_dp*EXP(-0.9423_dp*x) & + - 0.11289258_dp*EXP(-0.4029_dp*x) - 0.5679072E-2_dp*EXP(-0.2016_dp*x)) & + + fac/x1/au**2*(0.1861632E1_dp*EXP(-0.32E1_dp*x) + & + 0.4527551450_dp*EXP(-0.9423_dp*x) + 0.4548442048E-1_dp*EXP(-0.4029_dp*x) + & + 0.1144900915E-2_dp*EXP(-0.2016_dp*x)) v2 = 0.0_dp d2 = 0.0_dp @@ -256,45 +256,45 @@ SUBROUTINE compute_polinomial_5th(r1, v1, d1, dd1, r2, v2, d2, dd2, poly) ! 5th order - a0 = .5_dp*(2._dp*r1**5*v2-2._dp*v1*r2**5+10._dp*v1*r2**4*r1-20._dp*v1*r1**2*r2**3-r1**2*dd1*r2**5- & - r1**4*r2**3*dd1+20._dp*r1**3*r2**2*v2+2._dp*r1**3*r2**4*dd1+r1**3*r2**4*dd2-8._dp*r1**3*r2**3*d2- & - 2._dp*r1**4*r2**3*dd2+10._dp*r1**4*r2**2*d2-10._dp*r1**4*r2*v2+2._dp*r1*d1*r2**5-10._dp*r1**2*d1*r2**4+ & - 8._dp*r1**3*d1*r2**3-2._dp*r1**5*r2*d2+r1**5*r2**2*dd2)/ & - (10.*r2**2*r1**3-5._dp*r2*r1**4-10._dp*r1**2*r2**3+5._dp*r2**4*r1-r2**5+r1**5) - - a1 = -.5_dp*(-4._dp*r2**3*r1**3*dd2+24._dp*r2**2*r1**3*d1+4._dp*r2**3*r1**3*dd1+3._dp*r2**4*r1**2*dd2+ & - r2**4*r1**2*dd1-2._dp*r2**5*r1*dd1-10._dp*r2**4*r1*d1+10._dp*r1**4*r2*d2- & - r1**4*r2**2*dd2-3._dp*r1**4*r2**2*dd1+ & - 2._dp*r1**5*r2*dd2-24._dp*r2**3*r1**2*d2-16._dp*r2**3*r1**2*d1+ & - 16._dp*r2**2*r1**3*d2-2._dp*r1**5*d2+2._dp*r2**5*d1- & - 60._dp*r1**2*r2**2*v1+60._dp*r1**2*r2**2*v2)/ & - (10._dp*r2**2*r1**3-5._dp*r2*r1**4-10._dp*r1**2*r2**3+5._dp*r2**4*r1-r2**5+r1**5) - - a2 = .5_dp*(60._dp*r1**2*r2*v2-60._dp*v1*r1*r2**2-12._dp*r1**2*r2**2*d2-36._dp*r1*d1*r2**3+3._dp*r2**4*r1*dd2- & - 24._dp*r2**3*r1*d2-4._dp*r2**4*r1*dd1+12._dp*r1**2*r2**2*d1-8._dp*r1**3*r2**2*dd2+24._dp*r1**3*r2*d1+ & - 4._dp*r1**4*r2*dd2+36._dp*r1**3*r2*d2-3._dp*r1**4*r2*dd1+8._dp*r2**3*r1**2*dd1+60._dp*r2**2*r1*v2- & - 60._dp*r1**2*v1*r2+r1**5*dd2-r2**5*dd1)/ & - (10._dp*r2**2*r1**3-5._dp*r2*r1**4-10._dp*r1**2*r2**3+5._dp*r2**4*r1-r2**5+r1**5) - - a3 = -.5_dp*(3._dp*r1**4*dd2-r1**4*dd1+8.*r1**3*d1-4.*r1**3*r2*dd1+ & - 12._dp*r1**3*d2+32._dp*r1**2*r2*d1-8._dp*r1**2*r2**2*dd2- & - 20._dp*r1**2*v1+8._dp*r1**2*r2**2*dd1+28._dp*r1**2*r2*d2+ & - 20._dp*r1**2*v2+80._dp*r1*r2*v2-28._dp*r2**2*r1*d1-80._dp*r1*v1*r2- & - 32._dp*r2**2*r1*d2+4._dp*r1*r2**3*dd2-8._dp*r2**3*d2-12._dp*r2**3*d1+ & - r2**4*dd2-3._dp*r2**4*dd1+20._dp*r2**2*v2-20._dp*r2**2*v1)/ & - (10._dp*r2**2*r1**3-5._dp*r2*r1**4-10._dp*r1**2*r2**3+5._dp*r2**4*r1-r2**5+r1**5) - - a4 = .5_dp*(3._dp*r1**3*dd2-2._dp*r1**3*dd1+r1**2*r2*dd1+14.*r1**2*d1-4._dp*r1**2*r2*dd2+ & - 16._dp*r1**2*d2-2._dp*r1*r2*d2-r1*r2**2*dd2- & - 30._dp*r1*v1+30.*r1*v2+2._dp*r1*r2*d1+4._dp*r1*r2**2*dd1-16._dp*r2**2*d1+ & - 2._dp*r2**3*dd2-14._dp*r2**2*d2+30._dp*r2*v2-30._dp*v1*r2- & - 3._dp*r2**3*dd1)/(10._dp*r2**2*r1**3-5._dp*r2*r1**4- & - 10._dp*r1**2*r2**3+5._dp*r2**4*r1-r2**5+r1**5) - - a5 = -.5_dp*(6._dp*r1*d1+2._dp*r2*r1*dd1+6._dp*r1*d2-2.*r2*r1*dd2- & - r2**2*dd1-r1**2*dd1-12.*v1+12._dp*v2+r1**2*dd2- & - 6._dp*r2*d1+r2**2*dd2-6._dp*r2*d2)/ & - (10._dp*r2**2*r1**3-5._dp*r2*r1**4-10._dp*r1**2*r2**3+5._dp*r2**4*r1-r2**5+r1**5) + a0 = .5_dp*(2._dp*r1**5*v2 - 2._dp*v1*r2**5 + 10._dp*v1*r2**4*r1 - 20._dp*v1*r1**2*r2**3 - r1**2*dd1*r2**5 - & + r1**4*r2**3*dd1 + 20._dp*r1**3*r2**2*v2 + 2._dp*r1**3*r2**4*dd1 + r1**3*r2**4*dd2 - 8._dp*r1**3*r2**3*d2 - & + 2._dp*r1**4*r2**3*dd2 + 10._dp*r1**4*r2**2*d2 - 10._dp*r1**4*r2*v2 + 2._dp*r1*d1*r2**5 - 10._dp*r1**2*d1*r2**4 + & + 8._dp*r1**3*d1*r2**3 - 2._dp*r1**5*r2*d2 + r1**5*r2**2*dd2)/ & + (10.*r2**2*r1**3 - 5._dp*r2*r1**4 - 10._dp*r1**2*r2**3 + 5._dp*r2**4*r1 - r2**5 + r1**5) + + a1 = -.5_dp*(-4._dp*r2**3*r1**3*dd2 + 24._dp*r2**2*r1**3*d1 + 4._dp*r2**3*r1**3*dd1 + 3._dp*r2**4*r1**2*dd2 + & + r2**4*r1**2*dd1 - 2._dp*r2**5*r1*dd1 - 10._dp*r2**4*r1*d1 + 10._dp*r1**4*r2*d2 - & + r1**4*r2**2*dd2 - 3._dp*r1**4*r2**2*dd1 + & + 2._dp*r1**5*r2*dd2 - 24._dp*r2**3*r1**2*d2 - 16._dp*r2**3*r1**2*d1 + & + 16._dp*r2**2*r1**3*d2 - 2._dp*r1**5*d2 + 2._dp*r2**5*d1 - & + 60._dp*r1**2*r2**2*v1 + 60._dp*r1**2*r2**2*v2)/ & + (10._dp*r2**2*r1**3 - 5._dp*r2*r1**4 - 10._dp*r1**2*r2**3 + 5._dp*r2**4*r1 - r2**5 + r1**5) + + a2 = .5_dp*(60._dp*r1**2*r2*v2 - 60._dp*v1*r1*r2**2 - 12._dp*r1**2*r2**2*d2 - 36._dp*r1*d1*r2**3 + 3._dp*r2**4*r1*dd2 - & + 24._dp*r2**3*r1*d2 - 4._dp*r2**4*r1*dd1 + 12._dp*r1**2*r2**2*d1 - 8._dp*r1**3*r2**2*dd2 + 24._dp*r1**3*r2*d1 + & + 4._dp*r1**4*r2*dd2 + 36._dp*r1**3*r2*d2 - 3._dp*r1**4*r2*dd1 + 8._dp*r2**3*r1**2*dd1 + 60._dp*r2**2*r1*v2 - & + 60._dp*r1**2*v1*r2 + r1**5*dd2 - r2**5*dd1)/ & + (10._dp*r2**2*r1**3 - 5._dp*r2*r1**4 - 10._dp*r1**2*r2**3 + 5._dp*r2**4*r1 - r2**5 + r1**5) + + a3 = -.5_dp*(3._dp*r1**4*dd2 - r1**4*dd1 + 8.*r1**3*d1 - 4.*r1**3*r2*dd1 + & + 12._dp*r1**3*d2 + 32._dp*r1**2*r2*d1 - 8._dp*r1**2*r2**2*dd2 - & + 20._dp*r1**2*v1 + 8._dp*r1**2*r2**2*dd1 + 28._dp*r1**2*r2*d2 + & + 20._dp*r1**2*v2 + 80._dp*r1*r2*v2 - 28._dp*r2**2*r1*d1 - 80._dp*r1*v1*r2 - & + 32._dp*r2**2*r1*d2 + 4._dp*r1*r2**3*dd2 - 8._dp*r2**3*d2 - 12._dp*r2**3*d1 + & + r2**4*dd2 - 3._dp*r2**4*dd1 + 20._dp*r2**2*v2 - 20._dp*r2**2*v1)/ & + (10._dp*r2**2*r1**3 - 5._dp*r2*r1**4 - 10._dp*r1**2*r2**3 + 5._dp*r2**4*r1 - r2**5 + r1**5) + + a4 = .5_dp*(3._dp*r1**3*dd2 - 2._dp*r1**3*dd1 + r1**2*r2*dd1 + 14.*r1**2*d1 - 4._dp*r1**2*r2*dd2 + & + 16._dp*r1**2*d2 - 2._dp*r1*r2*d2 - r1*r2**2*dd2 - & + 30._dp*r1*v1 + 30.*r1*v2 + 2._dp*r1*r2*d1 + 4._dp*r1*r2**2*dd1 - 16._dp*r2**2*d1 + & + 2._dp*r2**3*dd2 - 14._dp*r2**2*d2 + 30._dp*r2*v2 - 30._dp*v1*r2 - & + 3._dp*r2**3*dd1)/(10._dp*r2**2*r1**3 - 5._dp*r2*r1**4 - & + 10._dp*r1**2*r2**3 + 5._dp*r2**4*r1 - r2**5 + r1**5) + + a5 = -.5_dp*(6._dp*r1*d1 + 2._dp*r2*r1*dd1 + 6._dp*r1*d2 - 2.*r2*r1*dd2 - & + r2**2*dd1 - r1**2*dd1 - 12.*v1 + 12._dp*v2 + r1**2*dd2 - & + 6._dp*r2*d1 + r2**2*dd2 - 6._dp*r2*d2)/ & + (10._dp*r2**2*r1**3 - 5._dp*r2*r1**4 - 10._dp*r1**2*r2**3 + 5._dp*r2**4*r1 - r2**5 + r1**5) poly(0) = a0 poly(1) = a1 diff --git a/src/pao_io.F b/src/pao_io.F index f95deb5d49..f553278e75 100644 --- a/src/pao_io.F +++ b/src/pao_io.F @@ -119,7 +119,7 @@ SUBROUTINE pao_read_restart(pao, qs_env) CALL pao_read_raw(pao%restart_file, param, hmat, kinds, atom2kind, positions, xblocks) ! check cell - IF (MAXVAL(ABS(hmat-cell%hmat)) > 1e-10) & + IF (MAXVAL(ABS(hmat - cell%hmat)) > 1e-10) & CPWARN("Restarting from differnt cell") ! check parametrization @@ -144,7 +144,7 @@ SUBROUTINE pao_read_restart(pao, qs_env) ! check positions, warning only diff = 0.0_dp DO iatom = 1, natoms - diff = MAX(diff, MAXVAL(ABS(positions(iatom, :)-particle_set(iatom)%r))) + diff = MAX(diff, MAXVAL(ABS(positions(iatom, :) - particle_set(iatom)%r))) ENDDO IF (diff > 1e-10) & CPWARN("Restarting from different atom positions") @@ -305,7 +305,7 @@ SUBROUTINE pao_read_raw(filename, param, hmat, kinds, atom2kind, positions, xblo ALLOCATE (xblocks(iatom)%p(nparams, 1)) BACKSPACE (unit_nr) READ (unit_nr, fmt=*) label, iatom, xblocks(iatom)%p - xblocks_read = xblocks_read+1 + xblocks_read = xblocks_read + 1 CPASSERT(iatom == xblocks_read) ! ensure blocks are read in order ELSE IF (TRIM(label) == "THE_END") THEN @@ -479,7 +479,7 @@ SUBROUTINE pao_write_diagonal_blocks(para_env, matrix, label, unit_nr) ENDDO ! flush - IF (unit_nr > 0) FLUSH(unit_nr) + IF (unit_nr > 0) FLUSH (unit_nr) END SUBROUTINE pao_write_diagonal_blocks diff --git a/src/pao_linpot_full.F b/src/pao_linpot_full.F index 60b74696c5..9ee99f4559 100644 --- a/src/pao_linpot_full.F +++ b/src/pao_linpot_full.F @@ -44,7 +44,7 @@ SUBROUTINE linpot_full_count_terms(qs_env, ikind, nterms) CALL get_qs_env(qs_env, qs_kind_set=qs_kind_set) CALL get_qs_kind(qs_kind_set(ikind), basis_set=basis_set) n = basis_set%nsgf - nterms = n+n*(n-1)/2 + nterms = n + n*(n - 1)/2 END SUBROUTINE linpot_full_count_terms @@ -65,7 +65,7 @@ SUBROUTINE linpot_full_calc_terms(V_blocks) kterm = 0 DO i = 1, N DO j = i, N - kterm = kterm+1 + kterm = kterm + 1 V_blocks(i, j, kterm) = 1.0_dp V_blocks(j, i, kterm) = 1.0_dp ENDDO diff --git a/src/pao_linpot_rotinv.F b/src/pao_linpot_rotinv.F index 3428c062fe..384f0cbe44 100644 --- a/src/pao_linpot_rotinv.F +++ b/src/pao_linpot_rotinv.F @@ -71,7 +71,7 @@ SUBROUTINE linpot_rotinv_count_terms(qs_env, ikind, nterms) ALLOCATE (shell_l(nshells)) DO iset = 1, basis_set%nset DO ishell = 1, basis_set%nshell(iset) - ishell_abs = SUM(basis_set%nshell(1:iset-1))+ishell + ishell_abs = SUM(basis_set%nshell(1:iset - 1)) + ishell shell_l(ishell_abs) = basis_set%l(ishell, iset) ENDDO ENDDO @@ -91,7 +91,7 @@ SUBROUTINE linpot_rotinv_count_terms(qs_env, ikind, nterms) lmin = shell_l(min_shell) lmax = shell_l(max_shell) IF (lmin == 0 .AND. lmax == 0) CYCLE ! coverted by central terms - nterms = nterms+1 + nterms = nterms + 1 ENDDO ENDDO ENDDO @@ -101,7 +101,7 @@ SUBROUTINE linpot_rotinv_count_terms(qs_env, ikind, nterms) DO max_shell = 1, nshells DO min_shell = 1, max_shell IF (shell_l(min_shell) /= shell_l(max_shell)) CYCLE ! need quadratic block - nterms = nterms+1 + nterms = nterms + 1 ENDDO ENDDO @@ -159,13 +159,13 @@ SUBROUTINE linpot_rotinv_calc_terms(qs_env, iatom, V_blocks) ! setup description of potential lb_min = 0 lb_max = pot_maxl - ncfgb = ncoset(lb_max)-ncoset(lb_min-1) + ncfgb = ncoset(lb_max) - ncoset(lb_min - 1) npgfb = 1 ! number of exponents nb = npgfb*ncfgb ALLOCATE (rpgfb(npgfb), zetb(npgfb)) ! build block_V_full - ALLOCATE (block_V_full(N, N, pot_maxl/2+1)) + ALLOCATE (block_V_full(N, N, pot_maxl/2 + 1)) block_V_full = 0.0_dp DO iset = 1, basis_set%nset @@ -175,7 +175,7 @@ SUBROUTINE linpot_rotinv_calc_terms(qs_env, iatom, V_blocks) la1_max = basis_set%lmax(iset) la1_min = basis_set%lmin(iset) npgfa1 = basis_set%npgf(iset) - ncfga1 = ncoset(la1_max)-ncoset(la1_min-1) + ncfga1 = ncoset(la1_max) - ncoset(la1_min - 1) na1 = npgfa1*ncfga1 zeta1 => basis_set%zet(:, iset) rpgfa1 => basis_set%pgf_radius(:, iset) @@ -184,7 +184,7 @@ SUBROUTINE linpot_rotinv_calc_terms(qs_env, iatom, V_blocks) la2_max = basis_set%lmax(jset) la2_min = basis_set%lmin(jset) npgfa2 = basis_set%npgf(jset) - ncfga2 = ncoset(la2_max)-ncoset(la2_min-1) + ncfga2 = ncoset(la2_max) - ncoset(la2_min - 1) na2 = npgfa2*ncfga2 zeta2 => basis_set%zet(:, jset) rpgfa2 => basis_set%pgf_radius(:, jset) @@ -193,7 +193,7 @@ SUBROUTINE linpot_rotinv_calc_terms(qs_env, iatom, V_blocks) rpgfa_max = MAX(MAXVAL(rpgfa1), MAXVAL(rpgfa2)) ! allocate space for integrals - ALLOCATE (saab(na1, na2, nb), saal(na1, na2, pot_maxl/2+1)) + ALLOCATE (saab(na1, na2, nb), saal(na1, na2, pot_maxl/2 + 1)) saal = 0.0_dp ! loop over neighbors @@ -217,7 +217,7 @@ SUBROUTINE linpot_rotinv_calc_terms(qs_env, iatom, V_blocks) ! distance screening tab = SQRT(SUM(Rab**2)) - IF (rpgfa_max+rpgfb(1) < tab) CYCLE + IF (rpgfa_max + rpgfb(1) < tab) CYCLE ! calculate actual integrals saab = 0.0_dp @@ -228,28 +228,28 @@ SUBROUTINE linpot_rotinv_calc_terms(qs_env, iatom, V_blocks) ! sum neighbor contributions according to remote atom's weight and normalization DO lpot = 0, pot_maxl, 2 - norm2 = (2.0_dp*pot_beta)**(-0.5_dp-lpot)*gamma1(lpot) + norm2 = (2.0_dp*pot_beta)**(-0.5_dp - lpot)*gamma1(lpot) ! sum potential terms: POW(x**2 + y**2 + z**2, lpot/2) - DO ic = ncoset(lpot-1)+1, ncoset(lpot) + DO ic = ncoset(lpot - 1) + 1, ncoset(lpot) coeff = multinomial(lpot/2, indco(:, ic)/2) - saal(:, :, lpot/2+1) = saal(:, :, lpot/2+1)+saab(:, :, ic)*coeff*pot_weight/SQRT(norm2) + saal(:, :, lpot/2 + 1) = saal(:, :, lpot/2 + 1) + saab(:, :, ic)*coeff*pot_weight/SQRT(norm2) ENDDO ENDDO ENDDO ! jatom ! find bounds of set-pair and setup transformation matrices sgfa1 = basis_set%first_sgf(1, iset) - sgla1 = sgfa1+basis_set%nsgf_set(iset)-1 + sgla1 = sgfa1 + basis_set%nsgf_set(iset) - 1 sgfa2 = basis_set%first_sgf(1, jset) - sgla2 = sgfa2+basis_set%nsgf_set(jset)-1 + sgla2 = sgfa2 + basis_set%nsgf_set(jset) - 1 T1 => basis_set%scon(1:na1, sgfa1:sgla1) T2 => basis_set%scon(1:na2, sgfa2:sgla2) ! transform into primary basis DO lpot = 0, pot_maxl, 2 - V12 => block_V_full(sgfa1:sgla1, sgfa2:sgla2, lpot/2+1) - V21 => block_V_full(sgfa2:sgla2, sgfa1:sgla1, lpot/2+1) - V12 = MATMUL(TRANSPOSE(T1), MATMUL(saal(:, :, lpot/2+1), T2)) + V12 => block_V_full(sgfa1:sgla1, sgfa2:sgla2, lpot/2 + 1) + V21 => block_V_full(sgfa2:sgla2, sgfa1:sgla1, lpot/2 + 1) + V12 = MATMUL(TRANSPOSE(T1), MATMUL(saal(:, :, lpot/2 + 1), T2)) V21 = TRANSPOSE(V12) ENDDO DEALLOCATE (saab, saal) @@ -264,8 +264,8 @@ SUBROUTINE linpot_rotinv_calc_terms(qs_env, iatom, V_blocks) DO ishell = 1, basis_set%nshell(iset) DO jshell = 1, basis_set%nshell(jset) IF (basis_set%l(ishell, iset) == 0 .AND. basis_set%l(jshell, jset) == 0) CYCLE ! covered by central terms - ishell_abs = SUM(basis_set%nshell(1:iset-1))+ishell - jshell_abs = SUM(basis_set%nshell(1:jset-1))+jshell + ishell_abs = SUM(basis_set%nshell(1:iset - 1)) + ishell + jshell_abs = SUM(basis_set%nshell(1:jset - 1)) + jshell IF (ishell_abs < jshell_abs) CYCLE ! find bounds of shell-pair @@ -275,10 +275,10 @@ SUBROUTINE linpot_rotinv_calc_terms(qs_env, iatom, V_blocks) sgla2 = basis_set%last_sgf(jshell, jset) DO lpot = 0, pot_maxl, 2 - kterm = kterm+1 + kterm = kterm + 1 V_blocks(:, :, kterm) = 0.0_dp - V_blocks(sgfa1:sgla1, sgfa2:sgla2, kterm) = block_V_full(sgfa1:sgla1, sgfa2:sgla2, lpot/2+1) - V_blocks(sgfa2:sgla2, sgfa1:sgla1, kterm) = block_V_full(sgfa2:sgla2, sgfa1:sgla1, lpot/2+1) + V_blocks(sgfa1:sgla1, sgfa2:sgla2, kterm) = block_V_full(sgfa1:sgla1, sgfa2:sgla2, lpot/2 + 1) + V_blocks(sgfa2:sgla2, sgfa1:sgla1, kterm) = block_V_full(sgfa2:sgla2, sgfa1:sgla1, lpot/2 + 1) ENDDO ! lpot ENDDO ! jshell ENDDO ! ishell @@ -294,19 +294,19 @@ SUBROUTINE linpot_rotinv_calc_terms(qs_env, iatom, V_blocks) DO ishell = 1, basis_set%nshell(iset) DO jshell = 1, basis_set%nshell(jset) IF (basis_set%l(ishell, iset) /= basis_set%l(jshell, jset)) CYCLE ! need quadratic block - ishell_abs = SUM(basis_set%nshell(1:iset-1))+ishell - jshell_abs = SUM(basis_set%nshell(1:jset-1))+jshell + ishell_abs = SUM(basis_set%nshell(1:iset - 1)) + ishell + jshell_abs = SUM(basis_set%nshell(1:jset - 1)) + jshell IF (ishell_abs < jshell_abs) CYCLE - kterm = kterm+1 + kterm = kterm + 1 sgfa1 = basis_set%first_sgf(ishell, iset) sgla1 = basis_set%last_sgf(ishell, iset) sgfa2 = basis_set%first_sgf(jshell, jset) sgla2 = basis_set%last_sgf(jshell, jset) - CPASSERT((sgla1-sgfa1) == (sgla2-sgfa2)) ! should be a quadratic block + CPASSERT((sgla1 - sgfa1) == (sgla2 - sgfa2)) ! should be a quadratic block V_blocks(:, :, kterm) = 0.0_dp - DO i = 1, sgla1-sgfa1+1 ! set diagonal of sub-block - V_blocks(sgfa1-1+i, sgfa2-1+i, kterm) = 1.0_dp - V_blocks(sgfa2-1+i, sgfa1-1+i, kterm) = 1.0_dp + DO i = 1, sgla1 - sgfa1 + 1 ! set diagonal of sub-block + V_blocks(sgfa1 - 1 + i, sgfa2 - 1 + i, kterm) = 1.0_dp + V_blocks(sgfa2 - 1 + i, sgfa1 - 1 + i, kterm) = 1.0_dp ENDDO norm2 = SUM(V_blocks(:, :, kterm)**2) V_blocks(:, :, kterm) = V_blocks(:, :, kterm)/SQRT(norm2) ! normalize @@ -373,15 +373,15 @@ SUBROUTINE linpot_rotinv_calc_forces(qs_env, iatom, M_blocks, forces) pot_maxl = ipao_potentials(ipot)%maxl ! taken from central atom ! build block_M_full - ALLOCATE (block_M_full(N, N, pot_maxl/2+1)) + ALLOCATE (block_M_full(N, N, pot_maxl/2 + 1)) block_M_full = 0.0_dp DO iset = 1, basis_set%nset DO jset = 1, iset DO ishell = 1, basis_set%nshell(iset) DO jshell = 1, basis_set%nshell(jset) IF (basis_set%l(ishell, iset) == 0 .AND. basis_set%l(jshell, jset) == 0) CYCLE ! covered by central terms - ishell_abs = SUM(basis_set%nshell(1:iset-1))+ishell - jshell_abs = SUM(basis_set%nshell(1:jset-1))+jshell + ishell_abs = SUM(basis_set%nshell(1:iset - 1)) + ishell + jshell_abs = SUM(basis_set%nshell(1:jset - 1)) + jshell IF (ishell_abs < jshell_abs) CYCLE ! find bounds of shell-pair sgfa1 = basis_set%first_sgf(ishell, iset) @@ -389,9 +389,9 @@ SUBROUTINE linpot_rotinv_calc_forces(qs_env, iatom, M_blocks, forces) sgfa2 = basis_set%first_sgf(jshell, jset) sgla2 = basis_set%last_sgf(jshell, jset) DO lpot = 0, pot_maxl, 2 - kterm = kterm+1 - block_M_full(sgfa1:sgla1, sgfa2:sgla2, lpot/2+1) = M_blocks(sgfa1:sgla1, sgfa2:sgla2, kterm) - block_M_full(sgfa2:sgla2, sgfa1:sgla1, lpot/2+1) = M_blocks(sgfa2:sgla2, sgfa1:sgla1, kterm) + kterm = kterm + 1 + block_M_full(sgfa1:sgla1, sgfa2:sgla2, lpot/2 + 1) = M_blocks(sgfa1:sgla1, sgfa2:sgla2, kterm) + block_M_full(sgfa2:sgla2, sgfa1:sgla1, lpot/2 + 1) = M_blocks(sgfa2:sgla2, sgfa1:sgla1, kterm) ENDDO ! lpot ENDDO ! jshell ENDDO ! ishell @@ -401,7 +401,7 @@ SUBROUTINE linpot_rotinv_calc_forces(qs_env, iatom, M_blocks, forces) ! setup description of potential lb_min = 0 lb_max = pot_maxl - ncfgb = ncoset(lb_max)-ncoset(lb_min-1) + ncfgb = ncoset(lb_max) - ncoset(lb_min - 1) npgfb = 1 ! number of exponents nb = npgfb*ncfgb ALLOCATE (rpgfb(npgfb), zetb(npgfb)) @@ -413,7 +413,7 @@ SUBROUTINE linpot_rotinv_calc_forces(qs_env, iatom, M_blocks, forces) la1_max = basis_set%lmax(iset) la1_min = basis_set%lmin(iset) npgfa1 = basis_set%npgf(iset) - ncfga1 = ncoset(la1_max)-ncoset(la1_min-1) + ncfga1 = ncoset(la1_max) - ncoset(la1_min - 1) na1 = npgfa1*ncfga1 zeta1 => basis_set%zet(:, iset) rpgfa1 => basis_set%pgf_radius(:, iset) @@ -422,7 +422,7 @@ SUBROUTINE linpot_rotinv_calc_forces(qs_env, iatom, M_blocks, forces) la2_max = basis_set%lmax(jset) la2_min = basis_set%lmin(jset) npgfa2 = basis_set%npgf(jset) - ncfga2 = ncoset(la2_max)-ncoset(la2_min-1) + ncfga2 = ncoset(la2_max) - ncoset(la2_min - 1) na2 = npgfa2*ncfga2 zeta2 => basis_set%zet(:, jset) rpgfa2 => basis_set%pgf_radius(:, jset) @@ -432,9 +432,9 @@ SUBROUTINE linpot_rotinv_calc_forces(qs_env, iatom, M_blocks, forces) ! find bounds of set-pair and setup transformation matrices sgfa1 = basis_set%first_sgf(1, iset) - sgla1 = sgfa1+basis_set%nsgf_set(iset)-1 + sgla1 = sgfa1 + basis_set%nsgf_set(iset) - 1 sgfa2 = basis_set%first_sgf(1, jset) - sgla2 = sgfa2+basis_set%nsgf_set(jset)-1 + sgla2 = sgfa2 + basis_set%nsgf_set(jset) - 1 T1 => basis_set%scon(1:na1, sgfa1:sgla1) T2 => basis_set%scon(1:na2, sgfa2:sgla2) @@ -462,7 +462,7 @@ SUBROUTINE linpot_rotinv_calc_forces(qs_env, iatom, M_blocks, forces) ! distance screening tab = SQRT(SUM(Rab**2)) - IF (rpgfa_max+rpgfb(1) < tab) CYCLE + IF (rpgfa_max + rpgfb(1) < tab) CYCLE ! calculate actual integrals daab = 0.0_dp @@ -475,10 +475,10 @@ SUBROUTINE linpot_rotinv_calc_forces(qs_env, iatom, M_blocks, forces) DO lpot = 0, pot_maxl, 2 ! sum potential terms: POW(x**2 + y**2 + z**2, lpot/2) dab = 0.0_dp - DO ic = ncoset(lpot-1)+1, ncoset(lpot) - norm2 = (2.0_dp*pot_beta)**(-0.5_dp-lpot)*gamma1(lpot) + DO ic = ncoset(lpot - 1) + 1, ncoset(lpot) + norm2 = (2.0_dp*pot_beta)**(-0.5_dp - lpot)*gamma1(lpot) coeff = multinomial(lpot/2, indco(:, ic)/2) - dab = dab+coeff*daab(:, :, ic, :)*pot_weight/SQRT(norm2) + dab = dab + coeff*daab(:, :, ic, :)*pot_weight/SQRT(norm2) ENDDO DO i = 1, 3 ! transform into primary basis @@ -486,9 +486,9 @@ SUBROUTINE linpot_rotinv_calc_forces(qs_env, iatom, M_blocks, forces) block_D(sgfa1:sgla1, sgfa2:sgla2) = MATMUL(TRANSPOSE(T1), MATMUL(dab(:, :, i), T2)) block_D(sgfa2:sgla2, sgfa1:sgla1) = TRANSPOSE(block_D(sgfa1:sgla1, sgfa2:sgla2)) ! calculate and add forces - f = SUM(block_M_full(:, :, lpot/2+1)*block_D) - forces(iatom, i) = forces(iatom, i)-f - forces(jatom, i) = forces(jatom, i)+f + f = SUM(block_M_full(:, :, lpot/2 + 1)*block_D) + forces(iatom, i) = forces(iatom, i) - f + forces(jatom, i) = forces(jatom, i) + f ENDDO ENDDO ! lpot ENDDO ! jatom diff --git a/src/pao_main.F b/src/pao_main.F index 3e80e14657..101c28063b 100644 --- a/src/pao_main.F +++ b/src/pao_main.F @@ -244,7 +244,7 @@ SUBROUTINE pao_update(qs_env, ls_scf_env, pao_is_done) CALL pao_opt_init(pao) DO WHILE (.TRUE.) - pao%istep = pao%istep+1 + pao%istep = pao%istep + 1 IF (pao%iw > 0) WRITE (pao%iw, "(A,I9,A)") " PAO| ======================= Iteration: ", & pao%istep, " =============================" @@ -254,7 +254,7 @@ SUBROUTINE pao_update(qs_env, ls_scf_env, pao_is_done) CALL pao_check_trace_PS(ls_scf_env) IF (pao%linesearch%starts) THEN - icycle = icycle+1 + icycle = icycle + 1 ! calc new gradient including penalty terms CALL pao_calc_outer_grad_lnv(qs_env, ls_scf_env, matrix_M) CALL pao_calc_U(pao, qs_env, matrix_M=matrix_M, matrix_G=pao%matrix_G, penalty=penalty) @@ -306,7 +306,7 @@ SUBROUTINE pao_update(qs_env, ls_scf_env, pao_is_done) ! perform mixing of matrix_X IF (do_mixing) THEN - CALL dbcsr_add(pao%matrix_X, matrix_X_mixing, pao%mixing, 1.0_dp-pao%mixing) + CALL dbcsr_add(pao%matrix_X, matrix_X_mixing, pao%mixing, 1.0_dp - pao%mixing) CALL dbcsr_release(matrix_X_mixing) IF (pao%iw > 0) WRITE (pao%iw, *) "PAO| Recalculating energy after mixing." CALL pao_calc_energy(pao, qs_env, ls_scf_env, energy) diff --git a/src/pao_methods.F b/src/pao_methods.F index 031c263e49..e1654bde62 100644 --- a/src/pao_methods.F +++ b/src/pao_methods.F @@ -218,8 +218,8 @@ SUBROUTINE pao_build_orthogonalizer(pao, qs_env) v = SQRT(evals(k)) DO i = 1, N DO j = 1, N - block_N(i, j) = block_N(i, j)+w*A(i, k)*A(j, k) - block_N_inv(i, j) = block_N_inv(i, j)+v*A(i, k)*A(j, k) + block_N(i, j) = block_N(i, j) + w*A(i, k)*A(j, k) + block_N_inv(i, j) = block_N_inv(i, j) + v*A(i, k)*A(j, k) ENDDO ENDDO ENDDO @@ -334,8 +334,8 @@ SUBROUTINE pao_build_diag_distribution(pao, qs_env) ! create new mapping of matrix-grid to processor-grid ALLOCATE (diag_row_dist(natoms), diag_col_dist(natoms)) DO iatom = 1, natoms - diag_row_dist(iatom) = MOD(iatom-1, pgrid_rows) - diag_col_dist(iatom) = MOD((iatom-1)/pgrid_rows, pgrid_cols) + diag_row_dist(iatom) = MOD(iatom - 1, pgrid_rows) + diag_col_dist(iatom) = MOD((iatom - 1)/pgrid_rows, pgrid_cols) ENDDO ! instanciate distribution object @@ -445,10 +445,10 @@ SUBROUTINE pao_test_convergence(pao, ls_scf_env, new_energy, is_converged) REAL(KIND=dp) :: energy_diff, loop_eps, now, time_diff ! calculate progress - energy_diff = new_energy-pao%energy_prev + energy_diff = new_energy - pao%energy_prev pao%energy_prev = new_energy now = m_walltime() - time_diff = now-pao%step_start_time + time_diff = now - pao%step_start_time pao%step_start_time = now ! convergence criterion @@ -504,11 +504,11 @@ SUBROUTINE pao_calc_energy(pao, qs_env, ls_scf_env, energy) energy = 0.0_dp DO ispin = 1, ls_scf_env%nspins CALL dbcsr_dot(ls_scf_env%matrix_p(ispin), ls_scf_env%matrix_ks(ispin), trace_PH) - energy = energy+trace_PH + energy = energy + trace_PH ENDDO ! add penalty term - energy = energy+penalty + energy = energy + penalty IF (pao%iw > 0) THEN WRITE (pao%iw, *) "" @@ -538,12 +538,12 @@ SUBROUTINE pao_check_trace_PS(ls_scf_env) trace_PS = 0.0_dp DO ispin = 1, ls_scf_env%nspins CALL dbcsr_dot(ls_scf_env%matrix_p(ispin), matrix_S_desym, tmp) - trace_PS = trace_PS+tmp + trace_PS = trace_PS + tmp ENDDO CALL dbcsr_release(matrix_S_desym) - IF (ABS(ls_scf_env%nelectron_total-trace_PS) > 0.5) & + IF (ABS(ls_scf_env%nelectron_total - trace_PS) > 0.5) & CPABORT("Number of electrons wrong. Trace(PS) ="//cp_to_string(trace_PS)) CALL timestop(handle) @@ -952,23 +952,23 @@ SUBROUTINE pao_check_grad(pao, qs_env, ls_scf_env) SELECT CASE (pao%num_grad_order) CASE (2) ! calculate derivative to 2th order Gij_num = -eval_point(block_X, i, j, -eps, pao, ls_scf_env, qs_env) - Gij_num = Gij_num+eval_point(block_X, i, j, +eps, pao, ls_scf_env, qs_env) + Gij_num = Gij_num + eval_point(block_X, i, j, +eps, pao, ls_scf_env, qs_env) Gij_num = Gij_num/(2.0_dp*eps) CASE (4) ! calculate derivative to 4th order Gij_num = eval_point(block_X, i, j, -2_dp*eps, pao, ls_scf_env, qs_env) - Gij_num = Gij_num-8_dp*eval_point(block_X, i, j, -1_dp*eps, pao, ls_scf_env, qs_env) - Gij_num = Gij_num+8_dp*eval_point(block_X, i, j, +1_dp*eps, pao, ls_scf_env, qs_env) - Gij_num = Gij_num-eval_point(block_X, i, j, +2_dp*eps, pao, ls_scf_env, qs_env) + Gij_num = Gij_num - 8_dp*eval_point(block_X, i, j, -1_dp*eps, pao, ls_scf_env, qs_env) + Gij_num = Gij_num + 8_dp*eval_point(block_X, i, j, +1_dp*eps, pao, ls_scf_env, qs_env) + Gij_num = Gij_num - eval_point(block_X, i, j, +2_dp*eps, pao, ls_scf_env, qs_env) Gij_num = Gij_num/(12.0_dp*eps) CASE (6) ! calculate derivative to 6th order Gij_num = -1_dp*eval_point(block_X, i, j, -3_dp*eps, pao, ls_scf_env, qs_env) - Gij_num = Gij_num+9_dp*eval_point(block_X, i, j, -2_dp*eps, pao, ls_scf_env, qs_env) - Gij_num = Gij_num-45_dp*eval_point(block_X, i, j, -1_dp*eps, pao, ls_scf_env, qs_env) - Gij_num = Gij_num+45_dp*eval_point(block_X, i, j, +1_dp*eps, pao, ls_scf_env, qs_env) - Gij_num = Gij_num-9_dp*eval_point(block_X, i, j, +2_dp*eps, pao, ls_scf_env, qs_env) - Gij_num = Gij_num+1_dp*eval_point(block_X, i, j, +3_dp*eps, pao, ls_scf_env, qs_env) + Gij_num = Gij_num + 9_dp*eval_point(block_X, i, j, -2_dp*eps, pao, ls_scf_env, qs_env) + Gij_num = Gij_num - 45_dp*eval_point(block_X, i, j, -1_dp*eps, pao, ls_scf_env, qs_env) + Gij_num = Gij_num + 45_dp*eval_point(block_X, i, j, +1_dp*eps, pao, ls_scf_env, qs_env) + Gij_num = Gij_num - 9_dp*eval_point(block_X, i, j, +2_dp*eps, pao, ls_scf_env, qs_env) + Gij_num = Gij_num + 1_dp*eval_point(block_X, i, j, +3_dp*eps, pao, ls_scf_env, qs_env) Gij_num = Gij_num/(60.0_dp*eps) CASE DEFAULT @@ -976,7 +976,7 @@ SUBROUTINE pao_check_grad(pao, qs_env, ls_scf_env) END SELECT IF (ASSOCIATED(block_X)) THEN - delta = ABS(Gij_num-block_G(i, j)) + delta = ABS(Gij_num - block_G(i, j)) delta_max = MAX(delta_max, delta) !WRITE (*,*) "gradient check", iatom, i, j, Gij_num, block_G(i,j), delta ENDIF @@ -1018,7 +1018,7 @@ FUNCTION eval_point(block_X, i, j, eps, pao, ls_scf_env, qs_env) RESULT(energy) IF (ASSOCIATED(block_X)) THEN old_Xij = block_X(i, j) ! backup old block_X - block_X(i, j) = block_X(i, j)+eps ! add pertubation + block_X(i, j) = block_X(i, j) + eps ! add pertubation ENDIF ! calculate energy @@ -1054,8 +1054,8 @@ SUBROUTINE pao_store_P(qs_env, ls_scf_env) pao => ls_scf_env%pao_env CALL get_qs_env(qs_env, dft_control=dft_control, matrix_s=matrix_s) - ls_scf_env%scf_history%istore = ls_scf_env%scf_history%istore+1 - istore = MOD(ls_scf_env%scf_history%istore-1, ls_scf_env%scf_history%nstore)+1 + ls_scf_env%scf_history%istore = ls_scf_env%scf_history%istore + 1 + istore = MOD(ls_scf_env%scf_history%istore - 1, ls_scf_env%scf_history%nstore) + 1 IF (pao%iw > 0) WRITE (pao%iw, *) "PAO| Storing density matrix for ASPC guess in slot:", istore ! initialize storage @@ -1149,9 +1149,9 @@ SUBROUTINE pao_aspc_guess_P(pao, qs_env, ls_scf_env) ! actual extrapolation CALL dbcsr_set(matrix_P, 0.0_dp) DO iaspc = 1, naspc - alpha = (-1.0_dp)**(iaspc+1)*REAL(iaspc, KIND=dp)* & - binomial(2*naspc, naspc-iaspc)/binomial(2*naspc-2, naspc-1) - istore = MOD(ls_scf_env%scf_history%istore-iaspc, ls_scf_env%scf_history%nstore)+1 + alpha = (-1.0_dp)**(iaspc + 1)*REAL(iaspc, KIND=dp)* & + binomial(2*naspc, naspc - iaspc)/binomial(2*naspc - 2, naspc - 1) + istore = MOD(ls_scf_env%scf_history%istore - iaspc, ls_scf_env%scf_history%nstore) + 1 CALL dbcsr_add(matrix_P, ls_scf_env%scf_history%matrix(ispin, istore), 1.0_dp, alpha) ENDDO @@ -1228,7 +1228,7 @@ SUBROUTINE pao_add_forces(qs_env, ls_scf_env) CALL mp_sum(forces, para_env%group) DO iatom = 1, natoms - particle_set(iatom)%f = particle_set(iatom)%f+forces(iatom, :) + particle_set(iatom)%f = particle_set(iatom)%f + forces(iatom, :) ENDDO DEALLOCATE (forces) diff --git a/src/pao_ml.F b/src/pao_ml.F index b03f4d23fe..d0aff52bc2 100644 --- a/src/pao_ml.F +++ b/src/pao_ml.F @@ -219,7 +219,7 @@ SUBROUTINE add_to_training_list(pao, qs_env, training_lists, filename) ALLOCATE (new_point) ! training-point input, calculate descriptor only on one rank - IF (MOD(iatom-1, para_env%num_pe) == para_env%mepos) THEN + IF (MOD(iatom - 1, para_env%num_pe) == para_env%mepos) THEN CALL pao_ml_calc_descriptor(pao, & my_particle_set, & qs_kind_set, & @@ -237,7 +237,7 @@ SUBROUTINE add_to_training_list(pao, qs_env, training_lists, filename) ! add to linked list ikind = kindsmap(atom2kind(iatom)) - training_lists(ikind)%npoints = training_lists(ikind)%npoints+1 + training_lists(ikind)%npoints = training_lists(ikind)%npoints + 1 new_point%next => training_lists(ikind)%head training_lists(ikind)%head => new_point ENDDO @@ -367,11 +367,11 @@ SUBROUTINE training_list2matrix(training_lists, training_matrices, para_env) DO i = 1, npoints IF (ALLOCATED(cur_point%input)) THEN training_matrix%inputs(:, i) = cur_point%input(:) - ninputs = ninputs+1 + ninputs = ninputs + 1 ENDIF IF (ALLOCATED(cur_point%output)) THEN training_matrix%outputs(:, i) = cur_point%output(:) - noutputs = noutputs+1 + noutputs = noutputs + 1 ENDIF ! advance to next entry and deallocate the current one prev_point => cur_point @@ -423,7 +423,7 @@ SUBROUTINE pao_ml_substract_prior(ml_prior, training_matrices) ! substract prior from all training points DO i = 1, npoints - training_matrix%outputs(:, i) = training_matrix%outputs(:, i)-training_matrix%prior + training_matrix%outputs(:, i) = training_matrix%outputs(:, i) - training_matrix%prior ENDDO ENDDO @@ -560,7 +560,7 @@ SUBROUTINE pao_ml_predict(pao, qs_env) DEALLOCATE (descriptor) !add prior - block_X(:, 1) = block_X(:, 1)+pao%ml_training_matrices(ikind)%prior + block_X(:, 1) = block_X(:, 1) + pao%ml_training_matrices(ikind)%prior ENDDO CALL dbcsr_iterator_stop(iter) !$OMP END PARALLEL diff --git a/src/pao_ml_descriptor.F b/src/pao_ml_descriptor.F index 56c6abb594..6165355f93 100644 --- a/src/pao_ml_descriptor.F +++ b/src/pao_ml_descriptor.F @@ -149,15 +149,15 @@ SUBROUTINE calc_descriptor_pot(particle_set, qs_kind_set, cell, iatom, descripto ! use eigenvalues of V_block as descriptor IF (PRESENT(descriptor)) & - descriptor((idesc-1)*N+1:idesc*N) = V_evals(:) + descriptor((idesc - 1)*N + 1:idesc*N) = V_evals(:) ! FORCES ---------------------------------------------------------------------------------- IF (PRESENT(forces)) THEN CPASSERT(PRESENT(descr_grad)) block_M = 0.0_dp DO k = 1, N - w = descr_grad((idesc-1)*N+k) - block_M(:, :) = block_M(:, :)+w*MATMUL(V_evecs(:, k:k), TRANSPOSE(V_evecs(:, k:k))) + w = descr_grad((idesc - 1)*N + k) + block_M(:, :) = block_M(:, :) + w*MATMUL(V_evecs(:, k:k), TRANSPOSE(V_evecs(:, k:k))) ENDDO DO jatom = 1, natoms IF (jatom == iatom) CYCLE @@ -171,8 +171,8 @@ SUBROUTINE calc_descriptor_pot(particle_set, qs_kind_set, cell, iatom, descripto block_D = 0.0_dp CALL pao_calc_gaussian(basis_set, block_D=block_D, Rab=Rab, lpot=0, beta=beta, weight=weight) DO i = 1, 3 - forces(iatom, i) = forces(iatom, i)-SUM(block_M*block_D(:, :, i)) - forces(jatom, i) = forces(jatom, i)+SUM(block_M*block_D(:, :, i)) + forces(iatom, i) = forces(iatom, i) - SUM(block_M*block_D(:, :, i)) + forces(jatom, i) = forces(jatom, i) + SUM(block_M*block_D(:, :, i)) ENDDO ENDDO ENDIF @@ -252,7 +252,7 @@ SUBROUTINE calc_descriptor_overlap(particle_set, qs_kind_set, cell, iatom, descr ! check if N was choosen large enough IF (natoms > N) THEN - IF (neighbor_dist(N+1) < screening_radius) & + IF (neighbor_dist(N + 1) < screening_radius) & CPABORT("PAO heuristic for descriptor size broke down") ENDIF @@ -277,7 +277,7 @@ SUBROUTINE calc_descriptor_overlap(particle_set, qs_kind_set, cell, iatom, descr jbeta = jpao_descriptors(idesc)%beta kweight = kpao_descriptors(idesc)%weight kbeta = kpao_descriptors(idesc)%beta - beta_sum = sbeta+jbeta+kbeta + beta_sum = sbeta + jbeta + kbeta ! get distances Rj = particle_set(jatom)%r @@ -290,7 +290,7 @@ SUBROUTINE calc_descriptor_overlap(particle_set, qs_kind_set, cell, iatom, descr Rjk2 = SUM(Rjk**2) ! calculate integral over three Gaussians - exponent = -(sbeta*jbeta*Rij2+sbeta*kbeta*Rik2+jbeta*kbeta*Rjk2)/beta_sum + exponent = -(sbeta*jbeta*Rij2 + sbeta*kbeta*Rik2 + jbeta*kbeta*Rjk2)/beta_sum integral = EXP(exponent)*rootpi/SQRT(beta_sum) normalization = SQRT(jbeta*kbeta)/rootpi**2 block_S(j, k) = jweight*kweight*normalization*integral @@ -303,15 +303,15 @@ SUBROUTINE calc_descriptor_overlap(particle_set, qs_kind_set, cell, iatom, descr ! use eigenvalues of S_block as descriptor IF (PRESENT(descriptor)) & - descriptor((idesc-1)*N+1:idesc*N) = S_evals(:) + descriptor((idesc - 1)*N + 1:idesc*N) = S_evals(:) ! FORCES ---------------------------------------------------------------------------------- IF (PRESENT(forces)) THEN CPASSERT(PRESENT(descr_grad)) block_M = 0.0_dp DO k = 1, N - w = descr_grad((idesc-1)*N+k) - block_M(:, :) = block_M(:, :)+w*MATMUL(S_evecs(:, k:k), TRANSPOSE(S_evecs(:, k:k))) + w = descr_grad((idesc - 1)*N + k) + block_M(:, :) = block_M(:, :) + w*MATMUL(S_evecs(:, k:k), TRANSPOSE(S_evecs(:, k:k))) ENDDO DO j = 1, MIN(natoms, N) @@ -328,7 +328,7 @@ SUBROUTINE calc_descriptor_overlap(particle_set, qs_kind_set, cell, iatom, descr jbeta = jpao_descriptors(idesc)%beta kweight = kpao_descriptors(idesc)%weight kbeta = kpao_descriptors(idesc)%beta - beta_sum = sbeta+jbeta+kbeta + beta_sum = sbeta + jbeta + kbeta ! get distances Rj = particle_set(jatom)%r @@ -341,17 +341,17 @@ SUBROUTINE calc_descriptor_overlap(particle_set, qs_kind_set, cell, iatom, descr Rjk2 = SUM(Rjk**2) ! calculate integral over three Gaussians - exponent = -(sbeta*jbeta*Rij2+sbeta*kbeta*Rik2+jbeta*kbeta*Rjk2)/beta_sum + exponent = -(sbeta*jbeta*Rij2 + sbeta*kbeta*Rik2 + jbeta*kbeta*Rjk2)/beta_sum integral = EXP(exponent)*rootpi/SQRT(beta_sum) normalization = SQRT(jbeta*kbeta)/rootpi**2 deriv = 2.0_dp/beta_sum*block_M(j, k) w = jweight*kweight*normalization*integral*deriv - forces(iatom, :) = forces(iatom, :)-sbeta*jbeta*Rij*w - forces(jatom, :) = forces(jatom, :)+sbeta*jbeta*Rij*w - forces(iatom, :) = forces(iatom, :)-sbeta*kbeta*Rik*w - forces(katom, :) = forces(katom, :)+sbeta*kbeta*Rik*w - forces(jatom, :) = forces(jatom, :)-jbeta*kbeta*Rjk*w - forces(katom, :) = forces(katom, :)+jbeta*kbeta*Rjk*w + forces(iatom, :) = forces(iatom, :) - sbeta*jbeta*Rij*w + forces(jatom, :) = forces(jatom, :) + sbeta*jbeta*Rij*w + forces(iatom, :) = forces(iatom, :) - sbeta*kbeta*Rik*w + forces(katom, :) = forces(katom, :) + sbeta*kbeta*Rik*w + forces(jatom, :) = forces(jatom, :) - jbeta*kbeta*Rjk*w + forces(katom, :) = forces(katom, :) + jbeta*kbeta*Rjk*w ENDDO ENDDO ENDIF @@ -399,8 +399,8 @@ SUBROUTINE calc_descriptor_r12(particle_set, qs_kind_set, cell, iatom, descripto IF (PRESENT(forces)) THEN CPASSERT(PRESENT(descr_grad)) G = R12/SQRT(SUM(R12**2))*descr_grad(1) - forces(1, :) = forces(1, :)+G - forces(2, :) = forces(2, :)-G + forces(1, :) = forces(1, :) + G + forces(2, :) = forces(2, :) - G ENDIF END SUBROUTINE calc_descriptor_r12 diff --git a/src/pao_ml_gaussprocess.F b/src/pao_ml_gaussprocess.F index 258a94ed99..4f4d185f45 100644 --- a/src/pao_ml_gaussprocess.F +++ b/src/pao_ml_gaussprocess.F @@ -57,7 +57,7 @@ SUBROUTINE pao_ml_gp_train(pao) ! add noise of training data DO i = 1, npoints - training_matrix%GP(i, i) = training_matrix%GP(i, i)+pao%gp_noise_var**2 + training_matrix%GP(i, i) = training_matrix%GP(i, i) + pao%gp_noise_var**2 ENDDO ! compute cholesky decomposition of covariance matrix @@ -104,11 +104,11 @@ SUBROUTINE pao_ml_gp_predict(pao, ikind, descriptor, output, variance) ! calculate predicted output output = 0.0_dp DO i = 1, npoints - output(:) = output+weights(i)*training_matrix%outputs(:, i) + output(:) = output + weights(i)*training_matrix%outputs(:, i) ENDDO ! calculate prediction's variance - variance = kernel(pao%gp_scale, descriptor, descriptor)-DOT_PRODUCT(weights, cov) + variance = kernel(pao%gp_scale, descriptor, descriptor) - DOT_PRODUCT(weights, cov) IF (variance < 0.0_dp) & CPABORT("PAO gaussian process found negative variance") @@ -155,7 +155,7 @@ SUBROUTINE pao_ml_gp_gradient(pao, ikind, descriptor, outer_deriv, gradient) gradient(:) = 0.0_dp DO i = 1, npoints kg = kernel_grad(pao%gp_scale, descriptor, training_matrix%inputs(:, i)) - gradient(:) = gradient(:)+kg(:)*cov_deriv(i) + gradient(:) = gradient(:) + kg(:)*cov_deriv(i) ENDDO DEALLOCATE (cov_deriv, weights_deriv) @@ -176,7 +176,7 @@ PURE FUNCTION kernel(scale, descr1, descr2) RESULT(cov) REAL(dp) :: fdist2 REAL(dp), DIMENSION(SIZE(descr1)) :: diff - diff = descr1-descr2 + diff = descr1 - descr2 fdist2 = SUM((diff/scale)**2) cov = EXP(-fdist2/2.0_dp) END FUNCTION kernel @@ -196,7 +196,7 @@ PURE FUNCTION kernel_grad(scale, descr1, descr2) RESULT(grad) REAL(dp) :: cov, fdist2 REAL(dp), DIMENSION(SIZE(descr1)) :: diff - diff = descr1-descr2 + diff = descr1 - descr2 fdist2 = SUM((diff/scale)**2) cov = EXP(-fdist2/2.0_dp) grad(:) = cov*(-diff/scale**2) diff --git a/src/pao_ml_neuralnet.F b/src/pao_ml_neuralnet.F index 107b592b65..05344ee199 100644 --- a/src/pao_ml_neuralnet.F +++ b/src/pao_ml_neuralnet.F @@ -92,7 +92,7 @@ SUBROUTINE pao_ml_nn_gradient(pao, ikind, descriptor, outer_deriv, gradient) DO ilayer = 1, nlayers DO i = 1, width DO j = 1, width - forward(ilayer, i) = forward(ilayer, i)+A(ilayer, i, j)*TANH(forward(ilayer-1, j)) + forward(ilayer, i) = forward(ilayer, i) + A(ilayer, i, j)*TANH(forward(ilayer - 1, j)) ENDDO ENDDO ENDDO @@ -104,7 +104,7 @@ SUBROUTINE pao_ml_nn_gradient(pao, ikind, descriptor, outer_deriv, gradient) DO ilayer = nlayers, 1, -1 DO i = 1, width DO j = 1, width - backward(ilayer-1, j) = backward(ilayer-1, j)+backward(ilayer, i)*A(ilayer, i, j)*(1.0_dp-TANH(forward(ilayer-1, j))**2) + backward(ilayer - 1, j) = backward(ilayer - 1, j) + backward(ilayer, i)*A(ilayer, i, j)*(1.0_dp - TANH(forward(ilayer - 1, j))**2) ENDDO ENDDO ENDDO @@ -154,7 +154,7 @@ SUBROUTINE pao_ml_nn_train(pao) DO ilayer = 1, nlayers DO i = 1, width DO j = 1, width - training_matrix%NN(ilayer, i, j) = -1.0_dp+2.0_dp*next_random_number(rng_stream) + training_matrix%NN(ilayer, i, j) = -1.0_dp + 2.0_dp*next_random_number(rng_stream) ENDDO ENDDO ENDDO @@ -172,7 +172,7 @@ SUBROUTINE pao_ml_nn_train(pao) gradient=gradient, & error=error) ENDDO - training_matrix%NN(:, :, :) = training_matrix%NN-step_size*gradient + training_matrix%NN(:, :, :) = training_matrix%NN - step_size*gradient IF (pao%iw > 0 .AND. MOD(icycle, 100) == 0) WRITE (pao%iw, *) & "PAO|ML| ", TRIM(training_matrix%kindname), & @@ -199,20 +199,20 @@ SUBROUTINE pao_ml_nn_train(pao) DO j = 1, width bak = training_matrix%NN(ilayer, i, j) - training_matrix%NN(ilayer, i, j) = bak+eps + training_matrix%NN(ilayer, i, j) = bak + eps CALL nn_eval(training_matrix%NN, & input=training_matrix%inputs(:, ipoint), & prediction=prediction) - error1 = SUM((training_matrix%outputs(:, ipoint)-prediction)**2) + error1 = SUM((training_matrix%outputs(:, ipoint) - prediction)**2) - training_matrix%NN(ilayer, i, j) = bak-eps + training_matrix%NN(ilayer, i, j) = bak - eps CALL nn_eval(training_matrix%NN, & input=training_matrix%inputs(:, ipoint), & prediction=prediction) - error2 = SUM((training_matrix%outputs(:, ipoint)-prediction)**2) + error2 = SUM((training_matrix%outputs(:, ipoint) - prediction)**2) training_matrix%NN(ilayer, i, j) = bak - num_grad = (error1-error2)/(2.0_dp*eps) + num_grad = (error1 - error2)/(2.0_dp*eps) IF (pao%iw > 0) WRITE (pao%iw, *) "PAO|ML| Numeric gradient:", i, j, gradient(ilayer, i, j), num_grad ENDDO @@ -229,7 +229,7 @@ SUBROUTINE pao_ml_nn_train(pao) CALL nn_eval(training_matrix%NN, & input=training_matrix%inputs(:, ipoint), & prediction=prediction) - error = MAXVAL(ABS(training_matrix%outputs(:, ipoint)-prediction)) + error = MAXVAL(ABS(training_matrix%outputs(:, ipoint) - prediction)) IF (pao%iw > 0) WRITE (pao%iw, *) "PAO|ML| ", TRIM(training_matrix%kindname), & " verify training-point:", ipoint, "SQRT(error):", SQRT(error) ENDDO @@ -267,7 +267,7 @@ SUBROUTINE nn_eval(A, input, prediction) DO ilayer = 1, nlayers DO i = 1, width DO j = 1, width - forward(ilayer, i) = forward(ilayer, i)+A(ilayer, i, j)*TANH(forward(ilayer-1, j)) + forward(ilayer, i) = forward(ilayer, i) + A(ilayer, i, j)*TANH(forward(ilayer - 1, j)) ENDDO ENDDO ENDDO @@ -308,24 +308,24 @@ SUBROUTINE nn_backpropagate(A, input, goal, error, gradient) DO ilayer = 1, nlayers DO i = 1, width DO j = 1, width - forward(ilayer, i) = forward(ilayer, i)+A(ilayer, i, j)*TANH(forward(ilayer-1, j)) + forward(ilayer, i) = forward(ilayer, i) + A(ilayer, i, j)*TANH(forward(ilayer - 1, j)) ENDDO ENDDO ENDDO prediction(:) = forward(nlayers, 1:width_out) - error = error+SUM((prediction-goal)**2) + error = error + SUM((prediction - goal)**2) ! Turning Point ------------------------------------------------------------------------------ backward = 0.0_dp - backward(nlayers, 1:width_out) = prediction-goal + backward(nlayers, 1:width_out) = prediction - goal DO ilayer = nlayers, 1, -1 DO i = 1, width DO j = 1, width - gradient(ilayer, i, j) = gradient(ilayer, i, j)+2.0_dp*backward(ilayer, i)*TANH(forward(ilayer-1, j)) - backward(ilayer-1, j) = backward(ilayer-1, j)+backward(ilayer, i)*A(ilayer, i, j)*(1.0_dp-TANH(forward(ilayer-1, j))**2) + gradient(ilayer, i, j) = gradient(ilayer, i, j) + 2.0_dp*backward(ilayer, i)*TANH(forward(ilayer - 1, j)) + backward(ilayer - 1, j) = backward(ilayer - 1, j) + backward(ilayer, i)*A(ilayer, i, j)*(1.0_dp - TANH(forward(ilayer - 1, j))**2) ENDDO ENDDO ENDDO diff --git a/src/pao_optimizer.F b/src/pao_optimizer.F index 185ed231a8..c4a58df796 100644 --- a/src/pao_optimizer.F +++ b/src/pao_optimizer.F @@ -189,7 +189,7 @@ SUBROUTINE pao_opt_newdir_cg(pao, icycle, matrix_G, matrix_G_prev, matrix_D) IF (pao%iw_opt > 0) WRITE (pao%iw_opt, *) "PAO|CG| trace_D_Gnew", trace_D_Gnew IF (trace_G_prev /= 0.0_dp) THEN - beta = (trace_G_new-trace_G_mix)/trace_G_prev !Polak-Ribiere + beta = (trace_G_new - trace_G_mix)/trace_G_prev !Polak-Ribiere ENDIF IF (beta < 0.0_dp) THEN @@ -270,7 +270,7 @@ SUBROUTINE pao_opt_newdir_bfgs(pao, icycle, matrix_G, matrix_G_prev, matrix_D) ! See chapter 18 in Nocedal and Wright's book for details. ! The formulas were adopted to inverse Hessian algorithm. IF (trace_sy < 0.2_dp*trace_yHy) THEN - theta = 0.8_dp*trace_yHy/(trace_yHy-trace_sy) + theta = 0.8_dp*trace_yHy/(trace_yHy - trace_sy) IF (pao%iw_opt > 0) WRITE (pao%iw_opt, *) "PAO|BFGS| Dampening theta:", theta ELSE theta = 1.0 @@ -278,7 +278,7 @@ SUBROUTINE pao_opt_newdir_bfgs(pao, icycle, matrix_G, matrix_G_prev, matrix_D) ! r = theta*s + (1-theta)*Hy CALL dbcsr_copy(matrix_r, matrix_s) - CALL dbcsr_add(matrix_r, matrix_Hy, theta, (1.0_dp-theta)) + CALL dbcsr_add(matrix_r, matrix_Hy, theta, (1.0_dp - theta)) ! use t instead of y to update B matrix CALL dbcsr_dot(matrix_r, matrix_y, trace_ry) diff --git a/src/pao_param.F b/src/pao_param.F index 9189390f74..2b811f17c0 100644 --- a/src/pao_param.F +++ b/src/pao_param.F @@ -330,7 +330,7 @@ SUBROUTINE pao_assert_unitary(pao) tmp1 = block_test(:, 1:M) tmp2 = MATMUL(TRANSPOSE(tmp1), tmp1) DO i = 1, M - tmp2(i, i) = tmp2(i, i)-1.0_dp + tmp2(i, i) = tmp2(i, i) - 1.0_dp ENDDO !$OMP ATOMIC diff --git a/src/pao_param_exp.F b/src/pao_param_exp.F index bb2240d1c5..b7d5debaec 100644 --- a/src/pao_param_exp.F +++ b/src/pao_param_exp.F @@ -83,7 +83,7 @@ SUBROUTINE pao_param_init_exp(pao, qs_env) ! construct H ALLOCATE (block_H(N, N)) - block_H = MATMUL(MATMUL(block_N, block_H0+block_V0), block_N) ! transform into orthonormal basis + block_H = MATMUL(MATMUL(block_N, block_H0 + block_V0), block_N) ! transform into orthonormal basis ! diagonalize H ALLOCATE (H_evecs(N, N), H_evals(N)) @@ -142,7 +142,7 @@ SUBROUTINE pao_param_count_exp(qs_env, ikind, nparams) ! we only consider rotations between occupied and virtuals rows = pao_basis_size - cols = pri_basis_size-pao_basis_size + cols = pri_basis_size - pao_basis_size nparams = rows*cols END SUBROUTINE pao_param_count_exp @@ -211,8 +211,8 @@ SUBROUTINE pao_calc_U_exp(pao, matrix_M, matrix_G) ALLOCATE (block_X_full(N, N)) block_X_full(:, :) = 0.0_dp DO i = 1, nparams - block_X_full(MOD(i-1, M)+1, M+(i-1)/M+1) = +block_X(i, 1) - block_X_full(M+(i-1)/M+1, MOD(i-1, M)+1) = -block_X(i, 1) + block_X_full(MOD(i - 1, M) + 1, M + (i - 1)/M + 1) = +block_X(i, 1) + block_X_full(M + (i - 1)/M + 1, MOD(i - 1, M) + 1) = -block_X(i, 1) ENDDO ! diagonalize block_X_full @@ -224,7 +224,7 @@ SUBROUTINE pao_calc_U_exp(pao, matrix_M, matrix_G) DO k = 1, N DO i = 1, N DO j = 1, N - block_U(i, j) = block_U(i, j)+REAL(EXP(evals(k))*evecs(i, k)*CONJG(evecs(j, k)), dp) + block_U(i, j) = block_U(i, j) + REAL(EXP(evals(k))*evecs(i, k)*CONJG(evecs(j, k)), dp) ENDDO ENDDO ENDDO @@ -243,11 +243,11 @@ SUBROUTINE pao_calc_U_exp(pao, matrix_M, matrix_G) ALLOCATE (block_D(N, N), block_tmp(N, N), block_G_full(N, N)) DO i = 1, N DO j = 1, N - denom = evals(i)-evals(j) + denom = evals(i) - evals(j) IF (i == j) THEN block_D(i, i) = EXP(evals(i)) ! diagonal elements ELSE IF (ABS(denom) > 1e-10_dp) THEN - block_D(i, j) = (EXP(evals(i))-EXP(evals(j)))/denom + block_D(i, j) = (EXP(evals(i)) - EXP(evals(j)))/denom ELSE block_D(i, j) = 1.0_dp ! limit according to L'Hospital's rule ENDIF @@ -263,7 +263,7 @@ SUBROUTINE pao_calc_U_exp(pao, matrix_M, matrix_G) ! return only gradient for rotations between occupied and virtuals DO i = 1, nparams - block_G(i, 1) = 2.0_dp*block_G_full(MOD(i-1, M)+1, M+(i-1)/M+1) + block_G(i, 1) = 2.0_dp*block_G_full(MOD(i - 1, M) + 1, M + (i - 1)/M + 1) ENDDO DEALLOCATE (block_D, block_tmp, block_G_full) @@ -308,7 +308,7 @@ FUNCTION fold_derivatives(M, D, R) RESULT(G) RFR = REAL(MATMUL(RF, TRANSPOSE(CONJG(R)))) ! gradient dE/dX has to be anti-symmetric - G = 0.5_dp*(TRANSPOSE(RFR)-RFR) + G = 0.5_dp*(TRANSPOSE(RFR) - RFR) DEALLOCATE (RM, RMR, F, RF, RFR) END FUNCTION fold_derivatives @@ -330,7 +330,7 @@ SUBROUTINE diag_antisym(matrix, evecs, evals) INTEGER :: N REAL(dp), DIMENSION(:), POINTER :: evals_r - IF (MAXVAL(ABS(matrix+TRANSPOSE(matrix))) > 1e-14_dp) CPABORT("Expected anti-symmetric matrix") + IF (MAXVAL(ABS(matrix + TRANSPOSE(matrix))) > 1e-14_dp) CPABORT("Expected anti-symmetric matrix") N = SIZE(matrix, 1) ALLOCATE (matrix_c(N, N), evals_r(N)) @@ -362,7 +362,7 @@ SUBROUTINE zheevd_wrapper(matrix, eigenvectors, eigenvalues) CALL timeset(routineN, handle) IF (SIZE(matrix, 1) /= SIZE(matrix, 2)) CPABORT("expected square matrix") - IF (MAXVAL(ABS(matrix-CONJG(TRANSPOSE(matrix)))) > 1e-14_dp) CPABORT("Expect hermitian matrix") + IF (MAXVAL(ABS(matrix - CONJG(TRANSPOSE(matrix)))) > 1e-14_dp) CPABORT("Expect hermitian matrix") n = SIZE(matrix, 1) ALLOCATE (iwork(1), rwork(1), work(1), A(n, n)) diff --git a/src/pao_param_fock.F b/src/pao_param_fock.F index 595a42589e..92de28e8fb 100644 --- a/src/pao_param_fock.F +++ b/src/pao_param_fock.F @@ -63,7 +63,7 @@ SUBROUTINE pao_calc_U_block_fock(pao, iatom, V, U, penalty, gap, evals, M1, G) CPASSERT(ASSOCIATED(H0)) CALL dbcsr_get_block_p(matrix=pao%matrix_N_diag, row=iatom, col=iatom, block=block_N, found=found) CPASSERT(ASSOCIATED(block_N)) - IF (MAXVAL(ABS(V-TRANSPOSE(V))) > 1e-14_dp) CPABORT("Expect symmetric matrix") + IF (MAXVAL(ABS(V - TRANSPOSE(V))) > 1e-14_dp) CPABORT("Expect symmetric matrix") ! figure out basis sizes CALL dbcsr_get_info(pao%matrix_Y, row_blk_size=blk_sizes_pri, col_blk_size=blk_sizes_pao) @@ -72,7 +72,7 @@ SUBROUTINE pao_calc_U_block_fock(pao, iatom, V, U, penalty, gap, evals, M1, G) ! calculate H in the orthonormal basis ALLOCATE (H(n, n)) - H = MATMUL(MATMUL(block_N, H0+V), block_N) + H = MATMUL(MATMUL(block_N, H0 + V), block_N) ! diagonalize H ALLOCATE (H_evals(n), H_evecs(n, n)) @@ -87,29 +87,29 @@ SUBROUTINE pao_calc_U_block_fock(pao, iatom, V, U, penalty, gap, evals, M1, G) CPASSERT(MOD(SIZE(evals), 2) == 0) ! gap will be exactely in the middle i = SIZE(evals)/2 j = MIN(m, i) - evals(1+i-j:i) = H_evals(1+m-j:m) ! eigenvalues below gap - j = MIN(n-m, i) - evals(i:i+j) = H_evals(m:m+j) ! eigenvalues above gap + evals(1 + i - j:i) = H_evals(1 + m - j:m) ! eigenvalues below gap + j = MIN(n - m, i) + evals(i:i + j) = H_evals(m:m + j) ! eigenvalues above gap ENDIF ! calculate homo-lumo gap (it's useful for detecting numerical issues) gap = HUGE(dp) IF (m < n) & ! catch special case n==m - gap = H_evals(m+1)-H_evals(m) + gap = H_evals(m + 1) - H_evals(m) IF (PRESENT(penalty)) THEN ! penalty terms: occupied and virtual eigenvalues repel each other alpha = pao%penalty_strength beta = pao%penalty_dist DO i = 1, m - DO j = m+1, n - diff = H_evals(i)-H_evals(j) - penalty = penalty+alpha*EXP(-(diff/beta)**2) + DO j = m + 1, n + diff = H_evals(i) - H_evals(j) + penalty = penalty + alpha*EXP(-(diff/beta)**2) ENDDO ENDDO ! regularization energy - penalty = penalty+pao%regularization*SUM(V**2) + penalty = penalty + pao%regularization*SUM(V**2) ENDIF IF (PRESENT(G)) THEN ! TURNING POINT (if calc grad) ------------------------- @@ -126,7 +126,7 @@ SUBROUTINE pao_calc_U_block_fock(pao, iatom, V, U, penalty, gap, evals, M1, G) IF (i <= m .EQV. j <= m) THEN D1(i, j) = 0.0_dp ELSE - denom = H_evals(i)-H_evals(j) + denom = H_evals(i) - H_evals(j) IF (ABS(denom) > 1e-9_dp) THEN ! avoid division by zero D1(i, j) = 1.0_dp/denom ELSE @@ -150,11 +150,11 @@ SUBROUTINE pao_calc_U_block_fock(pao, iatom, V, U, penalty, gap, evals, M1, G) DO i = 1, n DO j = 1, n IF (i <= m .EQV. j <= m) CYCLE - diff = H_evals(i)-H_evals(j) - D2(i, i) = D2(i, i)-2.0_dp*alpha*diff/beta**2*EXP(-(diff/beta)**2) + diff = H_evals(i) - H_evals(j) + D2(i, i) = D2(i, i) - 2.0_dp*alpha*diff/beta**2*EXP(-(diff/beta)**2) ENDDO ENDDO - M4 = M4+MATMUL(MATMUL(H_evecs, D2), TRANSPOSE(H_evecs)) + M4 = M4 + MATMUL(MATMUL(H_evecs, D2), TRANSPOSE(H_evecs)) DEALLOCATE (D2) ENDIF @@ -164,10 +164,10 @@ SUBROUTINE pao_calc_U_block_fock(pao, iatom, V, U, penalty, gap, evals, M1, G) ! add regularization gradient IF (PRESENT(penalty)) & - M5 = M5+2.0_dp*pao%regularization*V + M5 = M5 + 2.0_dp*pao%regularization*V ! symmetrize - G = 0.5_dp*(M5+TRANSPOSE(M5)) ! the final gradient + G = 0.5_dp*(M5 + TRANSPOSE(M5)) ! the final gradient DEALLOCATE (D1, M2, M3, M4, M5) ENDIF diff --git a/src/pao_param_gth.F b/src/pao_param_gth.F index 246ac29a30..0064dcb516 100644 --- a/src/pao_param_gth.F +++ b/src/pao_param_gth.F @@ -110,7 +110,7 @@ SUBROUTINE pao_param_init_gth(pao, qs_env) DO jatom = 1, natoms IF (jatom == iatom) CYCLE ! waste some storage to simplify things later DO iterm = 1, nterms(jatom) - idx = SUM(nterms(1:jatom-1))+iterm + idx = SUM(nterms(1:jatom - 1)) + iterm block_V_term(1:n, 1:n) => vec_V_terms(:, idx) ! map column into matrix CALL gth_calc_term(qs_env, block_V_term, iatom, jatom, iterm) ENDDO @@ -180,8 +180,8 @@ SUBROUTINE pao_param_gth_preconditioner(pao, qs_env, nterms) DO iatom = 1, natoms DO jatom = 1, natoms - ioffset = SUM(nterms(1:iatom-1)) - joffset = SUM(nterms(1:jatom-1)) + ioffset = SUM(nterms(1:iatom - 1)) + joffset = SUM(nterms(1:jatom - 1)) n = nterms(iatom) m = nterms(jatom) @@ -195,7 +195,7 @@ SUBROUTINE pao_param_gth_preconditioner(pao, qs_env, nterms) CPASSERT(arow == acol) DO i = 1, n DO j = 1, m - block(i, j) = block(i, j)+SUM(block_V_term(:, ioffset+i)*block_V_term(:, joffset+j)) + block(i, j) = block(i, j) + SUM(block_V_term(:, ioffset + i)*block_V_term(:, joffset + j)) ENDDO ENDDO ENDDO @@ -275,8 +275,8 @@ SUBROUTINE pao_calc_U_gth(pao, penalty, matrix_M1, matrix_G) DO WHILE (dbcsr_iterator_blocks_left(iter)) CALL dbcsr_iterator_next_block(iter, arow, acol, block_X) iatom = arow; CPASSERT(arow == acol) - idx = SUM(nterms(1:iatom-1)) - world_X(idx+1:idx+nterms(iatom)) = block_X(:, 1) + idx = SUM(nterms(1:iatom - 1)) + world_X(idx + 1:idx + nterms(iatom)) = block_X(:, 1) ENDDO CALL dbcsr_iterator_stop(iter) CALL mp_sum(world_X, group) ! sync world view across MPI ranks @@ -295,7 +295,7 @@ SUBROUTINE pao_calc_U_gth(pao, penalty, matrix_M1, matrix_G) block_V = 0.0_dp DO iterm = 1, SIZE(world_X) block_V_term(1:n, 1:n) => vec_V_terms(:, iterm) ! map column into matrix - block_V = block_V+world_X(iterm)*block_V_term + block_V = block_V + world_X(iterm)*block_V_term ENDDO ! calculate gradient block of i'th atom @@ -310,7 +310,7 @@ SUBROUTINE pao_calc_U_gth(pao, penalty, matrix_M1, matrix_G) M1=block_M1, G=block_M2, gap=gaps(iatom)) DO iterm = 1, SIZE(world_G) block_V_term(1:n, 1:n) => vec_V_terms(:, iterm) ! map column into matrix - world_G(iterm) = world_G(iterm)+SUM(block_V_term*block_M2) + world_G(iterm) = world_G(iterm) + SUM(block_V_term*block_M2) ENDDO DEALLOCATE (block_M2) ENDIF @@ -325,8 +325,8 @@ SUBROUTINE pao_calc_U_gth(pao, penalty, matrix_M1, matrix_G) DO WHILE (dbcsr_iterator_blocks_left(iter)) CALL dbcsr_iterator_next_block(iter, arow, acol, block_G) iatom = arow; CPASSERT(arow == acol) - idx = SUM(nterms(1:iatom-1)) - block_G(:, 1) = world_G(idx+1:idx+nterms(iatom)) + idx = SUM(nterms(1:iatom - 1)) + block_G(:, 1) = world_G(idx + 1:idx + nterms(iatom)) ENDDO CALL dbcsr_iterator_stop(iter) ENDIF @@ -389,8 +389,8 @@ SUBROUTINE pao_param_count_gth(qs_env, ikind, nparams) IF (MOD(maxl, 2) /= 0) & CPABORT("GTH parametrization requires even-numbered PAO_POTENTIAL%MAXL") - ncombis = (max_projector+1)*(max_projector+2)/2 - nparams = ncombis*(maxl/2+1) + ncombis = (max_projector + 1)*(max_projector + 2)/2 + nparams = ncombis*(maxl/2 + 1) END SUBROUTINE pao_param_count_gth @@ -434,7 +434,7 @@ SUBROUTINE gth_calc_term(qs_env, block_V, iatom, jatom, kterm) outer: DO lpot = 0, pot_maxl, 2 DO max_l = 0, pot_max_projector DO min_l = 0, max_l - c = c+1 + c = c + 1 IF (c == kterm) EXIT outer ENDDO ENDDO diff --git a/src/pao_param_linpot.F b/src/pao_param_linpot.F index f857cb6eda..7d30463133 100644 --- a/src/pao_param_linpot.F +++ b/src/pao_param_linpot.F @@ -189,7 +189,7 @@ SUBROUTINE pao_param_linpot_regularizer(pao) w = pao%linpot_regu_strength*MIN(1.0_dp, ABS(v)) DO i = 1, nterms DO j = 1, nterms - block_R(i, j) = block_R(i, j)+w*S_evecs(i, k)*S_evecs(j, k) + block_R(i, j) = block_R(i, j) + w*S_evecs(i, k)*S_evecs(j, k) ENDDO ENDDO ENDDO @@ -269,8 +269,8 @@ SUBROUTINE pao_param_linpot_preconditioner(pao) eval_capped = MAX(pao%linpot_precon_delta, S_evals(k)) ! too small eigenvalues are hurtful DO i = 1, nterms DO j = 1, nterms - block_precon(i, j) = block_precon(i, j)+S_evecs(i, k)*S_evecs(j, k)/SQRT(eval_capped) - block_precon_inv(i, j) = block_precon_inv(i, j)+S_evecs(i, k)*S_evecs(j, k)*SQRT(eval_capped) + block_precon(i, j) = block_precon(i, j) + S_evecs(i, k)*S_evecs(j, k)/SQRT(eval_capped) + block_precon_inv(i, j) = block_precon_inv(i, j) + S_evecs(i, k)*S_evecs(j, k)*SQRT(eval_capped) ENDDO ENDDO ENDDO @@ -401,14 +401,14 @@ SUBROUTINE pao_calc_U_linpot(pao, qs_env, penalty, matrix_M, matrix_G, forces) block_V(1:n, 1:n) => vec_V(:) ! map vector into matrix ! symmetrize - IF (MAXVAL(ABS(block_V-TRANSPOSE(block_V))/MAX(1.0_dp, MAXVAL(ABS(block_V)))) > 1e-12) & + IF (MAXVAL(ABS(block_V - TRANSPOSE(block_V))/MAX(1.0_dp, MAXVAL(ABS(block_V)))) > 1e-12) & CPABORT("block_V not symmetric") - block_V = 0.5_dp*(block_V+TRANSPOSE(block_V)) ! symmetrize exactly + block_V = 0.5_dp*(block_V + TRANSPOSE(block_V)) ! symmetrize exactly ! regularization energy ! protect against corner-case of zero pao parameters IF (PRESENT(penalty) .AND. nterms > 0) & - regu_energy = regu_energy+DOT_PRODUCT(block_X(:, 1), MATMUL(block_R, block_X(:, 1))) + regu_energy = regu_energy + DOT_PRODUCT(block_X(:, 1), MATMUL(block_R, block_X(:, 1))) IF (.NOT. PRESENT(matrix_G) .AND. .NOT. PRESENT(matrix_G)) THEN CALL pao_calc_U_block_fock(pao, iatom=iatom, penalty=penalty, V=block_V, U=block_U, & @@ -423,7 +423,8 @@ SUBROUTINE pao_calc_U_linpot(pao, qs_env, penalty, matrix_M, matrix_G, forces) block_M2(1:n, 1:n) => vec_M2(:) ! map vector into matrix CALL pao_calc_U_block_fock(pao, iatom=iatom, penalty=penalty, V=block_V, U=block_U, & M1=block_M1, G=block_M2, gap=gaps(iatom), evals=evals(:, iatom)) - IF (MAXVAL(ABS(block_M2-TRANSPOSE(block_M2))) > 1e-14_dp) CPABORT("matrix not symmetric") + IF (MAXVAL(ABS(block_M2 - TRANSPOSE(block_M2))) > 1e-14_dp) & + CPABORT("matrix not symmetric") ! gradient dE/dX IF (PRESENT(matrix_G)) THEN @@ -431,7 +432,7 @@ SUBROUTINE pao_calc_U_linpot(pao, qs_env, penalty, matrix_M, matrix_G, forces) CPASSERT(ASSOCIATED(block_G)) block_G(:, 1) = MATMUL(vec_M2, block_V_terms) IF (PRESENT(penalty)) & - block_G = block_G+2.0_dp*MATMUL(block_R, block_X) ! regularization gradient + block_G = block_G + 2.0_dp*MATMUL(block_R, block_X) ! regularization gradient ENDIF ! forced dE/dR @@ -455,7 +456,7 @@ SUBROUTINE pao_calc_U_linpot(pao, qs_env, penalty, matrix_M, matrix_G, forces) ! sum penalty energies across ranks CALL mp_sum(penalty, group) CALL mp_sum(regu_energy, group) - penalty = penalty+regu_energy + penalty = penalty + regu_energy ENDIF ! print stuff, but not during second invocation for forces @@ -591,10 +592,10 @@ SUBROUTINE pao_param_initguess_linpot(pao, qs_env) ALLOCATE (S_inv(nterms, nterms)) S_inv(:, :) = 0.0_dp DO k = 1, nterms - w = S_evals(k)/(S_evals(k)**2+pao%linpot_init_delta) + w = S_evals(k)/(S_evals(k)**2 + pao%linpot_init_delta) DO i = 1, nterms DO j = 1, nterms - S_inv(i, j) = S_inv(i, j)+w*S_evecs(i, k)*S_evecs(j, k) + S_inv(i, j) = S_inv(i, j) + w*S_evecs(i, k)*S_evecs(j, k) ENDDO ENDDO ENDDO diff --git a/src/pao_potentials.F b/src/pao_potentials.F index 183de28301..b2d2ff6077 100644 --- a/src/pao_potentials.F +++ b/src/pao_potentials.F @@ -142,7 +142,7 @@ SUBROUTINE pao_calc_gaussian(basis_set, block_V, block_D, Rab, lpot, beta, weigh ! setup description of potential lb_min = lpot lb_max = lpot - ncfgb = ncoset(lb_max)-ncoset(lb_min-1) + ncfgb = ncoset(lb_max) - ncoset(lb_min - 1) npgfb = 1 ! number of exponents nb = npgfb*ncfgb @@ -157,8 +157,8 @@ SUBROUTINE pao_calc_gaussian(basis_set, block_V, block_D, Rab, lpot, beta, weigh DO ishell = 1, basis_set%nshell(iset) DO jshell = 1, basis_set%nshell(jset) IF (PRESENT(min_shell) .AND. PRESENT(max_shell)) THEN - ishell_abs = SUM(basis_set%nshell(1:iset-1))+ishell - jshell_abs = SUM(basis_set%nshell(1:jset-1))+jshell + ishell_abs = SUM(basis_set%nshell(1:iset - 1)) + ishell + jshell_abs = SUM(basis_set%nshell(1:jset - 1)) + jshell IF (MIN(ishell_abs, jshell_abs) /= min_shell) CYCLE IF (MAX(ishell_abs, jshell_abs) /= max_shell) CYCLE ENDIF @@ -171,7 +171,7 @@ SUBROUTINE pao_calc_gaussian(basis_set, block_V, block_D, Rab, lpot, beta, weigh la1_max = basis_set%l(ishell, iset) la1_min = basis_set%l(ishell, iset) npgfa1 = basis_set%npgf(iset) - ncfga1 = ncoset(la1_max)-ncoset(la1_min-1) + ncfga1 = ncoset(la1_max) - ncoset(la1_min - 1) na1 = npgfa1*ncfga1 zeta1 => basis_set%zet(:, iset) rpgfa1 => basis_set%pgf_radius(:, iset) @@ -180,7 +180,7 @@ SUBROUTINE pao_calc_gaussian(basis_set, block_V, block_D, Rab, lpot, beta, weigh la2_max = basis_set%l(jshell, jset) la2_min = basis_set%l(jshell, jset) npgfa2 = basis_set%npgf(jset) - ncfga2 = ncoset(la2_max)-ncoset(la2_min-1) + ncfga2 = ncoset(la2_max) - ncoset(la2_min - 1) na2 = npgfa2*ncfga2 zeta2 => basis_set%zet(:, jset) rpgfa2 => basis_set%pgf_radius(:, jset) @@ -209,8 +209,8 @@ SUBROUTINE pao_calc_gaussian(basis_set, block_V, block_D, Rab, lpot, beta, weigh ALLOCATE (sab(na1, na2)) sab = 0.0_dp DO ic = 1, ncfgb - coeff = multinomial(lpot/2, indco(:, ncoset(lpot-1)+ic)/2) - sab = sab+coeff*saab(:, :, ic) + coeff = multinomial(lpot/2, indco(:, ncoset(lpot - 1) + ic)/2) + sab = sab + coeff*saab(:, :, ic) ENDDO CALL my_contract(sab=sab, block=new_block_V, basis_set=basis_set, & iset=iset, ishell=ishell, jset=jset, jshell=jshell) @@ -221,8 +221,8 @@ SUBROUTINE pao_calc_gaussian(basis_set, block_V, block_D, Rab, lpot, beta, weigh ALLOCATE (dab(na1, na2, 3)) dab = 0.0_dp DO ic = 1, ncfgb - coeff = multinomial(lpot/2, indco(:, ncoset(lpot-1)+ic)/2) - dab = dab+coeff*daab(:, :, ic, :) + coeff = multinomial(lpot/2, indco(:, ncoset(lpot - 1) + ic)/2) + dab = dab + coeff*daab(:, :, ic, :) ENDDO DO i = 1, 3 CALL my_contract(sab=dab(:, :, i), block=new_block_D(:, :, i), basis_set=basis_set, & @@ -238,18 +238,18 @@ SUBROUTINE pao_calc_gaussian(basis_set, block_V, block_D, Rab, lpot, beta, weigh DEALLOCATE (rpgfb, zetb) ! post-processing - norm2 = (2.0_dp*beta)**(-0.5_dp-lpot)*gamma1(lpot) + norm2 = (2.0_dp*beta)**(-0.5_dp - lpot)*gamma1(lpot) IF (PRESENT(block_V)) THEN - block_V = block_V+weight*new_block_V/SQRT(norm2) + block_V = block_V + weight*new_block_V/SQRT(norm2) DEALLOCATE (new_block_V) - block_V = 0.5_dp*(block_V+TRANSPOSE(block_V)) ! symmetrize + block_V = 0.5_dp*(block_V + TRANSPOSE(block_V)) ! symmetrize ENDIF IF (PRESENT(block_D)) THEN - block_D = block_D+weight*new_block_D/SQRT(norm2) + block_D = block_D + weight*new_block_D/SQRT(norm2) DEALLOCATE (new_block_D) DO i = 1, 3 - block_D(:, :, i) = 0.5_dp*(block_D(:, :, i)+TRANSPOSE(block_D(:, :, i))) ! symmetrize + block_D(:, :, i) = 0.5_dp*(block_D(:, :, i) + TRANSPOSE(block_D(:, :, i))) ! symmetrize ENDDO ENDIF @@ -301,26 +301,26 @@ SUBROUTINE my_contract(sab, block, basis_set, iset, ishell, jset, jshell) ! and then for each gaussian over all configrations of *the given shell*. l1 = basis_set%l(ishell, iset) l2 = basis_set%l(jshell, jset) - n1 = ncoset(l1)-ncoset(l1-1) - n2 = ncoset(l2)-ncoset(l2-1) + n1 = ncoset(l1) - ncoset(l1 - 1) + n2 = ncoset(l2) - ncoset(l2 - 1) DO ipgf = 1, basis_set%npgf(iset) DO jpgf = 1, basis_set%npgf(jset) ! prepare first trafo-matrix - a = (ipgf-1)*nn1+ncoset(l1-1)+1 - T1 => basis_set%sphi(a:a+n1-1, sgfa1:sgla1) + a = (ipgf - 1)*nn1 + ncoset(l1 - 1) + 1 + T1 => basis_set%sphi(a:a + n1 - 1, sgfa1:sgla1) ! prepare second trafo-matrix - b = (jpgf-1)*nn2+ncoset(l2-1)+1 - T2 => basis_set%sphi(b:b+n2-1, sgfa2:sgla2) + b = (jpgf - 1)*nn2 + ncoset(l2 - 1) + 1 + T2 => basis_set%sphi(b:b + n2 - 1, sgfa2:sgla2) ! prepare SAB matrix - c = (ipgf-1)*n1+1 - d = (jpgf-1)*n2+1 - S => sab(c:c+n1-1, d:d+n2-1) + c = (ipgf - 1)*n1 + 1 + d = (jpgf - 1)*n2 + 1 + S => sab(c:c + n1 - 1, d:d + n2 - 1) ! do the transformation - V = V+MATMUL(TRANSPOSE(T1), MATMUL(S, T2)) + V = V + MATMUL(TRANSPOSE(T1), MATMUL(S, T2)) ENDDO ENDDO diff --git a/src/particle_methods.F b/src/particle_methods.F index 832598e408..fc5aae7f3a 100644 --- a/src/particle_methods.F +++ b/src/particle_methods.F @@ -130,14 +130,14 @@ SUBROUTINE get_particle_set(particle_set, qs_kind_set, first_sgf, last_sgf, nsgf CALL get_qs_kind(qs_kind_set(ikind), nsgf=ns) END IF IF (PRESENT(nsgf)) nsgf(iparticle) = ns - IF (PRESENT(first_sgf)) first_sgf(iparticle) = isgf+1 - isgf = isgf+ns + IF (PRESENT(first_sgf)) first_sgf(iparticle) = isgf + 1 + isgf = isgf + ns IF (PRESENT(last_sgf)) last_sgf(iparticle) = isgf END DO END IF IF (PRESENT(first_sgf)) THEN - IF (SIZE(first_sgf) > nparticle) first_sgf(nparticle+1) = isgf+1 + IF (SIZE(first_sgf) > nparticle) first_sgf(nparticle + 1) = isgf + 1 END IF IF (PRESENT(nmao)) THEN @@ -210,7 +210,7 @@ SUBROUTINE write_particle_coordinates(particle_set, iunit, output_format, & natom = SIZE(particle_set) IF (PRESENT(array)) THEN - SELECT CASE (TRIM (content)) + SELECT CASE (TRIM(content)) CASE ("POS_VEL", "POS_VEL_FORCE") CPABORT("Illegal usage") END SELECT @@ -236,7 +236,7 @@ SUBROUTINE write_particle_coordinates(particle_set, iunit, output_format, & my_format = "(T2,A2," name = TRIM(element_symbol) END IF - SELECT CASE (TRIM (content)) + SELECT CASE (TRIM(content)) CASE ("POS") IF (PRESENT(array)) THEN r(1:3) = get_particle_pos_or_vel(iatom, particle_set, array) @@ -253,14 +253,14 @@ SUBROUTINE write_particle_coordinates(particle_set, iunit, output_format, & WRITE (iunit, TRIM(my_format)//"1X,3F20.10)") TRIM(name), v(1:3)*factor CASE ("FORCE") IF (PRESENT(array)) THEN - f(:) = array((iatom-1)*3+1:(iatom-1)*3+3) + f(:) = array((iatom - 1)*3 + 1:(iatom - 1)*3 + 3) ELSE f(:) = particle_set(iatom)%f(:) END IF WRITE (iunit, TRIM(my_format)//"1X,3F20.10)") TRIM(name), f(1:3)*factor CASE ("FORCE_MIXING_LABELS") IF (PRESENT(array)) THEN - f(:) = array((iatom-1)*3+1:(iatom-1)*3+3) + f(:) = array((iatom - 1)*3 + 1:(iatom - 1)*3 + 3) ELSE f(:) = particle_set(iatom)%f(:) END IF @@ -269,7 +269,7 @@ SUBROUTINE write_particle_coordinates(particle_set, iunit, output_format, & END DO CASE (dump_atomic) DO iatom = 1, natom - SELECT CASE (TRIM (content)) + SELECT CASE (TRIM(content)) CASE ("POS") IF (PRESENT(array)) THEN r(1:3) = get_particle_pos_or_vel(iatom, particle_set, array) @@ -286,14 +286,14 @@ SUBROUTINE write_particle_coordinates(particle_set, iunit, output_format, & WRITE (iunit, "(3F20.10)") v(1:3)*factor CASE ("FORCE") IF (PRESENT(array)) THEN - f(:) = array((iatom-1)*3+1:(iatom-1)*3+3) + f(:) = array((iatom - 1)*3 + 1:(iatom - 1)*3 + 3) ELSE f(:) = particle_set(iatom)%f(:) END IF WRITE (iunit, "(3F20.10)") f(1:3)*factor CASE ("FORCE_MIXING_LABELS") IF (PRESENT(array)) THEN - f(:) = array((iatom-1)*3+1:(iatom-1)*3+3) + f(:) = array((iatom - 1)*3 + 1:(iatom - 1)*3 + 3) ELSE f(:) = particle_set(iatom)%f(:) END IF @@ -326,7 +326,7 @@ SUBROUTINE write_particle_coordinates(particle_set, iunit, output_format, & IF (PRESENT(array)) THEN arr(1:3, 1:natom) = RESHAPE(array, (/3, natom/)) ELSE - SELECT CASE (TRIM (content)) + SELECT CASE (TRIM(content)) CASE ("POS") DO iatom = 1, natom arr(1:3, iatom) = particle_set(iatom)%r(1:3) @@ -428,7 +428,7 @@ SUBROUTINE write_particle_coordinates(particle_set, iunit, output_format, & WRITE (UNIT=line(13:16), FMT="(A4)") ADJUSTL(name) ! WRITE (UNIT=line(18:20),FMT="(A3)") TRIM(resname) ! WRITE (UNIT=line(23:26),FMT="(I4)") MODULO(idres,10000) - SELECT CASE (TRIM (content)) + SELECT CASE (TRIM(content)) CASE ("POS") IF (PRESENT(array)) THEN r(1:3) = get_particle_pos_or_vel(iatom, particle_set, array) @@ -518,7 +518,7 @@ SUBROUTINE write_fist_particle_coordinates(particle_set, subsys_section, & CALL get_shell(shell=shell_kind, & charge_core=qcore, & charge_shell=qshell) - qeff = qcore+qshell + qeff = qcore + qshell END IF WRITE (UNIT=iw, & FMT="(T2,I5,1X,I4,3X,A4,3X,3F12.6,4X,F6.2,2X,F11.4)") & @@ -639,10 +639,10 @@ SUBROUTINE write_particle_distances(particle_set, cell, subsys_section) ALLOCATE (distance_matrix(natom, natom)) distance_matrix(:, :) = 0.0_dp DO iatom = 1, natom - DO jatom = iatom+1, natom + DO jatom = iatom + 1, natom rab(:) = pbc(particle_set(iatom)%r(:), & particle_set(jatom)%r(:), cell) - dab = SQRT(rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3)) + dab = SQRT(rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3)) distance_matrix(iatom, jatom) = dab*conv distance_matrix(jatom, iatom) = distance_matrix(iatom, jatom) END DO @@ -710,11 +710,11 @@ SUBROUTINE write_particle_matrix(matrix, particle_set, iw, el_per_part, Ilist, p natom = natom*my_el_per_part DO jatom = 1, natom, my_parts_per_line from = jatom - to = MIN(from+my_parts_per_line-1, natom) + to = MIN(from + my_parts_per_line - 1, natom) WRITE (UNIT=iw, FMT=TRIM(fmt_string1)) (icol, icol=from, to) DO iatom = 1, natom katom = iatom/my_el_per_part - IF (MOD(iatom, my_el_per_part) /= 0) katom = katom+1 + IF (MOD(iatom, my_el_per_part) /= 0) katom = katom + 1 CALL get_atomic_kind(atomic_kind=particle_set(my_list(katom))%atomic_kind, & element_symbol=element_symbol) WRITE (UNIT=iw, FMT=TRIM(fmt_string2)) & @@ -795,9 +795,9 @@ SUBROUTINE write_structure_data(particle_set, cell, input_section) i_rep_val=i_rep, & i_vals=atomic_indices) n_vals = SIZE(atomic_indices) - new_size = old_size+n_vals + new_size = old_size + n_vals CALL reallocate(index_list, 1, new_size) - index_list(old_size+1:new_size) = atomic_indices(1:n_vals) + index_list(old_size + 1:new_size) = atomic_indices(1:n_vals) old_size = new_size END DO ALLOCATE (work(new_size)) @@ -812,7 +812,7 @@ SUBROUTINE write_structure_data(particle_set, cell, input_section) END IF IF (i > 1) THEN ! Skip redundant indices - IF (index_list(i) == index_list(i-1)) CYCLE + IF (index_list(i) == index_list(i - 1)) CYCLE END IF WRITE (UNIT=iw, FMT="(T3,A,T20,A,3F13.6)") & "r"//TRIM(string), "=", pbc(particle_set(index_list(i))%r(1:3), cell)*conv @@ -834,9 +834,9 @@ SUBROUTINE write_structure_data(particle_set, cell, input_section) i_rep_val=i_rep, & i_vals=atomic_indices) n_vals = SIZE(atomic_indices) - new_size = old_size+n_vals + new_size = old_size + n_vals CALL reallocate(index_list, 1, new_size) - index_list(old_size+1:new_size) = atomic_indices(1:n_vals) + index_list(old_size + 1:new_size) = atomic_indices(1:n_vals) old_size = new_size END DO ALLOCATE (work(new_size)) @@ -851,7 +851,7 @@ SUBROUTINE write_structure_data(particle_set, cell, input_section) END IF IF (i > 1) THEN ! Skip redundant indices - IF (index_list(i) == index_list(i-1)) CYCLE + IF (index_list(i) == index_list(i - 1)) CYCLE END IF r(1:3) = pbc(particle_set(index_list(i))%r(1:3), cell) CALL real_to_scaled(s, r, cell) @@ -882,7 +882,7 @@ SUBROUTINE write_structure_data(particle_set, cell, input_section) IF (((wrk2(1) >= 1) .AND. (wrk2(SIZE(wrk2)) <= natom)) .AND. unique) THEN rab(:) = pbc(particle_set(atomic_indices(1))%r(:), & particle_set(atomic_indices(2))%r(:), cell) - dab = SQRT(rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3)) + dab = SQRT(rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3)) WRITE (UNIT=iw, FMT="(T3,A,T20,A,3F13.6,3X,A,F13.6)") & "r"//TRIM(string), "=", rab(:)*conv, & "|r| =", dab*conv diff --git a/src/paw_proj_set_types.F b/src/paw_proj_set_types.F index b393037c91..72e5736ac2 100644 --- a/src/paw_proj_set_types.F +++ b/src/paw_proj_set_types.F @@ -328,7 +328,7 @@ SUBROUTINE build_projector(paw_proj, orb_basis, eps_fit, eps_iso, eps_svd, & IF (lshell >= lmin(iset) .AND. lshell <= lmax(iset)) THEN DO ip = 1, npgf(iset) IF (set_radius2(ip, lshell, iset) < max_rad_local) THEN - np = np+1 + np = np + 1 END IF END DO ENDIF @@ -376,10 +376,10 @@ SUBROUTINE build_projector(paw_proj, orb_basis, eps_fit, eps_iso, eps_svd, & IF (lshell >= lmin(iset) .AND. lshell <= lmax(iset)) THEN DO ip = 1, npgf(iset) IF (set_radius2(ip, lshell, iset) < max_rad_local) THEN - npgfg = npgfg+1 + npgfg = npgfg + 1 zet(npgfg) = orb_basis%zet(ip, iset) ELSE - notprj = notprj+1 + notprj = notprj + 1 END IF END DO ENDIF @@ -391,7 +391,7 @@ SUBROUTINE build_projector(paw_proj, orb_basis, eps_fit, eps_iso, eps_svd, & nisop = 0 DO ip = 1, np ! Check for equal exponents - DO ipp = 1, ip-1 + DO ipp = 1, ip - 1 IF (zet(ip) == zet(ipp)) THEN CALL cp_abort(__LOCATION__, & "Linear dependency in the construction of the GAPW projectors:"// & @@ -401,7 +401,7 @@ SUBROUTINE build_projector(paw_proj, orb_basis, eps_fit, eps_iso, eps_svd, & IF (zet(ip) >= paw_proj%zisomin(lshell)) THEN isoprj(ip) = .TRUE. - nisop = nisop+1 + nisop = nisop + 1 ELSE isoprj(ip) = .FALSE. END IF @@ -412,8 +412,8 @@ SUBROUTINE build_projector(paw_proj, orb_basis, eps_fit, eps_iso, eps_svd, & ! *** Generate the projectors by the geometric progression *** - IF (np-nisop-1 > 2) THEN - x = (80.0_dp/zetmin)**(1.0_dp/REAL(np-nisop-1, dp)) + IF (np - nisop - 1 > 2) THEN + x = (80.0_dp/zetmin)**(1.0_dp/REAL(np - nisop - 1, dp)) ELSE x = 2.0_dp END IF @@ -434,21 +434,21 @@ SUBROUTINE build_projector(paw_proj, orb_basis, eps_fit, eps_iso, eps_svd, & IF (isoprj(ip)) THEN zetp(ip) = zetval zetval = x*zetval - nisop = nisop+1 + nisop = nisop + 1 ENDIF ENDDO ! *** Build the overlap matrix: *** - prefac = 0.5_dp**(lshell+2)*rootpi*dfac(2*lshell+1) - expzet = REAL(lshell, dp)+1.5_dp + prefac = 0.5_dp**(lshell + 2)*rootpi*dfac(2*lshell + 1) + expzet = REAL(lshell, dp) + 1.5_dp DO ip = 1, np IF (isoprj(ip)) THEN - smat(ip, ip) = prefac/(zetp(ip)+zet(ip))**expzet + smat(ip, ip) = prefac/(zetp(ip) + zet(ip))**expzet ELSE DO jp = 1, np IF (.NOT. isoprj(jp)) THEN - smat(ip, jp) = prefac/(zetp(ip)+zet(jp))**expzet + smat(ip, jp) = prefac/(zetp(ip) + zet(jp))**expzet ENDIF ENDDO ENDIF @@ -501,10 +501,10 @@ SUBROUTINE build_projector(paw_proj, orb_basis, eps_fit, eps_iso, eps_svd, & IF (lshell >= lmin(iset) .AND. lshell <= lmax(iset)) THEN DO ip = 1, npgf(iset) IF (set_radius2(ip, lshell, iset) < max_rad_local) THEN - npgfg = npgfg+1 + npgfg = npgfg + 1 paw_proj%gccprj(1:np, ip, lshell, iset) = gcc(1:np, npgfg) ELSE - notprj = notprj+1 + notprj = notprj + 1 paw_proj%gccprj(1:np, ip, lshell, iset) = 0.0_dp END IF END DO @@ -548,8 +548,8 @@ SUBROUTINE build_projector(paw_proj, orb_basis, eps_fit, eps_iso, eps_svd, & paw_proj%ncgauprj = 0 paw_proj%nsgauprj = 0 DO lshell = 0, maxl - paw_proj%ncgauprj = paw_proj%ncgauprj+nco(lshell)*paw_proj%nprj(lshell) - paw_proj%nsgauprj = paw_proj%nsgauprj+nso(lshell)*paw_proj%nprj(lshell) + paw_proj%ncgauprj = paw_proj%ncgauprj + nco(lshell)*paw_proj%nprj(lshell) + paw_proj%nsgauprj = paw_proj%nsgauprj + nso(lshell)*paw_proj%nprj(lshell) ENDDO ncgauprj = paw_proj%ncgauprj @@ -569,18 +569,18 @@ SUBROUTINE build_projector(paw_proj, orb_basis, eps_fit, eps_iso, eps_svd, & nsgauprj = 0 DO lshell = 0, maxl np = paw_proj%nprj(lshell) - paw_proj%first_prj(lshell) = ncgauprj+1 - paw_proj%first_prjs(lshell) = nsgauprj+1 - paw_proj%last_prj(lshell) = ncgauprj+nco(lshell)*np + paw_proj%first_prj(lshell) = ncgauprj + 1 + paw_proj%first_prjs(lshell) = nsgauprj + 1 + paw_proj%last_prj(lshell) = ncgauprj + nco(lshell)*np DO ip = 1, np - DO ico = ncoset(lshell-1)+1, ncoset(lshell) - ncgauprj = ncgauprj+1 + DO ico = ncoset(lshell - 1) + 1, ncoset(lshell) + ncgauprj = ncgauprj + 1 paw_proj%lx(ncgauprj) = indco(1, ico) paw_proj%ly(ncgauprj) = indco(2, ico) paw_proj%lz(ncgauprj) = indco(3, ico) ENDDO ! ico - DO iso = nsoset(lshell-1)+1, nsoset(lshell) - nsgauprj = nsgauprj+1 + DO iso = nsoset(lshell - 1) + 1, nsoset(lshell) + nsgauprj = nsgauprj + 1 paw_proj%ll(nsgauprj) = indso(1, iso) paw_proj%m(nsgauprj) = indso(2, iso) ENDDO @@ -596,47 +596,47 @@ SUBROUTINE build_projector(paw_proj, orb_basis, eps_fit, eps_iso, eps_svd, & DO ipgf = 1, npgf(iset) DO ip = 1, np DO il = 1, nso(lshell) - iprjs = iprjfirst-1+il+(ip-1)*nso(lshell) - iso = nsoset(lshell-1)+1+(lshell+paw_proj%m(iprjs)) + iprjs = iprjfirst - 1 + il + (ip - 1)*nso(lshell) + iso = nsoset(lshell - 1) + 1 + (lshell + paw_proj%m(iprjs)) - iso = iso+(ipgf-1)*ns+ms + iso = iso + (ipgf - 1)*ns + ms paw_proj%cprj_s(iprjs, iso) = & paw_proj%gccprj(ip, ipgf, lshell, iset) ENDDO ! iprjs ENDDO ! ip ENDDO ! ipgf ENDDO ! lshell - ms = ms+maxso + ms = ms + maxso ENDDO ! iset ms = 0 DO iset = 1, orb_basis%nset ns = nsoset(lmax(iset)) DO ipgf = 1, npgf(iset) - DO iso = nsoset(lmin(iset)-1)+1+ns*(ipgf-1)+ms, ns*ipgf+ms + DO iso = nsoset(lmin(iset) - 1) + 1 + ns*(ipgf - 1) + ms, ns*ipgf + ms DO lshell = 0, maxl np = paw_proj%nprj(lshell) DO ip = 1, np - jp = paw_proj%first_prj(lshell)+(ip-1)*nco(lshell)-1 - kp = paw_proj%first_prjs(lshell)+(ip-1)*nso(lshell)-1 + jp = paw_proj%first_prj(lshell) + (ip - 1)*nco(lshell) - 1 + kp = paw_proj%first_prjs(lshell) + (ip - 1)*nso(lshell) - 1 DO il = 1, nco(lshell) - lx = indco(1, il+ncoset(lshell-1)) - ly = indco(2, il+ncoset(lshell-1)) - lz = indco(3, il+ncoset(lshell-1)) - iprj = jp+il + lx = indco(1, il + ncoset(lshell - 1)) + ly = indco(2, il + ncoset(lshell - 1)) + lz = indco(3, il + ncoset(lshell - 1)) + iprj = jp + il DO ic = 1, nso(lshell) - iprjs = kp+ic - paw_proj%cprj(iprj, iso) = paw_proj%cprj(iprj, iso)+ & + iprjs = kp + ic + paw_proj%cprj(iprj, iso) = paw_proj%cprj(iprj, iso) + & orbtramat(lshell)%s2c(ic, il)*paw_proj%cprj_s(iprjs, iso)* & - SQRT(dfac(2*lshell+1)/(4.0_dp*pi)/ & - dfac(2*lx-1)*dfac(2*ly-1)*dfac(2*lz-1)) + SQRT(dfac(2*lshell + 1)/(4.0_dp*pi)/ & + dfac(2*lx - 1)*dfac(2*ly - 1)*dfac(2*lz - 1)) ENDDO ! ic ENDDO ! il ENDDO ! ip ENDDO ! lshell ENDDO ! iso ENDDO ! ipgf - ms = ms+maxso + ms = ms + maxso ENDDO ! iset ! local coefficients for the one center expansions : oce @@ -661,8 +661,8 @@ SUBROUTINE build_projector(paw_proj, orb_basis, eps_fit, eps_iso, eps_svd, & DO ipgf = 1, npgf(iset) DO ishell = 1, nshell(iset) lshell = l(ishell, iset) - icomin = ncoset(lshell-1)+1+n*(ipgf-1) - icomax = ncoset(lshell)+n*(ipgf-1) + icomin = ncoset(lshell - 1) + 1 + n*(ipgf - 1) + icomax = ncoset(lshell) + n*(ipgf - 1) icgfmin = first_cgf(ishell, iset) icgfmax = last_cgf(ishell, iset) radius = exp_radius(lshell, orb_basis%zet(ipgf, iset), & @@ -686,8 +686,8 @@ SUBROUTINE build_projector(paw_proj, orb_basis, eps_fit, eps_iso, eps_svd, & DO ipgf = 1, npgf(iset) DO ishell = 1, nshell(iset) lshell = l(ishell, iset) - icomin = ncoset(lshell-1)+1+n*(ipgf-1) - icomax = ncoset(lshell)+n*(ipgf-1) + icomin = ncoset(lshell - 1) + 1 + n*(ipgf - 1) + icomax = ncoset(lshell) + n*(ipgf - 1) isgfmin = first_sgf(ishell, iset) isgfmax = last_sgf(ishell, iset) radius = exp_radius(lshell, orb_basis%zet(ipgf, iset), & @@ -712,29 +712,29 @@ SUBROUTINE build_projector(paw_proj, orb_basis, eps_fit, eps_iso, eps_svd, & DO ipgf = 1, npgf(iset) DO ishell = 1, nshell(iset) lshell = l(ishell, iset) - icomin = ncoset(lshell-1)+1+n*(ipgf-1) - icomax = ncoset(lshell)+n*(ipgf-1) + icomin = ncoset(lshell - 1) + 1 + n*(ipgf - 1) + icomax = ncoset(lshell) + n*(ipgf - 1) isgfmin = first_sgf(ishell, iset) isgfmax = last_sgf(ishell, iset) - isomin = nsoset(lshell-1)+1+ns*(ipgf-1) + isomin = nsoset(lshell - 1) + 1 + ns*(ipgf - 1) DO is = 1, nso(lshell) - iso = isomin+is-1 + iso = isomin + is - 1 DO ic = 1, nco(lshell) - ico = icomin+ic-1 - lx = indco(1, ic+ncoset(lshell-1)) - ly = indco(2, ic+ncoset(lshell-1)) - lz = indco(3, ic+ncoset(lshell-1)) + ico = icomin + ic - 1 + lx = indco(1, ic + ncoset(lshell - 1)) + ly = indco(2, ic + ncoset(lshell - 1)) + lz = indco(3, ic + ncoset(lshell - 1)) DO isgf = isgfmin, isgfmax paw_proj%local_oce_sphi_h(iso, isgf) = & - paw_proj%local_oce_sphi_h(iso, isgf)+ & + paw_proj%local_oce_sphi_h(iso, isgf) + & orbtramat(lshell)%s2c(is, ic)* & paw_proj%sphi_h(ico, isgf)*SQRT((4.0_dp*pi* & - dfac(2*lx-1)*dfac(2*ly-1)*dfac(2*lz-1))/dfac(2*lshell+1)) + dfac(2*lx - 1)*dfac(2*ly - 1)*dfac(2*lz - 1))/dfac(2*lshell + 1)) paw_proj%local_oce_sphi_s(iso, isgf) = & - paw_proj%local_oce_sphi_s(iso, isgf)+ & + paw_proj%local_oce_sphi_s(iso, isgf) + & orbtramat(lshell)%s2c(is, ic)* & paw_proj%sphi_s(ico, isgf)*SQRT((4.0_dp*pi* & - dfac(2*lx-1)*dfac(2*ly-1)*dfac(2*lz-1))/dfac(2*lshell+1)) + dfac(2*lx - 1)*dfac(2*ly - 1)*dfac(2*lz - 1))/dfac(2*lshell + 1)) END DO ! isgf END DO ! ic END DO ! is @@ -749,22 +749,22 @@ SUBROUTINE build_projector(paw_proj, orb_basis, eps_fit, eps_iso, eps_svd, & paw_proj%n2oindex = 0 ico = 1 DO iset = 1, nset - iso_set = (iset-1)*maxso+1 + iso_set = (iset - 1)*maxso + 1 nsox = nsoset(lmax(iset)) DO ipgf = 1, npgf(iset) - iso_pgf = iso_set+(ipgf-1)*nsox - iso = iso_pgf+nsoset(lmin(iset)-1) + iso_pgf = iso_set + (ipgf - 1)*nsox + iso = iso_pgf + nsoset(lmin(iset) - 1) DO lx = lmin(iset), lmax(iset) DO k = 1, nso(lx) paw_proj%n2oindex(ico) = iso paw_proj%o2nindex(iso) = ico - iso = iso+1 - ico = ico+1 + iso = iso + 1 + ico = ico + 1 END DO END DO END DO END DO - mp = ico-1 + mp = ico - 1 paw_proj%nsatbas = mp paw_proj%nsotot = nset*maxso ALLOCATE (paw_proj%csprj(nsgauprj, mp)) diff --git a/src/pexsi_interface.F b/src/pexsi_interface.F index 999bbfc768..283a068c9a 100644 --- a/src/pexsi_interface.F +++ b/src/pexsi_interface.F @@ -14,20 +14,20 @@ MODULE pexsi_interface #ifdef __LIBPEXSI USE f_ppexsi_interface, ONLY: f_ppexsi_dft_driver, & - f_ppexsi_load_real_hs_matrix, & - f_ppexsi_options, & - f_ppexsi_plan_finalize, & - f_ppexsi_plan_initialize, & - f_ppexsi_retrieve_real_dft_matrix, & - f_ppexsi_set_default_options + f_ppexsi_load_real_hs_matrix, & + f_ppexsi_options, & + f_ppexsi_plan_finalize, & + f_ppexsi_plan_initialize, & + f_ppexsi_retrieve_real_dft_matrix, & + f_ppexsi_set_default_options #endif #if defined (__HAS_IEEE_EXCEPTIONS) USE ieee_exceptions, ONLY: ieee_get_halting_mode, & - ieee_set_halting_mode, & - ieee_all + ieee_set_halting_mode, & + ieee_all #endif USE kinds, ONLY: int_8, & - real_8 + real_8 #include "./base/base_uses.f90" IMPLICIT NONE diff --git a/src/pexsi_methods.F b/src/pexsi_methods.F index 04060aedf9..7a8d58377d 100644 --- a/src/pexsi_methods.F +++ b/src/pexsi_methods.F @@ -385,7 +385,7 @@ SUBROUTINE density_matrix_pexsi(pexsi_env, matrix_p, matrix_w, kTS, matrix_ks, m CALL arnoldi_ev(arnoldi_matrices, my_arnoldi) delta_E = REAL(get_selected_ritz_val(my_arnoldi, 1), dp) ! increase delta_E a bit to make sure that it really is an upper bound - delta_E = delta_E+1.0E-2_dp*ABS(delta_E) + delta_E = delta_E + 1.0E-2_dp*ABS(delta_E) CALL get_selected_ritz_vector(my_arnoldi, 1, arnoldi_matrices(1)%matrix, & pexsi_env%max_ev_vector(ispin)) CALL deallocate_arnoldi_data(my_arnoldi) @@ -450,7 +450,7 @@ SUBROUTINE density_matrix_pexsi(pexsi_env, matrix_p, matrix_w, kTS, matrix_ks, m n_total_inertia_iter, n_total_pexsi_iter) ! Check convergence - nelectron_diff = nelectron_out-nelectron_exact_pexsi + nelectron_diff = nelectron_out - nelectron_exact_pexsi pexsi_convergence = ABS(nelectron_diff) .LT. nel_tol IF (unit_nr > 0) THEN @@ -482,7 +482,7 @@ SUBROUTINE density_matrix_pexsi(pexsi_env, matrix_p, matrix_w, kTS, matrix_ks, m pexsi_env%csr_mat_F%nzval_local%r_dp, & energy_H, energy_S, free_energy) ! calculate entropic energy contribution -TS = A - U - kTS = (free_energy-energy_H) + kTS = (free_energy - energy_H) ENDIF ! send kTS to all nodes: @@ -555,13 +555,13 @@ SUBROUTINE pexsi_set_convergence_tolerance(pexsi_env, delta_scf, eps_scf, initia IF (initialize) THEN pexsi_env%adaptive_nel_alpha = & - (pexsi_env%tol_nel_initial-pexsi_env%tol_nel_target)/(ABS(delta_scf)-eps_scf) + (pexsi_env%tol_nel_initial - pexsi_env%tol_nel_target)/(ABS(delta_scf) - eps_scf) pexsi_env%adaptive_nel_beta = & - pexsi_env%tol_nel_initial-pexsi_env%adaptive_nel_alpha*ABS(delta_scf) + pexsi_env%tol_nel_initial - pexsi_env%adaptive_nel_alpha*ABS(delta_scf) pexsi_env%do_adaptive_tol_nel = .TRUE. ENDIF IF (pexsi_env%do_adaptive_tol_nel) THEN - tol_nel = pexsi_env%adaptive_nel_alpha*ABS(delta_scf)+pexsi_env%adaptive_nel_beta + tol_nel = pexsi_env%adaptive_nel_alpha*ABS(delta_scf) + pexsi_env%adaptive_nel_beta tol_nel = MAX(tol_nel, pexsi_env%tol_nel_target) tol_nel = MIN(tol_nel, pexsi_env%tol_nel_initial) ENDIF diff --git a/src/pexsi_types.F b/src/pexsi_types.F index 136cd3d788..14c22fe450 100644 --- a/src/pexsi_types.F +++ b/src/pexsi_types.F @@ -153,7 +153,7 @@ SUBROUTINE lib_pexsi_init(pexsi_env, mp_group, nspin) ! is the smallest number greater or equal to min_ranks_per_pole that divides ! MPI size without remainder. DO WHILE (MOD(numnodes, pexsi_env%num_ranks_per_pole) .NE. 0) - pexsi_env%num_ranks_per_pole = pexsi_env%num_ranks_per_pole+1 + pexsi_env%num_ranks_per_pole = pexsi_env%num_ranks_per_pole + 1 ENDDO CALL cp_pexsi_get_options(pexsi_env%options, npSymbFact=npSymbFact) diff --git a/src/pme.F b/src/pme.F index 194b731eab..67b522180f 100644 --- a/src/pme.F +++ b/src/pme.F @@ -267,22 +267,22 @@ SUBROUTINE pme_evaluate(ewald_env, ewald_pw, box, particle_set, vg_coulomb, & ! add boxes to real space grid (big box) CALL dg_sum_patch_force_1d(rpot, rhos1, exp_igr%centre(:, p1), fat1) IF (atprop%energy) THEN - atprop%atener(p1) = atprop%atener(p1)+0.5_dp*fat1*dvols + atprop%atener(p1) = atprop%atener(p1) + 0.5_dp*fat1*dvols END IF IF (atprop%stress) THEN - atprop%atstress(1, 1, p1) = atprop%atstress(1, 1, p1)+0.5_dp*fat1*dvols - atprop%atstress(2, 2, p1) = atprop%atstress(2, 2, p1)+0.5_dp*fat1*dvols - atprop%atstress(3, 3, p1) = atprop%atstress(3, 3, p1)+0.5_dp*fat1*dvols + atprop%atstress(1, 1, p1) = atprop%atstress(1, 1, p1) + 0.5_dp*fat1*dvols + atprop%atstress(2, 2, p1) = atprop%atstress(2, 2, p1) + 0.5_dp*fat1*dvols + atprop%atstress(3, 3, p1) = atprop%atstress(3, 3, p1) + 0.5_dp*fat1*dvols END IF IF (p2 /= 0) THEN CALL dg_sum_patch_force_1d(rpot, rhos2, exp_igr%centre(:, p2), fat1) IF (atprop%energy) THEN - atprop%atener(p2) = atprop%atener(p2)+0.5_dp*fat1*dvols + atprop%atener(p2) = atprop%atener(p2) + 0.5_dp*fat1*dvols END IF IF (atprop%stress) THEN - atprop%atstress(1, 1, p2) = atprop%atstress(1, 1, p2)+0.5_dp*fat1*dvols - atprop%atstress(2, 2, p2) = atprop%atstress(2, 2, p2)+0.5_dp*fat1*dvols - atprop%atstress(3, 3, p2) = atprop%atstress(3, 3, p2)+0.5_dp*fat1*dvols + atprop%atstress(1, 1, p2) = atprop%atstress(1, 1, p2) + 0.5_dp*fat1*dvols + atprop%atstress(2, 2, p2) = atprop%atstress(2, 2, p2) + 0.5_dp*fat1*dvols + atprop%atstress(3, 3, p2) = atprop%atstress(3, 3, p2) + 0.5_dp*fat1*dvols END IF END IF END DO @@ -297,7 +297,7 @@ SUBROUTINE pme_evaluate(ewald_env, ewald_pw, box, particle_set, vg_coulomb, & ffb = 1.0_dp/fourpi DO i = 1, 3 DO ig = grid_b%first_gne0, grid_b%ngpts_cut_local - phi_g%cc(ig) = ffb*dphi_g(i)%pw%cc(ig)*(ffa*grid_b%gsq(ig)+1.0_dp) + phi_g%cc(ig) = ffb*dphi_g(i)%pw%cc(ig)*(ffa*grid_b%gsq(ig) + 1.0_dp) phi_g%cc(ig) = phi_g%cc(ig)*poisson_env%green_fft%influence_fn%cc(ig) END DO IF (grid_b%have_g0) phi_g%cc(1) = 0.0_dp @@ -319,12 +319,12 @@ SUBROUTINE pme_evaluate(ewald_env, ewald_pw, box, particle_set, vg_coulomb, & rhos1, rhos2, charges=charges) ! add boxes to real space grid (big box) CALL dg_sum_patch_force_1d(rpot, rhos1, exp_igr%centre(:, p1), fat1) - atprop%atstress(i, j, p1) = atprop%atstress(i, j, p1)+fat1*dvols - IF (i /= j) atprop%atstress(j, i, p1) = atprop%atstress(j, i, p1)+fat1*dvols + atprop%atstress(i, j, p1) = atprop%atstress(i, j, p1) + fat1*dvols + IF (i /= j) atprop%atstress(j, i, p1) = atprop%atstress(j, i, p1) + fat1*dvols IF (p2 /= 0) THEN CALL dg_sum_patch_force_1d(rpot, rhos2, exp_igr%centre(:, p2), fat1) - atprop%atstress(i, j, p2) = atprop%atstress(i, j, p2)+fat1*dvols - IF (i /= j) atprop%atstress(j, i, p2) = atprop%atstress(j, i, p2)+fat1*dvols + atprop%atstress(i, j, p2) = atprop%atstress(i, j, p2) + fat1*dvols + IF (i /= j) atprop%atstress(j, i, p2) = atprop%atstress(j, i, p2) + fat1*dvols END IF END DO END DO @@ -350,7 +350,7 @@ SUBROUTINE pme_evaluate(ewald_env, ewald_pw, box, particle_set, vg_coulomb, & END DO ffa = (1.0_dp/fourpi)*(0.5_dp/dg_rho0%zet(1))**2 f_stress = -ffa*f_stress - pv_g = h_stress+f_stress + pv_g = h_stress + f_stress END IF !--------END OF STRESS TENSOR CALCULATION ----------- @@ -397,31 +397,31 @@ SUBROUTINE pme_evaluate(ewald_env, ewald_pw, box, particle_set, vg_coulomb, & CALL dg_sum_patch_force_3d(drpot, rhos1, & exp_igr%core_centre(:, particle_set(p1)%shell_index), fat) fgcore_coulomb(1, particle_set(p1)%shell_index) = & - fgcore_coulomb(1, particle_set(p1)%shell_index)-fat(1)*dvols + fgcore_coulomb(1, particle_set(p1)%shell_index) - fat(1)*dvols fgcore_coulomb(2, particle_set(p1)%shell_index) = & - fgcore_coulomb(2, particle_set(p1)%shell_index)-fat(2)*dvols + fgcore_coulomb(2, particle_set(p1)%shell_index) - fat(2)*dvols fgcore_coulomb(3, particle_set(p1)%shell_index) = & - fgcore_coulomb(3, particle_set(p1)%shell_index)-fat(3)*dvols + fgcore_coulomb(3, particle_set(p1)%shell_index) - fat(3)*dvols ELSE CALL dg_sum_patch_force_3d(drpot, rhos1, exp_igr%centre(:, p1), fat) - fg_coulomb(1, p1) = fg_coulomb(1, p1)-fat(1)*dvols - fg_coulomb(2, p1) = fg_coulomb(2, p1)-fat(2)*dvols - fg_coulomb(3, p1) = fg_coulomb(3, p1)-fat(3)*dvols + fg_coulomb(1, p1) = fg_coulomb(1, p1) - fat(1)*dvols + fg_coulomb(2, p1) = fg_coulomb(2, p1) - fat(2)*dvols + fg_coulomb(3, p1) = fg_coulomb(3, p1) - fat(3)*dvols END IF IF (p2 /= 0 .AND. is2_core) THEN CALL dg_sum_patch_force_3d(drpot, rhos1, & exp_igr%core_centre(:, particle_set(p2)%shell_index), fat) fgcore_coulomb(1, particle_set(p2)%shell_index) = & - fgcore_coulomb(1, particle_set(p2)%shell_index)-fat(1)*dvols + fgcore_coulomb(1, particle_set(p2)%shell_index) - fat(1)*dvols fgcore_coulomb(2, particle_set(p2)%shell_index) = & - fgcore_coulomb(2, particle_set(p2)%shell_index)-fat(2)*dvols + fgcore_coulomb(2, particle_set(p2)%shell_index) - fat(2)*dvols fgcore_coulomb(3, particle_set(p2)%shell_index) = & - fgcore_coulomb(3, particle_set(p2)%shell_index)-fat(3)*dvols + fgcore_coulomb(3, particle_set(p2)%shell_index) - fat(3)*dvols ELSEIF (p2 /= 0) THEN CALL dg_sum_patch_force_3d(drpot, rhos2, exp_igr%centre(:, p2), fat) - fg_coulomb(1, p2) = fg_coulomb(1, p2)-fat(1)*dvols - fg_coulomb(2, p2) = fg_coulomb(2, p2)-fat(2)*dvols - fg_coulomb(3, p2) = fg_coulomb(3, p2)-fat(3)*dvols + fg_coulomb(1, p2) = fg_coulomb(1, p2) - fat(1)*dvols + fg_coulomb(2, p2) = fg_coulomb(2, p2) - fat(2)*dvols + fg_coulomb(3, p2) = fg_coulomb(3, p2) - fat(3)*dvols END IF END DO @@ -442,14 +442,14 @@ SUBROUTINE pme_evaluate(ewald_env, ewald_pw, box, particle_set, vg_coulomb, & ! sum boxes on real space grids (big box) CALL dg_sum_patch_force_3d(drpot, rhos1, exp_igr%shell_centre(:, p1), fat) - fgshell_coulomb(1, p1) = fgshell_coulomb(1, p1)-fat(1)*dvols - fgshell_coulomb(2, p1) = fgshell_coulomb(2, p1)-fat(2)*dvols - fgshell_coulomb(3, p1) = fgshell_coulomb(3, p1)-fat(3)*dvols + fgshell_coulomb(1, p1) = fgshell_coulomb(1, p1) - fat(1)*dvols + fgshell_coulomb(2, p1) = fgshell_coulomb(2, p1) - fat(2)*dvols + fgshell_coulomb(3, p1) = fgshell_coulomb(3, p1) - fat(3)*dvols IF (p2 /= 0) THEN CALL dg_sum_patch_force_3d(drpot, rhos2, exp_igr%shell_centre(:, p2), fat) - fgshell_coulomb(1, p2) = fgshell_coulomb(1, p2)-fat(1)*dvols - fgshell_coulomb(2, p2) = fgshell_coulomb(2, p2)-fat(2)*dvols - fgshell_coulomb(3, p2) = fgshell_coulomb(3, p2)-fat(3)*dvols + fgshell_coulomb(1, p2) = fgshell_coulomb(1, p2) - fat(1)*dvols + fgshell_coulomb(2, p2) = fgshell_coulomb(2, p2) - fat(2)*dvols + fgshell_coulomb(3, p2) = fgshell_coulomb(3, p2) - fat(3)*dvols END IF END DO diff --git a/src/pme_tools.F b/src/pme_tools.F index 13bd63464a..766fd750e1 100644 --- a/src/pme_tools.F +++ b/src/pme_tools.F @@ -60,7 +60,7 @@ SUBROUTINE set_list(part, npart, center, p1, rs, ipart, core_center) ub = rs%ub_real DO - ipart = ipart+1 + ipart = ipart + 1 IF (ipart > npart) EXIT atomic_kind => part(ipart)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, qeff=charge) @@ -141,17 +141,17 @@ SUBROUTINE get_center(part, box, center, npts, n) DO ipart = 1, SIZE(part) ! compute the scaled coordinate of atom ipart CALL real_to_scaled(s, part(ipart)%r, box) - s = s-NINT(s) + s = s - NINT(s) gp = REAL(npts, KIND=dp)*s ! find the closest grid point (on big grid) IF (MOD(n, 2) == 0) THEN - center(:, ipart) = INT(gp+rmp)-mp + center(:, ipart) = INT(gp + rmp) - mp ELSE center(:, ipart) = NINT(gp) END IF - center(:, ipart) = center(:, ipart)+npts(:)/2 + center(:, ipart) = center(:, ipart) + npts(:)/2 center(:, ipart) = MODULO(center(:, ipart), npts(:)) - center(:, ipart) = center(:, ipart)-npts(:)/2 + center(:, ipart) = center(:, ipart) - npts(:)/2 END DO END SUBROUTINE get_center diff --git a/src/population_analyses.F b/src/population_analyses.F index 755515930e..b1745279ce 100644 --- a/src/population_analyses.F +++ b/src/population_analyses.F @@ -368,19 +368,19 @@ SUBROUTINE mulliken_population_analysis(qs_env, output_unit, print_level) DO jsgf = 1, SIZE(s_block, 2) DO isgf = 1, SIZE(s_block, 1) ps = p_block(isgf, jsgf)*s_block(isgf, jsgf) - IF (ASSOCIATED(ps_block)) ps_block(isgf, jsgf) = ps_block(isgf, jsgf)+ps - orbpop(sgfb, ispin) = orbpop(sgfb, ispin)+ps + IF (ASSOCIATED(ps_block)) ps_block(isgf, jsgf) = ps_block(isgf, jsgf) + ps + orbpop(sgfb, ispin) = orbpop(sgfb, ispin) + ps END DO - sgfb = sgfb+1 + sgfb = sgfb + 1 END DO IF (iatom /= jatom) THEN sgfa = first_sgf_atom(iatom) DO isgf = 1, SIZE(s_block, 1) DO jsgf = 1, SIZE(s_block, 2) ps = p_block(isgf, jsgf)*s_block(isgf, jsgf) - orbpop(sgfa, ispin) = orbpop(sgfa, ispin)+ps + orbpop(sgfa, ispin) = orbpop(sgfa, ispin) + ps END DO - sgfa = sgfa+1 + sgfa = sgfa + 1 END DO END IF END DO @@ -520,7 +520,7 @@ SUBROUTINE write_orbpop(orbpop, atomic_kind_set, qs_kind_set, particle_set, outp l = lshell(ishell, iset) DO iso = 1, nso(l) IF (nspin == 1) THEN - sumorbpop(1) = sumorbpop(1)+orbpop(iao, 1) + sumorbpop(1) = sumorbpop(1) + orbpop(iao, 1) IF (print_orbital_contributions) THEN IF (isgf == 1) WRITE (UNIT=output_unit, FMT="(A)") "" WRITE (UNIT=output_unit, & @@ -528,34 +528,34 @@ SUBROUTINE write_orbpop(orbpop, atomic_kind_set, qs_kind_set, particle_set, outp iao, element_symbol, sgf_symbol(isgf), orbpop(iao, 1) END IF ELSE - sumorbpop(1:2) = sumorbpop(1:2)+orbpop(iao, 1:2) - sumorbpop(3) = sumorbpop(3)+orbpop(iao, 1)-orbpop(iao, 2) + sumorbpop(1:2) = sumorbpop(1:2) + orbpop(iao, 1:2) + sumorbpop(3) = sumorbpop(3) + orbpop(iao, 1) - orbpop(iao, 2) IF (print_orbital_contributions) THEN IF (isgf == 1) WRITE (UNIT=output_unit, FMT="(A)") "" WRITE (UNIT=output_unit, & FMT="(T2,I9,2X,A2,1X,A,T29,2(1X,F12.6),T68,F12.6)") & iao, element_symbol, sgf_symbol(isgf), orbpop(iao, 1:2), & - orbpop(iao, 1)-orbpop(iao, 2) + orbpop(iao, 1) - orbpop(iao, 2) END IF END IF - isgf = isgf+1 - iao = iao+1 + isgf = isgf + 1 + iao = iao + 1 END DO END DO END DO IF (nspin == 1) THEN - totsumorbpop(1) = totsumorbpop(1)+sumorbpop(1) - totsumorbpop(3) = totsumorbpop(3)+zeff-sumorbpop(1) + totsumorbpop(1) = totsumorbpop(1) + sumorbpop(1) + totsumorbpop(3) = totsumorbpop(3) + zeff - sumorbpop(1) WRITE (UNIT=output_unit, & FMT="(T2,I7,5X,A2,2X,I6,T30,F12.6,T68,F12.6)") & - iatom, element_symbol, ikind, sumorbpop(1), zeff-sumorbpop(1) + iatom, element_symbol, ikind, sumorbpop(1), zeff - sumorbpop(1) ELSE - totsumorbpop(1:2) = totsumorbpop(1:2)+sumorbpop(1:2) - totsumorbpop(3) = totsumorbpop(3)+zeff-sumorbpop(1)-sumorbpop(2) + totsumorbpop(1:2) = totsumorbpop(1:2) + sumorbpop(1:2) + totsumorbpop(3) = totsumorbpop(3) + zeff - sumorbpop(1) - sumorbpop(2) WRITE (UNIT=output_unit, & FMT="(T2,I7,5X,A2,2X,I6,T28,4(1X,F12.6))") & iatom, element_symbol, ikind, sumorbpop(1:2), & - zeff-sumorbpop(1)-sumorbpop(2), sumorbpop(3) + zeff - sumorbpop(1) - sumorbpop(2), sumorbpop(3) END IF END IF ! atom has an orbital basis END DO ! next atom iatom @@ -570,7 +570,7 @@ SUBROUTINE write_orbpop(orbpop, atomic_kind_set, qs_kind_set, particle_set, outp WRITE (UNIT=output_unit, & FMT="(T2,A,T28,4(1X,F12.6),/)") & "# Total charge and spin", totsumorbpop(1:2), totsumorbpop(3), & - totsumorbpop(1)-totsumorbpop(2) + totsumorbpop(1) - totsumorbpop(2) END IF IF (output_unit > 0) CALL m_flush(output_unit) diff --git a/src/preconditioner_apply.F b/src/preconditioner_apply.F index c01e178734..79f0545f84 100644 --- a/src/preconditioner_apply.F +++ b/src/preconditioner_apply.F @@ -246,7 +246,7 @@ SUBROUTINE apply_full_all(preconditioner_env, matrix_in, matrix_out) DO j = 1, ncol_local DO i = 1, nrow_local dum = 1.0_dp/MAX(preconditioner_env%energy_gap, & - preconditioner_env%full_evals(row_indices(i))-preconditioner_env%occ_evals(col_indices(j))) + preconditioner_env%full_evals(row_indices(i)) - preconditioner_env%occ_evals(col_indices(j))) local_data(i, j) = local_data(i, j)*dum ENDDO ENDDO @@ -295,8 +295,8 @@ SUBROUTINE apply_all(preconditioner_env, matrix_in, matrix_out) DO j = 1, col_size DO i = 1, row_size dum = 1.0_dp/MAX(preconditioner_env%energy_gap, & - preconditioner_env%full_evals(row_offset+i-1) & - -preconditioner_env%occ_evals(col_offset+j-1)) + preconditioner_env%full_evals(row_offset + i - 1) & + - preconditioner_env%occ_evals(col_offset + j - 1)) DATA(i, j) = DATA(i, j)*dum ENDDO ENDDO diff --git a/src/preconditioner_makes.F b/src/preconditioner_makes.F index a7c97e4b6d..ffa5a71165 100644 --- a/src/preconditioner_makes.F +++ b/src/preconditioner_makes.F @@ -271,13 +271,13 @@ SUBROUTINE make_full_single(preconditioner_env, fm, matrix_h, matrix_s, & CALL cp_fm_triangular_multiply(fm_s, fm, side="L", transpose_tr=.FALSE., & invert_tr=.FALSE., uplo_tr="U", n_rows=n, n_cols=n, alpha=1.0_dp) DO i = 1, n - evals(i) = 1.0_dp/MAX(evals(i)-energy_homo, energy_gap) + evals(i) = 1.0_dp/MAX(evals(i) - energy_homo, energy_gap) ENDDO CALL cp_fm_to_fm(fm, fm_h) CASE (cholesky_reduce) CALL cp_fm_cholesky_restore(fm, n, fm_s, fm_h, "SOLVE") DO i = 1, n - evals(i) = 1.0_dp/MAX(evals(i)-energy_homo, energy_gap) + evals(i) = 1.0_dp/MAX(evals(i) - energy_homo, energy_gap) ENDDO CALL cp_fm_to_fm(fm_h, fm) END SELECT @@ -338,7 +338,7 @@ SUBROUTINE make_full_single_ortho(preconditioner_env, fm, matrix_h, & CALL choose_eigv_solver(fm_h, fm, evals) DO i = 1, n - evals(i) = 1.0_dp/MAX(evals(i)-energy_homo, energy_gap) + evals(i) = 1.0_dp/MAX(evals(i) - energy_homo, energy_gap) ENDDO CALL cp_fm_to_fm(fm, fm_h) CALL cp_fm_column_scale(fm, evals) @@ -448,7 +448,7 @@ SUBROUTINE make_full_all(preconditioner_env, matrix_c0, matrix_h, matrix_s, c0_e CALL cp_gemm('T', 'N', k, k, n, 1.0_dp, matrix_shc0, matrix_shc0, 0.0_dp, matrix_s1) ALLOCATE (diag(k)) CALL cp_fm_get_diag(matrix_s1, diag) - error_estimate = MAXVAL(SQRT(ABS(diag-c0_evals**2))) + error_estimate = MAXVAL(SQRT(ABS(diag - c0_evals**2))) DEALLOCATE (diag) CALL cp_fm_release(matrix_s1) CALL cp_fm_release(matrix_shc0) @@ -473,8 +473,8 @@ SUBROUTINE make_full_all(preconditioner_env, matrix_c0, matrix_h, matrix_s, c0_e CALL cp_fm_release(matrix_left) ALLOCATE (shifted_evals(k)) - lambda = lambda_base+error_estimate - shifted_evals = c0_evals-lambda + lambda = lambda_base + error_estimate + shifted_evals = c0_evals - lambda CALL cp_fm_to_fm(matrix_sc0, matrix_hc0) CALL cp_fm_column_scale(matrix_hc0, shifted_evals) CALL cp_gemm('N', 'T', n, n, k, 1.0_dp, matrix_hc0, matrix_sc0, 1.0_dp, matrix_tmp) @@ -511,7 +511,7 @@ SUBROUTINE make_full_all(preconditioner_env, matrix_c0, matrix_h, matrix_s, c0_e ALLOCATE (norms(k)) CALL cp_gemm('T', 'N', k, k, n, 1.0_dp, matrix_sc0, matrix_tmp, 0.0_dp, matrix_s1) CALL choose_eigv_solver(matrix_s1, matrix_s2, norms) - WRITE (*, *) "matrix norm deviation (should be close to zero): ", MAXVAL(ABS(ABS(norms)-1.0_dp)) + WRITE (*, *) "matrix norm deviation (should be close to zero): ", MAXVAL(ABS(ABS(norms) - 1.0_dp)) DEALLOCATE (norms) CALL cp_fm_release(matrix_s1) CALL cp_fm_release(matrix_s2) @@ -596,7 +596,7 @@ SUBROUTINE make_full_all_ortho(preconditioner_env, matrix_c0, matrix_h, c0_evals CALL cp_gemm('T', 'N', k, k, n, 1.0_dp, matrix_hc0, matrix_hc0, 0.0_dp, matrix_s1) ALLOCATE (diag(k)) CALL cp_fm_get_diag(matrix_s1, diag) - error_estimate = MAXVAL(SQRT(ABS(diag-c0_evals**2))) + error_estimate = MAXVAL(SQRT(ABS(diag - c0_evals**2))) DEALLOCATE (diag) CALL cp_fm_release(matrix_s1) ! we'll only use the energy gap, if our estimate of the error on the eigenvalues @@ -621,8 +621,8 @@ SUBROUTINE make_full_all_ortho(preconditioner_env, matrix_c0, matrix_h, c0_evals CALL cp_fm_release(matrix_left) ALLOCATE (shifted_evals(k)) - lambda = lambda_base+error_estimate - shifted_evals = c0_evals-lambda + lambda = lambda_base + error_estimate + shifted_evals = c0_evals - lambda CALL cp_fm_to_fm(matrix_sc0, matrix_hc0) CALL cp_fm_column_scale(matrix_hc0, shifted_evals) CALL cp_gemm('N', 'T', n, n, k, 1.0_dp, matrix_hc0, matrix_sc0, 1.0_dp, matrix_tmp) @@ -643,7 +643,7 @@ SUBROUTINE make_full_all_ortho(preconditioner_env, matrix_c0, matrix_h, c0_evals CALL cp_gemm('T', 'N', k, k, n, 1.0_dp, matrix_sc0, matrix_tmp, 0.0_dp, matrix_s1) CALL choose_eigv_solver(matrix_s1, matrix_s2, norms) - WRITE (*, *) "matrix norm deviation (should be close to zero): ", MAXVAL(ABS(ABS(norms)-1.0_dp)) + WRITE (*, *) "matrix norm deviation (should be close to zero): ", MAXVAL(ABS(ABS(norms) - 1.0_dp)) DEALLOCATE (norms) CALL cp_fm_release(matrix_s1) CALL cp_fm_release(matrix_s2) @@ -781,9 +781,9 @@ SUBROUTINE make_full_single_inverse(preconditioner_env, matrix_c0, matrix_h, ene !-------------------------------------compute eigenvalues of H ---------------------------------------------- ! Shift the Lumo to the 1.5*the computed energy_gap or the external energy gap value ! The factor 1.5 is determined by trying. If the LUMO is positive, enough, just leave it alone - pre_shift = MAX(1.5_dp*(min_ev-max_ev), energy_gap) + pre_shift = MAX(1.5_dp*(min_ev - max_ev), energy_gap) IF (min_ev .LT. pre_shift) THEN - pre_shift = pre_shift-min_ev + pre_shift = pre_shift - min_ev ELSE pre_shift = 0.0_dp END IF diff --git a/src/prep.f90 b/src/prep.f90 index 0e9b745a78..a717fe13e3 100644 --- a/src/prep.f90 +++ b/src/prep.f90 @@ -9,12 +9,12 @@ iaxis = 3 t_exp_1 = EXP(-zetp*dr(iaxis)**2) t_exp_2 = t_exp_1**2 - t_exp_min_1 = EXP(-zetp*(+dr(iaxis)-roffset(iaxis))**2) - t_exp_min_2 = EXP(-2*zetp*(+dr(iaxis)-roffset(iaxis))*(-dr(iaxis))) + t_exp_min_1 = EXP(-zetp*(+dr(iaxis) - roffset(iaxis))**2) + t_exp_min_2 = EXP(-2*zetp*(+dr(iaxis) - roffset(iaxis))*(-dr(iaxis))) t_exp_plus_1 = EXP(-zetp*(-roffset(iaxis))**2) t_exp_plus_2 = EXP(-2*zetp*(-roffset(iaxis))*(+dr(iaxis))) DO ig = 0, lb_cube(iaxis), -1 - rpg = REAL(ig, dp)*dr(iaxis)-roffset(iaxis) + rpg = REAL(ig, dp)*dr(iaxis) - roffset(iaxis) t_exp_min_1 = t_exp_min_1*t_exp_min_2*t_exp_1 t_exp_min_2 = t_exp_min_2*t_exp_2 pg = t_exp_min_1 @@ -24,7 +24,7 @@ pg = pg*(rpg) ENDDO - rpg = REAL(1-ig, dp)*dr(iaxis)-roffset(iaxis) + rpg = REAL(1 - ig, dp)*dr(iaxis) - roffset(iaxis) t_exp_plus_1 = t_exp_plus_1*t_exp_plus_2*t_exp_1 t_exp_plus_2 = t_exp_plus_2*t_exp_2 pg = t_exp_plus_1 @@ -38,12 +38,12 @@ iaxis = 2 t_exp_1 = EXP(-zetp*dr(iaxis)**2) t_exp_2 = t_exp_1**2 - t_exp_min_1 = EXP(-zetp*(+dr(iaxis)-roffset(iaxis))**2) - t_exp_min_2 = EXP(-2*zetp*(+dr(iaxis)-roffset(iaxis))*(-dr(iaxis))) + t_exp_min_1 = EXP(-zetp*(+dr(iaxis) - roffset(iaxis))**2) + t_exp_min_2 = EXP(-2*zetp*(+dr(iaxis) - roffset(iaxis))*(-dr(iaxis))) t_exp_plus_1 = EXP(-zetp*(-roffset(iaxis))**2) t_exp_plus_2 = EXP(-2*zetp*(-roffset(iaxis))*(+dr(iaxis))) DO ig = 0, lb_cube(iaxis), -1 - rpg = REAL(ig, dp)*dr(iaxis)-roffset(iaxis) + rpg = REAL(ig, dp)*dr(iaxis) - roffset(iaxis) t_exp_min_1 = t_exp_min_1*t_exp_min_2*t_exp_1 t_exp_min_2 = t_exp_min_2*t_exp_2 pg = t_exp_min_1 @@ -53,7 +53,7 @@ pg = pg*(rpg) ENDDO - rpg = REAL(1-ig, dp)*dr(iaxis)-roffset(iaxis) + rpg = REAL(1 - ig, dp)*dr(iaxis) - roffset(iaxis) t_exp_plus_1 = t_exp_plus_1*t_exp_plus_2*t_exp_1 t_exp_plus_2 = t_exp_plus_2*t_exp_2 pg = t_exp_plus_1 @@ -67,13 +67,13 @@ iaxis = 1 t_exp_1 = EXP(-zetp*dr(iaxis)**2) t_exp_2 = t_exp_1**2 - t_exp_min_1 = EXP(-zetp*(+dr(iaxis)-roffset(iaxis))**2) - t_exp_min_2 = EXP(-2*zetp*(+dr(iaxis)-roffset(iaxis))*(-dr(iaxis))) + t_exp_min_1 = EXP(-zetp*(+dr(iaxis) - roffset(iaxis))**2) + t_exp_min_2 = EXP(-2*zetp*(+dr(iaxis) - roffset(iaxis))*(-dr(iaxis))) t_exp_plus_1 = EXP(-zetp*(-roffset(iaxis))**2) t_exp_plus_2 = EXP(-2*zetp*(-roffset(iaxis))*(+dr(iaxis))) DO ig = 0, lb_cube(1), -1 - rpg = REAL(ig, dp)*dr(1)-roffset(1) + rpg = REAL(ig, dp)*dr(1) - roffset(1) t_exp_min_1 = t_exp_min_1*t_exp_min_2*t_exp_1 t_exp_min_2 = t_exp_min_2*t_exp_2 pg = t_exp_min_1 @@ -83,13 +83,13 @@ pg = pg*(rpg) ENDDO - rpg = REAL(1-ig, dp)*dr(1)-roffset(1) + rpg = REAL(1 - ig, dp)*dr(1) - roffset(1) t_exp_plus_1 = t_exp_plus_1*t_exp_plus_2*t_exp_1 t_exp_plus_2 = t_exp_plus_2*t_exp_2 pg = t_exp_plus_1 ! pg = EXP(-zetp*rpg**2) DO icoef = 0, lp - pol_x(icoef, 1-ig) = pg + pol_x(icoef, 1 - ig) = pg pg = pg*(rpg) ENDDO ENDDO diff --git a/src/pw/cube_utils.F b/src/pw/cube_utils.F index 1ae24989c8..8af58c6903 100644 --- a/src/pw/cube_utils.F +++ b/src/pw/cube_utils.F @@ -72,8 +72,8 @@ SUBROUTINE compute_cube_center(cube_center, rs_desc, zeta, zetb, ra, rab) REAL(KIND=dp) :: zetp REAL(KIND=dp), DIMENSION(3) :: rp - zetp = zeta+zetb - rp(:) = ra(:)+zetb/zetp*rab(:) + zetp = zeta + zetb + rp(:) = ra(:) + zetb/zetp*rab(:) cube_center(:) = FLOOR(MATMUL(rs_desc%dh_inv, rp)) END SUBROUTINE compute_cube_center @@ -118,9 +118,9 @@ SUBROUTINE return_cube_nonortho(info, radius, lb, ub, rp) DO i = -1, 1 DO j = -1, 1 DO k = -1, 1 - point(1) = rp(1)+i*radius - point(2) = rp(2)+j*radius - point(3) = rp(3)+k*radius + point(1) = rp(1) + i*radius + point(2) = rp(2) + j*radius + point(3) = rp(3) + k*radius CALL matvec_3x3(res, info%dh_inv, point) lb = MIN(lb, FLOOR(res)) ub = MAX(ub, CEILING(res)) @@ -272,19 +272,19 @@ SUBROUTINE init_cube_info(info, dr, dh, dh_inv, ortho, max_radius) radius = i*drmin radius2 = radius**2 kgmin = do_and_hide_it_1(dzi, i, drmin, 0.0_dp, 0.0_dp, 0, 0) - k = k+1 + k = k + 1 DO kg = kgmin, 0 kg2 = kg*kg jgmin = do_and_hide_it_1(dyi, i, drmin, dz2, 0.0_dp, kg2, 0) - k = k+1 + k = k + 1 DO jg = jgmin, 0 jg2 = jg*jg igmin = do_and_hide_it_1(dxi, i, drmin, dz2, dy2, kg2, jg2) - check_1 = MODULO((kgmin*97+jgmin*37+igmin*113)*check_1+1277, 9343) - k = k+1 + check_1 = MODULO((kgmin*97 + jgmin*37 + igmin*113)*check_1 + 1277, 9343) + k = k + 1 ENDDO ENDDO - info%sphere_bounds_count(i) = k-1 + info%sphere_bounds_count(i) = k - 1 ALLOCATE (info%sphere_bounds(i)%p(info%sphere_bounds_count(i))) ENDDO @@ -298,23 +298,23 @@ SUBROUTINE init_cube_info(info, dr, dh, dh_inv, ortho, max_radius) kgmin = do_and_hide_it_1(dzi, i, drmin, 0.0_dp, 0.0_dp, 0, 0) info%lb_cube(3, i) = MIN(kgmin, info%lb_cube(3, i)) info%sphere_bounds(i)%p(k) = kgmin - k = k+1 + k = k + 1 DO kg = kgmin, 0 kg2 = kg*kg jgmin = do_and_hide_it_1(dyi, i, drmin, dz2, 0.0_dp, kg2, 0) info%lb_cube(2, i) = MIN(jgmin, info%lb_cube(2, i)) info%sphere_bounds(i)%p(k) = jgmin - k = k+1 + k = k + 1 DO jg = jgmin, 0 jg2 = jg*jg igmin = do_and_hide_it_1(dxi, i, drmin, dz2, dy2, kg2, jg2) - check_2 = MODULO((kgmin*97+jgmin*37+igmin*113)*check_2+1277, 9343) + check_2 = MODULO((kgmin*97 + jgmin*37 + igmin*113)*check_2 + 1277, 9343) info%lb_cube(1, i) = MIN(igmin, info%lb_cube(1, i)) info%sphere_bounds(i)%p(k) = igmin - k = k+1 + k = k + 1 ENDDO ENDDO - info%ub_cube(:, i) = 1-info%lb_cube(:, i) + info%ub_cube(:, i) = 1 - info%lb_cube(:, i) ENDDO IF (check_1 .NE. check_2) THEN CPABORT("Irreproducible fp math caused memory corruption") @@ -371,7 +371,7 @@ FUNCTION do_and_hide_it_2(buf, i, jg2, kg2) RESULT(res) INTEGER :: i, jg2, kg2, res buf(2) = (i*buf(2))**2 - res = CEILING(-0.1E-7_dp-buf(1)*SQRT(MAX(buf(2)-kg2*buf(3)-jg2*buf(4), 0.0_dp))) + res = CEILING(-0.1E-7_dp - buf(1)*SQRT(MAX(buf(2) - kg2*buf(3) - jg2*buf(4), 0.0_dp))) END FUNCTION do_and_hide_it_2 END MODULE cube_utils diff --git a/src/pw/dct.F b/src/pw/dct.F index 4583e2d366..7ce081837c 100644 --- a/src/pw/dct.F +++ b/src/pw/dct.F @@ -346,31 +346,31 @@ SUBROUTINE set_dests_srcs_pid(pw_grid, neumann_directions, dests_expand, srcs_ex IF (MOD(rs_dim1, 2) .EQ. 0) THEN tmp_size1 = rs_dim1 ELSE - tmp_size1 = rs_dim1+1 + tmp_size1 = rs_dim1 + 1 END IF - ALLOCATE (tmp1_arr(tmp_size1), src_pos1(2, 0:rs_dim1-1)) + ALLOCATE (tmp1_arr(tmp_size1), src_pos1(2, 0:rs_dim1 - 1)) IF (MOD(rs_dim1, 2) .EQ. 0) THEN tmp1_arr(:) = (/(i, i=1, rs_dim1)/) src_pos1(:, :) = RESHAPE((/tmp1_arr, -tmp1_arr(tmp_size1:1:-1)/), (/2, rs_dim1/)) ELSE tmp1_arr(:) = (/(i, i=1, rs_dim1), -rs_dim1/) - src_pos1(:, :) = RESHAPE((/tmp1_arr, -tmp1_arr(tmp_size1-2:1:-1)/), (/2, rs_dim1/)) + src_pos1(:, :) = RESHAPE((/tmp1_arr, -tmp1_arr(tmp_size1 - 2:1:-1)/), (/2, rs_dim1/)) END IF !--- IF (MOD(rs_dim2, 2) .EQ. 0) THEN tmp_size2 = rs_dim2 ELSE - tmp_size2 = rs_dim2+1 + tmp_size2 = rs_dim2 + 1 END IF - ALLOCATE (tmp2_arr(tmp_size2), src_pos2(2, 0:rs_dim2-1)) + ALLOCATE (tmp2_arr(tmp_size2), src_pos2(2, 0:rs_dim2 - 1)) IF (MOD(rs_dim2, 2) .EQ. 0) THEN tmp2_arr(:) = (/(i, i=1, rs_dim2)/) src_pos2(:, :) = RESHAPE((/tmp2_arr, -tmp2_arr(tmp_size2:1:-1)/), (/2, rs_dim2/)) ELSE tmp2_arr(:) = (/(i, i=1, rs_dim2), -rs_dim2/) - src_pos2(:, :) = RESHAPE((/tmp2_arr, -tmp2_arr(tmp_size2-2:1:-1)/), (/2, rs_dim2/)) + src_pos2(:, :) = RESHAPE((/tmp2_arr, -tmp2_arr(tmp_size2 - 2:1:-1)/), (/2, rs_dim2/)) END IF !--- srcs_coord(:, 1) = (/src_pos1(1, rs_pos(1)), src_pos2(1, rs_pos(2))/) @@ -384,19 +384,19 @@ SUBROUTINE set_dests_srcs_pid(pw_grid, neumann_directions, dests_expand, srcs_ex IF (MOD(rs_dim1, 2) .EQ. 0) THEN tmp_size1 = rs_dim1 ELSE - tmp_size1 = rs_dim1+1 + tmp_size1 = rs_dim1 + 1 END IF - ALLOCATE (tmp1_arr(tmp_size1), src_pos1(2, 0:rs_dim1-1)) + ALLOCATE (tmp1_arr(tmp_size1), src_pos1(2, 0:rs_dim1 - 1)) IF (MOD(rs_dim1, 2) .EQ. 0) THEN tmp1_arr(:) = (/(i, i=1, rs_dim1)/) src_pos1(:, :) = RESHAPE((/tmp1_arr, -tmp1_arr(tmp_size1:1:-1)/), (/2, rs_dim1/)) ELSE tmp1_arr(:) = (/(i, i=1, rs_dim1), -rs_dim1/) - src_pos1(:, :) = RESHAPE((/tmp1_arr, -tmp1_arr(tmp_size1-2:1:-1)/), (/2, rs_dim1/)) + src_pos1(:, :) = RESHAPE((/tmp1_arr, -tmp1_arr(tmp_size1 - 2:1:-1)/), (/2, rs_dim1/)) END IF !--- - ALLOCATE (src_pos2_onesdd(0:rs_dim2-1)) + ALLOCATE (src_pos2_onesdd(0:rs_dim2 - 1)) src_pos2_onesdd(:) = (/(i, i=1, rs_dim2)/) !--- srcs_coord(:, 1) = (/src_pos1(1, rs_pos(1)), src_pos2_onesdd(rs_pos(2))/) @@ -405,22 +405,22 @@ SUBROUTINE set_dests_srcs_pid(pw_grid, neumann_directions, dests_expand, srcs_ex maxn_sendrecv = 2 ALLOCATE (srcs_coord(2, maxn_sendrecv)) - ALLOCATE (src_pos1_onesdd(0:rs_dim1-1)) + ALLOCATE (src_pos1_onesdd(0:rs_dim1 - 1)) src_pos1_onesdd(:) = (/(i, i=1, rs_dim1)/) !--- IF (MOD(rs_dim2, 2) .EQ. 0) THEN tmp_size2 = rs_dim2 ELSE - tmp_size2 = rs_dim2+1 + tmp_size2 = rs_dim2 + 1 END IF - ALLOCATE (tmp2_arr(tmp_size2), src_pos2(2, 0:rs_dim2-1)) + ALLOCATE (tmp2_arr(tmp_size2), src_pos2(2, 0:rs_dim2 - 1)) IF (MOD(rs_dim2, 2) .EQ. 0) THEN tmp2_arr(:) = (/(i, i=1, rs_dim2)/) src_pos2(:, :) = RESHAPE((/tmp2_arr, -tmp2_arr(tmp_size2:1:-1)/), (/2, rs_dim2/)) ELSE tmp2_arr(:) = (/(i, i=1, rs_dim2), -rs_dim2/) - src_pos2(:, :) = RESHAPE((/tmp2_arr, -tmp2_arr(tmp_size2-2:1:-1)/), (/2, rs_dim2/)) + src_pos2(:, :) = RESHAPE((/tmp2_arr, -tmp2_arr(tmp_size2 - 2:1:-1)/), (/2, rs_dim2/)) END IF !--- srcs_coord(:, 1) = (/src_pos1_onesdd(rs_pos(1)), src_pos2(1, rs_pos(2))/) @@ -428,8 +428,8 @@ SUBROUTINE set_dests_srcs_pid(pw_grid, neumann_directions, dests_expand, srcs_ex CASE (neumannZ) maxn_sendrecv = 1 ALLOCATE (srcs_coord(2, maxn_sendrecv)) - ALLOCATE (src_pos1_onesdd(0:rs_dim1-1)) - ALLOCATE (src_pos2_onesdd(0:rs_dim2-1)) + ALLOCATE (src_pos1_onesdd(0:rs_dim1 - 1)) + ALLOCATE (src_pos2_onesdd(0:rs_dim2 - 1)) src_pos1_onesdd(:) = (/(i, i=1, rs_dim1)/) !--- @@ -443,7 +443,7 @@ SUBROUTINE set_dests_srcs_pid(pw_grid, neumann_directions, dests_expand, srcs_ex DO k = 1, maxn_sendrecv ! convert srcs_coord to pid - CALL mp_cart_rank(pw_grid%para%rs_group, ABS(srcs_coord(:, k))-1, srcs_expand(k)) + CALL mp_cart_rank(pw_grid%para%rs_group, ABS(srcs_coord(:, k)) - 1, srcs_expand(k)) ! find out the flipping status IF ((srcs_coord(1, k) .GT. 0) .AND. (srcs_coord(2, k) .GT. 0)) THEN flipg_stat(k) = NOT_FLIPPED @@ -465,8 +465,8 @@ SUBROUTINE set_dests_srcs_pid(pw_grid, neumann_directions, dests_expand, srcs_ex DO i = 1, group_size DO j = 1, maxn_sendrecv IF (srcs_expand_all(j, i) .EQ. rs_mpo) THEN - dests_expand(k) = i-1 - k = k+1 + dests_expand(k) = i - 1 + k = k + 1 END IF END DO END DO @@ -491,7 +491,7 @@ SUBROUTINE set_dests_srcs_pid(pw_grid, neumann_directions, dests_expand, srcs_ex DO i = 1, group_size DO j = 1, maxn_sendrecv IF (dests_shrink_all(j, i) .EQ. rs_mpo) THEN - srcs_shrink = i-1 + srcs_shrink = i - 1 EXIT END IF END DO @@ -596,7 +596,7 @@ SUBROUTINE pw_expand(neumann_directions, recv_msgs_bnds, dests_expand, srcs_expa recv_msgs(i)%msg = send_msg ! if I have already received data from the source, just use the one from the last time ELSE IF (ANY(src_hist .EQ. srcs_expand(i))) THEN - loc = MINLOC(ABS(src_hist-srcs_expand(i)), 1) + loc = MINLOC(ABS(src_hist - srcs_expand(i)), 1) lb1_loc = recv_msgs_bnds(1, 1, loc) ub1_loc = recv_msgs_bnds(2, 1, loc) lb2_loc = recv_msgs_bnds(1, 2, loc) @@ -617,7 +617,7 @@ SUBROUTINE pw_expand(neumann_directions, recv_msgs_bnds, dests_expand, srcs_expa ! flip the received data according on the flipping status DO i = 1, maxn_sendrecv - SELECT CASE (flipg_stat (i)) + SELECT CASE (flipg_stat(i)) CASE (NOT_FLIPPED) lb1 = recv_msgs_bnds(1, 1, i) ub1 = recv_msgs_bnds(2, 1, i) @@ -654,8 +654,8 @@ SUBROUTINE pw_expand(neumann_directions, recv_msgs_bnds, dests_expand, srcs_expa SELECT CASE (neumann_directions) CASE (neumannXYZ, neumannXZ, neumannYZ, neumannZ) - ind = INT(0.5*(ub3_new+lb3_new+1)) - ALLOCATE (catd(lb1_new:ub1_new, lb2_new:ub2_new, lb3_new:ind-1)) + ind = INT(0.5*(ub3_new + lb3_new + 1)) + ALLOCATE (catd(lb1_new:ub1_new, lb2_new:ub2_new, lb3_new:ind - 1)) CASE (neumannXY, neumannX, neumannY) ALLOCATE (catd(lb1_new:ub1_new, lb2_new:ub2_new, lb3_new:ub3_new)) END SELECT @@ -672,7 +672,7 @@ SUBROUTINE pw_expand(neumann_directions, recv_msgs_bnds, dests_expand, srcs_expa ALLOCATE (cr3d_xpndd(lb1_new:ub1_new, lb2_new:ub2_new, lb3_new:ub3_new)) SELECT CASE (neumann_directions) CASE (neumannXYZ, neumannXZ, neumannYZ, neumannZ) - cr3d_xpndd(:, :, lb3_new:ind-1) = catd + cr3d_xpndd(:, :, lb3_new:ind - 1) = catd cr3d_xpndd(:, :, ind:ub3_new) = catd_flipdbf CASE (neumannXY, neumannX, neumannY) cr3d_xpndd(:, :, :) = catd @@ -758,12 +758,12 @@ SUBROUTINE pw_shrink(neumann_directions, dests_shrink, srcs_shrink, bounds_local IF (in_space .EQ. RECIPROCALSPACE) THEN ALLOCATE (cr3d(lb1_xpnd:ub1_xpnd, lb2_xpnd:ub2_xpnd, lb3_xpnd:ub3_xpnd)) ALLOCATE (cc3d(lb1_xpnd:ub1_xpnd, lb2_xpnd:ub2_xpnd, lb3_xpnd:ub3_xpnd)) - cc3d = RESHAPE(pw_in%cc, (/ub1_xpnd-lb1_xpnd+1, ub2_xpnd-lb2_xpnd+1, ub3_xpnd-lb3_xpnd+1/)) + cc3d = RESHAPE(pw_in%cc, (/ub1_xpnd - lb1_xpnd + 1, ub2_xpnd - lb2_xpnd + 1, ub3_xpnd - lb3_xpnd + 1/)) CALL copy_cr(cc3d, cr3d) DEALLOCATE (cc3d) ELSE ALLOCATE (cr3d(lb1_xpnd:ub1_xpnd, lb2_xpnd:ub2_xpnd, lb3_xpnd:ub3_xpnd)) - cr3d = RESHAPE(pw_in%cr, (/ub1_xpnd-lb1_xpnd+1, ub2_xpnd-lb2_xpnd+1, ub3_xpnd-lb3_xpnd+1/)) + cr3d = RESHAPE(pw_in%cr, (/ub1_xpnd - lb1_xpnd + 1, ub2_xpnd - lb2_xpnd + 1, ub3_xpnd - lb3_xpnd + 1/)) END IF ELSE IF (in_space .EQ. RECIPROCALSPACE) THEN @@ -781,12 +781,12 @@ SUBROUTINE pw_shrink(neumann_directions, dests_shrink, srcs_shrink, bounds_local DO i = 1, maxn_sendrecv ! no need to send to myself or to an invalid destination (pid = -1) IF ((dests_shrink(i) .NE. rs_mpo) .AND. (dests_shrink(i) .NE. -1)) THEN - send_lb1 = bounds_local_all(1, 1, dests_shrink(i)+1) - send_ub1 = bounds_local_all(2, 1, dests_shrink(i)+1) - send_lb2 = bounds_local_all(1, 2, dests_shrink(i)+1) - send_ub2 = bounds_local_all(2, 2, dests_shrink(i)+1) - send_lb3 = bounds_local_all(1, 3, dests_shrink(i)+1) - send_ub3 = bounds_local_all(2, 3, dests_shrink(i)+1) + send_lb1 = bounds_local_all(1, 1, dests_shrink(i) + 1) + send_ub1 = bounds_local_all(2, 1, dests_shrink(i) + 1) + send_lb2 = bounds_local_all(1, 2, dests_shrink(i) + 1) + send_ub2 = bounds_local_all(2, 2, dests_shrink(i) + 1) + send_lb3 = bounds_local_all(1, 3, dests_shrink(i) + 1) + send_ub3 = bounds_local_all(2, 3, dests_shrink(i) + 1) ALLOCATE (send_crmsg(send_lb1:send_ub1, send_lb2:send_ub2, send_lb3:send_ub3)) send_crmsg = cr3d(send_lb1:send_ub1, send_lb2:send_ub2, send_lb3:send_ub3) @@ -864,9 +864,9 @@ SUBROUTINE flipud(cr3d_in, cr3d_out, bounds) ! set the data at the missing grid points (in a periodic grid) equal to the data at ! the last existing grid points - ALLOCATE (indx(ub1_new-lb1_new+1)) - indx(:) = (/(i, i=2*(ub1_glbl+1)-lb1_new, 2*(ub1_glbl+1)-ub1_new, -1)/) - IF (lb1_new .EQ. ub1_glbl+1) indx(1) = indx(2) + ALLOCATE (indx(ub1_new - lb1_new + 1)) + indx(:) = (/(i, i=2*(ub1_glbl + 1) - lb1_new, 2*(ub1_glbl + 1) - ub1_new, -1)/) + IF (lb1_new .EQ. ub1_glbl + 1) indx(1) = indx(2) cr3d_out(lb1_new:ub1_new, lb2_new:ub2_new, lb3_new:ub3_new) = cr3d_in(indx, :, :) CALL timestop(handle) @@ -918,9 +918,9 @@ SUBROUTINE fliplr(cr3d_in, cr3d_out, bounds) ! set the data at the missing grid points (in a periodic grid) equal to the data at ! the last existing grid points - ALLOCATE (indy(ub2_new-lb2_new+1)) - indy(:) = (/(i, i=2*(ub2_glbl+1)-lb2_new, 2*(ub2_glbl+1)-ub2_new, -1)/) - IF (lb2_new .EQ. ub2_glbl+1) indy(1) = indy(2) + ALLOCATE (indy(ub2_new - lb2_new + 1)) + indy(:) = (/(i, i=2*(ub2_glbl + 1) - lb2_new, 2*(ub2_glbl + 1) - ub2_new, -1)/) + IF (lb2_new .EQ. ub2_glbl + 1) indy(1) = indy(2) cr3d_out(lb1_new:ub1_new, lb2_new:ub2_new, lb3_new:ub3_new) = cr3d_in(:, indy, :) CALL timestop(handle) @@ -972,9 +972,9 @@ SUBROUTINE flipbf(cr3d_in, cr3d_out, bounds) ! set the data at the missing grid points (in a periodic grid) equal to the data at ! the last existing grid points - ALLOCATE (indz(ub3_new-lb3_new+1)) - indz(:) = (/(i, i=2*(ub3_glbl+1)-lb3_new, 2*(ub3_glbl+1)-ub3_new, -1)/) - IF (lb3_new .EQ. ub3_glbl+1) indz(1) = indz(2) + ALLOCATE (indz(ub3_new - lb3_new + 1)) + indz(:) = (/(i, i=2*(ub3_glbl + 1) - lb3_new, 2*(ub3_glbl + 1) - ub3_new, -1)/) + IF (lb3_new .EQ. ub3_glbl + 1) indz(1) = indz(2) cr3d_out(lb1_new:ub1_new, lb2_new:ub2_new, lb3_new:ub3_new) = cr3d_in(:, :, indz) CALL timestop(handle) @@ -1026,11 +1026,11 @@ SUBROUTINE rot180(cr3d_in, cr3d_out, bounds) ! set the data at the missing grid points (in a periodic grid) equal to the data at ! the last existing grid points - ALLOCATE (indx(ub1_new-lb1_new+1), indy(ub2_new-lb2_new+1)) - indx(:) = (/(i, i=2*(ub1_glbl+1)-lb1_new, 2*(ub1_glbl+1)-ub1_new, -1)/) - indy(:) = (/(i, i=2*(ub2_glbl+1)-lb2_new, 2*(ub2_glbl+1)-ub2_new, -1)/) - IF (lb1_new .EQ. ub1_glbl+1) indx(1) = indx(2) - IF (lb2_new .EQ. ub2_glbl+1) indy(1) = indy(2) + ALLOCATE (indx(ub1_new - lb1_new + 1), indy(ub2_new - lb2_new + 1)) + indx(:) = (/(i, i=2*(ub1_glbl + 1) - lb1_new, 2*(ub1_glbl + 1) - ub1_new, -1)/) + indy(:) = (/(i, i=2*(ub2_glbl + 1) - lb2_new, 2*(ub2_glbl + 1) - ub2_new, -1)/) + IF (lb1_new .EQ. ub1_glbl + 1) indx(1) = indx(2) + IF (lb2_new .EQ. ub2_glbl + 1) indy(1) = indy(2) cr3d_out(lb1_new:ub1_new, lb2_new:ub2_new, lb3_new:ub3_new) = cr3d_in(indx, indy, :) CALL timestop(handle) @@ -1114,13 +1114,13 @@ SUBROUTINE expansion_bounds(pw_grid, neumann_directions, srcs_expand, flipg_stat ! Note that this is not easily FFT-able ... needed anyway, so link in FFTW. npts_new = 2*pw_grid%npts shift = -npts_new/2 - shift = shift-bounds(1, :) - bounds_shftd(:, 1) = bounds(:, 1)+shf_yesno(1)*shift(1) - bounds_shftd(:, 2) = bounds(:, 2)+shf_yesno(2)*shift(2) - bounds_shftd(:, 3) = bounds(:, 3)+shf_yesno(3)*shift(3) - bounds_local_shftd(:, 1) = bounds_local(:, 1)+shf_yesno(1)*shift(1) - bounds_local_shftd(:, 2) = bounds_local(:, 2)+shf_yesno(2)*shift(2) - bounds_local_shftd(:, 3) = bounds_local(:, 3)+shf_yesno(3)*shift(3) + shift = shift - bounds(1, :) + bounds_shftd(:, 1) = bounds(:, 1) + shf_yesno(1)*shift(1) + bounds_shftd(:, 2) = bounds(:, 2) + shf_yesno(2)*shift(2) + bounds_shftd(:, 3) = bounds(:, 3) + shf_yesno(3)*shift(3) + bounds_local_shftd(:, 1) = bounds_local(:, 1) + shf_yesno(1)*shift(1) + bounds_local_shftd(:, 2) = bounds_local(:, 2) + shf_yesno(2)*shift(2) + bounds_local_shftd(:, 3) = bounds_local(:, 3) + shf_yesno(3)*shift(3) ! let all the nodes know about each others local shifted bounds ALLOCATE (bounds_local_all(2, 3, group_size)) @@ -1139,27 +1139,27 @@ SUBROUTINE expansion_bounds(pw_grid, neumann_directions, srcs_expand, flipg_stat recv_msgs_bnds(2, 3, i) = bounds_local_shftd(2, 3) ! if I have already received data from the source, just use the one from the last time ELSE IF (ANY(src_hist .EQ. srcs_expand(i))) THEN - loc = MINLOC(ABS(src_hist-srcs_expand(i)), 1) - recv_msgs_bnds(1, 1, i) = bounds_local_all(1, 1, srcs_expand(loc)+1) - recv_msgs_bnds(2, 1, i) = bounds_local_all(2, 1, srcs_expand(loc)+1) - recv_msgs_bnds(1, 2, i) = bounds_local_all(1, 2, srcs_expand(loc)+1) - recv_msgs_bnds(2, 2, i) = bounds_local_all(2, 2, srcs_expand(loc)+1) - recv_msgs_bnds(1, 3, i) = bounds_local_all(1, 3, srcs_expand(loc)+1) - recv_msgs_bnds(2, 3, i) = bounds_local_all(2, 3, srcs_expand(loc)+1) + loc = MINLOC(ABS(src_hist - srcs_expand(i)), 1) + recv_msgs_bnds(1, 1, i) = bounds_local_all(1, 1, srcs_expand(loc) + 1) + recv_msgs_bnds(2, 1, i) = bounds_local_all(2, 1, srcs_expand(loc) + 1) + recv_msgs_bnds(1, 2, i) = bounds_local_all(1, 2, srcs_expand(loc) + 1) + recv_msgs_bnds(2, 2, i) = bounds_local_all(2, 2, srcs_expand(loc) + 1) + recv_msgs_bnds(1, 3, i) = bounds_local_all(1, 3, srcs_expand(loc) + 1) + recv_msgs_bnds(2, 3, i) = bounds_local_all(2, 3, srcs_expand(loc) + 1) ELSE - recv_msgs_bnds(1, 1, i) = bounds_local_all(1, 1, srcs_expand(i)+1) - recv_msgs_bnds(2, 1, i) = bounds_local_all(2, 1, srcs_expand(i)+1) - recv_msgs_bnds(1, 2, i) = bounds_local_all(1, 2, srcs_expand(i)+1) - recv_msgs_bnds(2, 2, i) = bounds_local_all(2, 2, srcs_expand(i)+1) - recv_msgs_bnds(1, 3, i) = bounds_local_all(1, 3, srcs_expand(i)+1) - recv_msgs_bnds(2, 3, i) = bounds_local_all(2, 3, srcs_expand(i)+1) + recv_msgs_bnds(1, 1, i) = bounds_local_all(1, 1, srcs_expand(i) + 1) + recv_msgs_bnds(2, 1, i) = bounds_local_all(2, 1, srcs_expand(i) + 1) + recv_msgs_bnds(1, 2, i) = bounds_local_all(1, 2, srcs_expand(i) + 1) + recv_msgs_bnds(2, 2, i) = bounds_local_all(2, 2, srcs_expand(i) + 1) + recv_msgs_bnds(1, 3, i) = bounds_local_all(1, 3, srcs_expand(i) + 1) + recv_msgs_bnds(2, 3, i) = bounds_local_all(2, 3, srcs_expand(i) + 1) END IF src_hist(i) = srcs_expand(i) END DO ! flip the received data based on the flipping status DO i = 1, maxn_sendrecv - SELECT CASE (flipg_stat (i)) + SELECT CASE (flipg_stat(i)) CASE (NOT_FLIPPED) pcs_bnds(:, :, i) = recv_msgs_bnds(:, :, i) CASE (UD_FLIPPED) @@ -1185,7 +1185,7 @@ SUBROUTINE expansion_bounds(pw_grid, neumann_directions, srcs_expand, flipg_stat bounds_local_new(1, 3) = MINVAL(pcs_bnds(1, 3, :)) SELECT CASE (neumann_directions) CASE (neumannXYZ, neumannXZ, neumannYZ, neumannZ) - bounds_local_new(2, 3) = 2*(MAXVAL(pcs_bnds(2, 3, :))+1)-bounds_local_new(1, 3)-1 + bounds_local_new(2, 3) = 2*(MAXVAL(pcs_bnds(2, 3, :)) + 1) - bounds_local_new(1, 3) - 1 CASE (neumannXY, neumannX, neumannY) bounds_local_new(2, 3) = MAXVAL(pcs_bnds(2, 3, :)) END SELECT @@ -1226,10 +1226,10 @@ FUNCTION flipud_bounds_local(bndsl_in, bounds) RESULT(bndsl_out) CALL timeset(routineN, handle) - bndsl_out(1, 1) = 2*(bounds(2, 1)+1)-bndsl_in(2, 1) - bndsl_out(2, 1) = 2*(bounds(2, 1)+1)-bndsl_in(1, 1) - IF (bndsl_out(1, 1) .EQ. bounds(2, 1)+2) bndsl_out(1, 1) = bndsl_out(1, 1)-1 - IF (bndsl_out(2, 1) .EQ. 2*(bounds(2, 1)+1)-bounds(1, 1)) bndsl_out(2, 1) = bndsl_out(2, 1)-1 + bndsl_out(1, 1) = 2*(bounds(2, 1) + 1) - bndsl_in(2, 1) + bndsl_out(2, 1) = 2*(bounds(2, 1) + 1) - bndsl_in(1, 1) + IF (bndsl_out(1, 1) .EQ. bounds(2, 1) + 2) bndsl_out(1, 1) = bndsl_out(1, 1) - 1 + IF (bndsl_out(2, 1) .EQ. 2*(bounds(2, 1) + 1) - bounds(1, 1)) bndsl_out(2, 1) = bndsl_out(2, 1) - 1 bndsl_out(1, 2) = bndsl_in(1, 2) bndsl_out(2, 2) = bndsl_in(2, 2) @@ -1265,10 +1265,10 @@ FUNCTION fliplr_bounds_local(bndsl_in, bounds) RESULT(bndsl_out) bndsl_out(1, 1) = bndsl_in(1, 1) bndsl_out(2, 1) = bndsl_in(2, 1) - bndsl_out(1, 2) = 2*(bounds(2, 2)+1)-bndsl_in(2, 2) - bndsl_out(2, 2) = 2*(bounds(2, 2)+1)-bndsl_in(1, 2) - IF (bndsl_out(1, 2) .EQ. bounds(2, 2)+2) bndsl_out(1, 2) = bndsl_out(1, 2)-1 - IF (bndsl_out(2, 2) .EQ. 2*(bounds(2, 2)+1)-bounds(1, 2)) bndsl_out(2, 2) = bndsl_out(2, 2)-1 + bndsl_out(1, 2) = 2*(bounds(2, 2) + 1) - bndsl_in(2, 2) + bndsl_out(2, 2) = 2*(bounds(2, 2) + 1) - bndsl_in(1, 2) + IF (bndsl_out(1, 2) .EQ. bounds(2, 2) + 2) bndsl_out(1, 2) = bndsl_out(1, 2) - 1 + IF (bndsl_out(2, 2) .EQ. 2*(bounds(2, 2) + 1) - bounds(1, 2)) bndsl_out(2, 2) = bndsl_out(2, 2) - 1 bndsl_out(1, 3) = bndsl_in(1, 3) bndsl_out(2, 3) = bndsl_in(2, 3) @@ -1304,10 +1304,10 @@ FUNCTION flipbf_bounds_local(bndsl_in, bounds) RESULT(bndsl_out) bndsl_out(1, 2) = bndsl_in(1, 2) bndsl_out(2, 2) = bndsl_in(2, 2) - bndsl_out(1, 3) = 2*(bounds(2, 3)+1)-bndsl_in(2, 3) - bndsl_out(2, 3) = 2*(bounds(2, 3)+1)-bndsl_in(1, 3) - IF (bndsl_out(1, 3) .EQ. bounds(2, 3)+2) bndsl_out(1, 3) = bndsl_out(1, 3)-1 - IF (bndsl_out(2, 3) .EQ. 2*(bounds(2, 3)+1)-bounds(1, 3)) bndsl_out(2, 3) = bndsl_out(2, 3)-1 + bndsl_out(1, 3) = 2*(bounds(2, 3) + 1) - bndsl_in(2, 3) + bndsl_out(2, 3) = 2*(bounds(2, 3) + 1) - bndsl_in(1, 3) + IF (bndsl_out(1, 3) .EQ. bounds(2, 3) + 2) bndsl_out(1, 3) = bndsl_out(1, 3) - 1 + IF (bndsl_out(2, 3) .EQ. 2*(bounds(2, 3) + 1) - bounds(1, 3)) bndsl_out(2, 3) = bndsl_out(2, 3) - 1 CALL timestop(handle) @@ -1334,15 +1334,15 @@ FUNCTION rot180_bounds_local(bndsl_in, bounds) RESULT(bndsl_out) CALL timeset(routineN, handle) - bndsl_out(1, 1) = 2*(bounds(2, 1)+1)-bndsl_in(2, 1) - bndsl_out(2, 1) = 2*(bounds(2, 1)+1)-bndsl_in(1, 1) - IF (bndsl_out(1, 1) .EQ. bounds(2, 1)+2) bndsl_out(1, 1) = bndsl_out(1, 1)-1 - IF (bndsl_out(2, 1) .EQ. 2*(bounds(2, 1)+1)-bounds(1, 1)) bndsl_out(2, 1) = bndsl_out(2, 1)-1 + bndsl_out(1, 1) = 2*(bounds(2, 1) + 1) - bndsl_in(2, 1) + bndsl_out(2, 1) = 2*(bounds(2, 1) + 1) - bndsl_in(1, 1) + IF (bndsl_out(1, 1) .EQ. bounds(2, 1) + 2) bndsl_out(1, 1) = bndsl_out(1, 1) - 1 + IF (bndsl_out(2, 1) .EQ. 2*(bounds(2, 1) + 1) - bounds(1, 1)) bndsl_out(2, 1) = bndsl_out(2, 1) - 1 - bndsl_out(1, 2) = 2*(bounds(2, 2)+1)-bndsl_in(2, 2) - bndsl_out(2, 2) = 2*(bounds(2, 2)+1)-bndsl_in(1, 2) - IF (bndsl_out(1, 2) .EQ. bounds(2, 2)+2) bndsl_out(1, 2) = bndsl_out(1, 2)-1 - IF (bndsl_out(2, 2) .EQ. 2*(bounds(2, 2)+1)-bounds(1, 2)) bndsl_out(2, 2) = bndsl_out(2, 2)-1 + bndsl_out(1, 2) = 2*(bounds(2, 2) + 1) - bndsl_in(2, 2) + bndsl_out(2, 2) = 2*(bounds(2, 2) + 1) - bndsl_in(1, 2) + IF (bndsl_out(1, 2) .EQ. bounds(2, 2) + 2) bndsl_out(1, 2) = bndsl_out(1, 2) - 1 + IF (bndsl_out(2, 2) .EQ. 2*(bounds(2, 2) + 1) - bounds(1, 2)) bndsl_out(2, 2) = bndsl_out(2, 2) - 1 bndsl_out(1, 3) = bndsl_in(1, 3) bndsl_out(2, 3) = bndsl_in(2, 3) diff --git a/src/pw/dg_rho0_types.F b/src/pw/dg_rho0_types.F index b2a15def80..01b6d4fcd9 100644 --- a/src/pw/dg_rho0_types.F +++ b/src/pw/dg_rho0_types.F @@ -132,7 +132,7 @@ SUBROUTINE dg_rho0_create(dg_rho0) dg_rho0%grid = 0 dg_rho0%kind = 0 dg_rho0%type = do_ewald_none - last_dg_rho0_id_nr = last_dg_rho0_id_nr+1 + last_dg_rho0_id_nr = last_dg_rho0_id_nr + 1 dg_rho0%id_nr = last_dg_rho0_id_nr dg_rho0%ref_count = 1 NULLIFY (dg_rho0%density%pw) @@ -155,7 +155,7 @@ SUBROUTINE dg_rho0_retain(dg_rho0) CPASSERT(ASSOCIATED(dg_rho0)) CPASSERT(dg_rho0%ref_count > 0) - dg_rho0%ref_count = dg_rho0%ref_count+1 + dg_rho0%ref_count = dg_rho0%ref_count + 1 END SUBROUTINE dg_rho0_retain ! ************************************************************************************************** @@ -175,7 +175,7 @@ SUBROUTINE dg_rho0_release(dg_rho0) IF (ASSOCIATED(dg_rho0)) THEN CPASSERT(dg_rho0%ref_count > 0) - dg_rho0%ref_count = dg_rho0%ref_count-1 + dg_rho0%ref_count = dg_rho0%ref_count - 1 IF (dg_rho0%ref_count == 0) THEN IF (ASSOCIATED(dg_rho0%gcc)) THEN DEALLOCATE (dg_rho0%gcc) @@ -278,12 +278,12 @@ SUBROUTINE dg_rho0_pme_gauss(dg_rho0, alpha) e_gsq = EXP(-const*pw_grid%gsq(gpt))/pw_grid%vol !*apsi - lp = lp+bds(1, 1) - mp = mp+bds(1, 2) - np = np+bds(1, 3) - ln = ln+bds(1, 1) - mn = mn+bds(1, 2) - nn = nn+bds(1, 3) + lp = lp + bds(1, 1) + mp = mp + bds(1, 2) + np = np + bds(1, 3) + ln = ln + bds(1, 1) + mn = mn + bds(1, 2) + nn = nn + bds(1, 3) rho0(lp, mp, np) = e_gsq rho0(ln, mn, nn) = e_gsq diff --git a/src/pw/dg_types.F b/src/pw/dg_types.F index f40b63c600..ab7f534264 100644 --- a/src/pw/dg_types.F +++ b/src/pw/dg_types.F @@ -78,7 +78,7 @@ SUBROUTINE dg_create(dg) NULLIFY (dg_rho0) CALL dg_rho0_create(dg_rho0) dg%dg_rho0 => dg_rho0 - last_dg_id = last_dg_id+1 + last_dg_id = last_dg_id + 1 dg%id_nr = last_dg_id dg%ref_count = 1 @@ -100,7 +100,7 @@ SUBROUTINE dg_retain(dg) CPASSERT(ASSOCIATED(dg)) CPASSERT(dg%ref_count > 0) - dg%ref_count = dg%ref_count+1 + dg%ref_count = dg%ref_count + 1 END SUBROUTINE dg_retain ! ************************************************************************************************** @@ -119,7 +119,7 @@ SUBROUTINE dg_release(dg) IF (ASSOCIATED(dg)) THEN CPASSERT(dg%ref_count > 0) - dg%ref_count = dg%ref_count-1 + dg%ref_count = dg%ref_count - 1 IF (dg%ref_count == 0) THEN CALL dg_rho0_release(dg%dg_rho0) DEALLOCATE (dg) diff --git a/src/pw/dgs.F b/src/pw/dgs.F index 26308f3b88..d83b58cd70 100644 --- a/src/pw/dgs.F +++ b/src/pw/dgs.F @@ -137,14 +137,14 @@ FUNCTION get_cell_lengths(cell_hmat) RESULT(abc) REAL(KIND=dp), DIMENSION(3, 3), INTENT(IN) :: cell_hmat REAL(KIND=dp), DIMENSION(3) :: abc - abc(1) = SQRT(cell_hmat(1, 1)*cell_hmat(1, 1)+ & - cell_hmat(2, 1)*cell_hmat(2, 1)+ & + abc(1) = SQRT(cell_hmat(1, 1)*cell_hmat(1, 1) + & + cell_hmat(2, 1)*cell_hmat(2, 1) + & cell_hmat(3, 1)*cell_hmat(3, 1)) - abc(2) = SQRT(cell_hmat(1, 2)*cell_hmat(1, 2)+ & - cell_hmat(2, 2)*cell_hmat(2, 2)+ & + abc(2) = SQRT(cell_hmat(1, 2)*cell_hmat(1, 2) + & + cell_hmat(2, 2)*cell_hmat(2, 2) + & cell_hmat(3, 2)*cell_hmat(3, 2)) - abc(3) = SQRT(cell_hmat(1, 3)*cell_hmat(1, 3)+ & - cell_hmat(2, 3)*cell_hmat(2, 3)+ & + abc(3) = SQRT(cell_hmat(1, 3)*cell_hmat(1, 3) + & + cell_hmat(2, 3)*cell_hmat(2, 3) + & cell_hmat(3, 3)*cell_hmat(3, 3)) END FUNCTION get_cell_lengths @@ -208,11 +208,11 @@ SUBROUTINE dg_find_cutoff(b_cell_hmat, npts_s, cutoff_radius, grid_s, & ! big grid bounds grid_b%bounds(1, :) = -grid_b%npts/2 - grid_b%bounds(2, :) = +(grid_b%npts-1)/2 + grid_b%bounds(2, :) = +(grid_b%npts - 1)/2 grid_b%grid_span = HALFSPACE ! small grid bounds grid_s%bounds(1, :) = -nout(:)/2 - grid_s%bounds(2, :) = (+nout(:)-1)/2 + grid_s%bounds(2, :) = (+nout(:) - 1)/2 grid_s%grid_span = HALFSPACE grid_s%npts = nout @@ -381,7 +381,7 @@ SUBROUTINE dg_get_delta(cell_hmat, r, npts_s, npts_b, centre, delta) ! compute the scaled coordinate of atomi s = MATMUL(cell_h_inv, r) - s = s-NINT(s) + s = s - NINT(s) ! find the continuous ``grid'' point (on big grid) grid_i(1:3) = REAL(npts_b(1:3), KIND=dp)*s(1:3) @@ -390,11 +390,11 @@ SUBROUTINE dg_get_delta(cell_hmat, r, npts_s, npts_b, centre, delta) centre(:) = NINT(grid_i(:)) ! find the distance vector - delta(:) = (grid_i(:)-centre(:))/REAL(npts_s(:), KIND=dp) + delta(:) = (grid_i(:) - centre(:))/REAL(npts_s(:), KIND=dp) - centre(:) = centre(:)+npts_b(:)/2 + centre(:) = centre(:) + npts_b(:)/2 centre(:) = MODULO(centre(:), npts_b(:)) - centre(:) = centre(:)-npts_b(:)/2 + centre(:) = centre(:) - npts_b(:)/2 END SUBROUTINE dg_get_delta @@ -417,42 +417,42 @@ SUBROUTINE dg_sum_patch_coef(rs, rhos, center) folded = .FALSE. DO i = rhos%pw%pw_grid%bounds(1, 1), rhos%pw%pw_grid%bounds(2, 1) - ia = i-rhos%pw%pw_grid%bounds(1, 1)+1 - ii = center(1)+i-rs%lb_local(1) + ia = i - rhos%pw%pw_grid%bounds(1, 1) + 1 + ii = center(1) + i - rs%lb_local(1) IF (ii < 0) THEN - rs%px(ia) = ii+rs%npts_local(1)+1 + rs%px(ia) = ii + rs%npts_local(1) + 1 folded = .TRUE. ELSEIF (ii >= rs%npts_local(1)) THEN - rs%px(ia) = ii-rs%npts_local(1)+1 + rs%px(ia) = ii - rs%npts_local(1) + 1 folded = .TRUE. ELSE - rs%px(ia) = ii+1 + rs%px(ia) = ii + 1 ENDIF END DO DO i = rhos%pw%pw_grid%bounds(1, 2), rhos%pw%pw_grid%bounds(2, 2) - ia = i-rhos%pw%pw_grid%bounds(1, 2)+1 - ii = center(2)+i-rs%lb_local(2) + ia = i - rhos%pw%pw_grid%bounds(1, 2) + 1 + ii = center(2) + i - rs%lb_local(2) IF (ii < 0) THEN - rs%py(ia) = ii+rs%npts_local(2)+1 + rs%py(ia) = ii + rs%npts_local(2) + 1 folded = .TRUE. ELSEIF (ii >= rs%npts_local(2)) THEN - rs%py(ia) = ii-rs%npts_local(2)+1 + rs%py(ia) = ii - rs%npts_local(2) + 1 folded = .TRUE. ELSE - rs%py(ia) = ii+1 + rs%py(ia) = ii + 1 ENDIF END DO DO i = rhos%pw%pw_grid%bounds(1, 3), rhos%pw%pw_grid%bounds(2, 3) - ia = i-rhos%pw%pw_grid%bounds(1, 3)+1 - ii = center(3)+i-rs%lb_local(3) + ia = i - rhos%pw%pw_grid%bounds(1, 3) + 1 + ii = center(3) + i - rs%lb_local(3) IF (ii < 0) THEN - rs%pz(ia) = ii+rs%npts_local(3)+1 + rs%pz(ia) = ii + rs%npts_local(3) + 1 folded = .TRUE. ELSEIF (ii >= rs%npts_local(3)) THEN - rs%pz(ia) = ii-rs%npts_local(3)+1 + rs%pz(ia) = ii - rs%npts_local(3) + 1 folded = .TRUE. ELSE - rs%pz(ia) = ii+1 + rs%pz(ia) = ii + 1 ENDIF END DO @@ -460,9 +460,9 @@ SUBROUTINE dg_sum_patch_coef(rs, rhos, center) CALL dg_add_patch(rs%r, rhos%pw%cr3d, rhos%pw%pw_grid%npts, & rs%px, rs%py, rs%pz) ELSE - nc(1) = rs%px(1)-1 - nc(2) = rs%py(1)-1 - nc(3) = rs%pz(1)-1 + nc(1) = rs%px(1) - 1 + nc(2) = rs%py(1) - 1 + nc(3) = rs%pz(1) - 1 CALL dg_add_patch(rs%r, rhos%pw%cr3d, rhos%pw%pw_grid%npts, nc) END IF @@ -487,56 +487,56 @@ SUBROUTINE dg_sum_patch_arr(rs, rhos, center) ns(1) = SIZE(rhos, 1) ns(2) = SIZE(rhos, 2) ns(3) = SIZE(rhos, 3) - lb = -(ns-1)/2 - ub = lb+ns-1 + lb = -(ns - 1)/2 + ub = lb + ns - 1 folded = .FALSE. DO i = lb(1), ub(1) - ia = i-lb(1)+1 - ii = center(1)+i-rs%lb_local(1) + ia = i - lb(1) + 1 + ii = center(1) + i - rs%lb_local(1) IF (ii < 0) THEN - rs%px(ia) = ii+rs%npts_local(1)+1 + rs%px(ia) = ii + rs%npts_local(1) + 1 folded = .TRUE. ELSEIF (ii >= rs%npts_local(1)) THEN - rs%px(ia) = ii-rs%npts_local(1)+1 + rs%px(ia) = ii - rs%npts_local(1) + 1 folded = .TRUE. ELSE - rs%px(ia) = ii+1 + rs%px(ia) = ii + 1 ENDIF END DO DO i = lb(2), ub(2) - ia = i-lb(2)+1 - ii = center(2)+i-rs%lb_local(2) + ia = i - lb(2) + 1 + ii = center(2) + i - rs%lb_local(2) IF (ii < 0) THEN - rs%py(ia) = ii+rs%npts_local(2)+1 + rs%py(ia) = ii + rs%npts_local(2) + 1 folded = .TRUE. ELSEIF (ii >= rs%npts_local(2)) THEN - rs%py(ia) = ii-rs%npts_local(2)+1 + rs%py(ia) = ii - rs%npts_local(2) + 1 folded = .TRUE. ELSE - rs%py(ia) = ii+1 + rs%py(ia) = ii + 1 ENDIF END DO DO i = lb(3), ub(3) - ia = i-lb(3)+1 - ii = center(3)+i-rs%lb_local(3) + ia = i - lb(3) + 1 + ii = center(3) + i - rs%lb_local(3) IF (ii < 0) THEN - rs%pz(ia) = ii+rs%npts_local(3)+1 + rs%pz(ia) = ii + rs%npts_local(3) + 1 folded = .TRUE. ELSEIF (ii >= rs%npts_local(3)) THEN - rs%pz(ia) = ii-rs%npts_local(3)+1 + rs%pz(ia) = ii - rs%npts_local(3) + 1 folded = .TRUE. ELSE - rs%pz(ia) = ii+1 + rs%pz(ia) = ii + 1 ENDIF END DO IF (folded) THEN CALL dg_add_patch(rs%r, rhos, ns, rs%px, rs%py, rs%pz) ELSE - nc(1) = rs%px(1)-1 - nc(2) = rs%py(1)-1 - nc(3) = rs%pz(1)-1 + nc(1) = rs%px(1) - 1 + nc(2) = rs%py(1) - 1 + nc(3) = rs%pz(1) - 1 CALL dg_add_patch(rs%r, rhos, ns, nc) END IF @@ -563,47 +563,47 @@ SUBROUTINE dg_sum_patch_force_arr_3d(drpot, rhos, center, force) ns(1) = SIZE(rhos, 1) ns(2) = SIZE(rhos, 2) ns(3) = SIZE(rhos, 3) - lb = -(ns-1)/2 - ub = lb+ns-1 + lb = -(ns - 1)/2 + ub = lb + ns - 1 folded = .FALSE. DO i = lb(1), ub(1) - ia = i-lb(1)+1 - ii = center(1)+i-drpot(1)%rs_grid%lb_local(1) + ia = i - lb(1) + 1 + ii = center(1) + i - drpot(1)%rs_grid%lb_local(1) IF (ii < 0) THEN - drpot(1)%rs_grid%px(ia) = ii+drpot(1)%rs_grid%npts_local(1)+1 + drpot(1)%rs_grid%px(ia) = ii + drpot(1)%rs_grid%npts_local(1) + 1 folded = .TRUE. ELSEIF (ii >= drpot(1)%rs_grid%npts_local(1)) THEN - drpot(1)%rs_grid%px(ia) = ii-drpot(1)%rs_grid%npts_local(1)+1 + drpot(1)%rs_grid%px(ia) = ii - drpot(1)%rs_grid%npts_local(1) + 1 folded = .TRUE. ELSE - drpot(1)%rs_grid%px(ia) = ii+1 + drpot(1)%rs_grid%px(ia) = ii + 1 ENDIF END DO DO i = lb(2), ub(2) - ia = i-lb(2)+1 - ii = center(2)+i-drpot(1)%rs_grid%lb_local(2) + ia = i - lb(2) + 1 + ii = center(2) + i - drpot(1)%rs_grid%lb_local(2) IF (ii < 0) THEN - drpot(1)%rs_grid%py(ia) = ii+drpot(1)%rs_grid%npts_local(2)+1 + drpot(1)%rs_grid%py(ia) = ii + drpot(1)%rs_grid%npts_local(2) + 1 folded = .TRUE. ELSEIF (ii >= drpot(1)%rs_grid%npts_local(2)) THEN - drpot(1)%rs_grid%py(ia) = ii-drpot(1)%rs_grid%npts_local(2)+1 + drpot(1)%rs_grid%py(ia) = ii - drpot(1)%rs_grid%npts_local(2) + 1 folded = .TRUE. ELSE - drpot(1)%rs_grid%py(ia) = ii+1 + drpot(1)%rs_grid%py(ia) = ii + 1 ENDIF END DO DO i = lb(3), ub(3) - ia = i-lb(3)+1 - ii = center(3)+i-drpot(1)%rs_grid%lb_local(3) + ia = i - lb(3) + 1 + ii = center(3) + i - drpot(1)%rs_grid%lb_local(3) IF (ii < 0) THEN - drpot(1)%rs_grid%pz(ia) = ii+drpot(1)%rs_grid%npts_local(3)+1 + drpot(1)%rs_grid%pz(ia) = ii + drpot(1)%rs_grid%npts_local(3) + 1 folded = .TRUE. ELSEIF (ii >= drpot(1)%rs_grid%npts_local(3)) THEN - drpot(1)%rs_grid%pz(ia) = ii-drpot(1)%rs_grid%npts_local(3)+1 + drpot(1)%rs_grid%pz(ia) = ii - drpot(1)%rs_grid%npts_local(3) + 1 folded = .TRUE. ELSE - drpot(1)%rs_grid%pz(ia) = ii+1 + drpot(1)%rs_grid%pz(ia) = ii + 1 ENDIF END DO @@ -612,9 +612,9 @@ SUBROUTINE dg_sum_patch_force_arr_3d(drpot, rhos, center, force) drpot(3)%rs_grid%r, rhos, force, ns, & drpot(1)%rs_grid%px, drpot(1)%rs_grid%py, drpot(1)%rs_grid%pz) ELSE - nc(1) = drpot(1)%rs_grid%px(1)-1 - nc(2) = drpot(1)%rs_grid%py(1)-1 - nc(3) = drpot(1)%rs_grid%pz(1)-1 + nc(1) = drpot(1)%rs_grid%px(1) - 1 + nc(2) = drpot(1)%rs_grid%py(1) - 1 + nc(3) = drpot(1)%rs_grid%pz(1) - 1 CALL dg_int_patch_3d(drpot(1)%rs_grid%r, drpot(2)%rs_grid%r, & drpot(3)%rs_grid%r, rhos, force, ns, nc) END IF @@ -642,47 +642,47 @@ SUBROUTINE dg_sum_patch_force_arr_1d(drpot, rhos, center, force) ns(1) = SIZE(rhos, 1) ns(2) = SIZE(rhos, 2) ns(3) = SIZE(rhos, 3) - lb = -(ns-1)/2 - ub = lb+ns-1 + lb = -(ns - 1)/2 + ub = lb + ns - 1 folded = .FALSE. DO i = lb(1), ub(1) - ia = i-lb(1)+1 - ii = center(1)+i-drpot%lb_local(1) + ia = i - lb(1) + 1 + ii = center(1) + i - drpot%lb_local(1) IF (ii < 0) THEN - drpot%px(ia) = ii+drpot%npts_local(1)+1 + drpot%px(ia) = ii + drpot%npts_local(1) + 1 folded = .TRUE. ELSEIF (ii >= drpot%desc%npts(1)) THEN - drpot%px(ia) = ii-drpot%npts_local(1)+1 + drpot%px(ia) = ii - drpot%npts_local(1) + 1 folded = .TRUE. ELSE - drpot%px(ia) = ii+1 + drpot%px(ia) = ii + 1 ENDIF END DO DO i = lb(2), ub(2) - ia = i-lb(2)+1 - ii = center(2)+i-drpot%lb_local(2) + ia = i - lb(2) + 1 + ii = center(2) + i - drpot%lb_local(2) IF (ii < 0) THEN - drpot%py(ia) = ii+drpot%npts_local(2)+1 + drpot%py(ia) = ii + drpot%npts_local(2) + 1 folded = .TRUE. ELSEIF (ii >= drpot%desc%npts(2)) THEN - drpot%py(ia) = ii-drpot%npts_local(2)+1 + drpot%py(ia) = ii - drpot%npts_local(2) + 1 folded = .TRUE. ELSE - drpot%py(ia) = ii+1 + drpot%py(ia) = ii + 1 ENDIF END DO DO i = lb(3), ub(3) - ia = i-lb(3)+1 - ii = center(3)+i-drpot%lb_local(3) + ia = i - lb(3) + 1 + ii = center(3) + i - drpot%lb_local(3) IF (ii < 0) THEN - drpot%pz(ia) = ii+drpot%npts_local(3)+1 + drpot%pz(ia) = ii + drpot%npts_local(3) + 1 folded = .TRUE. ELSEIF (ii >= drpot%desc%npts(3)) THEN - drpot%pz(ia) = ii-drpot%npts_local(3)+1 + drpot%pz(ia) = ii - drpot%npts_local(3) + 1 folded = .TRUE. ELSE - drpot%pz(ia) = ii+1 + drpot%pz(ia) = ii + 1 ENDIF END DO @@ -690,9 +690,9 @@ SUBROUTINE dg_sum_patch_force_arr_1d(drpot, rhos, center, force) CALL dg_int_patch_1d(drpot%r, rhos, force, ns, & drpot%px, drpot%py, drpot%pz) ELSE - nc(1) = drpot%px(1)-1 - nc(2) = drpot%py(1)-1 - nc(3) = drpot%pz(1)-1 + nc(1) = drpot%px(1) - 1 + nc(2) = drpot%py(1) - 1 + nc(3) = drpot%pz(1) - 1 CALL dg_int_patch_1d(drpot%r, rhos, force, ns, nc) END IF @@ -719,42 +719,42 @@ SUBROUTINE dg_sum_patch_force_coef_3d(drpot, rhos, center, force) folded = .FALSE. DO i = rhos%pw%pw_grid%bounds(1, 1), rhos%pw%pw_grid%bounds(2, 1) - ia = i-rhos%pw%pw_grid%bounds(1, 1)+1 - ii = center(1)+i-drpot(1)%rs_grid%lb_local(1) + ia = i - rhos%pw%pw_grid%bounds(1, 1) + 1 + ii = center(1) + i - drpot(1)%rs_grid%lb_local(1) IF (ii < 0) THEN - drpot(1)%rs_grid%px(ia) = ii+drpot(1)%rs_grid%desc%npts(1)+1 + drpot(1)%rs_grid%px(ia) = ii + drpot(1)%rs_grid%desc%npts(1) + 1 folded = .TRUE. ELSEIF (ii >= drpot(1)%rs_grid%desc%npts(1)) THEN - drpot(1)%rs_grid%px(ia) = ii-drpot(1)%rs_grid%desc%npts(1)+1 + drpot(1)%rs_grid%px(ia) = ii - drpot(1)%rs_grid%desc%npts(1) + 1 folded = .TRUE. ELSE - drpot(1)%rs_grid%px(ia) = ii+1 + drpot(1)%rs_grid%px(ia) = ii + 1 ENDIF END DO DO i = rhos%pw%pw_grid%bounds(1, 2), rhos%pw%pw_grid%bounds(2, 2) - ia = i-rhos%pw%pw_grid%bounds(1, 2)+1 - ii = center(2)+i-drpot(1)%rs_grid%lb_local(2) + ia = i - rhos%pw%pw_grid%bounds(1, 2) + 1 + ii = center(2) + i - drpot(1)%rs_grid%lb_local(2) IF (ii < 0) THEN - drpot(1)%rs_grid%py(ia) = ii+drpot(1)%rs_grid%desc%npts(2)+1 + drpot(1)%rs_grid%py(ia) = ii + drpot(1)%rs_grid%desc%npts(2) + 1 folded = .TRUE. ELSEIF (ii >= drpot(1)%rs_grid%desc%npts(2)) THEN - drpot(1)%rs_grid%py(ia) = ii-drpot(1)%rs_grid%desc%npts(2)+1 + drpot(1)%rs_grid%py(ia) = ii - drpot(1)%rs_grid%desc%npts(2) + 1 folded = .TRUE. ELSE - drpot(1)%rs_grid%py(ia) = ii+1 + drpot(1)%rs_grid%py(ia) = ii + 1 ENDIF END DO DO i = rhos%pw%pw_grid%bounds(1, 3), rhos%pw%pw_grid%bounds(2, 3) - ia = i-rhos%pw%pw_grid%bounds(1, 3)+1 - ii = center(3)+i-drpot(1)%rs_grid%lb_local(3) + ia = i - rhos%pw%pw_grid%bounds(1, 3) + 1 + ii = center(3) + i - drpot(1)%rs_grid%lb_local(3) IF (ii < 0) THEN - drpot(1)%rs_grid%pz(ia) = ii+drpot(1)%rs_grid%desc%npts(3)+1 + drpot(1)%rs_grid%pz(ia) = ii + drpot(1)%rs_grid%desc%npts(3) + 1 folded = .TRUE. ELSEIF (ii >= drpot(1)%rs_grid%desc%npts(3)) THEN - drpot(1)%rs_grid%pz(ia) = ii-drpot(1)%rs_grid%desc%npts(3)+1 + drpot(1)%rs_grid%pz(ia) = ii - drpot(1)%rs_grid%desc%npts(3) + 1 folded = .TRUE. ELSE - drpot(1)%rs_grid%pz(ia) = ii+1 + drpot(1)%rs_grid%pz(ia) = ii + 1 ENDIF END DO @@ -763,9 +763,9 @@ SUBROUTINE dg_sum_patch_force_coef_3d(drpot, rhos, center, force) drpot(3)%rs_grid%r, rhos%pw%cr3d, force, rhos%pw%pw_grid%npts, & drpot(1)%rs_grid%px, drpot(1)%rs_grid%py, drpot(1)%rs_grid%pz) ELSE - nc(1) = drpot(1)%rs_grid%px(1)-1 - nc(2) = drpot(1)%rs_grid%py(1)-1 - nc(3) = drpot(1)%rs_grid%pz(1)-1 + nc(1) = drpot(1)%rs_grid%px(1) - 1 + nc(2) = drpot(1)%rs_grid%py(1) - 1 + nc(3) = drpot(1)%rs_grid%pz(1) - 1 CALL dg_int_patch_3d(drpot(1)%rs_grid%r, drpot(2)%rs_grid%r, & drpot(3)%rs_grid%r, rhos%pw%cr3d, force, rhos%pw%pw_grid%npts, nc) END IF @@ -793,42 +793,42 @@ SUBROUTINE dg_sum_patch_force_coef_1d(drpot, rhos, center, force) folded = .FALSE. DO i = rhos%pw%pw_grid%bounds(1, 1), rhos%pw%pw_grid%bounds(2, 1) - ia = i-rhos%pw%pw_grid%bounds(1, 1)+1 - ii = center(1)+i-drpot%lb_local(1) + ia = i - rhos%pw%pw_grid%bounds(1, 1) + 1 + ii = center(1) + i - drpot%lb_local(1) IF (ii < 0) THEN - drpot%px(ia) = ii+drpot%desc%npts(1)+1 + drpot%px(ia) = ii + drpot%desc%npts(1) + 1 folded = .TRUE. ELSEIF (ii >= drpot%desc%npts(1)) THEN - drpot%px(ia) = ii-drpot%desc%npts(1)+1 + drpot%px(ia) = ii - drpot%desc%npts(1) + 1 folded = .TRUE. ELSE - drpot%px(ia) = ii+1 + drpot%px(ia) = ii + 1 ENDIF END DO DO i = rhos%pw%pw_grid%bounds(1, 2), rhos%pw%pw_grid%bounds(2, 2) - ia = i-rhos%pw%pw_grid%bounds(1, 2)+1 - ii = center(2)+i-drpot%lb_local(2) + ia = i - rhos%pw%pw_grid%bounds(1, 2) + 1 + ii = center(2) + i - drpot%lb_local(2) IF (ii < 0) THEN - drpot%py(ia) = ii+drpot%desc%npts(2)+1 + drpot%py(ia) = ii + drpot%desc%npts(2) + 1 folded = .TRUE. ELSEIF (ii >= drpot%desc%npts(2)) THEN - drpot%py(ia) = ii-drpot%desc%npts(2)+1 + drpot%py(ia) = ii - drpot%desc%npts(2) + 1 folded = .TRUE. ELSE - drpot%py(ia) = ii+1 + drpot%py(ia) = ii + 1 ENDIF END DO DO i = rhos%pw%pw_grid%bounds(1, 3), rhos%pw%pw_grid%bounds(2, 3) - ia = i-rhos%pw%pw_grid%bounds(1, 3)+1 - ii = center(3)+i-drpot%lb_local(3) + ia = i - rhos%pw%pw_grid%bounds(1, 3) + 1 + ii = center(3) + i - drpot%lb_local(3) IF (ii < 0) THEN - drpot%pz(ia) = ii+drpot%desc%npts(3)+1 + drpot%pz(ia) = ii + drpot%desc%npts(3) + 1 folded = .TRUE. ELSEIF (ii >= drpot%desc%npts(3)) THEN - drpot%pz(ia) = ii-drpot%desc%npts(3)+1 + drpot%pz(ia) = ii - drpot%desc%npts(3) + 1 folded = .TRUE. ELSE - drpot%pz(ia) = ii+1 + drpot%pz(ia) = ii + 1 ENDIF END DO @@ -836,9 +836,9 @@ SUBROUTINE dg_sum_patch_force_coef_1d(drpot, rhos, center, force) CALL dg_int_patch_1d(drpot%r, rhos%pw%cr3d, force, & rhos%pw%pw_grid%npts, drpot%px, drpot%py, drpot%pz) ELSE - nc(1) = drpot%px(1)-1 - nc(2) = drpot%py(1)-1 - nc(3) = drpot%pz(1)-1 + nc(1) = drpot%px(1) - 1 + nc(2) = drpot%py(1) - 1 + nc(3) = drpot%pz(1) - 1 CALL dg_int_patch_1d(drpot%r, rhos%pw%cr3d, force, rhos%pw%pw_grid%npts, nc) END IF @@ -961,12 +961,12 @@ SUBROUTINE dg_add_patch_simple(rb, rs, ns, nc) INTEGER :: i, ii, j, jj, k, kk DO k = 1, ns(3) - kk = nc(3)+k + kk = nc(3) + k DO j = 1, ns(2) - jj = nc(2)+j + jj = nc(2) + j DO i = 1, ns(1) - ii = nc(1)+i - rb(ii, jj, kk) = rb(ii, jj, kk)+rs(i, j, k) + ii = nc(1) + i + rb(ii, jj, kk) = rb(ii, jj, kk) + rs(i, j, k) END DO END DO END DO @@ -997,7 +997,7 @@ SUBROUTINE dg_add_patch_folded(rb, rs, ns, px, py, pz) jj = py(j) DO i = 1, ns(1) ii = px(i) - rb(ii, jj, kk) = rb(ii, jj, kk)+rs(i, j, k) + rb(ii, jj, kk) = rb(ii, jj, kk) + rs(i, j, k) END DO END DO END DO @@ -1025,15 +1025,15 @@ SUBROUTINE dg_int_patch_simple_3d(rbx, rby, rbz, rs, f, ns, nc) f = 0.0_dp DO k = 1, ns(3) - kk = nc(3)+k + kk = nc(3) + k DO j = 1, ns(2) - jj = nc(2)+j + jj = nc(2) + j DO i = 1, ns(1) - ii = nc(1)+i + ii = nc(1) + i s = rs(i, j, k) - f(1) = f(1)+s*rbx(ii, jj, kk) - f(2) = f(2)+s*rby(ii, jj, kk) - f(3) = f(3)+s*rbz(ii, jj, kk) + f(1) = f(1) + s*rbx(ii, jj, kk) + f(2) = f(2) + s*rby(ii, jj, kk) + f(3) = f(3) + s*rbz(ii, jj, kk) END DO END DO END DO @@ -1059,13 +1059,13 @@ SUBROUTINE dg_int_patch_simple_1d(rb, rs, f, ns, nc) f = 0.0_dp DO k = 1, ns(3) - kk = nc(3)+k + kk = nc(3) + k DO j = 1, ns(2) - jj = nc(2)+j + jj = nc(2) + j DO i = 1, ns(1) - ii = nc(1)+i + ii = nc(1) + i s = rs(i, j, k) - f = f+s*rb(ii, jj, kk) + f = f + s*rb(ii, jj, kk) END DO END DO END DO @@ -1102,9 +1102,9 @@ SUBROUTINE dg_int_patch_folded_3d(rbx, rby, rbz, rs, f, ns, px, py, pz) DO i = 1, ns(1) ii = px(i) s = rs(i, j, k) - f(1) = f(1)+s*rbx(ii, jj, kk) - f(2) = f(2)+s*rby(ii, jj, kk) - f(3) = f(3)+s*rbz(ii, jj, kk) + f(1) = f(1) + s*rbx(ii, jj, kk) + f(2) = f(2) + s*rby(ii, jj, kk) + f(3) = f(3) + s*rbz(ii, jj, kk) END DO END DO END DO @@ -1139,7 +1139,7 @@ SUBROUTINE dg_int_patch_folded_1d(rb, rs, f, ns, px, py, pz) DO i = 1, ns(1) ii = px(i) s = rs(i, j, k) - f = f+s*rb(ii, jj, kk) + f = f + s*rb(ii, jj, kk) END DO END DO END DO diff --git a/src/pw/dielectric_methods.F b/src/pw/dielectric_methods.F index b3d1bd09d6..ff9daca8e8 100644 --- a/src/pw/dielectric_methods.F +++ b/src/pw/dielectric_methods.F @@ -267,7 +267,7 @@ SUBROUTINE dielectric_compute_periodic(dielectric, diel_rs_grid, pw_pool, rho, r CALL pw_pool_give_back_pw(pw_pool, rho_elec_rs) - dielectric%params%times_called = dielectric%params%times_called+1 + dielectric%params%times_called = dielectric%params%times_called + 1 CALL timestop(handle) @@ -469,7 +469,7 @@ SUBROUTINE dielectric_compute_neumann(dielectric, diel_rs_grid, pw_pool_orig, & CALL pw_pool_give_back_pw(pw_pool_xpndd, rho_elec_rs_xpndd) CALL pw_pool_release(pw_pool_xpndd) - dielectric%params%times_called = dielectric%params%times_called+1 + dielectric%params%times_called = dielectric%params%times_called + 1 CALL timestop(handle) @@ -512,7 +512,7 @@ SUBROUTINE dielectric_constant_sccs(rho, eps, deps_drho, eps0, rho_max, rho_min) lb2 = bounds_local(1, 2); ub2 = bounds_local(2, 2) lb3 = bounds_local(1, 3); ub3 = bounds_local(2, 3) - denom = LOG(rho_max)-LOG(rho_min) + denom = LOG(rho_max) - LOG(rho_min) DO k = lb3, ub3 DO j = lb2, ub2 DO i = lb1, ub1 @@ -523,9 +523,9 @@ SUBROUTINE dielectric_constant_sccs(rho, eps, deps_drho, eps0, rho_max, rho_min) eps%cr3d(i, j, k) = 1.0_dp deps_drho%cr3d(i, j, k) = 0.0_dp ELSE - t = twopi*(LOG(rho_max)-LOG(rho%cr3d(i, j, k)))/denom - eps%cr3d(i, j, k) = EXP(LOG(eps0)*(t-SIN(t))/twopi) - deps_drho%cr3d(i, j, k) = -eps%cr3d(i, j, k)*LOG(eps0)*(1.0_dp-COS(t))/(denom*rho%cr3d(i, j, k)) + t = twopi*(LOG(rho_max) - LOG(rho%cr3d(i, j, k)))/denom + eps%cr3d(i, j, k) = EXP(LOG(eps0)*(t - SIN(t))/twopi) + deps_drho%cr3d(i, j, k) = -eps%cr3d(i, j, k)*LOG(eps0)*(1.0_dp - COS(t))/(denom*rho%cr3d(i, j, k)) END IF END DO END DO @@ -591,11 +591,11 @@ SUBROUTINE dielectric_constant_aa_cuboidal(eps, dielec_const, pw_pool, zeta, & dx = pw_grid%dr(1); dy = pw_grid%dr(2); dz = pw_grid%dr(3) forb_xtnt1 = x_xtnt(1) .LT. x_glbl(LBOUND(x_glbl, 1)) - forb_xtnt2 = x_xtnt(2) .GT. x_glbl(UBOUND(x_glbl, 1))+dx + forb_xtnt2 = x_xtnt(2) .GT. x_glbl(UBOUND(x_glbl, 1)) + dx forb_xtnt3 = y_xtnt(1) .LT. y_glbl(LBOUND(y_glbl, 1)) - forb_xtnt4 = y_xtnt(2) .GT. y_glbl(UBOUND(y_glbl, 1))+dy + forb_xtnt4 = y_xtnt(2) .GT. y_glbl(UBOUND(y_glbl, 1)) + dy forb_xtnt5 = z_xtnt(1) .LT. z_glbl(LBOUND(z_glbl, 1)) - forb_xtnt6 = z_xtnt(2) .GT. z_glbl(UBOUND(z_glbl, 1))+dz + forb_xtnt6 = z_xtnt(2) .GT. z_glbl(UBOUND(z_glbl, 1)) + dz n_forb_xtnts = COUNT((/forb_xtnt1, forb_xtnt2, forb_xtnt3, & forb_xtnt4, forb_xtnt5, forb_xtnt6/) .EQV. test_forb_xtnts) IF (n_forb_xtnts .GT. 0) THEN @@ -688,11 +688,11 @@ SUBROUTINE dielectric_constant_xaa_annular(eps, dielec_const, pw_pool, zeta, & dx = pw_grid%dr(1); dy = pw_grid%dr(2); dz = pw_grid%dr(3) forb_xtnt1 = x_xtnt(1) .LT. x_glbl(LBOUND(x_glbl, 1)) - forb_xtnt2 = x_xtnt(2) .GT. x_glbl(UBOUND(x_glbl, 1))+dx - forb_xtnt3 = bctry-MAXVAL(base_radii) .LT. y_glbl(LBOUND(y_glbl, 1)) - forb_xtnt4 = bctry+MAXVAL(base_radii) .GT. y_glbl(UBOUND(y_glbl, 1))+dy - forb_xtnt5 = bctrz-MAXVAL(base_radii) .LT. z_glbl(LBOUND(z_glbl, 1)) - forb_xtnt6 = bctrz+MAXVAL(base_radii) .GT. z_glbl(UBOUND(z_glbl, 1))+dz + forb_xtnt2 = x_xtnt(2) .GT. x_glbl(UBOUND(x_glbl, 1)) + dx + forb_xtnt3 = bctry - MAXVAL(base_radii) .LT. y_glbl(LBOUND(y_glbl, 1)) + forb_xtnt4 = bctry + MAXVAL(base_radii) .GT. y_glbl(UBOUND(y_glbl, 1)) + dy + forb_xtnt5 = bctrz - MAXVAL(base_radii) .LT. z_glbl(LBOUND(z_glbl, 1)) + forb_xtnt6 = bctrz + MAXVAL(base_radii) .GT. z_glbl(UBOUND(z_glbl, 1)) + dz n_forb_xtnts = COUNT((/forb_xtnt1, forb_xtnt2, forb_xtnt3, & forb_xtnt4, forb_xtnt5, forb_xtnt6/) .EQV. test_forb_xtnts) IF (n_forb_xtnts .GT. 0) THEN @@ -712,7 +712,7 @@ SUBROUTINE dielectric_constant_xaa_annular(eps, dielec_const, pw_pool, zeta, & DO k = lb3, ub3 DO j = lb2, ub2 DO i = lb1, ub1 - distsq = (y_locl(j)-bctry)**2+(z_locl(k)-bctrz)**2 + distsq = (y_locl(j) - bctry)**2 + (z_locl(k) - bctrz)**2 IF ((x_locl(i) .GE. x_xtnt(1)) .AND. (x_locl(i) .LE. x_xtnt(2)) .AND. & (distsq .GE. MINVAL(base_radii)**2) .AND. (distsq .LE. MAXVAL(base_radii)**2)) THEN eps_tmp%cr3d(i, j, k) = dielec_const @@ -762,7 +762,7 @@ SUBROUTINE dielectric_constant_spatially_dependent(eps, pw_pool, dielectric_para n_xaa_annular = dielectric_params%n_xaa_annular pw_grid => pw_pool%pw_grid CALL setup_grid_axes(pw_grid, x_glbl, y_glbl, z_glbl, x_locl, y_locl, z_locl) - n_dielectric_region = n_aa_cuboidal+n_xaa_annular + n_dielectric_region = n_aa_cuboidal + n_xaa_annular IF (n_dielectric_region .EQ. 0) THEN CPABORT("No density independent dielectric region is defined.") @@ -840,7 +840,7 @@ SUBROUTINE dielectric_constant_spatially_rho_dependent(rho, eps, deps_drho, & CALL dielectric_constant_sccs(rho, swch_func, dswch_func_drho, 2.0_dp, & dielectric_params%rho_max, dielectric_params%rho_min) - eps%cr3d = ((swch_func%cr3d-1.0_dp)*(eps_sptldep%cr3d-1.0_dp))+1.0_dp + eps%cr3d = ((swch_func%cr3d-1.0_dp)*(eps_sptldep%cr3d-1.0_dp)) + 1.0_dp deps_drho%cr3d = dswch_func_drho%cr3d*(eps_sptldep%cr3d-1.0_dp) CALL pw_pool_give_back_pw(pw_pool, dswch_func_drho) diff --git a/src/pw/dirichlet_bc_methods.F b/src/pw/dirichlet_bc_methods.F index 3f54d508ac..04dee6b7b7 100644 --- a/src/pw/dirichlet_bc_methods.F +++ b/src/pw/dirichlet_bc_methods.F @@ -117,7 +117,7 @@ SUBROUTINE dirichlet_boundary_region_setup(pw_pool, poisson_params, dbcs) aa_cylindrical_nsides => poisson_params%dbc_params%aa_cylindrical_nsides pw_grid => pw_pool%pw_grid CALL setup_grid_axes(pw_grid, x_glbl, y_glbl, z_glbl, x_locl, y_locl, z_locl) - n_dbcs = n_aa_planar+n_aa_cuboidal+n_planar+SUM(aa_cylindrical_nsides) + n_dbcs = n_aa_planar + n_aa_cuboidal + n_planar + SUM(aa_cylindrical_nsides) SELECT CASE (poisson_params%ps_implicit_params%boundary_condition) CASE (MIXED_BC, MIXED_PERIODIC_BC) @@ -134,7 +134,7 @@ SUBROUTINE dirichlet_boundary_region_setup(pw_pool, poisson_params, dbcs) DO j = 1, n_aa_planar ALLOCATE (dbcs(j)%dirichlet_bc) n_prtn = poisson_params%dbc_params%aa_planar_nprtn(:, j) - dbc_id = AA_PLANAR+j + dbc_id = AA_PLANAR + j v_D = poisson_params%dbc_params%aa_planar_vD(j) frequency = poisson_params%dbc_params%aa_planar_frequency(j) oscillating_fraction = poisson_params%dbc_params%aa_planar_osc_frac(j) @@ -161,16 +161,16 @@ SUBROUTINE dirichlet_boundary_region_setup(pw_pool, poisson_params, dbcs) END DO l = n_aa_planar - DO j = l+1, l+n_aa_cuboidal + DO j = l + 1, l + n_aa_cuboidal ALLOCATE (dbcs(j)%dirichlet_bc) - n_prtn = poisson_params%dbc_params%aa_cuboidal_nprtn(:, j-l) - dbc_id = AA_CUBOIDAL+j-l - v_D = poisson_params%dbc_params%aa_cuboidal_vD(j-l) - frequency = poisson_params%dbc_params%aa_cuboidal_frequency(j-l) - oscillating_fraction = poisson_params%dbc_params%aa_cuboidal_osc_frac(j-l) - phase = poisson_params%dbc_params%aa_cuboidal_phase(j-l) - sigma = poisson_params%dbc_params%aa_cuboidal_sigma(j-l) - is_periodic = poisson_params%dbc_params%aa_cuboidal_is_periodic(j-l) + n_prtn = poisson_params%dbc_params%aa_cuboidal_nprtn(:, j - l) + dbc_id = AA_CUBOIDAL + j - l + v_D = poisson_params%dbc_params%aa_cuboidal_vD(j - l) + frequency = poisson_params%dbc_params%aa_cuboidal_frequency(j - l) + oscillating_fraction = poisson_params%dbc_params%aa_cuboidal_osc_frac(j - l) + phase = poisson_params%dbc_params%aa_cuboidal_phase(j - l) + sigma = poisson_params%dbc_params%aa_cuboidal_sigma(j - l) + is_periodic = poisson_params%dbc_params%aa_cuboidal_is_periodic(j - l) IF (unit_nr .GT. 0) THEN WRITE (unit_nr, '(T3,A,I5)') "POISSON| Dirichlet region", j @@ -178,9 +178,9 @@ SUBROUTINE dirichlet_boundary_region_setup(pw_pool, poisson_params, dbcs) WRITE (unit_nr, '(T3,A,E13.4,2X,A)') "POISSON| applied potential :", v_D, "[Eh/e]" END IF CALL aa_cuboidal_dbc_setup(cell_xtnts, & - poisson_params%dbc_params%aa_cuboidal_xxtnt(:, j-l), & - poisson_params%dbc_params%aa_cuboidal_yxtnt(:, j-l), & - poisson_params%dbc_params%aa_cuboidal_zxtnt(:, j-l), & + poisson_params%dbc_params%aa_cuboidal_xxtnt(:, j - l), & + poisson_params%dbc_params%aa_cuboidal_yxtnt(:, j - l), & + poisson_params%dbc_params%aa_cuboidal_zxtnt(:, j - l), & sigma, v_D, oscillating_fraction, frequency, & phase, dbc_id, verbose, dbcs(j)%dirichlet_bc) @@ -188,19 +188,19 @@ SUBROUTINE dirichlet_boundary_region_setup(pw_pool, poisson_params, dbcs) x_locl, y_locl, z_locl, is_periodic, verbose, dbcs(j)%dirichlet_bc) END DO - l = n_aa_planar+n_aa_cuboidal - DO j = l+1, l+n_planar + l = n_aa_planar + n_aa_cuboidal + DO j = l + 1, l + n_planar ALLOCATE (dbcs(j)%dirichlet_bc) n_prtn = 1 - n_prtn(1:2) = poisson_params%dbc_params%planar_nprtn(:, j-l) - dbc_id = PLANAR+j-l - v_D = poisson_params%dbc_params%planar_vD(j-l) - frequency = poisson_params%dbc_params%planar_frequency(j-l) - oscillating_fraction = poisson_params%dbc_params%planar_osc_frac(j-l) - phase = poisson_params%dbc_params%planar_phase(j-l) - sigma = poisson_params%dbc_params%planar_sigma(j-l) - thickness = poisson_params%dbc_params%planar_thickness(j-l) - is_periodic = poisson_params%dbc_params%planar_is_periodic(j-l) + n_prtn(1:2) = poisson_params%dbc_params%planar_nprtn(:, j - l) + dbc_id = PLANAR + j - l + v_D = poisson_params%dbc_params%planar_vD(j - l) + frequency = poisson_params%dbc_params%planar_frequency(j - l) + oscillating_fraction = poisson_params%dbc_params%planar_osc_frac(j - l) + phase = poisson_params%dbc_params%planar_phase(j - l) + sigma = poisson_params%dbc_params%planar_sigma(j - l) + thickness = poisson_params%dbc_params%planar_thickness(j - l) + is_periodic = poisson_params%dbc_params%planar_is_periodic(j - l) IF (unit_nr .GT. 0) THEN WRITE (unit_nr, '(T3,A,I5)') "POISSON| Dirichlet region", j @@ -208,9 +208,9 @@ SUBROUTINE dirichlet_boundary_region_setup(pw_pool, poisson_params, dbcs) WRITE (unit_nr, '(T3,A,E13.4,2X,A)') "POISSON| applied potential :", v_D, "[Eh/e]" END IF CALL arbitrary_planar_dbc_setup(cell_xtnts, & - poisson_params%dbc_params%planar_Avtx(:, j-l), & - poisson_params%dbc_params%planar_Bvtx(:, j-l), & - poisson_params%dbc_params%planar_Cvtx(:, j-l), & + poisson_params%dbc_params%planar_Avtx(:, j - l), & + poisson_params%dbc_params%planar_Bvtx(:, j - l), & + poisson_params%dbc_params%planar_Cvtx(:, j - l), & thickness, sigma, v_D, oscillating_fraction, frequency, & phase, dbc_id, verbose, dbcs(j)%dirichlet_bc) @@ -218,10 +218,10 @@ SUBROUTINE dirichlet_boundary_region_setup(pw_pool, poisson_params, dbcs) x_locl, y_locl, z_locl, is_periodic, verbose, dbcs(j)%dirichlet_bc) END DO - l = n_aa_planar+n_aa_cuboidal+n_planar + l = n_aa_planar + n_aa_cuboidal + n_planar DO j = 1, n_aa_cylindrical - ind_start = l+1 - ind_end = l+aa_cylindrical_nsides(j) + ind_start = l + 1 + ind_end = l + aa_cylindrical_nsides(j) n_prtn = 1 n_prtn(1:2) = poisson_params%dbc_params%aa_cylindrical_nprtn(:, j) @@ -239,7 +239,7 @@ SUBROUTINE dirichlet_boundary_region_setup(pw_pool, poisson_params, dbcs) is_periodic = poisson_params%dbc_params%aa_cylindrical_is_periodic(j) IF (unit_nr .GT. 0) THEN - WRITE (unit_nr, '(T3,A,I5)') "POISSON| Dirichlet region", l+j + WRITE (unit_nr, '(T3,A,I5)') "POISSON| Dirichlet region", l + j WRITE (unit_nr, '(T3,A)') "POISSON| type : axis-aligned cylindrical" WRITE (unit_nr, '(T3,A,E13.4,2X,A)') "POISSON| applied potential :", v_D, "[Eh/e]" END IF @@ -249,7 +249,7 @@ SUBROUTINE dirichlet_boundary_region_setup(pw_pool, poisson_params, dbcs) oscillating_fraction, frequency, phase, & n_prtn, is_periodic, verbose, dbcs(ind_start:ind_end)) - l = l+aa_cylindrical_nsides(j) + l = l + aa_cylindrical_nsides(j) END DO CASE (PERIODIC_BC, NEUMANN_BC) @@ -487,14 +487,14 @@ SUBROUTINE aa_planar_dbc_setup(cell_xtnts, parallel_plane, x_xtnt, y_xtnt, z_xtn SELECT CASE (parallel_plane) CASE (xy_plane) - zlb = zlb-thickness*0.5_dp - zub = zub+thickness*0.5_dp + zlb = zlb - thickness*0.5_dp + zub = zub + thickness*0.5_dp CASE (xz_plane) - ylb = ylb-thickness*0.5_dp - yub = yub+thickness*0.5_dp + ylb = ylb - thickness*0.5_dp + yub = yub + thickness*0.5_dp CASE (yz_plane) - xlb = xlb-thickness*0.5_dp - xub = xub+thickness*0.5_dp + xlb = xlb - thickness*0.5_dp + xub = xub + thickness*0.5_dp END SELECT forb_xtnt1 = xlb .LT. cell_xtnts(1, 1) @@ -681,8 +681,8 @@ SUBROUTINE arbitrary_planar_dbc_setup(cell_xtnts, A, B, C, thickness, & unit_nr = -1 ENDIF - D = A+(C-B) - AB = B-A; AC = C-A; AD = D-A; BC = C-B + D = A + (C - B) + AB = B - A; AC = C - A; AD = D - A; BC = C - B are_orthogonal = ABS(DOT_PRODUCT(AB, BC)/(SQRT(SUM(AB**2))*SQRT(SUM(BC**2)))) .LE. small_value IF (.NOT. are_orthogonal) THEN CALL cp_abort(__LOCATION__, "The given vertices for defining a "// & @@ -715,14 +715,14 @@ SUBROUTINE arbitrary_planar_dbc_setup(cell_xtnts, A, B, C, thickness, & CPABORT("The given vertices for defining a planar Dirichlet region are not coplanar.") END IF - cm = (A+B+C+D)/4.0_dp - dist1 = SUM((A-cm)**2) - dist2 = SUM((B-cm)**2) - dist3 = SUM((C-cm)**2) - dist4 = SUM((D-cm)**2) - is_rectangle = (ABS(dist1-dist2) .LE. small_value) .AND. & - (ABS(dist1-dist3) .LE. small_value) .AND. & - (ABS(dist1-dist4) .LE. small_value) + cm = (A + B + C + D)/4.0_dp + dist1 = SUM((A - cm)**2) + dist2 = SUM((B - cm)**2) + dist3 = SUM((C - cm)**2) + dist4 = SUM((D - cm)**2) + is_rectangle = (ABS(dist1 - dist2) .LE. small_value) .AND. & + (ABS(dist1 - dist3) .LE. small_value) .AND. & + (ABS(dist1 - dist4) .LE. small_value) IF (.NOT. is_rectangle) THEN CALL cp_abort(__LOCATION__, "The given vertices for defining "// & "a planar Dirichlet region do not form a rectangle.") @@ -737,14 +737,14 @@ SUBROUTINE arbitrary_planar_dbc_setup(cell_xtnts, A, B, C, thickness, & dirichlet_bc%smoothing_width = sigma dirichlet_bc%n_tiles = 1 - dirichlet_bc%vertices(1:3, 1) = A-0.5_dp*thickness*unit_normal - dirichlet_bc%vertices(1:3, 2) = B-0.5_dp*thickness*unit_normal - dirichlet_bc%vertices(1:3, 3) = C-0.5_dp*thickness*unit_normal - dirichlet_bc%vertices(1:3, 4) = D-0.5_dp*thickness*unit_normal - dirichlet_bc%vertices(1:3, 5) = D+0.5_dp*thickness*unit_normal - dirichlet_bc%vertices(1:3, 6) = A+0.5_dp*thickness*unit_normal - dirichlet_bc%vertices(1:3, 7) = B+0.5_dp*thickness*unit_normal - dirichlet_bc%vertices(1:3, 8) = C+0.5_dp*thickness*unit_normal + dirichlet_bc%vertices(1:3, 1) = A - 0.5_dp*thickness*unit_normal + dirichlet_bc%vertices(1:3, 2) = B - 0.5_dp*thickness*unit_normal + dirichlet_bc%vertices(1:3, 3) = C - 0.5_dp*thickness*unit_normal + dirichlet_bc%vertices(1:3, 4) = D - 0.5_dp*thickness*unit_normal + dirichlet_bc%vertices(1:3, 5) = D + 0.5_dp*thickness*unit_normal + dirichlet_bc%vertices(1:3, 6) = A + 0.5_dp*thickness*unit_normal + dirichlet_bc%vertices(1:3, 7) = B + 0.5_dp*thickness*unit_normal + dirichlet_bc%vertices(1:3, 8) = C + 0.5_dp*thickness*unit_normal IF ((unit_nr .GT. 0) .AND. verbose) THEN WRITE (unit_nr, '(T3,A,A)') "======== verbose ", REPEAT('=', 61) @@ -831,9 +831,9 @@ SUBROUTINE aa_cylindrical_dbc_setup(pw_pool, cell_xtnts, x_locl, y_locl, z_locl, unit_nr = -1 ENDIF - Lx = cell_xtnts(2, 1)-cell_xtnts(1, 1) - Ly = cell_xtnts(2, 2)-cell_xtnts(1, 2) - Lz = cell_xtnts(2, 3)-cell_xtnts(1, 3) + Lx = cell_xtnts(2, 1) - cell_xtnts(1, 1) + Ly = cell_xtnts(2, 2) - cell_xtnts(1, 2) + Lz = cell_xtnts(2, 3) - cell_xtnts(1, 3) SELECT CASE (parallel_axis) CASE (x_axis) @@ -842,10 +842,10 @@ SUBROUTINE aa_cylindrical_dbc_setup(pw_pool, cell_xtnts, x_locl, y_locl, z_locl, "The length of the cylindrical Dirichlet region is larger than the "// & "x range of the simulation cell.") END IF - forb_xtnt1 = base_center(1)-base_radius .LT. cell_xtnts(1, 2) - forb_xtnt2 = base_center(1)+base_radius .GT. cell_xtnts(2, 2) - forb_xtnt3 = base_center(2)-base_radius .LT. cell_xtnts(1, 3) - forb_xtnt4 = base_center(2)+base_radius .GT. cell_xtnts(2, 3) + forb_xtnt1 = base_center(1) - base_radius .LT. cell_xtnts(1, 2) + forb_xtnt2 = base_center(1) + base_radius .GT. cell_xtnts(2, 2) + forb_xtnt3 = base_center(2) - base_radius .LT. cell_xtnts(1, 3) + forb_xtnt4 = base_center(2) + base_radius .GT. cell_xtnts(2, 3) IF (forb_xtnt1 .OR. forb_xtnt2 .OR. forb_xtnt3 .OR. forb_xtnt4) THEN CPABORT("The cylinder does not fit entirely inside the simulation cell.") END IF @@ -855,10 +855,10 @@ SUBROUTINE aa_cylindrical_dbc_setup(pw_pool, cell_xtnts, x_locl, y_locl, z_locl, "The length of the cylindrical Dirichlet region is larger than the "// & "y range of the simulation cell.") END IF - forb_xtnt1 = base_center(1)-base_radius .LT. cell_xtnts(1, 1) - forb_xtnt2 = base_center(1)+base_radius .GT. cell_xtnts(2, 1) - forb_xtnt3 = base_center(2)-base_radius .LT. cell_xtnts(1, 3) - forb_xtnt4 = base_center(2)+base_radius .GT. cell_xtnts(2, 3) + forb_xtnt1 = base_center(1) - base_radius .LT. cell_xtnts(1, 1) + forb_xtnt2 = base_center(1) + base_radius .GT. cell_xtnts(2, 1) + forb_xtnt3 = base_center(2) - base_radius .LT. cell_xtnts(1, 3) + forb_xtnt4 = base_center(2) + base_radius .GT. cell_xtnts(2, 3) IF (forb_xtnt1 .OR. forb_xtnt2 .OR. forb_xtnt3 .OR. forb_xtnt4) THEN CPABORT("The cylinder does not fit entirely inside the simulation cell.") END IF @@ -868,10 +868,10 @@ SUBROUTINE aa_cylindrical_dbc_setup(pw_pool, cell_xtnts, x_locl, y_locl, z_locl, "The length of the cylindrical Dirichlet region is larger than the "// & "z range of the simulation cell.") END IF - forb_xtnt1 = base_center(1)-base_radius .LT. cell_xtnts(1, 1) - forb_xtnt2 = base_center(1)+base_radius .GT. cell_xtnts(2, 1) - forb_xtnt3 = base_center(2)-base_radius .LT. cell_xtnts(1, 2) - forb_xtnt4 = base_center(2)+base_radius .GT. cell_xtnts(2, 2) + forb_xtnt1 = base_center(1) - base_radius .LT. cell_xtnts(1, 1) + forb_xtnt2 = base_center(1) + base_radius .GT. cell_xtnts(2, 1) + forb_xtnt3 = base_center(2) - base_radius .LT. cell_xtnts(1, 2) + forb_xtnt4 = base_center(2) + base_radius .GT. cell_xtnts(2, 2) IF (forb_xtnt1 .OR. forb_xtnt2 .OR. forb_xtnt3 .OR. forb_xtnt4) THEN CPABORT("The cylinder does not fit entirely inside the simulation cell.") END IF @@ -909,20 +909,20 @@ SUBROUTINE aa_cylindrical_dbc_setup(pw_pool, cell_xtnts, x_locl, y_locl, z_locl, END IF END SELECT - alpha = linspace(0.0_dp, 2*pi, n_dbcs+1) - alpha_rotd = alpha+delta_alpha; + alpha = linspace(0.0_dp, 2*pi, n_dbcs + 1) + alpha_rotd = alpha + delta_alpha; SELECT CASE (parallel_axis) CASE (x_axis) DO j = 1, n_dbcs - ylb(j) = base_center(1)+h*SIN(alpha(j)) - zlb(j) = base_center(2)+h*COS(alpha(j)) - yub(j) = base_center(1)+h*SIN(alpha_rotd(j)) - zub(j) = base_center(2)+h*COS(alpha_rotd(j)) + ylb(j) = base_center(1) + h*SIN(alpha(j)) + zlb(j) = base_center(2) + h*COS(alpha(j)) + yub(j) = base_center(1) + h*SIN(alpha_rotd(j)) + zub(j) = base_center(2) + h*COS(alpha_rotd(j)) END DO - ylb(n_dbcs+1) = ylb(1) - yub(n_dbcs+1) = yub(1) - zlb(n_dbcs+1) = zlb(1) - zub(n_dbcs+1) = zub(1) + ylb(n_dbcs + 1) = ylb(1) + yub(n_dbcs + 1) = yub(1) + zlb(n_dbcs + 1) = zlb(1) + zub(n_dbcs + 1) = zub(1) DO j = 1, n_dbcs ALLOCATE (dbcs(j)%dirichlet_bc) dbcs(j)%dirichlet_bc%dbc_geom = CYLINDRICAL @@ -930,24 +930,24 @@ SUBROUTINE aa_cylindrical_dbc_setup(pw_pool, cell_xtnts, x_locl, y_locl, z_locl, dbcs(j)%dirichlet_bc%osc_frac = osc_frac dbcs(j)%dirichlet_bc%frequency = frequency dbcs(j)%dirichlet_bc%phase = phase - dbcs(j)%dirichlet_bc%dbc_id = CYLINDRICAL+j + dbcs(j)%dirichlet_bc%dbc_id = CYLINDRICAL + j dbcs(j)%dirichlet_bc%smoothing_width = sigma A = (/cntrlaxis_lb, yub(j), zub(j)/) - B = (/cntrlaxis_lb, ylb(j+1), zlb(j+1)/) - C = (/cntrlaxis_ub, ylb(j+1), zlb(j+1)/) + B = (/cntrlaxis_lb, ylb(j + 1), zlb(j + 1)/) + C = (/cntrlaxis_ub, ylb(j + 1), zlb(j + 1)/) D = (/cntrlaxis_ub, yub(j), zub(j)/) - normal_vec = vector_product((A-C), (D-B)) + normal_vec = vector_product((A - C), (D - B)) unit_normal = normal_vec/SQRT(SUM(normal_vec**2)) dbcs(j)%dirichlet_bc%vertices(1:3, 1) = A dbcs(j)%dirichlet_bc%vertices(1:3, 2) = B dbcs(j)%dirichlet_bc%vertices(1:3, 3) = C dbcs(j)%dirichlet_bc%vertices(1:3, 4) = D - dbcs(j)%dirichlet_bc%vertices(1:3, 5) = D+thickness*unit_normal - dbcs(j)%dirichlet_bc%vertices(1:3, 6) = A+thickness*unit_normal - dbcs(j)%dirichlet_bc%vertices(1:3, 7) = B+thickness*unit_normal - dbcs(j)%dirichlet_bc%vertices(1:3, 8) = C+thickness*unit_normal + dbcs(j)%dirichlet_bc%vertices(1:3, 5) = D + thickness*unit_normal + dbcs(j)%dirichlet_bc%vertices(1:3, 6) = A + thickness*unit_normal + dbcs(j)%dirichlet_bc%vertices(1:3, 7) = B + thickness*unit_normal + dbcs(j)%dirichlet_bc%vertices(1:3, 8) = C + thickness*unit_normal dbcs(j)%dirichlet_bc%n_tiles = 1 @@ -966,15 +966,15 @@ SUBROUTINE aa_cylindrical_dbc_setup(pw_pool, cell_xtnts, x_locl, y_locl, z_locl, END DO CASE (y_axis) DO j = 1, n_dbcs - xlb(j) = base_center(1)+h*SIN(alpha(j)) - zlb(j) = base_center(2)+h*COS(alpha(j)) - xub(j) = base_center(1)+h*SIN(alpha_rotd(j)) - zub(j) = base_center(2)+h*COS(alpha_rotd(j)) + xlb(j) = base_center(1) + h*SIN(alpha(j)) + zlb(j) = base_center(2) + h*COS(alpha(j)) + xub(j) = base_center(1) + h*SIN(alpha_rotd(j)) + zub(j) = base_center(2) + h*COS(alpha_rotd(j)) END DO - xlb(n_dbcs+1) = xlb(1) - xub(n_dbcs+1) = xub(1) - zlb(n_dbcs+1) = zlb(1) - zub(n_dbcs+1) = zub(1) + xlb(n_dbcs + 1) = xlb(1) + xub(n_dbcs + 1) = xub(1) + zlb(n_dbcs + 1) = zlb(1) + zub(n_dbcs + 1) = zub(1) DO j = 1, n_dbcs ALLOCATE (dbcs(j)%dirichlet_bc) dbcs(j)%dirichlet_bc%dbc_geom = CYLINDRICAL @@ -982,24 +982,24 @@ SUBROUTINE aa_cylindrical_dbc_setup(pw_pool, cell_xtnts, x_locl, y_locl, z_locl, dbcs(j)%dirichlet_bc%osc_frac = osc_frac dbcs(j)%dirichlet_bc%frequency = frequency dbcs(j)%dirichlet_bc%phase = phase - dbcs(j)%dirichlet_bc%dbc_id = CYLINDRICAL+j + dbcs(j)%dirichlet_bc%dbc_id = CYLINDRICAL + j dbcs(j)%dirichlet_bc%smoothing_width = sigma A = (/xub(j), cntrlaxis_lb, zub(j)/) - B = (/xlb(j+1), cntrlaxis_lb, zlb(j+1)/) - C = (/xlb(j+1), cntrlaxis_ub, zlb(j+1)/) + B = (/xlb(j + 1), cntrlaxis_lb, zlb(j + 1)/) + C = (/xlb(j + 1), cntrlaxis_ub, zlb(j + 1)/) D = (/xub(j), cntrlaxis_ub, zub(j)/) - normal_vec = vector_product((A-C), (D-B)) + normal_vec = vector_product((A - C), (D - B)) unit_normal = normal_vec/SQRT(SUM(normal_vec**2)) dbcs(j)%dirichlet_bc%vertices(1:3, 1) = A dbcs(j)%dirichlet_bc%vertices(1:3, 2) = B dbcs(j)%dirichlet_bc%vertices(1:3, 3) = C dbcs(j)%dirichlet_bc%vertices(1:3, 4) = D - dbcs(j)%dirichlet_bc%vertices(1:3, 5) = D+thickness*unit_normal - dbcs(j)%dirichlet_bc%vertices(1:3, 6) = A+thickness*unit_normal - dbcs(j)%dirichlet_bc%vertices(1:3, 7) = B+thickness*unit_normal - dbcs(j)%dirichlet_bc%vertices(1:3, 8) = C+thickness*unit_normal + dbcs(j)%dirichlet_bc%vertices(1:3, 5) = D + thickness*unit_normal + dbcs(j)%dirichlet_bc%vertices(1:3, 6) = A + thickness*unit_normal + dbcs(j)%dirichlet_bc%vertices(1:3, 7) = B + thickness*unit_normal + dbcs(j)%dirichlet_bc%vertices(1:3, 8) = C + thickness*unit_normal dbcs(j)%dirichlet_bc%n_tiles = 1 @@ -1018,15 +1018,15 @@ SUBROUTINE aa_cylindrical_dbc_setup(pw_pool, cell_xtnts, x_locl, y_locl, z_locl, END DO CASE (z_axis) DO j = 1, n_dbcs - xlb(j) = base_center(1)+h*SIN(alpha(j)) - ylb(j) = base_center(2)+h*COS(alpha(j)) - xub(j) = base_center(1)+h*SIN(alpha_rotd(j)) - yub(j) = base_center(2)+h*COS(alpha_rotd(j)) + xlb(j) = base_center(1) + h*SIN(alpha(j)) + ylb(j) = base_center(2) + h*COS(alpha(j)) + xub(j) = base_center(1) + h*SIN(alpha_rotd(j)) + yub(j) = base_center(2) + h*COS(alpha_rotd(j)) END DO - xlb(n_dbcs+1) = xlb(1) - xub(n_dbcs+1) = xub(1) - ylb(n_dbcs+1) = ylb(1) - yub(n_dbcs+1) = yub(1) + xlb(n_dbcs + 1) = xlb(1) + xub(n_dbcs + 1) = xub(1) + ylb(n_dbcs + 1) = ylb(1) + yub(n_dbcs + 1) = yub(1) DO j = 1, n_dbcs ALLOCATE (dbcs(j)%dirichlet_bc) dbcs(j)%dirichlet_bc%dbc_geom = CYLINDRICAL @@ -1034,24 +1034,24 @@ SUBROUTINE aa_cylindrical_dbc_setup(pw_pool, cell_xtnts, x_locl, y_locl, z_locl, dbcs(j)%dirichlet_bc%osc_frac = osc_frac dbcs(j)%dirichlet_bc%frequency = frequency dbcs(j)%dirichlet_bc%phase = phase - dbcs(j)%dirichlet_bc%dbc_id = CYLINDRICAL+j + dbcs(j)%dirichlet_bc%dbc_id = CYLINDRICAL + j dbcs(j)%dirichlet_bc%smoothing_width = sigma A = (/xub(j), yub(j), cntrlaxis_lb/) - B = (/xlb(j+1), ylb(j+1), cntrlaxis_lb/) - C = (/xlb(j+1), ylb(j+1), cntrlaxis_ub/) + B = (/xlb(j + 1), ylb(j + 1), cntrlaxis_lb/) + C = (/xlb(j + 1), ylb(j + 1), cntrlaxis_ub/) D = (/xub(j), yub(j), cntrlaxis_ub/) - normal_vec = vector_product((A-C), (D-B)) + normal_vec = vector_product((A - C), (D - B)) unit_normal = normal_vec/SQRT(SUM(normal_vec**2)) dbcs(j)%dirichlet_bc%vertices(1:3, 1) = A dbcs(j)%dirichlet_bc%vertices(1:3, 2) = B dbcs(j)%dirichlet_bc%vertices(1:3, 3) = C dbcs(j)%dirichlet_bc%vertices(1:3, 4) = D - dbcs(j)%dirichlet_bc%vertices(1:3, 5) = D+thickness*unit_normal - dbcs(j)%dirichlet_bc%vertices(1:3, 6) = A+thickness*unit_normal - dbcs(j)%dirichlet_bc%vertices(1:3, 7) = B+thickness*unit_normal - dbcs(j)%dirichlet_bc%vertices(1:3, 8) = C+thickness*unit_normal + dbcs(j)%dirichlet_bc%vertices(1:3, 5) = D + thickness*unit_normal + dbcs(j)%dirichlet_bc%vertices(1:3, 6) = A + thickness*unit_normal + dbcs(j)%dirichlet_bc%vertices(1:3, 7) = B + thickness*unit_normal + dbcs(j)%dirichlet_bc%vertices(1:3, 8) = C + thickness*unit_normal dbcs(j)%dirichlet_bc%n_tiles = 1 @@ -1095,8 +1095,8 @@ FUNCTION linspace(a, b, N) RESULT(arr) INTEGER :: i REAL(dp) :: dx - dx = (b-a)/(N-1) - arr = (/(a+(i-1)*dx, i=1, N)/) + dx = (b - a)/(N - 1) + arr = (/(a + (i - 1)*dx, i=1, N)/) END FUNCTION linspace @@ -1133,11 +1133,11 @@ SUBROUTINE rotate_translate_cuboid(cuboid_vtx, Rmat, Tpnt, cuboid_transfd_vtx) C = cuboid_vtx(1:3, 3); C2 = cuboid_vtx(1:3, 8) D = cuboid_vtx(1:3, 4); D2 = cuboid_vtx(1:3, 5) - Tpnt = (A+C2)/2.0_dp + Tpnt = (A + C2)/2.0_dp - AB = B-A - AD = D-A - AA2 = A2-A + AB = B - A + AD = D - A + AA2 = A2 - A ! unit vectors generating the local coordinate system e1_locl = AB/SQRT(SUM(AB**2)) @@ -1187,14 +1187,14 @@ FUNCTION rotate_translate_vector(Rmat, Tp, direction, vec) RESULT(vec_transfd) IF (direction .EQ. FWROT) THEN CALL matvec_3x3(vec_tmp, Rmat, vec) - vec_transfd = vec_tmp+Tp + vec_transfd = vec_tmp + Tp ELSEIF (direction .EQ. BWROT) THEN Rmat_inv = inv_3x3(Rmat) - Tpoint(1) = Rmat_inv(1, 1)*Tp(1)+Rmat_inv(1, 2)*Tp(2)+Rmat_inv(1, 3)*Tp(3) - Tpoint(2) = Rmat_inv(2, 1)*Tp(1)+Rmat_inv(2, 2)*Tp(2)+Rmat_inv(2, 3)*Tp(3) - Tpoint(3) = Rmat_inv(3, 1)*Tp(1)+Rmat_inv(3, 2)*Tp(2)+Rmat_inv(3, 3)*Tp(3) + Tpoint(1) = Rmat_inv(1, 1)*Tp(1) + Rmat_inv(1, 2)*Tp(2) + Rmat_inv(1, 3)*Tp(3) + Tpoint(2) = Rmat_inv(2, 1)*Tp(1) + Rmat_inv(2, 2)*Tp(2) + Rmat_inv(2, 3)*Tp(3) + Tpoint(3) = Rmat_inv(3, 1)*Tp(1) + Rmat_inv(3, 2)*Tp(2) + Rmat_inv(3, 3)*Tp(3) CALL matvec_3x3(vec_tmp, Rmat_inv, vec) - vec_transfd = vec_tmp-Tpoint + vec_transfd = vec_tmp - Tpoint END IF END FUNCTION rotate_translate_vector @@ -1245,17 +1245,17 @@ SUBROUTINE aa_dbc_partition(dbc_vertices, n_prtn, tiles) z_xtnt(1) = MINVAL(dbc_vertices(3, :)); z_xtnt(2) = MAXVAL(dbc_vertices(3, :)) ! devide the x, y and z extents into n_prtn partitions - step = (x_xtnt(2)-x_xtnt(1))/REAL(n_prtn(1), kind=dp) - xprtn_lb(:) = x_xtnt(1)+(/(i, i=0, n_prtn(1)-1)/)*step ! lower bounds - xprtn_ub(:) = x_xtnt(1)+(/(i, i=1, n_prtn(1))/)*step ! upper bounds + step = (x_xtnt(2) - x_xtnt(1))/REAL(n_prtn(1), kind=dp) + xprtn_lb(:) = x_xtnt(1) + (/(i, i=0, n_prtn(1) - 1)/)*step ! lower bounds + xprtn_ub(:) = x_xtnt(1) + (/(i, i=1, n_prtn(1))/)*step ! upper bounds - step = (y_xtnt(2)-y_xtnt(1))/REAL(n_prtn(2), kind=dp) - yprtn_lb(:) = y_xtnt(1)+(/(i, i=0, n_prtn(2)-1)/)*step - yprtn_ub(:) = y_xtnt(1)+(/(i, i=1, n_prtn(2))/)*step + step = (y_xtnt(2) - y_xtnt(1))/REAL(n_prtn(2), kind=dp) + yprtn_lb(:) = y_xtnt(1) + (/(i, i=0, n_prtn(2) - 1)/)*step + yprtn_ub(:) = y_xtnt(1) + (/(i, i=1, n_prtn(2))/)*step - step = (z_xtnt(2)-z_xtnt(1))/REAL(n_prtn(3), kind=dp) - zprtn_lb(:) = z_xtnt(1)+(/(i, i=0, n_prtn(3)-1)/)*step - zprtn_ub(:) = z_xtnt(1)+(/(i, i=1, n_prtn(3))/)*step + step = (z_xtnt(2) - z_xtnt(1))/REAL(n_prtn(3), kind=dp) + zprtn_lb(:) = z_xtnt(1) + (/(i, i=0, n_prtn(3) - 1)/)*step + zprtn_ub(:) = z_xtnt(1) + (/(i, i=1, n_prtn(3))/)*step ALLOCATE (tiles(n_prtn(1)*n_prtn(2)*n_prtn(3))) k = 1 @@ -1275,7 +1275,7 @@ SUBROUTINE aa_dbc_partition(dbc_vertices, n_prtn, tiles) tiles(k)%tile%vertices(1:3, 8) = (/xprtn_ub(ii), yprtn_ub(jj), zprtn_ub(kk)/) tiles(k)%tile%volume = 0.0_dp - k = k+1 + k = k + 1 END DO END DO END DO @@ -1318,22 +1318,22 @@ SUBROUTINE arbitrary_dbc_partition(dbc_vertices, n_prtn, tiles) D = dbc_vertices(:, 4) D2 = dbc_vertices(:, 5) - AB = B-A - AC = C-A - AD = D-A + AB = B - A + AC = C - A + AD = D - A normal_vector = vector_product(AB, AC) unit_normal = normal_vector/SQRT(SUM(normal_vector**2)) - thickness = SQRT(SUM((D-D2)**2)) + thickness = SQRT(SUM((D - D2)**2)) ! the larger n_prtn is assigned to the longer edge ABlength = SQRT(SUM(AB**2)) ADlength = SQRT(SUM(AD**2)) IF (ADlength .GE. ABlength) THEN - np1 = MAX(n_prtn(1)+1, n_prtn(2)+1) - np2 = MIN(n_prtn(1)+1, n_prtn(2)+1) + np1 = MAX(n_prtn(1) + 1, n_prtn(2) + 1) + np2 = MIN(n_prtn(1) + 1, n_prtn(2) + 1) ELSE - np1 = MIN(n_prtn(1)+1, n_prtn(2)+1) - np2 = MAX(n_prtn(1)+1, n_prtn(2)+1) + np1 = MIN(n_prtn(1) + 1, n_prtn(2) + 1) + np2 = MAX(n_prtn(1) + 1, n_prtn(2) + 1) END IF ALLOCATE (X(np1, np2, 3)) @@ -1341,9 +1341,9 @@ SUBROUTINE arbitrary_dbc_partition(dbc_vertices, n_prtn, tiles) ! partition AD and BC DO l = 1, np1 - step = REAL((l-1), kind=dp)/REAL((np1-1), kind=dp) - end_points(1, l, :) = A*(1.0_dp-step)+D*step - end_points(2, l, :) = B*(1.0_dp-step)+C*step + step = REAL((l - 1), kind=dp)/REAL((np1 - 1), kind=dp) + end_points(1, l, :) = A*(1.0_dp - step) + D*step + end_points(2, l, :) = B*(1.0_dp - step) + C*step END DO ! partition in the second direction along the line segments with endpoints from @@ -1352,29 +1352,29 @@ SUBROUTINE arbitrary_dbc_partition(dbc_vertices, n_prtn, tiles) point1(:) = end_points(1, l, :) point2(:) = end_points(2, l, :) DO i = 1, np2 - step = REAL((i-1), kind=dp)/REAL((np2-1), kind=dp) - X(l, i, :) = point1*(1.0_dp-step)+point2*step + step = REAL((i - 1), kind=dp)/REAL((np2 - 1), kind=dp) + X(l, i, :) = point1*(1.0_dp - step) + point2*step END DO END DO - ALLOCATE (tiles((np1-1)*(np2-1))) + ALLOCATE (tiles((np1 - 1)*(np2 - 1))) k = 1 - DO l = 1, np1-1 - DO i = 1, np2-1 + DO l = 1, np1 - 1 + DO i = 1, np2 - 1 ALLOCATE (tiles(k)%tile) tiles(k)%tile%tile_id = k tiles(k)%tile%vertices(1:3, 1) = X(l, i, :) - tiles(k)%tile%vertices(1:3, 2) = X(l, i+1, :) - tiles(k)%tile%vertices(1:3, 3) = X(l+1, i+1, :) - tiles(k)%tile%vertices(1:3, 4) = X(l+1, i, :) - tiles(k)%tile%vertices(1:3, 5) = X(l+1, i, :)+thickness*unit_normal - tiles(k)%tile%vertices(1:3, 6) = X(l, i, :)+thickness*unit_normal - tiles(k)%tile%vertices(1:3, 7) = X(l, i+1, :)+thickness*unit_normal - tiles(k)%tile%vertices(1:3, 8) = X(l+1, i+1, :)+thickness*unit_normal + tiles(k)%tile%vertices(1:3, 2) = X(l, i + 1, :) + tiles(k)%tile%vertices(1:3, 3) = X(l + 1, i + 1, :) + tiles(k)%tile%vertices(1:3, 4) = X(l + 1, i, :) + tiles(k)%tile%vertices(1:3, 5) = X(l + 1, i, :) + thickness*unit_normal + tiles(k)%tile%vertices(1:3, 6) = X(l, i, :) + thickness*unit_normal + tiles(k)%tile%vertices(1:3, 7) = X(l, i + 1, :) + thickness*unit_normal + tiles(k)%tile%vertices(1:3, 8) = X(l + 1, i + 1, :) + thickness*unit_normal tiles(k)%tile%volume = 0.0_dp - k = k+1 + k = k + 1 END DO END DO @@ -1431,7 +1431,7 @@ SUBROUTINE aa_tile_pw_compute(cell_xtnts, x_locl, y_locl, z_locl, tile_vertices, ALLOCATE (xloclr(lb1:ub1), yloclr(lb2:ub2), zloclr(lb3:ub3)) ! periodicities - per = cell_xtnts(2, :)-cell_xtnts(1, :) + per = cell_xtnts(2, :) - cell_xtnts(1, :) x_xtnt(1) = MINVAL(tile_vertices(1, :)); x_xtnt(2) = MAXVAL(tile_vertices(1, :)) y_xtnt(1) = MINVAL(tile_vertices(2, :)); y_xtnt(2) = MAXVAL(tile_vertices(2, :)) @@ -1445,25 +1445,25 @@ SUBROUTINE aa_tile_pw_compute(cell_xtnts, x_locl, y_locl, z_locl, tile_vertices, DO j = lb2, ub2 DO i = lb1, ub1 xi0 = x_locl(i); yj0 = y_locl(j); zk0 = z_locl(k) - xil = x_locl(i)-per(1); yjl = y_locl(j)-per(2); zkl = z_locl(k)-per(3) - xir = x_locl(i)+per(1); yjr = y_locl(j)+per(2); zkr = z_locl(k)+per(3) + xil = x_locl(i) - per(1); yjl = y_locl(j) - per(2); zkl = z_locl(k) - per(3) + xir = x_locl(i) + per(1); yjr = y_locl(j) + per(2); zkr = z_locl(k) + per(3) ! points from the original cell local to the current processor - fx = prefactor(1, 2)*(erf((xi0-x_xtnt(1))/sigma)-erf((xi0-x_xtnt(2))/sigma)) - fy = prefactor(2, 2)*(erf((yj0-y_xtnt(1))/sigma)-erf((yj0-y_xtnt(2))/sigma)) - fz = prefactor(3, 2)*(erf((zk0-z_xtnt(1))/sigma)-erf((zk0-z_xtnt(2))/sigma)) + fx = prefactor(1, 2)*(erf((xi0 - x_xtnt(1))/sigma) - erf((xi0 - x_xtnt(2))/sigma)) + fy = prefactor(2, 2)*(erf((yj0 - y_xtnt(1))/sigma) - erf((yj0 - y_xtnt(2))/sigma)) + fz = prefactor(3, 2)*(erf((zk0 - z_xtnt(1))/sigma) - erf((zk0 - z_xtnt(2))/sigma)) ! periodically replicated cell on the left, points local to the current processor - gx = prefactor(1, 1)*(erf((xil-x_xtnt(1))/sigma)-erf((xil-x_xtnt(2))/sigma)) - gy = prefactor(2, 1)*(erf((yjl-y_xtnt(1))/sigma)-erf((yjl-y_xtnt(2))/sigma)) - gz = prefactor(3, 1)*(erf((zkl-z_xtnt(1))/sigma)-erf((zkl-z_xtnt(2))/sigma)) + gx = prefactor(1, 1)*(erf((xil - x_xtnt(1))/sigma) - erf((xil - x_xtnt(2))/sigma)) + gy = prefactor(2, 1)*(erf((yjl - y_xtnt(1))/sigma) - erf((yjl - y_xtnt(2))/sigma)) + gz = prefactor(3, 1)*(erf((zkl - z_xtnt(1))/sigma) - erf((zkl - z_xtnt(2))/sigma)) ! periodically replicated cell on the right, points local to the current processor - hx = prefactor(1, 3)*(erf((xir-x_xtnt(1))/sigma)-erf((xir-x_xtnt(2))/sigma)) - hy = prefactor(2, 3)*(erf((yjr-y_xtnt(1))/sigma)-erf((yjr-y_xtnt(2))/sigma)) - hz = prefactor(3, 3)*(erf((zkr-z_xtnt(1))/sigma)-erf((zkr-z_xtnt(2))/sigma)) + hx = prefactor(1, 3)*(erf((xir - x_xtnt(1))/sigma) - erf((xir - x_xtnt(2))/sigma)) + hy = prefactor(2, 3)*(erf((yjr - y_xtnt(1))/sigma) - erf((yjr - y_xtnt(2))/sigma)) + hz = prefactor(3, 3)*(erf((zkr - z_xtnt(1))/sigma) - erf((zkr - z_xtnt(2))/sigma)) - tile_pw%cr3d(i, j, k) = (fx+gx+hx)*(fy+gy+hy)*(fz+gz+hz) + tile_pw%cr3d(i, j, k) = (fx + gx + hx)*(fy + gy + hy)*(fz + gz + hz) END DO END DO END DO @@ -1473,9 +1473,9 @@ SUBROUTINE aa_tile_pw_compute(cell_xtnts, x_locl, y_locl, z_locl, tile_vertices, DO i = lb1, ub1 xi0 = x_locl(i); yj0 = y_locl(j); zk0 = z_locl(k) - fx = 0.5_dp*(erf((xi0-x_xtnt(1))/sigma)-erf((xi0-x_xtnt(2))/sigma)) - fy = 0.5_dp*(erf((yj0-y_xtnt(1))/sigma)-erf((yj0-y_xtnt(2))/sigma)) - fz = 0.5_dp*(erf((zk0-z_xtnt(1))/sigma)-erf((zk0-z_xtnt(2))/sigma)) + fx = 0.5_dp*(erf((xi0 - x_xtnt(1))/sigma) - erf((xi0 - x_xtnt(2))/sigma)) + fy = 0.5_dp*(erf((yj0 - y_xtnt(1))/sigma) - erf((yj0 - y_xtnt(2))/sigma)) + fz = 0.5_dp*(erf((zk0 - z_xtnt(1))/sigma) - erf((zk0 - z_xtnt(2))/sigma)) tile_pw%cr3d(i, j, k) = fx*fy*fz END DO @@ -1535,7 +1535,7 @@ SUBROUTINE arbitrary_tile_pw_compute(cell_xtnts, x_locl, y_locl, z_locl, tile_ve ALLOCATE (xlocll(lb1:ub1), ylocll(lb2:ub2), zlocll(lb3:ub3)) ALLOCATE (xloclr(lb1:ub1), yloclr(lb2:ub2), zloclr(lb3:ub3)) - per = cell_xtnts(2, :)-cell_xtnts(1, :) + per = cell_xtnts(2, :) - cell_xtnts(1, :) CALL rotate_translate_cuboid(tile_vertices, Rmat, Tpnt, tile_transfd_vertices) @@ -1546,13 +1546,13 @@ SUBROUTINE arbitrary_tile_pw_compute(cell_xtnts, x_locl, y_locl, z_locl, tile_ve transfdz_xtnt(1) = MINVAL(tile_transfd_vertices(3, :)) transfdz_xtnt(2) = MAXVAL(tile_transfd_vertices(3, :)) - cm_x = 0.5_dp*(transfdx_xtnt(2)+transfdx_xtnt(1)) - cm_y = 0.5_dp*(transfdy_xtnt(2)+transfdy_xtnt(1)) - cm_z = 0.5_dp*(transfdz_xtnt(2)+transfdz_xtnt(1)) + cm_x = 0.5_dp*(transfdx_xtnt(2) + transfdx_xtnt(1)) + cm_y = 0.5_dp*(transfdy_xtnt(2) + transfdy_xtnt(1)) + cm_z = 0.5_dp*(transfdz_xtnt(2) + transfdz_xtnt(1)) - x_xtnt = transfdx_xtnt-cm_x - y_xtnt = transfdy_xtnt-cm_y - z_xtnt = transfdz_xtnt-cm_z + x_xtnt = transfdx_xtnt - cm_x + y_xtnt = transfdy_xtnt - cm_y + z_xtnt = transfdz_xtnt - cm_z prefactor = 0.5_dp @@ -1563,9 +1563,9 @@ SUBROUTINE arbitrary_tile_pw_compute(cell_xtnts, x_locl, y_locl, z_locl, tile_ve xi0 = pnt0(1); yj0 = pnt0(2); zk0 = pnt0(3) - fx = 0.5_dp*(erf((xi0-x_xtnt(1))/sigma)-erf((xi0-x_xtnt(2))/sigma)) - fy = 0.5_dp*(erf((yj0-y_xtnt(1))/sigma)-erf((yj0-y_xtnt(2))/sigma)) - fz = 0.5_dp*(erf((zk0-z_xtnt(1))/sigma)-erf((zk0-z_xtnt(2))/sigma)) + fx = 0.5_dp*(erf((xi0 - x_xtnt(1))/sigma) - erf((xi0 - x_xtnt(2))/sigma)) + fy = 0.5_dp*(erf((yj0 - y_xtnt(1))/sigma) - erf((yj0 - y_xtnt(2))/sigma)) + fz = 0.5_dp*(erf((zk0 - z_xtnt(1))/sigma) - erf((zk0 - z_xtnt(2))/sigma)) tile_pw%cr3d(i, j, k) = fx*fy*fz END DO diff --git a/src/pw/fft/fftw3_lib.F b/src/pw/fft/fftw3_lib.F index bc0db6cbb2..7f96c6695f 100644 --- a/src/pw/fft/fftw3_lib.F +++ b/src/pw/fft/fftw3_lib.F @@ -18,21 +18,21 @@ MODULE fftw3_lib integer8_kind USE fft_plan, ONLY: fft_plan_type - !$ USE OMP_LIB, ONLY: omp_get_max_threads, omp_get_thread_num, omp_get_num_threads +!$ USE OMP_LIB, ONLY: omp_get_max_threads, omp_get_thread_num, omp_get_num_threads #include "../../base/base_uses.f90" - IMPLICIT NONE - PRIVATE + IMPLICIT NONE + PRIVATE - PUBLIC :: fftw3_do_init, fftw3_do_cleanup, fftw3_get_lengths, fftw33d, fftw31dm - PUBLIC :: fftw3_destroy_plan, fftw3_create_plan_1dm, fftw3_create_plan_3d + PUBLIC :: fftw3_do_init, fftw3_do_cleanup, fftw3_get_lengths, fftw33d, fftw31dm + PUBLIC :: fftw3_destroy_plan, fftw3_create_plan_1dm, fftw3_create_plan_3d #if defined ( __FFTW3 ) - INTERFACE - SUBROUTINE fftw_cleanup() BIND(C,name="fftw_cleanup") + INTERFACE + SUBROUTINE fftw_cleanup() BIND(C, name="fftw_cleanup") END SUBROUTINE - END INTERFACE + END INTERFACE #endif CONTAINS @@ -42,46 +42,45 @@ SUBROUTINE fftw_cleanup() BIND(C,name="fftw_cleanup") !> \param wisdom_file ... !> \param ionode ... ! ************************************************************************************************** -SUBROUTINE fftw3_do_cleanup(wisdom_file,ionode) - - CHARACTER(LEN=*), INTENT(IN) :: wisdom_file - LOGICAL :: ionode + SUBROUTINE fftw3_do_cleanup(wisdom_file, ionode) + CHARACTER(LEN=*), INTENT(IN) :: wisdom_file + LOGICAL :: ionode #if defined ( __FFTW3 ) - INTEGER :: iunit,istat - ! Write out FFTW3 wisdom to file (if we can) - ! only the ionode updates the wisdom - IF (ionode) THEN - iunit=get_unit_number() - OPEN(UNIT=iunit,FILE=wisdom_file,STATUS="UNKNOWN",FORM="FORMATTED",ACTION="WRITE",IOSTAT=istat) - IF (istat==0) THEN - CALL fftw_export_wisdom_to_file(iunit) - CLOSE(iunit) - ENDIF - ENDIF - - CALL fftw_cleanup() + INTEGER :: iunit, istat + ! Write out FFTW3 wisdom to file (if we can) + ! only the ionode updates the wisdom + IF (ionode) THEN + iunit = get_unit_number() + OPEN (UNIT=iunit, FILE=wisdom_file, STATUS="UNKNOWN", FORM="FORMATTED", ACTION="WRITE", IOSTAT=istat) + IF (istat == 0) THEN + CALL fftw_export_wisdom_to_file(iunit) + CLOSE (iunit) + ENDIF + ENDIF + + CALL fftw_cleanup() #else - MARK_USED(wisdom_file) - MARK_USED(ionode) + MARK_USED(wisdom_file) + MARK_USED(ionode) #endif -END SUBROUTINE + END SUBROUTINE ! ************************************************************************************************** !> \brief ... !> \param wisdom_file ... ! ************************************************************************************************** -SUBROUTINE fftw3_do_init(wisdom_file) + SUBROUTINE fftw3_do_init(wisdom_file) - CHARACTER(LEN=*), INTENT(IN) :: wisdom_file + CHARACTER(LEN=*), INTENT(IN) :: wisdom_file #if defined ( __FFTW3 ) - INTEGER :: istat, isuccess, iunit - LOGICAL :: exist + INTEGER :: istat, isuccess, iunit + LOGICAL :: exist -!$ LOGICAL :: mkl_is_safe +!$ LOGICAL :: mkl_is_safe ! If using the Intel compiler then we need to declare ! a C interface to a global variable in MKL that sets @@ -94,9 +93,9 @@ SUBROUTINE fftw3_do_init(wisdom_file) !DEC$ IF DEFINED (INTEL_MKL_VERSION) !DEC$ IF INTEL_MKL_VERSION .EQ. 110100 !DIR$ ATTRIBUTES ALIGN : 8 :: fftw3_mkl -!$ COMMON/fftw3_mkl/ignore(4),mkl_dft_number_of_user_threads,ignore2(7) -!$ INTEGER*4 :: ignore, mkl_dft_number_of_user_threads, ignore2 -!$ BIND (c) :: /fftw3_mkl/ +!$ COMMON/fftw3_mkl/ignore(4), mkl_dft_number_of_user_threads, ignore2(7) +!$ INTEGER*4 :: ignore, mkl_dft_number_of_user_threads, ignore2 +!$ BIND(c) :: /fftw3_mkl/ !DEC$ ENDIF !DEC$ ENDIF #elif defined (__MKL) && defined (__FFTW3) @@ -104,54 +103,53 @@ SUBROUTINE fftw3_do_init(wisdom_file) #include #endif - ! Read FFTW wisdom (if available) - ! all nodes are opening the file here... - INQUIRE(FILE=wisdom_file,exist=exist) - IF (exist) THEN - iunit=get_unit_number() - OPEN(UNIT=iunit,FILE=wisdom_file,STATUS="OLD",FORM="FORMATTED",POSITION="REWIND",& - ACTION="READ",IOSTAT=istat) - IF (istat==0) THEN - CALL fftw_import_wisdom_from_file(isuccess,iunit) - ! write(*,*) "FFTW3 import wisdom from file ....",MERGE((/"OK "/),(/"NOT OK"/),(/isuccess==1/)) - CLOSE(iunit) - ENDIF - ENDIF - + ! Read FFTW wisdom (if available) + ! all nodes are opening the file here... + INQUIRE (FILE=wisdom_file, exist=exist) + IF (exist) THEN + iunit = get_unit_number() + OPEN (UNIT=iunit, FILE=wisdom_file, STATUS="OLD", FORM="FORMATTED", POSITION="REWIND", & + ACTION="READ", IOSTAT=istat) + IF (istat == 0) THEN + CALL fftw_import_wisdom_from_file(isuccess, iunit) + ! write(*,*) "FFTW3 import wisdom from file ....",MERGE((/"OK "/),(/"NOT OK"/),(/isuccess==1/)) + CLOSE (iunit) + ENDIF + ENDIF - ! Now check if we have a real FFTW3 library, or are using MKL wrappers + ! Now check if we have a real FFTW3 library, or are using MKL wrappers -!$ IF (fftw3_is_mkl_wrapper() .and. omp_get_max_threads() .gt. 1) THEN +!$ IF (fftw3_is_mkl_wrapper() .and. omp_get_max_threads() .gt. 1) THEN ! If we are not using the Intel compiler, there is no way to tell which ! MKL version is in use, so fail safe... -!$ mkl_is_safe = .FALSE. +!$ mkl_is_safe = .FALSE. #if defined (__MKL) && defined (__FFTW3) && defined(INTEL_MKL_VERSION) && (110100 < INTEL_MKL_VERSION) -!$ mkl_is_safe = .TRUE. +!$ mkl_is_safe = .TRUE. #elif defined (__INTEL_COMPILER) && defined (__MKL) && defined (__FFTW3) ! If we have an Intel compiler (__INTEL_COMPILER is defined) then check the ! MKL version and make the appropriate action !DEC$ IF DEFINED (INTEL_MKL_VERSION) !DEC$ IF INTEL_MKL_VERSION .EQ. 110100 -!$ mkl_dft_number_of_user_threads=omp_get_max_threads() +!$ mkl_dft_number_of_user_threads = omp_get_max_threads() !DEC$ ENDIF !DEC$ IF INTEL_MKL_VERSION .GE. 110100 -!$ mkl_is_safe = .TRUE. +!$ mkl_is_safe = .TRUE. !DEC$ ENDIF !DEC$ ENDIF #endif -!$ IF (.NOT.mkl_is_safe) THEN -!$ STOP "Intel's FFTW3 interface to MKL is not "//& -!$ "thread-safe prior to MKL 11.1.0! Please "//& -!$ "rebuild CP2K, linking against FFTW 3 from "//& -!$ "www.fftw.org or a newer version of MKL. "//& -!$ "Now exiting..." -!$ ENDIF -!$ ENDIF +!$ IF (.NOT. mkl_is_safe) THEN +!$ STOP "Intel's FFTW3 interface to MKL is not "// & +!$ "thread-safe prior to MKL 11.1.0! Please "// & +!$ "rebuild CP2K, linking against FFTW 3 from "// & +!$ "www.fftw.org or a newer version of MKL. "// & +!$ "Now exiting..." +!$ ENDIF +!$ ENDIF #else - MARK_USED(wisdom_file) + MARK_USED(wisdom_file) #endif -END SUBROUTINE + END SUBROUTINE ! ************************************************************************************************** !> \brief ... @@ -167,8 +165,7 @@ SUBROUTINE fftw3_do_init(wisdom_file) !> IAB 11-Sep-2012 : OpenMP parallel 3D FFT (Ruyman Reyes, PRACE) !> \author JGH ! ************************************************************************************************** -SUBROUTINE fftw3_get_lengths ( DATA, max_length ) - + SUBROUTINE fftw3_get_lengths(DATA, max_length) INTEGER, DIMENSION(*) :: DATA INTEGER, INTENT(INOUT) :: max_length @@ -184,69 +181,68 @@ SUBROUTINE fftw3_get_lengths ( DATA, max_length ) !! FFTW can do arbitrary(?) lengths, maybe you want to limit them to some !! powers of small prime numbers though... - maxn_twos = 15 - maxn_threes = 3 - maxn_fives = 2 - maxn_sevens = 1 - maxn_elevens = 1 - maxn_thirteens = 0 - maxn = 37748736 - - ndata = 0 - DO h = 0, maxn_twos - nmax = HUGE(0) / 2**h - DO i = 0, maxn_threes - DO j = 0, maxn_fives - DO k = 0, maxn_sevens - DO m = 0, maxn_elevens - number = (3**i) * (5**j) * (7**k) * (11**m) - - IF ( number > nmax ) CYCLE - - number = number * 2 ** h - IF ( number >= maxn ) CYCLE - - ndata = ndata + 1 - END DO - END DO - END DO - END DO - END DO - - ALLOCATE ( dlocal ( ndata ), idx ( ndata ) ) - - ndata = 0 - dlocal ( : ) = 0 - DO h = 0, maxn_twos - nmax = HUGE(0) / 2**h - DO i = 0, maxn_threes - DO j = 0, maxn_fives - DO k = 0, maxn_sevens - DO m = 0, maxn_elevens - number = (3**i) * (5**j) * (7**k) * (11**m) - - IF ( number > nmax ) CYCLE - - number = number * 2 ** h - IF ( number >= maxn ) CYCLE - - ndata = ndata + 1 - dlocal ( ndata ) = number - END DO - END DO - END DO - END DO - END DO - - CALL sortint ( dlocal, ndata, idx ) - ndata = MIN ( ndata, max_length ) - DATA(1:ndata) = dlocal(1:ndata) - max_length = ndata - - DEALLOCATE ( dlocal, idx ) - -END SUBROUTINE fftw3_get_lengths - + maxn_twos = 15 + maxn_threes = 3 + maxn_fives = 2 + maxn_sevens = 1 + maxn_elevens = 1 + maxn_thirteens = 0 + maxn = 37748736 + + ndata = 0 + DO h = 0, maxn_twos + nmax = HUGE(0)/2**h + DO i = 0, maxn_threes + DO j = 0, maxn_fives + DO k = 0, maxn_sevens + DO m = 0, maxn_elevens + number = (3**i)*(5**j)*(7**k)*(11**m) + + IF (number > nmax) CYCLE + + number = number*2**h + IF (number >= maxn) CYCLE + + ndata = ndata + 1 + END DO + END DO + END DO + END DO + END DO + + ALLOCATE (dlocal(ndata), idx(ndata)) + + ndata = 0 + dlocal(:) = 0 + DO h = 0, maxn_twos + nmax = HUGE(0)/2**h + DO i = 0, maxn_threes + DO j = 0, maxn_fives + DO k = 0, maxn_sevens + DO m = 0, maxn_elevens + number = (3**i)*(5**j)*(7**k)*(11**m) + + IF (number > nmax) CYCLE + + number = number*2**h + IF (number >= maxn) CYCLE + + ndata = ndata + 1 + dlocal(ndata) = number + END DO + END DO + END DO + END DO + END DO + + CALL sortint(dlocal, ndata, idx) + ndata = MIN(ndata, max_length) + DATA(1:ndata) = dlocal(1:ndata) + max_length = ndata + + DEALLOCATE (dlocal, idx) + + END SUBROUTINE fftw3_get_lengths ! ************************************************************************************************** !> \brief ... @@ -254,7 +250,7 @@ END SUBROUTINE fftw3_get_lengths !> \param n ... !> \param index ... ! ************************************************************************************************** -SUBROUTINE sortint ( iarr, n, index ) + SUBROUTINE sortint(iarr, n, index) INTEGER, INTENT(IN) :: n INTEGER, INTENT(INOUT) :: iarr(1:n) @@ -267,103 +263,103 @@ SUBROUTINE sortint ( iarr, n, index ) !------------------------------------------------------------------------------ - DO i = 1, n - INDEX(i) = i - END DO - jstack = 0 - l = 1 - ir = n - DO WHILE(.TRUE.) - IF (ir-liarr(ir)) THEN - temp = iarr(l+1) - iarr(l+1) = iarr(ir) - iarr(ir) = temp - itemp = INDEX(l+1) - INDEX(l+1) = INDEX(ir) - INDEX(ir) = itemp - END IF - IF (iarr(l)>iarr(ir)) THEN - temp = iarr(l) - iarr(l) = iarr(ir) - iarr(ir) = temp - itemp = INDEX(l) - INDEX(l) = INDEX(ir) - INDEX(ir) = itemp - END IF - IF (iarr(l+1)>iarr(l)) THEN - temp = iarr(l+1) - iarr(l+1) = iarr(l) - iarr(l) = temp - itemp = INDEX(l+1) - INDEX(l+1) = INDEX(l) - INDEX(l) = itemp - END IF - i = l + 1 - j = ir - a = iarr(l) - ib = INDEX(l) - DO WHILE(.TRUE.) - i = i + 1 - DO WHILE(iarr(i)a) - j = j - 1 - ENDDO - IF (jnstack) CPABORT(" Nstack too small in sortr") - IF (ir-i+1>=j-l) THEN - istack(jstack) = ir - istack(jstack-1) = i - ir = j - 1 - ELSE - istack(jstack) = j - 1 - istack(jstack-1) = l - l = i - END IF - END IF - - ENDDO - -END SUBROUTINE sortint + DO i = 1, n + INDEX(i) = i + END DO + jstack = 0 + l = 1 + ir = n + DO WHILE (.TRUE.) + IF (ir - l < m) THEN + DO j = l + 1, ir + a = iarr(j) + ib = INDEX(j) + DO i = j - 1, 0, -1 + IF (i == 0) EXIT + IF (iarr(i) <= a) EXIT + iarr(i + 1) = iarr(i) + INDEX(i + 1) = INDEX(i) + END DO + iarr(i + 1) = a + INDEX(i + 1) = ib + END DO + IF (jstack == 0) RETURN + ir = istack(jstack) + l = istack(jstack - 1) + jstack = jstack - 2 + ELSE + k = (l + ir)/2 + temp = iarr(k) + iarr(k) = iarr(l + 1) + iarr(l + 1) = temp + itemp = INDEX(k) + INDEX(k) = INDEX(l + 1) + INDEX(l + 1) = itemp + IF (iarr(l + 1) > iarr(ir)) THEN + temp = iarr(l + 1) + iarr(l + 1) = iarr(ir) + iarr(ir) = temp + itemp = INDEX(l + 1) + INDEX(l + 1) = INDEX(ir) + INDEX(ir) = itemp + END IF + IF (iarr(l) > iarr(ir)) THEN + temp = iarr(l) + iarr(l) = iarr(ir) + iarr(ir) = temp + itemp = INDEX(l) + INDEX(l) = INDEX(ir) + INDEX(ir) = itemp + END IF + IF (iarr(l + 1) > iarr(l)) THEN + temp = iarr(l + 1) + iarr(l + 1) = iarr(l) + iarr(l) = temp + itemp = INDEX(l + 1) + INDEX(l + 1) = INDEX(l) + INDEX(l) = itemp + END IF + i = l + 1 + j = ir + a = iarr(l) + ib = INDEX(l) + DO WHILE (.TRUE.) + i = i + 1 + DO WHILE (iarr(i) < a) + i = i + 1 + ENDDO + j = j - 1 + DO WHILE (iarr(j) > a) + j = j - 1 + ENDDO + IF (j < i) EXIT + temp = iarr(i) + iarr(i) = iarr(j) + iarr(j) = temp + itemp = INDEX(i) + INDEX(i) = INDEX(j) + INDEX(j) = itemp + ENDDO + iarr(l) = iarr(j) + iarr(j) = a + INDEX(l) = INDEX(j) + INDEX(j) = ib + jstack = jstack + 2 + IF (jstack > nstack) CPABORT(" Nstack too small in sortr") + IF (ir - i + 1 >= j - l) THEN + istack(jstack) = ir + istack(jstack - 1) = i + ir = j - 1 + ELSE + istack(jstack) = j - 1 + istack(jstack - 1) = l + l = i + END IF + END IF + + ENDDO + + END SUBROUTINE sortint ! ************************************************************************************************** @@ -384,56 +380,55 @@ END SUBROUTINE sortint !> \param fftw_plan_type ... !> \param valid ... ! ************************************************************************************************** -SUBROUTINE fftw3_create_guru_plan(plan, fft_rank, dim_n, & - dim_istride, dim_ostride, hm_rank, & - hm_n, hm_istride, hm_ostride, & - zin, zout, fft_direction, fftw_plan_type, & - valid) - - - IMPLICIT NONE - - INTEGER(KIND=integer8_kind), INTENT ( INOUT ) :: plan - COMPLEX(KIND=dp), DIMENSION(*), INTENT(IN) :: zin - COMPLEX(KIND=dp), DIMENSION(*), INTENT(IN) :: zout - INTEGER, INTENT(IN) :: dim_n(2), dim_istride(2), dim_ostride(2), & - hm_n(2), hm_istride(2), hm_ostride(2), fft_rank, & - fft_direction, fftw_plan_type, hm_rank - LOGICAL, INTENT(OUT) :: valid + SUBROUTINE fftw3_create_guru_plan(plan, fft_rank, dim_n, & + dim_istride, dim_ostride, hm_rank, & + hm_n, hm_istride, hm_ostride, & + zin, zout, fft_direction, fftw_plan_type, & + valid) + + IMPLICIT NONE + + INTEGER(KIND=integer8_kind), INTENT(INOUT) :: plan + COMPLEX(KIND=dp), DIMENSION(*), INTENT(IN) :: zin + COMPLEX(KIND=dp), DIMENSION(*), INTENT(IN) :: zout + INTEGER, INTENT(IN) :: dim_n(2), dim_istride(2), dim_ostride(2), & + hm_n(2), hm_istride(2), hm_ostride(2), fft_rank, & + fft_direction, fftw_plan_type, hm_rank + LOGICAL, INTENT(OUT) :: valid #if defined (__FFTW3) - CALL XFFTW_PLAN_GURU_DFT(plan,fft_rank, & - dim_n,dim_istride,dim_ostride, & - hm_rank,hm_n,hm_istride,hm_ostride, & - zin, zout, & - fft_direction, fftw_plan_type) + CALL XFFTW_PLAN_GURU_DFT(plan, fft_rank, & + dim_n, dim_istride, dim_ostride, & + hm_rank, hm_n, hm_istride, hm_ostride, & + zin, zout, & + fft_direction, fftw_plan_type) - IF (plan .EQ. 0) THEN - valid = .FALSE. - ELSE - valid = .TRUE. - ENDIF + IF (plan .EQ. 0) THEN + valid = .FALSE. + ELSE + valid = .TRUE. + ENDIF #else - MARK_USED(plan) - MARK_USED(fft_rank) - MARK_USED(dim_n) - MARK_USED(dim_istride) - MARK_USED(dim_ostride) - MARK_USED(hm_rank) - MARK_USED(hm_n) - MARK_USED(hm_istride) - MARK_USED(hm_ostride) - MARK_USED(fft_direction) - MARK_USED(fftw_plan_type) - !MARK_USED does not work with assumed size arguments - IF(.FALSE.)THEN; DO; IF(ABS(zin(1))>ABS(zout(1)))EXIT; ENDDO; ENDIF - valid = .FALSE. + MARK_USED(plan) + MARK_USED(fft_rank) + MARK_USED(dim_n) + MARK_USED(dim_istride) + MARK_USED(dim_ostride) + MARK_USED(hm_rank) + MARK_USED(hm_n) + MARK_USED(hm_istride) + MARK_USED(hm_ostride) + MARK_USED(fft_direction) + MARK_USED(fftw_plan_type) + !MARK_USED does not work with assumed size arguments + IF (.FALSE.) THEN; DO; IF (ABS(zin(1)) > ABS(zout(1))) EXIT; ENDDO; ENDIF + valid = .FALSE. #endif -END SUBROUTINE + END SUBROUTINE ! ************************************************************************************************** @@ -441,50 +436,50 @@ SUBROUTINE fftw3_create_guru_plan(plan, fft_rank, dim_n, & !> \brief ... !> \return ... ! ************************************************************************************************** -FUNCTION fftw3_is_mkl_wrapper() RESULT(is_mkl) + FUNCTION fftw3_is_mkl_wrapper() RESULT(is_mkl) - IMPLICIT NONE + IMPLICIT NONE - LOGICAL :: is_mkl + LOGICAL :: is_mkl #if defined ( __FFTW3 ) - LOGICAL :: guru_supported - INTEGER :: dim_n(2), dim_istride(2), dim_ostride(2), & - howmany_n(2), howmany_istride(2), howmany_ostride(2) - INTEGER (KIND=integer8_kind) :: test_plan - COMPLEX(KIND=dp), DIMENSION(1,1,1) :: zin + LOGICAL :: guru_supported + INTEGER :: dim_n(2), dim_istride(2), dim_ostride(2), & + howmany_n(2), howmany_istride(2), howmany_ostride(2) + INTEGER(KIND=integer8_kind) :: test_plan + COMPLEX(KIND=dp), DIMENSION(1, 1, 1) :: zin #include "fftw3.f" - ! Attempt to create a plan with the guru interface for a 2d sub-space - ! If this fails (e.g. for MKL's FFTW3 interface), fall back to the - ! FFTW3 threaded 3D transform instead of the hand-optimised version - dim_n(1) = 1 - dim_istride(1) = 1 - dim_ostride(1) = 1 - howmany_n(1) = 1 - howmany_n(2) = 1 - howmany_istride(1) = 1 - howmany_istride(2) = 1 - howmany_ostride(1) = 1 - howmany_ostride(2) = 1 - zin = CMPLX(0.0_dp, 0.0_dp, KIND=dp) - CALL fftw3_create_guru_plan(test_plan,1, & - dim_n,dim_istride,dim_ostride, & - 2,howmany_n,howmany_istride,howmany_ostride, & - zin, zin, & - FFTW_FORWARD, FFTW_ESTIMATE, guru_supported) - IF (guru_supported) THEN - CALL XFFTW_DESTROY_PLAN(test_plan) - is_mkl = .FALSE. - ELSE - is_mkl = .TRUE. - ENDIF + ! Attempt to create a plan with the guru interface for a 2d sub-space + ! If this fails (e.g. for MKL's FFTW3 interface), fall back to the + ! FFTW3 threaded 3D transform instead of the hand-optimised version + dim_n(1) = 1 + dim_istride(1) = 1 + dim_ostride(1) = 1 + howmany_n(1) = 1 + howmany_n(2) = 1 + howmany_istride(1) = 1 + howmany_istride(2) = 1 + howmany_ostride(1) = 1 + howmany_ostride(2) = 1 + zin = CMPLX(0.0_dp, 0.0_dp, KIND=dp) + CALL fftw3_create_guru_plan(test_plan, 1, & + dim_n, dim_istride, dim_ostride, & + 2, howmany_n, howmany_istride, howmany_ostride, & + zin, zin, & + FFTW_FORWARD, FFTW_ESTIMATE, guru_supported) + IF (guru_supported) THEN + CALL XFFTW_DESTROY_PLAN(test_plan) + is_mkl = .FALSE. + ELSE + is_mkl = .TRUE. + ENDIF #else - is_mkl = .FALSE. -#endif + is_mkl = .FALSE. +#endif -END FUNCTION + END FUNCTION ! ************************************************************************************************** @@ -497,27 +492,26 @@ FUNCTION fftw3_is_mkl_wrapper() RESULT(is_mkl) !> \param th_planA ... !> \param th_planB ... ! ************************************************************************************************** -SUBROUTINE fftw3_compute_rows_per_th(nrows,nt,rows_per_thread,rows_per_thread_r,& - th_planA, th_planB) + SUBROUTINE fftw3_compute_rows_per_th(nrows, nt, rows_per_thread, rows_per_thread_r, & + th_planA, th_planB) INTEGER, INTENT(IN) :: nrows, nt INTEGER, INTENT(OUT) :: rows_per_thread, rows_per_thread_r, & th_planA, th_planB - IF (MOD(nrows,nt) .EQ. 0) THEN - rows_per_thread = nrows/nt - rows_per_thread_r = 0 - th_planA = nt - th_planB = 0 - ELSE - rows_per_thread = nrows/nt + 1 - rows_per_thread_r = nrows/nt - th_planA = MOD(nrows,nt) - th_planB = nt - th_planA - ENDIF - -END SUBROUTINE + IF (MOD(nrows, nt) .EQ. 0) THEN + rows_per_thread = nrows/nt + rows_per_thread_r = 0 + th_planA = nt + th_planB = 0 + ELSE + rows_per_thread = nrows/nt + 1 + rows_per_thread_r = nrows/nt + th_planA = MOD(nrows, nt) + th_planB = nt - th_planA + ENDIF + END SUBROUTINE ! ************************************************************************************************** @@ -538,12 +532,11 @@ SUBROUTINE fftw3_compute_rows_per_th(nrows,nt,rows_per_thread,rows_per_thread_r, !> \param rows_per_th ... !> \param rows_per_th_r ... ! ************************************************************************************************** -SUBROUTINE fftw3_create_3d_plans(plan, plan_r, dim_n, dim_istride, dim_ostride, & - hm_n, hm_istride, hm_ostride, & - input, output, & - fft_direction, fftw_plan_type, rows_per_th, & - rows_per_th_r) - + SUBROUTINE fftw3_create_3d_plans(plan, plan_r, dim_n, dim_istride, dim_ostride, & + hm_n, hm_istride, hm_ostride, & + input, output, & + fft_direction, fftw_plan_type, rows_per_th, & + rows_per_th_r) INTEGER(KIND=integer8_kind), INTENT(INOUT) :: plan, plan_r INTEGER, INTENT(INOUT) :: dim_n(2), dim_istride(2), & @@ -557,30 +550,29 @@ SUBROUTINE fftw3_create_3d_plans(plan, plan_r, dim_n, dim_istride, dim_ostride, ! First plans will have an additional row - hm_n(2) = rows_per_th - CALL fftw3_create_guru_plan(plan,1, & - dim_n,dim_istride,dim_ostride, & - 2,hm_n,hm_istride,hm_ostride, & - input, output, & - fft_direction, fftw_plan_type, valid) + hm_n(2) = rows_per_th + CALL fftw3_create_guru_plan(plan, 1, & + dim_n, dim_istride, dim_ostride, & + 2, hm_n, hm_istride, hm_ostride, & + input, output, & + fft_direction, fftw_plan_type, valid) - IF (.NOT. valid) THEN + IF (.NOT. valid) THEN CPABORT("fftw3_create_plan") - ENDIF - - !!!! Remainder - hm_n(2) = rows_per_th_r - CALL fftw3_create_guru_plan(plan_r,1, & - dim_n,dim_istride,dim_ostride, & - 2,hm_n,hm_istride,hm_ostride, & - input, output, & - fft_direction, fftw_plan_type, valid) - IF (.NOT. valid) THEN + ENDIF + + !!!! Remainder + hm_n(2) = rows_per_th_r + CALL fftw3_create_guru_plan(plan_r, 1, & + dim_n, dim_istride, dim_ostride, & + 2, hm_n, hm_istride, hm_ostride, & + input, output, & + fft_direction, fftw_plan_type, valid) + IF (.NOT. valid) THEN CPABORT("fftw3_create_plan (remaining)") - ENDIF + ENDIF - -END SUBROUTINE + END SUBROUTINE ! ************************************************************************************************** @@ -591,179 +583,176 @@ SUBROUTINE fftw3_create_3d_plans(plan, plan_r, dim_n, dim_istride, dim_ostride, !> \param zout ... !> \param plan_style ... ! ************************************************************************************************** -SUBROUTINE fftw3_create_plan_3d(plan, zin, zout, plan_style) + SUBROUTINE fftw3_create_plan_3d(plan, zin, zout, plan_style) - TYPE(fft_plan_type), INTENT ( INOUT ) :: plan - COMPLEX(KIND=dp), DIMENSION(*), INTENT(INOUT) :: zin - COMPLEX(KIND=dp), DIMENSION(*), INTENT(INOUT) :: zout - INTEGER :: plan_style + TYPE(fft_plan_type), INTENT(INOUT) :: plan + COMPLEX(KIND=dp), DIMENSION(*), INTENT(INOUT) :: zin + COMPLEX(KIND=dp), DIMENSION(*), INTENT(INOUT) :: zout + INTEGER :: plan_style #if defined ( __FFTW3 ) - INTEGER :: n1,n2,n3 - INTEGER :: nt - INTEGER :: rows_per_th - INTEGER :: rows_per_th_r - INTEGER :: fft_direction - INTEGER :: th_planA, th_planB - COMPLEX(KIND=dp), ALLOCATABLE :: tmp(:) - - ! GURU Interface - INTEGER :: dim_n(2), dim_istride(2), dim_ostride(2), & - howmany_n(2), howmany_istride(2), howmany_ostride(2) + INTEGER :: n1, n2, n3 + INTEGER :: nt + INTEGER :: rows_per_th + INTEGER :: rows_per_th_r + INTEGER :: fft_direction + INTEGER :: th_planA, th_planB + COMPLEX(KIND=dp), ALLOCATABLE :: tmp(:) + + ! GURU Interface + INTEGER :: dim_n(2), dim_istride(2), dim_ostride(2), & + howmany_n(2), howmany_istride(2), howmany_ostride(2) #include "fftw3.f" - INTEGER :: fftw_plan_type - SELECT CASE(plan_style) - CASE(1) + INTEGER :: fftw_plan_type + SELECT CASE (plan_style) + CASE (1) fftw_plan_type = FFTW_ESTIMATE - CASE(2) + CASE (2) fftw_plan_type = FFTW_MEASURE - CASE(3) + CASE (3) fftw_plan_type = FFTW_PATIENT - CASE(4) + CASE (4) fftw_plan_type = FFTW_EXHAUSTIVE - CASE DEFAULT + CASE DEFAULT CPABORT("fftw3_create_plan_3d") - END SELECT + END SELECT #if defined (__FFTW3_UNALIGNED) - fftw_plan_type = fftw_plan_type + FFTW_UNALIGNED + fftw_plan_type = fftw_plan_type + FFTW_UNALIGNED #endif - IF ( plan%fsign == +1 ) THEN - fft_direction = FFTW_FORWARD - ELSE - fft_direction = FFTW_BACKWARD - END IF + IF (plan%fsign == +1) THEN + fft_direction = FFTW_FORWARD + ELSE + fft_direction = FFTW_BACKWARD + END IF - n1 = plan%n_3d(1) - n2 = plan%n_3d(2) - n3 = plan%n_3d(3) - + n1 = plan%n_3d(1) + n2 = plan%n_3d(2) + n3 = plan%n_3d(3) - nt = 1 + nt = 1 !$OMP PARALLEL DEFAULT(NONE) SHARED(nt) !$OMP MASTER -!$ nt = omp_get_num_threads() +!$ nt = omp_get_num_threads() !$OMP END MASTER !$OMP END PARALLEL - IF ( (fftw3_is_mkl_wrapper()) .OR. & - (.NOT. plan_style == 1 ) .OR. & - (n1 < 256 .AND. n2 < 256 .AND. n3 < 256 .AND. nt== 1)) THEN - ! If the plan type is MEASURE, PATIENT and EXHAUSTIVE or - ! the grid size is small (and we are single-threaded) then - ! FFTW3 does a better job than handmade optimization - ! so plan a single 3D FFT which will execute using all the threads - - plan%separated_plans = .FALSE. -!$ CALL XFFTW_PLAN_WITH_NTHREADS(nt) - - IF ( plan%fft_in_place) THEN - CALL XFFTW_PLAN_DFT_3D(plan%fftw_plan,n1,n2,n3,zin,zin,fft_direction,fftw_plan_type) - ELSE - CALL XFFTW_PLAN_DFT_3D(plan%fftw_plan,n1,n2,n3,zin,zout,fft_direction,fftw_plan_type) - ENDIF - ELSE - ALLOCATE(tmp(n1*n2*n3)) - ! ************************* PLANS WITH TRANSPOSITIONS **************************** - ! In the cases described above, we manually thread each stage of the 3D FFT. - ! - ! The following plans replace the 3D FFT call by running 1D FFTW across all - ! 3 directions of the array. - ! - ! Output of FFTW is transposed to ensure that the next round of FFTW access - ! contiguous information. - ! - ! Assuming the input matrix is M(n3,n2,n1), FFTW/Transp are : - ! M(n3,n2,n1) -> fftw(x) -> M(n3,n1,n2) -> fftw(y) -> M(n1,n2,n3) -> fftw(z) -> M(n1,n2,n3) - ! Notice that last matrix is transposed in the Z axis. A DO-loop in the execute routine - ! will perform the final transposition. Performance evaluation showed that using an external - ! DO loop to do the final transposition performed better than directly transposing the output. - ! However, this might vary depending on the compiler/platform, so a potential tuning spot - ! is to perform the final transposition within the fftw library rather than using the external loop - ! See comments below in Z-FFT for how to tranpose the output to avoid the final DO loop. - ! - ! Doc. for the Guru interface is in http://www.fftw.org/doc/Guru-Interface.html - ! - ! OpenMP : Work is distributed on the Z plane. - ! All transpositions are out-of-place to facilitate multi-threading - ! - !!!! Plan for X : M(n3,n2,n1) -> fftw(x) -> M(n3,n1,n2) - CALL fftw3_compute_rows_per_th(n3, nt, rows_per_th, rows_per_th_r, & - th_planA, th_planB) - - dim_n(1) = n1 - dim_istride(1) = 1 - dim_ostride(1) = n2 - howmany_n(1) = n2 - howmany_n(2) = rows_per_th - howmany_istride(1) = n1 - howmany_istride(2) = n1*n2 - howmany_ostride(1) = 1 - howmany_ostride(2) = n1*n2 - CALL fftw3_create_3d_plans(plan%fftw_plan_nx, plan%fftw_plan_nx_r, & - dim_n, dim_istride, dim_ostride,howmany_n, & - howmany_istride, howmany_ostride, & - zin, tmp, & - fft_direction, fftw_plan_type, rows_per_th, & - rows_per_th_r) - - !!!! Plan for Y : M(n3,n1,n2) -> fftw(y) -> M(n1,n2,n3) - CALL fftw3_compute_rows_per_th(n3, nt, rows_per_th, rows_per_th_r, & - th_planA, th_planB) - dim_n(1) = n2 - dim_istride(1) = 1 - dim_ostride(1) = n3 - howmany_n(1) = n1 - howmany_n(2) = rows_per_th - howmany_istride(1) = n2 - howmany_istride(2) = n1*n2 - !!! transposed Z axis on output - howmany_ostride(1) = n2*n3 - howmany_ostride(2) = 1 - - CALL fftw3_create_3d_plans(plan%fftw_plan_ny, plan%fftw_plan_ny_r, & - dim_n, dim_istride, dim_ostride, & - howmany_n, howmany_istride, howmany_ostride, & - tmp, zin, & - fft_direction, fftw_plan_type, rows_per_th, & - rows_per_th_r) - - !!!! Plan for Z : M(n1,n2,n3) -> fftw(z) -> M(n1,n2,n3) - CALL fftw3_compute_rows_per_th(n1, nt, rows_per_th, rows_per_th_r, & - th_planA, th_planB) - dim_n(1) = n3 - dim_istride(1) = 1 - dim_ostride(1) = 1 ! To transpose: n2*n1 - howmany_n(1) = n2 - howmany_n(2) = rows_per_th - howmany_istride(1) = n3 - howmany_istride(2) = n2*n3 - howmany_ostride(1) = n3 ! To transpose: n1 - howmany_ostride(2) = n2*n3 ! To transpose: 1 - - CALL fftw3_create_3d_plans(plan%fftw_plan_nz, plan%fftw_plan_nz_r, & - dim_n, dim_istride, dim_ostride, & - howmany_n, howmany_istride, howmany_ostride, & - zin, tmp, & - fft_direction, fftw_plan_type, rows_per_th, & - rows_per_th_r) - - plan%separated_plans = .TRUE. - - DEALLOCATE(tmp) - ENDIF + IF ((fftw3_is_mkl_wrapper()) .OR. & + (.NOT. plan_style == 1) .OR. & + (n1 < 256 .AND. n2 < 256 .AND. n3 < 256 .AND. nt == 1)) THEN + ! If the plan type is MEASURE, PATIENT and EXHAUSTIVE or + ! the grid size is small (and we are single-threaded) then + ! FFTW3 does a better job than handmade optimization + ! so plan a single 3D FFT which will execute using all the threads + + plan%separated_plans = .FALSE. +!$ CALL XFFTW_PLAN_WITH_NTHREADS(nt) + IF (plan%fft_in_place) THEN + CALL XFFTW_PLAN_DFT_3D(plan%fftw_plan, n1, n2, n3, zin, zin, fft_direction, fftw_plan_type) + ELSE + CALL XFFTW_PLAN_DFT_3D(plan%fftw_plan, n1, n2, n3, zin, zout, fft_direction, fftw_plan_type) + ENDIF + ELSE + ALLOCATE (tmp(n1*n2*n3)) + ! ************************* PLANS WITH TRANSPOSITIONS **************************** + ! In the cases described above, we manually thread each stage of the 3D FFT. + ! + ! The following plans replace the 3D FFT call by running 1D FFTW across all + ! 3 directions of the array. + ! + ! Output of FFTW is transposed to ensure that the next round of FFTW access + ! contiguous information. + ! + ! Assuming the input matrix is M(n3,n2,n1), FFTW/Transp are : + ! M(n3,n2,n1) -> fftw(x) -> M(n3,n1,n2) -> fftw(y) -> M(n1,n2,n3) -> fftw(z) -> M(n1,n2,n3) + ! Notice that last matrix is transposed in the Z axis. A DO-loop in the execute routine + ! will perform the final transposition. Performance evaluation showed that using an external + ! DO loop to do the final transposition performed better than directly transposing the output. + ! However, this might vary depending on the compiler/platform, so a potential tuning spot + ! is to perform the final transposition within the fftw library rather than using the external loop + ! See comments below in Z-FFT for how to tranpose the output to avoid the final DO loop. + ! + ! Doc. for the Guru interface is in http://www.fftw.org/doc/Guru-Interface.html + ! + ! OpenMP : Work is distributed on the Z plane. + ! All transpositions are out-of-place to facilitate multi-threading + ! + !!!! Plan for X : M(n3,n2,n1) -> fftw(x) -> M(n3,n1,n2) + CALL fftw3_compute_rows_per_th(n3, nt, rows_per_th, rows_per_th_r, & + th_planA, th_planB) + + dim_n(1) = n1 + dim_istride(1) = 1 + dim_ostride(1) = n2 + howmany_n(1) = n2 + howmany_n(2) = rows_per_th + howmany_istride(1) = n1 + howmany_istride(2) = n1*n2 + howmany_ostride(1) = 1 + howmany_ostride(2) = n1*n2 + CALL fftw3_create_3d_plans(plan%fftw_plan_nx, plan%fftw_plan_nx_r, & + dim_n, dim_istride, dim_ostride, howmany_n, & + howmany_istride, howmany_ostride, & + zin, tmp, & + fft_direction, fftw_plan_type, rows_per_th, & + rows_per_th_r) + + !!!! Plan for Y : M(n3,n1,n2) -> fftw(y) -> M(n1,n2,n3) + CALL fftw3_compute_rows_per_th(n3, nt, rows_per_th, rows_per_th_r, & + th_planA, th_planB) + dim_n(1) = n2 + dim_istride(1) = 1 + dim_ostride(1) = n3 + howmany_n(1) = n1 + howmany_n(2) = rows_per_th + howmany_istride(1) = n2 + howmany_istride(2) = n1*n2 + !!! transposed Z axis on output + howmany_ostride(1) = n2*n3 + howmany_ostride(2) = 1 + + CALL fftw3_create_3d_plans(plan%fftw_plan_ny, plan%fftw_plan_ny_r, & + dim_n, dim_istride, dim_ostride, & + howmany_n, howmany_istride, howmany_ostride, & + tmp, zin, & + fft_direction, fftw_plan_type, rows_per_th, & + rows_per_th_r) + + !!!! Plan for Z : M(n1,n2,n3) -> fftw(z) -> M(n1,n2,n3) + CALL fftw3_compute_rows_per_th(n1, nt, rows_per_th, rows_per_th_r, & + th_planA, th_planB) + dim_n(1) = n3 + dim_istride(1) = 1 + dim_ostride(1) = 1 ! To transpose: n2*n1 + howmany_n(1) = n2 + howmany_n(2) = rows_per_th + howmany_istride(1) = n3 + howmany_istride(2) = n2*n3 + howmany_ostride(1) = n3 ! To transpose: n1 + howmany_ostride(2) = n2*n3 ! To transpose: 1 + + CALL fftw3_create_3d_plans(plan%fftw_plan_nz, plan%fftw_plan_nz_r, & + dim_n, dim_istride, dim_ostride, & + howmany_n, howmany_istride, howmany_ostride, & + zin, tmp, & + fft_direction, fftw_plan_type, rows_per_th, & + rows_per_th_r) + + plan%separated_plans = .TRUE. + + DEALLOCATE (tmp) + ENDIF #else - MARK_USED(plan) - MARK_USED(plan_style) - !MARK_USED does not work with assumed size arguments - IF(.FALSE.)THEN; DO; IF(ABS(zin(1))>ABS(zout(1)))EXIT; ENDDO; ENDIF + MARK_USED(plan) + MARK_USED(plan_style) + !MARK_USED does not work with assumed size arguments + IF (.FALSE.) THEN; DO; IF (ABS(zin(1)) > ABS(zout(1))) EXIT; ENDDO; ENDIF #endif -END SUBROUTINE fftw3_create_plan_3d - + END SUBROUTINE fftw3_create_plan_3d ! ************************************************************************************************** @@ -779,63 +768,62 @@ END SUBROUTINE fftw3_create_plan_3d !> \param output ... !> \param ostride ... ! ************************************************************************************************** -SUBROUTINE fftw3_workshare_execute_dft(plan, plan_r, split_dim, nt, tid, & - input, istride, output, ostride) + SUBROUTINE fftw3_workshare_execute_dft(plan, plan_r, split_dim, nt, tid, & + input, istride, output, ostride) - INTEGER, INTENT(IN) :: split_dim,nt, tid - INTEGER, INTENT(IN) :: istride, ostride - COMPLEX(KIND=dp), DIMENSION(*), INTENT(INOUT) :: input, output - INTEGER (KIND=integer8_kind) :: plan, plan_r + INTEGER, INTENT(IN) :: split_dim, nt, tid + INTEGER, INTENT(IN) :: istride, ostride + COMPLEX(KIND=dp), DIMENSION(*), INTENT(INOUT) :: input, output + INTEGER(KIND=integer8_kind) :: plan, plan_r #if defined (__FFTW3) - INTEGER :: i_off, o_off - INTEGER :: th_planA, th_planB - INTEGER :: rows_per_thread, rows_per_thread_r + INTEGER :: i_off, o_off + INTEGER :: th_planA, th_planB + INTEGER :: rows_per_thread, rows_per_thread_r CALL fftw3_compute_rows_per_th(split_dim, nt, rows_per_thread, & rows_per_thread_r, & th_planA, th_planB) - - IF (th_planB .GT. 0) THEN - IF (tid .LT. th_planA) THEN - i_off = (tid) * (istride*(rows_per_thread)) + 1 - o_off = (tid) * (ostride*(rows_per_thread)) + 1 - IF (rows_per_thread .GT. 0) THEN - CALL XFFTW_EXECUTE_DFT(plan, input(i_off), & - output(o_off)) - ENDIF - ELSE IF ((tid - th_planA) < th_planB) THEN - - i_off = (th_planA)*istride*(rows_per_thread) + & - (tid-th_planA)*istride*(rows_per_thread_r) + 1 - o_off = (th_planA)*ostride*(rows_per_thread) + & - (tid-th_planA)*ostride*(rows_per_thread_r) + 1 - CALL XFFTW_EXECUTE_DFT(plan_r, input(i_off), & - output(o_off)) - ENDIF + IF (th_planB .GT. 0) THEN + IF (tid .LT. th_planA) THEN + i_off = (tid)*(istride*(rows_per_thread)) + 1 + o_off = (tid)*(ostride*(rows_per_thread)) + 1 + IF (rows_per_thread .GT. 0) THEN + CALL XFFTW_EXECUTE_DFT(plan, input(i_off), & + output(o_off)) + ENDIF + ELSE IF ((tid - th_planA) < th_planB) THEN + + i_off = (th_planA)*istride*(rows_per_thread) + & + (tid - th_planA)*istride*(rows_per_thread_r) + 1 + o_off = (th_planA)*ostride*(rows_per_thread) + & + (tid - th_planA)*ostride*(rows_per_thread_r) + 1 + + CALL XFFTW_EXECUTE_DFT(plan_r, input(i_off), & + output(o_off)) + ENDIF ELSE - i_off = (tid) * (istride*(rows_per_thread)) + 1 - o_off = (tid) * (ostride*(rows_per_thread)) + 1 + i_off = (tid)*(istride*(rows_per_thread)) + 1 + o_off = (tid)*(ostride*(rows_per_thread)) + 1 CALL XFFTW_EXECUTE_DFT(plan, input(i_off), & - output(o_off)) + output(o_off)) - ENDIF + ENDIF #else - MARK_USED(plan) - MARK_USED(plan_r) - MARK_USED(split_dim) - MARK_USED(nt) - MARK_USED(tid) - MARK_USED(istride) - MARK_USED(ostride) - !MARK_USED does not work with assumed size arguments - IF(.FALSE.)THEN; DO; IF(ABS(input(1))>ABS(output(1)))EXIT; ENDDO; ENDIF + MARK_USED(plan) + MARK_USED(plan_r) + MARK_USED(split_dim) + MARK_USED(nt) + MARK_USED(tid) + MARK_USED(istride) + MARK_USED(ostride) + !MARK_USED does not work with assumed size arguments + IF (.FALSE.) THEN; DO; IF (ABS(input(1)) > ABS(output(1))) EXIT; ENDDO; ENDIF #endif -END SUBROUTINE - + END SUBROUTINE ! ************************************************************************************************** @@ -847,93 +835,91 @@ SUBROUTINE fftw3_workshare_execute_dft(plan, plan_r, split_dim, nt, tid, & !> \param zout ... !> \param stat ... ! ************************************************************************************************** -SUBROUTINE fftw33d ( plan, scale, zin, zout, stat ) + SUBROUTINE fftw33d(plan, scale, zin, zout, stat) - TYPE(fft_plan_type), INTENT(IN) :: plan - REAL(KIND=dp), INTENT(IN) :: scale - COMPLEX(KIND=dp), DIMENSION(*), INTENT(INOUT), TARGET:: zin - COMPLEX(KIND=dp), DIMENSION(*), INTENT(INOUT), TARGET:: zout - INTEGER, INTENT(OUT) :: stat + TYPE(fft_plan_type), INTENT(IN) :: plan + REAL(KIND=dp), INTENT(IN) :: scale + COMPLEX(KIND=dp), DIMENSION(*), INTENT(INOUT), TARGET:: zin + COMPLEX(KIND=dp), DIMENSION(*), INTENT(INOUT), TARGET:: zout + INTEGER, INTENT(OUT) :: stat #if defined ( __FFTW3 ) - COMPLEX(KIND=dp), POINTER :: xout(:) - COMPLEX(KIND=dp), ALLOCATABLE :: tmp1(:) - INTEGER :: n1, n2, n3 - INTEGER :: tid, nt - INTEGER :: i,j,k + COMPLEX(KIND=dp), POINTER :: xout(:) + COMPLEX(KIND=dp), ALLOCATABLE :: tmp1(:) + INTEGER :: n1, n2, n3 + INTEGER :: tid, nt + INTEGER :: i, j, k !------------------------------------------------------------------------------ - #include "fftw3.f" - n1 = plan%n_3d(1) - n2 = plan%n_3d(2) - n3 = plan%n_3d(3) - - stat = 1 - - ! We use a POINTER to the output array to avoid duplicating code - IF (plan%fft_in_place) THEN - xout => zin(:n1*n2*n3) - ELSE - xout => zout(:n1*n2*n3) - ENDIF - - ! Either compute the full 3D FFT using a multithreaded plan - IF (.NOT. plan%separated_plans) THEN - CALL XFFTW_EXECUTE_DFT(plan%fftw_plan,zin,xout) - ELSE - ! Or use the 3 stage FFT scheme described in fftw3_create_plan_3d - ALLOCATE(tmp1(n1*n2*n3)) ! Temporary vector used for transpositions - !$OMP PARALLEL DEFAULT(NONE) PRIVATE(tid,nt,i,j,k) SHARED(zin,tmp1,n1,n2,n3,plan,xout) - tid = 0 - nt = 1 - -!$ tid = omp_get_thread_num() -!$ nt = omp_get_num_threads() - CALL fftw3_workshare_execute_dft(plan%fftw_plan_nx, plan%fftw_plan_nx_r, & - n3,nt, tid,& - zin, n1*n2, tmp1, n1*n2) - - !$OMP BARRIER - CALL fftw3_workshare_execute_dft(plan%fftw_plan_ny, plan%fftw_plan_ny_r, & - n3,nt, tid,& - tmp1, n1*n2, xout, 1) - !$OMP BARRIER - CALL fftw3_workshare_execute_dft(plan%fftw_plan_nz, plan%fftw_plan_nz_r, & - n1,nt, tid,& - xout, n2*n3, tmp1, n2*n3) - !$OMP BARRIER - - !$OMP DO COLLAPSE(3) - DO i = 1,n1 - DO j = 1,n2 - DO k = 1,n3 - xout((i-1) + (j-1) * n1 + (k-1) * n1 * n2 + 1) = & - tmp1((k-1) + (j-1) * n3 + (i-1) * n3 * n2 + 1) - ENDDO - ENDDO - ENDDO - !$OMP END DO + n1 = plan%n_3d(1) + n2 = plan%n_3d(2) + n3 = plan%n_3d(3) - !$OMP END PARALLEL - END IF + stat = 1 + ! We use a POINTER to the output array to avoid duplicating code + IF (plan%fft_in_place) THEN + xout => zin(:n1*n2*n3) + ELSE + xout => zout(:n1*n2*n3) + ENDIF - IF ( scale /= 1.0_dp ) THEN - CALL zdscal(n1*n2*n3,scale,xout,1) - END IF + ! Either compute the full 3D FFT using a multithreaded plan + IF (.NOT. plan%separated_plans) THEN + CALL XFFTW_EXECUTE_DFT(plan%fftw_plan, zin, xout) + ELSE + ! Or use the 3 stage FFT scheme described in fftw3_create_plan_3d + ALLOCATE (tmp1(n1*n2*n3)) ! Temporary vector used for transpositions + !$OMP PARALLEL DEFAULT(NONE) PRIVATE(tid,nt,i,j,k) SHARED(zin,tmp1,n1,n2,n3,plan,xout) + tid = 0 + nt = 1 + +!$ tid = omp_get_thread_num() +!$ nt = omp_get_num_threads() + CALL fftw3_workshare_execute_dft(plan%fftw_plan_nx, plan%fftw_plan_nx_r, & + n3, nt, tid, & + zin, n1*n2, tmp1, n1*n2) + + !$OMP BARRIER + CALL fftw3_workshare_execute_dft(plan%fftw_plan_ny, plan%fftw_plan_ny_r, & + n3, nt, tid, & + tmp1, n1*n2, xout, 1) + !$OMP BARRIER + CALL fftw3_workshare_execute_dft(plan%fftw_plan_nz, plan%fftw_plan_nz_r, & + n1, nt, tid, & + xout, n2*n3, tmp1, n2*n3) + !$OMP BARRIER + + !$OMP DO COLLAPSE(3) + DO i = 1, n1 + DO j = 1, n2 + DO k = 1, n3 + xout((i - 1) + (j - 1)*n1 + (k - 1)*n1*n2 + 1) = & + tmp1((k - 1) + (j - 1)*n3 + (i - 1)*n3*n2 + 1) + ENDDO + ENDDO + ENDDO + !$OMP END DO + + !$OMP END PARALLEL + END IF + + IF (scale /= 1.0_dp) THEN + CALL zdscal(n1*n2*n3, scale, xout, 1) + END IF #else - MARK_USED(plan) - MARK_USED(scale) - !MARK_USED does not work with assumed size arguments - IF(.FALSE.)THEN; DO; IF(ABS(zin(1))>ABS(zout(1)))EXIT; ENDDO; ENDIF - stat = 0 + MARK_USED(plan) + MARK_USED(scale) + !MARK_USED does not work with assumed size arguments + IF (.FALSE.) THEN; DO; IF (ABS(zin(1)) > ABS(zout(1))) EXIT; ENDDO; ENDIF + stat = 0 #endif -END SUBROUTINE fftw33d + END SUBROUTINE fftw33d ! ************************************************************************************************** @@ -944,130 +930,130 @@ END SUBROUTINE fftw33d !> \param zout ... !> \param plan_style ... ! ************************************************************************************************** -SUBROUTINE fftw3_create_plan_1dm(plan, zin, zout, plan_style) + SUBROUTINE fftw3_create_plan_1dm(plan, zin, zout, plan_style) - IMPLICIT NONE + IMPLICIT NONE - TYPE(fft_plan_type), INTENT ( INOUT ) :: plan - COMPLEX(KIND=dp), DIMENSION(*), INTENT(IN) :: zin - COMPLEX(KIND=dp), DIMENSION(*), INTENT(IN) :: zout - INTEGER, INTENT(IN) :: plan_style + TYPE(fft_plan_type), INTENT(INOUT) :: plan + COMPLEX(KIND=dp), DIMENSION(*), INTENT(IN) :: zin + COMPLEX(KIND=dp), DIMENSION(*), INTENT(IN) :: zout + INTEGER, INTENT(IN) :: plan_style #if defined ( __FFTW3 ) - INTEGER :: ii,di,io,DO, num_threads, num_rows + INTEGER :: ii, di, io, DO, num_threads, num_rows #include "fftw3.f" - INTEGER :: fftw_plan_type - SELECT CASE(plan_style) - CASE(1) + INTEGER :: fftw_plan_type + SELECT CASE (plan_style) + CASE (1) fftw_plan_type = FFTW_ESTIMATE - CASE(2) + CASE (2) fftw_plan_type = FFTW_MEASURE - CASE(3) + CASE (3) fftw_plan_type = FFTW_PATIENT - CASE(4) + CASE (4) fftw_plan_type = FFTW_EXHAUSTIVE - CASE DEFAULT + CASE DEFAULT CPABORT("fftw3_create_plan_1dm") - END SELECT + END SELECT #if defined (__FFTW3_UNALIGNED) - fftw_plan_type = fftw_plan_type + FFTW_UNALIGNED + fftw_plan_type = fftw_plan_type + FFTW_UNALIGNED #endif -num_threads = 1 -plan%separated_plans = .FALSE. + num_threads = 1 + plan%separated_plans = .FALSE. !$OMP PARALLEL DEFAULT(NONE), & !$OMP SHARED(NUM_THREADS) !$OMP MASTER -!$ num_threads = omp_get_num_threads() +!$ num_threads = omp_get_num_threads() !$OMP END MASTER !$OMP END PARALLEL -num_rows = plan%m / num_threads -!$ plan%num_threads_needed = num_threads + num_rows = plan%m/num_threads +!$ plan%num_threads_needed = num_threads ! Check for number of rows less than num_threads -!$ IF (plan%m < num_threads) THEN -!$ num_rows = 1 -!$ plan%num_threads_needed = plan%m -!$ ENDIF +!$ IF (plan%m < num_threads) THEN +!$ num_rows = 1 +!$ plan%num_threads_needed = plan%m +!$ ENDIF ! Check for total number of rows not divisible by num_threads -!$ IF (num_rows*plan%num_threads_needed .NE. plan%m) THEN -!$ plan%need_alt_plan = .TRUE. -!$ ENDIF - -!$ plan%num_rows = num_rows - ii = 1 - di = plan%n - io = 1 - DO = plan%n - IF ( plan%fsign == +1 .AND. plan%trans ) THEN - ii = plan%m - di = 1 - ELSEIF ( plan%fsign == -1 .AND. plan%trans ) THEN - io = plan%m - DO = 1 - END IF - - IF ( plan%fsign == +1 ) THEN - CALL dfftw_plan_many_dft(plan%fftw_plan,1,plan%n,num_rows,zin,0,ii,di,& - zout,0,io,DO,FFTW_FORWARD,fftw_plan_type) - ELSE - CALL dfftw_plan_many_dft(plan%fftw_plan,1,plan%n,num_rows,zin,0,ii,di,& - zout,0,io,DO,FFTW_BACKWARD,fftw_plan_type) - END IF - -!$ IF (plan%need_alt_plan) THEN -!$ plan%alt_num_rows = plan%m - (plan%num_threads_needed - 1)*num_rows -!$ IF ( plan%fsign == +1 ) THEN -!$ CALL dfftw_plan_many_dft(plan%alt_fftw_plan,1,plan%n,plan%alt_num_rows,zin,0,ii,di,& -!$ zout,0,io,DO,FFTW_FORWARD,fftw_plan_type) -!$ ELSE -!$ CALL dfftw_plan_many_dft(plan%alt_fftw_plan,1,plan%n,plan%alt_num_rows,zin,0,ii,di,& -!$ zout,0,io,DO,FFTW_BACKWARD,fftw_plan_type) -!$ END IF -!$ END IF +!$ IF (num_rows*plan%num_threads_needed .NE. plan%m) THEN +!$ plan%need_alt_plan = .TRUE. +!$ ENDIF + +!$ plan%num_rows = num_rows + ii = 1 + di = plan%n + io = 1 + DO = plan%n + IF (plan%fsign == +1 .AND. plan%trans) THEN + ii = plan%m + di = 1 + ELSEIF (plan%fsign == -1 .AND. plan%trans) THEN + io = plan%m + DO = 1 + END IF + + IF (plan%fsign == +1) THEN + CALL dfftw_plan_many_dft(plan%fftw_plan, 1, plan%n, num_rows, zin, 0, ii, di, & + zout, 0, io, DO, FFTW_FORWARD, fftw_plan_type) + ELSE + CALL dfftw_plan_many_dft(plan%fftw_plan, 1, plan%n, num_rows, zin, 0, ii, di, & + zout, 0, io, DO, FFTW_BACKWARD, fftw_plan_type) + END IF + +!$ IF (plan%need_alt_plan) THEN +!$ plan%alt_num_rows = plan%m - (plan%num_threads_needed - 1)*num_rows +!$ IF (plan%fsign == +1) THEN +!$ CALL dfftw_plan_many_dft(plan%alt_fftw_plan, 1, plan%n, plan%alt_num_rows, zin, 0, ii, di, & +!$ zout, 0, io, DO, FFTW_FORWARD, fftw_plan_type) +!$ ELSE +!$ CALL dfftw_plan_many_dft(plan%alt_fftw_plan, 1, plan%n, plan%alt_num_rows, zin, 0, ii, di, & +!$ zout, 0, io, DO, FFTW_BACKWARD, fftw_plan_type) +!$ END IF +!$ END IF #else - MARK_USED(plan) - MARK_USED(plan_style) - !MARK_USED does not work with assumed size arguments - IF(.FALSE.)THEN; DO; IF(ABS(zin(1))>ABS(zout(1)))EXIT; ENDDO; ENDIF + MARK_USED(plan) + MARK_USED(plan_style) + !MARK_USED does not work with assumed size arguments + IF (.FALSE.) THEN; DO; IF (ABS(zin(1)) > ABS(zout(1))) EXIT; ENDDO; ENDIF #endif -END SUBROUTINE fftw3_create_plan_1dm + END SUBROUTINE fftw3_create_plan_1dm ! ************************************************************************************************** !> \brief ... !> \param plan ... ! ************************************************************************************************** -SUBROUTINE fftw3_destroy_plan ( plan ) + SUBROUTINE fftw3_destroy_plan(plan) - TYPE(fft_plan_type), INTENT (INOUT) :: plan + TYPE(fft_plan_type), INTENT(INOUT) :: plan #if defined ( __FFTW3 ) -!$ IF (plan%need_alt_plan) THEN -!$ CALL XFFTW_DESTROY_PLAN(plan%alt_fftw_plan) -!$ END IF - - IF (.NOT. plan%separated_plans) THEN - CALL XFFTW_DESTROY_PLAN(plan%fftw_plan) - ELSE - ! If it is a separated plan then we have to destroy - ! each dim plan individually - CALL XFFTW_DESTROY_PLAN(plan%fftw_plan_nx) - CALL XFFTW_DESTROY_PLAN(plan%fftw_plan_ny) - CALL XFFTW_DESTROY_PLAN(plan%fftw_plan_nz) - CALL XFFTW_DESTROY_PLAN(plan%fftw_plan_nx_r) - CALL XFFTW_DESTROY_PLAN(plan%fftw_plan_ny_r) - CALL XFFTW_DESTROY_PLAN(plan%fftw_plan_nz_r) - ENDIF +!$ IF (plan%need_alt_plan) THEN +!$ CALL XFFTW_DESTROY_PLAN(plan%alt_fftw_plan) +!$ END IF + + IF (.NOT. plan%separated_plans) THEN + CALL XFFTW_DESTROY_PLAN(plan%fftw_plan) + ELSE + ! If it is a separated plan then we have to destroy + ! each dim plan individually + CALL XFFTW_DESTROY_PLAN(plan%fftw_plan_nx) + CALL XFFTW_DESTROY_PLAN(plan%fftw_plan_ny) + CALL XFFTW_DESTROY_PLAN(plan%fftw_plan_nz) + CALL XFFTW_DESTROY_PLAN(plan%fftw_plan_nx_r) + CALL XFFTW_DESTROY_PLAN(plan%fftw_plan_ny_r) + CALL XFFTW_DESTROY_PLAN(plan%fftw_plan_nz_r) + ENDIF #else - MARK_USED(plan) + MARK_USED(plan) #endif -END SUBROUTINE fftw3_destroy_plan + END SUBROUTINE fftw3_destroy_plan ! ************************************************************************************************** !> \brief ... @@ -1077,7 +1063,7 @@ END SUBROUTINE fftw3_destroy_plan !> \param scale ... !> \param stat ... ! ************************************************************************************************** -SUBROUTINE fftw31dm ( plan, zin, zout, scale, stat ) + SUBROUTINE fftw31dm(plan, zin, zout, scale, stat) TYPE(fft_plan_type), INTENT(IN) :: plan COMPLEX(KIND=dp), DIMENSION(*), INTENT(IN), TARGET :: zin COMPLEX(KIND=dp), DIMENSION(*), INTENT(INOUT), & @@ -1092,69 +1078,69 @@ SUBROUTINE fftw31dm ( plan, zin, zout, scale, stat ) !------------------------------------------------------------------------------ -my_id = 0 -num_rows = plan%m + my_id = 0 + num_rows = plan%m !$OMP PARALLEL DEFAULT(NONE), & !$OMP PRIVATE(my_id,num_rows,zin_ptr,zout_ptr,zscal_ptr,in_offset,out_offset,scal_offset,fftw_plan), & !$OMP SHARED(zin,zout), & !$OMP SHARED(plan,scale,stat) -!$ my_id = omp_get_thread_num() - -!$ if (my_id < plan%num_threads_needed) then - -fftw_plan = plan%fftw_plan - -in_offset = 1 -out_offset = 1 -scal_offset = 1 - -!$ in_offset = 1 + plan%num_rows * my_id * plan%n -!$ out_offset = 1 + plan%num_rows * my_id * plan%n -!$ IF ( plan%fsign == +1 .AND. plan%trans ) THEN -!$ in_offset = 1 + plan%num_rows*my_id -!$ ELSEIF ( plan%fsign == -1 .AND. plan%trans ) THEN -!$ out_offset = 1 + plan%num_rows*my_id -!$ ENDIF -!$ scal_offset = 1 + plan%n*plan%num_rows*my_id -!$ IF ( plan%need_alt_plan .AND. my_id .EQ. plan%num_threads_needed - 1 ) THEN -!$ num_rows = plan%alt_num_rows -!$ fftw_plan = plan%alt_fftw_plan -!$ ELSE -!$ num_rows = plan%num_rows -!$ ENDIF - -zin_ptr => zin(in_offset) -zout_ptr => zout(out_offset) -zscal_ptr => zout(scal_offset) +!$ my_id = omp_get_thread_num() + +!$ if (my_id < plan%num_threads_needed) then + + fftw_plan = plan%fftw_plan + + in_offset = 1 + out_offset = 1 + scal_offset = 1 + +!$ in_offset = 1 + plan%num_rows*my_id*plan%n +!$ out_offset = 1 + plan%num_rows*my_id*plan%n +!$ IF (plan%fsign == +1 .AND. plan%trans) THEN +!$ in_offset = 1 + plan%num_rows*my_id +!$ ELSEIF (plan%fsign == -1 .AND. plan%trans) THEN +!$ out_offset = 1 + plan%num_rows*my_id +!$ ENDIF +!$ scal_offset = 1 + plan%n*plan%num_rows*my_id +!$ IF (plan%need_alt_plan .AND. my_id .EQ. plan%num_threads_needed - 1) THEN +!$ num_rows = plan%alt_num_rows +!$ fftw_plan = plan%alt_fftw_plan +!$ ELSE +!$ num_rows = plan%num_rows +!$ ENDIF + + zin_ptr => zin(in_offset) + zout_ptr => zout(out_offset) + zscal_ptr => zout(scal_offset) #if defined ( __FFTW3 ) !$OMP MASTER - stat=1 + stat = 1 !$OMP END MASTER - CALL dfftw_execute_dft(fftw_plan, zin_ptr, zout_ptr) -!$ endif + CALL dfftw_execute_dft(fftw_plan, zin_ptr, zout_ptr) +!$ endif ! all theads need to meet at this barrier !$OMP BARRIER -!$ if (my_id < plan%num_threads_needed) then - IF ( scale /= 1.0_dp ) CALL zdscal(plan%n*num_rows,scale,zscal_ptr,1) -!$ endif +!$ if (my_id < plan%num_threads_needed) then + IF (scale /= 1.0_dp) CALL zdscal(plan%n*num_rows, scale, zscal_ptr, 1) +!$ endif #else - MARK_USED(plan) - MARK_USED(scale) - !MARK_USED does not work with assumed size arguments - IF(.FALSE.)THEN; DO; IF(ABS(zin(1))>ABS(zout(1)))EXIT; ENDDO; ENDIF - stat=0 + MARK_USED(plan) + MARK_USED(scale) + !MARK_USED does not work with assumed size arguments + IF (.FALSE.) THEN; DO; IF (ABS(zin(1)) > ABS(zout(1))) EXIT; ENDDO; ENDIF + stat = 0 -!$ else -!$ end if +!$ else +!$ end if #endif !$OMP END PARALLEL -END SUBROUTINE fftw31dm + END SUBROUTINE fftw31dm ! Copyright (c) 2003, 2006 Matteo Frigo ! Copyright (c) 2003, 2006 Massachusetts Institute of Technology @@ -1197,7 +1183,7 @@ SUBROUTINE fftw_write_char(c, iunit) BIND(C, name="fftw_write_char") CHARACTER(KIND=C_CHAR) :: c INTEGER(KIND=C_INT) :: iunit - WRITE(iunit,'(a)',ADVANCE="NO") c + WRITE (iunit, '(a)', ADVANCE="NO") c END SUBROUTINE ! ************************************************************************************************** @@ -1205,12 +1191,12 @@ SUBROUTINE fftw_write_char(c, iunit) BIND(C, name="fftw_write_char") !> \param iunit ... ! ************************************************************************************************** SUBROUTINE fftw_export_wisdom_to_file(iunit) - INTEGER :: iunit + INTEGER :: iunit #if defined ( __FFTW3 ) CALL dfftw_export_wisdom(fftw_write_char, iunit) #else - MARK_USED(iunit) + MARK_USED(iunit) #endif END SUBROUTINE @@ -1241,13 +1227,13 @@ SUBROUTINE fftw_read_char(ic, iunit) BIND(C, name="fftw_read_char") ibuf = ibuf + 1 RETURN ENDIF - READ(iunit,123,END=666) buf + READ (iunit, 123, END=666) buf ic = ICHAR(buf(1:1)) ibuf = 2 RETURN - 666 ic = -1 +666 ic = -1 ibuf = 257 - 123 FORMAT(a256) +123 FORMAT(a256) END SUBROUTINE ! ************************************************************************************************** @@ -1258,13 +1244,13 @@ SUBROUTINE fftw_read_char(ic, iunit) BIND(C, name="fftw_read_char") SUBROUTINE fftw_import_wisdom_from_file(isuccess, iunit) INTEGER :: isuccess, iunit - isuccess=0 + isuccess = 0 #if defined ( __FFTW3 ) CALL dfftw_import_wisdom(isuccess, fftw_read_char, iunit) #else - MARK_USED(iunit) + MARK_USED(iunit) #endif END SUBROUTINE -END MODULE + END MODULE diff --git a/src/pw/fft/mltfftsg_tools.F b/src/pw/fft/mltfftsg_tools.F index 876a310316..de1669fcd4 100644 --- a/src/pw/fft/mltfftsg_tools.F +++ b/src/pw/fft/mltfftsg_tools.F @@ -55,13 +55,13 @@ SUBROUTINE mltfftsg(transa, transb, a, ldax, lday, b, ldbx, ldby, n, m, isign, s ! Variables - LENGTH = 2*(cache_size/4+1) + LENGTH = 2*(cache_size/4 + 1) ISIG = -ISIGN - TSCAL = (ABS(SCALE-1._dp) > 1.e-12_dp) + TSCAL = (ABS(SCALE - 1._dp) > 1.e-12_dp) CALL ctrig(N, TRIG, AFTER, BEFORE, NOW, ISIG, IC) LOT = cache_size/(4*N) - LOT = LOT-MOD(LOT+1, 2) + LOT = LOT - MOD(LOT + 1, 2) LOT = MAX(1, LOT) ! initializations for serial mode @@ -74,19 +74,19 @@ SUBROUTINE mltfftsg(transa, transb, a, ldax, lday, b, ldbx, ldby, n, m, isign, s !$OMP SINGLE !$ num_threads = omp_get_num_threads() - ALLOCATE (Z(LENGTH, 2, 0:num_threads-1)) - iterations = (M+LOT-1)/LOT - chunk = LOT*((iterations+num_threads-1)/num_threads) + ALLOCATE (Z(LENGTH, 2, 0:num_threads - 1)) + iterations = (M + LOT - 1)/LOT + chunk = LOT*((iterations + num_threads - 1)/num_threads) !$OMP END SINGLE !$OMP BARRIER !$ id = omp_get_thread_num() - istart = id*chunk+1 - iend = MIN((id+1)*chunk, M) + istart = id*chunk + 1 + iend = MIN((id + 1)*chunk, M) DO ITR = istart, iend, LOT - NFFT = MIN(M-ITR+1, LOT) + NFFT = MIN(M - ITR + 1, LOT) IF (TRANSA == 'N' .OR. TRANSA == 'n') THEN CALL fftpre_cmplx(NFFT, NFFT, LDAX, LOT, N, A(1, ITR), Z(1, 1, id), & TRIG, NOW(1), AFTER(1), BEFORE(1), ISIG) @@ -99,7 +99,7 @@ SUBROUTINE mltfftsg(transa, transb, a, ldax, lday, b, ldbx, ldby, n, m, isign, s CALL scaled(2*LOT*N, SCALE, Z(1, 1, id)) ELSE DO I = 1, N - CALL scaled(2*NFFT, SCALE, Z(LOT*(I-1)+1, 1, id)) + CALL scaled(2*NFFT, SCALE, Z(LOT*(I - 1) + 1, 1, id)) END DO END IF END IF @@ -111,11 +111,11 @@ SUBROUTINE mltfftsg(transa, transb, a, ldax, lday, b, ldbx, ldby, n, m, isign, s ENDIF ELSE INZEE = 1 - DO I = 2, IC-1 + DO I = 2, IC - 1 CALL fftstp_cmplx(LOT, NFFT, N, LOT, N, Z(1, INZEE, id), & - Z(1, 3-INZEE, id), TRIG, NOW(I), AFTER(I), & + Z(1, 3 - INZEE, id), TRIG, NOW(I), AFTER(I), & BEFORE(I), ISIG) - INZEE = 3-INZEE + INZEE = 3 - INZEE ENDDO IF (TRANSB == 'N' .OR. TRANSB == 'n') THEN CALL fftrot_cmplx(LOT, NFFT, N, NFFT, LDBX, Z(1, INZEE, id), & @@ -132,11 +132,11 @@ SUBROUTINE mltfftsg(transa, transb, a, ldax, lday, b, ldbx, ldby, n, m, isign, s DEALLOCATE (Z) IF (TRANSB == 'N' .OR. TRANSB == 'n') THEN - B(1:LDBX, M+1:LDBY) = CMPLX(0._dp, 0._dp, dp) - B(N+1:LDBX, 1:M) = CMPLX(0._dp, 0._dp, dp) + B(1:LDBX, M + 1:LDBY) = CMPLX(0._dp, 0._dp, dp) + B(N + 1:LDBX, 1:M) = CMPLX(0._dp, 0._dp, dp) ELSE - B(1:LDBX, N+1:LDBY) = CMPLX(0._dp, 0._dp, dp) - B(M+1:LDBX, 1:N) = CMPLX(0._dp, 0._dp, dp) + B(1:LDBX, N + 1:LDBY) = CMPLX(0._dp, 0._dp, dp) + B(M + 1:LDBX, 1:N) = CMPLX(0._dp, 0._dp, dp) ENDIF END SUBROUTINE mltfftsg @@ -302,17 +302,17 @@ SUBROUTINE fftrot(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign IF (now == 4) THEN IF (isign == 1) THEN ia = 1 - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) @@ -322,139 +322,139 @@ SUBROUTINE fftrot(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s3 = zin(2, j, nin3) r4 = zin(1, j, nin4) s4 = zin(2, j, nin4) - r = r1+r3 - s = r2+r4 - zout(1, nout1, j) = r+s - zout(1, nout3, j) = r-s - r = r1-r3 - s = s2-s4 - zout(1, nout2, j) = r-s - zout(1, nout4, j) = r+s - r = s1+s3 - s = s2+s4 - zout(2, nout1, j) = r+s - zout(2, nout3, j) = r-s - r = s1-s3 - s = r2-r4 - zout(2, nout2, j) = r+s - zout(2, nout4, j) = r-s + r = r1 + r3 + s = r2 + r4 + zout(1, nout1, j) = r + s + zout(1, nout3, j) = r - s + r = r1 - r3 + s = s2 - s4 + zout(1, nout2, j) = r - s + zout(1, nout4, j) = r + s + r = s1 + s3 + s = s2 + s4 + zout(2, nout1, j) = r + s + zout(2, nout3, j) = r - s + r = s1 - s3 + s = r2 - r4 + zout(2, nout2, j) = r + s + zout(2, nout4, j) = r - s END DO END DO DO ia = 2, after - ias = ia-1 + ias = ia - 1 IF (2*ias == after) THEN - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) r = zin(1, j, nin2) s = zin(2, j, nin2) - r2 = (r-s)*rt2i - s2 = (r+s)*rt2i + r2 = (r - s)*rt2i + s2 = (r + s)*rt2i r3 = -zin(2, j, nin3) s3 = zin(1, j, nin3) r = zin(1, j, nin4) s = zin(2, j, nin4) - r4 = -(r+s)*rt2i - s4 = (r-s)*rt2i - r = r1+r3 - s = r2+r4 - zout(1, nout1, j) = r+s - zout(1, nout3, j) = r-s - r = r1-r3 - s = s2-s4 - zout(1, nout2, j) = r-s - zout(1, nout4, j) = r+s - r = s1+s3 - s = s2+s4 - zout(2, nout1, j) = r+s - zout(2, nout3, j) = r-s - r = s1-s3 - s = r2-r4 - zout(2, nout2, j) = r+s - zout(2, nout4, j) = r-s + r4 = -(r + s)*rt2i + s4 = (r - s)*rt2i + r = r1 + r3 + s = r2 + r4 + zout(1, nout1, j) = r + s + zout(1, nout3, j) = r - s + r = r1 - r3 + s = s2 - s4 + zout(1, nout2, j) = r - s + zout(1, nout4, j) = r + s + r = s1 + s3 + s = s2 + s4 + zout(2, nout1, j) = r + s + zout(2, nout3, j) = r - s + r = s1 - s3 + s = r2 - r4 + zout(2, nout2, j) = r + s + zout(2, nout4, j) = r - s END DO END DO ELSE itt = ias*before - itrig = itt+1 + itrig = itt + 1 cr2 = trig(1, itrig) ci2 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr3 = trig(1, itrig) ci3 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr4 = trig(1, itrig) ci4 = trig(2, itrig) - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) r = zin(1, j, nin2) s = zin(2, j, nin2) - r2 = r*cr2-s*ci2 - s2 = r*ci2+s*cr2 + r2 = r*cr2 - s*ci2 + s2 = r*ci2 + s*cr2 r = zin(1, j, nin3) s = zin(2, j, nin3) - r3 = r*cr3-s*ci3 - s3 = r*ci3+s*cr3 + r3 = r*cr3 - s*ci3 + s3 = r*ci3 + s*cr3 r = zin(1, j, nin4) s = zin(2, j, nin4) - r4 = r*cr4-s*ci4 - s4 = r*ci4+s*cr4 - r = r1+r3 - s = r2+r4 - zout(1, nout1, j) = r+s - zout(1, nout3, j) = r-s - r = r1-r3 - s = s2-s4 - zout(1, nout2, j) = r-s - zout(1, nout4, j) = r+s - r = s1+s3 - s = s2+s4 - zout(2, nout1, j) = r+s - zout(2, nout3, j) = r-s - r = s1-s3 - s = r2-r4 - zout(2, nout2, j) = r+s - zout(2, nout4, j) = r-s + r4 = r*cr4 - s*ci4 + s4 = r*ci4 + s*cr4 + r = r1 + r3 + s = r2 + r4 + zout(1, nout1, j) = r + s + zout(1, nout3, j) = r - s + r = r1 - r3 + s = s2 - s4 + zout(1, nout2, j) = r - s + zout(1, nout4, j) = r + s + r = s1 + s3 + s = s2 + s4 + zout(2, nout1, j) = r + s + zout(2, nout3, j) = r - s + r = s1 - s3 + s = r2 - r4 + zout(2, nout2, j) = r + s + zout(2, nout4, j) = r - s END DO END DO END IF END DO ELSE ia = 1 - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) @@ -464,122 +464,122 @@ SUBROUTINE fftrot(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s3 = zin(2, j, nin3) r4 = zin(1, j, nin4) s4 = zin(2, j, nin4) - r = r1+r3 - s = r2+r4 - zout(1, nout1, j) = r+s - zout(1, nout3, j) = r-s - r = r1-r3 - s = s2-s4 - zout(1, nout2, j) = r+s - zout(1, nout4, j) = r-s - r = s1+s3 - s = s2+s4 - zout(2, nout1, j) = r+s - zout(2, nout3, j) = r-s - r = s1-s3 - s = r2-r4 - zout(2, nout2, j) = r-s - zout(2, nout4, j) = r+s + r = r1 + r3 + s = r2 + r4 + zout(1, nout1, j) = r + s + zout(1, nout3, j) = r - s + r = r1 - r3 + s = s2 - s4 + zout(1, nout2, j) = r + s + zout(1, nout4, j) = r - s + r = s1 + s3 + s = s2 + s4 + zout(2, nout1, j) = r + s + zout(2, nout3, j) = r - s + r = s1 - s3 + s = r2 - r4 + zout(2, nout2, j) = r - s + zout(2, nout4, j) = r + s END DO END DO DO ia = 2, after - ias = ia-1 + ias = ia - 1 IF (2*ias == after) THEN - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) r = zin(1, j, nin2) s = zin(2, j, nin2) - r2 = (r+s)*rt2i - s2 = (s-r)*rt2i + r2 = (r + s)*rt2i + s2 = (s - r)*rt2i r3 = zin(2, j, nin3) s3 = -zin(1, j, nin3) r = zin(1, j, nin4) s = zin(2, j, nin4) - r4 = (s-r)*rt2i - s4 = -(r+s)*rt2i - r = r1+r3 - s = r2+r4 - zout(1, nout1, j) = r+s - zout(1, nout3, j) = r-s - r = r1-r3 - s = s2-s4 - zout(1, nout2, j) = r+s - zout(1, nout4, j) = r-s - r = s1+s3 - s = s2+s4 - zout(2, nout1, j) = r+s - zout(2, nout3, j) = r-s - r = s1-s3 - s = r2-r4 - zout(2, nout2, j) = r-s - zout(2, nout4, j) = r+s + r4 = (s - r)*rt2i + s4 = -(r + s)*rt2i + r = r1 + r3 + s = r2 + r4 + zout(1, nout1, j) = r + s + zout(1, nout3, j) = r - s + r = r1 - r3 + s = s2 - s4 + zout(1, nout2, j) = r + s + zout(1, nout4, j) = r - s + r = s1 + s3 + s = s2 + s4 + zout(2, nout1, j) = r + s + zout(2, nout3, j) = r - s + r = s1 - s3 + s = r2 - r4 + zout(2, nout2, j) = r - s + zout(2, nout4, j) = r + s END DO END DO ELSE itt = ias*before - itrig = itt+1 + itrig = itt + 1 cr2 = trig(1, itrig) ci2 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr3 = trig(1, itrig) ci3 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr4 = trig(1, itrig) ci4 = trig(2, itrig) - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) r = zin(1, j, nin2) s = zin(2, j, nin2) - r2 = r*cr2-s*ci2 - s2 = r*ci2+s*cr2 + r2 = r*cr2 - s*ci2 + s2 = r*ci2 + s*cr2 r = zin(1, j, nin3) s = zin(2, j, nin3) - r3 = r*cr3-s*ci3 - s3 = r*ci3+s*cr3 + r3 = r*cr3 - s*ci3 + s3 = r*ci3 + s*cr3 r = zin(1, j, nin4) s = zin(2, j, nin4) - r4 = r*cr4-s*ci4 - s4 = r*ci4+s*cr4 - r = r1+r3 - s = r2+r4 - zout(1, nout1, j) = r+s - zout(1, nout3, j) = r-s - r = r1-r3 - s = s2-s4 - zout(1, nout2, j) = r+s - zout(1, nout4, j) = r-s - r = s1+s3 - s = s2+s4 - zout(2, nout1, j) = r+s - zout(2, nout3, j) = r-s - r = s1-s3 - s = r2-r4 - zout(2, nout2, j) = r-s - zout(2, nout4, j) = r+s + r4 = r*cr4 - s*ci4 + s4 = r*ci4 + s*cr4 + r = r1 + r3 + s = r2 + r4 + zout(1, nout1, j) = r + s + zout(1, nout3, j) = r - s + r = r1 - r3 + s = s2 - s4 + zout(1, nout2, j) = r + s + zout(1, nout4, j) = r - s + r = s1 + s3 + s = s2 + s4 + zout(2, nout1, j) = r + s + zout(2, nout3, j) = r - s + r = s1 - s3 + s = r2 - r4 + zout(2, nout2, j) = r - s + zout(2, nout4, j) = r + s END DO END DO END IF @@ -588,25 +588,25 @@ SUBROUTINE fftrot(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign ELSE IF (now == 8) THEN IF (isign == -1) THEN ia = 1 - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nin5 = nin4+atb - nin6 = nin5+atb - nin7 = nin6+atb - nin8 = nin7+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after - nout5 = nout4+after - nout6 = nout5+after - nout7 = nout6+after - nout8 = nout7+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nin6 = nin5 + atb + nin7 = nin6 + atb + nin8 = nin7 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after + nout6 = nout5 + after + nout7 = nout6 + after + nout8 = nout7 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) @@ -624,81 +624,81 @@ SUBROUTINE fftrot(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s7 = zin(2, j, nin7) r8 = zin(1, j, nin8) s8 = zin(2, j, nin8) - r = r1+r5 - s = r3+r7 - ap = r+s - am = r-s - r = r2+r6 - s = r4+r8 - bp = r+s - bm = r-s - r = s1+s5 - s = s3+s7 - cp = r+s - cm = r-s - r = s2+s6 - s = s4+s8 - dbl = r+s - dm = r-s - zout(1, nout1, j) = ap+bp - zout(2, nout1, j) = cp+dbl - zout(1, nout5, j) = ap-bp - zout(2, nout5, j) = cp-dbl - zout(1, nout3, j) = am+dm - zout(2, nout3, j) = cm-bm - zout(1, nout7, j) = am-dm - zout(2, nout7, j) = cm+bm - r = r1-r5 - s = s3-s7 - ap = r+s - am = r-s - r = s1-s5 - s = r3-r7 - bp = r+s - bm = r-s - r = s4-s8 - s = r2-r6 - cp = r+s - cm = r-s - r = s2-s6 - s = r4-r8 - dbl = r+s - dm = r-s - r = (cp+dm)*rt2i - s = (-cp+dm)*rt2i - cp = (cm+dbl)*rt2i - dbl = (cm-dbl)*rt2i - zout(1, nout2, j) = ap+r - zout(2, nout2, j) = bm+s - zout(1, nout6, j) = ap-r - zout(2, nout6, j) = bm-s - zout(1, nout4, j) = am+cp - zout(2, nout4, j) = bp+dbl - zout(1, nout8, j) = am-cp - zout(2, nout8, j) = bp-dbl + r = r1 + r5 + s = r3 + r7 + ap = r + s + am = r - s + r = r2 + r6 + s = r4 + r8 + bp = r + s + bm = r - s + r = s1 + s5 + s = s3 + s7 + cp = r + s + cm = r - s + r = s2 + s6 + s = s4 + s8 + dbl = r + s + dm = r - s + zout(1, nout1, j) = ap + bp + zout(2, nout1, j) = cp + dbl + zout(1, nout5, j) = ap - bp + zout(2, nout5, j) = cp - dbl + zout(1, nout3, j) = am + dm + zout(2, nout3, j) = cm - bm + zout(1, nout7, j) = am - dm + zout(2, nout7, j) = cm + bm + r = r1 - r5 + s = s3 - s7 + ap = r + s + am = r - s + r = s1 - s5 + s = r3 - r7 + bp = r + s + bm = r - s + r = s4 - s8 + s = r2 - r6 + cp = r + s + cm = r - s + r = s2 - s6 + s = r4 - r8 + dbl = r + s + dm = r - s + r = (cp + dm)*rt2i + s = (-cp + dm)*rt2i + cp = (cm + dbl)*rt2i + dbl = (cm - dbl)*rt2i + zout(1, nout2, j) = ap + r + zout(2, nout2, j) = bm + s + zout(1, nout6, j) = ap - r + zout(2, nout6, j) = bm - s + zout(1, nout4, j) = am + cp + zout(2, nout4, j) = bp + dbl + zout(1, nout8, j) = am - cp + zout(2, nout8, j) = bp - dbl END DO END DO ELSE ia = 1 - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nin5 = nin4+atb - nin6 = nin5+atb - nin7 = nin6+atb - nin8 = nin7+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after - nout5 = nout4+after - nout6 = nout5+after - nout7 = nout6+after - nout8 = nout7+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nin6 = nin5 + atb + nin7 = nin6 + atb + nin8 = nin7 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after + nout6 = nout5 + after + nout7 = nout6 + after + nout8 = nout7 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) @@ -716,73 +716,73 @@ SUBROUTINE fftrot(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s7 = zin(2, j, nin7) r8 = zin(1, j, nin8) s8 = zin(2, j, nin8) - r = r1+r5 - s = r3+r7 - ap = r+s - am = r-s - r = r2+r6 - s = r4+r8 - bp = r+s - bm = r-s - r = s1+s5 - s = s3+s7 - cp = r+s - cm = r-s - r = s2+s6 - s = s4+s8 - dbl = r+s - dm = r-s - zout(1, nout1, j) = ap+bp - zout(2, nout1, j) = cp+dbl - zout(1, nout5, j) = ap-bp - zout(2, nout5, j) = cp-dbl - zout(1, nout3, j) = am-dm - zout(2, nout3, j) = cm+bm - zout(1, nout7, j) = am+dm - zout(2, nout7, j) = cm-bm - r = r1-r5 - s = -s3+s7 - ap = r+s - am = r-s - r = s1-s5 - s = r7-r3 - bp = r+s - bm = r-s - r = -s4+s8 - s = r2-r6 - cp = r+s - cm = r-s - r = -s2+s6 - s = r4-r8 - dbl = r+s - dm = r-s - r = (cp+dm)*rt2i - s = (cp-dm)*rt2i - cp = (cm+dbl)*rt2i - dbl = (-cm+dbl)*rt2i - zout(1, nout2, j) = ap+r - zout(2, nout2, j) = bm+s - zout(1, nout6, j) = ap-r - zout(2, nout6, j) = bm-s - zout(1, nout4, j) = am+cp - zout(2, nout4, j) = bp+dbl - zout(1, nout8, j) = am-cp - zout(2, nout8, j) = bp-dbl + r = r1 + r5 + s = r3 + r7 + ap = r + s + am = r - s + r = r2 + r6 + s = r4 + r8 + bp = r + s + bm = r - s + r = s1 + s5 + s = s3 + s7 + cp = r + s + cm = r - s + r = s2 + s6 + s = s4 + s8 + dbl = r + s + dm = r - s + zout(1, nout1, j) = ap + bp + zout(2, nout1, j) = cp + dbl + zout(1, nout5, j) = ap - bp + zout(2, nout5, j) = cp - dbl + zout(1, nout3, j) = am - dm + zout(2, nout3, j) = cm + bm + zout(1, nout7, j) = am + dm + zout(2, nout7, j) = cm - bm + r = r1 - r5 + s = -s3 + s7 + ap = r + s + am = r - s + r = s1 - s5 + s = r7 - r3 + bp = r + s + bm = r - s + r = -s4 + s8 + s = r2 - r6 + cp = r + s + cm = r - s + r = -s2 + s6 + s = r4 - r8 + dbl = r + s + dm = r - s + r = (cp + dm)*rt2i + s = (cp - dm)*rt2i + cp = (cm + dbl)*rt2i + dbl = (-cm + dbl)*rt2i + zout(1, nout2, j) = ap + r + zout(2, nout2, j) = bm + s + zout(1, nout6, j) = ap - r + zout(2, nout6, j) = bm - s + zout(1, nout4, j) = am + cp + zout(2, nout4, j) = bp + dbl + zout(1, nout8, j) = am - cp + zout(2, nout8, j) = bp - dbl END DO END DO END IF ELSE IF (now == 3) THEN bbs = isign*bb ia = 1 - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) @@ -790,33 +790,33 @@ SUBROUTINE fftrot(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s2 = zin(2, j, nin2) r3 = zin(1, j, nin3) s3 = zin(2, j, nin3) - r = r2+r3 - s = s2+s3 - zout(1, nout1, j) = r+r1 - zout(2, nout1, j) = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r2 = bbs*(r2-r3) - s2 = bbs*(s2-s3) - zout(1, nout2, j) = r1-s2 - zout(2, nout2, j) = s1+r2 - zout(1, nout3, j) = r1+s2 - zout(2, nout3, j) = s1-r2 + r = r2 + r3 + s = s2 + s3 + zout(1, nout1, j) = r + r1 + zout(2, nout1, j) = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r2 = bbs*(r2 - r3) + s2 = bbs*(s2 - s3) + zout(1, nout2, j) = r1 - s2 + zout(2, nout2, j) = s1 + r2 + zout(1, nout3, j) = r1 + s2 + zout(2, nout3, j) = s1 - r2 END DO END DO DO ia = 2, after - ias = ia-1 + ias = ia - 1 IF (4*ias == 3*after) THEN IF (isign == 1) THEN - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) @@ -824,30 +824,30 @@ SUBROUTINE fftrot(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s2 = zin(1, j, nin2) r3 = -zin(1, j, nin3) s3 = -zin(2, j, nin3) - r = r2+r3 - s = s2+s3 - zout(1, nout1, j) = r+r1 - zout(2, nout1, j) = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r2 = bbs*(r2-r3) - s2 = bbs*(s2-s3) - zout(1, nout2, j) = r1-s2 - zout(2, nout2, j) = s1+r2 - zout(1, nout3, j) = r1+s2 - zout(2, nout3, j) = s1-r2 + r = r2 + r3 + s = s2 + s3 + zout(1, nout1, j) = r + r1 + zout(2, nout1, j) = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r2 = bbs*(r2 - r3) + s2 = bbs*(s2 - s3) + zout(1, nout2, j) = r1 - s2 + zout(2, nout2, j) = s1 + r2 + zout(1, nout3, j) = r1 + s2 + zout(2, nout3, j) = s1 - r2 END DO END DO ELSE - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) @@ -855,129 +855,129 @@ SUBROUTINE fftrot(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s2 = -zin(1, j, nin2) r3 = -zin(1, j, nin3) s3 = -zin(2, j, nin3) - r = r2+r3 - s = s2+s3 - zout(1, nout1, j) = r+r1 - zout(2, nout1, j) = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r2 = bbs*(r2-r3) - s2 = bbs*(s2-s3) - zout(1, nout2, j) = r1-s2 - zout(2, nout2, j) = s1+r2 - zout(1, nout3, j) = r1+s2 - zout(2, nout3, j) = s1-r2 + r = r2 + r3 + s = s2 + s3 + zout(1, nout1, j) = r + r1 + zout(2, nout1, j) = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r2 = bbs*(r2 - r3) + s2 = bbs*(s2 - s3) + zout(1, nout2, j) = r1 - s2 + zout(2, nout2, j) = s1 + r2 + zout(1, nout3, j) = r1 + s2 + zout(2, nout3, j) = s1 - r2 END DO END DO END IF ELSE IF (8*ias == 3*after) THEN IF (isign == 1) THEN - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) r = zin(1, j, nin2) s = zin(2, j, nin2) - r2 = (r-s)*rt2i - s2 = (r+s)*rt2i + r2 = (r - s)*rt2i + s2 = (r + s)*rt2i r3 = -zin(2, j, nin3) s3 = zin(1, j, nin3) - r = r2+r3 - s = s2+s3 - zout(1, nout1, j) = r+r1 - zout(2, nout1, j) = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r2 = bbs*(r2-r3) - s2 = bbs*(s2-s3) - zout(1, nout2, j) = r1-s2 - zout(2, nout2, j) = s1+r2 - zout(1, nout3, j) = r1+s2 - zout(2, nout3, j) = s1-r2 + r = r2 + r3 + s = s2 + s3 + zout(1, nout1, j) = r + r1 + zout(2, nout1, j) = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r2 = bbs*(r2 - r3) + s2 = bbs*(s2 - s3) + zout(1, nout2, j) = r1 - s2 + zout(2, nout2, j) = s1 + r2 + zout(1, nout3, j) = r1 + s2 + zout(2, nout3, j) = s1 - r2 END DO END DO ELSE - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) r = zin(1, j, nin2) s = zin(2, j, nin2) - r2 = (r+s)*rt2i - s2 = (-r+s)*rt2i + r2 = (r + s)*rt2i + s2 = (-r + s)*rt2i r3 = zin(2, j, nin3) s3 = -zin(1, j, nin3) - r = r2+r3 - s = s2+s3 - zout(1, nout1, j) = r+r1 - zout(2, nout1, j) = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r2 = bbs*(r2-r3) - s2 = bbs*(s2-s3) - zout(1, nout2, j) = r1-s2 - zout(2, nout2, j) = s1+r2 - zout(1, nout3, j) = r1+s2 - zout(2, nout3, j) = s1-r2 + r = r2 + r3 + s = s2 + s3 + zout(1, nout1, j) = r + r1 + zout(2, nout1, j) = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r2 = bbs*(r2 - r3) + s2 = bbs*(s2 - s3) + zout(1, nout2, j) = r1 - s2 + zout(2, nout2, j) = s1 + r2 + zout(1, nout3, j) = r1 + s2 + zout(2, nout3, j) = s1 - r2 END DO END DO END IF ELSE itt = ias*before - itrig = itt+1 + itrig = itt + 1 cr2 = trig(1, itrig) ci2 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr3 = trig(1, itrig) ci3 = trig(2, itrig) - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) r = zin(1, j, nin2) s = zin(2, j, nin2) - r2 = r*cr2-s*ci2 - s2 = r*ci2+s*cr2 + r2 = r*cr2 - s*ci2 + s2 = r*ci2 + s*cr2 r = zin(1, j, nin3) s = zin(2, j, nin3) - r3 = r*cr3-s*ci3 - s3 = r*ci3+s*cr3 - r = r2+r3 - s = s2+s3 - zout(1, nout1, j) = r+r1 - zout(2, nout1, j) = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r2 = bbs*(r2-r3) - s2 = bbs*(s2-s3) - zout(1, nout2, j) = r1-s2 - zout(2, nout2, j) = s1+r2 - zout(1, nout3, j) = r1+s2 - zout(2, nout3, j) = s1-r2 + r3 = r*cr3 - s*ci3 + s3 = r*ci3 + s*cr3 + r = r2 + r3 + s = s2 + s3 + zout(1, nout1, j) = r + r1 + zout(2, nout1, j) = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r2 = bbs*(r2 - r3) + s2 = bbs*(s2 - s3) + zout(1, nout2, j) = r1 - s2 + zout(2, nout2, j) = s1 + r2 + zout(1, nout3, j) = r1 + s2 + zout(2, nout3, j) = s1 - r2 END DO END DO END IF @@ -986,19 +986,19 @@ SUBROUTINE fftrot(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign sin2 = isign*sin2p sin4 = isign*sin4p ia = 1 - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nin5 = nin4+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after - nout5 = nout4+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) @@ -1010,225 +1010,225 @@ SUBROUTINE fftrot(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s4 = zin(2, j, nin4) r5 = zin(1, j, nin5) s5 = zin(2, j, nin5) - r25 = r2+r5 - r34 = r3+r4 - s25 = s2-s5 - s34 = s3-s4 - zout(1, nout1, j) = r1+r25+r34 - r = cos2*r25+cos4*r34+r1 - s = sin2*s25+sin4*s34 - zout(1, nout2, j) = r-s - zout(1, nout5, j) = r+s - r = cos4*r25+cos2*r34+r1 - s = sin4*s25-sin2*s34 - zout(1, nout3, j) = r-s - zout(1, nout4, j) = r+s - r25 = r2-r5 - r34 = r3-r4 - s25 = s2+s5 - s34 = s3+s4 - zout(2, nout1, j) = s1+s25+s34 - r = cos2*s25+cos4*s34+s1 - s = sin2*r25+sin4*r34 - zout(2, nout2, j) = r+s - zout(2, nout5, j) = r-s - r = cos4*s25+cos2*s34+s1 - s = sin4*r25-sin2*r34 - zout(2, nout3, j) = r+s - zout(2, nout4, j) = r-s + r25 = r2 + r5 + r34 = r3 + r4 + s25 = s2 - s5 + s34 = s3 - s4 + zout(1, nout1, j) = r1 + r25 + r34 + r = cos2*r25 + cos4*r34 + r1 + s = sin2*s25 + sin4*s34 + zout(1, nout2, j) = r - s + zout(1, nout5, j) = r + s + r = cos4*r25 + cos2*r34 + r1 + s = sin4*s25 - sin2*s34 + zout(1, nout3, j) = r - s + zout(1, nout4, j) = r + s + r25 = r2 - r5 + r34 = r3 - r4 + s25 = s2 + s5 + s34 = s3 + s4 + zout(2, nout1, j) = s1 + s25 + s34 + r = cos2*s25 + cos4*s34 + s1 + s = sin2*r25 + sin4*r34 + zout(2, nout2, j) = r + s + zout(2, nout5, j) = r - s + r = cos4*s25 + cos2*s34 + s1 + s = sin4*r25 - sin2*r34 + zout(2, nout3, j) = r + s + zout(2, nout4, j) = r - s END DO END DO DO ia = 2, after - ias = ia-1 + ias = ia - 1 IF (8*ias == 5*after) THEN IF (isign == 1) THEN - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nin5 = nin4+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after - nout5 = nout4+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) r = zin(1, j, nin2) s = zin(2, j, nin2) - r2 = (r-s)*rt2i - s2 = (r+s)*rt2i + r2 = (r - s)*rt2i + s2 = (r + s)*rt2i r3 = -zin(2, j, nin3) s3 = zin(1, j, nin3) r = zin(1, j, nin4) s = zin(2, j, nin4) - r4 = -(r+s)*rt2i - s4 = (r-s)*rt2i + r4 = -(r + s)*rt2i + s4 = (r - s)*rt2i r5 = -zin(1, j, nin5) s5 = -zin(2, j, nin5) - r25 = r2+r5 - r34 = r3+r4 - s25 = s2-s5 - s34 = s3-s4 - zout(1, nout1, j) = r1+r25+r34 - r = cos2*r25+cos4*r34+r1 - s = sin2*s25+sin4*s34 - zout(1, nout2, j) = r-s - zout(1, nout5, j) = r+s - r = cos4*r25+cos2*r34+r1 - s = sin4*s25-sin2*s34 - zout(1, nout3, j) = r-s - zout(1, nout4, j) = r+s - r25 = r2-r5 - r34 = r3-r4 - s25 = s2+s5 - s34 = s3+s4 - zout(2, nout1, j) = s1+s25+s34 - r = cos2*s25+cos4*s34+s1 - s = sin2*r25+sin4*r34 - zout(2, nout2, j) = r+s - zout(2, nout5, j) = r-s - r = cos4*s25+cos2*s34+s1 - s = sin4*r25-sin2*r34 - zout(2, nout3, j) = r+s - zout(2, nout4, j) = r-s + r25 = r2 + r5 + r34 = r3 + r4 + s25 = s2 - s5 + s34 = s3 - s4 + zout(1, nout1, j) = r1 + r25 + r34 + r = cos2*r25 + cos4*r34 + r1 + s = sin2*s25 + sin4*s34 + zout(1, nout2, j) = r - s + zout(1, nout5, j) = r + s + r = cos4*r25 + cos2*r34 + r1 + s = sin4*s25 - sin2*s34 + zout(1, nout3, j) = r - s + zout(1, nout4, j) = r + s + r25 = r2 - r5 + r34 = r3 - r4 + s25 = s2 + s5 + s34 = s3 + s4 + zout(2, nout1, j) = s1 + s25 + s34 + r = cos2*s25 + cos4*s34 + s1 + s = sin2*r25 + sin4*r34 + zout(2, nout2, j) = r + s + zout(2, nout5, j) = r - s + r = cos4*s25 + cos2*s34 + s1 + s = sin4*r25 - sin2*r34 + zout(2, nout3, j) = r + s + zout(2, nout4, j) = r - s END DO END DO ELSE - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nin5 = nin4+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after - nout5 = nout4+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) r = zin(1, j, nin2) s = zin(2, j, nin2) - r2 = (r+s)*rt2i - s2 = (-r+s)*rt2i + r2 = (r + s)*rt2i + s2 = (-r + s)*rt2i r3 = zin(2, j, nin3) s3 = -zin(1, j, nin3) r = zin(1, j, nin4) s = zin(2, j, nin4) - r4 = (s-r)*rt2i - s4 = -(r+s)*rt2i + r4 = (s - r)*rt2i + s4 = -(r + s)*rt2i r5 = -zin(1, j, nin5) s5 = -zin(2, j, nin5) - r25 = r2+r5 - r34 = r3+r4 - s25 = s2-s5 - s34 = s3-s4 - zout(1, nout1, j) = r1+r25+r34 - r = cos2*r25+cos4*r34+r1 - s = sin2*s25+sin4*s34 - zout(1, nout2, j) = r-s - zout(1, nout5, j) = r+s - r = cos4*r25+cos2*r34+r1 - s = sin4*s25-sin2*s34 - zout(1, nout3, j) = r-s - zout(1, nout4, j) = r+s - r25 = r2-r5 - r34 = r3-r4 - s25 = s2+s5 - s34 = s3+s4 - zout(2, nout1, j) = s1+s25+s34 - r = cos2*s25+cos4*s34+s1 - s = sin2*r25+sin4*r34 - zout(2, nout2, j) = r+s - zout(2, nout5, j) = r-s - r = cos4*s25+cos2*s34+s1 - s = sin4*r25-sin2*r34 - zout(2, nout3, j) = r+s - zout(2, nout4, j) = r-s + r25 = r2 + r5 + r34 = r3 + r4 + s25 = s2 - s5 + s34 = s3 - s4 + zout(1, nout1, j) = r1 + r25 + r34 + r = cos2*r25 + cos4*r34 + r1 + s = sin2*s25 + sin4*s34 + zout(1, nout2, j) = r - s + zout(1, nout5, j) = r + s + r = cos4*r25 + cos2*r34 + r1 + s = sin4*s25 - sin2*s34 + zout(1, nout3, j) = r - s + zout(1, nout4, j) = r + s + r25 = r2 - r5 + r34 = r3 - r4 + s25 = s2 + s5 + s34 = s3 + s4 + zout(2, nout1, j) = s1 + s25 + s34 + r = cos2*s25 + cos4*s34 + s1 + s = sin2*r25 + sin4*r34 + zout(2, nout2, j) = r + s + zout(2, nout5, j) = r - s + r = cos4*s25 + cos2*s34 + s1 + s = sin4*r25 - sin2*r34 + zout(2, nout3, j) = r + s + zout(2, nout4, j) = r - s END DO END DO END IF ELSE - ias = ia-1 + ias = ia - 1 itt = ias*before - itrig = itt+1 + itrig = itt + 1 cr2 = trig(1, itrig) ci2 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr3 = trig(1, itrig) ci3 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr4 = trig(1, itrig) ci4 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr5 = trig(1, itrig) ci5 = trig(2, itrig) - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nin5 = nin4+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after - nout5 = nout4+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) r = zin(1, j, nin2) s = zin(2, j, nin2) - r2 = r*cr2-s*ci2 - s2 = r*ci2+s*cr2 + r2 = r*cr2 - s*ci2 + s2 = r*ci2 + s*cr2 r = zin(1, j, nin3) s = zin(2, j, nin3) - r3 = r*cr3-s*ci3 - s3 = r*ci3+s*cr3 + r3 = r*cr3 - s*ci3 + s3 = r*ci3 + s*cr3 r = zin(1, j, nin4) s = zin(2, j, nin4) - r4 = r*cr4-s*ci4 - s4 = r*ci4+s*cr4 + r4 = r*cr4 - s*ci4 + s4 = r*ci4 + s*cr4 r = zin(1, j, nin5) s = zin(2, j, nin5) - r5 = r*cr5-s*ci5 - s5 = r*ci5+s*cr5 - r25 = r2+r5 - r34 = r3+r4 - s25 = s2-s5 - s34 = s3-s4 - zout(1, nout1, j) = r1+r25+r34 - r = cos2*r25+cos4*r34+r1 - s = sin2*s25+sin4*s34 - zout(1, nout2, j) = r-s - zout(1, nout5, j) = r+s - r = cos4*r25+cos2*r34+r1 - s = sin4*s25-sin2*s34 - zout(1, nout3, j) = r-s - zout(1, nout4, j) = r+s - r25 = r2-r5 - r34 = r3-r4 - s25 = s2+s5 - s34 = s3+s4 - zout(2, nout1, j) = s1+s25+s34 - r = cos2*s25+cos4*s34+s1 - s = sin2*r25+sin4*r34 - zout(2, nout2, j) = r+s - zout(2, nout5, j) = r-s - r = cos4*s25+cos2*s34+s1 - s = sin4*r25-sin2*r34 - zout(2, nout3, j) = r+s - zout(2, nout4, j) = r-s + r5 = r*cr5 - s*ci5 + s5 = r*ci5 + s*cr5 + r25 = r2 + r5 + r34 = r3 + r4 + s25 = s2 - s5 + s34 = s3 - s4 + zout(1, nout1, j) = r1 + r25 + r34 + r = cos2*r25 + cos4*r34 + r1 + s = sin2*s25 + sin4*s34 + zout(1, nout2, j) = r - s + zout(1, nout5, j) = r + s + r = cos4*r25 + cos2*r34 + r1 + s = sin4*s25 - sin2*s34 + zout(1, nout3, j) = r - s + zout(1, nout4, j) = r + s + r25 = r2 - r5 + r34 = r3 - r4 + s25 = s2 + s5 + s34 = s3 + s4 + zout(2, nout1, j) = s1 + s25 + s34 + r = cos2*s25 + cos4*s34 + s1 + s = sin2*r25 + sin4*r34 + zout(2, nout2, j) = r + s + zout(2, nout5, j) = r - s + r = cos4*s25 + cos2*s34 + s1 + s = sin4*r25 - sin2*r34 + zout(2, nout3, j) = r + s + zout(2, nout4, j) = r - s END DO END DO END IF @@ -1236,72 +1236,72 @@ SUBROUTINE fftrot(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign ELSE IF (now == 6) THEN bbs = isign*bb ia = 1 - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nin5 = nin4+atb - nin6 = nin5+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after - nout5 = nout4+after - nout6 = nout5+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nin6 = nin5 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after + nout6 = nout5 + after DO j = 1, nfft r2 = zin(1, j, nin3) s2 = zin(2, j, nin3) r3 = zin(1, j, nin5) s3 = zin(2, j, nin5) - r = r2+r3 - s = s2+s3 + r = r2 + r3 + s = s2 + s3 r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) - ur1 = r+r1 - ui1 = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r = r2-r3 - s = s2-s3 - ur2 = r1-s*bbs - ui2 = s1+r*bbs - ur3 = r1+s*bbs - ui3 = s1-r*bbs + ur1 = r + r1 + ui1 = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r = r2 - r3 + s = s2 - s3 + ur2 = r1 - s*bbs + ui2 = s1 + r*bbs + ur3 = r1 + s*bbs + ui3 = s1 - r*bbs r2 = zin(1, j, nin6) s2 = zin(2, j, nin6) r3 = zin(1, j, nin2) s3 = zin(2, j, nin2) - r = r2+r3 - s = s2+s3 + r = r2 + r3 + s = s2 + s3 r1 = zin(1, j, nin4) s1 = zin(2, j, nin4) - vr1 = r+r1 - vi1 = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r = r2-r3 - s = s2-s3 - vr2 = r1-s*bbs - vi2 = s1+r*bbs - vr3 = r1+s*bbs - vi3 = s1-r*bbs - - zout(1, nout1, j) = ur1+vr1 - zout(2, nout1, j) = ui1+vi1 - zout(1, nout5, j) = ur2+vr2 - zout(2, nout5, j) = ui2+vi2 - zout(1, nout3, j) = ur3+vr3 - zout(2, nout3, j) = ui3+vi3 - zout(1, nout4, j) = ur1-vr1 - zout(2, nout4, j) = ui1-vi1 - zout(1, nout2, j) = ur2-vr2 - zout(2, nout2, j) = ui2-vi2 - zout(1, nout6, j) = ur3-vr3 - zout(2, nout6, j) = ui3-vi3 + vr1 = r + r1 + vi1 = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r = r2 - r3 + s = s2 - s3 + vr2 = r1 - s*bbs + vi2 = s1 + r*bbs + vr3 = r1 + s*bbs + vi3 = s1 - r*bbs + + zout(1, nout1, j) = ur1 + vr1 + zout(2, nout1, j) = ui1 + vi1 + zout(1, nout5, j) = ur2 + vr2 + zout(2, nout5, j) = ui2 + vi2 + zout(1, nout3, j) = ur3 + vr3 + zout(2, nout3, j) = ui3 + vi3 + zout(1, nout4, j) = ur1 - vr1 + zout(2, nout4, j) = ui1 - vi1 + zout(1, nout2, j) = ur2 - vr2 + zout(2, nout2, j) = ui2 - vi2 + zout(1, nout6, j) = ur3 - vr3 + zout(2, nout6, j) = ui3 - vi3 END DO END DO ELSE @@ -1373,17 +1373,17 @@ SUBROUTINE fftpre(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign IF (now == 4) THEN IF (isign == 1) THEN ia = 1 - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after DO j = 1, nfft r1 = zin(1, nin1, j) s1 = zin(2, nin1, j) @@ -1393,139 +1393,139 @@ SUBROUTINE fftpre(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s3 = zin(2, nin3, j) r4 = zin(1, nin4, j) s4 = zin(2, nin4, j) - r = r1+r3 - s = r2+r4 - zout(1, j, nout1) = r+s - zout(1, j, nout3) = r-s - r = r1-r3 - s = s2-s4 - zout(1, j, nout2) = r-s - zout(1, j, nout4) = r+s - r = s1+s3 - s = s2+s4 - zout(2, j, nout1) = r+s - zout(2, j, nout3) = r-s - r = s1-s3 - s = r2-r4 - zout(2, j, nout2) = r+s - zout(2, j, nout4) = r-s + r = r1 + r3 + s = r2 + r4 + zout(1, j, nout1) = r + s + zout(1, j, nout3) = r - s + r = r1 - r3 + s = s2 - s4 + zout(1, j, nout2) = r - s + zout(1, j, nout4) = r + s + r = s1 + s3 + s = s2 + s4 + zout(2, j, nout1) = r + s + zout(2, j, nout3) = r - s + r = s1 - s3 + s = r2 - r4 + zout(2, j, nout2) = r + s + zout(2, j, nout4) = r - s END DO END DO DO ia = 2, after - ias = ia-1 + ias = ia - 1 IF (2*ias == after) THEN - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after DO j = 1, nfft r1 = zin(1, nin1, j) s1 = zin(2, nin1, j) r = zin(1, nin2, j) s = zin(2, nin2, j) - r2 = (r-s)*rt2i - s2 = (r+s)*rt2i + r2 = (r - s)*rt2i + s2 = (r + s)*rt2i r3 = -zin(2, nin3, j) s3 = zin(1, nin3, j) r = zin(1, nin4, j) s = zin(2, nin4, j) - r4 = -(r+s)*rt2i - s4 = (r-s)*rt2i - r = r1+r3 - s = r2+r4 - zout(1, j, nout1) = r+s - zout(1, j, nout3) = r-s - r = r1-r3 - s = s2-s4 - zout(1, j, nout2) = r-s - zout(1, j, nout4) = r+s - r = s1+s3 - s = s2+s4 - zout(2, j, nout1) = r+s - zout(2, j, nout3) = r-s - r = s1-s3 - s = r2-r4 - zout(2, j, nout2) = r+s - zout(2, j, nout4) = r-s + r4 = -(r + s)*rt2i + s4 = (r - s)*rt2i + r = r1 + r3 + s = r2 + r4 + zout(1, j, nout1) = r + s + zout(1, j, nout3) = r - s + r = r1 - r3 + s = s2 - s4 + zout(1, j, nout2) = r - s + zout(1, j, nout4) = r + s + r = s1 + s3 + s = s2 + s4 + zout(2, j, nout1) = r + s + zout(2, j, nout3) = r - s + r = s1 - s3 + s = r2 - r4 + zout(2, j, nout2) = r + s + zout(2, j, nout4) = r - s END DO END DO ELSE itt = ias*before - itrig = itt+1 + itrig = itt + 1 cr2 = trig(1, itrig) ci2 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr3 = trig(1, itrig) ci3 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr4 = trig(1, itrig) ci4 = trig(2, itrig) - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after DO j = 1, nfft r1 = zin(1, nin1, j) s1 = zin(2, nin1, j) r = zin(1, nin2, j) s = zin(2, nin2, j) - r2 = r*cr2-s*ci2 - s2 = r*ci2+s*cr2 + r2 = r*cr2 - s*ci2 + s2 = r*ci2 + s*cr2 r = zin(1, nin3, j) s = zin(2, nin3, j) - r3 = r*cr3-s*ci3 - s3 = r*ci3+s*cr3 + r3 = r*cr3 - s*ci3 + s3 = r*ci3 + s*cr3 r = zin(1, nin4, j) s = zin(2, nin4, j) - r4 = r*cr4-s*ci4 - s4 = r*ci4+s*cr4 - r = r1+r3 - s = r2+r4 - zout(1, j, nout1) = r+s - zout(1, j, nout3) = r-s - r = r1-r3 - s = s2-s4 - zout(1, j, nout2) = r-s - zout(1, j, nout4) = r+s - r = s1+s3 - s = s2+s4 - zout(2, j, nout1) = r+s - zout(2, j, nout3) = r-s - r = s1-s3 - s = r2-r4 - zout(2, j, nout2) = r+s - zout(2, j, nout4) = r-s + r4 = r*cr4 - s*ci4 + s4 = r*ci4 + s*cr4 + r = r1 + r3 + s = r2 + r4 + zout(1, j, nout1) = r + s + zout(1, j, nout3) = r - s + r = r1 - r3 + s = s2 - s4 + zout(1, j, nout2) = r - s + zout(1, j, nout4) = r + s + r = s1 + s3 + s = s2 + s4 + zout(2, j, nout1) = r + s + zout(2, j, nout3) = r - s + r = s1 - s3 + s = r2 - r4 + zout(2, j, nout2) = r + s + zout(2, j, nout4) = r - s END DO END DO END IF END DO ELSE ia = 1 - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after DO j = 1, nfft r1 = zin(1, nin1, j) s1 = zin(2, nin1, j) @@ -1535,122 +1535,122 @@ SUBROUTINE fftpre(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s3 = zin(2, nin3, j) r4 = zin(1, nin4, j) s4 = zin(2, nin4, j) - r = r1+r3 - s = r2+r4 - zout(1, j, nout1) = r+s - zout(1, j, nout3) = r-s - r = r1-r3 - s = s2-s4 - zout(1, j, nout2) = r+s - zout(1, j, nout4) = r-s - r = s1+s3 - s = s2+s4 - zout(2, j, nout1) = r+s - zout(2, j, nout3) = r-s - r = s1-s3 - s = r2-r4 - zout(2, j, nout2) = r-s - zout(2, j, nout4) = r+s + r = r1 + r3 + s = r2 + r4 + zout(1, j, nout1) = r + s + zout(1, j, nout3) = r - s + r = r1 - r3 + s = s2 - s4 + zout(1, j, nout2) = r + s + zout(1, j, nout4) = r - s + r = s1 + s3 + s = s2 + s4 + zout(2, j, nout1) = r + s + zout(2, j, nout3) = r - s + r = s1 - s3 + s = r2 - r4 + zout(2, j, nout2) = r - s + zout(2, j, nout4) = r + s END DO END DO DO ia = 2, after - ias = ia-1 + ias = ia - 1 IF (2*ias == after) THEN - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after DO j = 1, nfft r1 = zin(1, nin1, j) s1 = zin(2, nin1, j) r = zin(1, nin2, j) s = zin(2, nin2, j) - r2 = (r+s)*rt2i - s2 = (s-r)*rt2i + r2 = (r + s)*rt2i + s2 = (s - r)*rt2i r3 = zin(2, nin3, j) s3 = -zin(1, nin3, j) r = zin(1, nin4, j) s = zin(2, nin4, j) - r4 = (s-r)*rt2i - s4 = -(r+s)*rt2i - r = r1+r3 - s = r2+r4 - zout(1, j, nout1) = r+s - zout(1, j, nout3) = r-s - r = r1-r3 - s = s2-s4 - zout(1, j, nout2) = r+s - zout(1, j, nout4) = r-s - r = s1+s3 - s = s2+s4 - zout(2, j, nout1) = r+s - zout(2, j, nout3) = r-s - r = s1-s3 - s = r2-r4 - zout(2, j, nout2) = r-s - zout(2, j, nout4) = r+s + r4 = (s - r)*rt2i + s4 = -(r + s)*rt2i + r = r1 + r3 + s = r2 + r4 + zout(1, j, nout1) = r + s + zout(1, j, nout3) = r - s + r = r1 - r3 + s = s2 - s4 + zout(1, j, nout2) = r + s + zout(1, j, nout4) = r - s + r = s1 + s3 + s = s2 + s4 + zout(2, j, nout1) = r + s + zout(2, j, nout3) = r - s + r = s1 - s3 + s = r2 - r4 + zout(2, j, nout2) = r - s + zout(2, j, nout4) = r + s END DO END DO ELSE itt = ias*before - itrig = itt+1 + itrig = itt + 1 cr2 = trig(1, itrig) ci2 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr3 = trig(1, itrig) ci3 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr4 = trig(1, itrig) ci4 = trig(2, itrig) - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after DO j = 1, nfft r1 = zin(1, nin1, j) s1 = zin(2, nin1, j) r = zin(1, nin2, j) s = zin(2, nin2, j) - r2 = r*cr2-s*ci2 - s2 = r*ci2+s*cr2 + r2 = r*cr2 - s*ci2 + s2 = r*ci2 + s*cr2 r = zin(1, nin3, j) s = zin(2, nin3, j) - r3 = r*cr3-s*ci3 - s3 = r*ci3+s*cr3 + r3 = r*cr3 - s*ci3 + s3 = r*ci3 + s*cr3 r = zin(1, nin4, j) s = zin(2, nin4, j) - r4 = r*cr4-s*ci4 - s4 = r*ci4+s*cr4 - r = r1+r3 - s = r2+r4 - zout(1, j, nout1) = r+s - zout(1, j, nout3) = r-s - r = r1-r3 - s = s2-s4 - zout(1, j, nout2) = r+s - zout(1, j, nout4) = r-s - r = s1+s3 - s = s2+s4 - zout(2, j, nout1) = r+s - zout(2, j, nout3) = r-s - r = s1-s3 - s = r2-r4 - zout(2, j, nout2) = r-s - zout(2, j, nout4) = r+s + r4 = r*cr4 - s*ci4 + s4 = r*ci4 + s*cr4 + r = r1 + r3 + s = r2 + r4 + zout(1, j, nout1) = r + s + zout(1, j, nout3) = r - s + r = r1 - r3 + s = s2 - s4 + zout(1, j, nout2) = r + s + zout(1, j, nout4) = r - s + r = s1 + s3 + s = s2 + s4 + zout(2, j, nout1) = r + s + zout(2, j, nout3) = r - s + r = s1 - s3 + s = r2 - r4 + zout(2, j, nout2) = r - s + zout(2, j, nout4) = r + s END DO END DO END IF @@ -1659,25 +1659,25 @@ SUBROUTINE fftpre(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign ELSE IF (now == 8) THEN IF (isign == -1) THEN ia = 1 - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nin5 = nin4+atb - nin6 = nin5+atb - nin7 = nin6+atb - nin8 = nin7+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after - nout5 = nout4+after - nout6 = nout5+after - nout7 = nout6+after - nout8 = nout7+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nin6 = nin5 + atb + nin7 = nin6 + atb + nin8 = nin7 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after + nout6 = nout5 + after + nout7 = nout6 + after + nout8 = nout7 + after DO j = 1, nfft r1 = zin(1, nin1, j) s1 = zin(2, nin1, j) @@ -1695,81 +1695,81 @@ SUBROUTINE fftpre(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s7 = zin(2, nin7, j) r8 = zin(1, nin8, j) s8 = zin(2, nin8, j) - r = r1+r5 - s = r3+r7 - ap = r+s - am = r-s - r = r2+r6 - s = r4+r8 - bp = r+s - bm = r-s - r = s1+s5 - s = s3+s7 - cp = r+s - cm = r-s - r = s2+s6 - s = s4+s8 - dbl = r+s - dm = r-s - zout(1, j, nout1) = ap+bp - zout(2, j, nout1) = cp+dbl - zout(1, j, nout5) = ap-bp - zout(2, j, nout5) = cp-dbl - zout(1, j, nout3) = am+dm - zout(2, j, nout3) = cm-bm - zout(1, j, nout7) = am-dm - zout(2, j, nout7) = cm+bm - r = r1-r5 - s = s3-s7 - ap = r+s - am = r-s - r = s1-s5 - s = r3-r7 - bp = r+s - bm = r-s - r = s4-s8 - s = r2-r6 - cp = r+s - cm = r-s - r = s2-s6 - s = r4-r8 - dbl = r+s - dm = r-s - r = (cp+dm)*rt2i - s = (-cp+dm)*rt2i - cp = (cm+dbl)*rt2i - dbl = (cm-dbl)*rt2i - zout(1, j, nout2) = ap+r - zout(2, j, nout2) = bm+s - zout(1, j, nout6) = ap-r - zout(2, j, nout6) = bm-s - zout(1, j, nout4) = am+cp - zout(2, j, nout4) = bp+dbl - zout(1, j, nout8) = am-cp - zout(2, j, nout8) = bp-dbl + r = r1 + r5 + s = r3 + r7 + ap = r + s + am = r - s + r = r2 + r6 + s = r4 + r8 + bp = r + s + bm = r - s + r = s1 + s5 + s = s3 + s7 + cp = r + s + cm = r - s + r = s2 + s6 + s = s4 + s8 + dbl = r + s + dm = r - s + zout(1, j, nout1) = ap + bp + zout(2, j, nout1) = cp + dbl + zout(1, j, nout5) = ap - bp + zout(2, j, nout5) = cp - dbl + zout(1, j, nout3) = am + dm + zout(2, j, nout3) = cm - bm + zout(1, j, nout7) = am - dm + zout(2, j, nout7) = cm + bm + r = r1 - r5 + s = s3 - s7 + ap = r + s + am = r - s + r = s1 - s5 + s = r3 - r7 + bp = r + s + bm = r - s + r = s4 - s8 + s = r2 - r6 + cp = r + s + cm = r - s + r = s2 - s6 + s = r4 - r8 + dbl = r + s + dm = r - s + r = (cp + dm)*rt2i + s = (-cp + dm)*rt2i + cp = (cm + dbl)*rt2i + dbl = (cm - dbl)*rt2i + zout(1, j, nout2) = ap + r + zout(2, j, nout2) = bm + s + zout(1, j, nout6) = ap - r + zout(2, j, nout6) = bm - s + zout(1, j, nout4) = am + cp + zout(2, j, nout4) = bp + dbl + zout(1, j, nout8) = am - cp + zout(2, j, nout8) = bp - dbl END DO END DO ELSE ia = 1 - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nin5 = nin4+atb - nin6 = nin5+atb - nin7 = nin6+atb - nin8 = nin7+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after - nout5 = nout4+after - nout6 = nout5+after - nout7 = nout6+after - nout8 = nout7+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nin6 = nin5 + atb + nin7 = nin6 + atb + nin8 = nin7 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after + nout6 = nout5 + after + nout7 = nout6 + after + nout8 = nout7 + after DO j = 1, nfft r1 = zin(1, nin1, j) s1 = zin(2, nin1, j) @@ -1787,73 +1787,73 @@ SUBROUTINE fftpre(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s7 = zin(2, nin7, j) r8 = zin(1, nin8, j) s8 = zin(2, nin8, j) - r = r1+r5 - s = r3+r7 - ap = r+s - am = r-s - r = r2+r6 - s = r4+r8 - bp = r+s - bm = r-s - r = s1+s5 - s = s3+s7 - cp = r+s - cm = r-s - r = s2+s6 - s = s4+s8 - dbl = r+s - dm = r-s - zout(1, j, nout1) = ap+bp - zout(2, j, nout1) = cp+dbl - zout(1, j, nout5) = ap-bp - zout(2, j, nout5) = cp-dbl - zout(1, j, nout3) = am-dm - zout(2, j, nout3) = cm+bm - zout(1, j, nout7) = am+dm - zout(2, j, nout7) = cm-bm - r = r1-r5 - s = -s3+s7 - ap = r+s - am = r-s - r = s1-s5 - s = r7-r3 - bp = r+s - bm = r-s - r = -s4+s8 - s = r2-r6 - cp = r+s - cm = r-s - r = -s2+s6 - s = r4-r8 - dbl = r+s - dm = r-s - r = (cp+dm)*rt2i - s = (cp-dm)*rt2i - cp = (cm+dbl)*rt2i - dbl = (-cm+dbl)*rt2i - zout(1, j, nout2) = ap+r - zout(2, j, nout2) = bm+s - zout(1, j, nout6) = ap-r - zout(2, j, nout6) = bm-s - zout(1, j, nout4) = am+cp - zout(2, j, nout4) = bp+dbl - zout(1, j, nout8) = am-cp - zout(2, j, nout8) = bp-dbl + r = r1 + r5 + s = r3 + r7 + ap = r + s + am = r - s + r = r2 + r6 + s = r4 + r8 + bp = r + s + bm = r - s + r = s1 + s5 + s = s3 + s7 + cp = r + s + cm = r - s + r = s2 + s6 + s = s4 + s8 + dbl = r + s + dm = r - s + zout(1, j, nout1) = ap + bp + zout(2, j, nout1) = cp + dbl + zout(1, j, nout5) = ap - bp + zout(2, j, nout5) = cp - dbl + zout(1, j, nout3) = am - dm + zout(2, j, nout3) = cm + bm + zout(1, j, nout7) = am + dm + zout(2, j, nout7) = cm - bm + r = r1 - r5 + s = -s3 + s7 + ap = r + s + am = r - s + r = s1 - s5 + s = r7 - r3 + bp = r + s + bm = r - s + r = -s4 + s8 + s = r2 - r6 + cp = r + s + cm = r - s + r = -s2 + s6 + s = r4 - r8 + dbl = r + s + dm = r - s + r = (cp + dm)*rt2i + s = (cp - dm)*rt2i + cp = (cm + dbl)*rt2i + dbl = (-cm + dbl)*rt2i + zout(1, j, nout2) = ap + r + zout(2, j, nout2) = bm + s + zout(1, j, nout6) = ap - r + zout(2, j, nout6) = bm - s + zout(1, j, nout4) = am + cp + zout(2, j, nout4) = bp + dbl + zout(1, j, nout8) = am - cp + zout(2, j, nout8) = bp - dbl END DO END DO END IF ELSE IF (now == 3) THEN ia = 1 - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn bbs = isign*bb DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after DO j = 1, nfft r1 = zin(1, nin1, j) s1 = zin(2, nin1, j) @@ -1861,33 +1861,33 @@ SUBROUTINE fftpre(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s2 = zin(2, nin2, j) r3 = zin(1, nin3, j) s3 = zin(2, nin3, j) - r = r2+r3 - s = s2+s3 - zout(1, j, nout1) = r+r1 - zout(2, j, nout1) = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r2 = bbs*(r2-r3) - s2 = bbs*(s2-s3) - zout(1, j, nout2) = r1-s2 - zout(2, j, nout2) = s1+r2 - zout(1, j, nout3) = r1+s2 - zout(2, j, nout3) = s1-r2 + r = r2 + r3 + s = s2 + s3 + zout(1, j, nout1) = r + r1 + zout(2, j, nout1) = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r2 = bbs*(r2 - r3) + s2 = bbs*(s2 - s3) + zout(1, j, nout2) = r1 - s2 + zout(2, j, nout2) = s1 + r2 + zout(1, j, nout3) = r1 + s2 + zout(2, j, nout3) = s1 - r2 END DO END DO DO ia = 2, after - ias = ia-1 + ias = ia - 1 IF (4*ias == 3*after) THEN IF (isign == 1) THEN - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after DO j = 1, nfft r1 = zin(1, nin1, j) s1 = zin(2, nin1, j) @@ -1895,30 +1895,30 @@ SUBROUTINE fftpre(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s2 = zin(1, nin2, j) r3 = -zin(1, nin3, j) s3 = -zin(2, nin3, j) - r = r2+r3 - s = s2+s3 - zout(1, j, nout1) = r+r1 - zout(2, j, nout1) = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r2 = bbs*(r2-r3) - s2 = bbs*(s2-s3) - zout(1, j, nout2) = r1-s2 - zout(2, j, nout2) = s1+r2 - zout(1, j, nout3) = r1+s2 - zout(2, j, nout3) = s1-r2 + r = r2 + r3 + s = s2 + s3 + zout(1, j, nout1) = r + r1 + zout(2, j, nout1) = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r2 = bbs*(r2 - r3) + s2 = bbs*(s2 - s3) + zout(1, j, nout2) = r1 - s2 + zout(2, j, nout2) = s1 + r2 + zout(1, j, nout3) = r1 + s2 + zout(2, j, nout3) = s1 - r2 END DO END DO ELSE - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after DO j = 1, nfft r1 = zin(1, nin1, j) s1 = zin(2, nin1, j) @@ -1926,129 +1926,129 @@ SUBROUTINE fftpre(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s2 = -zin(1, nin2, j) r3 = -zin(1, nin3, j) s3 = -zin(2, nin3, j) - r = r2+r3 - s = s2+s3 - zout(1, j, nout1) = r+r1 - zout(2, j, nout1) = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r2 = bbs*(r2-r3) - s2 = bbs*(s2-s3) - zout(1, j, nout2) = r1-s2 - zout(2, j, nout2) = s1+r2 - zout(1, j, nout3) = r1+s2 - zout(2, j, nout3) = s1-r2 + r = r2 + r3 + s = s2 + s3 + zout(1, j, nout1) = r + r1 + zout(2, j, nout1) = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r2 = bbs*(r2 - r3) + s2 = bbs*(s2 - s3) + zout(1, j, nout2) = r1 - s2 + zout(2, j, nout2) = s1 + r2 + zout(1, j, nout3) = r1 + s2 + zout(2, j, nout3) = s1 - r2 END DO END DO END IF ELSE IF (8*ias == 3*after) THEN IF (isign == 1) THEN - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after DO j = 1, nfft r1 = zin(1, nin1, j) s1 = zin(2, nin1, j) r = zin(1, nin2, j) s = zin(2, nin2, j) - r2 = (r-s)*rt2i - s2 = (r+s)*rt2i + r2 = (r - s)*rt2i + s2 = (r + s)*rt2i r3 = -zin(2, nin3, j) s3 = zin(1, nin3, j) - r = r2+r3 - s = s2+s3 - zout(1, j, nout1) = r+r1 - zout(2, j, nout1) = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r2 = bbs*(r2-r3) - s2 = bbs*(s2-s3) - zout(1, j, nout2) = r1-s2 - zout(2, j, nout2) = s1+r2 - zout(1, j, nout3) = r1+s2 - zout(2, j, nout3) = s1-r2 + r = r2 + r3 + s = s2 + s3 + zout(1, j, nout1) = r + r1 + zout(2, j, nout1) = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r2 = bbs*(r2 - r3) + s2 = bbs*(s2 - s3) + zout(1, j, nout2) = r1 - s2 + zout(2, j, nout2) = s1 + r2 + zout(1, j, nout3) = r1 + s2 + zout(2, j, nout3) = s1 - r2 END DO END DO ELSE - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after DO j = 1, nfft r1 = zin(1, nin1, j) s1 = zin(2, nin1, j) r = zin(1, nin2, j) s = zin(2, nin2, j) - r2 = (r+s)*rt2i - s2 = (-r+s)*rt2i + r2 = (r + s)*rt2i + s2 = (-r + s)*rt2i r3 = zin(2, nin3, j) s3 = -zin(1, nin3, j) - r = r2+r3 - s = s2+s3 - zout(1, j, nout1) = r+r1 - zout(2, j, nout1) = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r2 = bbs*(r2-r3) - s2 = bbs*(s2-s3) - zout(1, j, nout2) = r1-s2 - zout(2, j, nout2) = s1+r2 - zout(1, j, nout3) = r1+s2 - zout(2, j, nout3) = s1-r2 + r = r2 + r3 + s = s2 + s3 + zout(1, j, nout1) = r + r1 + zout(2, j, nout1) = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r2 = bbs*(r2 - r3) + s2 = bbs*(s2 - s3) + zout(1, j, nout2) = r1 - s2 + zout(2, j, nout2) = s1 + r2 + zout(1, j, nout3) = r1 + s2 + zout(2, j, nout3) = s1 - r2 END DO END DO END IF ELSE itt = ias*before - itrig = itt+1 + itrig = itt + 1 cr2 = trig(1, itrig) ci2 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr3 = trig(1, itrig) ci3 = trig(2, itrig) - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after DO j = 1, nfft r1 = zin(1, nin1, j) s1 = zin(2, nin1, j) r = zin(1, nin2, j) s = zin(2, nin2, j) - r2 = r*cr2-s*ci2 - s2 = r*ci2+s*cr2 + r2 = r*cr2 - s*ci2 + s2 = r*ci2 + s*cr2 r = zin(1, nin3, j) s = zin(2, nin3, j) - r3 = r*cr3-s*ci3 - s3 = r*ci3+s*cr3 - r = r2+r3 - s = s2+s3 - zout(1, j, nout1) = r+r1 - zout(2, j, nout1) = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r2 = bbs*(r2-r3) - s2 = bbs*(s2-s3) - zout(1, j, nout2) = r1-s2 - zout(2, j, nout2) = s1+r2 - zout(1, j, nout3) = r1+s2 - zout(2, j, nout3) = s1-r2 + r3 = r*cr3 - s*ci3 + s3 = r*ci3 + s*cr3 + r = r2 + r3 + s = s2 + s3 + zout(1, j, nout1) = r + r1 + zout(2, j, nout1) = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r2 = bbs*(r2 - r3) + s2 = bbs*(s2 - s3) + zout(1, j, nout2) = r1 - s2 + zout(2, j, nout2) = s1 + r2 + zout(1, j, nout3) = r1 + s2 + zout(2, j, nout3) = s1 - r2 END DO END DO END IF @@ -2057,19 +2057,19 @@ SUBROUTINE fftpre(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign sin2 = isign*sin2p sin4 = isign*sin4p ia = 1 - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nin5 = nin4+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after - nout5 = nout4+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after DO j = 1, nfft r1 = zin(1, nin1, j) s1 = zin(2, nin1, j) @@ -2081,225 +2081,225 @@ SUBROUTINE fftpre(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s4 = zin(2, nin4, j) r5 = zin(1, nin5, j) s5 = zin(2, nin5, j) - r25 = r2+r5 - r34 = r3+r4 - s25 = s2-s5 - s34 = s3-s4 - zout(1, j, nout1) = r1+r25+r34 - r = cos2*r25+cos4*r34+r1 - s = sin2*s25+sin4*s34 - zout(1, j, nout2) = r-s - zout(1, j, nout5) = r+s - r = cos4*r25+cos2*r34+r1 - s = sin4*s25-sin2*s34 - zout(1, j, nout3) = r-s - zout(1, j, nout4) = r+s - r25 = r2-r5 - r34 = r3-r4 - s25 = s2+s5 - s34 = s3+s4 - zout(2, j, nout1) = s1+s25+s34 - r = cos2*s25+cos4*s34+s1 - s = sin2*r25+sin4*r34 - zout(2, j, nout2) = r+s - zout(2, j, nout5) = r-s - r = cos4*s25+cos2*s34+s1 - s = sin4*r25-sin2*r34 - zout(2, j, nout3) = r+s - zout(2, j, nout4) = r-s + r25 = r2 + r5 + r34 = r3 + r4 + s25 = s2 - s5 + s34 = s3 - s4 + zout(1, j, nout1) = r1 + r25 + r34 + r = cos2*r25 + cos4*r34 + r1 + s = sin2*s25 + sin4*s34 + zout(1, j, nout2) = r - s + zout(1, j, nout5) = r + s + r = cos4*r25 + cos2*r34 + r1 + s = sin4*s25 - sin2*s34 + zout(1, j, nout3) = r - s + zout(1, j, nout4) = r + s + r25 = r2 - r5 + r34 = r3 - r4 + s25 = s2 + s5 + s34 = s3 + s4 + zout(2, j, nout1) = s1 + s25 + s34 + r = cos2*s25 + cos4*s34 + s1 + s = sin2*r25 + sin4*r34 + zout(2, j, nout2) = r + s + zout(2, j, nout5) = r - s + r = cos4*s25 + cos2*s34 + s1 + s = sin4*r25 - sin2*r34 + zout(2, j, nout3) = r + s + zout(2, j, nout4) = r - s END DO END DO DO ia = 2, after - ias = ia-1 + ias = ia - 1 IF (8*ias == 5*after) THEN IF (isign == 1) THEN - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nin5 = nin4+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after - nout5 = nout4+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after DO j = 1, nfft r1 = zin(1, nin1, j) s1 = zin(2, nin1, j) r = zin(1, nin2, j) s = zin(2, nin2, j) - r2 = (r-s)*rt2i - s2 = (r+s)*rt2i + r2 = (r - s)*rt2i + s2 = (r + s)*rt2i r3 = -zin(2, nin3, j) s3 = zin(1, nin3, j) r = zin(1, nin4, j) s = zin(2, nin4, j) - r4 = -(r+s)*rt2i - s4 = (r-s)*rt2i + r4 = -(r + s)*rt2i + s4 = (r - s)*rt2i r5 = -zin(1, nin5, j) s5 = -zin(2, nin5, j) - r25 = r2+r5 - r34 = r3+r4 - s25 = s2-s5 - s34 = s3-s4 - zout(1, j, nout1) = r1+r25+r34 - r = cos2*r25+cos4*r34+r1 - s = sin2*s25+sin4*s34 - zout(1, j, nout2) = r-s - zout(1, j, nout5) = r+s - r = cos4*r25+cos2*r34+r1 - s = sin4*s25-sin2*s34 - zout(1, j, nout3) = r-s - zout(1, j, nout4) = r+s - r25 = r2-r5 - r34 = r3-r4 - s25 = s2+s5 - s34 = s3+s4 - zout(2, j, nout1) = s1+s25+s34 - r = cos2*s25+cos4*s34+s1 - s = sin2*r25+sin4*r34 - zout(2, j, nout2) = r+s - zout(2, j, nout5) = r-s - r = cos4*s25+cos2*s34+s1 - s = sin4*r25-sin2*r34 - zout(2, j, nout3) = r+s - zout(2, j, nout4) = r-s + r25 = r2 + r5 + r34 = r3 + r4 + s25 = s2 - s5 + s34 = s3 - s4 + zout(1, j, nout1) = r1 + r25 + r34 + r = cos2*r25 + cos4*r34 + r1 + s = sin2*s25 + sin4*s34 + zout(1, j, nout2) = r - s + zout(1, j, nout5) = r + s + r = cos4*r25 + cos2*r34 + r1 + s = sin4*s25 - sin2*s34 + zout(1, j, nout3) = r - s + zout(1, j, nout4) = r + s + r25 = r2 - r5 + r34 = r3 - r4 + s25 = s2 + s5 + s34 = s3 + s4 + zout(2, j, nout1) = s1 + s25 + s34 + r = cos2*s25 + cos4*s34 + s1 + s = sin2*r25 + sin4*r34 + zout(2, j, nout2) = r + s + zout(2, j, nout5) = r - s + r = cos4*s25 + cos2*s34 + s1 + s = sin4*r25 - sin2*r34 + zout(2, j, nout3) = r + s + zout(2, j, nout4) = r - s END DO END DO ELSE - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nin5 = nin4+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after - nout5 = nout4+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after DO j = 1, nfft r1 = zin(1, nin1, j) s1 = zin(2, nin1, j) r = zin(1, nin2, j) s = zin(2, nin2, j) - r2 = (r+s)*rt2i - s2 = (-r+s)*rt2i + r2 = (r + s)*rt2i + s2 = (-r + s)*rt2i r3 = zin(2, nin3, j) s3 = -zin(1, nin3, j) r = zin(1, nin4, j) s = zin(2, nin4, j) - r4 = (s-r)*rt2i - s4 = -(r+s)*rt2i + r4 = (s - r)*rt2i + s4 = -(r + s)*rt2i r5 = -zin(1, nin5, j) s5 = -zin(2, nin5, j) - r25 = r2+r5 - r34 = r3+r4 - s25 = s2-s5 - s34 = s3-s4 - zout(1, j, nout1) = r1+r25+r34 - r = cos2*r25+cos4*r34+r1 - s = sin2*s25+sin4*s34 - zout(1, j, nout2) = r-s - zout(1, j, nout5) = r+s - r = cos4*r25+cos2*r34+r1 - s = sin4*s25-sin2*s34 - zout(1, j, nout3) = r-s - zout(1, j, nout4) = r+s - r25 = r2-r5 - r34 = r3-r4 - s25 = s2+s5 - s34 = s3+s4 - zout(2, j, nout1) = s1+s25+s34 - r = cos2*s25+cos4*s34+s1 - s = sin2*r25+sin4*r34 - zout(2, j, nout2) = r+s - zout(2, j, nout5) = r-s - r = cos4*s25+cos2*s34+s1 - s = sin4*r25-sin2*r34 - zout(2, j, nout3) = r+s - zout(2, j, nout4) = r-s + r25 = r2 + r5 + r34 = r3 + r4 + s25 = s2 - s5 + s34 = s3 - s4 + zout(1, j, nout1) = r1 + r25 + r34 + r = cos2*r25 + cos4*r34 + r1 + s = sin2*s25 + sin4*s34 + zout(1, j, nout2) = r - s + zout(1, j, nout5) = r + s + r = cos4*r25 + cos2*r34 + r1 + s = sin4*s25 - sin2*s34 + zout(1, j, nout3) = r - s + zout(1, j, nout4) = r + s + r25 = r2 - r5 + r34 = r3 - r4 + s25 = s2 + s5 + s34 = s3 + s4 + zout(2, j, nout1) = s1 + s25 + s34 + r = cos2*s25 + cos4*s34 + s1 + s = sin2*r25 + sin4*r34 + zout(2, j, nout2) = r + s + zout(2, j, nout5) = r - s + r = cos4*s25 + cos2*s34 + s1 + s = sin4*r25 - sin2*r34 + zout(2, j, nout3) = r + s + zout(2, j, nout4) = r - s END DO END DO END IF ELSE - ias = ia-1 + ias = ia - 1 itt = ias*before - itrig = itt+1 + itrig = itt + 1 cr2 = trig(1, itrig) ci2 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr3 = trig(1, itrig) ci3 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr4 = trig(1, itrig) ci4 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr5 = trig(1, itrig) ci5 = trig(2, itrig) - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nin5 = nin4+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after - nout5 = nout4+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after DO j = 1, nfft r1 = zin(1, nin1, j) s1 = zin(2, nin1, j) r = zin(1, nin2, j) s = zin(2, nin2, j) - r2 = r*cr2-s*ci2 - s2 = r*ci2+s*cr2 + r2 = r*cr2 - s*ci2 + s2 = r*ci2 + s*cr2 r = zin(1, nin3, j) s = zin(2, nin3, j) - r3 = r*cr3-s*ci3 - s3 = r*ci3+s*cr3 + r3 = r*cr3 - s*ci3 + s3 = r*ci3 + s*cr3 r = zin(1, nin4, j) s = zin(2, nin4, j) - r4 = r*cr4-s*ci4 - s4 = r*ci4+s*cr4 + r4 = r*cr4 - s*ci4 + s4 = r*ci4 + s*cr4 r = zin(1, nin5, j) s = zin(2, nin5, j) - r5 = r*cr5-s*ci5 - s5 = r*ci5+s*cr5 - r25 = r2+r5 - r34 = r3+r4 - s25 = s2-s5 - s34 = s3-s4 - zout(1, j, nout1) = r1+r25+r34 - r = cos2*r25+cos4*r34+r1 - s = sin2*s25+sin4*s34 - zout(1, j, nout2) = r-s - zout(1, j, nout5) = r+s - r = cos4*r25+cos2*r34+r1 - s = sin4*s25-sin2*s34 - zout(1, j, nout3) = r-s - zout(1, j, nout4) = r+s - r25 = r2-r5 - r34 = r3-r4 - s25 = s2+s5 - s34 = s3+s4 - zout(2, j, nout1) = s1+s25+s34 - r = cos2*s25+cos4*s34+s1 - s = sin2*r25+sin4*r34 - zout(2, j, nout2) = r+s - zout(2, j, nout5) = r-s - r = cos4*s25+cos2*s34+s1 - s = sin4*r25-sin2*r34 - zout(2, j, nout3) = r+s - zout(2, j, nout4) = r-s + r5 = r*cr5 - s*ci5 + s5 = r*ci5 + s*cr5 + r25 = r2 + r5 + r34 = r3 + r4 + s25 = s2 - s5 + s34 = s3 - s4 + zout(1, j, nout1) = r1 + r25 + r34 + r = cos2*r25 + cos4*r34 + r1 + s = sin2*s25 + sin4*s34 + zout(1, j, nout2) = r - s + zout(1, j, nout5) = r + s + r = cos4*r25 + cos2*r34 + r1 + s = sin4*s25 - sin2*s34 + zout(1, j, nout3) = r - s + zout(1, j, nout4) = r + s + r25 = r2 - r5 + r34 = r3 - r4 + s25 = s2 + s5 + s34 = s3 + s4 + zout(2, j, nout1) = s1 + s25 + s34 + r = cos2*s25 + cos4*s34 + s1 + s = sin2*r25 + sin4*r34 + zout(2, j, nout2) = r + s + zout(2, j, nout5) = r - s + r = cos4*s25 + cos2*s34 + s1 + s = sin4*r25 - sin2*r34 + zout(2, j, nout3) = r + s + zout(2, j, nout4) = r - s END DO END DO END IF @@ -2307,72 +2307,72 @@ SUBROUTINE fftpre(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign ELSE IF (now == 6) THEN bbs = isign*bb ia = 1 - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nin5 = nin4+atb - nin6 = nin5+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after - nout5 = nout4+after - nout6 = nout5+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nin6 = nin5 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after + nout6 = nout5 + after DO j = 1, nfft r2 = zin(1, nin3, j) s2 = zin(2, nin3, j) r3 = zin(1, nin5, j) s3 = zin(2, nin5, j) - r = r2+r3 - s = s2+s3 + r = r2 + r3 + s = s2 + s3 r1 = zin(1, nin1, j) s1 = zin(2, nin1, j) - ur1 = r+r1 - ui1 = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r = r2-r3 - s = s2-s3 - ur2 = r1-s*bbs - ui2 = s1+r*bbs - ur3 = r1+s*bbs - ui3 = s1-r*bbs + ur1 = r + r1 + ui1 = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r = r2 - r3 + s = s2 - s3 + ur2 = r1 - s*bbs + ui2 = s1 + r*bbs + ur3 = r1 + s*bbs + ui3 = s1 - r*bbs r2 = zin(1, nin6, j) s2 = zin(2, nin6, j) r3 = zin(1, nin2, j) s3 = zin(2, nin2, j) - r = r2+r3 - s = s2+s3 + r = r2 + r3 + s = s2 + s3 r1 = zin(1, nin4, j) s1 = zin(2, nin4, j) - vr1 = r+r1 - vi1 = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r = r2-r3 - s = s2-s3 - vr2 = r1-s*bbs - vi2 = s1+r*bbs - vr3 = r1+s*bbs - vi3 = s1-r*bbs - - zout(1, j, nout1) = ur1+vr1 - zout(2, j, nout1) = ui1+vi1 - zout(1, j, nout5) = ur2+vr2 - zout(2, j, nout5) = ui2+vi2 - zout(1, j, nout3) = ur3+vr3 - zout(2, j, nout3) = ui3+vi3 - zout(1, j, nout4) = ur1-vr1 - zout(2, j, nout4) = ui1-vi1 - zout(1, j, nout2) = ur2-vr2 - zout(2, j, nout2) = ui2-vi2 - zout(1, j, nout6) = ur3-vr3 - zout(2, j, nout6) = ui3-vi3 + vr1 = r + r1 + vi1 = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r = r2 - r3 + s = s2 - s3 + vr2 = r1 - s*bbs + vi2 = s1 + r*bbs + vr3 = r1 + s*bbs + vi3 = s1 - r*bbs + + zout(1, j, nout1) = ur1 + vr1 + zout(2, j, nout1) = ui1 + vi1 + zout(1, j, nout5) = ur2 + vr2 + zout(2, j, nout5) = ui2 + vi2 + zout(1, j, nout3) = ur3 + vr3 + zout(2, j, nout3) = ui3 + vi3 + zout(1, j, nout4) = ur1 - vr1 + zout(2, j, nout4) = ui1 - vi1 + zout(1, j, nout2) = ur2 - vr2 + zout(2, j, nout2) = ui2 - vi2 + zout(1, j, nout6) = ur3 - vr3 + zout(2, j, nout6) = ui3 - vi3 END DO END DO ELSE @@ -2445,17 +2445,17 @@ SUBROUTINE fftstp(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign IF (now == 4) THEN IF (isign == 1) THEN ia = 1 - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) @@ -2465,139 +2465,139 @@ SUBROUTINE fftstp(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s3 = zin(2, j, nin3) r4 = zin(1, j, nin4) s4 = zin(2, j, nin4) - r = r1+r3 - s = r2+r4 - zout(1, j, nout1) = r+s - zout(1, j, nout3) = r-s - r = r1-r3 - s = s2-s4 - zout(1, j, nout2) = r-s - zout(1, j, nout4) = r+s - r = s1+s3 - s = s2+s4 - zout(2, j, nout1) = r+s - zout(2, j, nout3) = r-s - r = s1-s3 - s = r2-r4 - zout(2, j, nout2) = r+s - zout(2, j, nout4) = r-s + r = r1 + r3 + s = r2 + r4 + zout(1, j, nout1) = r + s + zout(1, j, nout3) = r - s + r = r1 - r3 + s = s2 - s4 + zout(1, j, nout2) = r - s + zout(1, j, nout4) = r + s + r = s1 + s3 + s = s2 + s4 + zout(2, j, nout1) = r + s + zout(2, j, nout3) = r - s + r = s1 - s3 + s = r2 - r4 + zout(2, j, nout2) = r + s + zout(2, j, nout4) = r - s END DO END DO DO ia = 2, after - ias = ia-1 + ias = ia - 1 IF (2*ias == after) THEN - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) r = zin(1, j, nin2) s = zin(2, j, nin2) - r2 = (r-s)*rt2i - s2 = (r+s)*rt2i + r2 = (r - s)*rt2i + s2 = (r + s)*rt2i r3 = -zin(2, j, nin3) s3 = zin(1, j, nin3) r = zin(1, j, nin4) s = zin(2, j, nin4) - r4 = -(r+s)*rt2i - s4 = (r-s)*rt2i - r = r1+r3 - s = r2+r4 - zout(1, j, nout1) = r+s - zout(1, j, nout3) = r-s - r = r1-r3 - s = s2-s4 - zout(1, j, nout2) = r-s - zout(1, j, nout4) = r+s - r = s1+s3 - s = s2+s4 - zout(2, j, nout1) = r+s - zout(2, j, nout3) = r-s - r = s1-s3 - s = r2-r4 - zout(2, j, nout2) = r+s - zout(2, j, nout4) = r-s + r4 = -(r + s)*rt2i + s4 = (r - s)*rt2i + r = r1 + r3 + s = r2 + r4 + zout(1, j, nout1) = r + s + zout(1, j, nout3) = r - s + r = r1 - r3 + s = s2 - s4 + zout(1, j, nout2) = r - s + zout(1, j, nout4) = r + s + r = s1 + s3 + s = s2 + s4 + zout(2, j, nout1) = r + s + zout(2, j, nout3) = r - s + r = s1 - s3 + s = r2 - r4 + zout(2, j, nout2) = r + s + zout(2, j, nout4) = r - s END DO END DO ELSE itt = ias*before - itrig = itt+1 + itrig = itt + 1 cr2 = trig(1, itrig) ci2 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr3 = trig(1, itrig) ci3 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr4 = trig(1, itrig) ci4 = trig(2, itrig) - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) r = zin(1, j, nin2) s = zin(2, j, nin2) - r2 = r*cr2-s*ci2 - s2 = r*ci2+s*cr2 + r2 = r*cr2 - s*ci2 + s2 = r*ci2 + s*cr2 r = zin(1, j, nin3) s = zin(2, j, nin3) - r3 = r*cr3-s*ci3 - s3 = r*ci3+s*cr3 + r3 = r*cr3 - s*ci3 + s3 = r*ci3 + s*cr3 r = zin(1, j, nin4) s = zin(2, j, nin4) - r4 = r*cr4-s*ci4 - s4 = r*ci4+s*cr4 - r = r1+r3 - s = r2+r4 - zout(1, j, nout1) = r+s - zout(1, j, nout3) = r-s - r = r1-r3 - s = s2-s4 - zout(1, j, nout2) = r-s - zout(1, j, nout4) = r+s - r = s1+s3 - s = s2+s4 - zout(2, j, nout1) = r+s - zout(2, j, nout3) = r-s - r = s1-s3 - s = r2-r4 - zout(2, j, nout2) = r+s - zout(2, j, nout4) = r-s + r4 = r*cr4 - s*ci4 + s4 = r*ci4 + s*cr4 + r = r1 + r3 + s = r2 + r4 + zout(1, j, nout1) = r + s + zout(1, j, nout3) = r - s + r = r1 - r3 + s = s2 - s4 + zout(1, j, nout2) = r - s + zout(1, j, nout4) = r + s + r = s1 + s3 + s = s2 + s4 + zout(2, j, nout1) = r + s + zout(2, j, nout3) = r - s + r = s1 - s3 + s = r2 - r4 + zout(2, j, nout2) = r + s + zout(2, j, nout4) = r - s END DO END DO END IF END DO ELSE ia = 1 - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) @@ -2607,122 +2607,122 @@ SUBROUTINE fftstp(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s3 = zin(2, j, nin3) r4 = zin(1, j, nin4) s4 = zin(2, j, nin4) - r = r1+r3 - s = r2+r4 - zout(1, j, nout1) = r+s - zout(1, j, nout3) = r-s - r = r1-r3 - s = s2-s4 - zout(1, j, nout2) = r+s - zout(1, j, nout4) = r-s - r = s1+s3 - s = s2+s4 - zout(2, j, nout1) = r+s - zout(2, j, nout3) = r-s - r = s1-s3 - s = r2-r4 - zout(2, j, nout2) = r-s - zout(2, j, nout4) = r+s + r = r1 + r3 + s = r2 + r4 + zout(1, j, nout1) = r + s + zout(1, j, nout3) = r - s + r = r1 - r3 + s = s2 - s4 + zout(1, j, nout2) = r + s + zout(1, j, nout4) = r - s + r = s1 + s3 + s = s2 + s4 + zout(2, j, nout1) = r + s + zout(2, j, nout3) = r - s + r = s1 - s3 + s = r2 - r4 + zout(2, j, nout2) = r - s + zout(2, j, nout4) = r + s END DO END DO DO ia = 2, after - ias = ia-1 + ias = ia - 1 IF (2*ias == after) THEN - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) r = zin(1, j, nin2) s = zin(2, j, nin2) - r2 = (r+s)*rt2i - s2 = (s-r)*rt2i + r2 = (r + s)*rt2i + s2 = (s - r)*rt2i r3 = zin(2, j, nin3) s3 = -zin(1, j, nin3) r = zin(1, j, nin4) s = zin(2, j, nin4) - r4 = (s-r)*rt2i - s4 = -(r+s)*rt2i - r = r1+r3 - s = r2+r4 - zout(1, j, nout1) = r+s - zout(1, j, nout3) = r-s - r = r1-r3 - s = s2-s4 - zout(1, j, nout2) = r+s - zout(1, j, nout4) = r-s - r = s1+s3 - s = s2+s4 - zout(2, j, nout1) = r+s - zout(2, j, nout3) = r-s - r = s1-s3 - s = r2-r4 - zout(2, j, nout2) = r-s - zout(2, j, nout4) = r+s + r4 = (s - r)*rt2i + s4 = -(r + s)*rt2i + r = r1 + r3 + s = r2 + r4 + zout(1, j, nout1) = r + s + zout(1, j, nout3) = r - s + r = r1 - r3 + s = s2 - s4 + zout(1, j, nout2) = r + s + zout(1, j, nout4) = r - s + r = s1 + s3 + s = s2 + s4 + zout(2, j, nout1) = r + s + zout(2, j, nout3) = r - s + r = s1 - s3 + s = r2 - r4 + zout(2, j, nout2) = r - s + zout(2, j, nout4) = r + s END DO END DO ELSE itt = ias*before - itrig = itt+1 + itrig = itt + 1 cr2 = trig(1, itrig) ci2 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr3 = trig(1, itrig) ci3 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr4 = trig(1, itrig) ci4 = trig(2, itrig) - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) r = zin(1, j, nin2) s = zin(2, j, nin2) - r2 = r*cr2-s*ci2 - s2 = r*ci2+s*cr2 + r2 = r*cr2 - s*ci2 + s2 = r*ci2 + s*cr2 r = zin(1, j, nin3) s = zin(2, j, nin3) - r3 = r*cr3-s*ci3 - s3 = r*ci3+s*cr3 + r3 = r*cr3 - s*ci3 + s3 = r*ci3 + s*cr3 r = zin(1, j, nin4) s = zin(2, j, nin4) - r4 = r*cr4-s*ci4 - s4 = r*ci4+s*cr4 - r = r1+r3 - s = r2+r4 - zout(1, j, nout1) = r+s - zout(1, j, nout3) = r-s - r = r1-r3 - s = s2-s4 - zout(1, j, nout2) = r+s - zout(1, j, nout4) = r-s - r = s1+s3 - s = s2+s4 - zout(2, j, nout1) = r+s - zout(2, j, nout3) = r-s - r = s1-s3 - s = r2-r4 - zout(2, j, nout2) = r-s - zout(2, j, nout4) = r+s + r4 = r*cr4 - s*ci4 + s4 = r*ci4 + s*cr4 + r = r1 + r3 + s = r2 + r4 + zout(1, j, nout1) = r + s + zout(1, j, nout3) = r - s + r = r1 - r3 + s = s2 - s4 + zout(1, j, nout2) = r + s + zout(1, j, nout4) = r - s + r = s1 + s3 + s = s2 + s4 + zout(2, j, nout1) = r + s + zout(2, j, nout3) = r - s + r = s1 - s3 + s = r2 - r4 + zout(2, j, nout2) = r - s + zout(2, j, nout4) = r + s END DO END DO END IF @@ -2731,25 +2731,25 @@ SUBROUTINE fftstp(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign ELSE IF (now == 8) THEN IF (isign == -1) THEN ia = 1 - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nin5 = nin4+atb - nin6 = nin5+atb - nin7 = nin6+atb - nin8 = nin7+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after - nout5 = nout4+after - nout6 = nout5+after - nout7 = nout6+after - nout8 = nout7+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nin6 = nin5 + atb + nin7 = nin6 + atb + nin8 = nin7 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after + nout6 = nout5 + after + nout7 = nout6 + after + nout8 = nout7 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) @@ -2767,81 +2767,81 @@ SUBROUTINE fftstp(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s7 = zin(2, j, nin7) r8 = zin(1, j, nin8) s8 = zin(2, j, nin8) - r = r1+r5 - s = r3+r7 - ap = r+s - am = r-s - r = r2+r6 - s = r4+r8 - bp = r+s - bm = r-s - r = s1+s5 - s = s3+s7 - cp = r+s - cm = r-s - r = s2+s6 - s = s4+s8 - dbl = r+s - dm = r-s - zout(1, j, nout1) = ap+bp - zout(2, j, nout1) = cp+dbl - zout(1, j, nout5) = ap-bp - zout(2, j, nout5) = cp-dbl - zout(1, j, nout3) = am+dm - zout(2, j, nout3) = cm-bm - zout(1, j, nout7) = am-dm - zout(2, j, nout7) = cm+bm - r = r1-r5 - s = s3-s7 - ap = r+s - am = r-s - r = s1-s5 - s = r3-r7 - bp = r+s - bm = r-s - r = s4-s8 - s = r2-r6 - cp = r+s - cm = r-s - r = s2-s6 - s = r4-r8 - dbl = r+s - dm = r-s - r = (cp+dm)*rt2i - s = (-cp+dm)*rt2i - cp = (cm+dbl)*rt2i - dbl = (cm-dbl)*rt2i - zout(1, j, nout2) = ap+r - zout(2, j, nout2) = bm+s - zout(1, j, nout6) = ap-r - zout(2, j, nout6) = bm-s - zout(1, j, nout4) = am+cp - zout(2, j, nout4) = bp+dbl - zout(1, j, nout8) = am-cp - zout(2, j, nout8) = bp-dbl + r = r1 + r5 + s = r3 + r7 + ap = r + s + am = r - s + r = r2 + r6 + s = r4 + r8 + bp = r + s + bm = r - s + r = s1 + s5 + s = s3 + s7 + cp = r + s + cm = r - s + r = s2 + s6 + s = s4 + s8 + dbl = r + s + dm = r - s + zout(1, j, nout1) = ap + bp + zout(2, j, nout1) = cp + dbl + zout(1, j, nout5) = ap - bp + zout(2, j, nout5) = cp - dbl + zout(1, j, nout3) = am + dm + zout(2, j, nout3) = cm - bm + zout(1, j, nout7) = am - dm + zout(2, j, nout7) = cm + bm + r = r1 - r5 + s = s3 - s7 + ap = r + s + am = r - s + r = s1 - s5 + s = r3 - r7 + bp = r + s + bm = r - s + r = s4 - s8 + s = r2 - r6 + cp = r + s + cm = r - s + r = s2 - s6 + s = r4 - r8 + dbl = r + s + dm = r - s + r = (cp + dm)*rt2i + s = (-cp + dm)*rt2i + cp = (cm + dbl)*rt2i + dbl = (cm - dbl)*rt2i + zout(1, j, nout2) = ap + r + zout(2, j, nout2) = bm + s + zout(1, j, nout6) = ap - r + zout(2, j, nout6) = bm - s + zout(1, j, nout4) = am + cp + zout(2, j, nout4) = bp + dbl + zout(1, j, nout8) = am - cp + zout(2, j, nout8) = bp - dbl END DO END DO ELSE ia = 1 - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nin5 = nin4+atb - nin6 = nin5+atb - nin7 = nin6+atb - nin8 = nin7+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after - nout5 = nout4+after - nout6 = nout5+after - nout7 = nout6+after - nout8 = nout7+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nin6 = nin5 + atb + nin7 = nin6 + atb + nin8 = nin7 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after + nout6 = nout5 + after + nout7 = nout6 + after + nout8 = nout7 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) @@ -2859,73 +2859,73 @@ SUBROUTINE fftstp(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s7 = zin(2, j, nin7) r8 = zin(1, j, nin8) s8 = zin(2, j, nin8) - r = r1+r5 - s = r3+r7 - ap = r+s - am = r-s - r = r2+r6 - s = r4+r8 - bp = r+s - bm = r-s - r = s1+s5 - s = s3+s7 - cp = r+s - cm = r-s - r = s2+s6 - s = s4+s8 - dbl = r+s - dm = r-s - zout(1, j, nout1) = ap+bp - zout(2, j, nout1) = cp+dbl - zout(1, j, nout5) = ap-bp - zout(2, j, nout5) = cp-dbl - zout(1, j, nout3) = am-dm - zout(2, j, nout3) = cm+bm - zout(1, j, nout7) = am+dm - zout(2, j, nout7) = cm-bm - r = r1-r5 - s = -s3+s7 - ap = r+s - am = r-s - r = s1-s5 - s = r7-r3 - bp = r+s - bm = r-s - r = -s4+s8 - s = r2-r6 - cp = r+s - cm = r-s - r = -s2+s6 - s = r4-r8 - dbl = r+s - dm = r-s - r = (cp+dm)*rt2i - s = (cp-dm)*rt2i - cp = (cm+dbl)*rt2i - dbl = (-cm+dbl)*rt2i - zout(1, j, nout2) = ap+r - zout(2, j, nout2) = bm+s - zout(1, j, nout6) = ap-r - zout(2, j, nout6) = bm-s - zout(1, j, nout4) = am+cp - zout(2, j, nout4) = bp+dbl - zout(1, j, nout8) = am-cp - zout(2, j, nout8) = bp-dbl + r = r1 + r5 + s = r3 + r7 + ap = r + s + am = r - s + r = r2 + r6 + s = r4 + r8 + bp = r + s + bm = r - s + r = s1 + s5 + s = s3 + s7 + cp = r + s + cm = r - s + r = s2 + s6 + s = s4 + s8 + dbl = r + s + dm = r - s + zout(1, j, nout1) = ap + bp + zout(2, j, nout1) = cp + dbl + zout(1, j, nout5) = ap - bp + zout(2, j, nout5) = cp - dbl + zout(1, j, nout3) = am - dm + zout(2, j, nout3) = cm + bm + zout(1, j, nout7) = am + dm + zout(2, j, nout7) = cm - bm + r = r1 - r5 + s = -s3 + s7 + ap = r + s + am = r - s + r = s1 - s5 + s = r7 - r3 + bp = r + s + bm = r - s + r = -s4 + s8 + s = r2 - r6 + cp = r + s + cm = r - s + r = -s2 + s6 + s = r4 - r8 + dbl = r + s + dm = r - s + r = (cp + dm)*rt2i + s = (cp - dm)*rt2i + cp = (cm + dbl)*rt2i + dbl = (-cm + dbl)*rt2i + zout(1, j, nout2) = ap + r + zout(2, j, nout2) = bm + s + zout(1, j, nout6) = ap - r + zout(2, j, nout6) = bm - s + zout(1, j, nout4) = am + cp + zout(2, j, nout4) = bp + dbl + zout(1, j, nout8) = am - cp + zout(2, j, nout8) = bp - dbl END DO END DO END IF ELSE IF (now == 3) THEN bbs = isign*bb ia = 1 - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) @@ -2933,33 +2933,33 @@ SUBROUTINE fftstp(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s2 = zin(2, j, nin2) r3 = zin(1, j, nin3) s3 = zin(2, j, nin3) - r = r2+r3 - s = s2+s3 - zout(1, j, nout1) = r+r1 - zout(2, j, nout1) = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r2 = bbs*(r2-r3) - s2 = bbs*(s2-s3) - zout(1, j, nout2) = r1-s2 - zout(2, j, nout2) = s1+r2 - zout(1, j, nout3) = r1+s2 - zout(2, j, nout3) = s1-r2 + r = r2 + r3 + s = s2 + s3 + zout(1, j, nout1) = r + r1 + zout(2, j, nout1) = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r2 = bbs*(r2 - r3) + s2 = bbs*(s2 - s3) + zout(1, j, nout2) = r1 - s2 + zout(2, j, nout2) = s1 + r2 + zout(1, j, nout3) = r1 + s2 + zout(2, j, nout3) = s1 - r2 END DO END DO DO ia = 2, after - ias = ia-1 + ias = ia - 1 IF (4*ias == 3*after) THEN IF (isign == 1) THEN - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) @@ -2967,30 +2967,30 @@ SUBROUTINE fftstp(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s2 = zin(1, j, nin2) r3 = -zin(1, j, nin3) s3 = -zin(2, j, nin3) - r = r2+r3 - s = s2+s3 - zout(1, j, nout1) = r+r1 - zout(2, j, nout1) = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r2 = bbs*(r2-r3) - s2 = bbs*(s2-s3) - zout(1, j, nout2) = r1-s2 - zout(2, j, nout2) = s1+r2 - zout(1, j, nout3) = r1+s2 - zout(2, j, nout3) = s1-r2 + r = r2 + r3 + s = s2 + s3 + zout(1, j, nout1) = r + r1 + zout(2, j, nout1) = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r2 = bbs*(r2 - r3) + s2 = bbs*(s2 - s3) + zout(1, j, nout2) = r1 - s2 + zout(2, j, nout2) = s1 + r2 + zout(1, j, nout3) = r1 + s2 + zout(2, j, nout3) = s1 - r2 END DO END DO ELSE - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) @@ -2998,129 +2998,129 @@ SUBROUTINE fftstp(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s2 = -zin(1, j, nin2) r3 = -zin(1, j, nin3) s3 = -zin(2, j, nin3) - r = r2+r3 - s = s2+s3 - zout(1, j, nout1) = r+r1 - zout(2, j, nout1) = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r2 = bbs*(r2-r3) - s2 = bbs*(s2-s3) - zout(1, j, nout2) = r1-s2 - zout(2, j, nout2) = s1+r2 - zout(1, j, nout3) = r1+s2 - zout(2, j, nout3) = s1-r2 + r = r2 + r3 + s = s2 + s3 + zout(1, j, nout1) = r + r1 + zout(2, j, nout1) = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r2 = bbs*(r2 - r3) + s2 = bbs*(s2 - s3) + zout(1, j, nout2) = r1 - s2 + zout(2, j, nout2) = s1 + r2 + zout(1, j, nout3) = r1 + s2 + zout(2, j, nout3) = s1 - r2 END DO END DO END IF ELSE IF (8*ias == 3*after) THEN IF (isign == 1) THEN - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) r = zin(1, j, nin2) s = zin(2, j, nin2) - r2 = (r-s)*rt2i - s2 = (r+s)*rt2i + r2 = (r - s)*rt2i + s2 = (r + s)*rt2i r3 = -zin(2, j, nin3) s3 = zin(1, j, nin3) - r = r2+r3 - s = s2+s3 - zout(1, j, nout1) = r+r1 - zout(2, j, nout1) = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r2 = bbs*(r2-r3) - s2 = bbs*(s2-s3) - zout(1, j, nout2) = r1-s2 - zout(2, j, nout2) = s1+r2 - zout(1, j, nout3) = r1+s2 - zout(2, j, nout3) = s1-r2 + r = r2 + r3 + s = s2 + s3 + zout(1, j, nout1) = r + r1 + zout(2, j, nout1) = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r2 = bbs*(r2 - r3) + s2 = bbs*(s2 - s3) + zout(1, j, nout2) = r1 - s2 + zout(2, j, nout2) = s1 + r2 + zout(1, j, nout3) = r1 + s2 + zout(2, j, nout3) = s1 - r2 END DO END DO ELSE - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) r = zin(1, j, nin2) s = zin(2, j, nin2) - r2 = (r+s)*rt2i - s2 = (-r+s)*rt2i + r2 = (r + s)*rt2i + s2 = (-r + s)*rt2i r3 = zin(2, j, nin3) s3 = -zin(1, j, nin3) - r = r2+r3 - s = s2+s3 - zout(1, j, nout1) = r+r1 - zout(2, j, nout1) = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r2 = bbs*(r2-r3) - s2 = bbs*(s2-s3) - zout(1, j, nout2) = r1-s2 - zout(2, j, nout2) = s1+r2 - zout(1, j, nout3) = r1+s2 - zout(2, j, nout3) = s1-r2 + r = r2 + r3 + s = s2 + s3 + zout(1, j, nout1) = r + r1 + zout(2, j, nout1) = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r2 = bbs*(r2 - r3) + s2 = bbs*(s2 - s3) + zout(1, j, nout2) = r1 - s2 + zout(2, j, nout2) = s1 + r2 + zout(1, j, nout3) = r1 + s2 + zout(2, j, nout3) = s1 - r2 END DO END DO END IF ELSE itt = ias*before - itrig = itt+1 + itrig = itt + 1 cr2 = trig(1, itrig) ci2 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr3 = trig(1, itrig) ci3 = trig(2, itrig) - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) r = zin(1, j, nin2) s = zin(2, j, nin2) - r2 = r*cr2-s*ci2 - s2 = r*ci2+s*cr2 + r2 = r*cr2 - s*ci2 + s2 = r*ci2 + s*cr2 r = zin(1, j, nin3) s = zin(2, j, nin3) - r3 = r*cr3-s*ci3 - s3 = r*ci3+s*cr3 - r = r2+r3 - s = s2+s3 - zout(1, j, nout1) = r+r1 - zout(2, j, nout1) = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r2 = bbs*(r2-r3) - s2 = bbs*(s2-s3) - zout(1, j, nout2) = r1-s2 - zout(2, j, nout2) = s1+r2 - zout(1, j, nout3) = r1+s2 - zout(2, j, nout3) = s1-r2 + r3 = r*cr3 - s*ci3 + s3 = r*ci3 + s*cr3 + r = r2 + r3 + s = s2 + s3 + zout(1, j, nout1) = r + r1 + zout(2, j, nout1) = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r2 = bbs*(r2 - r3) + s2 = bbs*(s2 - s3) + zout(1, j, nout2) = r1 - s2 + zout(2, j, nout2) = s1 + r2 + zout(1, j, nout3) = r1 + s2 + zout(2, j, nout3) = s1 - r2 END DO END DO END IF @@ -3129,19 +3129,19 @@ SUBROUTINE fftstp(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign sin2 = isign*sin2p sin4 = isign*sin4p ia = 1 - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nin5 = nin4+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after - nout5 = nout4+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) @@ -3153,225 +3153,225 @@ SUBROUTINE fftstp(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign s4 = zin(2, j, nin4) r5 = zin(1, j, nin5) s5 = zin(2, j, nin5) - r25 = r2+r5 - r34 = r3+r4 - s25 = s2-s5 - s34 = s3-s4 - zout(1, j, nout1) = r1+r25+r34 - r = cos2*r25+cos4*r34+r1 - s = sin2*s25+sin4*s34 - zout(1, j, nout2) = r-s - zout(1, j, nout5) = r+s - r = cos4*r25+cos2*r34+r1 - s = sin4*s25-sin2*s34 - zout(1, j, nout3) = r-s - zout(1, j, nout4) = r+s - r25 = r2-r5 - r34 = r3-r4 - s25 = s2+s5 - s34 = s3+s4 - zout(2, j, nout1) = s1+s25+s34 - r = cos2*s25+cos4*s34+s1 - s = sin2*r25+sin4*r34 - zout(2, j, nout2) = r+s - zout(2, j, nout5) = r-s - r = cos4*s25+cos2*s34+s1 - s = sin4*r25-sin2*r34 - zout(2, j, nout3) = r+s - zout(2, j, nout4) = r-s + r25 = r2 + r5 + r34 = r3 + r4 + s25 = s2 - s5 + s34 = s3 - s4 + zout(1, j, nout1) = r1 + r25 + r34 + r = cos2*r25 + cos4*r34 + r1 + s = sin2*s25 + sin4*s34 + zout(1, j, nout2) = r - s + zout(1, j, nout5) = r + s + r = cos4*r25 + cos2*r34 + r1 + s = sin4*s25 - sin2*s34 + zout(1, j, nout3) = r - s + zout(1, j, nout4) = r + s + r25 = r2 - r5 + r34 = r3 - r4 + s25 = s2 + s5 + s34 = s3 + s4 + zout(2, j, nout1) = s1 + s25 + s34 + r = cos2*s25 + cos4*s34 + s1 + s = sin2*r25 + sin4*r34 + zout(2, j, nout2) = r + s + zout(2, j, nout5) = r - s + r = cos4*s25 + cos2*s34 + s1 + s = sin4*r25 - sin2*r34 + zout(2, j, nout3) = r + s + zout(2, j, nout4) = r - s END DO END DO DO ia = 2, after - ias = ia-1 + ias = ia - 1 IF (8*ias == 5*after) THEN IF (isign == 1) THEN - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nin5 = nin4+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after - nout5 = nout4+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) r = zin(1, j, nin2) s = zin(2, j, nin2) - r2 = (r-s)*rt2i - s2 = (r+s)*rt2i + r2 = (r - s)*rt2i + s2 = (r + s)*rt2i r3 = -zin(2, j, nin3) s3 = zin(1, j, nin3) r = zin(1, j, nin4) s = zin(2, j, nin4) - r4 = -(r+s)*rt2i - s4 = (r-s)*rt2i + r4 = -(r + s)*rt2i + s4 = (r - s)*rt2i r5 = -zin(1, j, nin5) s5 = -zin(2, j, nin5) - r25 = r2+r5 - r34 = r3+r4 - s25 = s2-s5 - s34 = s3-s4 - zout(1, j, nout1) = r1+r25+r34 - r = cos2*r25+cos4*r34+r1 - s = sin2*s25+sin4*s34 - zout(1, j, nout2) = r-s - zout(1, j, nout5) = r+s - r = cos4*r25+cos2*r34+r1 - s = sin4*s25-sin2*s34 - zout(1, j, nout3) = r-s - zout(1, j, nout4) = r+s - r25 = r2-r5 - r34 = r3-r4 - s25 = s2+s5 - s34 = s3+s4 - zout(2, j, nout1) = s1+s25+s34 - r = cos2*s25+cos4*s34+s1 - s = sin2*r25+sin4*r34 - zout(2, j, nout2) = r+s - zout(2, j, nout5) = r-s - r = cos4*s25+cos2*s34+s1 - s = sin4*r25-sin2*r34 - zout(2, j, nout3) = r+s - zout(2, j, nout4) = r-s + r25 = r2 + r5 + r34 = r3 + r4 + s25 = s2 - s5 + s34 = s3 - s4 + zout(1, j, nout1) = r1 + r25 + r34 + r = cos2*r25 + cos4*r34 + r1 + s = sin2*s25 + sin4*s34 + zout(1, j, nout2) = r - s + zout(1, j, nout5) = r + s + r = cos4*r25 + cos2*r34 + r1 + s = sin4*s25 - sin2*s34 + zout(1, j, nout3) = r - s + zout(1, j, nout4) = r + s + r25 = r2 - r5 + r34 = r3 - r4 + s25 = s2 + s5 + s34 = s3 + s4 + zout(2, j, nout1) = s1 + s25 + s34 + r = cos2*s25 + cos4*s34 + s1 + s = sin2*r25 + sin4*r34 + zout(2, j, nout2) = r + s + zout(2, j, nout5) = r - s + r = cos4*s25 + cos2*s34 + s1 + s = sin4*r25 - sin2*r34 + zout(2, j, nout3) = r + s + zout(2, j, nout4) = r - s END DO END DO ELSE - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nin5 = nin4+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after - nout5 = nout4+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) r = zin(1, j, nin2) s = zin(2, j, nin2) - r2 = (r+s)*rt2i - s2 = (-r+s)*rt2i + r2 = (r + s)*rt2i + s2 = (-r + s)*rt2i r3 = zin(2, j, nin3) s3 = -zin(1, j, nin3) r = zin(1, j, nin4) s = zin(2, j, nin4) - r4 = (s-r)*rt2i - s4 = -(r+s)*rt2i + r4 = (s - r)*rt2i + s4 = -(r + s)*rt2i r5 = -zin(1, j, nin5) s5 = -zin(2, j, nin5) - r25 = r2+r5 - r34 = r3+r4 - s25 = s2-s5 - s34 = s3-s4 - zout(1, j, nout1) = r1+r25+r34 - r = cos2*r25+cos4*r34+r1 - s = sin2*s25+sin4*s34 - zout(1, j, nout2) = r-s - zout(1, j, nout5) = r+s - r = cos4*r25+cos2*r34+r1 - s = sin4*s25-sin2*s34 - zout(1, j, nout3) = r-s - zout(1, j, nout4) = r+s - r25 = r2-r5 - r34 = r3-r4 - s25 = s2+s5 - s34 = s3+s4 - zout(2, j, nout1) = s1+s25+s34 - r = cos2*s25+cos4*s34+s1 - s = sin2*r25+sin4*r34 - zout(2, j, nout2) = r+s - zout(2, j, nout5) = r-s - r = cos4*s25+cos2*s34+s1 - s = sin4*r25-sin2*r34 - zout(2, j, nout3) = r+s - zout(2, j, nout4) = r-s + r25 = r2 + r5 + r34 = r3 + r4 + s25 = s2 - s5 + s34 = s3 - s4 + zout(1, j, nout1) = r1 + r25 + r34 + r = cos2*r25 + cos4*r34 + r1 + s = sin2*s25 + sin4*s34 + zout(1, j, nout2) = r - s + zout(1, j, nout5) = r + s + r = cos4*r25 + cos2*r34 + r1 + s = sin4*s25 - sin2*s34 + zout(1, j, nout3) = r - s + zout(1, j, nout4) = r + s + r25 = r2 - r5 + r34 = r3 - r4 + s25 = s2 + s5 + s34 = s3 + s4 + zout(2, j, nout1) = s1 + s25 + s34 + r = cos2*s25 + cos4*s34 + s1 + s = sin2*r25 + sin4*r34 + zout(2, j, nout2) = r + s + zout(2, j, nout5) = r - s + r = cos4*s25 + cos2*s34 + s1 + s = sin4*r25 - sin2*r34 + zout(2, j, nout3) = r + s + zout(2, j, nout4) = r - s END DO END DO END IF ELSE - ias = ia-1 + ias = ia - 1 itt = ias*before - itrig = itt+1 + itrig = itt + 1 cr2 = trig(1, itrig) ci2 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr3 = trig(1, itrig) ci3 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr4 = trig(1, itrig) ci4 = trig(2, itrig) - itrig = itrig+itt + itrig = itrig + itt cr5 = trig(1, itrig) ci5 = trig(2, itrig) - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nin5 = nin4+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after - nout5 = nout4+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after DO j = 1, nfft r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) r = zin(1, j, nin2) s = zin(2, j, nin2) - r2 = r*cr2-s*ci2 - s2 = r*ci2+s*cr2 + r2 = r*cr2 - s*ci2 + s2 = r*ci2 + s*cr2 r = zin(1, j, nin3) s = zin(2, j, nin3) - r3 = r*cr3-s*ci3 - s3 = r*ci3+s*cr3 + r3 = r*cr3 - s*ci3 + s3 = r*ci3 + s*cr3 r = zin(1, j, nin4) s = zin(2, j, nin4) - r4 = r*cr4-s*ci4 - s4 = r*ci4+s*cr4 + r4 = r*cr4 - s*ci4 + s4 = r*ci4 + s*cr4 r = zin(1, j, nin5) s = zin(2, j, nin5) - r5 = r*cr5-s*ci5 - s5 = r*ci5+s*cr5 - r25 = r2+r5 - r34 = r3+r4 - s25 = s2-s5 - s34 = s3-s4 - zout(1, j, nout1) = r1+r25+r34 - r = cos2*r25+cos4*r34+r1 - s = sin2*s25+sin4*s34 - zout(1, j, nout2) = r-s - zout(1, j, nout5) = r+s - r = cos4*r25+cos2*r34+r1 - s = sin4*s25-sin2*s34 - zout(1, j, nout3) = r-s - zout(1, j, nout4) = r+s - r25 = r2-r5 - r34 = r3-r4 - s25 = s2+s5 - s34 = s3+s4 - zout(2, j, nout1) = s1+s25+s34 - r = cos2*s25+cos4*s34+s1 - s = sin2*r25+sin4*r34 - zout(2, j, nout2) = r+s - zout(2, j, nout5) = r-s - r = cos4*s25+cos2*s34+s1 - s = sin4*r25-sin2*r34 - zout(2, j, nout3) = r+s - zout(2, j, nout4) = r-s + r5 = r*cr5 - s*ci5 + s5 = r*ci5 + s*cr5 + r25 = r2 + r5 + r34 = r3 + r4 + s25 = s2 - s5 + s34 = s3 - s4 + zout(1, j, nout1) = r1 + r25 + r34 + r = cos2*r25 + cos4*r34 + r1 + s = sin2*s25 + sin4*s34 + zout(1, j, nout2) = r - s + zout(1, j, nout5) = r + s + r = cos4*r25 + cos2*r34 + r1 + s = sin4*s25 - sin2*s34 + zout(1, j, nout3) = r - s + zout(1, j, nout4) = r + s + r25 = r2 - r5 + r34 = r3 - r4 + s25 = s2 + s5 + s34 = s3 + s4 + zout(2, j, nout1) = s1 + s25 + s34 + r = cos2*s25 + cos4*s34 + s1 + s = sin2*r25 + sin4*r34 + zout(2, j, nout2) = r + s + zout(2, j, nout5) = r - s + r = cos4*s25 + cos2*s34 + s1 + s = sin4*r25 - sin2*r34 + zout(2, j, nout3) = r + s + zout(2, j, nout4) = r - s END DO END DO END IF @@ -3379,72 +3379,72 @@ SUBROUTINE fftstp(mm, nfft, m, nn, n, zin, zout, trig, now, after, before, isign ELSE IF (now == 6) THEN bbs = isign*bb ia = 1 - nin1 = ia-after - nout1 = ia-atn + nin1 = ia - after + nout1 = ia - atn DO ib = 1, before - nin1 = nin1+after - nin2 = nin1+atb - nin3 = nin2+atb - nin4 = nin3+atb - nin5 = nin4+atb - nin6 = nin5+atb - nout1 = nout1+atn - nout2 = nout1+after - nout3 = nout2+after - nout4 = nout3+after - nout5 = nout4+after - nout6 = nout5+after + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nin6 = nin5 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after + nout6 = nout5 + after DO j = 1, nfft r2 = zin(1, j, nin3) s2 = zin(2, j, nin3) r3 = zin(1, j, nin5) s3 = zin(2, j, nin5) - r = r2+r3 - s = s2+s3 + r = r2 + r3 + s = s2 + s3 r1 = zin(1, j, nin1) s1 = zin(2, j, nin1) - ur1 = r+r1 - ui1 = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r = r2-r3 - s = s2-s3 - ur2 = r1-s*bbs - ui2 = s1+r*bbs - ur3 = r1+s*bbs - ui3 = s1-r*bbs + ur1 = r + r1 + ui1 = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r = r2 - r3 + s = s2 - s3 + ur2 = r1 - s*bbs + ui2 = s1 + r*bbs + ur3 = r1 + s*bbs + ui3 = s1 - r*bbs r2 = zin(1, j, nin6) s2 = zin(2, j, nin6) r3 = zin(1, j, nin2) s3 = zin(2, j, nin2) - r = r2+r3 - s = s2+s3 + r = r2 + r3 + s = s2 + s3 r1 = zin(1, j, nin4) s1 = zin(2, j, nin4) - vr1 = r+r1 - vi1 = s+s1 - r1 = r1-0.5_dp*r - s1 = s1-0.5_dp*s - r = r2-r3 - s = s2-s3 - vr2 = r1-s*bbs - vi2 = s1+r*bbs - vr3 = r1+s*bbs - vi3 = s1-r*bbs - - zout(1, j, nout1) = ur1+vr1 - zout(2, j, nout1) = ui1+vi1 - zout(1, j, nout5) = ur2+vr2 - zout(2, j, nout5) = ui2+vi2 - zout(1, j, nout3) = ur3+vr3 - zout(2, j, nout3) = ui3+vi3 - zout(1, j, nout4) = ur1-vr1 - zout(2, j, nout4) = ui1-vi1 - zout(1, j, nout2) = ur2-vr2 - zout(2, j, nout2) = ui2-vi2 - zout(1, j, nout6) = ur3-vr3 - zout(2, j, nout6) = ui3-vi3 + vr1 = r + r1 + vi1 = s + s1 + r1 = r1 - 0.5_dp*r + s1 = s1 - 0.5_dp*s + r = r2 - r3 + s = s2 - s3 + vr2 = r1 - s*bbs + vi2 = s1 + r*bbs + vr3 = r1 + s*bbs + vi3 = s1 - r*bbs + + zout(1, j, nout1) = ur1 + vr1 + zout(2, j, nout1) = ui1 + vi1 + zout(1, j, nout5) = ur2 + vr2 + zout(2, j, nout5) = ui2 + vi2 + zout(1, j, nout3) = ur3 + vr3 + zout(2, j, nout3) = ui3 + vi3 + zout(1, j, nout4) = ur1 - vr1 + zout(2, j, nout4) = ui1 - vi1 + zout(1, j, nout2) = ur2 - vr2 + zout(2, j, nout2) = ui2 - vi2 + zout(1, j, nout6) = ur3 - vr3 + zout(2, j, nout6) = ui3 - vi3 END DO END DO ELSE @@ -3515,10 +3515,10 @@ SUBROUTINE ctrig(n, trig, after, before, now, isign, ic) IF (n == idata(1, i)) THEN ic = 0 DO j = 1, 6 - itt = idata(1+j, i) + itt = idata(1 + j, i) IF (itt > 1) THEN - ic = ic+1 - now(j) = idata(1+j, i) + ic = ic + 1 + now(j) = idata(1 + j, i) ELSE EXIT mloop END IF @@ -3536,17 +3536,17 @@ SUBROUTINE ctrig(n, trig, after, before, now, isign, ic) after(1) = 1 before(ic) = 1 DO i = 2, ic - after(i) = after(i-1)*now(i-1) - before(ic-i+1) = before(ic-i+2)*now(ic-i+2) + after(i) = after(i - 1)*now(i - 1) + before(ic - i + 1) = before(ic - i + 2)*now(ic - i + 2) END DO twopi = 8._dp*ATAN(1._dp) angle = isign*twopi/REAL(n, dp) trig(1, 1) = 1._dp trig(2, 1) = 0._dp - DO i = 1, n-1 - trig(1, i+1) = COS(REAL(i, dp)*angle) - trig(2, i+1) = SIN(REAL(i, dp)*angle) + DO i = 1, n - 1 + trig(1, i + 1) = COS(REAL(i, dp)*angle) + trig(2, i + 1) = SIN(REAL(i, dp)*angle) END DO END SUBROUTINE ctrig diff --git a/src/pw/fft_tools.F b/src/pw/fft_tools.F index 302ed58452..b0c167eccc 100644 --- a/src/pw/fft_tools.F +++ b/src/pw/fft_tools.F @@ -303,9 +303,9 @@ SUBROUTINE fft_radix_operations(radix_in, radix_out, operation) IF (DATA(iloc) == radix_in) THEN radix_out = DATA(iloc) ELSE - IF (ABS(DATA(iloc-1)-radix_in) <= & - ABS(DATA(iloc)-radix_in)) THEN - radix_out = DATA(iloc-1) + IF (ABS(DATA(iloc - 1) - radix_in) <= & + ABS(DATA(iloc) - radix_in)) THEN + radix_out = DATA(iloc - 1) ELSE radix_out = DATA(iloc) END IF @@ -578,20 +578,20 @@ SUBROUTINE fft3d_ps(fsign, n, cin, gin, gs_group, rs_group, yzp, nyzray, & ELSE mmax = mg END IF - lmax = MAX(lg, (nx*ny*nz)/mmax+1) + lmax = MAX(lg, (nx*ny*nz)/mmax + 1) - ALLOCATE (p2p(0:numtask-1)) + ALLOCATE (p2p(0:numtask - 1)) CALL mp_rank_compare(gs_group, rs_group, p2p) rp = p2p(g_pos) - mx1 = bo(2, 1, rp, 1)-bo(1, 1, rp, 1)+1 - my1 = bo(2, 2, rp, 1)-bo(1, 2, rp, 1)+1 - mx2 = bo(2, 1, rp, 2)-bo(1, 1, rp, 2)+1 - mz2 = bo(2, 3, rp, 2)-bo(1, 3, rp, 2)+1 + mx1 = bo(2, 1, rp, 1) - bo(1, 1, rp, 1) + 1 + my1 = bo(2, 2, rp, 1) - bo(1, 2, rp, 1) + 1 + mx2 = bo(2, 1, rp, 2) - bo(1, 1, rp, 2) + 1 + mz2 = bo(2, 3, rp, 2) - bo(1, 3, rp, 2) + 1 - n1 = MAXVAL(bo(2, 1, :, 1)-bo(1, 1, :, 1)+1) - n2 = MAXVAL(bo(2, 2, :, 1)-bo(1, 2, :, 1)+1) + n1 = MAXVAL(bo(2, 1, :, 1) - bo(1, 1, :, 1) + 1) + n2 = MAXVAL(bo(2, 2, :, 1) - bo(1, 2, :, 1) + 1) nmax = MAX((2*n2)/numtask, 2)*mx2*mz2 nmax = MAX(nmax, n1*MAXVAL(nyzray)) n1 = MAXVAL(bo(2, 1, :, 2)) @@ -610,9 +610,9 @@ SUBROUTINE fft3d_ps(fsign, n, cin, gin, gs_group, rs_group, yzp, nyzray, & fft_scratch_size%mg = mg fft_scratch_size%nbx = n1 fft_scratch_size%nbz = n2 - mcz1 = MAXVAL(bo(2, 3, :, 1)-bo(1, 3, :, 1)+1) - mcx2 = MAXVAL(bo(2, 1, :, 2)-bo(1, 1, :, 2)+1) - mcz2 = MAXVAL(bo(2, 3, :, 2)-bo(1, 3, :, 2)+1) + mcz1 = MAXVAL(bo(2, 3, :, 1) - bo(1, 3, :, 1) + 1) + mcx2 = MAXVAL(bo(2, 1, :, 2) - bo(1, 1, :, 2) + 1) + mcz2 = MAXVAL(bo(2, 3, :, 2) - bo(1, 3, :, 2) + 1) fft_scratch_size%mcz1 = mcz1 fft_scratch_size%mcx2 = mcx2 fft_scratch_size%mcz2 = mcz2 @@ -1037,15 +1037,15 @@ SUBROUTINE fft3d_pb(fsign, n, zin, gin, group, bo, scale, status, debug) END IF END IF - mx1 = bo(2, 1, my_pos, 1)-bo(1, 1, my_pos, 1)+1 - my1 = bo(2, 2, my_pos, 1)-bo(1, 2, my_pos, 1)+1 - mz1 = bo(2, 3, my_pos, 1)-bo(1, 3, my_pos, 1)+1 - mx2 = bo(2, 1, my_pos, 2)-bo(1, 1, my_pos, 2)+1 - my2 = bo(2, 2, my_pos, 2)-bo(1, 2, my_pos, 2)+1 - mz2 = bo(2, 3, my_pos, 2)-bo(1, 3, my_pos, 2)+1 - mx3 = bo(2, 1, my_pos, 3)-bo(1, 1, my_pos, 3)+1 - my3 = bo(2, 2, my_pos, 3)-bo(1, 2, my_pos, 3)+1 - mz3 = bo(2, 3, my_pos, 3)-bo(1, 3, my_pos, 3)+1 + mx1 = bo(2, 1, my_pos, 1) - bo(1, 1, my_pos, 1) + 1 + my1 = bo(2, 2, my_pos, 1) - bo(1, 2, my_pos, 1) + 1 + mz1 = bo(2, 3, my_pos, 1) - bo(1, 3, my_pos, 1) + 1 + mx2 = bo(2, 1, my_pos, 2) - bo(1, 1, my_pos, 2) + 1 + my2 = bo(2, 2, my_pos, 2) - bo(1, 2, my_pos, 2) + 1 + mz2 = bo(2, 3, my_pos, 2) - bo(1, 3, my_pos, 2) + 1 + mx3 = bo(2, 1, my_pos, 3) - bo(1, 1, my_pos, 3) + 1 + my3 = bo(2, 2, my_pos, 3) - bo(1, 2, my_pos, 3) + 1 + mz3 = bo(2, 3, my_pos, 3) - bo(1, 3, my_pos, 3) + 1 fft_scratch_size%mx1 = mx1 fft_scratch_size%mx2 = mx2 fft_scratch_size%mx3 = mx3 @@ -1055,10 +1055,10 @@ SUBROUTINE fft3d_pb(fsign, n, zin, gin, group, bo, scale, status, debug) fft_scratch_size%mz1 = mz1 fft_scratch_size%mz2 = mz2 fft_scratch_size%mz3 = mz3 - mcz1 = MAXVAL(bo(2, 3, :, 1)-bo(1, 3, :, 1)+1) - mcx2 = MAXVAL(bo(2, 1, :, 2)-bo(1, 1, :, 2)+1) - mcz2 = MAXVAL(bo(2, 3, :, 2)-bo(1, 3, :, 2)+1) - mcy3 = MAXVAL(bo(2, 2, :, 3)-bo(1, 2, :, 3)+1) + mcz1 = MAXVAL(bo(2, 3, :, 1) - bo(1, 3, :, 1) + 1) + mcx2 = MAXVAL(bo(2, 1, :, 2) - bo(1, 1, :, 2) + 1) + mcz2 = MAXVAL(bo(2, 3, :, 2) - bo(1, 3, :, 2) + 1) + mcy3 = MAXVAL(bo(2, 2, :, 3) - bo(1, 2, :, 3) + 1) fft_scratch_size%mcz1 = mcz1 fft_scratch_size%mcx2 = mcx2 fft_scratch_size%mcz2 = mcz2 @@ -1423,23 +1423,23 @@ SUBROUTINE x_to_yz(sb, group, my_pos, p2p, yzp, nray, bo, tb, fft_scratch) END IF mpr = p2p(my_pos) - nm = MAXVAL(nray(0:np-1)) + nm = MAXVAL(nray(0:np - 1)) nr = nray(my_pos) !$OMP PARALLEL DO DEFAULT(NONE), & !$OMP PRIVATE(ix,nx), & !$OMP SHARED(np,p2p,bo,nr,scount,sdispl) - DO ip = 0, np-1 + DO ip = 0, np - 1 ix = p2p(ip) - nx = bo(2, 1, ix)-bo(1, 1, ix)+1 + nx = bo(2, 1, ix) - bo(1, 1, ix) + 1 scount(ip) = nr*nx - sdispl(ip) = nr*(bo(1, 1, ix)-1) + sdispl(ip) = nr*(bo(1, 1, ix) - 1) END DO !$OMP END PARALLEL DO - nx = bo(2, 1, mpr)-bo(1, 1, mpr)+1 + nx = bo(2, 1, mpr) - bo(1, 1, mpr) + 1 !$OMP PARALLEL DO DEFAULT(NONE), & !$OMP PRIVATE(nr), & !$OMP SHARED(np,nray,nx,rcount,rdispl,nm) - DO ip = 0, np-1 + DO ip = 0, np - 1 nr = nray(ip) rcount(ip) = nr*nx rdispl(ip) = nm*nx*ip @@ -1451,24 +1451,24 @@ SUBROUTINE x_to_yz(sb, group, my_pos, p2p, yzp, nray, bo, tb, fft_scratch) CALL mp_alltoall(sb, scount, sdispl, rr, rcount, rdispl, group) END IF - nx = bo(2, 1, mpr)-bo(1, 1, mpr)+1 + nx = bo(2, 1, mpr) - bo(1, 1, mpr) + 1 !$OMP PARALLEL DO DEFAULT(NONE) COLLAPSE(2) & !$OMP PRIVATE(ixx,ir,iy,iz,ix) & !$OMP SHARED(np,nray,nx,alltoall_sgl,yzp,tt,rr,tb) - DO ip = 0, np-1 + DO ip = 0, np - 1 DO ix = 1, nx - ixx = nray(ip)*(ix-1) + ixx = nray(ip)*(ix - 1) IF (alltoall_sgl) THEN DO ir = 1, nray(ip) iy = yzp(1, ir, ip) iz = yzp(2, ir, ip) - tb(iy, iz, ix) = tt(ir+ixx, ip) + tb(iy, iz, ix) = tt(ir + ixx, ip) END DO ELSE DO ir = 1, nray(ip) iy = yzp(1, ir, ip) iz = yzp(2, ir, ip) - tb(iy, iz, ix) = rr(ir+ixx, ip) + tb(iy, iz, ix) = rr(ir + ixx, ip) END DO END IF END DO @@ -1531,46 +1531,46 @@ SUBROUTINE yz_to_x(tb, group, my_pos, p2p, yzp, nray, bo, sb, fft_scratch) rr => fft_scratch%rr END IF - nx = bo(2, 1, mpr)-bo(1, 1, mpr)+1 + nx = bo(2, 1, mpr) - bo(1, 1, mpr) + 1 !$OMP PARALLEL DO DEFAULT(NONE) COLLAPSE(2) & !$OMP PRIVATE(ip, ixx, ir, iy, iz, ix) & !$OMP SHARED(np,nray,nx,alltoall_sgl,yzp,tb,tt,rr) - DO ip = 0, np-1 + DO ip = 0, np - 1 DO ix = 1, nx - ixx = nray(ip)*(ix-1) + ixx = nray(ip)*(ix - 1) IF (alltoall_sgl) THEN DO ir = 1, nray(ip) iy = yzp(1, ir, ip) iz = yzp(2, ir, ip) - tt(ir+ixx, ip) = CMPLX(tb(iy, iz, ix), KIND=sp) + tt(ir + ixx, ip) = CMPLX(tb(iy, iz, ix), KIND=sp) END DO ELSE DO ir = 1, nray(ip) iy = yzp(1, ir, ip) iz = yzp(2, ir, ip) - rr(ir+ixx, ip) = tb(iy, iz, ix) + rr(ir + ixx, ip) = tb(iy, iz, ix) END DO END IF END DO END DO !$OMP END PARALLEL DO - nm = MAXVAL(nray(0:np-1)) + nm = MAXVAL(nray(0:np - 1)) nr = nray(my_pos) !$OMP PARALLEL DO DEFAULT(NONE), & !$OMP PRIVATE(ix,nx), & !$OMP SHARED(np,p2p,bo,rcount,rdispl,nr) - DO ip = 0, np-1 + DO ip = 0, np - 1 ix = p2p(ip) - nx = bo(2, 1, ix)-bo(1, 1, ix)+1 + nx = bo(2, 1, ix) - bo(1, 1, ix) + 1 rcount(ip) = nr*nx - rdispl(ip) = nr*(bo(1, 1, ix)-1) + rdispl(ip) = nr*(bo(1, 1, ix) - 1) END DO !$OMP END PARALLEL DO - nx = bo(2, 1, mpr)-bo(1, 1, mpr)+1 + nx = bo(2, 1, mpr) - bo(1, 1, mpr) + 1 !$OMP PARALLEL DO DEFAULT(NONE), & !$OMP PRIVATE(nr), & !$OMP SHARED(np,nray,scount,sdispl,nx,nm) - DO ip = 0, np-1 + DO ip = 0, np - 1 nr = nray(ip) scount(ip) = nr*nx sdispl(ip) = nm*nx*ip @@ -1660,11 +1660,11 @@ SUBROUTINE yz_to_xz(sb, group, dims, my_pos, p2p, yzp, nray, bo, tb, fft_scratch scount = 0 - DO ix = 0, npx-1 + DO ix = 0, npx - 1 ip = pgrid(ix, 0) xcor(bo(1, 1, ip):bo(2, 1, ip)) = ix END DO - DO iz = 0, npz-1 + DO iz = 0, npz - 1 ip = pgrid(0, iz) zcor(bo(1, 3, ip):bo(2, 3, ip)) = iz END DO @@ -1674,14 +1674,14 @@ SUBROUTINE yz_to_xz(sb, group, dims, my_pos, p2p, yzp, nray, bo, tb, fft_scratch jy = yzp(1, ir, my_pos) jz = yzp(2, ir, my_pos) ip = pgrid(xcor(jx), zcor(jz)) - scount(ip) = scount(ip)+1 + scount(ip) = scount(ip) + 1 END DO ELSE DO ir = 1, nray(my_pos) jy = yzp(1, ir, my_pos) jz = yzp(2, ir, my_pos) ip = pgrid(xcor(jx), zcor(jz)) - scount(ip) = scount(ip)+1 + scount(ip) = scount(ip) + 1 END DO END IF END DO @@ -1693,18 +1693,18 @@ SUBROUTINE yz_to_xz(sb, group, dims, my_pos, p2p, yzp, nray, bo, tb, fft_scratch ! Work out the correct displacements in the buffers sdispl(0) = 0 rdispl(0) = 0 - DO ip = 1, np-1 - sdispl(ip) = sdispl(ip-1)+scount(ip-1) - rdispl(ip) = rdispl(ip-1)+rcount(ip-1) + DO ip = 1, np - 1 + sdispl(ip) = sdispl(ip - 1) + scount(ip - 1) + rdispl(ip) = rdispl(ip - 1) + rcount(ip - 1) END DO fft_scratch%yzdispl = sdispl fft_scratch%xzdispl = rdispl icrs = 0 - DO ip = 0, np-1 - IF (scount(ip) /= 0) icrs = icrs+1 - IF (rcount(ip) /= 0) icrs = icrs+1 + DO ip = 0, np - 1 + IF (scount(ip) /= 0) icrs = icrs + 1 + IF (rcount(ip) /= 0) icrs = icrs + 1 END DO CALL mp_sum(icrs, group) fft_scratch%rsratio = REAL(icrs, KIND=dp)/(REAL(2*np, KIND=dp)*REAL(np, KIND=dp)) @@ -1723,23 +1723,23 @@ SUBROUTINE yz_to_xz(sb, group, dims, my_pos, p2p, yzp, nray, bo, tb, fft_scratch !$OMP SHARED(np,p2p,pzcoord,bo,nray,yzp,zcor),& !$OMP SHARED(yzbuf,sb,scount,sdispl,my_pos),& !$OMP SHARED(yzbuf_sgl,alltoall_sgl) - DO ip = 0, np-1 + DO ip = 0, np - 1 IF (scount(ip) == 0) CYCLE ipl = p2p(ip) jj = 0 - nx = bo(2, 1, ipl)-bo(1, 1, ipl)+1 + nx = bo(2, 1, ipl) - bo(1, 1, ipl) + 1 DO ir = 1, nray(my_pos) jz = yzp(2, ir, my_pos) IF (zcor(jz) == pzcoord(ipl)) THEN - jj = jj+1 + jj = jj + 1 jy = yzp(1, ir, my_pos) IF (alltoall_sgl) THEN - DO jx = 0, nx-1 - yzbuf_sgl(sdispl(ip)+jj+jx*scount(ip)/nx) = CMPLX(sb(ir, jx+bo(1, 1, ipl)), KIND=sp) + DO jx = 0, nx - 1 + yzbuf_sgl(sdispl(ip) + jj + jx*scount(ip)/nx) = CMPLX(sb(ir, jx + bo(1, 1, ipl)), KIND=sp) END DO ELSE - DO jx = 0, nx-1 - yzbuf(sdispl(ip)+jj+jx*scount(ip)/nx) = sb(ir, jx+bo(1, 1, ipl)) + DO jx = 0, nx - 1 + yzbuf(sdispl(ip) + jj + jx*scount(ip)/nx) = sb(ir, jx + bo(1, 1, ipl)) END DO END IF END IF @@ -1759,32 +1759,32 @@ SUBROUTINE yz_to_xz(sb, group, dims, my_pos, p2p, yzp, nray, bo, tb, fft_scratch myx = fft_scratch%sizes%r_pos(1) myz = fft_scratch%sizes%r_pos(2) - nz = bo(2, 3, rs_pos)-bo(1, 3, rs_pos)+1 + nz = bo(2, 3, rs_pos) - bo(1, 3, rs_pos) + 1 !$OMP PARALLEL DO DEFAULT(NONE), & !$OMP PRIVATE(ipr,jj,ir,jx,jy,jz),& !$OMP SHARED(tb,np,p2p,bo,rs_pos,nray),& !$OMP SHARED(yzp,alltoall_sgl,zcor,myz),& !$OMP SHARED(xzbuf,xzbuf_sgl,nz,rdispl) - DO ip = 0, np-1 + DO ip = 0, np - 1 ipr = p2p(ip) jj = 0 - DO jx = 0, bo(2, 1, rs_pos)-bo(1, 1, rs_pos) + DO jx = 0, bo(2, 1, rs_pos) - bo(1, 1, rs_pos) DO ir = 1, nray(ip) jz = yzp(2, ir, ip) IF (alltoall_sgl) THEN IF (zcor(jz) == myz) THEN - jj = jj+1 + jj = jj + 1 jy = yzp(1, ir, ip) - jz = jz-bo(1, 3, rs_pos)+1 - tb(jy, jz+jx*nz) = xzbuf_sgl(jj+rdispl(ipr)) + jz = jz - bo(1, 3, rs_pos) + 1 + tb(jy, jz + jx*nz) = xzbuf_sgl(jj + rdispl(ipr)) END IF ELSE IF (zcor(jz) == myz) THEN - jj = jj+1 + jj = jj + 1 jy = yzp(1, ir, ip) - jz = jz-bo(1, 3, rs_pos)+1 - tb(jy, jz+jx*nz) = xzbuf(jj+rdispl(ipr)) + jz = jz - bo(1, 3, rs_pos) + 1 + tb(jy, jz + jx*nz) = xzbuf(jj + rdispl(ipr)) END IF END IF END DO @@ -1865,11 +1865,11 @@ SUBROUTINE xz_to_yz(sb, group, dims, my_pos, p2p, yzp, nray, bo, tb, fft_scratch rcount = 0 nx = MAXVAL(bo(2, 1, :)) - DO ix = 0, npx-1 + DO ix = 0, npx - 1 ip = pgrid(ix, 0) xcor(bo(1, 1, ip):bo(2, 1, ip)) = ix END DO - DO iz = 0, npz-1 + DO iz = 0, npz - 1 ip = pgrid(0, iz) zcor(bo(1, 3, ip):bo(2, 3, ip)) = iz END DO @@ -1878,7 +1878,7 @@ SUBROUTINE xz_to_yz(sb, group, dims, my_pos, p2p, yzp, nray, bo, tb, fft_scratch jy = yzp(1, ir, my_pos) jz = yzp(2, ir, my_pos) ip = pgrid(xcor(jx), zcor(jz)) - rcount(ip) = rcount(ip)+1 + rcount(ip) = rcount(ip) + 1 END DO END DO @@ -1889,18 +1889,18 @@ SUBROUTINE xz_to_yz(sb, group, dims, my_pos, p2p, yzp, nray, bo, tb, fft_scratch ! Work out the correct displacements in the buffers sdispl(0) = 0 rdispl(0) = 0 - DO ip = 1, np-1 - sdispl(ip) = sdispl(ip-1)+scount(ip-1) - rdispl(ip) = rdispl(ip-1)+rcount(ip-1) + DO ip = 1, np - 1 + sdispl(ip) = sdispl(ip - 1) + scount(ip - 1) + rdispl(ip) = rdispl(ip - 1) + rcount(ip - 1) END DO fft_scratch%xzdispl = sdispl fft_scratch%yzdispl = rdispl icrs = 0 - DO ip = 0, np-1 - IF (scount(ip) /= 0) icrs = icrs+1 - IF (rcount(ip) /= 0) icrs = icrs+1 + DO ip = 0, np - 1 + IF (scount(ip) /= 0) icrs = icrs + 1 + IF (rcount(ip) /= 0) icrs = icrs + 1 END DO CALL mp_sum(icrs, group) fft_scratch%rsratio = REAL(icrs, KIND=dp)/(REAL(2*np, KIND=dp)*REAL(np, KIND=dp)) @@ -1917,32 +1917,32 @@ SUBROUTINE xz_to_yz(sb, group, dims, my_pos, p2p, yzp, nray, bo, tb, fft_scratch myx = fft_scratch%sizes%r_pos(1) myz = fft_scratch%sizes%r_pos(2) mp = p2p(my_pos) - nz = bo(2, 3, mp)-bo(1, 3, mp)+1 - nx = bo(2, 1, mp)-bo(1, 1, mp)+1 + nz = bo(2, 3, mp) - bo(1, 3, mp) + 1 + nx = bo(2, 1, mp) - bo(1, 1, mp) + 1 !$OMP PARALLEL DO DEFAULT(NONE), & !$OMP PRIVATE(jj,ipl,ir,jx,jy,jz,ixx),& !$OMP SHARED(np,p2p,nray,yzp,zcor,myz,bo,mp),& !$OMP SHARED(alltoall_sgl,nx,scount,sdispl),& !$OMP SHARED(xzbuf,xzbuf_sgl,sb,nz) - DO ip = 0, np-1 + DO ip = 0, np - 1 jj = 0 ipl = p2p(ip) DO ir = 1, nray(ip) jz = yzp(2, ir, ip) IF (zcor(jz) == myz) THEN - jj = jj+1 + jj = jj + 1 jy = yzp(1, ir, ip) - jz = yzp(2, ir, ip)-bo(1, 3, mp)+1 + jz = yzp(2, ir, ip) - bo(1, 3, mp) + 1 IF (alltoall_sgl) THEN - DO jx = 0, nx-1 - ixx = jj+jx*scount(ipl)/nx - xzbuf_sgl(ixx+sdispl(ipl)) = CMPLX(sb(jy, jz+jx*nz), KIND=sp) + DO jx = 0, nx - 1 + ixx = jj + jx*scount(ipl)/nx + xzbuf_sgl(ixx + sdispl(ipl)) = CMPLX(sb(jy, jz + jx*nz), KIND=sp) END DO ELSE - DO jx = 0, nx-1 - ixx = jj+jx*scount(ipl)/nx - xzbuf(ixx+sdispl(ipl)) = sb(jy, jz+jx*nz) + DO jx = 0, nx - 1 + ixx = jj + jx*scount(ipl)/nx + xzbuf(ixx + sdispl(ipl)) = sb(jy, jz + jx*nz) END DO END IF END IF @@ -1965,23 +1965,23 @@ SUBROUTINE xz_to_yz(sb, group, dims, my_pos, p2p, yzp, nray, bo, tb, fft_scratch !$OMP SHARED(p2p,pzcoord,bo,nray,my_pos,yzp),& !$OMP SHARED(rcount,rdispl,tb,yzbuf,zcor),& !$OMP SHARED(yzbuf_sgl,alltoall_sgl,np) - DO ip = 0, np-1 + DO ip = 0, np - 1 IF (rcount(ip) == 0) CYCLE ipl = p2p(ip) jj = 0 - nx = bo(2, 1, ipl)-bo(1, 1, ipl)+1 + nx = bo(2, 1, ipl) - bo(1, 1, ipl) + 1 DO ir = 1, nray(my_pos) jz = yzp(2, ir, my_pos) IF (zcor(jz) == pzcoord(ipl)) THEN - jj = jj+1 + jj = jj + 1 jy = yzp(1, ir, my_pos) IF (alltoall_sgl) THEN - DO jx = 0, nx-1 - tb(ir, jx+bo(1, 1, ipl)) = yzbuf_sgl(rdispl(ip)+jj+jx*rcount(ip)/nx) + DO jx = 0, nx - 1 + tb(ir, jx + bo(1, 1, ipl)) = yzbuf_sgl(rdispl(ip) + jj + jx*rcount(ip)/nx) END DO ELSE - DO jx = 0, nx-1 - tb(ir, jx+bo(1, 1, ipl)) = yzbuf(rdispl(ip)+jj+jx*rcount(ip)/nx) + DO jx = 0, nx - 1 + tb(ir, jx + bo(1, 1, ipl)) = yzbuf(rdispl(ip) + jj + jx*rcount(ip)/nx) END DO END IF END IF @@ -2034,27 +2034,27 @@ SUBROUTINE cube_transpose_1(cin, boin, boout, sout, fft_scratch) pgrid => fft_scratch%pgcube np = DIM(2) - nx = boin(2, 1, mip)-boin(1, 1, mip)+1 - nz = boin(2, 3, mip)-boin(1, 3, mip)+1 + nx = boin(2, 1, mip) - boin(1, 1, mip) + 1 + nz = boin(2, 3, mip) - boin(1, 3, mip) + 1 !$OMP PARALLEL DO DEFAULT(NONE), & !$OMP PRIVATE(ipl,ny), & !$OMP SHARED(np,pgrid,boout,scount,sdispl,nx,nz) - DO ip = 0, np-1 + DO ip = 0, np - 1 ipl = pgrid(ip, 2) - ny = boout(2, 2, ipl)-boout(1, 2, ipl)+1 + ny = boout(2, 2, ipl) - boout(1, 2, ipl) + 1 scount(ip) = nx*nz*ny - sdispl(ip) = nx*nz*(boout(1, 2, ipl)-1) + sdispl(ip) = nx*nz*(boout(1, 2, ipl) - 1) END DO !$OMP END PARALLEL DO - ny = boout(2, 2, mip)-boout(1, 2, mip)+1 - mz = MAXVAL(boin(2, 3, :)-boin(1, 3, :)+1) + ny = boout(2, 2, mip) - boout(1, 2, mip) + 1 + mz = MAXVAL(boin(2, 3, :) - boin(1, 3, :) + 1) !$OMP PARALLEL DO DEFAULT(NONE), & !$OMP PRIVATE(ipl,nz), & !$OMP SHARED(np,pgrid,boin,nx,ny,rcount,rdispl,mz) - DO ip = 0, np-1 + DO ip = 0, np - 1 ipl = pgrid(ip, 2) - nz = boin(2, 3, ipl)-boin(1, 3, ipl)+1 + nz = boin(2, 3, ipl) - boin(1, 3, ipl) + 1 rcount(ip) = nx*nz*ny rdispl(ip) = nx*ny*mz*ip END DO @@ -2068,12 +2068,12 @@ SUBROUTINE cube_transpose_1(cin, boin, boout, sout, fft_scratch) !$OMP PRIVATE(ip,ipl,nz,iz,is,ir) & !$OMP SHARED(nx,ny,np,pgrid,boin,sout,rbuf) DO ixy = 1, nx*ny - DO ip = 0, np-1 + DO ip = 0, np - 1 ipl = pgrid(ip, 2) - nz = boin(2, 3, ipl)-boin(1, 3, ipl)+1 + nz = boin(2, 3, ipl) - boin(1, 3, ipl) + 1 DO iz = 1, nz - is = boin(1, 3, ipl)+iz-1 - ir = iz+nz*(ixy-1) + is = boin(1, 3, ipl) + iz - 1 + ir = iz + nz*(ixy - 1) sout(is, ixy) = rbuf(ir, ip) END DO END DO @@ -2122,9 +2122,9 @@ SUBROUTINE cube_transpose_2(cin, boin, boout, sout, fft_scratch) pgrid => fft_scratch%pgcube np = DIM(2) - nx = boin(2, 1, mip)-boin(1, 1, mip)+1 - ny = boin(2, 2, mip)-boin(1, 2, mip)+1 - mz = MAXVAL(boout(2, 3, :)-boout(1, 3, :)+1) + nx = boin(2, 1, mip) - boin(1, 1, mip) + 1 + ny = boin(2, 2, mip) - boin(1, 2, mip) + 1 + mz = MAXVAL(boout(2, 3, :) - boout(1, 3, :) + 1) rbuf => fft_scratch%rbuf2 @@ -2133,34 +2133,34 @@ SUBROUTINE cube_transpose_2(cin, boin, boout, sout, fft_scratch) !$OMP SHARED(nx,ny,np,pgrid,boout,rbuf,cin,scount,sdispl,mz) !$OMP DO COLLAPSE(2) DO ixy = 1, nx*ny - DO ip = 0, np-1 + DO ip = 0, np - 1 ipl = pgrid(ip, 2) - nz = boout(2, 3, ipl)-boout(1, 3, ipl)+1 + nz = boout(2, 3, ipl) - boout(1, 3, ipl) + 1 DO iz = boout(1, 3, ipl), boout(2, 3, ipl) - ir = iz-boout(1, 3, ipl)+1+(ixy-1)*nz + ir = iz - boout(1, 3, ipl) + 1 + (ixy - 1)*nz rbuf(ir, ip) = cin(iz, ixy) END DO END DO END DO !$OMP END DO !$OMP DO - DO ip = 0, np-1 + DO ip = 0, np - 1 ipl = pgrid(ip, 2) - nz = boout(2, 3, ipl)-boout(1, 3, ipl)+1 + nz = boout(2, 3, ipl) - boout(1, 3, ipl) + 1 scount(ip) = nx*ny*nz sdispl(ip) = nx*ny*mz*ip END DO !$OMP END DO !$OMP END PARALLEL - nz = boout(2, 3, mip)-boout(1, 3, mip)+1 + nz = boout(2, 3, mip) - boout(1, 3, mip) + 1 !$OMP PARALLEL DO DEFAULT(NONE), & !$OMP PRIVATE(ipl,ny), & !$OMP SHARED(np,pgrid,boin,nx,nz,rcount,rdispl) - DO ip = 0, np-1 + DO ip = 0, np - 1 ipl = pgrid(ip, 2) - ny = boin(2, 2, ipl)-boin(1, 2, ipl)+1 + ny = boin(2, 2, ipl) - boin(1, 2, ipl) + 1 rcount(ip) = nx*ny*nz - rdispl(ip) = nx*nz*(boin(1, 2, ipl)-1) + rdispl(ip) = nx*nz*(boin(1, 2, ipl) - 1) END DO !$OMP END PARALLEL DO @@ -2209,26 +2209,26 @@ SUBROUTINE cube_transpose_3(cin, boin, boout, sout, fft_scratch) rdispl => fft_scratch%rdispl pgrid => fft_scratch%pgcube - ny = boin(2, 2, mip)-boin(1, 2, mip)+1 - nz = boin(2, 3, mip)-boin(1, 3, mip)+1 + ny = boin(2, 2, mip) - boin(1, 2, mip) + 1 + nz = boin(2, 3, mip) - boin(1, 3, mip) + 1 !$OMP PARALLEL DO DEFAULT(NONE), & !$OMP PRIVATE(ipl, nx), & !$OMP SHARED(np,pgrid,boout,ny,nz,scount,sdispl) - DO ip = 0, np-1 + DO ip = 0, np - 1 ipl = pgrid(ip, 1) - nx = boout(2, 1, ipl)-boout(1, 1, ipl)+1 + nx = boout(2, 1, ipl) - boout(1, 1, ipl) + 1 scount(ip) = nx*nz*ny - sdispl(ip) = ny*nz*(boout(1, 1, ipl)-1) + sdispl(ip) = ny*nz*(boout(1, 1, ipl) - 1) END DO !$OMP END PARALLEL DO - nx = boout(2, 1, mip)-boout(1, 1, mip)+1 - my = MAXVAL(boin(2, 2, :)-boin(1, 2, :)+1) + nx = boout(2, 1, mip) - boout(1, 1, mip) + 1 + my = MAXVAL(boin(2, 2, :) - boin(1, 2, :) + 1) !$OMP PARALLEL DO DEFAULT(NONE), & !$OMP PRIVATE(ipl, ny), & !$OMP SHARED(np,pgrid,boin,nx,nz,my,rcount,rdispl) - DO ip = 0, np-1 + DO ip = 0, np - 1 ipl = pgrid(ip, 1) - ny = boin(2, 2, ipl)-boin(1, 2, ipl)+1 + ny = boin(2, 2, ipl) - boin(1, 2, ipl) + 1 rcount(ip) = nx*nz*ny rdispl(ip) = nx*my*nz*ip END DO @@ -2244,7 +2244,7 @@ SUBROUTINE cube_transpose_3(cin, boin, boout, sout, fft_scratch) !$ my_id = omp_get_thread_num() IF (my_id < num_threads) THEN lb = (SIZE(rbuf, 2)*my_id)/num_threads - ub = (SIZE(rbuf, 2)*(my_id+1))/num_threads-1 + ub = (SIZE(rbuf, 2)*(my_id + 1))/num_threads - 1 rbuf(:, lb:ub) = 0.0_dp END IF !$OMP END PARALLEL @@ -2255,12 +2255,12 @@ SUBROUTINE cube_transpose_3(cin, boin, boout, sout, fft_scratch) !$OMP PRIVATE(ip,ipl,ny,iy,is,ir) & !$OMP SHARED(nx,nz,np,pgrid,boin,rbuf,sout) DO ixz = 1, nx*nz - DO ip = 0, np-1 + DO ip = 0, np - 1 ipl = pgrid(ip, 1) - ny = boin(2, 2, ipl)-boin(1, 2, ipl)+1 + ny = boin(2, 2, ipl) - boin(1, 2, ipl) + 1 DO iy = 1, ny - is = boin(1, 2, ipl)+iy-1 - ir = iy+ny*(ixz-1) + is = boin(1, 2, ipl) + iy - 1 + ir = iy + ny*(ixz - 1) sout(is, ixz) = rbuf(ir, ip) END DO END DO @@ -2310,9 +2310,9 @@ SUBROUTINE cube_transpose_4(cin, boin, boout, sout, fft_scratch) rdispl => fft_scratch%rdispl pgrid => fft_scratch%pgcube - nx = boin(2, 1, mip)-boin(1, 1, mip)+1 - nz = boin(2, 3, mip)-boin(1, 3, mip)+1 - my = MAXVAL(boout(2, 2, :)-boout(1, 2, :)+1) + nx = boin(2, 1, mip) - boin(1, 1, mip) + 1 + nz = boin(2, 3, mip) - boin(1, 3, mip) + 1 + my = MAXVAL(boout(2, 2, :) - boout(1, 2, :) + 1) rbuf => fft_scratch%rbuf4 num_threads = 1 @@ -2324,41 +2324,41 @@ SUBROUTINE cube_transpose_4(cin, boin, boout, sout, fft_scratch) !$ my_id = omp_get_thread_num() IF (my_id < num_threads) THEN lb = (SIZE(rbuf, 2)*my_id)/num_threads - ub = (SIZE(rbuf, 2)*(my_id+1))/num_threads-1 + ub = (SIZE(rbuf, 2)*(my_id + 1))/num_threads - 1 rbuf(:, lb:ub) = 0.0_dp END IF !$OMP BARRIER !$OMP DO COLLAPSE(2) DO izx = 1, nz*nx - DO ip = 0, np-1 + DO ip = 0, np - 1 ipl = pgrid(ip, 1) - ny = boout(2, 2, ipl)-boout(1, 2, ipl)+1 + ny = boout(2, 2, ipl) - boout(1, 2, ipl) + 1 DO iy = boout(1, 2, ipl), boout(2, 2, ipl) - ir = iy-boout(1, 2, ipl)+1+(izx-1)*ny + ir = iy - boout(1, 2, ipl) + 1 + (izx - 1)*ny rbuf(ir, ip) = cin(iy, izx) END DO END DO END DO !$OMP END DO !$OMP DO - DO ip = 0, np-1 + DO ip = 0, np - 1 ipl = pgrid(ip, 1) - ny = boout(2, 2, ipl)-boout(1, 2, ipl)+1 + ny = boout(2, 2, ipl) - boout(1, 2, ipl) + 1 scount(ip) = nx*ny*nz sdispl(ip) = nx*nz*my*ip END DO !$OMP END DO !$OMP END PARALLEL - ny = boout(2, 2, mip)-boout(1, 2, mip)+1 + ny = boout(2, 2, mip) - boout(1, 2, mip) + 1 !$OMP PARALLEL DO DEFAULT(NONE), & !$OMP PRIVATE(ipl,nx), & !$OMP SHARED(np,pgrid,boin,rcount,rdispl,ny,nz) - DO ip = 0, np-1 + DO ip = 0, np - 1 ipl = pgrid(ip, 1) - nx = boin(2, 1, ipl)-boin(1, 1, ipl)+1 + nx = boin(2, 1, ipl) - boin(1, 1, ipl) + 1 rcount(ip) = nx*ny*nz - rdispl(ip) = ny*nz*(boin(1, 1, ipl)-1) + rdispl(ip) = ny*nz*(boin(1, 1, ipl) - 1) END DO !$OMP END PARALLEL DO @@ -2403,24 +2403,24 @@ SUBROUTINE cube_transpose_5(cin, group, boin, boout, sout, fft_scratch) sdispl => fft_scratch%sdispl rdispl => fft_scratch%rdispl - ny = boin(2, 2, mip)-boin(1, 2, mip)+1 - nz = boin(2, 3, mip)-boin(1, 3, mip)+1 + ny = boin(2, 2, mip) - boin(1, 2, mip) + 1 + nz = boin(2, 3, mip) - boin(1, 3, mip) + 1 !$OMP PARALLEL DO DEFAULT(NONE), & !$OMP PRIVATE(nx), & !$OMP SHARED(np,boout,ny,nz,scount,sdispl) - DO ip = 0, np-1 - nx = boout(2, 1, ip)-boout(1, 1, ip)+1 + DO ip = 0, np - 1 + nx = boout(2, 1, ip) - boout(1, 1, ip) + 1 scount(ip) = nx*nz*ny - sdispl(ip) = ny*nz*(boout(1, 1, ip)-1) + sdispl(ip) = ny*nz*(boout(1, 1, ip) - 1) END DO !$OMP END PARALLEL DO - nx = boout(2, 1, mip)-boout(1, 1, mip)+1 - my = MAXVAL(boin(2, 2, :)-boin(1, 2, :)+1) + nx = boout(2, 1, mip) - boout(1, 1, mip) + 1 + my = MAXVAL(boin(2, 2, :) - boin(1, 2, :) + 1) !$OMP PARALLEL DO DEFAULT(NONE), & !$OMP PRIVATE(ny), & !$OMP SHARED(np,boin,nx,nz,rcount,rdispl,my) - DO ip = 0, np-1 - ny = boin(2, 2, ip)-boin(1, 2, ip)+1 + DO ip = 0, np - 1 + ny = boin(2, 2, ip) - boin(1, 2, ip) + 1 rcount(ip) = nx*nz*ny rdispl(ip) = nx*my*nz*ip END DO @@ -2436,7 +2436,7 @@ SUBROUTINE cube_transpose_5(cin, group, boin, boout, sout, fft_scratch) !$ my_id = omp_get_thread_num() IF (my_id < num_threads) THEN lb = (SIZE(rbuf, 2)*my_id)/num_threads - ub = (SIZE(rbuf, 2)*(my_id+1))/num_threads-1 + ub = (SIZE(rbuf, 2)*(my_id + 1))/num_threads - 1 rbuf(:, lb:ub) = 0.0_dp END IF !$OMP END PARALLEL @@ -2447,11 +2447,11 @@ SUBROUTINE cube_transpose_5(cin, group, boin, boout, sout, fft_scratch) !$OMP PRIVATE(ip,ny,iy,is,ir) & !$OMP SHARED(nx,nz,np,boin,sout,rbuf) DO ixz = 1, nx*nz - DO ip = 0, np-1 - ny = boin(2, 2, ip)-boin(1, 2, ip)+1 + DO ip = 0, np - 1 + ny = boin(2, 2, ip) - boin(1, 2, ip) + 1 DO iy = 1, ny - is = boin(1, 2, ip)+iy-1 - ir = iy+ny*(ixz-1) + is = boin(1, 2, ip) + iy - 1 + ir = iy + ny*(ixz - 1) sout(is, ixz) = rbuf(ir, ip) END DO END DO @@ -2496,9 +2496,9 @@ SUBROUTINE cube_transpose_6(cin, group, boin, boout, sout, fft_scratch) sdispl => fft_scratch%sdispl rdispl => fft_scratch%rdispl - nx = boin(2, 1, mip)-boin(1, 1, mip)+1 - nz = boin(2, 3, mip)-boin(1, 3, mip)+1 - my = MAXVAL(boout(2, 2, :)-boout(1, 2, :)+1) + nx = boin(2, 1, mip) - boin(1, 1, mip) + 1 + nz = boin(2, 3, mip) - boin(1, 3, mip) + 1 + my = MAXVAL(boout(2, 2, :) - boout(1, 2, :) + 1) rbuf => fft_scratch%rbuf5 num_threads = 1 @@ -2510,38 +2510,38 @@ SUBROUTINE cube_transpose_6(cin, group, boin, boout, sout, fft_scratch) !$ my_id = omp_get_thread_num() IF (my_id < num_threads) THEN lb = (SIZE(rbuf, 2)*my_id)/num_threads - ub = (SIZE(rbuf, 2)*(my_id+1))/num_threads-1 + ub = (SIZE(rbuf, 2)*(my_id + 1))/num_threads - 1 rbuf(:, lb:ub) = 0.0_dp END IF !$OMP BARRIER !$OMP DO COLLAPSE(2) DO izx = 1, nz*nx - DO ip = 0, np-1 - ny = boout(2, 2, ip)-boout(1, 2, ip)+1 + DO ip = 0, np - 1 + ny = boout(2, 2, ip) - boout(1, 2, ip) + 1 DO iy = boout(1, 2, ip), boout(2, 2, ip) - ir = iy-boout(1, 2, ip)+1+(izx-1)*ny + ir = iy - boout(1, 2, ip) + 1 + (izx - 1)*ny rbuf(ir, ip) = cin(iy, izx) END DO END DO END DO !$OMP END DO !$OMP DO - DO ip = 0, np-1 - ny = boout(2, 2, ip)-boout(1, 2, ip)+1 + DO ip = 0, np - 1 + ny = boout(2, 2, ip) - boout(1, 2, ip) + 1 scount(ip) = nx*ny*nz sdispl(ip) = nx*nz*my*ip END DO !$OMP END DO !$OMP END PARALLEL - ny = boout(2, 2, mip)-boout(1, 2, mip)+1 + ny = boout(2, 2, mip) - boout(1, 2, mip) + 1 !$OMP PARALLEL DO DEFAULT(NONE), & !$OMP PRIVATE(nx), & !$OMP SHARED(np,boin,rcount,rdispl,nz,ny) - DO ip = 0, np-1 - nx = boin(2, 1, ip)-boin(1, 1, ip)+1 + DO ip = 0, np - 1 + nx = boin(2, 1, ip) - boin(1, 1, ip) + 1 rcount(ip) = nx*ny*nz - rdispl(ip) = ny*nz*(boin(1, 1, ip)-1) + rdispl(ip) = ny*nz*(boin(1, 1, ip) - 1) END DO !$OMP END PARALLEL DO @@ -2611,7 +2611,7 @@ SUBROUTINE init_fft_scratch_pool() ! this is a very special scratch, it seems, we always keep it 'most - recent' so we will never delete it fft_scratch_first%fft_scratch%last_tick = HUGE(fft_scratch_first%fft_scratch%last_tick) - init_fft_pool = init_fft_pool+1 + init_fft_pool = init_fft_pool + 1 END SUBROUTINE init_fft_scratch_pool @@ -2851,7 +2851,7 @@ SUBROUTINE resize_fft_scratch_pool() fft_scratch_current => fft_scratch_first DO IF (ASSOCIATED(fft_scratch_current)) THEN - nscratch = nscratch+1 + nscratch = nscratch + 1 ! is this a candidate for deletion (i.e. least recently used, and not in use) IF (.NOT. fft_scratch_current%fft_scratch%in_use) THEN IF (fft_scratch_current%fft_scratch%last_tick < last_tick) THEN @@ -2937,7 +2937,7 @@ SUBROUTINE get_fft_scratch(fft_scratch, tf_type, n, fft_sizes) CALL resize_fft_scratch_pool() ! get the required scratch - tick_fft_pool = tick_fft_pool+1 + tick_fft_pool = tick_fft_pool + 1 fft_scratch_current => fft_scratch_first DO IF (ASSOCIATED(fft_scratch_current)) THEN @@ -3023,9 +3023,9 @@ SUBROUTINE get_fft_scratch(fft_scratch, tf_type, n, fft_sizes) IF (tf_type .NE. 400) THEN fft_scratch_new%fft_scratch%sizes = fft_sizes np = fft_sizes%numtask - ALLOCATE (fft_scratch_new%fft_scratch%scount(0:np-1), fft_scratch_new%fft_scratch%rcount(0:np-1), & - fft_scratch_new%fft_scratch%sdispl(0:np-1), fft_scratch_new%fft_scratch%rdispl(0:np-1), & - fft_scratch_new%fft_scratch%pgcube(0:np-1, 2)) + ALLOCATE (fft_scratch_new%fft_scratch%scount(0:np - 1), fft_scratch_new%fft_scratch%rcount(0:np - 1), & + fft_scratch_new%fft_scratch%sdispl(0:np - 1), fft_scratch_new%fft_scratch%rdispl(0:np - 1), & + fft_scratch_new%fft_scratch%pgcube(0:np - 1, 2)) END IF SELECT CASE (tf_type) @@ -3054,10 +3054,10 @@ SUBROUTINE get_fft_scratch(fft_scratch, tf_type, n, fft_sizes) mcx2 = fft_sizes%mcx2 mcz2 = fft_sizes%mcz2 mcy3 = fft_sizes%mcy3 - ALLOCATE (fft_scratch_new%fft_scratch%rbuf1(mx2*my1*mcz2, 0:DIM(2)-1)) - ALLOCATE (fft_scratch_new%fft_scratch%rbuf2(mx1*my1*mcz2, 0:DIM(2)-1)) - ALLOCATE (fft_scratch_new%fft_scratch%rbuf3(mx2*mz3*mcy3, 0:DIM(1)-1)) - ALLOCATE (fft_scratch_new%fft_scratch%rbuf4(mx2*mz2*mcy3, 0:DIM(1)-1)) + ALLOCATE (fft_scratch_new%fft_scratch%rbuf1(mx2*my1*mcz2, 0:DIM(2) - 1)) + ALLOCATE (fft_scratch_new%fft_scratch%rbuf2(mx1*my1*mcz2, 0:DIM(2) - 1)) + ALLOCATE (fft_scratch_new%fft_scratch%rbuf3(mx2*mz3*mcy3, 0:DIM(1) - 1)) + ALLOCATE (fft_scratch_new%fft_scratch%rbuf4(mx2*mz2*mcy3, 0:DIM(1) - 1)) dims = (/.TRUE., .FALSE./) CALL mp_cart_sub(fft_sizes%rs_group, dims, fft_scratch_new%fft_scratch%cart_sub_comm(1)) @@ -3065,11 +3065,11 @@ SUBROUTINE get_fft_scratch(fft_scratch, tf_type, n, fft_sizes) CALL mp_cart_sub(fft_sizes%rs_group, dims, fft_scratch_new%fft_scratch%cart_sub_comm(2)) !initialise pgcube - DO i = 0, DIM(1)-1 + DO i = 0, DIM(1) - 1 coord = (/i, pos(2)/) CALL mp_cart_rank(fft_sizes%rs_group, coord, fft_scratch_new%fft_scratch%pgcube(i, 1)) END DO - DO i = 0, DIM(2)-1 + DO i = 0, DIM(2) - 1 coord = (/pos(1), i/) CALL mp_cart_rank(fft_sizes%rs_group, coord, fft_scratch_new%fft_scratch%pgcube(i, 2)) END DO @@ -3107,8 +3107,8 @@ SUBROUTINE get_fft_scratch(fft_scratch, tf_type, n, fft_sizes) fft_scratch_new%fft_scratch%dim = dim fft_scratch_new%fft_scratch%pos = pos mcy3 = fft_sizes%mcy3 - ALLOCATE (fft_scratch_new%fft_scratch%rbuf5(mx1*mz3*mcy3, 0:DIM(1)-1)) - ALLOCATE (fft_scratch_new%fft_scratch%rbuf6(mx1*mz1*mcy3, 0:DIM(1)-1)) + ALLOCATE (fft_scratch_new%fft_scratch%rbuf5(mx1*mz3*mcy3, 0:DIM(1) - 1)) + ALLOCATE (fft_scratch_new%fft_scratch%rbuf6(mx1*mz1*mcy3, 0:DIM(1) - 1)) !set up fft plans CALL fft_create_plan_1dm(fft_scratch_new%fft_scratch%fft_plan(1), fft_type, FWFFT, .TRUE., n(3), mx1*my1, & @@ -3154,9 +3154,9 @@ SUBROUTINE get_fft_scratch(fft_scratch, tf_type, n, fft_sizes) nm = nmray*mx2 IF (alltoall_sgl) THEN ALLOCATE (fft_scratch_new%fft_scratch%ss(mmax, lmax)) - ALLOCATE (fft_scratch_new%fft_scratch%tt(nm, 0:np-1)) + ALLOCATE (fft_scratch_new%fft_scratch%tt(nm, 0:np - 1)) ELSE - ALLOCATE (fft_scratch_new%fft_scratch%rr(nm, 0:np-1)) + ALLOCATE (fft_scratch_new%fft_scratch%rr(nm, 0:np - 1)) END IF !set up fft plans @@ -3225,14 +3225,14 @@ SUBROUTINE get_fft_scratch(fft_scratch, tf_type, n, fft_sizes) ALLOCATE (fft_scratch_new%fft_scratch%yzbuf(mg*lg)) ALLOCATE (fft_scratch_new%fft_scratch%xzbuf(n(2)*mx2*mz2)) END IF - ALLOCATE (fft_scratch_new%fft_scratch%pgrid(0:m1-1, 0:m2-1)) + ALLOCATE (fft_scratch_new%fft_scratch%pgrid(0:m1 - 1, 0:m2 - 1)) ALLOCATE (fft_scratch_new%fft_scratch%xcor(nbx)) ALLOCATE (fft_scratch_new%fft_scratch%zcor(nbz)) - ALLOCATE (fft_scratch_new%fft_scratch%pzcoord(0:np-1)) - ALLOCATE (fft_scratch_new%fft_scratch%xzcount(0:np-1), & - fft_scratch_new%fft_scratch%yzcount(0:np-1)) - ALLOCATE (fft_scratch_new%fft_scratch%xzdispl(0:np-1), & - fft_scratch_new%fft_scratch%yzdispl(0:np-1)) + ALLOCATE (fft_scratch_new%fft_scratch%pzcoord(0:np - 1)) + ALLOCATE (fft_scratch_new%fft_scratch%xzcount(0:np - 1), & + fft_scratch_new%fft_scratch%yzcount(0:np - 1)) + ALLOCATE (fft_scratch_new%fft_scratch%xzdispl(0:np - 1), & + fft_scratch_new%fft_scratch%yzdispl(0:np - 1)) fft_scratch_new%fft_scratch%in = 0 fft_scratch_new%fft_scratch%rsratio = 1._dp fft_scratch_new%fft_scratch%group = fft_sizes%gs_group @@ -3243,28 +3243,28 @@ SUBROUTINE get_fft_scratch(fft_scratch, tf_type, n, fft_sizes) fft_scratch_new%fft_scratch%pos = pos mcz1 = fft_sizes%mcz1 mcz2 = fft_sizes%mcz2 - ALLOCATE (fft_scratch_new%fft_scratch%rbuf1(mx2*my1*mcz2, 0:DIM(2)-1)) - ALLOCATE (fft_scratch_new%fft_scratch%rbuf2(mx1*my1*mcz2, 0:DIM(2)-1)) + ALLOCATE (fft_scratch_new%fft_scratch%rbuf1(mx2*my1*mcz2, 0:DIM(2) - 1)) + ALLOCATE (fft_scratch_new%fft_scratch%rbuf2(mx1*my1*mcz2, 0:DIM(2) - 1)) dims = (/.FALSE., .TRUE./) CALL mp_cart_sub(fft_sizes%rs_group, dims, fft_scratch_new%fft_scratch%cart_sub_comm(2)) !initialise pgcube - DO i = 0, DIM(2)-1 + DO i = 0, DIM(2) - 1 coord = (/pos(1), i/) CALL mp_cart_rank(fft_sizes%rs_group, coord, fft_scratch_new%fft_scratch%pgcube(i, 2)) END DO !initialise pgrid - DO ix = 0, m1-1 - DO iz = 0, m2-1 + DO ix = 0, m1 - 1 + DO iz = 0, m2 - 1 coord = (/ix, iz/) CALL mp_cart_rank(fft_sizes%rs_group, coord, fft_scratch_new%fft_scratch%pgrid(ix, iz)) END DO END DO !initialise pzcoord - DO i = 0, np-1 + DO i = 0, np - 1 CALL mp_cart_coords(fft_sizes%rs_group, i, pcoord) fft_scratch_new%fft_scratch%pzcoord(i) = pcoord(2) END DO @@ -3303,7 +3303,7 @@ SUBROUTINE get_fft_scratch(fft_scratch, tf_type, n, fft_sizes) NULLIFY (fft_scratch_new%fft_scratch_next) fft_scratch_new%fft_scratch%fft_scratch_id = & - fft_scratch_last%fft_scratch%fft_scratch_id+1 + fft_scratch_last%fft_scratch%fft_scratch_id + 1 fft_scratch_new%fft_scratch%in_use = .TRUE. fft_scratch_new%fft_scratch%nfft = n fft_scratch_last%fft_scratch_next => fft_scratch_new @@ -3377,32 +3377,32 @@ SUBROUTINE sparse_alltoall(rs, scount, sdispl, rq, rcount, rdispl, group) CALL mp_sync(group) CALL mp_environ(n, pos, group) - ALLOCATE (sreq(0:n-1)) - ALLOCATE (rreq(0:n-1)) + ALLOCATE (sreq(0:n - 1)) + ALLOCATE (rreq(0:n - 1)) nr = 0 - DO ip = 0, n-1 + DO ip = 0, n - 1 IF (rcount(ip) == 0) CYCLE IF (ip == pos) CYCLE - msgout => rq(rdispl(ip)+1:rdispl(ip)+rcount(ip)) + msgout => rq(rdispl(ip) + 1:rdispl(ip) + rcount(ip)) CALL mp_irecv(msgout, ip, group, rn) - nr = nr+1 - rreq(nr-1) = rn + nr = nr + 1 + rreq(nr - 1) = rn END DO ns = 0 - DO ip = 0, n-1 + DO ip = 0, n - 1 IF (scount(ip) == 0) CYCLE IF (ip == pos) CYCLE - msgin => rs(sdispl(ip)+1:sdispl(ip)+scount(ip)) + msgin => rs(sdispl(ip) + 1:sdispl(ip) + scount(ip)) CALL mp_isend(msgin, ip, group, sn) - ns = ns+1 - sreq(ns-1) = sn + ns = ns + 1 + sreq(ns - 1) = sn END DO IF (rcount(pos) /= 0) THEN IF (rcount(pos) /= scount(pos)) CPABORT("") - rq(rdispl(pos)+1:rdispl(pos)+rcount(pos)) = rs(sdispl(pos)+1:sdispl(pos)+scount(pos)) + rq(rdispl(pos) + 1:rdispl(pos) + rcount(pos)) = rs(sdispl(pos) + 1:sdispl(pos) + scount(pos)) END IF - CALL mp_waitall(sreq(0:ns-1)) - CALL mp_waitall(rreq(0:nr-1)) + CALL mp_waitall(sreq(0:ns - 1)) + CALL mp_waitall(rreq(0:nr - 1)) DEALLOCATE (sreq) DEALLOCATE (rreq) CALL mp_sync(group) diff --git a/src/pw/lazy.F b/src/pw/lazy.F index 44cc958cef..19d41346ee 100644 --- a/src/pw/lazy.F +++ b/src/pw/lazy.F @@ -79,9 +79,9 @@ SUBROUTINE lazy_arrays(itype, m, ch, cg, cgt, cht) cht(0) = 1._dp ! g coefficients from h coefficients - DO i = -m, m-1 - cg(i+1) = cht(-i)*(-1)**(i+1) - cgt(i+1) = ch(-i)*(-1)**(i+1) + DO i = -m, m - 1 + cg(i + 1) = cht(-i)*(-1)**(i + 1) + cgt(i + 1) = ch(-i)*(-1)**(i + 1) ENDDO CASE (14) @@ -107,9 +107,9 @@ SUBROUTINE lazy_arrays(itype, m, ch, cg, cgt, cht) cht(0) = 1._dp ! g coefficients from h coefficients - DO i = -m, m-1 - cg(i+1) = cht(-i)*(-1)**(i+1) - cgt(i+1) = ch(-i)*(-1)**(i+1) + DO i = -m, m - 1 + cg(i + 1) = cht(-i)*(-1)**(i + 1) + cgt(i + 1) = ch(-i)*(-1)**(i + 1) ENDDO CASE (16) @@ -136,9 +136,9 @@ SUBROUTINE lazy_arrays(itype, m, ch, cg, cgt, cht) cht(0) = 1._dp ! g coefficients from h coefficients - DO i = -m, m-1 - cg(i+1) = cht(-i)*(-1)**(i+1) - cgt(i+1) = ch(-i)*(-1)**(i+1) + DO i = -m, m - 1 + cg(i + 1) = cht(-i)*(-1)**(i + 1) + cgt(i + 1) = ch(-i)*(-1)**(i + 1) ENDDO CASE (20) @@ -169,9 +169,9 @@ SUBROUTINE lazy_arrays(itype, m, ch, cg, cgt, cht) cht(0) = 1._dp ! g coefficients from h coefficients - DO i = -m, m-1 - cg(i+1) = cht(-i)*(-1)**(i+1) - cgt(i+1) = ch(-i)*(-1)**(i+1) + DO i = -m, m - 1 + cg(i + 1) = cht(-i)*(-1)**(i + 1) + cgt(i + 1) = ch(-i)*(-1)**(i + 1) ENDDO CASE (24) @@ -204,9 +204,9 @@ SUBROUTINE lazy_arrays(itype, m, ch, cg, cgt, cht) cht(0) = 1._dp ! g coefficients from h coefficients - DO i = -m, m-1 - cg(i+1) = cht(-i)*(-1)**(i+1) - cgt(i+1) = ch(-i)*(-1)**(i+1) + DO i = -m, m - 1 + cg(i + 1) = cht(-i)*(-1)**(i + 1) + cgt(i + 1) = ch(-i)*(-1)**(i + 1) ENDDO CASE (30) @@ -242,9 +242,9 @@ SUBROUTINE lazy_arrays(itype, m, ch, cg, cgt, cht) cht(0) = 1._dp ! g coefficients from h coefficients - DO i = -m, m-1 - cg(i+1) = cht(-i)*(-1)**(i+1) - cgt(i+1) = ch(-i)*(-1)**(i+1) + DO i = -m, m - 1 + cg(i + 1) = cht(-i)*(-1)**(i + 1) + cgt(i + 1) = ch(-i)*(-1)**(i + 1) ENDDO CASE (40) @@ -285,9 +285,9 @@ SUBROUTINE lazy_arrays(itype, m, ch, cg, cgt, cht) cht(0) = 1._dp ! g coefficients from h coefficients - DO i = -m, m-1 - cg(i+1) = cht(-i)*(-1)**(i+1) - cgt(i+1) = ch(-i)*(-1)**(i+1) + DO i = -m, m - 1 + cg(i + 1) = cht(-i)*(-1)**(i + 1) + cgt(i + 1) = ch(-i)*(-1)**(i + 1) ENDDO CASE (50) @@ -334,9 +334,9 @@ SUBROUTINE lazy_arrays(itype, m, ch, cg, cgt, cht) cht(0) = 1._dp ! g coefficients from h coefficients - DO i = -m, m-1 - cg(i+1) = cht(-i)*(-1)**(i+1) - cgt(i+1) = ch(-i)*(-1)**(i+1) + DO i = -m, m - 1 + cg(i + 1) = cht(-i)*(-1)**(i + 1) + cgt(i + 1) = ch(-i)*(-1)**(i + 1) ENDDO CASE (60) @@ -388,41 +388,41 @@ SUBROUTINE lazy_arrays(itype, m, ch, cg, cgt, cht) cht(0) = 1._dp ! g coefficients from h coefficients - DO i = -m, m-1 - cg(i+1) = cht(-i)*(-1)**(i+1) - cgt(i+1) = ch(-i)*(-1)**(i+1) + DO i = -m, m - 1 + cg(i + 1) = cht(-i)*(-1)**(i + 1) + cgt(i + 1) = ch(-i)*(-1)**(i + 1) ENDDO CASE (100) !******** coefficients for wavelet transform ********************* - ch(-m:-m+22) = (/ & - 0._dp, 0._dp, 0._dp, & - -1.2683805626484815e-31_dp, 0._dp, 1.28158741180595538e-29_dp, 0._dp, & - -6.41198417717232202e-28_dp, 0._dp, 2.11779334023809847e-26_dp, 0._dp, & - -5.19441179715542395e-25_dp, 0._dp, 1.00911662890805933e-23_dp, 0._dp, & - -1.61729304931893186e-22_dp, 0._dp, 2.19924673311587861e-21_dp, 0._dp, & - -2.59007672484430282e-20_dp, 0._dp, 2.68351845030850743e-19_dp, 0._dp/) - ch(-m+23:0) = (/ & - -2.47631006363911635e-18_dp, 0._dp, 2.05560047903738218e-17_dp, 0._dp, & - -1.54763876066192241e-16_dp, 0._dp, 1.06410357358472536e-15_dp, 0._dp, & - -6.72076683598079057e-15_dp, 0._dp, 3.91882394735691508e-14_dp, 0._dp, & - -2.1187969775075261e-13_dp, 0._dp, 1.06630135673478305e-12_dp, 0._dp, & - -5.01180443685748998e-12_dp, 0._dp, 2.20666419683207691e-11_dp, 0._dp, & - -9.1258654919835045e-11_dp, 0._dp, 3.55352205999457932e-10_dp, 0._dp, & - -1.30569909741619005e-9_dp, 0._dp, 4.53620646231137398e-9_dp, 0._dp, & - -1.49279735540769725e-8_dp, 0._dp, 4.66118357913015673e-8_dp, 0._dp, & - -1.38309751701521672e-7_dp, 0._dp, 3.90568525175243503e-7_dp, 0._dp, & - -1.05103157937523999e-6_dp, 0._dp, 2.69873794098621337e-6_dp, 0._dp, & - -6.61998110310293365e-6_dp, 0._dp, 0.0000155312721433740143_dp, 0._dp, & - -0.0000348898934935080536_dp, 0._dp, 0.0000751302114254144957_dp, 0._dp, & - -0.000155250095336387829_dp, 0._dp, 0.000308205854288494064_dp, 0._dp, & - -0.000588508297900663563_dp, 0._dp, 0.00108221904295030132_dp, 0._dp, & - -0.00191926718143360074_dp, 0._dp, 0.00328782888345707184_dp, 0._dp, & - -0.00545087420152093489_dp, 0._dp, 0.00876675750345045625_dp, 0._dp, & - -0.0137206712673049998_dp, 0._dp, 0.0209859998811194541_dp, 0._dp, & - -0.031565718829452402_dp, 0._dp, 0.0471537281279474153_dp, 0._dp, & - -0.0711699126403181485_dp, 0._dp, 0.112357606764076737_dp, 0._dp, & - -0.202867901101805219_dp, 0._dp, 0.633444670787269357_dp, 1._dp/) + ch(-m:-m + 22) = (/ & + 0._dp, 0._dp, 0._dp, & + -1.2683805626484815e-31_dp, 0._dp, 1.28158741180595538e-29_dp, 0._dp, & + -6.41198417717232202e-28_dp, 0._dp, 2.11779334023809847e-26_dp, 0._dp, & + -5.19441179715542395e-25_dp, 0._dp, 1.00911662890805933e-23_dp, 0._dp, & + -1.61729304931893186e-22_dp, 0._dp, 2.19924673311587861e-21_dp, 0._dp, & + -2.59007672484430282e-20_dp, 0._dp, 2.68351845030850743e-19_dp, 0._dp/) + ch(-m + 23:0) = (/ & + -2.47631006363911635e-18_dp, 0._dp, 2.05560047903738218e-17_dp, 0._dp, & + -1.54763876066192241e-16_dp, 0._dp, 1.06410357358472536e-15_dp, 0._dp, & + -6.72076683598079057e-15_dp, 0._dp, 3.91882394735691508e-14_dp, 0._dp, & + -2.1187969775075261e-13_dp, 0._dp, 1.06630135673478305e-12_dp, 0._dp, & + -5.01180443685748998e-12_dp, 0._dp, 2.20666419683207691e-11_dp, 0._dp, & + -9.1258654919835045e-11_dp, 0._dp, 3.55352205999457932e-10_dp, 0._dp, & + -1.30569909741619005e-9_dp, 0._dp, 4.53620646231137398e-9_dp, 0._dp, & + -1.49279735540769725e-8_dp, 0._dp, 4.66118357913015673e-8_dp, 0._dp, & + -1.38309751701521672e-7_dp, 0._dp, 3.90568525175243503e-7_dp, 0._dp, & + -1.05103157937523999e-6_dp, 0._dp, 2.69873794098621337e-6_dp, 0._dp, & + -6.61998110310293365e-6_dp, 0._dp, 0.0000155312721433740143_dp, 0._dp, & + -0.0000348898934935080536_dp, 0._dp, 0.0000751302114254144957_dp, 0._dp, & + -0.000155250095336387829_dp, 0._dp, 0.000308205854288494064_dp, 0._dp, & + -0.000588508297900663563_dp, 0._dp, 0.00108221904295030132_dp, 0._dp, & + -0.00191926718143360074_dp, 0._dp, 0.00328782888345707184_dp, 0._dp, & + -0.00545087420152093489_dp, 0._dp, 0.00876675750345045625_dp, 0._dp, & + -0.0137206712673049998_dp, 0._dp, 0.0209859998811194541_dp, 0._dp, & + -0.031565718829452402_dp, 0._dp, 0.0471537281279474153_dp, 0._dp, & + -0.0711699126403181485_dp, 0._dp, 0.112357606764076737_dp, 0._dp, & + -0.202867901101805219_dp, 0._dp, 0.633444670787269357_dp, 1._dp/) ch(1:80) = (/0.633444670787269357_dp, & 0._dp, -0.202867901101805219_dp, 0._dp, 0.112357606764076737_dp, 0._dp, & -0.0711699126403181485_dp, 0._dp, 0.0471537281279474153_dp, 0._dp, & @@ -464,9 +464,9 @@ SUBROUTINE lazy_arrays(itype, m, ch, cg, cgt, cht) cht(0) = 1._dp ! g coefficients from h coefficients - DO i = -m, m-1 - cg(i+1) = cht(-i)*(-1)**(i+1) - cgt(i+1) = ch(-i)*(-1)**(i+1) + DO i = -m, m - 1 + cg(i + 1) = cht(-i)*(-1)**(i + 1) + cgt(i + 1) = ch(-i)*(-1)**(i + 1) ENDDO END SELECT diff --git a/src/pw/lgrid_types.F b/src/pw/lgrid_types.F index e02bcb33fd..87722c4039 100644 --- a/src/pw/lgrid_types.F +++ b/src/pw/lgrid_types.F @@ -82,7 +82,7 @@ SUBROUTINE lgrid_release(lgrid) IF (ASSOCIATED(lgrid)) THEN CPASSERT(lgrid%ref_count > 0) - lgrid%ref_count = lgrid%ref_count-1 + lgrid%ref_count = lgrid%ref_count - 1 IF (lgrid%ref_count < 1) THEN IF (ASSOCIATED(lgrid%r)) THEN DEALLOCATE (lgrid%r) @@ -113,7 +113,7 @@ SUBROUTINE lgrid_allocate_grid(lgrid, nthreads) CPASSERT(ASSOCIATED(lgrid)) CPASSERT(.NOT. ASSOCIATED(lgrid%r)) - ALLOCATE (lgrid%r(lgrid%ldim, 0:nthreads-1)) + ALLOCATE (lgrid%r(lgrid%ldim, 0:nthreads - 1)) CALL timestop(handle) END SUBROUTINE diff --git a/src/pw/mt_util.F b/src/pw/mt_util.F index bfd50e6b15..e275ceb9e6 100644 --- a/src/pw/mt_util.F +++ b/src/pw/mt_util.F @@ -107,17 +107,17 @@ SUBROUTINE MTin_create_screen_fn(screen_function, pw_pool, method, alpha, & DO ig = screen_function%pw_grid%first_gne0, screen_function%pw_grid%ngpts_cut_local g2 = screen_function%pw_grid%gsq(ig) g3d = fourpi/g2 - screen_function%cc(ig) = screen_function%cc(ig)-g3d*EXP(-g2/(4.0E0_dp*alpha2)) + screen_function%cc(ig) = screen_function%cc(ig) - g3d*EXP(-g2/(4.0E0_dp*alpha2)) END DO IF (screen_function%pw_grid%have_g0) & - screen_function%cc(1) = screen_function%cc(1)+fourpi/(4.0E0_dp*alpha2) + screen_function%cc(1) = screen_function%cc(1) + fourpi/(4.0E0_dp*alpha2) CASE (MT2D) iz = special_dimension ! iz is the direction with NO PBC zlength = slab_size ! zlength is the thickness of the cell DO ig = screen_function%pw_grid%first_gne0, screen_function%pw_grid%ngpts_cut_local gz = screen_function%pw_grid%g(iz, ig) g2 = screen_function%pw_grid%gsq(ig) - gxy = SQRT(ABS(g2-gz*gz)) + gxy = SQRT(ABS(g2 - gz*gz)) g3d = fourpi/g2 screen_function%cc(ig) = -g3d*COS(gz*zlength/2.0_dp)*EXP(-gxy*zlength/2.0_dp) END DO @@ -168,27 +168,27 @@ SUBROUTINE mt0din(Vloc, alpha) dz = grid%dr(3) kk = bo(1, 3) DO k = bo(1, 3), bo(2, 3) - z = REAL(k-glb(3), dp)*dz; IF (z .GT. box2(3)) z = box(3)-z + z = REAL(k - glb(3), dp)*dz; IF (z .GT. box2(3)) z = box(3) - z z2 = z*z jj = bo(1, 2) DO j = bo(1, 2), bo(2, 2) - y = REAL(j-glb(2), dp)*dy; IF (y .GT. box2(2)) y = box(2)-y + y = REAL(j - glb(2), dp)*dy; IF (y .GT. box2(2)) y = box(2) - y y2 = y*y ii = bo(1, 1) DO i = bo(1, 1), bo(2, 1) - x = REAL(i-glb(1), dp)*dx; IF (x .GT. box2(1)) x = box(1)-x - r2 = x*x+y2+z2 + x = REAL(i - glb(1), dp)*dx; IF (x .GT. box2(1)) x = box(1) - x + r2 = x*x + y2 + z2 r = SQRT(r2) IF (r .GT. 1.0E-10_dp) THEN Vloc%cr3d(ii, jj, kk) = erf(alpha*r)/r*fact ELSE Vloc%cr3d(ii, jj, kk) = 2.0_dp*alpha*oorootpi*fact END IF - ii = ii+1 + ii = ii + 1 END DO - jj = jj+1 + jj = jj + 1 END DO - kk = kk+1 + kk = kk + 1 END DO CALL timestop(handle) END SUBROUTINE Mt0din diff --git a/src/pw/ps_implicit_methods.F b/src/pw/ps_implicit_methods.F index d843b58dc3..86f5fbb116 100644 --- a/src/pw/ps_implicit_methods.F +++ b/src/pw/ps_implicit_methods.F @@ -260,7 +260,7 @@ SUBROUTINE implicit_poisson_solver_periodic(poisson_env, density, v_new, ehartre CALL apply_P_operator(pw_pool, dielectric, QAinvxres, PxQAinvxres) CALL pw_copy(PxQAinvxres, res_new) CALL pw_scale(res_new, -1.0_dp) - CALL pw_axpy(res_old, res_new, 1.0_dp-omega) + CALL pw_axpy(res_old, res_new, 1.0_dp - omega) ! compute the error CALL ps_implicit_compute_error_fft(pw_pool, green, res_new, v_old, v_new, QAinvxres, & @@ -275,12 +275,12 @@ SUBROUTINE implicit_poisson_solver_periodic(poisson_env, density, v_new, ehartre IF (outp_unit .GT. 0) WRITE (outp_unit, '(A1,/)') END IF - iter = iter+1 + iter = iter + 1 reached_max_iter = iter .GT. max_iter reached_tol = pres_error .LE. tol IF (pres_error .GT. large_error) & CPABORT("Poisson solver did not converge.") - ps_implicit_env%times_called = ps_implicit_env%times_called+1 + ps_implicit_env%times_called = ps_implicit_env%times_called + 1 IF (reached_max_iter .OR. reached_tol) EXIT ! v_old = v_new, res_old = res_new @@ -421,7 +421,7 @@ SUBROUTINE implicit_poisson_solver_neumann(poisson_env, density, v_new, ehartree CALL apply_P_operator(pw_pool_xpndd, dielectric, QAinvxres, PxQAinvxres) CALL pw_copy(PxQAinvxres, res_new) CALL pw_scale(res_new, -1.0_dp) - CALL pw_axpy(res_old, res_new, 1.0_dp-omega) + CALL pw_axpy(res_old, res_new, 1.0_dp - omega) ! compute the error CALL ps_implicit_compute_error_dct(pw_pool_xpndd, green, res_new, v_old, v_new_xpndd, QAinvxres, & @@ -436,12 +436,12 @@ SUBROUTINE implicit_poisson_solver_neumann(poisson_env, density, v_new, ehartree IF (outp_unit .GT. 0) WRITE (outp_unit, '(A1,/)') END IF - iter = iter+1 + iter = iter + 1 reached_max_iter = iter .GT. max_iter reached_tol = pres_error .LE. tol IF (pres_error .GT. large_error) & CPABORT("Poisson solver did not converge.") - ps_implicit_env%times_called = ps_implicit_env%times_called+1 + ps_implicit_env%times_called = ps_implicit_env%times_called + 1 IF (reached_max_iter .OR. reached_tol) EXIT ! v_old = v_new, res_old = res_new @@ -544,7 +544,7 @@ SUBROUTINE implicit_poisson_solver_mixed_periodic(poisson_env, density, v_new, e n_contacts = SIZE(ps_implicit_env%contacts) n_tiles_tot = 0 DO j = 1, n_contacts - n_tiles_tot = n_tiles_tot+ps_implicit_env%contacts(j)%dirichlet_bc%n_tiles + n_tiles_tot = n_tiles_tot + ps_implicit_env%contacts(j)%dirichlet_bc%n_tiles END DO IF (pw_grid%para%blocked) THEN @@ -561,7 +561,7 @@ SUBROUTINE implicit_poisson_solver_mixed_periodic(poisson_env, density, v_new, e ALLOCATE (B(n_tiles_tot, data_size)) ALLOCATE (Bt(data_size, n_tiles_tot)) ALLOCATE (QS(n_tiles_tot, n_tiles_tot)) - ALLOCATE (Rinv(n_tiles_tot+1, n_tiles_tot+1)) + ALLOCATE (Rinv(n_tiles_tot + 1, n_tiles_tot + 1)) B(:, :) = ps_implicit_env%B Bt(:, :) = ps_implicit_env%Bt @@ -578,8 +578,8 @@ SUBROUTINE implicit_poisson_solver_mixed_periodic(poisson_env, density, v_new, e ALLOCATE (Btxlambda_old(data_size), Btxlambda_new(data_size)) ALLOCATE (Btxlambda_old3D(lb1:ub1, lb2:ub2, lb3:ub3), Btxlambda_new3D(lb1:ub1, lb2:ub2, lb3:ub3)) ALLOCATE (QSxlambda(n_tiles_tot)) - ALLOCATE (w(n_tiles_tot+1)) - ALLOCATE (lambda_newNeta(n_tiles_tot+1)) + ALLOCATE (w(n_tiles_tot + 1)) + ALLOCATE (lambda_newNeta(n_tiles_tot + 1)) ALLOCATE (v_bar1D(data_size)) ALLOCATE (Bxv_bar(n_tiles_tot)) @@ -632,7 +632,7 @@ SUBROUTINE implicit_poisson_solver_mixed_periodic(poisson_env, density, v_new, e ! = 1^t * (g - P(\bar{v})) CALL apply_P_operator(pw_pool, dielectric, v_new, Axvbar) Axvbar_avg = accurate_sum(Axvbar%cr3d)/ngpts - gminusAxvbar_avg = g_avg-Axvbar_avg + gminusAxvbar_avg = g_avg - Axvbar_avg CALL mp_sum(gminusAxvbar_avg, pw_grid%para%group) ! evaluate Q_S * \lambda + v_D - B * \bar{v} @@ -642,10 +642,10 @@ SUBROUTINE implicit_poisson_solver_mixed_periodic(poisson_env, density, v_new, e CALL mp_sum(Bxv_bar, pw_grid%para%group) ! solve R [\lambda; \eta] = [Q_S * \lambda + v_D - B * \bar{v}; 1^t * (g - \Delta(\bar{v}) - P(\bar{v}))] w = 0.0_dp - w(:) = (/QSxlambda+v_D-Bxv_bar, gminusAxvbar_avg/) - CALL DGEMV('N', n_tiles_tot+1, n_tiles_tot+1, 1.0_dp, Rinv, n_tiles_tot+1, w, 1, 0.0_dp, lambda_newNeta, 1) + w(:) = (/QSxlambda + v_D - Bxv_bar, gminusAxvbar_avg/) + CALL DGEMV('N', n_tiles_tot + 1, n_tiles_tot + 1, 1.0_dp, Rinv, n_tiles_tot + 1, w, 1, 0.0_dp, lambda_newNeta, 1) lambda_new(:) = lambda_newNeta(1:n_tiles_tot) - eta = lambda_newNeta(n_tiles_tot+1) + eta = lambda_newNeta(n_tiles_tot + 1) ! v_new = v_bar + 1 * \eta v_new%cr3d = v_new%cr3d+eta/ngpts @@ -661,7 +661,7 @@ SUBROUTINE implicit_poisson_solver_mixed_periodic(poisson_env, density, v_new, e CALL pw_zero(res_new) CALL apply_P_operator(pw_pool, dielectric, QAinvxres, PxQAinvxres) CALL pw_axpy(PxQAinvxres, res_new, -1.0_dp) - CALL pw_axpy(res_old, res_new, 1.0_dp-omega) + CALL pw_axpy(res_old, res_new, 1.0_dp - omega) res_new%cr3d = res_new%cr3d+Btxlambda_old3D-Btxlambda_new3D ! compute the error @@ -691,7 +691,7 @@ SUBROUTINE implicit_poisson_solver_mixed_periodic(poisson_env, density, v_new, e DO ng = 1, n_contacts DO nt = 1, ps_implicit_env%contacts(ng)%dirichlet_bc%n_tiles WRITE (outp_unit, '(T17,I6,5X,I6,3X,E13.4,E13.4)') ng, nt, Bxv_new(nt_tot), lambda_new(nt_tot) - nt_tot = nt_tot+1 + nt_tot = nt_tot + 1 END DO END DO WRITE (outp_unit, '(T3,A)') REPEAT('=', 78) @@ -699,10 +699,10 @@ SUBROUTINE implicit_poisson_solver_mixed_periodic(poisson_env, density, v_new, e END IF ! check the convergence - iter = iter+1 + iter = iter + 1 reached_max_iter = iter .GT. max_iter reached_tol = pres_error .LE. tol - ps_implicit_env%times_called = ps_implicit_env%times_called+1 + ps_implicit_env%times_called = ps_implicit_env%times_called + 1 IF (pres_error .GT. large_error) & CPABORT("Poisson solver did not converge.") IF (reached_max_iter .OR. reached_tol) EXIT @@ -818,7 +818,7 @@ SUBROUTINE implicit_poisson_solver_mixed(poisson_env, density, v_new, electric_e n_contacts = SIZE(ps_implicit_env%contacts) n_tiles_tot = 0 DO j = 1, n_contacts - n_tiles_tot = n_tiles_tot+ps_implicit_env%contacts(j)%dirichlet_bc%n_tiles + n_tiles_tot = n_tiles_tot + ps_implicit_env%contacts(j)%dirichlet_bc%n_tiles END DO IF (dct_pw_grid%para%blocked) THEN @@ -837,7 +837,7 @@ SUBROUTINE implicit_poisson_solver_mixed(poisson_env, density, v_new, electric_e ALLOCATE (B(n_tiles_tot, data_size)) ALLOCATE (Bt(data_size, n_tiles_tot)) ALLOCATE (QS(n_tiles_tot, n_tiles_tot)) - ALLOCATE (Rinv(n_tiles_tot+1, n_tiles_tot+1)) + ALLOCATE (Rinv(n_tiles_tot + 1, n_tiles_tot + 1)) B(:, :) = ps_implicit_env%B Bt(:, :) = ps_implicit_env%Bt @@ -854,8 +854,8 @@ SUBROUTINE implicit_poisson_solver_mixed(poisson_env, density, v_new, electric_e ALLOCATE (Btxlambda_old(data_size), Btxlambda_new(data_size)) ALLOCATE (Btxlambda_old3D(lb1:ub1, lb2:ub2, lb3:ub3), Btxlambda_new3D(lb1:ub1, lb2:ub2, lb3:ub3)) ALLOCATE (QSxlambda(n_tiles_tot)) - ALLOCATE (w(n_tiles_tot+1)) - ALLOCATE (lambda_newNeta(n_tiles_tot+1)) + ALLOCATE (w(n_tiles_tot + 1)) + ALLOCATE (lambda_newNeta(n_tiles_tot + 1)) ALLOCATE (v_bar1D(data_size)) ALLOCATE (Bxv_bar(n_tiles_tot)) @@ -918,7 +918,7 @@ SUBROUTINE implicit_poisson_solver_mixed(poisson_env, density, v_new, electric_e ! = 1^t * (g - P(\bar{v})) CALL apply_P_operator(pw_pool_xpndd, dielectric, v_new_xpndd, Axvbar) Axvbar_avg = accurate_sum(Axvbar%cr3d)/ngpts - gminusAxvbar_avg = g_avg-Axvbar_avg + gminusAxvbar_avg = g_avg - Axvbar_avg CALL mp_sum(gminusAxvbar_avg, dct_pw_grid%para%group) ! evaluate Q_S * \lambda + v_D - B * \bar{v} @@ -928,10 +928,10 @@ SUBROUTINE implicit_poisson_solver_mixed(poisson_env, density, v_new, electric_e CALL mp_sum(Bxv_bar, dct_pw_grid%para%group) ! solve R [\lambda; \eta] = [Q_S * \lambda + v_D - B * \bar{v}; 1^t * (g - \Delta(\bar{v}) - P(\bar{v}))] w = 0.0_dp - w(:) = (/QSxlambda+v_D-Bxv_bar, gminusAxvbar_avg/) - CALL DGEMV('N', n_tiles_tot+1, n_tiles_tot+1, 1.0_dp, Rinv, n_tiles_tot+1, w, 1, 0.0_dp, lambda_newNeta, 1) + w(:) = (/QSxlambda + v_D - Bxv_bar, gminusAxvbar_avg/) + CALL DGEMV('N', n_tiles_tot + 1, n_tiles_tot + 1, 1.0_dp, Rinv, n_tiles_tot + 1, w, 1, 0.0_dp, lambda_newNeta, 1) lambda_new(:) = lambda_newNeta(1:n_tiles_tot) - eta = lambda_newNeta(n_tiles_tot+1) + eta = lambda_newNeta(n_tiles_tot + 1) ! v_new = v_bar + 1 * \eta v_new_xpndd%cr3d = v_new_xpndd%cr3d+eta/ngpts @@ -947,7 +947,7 @@ SUBROUTINE implicit_poisson_solver_mixed(poisson_env, density, v_new, electric_e CALL pw_zero(res_new) CALL apply_P_operator(pw_pool_xpndd, dielectric, QAinvxres, PxQAinvxres) CALL pw_axpy(PxQAinvxres, res_new, -1.0_dp) - CALL pw_axpy(res_old, res_new, 1.0_dp-omega) + CALL pw_axpy(res_old, res_new, 1.0_dp - omega) res_new%cr3d = res_new%cr3d-Btxlambda_new3D+Btxlambda_old3D ! compute the error @@ -978,7 +978,7 @@ SUBROUTINE implicit_poisson_solver_mixed(poisson_env, density, v_new, electric_e DO ng = 1, n_contacts DO nt = 1, ps_implicit_env%contacts(ng)%dirichlet_bc%n_tiles WRITE (outp_unit, '(T17,I6,5X,I6,3X,E13.4,E13.4)') ng, nt, Bxv_new(nt_tot), lambda_new(nt_tot) - nt_tot = nt_tot+1 + nt_tot = nt_tot + 1 END DO END DO WRITE (outp_unit, '(T3,A)') REPEAT('=', 78) @@ -986,10 +986,10 @@ SUBROUTINE implicit_poisson_solver_mixed(poisson_env, density, v_new, electric_e END IF ! check the convergence - iter = iter+1 + iter = iter + 1 reached_max_iter = iter .GT. max_iter reached_tol = pres_error .LE. tol - ps_implicit_env%times_called = ps_implicit_env%times_called+1 + ps_implicit_env%times_called = ps_implicit_env%times_called + 1 IF (pres_error .GT. large_error) & CPABORT("Poisson solver did not converge.") IF (reached_max_iter .OR. reached_tol) EXIT @@ -1155,10 +1155,10 @@ SUBROUTINE ps_implicit_prepare_blocks(pw_pool_orig, dct_pw_grid, green, & DO k = lb3, ub3 DO j = lb2, ub2 DO i = lb1, ub1 - ps_implicit_env%idx_1dto3d(l) = (i-lb1+1)+ & - (j-lb2)*npts_local(1)+ & - (k-lb3)*npts_local(1)*npts_local(2) - l = l+1 + ps_implicit_env%idx_1dto3d(l) = (i - lb1 + 1) + & + (j - lb2)*npts_local(1) + & + (k - lb3)*npts_local(1)*npts_local(2) + l = l + 1 END DO END DO END DO @@ -1166,13 +1166,13 @@ SUBROUTINE ps_implicit_prepare_blocks(pw_pool_orig, dct_pw_grid, green, & n_contacts = SIZE(ps_implicit_env%contacts) n_tiles_tot = 0 DO j = 1, n_contacts - n_tiles_tot = n_tiles_tot+ps_implicit_env%contacts(j)%dirichlet_bc%n_tiles + n_tiles_tot = n_tiles_tot + ps_implicit_env%contacts(j)%dirichlet_bc%n_tiles END DO ALLOCATE (ps_implicit_env%B(n_tiles_tot, data_size)) ALLOCATE (ps_implicit_env%Bt(data_size, n_tiles_tot)) ALLOCATE (ps_implicit_env%QS(n_tiles_tot, n_tiles_tot)) - ALLOCATE (ps_implicit_env%Rinv(n_tiles_tot+1, n_tiles_tot+1)) + ALLOCATE (ps_implicit_env%Rinv(n_tiles_tot + 1, n_tiles_tot + 1)) ALLOCATE (ps_implicit_env%v_D(n_tiles_tot)) ALLOCATE (ps_implicit_env%osc_frac(n_tiles_tot)) ALLOCATE (ps_implicit_env%frequency(n_tiles_tot)) @@ -1181,8 +1181,8 @@ SUBROUTINE ps_implicit_prepare_blocks(pw_pool_orig, dct_pw_grid, green, & ALLOCATE (QAinvxBt(data_size, n_tiles_tot)) ALLOCATE (Bxunit_vec(n_tiles_tot)) ALLOCATE (test_vec(n_tiles_tot)) - ALLOCATE (R(n_tiles_tot+1, n_tiles_tot+1)) - ALLOCATE (work_arr(n_tiles_tot+1), ipiv(n_tiles_tot+1)) ! LAPACK work and ipiv arrays + ALLOCATE (R(n_tiles_tot + 1, n_tiles_tot + 1)) + ALLOCATE (work_arr(n_tiles_tot + 1), ipiv(n_tiles_tot + 1)) ! LAPACK work and ipiv arrays ! prepare pw_pool for evaluating inverse Laplacian of tile_pw's using DCT CALL pw_pool_create(pw_pool_xpndd, pw_grid=dct_pw_grid) @@ -1191,7 +1191,7 @@ SUBROUTINE ps_implicit_prepare_blocks(pw_pool_orig, dct_pw_grid, green, & indx1 = 1 DO j = 1, n_contacts n_tiles = ps_implicit_env%contacts(j)%dirichlet_bc%n_tiles - indx2 = indx1+n_tiles-1 + indx2 = indx1 + n_tiles - 1 DO i = 1, n_tiles tile_pw => ps_implicit_env%contacts(j)%dirichlet_bc%tiles(i)%tile%tile_pw @@ -1202,21 +1202,21 @@ SUBROUTINE ps_implicit_prepare_blocks(pw_pool_orig, dct_pw_grid, green, & tile_volume = ps_implicit_env%contacts(j)%dirichlet_bc%tiles(i)%tile%volume CALL pw_scale(pw_in, 1.0_dp/(vol_scfac*tile_volume)) ! normalize tile_pw - ps_implicit_env%Bt(ps_implicit_env%idx_1dto3d, indx1+i-1) = RESHAPE(pw_in%cr3d, (/data_size/)) + ps_implicit_env%Bt(ps_implicit_env%idx_1dto3d, indx1 + i - 1) = RESHAPE(pw_in%cr3d, (/data_size/)) CALL pw_pool_create_pw(pw_pool_xpndd, pw_out, use_data=REALDATA3D, in_space=REALSPACE) CALL apply_inv_laplace_operator_dct(pw_pool_xpndd, green, pw_in, pw_out) - QAinvxBt(ps_implicit_env%idx_1dto3d, indx1+i-1) = RESHAPE(pw_out%cr3d, (/data_size/)) + QAinvxBt(ps_implicit_env%idx_1dto3d, indx1 + i - 1) = RESHAPE(pw_out%cr3d, (/data_size/)) ! the electrostatic potential has opposite sign by internal convention - ps_implicit_env%v_D(indx1+i-1) = -1.0_dp*ps_implicit_env%contacts(j)%dirichlet_bc%v_D - ps_implicit_env%osc_frac(indx1+i-1) = ps_implicit_env%contacts(j)%dirichlet_bc%osc_frac - ps_implicit_env%frequency(indx1+i-1) = ps_implicit_env%contacts(j)%dirichlet_bc%frequency - ps_implicit_env%phase(indx1+i-1) = ps_implicit_env%contacts(j)%dirichlet_bc%phase + ps_implicit_env%v_D(indx1 + i - 1) = -1.0_dp*ps_implicit_env%contacts(j)%dirichlet_bc%v_D + ps_implicit_env%osc_frac(indx1 + i - 1) = ps_implicit_env%contacts(j)%dirichlet_bc%osc_frac + ps_implicit_env%frequency(indx1 + i - 1) = ps_implicit_env%contacts(j)%dirichlet_bc%frequency + ps_implicit_env%phase(indx1 + i - 1) = ps_implicit_env%contacts(j)%dirichlet_bc%phase CALL pw_pool_give_back_pw(pw_pool_xpndd, pw_in) CALL pw_pool_give_back_pw(pw_pool_xpndd, pw_out) END DO - indx1 = indx2+1 + indx1 = indx2 + 1 END DO ps_implicit_env%B = TRANSPOSE(ps_implicit_env%Bt) @@ -1234,16 +1234,16 @@ SUBROUTINE ps_implicit_prepare_blocks(pw_pool_orig, dct_pw_grid, green, & ! set up R = [QS B*1; (B*1)^t 0] R = 0.0_dp R(1:n_tiles_tot, 1:n_tiles_tot) = ps_implicit_env%QS - R(1:n_tiles_tot, n_tiles_tot+1) = Bxunit_vec - R(n_tiles_tot+1, 1:n_tiles_tot) = Bxunit_vec + R(1:n_tiles_tot, n_tiles_tot + 1) = Bxunit_vec + R(n_tiles_tot + 1, 1:n_tiles_tot) = Bxunit_vec ! evaluate R^(-1) ps_implicit_env%Rinv = R - CALL DGETRF(n_tiles_tot+1, n_tiles_tot+1, ps_implicit_env%Rinv, n_tiles_tot+1, ipiv, info) + CALL DGETRF(n_tiles_tot + 1, n_tiles_tot + 1, ps_implicit_env%Rinv, n_tiles_tot + 1, ipiv, info) IF (info .NE. 0) & CALL cp_abort(__LOCATION__, & "R is (nearly) singular! Either two Dirichlet constraints are identical or "// & "you need to reduce the number of tiles.") - CALL DGETRI(n_tiles_tot+1, ps_implicit_env%Rinv, n_tiles_tot+1, ipiv, work_arr, n_tiles_tot+1, info) + CALL DGETRI(n_tiles_tot + 1, ps_implicit_env%Rinv, n_tiles_tot + 1, ipiv, work_arr, n_tiles_tot + 1, info) IF (info .NE. 0) & CPABORT("Inversion of R failed!") @@ -1284,10 +1284,10 @@ SUBROUTINE ps_implicit_prepare_blocks(pw_pool_orig, dct_pw_grid, green, & DO k = lb3, ub3 DO j = lb2, ub2 DO i = lb1, ub1 - ps_implicit_env%idx_1dto3d(l) = (i-lb1+1)+ & - (j-lb2)*npts_local(1)+ & - (k-lb3)*npts_local(1)*npts_local(2) - l = l+1 + ps_implicit_env%idx_1dto3d(l) = (i - lb1 + 1) + & + (j - lb2)*npts_local(1) + & + (k - lb3)*npts_local(1)*npts_local(2) + l = l + 1 END DO END DO END DO @@ -1295,13 +1295,13 @@ SUBROUTINE ps_implicit_prepare_blocks(pw_pool_orig, dct_pw_grid, green, & n_contacts = SIZE(ps_implicit_env%contacts) n_tiles_tot = 0 DO j = 1, n_contacts - n_tiles_tot = n_tiles_tot+ps_implicit_env%contacts(j)%dirichlet_bc%n_tiles + n_tiles_tot = n_tiles_tot + ps_implicit_env%contacts(j)%dirichlet_bc%n_tiles END DO ALLOCATE (ps_implicit_env%B(n_tiles_tot, data_size)) ALLOCATE (ps_implicit_env%Bt(data_size, n_tiles_tot)) ALLOCATE (ps_implicit_env%QS(n_tiles_tot, n_tiles_tot)) - ALLOCATE (ps_implicit_env%Rinv(n_tiles_tot+1, n_tiles_tot+1)) + ALLOCATE (ps_implicit_env%Rinv(n_tiles_tot + 1, n_tiles_tot + 1)) ALLOCATE (ps_implicit_env%v_D(n_tiles_tot)) ALLOCATE (ps_implicit_env%osc_frac(n_tiles_tot)) ALLOCATE (ps_implicit_env%frequency(n_tiles_tot)) @@ -1310,14 +1310,14 @@ SUBROUTINE ps_implicit_prepare_blocks(pw_pool_orig, dct_pw_grid, green, & ALLOCATE (QAinvxBt(data_size, n_tiles_tot)) ALLOCATE (Bxunit_vec(n_tiles_tot)) ALLOCATE (test_vec(n_tiles_tot)) - ALLOCATE (R(n_tiles_tot+1, n_tiles_tot+1)) - ALLOCATE (work_arr(n_tiles_tot+1), ipiv(n_tiles_tot+1)) + ALLOCATE (R(n_tiles_tot + 1, n_tiles_tot + 1)) + ALLOCATE (work_arr(n_tiles_tot + 1), ipiv(n_tiles_tot + 1)) ! set up B, B^t, (\Delta^-1)*B^t indx1 = 1 DO j = 1, n_contacts n_tiles = ps_implicit_env%contacts(j)%dirichlet_bc%n_tiles - indx2 = indx1+n_tiles-1 + indx2 = indx1 + n_tiles - 1 DO i = 1, n_tiles tile_pw => ps_implicit_env%contacts(j)%dirichlet_bc%tiles(i)%tile%tile_pw @@ -1326,21 +1326,21 @@ SUBROUTINE ps_implicit_prepare_blocks(pw_pool_orig, dct_pw_grid, green, & tile_volume = ps_implicit_env%contacts(j)%dirichlet_bc%tiles(i)%tile%volume CALL pw_scale(pw_in, 1.0_dp/tile_volume) ! normalize tile_pw - ps_implicit_env%Bt(ps_implicit_env%idx_1dto3d, indx1+i-1) = RESHAPE(pw_in%cr3d, (/data_size/)) + ps_implicit_env%Bt(ps_implicit_env%idx_1dto3d, indx1 + i - 1) = RESHAPE(pw_in%cr3d, (/data_size/)) CALL pw_pool_create_pw(pw_pool_orig, pw_out, use_data=REALDATA3D, in_space=REALSPACE) CALL apply_inv_laplace_operator_fft(pw_pool_orig, green, pw_in, pw_out) - QAinvxBt(ps_implicit_env%idx_1dto3d, indx1+i-1) = RESHAPE(pw_out%cr3d, (/data_size/)) + QAinvxBt(ps_implicit_env%idx_1dto3d, indx1 + i - 1) = RESHAPE(pw_out%cr3d, (/data_size/)) ! the electrostatic potential has opposite sign by internal convention - ps_implicit_env%v_D(indx1+i-1) = -1.0_dp*ps_implicit_env%contacts(j)%dirichlet_bc%v_D - ps_implicit_env%osc_frac(indx1+i-1) = ps_implicit_env%contacts(j)%dirichlet_bc%osc_frac - ps_implicit_env%frequency(indx1+i-1) = ps_implicit_env%contacts(j)%dirichlet_bc%frequency - ps_implicit_env%phase(indx1+i-1) = ps_implicit_env%contacts(j)%dirichlet_bc%phase + ps_implicit_env%v_D(indx1 + i - 1) = -1.0_dp*ps_implicit_env%contacts(j)%dirichlet_bc%v_D + ps_implicit_env%osc_frac(indx1 + i - 1) = ps_implicit_env%contacts(j)%dirichlet_bc%osc_frac + ps_implicit_env%frequency(indx1 + i - 1) = ps_implicit_env%contacts(j)%dirichlet_bc%frequency + ps_implicit_env%phase(indx1 + i - 1) = ps_implicit_env%contacts(j)%dirichlet_bc%phase CALL pw_pool_give_back_pw(pw_pool_orig, pw_in) CALL pw_pool_give_back_pw(pw_pool_orig, pw_out) END DO - indx1 = indx2+1 + indx1 = indx2 + 1 END DO ps_implicit_env%B = TRANSPOSE(ps_implicit_env%Bt) @@ -1358,16 +1358,16 @@ SUBROUTINE ps_implicit_prepare_blocks(pw_pool_orig, dct_pw_grid, green, & ! set up R = [QS B*1; (B*1)^t 0] R = 0.0_dp R(1:n_tiles_tot, 1:n_tiles_tot) = ps_implicit_env%QS - R(1:n_tiles_tot, n_tiles_tot+1) = Bxunit_vec - R(n_tiles_tot+1, 1:n_tiles_tot) = Bxunit_vec + R(1:n_tiles_tot, n_tiles_tot + 1) = Bxunit_vec + R(n_tiles_tot + 1, 1:n_tiles_tot) = Bxunit_vec ! evaluate R^(-1) ps_implicit_env%Rinv = R - CALL DGETRF(n_tiles_tot+1, n_tiles_tot+1, ps_implicit_env%Rinv, n_tiles_tot+1, ipiv, info) + CALL DGETRF(n_tiles_tot + 1, n_tiles_tot + 1, ps_implicit_env%Rinv, n_tiles_tot + 1, ipiv, info) IF (info .NE. 0) & CALL cp_abort(__LOCATION__, & "R is (nearly) singular! Either two Dirichlet constraints are identical or "// & "you need to reduce the number of tiles.") - CALL DGETRI(n_tiles_tot+1, ps_implicit_env%Rinv, n_tiles_tot+1, ipiv, work_arr, n_tiles_tot+1, info) + CALL DGETRI(n_tiles_tot + 1, ps_implicit_env%Rinv, n_tiles_tot + 1, ipiv, work_arr, n_tiles_tot + 1, info) IF (info .NE. 0) & CPABORT("Inversion of R failed!") @@ -1592,7 +1592,7 @@ SUBROUTINE apply_laplace_operator_fft(pw_pool, green, pw_in, pw_out) CALL pw_transfer(pw_in, pw_in_gs) IF (have_g0) THEN - g0_index = green%influence_fn%pw_grid%first_gne0-1 + g0_index = green%influence_fn%pw_grid%first_gne0 - 1 pw_in_gs%cc(g0_index) = 0.0_dp END IF DO ig = green%influence_fn%pw_grid%first_gne0, ng @@ -1649,7 +1649,7 @@ SUBROUTINE apply_laplace_operator_dct(pw_pool, green, pw_in, pw_out) CALL pw_transfer(pw_in, pw_in_gs) IF (have_g0) THEN - g0_index = green%dct_influence_fn%pw_grid%first_gne0-1 + g0_index = green%dct_influence_fn%pw_grid%first_gne0 - 1 pw_in_gs%cc(g0_index) = 0.0_dp END IF DO ig = green%dct_influence_fn%pw_grid%first_gne0, ng @@ -1790,7 +1790,7 @@ SUBROUTINE ps_implicit_compute_veps(pw_pool, dielectric, v, v_eps) CALL derive_fft(v, dv, pw_pool) ! evaluate |\nabla_r(v)|^2 - dv2%cr3d = dv(1)%pw%cr3d**2+dv(2)%pw%cr3d**2+dv(3)%pw%cr3d**2 + dv2%cr3d = dv(1)%pw%cr3d**2 + dv(2)%pw%cr3d**2 + dv(3)%pw%cr3d**2 v_eps%cr3d = -(1.0_dp/eightpi)*(dv2%cr3d*deps_drho%cr3d) @@ -1877,8 +1877,8 @@ SUBROUTINE compute_ehartree_mixed_bc(dielectric, density, Btxlambda, v, ehartree ehartree_rho_cstr = 0.5_dp*ehartree_rho_cstr*dvol CALL mp_sum(ehartree_rho, pw_grid%para%group) CALL mp_sum(ehartree_rho_cstr, pw_grid%para%group) - electric_enthalpy = ehartree_rho+ehartree_rho_cstr - ehartree = ehartree_rho-ehartree_rho_cstr + electric_enthalpy = ehartree_rho + ehartree_rho_cstr + ehartree = ehartree_rho - ehartree_rho_cstr CALL timestop(handle) @@ -2061,7 +2061,7 @@ SUBROUTINE ps_implicit_report_ehartree(ps_implicit_env, outp_unit, ehartree) CALL timeset(routineN, handle) IF (logger%iter_info%print_level .GT. low_print_level) THEN IF (outp_unit .GT. 0) WRITE (outp_unit, '(F19.10,E10.2)') & - ehartree, ehartree-ps_implicit_env%ehartree + ehartree, ehartree - ps_implicit_env%ehartree END IF CALL timestop(handle) @@ -2088,7 +2088,7 @@ SUBROUTINE ps_implicit_print_convergence_msg(iter, max_iter, outp_unit) CALL timeset(routineN, handle) - last_iter = iter-1 + last_iter = iter - 1 IF (last_iter .EQ. 1) THEN msg = " iteration. " ELSE @@ -2176,14 +2176,14 @@ SUBROUTINE convert_1dto3d(idx_1dto3d, arr1d, arr3d) lb2 = LBOUND(arr3d, 2); ub2 = UBOUND(arr3d, 2) lb3 = LBOUND(arr3d, 3); ub3 = UBOUND(arr3d, 3) - npts1 = ub1-lb1+1 - npts2 = ub2-lb2+1 - npts3 = ub3-lb3+1 + npts1 = ub1 - lb1 + 1 + npts2 = ub2 - lb2 + 1 + npts3 = ub3 - lb3 + 1 DO l = 1, SIZE(idx_1dto3d) - k = ((idx_1dto3d(l)-1)/(npts1*npts2))+lb3 - j = ((idx_1dto3d(l)-1)-(k-lb3)*npts1*npts2)/npts1+lb2 - i = idx_1dto3d(l)-((j-lb2)*npts1+(k-lb3)*npts1*npts2)+lb1-1 + k = ((idx_1dto3d(l) - 1)/(npts1*npts2)) + lb3 + j = ((idx_1dto3d(l) - 1) - (k - lb3)*npts1*npts2)/npts1 + lb2 + i = idx_1dto3d(l) - ((j - lb2)*npts1 + (k - lb3)*npts1*npts2) + lb1 - 1 arr3d(i, j, k) = arr1d(l) END DO @@ -2215,8 +2215,8 @@ SUBROUTINE get_voltage(time, v_D, osc_frac, frequency, phase, v_D_new) ALLOCATE (v_D_new(SIZE(v_D))) DO i = 1, SIZE(v_D) - v_D_new(i) = v_D(i)*(1-osc_frac(i))+ & - v_D(i)*osc_frac(i)*COS(2*pi*time*frequency(i)+phase(i)) + v_D_new(i) = v_D(i)*(1 - osc_frac(i)) + & + v_D(i)*osc_frac(i)*COS(2*pi*time*frequency(i) + phase(i)) END DO CALL timestop(handle) diff --git a/src/pw/ps_wavelet_base.F b/src/pw/ps_wavelet_base.F index aebb34906f..f0a0300807 100644 --- a/src/pw/ps_wavelet_base.F +++ b/src/pw/ps_wavelet_base.F @@ -69,9 +69,9 @@ SUBROUTINE P_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro REAL(KIND=dp), ALLOCATABLE, & DIMENSION(:, :, :, :, :) :: zmpi1 - IF (nd1 .LT. n1/2+1) CPABORT("Parallel convolution:ERROR:nd1") - IF (nd2 .LT. n2/2+1) CPABORT("Parallel convolution:ERROR:nd2") - IF (nd3 .LT. n3/2+1) CPABORT("Parallel convolution:ERROR:nd3") + IF (nd1 .LT. n1/2 + 1) CPABORT("Parallel convolution:ERROR:nd1") + IF (nd2 .LT. n2/2 + 1) CPABORT("Parallel convolution:ERROR:nd2") + IF (nd3 .LT. n3/2 + 1) CPABORT("Parallel convolution:ERROR:nd3") IF (md1 .LT. n1) CPABORT("Parallel convolution:ERROR:md1") IF (md2 .LT. n2) CPABORT("Parallel convolution:ERROR:md2") IF (md3 .LT. n3) CPABORT("Parallel convolution:ERROR:md3") @@ -83,8 +83,8 @@ SUBROUTINE P_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro IF (ncache <= MAX(n1, n2, n3)*4) ncache = MAX(n1, n2, n3)*4 lzt = n2 - IF (MOD(n2, 2) .EQ. 0) lzt = lzt+1 - IF (MOD(n2, 4) .EQ. 0) lzt = lzt+1 !maybe this is useless + IF (MOD(n2, 2) .EQ. 0) lzt = lzt + 1 + IF (MOD(n2, 4) .EQ. 0) lzt = lzt + 1 !maybe this is useless !Allocations ALLOCATE (btrig1(2, ctrig_length)) @@ -135,11 +135,11 @@ SUBROUTINE P_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro ENDIF DO j2 = 1, md2/nproc !this condition ensures that we manage only the interesting part for the FFT - IF (iproc*(md2/nproc)+j2 .LE. n2) THEN + IF (iproc*(md2/nproc) + j2 .LE. n2) THEN DO i1 = 1, n1, lot ma = i1 - mb = MIN(i1+(lot-1), n1) - nfft = mb-ma+1 + mb = MIN(i1 + (lot - 1), n1) + nfft = mb - ma + 1 !inserting real data into complex array of half lenght CALL P_fill_upcorn(md1, md3, lot, nfft, n3, zf(i1, 1, j2), zw(1, 1, 1)) @@ -147,9 +147,9 @@ SUBROUTINE P_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro !input: I1,I3,J2,(Jp2) inzee = 1 DO i = 1, ic3 - CALL fftstp(lot, nfft, n3, lot, n3, zw(1, 1, inzee), zw(1, 1, 3-inzee), & + CALL fftstp(lot, nfft, n3, lot, n3, zw(1, 1, inzee), zw(1, 1, 3 - inzee), & btrig3, after3(i), now3(i), before3(i), 1) - inzee = 3-inzee + inzee = 3 - inzee ENDDO !output: I1,i3,J2,(Jp2) @@ -172,7 +172,7 @@ SUBROUTINE P_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro !now each process perform complete convolution of its planes DO j3 = 1, nd3/nproc !this condition ensures that we manage only the interesting part for the FFT - IF (iproc*(nd3/nproc)+j3 .LE. n3/2+1) THEN + IF (iproc*(nd3/nproc) + j3 .LE. n3/2 + 1) THEN Jp2stb = 1 J2stb = 1 Jp2stf = 1 @@ -190,8 +190,8 @@ SUBROUTINE P_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro DO j = 1, n2, lot ma = j - mb = MIN(j+(lot-1), n2) - nfft = mb-ma+1 + mb = MIN(j + (lot - 1), n2) + nfft = mb - ma + 1 !reverse index ordering, leaving the planes to be transformed at the end !input: I1,J2,j3,Jp2,(jp3) @@ -205,10 +205,10 @@ SUBROUTINE P_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro !performing FFT !input: I2,I1,j3,(jp3) inzee = 1 - DO i = 1, ic1-1 - CALL fftstp(lot, nfft, n1, lot, n1, zw(1, 1, inzee), zw(1, 1, 3-inzee), & + DO i = 1, ic1 - 1 + CALL fftstp(lot, nfft, n1, lot, n1, zw(1, 1, inzee), zw(1, 1, 3 - inzee), & btrig1, after1(i), now1(i), before1(i), 1) - inzee = 3-inzee + inzee = 3 - inzee ENDDO !storing the last step into zt array @@ -230,8 +230,8 @@ SUBROUTINE P_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro DO j = 1, n1, lot ma = j - mb = MIN(j+(lot-1), n1) - nfft = mb-ma+1 + mb = MIN(j + (lot - 1), n1) + nfft = mb - ma + 1 !reverse ordering !input: I2,i1,j3,(jp3) @@ -242,14 +242,14 @@ SUBROUTINE P_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro !input: i1,I2,j3,(jp3) inzee = 1 DO i = 1, ic2 - CALL fftstp(lot, nfft, n2, lot, n2, zw(1, 1, inzee), zw(1, 1, 3-inzee), & + CALL fftstp(lot, nfft, n2, lot, n2, zw(1, 1, inzee), zw(1, 1, 3 - inzee), & btrig2, after2(i), now2(i), before2(i), 1) - inzee = 3-inzee + inzee = 3 - inzee ENDDO !output: i1,i2,j3,(jp3) !Multiply with kernel in fourier space - i3 = iproc*(nd3/nproc)+j3 + i3 = iproc*(nd3/nproc) + j3 CALL P_multkernel(n1, n2, n3, lot, nfft, j, i3, zw(1, 1, inzee), hx, hy, hz) !TRANSFORM BACK IN REAL SPACE @@ -257,9 +257,9 @@ SUBROUTINE P_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro !transform along y axis !input: i1,i2,j3,(jp3) DO i = 1, ic2 - CALL fftstp(lot, nfft, n2, lot, n2, zw(1, 1, inzee), zw(1, 1, 3-inzee), & + CALL fftstp(lot, nfft, n2, lot, n2, zw(1, 1, inzee), zw(1, 1, 3 - inzee), & ftrig2, after2(i), now2(i), before2(i), -1) - inzee = 3-inzee + inzee = 3 - inzee ENDDO !reverse ordering @@ -273,8 +273,8 @@ SUBROUTINE P_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro lot = ncache/(4*n1) DO j = 1, n2, lot ma = j - mb = MIN(j+(lot-1), n2) - nfft = mb-ma+1 + mb = MIN(j + (lot - 1), n2) + nfft = mb - ma + 1 !performing FFT i = 1 @@ -283,9 +283,9 @@ SUBROUTINE P_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro inzee = 1 DO i = 2, ic1 - CALL fftstp(lot, nfft, n1, lot, n1, zw(1, 1, inzee), zw(1, 1, 3-inzee), & + CALL fftstp(lot, nfft, n1, lot, n1, zw(1, 1, inzee), zw(1, 1, 3 - inzee), & ftrig1, after1(i), now1(i), before1(i), -1) - inzee = 3-inzee + inzee = 3 - inzee ENDDO !output: I2,I1,j3,(jp3) @@ -313,11 +313,11 @@ SUBROUTINE P_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro lot = ncache/(4*n3) DO j2 = 1, md2/nproc !this condition ensures that we manage only the interesting part for the FFT - IF (iproc*(md2/nproc)+j2 .LE. n2) THEN + IF (iproc*(md2/nproc) + j2 .LE. n2) THEN DO i1 = 1, n1, lot ma = i1 - mb = MIN(i1+(lot-1), n1) - nfft = mb-ma+1 + mb = MIN(i1 + (lot - 1), n1) + nfft = mb - ma + 1 !reverse ordering !input: I1,J2,i3,(Jp2) @@ -328,9 +328,9 @@ SUBROUTINE P_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro !input: I1,i3,J2,(Jp2) inzee = 1 DO i = 1, ic3 - CALL fftstp(lot, nfft, n3, lot, n3, zw(1, 1, inzee), zw(1, 1, 3-inzee), & + CALL fftstp(lot, nfft, n3, lot, n3, zw(1, 1, inzee), zw(1, 1, 3 - inzee), & ftrig3, after3(i), now3(i), before3(i), -1) - inzee = 3-inzee + inzee = 3 - inzee ENDDO !output: I1,I3,J2,(Jp2) @@ -393,7 +393,7 @@ SUBROUTINE P_mpiswitch_upcorn(j3, nfft, Jp2stb, J2stb, lot, n1, md2, nd3, nproc, mfft = 0 DO Jp2 = Jp2stb, nproc DO J2 = J2stb, md2/nproc - mfft = mfft+1 + mfft = mfft + 1 IF (mfft .GT. nfft) THEN Jp2stb = Jp2 J2stb = J2 @@ -490,7 +490,7 @@ SUBROUTINE P_unmpiswitch_downcorn(j3, nfft, Jp2stf, J2stf, lot, n1, md2, nd3, np mfft = 0 DO Jp2 = Jp2stf, nproc DO J2 = J2stf, md2/nproc - mfft = mfft+1 + mfft = mfft + 1 IF (mfft .GT. nfft) THEN Jp2stf = Jp2 J2stf = J2 @@ -608,10 +608,10 @@ SUBROUTINE scramble_P(i1, j2, lot, nfft, n1, n3, md2, nproc, nd3, zw, zmpi2) INTEGER :: i, i3 - DO i3 = 1, n3/2+1 - DO i = 0, nfft-1 - zmpi2(1, i1+i, j2, i3) = zw(1, i+1, i3) - zmpi2(2, i1+i, j2, i3) = zw(2, i+1, i3) + DO i3 = 1, n3/2 + 1 + DO i = 0, nfft - 1 + zmpi2(1, i1 + i, j2, i3) = zw(1, i + 1, i3) + zmpi2(2, i1 + i, j2, i3) = zw(2, i + 1, i3) END DO END DO @@ -653,18 +653,18 @@ SUBROUTINE unscramble_P(i1, j2, lot, nfft, n1, n3, md2, nproc, nd3, zmpi2, zw) INTEGER :: i, i3, j3 i3 = 1 - DO i = 0, nfft-1 - zw(1, i+1, i3) = zmpi2(1, i1+i, j2, i3) - zw(2, i+1, i3) = zmpi2(2, i1+i, j2, i3) + DO i = 0, nfft - 1 + zw(1, i + 1, i3) = zmpi2(1, i1 + i, j2, i3) + zw(2, i + 1, i3) = zmpi2(2, i1 + i, j2, i3) END DO - DO i3 = 2, n3/2+1 - j3 = n3+2-i3 - DO i = 0, nfft-1 - zw(1, i+1, j3) = zmpi2(1, i1+i, j2, i3) - zw(2, i+1, j3) = -zmpi2(2, i1+i, j2, i3) - zw(1, i+1, i3) = zmpi2(1, i1+i, j2, i3) - zw(2, i+1, i3) = zmpi2(2, i1+i, j2, i3) + DO i3 = 2, n3/2 + 1 + j3 = n3 + 2 - i3 + DO i = 0, nfft - 1 + zw(1, i + 1, j3) = zmpi2(1, i1 + i, j2, i3) + zw(2, i + 1, j3) = -zmpi2(2, i1 + i, j2, i3) + zw(1, i + 1, i3) = zmpi2(1, i1 + i, j2, i3) + zw(2, i + 1, i3) = zmpi2(2, i1 + i, j2, i3) END DO END DO @@ -711,18 +711,18 @@ SUBROUTINE P_multkernel(n1, n2, n3, lot, nfft, jS, i3, zw, hx, hy, hz) pi = 4._dp*ATAN(1._dp) fourpi2 = 4._dp*pi**2 j3 = i3 !n3/2+1-abs(n3/2+2-i3) - mu3 = REAL(j3-1, KIND=dp)/REAL(n3, KIND=dp) + mu3 = REAL(j3 - 1, KIND=dp)/REAL(n3, KIND=dp) mu3 = (mu3/hy)**2 !beware of the exchanged dimension !Body !generic case DO i2 = 1, n2 DO i1 = 1, nfft - j1 = i1+jS-1 - j1 = j1-(j1/(n1/2+2))*n1 !n1/2+1-abs(n1/2+2-jS-i1) - j2 = i2-(i2/(n2/2+2))*n2 !n2/2+1-abs(n2/2+1-i2) - p1 = REAL(j1-1, KIND=dp)/REAL(n1, KIND=dp) - p2 = REAL(j2-1, KIND=dp)/REAL(n2, KIND=dp) - ker = -fourpi2*((p1/hx)**2+(p2/hz)**2+mu3) !beware of the exchanged dimension + j1 = i1 + jS - 1 + j1 = j1 - (j1/(n1/2 + 2))*n1 !n1/2+1-abs(n1/2+2-jS-i1) + j2 = i2 - (i2/(n2/2 + 2))*n2 !n2/2+1-abs(n2/2+1-i2) + p1 = REAL(j1 - 1, KIND=dp)/REAL(n1, KIND=dp) + p2 = REAL(j2 - 1, KIND=dp)/REAL(n2, KIND=dp) + ker = -fourpi2*((p1/hx)**2 + (p2/hz)**2 + mu3) !beware of the exchanged dimension IF (ker /= 0._dp) ker = 1._dp/ker zw(1, i1, i2) = zw(1, i1, i2)*ker zw(2, i1, i2) = zw(2, i1, i2)*ker @@ -767,8 +767,8 @@ SUBROUTINE multkernel(nd1, nd2, n1, n2, lot, nfft, jS, pot, zw) INTEGER :: i2, j, j1, j2 DO j = 1, nfft - j1 = j+jS-1 - j1 = j1+(j1/(n1/2+2))*(n1+2-2*j1) + j1 = j + jS - 1 + j1 = j1 + (j1/(n1/2 + 2))*(n1 + 2 - 2*j1) zw(1, j, 1) = zw(1, j, 1)*pot(j1, 1) zw(2, j, 1) = zw(2, j, 1)*pot(j1, 1) END DO @@ -776,9 +776,9 @@ SUBROUTINE multkernel(nd1, nd2, n1, n2, lot, nfft, jS, pot, zw) !generic case DO i2 = 2, n2/2 DO j = 1, nfft - j1 = j+jS-1 - j1 = j1+(j1/(n1/2+2))*(n1+2-2*j1) - j2 = n2+2-i2 + j1 = j + jS - 1 + j1 = j1 + (j1/(n1/2 + 2))*(n1 + 2 - 2*j1) + j2 = n2 + 2 - i2 zw(1, j, i2) = zw(1, j, i2)*pot(j1, i2) zw(2, j, i2) = zw(2, j, i2)*pot(j1, i2) zw(1, j, j2) = zw(1, j, j2)*pot(j1, i2) @@ -788,9 +788,9 @@ SUBROUTINE multkernel(nd1, nd2, n1, n2, lot, nfft, jS, pot, zw) !case i2=n2/2+1 DO j = 1, nfft - j1 = j+jS-1 - j1 = j1+(j1/(n1/2+2))*(n1+2-2*j1) - j2 = n2/2+1 + j1 = j + jS - 1 + j1 = j1 + (j1/(n1/2 + 2))*(n1 + 2 - 2*j1) + j2 = n2/2 + 1 zw(1, j, j2) = zw(1, j, j2)*pot(j1, j2) zw(2, j, j2) = zw(2, j, j2)*pot(j1, j2) END DO @@ -867,9 +867,9 @@ SUBROUTINE S_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro CALL timeset(routineN, handle) ! check input IF (MOD(n3, 2) .NE. 0) CPABORT("Parallel convolution:ERROR:n3") - IF (nd1 .LT. n1/2+1) CPABORT("Parallel convolution:ERROR:nd1") - IF (nd2 .LT. n2/2+1) CPABORT("Parallel convolution:ERROR:nd2") - IF (nd3 .LT. n3/2+1) CPABORT("Parallel convolution:ERROR:nd3") + IF (nd1 .LT. n1/2 + 1) CPABORT("Parallel convolution:ERROR:nd1") + IF (nd2 .LT. n2/2 + 1) CPABORT("Parallel convolution:ERROR:nd2") + IF (nd3 .LT. n3/2 + 1) CPABORT("Parallel convolution:ERROR:nd3") IF (md1 .LT. n1) CPABORT("Parallel convolution:ERROR:md1") IF (md2 .LT. n2) CPABORT("Parallel convolution:ERROR:md2") IF (md3 .LT. n3/2) CPABORT("Parallel convolution:ERROR:md3") @@ -883,8 +883,8 @@ SUBROUTINE S_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro ! if (timing_flag == 1 .and. iproc ==0) print *,'parallel ncache=',ncache lzt = n2 - IF (MOD(n2, 2) .EQ. 0) lzt = lzt+1 - IF (MOD(n2, 4) .EQ. 0) lzt = lzt+1 !maybe this is useless + IF (MOD(n2, 2) .EQ. 0) lzt = lzt + 1 + IF (MOD(n2, 4) .EQ. 0) lzt = lzt + 1 !maybe this is useless !Allocations ALLOCATE (btrig1(2, ctrig_length)) @@ -934,8 +934,8 @@ SUBROUTINE S_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro !Calculating array of phases for HalFFT decoding twopion = 8._dp*ATAN(1._dp)/REAL(n3, KIND=dp) DO i3 = 1, n3/2 - cosinarr(1, i3) = COS(twopion*(i3-1)) - cosinarr(2, i3) = -SIN(twopion*(i3-1)) + cosinarr(1, i3) = COS(twopion*(i3 - 1)) + cosinarr(2, i3) = -SIN(twopion*(i3 - 1)) END DO !initializing integral @@ -953,11 +953,11 @@ SUBROUTINE S_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro DO j2 = 1, md2/nproc !this condition ensures that we manage only the interesting part for the FFT - IF (iproc*(md2/nproc)+j2 .LE. n2) THEN + IF (iproc*(md2/nproc) + j2 .LE. n2) THEN DO i1 = 1, n1, lot ma = i1 - mb = MIN(i1+(lot-1), n1) - nfft = mb-ma+1 + mb = MIN(i1 + (lot - 1), n1) + nfft = mb - ma + 1 !inserting real data into complex array of half lenght CALL halfill_upcorn(md1, md3, lot, nfft, n3, zf(i1, 1, j2), zw(1, 1, 1)) @@ -966,9 +966,9 @@ SUBROUTINE S_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro !input: I1,I3,J2,(Jp2) inzee = 1 DO i = 1, ic3 - CALL fftstp(lot, nfft, n3/2, lot, n3/2, zw(1, 1, inzee), zw(1, 1, 3-inzee), & + CALL fftstp(lot, nfft, n3/2, lot, n3/2, zw(1, 1, inzee), zw(1, 1, 3 - inzee), & btrig3, after3(i), now3(i), before3(i), 1) - inzee = 3-inzee + inzee = 3 - inzee ENDDO !output: I1,i3,J2,(Jp2) !unpacking FFT in order to restore correct result, @@ -989,7 +989,7 @@ SUBROUTINE S_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro !now each process perform complete convolution of its planes DO j3 = 1, nd3/nproc !this condition ensures that we manage only the interesting part for the FFT - IF (iproc*(nd3/nproc)+j3 .LE. n3/2+1) THEN + IF (iproc*(nd3/nproc) + j3 .LE. n3/2 + 1) THEN Jp2stb = 1 J2stb = 1 Jp2stf = 1 @@ -1007,8 +1007,8 @@ SUBROUTINE S_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro DO j = 1, n2, lot ma = j - mb = MIN(j+(lot-1), n2) - nfft = mb-ma+1 + mb = MIN(j + (lot - 1), n2) + nfft = mb - ma + 1 !reverse index ordering, leaving the planes to be transformed at the end !input: I1,J2,j3,Jp2,(jp3) @@ -1022,10 +1022,10 @@ SUBROUTINE S_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro !performing FFT !input: I2,I1,j3,(jp3) inzee = 1 - DO i = 1, ic1-1 - CALL fftstp(lot, nfft, n1, lot, n1, zw(1, 1, inzee), zw(1, 1, 3-inzee), & + DO i = 1, ic1 - 1 + CALL fftstp(lot, nfft, n1, lot, n1, zw(1, 1, inzee), zw(1, 1, 3 - inzee), & btrig1, after1(i), now1(i), before1(i), 1) - inzee = 3-inzee + inzee = 3 - inzee ENDDO !storing the last step into zt array @@ -1047,8 +1047,8 @@ SUBROUTINE S_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro DO j = 1, n1, lot ma = j - mb = MIN(j+(lot-1), n1) - nfft = mb-ma+1 + mb = MIN(j + (lot - 1), n1) + nfft = mb - ma + 1 !reverse ordering !input: I2,i1,j3,(jp3) @@ -1059,9 +1059,9 @@ SUBROUTINE S_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro !input: i1,I2,j3,(jp3) inzee = 1 DO i = 1, ic2 - CALL fftstp(lot, nfft, n2, lot, n2, zw(1, 1, inzee), zw(1, 1, 3-inzee), & + CALL fftstp(lot, nfft, n2, lot, n2, zw(1, 1, inzee), zw(1, 1, 3 - inzee), & btrig2, after2(i), now2(i), before2(i), 1) - inzee = 3-inzee + inzee = 3 - inzee ENDDO !output: i1,i2,j3,(jp3) @@ -1073,9 +1073,9 @@ SUBROUTINE S_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro !transform along y axis !input: i1,i2,j3,(jp3) DO i = 1, ic2 - CALL fftstp(lot, nfft, n2, lot, n2, zw(1, 1, inzee), zw(1, 1, 3-inzee), & + CALL fftstp(lot, nfft, n2, lot, n2, zw(1, 1, inzee), zw(1, 1, 3 - inzee), & ftrig2, after2(i), now2(i), before2(i), -1) - inzee = 3-inzee + inzee = 3 - inzee ENDDO !reverse ordering @@ -1089,8 +1089,8 @@ SUBROUTINE S_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro lot = ncache/(4*n1) DO j = 1, n2, lot ma = j - mb = MIN(j+(lot-1), n2) - nfft = mb-ma+1 + mb = MIN(j + (lot - 1), n2) + nfft = mb - ma + 1 !performing FFT i = 1 @@ -1099,9 +1099,9 @@ SUBROUTINE S_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro inzee = 1 DO i = 2, ic1 - CALL fftstp(lot, nfft, n1, lot, n1, zw(1, 1, inzee), zw(1, 1, 3-inzee), & + CALL fftstp(lot, nfft, n1, lot, n1, zw(1, 1, inzee), zw(1, 1, 3 - inzee), & ftrig1, after1(i), now1(i), before1(i), -1) - inzee = 3-inzee + inzee = 3 - inzee ENDDO !output: I2,I1,j3,(jp3) @@ -1131,11 +1131,11 @@ SUBROUTINE S_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro lot = ncache/(2*n3) DO j2 = 1, md2/nproc !this condition ensures that we manage only the interesting part for the FFT - IF (iproc*(md2/nproc)+j2 .LE. n2) THEN + IF (iproc*(md2/nproc) + j2 .LE. n2) THEN DO i1 = 1, n1, lot ma = i1 - mb = MIN(i1+(lot-1), n1) - nfft = mb-ma+1 + mb = MIN(i1 + (lot - 1), n1) + nfft = mb - ma + 1 !reverse ordering and repack the FFT data in order to be backward HalFFT transformed !input: I1,J2,i3,(Jp2) @@ -1146,9 +1146,9 @@ SUBROUTINE S_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro !input: I1,i3,J2,(Jp2) inzee = 1 DO i = 1, ic3 - CALL fftstp(lot, nfft, n3/2, lot, n3/2, zw(1, 1, inzee), zw(1, 1, 3-inzee), & + CALL fftstp(lot, nfft, n3/2, lot, n3/2, zw(1, 1, inzee), zw(1, 1, 3 - inzee), & ftrig3, after3(i), now3(i), before3(i), -1) - inzee = 3-inzee + inzee = 3 - inzee ENDDO !output: I1,I3,J2,(Jp2) @@ -1217,7 +1217,7 @@ SUBROUTINE S_mpiswitch_upcorn(j3, nfft, Jp2stb, J2stb, lot, n1, md2, nd3, nproc, mfft = 0 DO Jp2 = Jp2stb, nproc DO J2 = J2stb, md2/nproc - mfft = mfft+1 + mfft = mfft + 1 IF (mfft .GT. nfft) THEN Jp2stb = Jp2 J2stb = J2 @@ -1312,7 +1312,7 @@ SUBROUTINE S_unmpiswitch_downcorn(j3, nfft, Jp2stf, J2stf, lot, n1, md2, nd3, np mfft = 0 DO Jp2 = Jp2stf, nproc DO J2 = J2stf, md2/nproc - mfft = mfft+1 + mfft = mfft + 1 IF (mfft .GT. nfft) THEN Jp2stf = Jp2 J2stf = J2 @@ -1365,7 +1365,7 @@ SUBROUTINE unfill_downcorn(md1, md3, lot, nfft, n3, zw, zf, scal) DO i1 = 1, nfft pot1 = scal*zw(1, i1, i3) !ehartreetmp =ehartreetmp + pot1* zf(i1,2*i3-1) - zf(i1, 2*i3-1) = pot1 + zf(i1, 2*i3 - 1) = pot1 pot1 = scal*zw(2, i1, i3) !ehartreetmp =ehartreetmp + pot1* zf(i1,2*i3) zf(i1, 2*i3) = pot1 @@ -1398,10 +1398,10 @@ SUBROUTINE halfill_upcorn(md1, md3, lot, nfft, n3, zf, zw) zw(2, i1, i3) = 0._dp END DO END DO - DO i3 = n3/4+1, n3/2 + DO i3 = n3/4 + 1, n3/2 DO i1 = 1, nfft - zw(1, i1, i3) = zf(i1, 2*i3-1-n3/2) - zw(2, i1, i3) = zf(i1, 2*i3-n3/2) + zw(1, i1, i3) = zf(i1, 2*i3 - 1 - n3/2) + zw(2, i1, i3) = zf(i1, 2*i3 - n3/2) ENDDO END DO @@ -1449,33 +1449,33 @@ SUBROUTINE scramble_unpack(i1, j2, lot, nfft, n1, n3, md2, nproc, nd3, zw, zmpi2 !case i3=1 and i3=n3/2+1 - DO i = 0, nfft-1 - a = zw(1, i+1, 1) - b = zw(2, i+1, 1) - zmpi2(1, i1+i, j2, 1) = a+b - zmpi2(2, i1+i, j2, 1) = 0._dp - zmpi2(1, i1+i, j2, n3/2+1) = a-b - zmpi2(2, i1+i, j2, n3/2+1) = 0._dp + DO i = 0, nfft - 1 + a = zw(1, i + 1, 1) + b = zw(2, i + 1, 1) + zmpi2(1, i1 + i, j2, 1) = a + b + zmpi2(2, i1 + i, j2, 1) = 0._dp + zmpi2(1, i1 + i, j2, n3/2 + 1) = a - b + zmpi2(2, i1 + i, j2, n3/2 + 1) = 0._dp END DO !case 2<=i3<=n3/2 DO i3 = 2, n3/2 ind1 = i3 - ind2 = n3/2-i3+2 + ind2 = n3/2 - i3 + 2 cp = cosinarr(1, i3) sp = cosinarr(2, i3) - DO i = 0, nfft-1 - a = zw(1, i+1, ind1) - b = zw(2, i+1, ind1) - c = zw(1, i+1, ind2) - d = zw(2, i+1, ind2) - feR = .5_dp*(a+c) - feI = .5_dp*(b-d) - foR = .5_dp*(a-c) - foI = .5_dp*(b+d) - fR = feR+cp*foI-sp*foR - fI = feI-cp*foR-sp*foI - zmpi2(1, i1+i, j2, ind1) = fR - zmpi2(2, i1+i, j2, ind1) = fI + DO i = 0, nfft - 1 + a = zw(1, i + 1, ind1) + b = zw(2, i + 1, ind1) + c = zw(1, i + 1, ind2) + d = zw(2, i + 1, ind2) + feR = .5_dp*(a + c) + feI = .5_dp*(b - d) + foR = .5_dp*(a - c) + foI = .5_dp*(b + d) + fR = feR + cp*foI - sp*foR + fI = feI - cp*foR - sp*foI + zmpi2(1, i1 + i, j2, ind1) = fR + zmpi2(2, i1 + i, j2, ind1) = fI END DO END DO @@ -1524,22 +1524,22 @@ SUBROUTINE unscramble_pack(i1, j2, lot, nfft, n1, n3, md2, nproc, nd3, zmpi2, zw DO i3 = 1, n3/2 indA = i3 - indB = n3/2+2-i3 + indB = n3/2 + 2 - i3 cp = cosinarr(1, i3) sp = cosinarr(2, i3) - DO i = 0, nfft-1 - a = zmpi2(1, i1+i, j2, indA) - b = zmpi2(2, i1+i, j2, indA) - c = zmpi2(1, i1+i, j2, indB) - d = -zmpi2(2, i1+i, j2, indB) - re = (a+c) - ie = (b+d) - ro = (a-c)*cp-(b-d)*sp - io = (a-c)*sp+(b-d)*cp - rh = re-io - ih = ie+ro - zw(1, i+1, indA) = rh - zw(2, i+1, indA) = ih + DO i = 0, nfft - 1 + a = zmpi2(1, i1 + i, j2, indA) + b = zmpi2(2, i1 + i, j2, indA) + c = zmpi2(1, i1 + i, j2, indB) + d = -zmpi2(2, i1 + i, j2, indB) + re = (a + c) + ie = (b + d) + ro = (a - c)*cp - (b - d)*sp + io = (a - c)*sp + (b - d)*cp + rh = re - io + ih = ie + ro + zw(1, i + 1, indA) = rh + zw(2, i + 1, indA) = ih END DO END DO @@ -1612,9 +1612,9 @@ SUBROUTINE F_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro IF (MOD(n1, 2) .NE. 0) CPABORT("Parallel convolution:ERROR:n1") IF (MOD(n2, 2) .NE. 0) CPABORT("Parallel convolution:ERROR:n2") IF (MOD(n3, 2) .NE. 0) CPABORT("Parallel convolution:ERROR:n3") - IF (nd1 .LT. n1/2+1) CPABORT("Parallel convolution:ERROR:nd1") - IF (nd2 .LT. n2/2+1) CPABORT("Parallel convolution:ERROR:nd2") - IF (nd3 .LT. n3/2+1) CPABORT("Parallel convolution:ERROR:nd3") + IF (nd1 .LT. n1/2 + 1) CPABORT("Parallel convolution:ERROR:nd1") + IF (nd2 .LT. n2/2 + 1) CPABORT("Parallel convolution:ERROR:nd2") + IF (nd3 .LT. n3/2 + 1) CPABORT("Parallel convolution:ERROR:nd3") IF (md1 .LT. n1/2) CPABORT("Parallel convolution:ERROR:md1") IF (md2 .LT. n2/2) CPABORT("Parallel convolution:ERROR:md2") IF (md3 .LT. n3/2) CPABORT("Parallel convolution:ERROR:md3") @@ -1626,8 +1626,8 @@ SUBROUTINE F_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro ncache = ncache_optimal IF (ncache <= MAX(n1, n2, n3/2)*4) ncache = MAX(n1, n2, n3/2)*4 lzt = n2/2 - IF (MOD(n2/2, 2) .EQ. 0) lzt = lzt+1 - IF (MOD(n2/2, 4) .EQ. 0) lzt = lzt+1 + IF (MOD(n2/2, 2) .EQ. 0) lzt = lzt + 1 + IF (MOD(n2/2, 4) .EQ. 0) lzt = lzt + 1 !Allocations ALLOCATE (btrig1(2, ctrig_length)) @@ -1672,8 +1672,8 @@ SUBROUTINE F_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro !Calculating array of phases for HalFFT decoding twopion = 8._dp*ATAN(1._dp)/REAL(n3, KIND=dp) DO i3 = 1, n3/2 - cosinarr(1, i3) = COS(twopion*(i3-1)) - cosinarr(2, i3) = -SIN(twopion*(i3-1)) + cosinarr(1, i3) = COS(twopion*(i3 - 1)) + cosinarr(2, i3) = -SIN(twopion*(i3 - 1)) END DO ! transform along z axis @@ -1688,11 +1688,11 @@ SUBROUTINE F_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro DO j2 = 1, md2/nproc !this condition ensures that we manage only the interesting part for the FFT - IF (iproc*(md2/nproc)+j2 .LE. n2/2) THEN + IF (iproc*(md2/nproc) + j2 .LE. n2/2) THEN DO i1 = 1, (n1/2), lot ma = i1 - mb = MIN(i1+(lot-1), (n1/2)) - nfft = mb-ma+1 + mb = MIN(i1 + (lot - 1), (n1/2)) + nfft = mb - ma + 1 !inserting real data into complex array of half lenght CALL halfill_upcorn(md1, md3, lot, nfft, n3, zf(i1, 1, j2), zw(1, 1, 1)) @@ -1701,9 +1701,9 @@ SUBROUTINE F_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro !input: I1,I3,J2,(Jp2) inzee = 1 DO i = 1, ic3 - CALL fftstp(lot, nfft, n3/2, lot, n3/2, zw(1, 1, inzee), zw(1, 1, 3-inzee), & + CALL fftstp(lot, nfft, n3/2, lot, n3/2, zw(1, 1, inzee), zw(1, 1, 3 - inzee), & btrig3, after3(i), now3(i), before3(i), 1) - inzee = 3-inzee + inzee = 3 - inzee ENDDO !output: I1,i3,J2,(Jp2) @@ -1727,7 +1727,7 @@ SUBROUTINE F_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro !now each process perform complete convolution of its planes DO j3 = 1, nd3/nproc !this condition ensures that we manage only the interesting part for the FFT - IF (iproc*(nd3/nproc)+j3 .LE. n3/2+1) THEN + IF (iproc*(nd3/nproc) + j3 .LE. n3/2 + 1) THEN Jp2stb = 1 J2stb = 1 Jp2stf = 1 @@ -1745,8 +1745,8 @@ SUBROUTINE F_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro DO j = 1, n2/2, lot ma = j - mb = MIN(j+(lot-1), n2/2) - nfft = mb-ma+1 + mb = MIN(j + (lot - 1), n2/2) + nfft = mb - ma + 1 !reverse index ordering, leaving the planes to be transformed at the end !input: I1,J2,j3,Jp2,(jp3) @@ -1760,10 +1760,10 @@ SUBROUTINE F_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro !performing FFT !input: I2,I1,j3,(jp3) inzee = 1 - DO i = 1, ic1-1 - CALL fftstp(lot, nfft, n1, lot, n1, zw(1, 1, inzee), zw(1, 1, 3-inzee), & + DO i = 1, ic1 - 1 + CALL fftstp(lot, nfft, n1, lot, n1, zw(1, 1, inzee), zw(1, 1, 3 - inzee), & btrig1, after1(i), now1(i), before1(i), 1) - inzee = 3-inzee + inzee = 3 - inzee ENDDO !storing the last step into zt array @@ -1785,8 +1785,8 @@ SUBROUTINE F_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro DO j = 1, n1, lot ma = j - mb = MIN(j+(lot-1), n1) - nfft = mb-ma+1 + mb = MIN(j + (lot - 1), n1) + nfft = mb - ma + 1 !reverse ordering !input: I2,i1,j3,(jp3) @@ -1797,9 +1797,9 @@ SUBROUTINE F_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro !input: i1,I2,j3,(jp3) inzee = 1 DO i = 1, ic2 - CALL fftstp(lot, nfft, n2, lot, n2, zw(1, 1, inzee), zw(1, 1, 3-inzee), & + CALL fftstp(lot, nfft, n2, lot, n2, zw(1, 1, inzee), zw(1, 1, 3 - inzee), & btrig2, after2(i), now2(i), before2(i), 1) - inzee = 3-inzee + inzee = 3 - inzee ENDDO !output: i1,i2,j3,(jp3) @@ -1811,9 +1811,9 @@ SUBROUTINE F_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro !transform along y axis !input: i1,i2,j3,(jp3) DO i = 1, ic2 - CALL fftstp(lot, nfft, n2, lot, n2, zw(1, 1, inzee), zw(1, 1, 3-inzee), & + CALL fftstp(lot, nfft, n2, lot, n2, zw(1, 1, inzee), zw(1, 1, 3 - inzee), & ftrig2, after2(i), now2(i), before2(i), -1) - inzee = 3-inzee + inzee = 3 - inzee ENDDO !reverse ordering @@ -1827,8 +1827,8 @@ SUBROUTINE F_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro lot = ncache/(4*n1) DO j = 1, n2/2, lot ma = j - mb = MIN(j+(lot-1), n2/2) - nfft = mb-ma+1 + mb = MIN(j + (lot - 1), n2/2) + nfft = mb - ma + 1 !performing FFT i = 1 @@ -1837,9 +1837,9 @@ SUBROUTINE F_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro inzee = 1 DO i = 2, ic1 - CALL fftstp(lot, nfft, n1, lot, n1, zw(1, 1, inzee), zw(1, 1, 3-inzee), & + CALL fftstp(lot, nfft, n1, lot, n1, zw(1, 1, inzee), zw(1, 1, 3 - inzee), & ftrig1, after1(i), now1(i), before1(i), -1) - inzee = 3-inzee + inzee = 3 - inzee ENDDO !output: I2,I1,j3,(jp3) @@ -1868,11 +1868,11 @@ SUBROUTINE F_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro lot = ncache/(2*n3) DO j2 = 1, md2/nproc !this condition ensures that we manage only the interesting part for the FFT - IF (iproc*(md2/nproc)+j2 .LE. n2/2) THEN + IF (iproc*(md2/nproc) + j2 .LE. n2/2) THEN DO i1 = 1, (n1/2), lot ma = i1 - mb = MIN(i1+(lot-1), (n1/2)) - nfft = mb-ma+1 + mb = MIN(i1 + (lot - 1), (n1/2)) + nfft = mb - ma + 1 !reverse ordering and repack the FFT data in order to be backward HalFFT transformed !input: I1,J2,i3,(Jp2) @@ -1883,9 +1883,9 @@ SUBROUTINE F_PoissonSolver(n1, n2, n3, nd1, nd2, nd3, md1, md2, md3, nproc, ipro !input: I1,i3,J2,(Jp2) inzee = 1 DO i = 1, ic3 - CALL fftstp(lot, nfft, n3/2, lot, n3/2, zw(1, 1, inzee), zw(1, 1, 3-inzee), & + CALL fftstp(lot, nfft, n3/2, lot, n3/2, zw(1, 1, inzee), zw(1, 1, 3 - inzee), & ftrig3, after3(i), now3(i), before3(i), -1) - inzee = 3-inzee + inzee = 3 - inzee ENDDO !output: I1,I3,J2,(Jp2) @@ -1944,9 +1944,9 @@ SUBROUTINE switch_upcorn(nfft, n2, lot, n1, lzt, zt, zw) ! Low frequencies DO j = 1, nfft - DO i = n2/2+1, n2 - zw(1, j, i) = zt(1, i-n2/2, j) - zw(2, j, i) = zt(2, i-n2/2, j) + DO i = n2/2 + 1, n2 + zw(1, j, i) = zt(1, i - n2/2, j) + zw(2, j, i) = zt(2, i - n2/2, j) END DO END DO ! High frequencies @@ -1985,7 +1985,7 @@ SUBROUTINE mpiswitch_upcorn(j3, nfft, Jp2stb, J2stb, lot, n1, md2, nd3, nproc, z mfft = 0 Main: DO Jp2 = Jp2stb, nproc DO J2 = J2stb, md2/nproc - mfft = mfft+1 + mfft = mfft + 1 IF (mfft .GT. nfft) THEN Jp2stb = Jp2 J2stb = J2 @@ -1995,9 +1995,9 @@ SUBROUTINE mpiswitch_upcorn(j3, nfft, Jp2stb, J2stb, lot, n1, md2, nd3, nproc, z zw(1, mfft, I1) = 0._dp zw(2, mfft, I1) = 0._dp END DO - DO I1 = n1/2+1, n1 - zw(1, mfft, I1) = zmpi1(1, I1-n1/2, J2, j3, Jp2) - zw(2, mfft, I1) = zmpi1(2, I1-n1/2, J2, j3, Jp2) + DO I1 = n1/2 + 1, n1 + zw(1, mfft, I1) = zmpi1(1, I1 - n1/2, J2, j3, Jp2) + zw(2, mfft, I1) = zmpi1(2, I1 - n1/2, J2, j3, Jp2) END DO END DO J2stb = 1 @@ -2060,7 +2060,7 @@ SUBROUTINE unmpiswitch_downcorn(j3, nfft, Jp2stf, J2stf, lot, n1, md2, nd3, npro mfft = 0 Main: DO Jp2 = Jp2stf, nproc DO J2 = J2stf, md2/nproc - mfft = mfft+1 + mfft = mfft + 1 IF (mfft .GT. nfft) THEN Jp2stf = Jp2 J2stf = J2 @@ -2115,10 +2115,10 @@ SUBROUTINE F_unfill_downcorn(md1, md3, lot, nfft, n3, zw, zf, scal, ehartreetmp) DO i3 = 1, n3/4 DO i1 = 1, nfft pot1 = scal*zw(1, i1, i3) - ehartreetmp = ehartreetmp+pot1*zf(i1, 2*i3-1) - zf(i1, 2*i3-1) = pot1 + ehartreetmp = ehartreetmp + pot1*zf(i1, 2*i3 - 1) + zf(i1, 2*i3 - 1) = pot1 pot1 = scal*zw(2, i1, i3) - ehartreetmp = ehartreetmp+pot1*zf(i1, 2*i3) + ehartreetmp = ehartreetmp + pot1*zf(i1, 2*i3) zf(i1, 2*i3) = pot1 ENDDO END DO diff --git a/src/pw/ps_wavelet_fft3d.F b/src/pw/ps_wavelet_fft3d.F index 63e9e4c8b5..169843269d 100644 --- a/src/pw/ps_wavelet_fft3d.F +++ b/src/pw/ps_wavelet_fft3d.F @@ -6,21 +6,20 @@ ! ************************************************************************************************** MODULE ps_wavelet_fft3d - USE kinds, ONLY: dp #include "../base/base_uses.f90" - IMPLICIT NONE - PRIVATE + IMPLICIT NONE + PRIVATE CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'ps_wavelet_fft3d' - ! longest fft supported, must be equal to the lenght of the ctrig array - INTEGER, PARAMETER :: ctrig_length=8192 + ! longest fft supported, must be equal to the lenght of the ctrig array + INTEGER, PARAMETER :: ctrig_length = 8192 - PUBLIC :: fourier_dim,& - ctrig,& - fftstp, ctrig_length + PUBLIC :: fourier_dim, & + ctrig, & + fftstp, ctrig_length CONTAINS @@ -29,36 +28,35 @@ MODULE ps_wavelet_fft3d !> \param n ... !> \param n_next ... ! ************************************************************************************************** - SUBROUTINE fourier_dim(n,n_next) + SUBROUTINE fourier_dim(n, n_next) INTEGER, INTENT(in) :: n INTEGER, INTENT(out) :: n_next INTEGER, PARAMETER :: ndata = 149, ndata1024 = 149 - INTEGER, DIMENSION(ndata), PARAMETER :: idata = (/ 3, 4, 5, 6, 8, 9, 12, 15& - , 16, 18, 20, 24, 25, 27, 30, 32, 36,40, 45, 48, 54, 60, 64, 72,& - 75, 80, 81, 90, 96, 100, 108, 120, 125, 128, 135, 144, 150, 160, 162, & - 180, 192, 200, 216, 225, 240, 243, 256, 270, 288, 300, 320, 324, 360, 375, 384& - , 400, 405, 432, 450, 480, 486, 500, 512, 540, 576, 600, 625, 640, 648, 675,& - 720, 729, 750, 768, 800, 810, 864, 900, 960, 972, 1000, 1024, 1080, 1125, 1152, & - 1200, 1215, 1280, 1296, 1350,1440, 1458, 1500, 1536, 1600, 1620, 1728, 1800, 1875, 1920,& - 1944, 2000, 2025, 2048, 2160, 2250, 2304, 2400, 2430, 2500,2560, 2592, 2700, 2880, 3000, & - 3072, 3125, 3200, 3240, 3375,3456, 3600, 3750, 3840, 3888, 4000, 4050, 4096, 4320, 4500,& - 4608, 4800, 5000, 5120, 5184, 5400, 5625, 5760, 6000, 6144,6400, 6480, 6750, 6912, 7200, & - 7500, 7680, 8000, ctrig_length /) + INTEGER, DIMENSION(ndata), PARAMETER :: idata = (/3, 4, 5, 6, 8, 9, 12, 15, 16, 18, 20, 24, & + 25, 27, 30, 32, 36, 40, 45, 48, 54, 60, 64, 72, 75, 80, 81, 90, 96, 100, 108, 120, 125, & + 128, 135, 144, 150, 160, 162, 180, 192, 200, 216, 225, 240, 243, 256, 270, 288, 300, 320, & + 324, 360, 375, 384, 400, 405, 432, 450, 480, 486, 500, 512, 540, 576, 600, 625, 640, 648, & + 675, 720, 729, 750, 768, 800, 810, 864, 900, 960, 972, 1000, 1024, 1080, 1125, 1152, 1200,& + 1215, 1280, 1296, 1350, 1440, 1458, 1500, 1536, 1600, 1620, 1728, 1800, 1875, 1920, 1944, & + 2000, 2025, 2048, 2160, 2250, 2304, 2400, 2430, 2500, 2560, 2592, 2700, 2880, 3000, 3072, & + 3125, 3200, 3240, 3375, 3456, 3600, 3750, 3840, 3888, 4000, 4050, 4096, 4320, 4500, 4608, & + 4800, 5000, 5120, 5184, 5400, 5625, 5760, 6000, 6144, 6400, 6480, 6750, 6912, 7200, 7500, & + 7680, 8000, ctrig_length/) INTEGER :: i !Multiple of 2,3,5 - loop_data: DO i=1,ndata1024 - IF (n <= idata(i)) THEN - n_next = idata(i) - RETURN - END IF - END DO loop_data - WRITE(unit=*,fmt=*) "fourier_dim: ",n," is bigger than ",idata(ndata1024) - CPABORT("") - END SUBROUTINE fourier_dim + loop_data: DO i = 1, ndata1024 + IF (n <= idata(i)) THEN + n_next = idata(i) + RETURN + END IF + END DO loop_data + WRITE (unit=*, fmt=*) "fourier_dim: ", n, " is bigger than ", idata(ndata1024) + CPABORT("") + END SUBROUTINE fourier_dim ! Copyright (C) Stefan Goedecker, CEA Grenoble, 2002 ! This file is distributed under the terms of the @@ -101,7 +99,7 @@ END SUBROUTINE fourier_dim !> \param isign ... !> \param ic ... ! ************************************************************************************************** - SUBROUTINE ctrig(n,trig,after,before,now,isign,ic) + SUBROUTINE ctrig(n, trig, after, before, now, isign, ic) ! Copyright (C) Stefan Goedecker, Lausanne, Switzerland, August 1, 1991 ! Copyright (C) Stefan Goedecker, Cornell University, Ithaca, USA, 1994 ! Copyright (C) Stefan Goedecker, MPI Stuttgart, Germany, 1999 @@ -117,147 +115,147 @@ SUBROUTINE ctrig(n,trig,after,before,now,isign,ic) INTEGER :: i, itt, j, nh REAL(KIND=dp) :: angle, trigc, trigs, twopi - DIMENSION now(7),after(7),before(7),trig(2,ctrig_length) - INTEGER, DIMENSION(7,149) :: idata + DIMENSION now(7), after(7), before(7), trig(2, ctrig_length) + INTEGER, DIMENSION(7, 149) :: idata ! The factor 6 is only allowed in the first place! - DATA ((idata(i,j),i=1,7),j=1,76) / & - 3, 3, 1, 1, 1, 1, 1, 4, 4, 1, 1, 1, 1, 1, & - 5, 5, 1, 1, 1, 1, 1, 6, 6, 1, 1, 1, 1, 1, & - 8, 8, 1, 1, 1, 1, 1, 9, 3, 3, 1, 1, 1, 1, & - 12, 4, 3, 1, 1, 1, 1, 15, 5, 3, 1, 1, 1, 1, & - 16, 4, 4, 1, 1, 1, 1, 18, 6, 3, 1, 1, 1, 1, & - 20, 5, 4, 1, 1, 1, 1, 24, 8, 3, 1, 1, 1, 1, & - 25, 5, 5, 1, 1, 1, 1, 27, 3, 3, 3, 1, 1, 1, & - 30, 6, 5, 1, 1, 1, 1, 32, 8, 4, 1, 1, 1, 1, & - 36, 4, 3, 3, 1, 1, 1, 40, 8, 5, 1, 1, 1, 1, & - 45, 5, 3, 3, 1, 1, 1, 48, 4, 4, 3, 1, 1, 1, & - 54, 6, 3, 3, 1, 1, 1, 60, 5, 4, 3, 1, 1, 1, & - 64, 8, 8, 1, 1, 1, 1, 72, 8, 3, 3, 1, 1, 1, & - 75, 5, 5, 3, 1, 1, 1, 80, 5, 4, 4, 1, 1, 1, & - 81, 3, 3, 3, 3, 1, 1, 90, 6, 5, 3, 1, 1, 1, & - 96, 8, 4, 3, 1, 1, 1, 100, 5, 5, 4, 1, 1, 1, & - 108, 4, 3, 3, 3, 1, 1, 120, 8, 5, 3, 1, 1, 1, & - 125, 5, 5, 5, 1, 1, 1, 128, 8, 4, 4, 1, 1, 1, & - 135, 5, 3, 3, 3, 1, 1, 144, 6, 8, 3, 1, 1, 1, & - 150, 6, 5, 5, 1, 1, 1, 160, 8, 5, 4, 1, 1, 1, & - 162, 6, 3, 3, 3, 1, 1, 180, 5, 4, 3, 3, 1, 1, & - 192, 6, 8, 4, 1, 1, 1, 200, 8, 5, 5, 1, 1, 1, & - 216, 8, 3, 3, 3, 1, 1, 225, 5, 5, 3, 3, 1, 1, & - 240, 6, 8, 5, 1, 1, 1, 243, 3, 3, 3, 3, 3, 1, & - 256, 8, 8, 4, 1, 1, 1, 270, 6, 5, 3, 3, 1, 1, & - 288, 8, 4, 3, 3, 1, 1, 300, 5, 5, 4, 3, 1, 1, & - 320, 5, 4, 4, 4, 1, 1, 324, 4, 3, 3, 3, 3, 1, & - 360, 8, 5, 3, 3, 1, 1, 375, 5, 5, 5, 3, 1, 1, & - 384, 8, 4, 4, 3, 1, 1, 400, 5, 5, 4, 4, 1, 1, & - 405, 5, 3, 3, 3, 3, 1, 432, 4, 4, 3, 3, 3, 1, & - 450, 6, 5, 5, 3, 1, 1, 480, 8, 5, 4, 3, 1, 1, & - 486, 6, 3, 3, 3, 3, 1, 500, 5, 5, 5, 4, 1, 1, & - 512, 8, 8, 8, 1, 1, 1, 540, 5, 4, 3, 3, 3, 1, & - 576, 4, 4, 4, 3, 3, 1, 600, 8, 5, 5, 3, 1, 1, & - 625, 5, 5, 5, 5, 1, 1, 640, 8, 5, 4, 4, 1, 1, & - 648, 8, 3, 3, 3, 3, 1, 675, 5, 5, 3, 3, 3, 1, & - 720, 5, 4, 4, 3, 3, 1, 729, 3, 3, 3, 3, 3, 3, & - 750, 6, 5, 5, 5, 1, 1, 768, 4, 4, 4, 4, 3, 1, & - 800, 8, 5, 5, 4, 1, 1, 810, 6, 5, 3, 3, 3, 1 / - DATA ((idata(i,j),i=1,7),j=77,149) / & - 864, 8, 4, 3, 3, 3, 1, 900, 5, 5, 4, 3, 3, 1, & - 960, 5, 4, 4, 4, 3, 1, 972, 4, 3, 3, 3, 3, 3, & - 1000, 8, 5, 5, 5, 1, 1, 1024, 4, 4, 4, 4, 4, 1, & - 1080, 6, 5, 4, 3, 3, 1, 1125, 5, 5, 5, 3, 3, 1, & - 1152, 6, 4, 4, 4, 3, 1, 1200, 6, 8, 5, 5, 1, 1, & - 1215, 5, 3, 3, 3, 3, 3, 1280, 8, 8, 5, 4, 1, 1, & - 1296, 6, 8, 3, 3, 3, 1, 1350, 6, 5, 5, 3, 3, 1, & - 1440, 6, 5, 4, 4, 3, 1, 1458, 6, 3, 3, 3, 3, 3, & - 1500, 5, 5, 5, 4, 3, 1, 1536, 6, 8, 8, 4, 1, 1, & - 1600, 8, 8, 5, 5, 1, 1, 1620, 5, 4, 3, 3, 3, 3, & - 1728, 6, 8, 4, 3, 3, 1, 1800, 6, 5, 5, 4, 3, 1, & - 1875, 5, 5, 5, 5, 3, 1, 1920, 6, 5, 4, 4, 4, 1, & - 1944, 6, 4, 3, 3, 3, 3, 2000, 5, 5, 5, 4, 4, 1, & - 2025, 5, 5, 3, 3, 3, 3, 2048, 8, 4, 4, 4, 4, 1, & - 2160, 6, 8, 5, 3, 3, 1, 2250, 6, 5, 5, 5, 3, 1, & - 2304, 6, 8, 4, 4, 3, 1, 2400, 6, 5, 5, 4, 4, 1, & - 2430, 6, 5, 3, 3, 3, 3, 2500, 5, 5, 5, 5, 4, 1, & - 2560, 8, 5, 4, 4, 4, 1, 2592, 6, 4, 4, 3, 3, 3, & - 2700, 5, 5, 4, 3, 3, 3, 2880, 6, 8, 5, 4, 3, 1, & - 3000, 6, 5, 5, 5, 4, 1, 3072, 6, 8, 4, 4, 4, 1, & - 3125, 5, 5, 5, 5, 5, 1, 3200, 8, 5, 5, 4, 4, 1, & - 3240, 6, 5, 4, 3, 3, 3, 3375, 5, 5, 5, 3, 3, 3, & - 3456, 6, 4, 4, 4, 3, 3, 3600, 6, 8, 5, 5, 3, 1, & - 3750, 6, 5, 5, 5, 5, 1, 3840, 6, 8, 5, 4, 4, 1, & - 3888, 6, 8, 3, 3, 3, 3, 4000, 8, 5, 5, 5, 4, 1, & - 4050, 6, 5, 5, 3, 3, 3, 4096, 8, 8, 4, 4, 4, 1, & - 4320, 6, 5, 4, 4, 3, 3, 4500, 5, 5, 5, 4, 3, 3, & - 4608, 6, 8, 8, 4, 3, 1, 4800, 6, 8, 5, 5, 4, 1, & - 5000, 8, 5, 5, 5, 5, 1, 5120, 8, 8, 5, 4, 4, 1, & - 5184, 6, 8, 4, 3, 3, 3, 5400, 6, 5, 5, 4, 3, 3, & - 5625, 5, 5, 5, 5, 3, 3, 5760, 6, 8, 8, 5, 3, 1, & - 6000, 6, 8, 5, 5, 5, 1, 6144, 6, 8, 8, 4, 4, 1, & - 6400, 8, 8, 5, 5, 4, 1, 6480, 6, 8, 5, 3, 3, 3, & - 6750, 6, 5, 5, 5, 3, 3, 6912, 6, 8, 4, 4, 3, 3, & - 7200, 6, 5, 5, 4, 4, 3, 7500, 5, 5, 5, 5, 4, 3, & - 7680, 6, 8, 8, 5, 4, 1, 8000, 8, 8, 5, 5, 5, 1, & - 8192, 8, 8, 8, 4, 4, 1 / + DATA((idata(i, j), i=1, 7), j=1, 76)/ & + 3, 3, 1, 1, 1, 1, 1, 4, 4, 1, 1, 1, 1, 1, & + 5, 5, 1, 1, 1, 1, 1, 6, 6, 1, 1, 1, 1, 1, & + 8, 8, 1, 1, 1, 1, 1, 9, 3, 3, 1, 1, 1, 1, & + 12, 4, 3, 1, 1, 1, 1, 15, 5, 3, 1, 1, 1, 1, & + 16, 4, 4, 1, 1, 1, 1, 18, 6, 3, 1, 1, 1, 1, & + 20, 5, 4, 1, 1, 1, 1, 24, 8, 3, 1, 1, 1, 1, & + 25, 5, 5, 1, 1, 1, 1, 27, 3, 3, 3, 1, 1, 1, & + 30, 6, 5, 1, 1, 1, 1, 32, 8, 4, 1, 1, 1, 1, & + 36, 4, 3, 3, 1, 1, 1, 40, 8, 5, 1, 1, 1, 1, & + 45, 5, 3, 3, 1, 1, 1, 48, 4, 4, 3, 1, 1, 1, & + 54, 6, 3, 3, 1, 1, 1, 60, 5, 4, 3, 1, 1, 1, & + 64, 8, 8, 1, 1, 1, 1, 72, 8, 3, 3, 1, 1, 1, & + 75, 5, 5, 3, 1, 1, 1, 80, 5, 4, 4, 1, 1, 1, & + 81, 3, 3, 3, 3, 1, 1, 90, 6, 5, 3, 1, 1, 1, & + 96, 8, 4, 3, 1, 1, 1, 100, 5, 5, 4, 1, 1, 1, & + 108, 4, 3, 3, 3, 1, 1, 120, 8, 5, 3, 1, 1, 1, & + 125, 5, 5, 5, 1, 1, 1, 128, 8, 4, 4, 1, 1, 1, & + 135, 5, 3, 3, 3, 1, 1, 144, 6, 8, 3, 1, 1, 1, & + 150, 6, 5, 5, 1, 1, 1, 160, 8, 5, 4, 1, 1, 1, & + 162, 6, 3, 3, 3, 1, 1, 180, 5, 4, 3, 3, 1, 1, & + 192, 6, 8, 4, 1, 1, 1, 200, 8, 5, 5, 1, 1, 1, & + 216, 8, 3, 3, 3, 1, 1, 225, 5, 5, 3, 3, 1, 1, & + 240, 6, 8, 5, 1, 1, 1, 243, 3, 3, 3, 3, 3, 1, & + 256, 8, 8, 4, 1, 1, 1, 270, 6, 5, 3, 3, 1, 1, & + 288, 8, 4, 3, 3, 1, 1, 300, 5, 5, 4, 3, 1, 1, & + 320, 5, 4, 4, 4, 1, 1, 324, 4, 3, 3, 3, 3, 1, & + 360, 8, 5, 3, 3, 1, 1, 375, 5, 5, 5, 3, 1, 1, & + 384, 8, 4, 4, 3, 1, 1, 400, 5, 5, 4, 4, 1, 1, & + 405, 5, 3, 3, 3, 3, 1, 432, 4, 4, 3, 3, 3, 1, & + 450, 6, 5, 5, 3, 1, 1, 480, 8, 5, 4, 3, 1, 1, & + 486, 6, 3, 3, 3, 3, 1, 500, 5, 5, 5, 4, 1, 1, & + 512, 8, 8, 8, 1, 1, 1, 540, 5, 4, 3, 3, 3, 1, & + 576, 4, 4, 4, 3, 3, 1, 600, 8, 5, 5, 3, 1, 1, & + 625, 5, 5, 5, 5, 1, 1, 640, 8, 5, 4, 4, 1, 1, & + 648, 8, 3, 3, 3, 3, 1, 675, 5, 5, 3, 3, 3, 1, & + 720, 5, 4, 4, 3, 3, 1, 729, 3, 3, 3, 3, 3, 3, & + 750, 6, 5, 5, 5, 1, 1, 768, 4, 4, 4, 4, 3, 1, & + 800, 8, 5, 5, 4, 1, 1, 810, 6, 5, 3, 3, 3, 1/ + DATA((idata(i, j), i=1, 7), j=77, 149)/ & + 864, 8, 4, 3, 3, 3, 1, 900, 5, 5, 4, 3, 3, 1, & + 960, 5, 4, 4, 4, 3, 1, 972, 4, 3, 3, 3, 3, 3, & + 1000, 8, 5, 5, 5, 1, 1, 1024, 4, 4, 4, 4, 4, 1, & + 1080, 6, 5, 4, 3, 3, 1, 1125, 5, 5, 5, 3, 3, 1, & + 1152, 6, 4, 4, 4, 3, 1, 1200, 6, 8, 5, 5, 1, 1, & + 1215, 5, 3, 3, 3, 3, 3, 1280, 8, 8, 5, 4, 1, 1, & + 1296, 6, 8, 3, 3, 3, 1, 1350, 6, 5, 5, 3, 3, 1, & + 1440, 6, 5, 4, 4, 3, 1, 1458, 6, 3, 3, 3, 3, 3, & + 1500, 5, 5, 5, 4, 3, 1, 1536, 6, 8, 8, 4, 1, 1, & + 1600, 8, 8, 5, 5, 1, 1, 1620, 5, 4, 3, 3, 3, 3, & + 1728, 6, 8, 4, 3, 3, 1, 1800, 6, 5, 5, 4, 3, 1, & + 1875, 5, 5, 5, 5, 3, 1, 1920, 6, 5, 4, 4, 4, 1, & + 1944, 6, 4, 3, 3, 3, 3, 2000, 5, 5, 5, 4, 4, 1, & + 2025, 5, 5, 3, 3, 3, 3, 2048, 8, 4, 4, 4, 4, 1, & + 2160, 6, 8, 5, 3, 3, 1, 2250, 6, 5, 5, 5, 3, 1, & + 2304, 6, 8, 4, 4, 3, 1, 2400, 6, 5, 5, 4, 4, 1, & + 2430, 6, 5, 3, 3, 3, 3, 2500, 5, 5, 5, 5, 4, 1, & + 2560, 8, 5, 4, 4, 4, 1, 2592, 6, 4, 4, 3, 3, 3, & + 2700, 5, 5, 4, 3, 3, 3, 2880, 6, 8, 5, 4, 3, 1, & + 3000, 6, 5, 5, 5, 4, 1, 3072, 6, 8, 4, 4, 4, 1, & + 3125, 5, 5, 5, 5, 5, 1, 3200, 8, 5, 5, 4, 4, 1, & + 3240, 6, 5, 4, 3, 3, 3, 3375, 5, 5, 5, 3, 3, 3, & + 3456, 6, 4, 4, 4, 3, 3, 3600, 6, 8, 5, 5, 3, 1, & + 3750, 6, 5, 5, 5, 5, 1, 3840, 6, 8, 5, 4, 4, 1, & + 3888, 6, 8, 3, 3, 3, 3, 4000, 8, 5, 5, 5, 4, 1, & + 4050, 6, 5, 5, 3, 3, 3, 4096, 8, 8, 4, 4, 4, 1, & + 4320, 6, 5, 4, 4, 3, 3, 4500, 5, 5, 5, 4, 3, 3, & + 4608, 6, 8, 8, 4, 3, 1, 4800, 6, 8, 5, 5, 4, 1, & + 5000, 8, 5, 5, 5, 5, 1, 5120, 8, 8, 5, 4, 4, 1, & + 5184, 6, 8, 4, 3, 3, 3, 5400, 6, 5, 5, 4, 3, 3, & + 5625, 5, 5, 5, 5, 3, 3, 5760, 6, 8, 8, 5, 3, 1, & + 6000, 6, 8, 5, 5, 5, 1, 6144, 6, 8, 8, 4, 4, 1, & + 6400, 8, 8, 5, 5, 4, 1, 6480, 6, 8, 5, 3, 3, 3, & + 6750, 6, 5, 5, 5, 3, 3, 6912, 6, 8, 4, 4, 3, 3, & + 7200, 6, 5, 5, 4, 4, 3, 7500, 5, 5, 5, 5, 4, 3, & + 7680, 6, 8, 8, 5, 4, 1, 8000, 8, 8, 5, 5, 5, 1, & + 8192, 8, 8, 8, 4, 4, 1/ - DO i=1,150 - IF(i==150) THEN - PRINT*,'VALUE OF',n,'NOT ALLOWED FOR FFT, ALLOWED VALUES ARE:' - 37 FORMAT(15(i5)) - WRITE(*,37) (idata(1,j),j=1,149) + DO i = 1, 150 + IF (i == 150) THEN + PRINT *, 'VALUE OF', n, 'NOT ALLOWED FOR FFT, ALLOWED VALUES ARE:' +37 FORMAT(15(i5)) + WRITE (*, 37) (idata(1, j), j=1, 149) CPABORT("") - ENDIF - IF (n.EQ.idata(1,i)) THEN - ic=0 - DO j=1,6 - itt=idata(1+j,i) - IF (itt.GT.1) THEN - ic=ic+1 - now(j)=idata(1+j,i) - ELSE - EXIT - ENDIF + ENDIF + IF (n .EQ. idata(1, i)) THEN + ic = 0 + DO j = 1, 6 + itt = idata(1 + j, i) + IF (itt .GT. 1) THEN + ic = ic + 1 + now(j) = idata(1 + j, i) + ELSE + EXIT + ENDIF ENDDO EXIT - ENDIF - ENDDO + ENDIF + ENDDO - after(1)=1 - before(ic)=1 - DO i=2,ic - after(i)=after(i-1)*now(i-1) - before(ic-i+1)=before(ic-i+2)*now(ic-i+2) - ENDDO + after(1) = 1 + before(ic) = 1 + DO i = 2, ic + after(i) = after(i - 1)*now(i - 1) + before(ic - i + 1) = before(ic - i + 2)*now(ic - i + 2) + ENDDO - twopi=6.283185307179586_dp - angle=isign*twopi/n - IF (MOD(n,2).EQ.0) THEN - nh=n/2 - trig(1,1)=1._dp - trig(2,1)=0._dp - trig(1,nh+1)=-1._dp - trig(2,nh+1)=0._dp - DO 40,i=1,nh-1 - trigc=COS(i*angle) - trigs=SIN(i*angle) - trig(1,i+1)=trigc - trig(2,i+1)=trigs - trig(1,n-i+1)=trigc - trig(2,n-i+1)=-trigs -40 CONTINUE - ELSE - nh=(n-1)/2 - trig(1,1)=1._dp - trig(2,1)=0._dp - DO 20,i=1,nh - trigc=COS(i*angle) - trigs=SIN(i*angle) - trig(1,i+1)=trigc - trig(2,i+1)=trigs - trig(1,n-i+1)=trigc - trig(2,n-i+1)=-trigs -20 CONTINUE - ENDIF + twopi = 6.283185307179586_dp + angle = isign*twopi/n + IF (MOD(n, 2) .EQ. 0) THEN + nh = n/2 + trig(1, 1) = 1._dp + trig(2, 1) = 0._dp + trig(1, nh + 1) = -1._dp + trig(2, nh + 1) = 0._dp + DO 40, i = 1, nh - 1 + trigc = COS(i*angle) + trigs = SIN(i*angle) + trig(1, i + 1) = trigc + trig(2, i + 1) = trigs + trig(1, n - i + 1) = trigc + trig(2, n - i + 1) = -trigs +40 CONTINUE + ELSE + nh = (n - 1)/2 + trig(1, 1) = 1._dp + trig(2, 1) = 0._dp + DO 20, i = 1, nh + trigc = COS(i*angle) + trigs = SIN(i*angle) + trig(1, i + 1) = trigc + trig(2, i + 1) = trigs + trig(1, n - i + 1) = trigc + trig(2, n - i + 1) = -trigs +20 CONTINUE + ENDIF - END SUBROUTINE ctrig + END SUBROUTINE ctrig !ccccccccccccccccccccccccccccccccccccccccccccccc @@ -276,7 +274,7 @@ END SUBROUTINE ctrig !> \param before ... !> \param isign ... ! ************************************************************************************************** - SUBROUTINE fftstp(mm,nfft,m,nn,n,zin,zout,trig,after,now,before,isign) + SUBROUTINE fftstp(mm, nfft, m, nn, n, zin, zout, trig, after, now, before, isign) ! Copyright (C) Stefan Goedecker, Cornell University, Ithaca, USA, 1994 ! Copyright (C) Stefan Goedecker, MPI Stuttgart, Germany, 1995, 1999 ! This file is distributed under the terms of the @@ -295,1438 +293,1438 @@ SUBROUTINE fftstp(mm,nfft,m,nn,n,zin,zout,trig,after,now,before,isign) rt2i, s, s1, s2, s25, s3, s34, s4, s5, s6, s7, s8, sin2, sin4, ui1, ui2, ui3, ur1, ur2, & ur3, vi1, vi2, vi3, vr1, vr2, vr3 - DIMENSION trig(2,ctrig_length),zin(2,mm,m),zout(2,nn,n) - atn=after*now - atb=after*before + DIMENSION trig(2, ctrig_length), zin(2, mm, m), zout(2, nn, n) + atn = after*now + atb = after*before ! sqrt(.5_dp) - rt2i=0.7071067811865475_dp - IF (now.EQ.2) THEN - ia=1 - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nout1=nout1+atn - nout2=nout1+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r2=zin(1,j,nin2) - s2=zin(2,j,nin2) - zout(1,j,nout1)= r2 + r1 - zout(2,j,nout1)= s2 + s1 - zout(1,j,nout2)= r1 - r2 - zout(2,j,nout2)= s1 - s2 - ENDDO ; ENDDO - DO 2000,ia=2,after - ias=ia-1 - IF (2*ias.EQ.after) THEN - IF (isign.EQ.1) THEN - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nout1=nout1+atn - nout2=nout1+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r2=zin(2,j,nin2) - s2=zin(1,j,nin2) - zout(1,j,nout1)= r1 - r2 - zout(2,j,nout1)= s2 + s1 - zout(1,j,nout2)= r2 + r1 - zout(2,j,nout2)= s1 - s2 - ENDDO ; ENDDO - ELSE - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nout1=nout1+atn - nout2=nout1+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r2=zin(2,j,nin2) - s2=zin(1,j,nin2) - zout(1,j,nout1)= r2 + r1 - zout(2,j,nout1)= s1 - s2 - zout(1,j,nout2)= r1 - r2 - zout(2,j,nout2)= s2 + s1 - ENDDO ; ENDDO - ENDIF - ELSE IF (4*ias.EQ.after) THEN - IF (isign.EQ.1) THEN - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nout1=nout1+atn - nout2=nout1+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r=zin(1,j,nin2) - s=zin(2,j,nin2) - r2=(r - s)*rt2i - s2=(r + s)*rt2i - zout(1,j,nout1)= r2 + r1 - zout(2,j,nout1)= s2 + s1 - zout(1,j,nout2)= r1 - r2 - zout(2,j,nout2)= s1 - s2 - ENDDO ; ENDDO - ELSE - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nout1=nout1+atn - nout2=nout1+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r=zin(1,j,nin2) - s=zin(2,j,nin2) - r2=(r + s)*rt2i - s2=(s - r)*rt2i - zout(1,j,nout1)= r2 + r1 - zout(2,j,nout1)= s2 + s1 - zout(1,j,nout2)= r1 - r2 - zout(2,j,nout2)= s1 - s2 - ENDDO ; ENDDO - ENDIF - ELSE IF (4*ias.EQ.3*after) THEN - IF (isign.EQ.1) THEN - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nout1=nout1+atn - nout2=nout1+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r=zin(1,j,nin2) - s=zin(2,j,nin2) - r2=(r + s)*rt2i - s2=(r - s)*rt2i - zout(1,j,nout1)= r1 - r2 - zout(2,j,nout1)= s2 + s1 - zout(1,j,nout2)= r2 + r1 - zout(2,j,nout2)= s1 - s2 - ENDDO ; ENDDO - ELSE - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nout1=nout1+atn - nout2=nout1+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r=zin(1,j,nin2) - s=zin(2,j,nin2) - r2=(s - r)*rt2i - s2=(r + s)*rt2i - zout(1,j,nout1)= r2 + r1 - zout(2,j,nout1)= s1 - s2 - zout(1,j,nout2)= r1 - r2 - zout(2,j,nout2)= s2 + s1 - ENDDO ; ENDDO - ENDIF - ELSE - itrig=ias*before+1 - cr2=trig(1,itrig) - ci2=trig(2,itrig) - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nout1=nout1+atn - nout2=nout1+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r=zin(1,j,nin2) - s=zin(2,j,nin2) - r2=r*cr2 - s*ci2 - s2=r*ci2 + s*cr2 - zout(1,j,nout1)= r2 + r1 - zout(2,j,nout1)= s2 + s1 - zout(1,j,nout2)= r1 - r2 - zout(2,j,nout2)= s1 - s2 - ENDDO ; ENDDO - ENDIF -2000 CONTINUE - ELSE IF (now.EQ.4) THEN - IF (isign.EQ.1) THEN - ia=1 - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nin3=nin2+atb - nin4=nin3+atb - nout1=nout1+atn - nout2=nout1+after - nout3=nout2+after - nout4=nout3+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r2=zin(1,j,nin2) - s2=zin(2,j,nin2) - r3=zin(1,j,nin3) - s3=zin(2,j,nin3) - r4=zin(1,j,nin4) - s4=zin(2,j,nin4) - r=r1 + r3 - s=r2 + r4 - zout(1,j,nout1) = r + s - zout(1,j,nout3) = r - s - r=r1 - r3 - s=s2 - s4 - zout(1,j,nout2) = r - s - zout(1,j,nout4) = r + s - r=s1 + s3 - s=s2 + s4 - zout(2,j,nout1) = r + s - zout(2,j,nout3) = r - s - r=s1 - s3 - s=r2 - r4 - zout(2,j,nout2) = r + s - zout(2,j,nout4) = r - s - ENDDO ; ENDDO - DO 4000,ia=2,after - ias=ia-1 - IF (2*ias.EQ.after) THEN - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nin3=nin2+atb - nin4=nin3+atb - nout1=nout1+atn - nout2=nout1+after - nout3=nout2+after - nout4=nout3+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r=zin(1,j,nin2) - s=zin(2,j,nin2) - r2=(r-s)*rt2i - s2=(r+s)*rt2i - r3=zin(2,j,nin3) - s3=zin(1,j,nin3) - r=zin(1,j,nin4) - s=zin(2,j,nin4) - r4=(r + s)*rt2i - s4=(r - s)*rt2i - r=r1 - r3 - s=r2 - r4 - zout(1,j,nout1) = r + s - zout(1,j,nout3) = r - s - r=r1 + r3 - s=s2 - s4 - zout(1,j,nout2) = r - s - zout(1,j,nout4) = r + s - r=s1 + s3 - s=s2 + s4 - zout(2,j,nout1) = r + s - zout(2,j,nout3) = r - s - r=s1 - s3 - s=r2 + r4 - zout(2,j,nout2) = r + s - zout(2,j,nout4) = r - s - ENDDO ; ENDDO - ELSE - itt=ias*before - itrig=itt+1 - cr2=trig(1,itrig) - ci2=trig(2,itrig) - itrig=itrig+itt - cr3=trig(1,itrig) - ci3=trig(2,itrig) - itrig=itrig+itt - cr4=trig(1,itrig) - ci4=trig(2,itrig) - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nin3=nin2+atb - nin4=nin3+atb - nout1=nout1+atn - nout2=nout1+after - nout3=nout2+after - nout4=nout3+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r=zin(1,j,nin2) - s=zin(2,j,nin2) - r2=r*cr2 - s*ci2 - s2=r*ci2 + s*cr2 - r=zin(1,j,nin3) - s=zin(2,j,nin3) - r3=r*cr3 - s*ci3 - s3=r*ci3 + s*cr3 - r=zin(1,j,nin4) - s=zin(2,j,nin4) - r4=r*cr4 - s*ci4 - s4=r*ci4 + s*cr4 - r=r1 + r3 - s=r2 + r4 - zout(1,j,nout1) = r + s - zout(1,j,nout3) = r - s - r=r1 - r3 - s=s2 - s4 - zout(1,j,nout2) = r - s - zout(1,j,nout4) = r + s - r=s1 + s3 - s=s2 + s4 - zout(2,j,nout1) = r + s - zout(2,j,nout3) = r - s - r=s1 - s3 - s=r2 - r4 - zout(2,j,nout2) = r + s - zout(2,j,nout4) = r - s - ENDDO ; ENDDO - ENDIF -4000 CONTINUE - ELSE - ia=1 - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nin3=nin2+atb - nin4=nin3+atb - nout1=nout1+atn - nout2=nout1+after - nout3=nout2+after - nout4=nout3+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r2=zin(1,j,nin2) - s2=zin(2,j,nin2) - r3=zin(1,j,nin3) - s3=zin(2,j,nin3) - r4=zin(1,j,nin4) - s4=zin(2,j,nin4) - r=r1 + r3 - s=r2 + r4 - zout(1,j,nout1) = r + s - zout(1,j,nout3) = r - s - r=r1 - r3 - s=s2 - s4 - zout(1,j,nout2) = r + s - zout(1,j,nout4) = r - s - r=s1 + s3 - s=s2 + s4 - zout(2,j,nout1) = r + s - zout(2,j,nout3) = r - s - r=s1 - s3 - s=r2 - r4 - zout(2,j,nout2) = r - s - zout(2,j,nout4) = r + s - ENDDO ; ENDDO - DO 4100,ia=2,after - ias=ia-1 - IF (2*ias.EQ.after) THEN - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nin3=nin2+atb - nin4=nin3+atb - nout1=nout1+atn - nout2=nout1+after - nout3=nout2+after - nout4=nout3+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r=zin(1,j,nin2) - s=zin(2,j,nin2) - r2=(r + s)*rt2i - s2=(s - r)*rt2i - r3=zin(2,j,nin3) - s3=zin(1,j,nin3) - r=zin(1,j,nin4) - s=zin(2,j,nin4) - r4=(s - r)*rt2i - s4=(r + s)*rt2i - r=r1 + r3 - s=r2 + r4 - zout(1,j,nout1) = r + s - zout(1,j,nout3) = r - s - r=r1 - r3 - s=s2 + s4 - zout(1,j,nout2) = r + s - zout(1,j,nout4) = r - s - r=s1 - s3 - s=s2 - s4 - zout(2,j,nout1) = r + s - zout(2,j,nout3) = r - s - r=s1 + s3 - s=r2 - r4 - zout(2,j,nout2) = r - s - zout(2,j,nout4) = r + s - ENDDO ; ENDDO - ELSE - itt=ias*before - itrig=itt+1 - cr2=trig(1,itrig) - ci2=trig(2,itrig) - itrig=itrig+itt - cr3=trig(1,itrig) - ci3=trig(2,itrig) - itrig=itrig+itt - cr4=trig(1,itrig) - ci4=trig(2,itrig) - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nin3=nin2+atb - nin4=nin3+atb - nout1=nout1+atn - nout2=nout1+after - nout3=nout2+after - nout4=nout3+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r=zin(1,j,nin2) - s=zin(2,j,nin2) - r2=r*cr2 - s*ci2 - s2=r*ci2 + s*cr2 - r=zin(1,j,nin3) - s=zin(2,j,nin3) - r3=r*cr3 - s*ci3 - s3=r*ci3 + s*cr3 - r=zin(1,j,nin4) - s=zin(2,j,nin4) - r4=r*cr4 - s*ci4 - s4=r*ci4 + s*cr4 - r=r1 + r3 - s=r2 + r4 - zout(1,j,nout1) = r + s - zout(1,j,nout3) = r - s - r=r1 - r3 - s=s2 - s4 - zout(1,j,nout2) = r + s - zout(1,j,nout4) = r - s - r=s1 + s3 - s=s2 + s4 - zout(2,j,nout1) = r + s - zout(2,j,nout3) = r - s - r=s1 - s3 - s=r2 - r4 - zout(2,j,nout2) = r - s - zout(2,j,nout4) = r + s - ENDDO ; ENDDO - ENDIF -4100 CONTINUE - ENDIF - ELSE IF (now.EQ.8) THEN - IF (isign.EQ.-1) THEN - ia=1 - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nin3=nin2+atb - nin4=nin3+atb - nin5=nin4+atb - nin6=nin5+atb - nin7=nin6+atb - nin8=nin7+atb - nout1=nout1+atn - nout2=nout1+after - nout3=nout2+after - nout4=nout3+after - nout5=nout4+after - nout6=nout5+after - nout7=nout6+after - nout8=nout7+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r2=zin(1,j,nin2) - s2=zin(2,j,nin2) - r3=zin(1,j,nin3) - s3=zin(2,j,nin3) - r4=zin(1,j,nin4) - s4=zin(2,j,nin4) - r5=zin(1,j,nin5) - s5=zin(2,j,nin5) - r6=zin(1,j,nin6) - s6=zin(2,j,nin6) - r7=zin(1,j,nin7) - s7=zin(2,j,nin7) - r8=zin(1,j,nin8) - s8=zin(2,j,nin8) - r=r1 + r5 - s=r3 + r7 - ap=r + s - am=r - s - r=r2 + r6 - s=r4 + r8 - bp=r + s - bm=r - s - r=s1 + s5 - s=s3 + s7 - cp=r + s - cm=r - s - r=s2 + s6 - s=s4 + s8 - dpp=r + s - dm=r - s - zout(1,j,nout1) = ap + bp - zout(2,j,nout1) = cp + dpp - zout(1,j,nout5) = ap - bp - zout(2,j,nout5) = cp - dpp - zout(1,j,nout3) = am + dm - zout(2,j,nout3) = cm - bm - zout(1,j,nout7) = am - dm - zout(2,j,nout7) = cm + bm - r=r1 - r5 - s=s3 - s7 - ap=r + s - am=r - s - r=s1 - s5 - s=r3 - r7 - bp=r + s - bm=r - s - r=s4 - s8 - s=r2 - r6 - cp=r + s - cm=r - s - r=s2 - s6 - s=r4 - r8 - dpp=r + s - dm=r - s - r = ( cp + dm)*rt2i - s = ( dm - cp)*rt2i - cp= ( cm + dpp)*rt2i - dpp = ( cm - dpp)*rt2i - zout(1,j,nout2) = ap + r - zout(2,j,nout2) = bm + s - zout(1,j,nout6) = ap - r - zout(2,j,nout6) = bm - s - zout(1,j,nout4) = am + cp - zout(2,j,nout4) = bp + dpp - zout(1,j,nout8) = am - cp - zout(2,j,nout8) = bp - dpp - ENDDO ; ENDDO - DO 8000,ia=2,after - ias=ia-1 - itt=ias*before - itrig=itt+1 - cr2=trig(1,itrig) - ci2=trig(2,itrig) - itrig=itrig+itt - cr3=trig(1,itrig) - ci3=trig(2,itrig) - itrig=itrig+itt - cr4=trig(1,itrig) - ci4=trig(2,itrig) - itrig=itrig+itt - cr5=trig(1,itrig) - ci5=trig(2,itrig) - itrig=itrig+itt - cr6=trig(1,itrig) - ci6=trig(2,itrig) - itrig=itrig+itt - cr7=trig(1,itrig) - ci7=trig(2,itrig) - itrig=itrig+itt - cr8=trig(1,itrig) - ci8=trig(2,itrig) - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nin3=nin2+atb - nin4=nin3+atb - nin5=nin4+atb - nin6=nin5+atb - nin7=nin6+atb - nin8=nin7+atb - nout1=nout1+atn - nout2=nout1+after - nout3=nout2+after - nout4=nout3+after - nout5=nout4+after - nout6=nout5+after - nout7=nout6+after - nout8=nout7+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r=zin(1,j,nin2) - s=zin(2,j,nin2) - r2=r*cr2 - s*ci2 - s2=r*ci2 + s*cr2 - r=zin(1,j,nin3) - s=zin(2,j,nin3) - r3=r*cr3 - s*ci3 - s3=r*ci3 + s*cr3 - r=zin(1,j,nin4) - s=zin(2,j,nin4) - r4=r*cr4 - s*ci4 - s4=r*ci4 + s*cr4 - r=zin(1,j,nin5) - s=zin(2,j,nin5) - r5=r*cr5 - s*ci5 - s5=r*ci5 + s*cr5 - r=zin(1,j,nin6) - s=zin(2,j,nin6) - r6=r*cr6 - s*ci6 - s6=r*ci6 + s*cr6 - r=zin(1,j,nin7) - s=zin(2,j,nin7) - r7=r*cr7 - s*ci7 - s7=r*ci7 + s*cr7 - r=zin(1,j,nin8) - s=zin(2,j,nin8) - r8=r*cr8 - s*ci8 - s8=r*ci8 + s*cr8 - r=r1 + r5 - s=r3 + r7 - ap=r + s - am=r - s - r=r2 + r6 - s=r4 + r8 - bp=r + s - bm=r - s - r=s1 + s5 - s=s3 + s7 - cp=r + s - cm=r - s - r=s2 + s6 - s=s4 + s8 - dpp=r + s - dm=r - s - zout(1,j,nout1) = ap + bp - zout(2,j,nout1) = cp + dpp - zout(1,j,nout5) = ap - bp - zout(2,j,nout5) = cp - dpp - zout(1,j,nout3) = am + dm - zout(2,j,nout3) = cm - bm - zout(1,j,nout7) = am - dm - zout(2,j,nout7) = cm + bm - r=r1 - r5 - s=s3 - s7 - ap=r + s - am=r - s - r=s1 - s5 - s=r3 - r7 - bp=r + s - bm=r - s - r=s4 - s8 - s=r2 - r6 - cp=r + s - cm=r - s - r=s2 - s6 - s=r4 - r8 - dpp=r + s - dm=r - s - r = ( cp + dm)*rt2i - s = ( dm - cp)*rt2i - cp= ( cm + dpp)*rt2i - dpp = ( cm - dpp)*rt2i - zout(1,j,nout2) = ap + r - zout(2,j,nout2) = bm + s - zout(1,j,nout6) = ap - r - zout(2,j,nout6) = bm - s - zout(1,j,nout4) = am + cp - zout(2,j,nout4) = bp + dpp - zout(1,j,nout8) = am - cp - zout(2,j,nout8) = bp - dpp - ENDDO ; ENDDO -8000 CONTINUE + rt2i = 0.7071067811865475_dp + IF (now .EQ. 2) THEN + ia = 1 + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r2 = zin(1, j, nin2) + s2 = zin(2, j, nin2) + zout(1, j, nout1) = r2 + r1 + zout(2, j, nout1) = s2 + s1 + zout(1, j, nout2) = r1 - r2 + zout(2, j, nout2) = s1 - s2 + ENDDO; ENDDO + DO 2000, ia = 2, after + ias = ia - 1 + IF (2*ias .EQ. after) THEN + IF (isign .EQ. 1) THEN + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r2 = zin(2, j, nin2) + s2 = zin(1, j, nin2) + zout(1, j, nout1) = r1 - r2 + zout(2, j, nout1) = s2 + s1 + zout(1, j, nout2) = r2 + r1 + zout(2, j, nout2) = s1 - s2 + ENDDO; ENDDO + ELSE + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r2 = zin(2, j, nin2) + s2 = zin(1, j, nin2) + zout(1, j, nout1) = r2 + r1 + zout(2, j, nout1) = s1 - s2 + zout(1, j, nout2) = r1 - r2 + zout(2, j, nout2) = s2 + s1 + ENDDO; ENDDO + ENDIF + ELSE IF (4*ias .EQ. after) THEN + IF (isign .EQ. 1) THEN + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r = zin(1, j, nin2) + s = zin(2, j, nin2) + r2 = (r - s)*rt2i + s2 = (r + s)*rt2i + zout(1, j, nout1) = r2 + r1 + zout(2, j, nout1) = s2 + s1 + zout(1, j, nout2) = r1 - r2 + zout(2, j, nout2) = s1 - s2 + ENDDO; ENDDO + ELSE + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r = zin(1, j, nin2) + s = zin(2, j, nin2) + r2 = (r + s)*rt2i + s2 = (s - r)*rt2i + zout(1, j, nout1) = r2 + r1 + zout(2, j, nout1) = s2 + s1 + zout(1, j, nout2) = r1 - r2 + zout(2, j, nout2) = s1 - s2 + ENDDO; ENDDO + ENDIF + ELSE IF (4*ias .EQ. 3*after) THEN + IF (isign .EQ. 1) THEN + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r = zin(1, j, nin2) + s = zin(2, j, nin2) + r2 = (r + s)*rt2i + s2 = (r - s)*rt2i + zout(1, j, nout1) = r1 - r2 + zout(2, j, nout1) = s2 + s1 + zout(1, j, nout2) = r2 + r1 + zout(2, j, nout2) = s1 - s2 + ENDDO; ENDDO + ELSE + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r = zin(1, j, nin2) + s = zin(2, j, nin2) + r2 = (s - r)*rt2i + s2 = (r + s)*rt2i + zout(1, j, nout1) = r2 + r1 + zout(2, j, nout1) = s1 - s2 + zout(1, j, nout2) = r1 - r2 + zout(2, j, nout2) = s2 + s1 + ENDDO; ENDDO + ENDIF + ELSE + itrig = ias*before + 1 + cr2 = trig(1, itrig) + ci2 = trig(2, itrig) + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r = zin(1, j, nin2) + s = zin(2, j, nin2) + r2 = r*cr2 - s*ci2 + s2 = r*ci2 + s*cr2 + zout(1, j, nout1) = r2 + r1 + zout(2, j, nout1) = s2 + s1 + zout(1, j, nout2) = r1 - r2 + zout(2, j, nout2) = s1 - s2 + ENDDO; ENDDO + ENDIF +2000 CONTINUE + ELSE IF (now .EQ. 4) THEN + IF (isign .EQ. 1) THEN + ia = 1 + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r2 = zin(1, j, nin2) + s2 = zin(2, j, nin2) + r3 = zin(1, j, nin3) + s3 = zin(2, j, nin3) + r4 = zin(1, j, nin4) + s4 = zin(2, j, nin4) + r = r1 + r3 + s = r2 + r4 + zout(1, j, nout1) = r + s + zout(1, j, nout3) = r - s + r = r1 - r3 + s = s2 - s4 + zout(1, j, nout2) = r - s + zout(1, j, nout4) = r + s + r = s1 + s3 + s = s2 + s4 + zout(2, j, nout1) = r + s + zout(2, j, nout3) = r - s + r = s1 - s3 + s = r2 - r4 + zout(2, j, nout2) = r + s + zout(2, j, nout4) = r - s + ENDDO; ENDDO + DO 4000, ia = 2, after + ias = ia - 1 + IF (2*ias .EQ. after) THEN + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r = zin(1, j, nin2) + s = zin(2, j, nin2) + r2 = (r - s)*rt2i + s2 = (r + s)*rt2i + r3 = zin(2, j, nin3) + s3 = zin(1, j, nin3) + r = zin(1, j, nin4) + s = zin(2, j, nin4) + r4 = (r + s)*rt2i + s4 = (r - s)*rt2i + r = r1 - r3 + s = r2 - r4 + zout(1, j, nout1) = r + s + zout(1, j, nout3) = r - s + r = r1 + r3 + s = s2 - s4 + zout(1, j, nout2) = r - s + zout(1, j, nout4) = r + s + r = s1 + s3 + s = s2 + s4 + zout(2, j, nout1) = r + s + zout(2, j, nout3) = r - s + r = s1 - s3 + s = r2 + r4 + zout(2, j, nout2) = r + s + zout(2, j, nout4) = r - s + ENDDO; ENDDO + ELSE + itt = ias*before + itrig = itt + 1 + cr2 = trig(1, itrig) + ci2 = trig(2, itrig) + itrig = itrig + itt + cr3 = trig(1, itrig) + ci3 = trig(2, itrig) + itrig = itrig + itt + cr4 = trig(1, itrig) + ci4 = trig(2, itrig) + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r = zin(1, j, nin2) + s = zin(2, j, nin2) + r2 = r*cr2 - s*ci2 + s2 = r*ci2 + s*cr2 + r = zin(1, j, nin3) + s = zin(2, j, nin3) + r3 = r*cr3 - s*ci3 + s3 = r*ci3 + s*cr3 + r = zin(1, j, nin4) + s = zin(2, j, nin4) + r4 = r*cr4 - s*ci4 + s4 = r*ci4 + s*cr4 + r = r1 + r3 + s = r2 + r4 + zout(1, j, nout1) = r + s + zout(1, j, nout3) = r - s + r = r1 - r3 + s = s2 - s4 + zout(1, j, nout2) = r - s + zout(1, j, nout4) = r + s + r = s1 + s3 + s = s2 + s4 + zout(2, j, nout1) = r + s + zout(2, j, nout3) = r - s + r = s1 - s3 + s = r2 - r4 + zout(2, j, nout2) = r + s + zout(2, j, nout4) = r - s + ENDDO; ENDDO + ENDIF +4000 CONTINUE + ELSE + ia = 1 + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r2 = zin(1, j, nin2) + s2 = zin(2, j, nin2) + r3 = zin(1, j, nin3) + s3 = zin(2, j, nin3) + r4 = zin(1, j, nin4) + s4 = zin(2, j, nin4) + r = r1 + r3 + s = r2 + r4 + zout(1, j, nout1) = r + s + zout(1, j, nout3) = r - s + r = r1 - r3 + s = s2 - s4 + zout(1, j, nout2) = r + s + zout(1, j, nout4) = r - s + r = s1 + s3 + s = s2 + s4 + zout(2, j, nout1) = r + s + zout(2, j, nout3) = r - s + r = s1 - s3 + s = r2 - r4 + zout(2, j, nout2) = r - s + zout(2, j, nout4) = r + s + ENDDO; ENDDO + DO 4100, ia = 2, after + ias = ia - 1 + IF (2*ias .EQ. after) THEN + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r = zin(1, j, nin2) + s = zin(2, j, nin2) + r2 = (r + s)*rt2i + s2 = (s - r)*rt2i + r3 = zin(2, j, nin3) + s3 = zin(1, j, nin3) + r = zin(1, j, nin4) + s = zin(2, j, nin4) + r4 = (s - r)*rt2i + s4 = (r + s)*rt2i + r = r1 + r3 + s = r2 + r4 + zout(1, j, nout1) = r + s + zout(1, j, nout3) = r - s + r = r1 - r3 + s = s2 + s4 + zout(1, j, nout2) = r + s + zout(1, j, nout4) = r - s + r = s1 - s3 + s = s2 - s4 + zout(2, j, nout1) = r + s + zout(2, j, nout3) = r - s + r = s1 + s3 + s = r2 - r4 + zout(2, j, nout2) = r - s + zout(2, j, nout4) = r + s + ENDDO; ENDDO + ELSE + itt = ias*before + itrig = itt + 1 + cr2 = trig(1, itrig) + ci2 = trig(2, itrig) + itrig = itrig + itt + cr3 = trig(1, itrig) + ci3 = trig(2, itrig) + itrig = itrig + itt + cr4 = trig(1, itrig) + ci4 = trig(2, itrig) + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r = zin(1, j, nin2) + s = zin(2, j, nin2) + r2 = r*cr2 - s*ci2 + s2 = r*ci2 + s*cr2 + r = zin(1, j, nin3) + s = zin(2, j, nin3) + r3 = r*cr3 - s*ci3 + s3 = r*ci3 + s*cr3 + r = zin(1, j, nin4) + s = zin(2, j, nin4) + r4 = r*cr4 - s*ci4 + s4 = r*ci4 + s*cr4 + r = r1 + r3 + s = r2 + r4 + zout(1, j, nout1) = r + s + zout(1, j, nout3) = r - s + r = r1 - r3 + s = s2 - s4 + zout(1, j, nout2) = r + s + zout(1, j, nout4) = r - s + r = s1 + s3 + s = s2 + s4 + zout(2, j, nout1) = r + s + zout(2, j, nout3) = r - s + r = s1 - s3 + s = r2 - r4 + zout(2, j, nout2) = r - s + zout(2, j, nout4) = r + s + ENDDO; ENDDO + ENDIF +4100 CONTINUE + ENDIF + ELSE IF (now .EQ. 8) THEN + IF (isign .EQ. -1) THEN + ia = 1 + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nin6 = nin5 + atb + nin7 = nin6 + atb + nin8 = nin7 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after + nout6 = nout5 + after + nout7 = nout6 + after + nout8 = nout7 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r2 = zin(1, j, nin2) + s2 = zin(2, j, nin2) + r3 = zin(1, j, nin3) + s3 = zin(2, j, nin3) + r4 = zin(1, j, nin4) + s4 = zin(2, j, nin4) + r5 = zin(1, j, nin5) + s5 = zin(2, j, nin5) + r6 = zin(1, j, nin6) + s6 = zin(2, j, nin6) + r7 = zin(1, j, nin7) + s7 = zin(2, j, nin7) + r8 = zin(1, j, nin8) + s8 = zin(2, j, nin8) + r = r1 + r5 + s = r3 + r7 + ap = r + s + am = r - s + r = r2 + r6 + s = r4 + r8 + bp = r + s + bm = r - s + r = s1 + s5 + s = s3 + s7 + cp = r + s + cm = r - s + r = s2 + s6 + s = s4 + s8 + dpp = r + s + dm = r - s + zout(1, j, nout1) = ap + bp + zout(2, j, nout1) = cp + dpp + zout(1, j, nout5) = ap - bp + zout(2, j, nout5) = cp - dpp + zout(1, j, nout3) = am + dm + zout(2, j, nout3) = cm - bm + zout(1, j, nout7) = am - dm + zout(2, j, nout7) = cm + bm + r = r1 - r5 + s = s3 - s7 + ap = r + s + am = r - s + r = s1 - s5 + s = r3 - r7 + bp = r + s + bm = r - s + r = s4 - s8 + s = r2 - r6 + cp = r + s + cm = r - s + r = s2 - s6 + s = r4 - r8 + dpp = r + s + dm = r - s + r = (cp + dm)*rt2i + s = (dm - cp)*rt2i + cp = (cm + dpp)*rt2i + dpp = (cm - dpp)*rt2i + zout(1, j, nout2) = ap + r + zout(2, j, nout2) = bm + s + zout(1, j, nout6) = ap - r + zout(2, j, nout6) = bm - s + zout(1, j, nout4) = am + cp + zout(2, j, nout4) = bp + dpp + zout(1, j, nout8) = am - cp + zout(2, j, nout8) = bp - dpp + ENDDO; ENDDO + DO 8000, ia = 2, after + ias = ia - 1 + itt = ias*before + itrig = itt + 1 + cr2 = trig(1, itrig) + ci2 = trig(2, itrig) + itrig = itrig + itt + cr3 = trig(1, itrig) + ci3 = trig(2, itrig) + itrig = itrig + itt + cr4 = trig(1, itrig) + ci4 = trig(2, itrig) + itrig = itrig + itt + cr5 = trig(1, itrig) + ci5 = trig(2, itrig) + itrig = itrig + itt + cr6 = trig(1, itrig) + ci6 = trig(2, itrig) + itrig = itrig + itt + cr7 = trig(1, itrig) + ci7 = trig(2, itrig) + itrig = itrig + itt + cr8 = trig(1, itrig) + ci8 = trig(2, itrig) + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nin6 = nin5 + atb + nin7 = nin6 + atb + nin8 = nin7 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after + nout6 = nout5 + after + nout7 = nout6 + after + nout8 = nout7 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r = zin(1, j, nin2) + s = zin(2, j, nin2) + r2 = r*cr2 - s*ci2 + s2 = r*ci2 + s*cr2 + r = zin(1, j, nin3) + s = zin(2, j, nin3) + r3 = r*cr3 - s*ci3 + s3 = r*ci3 + s*cr3 + r = zin(1, j, nin4) + s = zin(2, j, nin4) + r4 = r*cr4 - s*ci4 + s4 = r*ci4 + s*cr4 + r = zin(1, j, nin5) + s = zin(2, j, nin5) + r5 = r*cr5 - s*ci5 + s5 = r*ci5 + s*cr5 + r = zin(1, j, nin6) + s = zin(2, j, nin6) + r6 = r*cr6 - s*ci6 + s6 = r*ci6 + s*cr6 + r = zin(1, j, nin7) + s = zin(2, j, nin7) + r7 = r*cr7 - s*ci7 + s7 = r*ci7 + s*cr7 + r = zin(1, j, nin8) + s = zin(2, j, nin8) + r8 = r*cr8 - s*ci8 + s8 = r*ci8 + s*cr8 + r = r1 + r5 + s = r3 + r7 + ap = r + s + am = r - s + r = r2 + r6 + s = r4 + r8 + bp = r + s + bm = r - s + r = s1 + s5 + s = s3 + s7 + cp = r + s + cm = r - s + r = s2 + s6 + s = s4 + s8 + dpp = r + s + dm = r - s + zout(1, j, nout1) = ap + bp + zout(2, j, nout1) = cp + dpp + zout(1, j, nout5) = ap - bp + zout(2, j, nout5) = cp - dpp + zout(1, j, nout3) = am + dm + zout(2, j, nout3) = cm - bm + zout(1, j, nout7) = am - dm + zout(2, j, nout7) = cm + bm + r = r1 - r5 + s = s3 - s7 + ap = r + s + am = r - s + r = s1 - s5 + s = r3 - r7 + bp = r + s + bm = r - s + r = s4 - s8 + s = r2 - r6 + cp = r + s + cm = r - s + r = s2 - s6 + s = r4 - r8 + dpp = r + s + dm = r - s + r = (cp + dm)*rt2i + s = (dm - cp)*rt2i + cp = (cm + dpp)*rt2i + dpp = (cm - dpp)*rt2i + zout(1, j, nout2) = ap + r + zout(2, j, nout2) = bm + s + zout(1, j, nout6) = ap - r + zout(2, j, nout6) = bm - s + zout(1, j, nout4) = am + cp + zout(2, j, nout4) = bp + dpp + zout(1, j, nout8) = am - cp + zout(2, j, nout8) = bp - dpp + ENDDO; ENDDO +8000 CONTINUE - ELSE - ia=1 - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nin3=nin2+atb - nin4=nin3+atb - nin5=nin4+atb - nin6=nin5+atb - nin7=nin6+atb - nin8=nin7+atb - nout1=nout1+atn - nout2=nout1+after - nout3=nout2+after - nout4=nout3+after - nout5=nout4+after - nout6=nout5+after - nout7=nout6+after - nout8=nout7+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r2=zin(1,j,nin2) - s2=zin(2,j,nin2) - r3=zin(1,j,nin3) - s3=zin(2,j,nin3) - r4=zin(1,j,nin4) - s4=zin(2,j,nin4) - r5=zin(1,j,nin5) - s5=zin(2,j,nin5) - r6=zin(1,j,nin6) - s6=zin(2,j,nin6) - r7=zin(1,j,nin7) - s7=zin(2,j,nin7) - r8=zin(1,j,nin8) - s8=zin(2,j,nin8) - r=r1 + r5 - s=r3 + r7 - ap=r + s - am=r - s - r=r2 + r6 - s=r4 + r8 - bp=r + s - bm=r - s - r=s1 + s5 - s=s3 + s7 - cp=r + s - cm=r - s - r=s2 + s6 - s=s4 + s8 - dpp=r + s - dm=r - s - zout(1,j,nout1) = ap + bp - zout(2,j,nout1) = cp + dpp - zout(1,j,nout5) = ap - bp - zout(2,j,nout5) = cp - dpp - zout(1,j,nout3) = am - dm - zout(2,j,nout3) = cm + bm - zout(1,j,nout7) = am + dm - zout(2,j,nout7) = cm - bm - r= r1 - r5 - s=-s3 + s7 - ap=r + s - am=r - s - r=s1 - s5 - s=r7 - r3 - bp=r + s - bm=r - s - r=-s4 + s8 - s= r2 - r6 - cp=r + s - cm=r - s - r=-s2 + s6 - s= r4 - r8 - dpp=r + s - dm=r - s - r = ( cp + dm)*rt2i - s = ( cp - dm)*rt2i - cp= ( cm + dpp)*rt2i - dpp= ( dpp - cm)*rt2i - zout(1,j,nout2) = ap + r - zout(2,j,nout2) = bm + s - zout(1,j,nout6) = ap - r - zout(2,j,nout6) = bm - s - zout(1,j,nout4) = am + cp - zout(2,j,nout4) = bp + dpp - zout(1,j,nout8) = am - cp - zout(2,j,nout8) = bp - dpp - ENDDO ; ENDDO + ELSE + ia = 1 + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nin6 = nin5 + atb + nin7 = nin6 + atb + nin8 = nin7 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after + nout6 = nout5 + after + nout7 = nout6 + after + nout8 = nout7 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r2 = zin(1, j, nin2) + s2 = zin(2, j, nin2) + r3 = zin(1, j, nin3) + s3 = zin(2, j, nin3) + r4 = zin(1, j, nin4) + s4 = zin(2, j, nin4) + r5 = zin(1, j, nin5) + s5 = zin(2, j, nin5) + r6 = zin(1, j, nin6) + s6 = zin(2, j, nin6) + r7 = zin(1, j, nin7) + s7 = zin(2, j, nin7) + r8 = zin(1, j, nin8) + s8 = zin(2, j, nin8) + r = r1 + r5 + s = r3 + r7 + ap = r + s + am = r - s + r = r2 + r6 + s = r4 + r8 + bp = r + s + bm = r - s + r = s1 + s5 + s = s3 + s7 + cp = r + s + cm = r - s + r = s2 + s6 + s = s4 + s8 + dpp = r + s + dm = r - s + zout(1, j, nout1) = ap + bp + zout(2, j, nout1) = cp + dpp + zout(1, j, nout5) = ap - bp + zout(2, j, nout5) = cp - dpp + zout(1, j, nout3) = am - dm + zout(2, j, nout3) = cm + bm + zout(1, j, nout7) = am + dm + zout(2, j, nout7) = cm - bm + r = r1 - r5 + s = -s3 + s7 + ap = r + s + am = r - s + r = s1 - s5 + s = r7 - r3 + bp = r + s + bm = r - s + r = -s4 + s8 + s = r2 - r6 + cp = r + s + cm = r - s + r = -s2 + s6 + s = r4 - r8 + dpp = r + s + dm = r - s + r = (cp + dm)*rt2i + s = (cp - dm)*rt2i + cp = (cm + dpp)*rt2i + dpp = (dpp - cm)*rt2i + zout(1, j, nout2) = ap + r + zout(2, j, nout2) = bm + s + zout(1, j, nout6) = ap - r + zout(2, j, nout6) = bm - s + zout(1, j, nout4) = am + cp + zout(2, j, nout4) = bp + dpp + zout(1, j, nout8) = am - cp + zout(2, j, nout8) = bp - dpp + ENDDO; ENDDO - DO 8001,ia=2,after - ias=ia-1 - itt=ias*before - itrig=itt+1 - cr2=trig(1,itrig) - ci2=trig(2,itrig) - itrig=itrig+itt - cr3=trig(1,itrig) - ci3=trig(2,itrig) - itrig=itrig+itt - cr4=trig(1,itrig) - ci4=trig(2,itrig) - itrig=itrig+itt - cr5=trig(1,itrig) - ci5=trig(2,itrig) - itrig=itrig+itt - cr6=trig(1,itrig) - ci6=trig(2,itrig) - itrig=itrig+itt - cr7=trig(1,itrig) - ci7=trig(2,itrig) - itrig=itrig+itt - cr8=trig(1,itrig) - ci8=trig(2,itrig) - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nin3=nin2+atb - nin4=nin3+atb - nin5=nin4+atb - nin6=nin5+atb - nin7=nin6+atb - nin8=nin7+atb - nout1=nout1+atn - nout2=nout1+after - nout3=nout2+after - nout4=nout3+after - nout5=nout4+after - nout6=nout5+after - nout7=nout6+after - nout8=nout7+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r=zin(1,j,nin2) - s=zin(2,j,nin2) - r2=r*cr2 - s*ci2 - s2=r*ci2 + s*cr2 - r=zin(1,j,nin3) - s=zin(2,j,nin3) - r3=r*cr3 - s*ci3 - s3=r*ci3 + s*cr3 - r=zin(1,j,nin4) - s=zin(2,j,nin4) - r4=r*cr4 - s*ci4 - s4=r*ci4 + s*cr4 - r=zin(1,j,nin5) - s=zin(2,j,nin5) - r5=r*cr5 - s*ci5 - s5=r*ci5 + s*cr5 - r=zin(1,j,nin6) - s=zin(2,j,nin6) - r6=r*cr6 - s*ci6 - s6=r*ci6 + s*cr6 - r=zin(1,j,nin7) - s=zin(2,j,nin7) - r7=r*cr7 - s*ci7 - s7=r*ci7 + s*cr7 - r=zin(1,j,nin8) - s=zin(2,j,nin8) - r8=r*cr8 - s*ci8 - s8=r*ci8 + s*cr8 - r=r1 + r5 - s=r3 + r7 - ap=r + s - am=r - s - r=r2 + r6 - s=r4 + r8 - bp=r + s - bm=r - s - r=s1 + s5 - s=s3 + s7 - cp=r + s - cm=r - s - r=s2 + s6 - s=s4 + s8 - dpp=r + s - dm=r - s - zout(1,j,nout1) = ap + bp - zout(2,j,nout1) = cp + dpp - zout(1,j,nout5) = ap - bp - zout(2,j,nout5) = cp - dpp - zout(1,j,nout3) = am - dm - zout(2,j,nout3) = cm + bm - zout(1,j,nout7) = am + dm - zout(2,j,nout7) = cm - bm - r= r1 - r5 - s=-s3 + s7 - ap=r + s - am=r - s - r=s1 - s5 - s=r7 - r3 - bp=r + s - bm=r - s - r=-s4 + s8 - s= r2 - r6 - cp=r + s - cm=r - s - r=-s2 + s6 - s= r4 - r8 - dpp=r + s - dm=r - s - r = ( cp + dm)*rt2i - s = ( cp - dm)*rt2i - cp= ( cm + dpp)*rt2i - dpp= ( dpp - cm)*rt2i - zout(1,j,nout2) = ap + r - zout(2,j,nout2) = bm + s - zout(1,j,nout6) = ap - r - zout(2,j,nout6) = bm - s - zout(1,j,nout4) = am + cp - zout(2,j,nout4) = bp + dpp - zout(1,j,nout8) = am - cp - zout(2,j,nout8) = bp - dpp - ENDDO ; ENDDO -8001 CONTINUE + DO 8001, ia = 2, after + ias = ia - 1 + itt = ias*before + itrig = itt + 1 + cr2 = trig(1, itrig) + ci2 = trig(2, itrig) + itrig = itrig + itt + cr3 = trig(1, itrig) + ci3 = trig(2, itrig) + itrig = itrig + itt + cr4 = trig(1, itrig) + ci4 = trig(2, itrig) + itrig = itrig + itt + cr5 = trig(1, itrig) + ci5 = trig(2, itrig) + itrig = itrig + itt + cr6 = trig(1, itrig) + ci6 = trig(2, itrig) + itrig = itrig + itt + cr7 = trig(1, itrig) + ci7 = trig(2, itrig) + itrig = itrig + itt + cr8 = trig(1, itrig) + ci8 = trig(2, itrig) + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nin6 = nin5 + atb + nin7 = nin6 + atb + nin8 = nin7 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after + nout6 = nout5 + after + nout7 = nout6 + after + nout8 = nout7 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r = zin(1, j, nin2) + s = zin(2, j, nin2) + r2 = r*cr2 - s*ci2 + s2 = r*ci2 + s*cr2 + r = zin(1, j, nin3) + s = zin(2, j, nin3) + r3 = r*cr3 - s*ci3 + s3 = r*ci3 + s*cr3 + r = zin(1, j, nin4) + s = zin(2, j, nin4) + r4 = r*cr4 - s*ci4 + s4 = r*ci4 + s*cr4 + r = zin(1, j, nin5) + s = zin(2, j, nin5) + r5 = r*cr5 - s*ci5 + s5 = r*ci5 + s*cr5 + r = zin(1, j, nin6) + s = zin(2, j, nin6) + r6 = r*cr6 - s*ci6 + s6 = r*ci6 + s*cr6 + r = zin(1, j, nin7) + s = zin(2, j, nin7) + r7 = r*cr7 - s*ci7 + s7 = r*ci7 + s*cr7 + r = zin(1, j, nin8) + s = zin(2, j, nin8) + r8 = r*cr8 - s*ci8 + s8 = r*ci8 + s*cr8 + r = r1 + r5 + s = r3 + r7 + ap = r + s + am = r - s + r = r2 + r6 + s = r4 + r8 + bp = r + s + bm = r - s + r = s1 + s5 + s = s3 + s7 + cp = r + s + cm = r - s + r = s2 + s6 + s = s4 + s8 + dpp = r + s + dm = r - s + zout(1, j, nout1) = ap + bp + zout(2, j, nout1) = cp + dpp + zout(1, j, nout5) = ap - bp + zout(2, j, nout5) = cp - dpp + zout(1, j, nout3) = am - dm + zout(2, j, nout3) = cm + bm + zout(1, j, nout7) = am + dm + zout(2, j, nout7) = cm - bm + r = r1 - r5 + s = -s3 + s7 + ap = r + s + am = r - s + r = s1 - s5 + s = r7 - r3 + bp = r + s + bm = r - s + r = -s4 + s8 + s = r2 - r6 + cp = r + s + cm = r - s + r = -s2 + s6 + s = r4 - r8 + dpp = r + s + dm = r - s + r = (cp + dm)*rt2i + s = (cp - dm)*rt2i + cp = (cm + dpp)*rt2i + dpp = (dpp - cm)*rt2i + zout(1, j, nout2) = ap + r + zout(2, j, nout2) = bm + s + zout(1, j, nout6) = ap - r + zout(2, j, nout6) = bm - s + zout(1, j, nout4) = am + cp + zout(2, j, nout4) = bp + dpp + zout(1, j, nout8) = am - cp + zout(2, j, nout8) = bp - dpp + ENDDO; ENDDO +8001 CONTINUE - ENDIF - ELSE IF (now.EQ.3) THEN + ENDIF + ELSE IF (now .EQ. 3) THEN ! .5_dp*sqrt(3._dp) - bb=isign*0.8660254037844387_dp - ia=1 - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nin3=nin2+atb - nout1=nout1+atn - nout2=nout1+after - nout3=nout2+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r2=zin(1,j,nin2) - s2=zin(2,j,nin2) - r3=zin(1,j,nin3) - s3=zin(2,j,nin3) - r=r2 + r3 - s=s2 + s3 - zout(1,j,nout1) = r + r1 - zout(2,j,nout1) = s + s1 - r1=r1 - .5_dp*r - s1=s1 - .5_dp*s - r2=bb*(r2-r3) - s2=bb*(s2-s3) - zout(1,j,nout2) = r1 - s2 - zout(2,j,nout2) = s1 + r2 - zout(1,j,nout3) = r1 + s2 - zout(2,j,nout3) = s1 - r2 - ENDDO ; ENDDO - DO 3000,ia=2,after - ias=ia-1 - IF (4*ias.EQ.3*after) THEN - IF (isign.EQ.1) THEN - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nin3=nin2+atb - nout1=nout1+atn - nout2=nout1+after - nout3=nout2+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r2=zin(2,j,nin2) - s2=zin(1,j,nin2) - r3=zin(1,j,nin3) - s3=zin(2,j,nin3) - r=r3 + r2 - s=s2 - s3 - zout(1,j,nout1) = r1 - r - zout(2,j,nout1) = s + s1 - r1=r1 + .5_dp*r - s1=s1 - .5_dp*s - r2=bb*(r2-r3) - s2=bb*(s2+s3) - zout(1,j,nout2) = r1 - s2 - zout(2,j,nout2) = s1 - r2 - zout(1,j,nout3) = r1 + s2 - zout(2,j,nout3) = s1 + r2 - ENDDO ; ENDDO - ELSE - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nin3=nin2+atb - nout1=nout1+atn - nout2=nout1+after - nout3=nout2+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r2=zin(2,j,nin2) - s2=zin(1,j,nin2) - r3=zin(1,j,nin3) - s3=zin(2,j,nin3) - r=r2 - r3 - s=s2 + s3 - zout(1,j,nout1) = r + r1 - zout(2,j,nout1) = s1 - s - r1=r1 - .5_dp*r - s1=s1 + .5_dp*s - r2=bb*(r2+r3) - s2=bb*(s2-s3) - zout(1,j,nout2) = r1 + s2 - zout(2,j,nout2) = s1 + r2 - zout(1,j,nout3) = r1 - s2 - zout(2,j,nout3) = s1 - r2 - ENDDO ; ENDDO - ENDIF - ELSE IF (8*ias.EQ.3*after) THEN - IF (isign.EQ.1) THEN - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nin3=nin2+atb - nout1=nout1+atn - nout2=nout1+after - nout3=nout2+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r=zin(1,j,nin2) - s=zin(2,j,nin2) - r2=(r - s)*rt2i - s2=(r + s)*rt2i - r3=zin(2,j,nin3) - s3=zin(1,j,nin3) - r=r2 - r3 - s=s2 + s3 - zout(1,j,nout1) = r + r1 - zout(2,j,nout1) = s + s1 - r1=r1 - .5_dp*r - s1=s1 - .5_dp*s - r2=bb*(r2+r3) - s2=bb*(s2-s3) - zout(1,j,nout2) = r1 - s2 - zout(2,j,nout2) = s1 + r2 - zout(1,j,nout3) = r1 + s2 - zout(2,j,nout3) = s1 - r2 - ENDDO ; ENDDO - ELSE - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nin3=nin2+atb - nout1=nout1+atn - nout2=nout1+after - nout3=nout2+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r=zin(1,j,nin2) - s=zin(2,j,nin2) - r2=(r + s)*rt2i - s2=(s - r)*rt2i - r3=zin(2,j,nin3) - s3=zin(1,j,nin3) - r=r2 + r3 - s=s2 - s3 - zout(1,j,nout1) = r + r1 - zout(2,j,nout1) = s + s1 - r1=r1 - .5_dp*r - s1=s1 - .5_dp*s - r2=bb*(r2-r3) - s2=bb*(s2+s3) - zout(1,j,nout2) = r1 - s2 - zout(2,j,nout2) = s1 + r2 - zout(1,j,nout3) = r1 + s2 - zout(2,j,nout3) = s1 - r2 - ENDDO ; ENDDO - ENDIF - ELSE - itt=ias*before - itrig=itt+1 - cr2=trig(1,itrig) - ci2=trig(2,itrig) - itrig=itrig+itt - cr3=trig(1,itrig) - ci3=trig(2,itrig) - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nin3=nin2+atb - nout1=nout1+atn - nout2=nout1+after - nout3=nout2+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r=zin(1,j,nin2) - s=zin(2,j,nin2) - r2=r*cr2 - s*ci2 - s2=r*ci2 + s*cr2 - r=zin(1,j,nin3) - s=zin(2,j,nin3) - r3=r*cr3 - s*ci3 - s3=r*ci3 + s*cr3 - r=r2 + r3 - s=s2 + s3 - zout(1,j,nout1) = r + r1 - zout(2,j,nout1) = s + s1 - r1=r1 - .5_dp*r - s1=s1 - .5_dp*s - r2=bb*(r2-r3) - s2=bb*(s2-s3) - zout(1,j,nout2) = r1 - s2 - zout(2,j,nout2) = s1 + r2 - zout(1,j,nout3) = r1 + s2 - zout(2,j,nout3) = s1 - r2 - ENDDO ; ENDDO - ENDIF -3000 CONTINUE - ELSE IF (now.EQ.5) THEN + bb = isign*0.8660254037844387_dp + ia = 1 + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r2 = zin(1, j, nin2) + s2 = zin(2, j, nin2) + r3 = zin(1, j, nin3) + s3 = zin(2, j, nin3) + r = r2 + r3 + s = s2 + s3 + zout(1, j, nout1) = r + r1 + zout(2, j, nout1) = s + s1 + r1 = r1 - .5_dp*r + s1 = s1 - .5_dp*s + r2 = bb*(r2 - r3) + s2 = bb*(s2 - s3) + zout(1, j, nout2) = r1 - s2 + zout(2, j, nout2) = s1 + r2 + zout(1, j, nout3) = r1 + s2 + zout(2, j, nout3) = s1 - r2 + ENDDO; ENDDO + DO 3000, ia = 2, after + ias = ia - 1 + IF (4*ias .EQ. 3*after) THEN + IF (isign .EQ. 1) THEN + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r2 = zin(2, j, nin2) + s2 = zin(1, j, nin2) + r3 = zin(1, j, nin3) + s3 = zin(2, j, nin3) + r = r3 + r2 + s = s2 - s3 + zout(1, j, nout1) = r1 - r + zout(2, j, nout1) = s + s1 + r1 = r1 + .5_dp*r + s1 = s1 - .5_dp*s + r2 = bb*(r2 - r3) + s2 = bb*(s2 + s3) + zout(1, j, nout2) = r1 - s2 + zout(2, j, nout2) = s1 - r2 + zout(1, j, nout3) = r1 + s2 + zout(2, j, nout3) = s1 + r2 + ENDDO; ENDDO + ELSE + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r2 = zin(2, j, nin2) + s2 = zin(1, j, nin2) + r3 = zin(1, j, nin3) + s3 = zin(2, j, nin3) + r = r2 - r3 + s = s2 + s3 + zout(1, j, nout1) = r + r1 + zout(2, j, nout1) = s1 - s + r1 = r1 - .5_dp*r + s1 = s1 + .5_dp*s + r2 = bb*(r2 + r3) + s2 = bb*(s2 - s3) + zout(1, j, nout2) = r1 + s2 + zout(2, j, nout2) = s1 + r2 + zout(1, j, nout3) = r1 - s2 + zout(2, j, nout3) = s1 - r2 + ENDDO; ENDDO + ENDIF + ELSE IF (8*ias .EQ. 3*after) THEN + IF (isign .EQ. 1) THEN + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r = zin(1, j, nin2) + s = zin(2, j, nin2) + r2 = (r - s)*rt2i + s2 = (r + s)*rt2i + r3 = zin(2, j, nin3) + s3 = zin(1, j, nin3) + r = r2 - r3 + s = s2 + s3 + zout(1, j, nout1) = r + r1 + zout(2, j, nout1) = s + s1 + r1 = r1 - .5_dp*r + s1 = s1 - .5_dp*s + r2 = bb*(r2 + r3) + s2 = bb*(s2 - s3) + zout(1, j, nout2) = r1 - s2 + zout(2, j, nout2) = s1 + r2 + zout(1, j, nout3) = r1 + s2 + zout(2, j, nout3) = s1 - r2 + ENDDO; ENDDO + ELSE + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r = zin(1, j, nin2) + s = zin(2, j, nin2) + r2 = (r + s)*rt2i + s2 = (s - r)*rt2i + r3 = zin(2, j, nin3) + s3 = zin(1, j, nin3) + r = r2 + r3 + s = s2 - s3 + zout(1, j, nout1) = r + r1 + zout(2, j, nout1) = s + s1 + r1 = r1 - .5_dp*r + s1 = s1 - .5_dp*s + r2 = bb*(r2 - r3) + s2 = bb*(s2 + s3) + zout(1, j, nout2) = r1 - s2 + zout(2, j, nout2) = s1 + r2 + zout(1, j, nout3) = r1 + s2 + zout(2, j, nout3) = s1 - r2 + ENDDO; ENDDO + ENDIF + ELSE + itt = ias*before + itrig = itt + 1 + cr2 = trig(1, itrig) + ci2 = trig(2, itrig) + itrig = itrig + itt + cr3 = trig(1, itrig) + ci3 = trig(2, itrig) + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r = zin(1, j, nin2) + s = zin(2, j, nin2) + r2 = r*cr2 - s*ci2 + s2 = r*ci2 + s*cr2 + r = zin(1, j, nin3) + s = zin(2, j, nin3) + r3 = r*cr3 - s*ci3 + s3 = r*ci3 + s*cr3 + r = r2 + r3 + s = s2 + s3 + zout(1, j, nout1) = r + r1 + zout(2, j, nout1) = s + s1 + r1 = r1 - .5_dp*r + s1 = s1 - .5_dp*s + r2 = bb*(r2 - r3) + s2 = bb*(s2 - s3) + zout(1, j, nout2) = r1 - s2 + zout(2, j, nout2) = s1 + r2 + zout(1, j, nout3) = r1 + s2 + zout(2, j, nout3) = s1 - r2 + ENDDO; ENDDO + ENDIF +3000 CONTINUE + ELSE IF (now .EQ. 5) THEN ! cos(2._dp*pi/5._dp) - cos2=0.3090169943749474_dp + cos2 = 0.3090169943749474_dp ! cos(4._dp*pi/5._dp) - cos4=-0.8090169943749474_dp + cos4 = -0.8090169943749474_dp ! sin(2._dp*pi/5._dp) - sin2=isign*0.9510565162951536_dp + sin2 = isign*0.9510565162951536_dp ! sin(4._dp*pi/5._dp) - sin4=isign*0.5877852522924731_dp - ia=1 - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nin3=nin2+atb - nin4=nin3+atb - nin5=nin4+atb - nout1=nout1+atn - nout2=nout1+after - nout3=nout2+after - nout4=nout3+after - nout5=nout4+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r2=zin(1,j,nin2) - s2=zin(2,j,nin2) - r3=zin(1,j,nin3) - s3=zin(2,j,nin3) - r4=zin(1,j,nin4) - s4=zin(2,j,nin4) - r5=zin(1,j,nin5) - s5=zin(2,j,nin5) - r25 = r2 + r5 - r34 = r3 + r4 - s25 = s2 - s5 - s34 = s3 - s4 - zout(1,j,nout1) = r1 + r25 + r34 - r = r1 + cos2*r25 + cos4*r34 - s = sin2*s25 + sin4*s34 - zout(1,j,nout2) = r - s - zout(1,j,nout5) = r + s - r = r1 + cos4*r25 + cos2*r34 - s = sin4*s25 - sin2*s34 - zout(1,j,nout3) = r - s - zout(1,j,nout4) = r + s - r25 = r2 - r5 - r34 = r3 - r4 - s25 = s2 + s5 - s34 = s3 + s4 - zout(2,j,nout1) = s1 + s25 + s34 - r = s1 + cos2*s25 + cos4*s34 - s = sin2*r25 + sin4*r34 - zout(2,j,nout2) = r + s - zout(2,j,nout5) = r - s - r = s1 + cos4*s25 + cos2*s34 - s = sin4*r25 - sin2*r34 - zout(2,j,nout3) = r + s - zout(2,j,nout4) = r - s - ENDDO ; ENDDO - DO 5000,ia=2,after - ias=ia-1 - IF (8*ias.EQ.5*after) THEN - IF (isign.EQ.1) THEN - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nin3=nin2+atb - nin4=nin3+atb - nin5=nin4+atb - nout1=nout1+atn - nout2=nout1+after - nout3=nout2+after - nout4=nout3+after - nout5=nout4+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r=zin(1,j,nin2) - s=zin(2,j,nin2) - r2=(r - s)*rt2i - s2=(r + s)*rt2i - r3=zin(2,j,nin3) - s3=zin(1,j,nin3) - r=zin(1,j,nin4) - s=zin(2,j,nin4) - r4=(r + s)*rt2i - s4=(r - s)*rt2i - r5=zin(1,j,nin5) - s5=zin(2,j,nin5) - r25 = r2 - r5 - r34 = r3 + r4 - s25 = s2 + s5 - s34 = s3 - s4 - zout(1,j,nout1) = r1 + r25 - r34 - r = r1 + cos2*r25 - cos4*r34 - s = sin2*s25 + sin4*s34 - zout(1,j,nout2) = r - s - zout(1,j,nout5) = r + s - r = r1 + cos4*r25 - cos2*r34 - s = sin4*s25 - sin2*s34 - zout(1,j,nout3) = r - s - zout(1,j,nout4) = r + s - r25 = r2 + r5 - r34 = r4 - r3 - s25 = s2 - s5 - s34 = s3 + s4 - zout(2,j,nout1) = s1 + s25 + s34 - r = s1 + cos2*s25 + cos4*s34 - s = sin2*r25 + sin4*r34 - zout(2,j,nout2) = r + s - zout(2,j,nout5) = r - s - r = s1 + cos4*s25 + cos2*s34 - s = sin4*r25 - sin2*r34 - zout(2,j,nout3) = r + s - zout(2,j,nout4) = r - s - ENDDO ; ENDDO - ELSE - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nin3=nin2+atb - nin4=nin3+atb - nin5=nin4+atb - nout1=nout1+atn - nout2=nout1+after - nout3=nout2+after - nout4=nout3+after - nout5=nout4+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r=zin(1,j,nin2) - s=zin(2,j,nin2) - r2=(r + s)*rt2i - s2=(s - r)*rt2i - r3=zin(2,j,nin3) - s3=zin(1,j,nin3) - r=zin(1,j,nin4) - s=zin(2,j,nin4) - r4=(s - r)*rt2i - s4=(r + s)*rt2i - r5=zin(1,j,nin5) - s5=zin(2,j,nin5) - r25 = r2 - r5 - r34 = r3 + r4 - s25 = s2 + s5 - s34 = s4 - s3 - zout(1,j,nout1) = r1 + r25 + r34 - r = r1 + cos2*r25 + cos4*r34 - s = sin2*s25 + sin4*s34 - zout(1,j,nout2) = r - s - zout(1,j,nout5) = r + s - r = r1 + cos4*r25 + cos2*r34 - s = sin4*s25 - sin2*s34 - zout(1,j,nout3) = r - s - zout(1,j,nout4) = r + s - r25 = r2 + r5 - r34 = r3 - r4 - s25 = s2 - s5 - s34 = s3 + s4 - zout(2,j,nout1) = s1 + s25 - s34 - r = s1 + cos2*s25 - cos4*s34 - s = sin2*r25 + sin4*r34 - zout(2,j,nout2) = r + s - zout(2,j,nout5) = r - s - r = s1 + cos4*s25 - cos2*s34 - s = sin4*r25 - sin2*r34 - zout(2,j,nout3) = r + s - zout(2,j,nout4) = r - s - ENDDO ; ENDDO - ENDIF - ELSE - ias=ia-1 - itt=ias*before - itrig=itt+1 - cr2=trig(1,itrig) - ci2=trig(2,itrig) - itrig=itrig+itt - cr3=trig(1,itrig) - ci3=trig(2,itrig) - itrig=itrig+itt - cr4=trig(1,itrig) - ci4=trig(2,itrig) - itrig=itrig+itt - cr5=trig(1,itrig) - ci5=trig(2,itrig) - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nin3=nin2+atb - nin4=nin3+atb - nin5=nin4+atb - nout1=nout1+atn - nout2=nout1+after - nout3=nout2+after - nout4=nout3+after - nout5=nout4+after - DO j=1,nfft - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - r=zin(1,j,nin2) - s=zin(2,j,nin2) - r2=r*cr2 - s*ci2 - s2=r*ci2 + s*cr2 - r=zin(1,j,nin3) - s=zin(2,j,nin3) - r3=r*cr3 - s*ci3 - s3=r*ci3 + s*cr3 - r=zin(1,j,nin4) - s=zin(2,j,nin4) - r4=r*cr4 - s*ci4 - s4=r*ci4 + s*cr4 - r=zin(1,j,nin5) - s=zin(2,j,nin5) - r5=r*cr5 - s*ci5 - s5=r*ci5 + s*cr5 - r25 = r2 + r5 - r34 = r3 + r4 - s25 = s2 - s5 - s34 = s3 - s4 - zout(1,j,nout1) = r1 + r25 + r34 - r = r1 + cos2*r25 + cos4*r34 - s = sin2*s25 + sin4*s34 - zout(1,j,nout2) = r - s - zout(1,j,nout5) = r + s - r = r1 + cos4*r25 + cos2*r34 - s = sin4*s25 - sin2*s34 - zout(1,j,nout3) = r - s - zout(1,j,nout4) = r + s - r25 = r2 - r5 - r34 = r3 - r4 - s25 = s2 + s5 - s34 = s3 + s4 - zout(2,j,nout1) = s1 + s25 + s34 - r = s1 + cos2*s25 + cos4*s34 - s = sin2*r25 + sin4*r34 - zout(2,j,nout2) = r + s - zout(2,j,nout5) = r - s - r = s1 + cos4*s25 + cos2*s34 - s = sin4*r25 - sin2*r34 - zout(2,j,nout3) = r + s - zout(2,j,nout4) = r - s - ENDDO ; ENDDO - ENDIF -5000 CONTINUE - ELSE IF (now.EQ.6) THEN + sin4 = isign*0.5877852522924731_dp + ia = 1 + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r2 = zin(1, j, nin2) + s2 = zin(2, j, nin2) + r3 = zin(1, j, nin3) + s3 = zin(2, j, nin3) + r4 = zin(1, j, nin4) + s4 = zin(2, j, nin4) + r5 = zin(1, j, nin5) + s5 = zin(2, j, nin5) + r25 = r2 + r5 + r34 = r3 + r4 + s25 = s2 - s5 + s34 = s3 - s4 + zout(1, j, nout1) = r1 + r25 + r34 + r = r1 + cos2*r25 + cos4*r34 + s = sin2*s25 + sin4*s34 + zout(1, j, nout2) = r - s + zout(1, j, nout5) = r + s + r = r1 + cos4*r25 + cos2*r34 + s = sin4*s25 - sin2*s34 + zout(1, j, nout3) = r - s + zout(1, j, nout4) = r + s + r25 = r2 - r5 + r34 = r3 - r4 + s25 = s2 + s5 + s34 = s3 + s4 + zout(2, j, nout1) = s1 + s25 + s34 + r = s1 + cos2*s25 + cos4*s34 + s = sin2*r25 + sin4*r34 + zout(2, j, nout2) = r + s + zout(2, j, nout5) = r - s + r = s1 + cos4*s25 + cos2*s34 + s = sin4*r25 - sin2*r34 + zout(2, j, nout3) = r + s + zout(2, j, nout4) = r - s + ENDDO; ENDDO + DO 5000, ia = 2, after + ias = ia - 1 + IF (8*ias .EQ. 5*after) THEN + IF (isign .EQ. 1) THEN + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r = zin(1, j, nin2) + s = zin(2, j, nin2) + r2 = (r - s)*rt2i + s2 = (r + s)*rt2i + r3 = zin(2, j, nin3) + s3 = zin(1, j, nin3) + r = zin(1, j, nin4) + s = zin(2, j, nin4) + r4 = (r + s)*rt2i + s4 = (r - s)*rt2i + r5 = zin(1, j, nin5) + s5 = zin(2, j, nin5) + r25 = r2 - r5 + r34 = r3 + r4 + s25 = s2 + s5 + s34 = s3 - s4 + zout(1, j, nout1) = r1 + r25 - r34 + r = r1 + cos2*r25 - cos4*r34 + s = sin2*s25 + sin4*s34 + zout(1, j, nout2) = r - s + zout(1, j, nout5) = r + s + r = r1 + cos4*r25 - cos2*r34 + s = sin4*s25 - sin2*s34 + zout(1, j, nout3) = r - s + zout(1, j, nout4) = r + s + r25 = r2 + r5 + r34 = r4 - r3 + s25 = s2 - s5 + s34 = s3 + s4 + zout(2, j, nout1) = s1 + s25 + s34 + r = s1 + cos2*s25 + cos4*s34 + s = sin2*r25 + sin4*r34 + zout(2, j, nout2) = r + s + zout(2, j, nout5) = r - s + r = s1 + cos4*s25 + cos2*s34 + s = sin4*r25 - sin2*r34 + zout(2, j, nout3) = r + s + zout(2, j, nout4) = r - s + ENDDO; ENDDO + ELSE + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r = zin(1, j, nin2) + s = zin(2, j, nin2) + r2 = (r + s)*rt2i + s2 = (s - r)*rt2i + r3 = zin(2, j, nin3) + s3 = zin(1, j, nin3) + r = zin(1, j, nin4) + s = zin(2, j, nin4) + r4 = (s - r)*rt2i + s4 = (r + s)*rt2i + r5 = zin(1, j, nin5) + s5 = zin(2, j, nin5) + r25 = r2 - r5 + r34 = r3 + r4 + s25 = s2 + s5 + s34 = s4 - s3 + zout(1, j, nout1) = r1 + r25 + r34 + r = r1 + cos2*r25 + cos4*r34 + s = sin2*s25 + sin4*s34 + zout(1, j, nout2) = r - s + zout(1, j, nout5) = r + s + r = r1 + cos4*r25 + cos2*r34 + s = sin4*s25 - sin2*s34 + zout(1, j, nout3) = r - s + zout(1, j, nout4) = r + s + r25 = r2 + r5 + r34 = r3 - r4 + s25 = s2 - s5 + s34 = s3 + s4 + zout(2, j, nout1) = s1 + s25 - s34 + r = s1 + cos2*s25 - cos4*s34 + s = sin2*r25 + sin4*r34 + zout(2, j, nout2) = r + s + zout(2, j, nout5) = r - s + r = s1 + cos4*s25 - cos2*s34 + s = sin4*r25 - sin2*r34 + zout(2, j, nout3) = r + s + zout(2, j, nout4) = r - s + ENDDO; ENDDO + ENDIF + ELSE + ias = ia - 1 + itt = ias*before + itrig = itt + 1 + cr2 = trig(1, itrig) + ci2 = trig(2, itrig) + itrig = itrig + itt + cr3 = trig(1, itrig) + ci3 = trig(2, itrig) + itrig = itrig + itt + cr4 = trig(1, itrig) + ci4 = trig(2, itrig) + itrig = itrig + itt + cr5 = trig(1, itrig) + ci5 = trig(2, itrig) + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after + DO j = 1, nfft + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + r = zin(1, j, nin2) + s = zin(2, j, nin2) + r2 = r*cr2 - s*ci2 + s2 = r*ci2 + s*cr2 + r = zin(1, j, nin3) + s = zin(2, j, nin3) + r3 = r*cr3 - s*ci3 + s3 = r*ci3 + s*cr3 + r = zin(1, j, nin4) + s = zin(2, j, nin4) + r4 = r*cr4 - s*ci4 + s4 = r*ci4 + s*cr4 + r = zin(1, j, nin5) + s = zin(2, j, nin5) + r5 = r*cr5 - s*ci5 + s5 = r*ci5 + s*cr5 + r25 = r2 + r5 + r34 = r3 + r4 + s25 = s2 - s5 + s34 = s3 - s4 + zout(1, j, nout1) = r1 + r25 + r34 + r = r1 + cos2*r25 + cos4*r34 + s = sin2*s25 + sin4*s34 + zout(1, j, nout2) = r - s + zout(1, j, nout5) = r + s + r = r1 + cos4*r25 + cos2*r34 + s = sin4*s25 - sin2*s34 + zout(1, j, nout3) = r - s + zout(1, j, nout4) = r + s + r25 = r2 - r5 + r34 = r3 - r4 + s25 = s2 + s5 + s34 = s3 + s4 + zout(2, j, nout1) = s1 + s25 + s34 + r = s1 + cos2*s25 + cos4*s34 + s = sin2*r25 + sin4*r34 + zout(2, j, nout2) = r + s + zout(2, j, nout5) = r - s + r = s1 + cos4*s25 + cos2*s34 + s = sin4*r25 - sin2*r34 + zout(2, j, nout3) = r + s + zout(2, j, nout4) = r - s + ENDDO; ENDDO + ENDIF +5000 CONTINUE + ELSE IF (now .EQ. 6) THEN ! .5_dp*sqrt(3._dp) - bb=isign*0.8660254037844387_dp + bb = isign*0.8660254037844387_dp - ia=1 - nin1=ia-after - nout1=ia-atn - DO ib=1,before - nin1=nin1+after - nin2=nin1+atb - nin3=nin2+atb - nin4=nin3+atb - nin5=nin4+atb - nin6=nin5+atb - nout1=nout1+atn - nout2=nout1+after - nout3=nout2+after - nout4=nout3+after - nout5=nout4+after - nout6=nout5+after - DO j=1,nfft - r2=zin(1,j,nin3) - s2=zin(2,j,nin3) - r3=zin(1,j,nin5) - s3=zin(2,j,nin5) - r=r2 + r3 - s=s2 + s3 - r1=zin(1,j,nin1) - s1=zin(2,j,nin1) - ur1 = r + r1 - ui1 = s + s1 - r1=r1 - .5_dp*r - s1=s1 - .5_dp*s - r=r2-r3 - s=s2-s3 - ur2 = r1 - s*bb - ui2 = s1 + r*bb - ur3 = r1 + s*bb - ui3 = s1 - r*bb + ia = 1 + nin1 = ia - after + nout1 = ia - atn + DO ib = 1, before + nin1 = nin1 + after + nin2 = nin1 + atb + nin3 = nin2 + atb + nin4 = nin3 + atb + nin5 = nin4 + atb + nin6 = nin5 + atb + nout1 = nout1 + atn + nout2 = nout1 + after + nout3 = nout2 + after + nout4 = nout3 + after + nout5 = nout4 + after + nout6 = nout5 + after + DO j = 1, nfft + r2 = zin(1, j, nin3) + s2 = zin(2, j, nin3) + r3 = zin(1, j, nin5) + s3 = zin(2, j, nin5) + r = r2 + r3 + s = s2 + s3 + r1 = zin(1, j, nin1) + s1 = zin(2, j, nin1) + ur1 = r + r1 + ui1 = s + s1 + r1 = r1 - .5_dp*r + s1 = s1 - .5_dp*s + r = r2 - r3 + s = s2 - s3 + ur2 = r1 - s*bb + ui2 = s1 + r*bb + ur3 = r1 + s*bb + ui3 = s1 - r*bb - r2=zin(1,j,nin6) - s2=zin(2,j,nin6) - r3=zin(1,j,nin2) - s3=zin(2,j,nin2) - r=r2 + r3 - s=s2 + s3 - r1=zin(1,j,nin4) - s1=zin(2,j,nin4) - vr1 = r + r1 - vi1 = s + s1 - r1=r1 - .5_dp*r - s1=s1 - .5_dp*s - r=r2-r3 - s=s2-s3 - vr2 = r1 - s*bb - vi2 = s1 + r*bb - vr3 = r1 + s*bb - vi3 = s1 - r*bb + r2 = zin(1, j, nin6) + s2 = zin(2, j, nin6) + r3 = zin(1, j, nin2) + s3 = zin(2, j, nin2) + r = r2 + r3 + s = s2 + s3 + r1 = zin(1, j, nin4) + s1 = zin(2, j, nin4) + vr1 = r + r1 + vi1 = s + s1 + r1 = r1 - .5_dp*r + s1 = s1 - .5_dp*s + r = r2 - r3 + s = s2 - s3 + vr2 = r1 - s*bb + vi2 = s1 + r*bb + vr3 = r1 + s*bb + vi3 = s1 - r*bb - zout(1,j,nout1)=ur1+vr1 - zout(2,j,nout1)=ui1+vi1 - zout(1,j,nout5)=ur2+vr2 - zout(2,j,nout5)=ui2+vi2 - zout(1,j,nout3)=ur3+vr3 - zout(2,j,nout3)=ui3+vi3 - zout(1,j,nout4)=ur1-vr1 - zout(2,j,nout4)=ui1-vi1 - zout(1,j,nout2)=ur2-vr2 - zout(2,j,nout2)=ui2-vi2 - zout(1,j,nout6)=ur3-vr3 - zout(2,j,nout6)=ui3-vi3 - ENDDO ; ENDDO - ELSE - CPABORT("error fftstp") - ENDIF + zout(1, j, nout1) = ur1 + vr1 + zout(2, j, nout1) = ui1 + vi1 + zout(1, j, nout5) = ur2 + vr2 + zout(2, j, nout5) = ui2 + vi2 + zout(1, j, nout3) = ur3 + vr3 + zout(2, j, nout3) = ui3 + vi3 + zout(1, j, nout4) = ur1 - vr1 + zout(2, j, nout4) = ui1 - vi1 + zout(1, j, nout2) = ur2 - vr2 + zout(2, j, nout2) = ui2 - vi2 + zout(1, j, nout6) = ur3 - vr3 + zout(2, j, nout6) = ui3 - vi3 + ENDDO; ENDDO + ELSE + CPABORT("error fftstp") + ENDIF - END SUBROUTINE fftstp + END SUBROUTINE fftstp -END MODULE ps_wavelet_fft3d + END MODULE ps_wavelet_fft3d diff --git a/src/pw/ps_wavelet_kernel.F b/src/pw/ps_wavelet_kernel.F index 1e5d507865..928bdf065b 100644 --- a/src/pw/ps_wavelet_kernel.F +++ b/src/pw/ps_wavelet_kernel.F @@ -9,7 +9,6 @@ ! ************************************************************************************************** MODULE ps_wavelet_kernel - USE kinds, ONLY: dp USE message_passing, ONLY: mp_alltoall USE ps_wavelet_base, ONLY: scramble_unpack @@ -22,15 +21,15 @@ MODULE ps_wavelet_kernel S_FFT_dimensions #include "../base/base_uses.f90" - IMPLICIT NONE + IMPLICIT NONE - PRIVATE + PRIVATE CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'ps_wavelet_kernel' ! *** Public data types *** - PUBLIC :: createKernel + PUBLIC :: createKernel CONTAINS @@ -75,7 +74,7 @@ MODULE ps_wavelet_kernel !> the nd1,nd2,nd3 arguments to the PS_dim4allocation routine, then eliminating the pointer !> declaration. ! ************************************************************************************************** - SUBROUTINE createKernel(geocode,n01,n02,n03,hx,hy,hz,itype_scf,iproc,nproc,kernel,mpi_group) + SUBROUTINE createKernel(geocode, n01, n02, n03, hx, hy, hz, itype_scf, iproc, nproc, kernel, mpi_group) CHARACTER(len=1), INTENT(in) :: geocode INTEGER, INTENT(in) :: n01, n02, n03 @@ -90,53 +89,53 @@ SUBROUTINE createKernel(geocode,n01,n02,n03,hx,hy,hz,itype_scf,iproc,nproc,kerne nd1, nd2, nd3, nlimd, nlimk REAL(KIND=dp) :: hgrid - hgrid=MAX(hx,hy,hz) + hgrid = MAX(hx, hy, hz) - IF (geocode == 'P') THEN + IF (geocode == 'P') THEN - CALL F_FFT_dimensions(n01,n02,n03,m1,m2,m3,n1,n2,n3,& - md1,md2,md3,nd1,nd2,nd3,nproc) + CALL F_FFT_dimensions(n01, n02, n03, m1, m2, m3, n1, n2, n3, & + md1, md2, md3, nd1, nd2, nd3, nproc) - ALLOCATE(kernel(1)) - nlimd=n2 - nlimk=0 + ALLOCATE (kernel(1)) + nlimd = n2 + nlimk = 0 - ELSE IF (geocode == 'S') THEN + ELSE IF (geocode == 'S') THEN - CALL S_FFT_dimensions(n01,n02,n03,m1,m2,m3,n1,n2,n3,& - md1,md2,md3,nd1,nd2,nd3,nproc) + CALL S_FFT_dimensions(n01, n02, n03, m1, m2, m3, n1, n2, n3, & + md1, md2, md3, nd1, nd2, nd3, nproc) - ALLOCATE(kernel(nd1*nd2*nd3/nproc)) + ALLOCATE (kernel(nd1*nd2*nd3/nproc)) - !the kernel must be built and scattered to all the processes + !the kernel must be built and scattered to all the processes - CALL Surfaces_Kernel(n1,n2,n3,m3,nd1,nd2,nd3,hx,hz,hy,& - itype_scf,kernel,iproc,nproc,mpi_group) - !last plane calculated for the density and the kernel + CALL Surfaces_Kernel(n1, n2, n3, m3, nd1, nd2, nd3, hx, hz, hy, & + itype_scf, kernel, iproc, nproc, mpi_group) + !last plane calculated for the density and the kernel - nlimd=n2 - nlimk=n3/2+1 - ELSE IF (geocode == 'F') THEN + nlimd = n2 + nlimk = n3/2 + 1 + ELSE IF (geocode == 'F') THEN - !Build the Kernel + !Build the Kernel - CALL F_FFT_dimensions(n01,n02,n03,m1,m2,m3,n1,n2,n3,& - md1,md2,md3,nd1,nd2,nd3,nproc) - ALLOCATE(kernel(nd1*nd2*nd3/nproc)) + CALL F_FFT_dimensions(n01, n02, n03, m1, m2, m3, n1, n2, n3, & + md1, md2, md3, nd1, nd2, nd3, nproc) + ALLOCATE (kernel(nd1*nd2*nd3/nproc)) - !the kernel must be built and scattered to all the processes - CALL Free_Kernel(n01,n02,n03,n1,n2,n3,nd1,nd2,nd3,hgrid,& - itype_scf,iproc,nproc,kernel,mpi_group) + !the kernel must be built and scattered to all the processes + CALL Free_Kernel(n01, n02, n03, n1, n2, n3, nd1, nd2, nd3, hgrid, & + itype_scf, iproc, nproc, kernel, mpi_group) - !last plane calculated for the density and the kernel - nlimd=n2/2 - nlimk=n3/2+1 + !last plane calculated for the density and the kernel + nlimd = n2/2 + nlimk = n3/2 + 1 - ELSE + ELSE - CPABORT("No wavelet based poisson solver for given geometry") + CPABORT("No wavelet based poisson solver for given geometry") - END IF + END IF !!! IF (iproc==0) THEN !!! write(*,*)'done.' !!! write(*,'(1x,a,i0)') 'Allocate words for kernel ',nd1*nd2*nd3/nproc @@ -192,7 +191,7 @@ SUBROUTINE createKernel(geocode,n01,n02,n03,hx,hy,hz,itype_scf,iproc,nproc,kerne !!! end if !!! !!! END IF -END SUBROUTINE createKernel + END SUBROUTINE createKernel ! ************************************************************************************************** !> \brief Build the kernel of the Poisson operator with @@ -217,8 +216,8 @@ END SUBROUTINE createKernel !> \date October 2006 !> \author L. Genovese ! ************************************************************************************************** -SUBROUTINE Surfaces_Kernel(n1,n2,n3,m3,nker1,nker2,nker3,h1,h2,h3,& - itype_scf,karray,iproc,nproc,mpi_group) + SUBROUTINE Surfaces_Kernel(n1, n2, n3, m3, nker1, nker2, nker3, h1, h2, h3, & + itype_scf, karray, iproc, nproc, mpi_group) INTEGER, INTENT(in) :: n1, n2, n3, m3, nker1, nker2, nker3 REAL(KIND=dp), INTENT(in) :: h1, h2, h3 @@ -251,293 +250,293 @@ SUBROUTINE Surfaces_Kernel(n1,n2,n3,m3,nker1,nker2,nker3,h1,h2,h3,& !coefficients for the polynomial interpolation !assign the values of the coefficients - karray = 0.0_dp - cpol(:,:)=1._dp - - cpol(1,2)=.25_dp - - cpol(1,3)=1._dp/3._dp - - cpol(1,4)=7._dp/12._dp - cpol(2,4)=8._dp/3._dp - - cpol(1,5)=19._dp/50._dp - cpol(2,5)=3._dp/2._dp - - cpol(1,6)=41._dp/272._dp - cpol(2,6)=27._dp/34._dp - cpol(3,6)=27._dp/272._dp - - cpol(1,7)=751._dp/2989._dp - cpol(2,7)=73._dp/61._dp - cpol(3,7)=27._dp/61._dp - - cpol(1,8)=-989._dp/4540._dp - cpol(2,8)=-1472._dp/1135._dp - cpol(3,8)=232._dp/1135._dp - cpol(4,8)=-2624._dp/1135._dp - - !renormalize values - cpol(1,1)=.5_dp*cpol(1,1) - cpol(1:2,2)=2._dp/3._dp*cpol(1:2,2) - cpol(1:2,3)=3._dp/8._dp*cpol(1:2,3) - cpol(1:3,4)=2._dp/15._dp*cpol(1:3,4) - cpol(1:3,5)=25._dp/144._dp*cpol(1:3,5) - cpol(1:4,6)=34._dp/105._dp*cpol(1:4,6) - cpol(1:4,7)=2989._dp/17280._dp*cpol(1:4,7) - cpol(1:5,8)=-454._dp/2835._dp*cpol(1:5,8) - - !assign the complete values - cpol(2,1)=cpol(1,1) - - cpol(3,2)=cpol(1,2) - - cpol(3,3)=cpol(2,3) - cpol(4,3)=cpol(1,3) - - cpol(4,4)=cpol(2,4) - cpol(5,4)=cpol(1,4) - - cpol(4,5)=cpol(3,5) - cpol(5,5)=cpol(2,5) - cpol(6,5)=cpol(1,5) - - cpol(5,6)=cpol(3,6) - cpol(6,6)=cpol(2,6) - cpol(7,6)=cpol(1,6) - - cpol(5,7)=cpol(4,7) - cpol(6,7)=cpol(3,7) - cpol(7,7)=cpol(2,7) - cpol(8,7)=cpol(1,7) - - cpol(6,8)=cpol(4,8) - cpol(7,8)=cpol(3,8) - cpol(8,8)=cpol(2,8) - cpol(9,8)=cpol(1,8) - - !Number of integration points : 2*itype_scf*n_points - n_scf=2*itype_scf*n_points - !Allocations - ALLOCATE(x_scf(0:n_scf)) - ALLOCATE(y_scf(0:n_scf)) - - !Build the scaling function - CALL scaling_function(itype_scf,n_scf,n_range,x_scf,y_scf) - !Step grid for the integration - dx = REAL(n_range,KIND=dp)/REAL(n_scf,KIND=dp) - !Extend the range (no more calculations because fill in by 0._dp) - n_cell = m3 - n_range = MAX(n_cell,n_range) - - !Allocations - ncache=ncache_optimal - !the HalFFT must be performed only in the third dimension, - !and nker3=n3/2+1, hence - IF (ncache <= (nker3-1)*4) ncache=nker3-1*4 - - !enlarge the second dimension of the kernel to be compatible with nproc - nact2=nker2 - enlarge_ydim: DO - IF (nproc*(nact2/nproc) /= nact2) THEN - nact2=nact2+1 - ELSE - EXIT enlarge_ydim - END IF - END DO enlarge_ydim - - !array for the MPI procedure - ALLOCATE(kernel(nker1,nact2/nproc,nker3)) - ALLOCATE(kernel_mpi(nker1,nact2/nproc,nker3/nproc,nproc)) - ALLOCATE(kernel_scf(n_range)) - ALLOCATE(halfft_cache(2,ncache/4,2)) - ALLOCATE(cossinarr(2,n3/2-1)) - ALLOCATE(btrig(2,ctrig_length)) - ALLOCATE(after(7)) - ALLOCATE(now(7)) - ALLOCATE(before(7)) - - !constants - pi=4._dp*ATAN(1._dp) - - !arrays for the halFFT - CALL ctrig(n3/2,btrig,after,before,now,1,ic) - - !build the phases for the HalFFT reconstruction - pion=2._dp*pi/REAL(n3,KIND=dp) - DO i3=2,n3/2 - x=REAL(i3-1,KIND=dp)*pion - cossinarr(1,i3-1)= COS(x) - cossinarr(2,i3-1)=-SIN(x) - END DO - - ! satisfy valgrind, init arrays to large value, even if the offending bit is (likely?) padding - kernel=HUGE(0._dp) - kernel_mpi=HUGE(0._dp) - - !calculate the limits of the FFT calculations - !that can be performed in a row remaining inside the cache - num_of_mus=ncache/(2*n3) - - diff=0._dp - !order of the polynomial to be used for integration (must be a power of two) - ipolyord=8 !this part should be incorporated inside the numerical integration - !here we have to choice the piece of the x-y grid to cover - - !let us now calculate the fraction of mu that will be considered - j2st=iproc*(nact2/nproc) - j2nd=MIN((iproc+1)*(nact2/nproc),n2/2+1) - - DO ind2=(n1/2+1)*j2st+1,(n1/2+1)*j2nd,num_of_mus - istart=ind2 - iend=MIN(ind2+(num_of_mus-1),(n1/2+1)*j2nd) - nfft=iend-istart+1 - shift=0 - - !initialization of the interesting part of the cache array - halfft_cache(:,:,:)=0._dp - - IF (istart == 1) THEN - !i2=1 - shift=1 - - CALL calculates_green_opt_muzero(n_range,n_scf,ipolyord,x_scf,y_scf,& - cpol(1,ipolyord),dx,kernel_scf) - - !copy of the first zero value - halfft_cache(1,1,1)=0._dp - - DO i3=1,m3 - - value=0.5_dp*h3*kernel_scf(i3) - !index in where to copy the value of the kernel - CALL indices(ireim,num_of_mus,n3/2+i3,1,ind1) - !index in where to copy the symmetric value - CALL indices(jreim,num_of_mus,n3/2+2-i3,1,jnd1) - halfft_cache(ireim,ind1,1) = value - halfft_cache(jreim,jnd1,1) = value - - END DO - - END IF - - loopimpulses : DO imu=istart+shift,iend - - !here there is the value of mu associated to hgrid - !note that we have multiplicated mu for hgrid to be comparable - !with mu0ref - - !calculate the proper value of mu taking into account the periodic dimensions - !corresponding value of i1 and i2 - i1=MOD(imu,n1/2+1) - IF (i1==0) i1=n1/2+1 - i2=(imu-i1)/(n1/2+1)+1 - ponx=REAL(i1-1,KIND=dp)/REAL(n1,KIND=dp) - pony=REAL(i2-1,KIND=dp)/REAL(n2,KIND=dp) - - mu1=2._dp*pi*SQRT((ponx/h1)**2+(pony/h2)**2)*h3 - - CALL calculates_green_opt(n_range,n_scf,itype_scf,ipolyord,x_scf,y_scf,& - cpol(1,ipolyord),mu1,dx,kernel_scf) - - !readjust the coefficient and define the final kernel - - !copy of the first zero value - halfft_cache(1,imu-istart+1,1) = 0._dp - DO i3=1,m3 - value=-0.5_dp*h3/mu1*kernel_scf(i3) - !write(80,*)mu1,i3,kernel_scf(i03) - !index in where to copy the value of the kernel - CALL indices(ireim,num_of_mus,n3/2+i3,imu-istart+1,ind1) - !index in where to copy the symmetric value - CALL indices(jreim,num_of_mus,n3/2+2-i3,imu-istart+1,jnd1) - halfft_cache(ireim,ind1,1)=value - halfft_cache(jreim,jnd1,1)=value - END DO - - END DO loopimpulses - - !now perform the FFT of the array in cache - inzee=1 - DO i=1,ic - CALL fftstp(num_of_mus,nfft,n3/2,num_of_mus,n3/2,& - halfft_cache(1,1,inzee),halfft_cache(1,1,3-inzee),& - btrig,after(i),now(i),before(i),1) - inzee=3-inzee - ENDDO - !assign the values of the FFT array - !and compare with the good results - DO imu=istart,iend - - !corresponding value of i1 and i2 - i1=MOD(imu,n1/2+1) - IF (i1==0) i1=n1/2+1 - i2=(imu-i1)/(n1/2+1)+1 - - j2=i2-j2st - - a=halfft_cache(1,imu-istart+1,inzee) - b=halfft_cache(2,imu-istart+1,inzee) - kernel(i1,j2,1)=a+b - kernel(i1,j2,n3/2+1)=a-b - - DO i3=2,n3/2 - ind1=imu-istart+1+num_of_mus*(i3-1) - jnd1=imu-istart+1+num_of_mus*(n3/2+2-i3-1) - cp=cossinarr(1,i3-1) - sp=cossinarr(2,i3-1) - a=halfft_cache(1,ind1,inzee) - b=halfft_cache(2,ind1,inzee) - c=halfft_cache(1,jnd1,inzee) - d=halfft_cache(2,jnd1,inzee) - feR=.5_dp*(a+c) - feI=.5_dp*(b-d) - foR=.5_dp*(a-c) - foI=.5_dp*(b+d) - fR=feR+cp*foI-sp*foR - kernel(i1,j2,i3)=fR - END DO - END DO - - END DO - - !give to each processor a slice of the third dimension - IF (nproc > 1) THEN - CALL mp_alltoall(kernel,&!nker1*(nact2/nproc)*(nker3/nproc), & - kernel_mpi,nker1*(nact2/nproc)*(nker3/nproc), & - mpi_group) - - DO jp2=1,nproc - DO i3=1,nker3/nproc - DO i2=1,nact2/nproc - j2=i2+(jp2-1)*(nact2/nproc) - IF (j2 <= nker2) THEN - DO i1=1,nker1 - karray(i1,j2,i3)=& - kernel_mpi(i1,i2,i3,jp2) - END DO - END IF - END DO - END DO - END DO - - ELSE - karray(1:nker1,1:nker2,1:nker3)=kernel(1:nker1,1:nker2,1:nker3) - ENDIF - - !De-allocations - DEALLOCATE(kernel) - DEALLOCATE(kernel_mpi) - DEALLOCATE(btrig) - DEALLOCATE(after) - DEALLOCATE(now) - DEALLOCATE(before) - DEALLOCATE(halfft_cache) - DEALLOCATE(kernel_scf) - DEALLOCATE(x_scf) - DEALLOCATE(y_scf) - -END SUBROUTINE Surfaces_Kernel + karray = 0.0_dp + cpol(:, :) = 1._dp + + cpol(1, 2) = .25_dp + + cpol(1, 3) = 1._dp/3._dp + + cpol(1, 4) = 7._dp/12._dp + cpol(2, 4) = 8._dp/3._dp + + cpol(1, 5) = 19._dp/50._dp + cpol(2, 5) = 3._dp/2._dp + + cpol(1, 6) = 41._dp/272._dp + cpol(2, 6) = 27._dp/34._dp + cpol(3, 6) = 27._dp/272._dp + + cpol(1, 7) = 751._dp/2989._dp + cpol(2, 7) = 73._dp/61._dp + cpol(3, 7) = 27._dp/61._dp + + cpol(1, 8) = -989._dp/4540._dp + cpol(2, 8) = -1472._dp/1135._dp + cpol(3, 8) = 232._dp/1135._dp + cpol(4, 8) = -2624._dp/1135._dp + + !renormalize values + cpol(1, 1) = .5_dp*cpol(1, 1) + cpol(1:2, 2) = 2._dp/3._dp*cpol(1:2, 2) + cpol(1:2, 3) = 3._dp/8._dp*cpol(1:2, 3) + cpol(1:3, 4) = 2._dp/15._dp*cpol(1:3, 4) + cpol(1:3, 5) = 25._dp/144._dp*cpol(1:3, 5) + cpol(1:4, 6) = 34._dp/105._dp*cpol(1:4, 6) + cpol(1:4, 7) = 2989._dp/17280._dp*cpol(1:4, 7) + cpol(1:5, 8) = -454._dp/2835._dp*cpol(1:5, 8) + + !assign the complete values + cpol(2, 1) = cpol(1, 1) + + cpol(3, 2) = cpol(1, 2) + + cpol(3, 3) = cpol(2, 3) + cpol(4, 3) = cpol(1, 3) + + cpol(4, 4) = cpol(2, 4) + cpol(5, 4) = cpol(1, 4) + + cpol(4, 5) = cpol(3, 5) + cpol(5, 5) = cpol(2, 5) + cpol(6, 5) = cpol(1, 5) + + cpol(5, 6) = cpol(3, 6) + cpol(6, 6) = cpol(2, 6) + cpol(7, 6) = cpol(1, 6) + + cpol(5, 7) = cpol(4, 7) + cpol(6, 7) = cpol(3, 7) + cpol(7, 7) = cpol(2, 7) + cpol(8, 7) = cpol(1, 7) + + cpol(6, 8) = cpol(4, 8) + cpol(7, 8) = cpol(3, 8) + cpol(8, 8) = cpol(2, 8) + cpol(9, 8) = cpol(1, 8) + + !Number of integration points : 2*itype_scf*n_points + n_scf = 2*itype_scf*n_points + !Allocations + ALLOCATE (x_scf(0:n_scf)) + ALLOCATE (y_scf(0:n_scf)) + + !Build the scaling function + CALL scaling_function(itype_scf, n_scf, n_range, x_scf, y_scf) + !Step grid for the integration + dx = REAL(n_range, KIND=dp)/REAL(n_scf, KIND=dp) + !Extend the range (no more calculations because fill in by 0._dp) + n_cell = m3 + n_range = MAX(n_cell, n_range) + + !Allocations + ncache = ncache_optimal + !the HalFFT must be performed only in the third dimension, + !and nker3=n3/2+1, hence + IF (ncache <= (nker3 - 1)*4) ncache = nker3 - 1*4 + + !enlarge the second dimension of the kernel to be compatible with nproc + nact2 = nker2 + enlarge_ydim: DO + IF (nproc*(nact2/nproc) /= nact2) THEN + nact2 = nact2 + 1 + ELSE + EXIT enlarge_ydim + END IF + END DO enlarge_ydim + + !array for the MPI procedure + ALLOCATE (kernel(nker1, nact2/nproc, nker3)) + ALLOCATE (kernel_mpi(nker1, nact2/nproc, nker3/nproc, nproc)) + ALLOCATE (kernel_scf(n_range)) + ALLOCATE (halfft_cache(2, ncache/4, 2)) + ALLOCATE (cossinarr(2, n3/2 - 1)) + ALLOCATE (btrig(2, ctrig_length)) + ALLOCATE (after(7)) + ALLOCATE (now(7)) + ALLOCATE (before(7)) + + !constants + pi = 4._dp*ATAN(1._dp) + + !arrays for the halFFT + CALL ctrig(n3/2, btrig, after, before, now, 1, ic) + + !build the phases for the HalFFT reconstruction + pion = 2._dp*pi/REAL(n3, KIND=dp) + DO i3 = 2, n3/2 + x = REAL(i3 - 1, KIND=dp)*pion + cossinarr(1, i3 - 1) = COS(x) + cossinarr(2, i3 - 1) = -SIN(x) + END DO + + ! satisfy valgrind, init arrays to large value, even if the offending bit is (likely?) padding + kernel = HUGE(0._dp) + kernel_mpi = HUGE(0._dp) + + !calculate the limits of the FFT calculations + !that can be performed in a row remaining inside the cache + num_of_mus = ncache/(2*n3) + + diff = 0._dp + !order of the polynomial to be used for integration (must be a power of two) + ipolyord = 8 !this part should be incorporated inside the numerical integration + !here we have to choice the piece of the x-y grid to cover + + !let us now calculate the fraction of mu that will be considered + j2st = iproc*(nact2/nproc) + j2nd = MIN((iproc + 1)*(nact2/nproc), n2/2 + 1) + + DO ind2 = (n1/2 + 1)*j2st + 1, (n1/2 + 1)*j2nd, num_of_mus + istart = ind2 + iend = MIN(ind2 + (num_of_mus - 1), (n1/2 + 1)*j2nd) + nfft = iend - istart + 1 + shift = 0 + + !initialization of the interesting part of the cache array + halfft_cache(:, :, :) = 0._dp + + IF (istart == 1) THEN + !i2=1 + shift = 1 + + CALL calculates_green_opt_muzero(n_range, n_scf, ipolyord, x_scf, y_scf, & + cpol(1, ipolyord), dx, kernel_scf) + + !copy of the first zero value + halfft_cache(1, 1, 1) = 0._dp + + DO i3 = 1, m3 + + value = 0.5_dp*h3*kernel_scf(i3) + !index in where to copy the value of the kernel + CALL indices(ireim, num_of_mus, n3/2 + i3, 1, ind1) + !index in where to copy the symmetric value + CALL indices(jreim, num_of_mus, n3/2 + 2 - i3, 1, jnd1) + halfft_cache(ireim, ind1, 1) = value + halfft_cache(jreim, jnd1, 1) = value + + END DO + + END IF + + loopimpulses: DO imu = istart + shift, iend + + !here there is the value of mu associated to hgrid + !note that we have multiplicated mu for hgrid to be comparable + !with mu0ref + + !calculate the proper value of mu taking into account the periodic dimensions + !corresponding value of i1 and i2 + i1 = MOD(imu, n1/2 + 1) + IF (i1 == 0) i1 = n1/2 + 1 + i2 = (imu - i1)/(n1/2 + 1) + 1 + ponx = REAL(i1 - 1, KIND=dp)/REAL(n1, KIND=dp) + pony = REAL(i2 - 1, KIND=dp)/REAL(n2, KIND=dp) + + mu1 = 2._dp*pi*SQRT((ponx/h1)**2 + (pony/h2)**2)*h3 + + CALL calculates_green_opt(n_range, n_scf, itype_scf, ipolyord, x_scf, y_scf, & + cpol(1, ipolyord), mu1, dx, kernel_scf) + + !readjust the coefficient and define the final kernel + + !copy of the first zero value + halfft_cache(1, imu - istart + 1, 1) = 0._dp + DO i3 = 1, m3 + value = -0.5_dp*h3/mu1*kernel_scf(i3) + !write(80,*)mu1,i3,kernel_scf(i03) + !index in where to copy the value of the kernel + CALL indices(ireim, num_of_mus, n3/2 + i3, imu - istart + 1, ind1) + !index in where to copy the symmetric value + CALL indices(jreim, num_of_mus, n3/2 + 2 - i3, imu - istart + 1, jnd1) + halfft_cache(ireim, ind1, 1) = value + halfft_cache(jreim, jnd1, 1) = value + END DO + + END DO loopimpulses + + !now perform the FFT of the array in cache + inzee = 1 + DO i = 1, ic + CALL fftstp(num_of_mus, nfft, n3/2, num_of_mus, n3/2, & + halfft_cache(1, 1, inzee), halfft_cache(1, 1, 3 - inzee), & + btrig, after(i), now(i), before(i), 1) + inzee = 3 - inzee + ENDDO + !assign the values of the FFT array + !and compare with the good results + DO imu = istart, iend + + !corresponding value of i1 and i2 + i1 = MOD(imu, n1/2 + 1) + IF (i1 == 0) i1 = n1/2 + 1 + i2 = (imu - i1)/(n1/2 + 1) + 1 + + j2 = i2 - j2st + + a = halfft_cache(1, imu - istart + 1, inzee) + b = halfft_cache(2, imu - istart + 1, inzee) + kernel(i1, j2, 1) = a + b + kernel(i1, j2, n3/2 + 1) = a - b + + DO i3 = 2, n3/2 + ind1 = imu - istart + 1 + num_of_mus*(i3 - 1) + jnd1 = imu - istart + 1 + num_of_mus*(n3/2 + 2 - i3 - 1) + cp = cossinarr(1, i3 - 1) + sp = cossinarr(2, i3 - 1) + a = halfft_cache(1, ind1, inzee) + b = halfft_cache(2, ind1, inzee) + c = halfft_cache(1, jnd1, inzee) + d = halfft_cache(2, jnd1, inzee) + feR = .5_dp*(a + c) + feI = .5_dp*(b - d) + foR = .5_dp*(a - c) + foI = .5_dp*(b + d) + fR = feR + cp*foI - sp*foR + kernel(i1, j2, i3) = fR + END DO + END DO + + END DO + + !give to each processor a slice of the third dimension + IF (nproc > 1) THEN + CALL mp_alltoall(kernel, &!nker1*(nact2/nproc)*(nker3/nproc), & + kernel_mpi, nker1*(nact2/nproc)*(nker3/nproc), & + mpi_group) + + DO jp2 = 1, nproc + DO i3 = 1, nker3/nproc + DO i2 = 1, nact2/nproc + j2 = i2 + (jp2 - 1)*(nact2/nproc) + IF (j2 <= nker2) THEN + DO i1 = 1, nker1 + karray(i1, j2, i3) = & + kernel_mpi(i1, i2, i3, jp2) + END DO + END IF + END DO + END DO + END DO + + ELSE + karray(1:nker1, 1:nker2, 1:nker3) = kernel(1:nker1, 1:nker2, 1:nker3) + ENDIF + + !De-allocations + DEALLOCATE (kernel) + DEALLOCATE (kernel_mpi) + DEALLOCATE (btrig) + DEALLOCATE (after) + DEALLOCATE (now) + DEALLOCATE (before) + DEALLOCATE (halfft_cache) + DEALLOCATE (kernel_scf) + DEALLOCATE (x_scf) + DEALLOCATE (y_scf) + + END SUBROUTINE Surfaces_Kernel ! ************************************************************************************************** !> \brief ... @@ -552,7 +551,7 @@ END SUBROUTINE Surfaces_Kernel !> \param hres ... !> \param g_mu ... ! ************************************************************************************************** -SUBROUTINE calculates_green_opt(n,n_scf,itype_scf,intorder,xval,yval,c,mu,hres,g_mu) + SUBROUTINE calculates_green_opt(n, n_scf, itype_scf, intorder, xval, yval, c, mu, hres, g_mu) INTEGER, INTENT(in) :: n, n_scf, itype_scf, intorder REAL(KIND=dp), DIMENSION(0:n_scf), INTENT(in) :: xval, yval REAL(KIND=dp), DIMENSION(intorder+1), INTENT(in) :: c @@ -569,120 +568,120 @@ SUBROUTINE calculates_green_opt(n,n_scf,itype_scf,intorder,xval,yval,c,mu,hres,g grtmp, mu0, ratio, x, x0, x1 REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: green, green1 - g_mu = 0.0_dp - !We calculate the number of iterations to go from mu0 to mu0_ref - IF (mu <= mu_max) THEN - n_iter = 0 - mu0 = mu - ELSE - n_iter=1 - loop_iter: DO - ratio=REAL(2**n_iter,KIND=dp) - mu0=mu/ratio - IF (mu0 <= mu_max) THEN - EXIT loop_iter - END IF - n_iter=n_iter+1 - END DO loop_iter - END IF - - !dimension needed for the correct calculation of the recursion - nrec=2**n_iter*n - - ALLOCATE(green(-nrec:nrec)) - - !initialization of the branching value - ikern=0 - izero=0 - initialization: DO - IF (xval(izero)>=REAL(ikern,KIND=dp) .OR. izero==n_scf) EXIT initialization - izero=izero+1 - END DO initialization - green=0._dp - !now perform the interpolation in right direction - ivalue=izero - gright=0._dp - loop_right: DO - IF(ivalue >= n_scf-intorder-1) EXIT loop_right - DO i=1,intorder+1 - x=xval(ivalue)-REAL(ikern,KIND=dp) - f=yval(ivalue)*EXP(-mu0*x) - filter=intorder*c(i) - gright=gright+filter*f - ivalue=ivalue+1 - END DO - ivalue=ivalue-1 - END DO loop_right - iend=n_scf-ivalue - DO i=1,iend - x=xval(ivalue)-REAL(ikern,KIND=dp) - f=yval(ivalue)*EXP(-mu0*x) - filter=intorder*c(i) - gright=gright+filter*f - ivalue=ivalue+1 - END DO - gright=hres*gright - - !the scaling function is symmetric, so the same for the other direction - gleft=gright - - green(ikern)=gleft+gright - - !now the loop until the last value - DO ikern=1,nrec - gltmp=0._dp - grtmp=0._dp - ivalue=izero - x0=xval(izero) - loop_integration: DO - IF (izero==n_scf) EXIT loop_integration - DO i=1,intorder+1 - x=xval(ivalue) - fl=yval(ivalue)*EXP(mu0*x) - fr=yval(ivalue)*EXP(-mu0*x) - filter=intorder*c(i) - gltmp=gltmp+filter*fl - grtmp=grtmp+filter*fr - ivalue=ivalue+1 - IF (xval(izero)>=REAL(ikern,KIND=dp) .OR. izero==n_scf) THEN - x1=xval(izero) - EXIT loop_integration - END IF - izero=izero+1 - END DO - ivalue=ivalue-1 - izero=izero-1 - END DO loop_integration - gleft=EXP(-mu0)*(gleft+hres*EXP(-mu0*REAL(ikern-1,KIND=dp))*gltmp) - IF (izero == n_scf) THEN - gright=0._dp - ELSE - gright=EXP(mu0)*(gright-hres*EXP(mu0*REAL(ikern-1,KIND=dp))*grtmp) - END IF - green(ikern)=gleft+gright - green(-ikern)=gleft+gright - IF (ABS(green(ikern)) <= 1.e-20_dp) THEN - nrec=ikern - EXIT - END IF - !print *,ikern,izero,n_scf,gltmp,grtmp,gleft,gright,x0,x1,green(ikern) - END DO - !now we must calculate the recursion - ALLOCATE(green1(-nrec:nrec)) - - !Start the iteration to go from mu0 to mu - CALL scf_recursion(itype_scf,n_iter,nrec,green(-nrec),green1(-nrec)) - - DO i=1,MIN(n,nrec) - g_mu(i)=green(i-1) - END DO - DO i=MIN(n,nrec)+1,n - g_mu(i)=0._dp - END DO - - DEALLOCATE(green, green1) - -END SUBROUTINE calculates_green_opt + g_mu = 0.0_dp + !We calculate the number of iterations to go from mu0 to mu0_ref + IF (mu <= mu_max) THEN + n_iter = 0 + mu0 = mu + ELSE + n_iter = 1 + loop_iter: DO + ratio = REAL(2**n_iter, KIND=dp) + mu0 = mu/ratio + IF (mu0 <= mu_max) THEN + EXIT loop_iter + END IF + n_iter = n_iter + 1 + END DO loop_iter + END IF + + !dimension needed for the correct calculation of the recursion + nrec = 2**n_iter*n + + ALLOCATE (green(-nrec:nrec)) + + !initialization of the branching value + ikern = 0 + izero = 0 + initialization: DO + IF (xval(izero) >= REAL(ikern, KIND=dp) .OR. izero == n_scf) EXIT initialization + izero = izero + 1 + END DO initialization + green = 0._dp + !now perform the interpolation in right direction + ivalue = izero + gright = 0._dp + loop_right: DO + IF (ivalue >= n_scf - intorder - 1) EXIT loop_right + DO i = 1, intorder + 1 + x = xval(ivalue) - REAL(ikern, KIND=dp) + f = yval(ivalue)*EXP(-mu0*x) + filter = intorder*c(i) + gright = gright + filter*f + ivalue = ivalue + 1 + END DO + ivalue = ivalue - 1 + END DO loop_right + iend = n_scf - ivalue + DO i = 1, iend + x = xval(ivalue) - REAL(ikern, KIND=dp) + f = yval(ivalue)*EXP(-mu0*x) + filter = intorder*c(i) + gright = gright + filter*f + ivalue = ivalue + 1 + END DO + gright = hres*gright + + !the scaling function is symmetric, so the same for the other direction + gleft = gright + + green(ikern) = gleft + gright + + !now the loop until the last value + DO ikern = 1, nrec + gltmp = 0._dp + grtmp = 0._dp + ivalue = izero + x0 = xval(izero) + loop_integration: DO + IF (izero == n_scf) EXIT loop_integration + DO i = 1, intorder + 1 + x = xval(ivalue) + fl = yval(ivalue)*EXP(mu0*x) + fr = yval(ivalue)*EXP(-mu0*x) + filter = intorder*c(i) + gltmp = gltmp + filter*fl + grtmp = grtmp + filter*fr + ivalue = ivalue + 1 + IF (xval(izero) >= REAL(ikern, KIND=dp) .OR. izero == n_scf) THEN + x1 = xval(izero) + EXIT loop_integration + END IF + izero = izero + 1 + END DO + ivalue = ivalue - 1 + izero = izero - 1 + END DO loop_integration + gleft = EXP(-mu0)*(gleft + hres*EXP(-mu0*REAL(ikern - 1, KIND=dp))*gltmp) + IF (izero == n_scf) THEN + gright = 0._dp + ELSE + gright = EXP(mu0)*(gright - hres*EXP(mu0*REAL(ikern - 1, KIND=dp))*grtmp) + END IF + green(ikern) = gleft + gright + green(-ikern) = gleft + gright + IF (ABS(green(ikern)) <= 1.e-20_dp) THEN + nrec = ikern + EXIT + END IF + !print *,ikern,izero,n_scf,gltmp,grtmp,gleft,gright,x0,x1,green(ikern) + END DO + !now we must calculate the recursion + ALLOCATE (green1(-nrec:nrec)) + + !Start the iteration to go from mu0 to mu + CALL scf_recursion(itype_scf, n_iter, nrec, green(-nrec), green1(-nrec)) + + DO i = 1, MIN(n, nrec) + g_mu(i) = green(i - 1) + END DO + DO i = MIN(n, nrec) + 1, n + g_mu(i) = 0._dp + END DO + + DEALLOCATE (green, green1) + + END SUBROUTINE calculates_green_opt ! ************************************************************************************************** !> \brief ... @@ -695,7 +694,7 @@ END SUBROUTINE calculates_green_opt !> \param hres ... !> \param green ... ! ************************************************************************************************** -SUBROUTINE calculates_green_opt_muzero(n,n_scf,intorder,xval,yval,c,hres,green) + SUBROUTINE calculates_green_opt_muzero(n, n_scf, intorder, xval, yval, c, hres, green) INTEGER, INTENT(in) :: n, n_scf, intorder REAL(KIND=dp), DIMENSION(0:n_scf), INTENT(in) :: xval, yval REAL(KIND=dp), DIMENSION(intorder+1), INTENT(in) :: c @@ -707,79 +706,79 @@ SUBROUTINE calculates_green_opt_muzero(n,n_scf,intorder,xval,yval,c,hres,green) !initialization of the branching value - ikern=0 - izero=0 - initialization: DO - IF (xval(izero)>=REAL(ikern,KIND=dp) .OR. izero==n_scf) EXIT initialization - izero=izero+1 - END DO initialization - green=0._dp - !first case, ikern=0 - !now perform the interpolation in right direction - ivalue=izero - gr1=0._dp - loop_right: DO - IF(ivalue >= n_scf-intorder-1) EXIT loop_right - DO i=1,intorder+1 - x=xval(ivalue) - y=yval(ivalue) - filter=intorder*c(i) - gr1=gr1+filter*x*y - ivalue=ivalue+1 - END DO - ivalue=ivalue-1 - END DO loop_right - iend=n_scf-ivalue - DO i=1,iend - x=xval(ivalue) - y=yval(ivalue) - filter=intorder*c(i) - gr1=gr1+filter*x*y - ivalue=ivalue+1 - END DO - gr1=hres*gr1 - !the scaling function is symmetric - gl1=-gr1 - gl0=0.5_dp - gr0=0.5_dp - - green(1)=2._dp*gr1 - - !now the loop until the last value - DO ikern=1,n-1 - c0=0._dp - c1=0._dp - ivalue=izero - loop_integration: DO - IF (izero==n_scf) EXIT loop_integration - DO i=1,intorder+1 - x=xval(ivalue) - y=yval(ivalue) - filter=intorder*c(i) - c0=c0+filter*y - c1=c1+filter*y*x - ivalue=ivalue+1 - IF (xval(izero)>=REAL(ikern,KIND=dp) .OR. izero==n_scf) THEN - EXIT loop_integration - END IF - izero=izero+1 - END DO - ivalue=ivalue-1 - izero=izero-1 - END DO loop_integration - c0=hres*c0 - c1=hres*c1 - - gl0=gl0+c0 - gl1=gl1+c1 - gr0=gr0-c0 - gr1=gr1-c1 - !general case - green(ikern+1)=REAL(ikern,KIND=dp)*(gl0-gr0)+gr1-gl1 - !print *,ikern,izero,n_scf,gltmp,grtmp,gleft,gright,x0,x1,green(ikern) - END DO - -END SUBROUTINE calculates_green_opt_muzero + ikern = 0 + izero = 0 + initialization: DO + IF (xval(izero) >= REAL(ikern, KIND=dp) .OR. izero == n_scf) EXIT initialization + izero = izero + 1 + END DO initialization + green = 0._dp + !first case, ikern=0 + !now perform the interpolation in right direction + ivalue = izero + gr1 = 0._dp + loop_right: DO + IF (ivalue >= n_scf - intorder - 1) EXIT loop_right + DO i = 1, intorder + 1 + x = xval(ivalue) + y = yval(ivalue) + filter = intorder*c(i) + gr1 = gr1 + filter*x*y + ivalue = ivalue + 1 + END DO + ivalue = ivalue - 1 + END DO loop_right + iend = n_scf - ivalue + DO i = 1, iend + x = xval(ivalue) + y = yval(ivalue) + filter = intorder*c(i) + gr1 = gr1 + filter*x*y + ivalue = ivalue + 1 + END DO + gr1 = hres*gr1 + !the scaling function is symmetric + gl1 = -gr1 + gl0 = 0.5_dp + gr0 = 0.5_dp + + green(1) = 2._dp*gr1 + + !now the loop until the last value + DO ikern = 1, n - 1 + c0 = 0._dp + c1 = 0._dp + ivalue = izero + loop_integration: DO + IF (izero == n_scf) EXIT loop_integration + DO i = 1, intorder + 1 + x = xval(ivalue) + y = yval(ivalue) + filter = intorder*c(i) + c0 = c0 + filter*y + c1 = c1 + filter*y*x + ivalue = ivalue + 1 + IF (xval(izero) >= REAL(ikern, KIND=dp) .OR. izero == n_scf) THEN + EXIT loop_integration + END IF + izero = izero + 1 + END DO + ivalue = ivalue - 1 + izero = izero - 1 + END DO loop_integration + c0 = hres*c0 + c1 = hres*c1 + + gl0 = gl0 + c0 + gl1 = gl1 + c1 + gr0 = gr0 - c0 + gr1 = gr1 - c1 + !general case + green(ikern + 1) = REAL(ikern, KIND=dp)*(gl0 - gr0) + gr1 - gl1 + !print *,ikern,izero,n_scf,gltmp,grtmp,gleft,gright,x0,x1,green(ikern) + END DO + + END SUBROUTINE calculates_green_opt_muzero ! ************************************************************************************************** !> \brief ... @@ -789,7 +788,7 @@ END SUBROUTINE calculates_green_opt_muzero !> \param extrn ... !> \param index ... ! ************************************************************************************************** -SUBROUTINE indices(var_realimag,nelem,intrn,extrn,index) + SUBROUTINE indices(var_realimag, nelem, intrn, extrn, index) INTEGER, INTENT(out) :: var_realimag INTEGER, INTENT(in) :: nelem, intrn, extrn @@ -799,18 +798,18 @@ SUBROUTINE indices(var_realimag,nelem,intrn,extrn,index) !real or imaginary part - var_realimag=2-MOD(intrn,2) + var_realimag = 2 - MOD(intrn, 2) !actual index over half the length - i=(intrn+1)/2 - !check - IF (2*(i-1)+var_realimag /= intrn) THEN - PRINT *,'error, index=',intrn,'var_realimag=',var_realimag,'i=',i - END IF - !complete index to be assigned - index=extrn+nelem*(i-1) + i = (intrn + 1)/2 + !check + IF (2*(i - 1) + var_realimag /= intrn) THEN + PRINT *, 'error, index=', intrn, 'var_realimag=', var_realimag, 'i=', i + END IF + !complete index to be assigned + index = extrn + nelem*(i - 1) -END SUBROUTINE indices + END SUBROUTINE indices ! ************************************************************************************************** !> \brief Build the kernel of a gaussian function @@ -839,8 +838,8 @@ END SUBROUTINE indices !> \date February 2006 !> \author T. Deutsch, L. Genovese ! ************************************************************************************************** -SUBROUTINE Free_Kernel(n01,n02,n03,nfft1,nfft2,nfft3,n1k,n2k,n3k,& - hgrid,itype_scf,iproc,nproc,karray,mpi_group) + SUBROUTINE Free_Kernel(n01, n02, n03, nfft1, nfft2, nfft3, n1k, n2k, n3k, & + hgrid, itype_scf, iproc, nproc, karray, mpi_group) INTEGER, INTENT(in) :: n01, n02, n03, nfft1, nfft2, nfft3, n1k, & n2k, n3k @@ -871,168 +870,168 @@ SUBROUTINE Free_Kernel(n01,n02,n03,nfft1,nfft2,nfft3,n1k,n2k,n3k,& !(the support of the exponential should be inside [-n_range/2,n_range/2]) !Number of integration points : 2*itype_scf*n_points - n_scf=2*itype_scf*n_points - !Set karray - karray = 0.0_dp - !here we must set the dimensions for the fft part, starting from the nfft - !remember that actually nfft2 is associated to n03 and viceversa - - !dimensions that define the center of symmetry - n1h=nfft1/2 - n2h=nfft2/2 - n3h=nfft3/2 - - !Auxiliary dimensions only for building the FFT part - nker1=nfft1 - nker2=nfft2 - nker3=nfft3/2+1 - - !adjusting the last two dimensions to be multiples of nproc - DO - IF(MODULO(nker2,nproc) == 0) EXIT - nker2=nker2+1 - END DO - DO - IF(MODULO(nker3,nproc) == 0) EXIT - nker3=nker3+1 - END DO - - !this will be the array of the kernel in the real space - ALLOCATE(kp(n1h+1,n3h+1,nker2/nproc)) - - !defining proper extremes for the calculation of the - !local part of the kernel - - istart=iproc*nker2/nproc+1 - iend=MIN((iproc+1)*nker2/nproc,n2h+n03) - - istart1=istart - IF(iproc .EQ. 0) istart1=n2h-n03+2 - - !Allocations - ALLOCATE(x_scf(0:n_scf)) - ALLOCATE(y_scf(0:n_scf)) - - !Build the scaling function - CALL scaling_function(itype_scf,n_scf,n_range,x_scf,y_scf) - !Step grid for the integration - dx = REAL(n_range,KIND=dp)/REAL(n_scf,KIND=dp) - !Extend the range (no more calculations because fill in by 0._dp) - n_cell = MAX(n01,n02,n03) - n_range = MAX(n_cell,n_range) - - !Allocations - ALLOCATE(kernel_scf(-n_range:n_range)) - ALLOCATE(kern_1_scf(-n_range:n_range)) - - !Lengthes of the box (use FFT dimension) - a1 = hgrid * REAL(n01,KIND=dp) - a2 = hgrid * REAL(n02,KIND=dp) - a3 = hgrid * REAL(n03,KIND=dp) - - x_scf(:) = hgrid * x_scf(:) - y_scf(:) = 1._dp/hgrid * y_scf(:) - dx = hgrid * dx - !To have a correct integration - p0_cell = p0_ref/(hgrid*hgrid) - - !Initialization of the gaussian (Beylkin) - CALL gequad(p_gauss,w_gauss,ur_gauss,dr_gauss,acc_gauss) - !In order to have a range from a_range=sqrt(a1*a1+a2*a2+a3*a3) - !(biggest length in the cube) - !We divide the p_gauss by a_range**2 and a_gauss by a_range - a_range = SQRT(a1*a1+a2*a2+a3*a3) - factor = 1._dp/a_range - !factor2 = factor*factor - factor2 = 1._dp/(a1*a1+a2*a2+a3*a3) - DO i_gauss=1,n_gauss - p_gauss(i_gauss) = factor2*p_gauss(i_gauss) - END DO - DO i_gauss=1,n_gauss - w_gauss(i_gauss) = factor*w_gauss(i_gauss) - END DO - - kp(:,:,:)=0._dp - !Use in this order (better for accuracy). - loop_gauss: DO i_gauss=n_gauss,1,-1 - !Gaussian - pgauss = p_gauss(i_gauss) - - !We calculate the number of iterations to go from pgauss to p0_ref - n_iter = NINT((LOG(pgauss) - LOG(p0_cell))/LOG(4._dp)) - IF (n_iter <= 0)THEN - n_iter = 0 - p0gauss = pgauss - ELSE - p0gauss = pgauss/4._dp**n_iter - END IF - - !Stupid integration - !Do the integration with the exponential centered in i_kern - kernel_scf(:) = 0._dp - DO i_kern=0,n_range - kern = 0._dp - DO i=0,n_scf - absci = x_scf(i) - REAL(i_kern,KIND=dp)*hgrid - absci = absci*absci - kern = kern + y_scf(i)*EXP(-p0gauss*absci)*dx - END DO - kernel_scf(i_kern) = kern - kernel_scf(-i_kern) = kern - IF (ABS(kern) < 1.e-18_dp) THEN - !Too small not useful to calculate - EXIT - END IF - END DO - - !Start the iteration to go from p0gauss to pgauss - CALL scf_recursion(itype_scf,n_iter,n_range,kernel_scf,kern_1_scf) - - !Add to the kernel (only the local part) - - DO i3=istart1,iend - i03 = i3 - n2h -1 - ! Crash if index out of range - ! Without compiler bounds checking, the calculation might run succesfully but - ! it is also possible that the Hartree energy will blow up - ! This seems to happen with large MPI processor counts if the size of the - ! RS grid is not directly compatible with the allowed FFT dimensions in - ! subroutine fourier_dim (ps_wavelet_fft3d.F) - IF (i03 .LT. -n_range .OR. i03 .GT. n_range) THEN - CALL cp_abort(__LOCATION__, "Index out of range in wavelet solver. "// & - "Try decreasing the number of MPI processors, or adjust the PW_CUTOFF or cell size "// & - "so that 2*(number of RS grid points) matches the allowed FFT dimensions "// & - "(see ps_wavelet_fft3d.F) exactly.") - END IF - DO i2=1,n02 - i02 = i2-1 - DO i1=1,n01 - i01 = i1-1 - kp(i1,i2,i3-istart+1) = kp(i1,i2,i3-istart+1) + w_gauss(i_gauss)* & - kernel_scf(i01)*kernel_scf(i02)*kernel_scf(i03) - END DO - END DO - END DO - - END DO loop_gauss - - !De-allocations - DEALLOCATE(kernel_scf) - DEALLOCATE(kern_1_scf) - DEALLOCATE(x_scf) - DEALLOCATE(y_scf) + n_scf = 2*itype_scf*n_points + !Set karray + karray = 0.0_dp + !here we must set the dimensions for the fft part, starting from the nfft + !remember that actually nfft2 is associated to n03 and viceversa + + !dimensions that define the center of symmetry + n1h = nfft1/2 + n2h = nfft2/2 + n3h = nfft3/2 + + !Auxiliary dimensions only for building the FFT part + nker1 = nfft1 + nker2 = nfft2 + nker3 = nfft3/2 + 1 + + !adjusting the last two dimensions to be multiples of nproc + DO + IF (MODULO(nker2, nproc) == 0) EXIT + nker2 = nker2 + 1 + END DO + DO + IF (MODULO(nker3, nproc) == 0) EXIT + nker3 = nker3 + 1 + END DO + + !this will be the array of the kernel in the real space + ALLOCATE (kp(n1h + 1, n3h + 1, nker2/nproc)) + + !defining proper extremes for the calculation of the + !local part of the kernel + + istart = iproc*nker2/nproc + 1 + iend = MIN((iproc + 1)*nker2/nproc, n2h + n03) + + istart1 = istart + IF (iproc .EQ. 0) istart1 = n2h - n03 + 2 + + !Allocations + ALLOCATE (x_scf(0:n_scf)) + ALLOCATE (y_scf(0:n_scf)) + + !Build the scaling function + CALL scaling_function(itype_scf, n_scf, n_range, x_scf, y_scf) + !Step grid for the integration + dx = REAL(n_range, KIND=dp)/REAL(n_scf, KIND=dp) + !Extend the range (no more calculations because fill in by 0._dp) + n_cell = MAX(n01, n02, n03) + n_range = MAX(n_cell, n_range) + + !Allocations + ALLOCATE (kernel_scf(-n_range:n_range)) + ALLOCATE (kern_1_scf(-n_range:n_range)) + + !Lengthes of the box (use FFT dimension) + a1 = hgrid*REAL(n01, KIND=dp) + a2 = hgrid*REAL(n02, KIND=dp) + a3 = hgrid*REAL(n03, KIND=dp) + + x_scf(:) = hgrid*x_scf(:) + y_scf(:) = 1._dp/hgrid*y_scf(:) + dx = hgrid*dx + !To have a correct integration + p0_cell = p0_ref/(hgrid*hgrid) + + !Initialization of the gaussian (Beylkin) + CALL gequad(p_gauss, w_gauss, ur_gauss, dr_gauss, acc_gauss) + !In order to have a range from a_range=sqrt(a1*a1+a2*a2+a3*a3) + !(biggest length in the cube) + !We divide the p_gauss by a_range**2 and a_gauss by a_range + a_range = SQRT(a1*a1 + a2*a2 + a3*a3) + factor = 1._dp/a_range + !factor2 = factor*factor + factor2 = 1._dp/(a1*a1 + a2*a2 + a3*a3) + DO i_gauss = 1, n_gauss + p_gauss(i_gauss) = factor2*p_gauss(i_gauss) + END DO + DO i_gauss = 1, n_gauss + w_gauss(i_gauss) = factor*w_gauss(i_gauss) + END DO + + kp(:, :, :) = 0._dp + !Use in this order (better for accuracy). + loop_gauss: DO i_gauss = n_gauss, 1, -1 + !Gaussian + pgauss = p_gauss(i_gauss) + + !We calculate the number of iterations to go from pgauss to p0_ref + n_iter = NINT((LOG(pgauss) - LOG(p0_cell))/LOG(4._dp)) + IF (n_iter <= 0) THEN + n_iter = 0 + p0gauss = pgauss + ELSE + p0gauss = pgauss/4._dp**n_iter + END IF + + !Stupid integration + !Do the integration with the exponential centered in i_kern + kernel_scf(:) = 0._dp + DO i_kern = 0, n_range + kern = 0._dp + DO i = 0, n_scf + absci = x_scf(i) - REAL(i_kern, KIND=dp)*hgrid + absci = absci*absci + kern = kern + y_scf(i)*EXP(-p0gauss*absci)*dx + END DO + kernel_scf(i_kern) = kern + kernel_scf(-i_kern) = kern + IF (ABS(kern) < 1.e-18_dp) THEN + !Too small not useful to calculate + EXIT + END IF + END DO + + !Start the iteration to go from p0gauss to pgauss + CALL scf_recursion(itype_scf, n_iter, n_range, kernel_scf, kern_1_scf) + + !Add to the kernel (only the local part) + + DO i3 = istart1, iend + i03 = i3 - n2h - 1 + ! Crash if index out of range + ! Without compiler bounds checking, the calculation might run succesfully but + ! it is also possible that the Hartree energy will blow up + ! This seems to happen with large MPI processor counts if the size of the + ! RS grid is not directly compatible with the allowed FFT dimensions in + ! subroutine fourier_dim (ps_wavelet_fft3d.F) + IF (i03 .LT. -n_range .OR. i03 .GT. n_range) THEN + CALL cp_abort(__LOCATION__, "Index out of range in wavelet solver. "// & + "Try decreasing the number of MPI processors, or adjust the PW_CUTOFF or cell size "// & + "so that 2*(number of RS grid points) matches the allowed FFT dimensions "// & + "(see ps_wavelet_fft3d.F) exactly.") + END IF + DO i2 = 1, n02 + i02 = i2 - 1 + DO i1 = 1, n01 + i01 = i1 - 1 + kp(i1, i2, i3 - istart + 1) = kp(i1, i2, i3 - istart + 1) + w_gauss(i_gauss)* & + kernel_scf(i01)*kernel_scf(i02)*kernel_scf(i03) + END DO + END DO + END DO + + END DO loop_gauss + + !De-allocations + DEALLOCATE (kernel_scf) + DEALLOCATE (kern_1_scf) + DEALLOCATE (x_scf) + DEALLOCATE (y_scf) !!!!END KERNEL CONSTRUCTION !!$ if(iproc .eq. 0) print *,"Do a 3D PHalFFT for the kernel" - CALL kernelfft(nfft1,nfft2,nfft3,nker1,nker2,nker3,n1k,n2k,n3k,nproc,iproc,& - kp,karray,mpi_group) + CALL kernelfft(nfft1, nfft2, nfft3, nker1, nker2, nker3, n1k, n2k, n3k, nproc, iproc, & + kp, karray, mpi_group) - !De-allocations - DEALLOCATE(kp) + !De-allocations + DEALLOCATE (kp) -END SUBROUTINE Free_Kernel + END SUBROUTINE Free_Kernel ! ************************************************************************************************** !> \brief ... @@ -1044,7 +1043,7 @@ END SUBROUTINE Free_Kernel !> \param zf ... !> \param zw ... ! ************************************************************************************************** -SUBROUTINE inserthalf(n1,n3,lot,nfft,i1,zf,zw) + SUBROUTINE inserthalf(n1, n3, lot, nfft, i1, zf, zw) INTEGER, INTENT(in) :: n1, n3, lot, nfft, i1 REAL(KIND=dp), DIMENSION(n1/2+1, n3/2+1), & INTENT(in) :: zf @@ -1053,20 +1052,20 @@ SUBROUTINE inserthalf(n1,n3,lot,nfft,i1,zf,zw) INTEGER :: i01, i03i, i03r, i3, l1, l3 - zw = 0.0_dp - i3=0 - DO l3=1,n3,2 - i3=i3+1 - i03r=ABS(l3-n3/2-1)+1 - i03i=ABS(l3-n3/2)+1 - DO l1=1,nfft - i01=ABS(l1-1+i1-n1/2-1)+1 - zw(1,l1,i3)=zf(i01,i03r) - zw(2,l1,i3)=zf(i01,i03i) - END DO - END DO - -END SUBROUTINE inserthalf + zw = 0.0_dp + i3 = 0 + DO l3 = 1, n3, 2 + i3 = i3 + 1 + i03r = ABS(l3 - n3/2 - 1) + 1 + i03i = ABS(l3 - n3/2) + 1 + DO l1 = 1, nfft + i01 = ABS(l1 - 1 + i1 - n1/2 - 1) + 1 + zw(1, l1, i3) = zf(i01, i03r) + zw(2, l1, i3) = zf(i01, i03i) + END DO + END DO + + END SUBROUTINE inserthalf ! ************************************************************************************************** !> \brief (Based on suitable modifications of S.Goedecker routines) @@ -1100,7 +1099,7 @@ END SUBROUTINE inserthalf !> The detailed table with allowed transform lengths can !> be found in subroutine CTRIG ! ************************************************************************************************** -SUBROUTINE kernelfft(n1,n2,n3,nd1,nd2,nd3,nk1,nk2,nk3,nproc,iproc,zf,zr,mpi_group) + SUBROUTINE kernelfft(n1, n2, n3, nd1, nd2, nd3, nk1, nk2, nk3, nproc, iproc, zf, zr, mpi_group) INTEGER, INTENT(in) :: n1, n2, n3, nd1, nd2, nd3, nk1, nk2, & nk3, nproc, iproc @@ -1134,189 +1133,189 @@ SUBROUTINE kernelfft(n1,n2,n3,nd1,nd2,nd3,nk1,nk2,nk3,nproc,iproc,zf,zr,mpi_grou !Body !check input - CPASSERT(nd1.GE.n1) - CPASSERT(nd2.GE.n2) - CPASSERT(nd3.GE.n3/2+1) - CPASSERT(MOD(nd3,nproc).EQ.0) - CPASSERT(MOD(nd2,nproc).EQ.0) - - !defining work arrays dimensions - ncache=ncache_optimal - IF (ncache <= MAX(n1,n2,n3/2)*4) ncache=MAX(n1,n2,n3/2)*4 - lzt=n2 - IF (MOD(n2,2).EQ.0) lzt=lzt+1 - IF (MOD(n2,4).EQ.0) lzt=lzt+1 - - !Allocations - ALLOCATE(trig1(2,ctrig_length)) - ALLOCATE(after1(7)) - ALLOCATE(now1(7)) - ALLOCATE(before1(7)) - ALLOCATE(trig2(2,ctrig_length)) - ALLOCATE(after2(7)) - ALLOCATE(now2(7)) - ALLOCATE(before2(7)) - ALLOCATE(trig3(2,ctrig_length)) - ALLOCATE(after3(7)) - ALLOCATE(now3(7)) - ALLOCATE(before3(7)) - ALLOCATE(zw(2,ncache/4,2)) - ALLOCATE(zt(2,lzt,n1)) - ALLOCATE(zmpi2(2,n1,nd2/nproc,nd3)) - ALLOCATE(cosinarr(2,n3/2)) - IF (nproc.GT.1) THEN - ALLOCATE(zmpi1(2,n1,nd2/nproc,nd3/nproc,nproc)) - zmpi1 = 0.0_dp - END IF - - zmpi2 = 0.0_dp - !calculating the FFT work arrays (beware on the HalFFT in n3 dimension) - CALL ctrig(n3/2,trig3,after3,before3,now3,1,ic3) - CALL ctrig(n1,trig1,after1,before1,now1,1,ic1) - CALL ctrig(n2,trig2,after2,before2,now2,1,ic2) - - !Calculating array of phases for HalFFT decoding - twopion=8._dp*ATAN(1._dp)/REAL(n3,KIND=dp) - DO i3=1,n3/2 - cosinarr(1,i3)=COS(twopion*(i3-1)) - cosinarr(2,i3)=-SIN(twopion*(i3-1)) - END DO - - !transform along z axis - - lot=ncache/(2*n3) - CPASSERT(lot.GE.1) - - DO j2=1,nd2/nproc - !this condition ensures that we manage only the interesting part for the FFT - IF (iproc*(nd2/nproc)+j2.LE.n2) THEN - DO i1=1,n1,lot - ma=i1 - mb=MIN(i1+(lot-1),n1) - nfft=mb-ma+1 - - !inserting real data into complex array of half lenght - !input: I1,I3,J2,(Jp2) - - CALL inserthalf(n1,n3,lot,nfft,i1,zf(1,1,j2),zw(1,1,1)) - - !performing FFT - inzee=1 - DO i=1,ic3 - CALL fftstp(lot,nfft,n3/2,lot,n3/2,zw(1,1,inzee),zw(1,1,3-inzee), & - trig3,after3(i),now3(i),before3(i),1) - inzee=3-inzee - ENDDO - !output: I1,i3,J2,(Jp2) - - !unpacking FFT in order to restore correct result, - !while exchanging components - !input: I1,i3,J2,(Jp2) - CALL scramble_unpack(i1,j2,lot,nfft,n1,n3,nd2,nproc,nd3,zw(1,1,inzee),zmpi2,cosinarr) - !output: I1,J2,i3,(Jp2) - END DO - ENDIF - END DO - - !Interprocessor data transposition - !input: I1,J2,j3,jp3,(Jp2) - IF (nproc.GT.1) THEN - !communication scheduling - CALL mp_alltoall(zmpi2,&!2*n1*(nd2/nproc)*(nd3/nproc), & - zmpi1,2*n1*(nd2/nproc)*(nd3/nproc), & - mpi_group) - ! output: I1,J2,j3,Jp2,(jp3) - ENDIF - - DO j3=1,nd3/nproc - !this condition ensures that we manage only the interesting part for the FFT - IF (iproc*(nd3/nproc)+j3.LE.n3/2+1) THEN - Jp2st=1 - J2st=1 - - !transform along x axis - lot=ncache/(4*n1) - CPASSERT(lot.GE.1) - - DO j=1,n2,lot - ma=j - mb=MIN(j+(lot-1),n2) - nfft=mb-ma+1 - - !reverse ordering - !input: I1,J2,j3,Jp2,(jp3) - IF (nproc.EQ.1) THEN - CALL mpiswitch(j3,nfft,Jp2st,J2st,lot,n1,nd2,nd3,nproc,zmpi2,zw(1,1,1)) - ELSE - CALL mpiswitch(j3,nfft,Jp2st,J2st,lot,n1,nd2,nd3,nproc,zmpi1,zw(1,1,1)) - ENDIF - !output: J2,Jp2,I1,j3,(jp3) - - !performing FFT - !input: I2,I1,j3,(jp3) - inzee=1 - DO i=1,ic1-1 - CALL fftstp(lot,nfft,n1,lot,n1,zw(1,1,inzee),zw(1,1,3-inzee), & - trig1,after1(i),now1(i),before1(i),1) - inzee=3-inzee - ENDDO - !storing the last step into zt - i=ic1 - CALL fftstp(lot,nfft,n1,lzt,n1,zw(1,1,inzee),zt(1,j,1), & - trig1,after1(i),now1(i),before1(i),1) - !output: I2,i1,j3,(jp3) - END DO - - !transform along y axis, and taking only the first half - lot=ncache/(4*n2) - CPASSERT(lot.GE.1) - - DO j=1,nk1,lot - ma=j - mb=MIN(j+(lot-1),nk1) - nfft=mb-ma+1 - - !reverse ordering - !input: I2,i1,j3,(jp3) - CALL switch(nfft,n2,lot,n1,lzt,zt(1,1,j),zw(1,1,1)) - !output: i1,I2,j3,(jp3) - - !performing FFT - !input: i1,I2,j3,(jp3) - inzee=1 - DO i=1,ic2 - CALL fftstp(lot,nfft,n2,lot,n2,zw(1,1,inzee),zw(1,1,3-inzee), & - trig2,after2(i),now2(i),before2(i),1) - inzee=3-inzee - ENDDO - - CALL realcopy(lot,nfft,n2,nk1,nk2,zw(1,1,inzee),zr(j,1,j3)) - - END DO - !output: i1,i2,j3,(jp3) - ENDIF - END DO - - !De-allocations - DEALLOCATE(trig1) - DEALLOCATE(after1) - DEALLOCATE(now1) - DEALLOCATE(before1) - DEALLOCATE(trig2) - DEALLOCATE(after2) - DEALLOCATE(now2) - DEALLOCATE(before2) - DEALLOCATE(trig3) - DEALLOCATE(after3) - DEALLOCATE(now3) - DEALLOCATE(before3) - DEALLOCATE(zmpi2) - DEALLOCATE(zw) - DEALLOCATE(zt) - DEALLOCATE(cosinarr) - IF (nproc.GT.1) DEALLOCATE(zmpi1) - -END SUBROUTINE kernelfft + CPASSERT(nd1 .GE. n1) + CPASSERT(nd2 .GE. n2) + CPASSERT(nd3 .GE. n3/2 + 1) + CPASSERT(MOD(nd3, nproc) .EQ. 0) + CPASSERT(MOD(nd2, nproc) .EQ. 0) + + !defining work arrays dimensions + ncache = ncache_optimal + IF (ncache <= MAX(n1, n2, n3/2)*4) ncache = MAX(n1, n2, n3/2)*4 + lzt = n2 + IF (MOD(n2, 2) .EQ. 0) lzt = lzt + 1 + IF (MOD(n2, 4) .EQ. 0) lzt = lzt + 1 + + !Allocations + ALLOCATE (trig1(2, ctrig_length)) + ALLOCATE (after1(7)) + ALLOCATE (now1(7)) + ALLOCATE (before1(7)) + ALLOCATE (trig2(2, ctrig_length)) + ALLOCATE (after2(7)) + ALLOCATE (now2(7)) + ALLOCATE (before2(7)) + ALLOCATE (trig3(2, ctrig_length)) + ALLOCATE (after3(7)) + ALLOCATE (now3(7)) + ALLOCATE (before3(7)) + ALLOCATE (zw(2, ncache/4, 2)) + ALLOCATE (zt(2, lzt, n1)) + ALLOCATE (zmpi2(2, n1, nd2/nproc, nd3)) + ALLOCATE (cosinarr(2, n3/2)) + IF (nproc .GT. 1) THEN + ALLOCATE (zmpi1(2, n1, nd2/nproc, nd3/nproc, nproc)) + zmpi1 = 0.0_dp + END IF + + zmpi2 = 0.0_dp + !calculating the FFT work arrays (beware on the HalFFT in n3 dimension) + CALL ctrig(n3/2, trig3, after3, before3, now3, 1, ic3) + CALL ctrig(n1, trig1, after1, before1, now1, 1, ic1) + CALL ctrig(n2, trig2, after2, before2, now2, 1, ic2) + + !Calculating array of phases for HalFFT decoding + twopion = 8._dp*ATAN(1._dp)/REAL(n3, KIND=dp) + DO i3 = 1, n3/2 + cosinarr(1, i3) = COS(twopion*(i3 - 1)) + cosinarr(2, i3) = -SIN(twopion*(i3 - 1)) + END DO + + !transform along z axis + + lot = ncache/(2*n3) + CPASSERT(lot .GE. 1) + + DO j2 = 1, nd2/nproc + !this condition ensures that we manage only the interesting part for the FFT + IF (iproc*(nd2/nproc) + j2 .LE. n2) THEN + DO i1 = 1, n1, lot + ma = i1 + mb = MIN(i1 + (lot - 1), n1) + nfft = mb - ma + 1 + + !inserting real data into complex array of half lenght + !input: I1,I3,J2,(Jp2) + + CALL inserthalf(n1, n3, lot, nfft, i1, zf(1, 1, j2), zw(1, 1, 1)) + + !performing FFT + inzee = 1 + DO i = 1, ic3 + CALL fftstp(lot, nfft, n3/2, lot, n3/2, zw(1, 1, inzee), zw(1, 1, 3 - inzee), & + trig3, after3(i), now3(i), before3(i), 1) + inzee = 3 - inzee + ENDDO + !output: I1,i3,J2,(Jp2) + + !unpacking FFT in order to restore correct result, + !while exchanging components + !input: I1,i3,J2,(Jp2) + CALL scramble_unpack(i1, j2, lot, nfft, n1, n3, nd2, nproc, nd3, zw(1, 1, inzee), zmpi2, cosinarr) + !output: I1,J2,i3,(Jp2) + END DO + ENDIF + END DO + + !Interprocessor data transposition + !input: I1,J2,j3,jp3,(Jp2) + IF (nproc .GT. 1) THEN + !communication scheduling + CALL mp_alltoall(zmpi2, &!2*n1*(nd2/nproc)*(nd3/nproc), & + zmpi1, 2*n1*(nd2/nproc)*(nd3/nproc), & + mpi_group) + ! output: I1,J2,j3,Jp2,(jp3) + ENDIF + + DO j3 = 1, nd3/nproc + !this condition ensures that we manage only the interesting part for the FFT + IF (iproc*(nd3/nproc) + j3 .LE. n3/2 + 1) THEN + Jp2st = 1 + J2st = 1 + + !transform along x axis + lot = ncache/(4*n1) + CPASSERT(lot .GE. 1) + + DO j = 1, n2, lot + ma = j + mb = MIN(j + (lot - 1), n2) + nfft = mb - ma + 1 + + !reverse ordering + !input: I1,J2,j3,Jp2,(jp3) + IF (nproc .EQ. 1) THEN + CALL mpiswitch(j3, nfft, Jp2st, J2st, lot, n1, nd2, nd3, nproc, zmpi2, zw(1, 1, 1)) + ELSE + CALL mpiswitch(j3, nfft, Jp2st, J2st, lot, n1, nd2, nd3, nproc, zmpi1, zw(1, 1, 1)) + ENDIF + !output: J2,Jp2,I1,j3,(jp3) + + !performing FFT + !input: I2,I1,j3,(jp3) + inzee = 1 + DO i = 1, ic1 - 1 + CALL fftstp(lot, nfft, n1, lot, n1, zw(1, 1, inzee), zw(1, 1, 3 - inzee), & + trig1, after1(i), now1(i), before1(i), 1) + inzee = 3 - inzee + ENDDO + !storing the last step into zt + i = ic1 + CALL fftstp(lot, nfft, n1, lzt, n1, zw(1, 1, inzee), zt(1, j, 1), & + trig1, after1(i), now1(i), before1(i), 1) + !output: I2,i1,j3,(jp3) + END DO + + !transform along y axis, and taking only the first half + lot = ncache/(4*n2) + CPASSERT(lot .GE. 1) + + DO j = 1, nk1, lot + ma = j + mb = MIN(j + (lot - 1), nk1) + nfft = mb - ma + 1 + + !reverse ordering + !input: I2,i1,j3,(jp3) + CALL switch(nfft, n2, lot, n1, lzt, zt(1, 1, j), zw(1, 1, 1)) + !output: i1,I2,j3,(jp3) + + !performing FFT + !input: i1,I2,j3,(jp3) + inzee = 1 + DO i = 1, ic2 + CALL fftstp(lot, nfft, n2, lot, n2, zw(1, 1, inzee), zw(1, 1, 3 - inzee), & + trig2, after2(i), now2(i), before2(i), 1) + inzee = 3 - inzee + ENDDO + + CALL realcopy(lot, nfft, n2, nk1, nk2, zw(1, 1, inzee), zr(j, 1, j3)) + + END DO + !output: i1,i2,j3,(jp3) + ENDIF + END DO + + !De-allocations + DEALLOCATE (trig1) + DEALLOCATE (after1) + DEALLOCATE (now1) + DEALLOCATE (before1) + DEALLOCATE (trig2) + DEALLOCATE (after2) + DEALLOCATE (now2) + DEALLOCATE (before2) + DEALLOCATE (trig3) + DEALLOCATE (after3) + DEALLOCATE (now3) + DEALLOCATE (before3) + DEALLOCATE (zmpi2) + DEALLOCATE (zw) + DEALLOCATE (zt) + DEALLOCATE (cosinarr) + IF (nproc .GT. 1) DEALLOCATE (zmpi1) + + END SUBROUTINE kernelfft ! ************************************************************************************************** !> \brief ... @@ -1328,20 +1327,20 @@ END SUBROUTINE kernelfft !> \param zin ... !> \param zout ... ! ************************************************************************************************** -SUBROUTINE realcopy(lot,nfft,n2,nk1,nk2,zin,zout) + SUBROUTINE realcopy(lot, nfft, n2, nk1, nk2, zin, zout) INTEGER, INTENT(in) :: lot, nfft, n2, nk1, nk2 REAL(KIND=dp), DIMENSION(2, lot, n2), INTENT(in) :: zin REAL(KIND=dp), DIMENSION(nk1, nk2), INTENT(inout) :: zout INTEGER :: i, j - DO i=1,nk2 - DO j=1,nfft - zout(j,i)=zin(1,j,i) - END DO - END DO + DO i = 1, nk2 + DO j = 1, nfft + zout(j, i) = zin(1, j, i) + END DO + END DO -END SUBROUTINE realcopy + END SUBROUTINE realcopy ! ************************************************************************************************** !> \brief ... @@ -1353,20 +1352,20 @@ END SUBROUTINE realcopy !> \param zt ... !> \param zw ... ! ************************************************************************************************** -SUBROUTINE switch(nfft,n2,lot,n1,lzt,zt,zw) + SUBROUTINE switch(nfft, n2, lot, n1, lzt, zt, zw) INTEGER :: nfft, n2, lot, n1, lzt - REAL(KIND=dp) :: zt(2,lzt,n1), zw(2,lot,n2) + REAL(KIND=dp) :: zt(2, lzt, n1), zw(2, lot, n2) INTEGER :: i, j - DO 200,j=1,nfft - DO 100,i=1,n2 - zw(1,j,i)=zt(1,i,j) - zw(2,j,i)=zt(2,i,j) -100 CONTINUE -200 CONTINUE - RETURN - END SUBROUTINE switch + DO 200, j = 1, nfft + DO 100, i = 1, n2 + zw(1, j, i) = zt(1, i, j) + zw(2, j, i) = zt(2, i, j) +100 CONTINUE +200 CONTINUE + RETURN + END SUBROUTINE switch ! ************************************************************************************************** !> \brief ... @@ -1382,30 +1381,30 @@ END SUBROUTINE switch !> \param zmpi1 ... !> \param zw ... ! ************************************************************************************************** - SUBROUTINE mpiswitch(j3,nfft,Jp2st,J2st,lot,n1,nd2,nd3,nproc,zmpi1,zw) + SUBROUTINE mpiswitch(j3, nfft, Jp2st, J2st, lot, n1, nd2, nd3, nproc, zmpi1, zw) INTEGER :: j3, nfft, Jp2st, J2st, lot, n1, nd2, & nd3, nproc - REAL(KIND=dp) :: zmpi1(2,n1,nd2/nproc,nd3/nproc,nproc), zw(2,lot,n1) + REAL(KIND=dp) :: zmpi1(2, n1, nd2/nproc, nd3/nproc, nproc), zw(2, lot, n1) INTEGER :: I1, J2, JP2, mfft - mfft=0 - DO 300,Jp2=Jp2st,nproc - DO 200,J2=J2st,nd2/nproc - mfft=mfft+1 - IF (mfft.GT.nfft) THEN - Jp2st=Jp2 - J2st=J2 - RETURN - ENDIF - DO 100,I1=1,n1 - zw(1,mfft,I1)=zmpi1(1,I1,J2,j3,Jp2) - zw(2,mfft,I1)=zmpi1(2,I1,J2,j3,Jp2) -100 CONTINUE -200 CONTINUE - J2st=1 -300 CONTINUE - END SUBROUTINE mpiswitch + mfft = 0 + DO 300, Jp2 = Jp2st, nproc + DO 200, J2 = J2st, nd2/nproc + mfft = mfft + 1 + IF (mfft .GT. nfft) THEN + Jp2st = Jp2 + J2st = J2 + RETURN + ENDIF + DO 100, I1 = 1, n1 + zw(1, mfft, I1) = zmpi1(1, I1, J2, j3, Jp2) + zw(2, mfft, I1) = zmpi1(2, I1, J2, j3, Jp2) +100 CONTINUE +200 CONTINUE + J2st = 1 +300 CONTINUE + END SUBROUTINE mpiswitch ! ************************************************************************************************** !> \brief ... @@ -1415,7 +1414,7 @@ END SUBROUTINE mpiswitch !> \param drange ... !> \param acc ... ! ************************************************************************************************** - SUBROUTINE gequad(p,w,urange,drange,acc) + SUBROUTINE gequad(p, w, urange, drange, acc) ! REAL(KIND=dp) :: p(*), w(*), urange, drange, acc @@ -1425,192 +1424,192 @@ SUBROUTINE gequad(p,w,urange,drange,acc) ! ! - p(1)=4.96142640560223544e19_dp - p(2)=1.37454269147978052e19_dp - p(3)=7.58610013441204679e18_dp - p(4)=4.42040691347806996e18_dp - p(5)=2.61986077948367892e18_dp - p(6)=1.56320138155496681e18_dp - p(7)=9.35645215863028402e17_dp - p(8)=5.60962910452691703e17_dp - p(9)=3.3666225119686761e17_dp - p(10)=2.0218253197947866e17_dp - p(11)=1.21477756091902017e17_dp - p(12)=7.3012982513608503e16_dp - p(13)=4.38951893556421099e16_dp - p(14)=2.63949482512262325e16_dp - p(15)=1.58742054072786174e16_dp - p(16)=9.54806587737665531e15_dp - p(17)=5.74353712364571709e15_dp - p(18)=3.455214877389445e15_dp - p(19)=2.07871658520326804e15_dp - p(20)=1.25064667315629928e15_dp - p(21)=7.52469429541933745e14_dp - p(22)=4.5274603337253175e14_dp - p(23)=2.72414006900059548e14_dp - p(24)=1.63912168349216752e14_dp - p(25)=9.86275802590865738e13_dp - p(26)=5.93457701624974985e13_dp - p(27)=3.5709554322296296e13_dp - p(28)=2.14872890367310454e13_dp - p(29)=1.29294719957726902e13_dp - p(30)=7.78003375426361016e12_dp - p(31)=4.68148199759876704e12_dp - p(32)=2.8169955024829868e12_dp - p(33)=1.69507790481958464e12_dp - p(34)=1.01998486064607581e12_dp - p(35)=6.13759486539856459e11_dp - p(36)=3.69320183828682544e11_dp - p(37)=2.22232783898905102e11_dp - p(38)=1.33725247623668682e11_dp - p(39)=8.0467192739036288e10_dp - p(40)=4.84199582415144143e10_dp - p(41)=2.91360091170559564e10_dp - p(42)=1.75321747475309216e10_dp - p(43)=1.0549735552210995e10_dp - p(44)=6.34815321079006586e9_dp - p(45)=3.81991113733594231e9_dp - p(46)=2.29857747533101109e9_dp - p(47)=1.38313653595483694e9_dp - p(48)=8.32282908580025358e8_dp - p(49)=5.00814519374587467e8_dp - p(50)=3.01358090773319025e8_dp - p(51)=1.81337994217503535e8_dp - p(52)=1.09117589961086823e8_dp - p(53)=6.56599771718640323e7_dp - p(54)=3.95099693638497164e7_dp - p(55)=2.37745694710665991e7_dp - p(56)=1.43060135285912813e7_dp - p(57)=8.60844290313506695e6_dp - p(58)=5.18000974075383424e6_dp - p(59)=3.116998193057466e6_dp - p(60)=1.87560993870024029e6_dp - p(61)=1.12862197183979562e6_dp - p(62)=679132.441326077231_dp - p(63)=408658.421279877969_dp - p(64)=245904.473450669789_dp - p(65)=147969.568088321005_dp - p(66)=89038.612357311147_dp - p(67)=53577.7362552358895_dp - p(68)=32239.6513926914668_dp - p(69)=19399.7580852362791_dp - p(70)=11673.5323603058634_dp - p(71)=7024.38438577707758_dp - p(72)=4226.82479307685999_dp - p(73)=2543.43254175354295_dp - p(74)=1530.47486269122675_dp - p(75)=920.941785160749482_dp - p(76)=554.163803906291646_dp - p(77)=333.46029740785694_dp - p(78)=200.6550575335041_dp - p(79)=120.741366914147284_dp - p(80)=72.6544243200329916_dp - p(81)=43.7187810415471025_dp - p(82)=26.3071631447061043_dp - p(83)=15.8299486353816329_dp - p(84)=9.52493152341244004_dp - p(85)=5.72200417067776041_dp - p(86)=3.36242234070940928_dp - p(87)=1.75371394604499472_dp - p(88)=0.64705932650658966_dp - p(89)=0.072765905943708247_dp - ! - w(1)=47.67445484528304247e10_dp - w(2)=11.37485774750442175e9_dp - w(3)=78.64340976880190239e8_dp - w(4)=46.27335788759590498e8_dp - w(5)=24.7380464827152951e8_dp - w(6)=13.62904116438987719e8_dp - w(7)=92.79560029045882433e8_dp - w(8)=52.15931216254660251e8_dp - w(9)=31.67018011061666244e8_dp - w(10)=1.29291036801493046e8_dp - w(11)=1.00139319988015862e8_dp - w(12)=7.75892350510188341e7_dp - w(13)=6.01333567950731271e7_dp - w(14)=4.66141178654796875e7_dp - w(15)=3.61398903394911448e7_dp - w(16)=2.80225846672956389e7_dp - w(17)=2.1730509180930247e7_dp - w(18)=1.68524482625876965e7_dp - w(19)=1.30701489345870338e7_dp - w(20)=1.01371784832269282e7_dp - w(21)=7.86264116300379329e6_dp - w(22)=6.09861667912273717e6_dp - w(23)=4.73045784039455683e6_dp - w(24)=3.66928949951594161e6_dp - w(25)=2.8462050836230259e6_dp - w(26)=2.20777394798527011e6_dp - w(27)=1.71256191589205524e6_dp - w(28)=1.32843556197737076e6_dp - w(29)=1.0304731275955989e6_dp - w(30)=799345.206572271448_dp - w(31)=620059.354143595343_dp - w(32)=480986.704107449333_dp - w(33)=373107.167700228515_dp - w(34)=289424.08337412132_dp - w(35)=224510.248231581788_dp - w(36)=174155.825690028966_dp - w(37)=135095.256919654065_dp - w(38)=104795.442776800312_dp - w(39)=81291.4458222430418_dp - w(40)=63059.0493649328682_dp - w(41)=48915.9040455329689_dp - w(42)=37944.8484018048756_dp - w(43)=29434.4290473253969_dp - w(44)=22832.7622054490044_dp - w(45)=17711.743950151233_dp - w(46)=13739.287867104177_dp - w(47)=10657.7895710752585_dp - w(48)=8267.42141053961834_dp - w(49)=6413.17397520136448_dp - w(50)=4974.80402838654277_dp - w(51)=3859.03698188553047_dp - w(52)=2993.51824493299154_dp - w(53)=2322.1211966811754_dp - w(54)=1801.30750964719641_dp - w(55)=1397.30379659817038_dp - w(56)=1083.91149143250697_dp - w(57)=840.807939169209188_dp - w(58)=652.228524366749422_dp - w(59)=505.944376983506128_dp - w(60)=392.469362317941064_dp - w(61)=304.444930257324312_dp - w(62)=236.162932842453601_dp - w(63)=183.195466078603525_dp - w(64)=142.107732186551471_dp - w(65)=110.23530215723992_dp - w(66)=85.5113346705382257_dp - w(67)=66.3325469806696621_dp - w(68)=51.4552463353841373_dp - w(69)=39.9146798429449273_dp - w(70)=30.9624728409162095_dp - w(71)=24.018098812215013_dp - w(72)=18.6312338024296588_dp - w(73)=14.4525541233150501_dp - w(74)=11.2110836519105938_dp - w(75)=8.69662175848497178_dp - w(76)=6.74611236165731961_dp - w(77)=5.23307018057529994_dp - w(78)=4.05937850501539556_dp - w(79)=3.14892659076635714_dp - w(80)=2.44267408211071604_dp - w(81)=1.89482240522855261_dp - w(82)=1.46984505907050079_dp - w(83)=1.14019261330527007_dp - w(84)=0.884791217422925293_dp - w(85)=0.692686387080616483_dp - w(86)=0.585244576897023282_dp - w(87)=0.576182522545327589_dp - w(88)=0.596688817388997178_dp - w(89)=0.607879901151108771_dp - ! - ! - urange = 1._dp - drange=1e-08_dp - acc =1e-08_dp - ! - RETURN - END SUBROUTINE gequad - -END MODULE ps_wavelet_kernel + p(1) = 4.96142640560223544e19_dp + p(2) = 1.37454269147978052e19_dp + p(3) = 7.58610013441204679e18_dp + p(4) = 4.42040691347806996e18_dp + p(5) = 2.61986077948367892e18_dp + p(6) = 1.56320138155496681e18_dp + p(7) = 9.35645215863028402e17_dp + p(8) = 5.60962910452691703e17_dp + p(9) = 3.3666225119686761e17_dp + p(10) = 2.0218253197947866e17_dp + p(11) = 1.21477756091902017e17_dp + p(12) = 7.3012982513608503e16_dp + p(13) = 4.38951893556421099e16_dp + p(14) = 2.63949482512262325e16_dp + p(15) = 1.58742054072786174e16_dp + p(16) = 9.54806587737665531e15_dp + p(17) = 5.74353712364571709e15_dp + p(18) = 3.455214877389445e15_dp + p(19) = 2.07871658520326804e15_dp + p(20) = 1.25064667315629928e15_dp + p(21) = 7.52469429541933745e14_dp + p(22) = 4.5274603337253175e14_dp + p(23) = 2.72414006900059548e14_dp + p(24) = 1.63912168349216752e14_dp + p(25) = 9.86275802590865738e13_dp + p(26) = 5.93457701624974985e13_dp + p(27) = 3.5709554322296296e13_dp + p(28) = 2.14872890367310454e13_dp + p(29) = 1.29294719957726902e13_dp + p(30) = 7.78003375426361016e12_dp + p(31) = 4.68148199759876704e12_dp + p(32) = 2.8169955024829868e12_dp + p(33) = 1.69507790481958464e12_dp + p(34) = 1.01998486064607581e12_dp + p(35) = 6.13759486539856459e11_dp + p(36) = 3.69320183828682544e11_dp + p(37) = 2.22232783898905102e11_dp + p(38) = 1.33725247623668682e11_dp + p(39) = 8.0467192739036288e10_dp + p(40) = 4.84199582415144143e10_dp + p(41) = 2.91360091170559564e10_dp + p(42) = 1.75321747475309216e10_dp + p(43) = 1.0549735552210995e10_dp + p(44) = 6.34815321079006586e9_dp + p(45) = 3.81991113733594231e9_dp + p(46) = 2.29857747533101109e9_dp + p(47) = 1.38313653595483694e9_dp + p(48) = 8.32282908580025358e8_dp + p(49) = 5.00814519374587467e8_dp + p(50) = 3.01358090773319025e8_dp + p(51) = 1.81337994217503535e8_dp + p(52) = 1.09117589961086823e8_dp + p(53) = 6.56599771718640323e7_dp + p(54) = 3.95099693638497164e7_dp + p(55) = 2.37745694710665991e7_dp + p(56) = 1.43060135285912813e7_dp + p(57) = 8.60844290313506695e6_dp + p(58) = 5.18000974075383424e6_dp + p(59) = 3.116998193057466e6_dp + p(60) = 1.87560993870024029e6_dp + p(61) = 1.12862197183979562e6_dp + p(62) = 679132.441326077231_dp + p(63) = 408658.421279877969_dp + p(64) = 245904.473450669789_dp + p(65) = 147969.568088321005_dp + p(66) = 89038.612357311147_dp + p(67) = 53577.7362552358895_dp + p(68) = 32239.6513926914668_dp + p(69) = 19399.7580852362791_dp + p(70) = 11673.5323603058634_dp + p(71) = 7024.38438577707758_dp + p(72) = 4226.82479307685999_dp + p(73) = 2543.43254175354295_dp + p(74) = 1530.47486269122675_dp + p(75) = 920.941785160749482_dp + p(76) = 554.163803906291646_dp + p(77) = 333.46029740785694_dp + p(78) = 200.6550575335041_dp + p(79) = 120.741366914147284_dp + p(80) = 72.6544243200329916_dp + p(81) = 43.7187810415471025_dp + p(82) = 26.3071631447061043_dp + p(83) = 15.8299486353816329_dp + p(84) = 9.52493152341244004_dp + p(85) = 5.72200417067776041_dp + p(86) = 3.36242234070940928_dp + p(87) = 1.75371394604499472_dp + p(88) = 0.64705932650658966_dp + p(89) = 0.072765905943708247_dp + ! + w(1) = 47.67445484528304247e10_dp + w(2) = 11.37485774750442175e9_dp + w(3) = 78.64340976880190239e8_dp + w(4) = 46.27335788759590498e8_dp + w(5) = 24.7380464827152951e8_dp + w(6) = 13.62904116438987719e8_dp + w(7) = 92.79560029045882433e8_dp + w(8) = 52.15931216254660251e8_dp + w(9) = 31.67018011061666244e8_dp + w(10) = 1.29291036801493046e8_dp + w(11) = 1.00139319988015862e8_dp + w(12) = 7.75892350510188341e7_dp + w(13) = 6.01333567950731271e7_dp + w(14) = 4.66141178654796875e7_dp + w(15) = 3.61398903394911448e7_dp + w(16) = 2.80225846672956389e7_dp + w(17) = 2.1730509180930247e7_dp + w(18) = 1.68524482625876965e7_dp + w(19) = 1.30701489345870338e7_dp + w(20) = 1.01371784832269282e7_dp + w(21) = 7.86264116300379329e6_dp + w(22) = 6.09861667912273717e6_dp + w(23) = 4.73045784039455683e6_dp + w(24) = 3.66928949951594161e6_dp + w(25) = 2.8462050836230259e6_dp + w(26) = 2.20777394798527011e6_dp + w(27) = 1.71256191589205524e6_dp + w(28) = 1.32843556197737076e6_dp + w(29) = 1.0304731275955989e6_dp + w(30) = 799345.206572271448_dp + w(31) = 620059.354143595343_dp + w(32) = 480986.704107449333_dp + w(33) = 373107.167700228515_dp + w(34) = 289424.08337412132_dp + w(35) = 224510.248231581788_dp + w(36) = 174155.825690028966_dp + w(37) = 135095.256919654065_dp + w(38) = 104795.442776800312_dp + w(39) = 81291.4458222430418_dp + w(40) = 63059.0493649328682_dp + w(41) = 48915.9040455329689_dp + w(42) = 37944.8484018048756_dp + w(43) = 29434.4290473253969_dp + w(44) = 22832.7622054490044_dp + w(45) = 17711.743950151233_dp + w(46) = 13739.287867104177_dp + w(47) = 10657.7895710752585_dp + w(48) = 8267.42141053961834_dp + w(49) = 6413.17397520136448_dp + w(50) = 4974.80402838654277_dp + w(51) = 3859.03698188553047_dp + w(52) = 2993.51824493299154_dp + w(53) = 2322.1211966811754_dp + w(54) = 1801.30750964719641_dp + w(55) = 1397.30379659817038_dp + w(56) = 1083.91149143250697_dp + w(57) = 840.807939169209188_dp + w(58) = 652.228524366749422_dp + w(59) = 505.944376983506128_dp + w(60) = 392.469362317941064_dp + w(61) = 304.444930257324312_dp + w(62) = 236.162932842453601_dp + w(63) = 183.195466078603525_dp + w(64) = 142.107732186551471_dp + w(65) = 110.23530215723992_dp + w(66) = 85.5113346705382257_dp + w(67) = 66.3325469806696621_dp + w(68) = 51.4552463353841373_dp + w(69) = 39.9146798429449273_dp + w(70) = 30.9624728409162095_dp + w(71) = 24.018098812215013_dp + w(72) = 18.6312338024296588_dp + w(73) = 14.4525541233150501_dp + w(74) = 11.2110836519105938_dp + w(75) = 8.69662175848497178_dp + w(76) = 6.74611236165731961_dp + w(77) = 5.23307018057529994_dp + w(78) = 4.05937850501539556_dp + w(79) = 3.14892659076635714_dp + w(80) = 2.44267408211071604_dp + w(81) = 1.89482240522855261_dp + w(82) = 1.46984505907050079_dp + w(83) = 1.14019261330527007_dp + w(84) = 0.884791217422925293_dp + w(85) = 0.692686387080616483_dp + w(86) = 0.585244576897023282_dp + w(87) = 0.576182522545327589_dp + w(88) = 0.596688817388997178_dp + w(89) = 0.607879901151108771_dp + ! + ! + urange = 1._dp + drange = 1e-08_dp + acc = 1e-08_dp + ! + RETURN + END SUBROUTINE gequad + + END MODULE ps_wavelet_kernel diff --git a/src/pw/ps_wavelet_methods.F b/src/pw/ps_wavelet_methods.F index 7ff4fedd4e..abd092a559 100644 --- a/src/pw/ps_wavelet_methods.F +++ b/src/pw/ps_wavelet_methods.F @@ -202,7 +202,7 @@ SUBROUTINE cp2k_distribution_to_z_slices(density, wavelet, pw_grid) DO j = lb(2), ub(2) DO i = lb(1), ub(1) sbuf(ii) = density%cr3d(i, j, k) - ii = ii+1 + ii = ii + 1 END DO END DO END DO @@ -235,39 +235,39 @@ SUBROUTINE cp2k_distribution_to_z_slices(density, wavelet, pw_grid) IF (should_warn > 0 .AND. iproc == 0) & CPWARN("Density non-zero on the edges of the unit cell: wrong results in WAVELET solver") - DO i = 0, pw_grid%para%rs_dims(1)-1 - DO j = 0, pw_grid%para%rs_dims(2)-1 + DO i = 0, pw_grid%para%rs_dims(1) - 1 + DO j = 0, pw_grid%para%rs_dims(2) - 1 cart_pos = (/i, j/) CALL mp_cart_rank(pw_grid%para%rs_group, & cart_pos, & dest) IF ((ub(1) .GE. lb(1)) .AND. (ub(2) .GE. lb(2))) THEN IF (dest*local_z_dim .LE. m2) THEN - IF ((dest+1)*local_z_dim .LE. m2) THEN - scount(dest+1) = ABS((ub(1)-lb(1)+1)*(ub(2)-lb(2)+1)*local_z_dim) + IF ((dest + 1)*local_z_dim .LE. m2) THEN + scount(dest + 1) = ABS((ub(1) - lb(1) + 1)*(ub(2) - lb(2) + 1)*local_z_dim) ELSE - scount(dest+1) = ABS((ub(1)-lb(1)+1)*(ub(2)-lb(2)+1)*MOD(m2, local_z_dim)) + scount(dest + 1) = ABS((ub(1) - lb(1) + 1)*(ub(2) - lb(2) + 1)*MOD(m2, local_z_dim)) END IF ELSE - scount(dest+1) = 0 + scount(dest + 1) = 0 END IF ELSE - scount(dest+1) = 0 + scount(dest + 1) = 0 END IF lox = get_limit(pw_grid%npts(1), pw_grid%para%rs_dims(1), i) loy = get_limit(pw_grid%npts(2), pw_grid%para%rs_dims(2), j) IF ((lox(2) .GE. lox(1)) .AND. (loy(2) .GE. loy(1))) THEN IF (iproc*local_z_dim .LE. m2) THEN - IF ((iproc+1)*local_z_dim .LE. m2) THEN - rcount(dest+1) = ABS((lox(2)-lox(1)+1)*(loy(2)-loy(1)+1)*local_z_dim) + IF ((iproc + 1)*local_z_dim .LE. m2) THEN + rcount(dest + 1) = ABS((lox(2) - lox(1) + 1)*(loy(2) - loy(1) + 1)*local_z_dim) ELSE - rcount(dest+1) = ABS((lox(2)-lox(1)+1)*(loy(2)-loy(1)+1)*MOD(m2, local_z_dim)) + rcount(dest + 1) = ABS((lox(2) - lox(1) + 1)*(loy(2) - loy(1) + 1)*MOD(m2, local_z_dim)) END IF ELSE - rcount(dest+1) = 0 + rcount(dest + 1) = 0 END IF ELSE - rcount(dest+1) = 0 + rcount(dest + 1) = 0 END IF END DO @@ -275,16 +275,16 @@ SUBROUTINE cp2k_distribution_to_z_slices(density, wavelet, pw_grid) sdispl(1) = 0 rdispl(1) = 0 DO i = 2, nproc - sdispl(i) = sdispl(i-1)+scount(i-1) - rdispl(i) = rdispl(i-1)+rcount(i-1) + sdispl(i) = sdispl(i - 1) + scount(i - 1) + rdispl(i) = rdispl(i - 1) + rcount(i - 1) END DO CALL mp_alltoall(sbuf, scount, sdispl, rbuf, rcount, rdispl, pw_grid%para%rs_group) !!!! and now, how to put the right cubes to the right position!!!!!! wavelet%rho_z_sliced = 0.0_dp - DO i = 0, pw_grid%para%rs_dims(1)-1 - DO j = 0, pw_grid%para%rs_dims(2)-1 + DO i = 0, pw_grid%para%rs_dims(1) - 1 + DO j = 0, pw_grid%para%rs_dims(2) - 1 cart_pos = (/i, j/) CALL mp_cart_rank(pw_grid%para%rs_group, & cart_pos, & @@ -293,7 +293,7 @@ SUBROUTINE cp2k_distribution_to_z_slices(density, wavelet, pw_grid) lox = get_limit(pw_grid%npts(1), pw_grid%para%rs_dims(1), i) loy = get_limit(pw_grid%npts(2), pw_grid%para%rs_dims(2), j) IF (iproc*local_z_dim .LE. m2) THEN - IF ((iproc+1)*local_z_dim .LE. m2) THEN + IF ((iproc + 1)*local_z_dim .LE. m2) THEN loz = local_z_dim ELSE loz = MOD(m2, local_z_dim) @@ -302,8 +302,8 @@ SUBROUTINE cp2k_distribution_to_z_slices(density, wavelet, pw_grid) DO k = 1, loz DO l = loy(1), loy(2) DO m = lox(1), lox(2) - wavelet%rho_z_sliced(m, l, k) = rbuf(ii+rdispl(dest+1)) - ii = ii+1 + wavelet%rho_z_sliced(m, l, k) = rbuf(ii + rdispl(dest + 1)) + ii = ii + 1 END DO END DO END DO @@ -359,7 +359,7 @@ SUBROUTINE z_slices_to_cp2k_distribution(density, wavelet, pw_grid) rbuf = 0.0_dp ii = 1 IF (iproc*local_z_dim .LE. m2) THEN - IF ((iproc+1)*local_z_dim .LE. m2) THEN + IF ((iproc + 1)*local_z_dim .LE. m2) THEN loz = local_z_dim ELSE loz = MOD(m2, local_z_dim) @@ -370,71 +370,71 @@ SUBROUTINE z_slices_to_cp2k_distribution(density, wavelet, pw_grid) min_x = get_limit(pw_grid%npts(1), pw_grid%para%rs_dims(1), 0) min_y = get_limit(pw_grid%npts(2), pw_grid%para%rs_dims(2), 0) - DO i = 0, pw_grid%para%rs_dims(1)-1 - DO j = 0, pw_grid%para%rs_dims(2)-1 + DO i = 0, pw_grid%para%rs_dims(1) - 1 + DO j = 0, pw_grid%para%rs_dims(2) - 1 cart_pos = (/i, j/) CALL mp_cart_rank(pw_grid%para%rs_group, & cart_pos, & dest) IF ((ub(1) .GE. lb(1)) .AND. (ub(2) .GE. lb(2))) THEN IF (dest*local_z_dim .LE. m2) THEN - IF ((dest+1)*local_z_dim .LE. m2) THEN - rcount(dest+1) = ABS((ub(1)-lb(1)+1)*(ub(2)-lb(2)+1)*local_z_dim) + IF ((dest + 1)*local_z_dim .LE. m2) THEN + rcount(dest + 1) = ABS((ub(1) - lb(1) + 1)*(ub(2) - lb(2) + 1)*local_z_dim) ELSE - rcount(dest+1) = ABS((ub(1)-lb(1)+1)*(ub(2)-lb(2)+1)*MOD(m2, local_z_dim)) + rcount(dest + 1) = ABS((ub(1) - lb(1) + 1)*(ub(2) - lb(2) + 1)*MOD(m2, local_z_dim)) END IF ELSE - rcount(dest+1) = 0 + rcount(dest + 1) = 0 END IF ELSE - rcount(dest+1) = 0 + rcount(dest + 1) = 0 END IF lox = get_limit(pw_grid%npts(1), pw_grid%para%rs_dims(1), i) loy = get_limit(pw_grid%npts(2), pw_grid%para%rs_dims(2), j) IF ((lox(2) .GE. lox(1)) .AND. (loy(2) .GE. loy(1))) THEN - scount(dest+1) = ABS((lox(2)-lox(1)+1)*(loy(2)-loy(1)+1)*loz) - DO k = lox(1)-min_x(1)+1, lox(2)-min_x(1)+1 - DO l = loy(1)-min_y(1)+1, loy(2)-min_y(1)+1 + scount(dest + 1) = ABS((lox(2) - lox(1) + 1)*(loy(2) - loy(1) + 1)*loz) + DO k = lox(1) - min_x(1) + 1, lox(2) - min_x(1) + 1 + DO l = loy(1) - min_y(1) + 1, loy(2) - min_y(1) + 1 DO m = 1, loz sbuf(ii) = wavelet%rho_z_sliced(k, l, m) - ii = ii+1 + ii = ii + 1 END DO END DO END DO ELSE - scount(dest+1) = 0 + scount(dest + 1) = 0 END IF END DO END DO sdispl(1) = 0 rdispl(1) = 0 DO i = 2, nproc - sdispl(i) = sdispl(i-1)+scount(i-1) - rdispl(i) = rdispl(i-1)+rcount(i-1) + sdispl(i) = sdispl(i - 1) + scount(i - 1) + rdispl(i) = rdispl(i - 1) + rcount(i - 1) END DO CALL mp_alltoall(sbuf, scount, sdispl, rbuf, rcount, rdispl, pw_grid%para%rs_group) !!!! and now, how to put the right cubes to the right position!!!!!! - DO i = 0, pw_grid%para%rs_dims(1)-1 - DO j = 0, pw_grid%para%rs_dims(2)-1 + DO i = 0, pw_grid%para%rs_dims(1) - 1 + DO j = 0, pw_grid%para%rs_dims(2) - 1 cart_pos = (/i, j/) CALL mp_cart_rank(pw_grid%para%rs_group, & cart_pos, & dest) IF (dest*local_z_dim .LE. m2) THEN - IF ((dest+1)*local_z_dim .LE. m2) THEN + IF ((dest + 1)*local_z_dim .LE. m2) THEN loz = local_z_dim ELSE loz = MOD(m2, local_z_dim) END IF ii = 1 - IF (lb(3)+(dest*local_z_dim) .LE. ub(3)) THEN + IF (lb(3) + (dest*local_z_dim) .LE. ub(3)) THEN DO m = lb(1), ub(1) DO l = lb(2), ub(2) - DO k = lb(3)+(dest*local_z_dim), lb(3)+(dest*local_z_dim)+loz-1 - density%cr3d(m, l, k) = rbuf(ii+rdispl(dest+1)) - ii = ii+1 + DO k = lb(3) + (dest*local_z_dim), lb(3) + (dest*local_z_dim) + loz - 1 + density%cr3d(m, l, k) = rbuf(ii + rdispl(dest + 1)) + ii = ii + 1 END DO END DO END DO diff --git a/src/pw/ps_wavelet_scaling_function.F b/src/pw/ps_wavelet_scaling_function.F index 1681b60e72..473c88addb 100644 --- a/src/pw/ps_wavelet_scaling_function.F +++ b/src/pw/ps_wavelet_scaling_function.F @@ -44,7 +44,7 @@ SUBROUTINE scaling_function(itype, nd, nrange, a, x) a = 0.0_dp x = 0.0_dp - m = itype+2 + m = itype + 2 CALL lazy_arrays(itype, m, ch, cg, cgt, cht) ni = 2*itype @@ -56,10 +56,10 @@ SUBROUTINE scaling_function(itype, nd, nrange, a, x) END IF ! plot scaling function - CALL zero(nd+1, x) - CALL zero(nd+1, y) + CALL zero(nd + 1, x) + CALL zero(nd + 1, y) nt = ni - x(nt/2-1) = 1._dp + x(nt/2 - 1) = 1._dp loop1: DO nt = 2*nt @@ -72,7 +72,7 @@ SUBROUTINE scaling_function(itype, nd, nrange, a, x) !open (unit=1,file='scfunction',status='unknown') DO i = 0, nd - a(i) = 1._dp*i*ni/nd-(.5_dp*ni-1._dp) + a(i) = 1._dp*i*ni/nd - (.5_dp*ni - 1._dp) !write(1,*) 1._dp*i*ni/nd-(.5_dp*ni-1._dp),x(i) END DO !close(1) @@ -101,7 +101,7 @@ SUBROUTINE wavelet_function(itype, nd, a, x) a = 0.0_dp x = 0.0_dp - m = itype+2 + m = itype + 2 ni = 2*itype CALL lazy_arrays(itype, m, ch, cg, cgt, cht) ALLOCATE (y(0:nd), stat=i_all) @@ -111,10 +111,10 @@ SUBROUTINE wavelet_function(itype, nd, a, x) END IF ! plot wavelet - CALL zero(nd+1, x) - CALL zero(nd+1, y) + CALL zero(nd + 1, x) + CALL zero(nd + 1, y) nt = ni - x(nt+nt/2-1) = 1._dp + x(nt + nt/2 - 1) = 1._dp loop3: DO nt = 2*nt !WRITE(*,*) 'nd,nt',nd,nt @@ -126,8 +126,8 @@ SUBROUTINE wavelet_function(itype, nd, a, x) END DO loop3 !open (unit=1,file='wavelet',status='unknown') - DO i = 0, nd-1 - a(i) = 1._dp*i*ni/nd-(.5_dp*ni-.5_dp) + DO i = 0, nd - 1 + a(i) = 1._dp*i*ni/nd - (.5_dp*ni - .5_dp) !write(1,*) 1._dp*i*ni/nd-(.5_dp*ni-.5_dp),x(i) END DO !close(1) @@ -154,7 +154,7 @@ SUBROUTINE scf_recursion(itype, n_iter, n_range, kernel_scf, kern_1_scf) REAL(KIND=dp), DIMENSION(:), POINTER :: cg, cgt, ch, cht kern_1_scf = 0.0_dp - m = itype+2 + m = itype + 2 CALL lazy_arrays(itype, m, ch, cg, cgt, cht) CALL scf_recurs(n_iter, n_range, kernel_scf, kern_1_scf, m, ch) DEALLOCATE (ch, cg, cgt, cht) @@ -193,36 +193,36 @@ END SUBROUTINE zero ! ************************************************************************************************** SUBROUTINE for_trans(nd, nt, x, y, m, cgt, cht) INTEGER, INTENT(in) :: nd, nt - REAL(KIND=dp), INTENT(in) :: x(0:nd-1) - REAL(KIND=dp), INTENT(out) :: y(0:nd-1) + REAL(KIND=dp), INTENT(in) :: x(0:nd - 1) + REAL(KIND=dp), INTENT(out) :: y(0:nd - 1) INTEGER :: m REAL(KIND=dp), DIMENSION(:), POINTER :: cgt, cht INTEGER :: i, ind, j y = 0.0_dp - DO i = 0, nt/2-1 + DO i = 0, nt/2 - 1 y(i) = 0._dp - y(nt/2+i) = 0._dp + y(nt/2 + i) = 0._dp - DO j = -m+1, m + DO j = -m + 1, m ! periodically wrap index if necessary - ind = j+2*i + ind = j + 2*i loop99: DO IF (ind .LT. 0) THEN - ind = ind+nt + ind = ind + nt CYCLE loop99 END IF IF (ind .GE. nt) THEN - ind = ind-nt + ind = ind - nt CYCLE loop99 END IF EXIT loop99 END DO loop99 - y(i) = y(i)+cht(j)*x(ind) - y(nt/2+i) = y(nt/2+i)+cgt(j)*x(ind) + y(i) = y(i) + cht(j)*x(ind) + y(nt/2 + i) = y(nt/2 + i) + cgt(j)*x(ind) END DO END DO @@ -246,8 +246,8 @@ SUBROUTINE back_trans(nd, nt, x, y, m, ch, cg) ! m filter length (m has to be even!) ! x input data, y output data INTEGER, INTENT(in) :: nd, nt - REAL(KIND=dp), INTENT(in) :: x(0:nd-1) - REAL(KIND=dp), INTENT(out) :: y(0:nd-1) + REAL(KIND=dp), INTENT(in) :: x(0:nd - 1) + REAL(KIND=dp), INTENT(out) :: y(0:nd - 1) INTEGER :: m REAL(KIND=dp), DIMENSION(:), POINTER :: ch, cg @@ -255,28 +255,28 @@ SUBROUTINE back_trans(nd, nt, x, y, m, ch, cg) y = 0.0_dp - DO i = 0, nt/2-1 - y(2*i+0) = 0._dp - y(2*i+1) = 0._dp + DO i = 0, nt/2 - 1 + y(2*i + 0) = 0._dp + y(2*i + 1) = 0._dp - DO j = -m/2, m/2-1 + DO j = -m/2, m/2 - 1 ! periodically wrap index if necessary - ind = i-j + ind = i - j loop99: DO IF (ind .LT. 0) THEN - ind = ind+nt/2 + ind = ind + nt/2 CYCLE loop99 END IF IF (ind .GE. nt/2) THEN - ind = ind-nt/2 + ind = ind - nt/2 CYCLE loop99 END IF EXIT loop99 END DO loop99 - y(2*i+0) = y(2*i+0)+ch(2*j-0)*x(ind)+cg(2*j-0)*x(ind+nt/2) - y(2*i+1) = y(2*i+1)+ch(2*j+1)*x(ind)+cg(2*j+1)*x(ind+nt/2) + y(2*i + 0) = y(2*i + 0) + ch(2*j - 0)*x(ind) + cg(2*j - 0)*x(ind + nt/2) + y(2*i + 1) = y(2*i + 1) + ch(2*j + 1)*x(ind) + cg(2*j + 1)*x(ind + nt/2) END DO END DO @@ -311,17 +311,17 @@ SUBROUTINE ftest(m, ch, cg, cgt, cht) t3 = 0._dp t4 = 0._dp DO l = -3*m, 3*m - IF (l-2*i .GE. -m .AND. l-2*i .LE. m .AND. & - l-2*j .GE. -m .AND. l-2*j .LE. m) THEN - t1 = t1+ch(l-2*i)*cht(l-2*j) - t2 = t2+cg(l-2*i)*cgt(l-2*j) - t3 = t3+ch(l-2*i)*cgt(l-2*j) - t4 = t4+cht(l-2*i)*cg(l-2*j) + IF (l - 2*i .GE. -m .AND. l - 2*i .LE. m .AND. & + l - 2*j .GE. -m .AND. l - 2*j .LE. m) THEN + t1 = t1 + ch(l - 2*i)*cht(l - 2*j) + t2 = t2 + cg(l - 2*i)*cgt(l - 2*j) + t3 = t3 + ch(l - 2*i)*cgt(l - 2*j) + t4 = t4 + cht(l - 2*i)*cg(l - 2*j) END IF END DO eps = 1.e-10_dp IF (i .EQ. j) THEN - IF (ABS(t1-1._dp) .GT. eps .OR. ABS(t2-1._dp) .GT. eps .OR. & + IF (ABS(t1 - 1._dp) .GT. eps .OR. ABS(t2 - 1._dp) .GT. eps .OR. & ABS(t3) .GT. eps .OR. ABS(t4) .GT. eps) THEN WRITE (*, fmt22) 'Orthogonality ERROR', i, j, t1, t2, t3, t4 END IF @@ -366,13 +366,13 @@ SUBROUTINE scf_recurs(n_iter, n_range, kernel_scf, kern_1_scf, m, ch) loop_iter_i: DO i = 0, n_range kern_tot = 0._dp DO j = -m, m - ind = 2*i-j + ind = 2*i - j IF (ABS(ind) > n_range) THEN kern = 0._dp ELSE kern = kern_1_scf(ind) END IF - kern_tot = kern_tot+ch(j)*kern + kern_tot = kern_tot + ch(j)*kern END DO IF (kern_tot == 0._dp) THEN !zero after (be sure because strictly == 0._dp) diff --git a/src/pw/ps_wavelet_util.F b/src/pw/ps_wavelet_util.F index ff6fbb71f9..6dbc7e3f8e 100644 --- a/src/pw/ps_wavelet_util.F +++ b/src/pw/ps_wavelet_util.F @@ -123,16 +123,16 @@ SUBROUTINE PSolver(geocode, iproc, nproc, n01, n02, n03, hx, hy, hz, & ! nxc+nxcl+nxcr-2 = nwb ! nwb+nwbl+nwbr = nxt istart = iproc*(md2/nproc) - iend = MIN((iproc+1)*md2/nproc, m2) + iend = MIN((iproc + 1)*md2/nproc, m2) - nxc = iend-istart + nxc = iend - istart nwbl = 0 nwbr = 0 nxcl = 1 nxcr = 1 - nwb = nxcl+nxc+nxcr-2 - nxt = nwbr+nwb+nwbl + nwb = nxcl + nxc + nxcr - 2 + nxt = nwbr + nwb + nwbl !calculate the actual limit of the array for the zero padded FFT IF (geocode == 'P') THEN @@ -146,12 +146,12 @@ SUBROUTINE PSolver(geocode, iproc, nproc, n01, n02, n03, hx, hy, hz, & !!$ print *,'density must go from',min(istart+1,m2),'to',iend,'with n2/2=',n2/2 !!$ print *,' it goes from',i3start+nwbl+nxcl-1,'to',i3start+nxc-1 - IF (istart+1 <= m2) THEN + IF (istart + 1 <= m2) THEN red_fact = 1._dp CALL scale_and_distribute(m1, m3, md1, md2, md3, nxc, rhopot, zf, nproc, red_fact) - ELSE IF (istart+1 <= nlim) THEN !this condition assures that we have perform good zero padding - DO i2 = istart+1, MIN(nlim, istart+md2/nproc) - j2 = i2-istart + ELSE IF (istart + 1 <= nlim) THEN !this condition assures that we have perform good zero padding + DO i2 = istart + 1, MIN(nlim, istart + md2/nproc) + j2 = i2 - istart DO i3 = 1, md3 DO i1 = 1, md1 zf(i1, i3, j2) = 0._dp @@ -257,7 +257,7 @@ SUBROUTINE P_FFT_dimensions(n01, n02, n03, m1, m2, m3, n1, n2, n3, md1, md2, md3 PRINT *, 'n01 dimension', n01 CPABORT("") END IF - l1 = l1+1 + l1 = l1 + 1 CALL fourier_dim(l2, n2) IF (n2 == m2) THEN ELSE @@ -279,16 +279,16 @@ SUBROUTINE P_FFT_dimensions(n01, n02, n03, m1, m2, m3, n1, n2, n3, md1, md2, md3 md2 = n2 md3 = n3 DO WHILE (nproc*(md2/nproc) .LT. n2) - md2 = md2+1 + md2 = md2 + 1 ENDDO !dimensions of the kernel, 1/8 of the total volume, !compatible with nproc - nd1 = n1/2+1 - nd2 = n2/2+1 - nd3 = n3/2+1 + nd1 = n1/2 + 1 + nd2 = n2/2 + 1 + nd3 = n3/2 + 1 DO WHILE (MODULO(nd3, nproc) .NE. 0) - nd3 = nd3+1 + nd3 = nd3 + 1 ENDDO END SUBROUTINE P_FFT_dimensions @@ -357,7 +357,7 @@ SUBROUTINE S_FFT_dimensions(n01, n02, n03, m1, m2, m3, n1, n2, n3, md1, md2, md3 PRINT *, 'n01 dimension', n01 CPABORT("") END IF - l1 = l1+1 + l1 = l1 + 1 CALL fourier_dim(l2, n2) IF (n2 == m2) THEN ELSE @@ -370,7 +370,7 @@ SUBROUTINE S_FFT_dimensions(n01, n02, n03, m1, m2, m3, n1, n2, n3, md1, md2, md3 IF (MODULO(n3, 2) == 0) THEN EXIT END IF - l3 = l3+1 + l3 = l3 + 1 END DO n3 = 2*n3 @@ -380,19 +380,19 @@ SUBROUTINE S_FFT_dimensions(n01, n02, n03, m1, m2, m3, n1, n2, n3, md1, md2, md3 md2 = n2 md3 = n3/2 DO WHILE (nproc*(md2/nproc) .LT. n2) - md2 = md2+1 + md2 = md2 + 1 ENDDO !dimensions of the kernel, 1/8 of the total volume, !compatible with nproc !these two dimensions are like that since they are even - nd1 = n1/2+1 - nd2 = n2/2+1 + nd1 = n1/2 + 1 + nd2 = n2/2 + 1 - nd3 = n3/2+1 + nd3 = n3/2 + 1 DO WHILE (MODULO(nd3, nproc) .NE. 0) - nd3 = nd3+1 + nd3 = nd3 + 1 ENDDO CALL timestop(handle) @@ -458,21 +458,21 @@ SUBROUTINE F_FFT_dimensions(n01, n02, n03, m1, m2, m3, n1, n2, n3, md1, md2, md3 IF (MODULO(n1, 2) == 0) THEN EXIT END IF - l1 = l1+1 + l1 = l1 + 1 END DO DO CALL fourier_dim(l2, n2) IF (MODULO(n2, 2) == 0) THEN EXIT END IF - l2 = l2+1 + l2 = l2 + 1 END DO DO CALL fourier_dim(l3, n3) IF (MODULO(n3, 2) == 0) THEN EXIT END IF - l3 = l3+1 + l3 = l3 + 1 END DO n3 = 2*n3 @@ -482,17 +482,17 @@ SUBROUTINE F_FFT_dimensions(n01, n02, n03, m1, m2, m3, n1, n2, n3, md1, md2, md3 md2 = n2/2 md3 = n3/2 DO WHILE (nproc*(md2/nproc) .LT. n2/2) - md2 = md2+1 + md2 = md2 + 1 ENDDO !dimensions of the kernel, 1/8 of the total volume, !compatible with nproc - nd1 = n1/2+1 - nd2 = n2/2+1 - nd3 = n3/2+1 + nd1 = n1/2 + 1 + nd2 = n2/2 + 1 + nd3 = n3/2 + 1 DO WHILE (MODULO(nd3, nproc) .NE. 0) - nd3 = nd3+1 + nd3 = nd3 + 1 ENDDO END SUBROUTINE F_FFT_dimensions @@ -532,17 +532,17 @@ SUBROUTINE scale_and_distribute(m1, m3, md1, md2, md3, nxc, & DO j1 = 1, m1 zf(j1, j3, jp2) = factor*rhopot(j1, j3, jp2) END DO - DO j1 = m1+1, md1 + DO j1 = m1 + 1, md1 zf(j1, j3, jp2) = 0._dp END DO END DO - DO j3 = m3+1, md3 + DO j3 = m3 + 1, md3 DO j1 = 1, md1 zf(j1, j3, jp2) = 0._dp END DO END DO END DO - DO jp2 = nxc+1, md2/nproc + DO jp2 = nxc + 1, md2/nproc DO j3 = 1, md3 DO j1 = 1, md1 zf(j1, j3, jp2) = 0._dp diff --git a/src/pw/pw_cuda.F b/src/pw/pw_cuda.F index cb428100ba..f5b912489a 100644 --- a/src/pw/pw_cuda.F +++ b/src/pw/pw_cuda.F @@ -450,17 +450,17 @@ SUBROUTINE pw_cuda_r3dc1d_3d_ps(pw1, pw2, scale) lg = SIZE(grays, 1) mg = SIZE(grays, 2) mmax = MAX(mg, 1) - lmax = MAX(lg, (ngpts/mmax+1)) + lmax = MAX(lg, (ngpts/mmax + 1)) - ALLOCATE (p2p(0:numtask-1)) + ALLOCATE (p2p(0:numtask - 1)) CALL mp_rank_compare(gs_group, rs_group, p2p) rp = p2p(g_pos) - mx2 = bo(2, 1, rp, 2)-bo(1, 1, rp, 2)+1 - mz2 = bo(2, 3, rp, 2)-bo(1, 3, rp, 2)+1 - n1 = MAXVAL(bo(2, 1, :, 1)-bo(1, 1, :, 1)+1) - n2 = MAXVAL(bo(2, 2, :, 1)-bo(1, 2, :, 1)+1) + mx2 = bo(2, 1, rp, 2) - bo(1, 1, rp, 2) + 1 + mz2 = bo(2, 3, rp, 2) - bo(1, 3, rp, 2) + 1 + n1 = MAXVAL(bo(2, 1, :, 1) - bo(1, 1, :, 1) + 1) + n2 = MAXVAL(bo(2, 2, :, 1) - bo(1, 2, :, 1) + 1) nmax = MAX((2*n2)/numtask, 2)*mx2*mz2 nmax = MAX(nmax, n1*MAXVAL(nyzray)) @@ -469,17 +469,17 @@ SUBROUTINE pw_cuda_r3dc1d_3d_ps(pw1, pw2, scale) fft_scratch_size%nz = nloc(3) fft_scratch_size%lmax = lmax fft_scratch_size%mmax = mmax - fft_scratch_size%mx1 = bo(2, 1, rp, 1)-bo(1, 1, rp, 1)+1 + fft_scratch_size%mx1 = bo(2, 1, rp, 1) - bo(1, 1, rp, 1) + 1 fft_scratch_size%mx2 = mx2 - fft_scratch_size%my1 = bo(2, 2, rp, 1)-bo(1, 2, rp, 1)+1 + fft_scratch_size%my1 = bo(2, 2, rp, 1) - bo(1, 2, rp, 1) + 1 fft_scratch_size%mz2 = mz2 fft_scratch_size%lg = lg fft_scratch_size%mg = mg fft_scratch_size%nbx = MAXVAL(bo(2, 1, :, 2)) fft_scratch_size%nbz = MAXVAL(bo(2, 3, :, 2)) - fft_scratch_size%mcz1 = MAXVAL(bo(2, 3, :, 1)-bo(1, 3, :, 1)+1) - fft_scratch_size%mcx2 = MAXVAL(bo(2, 1, :, 2)-bo(1, 1, :, 2)+1) - fft_scratch_size%mcz2 = MAXVAL(bo(2, 3, :, 2)-bo(1, 3, :, 2)+1) + fft_scratch_size%mcz1 = MAXVAL(bo(2, 3, :, 1) - bo(1, 3, :, 1) + 1) + fft_scratch_size%mcx2 = MAXVAL(bo(2, 1, :, 2) - bo(1, 1, :, 2) + 1) + fft_scratch_size%mcz2 = MAXVAL(bo(2, 3, :, 2) - bo(1, 3, :, 2) + 1) fft_scratch_size%nmax = nmax fft_scratch_size%nmray = MAXVAL(nyzray) fft_scratch_size%nyzray = nyzray(g_pos) @@ -639,17 +639,17 @@ SUBROUTINE pw_cuda_c1dr3d_3d_ps(pw1, pw2, scale) lg = SIZE(grays, 1) mg = SIZE(grays, 2) mmax = MAX(mg, 1) - lmax = MAX(lg, (ngpts/mmax+1)) + lmax = MAX(lg, (ngpts/mmax + 1)) - ALLOCATE (p2p(0:numtask-1)) + ALLOCATE (p2p(0:numtask - 1)) CALL mp_rank_compare(gs_group, rs_group, p2p) rp = p2p(g_pos) - mx2 = bo(2, 1, rp, 2)-bo(1, 1, rp, 2)+1 - mz2 = bo(2, 3, rp, 2)-bo(1, 3, rp, 2)+1 - n1 = MAXVAL(bo(2, 1, :, 1)-bo(1, 1, :, 1)+1) - n2 = MAXVAL(bo(2, 2, :, 1)-bo(1, 2, :, 1)+1) + mx2 = bo(2, 1, rp, 2) - bo(1, 1, rp, 2) + 1 + mz2 = bo(2, 3, rp, 2) - bo(1, 3, rp, 2) + 1 + n1 = MAXVAL(bo(2, 1, :, 1) - bo(1, 1, :, 1) + 1) + n2 = MAXVAL(bo(2, 2, :, 1) - bo(1, 2, :, 1) + 1) nmax = MAX((2*n2)/numtask, 2)*mx2*mz2 nmax = MAX(nmax, n1*MAXVAL(nyzray)) @@ -658,17 +658,17 @@ SUBROUTINE pw_cuda_c1dr3d_3d_ps(pw1, pw2, scale) fft_scratch_size%nz = nloc(3) fft_scratch_size%lmax = lmax fft_scratch_size%mmax = mmax - fft_scratch_size%mx1 = bo(2, 1, rp, 1)-bo(1, 1, rp, 1)+1 + fft_scratch_size%mx1 = bo(2, 1, rp, 1) - bo(1, 1, rp, 1) + 1 fft_scratch_size%mx2 = mx2 - fft_scratch_size%my1 = bo(2, 2, rp, 1)-bo(1, 2, rp, 1)+1 + fft_scratch_size%my1 = bo(2, 2, rp, 1) - bo(1, 2, rp, 1) + 1 fft_scratch_size%mz2 = mz2 fft_scratch_size%lg = lg fft_scratch_size%mg = mg fft_scratch_size%nbx = MAXVAL(bo(2, 1, :, 2)) fft_scratch_size%nbz = MAXVAL(bo(2, 3, :, 2)) - fft_scratch_size%mcz1 = MAXVAL(bo(2, 3, :, 1)-bo(1, 3, :, 1)+1) - fft_scratch_size%mcx2 = MAXVAL(bo(2, 1, :, 2)-bo(1, 1, :, 2)+1) - fft_scratch_size%mcz2 = MAXVAL(bo(2, 3, :, 2)-bo(1, 3, :, 2)+1) + fft_scratch_size%mcz1 = MAXVAL(bo(2, 3, :, 1) - bo(1, 3, :, 1) + 1) + fft_scratch_size%mcx2 = MAXVAL(bo(2, 1, :, 2) - bo(1, 1, :, 2) + 1) + fft_scratch_size%mcz2 = MAXVAL(bo(2, 3, :, 2) - bo(1, 3, :, 2) + 1) fft_scratch_size%nmax = nmax fft_scratch_size%nmray = MAXVAL(nyzray) fft_scratch_size%nyzray = nyzray(g_pos) diff --git a/src/pw/pw_grid_info.F b/src/pw/pw_grid_info.F index 1befda8f1b..fe362dfd24 100644 --- a/src/pw/pw_grid_info.F +++ b/src/pw/pw_grid_info.F @@ -67,8 +67,8 @@ FUNCTION pw_grid_init_setup(hmat, cutoff, spherical, odd, fft_usage, ncommensura IF (my_icommensurate > 1) THEN CPASSERT(PRESENT(ref_grid)) - n = ref_grid%npts/2**(my_icommensurate-1) - CPASSERT(ALL(ref_grid%npts == n*2**(my_icommensurate-1))) + n = ref_grid%npts/2**(my_icommensurate - 1) + CPASSERT(ALL(ref_grid%npts == n*2**(my_icommensurate - 1))) CPASSERT(ALL(pw_grid_n_for_fft(n) == n)) ELSE n = pw_grid_find_n(hmat, cutoff=cutoff, fft_usage=fft_usage, ncommensurate=ncommensurate, & @@ -142,18 +142,18 @@ FUNCTION pw_grid_find_n(hmat, cutoff, fft_usage, spherical, odd, ncommensurate, CALL fft_radix_operations(ntest(idir), n(idir), FFT_RADIX_NEXT) ! check every subgrid of n subgrid_is_OK = .TRUE. - DO t_icommensurate = 1, my_ncommensurate-1 - nsubgrid = n(idir)/2**(my_ncommensurate-t_icommensurate) + DO t_icommensurate = 1, my_ncommensurate - 1 + nsubgrid = n(idir)/2**(my_ncommensurate - t_icommensurate) CALL fft_radix_operations(nsubgrid, nsubgrid_new, FFT_RADIX_NEXT) subgrid_is_OK = (nsubgrid == nsubgrid_new) .AND. & - (MODULO(n(idir), 2**(my_ncommensurate-t_icommensurate)) == 0) + (MODULO(n(idir), 2**(my_ncommensurate - t_icommensurate)) == 0) IF (.NOT. subgrid_is_OK) EXIT END DO IF (subgrid_is_OK) THEN EXIT ELSE ! subgrid wasn't OK, increment ntest and try again - ntest(idir) = n(idir)+1 + ntest(idir) = n(idir) + 1 ENDIF END DO END DO @@ -162,14 +162,14 @@ FUNCTION pw_grid_find_n(hmat, cutoff, fft_usage, spherical, odd, ncommensurate, ELSE ! without a cutoff and HALFSPACE we have to be sure that there is ! a negative counterpart to every g vector (-> odd number of grid points) - IF (odd) n = n+MOD(n+1, 2) + IF (odd) n = n + MOD(n + 1, 2) END IF ! final check if all went fine ... IF (my_ncommensurate > 0) THEN DO my_icommensurate = 1, my_ncommensurate - ftest = ANY(MODULO(n, 2**(my_ncommensurate-my_icommensurate)) .NE. 0) + ftest = ANY(MODULO(n, 2**(my_ncommensurate - my_icommensurate)) .NE. 0) CPASSERT(.NOT. ftest) END DO ENDIF @@ -243,7 +243,7 @@ FUNCTION pw_grid_n_from_cutoff(hmat, cutoff) RESULT(n) alat(i) = SUM(hmat(:, i)**2) ENDDO CPASSERT(ALL(alat /= 0._dp)) - n = 2*FLOOR(SQRT(2.0_dp*cutoff*alat)/twopi)+1 + n = 2*FLOOR(SQRT(2.0_dp*cutoff*alat)/twopi) + 1 END FUNCTION pw_grid_n_from_cutoff @@ -261,7 +261,7 @@ FUNCTION pw_grid_bounds_from_n(npts) RESULT(bounds) routineP = moduleN//':'//routineN bounds(1, :) = -npts/2 - bounds(2, :) = bounds(1, :)+npts-1 + bounds(2, :) = bounds(1, :) + npts - 1 END FUNCTION pw_grid_bounds_from_n @@ -292,21 +292,21 @@ FUNCTION pw_find_cutoff(npts, h_inv) RESULT(cutoff) ! compute 2*pi*h_inv^t*g where g = (nmax[1],0,0) - gdum(:) = twopi*h_inv(1, :)*REAL((npts(1)-1)/2, KIND=dp) - length = SQRT(gdum(1)**2+gdum(2)**2+gdum(3)**2) + gdum(:) = twopi*h_inv(1, :)*REAL((npts(1) - 1)/2, KIND=dp) + length = SQRT(gdum(1)**2 + gdum(2)**2 + gdum(3)**2) gcut = length ! compute 2*pi*h_inv^t*g where g = (0,nmax[2],0) - gdum(:) = twopi*h_inv(2, :)*REAL((npts(2)-1)/2, KIND=dp) - length = SQRT(gdum(1)**2+gdum(2)**2+gdum(3)**2) + gdum(:) = twopi*h_inv(2, :)*REAL((npts(2) - 1)/2, KIND=dp) + length = SQRT(gdum(1)**2 + gdum(2)**2 + gdum(3)**2) gcut = MIN(gcut, length) ! compute 2*pi*h_inv^t*g where g = (0,0,nmax[3]) - gdum(:) = twopi*h_inv(3, :)*REAL((npts(3)-1)/2, KIND=dp) - length = SQRT(gdum(1)**2+gdum(2)**2+gdum(3)**2) + gdum(:) = twopi*h_inv(3, :)*REAL((npts(3) - 1)/2, KIND=dp) + length = SQRT(gdum(1)**2 + gdum(2)**2 + gdum(3)**2) gcut = MIN(gcut, length) - cutoff = gcut-1.e-8_dp + cutoff = gcut - 1.e-8_dp END FUNCTION pw_find_cutoff diff --git a/src/pw/pw_grids.F b/src/pw/pw_grids.F index 339d64e85e..3bccaf2029 100644 --- a/src/pw/pw_grids.F +++ b/src/pw/pw_grids.F @@ -146,7 +146,7 @@ SUBROUTINE pw_grid_create(pw_grid, pe_group, local) NULLIFY (pw_grid%para%pos_of_x) ! assign a unique tag to this grid - grid_tag = grid_tag+1 + grid_tag = grid_tag + 1 pw_grid%id_nr = grid_tag ! parallel info @@ -276,10 +276,10 @@ SUBROUTINE set_pw_grid_info(pw_grid, grid_span, npts, bounds, cutoff, spherical) IF (PRESENT(bounds) .AND. PRESENT(npts)) THEN pw_grid%bounds = bounds pw_grid%npts = npts - CPASSERT(ALL(npts == bounds(2, :)-bounds(1, :)+1)) + CPASSERT(ALL(npts == bounds(2, :) - bounds(1, :) + 1)) ELSE IF (PRESENT(bounds)) THEN pw_grid%bounds = bounds - pw_grid%npts = bounds(2, :)-bounds(1, :)+1 + pw_grid%npts = bounds(2, :) - bounds(1, :) + 1 ELSE IF (PRESENT(npts)) THEN pw_grid%npts = npts pw_grid%bounds = pw_grid_bounds_from_n(npts) @@ -391,7 +391,7 @@ SUBROUTINE pw_grid_setup(cell_hmat, pw_grid, grid_span, cutoff, bounds, bounds_l CALL set_pw_grid_info(pw_grid, bounds=bounds, cutoff=cutoff, & spherical=my_spherical) ELSE - n = bounds(2, :)-bounds(1, :)+1 + n = bounds(2, :) - bounds(1, :) + 1 my_cutoff = pw_find_cutoff(n, cell_h_inv) my_cutoff = 0.5_dp*my_cutoff*my_cutoff CALL set_pw_grid_info(pw_grid, bounds=bounds, cutoff=my_cutoff, & @@ -482,7 +482,7 @@ SUBROUTINE pw_grid_create_ghatmap(pw_grid) n = pmapn(g_hat(3, gpt)) !ATTENTION: C-mapping [start-index=0] !!!! !ATTENTION: potential integer overflow !!!! - g_hatmap(gpt, 1) = l+npts(1)*(m+npts(2)*n) + g_hatmap(gpt, 1) = l + npts(1)*(m + npts(2)*n) END DO IF (pw_grid%grid_span == HALFSPACE) THEN DO gpt = 1, ngpts @@ -491,29 +491,29 @@ SUBROUTINE pw_grid_create_ghatmap(pw_grid) n = nmapn(g_hat(3, gpt)) !ATTENTION: C-mapping [start-index=0] !!!! !ATTENTION: potential integer overflow !!!! - g_hatmap(gpt, 2) = l+npts(1)*(m+npts(2)*n) + g_hatmap(gpt, 2) = l + npts(1)*(m + npts(2)*n) END DO END IF ELSE yzq => pw_grid%para%yzq DO gpt = 1, ngpts l = pmapl(g_hat(1, gpt)) - m = pmapm(g_hat(2, gpt))+1 - n = pmapn(g_hat(3, gpt))+1 + m = pmapm(g_hat(2, gpt)) + 1 + n = pmapn(g_hat(3, gpt)) + 1 !ATTENTION: C-mapping [start-index=0] !!!! !ATTENTION: potential integer overflow !!!! - mn = yzq(m, n)-1 - g_hatmap(gpt, 1) = l+npts(1)*mn + mn = yzq(m, n) - 1 + g_hatmap(gpt, 1) = l + npts(1)*mn END DO IF (pw_grid%grid_span == HALFSPACE) THEN DO gpt = 1, ngpts l = nmapl(g_hat(1, gpt)) - m = nmapm(g_hat(2, gpt))+1 - n = nmapn(g_hat(3, gpt))+1 + m = nmapm(g_hat(2, gpt)) + 1 + n = nmapn(g_hat(3, gpt)) + 1 !ATTENTION: C-mapping [start-index=0] !!!! !ATTENTION: potential integer overflow !!!! - mn = yzq(m, n)-1 - g_hatmap(gpt, 2) = l+npts(1)*mn + mn = yzq(m, n) - 1 + g_hatmap(gpt, 2) = l + npts(1)*mn END DO END IF END IF @@ -955,36 +955,36 @@ SUBROUTINE pw_grid_distribute(pw_grid, yz_mask, bounds_local, ref_grid, blocked, ELSE lo = get_limit(nx, pw_grid%para%rs_dims(1), & pw_grid%para%rs_pos(1)) - pw_grid%bounds_local(:, 1) = lo+pw_grid%bounds(1, 1)-1 + pw_grid%bounds_local(:, 1) = lo + pw_grid%bounds(1, 1) - 1 lo = get_limit(ny, pw_grid%para%rs_dims(2), & pw_grid%para%rs_pos(2)) - pw_grid%bounds_local(:, 2) = lo+pw_grid%bounds(1, 2)-1 + pw_grid%bounds_local(:, 2) = lo + pw_grid%bounds(1, 2) - 1 pw_grid%bounds_local(:, 3) = pw_grid%bounds(:, 3) END IF pw_grid%npts_local(:) = pw_grid%bounds_local(2, :) & - -pw_grid%bounds_local(1, :)+1 + - pw_grid%bounds_local(1, :) + 1 !..the third distribution is needed for the second step in the FFT - ALLOCATE (pw_grid%para%bo(2, 3, 0:np-1, 3)) + ALLOCATE (pw_grid%para%bo(2, 3, 0:np - 1, 3)) rsd = pw_grid%para%rs_dims IF (PRESENT(bounds_local)) THEN ! axis_dist tells what portion of 1 .. nx , 1 .. ny , 1 .. nz are in the current process DO i = 1, 3 - axis_dist(:, i) = bounds_local(:, i)-pw_grid%bounds(1, i)+1 + axis_dist(:, i) = bounds_local(:, i) - pw_grid%bounds(1, i) + 1 END DO ALLOCATE (axis_dist_all(2, 3, np)) CALL mp_allgather(axis_dist, axis_dist_all, pw_grid%para%rs_group) - DO ip = 0, np-1 + DO ip = 0, np - 1 CALL mp_cart_coords(pw_grid%para%rs_group, ip, coor) ! distribution xyZ - pw_grid%para%bo(1:2, 1, ip, 1) = axis_dist_all(1:2, 1, ip+1) - pw_grid%para%bo(1:2, 2, ip, 1) = axis_dist_all(1:2, 2, ip+1) + pw_grid%para%bo(1:2, 1, ip, 1) = axis_dist_all(1:2, 1, ip + 1) + pw_grid%para%bo(1:2, 2, ip, 1) = axis_dist_all(1:2, 2, ip + 1) pw_grid%para%bo(1, 3, ip, 1) = 1 pw_grid%para%bo(2, 3, ip, 1) = nz ! distribution xYz - pw_grid%para%bo(1:2, 1, ip, 2) = axis_dist_all(1:2, 1, ip+1) + pw_grid%para%bo(1:2, 1, ip, 2) = axis_dist_all(1:2, 1, ip + 1) pw_grid%para%bo(1, 2, ip, 2) = 1 pw_grid%para%bo(2, 2, ip, 2) = ny pw_grid%para%bo(1:2, 3, ip, 2) = get_limit(nz, rsd(2), coor(2)) @@ -996,7 +996,7 @@ SUBROUTINE pw_grid_distribute(pw_grid, yz_mask, bounds_local, ref_grid, blocked, END DO DEALLOCATE (axis_dist_all) ELSE - DO ip = 0, np-1 + DO ip = 0, np - 1 CALL mp_cart_coords(pw_grid%para%rs_group, ip, coor) ! distribution xyZ pw_grid%para%bo(1:2, 1, ip, 1) = get_limit(nx, rsd(1), coor(1)) @@ -1018,7 +1018,7 @@ SUBROUTINE pw_grid_distribute(pw_grid, yz_mask, bounds_local, ref_grid, blocked, !..find the g space distribution pw_grid%ngpts_cut_local = 0 - ALLOCATE (pw_grid%para%nyzray(0:np-1)) + ALLOCATE (pw_grid%para%nyzray(0:np - 1)) ALLOCATE (pw_grid%para%yzq(ny, nz)) @@ -1048,15 +1048,15 @@ SUBROUTINE pw_grid_distribute(pw_grid, yz_mask, bounds_local, ref_grid, blocked, gmax = yz_mask(lo(1), lo(2)) IF (gmax == 0) CYCLE yz_mask(lo(1), lo(2)) = 0 - ip = MOD(i-1, 2*np) - IF (ip > np-1) ip = 2*np-ip-1 + ip = MOD(i - 1, 2*np) + IF (ip > np - 1) ip = 2*np - ip - 1 IF (ip == pw_grid%para%my_pos) THEN - pw_grid%ngpts_cut_local = pw_grid%ngpts_cut_local+gmax + pw_grid%ngpts_cut_local = pw_grid%ngpts_cut_local + gmax END IF pw_grid%para%yzq(lo(1), lo(2)) = ip IF (pw_grid%grid_span == HALFSPACE) THEN - m = -lo(1)-2*lby+2 - n = -lo(2)-2*lbz+2 + m = -lo(1) - 2*lby + 2 + n = -lo(2) - 2*lbz + 2 pw_grid%para%yzq(m, n) = ip yz_mask(m, n) = 0 END IF @@ -1070,13 +1070,13 @@ SUBROUTINE pw_grid_distribute(pw_grid, yz_mask, bounds_local, ref_grid, blocked, DO j = 1, ny ip = pw_grid%para%yzq(j, i) IF (ip >= 0) pw_grid%para%nyzray(ip) = & - pw_grid%para%nyzray(ip)+1 + pw_grid%para%nyzray(ip) + 1 END DO END DO ! Allocate mapping array (y:z, nray, nproc) - ns = MAXVAL(pw_grid%para%nyzray(0:np-1)) - ALLOCATE (pw_grid%para%yzp(2, ns, 0:np-1)) + ns = MAXVAL(pw_grid%para%nyzray(0:np - 1)) + ALLOCATE (pw_grid%para%yzp(2, ns, 0:np - 1)) ! Fill mapping array, recalculate nyzray for convenience pw_grid%para%nyzray = 0 @@ -1085,7 +1085,7 @@ SUBROUTINE pw_grid_distribute(pw_grid, yz_mask, bounds_local, ref_grid, blocked, ip = pw_grid%para%yzq(j, i) IF (ip >= 0) THEN pw_grid%para%nyzray(ip) = & - pw_grid%para%nyzray(ip)+1 + pw_grid%para%nyzray(ip) + 1 ns = pw_grid%para%nyzray(ip) pw_grid%para%yzp(1, ns, ip) = j pw_grid%para%yzp(2, ns, ip) = i @@ -1110,57 +1110,57 @@ SUBROUTINE pw_grid_distribute(pw_grid, yz_mask, bounds_local, ref_grid, blocked, pw_grid%para%blocked = .TRUE. pw_grid%para%ray_distribution = .FALSE. - DO ip = 0, np-1 - m = pw_grid%para%bo(2, 2, ip, 3)- & - pw_grid%para%bo(1, 2, ip, 3)+1 - n = pw_grid%para%bo(2, 3, ip, 3)- & - pw_grid%para%bo(1, 3, ip, 3)+1 + DO ip = 0, np - 1 + m = pw_grid%para%bo(2, 2, ip, 3) - & + pw_grid%para%bo(1, 2, ip, 3) + 1 + n = pw_grid%para%bo(2, 3, ip, 3) - & + pw_grid%para%bo(1, 3, ip, 3) + 1 pw_grid%para%nyzray(ip) = n*m END DO ipl = pw_grid%para%rs_mpo - l = pw_grid%para%bo(2, 1, ipl, 3)- & - pw_grid%para%bo(1, 1, ipl, 3)+1 - m = pw_grid%para%bo(2, 2, ipl, 3)- & - pw_grid%para%bo(1, 2, ipl, 3)+1 - n = pw_grid%para%bo(2, 3, ipl, 3)- & - pw_grid%para%bo(1, 3, ipl, 3)+1 + l = pw_grid%para%bo(2, 1, ipl, 3) - & + pw_grid%para%bo(1, 1, ipl, 3) + 1 + m = pw_grid%para%bo(2, 2, ipl, 3) - & + pw_grid%para%bo(1, 2, ipl, 3) + 1 + n = pw_grid%para%bo(2, 3, ipl, 3) - & + pw_grid%para%bo(1, 3, ipl, 3) + 1 pw_grid%ngpts_cut_local = l*m*n pw_grid%ngpts_local = pw_grid%ngpts_cut_local pw_grid%para%yzq = 0 - ny = pw_grid%para%bo(2, 2, ipl, 3)- & - pw_grid%para%bo(1, 2, ipl, 3)+1 + ny = pw_grid%para%bo(2, 2, ipl, 3) - & + pw_grid%para%bo(1, 2, ipl, 3) + 1 DO n = pw_grid%para%bo(1, 3, ipl, 3), & pw_grid%para%bo(2, 3, ipl, 3) - i = n-pw_grid%para%bo(1, 3, ipl, 3) + i = n - pw_grid%para%bo(1, 3, ipl, 3) DO m = pw_grid%para%bo(1, 2, ipl, 3), & pw_grid%para%bo(2, 2, ipl, 3) - j = m-pw_grid%para%bo(1, 2, ipl, 3)+1 - pw_grid%para%yzq(m, n) = j+i*ny + j = m - pw_grid%para%bo(1, 2, ipl, 3) + 1 + pw_grid%para%yzq(m, n) = j + i*ny END DO END DO ! Allocate mapping array (y:z, nray, nproc) - ns = MAXVAL(pw_grid%para%nyzray(0:np-1)) - ALLOCATE (pw_grid%para%yzp(2, ns, 0:np-1)) + ns = MAXVAL(pw_grid%para%nyzray(0:np - 1)) + ALLOCATE (pw_grid%para%yzp(2, ns, 0:np - 1)) pw_grid%para%yzp = 0 - ALLOCATE (pemap(0:np-1)) + ALLOCATE (pemap(0:np - 1)) pemap = 0 pemap(pw_grid%para%my_pos) = pw_grid%para%rs_mpo CALL mp_sum(pemap, pw_grid%para%group) - DO ip = 0, np-1 + DO ip = 0, np - 1 ipp = pemap(ip) ns = 0 DO n = pw_grid%para%bo(1, 3, ipp, 3), & pw_grid%para%bo(2, 3, ipp, 3) - i = n-pw_grid%bounds(1, 3)+1 + i = n - pw_grid%bounds(1, 3) + 1 DO m = pw_grid%para%bo(1, 2, ipp, 3), & pw_grid%para%bo(2, 2, ipp, 3) - j = m-pw_grid%bounds(1, 2)+1 - ns = ns+1 + j = m - pw_grid%bounds(1, 2) + 1 + ns = ns + 1 pw_grid%para%yzp(1, ns, ip) = j pw_grid%para%yzp(2, ns, ip) = i END DO @@ -1218,23 +1218,23 @@ SUBROUTINE pre_tag(pw_grid, yz_mask, ref_grid) mz = SIZE(yz_mask, 2) ! loop over all processors and all g vectors yz lines on this processor - DO ip = 0, ref_grid%para%group_size-1 + DO ip = 0, ref_grid%para%group_size - 1 DO ig = 1, ref_grid%para%nyzray(ip) ! go from mapped coordinates to original coordinates ! 0 .. N-1 -> -n/2 .. (n+1)/2 - y = ref_grid%para%yzp(1, ig, ip)-1 - IF (y > ny/2) y = y-ny - z = ref_grid%para%yzp(2, ig, ip)-1 - IF (z > nz/2) z = z-nz + y = ref_grid%para%yzp(1, ig, ip) - 1 + IF (y > ny/2) y = y - ny + z = ref_grid%para%yzp(2, ig, ip) - 1 + IF (z > nz/2) z = z - nz ! check if this is inside the realm of the new grid IF (y < lby .OR. y > uby .OR. z < lbz .OR. z > ubz) CYCLE ! go to shifted coordinates - y = y-lby+1 - z = z-lbz+1 + y = y - lby + 1 + z = z - lbz + 1 ! this tag is outside the cutoff range of the new grid IF (pw_grid%grid_span == HALFSPACE) THEN - yp = -y-2*lby+2 - zp = -z-2*lbz+2 + yp = -y - 2*lby + 2 + zp = -z - 2*lbz + 2 ! if the referenz grid is larger than the mirror point may be ! outside the new grid even if the original point is inside IF (yp < 1 .OR. yp > my .OR. zp < 1 .OR. zp > mz) CYCLE @@ -1251,7 +1251,7 @@ SUBROUTINE pre_tag(pw_grid, yz_mask, ref_grid) pw_grid%para%yzq(y, z) = ip END IF IF (ip == pw_grid%para%my_pos) THEN - pw_grid%ngpts_cut_local = pw_grid%ngpts_cut_local+gmax + pw_grid%ngpts_cut_local = pw_grid%ngpts_cut_local + gmax END IF END DO END DO @@ -1293,47 +1293,47 @@ SUBROUTINE order_mask(yz_mask, yz_index) IF (yz_mask(ii, jj) /= 0) THEN yz_index(1, icount) = ii yz_index(2, icount) = jj - icount = icount+1 + icount = icount + 1 ENDIF ENDIF - DO im = 1, MAX(ic+1, jc+1) - ii = ic-im - DO jj = jc-im, jc+im + DO im = 1, MAX(ic + 1, jc + 1) + ii = ic - im + DO jj = jc - im, jc + im IF (ii > 0 .AND. ii <= i1 .AND. jj > 0 .AND. jj <= i2) THEN IF (yz_mask(ii, jj) /= 0) THEN yz_index(1, icount) = ii yz_index(2, icount) = jj - icount = icount+1 + icount = icount + 1 ENDIF ENDIF END DO - ii = ic+im - DO jj = jc-im, jc+im + ii = ic + im + DO jj = jc - im, jc + im IF (ii > 0 .AND. ii <= i1 .AND. jj > 0 .AND. jj <= i2) THEN IF (yz_mask(ii, jj) /= 0) THEN yz_index(1, icount) = ii yz_index(2, icount) = jj - icount = icount+1 + icount = icount + 1 ENDIF ENDIF END DO - jj = jc-im - DO ii = ic-im+1, ic+im-1 + jj = jc - im + DO ii = ic - im + 1, ic + im - 1 IF (ii > 0 .AND. ii <= i1 .AND. jj > 0 .AND. jj <= i2) THEN IF (yz_mask(ii, jj) /= 0) THEN yz_index(1, icount) = ii yz_index(2, icount) = jj - icount = icount+1 + icount = icount + 1 ENDIF ENDIF END DO - jj = jc+im - DO ii = ic-im+1, ic+im-1 + jj = jc + im + DO ii = ic - im + 1, ic + im - 1 IF (ii > 0 .AND. ii <= i1 .AND. jj > 0 .AND. jj <= i2) THEN IF (yz_mask(ii, jj) /= 0) THEN yz_index(1, icount) = ii yz_index(2, icount) = jj - icount = icount+1 + icount = icount + 1 ENDIF ENDIF END DO @@ -1359,16 +1359,16 @@ SUBROUTINE pw_vec_length(h_inv, length_x, length_y, length_z, length, l, m, n) length_x & = REAL(l, dp)*h_inv(1, 1) & - +REAL(m, dp)*h_inv(2, 1) & - +REAL(n, dp)*h_inv(3, 1) + + REAL(m, dp)*h_inv(2, 1) & + + REAL(n, dp)*h_inv(3, 1) length_y & = REAL(l, dp)*h_inv(1, 2) & - +REAL(m, dp)*h_inv(2, 2) & - +REAL(n, dp)*h_inv(3, 2) + + REAL(m, dp)*h_inv(2, 2) & + + REAL(n, dp)*h_inv(3, 2) length_z & = REAL(l, dp)*h_inv(1, 3) & - +REAL(m, dp)*h_inv(2, 3) & - +REAL(n, dp)*h_inv(3, 3) + + REAL(m, dp)*h_inv(2, 3) & + + REAL(n, dp)*h_inv(3, 3) ! enforce strict zero-ness in this case (compiler optimization) IF (l == 0 .AND. m == 0 .AND. n == 0) THEN @@ -1381,7 +1381,7 @@ SUBROUTINE pw_vec_length(h_inv, length_x, length_y, length_z, length, l, m, n) length_y = length_y*twopi length_z = length_z*twopi - length = length_x**2+length_y**2+length_z**2 + length = length_x**2 + length_y**2 + length_z**2 END SUBROUTINE @@ -1426,18 +1426,18 @@ SUBROUTINE pw_grid_count(h_inv, pw_grid, cutoff, yz_mask) nlim(1) = bounds(1, 3) nlim(2) = n_upperlimit ELSE IF (pw_grid%para%mode == PW_MODE_DISTRIBUTED) THEN - n = n_upperlimit-bounds(1, 3)+1 + n = n_upperlimit - bounds(1, 3) + 1 nlim = get_limit(n, pw_grid%para%group_size, pw_grid%para%my_pos) - nlim = nlim+bounds(1, 3)-1 + nlim = nlim + bounds(1, 3) - 1 ELSE CPABORT("para % mode not specified") END IF yz_mask = 0 DO n = nlim(1), nlim(2) - nn = n-bounds(1, 3)+1 + nn = n - bounds(1, 3) + 1 DO m = bounds(1, 2), bounds(2, 2) - mm = m-bounds(1, 2)+1 + mm = m - bounds(1, 2) + 1 DO l = bounds(1, 1), bounds(2, 1) IF (pw_grid%grid_span == HALFSPACE .AND. n == 0) THEN IF ((m == 0 .AND. l > 0) .OR. (m > 0)) CYCLE @@ -1446,8 +1446,8 @@ SUBROUTINE pw_grid_count(h_inv, pw_grid, cutoff, yz_mask) CALL pw_vec_length(h_inv, length_x, length_y, length_z, length, l, m, n) IF (0.5_dp*length <= cutoff) THEN - gpt = gpt+1 - yz_mask(mm, nn) = yz_mask(mm, nn)+1 + gpt = gpt + 1 + yz_mask(mm, nn) = yz_mask(mm, nn) + 1 END IF END DO @@ -1514,7 +1514,7 @@ SUBROUTINE pw_grid_assign(h_inv, pw_grid, cutoff) CALL pw_vec_length(h_inv, length_x, length_y, length_z, length, l, m, n) IF (0.5_dp*length <= cutoff) THEN - gpt = gpt+1 + gpt = gpt + 1 pw_grid%g(1, gpt) = length_x pw_grid%g(2, gpt) = length_y pw_grid%g(3, gpt) = length_z @@ -1535,8 +1535,8 @@ SUBROUTINE pw_grid_assign(h_inv, pw_grid, cutoff) gpt = 0 ip = pw_grid%para%my_pos DO i = 1, pw_grid%para%nyzray(ip) - n = pw_grid%para%yzp(2, i, ip)+lbz-1 - m = pw_grid%para%yzp(1, i, ip)+lby-1 + n = pw_grid%para%yzp(2, i, ip) + lbz - 1 + m = pw_grid%para%yzp(1, i, ip) + lby - 1 IF (n > n_upperlimit) CYCLE DO l = bounds(1, 1), bounds(2, 1) IF (pw_grid%grid_span == HALFSPACE .AND. n == 0) THEN @@ -1546,7 +1546,7 @@ SUBROUTINE pw_grid_assign(h_inv, pw_grid, cutoff) CALL pw_vec_length(h_inv, length_x, length_y, length_z, length, l, m, n) IF (0.5_dp*length <= cutoff) THEN - gpt = gpt+1 + gpt = gpt + 1 pw_grid%g(1, gpt) = length_x pw_grid%g(2, gpt) = length_y pw_grid%g(3, gpt) = length_z @@ -1565,29 +1565,29 @@ SUBROUTINE pw_grid_assign(h_inv, pw_grid, cutoff) gpt = 0 DO n = bounds(1, 3), bounds(2, 3) IF (n < 0) THEN - nn = n+pw_grid%npts(3)+1 + nn = n + pw_grid%npts(3) + 1 ELSE - nn = n+1 + nn = n + 1 END IF IF (nn < bol(1, 3) .OR. nn > bol(2, 3)) CYCLE DO m = bounds(1, 2), bounds(2, 2) IF (m < 0) THEN - mm = m+pw_grid%npts(2)+1 + mm = m + pw_grid%npts(2) + 1 ELSE - mm = m+1 + mm = m + 1 END IF IF (mm < bol(1, 2) .OR. mm > bol(2, 2)) CYCLE DO l = bounds(1, 1), bounds(2, 1) IF (l < 0) THEN - ll = l+pw_grid%npts(1)+1 + ll = l + pw_grid%npts(1) + 1 ELSE - ll = l+1 + ll = l + 1 END IF IF (ll < bol(1, 1) .OR. ll > bol(2, 1)) CYCLE CALL pw_vec_length(h_inv, length_x, length_y, length_z, length, l, m, n) - gpt = gpt+1 + gpt = gpt + 1 pw_grid%g(1, gpt) = length_x pw_grid%g(2, gpt) = length_y pw_grid%g(3, gpt) = length_z @@ -1660,17 +1660,17 @@ SUBROUTINE pw_grid_set_maps(grid_span, g_hat, mapl, mapm, mapn, npts) m = g_hat(2, gpt) n = g_hat(3, gpt) IF (l < 0) THEN - mapl%pos(l) = l+npts(1) + mapl%pos(l) = l + npts(1) ELSE mapl%pos(l) = l END IF IF (m < 0) THEN - mapm%pos(m) = m+npts(2) + mapm%pos(m) = m + npts(2) ELSE mapm%pos(m) = m END IF IF (n < 0) THEN - mapn%pos(n) = n+npts(3) + mapn%pos(n) = n + npts(3) ELSE mapn%pos(n) = n END IF @@ -1682,17 +1682,17 @@ SUBROUTINE pw_grid_set_maps(grid_span, g_hat, mapl, mapm, mapn, npts) IF (l <= 0) THEN mapl%neg(l) = -l ELSE - mapl%neg(l) = npts(1)-l + mapl%neg(l) = npts(1) - l END IF IF (m <= 0) THEN mapm%neg(m) = -m ELSE - mapm%neg(m) = npts(2)-m + mapm%neg(m) = npts(2) - m END IF IF (n <= 0) THEN mapn%neg(n) = -n ELSE - mapn%neg(n) = npts(3)-n + mapn%neg(n) = npts(3) - n END IF END IF @@ -1864,12 +1864,12 @@ SUBROUTINE pw_grid_sort(pw_grid, ref_grid) IF (ng == ngr) THEN ! for the case pw_grid <= ref_grid is = it - DO ig = it+1, ngr + DO ig = it + 1, ngr gig = pw_grid%gsq(ig) gigr = MAX(1._dp, gig) g_found = .FALSE. - DO ih = is+1, SIZE(ref_grid%gsq) - IF (ABS(gig-ref_grid%gsq(ih))/gigr > 1.e-12_dp) CYCLE + DO ih = is + 1, SIZE(ref_grid%gsq) + IF (ABS(gig - ref_grid%gsq(ih))/gigr > 1.e-12_dp) CYCLE g_found = .TRUE. EXIT END DO @@ -1877,9 +1877,9 @@ SUBROUTINE pw_grid_sort(pw_grid, ref_grid) WRITE (*, "(A,I10,F20.10)") "G-vector", ig, pw_grid%gsq(ig) CPABORT("G vector not found") END IF - ip = ih-1 - DO ih = ip+1, SIZE(ref_grid%gsq) - IF (ABS(gig-ref_grid%gsq(ih))/gigr > 1.e-12_dp) CYCLE + ip = ih - 1 + DO ih = ip + 1, SIZE(ref_grid%gsq) + IF (ABS(gig - ref_grid%gsq(ih))/gigr > 1.e-12_dp) CYCLE IF (pw_grid%g_hat(1, ig) /= ref_grid%g_hat(1, ih)) CYCLE IF (pw_grid%g_hat(2, ig) /= ref_grid%g_hat(2, ih)) CYCLE IF (pw_grid%g_hat(3, ig) /= ref_grid%g_hat(3, ih)) CYCLE @@ -1887,7 +1887,7 @@ SUBROUTINE pw_grid_sort(pw_grid, ref_grid) EXIT END DO IF (pw_grid%gidx(ig) == 0) THEN - WRITE (*, "(A,2I10)") " G-Shell ", is+1, ip+1 + WRITE (*, "(A,2I10)") " G-Shell ", is + 1, ip + 1 WRITE (*, "(A,I10,3I6,F20.10)") & " G-vector", ig, pw_grid%g_hat(1:3, ig), pw_grid%gsq(ig) DO ih = 1, SIZE(ref_grid%gsq) @@ -1904,12 +1904,12 @@ SUBROUTINE pw_grid_sort(pw_grid, ref_grid) ELSE ! for the case pw_grid > ref_grid is = it - DO ig = it+1, ngr + DO ig = it + 1, ngr gig = ref_grid%gsq(ig) gigr = MAX(1._dp, gig) g_found = .FALSE. - DO ih = is+1, ng - IF (ABS(pw_grid%gsq(ih)-gig)/gigr > 1.e-12_dp) CYCLE + DO ih = is + 1, ng + IF (ABS(pw_grid%gsq(ih) - gig)/gigr > 1.e-12_dp) CYCLE g_found = .TRUE. EXIT END DO @@ -1917,9 +1917,9 @@ SUBROUTINE pw_grid_sort(pw_grid, ref_grid) WRITE (*, "(A,I10,F20.10)") "G-vector", ig, ref_grid%gsq(ig) CPABORT("G vector not found") END IF - ip = ih-1 - DO ih = ip+1, ng - IF (ABS(pw_grid%gsq(ih)-gig)/gigr > 1.e-12_dp) CYCLE + ip = ih - 1 + DO ih = ip + 1, ng + IF (ABS(pw_grid%gsq(ih) - gig)/gigr > 1.e-12_dp) CYCLE IF (pw_grid%g_hat(1, ih) /= ref_grid%g_hat(1, ig)) CYCLE IF (pw_grid%g_hat(2, ih) /= ref_grid%g_hat(2, ig)) CYCLE IF (pw_grid%g_hat(3, ih) /= ref_grid%g_hat(3, ig)) CYCLE @@ -1927,7 +1927,7 @@ SUBROUTINE pw_grid_sort(pw_grid, ref_grid) EXIT END DO IF (pw_grid%gidx(ig) == 0) THEN - WRITE (*, "(A,2I10)") " G-Shell ", is+1, ip+1 + WRITE (*, "(A,2I10)") " G-Shell ", is + 1, ip + 1 WRITE (*, "(A,I10,3I6,F20.10)") & " G-vector", ig, ref_grid%g_hat(1:3, ig), ref_grid%gsq(ig) DO ih = 1, ng @@ -1990,7 +1990,7 @@ SUBROUTINE sort_shells(gsq, g_hat, idx) s2 = 0 ig = 1 DO ig = 1, ng - IF (ABS(gsq(ig)-s_begin) < small) THEN + IF (ABS(gsq(ig) - s_begin) < small) THEN s2 = ig ELSE CALL redist(g_hat, idx, s1, s2) @@ -2026,7 +2026,7 @@ SUBROUTINE redist(g_hat, idx, s1, s2) REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: slen IF (s2 <= s1) RETURN - ns = s2-s1+1 + ns = s2 - s1 + 1 ALLOCATE (indl(ns)) ALLOCATE (slen(ns)) @@ -2035,12 +2035,12 @@ SUBROUTINE redist(g_hat, idx, s1, s2) n1 = g_hat(1, ii) n2 = g_hat(2, ii) n3 = g_hat(3, ii) - slen(i-s1+1) = 1000.0_dp*REAL(n1, dp)+ & - REAL(n2, dp)+0.001_dp*REAL(n3, dp) + slen(i - s1 + 1) = 1000.0_dp*REAL(n1, dp) + & + REAL(n2, dp) + 0.001_dp*REAL(n3, dp) END DO CALL sort(slen, ns, indl) DO i = 1, ns - ii = indl(i)+s1-1 + ii = indl(i) + s1 - 1 indl(i) = idx(ii) END DO idx(s1:s2) = indl(1:ns) @@ -2084,17 +2084,17 @@ SUBROUTINE pw_grid_remap(pw_grid, yz) mapn => pw_grid%mapn%pos DO gpt = 1, SIZE(pw_grid%gsq) - m = mapm(pw_grid%g_hat(2, gpt))+1 - n = mapn(pw_grid%g_hat(3, gpt))+1 - yz(m, n) = yz(m, n)+1 + m = mapm(pw_grid%g_hat(2, gpt)) + 1 + n = mapn(pw_grid%g_hat(3, gpt)) + 1 + yz(m, n) = yz(m, n) + 1 END DO IF (pw_grid%grid_span == HALFSPACE) THEN mapm => pw_grid%mapm%neg mapn => pw_grid%mapn%neg DO gpt = 1, SIZE(pw_grid%gsq) - m = mapm(pw_grid%g_hat(2, gpt))+1 - n = mapn(pw_grid%g_hat(3, gpt))+1 - yz(m, n) = yz(m, n)+1 + m = mapm(pw_grid%g_hat(2, gpt)) + 1 + n = mapn(pw_grid%g_hat(3, gpt)) + 1 + yz(m, n) = yz(m, n) + 1 END DO END IF @@ -2103,7 +2103,7 @@ SUBROUTINE pw_grid_remap(pw_grid, yz) DO i = 1, nz DO j = 1, ny IF (yz(j, i) > 0) THEN - is = is+1 + is = is + 1 pw_grid%para%yzp(1, is, ip) = j pw_grid%para%yzp(2, is, ip) = i pw_grid%para%yzq(j, i) = is @@ -2161,13 +2161,13 @@ SUBROUTINE pw_grid_change(cell_hmat, pw_grid) m = twopi*REAL(pw_grid%g_hat(2, gpt), KIND=dp) n = twopi*REAL(pw_grid%g_hat(3, gpt), KIND=dp) - g(1, gpt) = l*cell_h_inv(1, 1)+m*cell_h_inv(2, 1)+n*cell_h_inv(3, 1) - g(2, gpt) = l*cell_h_inv(1, 2)+m*cell_h_inv(2, 2)+n*cell_h_inv(3, 2) - g(3, gpt) = l*cell_h_inv(1, 3)+m*cell_h_inv(2, 3)+n*cell_h_inv(3, 3) + g(1, gpt) = l*cell_h_inv(1, 1) + m*cell_h_inv(2, 1) + n*cell_h_inv(3, 1) + g(2, gpt) = l*cell_h_inv(1, 2) + m*cell_h_inv(2, 2) + n*cell_h_inv(3, 2) + g(3, gpt) = l*cell_h_inv(1, 3) + m*cell_h_inv(2, 3) + n*cell_h_inv(3, 3) pw_grid%gsq(gpt) = g(1, gpt)*g(1, gpt) & - +g(2, gpt)*g(2, gpt) & - +g(3, gpt)*g(3, gpt) + + g(2, gpt)*g(2, gpt) & + + g(3, gpt)*g(3, gpt) END DO @@ -2189,7 +2189,7 @@ SUBROUTINE pw_grid_retain(pw_grid) CPASSERT(ASSOCIATED(pw_grid)) CPASSERT(pw_grid%ref_count > 0) - pw_grid%ref_count = pw_grid%ref_count+1 + pw_grid%ref_count = pw_grid%ref_count + 1 END SUBROUTINE pw_grid_retain ! ************************************************************************************************** @@ -2215,7 +2215,7 @@ SUBROUTINE pw_grid_release(pw_grid) IF (ASSOCIATED(pw_grid)) THEN CPASSERT(pw_grid%ref_count > 0) - pw_grid%ref_count = pw_grid%ref_count-1 + pw_grid%ref_count = pw_grid%ref_count - 1 IF (pw_grid%ref_count == 0) THEN IF (ASSOCIATED(pw_grid%gidx)) THEN DEALLOCATE (pw_grid%gidx) diff --git a/src/pw/pw_methods.F b/src/pw/pw_methods.F index 7211a1c0fe..81f6076938 100644 --- a/src/pw/pw_methods.F +++ b/src/pw/pw_methods.F @@ -163,7 +163,7 @@ SUBROUTINE pw_copy(pw1, pw2) END DO IF (ng2 > ng) THEN !$OMP PARALLEL DO PRIVATE(i) DEFAULT(NONE) SHARED(ng,ng2,pw2) - DO i = ng+1, ng2 + DO i = ng + 1, ng2 pw2%cc(i) = CMPLX(0.0_dp, 0.0_dp, KIND=dp) END DO END IF @@ -380,8 +380,8 @@ SUBROUTINE pw_gauss_damp(pw, omega) DO i = 1, cnt pw%cc(i) = pw%cc(i)*EXP(-pw%pw_grid%gsq(i)*omega_2) END DO - flop = flop+2*cnt - n_exp = n_exp+cnt + flop = flop + 2*cnt + n_exp = n_exp + cnt ELSE @@ -435,49 +435,49 @@ SUBROUTINE pw_derive(pw, n) DO i = 1, cnt pw%cc(i) = pw%cc(i)*pw%pw_grid%g(1, i) END DO - flop = flop+6*cnt + flop = flop + 6*cnt ELSE IF (n(1) > 1) THEN !$OMP PARALLEL DO PRIVATE (i) DEFAULT(NONE) SHARED(cnt, pw,n) DO i = 1, cnt pw%cc(i) = pw%cc(i)*(pw%pw_grid%g(1, i)**n(1)) END DO - flop = flop+7*cnt + flop = flop + 7*cnt END IF IF (n(2) == 1) THEN !$OMP PARALLEL DO PRIVATE (i) DEFAULT(NONE) SHARED(pw, cnt) DO i = 1, cnt pw%cc(i) = pw%cc(i)*pw%pw_grid%g(2, i) END DO - flop = flop+6*cnt + flop = flop + 6*cnt ELSE IF (n(2) > 1) THEN !$OMP PARALLEL DO PRIVATE (i) DEFAULT(NONE) SHARED(pw, cnt,n) DO i = 1, cnt pw%cc(i) = pw%cc(i)*(pw%pw_grid%g(2, i)**n(2)) END DO - flop = flop+7*cnt + flop = flop + 7*cnt END IF IF (n(3) == 1) THEN !$OMP PARALLEL DO PRIVATE (i) DEFAULT(NONE) SHARED(pw,cnt) DO i = 1, cnt pw%cc(i) = pw%cc(i)*pw%pw_grid%g(3, i) END DO - flop = flop+6*cnt + flop = flop + 6*cnt ELSE IF (n(3) > 1) THEN !$OMP PARALLEL DO PRIVATE (i) DEFAULT(NONE) SHARED(pw,cnt,n) DO i = 1, cnt pw%cc(i) = pw%cc(i)*(pw%pw_grid%g(3, i)**n(3)) END DO - flop = flop+7*cnt + flop = flop + 7*cnt END IF ! im can take the values 1, -1, i, -i ! skip this if im == 1 - IF (ABS(REAL(im, KIND=dp)-1.0_dp) > 1.e-10) THEN + IF (ABS(REAL(im, KIND=dp) - 1.0_dp) > 1.e-10) THEN !$OMP PARALLEL DO PRIVATE (i) DEFAULT(NONE) SHARED(pw,cnt,im) DO i = 1, cnt pw%cc(i) = im*pw%cc(i) END DO - flop = flop+6*cnt + flop = flop + 6*cnt END IF ELSE @@ -528,16 +528,16 @@ SUBROUTINE pw_dr2(pw, pwdr2, i, j) IF (i == j) THEN !$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(ig,gg) SHARED(i,o3,pw,pwdr2,cnt) DO ig = 1, cnt - gg = pw%pw_grid%g(i, ig)**2-o3*pw%pw_grid%gsq(ig) + gg = pw%pw_grid%g(i, ig)**2 - o3*pw%pw_grid%gsq(ig) pwdr2%cc(ig) = gg*pw%cc(ig) END DO - flop = flop+5*cnt + flop = flop + 5*cnt ELSE !$OMP PARALLEL DO PRIVATE (ig) DEFAULT(NONE) SHARED(pwdr2,pw,i,j,cnt) DO ig = 1, cnt pwdr2%cc(ig) = pw%cc(ig)*(pw%pw_grid%g(i, ig)*pw%pw_grid%g(j, ig)) END DO - flop = flop+4*cnt + flop = flop + 4*cnt END IF ELSE @@ -589,17 +589,17 @@ SUBROUTINE pw_dr2_gg(pw, pwdr2_gg, i, j) IF (i == j) THEN !$OMP PARALLEL DO PRIVATE (ig) DEFAULT(NONE) PRIVATE(gg) SHARED(cnt,pw,o3,pwdr2_gg,i) DO ig = pw%pw_grid%first_gne0, cnt - gg = pw%pw_grid%g(i, ig)**2-o3*pw%pw_grid%gsq(ig) + gg = pw%pw_grid%g(i, ig)**2 - o3*pw%pw_grid%gsq(ig) pwdr2_gg%cc(ig) = gg*pw%cc(ig)/pw%pw_grid%gsq(ig) END DO - flop = flop+6*cnt + flop = flop + 6*cnt ELSE !$OMP PARALLEL DO PRIVATE (ig) DEFAULT(NONE) SHARED(pwdr2_gg,pw,i,j,cnt) DO ig = pw%pw_grid%first_gne0, cnt pwdr2_gg%cc(ig) = pw%cc(ig)*(pw%pw_grid%g(i, ig)*pw%pw_grid%g(j, ig)) & /pw%pw_grid%gsq(ig) END DO - flop = flop+5*cnt + flop = flop + 5*cnt END IF IF (pw%pw_grid%have_g0) pwdr2_gg%cc(1) = 0.0_dp @@ -649,11 +649,11 @@ SUBROUTINE pw_smoothing(pw, ecut, sigma) !$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(ig,arg,f) SHARED(sigma,ecut,pw,cnt) DO ig = 1, cnt - arg = (ecut-pw%pw_grid%gsq(ig))/sigma - f = EXP(arg)/(1+EXP(arg)) + arg = (ecut - pw%pw_grid%gsq(ig))/sigma + f = EXP(arg)/(1 + EXP(arg)) pw%cc(ig) = f*pw%cc(ig) END DO - flop = flop+6*cnt + flop = flop + 6*cnt ELSE @@ -771,13 +771,13 @@ SUBROUTINE pw_axpy(pw1, pw2, alpha) IF (my_alpha == 1.0_dp) THEN !$OMP PARALLEL DO PRIVATE(i) DEFAULT(NONE) SHARED(pw2,pw1) DO i = 1, SIZE(pw2%cr) - pw2%cr(i) = pw2%cr(i)+pw1%cr(i) + pw2%cr(i) = pw2%cr(i) + pw1%cr(i) END DO flop = REAL(SIZE(pw2%cr), KIND=dp) ELSE !$OMP PARALLEL DO PRIVATE(i) DEFAULT(NONE) SHARED(pw2,pw1,my_alpha) DO i = 1, SIZE(pw2%cr) - pw2%cr(i) = pw2%cr(i)+my_alpha*pw1%cr(i) + pw2%cr(i) = pw2%cr(i) + my_alpha*pw1%cr(i) END DO flop = REAL(2*SIZE(pw2%cr), KIND=dp) END IF @@ -786,13 +786,13 @@ SUBROUTINE pw_axpy(pw1, pw2, alpha) IF (my_alpha == 1.0_dp) THEN !$OMP PARALLEL DO PRIVATE(i) DEFAULT(NONE) SHARED(pw2,pw1) DO i = 1, SIZE(pw2%cc) - pw2%cc(i) = pw2%cc(i)+pw1%cc(i) + pw2%cc(i) = pw2%cc(i) + pw1%cc(i) END DO flop = REAL(2*SIZE(pw2%cc), KIND=dp) ELSE !$OMP PARALLEL DO PRIVATE(i) DEFAULT(NONE) SHARED(pw2,my_alpha,pw1) DO i = 1, SIZE(pw2%cc) - pw2%cc(i) = pw2%cc(i)+my_alpha*pw1%cc(i) + pw2%cc(i) = pw2%cc(i) + my_alpha*pw1%cc(i) END DO flop = REAL(4*SIZE(pw2%cc), KIND=dp) END IF @@ -834,12 +834,12 @@ SUBROUTINE pw_axpy(pw1, pw2, alpha) IF (my_alpha == 1.0_dp) THEN !$OMP PARALLEL DO PRIVATE(i) DEFAULT(NONE) SHARED(pw2,pw1,ng) DO i = 1, ng - pw2%cc(i) = pw2%cc(i)+pw1%cc(i) + pw2%cc(i) = pw2%cc(i) + pw1%cc(i) END DO ELSE !$OMP PARALLEL DO PRIVATE(i) DEFAULT(NONE) SHARED(pw2,pw1,my_alpha,ng) DO i = 1, ng - pw2%cc(i) = pw2%cc(i)+my_alpha*pw1%cc(i) + pw2%cc(i) = pw2%cc(i) + my_alpha*pw1%cc(i) END DO END IF @@ -850,13 +850,13 @@ SUBROUTINE pw_axpy(pw1, pw2, alpha) !$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(pw2,pw1,ng2) DO i = 1, ng2 j = pw2%pw_grid%gidx(i) - pw2%cc(i) = pw2%cc(i)+pw1%cc(j) + pw2%cc(i) = pw2%cc(i) + pw1%cc(j) END DO ELSE !$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(pw2,pw1,ng1) DO i = 1, ng1 j = pw2%pw_grid%gidx(i) - pw2%cc(j) = pw2%cc(j)+pw1%cc(i) + pw2%cc(j) = pw2%cc(j) + pw1%cc(i) END DO END IF ELSE @@ -864,13 +864,13 @@ SUBROUTINE pw_axpy(pw1, pw2, alpha) !$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(pw2,pw1,my_alpha,ng2) DO i = 1, ng2 j = pw2%pw_grid%gidx(i) - pw2%cc(i) = pw2%cc(i)+my_alpha*pw1%cc(j) + pw2%cc(i) = pw2%cc(i) + my_alpha*pw1%cc(j) END DO ELSE !$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(pw2,pw1,my_alpha,ng1) DO i = 1, ng1 j = pw2%pw_grid%gidx(i) - pw2%cc(j) = pw2%cc(j)+my_alpha*pw1%cc(i) + pw2%cc(j) = pw2%cc(j) + my_alpha*pw1%cc(i) END DO END IF END IF @@ -881,13 +881,13 @@ SUBROUTINE pw_axpy(pw1, pw2, alpha) !$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(pw2,pw1,ng2) DO i = 1, ng2 j = pw1%pw_grid%gidx(i) - pw2%cc(i) = pw2%cc(i)+pw1%cc(j) + pw2%cc(i) = pw2%cc(i) + pw1%cc(j) END DO ELSE !$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(pw2,pw1,ng1) DO i = 1, ng1 j = pw1%pw_grid%gidx(i) - pw2%cc(j) = pw2%cc(j)+pw1%cc(i) + pw2%cc(j) = pw2%cc(j) + pw1%cc(i) END DO END IF ELSE @@ -895,13 +895,13 @@ SUBROUTINE pw_axpy(pw1, pw2, alpha) !$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(pw2,pw1,my_alpha,ng2) DO i = 1, ng2 j = pw1%pw_grid%gidx(i) - pw2%cc(i) = pw2%cc(i)+my_alpha*pw1%cc(j) + pw2%cc(i) = pw2%cc(i) + my_alpha*pw1%cc(j) END DO ELSE !$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(pw2,pw1,my_alpha,ng1) DO i = 1, ng1 j = pw1%pw_grid%gidx(i) - pw2%cc(j) = pw2%cc(j)+my_alpha*pw1%cc(i) + pw2%cc(j) = pw2%cc(j) + my_alpha*pw1%cc(i) END DO END IF END IF @@ -979,20 +979,20 @@ SUBROUTINE pw_multiply(pw_out, pw1, pw2, alpha) IF (pw1%in_use == REALDATA1D .AND. pw2%in_use == REALDATA1D .AND. & pw_out%in_use == REALDATA1D) THEN IF (my_alpha == 1.0_dp) THEN - pw_out%cr = pw_out%cr+pw1%cr+pw2%cr + pw_out%cr = pw_out%cr + pw1%cr + pw2%cr flop = REAL(2*SIZE(pw2%cr), KIND=dp) ELSE - pw_out%cr = pw_out%cr+my_alpha*pw1%cr*pw2%cr + pw_out%cr = pw_out%cr + my_alpha*pw1%cr*pw2%cr flop = REAL(3*SIZE(pw2%cr), KIND=dp) END IF ELSE IF (pw1%in_use == COMPLEXDATA1D .AND. & pw2%in_use == COMPLEXDATA1D .AND. & pw_out%in_use == COMPLEXDATA1D) THEN IF (my_alpha == 1.0_dp) THEN - pw_out%cc = pw_out%cc+pw1%cc*pw2%cc + pw_out%cc = pw_out%cc + pw1%cc*pw2%cc flop = REAL(3*SIZE(pw2%cc), KIND=dp) ELSE - pw_out%cc = pw_out%cc+my_alpha*pw1%cc*pw2%cc + pw_out%cc = pw_out%cc + my_alpha*pw1%cc*pw2%cc flop = REAL(6*SIZE(pw2%cc), KIND=dp) END IF ELSE IF (pw1%in_use == REALDATA3D .AND. pw2%in_use == REALDATA3D .AND. & @@ -1072,9 +1072,9 @@ SUBROUTINE pw_gather_s(pw, c, scale) !$OMP PARALLEL DO PRIVATE(gpt,l,m,n) DEFAULT(NONE) SHARED(ngpts, mapl,mapm,mapn,ghat,scale,pw,c) DO gpt = 1, ngpts - l = mapl(ghat(1, gpt))+1 - m = mapm(ghat(2, gpt))+1 - n = mapn(ghat(3, gpt))+1 + l = mapl(ghat(1, gpt)) + 1 + m = mapm(ghat(2, gpt)) + 1 + n = mapn(ghat(3, gpt)) + 1 pw%cc(gpt) = scale*c(l, m, n) END DO @@ -1084,9 +1084,9 @@ SUBROUTINE pw_gather_s(pw, c, scale) !$OMP PARALLEL DO PRIVATE(gpt,l,m,n) DEFAULT(NONE) SHARED(ngpts, mapl,mapm,mapn,ghat,pw,c) DO gpt = 1, ngpts - l = mapl(ghat(1, gpt))+1 - m = mapm(ghat(2, gpt))+1 - n = mapn(ghat(3, gpt))+1 + l = mapl(ghat(1, gpt)) + 1 + m = mapm(ghat(2, gpt)) + 1 + n = mapn(ghat(3, gpt)) + 1 pw%cc(gpt) = c(l, m, n) END DO @@ -1146,9 +1146,9 @@ SUBROUTINE pw_gather_p(pw, c, scale) !$OMP SHARED(ngpts,mapl,mapm,mapn,ghat,yzq,pw,c,scale) DO gpt = 1, ngpts - l = mapl(ghat(1, gpt))+1 - m = mapm(ghat(2, gpt))+1 - n = mapn(ghat(3, gpt))+1 + l = mapl(ghat(1, gpt)) + 1 + m = mapm(ghat(2, gpt)) + 1 + n = mapn(ghat(3, gpt)) + 1 mn = yzq(m, n) pw%cc(gpt) = scale*c(l, mn) @@ -1160,9 +1160,9 @@ SUBROUTINE pw_gather_p(pw, c, scale) !$OMP SHARED(ngpts,mapl,mapm,mapn,ghat,yzq,pw,c) DO gpt = 1, ngpts - l = mapl(ghat(1, gpt))+1 - m = mapm(ghat(2, gpt))+1 - n = mapn(ghat(3, gpt))+1 + l = mapl(ghat(1, gpt)) + 1 + m = mapm(ghat(2, gpt)) + 1 + n = mapn(ghat(3, gpt)) + 1 mn = yzq(m, n) pw%cc(gpt) = c(l, mn) @@ -1225,9 +1225,9 @@ SUBROUTINE pw_scatter_s(pw, c, scale) !$OMP PARALLEL DO PRIVATE(gpt,l,m,n) DEFAULT(NONE) SHARED(ngpts, mapl,mapm,mapn,ghat,scale,pw,c) DO gpt = 1, ngpts - l = mapl(ghat(1, gpt))+1 - m = mapm(ghat(2, gpt))+1 - n = mapn(ghat(3, gpt))+1 + l = mapl(ghat(1, gpt)) + 1 + m = mapm(ghat(2, gpt)) + 1 + n = mapn(ghat(3, gpt)) + 1 c(l, m, n) = scale*pw%cc(gpt) END DO @@ -1237,9 +1237,9 @@ SUBROUTINE pw_scatter_s(pw, c, scale) !$OMP PARALLEL DO PRIVATE(gpt,l,m,n) DEFAULT(NONE) SHARED(ngpts, mapl,mapm,mapn,ghat,pw,c) DO gpt = 1, ngpts - l = mapl(ghat(1, gpt))+1 - m = mapm(ghat(2, gpt))+1 - n = mapn(ghat(3, gpt))+1 + l = mapl(ghat(1, gpt)) + 1 + m = mapm(ghat(2, gpt)) + 1 + n = mapn(ghat(3, gpt)) + 1 c(l, m, n) = pw%cc(gpt) END DO @@ -1257,9 +1257,9 @@ SUBROUTINE pw_scatter_s(pw, c, scale) !$OMP PARALLEL DO PRIVATE(gpt,l,m,n) DEFAULT(NONE) SHARED(ngpts, mapl,mapm,mapn,ghat,scale,pw,c) DO gpt = 1, ngpts - l = mapl(ghat(1, gpt))+1 - m = mapm(ghat(2, gpt))+1 - n = mapn(ghat(3, gpt))+1 + l = mapl(ghat(1, gpt)) + 1 + m = mapm(ghat(2, gpt)) + 1 + n = mapn(ghat(3, gpt)) + 1 c(l, m, n) = scale*CONJG(pw%cc(gpt)) END DO @@ -1269,9 +1269,9 @@ SUBROUTINE pw_scatter_s(pw, c, scale) !$OMP PARALLEL DO PRIVATE(gpt,l,m,n) DEFAULT(NONE) SHARED(ngpts, mapl,mapm,mapn,ghat,pw,c) DO gpt = 1, ngpts - l = mapl(ghat(1, gpt))+1 - m = mapm(ghat(2, gpt))+1 - n = mapn(ghat(3, gpt))+1 + l = mapl(ghat(1, gpt)) + 1 + m = mapm(ghat(2, gpt)) + 1 + n = mapn(ghat(3, gpt)) + 1 c(l, m, n) = CONJG(pw%cc(gpt)) END DO @@ -1336,9 +1336,9 @@ SUBROUTINE pw_scatter_p(pw, c, scale) !$OMP SHARED(ngpts,mapl,mapm,mapn,ghat,yzq,pw,c,scale) DO gpt = 1, ngpts - l = mapl(ghat(1, gpt))+1 - m = mapm(ghat(2, gpt))+1 - n = mapn(ghat(3, gpt))+1 + l = mapl(ghat(1, gpt)) + 1 + m = mapm(ghat(2, gpt)) + 1 + n = mapn(ghat(3, gpt)) + 1 mn = yzq(m, n) c(l, mn) = scale*pw%cc(gpt) @@ -1350,9 +1350,9 @@ SUBROUTINE pw_scatter_p(pw, c, scale) !$OMP SHARED(ngpts,mapl,mapm,mapn,ghat,yzq,pw,c) DO gpt = 1, ngpts - l = mapl(ghat(1, gpt))+1 - m = mapm(ghat(2, gpt))+1 - n = mapn(ghat(3, gpt))+1 + l = mapl(ghat(1, gpt)) + 1 + m = mapm(ghat(2, gpt)) + 1 + n = mapn(ghat(3, gpt)) + 1 mn = yzq(m, n) c(l, mn) = pw%cc(gpt) @@ -1372,9 +1372,9 @@ SUBROUTINE pw_scatter_p(pw, c, scale) !$OMP SHARED(ngpts,mapl,mapm,mapn,ghat,yzq,pw,c,scale) DO gpt = 1, ngpts - l = mapl(ghat(1, gpt))+1 - m = mapm(ghat(2, gpt))+1 - n = mapn(ghat(3, gpt))+1 + l = mapl(ghat(1, gpt)) + 1 + m = mapm(ghat(2, gpt)) + 1 + n = mapn(ghat(3, gpt)) + 1 mn = yzq(m, n) c(l, mn) = scale*CONJG(pw%cc(gpt)) @@ -1386,9 +1386,9 @@ SUBROUTINE pw_scatter_p(pw, c, scale) !$OMP SHARED(ngpts,mapl,mapm,mapn,ghat,yzq,pw,c) DO gpt = 1, ngpts - l = mapl(ghat(1, gpt))+1 - m = mapm(ghat(2, gpt))+1 - n = mapn(ghat(3, gpt))+1 + l = mapl(ghat(1, gpt)) + 1 + m = mapm(ghat(2, gpt)) + 1 + n = mapn(ghat(3, gpt)) + 1 mn = yzq(m, n) c(l, mn) = CONJG(pw%cc(gpt)) @@ -1967,7 +1967,7 @@ FUNCTION pw_integral_ab(pw1, pw2) RESULT(integral_value) IF (pw1%in_use == COMPLEXDATA1D) THEN IF (pw1%pw_grid%grid_span == HALFSPACE) THEN integral_value = 2.0_dp*integral_value - IF (pw1%pw_grid%have_g0) integral_value = integral_value- & + IF (pw1%pw_grid%have_g0) integral_value = integral_value - & REAL(CONJG(pw1%cc(1))*pw2%cc(1), KIND=dp) END IF END IF @@ -2055,7 +2055,7 @@ SUBROUTINE pw_structure_factor(sf, r) arg = DOT_PRODUCT(sf%pw_grid%g(:, ig), r) sf%cc(ig) = CMPLX(COS(arg), -SIN(arg), KIND=dp) END DO - flop = flop+7*cnt + flop = flop + 7*cnt ELSE CPABORT("No suitable data field") diff --git a/src/pw/pw_poisson_methods.F b/src/pw/pw_poisson_methods.F index e03457e222..8df3513d7c 100644 --- a/src/pw/pw_poisson_methods.F +++ b/src/pw/pw_poisson_methods.F @@ -414,7 +414,7 @@ SUBROUTINE pw_poisson_solve(poisson_env, density, ehartree, vhartree, & h_stress(alpha, alpha) = ehartree DO beta = alpha, 3 h_stress(alpha, beta) = h_stress(alpha, beta) & - +ffa*pw_integral_ab(dvg(alpha)%pw, dvg(beta)%pw) + + ffa*pw_integral_ab(dvg(alpha)%pw, dvg(beta)%pw) h_stress(beta, alpha) = h_stress(alpha, beta) END DO END DO diff --git a/src/pw/pw_poisson_types.F b/src/pw/pw_poisson_types.F index 5a987a2bfb..010fe02e41 100644 --- a/src/pw/pw_poisson_types.F +++ b/src/pw/pw_poisson_types.F @@ -213,7 +213,7 @@ SUBROUTINE pw_green_create(green, poisson_params, cell_hmat, pw_pool, & green%slab_size = 0.0_dp green%alpha = 0.0_dp green%method = PERIODIC3D - last_greens_fn_id_nr = last_greens_fn_id_nr+1 + last_greens_fn_id_nr = last_greens_fn_id_nr + 1 green%id_nr = last_greens_fn_id_nr green%ref_count = 1 green%MT_alpha = 1.0_dp @@ -313,7 +313,7 @@ SUBROUTINE pw_green_create(green, poisson_params, cell_hmat, pw_pool, & green%p3m_order = poisson_params%ewald_o_spline green%p3m_alpha = poisson_params%ewald_alpha n = green%p3m_order - ALLOCATE (green%p3m_coeff(-(n-1):n-1, 0:n-1)) + ALLOCATE (green%p3m_coeff(-(n - 1):n - 1, 0:n - 1)) CALL spme_coeff_calculate(n, green%p3m_coeff) CALL pw_pool_create_pw(pw_pool, green%p3m_charge, use_data=REALDATA1D, & in_space=RECIPROCALSPACE) @@ -364,7 +364,7 @@ SUBROUTINE pw_green_create(green, poisson_params, cell_hmat, pw_pool, & g2 = grid%gsq(ig) g3d = fourpi/g2 gg = 0.5_dp*SQRT(g2) - gf%cc(ig) = g3d*(1.0_dp-(-1.0_dp)**nz*EXP(-gg*zlength)) + gf%cc(ig) = g3d*(1.0_dp - (-1.0_dp)**nz*EXP(-gg*zlength)) END DO IF (grid%have_g0) gf%cc(1) = 0.0_dp @@ -377,7 +377,7 @@ SUBROUTINE pw_green_create(green, poisson_params, cell_hmat, pw_pool, & DO ig = grid%first_gne0, grid%ngpts_cut_local g2 = grid%gsq(ig) g3d = fourpi/g2 - gxy = SQRT(MAX(0.0_dp, g2-grid%g(iz, ig)*grid%g(iz, ig))) + gxy = SQRT(MAX(0.0_dp, g2 - grid%g(iz, ig)*grid%g(iz, ig))) gz = ABS(grid%g(iz, ig)) j0g = bessj0(rlength*gxy) j1g = bessj1(rlength*gxy) @@ -388,8 +388,8 @@ SUBROUTINE pw_green_create(green, poisson_params, cell_hmat, pw_pool, & k0g = 0 k1g = 0 ENDIF - gf%cc(ig) = g3d*(1.0_dp+rlength* & - (gxy*j1g*k0g-gz*j0g*k1g)) + gf%cc(ig) = g3d*(1.0_dp + rlength* & + (gxy*j1g*k0g - gz*j0g*k1g)) END DO IF (grid%have_g0) gf%cc(1) = 0.0_dp @@ -400,7 +400,7 @@ SUBROUTINE pw_green_create(green, poisson_params, cell_hmat, pw_pool, & g2 = grid%gsq(ig) gg = SQRT(g2) g3d = fourpi/g2 - gf%cc(ig) = g3d*(1.0_dp-COS(rlength*gg)) + gf%cc(ig) = g3d*(1.0_dp - COS(rlength*gg)) END DO IF (grid%have_g0) & gf%cc(1) = 0.5_dp*fourpi*rlength*rlength @@ -453,7 +453,7 @@ SUBROUTINE pw_green_retain(gftype) CPASSERT(ASSOCIATED(gftype)) CPASSERT(gftype%ref_count > 0) - gftype%ref_count = gftype%ref_count+1 + gftype%ref_count = gftype%ref_count + 1 END SUBROUTINE pw_green_retain ! ************************************************************************************************** @@ -476,7 +476,7 @@ SUBROUTINE pw_green_release(gftype, pw_pool) IF (ASSOCIATED(gftype)) THEN CPASSERT(gftype%ref_count > 0) - gftype%ref_count = gftype%ref_count-1 + gftype%ref_count = gftype%ref_count - 1 IF (gftype%ref_count == 0) THEN can_give_back = PRESENT(pw_pool) IF (can_give_back) can_give_back = ASSOCIATED(pw_pool) @@ -544,29 +544,29 @@ SUBROUTINE influence_factor(gftype) ALLOCATE (gftype%p3m_bm2(3, MINVAL(lb(:)):MAXVAL(ub(:)))) END IF - ALLOCATE (m_assign(0:n-2)) + ALLOCATE (m_assign(0:n - 2)) m_assign = 0.0_dp - DO k = 0, n-2 - j = -(n-1)+2*k - DO l = 0, n-1 + DO k = 0, n - 2 + j = -(n - 1) + 2*k + DO l = 0, n - 1 l_arg = 0.5_dp**l prod_arg = gftype%p3m_coeff(j, l)*l_arg - m_assign(k) = m_assign(k)+prod_arg + m_assign(k) = m_assign(k) + prod_arg END DO END DO ! calculate the absolute b values - npts(:) = ub(:)-lb(:)+1 + npts(:) = ub(:) - lb(:) + 1 DO dim = 1, 3 DO pt = lb(dim), ub(dim) val = twopi*(REAL(pt, KIND=dp)/REAL(npts(dim), KIND=dp)) exp_m = CMPLX(COS(val), -SIN(val), KIND=dp) sum_m = CMPLX(0.0_dp, 0.0_dp, KIND=dp) - DO k = 0, n-2 - sum_m = sum_m+m_assign(k)*exp_m**k + DO k = 0, n - 2 + sum_m = sum_m + m_assign(k)*exp_m**k END DO - b_m = exp_m**(n-1)/sum_m + b_m = exp_m**(n - 1)/sum_m gftype%p3m_bm2(dim, pt) = SQRT(REAL(b_m*CONJG(b_m), KIND=dp)) END DO END DO @@ -625,7 +625,7 @@ SUBROUTINE pw_poisson_create(poisson_env) CPASSERT(.NOT. ASSOCIATED(poisson_env)) ALLOCATE (poisson_env) - last_poisson_id = last_poisson_id+1 + last_poisson_id = last_poisson_id + 1 poisson_env%id_nr = last_poisson_id poisson_env%ref_count = 1 poisson_env%method = pw_poisson_none @@ -655,7 +655,7 @@ SUBROUTINE pw_poisson_retain(poisson_env) CPASSERT(ASSOCIATED(poisson_env)) CPASSERT(poisson_env%ref_count > 0) - poisson_env%ref_count = poisson_env%ref_count+1 + poisson_env%ref_count = poisson_env%ref_count + 1 END SUBROUTINE pw_poisson_retain ! ************************************************************************************************** @@ -674,7 +674,7 @@ SUBROUTINE pw_poisson_release(poisson_env) IF (ASSOCIATED(poisson_env)) THEN CPASSERT(poisson_env%ref_count > 0) - poisson_env%ref_count = poisson_env%ref_count-1 + poisson_env%ref_count = poisson_env%ref_count - 1 IF (poisson_env%ref_count == 0) THEN IF (ASSOCIATED(poisson_env%pw_pools)) THEN CALL pw_pools_dealloc(poisson_env%pw_pools) @@ -717,24 +717,24 @@ SUBROUTINE spme_coeff_calculate(n, coeff) a(1, 0, 0) = 1.0_dp DO i = 2, n - m = i-1 + m = i - 1 DO j = -m, m, 2 - DO l = 0, m-1 - b = (a(m, j-1, l)+ & - REAL((-1)**l, KIND=dp)*a(m, j+1, l))/ & - REAL((l+1)*2**(l+1), KIND=dp) - a(i, j, 0) = a(i, j, 0)+b + DO l = 0, m - 1 + b = (a(m, j - 1, l) + & + REAL((-1)**l, KIND=dp)*a(m, j + 1, l))/ & + REAL((l + 1)*2**(l + 1), KIND=dp) + a(i, j, 0) = a(i, j, 0) + b END DO - DO l = 0, m-1 - a(i, j, l+1) = (a(m, j+1, l)- & - a(m, j-1, l))/REAL(l+1, KIND=dp) + DO l = 0, m - 1 + a(i, j, l + 1) = (a(m, j + 1, l) - & + a(m, j - 1, l))/REAL(l + 1, KIND=dp) END DO END DO END DO coeff = 0.0_dp - DO i = 0, n-1 - DO j = -(n-1), n-1, 2 + DO i = 0, n - 1 + DO j = -(n - 1), n - 1, 2 coeff(j, i) = a(n, j, i) END DO END DO diff --git a/src/pw/pw_pool_types.F b/src/pw/pw_pool_types.F index 421cb79af4..eba8ce11df 100644 --- a/src/pw/pw_pool_types.F +++ b/src/pw/pw_pool_types.F @@ -119,7 +119,7 @@ SUBROUTINE pw_pool_create(pool, pw_grid, max_cache) ALLOCATE (pool) pool%pw_grid => pw_grid CALL pw_grid_retain(pw_grid) - last_pw_pool_id_nr = last_pw_pool_id_nr+1 + last_pw_pool_id_nr = last_pw_pool_id_nr + 1 pool%id_nr = last_pw_pool_id_nr pool%ref_count = 1 pool%max_cache = default_max_cache @@ -153,7 +153,7 @@ SUBROUTINE pw_pool_retain(pool) CPASSERT(ASSOCIATED(pool)) CPASSERT(pool%ref_count > 0) - pool%ref_count = pool%ref_count+1 + pool%ref_count = pool%ref_count + 1 IF (debug_this_module) THEN WRITE (unit=cp_logger_get_default_unit_nr(logger, local=.TRUE.), & fmt="(' *** pw_pool ',i4,' has been retained, ref_count=',i4)") & @@ -256,7 +256,7 @@ SUBROUTINE pw_pool_release(pool) IF (ASSOCIATED(pool)) THEN CPASSERT(pool%ref_count > 0) - pool%ref_count = pool%ref_count-1 + pool%ref_count = pool%ref_count - 1 IF (debug_this_module) THEN WRITE (unit=cp_logger_get_default_unit_nr(logger, local=.TRUE.), & fmt="(' *** pw_pool ',i4,' released ref_count=',i4)") & diff --git a/src/pw/pw_spline_utils.F b/src/pw/pw_spline_utils.F index cc0a0898ff..6ca0ca520b 100644 --- a/src/pw/pw_spline_utils.F +++ b/src/pw/pw_spline_utils.F @@ -183,9 +183,9 @@ SUBROUTINE pw_spline2_interpolate_values_g(spline_g) k = spline_g%pw_grid%g_hat(3, ii) c23 = cosJVals(j)*cosKVals(k) - coeff = 64.0_dp/(cosIVals(i)*c23+ & - (cosIVals(i)*cosJVals(j)+cosIVals(i)*cosKVals(k)+c23)*3.0_dp+ & - (cosIVals(i)+cosJVals(j)+cosKVals(k))*9.0_dp+ & + coeff = 64.0_dp/(cosIVals(i)*c23 + & + (cosIVals(i)*cosJVals(j) + cosIVals(i)*cosKVals(k) + c23)*3.0_dp + & + (cosIVals(i) + cosJVals(j) + cosKVals(k))*9.0_dp + & 27.0_dp) spline_g%cc(ii) = spline_g%cc(ii)*coeff @@ -265,9 +265,9 @@ SUBROUTINE pw_spline3_interpolate_values_g(spline_g) !FM 8.0_dp/27.0_dp) ! opt c23 = cosJVals(j)*cosKVals(k) - coeff = 27.0_dp/(cosIVals(i)*c23+ & - (cosIVals(i)*cosJVals(j)+cosIVals(i)*cosKVals(k)+c23)*2.0_dp+ & - (cosIVals(i)+cosJVals(j)+cosKVals(k))*4.0_dp+ & + coeff = 27.0_dp/(cosIVals(i)*c23 + & + (cosIVals(i)*cosJVals(j) + cosIVals(i)*cosKVals(k) + c23)*2.0_dp + & + (cosIVals(i) + cosJVals(j) + cosKVals(k))*4.0_dp + & 8.0_dp) spline_g%cc(ii) = spline_g%cc(ii)*coeff @@ -336,7 +336,7 @@ SUBROUTINE pw_spline_scale_deriv(deriv_vals_r, transpose, scale) DO idir = 1, 3 ddata => deriv_vals_r(idir)%pw%cr3d scalef = h_grid(idir, idir) - CALL dscal((bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1), & + CALL dscal((bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1), & scalef, ddata, 1) END DO ELSE @@ -353,12 +353,12 @@ SUBROUTINE pw_spline_scale_deriv(deriv_vals_r, transpose, scale) dVal2 = ddata2(i, j, k) dVal3 = ddata3(i, j, k) - ddata(i, j, k) = h_grid(1, 1)*dVal1+ & - h_grid(2, 1)*dVal2+h_grid(3, 1)*dVal3 - ddata2(i, j, k) = h_grid(1, 2)*dVal1+ & - h_grid(2, 2)*dVal2+h_grid(3, 2)*dVal3 - ddata3(i, j, k) = h_grid(1, 3)*dVal1+ & - h_grid(2, 3)*dVal2+h_grid(3, 3)*dVal3 + ddata(i, j, k) = h_grid(1, 1)*dVal1 + & + h_grid(2, 1)*dVal2 + h_grid(3, 1)*dVal3 + ddata2(i, j, k) = h_grid(1, 2)*dVal1 + & + h_grid(2, 2)*dVal2 + h_grid(3, 2)*dVal3 + ddata3(i, j, k) = h_grid(1, 3)*dVal1 + & + h_grid(2, 3)*dVal2 + h_grid(3, 3)*dVal3 END DO END DO @@ -461,8 +461,8 @@ SUBROUTINE pw_spline3_deriv_g(spline_g, idir) !FM (sinVal(1)*cosVal(2)+sinVal(1)*cosVal(3))*2.0_dp/9.0_dp+& !FM sinVal(1)*4.0_dp/9.0_dp tmp = csIVals(i)*csJVals(j) - coeff = (tmp*csKVals(k)+ & - (tmp+csIVals(i)*csKVals(k))*2.0_dp+ & + coeff = (tmp*csKVals(k) + & + (tmp + csIVals(i)*csKVals(k))*2.0_dp + & csIVals(i)*4.0_dp)*inv9 spline_g%cc(ii) = spline_g%cc(ii)* & @@ -477,8 +477,8 @@ SUBROUTINE pw_spline3_deriv_g(spline_g, idir) k = spline_g%pw_grid%g_hat(3, ii) tmp = csIVals(i)*csJVals(j) - coeff = (tmp*csKVals(k)+ & - (tmp+csJVals(j)*csKVals(k))*2.0_dp+ & + coeff = (tmp*csKVals(k) + & + (tmp + csJVals(j)*csKVals(k))*2.0_dp + & csJVals(j)*4.0_dp)*inv9 spline_g%cc(ii) = spline_g%cc(ii)* & @@ -493,8 +493,8 @@ SUBROUTINE pw_spline3_deriv_g(spline_g, idir) k = spline_g%pw_grid%g_hat(3, ii) tmp = csIVals(i)*csKVals(k) - coeff = (tmp*csJVals(j)+ & - (tmp+csJVals(j)*csKVals(k))*2.0_dp+ & + coeff = (tmp*csJVals(j) + & + (tmp + csJVals(j)*csKVals(k))*2.0_dp + & csKVals(k)*4.0_dp)*inv9 spline_g%cc(ii) = spline_g%cc(ii)* & @@ -598,8 +598,8 @@ SUBROUTINE pw_spline2_deriv_g(spline_g, idir) !FM (sinVal(1)*cosVal(2)+sinVal(1)*cosVal(3))*3.0_dp/16.0_dp+& !FM sinVal(1)*9.0_dp/16.0_dp tmp = csIVals(i)*csJVals(j) - coeff = (tmp*csKVals(k)+ & - (tmp+csIVals(i)*csKVals(k))*3.0_dp+ & + coeff = (tmp*csKVals(k) + & + (tmp + csIVals(i)*csKVals(k))*3.0_dp + & csIVals(i)*9.0_dp)*inv16 spline_g%cc(ii) = spline_g%cc(ii)* & @@ -614,8 +614,8 @@ SUBROUTINE pw_spline2_deriv_g(spline_g, idir) k = spline_g%pw_grid%g_hat(3, ii) tmp = csIVals(i)*csJVals(j) - coeff = (tmp*csKVals(k)+ & - (tmp+csJVals(j)*csKVals(k))*3.0_dp+ & + coeff = (tmp*csKVals(k) + & + (tmp + csJVals(j)*csKVals(k))*3.0_dp + & csJVals(j)*9.0_dp)*inv16 spline_g%cc(ii) = spline_g%cc(ii)* & @@ -630,8 +630,8 @@ SUBROUTINE pw_spline2_deriv_g(spline_g, idir) k = spline_g%pw_grid%g_hat(3, ii) tmp = csIVals(i)*csKVals(k) - coeff = (tmp*csJVals(j)+ & - (tmp+csJVals(j)*csKVals(k))*3.0_dp+ & + coeff = (tmp*csJVals(j) + & + (tmp + csJVals(j)*csKVals(k))*3.0_dp + & csKVals(k)*9.0_dp)*inv16 spline_g%cc(ii) = spline_g%cc(ii)* & @@ -681,73 +681,73 @@ SUBROUTINE pw_compose_stripe(weights, in_val, in_val_first, in_val_last, & v1 = in_val(1) IF (weights(1) == 0.0_dp) THEN ! optimized version for x deriv - DO i = 1, n_el-3, 3 - v2 = in_val(i+1) - out_val(i) = out_val(i)+ & - weights(0)*v0+ & + DO i = 1, n_el - 3, 3 + v2 = in_val(i + 1) + out_val(i) = out_val(i) + & + weights(0)*v0 + & weights(2)*v2 - v0 = in_val(i+2) - out_val(i+1) = out_val(i+1)+ & - weights(0)*v1+ & - weights(2)*v0 - v1 = in_val(i+3) - out_val(i+2) = out_val(i+2)+ & - weights(0)*v2+ & - weights(2)*v1 + v0 = in_val(i + 2) + out_val(i + 1) = out_val(i + 1) + & + weights(0)*v1 + & + weights(2)*v0 + v1 = in_val(i + 3) + out_val(i + 2) = out_val(i + 2) + & + weights(0)*v2 + & + weights(2)*v1 END DO ELSE ! generic version - DO i = 1, n_el-3, 3 - v2 = in_val(i+1) - out_val(i) = out_val(i)+ & - weights(0)*v0+ & - weights(1)*v1+ & + DO i = 1, n_el - 3, 3 + v2 = in_val(i + 1) + out_val(i) = out_val(i) + & + weights(0)*v0 + & + weights(1)*v1 + & weights(2)*v2 - v0 = in_val(i+2) - out_val(i+1) = out_val(i+1)+ & - weights(0)*v1+ & - weights(1)*v2+ & - weights(2)*v0 - v1 = in_val(i+3) - out_val(i+2) = out_val(i+2)+ & - weights(0)*v2+ & - weights(1)*v0+ & - weights(2)*v1 + v0 = in_val(i + 2) + out_val(i + 1) = out_val(i + 1) + & + weights(0)*v1 + & + weights(1)*v2 + & + weights(2)*v0 + v1 = in_val(i + 3) + out_val(i + 2) = out_val(i + 2) + & + weights(0)*v2 + & + weights(1)*v0 + & + weights(2)*v1 END DO END IF - SELECT CASE (MODULO (n_el-1, 3)) + SELECT CASE (MODULO(n_el - 1, 3)) CASE (0) v2 = in_val_last - out_val(n_el) = out_val(n_el)+ & - weights(0)*v0+ & - weights(1)*v1+ & + out_val(n_el) = out_val(n_el) + & + weights(0)*v0 + & + weights(1)*v1 + & weights(2)*v2 CASE (1) v2 = in_val(n_el) - out_val(n_el-1) = out_val(n_el-1)+ & - weights(0)*v0+ & - weights(1)*v1+ & - weights(2)*v2 + out_val(n_el - 1) = out_val(n_el - 1) + & + weights(0)*v0 + & + weights(1)*v1 + & + weights(2)*v2 v0 = in_val_last - out_val(n_el) = out_val(n_el)+ & - weights(0)*v1+ & - weights(1)*v2+ & + out_val(n_el) = out_val(n_el) + & + weights(0)*v1 + & + weights(1)*v2 + & weights(2)*v0 CASE (2) - v2 = in_val(n_el-1) - out_val(n_el-2) = out_val(n_el-2)+ & - weights(0)*v0+ & - weights(1)*v1+ & - weights(2)*v2 + v2 = in_val(n_el - 1) + out_val(n_el - 2) = out_val(n_el - 2) + & + weights(0)*v0 + & + weights(1)*v1 + & + weights(2)*v2 v0 = in_val(n_el) - out_val(n_el-1) = out_val(n_el-1)+ & - weights(0)*v1+ & - weights(1)*v2+ & - weights(2)*v0 + out_val(n_el - 1) = out_val(n_el - 1) + & + weights(0)*v1 + & + weights(1)*v2 + & + weights(2)*v0 v1 = in_val_last - out_val(n_el) = out_val(n_el)+ & - weights(0)*v2+ & - weights(1)*v0+ & + out_val(n_el) = out_val(n_el) + & + weights(0)*v2 + & + weights(1)*v0 + & weights(2)*v1 END SELECT @@ -789,7 +789,7 @@ SUBROUTINE pw_nn_compose_r_work(weights, in_val, out_val, pw_in, bo) bo = pw_in%pw_grid%bounds_local gbo = pw_in%pw_grid%bounds DO i = 1, 3 - s(i) = bo(2, i)-bo(1, i)+1 + s(i) = bo(2, i) - bo(1, i) + 1 END DO IF (ANY(s < 1)) RETURN has_boundary = ANY(pw_in%pw_grid%bounds_local(:, 1) /= & @@ -800,15 +800,15 @@ SUBROUTINE pw_nn_compose_r_work(weights, in_val, out_val, pw_in, bo) tmp(bo(1, 2):bo(2, 2), bo(1, 3):bo(2, 3))) tmp(:, :) = pw_in%cr3d(bo(2, 1), :, :) CALL mp_sendrecv(tmp, pw_in%pw_grid%para%pos_of_x( & - gbo(1, 1)+MODULO(bo(2, 1)+1-gbo(1, 1), gbo(2, 1)-gbo(1, 1)+1)), & + gbo(1, 1) + MODULO(bo(2, 1) + 1 - gbo(1, 1), gbo(2, 1) - gbo(1, 1) + 1)), & l_boundary, pw_in%pw_grid%para%pos_of_x( & - gbo(1, 1)+MODULO(bo(1, 1)-1-gbo(1, 1), gbo(2, 1)-gbo(1, 1)+1)), & + gbo(1, 1) + MODULO(bo(1, 1) - 1 - gbo(1, 1), gbo(2, 1) - gbo(1, 1) + 1)), & pw_in%pw_grid%para%group) tmp(:, :) = pw_in%cr3d(bo(1, 1), :, :) CALL mp_sendrecv(tmp, pw_in%pw_grid%para%pos_of_x( & - gbo(1, 1)+MODULO(bo(1, 1)-1-gbo(1, 1), gbo(2, 1)-gbo(1, 1)+1)), & + gbo(1, 1) + MODULO(bo(1, 1) - 1 - gbo(1, 1), gbo(2, 1) - gbo(1, 1) + 1)), & u_boundary, pw_in%pw_grid%para%pos_of_x( & - gbo(1, 1)+MODULO(bo(2, 1)+1-gbo(1, 1), gbo(2, 1)-gbo(1, 1)+1)), & + gbo(1, 1) + MODULO(bo(2, 1) + 1 - gbo(1, 1), gbo(2, 1) - gbo(1, 1) + 1)), & pw_in%pw_grid%para%group) DEALLOCATE (tmp) END IF @@ -816,13 +816,13 @@ SUBROUTINE pw_nn_compose_r_work(weights, in_val, out_val, pw_in, bo) !$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(k,kw,myk,j,jw,myj,in_val_f,& !$OMP in_val_l) SHARED(zderiv,yderiv,bo,in_val,out_val,s,l_boundary,& !$OMP u_boundary,weights,has_boundary) - DO k = 0, s(3)-1 + DO k = 0, s(3) - 1 DO kw = 0, 2 - myk = bo(1, 3)+MODULO(k+kw-1, s(3)) + myk = bo(1, 3) + MODULO(k + kw - 1, s(3)) IF (zderiv .AND. kw == 1) CYCLE - DO j = 0, s(2)-1 + DO j = 0, s(2) - 1 DO jw = 0, 2 - myj = bo(1, 2)+MODULO(j+jw-1, s(2)) + myj = bo(1, 2) + MODULO(j + jw - 1, s(2)) IF (yderiv .AND. jw == 1) CYCLE IF (has_boundary) THEN in_val_f = l_boundary(myj, myk) @@ -834,7 +834,7 @@ SUBROUTINE pw_nn_compose_r_work(weights, in_val, out_val, pw_in, bo) CALL pw_compose_stripe(weights=weights(:, jw, kw), & in_val=in_val(:, myj, myk), & in_val_first=in_val_f, in_val_last=in_val_l, & - out_val=out_val(:, bo(1, 2)+j, bo(1, 3)+k), n_el=s(1)) + out_val=out_val(:, bo(1, 2) + j, bo(1, 3) + k), n_el=s(1)) END DO END DO END DO @@ -905,7 +905,7 @@ SUBROUTINE pw_nn_smear_r(pw_in, pw_out, coeffs) DO k = -1, 1 DO j = -1, 1 DO i = -1, 1 - weights(i, j, k) = coeffs(ABS(i)+ABS(j)+ABS(k)+1) + weights(i, j, k) = coeffs(ABS(i) + ABS(j) + ABS(k) + 1) END DO END DO END DO @@ -964,7 +964,7 @@ SUBROUTINE pw_nn_deriv_r(pw_in, pw_out, coeffs, idir) IF (idirVal == 0) THEN weights(i, j, k) = 0.0_dp ELSE - weights(i, j, k) = REAL(idirVal, dp)*coeffs(ABS(i)+ABS(j)+ABS(k)) + weights(i, j, k) = REAL(idirVal, dp)*coeffs(ABS(i) + ABS(j) + ABS(k)) END IF END DO END DO @@ -1058,18 +1058,18 @@ SUBROUTINE add_coarse2fine(coarse_coeffs_pw, fine_values_pw, & coarse_gbo = coarse_coeffs_pw%pw_grid%bounds fine_bo = fine_values_pw%pw_grid%bounds_local fine_gbo = fine_values_pw%pw_grid%bounds - f_shift = fine_gbo(1, :)-2*coarse_gbo(1, :) + f_shift = fine_gbo(1, :) - 2*coarse_gbo(1, :) DO j = 2, 3 DO i = 1, 2 - coarse_bo(i, j) = FLOOR((fine_bo(i, j)-f_shift(j))/2.) + coarse_bo(i, j) = FLOOR((fine_bo(i, j) - f_shift(j))/2.) END DO END DO IF (fine_bo(1, 1) <= fine_bo(2, 1)) THEN - coarse_bo(1, 1) = FLOOR((fine_bo(1, 1)-2-f_shift(1))/2.) - coarse_bo(2, 1) = FLOOR((fine_bo(2, 1)+3-f_shift(1))/2.) + coarse_bo(1, 1) = FLOOR((fine_bo(1, 1) - 2 - f_shift(1))/2.) + coarse_bo(2, 1) = FLOOR((fine_bo(2, 1) + 3 - f_shift(1))/2.) ELSE coarse_bo(1, 1) = coarse_gbo(2, 1) - coarse_bo(2, 1) = coarse_gbo(2, 1)-1 + coarse_bo(2, 1) = coarse_gbo(2, 1) - 1 END IF is_split = ANY(coarse_gbo(:, 1) /= my_coarse_bo(:, 1)) IF (.NOT. is_split .OR. .NOT. pbc) THEN @@ -1080,140 +1080,140 @@ SUBROUTINE add_coarse2fine(coarse_coeffs_pw, fine_values_pw, & has_i_lbound = (fine_gbo(1, 1) /= fine_bo(1, 1)) .OR. pbc .AND. is_split IF (pbc) THEN - CPASSERT(ALL(fine_gbo(1, :) == 2*coarse_gbo(1, :)+f_shift)) - CPASSERT(ALL(fine_gbo(2, :) == 2*coarse_gbo(2, :)+1+f_shift)) + CPASSERT(ALL(fine_gbo(1, :) == 2*coarse_gbo(1, :) + f_shift)) + CPASSERT(ALL(fine_gbo(2, :) == 2*coarse_gbo(2, :) + 1 + f_shift)) ELSE - CPASSERT(ALL(fine_gbo(2, :) == 2*coarse_gbo(2, :)+f_shift)) - CPASSERT(ALL(fine_gbo(1, :) == 2*coarse_gbo(1, :)+f_shift)) + CPASSERT(ALL(fine_gbo(2, :) == 2*coarse_gbo(2, :) + f_shift)) + CPASSERT(ALL(fine_gbo(1, :) == 2*coarse_gbo(1, :) + f_shift)) END IF coarse_coeffs => coarse_coeffs_pw%cr3d DO i = 1, 3 - s(i) = coarse_gbo(2, i)-coarse_gbo(1, i)+1 + s(i) = coarse_gbo(2, i) - coarse_gbo(1, i) + 1 END DO ! CALL timestop(handle2) ! *** parallel case IF (is_split) THEN CALL timeset(routineN//"_comm", handle2) - coarse_slice_size = (coarse_bo(2, 2)-coarse_bo(1, 2)+1)* & - (coarse_bo(2, 3)-coarse_bo(1, 3)+1) + coarse_slice_size = (coarse_bo(2, 2) - coarse_bo(1, 2) + 1)* & + (coarse_bo(2, 3) - coarse_bo(1, 3) + 1) n_procs = coarse_coeffs_pw%pw_grid%para%group_size - ALLOCATE (send_size(0:n_procs-1), send_offset(0:n_procs-1), & - sent_size(0:n_procs-1), rcv_size(0:n_procs-1), & - rcv_offset(0:n_procs-1), real_rcv_size(0:n_procs-1)) + ALLOCATE (send_size(0:n_procs - 1), send_offset(0:n_procs - 1), & + sent_size(0:n_procs - 1), rcv_size(0:n_procs - 1), & + rcv_offset(0:n_procs - 1), real_rcv_size(0:n_procs - 1)) ! ** rcv size count pos_of_x => coarse_coeffs_pw%pw_grid%para%pos_of_x p_old = pos_of_x(coarse_gbo(1, 1) & - +MODULO(coarse_bo(1, 1)-coarse_gbo(1, 1), s(1))) + + MODULO(coarse_bo(1, 1) - coarse_gbo(1, 1), s(1))) rcv_size = 0 DO x = coarse_bo(1, 1), coarse_bo(2, 1) - p = pos_of_x(coarse_gbo(1, 1)+MODULO(x-coarse_gbo(1, 1), s(1))) - rcv_size(p) = rcv_size(p)+coarse_slice_size + p = pos_of_x(coarse_gbo(1, 1) + MODULO(x - coarse_gbo(1, 1), s(1))) + rcv_size(p) = rcv_size(p) + coarse_slice_size END DO ! ** send size count pos_of_x => fine_values_pw%pw_grid%para%pos_of_x - sf = fine_gbo(2, 1)-fine_gbo(1, 1)+1 - fi_lb = 2*my_coarse_bo(1, 1)-3+f_shift(1) - fi_ub = 2*my_coarse_bo(2, 1)+3+f_shift(1) + sf = fine_gbo(2, 1) - fine_gbo(1, 1) + 1 + fi_lb = 2*my_coarse_bo(1, 1) - 3 + f_shift(1) + fi_ub = 2*my_coarse_bo(2, 1) + 3 + f_shift(1) IF (.NOT. pbc) THEN fi_lb = MAX(fi_lb, fine_gbo(1, 1)) fi_ub = MIN(fi_ub, fine_gbo(2, 1)) ELSE - fi_ub = MIN(fi_ub, fi_lb+sf-1) + fi_ub = MIN(fi_ub, fi_lb + sf - 1) END IF - p_old = pos_of_x(fine_gbo(1, 1)+MODULO(fi_lb-fine_gbo(1, 1), sf)) - p_lb = FLOOR((fi_lb-2-f_shift(1))/2.) + p_old = pos_of_x(fine_gbo(1, 1) + MODULO(fi_lb - fine_gbo(1, 1), sf)) + p_lb = FLOOR((fi_lb - 2 - f_shift(1))/2.) send_size = 0 DO x = fi_lb, fi_ub - p = pos_of_x(fine_gbo(1, 1)+MODULO(x-fine_gbo(1, 1), sf)) + p = pos_of_x(fine_gbo(1, 1) + MODULO(x - fine_gbo(1, 1), sf)) IF (p /= p_old) THEN - p_ub = FLOOR((x-1+3-f_shift(1))/2.) + p_ub = FLOOR((x - 1 + 3 - f_shift(1))/2.) - send_size(p_old) = send_size(p_old)+(MIN(p_ub, my_coarse_bo(2, 1)) & - -MAX(p_lb, my_coarse_bo(1, 1))+1)*coarse_slice_size + send_size(p_old) = send_size(p_old) + (MIN(p_ub, my_coarse_bo(2, 1)) & + - MAX(p_lb, my_coarse_bo(1, 1)) + 1)*coarse_slice_size IF (pbc) THEN - DO xx = p_lb, coarse_gbo(1, 1)-1 - x_att = coarse_gbo(1, 1)+MODULO(xx-coarse_gbo(1, 1), s(1)) + DO xx = p_lb, coarse_gbo(1, 1) - 1 + x_att = coarse_gbo(1, 1) + MODULO(xx - coarse_gbo(1, 1), s(1)) IF (x_att >= my_coarse_bo(1, 1) .AND. x_att <= my_coarse_bo(2, 1)) THEN - send_size(p_old) = send_size(p_old)+coarse_slice_size + send_size(p_old) = send_size(p_old) + coarse_slice_size END IF END DO - DO xx = coarse_gbo(2, 1)+1, p_ub - x_att = coarse_gbo(1, 1)+MODULO(xx-coarse_gbo(1, 1), s(1)) + DO xx = coarse_gbo(2, 1) + 1, p_ub + x_att = coarse_gbo(1, 1) + MODULO(xx - coarse_gbo(1, 1), s(1)) IF (x_att >= my_coarse_bo(1, 1) .AND. x_att <= my_coarse_bo(2, 1)) THEN - send_size(p_old) = send_size(p_old)+coarse_slice_size + send_size(p_old) = send_size(p_old) + coarse_slice_size END IF END DO END IF p_old = p - p_lb = FLOOR((x-2-f_shift(1))/2.) + p_lb = FLOOR((x - 2 - f_shift(1))/2.) END IF END DO - p_ub = FLOOR((fi_ub+3-f_shift(1))/2.) + p_ub = FLOOR((fi_ub + 3 - f_shift(1))/2.) - send_size(p_old) = send_size(p_old)+(MIN(p_ub, my_coarse_bo(2, 1)) & - -MAX(p_lb, my_coarse_bo(1, 1))+1)*coarse_slice_size + send_size(p_old) = send_size(p_old) + (MIN(p_ub, my_coarse_bo(2, 1)) & + - MAX(p_lb, my_coarse_bo(1, 1)) + 1)*coarse_slice_size IF (pbc) THEN - DO xx = p_lb, coarse_gbo(1, 1)-1 - x_att = coarse_gbo(1, 1)+MODULO(xx-coarse_gbo(1, 1), s(1)) + DO xx = p_lb, coarse_gbo(1, 1) - 1 + x_att = coarse_gbo(1, 1) + MODULO(xx - coarse_gbo(1, 1), s(1)) IF (x_att >= my_coarse_bo(1, 1) .AND. x_att <= my_coarse_bo(2, 1)) THEN - send_size(p_old) = send_size(p_old)+coarse_slice_size + send_size(p_old) = send_size(p_old) + coarse_slice_size END IF END DO - DO xx = coarse_gbo(2, 1)+1, p_ub - x_att = coarse_gbo(1, 1)+MODULO(xx-coarse_gbo(1, 1), s(1)) + DO xx = coarse_gbo(2, 1) + 1, p_ub + x_att = coarse_gbo(1, 1) + MODULO(xx - coarse_gbo(1, 1), s(1)) IF (x_att >= my_coarse_bo(1, 1) .AND. x_att <= my_coarse_bo(2, 1)) THEN - send_size(p_old) = send_size(p_old)+coarse_slice_size + send_size(p_old) = send_size(p_old) + coarse_slice_size END IF END DO END IF ! ** offsets & alloc send-rcv send_tot_size = 0 - DO ip = 0, n_procs-1 + DO ip = 0, n_procs - 1 send_offset(ip) = send_tot_size - send_tot_size = send_tot_size+send_size(ip) + send_tot_size = send_tot_size + send_size(ip) END DO - ALLOCATE (send_buf(0:send_tot_size-1)) + ALLOCATE (send_buf(0:send_tot_size - 1)) rcv_tot_size = 0 - DO ip = 0, n_procs-1 + DO ip = 0, n_procs - 1 rcv_offset(ip) = rcv_tot_size - rcv_tot_size = rcv_tot_size+rcv_size(ip) + rcv_tot_size = rcv_tot_size + rcv_size(ip) END DO - IF (.NOT. rcv_tot_size == (coarse_bo(2, 1)-coarse_bo(1, 1)+1)*coarse_slice_size) THEN + IF (.NOT. rcv_tot_size == (coarse_bo(2, 1) - coarse_bo(1, 1) + 1)*coarse_slice_size) THEN CPABORT("Error calculating rcv_tot_size ") END IF - ALLOCATE (rcv_buf(0:rcv_tot_size-1)) + ALLOCATE (rcv_buf(0:rcv_tot_size - 1)) ! ** fill send buffer - p_old = pos_of_x(fine_gbo(1, 1)+MODULO(fi_lb-fine_gbo(1, 1), sf)) - p_lb = FLOOR((fi_lb-2-f_shift(1))/2.) + p_old = pos_of_x(fine_gbo(1, 1) + MODULO(fi_lb - fine_gbo(1, 1), sf)) + p_lb = FLOOR((fi_lb - 2 - f_shift(1))/2.) sent_size(:) = send_offset - ss = my_coarse_bo(2, 1)-my_coarse_bo(1, 1)+1 + ss = my_coarse_bo(2, 1) - my_coarse_bo(1, 1) + 1 DO x = fi_lb, fi_ub - p = pos_of_x(fine_gbo(1, 1)+MODULO(x-fine_gbo(1, 1), sf)) + p = pos_of_x(fine_gbo(1, 1) + MODULO(x - fine_gbo(1, 1), sf)) IF (p /= p_old) THEN - shift = FLOOR((fine_gbo(1, 1)+MODULO(x-1-fine_gbo(1, 1), sf)-f_shift(1))/2._dp)- & - FLOOR((x-1-f_shift(1))/2._dp) - p_ub = FLOOR((x-1+3-f_shift(1))/2._dp) + shift = FLOOR((fine_gbo(1, 1) + MODULO(x - 1 - fine_gbo(1, 1), sf) - f_shift(1))/2._dp) - & + FLOOR((x - 1 - f_shift(1))/2._dp) + p_ub = FLOOR((x - 1 + 3 - f_shift(1))/2._dp) IF (pbc) THEN - DO xx = p_lb+shift, coarse_gbo(1, 1)-1 - x_att = coarse_gbo(1, 1)+MODULO(xx-coarse_gbo(1, 1), sf) + DO xx = p_lb + shift, coarse_gbo(1, 1) - 1 + x_att = coarse_gbo(1, 1) + MODULO(xx - coarse_gbo(1, 1), sf) IF (x_att >= my_coarse_bo(1, 1) .AND. x_att <= my_coarse_bo(2, 1)) THEN CALL dcopy(coarse_slice_size, & coarse_coeffs(x_att, my_coarse_bo(1, 2), & my_coarse_bo(1, 3)), ss, send_buf(sent_size(p_old)), 1) - sent_size(p_old) = sent_size(p_old)+coarse_slice_size + sent_size(p_old) = sent_size(p_old) + coarse_slice_size END IF END DO END IF @@ -1221,43 +1221,43 @@ SUBROUTINE add_coarse2fine(coarse_coeffs_pw, fine_values_pw, & ii = sent_size(p_old) DO k = coarse_bo(1, 3), coarse_bo(2, 3) DO j = coarse_bo(1, 2), coarse_bo(2, 2) - DO i = MAX(p_lb+shift, my_coarse_bo(1, 1)), MIN(p_ub+shift, my_coarse_bo(2, 1)) + DO i = MAX(p_lb + shift, my_coarse_bo(1, 1)), MIN(p_ub + shift, my_coarse_bo(2, 1)) send_buf(ii) = coarse_coeffs(i, j, k) - ii = ii+1 + ii = ii + 1 END DO END DO END DO sent_size(p_old) = ii IF (pbc) THEN - DO xx = coarse_gbo(2, 1)+1, p_ub+shift - x_att = coarse_gbo(1, 1)+MODULO(xx-coarse_gbo(1, 1), s(1)) + DO xx = coarse_gbo(2, 1) + 1, p_ub + shift + x_att = coarse_gbo(1, 1) + MODULO(xx - coarse_gbo(1, 1), s(1)) IF (x_att >= my_coarse_bo(1, 1) .AND. x_att <= my_coarse_bo(2, 1)) THEN CALL dcopy(coarse_slice_size, & coarse_coeffs(x_att, my_coarse_bo(1, 2), & my_coarse_bo(1, 3)), ss, & send_buf(sent_size(p_old)), 1) - sent_size(p_old) = sent_size(p_old)+coarse_slice_size + sent_size(p_old) = sent_size(p_old) + coarse_slice_size END IF END DO END IF p_old = p - p_lb = FLOOR((x-2-f_shift(1))/2.) + p_lb = FLOOR((x - 2 - f_shift(1))/2.) END IF END DO - shift = FLOOR((fine_gbo(1, 1)+MODULO(x-1-fine_gbo(1, 1), sf)-f_shift(1))/2._dp)- & - FLOOR((x-1-f_shift(1))/2._dp) - p_ub = FLOOR((fi_ub+3-f_shift(1))/2.) + shift = FLOOR((fine_gbo(1, 1) + MODULO(x - 1 - fine_gbo(1, 1), sf) - f_shift(1))/2._dp) - & + FLOOR((x - 1 - f_shift(1))/2._dp) + p_ub = FLOOR((fi_ub + 3 - f_shift(1))/2.) IF (pbc) THEN - DO xx = p_lb+shift, coarse_gbo(1, 1)-1 - x_att = coarse_gbo(1, 1)+MODULO(xx-coarse_gbo(1, 1), s(1)) + DO xx = p_lb + shift, coarse_gbo(1, 1) - 1 + x_att = coarse_gbo(1, 1) + MODULO(xx - coarse_gbo(1, 1), s(1)) IF (x_att >= my_coarse_bo(1, 1) .AND. x_att <= my_coarse_bo(2, 1)) THEN CALL dcopy(coarse_slice_size, & coarse_coeffs(x_att, my_coarse_bo(1, 2), & my_coarse_bo(1, 3)), ss, send_buf(sent_size(p_old)), 1) - sent_size(p_old) = sent_size(p_old)+coarse_slice_size + sent_size(p_old) = sent_size(p_old) + coarse_slice_size END IF END DO END IF @@ -1265,28 +1265,28 @@ SUBROUTINE add_coarse2fine(coarse_coeffs_pw, fine_values_pw, & ii = sent_size(p_old) DO k = coarse_bo(1, 3), coarse_bo(2, 3) DO j = coarse_bo(1, 2), coarse_bo(2, 2) - DO i = MAX(p_lb+shift, my_coarse_bo(1, 1)), MIN(p_ub+shift, my_coarse_bo(2, 1)) + DO i = MAX(p_lb + shift, my_coarse_bo(1, 1)), MIN(p_ub + shift, my_coarse_bo(2, 1)) send_buf(ii) = coarse_coeffs(i, j, k) - ii = ii+1 + ii = ii + 1 END DO END DO END DO sent_size(p_old) = ii IF (pbc) THEN - DO xx = coarse_gbo(2, 1)+1, p_ub+shift - x_att = coarse_gbo(1, 1)+MODULO(xx-coarse_gbo(1, 1), s(1)) + DO xx = coarse_gbo(2, 1) + 1, p_ub + shift + x_att = coarse_gbo(1, 1) + MODULO(xx - coarse_gbo(1, 1), s(1)) IF (x_att >= my_coarse_bo(1, 1) .AND. x_att <= my_coarse_bo(2, 1)) THEN CALL dcopy(coarse_slice_size, & coarse_coeffs(x_att, my_coarse_bo(1, 2), & my_coarse_bo(1, 3)), ss, send_buf(sent_size(p_old)), 1) - sent_size(p_old) = sent_size(p_old)+coarse_slice_size + sent_size(p_old) = sent_size(p_old) + coarse_slice_size END IF END DO END IF - CPASSERT(ALL(sent_size(:n_procs-2) == send_offset(1:))) - CPASSERT(sent_size(n_procs-1) == send_tot_size) + CPASSERT(ALL(sent_size(:n_procs - 2) == send_offset(1:))) + CPASSERT(sent_size(n_procs - 1) == send_tot_size) ! test send/rcv sizes CALL mp_alltoall(send_size, real_rcv_size, 1, coarse_coeffs_pw%pw_grid%para%group) CPASSERT(ALL(real_rcv_size == rcv_size)) @@ -1306,29 +1306,29 @@ SUBROUTINE add_coarse2fine(coarse_coeffs_pw, fine_values_pw, & my_ub = MIN(coarse_gbo(2, 1), coarse_bo(2, 1)) pos_of_x => coarse_coeffs_pw%pw_grid%para%pos_of_x sent_size(:) = rcv_offset - ss = coarse_bo(2, 1)-coarse_bo(1, 1)+1 - DO x = my_ub+1, coarse_bo(2, 1) - p_old = pos_of_x(coarse_gbo(1, 1)+MODULO(x-coarse_gbo(1, 1), s(1))) + ss = coarse_bo(2, 1) - coarse_bo(1, 1) + 1 + DO x = my_ub + 1, coarse_bo(2, 1) + p_old = pos_of_x(coarse_gbo(1, 1) + MODULO(x - coarse_gbo(1, 1), s(1))) CALL dcopy(coarse_slice_size, & rcv_buf(sent_size(p_old)), 1, & coarse_coeffs(x, coarse_bo(1, 2), & coarse_bo(1, 3)), ss) - sent_size(p_old) = sent_size(p_old)+coarse_slice_size + sent_size(p_old) = sent_size(p_old) + coarse_slice_size END DO p_old = pos_of_x(coarse_gbo(1, 1) & - +MODULO(my_lb-coarse_gbo(1, 1), s(1))) + + MODULO(my_lb - coarse_gbo(1, 1), s(1))) p_lb = my_lb DO x = my_lb, my_ub - p = pos_of_x(coarse_gbo(1, 1)+MODULO(x-coarse_gbo(1, 1), s(1))) + p = pos_of_x(coarse_gbo(1, 1) + MODULO(x - coarse_gbo(1, 1), s(1))) IF (p /= p_old) THEN - p_ub = x-1 + p_ub = x - 1 ii = sent_size(p_old) DO k = coarse_bo(1, 3), coarse_bo(2, 3) DO j = coarse_bo(1, 2), coarse_bo(2, 2) DO i = p_lb, p_ub coarse_coeffs(i, j, k) = rcv_buf(ii) - ii = ii+1 + ii = ii + 1 END DO END DO END DO @@ -1337,7 +1337,7 @@ SUBROUTINE add_coarse2fine(coarse_coeffs_pw, fine_values_pw, & p_lb = x p_old = p END IF - rcv_size(p) = rcv_size(p)+coarse_slice_size + rcv_size(p) = rcv_size(p) + coarse_slice_size END DO p_ub = my_ub ii = sent_size(p_old) @@ -1345,22 +1345,22 @@ SUBROUTINE add_coarse2fine(coarse_coeffs_pw, fine_values_pw, & DO j = coarse_bo(1, 2), coarse_bo(2, 2) DO i = p_lb, p_ub coarse_coeffs(i, j, k) = rcv_buf(ii) - ii = ii+1 + ii = ii + 1 END DO END DO END DO sent_size(p_old) = ii - DO x = coarse_bo(1, 1), my_lb-1 - p_old = pos_of_x(coarse_gbo(1, 1)+MODULO(x-coarse_gbo(1, 1), s(1))) + DO x = coarse_bo(1, 1), my_lb - 1 + p_old = pos_of_x(coarse_gbo(1, 1) + MODULO(x - coarse_gbo(1, 1), s(1))) CALL dcopy(coarse_slice_size, & rcv_buf(sent_size(p_old)), 1, & coarse_coeffs(x, coarse_bo(1, 2), & coarse_bo(1, 3)), ss) - sent_size(p_old) = sent_size(p_old)+coarse_slice_size + sent_size(p_old) = sent_size(p_old) + coarse_slice_size END DO - CPASSERT(ALL(sent_size(0:n_procs-2) == rcv_offset(1:))) - CPASSERT(sent_size(n_procs-1) == rcv_tot_size) + CPASSERT(ALL(sent_size(0:n_procs - 2) == rcv_offset(1:))) + CPASSERT(sent_size(n_procs - 1) == rcv_tot_size) ! dealloc DEALLOCATE (send_size, send_offset, rcv_size, rcv_offset) @@ -1375,16 +1375,16 @@ SUBROUTINE add_coarse2fine(coarse_coeffs_pw, fine_values_pw, & DO k = coarse_bo(1, 3), coarse_bo(2, 3) DO ik = -3, 3 IF (pbc) THEN - wk = weights_1d(ABS(ik)+1) - fk = fine_gbo(1, 3)+MODULO(2*k+ik-fine_gbo(1, 3)+f_shift(3), 2*s(3)) + wk = weights_1d(ABS(ik) + 1) + fk = fine_gbo(1, 3) + MODULO(2*k + ik - fine_gbo(1, 3) + f_shift(3), 2*s(3)) ELSE - fk = 2*k+ik+f_shift(3) - IF (fk <= fine_bo(1, 3)+1 .OR. fk >= fine_bo(2, 3)-1) THEN + fk = 2*k + ik + f_shift(3) + IF (fk <= fine_bo(1, 3) + 1 .OR. fk >= fine_bo(2, 3) - 1) THEN IF (fk < fine_bo(1, 3) .OR. fk > fine_bo(2, 3)) CYCLE IF (fk == fine_bo(1, 3) .OR. fk == fine_bo(2, 3)) THEN IF (ik /= 0) CYCLE wk = w_border0 - ELSE IF (fk == 2*coarse_bo(1, 3)+1+f_shift(3)) THEN + ELSE IF (fk == 2*coarse_bo(1, 3) + 1 + f_shift(3)) THEN SELECT CASE (ik) CASE (1) wk = w_border1(1) @@ -1410,22 +1410,22 @@ SUBROUTINE add_coarse2fine(coarse_coeffs_pw, fine_values_pw, & END SELECT END IF ELSE - wk = weights_1d(ABS(ik)+1) + wk = weights_1d(ABS(ik) + 1) END IF END IF DO j = coarse_bo(1, 2), coarse_bo(2, 2) DO ij = -3, 3 IF (pbc) THEN - wj = weights_1d(ABS(ij)+1)*wk - fj = fine_gbo(1, 2)+MODULO(2*j+ij-fine_gbo(1, 2)+f_shift(2), 2*s(2)) + wj = weights_1d(ABS(ij) + 1)*wk + fj = fine_gbo(1, 2) + MODULO(2*j + ij - fine_gbo(1, 2) + f_shift(2), 2*s(2)) ELSE - fj = 2*j+ij+f_shift(2) - IF (fj <= fine_bo(1, 2)+1 .OR. fj >= fine_bo(2, 2)-1) THEN + fj = 2*j + ij + f_shift(2) + IF (fj <= fine_bo(1, 2) + 1 .OR. fj >= fine_bo(2, 2) - 1) THEN IF (fj < fine_bo(1, 2) .OR. fj > fine_bo(2, 2)) CYCLE IF (fj == fine_bo(1, 2) .OR. fj == fine_bo(2, 2)) THEN IF (ij /= 0) CYCLE wj = w_border0*wk - ELSE IF (fj == 2*coarse_bo(1, 2)+1+f_shift(2)) THEN + ELSE IF (fj == 2*coarse_bo(1, 2) + 1 + f_shift(2)) THEN SELECT CASE (ij) CASE (1) wj = w_border1(1)*wk @@ -1449,26 +1449,26 @@ SUBROUTINE add_coarse2fine(coarse_coeffs_pw, fine_values_pw, & END SELECT END IF ELSE - wj = weights_1d(ABS(ij)+1)*wk + wj = weights_1d(ABS(ij) + 1)*wk END IF END IF - IF (fine_bo(2, 1)-fine_bo(1, 1) < 7 .OR. safe_calc) THEN + IF (fine_bo(2, 1) - fine_bo(1, 1) < 7 .OR. safe_calc) THEN ! CALL timeset(routineN//"_safe",handle2) DO i = coarse_bo(1, 1), coarse_bo(2, 1) DO ii = -3, 3 IF (pbc .AND. .NOT. is_split) THEN - wi = weights_1d(ABS(ii)+1)*wj - fi = fine_gbo(1, 1)+MODULO(2*i+ii-fine_gbo(1, 1)+f_shift(1), 2*s(1)) + wi = weights_1d(ABS(ii) + 1)*wj + fi = fine_gbo(1, 1) + MODULO(2*i + ii - fine_gbo(1, 1) + f_shift(1), 2*s(1)) ELSE - fi = 2*i+ii+f_shift(1) + fi = 2*i + ii + f_shift(1) IF (fi < fine_bo(1, 1) .OR. fi > fine_bo(2, 1)) CYCLE - IF (.NOT. pbc .AND. (fi <= fine_gbo(1, 1)+1 .OR. & - fi >= fine_gbo(2, 1)-1)) THEN + IF (.NOT. pbc .AND. (fi <= fine_gbo(1, 1) + 1 .OR. & + fi >= fine_gbo(2, 1) - 1)) THEN IF (fi == fine_gbo(1, 1) .OR. fi == fine_gbo(2, 1)) THEN IF (ii /= 0) CYCLE wi = w_border0*wj - ELSE IF (fi == fine_gbo(1, 1)+1) THEN + ELSE IF (fi == fine_gbo(1, 1) + 1) THEN SELECT CASE (ii) CASE (1) wi = w_border1(1)*wj @@ -1492,11 +1492,11 @@ SUBROUTINE add_coarse2fine(coarse_coeffs_pw, fine_values_pw, & END SELECT END IF ELSE - wi = weights_1d(ABS(ii)+1)*wj + wi = weights_1d(ABS(ii) + 1)*wj END IF END IF fine_values(fi, fj, fk) = & - fine_values(fi, fj, fk)+ & + fine_values(fi, fj, fk) + & wi*coarse_coeffs(i, j, k) END DO END DO @@ -1508,261 +1508,261 @@ SUBROUTINE add_coarse2fine(coarse_coeffs_pw, fine_values_pw, & IF (pbc .AND. .NOT. is_split) THEN v3 = coarse_coeffs(coarse_bo(2, 1), j, k) i = coarse_bo(1, 1) - fi = 2*i+f_shift(1) + fi = 2*i + f_shift(1) v0 = coarse_coeffs(i, j, k) - v1 = coarse_coeffs(i+1, j, k) - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww0(1)*v3+ww0(2)*v0+ww0(3)*v1 - v2 = coarse_coeffs(i+2, j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww1(1)*v3+ww1(2)*v0+ww1(3)*v1+ww1(4)*v2 + v1 = coarse_coeffs(i + 1, j, k) + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww0(1)*v3 + ww0(2)*v0 + ww0(3)*v1 + v2 = coarse_coeffs(i + 2, j, k) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww1(1)*v3 + ww1(2)*v0 + ww1(3)*v1 + ww1(4)*v2 ELSE IF (.NOT. has_i_lbound) THEN i = coarse_bo(1, 1) - fi = 2*i+f_shift(1) + fi = 2*i + f_shift(1) v0 = coarse_coeffs(i, j, k) - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & w_border0*wj*v0 - v1 = coarse_coeffs(i+1, j, k) - v2 = coarse_coeffs(i+2, j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - wj*(w_border1(1)*v0+w_border1(2)*v1+ & + v1 = coarse_coeffs(i + 1, j, k) + v2 = coarse_coeffs(i + 2, j, k) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + wj*(w_border1(1)*v0 + w_border1(2)*v1 + & w_border1(3)*v2) ELSE i = coarse_bo(1, 1) v0 = coarse_coeffs(i, j, k) - v1 = coarse_coeffs(i+1, j, k) - v2 = coarse_coeffs(i+2, j, k) - fi = 2*i+f_shift(1)+1 - IF (.NOT. (fi+1 == fine_bo(1, 1) .OR. & - fi+2 == fine_bo(1, 1))) THEN + v1 = coarse_coeffs(i + 1, j, k) + v2 = coarse_coeffs(i + 2, j, k) + fi = 2*i + f_shift(1) + 1 + IF (.NOT. (fi + 1 == fine_bo(1, 1) .OR. & + fi + 2 == fine_bo(1, 1))) THEN CALL cp_abort(__LOCATION__, & "unexpected start index "// & TRIM(cp_to_string(coarse_bo(1, 1)))//" "// & TRIM(cp_to_string(fi))) END IF END IF - fi = fi+1 + fi = fi + 1 IF (fi >= fine_bo(1, 1)) THEN - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww0(1)*v0+ww0(2)*v1+ & + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww0(1)*v0 + ww0(2)*v1 + & ww0(3)*v2 ELSE - CPASSERT(fi+1 == fine_bo(1, 1)) + CPASSERT(fi + 1 == fine_bo(1, 1)) END IF ! CALL timestop(handle2) ! CALL timeset(routineN//"_core",handle2) - DO i = coarse_bo(1, 1)+3, FLOOR((fine_bo(2, 1)-f_shift(1))/2.)-3, 4 + DO i = coarse_bo(1, 1) + 3, FLOOR((fine_bo(2, 1) - f_shift(1))/2.) - 3, 4 v3 = coarse_coeffs(i, j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - (ww1(1)*v0+ww1(2)*v1+ & - ww1(3)*v2+ww1(4)*v3) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - (ww0(1)*v1+ww0(2)*v2+ & + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + (ww1(1)*v0 + ww1(2)*v1 + & + ww1(3)*v2 + ww1(4)*v3) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + (ww0(1)*v1 + ww0(2)*v2 + & ww0(3)*v3) - v0 = coarse_coeffs(i+1, j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - (ww1(4)*v0+ww1(1)*v1+ & - ww1(2)*v2+ww1(3)*v3) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - (ww0(1)*v2+ww0(2)*v3+ & + v0 = coarse_coeffs(i + 1, j, k) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + (ww1(4)*v0 + ww1(1)*v1 + & + ww1(2)*v2 + ww1(3)*v3) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + (ww0(1)*v2 + ww0(2)*v3 + & ww0(3)*v0) - v1 = coarse_coeffs(i+2, j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - (ww1(3)*v0+ww1(4)*v1+ & - ww1(1)*v2+ww1(2)*v3) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - (ww0(1)*v3+ww0(2)*v0+ & + v1 = coarse_coeffs(i + 2, j, k) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + (ww1(3)*v0 + ww1(4)*v1 + & + ww1(1)*v2 + ww1(2)*v3) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + (ww0(1)*v3 + ww0(2)*v0 + & ww0(3)*v1) - v2 = coarse_coeffs(i+3, j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - (ww1(2)*v0+ww1(3)*v1+ & - ww1(4)*v2+ww1(1)*v3) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - (ww0(1)*v0+ww0(2)*v1+ & + v2 = coarse_coeffs(i + 3, j, k) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + (ww1(2)*v0 + ww1(3)*v1 + & + ww1(4)*v2 + ww1(1)*v3) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + (ww0(1)*v0 + ww0(2)*v1 + & ww0(3)*v2) END DO ! CALL timestop(handle2) ! CALL timeset(routineN//"_clean",handle2) - rest_b = MODULO(FLOOR((fine_bo(2, 1)-f_shift(1))/2.)-coarse_bo(1, 1)-3+1, 4) + rest_b = MODULO(FLOOR((fine_bo(2, 1) - f_shift(1))/2.) - coarse_bo(1, 1) - 3 + 1, 4) IF (rest_b > 0) THEN - i = FLOOR((fine_bo(2, 1)-f_shift(1))/2.)-rest_b+1 + i = FLOOR((fine_bo(2, 1) - f_shift(1))/2.) - rest_b + 1 v3 = coarse_coeffs(i, j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - (ww1(1)*v0+ww1(2)*v1+ & - ww1(3)*v2+ww1(4)*v3) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - (ww0(1)*v1+ww0(2)*v2+ & + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + (ww1(1)*v0 + ww1(2)*v1 + & + ww1(3)*v2 + ww1(4)*v3) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + (ww0(1)*v1 + ww0(2)*v2 + & ww0(3)*v3) IF (rest_b > 1) THEN - v0 = coarse_coeffs(i+1, j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - (ww1(4)*v0+ww1(1)*v1+ & - ww1(2)*v2+ww1(3)*v3) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - (ww0(1)*v2+ww0(2)*v3+ & + v0 = coarse_coeffs(i + 1, j, k) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + (ww1(4)*v0 + ww1(1)*v1 + & + ww1(2)*v2 + ww1(3)*v3) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + (ww0(1)*v2 + ww0(2)*v3 + & ww0(3)*v0) IF (rest_b > 2) THEN - v1 = coarse_coeffs(i+2, j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - (ww1(3)*v0+ww1(4)*v1+ & - ww1(1)*v2+ww1(2)*v3) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - (ww0(1)*v3+ww0(2)*v0+ & + v1 = coarse_coeffs(i + 2, j, k) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + (ww1(3)*v0 + ww1(4)*v1 + & + ww1(1)*v2 + ww1(2)*v3) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + (ww0(1)*v3 + ww0(2)*v0 + & ww0(3)*v1) IF (pbc .AND. .NOT. is_split) THEN v2 = coarse_coeffs(coarse_bo(1, 1), j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww1(1)*v3+ww1(2)*v0+ww1(3)*v1+ww1(4)*v2 - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww0(1)*v0+ww0(2)*v1+ww0(3)*v2 - v3 = coarse_coeffs(coarse_bo(1, 1)+1, j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww1(1)*v0+ww1(2)*v1+ww1(3)*v2+ww1(4)*v3 + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww1(1)*v3 + ww1(2)*v0 + ww1(3)*v1 + ww1(4)*v2 + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww0(1)*v0 + ww0(2)*v1 + ww0(3)*v2 + v3 = coarse_coeffs(coarse_bo(1, 1) + 1, j, k) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww1(1)*v0 + ww1(2)*v1 + ww1(3)*v2 + ww1(4)*v3 ELSE IF (has_i_ubound) THEN - v2 = coarse_coeffs(i+3, j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww1(1)*v3+ww1(2)*v0+ww1(3)*v1+ww1(4)*v2 - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww0(1)*v0+ww0(2)*v1+ww0(3)*v2 - IF (fi+1 == fine_bo(2, 1)) THEN - v3 = coarse_coeffs(i+4, j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww1(1)*v0+ww1(2)*v1+ww1(3)*v2+ww1(4)*v3 + v2 = coarse_coeffs(i + 3, j, k) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww1(1)*v3 + ww1(2)*v0 + ww1(3)*v1 + ww1(4)*v2 + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww0(1)*v0 + ww0(2)*v1 + ww0(3)*v2 + IF (fi + 1 == fine_bo(2, 1)) THEN + v3 = coarse_coeffs(i + 4, j, k) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww1(1)*v0 + ww1(2)*v1 + ww1(3)*v2 + ww1(4)*v3 END IF ELSE - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - wj*(w_border1(3)*v3+w_border1(2)*v0+ & + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + wj*(w_border1(3)*v3 + w_border1(2)*v0 + & w_border1(1)*v1) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & w_border0*wj*v1 END IF ELSE IF (pbc .AND. .NOT. is_split) THEN v1 = coarse_coeffs(coarse_bo(1, 1), j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww1(1)*v2+ww1(2)*v3+ww1(3)*v0+ww1(4)*v1 - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww0(1)*v3+ww0(2)*v0+ww0(3)*v1 - v2 = coarse_coeffs(coarse_bo(1, 1)+1, j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww1(1)*v3+ww1(2)*v0+ww1(3)*v1+ww1(4)*v2 + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww1(1)*v2 + ww1(2)*v3 + ww1(3)*v0 + ww1(4)*v1 + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww0(1)*v3 + ww0(2)*v0 + ww0(3)*v1 + v2 = coarse_coeffs(coarse_bo(1, 1) + 1, j, k) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww1(1)*v3 + ww1(2)*v0 + ww1(3)*v1 + ww1(4)*v2 ELSE IF (has_i_ubound) THEN - v1 = coarse_coeffs(i+2, j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww1(1)*v2+ww1(2)*v3+ww1(3)*v0+ww1(4)*v1 - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww0(1)*v3+ww0(2)*v0+ww0(3)*v1 - IF (fi+1 == fine_bo(2, 1)) THEN - v2 = coarse_coeffs(i+3, j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww1(1)*v3+ww1(2)*v0+ww1(3)*v1+ww1(4)*v2 + v1 = coarse_coeffs(i + 2, j, k) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww1(1)*v2 + ww1(2)*v3 + ww1(3)*v0 + ww1(4)*v1 + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww0(1)*v3 + ww0(2)*v0 + ww0(3)*v1 + IF (fi + 1 == fine_bo(2, 1)) THEN + v2 = coarse_coeffs(i + 3, j, k) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww1(1)*v3 + ww1(2)*v0 + ww1(3)*v1 + ww1(4)*v2 END IF ELSE - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - wj*(w_border1(3)*v2+w_border1(2)*v3+ & + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + wj*(w_border1(3)*v2 + w_border1(2)*v3 + & w_border1(1)*v0) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & w_border0*wj*v0 END IF ELSE IF (pbc .AND. .NOT. is_split) THEN v0 = coarse_coeffs(coarse_bo(1, 1), j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww1(1)*v1+ww1(2)*v2+ww1(3)*v3+ww1(4)*v0 - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww0(1)*v2+ww0(2)*v3+ww0(3)*v0 - v1 = coarse_coeffs(coarse_bo(1, 1)+1, j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww1(1)*v2+ww1(2)*v3+ww1(3)*v0+ww1(4)*v1 + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww1(1)*v1 + ww1(2)*v2 + ww1(3)*v3 + ww1(4)*v0 + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww0(1)*v2 + ww0(2)*v3 + ww0(3)*v0 + v1 = coarse_coeffs(coarse_bo(1, 1) + 1, j, k) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww1(1)*v2 + ww1(2)*v3 + ww1(3)*v0 + ww1(4)*v1 ELSE IF (has_i_ubound) THEN - v0 = coarse_coeffs(i+1, j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww1(1)*v1+ww1(2)*v2+ww1(3)*v3+ww1(4)*v0 - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww0(1)*v2+ww0(2)*v3+ww0(3)*v0 - IF (fi+1 == fine_bo(2, 1)) THEN - v1 = coarse_coeffs(i+2, j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww1(1)*v2+ww1(2)*v3+ww1(3)*v0+ww1(4)*v1 + v0 = coarse_coeffs(i + 1, j, k) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww1(1)*v1 + ww1(2)*v2 + ww1(3)*v3 + ww1(4)*v0 + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww0(1)*v2 + ww0(2)*v3 + ww0(3)*v0 + IF (fi + 1 == fine_bo(2, 1)) THEN + v1 = coarse_coeffs(i + 2, j, k) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww1(1)*v2 + ww1(2)*v3 + ww1(3)*v0 + ww1(4)*v1 END IF ELSE - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - wj*(w_border1(3)*v1+w_border1(2)*v2+ & + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + wj*(w_border1(3)*v1 + w_border1(2)*v2 + & w_border1(1)*v3) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & w_border0*wj*v3 END IF ELSE IF (pbc .AND. .NOT. is_split) THEN v3 = coarse_coeffs(coarse_bo(1, 1), j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww1(1)*v0+ww1(2)*v1+ww1(3)*v2+ww1(4)*v3 - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww0(1)*v1+ww0(2)*v2+ww0(3)*v3 - v0 = coarse_coeffs(coarse_bo(1, 1)+1, j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww1(1)*v1+ww1(2)*v2+ww1(3)*v3+ww1(4)*v0 + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww1(1)*v0 + ww1(2)*v1 + ww1(3)*v2 + ww1(4)*v3 + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww0(1)*v1 + ww0(2)*v2 + ww0(3)*v3 + v0 = coarse_coeffs(coarse_bo(1, 1) + 1, j, k) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww1(1)*v1 + ww1(2)*v2 + ww1(3)*v3 + ww1(4)*v0 ELSE IF (has_i_ubound) THEN v3 = coarse_coeffs(i, j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww1(1)*v0+ww1(2)*v1+ww1(3)*v2+ww1(4)*v3 - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww0(1)*v1+ww0(2)*v2+ww0(3)*v3 - IF (fi+1 == fine_bo(2, 1)) THEN - v0 = coarse_coeffs(i+1, j, k) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - ww1(1)*v1+ww1(2)*v2+ww1(3)*v3+ww1(4)*v0 + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww1(1)*v0 + ww1(2)*v1 + ww1(3)*v2 + ww1(4)*v3 + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww0(1)*v1 + ww0(2)*v2 + ww0(3)*v3 + IF (fi + 1 == fine_bo(2, 1)) THEN + v0 = coarse_coeffs(i + 1, j, k) + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + ww1(1)*v1 + ww1(2)*v2 + ww1(3)*v3 + ww1(4)*v0 END IF ELSE - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & - wj*(w_border1(3)*v0+w_border1(2)*v1+ & + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & + wj*(w_border1(3)*v0 + w_border1(2)*v1 + & w_border1(1)*v2) - fi = fi+1 - fine_values(fi, fj, fk) = fine_values(fi, fj, fk)+ & + fi = fi + 1 + fine_values(fi, fj, fk) = fine_values(fi, fj, fk) + & w_border0*wj*v2 END IF CPASSERT(fi == fine_bo(2, 1)) @@ -1853,15 +1853,15 @@ SUBROUTINE add_fine2coarse(fine_values_pw, coarse_coeffs_pw, & coarse_gbo = coarse_coeffs_pw%pw_grid%bounds fine_bo = fine_values_pw%pw_grid%bounds_local fine_gbo = fine_values_pw%pw_grid%bounds - f_shift = fine_gbo(1, :)-2*coarse_gbo(1, :) + f_shift = fine_gbo(1, :) - 2*coarse_gbo(1, :) is_split = ANY(coarse_gbo(:, 1) /= my_coarse_bo(:, 1)) coarse_bo = my_coarse_bo IF (fine_bo(1, 1) <= fine_bo(2, 1)) THEN - coarse_bo(1, 1) = FLOOR(REAL(fine_bo(1, 1)-f_shift(1), dp)/2._dp)-1 - coarse_bo(2, 1) = FLOOR(REAL(fine_bo(2, 1)+1-f_shift(1), dp)/2._dp)+1 + coarse_bo(1, 1) = FLOOR(REAL(fine_bo(1, 1) - f_shift(1), dp)/2._dp) - 1 + coarse_bo(2, 1) = FLOOR(REAL(fine_bo(2, 1) + 1 - f_shift(1), dp)/2._dp) + 1 ELSE coarse_bo(1, 1) = coarse_gbo(2, 1) - coarse_bo(2, 1) = coarse_gbo(2, 1)-1 + coarse_bo(2, 1) = coarse_gbo(2, 1) - 1 END IF IF (.NOT. is_split .OR. .NOT. pbc) THEN coarse_bo(1, 1) = MAX(coarse_gbo(1, 1), coarse_bo(1, 1)) @@ -1871,13 +1871,13 @@ SUBROUTINE add_fine2coarse(fine_values_pw, coarse_coeffs_pw, & has_i_lbound = (fine_gbo(1, 1) /= fine_bo(1, 1)) .OR. pbc .AND. is_split IF (pbc) THEN - CPASSERT(ALL(fine_gbo(1, :) == 2*coarse_gbo(1, :)+f_shift)) - CPASSERT(ALL(fine_gbo(2, :) == 2*coarse_gbo(2, :)+f_shift+1)) + CPASSERT(ALL(fine_gbo(1, :) == 2*coarse_gbo(1, :) + f_shift)) + CPASSERT(ALL(fine_gbo(2, :) == 2*coarse_gbo(2, :) + f_shift + 1)) ELSE - CPASSERT(ALL(fine_gbo(2, :) == 2*coarse_gbo(2, :)+f_shift)) - CPASSERT(ALL(fine_gbo(1, :) == 2*coarse_gbo(1, :)+f_shift)) + CPASSERT(ALL(fine_gbo(2, :) == 2*coarse_gbo(2, :) + f_shift)) + CPASSERT(ALL(fine_gbo(1, :) == 2*coarse_gbo(1, :) + f_shift)) END IF - CPASSERT(coarse_gbo(2, 1)-coarse_gbo(1, 2) > 1) + CPASSERT(coarse_gbo(2, 1) - coarse_gbo(1, 2) > 1) local_data = is_split ! ANY(coarse_bo/=my_coarse_bo) IF (local_data) THEN ALLOCATE (coarse_coeffs(coarse_bo(1, 1):coarse_bo(2, 1), & @@ -1893,23 +1893,23 @@ SUBROUTINE add_fine2coarse(fine_values_pw, coarse_coeffs_pw, & w_1 = (/weights_1d(4), weights_1d(2), weights_1d(2), weights_1d(4)/) DO i = 1, 3 - s(i) = coarse_gbo(2, i)-coarse_gbo(1, i)+1 + s(i) = coarse_gbo(2, i) - coarse_gbo(1, i) + 1 END DO IF (ANY(s < 1)) RETURN DO k = coarse_bo(1, 3), coarse_bo(2, 3) DO ik = -3, 3 IF (pbc) THEN - wk = weights_1d(ABS(ik)+1) - fk = fine_gbo(1, 3)+MODULO(2*k+ik-fine_gbo(1, 3)+f_shift(3), 2*s(3)) + wk = weights_1d(ABS(ik) + 1) + fk = fine_gbo(1, 3) + MODULO(2*k + ik - fine_gbo(1, 3) + f_shift(3), 2*s(3)) ELSE - fk = 2*k+ik+f_shift(3) - IF (fk <= fine_bo(1, 3)+1 .OR. fk >= fine_bo(2, 3)-1) THEN + fk = 2*k + ik + f_shift(3) + IF (fk <= fine_bo(1, 3) + 1 .OR. fk >= fine_bo(2, 3) - 1) THEN IF (fk < fine_bo(1, 3) .OR. fk > fine_bo(2, 3)) CYCLE IF (fk == fine_bo(1, 3) .OR. fk == fine_bo(2, 3)) THEN IF (ik /= 0) CYCLE wk = w_border0 - ELSE IF (fk == fine_bo(1, 3)+1) THEN + ELSE IF (fk == fine_bo(1, 3) + 1) THEN SELECT CASE (ik) CASE (1) wk = w_border1(1) @@ -1935,23 +1935,23 @@ SUBROUTINE add_fine2coarse(fine_values_pw, coarse_coeffs_pw, & END SELECT END IF ELSE - wk = weights_1d(ABS(ik)+1) + wk = weights_1d(ABS(ik) + 1) END IF END IF DO j = coarse_bo(1, 2), coarse_bo(2, 2) DO ij = -3, 3 IF (pbc) THEN - fj = fine_gbo(1, 2)+MODULO(2*j+ij-fine_gbo(1, 2)+f_shift(2), & - 2*s(2)) - wj = weights_1d(ABS(ij)+1)*wk + fj = fine_gbo(1, 2) + MODULO(2*j + ij - fine_gbo(1, 2) + f_shift(2), & + 2*s(2)) + wj = weights_1d(ABS(ij) + 1)*wk ELSE - fj = 2*j+ij+f_shift(2) - IF (fj <= fine_bo(1, 2)+1 .OR. fj >= fine_bo(2, 2)-1) THEN + fj = 2*j + ij + f_shift(2) + IF (fj <= fine_bo(1, 2) + 1 .OR. fj >= fine_bo(2, 2) - 1) THEN IF (fj < fine_bo(1, 2) .OR. fj > fine_bo(2, 2)) CYCLE IF (fj == fine_bo(1, 2) .OR. fj == fine_bo(2, 2)) THEN IF (ij /= 0) CYCLE wj = w_border0*wk - ELSE IF (fj == fine_bo(1, 2)+1) THEN + ELSE IF (fj == fine_bo(1, 2) + 1) THEN SELECT CASE (ij) CASE (1) wj = w_border1(1)*wk @@ -1977,25 +1977,25 @@ SUBROUTINE add_fine2coarse(fine_values_pw, coarse_coeffs_pw, & END SELECT END IF ELSE - wj = weights_1d(ABS(ij)+1)*wk + wj = weights_1d(ABS(ij) + 1)*wk END IF END IF - IF (coarse_bo(2, 1)-coarse_bo(1, 1) < 7 .OR. safe_calc) THEN + IF (coarse_bo(2, 1) - coarse_bo(1, 1) < 7 .OR. safe_calc) THEN DO i = coarse_bo(1, 1), coarse_bo(2, 1) DO ii = -3, 3 IF (pbc .AND. .NOT. is_split) THEN - wi = weights_1d(ABS(ii)+1)*wj - fi = fine_gbo(1, 1)+MODULO(2*i+ii-fine_gbo(1, 1)+f_shift(1), 2*s(1)) + wi = weights_1d(ABS(ii) + 1)*wj + fi = fine_gbo(1, 1) + MODULO(2*i + ii - fine_gbo(1, 1) + f_shift(1), 2*s(1)) ELSE - fi = 2*i+ii+f_shift(1) + fi = 2*i + ii + f_shift(1) IF (fi < fine_bo(1, 1) .OR. fi > fine_bo(2, 1)) CYCLE - IF (((.NOT. pbc) .AND. fi <= fine_gbo(1, 1)+1) .OR. & - ((.NOT. pbc) .AND. fi >= fine_gbo(2, 1)-1)) THEN + IF (((.NOT. pbc) .AND. fi <= fine_gbo(1, 1) + 1) .OR. & + ((.NOT. pbc) .AND. fi >= fine_gbo(2, 1) - 1)) THEN IF (fi == fine_gbo(1, 1) .OR. fi == fine_gbo(2, 1)) THEN IF (ii /= 0) CYCLE wi = w_border0*wj - ELSE IF (fi == fine_gbo(1, 1)+1) THEN + ELSE IF (fi == fine_gbo(1, 1) + 1) THEN SELECT CASE (ii) CASE (1) wi = w_border1(1)*wj @@ -2019,11 +2019,11 @@ SUBROUTINE add_fine2coarse(fine_values_pw, coarse_coeffs_pw, & END SELECT END IF ELSE - wi = weights_1d(ABS(ii)+1)*wj + wi = weights_1d(ABS(ii) + 1)*wj END IF END IF coarse_coeffs(i, j, k) = & - coarse_coeffs(i, j, k)+ & + coarse_coeffs(i, j, k) + & wi*fine_values(fi, fj, fk) END DO END DO @@ -2031,288 +2031,288 @@ SUBROUTINE add_fine2coarse(fine_values_pw, coarse_coeffs_pw, & ww0 = wj*w_0 ww1 = wj*w_1 IF (pbc .AND. .NOT. is_split) THEN - i = coarse_bo(1, 1)-1 - vv2 = fine_values(fine_bo(2, 1)-2, fj, fk) - vv3 = fine_values(fine_bo(2, 1)-1, fj, fk) + i = coarse_bo(1, 1) - 1 + vv2 = fine_values(fine_bo(2, 1) - 2, fj, fk) + vv3 = fine_values(fine_bo(2, 1) - 1, fj, fk) vv4 = fine_values(fine_bo(2, 1), fj, fk) fi = fine_bo(1, 1) vv5 = fine_values(fi, fj, fk) - fi = fi+1 + fi = fi + 1 vv6 = fine_values(fi, fj, fk) - fi = fi+1 + fi = fi + 1 vv7 = fine_values(fi, fj, fk) - coarse_coeffs(i+1, j, k) = coarse_coeffs(i+1, j, k) & - +ww1(4)*vv2+ww0(3)*vv3+ww1(3)*vv4+ww0(2)*vv5+ww1(2)*vv6+ww0(1)*vv7 - coarse_coeffs(i+2, j, k) = coarse_coeffs(i+2, j, k) & - +ww1(4)*vv4+ww0(3)*vv5+ww1(3)*vv6+ww0(2)*vv7 - coarse_coeffs(i+3, j, k) = coarse_coeffs(i+3, j, k) & - +ww1(4)*vv6+ww0(3)*vv7 + coarse_coeffs(i + 1, j, k) = coarse_coeffs(i + 1, j, k) & + + ww1(4)*vv2 + ww0(3)*vv3 + ww1(3)*vv4 + ww0(2)*vv5 + ww1(2)*vv6 + ww0(1)*vv7 + coarse_coeffs(i + 2, j, k) = coarse_coeffs(i + 2, j, k) & + + ww1(4)*vv4 + ww0(3)*vv5 + ww1(3)*vv6 + ww0(2)*vv7 + coarse_coeffs(i + 3, j, k) = coarse_coeffs(i + 3, j, k) & + + ww1(4)*vv6 + ww0(3)*vv7 ELSE IF (has_i_lbound) THEN i = coarse_bo(1, 1) - fi = fine_bo(1, 1)-1 - IF (i+1 == FLOOR((fine_bo(1, 1)+1-f_shift(1))/2._dp)) THEN - fi = fi+1 + fi = fine_bo(1, 1) - 1 + IF (i + 1 == FLOOR((fine_bo(1, 1) + 1 - f_shift(1))/2._dp)) THEN + fi = fi + 1 vv0 = fine_values(fi, fj, fk) - coarse_coeffs(i, j, k) = coarse_coeffs(i, j, k)+ & + coarse_coeffs(i, j, k) = coarse_coeffs(i, j, k) + & vv0*ww0(3) - coarse_coeffs(i+1, j, k) = coarse_coeffs(i+1, j, k)+ & - vv0*ww0(2) - coarse_coeffs(i+2, j, k) = coarse_coeffs(i+2, j, k)+ & - vv0*ww0(1) + coarse_coeffs(i + 1, j, k) = coarse_coeffs(i + 1, j, k) + & + vv0*ww0(2) + coarse_coeffs(i + 2, j, k) = coarse_coeffs(i + 2, j, k) + & + vv0*ww0(1) END IF ELSE i = coarse_bo(1, 1) - fi = 2*i+f_shift(1) + fi = 2*i + f_shift(1) vv0 = fine_values(fi, fj, fk) - fi = fi+1 + fi = fi + 1 vv1 = fine_values(fi, fj, fk) - fi = fi+1 + fi = fi + 1 vv2 = fine_values(fi, fj, fk) - coarse_coeffs(i, j, k) = coarse_coeffs(i, j, k)+ & - (vv0*w_border0+vv1*w_border1(1))*wj+vv2*ww0(1) - coarse_coeffs(i+1, j, k) = coarse_coeffs(i+1, j, k)+ & - wj*w_border1(2)*vv1+ww0(2)*vv2 - coarse_coeffs(i+2, j, k) = coarse_coeffs(i+2, j, k)+ & - wj*w_border1(3)*vv1+ww0(3)*vv2 + coarse_coeffs(i, j, k) = coarse_coeffs(i, j, k) + & + (vv0*w_border0 + vv1*w_border1(1))*wj + vv2*ww0(1) + coarse_coeffs(i + 1, j, k) = coarse_coeffs(i + 1, j, k) + & + wj*w_border1(2)*vv1 + ww0(2)*vv2 + coarse_coeffs(i + 2, j, k) = coarse_coeffs(i + 2, j, k) + & + wj*w_border1(3)*vv1 + ww0(3)*vv2 END IF - DO i = coarse_bo(1, 1)+3, FLOOR((fine_bo(2, 1)-f_shift(1))/2._dp)-3, 4 - fi = fi+1 + DO i = coarse_bo(1, 1) + 3, FLOOR((fine_bo(2, 1) - f_shift(1))/2._dp) - 3, 4 + fi = fi + 1 vv0 = fine_values(fi, fj, fk) - fi = fi+1 + fi = fi + 1 vv1 = fine_values(fi, fj, fk) - fi = fi+1 + fi = fi + 1 vv2 = fine_values(fi, fj, fk) - fi = fi+1 + fi = fi + 1 vv3 = fine_values(fi, fj, fk) - fi = fi+1 + fi = fi + 1 vv4 = fine_values(fi, fj, fk) - fi = fi+1 + fi = fi + 1 vv5 = fine_values(fi, fj, fk) - fi = fi+1 + fi = fi + 1 vv6 = fine_values(fi, fj, fk) - fi = fi+1 + fi = fi + 1 vv7 = fine_values(fi, fj, fk) - coarse_coeffs(i-3, j, k) = coarse_coeffs(i-3, j, k) & - +ww1(1)*vv0 - coarse_coeffs(i-2, j, k) = coarse_coeffs(i-2, j, k) & - +ww1(2)*vv0+ww0(1)*vv1+ww1(1)*vv2 - coarse_coeffs(i-1, j, k) = coarse_coeffs(i-1, j, k) & - +ww1(3)*vv0+ww0(2)*vv1+ww1(2)*vv2+ww0(1)*vv3+ww1(1)*vv4 + coarse_coeffs(i - 3, j, k) = coarse_coeffs(i - 3, j, k) & + + ww1(1)*vv0 + coarse_coeffs(i - 2, j, k) = coarse_coeffs(i - 2, j, k) & + + ww1(2)*vv0 + ww0(1)*vv1 + ww1(1)*vv2 + coarse_coeffs(i - 1, j, k) = coarse_coeffs(i - 1, j, k) & + + ww1(3)*vv0 + ww0(2)*vv1 + ww1(2)*vv2 + ww0(1)*vv3 + ww1(1)*vv4 coarse_coeffs(i, j, k) = coarse_coeffs(i, j, k) & - +ww1(4)*vv0+ww0(3)*vv1+ww1(3)*vv2+ww0(2)*vv3+ww1(2)*vv4+ww0(1)*vv5+ww1(1)*vv6 - coarse_coeffs(i+1, j, k) = coarse_coeffs(i+1, j, k) & - +ww1(4)*vv2+ww0(3)*vv3+ww1(3)*vv4+ww0(2)*vv5+ww1(2)*vv6+ww0(1)*vv7 - coarse_coeffs(i+2, j, k) = coarse_coeffs(i+2, j, k) & - +ww1(4)*vv4+ww0(3)*vv5+ww1(3)*vv6+ww0(2)*vv7 - coarse_coeffs(i+3, j, k) = coarse_coeffs(i+3, j, k) & - +ww1(4)*vv6+ww0(3)*vv7 + + ww1(4)*vv0 + ww0(3)*vv1 + ww1(3)*vv2 + ww0(2)*vv3 + ww1(2)*vv4 + ww0(1)*vv5 + ww1(1)*vv6 + coarse_coeffs(i + 1, j, k) = coarse_coeffs(i + 1, j, k) & + + ww1(4)*vv2 + ww0(3)*vv3 + ww1(3)*vv4 + ww0(2)*vv5 + ww1(2)*vv6 + ww0(1)*vv7 + coarse_coeffs(i + 2, j, k) = coarse_coeffs(i + 2, j, k) & + + ww1(4)*vv4 + ww0(3)*vv5 + ww1(3)*vv6 + ww0(2)*vv7 + coarse_coeffs(i + 3, j, k) = coarse_coeffs(i + 3, j, k) & + + ww1(4)*vv6 + ww0(3)*vv7 END DO - IF (.NOT. FLOOR((fine_bo(2, 1)-f_shift(1))/2._dp)-coarse_bo(1, 1) >= 4) THEN + IF (.NOT. FLOOR((fine_bo(2, 1) - f_shift(1))/2._dp) - coarse_bo(1, 1) >= 4) THEN CPABORT("FLOOR((fine_bo(2,1)-f_shift(1))/2._dp)-coarse_bo(1,1)>=4") END IF - rest_b = MODULO(FLOOR((fine_bo(2, 1)-f_shift(1))/2._dp)-coarse_bo(1, 1)-6, 4) - i = FLOOR((fine_bo(2, 1)-f_shift(1))/2._dp)-3-rest_b+4 - CPASSERT(fi == (i-2)*2+f_shift(1)) + rest_b = MODULO(FLOOR((fine_bo(2, 1) - f_shift(1))/2._dp) - coarse_bo(1, 1) - 6, 4) + i = FLOOR((fine_bo(2, 1) - f_shift(1))/2._dp) - 3 - rest_b + 4 + CPASSERT(fi == (i - 2)*2 + f_shift(1)) IF (rest_b > 0) THEN - fi = fi+1 + fi = fi + 1 vv0 = fine_values(fi, fj, fk) - fi = fi+1 + fi = fi + 1 vv1 = fine_values(fi, fj, fk) - coarse_coeffs(i-3, j, k) = coarse_coeffs(i-3, j, k) & - +ww1(1)*vv0 - coarse_coeffs(i-2, j, k) = coarse_coeffs(i-2, j, k) & - +ww1(2)*vv0+ww0(1)*vv1 - coarse_coeffs(i-1, j, k) = coarse_coeffs(i-1, j, k) & - +ww1(3)*vv0+ww0(2)*vv1 + coarse_coeffs(i - 3, j, k) = coarse_coeffs(i - 3, j, k) & + + ww1(1)*vv0 + coarse_coeffs(i - 2, j, k) = coarse_coeffs(i - 2, j, k) & + + ww1(2)*vv0 + ww0(1)*vv1 + coarse_coeffs(i - 1, j, k) = coarse_coeffs(i - 1, j, k) & + + ww1(3)*vv0 + ww0(2)*vv1 coarse_coeffs(i, j, k) = coarse_coeffs(i, j, k) & - +ww1(4)*vv0+ww0(3)*vv1 + + ww1(4)*vv0 + ww0(3)*vv1 IF (rest_b > 1) THEN - fi = fi+1 + fi = fi + 1 vv2 = fine_values(fi, fj, fk) - fi = fi+1 + fi = fi + 1 vv3 = fine_values(fi, fj, fk) - coarse_coeffs(i-2, j, k) = coarse_coeffs(i-2, j, k) & - +ww1(1)*vv2 - coarse_coeffs(i-1, j, k) = coarse_coeffs(i-1, j, k) & - +ww1(2)*vv2+ww0(1)*vv3 + coarse_coeffs(i - 2, j, k) = coarse_coeffs(i - 2, j, k) & + + ww1(1)*vv2 + coarse_coeffs(i - 1, j, k) = coarse_coeffs(i - 1, j, k) & + + ww1(2)*vv2 + ww0(1)*vv3 coarse_coeffs(i, j, k) = coarse_coeffs(i, j, k) & - +ww1(3)*vv2+ww0(2)*vv3 - coarse_coeffs(i+1, j, k) = coarse_coeffs(i+1, j, k) & - +ww1(4)*vv2+ww0(3)*vv3 + + ww1(3)*vv2 + ww0(2)*vv3 + coarse_coeffs(i + 1, j, k) = coarse_coeffs(i + 1, j, k) & + + ww1(4)*vv2 + ww0(3)*vv3 IF (rest_b > 2) THEN - fi = fi+1 + fi = fi + 1 vv4 = fine_values(fi, fj, fk) - fi = fi+1 + fi = fi + 1 vv5 = fine_values(fi, fj, fk) - fi = fi+1 + fi = fi + 1 vv6 = fine_values(fi, fj, fk) - fi = fi+1 + fi = fi + 1 vv7 = fine_values(fi, fj, fk) - coarse_coeffs(i-1, j, k) = coarse_coeffs(i-1, j, k) & - +ww1(1)*vv4 + coarse_coeffs(i - 1, j, k) = coarse_coeffs(i - 1, j, k) & + + ww1(1)*vv4 IF (has_i_ubound) THEN - IF (coarse_bo(2, 1)-2 == FLOOR((fine_bo(2, 1)-f_shift(1))/2._dp)) THEN - fi = fi+1 + IF (coarse_bo(2, 1) - 2 == FLOOR((fine_bo(2, 1) - f_shift(1))/2._dp)) THEN + fi = fi + 1 vv0 = fine_values(fi, fj, fk) - coarse_coeffs(i+4, j, k) = coarse_coeffs(i+4, j, k) & - +vv0*ww1(4) + coarse_coeffs(i + 4, j, k) = coarse_coeffs(i + 4, j, k) & + + vv0*ww1(4) ELSE vv0 = 0._dp END IF coarse_coeffs(i, j, k) = coarse_coeffs(i, j, k) & - +ww1(2)*vv4+ww0(1)*vv5+ww1(1)*vv6 - coarse_coeffs(i+1, j, k) = coarse_coeffs(i+1, j, k) & - +ww1(3)*vv4+ww0(2)*vv5+ww1(2)*vv6+ww0(1)*vv7+vv0*ww1(1) - coarse_coeffs(i+2, j, k) = coarse_coeffs(i+2, j, k) & - +ww1(4)*vv4+ww0(3)*vv5+ww1(3)*vv6+ww0(2)*vv7+vv0*ww1(2) - coarse_coeffs(i+3, j, k) = coarse_coeffs(i+3, j, k) & - +ww1(4)*vv6+ww0(3)*vv7+vv0*ww1(3) + + ww1(2)*vv4 + ww0(1)*vv5 + ww1(1)*vv6 + coarse_coeffs(i + 1, j, k) = coarse_coeffs(i + 1, j, k) & + + ww1(3)*vv4 + ww0(2)*vv5 + ww1(2)*vv6 + ww0(1)*vv7 + vv0*ww1(1) + coarse_coeffs(i + 2, j, k) = coarse_coeffs(i + 2, j, k) & + + ww1(4)*vv4 + ww0(3)*vv5 + ww1(3)*vv6 + ww0(2)*vv7 + vv0*ww1(2) + coarse_coeffs(i + 3, j, k) = coarse_coeffs(i + 3, j, k) & + + ww1(4)*vv6 + ww0(3)*vv7 + vv0*ww1(3) ELSEIF (pbc .AND. .NOT. is_split) THEN - fi = fi+1 + fi = fi + 1 vv0 = fine_values(fi, fj, fk) vv1 = fine_values(fine_bo(1, 1), fj, fk) - vv2 = fine_values(fine_bo(1, 1)+1, fj, fk) + vv2 = fine_values(fine_bo(1, 1) + 1, fj, fk) coarse_coeffs(i, j, k) = coarse_coeffs(i, j, k) & - +ww1(2)*vv4+ww0(1)*vv5+ww1(1)*vv6 - coarse_coeffs(i+1, j, k) = coarse_coeffs(i+1, j, k) & - +ww1(3)*vv4+ww0(2)*vv5+ww1(2)*vv6+ww0(1)*vv7+vv0*ww1(1) - coarse_coeffs(i+2, j, k) = coarse_coeffs(i+2, j, k) & - +ww1(4)*vv4+ww0(3)*vv5+ww1(3)*vv6+ww0(2)*vv7+vv0*ww1(2) & - +vv1*ww0(1)+vv2*ww1(1) + + ww1(2)*vv4 + ww0(1)*vv5 + ww1(1)*vv6 + coarse_coeffs(i + 1, j, k) = coarse_coeffs(i + 1, j, k) & + + ww1(3)*vv4 + ww0(2)*vv5 + ww1(2)*vv6 + ww0(1)*vv7 + vv0*ww1(1) + coarse_coeffs(i + 2, j, k) = coarse_coeffs(i + 2, j, k) & + + ww1(4)*vv4 + ww0(3)*vv5 + ww1(3)*vv6 + ww0(2)*vv7 + vv0*ww1(2) & + + vv1*ww0(1) + vv2*ww1(1) ELSE coarse_coeffs(i, j, k) = coarse_coeffs(i, j, k) & - +ww1(2)*vv4+ww0(1)*vv5+wj*w_border1(3)*vv6 - coarse_coeffs(i+1, j, k) = coarse_coeffs(i+1, j, k) & - +ww1(3)*vv4+ww0(2)*vv5+wj*w_border1(2)*vv6 - coarse_coeffs(i+2, j, k) = coarse_coeffs(i+2, j, k) & - +ww1(4)*vv4+ww0(3)*vv5+wj*w_border1(1)*vv6+w_border0*wj*vv7 + + ww1(2)*vv4 + ww0(1)*vv5 + wj*w_border1(3)*vv6 + coarse_coeffs(i + 1, j, k) = coarse_coeffs(i + 1, j, k) & + + ww1(3)*vv4 + ww0(2)*vv5 + wj*w_border1(2)*vv6 + coarse_coeffs(i + 2, j, k) = coarse_coeffs(i + 2, j, k) & + + ww1(4)*vv4 + ww0(3)*vv5 + wj*w_border1(1)*vv6 + w_border0*wj*vv7 END IF ELSE - fi = fi+1 + fi = fi + 1 vv4 = fine_values(fi, fj, fk) - fi = fi+1 + fi = fi + 1 vv5 = fine_values(fi, fj, fk) IF (has_i_ubound) THEN - IF (coarse_bo(2, 1)-2 == FLOOR((fine_bo(2, 1)-f_shift(1))/2._dp)) THEN - fi = fi+1 + IF (coarse_bo(2, 1) - 2 == FLOOR((fine_bo(2, 1) - f_shift(1))/2._dp)) THEN + fi = fi + 1 vv6 = fine_values(fi, fj, fk) - coarse_coeffs(i+3, j, k) = coarse_coeffs(i+3, j, k) & - +ww1(4)*vv6 + coarse_coeffs(i + 3, j, k) = coarse_coeffs(i + 3, j, k) & + + ww1(4)*vv6 ELSE vv6 = 0._dp END IF - coarse_coeffs(i-1, j, k) = coarse_coeffs(i-1, j, k) & - +ww1(1)*vv4 + coarse_coeffs(i - 1, j, k) = coarse_coeffs(i - 1, j, k) & + + ww1(1)*vv4 coarse_coeffs(i, j, k) = coarse_coeffs(i, j, k) & - +ww1(2)*vv4+ww0(1)*vv5+ww1(1)*vv6 - coarse_coeffs(i+1, j, k) = coarse_coeffs(i+1, j, k) & - +ww1(3)*vv4+ww0(2)*vv5+ww1(2)*vv6 - coarse_coeffs(i+2, j, k) = coarse_coeffs(i+2, j, k) & - +ww1(4)*vv4+ww0(3)*vv5+ww1(3)*vv6 + + ww1(2)*vv4 + ww0(1)*vv5 + ww1(1)*vv6 + coarse_coeffs(i + 1, j, k) = coarse_coeffs(i + 1, j, k) & + + ww1(3)*vv4 + ww0(2)*vv5 + ww1(2)*vv6 + coarse_coeffs(i + 2, j, k) = coarse_coeffs(i + 2, j, k) & + + ww1(4)*vv4 + ww0(3)*vv5 + ww1(3)*vv6 ELSEIF (pbc .AND. .NOT. is_split) THEN - fi = fi+1 + fi = fi + 1 vv6 = fine_values(fi, fj, fk) vv7 = fine_values(fine_bo(1, 1), fj, fk) - vv0 = fine_values(fine_bo(1, 1)+1, fj, fk) - coarse_coeffs(i-1, j, k) = coarse_coeffs(i-1, j, k) & - +ww1(1)*vv4 + vv0 = fine_values(fine_bo(1, 1) + 1, fj, fk) + coarse_coeffs(i - 1, j, k) = coarse_coeffs(i - 1, j, k) & + + ww1(1)*vv4 coarse_coeffs(i, j, k) = coarse_coeffs(i, j, k) & - +ww1(4)*vv0+ww0(3)*vv1+ww1(3)*vv2+ww0(2)*vv3+ & - ww1(2)*vv4+ww0(1)*vv5+ww1(1)*vv6 - coarse_coeffs(i+1, j, k) = coarse_coeffs(i+1, j, k) & - +ww1(4)*vv2+ww0(3)*vv3+ww1(3)*vv4+ww0(2)*vv5+ww1(2)*vv6 & - +ww0(1)*vv7+ww1(1)*vv0 + + ww1(4)*vv0 + ww0(3)*vv1 + ww1(3)*vv2 + ww0(2)*vv3 + & + ww1(2)*vv4 + ww0(1)*vv5 + ww1(1)*vv6 + coarse_coeffs(i + 1, j, k) = coarse_coeffs(i + 1, j, k) & + + ww1(4)*vv2 + ww0(3)*vv3 + ww1(3)*vv4 + ww0(2)*vv5 + ww1(2)*vv6 & + + ww0(1)*vv7 + ww1(1)*vv0 ELSE - coarse_coeffs(i-1, j, k) = coarse_coeffs(i-1, j, k) & - +wj*w_border1(3)*vv4 + coarse_coeffs(i - 1, j, k) = coarse_coeffs(i - 1, j, k) & + + wj*w_border1(3)*vv4 coarse_coeffs(i, j, k) = coarse_coeffs(i, j, k) & - +wj*w_border1(2)*vv4 - coarse_coeffs(i+1, j, k) = coarse_coeffs(i+1, j, k) & - +wj*(w_border1(1)*vv4+w_border0*vv5) + + wj*w_border1(2)*vv4 + coarse_coeffs(i + 1, j, k) = coarse_coeffs(i + 1, j, k) & + + wj*(w_border1(1)*vv4 + w_border0*vv5) END IF END IF ELSE - fi = fi+1 + fi = fi + 1 vv2 = fine_values(fi, fj, fk) - fi = fi+1 + fi = fi + 1 vv3 = fine_values(fi, fj, fk) IF (has_i_ubound) THEN - IF (coarse_bo(2, 1)-2 == FLOOR((fine_bo(2, 1)-f_shift(1))/2._dp)) THEN - fi = fi+1 + IF (coarse_bo(2, 1) - 2 == FLOOR((fine_bo(2, 1) - f_shift(1))/2._dp)) THEN + fi = fi + 1 vv4 = fine_values(fi, fj, fk) - coarse_coeffs(i+2, j, k) = coarse_coeffs(i+2, j, k) & - +ww1(4)*vv4 + coarse_coeffs(i + 2, j, k) = coarse_coeffs(i + 2, j, k) & + + ww1(4)*vv4 ELSE vv4 = 0._dp END IF - coarse_coeffs(i-2, j, k) = coarse_coeffs(i-2, j, k) & - +ww1(1)*vv2 - coarse_coeffs(i-1, j, k) = coarse_coeffs(i-1, j, k) & - +ww1(2)*vv2+ww0(1)*vv3+ww1(1)*vv4 + coarse_coeffs(i - 2, j, k) = coarse_coeffs(i - 2, j, k) & + + ww1(1)*vv2 + coarse_coeffs(i - 1, j, k) = coarse_coeffs(i - 1, j, k) & + + ww1(2)*vv2 + ww0(1)*vv3 + ww1(1)*vv4 coarse_coeffs(i, j, k) = coarse_coeffs(i, j, k) & - +ww1(3)*vv2+ww0(2)*vv3+ww1(2)*vv4 - coarse_coeffs(i+1, j, k) = coarse_coeffs(i+1, j, k) & - +ww1(4)*vv2+ww0(3)*vv3+ww1(3)*vv4 + + ww1(3)*vv2 + ww0(2)*vv3 + ww1(2)*vv4 + coarse_coeffs(i + 1, j, k) = coarse_coeffs(i + 1, j, k) & + + ww1(4)*vv2 + ww0(3)*vv3 + ww1(3)*vv4 ELSEIF (pbc .AND. .NOT. is_split) THEN - fi = fi+1 + fi = fi + 1 vv4 = fine_values(fi, fj, fk) vv5 = fine_values(fine_bo(1, 1), fj, fk) - vv6 = fine_values(fine_bo(1, 1)+1, fj, fk) - coarse_coeffs(i-2, j, k) = coarse_coeffs(i-2, j, k) & - +ww1(1)*vv2 - coarse_coeffs(i-1, j, k) = coarse_coeffs(i-1, j, k) & - +ww1(2)*vv2+ww0(1)*vv3+ww1(1)*vv4 + vv6 = fine_values(fine_bo(1, 1) + 1, fj, fk) + coarse_coeffs(i - 2, j, k) = coarse_coeffs(i - 2, j, k) & + + ww1(1)*vv2 + coarse_coeffs(i - 1, j, k) = coarse_coeffs(i - 1, j, k) & + + ww1(2)*vv2 + ww0(1)*vv3 + ww1(1)*vv4 coarse_coeffs(i, j, k) = coarse_coeffs(i, j, k) & - +ww1(3)*vv2+ww0(2)*vv3+ww1(2)*vv4+vv5*ww0(1)+ww1(1)*vv6 + + ww1(3)*vv2 + ww0(2)*vv3 + ww1(2)*vv4 + vv5*ww0(1) + ww1(1)*vv6 ELSE - coarse_coeffs(i-2, j, k) = coarse_coeffs(i-2, j, k) & - +wj*w_border1(3)*vv2 - coarse_coeffs(i-1, j, k) = coarse_coeffs(i-1, j, k) & - +wj*w_border1(2)*vv2 + coarse_coeffs(i - 2, j, k) = coarse_coeffs(i - 2, j, k) & + + wj*w_border1(3)*vv2 + coarse_coeffs(i - 1, j, k) = coarse_coeffs(i - 1, j, k) & + + wj*w_border1(2)*vv2 coarse_coeffs(i, j, k) = coarse_coeffs(i, j, k) & - +wj*(w_border1(1)*vv2+w_border0*vv3) + + wj*(w_border1(1)*vv2 + w_border0*vv3) END IF END IF ELSE - fi = fi+1 + fi = fi + 1 vv0 = fine_values(fi, fj, fk) - fi = fi+1 + fi = fi + 1 vv1 = fine_values(fi, fj, fk) IF (has_i_ubound) THEN - IF (coarse_bo(2, 1)-2 == FLOOR((fine_bo(2, 1)-f_shift(1))/2._dp)) THEN - fi = fi+1 + IF (coarse_bo(2, 1) - 2 == FLOOR((fine_bo(2, 1) - f_shift(1))/2._dp)) THEN + fi = fi + 1 vv2 = fine_values(fi, fj, fk) - coarse_coeffs(i+1, j, k) = coarse_coeffs(i+1, j, k) & - +ww1(4)*vv2 + coarse_coeffs(i + 1, j, k) = coarse_coeffs(i + 1, j, k) & + + ww1(4)*vv2 ELSE vv2 = 0._dp END IF - coarse_coeffs(i-3, j, k) = coarse_coeffs(i-3, j, k) & - +ww1(1)*vv0 - coarse_coeffs(i-2, j, k) = coarse_coeffs(i-2, j, k) & - +ww1(2)*vv0+ww0(1)*vv1+ww1(1)*vv2 - coarse_coeffs(i-1, j, k) = coarse_coeffs(i-1, j, k) & - +ww1(3)*vv0+ww0(2)*vv1+ww1(2)*vv2 + coarse_coeffs(i - 3, j, k) = coarse_coeffs(i - 3, j, k) & + + ww1(1)*vv0 + coarse_coeffs(i - 2, j, k) = coarse_coeffs(i - 2, j, k) & + + ww1(2)*vv0 + ww0(1)*vv1 + ww1(1)*vv2 + coarse_coeffs(i - 1, j, k) = coarse_coeffs(i - 1, j, k) & + + ww1(3)*vv0 + ww0(2)*vv1 + ww1(2)*vv2 coarse_coeffs(i, j, k) = coarse_coeffs(i, j, k) & - +ww1(4)*vv0+ww0(3)*vv1+ww1(3)*vv2 + + ww1(4)*vv0 + ww0(3)*vv1 + ww1(3)*vv2 ELSEIF (pbc .AND. .NOT. is_split) THEN - fi = fi+1 + fi = fi + 1 vv2 = fine_values(fi, fj, fk) vv3 = fine_values(fine_bo(1, 1), fk, fk) - vv4 = fine_values(fine_bo(1, 1)+1, fk, fk) - coarse_coeffs(i-3, j, k) = coarse_coeffs(i-3, j, k) & - +ww1(1)*vv0 - coarse_coeffs(i-2, j, k) = coarse_coeffs(i-2, j, k) & - +ww1(2)*vv0+ww0(1)*vv1+ww1(1)*vv2 - coarse_coeffs(i-1, j, k) = coarse_coeffs(i-1, j, k) & - +ww1(3)*vv0+ww0(2)*vv1+ww1(2)*vv2+ww0(1)*vv3+ww1(1)*vv4 + vv4 = fine_values(fine_bo(1, 1) + 1, fk, fk) + coarse_coeffs(i - 3, j, k) = coarse_coeffs(i - 3, j, k) & + + ww1(1)*vv0 + coarse_coeffs(i - 2, j, k) = coarse_coeffs(i - 2, j, k) & + + ww1(2)*vv0 + ww0(1)*vv1 + ww1(1)*vv2 + coarse_coeffs(i - 1, j, k) = coarse_coeffs(i - 1, j, k) & + + ww1(3)*vv0 + ww0(2)*vv1 + ww1(2)*vv2 + ww0(1)*vv3 + ww1(1)*vv4 ELSE - coarse_coeffs(i-3, j, k) = coarse_coeffs(i-3, j, k) & - +wj*w_border1(3)*vv0 - coarse_coeffs(i-2, j, k) = coarse_coeffs(i-2, j, k) & - +wj*w_border1(2)*vv0 - coarse_coeffs(i-1, j, k) = coarse_coeffs(i-1, j, k) & - +wj*(w_border1(1)*vv0+w_border0*vv1) + coarse_coeffs(i - 3, j, k) = coarse_coeffs(i - 3, j, k) & + + wj*w_border1(3)*vv0 + coarse_coeffs(i - 2, j, k) = coarse_coeffs(i - 2, j, k) & + + wj*w_border1(2)*vv0 + coarse_coeffs(i - 1, j, k) = coarse_coeffs(i - 1, j, k) & + + wj*(w_border1(1)*vv0 + w_border0*vv1) END IF END IF CPASSERT(fi == fine_bo(2, 1)) @@ -2325,21 +2325,21 @@ SUBROUTINE add_fine2coarse(fine_values_pw, coarse_coeffs_pw, & ! *** parallel case IF (is_split) THEN CALL timeset(routineN//"_comm", handle2) - coarse_slice_size = (coarse_bo(2, 2)-coarse_bo(1, 2)+1)* & - (coarse_bo(2, 3)-coarse_bo(1, 3)+1) + coarse_slice_size = (coarse_bo(2, 2) - coarse_bo(1, 2) + 1)* & + (coarse_bo(2, 3) - coarse_bo(1, 3) + 1) n_procs = coarse_coeffs_pw%pw_grid%para%group_size - ALLOCATE (send_size(0:n_procs-1), send_offset(0:n_procs-1), & - sent_size(0:n_procs-1), rcv_size(0:n_procs-1), & - rcv_offset(0:n_procs-1), pp_lb(0:n_procs-1), & - pp_ub(0:n_procs-1), real_rcv_size(0:n_procs-1)) + ALLOCATE (send_size(0:n_procs - 1), send_offset(0:n_procs - 1), & + sent_size(0:n_procs - 1), rcv_size(0:n_procs - 1), & + rcv_offset(0:n_procs - 1), pp_lb(0:n_procs - 1), & + pp_ub(0:n_procs - 1), real_rcv_size(0:n_procs - 1)) ! ** send size count pos_of_x => coarse_coeffs_pw%pw_grid%para%pos_of_x send_size = 0 DO x = coarse_bo(1, 1), coarse_bo(2, 1) - p = pos_of_x(coarse_gbo(1, 1)+MODULO(x-coarse_gbo(1, 1), s(1))) - send_size(p) = send_size(p)+coarse_slice_size + p = pos_of_x(coarse_gbo(1, 1) + MODULO(x - coarse_gbo(1, 1), s(1))) + send_size(p) = send_size(p) + coarse_slice_size END DO ! ** rcv size count @@ -2347,25 +2347,25 @@ SUBROUTINE add_fine2coarse(fine_values_pw, coarse_coeffs_pw, & pos_of_x => fine_values_pw%pw_grid%para%pos_of_x p_old = pos_of_x(fine_gbo(1, 1)) pp_lb = fine_gbo(2, 1) - pp_ub = fine_gbo(2, 1)-1 + pp_ub = fine_gbo(2, 1) - 1 pp_lb(p_old) = fine_gbo(1, 1) DO x = fine_gbo(1, 1), fine_gbo(2, 1) p = pos_of_x(x) IF (p /= p_old) THEN - pp_ub(p_old) = x-1 + pp_ub(p_old) = x - 1 pp_lb(p) = x p_old = p END IF END DO pp_ub(p_old) = fine_gbo(2, 1) - DO ip = 0, n_procs-1 + DO ip = 0, n_procs - 1 IF (pp_lb(ip) <= pp_ub(ip)) THEN - pp_lb(ip) = FLOOR(REAL(pp_lb(ip)-f_shift(1), dp)/2._dp)-1 - pp_ub(ip) = FLOOR(REAL(pp_ub(ip)+1-f_shift(1), dp)/2._dp)+1 + pp_lb(ip) = FLOOR(REAL(pp_lb(ip) - f_shift(1), dp)/2._dp) - 1 + pp_ub(ip) = FLOOR(REAL(pp_ub(ip) + 1 - f_shift(1), dp)/2._dp) + 1 ELSE pp_lb(ip) = coarse_gbo(2, 1) - pp_ub(ip) = coarse_gbo(2, 1)-1 + pp_ub(ip) = coarse_gbo(2, 1) - 1 END IF IF (.NOT. is_split .OR. .NOT. pbc) THEN pp_lb(ip) = MAX(pp_lb(ip), coarse_gbo(1, 1)) @@ -2374,20 +2374,20 @@ SUBROUTINE add_fine2coarse(fine_values_pw, coarse_coeffs_pw, & END DO rcv_size = 0 - DO ip = 0, n_procs-1 - DO x = pp_lb(ip), coarse_gbo(1, 1)-1 - x_att = coarse_gbo(1, 1)+MODULO(x-coarse_gbo(1, 1), s(1)) + DO ip = 0, n_procs - 1 + DO x = pp_lb(ip), coarse_gbo(1, 1) - 1 + x_att = coarse_gbo(1, 1) + MODULO(x - coarse_gbo(1, 1), s(1)) IF (x_att >= my_coarse_bo(1, 1) .AND. x_att <= my_coarse_bo(2, 1)) THEN - rcv_size(ip) = rcv_size(ip)+coarse_slice_size + rcv_size(ip) = rcv_size(ip) + coarse_slice_size END IF END DO - rcv_size(ip) = rcv_size(ip)+coarse_slice_size* & + rcv_size(ip) = rcv_size(ip) + coarse_slice_size* & MAX(0, & - MIN(pp_ub(ip), my_coarse_bo(2, 1))-MAX(pp_lb(ip), my_coarse_bo(1, 1))+1) - DO x = coarse_gbo(2, 1)+1, pp_ub(ip) - x_att = coarse_gbo(1, 1)+MODULO(x-coarse_gbo(1, 1), s(1)) + MIN(pp_ub(ip), my_coarse_bo(2, 1)) - MAX(pp_lb(ip), my_coarse_bo(1, 1)) + 1) + DO x = coarse_gbo(2, 1) + 1, pp_ub(ip) + x_att = coarse_gbo(1, 1) + MODULO(x - coarse_gbo(1, 1), s(1)) IF (x_att >= my_coarse_bo(1, 1) .AND. x_att <= my_coarse_bo(2, 1)) THEN - rcv_size(ip) = rcv_size(ip)+coarse_slice_size + rcv_size(ip) = rcv_size(ip) + coarse_slice_size END IF END DO END DO @@ -2395,39 +2395,39 @@ SUBROUTINE add_fine2coarse(fine_values_pw, coarse_coeffs_pw, & ! ** offsets & alloc send-rcv send_tot_size = 0 - DO ip = 0, n_procs-1 + DO ip = 0, n_procs - 1 send_offset(ip) = send_tot_size - send_tot_size = send_tot_size+send_size(ip) + send_tot_size = send_tot_size + send_size(ip) END DO - IF (send_tot_size /= (coarse_bo(2, 1)-coarse_bo(1, 1)+1)*coarse_slice_size) & + IF (send_tot_size /= (coarse_bo(2, 1) - coarse_bo(1, 1) + 1)*coarse_slice_size) & CPABORT("Error calculating send_tot_size") - ALLOCATE (send_buf(0:send_tot_size-1)) + ALLOCATE (send_buf(0:send_tot_size - 1)) rcv_tot_size = 0 - DO ip = 0, n_procs-1 + DO ip = 0, n_procs - 1 rcv_offset(ip) = rcv_tot_size - rcv_tot_size = rcv_tot_size+rcv_size(ip) + rcv_tot_size = rcv_tot_size + rcv_size(ip) END DO - ALLOCATE (rcv_buf(0:rcv_tot_size-1)) + ALLOCATE (rcv_buf(0:rcv_tot_size - 1)) ! ** fill send buffer pos_of_x => coarse_coeffs_pw%pw_grid%para%pos_of_x p_old = pos_of_x(coarse_gbo(1, 1) & - +MODULO(coarse_bo(1, 1)-coarse_gbo(1, 1), s(1))) + + MODULO(coarse_bo(1, 1) - coarse_gbo(1, 1), s(1))) sent_size(:) = send_offset - ss = coarse_bo(2, 1)-coarse_bo(1, 1)+1 + ss = coarse_bo(2, 1) - coarse_bo(1, 1) + 1 DO x = coarse_bo(1, 1), coarse_bo(2, 1) - p = pos_of_x(coarse_gbo(1, 1)+MODULO(x-coarse_gbo(1, 1), s(1))) + p = pos_of_x(coarse_gbo(1, 1) + MODULO(x - coarse_gbo(1, 1), s(1))) CALL dcopy(coarse_slice_size, & coarse_coeffs(x, coarse_bo(1, 2), & coarse_bo(1, 3)), ss, send_buf(sent_size(p)), 1) - sent_size(p) = sent_size(p)+coarse_slice_size + sent_size(p) = sent_size(p) + coarse_slice_size END DO - IF (ANY(sent_size(0:n_procs-2) /= send_offset(1:n_procs-1))) & + IF (ANY(sent_size(0:n_procs - 2) /= send_offset(1:n_procs - 1))) & CPABORT("error 1 filling send buffer") - IF (sent_size(n_procs-1) /= send_tot_size) & + IF (sent_size(n_procs - 1) /= send_tot_size) & CPABORT("error 2 filling send buffer") IF (local_data) THEN @@ -2436,8 +2436,8 @@ SUBROUTINE add_fine2coarse(fine_values_pw, coarse_coeffs_pw, & NULLIFY (coarse_coeffs) END IF - CPASSERT(ALL(sent_size(:n_procs-2) == send_offset(1:))) - CPASSERT(sent_size(n_procs-1) == send_tot_size) + CPASSERT(ALL(sent_size(:n_procs - 2) == send_offset(1:))) + CPASSERT(sent_size(n_procs - 1) == send_tot_size) ! test send/rcv sizes CALL mp_alltoall(send_size, real_rcv_size, 1, coarse_coeffs_pw%pw_grid%para%group) @@ -2450,16 +2450,16 @@ SUBROUTINE add_fine2coarse(fine_values_pw, coarse_coeffs_pw, & ! ** sum & reorder rcv buffer sent_size(:) = rcv_offset - DO ip = 0, n_procs-1 + DO ip = 0, n_procs - 1 - DO x = pp_lb(ip), coarse_gbo(1, 1)-1 - x_att = coarse_gbo(1, 1)+MODULO(x-coarse_gbo(1, 1), s(1)) + DO x = pp_lb(ip), coarse_gbo(1, 1) - 1 + x_att = coarse_gbo(1, 1) + MODULO(x - coarse_gbo(1, 1), s(1)) IF (x_att >= my_coarse_bo(1, 1) .AND. x_att <= my_coarse_bo(2, 1)) THEN ii = sent_size(ip) DO k = coarse_bo(1, 3), coarse_bo(2, 3) DO j = coarse_bo(1, 2), coarse_bo(2, 2) - coarse_coeffs_pw%cr3d(x_att, j, k) = coarse_coeffs_pw%cr3d(x_att, j, k)+rcv_buf(ii) - ii = ii+1 + coarse_coeffs_pw%cr3d(x_att, j, k) = coarse_coeffs_pw%cr3d(x_att, j, k) + rcv_buf(ii) + ii = ii + 1 END DO END DO sent_size(ip) = ii @@ -2470,21 +2470,21 @@ SUBROUTINE add_fine2coarse(fine_values_pw, coarse_coeffs_pw, & DO x_att = MAX(pp_lb(ip), my_coarse_bo(1, 1)), MIN(pp_ub(ip), my_coarse_bo(2, 1)) DO k = coarse_bo(1, 3), coarse_bo(2, 3) DO j = coarse_bo(1, 2), coarse_bo(2, 2) - coarse_coeffs_pw%cr3d(x_att, j, k) = coarse_coeffs_pw%cr3d(x_att, j, k)+rcv_buf(ii) - ii = ii+1 + coarse_coeffs_pw%cr3d(x_att, j, k) = coarse_coeffs_pw%cr3d(x_att, j, k) + rcv_buf(ii) + ii = ii + 1 END DO END DO END DO sent_size(ip) = ii - DO x = coarse_gbo(2, 1)+1, pp_ub(ip) - x_att = coarse_gbo(1, 1)+MODULO(x-coarse_gbo(1, 1), s(1)) + DO x = coarse_gbo(2, 1) + 1, pp_ub(ip) + x_att = coarse_gbo(1, 1) + MODULO(x - coarse_gbo(1, 1), s(1)) IF (x_att >= my_coarse_bo(1, 1) .AND. x_att <= my_coarse_bo(2, 1)) THEN ii = sent_size(ip) DO k = coarse_bo(1, 3), coarse_bo(2, 3) DO j = coarse_bo(1, 2), coarse_bo(2, 2) - coarse_coeffs_pw%cr3d(x_att, j, k) = coarse_coeffs_pw%cr3d(x_att, j, k)+rcv_buf(ii) - ii = ii+1 + coarse_coeffs_pw%cr3d(x_att, j, k) = coarse_coeffs_pw%cr3d(x_att, j, k) + rcv_buf(ii) + ii = ii + 1 END DO END DO sent_size(ip) = ii @@ -2493,9 +2493,9 @@ SUBROUTINE add_fine2coarse(fine_values_pw, coarse_coeffs_pw, & END DO - IF (ANY(sent_size(0:n_procs-2) /= rcv_offset(1:n_procs-1))) & + IF (ANY(sent_size(0:n_procs - 2) /= rcv_offset(1:n_procs - 1))) & CPABORT("error 1 handling the rcv buffer") - IF (sent_size(n_procs-1) /= rcv_tot_size) & + IF (sent_size(n_procs - 1) /= rcv_tot_size) & CPABORT("error 2 handling the rcv buffer") ! dealloc @@ -2531,7 +2531,7 @@ SUBROUTINE pw_spline_precond_create(preconditioner, precond_kind, & routineP = moduleN//':'//routineN ALLOCATE (preconditioner) - last_precond_id = last_precond_id+1 + last_precond_id = last_precond_id + 1 preconditioner%id_nr = last_precond_id preconditioner%ref_count = 1 preconditioner%kind = no_precond @@ -2625,7 +2625,7 @@ SUBROUTINE pw_spline_precond_set_kind(preconditioner, precond_kind, pbc, & preconditioner%coeffs_1d(1) IF (preconditioner%sharpen) THEN IF (preconditioner%normalize) THEN - preconditioner%coeffs(1) = 2._dp+ & + preconditioner%coeffs(1) = 2._dp + & preconditioner%coeffs(1) ELSE preconditioner%coeffs(1) = -preconditioner%coeffs(1) @@ -2647,7 +2647,7 @@ SUBROUTINE pw_spline_precond_retain(preconditioner) CPASSERT(ASSOCIATED(preconditioner)) CPASSERT(preconditioner%ref_count > 1) - preconditioner%ref_count = preconditioner%ref_count+1 + preconditioner%ref_count = preconditioner%ref_count + 1 END SUBROUTINE pw_spline_precond_retain ! ************************************************************************************************** @@ -2663,7 +2663,7 @@ SUBROUTINE pw_spline_precond_release(preconditioner) IF (ASSOCIATED(preconditioner)) THEN CPASSERT(preconditioner%ref_count > 0) - preconditioner%ref_count = preconditioner%ref_count-1 + preconditioner%ref_count = preconditioner%ref_count - 1 IF (preconditioner%ref_count == 0) THEN CALL pw_pool_release(preconditioner%pool) DEALLOCATE (preconditioner) @@ -2780,7 +2780,7 @@ END SUBROUTINE linOp CALL pw_copy(z, p) r_z = pw_integral_ab(r, z) - DO iter = iiter, MIN(iiter+9, max_iter) + DO iter = iiter, MIN(iiter + 9, max_iter) eps_r_att = SQRT(pw_integral_ab(r, r)) IF (eps_r_att == 0._dp) THEN eps_x_att = 0._dp @@ -2813,7 +2813,7 @@ END SUBROUTINE linOp DO k = bo(1, 3), bo(2, 3) DO j = bo(1, 2), bo(2, 2) DO i = bo(1, 1), bo(2, 1) - p%cr3d(i, j, k) = z%cr3d(i, j, k)+beta*p%cr3d(i, j, k) + p%cr3d(i, j, k) = z%cr3d(i, j, k) + beta*p%cr3d(i, j, k) END DO END DO END DO @@ -2879,7 +2879,7 @@ SUBROUTINE pw_nn_compose_r_no_pbc(weights_1d, pw_in, pw_out, & CPASSERT(.NOT. my_normalize .OR. my_sharpen) CPASSERT(.NOT. my_smooth_boundary .OR. .NOT. my_sharpen) DO i = 1, 3 - s(i) = bo(2, i)-bo(1, i)+1 + s(i) = bo(2, i) - bo(1, i) + 1 END DO IF (ANY(s < 1)) RETURN is_split = ANY(pw_in%pw_grid%bounds_local(:, 1) /= & @@ -2892,29 +2892,29 @@ SUBROUTINE pw_nn_compose_r_no_pbc(weights_1d, pw_in, pw_out, & tmp(bo(1, 2):bo(2, 2), bo(1, 3):bo(2, 3))) tmp(:, :) = pw_in%cr3d(bo(2, 1), :, :) CALL mp_sendrecv(tmp, pw_in%pw_grid%para%pos_of_x( & - gbo(1, 1)+MODULO(bo(2, 1)+1-gbo(1, 1), gbo(2, 1)-gbo(1, 1)+1)), & + gbo(1, 1) + MODULO(bo(2, 1) + 1 - gbo(1, 1), gbo(2, 1) - gbo(1, 1) + 1)), & l_boundary, pw_in%pw_grid%para%pos_of_x( & - gbo(1, 1)+MODULO(bo(1, 1)-1-gbo(1, 1), gbo(2, 1)-gbo(1, 1)+1)), & + gbo(1, 1) + MODULO(bo(1, 1) - 1 - gbo(1, 1), gbo(2, 1) - gbo(1, 1) + 1)), & pw_in%pw_grid%para%group) tmp(:, :) = pw_in%cr3d(bo(1, 1), :, :) CALL mp_sendrecv(tmp, pw_in%pw_grid%para%pos_of_x( & - gbo(1, 1)+MODULO(bo(1, 1)-1-gbo(1, 1), gbo(2, 1)-gbo(1, 1)+1)), & + gbo(1, 1) + MODULO(bo(1, 1) - 1 - gbo(1, 1), gbo(2, 1) - gbo(1, 1) + 1)), & u_boundary, pw_in%pw_grid%para%pos_of_x( & - gbo(1, 1)+MODULO(bo(2, 1)+1-gbo(1, 1), gbo(2, 1)-gbo(1, 1)+1)), & + gbo(1, 1) + MODULO(bo(2, 1) + 1 - gbo(1, 1), gbo(2, 1) - gbo(1, 1) + 1)), & pw_in%pw_grid%para%group) DEALLOCATE (tmp) END IF n_els = s(1) IF (has_l_boundary) THEN - n_els = n_els-1 - first_index = bo(1, 1)+1 + n_els = n_els - 1 + first_index = bo(1, 1) + 1 ELSE first_index = bo(1, 1) END IF IF (has_u_boundary) THEN - n_els = n_els-1 - last_index = bo(2, 1)-1 + n_els = n_els - 1 + last_index = bo(2, 1) - 1 ELSE last_index = bo(2, 1) END IF @@ -2925,9 +2925,9 @@ SUBROUTINE pw_nn_compose_r_no_pbc(weights_1d, pw_in, pw_out, & !$OMP my_sharpen, last_index, first_index, my_normalize, n_els) DO k = bo(1, 3), bo(2, 3) DO kw = -1, 1 - myk = k+kw + myk = k + kw IF (my_transpose) THEN - IF (k >= gbo(2, 3)-1 .OR. k <= gbo(1, 3)+1) THEN + IF (k >= gbo(2, 3) - 1 .OR. k <= gbo(1, 3) + 1) THEN IF (k == gbo(2, 3) .OR. k == gbo(1, 3)) THEN IF (myk < gbo(2, 3) .AND. myk > gbo(1, 3)) THEN w_k = weights_1d(kw) @@ -2947,13 +2947,13 @@ SUBROUTINE pw_nn_compose_r_no_pbc(weights_1d, pw_in, pw_out, & w_k = weights_1d(kw) END IF ELSE - IF (k >= gbo(2, 3)-1 .OR. k <= gbo(1, 3)+1) THEN + IF (k >= gbo(2, 3) - 1 .OR. k <= gbo(1, 3) + 1) THEN IF (k == gbo(2, 3) .OR. k == gbo(1, 3)) THEN IF (kw /= 0) CYCLE w_k = 1._dp ELSE - IF (my_smooth_boundary .AND. ((k == gbo(1, 3)+1 .AND. myk == gbo(1, 3)) .OR. & - (k == gbo(2, 3)-1 .AND. myk == gbo(2, 3)))) THEN + IF (my_smooth_boundary .AND. ((k == gbo(1, 3) + 1 .AND. myk == gbo(1, 3)) .OR. & + (k == gbo(2, 3) - 1 .AND. myk == gbo(2, 3)))) THEN w_k = weights_1d(kw)/weights_1d(0) ELSE w_k = weights_1d(kw) @@ -2965,8 +2965,8 @@ SUBROUTINE pw_nn_compose_r_no_pbc(weights_1d, pw_in, pw_out, & END IF DO j = bo(1, 2), bo(2, 2) DO jw = -1, 1 - myj = j+jw - IF (j < gbo(2, 2)-1 .AND. j > gbo(1, 2)+1) THEN + myj = j + jw + IF (j < gbo(2, 2) - 1 .AND. j > gbo(1, 2) + 1) THEN w_j = w_k*weights_1d(jw) ELSE IF (my_transpose) THEN @@ -2989,8 +2989,8 @@ SUBROUTINE pw_nn_compose_r_no_pbc(weights_1d, pw_in, pw_out, & IF (j == gbo(2, 2) .OR. j == gbo(1, 2)) THEN IF (jw /= 0) CYCLE w_j = w_k - ELSE IF (my_smooth_boundary .AND. ((j == gbo(1, 2)+1 .AND. myj == gbo(1, 2)) .OR. & - (j == gbo(2, 2)-1 .AND. myj == gbo(2, 2)))) THEN + ELSE IF (my_smooth_boundary .AND. ((j == gbo(1, 2) + 1 .AND. myj == gbo(1, 2)) .OR. & + (j == gbo(2, 2) - 1 .AND. myj == gbo(2, 2)))) THEN w_j = w_k*weights_1d(jw)/weights_1d(0) ELSE w_j = w_k*weights_1d(jw) @@ -3004,31 +3004,31 @@ SUBROUTINE pw_nn_compose_r_no_pbc(weights_1d, pw_in, pw_out, & CPASSERT(.NOT. has_u_boundary) in_val_tmp = u_boundary(myj, myk) ELSE - in_val_tmp = in_val(bo(1, 1)+1, myj, myk) + in_val_tmp = in_val(bo(1, 1) + 1, myj, myk) END IF IF (my_sharpen) THEN IF (kw == 0 .AND. jw == 0) THEN IF (my_normalize) THEN - out_val(bo(1, 1), j, k) = out_val(bo(1, 1), j, k)+ & - (2.0_dp-w_j)*in_val(bo(1, 1), myj, myk)- & + out_val(bo(1, 1), j, k) = out_val(bo(1, 1), j, k) + & + (2.0_dp - w_j)*in_val(bo(1, 1), myj, myk) - & in_val_tmp*weights_1d(1)*w_j ELSE - out_val(bo(1, 1), j, k) = out_val(bo(1, 1), j, k)+ & - in_val(bo(1, 1), myj, myk)*w_j- & + out_val(bo(1, 1), j, k) = out_val(bo(1, 1), j, k) + & + in_val(bo(1, 1), myj, myk)*w_j - & in_val_tmp*weights_1d(1)*w_j END IF ELSE - out_val(bo(1, 1), j, k) = out_val(bo(1, 1), j, k)- & - in_val(bo(1, 1), myj, myk)*w_j- & + out_val(bo(1, 1), j, k) = out_val(bo(1, 1), j, k) - & + in_val(bo(1, 1), myj, myk)*w_j - & in_val_tmp*weights_1d(1)*w_j END IF ELSE IF (my_smooth_boundary) THEN - out_val(bo(1, 1), j, k) = out_val(bo(1, 1), j, k)+ & - w_j*(in_val(bo(1, 1), myj, myk)+ & + out_val(bo(1, 1), j, k) = out_val(bo(1, 1), j, k) + & + w_j*(in_val(bo(1, 1), myj, myk) + & in_val_tmp*weights_1d(1)/weights_1d(0)) ELSE - out_val(bo(1, 1), j, k) = out_val(bo(1, 1), j, k)+ & - w_j*(in_val(bo(1, 1), myj, myk)+ & + out_val(bo(1, 1), j, k) = out_val(bo(1, 1), j, k) + & + w_j*(in_val(bo(1, 1), myj, myk) + & in_val_tmp*weights_1d(1)) END IF in_val_f = 0.0_dp @@ -3037,18 +3037,18 @@ SUBROUTINE pw_nn_compose_r_no_pbc(weights_1d, pw_in, pw_out, & IF (my_sharpen) THEN IF (kw == 0 .AND. jw == 0) THEN IF (my_normalize) THEN - out_val(bo(1, 1), j, k) = out_val(bo(1, 1), j, k)+ & - (2.0_dp-w_j)*in_val_f + out_val(bo(1, 1), j, k) = out_val(bo(1, 1), j, k) + & + (2.0_dp - w_j)*in_val_f ELSE - out_val(bo(1, 1), j, k) = out_val(bo(1, 1), j, k)+ & + out_val(bo(1, 1), j, k) = out_val(bo(1, 1), j, k) + & in_val_f*w_j END IF ELSE - out_val(bo(1, 1), j, k) = out_val(bo(1, 1), j, k)- & + out_val(bo(1, 1), j, k) = out_val(bo(1, 1), j, k) - & in_val_f*w_j END IF ELSE - out_val(bo(1, 1), j, k) = out_val(bo(1, 1), j, k)+ & + out_val(bo(1, 1), j, k) = out_val(bo(1, 1), j, k) + & in_val_f*w_j END IF END IF @@ -3062,30 +3062,30 @@ SUBROUTINE pw_nn_compose_r_no_pbc(weights_1d, pw_in, pw_out, & CPASSERT(.NOT. has_l_boundary) in_val_tmp = l_boundary(myj, myk) ELSE - in_val_tmp = in_val(bo(2, 1)-1, myj, myk) + in_val_tmp = in_val(bo(2, 1) - 1, myj, myk) END IF IF (my_sharpen) THEN IF (kw == 0 .AND. jw == 0) THEN IF (my_normalize) THEN - out_val(bo(2, 1), j, k) = out_val(bo(2, 1), j, k)+ & - in_val_l*(2._dp-w_j)- & + out_val(bo(2, 1), j, k) = out_val(bo(2, 1), j, k) + & + in_val_l*(2._dp - w_j) - & in_val_tmp*weights_1d(1)*w_j ELSE - out_val(bo(2, 1), j, k) = out_val(bo(2, 1), j, k)+ & - in_val_l*w_j- & + out_val(bo(2, 1), j, k) = out_val(bo(2, 1), j, k) + & + in_val_l*w_j - & in_val_tmp*weights_1d(1)*w_j END IF ELSE - out_val(bo(2, 1), j, k) = out_val(bo(2, 1), j, k)- & - w_j*in_val_l- & + out_val(bo(2, 1), j, k) = out_val(bo(2, 1), j, k) - & + w_j*in_val_l - & in_val_tmp*weights_1d(1)*w_j END IF ELSE IF (my_smooth_boundary) THEN - out_val(bo(2, 1), j, k) = out_val(bo(2, 1), j, k)+ & - w_j*(in_val_l+in_val_tmp*weights_1d(1)/weights_1d(0)) + out_val(bo(2, 1), j, k) = out_val(bo(2, 1), j, k) + & + w_j*(in_val_l + in_val_tmp*weights_1d(1)/weights_1d(0)) ELSE - out_val(bo(2, 1), j, k) = out_val(bo(2, 1), j, k)+ & - w_j*(in_val_l+in_val_tmp*weights_1d(1)) + out_val(bo(2, 1), j, k) = out_val(bo(2, 1), j, k) + & + w_j*(in_val_l + in_val_tmp*weights_1d(1)) END IF in_val_l = 0._dp ELSE @@ -3093,18 +3093,18 @@ SUBROUTINE pw_nn_compose_r_no_pbc(weights_1d, pw_in, pw_out, & IF (my_sharpen) THEN IF (kw == 0 .AND. jw == 0) THEN IF (my_normalize) THEN - out_val(bo(2, 1), j, k) = out_val(bo(2, 1), j, k)+ & - in_val_l*(2._dp-w_j) + out_val(bo(2, 1), j, k) = out_val(bo(2, 1), j, k) + & + in_val_l*(2._dp - w_j) ELSE - out_val(bo(2, 1), j, k) = out_val(bo(2, 1), j, k)+ & + out_val(bo(2, 1), j, k) = out_val(bo(2, 1), j, k) + & in_val_l*w_j END IF ELSE - out_val(bo(2, 1), j, k) = out_val(bo(2, 1), j, k)- & + out_val(bo(2, 1), j, k) = out_val(bo(2, 1), j, k) - & w_j*in_val_l END IF ELSE - out_val(bo(2, 1), j, k) = out_val(bo(2, 1), j, k)+ & + out_val(bo(2, 1), j, k) = out_val(bo(2, 1), j, k) + & w_j*in_val_l END IF END IF @@ -3113,9 +3113,9 @@ SUBROUTINE pw_nn_compose_r_no_pbc(weights_1d, pw_in, pw_out, & END IF IF (last_index >= first_index) THEN IF (my_transpose) THEN - IF (bo(1, 1)-1 == gbo(1, 1)) THEN + IF (bo(1, 1) - 1 == gbo(1, 1)) THEN in_val_f = 0._dp - ELSE IF (bo(2, 1)+1 == gbo(2, 1)) THEN + ELSE IF (bo(2, 1) + 1 == gbo(2, 1)) THEN in_val_l = 0._dp END IF END IF @@ -3123,7 +3123,7 @@ SUBROUTINE pw_nn_compose_r_no_pbc(weights_1d, pw_in, pw_out, & w = -weights_1d*w_j IF (kw == 0 .AND. jw == 0) THEN IF (my_normalize) THEN - w(0) = w(0)+2._dp + w(0) = w(0) + 2._dp ELSE w(0) = -w(0) END IF @@ -3132,16 +3132,16 @@ SUBROUTINE pw_nn_compose_r_no_pbc(weights_1d, pw_in, pw_out, & w = weights_1d*w_j END IF IF (my_smooth_boundary .AND. (.NOT. my_transpose)) THEN - IF (gbo(1, 1)+1 >= bo(1, 1) .AND. & - gbo(1, 1)+1 <= bo(2, 1) .AND. gbo(2, 1)-gbo(1, 1) > 2) THEN + IF (gbo(1, 1) + 1 >= bo(1, 1) .AND. & + gbo(1, 1) + 1 <= bo(2, 1) .AND. gbo(2, 1) - gbo(1, 1) > 2) THEN IF (gbo(1, 1) >= bo(1, 1)) THEN - out_val(gbo(1, 1)+1, j, k) = out_val(gbo(1, 1)+1, j, k)+ & - in_val(gbo(1, 1), myj, myk)*w_j*weights_1d(-1)* & - (1._dp/weights_1d(0)-1._dp) + out_val(gbo(1, 1) + 1, j, k) = out_val(gbo(1, 1) + 1, j, k) + & + in_val(gbo(1, 1), myj, myk)*w_j*weights_1d(-1)* & + (1._dp/weights_1d(0) - 1._dp) ELSE - out_val(gbo(1, 1)+1, j, k) = out_val(gbo(1, 1)+1, j, k)+ & - l_boundary(myj, myk)*w_j*weights_1d(-1)* & - (1._dp/weights_1d(0)-1._dp) + out_val(gbo(1, 1) + 1, j, k) = out_val(gbo(1, 1) + 1, j, k) + & + l_boundary(myj, myk)*w_j*weights_1d(-1)* & + (1._dp/weights_1d(0) - 1._dp) END IF END IF END IF @@ -3157,16 +3157,16 @@ SUBROUTINE pw_nn_compose_r_no_pbc(weights_1d, pw_in, pw_out, & !FM first_val=first_index,last_val=last_index,& !FM myj=myj,myk=myk,j=j,k=k) IF (my_smooth_boundary .AND. (.NOT. my_transpose)) THEN - IF (gbo(2, 1)-1 >= bo(1, 1) .AND. & - gbo(2, 1)-1 <= bo(2, 1) .AND. gbo(2, 1)-gbo(1, 1) > 2) THEN + IF (gbo(2, 1) - 1 >= bo(1, 1) .AND. & + gbo(2, 1) - 1 <= bo(2, 1) .AND. gbo(2, 1) - gbo(1, 1) > 2) THEN IF (gbo(2, 1) <= bo(2, 1)) THEN - out_val(gbo(2, 1)-1, j, k) = out_val(gbo(2, 1)-1, j, k)+ & - in_val(gbo(2, 1), myj, myk)*w_j*weights_1d(1)* & - (1._dp/weights_1d(0)-1._dp) + out_val(gbo(2, 1) - 1, j, k) = out_val(gbo(2, 1) - 1, j, k) + & + in_val(gbo(2, 1), myj, myk)*w_j*weights_1d(1)* & + (1._dp/weights_1d(0) - 1._dp) ELSE - out_val(gbo(2, 1)-1, j, k) = out_val(gbo(2, 1)-1, j, k)+ & - u_boundary(myj, myk)*w_j*weights_1d(1)* & - (1._dp/weights_1d(0)-1._dp) + out_val(gbo(2, 1) - 1, j, k) = out_val(gbo(2, 1) - 1, j, k) + & + u_boundary(myj, myk)*w_j*weights_1d(1)* & + (1._dp/weights_1d(0) - 1._dp) END IF END IF END IF @@ -3258,27 +3258,27 @@ FUNCTION Eval_Interp_Spl3_pbc(vec, pw) RESULT(val) dr2 = pw%pw_grid%dr(2) dr3 = pw%pw_grid%dr(3) - xd1 = (vec(1)/dr1)-REAL(ivec(1), kind=dp) - xd2 = (vec(2)/dr2)-REAL(ivec(2), kind=dp) - xd3 = (vec(3)/dr3)-REAL(ivec(3), kind=dp) + xd1 = (vec(1)/dr1) - REAL(ivec(1), kind=dp) + xd2 = (vec(2)/dr2) - REAL(ivec(2), kind=dp) + xd3 = (vec(3)/dr3) - REAL(ivec(3), kind=dp) grid => pw%cr3d(:, :, :) bo = pw%pw_grid%bounds bo_l = pw%pw_grid%bounds_local - ik(1) = MODULO(ivec(3)-1, npts(3))+bo(1, 3) - ik(2) = MODULO(ivec(3), npts(3))+bo(1, 3) - ik(3) = MODULO(ivec(3)+1, npts(3))+bo(1, 3) - ik(4) = MODULO(ivec(3)+2, npts(3))+bo(1, 3) + ik(1) = MODULO(ivec(3) - 1, npts(3)) + bo(1, 3) + ik(2) = MODULO(ivec(3), npts(3)) + bo(1, 3) + ik(3) = MODULO(ivec(3) + 1, npts(3)) + bo(1, 3) + ik(4) = MODULO(ivec(3) + 2, npts(3)) + bo(1, 3) - ij(1) = MODULO(ivec(2)-1, npts(2))+bo(1, 2) - ij(2) = MODULO(ivec(2), npts(2))+bo(1, 2) - ij(3) = MODULO(ivec(2)+1, npts(2))+bo(1, 2) - ij(4) = MODULO(ivec(2)+2, npts(2))+bo(1, 2) + ij(1) = MODULO(ivec(2) - 1, npts(2)) + bo(1, 2) + ij(2) = MODULO(ivec(2), npts(2)) + bo(1, 2) + ij(3) = MODULO(ivec(2) + 1, npts(2)) + bo(1, 2) + ij(4) = MODULO(ivec(2) + 2, npts(2)) + bo(1, 2) - ii(1) = MODULO(ivec(1)-1, npts(1))+bo(1, 1) - ii(2) = MODULO(ivec(1), npts(1))+bo(1, 1) - ii(3) = MODULO(ivec(1)+1, npts(1))+bo(1, 1) - ii(4) = MODULO(ivec(1)+2, npts(1))+bo(1, 1) + ii(1) = MODULO(ivec(1) - 1, npts(1)) + bo(1, 1) + ii(2) = MODULO(ivec(1), npts(1)) + bo(1, 1) + ii(3) = MODULO(ivec(1) + 1, npts(1)) + bo(1, 1) + ii(4) = MODULO(ivec(1) + 2, npts(1)) + bo(1, 1) DO k = 1, 4 DO j = 1, 4 @@ -3291,9 +3291,9 @@ FUNCTION Eval_Interp_Spl3_pbc(vec, pw) RESULT(val) ik(k) >= bo_l(1, 3) .AND. & ik(k) <= bo_l(2, 3) & ) THEN - box(i, j, k) = grid(ii(i)+1-bo_l(1, 1), & - ij(j)+1-bo_l(1, 2), & - ik(k)+1-bo_l(1, 3)) + box(i, j, k) = grid(ii(i) + 1 - bo_l(1, 1), & + ij(j) + 1 - bo_l(1, 2), & + ik(k) + 1 - bo_l(1, 3)) ELSE box(i, j, k) = 0.0_dp END IF @@ -3301,72 +3301,72 @@ FUNCTION Eval_Interp_Spl3_pbc(vec, pw) RESULT(val) END DO END DO - a1 = 3.0_dp+xd1 + a1 = 3.0_dp + xd1 a2 = a1*a1 a3 = a2*a1 - b1 = 2.0_dp+xd1 + b1 = 2.0_dp + xd1 b2 = b1*b1 b3 = b2*b1 - c1 = 1.0_dp+xd1 + c1 = 1.0_dp + xd1 c2 = c1*c1 c3 = c2*c1 d1 = xd1 d2 = d1*d1 d3 = d2*d1 - e1 = 3.0_dp+xd2 + e1 = 3.0_dp + xd2 e2 = e1*e1 e3 = e2*e1 - f1 = 2.0_dp+xd2 + f1 = 2.0_dp + xd2 f2 = f1*f1 f3 = f2*f1 - g1 = 1.0_dp+xd2 + g1 = 1.0_dp + xd2 g2 = g1*g1 g3 = g2*g1 h1 = xd2 h2 = h1*h1 h3 = h2*h1 - p1 = 3.0_dp+xd3 + p1 = 3.0_dp + xd3 p2 = p1*p1 p3 = p2*p1 - q1 = 2.0_dp+xd3 + q1 = 2.0_dp + xd3 q2 = q1*q1 q3 = q2*q1 - r1 = 1.0_dp+xd3 + r1 = 1.0_dp + xd3 r2 = r1*r1 r3 = r2*r1 u1 = xd3 u2 = u1*u1 u3 = u2*u1 - t1 = 1.0_dp/6.0_dp*(64.0_dp-48.0_dp*a1+12.0_dp*a2-a3) - t2 = -22.0_dp/3.0_dp+10.0_dp*b1-4.0_dp*b2+0.5_dp*b3 - t3 = 2.0_dp/3.0_dp-2.0_dp*c1+2.0_dp*c2-0.5_dp*c3 + t1 = 1.0_dp/6.0_dp*(64.0_dp - 48.0_dp*a1 + 12.0_dp*a2 - a3) + t2 = -22.0_dp/3.0_dp + 10.0_dp*b1 - 4.0_dp*b2 + 0.5_dp*b3 + t3 = 2.0_dp/3.0_dp - 2.0_dp*c1 + 2.0_dp*c2 - 0.5_dp*c3 t4 = 1.0_dp/6.0_dp*d3 - s1 = 1.0_dp/6.0_dp*(64.0_dp-48.0_dp*e1+12.0_dp*e2-e3) - s2 = -22.0_dp/3.0_dp+10.0_dp*f1-4.0_dp*f2+0.5_dp*f3 - s3 = 2.0_dp/3.0_dp-2.0_dp*g1+2.0_dp*g2-0.5_dp*g3 + s1 = 1.0_dp/6.0_dp*(64.0_dp - 48.0_dp*e1 + 12.0_dp*e2 - e3) + s2 = -22.0_dp/3.0_dp + 10.0_dp*f1 - 4.0_dp*f2 + 0.5_dp*f3 + s3 = 2.0_dp/3.0_dp - 2.0_dp*g1 + 2.0_dp*g2 - 0.5_dp*g3 s4 = 1.0_dp/6.0_dp*h3 - v1 = 1.0_dp/6.0_dp*(64.0_dp-48.0_dp*p1+12.0_dp*p2-p3) - v2 = -22.0_dp/3.0_dp+10.0_dp*q1-4.0_dp*q2+0.5_dp*q3 - v3 = 2.0_dp/3.0_dp-2.0_dp*r1+2.0_dp*r2-0.5_dp*r3 + v1 = 1.0_dp/6.0_dp*(64.0_dp - 48.0_dp*p1 + 12.0_dp*p2 - p3) + v2 = -22.0_dp/3.0_dp + 10.0_dp*q1 - 4.0_dp*q2 + 0.5_dp*q3 + v3 = 2.0_dp/3.0_dp - 2.0_dp*r1 + 2.0_dp*r2 - 0.5_dp*r3 v4 = 1.0_dp/6.0_dp*u3 - val = ((box(1, 1, 1)*t1+box(2, 1, 1)*t2+box(3, 1, 1)*t3+box(4, 1, 1)*t4)*s1+ & - (box(1, 2, 1)*t1+box(2, 2, 1)*t2+box(3, 2, 1)*t3+box(4, 2, 1)*t4)*s2+ & - (box(1, 3, 1)*t1+box(2, 3, 1)*t2+box(3, 3, 1)*t3+box(4, 3, 1)*t4)*s3+ & - (box(1, 4, 1)*t1+box(2, 4, 1)*t2+box(3, 4, 1)*t3+box(4, 4, 1)*t4)*s4)*v1+ & - ((box(1, 1, 2)*t1+box(2, 1, 2)*t2+box(3, 1, 2)*t3+box(4, 1, 2)*t4)*s1+ & - (box(1, 2, 2)*t1+box(2, 2, 2)*t2+box(3, 2, 2)*t3+box(4, 2, 2)*t4)*s2+ & - (box(1, 3, 2)*t1+box(2, 3, 2)*t2+box(3, 3, 2)*t3+box(4, 3, 2)*t4)*s3+ & - (box(1, 4, 2)*t1+box(2, 4, 2)*t2+box(3, 4, 2)*t3+box(4, 4, 2)*t4)*s4)*v2+ & - ((box(1, 1, 3)*t1+box(2, 1, 3)*t2+box(3, 1, 3)*t3+box(4, 1, 3)*t4)*s1+ & - (box(1, 2, 3)*t1+box(2, 2, 3)*t2+box(3, 2, 3)*t3+box(4, 2, 3)*t4)*s2+ & - (box(1, 3, 3)*t1+box(2, 3, 3)*t2+box(3, 3, 3)*t3+box(4, 3, 3)*t4)*s3+ & - (box(1, 4, 3)*t1+box(2, 4, 3)*t2+box(3, 4, 3)*t3+box(4, 4, 3)*t4)*s4)*v3+ & - ((box(1, 1, 4)*t1+box(2, 1, 4)*t2+box(3, 1, 4)*t3+box(4, 1, 4)*t4)*s1+ & - (box(1, 2, 4)*t1+box(2, 2, 4)*t2+box(3, 2, 4)*t3+box(4, 2, 4)*t4)*s2+ & - (box(1, 3, 4)*t1+box(2, 3, 4)*t2+box(3, 3, 4)*t3+box(4, 3, 4)*t4)*s3+ & - (box(1, 4, 4)*t1+box(2, 4, 4)*t2+box(3, 4, 4)*t3+box(4, 4, 4)*t4)*s4)*v4 + val = ((box(1, 1, 1)*t1 + box(2, 1, 1)*t2 + box(3, 1, 1)*t3 + box(4, 1, 1)*t4)*s1 + & + (box(1, 2, 1)*t1 + box(2, 2, 1)*t2 + box(3, 2, 1)*t3 + box(4, 2, 1)*t4)*s2 + & + (box(1, 3, 1)*t1 + box(2, 3, 1)*t2 + box(3, 3, 1)*t3 + box(4, 3, 1)*t4)*s3 + & + (box(1, 4, 1)*t1 + box(2, 4, 1)*t2 + box(3, 4, 1)*t3 + box(4, 4, 1)*t4)*s4)*v1 + & + ((box(1, 1, 2)*t1 + box(2, 1, 2)*t2 + box(3, 1, 2)*t3 + box(4, 1, 2)*t4)*s1 + & + (box(1, 2, 2)*t1 + box(2, 2, 2)*t2 + box(3, 2, 2)*t3 + box(4, 2, 2)*t4)*s2 + & + (box(1, 3, 2)*t1 + box(2, 3, 2)*t2 + box(3, 3, 2)*t3 + box(4, 3, 2)*t4)*s3 + & + (box(1, 4, 2)*t1 + box(2, 4, 2)*t2 + box(3, 4, 2)*t3 + box(4, 4, 2)*t4)*s4)*v2 + & + ((box(1, 1, 3)*t1 + box(2, 1, 3)*t2 + box(3, 1, 3)*t3 + box(4, 1, 3)*t4)*s1 + & + (box(1, 2, 3)*t1 + box(2, 2, 3)*t2 + box(3, 2, 3)*t3 + box(4, 2, 3)*t4)*s2 + & + (box(1, 3, 3)*t1 + box(2, 3, 3)*t2 + box(3, 3, 3)*t3 + box(4, 3, 3)*t4)*s3 + & + (box(1, 4, 3)*t1 + box(2, 4, 3)*t2 + box(3, 4, 3)*t3 + box(4, 4, 3)*t4)*s4)*v3 + & + ((box(1, 1, 4)*t1 + box(2, 1, 4)*t2 + box(3, 1, 4)*t3 + box(4, 1, 4)*t4)*s1 + & + (box(1, 2, 4)*t1 + box(2, 2, 4)*t2 + box(3, 2, 4)*t3 + box(4, 2, 4)*t4)*s2 + & + (box(1, 3, 4)*t1 + box(2, 3, 4)*t2 + box(3, 3, 4)*t3 + box(4, 3, 4)*t4)*s3 + & + (box(1, 4, 4)*t1 + box(2, 4, 4)*t2 + box(3, 4, 4)*t3 + box(4, 4, 4)*t4)*s4)*v4 IF (my_mpsum) CALL mp_sum(val, pw%pw_grid%para%group) @@ -3414,27 +3414,27 @@ FUNCTION Eval_d_Interp_Spl3_pbc(vec, pw) RESULT(val) dr1i = 1.0_dp/dr1 dr2i = 1.0_dp/dr2 dr3i = 1.0_dp/dr3 - xd1 = (vec(1)/dr1)-REAL(ivec(1), kind=dp) - xd2 = (vec(2)/dr2)-REAL(ivec(2), kind=dp) - xd3 = (vec(3)/dr3)-REAL(ivec(3), kind=dp) + xd1 = (vec(1)/dr1) - REAL(ivec(1), kind=dp) + xd2 = (vec(2)/dr2) - REAL(ivec(2), kind=dp) + xd3 = (vec(3)/dr3) - REAL(ivec(3), kind=dp) grid => pw%cr3d(:, :, :) bo = pw%pw_grid%bounds bo_l = pw%pw_grid%bounds_local - ik(1) = MODULO(ivec(3)-1, npts(3))+bo(1, 3) - ik(2) = MODULO(ivec(3), npts(3))+bo(1, 3) - ik(3) = MODULO(ivec(3)+1, npts(3))+bo(1, 3) - ik(4) = MODULO(ivec(3)+2, npts(3))+bo(1, 3) + ik(1) = MODULO(ivec(3) - 1, npts(3)) + bo(1, 3) + ik(2) = MODULO(ivec(3), npts(3)) + bo(1, 3) + ik(3) = MODULO(ivec(3) + 1, npts(3)) + bo(1, 3) + ik(4) = MODULO(ivec(3) + 2, npts(3)) + bo(1, 3) - ij(1) = MODULO(ivec(2)-1, npts(2))+bo(1, 2) - ij(2) = MODULO(ivec(2), npts(2))+bo(1, 2) - ij(3) = MODULO(ivec(2)+1, npts(2))+bo(1, 2) - ij(4) = MODULO(ivec(2)+2, npts(2))+bo(1, 2) + ij(1) = MODULO(ivec(2) - 1, npts(2)) + bo(1, 2) + ij(2) = MODULO(ivec(2), npts(2)) + bo(1, 2) + ij(3) = MODULO(ivec(2) + 1, npts(2)) + bo(1, 2) + ij(4) = MODULO(ivec(2) + 2, npts(2)) + bo(1, 2) - ii(1) = MODULO(ivec(1)-1, npts(1))+bo(1, 1) - ii(2) = MODULO(ivec(1), npts(1))+bo(1, 1) - ii(3) = MODULO(ivec(1)+1, npts(1))+bo(1, 1) - ii(4) = MODULO(ivec(1)+2, npts(1))+bo(1, 1) + ii(1) = MODULO(ivec(1) - 1, npts(1)) + bo(1, 1) + ii(2) = MODULO(ivec(1), npts(1)) + bo(1, 1) + ii(3) = MODULO(ivec(1) + 1, npts(1)) + bo(1, 1) + ii(4) = MODULO(ivec(1) + 2, npts(1)) + bo(1, 1) DO k = 1, 4 DO j = 1, 4 @@ -3447,9 +3447,9 @@ FUNCTION Eval_d_Interp_Spl3_pbc(vec, pw) RESULT(val) ik(k) >= bo_l(1, 3) .AND. & ik(k) <= bo_l(2, 3) & ) THEN - box(i, j, k) = grid(ii(i)+1-bo_l(1, 1), & - ij(j)+1-bo_l(1, 2), & - ik(k)+1-bo_l(1, 3)) + box(i, j, k) = grid(ii(i) + 1 - bo_l(1, 1), & + ij(j) + 1 - bo_l(1, 2), & + ik(k) + 1 - bo_l(1, 3)) ELSE box(i, j, k) = 0.0_dp END IF @@ -3457,67 +3457,67 @@ FUNCTION Eval_d_Interp_Spl3_pbc(vec, pw) RESULT(val) END DO END DO - a1 = 3.0_dp+xd1 + a1 = 3.0_dp + xd1 a2 = a1*a1 a3 = a2*a1 - b1 = 2.0_dp+xd1 + b1 = 2.0_dp + xd1 b2 = b1*b1 b3 = b2*b1 - c1 = 1.0_dp+xd1 + c1 = 1.0_dp + xd1 c2 = c1*c1 c3 = c2*c1 d1 = xd1 d2 = d1*d1 d3 = d2*d1 - e1 = 3.0_dp+xd2 + e1 = 3.0_dp + xd2 e2 = e1*e1 e3 = e2*e1 - f1 = 2.0_dp+xd2 + f1 = 2.0_dp + xd2 f2 = f1*f1 f3 = f2*f1 - g1 = 1.0_dp+xd2 + g1 = 1.0_dp + xd2 g2 = g1*g1 g3 = g2*g1 h1 = xd2 h2 = h1*h1 h3 = h2*h1 - p1 = 3.0_dp+xd3 + p1 = 3.0_dp + xd3 p2 = p1*p1 p3 = p2*p1 - q1 = 2.0_dp+xd3 + q1 = 2.0_dp + xd3 q2 = q1*q1 q3 = q2*q1 - r1 = 1.0_dp+xd3 + r1 = 1.0_dp + xd3 r2 = r1*r1 r3 = r2*r1 u1 = xd3 u2 = u1*u1 u3 = u2*u1 - t1o = 1.0_dp/6.0_dp*(64.0_dp-48.0_dp*a1+12.0_dp*a2-a3) - t2o = -22.0_dp/3.0_dp+10.0_dp*b1-4.0_dp*b2+0.5_dp*b3 - t3o = 2.0_dp/3.0_dp-2.0_dp*c1+2.0_dp*c2-0.5_dp*c3 + t1o = 1.0_dp/6.0_dp*(64.0_dp - 48.0_dp*a1 + 12.0_dp*a2 - a3) + t2o = -22.0_dp/3.0_dp + 10.0_dp*b1 - 4.0_dp*b2 + 0.5_dp*b3 + t3o = 2.0_dp/3.0_dp - 2.0_dp*c1 + 2.0_dp*c2 - 0.5_dp*c3 t4o = 1.0_dp/6.0_dp*d3 - s1o = 1.0_dp/6.0_dp*(64.0_dp-48.0_dp*e1+12.0_dp*e2-e3) - s2o = -22.0_dp/3.0_dp+10.0_dp*f1-4.0_dp*f2+0.5_dp*f3 - s3o = 2.0_dp/3.0_dp-2.0_dp*g1+2.0_dp*g2-0.5_dp*g3 + s1o = 1.0_dp/6.0_dp*(64.0_dp - 48.0_dp*e1 + 12.0_dp*e2 - e3) + s2o = -22.0_dp/3.0_dp + 10.0_dp*f1 - 4.0_dp*f2 + 0.5_dp*f3 + s3o = 2.0_dp/3.0_dp - 2.0_dp*g1 + 2.0_dp*g2 - 0.5_dp*g3 s4o = 1.0_dp/6.0_dp*h3 - v1o = 1.0_dp/6.0_dp*(64.0_dp-48.0_dp*p1+12.0_dp*p2-p3) - v2o = -22.0_dp/3.0_dp+10.0_dp*q1-4.0_dp*q2+0.5_dp*q3 - v3o = 2.0_dp/3.0_dp-2.0_dp*r1+2.0_dp*r2-0.5_dp*r3 + v1o = 1.0_dp/6.0_dp*(64.0_dp - 48.0_dp*p1 + 12.0_dp*p2 - p3) + v2o = -22.0_dp/3.0_dp + 10.0_dp*q1 - 4.0_dp*q2 + 0.5_dp*q3 + v3o = 2.0_dp/3.0_dp - 2.0_dp*r1 + 2.0_dp*r2 - 0.5_dp*r3 v4o = 1.0_dp/6.0_dp*u3 - t1d = -8.0_dp+4.0_dp*a1-0.5_dp*a2 - t2d = 10.0_dp-8.0_dp*b1+1.5_dp*b2 - t3d = -2.0_dp+4.0_dp*c1-1.5_dp*c2 + t1d = -8.0_dp + 4.0_dp*a1 - 0.5_dp*a2 + t2d = 10.0_dp - 8.0_dp*b1 + 1.5_dp*b2 + t3d = -2.0_dp + 4.0_dp*c1 - 1.5_dp*c2 t4d = 0.5_dp*d2 - s1d = -8.0_dp+4.0_dp*e1-0.5_dp*e2 - s2d = 10.0_dp-8.0_dp*f1+1.5_dp*f2 - s3d = -2.0_dp+4.0_dp*g1-1.5_dp*g2 + s1d = -8.0_dp + 4.0_dp*e1 - 0.5_dp*e2 + s2d = 10.0_dp - 8.0_dp*f1 + 1.5_dp*f2 + s3d = -2.0_dp + 4.0_dp*g1 - 1.5_dp*g2 s4d = 0.5_dp*h2 - v1d = -8.0_dp+4.0_dp*p1-0.5_dp*p2 - v2d = 10.0_dp-8.0_dp*q1+1.5_dp*q2 - v3d = -2.0_dp+4.0_dp*r1-1.5_dp*r2 + v1d = -8.0_dp + 4.0_dp*p1 - 0.5_dp*p2 + v2d = 10.0_dp - 8.0_dp*q1 + 1.5_dp*q2 + v3d = -2.0_dp + 4.0_dp*r1 - 1.5_dp*r2 v4d = 0.5_dp*u2 t1 = t1d*dr1i @@ -3532,22 +3532,22 @@ FUNCTION Eval_d_Interp_Spl3_pbc(vec, pw) RESULT(val) v2 = v2o v3 = v3o v4 = v4o - val(1) = ((box(1, 1, 1)*t1+box(2, 1, 1)*t2+box(3, 1, 1)*t3+box(4, 1, 1)*t4)*s1+ & - (box(1, 2, 1)*t1+box(2, 2, 1)*t2+box(3, 2, 1)*t3+box(4, 2, 1)*t4)*s2+ & - (box(1, 3, 1)*t1+box(2, 3, 1)*t2+box(3, 3, 1)*t3+box(4, 3, 1)*t4)*s3+ & - (box(1, 4, 1)*t1+box(2, 4, 1)*t2+box(3, 4, 1)*t3+box(4, 4, 1)*t4)*s4)*v1+ & - ((box(1, 1, 2)*t1+box(2, 1, 2)*t2+box(3, 1, 2)*t3+box(4, 1, 2)*t4)*s1+ & - (box(1, 2, 2)*t1+box(2, 2, 2)*t2+box(3, 2, 2)*t3+box(4, 2, 2)*t4)*s2+ & - (box(1, 3, 2)*t1+box(2, 3, 2)*t2+box(3, 3, 2)*t3+box(4, 3, 2)*t4)*s3+ & - (box(1, 4, 2)*t1+box(2, 4, 2)*t2+box(3, 4, 2)*t3+box(4, 4, 2)*t4)*s4)*v2+ & - ((box(1, 1, 3)*t1+box(2, 1, 3)*t2+box(3, 1, 3)*t3+box(4, 1, 3)*t4)*s1+ & - (box(1, 2, 3)*t1+box(2, 2, 3)*t2+box(3, 2, 3)*t3+box(4, 2, 3)*t4)*s2+ & - (box(1, 3, 3)*t1+box(2, 3, 3)*t2+box(3, 3, 3)*t3+box(4, 3, 3)*t4)*s3+ & - (box(1, 4, 3)*t1+box(2, 4, 3)*t2+box(3, 4, 3)*t3+box(4, 4, 3)*t4)*s4)*v3+ & - ((box(1, 1, 4)*t1+box(2, 1, 4)*t2+box(3, 1, 4)*t3+box(4, 1, 4)*t4)*s1+ & - (box(1, 2, 4)*t1+box(2, 2, 4)*t2+box(3, 2, 4)*t3+box(4, 2, 4)*t4)*s2+ & - (box(1, 3, 4)*t1+box(2, 3, 4)*t2+box(3, 3, 4)*t3+box(4, 3, 4)*t4)*s3+ & - (box(1, 4, 4)*t1+box(2, 4, 4)*t2+box(3, 4, 4)*t3+box(4, 4, 4)*t4)*s4)*v4 + val(1) = ((box(1, 1, 1)*t1 + box(2, 1, 1)*t2 + box(3, 1, 1)*t3 + box(4, 1, 1)*t4)*s1 + & + (box(1, 2, 1)*t1 + box(2, 2, 1)*t2 + box(3, 2, 1)*t3 + box(4, 2, 1)*t4)*s2 + & + (box(1, 3, 1)*t1 + box(2, 3, 1)*t2 + box(3, 3, 1)*t3 + box(4, 3, 1)*t4)*s3 + & + (box(1, 4, 1)*t1 + box(2, 4, 1)*t2 + box(3, 4, 1)*t3 + box(4, 4, 1)*t4)*s4)*v1 + & + ((box(1, 1, 2)*t1 + box(2, 1, 2)*t2 + box(3, 1, 2)*t3 + box(4, 1, 2)*t4)*s1 + & + (box(1, 2, 2)*t1 + box(2, 2, 2)*t2 + box(3, 2, 2)*t3 + box(4, 2, 2)*t4)*s2 + & + (box(1, 3, 2)*t1 + box(2, 3, 2)*t2 + box(3, 3, 2)*t3 + box(4, 3, 2)*t4)*s3 + & + (box(1, 4, 2)*t1 + box(2, 4, 2)*t2 + box(3, 4, 2)*t3 + box(4, 4, 2)*t4)*s4)*v2 + & + ((box(1, 1, 3)*t1 + box(2, 1, 3)*t2 + box(3, 1, 3)*t3 + box(4, 1, 3)*t4)*s1 + & + (box(1, 2, 3)*t1 + box(2, 2, 3)*t2 + box(3, 2, 3)*t3 + box(4, 2, 3)*t4)*s2 + & + (box(1, 3, 3)*t1 + box(2, 3, 3)*t2 + box(3, 3, 3)*t3 + box(4, 3, 3)*t4)*s3 + & + (box(1, 4, 3)*t1 + box(2, 4, 3)*t2 + box(3, 4, 3)*t3 + box(4, 4, 3)*t4)*s4)*v3 + & + ((box(1, 1, 4)*t1 + box(2, 1, 4)*t2 + box(3, 1, 4)*t3 + box(4, 1, 4)*t4)*s1 + & + (box(1, 2, 4)*t1 + box(2, 2, 4)*t2 + box(3, 2, 4)*t3 + box(4, 2, 4)*t4)*s2 + & + (box(1, 3, 4)*t1 + box(2, 3, 4)*t2 + box(3, 3, 4)*t3 + box(4, 3, 4)*t4)*s3 + & + (box(1, 4, 4)*t1 + box(2, 4, 4)*t2 + box(3, 4, 4)*t3 + box(4, 4, 4)*t4)*s4)*v4 t1 = t1o t2 = t2o @@ -3561,22 +3561,22 @@ FUNCTION Eval_d_Interp_Spl3_pbc(vec, pw) RESULT(val) v2 = v2o v3 = v3o v4 = v4o - val(2) = ((box(1, 1, 1)*t1+box(2, 1, 1)*t2+box(3, 1, 1)*t3+box(4, 1, 1)*t4)*s1+ & - (box(1, 2, 1)*t1+box(2, 2, 1)*t2+box(3, 2, 1)*t3+box(4, 2, 1)*t4)*s2+ & - (box(1, 3, 1)*t1+box(2, 3, 1)*t2+box(3, 3, 1)*t3+box(4, 3, 1)*t4)*s3+ & - (box(1, 4, 1)*t1+box(2, 4, 1)*t2+box(3, 4, 1)*t3+box(4, 4, 1)*t4)*s4)*v1+ & - ((box(1, 1, 2)*t1+box(2, 1, 2)*t2+box(3, 1, 2)*t3+box(4, 1, 2)*t4)*s1+ & - (box(1, 2, 2)*t1+box(2, 2, 2)*t2+box(3, 2, 2)*t3+box(4, 2, 2)*t4)*s2+ & - (box(1, 3, 2)*t1+box(2, 3, 2)*t2+box(3, 3, 2)*t3+box(4, 3, 2)*t4)*s3+ & - (box(1, 4, 2)*t1+box(2, 4, 2)*t2+box(3, 4, 2)*t3+box(4, 4, 2)*t4)*s4)*v2+ & - ((box(1, 1, 3)*t1+box(2, 1, 3)*t2+box(3, 1, 3)*t3+box(4, 1, 3)*t4)*s1+ & - (box(1, 2, 3)*t1+box(2, 2, 3)*t2+box(3, 2, 3)*t3+box(4, 2, 3)*t4)*s2+ & - (box(1, 3, 3)*t1+box(2, 3, 3)*t2+box(3, 3, 3)*t3+box(4, 3, 3)*t4)*s3+ & - (box(1, 4, 3)*t1+box(2, 4, 3)*t2+box(3, 4, 3)*t3+box(4, 4, 3)*t4)*s4)*v3+ & - ((box(1, 1, 4)*t1+box(2, 1, 4)*t2+box(3, 1, 4)*t3+box(4, 1, 4)*t4)*s1+ & - (box(1, 2, 4)*t1+box(2, 2, 4)*t2+box(3, 2, 4)*t3+box(4, 2, 4)*t4)*s2+ & - (box(1, 3, 4)*t1+box(2, 3, 4)*t2+box(3, 3, 4)*t3+box(4, 3, 4)*t4)*s3+ & - (box(1, 4, 4)*t1+box(2, 4, 4)*t2+box(3, 4, 4)*t3+box(4, 4, 4)*t4)*s4)*v4 + val(2) = ((box(1, 1, 1)*t1 + box(2, 1, 1)*t2 + box(3, 1, 1)*t3 + box(4, 1, 1)*t4)*s1 + & + (box(1, 2, 1)*t1 + box(2, 2, 1)*t2 + box(3, 2, 1)*t3 + box(4, 2, 1)*t4)*s2 + & + (box(1, 3, 1)*t1 + box(2, 3, 1)*t2 + box(3, 3, 1)*t3 + box(4, 3, 1)*t4)*s3 + & + (box(1, 4, 1)*t1 + box(2, 4, 1)*t2 + box(3, 4, 1)*t3 + box(4, 4, 1)*t4)*s4)*v1 + & + ((box(1, 1, 2)*t1 + box(2, 1, 2)*t2 + box(3, 1, 2)*t3 + box(4, 1, 2)*t4)*s1 + & + (box(1, 2, 2)*t1 + box(2, 2, 2)*t2 + box(3, 2, 2)*t3 + box(4, 2, 2)*t4)*s2 + & + (box(1, 3, 2)*t1 + box(2, 3, 2)*t2 + box(3, 3, 2)*t3 + box(4, 3, 2)*t4)*s3 + & + (box(1, 4, 2)*t1 + box(2, 4, 2)*t2 + box(3, 4, 2)*t3 + box(4, 4, 2)*t4)*s4)*v2 + & + ((box(1, 1, 3)*t1 + box(2, 1, 3)*t2 + box(3, 1, 3)*t3 + box(4, 1, 3)*t4)*s1 + & + (box(1, 2, 3)*t1 + box(2, 2, 3)*t2 + box(3, 2, 3)*t3 + box(4, 2, 3)*t4)*s2 + & + (box(1, 3, 3)*t1 + box(2, 3, 3)*t2 + box(3, 3, 3)*t3 + box(4, 3, 3)*t4)*s3 + & + (box(1, 4, 3)*t1 + box(2, 4, 3)*t2 + box(3, 4, 3)*t3 + box(4, 4, 3)*t4)*s4)*v3 + & + ((box(1, 1, 4)*t1 + box(2, 1, 4)*t2 + box(3, 1, 4)*t3 + box(4, 1, 4)*t4)*s1 + & + (box(1, 2, 4)*t1 + box(2, 2, 4)*t2 + box(3, 2, 4)*t3 + box(4, 2, 4)*t4)*s2 + & + (box(1, 3, 4)*t1 + box(2, 3, 4)*t2 + box(3, 3, 4)*t3 + box(4, 3, 4)*t4)*s3 + & + (box(1, 4, 4)*t1 + box(2, 4, 4)*t2 + box(3, 4, 4)*t3 + box(4, 4, 4)*t4)*s4)*v4 t1 = t1o t2 = t2o @@ -3590,22 +3590,22 @@ FUNCTION Eval_d_Interp_Spl3_pbc(vec, pw) RESULT(val) v2 = v2d*dr3i v3 = v3d*dr3i v4 = v4d*dr3i - val(3) = ((box(1, 1, 1)*t1+box(2, 1, 1)*t2+box(3, 1, 1)*t3+box(4, 1, 1)*t4)*s1+ & - (box(1, 2, 1)*t1+box(2, 2, 1)*t2+box(3, 2, 1)*t3+box(4, 2, 1)*t4)*s2+ & - (box(1, 3, 1)*t1+box(2, 3, 1)*t2+box(3, 3, 1)*t3+box(4, 3, 1)*t4)*s3+ & - (box(1, 4, 1)*t1+box(2, 4, 1)*t2+box(3, 4, 1)*t3+box(4, 4, 1)*t4)*s4)*v1+ & - ((box(1, 1, 2)*t1+box(2, 1, 2)*t2+box(3, 1, 2)*t3+box(4, 1, 2)*t4)*s1+ & - (box(1, 2, 2)*t1+box(2, 2, 2)*t2+box(3, 2, 2)*t3+box(4, 2, 2)*t4)*s2+ & - (box(1, 3, 2)*t1+box(2, 3, 2)*t2+box(3, 3, 2)*t3+box(4, 3, 2)*t4)*s3+ & - (box(1, 4, 2)*t1+box(2, 4, 2)*t2+box(3, 4, 2)*t3+box(4, 4, 2)*t4)*s4)*v2+ & - ((box(1, 1, 3)*t1+box(2, 1, 3)*t2+box(3, 1, 3)*t3+box(4, 1, 3)*t4)*s1+ & - (box(1, 2, 3)*t1+box(2, 2, 3)*t2+box(3, 2, 3)*t3+box(4, 2, 3)*t4)*s2+ & - (box(1, 3, 3)*t1+box(2, 3, 3)*t2+box(3, 3, 3)*t3+box(4, 3, 3)*t4)*s3+ & - (box(1, 4, 3)*t1+box(2, 4, 3)*t2+box(3, 4, 3)*t3+box(4, 4, 3)*t4)*s4)*v3+ & - ((box(1, 1, 4)*t1+box(2, 1, 4)*t2+box(3, 1, 4)*t3+box(4, 1, 4)*t4)*s1+ & - (box(1, 2, 4)*t1+box(2, 2, 4)*t2+box(3, 2, 4)*t3+box(4, 2, 4)*t4)*s2+ & - (box(1, 3, 4)*t1+box(2, 3, 4)*t2+box(3, 3, 4)*t3+box(4, 3, 4)*t4)*s3+ & - (box(1, 4, 4)*t1+box(2, 4, 4)*t2+box(3, 4, 4)*t3+box(4, 4, 4)*t4)*s4)*v4 + val(3) = ((box(1, 1, 1)*t1 + box(2, 1, 1)*t2 + box(3, 1, 1)*t3 + box(4, 1, 1)*t4)*s1 + & + (box(1, 2, 1)*t1 + box(2, 2, 1)*t2 + box(3, 2, 1)*t3 + box(4, 2, 1)*t4)*s2 + & + (box(1, 3, 1)*t1 + box(2, 3, 1)*t2 + box(3, 3, 1)*t3 + box(4, 3, 1)*t4)*s3 + & + (box(1, 4, 1)*t1 + box(2, 4, 1)*t2 + box(3, 4, 1)*t3 + box(4, 4, 1)*t4)*s4)*v1 + & + ((box(1, 1, 2)*t1 + box(2, 1, 2)*t2 + box(3, 1, 2)*t3 + box(4, 1, 2)*t4)*s1 + & + (box(1, 2, 2)*t1 + box(2, 2, 2)*t2 + box(3, 2, 2)*t3 + box(4, 2, 2)*t4)*s2 + & + (box(1, 3, 2)*t1 + box(2, 3, 2)*t2 + box(3, 3, 2)*t3 + box(4, 3, 2)*t4)*s3 + & + (box(1, 4, 2)*t1 + box(2, 4, 2)*t2 + box(3, 4, 2)*t3 + box(4, 4, 2)*t4)*s4)*v2 + & + ((box(1, 1, 3)*t1 + box(2, 1, 3)*t2 + box(3, 1, 3)*t3 + box(4, 1, 3)*t4)*s1 + & + (box(1, 2, 3)*t1 + box(2, 2, 3)*t2 + box(3, 2, 3)*t3 + box(4, 2, 3)*t4)*s2 + & + (box(1, 3, 3)*t1 + box(2, 3, 3)*t2 + box(3, 3, 3)*t3 + box(4, 3, 3)*t4)*s3 + & + (box(1, 4, 3)*t1 + box(2, 4, 3)*t2 + box(3, 4, 3)*t3 + box(4, 4, 3)*t4)*s4)*v3 + & + ((box(1, 1, 4)*t1 + box(2, 1, 4)*t2 + box(3, 1, 4)*t3 + box(4, 1, 4)*t4)*s1 + & + (box(1, 2, 4)*t1 + box(2, 2, 4)*t2 + box(3, 2, 4)*t3 + box(4, 2, 4)*t4)*s2 + & + (box(1, 3, 4)*t1 + box(2, 3, 4)*t2 + box(3, 3, 4)*t3 + box(4, 3, 4)*t4)*s3 + & + (box(1, 4, 4)*t1 + box(2, 4, 4)*t2 + box(3, 4, 4)*t3 + box(4, 4, 4)*t4)*s4)*v4 IF (my_mpsum) CALL mp_sum(val, pw%pw_grid%para%group) diff --git a/src/pw/pw_types.F b/src/pw/pw_types.F index f38c9c697f..45026ea170 100644 --- a/src/pw/pw_types.F +++ b/src/pw/pw_types.F @@ -91,7 +91,7 @@ SUBROUTINE pw_retain(pw) CPASSERT(ASSOCIATED(pw)) CPASSERT(pw%ref_count > 0) - pw%ref_count = pw%ref_count+1 + pw%ref_count = pw%ref_count + 1 END SUBROUTINE pw_retain ! ************************************************************************************************** @@ -110,11 +110,11 @@ SUBROUTINE pw_release(pw) IF (ASSOCIATED(pw)) THEN CPASSERT(pw%ref_count > 0) - pw%ref_count = pw%ref_count-1 + pw%ref_count = pw%ref_count - 1 IF (pw%ref_count == 0) THEN pw%ref_count = 1 - allocated_pw_count = allocated_pw_count-1 + allocated_pw_count = allocated_pw_count - 1 SELECT CASE (pw%in_use) CASE (REALDATA1D) DEALLOCATE (pw%cr) @@ -185,7 +185,7 @@ SUBROUTINE pw_create(pw, pw_grid, use_data, in_space, cr3d_ptr) END IF END IF - last_pw_id_nr = last_pw_id_nr+1 + last_pw_id_nr = last_pw_id_nr + 1 pw%id_nr = last_pw_id_nr pw%ref_count = 1 NULLIFY (pw%pw_grid) @@ -195,7 +195,7 @@ SUBROUTINE pw_create(pw, pw_grid, use_data, in_space, cr3d_ptr) pw%in_space = NOSPACE bounds => pw%pw_grid%bounds_local - allocated_pw_count = allocated_pw_count+1 + allocated_pw_count = allocated_pw_count + 1 NULLIFY (pw%cr, pw%cc, pw%cr3d, pw%cc3d) diff --git a/src/pw/realspace_grid_cube.F b/src/pw/realspace_grid_cube.F index 2487645d0b..ac73822138 100644 --- a/src/pw/realspace_grid_cube.F +++ b/src/pw/realspace_grid_cube.F @@ -107,13 +107,13 @@ SUBROUTINE pw_to_cube(pw, unit_nr, title, particles_r, particles_z, stride, zero WRITE (unit_nr, '(I5,3f12.6)') np, 0.0_dp, 0._dp, 0._dp !start of cube - WRITE (unit_nr, '(I5,3f12.6)') (pw%pw_grid%npts(1)+my_stride(1)-1)/my_stride(1), & + WRITE (unit_nr, '(I5,3f12.6)') (pw%pw_grid%npts(1) + my_stride(1) - 1)/my_stride(1), & pw%pw_grid%dh(1, 1)*REAL(my_stride(1), dp), pw%pw_grid%dh(2, 1)*REAL(my_stride(1), dp), & pw%pw_grid%dh(3, 1)*REAL(my_stride(1), dp) - WRITE (unit_nr, '(I5,3f12.6)') (pw%pw_grid%npts(2)+my_stride(2)-1)/my_stride(2), & + WRITE (unit_nr, '(I5,3f12.6)') (pw%pw_grid%npts(2) + my_stride(2) - 1)/my_stride(2), & pw%pw_grid%dh(1, 2)*REAL(my_stride(2), dp), pw%pw_grid%dh(2, 2)*REAL(my_stride(2), dp), & pw%pw_grid%dh(3, 2)*REAL(my_stride(2), dp) - WRITE (unit_nr, '(I5,3f12.6)') (pw%pw_grid%npts(3)+my_stride(3)-1)/my_stride(3), & + WRITE (unit_nr, '(I5,3f12.6)') (pw%pw_grid%npts(3) + my_stride(3) - 1)/my_stride(3), & pw%pw_grid%dh(1, 3)*REAL(my_stride(3), dp), pw%pw_grid%dh(2, 3)*REAL(my_stride(3), dp), & pw%pw_grid%dh(3, 3)*REAL(my_stride(3), dp) @@ -156,9 +156,9 @@ SUBROUTINE pw_to_cube(pw, unit_nr, title, particles_r, particles_z, stride, zero ! cycling through the CPUs, check if the current ray (I1,I2) is local to that CPU IF (pw%pw_grid%para%mode .NE. PW_MODE_LOCAL) THEN - DO ip = 0, num_pe-1 - IF (pw%pw_grid%para%bo(1, 1, ip, 1) <= I1-L1+1 .AND. pw%pw_grid%para%bo(2, 1, ip, 1) >= I1-L1+1 .AND. & - pw%pw_grid%para%bo(1, 2, ip, 1) <= I2-L2+1 .AND. pw%pw_grid%para%bo(2, 2, ip, 1) >= I2-L2+1) THEN + DO ip = 0, num_pe - 1 + IF (pw%pw_grid%para%bo(1, 1, ip, 1) <= I1 - L1 + 1 .AND. pw%pw_grid%para%bo(2, 1, ip, 1) >= I1 - L1 + 1 .AND. & + pw%pw_grid%para%bo(1, 2, ip, 1) <= I2 - L2 + 1 .AND. pw%pw_grid%para%bo(2, 2, ip, 1) >= I2 - L2 + 1) THEN source = ip ENDIF ENDDO @@ -202,11 +202,11 @@ SUBROUTINE pw_to_cube(pw, unit_nr, title, particles_r, particles_z, stride, zero DEALLOCATE (buf) ELSE - size_of_z = CEILING(REAL(pw%pw_grid%bounds(2, 3)-pw%pw_grid%bounds(1, 3)+1, dp)/REAL(my_stride(3), dp)) + size_of_z = CEILING(REAL(pw%pw_grid%bounds(2, 3) - pw%pw_grid%bounds(1, 3) + 1, dp)/REAL(my_stride(3), dp)) num_linebreak = size_of_z/num_entries_line IF (MODULO(size_of_z, num_entries_line) /= 0) & - num_linebreak = num_linebreak+1 - msglen = (size_of_z*entry_len+num_linebreak)*mpi_character_size + num_linebreak = num_linebreak + 1 + msglen = (size_of_z*entry_len + num_linebreak)*mpi_character_size CALL pw_to_cube_parallel(pw, unit_nr, title, particles_r, particles_z, my_stride, my_zero_tails, msglen) END IF @@ -256,7 +256,7 @@ SUBROUTINE cube_to_pw(grid, filename, scaling, parallel_read) lbounds_local = grid%pw_grid%bounds_local(1, :) ubounds_local = grid%pw_grid%bounds_local(2, :) - size_of_z = ubounds_local(3)-lbounds_local(3)+1 + size_of_z = ubounds_local(3) - lbounds_local(3) + 1 IF (.NOT. parallel_read) THEN npoints = grid%pw_grid%npts @@ -289,7 +289,7 @@ SUBROUTINE cube_to_pw(grid, filename, scaling, parallel_read) READ (extunit, *) nat, rdum DO i = 1, 3 READ (extunit, *) ndum, rdum - IF ((ndum /= npoints(i) .OR. (ABS(rdum(i)-dr(i)) > 1e-4)) .AND. & + IF ((ndum /= npoints(i) .OR. (ABS(rdum(i) - dr(i)) > 1e-4)) .AND. & output_unit > 0) THEN WRITE (output_unit, *) "Restart from density | ERROR! | CUBE FILE NOT COINCIDENT WITH INTERNAL GRID ", i WRITE (output_unit, *) "Restart from density | ", ndum, " DIFFERS FROM ", npoints(i) @@ -308,7 +308,7 @@ SUBROUTINE cube_to_pw(grid, filename, scaling, parallel_read) IF (my_rank .EQ. 0) THEN READ (extunit, *) (buffer(k), k=lbounds(3), ubounds(3)) IF (num_pe .GT. 1) THEN - DO ip = 1, num_pe-1 + DO ip = 1, num_pe - 1 CALL mp_send(buffer(lbounds(3):ubounds(3)), ip, tag, gid) ENDDO ENDIF @@ -339,8 +339,8 @@ SUBROUTINE cube_to_pw(grid, filename, scaling, parallel_read) ! Thus, this size is simply the number of entries multiplied by the entry size + the number of line breaks num_linebreak = size_of_z/num_entries_line IF (MODULO(size_of_z, num_entries_line) /= 0) & - num_linebreak = num_linebreak+1 - msglen = (size_of_z*entry_len+num_linebreak)*mpi_character_size + num_linebreak = num_linebreak + 1 + msglen = (size_of_z*entry_len + num_linebreak)*mpi_character_size CALL cube_to_pw_parallel(grid, filename, scaling, msglen) END IF @@ -403,8 +403,8 @@ SUBROUTINE cube_to_pw_parallel(grid, filename, scaling, msglen) npoints_local = grid%pw_grid%npts_local lbounds_local = grid%pw_grid%bounds_local(1, :) ubounds_local = grid%pw_grid%bounds_local(2, :) - size_of_z = ubounds_local(3)-lbounds_local(3)+1 - nslices = (ubounds_local(1)-lbounds_local(1)+1)*(ubounds_local(2)-lbounds_local(2)+1) + size_of_z = ubounds_local(3) - lbounds_local(3) + 1 + nslices = (ubounds_local(1) - lbounds_local(1) + 1)*(ubounds_local(2) - lbounds_local(2) + 1) islice = 1 ! Read header information and determine byte offset of cube data on master process @@ -427,7 +427,7 @@ SUBROUTINE cube_to_pw_parallel(grid, filename, scaling, msglen) READ (extunit, *) nat, rdum DO i = 1, 3 READ (extunit, *) ndum, rdum - IF ((ndum /= npoints(i) .OR. (ABS(rdum(i)-dr(i)) > 1e-4)) .AND. & + IF ((ndum /= npoints(i) .OR. (ABS(rdum(i) - dr(i)) > 1e-4)) .AND. & output_unit > 0) THEN WRITE (output_unit, *) "Restart from density | ERROR! | CUBE FILE NOT COINCIDENT WITH INTERNAL GRID ", i WRITE (output_unit, *) "Restart from density | ", ndum, " DIFFERS FROM ", npoints(i) @@ -464,10 +464,10 @@ SUBROUTINE cube_to_pw_parallel(grid, filename, scaling, msglen) IF (ALL(should_read .EQV. .TRUE.)) THEN IF (islice > nslices) CPABORT("Index out of bounds.") displacements(islice) = BOF - islice = islice+1 + islice = islice + 1 END IF ! Update global byte offset - BOF = BOF+msglen + BOF = BOF + msglen END DO END DO ! Size of each z-slice is msglen @@ -512,21 +512,21 @@ SUBROUTINE cube_to_pw_parallel(grid, filename, scaling, msglen) DO k = lbounds_local(3), ubounds_local(3) IF (MODULO(ientry, num_entries_line) == 0 .OR. k == ubounds_local(3)) THEN ! Last value on line, dont read line break - READ (tmp(pos:pos+(entry_len-2)), '(E12.5)') buffer(k) - pos = pos+(entry_len+1) + READ (tmp(pos:pos + (entry_len - 2)), '(E12.5)') buffer(k) + pos = pos + (entry_len + 1) ELSE - READ (tmp(pos:pos+(entry_len-1)), '(E13.5)') buffer(k) - pos = pos+entry_len + READ (tmp(pos:pos + (entry_len - 1)), '(E13.5)') buffer(k) + pos = pos + entry_len END IF - ientry = ientry+1 + ientry = ientry + 1 END DO END IF ! Optionally scale cube file values grid%cr3d(i, j, lbounds(3):ubounds(3)) = scaling*buffer(lbounds(3):ubounds(3)) - j = j+1 + j = j + 1 IF (j > ubounds_local(2)) THEN j = lbounds_local(2) - i = i+1 + i = i + 1 END IF END DO DEALLOCATE (readbuffer) @@ -552,7 +552,7 @@ SUBROUTINE cube_to_pw_parallel(grid, filename, scaling, msglen) READ (extunit, *) nat, rdum DO i = 1, 3 READ (extunit, *) ndum, rdum - IF ((ndum /= npoints(i) .OR. (ABS(rdum(i)-dr(i)) > 1e-4)) .AND. & + IF ((ndum /= npoints(i) .OR. (ABS(rdum(i) - dr(i)) > 1e-4)) .AND. & output_unit > 0) THEN WRITE (output_unit, *) "Restart from density | ERROR! | CUBE FILE NOT COINCIDENT WITH INTERNAL GRID ", i WRITE (output_unit, *) "Restart from density | ", ndum, " DIFFERS FROM ", npoints(i) @@ -571,7 +571,7 @@ SUBROUTINE cube_to_pw_parallel(grid, filename, scaling, msglen) IF (my_rank .EQ. 0) THEN READ (extunit, *) (buffer(k), k=lbounds(3), ubounds(3)) IF (num_pe .GT. 1) THEN - DO ip = 1, num_pe-1 + DO ip = 1, num_pe - 1 CALL mp_send(buffer(lbounds(3):ubounds(3)), ip, tag, gid) ENDDO ENDIF @@ -658,7 +658,7 @@ SUBROUTINE pw_to_cube_parallel(grid, unit_nr, title, particles_r, particles_z, s lbounds_local = grid%pw_grid%bounds_local(1, :) ubounds_local = grid%pw_grid%bounds_local(2, :) ! Determine the total number of z-slices and the number of values per slice - size_of_z = CEILING(REAL(ubounds_local(3)-lbounds_local(3)+1, dp)/REAL(stride(3), dp)) + size_of_z = CEILING(REAL(ubounds_local(3) - lbounds_local(3) + 1, dp)/REAL(stride(3), dp)) islice = 1 DO i = lbounds(1), ubounds(1), stride(1) should_write(:) = .TRUE. @@ -673,13 +673,13 @@ SUBROUTINE pw_to_cube_parallel(grid, unit_nr, title, particles_r, particles_z, s should_write(2) = .FALSE. END IF IF (ALL(should_write .EQV. .TRUE.)) THEN - islice = islice+1 + islice = islice + 1 END IF END DO END DO - nslices = islice-1 + nslices = islice - 1 DO k = lbounds(3), ubounds(3), stride(3) - IF (k+stride(3) > ubounds(3)) last_z = k + IF (k + stride(3) > ubounds(3)) last_z = k END DO islice = 1 ! Determine initial byte offset (0 or EOF if data is appended) @@ -689,13 +689,13 @@ SUBROUTINE pw_to_cube_parallel(grid, unit_nr, title, particles_r, particles_z, s ! this format seems to work for e.g. molekel and gOpenmol ! latest version of VMD can read non orthorhombic cells CALL mp_file_write_at(unit_nr, BOF, "-Quickstep-"//NEW_LINE("C")) - BOF = BOF+LEN("-Quickstep-"//NEW_LINE("C"))*mpi_character_size + BOF = BOF + LEN("-Quickstep-"//NEW_LINE("C"))*mpi_character_size IF (PRESENT(title)) THEN CALL mp_file_write_at(unit_nr, BOF, TRIM(title)//NEW_LINE("C")) - BOF = BOF+LEN(TRIM(title)//NEW_LINE("C"))*mpi_character_size + BOF = BOF + LEN(TRIM(title)//NEW_LINE("C"))*mpi_character_size ELSE CALL mp_file_write_at(unit_nr, BOF, "No Title"//NEW_LINE("C")) - BOF = BOF+LEN("No Title"//NEW_LINE("C"))*mpi_character_size + BOF = BOF + LEN("No Title"//NEW_LINE("C"))*mpi_character_size ENDIF CPASSERT(PRESENT(particles_z) .EQV. PRESENT(particles_r)) @@ -709,31 +709,31 @@ SUBROUTINE pw_to_cube_parallel(grid, unit_nr, title, particles_r, particles_z, s WRITE (header, '(I5,3f12.6)') np, 0.0_dp, 0._dp, 0._dp !start of cube CALL mp_file_write_at(unit_nr, BOF, header//NEW_LINE("C")) - BOF = BOF+LEN(header//NEW_LINE("C"))*mpi_character_size + BOF = BOF + LEN(header//NEW_LINE("C"))*mpi_character_size - WRITE (header, '(I5,3f12.6)') (grid%pw_grid%npts(1)+stride(1)-1)/stride(1), & + WRITE (header, '(I5,3f12.6)') (grid%pw_grid%npts(1) + stride(1) - 1)/stride(1), & grid%pw_grid%dh(1, 1)*REAL(stride(1), dp), grid%pw_grid%dh(2, 1)*REAL(stride(1), dp), & grid%pw_grid%dh(3, 1)*REAL(stride(1), dp) CALL mp_file_write_at(unit_nr, BOF, header//NEW_LINE("C")) - BOF = BOF+LEN(header//NEW_LINE("C"))*mpi_character_size + BOF = BOF + LEN(header//NEW_LINE("C"))*mpi_character_size - WRITE (header, '(I5,3f12.6)') (grid%pw_grid%npts(2)+stride(2)-1)/stride(2), & + WRITE (header, '(I5,3f12.6)') (grid%pw_grid%npts(2) + stride(2) - 1)/stride(2), & grid%pw_grid%dh(1, 2)*REAL(stride(2), dp), grid%pw_grid%dh(2, 2)*REAL(stride(2), dp), & grid%pw_grid%dh(3, 2)*REAL(stride(2), dp) CALL mp_file_write_at(unit_nr, BOF, header//NEW_LINE("C")) - BOF = BOF+LEN(header//NEW_LINE("C"))*mpi_character_size + BOF = BOF + LEN(header//NEW_LINE("C"))*mpi_character_size - WRITE (header, '(I5,3f12.6)') (grid%pw_grid%npts(3)+stride(3)-1)/stride(3), & + WRITE (header, '(I5,3f12.6)') (grid%pw_grid%npts(3) + stride(3) - 1)/stride(3), & grid%pw_grid%dh(1, 3)*REAL(stride(3), dp), grid%pw_grid%dh(2, 3)*REAL(stride(3), dp), & grid%pw_grid%dh(3, 3)*REAL(stride(3), dp) CALL mp_file_write_at(unit_nr, BOF, header//NEW_LINE("C")) - BOF = BOF+LEN(header//NEW_LINE("C"))*mpi_character_size + BOF = BOF + LEN(header//NEW_LINE("C"))*mpi_character_size IF (PRESENT(particles_z)) THEN DO i = 1, np WRITE (header_z, '(I5,4f12.6)') particles_z(i), 0._dp, particles_r(:, i) CALL mp_file_write_at(unit_nr, BOF, header_z//NEW_LINE("C")) - BOF = BOF+LEN(header_z//NEW_LINE("C"))*mpi_character_size + BOF = BOF + LEN(header_z//NEW_LINE("C"))*mpi_character_size END DO END IF ENDIF @@ -769,15 +769,15 @@ SUBROUTINE pw_to_cube_parallel(grid, unit_nr, title, particles_r, particles_z, s WRITE (value, '(E13.5)') grid%cr3d(i, j, k) END IF tmp = TRIM(tmp)//TRIM(value) - counter = counter+1 + counter = counter + 1 IF (MODULO(counter, num_entries_line) == 0 .OR. k == last_z) & tmp = TRIM(tmp)//NEW_LINE('C') END DO writebuffer(islice) = tmp - islice = islice+1 + islice = islice + 1 END IF ! Update global byte offset - BOF = BOF+msglen + BOF = BOF + msglen END DO END DO ! Create indexed MPI type using calculated byte offsets as displacements @@ -861,9 +861,9 @@ SUBROUTINE pw_to_simple_volumetric(pw, unit_nr, stride, pw2) ! Write the header: number of points and number of spins ngrids = 1 IF (DOUBLE) ngrids = 2 - npoints = ((pw%pw_grid%npts(1)+my_stride(1)-1)/my_stride(1))* & - ((pw%pw_grid%npts(2)+my_stride(2)-1)/my_stride(1))* & - ((pw%pw_grid%npts(3)+my_stride(3)-1)/my_stride(1)) + npoints = ((pw%pw_grid%npts(1) + my_stride(1) - 1)/my_stride(1))* & + ((pw%pw_grid%npts(2) + my_stride(2) - 1)/my_stride(1))* & + ((pw%pw_grid%npts(3) + my_stride(3) - 1)/my_stride(1)) IF (unit_nr > 1) WRITE (unit_nr, '(I7,I5)') npoints, ngrids ALLOCATE (buf(L3:U3)) @@ -891,9 +891,9 @@ SUBROUTINE pw_to_simple_volumetric(pw, unit_nr, stride, pw2) ! cycling through the CPUs, check if the current ray (I1,I2) is local to that CPU IF (pw%pw_grid%para%mode .NE. PW_MODE_LOCAL) THEN - DO ip = 0, num_pe-1 - IF (pw%pw_grid%para%bo(1, 1, ip, 1) <= I1-L1+1 .AND. pw%pw_grid%para%bo(2, 1, ip, 1) >= I1-L1+1 .AND. & - pw%pw_grid%para%bo(1, 2, ip, 1) <= I2-L2+1 .AND. pw%pw_grid%para%bo(2, 2, ip, 1) >= I2-L2+1) THEN + DO ip = 0, num_pe - 1 + IF (pw%pw_grid%para%bo(1, 1, ip, 1) <= I1 - L1 + 1 .AND. pw%pw_grid%para%bo(2, 1, ip, 1) >= I1 - L1 + 1 .AND. & + pw%pw_grid%para%bo(1, 2, ip, 1) <= I2 - L2 + 1 .AND. pw%pw_grid%para%bo(2, 2, ip, 1) >= I2 - L2 + 1) THEN source = ip ENDIF ENDDO @@ -923,16 +923,16 @@ SUBROUTINE pw_to_simple_volumetric(pw, unit_nr, stride, pw2) IF (.NOT. DOUBLE) THEN DO I3 = L3, U3, my_stride(3) - x = pw%pw_grid%dh(1, 1)*I1+ & - pw%pw_grid%dh(2, 1)*I2+ & + x = pw%pw_grid%dh(1, 1)*I1 + & + pw%pw_grid%dh(2, 1)*I2 + & pw%pw_grid%dh(3, 1)*I3 - y = pw%pw_grid%dh(1, 2)*I1+ & - pw%pw_grid%dh(2, 2)*I2+ & + y = pw%pw_grid%dh(1, 2)*I1 + & + pw%pw_grid%dh(2, 2)*I2 + & pw%pw_grid%dh(3, 2)*I3 - z = pw%pw_grid%dh(1, 3)*I1+ & - pw%pw_grid%dh(2, 3)*I2+ & + z = pw%pw_grid%dh(1, 3)*I1 + & + pw%pw_grid%dh(2, 3)*I2 + & pw%pw_grid%dh(3, 3)*I3 IF (unit_nr > 0) THEN @@ -943,16 +943,16 @@ SUBROUTINE pw_to_simple_volumetric(pw, unit_nr, stride, pw2) ELSE DO I3 = L3, U3, my_stride(3) - x = pw%pw_grid%dh(1, 1)*I1+ & - pw%pw_grid%dh(2, 1)*I2+ & + x = pw%pw_grid%dh(1, 1)*I1 + & + pw%pw_grid%dh(2, 1)*I2 + & pw%pw_grid%dh(3, 1)*I3 - y = pw%pw_grid%dh(1, 2)*I1+ & - pw%pw_grid%dh(2, 2)*I2+ & + y = pw%pw_grid%dh(1, 2)*I1 + & + pw%pw_grid%dh(2, 2)*I2 + & pw%pw_grid%dh(3, 2)*I3 - z = pw%pw_grid%dh(1, 3)*I1+ & - pw%pw_grid%dh(2, 3)*I2+ & + z = pw%pw_grid%dh(1, 3)*I1 + & + pw%pw_grid%dh(2, 3)*I2 + & pw%pw_grid%dh(3, 3)*I3 IF (unit_nr > 0) THEN diff --git a/src/pw/realspace_grid_types.F b/src/pw/realspace_grid_types.F index 6398033efa..0ba64509d1 100644 --- a/src/pw/realspace_grid_types.F +++ b/src/pw/realspace_grid_types.F @@ -180,7 +180,7 @@ FUNCTION rs_grid_locate_rank(rs_desc, rank_in, shift) RESULT(rank_out) INTEGER :: coord(3) - coord = MODULO(rs_desc%rank2coord(:, rank_in)+shift, rs_desc%group_dim) + coord = MODULO(rs_desc%rank2coord(:, rank_in) + shift, rs_desc%group_dim) rank_out = rs_desc%coord2rank(coord(1), coord(2), coord(3)) END FUNCTION rs_grid_locate_rank @@ -273,7 +273,7 @@ SUBROUTINE rs_grid_create_descriptor(desc, pw_grid, input_settings, border_point ! this is the eventual border size IF (border_size == 0) THEN - nmin = (input_settings%nsmax+1)/2 + nmin = (input_settings%nsmax + 1)/2 nmin = MAX(0, NINT(nmin*input_settings%halo_reduction_factor)) ELSE ! Set explicitly the requested border size @@ -315,11 +315,11 @@ SUBROUTINE rs_grid_create_descriptor(desc, pw_grid, input_settings, border_point DO dir = 1, 3 IF (n_slices_tmp(dir) > 1) THEN neighbours(dir) = HUGE(0) - DO l = 0, n_slices_tmp(dir)-1 + DO l = 0, n_slices_tmp(dir) - 1 lb = get_limit(desc%npts(dir), n_slices_tmp(dir), l) - neighbours(dir) = MIN(lb(2)-lb(1)+1, neighbours(dir)) + neighbours(dir) = MIN(lb(2) - lb(1) + 1, neighbours(dir)) ENDDO - desc%neighbours(dir) = (nmin+neighbours(dir)-1)/neighbours(dir) + desc%neighbours(dir) = (nmin + neighbours(dir) - 1)/neighbours(dir) IF (desc%neighbours(dir) .GE. n_slices_tmp(dir)) overlap = .TRUE. ELSE neighbours(dir) = 0 @@ -334,7 +334,7 @@ SUBROUTINE rs_grid_create_descriptor(desc, pw_grid, input_settings, border_point ! volume of the box without the wings / volume of the box with the wings ! with prefactodesc to promote less cuts in Z dimension ratio = PRODUCT(REAL(desc%npts, KIND=dp)/n_slices_tmp)/ & - PRODUCT(REAL(desc%npts, KIND=dp)/n_slices_tmp+ & + PRODUCT(REAL(desc%npts, KIND=dp)/n_slices_tmp + & MERGE((/0.0, 0.0, 0.0/), 2*(/1.06*nmin, 1.05*nmin, 1.03*nmin/), n_slices_tmp == (/1, 1, 1/))) IF (ratio > ratio_best) THEN ratio_best = ratio @@ -348,7 +348,7 @@ SUBROUTINE rs_grid_create_descriptor(desc, pw_grid, input_settings, border_point ! if the memory gain (or the gain is messages) is too small. IF (input_settings%distribution_type == rsgrid_automatic) THEN volume = PRODUCT(REAL(desc%npts, KIND=dp)) - volume_dist = PRODUCT(REAL(desc%npts, KIND=dp)/n_slices+ & + volume_dist = PRODUCT(REAL(desc%npts, KIND=dp)/n_slices + & MERGE((/0, 0, 0/), 2*(/nmin, nmin, nmin/), n_slices == (/1, 1, 1/))) IF (volume < volume_dist*input_settings%memory_factor) THEN n_slices = 1 @@ -376,10 +376,10 @@ SUBROUTINE rs_grid_create_descriptor(desc, pw_grid, input_settings, border_point desc%group_coor(:) = 0 desc%my_virtual_pos = 0 - ALLOCATE (desc%virtual2real(0:desc%group_size-1)) - ALLOCATE (desc%real2virtual(0:desc%group_size-1)) + ALLOCATE (desc%virtual2real(0:desc%group_size - 1)) + ALLOCATE (desc%real2virtual(0:desc%group_size - 1)) ! Start with no reordering - DO i = 0, desc%group_size-1 + DO i = 0, desc%group_size - 1 desc%virtual2real(i) = i desc%real2virtual(i) = i END DO @@ -402,15 +402,15 @@ SUBROUTINE rs_grid_create_descriptor(desc, pw_grid, input_settings, border_point desc%group_head = (desc%my_pos == 0) ! set up global info about the distribution - ALLOCATE (desc%rank2coord(3, 0:desc%group_size-1)) - ALLOCATE (desc%coord2rank(0:desc%group_dim(1)-1, 0:desc%group_dim(2)-1, 0:desc%group_dim(3)-1)) - ALLOCATE (desc%lb_global(3, 0:desc%group_size-1)) - ALLOCATE (desc%ub_global(3, 0:desc%group_size-1)) + ALLOCATE (desc%rank2coord(3, 0:desc%group_size - 1)) + ALLOCATE (desc%coord2rank(0:desc%group_dim(1) - 1, 0:desc%group_dim(2) - 1, 0:desc%group_dim(3) - 1)) + ALLOCATE (desc%lb_global(3, 0:desc%group_size - 1)) + ALLOCATE (desc%ub_global(3, 0:desc%group_size - 1)) ALLOCATE (desc%x2coord(desc%lb(1):desc%ub(1))) ALLOCATE (desc%y2coord(desc%lb(2):desc%ub(2))) ALLOCATE (desc%z2coord(desc%lb(3):desc%ub(3))) - DO i = 0, desc%group_size-1 + DO i = 0, desc%group_size - 1 ! Calculate coordinates in a row-major order (to be SMP-friendly) desc%rank2coord(1, i) = i/(desc%group_dim(2)*desc%group_dim(3)) desc%rank2coord(2, i) = MODULO(i, desc%group_dim(2)*desc%group_dim(3)) & @@ -428,18 +428,18 @@ SUBROUTINE rs_grid_create_descriptor(desc, pw_grid, input_settings, border_point DO dir = 1, 3 IF (desc%group_dim(dir) .GT. 1) THEN lb = get_limit(desc%npts(dir), desc%group_dim(dir), desc%rank2coord(dir, i)) - desc%lb_global(dir, i) = lb(1)+desc%lb(dir)-1 - desc%ub_global(dir, i) = lb(2)+desc%lb(dir)-1 + desc%lb_global(dir, i) = lb(1) + desc%lb(dir) - 1 + desc%ub_global(dir, i) = lb(2) + desc%lb(dir) - 1 ENDIF ENDDO ENDDO ! map a grid point to a CPU coord DO dir = 1, 3 - DO l = 0, desc%group_dim(dir)-1 + DO l = 0, desc%group_dim(dir) - 1 IF (desc%group_dim(dir) .GT. 1) THEN lb = get_limit(desc%npts(dir), desc%group_dim(dir), l) - lb = lb+desc%lb(dir)-1 + lb = lb + desc%lb(dir) - 1 ELSE lb(1) = desc%lb(dir) lb(2) = desc%ub(dir) @@ -460,18 +460,18 @@ SUBROUTINE rs_grid_create_descriptor(desc, pw_grid, input_settings, border_point desc%neighbours(dir) = 0 IF ((n_slices(dir) > 1) .OR. (border_size > 0)) THEN neighbours(dir) = HUGE(0) - DO l = 0, n_slices(dir)-1 + DO l = 0, n_slices(dir) - 1 lb = get_limit(desc%npts(dir), n_slices(dir), l) - neighbours(dir) = MIN(lb(2)-lb(1)+1, neighbours(dir)) + neighbours(dir) = MIN(lb(2) - lb(1) + 1, neighbours(dir)) END DO - desc%neighbours(dir) = (desc%border+neighbours(dir)-1)/neighbours(dir) + desc%neighbours(dir) = (desc%border + neighbours(dir) - 1)/neighbours(dir) END IF END DO - ALLOCATE (desc%virtual2real(0:desc%group_size-1)) - ALLOCATE (desc%real2virtual(0:desc%group_size-1)) + ALLOCATE (desc%virtual2real(0:desc%group_size - 1)) + ALLOCATE (desc%real2virtual(0:desc%group_size - 1)) ! Start with no reordering - DO i = 0, desc%group_size-1 + DO i = 0, desc%group_size - 1 desc%virtual2real(i) = i desc%real2virtual(i) = i END DO @@ -503,7 +503,7 @@ SUBROUTINE rs_grid_create(rs, desc) ALLOCATE (rs) - last_rs_id = last_rs_id+1 + last_rs_id = last_rs_id + 1 rs%id_nr = last_rs_id rs%ref_count = 1 rs%desc => desc @@ -514,9 +514,9 @@ SUBROUTINE rs_grid_create(rs, desc) ! All operations will be done locally rs%lb_real = desc%lb rs%ub_real = desc%ub - rs%lb_local = rs%lb_real-desc%border*(1-desc%perd) - rs%ub_local = rs%ub_real+desc%border*(1-desc%perd) - rs%npts_local = rs%ub_local-rs%lb_local+1 + rs%lb_local = rs%lb_real - desc%border*(1 - desc%perd) + rs%ub_local = rs%ub_real + desc%border*(1 - desc%perd) + rs%npts_local = rs%ub_local - rs%lb_local + 1 rs%ngpts_local = PRODUCT(rs%npts_local) END IF @@ -525,22 +525,22 @@ SUBROUTINE rs_grid_create(rs, desc) ! recombination of the total density rs%lb_real = desc%lb rs%ub_real = desc%ub - rs%lb_local = rs%lb_real-desc%border*(1-desc%perd) - rs%ub_local = rs%ub_real+desc%border*(1-desc%perd) - rs%npts_local = rs%ub_local-rs%lb_local+1 + rs%lb_local = rs%lb_real - desc%border*(1 - desc%perd) + rs%ub_local = rs%ub_real + desc%border*(1 - desc%perd) + rs%npts_local = rs%ub_local - rs%lb_local + 1 rs%ngpts_local = PRODUCT(rs%npts_local) ELSE ! CASE 2 : general case ! extract some more derived quantities about the local grid rs%lb_real = desc%lb_global(:, desc%my_virtual_pos) rs%ub_real = desc%ub_global(:, desc%my_virtual_pos) - rs%lb_local = rs%lb_real-desc%border*(1-desc%perd) - rs%ub_local = rs%ub_real+desc%border*(1-desc%perd) - rs%npts_local = rs%ub_local-rs%lb_local+1 + rs%lb_local = rs%lb_real - desc%border*(1 - desc%perd) + rs%ub_local = rs%ub_real + desc%border*(1 - desc%perd) + rs%npts_local = rs%ub_local - rs%lb_local + 1 rs%ngpts_local = PRODUCT(rs%npts_local) END IF - allocated_rs_grid_count = allocated_rs_grid_count+1 + allocated_rs_grid_count = allocated_rs_grid_count + 1 ALLOCATE (rs%r(rs%lb_local(1):rs%ub_local(1), & rs%lb_local(2):rs%ub_local(2), & @@ -583,7 +583,7 @@ SUBROUTINE rs_grid_reorder_ranks(desc, real2virtual) desc%real2virtual(:) = real2virtual - DO i = 0, desc%group_size-1 + DO i = 0, desc%group_size - 1 desc%virtual2real(desc%real2virtual(i)) = i END DO @@ -753,25 +753,25 @@ SUBROUTINE rs_pw_transfer(rs, pw, dir) !$OMP SHARED(pw,rs) DO k = rs%lb_local(3), rs%ub_local(3) IF (k < rs%lb_real(3)) THEN - km = k+rs%desc%npts(3) + km = k + rs%desc%npts(3) ELSE IF (k > rs%ub_real(3)) THEN - km = k-rs%desc%npts(3) + km = k - rs%desc%npts(3) ELSE km = k END IF DO j = rs%lb_local(2), rs%ub_local(2) IF (j < rs%lb_real(2)) THEN - jm = j+rs%desc%npts(2) + jm = j + rs%desc%npts(2) ELSE IF (j > rs%ub_real(2)) THEN - jm = j-rs%desc%npts(2) + jm = j - rs%desc%npts(2) ELSE jm = j END IF DO i = rs%lb_local(1), rs%ub_local(1) IF (i < rs%lb_real(1)) THEN - im = i+rs%desc%npts(1) + im = i + rs%desc%npts(1) ELSE IF (i > rs%ub_real(1)) THEN - im = i-rs%desc%npts(1) + im = i - rs%desc%npts(1) ELSE im = i END IF @@ -790,25 +790,25 @@ SUBROUTINE rs_pw_transfer(rs, pw, dir) !$OMP SHARED(pw,rs) DO k = rs%lb_local(3), rs%ub_local(3) IF (k < rs%lb_real(3)) THEN - km = k+rs%desc%npts(3) + km = k + rs%desc%npts(3) ELSE IF (k > rs%ub_real(3)) THEN - km = k-rs%desc%npts(3) + km = k - rs%desc%npts(3) ELSE km = k END IF DO j = rs%lb_local(2), rs%ub_local(2) IF (j < rs%lb_real(2)) THEN - jm = j+rs%desc%npts(2) + jm = j + rs%desc%npts(2) ELSE IF (j > rs%ub_real(2)) THEN - jm = j-rs%desc%npts(2) + jm = j - rs%desc%npts(2) ELSE jm = j END IF DO i = rs%lb_local(1), rs%ub_local(1) IF (i < rs%lb_real(1)) THEN - im = i+rs%desc%npts(1) + im = i + rs%desc%npts(1) ELSE IF (i > rs%ub_real(1)) THEN - im = i-rs%desc%npts(1) + im = i - rs%desc%npts(1) ELSE im = i END IF @@ -857,15 +857,15 @@ SUBROUTINE rs_pw_transfer_replicated(rs, pw, dir) REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: grid np = pw%pw_grid%para%group_size - bo => pw%pw_grid%para%bo(1:2, 1:3, 0:np-1, 1) + bo => pw%pw_grid%para%bo(1:2, 1:3, 0:np - 1, 1) pbo => pw%pw_grid%bounds group = pw%pw_grid%para%rs_group mepos = pw%pw_grid%para%rs_mpo - ALLOCATE (rcount(0:np-1)) + ALLOCATE (rcount(0:np - 1)) DO ip = 1, np - rcount(ip-1) = PRODUCT(bo(2, :, ip)-bo(1, :, ip)+1) + rcount(ip - 1) = PRODUCT(bo(2, :, ip) - bo(1, :, ip) + 1) END DO - nma = MAXVAL(rcount(0:np-1)) + nma = MAXVAL(rcount(0:np - 1)) ALLOCATE (sendbuf(nma), recvbuf(nma)) sendbuf = 1.0E99_dp; recvbuf = 1.0E99_dp ! init mpi'ed buffers to silence warnings under valgrind grid => rs%r @@ -874,26 +874,26 @@ SUBROUTINE rs_pw_transfer_replicated(rs, pw, dir) CALL m_memory() IF (dir == rs2pw) THEN - dest = MODULO(mepos+1, np) - source = MODULO(mepos-1, np) + dest = MODULO(mepos + 1, np) + source = MODULO(mepos - 1, np) sendbuf = 0.0_dp DO ip = 1, np - lb = pbo(1, :)+bo(1, :, MODULO(mepos-ip, np)+1)-1 - ub = pbo(1, :)+bo(2, :, MODULO(mepos-ip, np)+1)-1 + lb = pbo(1, :) + bo(1, :, MODULO(mepos - ip, np) + 1) - 1 + ub = pbo(1, :) + bo(2, :, MODULO(mepos - ip, np) + 1) - 1 ! this loop takes about the same time as the message passing call ! notice that the range of ix is only a small fraction of the first index of grid ! therefore it seems faster to have the second index as the innermost loop ! if this runs on many cpus ! tested on itanium, pentium4, opteron, ultrasparc... - s = ub-lb+1 + s = ub - lb + 1 DO iz = lb(3), ub(3) DO ix = lb(1), ub(1) - ii = (iz-lb(3))*s(1)*s(2)+(ix-lb(1))+1 + ii = (iz - lb(3))*s(1)*s(2) + (ix - lb(1)) + 1 DO iy = lb(2), ub(2) - sendbuf(ii) = sendbuf(ii)+grid(ix, iy, iz) - ii = ii+s(1) + sendbuf(ii) = sendbuf(ii) + grid(ix, iy, iz) + ii = ii + s(1) END DO END DO END DO @@ -923,17 +923,17 @@ SUBROUTINE rs_pw_transfer_replicated(rs, pw, dir) CPABORT("PW type not compatible") END IF - dest = MODULO(mepos+1, np) - source = MODULO(mepos-1, np) + dest = MODULO(mepos + 1, np) + source = MODULO(mepos - 1, np) - DO ip = 0, np-1 + DO ip = 0, np - 1 ! we must shift the buffer only np-1 times around - IF (ip .NE. np-1) THEN + IF (ip .NE. np - 1) THEN CALL mp_isendrecv(sendbuf, dest, recvbuf, source, & group, req(1), req(2), 13) ENDIF - lb = pbo(1, :)+bo(1, :, MODULO(mepos-ip, np)+1)-1 - ub = pbo(1, :)+bo(2, :, MODULO(mepos-ip, np)+1)-1 + lb = pbo(1, :) + bo(1, :, MODULO(mepos - ip, np) + 1) - 1 + ub = pbo(1, :) + bo(2, :, MODULO(mepos - ip, np) + 1) - 1 ii = 0 ! this loop takes about the same time as the message passing call ! If I read the code correctly then: @@ -945,12 +945,12 @@ SUBROUTINE rs_pw_transfer_replicated(rs, pw, dir) DO iz = lb(3), ub(3) DO iy = lb(2), ub(2) DO ix = lb(1), ub(1) - ii = ii+1 + ii = ii + 1 grid(ix, iy, iz) = sendbuf(ii) END DO END DO END DO - IF (ip .NE. np-1) THEN + IF (ip .NE. np - 1) THEN CALL mp_waitall(req) ENDIF swapptr => sendbuf @@ -963,25 +963,25 @@ SUBROUTINE rs_pw_transfer_replicated(rs, pw, dir) !$OMP SHARED(rs) DO k = rs%lb_local(3), rs%ub_local(3) IF (k < rs%lb_real(3)) THEN - km = k+rs%desc%npts(3) + km = k + rs%desc%npts(3) ELSE IF (k > rs%ub_real(3)) THEN - km = k-rs%desc%npts(3) + km = k - rs%desc%npts(3) ELSE km = k END IF DO j = rs%lb_local(2), rs%ub_local(2) IF (j < rs%lb_real(2)) THEN - jm = j+rs%desc%npts(2) + jm = j + rs%desc%npts(2) ELSE IF (j > rs%ub_real(2)) THEN - jm = j-rs%desc%npts(2) + jm = j - rs%desc%npts(2) ELSE jm = j END IF DO i = rs%lb_local(1), rs%ub_local(1) IF (i < rs%lb_real(1)) THEN - im = i+rs%desc%npts(1) + im = i + rs%desc%npts(1) ELSE IF (i > rs%ub_real(1)) THEN - im = i-rs%desc%npts(1) + im = i - rs%desc%npts(1) ELSE im = i END IF @@ -1074,17 +1074,17 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) dshifts = 0 ! check that we don't try to send data to ourself - DO n_shifts = 1, MIN(rs%desc%neighbours(idir), rs%desc%group_dim(idir)-1) + DO n_shifts = 1, MIN(rs%desc%neighbours(idir), rs%desc%group_dim(idir) - 1) ! need to take into account the possible varying widths of neighbouring cells ! offset_up and offset_down hold the real size of the neighbouring cells - position = MODULO(rs%desc%virtual_group_coor(idir)-n_shifts, rs%desc%group_dim(idir)) + position = MODULO(rs%desc%virtual_group_coor(idir) - n_shifts, rs%desc%group_dim(idir)) neighbours = get_limit(rs%desc%npts(idir), rs%desc%group_dim(idir), position) - dshifts(n_shifts) = dshifts(n_shifts-1)+(neighbours(2)-neighbours(1)+1) + dshifts(n_shifts) = dshifts(n_shifts - 1) + (neighbours(2) - neighbours(1) + 1) - position = MODULO(rs%desc%virtual_group_coor(idir)+n_shifts, rs%desc%group_dim(idir)) + position = MODULO(rs%desc%virtual_group_coor(idir) + n_shifts, rs%desc%group_dim(idir)) neighbours = get_limit(rs%desc%npts(idir), rs%desc%group_dim(idir), position) - ushifts(n_shifts) = ushifts(n_shifts-1)+(neighbours(2)-neighbours(1)+1) + ushifts(n_shifts) = ushifts(n_shifts - 1) + (neighbours(2) - neighbours(1) + 1) ! The border data has to be send/received from the neighbours ! First we calculate the source and destination processes for the shift @@ -1097,14 +1097,14 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) ub_recv_down(:) = rs%ub_local(:) ub_send_down(:) = rs%ub_local(:) - IF (dshifts(n_shifts-1) .LE. rs%desc%border) THEN - ub_send_down(idir) = lb_send_down(idir)+rs%desc%border-1-dshifts(n_shifts-1) + IF (dshifts(n_shifts - 1) .LE. rs%desc%border) THEN + ub_send_down(idir) = lb_send_down(idir) + rs%desc%border - 1 - dshifts(n_shifts - 1) lb_send_down(idir) = MAX(lb_send_down(idir), & - lb_send_down(idir)+rs%desc%border-dshifts(n_shifts)) + lb_send_down(idir) + rs%desc%border - dshifts(n_shifts)) - ub_recv_down(idir) = ub_recv_down(idir)-rs%desc%border - lb_recv_down(idir) = MAX(lb_recv_down(idir)+rs%desc%border, & - ub_recv_down(idir)-rs%desc%border+1+ushifts(n_shifts-1)) + ub_recv_down(idir) = ub_recv_down(idir) - rs%desc%border + lb_recv_down(idir) = MAX(lb_recv_down(idir) + rs%desc%border, & + ub_recv_down(idir) - rs%desc%border + 1 + ushifts(n_shifts - 1)) ELSE lb_send_down(idir) = 0 ub_send_down(idir) = -1 @@ -1127,18 +1127,18 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) CALL mp_irecv(recv_buf_3d_down, source_down, rs%desc%group, req(1)) ! now allocate, pack and send the send buffer - nn = PRODUCT(ub_send_down-lb_send_down+1) + nn = PRODUCT(ub_send_down - lb_send_down + 1) ALLOCATE (send_buf_3d_down(lb_send_down(1):ub_send_down(1), & lb_send_down(2):ub_send_down(2), lb_send_down(3):ub_send_down(3))) !$OMP PARALLEL DEFAULT(NONE), & !$OMP PRIVATE(lb,ub,my_id,NUM_THREADS), & !$OMP SHARED(send_buf_3d_down,rs,lb_send_down,ub_send_down) -!$ num_threads = MIN(omp_get_max_threads(), ub_send_down(3)-lb_send_down(3)+1) +!$ num_threads = MIN(omp_get_max_threads(), ub_send_down(3) - lb_send_down(3) + 1) !$ my_id = omp_get_thread_num() IF (my_id < num_threads) THEN - lb = lb_send_down(3)+((ub_send_down(3)-lb_send_down(3)+1)*my_id)/num_threads - ub = lb_send_down(3)+((ub_send_down(3)-lb_send_down(3)+1)*(my_id+1))/num_threads-1 + lb = lb_send_down(3) + ((ub_send_down(3) - lb_send_down(3) + 1)*my_id)/num_threads + ub = lb_send_down(3) + ((ub_send_down(3) - lb_send_down(3) + 1)*(my_id + 1))/num_threads - 1 send_buf_3d_down(lb_send_down(1):ub_send_down(1), lb_send_down(2):ub_send_down(2), & lb:ub) = rs%r(lb_send_down(1):ub_send_down(1), & @@ -1156,15 +1156,15 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) ub_recv_up(:) = rs%ub_local(:) ub_send_up(:) = rs%ub_local(:) - IF (ushifts(n_shifts-1) .LE. rs%desc%border) THEN + IF (ushifts(n_shifts - 1) .LE. rs%desc%border) THEN - lb_send_up(idir) = ub_send_up(idir)-rs%desc%border+1+ushifts(n_shifts-1) + lb_send_up(idir) = ub_send_up(idir) - rs%desc%border + 1 + ushifts(n_shifts - 1) ub_send_up(idir) = MIN(ub_send_up(idir), & - ub_send_up(idir)-rs%desc%border+ushifts(n_shifts)) + ub_send_up(idir) - rs%desc%border + ushifts(n_shifts)) - lb_recv_up(idir) = lb_recv_up(idir)+rs%desc%border - ub_recv_up(idir) = MIN(ub_recv_up(idir)-rs%desc%border, & - lb_recv_up(idir)+rs%desc%border-1-dshifts(n_shifts-1)) + lb_recv_up(idir) = lb_recv_up(idir) + rs%desc%border + ub_recv_up(idir) = MIN(ub_recv_up(idir) - rs%desc%border, & + lb_recv_up(idir) + rs%desc%border - 1 - dshifts(n_shifts - 1)) ELSE lb_send_up(idir) = 0 ub_send_up(idir) = -1 @@ -1187,18 +1187,18 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) CALL mp_irecv(recv_buf_3d_up, source_up, rs%desc%group, req(2)) ! now allocate,pack and send the send buffer - nn = PRODUCT(ub_send_up-lb_send_up+1) + nn = PRODUCT(ub_send_up - lb_send_up + 1) ALLOCATE (send_buf_3d_up(lb_send_up(1):ub_send_up(1), & lb_send_up(2):ub_send_up(2), lb_send_up(3):ub_send_up(3))) !$OMP PARALLEL DEFAULT(NONE), & !$OMP PRIVATE(lb,ub,my_id,NUM_THREADS), & !$OMP SHARED(send_buf_3d_up,rs,lb_send_up,ub_send_up) -!$ num_threads = MIN(omp_get_max_threads(), ub_send_up(3)-lb_send_up(3)+1) +!$ num_threads = MIN(omp_get_max_threads(), ub_send_up(3) - lb_send_up(3) + 1) !$ my_id = omp_get_thread_num() IF (my_id < num_threads) THEN - lb = lb_send_up(3)+((ub_send_up(3)-lb_send_up(3)+1)*my_id)/num_threads - ub = lb_send_up(3)+((ub_send_up(3)-lb_send_up(3)+1)*(my_id+1))/num_threads-1 + lb = lb_send_up(3) + ((ub_send_up(3) - lb_send_up(3) + 1)*my_id)/num_threads + ub = lb_send_up(3) + ((ub_send_up(3) - lb_send_up(3) + 1)*(my_id + 1))/num_threads - 1 send_buf_3d_up(lb_send_up(1):ub_send_up(1), lb_send_up(2):ub_send_up(2), & lb:ub) = rs%r(lb_send_up(1):ub_send_up(1), & @@ -1222,16 +1222,16 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) !$OMP PARALLEL DEFAULT(NONE), & !$OMP PRIVATE(lb,ub,my_id,NUM_THREADS), & !$OMP SHARED(recv_buf_3d_down,rs,lb_recv_down,ub_recv_down) -!$ num_threads = MIN(omp_get_max_threads(), ub_recv_down(3)-lb_recv_down(3)+1) +!$ num_threads = MIN(omp_get_max_threads(), ub_recv_down(3) - lb_recv_down(3) + 1) !$ my_id = omp_get_thread_num() IF (my_id < num_threads) THEN - lb = lb_recv_down(3)+((ub_recv_down(3)-lb_recv_down(3)+1)*my_id)/num_threads - ub = lb_recv_down(3)+((ub_recv_down(3)-lb_recv_down(3)+1)*(my_id+1))/num_threads-1 + lb = lb_recv_down(3) + ((ub_recv_down(3) - lb_recv_down(3) + 1)*my_id)/num_threads + ub = lb_recv_down(3) + ((ub_recv_down(3) - lb_recv_down(3) + 1)*(my_id + 1))/num_threads - 1 rs%r(lb_recv_down(1):ub_recv_down(1), & lb_recv_down(2):ub_recv_down(2), lb:ub) = & rs%r(lb_recv_down(1):ub_recv_down(1), & - lb_recv_down(2):ub_recv_down(2), lb:ub)+ & + lb_recv_down(2):ub_recv_down(2), lb:ub) + & recv_buf_3d_down(:, :, lb:ub) END IF !$OMP END PARALLEL @@ -1245,16 +1245,16 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) !$OMP PARALLEL DEFAULT(NONE), & !$OMP PRIVATE(lb,ub,my_id,NUM_THREADS), & !$OMP SHARED(recv_buf_3d_up,rs,lb_recv_up,ub_recv_up) -!$ num_threads = MIN(omp_get_max_threads(), ub_recv_up(3)-lb_recv_up(3)+1) +!$ num_threads = MIN(omp_get_max_threads(), ub_recv_up(3) - lb_recv_up(3) + 1) !$ my_id = omp_get_thread_num() IF (my_id < num_threads) THEN - lb = lb_recv_up(3)+((ub_recv_up(3)-lb_recv_up(3)+1)*my_id)/num_threads - ub = lb_recv_up(3)+((ub_recv_up(3)-lb_recv_up(3)+1)*(my_id+1))/num_threads-1 + lb = lb_recv_up(3) + ((ub_recv_up(3) - lb_recv_up(3) + 1)*my_id)/num_threads + ub = lb_recv_up(3) + ((ub_recv_up(3) - lb_recv_up(3) + 1)*(my_id + 1))/num_threads - 1 rs%r(lb_recv_up(1):ub_recv_up(1), & lb_recv_up(2):ub_recv_up(2), lb:ub) = & rs%r(lb_recv_up(1):ub_recv_up(1), & - lb_recv_up(2):ub_recv_up(2), lb:ub)+ & + lb_recv_up(2):ub_recv_up(2), lb:ub) + & recv_buf_3d_up(:, :, lb:ub) END IF !$OMP END PARALLEL @@ -1282,22 +1282,22 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) END DO ! This is the real redistribution - ALLOCATE (bounds(0:pw%pw_grid%para%group_size-1, 1:4)) + ALLOCATE (bounds(0:pw%pw_grid%para%group_size - 1, 1:4)) ! work out the pw grid points each proc holds - DO i = 0, pw%pw_grid%para%group_size-1 + DO i = 0, pw%pw_grid%para%group_size - 1 bounds(i, 1:2) = pw%pw_grid%para%bo(1:2, 1, i, 1) bounds(i, 3:4) = pw%pw_grid%para%bo(1:2, 2, i, 1) - bounds(i, 1:2) = bounds(i, 1:2)-pw%pw_grid%npts(1)/2-1 - bounds(i, 3:4) = bounds(i, 3:4)-pw%pw_grid%npts(2)/2-1 + bounds(i, 1:2) = bounds(i, 1:2) - pw%pw_grid%npts(1)/2 - 1 + bounds(i, 3:4) = bounds(i, 3:4) - pw%pw_grid%npts(2)/2 - 1 ENDDO - ALLOCATE (send_tasks(0:pw%pw_grid%para%group_size-1, 1:6)) - ALLOCATE (send_sizes(0:pw%pw_grid%para%group_size-1)) - ALLOCATE (send_disps(0:pw%pw_grid%para%group_size-1)) - ALLOCATE (recv_tasks(0:pw%pw_grid%para%group_size-1, 1:6)) - ALLOCATE (recv_sizes(0:pw%pw_grid%para%group_size-1)) - ALLOCATE (recv_disps(0:pw%pw_grid%para%group_size-1)) + ALLOCATE (send_tasks(0:pw%pw_grid%para%group_size - 1, 1:6)) + ALLOCATE (send_sizes(0:pw%pw_grid%para%group_size - 1)) + ALLOCATE (send_disps(0:pw%pw_grid%para%group_size - 1)) + ALLOCATE (recv_tasks(0:pw%pw_grid%para%group_size - 1, 1:6)) + ALLOCATE (recv_sizes(0:pw%pw_grid%para%group_size - 1)) + ALLOCATE (recv_disps(0:pw%pw_grid%para%group_size - 1)) send_tasks(:, 1) = 1 send_tasks(:, 2) = 0 send_tasks(:, 3) = 1 @@ -1319,14 +1319,14 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) !$OMP PARALLEL DO DEFAULT(NONE), & !$OMP PRIVATE(coords,idir,pos,lb_send,ub_send), & !$OMP SHARED(rs,bounds,my_rs_rank,recv_tasks,recv_sizes) - DO i = 0, rs%desc%group_size-1 + DO i = 0, rs%desc%group_size - 1 coords(:) = rs%desc%rank2coord(:, rs%desc%real2virtual(i)) !calculate the rs grid points on each processor !coords is the part of the grid that rank i actually holds DO idir = 1, 3 pos(:) = get_limit(rs%desc%npts(idir), rs%desc%group_dim(idir), coords(idir)) - pos(:) = pos(:)-rs%desc%npts(idir)/2-1 + pos(:) = pos(:) - rs%desc%npts(idir)/2 - 1 lb_send(idir) = pos(1) ub_send(idir) = pos(2) ENDDO @@ -1342,8 +1342,8 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) recv_tasks(i, 4) = MIN(ub_send(2), bounds(my_rs_rank, 4)) recv_tasks(i, 5) = lb_send(3) recv_tasks(i, 6) = ub_send(3) - recv_sizes(i) = (recv_tasks(i, 2)-recv_tasks(i, 1)+1)* & - (recv_tasks(i, 4)-recv_tasks(i, 3)+1)*(recv_tasks(i, 6)-recv_tasks(i, 5)+1) + recv_sizes(i) = (recv_tasks(i, 2) - recv_tasks(i, 1) + 1)* & + (recv_tasks(i, 4) - recv_tasks(i, 3) + 1)*(recv_tasks(i, 6) - recv_tasks(i, 5) + 1) ENDDO !$OMP END PARALLEL DO @@ -1351,7 +1351,7 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) coords(:) = rs%desc%rank2coord(:, rs%desc%real2virtual(my_rs_rank)) DO idir = 1, 3 pos(:) = get_limit(rs%desc%npts(idir), rs%desc%group_dim(idir), coords(idir)) - pos(:) = pos(:)-rs%desc%npts(idir)/2-1 + pos(:) = pos(:) - rs%desc%npts(idir)/2 - 1 lb_send(idir) = pos(1) ub_send(idir) = pos(2) ENDDO @@ -1360,7 +1360,7 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) ub_recv(:) = ub_send(:) !$OMP PARALLEL DO DEFAULT(NONE), & !$OMP SHARED(pw,lb_send,ub_send,bounds,send_tasks,send_sizes) - DO j = 0, pw%pw_grid%para%group_size-1 + DO j = 0, pw%pw_grid%para%group_size - 1 IF (lb_send(1) .GT. bounds(j, 2)) CYCLE IF (ub_send(1) .LT. bounds(j, 1)) CYCLE @@ -1373,25 +1373,25 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) send_tasks(j, 4) = MIN(ub_send(2), bounds(j, 4)) send_tasks(j, 5) = lb_send(3) send_tasks(j, 6) = ub_send(3) - send_sizes(j) = (send_tasks(j, 2)-send_tasks(j, 1)+1)* & - (send_tasks(j, 4)-send_tasks(j, 3)+1)*(send_tasks(j, 6)-send_tasks(j, 5)+1) + send_sizes(j) = (send_tasks(j, 2) - send_tasks(j, 1) + 1)* & + (send_tasks(j, 4) - send_tasks(j, 3) + 1)*(send_tasks(j, 6) - send_tasks(j, 5) + 1) END DO !$OMP END PARALLEL DO send_disps(0) = 0 recv_disps(0) = 0 - DO i = 1, pw%pw_grid%para%group_size-1 - send_disps(i) = send_disps(i-1)+send_sizes(i-1) - recv_disps(i) = recv_disps(i-1)+recv_sizes(i-1) + DO i = 1, pw%pw_grid%para%group_size - 1 + send_disps(i) = send_disps(i - 1) + send_sizes(i - 1) + recv_disps(i) = recv_disps(i - 1) + recv_sizes(i - 1) ENDDO - CPASSERT(SUM(send_sizes) == PRODUCT(ub_recv-lb_recv+1)) + CPASSERT(SUM(send_sizes) == PRODUCT(ub_recv - lb_recv + 1)) - ALLOCATE (send_bufs(0:rs%desc%group_size-1)) - ALLOCATE (recv_bufs(0:rs%desc%group_size-1)) + ALLOCATE (send_bufs(0:rs%desc%group_size - 1)) + ALLOCATE (recv_bufs(0:rs%desc%group_size - 1)) - DO i = 0, rs%desc%group_size-1 + DO i = 0, rs%desc%group_size - 1 IF (send_sizes(i) .NE. 0) THEN ALLOCATE (send_bufs(i)%array(send_sizes(i))) ELSE @@ -1404,10 +1404,10 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) END IF END DO - ALLOCATE (recv_reqs(0:rs%desc%group_size-1)) + ALLOCATE (recv_reqs(0:rs%desc%group_size - 1)) recv_reqs = mp_request_null - DO i = 0, rs%desc%group_size-1 + DO i = 0, rs%desc%group_size - 1 IF (recv_sizes(i) .NE. 0) THEN CALL mp_irecv(recv_bufs(i)%array, i, rs%desc%group, recv_reqs(i)) END IF @@ -1417,12 +1417,12 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) !$OMP PARALLEL DO DEFAULT(NONE), & !$OMP PRIVATE(k,z,y,x), & !$OMP SHARED(rs,send_tasks,send_bufs,send_disps) - DO i = 0, rs%desc%group_size-1 + DO i = 0, rs%desc%group_size - 1 k = 0 DO z = send_tasks(i, 5), send_tasks(i, 6) DO y = send_tasks(i, 3), send_tasks(i, 4) DO x = send_tasks(i, 1), send_tasks(i, 2) - k = k+1 + k = k + 1 send_bufs(i)%array(k) = rs%r(x, y, z) ENDDO ENDDO @@ -1430,10 +1430,10 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) ENDDO !$OMP END PARALLEL DO - ALLOCATE (send_reqs(0:rs%desc%group_size-1)) + ALLOCATE (send_reqs(0:rs%desc%group_size - 1)) send_reqs = mp_request_null - DO i = 0, rs%desc%group_size-1 + DO i = 0, rs%desc%group_size - 1 IF (send_sizes(i) .NE. 0) THEN CALL mp_isend(send_bufs(i)%array, i, rs%desc%group, send_reqs(i)) END IF @@ -1441,16 +1441,16 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) ! do unpacking ! no OMP here so we can unpack each message as it arrives - DO i = 0, rs%desc%group_size-1 + DO i = 0, rs%desc%group_size - 1 IF (recv_sizes(i) .EQ. 0) CYCLE CALL mp_waitany(recv_reqs, completed) k = 0 - DO z = recv_tasks(completed-1, 5), recv_tasks(completed-1, 6) - DO y = recv_tasks(completed-1, 3), recv_tasks(completed-1, 4) - DO x = recv_tasks(completed-1, 1), recv_tasks(completed-1, 2) - k = k+1 - pw%cr3d(x, y, z) = recv_bufs(completed-1)%array(k) + DO z = recv_tasks(completed - 1, 5), recv_tasks(completed - 1, 6) + DO y = recv_tasks(completed - 1, 3), recv_tasks(completed - 1, 4) + DO x = recv_tasks(completed - 1, 1), recv_tasks(completed - 1, 2) + k = k + 1 + pw%cr3d(x, y, z) = recv_bufs(completed - 1)%array(k) ENDDO ENDDO ENDDO @@ -1461,7 +1461,7 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) DEALLOCATE (recv_reqs) DEALLOCATE (send_reqs) - DO i = 0, rs%desc%group_size-1 + DO i = 0, rs%desc%group_size - 1 IF (ASSOCIATED(send_bufs(i)%array)) THEN DEALLOCATE (send_bufs(i)%array) END IF @@ -1482,9 +1482,9 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) IF (debug_this_module) THEN ! safety check, to be removed once we're absolute sure the routine is correct pw_sum = pw_integrate_function(pw) - IF (ABS(pw_sum-rs_sum)/MAX(1.0_dp, ABS(pw_sum), ABS(rs_sum)) > EPSILON(rs_sum)*1000) THEN + IF (ABS(pw_sum - rs_sum)/MAX(1.0_dp, ABS(pw_sum), ABS(rs_sum)) > EPSILON(rs_sum)*1000) THEN WRITE (error_string, '(A,6(1X,I4.4),3F25.16)') "rs_pw_transfer_distributed", & - rs%desc%npts, rs%desc%group_dim, pw_sum, rs_sum, ABS(pw_sum-rs_sum) + rs%desc%npts, rs%desc%group_dim, pw_sum, rs_sum, ABS(pw_sum - rs_sum) CALL cp_abort(__LOCATION__, & error_string//" Please report this bug ... quick workaround: use "// & "DISTRIBUTION_TYPE REPLICATED") @@ -1499,21 +1499,21 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) ! This is the real redistribution - ALLOCATE (bounds(0:pw%pw_grid%para%group_size-1, 1:4)) + ALLOCATE (bounds(0:pw%pw_grid%para%group_size - 1, 1:4)) - DO i = 0, pw%pw_grid%para%group_size-1 + DO i = 0, pw%pw_grid%para%group_size - 1 bounds(i, 1:2) = pw%pw_grid%para%bo(1:2, 1, i, 1) bounds(i, 3:4) = pw%pw_grid%para%bo(1:2, 2, i, 1) - bounds(i, 1:2) = bounds(i, 1:2)-pw%pw_grid%npts(1)/2-1 - bounds(i, 3:4) = bounds(i, 3:4)-pw%pw_grid%npts(2)/2-1 + bounds(i, 1:2) = bounds(i, 1:2) - pw%pw_grid%npts(1)/2 - 1 + bounds(i, 3:4) = bounds(i, 3:4) - pw%pw_grid%npts(2)/2 - 1 ENDDO - ALLOCATE (send_tasks(0:pw%pw_grid%para%group_size-1, 1:6)) - ALLOCATE (send_sizes(0:pw%pw_grid%para%group_size-1)) - ALLOCATE (send_disps(0:pw%pw_grid%para%group_size-1)) - ALLOCATE (recv_tasks(0:pw%pw_grid%para%group_size-1, 1:6)) - ALLOCATE (recv_sizes(0:pw%pw_grid%para%group_size-1)) - ALLOCATE (recv_disps(0:pw%pw_grid%para%group_size-1)) + ALLOCATE (send_tasks(0:pw%pw_grid%para%group_size - 1, 1:6)) + ALLOCATE (send_sizes(0:pw%pw_grid%para%group_size - 1)) + ALLOCATE (send_disps(0:pw%pw_grid%para%group_size - 1)) + ALLOCATE (recv_tasks(0:pw%pw_grid%para%group_size - 1, 1:6)) + ALLOCATE (recv_sizes(0:pw%pw_grid%para%group_size - 1)) + ALLOCATE (recv_disps(0:pw%pw_grid%para%group_size - 1)) send_tasks = 0 send_tasks(:, 1) = 1 @@ -1547,14 +1547,14 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) !$OMP PARALLEL DO DEFAULT(NONE), & !$OMP PRIVATE(coords,idir,pos,lb_send,ub_send), & !$OMP SHARED(rs,bounds,my_rs_rank,send_tasks,send_sizes,pw) - DO i = 0, pw%pw_grid%para%group_size-1 + DO i = 0, pw%pw_grid%para%group_size - 1 coords(:) = rs%desc%rank2coord(:, rs%desc%real2virtual(i)) !calculate the real rs grid points on each processor !coords is the part of the grid that rank i actually holds DO idir = 1, 3 pos(:) = get_limit(rs%desc%npts(idir), rs%desc%group_dim(idir), coords(idir)) - pos(:) = pos(:)-rs%desc%npts(idir)/2-1 + pos(:) = pos(:) - rs%desc%npts(idir)/2 - 1 lb_send(idir) = pos(1) ub_send(idir) = pos(2) ENDDO @@ -1570,8 +1570,8 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) send_tasks(i, 4) = MIN(ub_send(2), bounds(my_rs_rank, 4)) send_tasks(i, 5) = lb_send(3) send_tasks(i, 6) = ub_send(3) - send_sizes(i) = (send_tasks(i, 2)-send_tasks(i, 1)+1)* & - (send_tasks(i, 4)-send_tasks(i, 3)+1)*(send_tasks(i, 6)-send_tasks(i, 5)+1) + send_sizes(i) = (send_tasks(i, 2) - send_tasks(i, 1) + 1)* & + (send_tasks(i, 4) - send_tasks(i, 3) + 1)*(send_tasks(i, 6) - send_tasks(i, 5) + 1) ENDDO !$OMP END PARALLEL DO @@ -1579,7 +1579,7 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) coords(:) = rs%desc%rank2coord(:, rs%desc%real2virtual(my_rs_rank)) DO idir = 1, 3 pos(:) = get_limit(rs%desc%npts(idir), rs%desc%group_dim(idir), coords(idir)) - pos(:) = pos(:)-rs%desc%npts(idir)/2-1 + pos(:) = pos(:) - rs%desc%npts(idir)/2 - 1 lb_send(idir) = pos(1) ub_send(idir) = pos(2) ENDDO @@ -1589,7 +1589,7 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) !$OMP PARALLEL DO DEFAULT(NONE), & !$OMP SHARED(pw,lb_send,ub_send,bounds,recv_tasks,recv_sizes) - DO j = 0, pw%pw_grid%para%group_size-1 + DO j = 0, pw%pw_grid%para%group_size - 1 IF (ub_send(1) .LT. bounds(j, 1)) CYCLE IF (lb_send(1) .GT. bounds(j, 2)) CYCLE @@ -1602,25 +1602,25 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) recv_tasks(j, 4) = MIN(ub_send(2), bounds(j, 4)) recv_tasks(j, 5) = lb_send(3) recv_tasks(j, 6) = ub_send(3) - recv_sizes(j) = (recv_tasks(j, 2)-recv_tasks(j, 1)+1)* & - (recv_tasks(j, 4)-recv_tasks(j, 3)+1)*(recv_tasks(j, 6)-recv_tasks(j, 5)+1) + recv_sizes(j) = (recv_tasks(j, 2) - recv_tasks(j, 1) + 1)* & + (recv_tasks(j, 4) - recv_tasks(j, 3) + 1)*(recv_tasks(j, 6) - recv_tasks(j, 5) + 1) ENDDO !$OMP END PARALLEL DO send_disps(0) = 0 recv_disps(0) = 0 - DO i = 1, pw%pw_grid%para%group_size-1 - send_disps(i) = send_disps(i-1)+send_sizes(i-1) - recv_disps(i) = recv_disps(i-1)+recv_sizes(i-1) + DO i = 1, pw%pw_grid%para%group_size - 1 + send_disps(i) = send_disps(i - 1) + send_sizes(i - 1) + recv_disps(i) = recv_disps(i - 1) + recv_sizes(i - 1) ENDDO - CPASSERT(SUM(recv_sizes) == PRODUCT(ub_recv-lb_recv+1)) + CPASSERT(SUM(recv_sizes) == PRODUCT(ub_recv - lb_recv + 1)) - ALLOCATE (send_bufs(0:rs%desc%group_size-1)) - ALLOCATE (recv_bufs(0:rs%desc%group_size-1)) + ALLOCATE (send_bufs(0:rs%desc%group_size - 1)) + ALLOCATE (recv_bufs(0:rs%desc%group_size - 1)) - DO i = 0, rs%desc%group_size-1 + DO i = 0, rs%desc%group_size - 1 IF (send_sizes(i) .NE. 0) THEN ALLOCATE (send_bufs(i)%array(send_sizes(i))) ELSE @@ -1633,10 +1633,10 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) END IF END DO - ALLOCATE (recv_reqs(0:rs%desc%group_size-1)) + ALLOCATE (recv_reqs(0:rs%desc%group_size - 1)) recv_reqs = mp_request_null - DO i = 0, rs%desc%group_size-1 + DO i = 0, rs%desc%group_size - 1 IF (recv_sizes(i) .NE. 0) THEN CALL mp_irecv(recv_bufs(i)%array, i, rs%desc%group, recv_reqs(i)) END IF @@ -1646,12 +1646,12 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) !$OMP PARALLEL DO DEFAULT(NONE), & !$OMP PRIVATE(k,z,y,x), & !$OMP SHARED(pw,rs,send_tasks,send_bufs,send_disps) - DO i = 0, rs%desc%group_size-1 + DO i = 0, rs%desc%group_size - 1 k = 0 DO z = send_tasks(i, 5), send_tasks(i, 6) DO y = send_tasks(i, 3), send_tasks(i, 4) DO x = send_tasks(i, 1), send_tasks(i, 2) - k = k+1 + k = k + 1 send_bufs(i)%array(k) = pw%cr3d(x, y, z) ENDDO ENDDO @@ -1659,10 +1659,10 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) ENDDO !$OMP END PARALLEL DO - ALLOCATE (send_reqs(0:rs%desc%group_size-1)) + ALLOCATE (send_reqs(0:rs%desc%group_size - 1)) send_reqs = mp_request_null - DO i = 0, rs%desc%group_size-1 + DO i = 0, rs%desc%group_size - 1 IF (send_sizes(i) .NE. 0) THEN CALL mp_isend(send_bufs(i)%array, i, rs%desc%group, send_reqs(i)) END IF @@ -1671,16 +1671,16 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) ! do unpacking ! no OMP here so we can unpack each message as it arrives - DO i = 0, rs%desc%group_size-1 + DO i = 0, rs%desc%group_size - 1 IF (recv_sizes(i) .EQ. 0) CYCLE CALL mp_waitany(recv_reqs, completed) k = 0 - DO z = recv_tasks(completed-1, 5), recv_tasks(completed-1, 6) - DO y = recv_tasks(completed-1, 3), recv_tasks(completed-1, 4) - DO x = recv_tasks(completed-1, 1), recv_tasks(completed-1, 2) - k = k+1 - rs%r(x, y, z) = recv_bufs(completed-1)%array(k) + DO z = recv_tasks(completed - 1, 5), recv_tasks(completed - 1, 6) + DO y = recv_tasks(completed - 1, 3), recv_tasks(completed - 1, 4) + DO x = recv_tasks(completed - 1, 1), recv_tasks(completed - 1, 2) + k = k + 1 + rs%r(x, y, z) = recv_bufs(completed - 1)%array(k) ENDDO ENDDO ENDDO @@ -1691,7 +1691,7 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) DEALLOCATE (recv_reqs) DEALLOCATE (send_reqs) - DO i = 0, rs%desc%group_size-1 + DO i = 0, rs%desc%group_size - 1 IF (ASSOCIATED(send_bufs(i)%array)) THEN DEALLOCATE (send_bufs(i)%array) END IF @@ -1726,13 +1726,13 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) ! need to take into account the possible varying widths of neighbouring cells ! ushifts and dshifts hold the real size of the neighbouring cells - position = MODULO(rs%desc%virtual_group_coor(idir)-n_shifts, rs%desc%group_dim(idir)) + position = MODULO(rs%desc%virtual_group_coor(idir) - n_shifts, rs%desc%group_dim(idir)) neighbours = get_limit(rs%desc%npts(idir), rs%desc%group_dim(idir), position) - dshifts(n_shifts) = dshifts(n_shifts-1)+(neighbours(2)-neighbours(1)+1) + dshifts(n_shifts) = dshifts(n_shifts - 1) + (neighbours(2) - neighbours(1) + 1) - position = MODULO(rs%desc%virtual_group_coor(idir)+n_shifts, rs%desc%group_dim(idir)) + position = MODULO(rs%desc%virtual_group_coor(idir) + n_shifts, rs%desc%group_dim(idir)) neighbours = get_limit(rs%desc%npts(idir), rs%desc%group_dim(idir), position) - ushifts(n_shifts) = ushifts(n_shifts-1)+(neighbours(2)-neighbours(1)+1) + ushifts(n_shifts) = ushifts(n_shifts - 1) + (neighbours(2) - neighbours(1) + 1) ! The border data has to be send/received from the neighbors ! First we calculate the source and destination processes for the shift @@ -1745,14 +1745,14 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) lb_recv_down(:) = rs%lb_local(:) ub_recv_down(:) = rs%ub_local(:) - IF (dshifts(n_shifts-1) .LE. rs%desc%border) THEN - lb_send_down(idir) = lb_send_down(idir)+rs%desc%border - ub_send_down(idir) = MIN(ub_send_down(idir)-rs%desc%border, & - lb_send_down(idir)+rs%desc%border-1-dshifts(n_shifts-1)) + IF (dshifts(n_shifts - 1) .LE. rs%desc%border) THEN + lb_send_down(idir) = lb_send_down(idir) + rs%desc%border + ub_send_down(idir) = MIN(ub_send_down(idir) - rs%desc%border, & + lb_send_down(idir) + rs%desc%border - 1 - dshifts(n_shifts - 1)) - lb_recv_down(idir) = ub_recv_down(idir)-rs%desc%border+1+ushifts(n_shifts-1) + lb_recv_down(idir) = ub_recv_down(idir) - rs%desc%border + 1 + ushifts(n_shifts - 1) ub_recv_down(idir) = MIN(ub_recv_down(idir), & - ub_recv_down(idir)-rs%desc%border+ushifts(n_shifts)) + ub_recv_down(idir) - rs%desc%border + ushifts(n_shifts)) ELSE lb_send_down(idir) = 0 ub_send_down(idir) = -1 @@ -1770,7 +1770,7 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) ENDDO ! allocate the recv buffer - nn = PRODUCT(ub_recv_down-lb_recv_down+1) + nn = PRODUCT(ub_recv_down - lb_recv_down + 1) ALLOCATE (recv_buf_3d_down(lb_recv_down(1):ub_recv_down(1), & lb_recv_down(2):ub_recv_down(2), lb_recv_down(3):ub_recv_down(3))) @@ -1778,18 +1778,18 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) CALL mp_irecv(recv_buf_3d_down, source_down, rs%desc%group, req(1)) ! now allocate,pack and send the send buffer - nn = PRODUCT(ub_send_down-lb_send_down+1) + nn = PRODUCT(ub_send_down - lb_send_down + 1) ALLOCATE (send_buf_3d_down(lb_send_down(1):ub_send_down(1), & lb_send_down(2):ub_send_down(2), lb_send_down(3):ub_send_down(3))) !$OMP PARALLEL DEFAULT(NONE), & !$OMP PRIVATE(lb,ub,my_id,NUM_THREADS), & !$OMP SHARED(send_buf_3d_down,rs,lb_send_down,ub_send_down) -!$ num_threads = MIN(omp_get_max_threads(), ub_send_down(3)-lb_send_down(3)+1) +!$ num_threads = MIN(omp_get_max_threads(), ub_send_down(3) - lb_send_down(3) + 1) !$ my_id = omp_get_thread_num() IF (my_id < num_threads) THEN - lb = lb_send_down(3)+((ub_send_down(3)-lb_send_down(3)+1)*my_id)/num_threads - ub = lb_send_down(3)+((ub_send_down(3)-lb_send_down(3)+1)*(my_id+1))/num_threads-1 + lb = lb_send_down(3) + ((ub_send_down(3) - lb_send_down(3) + 1)*my_id)/num_threads + ub = lb_send_down(3) + ((ub_send_down(3) - lb_send_down(3) + 1)*(my_id + 1))/num_threads - 1 send_buf_3d_down(lb_send_down(1):ub_send_down(1), lb_send_down(2):ub_send_down(2), & lb:ub) = rs%r(lb_send_down(1):ub_send_down(1), & @@ -1808,14 +1808,14 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) lb_recv_up(:) = rs%lb_local(:) ub_recv_up(:) = rs%ub_local(:) - IF (ushifts(n_shifts-1) .LE. rs%desc%border) THEN - ub_send_up(idir) = ub_send_up(idir)-rs%desc%border - lb_send_up(idir) = MAX(lb_send_up(idir)+rs%desc%border, & - ub_send_up(idir)-rs%desc%border+1+ushifts(n_shifts-1)) + IF (ushifts(n_shifts - 1) .LE. rs%desc%border) THEN + ub_send_up(idir) = ub_send_up(idir) - rs%desc%border + lb_send_up(idir) = MAX(lb_send_up(idir) + rs%desc%border, & + ub_send_up(idir) - rs%desc%border + 1 + ushifts(n_shifts - 1)) - ub_recv_up(idir) = lb_recv_up(idir)+rs%desc%border-1-dshifts(n_shifts-1) + ub_recv_up(idir) = lb_recv_up(idir) + rs%desc%border - 1 - dshifts(n_shifts - 1) lb_recv_up(idir) = MAX(lb_recv_up(idir), & - lb_recv_up(idir)+rs%desc%border-dshifts(n_shifts)) + lb_recv_up(idir) + rs%desc%border - dshifts(n_shifts)) ELSE lb_send_up(idir) = 0 ub_send_up(idir) = -1 @@ -1833,7 +1833,7 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) ENDDO ! allocate the recv buffer - nn = PRODUCT(ub_recv_up-lb_recv_up+1) + nn = PRODUCT(ub_recv_up - lb_recv_up + 1) ALLOCATE (recv_buf_3d_up(lb_recv_up(1):ub_recv_up(1), & lb_recv_up(2):ub_recv_up(2), lb_recv_up(3):ub_recv_up(3))) @@ -1842,18 +1842,18 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) CALL mp_irecv(recv_buf_3d_up, source_up, rs%desc%group, req(2)) ! now allocate,pack and send the send buffer - nn = PRODUCT(ub_send_up-lb_send_up+1) + nn = PRODUCT(ub_send_up - lb_send_up + 1) ALLOCATE (send_buf_3d_up(lb_send_up(1):ub_send_up(1), & lb_send_up(2):ub_send_up(2), lb_send_up(3):ub_send_up(3))) !$OMP PARALLEL DEFAULT(NONE), & !$OMP PRIVATE(lb,ub,my_id,NUM_THREADS), & !$OMP SHARED(send_buf_3d_up,rs,lb_send_up,ub_send_up) -!$ num_threads = MIN(omp_get_max_threads(), ub_send_up(3)-lb_send_up(3)+1) +!$ num_threads = MIN(omp_get_max_threads(), ub_send_up(3) - lb_send_up(3) + 1) !$ my_id = omp_get_thread_num() IF (my_id < num_threads) THEN - lb = lb_send_up(3)+((ub_send_up(3)-lb_send_up(3)+1)*my_id)/num_threads - ub = lb_send_up(3)+((ub_send_up(3)-lb_send_up(3)+1)*(my_id+1))/num_threads-1 + lb = lb_send_up(3) + ((ub_send_up(3) - lb_send_up(3) + 1)*my_id)/num_threads + ub = lb_send_up(3) + ((ub_send_up(3) - lb_send_up(3) + 1)*(my_id + 1))/num_threads - 1 send_buf_3d_up(lb_send_up(1):ub_send_up(1), lb_send_up(2):ub_send_up(2), & lb:ub) = rs%r(lb_send_up(1):ub_send_up(1), & @@ -1878,11 +1878,11 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) !$OMP PARALLEL DEFAULT(NONE), & !$OMP PRIVATE(lb,ub,my_id,NUM_THREADS), & !$OMP SHARED(recv_buf_3d_down,rs,lb_recv_down,ub_recv_down) -!$ num_threads = MIN(omp_get_max_threads(), ub_recv_down(3)-lb_recv_down(3)+1) +!$ num_threads = MIN(omp_get_max_threads(), ub_recv_down(3) - lb_recv_down(3) + 1) !$ my_id = omp_get_thread_num() IF (my_id < num_threads) THEN - lb = lb_recv_down(3)+((ub_recv_down(3)-lb_recv_down(3)+1)*my_id)/num_threads - ub = lb_recv_down(3)+((ub_recv_down(3)-lb_recv_down(3)+1)*(my_id+1))/num_threads-1 + lb = lb_recv_down(3) + ((ub_recv_down(3) - lb_recv_down(3) + 1)*my_id)/num_threads + ub = lb_recv_down(3) + ((ub_recv_down(3) - lb_recv_down(3) + 1)*(my_id + 1))/num_threads - 1 rs%r(lb_recv_down(1):ub_recv_down(1), lb_recv_down(2):ub_recv_down(2), & lb:ub) = recv_buf_3d_down(:, :, lb:ub) @@ -1900,11 +1900,11 @@ SUBROUTINE rs_pw_transfer_distributed(rs, pw, dir) !$OMP PARALLEL DEFAULT(NONE), & !$OMP PRIVATE(lb,ub,my_id,NUM_THREADS), & !$OMP SHARED(recv_buf_3d_up,rs,lb_recv_up,ub_recv_up) -!$ num_threads = MIN(omp_get_max_threads(), ub_recv_up(3)-lb_recv_up(3)+1) +!$ num_threads = MIN(omp_get_max_threads(), ub_recv_up(3) - lb_recv_up(3) + 1) !$ my_id = omp_get_thread_num() IF (my_id < num_threads) THEN - lb = lb_recv_up(3)+((ub_recv_up(3)-lb_recv_up(3)+1)*my_id)/num_threads - ub = lb_recv_up(3)+((ub_recv_up(3)-lb_recv_up(3)+1)*(my_id+1))/num_threads-1 + lb = lb_recv_up(3) + ((ub_recv_up(3) - lb_recv_up(3) + 1)*my_id)/num_threads + ub = lb_recv_up(3) + ((ub_recv_up(3) - lb_recv_up(3) + 1)*(my_id + 1))/num_threads - 1 rs%r(lb_recv_up(1):ub_recv_up(1), lb_recv_up(2):ub_recv_up(2), & lb:ub) = recv_buf_3d_up(:, :, lb:ub) @@ -1998,7 +1998,7 @@ SUBROUTINE rs_grid_mult_and_add(rs1, rs2, rs3, scalar) DO k = l(3), u(3) DO j = l(2), u(2) DO i = l(1), u(1) - rs1%r(i, j, k) = rs1%r(i, j, k)+scalar*rs2%r(i, j, k)*rs3%r(i, j, k) + rs1%r(i, j, k) = rs1%r(i, j, k) + scalar*rs2%r(i, j, k)*rs3%r(i, j, k) ENDDO ENDDO ENDDO @@ -2046,7 +2046,7 @@ SUBROUTINE rs_grid_retain(rs_grid) CPASSERT(ASSOCIATED(rs_grid)) CPASSERT(rs_grid%ref_count > 0) - rs_grid%ref_count = rs_grid%ref_count+1 + rs_grid%ref_count = rs_grid%ref_count + 1 END SUBROUTINE rs_grid_retain ! ************************************************************************************************** @@ -2064,7 +2064,7 @@ SUBROUTINE rs_grid_retain_descriptor(rs_desc) CPASSERT(ASSOCIATED(rs_desc)) CPASSERT(rs_desc%ref_count > 0) - rs_desc%ref_count = rs_desc%ref_count+1 + rs_desc%ref_count = rs_desc%ref_count + 1 END SUBROUTINE rs_grid_retain_descriptor ! ************************************************************************************************** @@ -2082,12 +2082,12 @@ SUBROUTINE rs_grid_release(rs_grid) IF (ASSOCIATED(rs_grid)) THEN CPASSERT(rs_grid%ref_count > 0) - rs_grid%ref_count = rs_grid%ref_count-1 + rs_grid%ref_count = rs_grid%ref_count - 1 IF (rs_grid%ref_count == 0) THEN CALL rs_grid_release_descriptor(rs_grid%desc) - allocated_rs_grid_count = allocated_rs_grid_count-1 + allocated_rs_grid_count = allocated_rs_grid_count - 1 DEALLOCATE (rs_grid%r) DEALLOCATE (rs_grid%px) DEALLOCATE (rs_grid%py) @@ -2112,7 +2112,7 @@ SUBROUTINE rs_grid_release_descriptor(rs_desc) IF (ASSOCIATED(rs_desc)) THEN CPASSERT(rs_desc%ref_count > 0) - rs_desc%ref_count = rs_desc%ref_count-1 + rs_desc%ref_count = rs_desc%ref_count - 1 IF (rs_desc%ref_count == 0) THEN CALL pw_grid_release(rs_desc%pw) @@ -2163,10 +2163,10 @@ SUBROUTINE cart_shift(rs_grid, dir, disp, source, dest) INTEGER, DIMENSION(3) :: shift_coords shift_coords = rs_grid%desc%virtual_group_coor - shift_coords(dir) = MODULO(shift_coords(dir)+disp, rs_grid%desc%group_dim(dir)) + shift_coords(dir) = MODULO(shift_coords(dir) + disp, rs_grid%desc%group_dim(dir)) dest = rs_grid%desc%virtual2real(rs_grid%desc%coord2rank(shift_coords(1), shift_coords(2), shift_coords(3))) shift_coords = rs_grid%desc%virtual_group_coor - shift_coords(dir) = MODULO(shift_coords(dir)-disp, rs_grid%desc%group_dim(dir)) + shift_coords(dir) = MODULO(shift_coords(dir) - disp, rs_grid%desc%group_dim(dir)) source = rs_grid%desc%virtual2real(rs_grid%desc%coord2rank(shift_coords(1), shift_coords(2), shift_coords(3))) END SUBROUTINE @@ -2197,13 +2197,13 @@ FUNCTION rs_grid_max_ngpts(desc) RESULT(max_ngpts) CPASSERT(PRODUCT(INT(desc%npts, KIND=int_8)) < HUGE(1)) max_ngpts = PRODUCT(desc%npts) ELSE - DO i = 0, desc%group_size-1 + DO i = 0, desc%group_size - 1 lb = desc%lb_global(:, i) ub = desc%ub_global(:, i) - lb = lb-desc%border*(1-desc%perd) - ub = ub+desc%border*(1-desc%perd) - CPASSERT(PRODUCT(INT(ub-lb+1, KIND=int_8)) < HUGE(1)) - max_ngpts = MAX(max_ngpts, PRODUCT(ub-lb+1)) + lb = lb - desc%border*(1 - desc%perd) + ub = ub + desc%border*(1 - desc%perd) + CPASSERT(PRODUCT(INT(ub - lb + 1, KIND=int_8)) < HUGE(1)) + max_ngpts = MAX(max_ngpts, PRODUCT(ub - lb + 1)) END DO END IF diff --git a/src/pw/rs_methods.F b/src/pw/rs_methods.F index 7a6cacf1c7..e305e072e3 100644 --- a/src/pw/rs_methods.F +++ b/src/pw/rs_methods.F @@ -98,9 +98,9 @@ SUBROUTINE derive_fdm_cd3(f, df, rs_grid) DO k = lb(3), ub(3) DO j = lb(2), ub(2) DO i = lb(1), ub(1) - drdx(i, j, k) = (r(i+1, j, k)-r(i-1, j, k))/h(1) - drdy(i, j, k) = (r(i, j+1, k)-r(i, j-1, k))/h(2) - drdz(i, j, k) = (r(i, j, k+1)-r(i, j, k-1))/h(3) + drdx(i, j, k) = (r(i + 1, j, k) - r(i - 1, j, k))/h(1) + drdy(i, j, k) = (r(i, j + 1, k) - r(i, j - 1, k))/h(2) + drdz(i, j, k) = (r(i, j, k + 1) - r(i, j, k - 1))/h(3) END DO END DO END DO @@ -169,9 +169,9 @@ SUBROUTINE derive_fdm_cd5(f, df, rs_grid) DO k = lb(3), ub(3) DO j = lb(2), ub(2) DO i = lb(1), ub(1) - drdx(i, j, k) = (r(i-2, j, k)-r(i+2, j, k)+8.0_dp*(r(i+1, j, k)-r(i-1, j, k)))/h(1) - drdy(i, j, k) = (r(i, j-2, k)-r(i, j+2, k)+8.0_dp*(r(i, j+1, k)-r(i, j-1, k)))/h(2) - drdz(i, j, k) = (r(i, j, k-2)-r(i, j, k+2)+8.0_dp*(r(i, j, k+1)-r(i, j, k-1)))/h(3) + drdx(i, j, k) = (r(i - 2, j, k) - r(i + 2, j, k) + 8.0_dp*(r(i + 1, j, k) - r(i - 1, j, k)))/h(1) + drdy(i, j, k) = (r(i, j - 2, k) - r(i, j + 2, k) + 8.0_dp*(r(i, j + 1, k) - r(i, j - 1, k)))/h(2) + drdz(i, j, k) = (r(i, j, k - 2) - r(i, j, k + 2) + 8.0_dp*(r(i, j, k + 1) - r(i, j, k - 1)))/h(3) END DO END DO END DO @@ -240,12 +240,12 @@ SUBROUTINE derive_fdm_cd7(f, df, rs_grid) DO k = lb(3), ub(3) DO j = lb(2), ub(2) DO i = lb(1), ub(1) - drdx(i, j, k) = (r(i+3, j, k)-r(i-3, j, k)+9.0_dp*(r(i-2, j, k)-r(i+2, j, k))+ & - 45.0_dp*(r(i+1, j, k)-r(i-1, j, k)))/h(1) - drdy(i, j, k) = (r(i, j+3, k)-r(i, j-3, k)+9.0_dp*(r(i, j-2, k)-r(i, j+2, k))+ & - 45.0_dp*(r(i, j+1, k)-r(i, j-1, k)))/h(2) - drdz(i, j, k) = (r(i, j, k+3)-r(i, j, k-3)+9.0_dp*(r(i, j, k-2)-r(i, j, k+2))+ & - 45.0_dp*(r(i, j, k+1)-r(i, j, k-1)))/h(3) + drdx(i, j, k) = (r(i + 3, j, k) - r(i - 3, j, k) + 9.0_dp*(r(i - 2, j, k) - r(i + 2, j, k)) + & + 45.0_dp*(r(i + 1, j, k) - r(i - 1, j, k)))/h(1) + drdy(i, j, k) = (r(i, j + 3, k) - r(i, j - 3, k) + 9.0_dp*(r(i, j - 2, k) - r(i, j + 2, k)) + & + 45.0_dp*(r(i, j + 1, k) - r(i, j - 1, k)))/h(2) + drdz(i, j, k) = (r(i, j, k + 3) - r(i, j, k - 3) + 9.0_dp*(r(i, j, k - 2) - r(i, j, k + 2)) + & + 45.0_dp*(r(i, j, k + 1) - r(i, j, k - 1)))/h(3) END DO END DO END DO @@ -313,12 +313,12 @@ SUBROUTINE setup_grid_axes(pw_grid, x_glbl, y_glbl, z_glbl, x_locl, y_locl, z_lo ALLOCATE (x_locl(lb1:ub1), y_locl(lb2:ub2), z_locl(lb3:ub3)) ALLOCATE (x_glbl(glb1:gub1), y_glbl(glb2:gub2), z_glbl(glb3:gub3)) - gindx(:) = (/(i, i=0, npts(1)-1)/) - gindy(:) = (/(i, i=0, npts(2)-1)/) - gindz(:) = (/(i, i=0, npts(3)-1)/) - lindx(:) = (/(i, i=0, npts_local(1)-1)/) - lindy(:) = (/(i, i=0, npts_local(2)-1)/) - lindz(:) = (/(i, i=0, npts_local(3)-1)/) + gindx(:) = (/(i, i=0, npts(1) - 1)/) + gindy(:) = (/(i, i=0, npts(2) - 1)/) + gindz(:) = (/(i, i=0, npts(3) - 1)/) + lindx(:) = (/(i, i=0, npts_local(1) - 1)/) + lindy(:) = (/(i, i=0, npts_local(2) - 1)/) + lindz(:) = (/(i, i=0, npts_local(3) - 1)/) x_glbl(:) = gindx*dr(1) y_glbl(:) = gindy*dr(2) @@ -328,17 +328,17 @@ SUBROUTINE setup_grid_axes(pw_grid, x_glbl, y_glbl, z_glbl, x_locl, y_locl, z_lo IF (lb1 .EQ. ub1) THEN lindx(:) = lb1 ELSE - lindx(:) = lindx(:)*((ub1-lb1)/(npts_local(1)-1))+lb1 + lindx(:) = lindx(:)*((ub1 - lb1)/(npts_local(1) - 1)) + lb1 END IF IF (lb2 .EQ. ub2) THEN lindy(:) = lb2 ELSE - lindy(:) = lindy(:)*((ub2-lb2)/(npts_local(2)-1))+lb2 + lindy(:) = lindy(:)*((ub2 - lb2)/(npts_local(2) - 1)) + lb2 END IF IF (lb3 .EQ. ub3) THEN lindz(:) = lb3 ELSE - lindz(:) = lindz(:)*((ub3-lb3)/(npts_local(3)-1))+lb3 + lindz(:) = lindz(:)*((ub3 - lb3)/(npts_local(3) - 1)) + lb3 END IF x_locl(:) = x_glbl(lindx) @@ -415,22 +415,22 @@ SUBROUTINE pw_mollifier(pw_pool, zeta, x_glbl, y_glbl, z_glbl, pw_in, pw_out) DO j = lb2, ub2 DO i = lb1, ub1 xi = x_glbl(i); yj = y_glbl(j); zk = z_glbl(k) - IF (vec_norm2((/(xi-xmin), (yj-ymin), (zk-zmin)/)) .LT. zeta-small_value) THEN - G%cr3d(i, j, k) = EXP(1.0_dp/(vec_norm2((/(xi-xmin), (yj-ymin), (zk-zmin)/)/zeta)**2-1)) - ELSE IF (vec_norm2((/(xi-xmax), (yj-ymax), (zk-zmax)/)) .LT. zeta-small_value) THEN - G%cr3d(i, j, k) = EXP(1.0_dp/(vec_norm2((/(xi-xmax), (yj-ymax), (zk-zmax)/)/zeta)**2-1)) - ELSE IF (vec_norm2((/(xi-xmin), (yj-ymax), (zk-zmax)/)) .LT. zeta-small_value) THEN - G%cr3d(i, j, k) = EXP(1.0_dp/(vec_norm2((/(xi-xmin), (yj-ymax), (zk-zmax)/)/zeta)**2-1)) - ELSE IF (vec_norm2((/(xi-xmax), (yj-ymin), (zk-zmax)/)) .LT. zeta-small_value) THEN - G%cr3d(i, j, k) = EXP(1.0_dp/(vec_norm2((/(xi-xmax), (yj-ymin), (zk-zmax)/)/zeta)**2-1)) - ELSE IF (vec_norm2((/(xi-xmax), (yj-ymax), (zk-zmin)/)) .LT. zeta-small_value) THEN - G%cr3d(i, j, k) = EXP(1.0_dp/(vec_norm2((/(xi-xmax), (yj-ymax), (zk-zmin)/)/zeta)**2-1)) - ELSE IF (vec_norm2((/(xi-xmin), (yj-ymin), (zk-zmax)/)) .LT. zeta-small_value) THEN - G%cr3d(i, j, k) = EXP(1.0_dp/(vec_norm2((/(xi-xmin), (yj-ymin), (zk-zmax)/)/zeta)**2-1)) - ELSE IF (vec_norm2((/(xi-xmin), (yj-ymax), (zk-zmin)/)) .LT. zeta-small_value) THEN - G%cr3d(i, j, k) = EXP(1.0_dp/(vec_norm2((/(xi-xmin), (yj-ymax), (zk-zmin)/)/zeta)**2-1)) - ELSE IF (vec_norm2((/(xi-xmax), (yj-ymin), (zk-zmin)/)) .LT. zeta-small_value) THEN - G%cr3d(i, j, k) = EXP(1.0_dp/(vec_norm2((/(xi-xmax), (yj-ymin), (zk-zmin)/)/zeta)**2-1)) + IF (vec_norm2((/(xi - xmin), (yj - ymin), (zk - zmin)/)) .LT. zeta - small_value) THEN + G%cr3d(i, j, k) = EXP(1.0_dp/(vec_norm2((/(xi - xmin), (yj - ymin), (zk - zmin)/)/zeta)**2 - 1)) + ELSE IF (vec_norm2((/(xi - xmax), (yj - ymax), (zk - zmax)/)) .LT. zeta - small_value) THEN + G%cr3d(i, j, k) = EXP(1.0_dp/(vec_norm2((/(xi - xmax), (yj - ymax), (zk - zmax)/)/zeta)**2 - 1)) + ELSE IF (vec_norm2((/(xi - xmin), (yj - ymax), (zk - zmax)/)) .LT. zeta - small_value) THEN + G%cr3d(i, j, k) = EXP(1.0_dp/(vec_norm2((/(xi - xmin), (yj - ymax), (zk - zmax)/)/zeta)**2 - 1)) + ELSE IF (vec_norm2((/(xi - xmax), (yj - ymin), (zk - zmax)/)) .LT. zeta - small_value) THEN + G%cr3d(i, j, k) = EXP(1.0_dp/(vec_norm2((/(xi - xmax), (yj - ymin), (zk - zmax)/)/zeta)**2 - 1)) + ELSE IF (vec_norm2((/(xi - xmax), (yj - ymax), (zk - zmin)/)) .LT. zeta - small_value) THEN + G%cr3d(i, j, k) = EXP(1.0_dp/(vec_norm2((/(xi - xmax), (yj - ymax), (zk - zmin)/)/zeta)**2 - 1)) + ELSE IF (vec_norm2((/(xi - xmin), (yj - ymin), (zk - zmax)/)) .LT. zeta - small_value) THEN + G%cr3d(i, j, k) = EXP(1.0_dp/(vec_norm2((/(xi - xmin), (yj - ymin), (zk - zmax)/)/zeta)**2 - 1)) + ELSE IF (vec_norm2((/(xi - xmin), (yj - ymax), (zk - zmin)/)) .LT. zeta - small_value) THEN + G%cr3d(i, j, k) = EXP(1.0_dp/(vec_norm2((/(xi - xmin), (yj - ymax), (zk - zmin)/)/zeta)**2 - 1)) + ELSE IF (vec_norm2((/(xi - xmax), (yj - ymin), (zk - zmin)/)) .LT. zeta - small_value) THEN + G%cr3d(i, j, k) = EXP(1.0_dp/(vec_norm2((/(xi - xmax), (yj - ymin), (zk - zmin)/)/zeta)**2 - 1)) END IF END DO END DO diff --git a/src/pw_env/cp_spline_utils.F b/src/pw_env/cp_spline_utils.F index 08a208cb86..3c829e4180 100644 --- a/src/pw_env/cp_spline_utils.F +++ b/src/pw_env/cp_spline_utils.F @@ -68,7 +68,7 @@ SUBROUTINE pw_restrict_s3(pw_fine_in, pw_coarse_out, coarse_pool, param_section) TYPE(pw_spline_precond_type), POINTER :: precond TYPE(pw_type), POINTER :: coeffs, values - ifile = ifile+1 + ifile = ifile + 1 CALL timeset(routineN, handle) CALL section_vals_val_get(param_section, "safe_computation", & l_val=safe_computation) @@ -167,7 +167,7 @@ SUBROUTINE pw_prolongate_s3(pw_coarse_in, pw_fine_out, coarse_pool, & TYPE(pw_spline_precond_type), POINTER :: precond TYPE(pw_type), POINTER :: coeffs - ifile = ifile+1 + ifile = ifile + 1 CALL timeset(routineN, handle) NULLIFY (coeffs) CALL pw_pool_create_pw(coarse_pool, coeffs, use_data=REALDATA3D, & diff --git a/src/pw_env/gaussian_gridlevels.F b/src/pw_env/gaussian_gridlevels.F index 03b5434549..dea87b1e2b 100644 --- a/src/pw_env/gaussian_gridlevels.F +++ b/src/pw_env/gaussian_gridlevels.F @@ -149,12 +149,12 @@ FUNCTION gaussian_gridlevel(gridlevel_info, exponent) RESULT(gridlevel) gridlevel = 1 needed_cutoff = ABS(exponent)*gridlevel_info%rel_cutoff DO i = 1, gridlevel_info%ngrid_levels - IF ((gridlevel_info%cutoff(i)+1E-6_dp) .GE. needed_cutoff) THEN + IF ((gridlevel_info%cutoff(i) + 1E-6_dp) .GE. needed_cutoff) THEN gridlevel = i ENDIF ENDDO - gridlevel_info%total_count = gridlevel_info%total_count+1 - gridlevel_info%count(gridlevel) = gridlevel_info%count(gridlevel)+1 + gridlevel_info%total_count = gridlevel_info%total_count + 1 + gridlevel_info%count(gridlevel) = gridlevel_info%count(gridlevel) + 1 END FUNCTION gaussian_gridlevel diff --git a/src/pw_env/pw_env_types.F b/src/pw_env/pw_env_types.F index f76e839337..3a769c97b7 100644 --- a/src/pw_env/pw_env_types.F +++ b/src/pw_env/pw_env_types.F @@ -174,7 +174,7 @@ SUBROUTINE pw_env_retain(pw_env) CPASSERT(ASSOCIATED(pw_env)) CPASSERT(pw_env%ref_count > 0) - pw_env%ref_count = pw_env%ref_count+1 + pw_env%ref_count = pw_env%ref_count + 1 END SUBROUTINE pw_env_retain ! ************************************************************************************************** @@ -198,7 +198,7 @@ SUBROUTINE pw_env_release(pw_env, kg) IF (PRESENT(kg)) my_kg = kg IF (ASSOCIATED(pw_env)) THEN CPASSERT(pw_env%ref_count > 0) - pw_env%ref_count = pw_env%ref_count-1 + pw_env%ref_count = pw_env%ref_count - 1 IF (pw_env%ref_count < 1) THEN CALL pw_poisson_release(pw_env%poisson_env) CALL pw_pools_dealloc(pw_env%pw_pools) diff --git a/src/pw_env/rs_pw_interface.F b/src/pw_env/rs_pw_interface.F index b8992779eb..454997ead0 100644 --- a/src/pw_env/rs_pw_interface.F +++ b/src/pw_env/rs_pw_interface.F @@ -124,7 +124,7 @@ SUBROUTINE density_rs2pw(pw_env, rs_rho, rho, rho_gspace) CASE (spline3_pbc_interp) DO igrid_level = gridlevel_info%ngrid_levels, 2, -1 CALL pw_prolongate_s3(mgrid_rspace(igrid_level)%pw, & - mgrid_rspace(igrid_level-1)%pw, pw_pools(igrid_level)%pool, & + mgrid_rspace(igrid_level - 1)%pw, pw_pools(igrid_level)%pool, & pw_env%interp_section) END DO CALL pw_copy(mgrid_rspace(1)%pw, rho%pw) @@ -211,7 +211,7 @@ SUBROUTINE density_rs2pw_basic(pw_env, rs_rho, rho, rho_gspace) CASE (spline3_pbc_interp) DO igrid_level = gridlevel_info%ngrid_levels, 2, -1 CALL pw_prolongate_s3(mgrid_rspace(igrid_level)%pw, & - mgrid_rspace(igrid_level-1)%pw, pw_pools(igrid_level)%pool, & + mgrid_rspace(igrid_level - 1)%pw, pw_pools(igrid_level)%pool, & pw_env%interp_section) END DO CALL pw_copy(mgrid_rspace(1)%pw, rho%pw) @@ -299,14 +299,14 @@ SUBROUTINE potential_pw2rs(rs_v, v_rspace, pw_env) CALL pw_pools_give_back_pws(pw_pools, mgrid_gspace) CASE (spline3_pbc_interp) CALL pw_copy(v_rspace%pw, mgrid_rspace(1)%pw) - DO igrid_level = 1, gridlevel_info%ngrid_levels-1 - CALL pw_zero(mgrid_rspace(igrid_level+1)%pw) + DO igrid_level = 1, gridlevel_info%ngrid_levels - 1 + CALL pw_zero(mgrid_rspace(igrid_level + 1)%pw) CALL pw_restrict_s3(mgrid_rspace(igrid_level)%pw, & - mgrid_rspace(igrid_level+1)%pw, pw_pools(igrid_level+1)%pool, & + mgrid_rspace(igrid_level + 1)%pw, pw_pools(igrid_level + 1)%pool, & pw_env%interp_section) ! *** Multiply by the grid volume element ratio - mgrid_rspace(igrid_level+1)%pw%cr3d = & - mgrid_rspace(igrid_level+1)%pw%cr3d*8._dp + mgrid_rspace(igrid_level + 1)%pw%cr3d = & + mgrid_rspace(igrid_level + 1)%pw%cr3d*8._dp END DO CASE default CALL cp_abort(__LOCATION__, & diff --git a/src/pw_env_methods.F b/src/pw_env_methods.F index 576065c103..2893921f38 100644 --- a/src/pw_env_methods.F +++ b/src/pw_env_methods.F @@ -574,7 +574,7 @@ SUBROUTINE pw_env_rebuild(pw_env, qs_env, external_para_env) rs_grid_section => section_vals_get_subs_vals(input, "DFT%MGRID%RS_GRID") - CALL init_input_type(input_settings, nsmax=2*MAX(1, return_cube_max_iradius(pw_env%cube_info(igrid_level)))+1, & + CALL init_input_type(input_settings, nsmax=2*MAX(1, return_cube_max_iradius(pw_env%cube_info(igrid_level))) + 1, & rs_grid_section=rs_grid_section, ilevel=igrid_level, & higher_grid_layout=higher_grid_layout) @@ -878,18 +878,18 @@ SUBROUTINE compute_max_radius(radius, pw_env, qs_env) DO jset = 1, nsetb DO jpgf = 1, npgfb(jset) DO jshell = 1, nshellb(jset) - zetp = zeta(ipgf, iset)+zetb(jpgf, jset) - lb = lshellb(jshell, jset)+la + zetp = zeta(ipgf, iset) + zetb(jpgf, jset) + lb = lshellb(jshell, jset) + la lgrid_level = gaussian_gridlevel(pw_env%gridlevel_info, zetp) IF (lgrid_level .EQ. igrid_level) THEN ! density (scale is at most 2) maxradius = MAX(maxradius, exp_radius(lb, zetp, eps_rho, 2.0_dp)) ! tau, properties? - maxradius = MAX(maxradius, exp_radius(lb+1, zetp, eps_rho, 2.0_dp)) + maxradius = MAX(maxradius, exp_radius(lb + 1, zetp, eps_rho, 2.0_dp)) ! potential maxradius = MAX(maxradius, exp_radius(lb, zetp, eps_gvg, 2.0_dp)) ! forces - maxradius = MAX(maxradius, exp_radius(lb+1, zetp, eps_gvg, 2.0_dp)) + maxradius = MAX(maxradius, exp_radius(lb + 1, zetp, eps_gvg, 2.0_dp)) ENDIF END DO END DO @@ -1045,7 +1045,7 @@ SUBROUTINE setup_diel_rs_grid(diel_rs_grid, method, input, pw_grid) CASE (derivative_cd7) border_points = 3 END SELECT - CALL init_input_type(input_settings, 2*border_points+1, rs_grid_section, & + CALL init_input_type(input_settings, 2*border_points + 1, rs_grid_section, & 1, (/-1, -1, -1/)) CALL rs_grid_create_descriptor(rs_desc, pw_grid, input_settings, & border_points=border_points) diff --git a/src/pwdft_environment_types.F b/src/pwdft_environment_types.F index db3b6b08e4..cb31f30a1f 100644 --- a/src/pwdft_environment_types.F +++ b/src/pwdft_environment_types.F @@ -106,7 +106,7 @@ SUBROUTINE pwdft_env_retain(pwdft_env) CPASSERT(ASSOCIATED(pwdft_env)) CPASSERT(pwdft_env%ref_count > 0) - pwdft_env%ref_count = pwdft_env%ref_count+1 + pwdft_env%ref_count = pwdft_env%ref_count + 1 END SUBROUTINE pwdft_env_retain ! ************************************************************************************************** @@ -127,7 +127,7 @@ SUBROUTINE pwdft_env_release(pwdft_env) IF (ASSOCIATED(pwdft_env)) THEN CPASSERT(pwdft_env%ref_count > 0) - pwdft_env%ref_count = pwdft_env%ref_count-1 + pwdft_env%ref_count = pwdft_env%ref_count - 1 IF (pwdft_env%ref_count < 1) THEN ! IF (ASSOCIATED(pwdft_env%qs_subsys)) THEN @@ -327,7 +327,7 @@ SUBROUTINE pwdft_env_create(pwdft_env) ALLOCATE (pwdft_env) pwdft_env%ref_count = 1 - last_pwdft_id = last_pwdft_id+1 + last_pwdft_id = last_pwdft_id + 1 pwdft_env%id_nr = last_pwdft_id CALL pwdft_env_clear(pwdft_env) diff --git a/src/qmmm_create.F b/src/qmmm_create.F index bf5177f2f8..3db8fdd87c 100644 --- a/src/qmmm_create.F +++ b/src/qmmm_create.F @@ -282,7 +282,7 @@ SUBROUTINE qmmm_env_create(qmmm_env, root_section, para_env, globenv, & CALL get_cell(mm_cell, abc=abc_mm) IF (qmmm_env_qm%image_charge) THEN - IF (ANY(ABS(abc_mm-abc_qm) > 1.0E-12)) & + IF (ANY(ABS(abc_mm - abc_qm) > 1.0E-12)) & CPABORT("QM and MM box need to have the same size when using image charges") ENDIF @@ -338,7 +338,7 @@ SUBROUTINE qmmm_env_create(qmmm_env, root_section, para_env, globenv, & CALL section_vals_val_get(qmmm_section, "DELTA_CHARGE", i_val=delta_charge) CALL section_vals_val_get(force_env_section, "DFT%CHARGE", i_val=orig_charge) - CALL section_vals_val_set(force_env_section, "DFT%CHARGE", i_val=orig_charge+delta_charge) + CALL section_vals_val_set(force_env_section, "DFT%CHARGE", i_val=orig_charge + delta_charge) CALL section_vals_val_set(force_env_section, "METHOD", i_val=do_qs) CALL create_small_subsys(subsys_qm, & diff --git a/src/qmmm_elpot.F b/src/qmmm_elpot.F index fe687b6367..07ac3191e2 100644 --- a/src/qmmm_elpot.F +++ b/src/qmmm_elpot.F @@ -85,10 +85,10 @@ SUBROUTINE qmmm_potential_init(qmmm_coupl_type, mm_el_pot_radius, potentials, & logger => cp_get_default_logger() output_unit = cp_logger_get_default_io_unit(logger) Rmin = 0.0_dp - Rmax = SQRT(mm_cell%hmat(1, 1)**2+ & - mm_cell%hmat(2, 2)**2+ & + Rmax = SQRT(mm_cell%hmat(1, 1)**2 + & + mm_cell%hmat(2, 2)**2 + & mm_cell%hmat(3, 3)**2) - np = CEILING(rmax/dx)+1 + np = CEILING(rmax/dx) + 1 ! ! Preprocessing ! @@ -108,7 +108,7 @@ SUBROUTINE qmmm_potential_init(qmmm_coupl_type, mm_el_pot_radius, potentials, & END DO Loop_on_found_values IF (.NOT. Found) THEN Ndim = SIZE(radius) - Ndim = Ndim+1 + Ndim = Ndim + 1 CALL REALLOCATE(radius, 1, Ndim) radius(Ndim) = mm_el_pot_radius(i) END IF @@ -140,10 +140,10 @@ SUBROUTINE qmmm_potential_init(qmmm_coupl_type, mm_el_pot_radius, potentials, & pot0_2(2, 1) = 0.0_dp x = 0.0_dp DO i = 2, np - x = x+dx + x = x + dx pot0_2(1, i) = erf(x/rc)/x t = 2._dp/(rootpi*x*rc)*EXP(-(x/rc)**2) - pot0_2(2, i) = (t-pot0_2(1, i)/x)*dx + pot0_2(2, i) = (t - pot0_2(1, i)/x)*dx END DO ELSEIF (qmmm_coupl_type == do_qmmm_swave) THEN ! S-wave expansion :: 1/x - exp(-2*x/rc) * ( 1/x - 1/rc ) @@ -151,10 +151,10 @@ SUBROUTINE qmmm_potential_init(qmmm_coupl_type, mm_el_pot_radius, potentials, & pot0_2(2, 1) = 0.0_dp x = 0.0_dp DO i = 2, np - x = x+dx + x = x + dx t = EXP(-2.0_dp*x/rc)/rc - pot0_2(1, i) = (1.0_dp-t*(rc+x))/x - pot0_2(2, i) = ((t*(rc**2+2.0_dp*rc*x+2.0_dp*x**2)/rc-1.0_dp)/x**2)*dx + pot0_2(1, i) = (1.0_dp - t*(rc + x))/x + pot0_2(2, i) = ((t*(rc**2 + 2.0_dp*rc*x + 2.0_dp*x**2)/rc - 1.0_dp)/x**2)*dx END DO END IF pgf => pgfs(K)%pgf @@ -164,15 +164,15 @@ SUBROUTINE qmmm_potential_init(qmmm_coupl_type, mm_el_pot_radius, potentials, & DO Ig = ig_start, pgf%number_of_gaussians A = pgf%Ak(Ig) G = pgf%Gk(Ig) - pot0_2(1, 1) = pot0_2(1, 1)-A + pot0_2(1, 1) = pot0_2(1, 1) - A x = 0.0_dp DO i = 2, np - x = x+dx + x = x + dx t = EXP(-(x/G)**2)*A t1 = 1/G**2 t2 = t1*t - pot0_2(1, i) = pot0_2(1, i)-t - pot0_2(2, i) = pot0_2(2, i)+2.0_dp*x*t2*dx + pot0_2(1, i) = pot0_2(1, i) - t + pot0_2(2, i) = pot0_2(2, i) + 2.0_dp*x*t2*dx END DO END DO @@ -191,14 +191,14 @@ SUBROUTINE qmmm_potential_init(qmmm_coupl_type, mm_el_pot_radius, potentials, & myind = INDEX(myFormat, " ") WRITE (myFormat(myind:), '(A6)') "F12.9," END DO - myind = INDEX(myFormat, " ")-1 + myind = INDEX(myFormat, " ") - 1 myFormat = myFormat(1:myind)//"T300,F15.9" - myind = INDEX(myFormat, " ")-1 + myind = INDEX(myFormat, " ") - 1 x = 0.0_dp DO i = 1, np WRITE (unit_nr, '('//myFormat(1:myind)//')') & x, (EXP(-(x/pgf%Gk(Ig))**2)*pgf%Ak(Ig), Ig=1, pgf%number_of_gaussians), pot0_2(1, i) - x = x+dx + x = x + dx END DO END IF CALL cp_print_key_finished_output(unit_nr, logger, print_section, & @@ -216,7 +216,7 @@ SUBROUTINE qmmm_potential_init(qmmm_coupl_type, mm_el_pot_radius, potentials, & IF (rc .EQ. mm_el_pot_radius(J)) THEN Ndim = SIZE(mm_atom_index) mm_atom_index(Ndim) = J - CALL reallocate(mm_atom_index, 1, Ndim+1) + CALL reallocate(mm_atom_index, 1, Ndim + 1) ENDIF END DO CALL reallocate(mm_atom_index, 1, Ndim) diff --git a/src/qmmm_ff_fist.F b/src/qmmm_ff_fist.F index 8e6e90f332..d73ca3384c 100644 --- a/src/qmmm_ff_fist.F +++ b/src/qmmm_ff_fist.F @@ -49,7 +49,7 @@ FUNCTION qmmm_ff_precond_only_qm(id1, id2, id3, id4, is_link) RESULT(only_qm) my_link = .FALSE. DO WHILE (INDEX(id1, "_QM_") /= 0) my_link = qmmm_ff_precond_only_link(id1) .OR. my_link - my_index = INDEX(id1, "_QM_")+LEN_TRIM("_QM_") + my_index = INDEX(id1, "_QM_") + LEN_TRIM("_QM_") only_qm = .TRUE. tmp = TRIM(id1(my_index:)) clean_string_1: DO j = 1, default_string_length @@ -62,7 +62,7 @@ FUNCTION qmmm_ff_precond_only_qm(id1, id2, id3, id4, is_link) RESULT(only_qm) IF (INDEX(id2, "_QM_") == 0) only_qm = .FALSE. DO WHILE (INDEX(id2, "_QM_") /= 0) my_link = qmmm_ff_precond_only_link(id2) .OR. my_link - my_index = INDEX(id2, "_QM_")+LEN_TRIM("_QM_") + my_index = INDEX(id2, "_QM_") + LEN_TRIM("_QM_") tmp = TRIM(id2(my_index:)) clean_string_2: DO j = 1, default_string_length id2(j:j) = " " @@ -75,7 +75,7 @@ FUNCTION qmmm_ff_precond_only_qm(id1, id2, id3, id4, is_link) RESULT(only_qm) IF (INDEX(id3, "_QM_") == 0) only_qm = .FALSE. DO WHILE (INDEX(id3, "_QM_") /= 0) my_link = qmmm_ff_precond_only_link(id3) .OR. my_link - my_index = INDEX(id3, "_QM_")+LEN_TRIM("_QM_") + my_index = INDEX(id3, "_QM_") + LEN_TRIM("_QM_") tmp = TRIM(id3(my_index:)) clean_string_3: DO j = 1, default_string_length id3(j:j) = " " @@ -88,7 +88,7 @@ FUNCTION qmmm_ff_precond_only_qm(id1, id2, id3, id4, is_link) RESULT(only_qm) IF (INDEX(id4, "_QM_") == 0) only_qm = .FALSE. DO WHILE (INDEX(id4, "_QM_") /= 0) my_link = qmmm_ff_precond_only_link(id4) .OR. my_link - my_index = INDEX(id4, "_QM_")+LEN_TRIM("_QM_") + my_index = INDEX(id4, "_QM_") + LEN_TRIM("_QM_") tmp = TRIM(id4(my_index:)) clean_string_4: DO j = 1, default_string_length id4(j:j) = " " @@ -116,8 +116,8 @@ FUNCTION qmmm_ff_precond_only_link(id1) RESULT(is_link) is_link = .FALSE. DO WHILE (INDEX(id1, "_LNK") /= 0) - my_index = INDEX(id1, "_LNK")+1 - my_index = INDEX(id1(my_index:), "_QM_")+my_index-1 + my_index = INDEX(id1, "_LNK") + 1 + my_index = INDEX(id1(my_index:), "_QM_") + my_index - 1 is_link = .TRUE. tmp = TRIM(id1(my_index:)) clean_string_1: DO j = 1, default_string_length diff --git a/src/qmmm_force.F b/src/qmmm_force.F index a283d44c9a..a426fee6fe 100644 --- a/src/qmmm_force.F +++ b/src/qmmm_force.F @@ -192,7 +192,7 @@ SUBROUTINE qmmm_calc_energy_force(qmmm_env, calc_force, consistent_energies, lin IF (qmmm_link_imomm) CALL qmmm_link_Imomm_forces(qmmm_links, particles_qm, qm_atom_index) particles_mm => subsys_mm%particles%els DO ip = 1, SIZE(qm_atom_index) - particles_mm(qm_atom_index(ip))%f = particles_mm(qm_atom_index(ip))%f+particles_qm(ip)%f + particles_mm(qm_atom_index(ip))%f = particles_mm(qm_atom_index(ip))%f + particles_qm(ip)%f END DO ! If add charges get rid of their derivatives right NOW! IF (qmmm_added_chrg) CALL qmmm_added_chrg_forces(qmmm_env%qm, particles_mm) @@ -224,7 +224,7 @@ SUBROUTINE qmmm_calc_energy_force(qmmm_env, calc_force, consistent_energies, lin CPASSERT(nres <= 1) CALL get_results(results=results_qm, description=description, values=dip_qm) CALL get_results(results=results_mm, description=description, values=dip_mm) - dip_qmmm = dip_qm+dip_mm + dip_qmmm = dip_qm + dip_mm CALL cp_results_erase(results=results_qmmm, description=description) CALL put_results(results=results_qmmm, description=description, values=dip_qmmm) diff --git a/src/qmmm_gaussian_init.F b/src/qmmm_gaussian_init.F index 0517dde828..820dd0e185 100644 --- a/src/qmmm_gaussian_init.F +++ b/src/qmmm_gaussian_init.F @@ -114,7 +114,7 @@ SUBROUTINE qmmm_gaussian_initialize(qmmm_gaussian_fns, para_env, pw_env, & Ndim = SIZE(radius) Loop_on_all_values: DO I = 1, SIZE(mm_el_pot_radius) Found = .FALSE. - Loop_on_found_values: DO J = 1, SIZE(radius)-1 + Loop_on_found_values: DO J = 1, SIZE(radius) - 1 IF (mm_el_pot_radius(i) .EQ. radius(j)) THEN Found = .TRUE. EXIT Loop_on_found_values @@ -124,24 +124,24 @@ SUBROUTINE qmmm_gaussian_initialize(qmmm_gaussian_fns, para_env, pw_env, & Ndim = SIZE(radius) radius(Ndim) = mm_el_pot_radius(i) c_radius(Ndim) = mm_el_pot_radius_corr(i) - Ndim = Ndim+1 + Ndim = Ndim + 1 CALL REALLOCATE(radius, 1, Ndim) CALL REALLOCATE(c_radius, 1, Ndim) END IF END DO Loop_on_all_values ! - IF (Ndim-1 > 0) THEN - CALL REALLOCATE(radius, 1, Ndim-1) - CALL REALLOCATE(c_radius, 1, Ndim-1) - ELSE IF (Ndim-1 == 0) THEN + IF (Ndim - 1 > 0) THEN + CALL REALLOCATE(radius, 1, Ndim - 1) + CALL REALLOCATE(c_radius, 1, Ndim - 1) + ELSE IF (Ndim - 1 == 0) THEN DEALLOCATE (radius) DEALLOCATE (c_radius) ELSE CPABORT("") END IF ! - ALLOCATE (qmmm_gaussian_fns(Ndim-1)) - DO I = 1, Ndim-1 + ALLOCATE (qmmm_gaussian_fns(Ndim - 1)) + DO I = 1, Ndim - 1 NULLIFY (qmmm_gaussian_fns(I)%pgf) ALLOCATE (qmmm_gaussian_fns(I)%pgf) NULLIFY (qmmm_gaussian_fns(I)%pgf%Ak) diff --git a/src/qmmm_gaussian_input.F b/src/qmmm_gaussian_input.F index e029d9ca11..b28f0bb07c 100644 --- a/src/qmmm_gaussian_input.F +++ b/src/qmmm_gaussian_input.F @@ -172,7 +172,7 @@ SUBROUTINE read_mm_potential(para_env, qmmm_gaussian_fns, & Found_Radius = .FALSE. radius = radius*fconv Radius_Loop: DO J = 1, SIZE(qmmm_gaussian_fns) - IF (ABS(radius-qmmm_gaussian_fns(J)%pgf%Elp_Radius) .LT. EPSILON(0.0_dp)) THEN + IF (ABS(radius - qmmm_gaussian_fns(J)%pgf%Elp_Radius) .LT. EPSILON(0.0_dp)) THEN Found_Radius = .TRUE. EXIT Radius_Loop END IF @@ -180,14 +180,14 @@ SUBROUTINE read_mm_potential(para_env, qmmm_gaussian_fns, & IF (.NOT. Found_Radius) THEN CYCLE search_loop END IF - Ival = Ival+1 + Ival = Ival + 1 IRad = J ! Read Rmin, Rmax CALL parser_get_object(parser, qmmm_gaussian_fns(J)%pgf%Number_of_Gaussians, newline=.TRUE.) ! Allocate Vectors istart = 1 IF (compatibility) THEN - qmmm_gaussian_fns(J)%pgf%Number_of_Gaussians = qmmm_gaussian_fns(J)%pgf%Number_of_Gaussians+1 + qmmm_gaussian_fns(J)%pgf%Number_of_Gaussians = qmmm_gaussian_fns(J)%pgf%Number_of_Gaussians + 1 istart = 2 END IF NOG = qmmm_gaussian_fns(IRad)%pgf%Number_of_Gaussians @@ -195,7 +195,7 @@ SUBROUTINE read_mm_potential(para_env, qmmm_gaussian_fns, & ALLOCATE (qmmm_gaussian_fns(IRad)%pgf%Gk(NOG)) IF (compatibility) THEN my_radius = qmmm_gaussian_fns(J)%pgf%Elp_Radius_corr - qmmm_gaussian_fns(IRad)%pgf%Ak(1) = 1.0_dp/radius-2.0_dp/(rootpi*radius) + qmmm_gaussian_fns(IRad)%pgf%Ak(1) = 1.0_dp/radius - 2.0_dp/(rootpi*radius) qmmm_gaussian_fns(IRad)%pgf%Gk(1) = my_radius END IF DO J = istart, qmmm_gaussian_fns(IRad)%pgf%Number_of_Gaussians @@ -248,7 +248,7 @@ SUBROUTINE set_mm_potential_erf(qmmm_gaussian_fns, & istart = 0 ! Allocate Vectors IF (compatibility) THEN - qmmm_gaussian_fns(IRad)%pgf%Number_of_Gaussians = qmmm_gaussian_fns(IRad)%pgf%Number_of_Gaussians+1 + qmmm_gaussian_fns(IRad)%pgf%Number_of_Gaussians = qmmm_gaussian_fns(IRad)%pgf%Number_of_Gaussians + 1 istart = 1 END IF SELECT CASE (num_geep_gauss) @@ -292,370 +292,370 @@ SUBROUTINE set_mm_potential_erf(qmmm_gaussian_fns, & ALLOCATE (qmmm_gaussian_fns(IRad)%pgf%Gk(NOG)) IF (compatibility) THEN my_radius = qmmm_gaussian_fns(IRad)%pgf%Elp_Radius_corr - qmmm_gaussian_fns(IRad)%pgf%Ak(1) = 1.0_dp/radius-2.0_dp/(rootpi*radius) + qmmm_gaussian_fns(IRad)%pgf%Ak(1) = 1.0_dp/radius - 2.0_dp/(rootpi*radius) qmmm_gaussian_fns(IRad)%pgf%Gk(1) = my_radius END IF SELECT CASE (num_geep_gauss) CASE (2) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = g2_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = g2_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = g2_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = g2_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = g2_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = g2_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = g2_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = g2_b2 CASE (3) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = g3_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = g3_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = g3_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = g3_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = g3_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = g3_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = g3_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = g3_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = g3_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = g3_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = g3_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = g3_b3 CASE (4) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = g4_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = g4_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = g4_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = g4_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = g4_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = g4_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = g4_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = g4_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = g4_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = g4_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = g4_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = g4_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = g4_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = g4_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = g4_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = g4_b4 CASE (5) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = g5_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = g5_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = g5_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = g5_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = g5_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = g5_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = g5_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = g5_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = g5_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = g5_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = g5_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = g5_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = g5_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = g5_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = g5_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = g5_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = g5_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = g5_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = g5_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = g5_b5 CASE (6) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = g6_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = g6_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = g6_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = g6_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = g6_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = g6_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = g6_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = g6_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = g6_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = g6_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = g6_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = g6_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = g6_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = g6_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = g6_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = g6_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = g6_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = g6_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = g6_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = g6_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = g6_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = g6_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = g6_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = g6_b6 CASE (7) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = g7_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = g7_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = g7_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = g7_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = g7_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = g7_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = g7_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = g7_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = g7_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = g7_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = g7_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = g7_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = g7_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = g7_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = g7_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = g7_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = g7_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = g7_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = g7_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = g7_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = g7_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = g7_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = g7_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = g7_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = g7_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = g7_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = g7_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = g7_b7 CASE (8) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = g8_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = g8_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = g8_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = g8_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = g8_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = g8_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = g8_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = g8_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = g8_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = g8_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = g8_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = g8_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = g8_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = g8_b7 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+8) = g8_a8 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+8) = g8_b8 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = g8_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = g8_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = g8_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = g8_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = g8_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = g8_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = g8_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = g8_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = g8_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = g8_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = g8_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = g8_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = g8_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = g8_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 8) = g8_a8 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 8) = g8_b8 CASE (9) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = g9_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = g9_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = g9_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = g9_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = g9_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = g9_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = g9_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = g9_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = g9_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = g9_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = g9_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = g9_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = g9_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = g9_b7 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+8) = g9_a8 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+8) = g9_b8 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+9) = g9_a9 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+9) = g9_b9 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = g9_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = g9_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = g9_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = g9_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = g9_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = g9_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = g9_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = g9_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = g9_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = g9_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = g9_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = g9_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = g9_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = g9_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 8) = g9_a8 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 8) = g9_b8 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 9) = g9_a9 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 9) = g9_b9 CASE (10) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = g10_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = g10_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = g10_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = g10_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = g10_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = g10_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = g10_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = g10_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = g10_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = g10_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = g10_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = g10_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = g10_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = g10_b7 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+8) = g10_a8 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+8) = g10_b8 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+9) = g10_a9 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+9) = g10_b9 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+10) = g10_a10 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+10) = g10_b10 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = g10_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = g10_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = g10_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = g10_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = g10_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = g10_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = g10_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = g10_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = g10_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = g10_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = g10_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = g10_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = g10_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = g10_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 8) = g10_a8 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 8) = g10_b8 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 9) = g10_a9 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 9) = g10_b9 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 10) = g10_a10 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 10) = g10_b10 CASE (11) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = g11_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = g11_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = g11_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = g11_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = g11_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = g11_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = g11_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = g11_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = g11_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = g11_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = g11_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = g11_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = g11_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = g11_b7 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+8) = g11_a8 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+8) = g11_b8 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+9) = g11_a9 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+9) = g11_b9 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+10) = g11_a10 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+10) = g11_b10 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+11) = g11_a11 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+11) = g11_b11 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = g11_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = g11_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = g11_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = g11_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = g11_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = g11_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = g11_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = g11_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = g11_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = g11_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = g11_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = g11_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = g11_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = g11_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 8) = g11_a8 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 8) = g11_b8 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 9) = g11_a9 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 9) = g11_b9 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 10) = g11_a10 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 10) = g11_b10 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 11) = g11_a11 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 11) = g11_b11 CASE (12) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = g12_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = g12_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = g12_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = g12_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = g12_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = g12_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = g12_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = g12_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = g12_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = g12_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = g12_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = g12_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = g12_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = g12_b7 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+8) = g12_a8 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+8) = g12_b8 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+9) = g12_a9 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+9) = g12_b9 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+10) = g12_a10 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+10) = g12_b10 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+11) = g12_a11 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+11) = g12_b11 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+12) = g12_a12 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+12) = g12_b12 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = g12_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = g12_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = g12_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = g12_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = g12_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = g12_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = g12_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = g12_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = g12_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = g12_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = g12_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = g12_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = g12_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = g12_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 8) = g12_a8 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 8) = g12_b8 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 9) = g12_a9 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 9) = g12_b9 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 10) = g12_a10 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 10) = g12_b10 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 11) = g12_a11 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 11) = g12_b11 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 12) = g12_a12 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 12) = g12_b12 CASE (13) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = g13_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = g13_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = g13_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = g13_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = g13_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = g13_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = g13_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = g13_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = g13_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = g13_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = g13_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = g13_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = g13_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = g13_b7 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+8) = g13_a8 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+8) = g13_b8 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+9) = g13_a9 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+9) = g13_b9 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+10) = g13_a10 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+10) = g13_b10 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+11) = g13_a11 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+11) = g13_b11 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+12) = g13_a12 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+12) = g13_b12 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+13) = g13_a13 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+13) = g13_b13 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = g13_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = g13_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = g13_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = g13_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = g13_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = g13_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = g13_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = g13_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = g13_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = g13_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = g13_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = g13_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = g13_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = g13_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 8) = g13_a8 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 8) = g13_b8 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 9) = g13_a9 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 9) = g13_b9 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 10) = g13_a10 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 10) = g13_b10 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 11) = g13_a11 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 11) = g13_b11 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 12) = g13_a12 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 12) = g13_b12 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 13) = g13_a13 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 13) = g13_b13 CASE (14) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = g14_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = g14_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = g14_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = g14_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = g14_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = g14_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = g14_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = g14_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = g14_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = g14_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = g14_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = g14_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = g14_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = g14_b7 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+8) = g14_a8 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+8) = g14_b8 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+9) = g14_a9 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+9) = g14_b9 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+10) = g14_a10 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+10) = g14_b10 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+11) = g14_a11 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+11) = g14_b11 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+12) = g14_a12 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+12) = g14_b12 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+13) = g14_a13 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+13) = g14_b13 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+14) = g14_a14 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+14) = g14_b14 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = g14_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = g14_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = g14_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = g14_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = g14_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = g14_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = g14_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = g14_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = g14_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = g14_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = g14_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = g14_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = g14_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = g14_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 8) = g14_a8 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 8) = g14_b8 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 9) = g14_a9 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 9) = g14_b9 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 10) = g14_a10 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 10) = g14_b10 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 11) = g14_a11 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 11) = g14_b11 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 12) = g14_a12 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 12) = g14_b12 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 13) = g14_a13 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 13) = g14_b13 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 14) = g14_a14 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 14) = g14_b14 CASE (15) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = g15_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = g15_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = g15_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = g15_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = g15_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = g15_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = g15_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = g15_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = g15_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = g15_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = g15_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = g15_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = g15_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = g15_b7 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+8) = g15_a8 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+8) = g15_b8 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+9) = g15_a9 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+9) = g15_b9 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+10) = g15_a10 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+10) = g15_b10 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+11) = g15_a11 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+11) = g15_b11 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+12) = g15_a12 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+12) = g15_b12 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+13) = g15_a13 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+13) = g15_b13 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+14) = g15_a14 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+14) = g15_b14 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+15) = g15_a15 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+15) = g15_b15 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = g15_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = g15_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = g15_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = g15_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = g15_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = g15_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = g15_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = g15_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = g15_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = g15_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = g15_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = g15_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = g15_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = g15_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 8) = g15_a8 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 8) = g15_b8 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 9) = g15_a9 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 9) = g15_b9 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 10) = g15_a10 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 10) = g15_b10 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 11) = g15_a11 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 11) = g15_b11 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 12) = g15_a12 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 12) = g15_b12 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 13) = g15_a13 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 13) = g15_b13 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 14) = g15_a14 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 14) = g15_b14 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 15) = g15_a15 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 15) = g15_b15 CASE (16) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = g16_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = g16_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = g16_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = g16_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = g16_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = g16_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = g16_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = g16_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = g16_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = g16_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = g16_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = g16_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = g16_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = g16_b7 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+8) = g16_a8 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+8) = g16_b8 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+9) = g16_a9 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+9) = g16_b9 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+10) = g16_a10 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+10) = g16_b10 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+11) = g16_a11 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+11) = g16_b11 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+12) = g16_a12 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+12) = g16_b12 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+13) = g16_a13 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+13) = g16_b13 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+14) = g16_a14 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+14) = g16_b14 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+15) = g16_a15 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+15) = g16_b15 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+16) = g16_a16 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+16) = g16_b16 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = g16_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = g16_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = g16_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = g16_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = g16_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = g16_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = g16_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = g16_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = g16_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = g16_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = g16_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = g16_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = g16_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = g16_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 8) = g16_a8 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 8) = g16_b8 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 9) = g16_a9 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 9) = g16_b9 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 10) = g16_a10 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 10) = g16_b10 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 11) = g16_a11 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 11) = g16_b11 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 12) = g16_a12 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 12) = g16_b12 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 13) = g16_a13 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 13) = g16_b13 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 14) = g16_a14 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 14) = g16_b14 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 15) = g16_a15 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 15) = g16_b15 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 16) = g16_a16 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 16) = g16_b16 CASE (17) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = g17_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = g17_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = g17_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = g17_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = g17_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = g17_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = g17_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = g17_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = g17_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = g17_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = g17_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = g17_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = g17_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = g17_b7 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+8) = g17_a8 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+8) = g17_b8 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+9) = g17_a9 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+9) = g17_b9 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+10) = g17_a10 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+10) = g17_b10 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+11) = g17_a11 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+11) = g17_b11 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+12) = g17_a12 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+12) = g17_b12 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+13) = g17_a13 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+13) = g17_b13 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+14) = g17_a14 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+14) = g17_b14 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+15) = g17_a15 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+15) = g17_b15 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+16) = g17_a16 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+16) = g17_b16 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+17) = g17_a17 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+17) = g17_b17 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = g17_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = g17_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = g17_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = g17_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = g17_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = g17_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = g17_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = g17_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = g17_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = g17_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = g17_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = g17_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = g17_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = g17_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 8) = g17_a8 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 8) = g17_b8 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 9) = g17_a9 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 9) = g17_b9 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 10) = g17_a10 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 10) = g17_b10 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 11) = g17_a11 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 11) = g17_b11 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 12) = g17_a12 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 12) = g17_b12 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 13) = g17_a13 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 13) = g17_b13 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 14) = g17_a14 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 14) = g17_b14 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 15) = g17_a15 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 15) = g17_b15 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 16) = g17_a16 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 16) = g17_b16 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 17) = g17_a17 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 17) = g17_b17 CASE (18) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = g18_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = g18_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = g18_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = g18_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = g18_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = g18_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = g18_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = g18_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = g18_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = g18_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = g18_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = g18_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = g18_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = g18_b7 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+8) = g18_a8 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+8) = g18_b8 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+9) = g18_a9 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+9) = g18_b9 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+10) = g18_a10 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+10) = g18_b10 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+11) = g18_a11 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+11) = g18_b11 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+12) = g18_a12 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+12) = g18_b12 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+13) = g18_a13 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+13) = g18_b13 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+14) = g18_a14 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+14) = g18_b14 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+15) = g18_a15 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+15) = g18_b15 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+16) = g18_a16 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+16) = g18_b16 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+17) = g18_a17 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+17) = g18_b17 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+18) = g18_a18 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+18) = g18_b18 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = g18_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = g18_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = g18_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = g18_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = g18_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = g18_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = g18_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = g18_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = g18_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = g18_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = g18_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = g18_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = g18_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = g18_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 8) = g18_a8 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 8) = g18_b8 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 9) = g18_a9 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 9) = g18_b9 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 10) = g18_a10 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 10) = g18_b10 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 11) = g18_a11 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 11) = g18_b11 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 12) = g18_a12 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 12) = g18_b12 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 13) = g18_a13 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 13) = g18_b13 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 14) = g18_a14 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 14) = g18_b14 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 15) = g18_a15 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 15) = g18_b15 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 16) = g18_a16 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 16) = g18_b16 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 17) = g18_a17 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 17) = g18_b17 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 18) = g18_a18 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 18) = g18_b18 END SELECT - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1:) = qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1:)/rc - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1:) = qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1:)*rc + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1:) = qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1:)/rc + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1:) = qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1:)*rc END DO END SUBROUTINE set_mm_potential_erf @@ -725,365 +725,365 @@ SUBROUTINE set_mm_potential_swave(qmmm_gaussian_fns, & ALLOCATE (qmmm_gaussian_fns(IRad)%pgf%Gk(NOG)) SELECT CASE (num_geep_gauss) CASE (2) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = s2_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = s2_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = s2_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = s2_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = s2_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = s2_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = s2_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = s2_b2 CASE (3) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = s3_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = s3_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = s3_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = s3_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = s3_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = s3_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = s3_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = s3_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = s3_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = s3_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = s3_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = s3_b3 CASE (4) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = s4_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = s4_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = s4_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = s4_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = s4_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = s4_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = s4_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = s4_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = s4_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = s4_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = s4_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = s4_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = s4_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = s4_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = s4_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = s4_b4 CASE (5) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = s5_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = s5_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = s5_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = s5_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = s5_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = s5_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = s5_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = s5_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = s5_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = s5_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = s5_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = s5_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = s5_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = s5_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = s5_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = s5_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = s5_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = s5_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = s5_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = s5_b5 CASE (6) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = s6_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = s6_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = s6_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = s6_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = s6_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = s6_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = s6_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = s6_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = s6_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = s6_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = s6_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = s6_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = s6_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = s6_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = s6_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = s6_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = s6_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = s6_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = s6_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = s6_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = s6_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = s6_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = s6_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = s6_b6 CASE (7) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = s7_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = s7_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = s7_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = s7_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = s7_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = s7_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = s7_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = s7_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = s7_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = s7_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = s7_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = s7_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = s7_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = s7_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = s7_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = s7_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = s7_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = s7_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = s7_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = s7_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = s7_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = s7_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = s7_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = s7_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = s7_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = s7_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = s7_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = s7_b7 CASE (8) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = s8_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = s8_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = s8_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = s8_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = s8_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = s8_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = s8_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = s8_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = s8_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = s8_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = s8_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = s8_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = s8_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = s8_b7 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+8) = s8_a8 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+8) = s8_b8 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = s8_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = s8_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = s8_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = s8_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = s8_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = s8_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = s8_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = s8_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = s8_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = s8_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = s8_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = s8_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = s8_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = s8_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 8) = s8_a8 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 8) = s8_b8 CASE (9) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = s9_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = s9_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = s9_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = s9_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = s9_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = s9_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = s9_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = s9_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = s9_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = s9_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = s9_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = s9_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = s9_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = s9_b7 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+8) = s9_a8 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+8) = s9_b8 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+9) = s9_a9 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+9) = s9_b9 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = s9_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = s9_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = s9_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = s9_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = s9_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = s9_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = s9_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = s9_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = s9_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = s9_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = s9_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = s9_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = s9_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = s9_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 8) = s9_a8 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 8) = s9_b8 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 9) = s9_a9 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 9) = s9_b9 CASE (10) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = s10_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = s10_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = s10_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = s10_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = s10_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = s10_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = s10_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = s10_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = s10_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = s10_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = s10_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = s10_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = s10_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = s10_b7 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+8) = s10_a8 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+8) = s10_b8 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+9) = s10_a9 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+9) = s10_b9 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+10) = s10_a10 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+10) = s10_b10 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = s10_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = s10_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = s10_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = s10_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = s10_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = s10_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = s10_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = s10_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = s10_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = s10_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = s10_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = s10_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = s10_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = s10_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 8) = s10_a8 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 8) = s10_b8 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 9) = s10_a9 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 9) = s10_b9 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 10) = s10_a10 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 10) = s10_b10 CASE (11) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = s11_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = s11_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = s11_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = s11_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = s11_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = s11_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = s11_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = s11_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = s11_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = s11_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = s11_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = s11_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = s11_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = s11_b7 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+8) = s11_a8 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+8) = s11_b8 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+9) = s11_a9 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+9) = s11_b9 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+10) = s11_a10 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+10) = s11_b10 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+11) = s11_a11 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+11) = s11_b11 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = s11_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = s11_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = s11_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = s11_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = s11_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = s11_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = s11_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = s11_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = s11_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = s11_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = s11_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = s11_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = s11_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = s11_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 8) = s11_a8 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 8) = s11_b8 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 9) = s11_a9 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 9) = s11_b9 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 10) = s11_a10 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 10) = s11_b10 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 11) = s11_a11 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 11) = s11_b11 CASE (12) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = s12_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = s12_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = s12_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = s12_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = s12_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = s12_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = s12_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = s12_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = s12_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = s12_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = s12_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = s12_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = s12_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = s12_b7 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+8) = s12_a8 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+8) = s12_b8 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+9) = s12_a9 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+9) = s12_b9 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+10) = s12_a10 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+10) = s12_b10 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+11) = s12_a11 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+11) = s12_b11 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+12) = s12_a12 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+12) = s12_b12 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = s12_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = s12_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = s12_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = s12_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = s12_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = s12_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = s12_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = s12_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = s12_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = s12_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = s12_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = s12_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = s12_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = s12_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 8) = s12_a8 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 8) = s12_b8 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 9) = s12_a9 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 9) = s12_b9 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 10) = s12_a10 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 10) = s12_b10 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 11) = s12_a11 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 11) = s12_b11 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 12) = s12_a12 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 12) = s12_b12 CASE (13) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = s13_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = s13_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = s13_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = s13_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = s13_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = s13_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = s13_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = s13_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = s13_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = s13_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = s13_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = s13_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = s13_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = s13_b7 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+8) = s13_a8 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+8) = s13_b8 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+9) = s13_a9 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+9) = s13_b9 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+10) = s13_a10 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+10) = s13_b10 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+11) = s13_a11 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+11) = s13_b11 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+12) = s13_a12 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+12) = s13_b12 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+13) = s13_a13 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+13) = s13_b13 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = s13_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = s13_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = s13_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = s13_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = s13_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = s13_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = s13_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = s13_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = s13_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = s13_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = s13_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = s13_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = s13_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = s13_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 8) = s13_a8 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 8) = s13_b8 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 9) = s13_a9 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 9) = s13_b9 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 10) = s13_a10 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 10) = s13_b10 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 11) = s13_a11 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 11) = s13_b11 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 12) = s13_a12 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 12) = s13_b12 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 13) = s13_a13 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 13) = s13_b13 CASE (14) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = s14_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = s14_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = s14_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = s14_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = s14_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = s14_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = s14_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = s14_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = s14_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = s14_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = s14_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = s14_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = s14_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = s14_b7 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+8) = s14_a8 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+8) = s14_b8 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+9) = s14_a9 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+9) = s14_b9 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+10) = s14_a10 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+10) = s14_b10 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+11) = s14_a11 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+11) = s14_b11 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+12) = s14_a12 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+12) = s14_b12 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+13) = s14_a13 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+13) = s14_b13 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+14) = s14_a14 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+14) = s14_b14 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = s14_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = s14_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = s14_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = s14_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = s14_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = s14_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = s14_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = s14_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = s14_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = s14_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = s14_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = s14_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = s14_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = s14_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 8) = s14_a8 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 8) = s14_b8 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 9) = s14_a9 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 9) = s14_b9 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 10) = s14_a10 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 10) = s14_b10 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 11) = s14_a11 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 11) = s14_b11 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 12) = s14_a12 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 12) = s14_b12 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 13) = s14_a13 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 13) = s14_b13 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 14) = s14_a14 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 14) = s14_b14 CASE (15) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = s15_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = s15_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = s15_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = s15_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = s15_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = s15_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = s15_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = s15_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = s15_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = s15_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = s15_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = s15_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = s15_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = s15_b7 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+8) = s15_a8 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+8) = s15_b8 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+9) = s15_a9 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+9) = s15_b9 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+10) = s15_a10 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+10) = s15_b10 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+11) = s15_a11 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+11) = s15_b11 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+12) = s15_a12 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+12) = s15_b12 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+13) = s15_a13 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+13) = s15_b13 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+14) = s15_a14 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+14) = s15_b14 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+15) = s15_a15 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+15) = s15_b15 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = s15_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = s15_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = s15_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = s15_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = s15_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = s15_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = s15_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = s15_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = s15_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = s15_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = s15_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = s15_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = s15_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = s15_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 8) = s15_a8 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 8) = s15_b8 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 9) = s15_a9 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 9) = s15_b9 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 10) = s15_a10 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 10) = s15_b10 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 11) = s15_a11 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 11) = s15_b11 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 12) = s15_a12 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 12) = s15_b12 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 13) = s15_a13 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 13) = s15_b13 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 14) = s15_a14 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 14) = s15_b14 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 15) = s15_a15 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 15) = s15_b15 CASE (16) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = s16_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = s16_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = s16_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = s16_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = s16_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = s16_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = s16_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = s16_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = s16_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = s16_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = s16_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = s16_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = s16_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = s16_b7 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+8) = s16_a8 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+8) = s16_b8 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+9) = s16_a9 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+9) = s16_b9 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+10) = s16_a10 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+10) = s16_b10 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+11) = s16_a11 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+11) = s16_b11 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+12) = s16_a12 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+12) = s16_b12 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+13) = s16_a13 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+13) = s16_b13 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+14) = s16_a14 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+14) = s16_b14 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+15) = s16_a15 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+15) = s16_b15 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+16) = s16_a16 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+16) = s16_b16 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = s16_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = s16_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = s16_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = s16_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = s16_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = s16_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = s16_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = s16_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = s16_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = s16_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = s16_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = s16_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = s16_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = s16_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 8) = s16_a8 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 8) = s16_b8 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 9) = s16_a9 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 9) = s16_b9 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 10) = s16_a10 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 10) = s16_b10 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 11) = s16_a11 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 11) = s16_b11 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 12) = s16_a12 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 12) = s16_b12 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 13) = s16_a13 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 13) = s16_b13 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 14) = s16_a14 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 14) = s16_b14 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 15) = s16_a15 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 15) = s16_b15 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 16) = s16_a16 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 16) = s16_b16 CASE (17) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = s17_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = s17_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = s17_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = s17_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = s17_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = s17_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = s17_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = s17_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = s17_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = s17_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = s17_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = s17_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = s17_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = s17_b7 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+8) = s17_a8 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+8) = s17_b8 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+9) = s17_a9 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+9) = s17_b9 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+10) = s17_a10 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+10) = s17_b10 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+11) = s17_a11 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+11) = s17_b11 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+12) = s17_a12 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+12) = s17_b12 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+13) = s17_a13 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+13) = s17_b13 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+14) = s17_a14 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+14) = s17_b14 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+15) = s17_a15 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+15) = s17_b15 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+16) = s17_a16 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+16) = s17_b16 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+17) = s17_a17 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+17) = s17_b17 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = s17_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = s17_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = s17_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = s17_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = s17_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = s17_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = s17_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = s17_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = s17_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = s17_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = s17_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = s17_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = s17_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = s17_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 8) = s17_a8 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 8) = s17_b8 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 9) = s17_a9 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 9) = s17_b9 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 10) = s17_a10 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 10) = s17_b10 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 11) = s17_a11 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 11) = s17_b11 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 12) = s17_a12 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 12) = s17_b12 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 13) = s17_a13 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 13) = s17_b13 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 14) = s17_a14 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 14) = s17_b14 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 15) = s17_a15 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 15) = s17_b15 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 16) = s17_a16 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 16) = s17_b16 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 17) = s17_a17 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 17) = s17_b17 CASE (18) - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1) = s18_a1 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1) = s18_b1 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+2) = s18_a2 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+2) = s18_b2 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+3) = s18_a3 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+3) = s18_b3 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+4) = s18_a4 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+4) = s18_b4 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+5) = s18_a5 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+5) = s18_b5 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+6) = s18_a6 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+6) = s18_b6 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+7) = s18_a7 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+7) = s18_b7 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+8) = s18_a8 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+8) = s18_b8 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+9) = s18_a9 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+9) = s18_b9 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+10) = s18_a10 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+10) = s18_b10 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+11) = s18_a11 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+11) = s18_b11 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+12) = s18_a12 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+12) = s18_b12 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+13) = s18_a13 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+13) = s18_b13 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+14) = s18_a14 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+14) = s18_b14 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+15) = s18_a15 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+15) = s18_b15 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+16) = s18_a16 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+16) = s18_b16 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+17) = s18_a17 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+17) = s18_b17 - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+18) = s18_a18 - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+18) = s18_b18 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1) = s18_a1 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1) = s18_b1 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 2) = s18_a2 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 2) = s18_b2 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 3) = s18_a3 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 3) = s18_b3 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 4) = s18_a4 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 4) = s18_b4 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 5) = s18_a5 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 5) = s18_b5 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 6) = s18_a6 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 6) = s18_b6 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 7) = s18_a7 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 7) = s18_b7 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 8) = s18_a8 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 8) = s18_b8 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 9) = s18_a9 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 9) = s18_b9 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 10) = s18_a10 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 10) = s18_b10 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 11) = s18_a11 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 11) = s18_b11 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 12) = s18_a12 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 12) = s18_b12 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 13) = s18_a13 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 13) = s18_b13 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 14) = s18_a14 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 14) = s18_b14 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 15) = s18_a15 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 15) = s18_b15 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 16) = s18_a16 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 16) = s18_b16 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 17) = s18_a17 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 17) = s18_b17 + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 18) = s18_a18 + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 18) = s18_b18 END SELECT - qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1:) = qmmm_gaussian_fns(IRad)%pgf%Ak(istart+1:)/rc - qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1:) = qmmm_gaussian_fns(IRad)%pgf%Gk(istart+1:)*rc + qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1:) = qmmm_gaussian_fns(IRad)%pgf%Ak(istart + 1:)/rc + qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1:) = qmmm_gaussian_fns(IRad)%pgf%Gk(istart + 1:)*rc END DO END SUBROUTINE set_mm_potential_swave diff --git a/src/qmmm_gpw_energy.F b/src/qmmm_gpw_energy.F index 79f793f642..823c2f02bf 100644 --- a/src/qmmm_gpw_energy.F +++ b/src/qmmm_gpw_energy.F @@ -322,9 +322,9 @@ SUBROUTINE qmmm_elec_with_gaussian(qmmm_env, v_qmmm, mm_particles, & ! Spline Iterpolator CALL mp_sync(para_env%group) CALL timeset(TRIM(routineN)//":spline3Int", handle2) - DO Ilevel = coarser_grid, auxbas_grid+1, -1 + DO Ilevel = coarser_grid, auxbas_grid + 1, -1 CALL pw_prolongate_s3(grids(Ilevel)%pw, & - grids(Ilevel-1)%pw, & + grids(Ilevel - 1)%pw, & aug_pools(Ilevel)%pool, & param_section=interp_section) END DO @@ -429,15 +429,15 @@ SUBROUTINE qmmm_elec_with_gaussian_low(tmp_grid, mm_particles, mm_charges, & ilevel = pgf%grid_level(IGauss) Atoms: DO Imm = 1, SIZE(pot%mm_atom_index) IF (par_scheme == do_par_atom) THEN - myind = myind+1 + myind = myind + 1 IF (MOD(myind, para_env%num_pe) /= para_env%mepos) CYCLE Atoms END IF LIndMM = pot%mm_atom_index(Imm) IndMM = mm_atom_index(LIndMM) IF (shells) THEN - ra(:) = pbc(mm_particles(LIndMM)%r-dOmmOqm, mm_cell)+dOmmOqm + ra(:) = pbc(mm_particles(LIndMM)%r - dOmmOqm, mm_cell) + dOmmOqm ELSE - ra(:) = pbc(mm_particles(IndMM)%r-dOmmOqm, mm_cell)+dOmmOqm + ra(:) = pbc(mm_particles(IndMM)%r - dOmmOqm, mm_cell) + dOmmOqm END IF W = mm_charges(LIndMM)*height ! Possible Spherical Cutoff @@ -584,16 +584,16 @@ SUBROUTINE qmmm_elec_with_gaussian_LG(pgfs, cgrid, mm_charges, mm_atom_index, & grid => pw%cr3d(:, :, :) Atoms: DO Imm = 1, SIZE(per_pot%mm_atom_index) IF (par_scheme == do_par_atom) THEN - myind = myind+1 + myind = myind + 1 IF (MOD(myind, para_env%num_pe) /= para_env%mepos) CYCLE END IF LIndMM = per_pot%mm_atom_index(Imm) IndMM = mm_atom_index(LIndMM) qt = mm_charges(LIndMM) IF (shells) THEN - ra(:) = pbc(mm_particles(LIndMM)%r-dOmmOqm, mm_cell)+dOmmOqm + ra(:) = pbc(mm_particles(LIndMM)%r - dOmmOqm, mm_cell) + dOmmOqm ELSE - ra(:) = pbc(mm_particles(IndMM)%r-dOmmOqm, mm_cell)+dOmmOqm + ra(:) = pbc(mm_particles(IndMM)%r - dOmmOqm, mm_cell) + dOmmOqm END IF ! Possible Spherical Cutoff IF (qmmm_spherical_cutoff(1) > 0.0_dp) THEN @@ -605,118 +605,118 @@ SUBROUTINE qmmm_elec_with_gaussian_LG(pgfs, cgrid, mm_charges, mm_atom_index, & rt2 = ra(2) rt3 = ra(3) LoopOnGrid: DO k = bo(1, 3), bo(2, 3) - my_k = k-gbo(1, 3) + my_k = k - gbo(1, 3) xs3 = REAL(my_k, dp)*dr3c - my_j = bo(1, 2)-gbo(1, 2) + my_j = bo(1, 2) - gbo(1, 2) xs2 = REAL(my_j, dp)*dr2c - rv3 = rt3-xs3 + rv3 = rt3 - xs3 vec(3) = rv3 ivec(3) = FLOOR(vec(3)/pw%pw_grid%dr(3)) - xd3 = (vec(3)/dr3)-REAL(ivec(3), kind=dp) - ik1 = MODULO(ivec(3)-1, npts(3))+1 - ik2 = MODULO(ivec(3), npts(3))+1 - ik3 = MODULO(ivec(3)+1, npts(3))+1 - ik4 = MODULO(ivec(3)+2, npts(3))+1 - p1 = 3.0_dp+xd3 + xd3 = (vec(3)/dr3) - REAL(ivec(3), kind=dp) + ik1 = MODULO(ivec(3) - 1, npts(3)) + 1 + ik2 = MODULO(ivec(3), npts(3)) + 1 + ik3 = MODULO(ivec(3) + 1, npts(3)) + 1 + ik4 = MODULO(ivec(3) + 2, npts(3)) + 1 + p1 = 3.0_dp + xd3 p2 = p1*p1 p3 = p2*p1 - q1 = 2.0_dp+xd3 + q1 = 2.0_dp + xd3 q2 = q1*q1 q3 = q2*q1 - r1 = 1.0_dp+xd3 + r1 = 1.0_dp + xd3 r2 = r1*r1 r3 = r2*r1 u1 = xd3 u2 = u1*u1 u3 = u2*u1 - v1 = 1.0_dp/6.0_dp*(64.0_dp-48.0_dp*p1+12.0_dp*p2-p3) - v2 = -22.0_dp/3.0_dp+10.0_dp*q1-4.0_dp*q2+0.5_dp*q3 - v3 = 2.0_dp/3.0_dp-2.0_dp*r1+2.0_dp*r2-0.5_dp*r3 + v1 = 1.0_dp/6.0_dp*(64.0_dp - 48.0_dp*p1 + 12.0_dp*p2 - p3) + v2 = -22.0_dp/3.0_dp + 10.0_dp*q1 - 4.0_dp*q2 + 0.5_dp*q3 + v3 = 2.0_dp/3.0_dp - 2.0_dp*r1 + 2.0_dp*r2 - 0.5_dp*r3 v4 = 1.0_dp/6.0_dp*u3 DO j = bo(1, 2), bo(2, 2) - xs1 = (bo(1, 1)-gbo(1, 1))*dr1c - rv2 = rt2-xs2 + xs1 = (bo(1, 1) - gbo(1, 1))*dr1c + rv2 = rt2 - xs2 vec(2) = rv2 ivec(2) = FLOOR(vec(2)/pw%pw_grid%dr(2)) - xd2 = (vec(2)/dr2)-REAL(ivec(2), kind=dp) - ij1 = MODULO(ivec(2)-1, npts(2))+1 - ij2 = MODULO(ivec(2), npts(2))+1 - ij3 = MODULO(ivec(2)+1, npts(2))+1 - ij4 = MODULO(ivec(2)+2, npts(2))+1 - e1 = 3.0_dp+xd2 + xd2 = (vec(2)/dr2) - REAL(ivec(2), kind=dp) + ij1 = MODULO(ivec(2) - 1, npts(2)) + 1 + ij2 = MODULO(ivec(2), npts(2)) + 1 + ij3 = MODULO(ivec(2) + 1, npts(2)) + 1 + ij4 = MODULO(ivec(2) + 2, npts(2)) + 1 + e1 = 3.0_dp + xd2 e2 = e1*e1 e3 = e2*e1 - f1 = 2.0_dp+xd2 + f1 = 2.0_dp + xd2 f2 = f1*f1 f3 = f2*f1 - g1 = 1.0_dp+xd2 + g1 = 1.0_dp + xd2 g2 = g1*g1 g3 = g2*g1 h1 = xd2 h2 = h1*h1 h3 = h2*h1 - s1 = 1.0_dp/6.0_dp*(64.0_dp-48.0_dp*e1+12.0_dp*e2-e3) - s2 = -22.0_dp/3.0_dp+10.0_dp*f1-4.0_dp*f2+0.5_dp*f3 - s3 = 2.0_dp/3.0_dp-2.0_dp*g1+2.0_dp*g2-0.5_dp*g3 + s1 = 1.0_dp/6.0_dp*(64.0_dp - 48.0_dp*e1 + 12.0_dp*e2 - e3) + s2 = -22.0_dp/3.0_dp + 10.0_dp*f1 - 4.0_dp*f2 + 0.5_dp*f3 + s3 = 2.0_dp/3.0_dp - 2.0_dp*g1 + 2.0_dp*g2 - 0.5_dp*g3 s4 = 1.0_dp/6.0_dp*h3 DO i = bo(1, 1), bo(2, 1) - rv1 = rt1-xs1 + rv1 = rt1 - xs1 vec(1) = rv1 ivec(1) = FLOOR(vec(1)/pw%pw_grid%dr(1)) - xd1 = (vec(1)/dr1)-REAL(ivec(1), kind=dp) - ii1 = MODULO(ivec(1)-1, npts(1))+1 - ii2 = MODULO(ivec(1), npts(1))+1 - ii3 = MODULO(ivec(1)+1, npts(1))+1 - ii4 = MODULO(ivec(1)+2, npts(1))+1 + xd1 = (vec(1)/dr1) - REAL(ivec(1), kind=dp) + ii1 = MODULO(ivec(1) - 1, npts(1)) + 1 + ii2 = MODULO(ivec(1), npts(1)) + 1 + ii3 = MODULO(ivec(1) + 1, npts(1)) + 1 + ii4 = MODULO(ivec(1) + 2, npts(1)) + 1 ! ! Spline Interpolation ! - a1 = 3.0_dp+xd1 + a1 = 3.0_dp + xd1 a2 = a1*a1 a3 = a2*a1 - b1 = 2.0_dp+xd1 + b1 = 2.0_dp + xd1 b2 = b1*b1 b3 = b2*b1 - c1 = 1.0_dp+xd1 + c1 = 1.0_dp + xd1 c2 = c1*c1 c3 = c2*c1 d1 = xd1 d2 = d1*d1 d3 = d2*d1 - t1 = 1.0_dp/6.0_dp*(64.0_dp-48.0_dp*a1+12.0_dp*a2-a3) - t2 = -22.0_dp/3.0_dp+10.0_dp*b1-4.0_dp*b2+0.5_dp*b3 - t3 = 2.0_dp/3.0_dp-2.0_dp*c1+2.0_dp*c2-0.5_dp*c3 + t1 = 1.0_dp/6.0_dp*(64.0_dp - 48.0_dp*a1 + 12.0_dp*a2 - a3) + t2 = -22.0_dp/3.0_dp + 10.0_dp*b1 - 4.0_dp*b2 + 0.5_dp*b3 + t3 = 2.0_dp/3.0_dp - 2.0_dp*c1 + 2.0_dp*c2 - 0.5_dp*c3 t4 = 1.0_dp/6.0_dp*d3 - abc_X(1, 1) = grid(ii1, ij1, ik1)*v1+grid(ii1, ij1, ik2)*v2+grid(ii1, ij1, ik3)*v3+grid(ii1, ij1, ik4)*v4 - abc_X(1, 2) = grid(ii1, ij2, ik1)*v1+grid(ii1, ij2, ik2)*v2+grid(ii1, ij2, ik3)*v3+grid(ii1, ij2, ik4)*v4 - abc_X(1, 3) = grid(ii1, ij3, ik1)*v1+grid(ii1, ij3, ik2)*v2+grid(ii1, ij3, ik3)*v3+grid(ii1, ij3, ik4)*v4 - abc_X(1, 4) = grid(ii1, ij4, ik1)*v1+grid(ii1, ij4, ik2)*v2+grid(ii1, ij4, ik3)*v3+grid(ii1, ij4, ik4)*v4 - abc_X(2, 1) = grid(ii2, ij1, ik1)*v1+grid(ii2, ij1, ik2)*v2+grid(ii2, ij1, ik3)*v3+grid(ii2, ij1, ik4)*v4 - abc_X(2, 2) = grid(ii2, ij2, ik1)*v1+grid(ii2, ij2, ik2)*v2+grid(ii2, ij2, ik3)*v3+grid(ii2, ij2, ik4)*v4 - abc_X(2, 3) = grid(ii2, ij3, ik1)*v1+grid(ii2, ij3, ik2)*v2+grid(ii2, ij3, ik3)*v3+grid(ii2, ij3, ik4)*v4 - abc_X(2, 4) = grid(ii2, ij4, ik1)*v1+grid(ii2, ij4, ik2)*v2+grid(ii2, ij4, ik3)*v3+grid(ii2, ij4, ik4)*v4 - abc_X(3, 1) = grid(ii3, ij1, ik1)*v1+grid(ii3, ij1, ik2)*v2+grid(ii3, ij1, ik3)*v3+grid(ii3, ij1, ik4)*v4 - abc_X(3, 2) = grid(ii3, ij2, ik1)*v1+grid(ii3, ij2, ik2)*v2+grid(ii3, ij2, ik3)*v3+grid(ii3, ij2, ik4)*v4 - abc_X(3, 3) = grid(ii3, ij3, ik1)*v1+grid(ii3, ij3, ik2)*v2+grid(ii3, ij3, ik3)*v3+grid(ii3, ij3, ik4)*v4 - abc_X(3, 4) = grid(ii3, ij4, ik1)*v1+grid(ii3, ij4, ik2)*v2+grid(ii3, ij4, ik3)*v3+grid(ii3, ij4, ik4)*v4 - abc_X(4, 1) = grid(ii4, ij1, ik1)*v1+grid(ii4, ij1, ik2)*v2+grid(ii4, ij1, ik3)*v3+grid(ii4, ij1, ik4)*v4 - abc_X(4, 2) = grid(ii4, ij2, ik1)*v1+grid(ii4, ij2, ik2)*v2+grid(ii4, ij2, ik3)*v3+grid(ii4, ij2, ik4)*v4 - abc_X(4, 3) = grid(ii4, ij3, ik1)*v1+grid(ii4, ij3, ik2)*v2+grid(ii4, ij3, ik3)*v3+grid(ii4, ij3, ik4)*v4 - abc_X(4, 4) = grid(ii4, ij4, ik1)*v1+grid(ii4, ij4, ik2)*v2+grid(ii4, ij4, ik3)*v3+grid(ii4, ij4, ik4)*v4 - - abc_X_Y(1) = abc_X(1, 1)*t1+abc_X(2, 1)*t2+abc_X(3, 1)*t3+abc_X(4, 1)*t4 - abc_X_Y(2) = abc_X(1, 2)*t1+abc_X(2, 2)*t2+abc_X(3, 2)*t3+abc_X(4, 2)*t4 - abc_X_Y(3) = abc_X(1, 3)*t1+abc_X(2, 3)*t2+abc_X(3, 3)*t3+abc_X(4, 3)*t4 - abc_X_Y(4) = abc_X(1, 4)*t1+abc_X(2, 4)*t2+abc_X(3, 4)*t3+abc_X(4, 4)*t4 - - val = abc_X_Y(1)*s1+abc_X_Y(2)*s2+abc_X_Y(3)*s3+abc_X_Y(4)*s4 - - grid2(i, j, k) = grid2(i, j, k)-val*qt - xs1 = xs1+dr1c + abc_X(1, 1) = grid(ii1, ij1, ik1)*v1 + grid(ii1, ij1, ik2)*v2 + grid(ii1, ij1, ik3)*v3 + grid(ii1, ij1, ik4)*v4 + abc_X(1, 2) = grid(ii1, ij2, ik1)*v1 + grid(ii1, ij2, ik2)*v2 + grid(ii1, ij2, ik3)*v3 + grid(ii1, ij2, ik4)*v4 + abc_X(1, 3) = grid(ii1, ij3, ik1)*v1 + grid(ii1, ij3, ik2)*v2 + grid(ii1, ij3, ik3)*v3 + grid(ii1, ij3, ik4)*v4 + abc_X(1, 4) = grid(ii1, ij4, ik1)*v1 + grid(ii1, ij4, ik2)*v2 + grid(ii1, ij4, ik3)*v3 + grid(ii1, ij4, ik4)*v4 + abc_X(2, 1) = grid(ii2, ij1, ik1)*v1 + grid(ii2, ij1, ik2)*v2 + grid(ii2, ij1, ik3)*v3 + grid(ii2, ij1, ik4)*v4 + abc_X(2, 2) = grid(ii2, ij2, ik1)*v1 + grid(ii2, ij2, ik2)*v2 + grid(ii2, ij2, ik3)*v3 + grid(ii2, ij2, ik4)*v4 + abc_X(2, 3) = grid(ii2, ij3, ik1)*v1 + grid(ii2, ij3, ik2)*v2 + grid(ii2, ij3, ik3)*v3 + grid(ii2, ij3, ik4)*v4 + abc_X(2, 4) = grid(ii2, ij4, ik1)*v1 + grid(ii2, ij4, ik2)*v2 + grid(ii2, ij4, ik3)*v3 + grid(ii2, ij4, ik4)*v4 + abc_X(3, 1) = grid(ii3, ij1, ik1)*v1 + grid(ii3, ij1, ik2)*v2 + grid(ii3, ij1, ik3)*v3 + grid(ii3, ij1, ik4)*v4 + abc_X(3, 2) = grid(ii3, ij2, ik1)*v1 + grid(ii3, ij2, ik2)*v2 + grid(ii3, ij2, ik3)*v3 + grid(ii3, ij2, ik4)*v4 + abc_X(3, 3) = grid(ii3, ij3, ik1)*v1 + grid(ii3, ij3, ik2)*v2 + grid(ii3, ij3, ik3)*v3 + grid(ii3, ij3, ik4)*v4 + abc_X(3, 4) = grid(ii3, ij4, ik1)*v1 + grid(ii3, ij4, ik2)*v2 + grid(ii3, ij4, ik3)*v3 + grid(ii3, ij4, ik4)*v4 + abc_X(4, 1) = grid(ii4, ij1, ik1)*v1 + grid(ii4, ij1, ik2)*v2 + grid(ii4, ij1, ik3)*v3 + grid(ii4, ij1, ik4)*v4 + abc_X(4, 2) = grid(ii4, ij2, ik1)*v1 + grid(ii4, ij2, ik2)*v2 + grid(ii4, ij2, ik3)*v3 + grid(ii4, ij2, ik4)*v4 + abc_X(4, 3) = grid(ii4, ij3, ik1)*v1 + grid(ii4, ij3, ik2)*v2 + grid(ii4, ij3, ik3)*v3 + grid(ii4, ij3, ik4)*v4 + abc_X(4, 4) = grid(ii4, ij4, ik1)*v1 + grid(ii4, ij4, ik2)*v2 + grid(ii4, ij4, ik3)*v3 + grid(ii4, ij4, ik4)*v4 + + abc_X_Y(1) = abc_X(1, 1)*t1 + abc_X(2, 1)*t2 + abc_X(3, 1)*t3 + abc_X(4, 1)*t4 + abc_X_Y(2) = abc_X(1, 2)*t1 + abc_X(2, 2)*t2 + abc_X(3, 2)*t3 + abc_X(4, 2)*t4 + abc_X_Y(3) = abc_X(1, 3)*t1 + abc_X(2, 3)*t2 + abc_X(3, 3)*t3 + abc_X(4, 3)*t4 + abc_X_Y(4) = abc_X(1, 4)*t1 + abc_X(2, 4)*t2 + abc_X(3, 4)*t3 + abc_X(4, 4)*t4 + + val = abc_X_Y(1)*s1 + abc_X_Y(2)*s2 + abc_X_Y(3)*s3 + abc_X_Y(4)*s4 + + grid2(i, j, k) = grid2(i, j, k) - val*qt + xs1 = xs1 + dr1c END DO - xs2 = xs2+dr2c + xs2 = xs2 + dr2c END DO END DO LoopOnGrid END DO Atoms @@ -792,15 +792,15 @@ SUBROUTINE qmmm_elec_with_gaussian_LR(pgfs, grid, mm_charges, mm_atom_index, & pot0_2 => Pot%pot0_2 Atoms: DO Imm = 1, SIZE(pot%mm_atom_index) IF (par_scheme == do_par_atom) THEN - myind = myind+1 + myind = myind + 1 IF (MOD(myind, para_env%num_pe) /= para_env%mepos) CYCLE END IF LIndMM = pot%mm_atom_index(Imm) IndMM = mm_atom_index(LIndMM) - ra(:) = pbc(mm_particles(IndMM)%r-dOmmOqm, mm_cell)+dOmmOqm + ra(:) = pbc(mm_particles(IndMM)%r - dOmmOqm, mm_cell) + dOmmOqm qt = mm_charges(LIndMM) IF (shells) & - ra(:) = pbc(mm_particles(LIndMM)%r-dOmmOqm, mm_cell)+dOmmOqm + ra(:) = pbc(mm_particles(LIndMM)%r - dOmmOqm, mm_cell) + dOmmOqm ! Possible Spherical Cutoff IF (qmmm_spherical_cutoff(1) > 0.0_dp) THEN CALL spherical_cutoff_factor(qmmm_spherical_cutoff, ra, sph_chrg_factor) @@ -811,30 +811,30 @@ SUBROUTINE qmmm_elec_with_gaussian_LR(pgfs, grid, mm_charges, mm_atom_index, & rt2 = ra(2) rt3 = ra(3) LoopOnGrid: DO k = bo(1, 3), bo(2, 3) - my_k = k-gbo(1, 3) + my_k = k - gbo(1, 3) xs3 = REAL(my_k, dp)*dr3 - my_j = bo(1, 2)-gbo(1, 2) + my_j = bo(1, 2) - gbo(1, 2) xs2 = REAL(my_j, dp)*dr2 - rv3 = rt3-xs3 + rv3 = rt3 - xs3 DO j = bo(1, 2), bo(2, 2) - xs1 = (bo(1, 1)-gbo(1, 1))*dr1 - rv2 = rt2-xs2 + xs1 = (bo(1, 1) - gbo(1, 1))*dr1 + rv2 = rt2 - xs2 DO i = bo(1, 1), bo(2, 1) - rv1 = rt1-xs1 - r2 = rv1*rv1+rv2*rv2+rv3*rv3 + rv1 = rt1 - xs1 + r2 = rv1*rv1 + rv2*rv2 + rv3*rv3 r = SQRT(r2) - ix = FLOOR(r/dx)+1 - rx = (r-REAL(ix-1, dp)*dx)/dx + ix = FLOOR(r/dx) + 1 + rx = (r - REAL(ix - 1, dp)*dx)/dx rx2 = rx*rx rx3 = rx2*rx - Term = pot0_2(1, ix)*(1.0_dp-3.0_dp*rx2+2.0_dp*rx3) & - +pot0_2(2, ix)*(rx-2.0_dp*rx2+rx3) & - +pot0_2(1, ix+1)*(3.0_dp*rx2-2.0_dp*rx3) & - +pot0_2(2, ix+1)*(-rx2+rx3) - grid2(i, j, k) = grid2(i, j, k)-Term*qt - xs1 = xs1+dr1 + Term = pot0_2(1, ix)*(1.0_dp - 3.0_dp*rx2 + 2.0_dp*rx3) & + + pot0_2(2, ix)*(rx - 2.0_dp*rx2 + rx3) & + + pot0_2(1, ix + 1)*(3.0_dp*rx2 - 2.0_dp*rx3) & + + pot0_2(2, ix + 1)*(-rx2 + rx3) + grid2(i, j, k) = grid2(i, j, k) - Term*qt + xs1 = xs1 + dr1 END DO - xs2 = xs2+dr2 + xs2 = xs2 + dr2 END DO END DO LoopOnGrid END DO Atoms diff --git a/src/qmmm_image_charge.F b/src/qmmm_image_charge.F index 5aa95313d3..fd9a5fbc92 100644 --- a/src/qmmm_image_charge.F +++ b/src/qmmm_image_charge.F @@ -187,7 +187,7 @@ SUBROUTINE calc_image_coeff_gaussalgorithm(v_hartree_rspace, coeff, qmmm_env, & CALL integrate_potential_ga_rspace(v_hartree_rspace, qmmm_env, qs_env, & pot_const) !add integral V0*ga(r) - pot_const(:) = -pot_const(:)+V0*SQRT((pi/eta)**3) + pot_const(:) = -pot_const(:) + V0*SQRT((pi/eta)**3) !solve linear system of equations T*coeff=-pot_const !LU factorization of T by DGETRF done in calculate_image_matrix @@ -253,7 +253,7 @@ SUBROUTINE calc_image_coeff_iterative(v_hartree_rspace, coeff, qmmm_env, & pot_const) !add integral V0*ga(r) - pot_const(:) = -pot_const(:)+V0*SQRT((pi/eta)**3) + pot_const(:) = -pot_const(:) + V0*SQRT((pi/eta)**3) !initial guess for coeff coeff = 1.0_dp @@ -271,7 +271,7 @@ SUBROUTINE calc_image_coeff_iterative(v_hartree_rspace, coeff, qmmm_env, & qmmm_env=qmmm_env, qs_env=qs_env, int_res=vmetal_const) ! modify coefficients iteratively - r = pot_const-vmetal_const + r = pot_const - vmetal_const z = MATMUL(qs_env%image_matrix, r) d = z rsold = DOT_PRODUCT(r, z) @@ -286,18 +286,18 @@ SUBROUTINE calc_image_coeff_iterative(v_hartree_rspace, coeff, qmmm_env, & qs_env=qs_env, int_res=Ad) alpha = rsold/DOT_PRODUCT(d, Ad) - coeff = coeff+alpha*d + coeff = coeff + alpha*d - r = r-alpha*Ad + r = r - alpha*Ad z = MATMUL(qs_env%image_matrix, r) rsnew = DOT_PRODUCT(r, z) - iter_steps = iter_steps+1 + iter_steps = iter_steps + 1 ! SQRT(rsnew) < 1.0E-08 IF (rsnew < 1.0E-16) THEN CALL pw_release(auxpot_Ad_rspace%pw) EXIT END IF - d = z+rsnew/rsold*d + d = z + rsnew/rsold*d rsold = rsnew CALL pw_release(auxpot_Ad_rspace%pw) ENDDO @@ -388,7 +388,7 @@ SUBROUTINE integrate_potential_ga_rspace(potential, qmmm_env, qs_env, int_res, & k = 1 IF (PRESENT(atom_num)) k = atom_num - CALL reallocate(cores, 1, natom-k+1) + CALL reallocate(cores, 1, natom - k + 1) int_res = 0.0_dp npme = 0 cores = 0 @@ -397,11 +397,11 @@ SUBROUTINE integrate_potential_ga_rspace(potential, qmmm_env, qs_env, int_res, & IF (rs_v%desc%parallel .AND. .NOT. rs_v%desc%distributed) THEN ! replicated realspace grid, split the atoms up between procs IF (MODULO(iatom, rs_v%desc%group_size) == rs_v%desc%my_pos) THEN - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF ELSE - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF END DO @@ -416,8 +416,8 @@ SUBROUTINE integrate_potential_ga_rspace(potential, qmmm_env, qs_env, int_res, & atom_b = qmmm_env%image_charge_pot%image_mm_list(k) atom_ref = qmmm_env%image_charge_pot%image_mm_list(atom_num_ref) ra(:) = pbc(qmmm_env%image_charge_pot%particles_all(atom_a)%r, cell) & - -pbc(qmmm_env%image_charge_pot%particles_all(atom_b)%r, cell) & - +pbc(qmmm_env%image_charge_pot%particles_all(atom_ref)%r, cell) + - pbc(qmmm_env%image_charge_pot%particles_all(atom_b)%r, cell) & + + pbc(qmmm_env%image_charge_pot%particles_all(atom_ref)%r, cell) ELSE ra(:) = pbc(qmmm_env%image_charge_pot%particles_all(atom_a)%r, cell) @@ -526,11 +526,11 @@ SUBROUTINE integrate_potential_devga_rspace(potential, coeff, forces, qmmm_env, IF (rs_v%desc%parallel .AND. .NOT. rs_v%desc%distributed) THEN ! replicated realspace grid, split the atoms up between procs IF (MODULO(iatom, rs_v%desc%group_size) == rs_v%desc%my_pos) THEN - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF ELSE - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF END DO @@ -679,7 +679,7 @@ SUBROUTINE calculate_image_matrix(image_matrix, ipiv, qs_env, qmmm_env) CALL DPOTRI('L', natom, qs_env%image_matrix, natom, stat) CPASSERT(stat == 0) DO j = 1, natom - DO k = j+1, natom + DO k = j + 1, natom qs_env%image_matrix(j, k) = qs_env%image_matrix(k, j) ENDDO ENDDO @@ -762,7 +762,7 @@ SUBROUTINE calculate_image_matrix_gpw(image_matrix, qs_env, qmmm_env) qs_env, int_res, atom_num=iatom, & atom_num_ref=iatom_ref) image_matrix(iatom, iatom:natom) = int_res(iatom:natom) - image_matrix(iatom+1:natom, iatom) = int_res(iatom+1:natom) + image_matrix(iatom + 1:natom, iatom) = int_res(iatom + 1:natom) END DO CALL pw_release(vb_gspace%pw) @@ -852,11 +852,11 @@ SUBROUTINE integrate_s_mme(param, zeta, zetb, ra, rb, hab, para_env) limits = get_limit(npgf_prod, para_env%num_pe, para_env%mepos) DO ipgf_prod = limits(1), limits(2) - ipgf = (ipgf_prod-1)/npgfb+1 - jpgf = MOD(ipgf_prod-1, npgfb)+1 - rab(:) = ra(:, ipgf)-rb(:, jpgf) + ipgf = (ipgf_prod - 1)/npgfb + 1 + jpgf = MOD(ipgf_prod - 1, npgfb) + 1 + rab(:) = ra(:, ipgf) - rb(:, jpgf) CALL eri_mme_2c_integrate(param%par, 0, 0, 0, 0, zeta(ipgf), & - zetb(jpgf), rab, hab, ipgf-1, jpgf-1, G_count=G_count, R_count=R_count) + zetb(jpgf), rab, hab, ipgf - 1, jpgf - 1, G_count=G_count, R_count=R_count) ENDDO CALL cp_eri_mme_update_local_counts(param, para_env, G_count_2c=G_count, R_count_2c=R_count) @@ -932,7 +932,7 @@ SUBROUTINE calculate_potential_metal(v_metal_rspace, coeff, rho_hartree_gspace, en_vmetal_rhohartree = 0.5_dp*pw_integral_ab(v_metal_gspace%pw, & rho_hartree_gspace%pw) en_external = qs_env%qmmm_env_qm%image_charge_pot%V0*total_rho_metal - energy%image_charge = en_vmetal_rhohartree-0.5_dp*en_external + energy%image_charge = en_vmetal_rhohartree - 0.5_dp*en_external CALL print_image_energy_terms(en_vmetal_rhohartree, en_external, & total_rho_metal, qs_env) ENDIF @@ -1150,7 +1150,7 @@ SUBROUTINE print_gradients_image_atoms(forces, qs_env) natom = SIZE(qs_env%qmmm_env_qm%image_charge_pot%image_mm_list) DO iatom = 1, natom - sum_gradients(:) = sum_gradients(:)+forces(:, iatom) + sum_gradients(:) = sum_gradients(:) + forces(:, iatom) ENDDO CALL get_qs_env(qs_env=qs_env, input=input) @@ -1205,7 +1205,7 @@ SUBROUTINE print_image_coefficients(image_coeff, qs_env) normalize_factor = SQRT((qs_env%qmmm_env_qm%image_charge_pot%eta/pi)**3) DO iatom = 1, natom - sum_coeff = sum_coeff+image_coeff(iatom) + sum_coeff = sum_coeff + image_coeff(iatom) ENDDO CALL get_qs_env(qs_env=qs_env, input=input) @@ -1278,7 +1278,7 @@ SUBROUTINE print_image_energy_terms(en_vmetal_rhohartree, en_external, & WRITE (unit=output_unit, fmt="(T3,A,T56,F25.14)") & "External potential energy term [a.u.]:", -0.5_dp*en_external WRITE (unit=output_unit, fmt="(T3,A,T56,F25.14)") & - "Total image charge energy [a.u.]:", en_vmetal_rhohartree-0.5_dp*en_external + "Total image charge energy [a.u.]:", en_vmetal_rhohartree - 0.5_dp*en_external ENDIF CALL cp_print_key_finished_output(output_unit, logger, input, & diff --git a/src/qmmm_init.F b/src/qmmm_init.F index 7a28fbaf1e..e8b89da43e 100644 --- a/src/qmmm_init.F +++ b/src/qmmm_init.F @@ -236,7 +236,7 @@ SUBROUTINE print_qmmm_charges(mm_atom_index, mm_atom_chrg, mm_el_pot_radius, mm_ DO I = 1, SIZE(mm_atom_index) IndMM = mm_atom_index(I) qi = mm_atom_chrg(I) - qtot = qtot+qi + qtot = qtot + qi ri = mm_el_pot_radius(I) rc = mm_el_pot_radius_corr(I) IF (nocompatibility) THEN @@ -254,7 +254,7 @@ SUBROUTINE print_qmmm_charges(mm_atom_index, mm_atom_chrg, mm_el_pot_radius, mm_ DO I = 1, SIZE(added_charges%mm_atom_index) IndMM = added_charges%mm_atom_index(I) qi = added_charges%mm_atom_chrg(I) - qtot = qtot+qi + qtot = qtot + qi ri = added_charges%mm_el_pot_radius(I) ind1 = added_charges%add_env(I)%Index1 ind2 = added_charges%add_env(I)%Index2 @@ -277,7 +277,7 @@ SUBROUTINE print_qmmm_charges(mm_atom_index, mm_atom_chrg, mm_el_pot_radius, mm_ DO I = 1, SIZE(added_shells%mm_core_index) IndMM = added_shells%mm_core_index(I) qi = added_shells%mm_core_chrg(I) - qtot = qtot+qi + qtot = qtot + qi ri = added_shells%mm_el_pot_radius(I) IF (nocompatibility) THEN WRITE (iw, '(7X,A,I5,A8,F12.6,A8,F12.6,3F12.6)') 'SHELL:', IndMM, ' RADIUS:', ri, & @@ -695,7 +695,7 @@ SUBROUTINE setup_qmmm_vars_qm(qmmm_section, qmmm_env, subsys_mm, qm_atom_type, & qmmm_env%spherical_cutoff(2) = 0.0_dp ELSE IF (qmmm_env%spherical_cutoff(2) <= 0.0_dp) qmmm_env%spherical_cutoff(2) = EPSILON(0.0_dp) - tmp_radius = qmmm_env%spherical_cutoff(1)-20.0_dp*qmmm_env%spherical_cutoff(2) + tmp_radius = qmmm_env%spherical_cutoff(1) - 20.0_dp*qmmm_env%spherical_cutoff(2) IF (tmp_radius <= 0.0_dp) & CALL cp_abort(__LOCATION__, & "SPHERICAL_CUTOFF(1) > 20*SPHERICAL_CUTOFF(1)! Please correct parameters for "// & @@ -780,8 +780,8 @@ SUBROUTINE setup_qmmm_vars_qm(qmmm_section, qmmm_env, subsys_mm, qm_atom_type, & ! ! Build MM atoms list ! - size_mm_system = SIZE(subsys_mm%particles%els)-SIZE(qm_atom_index) - IF (qmmm_link .AND. ASSOCIATED(mm_link_atoms)) size_mm_system = size_mm_system+SIZE(mm_link_atoms) + size_mm_system = SIZE(subsys_mm%particles%els) - SIZE(qm_atom_index) + IF (qmmm_link .AND. ASSOCIATED(mm_link_atoms)) size_mm_system = size_mm_system + SIZE(mm_link_atoms) ALLOCATE (mm_atom_index(size_mm_system)) icount = 0 @@ -794,7 +794,7 @@ SUBROUTINE setup_qmmm_vars_qm(qmmm_section, qmmm_env, subsys_mm, qm_atom_type, & IF (ANY(mm_link_atoms == i) .AND. qmmm_link) is_mm = .TRUE. END IF IF (is_mm) THEN - icount = icount+1 + icount = icount + 1 IF (icount <= size_mm_system) mm_atom_index(icount) = i END IF END DO @@ -942,22 +942,22 @@ SUBROUTINE read_qmmm_ff_section(qmmm_ff_section, inp_info) CALL read_lj_section(inp_info%nonbonded, lj_section, start=0) END IF CALL section_vals_get(wl_section, n_repetition=n_wl) - np = n_lj+n_wl + np = n_lj + n_wl IF (n_wl /= 0) THEN CALL pair_potential_reallocate(inp_info%nonbonded, 1, np, williams=.TRUE.) CALL read_wl_section(inp_info%nonbonded, wl_section, start=n_lj) END IF CALL section_vals_get(gd_section, n_repetition=n_gd) - np = n_lj+n_wl+n_gd + np = n_lj + n_wl + n_gd IF (n_gd /= 0) THEN CALL pair_potential_reallocate(inp_info%nonbonded, 1, np, goodwin=.TRUE.) - CALL read_gd_section(inp_info%nonbonded, gd_section, start=n_lj+n_wl) + CALL read_gd_section(inp_info%nonbonded, gd_section, start=n_lj + n_wl) END IF CALL section_vals_get(gp_section, n_repetition=n_gp) - np = n_lj+n_wl+n_gd+n_gp + np = n_lj + n_wl + n_gd + n_gp IF (n_gp /= 0) THEN CALL pair_potential_reallocate(inp_info%nonbonded, 1, np, gp=.TRUE.) - CALL read_gp_section(inp_info%nonbonded, gp_section, start=n_lj+n_wl+n_gd) + CALL read_gp_section(inp_info%nonbonded, gp_section, start=n_lj + n_wl + n_gd) END IF ! ! NONBONDED14 @@ -973,22 +973,22 @@ SUBROUTINE read_qmmm_ff_section(qmmm_ff_section, inp_info) CALL read_lj_section(inp_info%nonbonded14, lj_section, start=0) END IF CALL section_vals_get(wl_section, n_repetition=n_wl) - np = n_lj+n_wl + np = n_lj + n_wl IF (n_wl /= 0) THEN CALL pair_potential_reallocate(inp_info%nonbonded14, 1, np, williams=.TRUE.) CALL read_wl_section(inp_info%nonbonded14, wl_section, start=n_lj) END IF CALL section_vals_get(gd_section, n_repetition=n_gd) - np = n_lj+n_wl+n_gd + np = n_lj + n_wl + n_gd IF (n_gd /= 0) THEN CALL pair_potential_reallocate(inp_info%nonbonded14, 1, np, goodwin=.TRUE.) - CALL read_gd_section(inp_info%nonbonded14, gd_section, start=n_lj+n_wl) + CALL read_gd_section(inp_info%nonbonded14, gd_section, start=n_lj + n_wl) END IF CALL section_vals_get(gp_section, n_repetition=n_gp) - np = n_lj+n_wl+n_gd+n_gp + np = n_lj + n_wl + n_gd + n_gp IF (n_gp /= 0) THEN CALL pair_potential_reallocate(inp_info%nonbonded14, 1, np, gp=.TRUE.) - CALL read_gp_section(inp_info%nonbonded14, gp_section, start=n_lj+n_wl+n_gd) + CALL read_gp_section(inp_info%nonbonded14, gp_section, start=n_lj + n_wl + n_gd) END IF END SUBROUTINE read_qmmm_ff_section @@ -1042,7 +1042,7 @@ SUBROUTINE setup_qm_atom_list(qmmm_section, qm_atom_index, qm_atom_type, & DO k = 1, n_var CALL section_vals_val_get(qm_kinds, "MM_INDEX", i_rep_section=ikind, i_rep_val=k, & i_vals=mm_indexes) - num_qm_atom_tot = num_qm_atom_tot+SIZE(mm_indexes) + num_qm_atom_tot = num_qm_atom_tot + SIZE(mm_indexes) END DO END DO ! @@ -1059,10 +1059,10 @@ SUBROUTINE setup_qm_atom_list(qmmm_section, qm_atom_index, qm_atom_type, & i_val=link_type) SELECT CASE (link_type) CASE (do_qmmm_link_imomm) - num_qm_atom_tot = num_qm_atom_tot+1 - link_involv_mm = link_involv_mm+1 + num_qm_atom_tot = num_qm_atom_tot + 1 + link_involv_mm = link_involv_mm + 1 CASE (do_qmmm_link_pseudo) - num_qm_atom_tot = num_qm_atom_tot+1 + num_qm_atom_tot = num_qm_atom_tot + 1 CASE (do_qmmm_link_gho) ! do nothing for the moment CASE DEFAULT @@ -1087,14 +1087,14 @@ SUBROUTINE setup_qm_atom_list(qmmm_section, qm_atom_index, qm_atom_type, & CALL section_vals_val_get(qm_kinds, "MM_INDEX", i_rep_section=ikind, i_rep_val=k, & i_vals=mm_indexes) IF (PRESENT(qm_atom_index)) THEN - qm_atom_index(num_qm_atom_tot:num_qm_atom_tot+SIZE(mm_indexes)-1) = mm_indexes(:) + qm_atom_index(num_qm_atom_tot:num_qm_atom_tot + SIZE(mm_indexes) - 1) = mm_indexes(:) END IF IF (PRESENT(qm_atom_type)) THEN CALL section_vals_val_get(qm_kinds, "_SECTION_PARAMETERS_", i_rep_section=ikind, & c_val=qm_atom_kind) - qm_atom_type(num_qm_atom_tot:num_qm_atom_tot+SIZE(mm_indexes)-1) = qm_atom_kind + qm_atom_type(num_qm_atom_tot:num_qm_atom_tot + SIZE(mm_indexes) - 1) = qm_atom_kind END IF - num_qm_atom_tot = num_qm_atom_tot+SIZE(mm_indexes) + num_qm_atom_tot = num_qm_atom_tot + SIZE(mm_indexes) END DO END DO IF (PRESENT(mm_link_scale_factor) .AND. (link_involv_mm /= 0)) mm_link_scale_factor = 0.0_dp @@ -1110,7 +1110,7 @@ SUBROUTINE setup_qm_atom_list(qmmm_section, qm_atom_index, qm_atom_type, & CALL section_vals_val_get(qmmm_links, "MM_INDEX", i_rep_section=ikind, i_val=mm_index) CPASSERT(ALL(qm_atom_index /= mm_index)) qm_atom_index(num_qm_atom_tot:num_qm_atom_tot) = mm_index - num_qm_atom_tot = num_qm_atom_tot+1 + num_qm_atom_tot = num_qm_atom_tot + 1 END IF IF (PRESENT(mm_link_atoms) .AND. (link_involv_mm /= 0)) THEN CALL section_vals_val_get(qmmm_links, "MM_INDEX", i_rep_section=ikind, i_val=mm_index) @@ -1126,7 +1126,7 @@ SUBROUTINE setup_qm_atom_list(qmmm_section, qm_atom_index, qm_atom_type, & END IF END DO END IF - CPASSERT(num_qm_atom_tot-1 == SIZE(qm_atom_index)) + CPASSERT(num_qm_atom_tot - 1 == SIZE(qm_atom_index)) END SUBROUTINE setup_qm_atom_list @@ -1169,11 +1169,11 @@ SUBROUTINE setup_qmmm_links(qmmm_section, qmmm_links, mm_el_pot_radius, mm_el_po CPASSERT(nlinks /= 0) DO ikind = 1, nlinks CALL section_vals_val_get(qmmm_link_section, "LINK_TYPE", i_rep_section=ikind, i_val=link_type) - IF (link_type == do_qmmm_link_imomm) n_imomm = n_imomm+1 - IF (link_type == do_qmmm_link_gho) n_gho = n_gho+1 - IF (link_type == do_qmmm_link_pseudo) n_pseudo = n_pseudo+1 + IF (link_type == do_qmmm_link_imomm) n_imomm = n_imomm + 1 + IF (link_type == do_qmmm_link_gho) n_gho = n_gho + 1 + IF (link_type == do_qmmm_link_pseudo) n_pseudo = n_pseudo + 1 END DO - n_tot = n_imomm+n_gho+n_pseudo + n_tot = n_imomm + n_gho + n_pseudo CPASSERT(n_tot /= 0) ALLOCATE (qmmm_links) NULLIFY (qmmm_links%imomm, & @@ -1190,7 +1190,7 @@ SUBROUTINE setup_qmmm_links(qmmm_section, qmmm_links, mm_el_pot_radius, mm_el_po DO ikind = 1, nlinks CALL section_vals_val_get(qmmm_link_section, "LINK_TYPE", i_rep_section=ikind, i_val=link_type) IF (link_type == do_qmmm_link_imomm) THEN - n_imomm = n_imomm+1 + n_imomm = n_imomm + 1 CALL section_vals_val_get(qmmm_link_section, "QM_INDEX", i_rep_section=ikind, i_val=qm_index) CALL section_vals_val_get(qmmm_link_section, "MM_INDEX", i_rep_section=ikind, i_val=mm_index) CALL section_vals_val_get(qmmm_link_section, "ALPHA_IMOMM", i_rep_section=ikind, r_val=alpha) @@ -1234,7 +1234,7 @@ SUBROUTINE setup_qmmm_links(qmmm_section, qmmm_links, mm_el_pot_radius, mm_el_po DO ikind = 1, nlinks CALL section_vals_val_get(qmmm_link_section, "LINK_TYPE", i_rep_section=ikind, i_val=link_type) IF (link_type == do_qmmm_link_pseudo) THEN - n_pseudo = n_pseudo+1 + n_pseudo = n_pseudo + 1 CALL section_vals_val_get(qmmm_link_section, "QM_INDEX", i_rep_section=ikind, i_val=qm_index) CALL section_vals_val_get(qmmm_link_section, "MM_INDEX", i_rep_section=ikind, i_val=mm_index) qmmm_links%pseudo(n_pseudo)%link%qm_index = qm_index @@ -1302,10 +1302,10 @@ SUBROUTINE move_or_add_atoms(qmmm_section, move_mm_charges, add_mm_charges, & add_section => section_vals_get_subs_vals(qmmm_link_section, "ADD_MM_CHARGE", & i_rep_section=ikind) CALL section_vals_get(add_section, n_repetition=n_adds) - n_move_tot = n_move_tot+n_moves - n_add_tot = n_add_tot+n_adds + n_move_tot = n_move_tot + n_moves + n_add_tot = n_add_tot + n_adds END DO - icount = n_move_tot+n_add_tot + icount = n_move_tot + n_add_tot IF (n_add_tot /= 0) add_mm_charges = .TRUE. IF (n_move_tot /= 0) move_mm_charges = .TRUE. ! @@ -1325,7 +1325,7 @@ SUBROUTINE move_or_add_atoms(qmmm_section, move_mm_charges, add_mm_charges, & ! IF (explicit) THEN DO i_add = 1, n_moves - icount = icount+1 + icount = icount + 1 CALL section_vals_val_get(move_section, "ATOM_INDEX_1", i_val=Index1, i_rep_section=i_add) CALL section_vals_val_get(move_section, "ATOM_INDEX_2", i_val=Index2, i_rep_section=i_add) CALL section_vals_val_get(move_section, "ALPHA", r_val=alpha, i_rep_section=i_add) @@ -1351,7 +1351,7 @@ SUBROUTINE move_or_add_atoms(qmmm_section, move_mm_charges, add_mm_charges, & ! IF (explicit) THEN DO i_add = 1, n_adds - icount = icount+1 + icount = icount + 1 CALL section_vals_val_get(add_section, "ATOM_INDEX_1", i_val=Index1, i_rep_section=i_add) CALL section_vals_val_get(add_section, "ATOM_INDEX_2", i_val=Index2, i_rep_section=i_add) CALL section_vals_val_get(add_section, "ALPHA", r_val=alpha, i_rep_section=i_add) @@ -1418,7 +1418,7 @@ SUBROUTINE set_add_set_type(added_charges, icount, Index1, Index2, alpha, radius i = 1 GetId: DO WHILE (i <= SIZE(mm_atom_index)) IF (Index1 == mm_atom_index(i)) EXIT GetId - i = i+1 + i = i + 1 END DO GetId IF (PRESENT(ind1)) ind1 = i CPASSERT(i <= SIZE(mm_atom_index)) @@ -1518,7 +1518,7 @@ SUBROUTINE setup_image_atom_list(image_charge_section, qmmm_env, & DO i = 1, n_var CALL section_vals_val_get(image_charge_section, "MM_ATOM_LIST", & i_rep_val=i, i_vals=mm_indexes) - num_image_mm_atom = num_image_mm_atom+SIZE(mm_indexes) + num_image_mm_atom = num_image_mm_atom + SIZE(mm_indexes) END DO ALLOCATE (qmmm_env%image_charge_pot%image_mm_list(num_image_mm_atom)) @@ -1530,12 +1530,12 @@ SUBROUTINE setup_image_atom_list(image_charge_section, qmmm_env, & CALL section_vals_val_get(image_charge_section, "MM_ATOM_LIST", & i_rep_val=i, i_vals=mm_indexes) qmmm_env%image_charge_pot%image_mm_list(num_image_mm_atom:num_image_mm_atom & - +SIZE(mm_indexes)-1) = mm_indexes(:) - num_image_mm_atom = num_image_mm_atom+SIZE(mm_indexes) + + SIZE(mm_indexes) - 1) = mm_indexes(:) + num_image_mm_atom = num_image_mm_atom + SIZE(mm_indexes) END DO ! checking, if in range, if list contains QM atoms or any atoms doubled - num_image_mm_atom = num_image_mm_atom-1 + num_image_mm_atom = num_image_mm_atom - 1 max_index = SIZE(subsys_mm%particles%els) @@ -1549,7 +1549,7 @@ SUBROUTINE setup_image_atom_list(image_charge_section, qmmm_env, & IF (ANY(qm_atom_index == atom_a)) THEN CPABORT("Image atom list must only contain MM atoms") ENDIF - DO j = i+1, num_image_mm_atom + DO j = i + 1, num_image_mm_atom atom_b = qmmm_env%image_charge_pot%image_mm_list(j) IF (atom_a == atom_b) & CPABORT("There are atoms doubled in image list.") @@ -1570,7 +1570,7 @@ SUBROUTINE setup_image_atom_list(image_charge_section, qmmm_env, & DO k = 1, num_image_mm_atom atom_a = qmmm_env%image_charge_pot%image_mm_list(k) IF (atom_a == molecule_kind(i)%fixd_list(j)%fixd) THEN - num_const_atom = num_const_atom+1 + num_const_atom = num_const_atom + 1 IF (molecule_kind(i)%fixd_list(j)%itype /= use_perd_xyz) THEN fix_xyz = .FALSE. EXIT diff --git a/src/qmmm_links_methods.F b/src/qmmm_links_methods.F index b695f8e374..a17509ace2 100644 --- a/src/qmmm_links_methods.F +++ b/src/qmmm_links_methods.F @@ -64,7 +64,7 @@ SUBROUTINE qmmm_link_Imomm_coord(qmmm_links, particles, qm_atom_index) DO ip = 1, SIZE(qm_atom_index) IF (qm_atom_index(ip) == qm_index) EXIT END DO - IF (ip == SIZE(qm_atom_index)+1) & + IF (ip == SIZE(qm_atom_index) + 1) & CALL cp_abort(__LOCATION__, & "QM atom index ("//cp_to_string(qm_index)//") specified in the LINK section nr.("// & cp_to_string(ilink)//") is not defined as a QM atom! Please inspect your QM_KIND sections. ") @@ -72,12 +72,12 @@ SUBROUTINE qmmm_link_Imomm_coord(qmmm_links, particles, qm_atom_index) DO ip = 1, SIZE(qm_atom_index) IF (qm_atom_index(ip) == mm_index) EXIT END DO - IF (ip == SIZE(qm_atom_index)+1) & + IF (ip == SIZE(qm_atom_index) + 1) & CALL cp_abort(__LOCATION__, & "Error in setting up the MM atom index ("//cp_to_string(mm_index)// & ") specified in the LINK section nr.("//cp_to_string(ilink)//"). Please report this bug! ") ip_mm = ip - particles(ip_mm)%r = alpha*particles(ip_mm)%r+(1.0_dp-alpha)*particles(ip_qm)%r + particles(ip_mm)%r = alpha*particles(ip_mm)%r + (1.0_dp - alpha)*particles(ip_qm)%r END DO END SUBROUTINE qmmm_link_Imomm_coord @@ -114,7 +114,7 @@ SUBROUTINE qmmm_link_Imomm_forces(qmmm_links, particles_qm, qm_atom_index) DO ip = 1, SIZE(qm_atom_index) IF (qm_atom_index(ip) == qm_index) EXIT END DO - IF (ip == SIZE(qm_atom_index)+1) & + IF (ip == SIZE(qm_atom_index) + 1) & CALL cp_abort(__LOCATION__, & "QM atom index ("//cp_to_string(qm_index)//") specified in the LINK section nr.("// & cp_to_string(ilink)//") is not defined as a QM atom! Please inspect your QM_KIND sections. ") @@ -122,12 +122,12 @@ SUBROUTINE qmmm_link_Imomm_forces(qmmm_links, particles_qm, qm_atom_index) DO ip = 1, SIZE(qm_atom_index) IF (qm_atom_index(ip) == mm_index) EXIT END DO - IF (ip == SIZE(qm_atom_index)+1) & + IF (ip == SIZE(qm_atom_index) + 1) & CALL cp_abort(__LOCATION__, & "Error in setting up the MM atom index ("//cp_to_string(mm_index)// & ") specified in the LINK section nr.("//cp_to_string(ilink)//"). Please report this bug! ") ip_mm = ip - particles_qm(ip_qm)%f = particles_qm(ip_qm)%f+particles_qm(ip_mm)%f*(1.0_dp-alpha) + particles_qm(ip_qm)%f = particles_qm(ip_qm)%f + particles_qm(ip_mm)%f*(1.0_dp - alpha) particles_qm(ip_mm)%f = particles_qm(ip_mm)%f*alpha END DO @@ -158,7 +158,7 @@ SUBROUTINE qmmm_added_chrg_coord(qmmm_env, particles) Index1 = added_charges%add_env(i)%Index1 Index2 = added_charges%add_env(i)%Index1 alpha = added_charges%add_env(i)%alpha - added_charges%added_particles(i)%r = alpha*particles(Index1)%r+(1.0_dp-alpha)*particles(Index2)%r + added_charges%added_particles(i)%r = alpha*particles(Index1)%r + (1.0_dp - alpha)*particles(Index2)%r END DO END SUBROUTINE qmmm_added_chrg_coord @@ -188,8 +188,8 @@ SUBROUTINE qmmm_added_chrg_forces(qmmm_env, particles) Index1 = added_charges%add_env(i)%Index1 Index2 = added_charges%add_env(i)%Index1 alpha = added_charges%add_env(i)%alpha - particles(Index1)%f = particles(Index1)%f+alpha*added_charges%added_particles(i)%f - particles(Index2)%f = particles(Index2)%f+(1.0_dp-alpha)*added_charges%added_particles(i)%f + particles(Index1)%f = particles(Index1)%f + alpha*added_charges%added_particles(i)%f + particles(Index2)%f = particles(Index2)%f + (1.0_dp - alpha)*added_charges%added_particles(i)%f END DO END SUBROUTINE qmmm_added_chrg_forces diff --git a/src/qmmm_per_elpot.F b/src/qmmm_per_elpot.F index 68c89955e5..feace25c99 100644 --- a/src/qmmm_per_elpot.F +++ b/src/qmmm_per_elpot.F @@ -112,8 +112,8 @@ SUBROUTINE qmmm_per_potential_init(qmmm_coupl_type, per_potentials, potentials, ncoarsel = PRODUCT(ncpl) logger => cp_get_default_logger() output_unit = cp_logger_get_default_io_unit(logger) - Rmax = SQRT(mm_cell%hmat(1, 1)**2+ & - mm_cell%hmat(2, 2)**2+ & + Rmax = SQRT(mm_cell%hmat(1, 1)**2 + & + mm_cell%hmat(2, 2)**2 + & mm_cell%hmat(3, 3)**2) CALL section_vals_val_get(qmmm_periodic, "GMAX", r_val=Gmax) CALL section_vals_val_get(qmmm_periodic, "REPLICA", i_val=n_rep_real_val) @@ -122,7 +122,7 @@ SUBROUTINE qmmm_per_potential_init(qmmm_coupl_type, per_potentials, potentials, Vol = mm_cell%hmat(1, 1)* & mm_cell%hmat(2, 2)* & mm_cell%hmat(3, 3) - Ndim = (Kmax(1)+1)*(2*Kmax(2)+1)*(2*Kmax(3)+1) + Ndim = (Kmax(1) + 1)*(2*Kmax(2) + 1)*(2*Kmax(3) + 1) ig_start = 1 n_rep_real = n_rep_real_val IF (compatibility .AND. (qmmm_coupl_type == do_qmmm_gauss)) ig_start = 2 @@ -160,12 +160,12 @@ SUBROUTINE qmmm_per_potential_init(qmmm_coupl_type, per_potentials, potentials, DO ix = 0, kmax(1) DO iy = -kmax(2), kmax(2) DO iz = -kmax(3), kmax(3) - idim = idim+1 + idim = idim + 1 IF (ix == 0 .AND. iy == 0 .AND. iz == 0) THEN DO Ig = ig_start, pgf%number_of_gaussians Gk = pgf%Gk(Ig) Ak = pgf%Ak(Ig)*Pi**(3.0_dp/2.0_dp)*Gk**3.0_dp - LG(idim) = LG(idim)-Ak + LG(idim) = LG(idim) - Ak END DO ELSE fs = 2.0_dp; IF (ix == 0) fs = 1.0_dp @@ -177,12 +177,12 @@ SUBROUTINE qmmm_per_potential_init(qmmm_coupl_type, per_potentials, potentials, LG(idim) = 4.0_dp*Pi/g2*EXP(-(g2*rc2)/4.0_dp) ELSEIF (qmmm_coupl_type == do_qmmm_swave) THEN tmp = 4.0_dp/rc2 - LG(idim) = 4.0_dp*Pi*tmp**2/(g2*(g2+tmp)**2) + LG(idim) = 4.0_dp*Pi*tmp**2/(g2*(g2 + tmp)**2) END IF DO Ig = ig_start, pgf%number_of_gaussians Gk = pgf%Gk(Ig) Ak = pgf%Ak(Ig)*Pi**(3.0_dp/2.0_dp)*Gk**3.0_dp - LG(idim) = LG(idim)-Ak*EXP(-(g*Gk)**2.0_dp/4.0_dp) + LG(idim) = LG(idim) - Ak*EXP(-(g*Gk)**2.0_dp/4.0_dp) END DO ENDIF LG(idim) = fs*LG(idim)*1.0_dp/Vol @@ -203,15 +203,15 @@ SUBROUTINE qmmm_per_potential_init(qmmm_coupl_type, per_potentials, potentials, mymaxradius = MAX(mymaxradius, exp_radius(0, alpha, eps_mm_rspace, Prefactor)) END IF END DO - box(1) = (qm_cell_small%hmat(1, 1)-mm_cell%hmat(1, 1))/2.0_dp - box(2) = (qm_cell_small%hmat(2, 2)-mm_cell%hmat(2, 2))/2.0_dp - box(3) = (qm_cell_small%hmat(3, 3)-mm_cell%hmat(3, 3))/2.0_dp + box(1) = (qm_cell_small%hmat(1, 1) - mm_cell%hmat(1, 1))/2.0_dp + box(2) = (qm_cell_small%hmat(2, 2) - mm_cell%hmat(2, 2))/2.0_dp + box(3) = (qm_cell_small%hmat(3, 3) - mm_cell%hmat(3, 3))/2.0_dp IF (ANY(box > 0.0_dp)) THEN CPABORT("") END IF - n_rep_real(1) = CEILING((box(1)+mymaxradius)/mm_cell%hmat(1, 1)) - n_rep_real(2) = CEILING((box(2)+mymaxradius)/mm_cell%hmat(2, 2)) - n_rep_real(3) = CEILING((box(3)+mymaxradius)/mm_cell%hmat(3, 3)) + n_rep_real(1) = CEILING((box(1) + mymaxradius)/mm_cell%hmat(1, 1)) + n_rep_real(2) = CEILING((box(2) + mymaxradius)/mm_cell%hmat(2, 2)) + n_rep_real(3) = CEILING((box(3) + mymaxradius)/mm_cell%hmat(3, 3)) END IF CASE DEFAULT diff --git a/src/qmmm_pw_grid.F b/src/qmmm_pw_grid.F index c7aed353ae..a0b2bfeb25 100644 --- a/src/qmmm_pw_grid.F +++ b/src/qmmm_pw_grid.F @@ -131,27 +131,27 @@ SUBROUTINE pw_grid_create_copy_no_pbc(pw_grid_in, pw_grid_out, pw_mode) pw_mode_loc = pw_grid_in%para%mode IF (PRESENT(pw_mode)) pw_mode_loc = pw_mode CALL pw_grid_create(pw_grid_out, pw_grid_in%para%group) - qmmm_grid_tag = qmmm_grid_tag+1 + qmmm_grid_tag = qmmm_grid_tag + 1 pw_grid_out%id_nr = qmmm_grid_tag pw_grid_out%ref_count = 1 pw_grid_out%reference = 0 pw_grid_out%bounds = pw_grid_in%bounds - pw_grid_out%bounds(2, :) = pw_grid_out%bounds(2, :)+1 + pw_grid_out%bounds(2, :) = pw_grid_out%bounds(2, :) + 1 IF (pw_mode_loc == PW_MODE_DISTRIBUTED) THEN pw_grid_out%bounds_local = pw_grid_in%bounds_local IF (pw_grid_in%bounds_local(2, 1) == pw_grid_in%bounds(2, 1) .AND. & pw_grid_in%bounds_local(1, 1) <= pw_grid_in%bounds(2, 1)) THEN - pw_grid_out%bounds_local(2, 1) = pw_grid_out%bounds_local(2, 1)+1 + pw_grid_out%bounds_local(2, 1) = pw_grid_out%bounds_local(2, 1) + 1 END IF - pw_grid_out%bounds_local(2, 2) = pw_grid_out%bounds_local(2, 2)+1 - pw_grid_out%bounds_local(2, 3) = pw_grid_out%bounds_local(2, 3)+1 + pw_grid_out%bounds_local(2, 2) = pw_grid_out%bounds_local(2, 2) + 1 + pw_grid_out%bounds_local(2, 3) = pw_grid_out%bounds_local(2, 3) + 1 ELSE pw_grid_out%bounds_local = pw_grid_out%bounds END IF - pw_grid_out%npts = pw_grid_in%npts+1 + pw_grid_out%npts = pw_grid_in%npts + 1 pw_grid_out%ngpts = PRODUCT(INT(pw_grid_out%npts, KIND=int_8)) pw_grid_out%ngpts_cut = 0 - pw_grid_out%npts_local = pw_grid_out%bounds_local(2, :)-pw_grid_out%bounds_local(1, :)+1 + pw_grid_out%npts_local = pw_grid_out%bounds_local(2, :) - pw_grid_out%bounds_local(1, :) + 1 pw_grid_out%ngpts_local = PRODUCT(pw_grid_out%npts_local) pw_grid_out%ngpts_cut_local = 0 pw_grid_out%dr = pw_grid_in%dr @@ -179,8 +179,8 @@ SUBROUTINE pw_grid_create_copy_no_pbc(pw_grid_in, pw_grid_out, pw_mode) pw_grid_out%para%nyzray, & pw_grid_out%para%bo) ALLOCATE (pos_of_x(pw_grid_out%bounds(1, 1):pw_grid_out%bounds(2, 1))) - pos_of_x(:pw_grid_out%bounds(2, 1)-1) = pw_grid_in%para%pos_of_x - pos_of_x(pw_grid_out%bounds(2, 1)) = pos_of_x(pw_grid_out%bounds(2, 1)-1) + pos_of_x(:pw_grid_out%bounds(2, 1) - 1) = pw_grid_in%para%pos_of_x + pos_of_x(pw_grid_out%bounds(2, 1)) = pos_of_x(pw_grid_out%bounds(2, 1) - 1) pw_grid_out%para%pos_of_x => pos_of_x pw_grid_out%para%rs_dims = pw_grid_in%para%rs_dims IF (PRODUCT(pw_grid_in%para%rs_dims) /= 0) THEN diff --git a/src/qmmm_se_energy.F b/src/qmmm_se_energy.F index dff89133aa..5e14c5e549 100644 --- a/src/qmmm_se_energy.F +++ b/src/qmmm_se_energy.F @@ -310,7 +310,7 @@ SUBROUTINE build_se_qmmm_matrix_low(h_block_a, se_kind_a, se_kind_mm, potentials LoopMM: DO Imp = 1, SIZE(Pot%mm_atom_index) Imm = Pot%mm_atom_index(Imp) IndMM = mm_atom_index(Imm) - r_pbc = pbc(particles_mm(IndMM)%r-particles_qm(IndQM)%r, mm_cell) + r_pbc = pbc(particles_mm(IndMM)%r - particles_qm(IndQM)%r, mm_cell) rt1 = r_pbc(1) rt2 = r_pbc(2) rt3 = r_pbc(3) @@ -326,21 +326,21 @@ SUBROUTINE build_se_qmmm_matrix_low(h_block_a, se_kind_a, se_kind_mm, potentials se_int_control=se_int_control, se_taper=se_taper) CALL corecore(se_kind_a, se_kind_mm, rij, itype=itype, enuc=enuc, anag=anag, & se_int_control=se_int_control, se_taper=se_taper) - enuclear = enuclear+enuc + enuclear = enuclear + enuc ! Contribution to the iatom block ! Computation of the QMMM core matrix i2 = 0 DO i1L = 1, se_kind_a%natorb i1 = se_orbital_pointer(i1L) - DO j1L = 1, i1L-1 + DO j1L = 1, i1L - 1 j1 = se_orbital_pointer(j1L) - i2 = i2+1 - h_block_a(i1, j1) = h_block_a(i1, j1)+e1b(i2) + i2 = i2 + 1 + h_block_a(i1, j1) = h_block_a(i1, j1) + e1b(i2) h_block_a(j1, i1) = h_block_a(i1, j1) END DO j1 = se_orbital_pointer(j1L) - i2 = i2+1 - h_block_a(i1, j1) = h_block_a(i1, j1)+e1b(i2) + i2 = i2 + 1 + h_block_a(i1, j1) = h_block_a(i1, j1) + e1b(i2) END DO END DO LoopMM END DO MainLoopPot diff --git a/src/qmmm_se_forces.F b/src/qmmm_se_forces.F index 32950e3f25..8e82351cc7 100644 --- a/src/qmmm_se_forces.F +++ b/src/qmmm_se_forces.F @@ -153,7 +153,7 @@ SUBROUTINE deriv_se_qmmm_matrix(qs_env, qmmm_env, particles_mm, mm_cell, para_en natorb=natorb_a) IF (.NOT. defined .OR. natorb_a < 1) CYCLE Atoms: DO i = 1, SIZE(list) - iqm = iqm+1 + iqm = iqm + 1 iatom = list(i) ! Give back block NULLIFY (p_block_a) @@ -217,9 +217,9 @@ SUBROUTINE deriv_se_qmmm_matrix(qs_env, qmmm_env, particles_mm, mm_cell, para_en natorb=natorb_a) IF (.NOT. defined .OR. natorb_a < 1) CYCLE DO i = 1, SIZE(list) - iqm = iqm+1 + iqm = iqm + 1 iatom = qmmm_env%qm_atom_index(list(i)) - particles_mm(iatom)%f(:) = particles_mm(iatom)%f(:)+Forces_QM(:, iqm) + particles_mm(iatom)%f(:) = particles_mm(iatom)%f(:) + Forces_QM(:, iqm) END DO END DO ! MM forces will be handled directly from the QMMM module in the same way @@ -294,7 +294,7 @@ SUBROUTINE deriv_se_qmmm_matrix_low(p_block_a, se_kind_a, se_kind_mm, & LoopMM: DO Imp = 1, SIZE(Pot%mm_atom_index) Imm = Pot%mm_atom_index(Imp) IndMM = mm_atom_index(Imm) - r_pbc = pbc(particles_mm(IndMM)%r-particles_qm(IndQM)%r, mm_cell) + r_pbc = pbc(particles_mm(IndMM)%r - particles_qm(IndQM)%r, mm_cell) rt1 = r_pbc(1) rt2 = r_pbc(2) rt3 = r_pbc(3) @@ -319,19 +319,19 @@ SUBROUTINE deriv_se_qmmm_matrix_low(p_block_a, se_kind_a, se_kind_mm, & i2 = 0 DO i1L = 1, se_kind_a%natorb i1 = se_orbital_pointer(i1L) - DO j1L = 1, i1L-1 + DO j1L = 1, i1L - 1 j1 = se_orbital_pointer(j1L) - i2 = i2+1 - force_ab = force_ab-2.0_dp*de1b(:, i2)*p_block_a(i1, j1) + i2 = i2 + 1 + force_ab = force_ab - 2.0_dp*de1b(:, i2)*p_block_a(i1, j1) END DO j1 = se_orbital_pointer(j1L) - i2 = i2+1 - force_ab = force_ab-de1b(:, i2)*p_block_a(i1, j1) + i2 = i2 + 1 + force_ab = force_ab - de1b(:, i2)*p_block_a(i1, j1) END DO ! The array of QM forces are really the forces - forces_qm(:) = forces_qm(:)-force_ab + forces_qm(:) = forces_qm(:) - force_ab ! The one of MM atoms are instead gradients - forces(:, Imm) = forces(:, Imm)-force_ab + forces(:, Imm) = forces(:, Imm) - force_ab END DO LoopMM END DO MainLoopPot CALL timestop(handle) diff --git a/src/qmmm_tb_coulomb.F b/src/qmmm_tb_coulomb.F index 0a00833c8f..0cb517264d 100644 --- a/src/qmmm_tb_coulomb.F +++ b/src/qmmm_tb_coulomb.F @@ -152,28 +152,28 @@ SUBROUTINE build_tb_coulomb_qmqm(qs_env, ks_matrix, rho, mcharge, energy, & DO ikind = 1, SIZE(local_particles%n_el) DO ia = 1, local_particles%n_el(ikind) iatom = local_particles%list(ikind)%array(ia) - DO jatom = 1, iatom-1 - rij = particle_set(iatom)%r-particle_set(jatom)%r + DO jatom = 1, iatom - 1 + rij = particle_set(iatom)%r - particle_set(jatom)%r ! no pbc(rij,mm_cell) at this point, we assume that QM particles are ! inside QM box and QM box << MM box dr = SQRT(SUM(rij(:)**2)) ! local (unit cell) correction 1/R - gmcharge(iatom, 1) = gmcharge(iatom, 1)-mcharge(jatom)/dr - gmcharge(jatom, 1) = gmcharge(jatom, 1)-mcharge(iatom)/dr + gmcharge(iatom, 1) = gmcharge(iatom, 1) - mcharge(jatom)/dr + gmcharge(jatom, 1) = gmcharge(jatom, 1) - mcharge(iatom)/dr DO i = 2, nmat - gmcharge(iatom, i) = gmcharge(iatom, i)-rij(i-1)*mcharge(jatom)/dr**3 - gmcharge(jatom, i) = gmcharge(jatom, i)+rij(i-1)*mcharge(iatom)/dr**3 + gmcharge(iatom, i) = gmcharge(iatom, i) - rij(i - 1)*mcharge(jatom)/dr**3 + gmcharge(jatom, i) = gmcharge(jatom, i) + rij(i - 1)*mcharge(iatom)/dr**3 END DO ! overlap correction fr = erfc(alpha*dr)/dr - gmcharge(iatom, 1) = gmcharge(iatom, 1)+mcharge(jatom)*fr - gmcharge(jatom, 1) = gmcharge(jatom, 1)+mcharge(iatom)*fr + gmcharge(iatom, 1) = gmcharge(iatom, 1) + mcharge(jatom)*fr + gmcharge(jatom, 1) = gmcharge(jatom, 1) + mcharge(iatom)*fr IF (nmat > 1) THEN - dfr = -2._dp*alpha*EXP(-alpha*alpha*dr*dr)*oorootpi/dr-fr/dr + dfr = -2._dp*alpha*EXP(-alpha*alpha*dr*dr)*oorootpi/dr - fr/dr dfr = -dfr/dr DO i = 2, nmat - gmcharge(iatom, i) = gmcharge(iatom, i)-rij(i-1)*mcharge(jatom)*dfr - gmcharge(jatom, i) = gmcharge(jatom, i)+rij(i-1)*mcharge(iatom)*dfr + gmcharge(iatom, i) = gmcharge(iatom, i) - rij(i - 1)*mcharge(jatom)*dfr + gmcharge(jatom, i) = gmcharge(jatom, i) + rij(i - 1)*mcharge(iatom)*dfr END DO END IF END DO @@ -197,12 +197,12 @@ SUBROUTINE build_tb_coulomb_qmqm(qs_env, ks_matrix, rho, mcharge, energy, & CALL mp_sum(gmcharge(:, 1), para_env%group) ! ! add self charge interaction and background charge contribution - gmcharge(:, 1) = gmcharge(:, 1)-2._dp*alpha*oorootpi*mcharge(:) + gmcharge(:, 1) = gmcharge(:, 1) - 2._dp*alpha*oorootpi*mcharge(:) IF (ANY(periodic(:) == 1)) THEN - gmcharge(:, 1) = gmcharge(:, 1)-pi/alpha**2/deth + gmcharge(:, 1) = gmcharge(:, 1) - pi/alpha**2/deth END IF ! - energy%qmmm_el = energy%qmmm_el+0.5_dp*SUM(mcharge(:)*gmcharge(:, 1)) + energy%qmmm_el = energy%qmmm_el + 0.5_dp*SUM(mcharge(:)*gmcharge(:, 1)) ! IF (calculate_forces) THEN ALLOCATE (atom_of_kind(natom), kind_of(natom)) @@ -230,9 +230,9 @@ SUBROUTINE build_tb_coulomb_qmqm(qs_env, ks_matrix, rho, mcharge, energy, & END IF CALL dbcsr_get_block_p(matrix=matrix_s(1)%matrix, & row=iatom, col=jatom, block=sblock, found=found) - gmij = 0.5_dp*(gmcharge(iatom, 1)+gmcharge(jatom, 1)) - ksblock = ksblock-gmij*sblock - IF (SIZE(ks_matrix, 1) > 1) ksblock_2 = ksblock_2-gmij*sblock + gmij = 0.5_dp*(gmcharge(iatom, 1) + gmcharge(jatom, 1)) + ksblock = ksblock - gmij*sblock + IF (SIZE(ks_matrix, 1) > 1) ksblock_2 = ksblock_2 - gmij*sblock IF (calculate_forces) THEN ikind = kind_of(iatom) atom_i = atom_of_kind(iatom) @@ -243,11 +243,11 @@ SUBROUTINE build_tb_coulomb_qmqm(qs_env, ks_matrix, rho, mcharge, energy, & row=iatom, col=jatom, block=pblock, found=found) DO i = 1, 3 NULLIFY (dsblock) - CALL dbcsr_get_block_p(matrix=matrix_s(1+i)%matrix, & + CALL dbcsr_get_block_p(matrix=matrix_s(1 + i)%matrix, & row=iatom, col=jatom, block=dsblock, found=found) fi = -2.0_dp*gmij*SUM(pblock*dsblock) - force(ikind)%rho_elec(i, atom_i) = force(ikind)%rho_elec(i, atom_i)+fi - force(jkind)%rho_elec(i, atom_j) = force(jkind)%rho_elec(i, atom_j)-fi + force(ikind)%rho_elec(i, atom_i) = force(ikind)%rho_elec(i, atom_i) + fi + force(jkind)%rho_elec(i, atom_j) = force(jkind)%rho_elec(i, atom_j) - fi fij(i) = fi END DO END IF diff --git a/src/qmmm_tb_methods.F b/src/qmmm_tb_methods.F index a5ad00bb99..d63c64d7c5 100644 --- a/src/qmmm_tb_methods.F +++ b/src/qmmm_tb_methods.F @@ -199,7 +199,7 @@ SUBROUTINE build_tb_qmmm_matrix(qs_env, qmmm_env, particles_mm, mm_cell, para_en qmmm_env%spherical_cutoff, & particles_qm) END IF - pc_ener = pc_ener+qpot(iatom)*zeff + pc_ener = pc_ener + qpot(iatom)*zeff END DO END DO @@ -219,7 +219,7 @@ SUBROUTINE build_tb_qmmm_matrix(qs_env, qmmm_env, particles_mm, mm_cell, para_en CALL dbcsr_get_block_p(matrix=matrix_h(1)%matrix, & row=iatom, col=jatom, block=hblock, found=found) CPASSERT(found) - hblock = hblock-0.5_dp*sblock*(qpot(iatom)+qpot(jatom)) + hblock = hblock - 0.5_dp*sblock*(qpot(iatom) + qpot(jatom)) END DO CALL dbcsr_iterator_stop(iter) @@ -496,7 +496,7 @@ SUBROUTINE build_tb_qmmm_matrix_pc(qs_env, qmmm_env, particles_mm, mm_cell, para qmmm_env%added_charges%mm_atom_index, mm_cell, iatom, rcutoff, & particles_qm) END IF - pc_ener = pc_ener+qpot(iatom)*zeff + pc_ener = pc_ener + qpot(iatom)*zeff END DO END DO CASE (do_ewald_none) @@ -532,7 +532,7 @@ SUBROUTINE build_tb_qmmm_matrix_pc(qs_env, qmmm_env, particles_mm, mm_cell, para qmmm_env%spherical_cutoff, & particles_qm) END IF - pc_ener = pc_ener+qpot(iatom)*zeff + pc_ener = pc_ener + qpot(iatom)*zeff END DO END DO CASE DEFAULT @@ -555,7 +555,7 @@ SUBROUTINE build_tb_qmmm_matrix_pc(qs_env, qmmm_env, particles_mm, mm_cell, para CALL dbcsr_get_block_p(matrix=matrix_h(1)%matrix, & row=iatom, col=jatom, block=hblock, found=found) CPASSERT(found) - hblock = hblock-0.5_dp*sblock*(qpot(iatom)+qpot(jatom)) + hblock = hblock - 0.5_dp*sblock*(qpot(iatom) + qpot(jatom)) END DO CALL dbcsr_iterator_stop(iter) @@ -680,7 +680,7 @@ SUBROUTINE deriv_tb_qmmm_matrix(qs_env, qmmm_env, particles_mm, mm_cell, para_en END IF DO iatom = 1, natom atom_a = atomic_kind_set(ikind)%atom_list(iatom) - mcharge(atom_a) = zeff-SUM(charges(atom_a, 1:nspins)) + mcharge(atom_a) = zeff - SUM(charges(atom_a, 1:nspins)) END DO END DO DEALLOCATE (charges) @@ -707,7 +707,7 @@ SUBROUTINE deriv_tb_qmmm_matrix(qs_env, qmmm_env, particles_mm, mm_cell, para_en END IF DO i = 1, SIZE(list) iatom = list(i) - iqm = iqm+1 + iqm = iqm + 1 CALL build_mm_pot(qpot(iatom), 0, eta_a(0), qmmm_env%Potentials, particles_mm, & qmmm_env%mm_atom_chrg, qmmm_env%mm_atom_index, mm_cell, iatom, & qmmm_env%spherical_cutoff, particles_qm) @@ -746,9 +746,9 @@ SUBROUTINE deriv_tb_qmmm_matrix(qs_env, qmmm_env, particles_mm, mm_cell, para_en ! use all kinds END IF DO i = 1, SIZE(list) - iqm = iqm+1 + iqm = iqm + 1 iatom = qmmm_env%qm_atom_index(list(i)) - particles_mm(iatom)%f(:) = particles_mm(iatom)%f(:)+Forces_QM(:, iqm) + particles_mm(iatom)%f(:) = particles_mm(iatom)%f(:) + Forces_QM(:, iqm) END DO END DO @@ -765,19 +765,19 @@ SUBROUTINE deriv_tb_qmmm_matrix(qs_env, qmmm_env, particles_mm, mm_cell, para_en ! IF (iatom == jatom) CYCLE ! - gmij = -0.5_dp*(qpot(iatom)+qpot(jatom)) + gmij = -0.5_dp*(qpot(iatom) + qpot(jatom)) NULLIFY (pblock) CALL dbcsr_get_block_p(matrix=matrix_p(1)%matrix, & row=iatom, col=jatom, block=pblock, found=found) CPASSERT(found) DO i = 1, 3 NULLIFY (dsblock) - CALL dbcsr_get_block_p(matrix=matrix_s(1+i)%matrix, & + CALL dbcsr_get_block_p(matrix=matrix_s(1 + i)%matrix, & row=iatom, col=jatom, block=dsblock, found=found) CPASSERT(found) fi = -2.0_dp*gmij*SUM(pblock*dsblock) - Forces_QM(i, iatom) = Forces_QM(i, iatom)+fi - Forces_QM(i, jatom) = Forces_QM(i, jatom)-fi + Forces_QM(i, iatom) = Forces_QM(i, iatom) + fi + Forces_QM(i, jatom) = Forces_QM(i, jatom) - fi END DO END DO CALL dbcsr_iterator_stop(iter) @@ -794,7 +794,7 @@ SUBROUTINE deriv_tb_qmmm_matrix(qs_env, qmmm_env, particles_mm, mm_cell, para_en DO i = 1, SIZE(list) iqm = list(i) iatom = qmmm_env%qm_atom_index(iqm) - particles_mm(iatom)%f(:) = particles_mm(iatom)%f(:)+Forces_QM(:, iqm) + particles_mm(iatom)%f(:) = particles_mm(iatom)%f(:) + Forces_QM(:, iqm) END DO END DO ! @@ -923,7 +923,7 @@ SUBROUTINE deriv_tb_qmmm_matrix_pc(qs_env, qmmm_env, particles_mm, mm_cell, para END IF DO iatom = 1, natom atom_a = atomic_kind_set(ikind)%atom_list(iatom) - mcharge(atom_a) = zeff-SUM(charges(atom_a, 1:nspins)) + mcharge(atom_a) = zeff - SUM(charges(atom_a, 1:nspins)) END DO END DO DEALLOCATE (charges) @@ -986,7 +986,7 @@ SUBROUTINE deriv_tb_qmmm_matrix_pc(qs_env, qmmm_env, particles_mm, mm_cell, para CALL mp_sum(Forces_MM, para_env%group) DO Imp = 1, nmm Imm = Pot%mm_atom_index(Imp) - Forces(:, Imm) = Forces(:, Imm)-Forces_MM(:, Imp) + Forces(:, Imm) = Forces(:, Imm) - Forces_MM(:, Imp) END DO DEALLOCATE (Forces_MM) END DO @@ -1027,7 +1027,7 @@ SUBROUTINE deriv_tb_qmmm_matrix_pc(qs_env, qmmm_env, particles_mm, mm_cell, para CALL mp_sum(Forces_MM, para_env%group) DO Imp = 1, nmm Imm = Pot%mm_atom_index(Imp) - Forces_added_charges(:, Imm) = Forces_added_charges(:, Imm)-Forces_MM(:, Imp) + Forces_added_charges(:, Imm) = Forces_added_charges(:, Imm) - Forces_MM(:, Imp) END DO DEALLOCATE (Forces_MM) END DO @@ -1057,7 +1057,7 @@ SUBROUTINE deriv_tb_qmmm_matrix_pc(qs_env, qmmm_env, particles_mm, mm_cell, para END IF DO i = 1, SIZE(list) iatom = list(i) - iqm = iqm+1 + iqm = iqm + 1 CALL build_mm_pot(qpot(iatom), 1, eta_a(0), qmmm_env%Potentials, particles_mm, & qmmm_env%mm_atom_chrg, qmmm_env%mm_atom_index, & mm_cell, iatom, rcutoff, particles_qm) @@ -1119,7 +1119,7 @@ SUBROUTINE deriv_tb_qmmm_matrix_pc(qs_env, qmmm_env, particles_mm, mm_cell, para END IF DO i = 1, SIZE(list) iatom = list(i) - iqm = iqm+1 + iqm = iqm + 1 CALL build_mm_pot(qpot(iatom), 0, eta_a(0), qmmm_env%Potentials, particles_mm, & qmmm_env%mm_atom_chrg, qmmm_env%mm_atom_index, mm_cell, iatom, & qmmm_env%spherical_cutoff, particles_qm) @@ -1161,9 +1161,9 @@ SUBROUTINE deriv_tb_qmmm_matrix_pc(qs_env, qmmm_env, particles_mm, mm_cell, para ! END IF DO i = 1, SIZE(list) - iqm = iqm+1 + iqm = iqm + 1 iatom = qmmm_env%qm_atom_index(list(i)) - particles_mm(iatom)%f(:) = particles_mm(iatom)%f(:)+Forces_QM(:, iqm) + particles_mm(iatom)%f(:) = particles_mm(iatom)%f(:) + Forces_QM(:, iqm) END DO END DO @@ -1180,19 +1180,19 @@ SUBROUTINE deriv_tb_qmmm_matrix_pc(qs_env, qmmm_env, particles_mm, mm_cell, para ! IF (iatom == jatom) CYCLE ! - gmij = -0.5_dp*(qpot(iatom)+qpot(jatom)) + gmij = -0.5_dp*(qpot(iatom) + qpot(jatom)) NULLIFY (pblock) CALL dbcsr_get_block_p(matrix=matrix_p(1)%matrix, & row=iatom, col=jatom, block=pblock, found=found) CPASSERT(found) DO i = 1, 3 NULLIFY (dsblock) - CALL dbcsr_get_block_p(matrix=matrix_s(1+i)%matrix, & + CALL dbcsr_get_block_p(matrix=matrix_s(1 + i)%matrix, & row=iatom, col=jatom, block=dsblock, found=found) CPASSERT(found) fi = -2.0_dp*gmij*SUM(pblock*dsblock) - Forces_QM(i, iatom) = Forces_QM(i, iatom)+fi - Forces_QM(i, jatom) = Forces_QM(i, jatom)-fi + Forces_QM(i, iatom) = Forces_QM(i, iatom) + fi + Forces_QM(i, jatom) = Forces_QM(i, jatom) - fi END DO END DO CALL dbcsr_iterator_stop(iter) @@ -1209,7 +1209,7 @@ SUBROUTINE deriv_tb_qmmm_matrix_pc(qs_env, qmmm_env, particles_mm, mm_cell, para DO i = 1, SIZE(list) iqm = list(i) iatom = qmmm_env%qm_atom_index(iqm) - particles_mm(iatom)%f(:) = particles_mm(iatom)%f(:)+Forces_QM(:, iqm) + particles_mm(iatom)%f(:) = particles_mm(iatom)%f(:) + Forces_QM(:, iqm) END DO END DO ! @@ -1280,7 +1280,7 @@ SUBROUTINE build_mm_pot(qpot, pot_type, qm_alpha, potentials, & LoopMM: DO Imp = 1, SIZE(Pot%mm_atom_index) Imm = Pot%mm_atom_index(Imp) IndMM = mm_atom_index(Imm) - r_pbc = pbc(particles_mm(IndMM)%r-particles_qm(IndQM)%r, mm_cell) + r_pbc = pbc(particles_mm(IndMM)%r - particles_qm(IndQM)%r, mm_cell) rt1 = r_pbc(1) rt2 = r_pbc(2) rt3 = r_pbc(3) @@ -1296,13 +1296,13 @@ SUBROUTINE build_mm_pot(qpot, pot_type, qm_alpha, potentials, & IF (dr > rtiny) THEN IF (pot_type == 0) THEN sr = gamma_rab_sr(dr, qm_alpha, eta_mm, 0.0_dp) - qpot = qpot+qeff*(1.0_dp/dr-sr) + qpot = qpot + qeff*(1.0_dp/dr - sr) ELSE IF (pot_type == 1) THEN sr = gamma_rab_sr(dr, qm_alpha, eta_mm, 0.0_dp) - qpot = qpot-qeff*sr + qpot = qpot - qeff*sr ELSE IF (pot_type == 2) THEN sr = erfc(qm_alpha*dr)/dr - qpot = qpot+qeff*sr + qpot = qpot + qeff*sr ELSE CPABORT("") END IF @@ -1364,7 +1364,7 @@ SUBROUTINE build_mm_dpot(qcharge, pot_type, qm_alpha, potentials, & LoopMM: DO Imp = 1, SIZE(Pot%mm_atom_index) Imm = Pot%mm_atom_index(Imp) IndMM = mm_atom_index(Imm) - r_pbc = pbc(particles_mm(IndMM)%r-particles_qm(IndQM)%r, mm_cell) + r_pbc = pbc(particles_mm(IndMM)%r - particles_qm(IndQM)%r, mm_cell) rt1 = r_pbc(1) rt2 = r_pbc(2) rt3 = r_pbc(3) @@ -1379,18 +1379,18 @@ SUBROUTINE build_mm_dpot(qcharge, pot_type, qm_alpha, potentials, & END IF IF (ABS(qeff) <= qsmall) CYCLE IF (dr > rtiny) THEN - drp = dr+ddrmm - drm = dr-ddrmm + drp = dr + ddrmm + drm = dr - ddrmm IF (pot_type == 0) THEN - dsr = 0.5_dp*(gamma_rab_sr(drp, qm_alpha, eta_mm, 0.0_dp)- & + dsr = 0.5_dp*(gamma_rab_sr(drp, qm_alpha, eta_mm, 0.0_dp) - & gamma_rab_sr(drm, qm_alpha, eta_mm, 0.0_dp))/ddrmm - fsr = qeff*qcharge*(-1.0_dp/(dr*dr)-dsr) + fsr = qeff*qcharge*(-1.0_dp/(dr*dr) - dsr) ELSE IF (pot_type == 1) THEN - dsr = 0.5_dp*(gamma_rab_sr(drp, qm_alpha, eta_mm, 0.0_dp)- & + dsr = 0.5_dp*(gamma_rab_sr(drp, qm_alpha, eta_mm, 0.0_dp) - & gamma_rab_sr(drm, qm_alpha, eta_mm, 0.0_dp))/ddrmm fsr = -qeff*qcharge*dsr ELSE IF (pot_type == 2) THEN - dsr = 0.5_dp*(erfc(qm_alpha*drp)/drp-erfc(qm_alpha*drm)/drm)/ddrmm + dsr = 0.5_dp*(erfc(qm_alpha*drp)/drp - erfc(qm_alpha*drm)/drm)/ddrmm fsr = qeff*qcharge*dsr ELSE CPABORT("") @@ -1400,9 +1400,9 @@ SUBROUTINE build_mm_dpot(qcharge, pot_type, qm_alpha, potentials, & force_ab = 0.0_dp END IF ! The array of QM forces are really the forces - forces_qm(:) = forces_qm(:)-force_ab + forces_qm(:) = forces_qm(:) - force_ab ! The one of MM atoms are instead gradients - forces(:, Imm) = forces(:, Imm)-force_ab + forces(:, Imm) = forces(:, Imm) - force_ab END DO LoopMM END DO MainLoopPot diff --git a/src/qmmm_topology_util.F b/src/qmmm_topology_util.F index c4f1a05289..4b8d45e04d 100644 --- a/src/qmmm_topology_util.F +++ b/src/qmmm_topology_util.F @@ -140,7 +140,7 @@ SUBROUTINE qmmm_connectivity_control(molecule_set, & CALL get_molecule(molecule, molecule_kind=molecule_kind, & first_atom=first_atom, last_atom=last_atom) IF (ANY(qm_atom_index >= first_atom .AND. qm_atom_index <= last_atom)) & - qm_mol_num = qm_mol_num+1 + qm_mol_num = qm_mol_num + 1 END DO ! ALLOCATE (qm_molecule_index(qm_mol_num)) @@ -150,9 +150,9 @@ SUBROUTINE qmmm_connectivity_control(molecule_set, & molecule => molecule_set(imolecule) CALL get_molecule(molecule, molecule_kind=molecule_kind, & first_atom=first_atom, last_atom=last_atom) - natom = last_atom-first_atom+1 + natom = last_atom - first_atom + 1 IF (ANY(qm_atom_index >= first_atom .AND. qm_atom_index <= last_atom)) THEN - qm_mol_num = qm_mol_num+1 + qm_mol_num = qm_mol_num + 1 ! ! Check if all atoms of the molecule are QM or if a QM/MM link scheme ! need to be used... diff --git a/src/qmmm_types.F b/src/qmmm_types.F index f7bea8532a..7b32cd7d02 100644 --- a/src/qmmm_types.F +++ b/src/qmmm_types.F @@ -72,7 +72,7 @@ SUBROUTINE qmmm_env_get(qmmm_env, subsys, potential_energy, kinetic_energy) ! for conventional QM/MM, and force-mixing knows to put relevant energy there. CALL fist_env_get(qmmm_env%fist_env, thermo=thermo) CALL get_qs_env(qmmm_env%qs_env, energy=qs_energy) - potential_energy = thermo%pot+qs_energy%total + potential_energy = thermo%pot + qs_energy%total ENDIF END SUBROUTINE qmmm_env_get @@ -89,7 +89,7 @@ SUBROUTINE qmmm_env_release(qmmm_env) IF (ASSOCIATED(qmmm_env)) THEN CPASSERT(qmmm_env%ref_count > 0) - qmmm_env%ref_count = qmmm_env%ref_count-1 + qmmm_env%ref_count = qmmm_env%ref_count - 1 IF (qmmm_env%ref_count == 0) THEN CALL qs_env_release(qmmm_env%qs_env) CALL qmmm_env_qm_release(qmmm_env%qm) @@ -113,7 +113,7 @@ SUBROUTINE qmmm_env_retain(qmmm_env) CPASSERT(ASSOCIATED(qmmm_env)) CPASSERT(qmmm_env%ref_count > 0) - qmmm_env%ref_count = qmmm_env%ref_count+1 + qmmm_env%ref_count = qmmm_env%ref_count + 1 END SUBROUTINE qmmm_env_retain END MODULE qmmm_types diff --git a/src/qmmm_types_low.F b/src/qmmm_types_low.F index 65a3b13249..d81945d582 100644 --- a/src/qmmm_types_low.F +++ b/src/qmmm_types_low.F @@ -266,7 +266,7 @@ SUBROUTINE qmmm_env_mm_create(qmmm_env) CPASSERT(.NOT. ASSOCIATED(qmmm_env)) ALLOCATE (qmmm_env) qmmm_env%ref_count = 1 - last_qmmm_env_id_nr = last_qmmm_env_id_nr+1 + last_qmmm_env_id_nr = last_qmmm_env_id_nr + 1 qmmm_env%id_nr = last_qmmm_env_id_nr NULLIFY (qmmm_env%qm_atom_index, & qmmm_env%qm_molecule_index, & @@ -294,7 +294,7 @@ SUBROUTINE qmmm_env_mm_retain(qmmm_env) CPASSERT(ASSOCIATED(qmmm_env)) CPASSERT(qmmm_env%ref_count > 0) - qmmm_env%ref_count = qmmm_env%ref_count+1 + qmmm_env%ref_count = qmmm_env%ref_count + 1 END SUBROUTINE qmmm_env_mm_retain ! ************************************************************************************************** @@ -311,7 +311,7 @@ SUBROUTINE qmmm_env_mm_release(qmmm_env) IF (ASSOCIATED(qmmm_env)) THEN CPASSERT(qmmm_env%ref_count > 0) - qmmm_env%ref_count = qmmm_env%ref_count-1 + qmmm_env%ref_count = qmmm_env%ref_count - 1 IF (qmmm_env%ref_count == 0) THEN IF (ASSOCIATED(qmmm_env%qm_atom_index)) THEN DEALLOCATE (qmmm_env%qm_atom_index) @@ -353,7 +353,7 @@ SUBROUTINE qmmm_env_qm_create(qmmm_env) CPASSERT(.NOT. ASSOCIATED(qmmm_env)) ALLOCATE (qmmm_env) qmmm_env%ref_count = 1 - last_qmmm_env_id_nr = last_qmmm_env_id_nr+1 + last_qmmm_env_id_nr = last_qmmm_env_id_nr + 1 qmmm_env%id_nr = last_qmmm_env_id_nr NULLIFY (qmmm_env%qm_atom_index, qmmm_env%mm_link_atoms, & qmmm_env%mm_atom_index, qmmm_env%mm_atom_chrg, & @@ -400,7 +400,7 @@ SUBROUTINE qmmm_env_qm_release(qmmm_env) IF (ASSOCIATED(qmmm_env)) THEN CPASSERT(qmmm_env%ref_count > 0) - qmmm_env%ref_count = qmmm_env%ref_count-1 + qmmm_env%ref_count = qmmm_env%ref_count - 1 IF (qmmm_env%ref_count == 0) THEN IF (ASSOCIATED(qmmm_env%qm_atom_index)) THEN DEALLOCATE (qmmm_env%qm_atom_index) diff --git a/src/qmmm_util.F b/src/qmmm_util.F index 9372241a64..28e75e9d4a 100644 --- a/src/qmmm_util.F +++ b/src/qmmm_util.F @@ -154,16 +154,16 @@ SUBROUTINE apply_qmmm_walls_reflective(force_env) DO ip = 1, SIZE(qm_atom_index) qm_index = qm_atom_index(ip) coord = particles_mm(qm_index)%r - IF (ANY(coord < skin) .OR. ANY(coord > (qm_cell_diag-skin))) THEN + IF (ANY(coord < skin) .OR. ANY(coord > (qm_cell_diag - skin))) THEN IF (explicit) THEN IF (iwall_type == do_qmmm_wall_reflective) THEN ! Apply Walls is_x(1) = (coord(1) < skin(1)) - is_x(2) = (coord(1) > (qm_cell_diag(1)-skin(1))) + is_x(2) = (coord(1) > (qm_cell_diag(1) - skin(1))) is_y(1) = (coord(2) < skin(2)) - is_y(2) = (coord(2) > (qm_cell_diag(2)-skin(2))) + is_y(2) = (coord(2) > (qm_cell_diag(2) - skin(2))) is_z(1) = (coord(3) < skin(3)) - is_z(2) = (coord(3) > (qm_cell_diag(3)-skin(3))) + is_z(2) = (coord(3) > (qm_cell_diag(3) - skin(3))) IF (ANY(is_x)) THEN ! X coordinate IF (is_x(1)) THEN @@ -251,57 +251,57 @@ SUBROUTINE apply_qmmm_walls_quadratic(qmmm_env, walls_section) DO ip = 1, SIZE(qm_atom_index) qm_index = qm_atom_index(ip) coord = particles_mm(qm_index)%r - IF (ANY(coord < skin) .OR. ANY(coord > (qm_cell_diag-skin))) THEN + IF (ANY(coord < skin) .OR. ANY(coord > (qm_cell_diag - skin))) THEN is_x(1) = (coord(1) < skin(1)) - is_x(2) = (coord(1) > (qm_cell_diag(1)-skin(1))) + is_x(2) = (coord(1) > (qm_cell_diag(1) - skin(1))) is_y(1) = (coord(2) < skin(2)) - is_y(2) = (coord(2) > (qm_cell_diag(2)-skin(2))) + is_y(2) = (coord(2) > (qm_cell_diag(2) - skin(2))) is_z(1) = (coord(3) < skin(3)) - is_z(2) = (coord(3) > (qm_cell_diag(3)-skin(3))) + is_z(2) = (coord(3) > (qm_cell_diag(3) - skin(3))) IF (is_x(1)) THEN - wallforce = 2.0_dp*k*(skin(1)-coord(1)) - particles_mm(qm_index)%f(1) = particles_mm(qm_index)%f(1)+ & + wallforce = 2.0_dp*k*(skin(1) - coord(1)) + particles_mm(qm_index)%f(1) = particles_mm(qm_index)%f(1) + & wallforce - wallenergy = wallenergy+wallforce*(skin(1)-coord(1))*0.5_dp + wallenergy = wallenergy + wallforce*(skin(1) - coord(1))*0.5_dp ENDIF IF (is_x(2)) THEN - wallforce = 2.0_dp*k*((qm_cell_diag(1)-skin(1))-coord(1)) - particles_mm(qm_index)%f(1) = particles_mm(qm_index)%f(1)+ & + wallforce = 2.0_dp*k*((qm_cell_diag(1) - skin(1)) - coord(1)) + particles_mm(qm_index)%f(1) = particles_mm(qm_index)%f(1) + & wallforce - wallenergy = wallenergy+wallforce*((qm_cell_diag(1)-skin(1))- & - coord(1))*0.5_dp + wallenergy = wallenergy + wallforce*((qm_cell_diag(1) - skin(1)) - & + coord(1))*0.5_dp ENDIF IF (is_y(1)) THEN - wallforce = 2.0_dp*k*(skin(2)-coord(2)) - particles_mm(qm_index)%f(2) = particles_mm(qm_index)%f(2)+ & + wallforce = 2.0_dp*k*(skin(2) - coord(2)) + particles_mm(qm_index)%f(2) = particles_mm(qm_index)%f(2) + & wallforce - wallenergy = wallenergy+wallforce*(skin(2)-coord(2))*0.5_dp + wallenergy = wallenergy + wallforce*(skin(2) - coord(2))*0.5_dp ENDIF IF (is_y(2)) THEN - wallforce = 2.0_dp*k*((qm_cell_diag(2)-skin(2))-coord(2)) - particles_mm(qm_index)%f(2) = particles_mm(qm_index)%f(2)+ & + wallforce = 2.0_dp*k*((qm_cell_diag(2) - skin(2)) - coord(2)) + particles_mm(qm_index)%f(2) = particles_mm(qm_index)%f(2) + & wallforce - wallenergy = wallenergy+wallforce*((qm_cell_diag(2)-skin(2))- & - coord(2))*0.5_dp + wallenergy = wallenergy + wallforce*((qm_cell_diag(2) - skin(2)) - & + coord(2))*0.5_dp ENDIF IF (is_z(1)) THEN - wallforce = 2.0_dp*k*(skin(3)-coord(3)) - particles_mm(qm_index)%f(3) = particles_mm(qm_index)%f(3)+ & + wallforce = 2.0_dp*k*(skin(3) - coord(3)) + particles_mm(qm_index)%f(3) = particles_mm(qm_index)%f(3) + & wallforce - wallenergy = wallenergy+wallforce*(skin(3)-coord(3))*0.5_dp + wallenergy = wallenergy + wallforce*(skin(3) - coord(3))*0.5_dp ENDIF IF (is_z(2)) THEN - wallforce = 2.0_dp*k*((qm_cell_diag(3)-skin(3))-coord(3)) - particles_mm(qm_index)%f(3) = particles_mm(qm_index)%f(3)+ & + wallforce = 2.0_dp*k*((qm_cell_diag(3) - skin(3)) - coord(3)) + particles_mm(qm_index)%f(3) = particles_mm(qm_index)%f(3) + & wallforce - wallenergy = wallenergy+wallforce*((qm_cell_diag(3)-skin(3))- & - coord(3))*0.5_dp + wallenergy = wallenergy + wallforce*((qm_cell_diag(3) - skin(3)) - & + coord(3))*0.5_dp ENDIF ENDIF ENDDO CALL get_qs_env(qs_env=qmmm_env%qs_env, energy=energy) - energy%total = energy%total+wallenergy + energy%total = energy%total + wallenergy END SUBROUTINE apply_qmmm_walls_quadratic @@ -335,7 +335,7 @@ SUBROUTINE apply_qmmm_wrap(subsys_mm, mm_cell, subsys_qm, qm_atom_index, saved_p r_lat(i_dim) = 0.0_dp END IF END DO - subsys_mm%particles%els(ip)%r = subsys_mm%particles%els(ip)%r-MATMUL(mm_cell%hmat, FLOOR(r_lat)) + subsys_mm%particles%els(ip)%r = subsys_mm%particles%els(ip)%r - MATMUL(mm_cell%hmat, FLOOR(r_lat)) END DO IF (PRESENT(subsys_qm) .AND. PRESENT(qm_atom_index)) THEN @@ -474,10 +474,10 @@ SUBROUTINE apply_qmmm_translate(qmmm_env) END DO ! find min and max coordinates in lattice positions (i_dim ! only) lat_dv3 = qmmm_lat_dv(mm_cell, particles_mm(qm_atom_index(min_ip))%r, particles_mm(qm_atom_index(max_ip))%r) - IF (lat_dv3(i_dim) < 0.0_dp) lat_dv3(i_dim) = lat_dv3(i_dim)+1.0_dp + IF (lat_dv3(i_dim) < 0.0_dp) lat_dv3(i_dim) = lat_dv3(i_dim) + 1.0_dp lat_min = MATMUL(mm_cell%h_inv, particles_mm(qm_atom_index(min_ip))%r) min_coord_lat(i_dim) = lat_min(i_dim) - max_coord_lat(i_dim) = lat_min(i_dim)+lat_dv3(i_dim) + max_coord_lat(i_dim) = lat_min(i_dim) + lat_dv3(i_dim) END IF ! periodic END DO ! i_dim ! min and max coordinates from lattice positions to Cartesian @@ -485,27 +485,27 @@ SUBROUTINE apply_qmmm_translate(qmmm_env) max_coord = MATMUL(mm_cell%hmat, max_coord_lat) DEALLOCATE (avoid) END IF ! pbc aware center - transl_v = (max_coord+min_coord)/2.0_dp + transl_v = (max_coord + min_coord)/2.0_dp ! ! The first time we always translate all the system in order ! to centre the QM system in the box. ! - transl_v(:) = transl_v(:)-SUM(qm_cell%hmat, 2)/2.0_dp + transl_v(:) = transl_v(:) - SUM(qm_cell%hmat, 2)/2.0_dp IF (ANY(qmmm_env%qm%utrasl /= 1.0_dp)) THEN transl_v = REAL(FLOOR(transl_v/qmmm_env%qm%utrasl), KIND=dp)* & qmmm_env%qm%utrasl END IF - qmmm_env%qm%transl_v = qmmm_env%qm%transl_v+transl_v + qmmm_env%qm%transl_v = qmmm_env%qm%transl_v + transl_v particles_mm => subsys_mm%particles%els DO ip = 1, subsys_mm%particles%n_els - particles_mm(ip)%r = particles_mm(ip)%r-transl_v + particles_mm(ip)%r = particles_mm(ip)%r - transl_v END DO IF (qmmm_env%qm%added_shells%num_mm_atoms .GT. 0) THEN DO ip = 1, qmmm_env%qm%added_shells%num_mm_atoms - qmmm_env%qm%added_shells%added_particles(ip)%r = qmmm_env%qm%added_shells%added_particles(ip)%r-transl_v - qmmm_env%qm%added_shells%added_cores(ip)%r = qmmm_env%qm%added_shells%added_cores(ip)%r-transl_v + qmmm_env%qm%added_shells%added_particles(ip)%r = qmmm_env%qm%added_shells%added_particles(ip)%r - transl_v + qmmm_env%qm%added_shells%added_cores(ip)%r = qmmm_env%qm%added_shells%added_cores(ip)%r - transl_v END DO END IF unit_nr = cp_logger_get_default_io_unit() @@ -547,8 +547,8 @@ FUNCTION qmmm_pbc_aware_mean(particles_mm, mm_cell, qm_atom_index) mean_z = 0.0_dp DO ip = 1, SIZE(qm_atom_index) - mean_z = mean_z+EXP(CMPLX(0.0_dp, 1.0_dp, KIND=dp)*2.0*pi* & - MATMUL(mm_cell%h_inv, particles_mm(qm_atom_index(ip))%r)) + mean_z = mean_z + EXP(CMPLX(0.0_dp, 1.0_dp, KIND=dp)*2.0*pi* & + MATMUL(mm_cell%h_inv, particles_mm(qm_atom_index(ip))%r)) END DO mean_z = mean_z/ABS(mean_z) qmmm_pbc_aware_mean = MATMUL(mm_cell%hmat, & @@ -571,8 +571,8 @@ FUNCTION qmmm_lat_dv(mm_cell, p1, p2) lat_v1 = MATMUL(mm_cell%h_inv, p1) lat_v2 = MATMUL(mm_cell%h_inv, p2) - qmmm_lat_dv = lat_v2-lat_v1 - qmmm_lat_dv = qmmm_lat_dv-FLOOR(qmmm_lat_dv) + qmmm_lat_dv = lat_v2 - lat_v1 + qmmm_lat_dv = qmmm_lat_dv - FLOOR(qmmm_lat_dv) END FUNCTION qmmm_lat_dv ! ************************************************************************************************** @@ -607,7 +607,7 @@ FUNCTION qmmm_find_closest(particles_mm, mm_cell, qm_atom_index, avoid, p, i_dim IF (avoid(ip)) CYCLE lat_dv3 = qmmm_lat_dv(mm_cell, p, particles_mm(qm_atom_index(ip))%r) DO shift = -1, 1 - lat_dv_shifted = lat_dv3(i_dim)+shift*1.0_dp + lat_dv_shifted = lat_dv3(i_dim) + shift*1.0_dp IF (ABS(lat_dv_shifted) < ABS(my_closest_dv) .AND. (dir*lat_dv_shifted >= 0.0)) THEN my_closest_dv = lat_dv_shifted closest_ip = ip @@ -641,8 +641,8 @@ SUBROUTINE spherical_cutoff_factor(spherical_cutoff, rij, factor) REAL(KIND=dp) :: r, r0 r = SQRT(DOT_PRODUCT(rij, rij)) - r0 = spherical_cutoff(1)-20.0_dp*spherical_cutoff(2) - factor = 0.5_dp*(1.0_dp-TANH((r-r0)/spherical_cutoff(2))) + r0 = spherical_cutoff(1) - 20.0_dp*spherical_cutoff(2) + factor = 0.5_dp*(1.0_dp - TANH((r - r0)/spherical_cutoff(2))) END SUBROUTINE spherical_cutoff_factor diff --git a/src/qmmmx_force.F b/src/qmmmx_force.F index 99a0267efa..243b27eb0b 100644 --- a/src/qmmmx_force.F +++ b/src/qmmmx_force.F @@ -129,26 +129,26 @@ SUBROUTINE qmmmx_calc_energy_force(qmmmx_env, calc_force, consistent_energies, l total_f = 0.0_dp DO ip = 1, SIZE(particles_qmmm_core) - total_f(1:3) = total_f(1:3)+particles_qmmm_core(ip)%f(1:3) + total_f(1:3) = total_f(1:3) + particles_qmmm_core(ip)%f(1:3) END DO IF (mom_conserv_type == do_fm_mom_conserv_equal_f) THEN mom_conserv_n = COUNT(cur_labels >= mom_conserv_min_label) delta_f = total_f/mom_conserv_n DO ip = 1, SIZE(cur_indices) IF (cur_labels(ip) >= mom_conserv_min_label) THEN - particles_qmmm_core(cur_indices(ip))%f = particles_qmmm_core(cur_indices(ip))%f-delta_f + particles_qmmm_core(cur_indices(ip))%f = particles_qmmm_core(cur_indices(ip))%f - delta_f ENDIF END DO ELSE IF (mom_conserv_type == do_fm_mom_conserv_equal_a) THEN mom_conserv_mass = 0.0_dp DO ip = 1, SIZE(cur_indices) IF (cur_labels(ip) >= mom_conserv_min_label) & - mom_conserv_mass = mom_conserv_mass+particles_qmmm_core(cur_indices(ip))%atomic_kind%mass + mom_conserv_mass = mom_conserv_mass + particles_qmmm_core(cur_indices(ip))%atomic_kind%mass END DO delta_a = total_f/mom_conserv_mass DO ip = 1, SIZE(cur_indices) IF (cur_labels(ip) >= mom_conserv_min_label) THEN - particles_qmmm_core(cur_indices(ip))%f = particles_qmmm_core(cur_indices(ip))%f- & + particles_qmmm_core(cur_indices(ip))%f = particles_qmmm_core(cur_indices(ip))%f - & particles_qmmm_core(cur_indices(ip))%atomic_kind%mass*delta_a ENDIF END DO diff --git a/src/qmmmx_types.F b/src/qmmmx_types.F index ae71ef2ee5..1452fa2f83 100644 --- a/src/qmmmx_types.F +++ b/src/qmmmx_types.F @@ -69,7 +69,7 @@ SUBROUTINE qmmmx_env_retain(qmmmx_env) CPASSERT(ASSOCIATED(qmmmx_env)) CPASSERT(qmmmx_env%ref_count > 0) - qmmmx_env%ref_count = qmmmx_env%ref_count+1 + qmmmx_env%ref_count = qmmmx_env%ref_count + 1 END SUBROUTINE qmmmx_env_retain ! ************************************************************************************************** @@ -85,7 +85,7 @@ SUBROUTINE qmmmx_env_release(qmmmx_env) IF (ASSOCIATED(qmmmx_env)) THEN CPASSERT(qmmmx_env%ref_count > 0) - qmmmx_env%ref_count = qmmmx_env%ref_count-1 + qmmmx_env%ref_count = qmmmx_env%ref_count - 1 IF (qmmmx_env%ref_count == 0) THEN CALL qmmm_env_release(qmmmx_env%core) CALL qmmm_env_release(qmmmx_env%ext) diff --git a/src/qmmmx_update.F b/src/qmmmx_update.F index af20d494f2..4ef6eefe80 100644 --- a/src/qmmmx_update.F +++ b/src/qmmmx_update.F @@ -159,11 +159,11 @@ SUBROUTINE copy_wiener_process(from_local_particle_kinds, from_local_particles, ! make sure total number of particles hasn't changed, even if particle kinds have tot_from_nparticle_local = 0 DO from_iparticle_kind = 1, from_nparticle_kind - tot_from_nparticle_local = tot_from_nparticle_local+from_local_particles%n_el(from_iparticle_kind) + tot_from_nparticle_local = tot_from_nparticle_local + from_local_particles%n_el(from_iparticle_kind) END DO tot_to_nparticle_local = 0 DO to_iparticle_kind = 1, to_nparticle_kind - tot_to_nparticle_local = tot_to_nparticle_local+to_local_particles%n_el(to_iparticle_kind) + tot_to_nparticle_local = tot_to_nparticle_local + to_local_particles%n_el(to_iparticle_kind) END DO CPASSERT(tot_from_nparticle_local == tot_to_nparticle_local) @@ -181,10 +181,10 @@ SUBROUTINE copy_wiener_process(from_local_particle_kinds, from_local_particles, ! find the matching kind/index where this particle was before DO from_iparticle_kind = 1, from_nparticle_kind from_nparticle_local = from_local_particles%n_el(from_iparticle_kind) - IF (MINVAL(ABS(from_local_particles%list(from_iparticle_kind)%array(1:from_nparticle_local)- & + IF (MINVAL(ABS(from_local_particles%list(from_iparticle_kind)%array(1:from_nparticle_local) - & to_iparticle_global)) == 0) THEN from_iparticle_local = & - MINLOC(ABS(from_local_particles%list(from_iparticle_kind)%array(1:from_nparticle_local)- & + MINLOC(ABS(from_local_particles%list(from_iparticle_kind)%array(1:from_nparticle_local) - & to_iparticle_global)) to_local_particles%local_particle_set(to_iparticle_kind)%rng(to_iparticle_local)%stream = & from_local_particles%local_particle_set(from_iparticle_kind)%rng(from_iparticle_local(1))%stream diff --git a/src/qmmmx_util.F b/src/qmmmx_util.F index fd1303407e..373210cc09 100644 --- a/src/qmmmx_util.F +++ b/src/qmmmx_util.F @@ -390,13 +390,13 @@ SUBROUTINE add_new_label(ip, label, n_new, new_indices, new_labels, new_full_lab "already set, but not in new_indices array") new_labels(old_index) = label ELSE - n_new = n_new+1 + n_new = n_new + 1 IF (n_new > max_n_qm) & CALL cp_abort(__LOCATION__, & "add_new_label tried to add more atoms "// & "than allowed by &FORCE_MIXING&MAX_N_QM!") - IF (n_new > SIZE(new_indices)) CALL reallocate(new_indices, 1, n_new+9) - IF (n_new > SIZE(new_labels)) CALL reallocate(new_labels, 1, n_new+9) + IF (n_new > SIZE(new_indices)) CALL reallocate(new_indices, 1, n_new + 9) + IF (n_new > SIZE(new_labels)) CALL reallocate(new_labels, 1, n_new + 9) new_indices(n_new) = ip new_labels(n_new) = label ENDIF @@ -471,7 +471,7 @@ SUBROUTINE add_layer_hysteretically(nlist, particle_set, cell, nearest_dist, & j_outside_new_seed = (new_full_labels(j_ind) < seed_min_label_val) IF ((i_in_new_seed .AND. j_outside_new_seed) .OR. (j_in_new_seed .AND. i_outside_new_seed)) THEN - r_ij = pbc(particle_set(i_ind)%r-particle_set(j_ind)%r, cell) + r_ij = pbc(particle_set(i_ind)%r - particle_set(j_ind)%r, cell) r_ij_mag = SQRT(SUM(r_ij**2)) IF (i_in_new_seed .AND. j_outside_new_seed .AND. (r_ij_mag < nearest_dist(j_ind))) THEN nearest_dist(j_ind) = r_ij_mag @@ -710,14 +710,14 @@ SUBROUTINE setup_force_mixing_qmmm_sections(subsys, qmmm_section, qmmm_core_sect cur_labels(ip) /= force_mixing_label_termination) THEN qm_kind_section => section_vals_get_subs_vals3(qmmm_extended_section, "QM_KIND") IF (new_element_extended) THEN ! add new QM_KIND section for this element - i_rep_section_extended = i_rep_section_extended+1 + i_rep_section_extended = i_rep_section_extended + 1 CALL section_vals_add_values(qm_kind_section) CALL section_vals_val_set(qm_kind_section, "_SECTION_PARAMETERS_", i_rep_section=i_rep_section_extended, & c_val=elem_mapping(2, ielem)) i_rep_val_extended = 0 new_element_extended = .FALSE. ENDIF - i_rep_val_extended = i_rep_val_extended+1 + i_rep_val_extended = i_rep_val_extended + 1 CALL section_vals_val_set(qm_kind_section, "MM_INDEX", i_rep_section=i_rep_section_extended, & i_rep_val=i_rep_val_extended, i_val=cur_indices(ip)) ENDIF ! is a non-termination QM atom @@ -728,14 +728,14 @@ SUBROUTINE setup_force_mixing_qmmm_sections(subsys, qmmm_section, qmmm_core_sect IF (cur_labels(ip) == force_mixing_label_QM_core) THEN qm_kind_section => section_vals_get_subs_vals3(qmmm_core_section, "QM_KIND") IF (new_element_core) THEN ! add new QM_KIND section for this element - i_rep_section_core = i_rep_section_core+1 + i_rep_section_core = i_rep_section_core + 1 CALL section_vals_add_values(qm_kind_section) CALL section_vals_val_set(qm_kind_section, "_SECTION_PARAMETERS_", i_rep_section=i_rep_section_core, & c_val=elem_mapping(2, ielem)) i_rep_val_core = 0 new_element_core = .FALSE. ENDIF - i_rep_val_core = i_rep_val_core+1 + i_rep_val_core = i_rep_val_core + 1 CALL section_vals_val_set(qm_kind_section, "MM_INDEX", i_rep_section=i_rep_section_core, & i_rep_val=i_rep_val_core, i_val=cur_indices(ip)) ENDIF ! is a non-termination QM atom @@ -791,15 +791,15 @@ SUBROUTINE get_force_mixing_indices(force_mixing_section, indices, labels) DO i_rep_val = 1, n_reps CALL section_vals_val_get(restart_section, "INDICES", & i_rep_val=i_rep_val, i_vals=indices_entry) - n_indices = n_indices+SIZE(indices_entry) + n_indices = n_indices + SIZE(indices_entry) END DO ALLOCATE (indices(n_indices)) n_indices = 0 DO i_rep_val = 1, n_reps CALL section_vals_val_get(restart_section, "INDICES", & i_rep_val=i_rep_val, i_vals=indices_entry) - indices(n_indices+1:n_indices+SIZE(indices_entry)) = indices_entry - n_indices = n_indices+SIZE(indices_entry) + indices(n_indices + 1:n_indices + SIZE(indices_entry)) = indices_entry + n_indices = n_indices + SIZE(indices_entry) END DO CALL section_vals_val_get(restart_section, "LABELS", n_rep_val=n_reps) @@ -807,15 +807,15 @@ SUBROUTINE get_force_mixing_indices(force_mixing_section, indices, labels) DO i_rep_val = 1, n_reps CALL section_vals_val_get(restart_section, "LABELS", & i_rep_val=i_rep_val, i_vals=labels_entry) - n_labels = n_labels+SIZE(labels_entry) + n_labels = n_labels + SIZE(labels_entry) END DO ALLOCATE (labels(n_labels)) n_labels = 0 DO i_rep_val = 1, n_reps CALL section_vals_val_get(restart_section, "LABELS", & i_rep_val=i_rep_val, i_vals=labels_entry) - labels(n_labels+1:n_labels+SIZE(labels_entry)) = labels_entry - n_labels = n_labels+SIZE(labels_entry) + labels(n_labels + 1:n_labels + SIZE(labels_entry)) = labels_entry + n_labels = n_labels + SIZE(labels_entry) END DO IF (n_indices /= n_labels) & diff --git a/src/qs_3c_tensors.F b/src/qs_3c_tensors.F index f4066ea11a..439631fa4b 100644 --- a/src/qs_3c_tensors.F +++ b/src/qs_3c_tensors.F @@ -134,8 +134,8 @@ SUBROUTINE distribution_2d_create(dist_2d, dist1, dist2, nkind, particle_set, mp DO iatom = 1, natom ikind = particle_set(iatom)%atomic_kind%kind_number - IF (dist1_prv(iatom, 1) == mp_coor(1)) nparticle_local_row(ikind) = nparticle_local_row(ikind)+1 - IF (dist2_prv(iatom, 1) == mp_coor(2)) nparticle_local_col(ikind) = nparticle_local_col(ikind)+1 + IF (dist1_prv(iatom, 1) == mp_coor(1)) nparticle_local_row(ikind) = nparticle_local_row(ikind) + 1 + IF (dist2_prv(iatom, 1) == mp_coor(2)) nparticle_local_col(ikind) = nparticle_local_col(ikind) + 1 END DO DO ikind = 1, nkind @@ -151,11 +151,11 @@ SUBROUTINE distribution_2d_create(dist_2d, dist1, dist2, nkind, particle_set, mp ikind = particle_set(iatom)%atomic_kind%kind_number IF (dist1_prv(iatom, 1) == mp_coor(1)) THEN - nparticle_local_row(ikind) = nparticle_local_row(ikind)+1 + nparticle_local_row(ikind) = nparticle_local_row(ikind) + 1 local_particle_row(ikind)%array(nparticle_local_row(ikind)) = iatom END IF IF (dist2_prv(iatom, 1) == mp_coor(2)) THEN - nparticle_local_col(ikind) = nparticle_local_col(ikind)+1 + nparticle_local_col(ikind) = nparticle_local_col(ikind) + 1 local_particle_col(ikind)%array(nparticle_local_col(ikind)) = iatom END IF END DO @@ -353,7 +353,7 @@ SUBROUTINE build_2c_neighbor_lists(ij_list, basis_i, basis_j, name, qs_env, & IF (ASSOCIATED(basis_j(ikind)%gto_basis_set)) THEN j_present(ikind) = .TRUE. CALL get_gto_basis_set(basis_j(ikind)%gto_basis_set, kind_radius=j_radius(ikind)) - j_radius(ikind) = j_radius(ikind)+x_range + j_radius(ikind) = j_radius(ikind) + x_range END IF END DO @@ -428,21 +428,21 @@ SUBROUTINE build_3c_neighbor_lists(ijk_list, basis_i, basis_j, basis_k, & IF (PRESENT(sym_ij)) THEN IF (sym_ij) THEN ijk_list%sym = symmetric_ij - sym_level = sym_level+1 + sym_level = sym_level + 1 ENDIF ENDIF IF (PRESENT(sym_jk)) THEN IF (sym_jk) THEN ijk_list%sym = symmetric_jk - sym_level = sym_level+1 + sym_level = sym_level + 1 ENDIF ENDIF IF (PRESENT(sym_ik)) THEN IF (sym_ik) THEN ijk_list%sym = symmetrik_ik - sym_level = sym_level+1 + sym_level = sym_level + 1 ENDIF ENDIF @@ -471,9 +471,9 @@ PURE FUNCTION include_symmetric(a, b) LOGICAL :: include_symmetric IF (a > b) THEN - include_symmetric = (MODULO(a+b, 2) /= 0) + include_symmetric = (MODULO(a + b, 2) /= 0) ELSE - include_symmetric = (MODULO(a+b, 2) == 0) + include_symmetric = (MODULO(a + b, 2) == 0) END IF END FUNCTION @@ -680,10 +680,10 @@ SUBROUTINE get_3c_iterator_info(iterator, ikind, jkind, kkind, nkind, iatom, jat IF (PRESENT(rij)) rij = r_1 IF (PRESENT(rjk)) rjk = r_2 - IF (PRESENT(rik)) rik = r_1+r_2 + IF (PRESENT(rik)) rik = r_1 + r_2 IF (PRESENT(cell_j)) cell_j = cell_1 - IF (PRESENT(cell_k)) cell_k = cell_1+cell_2 + IF (PRESENT(cell_k)) cell_k = cell_1 + cell_2 CALL timestop(handle) END SUBROUTINE @@ -781,9 +781,9 @@ SUBROUTINE alloc_block_3c(t3c, nl_3c, basis_i, basis_j, basis_k, qs_env, do_kpoi CALL get_gto_basis_set(basis_j(jkind)%gto_basis_set, kind_radius=kind_radius_j) CALL get_gto_basis_set(basis_k(kkind)%gto_basis_set, kind_radius=kind_radius_k) - IF (kind_radius_j+kind_radius_i < dij) CYCLE - IF (kind_radius_j+kind_radius_k < djk) CYCLE - IF (kind_radius_k+kind_radius_i < dik) CYCLE + IF (kind_radius_j + kind_radius_i < dij) CYCLE + IF (kind_radius_j + kind_radius_k < djk) CYCLE + IF (kind_radius_k + kind_radius_i < dik) CYCLE ! tensor is not symmetric therefore need to allocate rows and columns in ! correspondence with neighborlist. Note that this only allocates half @@ -812,9 +812,9 @@ SUBROUTINE alloc_block_3c(t3c, nl_3c, basis_i, basis_j, basis_k, qs_env, do_kpoi ALLOCATE (tmp(blk_cnt)) tmp(:) = ai%array(:) DEALLOCATE (ai%array) - ALLOCATE (ai%array(blk_cnt+1)) + ALLOCATE (ai%array(blk_cnt + 1)) ai%array(1:blk_cnt) = tmp(:) - ai%array(blk_cnt+1) = iatom + ai%array(blk_cnt + 1) = iatom ELSE ALLOCATE (ai%array(1)) ai%array(1) = iatom @@ -823,9 +823,9 @@ SUBROUTINE alloc_block_3c(t3c, nl_3c, basis_i, basis_j, basis_k, qs_env, do_kpoi IF (ALLOCATED(aj%array)) THEN tmp(:) = aj%array(:) DEALLOCATE (aj%array) - ALLOCATE (aj%array(blk_cnt+1)) + ALLOCATE (aj%array(blk_cnt + 1)) aj%array(1:blk_cnt) = tmp(:) - aj%array(blk_cnt+1) = jatom + aj%array(blk_cnt + 1) = jatom ELSE ALLOCATE (aj%array(1)) aj%array(1) = jatom @@ -834,9 +834,9 @@ SUBROUTINE alloc_block_3c(t3c, nl_3c, basis_i, basis_j, basis_k, qs_env, do_kpoi IF (ALLOCATED(ak%array)) THEN tmp(:) = ak%array(:) DEALLOCATE (ak%array) - ALLOCATE (ak%array(blk_cnt+1)) + ALLOCATE (ak%array(blk_cnt + 1)) ak%array(1:blk_cnt) = tmp(:) - ak%array(blk_cnt+1) = katom + ak%array(blk_cnt + 1) = katom ELSE ALLOCATE (ak%array(1)) ak%array(1) = katom @@ -996,9 +996,9 @@ SUBROUTINE build_3c_integrals(t3c, filter_eps, qs_env, & dij = SQRT(SUM(rij**2)) dik = SQRT(SUM(rik**2)) - IF (kind_radius_j+kind_radius_i < dij) CYCLE - IF (kind_radius_j+kind_radius_k < djk) CYCLE - IF (kind_radius_k+kind_radius_i < dik) CYCLE + IF (kind_radius_j + kind_radius_i < dij) CYCLE + IF (kind_radius_j + kind_radius_k < djk) CYCLE + IF (kind_radius_k + kind_radius_i < dik) CYCLE CALL dbcsr_t_blk_sizes(t3c(jcell, kcell), [iatom, jatom, katom], blk_size) ALLOCATE (block_t(blk_size(1), blk_size(2), blk_size(3))) @@ -1008,12 +1008,12 @@ SUBROUTINE build_3c_integrals(t3c, filter_eps, qs_env, & DO jset = 1, nsetj - IF (set_radius_j(jset)+set_radius_i(iset) < dij) CYCLE + IF (set_radius_j(jset) + set_radius_i(iset) < dij) CYCLE DO kset = 1, nsetk - IF (set_radius_j(jset)+set_radius_k(kset) < djk) CYCLE - IF (set_radius_k(kset)+set_radius_i(iset) < dik) CYCLE + IF (set_radius_j(jset) + set_radius_k(kset) < djk) CYCLE + IF (set_radius_k(kset) + set_radius_i(iset) < dik) CYCLE ncoi = npgfi(iset)*ncoset(lmax_i(iset)) ncoj = npgfj(jset)*ncoset(lmax_j(jset)) @@ -1046,11 +1046,11 @@ SUBROUTINE build_3c_integrals(t3c, filter_eps, qs_env, & ncoi, ncoj, ncok, nsgfi(iset), nsgfj(jset), nsgfk(kset)) block_start_j = sgfj - block_end_j = sgfj+nsgfj(jset)-1 + block_end_j = sgfj + nsgfj(jset) - 1 block_start_k = sgfk - block_end_k = sgfk+nsgfk(kset)-1 + block_end_k = sgfk + nsgfk(kset) - 1 block_start_i = sgfi - block_end_i = sgfi+nsgfi(iset)-1 + block_end_i = sgfi + nsgfi(iset) - 1 IF (do_kpoints_prv) THEN prefac = 0.5_dp @@ -1070,7 +1070,7 @@ SUBROUTINE build_3c_integrals(t3c, filter_eps, qs_env, & block_start_k:block_end_k) = & block_t(block_start_i:block_end_i, & block_start_j:block_end_j, & - block_start_k:block_end_k)+ & + block_start_k:block_end_k) + & prefac*sijk_contr(:, :, :) DEALLOCATE (sijk, sijk_contr) @@ -1115,7 +1115,7 @@ SUBROUTINE build_3c_integrals(t3c, filter_eps, qs_env, & ENDDO ENDDO DO jcell = 1, nimg - DO kcell = jcell+1, nimg + DO kcell = jcell + 1, nimg CALL dbcsr_t_copy(t3c(jcell, kcell), t_3c_tmp) CALL dbcsr_t_copy(t_3c_tmp, t3c(kcell, jcell), order=[1, 3, 2], summation=.FALSE., move_data=.TRUE.) CALL dbcsr_t_filter(t3c(kcell, jcell), filter_eps) @@ -1155,18 +1155,18 @@ SUBROUTINE contiguous_tensor_dist(nel, nbin, weights, limits_start, limits_end, DO ibin = 1, nbin nel_split = nel_div IF (ibin <= nel_rem) THEN - nel_split = nel_split+1 + nel_split = nel_split + 1 ENDIF - el_start = el_end+1 + el_start = el_end + 1 el_end = el_start - w_partialsum = w_partialsum+weights(el_end) - end_weight = end_weight+nel_split + w_partialsum = w_partialsum + weights(el_end) + end_weight = end_weight + nel_split DO WHILE (w_partialsum < end_weight) !IF (ABS(w_partialsum + weights(el_end) - end_weight) > ABS(w_partialsum - end_weight)) EXIT - el_end = el_end+1 - w_partialsum = w_partialsum+weights(el_end) + el_end = el_end + 1 + w_partialsum = w_partialsum + weights(el_end) ENDDO - IF (PRESENT(dist)) dist(el_start:el_end) = ibin-1 + IF (PRESENT(dist)) dist(el_start:el_end) = ibin - 1 IF (PRESENT(limits_start)) limits_start(ibin) = el_start IF (PRESENT(limits_end)) limits_end(ibin) = el_end ENDDO @@ -1192,14 +1192,14 @@ SUBROUTINE cyclic_tensor_dist(nel, nbin, weights, dist) ibin = 0 DO iel = 1, nel niter = 0 - ibin = MOD(ibin+1, nbin) - DO WHILE (occup(ibin+1)+weights(iel) .GE. MAXVAL(occup)) - IF (MINLOC(occup, DIM=1) == ibin+1) EXIT - ibin = MOD(ibin+1, nbin) - niter = niter+1 + ibin = MOD(ibin + 1, nbin) + DO WHILE (occup(ibin + 1) + weights(iel) .GE. MAXVAL(occup)) + IF (MINLOC(occup, DIM=1) == ibin + 1) EXIT + ibin = MOD(ibin + 1, nbin) + niter = niter + 1 ENDDO dist(iel) = ibin - occup(ibin+1) = occup(ibin+1)+weights(iel) + occup(ibin + 1) = occup(ibin + 1) + weights(iel) ENDDO END SUBROUTINE cyclic_tensor_dist diff --git a/src/qs_active_space_methods.F b/src/qs_active_space_methods.F index 5846fdcf86..585db19e7b 100644 --- a/src/qs_active_space_methods.F +++ b/src/qs_active_space_methods.F @@ -263,12 +263,12 @@ SUBROUTINE active_space_main(input, logger, qs_env) END IF ninactive_alpha = invals(1) ninactive_beta = invals(2) - ninactive = ninactive_alpha+ninactive_beta + ninactive = ninactive_alpha + ninactive_beta ELSE IF (explicit) THEN ninactive = invals(1) ELSE - ninactive = ntot-nactive + ninactive = ntot - nactive END IF ninactive_alpha = ninactive ninactive_beta = 0 @@ -276,7 +276,7 @@ SUBROUTINE active_space_main(input, logger, qs_env) CPASSERT(ninactive >= 0) CPASSERT(ninactive_alpha >= 0) CPASSERT(ninactive_beta >= 0) - CPASSERT(ntot == ninactive+nactive) + CPASSERT(ntot == ninactive + nactive) IF (nspins > 1) THEN CPASSERT(nepol(1) >= ninactive_alpha) CPASSERT(nepol(2) >= ninactive_beta) @@ -417,11 +417,11 @@ SUBROUTINE active_space_main(input, logger, qs_env) DO i = 1, 5 ishell = i IF (cshell(n1:n1) == " ") THEN - ishell = ishell-1 + ishell = ishell - 1 EXIT END IF READ (cshell(n1:), "(I1,A1)") nshell(i), lnam(i) - n1 = n1+2 + n1 = n1 + 2 END DO END IF @@ -440,7 +440,7 @@ SUBROUTINE active_space_main(input, logger, qs_env) nmo = 0 DO ispin = 1, nspins CALL get_mo_set(mos(ispin)%mo_set, nmo=m) - IF (m < ninactive_orb(ispin)+nactive_orb(ispin)) THEN + IF (m < ninactive_orb(ispin) + nactive_orb(ispin)) THEN CPABORT("Not enough canonical orbitals available.") END IF nmo = MAX(m, nmo) @@ -464,7 +464,7 @@ SUBROUTINE active_space_main(input, logger, qs_env) mo_set => active_space_env%mos_active(ispin)%mo_set CALL get_mo_set(mo_set, mo_coeff=fm_target) ncol = nactive_orb(ispin) - CALL cp_fm_to_fm(fm_ref, fm_target, ncol, ninactive_orb(ispin)+1, 1) + CALL cp_fm_to_fm(fm_ref, fm_target, ncol, ninactive_orb(ispin) + 1, 1) END DO END IF IF (iw > 0) THEN @@ -472,12 +472,12 @@ SUBROUTINE active_space_main(input, logger, qs_env) WRITE (iw, '(/,T4,A,I3,T65,A)') "Canonical Orbital Selection for spin", ispin, & "[atomic units]" DO i = 1, ninactive_orb(ispin), 4 - jm = MIN(3, ninactive_orb(ispin)-i) - WRITE (iw, '(T3,4(F14.6,A5))') (eigenvalues(i+j, 1), " [I]", j=0, jm) + jm = MIN(3, ninactive_orb(ispin) - i) + WRITE (iw, '(T3,4(F14.6,A5))') (eigenvalues(i + j, 1), " [I]", j=0, jm) END DO - DO i = ninactive_orb(ispin)+1, ninactive_orb(ispin)+nactive_orb(ispin), 4 - jm = MIN(3, ninactive_orb(ispin)+nactive_orb(ispin)-i) - WRITE (iw, '(T3,4(F14.6,A5))') (eigenvalues(i+j, 1), " [A]", j=0, jm) + DO i = ninactive_orb(ispin) + 1, ninactive_orb(ispin) + nactive_orb(ispin), 4 + jm = MIN(3, ninactive_orb(ispin) + nactive_orb(ispin) - i) + WRITE (iw, '(T3,4(F14.6,A5))') (eigenvalues(i + j, 1), " [A]", j=0, jm) END DO END DO END IF @@ -649,7 +649,7 @@ SUBROUTINE active_space_main(input, logger, qs_env) ! allocate container for integrals (CSR matrix) CALL get_qs_env(qs_env, para_env=para_env) - m = (nspins*(nspins+1))/2 + m = (nspins*(nspins + 1))/2 ALLOCATE (active_space_env%eri%eri(m)) DO i = 1, m ALLOCATE (active_space_env%eri%eri(i)%csr_mat) @@ -664,8 +664,8 @@ SUBROUTINE active_space_main(input, logger, qs_env) n1 = nactive_orb(2) n2 = nactive_orb(2) END IF - nn1 = (n1*(n1+1))/2 - nn2 = (n2*(n2+1))/2 + nn1 = (n1*(n1 + 1))/2 + nn2 = (n2*(n2 + 1))/2 CALL dbcsr_csr_create(eri_mat, nn1, nn2, 0_int_8, 0, 0, para_env%group) CALL get_mo_set(active_space_env%mos_active(i)%mo_set, nmo=active_space_env%eri%norb) END DO @@ -723,11 +723,11 @@ SUBROUTINE active_space_main(input, logger, qs_env) DO isp = 1, nspins fmat => active_space_env%p_ref(isp)%matrix CALL cp_fm_set_all(fmat, alpha=0.0_dp) - n1 = active_space_env%nelectrons(isp)-active_space_env%ninspin(isp) + n1 = active_space_env%nelectrons(isp) - active_space_env%ninspin(isp) DO i = 1, nactive_orb(isp) fel = MIN(focc, REAL(n1, KIND=dp)) CALL cp_fm_set_element(fmat, i, i, fel) - n1 = n1-NINT(fel) + n1 = n1 - NINT(fel) n1 = MAX(n1, 0) END DO END DO @@ -1001,7 +1001,7 @@ SUBROUTINE calculate_eri_gpw(mos, eri_env, qs_env, iw) dft_control%qs_control%cutoff = eri_env%eri_gpw%cutoff*0.5_dp dft_control%qs_control%e_cutoff(1) = dft_control%qs_control%cutoff DO i_multigrid = 2, n_multigrid - dft_control%qs_control%e_cutoff(i_multigrid) = dft_control%qs_control%e_cutoff(i_multigrid-1) & + dft_control%qs_control%e_cutoff(i_multigrid) = dft_control%qs_control%e_cutoff(i_multigrid - 1) & /progression_factor END DO @@ -1100,7 +1100,7 @@ SUBROUTINE calculate_eri_gpw(mos, eri_env, qs_env, iw) intcount = 0 DO isp1 = 1, nspins CALL get_mo_set(mo_set=mos(isp1)%mo_set, nmo=nmo1) - nmm = (nmo1*(nmo1+1))/2 + nmm = (nmo1*(nmo1 + 1))/2 irange = get_irange_csr(nmm, eri_env%eri(1)%csr_mat%mp_group) DO iwa1 = 1, nmo1 IF (eri_env%eri_gpw%store_wfn) THEN @@ -1111,7 +1111,7 @@ SUBROUTINE calculate_eri_gpw(mos, eri_env, qs_env, iw) DO iwa2 = iwa1, nmo1 iwa12 = csr_idx_to_combined(iwa1, iwa2, nmo1) IF (iwa12 >= irange(1) .AND. iwa12 <= irange(2)) THEN - iwa12 = iwa12-irange(1)+1 + iwa12 = iwa12 - irange(1) + 1 ELSE iwa12 = 0 END IF @@ -1138,12 +1138,12 @@ SUBROUTINE calculate_eri_gpw(mos, eri_env, qs_env, iw) ELSEIF (eri_env%method == eri_method_full_gpw) THEN DO isp2 = isp1, nspins CALL get_mo_set(mo_set=mos(isp1)%mo_set, nmo=nmo2) - nx = (nmo2*(nmo2+1))/2 + nx = (nmo2*(nmo2 + 1))/2 ALLOCATE (eri(nx), eri_index(nx)) icount2 = 0 iwbs = 1 IF (isp1 == isp2) iwbs = iwa1 - isp = (isp1-1)*isp2-((isp1-1)*(isp1-2))/2+(isp2-isp1+1) + isp = (isp1 - 1)*isp2 - ((isp1 - 1)*(isp1 - 2))/2 + (isp2 - isp1 + 1) DO iwb1 = iwbs, nmo2 IF (eri_env%eri_gpw%store_wfn) THEN wfn3 => wfn_a(iwb1, isp2) @@ -1161,12 +1161,12 @@ SUBROUTINE calculate_eri_gpw(mos, eri_env, qs_env, iw) wfn_r%pw%cr3d = rho_r%pw%cr3d*wfn3%pw%cr3d*wfn4%pw%cr3d erint = pw_integrate_function(wfn_r%pw) IF (erint > eri_env%eps_integral) THEN - intcount = intcount+1 + intcount = intcount + 1 IF (print2 .AND. iw > 0) THEN WRITE (iw, "(T4,'ERI_GPW|',T20,2I4,' [',I1,']',2I4,' [',I1,']',T58,G20.14)") & iwa1, iwa2, isp1, iwb1, iwb2, isp2, erint END IF - icount2 = icount2+1 + icount2 = icount2 + 1 eri(icount2) = erint eri_index(icount2) = csr_idx_to_combined(iwb1, iwb2, nmo2) END IF @@ -1253,7 +1253,7 @@ SUBROUTINE pw_eri_green_create(green, eri_env) a = eri_env%operator_parameter**2 DO ig = grid%first_gne0, grid%ngpts_cut_local g2 = grid%gsq(ig) - gf%cc(ig) = fourpi/(a+g2) + gf%cc(ig) = fourpi/(a + g2) END DO IF (grid%have_g0) gf%cc(1) = fourpi/a CASE (eri_operator_erf) @@ -1269,7 +1269,7 @@ SUBROUTINE pw_eri_green_create(green, eri_env) DO ig = grid%first_gne0, grid%ngpts_cut_local g2 = grid%gsq(ig) ga = -0.25_dp*g2/a - gf%cc(ig) = fourpi/g2*(1._dp-EXP(ga)) + gf%cc(ig) = fourpi/g2*(1._dp - EXP(ga)) END DO IF (grid%have_g0) gf%cc(1) = 0.25_dp*fourpi/a CASE (eri_operator_gaussian) @@ -1287,7 +1287,7 @@ SUBROUTINE pw_eri_green_create(green, eri_env) g2 = grid%gsq(ig) gg = SQRT(g2) g3d = fourpi/g2 - gf%cc(ig) = g3d*(1.0_dp-COS(rlength*gg)) + gf%cc(ig) = g3d*(1.0_dp - COS(rlength*gg)) END DO IF (grid%have_g0) gf%cc(1) = 0.5_dp*fourpi*rlength*rlength CASE (eri_operator_yukawa) @@ -1297,11 +1297,11 @@ SUBROUTINE pw_eri_green_create(green, eri_env) DO ig = grid%first_gne0, grid%ngpts_cut_local g2 = grid%gsq(ig) gg = SQRT(g2) - g3d = fourpi/(a*a+g2) + g3d = fourpi/(a*a + g2) rg = rlength*gg - gf%cc(ig) = g3d*(1.0_dp-ea*(COS(rg)+a/gg*SIN(rg))) + gf%cc(ig) = g3d*(1.0_dp - ea*(COS(rg) + a/gg*SIN(rg))) END DO - IF (grid%have_g0) gf%cc(1) = fourpi/(a*a)*(1.0_dp-ea*(1._dp+a*rlength)) + IF (grid%have_g0) gf%cc(1) = fourpi/(a*a)*(1.0_dp - ea*(1._dp + a*rlength)) CASE (eri_operator_erf) rlength = green%radius a = eri_env%operator_parameter**2 @@ -1309,7 +1309,7 @@ SUBROUTINE pw_eri_green_create(green, eri_env) g2 = grid%gsq(ig) gg = SQRT(g2) ga = -0.25_dp*g2/a - gf%cc(ig) = fourpi/g2*EXP(ga)*(1.0_dp-COS(rlength*gg)) + gf%cc(ig) = fourpi/g2*EXP(ga)*(1.0_dp - COS(rlength*gg)) END DO IF (grid%have_g0) gf%cc(1) = 0.5_dp*fourpi*rlength*rlength CASE (eri_operator_erfc) @@ -1319,7 +1319,7 @@ SUBROUTINE pw_eri_green_create(green, eri_env) g2 = grid%gsq(ig) gg = SQRT(g2) ga = -0.25_dp*g2/a - gf%cc(ig) = fourpi/g2*(1._dp-EXP(ga))*(1.0_dp-COS(rlength*gg)) + gf%cc(ig) = fourpi/g2*(1._dp - EXP(ga))*(1.0_dp - COS(rlength*gg)) END DO IF (grid%have_g0) gf%cc(1) = 0._dp CASE (eri_operator_gaussian) @@ -1358,27 +1358,27 @@ SUBROUTINE update_csr_matrix(csr_mat, nnz, rdat, rind, irow) CPASSERT(irow <= csr_mat%nrows_total) CPASSERT(irow > csr_mat%nrows_local) nze = csr_mat%nze_local - nze_new = nze+nnz + nze_new = nze + nnz ! values CALL reallocate(csr_mat%nzval_local%r_dp, 1, nze_new) - csr_mat%nzval_local%r_dp(nze+1:nze_new) = rdat(1:nnz) + csr_mat%nzval_local%r_dp(nze + 1:nze_new) = rdat(1:nnz) ! col indices CALL reallocate(csr_mat%colind_local, 1, nze_new) - csr_mat%colind_local(nze+1:nze_new) = rind(1:nnz) + csr_mat%colind_local(nze + 1:nze_new) = rind(1:nnz) ! rows nrow = csr_mat%nrows_local - CALL reallocate(csr_mat%rowptr_local, 1, irow+1) - csr_mat%rowptr_local(nrow+1:irow) = nze+1 - csr_mat%rowptr_local(irow+1) = nze_new+1 + CALL reallocate(csr_mat%rowptr_local, 1, irow + 1) + csr_mat%rowptr_local(nrow + 1:irow) = nze + 1 + csr_mat%rowptr_local(irow + 1) = nze_new + 1 ! nzerow CALL reallocate(csr_mat%nzerow_local, 1, irow) - DO k = nrow+1, irow - csr_mat%nzerow_local(k) = csr_mat%rowptr_local(k+1)-csr_mat%rowptr_local(k) + DO k = nrow + 1, irow + csr_mat%nzerow_local(k) = csr_mat%rowptr_local(k + 1) - csr_mat%rowptr_local(k) ENDDO csr_mat%nrows_local = irow - csr_mat%nze_local = csr_mat%nze_local+nnz + csr_mat%nze_local = csr_mat%nze_local + nnz END IF - csr_mat%nze_total = csr_mat%nze_total+nnz + csr_mat%nze_total = csr_mat%nze_total + nnz csr_mat%has_indices = .TRUE. END SUBROUTINE update_csr_matrix @@ -1612,40 +1612,40 @@ SUBROUTINE subspace_fock_matrix(active_space_env) ! calculate energy eeri = 0.0_dp eri => active_space_env%eri%eri(1)%csr_mat - nindex = (norb*(norb+1))/2 + nindex = (norb*(norb + 1))/2 irange = get_irange_csr(nindex, eri%mp_group) DO i1 = 1, norb DO i2 = i1, norb i12 = csr_idx_to_combined(i1, i2, norb) IF (i12 >= irange(1) .AND. i12 <= irange(2)) THEN - i12l = i12-irange(1)+1 - irptr = eri%rowptr_local(i12l)-1 + i12l = i12 - irange(1) + 1 + irptr = eri%rowptr_local(i12l) - 1 DO i34l = 1, eri%nzerow_local(i12l) - i34 = eri%colind_local(irptr+i34l) + i34 = eri%colind_local(irptr + i34l) CALL csr_idx_from_combined(i34, norb, i3, i4) - erint = eri%nzval_local%r_dp(irptr+i34l) + erint = eri%nzval_local%r_dp(irptr + i34l) ! Coulomb - ks_ref(i1, i2) = ks_ref(i1, i2)+erint*p_mat(i3, i4) + ks_ref(i1, i2) = ks_ref(i1, i2) + erint*p_mat(i3, i4) IF (i3 /= i4) THEN - ks_ref(i1, i2) = ks_ref(i1, i2)+erint*p_mat(i3, i4) + ks_ref(i1, i2) = ks_ref(i1, i2) + erint*p_mat(i3, i4) END IF IF (i12 /= i34) THEN - ks_ref(i3, i4) = ks_ref(i3, i4)+erint*p_mat(i1, i2) + ks_ref(i3, i4) = ks_ref(i3, i4) + erint*p_mat(i1, i2) IF (i1 /= i2) THEN - ks_ref(i3, i4) = ks_ref(i3, i4)+erint*p_mat(i1, i2) + ks_ref(i3, i4) = ks_ref(i3, i4) + erint*p_mat(i1, i2) END IF END IF ! Exchange erint = -0.5_dp*erint - ks_ref(i1, i3) = ks_ref(i1, i3)+erint*p_mat(i2, i4) + ks_ref(i1, i3) = ks_ref(i1, i3) + erint*p_mat(i2, i4) IF (i1 /= i2) THEN - ks_ref(i2, i3) = ks_ref(i2, i3)+erint*p_mat(i1, i4) + ks_ref(i2, i3) = ks_ref(i2, i3) + erint*p_mat(i1, i4) END IF IF (i3 /= i4) THEN - ks_ref(i1, i4) = ks_ref(i1, i4)+erint*p_mat(i2, i3) + ks_ref(i1, i4) = ks_ref(i1, i4) + erint*p_mat(i2, i3) END IF IF (i1 /= i2 .AND. i3 /= i4) THEN - ks_ref(i2, i4) = ks_ref(i2, i4)+erint*p_mat(i1, i3) + ks_ref(i2, i4) = ks_ref(i2, i4) + erint*p_mat(i1, i3) END IF END DO END IF @@ -1660,8 +1660,8 @@ SUBROUTINE subspace_fock_matrix(active_space_env) CALL mp_sum(ks_ref, eri%mp_group) ! eeri = 0.5_dp*SUM(ks_ref*p_mat) - esub = eref-SUM(ks_mat(1:norb, 1:norb)*p_mat(1:norb, 1:norb))+eeri - ks_mat(1:norb, 1:norb) = ks_mat(1:norb, 1:norb)-ks_ref(1:norb, 1:norb) + esub = eref - SUM(ks_mat(1:norb, 1:norb)*p_mat(1:norb, 1:norb)) + eeri + ks_mat(1:norb, 1:norb) = ks_mat(1:norb, 1:norb) - ks_ref(1:norb, 1:norb) ! active_space_env%energy_inactive = esub ! @@ -1721,9 +1721,9 @@ SUBROUTINE create_pro_basis(pro_basis_set, zval, ishell, nshell, lnam) ! electronic configuration ne = 0 DO l = 1, 4 !lq(1)+1 - nj = 2*(l-1)+1 + nj = 2*(l - 1) + 1 DO i = l, 7 ! nq(1) - ne(l, i) = ptable(zval)%e_conv(l-1)-2*nj*(i-l) + ne(l, i) = ptable(zval)%e_conv(l - 1) - 2*nj*(i - l) ne(l, i) = MAX(ne(l, i), 0) ne(l, i) = MIN(ne(l, i), 2*nj) END DO @@ -1731,7 +1731,7 @@ SUBROUTINE create_pro_basis(pro_basis_set, zval, ishell, nshell, lnam) ALLOCATE (nq(ishell), lq(ishell), zet(ishell), sym(ishell)) DO i = 1, ishell nq(i) = nshell(i) - SELECT CASE (lnam (i)) + SELECT CASE (lnam(i)) CASE ('S', 's') lq(i) = 0 CASE ('P', 'p') diff --git a/src/qs_active_space_types.F b/src/qs_active_space_types.F index bb831c0547..861ae7a0e1 100644 --- a/src/qs_active_space_types.F +++ b/src/qs_active_space_types.F @@ -250,9 +250,9 @@ INTEGER FUNCTION csr_idx_to_combined(i, j, n) RESULT(ij) CPASSERT(i <= n) CPASSERT(j <= n) - ij = (i-1)*n-((i-1)*(i-2))/2+(j-i+1) + ij = (i - 1)*n - ((i - 1)*(i - 2))/2 + (j - i + 1) - CPASSERT(ij <= (n*(n+1))/2) + CPASSERT(ij <= (n*(n + 1))/2) END FUNCTION csr_idx_to_combined @@ -273,8 +273,8 @@ SUBROUTINE csr_idx_from_combined(ij, n, i, j) m = MAX(ij/n, 1) DO i = m, n - m0 = (i-1)*n-((i-1)*(i-2))/2 - j = ij-m0+i-1 + m0 = (i - 1)*n - ((i - 1)*(i - 2))/2 + j = ij - m0 + i - 1 IF (j <= n) EXIT END DO @@ -310,13 +310,13 @@ FUNCTION get_irange_csr(nindex, mp_group) RESULT(irange) irange(1) = 1 irange(2) = 0 ELSE - irange(1) = taskid+1 - irange(2) = taskid+1 + irange(1) = taskid + 1 + irange(2) = taskid + 1 END IF ELSE rat = REAL(nindex, KIND=dp)/REAL(numtask, KIND=dp) - irange(1) = NINT(rat*taskid)+1 - irange(2) = NINT(rat*taskid+rat) + irange(1) = NINT(rat*taskid) + 1 + irange(2) = NINT(rat*taskid + rat) END IF END FUNCTION get_irange_csr @@ -342,7 +342,7 @@ SUBROUTINE eri_type_eri_foreach(this, nspin, fobj) REAL(KIND=dp) :: erint ASSOCIATE (eri=>this%eri(nspin)%csr_mat, norb=>this%norb) - nindex = (norb*(norb+1))/2 + nindex = (norb*(norb + 1))/2 irange = get_irange_csr(nindex, eri%mp_group) ALLOCATE (erival(nindex), colind(nindex)) @@ -351,11 +351,11 @@ SUBROUTINE eri_type_eri_foreach(this, nspin, fobj) i12 = csr_idx_to_combined(i1, i2, norb) IF (i12 >= irange(1) .AND. i12 <= irange(2)) THEN - i12l = i12-irange(1)+1 + i12l = i12 - irange(1) + 1 irptr = eri%rowptr_local(i12l) nindex = eri%nzerow_local(i12l) - colind(1:nindex) = eri%colind_local(irptr:irptr+nindex-1) - erival(1:nindex) = eri%nzval_local%r_dp(irptr:irptr+nindex-1) + colind(1:nindex) = eri%colind_local(irptr:irptr + nindex - 1) + erival(1:nindex) = eri%nzval_local%r_dp(irptr:irptr + nindex - 1) ELSE erival = 0.0_dp colind = 0 diff --git a/src/qs_band_structure.F b/src/qs_band_structure.F index 2be77f6a9c..7b5c40135f 100644 --- a/src/qs_band_structure.F +++ b/src/qs_band_structure.F @@ -188,18 +188,18 @@ SUBROUTINE do_calculate_band_structure(qs_env) CASE ("B_VECTOR") kspecial(1:3, ip) = kpptr(1:3) CASE ("CART_ANGSTROM") - kspecial(1:3, ip) = (kpptr(1)*cell%hmat(1, 1:3)+ & - kpptr(2)*cell%hmat(2, 1:3)+ & + kspecial(1:3, ip) = (kpptr(1)*cell%hmat(1, 1:3) + & + kpptr(2)*cell%hmat(2, 1:3) + & kpptr(3)*cell%hmat(3, 1:3))/twopi*angstrom CASE ("CART_BOHR") - kspecial(1:3, ip) = (kpptr(1)*cell%hmat(1, 1:3)+ & - kpptr(2)*cell%hmat(2, 1:3)+ & + kspecial(1:3, ip) = (kpptr(1)*cell%hmat(1, 1:3) + & + kpptr(2)*cell%hmat(2, 1:3) + & kpptr(3)*cell%hmat(3, 1:3))/twopi CASE DEFAULT CPABORT("Unknown Unit for kpoint definition") END SELECT END DO - npoints = (n_ptr-1)*npline+1 + npoints = (n_ptr - 1)*npline + 1 ! CPASSERT(npoints >= 1) IF (unit_nr > 0) THEN @@ -223,10 +223,10 @@ SUBROUTINE do_calculate_band_structure(qs_env) ikk = 1 DO ik = 2, n_ptr DO ip = 1, npline - ikk = ikk+1 - kpgeneral(1:3, ikk) = kspecial(1:3, ik-1)+ & + ikk = ikk + 1 + kpgeneral(1:3, ikk) = kspecial(1:3, ik - 1) + & REAL(ip, KIND=dp)/REAL(npline, KIND=dp)* & - (kspecial(1:3, ik)-kspecial(1:3, ik-1)) + (kspecial(1:3, ik) - kspecial(1:3, ik - 1)) END DO END DO NULLIFY (kpoint) @@ -243,7 +243,7 @@ SUBROUTINE do_calculate_band_structure(qs_env) my_kpgrp = (ik >= kp_range(1) .AND. ik <= kp_range(2)) DO ispin = 1, nspins IF (my_kpgrp) THEN - ikpgr = ik-kp_range(1)+1 + ikpgr = ik - kp_range(1) + 1 kp => kpoint%kp_env(ikpgr)%kpoint_env CALL get_mo_set(kp%mos(1, ispin)%mo_set, eigenvalues=eigenvalues) eigval(1:nmo) = eigenvalues(1:nmo) @@ -266,7 +266,7 @@ SUBROUTINE do_calculate_band_structure(qs_env) CALL kpoint_release(kpoint) t2 = m_walltime() IF (unit_nr > 0) THEN - WRITE (unit_nr, FMT="(T2,A,T67,F14.3)") "KPOINTS| Time for K-Point Line ", t2-t1 + WRITE (unit_nr, FMT="(T2,A,T67,F14.3)") "KPOINTS| Time for K-Point Line ", t2 - t1 END IF END DO ! close output file @@ -359,10 +359,10 @@ SUBROUTINE calculate_kp_orbitals(qs_env, kpoint, scheme, nadd, mp_grid, kpgenera DO ix = 1, mp_grid(1) DO iy = 1, mp_grid(2) DO iz = 1, mp_grid(3) - i = i+1 - kpt_latt(1) = REAL(2*ix-mp_grid(1)-1, KIND=dp)/(2._dp*REAL(mp_grid(1), KIND=dp)) - kpt_latt(2) = REAL(2*iy-mp_grid(2)-1, KIND=dp)/(2._dp*REAL(mp_grid(2), KIND=dp)) - kpt_latt(3) = REAL(2*iz-mp_grid(3)-1, KIND=dp)/(2._dp*REAL(mp_grid(3), KIND=dp)) + i = i + 1 + kpt_latt(1) = REAL(2*ix - mp_grid(1) - 1, KIND=dp)/(2._dp*REAL(mp_grid(1), KIND=dp)) + kpt_latt(2) = REAL(2*iy - mp_grid(2) - 1, KIND=dp)/(2._dp*REAL(mp_grid(2), KIND=dp)) + kpt_latt(3) = REAL(2*iz - mp_grid(3) - 1, KIND=dp)/(2._dp*REAL(mp_grid(3), KIND=dp)) kpoint%xkp(1:3, i) = MATMUL(TRANSPOSE(h_inv), kpt_latt(:)) END DO END DO @@ -403,7 +403,7 @@ SUBROUTINE calculate_kp_orbitals(qs_env, kpoint, scheme, nadd, mp_grid, kpgenera DO ik = 1, SIZE(kpoint%kp_env) CALL mpools_get(kpoint%mpools, ao_mo_fm_pools=ao_mo_fm_pools) mos => kpoint%kp_env(ik)%kpoint_env%mos - ikk = kpoint%kp_range(1)+ik-1 + ikk = kpoint%kp_range(1) + ik - 1 CPASSERT(ASSOCIATED(mos)) DO ispin = 1, SIZE(mos, 2) DO ic = 1, SIZE(mos, 1) diff --git a/src/qs_basis_gradient.F b/src/qs_basis_gradient.F index af56cf7a7e..8d773f98a4 100644 --- a/src/qs_basis_gradient.F +++ b/src/qs_basis_gradient.F @@ -213,8 +213,8 @@ FUNCTION return_basis_center_gradient_norm(qs_env) RESULT(norm) CALL get_atomic_kind(particle_set(iatom)%atomic_kind, kind_number=ikind) CALL get_qs_kind(qs_kind_set(ikind), floating=floating) IF (floating) THEN - nfloat = nfloat+1 - norm = norm+SUM(ABS(gradient(1:3, iatom))) + nfloat = nfloat + 1 + norm = norm + SUM(ABS(gradient(1:3, iatom))) END IF END DO IF (nfloat > 0) THEN @@ -256,7 +256,7 @@ SUBROUTINE qs_update_basis_center_pos(qs_env) CALL get_atomic_kind(particle_set(iatom)%atomic_kind, kind_number=ikind) CALL get_qs_kind(qs_kind_set(ikind), floating=floating) IF (floating) THEN - particle_set(iatom)%r(1:3) = particle_set(iatom)%r(1:3)+alpha*gradient(1:3, iatom) + particle_set(iatom)%r(1:3) = particle_set(iatom)%r(1:3) + alpha*gradient(1:3, iatom) END IF END DO diff --git a/src/qs_cdft_methods.F b/src/qs_cdft_methods.F index 592dcd16b0..b1af38cf18 100644 --- a/src/qs_cdft_methods.F +++ b/src/qs_cdft_methods.F @@ -206,15 +206,15 @@ SUBROUTINE becke_constraint_low(qs_env, just_gradients) DO i = 1, 3 cell_v(i) = cell%hmat(i, i) END DO - DO iatom = 1, natom-1 - DO jatom = iatom+1, natom + DO iatom = 1, natom - 1 + DO jatom = iatom + 1, natom r = particle_set(iatom)%r r1 = particle_set(jatom)%r DO i = 1, 3 - r(i) = MODULO(r(i), cell%hmat(i, i))-cell%hmat(i, i)/2._dp - r1(i) = MODULO(r1(i), cell%hmat(i, i))-cell%hmat(i, i)/2._dp + r(i) = MODULO(r(i), cell%hmat(i, i)) - cell%hmat(i, i)/2._dp + r1(i) = MODULO(r1(i), cell%hmat(i, i)) - cell%hmat(i, i)/2._dp END DO - dist_vec = (r-r1)-ANINT((r-r1)/cell_v)*cell_v + dist_vec = (r - r1) - ANINT((r - r1)/cell_v)*cell_v IF (becke_control%vector_buffer%store_vectors) THEN becke_control%vector_buffer%position_vecs(:, iatom) = r(:) IF (iatom == 1 .AND. jatom == natom) becke_control%vector_buffer%position_vecs(:, jatom) = r1(:) @@ -300,9 +300,9 @@ SUBROUTINE becke_constraint_low(qs_env, just_gradients) IF (becke_control%cavity%pw%cr3d(k, j, i) < eps_cavity) CYCLE END IF ind = (/k, j, i/) - grid_p(1) = k*dr(1)+shift(1) - grid_p(2) = j*dr(2)+shift(2) - grid_p(3) = i*dr(3)+shift(3) + grid_p(1) = k*dr(1) + shift(1) + grid_p(2) = j*dr(2) + shift(2) + grid_p(3) = i*dr(3) + shift(3) nskipped = 0 cell_functions = 1.0_dp skip_me = .FALSE. @@ -319,7 +319,7 @@ SUBROUTINE becke_constraint_low(qs_env, just_gradients) IF (skip_me(iatom)) THEN cell_functions(iatom) = 0.0_dp IF (becke_control%should_skip) THEN - IF (is_constraint(iatom)) nskipped = nskipped+1 + IF (is_constraint(iatom)) nskipped = nskipped + 1 IF (nskipped == cdft_control%natoms) THEN IF (in_memory) THEN IF (becke_control%cavity_confine) THEN @@ -334,7 +334,7 @@ SUBROUTINE becke_constraint_low(qs_env, just_gradients) IF (becke_control%vector_buffer%store_vectors) THEN IF (becke_control%vector_buffer%distances(iatom) .EQ. 0.0_dp) THEN r = becke_control%vector_buffer%position_vecs(:, iatom) - dist_vec = (r-grid_p)-ANINT((r-grid_p)/cell_v)*cell_v + dist_vec = (r - grid_p) - ANINT((r - grid_p)/cell_v)*cell_v dist1 = SQRT(DOT_PRODUCT(dist_vec, dist_vec)) becke_control%vector_buffer%distance_vecs(:, iatom) = dist_vec becke_control%vector_buffer%distances(iatom) = dist1 @@ -345,9 +345,9 @@ SUBROUTINE becke_constraint_low(qs_env, just_gradients) ELSE r = particle_set(iatom)%r DO ip = 1, 3 - r(ip) = MODULO(r(ip), cell%hmat(ip, ip))-cell%hmat(ip, ip)/2._dp + r(ip) = MODULO(r(ip), cell%hmat(ip, ip)) - cell%hmat(ip, ip)/2._dp END DO - dist_vec = (r-grid_p)-ANINT((r-grid_p)/cell_v)*cell_v + dist_vec = (r - grid_p) - ANINT((r - grid_p)/cell_v)*cell_v dist1 = SQRT(DOT_PRODUCT(dist_vec, dist_vec)) END IF IF (dist1 .LE. cutoffs(iatom)) THEN @@ -368,7 +368,7 @@ SUBROUTINE becke_constraint_low(qs_env, just_gradients) IF (becke_control%vector_buffer%store_vectors) THEN IF (becke_control%vector_buffer%distances(jatom) .EQ. 0.0_dp) THEN r1 = becke_control%vector_buffer%position_vecs(:, jatom) - dist_vec = (r1-grid_p)-ANINT((r1-grid_p)/cell_v)*cell_v + dist_vec = (r1 - grid_p) - ANINT((r1 - grid_p)/cell_v)*cell_v dist2 = SQRT(DOT_PRODUCT(dist_vec, dist_vec)) becke_control%vector_buffer%distance_vecs(:, jatom) = dist_vec becke_control%vector_buffer%distances(jatom) = dist2 @@ -379,44 +379,44 @@ SUBROUTINE becke_constraint_low(qs_env, just_gradients) ELSE r1 = particle_set(jatom)%r DO ip = 1, 3 - r1(ip) = MODULO(r1(ip), cell%hmat(ip, ip))-cell%hmat(ip, ip)/2._dp + r1(ip) = MODULO(r1(ip), cell%hmat(ip, ip)) - cell%hmat(ip, ip)/2._dp END DO - dist_vec = (r1-grid_p)-ANINT((r1-grid_p)/cell_v)*cell_v + dist_vec = (r1 - grid_p) - ANINT((r1 - grid_p)/cell_v)*cell_v dist2 = SQRT(DOT_PRODUCT(dist_vec, dist_vec)) END IF IF (in_memory) THEN IF (becke_control%vector_buffer%store_vectors) THEN dr1_r2 = becke_control%vector_buffer%pair_dist_vecs(:, iatom, jatom) ELSE - dr1_r2 = (r-r1)-ANINT((r-r1)/cell_v)*cell_v + dr1_r2 = (r - r1) - ANINT((r - r1)/cell_v)*cell_v END IF IF (dist2 .LE. th) dist2 = th tmp_const = (becke_control%vector_buffer%R12(iatom, jatom)**3) dr_ij_dR(:) = dr1_r2(:)/tmp_const !derivative w.r.t. Rj dr_j_dR = dist_vec(:)/dist2 - dmy_dR_j(:) = -(dr_j_dR(:)/becke_control%vector_buffer%R12(iatom, jatom)-(dist1-dist2)*dr_ij_dR(:)) + dmy_dR_j(:) = -(dr_j_dR(:)/becke_control%vector_buffer%R12(iatom, jatom) - (dist1 - dist2)*dr_ij_dR(:)) !derivative w.r.t. Ri - dmy_dR_i(:) = dr_i_dR(:)/becke_control%vector_buffer%R12(iatom, jatom)-(dist1-dist2)*dr_ij_dR(:) + dmy_dR_i(:) = dr_i_dR(:)/becke_control%vector_buffer%R12(iatom, jatom) - (dist1 - dist2)*dr_ij_dR(:) END IF ! myij - my1 = (dist1-dist2)/becke_control%vector_buffer%R12(iatom, jatom) + my1 = (dist1 - dist2)/becke_control%vector_buffer%R12(iatom, jatom) IF (becke_control%adjust) THEN my1_homo = my1 ! Homonuclear quantity needed for gradient - my1 = my1+becke_control%aij(iatom, jatom)*(1.0_dp-my1**2) + my1 = my1 + becke_control%aij(iatom, jatom)*(1.0_dp - my1**2) END IF ! f(myij) - myexp = 1.5_dp*my1-0.5_dp*my1**3 + myexp = 1.5_dp*my1 - 0.5_dp*my1**3 IF (in_memory) THEN - dmyexp = 1.5_dp-1.5_dp*my1**2 - tmp_const = (1.5_dp**2)*dmyexp*(1-myexp**2)* & - (1.0_dp-((1.5_dp*myexp-0.5_dp*(myexp**3))**2)) + dmyexp = 1.5_dp - 1.5_dp*my1**2 + tmp_const = (1.5_dp**2)*dmyexp*(1 - myexp**2)* & + (1.0_dp - ((1.5_dp*myexp - 0.5_dp*(myexp**3))**2)) ! d s(myij)/d R_i ds_dR_i(:) = -0.5_dp*tmp_const*dmy_dR_i(:) ! d s(myij)/d R_j ds_dR_j(:) = -0.5_dp*tmp_const*dmy_dR_j(:) IF (becke_control%adjust) THEN - tmp_const = 1.0_dp-2.0_dp*my1_homo* & + tmp_const = 1.0_dp - 2.0_dp*my1_homo* & becke_control%aij(iatom, jatom) ds_dR_i(:) = ds_dR_i(:)*tmp_const ! tmp_const is same for both since aij=-aji and myij=-myji @@ -424,29 +424,29 @@ SUBROUTINE becke_constraint_low(qs_env, just_gradients) END IF END IF ! s(myij) = f[f(f{myij})] - myexp = 1.5_dp*myexp-0.5_dp*myexp**3 - myexp = 1.5_dp*myexp-0.5_dp*myexp**3 - tmp_const = 0.5_dp*(1.0_dp-myexp) + myexp = 1.5_dp*myexp - 0.5_dp*myexp**3 + myexp = 1.5_dp*myexp - 0.5_dp*myexp**3 + tmp_const = 0.5_dp*(1.0_dp - myexp) cell_functions(iatom) = cell_functions(iatom)*tmp_const IF (in_memory) THEN - IF (ABS(tmp_const) .LE. th) tmp_const = tmp_const+th + IF (ABS(tmp_const) .LE. th) tmp_const = tmp_const + th ! P_i independent part of dP_i/dR_i - dP_i_dRi(:, iatom) = dP_i_dRi(:, iatom)+ds_dR_i(:)/tmp_const + dP_i_dRi(:, iatom) = dP_i_dRi(:, iatom) + ds_dR_i(:)/tmp_const ! P_i independent part of dP_i/dR_j dP_i_dRj(:, iatom, jatom) = ds_dR_j(:)/tmp_const END IF IF (dist2 .LE. cutoffs(jatom)) THEN - tmp_const = 0.5_dp*(1.0_dp+myexp) ! s(myji) + tmp_const = 0.5_dp*(1.0_dp + myexp) ! s(myji) cell_functions(jatom) = cell_functions(jatom)*tmp_const IF (in_memory) THEN - IF (ABS(tmp_const) .LE. th) tmp_const = tmp_const+th + IF (ABS(tmp_const) .LE. th) tmp_const = tmp_const + th ! P_j independent part of dP_j/dR_i ! d s(myji)/d R_i = -d s(myij)/d R_i dP_i_dRj(:, jatom, iatom) = -ds_dR_i(:)/tmp_const ! P_j independent part of dP_j/dR_j ! d s(myji)/d R_j = -d s(myij)/d R_j - dP_i_dRi(:, jatom) = dP_i_dRi(:, jatom)-ds_dR_j(:)/tmp_const + dP_i_dRi(:, jatom) = dP_i_dRi(:, jatom) - ds_dR_j(:)/tmp_const END IF ELSE skip_me(jatom) = .TRUE. @@ -457,7 +457,7 @@ SUBROUTINE becke_constraint_low(qs_env, just_gradients) ! Final value of dP_i_dRi dP_i_dRi(:, iatom) = cell_functions(iatom)*dP_i_dRi(:, iatom) ! Update relevant sums with value - d_sum_Pm_dR(:, iatom) = d_sum_Pm_dR(:, iatom)+dP_i_dRi(:, iatom) + d_sum_Pm_dR(:, iatom) = d_sum_Pm_dR(:, iatom) + dP_i_dRi(:, iatom) IF (is_constraint(iatom)) THEN DO igroup = 1, SIZE(group) IF (.NOT. atom_in_group(igroup, iatom)) CYCLE @@ -467,7 +467,7 @@ SUBROUTINE becke_constraint_low(qs_env, just_gradients) EXIT END IF END DO - group(igroup)%d_sum_const_dR(1:3, iatom) = group(igroup)%d_sum_const_dR(1:3, iatom)+ & + group(igroup)%d_sum_const_dR(1:3, iatom) = group(igroup)%d_sum_const_dR(1:3, iatom) + & group(igroup)%coeff(ip)*dP_i_dRi(:, iatom) END DO END IF @@ -476,7 +476,7 @@ SUBROUTINE becke_constraint_low(qs_env, just_gradients) ! Final value of dP_i_dRj dP_i_dRj(:, iatom, jatom) = cell_functions(iatom)*dP_i_dRj(:, iatom, jatom) ! Update where needed - d_sum_Pm_dR(:, jatom) = d_sum_Pm_dR(:, jatom)+dP_i_dRj(:, iatom, jatom) + d_sum_Pm_dR(:, jatom) = d_sum_Pm_dR(:, jatom) + dP_i_dRj(:, iatom, jatom) IF (is_constraint(iatom)) THEN DO igroup = 1, SIZE(group) IF (.NOT. atom_in_group(igroup, iatom)) CYCLE @@ -487,7 +487,7 @@ SUBROUTINE becke_constraint_low(qs_env, just_gradients) EXIT END IF END DO - group(igroup)%d_sum_const_dR(1:3, jatom) = group(igroup)%d_sum_const_dR(1:3, jatom)+ & + group(igroup)%d_sum_const_dR(1:3, jatom) = group(igroup)%d_sum_const_dR(1:3, jatom) + & group(igroup)%coeff(ip)* & dP_i_dRj(:, iatom, jatom) END DO @@ -499,7 +499,7 @@ SUBROUTINE becke_constraint_low(qs_env, just_gradients) cell_functions(iatom) = 0.0_dp skip_me(iatom) = .TRUE. IF (becke_control%should_skip) THEN - IF (is_constraint(iatom)) nskipped = nskipped+1 + IF (is_constraint(iatom)) nskipped = nskipped + 1 IF (nskipped == cdft_control%natoms) THEN IF (in_memory) THEN IF (becke_control%cavity_confine) THEN @@ -516,20 +516,20 @@ SUBROUTINE becke_constraint_low(qs_env, just_gradients) sum_cell_f_group = 0.0_dp DO igroup = 1, SIZE(group) DO ip = 1, SIZE(group(igroup)%atoms) - sum_cell_f_group(igroup) = sum_cell_f_group(igroup)+group(igroup)%coeff(ip)* & + sum_cell_f_group(igroup) = sum_cell_f_group(igroup) + group(igroup)%coeff(ip)* & cell_functions(group(igroup)%atoms(ip)) END DO END DO sum_cell_f_all = 0.0_dp DO ip = 1, natom - sum_cell_f_all = sum_cell_f_all+cell_functions(ip) + sum_cell_f_all = sum_cell_f_all + cell_functions(ip) END DO ! Gradients at (k,j,i) IF (in_memory .AND. ABS(sum_cell_f_all) .GT. 0.0_dp) THEN DO igroup = 1, SIZE(group) DO iatom = 1, natom - group(igroup)%gradients(3*(iatom-1)+1:3*(iatom-1)+3, k, j, i) = & - group(igroup)%d_sum_const_dR(1:3, iatom)/sum_cell_f_all-sum_cell_f_group(igroup)* & + group(igroup)%gradients(3*(iatom - 1) + 1:3*(iatom - 1) + 3, k, j, i) = & + group(igroup)%d_sum_const_dR(1:3, iatom)/sum_cell_f_all - sum_cell_f_group(igroup)* & d_sum_Pm_dR(1:3, iatom)/(sum_cell_f_all**2) END DO END DO @@ -666,7 +666,7 @@ SUBROUTINE becke_constraint_force(qs_env) DO igroup = 1, SIZE(group) DO iatom = 1, natom DO ispin = 1, dft_control%nspins - SELECT CASE (group (igroup)%constraint_type) + SELECT CASE (group(igroup)%constraint_type) CASE (cdft_charge_constraint) sign = 1.0_dp CASE (cdft_magnetization_constraint) @@ -684,8 +684,8 @@ SUBROUTINE becke_constraint_force(qs_env) CASE DEFAULT CPABORT("Unknown constraint type.") END SELECT - group(igroup)%integrated(:, iatom) = group(igroup)%integrated(:, iatom)+sign* & - group(igroup)%gradients(3*(iatom-1)+1:3*(iatom-1)+3, k, j, i)* & + group(igroup)%integrated(:, iatom) = group(igroup)%integrated(:, iatom) + sign* & + group(igroup)%gradients(3*(iatom - 1) + 1:3*(iatom - 1) + 3, k, j, i)* & rho_r(ispin)%pw%cr3d(k, j, i)*dvol END DO END DO @@ -702,7 +702,7 @@ SUBROUTINE becke_constraint_force(qs_env) DO igroup = 1, SIZE(group) DO iatom = 1, natom DO ispin = 1, dft_control%nspins - SELECT CASE (group (igroup)%constraint_type) + SELECT CASE (group(igroup)%constraint_type) CASE (cdft_charge_constraint) sign = 1.0_dp CASE (cdft_magnetization_constraint) @@ -720,8 +720,8 @@ SUBROUTINE becke_constraint_force(qs_env) CASE DEFAULT CPABORT("Unknown constraint type.") END SELECT - group(igroup)%integrated(:, iatom) = group(igroup)%integrated(:, iatom)+sign* & - group(igroup)%gradients(3*(iatom-1)+1:3*(iatom-1)+3, k, j, i)* & + group(igroup)%integrated(:, iatom) = group(igroup)%integrated(:, iatom) + sign* & + group(igroup)%gradients(3*(iatom - 1) + 1:3*(iatom - 1) + 3, k, j, i)* & rho_r(ispin)%pw%cr3d(k, j, i)*dvol END DO END DO @@ -746,7 +746,7 @@ SUBROUTINE becke_constraint_force(qs_env) DO iatom = 1, natom ikind = kind_of(iatom) i = atom_of_kind(iatom) - force(ikind)%rho_elec(:, i) = force(ikind)%rho_elec(:, i)+group(igroup)%integrated(:, iatom)*strength(igroup) + force(ikind)%rho_elec(:, i) = force(ikind)%rho_elec(:, i) + group(igroup)%integrated(:, iatom)*strength(igroup) END DO END DO END IF @@ -836,7 +836,7 @@ SUBROUTINE cdft_constraint_integrate(qs_env) ! Calculate value of constraint i.e. int ( rho(r) w(r) dr) DO i = 1, dft_control%nspins DO igroup = 1, SIZE(group) - SELECT CASE (group (igroup)%constraint_type) + SELECT CASE (group(igroup)%constraint_type) CASE (cdft_charge_constraint) sign = 1.0_dp CASE (cdft_magnetization_constraint) @@ -860,10 +860,10 @@ SUBROUTINE cdft_constraint_integrate(qs_env) IF (igroup /= 1) & CALL cp_abort(__LOCATION__, & "Multiple constraints not yet supported by parallel mixed calculations.") - dE(igroup) = dE(igroup)+sign*accurate_dot_product(group(igroup)%weight%pw%cr3d, rho_r(i)%pw%cr3d, & - becke_control%cavity_mat, eps_cavity)*dvol + dE(igroup) = dE(igroup) + sign*accurate_dot_product(group(igroup)%weight%pw%cr3d, rho_r(i)%pw%cr3d, & + becke_control%cavity_mat, eps_cavity)*dvol ELSE - dE(igroup) = dE(igroup)+sign*accurate_sum(group(igroup)%weight%pw%cr3d*rho_r(i)%pw%cr3d)*dvol + dE(igroup) = dE(igroup) + sign*accurate_sum(group(igroup)%weight%pw%cr3d*rho_r(i)%pw%cr3d)*dvol END IF END DO IF (cdft_control%atomic_charges) THEN @@ -893,7 +893,7 @@ SUBROUTINE cdft_constraint_integrate(qs_env) DO i = 1, dft_control%nspins DO igroup = 1, SIZE(group) DO iatom = 1, SIZE(group(igroup)%atoms) - SELECT CASE (group (igroup)%constraint_type) + SELECT CASE (group(igroup)%constraint_type) CASE (cdft_charge_constraint) sign = 1.0_dp CASE (cdft_magnetization_constraint) @@ -915,7 +915,7 @@ SUBROUTINE cdft_constraint_integrate(qs_env) CALL get_atomic_kind(particle_set(jatom)%atomic_kind, kind_number=ikind) CALL get_qs_kind(qs_kind_set(ikind), paw_atom=paw_atom) IF (paw_atom) THEN - gapw_offset(igroup, i) = gapw_offset(igroup, i)+sign*group(igroup)%coeff(iatom)*mp_rho(jatom)%q0(i) + gapw_offset(igroup, i) = gapw_offset(igroup, i) + sign*group(igroup)%coeff(iatom)*mp_rho(jatom)%q0(i) END IF END DO END DO @@ -927,14 +927,14 @@ SUBROUTINE cdft_constraint_integrate(qs_env) CALL get_qs_kind(qs_kind_set(ikind), paw_atom=paw_atom) IF (paw_atom) THEN DO i = 1, dft_control%nspins - electronic_charge(iatom, i) = electronic_charge(iatom, i)+mp_rho(jatom)%q0(i) + electronic_charge(iatom, i) = electronic_charge(iatom, i) + mp_rho(jatom)%q0(i) END DO END IF END DO END IF DO i = 1, dft_control%nspins DO ivar = 1, nvar - dE(ivar) = dE(ivar)+gapw_offset(ivar, i) + dE(ivar) = dE(ivar) + gapw_offset(ivar, i) END DO END DO DEALLOCATE (gapw_offset) @@ -943,7 +943,7 @@ SUBROUTINE cdft_constraint_integrate(qs_env) cdft_control%value(:) = dE(:) energy%cdft = 0.0_dp DO ivar = 1, nvar - energy%cdft = energy%cdft+(dE(ivar)-target_val(ivar))*strength(ivar) + energy%cdft = energy%cdft + (dE(ivar) - target_val(ivar))*strength(ivar) END DO ! Print constraint info and atomic CDFT charges CALL cdft_constraint_print(qs_env, electronic_charge) @@ -1010,7 +1010,7 @@ SUBROUTINE prepare_fragment_constraint(qs_env) multiplier = 1.0_dp nfrag_spins = 1 DO igroup = 1, SIZE(group) - SELECT CASE (group (igroup)%constraint_type) + SELECT CASE (group(igroup)%constraint_type) CASE (cdft_charge_constraint) ! Do nothing CASE (cdft_magnetization_constraint) @@ -1081,11 +1081,11 @@ SUBROUTINE prepare_fragment_constraint(qs_env) i = 2 END IF IF (is_becke .AND. (cdft_control%external_control .AND. becke_control%cavity_confine)) THEN - cdft_control%target(igroup) = cdft_control%target(igroup)+ & + cdft_control%target(igroup) = cdft_control%target(igroup) + & accurate_dot_product(group(igroup)%weight%pw%cr3d, rho_frag(i)%pw%cr3d, & becke_control%cavity_mat, becke_control%eps_cavity)*dvol ELSE - cdft_control%target(igroup) = cdft_control%target(igroup)+ & + cdft_control%target(igroup) = cdft_control%target(igroup) + & accurate_sum(group(igroup)%weight%pw%cr3d*rho_frag(i)%pw%cr3d)*dvol END IF END DO @@ -1267,11 +1267,11 @@ SUBROUTINE hirshfeld_constraint_low(qs_env) IF (rs_rho_all%desc%parallel .AND. .NOT. rs_rho_all%desc%distributed) THEN ! replicated realspace grid, split the atoms up between procs IF (MODULO(iatom, rs_rho_all%desc%group_size) == rs_rho_all%desc%my_pos) THEN - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF ELSE - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF END DO diff --git a/src/qs_cdft_scf_utils.F b/src/qs_cdft_scf_utils.F index 530054d07b..eba4594dc5 100644 --- a/src/qs_cdft_scf_utils.F +++ b/src/qs_cdft_scf_utils.F @@ -233,14 +233,14 @@ SUBROUTINE build_diagonal_jacobian(qs_env, used_history) use_md_history = .TRUE. ! Check that none of the history values are identical in which case we should try something different DO i = 1, nvar - IF (ABS(variable_history(i, 2)-variable_history(i, 1)) .LT. 1.0E-12_dp) & + IF (ABS(variable_history(i, 2) - variable_history(i, 1)) .LT. 1.0E-12_dp) & use_md_history = .FALSE. END DO IF (use_md_history) THEN ALLOCATE (jacobian(nvar, nvar)) DO i = 1, nvar - jacobian(i, i) = (gradient_history(i, 2)-gradient_history(i, 1))/ & - (variable_history(i, 2)-variable_history(i, 1)) + jacobian(i, i) = (gradient_history(i, 2) - gradient_history(i, 1))/ & + (variable_history(i, 2) - variable_history(i, 1)) END DO IF (.NOT. ASSOCIATED(scf_env%outer_scf%inv_jacobian)) & ALLOCATE (scf_env%outer_scf%inv_jacobian(nvar, nvar)) @@ -263,8 +263,8 @@ SUBROUTINE build_diagonal_jacobian(qs_env, used_history) "to 3 for optimizers that build the Jacobian from SCF history.") ALLOCATE (jacobian(nvar, nvar)) DO i = 1, nvar - jacobian(i, i) = (scf_env%outer_scf%gradient(i, ihistory)-scf_env%outer_scf%gradient(i, ihistory-1))/ & - (scf_env%outer_scf%variables(i, ihistory)-scf_env%outer_scf%variables(i, ihistory-1)) + jacobian(i, i) = (scf_env%outer_scf%gradient(i, ihistory) - scf_env%outer_scf%gradient(i, ihistory - 1))/ & + (scf_env%outer_scf%variables(i, ihistory) - scf_env%outer_scf%variables(i, ihistory - 1)) END DO IF (.NOT. ASSOCIATED(scf_env%outer_scf%inv_jacobian)) & ALLOCATE (scf_env%outer_scf%inv_jacobian(nvar, nvar)) @@ -311,7 +311,7 @@ SUBROUTINE restart_inverse_jacobian(qs_env) DO i = 1, nvar DO j = 1, nvar inv_jacobian(i, j) = scf_control%outer_scf%cdft_opt_control%jacobian_vector(iwork) - iwork = iwork+1 + iwork = iwork + 1 END DO END DO DEALLOCATE (scf_control%outer_scf%cdft_opt_control%jacobian_vector) @@ -345,7 +345,7 @@ SUBROUTINE print_inverse_jacobian(logger, inv_jacobian, iter_count) output_unit = get_unit_number() project_name = logger%iter_info%project_name lp = LEN_TRIM(project_name) - project_name(lp+1:LEN(project_name)) = ".inverseJacobian" + project_name(lp + 1:LEN(project_name)) = ".inverseJacobian" CALL open_file(file_name=project_name, file_status="UNKNOWN", & file_action="WRITE", file_position="APPEND", & unit_number=output_unit) @@ -383,7 +383,7 @@ SUBROUTINE create_tmp_logger(para_env, project_name, suffix, output_unit, tmp_lo IF (para_env%ionode) THEN lp = LEN_TRIM(project_name) - project_name(lp+1:LEN(project_name)) = suffix + project_name(lp + 1:LEN(project_name)) = suffix CALL open_file(file_name=project_name, file_status="UNKNOWN", & file_action="WRITE", file_position="APPEND", & unit_number=output_unit) diff --git a/src/qs_cdft_types.F b/src/qs_cdft_types.F index 4ac264131b..d1bd3ba48e 100644 --- a/src/qs_cdft_types.F +++ b/src/qs_cdft_types.F @@ -433,7 +433,7 @@ SUBROUTINE cdft_control_release(cdft_control) CPASSERT(ASSOCIATED(cdft_control)) CPASSERT(cdft_control%ref_count > 0) - cdft_control%ref_count = cdft_control%ref_count-1 + cdft_control%ref_count = cdft_control%ref_count - 1 IF (cdft_control%ref_count == 0) THEN ! Constraint settings IF (ASSOCIATED(cdft_control%atoms)) & @@ -515,7 +515,7 @@ SUBROUTINE cdft_control_retain(cdft_control) routineP = moduleN//':'//routineN CPASSERT(ASSOCIATED(cdft_control)) - cdft_control%ref_count = cdft_control%ref_count+1 + cdft_control%ref_count = cdft_control%ref_count + 1 END SUBROUTINE cdft_control_retain ! ************************************************************************************************** diff --git a/src/qs_cdft_utils.F b/src/qs_cdft_utils.F index 49ce297a8f..a2b1307924 100644 --- a/src/qs_cdft_utils.F +++ b/src/qs_cdft_utils.F @@ -223,15 +223,15 @@ SUBROUTINE becke_constraint_init(qs_env) DO i = 1, 3 cell_v(i) = cell%hmat(i, i) END DO - DO iatom = 1, natom-1 - DO jatom = iatom+1, natom + DO iatom = 1, natom - 1 + DO jatom = iatom + 1, natom r = particle_set(iatom)%r r1 = particle_set(jatom)%r DO i = 1, 3 - r(i) = MODULO(r(i), cell%hmat(i, i))-cell%hmat(i, i)/2._dp - r1(i) = MODULO(r1(i), cell%hmat(i, i))-cell%hmat(i, i)/2._dp + r(i) = MODULO(r(i), cell%hmat(i, i)) - cell%hmat(i, i)/2._dp + r1(i) = MODULO(r1(i), cell%hmat(i, i)) - cell%hmat(i, i)/2._dp END DO - dist_vec = (r-r1)-ANINT((r-r1)/cell_v)*cell_v + dist_vec = (r - r1) - ANINT((r - r1)/cell_v)*cell_v ! Store pbc corrected position and pairwise distance vectors for later reuse IF (becke_control%vector_buffer%store_vectors) THEN becke_control%vector_buffer%position_vecs(:, iatom) = r(:) @@ -251,8 +251,8 @@ SUBROUTINE becke_constraint_init(qs_env) jrcov = becke_control%radii(ikind) IF (ircov .NE. jrcov) THEN chi = ircov/jrcov - uij = (chi-1.0_dp)/(chi+1.0_dp) - becke_control%aij(iatom, jatom) = uij/(uij**2-1.0_dp) + uij = (chi - 1.0_dp)/(chi + 1.0_dp) + becke_control%aij(iatom, jatom) = uij/(uij**2 - 1.0_dp) IF (becke_control%aij(iatom, jatom) .GT. 0.5_dp) THEN becke_control%aij(iatom, jatom) = 0.5_dp ELSE IF (becke_control%aij(iatom, jatom) .LT. -0.5_dp) THEN @@ -357,11 +357,11 @@ SUBROUTINE becke_constraint_init(qs_env) IF (rs_cavity%desc%parallel .AND. .NOT. rs_cavity%desc%distributed) THEN ! replicated realspace grid, split the atoms up between procs IF (MODULO(iatom, rs_cavity%desc%group_size) == rs_cavity%desc%my_pos) THEN - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF ELSE - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF END DO @@ -370,7 +370,7 @@ SUBROUTINE becke_constraint_init(qs_env) atom_a = atom_list(iatom) pab(1, 1) = coef IF (becke_control%vector_buffer%store_vectors) THEN - ra(:) = becke_control%vector_buffer%position_vecs(:, atom_a)+cell_v(:)/2._dp + ra(:) = becke_control%vector_buffer%position_vecs(:, atom_a) + cell_v(:)/2._dp ELSE ra(:) = pbc(particle_set(atom_a)%r, cell) END IF @@ -401,7 +401,7 @@ SUBROUTINE becke_constraint_init(qs_env) ! Save bounds (first nonzero grid point indices) bo = group(1)%weight%pw%pw_grid%bounds_local IF (bounds(2) .LT. bo(2, 3)) THEN - bounds(2) = bounds(2)-1 + bounds(2) = bounds(2) - 1 ELSE bounds(2) = bo(2, 3) END IF @@ -409,7 +409,7 @@ SUBROUTINE becke_constraint_init(qs_env) ! In the special case bounds(1) == bounds(2) == bo(2, 3), after this check ! bounds(1) > bounds(2) and the subsequent gradient allocation (:, :, :, bounds(1):bounds(2)) ! will correctly allocate a 0-sized array - bounds(1) = bounds(1)+1 + bounds(1) = bounds(1) + 1 ELSE bounds(1) = bo(1, 3) END IF @@ -559,20 +559,20 @@ SUBROUTINE read_constraint_definitions(cdft_control, cdft_control_section) CALL section_vals_val_get(group_section, "ATOMS", i_rep_section=k, i_rep_val=j, i_vals=tmplist) IF (SIZE(tmplist) < 1) & CPABORT("Each ATOM_GROUP must contain at least 1 atom.") - natoms = natoms+SIZE(tmplist) + natoms = natoms + SIZE(tmplist) END DO ALLOCATE (cdft_control%group(k)%atoms(natoms)) ALLOCATE (cdft_control%group(k)%coeff(natoms)) NULLIFY (cdft_control%group(k)%weight%pw) NULLIFY (cdft_control%group(k)%gradients) NULLIFY (cdft_control%group(k)%integrated) - tot_natoms = tot_natoms+natoms + tot_natoms = tot_natoms + natoms ! Now parse jj = 0 DO j = 1, n_rep CALL section_vals_val_get(group_section, "ATOMS", i_rep_section=k, i_rep_val=j, i_vals=tmplist) DO i = 1, SIZE(tmplist) - jj = jj+1 + jj = jj + 1 cdft_control%group(k)%atoms(jj) = tmplist(i) END DO END DO @@ -581,7 +581,7 @@ SUBROUTINE read_constraint_definitions(cdft_control, cdft_control_section) DO j = 1, n_rep CALL section_vals_val_get(group_section, "COEFF", i_rep_section=k, i_rep_val=j, r_vals=rtmplist) DO i = 1, SIZE(rtmplist) - jj = jj+1 + jj = jj + 1 IF (jj > natoms) CPABORT("Length of keywords ATOMS and COEFF must match.") IF (ABS(rtmplist(i)) /= 1.0_dp) CPABORT("Keyword COEFF accepts only values +/-1.0") cdft_control%group(k)%coeff(jj) = rtmplist(i) @@ -601,14 +601,14 @@ SUBROUTINE read_constraint_definitions(cdft_control, cdft_control_section) DO k = 1, nvar DO j = 1, SIZE(cdft_control%group(k)%atoms) is_duplicate = .FALSE. - DO i = 1, jj+1 + DO i = 1, jj + 1 IF (cdft_control%group(k)%atoms(j) == atomlist(i)) THEN is_duplicate = .TRUE. EXIT END IF END DO IF (.NOT. is_duplicate) THEN - jj = jj+1 + jj = jj + 1 atomlist(jj) = cdft_control%group(k)%atoms(j) END IF END DO @@ -628,7 +628,7 @@ SUBROUTINE read_constraint_definitions(cdft_control, cdft_control_section) CALL section_vals_val_get(group_section, "ATOMS", i_rep_val=j, i_vals=tmplist) IF (SIZE(tmplist) < 1) & CPABORT("DUMMY_ATOMS must contain at least 1 atom.") - natoms = natoms+SIZE(tmplist) + natoms = natoms + SIZE(tmplist) END DO ALLOCATE (dummylist(natoms)) ! Now parse @@ -636,13 +636,13 @@ SUBROUTINE read_constraint_definitions(cdft_control, cdft_control_section) DO j = 1, n_rep CALL section_vals_val_get(group_section, "ATOMS", i_rep_val=j, i_vals=tmplist) DO i = 1, SIZE(tmplist) - jj = jj+1 + jj = jj + 1 dummylist(jj) = tmplist(i) END DO END DO ! Check for duplicates DO j = 1, natoms - DO i = j+1, natoms + DO i = j + 1, natoms IF (dummylist(i) == dummylist(j)) & CPABORT("Duplicate atoms defined in section DUMMY_ATOMS.") END DO @@ -659,7 +659,7 @@ SUBROUTINE read_constraint_definitions(cdft_control, cdft_control_section) END IF ! Join dummy atoms and constraint atoms into one list IF (ASSOCIATED(dummylist)) THEN - cdft_control%natoms = SIZE(atomlist)+SIZE(dummylist) + cdft_control%natoms = SIZE(atomlist) + SIZE(dummylist) ELSE cdft_control%natoms = SIZE(atomlist) END IF @@ -668,7 +668,7 @@ SUBROUTINE read_constraint_definitions(cdft_control, cdft_control_section) IF (cdft_control%atomic_charges) ALLOCATE (cdft_control%charge(cdft_control%natoms)) cdft_control%atoms(1:SIZE(atomlist)) = atomlist IF (ASSOCIATED(dummylist)) THEN - cdft_control%atoms(1+SIZE(atomlist):) = dummylist + cdft_control%atoms(1 + SIZE(atomlist):) = dummylist DEALLOCATE (dummylist) END IF cdft_control%is_constraint = .FALSE. @@ -931,7 +931,7 @@ SUBROUTINE hfun_zero(fun, th, just_bounds, bounds) DO i1 = 1, n1 IF (fun(i1, i2, i3) < th) THEN IF (just_bounds) THEN - nzeroed_inner = nzeroed_inner+1 + nzeroed_inner = nzeroed_inner + 1 ELSE fun(i1, i2, i3) = 0.0_dp END IF @@ -941,7 +941,7 @@ SUBROUTINE hfun_zero(fun, th, just_bounds, bounds) END DO IF (just_bounds) THEN IF (nzeroed_inner < n1) EXIT - nzeroed = nzeroed+nzeroed_inner + nzeroed = nzeroed + nzeroed_inner END IF END DO IF (just_bounds) THEN @@ -962,7 +962,7 @@ SUBROUTINE hfun_zero(fun, th, just_bounds, bounds) IF (.NOT. ub_final) ub = n3 bounds(1) = lb bounds(2) = ub - bounds = bounds-(n3/2)-1 + bounds = bounds - (n3/2) - 1 END IF END SUBROUTINE hfun_zero @@ -1157,8 +1157,8 @@ SUBROUTINE cdft_constraint_print(qs_env, electronic_charge) CALL get_qs_kind(qs_kind_set(ikind), zeff=zeff) WRITE (iw, "(i7,T15,A2,T23,L10,T39,F8.3,T61,F8.3,T81,F8.3)") & jatom, ADJUSTR(element_symbol), cdft_control%is_constraint(iatom), zeff, electronic_charge(iatom, 1), & - (zeff-electronic_charge(iatom, 1)) - tc(1) = tc(1)+(zeff-electronic_charge(iatom, 1)) + (zeff - electronic_charge(iatom, 1)) + tc(1) = tc(1) + (zeff - electronic_charge(iatom, 1)) END DO WRITE (iw, '(/,T3,A,T81,F8.3,/)') "Total Charge: ", tc(1) ELSE @@ -1178,10 +1178,10 @@ SUBROUTINE cdft_constraint_print(qs_env, electronic_charge) jatom, ADJUSTR(element_symbol), & cdft_control%is_constraint(iatom), & zeff, electronic_charge(iatom, 1), electronic_charge(iatom, 2), & - (zeff-electronic_charge(iatom, 1)-electronic_charge(iatom, 2)), & - electronic_charge(iatom, 1)-electronic_charge(iatom, 2) - tc(1) = tc(1)+(zeff-electronic_charge(iatom, 1)-electronic_charge(iatom, 2)) - tc(2) = tc(2)+(electronic_charge(iatom, 1)-electronic_charge(iatom, 2)) + (zeff - electronic_charge(iatom, 1) - electronic_charge(iatom, 2)), & + electronic_charge(iatom, 1) - electronic_charge(iatom, 2) + tc(1) = tc(1) + (zeff - electronic_charge(iatom, 1) - electronic_charge(iatom, 2)) + tc(2) = tc(2) + (electronic_charge(iatom, 1) - electronic_charge(iatom, 2)) END DO WRITE (iw, '(/,T3,A,T81,F8.3,T102,F8.3/)') "Total Charge and Spin Moment: ", tc(1), tc(2) END IF @@ -1210,20 +1210,20 @@ SUBROUTINE cdft_constraint_print(qs_env, electronic_charge) cdft_control%is_constraint(iatom), & cdft_control%charges_fragment(iatom, 1), & electronic_charge(iatom, 1), & - (electronic_charge(iatom, 1)- & + (electronic_charge(iatom, 1) - & cdft_control%charges_fragment(iatom, 1)) - tc(1) = tc(1)+(electronic_charge(iatom, 1)- & - cdft_control%charges_fragment(iatom, 1)) + tc(1) = tc(1) + (electronic_charge(iatom, 1) - & + cdft_control%charges_fragment(iatom, 1)) ELSE WRITE (iw, "(i7,T15,A2,T23,L10,T43,F8.3,T57,F8.3,T69,F8.3,T81,F8.3)") & jatom, ADJUSTR(element_symbol), & cdft_control%is_constraint(iatom), & cdft_control%charges_fragment(iatom, 1), & electronic_charge(iatom, 1), electronic_charge(iatom, 2), & - (electronic_charge(iatom, 1)+electronic_charge(iatom, 2)- & + (electronic_charge(iatom, 1) + electronic_charge(iatom, 2) - & cdft_control%charges_fragment(iatom, 1)) - tc(1) = tc(1)+(electronic_charge(iatom, 1)+electronic_charge(iatom, 2)- & - cdft_control%charges_fragment(iatom, 1)) + tc(1) = tc(1) + (electronic_charge(iatom, 1) + electronic_charge(iatom, 2) - & + cdft_control%charges_fragment(iatom, 1)) END IF END DO WRITE (iw, '(/,T3,A,T81,F8.3,/)') "Total Charge: ", tc(1) @@ -1245,14 +1245,14 @@ SUBROUTINE cdft_constraint_print(qs_env, electronic_charge) cdft_control%charges_fragment(iatom, 1), & cdft_control%charges_fragment(iatom, 2), & electronic_charge(iatom, 1), electronic_charge(iatom, 2), & - (electronic_charge(iatom, 1)+electronic_charge(iatom, 2)- & + (electronic_charge(iatom, 1) + electronic_charge(iatom, 2) - & cdft_control%charges_fragment(iatom, 1)), & - (electronic_charge(iatom, 1)-electronic_charge(iatom, 2)- & + (electronic_charge(iatom, 1) - electronic_charge(iatom, 2) - & cdft_control%charges_fragment(iatom, 2)) - tc(1) = tc(1)+(electronic_charge(iatom, 1)+electronic_charge(iatom, 2)- & - cdft_control%charges_fragment(iatom, 1)) - tc(2) = tc(2)+(electronic_charge(iatom, 1)-electronic_charge(iatom, 2)- & - cdft_control%charges_fragment(iatom, 2)) + tc(1) = tc(1) + (electronic_charge(iatom, 1) + electronic_charge(iatom, 2) - & + cdft_control%charges_fragment(iatom, 1)) + tc(2) = tc(2) + (electronic_charge(iatom, 1) - electronic_charge(iatom, 2) - & + cdft_control%charges_fragment(iatom, 2)) END DO WRITE (iw, '(/,T3,A,T90,F8.3,T102,F8.3/)') "Total Charge and Spin Moment: ", tc(1), tc(2) END IF diff --git a/src/qs_charge_mixing.F b/src/qs_charge_mixing.F index 90599f38d5..aaf88603a1 100644 --- a/src/qs_charge_mixing.F +++ b/src/qs_charge_mixing.F @@ -55,30 +55,30 @@ SUBROUTINE charge_mixing(mixing_method, mixing_store, charges, para_env, iter_co IF (mixing_method >= gspace_mixing_nr) THEN CPASSERT(ASSOCIATED(mixing_store)) - mixing_store%ncall = mixing_store%ncall+1 + mixing_store%ncall = mixing_store%ncall + 1 ns = SIZE(charges, 2) ns = MIN(ns, mixing_store%max_shell) alpha = mixing_store%alpha nbuffer = mixing_store%nbuffer - inow = MOD(mixing_store%ncall-1, nbuffer)+1 - imin = inow-1 + inow = MOD(mixing_store%ncall - 1, nbuffer) + 1 + imin = inow - 1 IF (imin == 0) imin = nbuffer IF (mixing_store%ncall > nbuffer) THEN nvec = nbuffer ELSE - nvec = mixing_store%ncall-1 + nvec = mixing_store%ncall - 1 END IF IF (mixing_store%ncall > 1) THEN ! store in/out charge difference DO ia = 1, mixing_store%nat_local ii = mixing_store%atlist(ia) - mixing_store%dacharge(ia, 1:ns, imin) = mixing_store%acharge(ia, 1:ns, imin)-charges(ii, 1:ns) + mixing_store%dacharge(ia, 1:ns, imin) = mixing_store%acharge(ia, 1:ns, imin) - charges(ii, 1:ns) END DO END IF - IF ((iter_count == 1) .OR. (iter_count+1 <= mixing_store%nskip_mixing)) THEN + IF ((iter_count == 1) .OR. (iter_count + 1 <= mixing_store%nskip_mixing)) THEN ! skip mixing mixing_store%iter_method = "NoMix" - ELSEIF (((iter_count+1-mixing_store%nskip_mixing) <= mixing_store%n_simple_mix) .OR. (nvec == 1)) THEN + ELSEIF (((iter_count + 1 - mixing_store%nskip_mixing) <= mixing_store%n_simple_mix) .OR. (nvec == 1)) THEN CALL mix_charges_only(mixing_store, charges, alpha, imin, ns, para_env) mixing_store%iter_method = "Mixing" ELSEIF (mixing_method == gspace_mixing_nr) THEN @@ -132,7 +132,7 @@ SUBROUTINE mix_charges_only(mixing_store, charges, alpha, imin, ns, para_env) DO ia = 1, mixing_store%nat_local ii = mixing_store%atlist(ia) - charges(ii, 1:ns) = alpha*mixing_store%dacharge(ia, 1:ns, imin)-mixing_store%acharge(ia, 1:ns, imin) + charges(ii, 1:ns) = alpha*mixing_store%dacharge(ia, 1:ns, imin) - mixing_store%acharge(ia, 1:ns, imin) END DO CALL mp_sum(charges, para_env%group) @@ -168,9 +168,9 @@ SUBROUTINE broyden_mixing(mixing_store, charges, inow, nvec, ns, para_env) nbuffer = mixing_store%nbuffer alpha = mixing_store%alpha - imin = inow-1 + imin = inow - 1 IF (imin == 0) imin = nvec - nv = nvec-1 + nv = nvec - 1 ! charge vectors q_now => mixing_store%acharge(:, :, inow) @@ -180,14 +180,14 @@ SUBROUTINE broyden_mixing(mixing_store, charges, inow, nvec, ns, para_env) IF (nvec == nbuffer) THEN ! reshuffel Broyden storage n->n-1 - DO i = 1, nv-1 - mixing_store%wbroy(i) = mixing_store%wbroy(i+1) - mixing_store%dfbroy(:, :, i) = mixing_store%dfbroy(:, :, i+1) - mixing_store%ubroy(:, :, i) = mixing_store%ubroy(:, :, i+1) + DO i = 1, nv - 1 + mixing_store%wbroy(i) = mixing_store%wbroy(i + 1) + mixing_store%dfbroy(:, :, i) = mixing_store%dfbroy(:, :, i + 1) + mixing_store%ubroy(:, :, i) = mixing_store%ubroy(:, :, i + 1) END DO - DO i = 1, nv-1 - DO j = 1, nv-1 - mixing_store%abroy(i, j) = mixing_store%abroy(i+1, j+1) + DO i = 1, nv - 1 + DO j = 1, nv - 1 + mixing_store%abroy(i, j) = mixing_store%abroy(i + 1, j + 1) END DO END DO END IF @@ -208,7 +208,7 @@ SUBROUTINE broyden_mixing(mixing_store, charges, inow, nvec, ns, para_env) IF (mixing_store%wbroy(nv) < minw) mixing_store%wbroy(nv) = minw ! dfbroy - mixing_store%dfbroy(:, :, nv) = dq_now(:, :)-dq_last(:, :) + mixing_store%dfbroy(:, :, nv) = dq_now(:, :) - dq_last(:, :) wdf = SUM(mixing_store%dfbroy(:, :, nv)**2) CALL mp_sum(wdf, para_env%group) wdf = 1.0_dp/SQRT(wdf) @@ -234,7 +234,7 @@ SUBROUTINE broyden_mixing(mixing_store, charges, inow, nvec, ns, para_env) DO j = 1, nv beta(j, i) = mixing_store%wbroy(j)*mixing_store%wbroy(i)*mixing_store%abroy(j, i) END DO - beta(i, i) = beta(i, i)+omega0*omega0 + beta(i, i) = beta(i, i) + omega0*omega0 END DO rskip = 1.e-12_dp @@ -242,17 +242,17 @@ SUBROUTINE broyden_mixing(mixing_store, charges, inow, nvec, ns, para_env) gammab(1:nv) = MATMUL(cvec(1:nv), amat(1:nv, 1:nv)) ! build ubroy - mixing_store%ubroy(:, :, nv) = alpha*mixing_store%dfbroy(:, :, nv)+wdf*(q_now(:, :)-q_last(:, :)) + mixing_store%ubroy(:, :, nv) = alpha*mixing_store%dfbroy(:, :, nv) + wdf*(q_now(:, :) - q_last(:, :)) charges = 0.0_dp DO ia = 1, mixing_store%nat_local ii = mixing_store%atlist(ia) - charges(ii, 1:ns) = q_now(ia, 1:ns)+alpha*dq_now(ia, 1:ns) + charges(ii, 1:ns) = q_now(ia, 1:ns) + alpha*dq_now(ia, 1:ns) END DO DO i = 1, nv DO ia = 1, mixing_store%nat_local ii = mixing_store%atlist(ia) - charges(ii, 1:ns) = charges(ii, 1:ns)-mixing_store%wbroy(i)*gammab(i)*mixing_store%ubroy(ia, 1:ns, i) + charges(ii, 1:ns) = charges(ii, 1:ns) - mixing_store%wbroy(i)*gammab(i)*mixing_store%ubroy(ia, 1:ns, i) END DO END DO CALL mp_sum(charges, para_env%group) diff --git a/src/qs_charges_types.F b/src/qs_charges_types.F index 02666fa664..fbd08d4c60 100644 --- a/src/qs_charges_types.F +++ b/src/qs_charges_types.F @@ -100,7 +100,7 @@ SUBROUTINE qs_charges_retain(qs_charges) CPASSERT(ASSOCIATED(qs_charges)) CPASSERT(qs_charges%ref_count > 0) - qs_charges%ref_count = qs_charges%ref_count+1 + qs_charges%ref_count = qs_charges%ref_count + 1 END SUBROUTINE qs_charges_retain ! ************************************************************************************************** @@ -118,7 +118,7 @@ SUBROUTINE qs_charges_release(qs_charges) IF (ASSOCIATED(qs_charges)) THEN CPASSERT(qs_charges%ref_count > 0) - qs_charges%ref_count = qs_charges%ref_count-1 + qs_charges%ref_count = qs_charges%ref_count - 1 IF (qs_charges%ref_count < 1) THEN DEALLOCATE (qs_charges%total_rho1_hard) DEALLOCATE (qs_charges%total_rho1_soft) diff --git a/src/qs_collocate_density.F b/src/qs_collocate_density.F index 1657cb2c05..43f17f4c13 100644 --- a/src/qs_collocate_density.F +++ b/src/qs_collocate_density.F @@ -214,7 +214,7 @@ SUBROUTINE calculate_rho_nlcc(rho_nlcc, qs_env) lmax_global = MAX(MAXVAL(mylmax), lmax_global) END DO !lmax_global set according to ni = 2*nc-2 below - lmax_global = 2*lmax_global-2 + lmax_global = 2*lmax_global - 2 DO ikind = 1, SIZE(atomic_kind_set) CALL get_atomic_kind(atomic_kind_set(ikind), natom=natom, atom_list=atom_list) @@ -231,7 +231,7 @@ SUBROUTINE calculate_rho_nlcc(rho_nlcc, qs_env) alpha = alpha_nlcc(iexp_nlcc) nc = nct_nlcc(iexp_nlcc) - ni = ncoset(2*nc-2) + ni = ncoset(2*nc - 2) ALLOCATE (pab(ni, 1)) pab = 0._dp @@ -300,11 +300,11 @@ SUBROUTINE calculate_rho_nlcc(rho_nlcc, qs_env) IF (rs_rho%desc%parallel .AND. .NOT. rs_rho%desc%distributed) THEN ! replicated realspace grid, split the atoms up between procs IF (MODULO(iatom, rs_rho%desc%group_size) == rs_rho%desc%my_pos) THEN - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF ELSE - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF END DO @@ -315,7 +315,7 @@ SUBROUTINE calculate_rho_nlcc(rho_nlcc, qs_env) atom_a = atom_list(iatom) ra(:) = pbc(particle_set(atom_a)%r, cell) subpatch_pattern = 0 - ni = 2*nc-2 + ni = 2*nc - 2 CALL collocate_pgf_product_rspace(ni, 1/(2*alpha**2), 0, 0, 0.0_dp, 0, ra, & (/0.0_dp, 0.0_dp, 0.0_dp/), 0.0_dp, 1.0_dp, pab, 0, 0, rs_rho, & cell, cube_info, eps_rho_rspace, ga_gb_function=FUNC_AB, & @@ -405,7 +405,7 @@ SUBROUTINE calculate_ppl_grid(vppl, qs_env) CALL get_potential(potential=gth_potential, nexp_ppl=lppl) lmax_global = MAX(lppl, lmax_global) END DO - lmax_global = 2*lmax_global-2 + lmax_global = 2*lmax_global - 2 DO ikind = 1, SIZE(atomic_kind_set) CALL get_atomic_kind(atomic_kind_set(ikind), natom=natom, atom_list=atom_list) @@ -416,7 +416,7 @@ SUBROUTINE calculate_ppl_grid(vppl, qs_env) IF (lppl <= 0) CYCLE - ni = ncoset(2*lppl-2) + ni = ncoset(2*lppl - 2) ALLOCATE (pab(ni, 1)) pab = 0._dp @@ -484,11 +484,11 @@ SUBROUTINE calculate_ppl_grid(vppl, qs_env) IF (rs_rho%desc%parallel .AND. .NOT. rs_rho%desc%distributed) THEN ! replicated realspace grid, split the atoms up between procs IF (MODULO(iatom, rs_rho%desc%group_size) == rs_rho%desc%my_pos) THEN - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF ELSE - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF END DO @@ -500,7 +500,7 @@ SUBROUTINE calculate_ppl_grid(vppl, qs_env) atom_a = atom_list(iatom) ra(:) = pbc(particle_set(atom_a)%r, cell) subpatch_pattern = 0 - ni = 2*lppl-2 + ni = 2*lppl - 2 CALL collocate_pgf_product_rspace(ni, alpha, 0, 0, 0.0_dp, 0, ra, & (/0.0_dp, 0.0_dp, 0.0_dp/), 0.0_dp, 1.0_dp, pab, 0, 0, rs_rho, & cell, cube_info, eps_rho_rspace, ga_gb_function=FUNC_AB, & @@ -674,14 +674,14 @@ SUBROUTINE calculate_lri_rho_elec(lri_rho_g, lri_rho_r, qs_env, & tp(dir) = FLOOR(DOT_PRODUCT(cell%h_inv(dir, :), ra)*rs_grid%desc%npts(dir)) tp(dir) = MODULO(tp(dir), rs_grid%desc%npts(dir)) IF (rs_grid%desc%perd(dir) .NE. 1) THEN - lb(dir) = rs_grid%lb_local(dir)+rs_grid%desc%border - ub(dir) = rs_grid%ub_local(dir)-rs_grid%desc%border + lb(dir) = rs_grid%lb_local(dir) + rs_grid%desc%border + ub(dir) = rs_grid%ub_local(dir) - rs_grid%desc%border ELSE lb(dir) = rs_grid%lb_local(dir) ub(dir) = rs_grid%ub_local(dir) ENDIF ! distributed grid, only map if it is local to the grid - location(dir) = tp(dir)+rs_grid%desc%lb(dir) + location(dir) = tp(dir) + rs_grid%desc%lb(dir) ENDDO IF (lb(1) <= location(1) .AND. location(1) <= ub(1) .AND. & lb(2) <= location(2) .AND. location(2) <= ub(2) .AND. & @@ -693,12 +693,12 @@ SUBROUTINE calculate_lri_rho_elec(lri_rho_g, lri_rho_r, qs_env, & IF (MODULO(offset, group_size) == my_pos) map_it(ipgf) = .TRUE. ENDIF END DO - offset = offset+1 + offset = offset + 1 IF (ANY(map_it(1:npgfa(iset)))) THEN sgfa = first_sgfa(1, iset) ncoa = npgfa(iset)*ncoset(la_max(iset)) - m1 = sgfa+nsgfa(iset)-1 + m1 = sgfa + nsgfa(iset) - 1 ALLOCATE (work(nsgfa(iset), 1)) work(1:nsgfa(iset), 1) = aci(sgfa:m1) pab = 0._dp @@ -708,7 +708,7 @@ SUBROUTINE calculate_lri_rho_elec(lri_rho_g, lri_rho_r, qs_env, & SIZE(pab, 1)) DO ipgf = 1, npgfa(iset) - na1 = (ipgf-1)*ncoset(la_max(iset)) + na1 = (ipgf - 1)*ncoset(la_max(iset)) igrid_level = gaussian_gridlevel(gridlevel_info, zeta(ipgf, iset)) rs_grid => rs_rho(igrid_level)%rs_grid IF (map_it(ipgf)) THEN @@ -781,7 +781,7 @@ SUBROUTINE calculate_lri_rho_elec(lri_rho_g, lri_rho_r, qs_env, & map_it2 = .FALSE. DO ipgf = 1, npgfa(iset) DO jpgf = 1, npgfa(jset) - zetp = zeta(ipgf, iset)+zeta(jpgf, jset) + zetp = zeta(ipgf, iset) + zeta(jpgf, jset) igrid_level = gaussian_gridlevel(gridlevel_info, zetp) rs_grid => rs_rho(igrid_level)%rs_grid IF (.NOT. ALL(rs_grid%desc%perd == 1)) THEN @@ -790,14 +790,14 @@ SUBROUTINE calculate_lri_rho_elec(lri_rho_g, lri_rho_r, qs_env, & tp(dir) = FLOOR(DOT_PRODUCT(cell%h_inv(dir, :), ra)*rs_grid%desc%npts(dir)) tp(dir) = MODULO(tp(dir), rs_grid%desc%npts(dir)) IF (rs_grid%desc%perd(dir) .NE. 1) THEN - lb(dir) = rs_grid%lb_local(dir)+rs_grid%desc%border - ub(dir) = rs_grid%ub_local(dir)-rs_grid%desc%border + lb(dir) = rs_grid%lb_local(dir) + rs_grid%desc%border + ub(dir) = rs_grid%ub_local(dir) - rs_grid%desc%border ELSE lb(dir) = rs_grid%lb_local(dir) ub(dir) = rs_grid%ub_local(dir) ENDIF ! distributed grid, only map if it is local to the grid - location(dir) = tp(dir)+rs_grid%desc%lb(dir) + location(dir) = tp(dir) + rs_grid%desc%lb(dir) ENDDO IF (lb(1) <= location(1) .AND. location(1) <= ub(1) .AND. & lb(2) <= location(2) .AND. location(2) <= ub(2) .AND. & @@ -810,7 +810,7 @@ SUBROUTINE calculate_lri_rho_elec(lri_rho_g, lri_rho_r, qs_env, & ENDIF END DO END DO - offset = offset+1 + offset = offset + 1 ! IF (ANY(map_it2(1:npgfa(iset), 1:npgfa(jset)))) THEN ncoa = npgfa(iset)*ncoset(la_max(iset)) @@ -828,12 +828,12 @@ SUBROUTINE calculate_lri_rho_elec(lri_rho_g, lri_rho_r, qs_env, & 0.0_dp, pab(1, 1), maxco) DO ipgf = 1, npgfa(iset) DO jpgf = 1, npgfa(jset) - zetp = zeta(ipgf, iset)+zeta(jpgf, jset) + zetp = zeta(ipgf, iset) + zeta(jpgf, jset) igrid_level = gaussian_gridlevel(gridlevel_info, zetp) rs_grid => rs_rho(igrid_level)%rs_grid - na1 = (ipgf-1)*ncoset(la_max(iset)) - nb1 = (jpgf-1)*ncoset(la_max(jset)) + na1 = (ipgf - 1)*ncoset(la_max(iset)) + nb1 = (jpgf - 1)*ncoset(la_max(jset)) IF (map_it2(ipgf, jpgf)) THEN CALL collocate_pgf_product_rspace( & @@ -962,11 +962,11 @@ SUBROUTINE calculate_rho_core(rho_core, total_rho, qs_env, only_nopaw) IF (rs_rho%desc%parallel .AND. .NOT. rs_rho%desc%distributed) THEN ! replicated realspace grid, split the atoms up between procs IF (MODULO(iatom, rs_rho%desc%group_size) == rs_rho%desc%my_pos) THEN - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF ELSE - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF END DO @@ -1063,10 +1063,10 @@ SUBROUTINE calculate_rho_single_gaussian(rho_gb, qs_env, iatom_in) IF (rs_rho%desc%parallel .AND. .NOT. rs_rho%desc%distributed) THEN IF (MODULO(iatom, rs_rho%desc%group_size) == rs_rho%desc%my_pos) THEN - npme = npme+1 + npme = npme + 1 ENDIF ELSE - npme = npme+1 + npme = npme + 1 ENDIF IF (npme .GT. 0) THEN @@ -1158,11 +1158,11 @@ SUBROUTINE calculate_rho_metal(rho_metal, coeff, total_rho_metal, qs_env) DO iatom = 1, natom IF (rs_rho%desc%parallel .AND. .NOT. rs_rho%desc%distributed) THEN IF (MODULO(iatom, rs_rho%desc%group_size) == rs_rho%desc%my_pos) THEN - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF ELSE - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF ENDDO @@ -1258,10 +1258,10 @@ SUBROUTINE calculate_rho_resp_single(rho_gb, qs_env, eta, iatom_in) IF (rs_rho%desc%parallel .AND. .NOT. rs_rho%desc%distributed) THEN IF (MODULO(iatom, rs_rho%desc%group_size) == rs_rho%desc%my_pos) THEN - npme = npme+1 + npme = npme + 1 ENDIF ELSE - npme = npme+1 + npme = npme + 1 ENDIF IF (npme .GT. 0) THEN @@ -1355,11 +1355,11 @@ SUBROUTINE calculate_rho_resp_all(rho_resp, coeff, natom, eta, qs_env) DO iatom = 1, natom IF (rs_rho%desc%parallel .AND. .NOT. rs_rho%desc%distributed) THEN IF (MODULO(iatom, rs_rho%desc%group_size) == rs_rho%desc%my_pos) THEN - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF ELSE - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF ENDDO @@ -1482,7 +1482,7 @@ SUBROUTINE calculate_rho_elec(matrix_p, matrix_p_kp, rho, rho_gspace, total_rho, sphi_a, sphi_b, zeta, zetb, first_sgfa, first_sgfb, tasks, pabt, & workt, lgrid, mylmax) - debug_count = debug_count+1 + debug_count = debug_count + 1 ! by default, the full density is calculated my_soft = .FALSE. @@ -1558,8 +1558,8 @@ SUBROUTINE calculate_rho_elec(matrix_p, matrix_p_kp, rho, rho_gspace, total_rho, maxsgf=maxsgf, & maxsgf_set=maxsgf_set, & basis_type=my_basis_type) - CALL reallocate(pabt, 1, maxco, 1, maxco, 0, nthread-1) - CALL reallocate(workt, 1, maxco, 1, maxsgf_set, 0, nthread-1) + CALL reallocate(pabt, 1, maxco, 1, maxco, 0, nthread - 1) + CALL reallocate(workt, 1, maxco, 1, maxsgf_set, 0, nthread - 1) ! find maximum numbers natoms = SIZE(particle_set) @@ -1587,21 +1587,21 @@ SUBROUTINE calculate_rho_elec(matrix_p, matrix_p_kp, rho, rho_gspace, total_rho, ! will be used for collocation SELECT CASE (ga_gb_function) CASE (FUNC_DADB) - lmax_global = lmax_global+1 + lmax_global = lmax_global + 1 CASE (FUNC_ADBmDAB) - lmax_global = lmax_global+1 + lmax_global = lmax_global + 1 CASE (FUNC_DABpADB) - lmax_global = lmax_global+1 + lmax_global = lmax_global + 1 CASE (FUNC_DX, FUNC_DY, FUNC_DZ) - lmax_global = lmax_global+1 + lmax_global = lmax_global + 1 CASE (FUNC_DXDY, FUNC_DYDZ, FUNC_DZDX) - lmax_global = lmax_global+2 + lmax_global = lmax_global + 2 CASE (FUNC_DXDX, FUNC_DYDY, FUNC_DZDZ) - lmax_global = lmax_global+2 + lmax_global = lmax_global + 2 CASE (FUNC_ARDBmDARB) - lmax_global = lmax_global+2 + lmax_global = lmax_global + 2 CASE (FUNC_ARB) - lmax_global = lmax_global+1 + lmax_global = lmax_global + 1 CASE (FUNC_AB) lmax_global = lmax_global CASE DEFAULT @@ -1808,13 +1808,13 @@ SUBROUTINE calculate_rho_elec(matrix_p, matrix_p_kp, rho, rho_gspace, total_rho, ENDIF rab(:) = dist_ab(:, itask) - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) - rb(:) = ra(:)+rab(:) - zetp = zeta(ipgf, iset)+zetb(jpgf, jset) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) + rb(:) = ra(:) + rab(:) + zetp = zeta(ipgf, iset) + zetb(jpgf, jset) - na1 = (ipgf-1)*ncoset(la_max(iset))+1 + na1 = (ipgf - 1)*ncoset(la_max(iset)) + 1 na2 = ipgf*ncoset(la_max(iset)) - nb1 = (jpgf-1)*ncoset(lb_max(jset))+1 + nb1 = (jpgf - 1)*ncoset(lb_max(jset)) + 1 nb2 = jpgf*ncoset(lb_max(jset)) ! takes the density matrix symmetry in account, i.e. off-diagonal blocks need to be mapped 'twice' @@ -1841,7 +1841,7 @@ SUBROUTINE calculate_rho_elec(matrix_p, matrix_p_kp, rho, rho_gspace, total_rho, CALL collocate_pgf_product_rspace( & la_max(iset), zeta(ipgf, iset), la_min(iset), & lb_max(jset), zetb(jpgf, jset), lb_min(jset), & - ra, rab, rab2, scale, pab, na1-1, nb1-1, & + ra, rab, rab2, scale, pab, na1 - 1, nb1 - 1, & rs_rho(igrid_level)%rs_grid, cell, cube_info(igrid_level), & eps_rho_rspace, & ga_gb_function=ga_gb_function, & @@ -1854,7 +1854,7 @@ SUBROUTINE calculate_rho_elec(matrix_p, matrix_p_kp, rho, rho_gspace, total_rho, CALL collocate_pgf_product_rspace( & lb_max(jset), zetb(jpgf, jset), lb_min(jset), & la_max(iset), zeta(ipgf, iset), la_min(iset), & - rb, rab_inv, rab2, scale, pab, nb1-1, na1-1, & + rb, rab_inv, rab2, scale, pab, nb1 - 1, na1 - 1, & rs_rho(igrid_level)%rs_grid, cell, cube_info(igrid_level), & eps_rho_rspace, & ga_gb_function=ga_gb_function, & @@ -1868,7 +1868,7 @@ SUBROUTINE calculate_rho_elec(matrix_p, matrix_p_kp, rho, rho_gspace, total_rho, CALL collocate_pgf_product_rspace( & la_max(iset), zeta(ipgf, iset), la_min(iset), & lb_max(jset), zetb(jpgf, jset), lb_min(jset), & - ra, rab, rab2, scale, pab, na1-1, nb1-1, & + ra, rab, rab2, scale, pab, na1 - 1, nb1 - 1, & rs_rho(igrid_level)%rs_grid, cell, cube_info(igrid_level), & eps_rho_rspace, & ga_gb_function=ga_gb_function, & @@ -1880,7 +1880,7 @@ SUBROUTINE calculate_rho_elec(matrix_p, matrix_p_kp, rho, rho_gspace, total_rho, CALL collocate_pgf_product_rspace( & lb_max(jset), zetb(jpgf, jset), lb_min(jset), & la_max(iset), zeta(ipgf, iset), la_min(iset), & - rb, rab_inv, rab2, scale, pab, nb1-1, na1-1, & + rb, rab_inv, rab2, scale, pab, nb1 - 1, na1 - 1, & rs_rho(igrid_level)%rs_grid, cell, cube_info(igrid_level), & eps_rho_rspace, & ga_gb_function=ga_gb_function, & @@ -1896,12 +1896,12 @@ SUBROUTINE calculate_rho_elec(matrix_p, matrix_p_kp, rho, rho_gspace, total_rho, ! Now sum the thread-local grids back into the rs_grid ! (in parallel, each thread writes to a section of the rs_grid at a time) IF (nthread > 1) THEN - nz = (1+rs_rho(igrid_level)%rs_grid%ub_local(3) & - -rs_rho(igrid_level)%rs_grid%lb_local(3)) - nxy = (1+rs_rho(igrid_level)%rs_grid%ub_local(1) & - -rs_rho(igrid_level)%rs_grid%lb_local(1)) & - *(1+rs_rho(igrid_level)%rs_grid%ub_local(2) & - -rs_rho(igrid_level)%rs_grid%lb_local(2)) + nz = (1 + rs_rho(igrid_level)%rs_grid%ub_local(3) & + - rs_rho(igrid_level)%rs_grid%lb_local(3)) + nxy = (1 + rs_rho(igrid_level)%rs_grid%ub_local(1) & + - rs_rho(igrid_level)%rs_grid%lb_local(1)) & + *(1 + rs_rho(igrid_level)%rs_grid%ub_local(2) & + - rs_rho(igrid_level)%rs_grid%lb_local(2)) ! Work out the number of tree levels, and start the reduction @@ -1909,31 +1909,31 @@ SUBROUTINE calculate_rho_elec(matrix_p, matrix_p_kp, rho, rho_gspace, total_rho, DO nr = 1, nrlevel nblock = 2**nr - nzsize = MIN(nblock, nthread-(ithread/nblock)*nblock) + nzsize = MIN(nblock, nthread - (ithread/nblock)*nblock) itask = MODULO(ithread, nblock) lb = (nz*itask)/nzsize - ub = (nz*(itask+1))/nzsize-1 + ub = (nz*(itask + 1))/nzsize - 1 nw = (ithread/nblock)*nblock - lbw = 1+nxy*lb + lbw = 1 + nxy*lb - n = nw+nblock/2 + n = nw + nblock/2 IF (n < nthread) THEN - lbr = 1+nxy*lb + lbr = 1 + nxy*lb - CALL daxpy(nxy*(1+ub-lb), 1.0_dp, lgrid%r(lbr, n), 1, lgrid%r(lbw, nw), 1) + CALL daxpy(nxy*(1 + ub - lb), 1.0_dp, lgrid%r(lbr, n), 1, lgrid%r(lbw, nw), 1) END IF !$OMP BARRIER END DO ! Copy final result from first local grid to rs_grid lb = (nz*ithread)/nthread - ub = (nz*(ithread+1))/nthread-1 - nzsize = 1+(ub-lb) + ub = (nz*(ithread + 1))/nthread - 1 + nzsize = 1 + (ub - lb) - lb = lb+rs_rho(igrid_level)%rs_grid%lb_local(3) - ub = ub+rs_rho(igrid_level)%rs_grid%lb_local(3) - lbr = 1+nxy*(nz*ithread/nthread) + lb = lb + rs_rho(igrid_level)%rs_grid%lb_local(3) + ub = ub + rs_rho(igrid_level)%rs_grid%lb_local(3) + lbr = 1 + nxy*(nz*ithread/nthread) CALL daxpy(nxy*nzsize, 1.0_dp, lgrid%r(lbr, 0), 1, & rs_rho(igrid_level)%rs_grid%r(:, :, lb:ub), 1) @@ -2036,7 +2036,7 @@ SUBROUTINE calculate_drho_elec(matrix_p, matrix_p_kp, drho, drho_gspace, qs_env, sphi_a, sphi_b, zeta, zetb, first_sgfa, first_sgfb, tasks, pabt, & workt, mylmax) - debug_count = debug_count+1 + debug_count = debug_count + 1 ! by default, the full density is calculated my_soft = .FALSE. @@ -2078,8 +2078,8 @@ SUBROUTINE calculate_drho_elec(matrix_p, matrix_p_kp, drho, drho_gspace, qs_env, maxsgf=maxsgf, & maxsgf_set=maxsgf_set, & basis_type=my_basis_type) - CALL reallocate(pabt, 1, maxco, 1, maxco, 0, nthread-1) - CALL reallocate(workt, 1, maxco, 1, maxsgf_set, 0, nthread-1) + CALL reallocate(pabt, 1, maxco, 1, maxco, 0, nthread - 1) + CALL reallocate(workt, 1, maxco, 1, maxsgf_set, 0, nthread - 1) ! find maximum numbers nimages = dft_control%nimages @@ -2107,7 +2107,7 @@ SUBROUTINE calculate_drho_elec(matrix_p, matrix_p_kp, drho, drho_gspace, qs_env, END DO !update lmax_global since ga_gb_function=FUNC_DABpADB - lmax_global = lmax_global+1 + lmax_global = lmax_global + 1 ! get the task lists IF (my_soft) task_list => task_list_soft @@ -2275,13 +2275,13 @@ SUBROUTINE calculate_drho_elec(matrix_p, matrix_p_kp, drho, drho_gspace, qs_env, ENDIF rab(:) = dist_ab(:, itask) - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) - rb(:) = ra(:)+rab(:) - zetp = zeta(ipgf, iset)+zetb(jpgf, jset) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) + rb(:) = ra(:) + rab(:) + zetp = zeta(ipgf, iset) + zetb(jpgf, jset) - na1 = (ipgf-1)*ncoset(la_max(iset))+1 + na1 = (ipgf - 1)*ncoset(la_max(iset)) + 1 na2 = ipgf*ncoset(la_max(iset)) - nb1 = (jpgf-1)*ncoset(lb_max(jset))+1 + nb1 = (jpgf - 1)*ncoset(lb_max(jset)) + 1 nb2 = jpgf*ncoset(lb_max(jset)) ! takes the density matrix symmetry in account, i.e. off-diagonal blocks need to be mapped 'twice' @@ -2306,7 +2306,7 @@ SUBROUTINE calculate_drho_elec(matrix_p, matrix_p_kp, drho, drho_gspace, qs_env, CALL collocate_pgf_product_rspace( & la_max(iset), zeta(ipgf, iset), la_min(iset), & lb_max(jset), zetb(jpgf, jset), lb_min(jset), & - ra, rab, rab2, scale, pab, na1-1, nb1-1, & + ra, rab, rab2, scale, pab, na1 - 1, nb1 - 1, & rs_rho(igrid_level)%rs_grid, cell, cube_info(igrid_level), & eps_rho_rspace, & ga_gb_function=FUNC_DABpADB, & @@ -2318,7 +2318,7 @@ SUBROUTINE calculate_drho_elec(matrix_p, matrix_p_kp, drho, drho_gspace, qs_env, CALL collocate_pgf_product_rspace( & lb_max(jset), zetb(jpgf, jset), lb_min(jset), & la_max(iset), zeta(ipgf, iset), la_min(iset), & - rb, rab_inv, rab2, scale, pab, nb1-1, na1-1, & + rb, rab_inv, rab2, scale, pab, nb1 - 1, na1 - 1, & rs_rho(igrid_level)%rs_grid, cell, cube_info(igrid_level), & eps_rho_rspace, & ga_gb_function=FUNC_DABpADB, & @@ -2477,7 +2477,7 @@ SUBROUTINE calculate_wavefunction(mo_vectors, ivector, rho, rho_gspace, & group = mgrid_rspace(1)%pw%pw_grid%para%group my_pos = mgrid_rspace(1)%pw%pw_grid%para%my_pos group_size = mgrid_rspace(1)%pw%pw_grid%para%group_size - ALLOCATE (where_is_the_point(0:group_size-1)) + ALLOCATE (where_is_the_point(0:group_size - 1)) !loop over natom to find maximum value of la_max lmax_global = 0 @@ -2511,7 +2511,7 @@ SUBROUTINE calculate_wavefunction(mo_vectors, ivector, rho, rho_gspace, & sgfa = first_sgfa(1, iset) DO i = 1, nsgfa(iset) - work(i, 1) = eigenvector(offset+i) + work(i, 1) = eigenvector(offset + i) ENDDO CALL dgemm("N", "N", ncoa, 1, nsgfa(iset), & @@ -2521,7 +2521,7 @@ SUBROUTINE calculate_wavefunction(mo_vectors, ivector, rho, rho_gspace, & DO ipgf = 1, npgfa(iset) - na1 = (ipgf-1)*ncoset(la_max(iset))+1 + na1 = (ipgf - 1)*ncoset(la_max(iset)) + 1 na2 = ipgf*ncoset(la_max(iset)) scale = 1.0_dp @@ -2536,14 +2536,14 @@ SUBROUTINE calculate_wavefunction(mo_vectors, ivector, rho, rho_gspace, & tp(dir) = FLOOR(DOT_PRODUCT(cell%h_inv(dir, :), ra)*rs_rho(igrid_level)%rs_grid%desc%npts(dir)) tp(dir) = MODULO(tp(dir), rs_rho(igrid_level)%rs_grid%desc%npts(dir)) IF (rs_rho(igrid_level)%rs_grid%desc%perd(dir) .NE. 1) THEN - lb(dir) = rs_rho(igrid_level)%rs_grid%lb_local(dir)+rs_rho(igrid_level)%rs_grid%desc%border - ub(dir) = rs_rho(igrid_level)%rs_grid%ub_local(dir)-rs_rho(igrid_level)%rs_grid%desc%border + lb(dir) = rs_rho(igrid_level)%rs_grid%lb_local(dir) + rs_rho(igrid_level)%rs_grid%desc%border + ub(dir) = rs_rho(igrid_level)%rs_grid%ub_local(dir) - rs_rho(igrid_level)%rs_grid%desc%border ELSE lb(dir) = rs_rho(igrid_level)%rs_grid%lb_local(dir) ub(dir) = rs_rho(igrid_level)%rs_grid%ub_local(dir) ENDIF ! distributed grid, only map if it is local to the grid - location(dir) = tp(dir)+rs_rho(igrid_level)%rs_grid%desc%lb(dir) + location(dir) = tp(dir) + rs_rho(igrid_level)%rs_grid%desc%lb(dir) ENDDO IF (lb(1) <= location(1) .AND. location(1) <= ub(1) .AND. & lb(2) <= location(2) .AND. location(2) <= ub(2) .AND. & @@ -2558,14 +2558,14 @@ SUBROUTINE calculate_wavefunction(mo_vectors, ivector, rho, rho_gspace, & IF (map_it_here) CALL collocate_pgf_product_rspace( & la_max(iset), zeta(ipgf, iset), la_min(iset), & 0, 0.0_dp, 0, & - ra, rab, rab2, scale, pab, na1-1, 0, & + ra, rab, rab2, scale, pab, na1 - 1, 0, & rs_rho(igrid_level)%rs_grid, cell, cube_info(igrid_level), & eps_rho_rspace, map_consistent=.TRUE., ga_gb_function=FUNC_AB, & lmax_global=lmax_global) END DO - offset = offset+nsgfa(iset) + offset = offset + nsgfa(iset) END DO @@ -2693,8 +2693,8 @@ SUBROUTINE collocate_pgf_product_rspace(la_max, zeta, la_min, & INTEGER, ALLOCATABLE, DIMENSION(:, :) :: map REAL(kind=dp) :: p_ele REAL(kind=dp), DIMENSION(0:lmax_global*2, 0:lmax_global, 0:lmax_global, 3) :: alpha - REAL(kind=dp), DIMENSION(((lmax_global*2+1)*(lmax_global*2+2)*(lmax_global*2+3))/6) :: coef_xyz - REAL(kind=dp), DIMENSION(((lmax_global*2+1)*(lmax_global*2+2))/2) :: coef_xyt + REAL(kind=dp), DIMENSION(((lmax_global*2 + 1)*(lmax_global*2 + 2)*(lmax_global*2 + 3))/6) :: coef_xyz + REAL(kind=dp), DIMENSION(((lmax_global*2 + 1)*(lmax_global*2 + 2))/2) :: coef_xyt REAL(kind=dp), DIMENSION(0:lmax_global*2) :: coef_xtt REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: pol_z @@ -2732,12 +2732,12 @@ SUBROUTINE collocate_pgf_product_rspace(la_max, zeta, la_min, & my_collocate_rho0 = .FALSE. END IF - zetp = zeta+zetb + zetp = zeta + zetb f = zetb/zetp rap(:) = f*rab(:) - rbp(:) = rap(:)-rab(:) - rp(:) = ra(:)+rap(:) - rb(:) = ra(:)+rab(:) + rbp(:) = rap(:) - rab(:) + rp(:) = ra(:) + rap(:) + rb(:) = ra(:) + rab(:) ! check to avoid overflows a = MAXVAL(ABS(rsgrid%desc%dh)) @@ -2771,10 +2771,10 @@ SUBROUTINE collocate_pgf_product_rspace(la_max, zeta, la_min, & ! this way we get the same radius as we use for the corresponding density SELECT CASE (ga_gb_function) CASE (FUNC_DADB) - la_max_local = la_max+1 - la_min_local = MAX(la_min-1, 0) - lb_max_local = lb_max+1 - lb_min_local = MAX(lb_min-1, 0) + la_max_local = la_max + 1 + la_min_local = MAX(la_min - 1, 0) + lb_max_local = lb_max + 1 + lb_min_local = MAX(lb_min - 1, 0) ! create a new pab_local so that mapping pab_local with pgf_a pgf_b ! is equivalent to mapping pab with 0.5 * (nabla pgf_a) . (nabla pgf_b) ! (ddx pgf_a ) (ddx pgf_b) = (lax pgf_{a-1x} - 2*zeta*pgf_{a+1x})*(lbx pgf_{b-1x} - 2*zetb*pgf_{b+1x}) @@ -2783,10 +2783,10 @@ SUBROUTINE collocate_pgf_product_rspace(la_max, zeta, la_min, & pab_local = 0.0_dp DO lxa = 0, la_max DO lxb = 0, lb_max - DO lya = 0, la_max-lxa - DO lyb = 0, lb_max-lxb - DO lza = MAX(la_min-lxa-lya, 0), la_max-lxa-lya - DO lzb = MAX(lb_min-lxb-lyb, 0), lb_max-lxb-lyb + DO lya = 0, la_max - lxa + DO lyb = 0, lb_max - lxb + DO lza = MAX(la_min - lxa - lya, 0), la_max - lxa - lya + DO lzb = MAX(lb_min - lxb - lyb, 0), lb_max - lxb - lyb ! this element of pab results in 12 elements of pab_local CALL prepare_dadb(pab_local, pab, lxa, lya, lza, lxb, lyb, lzb, o1, o2, zeta, zetb) @@ -2802,10 +2802,10 @@ SUBROUTINE collocate_pgf_product_rspace(la_max, zeta, la_min, & pab_local = pab_local*0.5_dp CASE (FUNC_ADBmDAB) CPASSERT(PRESENT(idir)) - la_max_local = la_max+1 - la_min_local = MAX(la_min-1, 0) - lb_max_local = lb_max+1 - lb_min_local = MAX(lb_min-1, 0) + la_max_local = la_max + 1 + la_min_local = MAX(la_min - 1, 0) + lb_max_local = lb_max + 1 + lb_min_local = MAX(lb_min - 1, 0) ! create a new pab_local so that mapping pab_local with pgf_a pgf_b ! is equivalent to mapping pab with ! pgf_a (nabla_{idir} pgf_b) - (nabla_{idir} pgf_a) pgf_b @@ -2817,10 +2817,10 @@ SUBROUTINE collocate_pgf_product_rspace(la_max, zeta, la_min, & pab_local = 0.0_dp DO lxa = 0, la_max DO lxb = 0, lb_max - DO lya = 0, la_max-lxa - DO lyb = 0, lb_max-lxb - DO lza = MAX(la_min-lxa-lya, 0), la_max-lxa-lya - DO lzb = MAX(lb_min-lxb-lyb, 0), lb_max-lxb-lyb + DO lya = 0, la_max - lxa + DO lyb = 0, lb_max - lxb + DO lza = MAX(la_min - lxa - lya, 0), la_max - lxa - lya + DO lzb = MAX(lb_min - lxb - lyb, 0), lb_max - lxb - lyb ! this element of pab results in 4 elements of pab_local CALL prepare_adb_m_dab(pab_local, pab, idir, & lxa, lya, lza, lxb, lyb, lzb, o1, o2, zeta, zetb) @@ -2834,10 +2834,10 @@ SUBROUTINE collocate_pgf_product_rspace(la_max, zeta, la_min, & o2_local = 0 CASE (FUNC_DABpADB) CPASSERT(PRESENT(idir)) - la_max_local = la_max+1 - la_min_local = MAX(la_min-1, 0) - lb_max_local = lb_max+1 - lb_min_local = MAX(lb_min-1, 0) + la_max_local = la_max + 1 + la_min_local = MAX(la_min - 1, 0) + lb_max_local = lb_max + 1 + lb_min_local = MAX(lb_min - 1, 0) ! create a new pab_local so that mapping pab_local with pgf_a pgf_b ! is equivalent to mapping pab with ! pgf_a (nabla_{idir} pgf_b) + (nabla_{idir} pgf_a) pgf_b @@ -2849,10 +2849,10 @@ SUBROUTINE collocate_pgf_product_rspace(la_max, zeta, la_min, & pab_local = 0.0_dp DO lxa = 0, la_max DO lxb = 0, lb_max - DO lya = 0, la_max-lxa - DO lyb = 0, lb_max-lxb - DO lza = MAX(la_min-lxa-lya, 0), la_max-lxa-lya - DO lzb = MAX(lb_min-lxb-lyb, 0), lb_max-lxb-lyb + DO lya = 0, la_max - lxa + DO lyb = 0, lb_max - lxb + DO lza = MAX(la_min - lxa - lya, 0), la_max - lxa - lya + DO lzb = MAX(lb_min - lxb - lyb, 0), lb_max - lxb - lyb ! this element of pab results in 4 elements of pab_local CALL prepare_dab_p_adb(pab_local, pab, idir, & lxa, lya, lza, lxb, lyb, lzb, o1, o2, zeta, zetb) @@ -2865,11 +2865,11 @@ SUBROUTINE collocate_pgf_product_rspace(la_max, zeta, la_min, & o1_local = 0 o2_local = 0 CASE (FUNC_DX, FUNC_DY, FUNC_DZ) - ider1 = ga_gb_function-500 - la_max_local = la_max+1 - la_min_local = MAX(la_min-1, 0) - lb_max_local = lb_max+1 - lb_min_local = MAX(lb_min-1, 0) + ider1 = ga_gb_function - 500 + la_max_local = la_max + 1 + la_min_local = MAX(la_min - 1, 0) + lb_max_local = lb_max + 1 + lb_min_local = MAX(lb_min - 1, 0) ! create a new pab_local so that mapping pab_local with pgf_a pgf_b ! is equivalent to mapping pab with ! d_{ider1} pgf_a d_{ider1} pgf_b @@ -2881,10 +2881,10 @@ SUBROUTINE collocate_pgf_product_rspace(la_max, zeta, la_min, & pab_local = 0.0_dp DO lxa = 0, la_max DO lxb = 0, lb_max - DO lya = 0, la_max-lxa - DO lyb = 0, lb_max-lxb - DO lza = MAX(la_min-lxa-lya, 0), la_max-lxa-lya - DO lzb = MAX(lb_min-lxb-lyb, 0), lb_max-lxb-lyb + DO lya = 0, la_max - lxa + DO lyb = 0, lb_max - lxb + DO lza = MAX(la_min - lxa - lya, 0), la_max - lxa - lya + DO lzb = MAX(lb_min - lxb - lyb, 0), lb_max - lxb - lyb ! this element of pab results in 4 elements of pab_local CALL prepare_dIadIb(pab_local, pab, ider1, & lxa, lya, lza, lxb, lyb, lzb, o1, o2, zeta, zetb) @@ -2897,13 +2897,13 @@ SUBROUTINE collocate_pgf_product_rspace(la_max, zeta, la_min, & o1_local = 0 o2_local = 0 CASE (FUNC_DXDY, FUNC_DYDZ, FUNC_DZDX) - ider1 = ga_gb_function-600 - ider2 = ga_gb_function-600+1 - IF (ider2 > 3) ider2 = ider1-2 - la_max_local = la_max+2 - la_min_local = MAX(la_min-2, 0) - lb_max_local = lb_max+2 - lb_min_local = MAX(lb_min-2, 0) + ider1 = ga_gb_function - 600 + ider2 = ga_gb_function - 600 + 1 + IF (ider2 > 3) ider2 = ider1 - 2 + la_max_local = la_max + 2 + la_min_local = MAX(la_min - 2, 0) + lb_max_local = lb_max + 2 + lb_min_local = MAX(lb_min - 2, 0) ! create a new pab_local so that mapping pab_local with pgf_a pgf_b ! is equivalent to mapping pab with ! d_{ider1} pgf_a d_{ider1} pgf_b @@ -2911,10 +2911,10 @@ SUBROUTINE collocate_pgf_product_rspace(la_max, zeta, la_min, & pab_local = 0.0_dp DO lxa = 0, la_max DO lxb = 0, lb_max - DO lya = 0, la_max-lxa - DO lyb = 0, lb_max-lxb - DO lza = MAX(la_min-lxa-lya, 0), la_max-lxa-lya - DO lzb = MAX(lb_min-lxb-lyb, 0), lb_max-lxb-lyb + DO lya = 0, la_max - lxa + DO lyb = 0, lb_max - lxb + DO lza = MAX(la_min - lxa - lya, 0), la_max - lxa - lya + DO lzb = MAX(lb_min - lxb - lyb, 0), lb_max - lxb - lyb ! this element of pab results in 16 elements of pab_local CALL prepare_dijadijb(pab_local, pab, ider1, ider2, & lxa, lya, lza, lxb, lyb, lzb, o1, o2, zeta, zetb) @@ -2927,11 +2927,11 @@ SUBROUTINE collocate_pgf_product_rspace(la_max, zeta, la_min, & o1_local = 0 o2_local = 0 CASE (FUNC_DXDX, FUNC_DYDY, FUNC_DZDZ) - ider1 = ga_gb_function-603 - la_max_local = la_max+2 - la_min_local = MAX(la_min-2, 0) - lb_max_local = lb_max+2 - lb_min_local = MAX(lb_min-2, 0) + ider1 = ga_gb_function - 603 + la_max_local = la_max + 2 + la_min_local = MAX(la_min - 2, 0) + lb_max_local = lb_max + 2 + lb_min_local = MAX(lb_min - 2, 0) ! create a new pab_local so that mapping pab_local with pgf_a pgf_b ! is equivalent to mapping pab with ! dd_{ider1} pgf_a dd_{ider1} pgf_b @@ -2940,10 +2940,10 @@ SUBROUTINE collocate_pgf_product_rspace(la_max, zeta, la_min, & pab_local = 0.0_dp DO lxa = 0, la_max DO lxb = 0, lb_max - DO lya = 0, la_max-lxa - DO lyb = 0, lb_max-lxb - DO lza = MAX(la_min-lxa-lya, 0), la_max-lxa-lya - DO lzb = MAX(lb_min-lxb-lyb, 0), lb_max-lxb-lyb + DO lya = 0, la_max - lxa + DO lyb = 0, lb_max - lxb + DO lza = MAX(la_min - lxa - lya, 0), la_max - lxa - lya + DO lzb = MAX(lb_min - lxb - lyb, 0), lb_max - lxb - lyb ! this element of pab results in 9 elements of pab_local CALL prepare_diiadiib(pab_local, pab, ider1, & lxa, lya, lza, lxb, lyb, lzb, o1, o2, zeta, zetb) @@ -2958,10 +2958,10 @@ SUBROUTINE collocate_pgf_product_rspace(la_max, zeta, la_min, & CASE (FUNC_ARDBmDARB) CPASSERT(PRESENT(idir)) CPASSERT(PRESENT(ir)) - la_max_local = la_max+1 - la_min_local = MAX(la_min-1, 0) - lb_max_local = lb_max+2 - lb_min_local = MAX(lb_min-1, 0) + la_max_local = la_max + 1 + la_min_local = MAX(la_min - 1, 0) + lb_max_local = lb_max + 2 + lb_min_local = MAX(lb_min - 1, 0) ! create a new pab_local so that mapping pab_local with pgf_a pgf_b ! is equivalent to mapping pab with ! pgf_a (r-Rb)_{ir} (nabla_{idir} pgf_b) - (nabla_{idir} pgf_a) (r-Rb)_{ir} pgf_b @@ -2973,10 +2973,10 @@ SUBROUTINE collocate_pgf_product_rspace(la_max, zeta, la_min, & pab_local = 0.0_dp DO lxa = 0, la_max DO lxb = 0, lb_max - DO lya = 0, la_max-lxa - DO lyb = 0, lb_max-lxb - DO lza = MAX(la_min-lxa-lya, 0), la_max-lxa-lya - DO lzb = MAX(lb_min-lxb-lyb, 0), lb_max-lxb-lyb + DO lya = 0, la_max - lxa + DO lyb = 0, lb_max - lxb + DO lza = MAX(la_min - lxa - lya, 0), la_max - lxa - lya + DO lzb = MAX(lb_min - lxb - lyb, 0), lb_max - lxb - lyb ! this element of pab results in 4 elements of pab_local CALL prepare_ardb_m_darb(pab_local, pab, idir, ir, & @@ -2993,7 +2993,7 @@ SUBROUTINE collocate_pgf_product_rspace(la_max, zeta, la_min, & CPASSERT(PRESENT(ir)) la_max_local = la_max la_min_local = la_min - lb_max_local = lb_max+1 + lb_max_local = lb_max + 1 lb_min_local = lb_min ! create a new pab_local so that mapping pab_local with pgf_a pgf_b ! is equivalent to mapping pab with @@ -3002,10 +3002,10 @@ SUBROUTINE collocate_pgf_product_rspace(la_max, zeta, la_min, & pab_local = 0.0_dp DO lxa = 0, la_max DO lxb = 0, lb_max - DO lya = 0, la_max-lxa - DO lyb = 0, lb_max-lxb - DO lza = MAX(la_min-lxa-lya, 0), la_max-lxa-lya - DO lzb = MAX(lb_min-lxb-lyb, 0), lb_max-lxb-lyb + DO lya = 0, la_max - lxa + DO lyb = 0, lb_max - lxb + DO lza = MAX(la_min - lxa - lya, 0), la_max - lxa - lya + DO lzb = MAX(lb_min - lxb - lyb, 0), lb_max - lxb - lyb ! this element of pab results in 4 elements of pab_local CALL prepare_arb(pab_local, pab, ir, lxa, lya, lza, lxb, lyb, lzb, o1, o2) END DO @@ -3055,7 +3055,7 @@ SUBROUTINE collocate_pgf_product_rspace(la_max, zeta, la_min, & ! where p is center of the product gaussian, and lp = la_max + lb_max ! (current implementation is l**7) ! - lp = la_max_local+lb_max_local + lp = la_max_local + lb_max_local ! ! compute polynomial expansion coefs -> (x-a)**lxa (x-b)**lxb -> sum_{ls} alpha(ls,lxa,lxb,1)*(x-p)**ls ! @@ -3070,13 +3070,13 @@ SUBROUTINE collocate_pgf_product_rspace(la_max, zeta, la_min, & binomial_l_lxb = 1.0_dp b = 1.0_dp DO l = 0, lxb - alpha(lxa-l+lxb-k, lxa, lxb, iaxis) = alpha(lxa-l+lxb-k, lxa, lxb, iaxis)+ & - binomial_k_lxa*binomial_l_lxb*a*b - binomial_l_lxb = binomial_l_lxb*REAL(lxb-l, dp)/REAL(l+1, dp) - b = b*(rp(iaxis)-(ra(iaxis)+rab(iaxis))) + alpha(lxa - l + lxb - k, lxa, lxb, iaxis) = alpha(lxa - l + lxb - k, lxa, lxb, iaxis) + & + binomial_k_lxa*binomial_l_lxb*a*b + binomial_l_lxb = binomial_l_lxb*REAL(lxb - l, dp)/REAL(l + 1, dp) + b = b*(rp(iaxis) - (ra(iaxis) + rab(iaxis))) ENDDO - binomial_k_lxa = binomial_k_lxa*REAL(lxa-k, dp)/REAL(k+1, dp) - a = a*(-ra(iaxis)+rp(iaxis)) + binomial_k_lxa = binomial_k_lxa*REAL(lxa - k, dp)/REAL(k + 1, dp) + a = a*(-ra(iaxis) + rp(iaxis)) ENDDO ENDDO ENDDO @@ -3089,9 +3089,9 @@ SUBROUTINE collocate_pgf_product_rspace(la_max, zeta, la_min, & ! lxyz = 0 DO lzp = 0, lp - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1 + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1 coef_xyz(lxyz) = 0.0_dp ENDDO ENDDO @@ -3099,50 +3099,50 @@ SUBROUTINE collocate_pgf_product_rspace(la_max, zeta, la_min, & DO lzb = 0, lb_max_local DO lza = 0, la_max_local lxy = 0 - DO lyp = 0, lp-lza-lzb - DO lxp = 0, lp-lza-lzb-lyp - lxy = lxy+1 + DO lyp = 0, lp - lza - lzb + DO lxp = 0, lp - lza - lzb - lyp + lxy = lxy + 1 coef_xyt(lxy) = 0.0_dp ENDDO - lxy = lxy+lza+lzb + lxy = lxy + lza + lzb ENDDO - DO lyb = 0, lb_max_local-lzb - DO lya = 0, la_max_local-lza - lxpm = (lb_max_local-lzb-lyb)+(la_max_local-lza-lya) + DO lyb = 0, lb_max_local - lzb + DO lya = 0, la_max_local - lza + lxpm = (lb_max_local - lzb - lyb) + (la_max_local - lza - lya) coef_xtt(0:lxpm) = 0.0_dp - DO lxb = MAX(lb_min_local-lzb-lyb, 0), lb_max_local-lzb-lyb - DO lxa = MAX(la_min_local-lza-lya, 0), la_max_local-lza-lya + DO lxb = MAX(lb_min_local - lzb - lyb, 0), lb_max_local - lzb - lyb + DO lxa = MAX(la_min_local - lza - lya, 0), la_max_local - lza - lya ico = coset(lxa, lya, lza) jco = coset(lxb, lyb, lzb) - p_ele = prefactor*pab_local(o1_local+ico, o2_local+jco) - DO lxp = 0, lxa+lxb - coef_xtt(lxp) = coef_xtt(lxp)+p_ele*alpha(lxp, lxa, lxb, 1) + p_ele = prefactor*pab_local(o1_local + ico, o2_local + jco) + DO lxp = 0, lxa + lxb + coef_xtt(lxp) = coef_xtt(lxp) + p_ele*alpha(lxp, lxa, lxb, 1) ENDDO ENDDO ENDDO lxy = 0 - DO lyp = 0, lya+lyb - DO lxp = 0, lp-lza-lzb-lya-lyb - lxy = lxy+1 - coef_xyt(lxy) = coef_xyt(lxy)+alpha(lyp, lya, lyb, 2)*coef_xtt(lxp) + DO lyp = 0, lya + lyb + DO lxp = 0, lp - lza - lzb - lya - lyb + lxy = lxy + 1 + coef_xyt(lxy) = coef_xyt(lxy) + alpha(lyp, lya, lyb, 2)*coef_xtt(lxp) ENDDO - lxy = lxy+lza+lzb+lya+lyb-lyp + lxy = lxy + lza + lzb + lya + lyb - lyp ENDDO ENDDO ENDDO lxyz = 0 - DO lzp = 0, lza+lzb + DO lzp = 0, lza + lzb lxy = 0 - DO lyp = 0, lp-lza-lzb - DO lxp = 0, lp-lza-lzb-lyp - lxy = lxy+1; lxyz = lxyz+1 - coef_xyz(lxyz) = coef_xyz(lxyz)+alpha(lzp, lza, lzb, 3)*coef_xyt(lxy) + DO lyp = 0, lp - lza - lzb + DO lxp = 0, lp - lza - lzb - lyp + lxy = lxy + 1; lxyz = lxyz + 1 + coef_xyz(lxyz) = coef_xyz(lxyz) + alpha(lzp, lza, lzb, 3)*coef_xyt(lxy) ENDDO - lxy = lxy+lza+lzb; lxyz = lxyz+lza+lzb-lzp + lxy = lxy + lza + lzb; lxyz = lxyz + lza + lzb - lzp ENDDO - DO lyp = lp-lza-lzb+1, lp-lzp - DO lxp = 0, lp-lyp-lzp - lxyz = lxyz+1 + DO lyp = lp - lza - lzb + 1, lp - lzp + DO lxp = 0, lp - lyp - lzp + lxyz = lxyz + 1 ENDDO ENDDO ENDDO @@ -3196,29 +3196,29 @@ SUBROUTINE collocate_ortho() ALLOCATE (map(-cmax:cmax, 3)) CALL compute_cube_center(cubecenter, rsgrid%desc, zeta, zetb, ra, rab) - roffset(:) = rp(:)-REAL(cubecenter(:), dp)*dr(:) + roffset(:) = rp(:) - REAL(cubecenter(:), dp)*dr(:) ! *** a mapping so that the ig corresponds to the right grid point DO i = 1, 3 IF (rsgrid%desc%perd(i) == 1) THEN start = lb_cube(i) DO - offset = MODULO(cubecenter(i)+start, ng(i))+1-start - length = MIN(ub_cube(i), ng(i)-offset)-start - DO ig = start, start+length - map(ig, i) = ig+offset + offset = MODULO(cubecenter(i) + start, ng(i)) + 1 - start + length = MIN(ub_cube(i), ng(i) - offset) - start + DO ig = start, start + length + map(ig, i) = ig + offset END DO - IF (start+length .GE. ub_cube(i)) EXIT - start = start+length+1 + IF (start + length .GE. ub_cube(i)) EXIT + start = start + length + 1 END DO ELSE ! this takes partial grid + border regions into account - offset = MODULO(cubecenter(i)+lb_cube(i)+rsgrid%desc%lb(i)-rsgrid%lb_local(i), ng(i))+1-lb_cube(i) + offset = MODULO(cubecenter(i) + lb_cube(i) + rsgrid%desc%lb(i) - rsgrid%lb_local(i), ng(i)) + 1 - lb_cube(i) ! check for out of bounds - IF (ub_cube(i)+offset > UBOUND(grid, i) .OR. lb_cube(i)+offset < LBOUND(grid, i)) THEN + IF (ub_cube(i) + offset > UBOUND(grid, i) .OR. lb_cube(i) + offset < LBOUND(grid, i)) THEN CPASSERT(.FALSE.) ENDIF DO ig = lb_cube(i), ub_cube(i) - map(ig, i) = ig+offset + map(ig, i) = ig + offset END DO END IF ENDDO @@ -3262,41 +3262,41 @@ SUBROUTINE collocate_gauge_ortho() ! sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) jgmin = sphere_bounds(sci) - sci = sci+1 - z = (REAL(kg, dp)+REAL(cubecenter(3), dp))*dr(3) - z2 = (REAL(kg2, dp)+REAL(cubecenter(3), dp))*dr(3) + sci = sci + 1 + z = (REAL(kg, dp) + REAL(cubecenter(3), dp))*dr(3) + z2 = (REAL(kg2, dp) + REAL(cubecenter(3), dp))*dr(3) DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin - y = (REAL(jg, dp)+REAL(cubecenter(2), dp))*dr(2) - y2 = (REAL(jg2, dp)+REAL(cubecenter(2), dp))*dr(2) + sci = sci + 1 + igmax = 1 - igmin + y = (REAL(jg, dp) + REAL(cubecenter(2), dp))*dr(2) + y2 = (REAL(jg2, dp) + REAL(cubecenter(2), dp))*dr(2) DO ig = igmin, igmax i = map(ig, 1) - x = (REAL(ig, dp)+REAL(cubecenter(1), dp))*dr(1) + x = (REAL(ig, dp) + REAL(cubecenter(1), dp))*dr(1) point(1, 1) = x; point(2, 1) = y; point(3, 1) = z point(1, 2) = x; point(2, 2) = y2; point(3, 2) = z point(1, 3) = x; point(2, 3) = y; point(3, 3) = z2 point(1, 4) = x; point(2, 4) = y2; point(3, 4) = z2 ! - res(1) = (point(ir, 1)-rb(ir))-gauge(i, j, k) - res(2) = (point(ir, 2)-rb(ir))-gauge(i, j2, k) - res(3) = (point(ir, 3)-rb(ir))-gauge(i, j, k2) - res(4) = (point(ir, 4)-rb(ir))-gauge(i, j2, k2) + res(1) = (point(ir, 1) - rb(ir)) - gauge(i, j, k) + res(2) = (point(ir, 2) - rb(ir)) - gauge(i, j2, k) + res(3) = (point(ir, 3) - rb(ir)) - gauge(i, j, k2) + res(4) = (point(ir, 4) - rb(ir)) - gauge(i, j2, k2) ! - grid_tmp(i, j, k) = grid_tmp(i, j, k)+grid(i, j, k)*res(1) - grid_tmp(i, j2, k) = grid_tmp(i, j2, k)+grid(i, j2, k)*res(2) - grid_tmp(i, j, k2) = grid_tmp(i, j, k2)+grid(i, j, k2)*res(3) - grid_tmp(i, j2, k2) = grid_tmp(i, j2, k2)+grid(i, j2, k2)*res(4) + grid_tmp(i, j, k) = grid_tmp(i, j, k) + grid(i, j, k)*res(1) + grid_tmp(i, j2, k) = grid_tmp(i, j2, k) + grid(i, j2, k)*res(2) + grid_tmp(i, j, k2) = grid_tmp(i, j, k2) + grid(i, j, k2)*res(3) + grid_tmp(i, j2, k2) = grid_tmp(i, j2, k2) + grid(i, j2, k2)*res(4) ENDDO ENDDO ENDDO @@ -3317,20 +3317,20 @@ SUBROUTINE collocate_ortho_set_to_0() ! sci = 1 kgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO kg = kgmin, 0 - kg2 = 1-kg + kg2 = 1 - kg k = map(kg, 3) k2 = map(kg2, 3) jgmin = sphere_bounds(sci) - sci = sci+1 + sci = sci + 1 DO jg = jgmin, 0 - jg2 = 1-jg + jg2 = 1 - jg j = map(jg, 2) j2 = map(jg2, 2) igmin = sphere_bounds(sci) - sci = sci+1 - igmax = 1-igmin + sci = sci + 1 + igmax = 1 - igmin DO ig = igmin, igmax i = map(ig, 1) grid(i, j, k) = 0.0_dp @@ -3368,16 +3368,16 @@ SUBROUTINE collocate_general_opt() ! sum_{lip,ljp,lkp} P_{lip,ljp,lkp} (i-i_p)**lip (j-j_p)**ljp (k-k_p)**lkp ! - ALLOCATE (coef_ijk(((lp+1)*(lp+2)*(lp+3))/6)) + ALLOCATE (coef_ijk(((lp + 1)*(lp + 2)*(lp + 3))/6)) ! aux mapping array to simplify life ALLOCATE (coef_map(0:lp, 0:lp, 0:lp)) coef_map = HUGE(coef_map) lxyz = 0 DO lzp = 0, lp - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1 + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1 coef_ijk(lxyz) = 0.0_dp coef_map(lxp, lyp, lzp) = lxyz ENDDO @@ -3395,30 +3395,30 @@ SUBROUTINE collocate_general_opt() ALLOCATE (hmatgridp(3, 3, 0:lp)) hmatgridp(:, :, 0) = 1.0_dp DO k = 1, lp - hmatgridp(:, :, k) = hmatgridp(:, :, k-1)*hmatgrid(:, :) + hmatgridp(:, :, k) = hmatgridp(:, :, k - 1)*hmatgrid(:, :) ENDDO lpx = lp DO klx = 0, lpx - DO jlx = 0, lpx-klx - DO ilx = 0, lpx-klx-jlx - lx = ilx+jlx+klx - lpy = lp-lx + DO jlx = 0, lpx - klx + DO ilx = 0, lpx - klx - jlx + lx = ilx + jlx + klx + lpy = lp - lx DO kly = 0, lpy - DO jly = 0, lpy-kly - DO ily = 0, lpy-kly-jly - ly = ily+jly+kly - lpz = lp-lx-ly + DO jly = 0, lpy - kly + DO ily = 0, lpy - kly - jly + ly = ily + jly + kly + lpz = lp - lx - ly DO klz = 0, lpz - DO jlz = 0, lpz-klz - DO ilz = 0, lpz-klz-jlz - lz = ilz+jlz+klz + DO jlz = 0, lpz - klz + DO ilz = 0, lpz - klz - jlz + lz = ilz + jlz + klz - il = ilx+ily+ilz - jl = jlx+jly+jlz - kl = klx+kly+klz + il = ilx + ily + ilz + jl = jlx + jly + jlz + kl = klx + kly + klz coef_ijk(coef_map(il, jl, kl)) = & - coef_ijk(coef_map(il, jl, kl))+coef_xyz(coef_map(lx, ly, lz))* & + coef_ijk(coef_map(il, jl, kl)) + coef_xyz(coef_map(lx, ly, lz))* & hmatgridp(1, 1, ilx)*hmatgridp(1, 2, jlx)*hmatgridp(1, 3, klx)* & hmatgridp(2, 1, ily)*hmatgridp(2, 2, jly)*hmatgridp(2, 3, kly)* & hmatgridp(3, 1, ilz)*hmatgridp(3, 2, jlz)*hmatgridp(3, 3, klz)* & @@ -3436,27 +3436,27 @@ SUBROUTINE collocate_general_opt() CALL return_cube_nonortho(cube_info, radius, index_min, index_max, rp) - offset(:) = MODULO(index_min(:)+rsgrid%desc%lb(:)-rsgrid%lb_local(:), ng(:))+1 + offset(:) = MODULO(index_min(:) + rsgrid%desc%lb(:) - rsgrid%lb_local(:), ng(:)) + 1 ALLOCATE (grid_map(index_min(1):index_max(1))) DO i = index_min(1), index_max(1) - grid_map(i) = MODULO(i, ng(1))+1 + grid_map(i) = MODULO(i, ng(1)) + 1 IF (rsgrid%desc%perd(1) == 1) THEN - grid_map(i) = MODULO(i, ng(1))+1 + grid_map(i) = MODULO(i, ng(1)) + 1 ELSE - grid_map(i) = i-index_min(1)+offset(1) + grid_map(i) = i - index_min(1) + offset(1) ENDIF ENDDO ! go over the grid, but cycle if the point is not within the radius DO k = index_min(3), index_max(3) - dk = k-gp(3) + dk = k - gp(3) pointk = hmatgrid(:, 3)*dk IF (rsgrid%desc%perd(3) == 1) THEN - k_index = MODULO(k, ng(3))+1 + k_index = MODULO(k, ng(3)) + 1 ELSE - k_index = k-index_min(3)+offset(3) + k_index = k - index_min(3) + offset(3) ENDIF coef_xyt = 0.0_dp @@ -3464,32 +3464,32 @@ SUBROUTINE collocate_general_opt() dkp = 1.0_dp DO kl = 0, lp lxy = 0 - DO jl = 0, lp-kl - DO il = 0, lp-kl-jl - lxyz = lxyz+1; lxy = lxy+1 - coef_xyt(lxy) = coef_xyt(lxy)+coef_ijk(lxyz)*dkp + DO jl = 0, lp - kl + DO il = 0, lp - kl - jl + lxyz = lxyz + 1; lxy = lxy + 1 + coef_xyt(lxy) = coef_xyt(lxy) + coef_ijk(lxyz)*dkp ENDDO - lxy = lxy+kl + lxy = lxy + kl ENDDO dkp = dkp*dk ENDDO DO j = index_min(2), index_max(2) - dj = j-gp(2) - pointj = pointk+hmatgrid(:, 2)*dj + dj = j - gp(2) + pointj = pointk + hmatgrid(:, 2)*dj IF (rsgrid%desc%perd(2) == 1) THEN - j_index = MODULO(j, ng(2))+1 + j_index = MODULO(j, ng(2)) + 1 ELSE - j_index = j-index_min(2)+offset(2) + j_index = j - index_min(2) + offset(2) ENDIF coef_xtt = 0.0_dp lxy = 0 djp = 1.0_dp DO jl = 0, lp - DO il = 0, lp-jl - lxy = lxy+1 - coef_xtt(il) = coef_xtt(il)+coef_xyt(lxy)*djp + DO il = 0, lp - jl + lxy = lxy + 1 + coef_xtt(il) = coef_xtt(il) + coef_xyt(lxy)*djp ENDDO djp = djp*dj ENDDO @@ -3497,40 +3497,40 @@ SUBROUTINE collocate_general_opt() ! find bounds for the inner loop ! based on a quadratic equation in i ! a*i**2+b*i+c=radius**2 - v = pointj-gp(1)*hmatgrid(:, 1) + v = pointj - gp(1)*hmatgrid(:, 1) a = DOT_PRODUCT(hmatgrid(:, 1), hmatgrid(:, 1)) b = 2*DOT_PRODUCT(v, hmatgrid(:, 1)) c = DOT_PRODUCT(v, v) - d = b*b-4*a*(c-radius**2) + d = b*b - 4*a*(c - radius**2) IF (d < 0) THEN CYCLE ELSE d = SQRT(d) - ismin = CEILING((-b-d)/(2*a)) - ismax = FLOOR((-b+d)/(2*a)) + ismin = CEILING((-b - d)/(2*a)) + ismax = FLOOR((-b + d)/(2*a)) ENDIF ! prepare for computing -zetp*rsq a = -zetp*a b = -zetp*b c = -zetp*c - i = ismin-1 + i = ismin - 1 ! the recursion relation might have to be done ! from the center of the gaussian (in both directions) ! instead as the current implementation from an edge - exp2i = EXP((a*i+b)*i+c) - exp1i = EXP(2*a*i+a+b) + exp2i = EXP((a*i + b)*i + c) + exp1i = EXP(2*a*i + a + b) exp0i = EXP(2*a) DO i = ismin, ismax - di = i-gp(1) + di = i - gp(1) ! polynomial terms res = 0.0_dp dip = 1.0_dp DO il = 0, lp - res = res+coef_xtt(il)*dip + res = res + coef_xtt(il)*dip dip = dip*di ENDDO @@ -3541,10 +3541,10 @@ SUBROUTINE collocate_general_opt() i_index = grid_map(i) IF (PRESENT(lgrid)) THEN - ig = (k_index-1)*ng(2)*ng(1)+(j_index-1)*ng(1)+(i_index-1)+1 - lgrid%r(ig, ithread_l) = lgrid%r(ig, ithread_l)+res + ig = (k_index - 1)*ng(2)*ng(1) + (j_index - 1)*ng(1) + (i_index - 1) + 1 + lgrid%r(ig, ithread_l) = lgrid%r(ig, ithread_l) + res ELSE - grid(i_index, j_index, k_index) = grid(i_index, j_index, k_index)+res + grid(i_index, j_index, k_index) = grid(i_index, j_index, k_index) + res ENDIF ENDDO ENDDO @@ -3569,18 +3569,18 @@ SUBROUTINE collocate_general_subpatch() periodic = 1 ! cell%perd CALL poly_cp2k2d3(coef_xyz, lp, poly_d3) - local_b(1, :) = rsgrid%lb_real-rsgrid%desc%lb - local_b(2, :) = rsgrid%ub_real-rsgrid%desc%lb - local_s = rsgrid%lb_real-rsgrid%lb_local - IF (BTEST(subpatch_pattern, 0)) local_b(1, 1) = local_b(1, 1)-rsgrid%desc%border - IF (BTEST(subpatch_pattern, 1)) local_b(2, 1) = local_b(2, 1)+rsgrid%desc%border - IF (BTEST(subpatch_pattern, 2)) local_b(1, 2) = local_b(1, 2)-rsgrid%desc%border - IF (BTEST(subpatch_pattern, 3)) local_b(2, 2) = local_b(2, 2)+rsgrid%desc%border - IF (BTEST(subpatch_pattern, 4)) local_b(1, 3) = local_b(1, 3)-rsgrid%desc%border - IF (BTEST(subpatch_pattern, 5)) local_b(2, 3) = local_b(2, 3)+rsgrid%desc%border - IF (BTEST(subpatch_pattern, 0)) local_s(1) = local_s(1)-rsgrid%desc%border - IF (BTEST(subpatch_pattern, 2)) local_s(2) = local_s(2)-rsgrid%desc%border - IF (BTEST(subpatch_pattern, 4)) local_s(3) = local_s(3)-rsgrid%desc%border + local_b(1, :) = rsgrid%lb_real - rsgrid%desc%lb + local_b(2, :) = rsgrid%ub_real - rsgrid%desc%lb + local_s = rsgrid%lb_real - rsgrid%lb_local + IF (BTEST(subpatch_pattern, 0)) local_b(1, 1) = local_b(1, 1) - rsgrid%desc%border + IF (BTEST(subpatch_pattern, 1)) local_b(2, 1) = local_b(2, 1) + rsgrid%desc%border + IF (BTEST(subpatch_pattern, 2)) local_b(1, 2) = local_b(1, 2) - rsgrid%desc%border + IF (BTEST(subpatch_pattern, 3)) local_b(2, 2) = local_b(2, 2) + rsgrid%desc%border + IF (BTEST(subpatch_pattern, 4)) local_b(1, 3) = local_b(1, 3) - rsgrid%desc%border + IF (BTEST(subpatch_pattern, 5)) local_b(2, 3) = local_b(2, 3) + rsgrid%desc%border + IF (BTEST(subpatch_pattern, 0)) local_s(1) = local_s(1) - rsgrid%desc%border + IF (BTEST(subpatch_pattern, 2)) local_s(2) = local_s(2) - rsgrid%desc%border + IF (BTEST(subpatch_pattern, 4)) local_s(3) = local_s(3) - rsgrid%desc%border IF (PRESENT(lgrid)) THEN CALL collocGauss(h=cell%hmat, h_inv=cell%h_inv, & grid=grid, poly=poly_d3, alphai=zetp, posi=rp, max_r2=radius*radius, & @@ -3607,17 +3607,17 @@ SUBROUTINE collocate_general_wings() periodic = 1 ! cell%perd CALL poly_cp2k2d3(coef_xyz, lp, poly_d3) local_b(1, :) = 0 - local_b(2, :) = MIN(rsgrid%desc%npts-1, rsgrid%ub_local-rsgrid%lb_local) - local_shift = REAL(rsgrid%desc%lb-rsgrid%lb_local, dp)/REAL(rsgrid%desc%npts, dp) - rShifted(1) = rp(1)+cell%hmat(1, 1)*local_shift(1) & - +cell%hmat(1, 2)*local_shift(2) & - +cell%hmat(1, 3)*local_shift(3) - rShifted(2) = rp(2)+cell%hmat(2, 1)*local_shift(1) & - +cell%hmat(2, 2)*local_shift(2) & - +cell%hmat(2, 3)*local_shift(3) - rShifted(3) = rp(3)+cell%hmat(3, 1)*local_shift(1) & - +cell%hmat(3, 2)*local_shift(2) & - +cell%hmat(3, 3)*local_shift(3) + local_b(2, :) = MIN(rsgrid%desc%npts - 1, rsgrid%ub_local - rsgrid%lb_local) + local_shift = REAL(rsgrid%desc%lb - rsgrid%lb_local, dp)/REAL(rsgrid%desc%npts, dp) + rShifted(1) = rp(1) + cell%hmat(1, 1)*local_shift(1) & + + cell%hmat(1, 2)*local_shift(2) & + + cell%hmat(1, 3)*local_shift(3) + rShifted(2) = rp(2) + cell%hmat(2, 1)*local_shift(1) & + + cell%hmat(2, 2)*local_shift(2) & + + cell%hmat(2, 3)*local_shift(3) + rShifted(3) = rp(3) + cell%hmat(3, 1)*local_shift(1) & + + cell%hmat(3, 2)*local_shift(2) & + + cell%hmat(3, 3)*local_shift(3) IF (PRESENT(lgrid)) THEN CALL collocGauss(h=cell%hmat, h_inv=cell%h_inv, & grid=grid, poly=poly_d3, alphai=zetp, posi=rShifted, max_r2=radius*radius, & @@ -3661,15 +3661,15 @@ SUBROUTINE collocate_general() ! primitive_value of point primpt = primitive_value(point) ! skip if outside of the sphere - IF (SUM((point-rp)**2) > radius**2) CYCLE + IF (SUM((point - rp)**2) > radius**2) CYCLE ! point on the grid (including pbc) - ipoint = MODULO((/i, j, k/), ng)+1 + ipoint = MODULO((/i, j, k/), ng) + 1 ! add to grid IF (PRESENT(lgrid)) THEN - ig = ipoint(3)*ng(2)*ng(1)+ipoint(2)*ng(1)+ipoint(1)+1 - lgrid%r(ig, ithread_l) = lgrid%r(ig, ithread_l)+primpt + ig = ipoint(3)*ng(2)*ng(1) + ipoint(2)*ng(1) + ipoint(1) + 1 + lgrid%r(ig, ithread_l) = lgrid%r(ig, ithread_l) + primpt ELSE - grid(ipoint(1), ipoint(2), ipoint(3)) = grid(ipoint(1), ipoint(2), ipoint(3))+primpt + grid(ipoint(1), ipoint(2), ipoint(3)) = grid(ipoint(1), ipoint(2), ipoint(3)) + primpt ENDIF ENDDO ENDDO @@ -3689,31 +3689,31 @@ FUNCTION primitive_value(point) RESULT(res) pdrap res = 0.0_dp - myexp = EXP(-zetp*SUM((point-rp)**2))*prefactor - dra = point-ra - drb = point-rb + myexp = EXP(-zetp*SUM((point - rp)**2))*prefactor + dra = point - ra + drb = point - rb drap(1) = 1.0_dp DO lxa = 0, la_max_local drbp(1) = 1.0_dp DO lxb = 0, lb_max_local drap(2) = 1.0_dp - DO lya = 0, la_max_local-lxa + DO lya = 0, la_max_local - lxa drbp(2) = 1.0_dp - DO lyb = 0, lb_max_local-lxb + DO lyb = 0, lb_max_local - lxb drap(3) = 1.0_dp - DO lza = 1, MAX(la_min_local-lxa-lya, 0) + DO lza = 1, MAX(la_min_local - lxa - lya, 0) drap(3) = drap(3)*dra(3) ENDDO - DO lza = MAX(la_min_local-lxa-lya, 0), la_max_local-lxa-lya + DO lza = MAX(la_min_local - lxa - lya, 0), la_max_local - lxa - lya drbp(3) = 1.0_dp - DO lzb = 1, MAX(lb_min_local-lxb-lyb, 0) + DO lzb = 1, MAX(lb_min_local - lxb - lyb, 0) drbp(3) = drbp(3)*drb(3) ENDDO ico = coset(lxa, lya, lza) pdrap = PRODUCT(drap) - DO lzb = MAX(lb_min_local-lxb-lyb, 0), lb_max_local-lxb-lyb + DO lzb = MAX(lb_min_local - lxb - lyb, 0), lb_max_local - lxb - lyb jco = coset(lxb, lyb, lzb) - res = res+pab_local(ico+o1_local, jco+o2_local)*myexp*pdrap*PRODUCT(drbp) + res = res + pab_local(ico + o1_local, jco + o2_local)*myexp*pdrap*PRODUCT(drbp) drbp(3) = drbp(3)*drb(3) ENDDO drap(3) = drap(3)*dra(3) @@ -3789,12 +3789,12 @@ SUBROUTINE collocate_pgf_product_gspace(la_max, zeta, la_min, & dg(:) = twopi/(pw%pw_grid%npts(:)*pw%pw_grid%dr(:)) - zetp = zeta+zetb + zetp = zeta + zetb rzetp = 1.0_dp/zetp f = zetb*rzetp rap(:) = f*rab(:) - rbp(:) = rap(:)-rab(:) - rp(:) = ra(:)+rap(:) + rbp(:) = rap(:) - rab(:) + rp(:) = ra(:) + rap(:) twozetp = 2.0_dp*zetp fap(:) = twozetp*rap(:) fbp(:) = twozetp*rbp(:) @@ -3833,10 +3833,10 @@ SUBROUTINE collocate_pgf_product_gspace(la_max, zeta, la_min, & cubeaxis(ig, i, 1, 0) = rag(ig)*cubeaxis(ig, i, 0, 0) END DO DO la = 2, la_max - fa = REAL(la-1, dp)*twozetp + fa = REAL(la - 1, dp)*twozetp DO ig = lb_cube(i), ub_cube(i) - cubeaxis(ig, i, la, 0) = rag(ig)*cubeaxis(ig, i, la-1, 0)+ & - fa*cubeaxis(ig, i, la-2, 0) + cubeaxis(ig, i, la, 0) = rag(ig)*cubeaxis(ig, i, la - 1, 0) + & + fa*cubeaxis(ig, i, la - 2, 0) END DO END DO IF (lb_max > 0) THEN @@ -3844,31 +3844,31 @@ SUBROUTINE collocate_pgf_product_gspace(la_max, zeta, la_min, & DO ig = lb_cube(i), ub_cube(i) rbg(ig) = CMPLX(fbp(i), -g(ig), KIND=dp) cubeaxis(ig, i, 0, 1) = rbg(ig)*cubeaxis(ig, i, 0, 0) - cubeaxis(ig, i, 1, 1) = rbg(ig)*cubeaxis(ig, i, 1, 0)+ & + cubeaxis(ig, i, 1, 1) = rbg(ig)*cubeaxis(ig, i, 1, 0) + & fa*cubeaxis(ig, i, 0, 0) END DO DO lb = 2, lb_max - fb = REAL(lb-1, dp)*twozetp + fb = REAL(lb - 1, dp)*twozetp DO ig = lb_cube(i), ub_cube(i) - cubeaxis(ig, i, 0, lb) = rbg(ig)*cubeaxis(ig, i, 0, lb-1)+ & - fb*cubeaxis(ig, i, 0, lb-2) - cubeaxis(ig, i, 1, lb) = rbg(ig)*cubeaxis(ig, i, 1, lb-1)+ & - fb*cubeaxis(ig, i, 1, lb-2)+ & - fa*cubeaxis(ig, i, 0, lb-1) + cubeaxis(ig, i, 0, lb) = rbg(ig)*cubeaxis(ig, i, 0, lb - 1) + & + fb*cubeaxis(ig, i, 0, lb - 2) + cubeaxis(ig, i, 1, lb) = rbg(ig)*cubeaxis(ig, i, 1, lb - 1) + & + fb*cubeaxis(ig, i, 1, lb - 2) + & + fa*cubeaxis(ig, i, 0, lb - 1) END DO END DO DO la = 2, la_max fa = REAL(la, dp)*twozetp DO ig = lb_cube(i), ub_cube(i) - cubeaxis(ig, i, la, 1) = rbg(ig)*cubeaxis(ig, i, la, 0)+ & - fa*cubeaxis(ig, i, la-1, 0) + cubeaxis(ig, i, la, 1) = rbg(ig)*cubeaxis(ig, i, la, 0) + & + fa*cubeaxis(ig, i, la - 1, 0) END DO DO lb = 2, lb_max - fb = REAL(lb-1, dp)*twozetp + fb = REAL(lb - 1, dp)*twozetp DO ig = lb_cube(i), ub_cube(i) - cubeaxis(ig, i, la, lb) = rbg(ig)*cubeaxis(ig, i, la, lb-1)+ & - fb*cubeaxis(ig, i, la, lb-2)+ & - fa*cubeaxis(ig, i, la-1, lb-1) + cubeaxis(ig, i, la, lb) = rbg(ig)*cubeaxis(ig, i, la, lb - 1) + & + fb*cubeaxis(ig, i, la, lb - 2) + & + fa*cubeaxis(ig, i, la - 1, lb - 1) END DO END DO END DO @@ -3881,10 +3881,10 @@ SUBROUTINE collocate_pgf_product_gspace(la_max, zeta, la_min, & cubeaxis(ig, i, 0, 1) = rbg(ig)*cubeaxis(ig, i, 0, 0) END DO DO lb = 2, lb_max - fb = REAL(lb-1, dp)*twozetp + fb = REAL(lb - 1, dp)*twozetp DO ig = lb_cube(i), ub_cube(i) - cubeaxis(ig, i, 0, lb) = rbg(ig)*cubeaxis(ig, i, 0, lb-1)+ & - fb*cubeaxis(ig, i, 0, lb-2) + cubeaxis(ig, i, 0, lb) = rbg(ig)*cubeaxis(ig, i, 0, lb - 1) + & + fb*cubeaxis(ig, i, 0, lb - 2) END DO END DO END IF @@ -3894,8 +3894,8 @@ SUBROUTINE collocate_pgf_product_gspace(la_max, zeta, la_min, & DO la = 0, la_max DO lb = 0, lb_max - IF (la+lb == 0) CYCLE - fa = (1.0_dp/twozetp)**(la+lb) + IF (la + lb == 0) CYCLE + fa = (1.0_dp/twozetp)**(la + lb) DO i = 1, 3 DO ig = lb_cube(i), ub_cube(i) cubeaxis(ig, i, la, lb) = fa*cubeaxis(ig, i, la, lb) @@ -3906,15 +3906,15 @@ SUBROUTINE collocate_pgf_product_gspace(la_max, zeta, la_min, & ! Add the current primitive Gaussian function product to grid - DO ico = ncoset(la_min-1)+1, ncoset(la_max) + DO ico = ncoset(la_min - 1) + 1, ncoset(la_max) ax = indco(1, ico) ay = indco(2, ico) az = indco(3, ico) - DO jco = ncoset(lb_min-1)+1, ncoset(lb_max) + DO jco = ncoset(lb_min - 1) + 1, ncoset(lb_max) - pij = prefactor*pab(na+ico, nb+jco) + pij = prefactor*pab(na + ico, nb + jco) IF (ABS(pij) < eps_rho_gspace) CYCLE @@ -3927,7 +3927,7 @@ SUBROUTINE collocate_pgf_product_gspace(la_max, zeta, la_min, & ig = pw%pw_grid%g_hat(1, i) jg = pw%pw_grid%g_hat(2, i) kg = pw%pw_grid%g_hat(3, i) - pw%cc(i) = pw%cc(i)+pij*cubeaxis(ig, 1, ax, bx)* & + pw%cc(i) = pw%cc(i) + pij*cubeaxis(ig, 1, ax, bx)* & cubeaxis(jg, 2, ay, by)* & cubeaxis(kg, 3, az, bz) END DO diff --git a/src/qs_condnum.F b/src/qs_condnum.F index 95c6b499f4..220f771711 100644 --- a/src/qs_condnum.F +++ b/src/qs_condnum.F @@ -234,17 +234,17 @@ SUBROUTINE estimate_norm_invmat(amat, anorm) g = dlange("1", nbas, 1, x, nbas, work) IF (g <= gg) EXIT x(1:nbas) = SIGN(1._dp, x(1:nbas)) - IF (SUM(ABS(x-xsi)) == 0 .OR. SUM(ABS(x+xsi)) == 0) EXIT + IF (SUM(ABS(x - xsi)) == 0 .OR. SUM(ABS(x + xsi)) == 0) EXIT xsi(1:nbas) = x(1:nbas) CALL dbcsr_solve(amat, x, pmat) - k = k+1 + k = k + 1 IF (k > 5) EXIT IF (SUM(r) == SUM(MAXLOC(ABS(x)))) EXIT END DO ! IF (nbas > 1) THEN DO i = 1, nbas - x(i) = -1._dp**(i+1)*(1._dp+REAL(i-1, dp)/REAL(nbas-1, dp)) + x(i) = -1._dp**(i + 1)*(1._dp + REAL(i - 1, dp)/REAL(nbas - 1, dp)) END DO ELSE x(1) = 1.0_dp diff --git a/src/qs_core_energies.F b/src/qs_core_energies.F index 677b340552..9143be1eb5 100644 --- a/src/qs_core_energies.F +++ b/src/qs_core_energies.F @@ -92,7 +92,7 @@ SUBROUTINE calculate_ptrace_gamma(hmat, pmat, ecore, nspin) DO ispin = 1, nspin etr = 0.0_dp CALL dbcsr_dot(hmat(1)%matrix, pmat(ispin)%matrix, etr) - ecore = ecore+etr + ecore = ecore + etr END DO CALL timestop(handle) @@ -132,7 +132,7 @@ SUBROUTINE calculate_ptrace_kp(hmat, pmat, ecore, nspin) DO ic = 1, nc etr = 0.0_dp CALL dbcsr_dot(hmat(1, ic)%matrix, pmat(ispin, ic)%matrix, etr) - ecore = ecore+etr + ecore = ecore + etr END DO END DO @@ -286,10 +286,10 @@ SUBROUTINE calculate_ecore_overlap(qs_env, para_env, calculate_forces, molecular DO WHILE (neighbor_list_iterate(nl_iterator) == 0) CALL get_iterator_info(nl_iterator, ikind=ikind, jkind=jkind, iatom=iatom, jatom=jatom, r=rab) zab = zeff(ikind)*zeff(jkind) - aab = alpha(ikind)*alpha(jkind)/(alpha(ikind)+alpha(jkind)) + aab = alpha(ikind)*alpha(jkind)/(alpha(ikind) + alpha(jkind)) rootaab = SQRT(aab) fab = 2.0_dp*oorootpi*zab*rootaab - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) IF (rab2 > 1.e-8_dp) THEN IF (ikind == jkind .AND. iatom == jatom) THEN f = 0.5_dp @@ -298,17 +298,17 @@ SUBROUTINE calculate_ecore_overlap(qs_env, para_env, calculate_forces, molecular END IF dab = SQRT(rab2) eab = zab*erfc(rootaab*dab)/dab - ecore_overlap = ecore_overlap+f*eab + ecore_overlap = ecore_overlap + f*eab IF (atenergy) THEN - atprop%atecc(iatom) = atprop%atecc(iatom)+0.5_dp*f*eab - atprop%atecc(jatom) = atprop%atecc(jatom)+0.5_dp*f*eab + atprop%atecc(iatom) = atprop%atecc(iatom) + 0.5_dp*f*eab + atprop%atecc(jatom) = atprop%atecc(jatom) + 0.5_dp*f*eab END IF IF (calculate_forces) THEN - deab(:) = rab(:)*f*(eab+fab*EXP(-aab*rab2))/rab2 + deab(:) = rab(:)*f*(eab + fab*EXP(-aab*rab2))/rab2 atom_a = atom_of_kind(iatom) atom_b = atom_of_kind(jatom) - force(ikind)%core_overlap(:, atom_a) = force(ikind)%core_overlap(:, atom_a)+deab(:) - force(jkind)%core_overlap(:, atom_b) = force(jkind)%core_overlap(:, atom_b)-deab(:) + force(ikind)%core_overlap(:, atom_a) = force(ikind)%core_overlap(:, atom_a) + deab(:) + force(jkind)%core_overlap(:, atom_b) = force(jkind)%core_overlap(:, atom_b) - deab(:) IF (use_virial) THEN CALL virial_pair_force(pv_loc, 1._dp, deab, rab) END IF @@ -322,8 +322,8 @@ SUBROUTINE calculate_ecore_overlap(qs_env, para_env, calculate_forces, molecular DEALLOCATE (atom_of_kind) END IF IF (calculate_forces .AND. use_virial) THEN - virial%pv_virial = virial%pv_virial+pv_loc - virial%pv_hartree = virial%pv_hartree+pv_loc + virial%pv_virial = virial%pv_virial + pv_loc + virial%pv_hartree = virial%pv_hartree + pv_loc END IF CALL mp_sum(ecore_overlap, group) @@ -376,7 +376,7 @@ SUBROUTINE calculate_ecore_self(qs_env, E_self_core) DO ikind = 1, SIZE(atomic_kind_set) CALL get_atomic_kind(atomic_kind_set(ikind), natom=natom) CALL get_qs_kind(qs_kind_set(ikind), zeff=zeff, alpha_core_charge=alpha_core_charge) - ecore_self = ecore_self-REAL(natom, dp)*zeff**2*SQRT(alpha_core_charge) + ecore_self = ecore_self - REAL(natom, dp)*zeff**2*SQRT(alpha_core_charge) END DO energy%core_self = ecore_self/SQRT(twopi) @@ -398,7 +398,7 @@ SUBROUTINE calculate_ecore_self(qs_env, E_self_core) es = zeff**2*SQRT(alpha_core_charge)/SQRT(twopi) DO iparticle_local = 1, nparticle_local iatom = local_particles%list(ikind)%array(iparticle_local) - atprop%ateself(iatom) = atprop%ateself(iatom)-es + atprop%ateself(iatom) = atprop%ateself(iatom) - es END DO END DO END IF diff --git a/src/qs_core_hamiltonian.F b/src/qs_core_hamiltonian.F index e39b35b182..9fc7e14a97 100644 --- a/src/qs_core_hamiltonian.F +++ b/src/qs_core_hamiltonian.F @@ -571,7 +571,7 @@ SUBROUTINE build_atomic_relmat(matrix_h, atomic_kind_set, qs_kind_set, particle_ IF (iatom == jatom) THEN ikind = kind_of(iatom) CALL get_qs_kind(qs_kind_set(ikind), reltmat=reltmat) - IF (ASSOCIATED(reltmat)) hblock = hblock+reltmat + IF (ASSOCIATED(reltmat)) hblock = hblock + reltmat END IF END DO CALL dbcsr_iterator_stop(iter) diff --git a/src/qs_density_mixing_types.F b/src/qs_density_mixing_types.F index dd47af84be..f44fbed8e0 100644 --- a/src/qs_density_mixing_types.F +++ b/src/qs_density_mixing_types.F @@ -238,7 +238,7 @@ SUBROUTINE mixing_storage_release(mixing_store) IF (ASSOCIATED(mixing_store)) THEN CPASSERT(mixing_store%ref_count > 0) - mixing_store%ref_count = mixing_store%ref_count-1 + mixing_store%ref_count = mixing_store%ref_count - 1 IF (mixing_store%ref_count == 0) THEN IF (ASSOCIATED(mixing_store%kerker_factor)) THEN diff --git a/src/qs_dftb3_methods.F b/src/qs_dftb3_methods.F index e0643cdb11..8bf0963fbc 100644 --- a/src/qs_dftb3_methods.F +++ b/src/qs_dftb3_methods.F @@ -125,11 +125,11 @@ SUBROUTINE build_dftb3_diagonal(qs_env, ks_matrix, rho, mcharge, energy, xgamma, DO ia = 1, local_particles%n_el(ikind) iatom = local_particles%list(ikind)%array(ia) eloc = -1.0_dp/6.0_dp*ua*mcharge(iatom)**3 - eb3 = eb3+eloc + eb3 = eb3 + eloc IF (atprop%energy) THEN ! we have to add the part not covered by 0.5*Tr(FP) - eloc = -0.5_dp*eloc-0.25_dp*ua*zeff(ikind)*mcharge(iatom)**2 - atprop%atecoul(iatom) = atprop%atecoul(iatom)+eloc + eloc = -0.5_dp*eloc - 0.25_dp*ua*zeff(ikind)*mcharge(iatom)**2 + atprop%atecoul(iatom) = atprop%atecoul(iatom) + eloc END IF END DO END DO @@ -174,7 +174,7 @@ SUBROUTINE build_dftb3_diagonal(qs_env, ks_matrix, rho, mcharge, energy, xgamma, atom_j = atom_of_kind(icol) uj = xgamma(jkind) ! - gmij = -0.5_dp*(ui*mcharge(irow)**2+uj*mcharge(icol)**2) + gmij = -0.5_dp*(ui*mcharge(irow)**2 + uj*mcharge(icol)**2) ! NULLIFY (pblock) CALL dbcsr_get_block_p(matrix=matrix_p(1, 1)%matrix, & @@ -182,12 +182,12 @@ SUBROUTINE build_dftb3_diagonal(qs_env, ks_matrix, rho, mcharge, energy, xgamma, CPASSERT(found) DO i = 1, 3 NULLIFY (dsblock) - CALL dbcsr_get_block_p(matrix=matrix_s(1+i, 1)%matrix, & + CALL dbcsr_get_block_p(matrix=matrix_s(1 + i, 1)%matrix, & row=irow, col=icol, block=dsblock, found=found) CPASSERT(found) fi = -gmij*SUM(pblock*dsblock) - force(ikind)%rho_elec(i, atom_i) = force(ikind)%rho_elec(i, atom_i)+fi - force(jkind)%rho_elec(i, atom_j) = force(jkind)%rho_elec(i, atom_j)-fi + force(ikind)%rho_elec(i, atom_i) = force(ikind)%rho_elec(i, atom_i) + fi + force(jkind)%rho_elec(i, atom_j) = force(jkind)%rho_elec(i, atom_j) - fi fij(i) = fi END DO ENDDO @@ -198,7 +198,7 @@ SUBROUTINE build_dftb3_diagonal(qs_env, ks_matrix, rho, mcharge, energy, xgamma, CALL get_qs_env(qs_env, nkind=nkind) DO ikind = 1, nkind DO jkind = 1, nkind - iac = ikind+nkind*(jkind-1) + iac = ikind + nkind*(jkind - 1) IF (.NOT. ASSOCIATED(sap_int(iac)%alist)) CYCLE ui = xgamma(ikind) uj = xgamma(jkind) @@ -211,7 +211,7 @@ SUBROUTINE build_dftb3_diagonal(qs_env, ks_matrix, rho, mcharge, energy, xgamma, dr = SQRT(SUM(rij(:)**2)) IF (dr > 1.e-6_dp) THEN dsint => sap_int(iac)%alist(ia)%clist(ic)%acint - gmij = -0.5_dp*(ui*mcharge(iatom)**2+uj*mcharge(jatom)**2) + gmij = -0.5_dp*(ui*mcharge(iatom)**2 + uj*mcharge(jatom)**2) icol = MAX(iatom, jatom) irow = MIN(iatom, jatom) NULLIFY (pblock) @@ -262,7 +262,7 @@ SUBROUTINE build_dftb3_diagonal(qs_env, ks_matrix, rho, mcharge, energy, xgamma, atom_j = atom_of_kind(jatom) uj = xgamma(jkind) ! - gmij = -0.5_dp*(ui*mcharge(iatom)**2+uj*mcharge(jatom)**2) + gmij = -0.5_dp*(ui*mcharge(iatom)**2 + uj*mcharge(jatom)**2) ! NULLIFY (pblock) CALL dbcsr_get_block_p(matrix=matrix_p(1, ic)%matrix, & @@ -270,7 +270,7 @@ SUBROUTINE build_dftb3_diagonal(qs_env, ks_matrix, rho, mcharge, energy, xgamma, CPASSERT(found) DO i = 1, 3 NULLIFY (dsblock) - CALL dbcsr_get_block_p(matrix=matrix_s(1+i, ic)%matrix, & + CALL dbcsr_get_block_p(matrix=matrix_s(1 + i, ic)%matrix, & row=irow, col=icol, block=dsblock, found=found) CPASSERT(found) IF (irow == iatom) THEN @@ -278,8 +278,8 @@ SUBROUTINE build_dftb3_diagonal(qs_env, ks_matrix, rho, mcharge, energy, xgamma, ELSE fi = gmij*SUM(pblock*dsblock) END IF - force(ikind)%rho_elec(i, atom_i) = force(ikind)%rho_elec(i, atom_i)+fi - force(jkind)%rho_elec(i, atom_j) = force(jkind)%rho_elec(i, atom_j)-fi + force(ikind)%rho_elec(i, atom_i) = force(ikind)%rho_elec(i, atom_i) + fi + force(jkind)%rho_elec(i, atom_j) = force(jkind)%rho_elec(i, atom_j) - fi fij(i) = fi END DO IF (use_virial) THEN @@ -329,13 +329,13 @@ SUBROUTINE build_dftb3_diagonal(qs_env, ks_matrix, rho, mcharge, energy, xgamma, ui = xgamma(ikind) jkind = kind_of(icol) uj = xgamma(jkind) - gmij = -0.5_dp*(ui*mcharge(irow)**2+uj*mcharge(icol)**2) + gmij = -0.5_dp*(ui*mcharge(irow)**2 + uj*mcharge(icol)**2) DO is = 1, SIZE(ks_matrix, 1) NULLIFY (ksblock) CALL dbcsr_get_block_p(matrix=ks_matrix(is, 1)%matrix, & row=irow, col=icol, block=ksblock, found=found) CPASSERT(found) - ksblock = ksblock-0.5_dp*gmij*sblock + ksblock = ksblock - 0.5_dp*gmij*sblock END DO ENDDO CALL dbcsr_iterator_stop(iter) @@ -357,7 +357,7 @@ SUBROUTINE build_dftb3_diagonal(qs_env, ks_matrix, rho, mcharge, energy, xgamma, ui = xgamma(ikind) jkind = kind_of(jatom) uj = xgamma(jkind) - gmij = -0.5_dp*(ui*mcharge(iatom)**2+uj*mcharge(jatom)**2) + gmij = -0.5_dp*(ui*mcharge(iatom)**2 + uj*mcharge(jatom)**2) ! NULLIFY (sblock) CALL dbcsr_get_block_p(matrix=matrix_s(1, ic)%matrix, & @@ -368,7 +368,7 @@ SUBROUTINE build_dftb3_diagonal(qs_env, ks_matrix, rho, mcharge, energy, xgamma, CALL dbcsr_get_block_p(matrix=ks_matrix(is, ic)%matrix, & row=irow, col=icol, block=ksblock, found=found) CPASSERT(found) - ksblock = ksblock-0.5_dp*gmij*sblock + ksblock = ksblock - 0.5_dp*gmij*sblock END DO END DO diff --git a/src/qs_dftb_coulomb.F b/src/qs_dftb_coulomb.F index 83bb2df4c5..9fbff01d4b 100644 --- a/src/qs_dftb_coulomb.F +++ b/src/qs_dftb_coulomb.F @@ -212,19 +212,19 @@ SUBROUTINE build_dftb_coulomb(qs_env, ks_matrix, rho, mcharge, energy, & gb = eta_b(0) dr = SQRT(SUM(rij(:)**2)) gmat = gamma_rab_sr(dr, ga, gb, hb_para) - gmcharge(jatom, 1) = gmcharge(jatom, 1)+gmat*mcharge(iatom) + gmcharge(jatom, 1) = gmcharge(jatom, 1) + gmat*mcharge(iatom) IF (iatom /= jatom) THEN - gmcharge(iatom, 1) = gmcharge(iatom, 1)+gmat*mcharge(jatom) + gmcharge(iatom, 1) = gmcharge(iatom, 1) + gmat*mcharge(jatom) END IF IF (calculate_forces .AND. (iatom /= jatom .OR. dr > 0.001_dp)) THEN ddr = 0.1_dp*dftb_potential(ikind, jkind)%dgrd - drp = dr+ddr - drm = dr-ddr - dgam = 0.5_dp*(gamma_rab_sr(drp, ga, gb, hb_para)-gamma_rab_sr(drm, ga, gb, hb_para))/ddr + drp = dr + ddr + drm = dr - ddr + dgam = 0.5_dp*(gamma_rab_sr(drp, ga, gb, hb_para) - gamma_rab_sr(drm, ga, gb, hb_para))/ddr DO i = 1, 3 - gmcharge(jatom, i+1) = gmcharge(jatom, i+1)-dgam*mcharge(iatom)*rij(i)/dr + gmcharge(jatom, i + 1) = gmcharge(jatom, i + 1) - dgam*mcharge(iatom)*rij(i)/dr IF (dr > 0.001_dp) THEN - gmcharge(iatom, i+1) = gmcharge(iatom, i+1)+dgam*mcharge(jatom)*rij(i)/dr + gmcharge(iatom, i + 1) = gmcharge(iatom, i + 1) + dgam*mcharge(jatom)*rij(i)/dr END IF IF (use_virial) THEN fij(i) = -mcharge(iatom)*mcharge(jatom)*dgam*rij(i)/dr @@ -281,15 +281,15 @@ SUBROUTINE build_dftb_coulomb(qs_env, ks_matrix, rho, mcharge, energy, & DO ikind = 1, SIZE(local_particles%n_el) DO ia = 1, local_particles%n_el(ikind) iatom = local_particles%list(ikind)%array(ia) - DO jatom = 1, iatom-1 - rij = particle_set(iatom)%r-particle_set(jatom)%r + DO jatom = 1, iatom - 1 + rij = particle_set(iatom)%r - particle_set(jatom)%r rij = pbc(rij, cell) dr = SQRT(SUM(rij(:)**2)) - gmcharge(iatom, 1) = gmcharge(iatom, 1)+mcharge(jatom)/dr - gmcharge(jatom, 1) = gmcharge(jatom, 1)+mcharge(iatom)/dr + gmcharge(iatom, 1) = gmcharge(iatom, 1) + mcharge(jatom)/dr + gmcharge(jatom, 1) = gmcharge(jatom, 1) + mcharge(iatom)/dr DO i = 2, nmat - gmcharge(iatom, i) = gmcharge(iatom, i)+rij(i-1)*mcharge(jatom)/dr**3 - gmcharge(jatom, i) = gmcharge(jatom, i)-rij(i-1)*mcharge(iatom)/dr**3 + gmcharge(iatom, i) = gmcharge(iatom, i) + rij(i - 1)*mcharge(jatom)/dr**3 + gmcharge(jatom, i) = gmcharge(jatom, i) - rij(i - 1)*mcharge(iatom)/dr**3 END DO END DO END DO @@ -301,13 +301,13 @@ SUBROUTINE build_dftb_coulomb(qs_env, ks_matrix, rho, mcharge, energy, & IF (do_ewald) THEN ! add self charge interaction and background charge contribution - gmcharge(:, 1) = gmcharge(:, 1)-2._dp*alpha*oorootpi*mcharge(:) + gmcharge(:, 1) = gmcharge(:, 1) - 2._dp*alpha*oorootpi*mcharge(:) IF (ANY(periodic(:) == 1)) THEN - gmcharge(:, 1) = gmcharge(:, 1)-pi/alpha**2/deth + gmcharge(:, 1) = gmcharge(:, 1) - pi/alpha**2/deth END IF END IF - energy%hartree = energy%hartree+0.5_dp*SUM(mcharge(:)*gmcharge(:, 1)) + energy%hartree = energy%hartree + 0.5_dp*SUM(mcharge(:)*gmcharge(:, 1)) IF (atprop%energy) THEN CALL get_qs_env(qs_env=qs_env, & local_particles=local_particles) @@ -316,7 +316,7 @@ SUBROUTINE build_dftb_coulomb(qs_env, ks_matrix, rho, mcharge, energy, & CALL get_dftb_atom_param(dftb_kind, zeff=zeff) DO ia = 1, local_particles%n_el(ikind) iatom = local_particles%list(ikind)%array(ia) - atprop%atecoul(iatom) = atprop%atecoul(iatom)+ & + atprop%atecoul(iatom) = atprop%atecoul(iatom) + & 0.5_dp*zeff*gmcharge(iatom, 1) END DO END DO @@ -335,9 +335,9 @@ SUBROUTINE build_dftb_coulomb(qs_env, ks_matrix, rho, mcharge, energy, & DO iatom = 1, natom ikind = kind_of(iatom) atom_i = atom_of_kind(iatom) - force(ikind)%rho_elec(1, atom_i) = force(ikind)%rho_elec(1, atom_i)-gmcharge(iatom, 2) - force(ikind)%rho_elec(2, atom_i) = force(ikind)%rho_elec(2, atom_i)-gmcharge(iatom, 3) - force(ikind)%rho_elec(3, atom_i) = force(ikind)%rho_elec(3, atom_i)-gmcharge(iatom, 4) + force(ikind)%rho_elec(1, atom_i) = force(ikind)%rho_elec(1, atom_i) - gmcharge(iatom, 2) + force(ikind)%rho_elec(2, atom_i) = force(ikind)%rho_elec(2, atom_i) - gmcharge(iatom, 3) + force(ikind)%rho_elec(3, atom_i) = force(ikind)%rho_elec(3, atom_i) - gmcharge(iatom, 4) END DO END IF @@ -376,13 +376,13 @@ SUBROUTINE build_dftb_coulomb(qs_env, ks_matrix, rho, mcharge, energy, & CALL dbcsr_iterator_start(iter, matrix_s(1, 1)%matrix) DO WHILE (dbcsr_iterator_blocks_left(iter)) CALL dbcsr_iterator_next_block(iter, irow, icol, sblock, blk) - gmij = 0.5_dp*(gmcharge(irow, 1)+gmcharge(icol, 1)) + gmij = 0.5_dp*(gmcharge(irow, 1) + gmcharge(icol, 1)) DO is = 1, SIZE(ks_matrix, 1) NULLIFY (ksblock) CALL dbcsr_get_block_p(matrix=ks_matrix(is, 1)%matrix, & row=irow, col=icol, block=ksblock, found=found) CPASSERT(found) - ksblock = ksblock-gmij*sblock + ksblock = ksblock - gmij*sblock END DO IF (calculate_forces) THEN ikind = kind_of(irow) @@ -395,12 +395,12 @@ SUBROUTINE build_dftb_coulomb(qs_env, ks_matrix, rho, mcharge, energy, & CPASSERT(found) DO i = 1, 3 NULLIFY (dsblock) - CALL dbcsr_get_block_p(matrix=matrix_s(1+i, 1)%matrix, & + CALL dbcsr_get_block_p(matrix=matrix_s(1 + i, 1)%matrix, & row=irow, col=icol, block=dsblock, found=found) CPASSERT(found) fi = -2.0_dp*gmij*SUM(pblock*dsblock) - force(ikind)%rho_elec(i, atom_i) = force(ikind)%rho_elec(i, atom_i)+fi - force(jkind)%rho_elec(i, atom_j) = force(jkind)%rho_elec(i, atom_j)-fi + force(ikind)%rho_elec(i, atom_i) = force(ikind)%rho_elec(i, atom_i) + fi + force(jkind)%rho_elec(i, atom_j) = force(jkind)%rho_elec(i, atom_j) - fi fij(i) = fi END DO END IF @@ -410,7 +410,7 @@ SUBROUTINE build_dftb_coulomb(qs_env, ks_matrix, rho, mcharge, energy, & IF (do_gamma_stress) THEN DO ikind = 1, nkind DO jkind = 1, nkind - iac = ikind+nkind*(jkind-1) + iac = ikind + nkind*(jkind - 1) IF (.NOT. ASSOCIATED(sap_int(iac)%alist)) CYCLE DO ia = 1, sap_int(iac)%nalist IF (.NOT. ASSOCIATED(sap_int(iac)%alist(ia)%clist)) CYCLE @@ -421,7 +421,7 @@ SUBROUTINE build_dftb_coulomb(qs_env, ks_matrix, rho, mcharge, energy, & dr = SQRT(SUM(rij(:)**2)) IF (dr > 1.e-6_dp) THEN dsint => sap_int(iac)%alist(ia)%clist(ic)%acint - gmij = 0.5_dp*(gmcharge(iatom, 1)+gmcharge(jatom, 1)) + gmij = 0.5_dp*(gmcharge(iatom, 1) + gmcharge(jatom, 1)) icol = MAX(iatom, jatom) irow = MIN(iatom, jatom) NULLIFY (pblock) @@ -461,7 +461,7 @@ SUBROUTINE build_dftb_coulomb(qs_env, ks_matrix, rho, mcharge, energy, & ic = cell_to_index(cellind(1), cellind(2), cellind(3)) CPASSERT(ic > 0) - gmij = 0.5_dp*(gmcharge(iatom, 1)+gmcharge(jatom, 1)) + gmij = 0.5_dp*(gmcharge(iatom, 1) + gmcharge(jatom, 1)) NULLIFY (sblock) CALL dbcsr_get_block_p(matrix=matrix_s(1, ic)%matrix, & @@ -472,7 +472,7 @@ SUBROUTINE build_dftb_coulomb(qs_env, ks_matrix, rho, mcharge, energy, & CALL dbcsr_get_block_p(matrix=ks_matrix(is, ic)%matrix, & row=irow, col=icol, block=ksblock, found=found) CPASSERT(found) - ksblock = ksblock-gmij*sblock + ksblock = ksblock - gmij*sblock END DO IF (calculate_forces) THEN @@ -487,12 +487,12 @@ SUBROUTINE build_dftb_coulomb(qs_env, ks_matrix, rho, mcharge, energy, & CPASSERT(found) DO i = 1, 3 NULLIFY (dsblock) - CALL dbcsr_get_block_p(matrix=matrix_s(1+i, ic)%matrix, & + CALL dbcsr_get_block_p(matrix=matrix_s(1 + i, ic)%matrix, & row=irow, col=icol, block=dsblock, found=found) CPASSERT(found) fi = -2.0_dp*gmij*SUM(pblock*dsblock) - force(ikind)%rho_elec(i, atom_i) = force(ikind)%rho_elec(i, atom_i)+fi - force(jkind)%rho_elec(i, atom_j) = force(jkind)%rho_elec(i, atom_j)-fi + force(ikind)%rho_elec(i, atom_i) = force(ikind)%rho_elec(i, atom_i) + fi + force(jkind)%rho_elec(i, atom_j) = force(jkind)%rho_elec(i, atom_j) - fi fij(i) = fi END DO IF (use_virial) THEN @@ -573,25 +573,25 @@ FUNCTION gamma_rab_sr(r, ga, gb, hb_para) RESULT(gamma) gamma = 0.0_dp a = 3.2_dp*ga ! 3.2 = 16/5 in Eq. 18 and ff. b = 3.2_dp*gb - g_sum = a+b + g_sum = a + b IF (g_sum < tol_gamma) RETURN ! hardness screening IF (r < rtiny) THEN ! This is for short distances but non-onsite terms ! This gives also correct diagonal elements (a=b, r=0) - gamma = 0.5_dp*(a*b/g_sum+(a*b)**2/g_sum**3) + gamma = 0.5_dp*(a*b/g_sum + (a*b)**2/g_sum**3) RETURN END IF ! ! distinguish two cases: Gamma's are very close, e.g. for the same atom type, ! and Gamma's are different ! - IF (ABS(a-b) < rtiny) THEN - fac = 1.6_dp*r*a*b/g_sum*(1.0_dp+a*b/g_sum**2) - gamma = -(48.0_dp+33._dp*fac+(9.0_dp+fac)*fac**2)*EXP(-fac)/(48._dp*r) + IF (ABS(a - b) < rtiny) THEN + fac = 1.6_dp*r*a*b/g_sum*(1.0_dp + a*b/g_sum**2) + gamma = -(48.0_dp + 33._dp*fac + (9.0_dp + fac)*fac**2)*EXP(-fac)/(48._dp*r) ELSE - gamma = -EXP(-a*r)*(0.5_dp*a*b**4/(a**2-b**2)**2- & - (b**6-3._dp*a**2*b**4)/(r*(a**2-b**2)**3))- & ! a-> b - EXP(-b*r)*(0.5_dp*b*a**4/(b**2-a**2)**2- & - (a**6-3._dp*b**2*a**4)/(r*(b**2-a**2)**3)) ! b-> a + gamma = -EXP(-a*r)*(0.5_dp*a*b**4/(a**2 - b**2)**2 - & + (b**6 - 3._dp*a**2*b**4)/(r*(a**2 - b**2)**3)) - & ! a-> b + EXP(-b*r)*(0.5_dp*b*a**4/(b**2 - a**2)**2 - & + (a**6 - 3._dp*b**2*a**4)/(r*(b**2 - a**2)**3)) ! b-> a END IF ! ! damping function for better short range hydrogen bonds. @@ -599,7 +599,7 @@ FUNCTION gamma_rab_sr(r, ga, gb, hb_para) RESULT(gamma) ! according to Elstner M, Theor. Chem. Acc. 2006, 116, 316-325, ! this should only be applied to a-b pairs involving hydrogen. IF (hb_para > 0.0_dp) THEN - gamma = gamma*EXP(-(0.5_dp*(ga+gb))**hb_para*r*r) + gamma = gamma*EXP(-(0.5_dp*(ga + gb))**hb_para*r*r) END IF END FUNCTION gamma_rab_sr @@ -663,7 +663,7 @@ SUBROUTINE dftb_dsint_list(qs_env, sap_int) CALL get_iterator_info(nl_iterator, ikind=ikind, jkind=jkind, iatom=iatom, & jatom=jatom, nlist=nlist, ilist=ilist, nnode=nneighbor, & inode=jneighbor, cell=cell, r=rij) - iac = ikind+nkind*(jkind-1) + iac = ikind + nkind*(jkind - 1) ! CALL get_qs_kind(qs_kind_set(ikind), dftb_parameter=dftb_kind_a) CALL get_dftb_atom_param(dftb_kind_a, & @@ -732,15 +732,15 @@ SUBROUTINE dftb_dsint_list(qs_env, sap_int) dsblockm = 0.0_dp drij = rij - drij(i) = rij(i)-ddr + drij(i) = rij(i) - ddr CALL compute_block_sk(dsblockm, smatij, smatji, drij, ngrd, ngrdcut, dgrd, & llm, lmaxi, lmaxj, iatom, iatom) - drij(i) = rij(i)+ddr + drij(i) = rij(i) + ddr CALL compute_block_sk(dsblock, smatij, smatji, drij, ngrd, ngrdcut, dgrd, & llm, lmaxi, lmaxj, iatom, iatom) - dsblock = dsblock-dsblockm + dsblock = dsblock - dsblockm dsblock = dsblock/(2.0_dp*ddr) clist%acint(1:n1, 1:n2, i) = -dsblock(1:n1, 1:n2) diff --git a/src/qs_dftb_dispersion.F b/src/qs_dftb_dispersion.F index 5b8ad270fe..5f9615cfe5 100644 --- a/src/qs_dftb_dispersion.F +++ b/src/qs_dftb_dispersion.F @@ -186,7 +186,7 @@ SUBROUTINE calculate_dispersion_uff(qs_env, para_env, calculate_forces) DO WHILE (neighbor_list_iterate(nl_iterator) == 0) CALL get_iterator_info(nl_iterator, ikind=ikind, jkind=jkind, iatom=iatom, jatom=jatom, r=rij) IF ((.NOT. define_kind(ikind)) .OR. (.NOT. define_kind(jkind))) CYCLE - rc = rc_kind(ikind)+rc_kind(jkind) + rc = rc_kind(ikind) + rc_kind(jkind) ! vdW potential dr = SQRT(SUM(rij(:)**2)) IF (dr <= rc .AND. dr > 0.001_dp) THEN @@ -205,17 +205,17 @@ SUBROUTINE calculate_dispersion_uff(qs_env, para_env, calculate_forces) ! This is the standard London contribution. ! UFF1 - Eq. 20 (long-range) xp = xij/dr - eij = dij*(-2._dp*xp**6+xp**12)*fac - evdw = evdw+eij + eij = dij*(-2._dp*xp**6 + xp**12)*fac + evdw = evdw + eij IF (calculate_forces .AND. (dr > 0.001_dp)) THEN - devdw = dij*12._dp*(xp**6-xp**12)/dr*fac + devdw = dij*12._dp*(xp**6 - xp**12)/dr*fac atom_a = atom_of_kind(iatom) atom_b = atom_of_kind(jatom) fdij(:) = devdw*rij(:)/dr force(ikind)%dispersion(:, atom_a) = & - force(ikind)%dispersion(:, atom_a)-fdij(:) + force(ikind)%dispersion(:, atom_a) - fdij(:) force(jkind)%dispersion(:, atom_b) = & - force(jkind)%dispersion(:, atom_b)+fdij(:) + force(jkind)%dispersion(:, atom_b) + fdij(:) END IF ELSE ! Shorter distance. @@ -223,22 +223,22 @@ SUBROUTINE calculate_dispersion_uff(qs_env, para_env, calculate_forces) ! Using a parabola of the form (y = A - Bx**5 -Cx**10). ! Analytic parameters by forcing energy, first and second ! derivatives to be continuous. - eij = (A-B*dr**5-C*dr**10)*fac - evdw = evdw+eij + eij = (A - B*dr**5 - C*dr**10)*fac + evdw = evdw + eij IF (calculate_forces .AND. (dr > 0.001_dp)) THEN atom_a = atom_of_kind(iatom) atom_b = atom_of_kind(jatom) - devdw = (-5*B*dr**4-10*C*dr**9)*fac + devdw = (-5*B*dr**4 - 10*C*dr**9)*fac fdij(:) = devdw*rij(:)/dr force(ikind)%dispersion(:, atom_a) = & - force(ikind)%dispersion(:, atom_a)-fdij(:) + force(ikind)%dispersion(:, atom_a) - fdij(:) force(jkind)%dispersion(:, atom_b) = & - force(jkind)%dispersion(:, atom_b)+fdij(:) + force(jkind)%dispersion(:, atom_b) + fdij(:) END IF END IF IF (atprop%energy) THEN - atprop%atevdw(iatom) = atprop%atevdw(iatom)+0.5_dp*eij - atprop%atevdw(jatom) = atprop%atevdw(jatom)+0.5_dp*eij + atprop%atevdw(iatom) = atprop%atevdw(iatom) + 0.5_dp*eij + atprop%atevdw(jatom) = atprop%atevdw(jatom) + 0.5_dp*eij END IF IF (calculate_forces .AND. (dr > 0.001_dp) .AND. use_virial) THEN CALL virial_pair_force(virial%pv_virial, -1._dp, fdij, rij) diff --git a/src/qs_dftb_matrices.F b/src/qs_dftb_matrices.F index 8b26b7e191..8bd5594dfe 100644 --- a/src/qs_dftb_matrices.F +++ b/src/qs_dftb_matrices.F @@ -152,7 +152,7 @@ SUBROUTINE build_dftb_matrices(qs_env, para_env, calculate_forces) DO l1 = 0, MAX(la, lb) DO l2 = 0, MIN(l1, la, lb) DO m = 0, l2 - llm = llm+1 + llm = llm + 1 iptr(l1, l2, m, la, lb) = llm END DO END DO @@ -314,8 +314,8 @@ SUBROUTINE build_dftb_matrices(qs_env, para_env, calculate_forces) IF (iatom == jatom .AND. dr < 0.001_dp) THEN ! diagonal block DO i = 1, natorb_a - sblock(i, i) = sblock(i, i)+1._dp - fblock(i, i) = fblock(i, i)+skself(orbptr(i)) + sblock(i, i) = sblock(i, i) + 1._dp + fblock(i, i) = fblock(i, i) + skself(orbptr(i)) END DO ELSE ! off-diagonal block @@ -339,7 +339,7 @@ SUBROUTINE build_dftb_matrices(qs_env, para_env, calculate_forces) drij = rij dfblock = 0._dp; dsblock = 0._dp - drij(i) = rij(i)-ddr*f0 + drij(i) = rij(i) - ddr*f0 CALL compute_block_sk(dsblock, smatij, smatji, drij, ngrd, ngrdcut, dgrd, & llm, lmaxi, lmaxj, irow, iatom) CALL compute_block_sk(dfblock, fmatij, fmatji, drij, ngrd, ngrdcut, dgrd, & @@ -348,7 +348,7 @@ SUBROUTINE build_dftb_matrices(qs_env, para_env, calculate_forces) dsblock = -dsblock dfblock = -dfblock - drij(i) = rij(i)+ddr*f0 + drij(i) = rij(i) + ddr*f0 CALL compute_block_sk(dsblock, smatij, smatji, drij, ngrd, ngrdcut, dgrd, & llm, lmaxi, lmaxj, irow, iatom) CALL compute_block_sk(dfblock, fmatij, fmatji, drij, ngrd, ngrdcut, dgrd, & @@ -360,11 +360,11 @@ SUBROUTINE build_dftb_matrices(qs_env, para_env, calculate_forces) foab = 2.0_dp*SUM(dfblock*pblock) fow = -2.0_dp*SUM(dsblock*wblock) - force_ab(i) = force_ab(i)+foab - force_w(i) = force_w(i)+fow + force_ab(i) = force_ab(i) + foab + force_w(i) = force_w(i) + fow IF (dftb_control%self_consistent) THEN - CPASSERT(ASSOCIATED(dsblocks(i+1)%block)) - dsblocks(i+1)%block = dsblocks(i+1)%block+dsblock + CPASSERT(ASSOCIATED(dsblocks(i + 1)%block)) + dsblocks(i + 1)%block = dsblocks(i + 1)%block + dsblock END IF ENDDO IF (use_virial) THEN @@ -390,10 +390,10 @@ SUBROUTINE build_dftb_matrices(qs_env, para_env, calculate_forces) atom_b = atom_of_kind(jatom) IF (irow == iatom) force_ab = -force_ab IF (irow == iatom) force_w = -force_w - force(ikind)%all_potential(:, atom_a) = force(ikind)%all_potential(:, atom_a)-force_ab(:) - force(jkind)%all_potential(:, atom_b) = force(jkind)%all_potential(:, atom_b)+force_ab(:) - force(ikind)%overlap(:, atom_a) = force(ikind)%overlap(:, atom_a)-force_w(:) - force(jkind)%overlap(:, atom_b) = force(jkind)%overlap(:, atom_b)+force_w(:) + force(ikind)%all_potential(:, atom_a) = force(ikind)%all_potential(:, atom_a) - force_ab(:) + force(jkind)%all_potential(:, atom_b) = force(jkind)%all_potential(:, atom_b) + force_ab(:) + force(ikind)%overlap(:, atom_a) = force(ikind)%overlap(:, atom_a) - force_w(:) + force(jkind)%overlap(:, atom_b) = force(jkind)%overlap(:, atom_b) + force_w(:) END IF END IF @@ -403,18 +403,18 @@ SUBROUTINE build_dftb_matrices(qs_env, para_env, calculate_forces) erepij = 0._dp CALL urep_egr(rij, dr, erepij, force_rr, & n_urpoly, urep, spdim, s_cut, srep, spxr, scoeff, surr, calculate_forces) - erep = erep+erepij + erep = erep + erepij IF (atprop%energy) THEN - atprop%atecc(iatom) = atprop%atecc(iatom)+0.5_dp*erepij - atprop%atecc(jatom) = atprop%atecc(jatom)+0.5_dp*erepij + atprop%atecc(iatom) = atprop%atecc(iatom) + 0.5_dp*erepij + atprop%atecc(jatom) = atprop%atecc(jatom) + 0.5_dp*erepij END IF IF (calculate_forces .AND. (iatom /= jatom .OR. dr > 0.001_dp)) THEN atom_a = atom_of_kind(iatom) atom_b = atom_of_kind(jatom) force(ikind)%repulsive(:, atom_a) = & - force(ikind)%repulsive(:, atom_a)-force_rr(:) + force(ikind)%repulsive(:, atom_a) - force_rr(:) force(jkind)%repulsive(:, atom_b) = & - force(jkind)%repulsive(:, atom_b)+force_rr(:) + force(jkind)%repulsive(:, atom_b) + force_rr(:) IF (use_virial) THEN f0 = -1.0_dp IF (iatom == jatom) f0 = -0.5_dp @@ -584,7 +584,7 @@ SUBROUTINE build_dftb_ks_matrix(qs_env, calculate_forces, just_energy) CALL get_dftb_atom_param(dftb_kind, zeff=zeff) DO iatom = 1, natom atom_a = atomic_kind_set(ikind)%atom_list(iatom) - mcharge(atom_a) = zeff-SUM(charges(atom_a, 1:nspins)) + mcharge(atom_a) = zeff - SUM(charges(atom_a, 1:nspins)) END DO END DO DEALLOCATE (charges) @@ -609,14 +609,14 @@ SUBROUTINE build_dftb_ks_matrix(qs_env, calculate_forces, just_energy) ! Compute QM/MM Energy CALL dbcsr_dot(qs_env%ks_qmmm_env%matrix_h(1)%matrix, & matrix_p1(ispin)%matrix, qmmm_el) - energy%qmmm_el = energy%qmmm_el+qmmm_el + energy%qmmm_el = energy%qmmm_el + qmmm_el END DO pc_ener = qs_env%ks_qmmm_env%pc_ener - energy%qmmm_el = energy%qmmm_el+pc_ener + energy%qmmm_el = energy%qmmm_el + pc_ener END IF - energy%total = energy%core+energy%hartree+energy%qmmm_el+energy%efield+ & - energy%repulsive+energy%dispersion+energy%dftb3 + energy%total = energy%core + energy%hartree + energy%qmmm_el + energy%efield + & + energy%repulsive + energy%dispersion + energy%dftb3 output_unit = cp_print_key_unit_nr(logger, scf_section, "PRINT%DETAILED_ENERGY", & extension=".scfLog") @@ -708,7 +708,7 @@ SUBROUTINE build_dftb_overlap(qs_env, nderivative, matrix_s) DO l1 = 0, MAX(la, lb) DO l2 = 0, MIN(l1, la, lb) DO m = 0, l2 - llm = llm+1 + llm = llm + 1 iptr(l1, l2, m, la, lb) = llm END DO END DO @@ -790,7 +790,7 @@ SUBROUTINE build_dftb_overlap(qs_env, nderivative, matrix_s) IF (iatom == jatom .AND. dr < 0.001_dp) THEN ! diagonal block DO i = 1, natorb_a - sblock(i, i) = sblock(i, i)+1._dp + sblock(i, i) = sblock(i, i) + 1._dp END DO ELSE ! off-diagonal block @@ -808,48 +808,48 @@ SUBROUTINE build_dftb_overlap(qs_env, nderivative, matrix_s) drij = rij f0 = 1.0_dp; IF (irow == iatom) f0 = -1.0_dp - drij(i) = rij(i)-ddr*f0 + drij(i) = rij(i) - ddr*f0 CALL compute_block_sk(dsblockm, smatij, smatji, drij, ngrd, ngrdcut, dgrd, & llm, lmaxi, lmaxj, irow, iatom) - drij(i) = rij(i)+ddr*f0 + drij(i) = rij(i) + ddr*f0 CALL compute_block_sk(dsblock, smatij, smatji, drij, ngrd, ngrdcut, dgrd, & llm, lmaxi, lmaxj, irow, iatom) - dsblock1(:, :, i) = (dsblock+dsblockm) - dsblock = dsblock-dsblockm + dsblock1(:, :, i) = (dsblock + dsblockm) + dsblock = dsblock - dsblockm dsblock = dsblock/(2.0_dp*ddr) - CPASSERT(ASSOCIATED(dsblocks(i+1)%block)) - dsblocks(i+1)%block = dsblocks(i+1)%block+dsblock + CPASSERT(ASSOCIATED(dsblocks(i + 1)%block)) + dsblocks(i + 1)%block = dsblocks(i + 1)%block + dsblock IF (nderivative .GT. 1) THEN - indder = indder+5-i + indder = indder + 5 - i dsblocks(indder)%block = 0.0_dp - dsblocks(indder)%block = dsblocks(indder)%block+ & - (dsblock1(:, :, i)-2.0_dp*sblock)/ddr**2 + dsblocks(indder)%block = dsblocks(indder)%block + & + (dsblock1(:, :, i) - 2.0_dp*sblock)/ddr**2 END IF ENDDO IF (nderivative .GT. 1) THEN DO i = 1, 2 - DO j = i+1, 3 + DO j = i + 1, 3 dsblock = 0._dp; dsblockm = 0.0_dp drij = rij f0 = 1.0_dp; IF (irow == iatom) f0 = -1.0_dp - drij(i) = rij(i)-ddr*f0; drij(j) = rij(j)-ddr*f0 + drij(i) = rij(i) - ddr*f0; drij(j) = rij(j) - ddr*f0 CALL compute_block_sk(dsblockm, smatij, smatji, drij, ngrd, ngrdcut, dgrd, & llm, lmaxi, lmaxj, irow, iatom) - drij(i) = rij(i)+ddr*f0; drij(j) = rij(j)+ddr*f0 + drij(i) = rij(i) + ddr*f0; drij(j) = rij(j) + ddr*f0 CALL compute_block_sk(dsblock, smatij, smatji, drij, ngrd, ngrdcut, dgrd, & llm, lmaxi, lmaxj, irow, iatom) - indder = 2+2*i+j + indder = 2 + 2*i + j dsblocks(indder)%block = 0.0_dp dsblocks(indder)%block = & - dsblocks(indder)%block+( & - dsblock+dsblockm-dsblock1(:, :, i)-dsblock1(:, :, j)+2.0_dp*sblock)/(2.0_dp*ddr**2) + dsblocks(indder)%block + ( & + dsblock + dsblockm - dsblock1(:, :, i) - dsblock1(:, :, j) + 2.0_dp*sblock)/(2.0_dp*ddr**2) END DO END DO END IF diff --git a/src/qs_dftb_parameters.F b/src/qs_dftb_parameters.F index de4b2374bf..fa886ccbd7 100644 --- a/src/qs_dftb_parameters.F +++ b/src/qs_dftb_parameters.F @@ -50,19 +50,19 @@ MODULE qs_dftb_parameters USE string_utilities, ONLY: uppercase #include "./base/base_uses.f90" - IMPLICIT NONE + IMPLICIT NONE - PRIVATE + PRIVATE ! *** Global parameters *** CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_dftb_parameters' - REAL(dp), PARAMETER :: slako_d0 = 1._dp + REAL(dp), PARAMETER :: slako_d0 = 1._dp ! *** Public subroutines *** - PUBLIC :: qs_dftb_param_init + PUBLIC :: qs_dftb_param_init CONTAINS @@ -75,8 +75,8 @@ MODULE qs_dftb_parameters !> \param subsys_section ... !> \param para_env ... ! ************************************************************************************************** - SUBROUTINE qs_dftb_param_init (atomic_kind_set,qs_kind_set,dftb_control,dftb_potential,& - subsys_section,para_env) + SUBROUTINE qs_dftb_param_init(atomic_kind_set, qs_kind_set, dftb_control, dftb_potential, & + subsys_section, para_env) TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(dftb_control_type), INTENT(inout) :: dftb_control @@ -111,597 +111,597 @@ SUBROUTINE qs_dftb_param_init (atomic_kind_set,qs_kind_set,dftb_control,dftb_pot TYPE(cp_parser_type), POINTER :: parser TYPE(qs_dftb_atom_type), POINTER :: dftb_atom_a, dftb_atom_b - output_unit = -1 - NULLIFY(logger) - logger => cp_get_default_logger() - IF (BTEST(cp_print_key_should_output(logger%iter_info,subsys_section,& - "PRINT%KINDS/BASIS_SET"),cp_p_file)) THEN - output_unit = cp_print_key_unit_nr(logger,subsys_section,& - "PRINT%KINDS",extension=".Log") - IF ( output_unit > 0 ) THEN - WRITE(output_unit,"(/,A)") " DFTB| A set of relativistic DFTB "//& - "parameters for material sciences." - WRITE(output_unit,"(A)") " DFTB| J. Frenzel, N. Jardillier, A.F. Oliveira,"//& - " T. Heine, G. Seifert" - WRITE(output_unit,"(A)") " DFTB| TU Dresden, 2002-2007" - WRITE(output_unit,"(/,A)") " DFTB| Non-SCC parameters " - WRITE(output_unit,"(A,T25,A)") " DFTB| C,H :",& - " D. Porezag et al, PRB 51 12947 (1995)" - WRITE(output_unit,"(A,T25,A)") " DFTB| B,N :",& - " J. Widany et al, PRB 53 4443 (1996)" - WRITE(output_unit,"(A,T25,A)") " DFTB| Li,Na,K,Cl :",& - " S. Hazebroucq et al, JCP 123 134510 (2005)" - WRITE(output_unit,"(A,T25,A)") " DFTB| F :",& - " T. Heine et al, JCSoc-Perkins Trans 2 707 (1999)" - WRITE(output_unit,"(A,T25,A)") " DFTB| Mo,S :",& - " G. Seifert et al, PRL 85 146 (2000)" - WRITE(output_unit,"(A,T25,A)") " DFTB| P :",& - " G. Seifert et al, EPS 16 341 (2001)" - WRITE(output_unit,"(A,T25,A)") " DFTB| Sc,N,C :",& - " M. Krause et al, JCP 115 6596 (2001)" - END IF - CALL cp_print_key_finished_output(output_unit,logger,subsys_section,& - "PRINT%KINDS") - END IF - - sklist = (dftb_control%sk_file_list /= "") - - nkind = SIZE(atomic_kind_set) - ALLOCATE(sk_files(nkind,nkind)) - ! allocate potential structures - ALLOCATE(dftb_potential(nkind,nkind)) - CALL qs_dftb_pairpot_init(dftb_potential) - - DO ikind = 1, nkind - CALL get_atomic_kind(atomic_kind_set(ikind),name=iname,element_symbol=iel) - CALL uppercase(iname) - CALL uppercase(iel) - ldum = qmmm_ff_precond_only_qm(iname) - DO jkind = 1, nkind - CALL get_atomic_kind(atomic_kind_set(jkind),name=jname,element_symbol=jel) - CALL uppercase(jname) - CALL uppercase(jel) - ldum = qmmm_ff_precond_only_qm(jname) - found = .FALSE. - DO k=1,SIZE(dftb_control%sk_pair_list,2) - name_a=TRIM(dftb_control%sk_pair_list(1,k)) - name_b=TRIM(dftb_control%sk_pair_list(2,k)) - CALL uppercase(name_a) - CALL uppercase(name_b) - IF ( (iname==name_a .AND. jname==name_b) ) THEN - sk_files(ikind,jkind) = TRIM(dftb_control%sk_file_path)//"/"//& - TRIM(dftb_control%sk_pair_list(3,k)) - found = .TRUE. - EXIT - END IF - END DO - IF ( .NOT. found .AND. sklist ) THEN - file_name = TRIM(dftb_control%sk_file_path)//"/"//& - TRIM(dftb_control%sk_file_list) - NULLIFY(parser) - CALL parser_create(parser,file_name,para_env=para_env) - DO - at_end = .FALSE. - CALL parser_get_next_line(parser,1,at_end) - IF ( at_end ) EXIT - CALL parser_get_object(parser,name_a,lower_to_upper=.TRUE.) - CALL parser_get_object(parser,name_b,lower_to_upper=.TRUE.) - !Checking Names - IF ( (iname==name_a .AND. jname==name_b) ) THEN - CALL parser_get_object(parser,skfn,string_length=8) - sk_files(ikind,jkind) = TRIM(dftb_control%sk_file_path)//"/"//& - TRIM(skfn) - found = .TRUE. - EXIT - END IF - !Checking Element - IF ( (iel==name_a .AND. jel==name_b) ) THEN - CALL parser_get_object(parser,skfn,string_length=8) - sk_files(ikind,jkind) = TRIM(dftb_control%sk_file_path)//"/"//& - TRIM(skfn) - found = .TRUE. - EXIT - END IF - END DO - CALL parser_release(parser) - END IF - IF(.NOT.found)& - CALL cp_abort(__LOCATION__,& - "Failure in assigning KINDS <"//TRIM(iname)//"> and <"//TRIM(jname)//& - "> to a DFTB interaction pair!") - END DO - END DO - ! reading the files - ! read all pairs, equal kind first - DO ikind = 1, nkind - CALL get_atomic_kind(atomic_kind_set(ikind), z=z,name=iname) - - CALL get_qs_kind(qs_kind_set(ikind),dftb_parameter=dftb_atom_a) - IF (.NOT.ASSOCIATED(dftb_atom_a)) THEN - CALL allocate_dftb_atom_param(dftb_atom_a) - CALL set_qs_kind(qs_kind_set(ikind),dftb_parameter=dftb_atom_a) + output_unit = -1 + NULLIFY (logger) + logger => cp_get_default_logger() + IF (BTEST(cp_print_key_should_output(logger%iter_info, subsys_section, & + "PRINT%KINDS/BASIS_SET"), cp_p_file)) THEN + output_unit = cp_print_key_unit_nr(logger, subsys_section, & + "PRINT%KINDS", extension=".Log") + IF (output_unit > 0) THEN + WRITE (output_unit, "(/,A)") " DFTB| A set of relativistic DFTB "// & + "parameters for material sciences." + WRITE (output_unit, "(A)") " DFTB| J. Frenzel, N. Jardillier, A.F. Oliveira,"// & + " T. Heine, G. Seifert" + WRITE (output_unit, "(A)") " DFTB| TU Dresden, 2002-2007" + WRITE (output_unit, "(/,A)") " DFTB| Non-SCC parameters " + WRITE (output_unit, "(A,T25,A)") " DFTB| C,H :", & + " D. Porezag et al, PRB 51 12947 (1995)" + WRITE (output_unit, "(A,T25,A)") " DFTB| B,N :", & + " J. Widany et al, PRB 53 4443 (1996)" + WRITE (output_unit, "(A,T25,A)") " DFTB| Li,Na,K,Cl :", & + " S. Hazebroucq et al, JCP 123 134510 (2005)" + WRITE (output_unit, "(A,T25,A)") " DFTB| F :", & + " T. Heine et al, JCSoc-Perkins Trans 2 707 (1999)" + WRITE (output_unit, "(A,T25,A)") " DFTB| Mo,S :", & + " G. Seifert et al, PRL 85 146 (2000)" + WRITE (output_unit, "(A,T25,A)") " DFTB| P :", & + " G. Seifert et al, EPS 16 341 (2001)" + WRITE (output_unit, "(A,T25,A)") " DFTB| Sc,N,C :", & + " M. Krause et al, JCP 115 6596 (2001)" + END IF + CALL cp_print_key_finished_output(output_unit, logger, subsys_section, & + "PRINT%KINDS") END IF - ! read all pairs, equal kind first - jkind = ikind + sklist = (dftb_control%sk_file_list /= "") - CALL get_atomic_kind(atomic_kind_set(jkind), name=jname) - CALL get_qs_kind(qs_kind_set(jkind), dftb_parameter=dftb_atom_b) + nkind = SIZE(atomic_kind_set) + ALLOCATE (sk_files(nkind, nkind)) + ! allocate potential structures + ALLOCATE (dftb_potential(nkind, nkind)) + CALL qs_dftb_pairpot_init(dftb_potential) - IF (output_unit > 0) THEN - WRITE(output_unit,"(A,T30,A50)") " DFTB| Reading parameter file ",& - ADJUSTR(TRIM(sk_files(jkind,ikind))) - END IF - skself = 0._dp - eta = 0._dp - occupation = 0._dp - IF ( para_env%ionode ) THEN - runit = get_unit_number() - CALL open_file(file_name=sk_files(jkind,ikind),unit_number=runit) - ! grid density and number of grid poin ts - READ(runit,fmt=*,END=1,err=1) dgrd,ngrd + DO ikind = 1, nkind + CALL get_atomic_kind(atomic_kind_set(ikind), name=iname, element_symbol=iel) + CALL uppercase(iname) + CALL uppercase(iel) + ldum = qmmm_ff_precond_only_qm(iname) + DO jkind = 1, nkind + CALL get_atomic_kind(atomic_kind_set(jkind), name=jname, element_symbol=jel) + CALL uppercase(jname) + CALL uppercase(jel) + ldum = qmmm_ff_precond_only_qm(jname) + found = .FALSE. + DO k = 1, SIZE(dftb_control%sk_pair_list, 2) + name_a = TRIM(dftb_control%sk_pair_list(1, k)) + name_b = TRIM(dftb_control%sk_pair_list(2, k)) + CALL uppercase(name_a) + CALL uppercase(name_b) + IF ((iname == name_a .AND. jname == name_b)) THEN + sk_files(ikind, jkind) = TRIM(dftb_control%sk_file_path)//"/"// & + TRIM(dftb_control%sk_pair_list(3, k)) + found = .TRUE. + EXIT + END IF + END DO + IF (.NOT. found .AND. sklist) THEN + file_name = TRIM(dftb_control%sk_file_path)//"/"// & + TRIM(dftb_control%sk_file_list) + NULLIFY (parser) + CALL parser_create(parser, file_name, para_env=para_env) + DO + at_end = .FALSE. + CALL parser_get_next_line(parser, 1, at_end) + IF (at_end) EXIT + CALL parser_get_object(parser, name_a, lower_to_upper=.TRUE.) + CALL parser_get_object(parser, name_b, lower_to_upper=.TRUE.) + !Checking Names + IF ((iname == name_a .AND. jname == name_b)) THEN + CALL parser_get_object(parser, skfn, string_length=8) + sk_files(ikind, jkind) = TRIM(dftb_control%sk_file_path)//"/"// & + TRIM(skfn) + found = .TRUE. + EXIT + END IF + !Checking Element + IF ((iel == name_a .AND. jel == name_b)) THEN + CALL parser_get_object(parser, skfn, string_length=8) + sk_files(ikind, jkind) = TRIM(dftb_control%sk_file_path)//"/"// & + TRIM(skfn) + found = .TRUE. + EXIT + END IF + END DO + CALL parser_release(parser) + END IF + IF (.NOT. found) & + CALL cp_abort(__LOCATION__, & + "Failure in assigning KINDS <"//TRIM(iname)//"> and <"//TRIM(jname)// & + "> to a DFTB interaction pair!") + END DO + END DO + ! reading the files + ! read all pairs, equal kind first + DO ikind = 1, nkind + CALL get_atomic_kind(atomic_kind_set(ikind), z=z, name=iname) + + CALL get_qs_kind(qs_kind_set(ikind), dftb_parameter=dftb_atom_a) + IF (.NOT. ASSOCIATED(dftb_atom_a)) THEN + CALL allocate_dftb_atom_param(dftb_atom_a) + CALL set_qs_kind(qs_kind_set(ikind), dftb_parameter=dftb_atom_a) + END IF + + ! read all pairs, equal kind first + jkind = ikind + + CALL get_atomic_kind(atomic_kind_set(jkind), name=jname) + CALL get_qs_kind(qs_kind_set(jkind), dftb_parameter=dftb_atom_b) + + IF (output_unit > 0) THEN + WRITE (output_unit, "(A,T30,A50)") " DFTB| Reading parameter file ", & + ADJUSTR(TRIM(sk_files(jkind, ikind))) + END IF + skself = 0._dp + eta = 0._dp + occupation = 0._dp + IF (para_env%ionode) THEN + runit = get_unit_number() + CALL open_file(file_name=sk_files(jkind, ikind), unit_number=runit) + ! grid density and number of grid poin ts + READ (runit, fmt=*, END=1, err=1) dgrd, ngrd ! ! ngrd -1 ? ! In Slako tables, the grid starts at 0.0, in deMon it starts with dgrd ! - ngrd = ngrd - 1 + ngrd = ngrd - 1 ! - ! orbital energy, total energy, hardness, occupation - READ (runit,fmt=*,END=1,err=1) skself(2:0:-1),energy, & - eta(2:0:-1),occupation(2:0:-1) - ! repulsive potential as polynomial - READ (runit,fmt=*,END=1,err=1) uwork(1:10) - n_urpoly = 0 - IF ( DOT_PRODUCT(uwork(2:10),uwork(2:10)) >= 1.e-12_dp) THEN - n_urpoly = 1 - DO k=2,9 - IF ( ABS(uwork(k)) >= 1.e-12_dp ) n_urpoly = k - END DO - END IF + ! orbital energy, total energy, hardness, occupation + READ (runit, fmt=*, END=1, err=1) skself(2:0:-1), energy, & + eta(2:0:-1), occupation(2:0:-1) + ! repulsive potential as polynomial + READ (runit, fmt=*, END=1, err=1) uwork(1:10) + n_urpoly = 0 + IF (DOT_PRODUCT(uwork(2:10), uwork(2:10)) >= 1.e-12_dp) THEN + n_urpoly = 1 + DO k = 2, 9 + IF (ABS(uwork(k)) >= 1.e-12_dp) n_urpoly = k + END DO + END IF ! Polynomials of length 1 are not allowed, it seems we should use spline after all ! This is creative guessing! - IF ( n_urpoly < 2 ) n_urpoly = 0 - END IF - - CALL mp_bcast(n_urpoly,para_env%source,para_env%group) - CALL mp_bcast(uwork,para_env%source,para_env%group) - CALL mp_bcast(ngrd,para_env%source,para_env%group) - CALL mp_bcast(dgrd,para_env%source,para_env%group) - - CALL mp_bcast(skself,para_env%source,para_env%group) - CALL mp_bcast(energy,para_env%source,para_env%group) - CALL mp_bcast(eta,para_env%source,para_env%group) - CALL mp_bcast(occupation,para_env%source,para_env%group) - - CALL set_dftb_atom_param(dftb_parameter=dftb_atom_a,& - z=z,zeff=SUM(occupation),defined=.TRUE.,& - skself=skself,energy=energy,eta=eta,occupation=occupation) - - ! Slater-Koster table - ALLOCATE(fmat(ngrd,10)) - ALLOCATE(smat(ngrd,10)) - IF ( para_env%ionode ) THEN - DO k=1,ngrd - READ (runit,fmt=*,END=1,err=1) fwork(1:10),swork(1:10) - fmat(k,1:10) = fwork(1:10) - smat(k,1:10) = swork(1:10) - END DO - END IF - CALL mp_bcast(fmat,para_env%source,para_env%group) - CALL mp_bcast(smat,para_env%source,para_env%group) - - ! - ! Determine lmax for atom type. - ! An atomic orbital is 'active' if either its onsite energy is different from zero, - ! or - ! if this matrix element contains non-zero elements. - ! The sigma interactions are sufficient for that. - ! In the DFTB-Slako convention they are on orbital 10 (s-s-sigma), - ! 7 (p-p-sigma) and 3 (d-d-sigma). - ! - ! We also allow lmax to be set in the input (in KIND) - ! - CALL get_qs_kind(qs_kind_set(ikind),lmax_dftb=lmax) - IF ( lmax < 0 ) THEN - lmax=0 - DO l=0,3 - SELECT CASE (l) - CASE DEFAULT - CPABORT("") - CASE (0) - lp = 10 - CASE (1) - lp = 7 - CASE (2) - lp = 3 - CASE (3) - lp = 3 ! this is wrong but we don't allow f anyway - END SELECT - ! Technical note: In some slako files dummies are included in the - ! first matrix elements, so remove them. - IF ( (ABS(skself(l)) > 0._dp) .OR. & - (SUM(ABS(fmat(ngrd/10:ngrd,lp))) > 0._dp) ) lmax=l - END DO - ! l=2 (d) is maximum - lmax = MIN(2,lmax) - END IF - IF ( lmax > 2 ) THEN - CALL cp_abort(__LOCATION__,"Maximum L allowed is d. "//& - "Use KIND/LMAX_DFTB to set smaller values if needed.") - END IF - ! - CALL set_dftb_atom_param(dftb_parameter=dftb_atom_a,& - lmax=lmax, natorb=(lmax+1)**2) - - spdim = 0 - IF ( n_urpoly == 0 ) THEN - IF ( para_env%ionode ) THEN - ! Look for spline representation of repulsive potential - search = .TRUE. - DO WHILE (search) - READ (runit,fmt='(A6)',END=1,err=1) cspline - IF (cspline == 'Spline') THEN - search = .FALSE. - ! spline dimension and left-hand cutoff - READ (runit,fmt=*,END=1,err=1) spdim,s_cut - ALLOCATE(spxr(spdim,2)) - ALLOCATE(scoeff(spdim,4)) - ! e-functions describing left-hand extrapolation - READ (runit,fmt=*,END=1,err=1) srep(1:3) - DO isp = 1,spdim-1 - ! location and coefficients of 'normal' spline range - READ (runit,fmt=*,END=1,err=1) spxr(isp,1:2),scoeff(isp,1:4) - END DO - ! last point has 2 more coefficients - READ (runit,fmt=*,END=1,err=1) spxr(spdim,1:2),scoeff(spdim,1:4),surr(1:2) + IF (n_urpoly < 2) n_urpoly = 0 + END IF + + CALL mp_bcast(n_urpoly, para_env%source, para_env%group) + CALL mp_bcast(uwork, para_env%source, para_env%group) + CALL mp_bcast(ngrd, para_env%source, para_env%group) + CALL mp_bcast(dgrd, para_env%source, para_env%group) + + CALL mp_bcast(skself, para_env%source, para_env%group) + CALL mp_bcast(energy, para_env%source, para_env%group) + CALL mp_bcast(eta, para_env%source, para_env%group) + CALL mp_bcast(occupation, para_env%source, para_env%group) + + CALL set_dftb_atom_param(dftb_parameter=dftb_atom_a, & + z=z, zeff=SUM(occupation), defined=.TRUE., & + skself=skself, energy=energy, eta=eta, occupation=occupation) + + ! Slater-Koster table + ALLOCATE (fmat(ngrd, 10)) + ALLOCATE (smat(ngrd, 10)) + IF (para_env%ionode) THEN + DO k = 1, ngrd + READ (runit, fmt=*, END=1, err=1) fwork(1:10), swork(1:10) + fmat(k, 1:10) = fwork(1:10) + smat(k, 1:10) = swork(1:10) + END DO + END IF + CALL mp_bcast(fmat, para_env%source, para_env%group) + CALL mp_bcast(smat, para_env%source, para_env%group) + + ! + ! Determine lmax for atom type. + ! An atomic orbital is 'active' if either its onsite energy is different from zero, + ! or + ! if this matrix element contains non-zero elements. + ! The sigma interactions are sufficient for that. + ! In the DFTB-Slako convention they are on orbital 10 (s-s-sigma), + ! 7 (p-p-sigma) and 3 (d-d-sigma). + ! + ! We also allow lmax to be set in the input (in KIND) + ! + CALL get_qs_kind(qs_kind_set(ikind), lmax_dftb=lmax) + IF (lmax < 0) THEN + lmax = 0 + DO l = 0, 3 + SELECT CASE (l) + CASE DEFAULT + CPABORT("") + CASE (0) + lp = 10 + CASE (1) + lp = 7 + CASE (2) + lp = 3 + CASE (3) + lp = 3 ! this is wrong but we don't allow f anyway + END SELECT + ! Technical note: In some slako files dummies are included in the + ! first matrix elements, so remove them. + IF ((ABS(skself(l)) > 0._dp) .OR. & + (SUM(ABS(fmat(ngrd/10:ngrd, lp))) > 0._dp)) lmax = l + END DO + ! l=2 (d) is maximum + lmax = MIN(2, lmax) + END IF + IF (lmax > 2) THEN + CALL cp_abort(__LOCATION__, "Maximum L allowed is d. "// & + "Use KIND/LMAX_DFTB to set smaller values if needed.") + END IF + ! + CALL set_dftb_atom_param(dftb_parameter=dftb_atom_a, & + lmax=lmax, natorb=(lmax + 1)**2) + + spdim = 0 + IF (n_urpoly == 0) THEN + IF (para_env%ionode) THEN + ! Look for spline representation of repulsive potential + search = .TRUE. + DO WHILE (search) + READ (runit, fmt='(A6)', END=1, err=1) cspline + IF (cspline == 'Spline') THEN + search = .FALSE. + ! spline dimension and left-hand cutoff + READ (runit, fmt=*, END=1, err=1) spdim, s_cut + ALLOCATE (spxr(spdim, 2)) + ALLOCATE (scoeff(spdim, 4)) + ! e-functions describing left-hand extrapolation + READ (runit, fmt=*, END=1, err=1) srep(1:3) + DO isp = 1, spdim - 1 + ! location and coefficients of 'normal' spline range + READ (runit, fmt=*, END=1, err=1) spxr(isp, 1:2), scoeff(isp, 1:4) + END DO + ! last point has 2 more coefficients + READ (runit, fmt=*, END=1, err=1) spxr(spdim, 1:2), scoeff(spdim, 1:4), surr(1:2) + END IF + END DO END IF - END DO - END IF - END IF - - IF ( para_env%ionode ) THEN - CALL close_file(unit_number=runit) - END IF - - CALL mp_bcast(spdim,para_env%source,para_env%group) - IF ( spdim > 0 .AND. (.NOT. para_env%ionode)) THEN - ALLOCATE(spxr(spdim,2)) - ALLOCATE(scoeff(spdim,4)) - END IF - IF(spdim > 0) THEN - CALL mp_bcast(spxr,para_env%source,para_env%group) - CALL mp_bcast(scoeff,para_env%source,para_env%group) - CALL mp_bcast(surr,para_env%source,para_env%group) - CALL mp_bcast(srep,para_env%source,para_env%group) - CALL mp_bcast(s_cut,para_env%source,para_env%group) - END IF + END IF + + IF (para_env%ionode) THEN + CALL close_file(unit_number=runit) + END IF + + CALL mp_bcast(spdim, para_env%source, para_env%group) + IF (spdim > 0 .AND. (.NOT. para_env%ionode)) THEN + ALLOCATE (spxr(spdim, 2)) + ALLOCATE (scoeff(spdim, 4)) + END IF + IF (spdim > 0) THEN + CALL mp_bcast(spxr, para_env%source, para_env%group) + CALL mp_bcast(scoeff, para_env%source, para_env%group) + CALL mp_bcast(surr, para_env%source, para_env%group) + CALL mp_bcast(srep, para_env%source, para_env%group) + CALL mp_bcast(s_cut, para_env%source, para_env%group) + END IF + + ! store potential data + ! allocate data + CALL get_dftb_atom_param(dftb_parameter=dftb_atom_a, lmax=lmax_a) + CALL get_dftb_atom_param(dftb_parameter=dftb_atom_b, lmax=lmax_b) + llm = 0 + DO l1 = 0, MAX(lmax_a, lmax_b) + DO l2 = 0, MIN(l1, lmax_a, lmax_b) + DO m = 0, l2 + llm = llm + 1 + END DO + END DO + END DO + CALL qs_dftb_pairpot_create(dftb_potential(ikind, jkind), & + ngrd, llm, spdim) + + ! repulsive potential + dftb_potential(ikind, jkind)%n_urpoly = n_urpoly + dftb_potential(ikind, jkind)%urep_cut = uwork(10) + dftb_potential(ikind, jkind)%urep(:) = 0._dp + dftb_potential(ikind, jkind)%urep(1) = uwork(10) + dftb_potential(ikind, jkind)%urep(2:n_urpoly) = uwork(2:n_urpoly) + + ! Slater-Koster tables + dftb_potential(ikind, jkind)%dgrd = dgrd + CALL skreorder(fmat, lmax_a, lmax_b) + dftb_potential(ikind, jkind)%fmat(:, 1:llm) = fmat(:, 1:llm) + CALL skreorder(smat, lmax_a, lmax_b) + dftb_potential(ikind, jkind)%smat(:, 1:llm) = smat(:, 1:llm) + dftb_potential(ikind, jkind)%ngrdcut = ngrd + INT(slako_d0/dgrd) + ! Splines + IF (spdim > 0) THEN + dftb_potential(ikind, jkind)%s_cut = s_cut + dftb_potential(ikind, jkind)%srep = srep + dftb_potential(ikind, jkind)%spxr = spxr + dftb_potential(ikind, jkind)%scoeff = scoeff + dftb_potential(ikind, jkind)%surr = surr + END IF + + DEALLOCATE (fmat) + DEALLOCATE (smat) + IF (spdim > 0) THEN + DEALLOCATE (spxr) + DEALLOCATE (scoeff) + END IF - ! store potential data - ! allocate data - CALL get_dftb_atom_param(dftb_parameter=dftb_atom_a,lmax=lmax_a) - CALL get_dftb_atom_param(dftb_parameter=dftb_atom_b,lmax=lmax_b) - llm = 0 - DO l1 = 0,MAX(lmax_a,lmax_b) - DO l2 = 0,MIN(l1,lmax_a,lmax_b) - DO m = 0,l2 - llm = llm + 1 - END DO - END DO END DO - CALL qs_dftb_pairpot_create(dftb_potential(ikind,jkind),& - ngrd,llm,spdim) - - ! repulsive potential - dftb_potential(ikind,jkind)%n_urpoly = n_urpoly - dftb_potential(ikind,jkind)%urep_cut = uwork(10) - dftb_potential(ikind,jkind)%urep(:) = 0._dp - dftb_potential(ikind,jkind)%urep(1) = uwork(10) - dftb_potential(ikind,jkind)%urep(2:n_urpoly) = uwork(2:n_urpoly) - - ! Slater-Koster tables - dftb_potential(ikind,jkind)%dgrd = dgrd - CALL skreorder(fmat,lmax_a,lmax_b) - dftb_potential(ikind,jkind)%fmat(:,1:llm) = fmat(:,1:llm) - CALL skreorder(smat,lmax_a,lmax_b) - dftb_potential(ikind,jkind)%smat(:,1:llm) = smat(:,1:llm) - dftb_potential(ikind,jkind)%ngrdcut = ngrd + INT(slako_d0/dgrd) - ! Splines - IF(spdim > 0) THEN - dftb_potential(ikind,jkind)%s_cut = s_cut - dftb_potential(ikind,jkind)%srep = srep - dftb_potential(ikind,jkind)%spxr = spxr - dftb_potential(ikind,jkind)%scoeff = scoeff - dftb_potential(ikind,jkind)%surr = surr - END IF - DEALLOCATE(fmat) - DEALLOCATE(smat) - IF(spdim > 0) THEN - DEALLOCATE(spxr) - DEALLOCATE(scoeff) - END IF + ! no all other pairs + DO ikind = 1, nkind + CALL get_atomic_kind(atomic_kind_set(ikind), z=z, name=iname) + CALL get_qs_kind(qs_kind_set(ikind), dftb_parameter=dftb_atom_a) - END DO + IF (.NOT. ASSOCIATED(dftb_atom_a)) THEN + CALL allocate_dftb_atom_param(dftb_atom_a) + CALL set_qs_kind(qs_kind_set(ikind), dftb_parameter=dftb_atom_a) + END IF - ! no all other pairs - DO ikind = 1, nkind - CALL get_atomic_kind(atomic_kind_set(ikind), z=z,name=iname) - CALL get_qs_kind(qs_kind_set(ikind),dftb_parameter=dftb_atom_a) + DO jkind = 1, nkind - IF (.NOT.ASSOCIATED(dftb_atom_a)) THEN - CALL allocate_dftb_atom_param(dftb_atom_a) - CALL set_qs_kind(qs_kind_set(ikind),dftb_parameter=dftb_atom_a) - END IF + IF (ikind == jkind) CYCLE + CALL get_atomic_kind(atomic_kind_set(jkind), name=jname) + CALL get_qs_kind(qs_kind_set(jkind), dftb_parameter=dftb_atom_b) - DO jkind = 1, nkind - - IF ( ikind == jkind ) CYCLE - CALL get_atomic_kind(atomic_kind_set(jkind), name=jname) - CALL get_qs_kind(qs_kind_set(jkind), dftb_parameter=dftb_atom_b) - - IF (output_unit > 0) THEN - WRITE(output_unit,"(A,T30,A50)") " DFTB| Reading parameter file ",& - ADJUSTR(TRIM(sk_files(ikind,jkind))) - END IF - skself = 0._dp - eta = 0._dp - occupation = 0._dp - IF ( para_env%ionode ) THEN - runit = get_unit_number() - CALL open_file(file_name=sk_files(ikind,jkind),unit_number=runit) - ! grid density and number of grid poin ts - READ(runit,fmt=*,END=1,err=1) dgrd,ngrd + IF (output_unit > 0) THEN + WRITE (output_unit, "(A,T30,A50)") " DFTB| Reading parameter file ", & + ADJUSTR(TRIM(sk_files(ikind, jkind))) + END IF + skself = 0._dp + eta = 0._dp + occupation = 0._dp + IF (para_env%ionode) THEN + runit = get_unit_number() + CALL open_file(file_name=sk_files(ikind, jkind), unit_number=runit) + ! grid density and number of grid poin ts + READ (runit, fmt=*, END=1, err=1) dgrd, ngrd ! ! ngrd -1 ? ! In Slako tables, the grid starts at 0.0, in deMon it starts with dgrd ! - ngrd = ngrd - 1 + ngrd = ngrd - 1 ! - IF ( ikind == jkind) THEN - ! orbital energy, total energy, hardness, occupation - READ (runit,fmt=*,END=1,err=1) skself(2:0:-1),energy, & - eta(2:0:-1),occupation(2:0:-1) - END IF - ! repulsive potential as polynomial - READ (runit,fmt=*,END=1,err=1) uwork(1:10) - n_urpoly = 0 - IF ( DOT_PRODUCT(uwork(2:10),uwork(2:10)) >= 1.e-12_dp) THEN - n_urpoly = 1 - DO k=2,9 - IF ( ABS(uwork(k)) >= 1.e-12_dp ) n_urpoly = k - END DO - END IF + IF (ikind == jkind) THEN + ! orbital energy, total energy, hardness, occupation + READ (runit, fmt=*, END=1, err=1) skself(2:0:-1), energy, & + eta(2:0:-1), occupation(2:0:-1) + END IF + ! repulsive potential as polynomial + READ (runit, fmt=*, END=1, err=1) uwork(1:10) + n_urpoly = 0 + IF (DOT_PRODUCT(uwork(2:10), uwork(2:10)) >= 1.e-12_dp) THEN + n_urpoly = 1 + DO k = 2, 9 + IF (ABS(uwork(k)) >= 1.e-12_dp) n_urpoly = k + END DO + END IF ! Polynomials of length 1 are not allowed, it seems we should use spline after all ! This is creative guessing! - IF ( n_urpoly < 2 ) n_urpoly = 0 - END IF - - CALL mp_bcast(n_urpoly,para_env%source,para_env%group) - CALL mp_bcast(uwork,para_env%source,para_env%group) - CALL mp_bcast(ngrd,para_env%source,para_env%group) - CALL mp_bcast(dgrd,para_env%source,para_env%group) - - ! Slater-Koster table - ALLOCATE(fmat(ngrd,10)) - ALLOCATE(smat(ngrd,10)) - IF ( para_env%ionode ) THEN - DO k=1,ngrd - READ (runit,fmt=*,END=1,err=1) fwork(1:10),swork(1:10) - fmat(k,1:10) = fwork(1:10) - smat(k,1:10) = swork(1:10) - END DO - END IF - CALL mp_bcast(fmat,para_env%source,para_env%group) - CALL mp_bcast(smat,para_env%source,para_env%group) - - spdim = 0 - IF ( n_urpoly == 0 ) THEN - IF ( para_env%ionode ) THEN - ! Look for spline representation of repulsive potential - search = .TRUE. - DO WHILE (search) - READ (runit,fmt='(A6)',END=1,err=1) cspline - IF (cspline == 'Spline') THEN - search = .FALSE. - ! spline dimension and left-hand cutoff - READ (runit,fmt=*,END=1,err=1) spdim,s_cut - ALLOCATE(spxr(spdim,2)) - ALLOCATE(scoeff(spdim,4)) - ! e-functions describing left-hand extrapolation - READ (runit,fmt=*,END=1,err=1) srep(1:3) - DO isp = 1,spdim-1 - ! location and coefficients of 'normal' spline range - READ (runit,fmt=*,END=1,err=1) spxr(isp,1:2),scoeff(isp,1:4) - END DO - ! last point has 2 more coefficients - READ (runit,fmt=*,END=1,err=1) spxr(spdim,1:2),scoeff(spdim,1:4),surr(1:2) - END IF - END DO - END IF - END IF - - IF ( para_env%ionode ) THEN - CALL close_file(unit_number=runit) - END IF - - CALL mp_bcast(spdim,para_env%source,para_env%group) - IF ( spdim > 0 .AND. (.NOT. para_env%ionode)) THEN - ALLOCATE(spxr(spdim,2)) - ALLOCATE(scoeff(spdim,4)) - END IF - IF(spdim > 0) THEN - CALL mp_bcast(spxr,para_env%source,para_env%group) - CALL mp_bcast(scoeff,para_env%source,para_env%group) - CALL mp_bcast(surr,para_env%source,para_env%group) - CALL mp_bcast(srep,para_env%source,para_env%group) - CALL mp_bcast(s_cut,para_env%source,para_env%group) - END IF - - ! store potential data - ! allocate data - CALL get_dftb_atom_param(dftb_parameter=dftb_atom_a,lmax=lmax_a) - CALL get_dftb_atom_param(dftb_parameter=dftb_atom_b,lmax=lmax_b) - llm = 0 - DO l1 = 0,MAX(lmax_a,lmax_b) - DO l2 = 0,MIN(l1,lmax_a,lmax_b) - DO m = 0,l2 - llm = llm + 1 + IF (n_urpoly < 2) n_urpoly = 0 + END IF + + CALL mp_bcast(n_urpoly, para_env%source, para_env%group) + CALL mp_bcast(uwork, para_env%source, para_env%group) + CALL mp_bcast(ngrd, para_env%source, para_env%group) + CALL mp_bcast(dgrd, para_env%source, para_env%group) + + ! Slater-Koster table + ALLOCATE (fmat(ngrd, 10)) + ALLOCATE (smat(ngrd, 10)) + IF (para_env%ionode) THEN + DO k = 1, ngrd + READ (runit, fmt=*, END=1, err=1) fwork(1:10), swork(1:10) + fmat(k, 1:10) = fwork(1:10) + smat(k, 1:10) = swork(1:10) + END DO + END IF + CALL mp_bcast(fmat, para_env%source, para_env%group) + CALL mp_bcast(smat, para_env%source, para_env%group) + + spdim = 0 + IF (n_urpoly == 0) THEN + IF (para_env%ionode) THEN + ! Look for spline representation of repulsive potential + search = .TRUE. + DO WHILE (search) + READ (runit, fmt='(A6)', END=1, err=1) cspline + IF (cspline == 'Spline') THEN + search = .FALSE. + ! spline dimension and left-hand cutoff + READ (runit, fmt=*, END=1, err=1) spdim, s_cut + ALLOCATE (spxr(spdim, 2)) + ALLOCATE (scoeff(spdim, 4)) + ! e-functions describing left-hand extrapolation + READ (runit, fmt=*, END=1, err=1) srep(1:3) + DO isp = 1, spdim - 1 + ! location and coefficients of 'normal' spline range + READ (runit, fmt=*, END=1, err=1) spxr(isp, 1:2), scoeff(isp, 1:4) + END DO + ! last point has 2 more coefficients + READ (runit, fmt=*, END=1, err=1) spxr(spdim, 1:2), scoeff(spdim, 1:4), surr(1:2) + END IF + END DO + END IF + END IF + + IF (para_env%ionode) THEN + CALL close_file(unit_number=runit) + END IF + + CALL mp_bcast(spdim, para_env%source, para_env%group) + IF (spdim > 0 .AND. (.NOT. para_env%ionode)) THEN + ALLOCATE (spxr(spdim, 2)) + ALLOCATE (scoeff(spdim, 4)) + END IF + IF (spdim > 0) THEN + CALL mp_bcast(spxr, para_env%source, para_env%group) + CALL mp_bcast(scoeff, para_env%source, para_env%group) + CALL mp_bcast(surr, para_env%source, para_env%group) + CALL mp_bcast(srep, para_env%source, para_env%group) + CALL mp_bcast(s_cut, para_env%source, para_env%group) + END IF + + ! store potential data + ! allocate data + CALL get_dftb_atom_param(dftb_parameter=dftb_atom_a, lmax=lmax_a) + CALL get_dftb_atom_param(dftb_parameter=dftb_atom_b, lmax=lmax_b) + llm = 0 + DO l1 = 0, MAX(lmax_a, lmax_b) + DO l2 = 0, MIN(l1, lmax_a, lmax_b) + DO m = 0, l2 + llm = llm + 1 + END DO + END DO END DO - END DO - END DO - CALL qs_dftb_pairpot_create(dftb_potential(ikind,jkind),& - ngrd,llm,spdim) - - ! repulsive potential - dftb_potential(ikind,jkind)%n_urpoly = n_urpoly - dftb_potential(ikind,jkind)%urep_cut = uwork(10) - dftb_potential(ikind,jkind)%urep(:) = 0._dp - dftb_potential(ikind,jkind)%urep(1) = uwork(10) - dftb_potential(ikind,jkind)%urep(2:n_urpoly) = uwork(2:n_urpoly) - - ! Slater-Koster tables - dftb_potential(ikind,jkind)%dgrd = dgrd - CALL skreorder(fmat,lmax_a,lmax_b) - dftb_potential(ikind,jkind)%fmat(:,1:llm) = fmat(:,1:llm) - CALL skreorder(smat,lmax_a,lmax_b) - dftb_potential(ikind,jkind)%smat(:,1:llm) = smat(:,1:llm) - dftb_potential(ikind,jkind)%ngrdcut = ngrd +INT(slako_d0/dgrd) - ! Splines - IF(spdim > 0) THEN - dftb_potential(ikind,jkind)%s_cut = s_cut - dftb_potential(ikind,jkind)%srep = srep - dftb_potential(ikind,jkind)%spxr = spxr - dftb_potential(ikind,jkind)%scoeff = scoeff - dftb_potential(ikind,jkind)%surr = surr - END IF - - DEALLOCATE(fmat) - DEALLOCATE(smat) - IF(spdim > 0) THEN - DEALLOCATE(spxr) - DEALLOCATE(scoeff) - END IF + CALL qs_dftb_pairpot_create(dftb_potential(ikind, jkind), & + ngrd, llm, spdim) + + ! repulsive potential + dftb_potential(ikind, jkind)%n_urpoly = n_urpoly + dftb_potential(ikind, jkind)%urep_cut = uwork(10) + dftb_potential(ikind, jkind)%urep(:) = 0._dp + dftb_potential(ikind, jkind)%urep(1) = uwork(10) + dftb_potential(ikind, jkind)%urep(2:n_urpoly) = uwork(2:n_urpoly) + + ! Slater-Koster tables + dftb_potential(ikind, jkind)%dgrd = dgrd + CALL skreorder(fmat, lmax_a, lmax_b) + dftb_potential(ikind, jkind)%fmat(:, 1:llm) = fmat(:, 1:llm) + CALL skreorder(smat, lmax_a, lmax_b) + dftb_potential(ikind, jkind)%smat(:, 1:llm) = smat(:, 1:llm) + dftb_potential(ikind, jkind)%ngrdcut = ngrd + INT(slako_d0/dgrd) + ! Splines + IF (spdim > 0) THEN + dftb_potential(ikind, jkind)%s_cut = s_cut + dftb_potential(ikind, jkind)%srep = srep + dftb_potential(ikind, jkind)%spxr = spxr + dftb_potential(ikind, jkind)%scoeff = scoeff + dftb_potential(ikind, jkind)%surr = surr + END IF - END DO - END DO - - DEALLOCATE(sk_files) - - ! read dispersion parameters (UFF type) - IF ( dftb_control%dispersion ) THEN - - IF ( dftb_control%dispersion_type == dispersion_uff ) THEN - file_name = TRIM(dftb_control%sk_file_path)//"/"//& - TRIM(dftb_control%uff_force_field) - DO ikind = 1, nkind - CALL get_atomic_kind(atomic_kind_set(ikind), name=iname) - CALL get_qs_kind(qs_kind_set(ikind),dftb_parameter=dftb_atom_a) - - m = LEN_TRIM(iname) - NULLIFY(parser) - CALL parser_create(parser,file_name,para_env=para_env) - found = .FALSE. - DO - at_end = .FALSE. - CALL parser_get_next_line(parser,1,at_end) - IF ( at_end ) EXIT - CALL parser_get_object(parser,name_a) - ! parser is no longer removing leading quotes - IF(name_a(1:1) == '"') name_a(1:m) = name_a(2:m+1) - IF ( name_a(1:m) == TRIM(iname) ) THEN - CALL parser_get_object(parser,rb) - CALL parser_get_object(parser,rb) - CALL parser_get_object(parser,ra) - CALL parser_get_object(parser,da) - found = .TRUE. - ra = ra/angstrom - da = da/kcalmol - CALL set_dftb_atom_param(dftb_parameter=dftb_atom_a,name=iname,xi=ra,di=da) - EXIT + DEALLOCATE (fmat) + DEALLOCATE (smat) + IF (spdim > 0) THEN + DEALLOCATE (spxr) + DEALLOCATE (scoeff) END IF - END DO - CALL parser_release(parser) - END DO + + END DO + END DO + + DEALLOCATE (sk_files) + + ! read dispersion parameters (UFF type) + IF (dftb_control%dispersion) THEN + + IF (dftb_control%dispersion_type == dispersion_uff) THEN + file_name = TRIM(dftb_control%sk_file_path)//"/"// & + TRIM(dftb_control%uff_force_field) + DO ikind = 1, nkind + CALL get_atomic_kind(atomic_kind_set(ikind), name=iname) + CALL get_qs_kind(qs_kind_set(ikind), dftb_parameter=dftb_atom_a) + + m = LEN_TRIM(iname) + NULLIFY (parser) + CALL parser_create(parser, file_name, para_env=para_env) + found = .FALSE. + DO + at_end = .FALSE. + CALL parser_get_next_line(parser, 1, at_end) + IF (at_end) EXIT + CALL parser_get_object(parser, name_a) + ! parser is no longer removing leading quotes + IF (name_a(1:1) == '"') name_a(1:m) = name_a(2:m + 1) + IF (name_a(1:m) == TRIM(iname)) THEN + CALL parser_get_object(parser, rb) + CALL parser_get_object(parser, rb) + CALL parser_get_object(parser, ra) + CALL parser_get_object(parser, da) + found = .TRUE. + ra = ra/angstrom + da = da/kcalmol + CALL set_dftb_atom_param(dftb_parameter=dftb_atom_a, name=iname, xi=ra, di=da) + EXIT + END IF + END DO + CALL parser_release(parser) + END DO + END IF + END IF - END IF - - ! extract simple atom interaction radii - DO ikind = 1, nkind - CALL get_qs_kind(qs_kind_set(ikind),dftb_parameter=dftb_atom_a) - radmax = (dftb_potential(ikind,ikind)%ngrdcut + 1) * & - dftb_potential(ikind,ikind)%dgrd*0.5_dp - CALL set_dftb_atom_param(dftb_parameter=dftb_atom_a,cutoff=radmax) - END DO - DO ikind = 1, nkind - CALL get_qs_kind(qs_kind_set(ikind),dftb_parameter=dftb_atom_a) - CALL get_dftb_atom_param(dftb_parameter=dftb_atom_a,cutoff=ra) - DO jkind = 1, nkind - CALL get_qs_kind(qs_kind_set(jkind),dftb_parameter=dftb_atom_b) - CALL get_dftb_atom_param(dftb_parameter=dftb_atom_b,cutoff=rb) - radmax = (dftb_potential(ikind,jkind)%ngrdcut + 1) * & - dftb_potential(ikind,jkind)%dgrd - IF ( ra+rb < radmax ) THEN - ra = ra + (radmax-ra-rb)*0.5_dp - rb = rb + (radmax-ra-rb)*0.5_dp - CALL set_dftb_atom_param(dftb_parameter=dftb_atom_a,cutoff=ra) - CALL set_dftb_atom_param(dftb_parameter=dftb_atom_b,cutoff=rb) - END IF + ! extract simple atom interaction radii + DO ikind = 1, nkind + CALL get_qs_kind(qs_kind_set(ikind), dftb_parameter=dftb_atom_a) + radmax = (dftb_potential(ikind, ikind)%ngrdcut + 1)* & + dftb_potential(ikind, ikind)%dgrd*0.5_dp + CALL set_dftb_atom_param(dftb_parameter=dftb_atom_a, cutoff=radmax) END DO - END DO - - ! set correct core charge in potential - DO ikind = 1, nkind - CALL get_qs_kind(qs_kind_set(ikind),dftb_parameter=dftb_atom_a) - CALL get_dftb_atom_param(dftb_parameter=dftb_atom_a,zeff=zeff) - CALL set_potential(potential=qs_kind_set(ikind)%all_potential,& - zeff=zeff,zeff_correction=0.0_dp) - END DO - - ! setup DFTB3 parameters - IF ( dftb_control%dftb3_diagonal ) THEN DO ikind = 1, nkind - CALL get_qs_kind(qs_kind_set(ikind), dftb3_param=db) - CALL get_qs_kind(qs_kind_set(ikind), dftb_parameter=dftb_atom_a) - CALL set_dftb_atom_param(dftb_parameter=dftb_atom_a,dudq=db) + CALL get_qs_kind(qs_kind_set(ikind), dftb_parameter=dftb_atom_a) + CALL get_dftb_atom_param(dftb_parameter=dftb_atom_a, cutoff=ra) + DO jkind = 1, nkind + CALL get_qs_kind(qs_kind_set(jkind), dftb_parameter=dftb_atom_b) + CALL get_dftb_atom_param(dftb_parameter=dftb_atom_b, cutoff=rb) + radmax = (dftb_potential(ikind, jkind)%ngrdcut + 1)* & + dftb_potential(ikind, jkind)%dgrd + IF (ra + rb < radmax) THEN + ra = ra + (radmax - ra - rb)*0.5_dp + rb = rb + (radmax - ra - rb)*0.5_dp + CALL set_dftb_atom_param(dftb_parameter=dftb_atom_a, cutoff=ra) + CALL set_dftb_atom_param(dftb_parameter=dftb_atom_b, cutoff=rb) + END IF + END DO + END DO + + ! set correct core charge in potential + DO ikind = 1, nkind + CALL get_qs_kind(qs_kind_set(ikind), dftb_parameter=dftb_atom_a) + CALL get_dftb_atom_param(dftb_parameter=dftb_atom_a, zeff=zeff) + CALL set_potential(potential=qs_kind_set(ikind)%all_potential, & + zeff=zeff, zeff_correction=0.0_dp) END DO - END IF - - ! setup dispersion parameters (UFF type) - IF ( dftb_control%dispersion ) THEN - IF ( dftb_control%dispersion_type == dispersion_uff ) THEN - eps_disp = dftb_control%eps_disp - DO ikind = 1, nkind - CALL get_qs_kind(qs_kind_set(ikind), dftb_parameter=dftb_atom_a) - CALL get_dftb_atom_param(dftb_parameter=dftb_atom_a,xi=ra,di=da) - rcdisp = 0._dp - DO jkind = 1, nkind - CALL get_qs_kind(qs_kind_set(jkind),dftb_parameter=dftb_atom_b) - CALL get_dftb_atom_param(dftb_parameter=dftb_atom_b,xi=rb,di=db) - xij = SQRT(ra*rb) - dij = SQRT(da*db) - dftb_potential(ikind,jkind)%xij = xij - dftb_potential(ikind,jkind)%dij = dij - dftb_potential(ikind,jkind)%x0ij = xij*(0.5_dp**(1.0_dp/6.0_dp)) - dftb_potential(ikind,jkind)%a = dij*396.0_dp/25.0_dp - dftb_potential(ikind,jkind)%b = & - dij/(xij**5)*672.0_dp*2.0_dp**(5.0_dp/6.0_dp)/25.0_dp - dftb_potential(ikind,jkind)%c = & - -dij/(xij**10)*2.0_dp**(2.0_dp/3.0_dp)*552.0_dp/25.0_dp - rmax6 = ((8._dp*pi*dij/eps_disp)*xij**6)**0.25_dp - rcdisp = MAX(rcdisp,rmax6*0.5_dp) - END DO - CALL set_dftb_atom_param(dftb_parameter=dftb_atom_a,rcdisp=rcdisp) - END DO + + ! setup DFTB3 parameters + IF (dftb_control%dftb3_diagonal) THEN + DO ikind = 1, nkind + CALL get_qs_kind(qs_kind_set(ikind), dftb3_param=db) + CALL get_qs_kind(qs_kind_set(ikind), dftb_parameter=dftb_atom_a) + CALL set_dftb_atom_param(dftb_parameter=dftb_atom_a, dudq=db) + END DO + END IF + + ! setup dispersion parameters (UFF type) + IF (dftb_control%dispersion) THEN + IF (dftb_control%dispersion_type == dispersion_uff) THEN + eps_disp = dftb_control%eps_disp + DO ikind = 1, nkind + CALL get_qs_kind(qs_kind_set(ikind), dftb_parameter=dftb_atom_a) + CALL get_dftb_atom_param(dftb_parameter=dftb_atom_a, xi=ra, di=da) + rcdisp = 0._dp + DO jkind = 1, nkind + CALL get_qs_kind(qs_kind_set(jkind), dftb_parameter=dftb_atom_b) + CALL get_dftb_atom_param(dftb_parameter=dftb_atom_b, xi=rb, di=db) + xij = SQRT(ra*rb) + dij = SQRT(da*db) + dftb_potential(ikind, jkind)%xij = xij + dftb_potential(ikind, jkind)%dij = dij + dftb_potential(ikind, jkind)%x0ij = xij*(0.5_dp**(1.0_dp/6.0_dp)) + dftb_potential(ikind, jkind)%a = dij*396.0_dp/25.0_dp + dftb_potential(ikind, jkind)%b = & + dij/(xij**5)*672.0_dp*2.0_dp**(5.0_dp/6.0_dp)/25.0_dp + dftb_potential(ikind, jkind)%c = & + -dij/(xij**10)*2.0_dp**(2.0_dp/3.0_dp)*552.0_dp/25.0_dp + rmax6 = ((8._dp*pi*dij/eps_disp)*xij**6)**0.25_dp + rcdisp = MAX(rcdisp, rmax6*0.5_dp) + END DO + CALL set_dftb_atom_param(dftb_parameter=dftb_atom_a, rcdisp=rcdisp) + END DO + END IF END IF - END IF - RETURN + RETURN -1 CONTINUE - CPABORT("") +1 CONTINUE + CPABORT("") - END SUBROUTINE qs_dftb_param_init + END SUBROUTINE qs_dftb_param_init ! ************************************************************************************************** !> \brief Transform Slako format in l1/l2/m format @@ -726,34 +726,34 @@ END SUBROUTINE qs_dftb_param_init !> 10: s - s - sigma !> \version 1.0 ! ************************************************************************************************** - SUBROUTINE skreorder(xmat,la,lb) + SUBROUTINE skreorder(xmat, la, lb) REAL(dp), DIMENSION(:, :), INTENT(INOUT) :: xmat INTEGER, INTENT(IN) :: la, lb INTEGER :: i, l1, l2, llm, m - REAL(dp) :: skllm(0:3,0:3,0:3) - - DO i=1,SIZE(xmat,1) - skllm = 0._dp - skllm(0,0,0) = xmat(i,10) - skllm(1,0,0) = xmat(i,9) - skllm(2,0,0) = xmat(i,8) - skllm(1,1,1) = xmat(i,7) - skllm(1,1,0) = xmat(i,6) - skllm(2,1,1) = xmat(i,5) - skllm(2,1,0) = xmat(i,4) - skllm(2,2,2) = xmat(i,3) - skllm(2,2,1) = xmat(i,2) - skllm(2,2,0) = xmat(i,1) - llm=0 - DO l1=0,MAX(la,lb) - DO l2=0,MIN(l1,la,lb) - DO m=0,l2 - llm=llm+1 - xmat(i,llm)=skllm(l1,l2,m) + REAL(dp) :: skllm(0:3, 0:3, 0:3) + + DO i = 1, SIZE(xmat, 1) + skllm = 0._dp + skllm(0, 0, 0) = xmat(i, 10) + skllm(1, 0, 0) = xmat(i, 9) + skllm(2, 0, 0) = xmat(i, 8) + skllm(1, 1, 1) = xmat(i, 7) + skllm(1, 1, 0) = xmat(i, 6) + skllm(2, 1, 1) = xmat(i, 5) + skllm(2, 1, 0) = xmat(i, 4) + skllm(2, 2, 2) = xmat(i, 3) + skllm(2, 2, 1) = xmat(i, 2) + skllm(2, 2, 0) = xmat(i, 1) + llm = 0 + DO l1 = 0, MAX(la, lb) + DO l2 = 0, MIN(l1, la, lb) + DO m = 0, l2 + llm = llm + 1 + xmat(i, llm) = skllm(l1, l2, m) + END DO END DO - END DO - END DO + END DO END DO ! END SUBROUTINE skreorder diff --git a/src/qs_dftb_utils.F b/src/qs_dftb_utils.F index 69e2b5cb86..cc0439845c 100644 --- a/src/qs_dftb_utils.F +++ b/src/qs_dftb_utils.F @@ -374,10 +374,10 @@ SUBROUTINE interpol(slakotab, skpar, dx, ngrd, dgrd, llm, clgp) INTEGER :: fgpm, k, l, lgpm REAL(dp) :: error, xa(max_inter), ya(max_inter) - lgpm = MIN(clgp+INT(max_inter/2.0), ngrd) - fgpm = lgpm-max_inter+1 - DO k = 0, max_inter-1 - xa(k+1) = (fgpm+k)*dgrd + lgpm = MIN(clgp + INT(max_inter/2.0), ngrd) + fgpm = lgpm - max_inter + 1 + DO k = 0, max_inter - 1 + xa(k + 1) = (fgpm + k)*dgrd END DO ! ! Interpolate matrix elements for all orbitals @@ -411,16 +411,16 @@ SUBROUTINE extrapol(slakotab, skpar, dx, ngrd, dgrd, llm) REAL(dp) :: error, xa(max_extra), ya(max_extra) nzero = max_extra/3 - ntable = max_extra-nzero + ntable = max_extra - nzero ! ! Get the three last distances from the table ! DO k = 1, ntable - xa(k) = (ngrd-(max_extra-3)+k)*dgrd + xa(k) = (ngrd - (max_extra - 3) + k)*dgrd END DO DO k = 1, nzero - xa(ntable+k) = (ngrd+k-1)*dgrd+slako_d0 - ya(ntable+k) = 0.0 + xa(ntable + k) = (ngrd + k - 1)*dgrd + slako_d0 + ya(ntable + k) = 0.0 END DO ! ! Extrapolate matrix elements for all orbitals @@ -429,9 +429,9 @@ SUBROUTINE extrapol(slakotab, skpar, dx, ngrd, dgrd, llm) ! ! Read SK parameters from table ! - fgp = ngrd+1-(max_extra-3) + fgp = ngrd + 1 - (max_extra - 3) lgp = ngrd - ya(1:max_extra-3) = slakotab(fgp:lgp, l) + ya(1:max_extra - 3) = slakotab(fgp:lgp, l) CALL polint(xa, ya, max_extra, dx, skpar(l), error) END DO END SUBROUTINE extrapol @@ -571,7 +571,7 @@ SUBROUTINE skss(skpar, mat) REAL(dp), INTENT(in) :: skpar(:) REAL(dp), INTENT(inout) :: mat(:, :) - mat(1, 1) = mat(1, 1)+skpar(1) + mat(1, 1) = mat(1, 1) + skpar(1) ! END SUBROUTINE skss @@ -595,11 +595,11 @@ SUBROUTINE sksp(skpar, mat, ind, transposed) skp = skpar(ind(1, 0, 0)) IF (transposed) THEN DO l = 1, 3 - mat(1, l+1) = mat(1, l+1)+rr(l)*skp + mat(1, l + 1) = mat(1, l + 1) + rr(l)*skp END DO ELSE DO l = 1, 3 - mat(l+1, 1) = mat(l+1, 1)-rr(l)*skp + mat(l + 1, 1) = mat(l + 1, 1) - rr(l)*skp END DO END IF ! @@ -621,26 +621,26 @@ SUBROUTINE skpp(skpar, mat, ind) epp(1:3) = rr2(1:3) DO l = 1, 3 - epp(l+3) = rr(l)*rr(l+1) + epp(l + 3) = rr(l)*rr(l + 1) END DO skppp = skpar(ind(1, 1, 1)) skpps = skpar(ind(1, 1, 0)) ! DO l = 1, 3 - matel(l) = epp(l)*skpps+(1._dp-epp(l))*skppp + matel(l) = epp(l)*skpps + (1._dp - epp(l))*skppp END DO DO l = 4, 6 - matel(l) = epp(l)*(skpps-skppp) + matel(l) = epp(l)*(skpps - skppp) END DO ! DO ir = 1, 3 - DO is = 1, ir-1 - ii = ir-is - k = 3*ii-(ii*(ii-1))/2+is - mat(is+1, ir+1) = mat(is+1, ir+1)+matel(k) - mat(ir+1, is+1) = mat(ir+1, is+1)+matel(k) + DO is = 1, ir - 1 + ii = ir - is + k = 3*ii - (ii*(ii - 1))/2 + is + mat(is + 1, ir + 1) = mat(is + 1, ir + 1) + matel(k) + mat(ir + 1, is + 1) = mat(ir + 1, is + 1) + matel(k) END DO - mat(ir+1, ir+1) = mat(ir+1, ir+1)+matel(ir) + mat(ir + 1, ir + 1) = mat(ir + 1, ir + 1) + matel(ir) END DO END SUBROUTINE skpp @@ -662,22 +662,22 @@ SUBROUTINE sksd(skpar, mat, ind, transposed) sksds = skpar(ind(2, 0, 0)) r3 = SQRT(3._dp) - d4 = rr2(3)-0.5_dp*(rr2(1)+rr2(2)) - d5 = rr2(1)-rr2(2) + d4 = rr2(3) - 0.5_dp*(rr2(1) + rr2(2)) + d5 = rr2(1) - rr2(2) ! DO l = 1, 3 - es(l) = r3*rr(l)*rr(l+1) + es(l) = r3*rr(l)*rr(l + 1) END DO es(4) = 0.5_dp*r3*d5 es(5) = d4 ! IF (transposed) THEN DO l = 1, 5 - mat(1, l+4) = mat(1, l+4)+es(l)*sksds + mat(1, l + 4) = mat(1, l + 4) + es(l)*sksds END DO ELSE DO l = 1, 5 - mat(l+4, 1) = mat(l+4, 1)+es(l)*sksds + mat(l + 4, 1) = mat(l + 4, 1) + es(l)*sksds END DO END IF END SUBROUTINE sksd @@ -700,23 +700,23 @@ SUBROUTINE skpd(skpar, mat, ind, transposed) sktmp r3 = SQRT(3.0_dp) - d3 = rr2(1)+rr2(2) - d4 = rr2(3)-0.5_dp*d3 - d5 = rr2(1)-rr2(2) + d3 = rr2(1) + rr2(2) + d4 = rr2(3) - 0.5_dp*d3 + d5 = rr2(1) - rr2(2) d6 = rr(1)*rr(2)*rr(3) DO l = 1, 3 - epd(l, 1) = r3*rr2(l)*rr(l+1) - epd(l, 2) = rr(l+1)*(1.0_dp-2._dp*rr2(l)) - epd(l+4, 1) = r3*rr2(l)*rr(l+2) - epd(l+4, 2) = rr(l+2)*(1.0_dp-2*rr2(l)) - epd(l+7, 1) = 0.5_dp*r3*rr(l)*d5 - epd(l+10, 1) = rr(l)*d4 + epd(l, 1) = r3*rr2(l)*rr(l + 1) + epd(l, 2) = rr(l + 1)*(1.0_dp - 2._dp*rr2(l)) + epd(l + 4, 1) = r3*rr2(l)*rr(l + 2) + epd(l + 4, 2) = rr(l + 2)*(1.0_dp - 2*rr2(l)) + epd(l + 7, 1) = 0.5_dp*r3*rr(l)*d5 + epd(l + 10, 1) = rr(l)*d4 END DO ! epd(4, 1) = r3*d6 epd(4, 2) = -2._dp*d6 - epd(8, 2) = rr(1)*(1.0_dp-d5) - epd(9, 2) = -rr(2)*(1.0_dp+d5) + epd(8, 2) = rr(1)*(1.0_dp - d5) + epd(9, 2) = -rr(2)*(1.0_dp + d5) epd(10, 2) = -rr(3)*d5 epd(11, 2) = -r3*rr(1)*rr2(3) epd(12, 2) = -r3*rr(2)*rr2(3) @@ -725,16 +725,16 @@ SUBROUTINE skpd(skpar, mat, ind, transposed) dm(1:15) = 0.0_dp ! DO m = 1, 2 - sktmp = skpar(ind(2, 1, m-1)) - dm(1) = dm(1)+epd(1, m)*sktmp - dm(2) = dm(2)+epd(6, m)*sktmp - dm(3) = dm(3)+epd(4, m)*sktmp - dm(5) = dm(5)+epd(2, m)*sktmp - dm(6) = dm(6)+epd(7, m)*sktmp - dm(7) = dm(7)+epd(5, m)*sktmp - dm(9) = dm(9)+epd(3, m)*sktmp + sktmp = skpar(ind(2, 1, m - 1)) + dm(1) = dm(1) + epd(1, m)*sktmp + dm(2) = dm(2) + epd(6, m)*sktmp + dm(3) = dm(3) + epd(4, m)*sktmp + dm(5) = dm(5) + epd(2, m)*sktmp + dm(6) = dm(6) + epd(7, m)*sktmp + dm(7) = dm(7) + epd(5, m)*sktmp + dm(9) = dm(9) + epd(3, m)*sktmp DO l = 8, 13 - dm(l+2) = dm(l+2)+epd(l, m)*sktmp + dm(l + 2) = dm(l + 2) + epd(l, m)*sktmp END DO END DO ! @@ -744,15 +744,15 @@ SUBROUTINE skpd(skpar, mat, ind, transposed) IF (transposed) THEN DO ir = 1, 5 DO is = 1, 3 - k = 3*(ir-1)+is - mat(is+1, ir+4) = mat(is+1, ir+4)+dm(k) + k = 3*(ir - 1) + is + mat(is + 1, ir + 4) = mat(is + 1, ir + 4) + dm(k) END DO END DO ELSE DO ir = 1, 5 DO is = 1, 3 - k = 3*(ir-1)+is - mat(ir+4, is+1) = mat(ir+4, is+1)-dm(k) + k = 3*(ir - 1) + is + mat(ir + 4, is + 1) = mat(ir + 4, is + 1) - dm(k) END DO END DO END IF @@ -774,18 +774,18 @@ SUBROUTINE skdd(skpar, mat, ind) REAL(dp) :: d3, d4, d5, dd(3), dm(15), e(15, 3), r3 r3 = SQRT(3._dp) - d3 = rr2(1)+rr2(2) - d4 = rr2(3)-0.5_dp*d3 - d5 = rr2(1)-rr2(2) + d3 = rr2(1) + rr2(2) + d4 = rr2(3) - 0.5_dp*d3 + d5 = rr2(1) - rr2(2) DO l = 1, 3 - e(l, 1) = rr2(l)*rr2(l+1) - e(l, 2) = rr2(l)+rr2(l+1)-4._dp*e(l, 1) - e(l, 3) = rr2(l+2)+e(l, 1) + e(l, 1) = rr2(l)*rr2(l + 1) + e(l, 2) = rr2(l) + rr2(l + 1) - 4._dp*e(l, 1) + e(l, 3) = rr2(l + 2) + e(l, 1) e(l, 1) = 3._dp*e(l, 1) END DO e(4, 1) = d5**2 - e(4, 2) = d3-e(4, 1) - e(4, 3) = rr2(3)+0.25_dp*e(4, 1) + e(4, 2) = d3 - e(4, 1) + e(4, 3) = rr2(3) + 0.25_dp*e(4, 1) e(4, 1) = 0.75_dp*e(4, 1) e(5, 1) = d4**2 e(5, 2) = 3._dp*rr2(3)*d3 @@ -794,22 +794,22 @@ SUBROUTINE skdd(skpar, mat, ind) dd(2) = rr(2)*rr(1) dd(3) = rr(3)*rr(2) DO l = 1, 2 - e(l+5, 1) = 3._dp*rr2(l+1)*dd(l) - e(l+5, 2) = dd(l)*(1._dp-4._dp*rr2(l+1)) - e(l+5, 3) = dd(l)*(rr2(l+1)-1._dp) + e(l + 5, 1) = 3._dp*rr2(l + 1)*dd(l) + e(l + 5, 2) = dd(l)*(1._dp - 4._dp*rr2(l + 1)) + e(l + 5, 3) = dd(l)*(rr2(l + 1) - 1._dp) END DO e(8, 1) = dd(1)*d5*1.5_dp - e(8, 2) = dd(1)*(1.0_dp-2.0_dp*d5) - e(8, 3) = dd(1)*(0.5_dp*d5-1.0_dp) + e(8, 2) = dd(1)*(1.0_dp - 2.0_dp*d5) + e(8, 3) = dd(1)*(0.5_dp*d5 - 1.0_dp) e(9, 1) = d5*0.5_dp*d4*r3 e(9, 2) = -d5*rr2(3)*r3 - e(9, 3) = d5*0.25_dp*(1.0_dp+rr2(3))*r3 + e(9, 3) = d5*0.25_dp*(1.0_dp + rr2(3))*r3 e(10, 1) = rr2(1)*dd(3)*3.0_dp - e(10, 2) = (0.25_dp-rr2(1))*dd(3)*4.0_dp - e(10, 3) = dd(3)*(rr2(1)-1.0_dp) + e(10, 2) = (0.25_dp - rr2(1))*dd(3)*4.0_dp + e(10, 3) = dd(3)*(rr2(1) - 1.0_dp) e(11, 1) = 1.5_dp*dd(3)*d5 - e(11, 2) = -dd(3)*(1.0_dp+2.0_dp*d5) - e(11, 3) = dd(3)*(1.0_dp+0.5_dp*d5) + e(11, 2) = -dd(3)*(1.0_dp + 2.0_dp*d5) + e(11, 3) = dd(3)*(1.0_dp + 0.5_dp*d5) e(13, 3) = 0.5_dp*d5*dd(2) e(13, 2) = -2.0_dp*dd(2)*d5 e(13, 1) = e(13, 3)*3.0_dp @@ -817,27 +817,27 @@ SUBROUTINE skdd(skpar, mat, ind) e(14, 1) = d4*dd(3)*r3 e(15, 1) = d4*dd(2)*r3 e(15, 2) = -2.0_dp*r3*dd(2)*rr2(3) - e(15, 3) = 0.5_dp*r3*(1.0_dp+rr2(3))*dd(2) - e(14, 2) = r3*dd(3)*(d3-rr2(3)) + e(15, 3) = 0.5_dp*r3*(1.0_dp + rr2(3))*dd(2) + e(14, 2) = r3*dd(3)*(d3 - rr2(3)) e(14, 3) = -r3*0.5_dp*dd(3)*d3 - e(12, 2) = r3*dd(1)*(d3-rr2(3)) + e(12, 2) = r3*dd(1)*(d3 - rr2(3)) e(12, 3) = -r3*0.5_dp*dd(1)*d3 ! dm(1:15) = 0._dp DO l = 1, 15 DO m = 1, 3 - dm(l) = dm(l)+e(l, m)*skpar(ind(2, 2, m-1)) + dm(l) = dm(l) + e(l, m)*skpar(ind(2, 2, m - 1)) END DO END DO ! DO ir = 1, 5 - DO is = 1, ir-1 - ii = ir-is - k = 5*ii-(ii*(ii-1))/2+is - mat(ir+4, is+4) = mat(ir+4, is+4)+dm(k) - mat(is+4, ir+4) = mat(is+4, ir+4)+dm(k) + DO is = 1, ir - 1 + ii = ir - is + k = 5*ii - (ii*(ii - 1))/2 + is + mat(ir + 4, is + 4) = mat(ir + 4, is + 4) + dm(k) + mat(is + 4, ir + 4) = mat(is + 4, ir + 4) + dm(k) END DO - mat(ir+4, ir+4) = mat(ir+4, ir+4)+dm(ir) + mat(ir + 4, ir + 4) = mat(ir + 4, ir + 4) + dm(ir) END DO END SUBROUTINE skdd ! @@ -867,9 +867,9 @@ SUBROUTINE polint(xa, ya, n, x, y, dy) ns = 1 - dif = ABS(x-xa(1)) + dif = ABS(x - xa(1)) DO i = 1, n - dift = ABS(x-xa(i)) + dift = ABS(x - xa(i)) IF (dift .LT. dif) THEN ns = i dif = dift @@ -879,25 +879,25 @@ SUBROUTINE polint(xa, ya, n, x, y, dy) END DO ! y = ya(ns) - ns = ns-1 - DO m = 1, n-1 - DO i = 1, n-m - ho = xa(i)-x - hp = xa(i+m)-x - w = c(i+1)-d(i) - den = ho-hp + ns = ns - 1 + DO m = 1, n - 1 + DO i = 1, n - m + ho = xa(i) - x + hp = xa(i + m) - x + w = c(i + 1) - d(i) + den = ho - hp CPASSERT(den /= 0.0_dp) den = w/den d(i) = hp*den c(i) = ho*den END DO - IF (2*ns .LT. n-m) THEN - dy = c(ns+1) + IF (2*ns .LT. n - m) THEN + dy = c(ns + 1) ELSE dy = d(ns) - ns = ns-1 + ns = ns - 1 ENDIF - y = y+dy + y = y + dy END DO ! RETURN @@ -941,14 +941,14 @@ SUBROUTINE urep_egr(rv, r, erep, derep, & ! ! polynomial part ! - rz = urep(1)-r + rz = urep(1) - r IF (rz <= rtiny) RETURN DO ic = 2, n_urpoly - erep = erep+urep(ic)*rz**(ic) + erep = erep + urep(ic)*rz**(ic) END DO IF (dograd) THEN DO ic = 2, n_urpoly - de_z = de_z-ic*urep(ic)*rz**(ic-1) + de_z = de_z - ic*urep(ic)*rz**(ic - 1) END DO END IF ELSE IF (spdim > 0) THEN @@ -968,8 +968,8 @@ SUBROUTINE urep_egr(rv, r, erep, derep, & ! IF (r < spxr(1, 1)) THEN ! a) short range - erep = erep+EXP(-srep(1)*r+srep(2))+srep(3) - IF (dograd) de_z = de_z-srep(1)*EXP(-srep(1)*r+srep(2)) + erep = erep + EXP(-srep(1)*r + srep(2)) + srep(3) + IF (dograd) de_z = de_z - srep(1)*EXP(-srep(1)*r + srep(2)) ELSE ! ! condition c). First determine between which places the spline is located: @@ -978,32 +978,32 @@ SUBROUTINE urep_egr(rv, r, erep, derep, & IF (r < spxr(isp, 1)) CYCLE ispg ! distance is smaller than this spline range IF (r >= spxr(isp, 2)) CYCLE ispg ! distance is larger than this spline range ! at this point we have found the correct spline interval - rz = r-spxr(isp, 1) + rz = r - spxr(isp, 1) IF (isp /= spdim) THEN nsp = 3 ! condition ca DO jsp = 0, nsp - erep = erep+scoeff(isp, jsp+1)*rz**(jsp) + erep = erep + scoeff(isp, jsp + 1)*rz**(jsp) END DO IF (dograd) THEN DO jsp = 1, nsp - de_z = de_z+jsp*scoeff(isp, jsp+1)*rz**(jsp-1) + de_z = de_z + jsp*scoeff(isp, jsp + 1)*rz**(jsp - 1) END DO END IF ELSE nsp = 5 ! condition cb DO jsp = 0, nsp IF (jsp <= 3) THEN - erep = erep+scoeff(isp, jsp+1)*rz**(jsp) + erep = erep + scoeff(isp, jsp + 1)*rz**(jsp) ELSE - erep = erep+surr(jsp-3)*rz**(jsp) + erep = erep + surr(jsp - 3)*rz**(jsp) ENDIF END DO IF (dograd) THEN DO jsp = 1, nsp IF (jsp <= 3) THEN - de_z = de_z+jsp*scoeff(isp, jsp+1)*rz**(jsp-1) + de_z = de_z + jsp*scoeff(isp, jsp + 1)*rz**(jsp - 1) ELSE - de_z = de_z+jsp*surr(jsp-3)*rz**(jsp-1) + de_z = de_z + jsp*surr(jsp - 3)*rz**(jsp - 1) ENDIF END DO END IF diff --git a/src/qs_diis.F b/src/qs_diis.F index 36af3abf06..1d13ad4bcf 100644 --- a/src/qs_diis.F +++ b/src/qs_diis.F @@ -100,7 +100,7 @@ SUBROUTINE qs_diis_b_create(diis_buffer, nbuffer) NULLIFY (diis_buffer%parameter) diis_buffer%nbuffer = nbuffer diis_buffer%ncall = 0 - last_diis_b_id = last_diis_b_id+1 + last_diis_b_id = last_diis_b_id + 1 diis_buffer%id_nr = last_diis_b_id diis_buffer%ref_count = 1 @@ -184,7 +184,7 @@ SUBROUTINE qs_diis_b_check_i_alloc(diis_buffer, matrix_struct, nspin, & END IF IF (.NOT. ASSOCIATED(diis_buffer%b_matrix)) THEN - ALLOCATE (diis_buffer%b_matrix(nbuffer+1, nbuffer+1)) + ALLOCATE (diis_buffer%b_matrix(nbuffer + 1, nbuffer + 1)) diis_buffer%b_matrix = 0.0_dp output_unit = cp_print_key_unit_nr(logger, scf_section, "PRINT%DIIS_INFO", & extension=".scfLog") @@ -290,8 +290,8 @@ SUBROUTINE qs_diis_b_step(diis_buffer, mo_array, kc, sc, delta, error_max, & error_max = 0.0_dp - ib = MODULO(diis_buffer%ncall, diis_buffer%nbuffer)+1 - diis_buffer%ncall = diis_buffer%ncall+1 + ib = MODULO(diis_buffer%ncall, diis_buffer%nbuffer) + 1 + diis_buffer%ncall = diis_buffer%ncall + 1 nb = MIN(diis_buffer%ncall, diis_buffer%nbuffer) DO ispin = 1, nspin @@ -320,7 +320,7 @@ SUBROUTINE qs_diis_b_step(diis_buffer, mo_array, kc, sc, delta, error_max, & occupation_numbers=occb) DO imo = 1, nmo - occ(imo) = SQRT(occa(imo)+occb(imo)) + occ(imo) = SQRT(occa(imo) + occb(imo)) END DO CALL cp_fm_to_fm(c, sc) @@ -410,7 +410,7 @@ SUBROUTINE qs_diis_b_step(diis_buffer, mo_array, kc, sc, delta, error_max, & old_errors => diis_buffer%error(jb, ispin)%matrix new_errors => diis_buffer%error(ib, ispin)%matrix CALL cp_fm_trace(old_errors, new_errors, tmp) - b(jb, ib) = b(jb, ib)+tmp + b(jb, ib) = b(jb, ib) + tmp END DO b(ib, jb) = b(jb, ib) END DO @@ -425,7 +425,7 @@ SUBROUTINE qs_diis_b_step(diis_buffer, mo_array, kc, sc, delta, error_max, & IF (diis_step) THEN - nb1 = nb+1 + nb1 = nb + 1 ALLOCATE (a(nb1, nb1)) ALLOCATE (b(nb1, nb1)) @@ -605,8 +605,8 @@ SUBROUTINE qs_diis_b_step_4lscf(diis_buffer, qs_env, ls_scf_env, unit_nr, iscf, nspin) error_max = 0.0_dp - ib = MODULO(diis_buffer%ncall, diis_buffer%nbuffer)+1 - diis_buffer%ncall = diis_buffer%ncall+1 + ib = MODULO(diis_buffer%ncall, diis_buffer%nbuffer) + 1 + diis_buffer%ncall = diis_buffer%ncall + 1 nb = MIN(diis_buffer%ncall, diis_buffer%nbuffer) ! Create scratch arrays CALL dbcsr_create(matrix_tmp, & @@ -696,7 +696,7 @@ SUBROUTINE qs_diis_b_step_4lscf(diis_buffer, qs_env, ls_scf_env, unit_nr, iscf, CALL dbcsr_dot(old_errors, & new_errors, & tmp) ! out : < f_i | f_j > - b(jb, ib) = b(jb, ib)+tmp + b(jb, ib) = b(jb, ib) + tmp END DO ! end-loop-ispin b(ib, jb) = b(jb, ib) END DO ! end-loop-jb @@ -706,7 +706,7 @@ SUBROUTINE qs_diis_b_step_4lscf(diis_buffer, qs_env, ls_scf_env, unit_nr, iscf, ! Perform DIIS step IF (diis_step) THEN - nb1 = nb+1 + nb1 = nb + 1 ALLOCATE (a(nb1, nb1)) ALLOCATE (b(nb1, nb1)) ALLOCATE (ev(nb1)) @@ -828,7 +828,7 @@ SUBROUTINE qs_diis_b_check_i_alloc_sparse(diis_buffer, ls_scf_env, & END IF IF (.NOT. ASSOCIATED(diis_buffer%b_matrix)) THEN - ALLOCATE (diis_buffer%b_matrix(nbuffer+1, nbuffer+1)) + ALLOCATE (diis_buffer%b_matrix(nbuffer + 1, nbuffer + 1)) diis_buffer%b_matrix = 0.0_dp END IF @@ -896,7 +896,7 @@ SUBROUTINE qs_diis_b_create_sparse(diis_buffer, nbuffer) NULLIFY (diis_buffer%parameter) diis_buffer%nbuffer = nbuffer diis_buffer%ncall = 0 - last_diis_b_id = last_diis_b_id+1 + last_diis_b_id = last_diis_b_id + 1 diis_buffer%id_nr = last_diis_b_id diis_buffer%ref_count = 1 diff --git a/src/qs_diis_types.F b/src/qs_diis_types.F index acab8eb35c..e1d9a34385 100644 --- a/src/qs_diis_types.F +++ b/src/qs_diis_types.F @@ -87,7 +87,7 @@ SUBROUTINE qs_diis_b_retain(diis_buffer) CPASSERT(ASSOCIATED(diis_buffer)) CPASSERT(diis_buffer%ref_count > 0) - diis_buffer%ref_count = diis_buffer%ref_count+1 + diis_buffer%ref_count = diis_buffer%ref_count + 1 END SUBROUTINE qs_diis_b_retain ! ************************************************************************************************** @@ -107,7 +107,7 @@ SUBROUTINE qs_diis_b_release(diis_buffer) IF (ASSOCIATED(diis_buffer)) THEN CPASSERT(diis_buffer%ref_count > 0) - diis_buffer%ref_count = diis_buffer%ref_count-1 + diis_buffer%ref_count = diis_buffer%ref_count - 1 IF (diis_buffer%ref_count < 1) THEN IF (ASSOCIATED(diis_buffer%b_matrix)) THEN DEALLOCATE (diis_buffer%b_matrix) diff --git a/src/qs_dispersion_nonloc.F b/src/qs_dispersion_nonloc.F index e9943b2df5..bc70bfbcda 100644 --- a/src/qs_dispersion_nonloc.F +++ b/src/qs_dispersion_nonloc.F @@ -241,15 +241,15 @@ SUBROUTINE calculate_dispersion_nonloc(vxc_rho, rho_r, rho_g, edispersion, & DO i = 1, 3 lo(i) = LBOUND(tmp_r%cr3d, i) hi(i) = UBOUND(tmp_r%cr3d, i) - n(i) = hi(i)-lo(i)+1 + n(i) = hi(i) - lo(i) + 1 END DO !$OMP PARALLEL DO DEFAULT(NONE) & !$OMP SHARED(n,rho) & !$OMP COLLAPSE(3) - DO r = 0, n(3)-1 - DO q = 0, n(2)-1 - DO p = 0, n(1)-1 - rho(r*n(2)*n(1)+q*n(1)+p+1) = 0.0_dp + DO r = 0, n(3) - 1 + DO q = 0, n(2) - 1 + DO p = 0, n(1) - 1 + rho(r*n(2)*n(1) + q*n(1) + p + 1) = 0.0_dp END DO END DO END DO @@ -258,10 +258,10 @@ SUBROUTINE calculate_dispersion_nonloc(vxc_rho, rho_r, rho_g, edispersion, & !$OMP PARALLEL DO DEFAULT(NONE) & !$OMP SHARED(n,i,drho) & !$OMP COLLAPSE(3) - DO r = 0, n(3)-1 - DO q = 0, n(2)-1 - DO p = 0, n(1)-1 - drho(r*n(2)*n(1)+q*n(1)+p+1, i) = 0.0_dp + DO r = 0, n(3) - 1 + DO q = 0, n(2) - 1 + DO p = 0, n(1) - 1 + drho(r*n(2)*n(1) + q*n(1) + p + 1, i) = 0.0_dp END DO END DO END DO @@ -275,11 +275,11 @@ SUBROUTINE calculate_dispersion_nonloc(vxc_rho, rho_r, rho_g, edispersion, & !$OMP SHARED(n,lo,rho,tmp_r) & !$OMP PRIVATE(s) & !$OMP COLLAPSE(3) - DO r = 0, n(3)-1 - DO q = 0, n(2)-1 - DO p = 0, n(1)-1 - s = r*n(2)*n(1)+q*n(1)+p+1 - rho(s) = rho(s)+tmp_r%cr3d(p+lo(1), q+lo(2), r+lo(3)) + DO r = 0, n(3) - 1 + DO q = 0, n(2) - 1 + DO p = 0, n(1) - 1 + s = r*n(2)*n(1) + q*n(1) + p + 1 + rho(s) = rho(s) + tmp_r%cr3d(p + lo(1), q + lo(2), r + lo(3)) END DO END DO END DO @@ -289,11 +289,11 @@ SUBROUTINE calculate_dispersion_nonloc(vxc_rho, rho_r, rho_g, edispersion, & !$OMP SHARED(ispin,i,n,lo,drho,drho_r) & !$OMP PRIVATE(s) & !$OMP COLLAPSE(3) - DO r = 0, n(3)-1 - DO q = 0, n(2)-1 - DO p = 0, n(1)-1 - s = r*n(2)*n(1)+q*n(1)+p+1 - drho(s, i) = drho(s, i)+drho_r(i, ispin)%pw%cr3d(p+lo(1), q+lo(2), r+lo(3)) + DO r = 0, n(3) - 1 + DO q = 0, n(2) - 1 + DO p = 0, n(1) - 1 + s = r*n(2)*n(1) + q*n(1) + p + 1 + drho(s, i) = drho(s, i) + drho_r(i, ispin)%pw%cr3d(p + lo(1), q + lo(2), r + lo(3)) END DO END DO END DO @@ -383,17 +383,17 @@ SUBROUTINE calculate_dispersion_nonloc(vxc_rho, rho_r, rho_g, edispersion, & DO i = 1, 3 lo(i) = LBOUND(tmp_r%cr3d, i) hi(i) = UBOUND(tmp_r%cr3d, i) - n(i) = hi(i)-lo(i)+1 + n(i) = hi(i) - lo(i) + 1 END DO ALLOCATE (thetas_g(dispersion_env%nqs)) DO i = 1, dispersion_env%nqs !$OMP PARALLEL DO DEFAULT(NONE) & !$OMP SHARED(i,n,lo,thetas,tmp_r) & !$OMP COLLAPSE(3) - DO r = 0, n(3)-1 - DO q = 0, n(2)-1 - DO p = 0, n(1)-1 - tmp_r%cr3d(p+lo(1), q+lo(2), r+lo(3)) = thetas(r*n(2)*n(1)+q*n(1)+p+1, i) + DO r = 0, n(3) - 1 + DO q = 0, n(2) - 1 + DO p = 0, n(1) - 1 + tmp_r%cr3d(p + lo(1), q + lo(2), r + lo(3)) = thetas(r*n(2)*n(1) + q*n(1) + p + 1, i) END DO END DO END DO @@ -415,18 +415,18 @@ SUBROUTINE calculate_dispersion_nonloc(vxc_rho, rho_r, rho_g, edispersion, & CALL vdW_energy(thetas_g, dispersion_env, Ec_nl, energy_only, virial) SELECT CASE (nl_type) CASE (vdw_nl_RVV10) - Ec_nl = 0.5_dp*Ec_nl+beta*SUM(rho(:))*grid%vol/sumnp + Ec_nl = 0.5_dp*Ec_nl + beta*SUM(rho(:))*grid%vol/sumnp END SELECT ! calculates energy contribution to stress ! potential contribution to stress is calculated together with other potentials (Hxc) DO idir = 1, 3 - virial%pv_xc(idir, idir) = virial%pv_xc(idir, idir)+Ec_nl + virial%pv_xc(idir, idir) = virial%pv_xc(idir, idir) + Ec_nl END DO ELSE CALL vdW_energy(thetas_g, dispersion_env, Ec_nl, energy_only) SELECT CASE (nl_type) CASE (vdw_nl_RVV10) - Ec_nl = 0.5_dp*Ec_nl+beta*SUM(rho(:))*grid%vol/sumnp + Ec_nl = 0.5_dp*Ec_nl + beta*SUM(rho(:))*grid%vol/sumnp END SELECT END IF CALL mp_sum(Ec_nl, para_env%group) @@ -441,17 +441,17 @@ SUBROUTINE calculate_dispersion_nonloc(vxc_rho, rho_r, rho_g, edispersion, & DO i = 1, 3 lo(i) = LBOUND(tmp_r%cr3d, i) hi(i) = UBOUND(tmp_r%cr3d, i) - n(i) = hi(i)-lo(i)+1 + n(i) = hi(i) - lo(i) + 1 END DO DO i = 1, dispersion_env%nqs CALL pw_transfer(thetas_g(i)%pw, tmp_r) !$OMP PARALLEL DO DEFAULT(NONE) & !$OMP SHARED(i,n,lo,thetas,tmp_r) & !$OMP COLLAPSE(3) - DO r = 0, n(3)-1 - DO q = 0, n(2)-1 - DO p = 0, n(1)-1 - thetas(r*n(2)*n(1)+q*n(1)+p+1, i) = tmp_r%cr3d(p+lo(1), q+lo(2), r+lo(3)) + DO r = 0, n(3) - 1 + DO q = 0, n(2) - 1 + DO p = 0, n(1) - 1 + thetas(r*n(2)*n(1) + q*n(1) + p + 1, i) = tmp_r%cr3d(p + lo(1), q + lo(2), r + lo(3)) END DO END DO END DO @@ -476,22 +476,22 @@ SUBROUTINE calculate_dispersion_nonloc(vxc_rho, rho_r, rho_g, edispersion, & END IF SELECT CASE (nl_type) CASE (vdw_nl_RVV10) - potential(:) = 0.5_dp*potential(:)+beta + potential(:) = 0.5_dp*potential(:) + beta hpot(:) = 0.5_dp*hpot(:) END SELECT CALL pw_pool_create_pw(pw_pool, vxc_r, use_data=REALDATA3D, in_space=REALSPACE) DO i = 1, 3 lo(i) = LBOUND(vxc_r%cr3d, i) hi(i) = UBOUND(vxc_r%cr3d, i) - n(i) = hi(i)-lo(i)+1 + n(i) = hi(i) - lo(i) + 1 END DO !$OMP PARALLEL DO DEFAULT(NONE) & !$OMP SHARED(i,n,lo,potential,vxc_r) & !$OMP COLLAPSE(3) - DO r = 0, n(3)-1 - DO q = 0, n(2)-1 - DO p = 0, n(1)-1 - vxc_r%cr3d(p+lo(1), q+lo(2), r+lo(3)) = potential(r*n(2)*n(1)+q*n(1)+p+1) + DO r = 0, n(3) - 1 + DO q = 0, n(2) - 1 + DO p = 0, n(1) - 1 + vxc_r%cr3d(p + lo(1), q + lo(2), r + lo(3)) = potential(r*n(2)*n(1) + q*n(1) + p + 1) END DO END DO END DO @@ -499,16 +499,16 @@ SUBROUTINE calculate_dispersion_nonloc(vxc_rho, rho_r, rho_g, edispersion, & DO i = 1, 3 lo(i) = LBOUND(tmp_r%cr3d, i) hi(i) = UBOUND(tmp_r%cr3d, i) - n(i) = hi(i)-lo(i)+1 + n(i) = hi(i) - lo(i) + 1 END DO DO idir = 1, 3 !$OMP PARALLEL DO DEFAULT(NONE) & !$OMP SHARED(n,lo,tmp_r) & !$OMP COLLAPSE(3) - DO r = 0, n(3)-1 - DO q = 0, n(2)-1 - DO p = 0, n(1)-1 - tmp_r%cr3d(p+lo(1), q+lo(2), r+lo(3)) = 0.0_dp + DO r = 0, n(3) - 1 + DO q = 0, n(2) - 1 + DO p = 0, n(1) - 1 + tmp_r%cr3d(p + lo(1), q + lo(2), r + lo(3)) = 0.0_dp END DO END DO END DO @@ -517,12 +517,12 @@ SUBROUTINE calculate_dispersion_nonloc(vxc_rho, rho_r, rho_g, edispersion, & !$OMP PARALLEL DO DEFAULT(NONE) & !$OMP SHARED(n,lo,tmp_r,hpot,drho_r,idir,ispin) & !$OMP COLLAPSE(3) - DO r = 0, n(3)-1 - DO q = 0, n(2)-1 - DO p = 0, n(1)-1 - tmp_r%cr3d(p+lo(1), q+lo(2), r+lo(3)) = tmp_r%cr3d(p+lo(1), q+lo(2), r+lo(3)) & - +hpot(r*n(2)*n(1)+q*n(1)+p+1) & - *drho_r(idir, ispin)%pw%cr3d(p+lo(1), q+lo(2), r+lo(3)) + DO r = 0, n(3) - 1 + DO q = 0, n(2) - 1 + DO p = 0, n(1) - 1 + tmp_r%cr3d(p + lo(1), q + lo(2), r + lo(3)) = tmp_r%cr3d(p + lo(1), q + lo(2), r + lo(3)) & + + hpot(r*n(2)*n(1) + q*n(1) + p + 1) & + *drho_r(idir, ispin)%pw%cr3d(p + lo(1), q + lo(2), r + lo(3)) END DO END DO END DO @@ -645,7 +645,7 @@ SUBROUTINE vdW_energy(thetas_g, dispersion_env, vdW_xc_energy, energy_only, viri !$OMP DO DO ig = 1, grid%ngpts_cut_local g2 = grid%gsq(ig) - IF (ABS(g2-g2_last) > 1.e-10) THEN + IF (ABS(g2 - g2_last) > 1.e-10) THEN g2_last = g2 g = SQRT(g2) CALL interpolate_kernel(g, kernel_of_k, dispersion_env) @@ -657,12 +657,12 @@ SUBROUTINE vdW_energy(thetas_g, dispersion_env, vdW_xc_energy, energy_only, viri DO q2_i = 1, nqs uu = CMPLX(0.0_dp, 0.0_dp, KIND=dp) DO q1_i = 1, nqs - uu = uu+kernel_of_k(q2_i, q1_i)*theta(q1_i) + uu = uu + kernel_of_k(q2_i, q1_i)*theta(q1_i) END DO IF (ig < grid%first_gne0) THEN - vdW_xc_energy = vdW_xc_energy+REAL(uu*CONJG(theta(q2_i)), KIND=dp) + vdW_xc_energy = vdW_xc_energy + REAL(uu*CONJG(theta(q2_i)), KIND=dp) ELSE - vdW_xc_energy = vdW_xc_energy+g_multiplier*REAL(uu*CONJG(theta(q2_i)), KIND=dp) + vdW_xc_energy = vdW_xc_energy + g_multiplier*REAL(uu*CONJG(theta(q2_i)), KIND=dp) END IF IF (.NOT. energy_only) u_vdW(ig, q2_i) = uu @@ -674,7 +674,7 @@ SUBROUTINE vdW_energy(thetas_g, dispersion_env, vdW_xc_energy, energy_only, viri END IF DO l = 1, 3 DO m = 1, l - virial_thread(l, m) = virial_thread(l, m)-gm*(grid%g(l, ig)*grid%g(m, ig))/g + virial_thread(l, m) = virial_thread(l, m) - gm*(grid%g(l, ig)*grid%g(m, ig))/g END DO END DO END DO @@ -707,12 +707,12 @@ SUBROUTINE vdW_energy(thetas_g, dispersion_env, vdW_xc_energy, energy_only, viri IF (use_virial) THEN DO l = 1, 3 - DO m = 1, (l-1) - virial%pv_xc(l, m) = virial%pv_xc(l, m)+virial_thread(l, m) + DO m = 1, (l - 1) + virial%pv_xc(l, m) = virial%pv_xc(l, m) + virial_thread(l, m) virial%pv_xc(m, l) = virial%pv_xc(l, m) END DO m = l - virial%pv_xc(l, m) = virial%pv_xc(l, m)+virial_thread(l, m) + virial%pv_xc(l, m) = virial%pv_xc(l, m) + virial_thread(l, m) END DO END IF @@ -809,8 +809,8 @@ SUBROUTINE get_potential(q0, dq0_drho, dq0_dgradrho, total_rho, u_vdW, potential q_low = 1 q_hi = nqs ! Figure out which bin our value of q0 is in in the q_mesh - DO WHILE ((q_hi-q_low) > 1) - q = INT((q_hi+q_low)/2) + DO WHILE ((q_hi - q_low) > 1) + q = INT((q_hi + q_low)/2) IF (q_mesh(q) > q0(i_grid)) THEN q_hi = q ELSE @@ -819,27 +819,27 @@ SUBROUTINE get_potential(q0, dq0_drho, dq0_dgradrho, total_rho, u_vdW, potential END DO IF (q_hi == q_low) CPABORT("get_potential: qhi == qlow") - dq = q_mesh(q_hi)-q_mesh(q_low) + dq = q_mesh(q_hi) - q_mesh(q_low) dq_6 = dq/6.0_dp - a = (q_mesh(q_hi)-q0(i_grid))/dq - b = (q0(i_grid)-q_mesh(q_low))/dq - c = (a**3-a)*dq*dq_6 - d = (b**3-b)*dq*dq_6 - e = (3.0_dp*a**2-1.0_dp)*dq_6 - f = (3.0_dp*b**2-1.0_dp)*dq_6 + a = (q_mesh(q_hi) - q0(i_grid))/dq + b = (q0(i_grid) - q_mesh(q_low))/dq + c = (a**3 - a)*dq*dq_6 + d = (b**3 - b)*dq*dq_6 + e = (3.0_dp*a**2 - 1.0_dp)*dq_6 + f = (3.0_dp*b**2 - 1.0_dp)*dq_6 DO P_i = 1, nqs y = 0.0_dp y(P_i) = 1.0_dp - dP_dq0 = (y(q_hi)-y(q_low))/dq-e*d2y_dx2(P_i, q_low)+f*d2y_dx2(P_i, q_hi) - P = a*y(q_low)+b*y(q_hi)+c*d2y_dx2(P_i, q_low)+d*d2y_dx2(P_i, q_hi) + dP_dq0 = (y(q_hi) - y(q_low))/dq - e*d2y_dx2(P_i, q_low) + f*d2y_dx2(P_i, q_hi) + P = a*y(q_low) + b*y(q_hi) + c*d2y_dx2(P_i, q_low) + d*d2y_dx2(P_i, q_hi) !! The first term in equation 13 of SOLER SELECT CASE (nl_type) CASE DEFAULT CPABORT("Unknown vdW-DF functional") CASE (vdw_nl_DRSLL, vdw_nl_LMKLL) - potential(i_grid) = potential(i_grid)+u_vdW(i_grid, P_i)*(P+dP_dq0*dq0_drho(i_grid)) + potential(i_grid) = potential(i_grid) + u_vdW(i_grid, P_i)*(P + dP_dq0*dq0_drho(i_grid)) prefactor = u_vdW(i_grid, P_i)*dP_dq0*dq0_dgradrho(i_grid) CASE (vdw_nl_RVV10) IF (total_rho(i_grid) > epsr) THEN @@ -847,15 +847,15 @@ SUBROUTINE get_potential(q0, dq0_drho, dq0_dgradrho, total_rho, u_vdW, potential tmp_1_4 = SQRT(tmp_1_2) ! == total_rho(i_grid)**(1.0_dp/4.0_dp) tmp_3_4 = tmp_1_4*tmp_1_4*tmp_1_4 ! == total_rho(i_grid)**(3.0_dp/4.0_dp) potential(i_grid) = potential(i_grid) & - +u_vdW(i_grid, P_i)*(const*0.75_dp/tmp_1_4*P & - +const*tmp_3_4*dP_dq0*dq0_drho(i_grid)) + + u_vdW(i_grid, P_i)*(const*0.75_dp/tmp_1_4*P & + + const*tmp_3_4*dP_dq0*dq0_drho(i_grid)) prefactor = u_vdW(i_grid, P_i)*const*tmp_3_4*dP_dq0*dq0_dgradrho(i_grid) ELSE prefactor = 0.0_dp ENDIF END SELECT IF (q0(i_grid) .NE. q_mesh(nqs)) THEN - h_prefactor(i_grid) = h_prefactor(i_grid)+prefactor + h_prefactor(i_grid) = h_prefactor(i_grid) + prefactor END IF IF (use_virial .AND. ABS(prefactor) > 0.0_dp) THEN @@ -868,7 +868,7 @@ SUBROUTINE get_potential(q0, dq0_drho, dq0_dgradrho, total_rho, u_vdW, potential prefactor = prefactor*dvol DO l = 1, 3 DO m = 1, l - virial_thread(l, m) = virial_thread(l, m)-prefactor*drho(i_grid, l)*drho(i_grid, m) + virial_thread(l, m) = virial_thread(l, m) - prefactor*drho(i_grid, l)*drho(i_grid, m) ENDDO ENDDO END IF @@ -882,12 +882,12 @@ SUBROUTINE get_potential(q0, dq0_drho, dq0_dgradrho, total_rho, u_vdW, potential IF (use_virial) THEN DO l = 1, 3 - DO m = 1, (l-1) - virial%pv_xc(l, m) = virial%pv_xc(l, m)+virial_thread(l, m) + DO m = 1, (l - 1) + virial%pv_xc(l, m) = virial%pv_xc(l, m) + virial_thread(l, m) virial%pv_xc(m, l) = virial%pv_xc(l, m) ENDDO m = l - virial%pv_xc(l, m) = virial%pv_xc(l, m)+virial_thread(l, m) + virial%pv_xc(l, m) = virial%pv_xc(l, m) + virial_thread(l, m) ENDDO END IF @@ -915,7 +915,7 @@ SUBROUTINE calculate_exponent(hi, alpha, exponent) DO i = 2, hi multiplier = multiplier*alpha - exponent = exponent+(multiplier/i) + exponent = exponent + (multiplier/i) END DO END SUBROUTINE calculate_exponent @@ -942,9 +942,9 @@ SUBROUTINE calculate_exponent_derivative(hi, alpha, exponent, derivative) exponent = 0.0d0 DO i = 1, hi - derivative = derivative+multiplier + derivative = derivative + multiplier multiplier = multiplier*alpha - exponent = exponent+(multiplier/i) + exponent = exponent + (multiplier/i) END DO END SUBROUTINE calculate_exponent_derivative @@ -1016,21 +1016,21 @@ SUBROUTINE get_q0_on_grid_vdw(total_rho, gradient_rho, q0, dq0_drho, dq0_dgradrh sqrt_r_s = SQRT(r_s) gradient_correction = -Z_ab/(36.0_dp*kF*total_rho(i_grid)**2) & - *(gradient_rho(i_grid, 1)**2+gradient_rho(i_grid, 2)**2+gradient_rho(i_grid, 3)**2) + *(gradient_rho(i_grid, 1)**2 + gradient_rho(i_grid, 2)**2 + gradient_rho(i_grid, 3)**2) - LDA_1 = 8.0_dp*pi/3.0_dp*(LDA_A*(1.0_dp+LDA_a1*r_s)) - LDA_2 = 2.0_dp*LDA_A*(LDA_b1*sqrt_r_s+LDA_b2*r_s+LDA_b3*r_s*sqrt_r_s+LDA_b4*r_s*r_s) + LDA_1 = 8.0_dp*pi/3.0_dp*(LDA_A*(1.0_dp + LDA_a1*r_s)) + LDA_2 = 2.0_dp*LDA_A*(LDA_b1*sqrt_r_s + LDA_b2*r_s + LDA_b3*r_s*sqrt_r_s + LDA_b4*r_s*r_s) !! --------------------------------------------------------------- !! This is the q value defined in equations 11 and 12 of DION !! --------------------------------------------------------------- - q = kF+LDA_1*LOG(1.0_dp+1.0_dp/LDA_2)+gradient_correction + q = kF + LDA_1*LOG(1.0_dp + 1.0_dp/LDA_2) + gradient_correction !! --------------------------------------------------------------- !! Here, we calculate q0 by saturating q according to equation 5 of SOLER. Also, we find !! the derivative dq0_dq needed for the derivatives dq0_drho and dq0_dgradrh0 discussed below. !! --------------------------------------------------------------------------------------- q__q_cut = q/q_cut CALL calculate_exponent_derivative(m_cut, q__q_cut, exponent, dq0_dq) - q0(i_grid) = q_cut*(1.0_dp-EXP(-exponent)) + q0(i_grid) = q_cut*(1.0_dp - EXP(-exponent)) dq0_dq = dq0_dq*EXP(-exponent) !! --------------------------------------------------------------------------------------- !! This is to handle a case with q0 too small. We simply set it to the smallest q value in @@ -1051,11 +1051,11 @@ SUBROUTINE get_q0_on_grid_vdw(total_rho, gradient_rho, q0, dq0_drho, dq0_dgradrh !! component. !! ------------------------------------------------------------------------------------------------ - dq0_drho(i_grid) = dq0_dq*(kF/3.0_dp-7.0_dp/3.0_dp*gradient_correction & - -8.0_dp*pi/9.0_dp*LDA_A*LDA_a1*r_s*LOG(1.0_dp+1.0_dp/LDA_2) & - +LDA_1/(LDA_2*(1.0_dp+LDA_2)) & - *(2.0_dp*LDA_A*(LDA_b1/6.0_dp*sqrt_r_s+LDA_b2/3.0_dp*r_s+LDA_b3/2.0_dp*r_s*sqrt_r_s & - +2.0_dp*LDA_b4/3.0_dp*r_s**2))) + dq0_drho(i_grid) = dq0_dq*(kF/3.0_dp - 7.0_dp/3.0_dp*gradient_correction & + - 8.0_dp*pi/9.0_dp*LDA_A*LDA_a1*r_s*LOG(1.0_dp + 1.0_dp/LDA_2) & + + LDA_1/(LDA_2*(1.0_dp + LDA_2)) & + *(2.0_dp*LDA_A*(LDA_b1/6.0_dp*sqrt_r_s + LDA_b2/3.0_dp*r_s + LDA_b3/2.0_dp*r_s*sqrt_r_s & + + 2.0_dp*LDA_b4/3.0_dp*r_s**2))) dq0_dgradrho(i_grid) = total_rho(i_grid)*dq0_dq*2.0_dp*(-Z_ab)/(36.0_dp*kF*total_rho(i_grid)**2) @@ -1103,7 +1103,7 @@ SUBROUTINE get_q0_on_grid_rvv10(total_rho, gradient_rho, q0, dq0_drho, dq0_dgrad DO i_grid = 1, SIZE(total_rho) - gmod2 = gradient_rho(i_grid, 1)**2+gradient_rho(i_grid, 2)**2+gradient_rho(i_grid, 3)**2 + gmod2 = gradient_rho(i_grid, 1)**2 + gradient_rho(i_grid, 2)**2 + gradient_rho(i_grid, 3)**2 !if (total_rho(i_grid) > epsr .and. gmod2 > epsr) cycle IF (total_rho(i_grid) > epsr) THEN @@ -1116,7 +1116,7 @@ SUBROUTINE get_q0_on_grid_rvv10(total_rho, gradient_rho, q0, dq0_drho, dq0_dgrad wg2 = 4_dp*C_value*(mod_grad/total_rho(i_grid))**4 k = b_value*3.0_dp*pi*((total_rho(i_grid)/(9.0_dp*pi))**(1.0_dp/6.0_dp)) - w0 = SQRT(wg2+wp2/3.0_dp) + w0 = SQRT(wg2 + wp2/3.0_dp) q = w0/k @@ -1124,7 +1124,7 @@ SUBROUTINE get_q0_on_grid_rvv10(total_rho, gradient_rho, q0, dq0_drho, dq0_dgrad !! --------------------------------------------------------------------------------------- q__q_cut = q/q_cut CALL calculate_exponent_derivative(m_cut, q__q_cut, exponent, dq0_dq) - q0(i_grid) = q_cut*(1.0_dp-EXP(-exponent)) + q0(i_grid) = q_cut*(1.0_dp - EXP(-exponent)) dq0_dq = dq0_dq*EXP(-exponent) !! --------------------------------------------------------------------------------------- @@ -1133,10 +1133,10 @@ SUBROUTINE get_q0_on_grid_rvv10(total_rho, gradient_rho, q0, dq0_drho, dq0_dgrad END IF !!---------------------------------Final values--------------------------------- - dw0_dn = 1.0_dp/(2.0_dp*w0)*(16.0_dp/3.0_dp*pi-4.0_dp*wg2/total_rho(i_grid)) + dw0_dn = 1.0_dp/(2.0_dp*w0)*(16.0_dp/3.0_dp*pi - 4.0_dp*wg2/total_rho(i_grid)) dk_dn = k/(6.0_dp*total_rho(i_grid)) - dq0_drho(i_grid) = dq0_dq*1.0_dp/(k**2.0)*(dw0_dn*k-dk_dn*w0) + dq0_drho(i_grid) = dq0_dq*1.0_dp/(k**2.0)*(dw0_dn*k - dk_dn*w0) dq0_dgradrho(i_grid) = dq0_dq*1.0_dp/(2.0_dp*k*w0)*4.0_dp*wg2/gmod2 ENDIF @@ -1197,14 +1197,14 @@ SUBROUTINE get_q0_on_grid_eo_vdw(total_rho, gradient_rho, q0, dispersion_env) sqrt_r_s = SQRT(r_s) gradient_correction = -Z_ab/(36.0_dp*kF*total_rho(i_grid)**2) & - *(gradient_rho(i_grid, 1)**2+gradient_rho(i_grid, 2)**2+gradient_rho(i_grid, 3)**2) + *(gradient_rho(i_grid, 1)**2 + gradient_rho(i_grid, 2)**2 + gradient_rho(i_grid, 3)**2) - LDA_1 = 8.0_dp*pi/3.0_dp*(LDA_A*(1.0_dp+LDA_a1*r_s)) - LDA_2 = 2.0_dp*LDA_A*(LDA_b1*sqrt_r_s+LDA_b2*r_s+LDA_b3*r_s*sqrt_r_s+LDA_b4*r_s*r_s) + LDA_1 = 8.0_dp*pi/3.0_dp*(LDA_A*(1.0_dp + LDA_a1*r_s)) + LDA_2 = 2.0_dp*LDA_A*(LDA_b1*sqrt_r_s + LDA_b2*r_s + LDA_b3*r_s*sqrt_r_s + LDA_b4*r_s*r_s) !! ------------------------------------------------------------------------------------ !! This is the q value defined in equations 11 and 12 of DION !! --------------------------------------------------------------- - q = kF+LDA_1*LOG(1.0_dp+1.0_dp/LDA_2)+gradient_correction + q = kF + LDA_1*LOG(1.0_dp + 1.0_dp/LDA_2) + gradient_correction !! --------------------------------------------------------------- !! Here, we calculate q0 by saturating q according to equation 5 of SOLER. Also, we find @@ -1212,7 +1212,7 @@ SUBROUTINE get_q0_on_grid_eo_vdw(total_rho, gradient_rho, q0, dispersion_env) !! --------------------------------------------------------------------------------------- q__q_cut = q/q_cut CALL calculate_exponent(m_cut, q__q_cut, exponent) - q0(i_grid) = q_cut*(1.0_dp-EXP(-exponent)) + q0(i_grid) = q_cut*(1.0_dp - EXP(-exponent)) !! --------------------------------------------------------------------------------------- !! This is to handle a case with q0 too small. We simply set it to the smallest q value in @@ -1254,7 +1254,7 @@ SUBROUTINE get_q0_on_grid_eo_rvv10(total_rho, gradient_rho, q0, dispersion_env) DO i_grid = 1, SIZE(total_rho) - gmod2 = gradient_rho(i_grid, 1)**2+gradient_rho(i_grid, 2)**2+gradient_rho(i_grid, 3)**2 + gmod2 = gradient_rho(i_grid, 1)**2 + gradient_rho(i_grid, 2)**2 + gradient_rho(i_grid, 3)**2 !if (total_rho(i_grid) > epsr .and. gmod2 > epsr) cycle IF (total_rho(i_grid) > epsr) THEN @@ -1265,7 +1265,7 @@ SUBROUTINE get_q0_on_grid_eo_rvv10(total_rho, gradient_rho, q0, dispersion_env) wg2 = 4_dp*C_value*(gmod2*gmod2)/(total_rho(i_grid)**4) k = b_value*3.0_dp*pi*((total_rho(i_grid)/(9.0_dp*pi))**(1.0_dp/6.0_dp)) - w0 = SQRT(wg2+wp2/3.0_dp) + w0 = SQRT(wg2 + wp2/3.0_dp) q = w0/k @@ -1273,7 +1273,7 @@ SUBROUTINE get_q0_on_grid_eo_rvv10(total_rho, gradient_rho, q0, dispersion_env) !! --------------------------------------------------------------------------------------- q__q_cut = q/q_cut CALL calculate_exponent(m_cut, q__q_cut, exponent) - q0(i_grid) = q_cut*(1.0_dp-EXP(-exponent)) + q0(i_grid) = q_cut*(1.0_dp - EXP(-exponent)) IF (q0(i_grid) < q_min) THEN q0(i_grid) = q_min @@ -1323,8 +1323,8 @@ SUBROUTINE spline_interpolation(x, d2y_dx2, evaluation_points, values) DO i_grid = 1, Ngrid_points lower_bound = 1 upper_bound = Nx - DO WHILE ((upper_bound-lower_bound) > 1) - index = (upper_bound+lower_bound)/2 + DO WHILE ((upper_bound - lower_bound) > 1) + index = (upper_bound + lower_bound)/2 IF (evaluation_points(i_grid) > x(index)) THEN lower_bound = index ELSE @@ -1332,19 +1332,19 @@ SUBROUTINE spline_interpolation(x, d2y_dx2, evaluation_points, values) END IF END DO - dx = x(upper_bound)-x(lower_bound) + dx = x(upper_bound) - x(lower_bound) const = dx*dx/6.0_dp - a = (x(upper_bound)-evaluation_points(i_grid))/dx - b = (evaluation_points(i_grid)-x(lower_bound))/dx - c = (a**3-a)*const - d = (b**3-b)*const + a = (x(upper_bound) - evaluation_points(i_grid))/dx + b = (evaluation_points(i_grid) - x(lower_bound))/dx + c = (a**3 - a)*const + d = (b**3 - b)*const DO P_i = 1, Nx y = 0 y(P_i) = 1 - values(i_grid, P_i) = a*y(lower_bound)+b*y(upper_bound) & - +(c*d2y_dx2(P_i, lower_bound)+d*d2y_dx2(P_i, upper_bound)) + values(i_grid, P_i) = a*y(lower_bound) + b*y(upper_bound) & + + (c*d2y_dx2(P_i, lower_bound) + d*d2y_dx2(P_i, upper_bound)) END DO END DO !$OMP END DO @@ -1392,18 +1392,18 @@ SUBROUTINE initialize_spline_interpolation(x, d2y_dx2) d2y_dx2(P_i, 1) = 0.0_dp temp_array(1) = 0.0_dp - DO index = 2, Nx-1 - temp1 = (x(index)-x(index-1))/(x(index+1)-x(index-1)) - temp2 = temp1*d2y_dx2(P_i, index-1)+2.0_dp - d2y_dx2(P_i, index) = (temp1-1.0_dp)/temp2 - temp_array(index) = (y(index+1)-y(index))/(x(index+1)-x(index)) & - -(y(index)-y(index-1))/(x(index)-x(index-1)) - temp_array(index) = (6.0_dp*temp_array(index)/(x(index+1)-x(index-1)) & - -temp1*temp_array(index-1))/temp2 + DO index = 2, Nx - 1 + temp1 = (x(index) - x(index - 1))/(x(index + 1) - x(index - 1)) + temp2 = temp1*d2y_dx2(P_i, index - 1) + 2.0_dp + d2y_dx2(P_i, index) = (temp1 - 1.0_dp)/temp2 + temp_array(index) = (y(index + 1) - y(index))/(x(index + 1) - x(index)) & + - (y(index) - y(index - 1))/(x(index) - x(index - 1)) + temp_array(index) = (6.0_dp*temp_array(index)/(x(index + 1) - x(index - 1)) & + - temp1*temp_array(index - 1))/temp2 END DO d2y_dx2(P_i, Nx) = 0.0_dp - DO index = Nx-1, 1, -1 - d2y_dx2(P_i, index) = d2y_dx2(P_i, index)*d2y_dx2(P_i, index+1)+temp_array(index) + DO index = Nx - 1, 1, -1 + d2y_dx2(P_i, index) = d2y_dx2(P_i, index)*d2y_dx2(P_i, index + 1) + temp_array(index) END DO END DO !$OMP END DO @@ -1472,14 +1472,14 @@ SUBROUTINE interpolate_kernel(k, kernel_of_k, dispersion_env) !! If we are not on a function point then we carry out the interpolation !! ---------------------------------------------------------------------------------------- const = dk*dk/6.0_dp - A = (dk*(k_i+1.0_dp)-k)/dk - B = (k-dk*k_i)/dk - C = (A**3-A)*const - D = (B**3-B)*const + A = (dk*(k_i + 1.0_dp) - k)/dk + B = (k - dk*k_i)/dk + C = (A**3 - A)*const + D = (B**3 - B)*const DO q1_i = 1, dispersion_env%Nqs DO q2_i = 1, q1_i - kernel_of_k(q1_i, q2_i) = A*kernel(k_i, q1_i, q2_i)+B*kernel(k_i+1, q1_i, q2_i) & - +(C*d2phi_dk2(k_i, q1_i, q2_i)+D*d2phi_dk2(k_i+1, q1_i, q2_i)) + kernel_of_k(q1_i, q2_i) = A*kernel(k_i, q1_i, q2_i) + B*kernel(k_i + 1, q1_i, q2_i) & + + (C*d2phi_dk2(k_i, q1_i, q2_i) + D*d2phi_dk2(k_i + 1, q1_i, q2_i)) kernel_of_k(q2_i, q1_i) = kernel_of_k(q1_i, q2_i) END DO END DO @@ -1517,16 +1517,16 @@ SUBROUTINE interpolate_dkernel_dk(k, dkernel_of_dk, dispersion_env) dkernel_of_dk = 0.0_dp k_i = INT(k/dk) - A = (dk*(k_i+1.0_dp)-k)/dk - B = (k-dk*k_i)/dk + A = (dk*(k_i + 1.0_dp) - k)/dk + B = (k - dk*k_i)/dk dAdk = -1.0_dp/dk dBdk = 1.0_dp/dk - dCdk = -(3*A**2-1.0_dp)*dk_6 - dDdk = (3*B**2-1.0_dp)*dk_6 + dCdk = -(3*A**2 - 1.0_dp)*dk_6 + dDdk = (3*B**2 - 1.0_dp)*dk_6 DO q1_i = 1, dispersion_env%Nqs DO q2_i = 1, q1_i - dkernel_of_dk(q1_i, q2_i) = dAdk*kernel(k_i, q1_i, q2_i)+dBdk*kernel(k_i+1, q1_i, q2_i) & - +dCdk*d2phi_dk2(k_i, q1_i, q2_i)+dDdk*d2phi_dk2(k_i+1, q1_i, q2_i) + dkernel_of_dk(q1_i, q2_i) = dAdk*kernel(k_i, q1_i, q2_i) + dBdk*kernel(k_i + 1, q1_i, q2_i) & + + dCdk*d2phi_dk2(k_i, q1_i, q2_i) + dDdk*d2phi_dk2(k_i + 1, q1_i, q2_i) dkernel_of_dk(q2_i, q1_i) = dkernel_of_dk(q1_i, q2_i) END DO END DO diff --git a/src/qs_dispersion_pairpot.F b/src/qs_dispersion_pairpot.F index c4009a6ed0..4475e7c9e4 100644 --- a/src/qs_dispersion_pairpot.F +++ b/src/qs_dispersion_pairpot.F @@ -73,10 +73,10 @@ MODULE qs_dispersion_pairpot USE virial_types, ONLY: virial_type !$ USE OMP_LIB, ONLY: omp_get_max_threads, & -!$ omp_get_thread_num, & -!$ omp_lock_kind, & -!$ omp_init_lock, omp_set_lock, & -!$ omp_unset_lock, omp_destroy_lock +!$ omp_get_thread_num, & +!$ omp_lock_kind, & +!$ omp_init_lock, omp_set_lock, & +!$ omp_unset_lock, omp_destroy_lock #include "./base/base_uses.f90" @@ -308,11 +308,11 @@ SUBROUTINE qs_dispersion_pairpot_init(atomic_kind_set, qs_kind_set, dispersion_e CALL section_vals_val_get(pp_section, "ATOM_COORDINATION_NUMBERS", i_rep_val=i, & c_vals=tmpstringlist) nl = SIZE(tmpstringlist) - ALLOCATE (dispersion_env%cnlist(i)%atom(nl-1)) - dispersion_env%cnlist(i)%natom = nl-1 + ALLOCATE (dispersion_env%cnlist(i)%atom(nl - 1)) + dispersion_env%cnlist(i)%natom = nl - 1 READ (tmpstringlist(1), *) dispersion_env%cnlist(i)%cnum - DO j = 1, nl-1 - READ (tmpstringlist(j+1), *) dispersion_env%cnlist(i)%atom(j) + DO j = 1, nl - 1 + READ (tmpstringlist(j + 1), *) dispersion_env%cnlist(i)%atom(j) END DO END DO END IF @@ -353,7 +353,7 @@ SUBROUTINE qs_scaling_init(scaling, vdw_section) CALL section_vals_val_get(vdw_section, "PAIR_POTENTIAL%REFERENCE_FUNCTIONAL", c_val=functional) - SELECT CASE (TRIM (functional)) + SELECT CASE (TRIM(functional)) CASE DEFAULT ! unknown functional CPABORT("No DFT-D2 s6 value available for this functional:"//TRIM(functional)) @@ -399,7 +399,7 @@ SUBROUTINE qs_scaling_dftd3(s6, sr6, s8, vdw_section) ! values for different functionals from: ! https://www.chemie.uni-bonn.de/pctc/mulliken-center/software/dft-d3/dft-d3 - SELECT CASE (TRIM (functional)) + SELECT CASE (TRIM(functional)) CASE DEFAULT ! unknown functional CPABORT("No DFT-D3 values available for this functional:"//TRIM(functional)) @@ -634,7 +634,7 @@ SUBROUTINE qs_scaling_dftd3bj(s6, a1, s8, a2, vdw_section) ! values for different functionals from: ! http://www.thch.uni-bonn.de/tc/downloads/DFT-D3/functionalsbj.html - SELECT CASE (TRIM (functional)) + SELECT CASE (TRIM(functional)) CASE DEFAULT ! unknown functional CPABORT("No DFT-D3(BJ) values available for this functional:"//TRIM(functional)) @@ -1005,7 +1005,7 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat maxc = SIZE(dispersion_env%c6ab, 3) max_elem = SIZE(dispersion_env%c6ab, 1) alp6 = dispersion_env%alp - alp8 = alp6+2._dp + alp8 = alp6 + 2._dp s6 = dispersion_env%s6 s8 = dispersion_env%s8 s9 = dispersion_env%s6 @@ -1108,12 +1108,12 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat sab_max(1) = rcc/plane_distance(1, 0, 0, cell) sab_max(2) = rcc/plane_distance(0, 1, 0, cell) sab_max(3) = rcc/plane_distance(0, 0, 1, cell) - ncell(:) = (INT(sab_max(:))+1)*periodic(:) + ncell(:) = (INT(sab_max(:)) + 1)*periodic(:) IF (unit_nr > 0) THEN WRITE (unit_nr, *) " Calculate C9 Terms" WRITE (unit_nr, "(A,T20,I3,A,I3)") " Search in cells ", -ncell(1), ":", ncell(1) - WRITE (unit_nr, "(T20,I3,A,I3)")-ncell(2), ":", ncell(2) - WRITE (unit_nr, "(T20,I3,A,I3)")-ncell(3), ":", ncell(3) + WRITE (unit_nr, "(T20,I3,A,I3)") - ncell(2), ":", ncell(2) + WRITE (unit_nr, "(T20,I3,A,I3)") - ncell(3), ":", ncell(3) WRITE (unit_nr, *) END IF IF (dispersion_env%c9cnst) THEN @@ -1150,7 +1150,7 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat END IF IF (unit_nr > 0) THEN DO i = 1, natom - IF (ABS(cnumbers(i)-cnumfix(i)) > 0.5_dp) THEN + IF (ABS(cnumbers(i) - cnumfix(i)) > 0.5_dp) THEN WRITE (unit_nr, "(A,T20,A,I6,T41,2F10.3)") " Difference in CN ", "Atom:", & i, cnumbers(i), cnumfix(i) END IF @@ -1183,24 +1183,24 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat ! vdW potential dr = SQRT(SUM(rij(:)**2)) IF (dr <= rcut) THEN - nab = nab+1._dp + nab = nab + 1._dp fac = 1._dp IF (iatom == jatom) fac = 0.5_dp IF (disp_a%type == dftd2_pp .AND. dr > 0.001_dp) THEN c6 = SQRT(c6d2(ikind)*c6d2(jkind)) - rcc = radd2(ikind)+radd2(jkind) - er = EXP(-dd*(dr/rcc-1._dp)) - fdmp = 1._dp/(1._dp+er) + rcc = radd2(ikind) + radd2(jkind) + er = EXP(-dd*(dr/rcc - 1._dp)) + fdmp = 1._dp/(1._dp + er) xp = s6*c6/dr**6 - evdw = evdw-xp*fdmp*fac + evdw = evdw - xp*fdmp*fac IF (calculate_forces) THEN dfdmp = dd/rcc*er*fdmp*fdmp - devdw = -xp*(-6._dp*fdmp/dr+dfdmp) + devdw = -xp*(-6._dp*fdmp/dr + dfdmp) fdij(:) = devdw*rij(:)/dr*fac atom_a = atom_of_kind(iatom) atom_b = atom_of_kind(jatom) - force(ikind)%dispersion(:, atom_a) = force(ikind)%dispersion(:, atom_a)-fdij(:) - force(jkind)%dispersion(:, atom_b) = force(jkind)%dispersion(:, atom_b)+fdij(:) + force(ikind)%dispersion(:, atom_a) = force(ikind)%dispersion(:, atom_a) - fdij(:) + force(jkind)%dispersion(:, atom_b) = force(jkind)%dispersion(:, atom_b) + fdij(:) IF (use_virial) THEN CALL virial_pair_force(pv_virial_thread, -1._dp, fdij, rij) END IF @@ -1210,8 +1210,8 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat END IF END IF IF (atenergy) THEN - atener(iatom) = atener(iatom)-0.5_dp*xp*fdmp*fac - atener(jatom) = atener(jatom)-0.5_dp*xp*fdmp*fac + atener(iatom) = atener(iatom) - 0.5_dp*xp*fdmp*fac + atener(jatom) = atener(jatom) - 0.5_dp*xp*fdmp*fac END IF ELSE IF (disp_a%type == dftd3_pp .AND. dr > 0.001_dp) THEN ! C6 coefficient @@ -1238,9 +1238,9 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat ELSE IF (idmp == 2) THEN ! BJ r0ab = SQRT(3.0d0*dispersion_env%r2r4(za)*dispersion_env%r2r4(zb)) - f0ab = a1*r0ab+a2 - fdab6 = 1.0_dp/(r6+f0ab**6) - fdab8 = 1.0_dp/(r8+f0ab**8) + f0ab = a1*r0ab + a2 + fdab6 = 1.0_dp/(r6 + f0ab**6) + fdab8 = 1.0_dp/(r8 + f0ab**8) e6 = s6*fac*c6*fdab6 e8 = s8i*fac*c8*fdab8 ELSE @@ -1248,24 +1248,24 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat END IF IF (dispersion_env%srb .AND. dr .LT. 30.0d0) THEN srbe = ssrb*(REAL((za*zb), KIND=dp))**t1srb*EXP(-gsrb*dr*dispersion_env%r0ab(za, zb)**t2srb) - esrb = esrb+srbe - evdw = evdw-srbe + esrb = esrb + srbe + evdw = evdw - srbe ELSE srbe = 0.0_dp END IF - evdw = evdw-e6-e8 - e6tot = e6tot-e6 - e8tot = e8tot-e8 + evdw = evdw - e6 - e8 + e6tot = e6tot - e6 + e8tot = e8tot - e8 IF (atenergy) THEN - atener(iatom) = atener(iatom)-0.5_dp*(e6+e8+srbe) - atener(jatom) = atener(jatom)-0.5_dp*(e6+e8+srbe) + atener(iatom) = atener(iatom) - 0.5_dp*(e6 + e8 + srbe) + atener(jatom) = atener(jatom) - 0.5_dp*(e6 + e8 + srbe) END IF IF (calculate_forces) THEN ! damping IF (idmp == 1) THEN ! zero - de6 = -s6*c6/r6*(dfdab6-6._dp*fdab6/dr) - de8 = -s8i*c8/r8*(dfdab8-8._dp*fdab8/dr) + de6 = -s6*c6/r6*(dfdab6 - 6._dp*fdab6/dr) + de8 = -s8i*c8/r8*(dfdab8 - 8._dp*fdab8/dr) ELSE IF (idmp == 2) THEN ! BJ de6 = s6*c6*fdab6*fdab6*6.0_dp*dr**5 @@ -1273,14 +1273,14 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat ELSE CPABORT("Unknown DFT-D3 damping function:") END IF - fdij(:) = (de6+de8)*rij(:)/dr*fac + fdij(:) = (de6 + de8)*rij(:)/dr*fac IF (dispersion_env%srb .AND. dr .LT. 30.0d0) THEN - fdij(:) = fdij(:)+srbe*gsrb*dispersion_env%r0ab(za, zb)**t2srb*rij(:)/dr + fdij(:) = fdij(:) + srbe*gsrb*dispersion_env%r0ab(za, zb)**t2srb*rij(:)/dr END IF atom_a = atom_of_kind(iatom) atom_b = atom_of_kind(jatom) - force(ikind)%dispersion(:, atom_a) = force(ikind)%dispersion(:, atom_a)-fdij(:) - force(jkind)%dispersion(:, atom_b) = force(jkind)%dispersion(:, atom_b)+fdij(:) + force(ikind)%dispersion(:, atom_a) = force(ikind)%dispersion(:, atom_a) - fdij(:) + force(jkind)%dispersion(:, atom_b) = force(jkind)%dispersion(:, atom_b) + fdij(:) IF (use_virial) THEN CALL virial_pair_force(pv_virial_thread, -1._dp, fdij, rij) END IF @@ -1309,10 +1309,10 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat kkind = kind_of(katom) rik = dcnum(iatom)%rik(:, i) drk = SQRT(SUM(rik(:)**2)) - fdik(:) = (dc6a+dc8a)*dcnum(iatom)%dvals(i)*rik(:)/drk + fdik(:) = (dc6a + dc8a)*dcnum(iatom)%dvals(i)*rik(:)/drk atom_c = atom_of_kind(katom) - force(ikind)%dispersion(:, atom_a) = force(ikind)%dispersion(:, atom_a)-fdik(:) - force(kkind)%dispersion(:, atom_c) = force(kkind)%dispersion(:, atom_c)+fdik(:) + force(ikind)%dispersion(:, atom_a) = force(ikind)%dispersion(:, atom_a) - fdik(:) + force(kkind)%dispersion(:, atom_c) = force(kkind)%dispersion(:, atom_c) + fdik(:) IF (use_virial) THEN CALL virial_pair_force(pv_virial_thread, -1._dp, fdik, rik) END IF @@ -1326,10 +1326,10 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat kkind = kind_of(katom) rik = dcnum(jatom)%rik(:, i) drk = SQRT(SUM(rik(:)**2)) - fdik(:) = (dc6b+dc8b)*dcnum(jatom)%dvals(i)*rik(:)/drk + fdik(:) = (dc6b + dc8b)*dcnum(jatom)%dvals(i)*rik(:)/drk atom_c = atom_of_kind(katom) - force(jkind)%dispersion(:, atom_b) = force(jkind)%dispersion(:, atom_b)-fdik(:) - force(kkind)%dispersion(:, atom_c) = force(kkind)%dispersion(:, atom_c)+fdik(:) + force(jkind)%dispersion(:, atom_b) = force(jkind)%dispersion(:, atom_b) - fdik(:) + force(kkind)%dispersion(:, atom_c) = force(kkind)%dispersion(:, atom_c) + fdik(:) IF (use_virial) THEN CALL virial_pair_force(pv_virial_thread, -1._dp, fdik, rik) END IF @@ -1345,8 +1345,8 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat is000 = (ALL(cell_b == 0)) rb0(:) = MATMUL(cell%hmat, cell_b) ra(:) = pbc(particle_set(iatom)%r(:), cell) - rb(:) = pbc(particle_set(jatom)%r(:), cell)+rb0 - r2ab = SUM((ra-rb)**2) + rb(:) = pbc(particle_set(jatom)%r(:), cell) + rb0 + r2ab = SUM((ra - rb)**2) DO icx = -ncell(1), ncell(1) DO icy = -ncell(2), ncell(2) DO icz = -ncell(3), ncell(3) @@ -1356,7 +1356,7 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat hashc = cellhash(cell_c, ncell) IF (is000 .AND. (ALL(cell_c == 0))) THEN ! CASE 1: all atoms in (000), use only ordered triples - kstart = MAX(jatom+1, iatom+1) + kstart = MAX(jatom + 1, iatom + 1) fac0 = 1.0_dp ELSE IF (is000) THEN ! CASE 2: AB in (000), C in other cell @@ -1376,10 +1376,10 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat DO katom = kstart, natom kkind = kind_of(katom) IF (ghost(kkind) .OR. floating(kkind) .OR. .NOT. dodisp(kkind)) CYCLE - rc(:) = rcpbc(:, katom)+rc0(:) - r2bc = SUM((rb-rc)**2) + rc(:) = rcpbc(:, katom) + rc0(:) + r2bc = SUM((rb - rc)**2) IF (r2bc >= rc2) CYCLE - r2ca = SUM((rc-ra)**2) + r2ca = SUM((rc - ra)**2) IF (r2ca >= rc2) CYCLE r2abc = r2ab*r2bc*r2ca IF (r2abc <= 0.001_dp) CYCLE @@ -1393,7 +1393,7 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat IF (iatom == jatom .OR. iatom == katom .OR. jatom == katom) fac = 0.5_dp IF (iatom == jatom .AND. iatom == katom) fac = 1._dp/3._dp fac = fac*fac0 - nabc = nabc+1._dp + nabc = nabc + 1._dp IF (dispersion_env%c9cnst) THEN CALL getc6(maxc, max_elem, dispersion_env%c6ab, dispersion_env%maxci, za, zb, & cnumfix(iatom), cnumfix(jatom), dispersion_env%k3, cc6ab, dcc6aba, dcc6abb) @@ -1417,30 +1417,30 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat ! correct value from alp6=14 to 16 as used in original paper ! CALL damping_d3(rabc, r0, 4._dp/3._dp, alp6, rcut, fdabc, dfdabc) CALL damping_d3(rabc, r0, 4._dp/3._dp, 16.0_dp, rcut, fdabc, dfdabc) - s1 = r2ab+r2bc-r2ca - s2 = r2ab+r2ca-r2bc - s3 = r2ca+r2bc-r2ab - ang = 0.375_dp*s1*s2*s3/r2abc+1.0_dp + s1 = r2ab + r2bc - r2ca + s2 = r2ab + r2ca - r2bc + s3 = r2ca + r2bc - r2ab + ang = 0.375_dp*s1*s2*s3/r2abc + 1.0_dp e9 = s9*fac*fdabc*c9*ang/r2abc**1.50d0 - evdw = evdw-e9 - e9tot = e9tot-e9 + evdw = evdw - e9 + e9tot = e9tot - e9 IF (atenergy) THEN - atener(iatom) = atener(iatom)-e9/3._dp - atener(jatom) = atener(jatom)-e9/3._dp - atener(katom) = atener(katom)-e9/3._dp + atener(iatom) = atener(iatom) - e9/3._dp + atener(jatom) = atener(jatom) - e9/3._dp + atener(katom) = atener(katom) - e9/3._dp END IF IF (calculate_forces) THEN - rab = rb-ra; rbc = rc-rb; rca = ra-rc + rab = rb - ra; rbc = rc - rb; rca = ra - rc de91 = s9*fac*dfdabc*c9*ang/r2abc**1.50d0 - de91 = -de91/3._dp*rabc+3._dp*e9 + de91 = -de91/3._dp*rabc + 3._dp*e9 dea = s9*fac*fdabc*c9/r2abc**2.50d0*0.75_dp fdij(:) = de91*rab(:)/r2ab - fdij(:) = fdij(:)+dea*s1*s2*s3*rab(:)/r2ab - fdij(:) = fdij(:)-dea*(s2*s3+s1*s3-s1*s2)*rab(:) - force(ikind)%dispersion(:, atom_a) = force(ikind)%dispersion(:, atom_a)-fdij(:) - force(jkind)%dispersion(:, atom_b) = force(jkind)%dispersion(:, atom_b)+fdij(:) + fdij(:) = fdij(:) + dea*s1*s2*s3*rab(:)/r2ab + fdij(:) = fdij(:) - dea*(s2*s3 + s1*s3 - s1*s2)*rab(:) + force(ikind)%dispersion(:, atom_a) = force(ikind)%dispersion(:, atom_a) - fdij(:) + force(jkind)%dispersion(:, atom_b) = force(jkind)%dispersion(:, atom_b) + fdij(:) IF (use_virial) THEN CALL virial_pair_force(pv_virial_thread, -1._dp, fdij, rab) END IF @@ -1449,10 +1449,10 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat CALL virial_pair_force(atstr(:, :, jatom), -0.5_dp, fdij, rab) END IF fdij(:) = de91*rbc(:)/r2bc - fdij(:) = fdij(:)+dea*s1*s2*s3*rbc(:)/r2bc - fdij(:) = fdij(:)-dea*(s2*s3-s1*s3+s1*s2)*rbc(:) - force(jkind)%dispersion(:, atom_b) = force(jkind)%dispersion(:, atom_b)-fdij(:) - force(kkind)%dispersion(:, atom_c) = force(kkind)%dispersion(:, atom_c)+fdij(:) + fdij(:) = fdij(:) + dea*s1*s2*s3*rbc(:)/r2bc + fdij(:) = fdij(:) - dea*(s2*s3 - s1*s3 + s1*s2)*rbc(:) + force(jkind)%dispersion(:, atom_b) = force(jkind)%dispersion(:, atom_b) - fdij(:) + force(kkind)%dispersion(:, atom_c) = force(kkind)%dispersion(:, atom_c) + fdij(:) IF (use_virial) THEN CALL virial_pair_force(pv_virial_thread, -1._dp, fdij, rbc) END IF @@ -1461,10 +1461,10 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat CALL virial_pair_force(atstr(:, :, katom), -0.5_dp, fdij, rbc) END IF fdij(:) = de91*rca(:)/r2ca - fdij(:) = fdij(:)+dea*s1*s2*s3*rca(:)/r2ca - fdij(:) = fdij(:)-dea*(-s2*s3+s1*s3+s1*s2)*rca(:) - force(kkind)%dispersion(:, atom_c) = force(kkind)%dispersion(:, atom_c)-fdij(:) - force(ikind)%dispersion(:, atom_a) = force(ikind)%dispersion(:, atom_a)+fdij(:) + fdij(:) = fdij(:) + dea*s1*s2*s3*rca(:)/r2ca + fdij(:) = fdij(:) - dea*(-s2*s3 + s1*s3 + s1*s2)*rca(:) + force(kkind)%dispersion(:, atom_c) = force(kkind)%dispersion(:, atom_c) - fdij(:) + force(ikind)%dispersion(:, atom_a) = force(ikind)%dispersion(:, atom_a) + fdij(:) IF (use_virial) THEN CALL virial_pair_force(pv_virial_thread, -1._dp, fdij, rca) END IF @@ -1486,11 +1486,11 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat rik(1) = dcnum(iatom)%rik(1, i) rik(2) = dcnum(iatom)%rik(2, i) rik(3) = dcnum(iatom)%rik(3, i) - drk = SQRT(rik(1)*rik(1)+rik(2)*rik(2)+rik(3)*rik(3)) + drk = SQRT(rik(1)*rik(1) + rik(2)*rik(2) + rik(3)*rik(3)) fdik(:) = -de921*dcnum(iatom)%dvals(i)*rik(:)/drk atom_d = atom_of_kind(latom) - force(ikind)%dispersion(:, atom_a) = force(ikind)%dispersion(:, atom_a)-fdik(:) - force(lkind)%dispersion(:, atom_d) = force(lkind)%dispersion(:, atom_d)+fdik(:) + force(ikind)%dispersion(:, atom_a) = force(ikind)%dispersion(:, atom_a) - fdik(:) + force(lkind)%dispersion(:, atom_d) = force(lkind)%dispersion(:, atom_d) + fdik(:) IF (use_virial) THEN CALL virial_pair_force(pv_virial_thread, -1._dp, fdik, rik) END IF @@ -1501,11 +1501,11 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat rik(1) = dcnum(jatom)%rik(1, i) rik(2) = dcnum(jatom)%rik(2, i) rik(3) = dcnum(jatom)%rik(3, i) - drk = SQRT(rik(1)*rik(1)+rik(2)*rik(2)+rik(3)*rik(3)) + drk = SQRT(rik(1)*rik(1) + rik(2)*rik(2) + rik(3)*rik(3)) fdik(:) = -de922*dcnum(jatom)%dvals(i)*rik(:)/drk atom_d = atom_of_kind(latom) - force(jkind)%dispersion(:, atom_b) = force(jkind)%dispersion(:, atom_b)-fdik(:) - force(lkind)%dispersion(:, atom_d) = force(lkind)%dispersion(:, atom_d)+fdik(:) + force(jkind)%dispersion(:, atom_b) = force(jkind)%dispersion(:, atom_b) - fdik(:) + force(lkind)%dispersion(:, atom_d) = force(lkind)%dispersion(:, atom_d) + fdik(:) IF (use_virial) THEN CALL virial_pair_force(pv_virial_thread, -1._dp, fdik, rik) END IF @@ -1520,11 +1520,11 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat rik(1) = dcnum(jatom)%rik(1, i) rik(2) = dcnum(jatom)%rik(2, i) rik(3) = dcnum(jatom)%rik(3, i) - drk = SQRT(rik(1)*rik(1)+rik(2)*rik(2)+rik(3)*rik(3)) + drk = SQRT(rik(1)*rik(1) + rik(2)*rik(2) + rik(3)*rik(3)) fdik(:) = -de921*dcnum(jatom)%dvals(i)*rik(:)/drk atom_d = atom_of_kind(latom) - force(jkind)%dispersion(:, atom_b) = force(jkind)%dispersion(:, atom_b)-fdik(:) - force(lkind)%dispersion(:, atom_d) = force(lkind)%dispersion(:, atom_d)+fdik(:) + force(jkind)%dispersion(:, atom_b) = force(jkind)%dispersion(:, atom_b) - fdik(:) + force(lkind)%dispersion(:, atom_d) = force(lkind)%dispersion(:, atom_d) + fdik(:) IF (use_virial) THEN CALL virial_pair_force(pv_virial_thread, -1._dp, fdik, rik) END IF @@ -1535,11 +1535,11 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat rik(1) = dcnum(katom)%rik(1, i) rik(2) = dcnum(katom)%rik(2, i) rik(3) = dcnum(katom)%rik(3, i) - drk = SQRT(rik(1)*rik(1)+rik(2)*rik(2)+rik(3)*rik(3)) + drk = SQRT(rik(1)*rik(1) + rik(2)*rik(2) + rik(3)*rik(3)) fdik(:) = -de922*dcnum(katom)%dvals(i)*rik(:)/drk atom_d = atom_of_kind(latom) - force(kkind)%dispersion(:, atom_c) = force(kkind)%dispersion(:, atom_c)-fdik(:) - force(lkind)%dispersion(:, atom_d) = force(lkind)%dispersion(:, atom_d)+fdik(:) + force(kkind)%dispersion(:, atom_c) = force(kkind)%dispersion(:, atom_c) - fdik(:) + force(lkind)%dispersion(:, atom_d) = force(lkind)%dispersion(:, atom_d) + fdik(:) IF (use_virial) THEN CALL virial_pair_force(pv_virial_thread, -1._dp, fdik, rik) END IF @@ -1554,11 +1554,11 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat rik(1) = dcnum(katom)%rik(1, i) rik(2) = dcnum(katom)%rik(2, i) rik(3) = dcnum(katom)%rik(3, i) - drk = SQRT(rik(1)*rik(1)+rik(2)*rik(2)+rik(3)*rik(3)) + drk = SQRT(rik(1)*rik(1) + rik(2)*rik(2) + rik(3)*rik(3)) fdik(:) = -de921*dcnum(katom)%dvals(i)*rik(:)/drk atom_d = atom_of_kind(latom) - force(kkind)%dispersion(:, atom_c) = force(kkind)%dispersion(:, atom_c)-fdik(:) - force(lkind)%dispersion(:, atom_d) = force(lkind)%dispersion(:, atom_d)+fdik(:) + force(kkind)%dispersion(:, atom_c) = force(kkind)%dispersion(:, atom_c) - fdik(:) + force(lkind)%dispersion(:, atom_d) = force(lkind)%dispersion(:, atom_d) + fdik(:) IF (use_virial) THEN CALL virial_pair_force(pv_virial_thread, -1._dp, fdik, rik) END IF @@ -1569,11 +1569,11 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat rik(1) = dcnum(iatom)%rik(1, i) rik(2) = dcnum(iatom)%rik(2, i) rik(3) = dcnum(iatom)%rik(3, i) - drk = SQRT(rik(1)*rik(1)+rik(2)*rik(2)+rik(3)*rik(3)) + drk = SQRT(rik(1)*rik(1) + rik(2)*rik(2) + rik(3)*rik(3)) fdik(:) = -de922*dcnum(iatom)%dvals(i)*rik(:)/drk atom_d = atom_of_kind(latom) - force(ikind)%dispersion(:, atom_a) = force(ikind)%dispersion(:, atom_a)-fdik(:) - force(lkind)%dispersion(:, atom_d) = force(lkind)%dispersion(:, atom_d)+fdik(:) + force(ikind)%dispersion(:, atom_a) = force(ikind)%dispersion(:, atom_a) - fdik(:) + force(lkind)%dispersion(:, atom_d) = force(lkind)%dispersion(:, atom_d) + fdik(:) IF (use_virial) THEN CALL virial_pair_force(pv_virial_thread, -1._dp, fdik, rik) END IF @@ -1593,7 +1593,7 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat END IF END DO - virial%pv_virial = virial%pv_virial+pv_virial_thread + virial%pv_virial = virial%pv_virial + pv_virial_thread CALL neighbor_list_iterator_release(nl_iterator) @@ -1628,9 +1628,9 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat IF (.NOT. disp_b%defined .OR. ghost_b .OR. floating_b) CYCLE CALL getc6(maxc, max_elem, dispersion_env%c6ab, dispersion_env%maxci, za, zb, & cnkind(ikind), cnkind(jkind), dispersion_env%k3, cc6ab, dcc6aba, dcc6abb) - elrc6 = elrc6-s6*twopi*REAL(na*nb, KIND=dp)*cc6ab/(3._dp*rcut**3*cell%deth) + elrc6 = elrc6 - s6*twopi*REAL(na*nb, KIND=dp)*cc6ab/(3._dp*rcut**3*cell%deth) c8 = 3.0d0*cc6ab*dispersion_env%r2r4(za)*dispersion_env%r2r4(zb) - elrc8 = elrc8-s8*twopi*REAL(na*nb, KIND=dp)*c8/(5._dp*rcut**5*cell%deth) + elrc8 = elrc8 - s8*twopi*REAL(na*nb, KIND=dp)*c8/(5._dp*rcut**5*cell%deth) IF (dispersion_env%doabc) THEN DO kkind = 1, nkind CALL get_atomic_kind(atomic_kind_set(kkind), natom=nc, z=zc) @@ -1643,14 +1643,14 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat CALL getc6(maxc, max_elem, dispersion_env%c6ab, dispersion_env%maxci, zb, zc, & cnkind(jkind), cnkind(kkind), dispersion_env%k3, cc6bc, dcc6aba, dcc6abb) c9 = -SQRT(cc6ab*cc6bc*cc6ca) - elrc9 = elrc9-s9*64._dp*twopi*REAL(na*nb*nc, KIND=dp)*c9/(6._dp*rcut**3*cell%deth**2) + elrc9 = elrc9 - s9*64._dp*twopi*REAL(na*nb*nc, KIND=dp)*c9/(6._dp*rcut**3*cell%deth**2) END DO END IF END DO END DO IF (use_virial) THEN DO i = 1, 3 - virial%pv_virial(i, i) = virial%pv_virial(i, i)+(elrc6+elrc8+2._dp*elrc9) + virial%pv_virial(i, i) = virial%pv_virial(i, i) + (elrc6 + elrc8 + 2._dp*elrc9) END DO END IF DEALLOCATE (cnkind) @@ -1675,7 +1675,7 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat ! set dispersion energy CALL mp_sum(evdw, para_env%group) - evdw = evdw+(elrc6+elrc8+elrc9) + evdw = evdw + (elrc6 + elrc8 + elrc9) energy = evdw IF ((dispersion_env%pp_type == vdw_pairpot_dftd3 .OR. & @@ -1685,9 +1685,9 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat CALL mp_sum(e9tot, para_env%group) CALL mp_sum(nab, para_env%group) CALL mp_sum(nabc, para_env%group) - e6tot = e6tot+elrc6 - e8tot = e8tot+elrc8 - e9tot = e9tot+elrc9 + e6tot = e6tot + elrc6 + e8tot = e8tot + elrc8 + e9tot = e9tot + elrc9 IF (unit_nr > 0) THEN WRITE (unit_nr, "(A,F20.0)") " E6 vdW terms :", nab WRITE (unit_nr, *) " E6 vdW energy [au/kcal] :", e6tot, e6tot*kcalmol @@ -1719,7 +1719,7 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat atom_a = atom_of_kind(iatom) fdij(1:3) = force(ikind)%dispersion(:, atom_a) CALL mp_sum(fdij, para_env%group) - gnorm = gnorm+SUM(ABS(fdij)) + gnorm = gnorm + SUM(ABS(fdij)) IF (unit_nr > 0) WRITE (unit_nr, "(i5,i7,3F20.14)") iatom, ikind, fdij END DO IF (unit_nr > 0) THEN @@ -1728,12 +1728,12 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat WRITE (unit_nr, *) END IF IF (use_virial) THEN - dvirial = virial%pv_virial-dvirial + dvirial = virial%pv_virial - dvirial CALL mp_sum(dvirial, para_env%group) IF (unit_nr > 0) THEN WRITE (unit_nr, *) "Stress Tensor (dispersion)" WRITE (unit_nr, "(3G20.12)") dvirial - WRITE (unit_nr, *) " Tr(P)/3 : ", (dvirial(1, 1)+dvirial(2, 2)+dvirial(3, 3))/3._dp + WRITE (unit_nr, *) " Tr(P)/3 : ", (dvirial(1, 1) + dvirial(2, 2) + dvirial(3, 3))/3._dp WRITE (unit_nr, *) END IF END IF @@ -1750,7 +1750,7 @@ SUBROUTINE calculate_dispersion_pairpot(qs_env, dispersion_env, energy, calculat END IF IF (calculate_forces .AND. use_virial) THEN - virial%pv_vdw = virial%pv_virial-pv_loc + virial%pv_vdw = virial%pv_virial - pv_loc END IF IF (ASSOCIATED(dispersion_env%dftd_section)) THEN @@ -1779,22 +1779,22 @@ FUNCTION cellhash(cell, ncell) RESULT(hash) ix = cell(1) IF (ix /= 0) THEN - ix = 2*ABS(ix)-(1+SIGN(1, ix))/2 + ix = 2*ABS(ix) - (1 + SIGN(1, ix))/2 END IF iy = cell(2) IF (iy /= 0) THEN - iy = 2*ABS(iy)-(1+SIGN(1, iy))/2 + iy = 2*ABS(iy) - (1 + SIGN(1, iy))/2 END IF iz = cell(3) IF (iz /= 0) THEN - iz = 2*ABS(iz)-(1+SIGN(1, iz))/2 + iz = 2*ABS(iz) - (1 + SIGN(1, iz))/2 END IF - nx = 2*ncell(1)+1 - ny = 2*ncell(2)+1 - nz = 2*ncell(3)+1 + nx = 2*ncell(1) + 1 + ny = 2*ncell(2) + 1 + nz = 2*ncell(3) + 1 - hash = ix*ny*nz+iy*nz+iz+1 + hash = ix*ny*nz + iy*nz + iz + 1 END FUNCTION cellhash ! ************************************************************************************************** @@ -1886,19 +1886,19 @@ SUBROUTINE dftd3_c6_param(c6ab, maxci, filename, para_env) maxci = 0 kk = 1 DO nn = 1, nlines - iat = NINT(pars(kk+1)) - jat = NINT(pars(kk+2)) + iat = NINT(pars(kk + 1)) + jat = NINT(pars(kk + 2)) CALL limit(iat, jat, iadr, jadr) maxci(iat) = MAX(maxci(iat), iadr) maxci(jat) = MAX(maxci(jat), jadr) c6ab(iat, jat, iadr, jadr, 1) = pars(kk) - c6ab(iat, jat, iadr, jadr, 2) = pars(kk+3) - c6ab(iat, jat, iadr, jadr, 3) = pars(kk+4) + c6ab(iat, jat, iadr, jadr, 2) = pars(kk + 3) + c6ab(iat, jat, iadr, jadr, 3) = pars(kk + 4) c6ab(jat, iat, jadr, iadr, 1) = pars(kk) - c6ab(jat, iat, jadr, iadr, 2) = pars(kk+4) - c6ab(jat, iat, jadr, iadr, 3) = pars(kk+3) - kk = (nn*5)+1 + c6ab(jat, iat, jadr, iadr, 2) = pars(kk + 4) + c6ab(jat, iat, jadr, iadr, 3) = pars(kk + 3) + kk = (nn*5) + 1 ENDDO DEALLOCATE (pars) @@ -1921,14 +1921,14 @@ SUBROUTINE limit(iat, jat, iadr, jadr) jadr = 1 i = 100 DO WHILE (iat .GT. 100) - iat = iat-100 - iadr = iadr+1 + iat = iat - 100 + iadr = iadr + 1 ENDDO i = 100 DO WHILE (jat .GT. 100) - jat = jat-100 - jadr = jadr+1 + jat = jat - 100 + jadr = jadr + 1 ENDDO END SUBROUTINE limit @@ -2716,7 +2716,7 @@ SUBROUTINE setr0ab(rout, rcov, r2r4) k = 0 DO i = 1, SIZE(rout, 1) DO j = 1, i - k = k+1 + k = k + 1 rout(i, j) = r0ab(k)*bohr rout(j, i) = r0ab(k)*bohr ENDDO @@ -2802,17 +2802,17 @@ SUBROUTINE cnparam_d3(rab, rcova, rcovb, k1, cnab, dcnab) ! covalent distance in Bohr - rco = rcova+rcovb + rco = rcova + rcovb rr = rco/rab ! counting function exponential has a better long-range behavior ! than MHGs inverse damping ! factor k2 already included into rcov - ee = EXP(-k1*(rr-1.0_dp)) + ee = EXP(-k1*(rr - 1.0_dp)) ! force the function to zero using a second step function - fz = 0.5_dp*(1.0_dp-TANH(rab-2.0_dp*rco)) - dfz = 0.5_dp*((TANH(rab-2.0_dp*rco))**2-1.0_dp) - cnab = 1.0_dp/(1.0_dp+ee)*fz - dcnab = -cnab*cnab*k1*rr/rab*ee+1.0_dp/(1.0_dp+ee)*dfz + fz = 0.5_dp*(1.0_dp - TANH(rab - 2.0_dp*rco)) + dfz = 0.5_dp*((TANH(rab - 2.0_dp*rco))**2 - 1.0_dp) + cnab = 1.0_dp/(1.0_dp + ee)*fz + dcnab = -cnab*cnab*k1*rr/rab*ee + 1.0_dp/(1.0_dp + ee)*dfz END SUBROUTINE cnparam_d3 @@ -2834,7 +2834,7 @@ SUBROUTINE damping_d3(rab, rcutab, srn, alpn, rcut, fdab, dfdab) REAL(KIND=dp) :: a, b, c, d, dd, dfab, dfcc, dz, fab, & fcc, rl, rr, ru, z, zz - rl = rcut-1._dp + rl = rcut - 1._dp ru = rcut IF (rab >= ru) THEN fcc = 0._dp @@ -2843,23 +2843,23 @@ SUBROUTINE damping_d3(rab, rcutab, srn, alpn, rcut, fdab, dfdab) fcc = 1._dp dfcc = 0._dp ELSE - z = rab*rab-rl*rl + z = rab*rab - rl*rl dz = 2._dp*rab zz = z*z*z - d = ru*ru-rl*rl + d = ru*ru - rl*rl dd = d*d*d a = -10._dp/dd b = 15._dp/(dd*d) c = -6._dp/(dd*d*d) - fcc = 1._dp+zz*(a+b*z+c*z*z) - dfcc = zz*dz/z*(3._dp*a+4._dp*b*z+5._dp*c*z*z) + fcc = 1._dp + zz*(a + b*z + c*z*z) + dfcc = zz*dz/z*(3._dp*a + 4._dp*b*z + 5._dp*c*z*z) END IF rr = 6._dp*(rab/(srn*rcutab))**(-alpn) - fab = 1._dp/(1._dp+rr) + fab = 1._dp/(1._dp + rr) dfab = fab*fab*rr*alpn/rab fdab = fab*fcc - dfdab = dfab*fcc+fab*dfcc + dfdab = dfab*fcc + fab*dfcc END SUBROUTINE damping_d3 @@ -2910,20 +2910,20 @@ SUBROUTINE getc6(maxc, max_elem, c6ab, mxc, iat, jat, nci, ncj, k3, c6, dc6a, dc cn1 = c6ab(iat, jat, i, j, 2) cn2 = c6ab(iat, jat, i, j, 3) ! distance - r = (cn1-nci)**2+(cn2-ncj)**2 + r = (cn1 - nci)**2 + (cn2 - ncj)**2 IF (r < rsave) THEN rsave = r c6mem = c6 ENDIF tmp1 = EXP(k3*r) - dtmpa = -2.0_dp*k3*(cn1-nci)*tmp1 - dtmpb = -2.0_dp*k3*(cn2-ncj)*tmp1 - rsum = rsum+tmp1 - csum = csum+tmp1*c6 - dza = dza+dtmpa*c6 - dwa = dwa+dtmpa - dzb = dzb+dtmpb*c6 - dwb = dwb+dtmpb + dtmpa = -2.0_dp*k3*(cn1 - nci)*tmp1 + dtmpb = -2.0_dp*k3*(cn2 - ncj)*tmp1 + rsum = rsum + tmp1 + csum = csum + tmp1*c6 + dza = dza + dtmpa*c6 + dwa = dwa + dtmpa + dzb = dzb + dtmpb*c6 + dwb = dwb + dtmpb ENDIF ENDDO ENDDO @@ -2932,8 +2932,8 @@ SUBROUTINE getc6(maxc, max_elem, c6ab, mxc, iat, jat, nci, ncj, k3, c6, dc6a, dc IF (rsum > 1.0e-66_dp) THEN c6 = csum/rsum - dc6a = (dza-c6*dwa)/rsum - dc6b = (dzb-c6*dwb)/rsum + dc6a = (dza - c6*dwa)/rsum + dc6b = (dzb - c6*dwb)/rsum ELSE c6 = c6mem dc6a = 0._dp @@ -2981,13 +2981,13 @@ SUBROUTINE dcnum_distribute(dcnum, para_env) i = 0 DO ia = 1, natom DO jn = 1, nloc(ia) - i = i+1 + i = i + 1 list(i) = dcnum(ia)%nlist(jn) dvals(i) = dcnum(ia)%dvals(jn) rik(1:3, i) = dcnum(ia)%rik(1:3, jn) END DO END DO - DO ipe = 1, para_env%num_pe-1 + DO ipe = 1, para_env%num_pe - 1 !send/receive packed data CALL mp_shift(nloc, group) !unpack received data @@ -2997,20 +2997,20 @@ SUBROUTINE dcnum_distribute(dcnum, para_env) !add data to local dcnum i = 0 DO ia = 1, natom - n = dcnum(ia)%neighbors+nloc(ia) + n = dcnum(ia)%neighbors + nloc(ia) IF (n > SIZE(dcnum(ia)%nlist)) THEN CALL reallocate(dcnum(ia)%nlist, 1, 2*n) CALL reallocate(dcnum(ia)%dvals, 1, 2*n) CALL reallocate(dcnum(ia)%rik, 1, 3, 1, 2*n) END IF DO jn = 1, nloc(ia) - i = i+1 - n = dcnum(ia)%neighbors+jn + i = i + 1 + n = dcnum(ia)%neighbors + jn dcnum(ia)%nlist(n) = list(i) dcnum(ia)%dvals(n) = dvals(i) dcnum(ia)%rik(1:3, n) = rik(1:3, i) END DO - dcnum(ia)%neighbors = dcnum(ia)%neighbors+nloc(ia) + dcnum(ia)%neighbors = dcnum(ia)%neighbors + nloc(ia) END DO END DO DEALLOCATE (nloc) @@ -3100,7 +3100,7 @@ SUBROUTINE d3_cnumber(qs_env, dispersion_env, cnumbers, dcnum, ghost, floating, CALL get_iterator_info(nl_iterator, mepos=mepos, ikind=ikind, jkind=jkind, iatom=iatom, jatom=jatom, r=rij) IF (ghost(ikind) .OR. ghost(jkind) .OR. floating(ikind) .OR. floating(jkind)) CYCLE - rcc = SQRT(rij(1)*rij(1)+rij(2)*rij(2)+rij(3)*rij(3)) + rcc = SQRT(rij(1)*rij(1) + rij(2)*rij(2) + rij(3)*rij(3)) IF (rcc > 1.e-6_dp) THEN za = atomnumber(ikind) zb = atomnumber(jkind) @@ -3109,15 +3109,15 @@ SUBROUTINE d3_cnumber(qs_env, dispersion_env, cnumbers, dcnum, ghost, floating, CALL cnparam_d3(rcc, rcova, rcovb, dispersion_env%k1, cnab, dcnab) IF (cnab > eps_cn) THEN !$OMP ATOMIC - cnumbers(iatom) = cnumbers(iatom)+cnab + cnumbers(iatom) = cnumbers(iatom) + cnab IF (iatom /= jatom) THEN !$OMP ATOMIC - cnumbers(jatom) = cnumbers(jatom)+cnab + cnumbers(jatom) = cnumbers(jatom) + cnab END IF END IF IF (calculate_forces .OR. debugall .AND. cnab > eps_cn) THEN !$ CALL omp_set_lock(locks(iatom)) - dcnum(iatom)%neighbors = dcnum(iatom)%neighbors+1 + dcnum(iatom)%neighbors = dcnum(iatom)%neighbors + 1 ni = dcnum(iatom)%neighbors IF (ni > SIZE(dcnum(iatom)%nlist)) THEN CALL reallocate(dcnum(iatom)%nlist, 1, 2*ni) @@ -3131,7 +3131,7 @@ SUBROUTINE d3_cnumber(qs_env, dispersion_env, cnumbers, dcnum, ghost, floating, IF (iatom /= jatom) THEN !$ CALL omp_set_lock(locks(jatom)) - dcnum(jatom)%neighbors = dcnum(jatom)%neighbors+1 + dcnum(jatom)%neighbors = dcnum(jatom)%neighbors + 1 nj = dcnum(jatom)%neighbors IF (nj > SIZE(dcnum(jatom)%dvals)) THEN CALL reallocate(dcnum(jatom)%nlist, 1, 2*nj) diff --git a/src/qs_efield_berry.F b/src/qs_efield_berry.F index f02390e76e..69de255814 100644 --- a/src/qs_efield_berry.F +++ b/src/qs_efield_berry.F @@ -258,7 +258,7 @@ SUBROUTINE qs_efield_derivatives(qs_env, just_energy, calculate_forces) fieldpol = -fieldpol*dft_control%period_efield%strength hmat = cell%hmat(:, :)/twopi DO idir = 1, 3 - fpolvec(idir) = fieldpol(1)*hmat(1, idir)+fieldpol(2)*hmat(2, idir)+fieldpol(3)*hmat(3, idir) + fpolvec(idir) = fieldpol(1)*hmat(1, idir) + fieldpol(2)*hmat(2, idir) + fieldpol(3)*hmat(3, idir) END DO ! nuclear contribution @@ -284,7 +284,7 @@ SUBROUTINE qs_efield_derivatives(qs_env, just_energy, calculate_forces) IF (para_env%mepos == 0) THEN iatom = atom_of_kind(ia) forcea(:) = fieldpol(:)*charge - force(ikind)%efield(:, iatom) = force(ikind)%efield(:, iatom)+forcea(:) + force(ikind)%efield(:, iatom) = force(ikind)%efield(:, iatom) + forcea(:) END IF END IF IF (use_virial) THEN @@ -478,8 +478,8 @@ SUBROUTINE qs_efield_derivatives(qs_env, just_energy, calculate_forces) ldsa = SIZE(sphi_a, 1) ldsb = SIZE(sphi_b, 1) ra(:) = pbc(particle_set(iatom)%r(:), cell) - rb(:) = ra+rab - dab = SQRT(rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3)) + rb(:) = ra + rab + dab = SQRT(rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3)) IF (iatom <= jatom) THEN irow = iatom @@ -506,7 +506,7 @@ SUBROUTINE qs_efield_derivatives(qs_env, just_energy, calculate_forces) ncoa = npgfa(iset)*ncoset(la_max(iset)) sgfa = first_sgfa(1, iset) DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) ! Calculate the primitive integrals (da|b) @@ -551,22 +551,22 @@ SUBROUTINE qs_efield_derivatives(qs_env, just_energy, calculate_forces) CPASSERT(lsab >= n2) IF (iatom <= jatom) THEN DO i = 1, 3 - forcea(i) = forcea(i)+SUM(rblock(1:n1, 1:n2)*dsint(i, 1)%block(1:n1, 1:n2)) & - -SUM(iblock(1:n1, 1:n2)*dcost(i, 1)%block(1:n1, 1:n2)) - forceb(i) = forceb(i)+SUM(rblock(1:n1, 1:n2)*dsint(i, 2)%block(1:n1, 1:n2)) & - -SUM(iblock(1:n1, 1:n2)*dcost(i, 2)%block(1:n1, 1:n2)) + forcea(i) = forcea(i) + SUM(rblock(1:n1, 1:n2)*dsint(i, 1)%block(1:n1, 1:n2)) & + - SUM(iblock(1:n1, 1:n2)*dcost(i, 1)%block(1:n1, 1:n2)) + forceb(i) = forceb(i) + SUM(rblock(1:n1, 1:n2)*dsint(i, 2)%block(1:n1, 1:n2)) & + - SUM(iblock(1:n1, 1:n2)*dcost(i, 2)%block(1:n1, 1:n2)) END DO ELSE DO i = 1, 3 - forcea(i) = forcea(i)+SUM(TRANSPOSE(rblock(1:n1, 1:n2))*dsint(i, 1)%block(1:n2, 1:n1)) & - -SUM(TRANSPOSE(iblock(1:n1, 1:n2))*dcost(i, 1)%block(1:n2, 1:n1)) - forceb(i) = forceb(i)+SUM(TRANSPOSE(rblock(1:n1, 1:n2))*dsint(i, 2)%block(1:n2, 1:n1)) & - -SUM(TRANSPOSE(iblock(1:n1, 1:n2))*dcost(i, 2)%block(1:n2, 1:n1)) + forcea(i) = forcea(i) + SUM(TRANSPOSE(rblock(1:n1, 1:n2))*dsint(i, 1)%block(1:n2, 1:n1)) & + - SUM(TRANSPOSE(iblock(1:n1, 1:n2))*dcost(i, 1)%block(1:n2, 1:n1)) + forceb(i) = forceb(i) + SUM(TRANSPOSE(rblock(1:n1, 1:n2))*dsint(i, 2)%block(1:n2, 1:n1)) & + - SUM(TRANSPOSE(iblock(1:n1, 1:n2))*dcost(i, 2)%block(1:n2, 1:n1)) END DO END IF END DO - force(ikind)%efield(1:3, atom_a) = force(ikind)%efield(1:3, atom_a)-fab*fpolvec(idir)*forcea(1:3) - force(jkind)%efield(1:3, atom_b) = force(jkind)%efield(1:3, atom_b)-fab*fpolvec(idir)*forceb(1:3) + force(ikind)%efield(1:3, atom_a) = force(ikind)%efield(1:3, atom_a) - fab*fpolvec(idir)*forcea(1:3) + force(jkind)%efield(1:3, atom_b) = force(jkind)%efield(1:3, atom_b) - fab*fpolvec(idir)*forceb(1:3) IF (use_virial) THEN f0 = -fab*fpolvec(idir) CALL virial_pair_force(virial%pv_virial, f0, forcea, ra) @@ -586,24 +586,24 @@ SUBROUTINE qs_efield_derivatives(qs_env, just_energy, calculate_forces) ti = 0.0_dp DO idir = 1, 3 ! make sure the total normalized polarization is within [-1:1] - cqi(idir) = qi(idir)+ci(idir) - IF (cqi(idir) > pi) cqi(idir) = cqi(idir)-twopi - IF (cqi(idir) < -pi) cqi(idir) = cqi(idir)+twopi + cqi(idir) = qi(idir) + ci(idir) + IF (cqi(idir) > pi) cqi(idir) = cqi(idir) - twopi + IF (cqi(idir) < -pi) cqi(idir) = cqi(idir) + twopi ! now check for log branch - IF (ABS(efield%polarisation(idir)-cqi(idir)) > pi) THEN - ti(idir) = (efield%polarisation(idir)-cqi(idir))/pi + IF (ABS(efield%polarisation(idir) - cqi(idir)) > pi) THEN + ti(idir) = (efield%polarisation(idir) - cqi(idir))/pi DO i = 1, 10 - cqi(idir) = cqi(idir)+SIGN(1.0_dp, ti(idir))*twopi - IF (ABS(efield%polarisation(idir)-cqi(idir)) < pi) EXIT + cqi(idir) = cqi(idir) + SIGN(1.0_dp, ti(idir))*twopi + IF (ABS(efield%polarisation(idir) - cqi(idir)) < pi) EXIT END DO END IF - ener_field = ener_field+fpolvec(idir)*cqi(idir) + ener_field = ener_field + fpolvec(idir)*cqi(idir) END DO ! update the references IF (calculate_forces) THEN ! check for smoothness of energy surface - IF (ABS(efield%field_energy-ener_field) > pi*ABS(SUM(fpolvec))) THEN + IF (ABS(efield%field_energy - ener_field) > pi*ABS(SUM(fpolvec))) THEN CPWARN("Large change of e-field energy detected. Correct for non-smooth energy surface") END IF efield%field_energy = ener_field @@ -620,12 +620,12 @@ SUBROUTINE qs_efield_derivatives(qs_env, just_energy, calculate_forces) ti = 0.0_dp DO i = 1, 3 DO j = 1, 3 - ti(j) = ti(j)+hmat(j, i)*cqi(i) + ti(j) = ti(j) + hmat(j, i)*cqi(i) END DO END DO DO i = 1, 3 DO j = 1, 3 - virial%pv_virial(i, j) = virial%pv_virial(i, j)-fieldpol(i)*ti(j) + virial%pv_virial(i, j) = virial%pv_virial(i, j) - fieldpol(i)*ti(j) END DO END DO END IF @@ -771,7 +771,7 @@ SUBROUTINE qs_dispfield_derivatives(qs_env, just_energy, calculate_forces) IF (calculate_forces) THEN IF (para_env%mepos == 0) THEN DO i = 1, 3 - force_tmp(ia, i, i) = force_tmp(ia, i, i)+charge/omega + force_tmp(ia, i, i) = force_tmp(ia, i, i) + charge/omega END DO END IF END IF @@ -961,8 +961,8 @@ SUBROUTINE qs_dispfield_derivatives(qs_env, just_energy, calculate_forces) ldsa = SIZE(sphi_a, 1) ldsb = SIZE(sphi_b, 1) ra(:) = pbc(particle_set(iatom)%r(:), cell) - rb(:) = ra+rab - dab = SQRT(rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3)) + rb(:) = ra + rab + dab = SQRT(rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3)) IF (iatom <= jatom) THEN irow = iatom @@ -989,7 +989,7 @@ SUBROUTINE qs_dispfield_derivatives(qs_env, just_energy, calculate_forces) ncoa = npgfa(iset)*ncoset(la_max(iset)) sgfa = first_sgfa(1, iset) DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) ! Calculate the primitive integrals (da|b) @@ -1034,23 +1034,23 @@ SUBROUTINE qs_dispfield_derivatives(qs_env, just_energy, calculate_forces) CPASSERT(lsab >= n2) IF (iatom <= jatom) THEN DO i = 1, 3 - forcea(i) = forcea(i)+SUM(rblock(1:n1, 1:n2)*dsint(i, 1)%block(1:n1, 1:n2)) & - -SUM(iblock(1:n1, 1:n2)*dcost(i, 1)%block(1:n1, 1:n2)) - forceb(i) = forceb(i)+SUM(rblock(1:n1, 1:n2)*dsint(i, 2)%block(1:n1, 1:n2)) & - -SUM(iblock(1:n1, 1:n2)*dcost(i, 2)%block(1:n1, 1:n2)) + forcea(i) = forcea(i) + SUM(rblock(1:n1, 1:n2)*dsint(i, 1)%block(1:n1, 1:n2)) & + - SUM(iblock(1:n1, 1:n2)*dcost(i, 1)%block(1:n1, 1:n2)) + forceb(i) = forceb(i) + SUM(rblock(1:n1, 1:n2)*dsint(i, 2)%block(1:n1, 1:n2)) & + - SUM(iblock(1:n1, 1:n2)*dcost(i, 2)%block(1:n1, 1:n2)) END DO ELSE DO i = 1, 3 - forcea(i) = forcea(i)+SUM(TRANSPOSE(rblock(1:n1, 1:n2))*dsint(i, 1)%block(1:n2, 1:n1)) & - -SUM(TRANSPOSE(iblock(1:n1, 1:n2))*dcost(i, 1)%block(1:n2, 1:n1)) - forceb(i) = forceb(i)+SUM(TRANSPOSE(rblock(1:n1, 1:n2))*dsint(i, 2)%block(1:n2, 1:n1)) & - -SUM(TRANSPOSE(iblock(1:n1, 1:n2))*dcost(i, 2)%block(1:n2, 1:n1)) + forcea(i) = forcea(i) + SUM(TRANSPOSE(rblock(1:n1, 1:n2))*dsint(i, 1)%block(1:n2, 1:n1)) & + - SUM(TRANSPOSE(iblock(1:n1, 1:n2))*dcost(i, 1)%block(1:n2, 1:n1)) + forceb(i) = forceb(i) + SUM(TRANSPOSE(rblock(1:n1, 1:n2))*dsint(i, 2)%block(1:n2, 1:n1)) & + - SUM(TRANSPOSE(iblock(1:n1, 1:n2))*dcost(i, 2)%block(1:n2, 1:n1)) END DO END IF END DO DO i = 1, 3 - force_tmp(iatom, :, i) = force_tmp(iatom, :, i)-fab*hmat(i, idir)*forcea(:) - force_tmp(jatom, :, i) = force_tmp(jatom, :, i)-fab*hmat(i, idir)*forceb(:) + force_tmp(iatom, :, i) = force_tmp(iatom, :, i) - fab*hmat(i, idir)*forcea(:) + force_tmp(jatom, :, i) = force_tmp(jatom, :, i) - fab*hmat(i, idir)*forceb(:) END DO END DO CALL neighbor_list_iterator_release(nl_iterator) @@ -1060,16 +1060,16 @@ SUBROUTINE qs_dispfield_derivatives(qs_env, just_energy, calculate_forces) ! make sure the total normalized polarization is within [-1:1] DO idir = 1, 3 - cqi(idir) = rlog(idir)+zlog(idir) - IF (cqi(idir) > pi) cqi(idir) = cqi(idir)-twopi - IF (cqi(idir) < -pi) cqi(idir) = cqi(idir)+twopi + cqi(idir) = rlog(idir) + zlog(idir) + IF (cqi(idir) > pi) cqi(idir) = cqi(idir) - twopi + IF (cqi(idir) < -pi) cqi(idir) = cqi(idir) + twopi ! now check for log branch IF (calculate_forces) THEN - IF (ABS(efield%polarisation(idir)-cqi(idir)) > pi) THEN - di(idir) = (efield%polarisation(idir)-cqi(idir))/pi + IF (ABS(efield%polarisation(idir) - cqi(idir)) > pi) THEN + di(idir) = (efield%polarisation(idir) - cqi(idir))/pi DO i = 1, 10 - cqi(idir) = cqi(idir)+SIGN(1.0_dp, di(idir))*twopi - IF (ABS(efield%polarisation(idir)-cqi(idir)) < pi) EXIT + cqi(idir) = cqi(idir) + SIGN(1.0_dp, di(idir))*twopi + IF (ABS(efield%polarisation(idir) - cqi(idir)) < pi) EXIT END DO END IF END IF @@ -1078,7 +1078,7 @@ SUBROUTINE qs_dispfield_derivatives(qs_env, just_energy, calculate_forces) qi(idir) = 0.0_dp ci(idir) = 0.0_dp DO i = 1, 3 - ci(idir) = ci(idir)+hmat(idir, i)*cqi(i) + ci(idir) = ci(idir) + hmat(idir, i)*cqi(i) END DO END DO @@ -1086,7 +1086,7 @@ SUBROUTINE qs_dispfield_derivatives(qs_env, just_energy, calculate_forces) IF (calculate_forces) THEN ener_field = SUM(ci) ! check for smoothness of energy surface - IF (ABS(efield%field_energy-ener_field) > pi*ABS(SUM(hmat))) THEN + IF (ABS(efield%field_energy - ener_field) > pi*ABS(SUM(hmat))) THEN CPWARN("Large change of e-field energy detected. Correct for non-smooth energy surface") END IF efield%field_energy = ener_field @@ -1096,13 +1096,13 @@ SUBROUTINE qs_dispfield_derivatives(qs_env, just_energy, calculate_forces) ! Energy ener_field = 0.0_dp DO i = 1, 3 - ener_field = ener_field+dfilter(i)*(fieldpol(i)-2._dp*twopi*ci(i))**2 + ener_field = ener_field + dfilter(i)*(fieldpol(i) - 2._dp*twopi*ci(i))**2 END DO energy%efield = 0.25_dp*omega/twopi*ener_field IF (.NOT. just_energy) THEN DO i = 1, 3 - di(i) = -omega*(fieldpol(i)-2._dp*twopi*ci(i))*dfilter(i) + di(i) = -omega*(fieldpol(i) - 2._dp*twopi*ci(i))*dfilter(i) END DO ! Add the result to mo_derivativs DO ispin = 1, dft_control%nspins @@ -1122,7 +1122,7 @@ SUBROUTINE qs_dispfield_derivatives(qs_env, just_energy, calculate_forces) DO ia = 1, natom CALL get_atomic_kind(particle_set(ia)%atomic_kind, kind_number=ikind) iatom = atom_of_kind(ia) - force(ikind)%efield(1:3, iatom) = force(ikind)%efield(1:3, iatom)+di(i)*force_tmp(ia, 1:3, i) + force(ikind)%efield(1:3, iatom) = force(ikind)%efield(1:3, iatom) + di(i)*force_tmp(ia, 1:3, i) END DO END DO END IF diff --git a/src/qs_efield_local.F b/src/qs_efield_local.F index 370d144776..5badd977f7 100644 --- a/src/qs_efield_local.F +++ b/src/qs_efield_local.F @@ -209,14 +209,14 @@ SUBROUTINE qs_efield_mo_derivatives(qs_env, rpoint, just_energy, calculate_force DO ia = 1, natom CALL get_atomic_kind(particle_set(ia)%atomic_kind, kind_number=ikind) CALL get_qs_kind(qs_kind_set(ikind), core_charge=charge) - ria = particle_set(ia)%r-rpoint + ria = particle_set(ia)%r - rpoint ria = pbc(ria, cell) - ci(:) = ci(:)+charge*ria(:) + ci(:) = ci(:) + charge*ria(:) IF (calculate_forces) THEN IF (para_env%mepos == 0) THEN iatom = atom_of_kind(ia) DO idir = 1, 3 - force(ikind)%efield(idir, iatom) = force(ikind)%efield(idir, iatom)-fieldpol(idir)*charge + force(ikind)%efield(idir, iatom) = force(ikind)%efield(idir, iatom) - fieldpol(idir)*charge END DO END IF END IF @@ -231,7 +231,7 @@ SUBROUTINE qs_efield_mo_derivatives(qs_env, rpoint, just_energy, calculate_force DO ispin = 1, SIZE(matrix_p) DO idir = 1, 3 CALL dbcsr_dot(matrix_p(ispin)%matrix, dipmat(idir)%matrix, tmp) - ener_field = ener_field+fieldpol(idir)*tmp + ener_field = ener_field + fieldpol(idir)*tmp END DO END DO energy%efield = ener_field @@ -298,10 +298,10 @@ SUBROUTINE qs_efield_mo_derivatives(qs_env, rpoint, just_energy, calculate_force atom_a = atom_of_kind(iatom) atom_b = atom_of_kind(jatom) - ra(:) = particle_set(iatom)%r(:)-rpoint(:) + ra(:) = particle_set(iatom)%r(:) - rpoint(:) rac(:) = pbc(ra(:), cell) - rbc(:) = rac(:)+rab(:) - dab = SQRT(rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3)) + rbc(:) = rac(:) + rab(:) + dab = SQRT(rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3)) IF (iatom <= jatom) THEN irow = iatom @@ -332,7 +332,7 @@ SUBROUTINE qs_efield_mo_derivatives(qs_env, rpoint, just_energy, calculate_force ncoa = npgfa(iset)*ncoset(la_max(iset)) sgfa = first_sgfa(1, iset) DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) ! Calculate the primitive integrals (da|O|b) and (a|O|db) @@ -373,9 +373,9 @@ SUBROUTINE qs_efield_mo_derivatives(qs_env, rpoint, just_energy, calculate_force DO idir = 1, 3 force(ikind)%efield(1:3, atom_a) = force(ikind)%efield(1:3, atom_a) & - +fdir*fieldpol(idir)*forcea(idir, 1:3) + + fdir*fieldpol(idir)*forcea(idir, 1:3) force(jkind)%efield(1:3, atom_b) = force(jkind)%efield(1:3, atom_b) & - +fdir*fieldpol(idir)*forceb(idir, 1:3) + + fdir*fieldpol(idir)*forceb(idir, 1:3) END DO END DO diff --git a/src/qs_elec_field.F b/src/qs_elec_field.F index 50cf17049c..e683231c1a 100644 --- a/src/qs_elec_field.F +++ b/src/qs_elec_field.F @@ -129,10 +129,10 @@ SUBROUTINE build_efg_matrix(qs_env, matrix_efg, rc) maxlgto=maxlgto, & maxsgf=maxsgf) - ldai = ncoset(maxlgto+2) + ldai = ncoset(maxlgto + 2) CALL init_orbital_pointers(ldai) - ALLOCATE (rr_work(0:2*maxlgto+4, ldai, ldai)) + ALLOCATE (rr_work(0:2*maxlgto + 4, ldai, ldai)) ALLOCATE (efgab(maxco, maxco, 6)) @@ -188,11 +188,11 @@ SUBROUTINE build_efg_matrix(qs_env, matrix_efg, rc) IF (inode == 1) last_jatom = 0 - rb = rab+ra - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rb = rab + ra + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) dab = SQRT(rab2) rac = pbc(ra, rc, cell) - rbc = rac-rab + rbc = rac - rab IF (jatom /= last_jatom) THEN new_atom_b = .TRUE. @@ -224,7 +224,7 @@ SUBROUTINE build_efg_matrix(qs_env, matrix_efg, rc) DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) diff --git a/src/qs_electric_field_gradient.F b/src/qs_electric_field_gradient.F index 03b50ad5ca..8635c837b0 100644 --- a/src/qs_electric_field_gradient.F +++ b/src/qs_electric_field_gradient.F @@ -232,7 +232,7 @@ SUBROUTINE qs_efg_calc(qs_env) DO i = 1, 3 DO j = 1, i - ij = (i*(i-1))/2+j + ij = (i*(i - 1))/2 + j CALL pw_pool_create_pw(auxbas_pw_pool, dvr2(ij)%pw, & use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) CALL pw_dr2(v_hartree_gspace%pw, dvr2(ij)%pw, i, j) @@ -286,12 +286,12 @@ SUBROUTINE qs_efg_calc(qs_env) IF (efg_interpolation) THEN DO i = 1, 3 DO j = 1, i - ij = (i*(i-1))/2+j + ij = (i*(i - 1))/2 + j efg_val = Eval_Interp_Spl3_pbc(ra, dvspl(ij)%pw) efg_tensor(i, j, iatom) = -efg_val efg_tensor(j, i, iatom) = efg_tensor(i, j, iatom) IF (efg_debug) THEN - chk_spl = chk_spl+efg_val+ & + chk_spl = chk_spl + efg_val + & SUM(Eval_d_Interp_Spl3_pbc(ra, dvspl(ij)%pw)) END IF END DO @@ -300,7 +300,7 @@ SUBROUTINE qs_efg_calc(qs_env) CALL pw_structure_factor(structure_factor%pw, ra) DO i = 1, 3 DO j = 1, i - ij = (i*(i-1))/2+j + ij = (i*(i - 1))/2 + j efg_tensor(i, j, iatom) = -pw_integral_ab(dvr2(ij)%pw, structure_factor%pw) efg_tensor(j, i, iatom) = efg_tensor(i, j, iatom) END DO @@ -318,16 +318,16 @@ SUBROUTINE qs_efg_calc(qs_env) DO iat = 1, natomkind iatom = atom_list(iat) efg_tensor(1, 1, iatom) = efg_tensor(1, 1, iatom) & - +f1*(vh0(iatom, 2))-f2*(vh0(iatom, 0)) + + f1*(vh0(iatom, 2)) - f2*(vh0(iatom, 0)) efg_tensor(2, 2, iatom) = efg_tensor(2, 2, iatom) & - -f1*(vh0(iatom, 2))-f2*(vh0(iatom, 0)) - efg_tensor(3, 3, iatom) = efg_tensor(3, 3, iatom)+2._dp*f2*(vh0(iatom, 0)) - efg_tensor(1, 2, iatom) = efg_tensor(1, 2, iatom)+f1*(vh0(iatom, -2)) - efg_tensor(2, 1, iatom) = efg_tensor(2, 1, iatom)+f1*(vh0(iatom, -2)) - efg_tensor(1, 3, iatom) = efg_tensor(1, 3, iatom)+f1*(vh0(iatom, 1)) - efg_tensor(3, 1, iatom) = efg_tensor(3, 1, iatom)+f1*(vh0(iatom, 1)) - efg_tensor(2, 3, iatom) = efg_tensor(2, 3, iatom)+f1*(vh0(iatom, -1)) - efg_tensor(3, 2, iatom) = efg_tensor(3, 2, iatom)+f1*(vh0(iatom, -1)) + - f1*(vh0(iatom, 2)) - f2*(vh0(iatom, 0)) + efg_tensor(3, 3, iatom) = efg_tensor(3, 3, iatom) + 2._dp*f2*(vh0(iatom, 0)) + efg_tensor(1, 2, iatom) = efg_tensor(1, 2, iatom) + f1*(vh0(iatom, -2)) + efg_tensor(2, 1, iatom) = efg_tensor(2, 1, iatom) + f1*(vh0(iatom, -2)) + efg_tensor(1, 3, iatom) = efg_tensor(1, 3, iatom) + f1*(vh0(iatom, 1)) + efg_tensor(3, 1, iatom) = efg_tensor(3, 1, iatom) + f1*(vh0(iatom, 1)) + efg_tensor(2, 3, iatom) = efg_tensor(2, 3, iatom) + f1*(vh0(iatom, -1)) + efg_tensor(3, 2, iatom) = efg_tensor(3, 2, iatom) + f1*(vh0(iatom, -1)) END DO END IF @@ -351,7 +351,7 @@ SUBROUTINE qs_efg_calc(qs_env) WRITE (UNIT=unit_nr, FMT="(T2,I5,T8,A,T12,A,T15,6F11.5)") & iatom, element_symbol, "PW", ((efg_pw(i, j, iatom), i=1, j), j=1, 3) WRITE (UNIT=unit_nr, FMT="(T12,A,T15,6F11.5)") & - "AT", ((efg_tensor(i, j, iatom)-efg_pw(i, j, iatom), i=1, j), j=1, 3) + "AT", ((efg_tensor(i, j, iatom) - efg_pw(i, j, iatom), i=1, j), j=1, 3) END IF ENDDO IF (unit_nr > 0) THEN @@ -375,7 +375,7 @@ SUBROUTINE qs_efg_calc(qs_env) WRITE (UNIT=unit_nr, FMT="(T12,A,T39,3F14.7)") & "EFG Tensor eigenvalues", efg_diagval(:, iatom) WRITE (UNIT=unit_nr, FMT="(T12,A,T67,F14.7)") "EFG Tensor anisotropy", & - (efg_diagval(1, iatom)-efg_diagval(2, iatom))/efg_diagval(3, iatom) + (efg_diagval(1, iatom) - efg_diagval(2, iatom))/efg_diagval(3, iatom) WRITE (UNIT=unit_nr, FMT=*) END IF ENDDO @@ -483,27 +483,27 @@ SUBROUTINE vlimit_atom(para_env, vlimit, rho_atom_set, qs_kind, & n1s = nsoset(lmax(iset1)) DO ipgf1 = 1, npgf(iset1) - iso1_first = nsoset(lmin(iset1)-1)+1+n1s*(ipgf1-1)+m1s - iso1_last = nsoset(lmax(iset1))+n1s*(ipgf1-1)+m1s - size1 = iso1_last-iso1_first+1 + iso1_first = nsoset(lmin(iset1) - 1) + 1 + n1s*(ipgf1 - 1) + m1s + iso1_last = nsoset(lmax(iset1)) + n1s*(ipgf1 - 1) + m1s + size1 = iso1_last - iso1_first + 1 iso1_first = o2nindex(iso1_first) iso1_last = o2nindex(iso1_last) - i1 = iso1_last-iso1_first+1 + i1 = iso1_last - iso1_first + 1 CPASSERT(size1 == i1) - i1 = nsoset(lmin(iset1)-1)+1 + i1 = nsoset(lmin(iset1) - 1) + 1 n2s = nsoset(lmax(iset2)) DO ipgf2 = 1, npgf(iset2) - iso2_first = nsoset(lmin(iset2)-1)+1+n2s*(ipgf2-1)+m2s - iso2_last = nsoset(lmax(iset2))+n2s*(ipgf2-1)+m2s - size2 = iso2_last-iso2_first+1 + iso2_first = nsoset(lmin(iset2) - 1) + 1 + n2s*(ipgf2 - 1) + m2s + iso2_last = nsoset(lmax(iset2)) + n2s*(ipgf2 - 1) + m2s + size2 = iso2_last - iso2_first + 1 iso2_first = o2nindex(iso2_first) iso2_last = o2nindex(iso2_last) - i2 = iso2_last-iso2_first+1 + i2 = iso2_last - iso2_first + 1 CPASSERT(size2 == i2) - i2 = nsoset(lmin(iset2)-1)+1 + i2 = nsoset(lmin(iset2) - 1) + 1 - zet12 = zet(ipgf1, iset1)+zet(ipgf2, iset2) + zet12 = zet(ipgf1, iset1) + zet(ipgf2, iset2) vgg = 0.0_dp @@ -513,9 +513,9 @@ SUBROUTINE vlimit_atom(para_env, vlimit, rho_atom_set, qs_kind, & DO icg = 1, cg_n_list(iso) iso1 = cg_list(1, icg, iso) iso2 = cg_list(2, icg, iso) - l = indso(1, iso1)+indso(1, iso2) + l = indso(1, iso1) + indso(1, iso2) IF (MOD(l, 2) == 0 .AND. l > 0) THEN - vgg(l/2) = fourpi/10._dp*fac(l-2)/zet12**(l/2) + vgg(l/2) = fourpi/10._dp*fac(l - 2)/zet12**(l/2) END IF END DO END DO @@ -526,12 +526,12 @@ SUBROUTINE vlimit_atom(para_env, vlimit, rho_atom_set, qs_kind, & CPC_sphere = 0.0_dp DO i = 1, nspins coeff => rho_atom_set(iatom)%cpc_h(i)%r_coef - CPC_sphere(i1:i1+size1-1, i2:i2+size2-1) = & - CPC_sphere(i1:i1+size1-1, i2:i2+size2-1)+ & + CPC_sphere(i1:i1 + size1 - 1, i2:i2 + size2 - 1) = & + CPC_sphere(i1:i1 + size1 - 1, i2:i2 + size2 - 1) + & coeff(iso1_first:iso1_last, iso2_first:iso2_last) coeff => rho_atom_set(iatom)%cpc_s(i)%r_coef - CPC_sphere(i1:i1+size1-1, i2:i2+size2-1) = & - CPC_sphere(i1:i1+size1-1, i2:i2+size2-1)- & + CPC_sphere(i1:i1 + size1 - 1, i2:i2 + size2 - 1) = & + CPC_sphere(i1:i1 + size1 - 1, i2:i2 + size2 - 1) - & coeff(iso1_first:iso1_last, iso2_first:iso2_last) ENDDO ! i @@ -542,9 +542,9 @@ SUBROUTINE vlimit_atom(para_env, vlimit, rho_atom_set, qs_kind, & DO icg = 1, cg_n_list(iso) iso1 = cg_list(1, icg, iso) iso2 = cg_list(2, icg, iso) - l = indso(1, iso1)+indso(1, iso2) + l = indso(1, iso1) + indso(1, iso2) IF (MOD(l, 2) == 0 .AND. l > 0) THEN - vlimit(iatom, m_iso) = vlimit(iatom, m_iso)+ & + vlimit(iatom, m_iso) = vlimit(iatom, m_iso) + & vgg(l/2)*CPC_sphere(iso1, iso2)*my_CG(iso1, iso2, iso) END IF ENDDO ! icg @@ -554,9 +554,9 @@ SUBROUTINE vlimit_atom(para_env, vlimit, rho_atom_set, qs_kind, & ENDDO ! ipgf2 ENDDO ! ipgf1 - m2s = m2s+maxso + m2s = m2s + maxso ENDDO ! iset2 - m1s = m1s+maxso + m1s = m1s + maxso ENDDO ! iset1 CALL mp_sum(vlimit, para_env%group) diff --git a/src/qs_elf_methods.F b/src/qs_elf_methods.F index 23134370a8..fb7756f49b 100644 --- a/src/qs_elf_methods.F +++ b/src/qs_elf_methods.F @@ -130,7 +130,7 @@ SUBROUTINE qs_elf_calc(qs_env, elf_r, rho_cutoff) IF (drho_r_valid) THEN DO idir = 1, 3 - drho_r(3*(ispin-1)+idir)%pw => drho_struct_r(3*(ispin-1)+idir)%pw + drho_r(3*(ispin - 1) + idir)%pw => drho_struct_r(3*(ispin - 1) + idir)%pw END DO ELSE deriv_pw = .FALSE. @@ -141,23 +141,23 @@ SUBROUTINE qs_elf_calc(qs_env, elf_r, rho_cutoff) use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) udvol = 1.0_dp/rho_struct_r(ispin)%pw%pw_grid%dvol DO idir = 1, 3 - CALL pw_pool_create_pw(auxbas_pw_pool, drho_r(3*(ispin-1)+idir)%pw, & + CALL pw_pool_create_pw(auxbas_pw_pool, drho_r(3*(ispin - 1) + idir)%pw, & use_data=REALDATA3D, in_space=REALSPACE) CALL pw_transfer(rho_struct_r(ispin)%pw, tmp_g) CALL pw_derive(tmp_g, nd(:, idir)) - CALL pw_transfer(tmp_g, drho_r(3*(ispin-1)+idir)%pw) + CALL pw_transfer(tmp_g, drho_r(3*(ispin - 1) + idir)%pw) END DO ELSE DO idir = 1, 3 - CALL pw_pool_create_pw(auxbas_pw_pool, drho_r(3*(ispin-1)+idir)%pw, & + CALL pw_pool_create_pw(auxbas_pw_pool, drho_r(3*(ispin - 1) + idir)%pw, & use_data=REALDATA3D, in_space=REALSPACE) - CALL pw_pool_create_pw(auxbas_pw_pool, drho_g(3*(ispin-1)+idir)%pw, & + CALL pw_pool_create_pw(auxbas_pw_pool, drho_g(3*(ispin - 1) + idir)%pw, & use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) rho_ao => rho_struct_ao(ispin, :) CALL calculate_rho_elec(matrix_p_kp=rho_ao, & - rho=drho_r(3*(ispin-1)+idir), & - rho_gspace=drho_g(3*(ispin-1)+idir), & + rho=drho_r(3*(ispin - 1) + idir), & + rho_gspace=drho_g(3*(ispin - 1) + idir), & total_rho=dum, & ks_env=ks_env, soft_valid=.FALSE., & compute_tau=.FALSE., compute_grad=.TRUE., idir=idir) @@ -172,14 +172,14 @@ SUBROUTINE qs_elf_calc(qs_env, elf_r, rho_cutoff) DO k = bo(1, 3), bo(2, 3) DO j = bo(1, 2), bo(2, 2) DO i = bo(1, 1), bo(2, 1) - norm_drho = drho_r(3*(ispin-1)+1)%pw%cr3d(i, j, k)**2+ & - drho_r(3*(ispin-1)+2)%pw%cr3d(i, j, k)**2+ & - drho_r(3*(ispin-1)+3)%pw%cr3d(i, j, k)**2 + norm_drho = drho_r(3*(ispin - 1) + 1)%pw%cr3d(i, j, k)**2 + & + drho_r(3*(ispin - 1) + 2)%pw%cr3d(i, j, k)**2 + & + drho_r(3*(ispin - 1) + 3)%pw%cr3d(i, j, k)**2 norm_drho = norm_drho/MAX(rho_r(ispin)%pw%cr3d(i, j, k), rho_cutoff) rho_53 = cfermi*MAX(rho_r(ispin)%pw%cr3d(i, j, k), rho_cutoff)**f53 - elf_kernel = (tau_r(ispin)%pw%cr3d(i, j, k)-f18*norm_drho)+2.87E-5_dp + elf_kernel = (tau_r(ispin)%pw%cr3d(i, j, k) - f18*norm_drho) + 2.87E-5_dp elf_kernel = (elf_kernel/rho_53)**2 - elf_r(ispin)%pw%cr3d(i, j, k) = 1.0_dp/(1.0_dp+elf_kernel) + elf_r(ispin)%pw%cr3d(i, j, k) = 1.0_dp/(1.0_dp + elf_kernel) IF (elf_r(ispin)%pw%cr3d(i, j, k) < ELFCUT) elf_r(ispin)%pw%cr3d(i, j, k) = 0.0_dp END DO END DO @@ -193,12 +193,12 @@ SUBROUTINE qs_elf_calc(qs_env, elf_r, rho_cutoff) IF (deriv_pw) THEN CALL pw_pool_give_back_pw(auxbas_pw_pool, tmp_g) DO idir = 1, 3 - CALL pw_pool_give_back_pw(auxbas_pw_pool, drho_r(3*(ispin-1)+idir)%pw) + CALL pw_pool_give_back_pw(auxbas_pw_pool, drho_r(3*(ispin - 1) + idir)%pw) END DO ELSE DO idir = 1, 3 - CALL pw_pool_give_back_pw(auxbas_pw_pool, drho_r(3*(ispin-1)+idir)%pw) - CALL pw_pool_give_back_pw(auxbas_pw_pool, drho_g(3*(ispin-1)+idir)%pw) + CALL pw_pool_give_back_pw(auxbas_pw_pool, drho_r(3*(ispin - 1) + idir)%pw) + CALL pw_pool_give_back_pw(auxbas_pw_pool, drho_g(3*(ispin - 1) + idir)%pw) END DO END IF END IF diff --git a/src/qs_energy.F b/src/qs_energy.F index fd836d3309..678878545b 100644 --- a/src/qs_energy.F +++ b/src/qs_energy.F @@ -103,7 +103,7 @@ SUBROUTINE qs_energies(qs_env, consistent_energies, calc_forces) CALL qs_ks_update_qs_env(qs_env, calculate_forces=.FALSE., just_energy=.TRUE.) ! add MP2 energy if necessary IF (ASSOCIATED(qs_env%mp2_env)) THEN - energy%total = energy%total+energy%mp2 + energy%total = energy%total + energy%mp2 END IF END IF END IF diff --git a/src/qs_energy_utils.F b/src/qs_energy_utils.F index f0233a3da2..e255d07b00 100644 --- a/src/qs_energy_utils.F +++ b/src/qs_energy_utils.F @@ -387,8 +387,8 @@ SUBROUTINE atom_trace(amat, bmat, factor, atrace) mult = 1.0_dp ENDIF btr = factor*mult*SUM(a_block*b_block) - atrace(iblock_row) = atrace(iblock_row)+btr - atrace(iblock_col) = atrace(iblock_col)+btr + atrace(iblock_row) = atrace(iblock_row) + btr + atrace(iblock_col) = atrace(iblock_col) + btr ENDDO CALL dbcsr_iterator_stop(iter) diff --git a/src/qs_energy_window.F b/src/qs_energy_window.F index 7818bbfa37..6f2c5ec346 100644 --- a/src/qs_energy_window.F +++ b/src/qs_energy_window.F @@ -182,10 +182,10 @@ SUBROUTINE energy_windows(qs_env) !diagonalize the full ks matrix CALL choose_eigv_solver(matrix_ks_fm, eigenvectors, eigenvalues) - fermi_level = eigenvalues((nelectron_total+MOD(nelectron_total, 2))/2) + fermi_level = eigenvalues((nelectron_total + MOD(nelectron_total, 2))/2) IF (restrict_range) THEN - lower_bound = MAX(fermi_level-energy_range, eigenvalues(1)) - upper_bound = MIN(fermi_level+energy_range, eigenvalues(SIZE(eigenvalues))) + lower_bound = MAX(fermi_level - energy_range, eigenvalues(1)) + upper_bound = MIN(fermi_level + energy_range, eigenvalues(SIZE(eigenvalues))) ELSE lower_bound = eigenvalues(1) upper_bound = eigenvalues(SIZE(eigenvalues)) @@ -237,7 +237,7 @@ SUBROUTINE energy_windows(qs_env) CALL choose_eigv_solver(P_window_fm, window_eigenvectors, window_eigenvalues) DO i = 1, nao IF (unit_nr > 0) THEN - WRITE (unit_nr, *) i, "H:", eigenvalues(i), "P:", P_eigenvalues(nao-i+1), "Pnew:", window_eigenvalues(nao-i+1) + WRITE (unit_nr, *) i, "H:", eigenvalues(i), "P:", P_eigenvalues(nao - i + 1), "Pnew:", window_eigenvalues(nao - i + 1) ENDIF END DO DEALLOCATE (P_eigenvalues) @@ -249,31 +249,31 @@ SUBROUTINE energy_windows(qs_env) END IF !create energy windows - bin_width = (upper_bound-lower_bound)/nwindows + bin_width = (upper_bound - lower_bound)/nwindows next = 0 DO i = 1, nwindows - DO WHILE (eigenvalues(next+1) < lower_bound) - next = next+1 + DO WHILE (eigenvalues(next + 1) < lower_bound) + next = next + 1 END DO last = next - DO WHILE (eigenvalues(next+1) < lower_bound+i*bin_width) - next = next+1 + DO WHILE (eigenvalues(next + 1) < lower_bound + i*bin_width) + next = next + 1 IF (next == SIZE(eigenvalues)) EXIT END DO !calculate the occupation !not sure how bad this is now load balanced due to using the same blacs_env - CALL cp_fm_struct_create(fmstruct=window_fm_struct, context=blacs_env, nrow_global=nao, ncol_global=next-last) + CALL cp_fm_struct_create(fmstruct=window_fm_struct, context=blacs_env, nrow_global=nao, ncol_global=next - last) CALL cp_fm_create(window_fm, window_fm_struct) !copy the mos in the energy window into a separate matrix - CALL cp_fm_to_fm(eigenvectors, window_fm, next-last, last+1, 1) - CALL cp_gemm("N", "T", nao, nao, next-last, one, window_fm, window_fm, zero, P_window_fm) + CALL cp_fm_to_fm(eigenvectors, window_fm, next - last, last + 1, 1) + CALL cp_gemm("N", "T", nao, nao, next - last, one, window_fm, window_fm, zero, P_window_fm) CALL cp_fm_trace(P_window_fm, rho_ao_ortho_fm, occupation) IF (print_cube) THEN - CALL cp_fm_to_fm(eigenvectors_nonorth, window_fm, next-last, last+1, 1) + CALL cp_fm_to_fm(eigenvectors_nonorth, window_fm, next - last, last + 1, 1) !print the energy window to a cube file !calculate the density caused by the mos in the energy window - CALL cp_gemm("N", "T", nao, nao, next-last, one, window_fm, window_fm, zero, P_window_fm) + CALL cp_gemm("N", "T", nao, nao, next - last, one, window_fm, window_fm, zero, P_window_fm) CALL copy_fm_to_dbcsr(P_window_fm, tmp) !ensure the correct sparsity CALL dbcsr_copy(window, matrix_ks(1)%matrix) @@ -294,12 +294,12 @@ SUBROUTINE energy_windows(qs_env) "PRINT%ENERGY_WINDOWS", mpi_io=mpi_io) density_ewindow_total = pw_integrate_function(rho_r%pw) IF (unit_nr > 0) WRITE (unit_nr, "(A,F16.10,A,I5,A,F20.14,A,F20.14)") " Energy Level: ", & - lower_bound+(i-0.5_dp)*bin_width, " Number of states: ", next-last, " Occupation: ", & + lower_bound + (i - 0.5_dp)*bin_width, " Number of states: ", next - last, " Occupation: ", & occupation, " Grid Density ", density_ewindow_total ELSE IF (unit_nr > 0) THEN - WRITE (unit_nr, "(A,F16.10,A,I5,A,F20.14)") " Energy Level: ", lower_bound+(i-0.5_dp)*bin_width, & - " Number of states: ", next-last, " Occupation: ", occupation + WRITE (unit_nr, "(A,F16.10,A,I5,A,F20.14)") " Energy Level: ", lower_bound + (i - 0.5_dp)*bin_width, & + " Number of states: ", next - last, " Occupation: ", occupation END IF END IF CALL cp_fm_release(window_fm) diff --git a/src/qs_environment.F b/src/qs_environment.F index 15079df167..7f15b66e4b 100644 --- a/src/qs_environment.F +++ b/src/qs_environment.F @@ -685,7 +685,7 @@ SUBROUTINE qs_init_subsys(qs_env, para_env, subsys, cell, cell_ref, use_ref_cell CALL get_potential(qs_kind%all_potential, alpha_core_charge=alpha) ccore = qs_kind%xtb_parameter%zeff*SQRT((alpha/pi)**3) CALL set_potential(qs_kind%all_potential, ccore_charge=ccore) - qs_kind%xtb_parameter%zeff = qs_kind%xtb_parameter%zeff-zeff_correction + qs_kind%xtb_parameter%zeff = qs_kind%xtb_parameter%zeff - zeff_correction END DO ! ! check for Ewald @@ -832,7 +832,7 @@ SUBROUTINE qs_init_subsys(qs_env, para_env, subsys, cell, cell_ref, use_ref_cell CALL get_qs_kind_set(qs_kind_set, maxlgto=maxlgto_lri, basis_type="RI_XAS") maxlgto = MAX(maxlgto, maxlgto_lri) END IF - maxl = MAX(2*maxlgto, maxlppl, maxlppnl, lmax_sphere)+1 + maxl = MAX(2*maxlgto, maxlppl, maxlppnl, lmax_sphere) + 1 CALL init_orbital_pointers(maxl) @@ -851,7 +851,7 @@ SUBROUTINE qs_init_subsys(qs_env, para_env, subsys, cell, cell_ref, use_ref_cell ! *** Initialize the pretabulation for the calculation of the *** ! *** incomplete Gamma function F_n(t) after McMurchie-Davidson *** CALL get_qs_kind_set(qs_kind_set, maxlgto=maxlgto) - maxl = MAX(3*maxlgto+1, 0) + maxl = MAX(3*maxlgto + 1, 0) CALL init_md_ftable(maxl) ! *** Initialize the atomic interaction radii *** @@ -1187,7 +1187,7 @@ SUBROUTINE qs_init_subsys(qs_env, para_env, subsys, cell, cell_ref, use_ref_cell CALL get_qs_kind_set(qs_kind_set, nsgf=n_ao, nelectron=nelectron) ! the total number of electrons - nelectron = nelectron-dft_control%charge + nelectron = nelectron - dft_control%charge IF (dft_control%multiplicity == 0) THEN IF (MODULO(nelectron, 2) == 0) THEN @@ -1232,11 +1232,11 @@ SUBROUTINE qs_init_subsys(qs_env, para_env, subsys, cell, cell_ref, use_ref_cell n_mo(1) = 1 n_mo(2) = 0 ELSE - IF (MODULO(nelectron+multiplicity-1, 2) /= 0) THEN + IF (MODULO(nelectron + multiplicity - 1, 2) /= 0) THEN CPABORT("LSD: try to use a different multiplicity") END IF - nelectron_spin(1) = (nelectron+multiplicity-1)/2 - nelectron_spin(2) = (nelectron-multiplicity+1)/2 + nelectron_spin(1) = (nelectron + multiplicity - 1)/2 + nelectron_spin(2) = (nelectron - multiplicity + 1)/2 IF (nelectron_spin(1) < 0) THEN CPABORT("LSD: too few electrons for this multiplicity") END IF @@ -1254,7 +1254,7 @@ SUBROUTINE qs_init_subsys(qs_env, para_env, subsys, cell, cell_ref, use_ref_cell IF (MODULO(nelectron, 2) == 0) THEN n_mo(1) = nelectron/2 ELSE - n_mo(1) = INT(nelectron/2._dp)+1 + n_mo(1) = INT(nelectron/2._dp) + 1 END IF n_mo(2) = 0 ELSE @@ -1262,12 +1262,12 @@ SUBROUTINE qs_init_subsys(qs_env, para_env, subsys, cell, cell_ref, use_ref_cell ! The simplist spin distribution is written here. Special cases will ! need additional user input - IF (MODULO(nelectron+multiplicity-1, 2) /= 0) THEN + IF (MODULO(nelectron + multiplicity - 1, 2) /= 0) THEN CPABORT("LSD: try to use a different multiplicity") END IF - nelectron_spin(1) = (nelectron+multiplicity-1)/2 - nelectron_spin(2) = (nelectron-multiplicity+1)/2 + nelectron_spin(1) = (nelectron + multiplicity - 1)/2 + nelectron_spin(2) = (nelectron - multiplicity + 1)/2 IF (nelectron_spin(2) < 0) THEN CPABORT("LSD: too few electrons for this multiplicity") @@ -1292,10 +1292,10 @@ SUBROUTINE qs_init_subsys(qs_env, para_env, subsys, cell, cell_ref, use_ref_cell ELSE n_mo_add = scf_control%added_mos(1) END IF - IF (n_mo_add > n_ao-n_mo(2)) & + IF (n_mo_add > n_ao - n_mo(2)) & CPWARN("More added MOs requested for beta spin than available.") - scf_control%added_mos(2) = MIN(n_mo_add, n_ao-n_mo(2)) - n_mo(2) = n_mo(2)+scf_control%added_mos(2) + scf_control%added_mos(2) = MIN(n_mo_add, n_ao - n_mo(2)) + n_mo(2) = n_mo(2) + scf_control%added_mos(2) END IF ! proceed alpha orbitals after the beta orbitals; this is essential to avoid @@ -1306,12 +1306,12 @@ SUBROUTINE qs_init_subsys(qs_env, para_env, subsys, cell, cell_ref, use_ref_cell ! However, if we try to proceed alpha orbitals first, this leads us n_mo(1:2) = (10,8) ! due to the following assignment instruction above: ! IF (scf_control%added_mos(2) > 0) THEN ... ELSE; n_mo_add = scf_control%added_mos(1); END IF - IF (scf_control%added_mos(1) > n_ao-n_mo(1)) & + IF (scf_control%added_mos(1) > n_ao - n_mo(1)) & CALL cp_warn(__LOCATION__, & "More added MOs requested than available. "// & "The full set of unoccupied MOs will be used.") - scf_control%added_mos(1) = MIN(scf_control%added_mos(1), n_ao-n_mo(1)) - n_mo(1) = n_mo(1)+scf_control%added_mos(1) + scf_control%added_mos(1) = MIN(scf_control%added_mos(1), n_ao - n_mo(1)) + n_mo(1) = n_mo(1) + scf_control%added_mos(1) IF (dft_control%nspins == 2) THEN IF (n_mo(2) > n_mo(1)) & @@ -1532,7 +1532,7 @@ SUBROUTINE write_total_numbers(qs_kind_set, particle_set, force_env_section) WRITE (UNIT=output_unit, FMT="(/,/,T2,A)") & "TOTAL NUMBERS AND MAXIMUM NUMBERS" - IF (nset+npgf+ncgf > 0) THEN + IF (nset + npgf + ncgf > 0) THEN WRITE (UNIT=output_unit, FMT="(/,T3,A,(T30,A,T71,I10))") & "Total number of", & "- Atomic kinds: ", nkind, & @@ -1542,7 +1542,7 @@ SUBROUTINE write_total_numbers(qs_kind_set, particle_set, force_env_section) "- Primitive Cartesian functions: ", npgf, & "- Cartesian basis functions: ", ncgf, & "- Spherical basis functions: ", nsgf - ELSE IF (nshell+nsgf > 0) THEN + ELSE IF (nshell + nsgf > 0) THEN WRITE (UNIT=output_unit, FMT="(/,T3,A,(T30,A,T71,I10))") & "Total number of", & "- Atomic kinds: ", nkind, & @@ -1581,7 +1581,7 @@ SUBROUTINE write_total_numbers(qs_kind_set, particle_set, force_env_section) nsgf=nsgf, & nshell=nshell, & basis_type="LRI_AUX") - IF (nset+npgf+ncgf > 0) THEN + IF (nset + npgf + ncgf > 0) THEN WRITE (UNIT=output_unit, FMT="(/,T3,A,/,T3,A,(T30,A,T71,I10))") & "LRI_AUX Basis: ", & "Total number of", & @@ -1603,7 +1603,7 @@ SUBROUTINE write_total_numbers(qs_kind_set, particle_set, force_env_section) nsgf=nsgf, & nshell=nshell, & basis_type="RI_HXC") - IF (nset+npgf+ncgf > 0) THEN + IF (nset + npgf + ncgf > 0) THEN WRITE (UNIT=output_unit, FMT="(/,T3,A,/,T3,A,(T30,A,T71,I10))") & "RI_HXC Basis: ", & "Total number of", & @@ -1625,7 +1625,7 @@ SUBROUTINE write_total_numbers(qs_kind_set, particle_set, force_env_section) nsgf=nsgf, & nshell=nshell, & basis_type="AUX_FIT") - IF (nset+npgf+ncgf > 0) THEN + IF (nset + npgf + ncgf > 0) THEN WRITE (UNIT=output_unit, FMT="(/,T3,A,/,T3,A,(T30,A,T71,I10))") & "AUX_FIT ADMM-Basis: ", & "Total number of", & diff --git a/src/qs_environment_types.F b/src/qs_environment_types.F index 36ae9b2ad9..f588b1dac6 100644 --- a/src/qs_environment_types.F +++ b/src/qs_environment_types.F @@ -928,7 +928,7 @@ SUBROUTINE init_qs_env(qs_env, globenv) CALL local_rho_set_create(qs_env%local_rho_set) CALL hartree_local_create(qs_env%hartree_local) qs_env%ref_count = 1 - last_qs_env_id_nr = last_qs_env_id_nr+1 + last_qs_env_id_nr = last_qs_env_id_nr + 1 qs_env%id_nr = last_qs_env_id_nr qs_env%run_rtp = .FALSE. qs_env%linres_run = .FALSE. @@ -1332,7 +1332,7 @@ SUBROUTINE qs_env_retain(qs_env) CPASSERT(ASSOCIATED(qs_env)) CPASSERT(qs_env%ref_count > 0) - qs_env%ref_count = qs_env%ref_count+1 + qs_env%ref_count = qs_env%ref_count + 1 END SUBROUTINE qs_env_retain ! ************************************************************************************************** @@ -1352,7 +1352,7 @@ SUBROUTINE qs_env_release(qs_env) IF (ASSOCIATED(qs_env)) THEN CPASSERT(qs_env%ref_count > 0) - qs_env%ref_count = qs_env%ref_count-1 + qs_env%ref_count = qs_env%ref_count - 1 IF (qs_env%ref_count < 1) THEN CALL cell_release(qs_env%super_cell) IF (ASSOCIATED(qs_env%mos)) THEN diff --git a/src/qs_epr_hyp.F b/src/qs_epr_hyp.F index 90d1103962..c521b374c3 100644 --- a/src/qs_epr_hyp.F +++ b/src/qs_epr_hyp.F @@ -188,8 +188,8 @@ SUBROUTINE qs_epr_hyp_calc(qs_env) ! Non-relativistic isotropic hyperfine value (hypiso_one) DO ia = 1, grid_atom%ng_sphere DO iso = 1, harmonics%max_iso_not0 - hypiso_one(iatom) = hypiso_one(iatom)+ & - (rho_rad_h(1)%r_coef(grid_atom%nr, iso)- & + hypiso_one(iatom) = hypiso_one(iatom) + & + (rho_rad_h(1)%r_coef(grid_atom%nr, iso) - & rho_rad_h(2)%r_coef(grid_atom%nr, iso))* & harmonics%slm(ia, iso)*grid_atom%wa(ia)/fourpi END DO @@ -201,36 +201,36 @@ SUBROUTINE qs_epr_hyp_calc(qs_env) DO ia = 1, grid_atom%ng_sphere hypanisotemp = 0.0_dp DO iso = 1, harmonics%max_iso_not0 - hypiso(iatom) = hypiso(iatom)+ & - (rho_rad_h(1)%r_coef(ir, iso)-rho_rad_h(2)%r_coef(ir, iso))* & + hypiso(iatom) = hypiso(iatom) + & + (rho_rad_h(1)%r_coef(ir, iso) - rho_rad_h(2)%r_coef(ir, iso))* & harmonics%slm(ia, iso)*grid_atom%wr(ir)*grid_atom%wa(ia)* & 2._dp/(REAL(z, KIND=dp)*a_fine**2* & - (1._dp+2._dp*grid_atom%rad(ir)/(REAL(z, KIND=dp)*a_fine**2))**2* & + (1._dp + 2._dp*grid_atom%rad(ir)/(REAL(z, KIND=dp)*a_fine**2))**2* & fourpi*grid_atom%rad(ir)**2) - hypanisotemp = hypanisotemp+ & - (rho_rad_h(1)%r_coef(ir, iso)-rho_rad_h(2)%r_coef(ir, iso) & - -(rho_rad_s(1)%r_coef(ir, iso)-rho_rad_s(2)%r_coef(ir, iso)))* & + hypanisotemp = hypanisotemp + & + (rho_rad_h(1)%r_coef(ir, iso) - rho_rad_h(2)%r_coef(ir, iso) & + - (rho_rad_s(1)%r_coef(ir, iso) - rho_rad_s(2)%r_coef(ir, iso)))* & harmonics%slm(ia, iso)*grid_atom%wr(ir)*grid_atom%wa(ia)/ & grid_atom%rad(ir)**3 END DO ! iso - hypaniso(1, 1, iatom) = hypaniso(1, 1, iatom)+hypanisotemp* & + hypaniso(1, 1, iatom) = hypaniso(1, 1, iatom) + hypanisotemp* & (3._dp*grid_atom%sin_pol(ia)*grid_atom%cos_azi(ia)* & - grid_atom%sin_pol(ia)*grid_atom%cos_azi(ia)-1._dp) - hypaniso(1, 2, iatom) = hypaniso(1, 2, iatom)+hypanisotemp* & + grid_atom%sin_pol(ia)*grid_atom%cos_azi(ia) - 1._dp) + hypaniso(1, 2, iatom) = hypaniso(1, 2, iatom) + hypanisotemp* & (3._dp*grid_atom%sin_pol(ia)*grid_atom%cos_azi(ia)* & - grid_atom%sin_pol(ia)*grid_atom%sin_azi(ia)-0._dp) - hypaniso(1, 3, iatom) = hypaniso(1, 3, iatom)+hypanisotemp* & + grid_atom%sin_pol(ia)*grid_atom%sin_azi(ia) - 0._dp) + hypaniso(1, 3, iatom) = hypaniso(1, 3, iatom) + hypanisotemp* & (3._dp*grid_atom%sin_pol(ia)*grid_atom%cos_azi(ia)* & - grid_atom%cos_pol(ia)-0._dp) - hypaniso(2, 2, iatom) = hypaniso(2, 2, iatom)+hypanisotemp* & + grid_atom%cos_pol(ia) - 0._dp) + hypaniso(2, 2, iatom) = hypaniso(2, 2, iatom) + hypanisotemp* & (3._dp*grid_atom%sin_pol(ia)*grid_atom%sin_azi(ia)* & - grid_atom%sin_pol(ia)*grid_atom%sin_azi(ia)-1._dp) - hypaniso(2, 3, iatom) = hypaniso(2, 3, iatom)+hypanisotemp* & + grid_atom%sin_pol(ia)*grid_atom%sin_azi(ia) - 1._dp) + hypaniso(2, 3, iatom) = hypaniso(2, 3, iatom) + hypanisotemp* & (3._dp*grid_atom%sin_pol(ia)*grid_atom%sin_azi(ia)* & - grid_atom%cos_pol(ia)-0._dp) - hypaniso(3, 3, iatom) = hypaniso(3, 3, iatom)+hypanisotemp* & + grid_atom%cos_pol(ia) - 0._dp) + hypaniso(3, 3, iatom) = hypaniso(3, 3, iatom) + hypanisotemp* & (3._dp*grid_atom%cos_pol(ia)* & - grid_atom%cos_pol(ia)-1._dp) + grid_atom%cos_pol(ia) - 1._dp) END DO ! ia END IF ! hard_radius END DO ! ir @@ -246,35 +246,35 @@ SUBROUTINE qs_epr_hyp_calc(qs_env) IF (grid_atom%rad(ir) <= hard_radius) THEN DO ia = 1, grid_atom%ng_sphere hypanisotemp = 0.0_dp - rtemp = SQRT(rab2+grid_atom%rad(ir)**2+2.0_dp*grid_atom%rad(ir)* & - (rab(1)*grid_atom%sin_pol(ia)*grid_atom%cos_azi(ia)+ & - rab(2)*grid_atom%sin_pol(ia)*grid_atom%sin_azi(ia)+ & + rtemp = SQRT(rab2 + grid_atom%rad(ir)**2 + 2.0_dp*grid_atom%rad(ir)* & + (rab(1)*grid_atom%sin_pol(ia)*grid_atom%cos_azi(ia) + & + rab(2)*grid_atom%sin_pol(ia)*grid_atom%sin_azi(ia) + & rab(3)*grid_atom%cos_pol(ia))) DO iso = 1, harmonics%max_iso_not0 - hypanisotemp = hypanisotemp+ & - (rho_rad_h(1)%r_coef(ir, iso)-rho_rad_h(2)%r_coef(ir, iso) & - -(rho_rad_s(1)%r_coef(ir, iso)-rho_rad_s(2)%r_coef(ir, iso)))* & + hypanisotemp = hypanisotemp + & + (rho_rad_h(1)%r_coef(ir, iso) - rho_rad_h(2)%r_coef(ir, iso) & + - (rho_rad_s(1)%r_coef(ir, iso) - rho_rad_s(2)%r_coef(ir, iso)))* & harmonics%slm(ia, iso)*grid_atom%wr(ir)*grid_atom%wa(ia)/ & rtemp**5 END DO ! iso - hypaniso(1, 1, jatom) = hypaniso(1, 1, jatom)+hypanisotemp* & - (3._dp*(rab(1)+grid_atom%rad(ir)*grid_atom%sin_pol(ia)*grid_atom%cos_azi(ia))* & - (rab(1)+grid_atom%rad(ir)*grid_atom%sin_pol(ia)*grid_atom%cos_azi(ia))-rtemp**2) - hypaniso(1, 2, jatom) = hypaniso(1, 2, jatom)+hypanisotemp* & - (3._dp*(rab(1)+grid_atom%rad(ir)*grid_atom%sin_pol(ia)*grid_atom%cos_azi(ia))* & - (rab(2)+grid_atom%rad(ir)*grid_atom%sin_pol(ia)*grid_atom%sin_azi(ia))-0._dp) - hypaniso(1, 3, jatom) = hypaniso(1, 3, jatom)+hypanisotemp* & - (3._dp*(rab(1)+grid_atom%rad(ir)*grid_atom%sin_pol(ia)*grid_atom%cos_azi(ia))* & - (rab(3)+grid_atom%rad(ir)*grid_atom%cos_pol(ia))-0._dp) - hypaniso(2, 2, jatom) = hypaniso(2, 2, jatom)+hypanisotemp* & - (3._dp*(rab(2)+grid_atom%rad(ir)*grid_atom%sin_pol(ia)*grid_atom%sin_azi(ia))* & - (rab(2)+grid_atom%rad(ir)*grid_atom%sin_pol(ia)*grid_atom%sin_azi(ia))-rtemp**2) - hypaniso(2, 3, jatom) = hypaniso(2, 3, jatom)+hypanisotemp* & - (3._dp*(rab(2)+grid_atom%rad(ir)*grid_atom%sin_pol(ia)*grid_atom%sin_azi(ia))* & - (rab(3)+grid_atom%rad(ir)*grid_atom%cos_pol(ia))-0._dp) - hypaniso(3, 3, jatom) = hypaniso(3, 3, jatom)+hypanisotemp* & - (3._dp*(rab(3)+grid_atom%rad(ir)*grid_atom%cos_pol(ia))* & - (rab(3)+grid_atom%rad(ir)*grid_atom%cos_pol(ia))-rtemp**2) + hypaniso(1, 1, jatom) = hypaniso(1, 1, jatom) + hypanisotemp* & + (3._dp*(rab(1) + grid_atom%rad(ir)*grid_atom%sin_pol(ia)*grid_atom%cos_azi(ia))* & + (rab(1) + grid_atom%rad(ir)*grid_atom%sin_pol(ia)*grid_atom%cos_azi(ia)) - rtemp**2) + hypaniso(1, 2, jatom) = hypaniso(1, 2, jatom) + hypanisotemp* & + (3._dp*(rab(1) + grid_atom%rad(ir)*grid_atom%sin_pol(ia)*grid_atom%cos_azi(ia))* & + (rab(2) + grid_atom%rad(ir)*grid_atom%sin_pol(ia)*grid_atom%sin_azi(ia)) - 0._dp) + hypaniso(1, 3, jatom) = hypaniso(1, 3, jatom) + hypanisotemp* & + (3._dp*(rab(1) + grid_atom%rad(ir)*grid_atom%sin_pol(ia)*grid_atom%cos_azi(ia))* & + (rab(3) + grid_atom%rad(ir)*grid_atom%cos_pol(ia)) - 0._dp) + hypaniso(2, 2, jatom) = hypaniso(2, 2, jatom) + hypanisotemp* & + (3._dp*(rab(2) + grid_atom%rad(ir)*grid_atom%sin_pol(ia)*grid_atom%sin_azi(ia))* & + (rab(2) + grid_atom%rad(ir)*grid_atom%sin_pol(ia)*grid_atom%sin_azi(ia)) - rtemp**2) + hypaniso(2, 3, jatom) = hypaniso(2, 3, jatom) + hypanisotemp* & + (3._dp*(rab(2) + grid_atom%rad(ir)*grid_atom%sin_pol(ia)*grid_atom%sin_azi(ia))* & + (rab(3) + grid_atom%rad(ir)*grid_atom%cos_pol(ia)) - 0._dp) + hypaniso(3, 3, jatom) = hypaniso(3, 3, jatom) + hypanisotemp* & + (3._dp*(rab(3) + grid_atom%rad(ir)*grid_atom%cos_pol(ia))* & + (rab(3) + grid_atom%rad(ir)*grid_atom%cos_pol(ia)) - rtemp**2) END DO ! ia END IF ! hard_radius END DO ! ir @@ -319,12 +319,12 @@ SUBROUTINE qs_epr_hyp_calc(qs_env) ra(:) = pbc(particle_set(iatom)%r, cell) DO ig = 1, SIZE(hypaniso_gspace%pw%cc) arg = DOT_PRODUCT(pw_grid%g(:, ig), ra) - esum = esum+COS(arg)*REAL(hypaniso_gspace%pw%cc(ig), dp) & - -SIN(arg)*AIMAG(hypaniso_gspace%pw%cc(ig)) + esum = esum + COS(arg)*REAL(hypaniso_gspace%pw%cc(ig), dp) & + - SIN(arg)*AIMAG(hypaniso_gspace%pw%cc(ig)) END DO ! Actually, we need -1.0 * fourpi * hypaniso_gspace esum = esum*fourpi*(-1.0_dp) - hypaniso(idir1, idir2, iatom) = hypaniso(idir1, idir2, iatom)+esum + hypaniso(idir1, idir2, iatom) = hypaniso(idir1, idir2, iatom) + esum END DO END DO ! idir2 END DO ! idir1 diff --git a/src/qs_external_density.F b/src/qs_external_density.F index 0a6c3506b5..d3d05d6268 100644 --- a/src/qs_external_density.F +++ b/src/qs_external_density.F @@ -108,7 +108,7 @@ SUBROUTINE external_read_density(qs_env) CALL rs_grid_zero(rs_rho_ext(igrid_level)%rs_grid) ENDDO - igrid_level = igrid_level-1 + igrid_level = igrid_level - 1 ext_den_section => section_vals_get_subs_vals(input, "DFT%EXTERNAL_DENSITY") CALL section_vals_val_get(ext_den_section, "FILE_DENSITY", c_val=filename) @@ -156,7 +156,7 @@ SUBROUTINE external_read_density(qs_env) READ (extunit, *) nat, rdum DO i = 1, 3 READ (extunit, *) ndum, rdum - IF (ndum /= npoints(i) .OR. (ABS(rdum(i)-dr(i)) > 1e-4)) THEN + IF (ndum /= npoints(i) .OR. (ABS(rdum(i) - dr(i)) > 1e-4)) THEN WRITE (*, *) "ZMP | ERROR! | CUBE FILE NOT COINCIDENT WITH INTERNAL GRID ", i WRITE (*, *) "ZMP | ", ndum, " DIFFERS FROM ", npoints(i) WRITE (*, *) "ZMP | ", rdum, " DIFFERS FROM ", dr(i) @@ -172,7 +172,7 @@ SUBROUTINE external_read_density(qs_env) IF (my_rank .EQ. 0) THEN READ (extunit, *) (buffer(k), k=lbounds(3), ubounds(3)) IF (num_pe .GT. 1) THEN - DO ip = 1, num_pe-1 + DO ip = 1, num_pe - 1 CALL mp_send(buffer(lbounds(3):ubounds(3)), ip, tag, gid) ! WRITE(*,*) my_rank," sending to : ",ip ENDDO diff --git a/src/qs_external_potential.F b/src/qs_external_potential.F index 3481455b59..d2bb33b7a6 100644 --- a/src/qs_external_potential.F +++ b/src/qs_external_potential.F @@ -102,11 +102,11 @@ SUBROUTINE external_e_potential(qs_env) DO k = bo_local(1, 3), bo_local(2, 3) DO j = bo_local(1, 2), bo_local(2, 2) DO i = bo_local(1, 1), bo_local(2, 1) - grid_p(1) = (i-bo_global(1, 1))*dr(1) - grid_p(2) = (j-bo_global(1, 2))*dr(2) - grid_p(3) = (k-bo_global(1, 3))*dr(3) + grid_p(1) = (i - bo_global(1, 1))*dr(1) + grid_p(2) = (j - bo_global(1, 2))*dr(2) + grid_p(3) = (k - bo_global(1, 3))*dr(3) CALL get_external_potential(grid_p, ext_pot_section, func=efunc) - v_ee%pw%cr3d(i, j, k) = v_ee%pw%cr3d(i, j, k)+efunc + v_ee%pw%cr3d(i, j, k) = v_ee%pw%cr3d(i, j, k) + efunc END DO END DO END DO @@ -196,7 +196,7 @@ SUBROUTINE external_c_potential(qs_env, calculate_forces) CALL get_external_potential(r, ext_pot_section, func=efunc, & dfunc=dfunc, calc_derivatives=my_force) END IF - ee_core_ener = ee_core_ener+zeff*efunc + ee_core_ener = ee_core_ener + zeff*efunc IF (my_force) THEN CALL get_qs_env(qs_env=qs_env, force=force) force(ikind)%eev(:, iatom) = dfunc*zeff @@ -340,25 +340,25 @@ SUBROUTINE interpolate_external_potential(r, grid, func, dfunc, calc_derivatives ubounds_local = grid%pw_grid%bounds_local(2, :) ! Determine the indices of grid points that are needed - lower_inds = lbounds+FLOOR(r/dr)-fd_extra_point - upper_inds = lower_inds+1+2*fd_extra_point + lower_inds = lbounds + FLOOR(r/dr) - fd_extra_point + upper_inds = lower_inds + 1 + 2*fd_extra_point DO i = lower_inds(1), upper_inds(1) ! If index is out of global bounds, assume periodic boundary conditions i_pbc = pbc_index(i, lbounds(1), ubounds(1)) - buffer_i = i-lower_inds(1)+1-fd_extra_point + buffer_i = i - lower_inds(1) + 1 - fd_extra_point DO j = lower_inds(2), upper_inds(2) j_pbc = pbc_index(j, lbounds(2), ubounds(2)) - buffer_j = j-lower_inds(2)+1-fd_extra_point + buffer_j = j - lower_inds(2) + 1 - fd_extra_point ! Find the process that has the data for indices i_pbc and j_pbc ! and store the data to bcast_buffer. Assuming that each process has full z data IF (grid%pw_grid%para%mode .NE. PW_MODE_LOCAL) THEN - DO ip = 0, num_pe-1 - IF (grid%pw_grid%para%bo(1, 1, ip, 1) <= i_pbc-lbounds(1)+1 .AND. & - grid%pw_grid%para%bo(2, 1, ip, 1) >= i_pbc-lbounds(1)+1 .AND. & - grid%pw_grid%para%bo(1, 2, ip, 1) <= j_pbc-lbounds(2)+1 .AND. & - grid%pw_grid%para%bo(2, 2, ip, 1) >= j_pbc-lbounds(2)+1) THEN + DO ip = 0, num_pe - 1 + IF (grid%pw_grid%para%bo(1, 1, ip, 1) <= i_pbc - lbounds(1) + 1 .AND. & + grid%pw_grid%para%bo(2, 1, ip, 1) >= i_pbc - lbounds(1) + 1 .AND. & + grid%pw_grid%para%bo(1, 2, ip, 1) <= j_pbc - lbounds(2) + 1 .AND. & + grid%pw_grid%para%bo(2, 2, ip, 1) >= j_pbc - lbounds(2) + 1) THEN data_source = ip EXIT END IF @@ -370,7 +370,7 @@ SUBROUTINE interpolate_external_potential(r, grid, func, dfunc, calc_derivatives ELSE DO k = lower_inds(3), upper_inds(3) k_pbc = pbc_index(k, lbounds(3), ubounds(3)) - buffer_k = k-lower_inds(3)+1-fd_extra_point + buffer_k = k - lower_inds(3) + 1 - fd_extra_point bcast_buffer(buffer_k) = & grid%cr3d(i_pbc, j_pbc, k_pbc) END DO @@ -387,7 +387,7 @@ SUBROUTINE interpolate_external_potential(r, grid, func, dfunc, calc_derivatives ! Now that all the processes have local external potential data around r, ! interpolate the value at r - subgrid_origin = (lower_inds-lbounds+fd_extra_point)*dr + subgrid_origin = (lower_inds - lbounds + fd_extra_point)*dr func = trilinear_interpolation(r, grid_buffer(1:2, 1:2, 1:2), subgrid_origin, dr) ! If the derivative of the potential is needed, approximate the derivative at grid @@ -422,9 +422,9 @@ SUBROUTINE d_finite_difference(grid, dr, dgrid) DO i = 1, SIZE(dgrid, 1) DO j = 1, SIZE(dgrid, 2) DO k = 1, SIZE(dgrid, 3) - dgrid(i, j, k, 1) = 0.5*(grid(i+1, j, k)-grid(i-1, j, k))/dr(1) - dgrid(i, j, k, 2) = 0.5*(grid(i, j+1, k)-grid(i, j-1, k))/dr(2) - dgrid(i, j, k, 3) = 0.5*(grid(i, j, k+1)-grid(i, j, k-1))/dr(3) + dgrid(i, j, k, 1) = 0.5*(grid(i + 1, j, k) - grid(i - 1, j, k))/dr(1) + dgrid(i, j, k, 2) = 0.5*(grid(i, j + 1, k) - grid(i, j - 1, k))/dr(2) + dgrid(i, j, k, 3) = 0.5*(grid(i, j, k + 1) - grid(i, j, k - 1))/dr(3) END DO END DO END DO @@ -447,15 +447,15 @@ FUNCTION trilinear_interpolation(r, subgrid, origin, dr) RESULT(value_at_r) REAL(KIND=dp), DIMENSION(3) :: norm_r, norm_r_rev - norm_r = (r-origin)/dr - norm_r_rev = 1-norm_r - value_at_r = subgrid(1, 1, 1)*PRODUCT(norm_r_rev)+ & - subgrid(2, 1, 1)*norm_r(1)*norm_r_rev(2)*norm_r_rev(3)+ & - subgrid(1, 2, 1)*norm_r_rev(1)*norm_r(2)*norm_r_rev(3)+ & - subgrid(1, 1, 2)*norm_r_rev(1)*norm_r_rev(2)*norm_r(3)+ & - subgrid(1, 2, 2)*norm_r_rev(1)*norm_r(2)*norm_r(3)+ & - subgrid(2, 1, 2)*norm_r(1)*norm_r_rev(2)*norm_r(3)+ & - subgrid(2, 2, 1)*norm_r(1)*norm_r(2)*norm_r_rev(3)+ & + norm_r = (r - origin)/dr + norm_r_rev = 1 - norm_r + value_at_r = subgrid(1, 1, 1)*PRODUCT(norm_r_rev) + & + subgrid(2, 1, 1)*norm_r(1)*norm_r_rev(2)*norm_r_rev(3) + & + subgrid(1, 2, 1)*norm_r_rev(1)*norm_r(2)*norm_r_rev(3) + & + subgrid(1, 1, 2)*norm_r_rev(1)*norm_r_rev(2)*norm_r(3) + & + subgrid(1, 2, 2)*norm_r_rev(1)*norm_r(2)*norm_r(3) + & + subgrid(2, 1, 2)*norm_r(1)*norm_r_rev(2)*norm_r(3) + & + subgrid(2, 2, 1)*norm_r(1)*norm_r(2)*norm_r_rev(3) + & subgrid(2, 2, 2)*PRODUCT(norm_r) END FUNCTION trilinear_interpolation @@ -471,9 +471,9 @@ FUNCTION pbc_index(i, lowbound, upbound) INTEGER :: i, lowbound, upbound, pbc_index IF (i < lowbound) THEN - pbc_index = upbound+i-lowbound+1 + pbc_index = upbound + i - lowbound + 1 ELSE IF (i > upbound) THEN - pbc_index = lowbound+i-upbound-1 + pbc_index = lowbound + i - upbound - 1 ELSE pbc_index = i END IF diff --git a/src/qs_fb_atomic_halo_types.F b/src/qs_fb_atomic_halo_types.F index 1a9f08f020..b95dea9472 100644 --- a/src/qs_fb_atomic_halo_types.F +++ b/src/qs_fb_atomic_halo_types.F @@ -145,7 +145,7 @@ SUBROUTINE fb_atomic_halo_retain(atomic_halo) CPASSERT(ASSOCIATED(atomic_halo%obj)) CPASSERT(atomic_halo%obj%ref_count > 0) - atomic_halo%obj%ref_count = atomic_halo%obj%ref_count+1 + atomic_halo%obj%ref_count = atomic_halo%obj%ref_count + 1 END SUBROUTINE fb_atomic_halo_retain ! ************************************************************************************************** @@ -163,7 +163,7 @@ SUBROUTINE fb_atomic_halo_release(atomic_halo) IF (ASSOCIATED(atomic_halo%obj)) THEN CPASSERT(atomic_halo%obj%ref_count > 0) - atomic_halo%obj%ref_count = atomic_halo%obj%ref_count-1 + atomic_halo%obj%ref_count = atomic_halo%obj%ref_count - 1 IF (atomic_halo%obj%ref_count == 0) THEN atomic_halo%obj%ref_count = 1 IF (ASSOCIATED(atomic_halo%obj%halo_atoms)) THEN @@ -253,7 +253,7 @@ SUBROUTINE fb_atomic_halo_create(atomic_halo) atomic_halo%obj%cost = 0.0_dp NULLIFY (atomic_halo%obj%halo_atoms) atomic_halo%obj%ref_count = 1 - atomic_halo%obj%id_nr = last_fb_atomic_halo_id+1 + atomic_halo%obj%id_nr = last_fb_atomic_halo_id + 1 last_fb_atomic_halo_id = atomic_halo%obj%id_nr END SUBROUTINE fb_atomic_halo_create @@ -465,7 +465,7 @@ FUNCTION fb_atomic_halo_nelectrons_estimate_Z(atomic_halo, particle_set) RESULT( atomic_kind => particle_set(iatom_global)%atomic_kind CALL get_atomic_kind(atomic_kind=atomic_kind, & z=z) - nelectrons = nelectrons+z + nelectrons = nelectrons + z END DO END IF END FUNCTION fb_atomic_halo_nelectrons_estimate_Z @@ -508,7 +508,7 @@ FUNCTION fb_atomic_halo_cost(atomic_halo, & kind_number=ikind) CALL get_qs_kind(qs_kind=qs_kind_set(ikind), & ncgf=ncgf) - cost = cost+REAL(ncgf, dp) + cost = cost + REAL(ncgf, dp) END DO ! diagonalisation is N**3 process, so cost must reflect that cost = cost**3 @@ -574,13 +574,13 @@ SUBROUTINE fb_atomic_halo_build_halo_atoms(owner_atom, & ri(1:3) = particle_set(iatom)%r(1:3) rj(1:3) = particle_set(jatom)%r(1:3) rij_pbc = pbc(ri, rj, cell) - rij = rij_pbc(1)*rij_pbc(1)+ & - rij_pbc(2)*rij_pbc(2)+ & + rij = rij_pbc(1)*rij_pbc(1) + & + rij_pbc(2)*rij_pbc(2) + & rij_pbc(3)*rij_pbc(3) rij = SQRT(rij) IF (rij .LE. pair_radii(ikind, jkind)) THEN ! jatom is in iatom's halo - nhalo_atoms = nhalo_atoms+1 + nhalo_atoms = nhalo_atoms + 1 halo_atoms(nhalo_atoms) = jatom IF (jatom == iatom) owner_id_in_halo = nhalo_atoms END IF @@ -602,7 +602,7 @@ SUBROUTINE fb_atomic_halo_list_retain(atomic_halos) CPASSERT(ASSOCIATED(atomic_halos%obj)) CPASSERT(atomic_halos%obj%ref_count > 0) - atomic_halos%obj%ref_count = atomic_halos%obj%ref_count+1 + atomic_halos%obj%ref_count = atomic_halos%obj%ref_count + 1 END SUBROUTINE fb_atomic_halo_list_retain ! ************************************************************************************************** @@ -621,7 +621,7 @@ SUBROUTINE fb_atomic_halo_list_release(atomic_halos) IF (ASSOCIATED(atomic_halos%obj)) THEN CPASSERT(atomic_halos%obj%ref_count > 0) - atomic_halos%obj%ref_count = atomic_halos%obj%ref_count-1 + atomic_halos%obj%ref_count = atomic_halos%obj%ref_count - 1 IF (atomic_halos%obj%ref_count == 0) THEN atomic_halos%obj%ref_count = 1 IF (ASSOCIATED(atomic_halos%obj%halos)) THEN @@ -706,7 +706,7 @@ SUBROUTINE fb_atomic_halo_list_create(atomic_halos) atomic_halos%obj%max_nhalos = 0 NULLIFY (atomic_halos%obj%halos) atomic_halos%obj%ref_count = 1 - atomic_halos%obj%id_nr = last_fb_atomic_halo_list_id+1 + atomic_halos%obj%id_nr = last_fb_atomic_halo_list_id + 1 last_fb_atomic_halo_list_id = atomic_halos%obj%id_nr END SUBROUTINE fb_atomic_halo_list_create @@ -913,7 +913,7 @@ SUBROUTINE fb_atomic_halo_list_write_info(atomic_halos, para_env, scf_section) DO ihalo = 1, nhalos CALL fb_atomic_halo_get(atomic_halo=halos(ihalo), & natoms=nhalo_atoms) - total_n_halo_atoms = total_n_halo_atoms+nhalo_atoms + total_n_halo_atoms = total_n_halo_atoms + nhalo_atoms max_natoms = MAX(max_natoms, nhalo_atoms) min_natoms = MIN(min_natoms, nhalo_atoms) END DO @@ -963,7 +963,7 @@ PURE SUBROUTINE fb_build_pair_radii(rcut, nkinds, pair_radii) pair_radii = 0.0_dp DO ii = 1, nkinds DO jj = 1, nkinds - pair_radii(ii, jj) = rcut(ii)+rcut(jj) + pair_radii(ii, jj) = rcut(ii) + rcut(jj) END DO END DO END SUBROUTINE fb_build_pair_radii diff --git a/src/qs_fb_atomic_matrix_methods.F b/src/qs_fb_atomic_matrix_methods.F index 5bc9e0049f..e93048ede3 100644 --- a/src/qs_fb_atomic_matrix_methods.F +++ b/src/qs_fb_atomic_matrix_methods.F @@ -86,22 +86,22 @@ SUBROUTINE fb_atmatrix_calc_size(dbcsr_mat, & CALL fb_atomic_halo_get(atomic_halo=atomic_halo, & natoms=natoms_in_halo, & halo_atoms=halo_atoms) - check_ok = SIZE(blk_row_start) .GE. (natoms_in_halo+1) + check_ok = SIZE(blk_row_start) .GE. (natoms_in_halo + 1) CPASSERT(check_ok) - check_ok = SIZE(blk_col_start) .GE. (natoms_in_halo+1) + check_ok = SIZE(blk_col_start) .GE. (natoms_in_halo + 1) CPASSERT(check_ok) blk_row_start = 0 blk_col_start = 0 nrows = 0 ncols = 0 DO ii = 1, natoms_in_halo - blk_row_start(ii) = nrows+1 - blk_col_start(ii) = ncols+1 - nrows = nrows+row_block_size_data(halo_atoms(ii)) - ncols = ncols+col_block_size_data(halo_atoms(ii)) + blk_row_start(ii) = nrows + 1 + blk_col_start(ii) = ncols + 1 + nrows = nrows + row_block_size_data(halo_atoms(ii)) + ncols = ncols + col_block_size_data(halo_atoms(ii)) END DO - blk_row_start(natoms_in_halo+1) = nrows+1 - blk_col_start(natoms_in_halo+1) = ncols+1 + blk_row_start(natoms_in_halo + 1) = nrows + 1 + blk_col_start(natoms_in_halo + 1) = ncols + 1 END SUBROUTINE fb_atmatrix_calc_size ! **************************************************************************** @@ -227,7 +227,7 @@ SUBROUTINE fb_atmatrix_construct(dbcsr_mat, & ! need to reuse send_sizes as an accumulative displacement, so recalculate send_sizes(ipe) = 0 DO ipair = 1, send_pair_count(ipe) - CALL fb_com_atom_pairs_decode(pairs_send(send_pair_disps(ipe)+ipair), & + CALL fb_com_atom_pairs_decode(pairs_send(send_pair_disps(ipe) + ipair), & pe, iatom, jatom, send_encode) nrows_blk = row_block_size_data(iatom) ncols_blk = col_block_size_data(jatom) @@ -241,11 +241,11 @@ SUBROUTINE fb_atmatrix_construct(dbcsr_mat, & DO jj = 1, ncols_blk DO ii = 1, nrows_blk ! column major format in blocks - ind = send_disps(ipe)+send_sizes(ipe)+ii+(jj-1)*nrows_blk + ind = send_disps(ipe) + send_sizes(ipe) + ii + (jj - 1)*nrows_blk send_buf(ind) = mat_block(ii, jj) END DO ! ii END DO ! jj - send_sizes(ipe) = send_sizes(ipe)+nrows_blk*ncols_blk + send_sizes(ipe) = send_sizes(ipe) + nrows_blk*ncols_blk END IF END DO ! ipair END DO ! ipe @@ -266,7 +266,7 @@ SUBROUTINE fb_atmatrix_construct(dbcsr_mat, & DO ipe = 1, numprocs recv_sizes(ipe) = 0 DO ipair = 1, recv_pair_count(ipe) - CALL fb_com_atom_pairs_decode(pairs_recv(recv_pair_disps(ipe)+ipair), & + CALL fb_com_atom_pairs_decode(pairs_recv(recv_pair_disps(ipe) + ipair), & pe, iatom, jatom, recv_encode) ! nrows_blk = last_row(iatom) - first_row(iatom) + 1 ! ncols_blk = last_col(jatom) - first_col(jatom) + 1 @@ -288,19 +288,19 @@ SUBROUTINE fb_atmatrix_construct(dbcsr_mat, & DO jj = 1, ncols_blk DO ii = 1, nrows_blk ! column major format in blocks - ind = recv_disps(ipe)+recv_sizes(ipe)+ii+(jj-1)*nrows_blk - atomic_matrix(blk_row_start(iatom_in_halo)+ii-1, & - blk_col_start(jatom_in_halo)+jj-1) = recv_buf(ind) + ind = recv_disps(ipe) + recv_sizes(ipe) + ii + (jj - 1)*nrows_blk + atomic_matrix(blk_row_start(iatom_in_halo) + ii - 1, & + blk_col_start(jatom_in_halo) + jj - 1) = recv_buf(ind) END DO ! ii END DO ! jj - recv_sizes(ipe) = recv_sizes(ipe)+nrows_blk*ncols_blk + recv_sizes(ipe) = recv_sizes(ipe) + nrows_blk*ncols_blk END DO ! ipair END DO ! ipe ! the constructed matrix is upper triangular, fill it up to full DO ii = 2, SIZE(atomic_matrix, 1) - DO jj = 1, ii-1 + DO jj = 1, ii - 1 atomic_matrix(ii, jj) = atomic_matrix(jj, ii) END DO END DO @@ -392,9 +392,9 @@ SUBROUTINE fb_atmatrix_construct_2(matrix_storage, & ! copy data to atomic_matrix if found IF (found) THEN DO jj = 1, SIZE(blk_p, 2) - icol = blk_col_start(jatom)+jj-1 + icol = blk_col_start(jatom) + jj - 1 DO ii = 1, SIZE(blk_p, 1) - irow = blk_row_start(iatom)+ii-1 + irow = blk_row_start(iatom) + ii - 1 atomic_matrix(irow, icol) = blk_p(ii, jj) END DO ! ii END DO ! jj @@ -405,7 +405,7 @@ SUBROUTINE fb_atmatrix_construct_2(matrix_storage, & ! the constructed matrix is upper triangular, fill it up to full DO ii = 2, SIZE(atomic_matrix, 1) - DO jj = 1, ii-1 + DO jj = 1, ii - 1 atomic_matrix(ii, jj) = atomic_matrix(jj, ii) END DO END DO @@ -523,13 +523,13 @@ SUBROUTINE fb_atmatrix_generate_com_pairs(dbcsr_mat, & nblkrows_total) ! calculation of cost not implemented at the moment tasks_recv(TASK_COST, itask) = 0 - itask = itask+1 + itask = itask + 1 END IF END DO ! jatom END DO ! iatom ! get the actual number of tasks - ntasks_recv = itask-1 + ntasks_recv = itask - 1 ! create tasks CALL fb_com_tasks_create(com_tasks_recv) @@ -566,7 +566,7 @@ SUBROUTINE fb_atmatrix_generate_com_pairs(dbcsr_mat, & row=iatom_global, col=jatom_global, block=mat_block, & found=found) IF (found) THEN - counter = counter+1 + counter = counter + 1 ! we can do this here, because essencially we are inspecting ! the send tasks one by one, and then omit ones which the ! block is not found in the DBCSR matrix. itask is always @@ -679,7 +679,7 @@ SUBROUTINE fb_atmatrix_generate_com_pairs_2(dbcsr_mat, & DO ihalo = 1, nhalos CALL fb_atomic_halo_get(atomic_halo=halos(ihalo), & natoms=natoms_in_halo) - ntasks_recv = ntasks_recv+natoms_in_halo*natoms_in_halo + ntasks_recv = ntasks_recv + natoms_in_halo*natoms_in_halo END DO ALLOCATE (tasks_recv(TASK_N_RECORDS, ntasks_recv)) @@ -719,14 +719,14 @@ SUBROUTINE fb_atmatrix_generate_com_pairs_2(dbcsr_mat, & nblkrows_total) ! calculation of cost not implemented at the moment tasks_recv(TASK_COST, itask) = 0 - itask = itask+1 + itask = itask + 1 END IF END DO ! jatom END DO ! iatom END DO ! ihalo ! set the actual number of tasks obtained - ntasks_recv = itask-1 + ntasks_recv = itask - 1 ! create tasks CALL fb_com_tasks_create(com_tasks_recv) @@ -763,7 +763,7 @@ SUBROUTINE fb_atmatrix_generate_com_pairs_2(dbcsr_mat, & col=jatom_global, block=mat_block, & found=found) IF (found) THEN - counter = counter+1 + counter = counter + 1 ! we can do this here, because essencially we are inspecting ! the send tasks one by one, and then omit ones which the ! block is not found in the DBCSR matrix. itask is always diff --git a/src/qs_fb_buffer_types.F b/src/qs_fb_buffer_types.F index 4c80c2b11e..ac6d081736 100644 --- a/src/qs_fb_buffer_types.F +++ b/src/qs_fb_buffer_types.F @@ -157,7 +157,7 @@ SUBROUTINE fb_buffer_i_retain(buffer) routineP = moduleN//':'//routineN CPASSERT(ASSOCIATED(buffer%obj)) - buffer%obj%ref_count = buffer%obj%ref_count+1 + buffer%obj%ref_count = buffer%obj%ref_count + 1 END SUBROUTINE fb_buffer_i_retain ! ************************************************************************************************** @@ -173,7 +173,7 @@ SUBROUTINE fb_buffer_i_release(buffer) IF (ASSOCIATED(buffer%obj)) THEN CPASSERT(buffer%obj%ref_count > 0) - buffer%obj%ref_count = buffer%obj%ref_count-1 + buffer%obj%ref_count = buffer%obj%ref_count - 1 IF (buffer%obj%ref_count == 0) THEN buffer%obj%ref_count = 1 IF (ASSOCIATED(buffer%obj%data_1d)) THEN @@ -300,7 +300,7 @@ SUBROUTINE fb_buffer_i_create(buffer, & END IF ! obj meta data update buffer%obj%ref_count = 1 - buffer%obj%id_nr = last_fb_buffer_i_id+1 + buffer%obj%id_nr = last_fb_buffer_i_id + 1 last_fb_buffer_i_id = buffer%obj%id_nr END SUBROUTINE fb_buffer_i_create @@ -323,13 +323,13 @@ SUBROUTINE fb_buffer_i_add(buffer, data_1d) NULLIFY (new_disps, new_data) this_size = SIZE(data_1d) - new_n = buffer%obj%n+1 - new_data_size = buffer%obj%disps(new_n)+this_size + new_n = buffer%obj%n + 1 + new_data_size = buffer%obj%disps(new_n) + this_size ! resize when needed - IF (SIZE(buffer%obj%disps) .LT. new_n+1) THEN + IF (SIZE(buffer%obj%disps) .LT. new_n + 1) THEN ALLOCATE (new_disps(new_n*2)) new_disps = 0 - new_disps(1:buffer%obj%n+1) = buffer%obj%disps(1:buffer%obj%n+1) + new_disps(1:buffer%obj%n + 1) = buffer%obj%disps(1:buffer%obj%n + 1) DEALLOCATE (buffer%obj%disps) buffer%obj%disps => new_disps END IF @@ -342,8 +342,8 @@ SUBROUTINE fb_buffer_i_add(buffer, data_1d) buffer%obj%data_1d => new_data END IF ! append to the buffer - buffer%obj%disps(new_n+1) = new_data_size - buffer%obj%data_1d(buffer%obj%disps(new_n)+1:new_data_size) = & + buffer%obj%disps(new_n + 1) = new_data_size + buffer%obj%data_1d(buffer%obj%disps(new_n) + 1:new_data_size) = & data_1d(1:this_size) buffer%obj%n = new_n END SUBROUTINE fb_buffer_i_add @@ -366,8 +366,8 @@ SUBROUTINE fb_buffer_i_calc_disps(buffer, sizes) CPASSERT(SIZE(sizes) .GE. buffer%obj%n) buffer%obj%disps(1) = 0 - DO ii = 2, buffer%obj%n+1 - buffer%obj%disps(ii) = buffer%obj%disps(ii-1)+sizes(ii-1) + DO ii = 2, buffer%obj%n + 1 + buffer%obj%disps(ii) = buffer%obj%disps(ii - 1) + sizes(ii - 1) END DO END SUBROUTINE fb_buffer_i_calc_disps @@ -388,7 +388,7 @@ SUBROUTINE fb_buffer_i_calc_sizes(buffer, sizes) CPASSERT(SIZE(sizes) .GE. buffer%obj%n) DO ii = 1, buffer%obj%n - sizes(ii) = buffer%obj%disps(ii+1)-buffer%obj%disps(ii) + sizes(ii) = buffer%obj%disps(ii + 1) - buffer%obj%disps(ii) END DO END SUBROUTINE fb_buffer_i_calc_sizes @@ -433,7 +433,7 @@ SUBROUTINE fb_buffer_i_get(buffer, & INTEGER :: ncols, slice_size IF (PRESENT(n)) n = buffer%obj%n - IF (PRESENT(data_size)) data_size = buffer%obj%disps(buffer%obj%n+1) + IF (PRESENT(data_size)) data_size = buffer%obj%disps(buffer%obj%n + 1) IF (PRESENT(sizes)) THEN CALL fb_buffer_calc_sizes(buffer, sizes) END IF @@ -444,10 +444,10 @@ SUBROUTINE fb_buffer_i_get(buffer, & IF (PRESENT(data_1d)) THEN IF (PRESENT(i_slice)) THEN CPASSERT(i_slice .LE. buffer%obj%n) - data_1d => buffer%obj%data_1d(buffer%obj%disps(i_slice)+1: & - buffer%obj%disps(i_slice+1)) + data_1d => buffer%obj%data_1d(buffer%obj%disps(i_slice) + 1: & + buffer%obj%disps(i_slice + 1)) ELSE - data_1d => buffer%obj%data_1d(1:buffer%obj%disps(buffer%obj%n+1)) + data_1d => buffer%obj%data_1d(1:buffer%obj%disps(buffer%obj%n + 1)) END IF END IF IF (PRESENT(data_2d)) THEN @@ -458,12 +458,12 @@ SUBROUTINE fb_buffer_i_get(buffer, & ! associate pointer unless copied to a targeted array. b) in ! F2003 standard, pointers should rank remap automatically by ! association to a rank 1 array - slice_size = buffer%obj%disps(i_slice+1)-buffer%obj%disps(i_slice) + slice_size = buffer%obj%disps(i_slice + 1) - buffer%obj%disps(i_slice) ncols = slice_size/data_2d_ld CPASSERT(slice_size == data_2d_ld*ncols) data_2d(1:data_2d_ld, 1:ncols) => & - buffer%obj%data_1d(buffer%obj%disps(i_slice)+1: & - buffer%obj%disps(i_slice+1)) + buffer%obj%data_1d(buffer%obj%disps(i_slice) + 1: & + buffer%obj%disps(i_slice + 1)) END IF END SUBROUTINE fb_buffer_i_get @@ -485,10 +485,10 @@ SUBROUTINE fb_buffer_i_replace(buffer, i_slice, data_1d) INTEGER :: slice_size - slice_size = buffer%obj%disps(i_slice+1)-buffer%obj%disps(i_slice) + slice_size = buffer%obj%disps(i_slice + 1) - buffer%obj%disps(i_slice) CPASSERT(SIZE(data_1d) == slice_size) - buffer%obj%data_1d(buffer%obj%disps(i_slice)+1: & - buffer%obj%disps(i_slice+1)) = data_1d + buffer%obj%data_1d(buffer%obj%disps(i_slice) + 1: & + buffer%obj%disps(i_slice + 1)) = data_1d END SUBROUTINE fb_buffer_i_replace ! DOUBLE PRECISION VERSION @@ -505,7 +505,7 @@ SUBROUTINE fb_buffer_d_retain(buffer) routineP = moduleN//':'//routineN CPASSERT(ASSOCIATED(buffer%obj)) - buffer%obj%ref_count = buffer%obj%ref_count+1 + buffer%obj%ref_count = buffer%obj%ref_count + 1 END SUBROUTINE fb_buffer_d_retain ! ************************************************************************************************** @@ -521,7 +521,7 @@ SUBROUTINE fb_buffer_d_release(buffer) IF (ASSOCIATED(buffer%obj)) THEN CPASSERT(buffer%obj%ref_count > 0) - buffer%obj%ref_count = buffer%obj%ref_count-1 + buffer%obj%ref_count = buffer%obj%ref_count - 1 IF (buffer%obj%ref_count == 0) THEN buffer%obj%ref_count = 1 IF (ASSOCIATED(buffer%obj%data_1d)) THEN @@ -631,7 +631,7 @@ SUBROUTINE fb_buffer_d_create(buffer, & END IF ! allocate the arrays ALLOCATE (buffer%obj%data_1d(my_max_size)) - ALLOCATE (buffer%obj%disps(my_nslices+1)) + ALLOCATE (buffer%obj%disps(my_nslices + 1)) buffer%obj%data_1d = 0 buffer%obj%disps = 0 ! set n for buffer before calc disps @@ -649,7 +649,7 @@ SUBROUTINE fb_buffer_d_create(buffer, & END IF ! obj meta data update buffer%obj%ref_count = 1 - buffer%obj%id_nr = last_fb_buffer_d_id+1 + buffer%obj%id_nr = last_fb_buffer_d_id + 1 last_fb_buffer_d_id = buffer%obj%id_nr END SUBROUTINE fb_buffer_d_create @@ -673,13 +673,13 @@ SUBROUTINE fb_buffer_d_add(buffer, data_1d) NULLIFY (new_disps, new_data) this_size = SIZE(data_1d) - new_n = buffer%obj%n+1 - new_data_size = buffer%obj%disps(new_n)+this_size + new_n = buffer%obj%n + 1 + new_data_size = buffer%obj%disps(new_n) + this_size ! resize when needed - IF (SIZE(buffer%obj%disps) .LT. new_n+1) THEN + IF (SIZE(buffer%obj%disps) .LT. new_n + 1) THEN ALLOCATE (new_disps(new_n*2)) new_disps = 0 - new_disps(1:buffer%obj%n+1) = buffer%obj%disps(1:buffer%obj%n+1) + new_disps(1:buffer%obj%n + 1) = buffer%obj%disps(1:buffer%obj%n + 1) DEALLOCATE (buffer%obj%disps) buffer%obj%disps => new_disps END IF @@ -692,8 +692,8 @@ SUBROUTINE fb_buffer_d_add(buffer, data_1d) buffer%obj%data_1d => new_data END IF ! append to the buffer - buffer%obj%disps(new_n+1) = new_data_size - buffer%obj%data_1d(buffer%obj%disps(new_n)+1:new_data_size) = & + buffer%obj%disps(new_n + 1) = new_data_size + buffer%obj%data_1d(buffer%obj%disps(new_n) + 1:new_data_size) = & data_1d(1:this_size) buffer%obj%n = new_n END SUBROUTINE fb_buffer_d_add @@ -716,8 +716,8 @@ SUBROUTINE fb_buffer_d_calc_disps(buffer, sizes) CPASSERT(SIZE(sizes) .GE. buffer%obj%n) buffer%obj%disps(1) = 0 - DO ii = 2, buffer%obj%n+1 - buffer%obj%disps(ii) = buffer%obj%disps(ii-1)+sizes(ii-1) + DO ii = 2, buffer%obj%n + 1 + buffer%obj%disps(ii) = buffer%obj%disps(ii - 1) + sizes(ii - 1) END DO END SUBROUTINE fb_buffer_d_calc_disps @@ -738,7 +738,7 @@ SUBROUTINE fb_buffer_d_calc_sizes(buffer, sizes) CPASSERT(SIZE(sizes) .GE. buffer%obj%n) DO ii = 1, buffer%obj%n - sizes(ii) = buffer%obj%disps(ii+1)-buffer%obj%disps(ii) + sizes(ii) = buffer%obj%disps(ii + 1) - buffer%obj%disps(ii) END DO END SUBROUTINE fb_buffer_d_calc_sizes @@ -783,7 +783,7 @@ SUBROUTINE fb_buffer_d_get(buffer, & INTEGER :: ncols, slice_size IF (PRESENT(n)) n = buffer%obj%n - IF (PRESENT(data_size)) data_size = buffer%obj%disps(buffer%obj%n+1) + IF (PRESENT(data_size)) data_size = buffer%obj%disps(buffer%obj%n + 1) IF (PRESENT(sizes)) THEN CALL fb_buffer_calc_sizes(buffer, sizes) END IF @@ -794,10 +794,10 @@ SUBROUTINE fb_buffer_d_get(buffer, & IF (PRESENT(data_1d)) THEN IF (PRESENT(i_slice)) THEN CPASSERT(i_slice .LE. buffer%obj%n) - data_1d => buffer%obj%data_1d(buffer%obj%disps(i_slice)+1: & - buffer%obj%disps(i_slice+1)) + data_1d => buffer%obj%data_1d(buffer%obj%disps(i_slice) + 1: & + buffer%obj%disps(i_slice + 1)) ELSE - data_1d => buffer%obj%data_1d(1:buffer%obj%disps(buffer%obj%n+1)) + data_1d => buffer%obj%data_1d(1:buffer%obj%disps(buffer%obj%n + 1)) END IF END IF IF (PRESENT(data_2d)) THEN @@ -808,12 +808,12 @@ SUBROUTINE fb_buffer_d_get(buffer, & ! associate pointer unless copied to a targeted array. b) in ! F2003 standard, pointers should rank remap automatically by ! association to a rank 1 array - slice_size = buffer%obj%disps(i_slice+1)-buffer%obj%disps(i_slice) + slice_size = buffer%obj%disps(i_slice + 1) - buffer%obj%disps(i_slice) ncols = slice_size/data_2d_ld CPASSERT(slice_size == data_2d_ld*ncols) data_2d(1:data_2d_ld, 1:ncols) => & - buffer%obj%data_1d(buffer%obj%disps(i_slice)+1: & - buffer%obj%disps(i_slice+1)) + buffer%obj%data_1d(buffer%obj%disps(i_slice) + 1: & + buffer%obj%disps(i_slice + 1)) END IF END SUBROUTINE fb_buffer_d_get @@ -835,10 +835,10 @@ SUBROUTINE fb_buffer_d_replace(buffer, i_slice, data_1d) INTEGER :: slice_size - slice_size = buffer%obj%disps(i_slice+1)-buffer%obj%disps(i_slice) + slice_size = buffer%obj%disps(i_slice + 1) - buffer%obj%disps(i_slice) CPASSERT(SIZE(data_1d) == slice_size) - buffer%obj%data_1d(buffer%obj%disps(i_slice)+1: & - buffer%obj%disps(i_slice+1)) = data_1d + buffer%obj%data_1d(buffer%obj%disps(i_slice) + 1: & + buffer%obj%disps(i_slice + 1)) = data_1d END SUBROUTINE fb_buffer_d_replace END MODULE qs_fb_buffer_types diff --git a/src/qs_fb_com_tasks_types.F b/src/qs_fb_com_tasks_types.F index 0b3da6771a..1725637da6 100644 --- a/src/qs_fb_com_tasks_types.F +++ b/src/qs_fb_com_tasks_types.F @@ -162,7 +162,7 @@ SUBROUTINE fb_com_tasks_retain(com_tasks) CPASSERT(ASSOCIATED(com_tasks%obj)) CPASSERT(com_tasks%obj%ref_count > 0) - com_tasks%obj%ref_count = com_tasks%obj%ref_count+1 + com_tasks%obj%ref_count = com_tasks%obj%ref_count + 1 END SUBROUTINE fb_com_tasks_retain ! ********************************************************************** @@ -179,7 +179,7 @@ SUBROUTINE fb_com_atom_pairs_retain(atom_pairs) CPASSERT(ASSOCIATED(atom_pairs%obj)) CPASSERT(atom_pairs%obj%ref_count > 0) - atom_pairs%obj%ref_count = atom_pairs%obj%ref_count+1 + atom_pairs%obj%ref_count = atom_pairs%obj%ref_count + 1 END SUBROUTINE fb_com_atom_pairs_retain ! ********************************************************************** @@ -197,7 +197,7 @@ SUBROUTINE fb_com_tasks_release(com_tasks) IF (ASSOCIATED(com_tasks%obj)) THEN CPASSERT(com_tasks%obj%ref_count > 0) - com_tasks%obj%ref_count = com_tasks%obj%ref_count-1 + com_tasks%obj%ref_count = com_tasks%obj%ref_count - 1 IF (com_tasks%obj%ref_count == 0) THEN com_tasks%obj%ref_count = 1 IF (ASSOCIATED(com_tasks%obj%tasks)) THEN @@ -226,7 +226,7 @@ SUBROUTINE fb_com_atom_pairs_release(atom_pairs) IF (ASSOCIATED(atom_pairs%obj)) THEN CPASSERT(atom_pairs%obj%ref_count > 0) - atom_pairs%obj%ref_count = atom_pairs%obj%ref_count-1 + atom_pairs%obj%ref_count = atom_pairs%obj%ref_count - 1 IF (atom_pairs%obj%ref_count == 0) THEN atom_pairs%obj%ref_count = 1 IF (ASSOCIATED(atom_pairs%obj%pairs)) THEN @@ -359,7 +359,7 @@ SUBROUTINE fb_com_tasks_create(com_tasks) com_tasks%obj%nencode = 0 NULLIFY (com_tasks%obj%tasks) com_tasks%obj%ref_count = 1 - com_tasks%obj%id_nr = last_fb_com_tasks_id+1 + com_tasks%obj%id_nr = last_fb_com_tasks_id + 1 last_fb_com_tasks_id = com_tasks%obj%id_nr END SUBROUTINE fb_com_tasks_create @@ -381,7 +381,7 @@ SUBROUTINE fb_com_atom_pairs_create(atom_pairs) atom_pairs%obj%natoms_encode = 0 NULLIFY (atom_pairs%obj%pairs) atom_pairs%obj%ref_count = 1 - atom_pairs%obj%id_nr = last_fb_com_atom_pairs_id+1 + atom_pairs%obj%id_nr = last_fb_com_atom_pairs_id + 1 last_fb_com_atom_pairs_id = atom_pairs%obj%id_nr END SUBROUTINE fb_com_atom_pairs_create @@ -628,8 +628,8 @@ SUBROUTINE fb_com_tasks_transpose_dest_src(tasks_dest_is_me, & send_buf = 0 ! looping over local task list DO itask = 1, ntasks_in - rank = INT(tasks_in(rank_pos, itask))+1 - send_buf(rank) = send_buf(rank)+1 + rank = INT(tasks_in(rank_pos, itask)) + 1 + send_buf(rank) = send_buf(rank) + 1 END DO CALL mp_alltoall(send_buf, recv_buf, 1, para_env%group) @@ -650,9 +650,9 @@ SUBROUTINE fb_com_tasks_transpose_dest_src(tasks_dest_is_me, & recv_sizes(1) = recv_buf(1)*task_dim DO ipe = 2, para_env%num_pe send_sizes(ipe) = send_buf(ipe)*task_dim - send_disps(ipe) = send_disps(ipe-1)+send_sizes(ipe-1) + send_disps(ipe) = send_disps(ipe - 1) + send_sizes(ipe - 1) recv_sizes(ipe) = recv_buf(ipe)*task_dim - recv_disps(ipe) = recv_disps(ipe-1)+recv_sizes(ipe-1) + recv_disps(ipe) = recv_disps(ipe - 1) + recv_sizes(ipe - 1) END DO ! reallocate send and recv buffers to the correct sizes for @@ -668,12 +668,12 @@ SUBROUTINE fb_com_tasks_transpose_dest_src(tasks_dest_is_me, & IF (SIZE(recv_buf) > 0) recv_buf = 0 send_sizes = 0 DO itask = 1, ntasks_in - rank = INT(tasks_in(rank_pos, itask))+1 + rank = INT(tasks_in(rank_pos, itask)) + 1 DO ii = 1, task_dim - ind = send_disps(rank)+send_sizes(rank)+ii + ind = send_disps(rank) + send_sizes(rank) + ii send_buf(ind) = INT(tasks_in(ii, itask)) END DO - send_sizes(rank) = send_sizes(rank)+task_dim + send_sizes(rank) = send_sizes(rank) + task_dim END DO ! do communication CALL mp_alltoall(send_buf, send_sizes, send_disps, & @@ -693,10 +693,10 @@ SUBROUTINE fb_com_tasks_transpose_dest_src(tasks_dest_is_me, & ! do unpacking itask = 0 DO ipe = 1, para_env%num_pe - DO ii = 0, recv_sizes(ipe)/task_dim-1 - itask = itask+1 + DO ii = 0, recv_sizes(ipe)/task_dim - 1 + itask = itask + 1 DO jj = 1, task_dim - ind = recv_disps(ipe)+ii*task_dim+jj + ind = recv_disps(ipe) + ii*task_dim + jj tasks_out(jj, itask) = recv_buf(ind) END DO END DO @@ -812,8 +812,8 @@ SUBROUTINE fb_com_tasks_build_atom_pairs(com_tasks, & npairs = 1 ! first atom pair must be allowed DO ii = 2, ntasks - IF (pairs(ii) > pairs(ii-1)) THEN - npairs = npairs+1 + IF (pairs(ii) > pairs(ii - 1)) THEN + npairs = npairs + 1 pairs(npairs) = pairs(ii) END IF END DO @@ -852,7 +852,7 @@ SUBROUTINE fb_com_tasks_encode_pair(ind, iatom, jatom, natoms) iatom8 = INT(iatom, int_8) jatom8 = INT(jatom, int_8) - ind = (iatom8-1_int_8)*natoms8+(jatom8-1_int_8) + ind = (iatom8 - 1_int_8)*natoms8 + (jatom8 - 1_int_8) END SUBROUTINE fb_com_tasks_encode_pair ! ********************************************************************** @@ -875,8 +875,8 @@ SUBROUTINE fb_com_tasks_decode_pair(ind, iatom, jatom, natoms) INTEGER(KIND=int_8) :: iatom8, jatom8, natoms8 natoms8 = INT(natoms, int_8) - iatom8 = ind/natoms8+1_int_8 - jatom8 = MOD(ind, natoms8)+1_int_8 + iatom8 = ind/natoms8 + 1_int_8 + jatom8 = MOD(ind, natoms8) + 1_int_8 iatom = INT(iatom8, int_4) jatom = INT(jatom8, int_4) END SUBROUTINE fb_com_tasks_decode_pair @@ -905,7 +905,7 @@ SUBROUTINE fb_com_atom_pairs_encode(ind, pe, iatom, jatom, natoms) natoms8 = INT(natoms, int_8) CALL fb_com_tasks_encode_pair(pair, iatom, jatom, natoms) - ind = INT(pe, int_8)*natoms8*natoms8+pair + ind = INT(pe, int_8)*natoms8*natoms8 + pair END SUBROUTINE fb_com_atom_pairs_encode ! ********************************************************************** @@ -1016,21 +1016,21 @@ SUBROUTINE fb_com_atom_pairs_calc_buffer_sizes(atom_pairs, & ! decode processor and (iatom, jatom) information CALL fb_com_atom_pairs_decode(pairs(ipair), & pe, iatom, jatom, natoms_encode) - pe = pe+1 ! we need proc to count from 1 + pe = pe + 1 ! we need proc to count from 1 IF (PRESENT(row_map)) iatom = row_map(iatom) IF (PRESENT(col_map)) jatom = row_map(jatom) nrows_blk = row_blk_sizes(iatom) ncols_blk = col_blk_sizes(jatom) - sendrecv_sizes(pe) = sendrecv_sizes(pe)+nrows_blk*ncols_blk - sendrecv_pair_counts(pe) = sendrecv_pair_counts(pe)+1 + sendrecv_sizes(pe) = sendrecv_sizes(pe) + nrows_blk*ncols_blk + sendrecv_pair_counts(pe) = sendrecv_pair_counts(pe) + 1 END DO ! calculate displacements of the data of each destibation pe in ! send buffer and in the list of pairs to be sent sendrecv_disps = 0 sendrecv_pair_disps = 0 DO ipe = 2, nprocs - sendrecv_disps(ipe) = sendrecv_disps(ipe-1)+sendrecv_sizes(ipe-1) - sendrecv_pair_disps(ipe) = sendrecv_pair_disps(ipe-1)+sendrecv_pair_counts(ipe-1) + sendrecv_disps(ipe) = sendrecv_disps(ipe - 1) + sendrecv_sizes(ipe - 1) + sendrecv_pair_disps(ipe) = sendrecv_pair_disps(ipe - 1) + sendrecv_pair_counts(ipe - 1) END DO END SUBROUTINE fb_com_atom_pairs_calc_buffer_sizes @@ -1143,7 +1143,7 @@ SUBROUTINE fb_com_atom_pairs_gather_blks(dbcsr_mat, & ! need to reuse send_sizes as an accumulative displacement, so recalculate send_sizes(ipe) = 0 DO ipair = 1, send_pair_count(ipe) - CALL fb_com_atom_pairs_decode(pairs_send(send_pair_disps(ipe)+ipair), & + CALL fb_com_atom_pairs_decode(pairs_send(send_pair_disps(ipe) + ipair), & pe, iatom, jatom, send_encode) nrows_blk = row_block_size_data(iatom) ncols_blk = col_block_size_data(jatom) @@ -1157,11 +1157,11 @@ SUBROUTINE fb_com_atom_pairs_gather_blks(dbcsr_mat, & DO jj = 1, ncols_blk DO ii = 1, nrows_blk ! column major format in blocks - ind = send_disps(ipe)+send_sizes(ipe)+ii+(jj-1)*nrows_blk + ind = send_disps(ipe) + send_sizes(ipe) + ii + (jj - 1)*nrows_blk send_buf(ind) = mat_block(ii, jj) END DO ! ii END DO ! jj - send_sizes(ipe) = send_sizes(ipe)+nrows_blk*ncols_blk + send_sizes(ipe) = send_sizes(ipe) + nrows_blk*ncols_blk END IF END DO ! ipair END DO ! ipe @@ -1186,7 +1186,7 @@ SUBROUTINE fb_com_atom_pairs_gather_blks(dbcsr_mat, & DO ipe = 1, numprocs recv_sizes(ipe) = 0 DO ipair = 1, recv_pair_count(ipe) - CALL fb_com_atom_pairs_decode(pairs_recv(recv_pair_disps(ipe)+ipair), & + CALL fb_com_atom_pairs_decode(pairs_recv(recv_pair_disps(ipe) + ipair), & pe, iatom, jatom, recv_encode) nrows_blk = row_block_size_data(iatom) ncols_blk = col_block_size_data(jatom) @@ -1196,14 +1196,14 @@ SUBROUTINE fb_com_atom_pairs_gather_blks(dbcsr_mat, & DO jj = 1, ncols_blk DO ii = 1, nrows_blk ! column major format in blocks - ind = recv_disps(ipe)+recv_sizes(ipe)+ii+(jj-1)*nrows_blk + ind = recv_disps(ipe) + recv_sizes(ipe) + ii + (jj - 1)*nrows_blk mat_block(ii, jj) = recv_buf(ind) END DO ! ii END DO ! jj CALL fb_matrix_data_add(matrix_storage, & iatom, jatom, & mat_block(1:nrows_blk, 1:ncols_blk)) - recv_sizes(ipe) = recv_sizes(ipe)+nrows_blk*ncols_blk + recv_sizes(ipe) = recv_sizes(ipe) + nrows_blk*ncols_blk ! DEALLOCATE(mat_block, STAT=stat) ! CPPostcondition(stat==0, cp_failure_level, routineP,failure) END DO ! ipair @@ -1330,7 +1330,7 @@ SUBROUTINE fb_com_atom_pairs_distribute_blks(matrix_storage, & ! need to reuse send_sizes as an accumulative displacement, so recalculate send_sizes(ipe) = 0 DO ipair = 1, send_pair_count(ipe) - CALL fb_com_atom_pairs_decode(pairs_send(send_pair_disps(ipe)+ipair), & + CALL fb_com_atom_pairs_decode(pairs_send(send_pair_disps(ipe) + ipair), & pe, iatom, jatom, send_encode) CALL fb_matrix_data_get(matrix_storage, & iatom, jatom, & @@ -1343,11 +1343,11 @@ SUBROUTINE fb_com_atom_pairs_distribute_blks(matrix_storage, & DO jj = 1, ncols_blk DO ii = 1, nrows_blk ! column major format in blocks - ind = send_disps(ipe)+send_sizes(ipe)+ii+(jj-1)*nrows_blk + ind = send_disps(ipe) + send_sizes(ipe) + ii + (jj - 1)*nrows_blk send_buf(ind) = mat_block(ii, jj) END DO ! ii END DO ! jj - send_sizes(ipe) = send_sizes(ipe)+nrows_blk*ncols_blk + send_sizes(ipe) = send_sizes(ipe) + nrows_blk*ncols_blk END IF END DO ! ipair END DO ! ipe @@ -1368,15 +1368,15 @@ SUBROUTINE fb_com_atom_pairs_distribute_blks(matrix_storage, & DO ipe = 1, numprocs recv_sizes(ipe) = 0 DO ipair = 1, recv_pair_count(ipe) - CALL fb_com_atom_pairs_decode(pairs_recv(recv_pair_disps(ipe)+ipair), & + CALL fb_com_atom_pairs_decode(pairs_recv(recv_pair_disps(ipe) + ipair), & pe, iatom, jatom, recv_encode) nrows_blk = row_block_size_data(iatom) ncols_blk = col_block_size_data(jatom) - ind = recv_disps(ipe)+recv_sizes(ipe) + ind = recv_disps(ipe) + recv_sizes(ipe) CALL dbcsr_put_block(dbcsr_mat, & iatom, jatom, & - recv_buf((ind+1):(ind+nrows_blk*ncols_blk))) - recv_sizes(ipe) = recv_sizes(ipe)+nrows_blk*ncols_blk + recv_buf((ind + 1):(ind + nrows_blk*ncols_blk))) + recv_sizes(ipe) = recv_sizes(ipe) + nrows_blk*ncols_blk END DO ! ipair END DO ! ipe diff --git a/src/qs_fb_distribution_methods.F b/src/qs_fb_distribution_methods.F index 54de8e9175..eca8f6bcbd 100644 --- a/src/qs_fb_distribution_methods.F +++ b/src/qs_fb_distribution_methods.F @@ -164,7 +164,7 @@ SUBROUTINE fb_distribution_build(fb_env, qs_env, scf_section) para_env=para_env, & matrix_ks=mat_ks) nprocs = para_env%num_pe - my_pe = para_env%mepos+1 ! counting from 1 + my_pe = para_env%mepos + 1 ! counting from 1 ! for each global atom, build atomic halo and get the associated cost ALLOCATE (pair_radii(nkinds, nkinds)) @@ -214,7 +214,7 @@ SUBROUTINE fb_distribution_build(fb_env, qs_env, scf_section) i_common_set = common_set_ids(iatom) pos_in_preferred_list(i_common_set) = & MOD(pos_in_preferred_list(i_common_set), & - preferred_procs_set(iatom)%nprocs)+1 + preferred_procs_set(iatom)%nprocs) + 1 ipe = preferred_procs_set(iatom)%list(pos_in_preferred_list(i_common_set)) CALL fb_distribution_add(dist(ipe), element) END DO @@ -317,7 +317,7 @@ SUBROUTINE fb_distribution_build(fb_env, qs_env, scf_section) local_atoms_sizes) ALLOCATE (local_atoms(local_atoms_sizes(my_pe))) lb = local_atoms_starts(my_pe) - ub = local_atoms_starts(my_pe)+local_atoms_sizes(my_pe)-1 + ub = local_atoms_starts(my_pe) + local_atoms_sizes(my_pe) - 1 local_atoms(1:local_atoms_sizes(my_pe)) = local_atoms_all(lb:ub) CALL fb_env_set(fb_env=fb_env, & local_atoms=local_atoms, & @@ -360,7 +360,7 @@ PURE FUNCTION fb_distribution_acceptable_move(dist_from, & REAL(KIND=dp), INTENT(IN) :: threshold LOGICAL :: acceptable - acceptable = (dist_to%cost+element%cost .LT. dist_from%cost) .AND. & + acceptable = (dist_to%cost + element%cost .LT. dist_from%cost) .AND. & (dist_to%cost .LT. threshold) END FUNCTION fb_distribution_acceptable_move @@ -388,8 +388,8 @@ SUBROUTINE fb_distribution_write_info(dist_set, scf_section) natoms = 0 total_cost = 0.0_dp DO ii = 1, nprocs - natoms = natoms+dist_set(ii)%nelements - total_cost = total_cost+dist_set(ii)%cost + natoms = natoms + dist_set(ii)%nelements + total_cost = total_cost + dist_set(ii)%cost END DO ave_natoms = REAL(natoms, dp)/REAL(nprocs, dp) ave_cost = total_cost/REAL(nprocs, dp) @@ -482,15 +482,15 @@ SUBROUTINE fb_build_preferred_procs(dbcsr_mat, & ALLOCATE (preferred_procs_set(icol)%list(nprows)) pcol = col_dist(icol) ! dbcsr prow and pcol counts from 0 - DO prow = 0, nprows-1 + DO prow = 0, nprows - 1 ! here, we count processes from 1, so +1 from mpirank - preferred_procs_set(icol)%list(prow+1) = pgrid(prow, pcol)+1 + preferred_procs_set(icol)%list(prow + 1) = pgrid(prow, pcol) + 1 END DO preferred_procs_set(icol)%nprocs = nprows END DO common_set_ids(:) = 0 - common_set_ids(1:natoms) = col_dist(1:natoms)+1 + common_set_ids(1:natoms) = col_dist(1:natoms) + 1 END SUBROUTINE fb_build_preferred_procs @@ -552,8 +552,8 @@ SUBROUTINE fb_distribution_to_local_atoms(dist_set, & local_atoms_starts(ipe) = pos DO iatom = 1, dist_set(ipe)%nelements local_atoms(pos) = dist_set(ipe)%list(iatom)%id - pos = pos+1 - local_atoms_sizes(ipe) = local_atoms_sizes(ipe)+1 + pos = pos + 1 + local_atoms_sizes(ipe) = local_atoms_sizes(ipe) + 1 END DO END DO END SUBROUTINE fb_distribution_to_local_atoms @@ -640,7 +640,7 @@ SUBROUTINE fb_distribution_add(dist, element) INTEGER :: ii, new_nelements, pos - new_nelements = dist%nelements+1 + new_nelements = dist%nelements + 1 ! resize list if necessary IF (.NOT. ASSOCIATED(dist%list)) THEN @@ -655,12 +655,12 @@ SUBROUTINE fb_distribution_add(dist, element) ELSE pos = fb_distribution_find_slot(dist, element) DO ii = dist%nelements, pos, -1 - dist%list(ii+1) = dist%list(ii) + dist%list(ii + 1) = dist%list(ii) END DO dist%list(pos) = element END IF dist%nelements = new_nelements - dist%cost = dist%cost+element%cost + dist%cost = dist%cost + element%cost END SUBROUTINE fb_distribution_add ! ************************************************************************************************** @@ -684,13 +684,13 @@ PURE FUNCTION fb_distribution_find_slot(dist, element) RESULT(pos) RETURN END IF IF (element%cost .GE. dist%list(N)%cost) THEN - pos = N+1 + pos = N + 1 RETURN END IF lower = 1 upper = N - DO WHILE ((upper-lower) .GT. 1) - middle = (lower+upper)/2 + DO WHILE ((upper - lower) .GT. 1) + middle = (lower + upper)/2 IF (element%cost .LT. dist%list(middle)%cost) THEN upper = middle ELSE @@ -719,13 +719,13 @@ SUBROUTINE fb_distribution_remove_ind(dist, pos) check_ok = pos .GT. 0 CPASSERT(check_ok) IF (pos .LE. dist%nelements) THEN - dist%cost = dist%cost-dist%list(pos)%cost - DO ii = pos, dist%nelements-1 - dist%list(ii) = dist%list(ii+1) + dist%cost = dist%cost - dist%list(pos)%cost + DO ii = pos, dist%nelements - 1 + dist%list(ii) = dist%list(ii + 1) END DO dist%list(dist%nelements)%id = 0 dist%list(dist%nelements)%cost = 0.0_dp - dist%nelements = dist%nelements-1 + dist%nelements = dist%nelements - 1 ! auto resize if required IF (dist%nelements*REDUCE_RATIO .LT. SIZE(dist%list)) THEN CALL fb_distribution_resize(dist, dist%nelements/SHRINK_FACTOR) @@ -748,7 +748,7 @@ SUBROUTINE fb_distribution_remove_el(dist, element) INTEGER :: ii, pos - pos = dist%nelements+1 + pos = dist%nelements + 1 DO ii = 1, dist%nelements IF (element%id == dist%list(ii)%id) THEN pos = ii diff --git a/src/qs_fb_env_methods.F b/src/qs_fb_env_methods.F index 4d756e7df9..9f44aff9cd 100644 --- a/src/qs_fb_env_methods.F +++ b/src/qs_fb_env_methods.F @@ -916,7 +916,7 @@ SUBROUTINE fb_env_build_atomic_halos(fb_env, qs_env, scf_section) CALL fb_build_pair_radii(rcut, nkinds_global, pair_radii) ihalo = 0 DO iatom = 1, natoms_local - ihalo = ihalo+1 + ihalo = ihalo + 1 CALL fb_atomic_halo_build_halo_atoms(local_atoms(iatom), & particle_set, & cell, & @@ -1041,11 +1041,11 @@ SUBROUTINE fb_env_build_trial_fns_auto(fb_env, qs_env, maxocc) lshell = basis_set%l(ishell, iset) counter = 0 ! loop over orbitals within the same l - DO ico = ncoset(lshell-1)+1, ncoset(lshell) - counter = counter+1 + DO ico = ncoset(lshell - 1) + 1, ncoset(lshell) + counter = counter + 1 ! only include the first zeta orbitals IF ((lshell .GT. old_lshell) .AND. (counter .LE. nco(lshell))) THEN - nfunctions(ikind) = nfunctions(ikind)+1 + nfunctions(ikind) = nfunctions(ikind) + 1 END IF END DO ! we have got enough trial functions when we have enough @@ -1084,12 +1084,12 @@ SUBROUTINE fb_env_build_trial_fns_auto(fb_env, qs_env, maxocc) lshell = basis_set%l(ishell, iset) counter = 0 ! loop over orbitals within the same l - DO ico = ncoset(lshell-1)+1, ncoset(lshell) - icgf = icgf+1 - counter = counter+1 + DO ico = ncoset(lshell - 1) + 1, ncoset(lshell) + icgf = icgf + 1 + counter = counter + 1 ! only include the first zeta orbitals IF ((lshell .GT. old_lshell) .AND. (counter .LE. nco(lshell))) THEN - itrial = itrial+1 + itrial = itrial + 1 functions(itrial, ikind) = icgf END IF END DO @@ -1163,7 +1163,7 @@ SUBROUTINE fb_dbcsr_copy_sparse_struct(matrix_out, matrix_in) CALL dbcsr_iterator_next_block(iter, iatom, jatom, mat_block, iblk) rows(iblk) = iatom cols(iblk) = jatom - nblks = nblks+1 + nblks = nblks + 1 END DO CALL dbcsr_iterator_stop(iter) CALL dbcsr_reserve_blocks(matrix_out, rows(1:nblks), cols(1:nblks)) diff --git a/src/qs_fb_env_types.F b/src/qs_fb_env_types.F index c2be57d2c1..eacc3ca271 100644 --- a/src/qs_fb_env_types.F +++ b/src/qs_fb_env_types.F @@ -103,7 +103,7 @@ SUBROUTINE fb_env_retain(fb_env) CPASSERT(ASSOCIATED(fb_env%obj)) CPASSERT(fb_env%obj%ref_count > 0) - fb_env%obj%ref_count = fb_env%obj%ref_count+1 + fb_env%obj%ref_count = fb_env%obj%ref_count + 1 END SUBROUTINE fb_env_retain ! ********************************************************************** @@ -119,7 +119,7 @@ SUBROUTINE fb_env_release(fb_env) IF (ASSOCIATED(fb_env%obj)) THEN CPASSERT(fb_env%obj%ref_count > 0) - fb_env%obj%ref_count = fb_env%obj%ref_count-1 + fb_env%obj%ref_count = fb_env%obj%ref_count - 1 IF (fb_env%obj%ref_count == 0) THEN fb_env%obj%ref_count = 1 IF (ASSOCIATED(fb_env%obj%rcut)) THEN @@ -211,7 +211,7 @@ SUBROUTINE fb_env_create(fb_env) NULLIFY (fb_env%obj%local_atoms) fb_env%obj%nlocal_atoms = 0 fb_env%obj%ref_count = 1 - fb_env%obj%id_nr = last_fb_env_id+1 + fb_env%obj%id_nr = last_fb_env_id + 1 last_fb_env_id = fb_env%obj%id_nr END SUBROUTINE fb_env_create diff --git a/src/qs_fb_filter_matrix_methods.F b/src/qs_fb_filter_matrix_methods.F index adaac346ae..f66dea64d9 100644 --- a/src/qs_fb_filter_matrix_methods.F +++ b/src/qs_fb_filter_matrix_methods.F @@ -388,7 +388,7 @@ SUBROUTINE fb_fltrmat_build_2(H_mat, & DO ihalo = 1, nhalos CALL fb_atomic_halo_get(atomic_halo=halos(ihalo), & natoms=natoms_in_halo) - nmax = nmax+natoms_in_halo + nmax = nmax + natoms_in_halo END DO CALL fb_matrix_data_create(filter_mat_data, & nmax, & @@ -584,8 +584,8 @@ SUBROUTINE fb_fltrmat_add_blkcol(H_mat, & halo_atoms=halo_atoms) ! construct atomic matrix for H for atomic_halo - ALLOCATE (atomic_H_blk_row_start(natoms_in_halo+1), & - atomic_H_blk_col_start(natoms_in_halo+1), & + ALLOCATE (atomic_H_blk_row_start(natoms_in_halo + 1), & + atomic_H_blk_col_start(natoms_in_halo + 1), & STAT=stat) CPASSERT(stat == 0) CALL fb_atmatrix_calc_size(H_mat, & @@ -604,8 +604,8 @@ SUBROUTINE fb_fltrmat_add_blkcol(H_mat, & atomic_H_blk_col_start) ! construct atomic matrix for S for atomic_halo - ALLOCATE (atomic_S_blk_row_start(natoms_in_halo+1), & - atomic_S_blk_col_start(natoms_in_halo+1), & + ALLOCATE (atomic_S_blk_row_start(natoms_in_halo + 1), & + atomic_S_blk_col_start(natoms_in_halo + 1), & STAT=stat) CPASSERT(stat == 0) CALL fb_atmatrix_calc_size(S_mat, & @@ -653,7 +653,7 @@ SUBROUTINE fb_fltrmat_add_blkcol(H_mat, & DO ipe = 1, numprocs send_sizes(ipe) = 0 DO ipair = 1, send_pair_count(ipe) - CALL fb_com_atom_pairs_decode(pairs_send(send_pair_disps(ipe)+ipair), & + CALL fb_com_atom_pairs_decode(pairs_send(send_pair_disps(ipe) + ipair), & pe, iatom_global, jatom_global, & send_encode) iatom_in_halo = ind_in_halo(iatom_global) @@ -668,28 +668,28 @@ SUBROUTINE fb_fltrmat_add_blkcol(H_mat, & ! do it column-wise one trial function at a time DO itrial = 1, ntfns(jkind) - ind = send_disps(ipe)+send_sizes(ipe)+(itrial-1)*nrows_blk + ind = send_disps(ipe) + send_sizes(ipe) + (itrial - 1)*nrows_blk CALL dgemv("N", & nrows_blk, & ncols_atmatrix, & 1.0_dp, & atomic_filter_mat( & atomic_H_blk_row_start(iatom_in_halo): & - atomic_H_blk_row_start(iatom_in_halo+1)-1, & + atomic_H_blk_row_start(iatom_in_halo + 1) - 1, & 1:ncols_atmatrix & ), & nrows_blk, & atomic_S( & 1:nrows_atmatrix, & - atomic_S_blk_col_start(jatom_in_halo)+ & - tfns(itrial, jkind)-1 & + atomic_S_blk_col_start(jatom_in_halo) + & + tfns(itrial, jkind) - 1 & ), & 1, & 0.0_dp, & - send_buf(ind+1:ind+nrows_blk), & + send_buf(ind + 1:ind + nrows_blk), & 1) END DO ! itrial - send_sizes(ipe) = send_sizes(ipe)+nrows_blk*ncols_blk + send_sizes(ipe) = send_sizes(ipe) + nrows_blk*ncols_blk END DO ! ipair END DO ! ipe @@ -726,16 +726,16 @@ SUBROUTINE fb_fltrmat_add_blkcol(H_mat, & DO ipe = 1, numprocs recv_sizes(ipe) = 0 DO ipair = 1, recv_pair_count(ipe) - CALL fb_com_atom_pairs_decode(pairs_recv(recv_pair_disps(ipe)+ipair), & + CALL fb_com_atom_pairs_decode(pairs_recv(recv_pair_disps(ipe) + ipair), & pe, iatom_global, jatom_global, & recv_encode) nrows_blk = row_block_size_data(iatom_global) ncols_blk = col_block_size_data(jatom_global) - ind = recv_disps(ipe)+recv_sizes(ipe) + ind = recv_disps(ipe) + recv_sizes(ipe) CALL dbcsr_put_block(filter_mat, & iatom_global, jatom_global, & - recv_buf((ind+1):(ind+nrows_blk*ncols_blk))) - recv_sizes(ipe) = recv_sizes(ipe)+nrows_blk*ncols_blk + recv_buf((ind + 1):(ind + nrows_blk*ncols_blk))) + recv_sizes(ipe) = recv_sizes(ipe) + nrows_blk*ncols_blk END DO ! ipair END DO ! ipe @@ -843,8 +843,8 @@ SUBROUTINE fb_fltrmat_add_blkcol_2(H_mat, & halo_atoms=halo_atoms) ! construct atomic matrix for H for atomic_halo - ALLOCATE (atomic_H_blk_row_start(natoms_in_halo+1), & - atomic_H_blk_col_start(natoms_in_halo+1), & + ALLOCATE (atomic_H_blk_row_start(natoms_in_halo + 1), & + atomic_H_blk_col_start(natoms_in_halo + 1), & STAT=stat) CPASSERT(stat == 0) CALL fb_atmatrix_calc_size(H_mat, & @@ -861,8 +861,8 @@ SUBROUTINE fb_fltrmat_add_blkcol_2(H_mat, & atomic_H_blk_col_start) ! construct atomic matrix for S for atomic_halo - ALLOCATE (atomic_S_blk_row_start(natoms_in_halo+1), & - atomic_S_blk_col_start(natoms_in_halo+1), & + ALLOCATE (atomic_S_blk_row_start(natoms_in_halo + 1), & + atomic_S_blk_col_start(natoms_in_halo + 1), & STAT=stat) CPASSERT(stat == 0) CALL fb_atmatrix_calc_size(S_mat, & @@ -920,14 +920,14 @@ SUBROUTINE fb_fltrmat_add_blkcol_2(H_mat, & 1.0_dp, & atomic_filter_mat( & atomic_H_blk_row_start(iatom_in_halo): & - atomic_H_blk_row_start(iatom_in_halo+1)-1, & + atomic_H_blk_row_start(iatom_in_halo + 1) - 1, & 1:ncols_atmatrix & ), & nrows_blk, & atomic_S( & 1:nrows_atmatrix, & - atomic_S_blk_col_start(jatom_in_halo)+ & - tfns(itrial, jkind)-1 & + atomic_S_blk_col_start(jatom_in_halo) + & + tfns(itrial, jkind) - 1 & ), & 1, & 0.0_dp, & @@ -1060,7 +1060,7 @@ SUBROUTINE fb_fltrmat_generate_com_pairs(filter_mat, & nblkrows_total) ! calculation of cost not implemented at the moment tasks_send(TASK_COST, itask) = 0 - itask = itask+1 + itask = itask + 1 END DO ! iatom_in_halo CALL fb_com_tasks_create(com_tasks_recv) @@ -1165,7 +1165,7 @@ SUBROUTINE fb_fltrmat_generate_com_pairs_2(filter_mat, & DO ihalo = 1, nhalos CALL fb_atomic_halo_get(atomic_halo=halos(ihalo), & natoms=natoms_in_halo) - ntasks_send = ntasks_send+natoms_in_halo + ntasks_send = ntasks_send + natoms_in_halo END DO ! ihalo ! allocate send tasks @@ -1206,12 +1206,12 @@ SUBROUTINE fb_fltrmat_generate_com_pairs_2(filter_mat, & nblkrows_total) ! calculation of cost not implemented at the moment tasks_send(TASK_COST, itask) = 0 - itask = itask+1 + itask = itask + 1 END DO ! iatom_in_halo END DO ! ihalo ! get the actual number of tasks - ntasks_send = itask-1 + ntasks_send = itask - 1 CALL fb_com_tasks_create(com_tasks_send) CALL fb_com_tasks_set(com_tasks=com_tasks_send, & diff --git a/src/qs_fb_hash_table_types.F b/src/qs_fb_hash_table_types.F index e3c2f92407..81c6cc5f8b 100644 --- a/src/qs_fb_hash_table_types.F +++ b/src/qs_fb_hash_table_types.F @@ -129,7 +129,7 @@ RECURSIVE SUBROUTINE fb_hash_table_add(hash_table, key, val) ! we are adding a new entry only if islot points to an empty slot, ! otherwise just change the val of the existing entry IF (hash_table%obj%table(islot)%key == EMPTY_KEY) THEN - hash_table%obj%nelements = hash_table%obj%nelements+1 + hash_table%obj%nelements = hash_table%obj%nelements + 1 hash_table%obj%table(islot)%key = key END IF hash_table%obj%table(islot)%val = val @@ -166,7 +166,7 @@ SUBROUTINE fb_hash_table_create(hash_table, nmax) nmax=my_nmax) ! book keeping stuff hash_table%obj%ref_count = 1 - hash_table%obj%id_nr = last_fb_hash_table_id+1 + hash_table%obj%id_nr = last_fb_hash_table_id + 1 last_fb_hash_table_id = hash_table%obj%id_nr END SUBROUTINE fb_hash_table_create @@ -242,7 +242,7 @@ SUBROUTINE fb_hash_table_init(hash_table, nmax) ! power that is greater or equal to my_nmax power = 0 DO WHILE (2**power .LT. my_nmax) - power = power+1 + power = power + 1 END DO my_nmax = 2**power IF (ASSOCIATED(hash_table%obj%table)) THEN @@ -332,7 +332,7 @@ SUBROUTINE fb_hash_table_release(hash_table) IF (ASSOCIATED(hash_table%obj)) THEN check_ok = hash_table%obj%ref_count > 0 CPASSERT(check_ok) - hash_table%obj%ref_count = hash_table%obj%ref_count-1 + hash_table%obj%ref_count = hash_table%obj%ref_count - 1 IF (hash_table%obj%ref_count == 0) THEN hash_table%obj%ref_count = 1 IF (ASSOCIATED(hash_table%obj%table)) THEN @@ -369,7 +369,7 @@ SUBROUTINE fb_hash_table_remove(hash_table, key) IF (islot > 0) THEN IF (hash_table%obj%table(islot)%key == key) THEN hash_table%obj%table(islot)%key = EMPTY_KEY - hash_table%obj%nelements = hash_table%obj%nelements-1 + hash_table%obj%nelements = hash_table%obj%nelements - 1 ! must rehash after setting a filled slot to empty, otherwise the ! table will not work. Automatic resize if required IF (hash_table%obj%nelements*REDUCE_RATIO .LT. & @@ -400,7 +400,7 @@ SUBROUTINE fb_hash_table_retain(hash_table) CPASSERT(check_ok) check_ok = hash_table%obj%ref_count > 0 CPASSERT(check_ok) - hash_table%obj%ref_count = hash_table%obj%ref_count+1 + hash_table%obj%ref_count = hash_table%obj%ref_count + 1 END SUBROUTINE fb_hash_table_retain ! ************************************************************************************************** @@ -454,7 +454,7 @@ PURE FUNCTION fb_hash_table_linear_probe(hash_table, key) & (hash_table%obj%table(islot)%key == EMPTY_KEY)) RETURN END DO ! if unsuccessful, search from 1 to guess - DO islot = 1, guess-1 + DO islot = 1, guess - 1 IF ((hash_table%obj%table(islot)%key == key) .OR. & (hash_table%obj%table(islot)%key == EMPTY_KEY)) RETURN END DO @@ -480,7 +480,7 @@ PURE FUNCTION fb_hash_table_hash_function(hash_table, key) RESULT(hash) nmax_8 = INT(hash_table%obj%nmax, int_8) prime_8 = INT(hash_table%obj%prime, int_8) ! IAND with nmax-1 is equivalent to MOD nmax if nmax is alway a power of 2. - hash_8 = IAND(key*prime_8, nmax_8-1)+1_int_8 + hash_8 = IAND(key*prime_8, nmax_8 - 1) + 1_int_8 hash = INT(hash_8) END FUNCTION fb_hash_table_hash_function diff --git a/src/qs_fb_matrix_data_types.F b/src/qs_fb_matrix_data_types.F index 0eed801d4d..77d72faef2 100644 --- a/src/qs_fb_matrix_data_types.F +++ b/src/qs_fb_matrix_data_types.F @@ -115,7 +115,7 @@ SUBROUTINE fb_matrix_data_add(matrix_data, row, col, blk) CALL fb_buffer_replace(matrix_data%obj%blks, existing_ii, RESHAPE(blk, (/nrows*ncols/))) ELSE old_nblks = matrix_data%obj%nblks - matrix_data%obj%nblks = old_nblks+1 + matrix_data%obj%nblks = old_nblks + 1 ii = matrix_data%obj%nblks ! resize lds if necessary IF (SIZE(matrix_data%obj%lds) .LT. ii) THEN @@ -177,7 +177,7 @@ SUBROUTINE fb_matrix_data_create(matrix_data, nmax, nencode) nencode=nencode) ! book keeping stuff matrix_data%obj%ref_count = 1 - matrix_data%obj%id_nr = last_fb_matrix_data_id+1 + matrix_data%obj%id_nr = last_fb_matrix_data_id + 1 last_fb_matrix_data_id = matrix_data%obj%id_nr END SUBROUTINE fb_matrix_data_create @@ -299,7 +299,7 @@ SUBROUTINE fb_matrix_data_release(matrix_data) IF (ASSOCIATED(matrix_data%obj)) THEN check_ok = matrix_data%obj%ref_count > 0 CPASSERT(check_ok) - matrix_data%obj%ref_count = matrix_data%obj%ref_count-1 + matrix_data%obj%ref_count = matrix_data%obj%ref_count - 1 IF (matrix_data%obj%ref_count == 0) THEN matrix_data%obj%ref_count = 1 IF (fb_hash_table_has_data(matrix_data%obj%ind)) THEN @@ -336,7 +336,7 @@ SUBROUTINE fb_matrix_data_retain(matrix_data) CPASSERT(check_ok) check_ok = matrix_data%obj%ref_count > 0 CPASSERT(check_ok) - matrix_data%obj%ref_count = matrix_data%obj%ref_count+1 + matrix_data%obj%ref_count = matrix_data%obj%ref_count + 1 END SUBROUTINE fb_matrix_data_retain ! ************************************************************************************************** @@ -400,7 +400,7 @@ PURE FUNCTION fb_matrix_data_encode_pair(row, col, nencode) & row_8 = INT(row, int_8) col_8 = INT(col, int_8) nencode_8 = INT(nencode, int_8) - pair_ind = (row_8-1_int_8)*nencode_8+(col_8-1_int_8)+1 + pair_ind = (row_8 - 1_int_8)*nencode_8 + (col_8 - 1_int_8) + 1 END FUNCTION fb_matrix_data_encode_pair END MODULE qs_fb_matrix_data_types diff --git a/src/qs_fb_trial_fns_types.F b/src/qs_fb_trial_fns_types.F index f02a0027b2..f0965f49a7 100644 --- a/src/qs_fb_trial_fns_types.F +++ b/src/qs_fb_trial_fns_types.F @@ -73,7 +73,7 @@ SUBROUTINE fb_trial_fns_retain(trial_fns) CPASSERT(ASSOCIATED(trial_fns%obj)) CPASSERT(trial_fns%obj%ref_count > 0) - trial_fns%obj%ref_count = trial_fns%obj%ref_count+1 + trial_fns%obj%ref_count = trial_fns%obj%ref_count + 1 END SUBROUTINE fb_trial_fns_retain ! ************************************************************************************************** @@ -90,7 +90,7 @@ SUBROUTINE fb_trial_fns_release(trial_fns) IF (ASSOCIATED(trial_fns%obj)) THEN CPASSERT(trial_fns%obj%ref_count > 0) - trial_fns%obj%ref_count = trial_fns%obj%ref_count-1 + trial_fns%obj%ref_count = trial_fns%obj%ref_count - 1 IF (trial_fns%obj%ref_count == 0) THEN trial_fns%obj%ref_count = 1 IF (ASSOCIATED(trial_fns%obj%nfunctions)) THEN @@ -170,7 +170,7 @@ SUBROUTINE fb_trial_fns_create(trial_fns) NULLIFY (trial_fns%obj%nfunctions) NULLIFY (trial_fns%obj%functions) trial_fns%obj%ref_count = 1 - trial_fns%obj%id_nr = last_fb_trial_fns_id+1 + trial_fns%obj%id_nr = last_fb_trial_fns_id + 1 last_fb_trial_fns_id = trial_fns%obj%id_nr END SUBROUTINE fb_trial_fns_create diff --git a/src/qs_fermi_contact.F b/src/qs_fermi_contact.F index d5bc0eebe7..90cbf6bece 100644 --- a/src/qs_fermi_contact.F +++ b/src/qs_fermi_contact.F @@ -185,11 +185,11 @@ SUBROUTINE build_fermi_contact_matrix(qs_env, matrix_fc, rc) IF (inode == 1) last_jatom = 0 - rb = rab+ra - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rb = rab + ra + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) dab = SQRT(rab2) rac = pbc(ra, rc, cell) - rbc = rac-rab + rbc = rac - rab IF (jatom /= last_jatom) THEN new_atom_b = .TRUE. @@ -219,7 +219,7 @@ SUBROUTINE build_fermi_contact_matrix(qs_env, matrix_fc, rc) DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) diff --git a/src/qs_force.F b/src/qs_force.F index 50e123f25e..bc5677a316 100644 --- a/src/qs_force.F +++ b/src/qs_force.F @@ -330,7 +330,7 @@ SUBROUTINE qs_forces(qs_env) CALL qs_rho_update_rho(rho, qs_env=qs_env) CALL qs_ks_did_change(ks_env, rho_changed=.TRUE.) CALL qs_ks_update_qs_env(qs_env, just_energy=.TRUE.) - energy%total = energy%total+energy%mp2 + energy%total = energy%total + energy%mp2 ! Compute MP2 properties ! Get the HF+MP2 density @@ -391,8 +391,8 @@ SUBROUTINE qs_forces(qs_env) ! Things should have the right name ! The minus sign below is a hack ! XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - force(ikind)%other(1:3, i) = -particle_set(iatom)%f(1:3)+force(ikind)%ch_pulay(1:3, i) - force(ikind)%total(1:3, i) = force(ikind)%total(1:3, i)+force(ikind)%other(1:3, i) + force(ikind)%other(1:3, i) = -particle_set(iatom)%f(1:3) + force(ikind)%ch_pulay(1:3, i) + force(ikind)%total(1:3, i) = force(ikind)%total(1:3, i) + force(ikind)%other(1:3, i) particle_set(iatom)%f = -force(ikind)%total(1:3, i) END DO @@ -407,10 +407,10 @@ SUBROUTINE qs_forces(qs_env) dft_control%qs_control%xtb .OR. & dft_control%qs_control%semi_empirical))) THEN DO dir = 1, 3 - virial%pv_virial(dir, dir) = virial%pv_virial(dir, dir)-energy%exc & - -2.0_dp*energy%hartree + virial%pv_virial(dir, dir) = virial%pv_virial(dir, dir) - energy%exc & + - 2.0_dp*energy%hartree IF (dft_control%do_admm) THEN - virial%pv_virial(dir, dir) = virial%pv_virial(dir, dir)-energy%exc_aux_fit + virial%pv_virial(dir, dir) = virial%pv_virial(dir, dir) - energy%exc_aux_fit END IF ! The factor 2 is a hack. It compensates the plus sign in h_stress/pw_poisson_solve. ! The sign in pw_poisson_solve is correct for FIST, but not for QS. @@ -506,19 +506,19 @@ SUBROUTINE write_forces(qs_force, atomic_kind_set, ftype, output_unit, & i_val=ndigits) fmtstr1 = "(/,/,T2,A,/,/,T3,A,T11,A,T23,A,T40,A1,2( X,A1))" - WRITE (UNIT=fmtstr1(41:42), FMT="(I2)") ndigits+5 + WRITE (UNIT=fmtstr1(41:42), FMT="(I2)") ndigits + 5 fmtstr2 = "(/,(T2,I5,4X,I4,T18,A,T34,3F . ))" WRITE (UNIT=fmtstr2(32:33), FMT="(I2)") ndigits - WRITE (UNIT=fmtstr2(29:30), FMT="(I2)") ndigits+6 + WRITE (UNIT=fmtstr2(29:30), FMT="(I2)") ndigits + 6 fmtstr3 = "(/,T3,A,T34,3F . )" WRITE (UNIT=fmtstr3(18:19), FMT="(I2)") ndigits - WRITE (UNIT=fmtstr3(15:16), FMT="(I2)") ndigits+6 + WRITE (UNIT=fmtstr3(15:16), FMT="(I2)") ndigits + 6 fmtstr4 = "((T34,3F . ))" WRITE (UNIT=fmtstr4(12:13), FMT="(I2)") ndigits - WRITE (UNIT=fmtstr4(9:10), FMT="(I2)") ndigits+6 + WRITE (UNIT=fmtstr4(9:10), FMT="(I2)") ndigits + 6 fmtstr5 = "(/T2,A//T3,A)" @@ -536,7 +536,7 @@ SUBROUTINE write_forces(qs_force, atomic_kind_set, ftype, output_unit, & i = atom_of_kind(iatom) WRITE (UNIT=output_unit, FMT=fmtstr2) & iatom, ikind, " total", qs_force(ikind)%total(1:3, i) - grand_total(1:3) = grand_total(1:3)+qs_force(ikind)%total(1:3, i) + grand_total(1:3) = grand_total(1:3) + qs_force(ikind)%total(1:3, i) END DO CASE (0) DO iatom = 1, natom @@ -564,7 +564,7 @@ SUBROUTINE write_forces(qs_force, atomic_kind_set, ftype, output_unit, & iatom, ikind, " mp2_non_sep", qs_force(ikind)%mp2_non_sep(1:3, i), & iatom, ikind, " mp2_sep", qs_force(ikind)%mp2_sep(1:3, i), & iatom, ikind, " total", qs_force(ikind)%total(1:3, i) - grand_total(1:3) = grand_total(1:3)+qs_force(ikind)%total(1:3, i) + grand_total(1:3) = grand_total(1:3) + qs_force(ikind)%total(1:3, i) END DO CASE (1) DO iatom = 1, natom @@ -593,7 +593,7 @@ SUBROUTINE write_forces(qs_force, atomic_kind_set, ftype, output_unit, & iatom, ikind, " mp2_non_sep", qs_force(ikind)%mp2_non_sep(1:3, i), & iatom, ikind, " mp2_sep", qs_force(ikind)%mp2_sep(1:3, i), & iatom, ikind, " total", qs_force(ikind)%total(1:3, i) - grand_total(1:3) = grand_total(1:3)+qs_force(ikind)%total(1:3, i) + grand_total(1:3) = grand_total(1:3) + qs_force(ikind)%total(1:3, i) END DO CASE (2) DO iatom = 1, natom @@ -603,7 +603,7 @@ SUBROUTINE write_forces(qs_force, atomic_kind_set, ftype, output_unit, & iatom, ikind, " all_potential", qs_force(ikind)%all_potential(1:3, i), & iatom, ikind, " rho_elec", qs_force(ikind)%rho_elec(1:3, i), & iatom, ikind, " total", qs_force(ikind)%total(1:3, i) - grand_total(1:3) = grand_total(1:3)+qs_force(ikind)%total(1:3, i) + grand_total(1:3) = grand_total(1:3) + qs_force(ikind)%total(1:3, i) END DO CASE (3) DO iatom = 1, natom @@ -624,7 +624,7 @@ SUBROUTINE write_forces(qs_force, atomic_kind_set, ftype, output_unit, & iatom, ikind, " mp2_non_sep", qs_force(ikind)%mp2_non_sep(1:3, i), & iatom, ikind, " mp2_sep", qs_force(ikind)%mp2_sep(1:3, i), & iatom, ikind, " total", qs_force(ikind)%total(1:3, i) - grand_total(1:3) = grand_total(1:3)+qs_force(ikind)%total(1:3, i) + grand_total(1:3) = grand_total(1:3) + qs_force(ikind)%total(1:3, i) END DO CASE (4) DO iatom = 1, natom @@ -639,7 +639,7 @@ SUBROUTINE write_forces(qs_force, atomic_kind_set, ftype, output_unit, & iatom, ikind, " efield", qs_force(ikind)%efield(1:3, i), & iatom, ikind, " ehrenfest", qs_force(ikind)%ehrenfest(1:3, i), & iatom, ikind, " total", qs_force(ikind)%total(1:3, i) - grand_total(1:3) = grand_total(1:3)+qs_force(ikind)%total(1:3, i) + grand_total(1:3) = grand_total(1:3) + qs_force(ikind)%total(1:3, i) END DO CASE (5) DO iatom = 1, natom @@ -653,7 +653,7 @@ SUBROUTINE write_forces(qs_force, atomic_kind_set, ftype, output_unit, & iatom, ikind, " all potential", qs_force(ikind)%all_potential(1:3, i), & iatom, ikind, " other", qs_force(ikind)%other(1:3, i), & iatom, ikind, " total", qs_force(ikind)%total(1:3, i) - grand_total(1:3) = grand_total(1:3)+qs_force(ikind)%total(1:3, i) + grand_total(1:3) = grand_total(1:3) + qs_force(ikind)%total(1:3, i) END DO END SELECT diff --git a/src/qs_force_types.F b/src/qs_force_types.F index 24df072890..7635e93acd 100644 --- a/src/qs_force_types.F +++ b/src/qs_force_types.F @@ -330,28 +330,28 @@ SUBROUTINE replicate_qs_force(qs_force, para_env) CALL mp_sum(qs_force(ikind)%gcp, para_env%group) CALL mp_sum(qs_force(ikind)%ehrenfest, para_env%group) - qs_force(ikind)%total(:, :) = qs_force(ikind)%total(:, :)+ & - qs_force(ikind)%core_overlap(:, :)+ & - qs_force(ikind)%gth_ppl(:, :)+ & - qs_force(ikind)%gth_nlcc(:, :)+ & - qs_force(ikind)%gth_ppnl(:, :)+ & - qs_force(ikind)%all_potential(:, :)+ & - qs_force(ikind)%kinetic(:, :)+ & - qs_force(ikind)%overlap(:, :)+ & - qs_force(ikind)%overlap_admm(:, :)+ & - qs_force(ikind)%rho_core(:, :)+ & - qs_force(ikind)%rho_elec(:, :)+ & - qs_force(ikind)%rho_lri_elec(:, :)+ & - qs_force(ikind)%vhxc_atom(:, :)+ & - qs_force(ikind)%g0s_Vh_elec(:, :)+ & - qs_force(ikind)%fock_4c(:, :)+ & - qs_force(ikind)%mp2_non_sep(:, :)+ & - qs_force(ikind)%mp2_sep(:, :)+ & - qs_force(ikind)%repulsive(:, :)+ & - qs_force(ikind)%dispersion(:, :)+ & - qs_force(ikind)%gcp(:, :)+ & - qs_force(ikind)%ehrenfest(:, :)+ & - qs_force(ikind)%efield(:, :)+ & + qs_force(ikind)%total(:, :) = qs_force(ikind)%total(:, :) + & + qs_force(ikind)%core_overlap(:, :) + & + qs_force(ikind)%gth_ppl(:, :) + & + qs_force(ikind)%gth_nlcc(:, :) + & + qs_force(ikind)%gth_ppnl(:, :) + & + qs_force(ikind)%all_potential(:, :) + & + qs_force(ikind)%kinetic(:, :) + & + qs_force(ikind)%overlap(:, :) + & + qs_force(ikind)%overlap_admm(:, :) + & + qs_force(ikind)%rho_core(:, :) + & + qs_force(ikind)%rho_elec(:, :) + & + qs_force(ikind)%rho_lri_elec(:, :) + & + qs_force(ikind)%vhxc_atom(:, :) + & + qs_force(ikind)%g0s_Vh_elec(:, :) + & + qs_force(ikind)%fock_4c(:, :) + & + qs_force(ikind)%mp2_non_sep(:, :) + & + qs_force(ikind)%mp2_sep(:, :) + & + qs_force(ikind)%repulsive(:, :) + & + qs_force(ikind)%dispersion(:, :) + & + qs_force(ikind)%gcp(:, :) + & + qs_force(ikind)%ehrenfest(:, :) + & + qs_force(ikind)%efield(:, :) + & qs_force(ikind)%eev(:, :) END DO @@ -390,7 +390,7 @@ SUBROUTINE add_qs_force(force, qs_force, forcetype, atomic_kind_set) CALL get_atomic_kind(atomic_kind=atomic_kind, natom=natom_kind) DO ia = 1, natom_kind iatom = atomic_kind%atom_list(ia) - qs_force(ikind)%overlap_admm(:, ia) = qs_force(ikind)%overlap_admm(:, ia)+force(:, iatom) + qs_force(ikind)%overlap_admm(:, ia) = qs_force(ikind)%overlap_admm(:, ia) + force(:, iatom) END DO END DO CASE DEFAULT diff --git a/src/qs_gapw_densities.F b/src/qs_gapw_densities.F index 2cb6257fb0..507b02102d 100644 --- a/src/qs_gapw_densities.F +++ b/src/qs_gapw_densities.F @@ -149,7 +149,7 @@ SUBROUTINE prepare_gapw_den(qs_env, local_rho_set, do_rho0) ! Put the rho0_soft on the global grid CALL put_rho0_on_grid(qs_env, rho0_mpole, tot_rs_int) IF (ABS(rho0_h_tot) .GE. 1.0E-5_dp) THEN - IF (ABS(1.0_dp-ABS(tot_rs_int/rho0_h_tot)) .GT. 1.0E-3_dp) THEN + IF (ABS(1.0_dp - ABS(tot_rs_int/rho0_h_tot)) .GT. 1.0E-3_dp) THEN IF (output_unit > 0) THEN WRITE (output_unit, '(/,72("*"))') WRITE (output_unit, '(T2,A,T66,1E20.8)') & diff --git a/src/qs_gcp_method.F b/src/qs_gcp_method.F index 34327fab5b..e685cca698 100644 --- a/src/qs_gcp_method.F +++ b/src/qs_gcp_method.F @@ -174,7 +174,7 @@ SUBROUTINE calculate_gcp_pairpot(qs_env, gcp_env, energy, calculate_forces) CALL get_iterator_info(nl_iterator, mepos=mepos, ikind=ikind, jkind=jkind, iatom=iatom, jatom=jatom, r=rij) - rcc = SQRT(rij(1)*rij(1)+rij(2)*rij(2)+rij(3)*rij(3)) + rcc = SQRT(rij(1)*rij(1) + rij(2)*rij(2) + rij(3)*rij(3)) IF (rcc > 1.e-6_dp) THEN fac = 1._dp IF (iatom == jatom) fac = 0.5_dp @@ -209,25 +209,25 @@ SUBROUTINE calculate_gcp_pairpot(qs_env, gcp_env, energy, calculate_forces) ELSE fdb = 0.0_dp END IF - egcp = egcp+fac*(fda+fdb) + egcp = egcp + fac*(fda + fdb) IF (verbose) THEN - egcpat(iatom) = egcpat(iatom)+fac*fda - egcpat(jatom) = egcpat(jatom)+fac*fdb - ngcpat(iatom) = ngcpat(iatom)+1 - ngcpat(jatom) = ngcpat(jatom)+1 + egcpat(iatom) = egcpat(iatom) + fac*fda + egcpat(jatom) = egcpat(jatom) + fac*fdb + ngcpat(iatom) = ngcpat(iatom) + 1 + ngcpat(jatom) = ngcpat(jatom) + 1 END IF IF (calculate_forces) THEN - fdij = -fac*(fda+fdb)*(gcp_env%alpha*gcp_env%beta*rcc**(gcp_env%beta-1.0_dp)*rij(1:3)/rcc) + fdij = -fac*(fda + fdb)*(gcp_env%alpha*gcp_env%beta*rcc**(gcp_env%beta - 1.0_dp)*rij(1:3)/rcc) IF (sqa > 1.e-12_dp) THEN - fdij = fdij+0.25_dp*fac*fdb/(sqa*sqa)*dsint(1:3) + fdij = fdij + 0.25_dp*fac*fdb/(sqa*sqa)*dsint(1:3) END IF IF (sqb > 1.e-12_dp) THEN - fdij = fdij+0.25_dp*fac*fda/(sqb*sqb)*dsint(1:3) + fdij = fdij + 0.25_dp*fac*fda/(sqb*sqb)*dsint(1:3) END IF atom_a = atom_of_kind(iatom) atom_b = atom_of_kind(jatom) - force(ikind)%gcp(:, atom_a) = force(ikind)%gcp(:, atom_a)-fdij(:) - force(jkind)%gcp(:, atom_b) = force(jkind)%gcp(:, atom_b)+fdij(:) + force(ikind)%gcp(:, atom_a) = force(ikind)%gcp(:, atom_a) - fdij(:) + force(jkind)%gcp(:, atom_b) = force(jkind)%gcp(:, atom_b) + fdij(:) IF (use_virial) THEN CALL virial_pair_force(virial%pv_virial, -1._dp, fdij, rij) END IF @@ -237,8 +237,8 @@ SUBROUTINE calculate_gcp_pairpot(qs_env, gcp_env, energy, calculate_forces) END IF END IF IF (atenergy) THEN - atener(iatom) = atener(iatom)+fda*fac - atener(jatom) = atener(jatom)+fdb*fac + atener(iatom) = atener(iatom) + fda*fac + atener(jatom) = atener(jatom) + fdb*fac END IF END IF END DO @@ -274,7 +274,7 @@ SUBROUTINE calculate_gcp_pairpot(qs_env, gcp_env, energy, calculate_forces) atom_a = atom_of_kind(iatom) fdij(1:3) = force(ikind)%gcp(:, atom_a) CALL mp_sum(fdij, para_env%group) - gnorm = gnorm+SUM(ABS(fdij)) + gnorm = gnorm + SUM(ABS(fdij)) IF (unit_nr > 0) WRITE (unit_nr, "(i5,i7,3F20.14)") iatom, ikind, fdij END DO IF (unit_nr > 0) THEN @@ -283,12 +283,12 @@ SUBROUTINE calculate_gcp_pairpot(qs_env, gcp_env, energy, calculate_forces) WRITE (unit_nr, *) END IF IF (use_virial) THEN - dvirial = virial%pv_virial-dvirial + dvirial = virial%pv_virial - dvirial CALL mp_sum(dvirial, para_env%group) IF (unit_nr > 0) THEN WRITE (unit_nr, *) " Stress Tensor (gCP)" WRITE (unit_nr, "(3G20.12)") dvirial - WRITE (unit_nr, *) " Tr(P)/3 : ", (dvirial(1, 1)+dvirial(2, 2)+dvirial(3, 3))/3._dp + WRITE (unit_nr, *) " Tr(P)/3 : ", (dvirial(1, 1) + dvirial(2, 2) + dvirial(3, 3))/3._dp WRITE (unit_nr, *) END IF END IF diff --git a/src/qs_gcp_utils.F b/src/qs_gcp_utils.F index 412134e56f..c6d9146627 100644 --- a/src/qs_gcp_utils.F +++ b/src/qs_gcp_utils.F @@ -187,13 +187,13 @@ SUBROUTINE qs_gcp_init(qs_env, gcp_env) gcp_env%gcp_kind(ikind)%za = za gcp_env%gcp_kind(ikind)%asto = gcp_env%eta*SUM(sexp(1:4, za))/REAL(nll(za), KIND=dp) gcp_env%gcp_kind(ikind)%nq = nshell(za) - gcp_env%gcp_kind(ikind)%rcsto = ((nshell(za)-1)*2.5_dp-LOG(epsc))/gcp_env%gcp_kind(ikind)%asto + gcp_env%gcp_kind(ikind)%rcsto = ((nshell(za) - 1)*2.5_dp - LOG(epsc))/gcp_env%gcp_kind(ikind)%asto ! basis NULLIFY (orb_basis) CALL get_qs_kind(qs_kind, basis_set=orb_basis, basis_type="ORB") CALL get_gto_basis_set(gto_basis_set=orb_basis, nsgf=nbas) nel = SUM(qs_kind%elec_conf) - gcp_env%gcp_kind(ikind)%nbvirt = REAL(nbas, KIND=dp)-0.5_dp*REAL(nel, KIND=dp) + gcp_env%gcp_kind(ikind)%nbvirt = REAL(nbas, KIND=dp) - 0.5_dp*REAL(nel, KIND=dp) ! STO-nG nsto = SIZE(gcp_env%gcp_kind(ikind)%al) CALL get_sto_ng(gcp_env%gcp_kind(ikind)%asto, nsto, nshell(za), 0, al, cl) diff --git a/src/qs_grid_atom.F b/src/qs_grid_atom.F index 87968b3ead..7f8b649a1b 100644 --- a/src/qs_grid_atom.F +++ b/src/qs_grid_atom.F @@ -214,8 +214,8 @@ SUBROUTINE create_grid_atom(grid_atom, nr, na, llmax, ll, quadrature) CALL reallocate(grid_atom%cos_pol, 1, na) CALL reallocate(grid_atom%sin_pol, 1, na) CALL reallocate(grid_atom%usin_azi, 1, na) - CALL reallocate(grid_atom%rad2l, 1, nr, 0, llmax+1) - CALL reallocate(grid_atom%oorad2l, 1, nr, 0, llmax+1) + CALL reallocate(grid_atom%rad2l, 1, nr, 0, llmax + 1) + CALL reallocate(grid_atom%oorad2l, 1, nr, 0, llmax + 1) ! Calculate the radial grid for this kind rad => grid_atom%rad @@ -227,9 +227,9 @@ SUBROUTINE create_grid_atom(grid_atom, nr, na, llmax, ll, quadrature) grid_atom%rad2l(:, 0) = 1._dp grid_atom%oorad2l(:, 0) = 1._dp - DO l = 1, llmax+1 - grid_atom%rad2l(:, l) = grid_atom%rad2l(:, l-1)*rad(:) - grid_atom%oorad2l(:, l) = grid_atom%oorad2l(:, l-1)/rad(:) + DO l = 1, llmax + 1 + grid_atom%rad2l(:, l) = grid_atom%rad2l(:, l - 1)*rad(:) + grid_atom%oorad2l(:, l) = grid_atom%oorad2l(:, l - 1)/rad(:) ENDDO IF (ll > 0) THEN @@ -328,8 +328,8 @@ SUBROUTINE initialize_atomic_grid(int_grid, nr, na, rmax, quadrature, iunit) ! store grid points always in ascending order IF (rad(1) > rad(nr)) THEN DO ir = nr, 1, -1 - igr%rr(nr-ir+1) = rad(ir) - igr%wr(nr-ir+1) = wr(ir) + igr%rr(nr - ir + 1) = rad(ir) + igr%wr(nr - ir + 1) = wr(ir) END DO ELSE igr%rr(1:nr) = rad(1:nr) @@ -339,7 +339,7 @@ SUBROUTINE initialize_atomic_grid(int_grid, nr, na, rmax, quadrature, iunit) np = 0 DO ir = 1, nr IF (igr%rr(ir) < rmax) THEN - np = np+1 + np = np + 1 rad(np) = igr%rr(ir) wr(np) = igr%wr(ir) END IF @@ -366,32 +366,32 @@ SUBROUTINE initialize_atomic_grid(int_grid, nr, na, rmax, quadrature, iunit) ig = 0 DO ir = 1, igr%np DO ia = 1, igr%na - ig = ig+1 + ig = ig + 1 rco(1:3, ig) = rang(1:3, ia)*rad(ir) wc(ig) = wa(ia)*wr(ir) END DO END DO ! grid for batches, odd number of cells ng = NINT((REAL(ntot, dp)/32._dp)**0.33333_dp) - ng = ng+MOD(ng+1, 2) + ng = ng + MOD(ng + 1, 2) ! avarage number of points along radial grid dco = 0.0_dp ag = REAL(igr%np, dp)/ng - CPASSERT(SIZE(dco) >= (ng+1)/2) + CPASSERT(SIZE(dco) >= (ng + 1)/2) DO ig = 1, ng, 2 ir = MIN(NINT(ag)*ig, igr%np) - ia = (ig+1)/2 + ia = (ig + 1)/2 dco(ia) = rad(ir) END DO ! batches ALLOCATE (icell(ntot)) icell = 0 - nx = (ng-1)/2 + nx = (ng - 1)/2 DO ig = 1, ntot - ix = grid_coord(rco(1, ig), dco, nx+1)+nx - iy = grid_coord(rco(2, ig), dco, nx+1)+nx - iz = grid_coord(rco(3, ig), dco, nx+1)+nx - icell(ig) = iz*ng*ng+iy*ng+ix+1 + ix = grid_coord(rco(1, ig), dco, nx + 1) + nx + iy = grid_coord(rco(2, ig), dco, nx + 1) + nx + iz = grid_coord(rco(3, ig), dco, nx + 1) + nx + icell(ig) = iz*ng*ng + iy*ng + ix + 1 END DO ! igr%nbatch = ng*ng*ng @@ -399,7 +399,7 @@ SUBROUTINE initialize_atomic_grid(int_grid, nr, na, rmax, quadrature, iunit) igr%batch(:)%np = 0 DO ig = 1, ntot ia = icell(ig) - igr%batch(ia)%np = igr%batch(ia)%np+1 + igr%batch(ia)%np = igr%batch(ia)%np + 1 END DO DO ig = 1, igr%nbatch np = igr%batch(ig)%np @@ -408,7 +408,7 @@ SUBROUTINE initialize_atomic_grid(int_grid, nr, na, rmax, quadrature, iunit) END DO DO ig = 1, ntot ia = icell(ig) - igr%batch(ia)%np = igr%batch(ia)%np+1 + igr%batch(ia)%np = igr%batch(ia)%np + 1 np = igr%batch(ia)%np igr%batch(ia)%rco(1:3, np) = rco(1:3, ig) igr%batch(ia)%weight(np) = wc(ig) @@ -436,10 +436,10 @@ SUBROUTINE initialize_atomic_grid(int_grid, nr, na, rmax, quadrature, iunit) ! empty batch ELSE IF (igr%batch(ig)%np <= 48) THEN ! single batch - nbatch = nbatch+1 + nbatch = nbatch + 1 ELSE ! multiple batches - nbatch = nbatch+NINT(igr%batch(ig)%np/32._dp) + nbatch = nbatch + NINT(igr%batch(ig)%np/32._dp) END IF END DO int_grid%nbatch = nbatch @@ -451,7 +451,7 @@ SUBROUTINE initialize_atomic_grid(int_grid, nr, na, rmax, quadrature, iunit) ! empty batch ELSE IF (igr%batch(ig)%np <= 48) THEN ! single batch - n1 = n1+1 + n1 = n1 + 1 np = igr%batch(ig)%np ALLOCATE (int_grid%batch(n1)%rco(3, np), int_grid%batch(n1)%weight(np)) int_grid%batch(n1)%np = np @@ -461,17 +461,17 @@ SUBROUTINE initialize_atomic_grid(int_grid, nr, na, rmax, quadrature, iunit) ! multiple batches n2 = NINT(igr%batch(ig)%np/32._dp) n3 = igr%batch(ig)%np/n2 - DO ia = n1+1, n1+n2 - nu = (ia-n1-1)*n3+1 - no = nu+n3-1 - IF (ia == n1+n2) no = igr%batch(ig)%np - np = no-nu+1 + DO ia = n1 + 1, n1 + n2 + nu = (ia - n1 - 1)*n3 + 1 + no = nu + n3 - 1 + IF (ia == n1 + n2) no = igr%batch(ig)%np + np = no - nu + 1 ALLOCATE (int_grid%batch(ia)%rco(3, np), int_grid%batch(ia)%weight(np)) int_grid%batch(ia)%np = np int_grid%batch(ia)%rco(1:3, 1:np) = igr%batch(ig)%rco(1:3, nu:no) int_grid%batch(ia)%weight(1:np) = igr%batch(ig)%weight(nu:no) END DO - n1 = n1+n2 + n1 = n1 + n2 END IF END DO CPASSERT(nbatch == n1) @@ -487,7 +487,7 @@ SUBROUTINE initialize_atomic_grid(int_grid, nr, na, rmax, quadrature, iunit) int_grid%batch(ig)%rcenter(1:3) = rm(1:3) dmax = 0.0_dp DO ia = 1, np - dd = SUM((int_grid%batch(ig)%rco(1:3, ia)-rm(1:3))**2) + dd = SUM((int_grid%batch(ig)%rco(1:3, ia) - rm(1:3))**2) dmax = MAX(dd, dmax) END DO int_grid%batch(ig)%rad = SQRT(dmax) @@ -519,7 +519,7 @@ SUBROUTINE initialize_atomic_grid(int_grid, nr, na, rmax, quadrature, iunit) DO ig = 1, int_grid%nbatch r1 = MIN(r1, int_grid%batch(ig)%rad) r2 = MAX(r2, int_grid%batch(ig)%rad) - r3 = r3+int_grid%batch(ig)%rad + r3 = r3 + int_grid%batch(ig)%rad END DO r3 = r3/REAL(ng*ng*ng, KIND=dp) WRITE (iunit, "(A,T51,3F10.2)") " Batch radius (bohr) [min,max,ave]", r1, r2, r3 @@ -549,7 +549,7 @@ FUNCTION grid_coord(x, dco, ng) RESULT(igrid) igrid = ng DO ig = 1, ng IF (xval <= dco(ig)) THEN - igrid = ig-1 + igrid = ig - 1 EXIT END IF END DO @@ -614,7 +614,7 @@ SUBROUTINE radial_grid(n, r, r2, wr, radial_quadrature) INTEGER :: i REAL(dp) :: cost, f, sint, sint2, t, w, x - f = pi/REAL(n+1, dp) + f = pi/REAL(n + 1, dp) SELECT CASE (radial_quadrature) @@ -627,10 +627,10 @@ SUBROUTINE radial_grid(n, r, r2, wr, radial_quadrature) t = REAL(i, dp)*f x = COS(t) w = f*SIN(t)**2 - r(i) = (1.0_dp+x)/(1.0_dp-x) + r(i) = (1.0_dp + x)/(1.0_dp - x) r2(i) = r(i)**2 - wr(i) = w/SQRT(1.0_dp-x**2) - wr(i) = 2.0_dp*wr(i)*r2(i)/(1.0_dp-x)**2 + wr(i) = w/SQRT(1.0_dp - x**2) + wr(i) = 2.0_dp*wr(i)*r2(i)/(1.0_dp - x)**2 END DO CASE (do_gapw_gct) @@ -643,12 +643,12 @@ SUBROUTINE radial_grid(n, r, r2, wr, radial_quadrature) cost = COS(t) sint = SIN(t) sint2 = sint**2 - x = REAL(2*i-n-1, dp)/REAL(n+1, dp)- & - 2.0_dp*(1.0_dp+2.0_dp*sint2/3.0_dp)*cost*sint/pi - w = 16.0_dp*sint2**2/REAL(3*(n+1), dp) - r(n+1-i) = (1.0_dp+x)/(1.0_dp-x) - r2(n+1-i) = r(n+1-i)**2 - wr(n+1-i) = 2.0_dp*w*r2(n+1-i)/(1.0_dp-x)**2 + x = REAL(2*i - n - 1, dp)/REAL(n + 1, dp) - & + 2.0_dp*(1.0_dp + 2.0_dp*sint2/3.0_dp)*cost*sint/pi + w = 16.0_dp*sint2**2/REAL(3*(n + 1), dp) + r(n + 1 - i) = (1.0_dp + x)/(1.0_dp - x) + r2(n + 1 - i) = r(n + 1 - i)**2 + wr(n + 1 - i) = 2.0_dp*w*r2(n + 1 - i)/(1.0_dp - x)**2 END DO CASE (do_gapw_log) @@ -661,12 +661,12 @@ SUBROUTINE radial_grid(n, r, r2, wr, radial_quadrature) cost = COS(t) sint = SIN(t) sint2 = sint**2 - x = REAL(2*i-n-1, dp)/REAL(n+1, dp)- & - 2.0_dp*(1.0_dp+2.0_dp*sint2/3.0_dp)*cost*sint/pi - w = 16.0_dp*sint2**2/REAL(3*(n+1), dp) - r(n+1-i) = LOG(2.0_dp/(1.0_dp-x))/LOG(2.0_dp) - r2(n+1-i) = r(n+1-i)**2 - wr(n+1-i) = w*r2(n+1-i)/(LOG(2.0_dp)*(1.0_dp-x)) + x = REAL(2*i - n - 1, dp)/REAL(n + 1, dp) - & + 2.0_dp*(1.0_dp + 2.0_dp*sint2/3.0_dp)*cost*sint/pi + w = 16.0_dp*sint2**2/REAL(3*(n + 1), dp) + r(n + 1 - i) = LOG(2.0_dp/(1.0_dp - x))/LOG(2.0_dp) + r2(n + 1 - i) = r(n + 1 - i)**2 + wr(n + 1 - i) = w*r2(n + 1 - i)/(LOG(2.0_dp)*(1.0_dp - x)) END DO CASE DEFAULT diff --git a/src/qs_gspace_mixing.F b/src/qs_gspace_mixing.F index 2f9c740d4a..d028535218 100644 --- a/src/qs_gspace_mixing.F +++ b/src/qs_gspace_mixing.F @@ -124,7 +124,7 @@ SUBROUTINE gspace_mixing(qs_env, mixing_method, mixing_store, rho, para_env, ite CALL pw_scale(rho_g(2)%pw, -1.0_dp) END IF - IF (iter_count+1 <= mixing_store%nskip_mixing) THEN + IF (iter_count + 1 <= mixing_store%nskip_mixing) THEN ! skip mixing DO ispin = 1, nspin DO ig = 1, ng @@ -161,7 +161,7 @@ SUBROUTINE gspace_mixing(qs_env, mixing_method, mixing_store, rho, para_env, ite RETURN END IF - IF ((iter_count+1-mixing_store%nskip_mixing) <= mixing_store%n_simple_mix) THEN + IF ((iter_count + 1 - mixing_store%nskip_mixing) <= mixing_store%n_simple_mix) THEN CALL gmix_potential_only(qs_env, mixing_store, rho, para_env) mixing_store%iter_method = "Kerker" ELSEIF (mixing_method == gspace_mixing_nr) THEN @@ -252,12 +252,12 @@ SUBROUTINE gmix_potential_only(qs_env, mixing_store, rho, para_env) cc_new => rho_g(ispin)%pw%cc DO ig = 1, mixing_store%ig_max ! ng f_mix = mixing_store%alpha*mixing_store%kerker_factor(ig) - cc_new(ig) = (1.0_dp-f_mix)*mixing_store%rhoin(ispin)%cc(ig)+f_mix*cc_new(ig) + cc_new(ig) = (1.0_dp - f_mix)*mixing_store%rhoin(ispin)%cc(ig) + f_mix*cc_new(ig) mixing_store%rhoin(ispin)%cc(ig) = cc_new(ig) END DO - DO ig = mixing_store%ig_max+1, ng + DO ig = mixing_store%ig_max + 1, ng f_mix = mixing_store%alpha - cc_new(ig) = (1.0_dp-f_mix)*mixing_store%rhoin(ispin)%cc(ig)+f_mix*cc_new(ig) + cc_new(ig) = (1.0_dp - f_mix)*mixing_store%rhoin(ispin)%cc(ig) + f_mix*cc_new(ig) mixing_store%rhoin(ispin)%cc(ig) = cc_new(ig) END DO @@ -280,10 +280,10 @@ SUBROUTINE gmix_potential_only(qs_env, mixing_store, rho, para_env) DO ispin = 1, nspin DO iatom = 1, natom IF (mixing_store%paw(iatom)) THEN - rho_atom(iatom)%cpc_h(ispin)%r_coef = alpha*rho_atom(iatom)%cpc_h(ispin)%r_coef+ & - mixing_store%cpc_h_in(iatom, ispin)%r_coef*(1._dp-alpha) - rho_atom(iatom)%cpc_s(ispin)%r_coef = alpha*rho_atom(iatom)%cpc_s(ispin)%r_coef+ & - mixing_store%cpc_s_in(iatom, ispin)%r_coef*(1._dp-alpha) + rho_atom(iatom)%cpc_h(ispin)%r_coef = alpha*rho_atom(iatom)%cpc_h(ispin)%r_coef + & + mixing_store%cpc_h_in(iatom, ispin)%r_coef*(1._dp - alpha) + rho_atom(iatom)%cpc_s(ispin)%r_coef = alpha*rho_atom(iatom)%cpc_s(ispin)%r_coef + & + mixing_store%cpc_s_in(iatom, ispin)%r_coef*(1._dp - alpha) mixing_store%cpc_h_in(iatom, ispin)%r_coef = rho_atom(iatom)%cpc_h(ispin)%r_coef mixing_store%cpc_s_in(iatom, ispin)%r_coef = rho_atom(iatom)%cpc_s(ispin)%r_coef END IF @@ -354,12 +354,12 @@ SUBROUTINE pulay_mixing(qs_env, mixing_store, rho, para_env) natom = SIZE(rho_atom) END IF - ib = MODULO(mixing_store%ncall, nbuffer)+1 - mixing_store%ncall = mixing_store%ncall+1 + ib = MODULO(mixing_store%ncall, nbuffer) + 1 + mixing_store%ncall = mixing_store%ncall + 1 nb = MIN(mixing_store%ncall, nbuffer) - ibb = MODULO(mixing_store%ncall, nbuffer)+1 + ibb = MODULO(mixing_store%ncall, nbuffer) + 1 - nb1 = nb+1 + nb1 = nb + 1 ALLOCATE (a(nb1, nb1)) a = 0.0_dp ALLOCATE (b(nb1, nb1)) @@ -381,7 +381,7 @@ SUBROUTINE pulay_mixing(qs_env, mixing_store, rho, para_env) IF (nb == 1) mixing_store%rhoin_buffer(1, ispin)%cc = mixing_store%rhoin(ispin)%cc DO ig = 1, ng f_mix = mixing_store%kerker_factor(ig) - mixing_store%res_buffer(ib, ispin)%cc(ig) = f_mix*(rho_g(ispin)%pw%cc(ig)- & + mixing_store%res_buffer(ib, ispin)%cc(ig) = f_mix*(rho_g(ispin)%pw%cc(ig) - & mixing_store%rhoin_buffer(ib, ispin)%cc(ig)) END DO @@ -389,9 +389,9 @@ SUBROUTINE pulay_mixing(qs_env, mixing_store, rho, para_env) mixing_store%pulay_matrix(jb, ib) = 0.0_dp DO ig = 1, ng f_mix = mixing_store%special_metric(ig) - mixing_store%pulay_matrix(jb, ib) = mixing_store%pulay_matrix(jb, ib)+ & + mixing_store%pulay_matrix(jb, ib) = mixing_store%pulay_matrix(jb, ib) + & f_mix*(REAL(mixing_store%res_buffer(jb, ispin)%cc(ig), dp) & - *REAL(mixing_store%res_buffer(ib, ispin)%cc(ig), dp)+ & + *REAL(mixing_store%res_buffer(ib, ispin)%cc(ig), dp) + & AIMAG(mixing_store%res_buffer(jb, ispin)%cc(ig))* & AIMAG(mixing_store%res_buffer(ib, ispin)%cc(ig))) END DO @@ -403,9 +403,9 @@ SUBROUTINE pulay_mixing(qs_env, mixing_store, rho, para_env) IF (nb == 1) THEN DO ig = 1, ng f_mix = alpha_kerker*mixing_store%kerker_factor(ig) - cc_mix(ig) = rho_g(ispin)%pw%cc(ig)- & + cc_mix(ig) = rho_g(ispin)%pw%cc(ig) - & mixing_store%rhoin_buffer(ib, ispin)%cc(ig) - rho_g(ispin)%pw%cc(ig) = f_mix*cc_mix(ig)+ & + rho_g(ispin)%pw%cc(ig) = f_mix*cc_mix(ig) + & mixing_store%rhoin_buffer(ib, ispin)%cc(ig) mixing_store%rhoin_buffer(ibb, ispin)%cc(ig) = rho_g(ispin)%pw%cc(ig) END DO @@ -417,7 +417,7 @@ SUBROUTINE pulay_mixing(qs_env, mixing_store, rho, para_env) CALL dbcsr_add(matrix_a=rho_ao_kp(ispin, ic)%matrix, alpha_scalar=alpha_kerker, & matrix_b=mixing_store%rho_ao_in(ispin, ic)%matrix, & - beta_scalar=(1.0_dp-alpha_kerker)) + beta_scalar=(1.0_dp - alpha_kerker)) CALL dbcsr_copy(mixing_store%rho_ao_in_buffer(ispin, ic, ib)%matrix, mixing_store%rho_ao_in(ispin, ic)%matrix) CALL dbcsr_copy(mixing_store%rho_ao_in_buffer(ispin, ic, ibb)%matrix, rho_ao_kp(ispin, ic)%matrix) @@ -425,15 +425,15 @@ SUBROUTINE pulay_mixing(qs_env, mixing_store, rho, para_env) IF (gapw) THEN DO iatom = 1, natom IF (mixing_store%paw(iatom)) THEN - mixing_store%cpc_h_res_buffer(ib, iatom, ispin)%r_coef = rho_atom(iatom)%cpc_h(ispin)%r_coef- & + mixing_store%cpc_h_res_buffer(ib, iatom, ispin)%r_coef = rho_atom(iatom)%cpc_h(ispin)%r_coef - & mixing_store%cpc_h_in(iatom, ispin)%r_coef - mixing_store%cpc_s_res_buffer(ib, iatom, ispin)%r_coef = rho_atom(iatom)%cpc_s(ispin)%r_coef- & + mixing_store%cpc_s_res_buffer(ib, iatom, ispin)%r_coef = rho_atom(iatom)%cpc_s(ispin)%r_coef - & mixing_store%cpc_s_in(iatom, ispin)%r_coef - rho_atom(iatom)%cpc_h(ispin)%r_coef = alpha_kerker*rho_atom(iatom)%cpc_h(ispin)%r_coef+ & - (1.0_dp-alpha_kerker)*mixing_store%cpc_h_in(iatom, ispin)%r_coef - rho_atom(iatom)%cpc_s(ispin)%r_coef = alpha_kerker*rho_atom(iatom)%cpc_s(ispin)%r_coef+ & - (1.0_dp-alpha_kerker)*mixing_store%cpc_s_in(iatom, ispin)%r_coef + rho_atom(iatom)%cpc_h(ispin)%r_coef = alpha_kerker*rho_atom(iatom)%cpc_h(ispin)%r_coef + & + (1.0_dp - alpha_kerker)*mixing_store%cpc_h_in(iatom, ispin)%r_coef + rho_atom(iatom)%cpc_s(ispin)%r_coef = alpha_kerker*rho_atom(iatom)%cpc_s(ispin)%r_coef + & + (1.0_dp - alpha_kerker)*mixing_store%cpc_s_in(iatom, ispin)%r_coef mixing_store%cpc_h_in_buffer(ib, iatom, ispin)%r_coef = mixing_store%cpc_h_in(iatom, ispin)%r_coef mixing_store%cpc_s_in_buffer(ib, iatom, ispin)%r_coef = mixing_store%cpc_s_in(iatom, ispin)%r_coef @@ -455,16 +455,16 @@ SUBROUTINE pulay_mixing(qs_env, mixing_store, rho, para_env) alpha_c = 0.0_dp DO i = 1, nb DO jb = 1, nb - alpha_c(i) = alpha_c(i)+c_inv(jb, i) - norm_c_inv = norm_c_inv+c_inv(jb, i) + alpha_c(i) = alpha_c(i) + c_inv(jb, i) + norm_c_inv = norm_c_inv + c_inv(jb, i) END DO END DO alpha_c(1:nb) = alpha_c(1:nb)/norm_c_inv cc_mix = CMPLX(0._dp, 0._dp, KIND=dp) DO jb = 1, nb DO ig = 1, ng - cc_mix(ig) = cc_mix(ig)+ & - alpha_c(jb)*(mixing_store%rhoin_buffer(jb, ispin)%cc(ig)+ & + cc_mix(ig) = cc_mix(ig) + & + alpha_c(jb)*(mixing_store%rhoin_buffer(jb, ispin)%cc(ig) + & mixing_store%pulay_beta*mixing_store%res_buffer(jb, ispin)%cc(ig)) END DO END DO @@ -472,8 +472,8 @@ SUBROUTINE pulay_mixing(qs_env, mixing_store, rho, para_env) IF (alpha_pulay > 0.0_dp) THEN DO ig = 1, ng f_mix = alpha_pulay*mixing_store%kerker_factor(ig) - rho_g(ispin)%pw%cc(ig) = f_mix*rho_g(ispin)%pw%cc(ig)+ & - (1.0_dp-f_mix)*cc_mix(ig) + rho_g(ispin)%pw%cc(ig) = f_mix*rho_g(ispin)%pw%cc(ig) + & + (1.0_dp - f_mix)*cc_mix(ig) mixing_store%rhoin_buffer(ibb, ispin)%cc(ig) = rho_g(ispin)%pw%cc(ig) END DO ELSE @@ -500,7 +500,7 @@ SUBROUTINE pulay_mixing(qs_env, mixing_store, rho, para_env) beta_scalar=alpha_c(jb)*beta) END DO CALL dbcsr_add(matrix_a=rho_ao_kp(ispin, ic)%matrix, alpha_scalar=alpha_pulay, & - matrix_b=rho_ao_mix, beta_scalar=(1.0_dp-alpha_pulay)) + matrix_b=rho_ao_mix, beta_scalar=(1.0_dp - alpha_pulay)) CALL dbcsr_copy(mixing_store%rho_ao_in_buffer(ispin, ic, ibb)%matrix, rho_ao_kp(ispin, ic)%matrix) END DO END IF @@ -513,24 +513,24 @@ SUBROUTINE pulay_mixing(qs_env, mixing_store, rho, para_env) ALLOCATE (cpc_h_mix(n1, n2)) ALLOCATE (cpc_s_mix(n1, n2)) - mixing_store%cpc_h_res_buffer(ib, iatom, ispin)%r_coef = rho_atom(iatom)%cpc_h(ispin)%r_coef- & + mixing_store%cpc_h_res_buffer(ib, iatom, ispin)%r_coef = rho_atom(iatom)%cpc_h(ispin)%r_coef - & mixing_store%cpc_h_in_buffer(ib, iatom, ispin)%r_coef - mixing_store%cpc_s_res_buffer(ib, iatom, ispin)%r_coef = rho_atom(iatom)%cpc_s(ispin)%r_coef- & + mixing_store%cpc_s_res_buffer(ib, iatom, ispin)%r_coef = rho_atom(iatom)%cpc_s(ispin)%r_coef - & mixing_store%cpc_s_in_buffer(ib, iatom, ispin)%r_coef cpc_h_mix = 0.0_dp cpc_s_mix = 0.0_dp DO jb = 1, nb - cpc_h_mix(:, :) = cpc_h_mix(:, :)+ & - alpha_c(jb)*mixing_store%cpc_h_in_buffer(jb, iatom, ispin)%r_coef(:, :)+ & + cpc_h_mix(:, :) = cpc_h_mix(:, :) + & + alpha_c(jb)*mixing_store%cpc_h_in_buffer(jb, iatom, ispin)%r_coef(:, :) + & alpha_c(jb)*beta*mixing_store%cpc_h_res_buffer(jb, iatom, ispin)%r_coef(:, :) - cpc_s_mix(:, :) = cpc_s_mix(:, :)+ & - alpha_c(jb)*mixing_store%cpc_s_in_buffer(jb, iatom, ispin)%r_coef(:, :)+ & + cpc_s_mix(:, :) = cpc_s_mix(:, :) + & + alpha_c(jb)*mixing_store%cpc_s_in_buffer(jb, iatom, ispin)%r_coef(:, :) + & alpha_c(jb)*beta*mixing_store%cpc_s_res_buffer(jb, iatom, ispin)%r_coef(:, :) END DO - rho_atom(iatom)%cpc_h(ispin)%r_coef = alpha_pulay*rho_atom(iatom)%cpc_h(ispin)%r_coef+ & - (1.0_dp-alpha_pulay)*cpc_h_mix - rho_atom(iatom)%cpc_s(ispin)%r_coef = alpha_pulay*rho_atom(iatom)%cpc_s(ispin)%r_coef+ & - (1.0_dp-alpha_pulay)*cpc_s_mix + rho_atom(iatom)%cpc_h(ispin)%r_coef = alpha_pulay*rho_atom(iatom)%cpc_h(ispin)%r_coef + & + (1.0_dp - alpha_pulay)*cpc_h_mix + rho_atom(iatom)%cpc_s(ispin)%r_coef = alpha_pulay*rho_atom(iatom)%cpc_s(ispin)%r_coef + & + (1.0_dp - alpha_pulay)*cpc_s_mix mixing_store%cpc_h_in_buffer(ibb, iatom, ispin)%r_coef = rho_atom(iatom)%cpc_h(ispin)%r_coef mixing_store%cpc_s_in_buffer(ibb, iatom, ispin)%r_coef = rho_atom(iatom)%cpc_s(ispin)%r_coef DEALLOCATE (cpc_h_mix) @@ -609,13 +609,13 @@ SUBROUTINE broyden_mixing(qs_env, mixing_store, rho, para_env) ALLOCATE (res_rho(ng)) - mixing_store%ncall = mixing_store%ncall+1 + mixing_store%ncall = mixing_store%ncall + 1 IF (mixing_store%ncall == 1) THEN only_kerker = .TRUE. ELSE only_kerker = .FALSE. - nb = MIN(mixing_store%ncall-1, nbuffer) - ib = MODULO(mixing_store%ncall-2, nbuffer)+1 + nb = MIN(mixing_store%ncall - 1, nbuffer) + ib = MODULO(mixing_store%ncall - 2, nbuffer) + 1 END IF IF (gapw) THEN @@ -628,14 +628,14 @@ SUBROUTINE broyden_mixing(qs_env, mixing_store, rho, para_env) DO ispin = 1, nspin res_rho = CMPLX(0.0_dp, 0.0_dp, KIND=dp) DO ig = 1, ng - res_rho(ig) = rho_g(ispin)%pw%cc(ig)-mixing_store%rhoin(ispin)%cc(ig) + res_rho(ig) = rho_g(ispin)%pw%cc(ig) - mixing_store%rhoin(ispin)%cc(ig) END DO IF (only_kerker) THEN DO ig = 1, ng mixing_store%last_res(ispin)%cc(ig) = res_rho(ig) f_mix = alpha*mixing_store%kerker_factor(ig) - rho_g(ispin)%pw%cc(ig) = mixing_store%rhoin(ispin)%cc(ig)+f_mix*res_rho(ig) + rho_g(ispin)%pw%cc(ig) = mixing_store%rhoin(ispin)%cc(ig) + f_mix*res_rho(ig) mixing_store%rhoin_old(ispin)%cc(ig) = mixing_store%rhoin(ispin)%cc(ig) mixing_store%rhoin(ispin)%cc(ig) = rho_g(ispin)%pw%cc(ig) END DO @@ -648,7 +648,7 @@ SUBROUTINE broyden_mixing(qs_env, mixing_store, rho, para_env) CALL dbcsr_add(matrix_a=rho_ao_kp(ispin, ic)%matrix, alpha_scalar=alpha, & matrix_b=mixing_store%rho_ao_in(ispin, ic)%matrix, & - beta_scalar=(1.0_dp-alpha)) + beta_scalar=(1.0_dp - alpha)) CALL dbcsr_copy(mixing_store%rho_ao_in_old(ispin, ic)%matrix, mixing_store%rho_ao_in(ispin, ic)%matrix) CALL dbcsr_copy(mixing_store%rho_ao_in(ispin, ic)%matrix, rho_ao_kp(ispin, ic)%matrix) @@ -657,15 +657,15 @@ SUBROUTINE broyden_mixing(qs_env, mixing_store, rho, para_env) IF (gapw) THEN DO iatom = 1, natom IF (mixing_store%paw(iatom)) THEN - mixing_store%cpc_h_lastres(iatom, ispin)%r_coef = rho_atom(iatom)%cpc_h(ispin)%r_coef- & + mixing_store%cpc_h_lastres(iatom, ispin)%r_coef = rho_atom(iatom)%cpc_h(ispin)%r_coef - & mixing_store%cpc_h_in(iatom, ispin)%r_coef - mixing_store%cpc_s_lastres(iatom, ispin)%r_coef = rho_atom(iatom)%cpc_s(ispin)%r_coef- & + mixing_store%cpc_s_lastres(iatom, ispin)%r_coef = rho_atom(iatom)%cpc_s(ispin)%r_coef - & mixing_store%cpc_s_in(iatom, ispin)%r_coef - rho_atom(iatom)%cpc_h(ispin)%r_coef = alpha*rho_atom(iatom)%cpc_h(ispin)%r_coef+ & - mixing_store%cpc_h_in(iatom, ispin)%r_coef*(1._dp-alpha) - rho_atom(iatom)%cpc_s(ispin)%r_coef = alpha*rho_atom(iatom)%cpc_s(ispin)%r_coef+ & - mixing_store%cpc_s_in(iatom, ispin)%r_coef*(1._dp-alpha) + rho_atom(iatom)%cpc_h(ispin)%r_coef = alpha*rho_atom(iatom)%cpc_h(ispin)%r_coef + & + mixing_store%cpc_h_in(iatom, ispin)%r_coef*(1._dp - alpha) + rho_atom(iatom)%cpc_s(ispin)%r_coef = alpha*rho_atom(iatom)%cpc_s(ispin)%r_coef + & + mixing_store%cpc_s_in(iatom, ispin)%r_coef*(1._dp - alpha) mixing_store%cpc_h_old(iatom, ispin)%r_coef = mixing_store%cpc_h_in(iatom, ispin)%r_coef mixing_store%cpc_s_old(iatom, ispin)%r_coef = mixing_store%cpc_s_in(iatom, ispin)%r_coef @@ -689,20 +689,20 @@ SUBROUTINE broyden_mixing(qs_env, mixing_store, rho, para_env) delta_norm = 0.0_dp res_norm = 0.0_dp DO ig = 1, ng - mixing_store%res_buffer(ib, ispin)%cc(ig) = res_rho(ig)-mixing_store%last_res(ispin)%cc(ig) + mixing_store%res_buffer(ib, ispin)%cc(ig) = res_rho(ig) - mixing_store%last_res(ispin)%cc(ig) mixing_store%last_res(ispin)%cc(ig) = res_rho(ig) - res_norm = res_norm+ & - REAL(res_rho(ig), dp)*REAL(res_rho(ig), dp)+ & + res_norm = res_norm + & + REAL(res_rho(ig), dp)*REAL(res_rho(ig), dp) + & AIMAG(res_rho(ig))*AIMAG(res_rho(ig)) - delta_norm = delta_norm+ & + delta_norm = delta_norm + & REAL(mixing_store%res_buffer(ib, ispin)%cc(ig), dp)* & - REAL(mixing_store%res_buffer(ib, ispin)%cc(ig), dp)+ & + REAL(mixing_store%res_buffer(ib, ispin)%cc(ig), dp) + & AIMAG(mixing_store%res_buffer(ib, ispin)%cc(ig))* & AIMAG(mixing_store%res_buffer(ib, ispin)%cc(ig)) END DO DO ig = 1, ng mixing_store%drho_buffer(ib, ispin)%cc(ig) = & - mixing_store%rhoin(ispin)%cc(ig)- & + mixing_store%rhoin(ispin)%cc(ig) - & mixing_store%rhoin_old(ispin)%cc(ig) END DO CALL mp_sum(delta_norm, para_env%group) @@ -720,28 +720,28 @@ SUBROUTINE broyden_mixing(qs_env, mixing_store, rho, para_env) DO i = 1, n2 DO j = 1, n1 mixing_store%dcpc_h_in(ib, iatom, ispin)%r_coef(j, i) = & - (mixing_store%cpc_h_in(iatom, ispin)%r_coef(j, i)- & + (mixing_store%cpc_h_in(iatom, ispin)%r_coef(j, i) - & mixing_store%cpc_h_old(iatom, ispin)%r_coef(j, i))/delta_norm - dcpc_h_res = ((rho_atom(iatom)%cpc_h(ispin)%r_coef(j, i)- & - mixing_store%cpc_h_in(iatom, ispin)%r_coef(j, i))- & + dcpc_h_res = ((rho_atom(iatom)%cpc_h(ispin)%r_coef(j, i) - & + mixing_store%cpc_h_in(iatom, ispin)%r_coef(j, i)) - & mixing_store%cpc_h_lastres(iatom, ispin)%r_coef(j, i))/delta_norm - mixing_store%cpc_h_lastres(iatom, ispin)%r_coef(j, i) = rho_atom(iatom)%cpc_h(ispin)%r_coef(j, i)- & + mixing_store%cpc_h_lastres(iatom, ispin)%r_coef(j, i) = rho_atom(iatom)%cpc_h(ispin)%r_coef(j, i) - & mixing_store%cpc_h_in(iatom, ispin)%r_coef(j, i) mixing_store%dcpc_s_in(ib, iatom, ispin)%r_coef(j, i) = & - (mixing_store%cpc_s_in(iatom, ispin)%r_coef(j, i)- & + (mixing_store%cpc_s_in(iatom, ispin)%r_coef(j, i) - & mixing_store%cpc_s_old(iatom, ispin)%r_coef(j, i))/delta_norm - dcpc_s_res = ((rho_atom(iatom)%cpc_s(ispin)%r_coef(j, i)- & - mixing_store%cpc_s_in(iatom, ispin)%r_coef(j, i))- & + dcpc_s_res = ((rho_atom(iatom)%cpc_s(ispin)%r_coef(j, i) - & + mixing_store%cpc_s_in(iatom, ispin)%r_coef(j, i)) - & mixing_store%cpc_s_lastres(iatom, ispin)%r_coef(j, i))/delta_norm - mixing_store%cpc_s_lastres(iatom, ispin)%r_coef(j, i) = rho_atom(iatom)%cpc_s(ispin)%r_coef(j, i)- & + mixing_store%cpc_s_lastres(iatom, ispin)%r_coef(j, i) = rho_atom(iatom)%cpc_s(ispin)%r_coef(j, i) - & mixing_store%cpc_s_in(iatom, ispin)%r_coef(j, i) mixing_store%dcpc_h_in(ib, iatom, ispin)%r_coef(j, i) = & - alpha*dcpc_h_res+ & + alpha*dcpc_h_res + & mixing_store%dcpc_h_in(ib, iatom, ispin)%r_coef(j, i) mixing_store%dcpc_s_in(ib, iatom, ispin)%r_coef(j, i) = & - alpha*dcpc_s_res+ & + alpha*dcpc_s_res + & mixing_store%dcpc_s_in(ib, iatom, ispin)%r_coef(j, i) END DO END DO @@ -753,15 +753,15 @@ SUBROUTINE broyden_mixing(qs_env, mixing_store, rho, para_env) DO ig = 1, ng f_mix = alpha*mixing_store%kerker_factor(ig) mixing_store%drho_buffer(ib, ispin)%cc(ig) = & - f_mix*mixing_store%res_buffer(ib, ispin)%cc(ig)+ & + f_mix*mixing_store%res_buffer(ib, ispin)%cc(ig) + & mixing_store%drho_buffer(ib, ispin)%cc(ig) END DO DO jb = 1, nb DO kb = jb, nb DO ig = 1, mixing_store%ig_max !ng - a(kb, jb) = a(kb, jb)+mixing_store%p_metric(ig)*( & + a(kb, jb) = a(kb, jb) + mixing_store%p_metric(ig)*( & REAL(mixing_store%res_buffer(jb, ispin)%cc(ig), dp)* & - REAL(mixing_store%res_buffer(kb, ispin)%cc(ig), dp)+ & + REAL(mixing_store%res_buffer(kb, ispin)%cc(ig), dp) + & AIMAG(mixing_store%res_buffer(jb, ispin)%cc(ig))* & AIMAG(mixing_store%res_buffer(kb, ispin)%cc(ig))) END DO @@ -772,10 +772,10 @@ SUBROUTINE broyden_mixing(qs_env, mixing_store, rho, para_env) C = 0.0_dp DO jb = 1, nb - a(jb, jb) = w0+a(jb, jb) + a(jb, jb) = w0 + a(jb, jb) DO ig = 1, mixing_store%ig_max !ng - c(jb) = c(jb)+mixing_store%p_metric(ig)*( & - REAL(mixing_store%res_buffer(jb, ispin)%cc(ig), dp)*REAL(res_rho(ig), dp)+ & + c(jb) = c(jb) + mixing_store%p_metric(ig)*( & + REAL(mixing_store%res_buffer(jb, ispin)%cc(ig), dp)*REAL(res_rho(ig), dp) + & AIMAG(mixing_store%res_buffer(jb, ispin)%cc(ig))*AIMAG(res_rho(ig))) END DO END DO @@ -787,11 +787,11 @@ SUBROUTINE broyden_mixing(qs_env, mixing_store, rho, para_env) DO ig = 1, ng cc_mix = CMPLX(0.0_dp, 0.0_dp, kind=dp) DO jb = 1, nb - cc_mix = cc_mix-G(jb)*mixing_store%drho_buffer(jb, ispin)%cc(ig) + cc_mix = cc_mix - G(jb)*mixing_store%drho_buffer(jb, ispin)%cc(ig) END DO f_mix = alpha*mixing_store%kerker_factor(ig) - rho_g(ispin)%pw%cc(ig) = mixing_store%rhoin(ispin)%cc(ig)+ & - f_mix*res_rho(ig)+cc_mix + rho_g(ispin)%pw%cc(ig) = mixing_store%rhoin(ispin)%cc(ig) + & + f_mix*res_rho(ig) + cc_mix mixing_store%rhoin_old(ispin)%cc(ig) = mixing_store%rhoin(ispin)%cc(ig) mixing_store%rhoin(ispin)%cc(ig) = rho_g(ispin)%pw%cc(ig) END DO @@ -826,7 +826,7 @@ SUBROUTINE broyden_mixing(qs_env, mixing_store, rho, para_env) END DO CALL dbcsr_add(matrix_a=rho_ao_kp(ispin, ic)%matrix, alpha_scalar=alpha, & matrix_b=mixing_store%rho_ao_in(ispin, ic)%matrix, & - beta_scalar=(1.0_dp-alpha)) + beta_scalar=(1.0_dp - alpha)) CALL dbcsr_add(matrix_a=rho_ao_kp(ispin, ic)%matrix, alpha_scalar=1.0_dp, & matrix_b=rho_ao_mix, beta_scalar=-1.0_dp) @@ -845,15 +845,15 @@ SUBROUTINE broyden_mixing(qs_env, mixing_store, rho, para_env) valh = 0.0_dp vals = 0.0_dp DO jb = 1, nb - valh = valh-G(jb)*mixing_store%dcpc_h_in(jb, iatom, ispin)%r_coef(j, i) - vals = vals-G(jb)*mixing_store%dcpc_s_in(jb, iatom, ispin)%r_coef(j, i) + valh = valh - G(jb)*mixing_store%dcpc_h_in(jb, iatom, ispin)%r_coef(j, i) + vals = vals - G(jb)*mixing_store%dcpc_s_in(jb, iatom, ispin)%r_coef(j, i) END DO rho_atom(iatom)%cpc_h(ispin)%r_coef(j, i) = & - alpha*rho_atom(iatom)%cpc_h(ispin)%r_coef(j, i)+ & - mixing_store%cpc_h_in(iatom, ispin)%r_coef(j, i)*(1._dp-alpha)+valh + alpha*rho_atom(iatom)%cpc_h(ispin)%r_coef(j, i) + & + mixing_store%cpc_h_in(iatom, ispin)%r_coef(j, i)*(1._dp - alpha) + valh rho_atom(iatom)%cpc_s(ispin)%r_coef(j, i) = & - alpha*rho_atom(iatom)%cpc_s(ispin)%r_coef(j, i)+ & - mixing_store%cpc_s_in(iatom, ispin)%r_coef(j, i)*(1._dp-alpha)+vals + alpha*rho_atom(iatom)%cpc_s(ispin)%r_coef(j, i) + & + mixing_store%cpc_s_in(iatom, ispin)%r_coef(j, i)*(1._dp - alpha) + vals END DO END DO @@ -928,13 +928,13 @@ SUBROUTINE broyden_mixing_new(mixing_store, rho, para_env) wmax = mixing_store%wmax nbuffer = mixing_store%nbuffer - mixing_store%ncall = mixing_store%ncall+1 + mixing_store%ncall = mixing_store%ncall + 1 IF (mixing_store%ncall == 1) THEN only_kerker = .TRUE. ELSE only_kerker = .FALSE. - nb = MIN(mixing_store%ncall-1, nbuffer) - ib = MODULO(mixing_store%ncall-2, nbuffer)+1 + nb = MIN(mixing_store%ncall - 1, nbuffer) + ib = MODULO(mixing_store%ncall - 2, nbuffer) + 1 ALLOCATE (a(nb, nb)) a = 0.0_dp @@ -974,18 +974,18 @@ SUBROUTINE broyden_mixing_new(mixing_store, rho, para_env) ! Residual multiplied by the metrics RP_i(G) = (rho_out(G)-rho_in(G)) * P(G) ! Delta is the norm of the residual, measures how far we are from convergence DO ig = 1, ng - res_rho(ig) = rho_g(ispin)%pw%cc(ig)-mixing_store%rhoin(ispin)%cc(ig) + res_rho(ig) = rho_g(ispin)%pw%cc(ig) - mixing_store%rhoin(ispin)%cc(ig) res_rho_p(ig) = res_rho(ig)*p_metric(ig) !*sqt_uvol - norm_ig = REAL(res_rho(ig), dp)*REAL(res_rho(ig), dp)+AIMAG(res_rho(ig))*AIMAG(res_rho(ig)) - delta = delta+norm_ig - delta_p = delta_p+norm_ig*p_metric(ig) !*p_metric(ig) + norm_ig = REAL(res_rho(ig), dp)*REAL(res_rho(ig), dp) + AIMAG(res_rho(ig))*AIMAG(res_rho(ig)) + delta = delta + norm_ig + delta_p = delta_p + norm_ig*p_metric(ig) !*p_metric(ig) END DO CALL mp_sum(delta, para_env%group) delta = SQRT(delta) CALL mp_sum(delta_p, para_env%group) delta_p = SQRT(delta_p) - delta_rhog = delta_rhog+delta - delta_rhog_p = delta_rhog_p+delta_p + delta_rhog = delta_rhog + delta + delta_rhog_p = delta_rhog_p + delta_p weight(ib, ispin) = 1.0_dp ! wc IF (wc < 0.0_dp) weight(ib, ispin) = 0.01_dp*ABS(wc)/(delta_p*delta_p) @@ -996,7 +996,7 @@ SUBROUTINE broyden_mixing_new(mixing_store, rho, para_env) ! Simple Kerker damping : linear mixing rho(G) = rho_in(G) - alpha k(G)*(rho_out(G)-rho_in(G)) DO ig = 1, ng f_mix = alpha*mixing_store%kerker_factor(ig) - rho_g(ispin)%pw%cc(ig) = mixing_store%rhoin(ispin)%cc(ig)+f_mix*res_rho(ig) + rho_g(ispin)%pw%cc(ig) = mixing_store%rhoin(ispin)%cc(ig) + f_mix*res_rho(ig) mixing_store%rhoin_old(ispin)%cc(ig) = mixing_store%rhoin(ispin)%cc(ig) mixing_store%rhoin(ispin)%cc(ig) = rho_g(ispin)%pw%cc(ig) mixing_store%last_res(ispin)%cc(ig) = res_rho(ig) @@ -1005,11 +1005,11 @@ SUBROUTINE broyden_mixing_new(mixing_store, rho, para_env) norm = 0.0_dp ! Difference of residuals DR_{i-1)} (G) = R_i(G) - R_{i-1}(G) DO ig = 1, ng - delta_res(ib, ispin)%cc(ig) = res_rho(ig)-mixing_store%last_res(ispin)%cc(ig) + delta_res(ib, ispin)%cc(ig) = res_rho(ig) - mixing_store%last_res(ispin)%cc(ig) delta_res_p(ig) = p_metric(ig)*delta_res(ib, ispin)%cc(ig) - norm_ig = REAL(delta_res(ib, ispin)%cc(ig), dp)*REAL(delta_res_p(ig), dp)+ & + norm_ig = REAL(delta_res(ib, ispin)%cc(ig), dp)*REAL(delta_res_p(ig), dp) + & AIMAG(delta_res(ib, ispin)%cc(ig))*AIMAG(delta_res_p(ig)) - norm = norm+norm_ig + norm = norm + norm_ig END DO CALL mp_sum(norm, para_env%group) norm = 1._dp/SQRT(norm) @@ -1019,9 +1019,9 @@ SUBROUTINE broyden_mixing_new(mixing_store, rho, para_env) IF (para_env%ionode) WRITE (*, *) 'norm ', norm ! Vector U_{i-1}(G) = Drho_{i-1} + k(G) * DR_{i-1}(G) DO ig = 1, ng - tmp(ig) = (mixing_store%rhoin(ispin)%cc(ig)- & + tmp(ig) = (mixing_store%rhoin(ispin)%cc(ig) - & mixing_store%rhoin_old(ispin)%cc(ig))*norm - u_vec(ib, ispin)%cc(ig) = (tmp(ig)+ & + u_vec(ib, ispin)%cc(ig) = (tmp(ig) + & mixing_store%kerker_factor(ig)*delta_res(ib, ispin)%cc(ig)) END DO @@ -1034,7 +1034,7 @@ SUBROUTINE broyden_mixing_new(mixing_store, rho, para_env) ! < DR_{j} | DR_{i-1} > rep = REAL(delta_res_p(ig), dp) imp = AIMAG(delta_res_p(ig)) - fmat(jb, ib) = fmat(jb, ib)+rep_j*rep+imp_j*imp + fmat(jb, ib) = fmat(jb, ib) + rep_j*rep + imp_j*imp END DO END DO @@ -1048,7 +1048,7 @@ SUBROUTINE broyden_mixing_new(mixing_store, rho, para_env) DO jb = 1, nb a(jb, jb) = weight(jb, ispin)*weight(jb, ispin)*fmat(jb, jb) - DO kb = 1, jb-1 + DO kb = 1, jb - 1 a(jb, kb) = weight(jb, ispin)*weight(kb, ispin)*fmat(jb, kb) a(kb, jb) = weight(jb, ispin)*weight(kb, ispin)*fmat(kb, jb) ENDDO @@ -1058,16 +1058,16 @@ SUBROUTINE broyden_mixing_new(mixing_store, rho, para_env) CALL invert_matrix(a, b, inv_err) ELSE b = 0.0_dp - ALLOCATE (work(ib-1, ib-1), aval(ib-1), av(ib-1, ib-1), au(ib-1, ib-1)) + ALLOCATE (work(ib - 1, ib - 1), aval(ib - 1), av(ib - 1, ib - 1), au(ib - 1, ib - 1)) work(:, :) = a - ALLOCATE (iwork(8*(ib-1)), work_dgesdd(1)) + ALLOCATE (iwork(8*(ib - 1)), work_dgesdd(1)) lwork = -1 - CALL DGESDD('S', ib-1, ib-1, work, ib-1, aval, au, ib-1, av, ib-1, work_dgesdd, lwork, iwork, info) + CALL DGESDD('S', ib - 1, ib - 1, work, ib - 1, aval, au, ib - 1, av, ib - 1, work_dgesdd, lwork, iwork, info) lwork = INT(work_dgesdd(1)) DEALLOCATE (work_dgesdd); ALLOCATE (work_dgesdd(lwork)) - CALL DGESDD('S', ib-1, ib-1, work, ib-1, aval, au, ib-1, av, ib-1, work_dgesdd, lwork, iwork, info) + CALL DGESDD('S', ib - 1, ib - 1, work, ib - 1, aval, au, ib - 1, av, ib - 1, work_dgesdd, lwork, iwork, info) ! construct the inverse - DO kb = 1, ib-1 + DO kb = 1, ib - 1 ! invert SV IF (aval(kb) < 1.E-6_dp) THEN aval(kb) = 0.0_dp @@ -1076,7 +1076,7 @@ SUBROUTINE broyden_mixing_new(mixing_store, rho, para_env) ENDIF av(kb, :) = av(kb, :)*aval(kb) ENDDO - CALL DGEMM('T', 'T', ib-1, ib-1, ib-1, 1.0_dp, av, ib-1, au, ib-1, 0.0_dp, b, ib-1) + CALL DGEMM('T', 'T', ib - 1, ib - 1, ib - 1, 1.0_dp, av, ib - 1, au, ib - 1, 0.0_dp, b, ib - 1) DEALLOCATE (iwork, aval, au, av, work_dgesdd, work) END IF @@ -1087,10 +1087,10 @@ SUBROUTINE broyden_mixing_new(mixing_store, rho, para_env) DO kb = 1, nb bq(jb, kb) = 0.0_dp DO kkb = 1, nb - bq(jb, kb) = bq(jb, kb)-weight(jb, ispin)*weight(kkb, ispin)*b(jb, kkb)*fmat(kkb, kb) + bq(jb, kb) = bq(jb, kb) - weight(jb, ispin)*weight(kkb, ispin)*b(jb, kkb)*fmat(kkb, kb) END DO END DO - bq(jb, jb) = 1.0_dp+bq(jb, jb) + bq(jb, jb) = 1.0_dp + bq(jb, jb) END DO IF (.NOT. skip_bq) THEN @@ -1109,15 +1109,15 @@ SUBROUTINE broyden_mixing_new(mixing_store, rho, para_env) DO kb = 1, nb IF (weight(kb, ispin) >= (10.0_dp*wmax)) CYCLE DO ig = 1, ng - tmp(ig) = tmp(ig)+bq(jb, kb)*z_vec(kb, ispin)%cc(ig) + tmp(ig) = tmp(ig) + bq(jb, kb)*z_vec(kb, ispin)%cc(ig) END DO END DO ! kb END IF ! sum_{kb} w(jb)*w(kb)*b(jb,kb) * u_vec_{kb} - DO kb = 1, ib-1 + DO kb = 1, ib - 1 DO ig = 1, ng - tmp(ig) = tmp(ig)+weight(kb, ispin)*weight(jb, ispin)*b(jb, kb)*u_vec(kb, ispin)%cc(ig) + tmp(ig) = tmp(ig) + weight(kb, ispin)*weight(jb, ispin)*b(jb, kb)*u_vec(kb, ispin)%cc(ig) END DO END DO @@ -1131,7 +1131,7 @@ SUBROUTINE broyden_mixing_new(mixing_store, rho, para_env) END DO !jb IF (.NOT. skip_bq) THEN - DO jb = 1, ib-1 + DO jb = 1, ib - 1 IF (weight(jb, ispin) < (10._dp*wmax)) z_vec(jb, ispin)%cc(:) = tmp_z(jb)%cc(:) DEALLOCATE (tmp_z(jb)%cc) END DO @@ -1140,27 +1140,27 @@ SUBROUTINE broyden_mixing_new(mixing_store, rho, para_env) ! Overwrite the density i reciprocal space rho_g(ispin)%pw%cc(:) = CMPLX(0.0_dp, 0.0_dp, KIND=dp) - DO jb = 1, ib-1 + DO jb = 1, ib - 1 norm = 0.0_dp DO ig = 1, ng rep_j = REAL(delta_res(jb, ispin)%cc(ig), dp) imp_j = AIMAG(delta_res(jb, ispin)%cc(ig)) rep = REAL(res_rho_p(ig), dp) imp = AIMAG(res_rho_p(ig)) - norm = norm+rep_j*rep+imp_j*imp + norm = norm + rep_j*rep + imp_j*imp END DO CALL mp_sum(norm, para_env%group) ! Subtract |Z_jb)> DO ig = 1, ng - rho_g(ispin)%pw%cc(ig) = rho_g(ispin)%pw%cc(ig)-norm*z_vec(jb, ispin)%cc(ig)*sqt_vol + rho_g(ispin)%pw%cc(ig) = rho_g(ispin)%pw%cc(ig) - norm*z_vec(jb, ispin)%cc(ig)*sqt_vol END DO END DO DO ig = 1, ng f_mix = alpha*mixing_store%kerker_factor(ig) - rho_g(ispin)%pw%cc(ig) = rho_g(ispin)%pw%cc(ig)+ & - mixing_store%rhoin_buffer(ib, ispin)%cc(ig)+f_mix*res_rho(ig) + rho_g(ispin)%pw%cc(ig) = rho_g(ispin)%pw%cc(ig) + & + mixing_store%rhoin_buffer(ib, ispin)%cc(ig) + f_mix*res_rho(ig) mixing_store%rhoin_buffer(ibb, ispin)%cc(ig) = rho_g(ispin)%pw%cc(ig) END DO @@ -1247,24 +1247,24 @@ SUBROUTINE multisecant_mixing(mixing_store, rho, para_env) nbuffer = mixing_store%nbuffer ! determine the step number, and multisecant iteration - nb = MIN(mixing_store%ncall, nbuffer-1) - ib = MODULO(mixing_store%ncall, nbuffer)+1 + nb = MIN(mixing_store%ncall, nbuffer - 1) + ib = MODULO(mixing_store%ncall, nbuffer) + 1 IF (mixing_store%ncall > 0) THEN - ib_prev = MODULO(mixing_store%ncall-1, nbuffer)+1 + ib_prev = MODULO(mixing_store%ncall - 1, nbuffer) + 1 ELSE ib_prev = 0 END IF - mixing_store%ncall = mixing_store%ncall+1 - ib_next = MODULO(mixing_store%ncall, nbuffer)+1 + mixing_store%ncall = mixing_store%ncall + 1 + ib_next = MODULO(mixing_store%ncall, nbuffer) + 1 ! compute the residual gn and its norm gn_norm DO ispin = 1, nspin gn => mixing_store%res_buffer(ib, ispin)%cc gn_norm = 0.0_dp DO ig = 1, ng - gn(ig) = (rho_g(ispin)%pw%cc(ig)-mixing_store%rhoin_buffer(ib, ispin)%cc(ig)) - gn_norm = gn_norm+ & - REAL(gn(ig), dp)*REAL(gn(ig), dp)+AIMAG(gn(ig))*AIMAG(gn(ig)) + gn(ig) = (rho_g(ispin)%pw%cc(ig) - mixing_store%rhoin_buffer(ib, ispin)%cc(ig)) + gn_norm = gn_norm + & + REAL(gn(ig), dp)*REAL(gn(ig), dp) + AIMAG(gn(ig))*AIMAG(gn(ig)) END DO CALL mp_sum(gn_norm, para_env%group) gn_norm = SQRT(gn_norm) @@ -1276,7 +1276,7 @@ SUBROUTINE multisecant_mixing(mixing_store, rho, para_env) DO ispin = 1, nspin DO ig = 1, ng f_mix = alpha*mixing_store%kerker_factor(ig) - rho_g(ispin)%pw%cc(ig) = mixing_store%rhoin_buffer(1, ispin)%cc(ig)+ & + rho_g(ispin)%pw%cc(ig) = mixing_store%rhoin_buffer(1, ispin)%cc(ig) + & f_mix*mixing_store%res_buffer(1, ispin)%cc(ig) mixing_store%rhoin_buffer(ib_next, ispin)%cc(ig) = rho_g(ispin)%pw%cc(ig) END DO @@ -1331,11 +1331,11 @@ SUBROUTINE multisecant_mixing(mixing_store, rho, para_env) ! These quantities are pre-conditioned by means of Kerker factor multipliccation g2 => rho_g(1)%pw%pw_grid%gsq - DO jb = 1, nb+1 + DO jb = 1, nb + 1 IF (jb < ib) THEN kb = jb ELSEIF (jb > ib) THEN - kb = jb-1 + kb = jb - 1 ELSE CYCLE END IF @@ -1346,19 +1346,19 @@ SUBROUTINE multisecant_mixing(mixing_store, rho, para_env) prec = 1.0_dp - step_matrix(ig, kb) = prec*(mixing_store%rhoin_buffer(jb, ispin)%cc(ig)- & + step_matrix(ig, kb) = prec*(mixing_store%rhoin_buffer(jb, ispin)%cc(ig) - & mixing_store%rhoin_buffer(ib, ispin)%cc(ig)) - res_matrix(ig, kb) = (mixing_store%res_buffer(jb, ispin)%cc(ig)- & + res_matrix(ig, kb) = (mixing_store%res_buffer(jb, ispin)%cc(ig) - & mixing_store%res_buffer(ib, ispin)%cc(ig)) - norm_res(kb) = norm_res(kb)+REAL(res_matrix(ig, kb), dp)*REAL(res_matrix(ig, kb), dp)+ & + norm_res(kb) = norm_res(kb) + REAL(res_matrix(ig, kb), dp)*REAL(res_matrix(ig, kb), dp) + & AIMAG(res_matrix(ig, kb))*AIMAG(res_matrix(ig, kb)) IF (g2(ig) < 4.0_dp) THEN - norm_res_low(kb) = norm_res_low(kb)+ & - REAL(res_matrix(ig, kb), dp)*REAL(res_matrix(ig, kb), dp)+ & + norm_res_low(kb) = norm_res_low(kb) + & + REAL(res_matrix(ig, kb), dp)*REAL(res_matrix(ig, kb), dp) + & AIMAG(res_matrix(ig, kb))*AIMAG(res_matrix(ig, kb)) ELSE - norm_res_up(kb) = norm_res_up(kb)+ & - REAL(res_matrix(ig, kb), dp)*REAL(res_matrix(ig, kb), dp)+ & + norm_res_up(kb) = norm_res_up(kb) + & + REAL(res_matrix(ig, kb), dp)*REAL(res_matrix(ig, kb), dp) + & AIMAG(res_matrix(ig, kb))*AIMAG(res_matrix(ig, kb)) END IF res_matrix(ig, kb) = prec*res_matrix(ig, kb) @@ -1373,8 +1373,8 @@ SUBROUTINE multisecant_mixing(mixing_store, rho, para_env) n_low = 0.0_dp n_up = 0.0_dp DO jb = 1, nb - n_low = n_low+norm_res_low(jb)/norm_res(jb) - n_up = n_up+norm_res_up(jb)/norm_res(jb) + n_low = n_low + norm_res_low(jb)/norm_res(jb) + n_up = n_up + norm_res_up(jb)/norm_res(jb) END DO DO ig = 1, ng IF (g2(ig) > 4.0_dp) THEN @@ -1395,14 +1395,14 @@ SUBROUTINE multisecant_mixing(mixing_store, rho, para_env) DO ig = 1, ng ! it is assumed that summing over all G vector gives a real, because ! y(-G,kb) = (y(G,kb))* - b_matrix(kb, jb) = b_matrix(kb, jb)+REAL(res_matrix(ig, kb)*res_matrix(ig, jb), dp) + b_matrix(kb, jb) = b_matrix(kb, jb) + REAL(res_matrix(ig, kb)*res_matrix(ig, jb), dp) END DO END DO END DO CALL mp_sum(b_matrix, para_env%group) DO jb = 1, nb - b_matrix(jb, jb) = b_matrix(jb, jb)+reg_par + b_matrix(jb, jb) = b_matrix(jb, jb) + reg_par END DO ! invert B CALL invert_matrix(b_matrix, binv_matrix, inv_err) @@ -1420,7 +1420,7 @@ SUBROUTINE multisecant_mixing(mixing_store, rho, para_env) DO jb = 1, nb DO ig = 1, ng ig_global = mixing_store%ig_global_index(ig) - a_matrix(jb, ig_global) = a_matrix(jb, ig_global)+ & + a_matrix(jb, ig_global) = a_matrix(jb, ig_global) + & binv_matrix(jb, kb)*res_matrix_global(ig_global) END DO END DO @@ -1439,7 +1439,7 @@ SUBROUTINE multisecant_mixing(mixing_store, rho, para_env) a_matrix(1, 1), nb, czero, ya(1, 1), ng) DO ig = 1, ng ig_global = mixing_store%ig_global_index(ig) - ya(ig, ig_global) = ya(ig, ig_global)+CMPLX(1.0_dp, 0.0_dp, KIND=dp) + ya(ig, ig_global) = ya(ig, ig_global) + CMPLX(1.0_dp, 0.0_dp, KIND=dp) END DO CALL zgemv("N", ng, ng_global, cone, sa(1, 1), & @@ -1448,7 +1448,7 @@ SUBROUTINE multisecant_mixing(mixing_store, rho, para_env) ng, gn_global(1), 1, czero, ugn(1), 1) DO ig = 1, ng - pgn_norm = pgn_norm+REAL(pgn(ig), dp)*REAL(pgn(ig), dp)+ & + pgn_norm = pgn_norm + REAL(pgn(ig), dp)*REAL(pgn(ig), dp) + & AIMAG(pgn(ig))*AIMAG(pgn(ig)) END DO CALL mp_sum(pgn_norm, para_env%group) @@ -1464,9 +1464,9 @@ SUBROUTINE multisecant_mixing(mixing_store, rho, para_env) tmp_vec(1), 1, czero, ugn(1), 1) DO ig = 1, ng - pgn_norm = pgn_norm+REAL(pgn(ig), dp)*REAL(pgn(ig), dp)+ & + pgn_norm = pgn_norm + REAL(pgn(ig), dp)*REAL(pgn(ig), dp) + & AIMAG(pgn(ig))*AIMAG(pgn(ig)) - ugn(ig) = ugn(ig)+gn(ig) + ugn(ig) = ugn(ig) + gn(ig) END DO CALL mp_sum(pgn_norm, para_env%group) @@ -1482,15 +1482,15 @@ SUBROUTINE multisecant_mixing(mixing_store, rho, para_env) IF (ig_global == iig) yaa = CMPLX(1.0_dp, 0.0_dp, KIND=dp) DO jb = 1, nb - saa = saa-step_matrix(ig, jb)*a_matrix(jb, iig) - yaa = yaa-res_matrix(ig, jb)*a_matrix(jb, iig) + saa = saa - step_matrix(ig, jb)*a_matrix(jb, iig) + yaa = yaa - res_matrix(ig, jb)*a_matrix(jb, iig) END DO - pgn(ig) = pgn(ig)+saa*gn_global(iig) - ugn(ig) = ugn(ig)+yaa*gn_global(iig) + pgn(ig) = pgn(ig) + saa*gn_global(iig) + ugn(ig) = ugn(ig) + yaa*gn_global(iig) END DO END DO DO ig = 1, ng - pgn_norm = pgn_norm+REAL(pgn(ig), dp)*REAL(pgn(ig), dp)+ & + pgn_norm = pgn_norm + REAL(pgn(ig), dp)*REAL(pgn(ig), dp) + & AIMAG(pgn(ig))*AIMAG(pgn(ig)) END DO CALL mp_sum(pgn_norm, para_env%group) @@ -1512,7 +1512,7 @@ SUBROUTINE multisecant_mixing(mixing_store, rho, para_env) DO ig = 1, ng prec = mixing_store%kerker_factor(ig) rho_g(ispin)%pw%cc(ig) = mixing_store%rhoin_buffer(ib, ispin)%cc(ig) & - -prec*step_size*ugn(ig)+prec*pgn(ig) ! - 0.1_dp * prec* gn(ig) + - prec*step_size*ugn(ig) + prec*pgn(ig) ! - 0.1_dp * prec* gn(ig) mixing_store%rhoin_buffer(ib_next, ispin)%cc(ig) = rho_g(ispin)%pw%cc(ig) END DO diff --git a/src/qs_harmonics_atom.F b/src/qs_harmonics_atom.F index 9485ecf8b7..fbfd3b2f35 100644 --- a/src/qs_harmonics_atom.F +++ b/src/qs_harmonics_atom.F @@ -225,7 +225,7 @@ SUBROUTINE create_harmonics_atom(harmonics, my_CG, na, llmax, maxs, max_s_harm, CALL y_lm(lebedev_grid(ll)%r, y, l, m) slm(1:na, iso) = y(1:na) DO i = 1, na - slm_int(iso) = slm_int(iso)+slm(i, iso)*wa(i) + slm_int(iso) = slm_int(iso) + slm(i, iso)*wa(i) END DO ! i END DO ! iso @@ -241,9 +241,9 @@ SUBROUTINE create_harmonics_atom(harmonics, my_CG, na, llmax, maxs, max_s_harm, DO ia = 1, na DO l = 0, indso(1, max_s_harm) DO ic = 1, nco(l) - lx = indco(1, ic+ncoset(l-1)) - ly = indco(2, ic+ncoset(l-1)) - lz = indco(3, ic+ncoset(l-1)) + lx = indco(1, ic + ncoset(l - 1)) + ly = indco(2, ic + ncoset(l - 1)) + lz = indco(3, ic + ncoset(l - 1)) IF (lx == 0) THEN rx = 1.0_dp @@ -253,7 +253,7 @@ SUBROUTINE create_harmonics_atom(harmonics, my_CG, na, llmax, maxs, max_s_harm, drx = 1.0_dp ELSE rx = lebedev_grid(ll)%r(1, ia)**lx - drx = REAL(lx, dp)*lebedev_grid(ll)%r(1, ia)**(lx-1) + drx = REAL(lx, dp)*lebedev_grid(ll)%r(1, ia)**(lx - 1) END IF IF (ly == 0) THEN ry = 1.0_dp @@ -263,7 +263,7 @@ SUBROUTINE create_harmonics_atom(harmonics, my_CG, na, llmax, maxs, max_s_harm, dry = 1.0_dp ELSE ry = lebedev_grid(ll)%r(2, ia)**ly - dry = REAL(ly, dp)*lebedev_grid(ll)%r(2, ia)**(ly-1) + dry = REAL(ly, dp)*lebedev_grid(ll)%r(2, ia)**(ly - 1) END IF IF (lz == 0) THEN rz = 1.0_dp @@ -273,22 +273,22 @@ SUBROUTINE create_harmonics_atom(harmonics, my_CG, na, llmax, maxs, max_s_harm, drz = 1.0_dp ELSE rz = lebedev_grid(ll)%r(3, ia)**lz - drz = REAL(lz, dp)*lebedev_grid(ll)%r(3, ia)**(lz-1) + drz = REAL(lz, dp)*lebedev_grid(ll)%r(3, ia)**(lz - 1) END IF dc(ic, 1) = drx*ry*rz dc(ic, 2) = rx*dry*rz dc(ic, 3) = rx*ry*drz END DO - n = nsoset(l-1) + n = nsoset(l - 1) DO is = 1, nso(l) - iso = is+n + iso = is + n dslm_dxyz(1:3, ia, iso) = 0.0_dp DO ic = 1, nco(l) - dslm_dxyz(1, ia, iso) = dslm_dxyz(1, ia, iso)+ & + dslm_dxyz(1, ia, iso) = dslm_dxyz(1, ia, iso) + & orbtramat(l)%slm(is, ic)*dc(ic, 1) - dslm_dxyz(2, ia, iso) = dslm_dxyz(2, ia, iso)+ & + dslm_dxyz(2, ia, iso) = dslm_dxyz(2, ia, iso) + & orbtramat(l)%slm(is, ic)*dc(ic, 2) - dslm_dxyz(3, ia, iso) = dslm_dxyz(3, ia, iso)+ & + dslm_dxyz(3, ia, iso) = dslm_dxyz(3, ia, iso) + & orbtramat(l)%slm(is, ic)*dc(ic, 3) END DO END DO @@ -305,12 +305,12 @@ SUBROUTINE create_harmonics_atom(harmonics, my_CG, na, llmax, maxs, max_s_harm, int2 = 0.0_dp int3 = 0.0_dp DO ia = 1, na - int1 = int1+wa(ia)* & - (dslm_dxyz(1, ia, iso1)*slm(ia, iso2)+slm(ia, iso1)*dslm_dxyz(1, ia, iso2)) - int2 = int2+wa(ia)* & - (dslm_dxyz(2, ia, iso1)*slm(ia, iso2)+slm(ia, iso1)*dslm_dxyz(2, ia, iso2)) - int3 = int3+wa(ia)* & - (dslm_dxyz(3, ia, iso1)*slm(ia, iso2)+slm(ia, iso1)*dslm_dxyz(3, ia, iso2)) + int1 = int1 + wa(ia)* & + (dslm_dxyz(1, ia, iso1)*slm(ia, iso2) + slm(ia, iso1)*dslm_dxyz(1, ia, iso2)) + int2 = int2 + wa(ia)* & + (dslm_dxyz(2, ia, iso1)*slm(ia, iso2) + slm(ia, iso1)*dslm_dxyz(2, ia, iso2)) + int3 = int3 + wa(ia)* & + (dslm_dxyz(3, ia, iso1)*slm(ia, iso2) + slm(ia, iso1)*dslm_dxyz(3, ia, iso2)) END DO DO iso = 1, max_s_harm rx = 0.0_dp @@ -320,15 +320,15 @@ SUBROUTINE create_harmonics_atom(harmonics, my_CG, na, llmax, maxs, max_s_harm, rz = 0.0_dp drz = 0.0_dp DO ia = 1, na - rx = rx+wa(ia)*slm(ia, iso)* & - (dslm_dxyz(1, ia, iso1)*slm(ia, iso2)+slm(ia, iso1)*dslm_dxyz(1, ia, iso2)) - drx = drx+wa(ia)*slm(ia, iso) - ry = ry+wa(ia)*slm(ia, iso)* & - (dslm_dxyz(2, ia, iso1)*slm(ia, iso2)+slm(ia, iso1)*dslm_dxyz(2, ia, iso2)) - dry = dry+wa(ia)*slm(ia, iso) - rz = rz+wa(ia)*slm(ia, iso)* & - (dslm_dxyz(3, ia, iso1)*slm(ia, iso2)+slm(ia, iso1)*dslm_dxyz(3, ia, iso2)) - drz = drz+wa(ia)*slm(ia, iso) + rx = rx + wa(ia)*slm(ia, iso)* & + (dslm_dxyz(1, ia, iso1)*slm(ia, iso2) + slm(ia, iso1)*dslm_dxyz(1, ia, iso2)) + drx = drx + wa(ia)*slm(ia, iso) + ry = ry + wa(ia)*slm(ia, iso)* & + (dslm_dxyz(2, ia, iso1)*slm(ia, iso2) + slm(ia, iso1)*dslm_dxyz(2, ia, iso2)) + dry = dry + wa(ia)*slm(ia, iso) + rz = rz + wa(ia)*slm(ia, iso)* & + (dslm_dxyz(3, ia, iso1)*slm(ia, iso2) + slm(ia, iso1)*dslm_dxyz(3, ia, iso2)) + drz = drz + wa(ia)*slm(ia, iso) END DO harmonics%my_CG_dxyz(1, iso1, iso2, iso) = rx @@ -356,18 +356,18 @@ SUBROUTINE create_harmonics_atom(harmonics, my_CG, na, llmax, maxs, max_s_harm, rz = 0.0_dp drz = 0.0_dp DO ia = 1, na - rx = rx+wa(ia)*slm(ia, iso)* & - (-dslm_dxyz(1, ia, iso1)*slm(ia, iso2)+ & + rx = rx + wa(ia)*slm(ia, iso)* & + (-dslm_dxyz(1, ia, iso1)*slm(ia, iso2) + & slm(ia, iso1)*dslm_dxyz(1, ia, iso2)) - drx = drx+wa(ia)*slm(ia, iso) - ry = ry+wa(ia)*slm(ia, iso)* & - (-dslm_dxyz(2, ia, iso1)*slm(ia, iso2)+ & + drx = drx + wa(ia)*slm(ia, iso) + ry = ry + wa(ia)*slm(ia, iso)* & + (-dslm_dxyz(2, ia, iso1)*slm(ia, iso2) + & slm(ia, iso1)*dslm_dxyz(2, ia, iso2)) - dry = dry+wa(ia)*slm(ia, iso) - rz = rz+wa(ia)*slm(ia, iso)* & - (-dslm_dxyz(3, ia, iso1)*slm(ia, iso2)+ & + dry = dry + wa(ia)*slm(ia, iso) + rz = rz + wa(ia)*slm(ia, iso)* & + (-dslm_dxyz(3, ia, iso1)*slm(ia, iso2) + & slm(ia, iso1)*dslm_dxyz(3, ia, iso2)) - drz = drz+wa(ia)*slm(ia, iso) + drz = drz + wa(ia)*slm(ia, iso) END DO harmonics%my_CG_dxyz_asym(1, iso1, iso2, iso) = rx @@ -512,14 +512,14 @@ SUBROUTINE get_none0_cg_list4(cgc, lmin1, lmax1, lmin2, lmax2, max_s_harm, llmax DO iso = 1, max_s_harm nlist = 0 DO l1 = lmin1, lmax1 - DO iso1 = nsoset(l1-1)+1, nsoset(l1) + DO iso1 = nsoset(l1 - 1) + 1, nsoset(l1) DO l2 = lmin2, lmax2 - IF (l1+l2 > llmax) CYCLE - DO iso2 = nsoset(l2-1)+1, nsoset(l2) - IF (ABS(cgc(1, iso1, iso2, iso))+ & - ABS(cgc(2, iso1, iso2, iso))+ & + IF (l1 + l2 > llmax) CYCLE + DO iso2 = nsoset(l2 - 1) + 1, nsoset(l2) + IF (ABS(cgc(1, iso1, iso2, iso)) + & + ABS(cgc(2, iso1, iso2, iso)) + & ABS(cgc(3, iso1, iso2, iso)) > 1.E-8_dp) THEN - nlist = nlist+1 + nlist = nlist + 1 IF (PRESENT(n_list) .AND. PRESENT(list)) THEN list(1, nlist, iso) = iso1 list(2, nlist, iso) = iso2 @@ -573,12 +573,12 @@ SUBROUTINE get_none0_cg_list3(cgc, lmin1, lmax1, lmin2, lmax2, max_s_harm, llmax DO iso = 1, max_s_harm nlist = 0 DO l1 = lmin1, lmax1 - DO iso1 = nsoset(l1-1)+1, nsoset(l1) + DO iso1 = nsoset(l1 - 1) + 1, nsoset(l1) DO l2 = lmin2, lmax2 - IF (l1+l2 > llmax) CYCLE - DO iso2 = nsoset(l2-1)+1, nsoset(l2) + IF (l1 + l2 > llmax) CYCLE + DO iso2 = nsoset(l2 - 1) + 1, nsoset(l2) IF (ABS(cgc(iso1, iso2, iso)) > 1.E-8_dp) THEN - nlist = nlist+1 + nlist = nlist + 1 IF (PRESENT(n_list) .AND. PRESENT(list)) THEN list(1, nlist, iso) = iso1 list(2, nlist, iso) = iso2 diff --git a/src/qs_hash_table_functions.F b/src/qs_hash_table_functions.F index 4d18c6da5c..4323e0f551 100644 --- a/src/qs_hash_table_functions.F +++ b/src/qs_hash_table_functions.F @@ -32,10 +32,10 @@ PURE FUNCTION hash_table_matching_prime(ii) RESULT(res) ! even numbers are not prime, so no point testing them, so increment by 2 each time starting ! from an odd number greater or equal to ii (as noted in \brief) - res = ii+1-MOD(ii, 2) + res = ii + 1 - MOD(ii, 2) DO WHILE (.NOT. is_positive_prime(res)) - res = res+2 + res = res + 2 END DO END FUNCTION hash_table_matching_prime @@ -65,11 +65,11 @@ PURE FUNCTION is_positive_prime(num) RESULT(res) ! and we only have to check factors less than and equal to SQRT(num) ii = 5 DO WHILE (ii*ii .LE. num) - IF (MOD(num, ii) == 0 .OR. MOD(num, ii+2) == 0) THEN + IF (MOD(num, ii) == 0 .OR. MOD(num, ii + 2) == 0) THEN res = .FALSE. RETURN END IF - ii = ii+6 + ii = ii + 6 END DO res = .TRUE. END FUNCTION is_positive_prime diff --git a/src/qs_initial_guess.F b/src/qs_initial_guess.F index b71602b802..5ad6188f5b 100644 --- a/src/qs_initial_guess.F +++ b/src/qs_initial_guess.F @@ -293,10 +293,10 @@ SUBROUTINE calculate_first_density_matrix(scf_env, qs_env) CALL mp_bcast(exist, para_env%source, para_env%group) CALL mp_bcast(file_name, para_env%source, para_env%group) nvec = qs_env%wf_history%memory_depth - not_read = nvec+1 + not_read = nvec + 1 ! At this level we read the saved backup RESTART files.. DO i = 1, nvec - j = i-1 + j = i - 1 filename = TRIM(file_name) IF (j /= 0) filename = TRIM(file_name)//".bak-"//ADJUSTL(cp_to_string(j)) IF (para_env%ionode) & @@ -322,7 +322,7 @@ SUBROUTINE calculate_first_density_matrix(scf_env, qs_env) density_guess = safe_density_guess END IF END IF - last_read = not_read-1 + last_read = not_read - 1 END IF did_guess = .FALSE. @@ -395,7 +395,7 @@ SUBROUTINE calculate_first_density_matrix(scf_env, qs_env) IF (density_guess == history_guess) THEN IF (not_read > 1) THEN DO i = 1, last_read - j = last_read-i + j = last_read - i CALL read_mo_set(mo_array, atomic_kind_set, qs_kind_set, particle_set, para_env, & id_nr=j, multiplicity=dft_control%multiplicity, & dft_section=dft_section) @@ -704,10 +704,10 @@ SUBROUTINE calculate_first_density_matrix(scf_env, qs_env) ikind = kind_of(irow) IF (icol .EQ. irow) THEN IF (ispin == 1) THEN - pdata(:, :) = pmat(ikind)%mat(:, :, 1)*rscale+ & + pdata(:, :) = pmat(ikind)%mat(:, :, 1)*rscale + & pmat(ikind)%mat(:, :, 2)*rscale ELSE - pdata(:, :) = pmat(ikind)%mat(:, :, 1)*rscale- & + pdata(:, :) = pmat(ikind)%mat(:, :, 1)*rscale - & pmat(ikind)%mat(:, :, 2)*rscale END IF END IF @@ -744,7 +744,7 @@ SUBROUTINE calculate_first_density_matrix(scf_env, qs_env) nmo=nmo, nao=nao, homo=homo) CALL cp_fm_set_all(mo_coeff, 0.0_dp) - n = MAXVAL(last_sgf-first_sgf)+1 + n = MAXVAL(last_sgf - first_sgf) + 1 size_atomic_kind_set = SIZE(atomic_kind_set) ALLOCATE (buff(n, n), sort_kind(size_atomic_kind_set), & @@ -778,14 +778,14 @@ SUBROUTINE calculate_first_density_matrix(scf_env, qs_env) ! atom_a = atom_list(iatom) istart_row = first_sgf(atom_a) - n_rows = last_sgf(atom_a)-first_sgf(atom_a)+1 + n_rows = last_sgf(atom_a) - first_sgf(atom_a) + 1 ! ! compute the "potential" nbr of states for this atom n_cols = MAX(INT(REAL(nmo_tmp, dp)/REAL(natoms_tmp, dp)), 1) IF (n_cols .GT. n_rows) n_cols = n_rows ! - nmo_tmp = nmo_tmp-n_cols - natoms_tmp = natoms_tmp-1 + nmo_tmp = nmo_tmp - n_cols + natoms_tmp = natoms_tmp - 1 IF (nmo_tmp .LT. 0 .OR. natoms_tmp .LT. 0) THEN CPABORT("Wrong1!") END IF @@ -794,7 +794,7 @@ SUBROUTINE calculate_first_density_matrix(scf_env, qs_env) ENDDO CALL cp_fm_set_submatrix(mo_coeff, buff, istart_row, istart_col, & n_rows, n_cols) - istart_col = istart_col+n_cols + istart_col = istart_col + n_cols ENDDO ENDDO @@ -813,11 +813,11 @@ SUBROUTINE calculate_first_density_matrix(scf_env, qs_env) ENDIF length = SQRT(DOT_PRODUCT(buff(:, 1), buff(:, 1))) buff(:, :) = buff(:, :)/length - DO j = i+1, nmo + DO j = i + 1, nmo CALL cp_fm_get_submatrix(mo_coeff, buff2, 1, j, nao, 1) length = SQRT(DOT_PRODUCT(buff2(:, 1), buff2(:, 1))) buff2(:, :) = buff2(:, :)/length - IF (ABS(DOT_PRODUCT(buff(:, 1), buff2(:, 1))-1.0_dp) .LT. 1E-10_dp) THEN + IF (ABS(DOT_PRODUCT(buff(:, 1), buff2(:, 1)) - 1.0_dp) .LT. 1E-10_dp) THEN WRITE (*, *) 'wrong2', i, j, DOT_PRODUCT(buff(:, 1), buff2(:, 1)) DO ikind = 1, nao IF (ABS(mo_coeff%local_data(ikind, i)) .GT. 1e-10_dp) THEN @@ -1055,13 +1055,13 @@ SUBROUTINE calculate_atomic_block_dm(pmatrix, matrix_s, particle_set, atomic_kin ikind = kind_of(irow) IF (icol .EQ. irow) THEN IF (ispin == 1) THEN - pdata(:, :) = pmat(ikind)%mat(:, :, 1)*rscale+ & + pdata(:, :) = pmat(ikind)%mat(:, :, 1)*rscale + & pmat(ikind)%mat(:, :, 2)*rscale ELSE - pdata(:, :) = pmat(ikind)%mat(:, :, 1)*rscale- & + pdata(:, :) = pmat(ikind)%mat(:, :, 1)*rscale - & pmat(ikind)%mat(:, :, 2)*rscale END IF - nocc(ispin) = nocc(ispin)+nok(ispin, ikind) + nocc(ispin) = nocc(ispin) + nok(ispin, ikind) END IF ENDDO CALL dbcsr_iterator_stop(iter) @@ -1092,7 +1092,7 @@ SUBROUTINE calculate_atomic_block_dm(pmatrix, matrix_s, particle_set, atomic_kin IF (nelectron_spin(ispin) > nocc(ispin)) THEN rds = 0.99_dp CALL dbcsr_scale(matrix_p, rds) - rds = (1.0_dp-rds)*nelectron_spin(ispin) + rds = (1.0_dp - rds)*nelectron_spin(ispin) CALL dbcsr_get_info(matrix_p, nfullcols_total=nc) rds = rds/REAL(nc, KIND=dp) CALL dbcsr_add_on_diag(matrix_p, rds) @@ -1300,7 +1300,7 @@ SUBROUTINE calculate_mopac_dm(pmat, matrix_s, has_unit_metric, & ELSEIF (has_pot) THEN CALL get_atomic_kind(atomic_kind_set(ikind), z=z) CALL get_qs_kind(qs_kind_set(ikind), nsgf=nsgf, elec_conf=elec_conf, zeff=zeff) - maxll = MIN(SIZE(elec_conf)-1, maxl) + maxll = MIN(SIZE(elec_conf) - 1, maxl) econf(:) = 0.0_dp econf(0:maxll) = 0.5_dp*maxocc*REAL(elec_conf(0:maxll), dp) ELSE @@ -1317,23 +1317,23 @@ SUBROUTINE calculate_mopac_dm(pmat, matrix_s, has_unit_metric, & CASE (0) pdiag(isgfa) = econf(0) CASE (1) - pdiag(isgfa+1) = econf(1)/3._dp - pdiag(isgfa+2) = econf(1)/3._dp - pdiag(isgfa+3) = econf(1)/3._dp + pdiag(isgfa + 1) = econf(1)/3._dp + pdiag(isgfa + 2) = econf(1)/3._dp + pdiag(isgfa + 3) = econf(1)/3._dp CASE (2) - pdiag(isgfa+4) = econf(2)/5._dp - pdiag(isgfa+5) = econf(2)/5._dp - pdiag(isgfa+6) = econf(2)/5._dp - pdiag(isgfa+7) = econf(2)/5._dp - pdiag(isgfa+8) = econf(2)/5._dp + pdiag(isgfa + 4) = econf(2)/5._dp + pdiag(isgfa + 5) = econf(2)/5._dp + pdiag(isgfa + 6) = econf(2)/5._dp + pdiag(isgfa + 7) = econf(2)/5._dp + pdiag(isgfa + 8) = econf(2)/5._dp CASE (3) - pdiag(isgfa+9) = econf(3)/7._dp - pdiag(isgfa+10) = econf(3)/7._dp - pdiag(isgfa+11) = econf(3)/7._dp - pdiag(isgfa+12) = econf(3)/7._dp - pdiag(isgfa+13) = econf(3)/7._dp - pdiag(isgfa+14) = econf(3)/7._dp - pdiag(isgfa+15) = econf(3)/7._dp + pdiag(isgfa + 9) = econf(3)/7._dp + pdiag(isgfa + 10) = econf(3)/7._dp + pdiag(isgfa + 11) = econf(3)/7._dp + pdiag(isgfa + 12) = econf(3)/7._dp + pdiag(isgfa + 13) = econf(3)/7._dp + pdiag(isgfa + 14) = econf(3)/7._dp + pdiag(isgfa + 15) = econf(3)/7._dp CASE DEFAULT CPABORT("") END SELECT @@ -1346,8 +1346,8 @@ SUBROUTINE calculate_mopac_dm(pmat, matrix_s, has_unit_metric, & DO isgf = 1, nsgf na = naox(isgf) la = laox(isgf) - occ = REAL(occupation(na), dp)/REAL(2*la+1, dp) - pdiag(isgfa+isgf-1) = occ + occ = REAL(occupation(na), dp)/REAL(2*la + 1, dp) + pdiag(isgfa + isgf - 1) = occ END DO END DO ELSEIF (dft_control%qs_control%semi_empirical) THEN @@ -1357,49 +1357,49 @@ SUBROUTINE calculate_mopac_dm(pmat, matrix_s, has_unit_metric, & isgfa = first_sgf(atom_a) SELECT CASE (nsgf) CASE (1) ! s-basis - pdiag(isgfa) = (zeff-yy)*0.5_dp*maxocc + pdiag(isgfa) = (zeff - yy)*0.5_dp*maxocc CASE (4) ! sp-basis IF (z == 1) THEN ! special case: hydrogen with sp basis - pdiag(isgfa) = (zeff-yy)*0.5_dp*maxocc - pdiag(isgfa+1) = 0._dp - pdiag(isgfa+2) = 0._dp - pdiag(isgfa+3) = 0._dp + pdiag(isgfa) = (zeff - yy)*0.5_dp*maxocc + pdiag(isgfa + 1) = 0._dp + pdiag(isgfa + 2) = 0._dp + pdiag(isgfa + 3) = 0._dp ELSE - pdiag(isgfa) = (zeff*0.25_dp-yy)*0.5_dp*maxocc - pdiag(isgfa+1) = (zeff*0.25_dp-yy)*0.5_dp*maxocc - pdiag(isgfa+2) = (zeff*0.25_dp-yy)*0.5_dp*maxocc - pdiag(isgfa+3) = (zeff*0.25_dp-yy)*0.5_dp*maxocc + pdiag(isgfa) = (zeff*0.25_dp - yy)*0.5_dp*maxocc + pdiag(isgfa + 1) = (zeff*0.25_dp - yy)*0.5_dp*maxocc + pdiag(isgfa + 2) = (zeff*0.25_dp - yy)*0.5_dp*maxocc + pdiag(isgfa + 3) = (zeff*0.25_dp - yy)*0.5_dp*maxocc END IF CASE (9) ! spd-basis IF (z < 21 .OR. z > 30 .AND. z < 39 .OR. z > 48 .AND. z < 57) THEN ! Main Group Element: The "d" shell is formally empty. - pdiag(isgfa) = (zeff*0.25_dp-yy)*0.5_dp*maxocc - pdiag(isgfa+1) = (zeff*0.25_dp-yy)*0.5_dp*maxocc - pdiag(isgfa+2) = (zeff*0.25_dp-yy)*0.5_dp*maxocc - pdiag(isgfa+3) = (zeff*0.25_dp-yy)*0.5_dp*maxocc - pdiag(isgfa+4) = (-yy)*0.5_dp*maxocc - pdiag(isgfa+5) = (-yy)*0.5_dp*maxocc - pdiag(isgfa+6) = (-yy)*0.5_dp*maxocc - pdiag(isgfa+7) = (-yy)*0.5_dp*maxocc - pdiag(isgfa+8) = (-yy)*0.5_dp*maxocc + pdiag(isgfa) = (zeff*0.25_dp - yy)*0.5_dp*maxocc + pdiag(isgfa + 1) = (zeff*0.25_dp - yy)*0.5_dp*maxocc + pdiag(isgfa + 2) = (zeff*0.25_dp - yy)*0.5_dp*maxocc + pdiag(isgfa + 3) = (zeff*0.25_dp - yy)*0.5_dp*maxocc + pdiag(isgfa + 4) = (-yy)*0.5_dp*maxocc + pdiag(isgfa + 5) = (-yy)*0.5_dp*maxocc + pdiag(isgfa + 6) = (-yy)*0.5_dp*maxocc + pdiag(isgfa + 7) = (-yy)*0.5_dp*maxocc + pdiag(isgfa + 8) = (-yy)*0.5_dp*maxocc ELSE IF (z < 99) THEN - my_sum = zeff-9.0_dp*yy + my_sum = zeff - 9.0_dp*yy ! First, put 2 electrons in the 's' shell pdiag(isgfa) = (MAX(0.0_dp, MIN(my_sum, 2.0_dp)))*0.5_dp*maxocc - my_sum = my_sum-2.0_dp + my_sum = my_sum - 2.0_dp IF (my_sum > 0.0_dp) THEN ! Now put as many electrons as possible into the 'd' shell - pdiag(isgfa+4) = (MAX(0.0_dp, MIN(my_sum*0.2_dp, 2.0_dp)))*0.5_dp*maxocc - pdiag(isgfa+5) = (MAX(0.0_dp, MIN(my_sum*0.2_dp, 2.0_dp)))*0.5_dp*maxocc - pdiag(isgfa+6) = (MAX(0.0_dp, MIN(my_sum*0.2_dp, 2.0_dp)))*0.5_dp*maxocc - pdiag(isgfa+7) = (MAX(0.0_dp, MIN(my_sum*0.2_dp, 2.0_dp)))*0.5_dp*maxocc - pdiag(isgfa+8) = (MAX(0.0_dp, MIN(my_sum*0.2_dp, 2.0_dp)))*0.5_dp*maxocc - my_sum = MAX(0.0_dp, my_sum-10.0_dp) + pdiag(isgfa + 4) = (MAX(0.0_dp, MIN(my_sum*0.2_dp, 2.0_dp)))*0.5_dp*maxocc + pdiag(isgfa + 5) = (MAX(0.0_dp, MIN(my_sum*0.2_dp, 2.0_dp)))*0.5_dp*maxocc + pdiag(isgfa + 6) = (MAX(0.0_dp, MIN(my_sum*0.2_dp, 2.0_dp)))*0.5_dp*maxocc + pdiag(isgfa + 7) = (MAX(0.0_dp, MIN(my_sum*0.2_dp, 2.0_dp)))*0.5_dp*maxocc + pdiag(isgfa + 8) = (MAX(0.0_dp, MIN(my_sum*0.2_dp, 2.0_dp)))*0.5_dp*maxocc + my_sum = MAX(0.0_dp, my_sum - 10.0_dp) ! Put the remaining electrons in the 'p' shell - pdiag(isgfa+1) = (my_sum/3.0_dp)*0.5_dp*maxocc - pdiag(isgfa+2) = (my_sum/3.0_dp)*0.5_dp*maxocc - pdiag(isgfa+3) = (my_sum/3.0_dp)*0.5_dp*maxocc + pdiag(isgfa + 1) = (my_sum/3.0_dp)*0.5_dp*maxocc + pdiag(isgfa + 2) = (my_sum/3.0_dp)*0.5_dp*maxocc + pdiag(isgfa + 3) = (my_sum/3.0_dp)*0.5_dp*maxocc END IF END IF CASE DEFAULT @@ -1417,25 +1417,25 @@ SUBROUTINE calculate_mopac_dm(pmat, matrix_s, has_unit_metric, & DO iset = 1, nset DO ishell = 1, nshell(iset) la = l(ishell, iset) - nelec = maxocc*REAL(2*la+1, dp) + nelec = maxocc*REAL(2*la + 1, dp) IF (econf(la) > 0.0_dp) THEN IF (econf(la) >= nelec) THEN paa = maxocc - econf(la) = econf(la)-nelec + econf(la) = econf(la) - nelec ELSE paa = maxocc*econf(la)/nelec econf(la) = 0.0_dp - ncount = ncount+NINT(nelec/maxocc) + ncount = ncount + NINT(nelec/maxocc) END IF DO isgfa = first_sgfa(ishell, iset), last_sgfa(ishell, iset) DO iatom = 1, natom atom_a = atom_list(iatom) - isgf = first_sgf(atom_a)+isgfa-1 + isgf = first_sgf(atom_a) + isgfa - 1 pdiag(isgf) = paa IF (paa == maxocc) THEN - trps1 = trps1+paa*sdiag(isgf) + trps1 = trps1 + paa*sdiag(isgf) ELSE - trps2 = trps2+paa*sdiag(isgf) + trps2 = trps2 + paa*sdiag(isgf) END IF END DO END DO @@ -1458,7 +1458,7 @@ SUBROUTINE calculate_mopac_dm(pmat, matrix_s, has_unit_metric, & ELSE DO ispin = 1, nspin IF (nelectron_spin(ispin) /= 0) THEN - rscale = (REAL(nelectron_spin(ispin), dp)-trps1)/trps2 + rscale = (REAL(nelectron_spin(ispin), dp) - trps1)/trps2 DO isgf = 1, nao IF (pdiag(isgf) < maxocc) pdiag(isgf) = rscale*pdiag(isgf) END DO diff --git a/src/qs_integral_utils.F b/src/qs_integral_utils.F index 1afc423692..6cc404cf66 100644 --- a/src/qs_integral_utils.F +++ b/src/qs_integral_utils.F @@ -62,7 +62,7 @@ FUNCTION get_memory_usage_a(qs_kind_set, basis_type_a) RESULT(ldmem) basis_type=basis_type_a) ldmem = MAX(maxc, maxs) - CALL init_orbital_pointers(maxl+2) + CALL init_orbital_pointers(maxl + 2) END FUNCTION get_memory_usage_a diff --git a/src/qs_integrate_potential_low.F b/src/qs_integrate_potential_low.F index 2a7d077d2a..7886a6910d 100644 --- a/src/qs_integrate_potential_low.F +++ b/src/qs_integrate_potential_low.F @@ -40,7 +40,7 @@ SUBROUTINE call_to_xyz_to_vab(prefactor, coef_xyz, lp, la_max_local, lb_max_loca IMPORT :: dp REAL(KIND=dp), INTENT(in) :: prefactor INTEGER, INTENT(in) :: lp - REAL(kind=dp), DIMENSION(((lp+1)*(lp+2)*(lp+3))/6), & + REAL(kind=dp), DIMENSION(((lp + 1)*(lp + 2)*(lp + 3))/6), & INTENT(inout) :: coef_xyz INTEGER, INTENT(in) :: la_max_local, lb_max_local, la_min_local, & lb_min_local, maxl, lvab, hvab @@ -199,13 +199,13 @@ SUBROUTINE integrate_pgf_product_rspace(la_max, zeta, la_min, & END IF IF (calculate_forces) THEN - la_max_local = la_max+1 ! needed for the derivative of the gaussian, unimportant which one - la_min_local = MAX(la_min-1, 0) ! just in case the la_min,lb_min is not zero - lb_min_local = MAX(lb_min-1, 0) + la_max_local = la_max + 1 ! needed for the derivative of the gaussian, unimportant which one + la_min_local = MAX(la_min - 1, 0) ! just in case the la_min,lb_min is not zero + lb_min_local = MAX(lb_min - 1, 0) lb_max_local = lb_max IF (my_use_virial) THEN - la_max_local = la_max_local+1 - lb_max_local = lb_max_local+1 + la_max_local = la_max_local + 1 + lb_max_local = lb_max_local + 1 ENDIF ELSE la_max_local = la_max @@ -215,21 +215,21 @@ SUBROUTINE integrate_pgf_product_rspace(la_max, zeta, la_min, & END IF IF (my_compute_tau) THEN - la_max_local = la_max_local+1 - lb_max_local = lb_max_local+1 - la_min_local = MAX(la_min_local-1, 0) - lb_min_local = MAX(lb_min_local-1, 0) + la_max_local = la_max_local + 1 + lb_max_local = lb_max_local + 1 + la_min_local = MAX(la_min_local - 1, 0) + lb_min_local = MAX(lb_min_local - 1, 0) ENDIF - coef_max = la_max_local+lb_max_local+1 - zetp = zeta+zetb + coef_max = la_max_local + lb_max_local + 1 + zetp = zeta + zetb f = zetb/zetp prefactor = EXP(-zeta*f*rab2) ! *** position of the gaussian product rap(:) = f*rab(:) - rbp(:) = rap(:)-rab(:) - rp(:) = ra(:)+rap(:) ! this is the gaussian center in real coordinates - rb(:) = ra(:)+rab(:) + rbp(:) = rap(:) - rab(:) + rp(:) = ra(:) + rap(:) ! this is the gaussian center in real coordinates + rb(:) = ra(:) + rab(:) IF (my_map_consistent) THEN ! still assumes that eps_gvg_rspace=eps_rho_rspace cutoff = 1.0_dp @@ -278,62 +278,62 @@ SUBROUTINE integrate_pgf_product_rspace(la_max, zeta, la_min, & DO la = la_min, la_max DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay ico = coset(ax, ay, az) DO lb = lb_min, lb_max DO bx = 0, lb - DO by = 0, lb-bx - bz = lb-bx-by + DO by = 0, lb - bx + bz = lb - bx - by jco = coset(bx, by, bz) IF (.NOT. my_compute_tau) THEN axpm0 = vab(ico, jco) ELSE - axpm0 = 0.5_dp*(ax*bx*vab(coset(MAX(ax-1, 0), ay, az), coset(MAX(bx-1, 0), by, bz))+ & - ay*by*vab(coset(ax, MAX(ay-1, 0), az), coset(bx, MAX(by-1, 0), bz))+ & - az*bz*vab(coset(ax, ay, MAX(az-1, 0)), coset(bx, by, MAX(bz-1, 0))) & - -ftza*bx*vab(coset(ax+1, ay, az), coset(MAX(bx-1, 0), by, bz)) & - -ftza*by*vab(coset(ax, ay+1, az), coset(bx, MAX(by-1, 0), bz)) & - -ftza*bz*vab(coset(ax, ay, az+1), coset(bx, by, MAX(bz-1, 0))) & - -ax*ftzb*vab(coset(MAX(ax-1, 0), ay, az), coset(bx+1, by, bz)) & - -ay*ftzb*vab(coset(ax, MAX(ay-1, 0), az), coset(bx, by+1, bz)) & - -az*ftzb*vab(coset(ax, ay, MAX(az-1, 0)), coset(bx, by, bz+1))+ & - ftza*ftzb*vab(coset(ax+1, ay, az), coset(bx+1, by, bz))+ & - ftza*ftzb*vab(coset(ax, ay+1, az), coset(bx, by+1, bz))+ & - ftza*ftzb*vab(coset(ax, ay, az+1), coset(bx, by, bz+1))) + axpm0 = 0.5_dp*(ax*bx*vab(coset(MAX(ax - 1, 0), ay, az), coset(MAX(bx - 1, 0), by, bz)) + & + ay*by*vab(coset(ax, MAX(ay - 1, 0), az), coset(bx, MAX(by - 1, 0), bz)) + & + az*bz*vab(coset(ax, ay, MAX(az - 1, 0)), coset(bx, by, MAX(bz - 1, 0))) & + - ftza*bx*vab(coset(ax + 1, ay, az), coset(MAX(bx - 1, 0), by, bz)) & + - ftza*by*vab(coset(ax, ay + 1, az), coset(bx, MAX(by - 1, 0), bz)) & + - ftza*bz*vab(coset(ax, ay, az + 1), coset(bx, by, MAX(bz - 1, 0))) & + - ax*ftzb*vab(coset(MAX(ax - 1, 0), ay, az), coset(bx + 1, by, bz)) & + - ay*ftzb*vab(coset(ax, MAX(ay - 1, 0), az), coset(bx, by + 1, bz)) & + - az*ftzb*vab(coset(ax, ay, MAX(az - 1, 0)), coset(bx, by, bz + 1)) + & + ftza*ftzb*vab(coset(ax + 1, ay, az), coset(bx + 1, by, bz)) + & + ftza*ftzb*vab(coset(ax, ay + 1, az), coset(bx, by + 1, bz)) + & + ftza*ftzb*vab(coset(ax, ay, az + 1), coset(bx, by, bz + 1))) ENDIF - hab(o1+ico, o2+jco) = hab(o1+ico, o2+jco)+axpm0 + hab(o1 + ico, o2 + jco) = hab(o1 + ico, o2 + jco) + axpm0 IF (calculate_forces .AND. PRESENT(force_a)) THEN IF (my_compute_tau) THEN - pabval = pab(o1+ico, o2+jco)*0.5_dp*ax*bx + pabval = pab(o1 + ico, o2 + jco)*0.5_dp*ax*bx CALL force_update( & - force_a, force_b, rab, pabval, ftza, ftzb, MAX(ax-1, 0), ay, az, MAX(bx-1, 0), by, bz, vab) - pabval = pab(o1+ico, o2+jco)*0.5_dp*ay*by + force_a, force_b, rab, pabval, ftza, ftzb, MAX(ax - 1, 0), ay, az, MAX(bx - 1, 0), by, bz, vab) + pabval = pab(o1 + ico, o2 + jco)*0.5_dp*ay*by CALL force_update( & - force_a, force_b, rab, pabval, ftza, ftzb, ax, MAX(ay-1, 0), az, bx, MAX(by-1, 0), bz, vab) - pabval = pab(o1+ico, o2+jco)*0.5_dp*az*bz + force_a, force_b, rab, pabval, ftza, ftzb, ax, MAX(ay - 1, 0), az, bx, MAX(by - 1, 0), bz, vab) + pabval = pab(o1 + ico, o2 + jco)*0.5_dp*az*bz CALL force_update( & - force_a, force_b, rab, pabval, ftza, ftzb, ax, ay, MAX(az-1, 0), bx, by, MAX(bz-1, 0), vab) - pabval = pab(o1+ico, o2+jco)*0.5_dp*(-ftza*bx) - CALL force_update(force_a, force_b, rab, pabval, ftza, ftzb, ax+1, ay, az, MAX(bx-1, 0), by, bz, vab) - pabval = pab(o1+ico, o2+jco)*0.5_dp*(-ftza*by) - CALL force_update(force_a, force_b, rab, pabval, ftza, ftzb, ax, ay+1, az, bx, MAX(by-1, 0), bz, vab) - pabval = pab(o1+ico, o2+jco)*0.5_dp*(-ftza*bz) - CALL force_update(force_a, force_b, rab, pabval, ftza, ftzb, ax, ay, az+1, bx, by, MAX(bz-1, 0), vab) - pabval = pab(o1+ico, o2+jco)*0.5_dp*(-ax*ftzb) - CALL force_update(force_a, force_b, rab, pabval, ftza, ftzb, MAX(ax-1, 0), ay, az, bx+1, by, bz, vab) - pabval = pab(o1+ico, o2+jco)*0.5_dp*(-ay*ftzb) - CALL force_update(force_a, force_b, rab, pabval, ftza, ftzb, ax, MAX(ay-1, 0), az, bx, by+1, bz, vab) - pabval = pab(o1+ico, o2+jco)*0.5_dp*(-az*ftzb) - CALL force_update(force_a, force_b, rab, pabval, ftza, ftzb, ax, ay, MAX(az-1, 0), bx, by, bz+1, vab) - pabval = pab(o1+ico, o2+jco)*0.5_dp*(ftza*ftzb) - CALL force_update(force_a, force_b, rab, pabval, ftza, ftzb, ax+1, ay, az, bx+1, by, bz, vab) - pabval = pab(o1+ico, o2+jco)*0.5_dp*(ftza*ftzb) - CALL force_update(force_a, force_b, rab, pabval, ftza, ftzb, ax, ay+1, az, bx, by+1, bz, vab) - pabval = pab(o1+ico, o2+jco)*0.5_dp*(ftza*ftzb) - CALL force_update(force_a, force_b, rab, pabval, ftza, ftzb, ax, ay, az+1, bx, by, bz+1, vab) + force_a, force_b, rab, pabval, ftza, ftzb, ax, ay, MAX(az - 1, 0), bx, by, MAX(bz - 1, 0), vab) + pabval = pab(o1 + ico, o2 + jco)*0.5_dp*(-ftza*bx) + CALL force_update(force_a, force_b, rab, pabval, ftza, ftzb, ax + 1, ay, az, MAX(bx - 1, 0), by, bz, vab) + pabval = pab(o1 + ico, o2 + jco)*0.5_dp*(-ftza*by) + CALL force_update(force_a, force_b, rab, pabval, ftza, ftzb, ax, ay + 1, az, bx, MAX(by - 1, 0), bz, vab) + pabval = pab(o1 + ico, o2 + jco)*0.5_dp*(-ftza*bz) + CALL force_update(force_a, force_b, rab, pabval, ftza, ftzb, ax, ay, az + 1, bx, by, MAX(bz - 1, 0), vab) + pabval = pab(o1 + ico, o2 + jco)*0.5_dp*(-ax*ftzb) + CALL force_update(force_a, force_b, rab, pabval, ftza, ftzb, MAX(ax - 1, 0), ay, az, bx + 1, by, bz, vab) + pabval = pab(o1 + ico, o2 + jco)*0.5_dp*(-ay*ftzb) + CALL force_update(force_a, force_b, rab, pabval, ftza, ftzb, ax, MAX(ay - 1, 0), az, bx, by + 1, bz, vab) + pabval = pab(o1 + ico, o2 + jco)*0.5_dp*(-az*ftzb) + CALL force_update(force_a, force_b, rab, pabval, ftza, ftzb, ax, ay, MAX(az - 1, 0), bx, by, bz + 1, vab) + pabval = pab(o1 + ico, o2 + jco)*0.5_dp*(ftza*ftzb) + CALL force_update(force_a, force_b, rab, pabval, ftza, ftzb, ax + 1, ay, az, bx + 1, by, bz, vab) + pabval = pab(o1 + ico, o2 + jco)*0.5_dp*(ftza*ftzb) + CALL force_update(force_a, force_b, rab, pabval, ftza, ftzb, ax, ay + 1, az, bx, by + 1, bz, vab) + pabval = pab(o1 + ico, o2 + jco)*0.5_dp*(ftza*ftzb) + CALL force_update(force_a, force_b, rab, pabval, ftza, ftzb, ax, ay, az + 1, bx, by, bz + 1, vab) ELSE - pabval = pab(o1+ico, o2+jco) + pabval = pab(o1 + ico, o2 + jco) CALL force_update(force_a, force_b, rab, pabval, ftza, ftzb, ax, ay, az, bx, by, bz, vab) IF (my_use_virial) THEN CALL virial_update(my_virial_a, my_virial_b, rab, pabval, ftza, ftzb, ax, ay, az, bx, by, bz, vab) @@ -344,15 +344,15 @@ SUBROUTINE integrate_pgf_product_rspace(la_max, zeta, la_min, & der_a(1:3) = 0.0_dp der_b(1:3) = 0.0_dp CALL hab_derivatives(der_a, der_b, rab, ftza, ftzb, ax, ay, az, bx, by, bz, vab) - hdab(1:3, o1+ico, o2+jco) = der_a(1:3) - hadb(1:3, o1+ico, o2+jco) = der_b(1:3) + hdab(1:3, o1 + ico, o2 + jco) = der_a(1:3) + hadb(1:3, o1 + ico, o2 + jco) = der_b(1:3) pabval = 1.0_dp IF (my_use_virial .AND. PRESENT(a_hdab)) THEN my_virial_a = 0.0_dp my_virial_b = 0.0_dp CALL virial_update(my_virial_a, my_virial_b, rab, pabval, ftza, ftzb, ax, ay, az, bx, by, bz, vab) DO j = 1, 3 - a_hdab(1:3, j, o1+ico, o2+jco) = a_hdab(1:3, j, o1+ico, o2+jco)+my_virial_a(1:3, j) + a_hdab(1:3, j, o1 + ico, o2 + jco) = a_hdab(1:3, j, o1 + ico, o2 + jco) + my_virial_a(1:3, j) END DO ENDIF END IF @@ -386,7 +386,7 @@ SUBROUTINE integrate_ortho() gridbounds(2, 3) = UBOUND(GRID, 3) CALL compute_cube_center(cubecenter, rsgrid%desc, zeta, zetb, ra, rab) - roffset(:) = rp(:)-REAL(cubecenter(:), dp)*dr(:) + roffset(:) = rp(:) - REAL(cubecenter(:), dp)*dr(:) lb_cube_min = MINVAL(lb_cube(:)) ub_cube_max = MAXVAL(ub_cube(:)) @@ -396,29 +396,29 @@ SUBROUTINE integrate_ortho() IF (rsgrid%desc%perd(i) == 1) THEN start = lb_cube(i) DO - offset = MODULO(cubecenter(i)+start, ng(i))+1-start - length = MIN(ub_cube(i), ng(i)-offset)-start - DO ig = start, start+length - map(ig, i) = ig+offset + offset = MODULO(cubecenter(i) + start, ng(i)) + 1 - start + length = MIN(ub_cube(i), ng(i) - offset) - start + DO ig = start, start + length + map(ig, i) = ig + offset END DO - IF (start+length .GE. ub_cube(i)) EXIT - start = start+length+1 + IF (start + length .GE. ub_cube(i)) EXIT + start = start + length + 1 END DO ELSE ! this takes partial grid + border regions into account - offset = MODULO(cubecenter(i)+lb_cube(i)+rsgrid%desc%lb(i)-rsgrid%lb_local(i), ng(i))+1-lb_cube(i) + offset = MODULO(cubecenter(i) + lb_cube(i) + rsgrid%desc%lb(i) - rsgrid%lb_local(i), ng(i)) + 1 - lb_cube(i) ! check for out of bounds - IF (ub_cube(i)+offset > UBOUND(grid, i) .OR. lb_cube(i)+offset < LBOUND(grid, i)) THEN + IF (ub_cube(i) + offset > UBOUND(grid, i) .OR. lb_cube(i) + offset < LBOUND(grid, i)) THEN CPABORT("") ENDIF DO ig = lb_cube(i), ub_cube(i) - map(ig, i) = ig+offset + map(ig, i) = ig + offset END DO END IF ENDDO - lp = la_max_local+lb_max_local - ALLOCATE (coef_xyz(((lp+1)*(lp+2)*(lp+3))/6)) + lp = la_max_local + lb_max_local + ALLOCATE (coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6)) ALLOCATE (pol_z(1:2, 0:lp, -cmax:0)) ALLOCATE (pol_y(1:2, 0:lp, -cmax:0)) ALLOCATE (pol_x(0:lp, -cmax:cmax)) @@ -505,10 +505,10 @@ SUBROUTINE integrate_general_opt() ! sum_{lip,ljp,lkp} P_{lip,ljp,lkp} (i-i_p)**lip (j-j_p)**ljp (k-k_p)**lkp ! - lp = la_max_local+lb_max_local - ALLOCATE (coef_xyz(((lp+1)*(lp+2)*(lp+3))/6)) - ALLOCATE (coef_ijk(((lp+1)*(lp+2)*(lp+3))/6)) - ALLOCATE (coef_xyt(((lp+1)*(lp+2))/2)) + lp = la_max_local + lb_max_local + ALLOCATE (coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6)) + ALLOCATE (coef_ijk(((lp + 1)*(lp + 2)*(lp + 3))/6)) + ALLOCATE (coef_xyt(((lp + 1)*(lp + 2))/2)) ALLOCATE (coef_xtt(0:lp)) ! aux mapping array to simplify life @@ -516,9 +516,9 @@ SUBROUTINE integrate_general_opt() coef_map = HUGE(coef_map) lxyz = 0 DO lzp = 0, lp - DO lyp = 0, lp-lzp - DO lxp = 0, lp-lzp-lyp - lxyz = lxyz+1 + DO lyp = 0, lp - lzp + DO lxp = 0, lp - lzp - lyp + lxyz = lxyz + 1 coef_map(lxp, lyp, lzp) = lxyz ENDDO ENDDO @@ -541,15 +541,15 @@ SUBROUTINE integrate_general_opt() CALL return_cube_nonortho(cube_info, radius, index_min, index_max, rp) - offset(:) = MODULO(index_min(:)+rsgrid%desc%lb(:)-rsgrid%lb_local(:), ng(:))+1 + offset(:) = MODULO(index_min(:) + rsgrid%desc%lb(:) - rsgrid%lb_local(:), ng(:)) + 1 ALLOCATE (grid_map(index_min(1):index_max(1))) DO i = index_min(1), index_max(1) - grid_map(i) = MODULO(i, ng(1))+1 + grid_map(i) = MODULO(i, ng(1)) + 1 IF (rsgrid%desc%perd(1) == 1) THEN - grid_map(i) = MODULO(i, ng(1))+1 + grid_map(i) = MODULO(i, ng(1)) + 1 ELSE - grid_map(i) = i-index_min(1)+offset(1) + grid_map(i) = i - index_min(1) + offset(1) ENDIF ENDDO @@ -557,25 +557,25 @@ SUBROUTINE integrate_general_opt() ! go over the grid, but cycle if the point is not within the radius DO k = index_min(3), index_max(3) - dk = k-gp(3) + dk = k - gp(3) pointk = hmatgrid(:, 3)*dk ! allow for generalised rs grids IF (rsgrid%desc%perd(3) == 1) THEN - k_index = MODULO(k, ng(3))+1 + k_index = MODULO(k, ng(3)) + 1 ELSE - k_index = k-index_min(3)+offset(3) + k_index = k - index_min(3) + offset(3) ENDIF coef_xyt = 0.0_dp DO j = index_min(2), index_max(2) - dj = j-gp(2) - pointj = pointk+hmatgrid(:, 2)*dj + dj = j - gp(2) + pointj = pointk + hmatgrid(:, 2)*dj IF (rsgrid%desc%perd(2) == 1) THEN - j_index = MODULO(j, ng(2))+1 + j_index = MODULO(j, ng(2)) + 1 ELSE - j_index = j-index_min(2)+offset(2) + j_index = j - index_min(2) + offset(2) ENDIF coef_xtt = 0.0_dp @@ -583,32 +583,32 @@ SUBROUTINE integrate_general_opt() ! find bounds for the inner loop ! based on a quadratic equation in i ! a*i**2+b*i+c=radius**2 - v = pointj-gp(1)*hmatgrid(:, 1) + v = pointj - gp(1)*hmatgrid(:, 1) a = DOT_PRODUCT(hmatgrid(:, 1), hmatgrid(:, 1)) b = 2*DOT_PRODUCT(v, hmatgrid(:, 1)) c = DOT_PRODUCT(v, v) - d = b*b-4*a*(c-radius**2) + d = b*b - 4*a*(c - radius**2) IF (d < 0) THEN CYCLE ELSE d = SQRT(d) - ismin = CEILING((-b-d)/(2*a)) - ismax = FLOOR((-b+d)/(2*a)) + ismin = CEILING((-b - d)/(2*a)) + ismax = FLOOR((-b + d)/(2*a)) ENDIF ! prepare for computing -zetp*rsq a = -zetp*a b = -zetp*b c = -zetp*c - i = ismin-1 - exp2i = EXP((a*i+b)*i+c) - exp1i = EXP(2*a*i+a+b) + i = ismin - 1 + exp2i = EXP((a*i + b)*i + c) + exp1i = EXP(2*a*i + a + b) exp0i = EXP(2*a) coef_xtt = 0.0_dp DO i = ismin, ismax - di = i-gp(1) + di = i - gp(1) exp2i = exp2i*exp1i exp1i = exp1i*exp0i @@ -618,7 +618,7 @@ SUBROUTINE integrate_general_opt() dip = 1.0_dp DO il = 0, lp - coef_xtt(il) = coef_xtt(il)+gridval*dip + coef_xtt(il) = coef_xtt(il) + gridval*dip dip = dip*di ENDDO ENDDO @@ -626,9 +626,9 @@ SUBROUTINE integrate_general_opt() lxy = 0 djp = 1.0_dp DO jl = 0, lp - DO il = 0, lp-jl - lxy = lxy+1 - coef_xyt(lxy) = coef_xyt(lxy)+coef_xtt(il)*djp + DO il = 0, lp - jl + lxy = lxy + 1 + coef_xyt(lxy) = coef_xyt(lxy) + coef_xtt(il)*djp ENDDO djp = djp*dj ENDDO @@ -639,12 +639,12 @@ SUBROUTINE integrate_general_opt() dkp = 1.0_dp DO kl = 0, lp lxy = 0 - DO jl = 0, lp-kl - DO il = 0, lp-kl-jl - lxyz = lxyz+1; lxy = lxy+1 - coef_ijk(lxyz) = coef_ijk(lxyz)+dkp*coef_xyt(lxy) + DO jl = 0, lp - kl + DO il = 0, lp - kl - jl + lxyz = lxyz + 1; lxy = lxy + 1 + coef_ijk(lxyz) = coef_ijk(lxyz) + dkp*coef_xyt(lxy) ENDDO - lxy = lxy+kl + lxy = lxy + kl ENDDO dkp = dkp*dk ENDDO @@ -655,31 +655,31 @@ SUBROUTINE integrate_general_opt() ALLOCATE (hmatgridp(3, 3, 0:lp)) hmatgridp(:, :, 0) = 1.0_dp DO k = 1, lp - hmatgridp(:, :, k) = hmatgridp(:, :, k-1)*hmatgrid(:, :) + hmatgridp(:, :, k) = hmatgridp(:, :, k - 1)*hmatgrid(:, :) ENDDO coef_xyz = 0.0_dp lpx = lp DO klx = 0, lpx - DO jlx = 0, lpx-klx - DO ilx = 0, lpx-klx-jlx - lx = ilx+jlx+klx - lpy = lp-lx + DO jlx = 0, lpx - klx + DO ilx = 0, lpx - klx - jlx + lx = ilx + jlx + klx + lpy = lp - lx DO kly = 0, lpy - DO jly = 0, lpy-kly - DO ily = 0, lpy-kly-jly - ly = ily+jly+kly - lpz = lp-lx-ly + DO jly = 0, lpy - kly + DO ily = 0, lpy - kly - jly + ly = ily + jly + kly + lpz = lp - lx - ly DO klz = 0, lpz - DO jlz = 0, lpz-klz - DO ilz = 0, lpz-klz-jlz - lz = ilz+jlz+klz + DO jlz = 0, lpz - klz + DO ilz = 0, lpz - klz - jlz + lz = ilz + jlz + klz - il = ilx+ily+ilz - jl = jlx+jly+jlz - kl = klx+kly+klz + il = ilx + ily + ilz + jl = jlx + jly + jlz + kl = klx + kly + klz coef_xyz(coef_map(lx, ly, lz)) = & - coef_xyz(coef_map(lx, ly, lz))+coef_ijk(coef_map(il, jl, kl))* & + coef_xyz(coef_map(lx, ly, lz)) + coef_ijk(coef_map(il, jl, kl))* & hmatgridp(1, 1, ilx)*hmatgridp(1, 2, jlx)*hmatgridp(1, 3, klx)* & hmatgridp(2, 1, ily)*hmatgridp(2, 2, jly)*hmatgridp(2, 3, kly)* & hmatgridp(3, 1, ilz)*hmatgridp(3, 2, jlz)*hmatgridp(3, 3, klz)* & @@ -723,25 +723,25 @@ SUBROUTINE integrate_general_subpatch() la_max_local+lb_max_local+3)/6) :: poly_d3 periodic = 1 ! cell%perd - lp = la_max_local+lb_max_local - local_b(1, :) = rsgrid%lb_real-rsgrid%desc%lb - local_b(2, :) = rsgrid%ub_real-rsgrid%desc%lb - local_s = rsgrid%lb_real-rsgrid%lb_local - IF (BTEST(subpatch_pattern, 0)) local_b(1, 1) = local_b(1, 1)-rsgrid%desc%border - IF (BTEST(subpatch_pattern, 1)) local_b(2, 1) = local_b(2, 1)+rsgrid%desc%border - IF (BTEST(subpatch_pattern, 2)) local_b(1, 2) = local_b(1, 2)-rsgrid%desc%border - IF (BTEST(subpatch_pattern, 3)) local_b(2, 2) = local_b(2, 2)+rsgrid%desc%border - IF (BTEST(subpatch_pattern, 4)) local_b(1, 3) = local_b(1, 3)-rsgrid%desc%border - IF (BTEST(subpatch_pattern, 5)) local_b(2, 3) = local_b(2, 3)+rsgrid%desc%border - IF (BTEST(subpatch_pattern, 0)) local_s(1) = local_s(1)-rsgrid%desc%border - IF (BTEST(subpatch_pattern, 2)) local_s(2) = local_s(2)-rsgrid%desc%border - IF (BTEST(subpatch_pattern, 4)) local_s(3) = local_s(3)-rsgrid%desc%border + lp = la_max_local + lb_max_local + local_b(1, :) = rsgrid%lb_real - rsgrid%desc%lb + local_b(2, :) = rsgrid%ub_real - rsgrid%desc%lb + local_s = rsgrid%lb_real - rsgrid%lb_local + IF (BTEST(subpatch_pattern, 0)) local_b(1, 1) = local_b(1, 1) - rsgrid%desc%border + IF (BTEST(subpatch_pattern, 1)) local_b(2, 1) = local_b(2, 1) + rsgrid%desc%border + IF (BTEST(subpatch_pattern, 2)) local_b(1, 2) = local_b(1, 2) - rsgrid%desc%border + IF (BTEST(subpatch_pattern, 3)) local_b(2, 2) = local_b(2, 2) + rsgrid%desc%border + IF (BTEST(subpatch_pattern, 4)) local_b(1, 3) = local_b(1, 3) - rsgrid%desc%border + IF (BTEST(subpatch_pattern, 5)) local_b(2, 3) = local_b(2, 3) + rsgrid%desc%border + IF (BTEST(subpatch_pattern, 0)) local_s(1) = local_s(1) - rsgrid%desc%border + IF (BTEST(subpatch_pattern, 2)) local_s(2) = local_s(2) - rsgrid%desc%border + IF (BTEST(subpatch_pattern, 4)) local_s(3) = local_s(3) - rsgrid%desc%border CALL integrateGaussFull(h=cell%hmat, h_inv=cell%h_inv, & grid=grid, poly=poly_d3, alphai=zetp, posi=rp, max_r2=radius*radius, & periodic=periodic, gdim=ng, local_bounds=local_b, local_shift=local_s, & scale=rsgrid%desc%ngpts/ABS(cell%deth)) ! defaults: local_shift=(/0,0,0/),poly_shift=(/0.0_dp,0.0_dp,0.0_dp/),scale=1.0_dp, - ALLOCATE (coef_xyz(((lp+1)*(lp+2)*(lp+3))/6)) + ALLOCATE (coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6)) CALL poly_d32cp2k(coef_xyz, lp, poly_d3) CALL call_to_xyz_to_vab(prefactor, coef_xyz, lp, la_max_local, lb_max_local, & rp, ra, rab, vab, coset, la_min_local, lb_min_local, & @@ -764,25 +764,25 @@ SUBROUTINE integrate_general_wings() periodic = 1 ! cell%perd local_b(1, :) = 0 - local_b(2, :) = MIN(rsgrid%desc%npts-1, rsgrid%ub_local-rsgrid%lb_local) - local_shift = REAL(rsgrid%desc%lb-rsgrid%lb_local, dp)/REAL(rsgrid%desc%npts, dp) - rShifted(1) = rp(1)+cell%hmat(1, 1)*local_shift(1) & - +cell%hmat(1, 2)*local_shift(2) & - +cell%hmat(1, 3)*local_shift(3) - rShifted(2) = rp(2)+cell%hmat(2, 1)*local_shift(1) & - +cell%hmat(2, 2)*local_shift(2) & - +cell%hmat(2, 3)*local_shift(3) - rShifted(3) = rp(3)+cell%hmat(3, 1)*local_shift(1) & - +cell%hmat(3, 2)*local_shift(2) & - +cell%hmat(3, 3)*local_shift(3) - lp = la_max_local+lb_max_local + local_b(2, :) = MIN(rsgrid%desc%npts - 1, rsgrid%ub_local - rsgrid%lb_local) + local_shift = REAL(rsgrid%desc%lb - rsgrid%lb_local, dp)/REAL(rsgrid%desc%npts, dp) + rShifted(1) = rp(1) + cell%hmat(1, 1)*local_shift(1) & + + cell%hmat(1, 2)*local_shift(2) & + + cell%hmat(1, 3)*local_shift(3) + rShifted(2) = rp(2) + cell%hmat(2, 1)*local_shift(1) & + + cell%hmat(2, 2)*local_shift(2) & + + cell%hmat(2, 3)*local_shift(3) + rShifted(3) = rp(3) + cell%hmat(3, 1)*local_shift(1) & + + cell%hmat(3, 2)*local_shift(2) & + + cell%hmat(3, 3)*local_shift(3) + lp = la_max_local + lb_max_local CALL integrateGaussFull(h=cell%hmat, h_inv=cell%h_inv, & grid=grid, poly=poly_d3, alphai=zetp, posi=rShifted, & max_r2=radius*radius, & periodic=periodic, gdim=ng, local_bounds=local_b, & scale=rsgrid%desc%ngpts/ABS(cell%deth)) ! defaults: local_shift=(/0,0,0/),poly_shift=(/0.0_dp,0.0_dp,0.0_dp/),scale=1.0_dp, - ALLOCATE (coef_xyz(((lp+1)*(lp+2)*(lp+3))/6)) + ALLOCATE (coef_xyz(((lp + 1)*(lp + 2)*(lp + 3))/6)) CALL poly_d32cp2k(coef_xyz, lp, poly_d3) CALL call_to_xyz_to_vab(prefactor, coef_xyz, lp, la_max_local, lb_max_local, & rp, ra, rab, vab, coset, la_min_local, lb_min_local, & @@ -808,9 +808,9 @@ SUBROUTINE integrate_general() ! point in real space point = MATMUL(cell%hmat, REAL((/i, j, k/), KIND=dp)/ng) ! skip if outside of the sphere - IF (SUM((point-rp)**2) > radius**2) CYCLE + IF (SUM((point - rp)**2) > radius**2) CYCLE ! point on the grid (including pbc) - ipoint = MODULO((/i, j, k/), ng)+1 + ipoint = MODULO((/i, j, k/), ng) + 1 ! integrate on the grid gridval = grid(ipoint(1), ipoint(2), ipoint(3)) CALL primitive_integrate(point, gridval) @@ -829,30 +829,30 @@ SUBROUTINE primitive_integrate(point, gridval) REAL(KIND=dp) :: dra(3), drap(3), drb(3), drbp(3), myexp - myexp = EXP(-zetp*SUM((point-rp)**2))*prefactor*gridval - dra = point-ra - drb = point-rb + myexp = EXP(-zetp*SUM((point - rp)**2))*prefactor*gridval + dra = point - ra + drb = point - rb drap(1) = 1.0_dp DO lxa = 0, la_max_local drbp(1) = 1.0_dp DO lxb = 0, lb_max_local drap(2) = 1.0_dp - DO lya = 0, la_max_local-lxa + DO lya = 0, la_max_local - lxa drbp(2) = 1.0_dp - DO lyb = 0, lb_max_local-lxb + DO lyb = 0, lb_max_local - lxb drap(3) = 1.0_dp - DO lza = 1, MAX(la_min_local-lxa-lya, 0) + DO lza = 1, MAX(la_min_local - lxa - lya, 0) drap(3) = drap(3)*dra(3) ENDDO - DO lza = MAX(la_min_local-lxa-lya, 0), la_max_local-lxa-lya + DO lza = MAX(la_min_local - lxa - lya, 0), la_max_local - lxa - lya drbp(3) = 1.0_dp - DO lzb = 1, MAX(lb_min_local-lxb-lyb, 0) + DO lzb = 1, MAX(lb_min_local - lxb - lyb, 0) drbp(3) = drbp(3)*drb(3) ENDDO - DO lzb = MAX(lb_min_local-lxb-lyb, 0), lb_max_local-lxb-lyb + DO lzb = MAX(lb_min_local - lxb - lyb, 0), lb_max_local - lxb - lyb ico = coset(lxa, lya, lza) jco = coset(lxb, lyb, lzb) - vab(ico, jco) = vab(ico, jco)+myexp*PRODUCT(drap)*PRODUCT(drbp) + vab(ico, jco) = vab(ico, jco) + myexp*PRODUCT(drap)*PRODUCT(drbp) drbp(3) = drbp(3)*drb(3) ENDDO drap(3) = drap(3)*dra(3) @@ -895,87 +895,87 @@ SUBROUTINE virial_update(my_virial_a, my_virial_b, rab, pab, & REAL(KIND=dp) :: vab(:, :) my_virial_a(1, 1) = my_virial_a(1, 1) & - +pab*ftza*vab(coset(ax+2, ay, az), coset(bx, by, bz)) & - -pab*REAL(ax, dp)*vab(coset(MAX(0, ax-1)+1, ay, az), coset(bx, by, bz)) + + pab*ftza*vab(coset(ax + 2, ay, az), coset(bx, by, bz)) & + - pab*REAL(ax, dp)*vab(coset(MAX(0, ax - 1) + 1, ay, az), coset(bx, by, bz)) my_virial_a(1, 2) = my_virial_a(1, 2) & - +pab*ftza*vab(coset(ax+1, ay+1, az), coset(bx, by, bz)) & - -pab*REAL(ax, dp)*vab(coset(MAX(0, ax-1), ay+1, az), coset(bx, by, bz)) + + pab*ftza*vab(coset(ax + 1, ay + 1, az), coset(bx, by, bz)) & + - pab*REAL(ax, dp)*vab(coset(MAX(0, ax - 1), ay + 1, az), coset(bx, by, bz)) my_virial_a(1, 3) = my_virial_a(1, 3) & - +pab*ftza*vab(coset(ax+1, ay, az+1), coset(bx, by, bz)) & - -pab*REAL(ax, dp)*vab(coset(MAX(0, ax-1), ay, az+1), coset(bx, by, bz)) + + pab*ftza*vab(coset(ax + 1, ay, az + 1), coset(bx, by, bz)) & + - pab*REAL(ax, dp)*vab(coset(MAX(0, ax - 1), ay, az + 1), coset(bx, by, bz)) my_virial_a(2, 1) = my_virial_a(2, 1) & - +pab*ftza*vab(coset(ax+1, ay+1, az), coset(bx, by, bz)) & - -pab*REAL(ay, dp)*vab(coset(ax+1, MAX(0, ay-1), az), coset(bx, by, bz)) + + pab*ftza*vab(coset(ax + 1, ay + 1, az), coset(bx, by, bz)) & + - pab*REAL(ay, dp)*vab(coset(ax + 1, MAX(0, ay - 1), az), coset(bx, by, bz)) my_virial_a(2, 2) = my_virial_a(2, 2) & - +pab*ftza*vab(coset(ax, ay+2, az), coset(bx, by, bz)) & - -pab*REAL(ay, dp)*vab(coset(ax, MAX(0, ay-1)+1, az), coset(bx, by, bz)) + + pab*ftza*vab(coset(ax, ay + 2, az), coset(bx, by, bz)) & + - pab*REAL(ay, dp)*vab(coset(ax, MAX(0, ay - 1) + 1, az), coset(bx, by, bz)) my_virial_a(2, 3) = my_virial_a(2, 3) & - +pab*ftza*vab(coset(ax, ay+1, az+1), coset(bx, by, bz)) & - -pab*REAL(ay, dp)*vab(coset(ax, MAX(0, ay-1), az+1), coset(bx, by, bz)) + + pab*ftza*vab(coset(ax, ay + 1, az + 1), coset(bx, by, bz)) & + - pab*REAL(ay, dp)*vab(coset(ax, MAX(0, ay - 1), az + 1), coset(bx, by, bz)) my_virial_a(3, 1) = my_virial_a(3, 1) & - +pab*ftza*vab(coset(ax+1, ay, az+1), coset(bx, by, bz)) & - -pab*REAL(az, dp)*vab(coset(ax+1, ay, MAX(0, az-1)), coset(bx, by, bz)) + + pab*ftza*vab(coset(ax + 1, ay, az + 1), coset(bx, by, bz)) & + - pab*REAL(az, dp)*vab(coset(ax + 1, ay, MAX(0, az - 1)), coset(bx, by, bz)) my_virial_a(3, 2) = my_virial_a(3, 2) & - +pab*ftza*vab(coset(ax, ay+1, az+1), coset(bx, by, bz)) & - -pab*REAL(az, dp)*vab(coset(ax, ay+1, MAX(0, az-1)), coset(bx, by, bz)) + + pab*ftza*vab(coset(ax, ay + 1, az + 1), coset(bx, by, bz)) & + - pab*REAL(az, dp)*vab(coset(ax, ay + 1, MAX(0, az - 1)), coset(bx, by, bz)) my_virial_a(3, 3) = my_virial_a(3, 3) & - +pab*ftza*vab(coset(ax, ay, az+2), coset(bx, by, bz)) & - -pab*REAL(az, dp)*vab(coset(ax, ay, MAX(0, az-1)+1), coset(bx, by, bz)) - - my_virial_b(1, 1) = my_virial_b(1, 1)+pab*ftzb*( & - vab(coset(ax+2, ay, az), coset(bx, by, bz)) & - -vab(coset(ax+1, ay, az), coset(bx, by, bz))*rab(1) & - -vab(coset(ax+1, ay, az), coset(bx, by, bz))*rab(1) & - +vab(coset(ax, ay, az), coset(bx, by, bz))*rab(1)*rab(1)) & - -pab*REAL(bx, dp)*vab(coset(ax, ay, az), coset(MAX(0, bx-1)+1, by, bz)) - my_virial_b(1, 2) = my_virial_b(1, 2)+pab*ftzb*( & - vab(coset(ax+1, ay+1, az), coset(bx, by, bz)) & - -vab(coset(ax, ay+1, az), coset(bx, by, bz))*rab(1) & - -vab(coset(ax+1, ay, az), coset(bx, by, bz))*rab(2) & - +vab(coset(ax, ay, az), coset(bx, by, bz))*rab(1)*rab(2)) & - -pab*REAL(bx, dp)*vab(coset(ax, ay, az), coset(MAX(0, bx-1), by+1, bz)) - my_virial_b(1, 3) = my_virial_b(1, 3)+pab*ftzb*( & - vab(coset(ax+1, ay, az+1), coset(bx, by, bz)) & - -vab(coset(ax, ay, az+1), coset(bx, by, bz))*rab(1) & - -vab(coset(ax+1, ay, az), coset(bx, by, bz))*rab(3) & - +vab(coset(ax, ay, az), coset(bx, by, bz))*rab(1)*rab(3)) & - -pab*REAL(bx, dp)*vab(coset(ax, ay, az), coset(MAX(0, bx-1), by, bz+1)) - my_virial_b(2, 1) = my_virial_b(2, 1)+pab*ftzb*( & - vab(coset(ax+1, ay+1, az), coset(bx, by, bz)) & - -vab(coset(ax+1, ay, az), coset(bx, by, bz))*rab(2) & - -vab(coset(ax, ay+1, az), coset(bx, by, bz))*rab(1) & - +vab(coset(ax, ay, az), coset(bx, by, bz))*rab(2)*rab(1)) & - -pab*REAL(by, dp)*vab(coset(ax, ay, az), coset(bx+1, MAX(0, by-1), bz)) - my_virial_b(2, 2) = my_virial_b(2, 2)+pab*ftzb*( & - vab(coset(ax, ay+2, az), coset(bx, by, bz)) & - -vab(coset(ax, ay+1, az), coset(bx, by, bz))*rab(2) & - -vab(coset(ax, ay+1, az), coset(bx, by, bz))*rab(2) & - +vab(coset(ax, ay, az), coset(bx, by, bz))*rab(2)*rab(2)) & - -pab*REAL(by, dp)*vab(coset(ax, ay, az), coset(bx, MAX(0, by-1)+1, bz)) - my_virial_b(2, 3) = my_virial_b(2, 3)+pab*ftzb*( & - vab(coset(ax, ay+1, az+1), coset(bx, by, bz)) & - -vab(coset(ax, ay, az+1), coset(bx, by, bz))*rab(2) & - -vab(coset(ax, ay+1, az), coset(bx, by, bz))*rab(3) & - +vab(coset(ax, ay, az), coset(bx, by, bz))*rab(2)*rab(3)) & - -pab*REAL(by, dp)*vab(coset(ax, ay, az), coset(bx, MAX(0, by-1), bz+1)) - my_virial_b(3, 1) = my_virial_b(3, 1)+pab*ftzb*( & - vab(coset(ax+1, ay, az+1), coset(bx, by, bz)) & - -vab(coset(ax+1, ay, az), coset(bx, by, bz))*rab(3) & - -vab(coset(ax, ay, az+1), coset(bx, by, bz))*rab(1) & - +vab(coset(ax, ay, az), coset(bx, by, bz))*rab(3)*rab(1)) & - -pab*REAL(bz, dp)*vab(coset(ax, ay, az), coset(bx+1, by, MAX(0, bz-1))) - my_virial_b(3, 2) = my_virial_b(3, 2)+pab*ftzb*( & - vab(coset(ax, ay+1, az+1), coset(bx, by, bz)) & - -vab(coset(ax, ay+1, az), coset(bx, by, bz))*rab(3) & - -vab(coset(ax, ay, az+1), coset(bx, by, bz))*rab(2) & - +vab(coset(ax, ay, az), coset(bx, by, bz))*rab(3)*rab(2)) & - -pab*REAL(bz, dp)*vab(coset(ax, ay, az), coset(bx, by+1, MAX(0, bz-1))) - my_virial_b(3, 3) = my_virial_b(3, 3)+pab*ftzb*( & - vab(coset(ax, ay, az+2), coset(bx, by, bz)) & - -vab(coset(ax, ay, az+1), coset(bx, by, bz))*rab(3) & - -vab(coset(ax, ay, az+1), coset(bx, by, bz))*rab(3) & - +vab(coset(ax, ay, az), coset(bx, by, bz))*rab(3)*rab(3)) & - -pab*REAL(bz, dp)*vab(coset(ax, ay, az), coset(bx, by, MAX(0, bz-1)+1)) + + pab*ftza*vab(coset(ax, ay, az + 2), coset(bx, by, bz)) & + - pab*REAL(az, dp)*vab(coset(ax, ay, MAX(0, az - 1) + 1), coset(bx, by, bz)) + + my_virial_b(1, 1) = my_virial_b(1, 1) + pab*ftzb*( & + vab(coset(ax + 2, ay, az), coset(bx, by, bz)) & + - vab(coset(ax + 1, ay, az), coset(bx, by, bz))*rab(1) & + - vab(coset(ax + 1, ay, az), coset(bx, by, bz))*rab(1) & + + vab(coset(ax, ay, az), coset(bx, by, bz))*rab(1)*rab(1)) & + - pab*REAL(bx, dp)*vab(coset(ax, ay, az), coset(MAX(0, bx - 1) + 1, by, bz)) + my_virial_b(1, 2) = my_virial_b(1, 2) + pab*ftzb*( & + vab(coset(ax + 1, ay + 1, az), coset(bx, by, bz)) & + - vab(coset(ax, ay + 1, az), coset(bx, by, bz))*rab(1) & + - vab(coset(ax + 1, ay, az), coset(bx, by, bz))*rab(2) & + + vab(coset(ax, ay, az), coset(bx, by, bz))*rab(1)*rab(2)) & + - pab*REAL(bx, dp)*vab(coset(ax, ay, az), coset(MAX(0, bx - 1), by + 1, bz)) + my_virial_b(1, 3) = my_virial_b(1, 3) + pab*ftzb*( & + vab(coset(ax + 1, ay, az + 1), coset(bx, by, bz)) & + - vab(coset(ax, ay, az + 1), coset(bx, by, bz))*rab(1) & + - vab(coset(ax + 1, ay, az), coset(bx, by, bz))*rab(3) & + + vab(coset(ax, ay, az), coset(bx, by, bz))*rab(1)*rab(3)) & + - pab*REAL(bx, dp)*vab(coset(ax, ay, az), coset(MAX(0, bx - 1), by, bz + 1)) + my_virial_b(2, 1) = my_virial_b(2, 1) + pab*ftzb*( & + vab(coset(ax + 1, ay + 1, az), coset(bx, by, bz)) & + - vab(coset(ax + 1, ay, az), coset(bx, by, bz))*rab(2) & + - vab(coset(ax, ay + 1, az), coset(bx, by, bz))*rab(1) & + + vab(coset(ax, ay, az), coset(bx, by, bz))*rab(2)*rab(1)) & + - pab*REAL(by, dp)*vab(coset(ax, ay, az), coset(bx + 1, MAX(0, by - 1), bz)) + my_virial_b(2, 2) = my_virial_b(2, 2) + pab*ftzb*( & + vab(coset(ax, ay + 2, az), coset(bx, by, bz)) & + - vab(coset(ax, ay + 1, az), coset(bx, by, bz))*rab(2) & + - vab(coset(ax, ay + 1, az), coset(bx, by, bz))*rab(2) & + + vab(coset(ax, ay, az), coset(bx, by, bz))*rab(2)*rab(2)) & + - pab*REAL(by, dp)*vab(coset(ax, ay, az), coset(bx, MAX(0, by - 1) + 1, bz)) + my_virial_b(2, 3) = my_virial_b(2, 3) + pab*ftzb*( & + vab(coset(ax, ay + 1, az + 1), coset(bx, by, bz)) & + - vab(coset(ax, ay, az + 1), coset(bx, by, bz))*rab(2) & + - vab(coset(ax, ay + 1, az), coset(bx, by, bz))*rab(3) & + + vab(coset(ax, ay, az), coset(bx, by, bz))*rab(2)*rab(3)) & + - pab*REAL(by, dp)*vab(coset(ax, ay, az), coset(bx, MAX(0, by - 1), bz + 1)) + my_virial_b(3, 1) = my_virial_b(3, 1) + pab*ftzb*( & + vab(coset(ax + 1, ay, az + 1), coset(bx, by, bz)) & + - vab(coset(ax + 1, ay, az), coset(bx, by, bz))*rab(3) & + - vab(coset(ax, ay, az + 1), coset(bx, by, bz))*rab(1) & + + vab(coset(ax, ay, az), coset(bx, by, bz))*rab(3)*rab(1)) & + - pab*REAL(bz, dp)*vab(coset(ax, ay, az), coset(bx + 1, by, MAX(0, bz - 1))) + my_virial_b(3, 2) = my_virial_b(3, 2) + pab*ftzb*( & + vab(coset(ax, ay + 1, az + 1), coset(bx, by, bz)) & + - vab(coset(ax, ay + 1, az), coset(bx, by, bz))*rab(3) & + - vab(coset(ax, ay, az + 1), coset(bx, by, bz))*rab(2) & + + vab(coset(ax, ay, az), coset(bx, by, bz))*rab(3)*rab(2)) & + - pab*REAL(bz, dp)*vab(coset(ax, ay, az), coset(bx, by + 1, MAX(0, bz - 1))) + my_virial_b(3, 3) = my_virial_b(3, 3) + pab*ftzb*( & + vab(coset(ax, ay, az + 2), coset(bx, by, bz)) & + - vab(coset(ax, ay, az + 1), coset(bx, by, bz))*rab(3) & + - vab(coset(ax, ay, az + 1), coset(bx, by, bz))*rab(3) & + + vab(coset(ax, ay, az), coset(bx, by, bz))*rab(3)*rab(3)) & + - pab*REAL(bz, dp)*vab(coset(ax, ay, az), coset(bx, by, MAX(0, bz - 1) + 1)) END SUBROUTINE virial_update @@ -1006,21 +1006,21 @@ SUBROUTINE force_update(force_a, force_b, rab, pab, ftza, ftzb, ax, ay, az, bx, azp1, bxm1, bym1, bzm1 axpm0 = vab(coset(ax, ay, az), coset(bx, by, bz)) - axp1 = vab(coset(ax+1, ay, az), coset(bx, by, bz)) - axm1 = vab(coset(MAX(0, ax-1), ay, az), coset(bx, by, bz)) - ayp1 = vab(coset(ax, ay+1, az), coset(bx, by, bz)) - aym1 = vab(coset(ax, MAX(0, ay-1), az), coset(bx, by, bz)) - azp1 = vab(coset(ax, ay, az+1), coset(bx, by, bz)) - azm1 = vab(coset(ax, ay, MAX(0, az-1)), coset(bx, by, bz)) - bxm1 = vab(coset(ax, ay, az), coset(MAX(0, bx-1), by, bz)) - bym1 = vab(coset(ax, ay, az), coset(bx, MAX(0, by-1), bz)) - bzm1 = vab(coset(ax, ay, az), coset(bx, by, MAX(0, bz-1))) - force_a(1) = force_a(1)+pab*(ftza*axp1-REAL(ax, dp)*axm1) - force_a(2) = force_a(2)+pab*(ftza*ayp1-REAL(ay, dp)*aym1) - force_a(3) = force_a(3)+pab*(ftza*azp1-REAL(az, dp)*azm1) - force_b(1) = force_b(1)+pab*(ftzb*(axp1-rab(1)*axpm0)-REAL(bx, dp)*bxm1) - force_b(2) = force_b(2)+pab*(ftzb*(ayp1-rab(2)*axpm0)-REAL(by, dp)*bym1) - force_b(3) = force_b(3)+pab*(ftzb*(azp1-rab(3)*axpm0)-REAL(bz, dp)*bzm1) + axp1 = vab(coset(ax + 1, ay, az), coset(bx, by, bz)) + axm1 = vab(coset(MAX(0, ax - 1), ay, az), coset(bx, by, bz)) + ayp1 = vab(coset(ax, ay + 1, az), coset(bx, by, bz)) + aym1 = vab(coset(ax, MAX(0, ay - 1), az), coset(bx, by, bz)) + azp1 = vab(coset(ax, ay, az + 1), coset(bx, by, bz)) + azm1 = vab(coset(ax, ay, MAX(0, az - 1)), coset(bx, by, bz)) + bxm1 = vab(coset(ax, ay, az), coset(MAX(0, bx - 1), by, bz)) + bym1 = vab(coset(ax, ay, az), coset(bx, MAX(0, by - 1), bz)) + bzm1 = vab(coset(ax, ay, az), coset(bx, by, MAX(0, bz - 1))) + force_a(1) = force_a(1) + pab*(ftza*axp1 - REAL(ax, dp)*axm1) + force_a(2) = force_a(2) + pab*(ftza*ayp1 - REAL(ay, dp)*aym1) + force_a(3) = force_a(3) + pab*(ftza*azp1 - REAL(az, dp)*azm1) + force_b(1) = force_b(1) + pab*(ftzb*(axp1 - rab(1)*axpm0) - REAL(bx, dp)*bxm1) + force_b(2) = force_b(2) + pab*(ftzb*(ayp1 - rab(2)*axpm0) - REAL(by, dp)*bym1) + force_b(3) = force_b(3) + pab*(ftzb*(azp1 - rab(3)*axpm0) - REAL(bz, dp)*bzm1) END SUBROUTINE force_update @@ -1051,21 +1051,21 @@ SUBROUTINE hab_derivatives(der_a, der_b, rab, ftza, ftzb, ax, ay, az, bx, by, bz azp1, bxm1, bym1, bzm1 axpm0 = vab(coset(ax, ay, az), coset(bx, by, bz)) - axp1 = vab(coset(ax+1, ay, az), coset(bx, by, bz)) - axm1 = vab(coset(MAX(0, ax-1), ay, az), coset(bx, by, bz)) - ayp1 = vab(coset(ax, ay+1, az), coset(bx, by, bz)) - aym1 = vab(coset(ax, MAX(0, ay-1), az), coset(bx, by, bz)) - azp1 = vab(coset(ax, ay, az+1), coset(bx, by, bz)) - azm1 = vab(coset(ax, ay, MAX(0, az-1)), coset(bx, by, bz)) - bxm1 = vab(coset(ax, ay, az), coset(MAX(0, bx-1), by, bz)) - bym1 = vab(coset(ax, ay, az), coset(bx, MAX(0, by-1), bz)) - bzm1 = vab(coset(ax, ay, az), coset(bx, by, MAX(0, bz-1))) - der_a(1) = (ftza*axp1-REAL(ax, dp)*axm1) - der_a(2) = (ftza*ayp1-REAL(ay, dp)*aym1) - der_a(3) = (ftza*azp1-REAL(az, dp)*azm1) - der_b(1) = (ftzb*(axp1-rab(1)*axpm0)-REAL(bx, dp)*bxm1) - der_b(2) = (ftzb*(ayp1-rab(2)*axpm0)-REAL(by, dp)*bym1) - der_b(3) = (ftzb*(azp1-rab(3)*axpm0)-REAL(bz, dp)*bzm1) + axp1 = vab(coset(ax + 1, ay, az), coset(bx, by, bz)) + axm1 = vab(coset(MAX(0, ax - 1), ay, az), coset(bx, by, bz)) + ayp1 = vab(coset(ax, ay + 1, az), coset(bx, by, bz)) + aym1 = vab(coset(ax, MAX(0, ay - 1), az), coset(bx, by, bz)) + azp1 = vab(coset(ax, ay, az + 1), coset(bx, by, bz)) + azm1 = vab(coset(ax, ay, MAX(0, az - 1)), coset(bx, by, bz)) + bxm1 = vab(coset(ax, ay, az), coset(MAX(0, bx - 1), by, bz)) + bym1 = vab(coset(ax, ay, az), coset(bx, MAX(0, by - 1), bz)) + bzm1 = vab(coset(ax, ay, az), coset(bx, by, MAX(0, bz - 1))) + der_a(1) = (ftza*axp1 - REAL(ax, dp)*axm1) + der_a(2) = (ftza*ayp1 - REAL(ay, dp)*aym1) + der_a(3) = (ftza*azp1 - REAL(az, dp)*azm1) + der_b(1) = (ftzb*(axp1 - rab(1)*axpm0) - REAL(bx, dp)*bxm1) + der_b(2) = (ftzb*(ayp1 - rab(2)*axpm0) - REAL(by, dp)*bym1) + der_b(3) = (ftzb*(azp1 - rab(3)*axpm0) - REAL(bz, dp)*bzm1) END SUBROUTINE hab_derivatives diff --git a/src/qs_integrate_potential_product.F b/src/qs_integrate_potential_product.F index 200e4b1004..fef7cfef06 100644 --- a/src/qs_integrate_potential_product.F +++ b/src/qs_integrate_potential_product.F @@ -207,7 +207,7 @@ SUBROUTINE integrate_v_rspace(v_rspace, hmat, hmat_kp, pmat, pmat_kp, & NULLIFY (pw_env, rs_descs, tasks, dist_ab, admm_env) - debug_count = debug_count+1 + debug_count = debug_count + 1 offs_dv = 0 @@ -618,15 +618,15 @@ SUBROUTINE integrate_v_rspace(v_rspace, hmat, hmat_kp, pmat, pmat_kp, & rab(2) = dist_ab(2, itask) rab(3) = dist_ab(3, itask) rab2 = DOT_PRODUCT(rab, rab) - rb(1) = ra(1)+rab(1) - rb(2) = ra(2)+rab(2) - rb(3) = ra(3)+rab(3) - zetp = zeta(ipgf, iset)+zetb(jpgf, jset) + rb(1) = ra(1) + rab(1) + rb(2) = ra(2) + rab(2) + rb(3) = ra(3) + rab(3) + zetp = zeta(ipgf, iset) + zetb(jpgf, jset) dab = SQRT(rab2) - na1 = (ipgf-1)*ncoset(la_max(iset))+1 + na1 = (ipgf - 1)*ncoset(la_max(iset)) + 1 na2 = ipgf*ncoset(la_max(iset)) - nb1 = (jpgf-1)*ncoset(lb_max(jset))+1 + nb1 = (jpgf - 1)*ncoset(lb_max(jset)) + 1 nb2 = jpgf*ncoset(lb_max(jset)) ! check whether we need to use fawzi's generalised collocation scheme @@ -648,7 +648,7 @@ SUBROUTINE integrate_v_rspace(v_rspace, hmat, hmat_kp, pmat, pmat_kp, & lb_max(jset), zetb(jpgf, jset), lb_min(jset), & ra, rab, rab2, rs_v(igrid_level)%rs_grid, cell, & cube_info(igrid_level), & - hab, pab=pab, o1=na1-1, o2=nb1-1, & + hab, pab=pab, o1=na1 - 1, o2=nb1 - 1, & eps_gvg_rspace=eps_gvg_rspace, & calculate_forces=calculate_forces, & force_a=force_a, force_b=force_b, & @@ -662,7 +662,7 @@ SUBROUTINE integrate_v_rspace(v_rspace, hmat, hmat_kp, pmat, pmat_kp, & la_max(iset), zeta(ipgf, iset), la_min(iset), & rb, rab_inv, rab2, rs_v(igrid_level)%rs_grid, cell, & cube_info(igrid_level), & - hab, pab=pab, o1=nb1-1, o2=na1-1, & + hab, pab=pab, o1=nb1 - 1, o2=na1 - 1, & eps_gvg_rspace=eps_gvg_rspace, & calculate_forces=calculate_forces, & force_a=force_b, force_b=force_a, & @@ -677,7 +677,7 @@ SUBROUTINE integrate_v_rspace(v_rspace, hmat, hmat_kp, pmat, pmat_kp, & lb_max(jset), zetb(jpgf, jset), lb_min(jset), & ra, rab, rab2, rs_v(igrid_level)%rs_grid, cell, & cube_info(igrid_level), & - hab, o1=na1-1, o2=nb1-1, & + hab, o1=na1 - 1, o2=nb1 - 1, & eps_gvg_rspace=eps_gvg_rspace, & calculate_forces=calculate_forces, & force_a=force_a, force_b=force_b, & @@ -690,7 +690,7 @@ SUBROUTINE integrate_v_rspace(v_rspace, hmat, hmat_kp, pmat, pmat_kp, & la_max(iset), zeta(ipgf, iset), la_min(iset), & rb, rab_inv, rab2, rs_v(igrid_level)%rs_grid, cell, & cube_info(igrid_level), & - hab, o1=nb1-1, o2=na1-1, & + hab, o1=nb1 - 1, o2=na1 - 1, & eps_gvg_rspace=eps_gvg_rspace, & calculate_forces=calculate_forces, & force_a=force_b, force_b=force_a, & @@ -702,7 +702,7 @@ SUBROUTINE integrate_v_rspace(v_rspace, hmat, hmat_kp, pmat, pmat_kp, & new_set_pair_coming = .FALSE. atom_pair_done = .FALSE. IF (itask < task_list%taskstop(ipair, igrid_level)) THEN - CALL int2pair(tasks(3, itask+1), ilevel, img, iatom, jatom, iset_new, jset_new, ipgf_new, jpgf_new, & + CALL int2pair(tasks(3, itask + 1), ilevel, img, iatom, jatom, iset_new, jset_new, ipgf_new, jpgf_new, & nimages, natom, maxset, maxpgf) IF (iset_new .NE. iset .OR. jset_new .NE. jset) THEN new_set_pair_coming = .TRUE. @@ -745,14 +745,14 @@ SUBROUTINE integrate_v_rspace(v_rspace, hmat, hmat_kp, pmat, pmat_kp, & END IF IF (calculate_forces) THEN force(ikind)%rho_elec(:, atom_a) = & - force(ikind)%rho_elec(:, atom_a)+scalef*admm_scal_fac*force_a(:) + force(ikind)%rho_elec(:, atom_a) + scalef*admm_scal_fac*force_a(:) force(jkind)%rho_elec(:, atom_b) = & - force(jkind)%rho_elec(:, atom_b)+scalef*admm_scal_fac*force_b(:) + force(jkind)%rho_elec(:, atom_b) + scalef*admm_scal_fac*force_b(:) ENDIF IF (use_virial) THEN IF (use_virial .AND. calculate_forces) THEN - virial%pv_virial = virial%pv_virial+scalef*admm_scal_fac*my_virial_a - virial%pv_virial = virial%pv_virial+scalef*admm_scal_fac*my_virial_b + virial%pv_virial = virial%pv_virial + scalef*admm_scal_fac*my_virial_a + virial%pv_virial = virial%pv_virial + scalef*admm_scal_fac*my_virial_b END IF END IF !$OMP END CRITICAL (force_critical) diff --git a/src/qs_integrate_potential_single.F b/src/qs_integrate_potential_single.F index 30797593e7..3b779f9a38 100644 --- a/src/qs_integrate_potential_single.F +++ b/src/qs_integrate_potential_single.F @@ -155,7 +155,7 @@ SUBROUTINE integrate_ppl_rspace(rho_rspace, qs_env) IF (lppl <= 0) CYCLE - ni = ncoset(2*lppl-2) + ni = ncoset(2*lppl - 2) ALLOCATE (hab(ni, 1), pab(ni, 1)) pab = 0._dp @@ -220,11 +220,11 @@ SUBROUTINE integrate_ppl_rspace(rho_rspace, qs_env) IF (rs_v%desc%parallel .AND. .NOT. rs_v%desc%distributed) THEN ! replicated realspace grid, split the atoms up between procs IF (MODULO(iatom, rs_v%desc%group_size) == rs_v%desc%my_pos) THEN - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF ELSE - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF END DO @@ -241,7 +241,7 @@ SUBROUTINE integrate_ppl_rspace(rho_rspace, qs_env) my_virial_a = 0.0_dp my_virial_b = 0.0_dp END IF - ni = 2*lppl-2 + ni = 2*lppl - 2 CALL integrate_pgf_product_rspace(ni, alpha, 0, & 0, 0.0_dp, 0, ra, (/0.0_dp, 0.0_dp, 0.0_dp/), 0.0_dp, & @@ -252,11 +252,11 @@ SUBROUTINE integrate_ppl_rspace(rho_rspace, qs_env) my_virial_b=my_virial_b, use_subpatch=.TRUE., subpatch_pattern=0_int_8) force(ikind)%gth_ppl(:, iatom) = & - force(ikind)%gth_ppl(:, iatom)+force_a(:)*rho_rspace%pw%pw_grid%dvol + force(ikind)%gth_ppl(:, iatom) + force_a(:)*rho_rspace%pw%pw_grid%dvol IF (use_virial) THEN - virial%pv_virial = virial%pv_virial+my_virial_a*rho_rspace%pw%pw_grid%dvol - virial%pv_ppl = virial%pv_ppl+my_virial_a*rho_rspace%pw%pw_grid%dvol + virial%pv_virial = virial%pv_virial + my_virial_a*rho_rspace%pw%pw_grid%dvol + virial%pv_ppl = virial%pv_ppl + my_virial_a*rho_rspace%pw%pw_grid%dvol CPABORT("Virial not debuged for CORE_PPL") END IF END DO @@ -345,7 +345,7 @@ SUBROUTINE integrate_rho_nlcc(rho_rspace, qs_env) alpha = alpha_nlcc(iexp_nlcc) nc = nct_nlcc(iexp_nlcc) - ni = ncoset(2*nc-2) + ni = ncoset(2*nc - 2) nthread = 1 ithread = 0 @@ -415,11 +415,11 @@ SUBROUTINE integrate_rho_nlcc(rho_rspace, qs_env) IF (rs_v%desc%parallel .AND. .NOT. rs_v%desc%distributed) THEN ! replicated realspace grid, split the atoms up between procs IF (MODULO(iatom, rs_v%desc%group_size) == rs_v%desc%my_pos) THEN - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF ELSE - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF END DO @@ -436,7 +436,7 @@ SUBROUTINE integrate_rho_nlcc(rho_rspace, qs_env) my_virial_a = 0.0_dp my_virial_b = 0.0_dp END IF - ni = 2*nc-2 + ni = 2*nc - 2 CALL integrate_pgf_product_rspace(ni, 1/(2*alpha**2), 0, & 0, 0.0_dp, 0, ra, (/0.0_dp, 0.0_dp, 0.0_dp/), 0.0_dp, & @@ -447,11 +447,11 @@ SUBROUTINE integrate_rho_nlcc(rho_rspace, qs_env) my_virial_b=my_virial_b, use_subpatch=.TRUE., subpatch_pattern=0_int_8) force(ikind)%gth_nlcc(:, iatom) = & - force(ikind)%gth_nlcc(:, iatom)+force_a(:)*rho_rspace%pw%pw_grid%dvol + force(ikind)%gth_nlcc(:, iatom) + force_a(:)*rho_rspace%pw%pw_grid%dvol IF (use_virial) THEN - virial%pv_virial = virial%pv_virial+my_virial_a*rho_rspace%pw%pw_grid%dvol - virial%pv_exc = virial%pv_exc+my_virial_a*rho_rspace%pw%pw_grid%dvol + virial%pv_virial = virial%pv_virial + my_virial_a*rho_rspace%pw%pw_grid%dvol + virial%pv_exc = virial%pv_exc + my_virial_a*rho_rspace%pw%pw_grid%dvol END IF END DO @@ -575,11 +575,11 @@ SUBROUTINE integrate_v_core_rspace(v_rspace, qs_env) IF (rs_v%desc%parallel .AND. .NOT. rs_v%desc%distributed) THEN ! replicated realspace grid, split the atoms up between procs IF (MODULO(iatom, rs_v%desc%group_size) == rs_v%desc%my_pos) THEN - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF ELSE - npme = npme+1 + npme = npme + 1 cores(npme) = iatom ENDIF END DO @@ -607,15 +607,15 @@ SUBROUTINE integrate_v_core_rspace(v_rspace, qs_env) IF (ASSOCIATED(force)) THEN force(ikind)%rho_core(:, iatom) = & - force(ikind)%rho_core(:, iatom)+force_a(:) + force(ikind)%rho_core(:, iatom) + force_a(:) ENDIF IF (use_virial) THEN - virial%pv_virial = virial%pv_virial+my_virial_a - virial%pv_hartree = virial%pv_hartree+my_virial_a + virial%pv_virial = virial%pv_virial + my_virial_a + virial%pv_hartree = virial%pv_hartree + my_virial_a END IF IF (ASSOCIATED(atprop)) THEN - atprop%ateb(atom_a) = atprop%ateb(atom_a)+0.5_dp*hab(1, 1)*pab(1, 1) + atprop%ateb(atom_a) = atprop%ateb(atom_a) + 0.5_dp*hab(1, 1)*pab(1, 1) END IF END DO @@ -774,14 +774,14 @@ SUBROUTINE integrate_v_rspace_one_center(v_rspace, qs_env, int_res, & tp(dir) = FLOOR(DOT_PRODUCT(cell%h_inv(dir, :), ra)*rs_grid%desc%npts(dir)) tp(dir) = MODULO(tp(dir), rs_grid%desc%npts(dir)) IF (rs_grid%desc%perd(dir) .NE. 1) THEN - lb(dir) = rs_grid%lb_local(dir)+rs_grid%desc%border - ub(dir) = rs_grid%ub_local(dir)-rs_grid%desc%border + lb(dir) = rs_grid%lb_local(dir) + rs_grid%desc%border + ub(dir) = rs_grid%ub_local(dir) - rs_grid%desc%border ELSE lb(dir) = rs_grid%lb_local(dir) ub(dir) = rs_grid%ub_local(dir) ENDIF ! distributed grid, only map if it is local to the grid - location(dir) = tp(dir)+rs_grid%desc%lb(dir) + location(dir) = tp(dir) + rs_grid%desc%lb(dir) ENDDO IF (lb(1) <= location(1) .AND. location(1) <= ub(1) .AND. & lb(2) <= location(2) .AND. location(2) <= ub(2) .AND. & @@ -793,7 +793,7 @@ SUBROUTINE integrate_v_rspace_one_center(v_rspace, qs_env, int_res, & IF (MODULO(offset, group_size) == my_pos) map_it(ipgf) = .TRUE. ENDIF END DO - offset = offset+1 + offset = offset + 1 ! IF (ANY(map_it(1:npgfa(iset)))) THEN sgfa = first_sgfa(1, iset) @@ -804,7 +804,7 @@ SUBROUTINE integrate_v_rspace_one_center(v_rspace, qs_env, int_res, & ! get fit coefficients for forces IF (calculate_forces) THEN - m1 = sgfa+nsgf_seta(iset)-1 + m1 = sgfa + nsgf_seta(iset) - 1 ALLOCATE (work_f(nsgf_seta(iset), 1)) work_f(1:nsgf_seta(iset), 1) = int_res(ikind)%acoef(iatom, sgfa:m1) CALL dgemm("N", "N", ncoa, 1, nsgf_seta(iset), 1.0_dp, sphi_a(1, sgfa), & @@ -814,7 +814,7 @@ SUBROUTINE integrate_v_rspace_one_center(v_rspace, qs_env, int_res, & ENDIF DO ipgf = 1, npgfa(iset) - na1 = (ipgf-1)*ncoset(la_max(iset)) + na1 = (ipgf - 1)*ncoset(la_max(iset)) igrid_level = gaussian_gridlevel(gridlevel_info, zeta(ipgf, iset)) rs_grid => rs_v(igrid_level)%rs_grid @@ -849,16 +849,16 @@ SUBROUTINE integrate_v_rspace_one_center(v_rspace, qs_env, int_res, & CALL dgemm("T", "N", nsgf_seta(iset), 1, ncoa, 1.0_dp, sphi_a(1, sgfa), & SIZE(sphi_a, 1), hab(1, 1), SIZE(hab, 1), 0.0_dp, work_i(1, 1), SIZE(work_i, 1)) - int_res(ikind)%v_int(iatom, sgfa:sgfa-1+nsgf_seta(iset)) = & - int_res(ikind)%v_int(iatom, sgfa:sgfa-1+nsgf_seta(iset))+work_i(1:nsgf_seta(iset), 1) + int_res(ikind)%v_int(iatom, sgfa:sgfa - 1 + nsgf_seta(iset)) = & + int_res(ikind)%v_int(iatom, sgfa:sgfa - 1 + nsgf_seta(iset)) + work_i(1:nsgf_seta(iset), 1) DEALLOCATE (work_i) END IF ENDDO ! IF (calculate_forces) THEN - int_res(ikind)%v_dfdr(iatom, :) = int_res(ikind)%v_dfdr(iatom, :)+force_a(:) + int_res(ikind)%v_dfdr(iatom, :) = int_res(ikind)%v_dfdr(iatom, :) + force_a(:) IF (use_virial) THEN - virial%pv_virial = virial%pv_virial+my_virial_a + virial%pv_virial = virial%pv_virial + my_virial_a ENDIF ENDIF @@ -1009,7 +1009,7 @@ SUBROUTINE integrate_v_rspace_diagonal(v_rspace, ksmat, pmat, qs_env, calculate_ map_it2 = .FALSE. DO ipgf = 1, npgfa(iset) DO jpgf = 1, npgfa(jset) - zetp = zeta(ipgf, iset)+zeta(jpgf, jset) + zetp = zeta(ipgf, iset) + zeta(jpgf, jset) igrid_level = gaussian_gridlevel(gridlevel_info, zetp) rs_grid => rs_v(igrid_level)%rs_grid IF (.NOT. ALL(rs_grid%desc%perd == 1)) THEN @@ -1018,14 +1018,14 @@ SUBROUTINE integrate_v_rspace_diagonal(v_rspace, ksmat, pmat, qs_env, calculate_ tp(dir) = FLOOR(DOT_PRODUCT(cell%h_inv(dir, :), ra)*rs_grid%desc%npts(dir)) tp(dir) = MODULO(tp(dir), rs_grid%desc%npts(dir)) IF (rs_grid%desc%perd(dir) .NE. 1) THEN - lb(dir) = rs_grid%lb_local(dir)+rs_grid%desc%border - ub(dir) = rs_grid%ub_local(dir)-rs_grid%desc%border + lb(dir) = rs_grid%lb_local(dir) + rs_grid%desc%border + ub(dir) = rs_grid%ub_local(dir) - rs_grid%desc%border ELSE lb(dir) = rs_grid%lb_local(dir) ub(dir) = rs_grid%ub_local(dir) ENDIF ! distributed grid, only map if it is local to the grid - location(dir) = tp(dir)+rs_grid%desc%lb(dir) + location(dir) = tp(dir) + rs_grid%desc%lb(dir) ENDDO IF (lb(1) <= location(1) .AND. location(1) <= ub(1) .AND. & lb(2) <= location(2) .AND. location(2) <= ub(2) .AND. & @@ -1038,7 +1038,7 @@ SUBROUTINE integrate_v_rspace_diagonal(v_rspace, ksmat, pmat, qs_env, calculate_ ENDIF END DO END DO - offset = offset+1 + offset = offset + 1 ! IF (ANY(map_it2(1:npgfa(iset), 1:npgfa(jset)))) THEN hab(:, :) = 0._dp @@ -1054,13 +1054,13 @@ SUBROUTINE integrate_v_rspace_diagonal(v_rspace, ksmat, pmat, qs_env, calculate_ END IF DO ipgf = 1, npgfa(iset) - na1 = (ipgf-1)*ncoset(la_max(iset)) + na1 = (ipgf - 1)*ncoset(la_max(iset)) na2 = ipgf*ncoset(la_max(iset)) DO jpgf = 1, npgfa(jset) - nb1 = (jpgf-1)*ncoset(la_max(jset)) + nb1 = (jpgf - 1)*ncoset(la_max(jset)) nb2 = jpgf*ncoset(la_max(jset)) - zetp = zeta(ipgf, iset)+zeta(jpgf, jset) + zetp = zeta(ipgf, iset) + zeta(jpgf, jset) igrid_level = gaussian_gridlevel(gridlevel_info, zetp) rs_grid => rs_v(igrid_level)%rs_grid IF (map_it2(ipgf, jpgf)) THEN @@ -1106,13 +1106,13 @@ SUBROUTINE integrate_v_rspace_diagonal(v_rspace, ksmat, pmat, qs_env, calculate_ CALL mp_sum(hmat, para_env%group) CALL dbcsr_get_block_p(matrix=ksmat, row=atom_a, col=atom_a, BLOCK=h_block, found=found) IF (found) THEN - h_block(1:nsgfa, 1:nsgfa) = h_block(1:nsgfa, 1:nsgfa)+hmat(1:nsgfa, 1:nsgfa) + h_block(1:nsgfa, 1:nsgfa) = h_block(1:nsgfa, 1:nsgfa) + hmat(1:nsgfa, 1:nsgfa) END IF IF (calculate_forces) THEN - force(ikind)%rho_elec(:, iatom) = force(ikind)%rho_elec(:, iatom)+2.0_dp*force_a(:) + force(ikind)%rho_elec(:, iatom) = force(ikind)%rho_elec(:, iatom) + 2.0_dp*force_a(:) IF (use_virial) THEN IF (use_virial .AND. calculate_forces) THEN - virial%pv_virial = virial%pv_virial+2.0_dp*my_virial_a + virial%pv_virial = virial%pv_virial + 2.0_dp*my_virial_a END IF END IF ENDIF diff --git a/src/qs_interactions.F b/src/qs_interactions.F index e36918fcba..911475950a 100644 --- a/src/qs_interactions.F +++ b/src/qs_interactions.F @@ -185,7 +185,7 @@ SUBROUTINE init_interaction_radii(qs_control, atomic_kind_set, qs_kind_set) ppl_radius = exp_radius(0, alpha_ppl, qs_control%eps_ppl, cerf_ppl) DO iexp_ppl = 1, nexp_ppl - lppl = 2*(iexp_ppl-1) + lppl = 2*(iexp_ppl - 1) ppl_radius = MAX(ppl_radius, & exp_radius(lppl, alpha_ppl, & qs_control%eps_ppl, & @@ -200,7 +200,7 @@ SUBROUTINE init_interaction_radii(qs_control, atomic_kind_set, qs_kind_set) cval_lpot=cval_lpot) DO j = 1, nexp_lpot DO i = 1, nct_lpot(j) - lppl = 2*(i-1) + lppl = 2*(i - 1) ppl_radius = MAX(ppl_radius, & exp_radius(lppl, alpha_lpot(j), qs_control%eps_ppl, cval_lpot(i, j))) END DO @@ -215,7 +215,7 @@ SUBROUTINE init_interaction_radii(qs_control, atomic_kind_set, qs_kind_set) cval_lsd=cval_lsd) DO j = 1, nexp_lsd DO i = 1, nct_lsd(j) - lppl = 2*(i-1) + lppl = 2*(i - 1) ppl_radius = MAX(ppl_radius, & exp_radius(lppl, alpha_lsd(j), qs_control%eps_ppl, cval_lsd(i, j))) END DO @@ -227,7 +227,7 @@ SUBROUTINE init_interaction_radii(qs_control, atomic_kind_set, qs_kind_set) ppnl_radius = 0.0_dp DO l = 0, lppnl DO iprj_ppnl = 1, nprj_ppnl(l) - lprj_ppnl = l+2*(iprj_ppnl-1) + lprj_ppnl = l + 2*(iprj_ppnl - 1) ppnl_radius = MAX(ppnl_radius, & exp_radius(lprj_ppnl, alpha_ppnl(l), & qs_control%eps_pgf_orb, & @@ -254,7 +254,7 @@ SUBROUTINE init_interaction_radii(qs_control, atomic_kind_set, qs_kind_set) IF (ecp_local) THEN CALL get_potential(potential=sgp_potential, nloc=nloc, nrloc=nrloc, aloc=aloc, bloc=bloc) DO i = 1, nloc - lppl = MAX(0, nrloc(i)-2) + lppl = MAX(0, nrloc(i) - 2) ppl_radius = MAX(ppl_radius, & exp_radius(lppl, bloc(i), qs_control%eps_ppl, aloc(i))) END DO diff --git a/src/qs_kind_types.F b/src/qs_kind_types.F index ab60df6b40..16a845a3d5 100644 --- a/src/qs_kind_types.F +++ b/src/qs_kind_types.F @@ -521,7 +521,7 @@ SUBROUTINE get_qs_kind(qs_kind, & CALL get_gto_basis_set(gto_basis_set=tmp_basis_set, ncgf=ncgf) ELSE IF (ASSOCIATED(qs_kind%dftb_parameter)) THEN l = qs_kind%dftb_parameter%lmax - ncgf = ((l+1)*(l+2)*(l+3))/6 + ncgf = ((l + 1)*(l + 2)*(l + 3))/6 ELSE ncgf = 0 END IF @@ -892,11 +892,11 @@ SUBROUTINE get_qs_kind_set(qs_kind_set, & IF (PRESENT(maxlppl) .AND. ASSOCIATED(gth_potential)) THEN CALL get_potential(potential=gth_potential, nexp_ppl=n) - maxlppl = MAX(maxlppl, 2*(n-1)) + maxlppl = MAX(maxlppl, 2*(n - 1)) ELSEIF (PRESENT(maxlppl) .AND. ASSOCIATED(sgp_potential)) THEN CALL get_potential(potential=sgp_potential, nrloc=nrloc) - n = MAXVAL(nrloc)-2 - maxlppl = MAX(maxlppl, 2*(n-1)) + n = MAXVAL(nrloc) - 2 + maxlppl = MAX(maxlppl, 2*(n - 1)) END IF IF (PRESENT(maxlppnl) .AND. ASSOCIATED(gth_potential)) THEN @@ -909,7 +909,7 @@ SUBROUTINE get_qs_kind_set(qs_kind_set, & IF (PRESENT(maxpol) .AND. ASSOCIATED(tnadd_potential)) THEN CALL get_potential(potential=tnadd_potential, npol=n) - maxpol = MAX(maxpol, 2*(n-1)) + maxpol = MAX(maxpol, 2*(n - 1)) END IF IF (PRESENT(maxco_proj) .AND. ASSOCIATED(paw_proj_set)) THEN @@ -939,7 +939,7 @@ SUBROUTINE get_qs_kind_set(qs_kind_set, & maxcgf = MAX(maxcgf, imax) ELSE IF (ASSOCIATED(qs_kind%dftb_parameter)) THEN CALL get_dftb_atom_param(dftb_parameter=dftb_parameter, lmax=imax) - imax = ((imax+1)*(imax+2)*(imax+3))/6 + imax = ((imax + 1)*(imax + 2)*(imax + 3))/6 maxcgf = MAX(maxcgf, imax) END IF END IF @@ -1005,45 +1005,45 @@ SUBROUTINE get_qs_kind_set(qs_kind_set, & IF (PRESENT(ncgf)) THEN IF (ASSOCIATED(tmp_basis_set)) THEN CALL get_gto_basis_set(gto_basis_set=tmp_basis_set, ncgf=n) - ncgf = ncgf+n*qs_kind_set(ikind)%natom + ncgf = ncgf + n*qs_kind_set(ikind)%natom ELSE IF (ASSOCIATED(qs_kind%dftb_parameter)) THEN CALL get_dftb_atom_param(dftb_parameter=dftb_parameter, lmax=imax) - n = ((imax+1)*(imax+2)*(imax+3))/6 - ncgf = ncgf+n*qs_kind_set(ikind)%natom + n = ((imax + 1)*(imax + 2)*(imax + 3))/6 + ncgf = ncgf + n*qs_kind_set(ikind)%natom END IF END IF IF (PRESENT(npgf)) THEN IF (ASSOCIATED(tmp_basis_set)) THEN CALL get_gto_basis_set(gto_basis_set=tmp_basis_set, npgf_sum=n) - npgf = npgf+n*qs_kind_set(ikind)%natom + npgf = npgf + n*qs_kind_set(ikind)%natom END IF END IF IF (PRESENT(nset)) THEN IF (ASSOCIATED(tmp_basis_set)) THEN CALL get_gto_basis_set(gto_basis_set=tmp_basis_set, nset=n) - nset = nset+n*qs_kind_set(ikind)%natom + nset = nset + n*qs_kind_set(ikind)%natom END IF END IF IF (PRESENT(nsgf)) THEN IF (ASSOCIATED(tmp_basis_set)) THEN CALL get_gto_basis_set(gto_basis_set=tmp_basis_set, nsgf=n) - nsgf = nsgf+n*qs_kind_set(ikind)%natom + nsgf = nsgf + n*qs_kind_set(ikind)%natom ELSE IF (ASSOCIATED(qs_kind%dftb_parameter)) THEN CALL get_dftb_atom_param(dftb_parameter=dftb_parameter, natorb=n) - nsgf = nsgf+n*qs_kind_set(ikind)%natom + nsgf = nsgf + n*qs_kind_set(ikind)%natom END IF END IF IF (PRESENT(nshell)) THEN IF (ASSOCIATED(tmp_basis_set)) THEN CALL get_gto_basis_set(gto_basis_set=tmp_basis_set, nshell_sum=n) - nshell = nshell+n*qs_kind_set(ikind)%natom + nshell = nshell + n*qs_kind_set(ikind)%natom ELSE IF (ASSOCIATED(qs_kind%dftb_parameter)) THEN CALL get_dftb_atom_param(dftb_parameter=dftb_parameter, lmax=n) - nshell = nshell+(n+1)*qs_kind_set(ikind)%natom + nshell = nshell + (n + 1)*qs_kind_set(ikind)%natom END IF END IF @@ -1061,7 +1061,7 @@ SUBROUTINE get_qs_kind_set(qs_kind_set, & zeff = 0.0_dp zeff_correction = 0.0_dp END IF - nelectron = nelectron+qs_kind_set(ikind)%natom*NINT(zeff-zeff_correction) + nelectron = nelectron + qs_kind_set(ikind)%natom*NINT(zeff - zeff_correction) END IF IF (PRESENT(basis_rcut)) THEN @@ -1328,10 +1328,10 @@ SUBROUTINE init_gapw_nlcc(qs_kind_set) DO ic = 1, nc cval = cval_nlcc(ic, i) coa = cval/alpha - den(:, 1) = den(:, 1)+fe(:)*rc**(2*ic-2)*cval - den(:, 2) = den(:, 2)-fe(:)*rc**(2*ic-1)*coa + den(:, 1) = den(:, 1) + fe(:)*rc**(2*ic - 2)*cval + den(:, 2) = den(:, 2) - fe(:)*rc**(2*ic - 1)*coa IF (ic > 1) THEN - den(:, 2) = den(:, 2)+REAL(2*ic-2, dp)*fe(:)*rc**(2*ic-3)*coa + den(:, 2) = den(:, 2) + REAL(2*ic - 2, dp)*fe(:)*rc**(2*ic - 3)*coa END IF END DO END DO @@ -1350,8 +1350,8 @@ SUBROUTINE init_gapw_nlcc(qs_kind_set) alpha = a_nlcc(i) fe(:) = EXP(-alpha*rr(:)*rr(:)) cval = c_nlcc(i) - den(:, 1) = den(:, 1)+cval*fe(:) - den(:, 2) = den(:, 2)-2.0_dp*alpha*cval*rr(:)*fe(:) + den(:, 1) = den(:, 1) + cval*fe(:) + den(:, 2) = den(:, 2) - 2.0_dp*alpha*cval*rr(:)*fe(:) END DO DEALLOCATE (rc, fe) END IF @@ -1467,7 +1467,7 @@ SUBROUTINE read_qs_kind(qs_kind, kind_section, para_env, force_env_section, & IF (((ipos == 2) .OR. (ipos == 3)) .AND. (INDEX(qs_kind%name, "_ghost") == 0)) THEN ! If the atm_name could not match any KIND section it maybe be a QM/MM link atom. ! ghost atoms will be treated differently. - akind_name = qs_kind%name(1:ipos-1) + akind_name = qs_kind%name(1:ipos - 1) CALL uppercase(akind_name) DO i_rep = 1, n_rep CALL section_vals_val_get(kind_section, "_SECTION_PARAMETERS_", & @@ -1587,7 +1587,7 @@ SUBROUTINE read_qs_kind(qs_kind, kind_section, para_env, force_env_section, & CALL section_vals_val_get(kind_section, i_rep_section=k_rep, & keyword_name="RI_AUX_BASIS_SET", c_val=ri_aux_basis_set_name) IF (ri_aux_basis_set_name /= "") THEN - nb_rep = nb_rep+1 + nb_rep = nb_rep + 1 CPASSERT(nb_rep <= maxbas) basis_set_type(nb_rep) = "RI_AUX" basis_set_form(nb_rep) = "GTO" @@ -1652,7 +1652,7 @@ SUBROUTINE read_qs_kind(qs_kind, kind_section, para_env, force_env_section, & IF (potential_type == "") THEN ipos = INDEX(potential_name, "-") IF (ipos > 1) THEN - potential_type = potential_name(:ipos-1) + potential_type = potential_name(:ipos - 1) ELSE potential_type = potential_name END IF @@ -1866,7 +1866,7 @@ SUBROUTINE read_qs_kind(qs_kind, kind_section, para_env, force_env_section, & keyword_name="ORBITALS", & i_vals=orbitals) norbitals = SIZE(orbitals) - IF (norbitals <= 0 .OR. norbitals > 2*l+1) & + IF (norbitals <= 0 .OR. norbitals > 2*l + 1) & CALL cp_abort(__LOCATION__, "DFT+U| Invalid number of ORBITALS specified: "// & "1 to 2*L+1 integer numbers are expected") ALLOCATE (qs_kind%dft_plus_u%orbitals(norbitals)) @@ -1971,7 +1971,7 @@ SUBROUTINE read_qs_kind(qs_kind, kind_section, para_env, force_env_section, & CALL add_basis_set_to_container(qs_kind%basis_sets, tmp_basis_set, "ORB") CALL init_potential(qs_kind%all_potential, itype="BARE", & zeff=qs_kind%se_parameter%zeff, zeff_correction=zeff_correction) - qs_kind%se_parameter%zeff = qs_kind%se_parameter%zeff-zeff_correction + qs_kind%se_parameter%zeff = qs_kind%se_parameter%zeff - zeff_correction check = ((potential_name /= '') .OR. explicit_potential) IF (check) & @@ -2055,7 +2055,7 @@ SUBROUTINE read_qs_kind(qs_kind, kind_section, para_env, force_env_section, & ! PW DFT ! Allocate and initialise the potential data set structure IF (potential_name /= '') THEN - SELECT CASE (TRIM (potential_type)) + SELECT CASE (TRIM(potential_type)) CASE ("ALL", "ECP") CALL cp_abort(__LOCATION__, & "PW DFT calculations only with potential type UPF or GTH possible."// & @@ -2104,7 +2104,7 @@ SUBROUTINE read_qs_kind(qs_kind, kind_section, para_env, force_env_section, & ! Allocate and initialise the basis set data set structure ! first external basis sets DO i = 1, nb_rep - SELECT CASE (basis_set_form (i)) + SELECT CASE (basis_set_form(i)) CASE ("GTO") NULLIFY (tmp_basis_set) CALL allocate_gto_basis_set(tmp_basis_set) @@ -2147,8 +2147,8 @@ SUBROUTINE read_qs_kind(qs_kind, kind_section, para_env, force_env_section, & inumbas=i, basis_type=basis_type) IF (basis_type == "") CYCLE jj = i - DO j = i+1, SIZE(qs_kind%basis_sets) - jj = jj+1 + DO j = i + 1, SIZE(qs_kind%basis_sets) + jj = jj + 1 NULLIFY (sup_basis_set) CALL get_basis_from_container(qs_kind%basis_sets, basis_set=sup_basis_set, & inumbas=jj, basis_type=tmp) @@ -2156,7 +2156,7 @@ SUBROUTINE read_qs_kind(qs_kind, kind_section, para_env, force_env_section, & ! we found a match, combine the basis sets and delete the second CALL combine_basis_sets(tmp_basis_set, sup_basis_set) CALL remove_basis_from_container(qs_kind%basis_sets, jj) - jj = jj-1 + jj = jj - 1 END IF END DO NULLIFY (sup_basis_set) @@ -2190,7 +2190,7 @@ SUBROUTINE read_qs_kind(qs_kind, kind_section, para_env, force_env_section, & potential_file_name = potential_fn_kind END IF ! - SELECT CASE (TRIM (potential_type)) + SELECT CASE (TRIM(potential_type)) CASE ("ALL") CALL allocate_potential(qs_kind%all_potential) CALL read_potential(qs_kind%element_symbol, potential_name, & @@ -2243,7 +2243,7 @@ SUBROUTINE read_qs_kind(qs_kind, kind_section, para_env, force_env_section, & nnl = sgppot%n_nonlocal nppnl = 0 DO l = 0, sgppot%lmax - nppnl = nppnl+nnl*nco(l) + nppnl = nppnl + nnl*nco(l) END DO l = sgppot%lmax ALLOCATE (a_nl(nnl), h_nl(nnl, 0:l), c_nl(nnl, nnl, 0:l)) @@ -2300,7 +2300,7 @@ SUBROUTINE read_qs_kind(qs_kind, kind_section, para_env, force_env_section, & nnl = sgppot%n_nonlocal nppnl = 0 DO l = 0, sgppot%lmax - nppnl = nppnl+nnl*nco(l) + nppnl = nppnl + nnl*nco(l) END DO l = sgppot%lmax ALLOCATE (a_nl(nnl), h_nl(nnl, 0:l), c_nl(nnl, nnl, 0:l)) @@ -2360,13 +2360,13 @@ SUBROUTINE read_qs_kind(qs_kind, kind_section, para_env, force_env_section, & IF ((kgpot_name /= '') .OR. explicit_kgpot) THEN ipos = INDEX(kgpot_name, "-") IF (ipos > 1) THEN - kgpot_type = kgpot_name(:ipos-1) + kgpot_type = kgpot_name(:ipos - 1) ELSE kgpot_type = kgpot_name END IF CALL uppercase(kgpot_type) - SELECT CASE (TRIM (kgpot_type)) + SELECT CASE (TRIM(kgpot_type)) CASE ("TNADD") ! determine the pseudopotential file to search IF (kg_potential_fn_kind == "-") THEN @@ -2434,10 +2434,10 @@ FUNCTION parse_valence_electrons(string) RESULT(n) INTEGER :: i, istat, j - DO i = 1, LEN_TRIM(string)-2 - IF (string(i:i+1) .NE. "-Q") CYCLE - j = SCAN(string(i+2:), "- ") - READ (string(i+2:i+j), '(I3)', iostat=istat) n + DO i = 1, LEN_TRIM(string) - 2 + IF (string(i:i + 1) .NE. "-Q") CYCLE + j = SCAN(string(i + 2:), "- ") + READ (string(i + 2:i + j), '(I3)', iostat=istat) n IF (istat == 0) RETURN ENDDO n = -1 ! valence electron number not found @@ -2681,7 +2681,7 @@ SUBROUTINE set_qs_kind(qs_kind, paw_atom, ghost, floating, hard_radius, hard0_ra IF (ASSOCIATED(qs_kind%elec_conf)) THEN DEALLOCATE (qs_kind%elec_conf) ENDIF - ALLOCATE (qs_kind%elec_conf(0:SIZE(elec_conf)-1)) + ALLOCATE (qs_kind%elec_conf(0:SIZE(elec_conf) - 1)) qs_kind%elec_conf(:) = elec_conf(:) ENDIF IF (PRESENT(paw_atom)) qs_kind%paw_atom = paw_atom @@ -3026,21 +3026,21 @@ SUBROUTINE init_atom_electronic_state(atomic_kind, qs_kind, ncalc, ncore, nelem, CALL set_pseudo_state(econf, z, ncalc, ncore, nelem) ELSE DO l = 0, MIN(lmat, UBOUND(ptable(z)%e_conv, 1)) - ll = 2*(2*l+1) + ll = 2*(2*l + 1) nn = ptable(z)%e_conv(l) ii = 0 DO - ii = ii+1 + ii = ii + 1 IF (nn <= ll) THEN nelem(l, ii) = nn EXIT ELSE nelem(l, ii) = ll - nn = nn-ll + nn = nn - ll END IF END DO END DO - ncalc = nelem-ncore + ncalc = nelem - ncore END IF ! readjust the occupation number of the orbitals as requested by user @@ -3051,28 +3051,28 @@ SUBROUTINE init_atom_electronic_state(atomic_kind, qs_kind, ncalc, ncore, nelem, DO i = 1, SIZE(addel, 1) ne = addel(i, is) l = laddel(i, is) - nn = naddel(i, is)-l + nn = naddel(i, is) - l IF (ne /= 0) THEN IF (nn == 0) THEN DO ii = SIZE(nelem, 2), 1, -1 IF (ncalc(l, ii) > 0) THEN - IF ((ncalc(l, ii)+ne) < 2*(2*l+1)+1) THEN - edelta(l, ii, is) = edelta(l, ii, is)+ne + IF ((ncalc(l, ii) + ne) < 2*(2*l + 1) + 1) THEN + edelta(l, ii, is) = edelta(l, ii, is) + ne nn = ii ELSE - edelta(l, ii+1, is) = edelta(l, ii+1, is)+ne - nn = ii+1 + edelta(l, ii + 1, is) = edelta(l, ii + 1, is) + ne + nn = ii + 1 END IF EXIT ELSE IF (ii == 1) THEN - edelta(l, ii, is) = edelta(l, ii, is)+ne + edelta(l, ii, is) = edelta(l, ii, is) + ne nn = ii END IF END DO ELSE - edelta(l, nn, is) = edelta(l, nn, is)+ne + edelta(l, nn, is) = edelta(l, nn, is) + ne END IF - IF (ncalc(l, nn)+edelta(l, nn, is) < 0) THEN + IF (ncalc(l, nn) + edelta(l, nn, is) < 0) THEN edelta(l, nn, is) = -ncalc(l, nn) END IF END IF @@ -3082,12 +3082,12 @@ SUBROUTINE init_atom_electronic_state(atomic_kind, qs_kind, ncalc, ncore, nelem, ELSE IF (magnetization /= 0.0_dp) THEN dmag = 0.5_dp*ABS(magnetization) DO l = 0, MIN(lmat, UBOUND(ptable(z)%e_conv, 1)) - ll = 2*(2*l+1) + ll = 2*(2*l + 1) ii = 0 DO i = 1, SIZE(ncalc, 2) IF (ncalc(l, i) == 0) CYCLE IF (ncalc(l, i) == ll) CYCLE - IF (ncalc(l, i) > dmag .AND. (ll-ncalc(l, i)) > dmag) THEN + IF (ncalc(l, i) > dmag .AND. (ll - ncalc(l, i)) > dmag) THEN ii = i EXIT END IF @@ -3133,67 +3133,67 @@ SUBROUTINE set_pseudo_state(econf, z, ncalc, ncore, nelem) INTEGER, DIMENSION(0:lmat) :: econfx econfx = 0 - econfx(0:SIZE(econf)-1) = econf + econfx(0:SIZE(econf) - 1) = econf IF (SUM(econf) >= 0) THEN DO l = 0, MIN(lmat, UBOUND(ptable(z)%e_conv, 1)) - ll = 2*(2*l+1) - nn = ptable(z)%e_conv(l)-econfx(l) + ll = 2*(2*l + 1) + nn = ptable(z)%e_conv(l) - econfx(l) IF (MOD(nn, ll) == 0) CYCLE IF (econfx(l) == 0) CYCLE IF (MOD(nn, 2) == 0) CYCLE - DO lx = 3, l+1, -1 + DO lx = 3, l + 1, -1 IF (econfx(lx) == 0) CYCLE - econfx(l) = econfx(l)+1 - econfx(lx) = econfx(lx)-1 + econfx(l) = econfx(l) + 1 + econfx(lx) = econfx(lx) - 1 EXIT END DO END DO DO l = 0, MIN(lmat, UBOUND(ptable(z)%e_conv, 1)) - ll = 2*(2*l+1) - nn = ptable(z)%e_conv(l)-econfx(l) + ll = 2*(2*l + 1) + nn = ptable(z)%e_conv(l) - econfx(l) ii = 0 DO - ii = ii+1 + ii = ii + 1 IF (nn <= ll) THEN ncore(l, ii) = nn EXIT ELSE ncore(l, ii) = ll - nn = nn-ll + nn = nn - ll END IF END DO END DO DO l = 0, MIN(lmat, UBOUND(ptable(z)%e_conv, 1)) - ll = 2*(2*l+1) + ll = 2*(2*l + 1) nn = ptable(z)%e_conv(l) ii = 0 DO - ii = ii+1 + ii = ii + 1 IF (nn <= ll) THEN nelem(l, ii) = nn EXIT ELSE nelem(l, ii) = ll - nn = nn-ll + nn = nn - ll END IF END DO END DO - ncalc = nelem-ncore + ncalc = nelem - ncore ELSE ncore = 0 ncalc = 0 DO l = 0, MIN(lmat, UBOUND(ptable(z)%e_conv, 1)) - ll = 2*(2*l+1) + ll = 2*(2*l + 1) nn = ABS(econfx(l)) ii = 0 DO - ii = ii+1 + ii = ii + 1 IF (nn <= ll) THEN ncalc(l, ii) = -nn EXIT ELSE ncalc(l, ii) = -ll - nn = nn-ll + nn = nn - ll END IF END DO END DO diff --git a/src/qs_kinetic.F b/src/qs_kinetic.F index e17cb30f7f..fbe55c0643 100644 --- a/src/qs_kinetic.F +++ b/src/qs_kinetic.F @@ -303,20 +303,20 @@ SUBROUTINE build_kinetic_matrix(ks_env, matrix_t, matrixkp_t, matrix_name, & END IF END IF - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) tab = SQRT(rab2) trans = do_symmetric .AND. (iatom > jatom) DO iset = 1, nseta - ncoa = npgfa(iset)*(ncoset(la_max(iset))-ncoset(la_min(iset)-1)) + ncoa = npgfa(iset)*(ncoset(la_max(iset)) - ncoset(la_min(iset) - 1)) sgfa = first_sgfa(1, iset) DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < tab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < tab) CYCLE - ncob = npgfb(jset)*(ncoset(lb_max(jset))-ncoset(lb_min(jset)-1)) + ncob = npgfb(jset)*(ncoset(lb_max(jset)) - ncoset(lb_min(jset) - 1)) sgfb = first_sgfb(1, jset) IF (do_forces .AND. ASSOCIATED(p_block) .AND. ((iatom /= jatom) .OR. use_virial)) THEN @@ -331,8 +331,8 @@ SUBROUTINE build_kinetic_matrix(ks_env, matrix_t, matrixkp_t, matrix_name, & rab, kab, dab) CALL force_trace(force_a, dab, pab, ncoa, ncob, 3) !$OMP CRITICAL(forceupate) - force(ikind)%kinetic(:, atom_a) = force(ikind)%kinetic(:, atom_a)+ff*force_a(:) - force(jkind)%kinetic(:, atom_b) = force(jkind)%kinetic(:, atom_b)-ff*force_a(:) + force(ikind)%kinetic(:, atom_a) = force(ikind)%kinetic(:, atom_a) + ff*force_a(:) + force(jkind)%kinetic(:, atom_b) = force(jkind)%kinetic(:, atom_b) - ff*force_a(:) IF (use_virial) THEN CALL virial_pair_force(virial%pv_virial, f0, force_a, rab) END IF @@ -361,7 +361,7 @@ SUBROUTINE build_kinetic_matrix(ks_env, matrix_t, matrixkp_t, matrix_name, & CALL neighbor_list_iterator_release(nl_iterator) IF (do_forces .AND. use_virial) THEN - virial%pv_ekin = virial%pv_virial-pv_loc + virial%pv_ekin = virial%pv_virial - pv_loc END IF IF (dokp) THEN diff --git a/src/qs_kpp1_env_methods.F b/src/qs_kpp1_env_methods.F index ca111a0caa..a441fbf320 100644 --- a/src/qs_kpp1_env_methods.F +++ b/src/qs_kpp1_env_methods.F @@ -118,7 +118,7 @@ SUBROUTINE kpp1_create(kpp1_env) kpp1_env%deriv_set, kpp1_env%spin_pot, kpp1_env%grad_pot, & kpp1_env%ndiag_term) kpp1_env%ref_count = 1 - last_kpp1_id_nr = last_kpp1_id_nr+1 + last_kpp1_id_nr = last_kpp1_id_nr + 1 kpp1_env%id_nr = last_kpp1_id_nr kpp1_env%iter = 0 kpp1_env%print_count = 0 @@ -219,7 +219,7 @@ SUBROUTINE kpp1_calc_k_p_p1(kpp1_env, p_env, qs_env, k_p_p1, rho, rho1, rho1_xc) CALL section_vals_val_get(input, "DFT%TDDFPT%RES_ETYPE", & i_val=res_etype) - kpp1_env%iter = kpp1_env%iter+1 + kpp1_env%iter = kpp1_env%iter + 1 ! gets the tmp grids CPASSERT(ASSOCIATED(pw_env)) @@ -528,7 +528,7 @@ SUBROUTINE kpp1_calc_k_p_p1_fdiff(qs_env, k_p_p1, rho, rho1, & CALL dbcsr_add(rho_ao(ispin)%matrix, rho1_ao(ispin)%matrix, & alpha_scalar=1.0_dp, beta_scalar=my_diff) rho_r(ispin)%pw%cr3d = rho_r(ispin)%pw%cr3d+my_diff*rho1_r(ispin)%pw%cr3d - rho_g(ispin)%pw%cc = rho_g(ispin)%pw%cc+my_diff*rho1_g(ispin)%pw%cc + rho_g(ispin)%pw%cc = rho_g(ispin)%pw%cc + my_diff*rho1_g(ispin)%pw%cc END DO CALL qs_ks_build_kohn_sham_matrix(qs_env, & @@ -549,7 +549,7 @@ SUBROUTINE kpp1_calc_k_p_p1_fdiff(qs_env, k_p_p1, rho, rho1, & CALL dbcsr_add(rho_ao(ispin)%matrix, rho1_ao(ispin)%matrix, & alpha_scalar=1.0_dp, beta_scalar=my_diff) rho_r(ispin)%pw%cr3d = rho_r(ispin)%pw%cr3d+my_diff*rho1_r(ispin)%pw%cr3d - rho_g(ispin)%pw%cc = rho_g(ispin)%pw%cc+my_diff*rho1_g(ispin)%pw%cc + rho_g(ispin)%pw%cc = rho_g(ispin)%pw%cc + my_diff*rho1_g(ispin)%pw%cc END DO CALL qs_ks_build_kohn_sham_matrix(qs_env, & @@ -563,7 +563,7 @@ SUBROUTINE kpp1_calc_k_p_p1_fdiff(qs_env, k_p_p1, rho, rho1, & CALL dbcsr_add(rho_ao(ispin)%matrix, rho1_ao(ispin)%matrix, & alpha_scalar=1.0_dp, beta_scalar=my_diff) rho_r(ispin)%pw%cr3d = rho_r(ispin)%pw%cr3d+my_diff*rho1_r(ispin)%pw%cr3d - rho_g(ispin)%pw%cc = rho_g(ispin)%pw%cc+my_diff*rho1_g(ispin)%pw%cc + rho_g(ispin)%pw%cc = rho_g(ispin)%pw%cc + my_diff*rho1_g(ispin)%pw%cc END DO ! k_p_p1=(H(rho0+h/2 rho1)-H(rho0-h/2 rho1))/h diff --git a/src/qs_kpp1_env_types.F b/src/qs_kpp1_env_types.F index 31e3e24e33..6a2533af5d 100644 --- a/src/qs_kpp1_env_types.F +++ b/src/qs_kpp1_env_types.F @@ -94,7 +94,7 @@ SUBROUTINE kpp1_release(kpp1_env) IF (ASSOCIATED(kpp1_env)) THEN CPASSERT(kpp1_env%ref_count > 0) - kpp1_env%ref_count = kpp1_env%ref_count-1 + kpp1_env%ref_count = kpp1_env%ref_count - 1 IF (kpp1_env%ref_count < 1) THEN IF (ASSOCIATED(kpp1_env%v_rspace)) THEN DO ispin = 1, SIZE(kpp1_env%v_rspace) @@ -150,7 +150,7 @@ SUBROUTINE kpp1_retain(kpp1_env) CPASSERT(ASSOCIATED(kpp1_env)) CPASSERT(kpp1_env%ref_count > 0) - kpp1_env%ref_count = kpp1_env%ref_count+1 + kpp1_env%ref_count = kpp1_env%ref_count + 1 END SUBROUTINE kpp1_retain END MODULE qs_kpp1_env_types diff --git a/src/qs_ks_atom.F b/src/qs_ks_atom.F index cb5718d4af..a0f0ae1f35 100644 --- a/src/qs_ks_atom.F +++ b/src/qs_ks_atom.F @@ -61,10 +61,10 @@ MODULE qs_ks_atom USE virial_types, ONLY: virial_type !$ USE OMP_LIB, ONLY: omp_get_max_threads, & -!$ omp_get_thread_num, & -!$ omp_lock_kind, & -!$ omp_init_lock, omp_set_lock, & -!$ omp_unset_lock, omp_destroy_lock +!$ omp_get_thread_num, & +!$ omp_lock_kind, & +!$ omp_init_lock, omp_set_lock, & +!$ omp_unset_lock, omp_destroy_lock #include "./base/base_uses.f90" @@ -227,7 +227,7 @@ SUBROUTINE update_ks_atom(qs_env, ksmat, pmat, forces, tddft, p_env) END DO END DO ! broadcast the CPC arrays to all processors (replicated data) - DO ip = 0, num_pe-1 + DO ip = 0, num_pe - 1 bo = get_limit(nat, num_pe, ip) DO iat = bo(1), bo(2) iatom = atom_list(iat) @@ -261,9 +261,9 @@ SUBROUTINE update_ks_atom(qs_env, ksmat, pmat, forces, tddft, p_env) CALL get_iterator_task(nl_iterator, task) ! build hash table in serial, so don't pass mepos ! tasks with the same key access the same blocks of H & P IF (task%iatom <= task%jatom) THEN - nl_table_key = natom*task%iatom+task%jatom + nl_table_key = natom*task%iatom + task%jatom ELSE - nl_table_key = natom*task%jatom+task%iatom + nl_table_key = natom*task%jatom + task%iatom ENDIF CALL nl_hash_table_add(nl_hash_table, nl_table_key, task) END DO @@ -383,8 +383,8 @@ SUBROUTINE update_ks_atom(qs_env, ksmat, pmat, forces, tddft, p_env) CALL get_gto_basis_set(gto_basis_set=orb_basis, nset=nsetc, maxso=maxsoc) - iac = ikind+nkind*(kkind-1) - ibc = jkind+nkind*(kkind-1) + iac = ikind + nkind*(kkind - 1) + ibc = jkind + nkind*(kkind - 1) IF (.NOT. ASSOCIATED(oce%intac(iac)%alist)) CYCLE IF (.NOT. ASSOCIATED(oce%intac(ibc)%alist)) CYCLE @@ -397,7 +397,7 @@ SUBROUTINE update_ks_atom(qs_env, ksmat, pmat, forces, tddft, p_env) DO kbc = 1, alist_bc%nclist IF (alist_ac%clist(kac)%catom /= alist_bc%clist(kbc)%catom) CYCLE - IF (ALL(cell_b+alist_bc%clist(kbc)%cell-alist_ac%clist(kac)%cell == 0)) THEN + IF (ALL(cell_b + alist_bc%clist(kbc)%cell - alist_ac%clist(kac)%cell == 0)) THEN n_cont_a = alist_ac%clist(kac)%nsgf_cnt n_cont_b = alist_bc%clist(kbc)%nsgf_cnt IF (n_cont_a .EQ. 0 .OR. n_cont_b .EQ. 0) CYCLE @@ -450,15 +450,15 @@ SUBROUTINE update_ks_atom(qs_env, ksmat, pmat, forces, tddft, p_env) rho_at, force_tmp, nspins, iatom, jatom, nsoctot, & list_a, n_cont_a, list_b, n_cont_b, dCPC_h, dCPC_s, ldCPC, & PC_h, PC_s, p_matrix) -!$ CALL omp_set_lock(locks((ka_kind-1)*nkind+kkind)) - force(kkind)%vhxc_atom(1:3, ka_kind) = force(kkind)%vhxc_atom(1:3, ka_kind)+force_tmp(1:3, 3) -!$ CALL omp_unset_lock(locks((ka_kind-1)*nkind+kkind)) -!$ CALL omp_set_lock(locks((ia_kind-1)*nkind+ikind)) - force(ikind)%vhxc_atom(1:3, ia_kind) = force(ikind)%vhxc_atom(1:3, ia_kind)+force_tmp(1:3, 1) -!$ CALL omp_unset_lock(locks((ia_kind-1)*nkind+ikind)) -!$ CALL omp_set_lock(locks((ja_kind-1)*nkind+jkind)) - force(jkind)%vhxc_atom(1:3, ja_kind) = force(jkind)%vhxc_atom(1:3, ja_kind)+force_tmp(1:3, 2) -!$ CALL omp_unset_lock(locks((ja_kind-1)*nkind+jkind)) +!$ CALL omp_set_lock(locks((ka_kind - 1)*nkind + kkind)) + force(kkind)%vhxc_atom(1:3, ka_kind) = force(kkind)%vhxc_atom(1:3, ka_kind) + force_tmp(1:3, 3) +!$ CALL omp_unset_lock(locks((ka_kind - 1)*nkind + kkind)) +!$ CALL omp_set_lock(locks((ia_kind - 1)*nkind + ikind)) + force(ikind)%vhxc_atom(1:3, ia_kind) = force(ikind)%vhxc_atom(1:3, ia_kind) + force_tmp(1:3, 1) +!$ CALL omp_unset_lock(locks((ia_kind - 1)*nkind + ikind)) +!$ CALL omp_set_lock(locks((ja_kind - 1)*nkind + jkind)) + force(jkind)%vhxc_atom(1:3, ja_kind) = force(jkind)%vhxc_atom(1:3, ja_kind) + force_tmp(1:3, 2) +!$ CALL omp_unset_lock(locks((ja_kind - 1)*nkind + jkind)) IF (use_virial) THEN CALL virial_pair_force(pv_virial_thread, 1._dp, force_tmp(1:3, 1), rac) CALL virial_pair_force(pv_virial_thread, 1._dp, force_tmp(1:3, 2), rbc) @@ -468,15 +468,15 @@ SUBROUTINE update_ks_atom(qs_env, ksmat, pmat, forces, tddft, p_env) rho_at, force_tmp, nspins, jatom, iatom, nsoctot, & list_b, n_cont_b, list_a, n_cont_a, dCPC_h, dCPC_s, ldCPC, & PC_h, PC_s, p_matrix) -!$ CALL omp_set_lock(locks((ka_kind-1)*nkind+kkind)) - force(kkind)%vhxc_atom(1:3, ka_kind) = force(kkind)%vhxc_atom(1:3, ka_kind)+force_tmp(1:3, 3) -!$ CALL omp_unset_lock(locks((ka_kind-1)*nkind+kkind)) -!$ CALL omp_set_lock(locks((ia_kind-1)*nkind+ikind)) - force(ikind)%vhxc_atom(1:3, ia_kind) = force(ikind)%vhxc_atom(1:3, ia_kind)+force_tmp(1:3, 2) -!$ CALL omp_unset_lock(locks((ia_kind-1)*nkind+ikind)) -!$ CALL omp_set_lock(locks((ja_kind-1)*nkind+jkind)) - force(jkind)%vhxc_atom(1:3, ja_kind) = force(jkind)%vhxc_atom(1:3, ja_kind)+force_tmp(1:3, 1) -!$ CALL omp_unset_lock(locks((ja_kind-1)*nkind+jkind)) +!$ CALL omp_set_lock(locks((ka_kind - 1)*nkind + kkind)) + force(kkind)%vhxc_atom(1:3, ka_kind) = force(kkind)%vhxc_atom(1:3, ka_kind) + force_tmp(1:3, 3) +!$ CALL omp_unset_lock(locks((ka_kind - 1)*nkind + kkind)) +!$ CALL omp_set_lock(locks((ia_kind - 1)*nkind + ikind)) + force(ikind)%vhxc_atom(1:3, ia_kind) = force(ikind)%vhxc_atom(1:3, ia_kind) + force_tmp(1:3, 2) +!$ CALL omp_unset_lock(locks((ia_kind - 1)*nkind + ikind)) +!$ CALL omp_set_lock(locks((ja_kind - 1)*nkind + jkind)) + force(jkind)%vhxc_atom(1:3, ja_kind) = force(jkind)%vhxc_atom(1:3, ja_kind) + force_tmp(1:3, 1) +!$ CALL omp_unset_lock(locks((ja_kind - 1)*nkind + jkind)) IF (use_virial) THEN CALL virial_pair_force(pv_virial_thread, 1._dp, force_tmp(1:3, 2), rac) CALL virial_pair_force(pv_virial_thread, 1._dp, force_tmp(1:3, 1), rbc) @@ -528,7 +528,7 @@ SUBROUTINE update_ks_atom(qs_env, ksmat, pmat, forces, tddft, p_env) !$OMP END PARALLEL IF (use_virial) THEN - virial%pv_virial(1:3, 1:3) = virial%pv_virial(1:3, 1:3)+pv_virial_thread(1:3, 1:3) + virial%pv_virial(1:3, 1:3) = virial%pv_virial(1:3, 1:3) + pv_virial_thread(1:3, 1:3) END IF CALL nl_hash_table_release(nl_hash_table) @@ -604,8 +604,8 @@ SUBROUTINE add_vhxca_to_ks(mat_h, C_hh_a, C_hh_b, C_ss_a, C_ss_b, & k = 0 DO i = 1, nsp DO j = 1, nsp - k = k+1 - coc(k) = int_hard(j, i)-int_soft(j, i) + k = k + 1 + coc(k) = int_hard(j, i) - int_soft(j, i) END DO END DO CALL DGEMM('N', 'T', nsp, ncontb, nsp, 1.0_dp, coc, nsp, C_hh_b(1, 1, 1), SIZE(C_hh_b, 1), & @@ -648,8 +648,8 @@ SUBROUTINE add_vhxca_to_ks(mat_h, C_hh_a, C_hh_b, C_ss_a, C_ss_b, & k = 0 DO i = 1, nsp DO j = 1, nsp - k = k+1 - coc(k) = int_hard(j, i)-int_soft(j, i) + k = k + 1 + coc(k) = int_hard(j, i) - int_soft(j, i) END DO END DO CALL DGEMM('N', 'T', nsp, nconta, nsp, 1.0_dp, coc, nsp, C_hh_a(1, 1, 1), SIZE(C_hh_a, 1), 0.0_dp, C_int_h(1), nsp) @@ -772,15 +772,15 @@ SUBROUTINE add_vhxca_forces(mat_p, C_hh_a, C_hh_b, C_ss_a, C_ss_b, & C_hh_a(1, 1, dir), SIZE(C_hh_a, 1), & 0.0_dp, dCPC_h(1, 1), SIZE(dCPC_h, 1)) trace = trace_r_AxB(dCPC_h, ldCPC, int_hard, nsp, nsp, nsp) - force(dir-1, 3) = force(dir-1, 3)+ieqj*trace - force(dir-1, 1) = force(dir-1, 1)-ieqj*trace + force(dir - 1, 3) = force(dir - 1, 3) + ieqj*trace + force(dir - 1, 1) = force(dir - 1, 1) - ieqj*trace CALL DGEMM('T', 'N', nsp, nsp, nconta, 1.0_dp, PC_s(1, 1, ispin), SIZE(PC_s, 1), & C_ss_a(1, 1, dir), SIZE(C_ss_a, 1), & 0.0_dp, dCPC_s(1, 1), SIZE(dCPC_s, 1)) trace = trace_r_AxB(dCPC_s, ldCPC, int_soft, nsp, nsp, nsp) - force(dir-1, 3) = force(dir-1, 3)-ieqj*trace - force(dir-1, 1) = force(dir-1, 1)+ieqj*trace + force(dir - 1, 3) = force(dir - 1, 3) - ieqj*trace + force(dir - 1, 1) = force(dir - 1, 1) + ieqj*trace END DO ! j-k contributions @@ -796,15 +796,15 @@ SUBROUTINE add_vhxca_forces(mat_p, C_hh_a, C_hh_b, C_ss_a, C_ss_b, & C_hh_b(1, 1, dir), SIZE(C_hh_b, 1), & 0.0_dp, dCPC_h(1, 1), SIZE(dCPC_h, 1)) trace = trace_r_AxB(dCPC_h, ldCPC, int_hard, nsp, nsp, nsp) - force(dir-1, 3) = force(dir-1, 3)+ieqj*trace - force(dir-1, 2) = force(dir-1, 2)-ieqj*trace + force(dir - 1, 3) = force(dir - 1, 3) + ieqj*trace + force(dir - 1, 2) = force(dir - 1, 2) - ieqj*trace CALL DGEMM('T', 'N', nsp, nsp, ncontb, 1.0_dp, PC_s(1, 1, ispin), SIZE(PC_s, 1), & C_ss_b(1, 1, dir), SIZE(C_ss_b, 1), & 0.0_dp, dCPC_s(1, 1), SIZE(dCPC_s, 1)) trace = trace_r_AxB(dCPC_s, ldCPC, int_soft, nsp, nsp, nsp) - force(dir-1, 3) = force(dir-1, 3)-ieqj*trace - force(dir-1, 2) = force(dir-1, 2)+ieqj*trace + force(dir - 1, 3) = force(dir - 1, 3) - ieqj*trace + force(dir - 1, 2) = force(dir - 1, 2) + ieqj*trace END DO END DO !ispin diff --git a/src/qs_ks_methods.F b/src/qs_ks_methods.F index 88d7ecc9d8..f056e8ff82 100644 --- a/src/qs_ks_methods.F +++ b/src/qs_ks_methods.F @@ -414,8 +414,8 @@ SUBROUTINE qs_ks_build_kohn_sham_matrix(qs_env, calculate_forces, just_energy, & IF (use_virial .AND. calculate_forces) THEN CALL sccs(qs_env, rho_tot_gspace%pw, v_hartree_gspace%pw, v_sccs_rspace%pw, & h_stress=h_stress) - virial%pv_virial = virial%pv_virial+h_stress/REAL(para_env%num_pe, dp) - virial%pv_hartree = virial%pv_hartree+h_stress/REAL(para_env%num_pe, dp) + virial%pv_virial = virial%pv_virial + h_stress/REAL(para_env%num_pe, dp) + virial%pv_hartree = virial%pv_hartree + h_stress/REAL(para_env%num_pe, dp) ELSE CALL sccs(qs_env, rho_tot_gspace%pw, v_hartree_gspace%pw, v_sccs_rspace%pw) END IF @@ -427,8 +427,8 @@ SUBROUTINE qs_ks_build_kohn_sham_matrix(qs_env, calculate_forces, just_energy, & CALL pw_poisson_solve(poisson_env, rho_tot_gspace%pw, energy%hartree, & v_hartree_gspace%pw, h_stress=h_stress, & rho_core=rho_core) - virial%pv_virial = virial%pv_virial+h_stress/REAL(para_env%num_pe, dp) - virial%pv_hartree = virial%pv_hartree+h_stress/REAL(para_env%num_pe, dp) + virial%pv_virial = virial%pv_virial + h_stress/REAL(para_env%num_pe, dp) + virial%pv_hartree = virial%pv_hartree + h_stress/REAL(para_env%num_pe, dp) ELSE CALL pw_poisson_solve(poisson_env, rho_tot_gspace%pw, energy%hartree, & v_hartree_gspace%pw, rho_core=rho_core) @@ -461,7 +461,7 @@ SUBROUTINE qs_ks_build_kohn_sham_matrix(qs_env, calculate_forces, just_energy, & IF (dft_control%correct_surf_dip) THEN CALL calc_dipsurf_potential(qs_env, energy) - energy%hartree = energy%hartree+energy%surf_dipole + energy%hartree = energy%hartree + energy%surf_dipole END IF ! SIC @@ -478,14 +478,14 @@ SUBROUTINE qs_ks_build_kohn_sham_matrix(qs_env, calculate_forces, just_energy, & ! Compute the energy due to the external potential ee_ener = 0.0_dp DO ispin = 1, nspins - ee_ener = ee_ener+pw_integral_ab(rho_r(ispin)%pw, vee%pw) + ee_ener = ee_ener + pw_integral_ab(rho_r(ispin)%pw, vee%pw) END DO IF (.NOT. just_energy) THEN IF (gapw) THEN CALL get_qs_env(qs_env=qs_env, & rho0_s_rs=rho0_s_rs) CPASSERT(ASSOCIATED(rho0_s_rs)) - ee_ener = ee_ener+pw_integral_ab(rho0_s_rs%pw, vee%pw) + ee_ener = ee_ener + pw_integral_ab(rho0_s_rs%pw, vee%pw) END IF END IF ! the sign accounts for the charge of the electrons @@ -561,7 +561,7 @@ SUBROUTINE qs_ks_build_kohn_sham_matrix(qs_env, calculate_forces, just_energy, & NULLIFY (rho_struct) IF (use_virial .AND. calculate_forces) THEN - virial%pv_virial = virial%pv_virial-virial%pv_xc + virial%pv_virial = virial%pv_virial - virial%pv_xc ! ** virial%pv_xc will be zeroed in the xc routines END IF xc_section => admm_env%xc_section_primary @@ -606,15 +606,15 @@ SUBROUTINE qs_ks_build_kohn_sham_matrix(qs_env, calculate_forces, just_energy, & NULLIFY (rho_struct) IF (use_virial .AND. calculate_forces) THEN - virial%pv_virial = virial%pv_virial-virial%pv_xc + virial%pv_virial = virial%pv_virial - virial%pv_xc virial%pv_exc = -virial%pv_xc DO idir = 1, 3 - virial%pv_exc(idir, idir) = virial%pv_exc(idir, idir)-energy%exc - virial%pv_hartree(idir, idir) = virial%pv_hartree(idir, idir)-2.0_dp*energy%hartree + virial%pv_exc(idir, idir) = virial%pv_exc(idir, idir) - energy%exc + virial%pv_hartree(idir, idir) = virial%pv_hartree(idir, idir) - 2.0_dp*energy%hartree END DO IF (dft_control%do_admm) THEN DO idir = 1, 3 - virial%pv_exc(idir, idir) = virial%pv_exc(idir, idir)-energy%exc_aux_fit + virial%pv_exc(idir, idir) = virial%pv_exc(idir, idir) - energy%exc_aux_fit END DO END IF ENDIF @@ -649,7 +649,7 @@ SUBROUTINE qs_ks_build_kohn_sham_matrix(qs_env, calculate_forces, just_energy, & CALL kg_ekin_subset(qs_env, ksmat, ekin_mol, calculate_forces) ! substract kg corr from the total energy - energy%exc = energy%exc-ekin_mol + energy%exc = energy%exc - ekin_mol END IF @@ -692,7 +692,7 @@ SUBROUTINE qs_ks_build_kohn_sham_matrix(qs_env, calculate_forces, just_energy, & cdft_control, calculate_forces) IF (use_virial .AND. calculate_forces) THEN - virial%pv_hartree = virial%pv_hartree+(virial%pv_virial-pv_loc) + virial%pv_hartree = virial%pv_hartree + (virial%pv_virial - pv_loc) END IF IF (dft_control%qs_control%do_kg) THEN CPASSERT(.NOT. (gapw .OR. gapw_xc)) @@ -700,10 +700,10 @@ SUBROUTINE qs_ks_build_kohn_sham_matrix(qs_env, calculate_forces, just_energy, & ksmat => ks_matrix(:, 1) CALL kg_ekin_subset(qs_env, ksmat, ekin_mol, calculate_forces) ! substract kg corr from the total energy - energy%exc = energy%exc-ekin_mol + energy%exc = energy%exc - ekin_mol ! virial corrections IF (use_virial .AND. calculate_forces) THEN - virial%pv_virial = virial%pv_virial+virial%pv_xc + virial%pv_virial = virial%pv_virial + virial%pv_xc virial%pv_xc = 0.0_dp END IF END IF @@ -834,11 +834,11 @@ SUBROUTINE qs_ks_build_kohn_sham_matrix(qs_env, calculate_forces, just_energy, & ! update core energy for grid based local pseudopotential ecore_ppl = 0._dp DO ispin = 1, nspins - ecore_ppl = ecore_ppl+ & + ecore_ppl = ecore_ppl + & SUM(vppl_rspace%pw%cr3d*rho_r(ispin)%pw%cr3d)*vppl_rspace%pw%pw_grid%dvol END DO CALL mp_sum(ecore_ppl, para_env%group) - energy%core = energy%core+ecore_ppl + energy%core = energy%core + ecore_ppl END IF IF (lrigpw) THEN @@ -850,21 +850,21 @@ SUBROUTINE qs_ks_build_kohn_sham_matrix(qs_env, calculate_forces, just_energy, & lri_v_int => lri_density%lri_coefs(ispin)%lri_kinds CALL v_int_ppl_energy(qs_env, lri_v_int, ecore_ppl) END DO - energy%core = energy%core+ecore_ppl + energy%core = energy%core + ecore_ppl END IF END IF ! Sum all energy terms to obtain the total energy - energy%total = energy%core_overlap+energy%core_self+energy%core+energy%hartree+ & - energy%hartree_1c+energy%exc+energy%exc1+energy%ex+ & - energy%dispersion+energy%gcp+energy%qmmm_el+energy%mulliken+ & - SUM(energy%ddapc_restraint)+energy%s2_restraint+ & - energy%dft_plus_u+energy%kTS+ & - energy%efield+energy%efield_core+energy%ee+ & - energy%ee_core+energy%exc_aux_fit+energy%image_charge+ & - energy%sccs_pol+energy%sccs_mpc+energy%cdft + energy%total = energy%core_overlap + energy%core_self + energy%core + energy%hartree + & + energy%hartree_1c + energy%exc + energy%exc1 + energy%ex + & + energy%dispersion + energy%gcp + energy%qmmm_el + energy%mulliken + & + SUM(energy%ddapc_restraint) + energy%s2_restraint + & + energy%dft_plus_u + energy%kTS + & + energy%efield + energy%efield_core + energy%ee + & + energy%ee_core + energy%exc_aux_fit + energy%image_charge + & + energy%sccs_pol + energy%sccs_mpc + energy%cdft - IF (dft_control%apply_embed_pot) energy%total = energy%total+energy%embed_corr + IF (dft_control%apply_embed_pot) energy%total = energy%total + energy%embed_corr IF (abnormal_value(energy%total)) & CPABORT("KS energy is an abnormal value (NaN/Inf).") @@ -1357,7 +1357,7 @@ SUBROUTINE calculate_w_matrix_ot(mo_set, mo_deriv, w_matrix, s_matrix) CALL cp_fm_column_scale(weighted_vectors, scaling_factor) DEALLOCATE (scaling_factor) - WRITE (*, *) " maxabs difference ", MAXVAL(ABS(weighted_vectors%local_data-2.0_dp*gradient%local_data)) + WRITE (*, *) " maxabs difference ", MAXVAL(ABS(weighted_vectors%local_data - 2.0_dp*gradient%local_data)) CALL cp_fm_release(gradient) ENDIF diff --git a/src/qs_ks_qmmm_methods.F b/src/qs_ks_qmmm_methods.F index 0cbaf1cdf2..51b2e5a89a 100644 --- a/src/qs_ks_qmmm_methods.F +++ b/src/qs_ks_qmmm_methods.F @@ -113,7 +113,7 @@ SUBROUTINE qs_ks_qmmm_create(ks_qmmm_env, qs_env, qmmm_env) ks_qmmm_env%pc_ener = 0.0_dp ks_qmmm_env%n_evals = 0 ks_qmmm_env%ref_count = 1 - last_ks_qmmm_nr = last_ks_qmmm_nr+1 + last_ks_qmmm_nr = last_ks_qmmm_nr + 1 ks_qmmm_env%id_nr = last_ks_qmmm_nr CALL pw_pool_create_pw(auxbas_pw_pool, ks_qmmm_env%v_qmmm_rspace%pw, & @@ -182,13 +182,13 @@ SUBROUTINE qmmm_calculate_energy(qs_env, rho, v_qmmm, qmmm_energy) qmmm_energy = 0.0_dp DO ispin = 1, dft_control%nspins - qmmm_energy = qmmm_energy+pw_integral_ab(rho(ispin)%pw, v_qmmm%pw) + qmmm_energy = qmmm_energy + pw_integral_ab(rho(ispin)%pw, v_qmmm%pw) END DO IF (dft_control%qs_control%gapw) THEN CALL get_qs_env(qs_env=qs_env, & rho0_s_rs=rho0_s_rs) CPASSERT(ASSOCIATED(rho0_s_rs)) - qmmm_energy = qmmm_energy+pw_integral_ab(rho0_s_rs%pw, v_qmmm%pw) + qmmm_energy = qmmm_energy + pw_integral_ab(rho0_s_rs%pw, v_qmmm%pw) END IF CALL cp_print_key_finished_output(output_unit, logger, input, & diff --git a/src/qs_ks_qmmm_types.F b/src/qs_ks_qmmm_types.F index 99399f17a9..407ccc6aa7 100644 --- a/src/qs_ks_qmmm_types.F +++ b/src/qs_ks_qmmm_types.F @@ -85,7 +85,7 @@ SUBROUTINE qs_ks_qmmm_release(ks_qmmm_env) IF (ASSOCIATED(ks_qmmm_env)) THEN CPASSERT(ks_qmmm_env%ref_count > 0) - ks_qmmm_env%ref_count = ks_qmmm_env%ref_count-1 + ks_qmmm_env%ref_count = ks_qmmm_env%ref_count - 1 IF (ks_qmmm_env%ref_count < 1) THEN CALL pw_env_get(ks_qmmm_env%pw_env, auxbas_pw_pool=pool) @@ -121,7 +121,7 @@ SUBROUTINE qs_ks_qmmm_retain(ks_qmmm_env) CPASSERT(ASSOCIATED(ks_qmmm_env)) CPASSERT(ks_qmmm_env%ref_count > 0) - ks_qmmm_env%ref_count = ks_qmmm_env%ref_count+1 + ks_qmmm_env%ref_count = ks_qmmm_env%ref_count + 1 END SUBROUTINE qs_ks_qmmm_retain END MODULE qs_ks_qmmm_types diff --git a/src/qs_ks_types.F b/src/qs_ks_types.F index 708cfcba9d..1061d73689 100644 --- a/src/qs_ks_types.F +++ b/src/qs_ks_types.F @@ -775,7 +775,7 @@ SUBROUTINE qs_ks_release(ks_env) IF (ASSOCIATED(ks_env)) THEN CPASSERT(ks_env%ref_count > 0) - ks_env%ref_count = ks_env%ref_count-1 + ks_env%ref_count = ks_env%ref_count - 1 IF (ks_env%ref_count < 1) THEN IF (ASSOCIATED(ks_env%v_hartree_rspace)) & @@ -917,7 +917,7 @@ SUBROUTINE qs_ks_retain(ks_env) CPASSERT(ASSOCIATED(ks_env)) CPASSERT(ks_env%ref_count > 0) - ks_env%ref_count = ks_env%ref_count+1 + ks_env%ref_count = ks_env%ref_count + 1 END SUBROUTINE qs_ks_retain ! ************************************************************************************************** diff --git a/src/qs_ks_utils.F b/src/qs_ks_utils.F index 11542cc50e..7f7fce35ea 100644 --- a/src/qs_ks_utils.F +++ b/src/qs_ks_utils.F @@ -228,7 +228,7 @@ SUBROUTINE low_spin_roks(energy, qs_env, dft_control, just_energy, & CPASSERT(n_rep == Nterms) CALL section_vals_val_get(low_spin_roks_section, "SPIN_CONFIGURATION", i_rep_val=1, i_vals=ivec) Nelectron = SIZE(ivec) - CPASSERT(Nelectron == k_alpha-k_beta) + CPASSERT(Nelectron == k_alpha - k_beta) ALLOCATE (occupations(2, Nelectron, Nterms)) occupations = 0 DO iterm = 1, Nterms @@ -299,7 +299,7 @@ SUBROUTINE low_spin_roks(energy, qs_env, dft_control, just_energy, & ! compute the proper density matrices with the required occupations CALL dbcsr_set(matrix_p(ispin)%matrix, 0.0_dp) scaling = 1.0_dp - scaling(k_alpha-Nelectron+1:k_alpha) = occupations(ispin, :, iterm) + scaling(k_alpha - Nelectron + 1:k_alpha) = occupations(ispin, :, iterm) CALL dbcsr_copy(fm_scaled, mo_coeff) CALL dbcsr_scale_by_vector(fm_scaled, scaling, side='right') CALL dbcsr_multiply('n', 't', 1.0_dp, mo_coeff, fm_scaled, & @@ -321,7 +321,7 @@ SUBROUTINE low_spin_roks(energy, qs_env, dft_control, just_energy, & pw_pool=xc_pw_pool, compute_virial=.FALSE., virial_xc=virial_xc_tmp) END IF - energy%exc = energy%exc+energy_scaling(iterm)*exc + energy%exc = energy%exc + energy_scaling(iterm)*exc ! add the corresponding derivatives to the MO derivatives IF (.NOT. just_energy) THEN @@ -344,7 +344,7 @@ SUBROUTINE low_spin_roks(energy, qs_env, dft_control, just_energy, & 0.0_dp, dbcsr_deriv, last_column=k_alpha) scaling = 1.0_dp - scaling(k_alpha-Nelectron+1:k_alpha) = occupations(ispin, :, iterm) + scaling(k_alpha - Nelectron + 1:k_alpha) = occupations(ispin, :, iterm) CALL dbcsr_scale_by_vector(dbcsr_deriv, scaling, side='right') CALL dbcsr_add(mo_derivs(1)%matrix, dbcsr_deriv, 1.0_dp, 1.0_dp) ENDDO @@ -483,18 +483,18 @@ SUBROUTINE sic_explicit_orbitals(energy, qs_env, dft_control, poisson_env, just_ CALL cp_fm_get_info(mo_coeff, ncol_global=k_beta) ENDIF - Norb = k_alpha+k_beta + Norb = k_alpha + k_beta ALLOCATE (sic_orbital_list(3, Norb)) iorb = 0 DO i = 1, k_alpha - iorb = iorb+1 + iorb = iorb + 1 sic_orbital_list(1, iorb) = 1 sic_orbital_list(2, iorb) = i sic_orbital_list(3, iorb) = 1 ENDDO DO i = 1, k_beta - iorb = iorb+1 + iorb = iorb + 1 sic_orbital_list(1, iorb) = 2 sic_orbital_list(2, iorb) = i IF (SIZE(mo_derivs, 1) == 1) THEN @@ -517,12 +517,12 @@ SUBROUTINE sic_explicit_orbitals(energy, qs_env, dft_control, poisson_env, just_ CALL get_mo_set(mo_set=mo_array(2)%mo_set, mo_coeff=mo_coeff) CALL cp_fm_get_info(mo_coeff, ncol_global=k_beta) - Norb = k_alpha-k_beta + Norb = k_alpha - k_beta ALLOCATE (sic_orbital_list(3, Norb)) iorb = 0 - DO i = k_beta+1, k_alpha - iorb = iorb+1 + DO i = k_beta + 1, k_alpha + iorb = iorb + 1 sic_orbital_list(1, iorb) = 1 sic_orbital_list(2, iorb) = i ! we are guaranteed to be restricted @@ -620,7 +620,7 @@ SUBROUTINE sic_explicit_orbitals(energy, qs_env, dft_control, poisson_env, just_ CALL pw_poisson_solve(poisson_env, orb_rho_g%pw, ener, work_v_gspace%pw) ! no PBC correction is done here, see "calc_v_sic_rspace" for SIC methods ! with PBC aware corrections - energy%hartree = energy%hartree-dft_control%sic_scaling_a*ener + energy%hartree = energy%hartree - dft_control%sic_scaling_a*ener IF (.NOT. just_energy) THEN CALL pw_transfer(work_v_gspace%pw, work_v_rspace%pw) CALL pw_scale(work_v_rspace%pw, -dft_control%sic_scaling_a*work_v_rspace%pw%pw_grid%dvol) @@ -639,7 +639,7 @@ SUBROUTINE sic_explicit_orbitals(energy, qs_env, dft_control, poisson_env, just_ work_v_rspace%pw%cr3d = work_v_rspace%pw%cr3d- & dft_control%sic_scaling_b*vxc(1)%pw%pw_grid%dvol*vxc(1)%pw%cr3d END IF - energy%exc = energy%exc-dft_control%sic_scaling_b*exc + energy%exc = energy%exc - dft_control%sic_scaling_b*exc IF (.NOT. just_energy) THEN ! note, orb_h (which is being pointed to with orb_h_p) is zeroed above @@ -755,7 +755,7 @@ SUBROUTINE calc_v_sic_rspace(v_sic_rspace, energy, & CALL get_qs_env(qs_env, mos=mo_array) CALL get_mo_set(mo_set=mo_array(1)%mo_set, nelectron=nelec_a) CALL get_mo_set(mo_set=mo_array(2)%mo_set, nelectron=nelec_b) - nelec = nelec_a+nelec_b + nelec = nelec_a + nelec_b CALL pw_copy(rho_g(1)%pw, work_rho%pw) CALL pw_axpy(rho_g(2)%pw, work_rho%pw) scaling = 1.0_dp/REAL(nelec, KIND=dp) @@ -771,14 +771,14 @@ SUBROUTINE calc_v_sic_rspace(v_sic_rspace, energy, & CALL get_qs_env(qs_env=qs_env, force=force) nforce = 0 DO i = 1, SIZE(force) - nforce = nforce+SIZE(force(i)%ch_pulay, 2) + nforce = nforce + SIZE(force(i)%ch_pulay, 2) ENDDO ALLOCATE (store_forces(3, nforce)) nforce = 0 DO i = 1, SIZE(force) - store_forces(1:3, nforce+1:nforce+SIZE(force(i)%ch_pulay, 2)) = force(i)%ch_pulay(:, :) + store_forces(1:3, nforce + 1:nforce + SIZE(force(i)%ch_pulay, 2)) = force(i)%ch_pulay(:, :) force(i)%ch_pulay(:, :) = 0.0_dp - nforce = nforce+SIZE(force(i)%ch_pulay, 2) + nforce = nforce + SIZE(force(i)%ch_pulay, 2) ENDDO ENDIF @@ -797,15 +797,15 @@ SUBROUTINE calc_v_sic_rspace(v_sic_rspace, energy, & CASE DEFAULT CPABORT("Unknown sic method id") END SELECT - energy%hartree = energy%hartree+full_scaling*ener + energy%hartree = energy%hartree + full_scaling*ener ! add scaled forces, restoring the old IF (calculate_forces) THEN nforce = 0 DO i = 1, SIZE(force) - force(i)%ch_pulay(:, :) = force(i)%ch_pulay(:, :)*full_scaling+ & - store_forces(1:3, nforce+1:nforce+SIZE(force(i)%ch_pulay, 2)) - nforce = nforce+SIZE(force(i)%ch_pulay, 2) + force(i)%ch_pulay(:, :) = force(i)%ch_pulay(:, :)*full_scaling + & + store_forces(1:3, nforce + 1:nforce + SIZE(force(i)%ch_pulay, 2)) + nforce = nforce + SIZE(force(i)%ch_pulay, 2) ENDDO ENDIF @@ -863,7 +863,7 @@ SUBROUTINE print_densities(qs_env, rho) extension=".scfLog") CALL qs_rho_get(rho, tot_rho_r=tot_rho_r_arr, rho_ao_kp=rho_ao) - n_electrons = n_electrons-dft_control%charge + n_electrons = n_electrons - dft_control%charge tot_rho_r = accurate_sum(tot_rho_r_arr) trace = 0 @@ -871,7 +871,7 @@ SUBROUTINE print_densities(qs_env, rho) DO ispin = 1, dft_control%nspins DO img = 1, dft_control%nimages CALL dbcsr_dot(rho_ao(ispin, img)%matrix, matrix_s(1, img)%matrix, trace_tmp) - trace = trace+trace_tmp + trace = trace + trace_tmp END DO END DO ENDIF @@ -881,18 +881,18 @@ SUBROUTINE print_densities(qs_env, rho) WRITE (UNIT=output_unit, FMT="((T3,A,T41,2F20.10))") & "Electronic density on regular grids: ", & tot_rho_r, & - tot_rho_r+ & + tot_rho_r + & REAL(n_electrons, dp), & "Core density on regular grids:", & qs_charges%total_rho_core_rspace, & - qs_charges%total_rho_core_rspace-REAL(n_electrons+dft_control%charge, dp) + qs_charges%total_rho_core_rspace - REAL(n_electrons + dft_control%charge, dp) END IF IF (dft_control%qs_control%gapw) THEN tot1_h = qs_charges%total_rho1_hard(1) tot1_s = qs_charges%total_rho1_soft(1) DO ispin = 2, dft_control%nspins - tot1_h = tot1_h+qs_charges%total_rho1_hard(ispin) - tot1_s = tot1_s+qs_charges%total_rho1_soft(ispin) + tot1_h = tot1_h + qs_charges%total_rho1_hard(ispin) + tot1_s = tot1_s + qs_charges%total_rho1_soft(ispin) END DO IF (output_unit > 0) THEN WRITE (UNIT=output_unit, FMT="((T3,A,T41,2F20.10))") & @@ -900,21 +900,21 @@ SUBROUTINE print_densities(qs_env, rho) tot1_h, tot1_s WRITE (UNIT=output_unit, FMT="(T3,A,T41,F20.10)") & "Total Rho_soft + Rho1_hard - Rho1_soft (r-space): ", & - tot_rho_r+tot1_h-tot1_s, & + tot_rho_r + tot1_h - tot1_s, & "Total charge density (r-space): ", & - tot_rho_r+tot1_h-tot1_s & - +qs_charges%total_rho_core_rspace, & + tot_rho_r + tot1_h - tot1_s & + + qs_charges%total_rho_core_rspace, & "Total Rho_soft + Rho0_soft (g-space):", & qs_charges%total_rho_gspace END IF - qs_charges%background = tot_rho_r+tot1_h-tot1_s+ & + qs_charges%background = tot_rho_r + tot1_h - tot1_s + & qs_charges%total_rho_core_rspace ELSE IF (dft_control%qs_control%gapw_xc) THEN tot1_h = qs_charges%total_rho1_hard(1) tot1_s = qs_charges%total_rho1_soft(1) DO ispin = 2, dft_control%nspins - tot1_h = tot1_h+qs_charges%total_rho1_hard(ispin) - tot1_s = tot1_s+qs_charges%total_rho1_soft(ispin) + tot1_h = tot1_h + qs_charges%total_rho1_hard(ispin) + tot1_s = tot1_s + qs_charges%total_rho1_soft(ispin) END DO IF (output_unit > 0) THEN WRITE (UNIT=output_unit, FMT="(/,(T3,A,T41,2F20.10))") & @@ -922,20 +922,20 @@ SUBROUTINE print_densities(qs_env, rho) tot1_h, tot1_s WRITE (UNIT=output_unit, FMT="(T3,A,T41,F20.10)") & "Total Rho_soft + Rho1_hard - Rho1_soft (r-space): ", & - accurate_sum(tot_rho_r_arr)+tot1_h-tot1_s + accurate_sum(tot_rho_r_arr) + tot1_h - tot1_s END IF - qs_charges%background = tot_rho_r+ & + qs_charges%background = tot_rho_r + & qs_charges%total_rho_core_rspace ELSE IF (output_unit > 0) THEN WRITE (UNIT=output_unit, FMT="(T3,A,T41,F20.10)") & "Total charge density on r-space grids: ", & - tot_rho_r+ & + tot_rho_r + & qs_charges%total_rho_core_rspace, & "Total charge density g-space grids: ", & qs_charges%total_rho_gspace END IF - qs_charges%background = tot_rho_r+ & + qs_charges%background = tot_rho_r + & qs_charges%total_rho_core_rspace END IF IF (output_unit > 0) WRITE (UNIT=output_unit, FMT="()") @@ -998,18 +998,18 @@ SUBROUTINE print_detailed_energy(qs_env, dft_control, input, energy, mulliken_or "Core Hamiltonian energy: ", energy%core, & "Hartree energy: ", implicit_ps_ehartree, & "Electric enthalpy: ", energy%hartree, & - "Exchange-correlation energy: ", energy%exc+energy%exc_aux_fit + "Exchange-correlation energy: ", energy%exc + energy%exc_aux_fit CASE (PERIODIC_BC, NEUMANN_BC) WRITE (UNIT=output_unit, FMT="(/,(T3,A,T61,F20.10))") & "Core Hamiltonian energy: ", energy%core, & "Hartree energy: ", energy%hartree, & - "Exchange-correlation energy: ", energy%exc+energy%exc_aux_fit + "Exchange-correlation energy: ", energy%exc + energy%exc_aux_fit END SELECT ELSE WRITE (UNIT=output_unit, FMT="(/,(T3,A,T61,F20.10))") & "Core Hamiltonian energy: ", energy%core, & "Hartree energy: ", energy%hartree, & - "Exchange-correlation energy: ", energy%exc+energy%exc_aux_fit + "Exchange-correlation energy: ", energy%exc + energy%exc_aux_fit END IF ELSE !ZMP to print some variables at each step @@ -1319,7 +1319,7 @@ SUBROUTINE sum_up_and_integrate(qs_env, ks_matrix, rho, my_rho, & ! CDFT constraint contribution IF (dft_control%qs_control%cdft) THEN DO igroup = 1, SIZE(cdft_control%group) - SELECT CASE (cdft_control%group (igroup)%constraint_type) + SELECT CASE (cdft_control%group(igroup)%constraint_type) CASE (cdft_charge_constraint) sign = 1.0_dp CASE (cdft_magnetization_constraint) @@ -1801,9 +1801,9 @@ SUBROUTINE get_embed_potential_energy(qs_env, rho, v_rspace_embed, dft_control, ns1 = SIZE(qs_env%spin_embed_pot%pw%cr3d) IF (ns1 .NE. ns2) CPABORT("Subsystem grids must be identical") IF (ispin .EQ. 1) v_rspace_embed(ispin)%pw%cr3d(:, :, :) = & - v_rspace_embed(ispin)%pw%cr3d(:, :, :)+qs_env%spin_embed_pot%pw%cr3d + v_rspace_embed(ispin)%pw%cr3d(:, :, :) + qs_env%spin_embed_pot%pw%cr3d IF (ispin .EQ. 2) v_rspace_embed(ispin)%pw%cr3d(:, :, :) = & - v_rspace_embed(ispin)%pw%cr3d(:, :, :)-qs_env%spin_embed_pot%pw%cr3d + v_rspace_embed(ispin)%pw%cr3d(:, :, :) - qs_env%spin_embed_pot%pw%cr3d ENDIF ! Integrate the density*potential embed_corr_local = accurate_sum(v_rspace_embed(ispin)%pw%cr3d*rho_r(ispin)%pw%cr3d)* & @@ -1813,7 +1813,7 @@ SUBROUTINE get_embed_potential_energy(qs_env, rho, v_rspace_embed, dft_control, CALL mp_sum(embed_corr_local, v_rspace_embed(ispin)%pw%pw_grid%para%group) END IF - embed_corr = embed_corr+embed_corr_local + embed_corr = embed_corr + embed_corr_local ENDDO diff --git a/src/qs_linres_atom_current.F b/src/qs_linres_atom_current.F index ac9817b6b1..38850e2252 100644 --- a/src/qs_linres_atom_current.F +++ b/src/qs_linres_atom_current.F @@ -67,10 +67,10 @@ MODULE qs_linres_atom_current USE util, ONLY: get_limit !$ USE OMP_LIB, ONLY: omp_get_max_threads, & -!$ omp_get_thread_num, & -!$ omp_lock_kind, & -!$ omp_init_lock, omp_set_lock, & -!$ omp_unset_lock, omp_destroy_lock +!$ omp_get_thread_num, & +!$ omp_lock_kind, & +!$ omp_init_lock, omp_set_lock, & +!$ omp_unset_lock, omp_destroy_lock #include "./base/base_uses.f90" @@ -325,19 +325,19 @@ SUBROUTINE calculate_jrho_atom_coeff(qs_env, current_env, mat_d0, mat_jp, mat_jp CALL dbcsr_get_block_p(matrix=mat_a(ispin)%matrix, & row=iatom, col=jatom, block=a_block(ispin)%r_coef, & found=den_found) - jmax = jmax+MAXVAL(ABS(a_block(ispin)%r_coef)) + jmax = jmax + MAXVAL(ABS(a_block(ispin)%r_coef)) CALL dbcsr_get_block_p(matrix=mat_b(ispin)%matrix, & row=iatom, col=jatom, block=b_block(ispin)%r_coef, & found=den_found) - jmax = jmax+MAXVAL(ABS(b_block(ispin)%r_coef)) + jmax = jmax + MAXVAL(ABS(b_block(ispin)%r_coef)) CALL dbcsr_get_block_p(matrix=mat_c(ispin)%matrix, & row=iatom, col=jatom, block=c_block(ispin)%r_coef, & found=den_found) - jmax = jmax+MAXVAL(ABS(c_block(ispin)%r_coef)) + jmax = jmax + MAXVAL(ABS(c_block(ispin)%r_coef)) CALL dbcsr_get_block_p(matrix=mat_d(ispin)%matrix, & row=iatom, col=jatom, block=d_block(ispin)%r_coef, & found=den_found) - jmax = jmax+MAXVAL(ABS(d_block(ispin)%r_coef)) + jmax = jmax + MAXVAL(ABS(d_block(ispin)%r_coef)) ENDDO ! Loop over atoms @@ -355,8 +355,8 @@ SUBROUTINE calculate_jrho_atom_coeff(qs_env, current_env, mat_d0, mat_jp, mat_jp CALL get_paw_proj_set(paw_proj_set=paw_proj, nsatbas=nsatbas) nsoctot = nsatbas - iac = ikind+nkind*(kkind-1) - ibc = jkind+nkind*(kkind-1) + iac = ikind + nkind*(kkind - 1) + ibc = jkind + nkind*(kkind - 1) IF (.NOT. ASSOCIATED(oce%intac(iac)%alist)) CYCLE IF (.NOT. ASSOCIATED(oce%intac(ibc)%alist)) CYCLE @@ -369,7 +369,7 @@ SUBROUTINE calculate_jrho_atom_coeff(qs_env, current_env, mat_d0, mat_jp, mat_jp DO kbc = 1, alist_bc%nclist IF (alist_ac%clist(kac)%catom /= alist_bc%clist(kbc)%catom) CYCLE - IF (ALL(cell_b+alist_bc%clist(kbc)%cell-alist_ac%clist(kac)%cell == 0)) THEN + IF (ALL(cell_b + alist_bc%clist(kbc)%cell - alist_ac%clist(kac)%cell == 0)) THEN IF (jmax*alist_bc%clist(kbc)%maxac*alist_ac%clist(kac)%maxac < eps_cpc) CYCLE n_cont_a = alist_ac%clist(kac)%nsgf_cnt @@ -450,7 +450,7 @@ SUBROUTINE calculate_jrho_atom_coeff(qs_env, current_env, mat_d0, mat_jp, mat_jp d_matrix, SIZE(d_matrix, 1), & list_a, n_cont_a, list_b, n_cont_b) -!$ CALL omp_set_lock(proj_blk_lock((katom-1)*nspins+ispin)) +!$ CALL omp_set_lock(proj_blk_lock((katom - 1)*nspins + ispin)) !------------------------------------------------------------------ ! P_\alpha\alpha' r_coef_h => jrho1_atom_set(katom)%cjc0_h(ispin)%r_coef @@ -484,7 +484,7 @@ SUBROUTINE calculate_jrho_atom_coeff(qs_env, current_env, mat_d0, mat_jp, mat_jp d_matrix, max_nsgf, r_coef_h, r_coef_s, nso, & len_PC1, len_CPC, 1.0_dp, distab) !------------------------------------------------------------------ -!$ CALL omp_unset_lock(proj_blk_lock((katom-1)*nspins+ispin)) +!$ CALL omp_unset_lock(proj_blk_lock((katom - 1)*nspins + ispin)) ENDDO ! ispin @@ -608,7 +608,7 @@ SUBROUTINE calculate_jrho_atom_coeff(qs_env, current_env, mat_d0, mat_jp, mat_jp CALL mp_sum(tmp_coeff, para_env%group) IF (ASSOCIATED(jrho1_atom_set(iatom)%cjc0_h(ispin)%r_coef)) & - nbr_dbl = nbr_dbl+8.0_dp*REAL(SIZE(jrho1_atom_set(iatom)%cjc0_h(ispin)%r_coef), dp) + nbr_dbl = nbr_dbl + 8.0_dp*REAL(SIZE(jrho1_atom_set(iatom)%cjc0_h(ispin)%r_coef), dp) ENDDO ! ispin ENDDO ! iat @@ -793,32 +793,32 @@ SUBROUTINE calculate_jrho_atom_rad(qs_env, current_env, idir) n1s = nsoset(lmax(iset1)) DO ipgf1 = 1, npgf(iset1) - iso1_first = nsoset(lmin(iset1)-1)+1+n1s*(ipgf1-1)+m1s - iso1_last = nsoset(lmax(iset1))+n1s*(ipgf1-1)+m1s - size1 = iso1_last-iso1_first+1 + iso1_first = nsoset(lmin(iset1) - 1) + 1 + n1s*(ipgf1 - 1) + m1s + iso1_last = nsoset(lmax(iset1)) + n1s*(ipgf1 - 1) + m1s + size1 = iso1_last - iso1_first + 1 iso1_first = o2nindex(iso1_first) iso1_last = o2nindex(iso1_last) - i1 = iso1_last-iso1_first+1 + i1 = iso1_last - iso1_first + 1 CPASSERT(size1 == i1) - i1 = nsoset(lmin(iset1)-1)+1 + i1 = nsoset(lmin(iset1) - 1) + 1 ! g1(1:nr) = EXP(-zet(ipgf1, iset1)*grid_atom%rad2(1:nr)) ! n2s = nsoset(lmax(iset2)) DO ipgf2 = 1, npgf(iset2) - iso2_first = nsoset(lmin(iset2)-1)+1+n2s*(ipgf2-1)+m2s - iso2_last = nsoset(lmax(iset2))+n2s*(ipgf2-1)+m2s - size2 = iso2_last-iso2_first+1 + iso2_first = nsoset(lmin(iset2) - 1) + 1 + n2s*(ipgf2 - 1) + m2s + iso2_last = nsoset(lmax(iset2)) + n2s*(ipgf2 - 1) + m2s + size2 = iso2_last - iso2_first + 1 iso2_first = o2nindex(iso2_first) iso2_last = o2nindex(iso2_last) - i2 = iso2_last-iso2_first+1 + i2 = iso2_last - iso2_first + 1 CPASSERT(size2 == i2) - i2 = nsoset(lmin(iset2)-1)+1 + i2 = nsoset(lmin(iset2) - 1) + 1 ! g2(1:nr) = EXP(-zet(ipgf2, iset2)*grid_atom%rad2(1:nr)) ! - lmin12 = lmin(iset1)+lmin(iset2) - lmax12 = lmax(iset1)+lmax(iset2) + lmin12 = lmin(iset1) + lmin(iset2) + lmax12 = lmax(iset1) + lmax(iset2) ! gg = 0.0_dp gg_lm1 = 0.0_dp @@ -834,16 +834,16 @@ SUBROUTINE calculate_jrho_atom_rad(qs_env, current_env, idir) gg_lm1(1:nr, lmin12) = 0.0_dp ELSE gg(1:nr, lmin12) = grid_atom%rad2l(1:nr, lmin12)*g1(1:nr)*g2(1:nr) - gg_lm1(1:nr, lmin12) = grid_atom%rad2l(1:nr, lmin12-1)*g1(1:nr)*g2(1:nr) + gg_lm1(1:nr, lmin12) = grid_atom%rad2l(1:nr, lmin12 - 1)*g1(1:nr)*g2(1:nr) ENDIF ! - DO l = lmin12+1, lmax12 - gg(1:nr, l) = grid_atom%rad(1:nr)*gg(1:nr, l-1) - gg_lm1(1:nr, l) = gg(1:nr, l-1) + DO l = lmin12 + 1, lmax12 + gg(1:nr, l) = grid_atom%rad(1:nr)*gg(1:nr, l - 1) + gg_lm1(1:nr, l) = gg(1:nr, l - 1) ENDDO ! DO l = lmin12, lmax12 - dgg_1(1:nr, l) = 2.0_dp*(zet(ipgf1, iset1)-zet(ipgf2, iset2))& + dgg_1(1:nr, l) = 2.0_dp*(zet(ipgf1, iset1) - zet(ipgf2, iset2))& & *gg(1:nr, l)*grid_atom%rad(1:nr) ENDDO ELSE @@ -861,12 +861,12 @@ SUBROUTINE calculate_jrho_atom_rad(qs_env, current_env, idir) ! ! Hard term coeff => jrho1_atom_set(iatom)%cjc0_h(ispin)%r_coef - cjc0_h_block(i1:i1+size1-1, i2:i2+size2-1) = & + cjc0_h_block(i1:i1 + size1 - 1, i2:i2 + size2 - 1) = & coeff(iso1_first:iso1_last, iso2_first:iso2_last) ! ! Soft term coeff => jrho1_atom_set(iatom)%cjc0_s(ispin)%r_coef - cjc0_s_block(i1:i1+size1-1, i2:i2+size2-1) = & + cjc0_s_block(i1:i1 + size1 - 1, i2:i2 + size2 - 1) = & coeff(iso1_first:iso1_last, iso2_first:iso2_last) !------------------------------------------------------------------ ! mQai_\alpha\alpha' @@ -875,12 +875,12 @@ SUBROUTINE calculate_jrho_atom_rad(qs_env, current_env, idir) ! ! Hard term coeff => jrho1_atom_set(iatom)%cjc_h(ispin)%r_coef - cjc_h_block(i1:i1+size1-1, i2:i2+size2-1) = & + cjc_h_block(i1:i1 + size1 - 1, i2:i2 + size2 - 1) = & coeff(iso1_first:iso1_last, iso2_first:iso2_last) ! ! Soft term coeff => jrho1_atom_set(iatom)%cjc_s(ispin)%r_coef - cjc_s_block(i1:i1+size1-1, i2:i2+size2-1) = & + cjc_s_block(i1:i1 + size1 - 1, i2:i2 + size2 - 1) = & coeff(iso1_first:iso1_last, iso2_first:iso2_last) !------------------------------------------------------------------ ! Qci_\alpha\alpha' @@ -889,12 +889,12 @@ SUBROUTINE calculate_jrho_atom_rad(qs_env, current_env, idir) ! ! Hard term coeff => jrho1_atom_set(iatom)%cjc_ii_h(ispin)%r_coef - cjc_ii_h_block(i1:i1+size1-1, i2:i2+size2-1) = & + cjc_ii_h_block(i1:i1 + size1 - 1, i2:i2 + size2 - 1) = & coeff(iso1_first:iso1_last, iso2_first:iso2_last) ! ! Soft term coeff => jrho1_atom_set(iatom)%cjc_ii_s(ispin)%r_coef - cjc_ii_s_block(i1:i1+size1-1, i2:i2+size2-1) = & + cjc_ii_s_block(i1:i1 + size1 - 1, i2:i2 + size2 - 1) = & coeff(iso1_first:iso1_last, iso2_first:iso2_last) !------------------------------------------------------------------ ! Qbi_\alpha\alpha' @@ -904,12 +904,12 @@ SUBROUTINE calculate_jrho_atom_rad(qs_env, current_env, idir) ! ! Hard term coeff => jrho1_atom_set(iatom)%cjc_iii_h(ispin)%r_coef - cjc_iii_h_block(i1:i1+size1-1, i2:i2+size2-1) = & + cjc_iii_h_block(i1:i1 + size1 - 1, i2:i2 + size2 - 1) = & coeff(iso1_first:iso1_last, iso2_first:iso2_last) ! ! Soft term coeff => jrho1_atom_set(iatom)%cjc_iii_s(ispin)%r_coef - cjc_iii_s_block(i1:i1+size1-1, i2:i2+size2-1) = & + cjc_iii_s_block(i1:i1 + size1 - 1, i2:i2 + size2 - 1) = & coeff(iso1_first:iso1_last, iso2_first:iso2_last) !------------------------------------------------------------------ ! @@ -964,7 +964,7 @@ SUBROUTINE calculate_jrho_atom_rad(qs_env, current_env, idir) ENDIF CPASSERT(iso2 > 0 .AND. iso1 > 0) ! - l = indso(1, iso1)+indso(1, iso2) + l = indso(1, iso1) + indso(1, iso2) IF (l .GT. lmax_expansion .OR. l .LT. .0) THEN WRITE (*, *) 'calculate_jrho_atom_rad: 1 l', l WRITE (*, *) 'calculate_jrho_atom_rad: 1 lmax_expansion', lmax_expansion @@ -976,33 +976,33 @@ SUBROUTINE calculate_jrho_atom_rad(qs_env, current_env, idir) ! IF (current_env%gauge .EQ. current_gauge_atom) THEN ! Hard term - Fr_h(1:nr, iso) = Fr_h(1:nr, iso)+ & + Fr_h(1:nr, iso) = Fr_h(1:nr, iso) + & gg(1:nr, l)*cjc0_h_block(iso1, iso2)* & my_CG(iso1, iso2, iso) ! Soft term - Fr_s(1:nr, iso) = Fr_s(1:nr, iso)+ & + Fr_s(1:nr, iso) = Fr_s(1:nr, iso) + & gg(1:nr, l)*cjc0_s_block(iso1, iso2)* & my_CG(iso1, iso2, iso) ELSE ! Hard term - Fr_h(1:nr, iso) = Fr_h(1:nr, iso)+ & + Fr_h(1:nr, iso) = Fr_h(1:nr, iso) + & gg(1:nr, l)*cjc0_h_block(iso1, iso2)* & - my_CG(iso1, iso2, iso)*(grid_atom%rad(1:nr)-gauge_h(1:nr)) + my_CG(iso1, iso2, iso)*(grid_atom%rad(1:nr) - gauge_h(1:nr)) ! Soft term - Fr_s(1:nr, iso) = Fr_s(1:nr, iso)+ & + Fr_s(1:nr, iso) = Fr_s(1:nr, iso) + & gg(1:nr, l)*cjc0_s_block(iso1, iso2)* & - my_CG(iso1, iso2, iso)*(grid_atom%rad(1:nr)-gauge_s(1:nr)) + my_CG(iso1, iso2, iso)*(grid_atom%rad(1:nr) - gauge_s(1:nr)) ENDIF !------------------------------------------------------------------ ! Rai ! ! Hard term - Fr_a_h(1:nr, iso) = Fr_a_h(1:nr, iso)+ & + Fr_a_h(1:nr, iso) = Fr_a_h(1:nr, iso) + & dgg_1(1:nr, l)*cjc_h_block(iso1, iso2)* & my_CG(iso1, iso2, iso) ! ! Soft term - Fr_a_s(1:nr, iso) = Fr_a_s(1:nr, iso)+ & + Fr_a_s(1:nr, iso) = Fr_a_s(1:nr, iso) + & dgg_1(1:nr, l)*cjc_s_block(iso1, iso2)* & my_CG(iso1, iso2, iso) !------------------------------------------------------------------ @@ -1010,23 +1010,23 @@ SUBROUTINE calculate_jrho_atom_rad(qs_env, current_env, idir) ! IF (current_env%gauge .EQ. current_gauge_atom) THEN ! Hard term - Fr_a_h_ii(1:nr, iso) = Fr_a_h_ii(1:nr, iso)+ & + Fr_a_h_ii(1:nr, iso) = Fr_a_h_ii(1:nr, iso) + & dgg_1(1:nr, l)* & cjc_ii_h_block(iso1, iso2)* & my_CG(iso1, iso2, iso) ! Soft term - Fr_a_s_ii(1:nr, iso) = Fr_a_s_ii(1:nr, iso)+ & + Fr_a_s_ii(1:nr, iso) = Fr_a_s_ii(1:nr, iso) + & dgg_1(1:nr, l)* & cjc_ii_s_block(iso1, iso2)* & my_CG(iso1, iso2, iso) ELSE ! Hard term - Fr_a_h_ii(1:nr, iso) = Fr_a_h_ii(1:nr, iso)+ & + Fr_a_h_ii(1:nr, iso) = Fr_a_h_ii(1:nr, iso) + & dgg_1(1:nr, l)*gauge_h(1:nr)* & cjc_ii_h_block(iso1, iso2)* & my_CG(iso1, iso2, iso) ! Soft term - Fr_a_s_ii(1:nr, iso) = Fr_a_s_ii(1:nr, iso)+ & + Fr_a_s_ii(1:nr, iso) = Fr_a_s_ii(1:nr, iso) + & dgg_1(1:nr, l)*gauge_s(1:nr)* & cjc_ii_s_block(iso1, iso2)* & my_CG(iso1, iso2, iso) @@ -1036,23 +1036,23 @@ SUBROUTINE calculate_jrho_atom_rad(qs_env, current_env, idir) ! IF (current_env%gauge .EQ. current_gauge_atom) THEN ! Hard term - Fr_a_h_iii(1:nr, iso) = Fr_a_h_iii(1:nr, iso)+ & + Fr_a_h_iii(1:nr, iso) = Fr_a_h_iii(1:nr, iso) + & dgg_1(1:nr, l)* & cjc_iii_h_block(iso1, iso2)* & my_CG(iso1, iso2, iso) ! Soft term - Fr_a_s_iii(1:nr, iso) = Fr_a_s_iii(1:nr, iso)+ & + Fr_a_s_iii(1:nr, iso) = Fr_a_s_iii(1:nr, iso) + & dgg_1(1:nr, l)* & cjc_iii_s_block(iso1, iso2)* & my_CG(iso1, iso2, iso) ELSE ! Hard term - Fr_a_h_iii(1:nr, iso) = Fr_a_h_iii(1:nr, iso)+ & + Fr_a_h_iii(1:nr, iso) = Fr_a_h_iii(1:nr, iso) + & dgg_1(1:nr, l)*gauge_h(1:nr)* & cjc_iii_h_block(iso1, iso2)* & my_CG(iso1, iso2, iso) ! Soft term - Fr_a_s_iii(1:nr, iso) = Fr_a_s_iii(1:nr, iso)+ & + Fr_a_s_iii(1:nr, iso) = Fr_a_s_iii(1:nr, iso) + & dgg_1(1:nr, l)*gauge_s(1:nr)* & cjc_iii_s_block(iso1, iso2)* & my_CG(iso1, iso2, iso) @@ -1078,7 +1078,7 @@ SUBROUTINE calculate_jrho_atom_rad(qs_env, current_env, idir) ENDIF CPASSERT(iso2 > 0 .AND. iso1 > 0) ! - l = indso(1, iso1)+indso(1, iso2) + l = indso(1, iso1) + indso(1, iso2) IF (l .GT. lmax_expansion) THEN WRITE (*, *) 'calculate_jrho_atom_rad: 1 l', l WRITE (*, *) 'calculate_jrho_atom_rad: 1 lmax_expansion', lmax_expansion @@ -1089,12 +1089,12 @@ SUBROUTINE calculate_jrho_atom_rad(qs_env, current_env, idir) ! Daij ! ! Hard term - Fr_b_h(1:nr, iso) = Fr_b_h(1:nr, iso)+ & + Fr_b_h(1:nr, iso) = Fr_b_h(1:nr, iso) + & gg_lm1(1:nr, l)*cjc_h_block(iso1, iso2)* & my_CG_dxyz_asym(idir, iso1, iso2, iso) ! ! Soft term - Fr_b_s(1:nr, iso) = Fr_b_s(1:nr, iso)+ & + Fr_b_s(1:nr, iso) = Fr_b_s(1:nr, iso) + & gg_lm1(1:nr, l)*cjc_s_block(iso1, iso2)* & my_CG_dxyz_asym(idir, iso1, iso2, iso) ! @@ -1103,23 +1103,23 @@ SUBROUTINE calculate_jrho_atom_rad(qs_env, current_env, idir) ! IF (current_env%gauge .EQ. current_gauge_atom) THEN ! Hard term - Fr_b_h_ii(1:nr, iso) = Fr_b_h_ii(1:nr, iso)+ & + Fr_b_h_ii(1:nr, iso) = Fr_b_h_ii(1:nr, iso) + & gg_lm1(1:nr, l)* & cjc_ii_h_block(iso1, iso2)* & my_CG_dxyz_asym(idir, iso1, iso2, iso) ! Soft term - Fr_b_s_ii(1:nr, iso) = Fr_b_s_ii(1:nr, iso)+ & + Fr_b_s_ii(1:nr, iso) = Fr_b_s_ii(1:nr, iso) + & gg_lm1(1:nr, l)* & cjc_ii_s_block(iso1, iso2)* & my_CG_dxyz_asym(idir, iso1, iso2, iso) ELSE ! Hard term - Fr_b_h_ii(1:nr, iso) = Fr_b_h_ii(1:nr, iso)+ & + Fr_b_h_ii(1:nr, iso) = Fr_b_h_ii(1:nr, iso) + & gg_lm1(1:nr, l)*gauge_h(1:nr)* & cjc_ii_h_block(iso1, iso2)* & my_CG_dxyz_asym(idir, iso1, iso2, iso) ! Soft term - Fr_b_s_ii(1:nr, iso) = Fr_b_s_ii(1:nr, iso)+ & + Fr_b_s_ii(1:nr, iso) = Fr_b_s_ii(1:nr, iso) + & gg_lm1(1:nr, l)*gauge_s(1:nr)* & cjc_ii_s_block(iso1, iso2)* & my_CG_dxyz_asym(idir, iso1, iso2, iso) @@ -1129,23 +1129,23 @@ SUBROUTINE calculate_jrho_atom_rad(qs_env, current_env, idir) ! IF (current_env%gauge .EQ. current_gauge_atom) THEN ! Hard term - Fr_b_h_iii(1:nr, iso) = Fr_b_h_iii(1:nr, iso)+ & + Fr_b_h_iii(1:nr, iso) = Fr_b_h_iii(1:nr, iso) + & gg_lm1(1:nr, l)* & cjc_iii_h_block(iso1, iso2)* & my_CG_dxyz_asym(idir, iso1, iso2, iso) ! Soft term - Fr_b_s_iii(1:nr, iso) = Fr_b_s_iii(1:nr, iso)+ & + Fr_b_s_iii(1:nr, iso) = Fr_b_s_iii(1:nr, iso) + & gg_lm1(1:nr, l)* & cjc_iii_s_block(iso1, iso2)* & my_CG_dxyz_asym(idir, iso1, iso2, iso) ELSE ! Hard term - Fr_b_h_iii(1:nr, iso) = Fr_b_h_iii(1:nr, iso)+ & + Fr_b_h_iii(1:nr, iso) = Fr_b_h_iii(1:nr, iso) + & gg_lm1(1:nr, l)*gauge_h(1:nr)* & cjc_iii_h_block(iso1, iso2)* & my_CG_dxyz_asym(idir, iso1, iso2, iso) ! Soft term - Fr_b_s_iii(1:nr, iso) = Fr_b_s_iii(1:nr, iso)+ & + Fr_b_s_iii(1:nr, iso) = Fr_b_s_iii(1:nr, iso) + & gg_lm1(1:nr, l)*gauge_s(1:nr)* & cjc_iii_s_block(iso1, iso2)* & my_CG_dxyz_asym(idir, iso1, iso2, iso) @@ -1161,9 +1161,9 @@ SUBROUTINE calculate_jrho_atom_rad(qs_env, current_env, idir) ! ENDDO !ipgf2 ENDDO ! ipgf1 - m2s = m2s+maxso + m2s = m2s + maxso ENDDO ! iset2 - m1s = m1s+maxso + m1s = m1s + maxso ENDDO ! iset1 ! DEALLOCATE (cjc0_h_block, cjc0_s_block, cjc_h_block, cjc_s_block, cjc_ii_h_block, cjc_ii_s_block, & @@ -1305,20 +1305,20 @@ SUBROUTINE calculate_jrho_atom_ang(jrho1_atom, jrho_h, jrho_s, grid_atom, & ! - aii(ia) * ( aj(ia) * Rbi(ir,iso) + Dbij ) ! + aiii(ia) * ( aj(ia) * Rci(ir,iso) + Dcij ) ! ) * Ylm(ia) - rad_part = a(idir, ia)*Fr_a_h(ir, iso)+Fr_b_h(ir, iso) & - & -g(iiB, ir, ia)*(a(idir, ia)*Fr_a_h_iii(ir, iso)+Fr_b_h_iii(ir, iso))& - & +g(iiiB, ir, ia)*(a(idir, ia)*Fr_a_h_ii(ir, iso)+Fr_b_h_ii(ir, iso))& - & +scale*(a(idir2, ia)*r(ir)-g(idir2, ir, ia))*Fr_h(ir, iso) + rad_part = a(idir, ia)*Fr_a_h(ir, iso) + Fr_b_h(ir, iso) & + & - g(iiB, ir, ia)*(a(idir, ia)*Fr_a_h_iii(ir, iso) + Fr_b_h_iii(ir, iso))& + & + g(iiiB, ir, ia)*(a(idir, ia)*Fr_a_h_ii(ir, iso) + Fr_b_h_ii(ir, iso))& + & + scale*(a(idir2, ia)*r(ir) - g(idir2, ir, ia))*Fr_h(ir, iso) ! - jrho_h(ir, ia) = jrho_h(ir, ia)+rad_part*slm(ia, iso) + jrho_h(ir, ia) = jrho_h(ir, ia) + rad_part*slm(ia, iso) !------------------------------------------------------------------ ! Soft current density response - rad_part = a(idir, ia)*Fr_a_s(ir, iso)+Fr_b_s(ir, iso) & - & -g(iiB, ir, ia)*(a(idir, ia)*Fr_a_s_iii(ir, iso)+Fr_b_s_iii(ir, iso))& - & +g(iiiB, ir, ia)*(a(idir, ia)*Fr_a_s_ii(ir, iso)+Fr_b_s_ii(ir, iso))& - & +scale*(a(idir2, ia)*r(ir)-g(idir2, ir, ia))*Fr_s(ir, iso) + rad_part = a(idir, ia)*Fr_a_s(ir, iso) + Fr_b_s(ir, iso) & + & - g(iiB, ir, ia)*(a(idir, ia)*Fr_a_s_iii(ir, iso) + Fr_b_s_iii(ir, iso))& + & + g(iiiB, ir, ia)*(a(idir, ia)*Fr_a_s_ii(ir, iso) + Fr_b_s_ii(ir, iso))& + & + scale*(a(idir2, ia)*r(ir) - g(idir2, ir, ia))*Fr_s(ir, iso) ! - jrho_s(ir, ia) = jrho_s(ir, ia)+rad_part*slm(ia, iso) + jrho_s(ir, ia) = jrho_s(ir, ia) + rad_part*slm(ia, iso) !------------------------------------------------------------------ ELSE !------------------------------------------------------------------ @@ -1327,20 +1327,20 @@ SUBROUTINE calculate_jrho_atom_ang(jrho1_atom, jrho_h, jrho_s, grid_atom, & ! - aii(ia) * ( aj(ia) * Rbi(ir,iso) + Dbij ) ! + aiii(ia) * ( aj(ia) * Rci(ir,iso) + Dcij ) ! ) * Ylm(ia) - rad_part = a(idir, ia)*Fr_a_h(ir, iso)+Fr_b_h(ir, iso) & - & -a(iiB, ia)*(a(idir, ia)*Fr_a_h_iii(ir, iso)+Fr_b_h_iii(ir, iso))& - & +a(iiiB, ia)*(a(idir, ia)*Fr_a_h_ii(ir, iso)+Fr_b_h_ii(ir, iso))& - & +scale*a(idir2, ia)*Fr_h(ir, iso) + rad_part = a(idir, ia)*Fr_a_h(ir, iso) + Fr_b_h(ir, iso) & + & - a(iiB, ia)*(a(idir, ia)*Fr_a_h_iii(ir, iso) + Fr_b_h_iii(ir, iso))& + & + a(iiiB, ia)*(a(idir, ia)*Fr_a_h_ii(ir, iso) + Fr_b_h_ii(ir, iso))& + & + scale*a(idir2, ia)*Fr_h(ir, iso) ! - jrho_h(ir, ia) = jrho_h(ir, ia)+rad_part*slm(ia, iso) + jrho_h(ir, ia) = jrho_h(ir, ia) + rad_part*slm(ia, iso) !------------------------------------------------------------------ ! Soft current density response - rad_part = a(idir, ia)*Fr_a_s(ir, iso)+Fr_b_s(ir, iso) & - & -a(iiB, ia)*(a(idir, ia)*Fr_a_s_iii(ir, iso)+Fr_b_s_iii(ir, iso))& - & +a(iiiB, ia)*(a(idir, ia)*Fr_a_s_ii(ir, iso)+Fr_b_s_ii(ir, iso))& - & +scale*a(idir2, ia)*Fr_s(ir, iso) + rad_part = a(idir, ia)*Fr_a_s(ir, iso) + Fr_b_s(ir, iso) & + & - a(iiB, ia)*(a(idir, ia)*Fr_a_s_iii(ir, iso) + Fr_b_s_iii(ir, iso))& + & + a(iiiB, ia)*(a(idir, ia)*Fr_a_s_ii(ir, iso) + Fr_b_s_ii(ir, iso))& + & + scale*a(idir2, ia)*Fr_s(ir, iso) ! - jrho_s(ir, ia) = jrho_s(ir, ia)+rad_part*slm(ia, iso) + jrho_s(ir, ia) = jrho_s(ir, ia) + rad_part*slm(ia, iso) !------------------------------------------------------------------ ENDIF ENDDO ! ia @@ -1371,25 +1371,25 @@ SUBROUTINE get_gauge() point(3) = r(ir)*a(3, ia) DO iatom = 1, natm_gauge buf(iatom) = 1.0_dp - pra = point-ratom(:, iatom) - pa = SQRT(pra(1)**2+pra(2)**2+pra(3)**2) + pra = point - ratom(:, iatom) + pa = SQRT(pra(1)**2 + pra(2)**2 + pra(3)**2) DO jatom = 1, natm_gauge IF (iatom .EQ. jatom) CYCLE - prb = point-ratom(:, jatom) - pb = SQRT(prb(1)**2+prb(2)**2+prb(3)**2) - ab = SQRT((pra(1)-prb(1))**2+(pra(2)-prb(2))**2+(pra(3)-prb(3))**2) + prb = point - ratom(:, jatom) + pb = SQRT(prb(1)**2 + prb(2)**2 + prb(3)**2) + ab = SQRT((pra(1) - prb(1))**2 + (pra(2) - prb(2))**2 + (pra(3) - prb(3))**2) ! - tmp = (pa-pb)/ab - tmp = 0.5_dp*(3.0_dp-tmp**2)*tmp - tmp = 0.5_dp*(3.0_dp-tmp**2)*tmp - tmp = 0.5_dp*(3.0_dp-tmp**2)*tmp - buf(iatom) = buf(iatom)*0.5_dp*(1.0_dp-tmp) + tmp = (pa - pb)/ab + tmp = 0.5_dp*(3.0_dp - tmp**2)*tmp + tmp = 0.5_dp*(3.0_dp - tmp**2)*tmp + tmp = 0.5_dp*(3.0_dp - tmp**2)*tmp + buf(iatom) = buf(iatom)*0.5_dp*(1.0_dp - tmp) ENDDO ENDDO DO ixyz = 1, 3 res = 0.0_dp DO iatom = 1, natm_gauge - res = res+ratom(ixyz, iatom)*buf(iatom) + res = res + ratom(ixyz, iatom)*buf(iatom) ENDDO res = res/SUM(buf(1:natm_gauge)) ! @@ -1482,10 +1482,10 @@ SUBROUTINE calculate_jrho_atom(current_env, qs_env, iB, idir) natm_gauge = 0 DO jatom = 1, natm_tot - r(:) = pbc(particle_set(jatom)%r(:)-particle_set(iatom)%r(:), cell) + r(:) = pbc(particle_set(jatom)%r(:) - particle_set(iatom)%r(:), cell) ! SQRT(SUM(r(:)**2)) .LE. 2.0_dp*hard_radius IF (SUM(r(:)**2) .LE. (4.0_dp*hard_radius*hard_radius)) THEN - natm_gauge = natm_gauge+1 + natm_gauge = natm_gauge + 1 ratom(:, natm_gauge) = r(:) ENDIF ENDDO diff --git a/src/qs_linres_current.F b/src/qs_linres_current.F index ecb4d2cbed..6419b10aca 100644 --- a/src/qs_linres_current.F +++ b/src/qs_linres_current.F @@ -354,7 +354,7 @@ SUBROUTINE current_build_current(current_env, qs_env, iB) ! ! Copy the vector in the full matrix psi1 !nstate_loc = center_list(ispin)%array(1,icenter+1)-center_list(ispin)%array(1,icenter) - DO j = center_list(ispin)%array(1, istate), center_list(ispin)%array(1, istate+1)-1 + DO j = center_list(ispin)%array(1, istate), center_list(ispin)%array(1, istate + 1) - 1 jstate = center_list(ispin)%array(2, j) CALL cp_fm_to_fm(psi1_p(ispin, iiB)%matrix, psi_a_iB, 1, jstate, jstate) CALL cp_fm_to_fm(psi1_p(ispin, iiiB)%matrix, psi_buf, 1, jstate, jstate) @@ -424,7 +424,7 @@ SUBROUTINE current_build_current(current_env, qs_env, iB) IF (output_unit > 0) THEN WRITE (output_unit, '(T2,2(A,E24.16))') 'Integrated j_'& - &//ACHAR(idir+119)//ACHAR(iB+119)//'(r): G-space=', & + &//ACHAR(idir + 119)//ACHAR(iB + 119)//'(r): G-space=', & jrho_tot_G(idir, iB), ' R-space=', jrho_tot_R(idir, iB) ENDIF ! @@ -490,7 +490,7 @@ SUBROUTINE current_build_current(current_env, qs_env, iB) filename = "jresp" mpi_io = .TRUE. WRITE (ext, '(a2,I1,a2,I1,a5)') "iB", iB, "_d", idir, ".cube" - WRITE (ext, '(a2,a1,a2,a1,a5)') "iB", ACHAR(iB+119), "_d", ACHAR(idir+119), ".cube" + WRITE (ext, '(a2,a1,a2,a1,a5)') "iB", ACHAR(iB + 119), "_d", ACHAR(idir + 119), ".cube" unit_nr = cp_print_key_unit_nr(logger, current_section, "PRINT%CURRENT_CUBES", & extension=TRIM(ext), middle_name=TRIM(filename), & log_filename=.FALSE., file_position=my_pos, & @@ -712,11 +712,11 @@ SUBROUTINE calculate_jrho_resp(mat_d0, mat_jp, mat_jp_rii, mat_jp_riii, iB, idir nkind = SIZE(qs_kind_set) - CALL reallocate(jpabt_a, 1, maxco, 1, maxco, 0, nthread-1) - CALL reallocate(jpabt_b, 1, maxco, 1, maxco, 0, nthread-1) - CALL reallocate(jpabt_c, 1, maxco, 1, maxco, 0, nthread-1) - CALL reallocate(jpabt_d, 1, maxco, 1, maxco, 0, nthread-1) - CALL reallocate(workt, 1, maxco, 1, maxsgf_set, 0, nthread-1) + CALL reallocate(jpabt_a, 1, maxco, 1, maxco, 0, nthread - 1) + CALL reallocate(jpabt_b, 1, maxco, 1, maxco, 0, nthread - 1) + CALL reallocate(jpabt_c, 1, maxco, 1, maxco, 0, nthread - 1) + CALL reallocate(jpabt_d, 1, maxco, 1, maxco, 0, nthread - 1) + CALL reallocate(workt, 1, maxco, 1, maxsgf_set, 0, nthread - 1) CALL reallocate(tasks, 1, 6, 1, max_tasks) CALL reallocate(dist_ab, 1, 3, 1, max_tasks) @@ -754,7 +754,7 @@ SUBROUTINE calculate_jrho_resp(mat_d0, mat_jp, mat_jp_rii, mat_jp_riii, iB, idir ! ga_gb_function can be one of FUNC_AB, FUNC_ADBmDAB or FUNC_ARDBm_DARB ! take worst case and add 2 to lmax_global - lmax_global = lmax_global+2 + lmax_global = lmax_global + 2 ! *** Initialize working density matrix *** @@ -1108,13 +1108,13 @@ SUBROUTINE calculate_jrho_resp(mat_d0, mat_jp, mat_jp_rii, mat_jp_riii, iB, idir ENDIF rab(:) = dist_ab(:, itask) - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) - rb(:) = ra(:)+rab(:) - zetp = zeta(ipgf, iset)+zetb(jpgf, jset) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) + rb(:) = ra(:) + rab(:) + zetp = zeta(ipgf, iset) + zetb(jpgf, jset) - na1 = (ipgf-1)*ncoset(la_max(iset))+1 + na1 = (ipgf - 1)*ncoset(la_max(iset)) + 1 na2 = ipgf*ncoset(la_max(iset)) - nb1 = (jpgf-1)*ncoset(lb_max(jset))+1 + nb1 = (jpgf - 1)*ncoset(lb_max(jset)) + 1 nb2 = jpgf*ncoset(lb_max(jset)) ! Four calls to the general collocate density, to multply the correct function @@ -1126,7 +1126,7 @@ SUBROUTINE calculate_jrho_resp(mat_d0, mat_jp, mat_jp_rii, mat_jp_riii, iB, idir scale = 1.0_dp CALL collocate_pgf_product_rspace(la_max(iset), zeta(ipgf, iset), & la_min(iset), lb_max(jset), zetb(jpgf, jset), lb_min(jset), & - ra, rab, rab2, scale, jpab_a, na1-1, nb1-1, & + ra, rab, rab2, scale, jpab_a, na1 - 1, nb1 - 1, & rs_current(igrid_level)%rs_grid, cell, cube_info(igrid_level), & eps_rho_rspace, & ga_gb_function=FUNC_ADBmDAB, & @@ -1138,7 +1138,7 @@ SUBROUTINE calculate_jrho_resp(mat_d0, mat_jp, mat_jp_rii, mat_jp_riii, iB, idir IF (scale2 .NE. 0.0_dp) THEN CALL collocate_pgf_product_rspace(la_max(iset), zeta(ipgf, iset), & la_min(iset), lb_max(jset), zetb(jpgf, jset), lb_min(jset), & - ra, rab, rab2, scale2, jpab_d, na1-1, nb1-1, & + ra, rab, rab2, scale2, jpab_d, na1 - 1, nb1 - 1, & rs_rho(igrid_level)%rs_grid, cell, cube_info(igrid_level), & eps_rho_rspace, & ga_gb_function=FUNC_AB, & @@ -1150,7 +1150,7 @@ SUBROUTINE calculate_jrho_resp(mat_d0, mat_jp, mat_jp_rii, mat_jp_riii, iB, idir scale = 1.0_dp CALL collocate_pgf_product_rspace(la_max(iset), zeta(ipgf, iset), & la_min(iset), lb_max(jset), zetb(jpgf, jset), lb_min(jset), & - ra, rab, rab2, scale, jpab_b, na1-1, nb1-1, & + ra, rab, rab2, scale, jpab_b, na1 - 1, nb1 - 1, & rs_current(igrid_level)%rs_grid, cell, cube_info(igrid_level), & eps_rho_rspace, & ga_gb_function=FUNC_ADBmDAB, & @@ -1164,7 +1164,7 @@ SUBROUTINE calculate_jrho_resp(mat_d0, mat_jp, mat_jp_rii, mat_jp_riii, iB, idir scale = -1.0_dp CALL collocate_pgf_product_rspace(la_max(iset), zeta(ipgf, iset), & la_min(iset), lb_max(jset), zetb(jpgf, jset), lb_min(jset), & - ra, rab, rab2, scale, jpab_c, na1-1, nb1-1, & + ra, rab, rab2, scale, jpab_c, na1 - 1, nb1 - 1, & rs_current(igrid_level)%rs_grid, cell, cube_info(igrid_level), & eps_rho_rspace, & ga_gb_function=FUNC_ADBmDAB, & @@ -1179,7 +1179,7 @@ SUBROUTINE calculate_jrho_resp(mat_d0, mat_jp, mat_jp_rii, mat_jp_riii, iB, idir scale = 1.0_dp CALL collocate_pgf_product_rspace(la_max(iset), zeta(ipgf, iset), & la_min(iset), lb_max(jset), zetb(jpgf, jset), lb_min(jset), & - ra, rab, rab2, scale, jpab_b, na1-1, nb1-1, & + ra, rab, rab2, scale, jpab_b, na1 - 1, nb1 - 1, & rs_current(igrid_level)%rs_grid, cell, cube_info(igrid_level), & eps_rho_rspace, & ga_gb_function=FUNC_ARDBmDARB, & @@ -1191,7 +1191,7 @@ SUBROUTINE calculate_jrho_resp(mat_d0, mat_jp, mat_jp_rii, mat_jp_riii, iB, idir scale = -1.0_dp CALL collocate_pgf_product_rspace(la_max(iset), zeta(ipgf, iset), & la_min(iset), lb_max(jset), zetb(jpgf, jset), lb_min(jset), & - ra, rab, rab2, scale, jpab_c, na1-1, nb1-1, & + ra, rab, rab2, scale, jpab_c, na1 - 1, nb1 - 1, & rs_current(igrid_level)%rs_grid, cell, cube_info(igrid_level), & eps_rho_rspace, & ga_gb_function=FUNC_ARDBmDARB, & @@ -1357,7 +1357,7 @@ SUBROUTINE box_atoms(qs_env) dbox(2) = cell%hmat(2, 2)/REAL(nbox(2), dp) dbox(3) = cell%hmat(3, 3)/REAL(nbox(3), dp) !write(*,*) 'dbox',dbox - ALLOCATE (box_ptr(0:nbox(1), 0:nbox(2)-1, 0:nbox(3)-1), box_data(3, natms)) + ALLOCATE (box_ptr(0:nbox(1), 0:nbox(2) - 1, 0:nbox(3) - 1), box_data(3, natms)) box_data(:, :) = HUGE(0.0_dp) box_ptr(:, :, :) = HUGE(0) ! @@ -1365,36 +1365,36 @@ SUBROUTINE box_atoms(qs_env) offset(2) = cell%hmat(2, 2)*0.5_dp offset(3) = cell%hmat(3, 3)*0.5_dp DO iatom = 1, natms - ratom(:, iatom) = pbc(particle_set(iatom)%r(:), cell)+offset(:) + ratom(:, iatom) = pbc(particle_set(iatom)%r(:), cell) + offset(:) ENDDO ! i = 1 - DO kbox = 0, nbox(3)-1 - DO jbox = 0, nbox(2)-1 + DO kbox = 0, nbox(3) - 1 + DO jbox = 0, nbox(2) - 1 box_ptr(0, jbox, kbox) = i - DO ibox = 0, nbox(1)-1 + DO ibox = 0, nbox(1) - 1 ii = 0 DO iatom = 1, natms IF (INT(ratom(1, iatom)/dbox(1)) .EQ. ibox .AND. & INT(ratom(2, iatom)/dbox(2)) .EQ. jbox .AND. & INT(ratom(3, iatom)/dbox(3)) .EQ. kbox) THEN - box_data(:, i) = ratom(:, iatom)-offset(:) - i = i+1 - ii = ii+1 + box_data(:, i) = ratom(:, iatom) - offset(:) + i = i + 1 + ii = ii + 1 ENDIF ENDDO - box_ptr(ibox+1, jbox, kbox) = box_ptr(ibox, jbox, kbox)+ii + box_ptr(ibox + 1, jbox, kbox) = box_ptr(ibox, jbox, kbox) + ii ENDDO ENDDO ENDDO ! IF (.FALSE.) THEN - DO kbox = 0, nbox(3)-1 - DO jbox = 0, nbox(2)-1 - DO ibox = 0, nbox(1)-1 + DO kbox = 0, nbox(3) - 1 + DO jbox = 0, nbox(2) - 1 + DO ibox = 0, nbox(1) - 1 WRITE (*, *) 'box=', ibox, jbox, kbox - WRITE (*, *) 'nbr atom=', box_ptr(ibox+1, jbox, kbox)-box_ptr(ibox, jbox, kbox) - DO iatom = box_ptr(ibox, jbox, kbox), box_ptr(ibox+1, jbox, kbox)-1 + WRITE (*, *) 'nbr atom=', box_ptr(ibox + 1, jbox, kbox) - box_ptr(ibox, jbox, kbox) + DO iatom = box_ptr(ibox, jbox, kbox), box_ptr(ibox + 1, jbox, kbox) - 1 WRITE (*, *) 'iatom=', iatom WRITE (*, '(A,3E14.6)') 'coor=', box_data(:, iatom) ENDDO @@ -1464,51 +1464,51 @@ SUBROUTINE collocate_gauge(current_env, qs_env, rs_grid_x, rs_grid_y, rs_grid_z) DO j = 1, ng(2) DO i = 1, ng(1) ! - point(3) = REAL(k-1+lb_local(3)-lb(3), dp)*dr(3) - point(2) = REAL(j-1+lb_local(2)-lb(2), dp)*dr(2) - point(1) = REAL(i-1+lb_local(1)-lb(1), dp)*dr(1) + point(3) = REAL(k - 1 + lb_local(3) - lb(3), dp)*dr(3) + point(2) = REAL(j - 1 + lb_local(2) - lb(2), dp)*dr(2) + point(1) = REAL(i - 1 + lb_local(1) - lb(1), dp)*dr(1) point = pbc(point, cell) ! ! run over the overlaping boxes natms_local = 0 - kmin = INT((point(3)+offset(3)-gauge_atom_radius)/dbox(3)) - kmax = INT((point(3)+offset(3)+gauge_atom_radius)/dbox(3)) - IF (kmax-kmin+1 .GT. nbox(3)) THEN + kmin = INT((point(3) + offset(3) - gauge_atom_radius)/dbox(3)) + kmax = INT((point(3) + offset(3) + gauge_atom_radius)/dbox(3)) + IF (kmax - kmin + 1 .GT. nbox(3)) THEN kmin = 0 - kmax = nbox(3)-1 + kmax = nbox(3) - 1 ENDIF DO kbox = kmin, kmax - jmin = INT((point(2)+offset(2)-gauge_atom_radius)/dbox(2)) - jmax = INT((point(2)+offset(2)+gauge_atom_radius)/dbox(2)) - IF (jmax-jmin+1 .GT. nbox(2)) THEN + jmin = INT((point(2) + offset(2) - gauge_atom_radius)/dbox(2)) + jmax = INT((point(2) + offset(2) + gauge_atom_radius)/dbox(2)) + IF (jmax - jmin + 1 .GT. nbox(2)) THEN jmin = 0 - jmax = nbox(2)-1 + jmax = nbox(2) - 1 ENDIF DO jbox = jmin, jmax - imin = INT((point(1)+offset(1)-gauge_atom_radius)/dbox(1)) - imax = INT((point(1)+offset(1)+gauge_atom_radius)/dbox(1)) - IF (imax-imin+1 .GT. nbox(1)) THEN + imin = INT((point(1) + offset(1) - gauge_atom_radius)/dbox(1)) + imax = INT((point(1) + offset(1) + gauge_atom_radius)/dbox(1)) + IF (imax - imin + 1 .GT. nbox(1)) THEN imin = 0 - imax = nbox(1)-1 + imax = nbox(1) - 1 ENDIF DO ibox = imin, imax ibeg = box_ptr(MODULO(ibox, nbox(1)), MODULO(jbox, nbox(2)), MODULO(kbox, nbox(3))) - iend = box_ptr(MODULO(ibox, nbox(1))+1, MODULO(jbox, nbox(2)), MODULO(kbox, nbox(3)))-1 + iend = box_ptr(MODULO(ibox, nbox(1)) + 1, MODULO(jbox, nbox(2)), MODULO(kbox, nbox(3))) - 1 DO iatom = ibeg, iend - r(:) = pbc(box_data(:, iatom)-point(:), cell)+point(:) - dist = (r(1)-point(1))**2+(r(2)-point(2))**2+(r(3)-point(3))**2 + r(:) = pbc(box_data(:, iatom) - point(:), cell) + point(:) + dist = (r(1) - point(1))**2 + (r(2) - point(2))**2 + (r(3) - point(3))**2 IF (dist .LT. gauge_atom_radius**2) THEN - natms_local = natms_local+1 + natms_local = natms_local + 1 ratom(:, natms_local) = r(:) ! ! compute the distance atoms-point - x = point(1)-r(1) - y = point(2)-r(2) - z = point(3)-r(3) + x = point(1) - r(1) + y = point(2) - r(2) + z = point(3) - r(3) atms_pnt(1, natms_local) = x atms_pnt(2, natms_local) = y atms_pnt(3, natms_local) = z - nrm_atms_pnt(natms_local) = SQRT(x*x+y*y+z*z) + nrm_atms_pnt(natms_local) = SQRT(x*x + y*y + z*z) ENDIF ENDDO ENDDO @@ -1527,16 +1527,16 @@ SUBROUTINE collocate_gauge(current_env, qs_env, rs_grid_x, rs_grid_y, rs_grid_z) DO jatom = 1, natms_local IF (iatom .EQ. jatom) CYCLE pb = nrm_atms_pnt(jatom) - x = pra(1)-atms_pnt(1, jatom) - y = pra(2)-atms_pnt(2, jatom) - z = pra(3)-atms_pnt(3, jatom) - ab = SQRT(x*x+y*y+z*z) + x = pra(1) - atms_pnt(1, jatom) + y = pra(2) - atms_pnt(2, jatom) + z = pra(3) - atms_pnt(3, jatom) + ab = SQRT(x*x + y*y + z*z) ! - tmp = (pa-pb)/ab - tmp = 0.5_dp*(3.0_dp-tmp*tmp)*tmp - tmp = 0.5_dp*(3.0_dp-tmp*tmp)*tmp - tmp = 0.5_dp*(3.0_dp-tmp*tmp)*tmp - buf_tmp = buf_tmp*0.5_dp*(1.0_dp-tmp) + tmp = (pa - pb)/ab + tmp = 0.5_dp*(3.0_dp - tmp*tmp)*tmp + tmp = 0.5_dp*(3.0_dp - tmp*tmp)*tmp + tmp = 0.5_dp*(3.0_dp - tmp*tmp)*tmp + buf_tmp = buf_tmp*0.5_dp*(1.0_dp - tmp) ENDDO buf(iatom) = buf_tmp ENDDO @@ -1545,17 +1545,17 @@ SUBROUTINE collocate_gauge(current_env, qs_env, rs_grid_x, rs_grid_y, rs_grid_z) res(3) = 0.0_dp summe = 0.0_dp DO iatom = 1, natms_local - res(1) = res(1)+ratom(1, iatom)*buf(iatom) - res(2) = res(2)+ratom(2, iatom)*buf(iatom) - res(3) = res(3)+ratom(3, iatom)*buf(iatom) - summe = summe+buf(iatom) + res(1) = res(1) + ratom(1, iatom)*buf(iatom) + res(2) = res(2) + ratom(2, iatom)*buf(iatom) + res(3) = res(3) + ratom(3, iatom)*buf(iatom) + summe = summe + buf(iatom) ENDDO res(1) = res(1)/summe res(2) = res(2)/summe res(3) = res(3)/summe - grid_x(i, j, k) = point(1)-res(1) - grid_y(i, j, k) = point(2)-res(2) - grid_z(i, j, k) = point(3)-res(3) + grid_x(i, j, k) = point(1) - res(1) + grid_y(i, j, k) = point(2) - res(2) + grid_z(i, j, k) = point(3) - res(3) ELSE grid_x(i, j, k) = 0.0_dp grid_y(i, j, k) = 0.0_dp @@ -1620,7 +1620,7 @@ SUBROUTINE box_atoms_new(current_env, qs_env, box) dbox(1) = cell%hmat(1, 1)/REAL(nbox(1), dp) dbox(2) = cell%hmat(2, 2)/REAL(nbox(2), dp) dbox(3) = cell%hmat(3, 3)/REAL(nbox(3), dp) - ALLOCATE (box_ptr(0:nbox(1), 0:nbox(2)-1, 0:nbox(3)-1), box_data(3, natms)) + ALLOCATE (box_ptr(0:nbox(1), 0:nbox(2) - 1, 0:nbox(3) - 1), box_data(3, natms)) box_data(:, :) = HUGE(0.0_dp) box_ptr(:, :, :) = HUGE(0) ! @@ -1632,33 +1632,33 @@ SUBROUTINE box_atoms_new(current_env, qs_env, box) ENDDO ! i = 1 - DO kbox = 0, nbox(3)-1 - DO jbox = 0, nbox(2)-1 + DO kbox = 0, nbox(3) - 1 + DO jbox = 0, nbox(2) - 1 box_ptr(0, jbox, kbox) = i - DO ibox = 0, nbox(1)-1 + DO ibox = 0, nbox(1) - 1 ii = 0 DO iatom = 1, natms IF (MODULO(FLOOR(ratom(1, iatom)/dbox(1)), nbox(1)) .EQ. ibox .AND. & MODULO(FLOOR(ratom(2, iatom)/dbox(2)), nbox(2)) .EQ. jbox .AND. & MODULO(FLOOR(ratom(3, iatom)/dbox(3)), nbox(3)) .EQ. kbox) THEN box_data(:, i) = ratom(:, iatom) - i = i+1 - ii = ii+1 + i = i + 1 + ii = ii + 1 ENDIF ENDDO - box_ptr(ibox+1, jbox, kbox) = box_ptr(ibox, jbox, kbox)+ii + box_ptr(ibox + 1, jbox, kbox) = box_ptr(ibox, jbox, kbox) + ii ENDDO ENDDO ENDDO ! IF (.FALSE.) THEN - DO kbox = 0, nbox(3)-1 - DO jbox = 0, nbox(2)-1 - DO ibox = 0, nbox(1)-1 - IF (box_ptr(ibox+1, jbox, kbox)-box_ptr(ibox, jbox, kbox) .GT. 0) THEN + DO kbox = 0, nbox(3) - 1 + DO jbox = 0, nbox(2) - 1 + DO ibox = 0, nbox(1) - 1 + IF (box_ptr(ibox + 1, jbox, kbox) - box_ptr(ibox, jbox, kbox) .GT. 0) THEN WRITE (*, *) 'box=', ibox, jbox, kbox - WRITE (*, *) 'nbr atom=', box_ptr(ibox+1, jbox, kbox)-box_ptr(ibox, jbox, kbox) - DO iatom = box_ptr(ibox, jbox, kbox), box_ptr(ibox+1, jbox, kbox)-1 + WRITE (*, *) 'nbr atom=', box_ptr(ibox + 1, jbox, kbox) - box_ptr(ibox, jbox, kbox) + DO iatom = box_ptr(ibox, jbox, kbox), box_ptr(ibox + 1, jbox, kbox) - 1 WRITE (*, '(A,I3,3E14.6)') 'coor=', iatom, box_data(:, iatom) ENDDO ENDIF @@ -1668,49 +1668,49 @@ SUBROUTINE box_atoms_new(current_env, qs_env, box) ENDIF ! NULLIFY (box) - ALLOCATE (box(0:nbox(1)-1, 0:nbox(2)-1, 0:nbox(3)-1)) + ALLOCATE (box(0:nbox(1) - 1, 0:nbox(2) - 1, 0:nbox(3) - 1)) ! ! build the list - DO k = 0, nbox(3)-1 - DO j = 0, nbox(2)-1 - DO i = 0, nbox(1)-1 + DO k = 0, nbox(3) - 1 + DO j = 0, nbox(2) - 1 + DO i = 0, nbox(1) - 1 ! - box_center(1) = (REAL(i, dp)+0.5_dp)*dbox(1) - box_center(2) = (REAL(j, dp)+0.5_dp)*dbox(2) - box_center(3) = (REAL(k, dp)+0.5_dp)*dbox(3) + box_center(1) = (REAL(i, dp) + 0.5_dp)*dbox(1) + box_center(2) = (REAL(j, dp) + 0.5_dp)*dbox(2) + box_center(3) = (REAL(k, dp) + 0.5_dp)*dbox(3) box_center_wrap = pbc(box_center, cell) ! ! find the atoms that are in the overlaping boxes natms_local = 0 - kmin = FLOOR((box_center(3)-gauge_atom_radius)/dbox(3)) - kmax = FLOOR((box_center(3)+gauge_atom_radius)/dbox(3)) - IF (kmax-kmin+1 .GT. nbox(3)) THEN + kmin = FLOOR((box_center(3) - gauge_atom_radius)/dbox(3)) + kmax = FLOOR((box_center(3) + gauge_atom_radius)/dbox(3)) + IF (kmax - kmin + 1 .GT. nbox(3)) THEN kmin = 0 - kmax = nbox(3)-1 + kmax = nbox(3) - 1 ENDIF DO kbox = kmin, kmax - jmin = FLOOR((box_center(2)-gauge_atom_radius)/dbox(2)) - jmax = FLOOR((box_center(2)+gauge_atom_radius)/dbox(2)) - IF (jmax-jmin+1 .GT. nbox(2)) THEN + jmin = FLOOR((box_center(2) - gauge_atom_radius)/dbox(2)) + jmax = FLOOR((box_center(2) + gauge_atom_radius)/dbox(2)) + IF (jmax - jmin + 1 .GT. nbox(2)) THEN jmin = 0 - jmax = nbox(2)-1 + jmax = nbox(2) - 1 ENDIF DO jbox = jmin, jmax - imin = FLOOR((box_center(1)-gauge_atom_radius)/dbox(1)) - imax = FLOOR((box_center(1)+gauge_atom_radius)/dbox(1)) - IF (imax-imin+1 .GT. nbox(1)) THEN + imin = FLOOR((box_center(1) - gauge_atom_radius)/dbox(1)) + imax = FLOOR((box_center(1) + gauge_atom_radius)/dbox(1)) + IF (imax - imin + 1 .GT. nbox(1)) THEN imin = 0 - imax = nbox(1)-1 + imax = nbox(1) - 1 ENDIF DO ibox = imin, imax ibeg = box_ptr(MODULO(ibox, nbox(1)), MODULO(jbox, nbox(2)), MODULO(kbox, nbox(3))) - iend = box_ptr(MODULO(ibox, nbox(1))+1, MODULO(jbox, nbox(2)), MODULO(kbox, nbox(3)))-1 + iend = box_ptr(MODULO(ibox, nbox(1)) + 1, MODULO(jbox, nbox(2)), MODULO(kbox, nbox(3))) - 1 DO iatom = ibeg, iend - r = pbc(box_center_wrap(:)-box_data(:, iatom), cell) - IF (ABS(r(1)) .LE. (scale+0.5_dp)*dbox(1) .AND. & - ABS(r(2)) .LE. (scale+0.5_dp)*dbox(2) .AND. & - ABS(r(3)) .LE. (scale+0.5_dp)*dbox(3)) THEN - natms_local = natms_local+1 + r = pbc(box_center_wrap(:) - box_data(:, iatom), cell) + IF (ABS(r(1)) .LE. (scale + 0.5_dp)*dbox(1) .AND. & + ABS(r(2)) .LE. (scale + 0.5_dp)*dbox(2) .AND. & + ABS(r(3)) .LE. (scale + 0.5_dp)*dbox(3)) THEN + natms_local = natms_local + 1 ratom(:, natms_local) = box_data(:, iatom) ENDIF ENDDO @@ -1731,28 +1731,28 @@ SUBROUTINE box_atoms_new(current_env, qs_env, box) ENDDO IF (.FALSE.) THEN - DO k = 0, nbox(3)-1 - DO j = 0, nbox(2)-1 - DO i = 0, nbox(1)-1 + DO k = 0, nbox(3) - 1 + DO j = 0, nbox(2) - 1 + DO i = 0, nbox(1) - 1 IF (box(i, j, k)%n .GT. 0) THEN WRITE (*, *) WRITE (*, *) 'box=', i, j, k - box_center(1) = (REAL(i, dp)+0.5_dp)*dbox(1) - box_center(2) = (REAL(j, dp)+0.5_dp)*dbox(2) - box_center(3) = (REAL(k, dp)+0.5_dp)*dbox(3) + box_center(1) = (REAL(i, dp) + 0.5_dp)*dbox(1) + box_center(2) = (REAL(j, dp) + 0.5_dp)*dbox(2) + box_center(3) = (REAL(k, dp) + 0.5_dp)*dbox(3) box_center = pbc(box_center, cell) WRITE (*, '(A,3E14.6)') 'box_center=', box_center WRITE (*, *) 'nbr atom=', box(i, j, k)%n r_ptr => box(i, j, k)%r DO iatom = 1, box(i, j, k)%n WRITE (*, '(A,I3,3E14.6)') 'coor=', iatom, r_ptr(:, iatom) - r(:) = pbc(box_center(:)-r_ptr(:, iatom), cell) - IF (ABS(r(1)) .GT. (scale+0.5_dp)*dbox(1) .OR. & - ABS(r(2)) .GT. (scale+0.5_dp)*dbox(2) .OR. & - ABS(r(3)) .GT. (scale+0.5_dp)*dbox(3)) THEN + r(:) = pbc(box_center(:) - r_ptr(:, iatom), cell) + IF (ABS(r(1)) .GT. (scale + 0.5_dp)*dbox(1) .OR. & + ABS(r(2)) .GT. (scale + 0.5_dp)*dbox(2) .OR. & + ABS(r(3)) .GT. (scale + 0.5_dp)*dbox(3)) THEN WRITE (*, *) 'error too many atoms' WRITE (*, *) 'dist=', ABS(r(:)) - WRITE (*, *) 'large_dist=', (scale+0.5_dp)*dbox + WRITE (*, *) 'large_dist=', (scale + 0.5_dp)*dbox CPABORT("") ENDIF ENDDO @@ -1763,19 +1763,19 @@ SUBROUTINE box_atoms_new(current_env, qs_env, box) ENDIF IF (.TRUE.) THEN - DO k = 0, nbox(3)-1 - DO j = 0, nbox(2)-1 - DO i = 0, nbox(1)-1 - box_center(1) = (REAL(i, dp)+0.5_dp)*dbox(1) - box_center(2) = (REAL(j, dp)+0.5_dp)*dbox(2) - box_center(3) = (REAL(k, dp)+0.5_dp)*dbox(3) + DO k = 0, nbox(3) - 1 + DO j = 0, nbox(2) - 1 + DO i = 0, nbox(1) - 1 + box_center(1) = (REAL(i, dp) + 0.5_dp)*dbox(1) + box_center(2) = (REAL(j, dp) + 0.5_dp)*dbox(2) + box_center(3) = (REAL(k, dp) + 0.5_dp)*dbox(3) box_center = pbc(box_center, cell) r_ptr => box(i, j, k)%r DO iatom = 1, natms - r(:) = pbc(box_center(:)-ratom(:, iatom), cell) + r(:) = pbc(box_center(:) - ratom(:, iatom), cell) ifind = 0 DO jatom = 1, box(i, j, k)%n - IF (SUM(ABS(ratom(:, iatom)-r_ptr(:, jatom))) .LT. 1E-10_dp) ifind = 1 + IF (SUM(ABS(ratom(:, iatom) - r_ptr(:, jatom))) .LT. 1E-10_dp) ifind = 1 ENDDO IF (ifind .EQ. 0) THEN @@ -1856,7 +1856,7 @@ SUBROUTINE collocate_gauge_new(current_env, qs_env, rs_grid_x, rs_grid_y, rs_gri grid_y => rs_grid_y%r(:, :, :) grid_z => rs_grid_z%r(:, :, :) ng(:) = UBOUND(grid_x) - delta_lb(:) = lb_local(:)-lb(:) + delta_lb(:) = lb_local(:) - lb(:) offset(1) = cell%hmat(1, 1)*0.5_dp offset(2) = cell%hmat(2, 2)*0.5_dp offset(3) = cell%hmat(3, 3)*0.5_dp @@ -1864,11 +1864,11 @@ SUBROUTINE collocate_gauge_new(current_env, qs_env, rs_grid_x, rs_grid_y, rs_gri ! ! find the boxes that match the grid ibs = FLOOR(REAL(delta_lb(1), dp)*dr(1)/dbox(1)) - ibe = FLOOR(REAL(ng(1)-1+delta_lb(1), dp)*dr(1)/dbox(1)) + ibe = FLOOR(REAL(ng(1) - 1 + delta_lb(1), dp)*dr(1)/dbox(1)) jbs = FLOOR(REAL(delta_lb(2), dp)*dr(2)/dbox(2)) - jbe = FLOOR(REAL(ng(2)-1+delta_lb(2), dp)*dr(2)/dbox(2)) + jbe = FLOOR(REAL(ng(2) - 1 + delta_lb(2), dp)*dr(2)/dbox(2)) kbs = FLOOR(REAL(delta_lb(3), dp)*dr(3)/dbox(3)) - kbe = FLOOR(REAL(ng(3)-1+delta_lb(3), dp)*dr(3)/dbox(3)) + kbe = FLOOR(REAL(ng(3) - 1 + delta_lb(3), dp)*dr(3)/dbox(3)) ! ! go over the box-list DO kb = kbs, kbe @@ -1878,36 +1878,36 @@ SUBROUTINE collocate_gauge_new(current_env, qs_env, rs_grid_x, rs_grid_y, rs_gri jbox = MODULO(jb, nbox(2)) kbox = MODULO(kb, nbox(3)) ! - is = MAX(CEILING(REAL(ib, dp)*dbox(1)/dr(1)), delta_lb(1))-delta_lb(1)+1 - ie = MIN(FLOOR(REAL(ib+1, dp)*dbox(1)/dr(1)), ng(1)-1+delta_lb(1))-delta_lb(1)+1 - js = MAX(CEILING(REAL(jb, dp)*dbox(2)/dr(2)), delta_lb(2))-delta_lb(2)+1 - je = MIN(FLOOR(REAL(jb+1, dp)*dbox(2)/dr(2)), ng(2)-1+delta_lb(2))-delta_lb(2)+1 - ks = MAX(CEILING(REAL(kb, dp)*dbox(3)/dr(3)), delta_lb(3))-delta_lb(3)+1 - ke = MIN(FLOOR(REAL(kb+1, dp)*dbox(3)/dr(3)), ng(3)-1+delta_lb(3))-delta_lb(3)+1 + is = MAX(CEILING(REAL(ib, dp)*dbox(1)/dr(1)), delta_lb(1)) - delta_lb(1) + 1 + ie = MIN(FLOOR(REAL(ib + 1, dp)*dbox(1)/dr(1)), ng(1) - 1 + delta_lb(1)) - delta_lb(1) + 1 + js = MAX(CEILING(REAL(jb, dp)*dbox(2)/dr(2)), delta_lb(2)) - delta_lb(2) + 1 + je = MIN(FLOOR(REAL(jb + 1, dp)*dbox(2)/dr(2)), ng(2) - 1 + delta_lb(2)) - delta_lb(2) + 1 + ks = MAX(CEILING(REAL(kb, dp)*dbox(3)/dr(3)), delta_lb(3)) - delta_lb(3) + 1 + ke = MIN(FLOOR(REAL(kb + 1, dp)*dbox(3)/dr(3)), ng(3) - 1 + delta_lb(3)) - delta_lb(3) + 1 ! ! sanity checks IF (.TRUE.) THEN - IF (REAL(ks-1+delta_lb(3), dp)*dr(3) .LT. REAL(kb, dp)*dbox(3) .OR. & - REAL(ke-1+delta_lb(3), dp)*dr(3) .GT. REAL(kb+1, dp)*dbox(3)) THEN - WRITE (*, *) 'box_k', REAL(kb, dp)*dbox(3), REAL(kb+1, dp)*dbox(3) - WRITE (*, *) 'point_k', REAL(ks-1+delta_lb(3), dp)*dr(3), REAL(ke-1+delta_lb(3), dp)*dr(3) + IF (REAL(ks - 1 + delta_lb(3), dp)*dr(3) .LT. REAL(kb, dp)*dbox(3) .OR. & + REAL(ke - 1 + delta_lb(3), dp)*dr(3) .GT. REAL(kb + 1, dp)*dbox(3)) THEN + WRITE (*, *) 'box_k', REAL(kb, dp)*dbox(3), REAL(kb + 1, dp)*dbox(3) + WRITE (*, *) 'point_k', REAL(ks - 1 + delta_lb(3), dp)*dr(3), REAL(ke - 1 + delta_lb(3), dp)*dr(3) WRITE (*, *) 'ibox', ibox, 'jbox', jbox, 'kbox', kbox WRITE (*, *) 'is,ie', is, ie, ' js,je', js, je, ' ks,ke', ks, ke WRITE (*, *) 'ibs,ibe', ibs, ibe, ' jbs,jbe', jbs, jbe, ' kbs,kbe', kbs, kbe CPABORT("we stop_k") ENDIF - IF (REAL(js-1+delta_lb(2), dp)*dr(2) .LT. REAL(jb, dp)*dbox(2) .OR. & - REAL(je-1+delta_lb(2), dp)*dr(2) .GT. REAL(jb+1, dp)*dbox(2)) THEN - WRITE (*, *) 'box_j', REAL(jb, dp)*dbox(2), REAL(jb+1, dp)*dbox(2) - WRITE (*, *) 'point_j', REAL(js-1+delta_lb(2), dp)*dr(2), REAL(je-1+delta_lb(2), dp)*dr(2) + IF (REAL(js - 1 + delta_lb(2), dp)*dr(2) .LT. REAL(jb, dp)*dbox(2) .OR. & + REAL(je - 1 + delta_lb(2), dp)*dr(2) .GT. REAL(jb + 1, dp)*dbox(2)) THEN + WRITE (*, *) 'box_j', REAL(jb, dp)*dbox(2), REAL(jb + 1, dp)*dbox(2) + WRITE (*, *) 'point_j', REAL(js - 1 + delta_lb(2), dp)*dr(2), REAL(je - 1 + delta_lb(2), dp)*dr(2) WRITE (*, *) 'is,ie', is, ie, ' js,je', js, je, ' ks,ke', ks, ke WRITE (*, *) 'ibs,ibe', ibs, ibe, ' jbs,jbe', jbs, jbe, ' kbs,kbe', kbs, kbe CPABORT("we stop_j") ENDIF - IF (REAL(is-1+delta_lb(1), dp)*dr(1) .LT. REAL(ib, dp)*dbox(1) .OR. & - REAL(ie-1+delta_lb(1), dp)*dr(1) .GT. REAL(ib+1, dp)*dbox(1)) THEN - WRITE (*, *) 'box_i', REAL(ib, dp)*dbox(1), REAL(ib+1, dp)*dbox(1) - WRITE (*, *) 'point_i', REAL(is-1+delta_lb(1), dp)*dr(1), REAL(ie-1+delta_lb(1), dp)*dr(1) + IF (REAL(is - 1 + delta_lb(1), dp)*dr(1) .LT. REAL(ib, dp)*dbox(1) .OR. & + REAL(ie - 1 + delta_lb(1), dp)*dr(1) .GT. REAL(ib + 1, dp)*dbox(1)) THEN + WRITE (*, *) 'box_i', REAL(ib, dp)*dbox(1), REAL(ib + 1, dp)*dbox(1) + WRITE (*, *) 'point_i', REAL(is - 1 + delta_lb(1), dp)*dr(1), REAL(ie - 1 + delta_lb(1), dp)*dr(1) WRITE (*, *) 'is,ie', is, ie, ' js,je', js, je, ' ks,ke', ks, ke WRITE (*, *) 'ibs,ibe', ibs, ibe, ' jbs,jbe', jbs, jbe, ' kbs,kbe', kbs, kbe CPABORT("we stop_i") @@ -1915,9 +1915,9 @@ SUBROUTINE collocate_gauge_new(current_env, qs_env, rs_grid_x, rs_grid_y, rs_gri ENDIF ! ! the center of the box - box_center(1) = (REAL(ibox, dp)+0.5_dp)*dbox(1) - box_center(2) = (REAL(jbox, dp)+0.5_dp)*dbox(2) - box_center(3) = (REAL(kbox, dp)+0.5_dp)*dbox(3) + box_center(1) = (REAL(ibox, dp) + 0.5_dp)*dbox(1) + box_center(2) = (REAL(jbox, dp) + 0.5_dp)*dbox(2) + box_center(3) = (REAL(kbox, dp) + 0.5_dp)*dbox(3) ! ! find the atoms that are in the overlaping boxes natms_local0 = box(ibox, jbox, kbox)%n @@ -1930,28 +1930,28 @@ SUBROUTINE collocate_gauge_new(current_env, qs_env, rs_grid_x, rs_grid_y, rs_gri DO k = ks, ke DO j = js, je DO i = is, ie - point(1) = REAL(i-1+delta_lb(1), dp)*dr(1) - point(2) = REAL(j-1+delta_lb(2), dp)*dr(2) - point(3) = REAL(k-1+delta_lb(3), dp)*dr(3) + point(1) = REAL(i - 1 + delta_lb(1), dp)*dr(1) + point(2) = REAL(j - 1 + delta_lb(2), dp)*dr(2) + point(3) = REAL(k - 1 + delta_lb(3), dp)*dr(3) point = pbc(point, cell) ! ! compute atom-point distances natms_local1 = 0 DO iatom = 1, natms_local0 - r(:) = pbc(r_ptr(:, iatom)-point(:), cell)+point(:) !needed? - dist = (r(1)-point(1))**2+(r(2)-point(2))**2+(r(3)-point(3))**2 + r(:) = pbc(r_ptr(:, iatom) - point(:), cell) + point(:) !needed? + dist = (r(1) - point(1))**2 + (r(2) - point(2))**2 + (r(3) - point(3))**2 IF (dist .LT. gauge_atom_radius**2) THEN - natms_local1 = natms_local1+1 + natms_local1 = natms_local1 + 1 ratom(:, natms_local1) = r(:) ! ! compute the distance atoms-point - x = point(1)-r(1) - y = point(2)-r(2) - z = point(3)-r(3) + x = point(1) - r(1) + y = point(2) - r(2) + z = point(3) - r(3) atms_pnt(1, natms_local1) = x atms_pnt(2, natms_local1) = y atms_pnt(3, natms_local1) = z - nrm_atms_pnt(natms_local1) = SQRT(x*x+y*y+z*z) + nrm_atms_pnt(natms_local1) = SQRT(x*x + y*y + z*z) ENDIF ENDDO ! @@ -1968,16 +1968,16 @@ SUBROUTINE collocate_gauge_new(current_env, qs_env, rs_grid_x, rs_grid_y, rs_gri DO jatom = 1, natms_local1 IF (iatom .EQ. jatom) CYCLE pb = nrm_atms_pnt(jatom) - x = pra(1)-atms_pnt(1, jatom) - y = pra(2)-atms_pnt(2, jatom) - z = pra(3)-atms_pnt(3, jatom) - ab = SQRT(x*x+y*y+z*z) + x = pra(1) - atms_pnt(1, jatom) + y = pra(2) - atms_pnt(2, jatom) + z = pra(3) - atms_pnt(3, jatom) + ab = SQRT(x*x + y*y + z*z) ! - tmp = (pa-pb)/ab - tmp = 0.5_dp*(3.0_dp-tmp*tmp)*tmp - tmp = 0.5_dp*(3.0_dp-tmp*tmp)*tmp - tmp = 0.5_dp*(3.0_dp-tmp*tmp)*tmp - buf_tmp = buf_tmp*0.5_dp*(1.0_dp-tmp) + tmp = (pa - pb)/ab + tmp = 0.5_dp*(3.0_dp - tmp*tmp)*tmp + tmp = 0.5_dp*(3.0_dp - tmp*tmp)*tmp + tmp = 0.5_dp*(3.0_dp - tmp*tmp)*tmp + buf_tmp = buf_tmp*0.5_dp*(1.0_dp - tmp) ENDDO buf(iatom) = buf_tmp ENDDO @@ -1986,17 +1986,17 @@ SUBROUTINE collocate_gauge_new(current_env, qs_env, rs_grid_x, rs_grid_y, rs_gri res(3) = 0.0_dp summe = 0.0_dp DO iatom = 1, natms_local1 - res(1) = res(1)+ratom(1, iatom)*buf(iatom) - res(2) = res(2)+ratom(2, iatom)*buf(iatom) - res(3) = res(3)+ratom(3, iatom)*buf(iatom) - summe = summe+buf(iatom) + res(1) = res(1) + ratom(1, iatom)*buf(iatom) + res(2) = res(2) + ratom(2, iatom)*buf(iatom) + res(3) = res(3) + ratom(3, iatom)*buf(iatom) + summe = summe + buf(iatom) ENDDO res(1) = res(1)/summe res(2) = res(2)/summe res(3) = res(3)/summe - grid_x(i, j, k) = point(1)-res(1) - grid_y(i, j, k) = point(2)-res(2) - grid_z(i, j, k) = point(3)-res(3) + grid_x(i, j, k) = point(1) - res(1) + grid_y(i, j, k) = point(2) - res(2) + grid_z(i, j, k) = point(3) - res(3) ELSE grid_x(i, j, k) = 0.0_dp grid_y(i, j, k) = 0.0_dp @@ -2163,8 +2163,8 @@ SUBROUTINE current_build_chi_many_centers(current_env, qs_env, iB) max_states = 0 DO ispin = 1, nspins DO icenter = 1, nbr_center(ispin) - max_states = MAX(max_states, center_list(ispin)%array(1, icenter+1)& - & -center_list(ispin)%array(1, icenter)) + max_states = MAX(max_states, center_list(ispin)%array(1, icenter + 1)& + & - center_list(ispin)%array(1, icenter)) ENDDO ENDDO ! @@ -2302,9 +2302,9 @@ SUBROUTINE current_build_chi_many_centers(current_env, qs_env, iB) CALL cp_fm_set_all(psi_D, 0.0_dp) CALL cp_fm_set_all(psi_p1, 0.0_dp) CALL cp_fm_set_all(psi_p2, 0.0_dp) - nstate_loc = center_list(ispin)%array(1, icenter+1)-center_list(ispin)%array(1, icenter) + nstate_loc = center_list(ispin)%array(1, icenter + 1) - center_list(ispin)%array(1, icenter) jstate = 1 - DO j = center_list(ispin)%array(1, icenter), center_list(ispin)%array(1, icenter+1)-1 + DO j = center_list(ispin)%array(1, icenter), center_list(ispin)%array(1, icenter + 1) - 1 istate = center_list(ispin)%array(2, j) ! ! block the states that belong to this center @@ -2317,7 +2317,7 @@ SUBROUTINE current_build_chi_many_centers(current_env, qs_env, iB) CALL cp_fm_to_fm(psi1_p(ispin, iiB)%matrix, psi_p1, 1, istate, jstate) CALL cp_fm_to_fm(psi1_p(ispin, iiiB)%matrix, psi_p2, 1, istate, jstate) ! - jstate = jstate+1 + jstate = jstate + 1 ENDDO ! istate ! ! scale the ordered mos @@ -2370,22 +2370,22 @@ SUBROUTINE current_build_chi_many_centers(current_env, qs_env, iB) ! the factor 2 should be already included in the matrix elements contrib = 0.0_dp CALL cp_fm_trace(psi0, rr_rxp(ii, iii)%matrix, contrib) - chi_tmp = chi_tmp+2.0_dp*contrib + chi_tmp = chi_tmp + 2.0_dp*contrib ! contrib = 0.0_dp CALL cp_fm_trace(psi0, rr_rxp(iii, ii)%matrix, contrib) - chi_tmp = chi_tmp-2.0_dp*contrib + chi_tmp = chi_tmp - 2.0_dp*contrib ! ! correction: dk_ii*2[C0| d_iii(C1(rxp-D))] - dk_iii*2[C0| d_ii(C1(rxp-D))] ! factor 2 not included in the matrix elements contrib = 0.0_dp CALL cp_fm_trace(psi0, p_rxp(iii)%matrix, contrib) - IF (.NOT. chi_pbc) chi_tmp = chi_tmp+2.0_dp*dk(ii)*contrib - int_current_tmp = int_current_tmp+2.0_dp*contrib + IF (.NOT. chi_pbc) chi_tmp = chi_tmp + 2.0_dp*dk(ii)*contrib + int_current_tmp = int_current_tmp + 2.0_dp*contrib ! contrib2 = 0.0_dp CALL cp_fm_trace(psi0, p_rxp(ii)%matrix, contrib2) - IF (.NOT. chi_pbc) chi_tmp = chi_tmp-2.0_dp*dk(iii)*contrib2 + IF (.NOT. chi_pbc) chi_tmp = chi_tmp - 2.0_dp*dk(iii)*contrib2 ! ! term: -2[C0| (r-dk)_ii (r-dk)_iiB | d_iii(C1(piiiB))] \ ! +2[C0| (r-dk)_iii (r-dk)_iiB | d_ii(C1(piiiB))] @@ -2393,21 +2393,21 @@ SUBROUTINE current_build_chi_many_centers(current_env, qs_env, iB) contrib = 0.0_dp idir2 = ind_m2(ii, iiB) CALL cp_fm_trace(psi0, rr_p2(idir2, iii)%matrix, contrib) - chi_tmp = chi_tmp-2.0_dp*contrib + chi_tmp = chi_tmp - 2.0_dp*contrib contrib2 = 0.0_dp IF (iiB == iii) THEN CALL cp_fm_trace(psi0, r_p2(ii)%matrix, contrib2) - chi_tmp = chi_tmp-contrib2 + chi_tmp = chi_tmp - contrib2 ENDIF ! contrib = 0.0_dp idir2 = ind_m2(iii, iiB) CALL cp_fm_trace(psi0, rr_p2(idir2, ii)%matrix, contrib) - chi_tmp = chi_tmp+2.0_dp*contrib + chi_tmp = chi_tmp + 2.0_dp*contrib contrib2 = 0.0_dp IF (iiB == ii) THEN CALL cp_fm_trace(psi0, r_p2(iii)%matrix, contrib2) - chi_tmp = chi_tmp+contrib2 + chi_tmp = chi_tmp + contrib2 ENDIF ! ! correction: -dk_ii * 2[C0|(r-dk)_iiB | d_iii(C1(piiiB))] \ @@ -2416,12 +2416,12 @@ SUBROUTINE current_build_chi_many_centers(current_env, qs_env, iB) ! no additional correction terms because of the orthogonality between C0 and C1 contrib = 0.0_dp CALL cp_fm_trace(psi0, rr_p2(iiB, iii)%matrix, contrib) - IF (.NOT. chi_pbc) chi_tmp = chi_tmp-2.0_dp*dk(ii)*contrib - int_current_tmp = int_current_tmp-2.0_dp*contrib + IF (.NOT. chi_pbc) chi_tmp = chi_tmp - 2.0_dp*dk(ii)*contrib + int_current_tmp = int_current_tmp - 2.0_dp*contrib ! contrib2 = 0.0_dp CALL cp_fm_trace(psi0, rr_p2(iiB, ii)%matrix, contrib2) - IF (.NOT. chi_pbc) chi_tmp = chi_tmp+2.0_dp*dk(iii)*contrib2 + IF (.NOT. chi_pbc) chi_tmp = chi_tmp + 2.0_dp*dk(iii)*contrib2 ! ! term: +2[C0| (r-dk)_ii (r-dk)_iiiB | d_iii(C1(piiB))] \ ! -2[C0| (r-dk)_iii (r-dk)_iiiB | d_ii(C1(piiB))] @@ -2429,21 +2429,21 @@ SUBROUTINE current_build_chi_many_centers(current_env, qs_env, iB) contrib = 0.0_dp idir2 = ind_m2(ii, iiiB) CALL cp_fm_trace(psi0, rr_p1(idir2, iii)%matrix, contrib) - chi_tmp = chi_tmp+2.0_dp*contrib + chi_tmp = chi_tmp + 2.0_dp*contrib contrib2 = 0.0_dp IF (iiiB == iii) THEN CALL cp_fm_trace(psi0, r_p1(ii)%matrix, contrib2) - chi_tmp = chi_tmp+contrib2 + chi_tmp = chi_tmp + contrib2 ENDIF ! contrib = 0.0_dp idir2 = ind_m2(iii, iiiB) CALL cp_fm_trace(psi0, rr_p1(idir2, ii)%matrix, contrib) - chi_tmp = chi_tmp-2.0_dp*contrib + chi_tmp = chi_tmp - 2.0_dp*contrib contrib2 = 0.0_dp IF (iiiB == ii) THEN CALL cp_fm_trace(psi0, r_p1(iii)%matrix, contrib2) - chi_tmp = chi_tmp-contrib2 + chi_tmp = chi_tmp - contrib2 ENDIF ! ! correction: +dk_ii * 2[C0|(r-dk)_iiiB | d_iii(C1(piiB))] +\ @@ -2451,22 +2451,22 @@ SUBROUTINE current_build_chi_many_centers(current_env, qs_env, iB) ! the factor 2 should be already included in the matrix elements contrib = 0.0_dp CALL cp_fm_trace(psi0, rr_p1(iiiB, iii)%matrix, contrib) - IF (.NOT. chi_pbc) chi_tmp = chi_tmp+2.0_dp*dk(ii)*contrib - int_current_tmp = int_current_tmp+2.0_dp*contrib + IF (.NOT. chi_pbc) chi_tmp = chi_tmp + 2.0_dp*dk(ii)*contrib + int_current_tmp = int_current_tmp + 2.0_dp*contrib ! contrib2 = 0.0_dp CALL cp_fm_trace(psi0, rr_p1(iiiB, ii)%matrix, contrib2) - IF (.NOT. chi_pbc) chi_tmp = chi_tmp-2.0_dp*dk(iii)*contrib2 + IF (.NOT. chi_pbc) chi_tmp = chi_tmp - 2.0_dp*dk(iii)*contrib2 ! ! accumulate - chi(idir) = chi(idir)+maxocc*chi_tmp - int_current(iii) = int_current(iii)+int_current_tmp + chi(idir) = chi(idir) + maxocc*chi_tmp + int_current(iii) = int_current(iii) + int_current_tmp ENDDO ! idir ENDDO ! icenter ! DO idir = 1, 3 - current_env%chi_tensor(idir, iB, ispin) = current_env%chi_tensor(idir, iB, ispin)+ & + current_env%chi_tensor(idir, iB, ispin) = current_env%chi_tensor(idir, iB, ispin) + & chi(idir) IF (output_unit > 0) THEN !WRITE(output_unit,'(A,E12.6)') ' chi_'//ACHAR(119+idir)//ACHAR(119+iB)//& @@ -2700,7 +2700,7 @@ SUBROUTINE current_build_chi_one_center(current_env, qs_env, iB) DO kdir = 1, 3 IF (Levi_Civita(kdir, jdir, idir) .EQ. 0.0_dp) CYCLE CALL cp_fm_trace(buf, psi1_rxp(ispin, iB)%matrix, contrib) - chi(kdir) = chi(kdir)-Levi_Civita(kdir, jdir, idir)*2.0_dp*dk(jdir)*contrib + chi(kdir) = chi(kdir) - Levi_Civita(kdir, jdir, idir)*2.0_dp*dk(jdir)*contrib ENDDO ENDDO ENDIF @@ -2720,7 +2720,7 @@ SUBROUTINE current_build_chi_one_center(current_env, qs_env, iB) DO kdir = 1, 3 IF (Levi_Civita(kdir, jdir, idir) .EQ. 0.0_dp) CYCLE CALL cp_fm_trace(buf, psi1_rxp(ispin, iB)%matrix, contrib) - chi(kdir) = chi(kdir)-Levi_Civita(kdir, jdir, idir)*2.0_dp*contrib + chi(kdir) = chi(kdir) - Levi_Civita(kdir, jdir, idir)*2.0_dp*contrib ENDDO ! IF (.NOT. chi_pbc) THEN @@ -2729,7 +2729,7 @@ SUBROUTINE current_build_chi_one_center(current_env, qs_env, iB) DO kdir = 1, 3 IF (Levi_Civita(kdir, jjdir, idir) .EQ. 0.0_dp) CYCLE CALL cp_fm_trace(buf, psi1_p(ispin, iiiB)%matrix, contrib) - chi(kdir) = chi(kdir)+Levi_Civita(kdir, jjdir, idir)*2.0_dp*dk(jjdir)*contrib + chi(kdir) = chi(kdir) + Levi_Civita(kdir, jjdir, idir)*2.0_dp*dk(jjdir)*contrib ENDDO ENDDO ENDIF @@ -2739,7 +2739,7 @@ SUBROUTINE current_build_chi_one_center(current_env, qs_env, iB) DO kdir = 1, 3 IF (Levi_Civita(kdir, jjdir, idir) .EQ. 0.0_dp) CYCLE CALL cp_fm_trace(buf, psi1_p(ispin, iiB)%matrix, contrib) - chi(kdir) = chi(kdir)-Levi_Civita(kdir, jjdir, idir)*2.0_dp*dk(jjdir)*contrib + chi(kdir) = chi(kdir) - Levi_Civita(kdir, jjdir, idir)*2.0_dp*dk(jjdir)*contrib ENDDO ENDDO ENDIF @@ -2760,7 +2760,7 @@ SUBROUTINE current_build_chi_one_center(current_env, qs_env, iB) DO kdir = 1, 3 IF (Levi_Civita(kdir, jdir, idir) .EQ. 0.0_dp) CYCLE CALL cp_fm_trace(buf, psi1_p(ispin, iiiB)%matrix, contrib) - chi(kdir) = chi(kdir)+Levi_Civita(kdir, jdir, idir)*2.0_dp*contrib + chi(kdir) = chi(kdir) + Levi_Civita(kdir, jdir, idir)*2.0_dp*contrib ENDDO ! CALL cp_dbcsr_sm_fm_multiply(op_mom_der_ao(ind_m2(jdir, iiiB), idir)%matrix, mo_coeff, & @@ -2768,7 +2768,7 @@ SUBROUTINE current_build_chi_one_center(current_env, qs_env, iB) DO kdir = 1, 3 IF (Levi_Civita(kdir, jdir, idir) .EQ. 0.0_dp) CYCLE CALL cp_fm_trace(buf, psi1_p(ispin, iiB)%matrix, contrib) - chi(kdir) = chi(kdir)-Levi_Civita(kdir, jdir, idir)*2.0_dp*contrib + chi(kdir) = chi(kdir) - Levi_Civita(kdir, jdir, idir)*2.0_dp*contrib ENDDO ENDDO ! @@ -2786,7 +2786,7 @@ SUBROUTINE current_build_chi_one_center(current_env, qs_env, iB) IF (Levi_Civita(kdir, idir, jdir) .EQ. 0.0_dp) CYCLE IF (iiB == jdir) THEN CALL cp_fm_trace(buf, psi1_p(ispin, iiiB)%matrix, contrib) - chi(kdir) = chi(kdir)+Levi_Civita(kdir, idir, jdir)*contrib + chi(kdir) = chi(kdir) + Levi_Civita(kdir, idir, jdir)*contrib ENDIF ENDDO ENDDO @@ -2796,7 +2796,7 @@ SUBROUTINE current_build_chi_one_center(current_env, qs_env, iB) IF (Levi_Civita(kdir, idir, jdir) .EQ. 0.0_dp) CYCLE IF (iiiB == jdir) THEN CALL cp_fm_trace(buf, psi1_p(ispin, iiB)%matrix, contrib) - chi(kdir) = chi(kdir)-Levi_Civita(kdir, idir, jdir)*contrib + chi(kdir) = chi(kdir) - Levi_Civita(kdir, idir, jdir)*contrib ENDIF ! ENDDO @@ -2808,7 +2808,7 @@ SUBROUTINE current_build_chi_one_center(current_env, qs_env, iB) ENDDO ! idir ! DO idir = 1, 3 - current_env%chi_tensor(idir, iB, ispin) = current_env%chi_tensor(idir, iB, ispin)+ & + current_env%chi_tensor(idir, iB, ispin) = current_env%chi_tensor(idir, iB, ispin) + & maxocc*chi(idir) IF (output_unit > 0) THEN !WRITE(output_unit,'(A,E12.6)') ' chi_'//ACHAR(119+idir)//ACHAR(119+iB)//& diff --git a/src/qs_linres_current_utils.F b/src/qs_linres_current_utils.F index 3950a9dd75..ddd37bb1d6 100644 --- a/src/qs_linres_current_utils.F +++ b/src/qs_linres_current_utils.F @@ -306,7 +306,7 @@ SUBROUTINE current_response(current_env, p_env, qs_env) DO idir = 1, 3 IF (should_stop) EXIT IF (output_unit > 0) THEN - WRITE (output_unit, "(T10,A)") "Response to the perturbation operator P_"//ACHAR(idir+119) + WRITE (output_unit, "(T10,A)") "Response to the perturbation operator P_"//ACHAR(idir + 119) ENDIF ! ! Initial guess for psi1 @@ -345,7 +345,7 @@ SUBROUTINE current_response(current_env, p_env, qs_env) DO idir = 1, 3 IF (should_stop) EXIT IF (output_unit > 0) THEN - WRITE (output_unit, "(T10,A)") "Response to the perturbation operator L_"//ACHAR(idir+119) + WRITE (output_unit, "(T10,A)") "Response to the perturbation operator L_"//ACHAR(idir + 119) ENDIF ! ! Initial guess for psi1 @@ -433,7 +433,7 @@ SUBROUTINE current_response(current_env, p_env, qs_env) IF (output_unit > 0) THEN WRITE (output_unit, "(T10,A,I4,A)")& & "Response to the perturbation operator (dk-dl)xp for -state- ", & - icenter, " in dir. "//ACHAR(idir+119) + icenter, " in dir. "//ACHAR(idir + 119) ENDIF ! DO ispin = 1, nspins @@ -461,7 +461,7 @@ SUBROUTINE current_response(current_env, p_env, qs_env) DO jcenter = 1, nbr_center(ispin) dl(1:3) = centers_set(ispin)%array(1:3, jcenter) dkl = pbc(dl, dk, cell) - DO j = center_list(ispin)%array(1, jcenter), center_list(ispin)%array(1, jcenter+1)-1 + DO j = center_list(ispin)%array(1, jcenter), center_list(ispin)%array(1, jcenter + 1) - 1 jstate = center_list(ispin)%array(2, j) dkl_vec_ii(jstate) = dkl(ii) dkl_vec_iii(jstate) = dkl(iii) @@ -514,7 +514,7 @@ SUBROUTINE current_response(current_env, p_env, qs_env) ! ! need to reset those guys ist_true = statetrueindex(idir, icenter, ispin) - DO i = center_list(ispin)%array(1, ist_true), center_list(ispin)%array(1, ist_true+1)-1 + DO i = center_list(ispin)%array(1, ist_true), center_list(ispin)%array(1, ist_true + 1) - 1 istate = center_list(ispin)%array(2, i) ! ! the optimized wfns are copied in the fm @@ -790,15 +790,15 @@ SUBROUTINE current_env_init(current_env, qs_env) r(:) = pbc(localized_wfn_control%centers_set(ispin)%array(:, istate), cell) IF (r(1) .LT. 0.0_dp) THEN localized_wfn_control%centers_set(ispin)%array(1, istate) = & - r(1)+cell%hmat(1, 1) + r(1) + cell%hmat(1, 1) ENDIF IF (r(2) .LT. 0.0_dp) THEN localized_wfn_control%centers_set(ispin)%array(2, istate) = & - r(2)+cell%hmat(2, 2) + r(2) + cell%hmat(2, 2) ENDIF IF (r(3) .LT. 0.0_dp) THEN localized_wfn_control%centers_set(ispin)%array(3, istate) = & - r(3)+cell%hmat(3, 3) + r(3) + cell%hmat(3, 3) ENDIF ENDDO ENDDO @@ -826,11 +826,11 @@ SUBROUTINE current_env_init(current_env, qs_env) CALL section_vals_val_get(current_section, "SELECTED_STATES_ON_ATOM_LIST", & i_rep_val=ir, i_vals=list) IF (ASSOCIATED(list)) THEN - CALL reallocate(current_env%selected_states_on_atom_list, 1, n+SIZE(list)) + CALL reallocate(current_env%selected_states_on_atom_list, 1, n + SIZE(list)) DO ini = 1, SIZE(list) - current_env%selected_states_on_atom_list(ini+n) = list(ini) + current_env%selected_states_on_atom_list(ini + n) = list(ini) ENDDO - n = n+SIZE(list) + n = n + SIZE(list) ENDIF ENDDO ! @@ -843,14 +843,14 @@ SUBROUTINE current_env_init(current_env, qs_env) DO istate = 1, SIZE(center_array, 2) DO i = 1, SIZE(selected_states_on_atom_list, 1) iatom = selected_states_on_atom_list(i) - r(:) = pbc(center_array(1:3, istate)-particle_set(iatom)%r(:), cell) + r(:) = pbc(center_array(1:3, istate) - particle_set(iatom)%r(:), cell) ! SQRT(DOT_PRODUCT(r, r)) .LE. current_env%selected_states_atom_radius IF ((DOT_PRODUCT(r, r)) .LE. (current_env%selected_states_atom_radius & *current_env%selected_states_atom_radius)) & THEN ! ! add the state to the list - nstate = nstate+1 + nstate = nstate + 1 state_list(nstate, ispin) = istate EXIT ENDIF @@ -863,7 +863,7 @@ SUBROUTINE current_env_init(current_env, qs_env) center_array => localized_wfn_control%centers_set(ispin)%array nstate = 0 DO istate = 1, SIZE(center_array, 2) - nstate = nstate+1 + nstate = nstate + 1 state_list(nstate, ispin) = istate ENDDO nstate_list(ispin) = nstate @@ -877,7 +877,7 @@ SUBROUTINE current_env_init(current_env, qs_env) nstate = nstate_list(ispin) current_env%nstates(ispin) = nstate ! - ALLOCATE (current_env%center_list(ispin)%array(2, nstate+1), & + ALLOCATE (current_env%center_list(ispin)%array(2, nstate + 1), & current_env%centers_set(ispin)%array(3, nstate)) current_env%center_list(ispin)%array(:, :) = HUGE(0) current_env%centers_set(ispin)%array(:, :) = HUGE(0.0_dp) @@ -896,7 +896,7 @@ SUBROUTINE current_env_init(current_env, qs_env) current_env%center_list(ispin)%array(1, is) = is current_env%center_list(ispin)%array(2, is) = istate ENDDO - current_env%center_list(ispin)%array(1, nstate+1) = nstate+1 + current_env%center_list(ispin)%array(1, nstate + 1) = nstate + 1 ! CASE (current_orb_center_common) ! @@ -904,7 +904,7 @@ SUBROUTINE current_env_init(current_env, qs_env) current_env%centers_set(ispin)%array(:, 1) = common_center(:) current_env%nbr_center(ispin) = 1 current_env%center_list(ispin)%array(1, 1) = 1 - current_env%center_list(ispin)%array(1, 2) = nstate+1 + current_env%center_list(ispin)%array(1, 2) = nstate + 1 DO is = 1, nstate istate = state_list(is, ispin) current_env%center_list(ispin)%array(2, is) = istate @@ -922,7 +922,7 @@ SUBROUTINE current_env_init(current_env, qs_env) DO iatom = 1, natom r = pbc(particle_set(iatom)%r(:), cell) rab = pbc(r, center_array(1:3, istate), cell) - dist = SQRT(rab(1)**2+rab(2)**2+rab(3)**2) + dist = SQRT(rab(1)**2 + rab(2)**2 + rab(3)**2) IF (dist .LT. mdist) THEN buff(is) = iatom mdist = dist @@ -939,8 +939,8 @@ SUBROUTINE current_env_init(current_env, qs_env) DO is = 1, nstate istate = state_list(is, ispin) IF (buff(is) .EQ. iatom) THEN - j = j+1 - i = i+1 + j = j + 1 + i = i + 1 is0 = .FALSE. current_env%center_list(ispin)%array(2, i) = istate ENDIF @@ -949,14 +949,14 @@ SUBROUTINE current_env_init(current_env, qs_env) IF (output_unit > 0) THEN WRITE (output_unit, '(T2,A,I6,A,I6)') 'clustering ', j, ' center(s) on atom ', iatom ENDIF - current_env%center_list(ispin)%array(1, ii+1) = & - current_env%center_list(ispin)%array(1, ii)+j + current_env%center_list(ispin)%array(1, ii + 1) = & + current_env%center_list(ispin)%array(1, ii) + j current_env%centers_set(ispin)%array(:, ii) = & pbc(particle_set(iatom)%r, cell) - ii = ii+1 + ii = ii + 1 ENDIF ENDDO - current_env%nbr_center(ispin) = ii-1 + current_env%nbr_center(ispin) = ii - 1 ! DEALLOCATE (buff) CASE (current_orb_center_box) @@ -971,10 +971,10 @@ SUBROUTINE current_env_init(current_env, qs_env) DO iz = 1, nbox(3) DO iy = 1, nbox(2) DO ix = 1, nbox(1) - rbuff(1, ibox) = cell%hmat(1, 1)*((REAL(ix, dp)-0.5_dp)/REAL(nbox(1), dp)-0.5_dp) - rbuff(2, ibox) = cell%hmat(2, 2)*((REAL(iy, dp)-0.5_dp)/REAL(nbox(2), dp)-0.5_dp) - rbuff(3, ibox) = cell%hmat(3, 3)*((REAL(iz, dp)-0.5_dp)/REAL(nbox(3), dp)-0.5_dp) - ibox = ibox+1 + rbuff(1, ibox) = cell%hmat(1, 1)*((REAL(ix, dp) - 0.5_dp)/REAL(nbox(1), dp) - 0.5_dp) + rbuff(2, ibox) = cell%hmat(2, 2)*((REAL(iy, dp) - 0.5_dp)/REAL(nbox(2), dp) - 0.5_dp) + rbuff(3, ibox) = cell%hmat(3, 3)*((REAL(iz, dp) - 0.5_dp)/REAL(nbox(3), dp) - 0.5_dp) + ibox = ibox + 1 ENDDO ENDDO ENDDO @@ -984,7 +984,7 @@ SUBROUTINE current_env_init(current_env, qs_env) mdist = HUGE(0.0_dp) DO ibox = 1, nbr_box rab(:) = pbc(rbuff(:, ibox), center_array(1:3, istate), cell) - dist = SQRT(rab(1)**2+rab(2)**2+rab(3)**2) + dist = SQRT(rab(1)**2 + rab(2)**2 + rab(3)**2) IF (dist .LT. mdist) THEN buff(is) = ibox mdist = dist @@ -1001,8 +1001,8 @@ SUBROUTINE current_env_init(current_env, qs_env) DO is = 1, nstate istate = state_list(is, ispin) IF (buff(is) .EQ. ibox) THEN - j = j+1 - i = i+1 + j = j + 1 + i = i + 1 is0 = .FALSE. current_env%center_list(ispin)%array(2, i) = istate ENDIF @@ -1011,13 +1011,13 @@ SUBROUTINE current_env_init(current_env, qs_env) IF (output_unit > 0) THEN WRITE (output_unit, '(T2,A,I6,A,I6)') 'clustering ', j, ' center(s) on box ', ibox ENDIF - current_env%center_list(ispin)%array(1, ii+1) = & - current_env%center_list(ispin)%array(1, ii)+j + current_env%center_list(ispin)%array(1, ii + 1) = & + current_env%center_list(ispin)%array(1, ii) + j current_env%centers_set(ispin)%array(:, ii) = rbuff(:, ibox) - ii = ii+1 + ii = ii + 1 ENDIF ENDDO - current_env%nbr_center(ispin) = ii-1 + current_env%nbr_center(ispin) = ii - 1 ! DEALLOCATE (buff, rbuff) CASE DEFAULT @@ -1046,10 +1046,10 @@ SUBROUTINE current_env_init(current_env, qs_env) jstate = 0 DO icenter = 1, current_env%nbr_center(ispin) DO i = current_env%center_list(ispin)%array(1, icenter), & - current_env%center_list(ispin)%array(1, icenter+1)-1 + current_env%center_list(ispin)%array(1, icenter + 1) - 1 ! istate = current_env%center_list(ispin)%array(2, i) - jstate = jstate+1 + jstate = jstate + 1 ! IF (current_env%do_selected_states) THEN ! this should be removed. always reorder the states ! the blocking works (so far) with all the precond except FULL_ALL @@ -1081,15 +1081,15 @@ SUBROUTINE current_env_init(current_env, qs_env) DO istate = 1, current_env%nbr_center(ispin) IF (current_env%centers_set(ispin)%array(1, istate) .LE. 0.0_dp) THEN current_env%centers_set(ispin)%array(1, istate) = & - current_env%centers_set(ispin)%array(1, istate)+cell%hmat(1, 1) + current_env%centers_set(ispin)%array(1, istate) + cell%hmat(1, 1) ENDIF IF (current_env%centers_set(ispin)%array(2, istate) .LE. 0.0_dp) THEN current_env%centers_set(ispin)%array(2, istate) = & - current_env%centers_set(ispin)%array(2, istate)+cell%hmat(2, 2) + current_env%centers_set(ispin)%array(2, istate) + cell%hmat(2, 2) ENDIF IF (current_env%centers_set(ispin)%array(3, istate) .LE. 0.0_dp) THEN current_env%centers_set(ispin)%array(3, istate) = & - current_env%centers_set(ispin)%array(3, istate)+cell%hmat(3, 3) + current_env%centers_set(ispin)%array(3, istate) + cell%hmat(3, 3) ENDIF ENDDO ENDDO @@ -1139,7 +1139,7 @@ SUBROUTINE current_env_init(current_env, qs_env) ! rab = pbc(center, center2, cell) CALL set_vecp(idir, j, k) - dist = SQRT(rab(j)*rab(j)+rab(k)*rab(k)) + dist = SQRT(rab(j)*rab(j) + rab(k)*rab(k)) ! IF (dist .LT. mdist) THEN mdist = dist @@ -1148,7 +1148,7 @@ SUBROUTINE current_env_init(current_env, qs_env) ENDIF ENDDO ! istate2 ! - icount = icount+1 + icount = icount + 1 state_done(idir, istate_next) = .TRUE. current_env%statetrueindex(idir, icount, ispin) = istate_next center(1) = current_env%centers_set(ispin)%array(1, istate_next) @@ -1170,7 +1170,7 @@ SUBROUTINE current_env_init(current_env, qs_env) ! IF (output_unit > 0) THEN WRITE (output_unit, "(T2,A,T60,A)") "CURRENT| Gauge used", & - REPEAT(' ', 20-LEN_TRIM(current_env%gauge_name))//TRIM(current_env%gauge_name) + REPEAT(' ', 20 - LEN_TRIM(current_env%gauge_name))//TRIM(current_env%gauge_name) WRITE (output_unit, "(T2,A,T79,L1)") "CURRENT| Use old gauge code", current_env%use_old_gauge_atom WRITE (output_unit, "(T2,A,T79,L1)") "CURRENT| Compute chi for PBC calculation", current_env%chi_pbc IF (current_env%gauge .EQ. current_gauge_atom) THEN @@ -1178,7 +1178,7 @@ SUBROUTINE current_env_init(current_env, qs_env) current_env%gauge_atom_radius ENDIF WRITE (output_unit, "(T2,A,T60,A)") "CURRENT| Orbital center used", & - REPEAT(' ', 20-LEN_TRIM(current_env%orb_center_name))//TRIM(current_env%orb_center_name) + REPEAT(' ', 20 - LEN_TRIM(current_env%orb_center_name))//TRIM(current_env%orb_center_name) IF (current_env%orb_center .EQ. current_orb_center_common) THEN WRITE (output_unit, "(T2,A,T50,3F10.6)") "CURRENT| Common center", common_center(1:3) ELSEIF (current_env%orb_center .EQ. current_orb_center_box) THEN @@ -1204,11 +1204,11 @@ SUBROUTINE current_env_init(current_env, qs_env) CALL section_vals_val_get(current_section,& & "PRINT%RESPONSE_FUNCTION_CUBES%CUBES_LU_BOUNDS", & i_vals=bounds) - ncubes = bounds(2)-bounds(1)+1 + ncubes = bounds(2) - bounds(1) + 1 IF (ncubes > 0) THEN ALLOCATE (current_env%list_cubes(ncubes)) DO ir = 1, ncubes - current_env%list_cubes(ir) = bounds(1)+(ir-1) + current_env%list_cubes(ir) = bounds(1) + (ir - 1) ENDDO ENDIF IF (.NOT. ASSOCIATED(current_env%list_cubes)) THEN @@ -1220,11 +1220,11 @@ SUBROUTINE current_env_init(current_env, qs_env) CALL section_vals_val_get(current_section, "PRINT%RESPONSE_FUNCTION_CUBES%CUBES_LIST", & i_rep_val=ir, i_vals=list) IF (ASSOCIATED(list)) THEN - CALL reallocate(current_env%list_cubes, 1, ncubes+SIZE(list)) + CALL reallocate(current_env%list_cubes, 1, ncubes + SIZE(list)) DO ini = 1, SIZE(list) - current_env%list_cubes(ini+ncubes) = list(ini) + current_env%list_cubes(ini + ncubes) = list(ini) ENDDO - ncubes = ncubes+SIZE(list) + ncubes = ncubes + SIZE(list) ENDIF ENDDO ! ir ENDIF @@ -1357,7 +1357,7 @@ SUBROUTINE current_env_cleanup(current_env, qs_env) NULLIFY (pw_env, rs_descs) - current_env%ref_count = current_env%ref_count-1 + current_env%ref_count = current_env%ref_count - 1 IF (current_env%ref_count == 0) THEN ! !psi0_order diff --git a/src/qs_linres_epr_nablavks.F b/src/qs_linres_epr_nablavks.F index e52e5f8084..7bf54eaf18 100644 --- a/src/qs_linres_epr_nablavks.F +++ b/src/qs_linres_epr_nablavks.F @@ -394,11 +394,11 @@ SUBROUTINE epr_nablavks(epr_env, qs_env) DO idir = 1, 3 hard_value = 0.0_dp DO iso = 1, harmonics%max_iso_not0 - hard_value = hard_value+ & - vh1_rad_h(ir, iso)*harmonics%dslm_dxyz(idir, ia, iso)+ & + hard_value = hard_value + & + vh1_rad_h(ir, iso)*harmonics%dslm_dxyz(idir, ia, iso) + & harmonics%slm(ia, iso)* & - (vh1_rad_h(ir-1, iso)-vh1_rad_h(ir, iso))/ & - (grid_atom%rad(ir-1)-grid_atom%rad(ir))* & + (vh1_rad_h(ir - 1, iso) - vh1_rad_h(ir, iso))/ & + (grid_atom%rad(ir - 1) - grid_atom%rad(ir))* & (harmonics%a(idir, ia)) END DO nablavks_vec_rad_h(idir, 1)%r_coef(ir, ia) = hard_value @@ -409,11 +409,11 @@ SUBROUTINE epr_nablavks(epr_env, qs_env) DO idir = 1, 3 soft_value = 0.0_dp DO iso = 1, harmonics%max_iso_not0 - soft_value = soft_value+ & - vh1_rad_s(ir, iso)*harmonics%dslm_dxyz(idir, ia, iso)+ & + soft_value = soft_value + & + vh1_rad_s(ir, iso)*harmonics%dslm_dxyz(idir, ia, iso) + & harmonics%slm(ia, iso)* & - (vh1_rad_s(ir-1, iso)-vh1_rad_s(ir, iso))/ & - (grid_atom%rad(ir-1)-grid_atom%rad(ir))* & + (vh1_rad_s(ir - 1, iso) - vh1_rad_s(ir, iso))/ & + (grid_atom%rad(ir - 1) - grid_atom%rad(ir))* & (harmonics%a(idir, ia)) END DO nablavks_vec_rad_s(idir, 1)%r_coef(ir, ia) = soft_value @@ -536,54 +536,54 @@ SUBROUTINE epr_nablavks(epr_env, qs_env) SELECT CASE (nexp_ppl) CASE (1) - gtemp = gtemp+ & + gtemp = gtemp + & (twopi)**(1.5_dp)/(cell%deth*(2.0_dp*alpha)**(1.5_dp))* & EXP(-v_coulomb_gspace%pw%pw_grid%gsq(ig)/(4.0_dp*alpha))*( & ! C1 +cexp_ppl(1) & ) CASE (2) - gtemp = gtemp+ & + gtemp = gtemp + & (twopi)**(1.5_dp)/(cell%deth*(2.0_dp*alpha)**(1.5_dp))* & EXP(-v_coulomb_gspace%pw%pw_grid%gsq(ig)/(4.0_dp*alpha))*( & ! C1 +cexp_ppl(1) & ! C2 - +cexp_ppl(2)/(2.0_dp*alpha)* & - (3.0_dp-v_coulomb_gspace%pw%pw_grid%gsq(ig)/(2.0_dp*alpha)) & + + cexp_ppl(2)/(2.0_dp*alpha)* & + (3.0_dp - v_coulomb_gspace%pw%pw_grid%gsq(ig)/(2.0_dp*alpha)) & ) CASE (3) - gtemp = gtemp+ & + gtemp = gtemp + & (twopi)**(1.5_dp)/(cell%deth*(2.0_dp*alpha)**(1.5_dp))* & EXP(-v_coulomb_gspace%pw%pw_grid%gsq(ig)/(4.0_dp*alpha))*( & ! C1 +cexp_ppl(1) & ! C2 - +cexp_ppl(2)/(2.0_dp*alpha)* & - (3.0_dp-v_coulomb_gspace%pw%pw_grid%gsq(ig)/(2.0_dp*alpha)) & + + cexp_ppl(2)/(2.0_dp*alpha)* & + (3.0_dp - v_coulomb_gspace%pw%pw_grid%gsq(ig)/(2.0_dp*alpha)) & ! C3 - +cexp_ppl(3)/(2.0_dp*alpha)**2* & - (15.0_dp-10.0_dp*v_coulomb_gspace%pw%pw_grid%gsq(ig)/(2.0_dp*alpha) & - +(v_coulomb_gspace%pw%pw_grid%gsq(ig)/(2.0_dp*alpha))**2) & + + cexp_ppl(3)/(2.0_dp*alpha)**2* & + (15.0_dp - 10.0_dp*v_coulomb_gspace%pw%pw_grid%gsq(ig)/(2.0_dp*alpha) & + + (v_coulomb_gspace%pw%pw_grid%gsq(ig)/(2.0_dp*alpha))**2) & ) CASE (4) - gtemp = gtemp+ & + gtemp = gtemp + & (twopi)**(1.5_dp)/(cell%deth*(2.0_dp*alpha)**(1.5_dp))* & EXP(-v_coulomb_gspace%pw%pw_grid%gsq(ig)/(4.0_dp*alpha))*( & ! C1 +cexp_ppl(1) & ! C2 - +cexp_ppl(2)/(2.0_dp*alpha)* & - (3.0_dp-v_coulomb_gspace%pw%pw_grid%gsq(ig)/(2.0_dp*alpha)) & + + cexp_ppl(2)/(2.0_dp*alpha)* & + (3.0_dp - v_coulomb_gspace%pw%pw_grid%gsq(ig)/(2.0_dp*alpha)) & ! C3 - +cexp_ppl(3)/(2.0_dp*alpha)**2* & - (15.0_dp-10.0_dp*v_coulomb_gspace%pw%pw_grid%gsq(ig)/(2.0_dp*alpha) & - +(v_coulomb_gspace%pw%pw_grid%gsq(ig)/(2.0_dp*alpha))**2) & + + cexp_ppl(3)/(2.0_dp*alpha)**2* & + (15.0_dp - 10.0_dp*v_coulomb_gspace%pw%pw_grid%gsq(ig)/(2.0_dp*alpha) & + + (v_coulomb_gspace%pw%pw_grid%gsq(ig)/(2.0_dp*alpha))**2) & ! C4 - +cexp_ppl(4)/(2.0_dp*alpha)**3* & - (105.0_dp-105.0_dp*v_coulomb_gspace%pw%pw_grid%gsq(ig)/(2.0_dp*alpha) & - +21.0_dp*(v_coulomb_gspace%pw%pw_grid%gsq(ig)/(2.0_dp*alpha))**2 & - -(v_coulomb_gspace%pw%pw_grid%gsq(ig)/(2.0_dp*alpha))**3) & + + cexp_ppl(4)/(2.0_dp*alpha)**3* & + (105.0_dp - 105.0_dp*v_coulomb_gspace%pw%pw_grid%gsq(ig)/(2.0_dp*alpha) & + + 21.0_dp*(v_coulomb_gspace%pw%pw_grid%gsq(ig)/(2.0_dp*alpha))**2 & + - (v_coulomb_gspace%pw%pw_grid%gsq(ig)/(2.0_dp*alpha))**3) & ) END SELECT @@ -592,7 +592,7 @@ SUBROUTINE epr_nablavks(epr_env, qs_env) arg = DOT_PRODUCT(v_coulomb_gspace%pw%pw_grid%g(:, ig), ratom) gtemp = gtemp*CMPLX(COS(arg), -SIN(arg), KIND=dp) - v_coulomb_gspace%pw%cc(ig) = v_coulomb_gspace%pw%cc(ig)+gtemp + v_coulomb_gspace%pw%cc(ig) = v_coulomb_gspace%pw%cc(ig) + gtemp END DO IF (v_coulomb_gspace%pw%pw_grid%have_g0) v_coulomb_gspace%pw%cc(1) = 0.0_dp @@ -644,36 +644,36 @@ SUBROUTINE epr_nablavks(epr_env, qs_env) rpoint = (/REAL(ix, dp)*pwx%pw_grid%dr(1), & REAL(iy, dp)*pwx%pw_grid%dr(2), & REAL(iz, dp)*pwx%pw_grid%dr(3)/) - rpoint = rpoint+roffset - rap = rpoint-ratom - rap(1) = MODULO(rap(1), cell%hmat(1, 1))-cell%hmat(1, 1)/2._dp - rap(2) = MODULO(rap(2), cell%hmat(2, 2))-cell%hmat(2, 2)/2._dp - rap(3) = MODULO(rap(3), cell%hmat(3, 3))-cell%hmat(3, 3)/2._dp + rpoint = rpoint + roffset + rap = rpoint - ratom + rap(1) = MODULO(rap(1), cell%hmat(1, 1)) - cell%hmat(1, 1)/2._dp + rap(2) = MODULO(rap(2), cell%hmat(2, 2)) - cell%hmat(2, 2)/2._dp + rap(3) = MODULO(rap(3), cell%hmat(3, 3)) - cell%hmat(3, 3)/2._dp sqrt_rap = SQRT(DOT_PRODUCT(rap, rap)) exp_rap = EXP(-alpha*sqrt_rap**2) sqrt_rap = MAX(sqrt_rap, 1.e-10_dp) ! d_x - pwx%cr3d(ix, iy, iz) = pwx%cr3d(ix, iy, iz)+charge*( & + pwx%cr3d(ix, iy, iz) = pwx%cr3d(ix, iy, iz) + charge*( & -2.0_dp*sqrt_alpha*EXP(-sqrt_rap**2*sqrt_alpha**2)*rap(1) & /(rootpi*sqrt_rap**2) & - +erf(sqrt_rap*sqrt_alpha)*rap(1) & + + erf(sqrt_rap*sqrt_alpha)*rap(1) & /sqrt_rap**3) ! d_y - pwy%cr3d(ix, iy, iz) = pwy%cr3d(ix, iy, iz)+charge*( & + pwy%cr3d(ix, iy, iz) = pwy%cr3d(ix, iy, iz) + charge*( & -2.0_dp*sqrt_alpha*EXP(-sqrt_rap**2*sqrt_alpha**2)*rap(2) & /(rootpi*sqrt_rap**2) & - +erf(sqrt_rap*sqrt_alpha)*rap(2) & + + erf(sqrt_rap*sqrt_alpha)*rap(2) & /sqrt_rap**3) ! d_z - pwz%cr3d(ix, iy, iz) = pwz%cr3d(ix, iy, iz)+charge*( & + pwz%cr3d(ix, iy, iz) = pwz%cr3d(ix, iy, iz) + charge*( & -2.0_dp*sqrt_alpha*EXP(-sqrt_rap**2*sqrt_alpha**2)*rap(3) & /(rootpi*sqrt_rap**2) & - +erf(sqrt_rap*sqrt_alpha)*rap(3) & + + erf(sqrt_rap*sqrt_alpha)*rap(3) & /sqrt_rap**3) IF (make_soft) CYCLE @@ -681,39 +681,39 @@ SUBROUTINE epr_nablavks(epr_env, qs_env) ! d_x DO iexp = 1, nexp_ppl - pwx%cr3d(ix, iy, iz) = pwx%cr3d(ix, iy, iz)+( & + pwx%cr3d(ix, iy, iz) = pwx%cr3d(ix, iy, iz) + ( & -2.0_dp*alpha*rap(1)*exp_rap* & - cexp_ppl(iexp)*(sqrt_rap**2)**(iexp-1)) + cexp_ppl(iexp)*(sqrt_rap**2)**(iexp - 1)) IF (iexp > 1) THEN - pwx%cr3d(ix, iy, iz) = pwx%cr3d(ix, iy, iz)+( & + pwx%cr3d(ix, iy, iz) = pwx%cr3d(ix, iy, iz) + ( & 2.0_dp*exp_rap*cexp_ppl(iexp)* & - (sqrt_rap**2)**(iexp-2)*REAL(iexp-1, dp)*rap(1)) + (sqrt_rap**2)**(iexp - 2)*REAL(iexp - 1, dp)*rap(1)) END IF END DO ! d_y DO iexp = 1, nexp_ppl - pwy%cr3d(ix, iy, iz) = pwy%cr3d(ix, iy, iz)+( & + pwy%cr3d(ix, iy, iz) = pwy%cr3d(ix, iy, iz) + ( & -2.0_dp*alpha*rap(2)*exp_rap* & - cexp_ppl(iexp)*(sqrt_rap**2)**(iexp-1)) + cexp_ppl(iexp)*(sqrt_rap**2)**(iexp - 1)) IF (iexp > 1) THEN - pwy%cr3d(ix, iy, iz) = pwy%cr3d(ix, iy, iz)+( & + pwy%cr3d(ix, iy, iz) = pwy%cr3d(ix, iy, iz) + ( & 2.0_dp*exp_rap*cexp_ppl(iexp)* & - (sqrt_rap**2)**(iexp-2)*REAL(iexp-1, dp)*rap(2)) + (sqrt_rap**2)**(iexp - 2)*REAL(iexp - 1, dp)*rap(2)) END IF END DO ! d_z DO iexp = 1, nexp_ppl - pwz%cr3d(ix, iy, iz) = pwz%cr3d(ix, iy, iz)+( & + pwz%cr3d(ix, iy, iz) = pwz%cr3d(ix, iy, iz) + ( & -2.0_dp*alpha*rap(3)*exp_rap* & - cexp_ppl(iexp)*(sqrt_rap**2)**(iexp-1)) + cexp_ppl(iexp)*(sqrt_rap**2)**(iexp - 1)) IF (iexp > 1) THEN - pwz%cr3d(ix, iy, iz) = pwz%cr3d(ix, iy, iz)+( & + pwz%cr3d(ix, iy, iz) = pwz%cr3d(ix, iy, iz) + ( & 2.0_dp*exp_rap*cexp_ppl(iexp)* & - (sqrt_rap**2)**(iexp-2)*REAL(iexp-1, dp)*rap(3)) + (sqrt_rap**2)**(iexp - 2)*REAL(iexp - 1, dp)*rap(3)) END IF END DO @@ -752,29 +752,29 @@ SUBROUTINE epr_nablavks(epr_env, qs_env) -2.0_dp*sqrt_alpha*EXP(-grid_atom%rad(ir)**2*sqrt_alpha**2) & *grid_atom%rad(ir)*harmonics%a(idir, ia) & /(rootpi*grid_atom%rad(ir)**2) & - +erf(grid_atom%rad(ir)*sqrt_alpha) & + + erf(grid_atom%rad(ir)*sqrt_alpha) & *grid_atom%rad(ir)*harmonics%a(idir, ia) & /grid_atom%rad(ir)**3) soft_value = hard_value DO iexp = 1, nexp_ppl - hard_value = hard_value+( & + hard_value = hard_value + ( & -2.0_dp*alpha*grid_atom%rad(ir)*harmonics%a(idir, ia) & - *exp_rap*cexp_ppl(iexp)*(grid_atom%rad(ir)**2)**(iexp-1)) + *exp_rap*cexp_ppl(iexp)*(grid_atom%rad(ir)**2)**(iexp - 1)) IF (iexp > 1) THEN - hard_value = hard_value+( & + hard_value = hard_value + ( & 2.0_dp*exp_rap*cexp_ppl(iexp) & - *(grid_atom%rad(ir)**2)**(iexp-2)*REAL(iexp-1, dp) & + *(grid_atom%rad(ir)**2)**(iexp - 2)*REAL(iexp - 1, dp) & *grid_atom%rad(ir)*harmonics%a(idir, ia)) END IF END DO nablavks_vec_rad_h(idir, 1)%r_coef(ir, ia) = & - nablavks_vec_rad_h(idir, 1)%r_coef(ir, ia)+hard_value + nablavks_vec_rad_h(idir, 1)%r_coef(ir, ia) + hard_value IF (make_soft) THEN nablavks_vec_rad_s(idir, 1)%r_coef(ir, ia) = & - nablavks_vec_rad_s(idir, 1)%r_coef(ir, ia)+soft_value + nablavks_vec_rad_s(idir, 1)%r_coef(ir, ia) + soft_value ELSE nablavks_vec_rad_s(idir, 1)%r_coef(ir, ia) = & - nablavks_vec_rad_s(idir, 1)%r_coef(ir, ia)+hard_value + nablavks_vec_rad_s(idir, 1)%r_coef(ir, ia) + hard_value END IF END DO @@ -828,11 +828,11 @@ SUBROUTINE epr_nablavks(epr_env, qs_env) 2.0_dp*sqrt_alpha*EXP(-grid_atom%rad(ir)**2*sqrt_alpha**2) & *grid_atom%rad(ir)*harmonics%a(idir, ia) & /(rootpi*grid_atom%rad(ir)**2) & - +erfc(grid_atom%rad(ir)*sqrt_alpha) & + + erfc(grid_atom%rad(ir)*sqrt_alpha) & *grid_atom%rad(ir)*harmonics%a(idir, ia) & /grid_atom%rad(ir)**3) nablavks_vec_rad_h(idir, 1)%r_coef(ir, ia) = & - nablavks_vec_rad_h(idir, 1)%r_coef(ir, ia)+hard_value + nablavks_vec_rad_h(idir, 1)%r_coef(ir, ia) + hard_value END DO END DO ! ia diff --git a/src/qs_linres_epr_ownutils.F b/src/qs_linres_epr_ownutils.F index 0cfced62f6..6e226420f7 100644 --- a/src/qs_linres_epr_ownutils.F +++ b/src/qs_linres_epr_ownutils.F @@ -122,7 +122,7 @@ SUBROUTINE epr_g_print(epr_env, qs_env) DO idir1 = 1, 3 DO idir2 = 1, 3 - gsum = gsum+epr_env%g_total(idir1, idir2) + gsum = gsum + epr_env%g_total(idir1, idir2) END DO END DO @@ -171,27 +171,27 @@ SUBROUTINE epr_g_print(epr_env, qs_env) " ZY=", epr_env%g_soo(3, 2), " ZZ=", epr_env%g_soo(3, 3) WRITE (unit_nr, "(T2,A)") "gmatrix_total" - WRITE (unit_nr, "(3(A,f15.10))") " XX=", epr_env%g_total(1, 1)+epr_env%g_free_factor, & + WRITE (unit_nr, "(3(A,f15.10))") " XX=", epr_env%g_total(1, 1) + epr_env%g_free_factor, & " XY=", epr_env%g_total(1, 2), " XZ=", epr_env%g_total(1, 3) WRITE (unit_nr, "(3(A,f15.10))") " YX=", epr_env%g_total(2, 1), & - " YY=", epr_env%g_total(2, 2)+epr_env%g_free_factor, " YZ=", epr_env%g_total(2, 3) + " YY=", epr_env%g_total(2, 2) + epr_env%g_free_factor, " YZ=", epr_env%g_total(2, 3) WRITE (unit_nr, "(3(A,f15.10))") " ZX=", epr_env%g_total(3, 1), & - " ZY=", epr_env%g_total(3, 2), " ZZ=", epr_env%g_total(3, 3)+epr_env%g_free_factor + " ZY=", epr_env%g_total(3, 2), " ZZ=", epr_env%g_total(3, 3) + epr_env%g_free_factor DO idir1 = 1, 3 DO idir2 = 1, 3 - g_sym(idir1, idir2) = (epr_env%g_total(idir1, idir2)+ & + g_sym(idir1, idir2) = (epr_env%g_total(idir1, idir2) + & epr_env%g_total(idir2, idir1))/2.0_dp END DO END DO WRITE (unit_nr, "(T2,A)") "gtensor_total" - WRITE (unit_nr, "(3(A,f15.10))") " XX=", g_sym(1, 1)+epr_env%g_free_factor, & + WRITE (unit_nr, "(3(A,f15.10))") " XX=", g_sym(1, 1) + epr_env%g_free_factor, & " XY=", g_sym(1, 2), " XZ=", g_sym(1, 3) WRITE (unit_nr, "(3(A,f15.10))") " YX=", g_sym(2, 1), & - " YY=", g_sym(2, 2)+epr_env%g_free_factor, " YZ=", g_sym(2, 3) + " YY=", g_sym(2, 2) + epr_env%g_free_factor, " YZ=", g_sym(2, 3) WRITE (unit_nr, "(3(A,f15.10))") " ZX=", g_sym(3, 1), & - " ZY=", g_sym(3, 2), " ZZ=", g_sym(3, 3)+epr_env%g_free_factor + " ZY=", g_sym(3, 2), " ZZ=", g_sym(3, 3) + epr_env%g_free_factor CALL diamat_all(g_sym, eigenv_g) eigenv_g(:) = eigenv_g(:)*1.0e6_dp @@ -255,9 +255,9 @@ SUBROUTINE epr_g_zke(epr_env, qs_env) ecore=epr_g_zke_temp(ispin)) END DO - epr_env%g_zke = epr_env%g_zke_factor*(epr_g_zke_temp(1)-epr_g_zke_temp(2)) + epr_env%g_zke = epr_env%g_zke_factor*(epr_g_zke_temp(1) - epr_g_zke_temp(2)) DO i1 = 1, 3 - epr_env%g_total(i1, i1) = epr_env%g_total(i1, i1)+epr_env%g_zke + epr_env%g_total(i1, i1) = epr_env%g_total(i1, i1) + epr_env%g_zke END DO IF (output_unit > 0) THEN @@ -361,8 +361,8 @@ SUBROUTINE epr_g_so(epr_env, current_env, qs_env, iB) CALL qs_rho_get(jrho1_set(idir3)%rho, rho_r=jrho3_r) CALL qs_rho_get(nablavks_set(idir2, ispin)%rho, rho_r=nrho2_r) CALL qs_rho_get(nablavks_set(idir3, ispin)%rho, rho_r=nrho3_r) - temp_so_soft = temp_so_soft+(-1.0_dp)**(1+ispin)*( & - pw_integral_ab(jrho2_r(ispin)%pw, nrho3_r(1)%pw)- & + temp_so_soft = temp_so_soft + (-1.0_dp)**(1 + ispin)*( & + pw_integral_ab(jrho2_r(ispin)%pw, nrho3_r(1)%pw) - & pw_integral_ab(jrho3_r(ispin)%pw, nrho2_r(1)%pw)) END DO temp_so_soft = -1.0_dp*epr_env%g_so_factor*temp_so_soft @@ -441,7 +441,7 @@ SUBROUTINE epr_g_so(epr_env, current_env, qs_env, iB) DO ia = 1, grid_atom%ng_sphere ra = particle_set(iatom)%r - ra(:) = ra(:)+grid_atom%rad(ir)*harmonics%a(:, ia) + ra(:) = ra(:) + grid_atom%rad(ir)*harmonics%a(:, ia) vks_ra_idir2 = Eval_Interp_Spl3_pbc(ra, & vks_pw_spline(idir2, ispin)%pw) vks_ra_idir3 = Eval_Interp_Spl3_pbc(ra, & @@ -451,37 +451,37 @@ SUBROUTINE epr_g_so(epr_env, current_env, qs_env, iB) ! !here take care of the partition ! + sum_A j_loc_h_A x nabla_vks_s_A - temp_so_gapw(iB, idir1) = temp_so_gapw(iB, idir1)+ & - (-1.0_dp)**(1+ispin)*( & + temp_so_gapw(iB, idir1) = temp_so_gapw(iB, idir1) + & + (-1.0_dp)**(1 + ispin)*( & jrho1_atom%jrho_vec_rad_h(idir2, ispin)%r_coef(ir, ia)* & - vks_ra_idir3- & + vks_ra_idir3 - & jrho1_atom%jrho_vec_rad_h(idir3, ispin)%r_coef(ir, ia)* & vks_ra_idir2 & )*grid_atom%wr(ir)*grid_atom%wa(ia) ! - sum_A j_loc_s_A x nabla_vks_s_A - temp_so_gapw(iB, idir1) = temp_so_gapw(iB, idir1)- & - (-1.0_dp)**(1+ispin)*( & + temp_so_gapw(iB, idir1) = temp_so_gapw(iB, idir1) - & + (-1.0_dp)**(1 + ispin)*( & jrho1_atom%jrho_vec_rad_s(idir2, ispin)%r_coef(ir, ia)* & - vks_ra_idir3- & + vks_ra_idir3 - & jrho1_atom%jrho_vec_rad_s(idir3, ispin)%r_coef(ir, ia)* & vks_ra_idir2 & )*grid_atom%wr(ir)*grid_atom%wa(ia) ! + sum_A j_loc_h_A x nabla_vks_loc_h_A - temp_so_gapw(iB, idir1) = temp_so_gapw(iB, idir1)+ & - (-1.0_dp)**(1+ispin)*( & + temp_so_gapw(iB, idir1) = temp_so_gapw(iB, idir1) + & + (-1.0_dp)**(1 + ispin)*( & jrho1_atom%jrho_vec_rad_h(idir2, ispin)%r_coef(ir, ia)* & - nablavks_atom%nablavks_vec_rad_h(idir3, ispin)%r_coef(ir, ia)- & + nablavks_atom%nablavks_vec_rad_h(idir3, ispin)%r_coef(ir, ia) - & jrho1_atom%jrho_vec_rad_h(idir3, ispin)%r_coef(ir, ia)* & nablavks_atom%nablavks_vec_rad_h(idir2, ispin)%r_coef(ir, ia) & )*grid_atom%wr(ir)*grid_atom%wa(ia) ! - sum_A j_loc_h_A x nabla_vks_loc_s_A - temp_so_gapw(iB, idir1) = temp_so_gapw(iB, idir1)- & - (-1.0_dp)**(1+ispin)*( & + temp_so_gapw(iB, idir1) = temp_so_gapw(iB, idir1) - & + (-1.0_dp)**(1 + ispin)*( & jrho1_atom%jrho_vec_rad_h(idir2, ispin)%r_coef(ir, ia)* & - nablavks_atom%nablavks_vec_rad_s(idir3, ispin)%r_coef(ir, ia)- & + nablavks_atom%nablavks_vec_rad_s(idir3, ispin)%r_coef(ir, ia) - & jrho1_atom%jrho_vec_rad_h(idir3, ispin)%r_coef(ir, ia)* & nablavks_atom%nablavks_vec_rad_s(idir2, ispin)%r_coef(ir, ia) & )*grid_atom%wr(ir)*grid_atom%wa(ia) @@ -520,7 +520,7 @@ SUBROUTINE epr_g_so(epr_env, current_env, qs_env, iB) END DO END IF - g_so(iB, :) = g_so(iB, :)+temp_so_gapw(iB, :) + g_so(iB, :) = g_so(iB, :) + temp_so_gapw(iB, :) DO ispin = 1, nspins DO idir1 = 1, 3 @@ -532,7 +532,7 @@ SUBROUTINE epr_g_so(epr_env, current_env, qs_env, iB) END IF ! gapw - g_total(iB, :) = g_total(iB, :)+g_so(iB, :) + g_total(iB, :) = g_total(iB, :) + g_so(iB, :) CALL cp_print_key_finished_output(output_unit, logger, lr_section, & "PRINT%PROGRAM_RUN_INFO") @@ -626,7 +626,7 @@ SUBROUTINE epr_g_soo(epr_env, current_env, qs_env, iB) temp_soo_soft = 0.0_dp DO ispin = 1, nspins CALL qs_rho_get(bind_set(idir1, iB)%rho, rho_r=brho1_r) - temp_soo_soft = temp_soo_soft+(-1.0_dp)**(1+ispin)* & + temp_soo_soft = temp_soo_soft + (-1.0_dp)**(1 + ispin)* & pw_integral_ab(brho1_r(1)%pw, rho_r(ispin)%pw) END DO temp_soo_soft = 1.0_dp*epr_env%g_soo_factor*temp_soo_soft @@ -639,12 +639,12 @@ SUBROUTINE epr_g_soo(epr_env, current_env, qs_env, iB) DO idir1 = 1, 3 temp_soo_soft = 1.0_dp*epr_env%g_soo_chicorr_factor*chi_tensor(idir1, iB, 2)* & - (REAL(dft_control%multiplicity, KIND=dp)-1.0_dp) + (REAL(dft_control%multiplicity, KIND=dp) - 1.0_dp) IF (output_unit > 0) THEN WRITE (UNIT=output_unit, FMT="(T2,A,T18,i1,i1,T56,E24.16)") & "epr|SOO:soft_g0", iB, idir1, temp_soo_soft END IF - g_soo(iB, idir1) = g_soo(iB, idir1)+temp_soo_soft + g_soo(iB, idir1) = g_soo(iB, idir1) + temp_soo_soft END DO IF (gapw .AND. soo_rho_hard) THEN @@ -713,7 +713,7 @@ SUBROUTINE epr_g_soo(epr_env, current_env, qs_env, iB) DO ia = 1, grid_atom%ng_sphere ra = particle_set(iatom)%r - ra(:) = ra(:)+grid_atom%rad(ir)*harmonics%a(:, ia) + ra(:) = ra(:) + grid_atom%rad(ir)*harmonics%a(:, ia) bind_ra_idir1 = Eval_Interp_Spl3_pbc(ra, & bind_pw_spline(idir1, iB)%pw) @@ -723,14 +723,14 @@ SUBROUTINE epr_g_soo(epr_env, current_env, qs_env, iB) rho_spin = 0.0_dp DO iso = 1, harmonics%max_iso_not0 - rho_spin = rho_spin+ & - (rho_rad_h(ispin)%r_coef(ir, iso)- & + rho_spin = rho_spin + & + (rho_rad_h(ispin)%r_coef(ir, iso) - & rho_rad_s(ispin)%r_coef(ir, iso))* & harmonics%slm(ia, iso) END DO - temp_soo_gapw(iB, idir1) = temp_soo_gapw(iB, idir1)+ & - (-1.0_dp)**(1+ispin)*( & + temp_soo_gapw(iB, idir1) = temp_soo_gapw(iB, idir1) + & + (-1.0_dp)**(1 + ispin)*( & bind_ra_idir1*rho_spin & )*grid_atom%wr(ir)*grid_atom%wa(ia) @@ -751,7 +751,7 @@ SUBROUTINE epr_g_soo(epr_env, current_env, qs_env, iB) END DO END IF - g_soo(iB, :) = g_soo(iB, :)+temp_soo_gapw(iB, :) + g_soo(iB, :) = g_soo(iB, :) + temp_soo_gapw(iB, :) DO idir1 = 1, 3 CALL pw_pool_give_back_pw(auxbas_pw_pool, bind_pw_spline(idir1, iB)%pw) @@ -761,7 +761,7 @@ SUBROUTINE epr_g_soo(epr_env, current_env, qs_env, iB) END IF ! gapw - g_total(iB, :) = g_total(iB, :)+g_soo(iB, :) + g_total(iB, :) = g_total(iB, :) + g_soo(iB, :) CALL cp_print_key_finished_output(output_unit, logger, lr_section, & "PRINT%PROGRAM_RUN_INFO") diff --git a/src/qs_linres_epr_utils.F b/src/qs_linres_epr_utils.F index 65f8219f92..3ac9e09175 100644 --- a/src/qs_linres_epr_utils.F +++ b/src/qs_linres_epr_utils.F @@ -165,8 +165,8 @@ SUBROUTINE epr_env_init(epr_env, qs_env) ! Magical constant twopi/cell%deth just like in NMR shift (basically undo scale_fac in qs_linres_nmr_current.F) epr_env%g_free_factor = -1.0_dp*e_gfactor epr_env%g_zke_factor = e_gfactor*(a_fine)**2 - epr_env%g_so_factor = (a_fine)**2*(-1.0_dp*e_gfactor-1.0_dp)/2.0_dp*twopi/cell%deth - epr_env%g_so_factor_gapw = (a_fine)**2*(-1.0_dp*e_gfactor-1.0_dp)/2.0_dp + epr_env%g_so_factor = (a_fine)**2*(-1.0_dp*e_gfactor - 1.0_dp)/2.0_dp*twopi/cell%deth + epr_env%g_so_factor_gapw = (a_fine)**2*(-1.0_dp*e_gfactor - 1.0_dp)/2.0_dp ! * 2 because B_ind = 2 * B_beta epr_env%g_soo_factor = 2.0_dp*fourpi*(a_fine)**2*twopi/cell%deth ! 2 * 2 * 1/4 * e^2 / m * a_0^2 * 2/3 * mu_0 / (omega * 1e-30 ) @@ -245,7 +245,7 @@ SUBROUTINE epr_env_cleanup(epr_env) INTEGER :: i_B, idir, ispin - epr_env%ref_count = epr_env%ref_count-1 + epr_env%ref_count = epr_env%ref_count - 1 IF (epr_env%ref_count == 0) THEN ! nablavks_set IF (ASSOCIATED(epr_env%nablavks_set)) THEN diff --git a/src/qs_linres_issc_utils.F b/src/qs_linres_issc_utils.F index b7b6efe337..208fa52ff4 100644 --- a/src/qs_linres_issc_utils.F +++ b/src/qs_linres_issc_utils.F @@ -189,12 +189,12 @@ SUBROUTINE issc_response(issc_env, p_env, qs_env) ijdir = 0 DO idir = 1, 3 DO jdir = idir, 3 - ijdir = ijdir+1 + ijdir = ijdir + 1 DO ispin = 1, nspins CALL cp_fm_set_all(psi1_efg(ispin, ijdir)%matrix, 0.0_dp) ENDDO IF (output_unit > 0) THEN - WRITE (output_unit, "(T10,A)") "Response to the perturbation operator efg_"//ACHAR(idir+119)//ACHAR(jdir+119) + WRITE (output_unit, "(T10,A)") "Response to the perturbation operator efg_"//ACHAR(idir + 119)//ACHAR(jdir + 119) ENDIF ! !Initial guess for psi1 @@ -220,7 +220,7 @@ SUBROUTINE issc_response(issc_env, p_env, qs_env) DO ispin = 1, nspins CALL cp_fm_to_fm(psi1(ispin)%matrix, psi1_efg(ispin, ijdir)%matrix) CALL cp_fm_frobenius_norm(psi1(ispin)%matrix, fro) - chk = chk+fro + chk = chk + fro ENDDO ! ! print response functions @@ -252,7 +252,7 @@ SUBROUTINE issc_response(issc_env, p_env, qs_env) CALL cp_fm_set_all(psi1_pso(ispin, idir)%matrix, 0.0_dp) ENDDO IF (output_unit > 0) THEN - WRITE (output_unit, "(T10,A)") "Response to the perturbation operator pso_"//ACHAR(idir+119) + WRITE (output_unit, "(T10,A)") "Response to the perturbation operator pso_"//ACHAR(idir + 119) ENDIF ! !Initial guess for psi1 @@ -278,7 +278,7 @@ SUBROUTINE issc_response(issc_env, p_env, qs_env) DO ispin = 1, nspins CALL cp_fm_to_fm(psi1(ispin)%matrix, psi1_pso(ispin, idir)%matrix) CALL cp_fm_frobenius_norm(psi1(ispin)%matrix, fro) - chk = chk+fro + chk = chk + fro ENDDO ! ! print response functions @@ -334,7 +334,7 @@ SUBROUTINE issc_response(issc_env, p_env, qs_env) DO ispin = 1, nspins CALL cp_fm_to_fm(psi1(ispin)%matrix, psi1_fc(ispin)%matrix) CALL cp_fm_frobenius_norm(psi1(ispin)%matrix, fro) - chk = chk+fro + chk = chk + fro ENDDO ! ! print response functions @@ -366,7 +366,7 @@ SUBROUTINE issc_response(issc_env, p_env, qs_env) CALL cp_fm_set_all(psi1_dso(ispin, idir)%matrix, 0.0_dp) ENDDO IF (output_unit > 0) THEN - WRITE (output_unit, "(T10,A)") "Response to the perturbation operator r_"//ACHAR(idir+119) + WRITE (output_unit, "(T10,A)") "Response to the perturbation operator r_"//ACHAR(idir + 119) ENDIF ! !Initial guess for psi1 @@ -392,7 +392,7 @@ SUBROUTINE issc_response(issc_env, p_env, qs_env) DO ispin = 1, nspins CALL cp_fm_to_fm(psi1(ispin)%matrix, psi1_dso(ispin, idir)%matrix) CALL cp_fm_frobenius_norm(psi1(ispin)%matrix, fro) - chk = chk+fro + chk = chk + fro ENDDO ! ! print response functions @@ -522,7 +522,7 @@ SUBROUTINE issc_issc(issc_env, qs_env, iatom) DO jatom = 1, natom r_i = particle_set(iatom)%r r_j = particle_set(jatom)%r - r_j = pbc(r_i, r_j, cell)+r_i + r_j = pbc(r_i, r_j, cell) + r_i ! ! ! @@ -545,9 +545,9 @@ SUBROUTINE issc_issc(issc_env, qs_env, iatom) CALL cp_fm_trace(fc_psi0(ispin)%matrix, psi1_fc(ispin)%matrix, buf) issc_fc = 2.0_dp*2.0_dp*maxocc*facfc*buf - issc(1, 1, iatom, jatom, 1) = issc(1, 1, iatom, jatom, 1)+issc_fc - issc(2, 2, iatom, jatom, 1) = issc(2, 2, iatom, jatom, 1)+issc_fc - issc(3, 3, iatom, jatom, 1) = issc(3, 3, iatom, jatom, 1)+issc_fc + issc(1, 1, iatom, jatom, 1) = issc(1, 1, iatom, jatom, 1) + issc_fc + issc(2, 2, iatom, jatom, 1) = issc(2, 2, iatom, jatom, 1) + issc_fc + issc(3, 3, iatom, jatom, 1) = issc(3, 3, iatom, jatom, 1) + issc_fc ENDIF ! ! SD term @@ -593,7 +593,7 @@ SUBROUTINE issc_issc(issc_env, qs_env, iatom) DO jxyz = 1, 3 CALL cp_fm_trace(fc_psi0(ispin)%matrix, psi1_pso(ispin, jxyz)%matrix, buf) issc_pso = -2.0_dp*maxocc*facpso*buf - issc(ixyz, jxyz, iatom, jatom, 3) = issc(ixyz, jxyz, iatom, jatom, 3)+issc_pso + issc(ixyz, jxyz, iatom, jatom, 3) = issc(ixyz, jxyz, iatom, jatom, 3) + issc_pso ENDDO ENDDO ENDIF @@ -632,7 +632,7 @@ SUBROUTINE issc_issc(issc_env, qs_env, iatom) ! we save the polarizability for a checksum later on ! issc_dso = 2.0_dp*maxocc*buf !WRITE(*,*) ixyz,jxyz,'tr(P_r*r)=',2.0_dp * maxocc * buf - issc(ixyz, jxyz, iatom, jatom, 4) = issc(ixyz, jxyz, iatom, jatom, 4)+issc_dso + issc(ixyz, jxyz, iatom, jatom, 4) = issc(ixyz, jxyz, iatom, jatom, 4) + issc_dso ENDDO ENDDO @@ -725,30 +725,30 @@ SUBROUTINE issc_print(issc_env, qs_env) ! ! FC issc_tmp(:, :) = issc(:, :, iatom, jatom, 1) - issc_tmp(:, :) = 0.5_dp*(issc_tmp(:, :)+TRANSPOSE(issc_tmp(:, :))) + issc_tmp(:, :) = 0.5_dp*(issc_tmp(:, :) + TRANSPOSE(issc_tmp(:, :))) CALL diamat_all(issc_tmp, eig) - issc_iso_fc = (eig(1)+eig(2)+eig(3))/3.0_dp + issc_iso_fc = (eig(1) + eig(2) + eig(3))/3.0_dp ! ! SD issc_tmp(:, :) = issc(:, :, iatom, jatom, 2) - issc_tmp(:, :) = 0.5_dp*(issc_tmp(:, :)+TRANSPOSE(issc_tmp(:, :))) + issc_tmp(:, :) = 0.5_dp*(issc_tmp(:, :) + TRANSPOSE(issc_tmp(:, :))) CALL diamat_all(issc_tmp, eig) - issc_iso_sd = (eig(1)+eig(2)+eig(3))/3.0_dp + issc_iso_sd = (eig(1) + eig(2) + eig(3))/3.0_dp ! ! PSO issc_tmp(:, :) = issc(:, :, iatom, jatom, 3) - issc_tmp(:, :) = 0.5_dp*(issc_tmp(:, :)+TRANSPOSE(issc_tmp(:, :))) + issc_tmp(:, :) = 0.5_dp*(issc_tmp(:, :) + TRANSPOSE(issc_tmp(:, :))) CALL diamat_all(issc_tmp, eig) - issc_iso_pso = (eig(1)+eig(2)+eig(3))/3.0_dp + issc_iso_pso = (eig(1) + eig(2) + eig(3))/3.0_dp ! ! DSO issc_tmp(:, :) = issc(:, :, iatom, jatom, 4) - issc_tmp(:, :) = 0.5_dp*(issc_tmp(:, :)+TRANSPOSE(issc_tmp(:, :))) + issc_tmp(:, :) = 0.5_dp*(issc_tmp(:, :) + TRANSPOSE(issc_tmp(:, :))) CALL diamat_all(issc_tmp, eig) - issc_iso_dso = (eig(1)+eig(2)+eig(3))/3.0_dp + issc_iso_dso = (eig(1) + eig(2) + eig(3))/3.0_dp ! ! TOT - issc_iso_tot = issc_iso_fc+issc_iso_sd+issc_iso_dso+issc_iso_pso + issc_iso_tot = issc_iso_fc + issc_iso_sd + issc_iso_dso + issc_iso_pso ! ! WRITE (unit_atoms, *) @@ -876,11 +876,11 @@ SUBROUTINE issc_env_init(issc_env, qs_env) NULLIFY (list) CALL section_vals_val_get(issc_section, "ISSC_ON_ATOM_LIST", i_rep_val=ir, i_vals=list) IF (ASSOCIATED(list)) THEN - CALL reallocate(issc_env%issc_on_atom_list, 1, n+SIZE(list)) + CALL reallocate(issc_env%issc_on_atom_list, 1, n + SIZE(list)) DO ini = 1, SIZE(list) - issc_env%issc_on_atom_list(ini+n) = list(ini) + issc_env%issc_on_atom_list(ini + n) = list(ini) ENDDO - n = n+SIZE(list) + n = n + SIZE(list) ENDIF ENDDO ! @@ -1047,7 +1047,7 @@ SUBROUTINE issc_env_cleanup(issc_env) INTEGER :: idir, ispin - issc_env%ref_count = issc_env%ref_count-1 + issc_env%ref_count = issc_env%ref_count - 1 IF (issc_env%ref_count == 0) THEN IF (ASSOCIATED(issc_env%issc_on_atom_list)) THEN DEALLOCATE (issc_env%issc_on_atom_list) diff --git a/src/qs_linres_methods.F b/src/qs_linres_methods.F index 05e709a9ab..d8b681d982 100644 --- a/src/qs_linres_methods.F +++ b/src/qs_linres_methods.F @@ -468,7 +468,7 @@ SUBROUTINE linres_solver(p_env, qs_env, psi1, h1_psi0, psi0_order, iounit, shoul IF (iter .EQ. 1 .OR. MOD(iter, 1) .EQ. 0 .OR. linres_control%converged .OR. restart .OR. should_stop) THEN IF (iounit > 0) THEN WRITE (iounit, "(T5,I5,T18,A3,T28,L1,T38,1E8.2,T48,F16.10,T68,F8.2)") & - iter, linres_control%flag, restart, MAXVAL(alpha), norm_res, t2-t1 + iter, linres_control%flag, restart, MAXVAL(alpha), norm_res, t2 - t1 CALL m_flush(iounit) ENDIF ENDIF @@ -687,7 +687,7 @@ SUBROUTINE apply_op(qs_env, p_env, c0, v, Av, chc) chksum = 0.0_dp DO ispin = 1, nspins - chksum = chksum+dbcsr_checksum(p_env%p1(ispin)%matrix) + chksum = chksum + dbcsr_checksum(p_env%p1(ispin)%matrix) ENDDO ! skip the kernel if the DM is very small @@ -935,7 +935,7 @@ SUBROUTINE apply_op_2_dft(qs_env, p_env, c0, v, Av, chc) xc_section => section_vals_get_subs_vals(input, "DFT%XC") scf_section => section_vals_get_subs_vals(input, "DFT%SCF") - p_env%kpp1_env%iter = p_env%kpp1_env%iter+1 + p_env%kpp1_env%iter = p_env%kpp1_env%iter + 1 ! gets the tmp grids CPASSERT(ASSOCIATED(pw_env)) @@ -1074,16 +1074,16 @@ SUBROUTINE apply_op_2_dft(qs_env, p_env, c0, v, Av, chc) CALL pw_pool_create_pw(auxbas_pw_pool, rho_r(ispin)%pw, in_space=REALSPACE, use_data=REALDATA3D) END DO CALL xc_rho_set_get(p_env%kpp1_env%rho_set, rhoa=rhoa, rhob=rhob) - rho_r(1)%pw%cr3d(:, :, :) = rhoa(:, :, :)+0.5_dp*h*rho1_r(1)%pw%cr3d(:, :, :) - rho_r(2)%pw%cr3d(:, :, :) = rhob(:, :, :)+0.5_dp*h*rho1_r(2)%pw%cr3d(:, :, :) + rho_r(1)%pw%cr3d(:, :, :) = rhoa(:, :, :) + 0.5_dp*h*rho1_r(1)%pw%cr3d(:, :, :) + rho_r(2)%pw%cr3d(:, :, :) = rhob(:, :, :) + 0.5_dp*h*rho1_r(2)%pw%cr3d(:, :, :) CALL xc_vxc_pw_create(vxc_rho_1, tau_pw, exc, rho_r, rho_g, tau, xc_section, & auxbas_pw_pool, .FALSE., virial_xc) - rho_r(1)%pw%cr3d(:, :, :) = rhoa(:, :, :)-0.5_dp*h*rho1_r(1)%pw%cr3d(:, :, :) - rho_r(2)%pw%cr3d(:, :, :) = rhob(:, :, :)-0.5_dp*h*rho1_r(2)%pw%cr3d(:, :, :) + rho_r(1)%pw%cr3d(:, :, :) = rhoa(:, :, :) - 0.5_dp*h*rho1_r(1)%pw%cr3d(:, :, :) + rho_r(2)%pw%cr3d(:, :, :) = rhob(:, :, :) - 0.5_dp*h*rho1_r(2)%pw%cr3d(:, :, :) CALL xc_vxc_pw_create(vxc_rho_2, tau_pw, exc, rho_r, rho_g, tau, xc_section, & auxbas_pw_pool, .FALSE., virial_xc) - v_xc(1)%pw%cr3d(:, :, :) = (vxc_rho_1(1)%pw%cr3d(:, :, :)-vxc_rho_2(1)%pw%cr3d(:, :, :))/h - v_xc(2)%pw%cr3d(:, :, :) = (vxc_rho_1(2)%pw%cr3d(:, :, :)-vxc_rho_2(2)%pw%cr3d(:, :, :))/h + v_xc(1)%pw%cr3d(:, :, :) = (vxc_rho_1(1)%pw%cr3d(:, :, :) - vxc_rho_2(1)%pw%cr3d(:, :, :))/h + v_xc(2)%pw%cr3d(:, :, :) = (vxc_rho_1(2)%pw%cr3d(:, :, :) - vxc_rho_2(2)%pw%cr3d(:, :, :))/h DO ispin = 1, nspins CALL pw_pool_give_back_pw(auxbas_pw_pool, rho_r(ispin)%pw) END DO @@ -1102,26 +1102,26 @@ SUBROUTINE apply_op_2_dft(qs_env, p_env, c0, v, Av, chc) END DO CALL xc_rho_set_get(p_env%kpp1_env%rho_set, rhoa=rhoa, rhob=rhob) ! K(alpha,alpha) - rho_r(1)%pw%cr3d(:, :, :) = rhoa(:, :, :)+0.5_dp*h*rho1_r(1)%pw%cr3d(:, :, :) + rho_r(1)%pw%cr3d(:, :, :) = rhoa(:, :, :) + 0.5_dp*h*rho1_r(1)%pw%cr3d(:, :, :) rho_r(2)%pw%cr3d(:, :, :) = rhob(:, :, :) CALL xc_vxc_pw_create(vxc_rho_1, tau_pw, exc, rho_r, rho_g, tau, xc_section, & auxbas_pw_pool, .FALSE., virial_xc) - rho_r(1)%pw%cr3d(:, :, :) = rhoa(:, :, :)-0.5_dp*h*rho1_r(1)%pw%cr3d(:, :, :) + rho_r(1)%pw%cr3d(:, :, :) = rhoa(:, :, :) - 0.5_dp*h*rho1_r(1)%pw%cr3d(:, :, :) rho_r(2)%pw%cr3d(:, :, :) = rhob(:, :, :) CALL xc_vxc_pw_create(vxc_rho_2, tau_pw, exc, rho_r, rho_g, tau, xc_section, & auxbas_pw_pool, .FALSE., virial_xc) - v_xc(1)%pw%cr3d(:, :, :) = (vxc_rho_1(1)%pw%cr3d(:, :, :)-vxc_rho_2(1)%pw%cr3d(:, :, :))/h + v_xc(1)%pw%cr3d(:, :, :) = (vxc_rho_1(1)%pw%cr3d(:, :, :) - vxc_rho_2(1)%pw%cr3d(:, :, :))/h ! K(alpha,beta) rho_r(1)%pw%cr3d(:, :, :) = rhoa(:, :, :) - rho_r(2)%pw%cr3d(:, :, :) = rhob(:, :, :)+0.5_dp*h*rho1_r(1)%pw%cr3d(:, :, :) + rho_r(2)%pw%cr3d(:, :, :) = rhob(:, :, :) + 0.5_dp*h*rho1_r(1)%pw%cr3d(:, :, :) CALL xc_vxc_pw_create(vxc_rho_3, tau_pw, exc, rho_r, rho_g, tau, xc_section, & auxbas_pw_pool, .FALSE., virial_xc) rho_r(1)%pw%cr3d(:, :, :) = rhoa(:, :, :) - rho_r(2)%pw%cr3d(:, :, :) = rhob(:, :, :)-0.5_dp*h*rho1_r(1)%pw%cr3d(:, :, :) + rho_r(2)%pw%cr3d(:, :, :) = rhob(:, :, :) - 0.5_dp*h*rho1_r(1)%pw%cr3d(:, :, :) CALL xc_vxc_pw_create(vxc_rho_4, tau_pw, exc, rho_r, rho_g, tau, xc_section, & auxbas_pw_pool, .FALSE., virial_xc) - v_xc(1)%pw%cr3d(:, :, :) = v_xc(1)%pw%cr3d(:, :, :)- & - (vxc_rho_3(1)%pw%cr3d(:, :, :)-vxc_rho_4(1)%pw%cr3d(:, :, :))/h + v_xc(1)%pw%cr3d(:, :, :) = v_xc(1)%pw%cr3d(:, :, :) - & + (vxc_rho_3(1)%pw%cr3d(:, :, :) - vxc_rho_4(1)%pw%cr3d(:, :, :))/h DO ispin = 1, 2 CALL pw_pool_give_back_pw(auxbas_pw_pool, rho_r(ispin)%pw) END DO @@ -1139,13 +1139,13 @@ SUBROUTINE apply_op_2_dft(qs_env, p_env, c0, v, Av, chc) NULLIFY (rho_r(1)%pw) CALL pw_pool_create_pw(auxbas_pw_pool, rho_r(1)%pw, in_space=REALSPACE, use_data=REALDATA3D) CALL xc_rho_set_get(p_env%kpp1_env%rho_set, rho=rho3) - rho_r(1)%pw%cr3d(:, :, :) = rho3(:, :, :)+0.5_dp*h*rho1_r(1)%pw%cr3d(:, :, :) + rho_r(1)%pw%cr3d(:, :, :) = rho3(:, :, :) + 0.5_dp*h*rho1_r(1)%pw%cr3d(:, :, :) CALL xc_vxc_pw_create(vxc_rho_1, tau_pw, exc, rho_r, rho_g, tau, xc_section, & auxbas_pw_pool, .FALSE., virial_xc) - rho_r(1)%pw%cr3d(:, :, :) = rho3(:, :, :)-0.5_dp*h*rho1_r(1)%pw%cr3d(:, :, :) + rho_r(1)%pw%cr3d(:, :, :) = rho3(:, :, :) - 0.5_dp*h*rho1_r(1)%pw%cr3d(:, :, :) CALL xc_vxc_pw_create(vxc_rho_2, tau_pw, exc, rho_r, rho_g, tau, xc_section, & auxbas_pw_pool, .FALSE., virial_xc) - v_xc(1)%pw%cr3d(:, :, :) = (vxc_rho_1(1)%pw%cr3d(:, :, :)-vxc_rho_2(1)%pw%cr3d(:, :, :))/h + v_xc(1)%pw%cr3d(:, :, :) = (vxc_rho_1(1)%pw%cr3d(:, :, :) - vxc_rho_2(1)%pw%cr3d(:, :, :))/h CALL pw_pool_give_back_pw(auxbas_pw_pool, rho_r(1)%pw) DEALLOCATE (rho_r) CALL pw_release(vxc_rho_1(1)%pw) @@ -1393,7 +1393,7 @@ SUBROUTINE apply_op_2_xtb(qs_env, p_env, c0, v, Av, chc) CPASSERT(.NOT. lr_triplet) nspins = SIZE(p_env%kpp1) - p_env%kpp1_env%iter = p_env%kpp1_env%iter+1 + p_env%kpp1_env%iter = p_env%kpp1_env%iter + 1 DO ispin = 1, nspins CALL dbcsr_set(p_env%kpp1(ispin)%matrix, 0.0_dp) @@ -1428,9 +1428,9 @@ SUBROUTINE apply_op_2_xtb(qs_env, p_env, c0, v, Av, chc) atom_a = atomic_kind_set(ikind)%atom_list(iatom) charges(atom_a, :) = REAL(occ(:), KIND=dp) DO is = 1, natorb - ns = lao(is)+1 - charges(atom_a, ns) = charges(atom_a, ns)-aocg(is, atom_a) - charges1(atom_a, ns) = charges1(atom_a, ns)-aocg1(is, atom_a) + ns = lao(is) + 1 + charges(atom_a, ns) = charges(atom_a, ns) - aocg(is, atom_a) + charges1(atom_a, ns) = charges1(atom_a, ns) - aocg1(is, atom_a) END DO END DO END DO @@ -1803,7 +1803,7 @@ SUBROUTINE linres_write_restart(qs_env, linres_section, vec, ivec, tag, ind) IF (rst_unit > 0) WRITE (rst_unit) nmo DO i = 1, nmo, MAX(max_block, 1) - i_block = MIN(max_block, nmo-i+1) + i_block = MIN(max_block, nmo - i + 1) CALL cp_fm_get_submatrix(vec(ispin)%matrix, vecbuffer, 1, i, nao, i_block) ! doing this in one write would increase efficiency, but breaks RESTART compatibility. ! to old ones, and in cases where max_block is different between runs, as might happen during @@ -1961,7 +1961,7 @@ SUBROUTINE linres_read_restart(qs_env, linres_section, vec, ivec, tag, ind) ! ! read the response DO i = 1, nmo, MAX(max_block, 1) - i_block = MIN(max_block, nmo-i+1) + i_block = MIN(max_block, nmo - i + 1) DO j = 1, i_block IF (rst_unit > 0) READ (rst_unit) vecbuffer(1:nao, j) ENDDO diff --git a/src/qs_linres_nmr_shift.F b/src/qs_linres_nmr_shift.F index aca438c3f4..3962a173e8 100644 --- a/src/qs_linres_nmr_shift.F +++ b/src/qs_linres_nmr_shift.F @@ -323,8 +323,8 @@ SUBROUTINE nmr_shift_gapw(nmr_env, current_env, qs_env, iB, idir) nspins = dft_control%nspins itegrated_jrho = 0.0_dp ! - idir2_1 = MODULO(idir, 3)+1 - idir3_1 = MODULO(idir+1, 3)+1 + idir2_1 = MODULO(idir, 3) + 1 + idir3_1 = MODULO(idir + 1, 3) + 1 scale_fac_1 = fac_vecp(idir3_1, idir2_1, idir) ! ALLOCATE (cs_loc_tmp(3, natom_tot), list_j(natom_tot), & @@ -358,7 +358,7 @@ SUBROUTINE nmr_shift_gapw(nmr_env, current_env, qs_env, iB, idir) DO ia = 1, na DO ir = 1, nr r_grid(:, ira) = grid_atom%rad(ir)*harmonics%a(:, ia) - ira = ira+1 + ira = ira + 1 ENDDO ENDDO ! @@ -377,9 +377,9 @@ SUBROUTINE nmr_shift_gapw(nmr_env, current_env, qs_env, iB, idir) natom_local = 0 DO jatom = 1, natom_tot rij(:) = pbc(particle_set(iatom)%r, particle_set(jatom)%r, cell) - dist = SQRT(rij(1)*rij(1)+rij(2)*rij(2)+rij(3)*rij(3)) + dist = SQRT(rij(1)*rij(1) + rij(2)*rij(2) + rij(3)*rij(3)) IF (dist .LE. shift_gapw_radius) THEN - natom_local = natom_local+1 + natom_local = natom_local + 1 list_j(natom_local) = jatom dist_ij(:, natom_local) = rij(:) ENDIF @@ -391,9 +391,9 @@ SUBROUTINE nmr_shift_gapw(nmr_env, current_env, qs_env, iB, idir) DO jatom = 1, n_nics r_jatom(:) = r_nics(:, jatom) rij(:) = pbc(particle_set(iatom)%r, r_jatom, cell) - dist = SQRT(rij(1)*rij(1)+rij(2)*rij(2)+rij(3)*rij(3)) + dist = SQRT(rij(1)*rij(1) + rij(2)*rij(2) + rij(3)*rij(3)) IF (dist .LE. shift_gapw_radius) THEN - nnics_local = nnics_local+1 + nnics_local = nnics_local + 1 list_nics_j(nnics_local) = jatom dist_nics_ij(:, nnics_local) = rij(:) ENDIF @@ -413,9 +413,9 @@ SUBROUTINE nmr_shift_gapw(nmr_env, current_env, qs_env, iB, idir) ira = 1 DO ia = 1, na DO ir = 1, nr - j_grid(ira) = (jrho_h_grid(ir, ia)-jrho_s_grid(ir, ia))*grid_atom%weight(ia, ir) - itegrated_jrho = itegrated_jrho+j_grid(ira) - ira = ira+1 + j_grid(ira) = (jrho_h_grid(ir, ia) - jrho_s_grid(ir, ia))*grid_atom%weight(ia, ir) + itegrated_jrho = itegrated_jrho + j_grid(ira) + ira = ira + 1 ENDDO ENDDO ! @@ -427,16 +427,16 @@ SUBROUTINE nmr_shift_gapw(nmr_env, current_env, qs_env, iB, idir) s_2 = 0.0_dp DO ira = 1, nra ! - rdiff(:) = rij(:)-r_grid(:, ira) - ddiff = SQRT(rdiff(1)*rdiff(1)+rdiff(2)*rdiff(2)+rdiff(3)*rdiff(3)) + rdiff(:) = rij(:) - r_grid(:, ira) + ddiff = SQRT(rdiff(1)*rdiff(1) + rdiff(2)*rdiff(2) + rdiff(3)*rdiff(3)) IF (ddiff .GT. 1.0E-12_dp) THEN dum = scale_fac_1*j_grid(ira)/(ddiff*ddiff*ddiff) - s_1 = s_1+rdiff(idir2_1)*dum - s_2 = s_2+rdiff(idir3_1)*dum + s_1 = s_1 + rdiff(idir2_1)*dum + s_2 = s_2 + rdiff(idir3_1)*dum ENDIF ! ddiff ENDDO ! ira - cs_loc_tmp(idir3_1, jatom) = cs_loc_tmp(idir3_1, jatom)+s_1 - cs_loc_tmp(idir2_1, jatom) = cs_loc_tmp(idir2_1, jatom)-s_2 + cs_loc_tmp(idir3_1, jatom) = cs_loc_tmp(idir3_1, jatom) + s_1 + cs_loc_tmp(idir2_1, jatom) = cs_loc_tmp(idir2_1, jatom) - s_2 ENDDO ! j ! IF (do_nics) THEN @@ -448,16 +448,16 @@ SUBROUTINE nmr_shift_gapw(nmr_env, current_env, qs_env, iB, idir) s_2 = 0.0_dp DO ira = 1, nra ! - rdiff(:) = rij(:)-r_grid(:, ira) - ddiff = SQRT(rdiff(1)*rdiff(1)+rdiff(2)*rdiff(2)+rdiff(3)*rdiff(3)) + rdiff(:) = rij(:) - r_grid(:, ira) + ddiff = SQRT(rdiff(1)*rdiff(1) + rdiff(2)*rdiff(2) + rdiff(3)*rdiff(3)) IF (ddiff .GT. 1.0E-12_dp) THEN dum = scale_fac_1*j_grid(ira)/(ddiff*ddiff*ddiff) - s_1 = s_1+rdiff(idir2_1)*dum - s_2 = s_2+rdiff(idir3_1)*dum + s_1 = s_1 + rdiff(idir2_1)*dum + s_2 = s_2 + rdiff(idir3_1)*dum ENDIF ! ddiff ENDDO ! ira - cs_nics_loc_tmp(idir3_1, jatom) = cs_nics_loc_tmp(idir3_1, jatom)+s_1 - cs_nics_loc_tmp(idir2_1, jatom) = cs_nics_loc_tmp(idir2_1, jatom)-s_2 + cs_nics_loc_tmp(idir3_1, jatom) = cs_nics_loc_tmp(idir3_1, jatom) + s_1 + cs_nics_loc_tmp(idir2_1, jatom) = cs_nics_loc_tmp(idir2_1, jatom) - s_2 ENDDO ! j ENDIF ! do_nics ENDDO ! ispin @@ -470,19 +470,19 @@ SUBROUTINE nmr_shift_gapw(nmr_env, current_env, qs_env, iB, idir) CALL mp_sum(itegrated_jrho, para_env%group) IF (output_unit > 0) THEN WRITE (output_unit, '(T2,A,E24.16)') 'Integrated local j_'& - &//ACHAR(idir+119)//ACHAR(iB+119)//'(r)=', itegrated_jrho + &//ACHAR(idir + 119)//ACHAR(iB + 119)//'(r)=', itegrated_jrho ENDIF ! CALL mp_sum(cs_loc_tmp, para_env%group) chemical_shift_loc(:, iB, :) = chemical_shift_loc(:, iB, :) & - & -nmr_env%shift_factor_gapw*cs_loc_tmp(:, :)/2.0_dp + & - nmr_env%shift_factor_gapw*cs_loc_tmp(:, :)/2.0_dp ! DEALLOCATE (cs_loc_tmp, list_j, dist_ij) ! IF (do_nics) THEN CALL mp_sum(cs_nics_loc_tmp, para_env%group) chemical_shift_nics_loc(:, iB, :) = chemical_shift_nics_loc(:, iB, :) & - & -nmr_env%shift_factor_gapw*cs_nics_loc_tmp(:, :)/2.0_dp + & - nmr_env%shift_factor_gapw*cs_nics_loc_tmp(:, :)/2.0_dp ! DEALLOCATE (cs_nics_loc_tmp, list_nics_j, dist_nics_ij) ENDIF @@ -581,7 +581,7 @@ SUBROUTINE interpolate_shift_pwgrid(nmr_env, pw_env, particle_set, cell, shift_p iatom = cs_atom_list(iat) R_iatom = pbc(particle_set(iatom)%r, cell) shift_val = Eval_Interp_Spl3_pbc(R_iatom, shiftspl%pw) - chemical_shift(idir, i_B, iatom) = chemical_shift(idir, i_B, iatom)+ & + chemical_shift(idir, i_B, iatom) = chemical_shift(idir, i_B, iatom) + & nmr_env%shift_factor*twopi**2*shift_val END DO @@ -590,7 +590,7 @@ SUBROUTINE interpolate_shift_pwgrid(nmr_env, pw_env, particle_set, cell, shift_p ra(:) = r_nics(:, iatom) R_iatom = pbc(ra, cell) shift_val = Eval_Interp_Spl3_pbc(R_iatom, shiftspl%pw) - chemical_shift_nics(idir, i_B, iatom) = chemical_shift_nics(idir, i_B, iatom)+ & + chemical_shift_nics(idir, i_B, iatom) = chemical_shift_nics(idir, i_B, iatom) + & nmr_env%shift_factor*twopi**2*shift_val END DO END IF @@ -654,7 +654,7 @@ SUBROUTINE gsum_shift_pwgrid(nmr_env, particle_set, cell, shift_pw_gspace, & iatom = cs_atom_list(iat) R_iatom = pbc(particle_set(iatom)%r, cell) CALL gsumr(R_iatom, shift_pw_gspace%pw, cplx) - chemical_shift(idir, i_B, iatom) = chemical_shift(idir, i_B, iatom)+ & + chemical_shift(idir, i_B, iatom) = chemical_shift(idir, i_B, iatom) + & nmr_env%shift_factor*twopi**2*REAL(cplx, dp) ENDDO ! @@ -663,7 +663,7 @@ SUBROUTINE gsum_shift_pwgrid(nmr_env, particle_set, cell, shift_pw_gspace, & DO iat = 1, n_nics ra = pbc(r_nics(:, iat), cell) CALL gsumr(ra, shift_pw_gspace%pw, cplx) - chemical_shift_nics(idir, i_B, iat) = chemical_shift_nics(idir, i_B, iat)+ & + chemical_shift_nics(idir, i_B, iat) = chemical_shift_nics(idir, i_B, iat) + & nmr_env%shift_factor*twopi**2*REAL(cplx, dp) ENDDO ENDIF @@ -690,10 +690,10 @@ SUBROUTINE gsumr(r, pw, cplx) grid => pw%pw_grid cplx = CMPLX(0.0_dp, 0.0_dp, KIND=dp) DO ig = grid%first_gne0, grid%ngpts_cut_local - rg = (grid%g(1, ig)*r(1)+grid%g(2, ig)*r(2)+grid%g(3, ig)*r(3))*gaussi - cplx = cplx+pw%cc(ig)*EXP(rg) + rg = (grid%g(1, ig)*r(1) + grid%g(2, ig)*r(2) + grid%g(3, ig)*r(3))*gaussi + cplx = cplx + pw%cc(ig)*EXP(rg) ENDDO - IF (grid%have_g0) cplx = cplx+pw%cc(1) + IF (grid%have_g0) cplx = cplx + pw%cc(1) CALL mp_sum(cplx, grid%para%group) END SUBROUTINE gsumr @@ -759,7 +759,7 @@ SUBROUTINE nmr_shift_print(nmr_env, current_env, qs_env) ! multiply by the appropriate factor chi_tensor_tmp(:, :) = 0.0_dp chi_tensor_loc_tmp(:, :) = 0.0_dp - chi_tensor_tmp(:, :) = (chi_tensor(:, :, 1)+chi_tensor(:, :, 2))*nmr_env%chi_factor + chi_tensor_tmp(:, :) = (chi_tensor(:, :, 1) + chi_tensor(:, :, 2))*nmr_env%chi_factor !chi_tensor_loc_tmp(:,:) = (chi_tensor_loc(:,:,1) + chi_tensor_loc(:,:,2)) * here there is another factor ! CALL get_qs_env(qs_env=qs_env, & @@ -776,15 +776,15 @@ SUBROUTINE nmr_shift_print(nmr_env, current_env, qs_env) ENDIF ! Finalize Chi calculation ! Symmetrize - chi_sym_tot(:, :) = (chi_tensor_tmp(:, :)+TRANSPOSE(chi_tensor_tmp(:, :)))/2.0_dp + chi_sym_tot(:, :) = (chi_tensor_tmp(:, :) + TRANSPOSE(chi_tensor_tmp(:, :)))/2.0_dp IF (gapw) THEN chi_sym_tot(:, :) = chi_sym_tot(:, :) & - & +(chi_tensor_loc_tmp(:, :)+TRANSPOSE(chi_tensor_loc_tmp(:, :)))/2.0_dp + & + (chi_tensor_loc_tmp(:, :) + TRANSPOSE(chi_tensor_loc_tmp(:, :)))/2.0_dp ENDIF chi_tmp(:, :) = chi_sym_tot(:, :) CALL diamat_all(chi_tmp, eig) - chi_iso = (eig(1)+eig(2)+eig(3))/3.0_dp - chi_aniso = eig(3)-(eig(2)+eig(1))/2.0_dp + chi_iso = (eig(1) + eig(2) + eig(3))/3.0_dp + chi_aniso = eig(3) - (eig(2) + eig(1))/2.0_dp ! IF (output_unit > 0) THEN WRITE (output_unit, '(T2,A,E14.6)') 'CheckSum Chi =', & @@ -863,8 +863,8 @@ SUBROUTINE nmr_shift_print(nmr_env, current_env, qs_env) rpos(1:3) = particle_set(iatom)%r(1:3) atom_kind => particle_set(iatom)%atomic_kind CALL get_atomic_kind(atom_kind, name=name, element_symbol=element_symbol) - cs_tot(:, :, ir) = chi_tensor_tmp(:, :)*nmr_env%chi_SI2shiftppm+cs(:, :, iatom) - IF (gapw) cs_tot(:, :, ir) = cs_tot(:, :, ir)+cs_loc(:, :, iatom) + cs_tot(:, :, ir) = chi_tensor_tmp(:, :)*nmr_env%chi_SI2shiftppm + cs(:, :, iatom) + IF (gapw) cs_tot(:, :, ir) = cs_tot(:, :, ir) + cs_loc(:, :, iatom) ENDDO ! ir IF (output_unit > 0) THEN WRITE (output_unit, '(T2,A,E14.6)') 'CheckSum Shifts =', & @@ -888,10 +888,10 @@ SUBROUTINE nmr_shift_print(nmr_env, current_env, qs_env) rpos(1:3) = particle_set(iatom)%r(1:3) atom_kind => particle_set(iatom)%atomic_kind CALL get_atomic_kind(atom_kind, name=name, element_symbol=element_symbol) - shift_sym_tot(:, :) = 0.5_dp*(cs_tot(:, :, ir)+TRANSPOSE(cs_tot(:, :, ir))) + shift_sym_tot(:, :) = 0.5_dp*(cs_tot(:, :, ir) + TRANSPOSE(cs_tot(:, :, ir))) CALL diamat_all(shift_sym_tot, eig) - shift_iso = (eig(1)+eig(2)+eig(3))/3.0_dp - shift_aniso = eig(3)-(eig(2)+eig(1))/2.0_dp + shift_iso = (eig(1) + eig(2) + eig(3))/3.0_dp + shift_aniso = eig(3) - (eig(2) + eig(1))/2.0_dp ! WRITE (unit_atoms, '(T2,I5,A,2X,A2,2X,3f15.6)') iatom, TRIM(name), element_symbol, rpos(1:3) ! @@ -939,8 +939,8 @@ SUBROUTINE nmr_shift_print(nmr_env, current_env, qs_env) ! Add the chi part to the nics cs_nics_tot(:, :, :) = 0.0_dp DO ir = 1, n_nics - cs_nics_tot(:, :, ir) = chi_tensor_tmp(:, :)*nmr_env%chi_SI2shiftppm+cs_nics(:, :, ir) - IF (gapw) cs_nics_tot(:, :, ir) = cs_nics_tot(:, :, ir)+cs_nics_loc(:, :, ir) + cs_nics_tot(:, :, ir) = chi_tensor_tmp(:, :)*nmr_env%chi_SI2shiftppm + cs_nics(:, :, ir) + IF (gapw) cs_nics_tot(:, :, ir) = cs_nics_tot(:, :, ir) + cs_nics_loc(:, :, ir) ENDDO ! ir IF (output_unit > 0) THEN WRITE (output_unit, '(T2,A,E14.6)') 'CheckSum NICS =', & @@ -954,10 +954,10 @@ SUBROUTINE nmr_shift_print(nmr_env, current_env, qs_env) WRITE (title, '(A,1X,I5)') "Shielding at nics positions. # tensors printed ", n_nics WRITE (unit_nics, '(T2,A)') title DO ir = 1, n_nics - shift_sym_tot(:, :) = 0.5_dp*(cs_nics_tot(:, :, ir)+TRANSPOSE(cs_nics_tot(:, :, ir))) + shift_sym_tot(:, :) = 0.5_dp*(cs_nics_tot(:, :, ir) + TRANSPOSE(cs_nics_tot(:, :, ir))) CALL diamat_all(shift_sym_tot, eig) - shift_iso = (eig(1)+eig(2)+eig(3))/3.0_dp - shift_aniso = eig(3)-(eig(2)+eig(1))/2.0_dp + shift_iso = (eig(1) + eig(2) + eig(3))/3.0_dp + shift_aniso = eig(3) - (eig(2) + eig(1))/2.0_dp ! WRITE (unit_nics, '(T2,I5,2X,3f15.6)') ir, r_nics(1:3, ir) ! diff --git a/src/qs_linres_nmr_utils.F b/src/qs_linres_nmr_utils.F index ef5913b2a3..5543fab380 100644 --- a/src/qs_linres_nmr_utils.F +++ b/src/qs_linres_nmr_utils.F @@ -216,12 +216,12 @@ SUBROUTINE nmr_env_init(nmr_env, qs_env) CALL section_vals_val_get(nmr_section,& & "PRINT%SHIELDING_TENSOR%ATOMS_LU_BOUNDS", & i_vals=bounds) - nat_print = bounds(2)-bounds(1)+1 + nat_print = bounds(2) - bounds(1) + 1 IF (nat_print > 0) THEN ALLOCATE (nmr_env%cs_atom_list(nat_print)) DO ir = 1, nat_print - nmr_env%cs_atom_list(ir) = bounds(1)+(ir-1) - nmr_env%do_calc_cs_atom(bounds(1)+(ir-1)) = 1 + nmr_env%cs_atom_list(ir) = bounds(1) + (ir - 1) + nmr_env%do_calc_cs_atom(bounds(1) + (ir - 1)) = 1 ENDDO ENDIF @@ -234,12 +234,12 @@ SUBROUTINE nmr_env_init(nmr_env, qs_env) CALL section_vals_val_get(nmr_section, "PRINT%SHIELDING_TENSOR%ATOMS_LIST", & i_rep_val=ir, i_vals=list) IF (ASSOCIATED(list)) THEN - CALL reallocate(nmr_env%cs_atom_list, 1, nat_print+SIZE(list)) + CALL reallocate(nmr_env%cs_atom_list, 1, nat_print + SIZE(list)) DO ini = 1, SIZE(list) - nmr_env%cs_atom_list(ini+nat_print) = list(ini) + nmr_env%cs_atom_list(ini + nat_print) = list(ini) nmr_env%do_calc_cs_atom(list(ini)) = 1 ENDDO - nat_print = nat_print+SIZE(list) + nat_print = nat_print + SIZE(list) ENDIF ENDDO ! ir ENDIF @@ -312,7 +312,7 @@ SUBROUTINE nmr_env_cleanup(nmr_env) CHARACTER(LEN=*), PARAMETER :: routineN = 'nmr_env_cleanup', & routineP = moduleN//':'//routineN - nmr_env%ref_count = nmr_env%ref_count-1 + nmr_env%ref_count = nmr_env%ref_count - 1 IF (nmr_env%ref_count == 0) THEN IF (ASSOCIATED(nmr_env%cs_atom_list)) THEN DEALLOCATE (nmr_env%cs_atom_list) diff --git a/src/qs_linres_op.F b/src/qs_linres_op.F index 26bd83c0f5..0d1ac2ec09 100644 --- a/src/qs_linres_op.F +++ b/src/qs_linres_op.F @@ -256,15 +256,15 @@ SUBROUTINE current_operators(current_env, qs_env) CALL build_ang_mom_matrix(qs_env, op_ao, centers_set(ispin)%array(1:3, icenter)) ! ! accumulate checksums - chk(1) = chk(1)+dbcsr_checksum(op_ao(1)%matrix) - chk(2) = chk(2)+dbcsr_checksum(op_ao(2)%matrix) - chk(3) = chk(3)+dbcsr_checksum(op_ao(3)%matrix) + chk(1) = chk(1) + dbcsr_checksum(op_ao(1)%matrix) + chk(2) = chk(2) + dbcsr_checksum(op_ao(2)%matrix) + chk(3) = chk(3) + dbcsr_checksum(op_ao(3)%matrix) DO idir = 1, 3 CALL cp_fm_set_all(rxp_psi0(ispin, idir)%matrix, 0.0_dp) CALL cp_dbcsr_sm_fm_multiply(op_ao(idir)%matrix, mo_coeff, & rxp_psi0(ispin, idir)%matrix, ncol=nmo, & alpha=-1.0_dp) - DO j = center_list(ispin)%array(1, icenter), center_list(ispin)%array(1, icenter+1)-1 + DO j = center_list(ispin)%array(1, icenter), center_list(ispin)%array(1, icenter + 1) - 1 istate = center_list(ispin)%array(2, j) ! the p_psi0 fm is used as temporary matrix to store the results for the psi0 centered in dk CALL cp_fm_to_fm(rxp_psi0(ispin, idir)%matrix, & @@ -915,9 +915,9 @@ FUNCTION fac_vecp(a, b, c) RESULT(factor) factor = 0.0_dp - IF ((b .EQ. a+1 .OR. b .EQ. a-2) .AND. (c .EQ. b+1 .OR. c .EQ. b-2)) THEN + IF ((b .EQ. a + 1 .OR. b .EQ. a - 2) .AND. (c .EQ. b + 1 .OR. c .EQ. b - 2)) THEN factor = 1.0_dp - ELSEIF ((b .EQ. a-1 .OR. b .EQ. a+2) .AND. (c .EQ. b-1 .OR. c .EQ. b+2)) THEN + ELSEIF ((b .EQ. a - 1 .OR. b .EQ. a + 2) .AND. (c .EQ. b - 1 .OR. c .EQ. b + 2)) THEN factor = -1.0_dp END IF @@ -943,12 +943,12 @@ FUNCTION ind_m2(ii, iii) RESULT(i) l(ii) = 1 ELSEIF (ii == iii) THEN l(ii) = 2 - i = coset(l(1), l(2), l(3))-1 + i = coset(l(1), l(2), l(3)) - 1 ELSE l(ii) = 1 l(iii) = 1 ENDIF - i = coset(l(1), l(2), l(3))-1 + i = coset(l(1), l(2), l(3)) - 1 END FUNCTION ind_m2 ! ************************************************************************************************** @@ -986,11 +986,11 @@ SUBROUTINE set_vecp_rev(i1, i2, i3) INTEGER, INTENT(IN) :: i1, i2 INTEGER, INTENT(OUT) :: i3 - IF ((i1+i2) == 3) THEN + IF ((i1 + i2) == 3) THEN i3 = 3 - ELSEIF ((i1+i2) == 4) THEN + ELSEIF ((i1 + i2) == 4) THEN i3 = 2 - ELSEIF ((i1+i2) == 5) THEN + ELSEIF ((i1 + i2) == 5) THEN i3 = 1 ELSE END IF diff --git a/src/qs_linres_polar_utils.F b/src/qs_linres_polar_utils.F index 1bb9e424bf..d13135aa71 100644 --- a/src/qs_linres_polar_utils.F +++ b/src/qs_linres_polar_utils.F @@ -251,7 +251,7 @@ SUBROUTINE polar_polar(qs_env) !SL compute trace ptmp = 0.0_dp CALL cp_fm_trace(psi1_dBerry(i, ispin)%matrix, dBerry_psi0(z, ispin)%matrix, ptmp) - polar_tmp(i, z) = polar_tmp(i, z)-2.0_dp*ptmp + polar_tmp(i, z) = polar_tmp(i, z) - 2.0_dp*ptmp END DO END DO END DO !spin @@ -462,10 +462,10 @@ SUBROUTINE polar_response(p_env, qs_env) IF (iounit > 0) THEN IF (do_periodic) THEN WRITE (iounit, "(/,T2,A)") & - "POLAR| Response to the perturbation operator Berry phase_"//ACHAR(idir+119) + "POLAR| Response to the perturbation operator Berry phase_"//ACHAR(idir + 119) ELSE WRITE (iounit, "(/,T2,A)") & - "POLAR| Response to the perturbation operator R_"//ACHAR(idir+119) + "POLAR| Response to the perturbation operator R_"//ACHAR(idir + 119) END IF ENDIF ! Do scf cycle to optimize psi1 diff --git a/src/qs_linres_types.F b/src/qs_linres_types.F index 83ae9c7ff1..f915b0591b 100644 --- a/src/qs_linres_types.F +++ b/src/qs_linres_types.F @@ -276,7 +276,7 @@ SUBROUTINE linres_control_release(linres_control) IF (ASSOCIATED(linres_control)) THEN CPASSERT(linres_control%ref_count > 0) - linres_control%ref_count = linres_control%ref_count-1 + linres_control%ref_count = linres_control%ref_count - 1 IF (linres_control%ref_count < 1) THEN IF (ASSOCIATED(linres_control%qs_loc_env)) THEN CALL qs_loc_env_release(linres_control%qs_loc_env) @@ -300,7 +300,7 @@ SUBROUTINE linres_control_retain(linres_control) CPASSERT(ASSOCIATED(linres_control)) CPASSERT(linres_control%ref_count > 0) - linres_control%ref_count = linres_control%ref_count+1 + linres_control%ref_count = linres_control%ref_count + 1 END SUBROUTINE linres_control_retain @@ -1496,7 +1496,7 @@ SUBROUTINE polar_env_release(polar_env) IF (ASSOCIATED(polar_env)) THEN CPASSERT(polar_env%ref_count > 0) - polar_env%ref_count = polar_env%ref_count-1 + polar_env%ref_count = polar_env%ref_count - 1 IF (polar_env%ref_count < 1) THEN IF (ASSOCIATED(polar_env%polar)) THEN DEALLOCATE (polar_env%polar) diff --git a/src/qs_loc_dipole.F b/src/qs_loc_dipole.F index 6810abcb41..8dc2515e94 100644 --- a/src/qs_loc_dipole.F +++ b/src/qs_loc_dipole.F @@ -126,7 +126,7 @@ SUBROUTINE loc_dipole(input, dft_control, qs_loc_env, logger, qs_env) ! Charges of the wfc involved ! Warning, this assumes the same occupation for all states - zwfc = 3.0_dp-REAL(dft_control%nspins, dp) + zwfc = 3.0_dp - REAL(dft_control%nspins, dp) DO ispins = 1, dft_control%nspins DO i = 1, SIZE(qs_loc_env%localized_wfn_control%centers_set(ispins)%array, 2) @@ -150,18 +150,18 @@ SUBROUTINE loc_dipole(input, dft_control, qs_loc_env, logger, qs_env) IF (.NOT. ghost .AND. .NOT. floating) THEN CALL get_qs_kind(qs_kind_set(ikind), core_charge=zeff) ria = pbc(particle_set(i)%r, cell) - dipole = dipole+zeff*(ria-rcc) + dipole = dipole + zeff*(ria - rcc) END IF END DO ! Charges of the wfc involved ! Warning, this assumes the same occupation for all states - zwfc = 3.0_dp-REAL(dft_control%nspins, dp) + zwfc = 3.0_dp - REAL(dft_control%nspins, dp) DO ispins = 1, dft_control%nspins DO i = 1, SIZE(qs_loc_env%localized_wfn_control%centers_set(ispins)%array, 2) ria = pbc(qs_loc_env%localized_wfn_control%centers_set(ispins)%array(1:3, i), cell) - dipole = dipole-zwfc*(ria-rcc) + dipole = dipole - zwfc*(ria - rcc) ENDDO ENDDO END IF @@ -185,10 +185,10 @@ SUBROUTINE loc_dipole(input, dft_control, qs_loc_env, logger, qs_env) END IF IF (do_berry) THEN WRITE (unit=unit_nr, fmt="(a,9(es18.8))") & - iter(1:15), dipole, dipole*debye, pbc(dipole-dipole_old, cell) + iter(1:15), dipole, dipole*debye, pbc(dipole - dipole_old, cell) ELSE WRITE (unit=unit_nr, fmt="(a,9(es18.8))") & - iter(1:15), dipole, dipole*debye, (dipole-dipole_old) + iter(1:15), dipole, dipole*debye, (dipole - dipole_old) END IF END IF CALL cp_print_key_finished_output(unit_nr, logger, print_key) diff --git a/src/qs_loc_methods.F b/src/qs_loc_methods.F index d8e104b489..84a8b03c33 100644 --- a/src/qs_loc_methods.F +++ b/src/qs_loc_methods.F @@ -445,13 +445,13 @@ SUBROUTINE centers_spreads_berry(qs_loc_env, zij, nmoloc, cell, weights, ispin, CALL cp_fm_get_element(zij(1, jdir)%matrix, istate, istate, realpart) CALL cp_fm_get_element(zij(2, jdir)%matrix, istate, istate, imagpart) z = CMPLX(realpart, imagpart, dp) - spread_i = spread_i-weights(jdir)* & - LOG(realpart*realpart+imagpart*imagpart)/twopi/twopi - spread_ii = spread_ii+weights(jdir)* & - (1.0_dp-(realpart*realpart+imagpart*imagpart))/twopi/twopi + spread_i = spread_i - weights(jdir)* & + LOG(realpart*realpart + imagpart*imagpart)/twopi/twopi + spread_ii = spread_ii + weights(jdir)* & + (1.0_dp - (realpart*realpart + imagpart*imagpart))/twopi/twopi IF (jdir < 4) THEN DO idir = 1, 3 - c(idir) = c(idir)+ & + c(idir) = c(idir) + & (cell%hmat(idir, jdir)/twopi)*AIMAG(LOG(z)) ENDDO END IF @@ -460,8 +460,8 @@ SUBROUTINE centers_spreads_berry(qs_loc_env, zij, nmoloc, cell, weights, ispin, centers(1:3, istate) = cpbc(1:3) centers(4, istate) = spread_i centers(5, istate) = spread_ii - sum_spread_i = sum_spread_i+centers(4, istate) - sum_spread_ii = sum_spread_ii+centers(5, istate) + sum_spread_i = sum_spread_i + centers(4, istate) + sum_spread_ii = sum_spread_ii + centers(5, istate) IF (unit_out_s > 0 .AND. .NOT. my_only_init) WRITE (unit_out_s, '(I6,2F16.8)') istate, centers(4:5, istate) ENDDO @@ -553,7 +553,7 @@ SUBROUTINE centers_spreads_pipek(qs_loc_env, zij_fm_set, particle_set, ispin, & DO iatom = 1, natom DO istate = 1, nstate - Qii(istate) = Qii(istate)+diag(istate, iatom)*diag(istate, iatom) + Qii(istate) = Qii(istate) + diag(istate, iatom)*diag(istate, iatom) IF (ABS(diag(istate, iatom)) > ziimax(istate)) THEN ziimax(istate) = ABS(diag(istate, iatom)) atom_of_state(istate) = iatom @@ -710,7 +710,7 @@ SUBROUTINE qs_loc_driver(qs_env, qs_loc_env, print_loc_section, myspin, & imoloc = 0 DO i = lb, ub ! Get the index in the subset - imoloc = imoloc+1 + imoloc = imoloc + 1 ! Get the index in the full set imo = localized_wfn_control%loc_states(i, ispin) @@ -743,12 +743,12 @@ SUBROUTINE qs_loc_driver(qs_env, qs_loc_env, print_loc_section, myspin, & ! Provides boundaries of MOs CALL section_vals_val_get(print_loc_section, "WANNIER_CUBES%CUBES_LU_BOUNDS", & i_vals=bounds) - ncubes = bounds(2)-bounds(1)+1 + ncubes = bounds(2) - bounds(1) + 1 IF (ncubes > 0) THEN list_cubes_setup = .TRUE. ALLOCATE (list_cubes(ncubes)) DO ir = 1, ncubes - list_cubes(ir) = bounds(1)+(ir-1) + list_cubes(ir) = bounds(1) + (ir - 1) END DO END IF @@ -761,11 +761,11 @@ SUBROUTINE qs_loc_driver(qs_env, qs_loc_env, print_loc_section, myspin, & CALL section_vals_val_get(print_loc_section, "WANNIER_CUBES%CUBES_LIST", & i_rep_val=ir, i_vals=list) IF (ASSOCIATED(list)) THEN - CALL reallocate(list_cubes, 1, ncubes+SIZE(list)) + CALL reallocate(list_cubes, 1, ncubes + SIZE(list)) DO i = 1, SIZE(list) - list_cubes(i+ncubes) = list(i) + list_cubes(i + ncubes) = list(i) END DO - ncubes = ncubes+SIZE(list) + ncubes = ncubes + SIZE(list) END IF END DO IF (ncubes > 0) list_cubes_setup = .TRUE. @@ -908,7 +908,7 @@ SUBROUTINE qs_print_cubes(qs_env, mo_coeff, nstates, state_list, centers, & END IF DO istate = 1, nstates - ivector = state_list(istate)-my_state0 + ivector = state_list(istate) - my_state0 CALL get_qs_env(qs_env=qs_env, atomic_kind_set=atomic_kind_set, qs_kind_set=qs_kind_set, cell=cell, & dft_control=dft_control, particle_set=particle_set, pw_env=pw_env) @@ -1042,7 +1042,7 @@ SUBROUTINE print_wannier_traj(qs_loc_env, print_key, center, iunit, init_traj, u NULLIFY (particle_set, atomic_kind_set, atomic_kind, logger) logger => cp_get_default_logger() natom = SIZE(qs_loc_env%particle_set) - ntot = natom+SIZE(center, 2) + ntot = natom + SIZE(center, 2) CALL allocate_particle_set(particle_set, ntot) ALLOCATE (atomic_kind_set(1)) atomic_kind => atomic_kind_set(1) @@ -1054,9 +1054,9 @@ SUBROUTINE print_wannier_traj(qs_loc_env, print_key, center, iunit, init_traj, u particle_set(i)%r = pbc(qs_loc_env%particle_set(i)%r, qs_loc_env%cell) END DO ! Wannier Centers - DO i = natom+1, ntot + DO i = natom + 1, ntot particle_set(i)%atomic_kind => atomic_kind - particle_set(i)%r = pbc(center(1:3, i-natom), qs_loc_env%cell) + particle_set(i)%r = pbc(center(1:3, i - natom), qs_loc_env%cell) END DO ! Dump the structure CALL section_vals_val_get(print_key, "FORMAT", i_val=outformat) diff --git a/src/qs_loc_molecules.F b/src/qs_loc_molecules.F index 2acc930719..e7bf73fb6f 100644 --- a/src/qs_loc_molecules.F +++ b/src/qs_loc_molecules.F @@ -80,7 +80,7 @@ SUBROUTINE wfc_to_molecule(qs_loc_env, center, molecule_set, ispin, nspins) i = local_molecules%list(ikind)%array(imol) molecule_kind => molecule_set(i)%molecule_kind CALL get_molecule_kind(molecule_kind=molecule_kind, natom=natom) - natom_max = natom_max+natom + natom_max = natom_max + natom IF (.NOT. ASSOCIATED(molecule_set(i)%lmi)) THEN ALLOCATE (molecule_set(i)%lmi(nspins)) DO k = 1, nspins @@ -119,8 +119,8 @@ SUBROUTINE wfc_to_molecule(qs_loc_env, center, molecule_set, ispin, nspins) CALL get_molecule_kind(molecule_kind=molecule_kind, natom=natom) DO iatom = 1, natom - counter = counter+1 - r(:, counter) = particle_set(first_atom+iatom-1)%r(:) + counter = counter + 1 + r(:, counter) = particle_set(first_atom + iatom - 1)%r(:) END DO END DO END DO @@ -130,9 +130,9 @@ SUBROUTINE wfc_to_molecule(qs_loc_env, center, molecule_set, ispin, nspins) DO istate = 1, nstate distance(:) = 1.E10_dp DO iatom = 1, natom_loc - dr(1) = r(1, iatom)-center(1, istate) - dr(2) = r(2, iatom)-center(2, istate) - dr(3) = r(3, iatom)-center(3, istate) + dr(1) = r(1, iatom) - center(1, istate) + dr(2) = r(2, iatom) - center(2, istate) + dr(3) = r(3, iatom) - center(3, istate) ria = pbc(dr, qs_loc_env%cell) distance(iatom) = SQRT(DOT_PRODUCT(ria, ria)) END DO @@ -165,13 +165,13 @@ SUBROUTINE wfc_to_molecule(qs_loc_env, center, molecule_set, ispin, nspins) imol_now = local_molecules%list(ikind)%array(imol) molecule_kind => molecule_set(imol_now)%molecule_kind CALL get_molecule_kind(molecule_kind=molecule_kind, natom=natom) - counter = counter+natom + counter = counter + natom IF (counter >= iatom) EXIT END DO IF (counter >= iatom) EXIT END DO i = molecule_set(imol_now)%lmi(ispin)%nstates - i = i+1 + i = i + 1 molecule_set(imol_now)%lmi(ispin)%nstates = i CALL reallocate(molecule_set(imol_now)%lmi(ispin)%states, 1, i) molecule_set(imol_now)%lmi(ispin)%states(i) = istate diff --git a/src/qs_loc_states.F b/src/qs_loc_states.F index 921b96c72e..6a0c0261c0 100644 --- a/src/qs_loc_states.F +++ b/src/qs_loc_states.F @@ -146,7 +146,7 @@ SUBROUTINE get_localization_info(qs_env, qs_loc_env, loc_section, mo_local, & ALLOCATE (wc(ispin)%centres(3, ns)) ENDIF - wc(ispin)%centres(:, :) = scenter(1+(ispin-1)*3:ispin*3, :) + wc(ispin)%centres(:, :) = scenter(1 + (ispin - 1)*3:ispin*3, :) lstates => qs_loc_env%localized_wfn_control%loc_states(:, ispin) CALL construct_wannier_states(mo_local(ispin)%matrix, & ks_rmpv(ispin)%matrix, qs_env, loc_print_section=loc_print_section, & diff --git a/src/qs_loc_types.F b/src/qs_loc_types.F index 4bc9d58a75..4767e76dd9 100644 --- a/src/qs_loc_types.F +++ b/src/qs_loc_types.F @@ -220,7 +220,7 @@ SUBROUTINE qs_loc_env_destroy(qs_loc_env) IF (ASSOCIATED(qs_loc_env%moloc_coeff)) THEN DO i = 1, SIZE(qs_loc_env%moloc_coeff, 1) - ii = LBOUND(qs_loc_env%moloc_coeff, 1)+i-1 + ii = LBOUND(qs_loc_env%moloc_coeff, 1) + i - 1 CALL cp_fm_release(qs_loc_env%moloc_coeff(ii)%matrix) END DO DEALLOCATE (qs_loc_env%moloc_coeff) @@ -266,7 +266,7 @@ SUBROUTINE qs_loc_env_release(qs_loc_env) IF (ASSOCIATED(qs_loc_env)) THEN CPASSERT(qs_loc_env%ref_count > 0) - qs_loc_env%ref_count = qs_loc_env%ref_count-1 + qs_loc_env%ref_count = qs_loc_env%ref_count - 1 IF (qs_loc_env%ref_count == 0) THEN CALL qs_loc_env_destroy(qs_loc_env) END IF @@ -291,7 +291,7 @@ SUBROUTINE qs_loc_env_retain(qs_loc_env) CPASSERT(ASSOCIATED(qs_loc_env)) CPASSERT(qs_loc_env%ref_count > 0) - qs_loc_env%ref_count = qs_loc_env%ref_count+1 + qs_loc_env%ref_count = qs_loc_env%ref_count + 1 END SUBROUTINE qs_loc_env_retain ! ************************************************************************************************** @@ -338,7 +338,7 @@ SUBROUTINE localized_wfn_control_release(localized_wfn_control) IF (ASSOCIATED(localized_wfn_control)) THEN CPASSERT(localized_wfn_control%ref_count > 0) - localized_wfn_control%ref_count = localized_wfn_control%ref_count-1 + localized_wfn_control%ref_count = localized_wfn_control%ref_count - 1 IF (localized_wfn_control%ref_count == 0) THEN IF (ASSOCIATED(localized_wfn_control%loc_states)) THEN DEALLOCATE (localized_wfn_control%loc_states) @@ -369,7 +369,7 @@ SUBROUTINE localized_wfn_control_retain(localized_wfn_control) CPASSERT(ASSOCIATED(localized_wfn_control)) - localized_wfn_control%ref_count = localized_wfn_control%ref_count+1 + localized_wfn_control%ref_count = localized_wfn_control%ref_count + 1 END SUBROUTINE localized_wfn_control_retain !****f* qs_loc_types/get_qs_loc_env [1.0] * diff --git a/src/qs_loc_utils.F b/src/qs_loc_utils.F index a22018b0b6..085f7d628e 100644 --- a/src/qs_loc_utils.F +++ b/src/qs_loc_utils.F @@ -248,17 +248,17 @@ SUBROUTINE jacobi_rotation_pipek(zij_fm_set, vectors, sweeps) natom = SIZE(zij_fm_set, 1) ! do jacobi sweeps until converged DO WHILE (tolerance >= 1.0e-4_dp) - sweeps = sweeps+1 + sweeps = sweeps + 1 DO istate = 1, nstate - DO jstate = istate+1, nstate + DO jstate = istate + 1, nstate aij = 0.0_dp bij = 0.0_dp DO iatom = 1, natom CALL cp_fm_get_element(zij_fm_set(iatom, 1)%matrix, istate, istate, mii) CALL cp_fm_get_element(zij_fm_set(iatom, 1)%matrix, istate, jstate, mij) CALL cp_fm_get_element(zij_fm_set(iatom, 1)%matrix, jstate, jstate, mjj) - aij = aij+mij*(mii-mjj) - bij = bij+mij*mij-0.25_dp*(mii-mjj)*(mii-mjj) + aij = aij + mij*(mii - mjj) + bij = bij + mij*mij - 0.25_dp*(mii - mjj)*(mii - mjj) END DO IF (ABS(bij) > 1.E-10_dp) THEN @@ -271,9 +271,9 @@ SUBROUTINE jacobi_rotation_pipek(zij_fm_set, vectors, sweeps) ! Check max or min ! To minimize the spread IF (theta > pi*0.5_dp) THEN - theta = theta-pi*0.25_dp + theta = theta - pi*0.25_dp ELSE IF (theta < -pi*0.5_dp) THEN - theta = theta+pi*0.25_dp + theta = theta + pi*0.25_dp END IF ct = COS(theta) @@ -418,7 +418,7 @@ SUBROUTINE check_tolerance_real(zij_fm_set, tolerance) zii = diag(istate, iatom) zjj = diag(jstate, iatom) zij = zij_fm_set(iatom, 1)%matrix%local_data(istate, jstate) - grad_ij = grad_ij+4.0_dp*zij*(zjj-zii) + grad_ij = grad_ij + 4.0_dp*zij*(zjj - zii) END DO force%local_data(istate, jstate) = grad_ij END DO @@ -507,7 +507,7 @@ SUBROUTINE qs_loc_env_init(qs_loc_env, localized_wfn_control, qs_env, myspin, do IF (localized_wfn_control%do_homo) THEN CPASSERT(nmo >= nmosub) ELSE - CPASSERT(nao-nmo >= nmosub) + CPASSERT(nao - nmo >= nmosub) END IF CALL cp_fm_set_all(moloc_coeff(ispin)%matrix, 0.0_dp) CALL cp_fm_struct_release(tmp_fm_struct) @@ -535,12 +535,12 @@ SUBROUTINE qs_loc_env_init(qs_loc_env, localized_wfn_control, qs_env, myspin, do imoloc = 0 DO i = lb, ub ! Get the index in the subset - imoloc = imoloc+1 + imoloc = imoloc + 1 ! Get the index in the full set imo = localized_wfn_control%loc_states(i, ispin) IF (localized_wfn_control%do_homo) THEN occ_imo = occupations(imo) - IF (ABS(occ_imo-my_occ) > localized_wfn_control%eps_occ) THEN + IF (ABS(occ_imo - my_occ) > localized_wfn_control%eps_occ) THEN IF (localized_wfn_control%localization_method /= do_loc_none) & CALL cp_abort(__LOCATION__, & "States with different occupations "// & @@ -557,7 +557,7 @@ SUBROUTINE qs_loc_env_init(qs_loc_env, localized_wfn_control, qs_env, myspin, do ELSE my_occ = occupations(lb) occ_imo = occupations(ub) - IF (ABS(occ_imo-my_occ) > localized_wfn_control%eps_occ) THEN + IF (ABS(occ_imo - my_occ) > localized_wfn_control%eps_occ) THEN IF (localized_wfn_control%localization_method /= do_loc_none) & CALL cp_abort(__LOCATION__, & "States with different occupations "// & @@ -737,9 +737,9 @@ SUBROUTINE get_berry_operator(qs_loc_env, qs_env) vector_k(:, 1) = twopi*cell%h_inv(1, :) vector_k(:, 2) = twopi*cell%h_inv(2, :) vector_k(:, 3) = twopi*cell%h_inv(3, :) - vector_k(:, 4) = twopi*(cell%h_inv(1, :)+cell%h_inv(2, :)) - vector_k(:, 5) = twopi*(cell%h_inv(1, :)+cell%h_inv(3, :)) - vector_k(:, 6) = twopi*(cell%h_inv(2, :)+cell%h_inv(3, :)) + vector_k(:, 4) = twopi*(cell%h_inv(1, :) + cell%h_inv(2, :)) + vector_k(:, 5) = twopi*(cell%h_inv(1, :) + cell%h_inv(3, :)) + vector_k(:, 6) = twopi*(cell%h_inv(2, :) + cell%h_inv(3, :)) ! This operator can be used only for periodic systems ! If an isolated system is used the periodicity is overimposed @@ -792,7 +792,7 @@ SUBROUTINE get_berry_operator(qs_loc_env, qs_env) ldsb = SIZE(sphi_b, 1) IF (inode == 1) last_jatom = 0 - rb = rab+ra + rb = rab + ra IF (jatom /= last_jatom) THEN new_atom_b = .TRUE. @@ -820,7 +820,7 @@ SUBROUTINE get_berry_operator(qs_loc_env, qs_env) END DO END IF ! new_atom_b - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) dab = SQRT(rab2) nrow = 0 @@ -834,7 +834,7 @@ SUBROUTINE get_berry_operator(qs_loc_env, qs_env) ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) - IF (set_radius_a(iset)+set_radius_b(jset) >= dab) THEN + IF (set_radius_a(iset) + set_radius_b(jset) >= dab) THEN ! *** Calculate the primitive overlap integrals *** DO i = 1, dim_op @@ -857,7 +857,7 @@ SUBROUTINE get_berry_operator(qs_loc_env, qs_env) END DO ! jset - nrow = nrow+ncoa + nrow = nrow + ncoa END DO ! iset @@ -1298,7 +1298,7 @@ SUBROUTINE qs_loc_init(qs_env, qs_loc_env, localize_section, mos_localized, & nmoloc(ispin) = NINT(nelectron/occupation(1)) IF (n_mo(ispin) > homo) THEN DO i = nmoloc(ispin), 1, -1 - IF (occupation(1)-occupation(i) < localized_wfn_control%eps_occ) THEN + IF (occupation(1) - occupation(i) < localized_wfn_control%eps_occ) THEN ilast_intocc = i EXIT END IF @@ -1333,9 +1333,9 @@ SUBROUTINE qs_loc_init(qs_env, qs_loc_env, localize_section, mos_localized, & END DO localized_wfn_control%lu_bound_states(1, ispin) = ilow localized_wfn_control%lu_bound_states(2, ispin) = iup - localized_wfn_control%nloc_states(ispin) = iup-ilow+1 + localized_wfn_control%nloc_states(ispin) = iup - ilow + 1 nmoloc(ispin) = localized_wfn_control%nloc_states(ispin) - IF (occupation(ilow)-occupation(iup) > localized_wfn_control%eps_occ) THEN + IF (occupation(ilow) - occupation(iup) > localized_wfn_control%eps_occ) THEN CALL cp_abort(__LOCATION__, & "The selected energy range includes orbitals with different occupation number. "// & " The localization procedure cannot be applied.") @@ -1343,14 +1343,14 @@ SUBROUTINE qs_loc_init(qs_env, qs_loc_env, localize_section, mos_localized, & IF (output_unit > 0) WRITE (output_unit, "(/,T2,A,I4,A,I6,A)") "LOCALIZATION| Spin ", ispin, " : ", & nmoloc(ispin), " orbitals in the selected energy range are localized." ELSE IF (localized_wfn_control%set_of_states == state_loc_all .AND. (.NOT. my_do_homo)) THEN - nmoloc(ispin) = n_mo(ispin)-homo - localized_wfn_control%lu_bound_states(1, ispin) = homo+1 + nmoloc(ispin) = n_mo(ispin) - homo + localized_wfn_control%lu_bound_states(1, ispin) = homo + 1 localized_wfn_control%lu_bound_states(2, ispin) = n_mo(ispin) IF (output_unit > 0) & WRITE (output_unit, "(/,T2,A,I4,A,I6,A,/,T15,A,F12.6,A,F12.6,A)") & "LOCALIZATION| Spin ", ispin, " The first ", & nmoloc(ispin), " virtual orbitals are localized,", " with energies from ", & - mo_eigenvalues(homo+1), " to ", mo_eigenvalues(n_mo(ispin)), " [a.u.]." + mo_eigenvalues(homo + 1), " to ", mo_eigenvalues(n_mo(ispin)), " [a.u.]." ELSE nmoloc(ispin) = MIN(localized_wfn_control%nloc_states(1), n_mo(ispin)) IF (output_unit > 0 .AND. my_do_homo) WRITE (output_unit, "(/,T2,A,I4,A,I6,A)") "LOCALIZATION| Spin ", ispin, & @@ -1361,7 +1361,7 @@ SUBROUTINE qs_loc_init(qs_env, qs_loc_env, localize_section, mos_localized, & ilow = localized_wfn_control%loc_states(1, ispin) DO i = 2, nmoloc(ispin) iup = localized_wfn_control%loc_states(i, ispin) - IF (ABS(occupation(ilow)-occupation(iup)) > localized_wfn_control%eps_occ) THEN + IF (ABS(occupation(ilow) - occupation(iup)) > localized_wfn_control%eps_occ) THEN ! write warning CALL cp_warn(__LOCATION__, & "User requested the calculation of localized wavefunction from a subset of MOs, "// & @@ -1373,7 +1373,7 @@ SUBROUTINE qs_loc_init(qs_env, qs_loc_env, localize_section, mos_localized, & END IF ENDIF ENDDO ! ispin - n_mos(:) = nao-n_mo(:) + n_mos(:) = nao - n_mo(:) IF (my_do_homo) n_mos = n_mo CALL set_loc_wfn_lists(localized_wfn_control, nmoloc, n_mos, nspin) END IF @@ -1485,11 +1485,11 @@ SUBROUTINE read_loc_section(localized_wfn_control, loc_section, & NULLIFY (list) CALL section_vals_val_get(loc_section, "LIST", i_rep_val=ir, i_vals=list) IF (ASSOCIATED(list)) THEN - CALL reallocate(loc_list, 1, n_list+SIZE(list)) + CALL reallocate(loc_list, 1, n_list + SIZE(list)) DO i = 1, SIZE(list) - loc_list(n_list+i) = list(i) + loc_list(n_list + i) = list(i) END DO ! i - n_list = n_list+SIZE(list) + n_list = n_list + SIZE(list) END IF END DO ! ir IF (n_list /= 0) THEN @@ -1519,11 +1519,11 @@ SUBROUTINE read_loc_section(localized_wfn_control, loc_section, & NULLIFY (list) CALL section_vals_val_get(loc_section, "LIST_UNOCCUPIED", i_rep_val=ir, i_vals=list) IF (ASSOCIATED(list)) THEN - CALL reallocate(loc_list, 1, n_list+SIZE(list)) + CALL reallocate(loc_list, 1, n_list + SIZE(list)) DO i = 1, SIZE(list) - loc_list(n_list+i) = list(i) + loc_list(n_list + i) = list(i) END DO ! i - n_list = n_list+SIZE(list) + n_list = n_list + SIZE(list) END IF END DO ! ir IF (n_list /= 0) THEN @@ -1594,15 +1594,15 @@ SUBROUTINE read_loc_section(localized_wfn_control, loc_section, & CASE (state_loc_list) WRITE (UNIT=output_unit, FMT="(T2,A)") & "LOCALIZE| Orbitals to be localized: Those with index in the following list" - nline = localized_wfn_control%nloc_states(1)/10+1 + nline = localized_wfn_control%nloc_states(1)/10 + 1 ind = 0 DO i = 1, nline - IF (ind+10 < localized_wfn_control%nloc_states(1)) THEN - WRITE (UNIT=output_unit, FMT="(T8,10I7)") localized_wfn_control%loc_states(ind+1:ind+10, 1) - ind = ind+10 + IF (ind + 10 < localized_wfn_control%nloc_states(1)) THEN + WRITE (UNIT=output_unit, FMT="(T8,10I7)") localized_wfn_control%loc_states(ind + 1:ind + 10, 1) + ind = ind + 10 ELSE WRITE (UNIT=output_unit, FMT="(T8,10I7)") & - localized_wfn_control%loc_states(ind+1:localized_wfn_control%nloc_states(1), 1) + localized_wfn_control%loc_states(ind + 1:localized_wfn_control%nloc_states(1), 1) ind = localized_wfn_control%nloc_states(1) END IF END DO @@ -1742,10 +1742,10 @@ SUBROUTINE set_loc_wfn_lists(localized_wfn_control, nmoloc, nmo, nspins, my_spin localized_wfn_control%lu_bound_states(1, ispin) = & localized_wfn_control%lu_bound_states(1, my_spin) localized_wfn_control%lu_bound_states(2, ispin) = & - localized_wfn_control%lu_bound_states(1, my_spin)+nmoloc(ispin)-1 + localized_wfn_control%lu_bound_states(1, my_spin) + nmoloc(ispin) - 1 max_iloc = localized_wfn_control%lu_bound_states(2, ispin) DO i = 1, nmoloc(ispin) - localized_wfn_control%loc_states(i, ispin) = localized_wfn_control%lu_bound_states(1, ispin)+i-1 + localized_wfn_control%loc_states(i, ispin) = localized_wfn_control%lu_bound_states(1, ispin) + i - 1 END DO CPASSERT(max_iloc <= nmo(ispin)) END DO @@ -1755,7 +1755,7 @@ SUBROUTINE set_loc_wfn_lists(localized_wfn_control, nmoloc, nmo, nspins, my_spin localized_wfn_control%loc_states = 0 DO ispin = 1, nspins DO i = 1, nmoloc(ispin) - localized_wfn_control%loc_states(i, ispin) = localized_wfn_control%lu_bound_states(1, ispin)+i-1 + localized_wfn_control%loc_states(i, ispin) = localized_wfn_control%lu_bound_states(1, ispin) + i - 1 END DO END DO CASE (state_loc_all) @@ -1777,7 +1777,7 @@ SUBROUTINE set_loc_wfn_lists(localized_wfn_control, nmoloc, nmo, nspins, my_spin IF (nmoloc(ispin) < 1) localized_wfn_control%lu_bound_states(1, ispin) = 0 DO i = 1, nmoloc(ispin) localized_wfn_control%loc_states(i, ispin) = & - localized_wfn_control%lu_bound_states(1, ispin)+i-1 + localized_wfn_control%lu_bound_states(1, ispin) + i - 1 END DO END DO END IF diff --git a/src/qs_local_properties.F b/src/qs_local_properties.F index 0093246a1e..f0933fb56e 100644 --- a/src/qs_local_properties.F +++ b/src/qs_local_properties.F @@ -234,7 +234,7 @@ SUBROUTINE qs_local_energy(qs_env, energy_density) WRITE (UNIT=iounit, FMT="(T4,A,T65,F15.8)") "Hartree Energy Correction", eh WRITE (UNIT=iounit, FMT="(T4,A,T65,F15.8)") "XC Energy Correction", exc WRITE (UNIT=iounit, FMT="(T4,A,T45,F15.8,T65,F15.8)") "Total Energy", & - energy%total, eban+eh+exc+energy%core_overlap+energy%core_self+energy%dispersion + energy%total, eban + eh + exc + energy%core_overlap + energy%core_self + energy%dispersion WRITE (UNIT=iounit, FMT="(T3,A)") REPEAT("=", 78) END IF @@ -383,7 +383,7 @@ SUBROUTINE qs_local_stress(qs_env, stress_tensor, pressure, beta) WRITE (UNIT=iounit, FMT="(T4,A)") "Local Stress Calculation" WRITE (UNIT=iounit, FMT="(T42,A,T64,A)") " 1/3 Trace", " Determinant" WRITE (UNIT=iounit, FMT="(T4,A,T42,F16.8,T64,F16.8)") "Total Stress", & - (pv_loc(1, 1)+pv_loc(2, 2)+pv_loc(3, 3))/3.0_dp, det_3x3(pv_loc) + (pv_loc(1, 1) + pv_loc(2, 2) + pv_loc(3, 3))/3.0_dp, det_3x3(pv_loc) WRITE (UNIT=iounit, FMT="(T3,A)") REPEAT("=", 78) END IF diff --git a/src/qs_local_rho_types.F b/src/qs_local_rho_types.F index 6667969b25..7090b67f6b 100644 --- a/src/qs_local_rho_types.F +++ b/src/qs_local_rho_types.F @@ -134,10 +134,10 @@ SUBROUTINE calculate_rhoz(rhoz, grid_atom, alpha, zeff, natom, rhoz_tot, harmoni rhoz%dr_coef(ir) = prefactor2*rhoz%r_coef(ir) END IF rhoz%vr_coef(ir) = prefactor3*erf(grid_atom%rad(ir)*c3)/grid_atom%rad(ir) - sum = sum+rhoz%r_coef(ir)*grid_atom%wr(ir) + sum = sum + rhoz%r_coef(ir)*grid_atom%wr(ir) END DO rhoz%one_atom = sum*harmonics%slm_int(1) - rhoz_tot = rhoz_tot+natom*rhoz%one_atom + rhoz_tot = rhoz_tot + natom*rhoz%one_atom END SUBROUTINE calculate_rhoz diff --git a/src/qs_localization_methods.F b/src/qs_localization_methods.F index 92cfd5ef9b..4999c69e31 100644 --- a/src/qs_localization_methods.F +++ b/src/qs_localization_methods.F @@ -151,7 +151,7 @@ SUBROUTINE approx_l1_norm_sd(C, iterations, eps, converged, sweeps) f2 = 0.0_dp DO p = 1, ncol_local ! p DO i = 1, nrow_local ! i - f2 = f2+SQRT(C%local_data(i, p)**2+f2_eps) + f2 = f2 + SQRT(C%local_data(i, p)**2 + f2_eps) ENDDO ENDDO CALL mp_sum(f2, C%matrix_struct%para_env%group) @@ -161,7 +161,7 @@ SUBROUTINE approx_l1_norm_sd(C, iterations, eps, converged, sweeps) ! f_2(x)=(x^2+eps)^1/2 DO p = 1, ncol_local ! p DO i = 1, nrow_local ! i - CTmp%local_data(i, p) = C%local_data(i, p)/SQRT(C%local_data(i, p)**2+f2_eps) + CTmp%local_data(i, p) = C%local_data(i, p)/SQRT(C%local_data(i, p)**2 + f2_eps) ENDDO ENDDO CALL cp_gemm('T', 'N', k, k, n, 1.0_dp, CTmp, C, 0.0_dp, G) @@ -207,13 +207,13 @@ SUBROUTINE approx_l1_norm_sd(C, iterations, eps, converged, sweeps) ! ! printing IF (output_unit .GT. 0) THEN - WRITE (output_unit, '(10X,I4,E18.10,2E10.2)') istep, f2, gnorm, ABS((f2-f2old)/f2) + WRITE (output_unit, '(10X,I4,E18.10,2E10.2)') istep, f2, gnorm, ABS((f2 - f2old)/f2) ENDIF ! ! Are we done? sweeps = istep !IF(gnorm.LE.grad_thresh.AND.ABS((f2-f2old)/f2).LE.f2_thresh.AND.istep.GT.1) THEN - IF (ABS((f2-f2old)/f2) .LE. eps .AND. istep .GT. 1) THEN + IF (ABS((f2 - f2old)/f2) .LE. eps .AND. istep .GT. 1) THEN converged = .TRUE. EXIT ENDIF @@ -266,9 +266,9 @@ SUBROUTINE initialize_weights(cell, weights) metric = 0.0_dp CALL dgemm('T', 'N', 3, 3, 3, 1._dp, cell%hmat, 3, cell%hmat, 3, 0.0_dp, metric, 3) - weights(1) = METRIC(1, 1)-METRIC(1, 2)-METRIC(1, 3) - weights(2) = METRIC(2, 2)-METRIC(1, 2)-METRIC(2, 3) - weights(3) = METRIC(3, 3)-METRIC(1, 3)-METRIC(2, 3) + weights(1) = METRIC(1, 1) - METRIC(1, 2) - METRIC(1, 3) + weights(2) = METRIC(2, 2) - METRIC(1, 2) - METRIC(2, 3) + weights(3) = METRIC(3, 3) - METRIC(1, 3) - METRIC(2, 3) weights(4) = METRIC(1, 2) weights(5) = METRIC(1, 3) weights(6) = METRIC(2, 3) @@ -374,10 +374,10 @@ SUBROUTINE jacobi_rotations_serial(weights, zij, vectors, max_iter, eps_localiza END IF ! do jacobi sweeps until converged DO WHILE (tolerance >= eps_localization .AND. sweeps < max_iter) - sweeps = sweeps+1 + sweeps = sweeps + 1 t1 = m_walltime() DO istate = 1, nstate - DO jstate = istate+1, nstate + DO jstate = istate + 1, nstate DO idim = 1, dim2 CALL cp_cfm_get_element(c_zij(idim)%matrix, istate, istate, mii(idim)) CALL cp_cfm_get_element(c_zij(idim)%matrix, istate, jstate, mij(idim)) @@ -394,7 +394,7 @@ SUBROUTINE jacobi_rotations_serial(weights, zij, vectors, max_iter, eps_localiza t2 = m_walltime() IF (unit_nr > 0 .AND. MODULO(sweeps, out_each) == 0) THEN WRITE (unit_nr, '(T4,A,I7,T30,A,E12.4,T60,A,F8.3)') & - "Iteration:", sweeps, "Tolerance:", tolerance, "Time:", t2-t1 + "Iteration:", sweeps, "Tolerance:", tolerance, "Time:", t2 - t1 CALL m_flush(unit_nr) ENDIF END DO @@ -508,9 +508,9 @@ SUBROUTINE get_angle(mii, mjj, mij, weights, theta) z11 = mii(idim) z22 = mjj(idim) z12 = mij(idim) - a12 = a12+weights(idim)*REAL(CONJG(z12)*(z11-z22), KIND=dp) - b12 = b12+weights(idim)*REAL((z12*CONJG(z12)- & - 0.25_dp*(z11-z22)*(CONJG(z11)-CONJG(z22))), KIND=dp) + a12 = a12 + weights(idim)*REAL(CONJG(z12)*(z11 - z22), KIND=dp) + b12 = b12 + weights(idim)*REAL((z12*CONJG(z12) - & + 0.25_dp*(z11 - z22)*(CONJG(z11) - CONJG(z22))), KIND=dp) END DO IF (ABS(b12) > 1.e-10_dp) THEN ratio = -a12/b12 @@ -522,12 +522,12 @@ SUBROUTINE get_angle(mii, mjj, mij, weights, theta) theta = 0.25_dp*pi ENDIF ! Check second derivative info - d2 = a12*SIN(4._dp*theta)-b12*COS(4._dp*theta) + d2 = a12*SIN(4._dp*theta) - b12*COS(4._dp*theta) IF (d2 <= 0._dp) THEN ! go to the maximum, not the minimum IF (theta > 0.0_dp) THEN ! make theta as small as possible - theta = theta-0.25_dp*pi + theta = theta - 0.25_dp*pi ELSE - theta = theta+0.25_dp*pi + theta = theta + 0.25_dp*pi ENDIF ENDIF END SUBROUTINE get_angle @@ -610,8 +610,8 @@ SUBROUTINE gradsq_at_0(diag, weights, matrix, ndim) DO idim = 1, ndim zii = diag(row_indices(istate), idim) zjj = diag(col_indices(jstate), idim) - gradsq_ij = gradsq_ij+weights(idim)* & - 4.0_dp*REAL((CONJG(zii)*zii+CONJG(zjj)*zjj), KIND=dp) + gradsq_ij = gradsq_ij + weights(idim)* & + 4.0_dp*REAL((CONJG(zii)*zii + CONJG(zjj)*zjj), KIND=dp) END DO matrix%local_data(istate, jstate) = gradsq_ij END DO @@ -656,8 +656,8 @@ SUBROUTINE grad_at_0(matrix_p, weights, matrix) zii = diag(row_indices(istate), idim) zjj = diag(col_indices(jstate), idim) zij = matrix_p(idim)%matrix%local_data(istate, jstate) - grad_ij = grad_ij+weights(idim)* & - REAL(4.0_dp*CONJG(zij)*(zjj-zii), dp) + grad_ij = grad_ij + weights(idim)* & + REAL(4.0_dp*CONJG(zij)*(zjj - zii), dp) END DO matrix%local_data(istate, jstate) = grad_ij END DO @@ -696,7 +696,7 @@ SUBROUTINE check_tolerance_new(weights, zij, tolerance, value) CALL cp_fm_get_element(zij(1, idim)%matrix, istate, istate, ra) CALL cp_fm_get_element(zij(2, idim)%matrix, istate, istate, rb) diag(istate, idim) = CMPLX(ra, rb, dp) - value = value+weights(idim)-weights(idim)*ABS(diag(istate, idim))**2 + value = value + weights(idim) - weights(idim)*ABS(diag(istate, idim))**2 ENDDO ENDDO tolerance = 0.0_dp @@ -709,8 +709,8 @@ SUBROUTINE check_tolerance_new(weights, zij, tolerance, value) ra = zij(1, idim)%matrix%local_data(istate, jstate) rb = zij(2, idim)%matrix%local_data(istate, jstate) kij = CMPLX(ra, rb, dp) - grad_ij = grad_ij+weights(idim)* & - REAL(4.0_dp*CONJG(kij)*(kjj-kii), dp) + grad_ij = grad_ij + weights(idim)* & + REAL(4.0_dp*CONJG(kij)*(kjj - kii), dp) END DO tolerance = MAX(ABS(grad_ij), tolerance) ENDDO @@ -826,7 +826,7 @@ SUBROUTINE crazy_rotations(weights, zij, vectors, max_iter, max_crazy_angle, cra tolerance = 1.0_dp DO - iterations = iterations+1 + iterations = iterations + 1 DO idim = 1, dim2 DO i = 1, nrow_global CALL cp_fm_get_element(zij(1, idim)%matrix, i, i, ra) @@ -1032,7 +1032,7 @@ SUBROUTINE direct_mini(weights, zij, vectors, max_iter, eps_localization, iterat line_searches = 0 line_search_count = 0 DO - iterations = iterations+1 + iterations = iterations + 1 ! compute U,R,evals given A cmat_A%local_data = CMPLX(0.0_dp, matrix_A%local_data, dp) ! cmat_A is hermitian, evals are reals CALL cp_cfm_heevd(cmat_A, cmat_R, evals) @@ -1076,16 +1076,16 @@ SUBROUTINE direct_mini(weights, zij, vectors, max_iter, eps_localization, iterat fval(i) = -weights(idim)*LOG(ABS(diag_z(i, idim))**2) fvald(i) = -weights(idim)/(ABS(diag_z(i, idim))**2) CASE (2) ! corresponds to the jacobi setup - fval(i) = weights(idim)-weights(idim)*ABS(diag_z(i, idim))**2 + fval(i) = weights(idim) - weights(idim)*ABS(diag_z(i, idim))**2 fvald(i) = -weights(idim) END SELECT - omega = omega+fval(i) + omega = omega + fval(i) ENDDO DO icol = 1, ncol_local DO irow = 1, nrow_local tmp = cmat_t1%local_data(irow, icol)*CONJG(diag_z(col_indices(icol), idim)) cmat_M%local_data(irow, icol) = cmat_M%local_data(irow, icol) & - +4.0_dp*fvald(col_indices(icol))*REAL(tmp, KIND=dp) + + 4.0_dp*fvald(col_indices(icol))*REAL(tmp, KIND=dp) ENDDO ENDDO ENDDO @@ -1102,16 +1102,16 @@ SUBROUTINE direct_mini(weights, zij, vectors, max_iter, eps_localization, iterat DO irow = 1, nrow_local ll = (0.0_dp, -1.0_dp)*evals(row_indices(irow)) lk = (0.0_dp, -1.0_dp)*evals(col_indices(icol)) - IF (ABS(ll-lk) .LT. 0.5_dp) THEN ! use a series expansion to avoid loss of precision + IF (ABS(ll - lk) .LT. 0.5_dp) THEN ! use a series expansion to avoid loss of precision tmp = 1.0_dp cmat_B%local_data(irow, icol) = 0.0_dp DO i = 1, 16 - cmat_B%local_data(irow, icol) = cmat_B%local_data(irow, icol)+tmp - tmp = tmp*(ll-lk)/(i+1) + cmat_B%local_data(irow, icol) = cmat_B%local_data(irow, icol) + tmp + tmp = tmp*(ll - lk)/(i + 1) ENDDO cmat_B%local_data(irow, icol) = cmat_B%local_data(irow, icol)*EXP(lk) ELSE - cmat_B%local_data(irow, icol) = (EXP(lk)-EXP(ll))/(lk-ll) + cmat_B%local_data(irow, icol) = (EXP(lk) - EXP(ll))/(lk - ll) ENDIF ENDDO ENDDO @@ -1130,7 +1130,7 @@ SUBROUTINE direct_mini(weights, zij, vectors, max_iter, eps_localization, iterat ! from here on, minimizing technology IF (new_direction) THEN ! energy converged up to machine precision ? - line_searches = line_searches+1 + line_searches = line_searches + 1 ! DO i=1,line_search_count ! write(15,*) pos(i),energy(i) ! ENDDO @@ -1156,7 +1156,7 @@ SUBROUTINE direct_mini(weights, zij, vectors, max_iter, eps_localization, iterat ENDDO CALL cp_fm_trace(matrix_G, matrix_G_old, normg) normg = normg*0.5_dp - beta_pr = (normg-normg_cross)/normg_old + beta_pr = (normg - normg_cross)/normg_old normg_old = normg beta_pr = MAX(beta_pr, 0.0_dp) CALL cp_fm_scale_and_add(beta_pr, matrix_G_search, -1.0_dp, matrix_G_old) @@ -1175,7 +1175,7 @@ SUBROUTINE direct_mini(weights, zij, vectors, max_iter, eps_localization, iterat ! ds_min=1.0E-4_dp line_search_count = 0 END IF - line_search_count = line_search_count+1 + line_search_count = line_search_count + 1 energy(line_search_count) = Omega ! line search section @@ -1194,10 +1194,10 @@ SUBROUTINE direct_mini(weights, zij, vectors, max_iter, eps_localization, iterat c = energy(1) b = grad(1) x1 = pos(2) - a = (energy(2)-b*x1-c)/(x1**2) + a = (energy(2) - b*x1 - c)/(x1**2) IF (a .LE. 0.0_dp) a = 1.0E-15_dp npos = -b/(2.0_dp*a) - val = a*npos**2+b*npos+c + val = a*npos**2 + b*npos + c IF (val .LT. energy(1) .AND. val .LE. energy(2)) THEN ! we go to a minimum, but ... ! we take a guard against too large steps @@ -1227,16 +1227,16 @@ SUBROUTINE direct_mini(weights, zij, vectors, max_iter, eps_localization, iterat fa = energy(1) fb = energy(2) fc = energy(3) - nom = (xb-xa)**2*(fb-fc)-(xb-xc)**2*(fb-fa) - denom = (xb-xa)*(fb-fc)-(xb-xc)*(fb-fa) - IF (ABS(denom) .LE. 1.0E-18_dp*MAX(ABS(fb-fc), ABS(fb-fa))) THEN + nom = (xb - xa)**2*(fb - fc) - (xb - xc)**2*(fb - fa) + denom = (xb - xa)*(fb - fc) - (xb - xc)*(fb - fa) + IF (ABS(denom) .LE. 1.0E-18_dp*MAX(ABS(fb - fc), ABS(fb - fa))) THEN npos = xb ELSE - npos = xb-0.5_dp*nom/denom ! position of the stationary point + npos = xb - 0.5_dp*nom/denom ! position of the stationary point ENDIF - val = (npos-xa)*(npos-xb)*fc/((xc-xa)*(xc-xb))+ & - (npos-xb)*(npos-xc)*fa/((xa-xb)*(xa-xc))+ & - (npos-xc)*(npos-xa)*fb/((xb-xc)*(xb-xa)) + val = (npos - xa)*(npos - xb)*fc/((xc - xa)*(xc - xb)) + & + (npos - xb)*(npos - xc)*fa/((xa - xb)*(xa - xc)) + & + (npos - xc)*(npos - xa)*fb/((xb - xc)*(xb - xa)) IF (val .LT. fa .AND. val .LE. fb .AND. val .LE. fc) THEN ! OK, we go to a minimum ! we take a guard against too large steps pos(4) = MAX(MAXVAL(pos(1:3))*0.01_dp, & @@ -1256,13 +1256,13 @@ SUBROUTINE direct_mini(weights, zij, vectors, max_iter, eps_localization, iterat ELSE IF (line_search_count .EQ. 150) CPABORT("Too many") IF (lsr .EQ. 0) THEN - IF (energy(line_search_count-1) .LT. energy(line_search_count)) THEN + IF (energy(line_search_count - 1) .LT. energy(line_search_count)) THEN lsr = line_search_count - pos(line_search_count+1) = pos(lsm)+(pos(lsr)-pos(lsm))*gold_sec + pos(line_search_count + 1) = pos(lsm) + (pos(lsr) - pos(lsm))*gold_sec ELSE lsl = lsm lsm = line_search_count - pos(line_search_count+1) = pos(line_search_count)/gold_sec + pos(line_search_count + 1) = pos(line_search_count)/gold_sec ENDIF ELSE IF (pos(line_search_count) .LT. pos(lsm)) THEN @@ -1280,20 +1280,20 @@ SUBROUTINE direct_mini(weights, zij, vectors, max_iter, eps_localization, iterat lsr = line_search_count ENDIF ENDIF - IF (pos(lsr)-pos(lsm) .GT. pos(lsm)-pos(lsl)) THEN - pos(line_search_count+1) = pos(lsm)+gold_sec*(pos(lsr)-pos(lsm)) + IF (pos(lsr) - pos(lsm) .GT. pos(lsm) - pos(lsl)) THEN + pos(line_search_count + 1) = pos(lsm) + gold_sec*(pos(lsr) - pos(lsm)) ELSE - pos(line_search_count+1) = pos(lsl)+gold_sec*(pos(lsm)-pos(lsl)) + pos(line_search_count + 1) = pos(lsl) + gold_sec*(pos(lsm) - pos(lsl)) ENDIF - IF ((pos(lsr)-pos(lsl)) .LT. 1.0E-3_dp*pos(lsr)) THEN + IF ((pos(lsr) - pos(lsl)) .LT. 1.0E-3_dp*pos(lsr)) THEN new_direction = .TRUE. ENDIF ENDIF ! lsr .eq. 0 ENDIF ! first step END SELECT ! now go to the suggested point - ds_min = pos(line_search_count+1) - ds = pos(line_search_count+1)-pos(line_search_count) + ds_min = pos(line_search_count + 1) + ds = pos(line_search_count + 1) - pos(line_search_count) CALL cp_fm_scale_and_add(1.0_dp, matrix_A, ds, matrix_G_search) ENDDO @@ -1407,30 +1407,30 @@ SUBROUTINE jacobi_rot_para(weights, zij, vectors, para_env, max_iter, eps_locali sweeps = 0 ! number of processor pairs and number of permutations - npair = (para_env%num_pe+1)/2 - nperm = para_env%num_pe-MOD(para_env%num_pe+1, 2) + npair = (para_env%num_pe + 1)/2 + nperm = para_env%num_pe - MOD(para_env%num_pe + 1, 2) ALLOCATE (list_pair(2, npair)) ! Distribution of the states (XXXXX safe against more pe than states ??? XXXXX) xstate = REAL(nstate, dp)/REAL(para_env%num_pe, dp) nblock_max = 0 - ALLOCATE (ns_bound(0:para_env%num_pe-1, 2)) + ALLOCATE (ns_bound(0:para_env%num_pe - 1, 2)) Xlow = 0.0D0 Xup = 0.0D0 DO ip = 1, para_env%num_pe - xup = xlow+xstate - ns_bound(ip-1, 1) = NINT(xlow)+1 - ns_bound(ip-1, 2) = NINT(xup) + xup = xlow + xstate + ns_bound(ip - 1, 1) = NINT(xlow) + 1 + ns_bound(ip - 1, 2) = NINT(xup) IF (NINT(xup) .GT. nstate) THEN - ns_bound(ip-1, 2) = nstate + ns_bound(ip - 1, 2) = nstate ENDIF IF (NINT(xlow) .GT. nstate) THEN - ns_bound(ip-1, 1) = nstate+1 + ns_bound(ip - 1, 1) = nstate + 1 ENDIF xlow = xup ENDDO - DO ip = 0, para_env%num_pe-1 - nblock = ns_bound(ip, 2)-ns_bound(ip, 1)+1 + DO ip = 0, para_env%num_pe - 1 + nblock = ns_bound(ip, 2) - ns_bound(ip, 1) + 1 nblock_max = MAX(nblock_max, nblock) ENDDO @@ -1439,8 +1439,8 @@ SUBROUTINE jacobi_rot_para(weights, zij, vectors, para_env, max_iter, eps_locali ALLOCATE (z_ij_loc_im(nstate, nblock_max)) ALLOCATE (cz_ij_loc(dim2)) DO idim = 1, dim2 - DO ip = 0, para_env%num_pe-1 - nblock = ns_bound(ip, 2)-ns_bound(ip, 1)+1 + DO ip = 0, para_env%num_pe - 1 + nblock = ns_bound(ip, 2) - ns_bound(ip, 1) + 1 CALL cp_fm_get_submatrix(zij(1, idim)%matrix, z_ij_loc_re, 1, ns_bound(ip, 1), nstate, nblock) CALL cp_fm_get_submatrix(zij(2, idim)%matrix, z_ij_loc_im, 1, ns_bound(ip, 1), nstate, nblock) IF (para_env%mepos == ip) THEN @@ -1461,7 +1461,7 @@ SUBROUTINE jacobi_rot_para(weights, zij, vectors, para_env, max_iter, eps_locali ALLOCATE (rotmat(nstate, 2*nblock_max)) rotmat = 0.0_dp DO i = ns_bound(para_env%mepos, 1), ns_bound(para_env%mepos, 2) - ii = i-ns_bound(para_env%mepos, 1)+1 + ii = i - ns_bound(para_env%mepos, 1) + 1 rotmat(i, ii) = 1.0_dp END DO @@ -1470,7 +1470,7 @@ SUBROUTINE jacobi_rot_para(weights, zij, vectors, para_env, max_iter, eps_locali ALLOCATE (zdiag_me(dim2)) ALLOCATE (zdiag_all(dim2)) - ns_me = ns_bound(para_env%mepos, 2)-ns_bound(para_env%mepos, 1)+1 + ns_me = ns_bound(para_env%mepos, 2) - ns_bound(para_env%mepos, 1) + 1 IF (ns_me /= 0) THEN ALLOCATE (c_array_me(nstate, ns_me, dim2)) DO idim = 1, dim2 @@ -1489,15 +1489,15 @@ SUBROUTINE jacobi_rot_para(weights, zij, vectors, para_env, max_iter, eps_locali ALLOCATE (rmat_send(nblock_max*2, nblock_max)) ! buffer for message passing - ALLOCATE (rmat_recv_all(nblock_max*2, nblock_max, 0:para_env%num_pe-1)) + ALLOCATE (rmat_recv_all(nblock_max*2, nblock_max, 0:para_env%num_pe - 1)) IF (output_unit > 0) THEN WRITE (output_unit, '(T4,A )') " Localization by iterative distributed Jacobi rotation" WRITE (output_unit, '(T20,A12,T32, A22,T60, A12,A8 )') "Iteration", "Functional", "Tolerance", " Time " END IF - DO sweeps = 1, max_iter+1 - IF (sweeps == max_iter+1) THEN + DO sweeps = 1, max_iter + 1 + IF (sweeps == max_iter + 1) THEN IF (output_unit > 0) THEN WRITE (output_unit, *) ' LOCALIZATION! loop did not converge within the maximum number of iterations.' WRITE (output_unit, *) ' Present Max. gradient = ', tolerance @@ -1522,7 +1522,7 @@ SUBROUTINE jacobi_rot_para(weights, zij, vectors, para_env, max_iter, eps_locali END IF END DO IF (ip_partner >= 0) THEN - ns_partner = ns_bound(ip_partner, 2)-ns_bound(ip_partner, 1)+1 + ns_partner = ns_bound(ip_partner, 2) - ns_bound(ip_partner, 1) + 1 ELSE ns_partner = 0 END IF @@ -1530,16 +1530,16 @@ SUBROUTINE jacobi_rot_para(weights, zij, vectors, para_env, max_iter, eps_locali ! if there is a non-zero block connecting two partners, jacobi-sweep it. IF (ns_partner*ns_me /= 0) THEN - ALLOCATE (rmat_loc(ns_me+ns_partner, ns_me+ns_partner)) + ALLOCATE (rmat_loc(ns_me + ns_partner, ns_me + ns_partner)) rmat_loc = 0.0_dp - DO i = 1, ns_me+ns_partner + DO i = 1, ns_me + ns_partner rmat_loc(i, i) = 1.0_dp END DO ALLOCATE (c_array_partner(nstate, ns_partner, dim2)) DO idim = 1, dim2 - ALLOCATE (xyz_mix(idim)%c_array(ns_me+ns_partner, ns_me+ns_partner)) + ALLOCATE (xyz_mix(idim)%c_array(ns_me + ns_partner, ns_me + ns_partner)) DO i = 1, ns_me c_array_me(1:nstate, i, idim) = cz_ij_loc(idim)%c_array(1:nstate, i) END DO @@ -1551,36 +1551,36 @@ SUBROUTINE jacobi_rot_para(weights, zij, vectors, para_env, max_iter, eps_locali n1 = ns_me n2 = ns_partner ilow1 = ns_bound(para_env%mepos, 1) - iup1 = ns_bound(para_env%mepos, 1)+n1-1 + iup1 = ns_bound(para_env%mepos, 1) + n1 - 1 ilow2 = ns_bound(ip_partner, 1) - iup2 = ns_bound(ip_partner, 1)+n2-1 + iup2 = ns_bound(ip_partner, 1) + n2 - 1 IF (ns_bound(para_env%mepos, 1) < ns_bound(ip_partner, 1)) THEN il1 = 1 iu1 = n1 iu1 = n1 - il2 = 1+n1 - iu2 = n1+n2 + il2 = 1 + n1 + iu2 = n1 + n2 ELSE - il1 = 1+n2 - iu1 = n1+n2 - iu1 = n1+n2 + il1 = 1 + n2 + iu1 = n1 + n2 + iu1 = n1 + n2 il2 = 1 iu2 = n2 END IF DO idim = 1, dim2 DO i = 1, n1 - xyz_mix(idim)%c_array(il1:iu1, il1+i-1) = c_array_me(ilow1:iup1, i, idim) - xyz_mix(idim)%c_array(il2:iu2, il1+i-1) = c_array_me(ilow2:iup2, i, idim) + xyz_mix(idim)%c_array(il1:iu1, il1 + i - 1) = c_array_me(ilow1:iup1, i, idim) + xyz_mix(idim)%c_array(il2:iu2, il1 + i - 1) = c_array_me(ilow2:iup2, i, idim) END DO DO i = 1, n2 - xyz_mix(idim)%c_array(il2:iu2, il2+i-1) = c_array_partner(ilow2:iup2, i, idim) - xyz_mix(idim)%c_array(il1:iu1, il2+i-1) = c_array_partner(ilow1:iup1, i, idim) + xyz_mix(idim)%c_array(il2:iu2, il2 + i - 1) = c_array_partner(ilow2:iup2, i, idim) + xyz_mix(idim)%c_array(il1:iu1, il2 + i - 1) = c_array_partner(ilow1:iup1, i, idim) END DO END DO - DO istate = 1, n1+n2 - DO jstate = istate+1, n1+n2 + DO istate = 1, n1 + n2 + DO jstate = istate + 1, n1 + n2 DO idim = 1, dim2 mii(idim) = xyz_mix(idim)%c_array(istate, istate) mij(idim) = xyz_mix(idim)%c_array(istate, jstate) @@ -1590,40 +1590,40 @@ SUBROUTINE jacobi_rot_para(weights, zij, vectors, para_env, max_iter, eps_locali st = SIN(theta) ct = COS(theta) DO idim = 1, dim2 - DO i = 1, n1+n2 - zi = ct*xyz_mix(idim)%c_array(i, istate)+st*xyz_mix(idim)%c_array(i, jstate) - zj = -st*xyz_mix(idim)%c_array(i, istate)+ct*xyz_mix(idim)%c_array(i, jstate) + DO i = 1, n1 + n2 + zi = ct*xyz_mix(idim)%c_array(i, istate) + st*xyz_mix(idim)%c_array(i, jstate) + zj = -st*xyz_mix(idim)%c_array(i, istate) + ct*xyz_mix(idim)%c_array(i, jstate) xyz_mix(idim)%c_array(i, istate) = zi xyz_mix(idim)%c_array(i, jstate) = zj END DO - DO i = 1, n1+n2 - zi = ct*xyz_mix(idim)%c_array(istate, i)+st*xyz_mix(idim)%c_array(jstate, i) - zj = -st*xyz_mix(idim)%c_array(istate, i)+ct*xyz_mix(idim)%c_array(jstate, i) + DO i = 1, n1 + n2 + zi = ct*xyz_mix(idim)%c_array(istate, i) + st*xyz_mix(idim)%c_array(jstate, i) + zj = -st*xyz_mix(idim)%c_array(istate, i) + ct*xyz_mix(idim)%c_array(jstate, i) xyz_mix(idim)%c_array(istate, i) = zi xyz_mix(idim)%c_array(jstate, i) = zj END DO END DO - DO i = 1, n1+n2 - ri = ct*rmat_loc(i, istate)+st*rmat_loc(i, jstate) - rj = ct*rmat_loc(i, jstate)-st*rmat_loc(i, istate) + DO i = 1, n1 + n2 + ri = ct*rmat_loc(i, istate) + st*rmat_loc(i, jstate) + rj = ct*rmat_loc(i, jstate) - st*rmat_loc(i, istate) rmat_loc(i, istate) = ri rmat_loc(i, jstate) = rj END DO END DO END DO - k = nblock_max+1 + k = nblock_max + 1 CALL mp_sendrecv(rotmat(1:nstate, 1:ns_me), ip_partner, & - rotmat(1:nstate, k:k+n2-1), ip_partner, para_env%group) + rotmat(1:nstate, k:k + n2 - 1), ip_partner, para_env%group) IF (ilow1 < ilow2) THEN - CALL dgemm("N", "N", nstate, n1, n2, 1.0_dp, rotmat(1, k), nstate, rmat_loc(1+n1, 1), n1+n2, 0.0_dp, gmat, nstate) - CALL dgemm("N", "N", nstate, n1, n1, 1.0_dp, rotmat(1, 1), nstate, rmat_loc(1, 1), n1+n2, 1.0_dp, gmat, nstate) + CALL dgemm("N", "N", nstate, n1, n2, 1.0_dp, rotmat(1, k), nstate, rmat_loc(1 + n1, 1), n1 + n2, 0.0_dp, gmat, nstate) + CALL dgemm("N", "N", nstate, n1, n1, 1.0_dp, rotmat(1, 1), nstate, rmat_loc(1, 1), n1 + n2, 1.0_dp, gmat, nstate) ELSE - CALL dgemm("N", "N", nstate, n1, n2, 1.0_dp, rotmat(1, k), nstate, rmat_loc(1, n2+1), n1+n2, 0.0_dp, gmat, nstate) + CALL dgemm("N", "N", nstate, n1, n2, 1.0_dp, rotmat(1, k), nstate, rmat_loc(1, n2 + 1), n1 + n2, 0.0_dp, gmat, nstate) CALL dgemm("N", "N", nstate, n1, n1, 1.0_dp, rotmat(1, 1), nstate, & - rmat_loc(n2+1, n2+1), n1+n2, 1.0_dp, gmat, nstate) + rmat_loc(n2 + 1, n2 + 1), n1 + n2, 1.0_dp, gmat, nstate) END IF CALL dcopy(nstate*n1, gmat(1, 1), 1, rotmat(1, 1), 1) @@ -1637,16 +1637,16 @@ SUBROUTINE jacobi_rot_para(weights, zij, vectors, para_env, max_iter, eps_locali DO jstate = 1, nstate DO i = 1, n2 xyz_mix_ns(idim)%c_array(jstate, istate) = & - xyz_mix_ns(idim)%c_array(jstate, istate)+ & - c_array_partner(jstate, i, idim)*rmat_loc(il2+i-1, il1+istate-1) + xyz_mix_ns(idim)%c_array(jstate, istate) + & + c_array_partner(jstate, i, idim)*rmat_loc(il2 + i - 1, il1 + istate - 1) END DO END DO END DO DO istate = 1, n1 DO jstate = 1, nstate DO i = 1, n1 - xyz_mix_ns(idim)%c_array(jstate, istate) = xyz_mix_ns(idim)%c_array(jstate, istate)+ & - c_array_me(jstate, i, idim)*rmat_loc(il1+i-1, il1+istate-1) + xyz_mix_ns(idim)%c_array(jstate, istate) = xyz_mix_ns(idim)%c_array(jstate, istate) + & + c_array_me(jstate, i, idim)*rmat_loc(il1 + i - 1, il1 + istate - 1) END DO END DO END DO @@ -1670,8 +1670,8 @@ SUBROUTINE jacobi_rot_para(weights, zij, vectors, para_env, max_iter, eps_locali IF (ns_partner*ns_me /= 0) THEN ! transpose rotation matrix rmat_loc - DO i = 1, ns_me+ns_partner - DO j = i+1, ns_me+ns_partner + DO i = 1, ns_me + ns_partner + DO j = i + 1, ns_me + ns_partner ri = rmat_loc(i, j) rmat_loc(i, j) = rmat_loc(j, i) rmat_loc(j, i) = ri @@ -1680,11 +1680,11 @@ SUBROUTINE jacobi_rot_para(weights, zij, vectors, para_env, max_iter, eps_locali ! prepare for distribution DO i = 1, n1 - rmat_send(1:n1, i) = rmat_loc(il1:iu1, il1+i-1) + rmat_send(1:n1, i) = rmat_loc(il1:iu1, il1 + i - 1) END DO ik = nblock_max DO i = 1, n2 - rmat_send(ik+1:ik+n1, i) = rmat_loc(il1:iu1, il2+i-1) + rmat_send(ik + 1:ik + n1, i) = rmat_loc(il1:iu1, il2 + i - 1) END DO ELSE rmat_send = 0.0_dp @@ -1694,12 +1694,12 @@ SUBROUTINE jacobi_rot_para(weights, zij, vectors, para_env, max_iter, eps_locali CALL mp_allgather(rmat_send, rmat_recv_all, para_env%group) ! update blocks everywhere - DO ip = 0, para_env%num_pe-1 + DO ip = 0, para_env%num_pe - 1 - ip_recv_from = MOD(para_env%mepos-IP+para_env%num_pe, para_env%num_pe) + ip_recv_from = MOD(para_env%mepos - IP + para_env%num_pe, para_env%num_pe) rmat_recv(:, :) = rmat_recv_all(:, :, ip_recv_from) - ns_recv_from = ns_bound(ip_recv_from, 2)-ns_bound(ip_recv_from, 1)+1 + ns_recv_from = ns_bound(ip_recv_from, 2) - ns_bound(ip_recv_from, 1) + 1 IF (ns_me /= 0) THEN IF (ns_recv_from /= 0) THEN @@ -1717,7 +1717,7 @@ SUBROUTINE jacobi_rot_para(weights, zij, vectors, para_env, max_iter, eps_locali END DO IF (ip_recv_partner >= 0) THEN - ns_recv_partner = ns_bound(ip_recv_partner, 2)-ns_bound(ip_recv_partner, 1)+1 + ns_recv_partner = ns_bound(ip_recv_partner, 2) - ns_bound(ip_recv_partner, 1) + 1 END IF IF (ns_recv_partner > 0) THEN il1 = ns_bound(para_env%mepos, 1) @@ -1727,24 +1727,24 @@ SUBROUTINE jacobi_rot_para(weights, zij, vectors, para_env, max_iter, eps_locali DO idim = 1, dim2 DO i = 1, ns_recv_from - ii = il_recv+i-1 + ii = il_recv + i - 1 DO j = 1, ns_me jj = j DO k = 1, ns_recv_from - kk = il_recv+k-1 - cz_ij_loc(idim)%c_array(ii, jj) = cz_ij_loc(idim)%c_array(ii, jj)+ & + kk = il_recv + k - 1 + cz_ij_loc(idim)%c_array(ii, jj) = cz_ij_loc(idim)%c_array(ii, jj) + & rmat_recv(i, k)*xyz_mix_ns(idim)%c_array(kk, j) END DO END DO END DO DO i = 1, ns_recv_from - ii = il_recv+i-1 + ii = il_recv + i - 1 DO j = 1, ns_me jj = j DO k = 1, ns_recv_partner - kk = il_recv_partner+k-1 - cz_ij_loc(idim)%c_array(ii, jj) = cz_ij_loc(idim)%c_array(ii, jj)+ & - rmat_recv(ik+i, k)*xyz_mix_ns(idim)%c_array(kk, j) + kk = il_recv_partner + k - 1 + cz_ij_loc(idim)%c_array(ii, jj) = cz_ij_loc(idim)%c_array(ii, jj) + & + rmat_recv(ik + i, k)*xyz_mix_ns(idim)%c_array(kk, j) END DO END DO END DO @@ -1756,7 +1756,7 @@ SUBROUTINE jacobi_rot_para(weights, zij, vectors, para_env, max_iter, eps_locali DO j = 1, ns_me jj = j DO i = 1, ns_recv_from - ii = il_recv+i-1 + ii = il_recv + i - 1 cz_ij_loc(idim)%c_array(ii, jj) = xyz_mix_ns(idim)%c_array(ii, j) END DO END DO @@ -1778,14 +1778,14 @@ SUBROUTINE jacobi_rot_para(weights, zij, vectors, para_env, max_iter, eps_locali ! calculate the max gradient DO idim = 1, dim2 DO i = ns_bound(para_env%mepos, 1), ns_bound(para_env%mepos, 2) - ii = i-ns_bound(para_env%mepos, 1)+1 + ii = i - ns_bound(para_env%mepos, 1) + 1 zdiag_me(idim)%c_array(ii) = cz_ij_loc(idim)%c_array(i, ii) zdiag_me(idim)%c_array(ii) = cz_ij_loc(idim)%c_array(i, ii) END DO rcount(:) = SIZE(zdiag_me(idim)%c_array) rdispl(1) = 0 DO ip = 2, para_env%num_pe - rdispl(ip) = rdispl(ip-1)+rcount(ip-1) + rdispl(ip) = rdispl(ip - 1) + rcount(ip - 1) ENDDO ! collect all the diagonal elements in a replicated 1d array CALL mp_allgather(zdiag_me(idim)%c_array, zdiag_all(idim)%c_array, rcount, rdispl, para_env%group) @@ -1793,23 +1793,23 @@ SUBROUTINE jacobi_rot_para(weights, zij, vectors, para_env, max_iter, eps_locali gmax = 0.0_dp DO j = ns_bound(para_env%mepos, 1), ns_bound(para_env%mepos, 2) - k = j-ns_bound(para_env%mepos, 1)+1 - DO i = 1, j-1 + k = j - ns_bound(para_env%mepos, 1) + 1 + DO i = 1, j - 1 ! find the location of the diagonal element (i,i) - DO ip = 0, para_env%num_pe-1 + DO ip = 0, para_env%num_pe - 1 IF (i >= ns_bound(ip, 1) .AND. i <= ns_bound(ip, 2)) THEN ip_has_i = ip EXIT END IF END DO - ii = nblock_max*ip_has_i+i-ns_bound(ip_has_i, 1)+1 + ii = nblock_max*ip_has_i + i - ns_bound(ip_has_i, 1) + 1 ! mepos has the diagonal element (j,j), as well as the off diagonal (i,j) - jj = nblock_max*para_env%mepos+j-ns_bound(para_env%mepos, 1)+1 + jj = nblock_max*para_env%mepos + j - ns_bound(para_env%mepos, 1) + 1 grad = 0.0_dp DO idim = 1, dim2 zi = zdiag_all(idim)%c_array(ii) zj = zdiag_all(idim)%c_array(jj) - grad = grad+weights(idim)*REAL(4.0_dp*CONJG(cz_ij_loc(idim)%c_array(i, k))*(zj-zi), dp) + grad = grad + weights(idim)*REAL(4.0_dp*CONJG(cz_ij_loc(idim)%c_array(i, k))*(zj - zi), dp) END DO gmax = MAX(gmax, ABS(grad)) END DO @@ -1820,18 +1820,18 @@ SUBROUTINE jacobi_rot_para(weights, zij, vectors, para_env, max_iter, eps_locali func = 0.0_dp DO i = ns_bound(para_env%mepos, 1), ns_bound(para_env%mepos, 2) - k = i-ns_bound(para_env%mepos, 1)+1 + k = i - ns_bound(para_env%mepos, 1) + 1 DO idim = 1, dim2 zr = REAL(cz_ij_loc(idim)%c_array(i, k), dp) zc = AIMAG(cz_ij_loc(idim)%c_array(i, k)) - func = func+weights(idim)*(1.0_dp-(zr*zr+zc*zc))/twopi/twopi + func = func + weights(idim)*(1.0_dp - (zr*zr + zc*zc))/twopi/twopi END DO END DO CALL mp_sum(func, para_env%group) t2 = m_walltime() IF (output_unit > 0 .AND. MODULO(sweeps, out_each) == 0) THEN - WRITE (output_unit, '(T20,I12,T35,F20.10,T60,E12.4,F8.3)') sweeps, func, tolerance, t2-t1 + WRITE (output_unit, '(T20,I12,T35,F20.10,T60,E12.4,F8.3)') sweeps, func, tolerance, t2 - t1 CALL m_flush(output_unit) END IF IF (tolerance < eps_localization) EXIT @@ -1869,18 +1869,18 @@ SUBROUTINE jacobi_rot_para(weights, zij, vectors, para_env, max_iter, eps_locali DEALLOCATE (mjj) ilow1 = ns_bound(para_env%mepos, 1) - ns_me = ns_bound(para_env%mepos, 2)-ns_bound(para_env%mepos, 1)+1 + ns_me = ns_bound(para_env%mepos, 2) - ns_bound(para_env%mepos, 1) + 1 ALLOCATE (z_ij_loc_re(nstate, nblock_max)) ALLOCATE (z_ij_loc_im(nstate, nblock_max)) DO idim = 1, dim2 - DO ip = 0, para_env%num_pe-1 + DO ip = 0, para_env%num_pe - 1 z_ij_loc_re = 0.0_dp z_ij_loc_im = 0.0_dp - nblock = ns_bound(ip, 2)-ns_bound(ip, 1)+1 + nblock = ns_bound(ip, 2) - ns_bound(ip, 1) + 1 IF (ip == para_env%mepos) THEN ns_me = nblock DO i = 1, ns_me - ii = ilow1+i-1 + ii = ilow1 + i - 1 DO j = 1, nstate z_ij_loc_re(j, i) = REAL(cz_ij_loc(idim)%c_array(j, i), dp) z_ij_loc_im(j, i) = AIMAG(cz_ij_loc(idim)%c_array(j, i)) @@ -1894,13 +1894,13 @@ SUBROUTINE jacobi_rot_para(weights, zij, vectors, para_env, max_iter, eps_locali END DO ! ip END DO - DO ip = 0, para_env%num_pe-1 + DO ip = 0, para_env%num_pe - 1 z_ij_loc_re = 0.0_dp - nblock = ns_bound(ip, 2)-ns_bound(ip, 1)+1 + nblock = ns_bound(ip, 2) - ns_bound(ip, 1) + 1 IF (ip == para_env%mepos) THEN ns_me = nblock DO i = 1, ns_me - ii = ilow1+i-1 + ii = ilow1 + i - 1 DO j = 1, nstate z_ij_loc_re(j, i) = rotmat(j, i) END DO @@ -1943,12 +1943,12 @@ SUBROUTINE eberlein(iperm, para_env, list_pair) INTEGER :: i, ii, jj, npair - npair = (para_env%num_pe+1)/2 + npair = (para_env%num_pe + 1)/2 IF (iperm == 1) THEN !..set up initial ordering - DO I = 0, para_env%num_pe-1 - II = ((i+1)+1)/2 - JJ = MOD((i+1)+1, 2)+1 + DO I = 0, para_env%num_pe - 1 + II = ((i + 1) + 1)/2 + JJ = MOD((i + 1) + 1, 2) + 1 list_pair(JJ, II) = i ENDDO IF (MOD(para_env%num_pe, 2) == 1) list_pair(2, npair) = -1 @@ -1956,15 +1956,15 @@ SUBROUTINE eberlein(iperm, para_env, list_pair) !..a type shift jj = list_pair(1, npair) DO I = npair, 3, -1 - list_pair(1, I) = list_pair(1, I-1) + list_pair(1, I) = list_pair(1, I - 1) ENDDO list_pair(1, 2) = list_pair(2, 1) list_pair(2, 1) = jj ELSE !..b type shift jj = list_pair(2, 1) - DO I = 1, npair-1 - list_pair(2, I) = list_pair(2, I+1) + DO I = 1, npair - 1 + list_pair(2, I) = list_pair(2, I + 1) ENDDO list_pair(2, npair) = jj ENDIF diff --git a/src/qs_matrix_pools.F b/src/qs_matrix_pools.F index 644a81891b..8d27f138a6 100644 --- a/src/qs_matrix_pools.F +++ b/src/qs_matrix_pools.F @@ -89,7 +89,7 @@ SUBROUTINE mpools_retain(mpools) CPASSERT(ASSOCIATED(mpools)) CPASSERT(mpools%ref_count > 0) - mpools%ref_count = mpools%ref_count+1 + mpools%ref_count = mpools%ref_count + 1 END SUBROUTINE mpools_retain ! ************************************************************************************************** @@ -106,7 +106,7 @@ SUBROUTINE mpools_release(mpools) IF (ASSOCIATED(mpools)) THEN CPASSERT(mpools%ref_count > 0) - mpools%ref_count = mpools%ref_count-1 + mpools%ref_count = mpools%ref_count - 1 IF (mpools%ref_count == 0) THEN CALL fm_pools_dealloc(mpools%ao_mo_fm_pools) CALL fm_pools_dealloc(mpools%ao_ao_fm_pools) @@ -198,7 +198,7 @@ SUBROUTINE mpools_create(mpools) mpools%mo_mo_fm_pools, mpools%ao_mosub_fm_pools, & mpools%mosub_mosub_fm_pools) mpools%ref_count = 1 - last_mpools_id = last_mpools_id+1 + last_mpools_id = last_mpools_id + 1 mpools%id_nr = last_mpools_id END SUBROUTINE mpools_create diff --git a/src/qs_mixing_utils.F b/src/qs_mixing_utils.F index e1651779f8..a9473a2256 100644 --- a/src/qs_mixing_utils.F +++ b/src/qs_mixing_utils.F @@ -205,7 +205,7 @@ SUBROUTINE mixing_allocate(qs_env, mixing_method, p_mix_new, p_delta, nspins, mi DO ikind = 1, nkind nel = distribution_1d%n_el(ikind) DO iat = 1, nel - ia = ia+1 + ia = ia + 1 mixing_store%atlist(ia) = distribution_1d%list(ikind)%array(iat) END DO END DO @@ -456,13 +456,13 @@ SUBROUTINE mixing_allocate(qs_env, mixing_method, p_mix_new, p_delta, nspins, mi IF (mixing_method == broyden_mixing_new_nr) THEN IF (.NOT. ASSOCIATED(mixing_store%u_vec)) THEN ALLOCATE (mixing_store%last_res(nspins)) - ALLOCATE (mixing_store%delta_res(nbuffer-1, nspins)) - ALLOCATE (mixing_store%u_vec(nbuffer-1, nspins)) - ALLOCATE (mixing_store%z_vec(nbuffer-1, nspins)) + ALLOCATE (mixing_store%delta_res(nbuffer - 1, nspins)) + ALLOCATE (mixing_store%u_vec(nbuffer - 1, nspins)) + ALLOCATE (mixing_store%z_vec(nbuffer - 1, nspins)) ALLOCATE (mixing_store%weight(nbuffer, nspins)) - ALLOCATE (mixing_store%fmat(nbuffer-1, nbuffer-1, nspins)) + ALLOCATE (mixing_store%fmat(nbuffer - 1, nbuffer - 1, nspins)) DO ispin = 1, nspins - DO i = 1, nbuffer-1 + DO i = 1, nbuffer - 1 NULLIFY (mixing_store%delta_res(i, ispin)%cc) NULLIFY (mixing_store%u_vec(i, ispin)%cc) NULLIFY (mixing_store%z_vec(i, ispin)%cc) @@ -560,13 +560,13 @@ SUBROUTINE mixing_init(mixing_method, rho, mixing_store, para_env, rho_atom) ig1 = 1 IF (rho_g(1)%pw%pw_grid%have_g0) ig1 = 2 DO ig = ig1, mixing_store%ig_max - mixing_store%kerker_factor(ig) = MAX(g2(ig)/(g2(ig)+beta*beta), kmin) + mixing_store%kerker_factor(ig) = MAX(g2(ig)/(g2(ig) + beta*beta), kmin) mixing_store%special_metric(ig) = & - 1.0_dp+50.0_dp/8.0_dp*( & - 1.0_dp+COS(g_vec(1, ig))+COS(g_vec(2, ig))+COS(g_vec(3, ig))+ & - COS(g_vec(1, ig))*COS(g_vec(2, ig))+ & - COS(g_vec(2, ig))*COS(g_vec(3, ig))+ & - COS(g_vec(1, ig))*COS(g_vec(3, ig))+ & + 1.0_dp + 50.0_dp/8.0_dp*( & + 1.0_dp + COS(g_vec(1, ig)) + COS(g_vec(2, ig)) + COS(g_vec(3, ig)) + & + COS(g_vec(1, ig))*COS(g_vec(2, ig)) + & + COS(g_vec(2, ig))*COS(g_vec(3, ig)) + & + COS(g_vec(1, ig))*COS(g_vec(3, ig)) + & COS(g_vec(1, ig))*COS(g_vec(2, ig))*COS(g_vec(3, ig))) END DO @@ -596,11 +596,11 @@ SUBROUTINE mixing_init(mixing_method, rho, mixing_store, para_env, rho_atom) END DO IF (nspin == 2) THEN - mixing_store%rhoin(1)%cc = rho_g(1)%pw%cc+rho_g(2)%pw%cc - mixing_store%rhoin(2)%cc = rho_g(1)%pw%cc-rho_g(2)%pw%cc + mixing_store%rhoin(1)%cc = rho_g(1)%pw%cc + rho_g(2)%pw%cc + mixing_store%rhoin(2)%cc = rho_g(1)%pw%cc - rho_g(2)%pw%cc IF (ASSOCIATED(mixing_store%rhoin_buffer)) THEN - mixing_store%rhoin_buffer(1, 1)%cc = rho_g(1)%pw%cc+rho_g(2)%pw%cc - mixing_store%rhoin_buffer(1, 2)%cc = rho_g(1)%pw%cc-rho_g(2)%pw%cc + mixing_store%rhoin_buffer(1, 1)%cc = rho_g(1)%pw%cc + rho_g(2)%pw%cc + mixing_store%rhoin_buffer(1, 2)%cc = rho_g(1)%pw%cc - rho_g(2)%pw%cc END IF END IF @@ -726,9 +726,9 @@ SUBROUTINE mixing_init(mixing_method, rho, mixing_store, para_env, rho_atom) ! fdamp/g2 varies between (bconst-1) and 0 ! i.e. p_metric varies between bconst and 1 ! fdamp = (bconst-1.0_dp)*g2min - fdamp = (bconst-1.0_dp)*g2min*g2max/(g2max-g2min*bconst) + fdamp = (bconst - 1.0_dp)*g2min*g2max/(g2max - g2min*bconst) DO ig = 1, ng - mixing_store%p_metric(ig) = (g2(ig)+fdamp)/MAX(g2(ig), 1.E-10_dp) + mixing_store%p_metric(ig) = (g2(ig) + fdamp)/MAX(g2(ig), 1.E-10_dp) END DO IF (rho_g(1)%pw%pw_grid%have_g0) mixing_store%p_metric(1) = bconst END IF @@ -736,7 +736,7 @@ SUBROUTINE mixing_init(mixing_method, rho, mixing_store, para_env, rho_atom) ELSEIF (mixing_method == broyden_mixing_new_nr) THEN DO ispin = 1, nspin IF (.NOT. ASSOCIATED(mixing_store%u_vec(1, ispin)%cc)) THEN - DO ib = 1, nbuffer-1 + DO ib = 1, nbuffer - 1 ALLOCATE (mixing_store%delta_res(ib, ispin)%cc(ng)) ALLOCATE (mixing_store%u_vec(ib, ispin)%cc(ng)) ALLOCATE (mixing_store%z_vec(ib, ispin)%cc(ng)) @@ -752,9 +752,9 @@ SUBROUTINE mixing_init(mixing_method, rho, mixing_store, para_env, rho_atom) IF (g2(ig) > 1.E-10_dp) g2min = MIN(g2min, g2(ig)) END DO CALL mp_min(g2min, para_env%group) - fdamp = (bconst-1.0_dp)*g2min + fdamp = (bconst - 1.0_dp)*g2min DO ig = 1, ng - mixing_store%p_metric(ig) = (g2(ig)+fdamp)/MAX(g2(ig), 1.E-10_dp) + mixing_store%p_metric(ig) = (g2(ig) + fdamp)/MAX(g2(ig), 1.E-10_dp) END DO IF (rho_g(1)%pw%pw_grid%have_g0) mixing_store%p_metric(1) = bconst END IF @@ -764,10 +764,10 @@ SUBROUTINE mixing_init(mixing_method, rho, mixing_store, para_env, rho_atom) END IF mixing_store%ig_global_index = 0 ig_count = 0 - DO iproc = 0, para_env%num_pe-1 + DO iproc = 0, para_env%num_pe - 1 IF (para_env%mepos == iproc) THEN DO ig = 1, ng - ig_count = ig_count+1 + ig_count = ig_count + 1 mixing_store%ig_global_index(ig) = ig_count END DO END IF diff --git a/src/qs_mo_io.F b/src/qs_mo_io.F index ddf984fde7..41bde1ccbe 100644 --- a/src/qs_mo_io.F +++ b/src/qs_mo_io.F @@ -338,7 +338,7 @@ SUBROUTINE write_mo_set_low(mo_array, qs_kind_set, particle_set, ires, rt_mos) ELSEIF (ASSOCIATED(dftb_parameter)) THEN CALL get_dftb_atom_param(dftb_parameter, lmax=lmax) nset_max = MAX(nset_max, 1) - nshell_max = MAX(nshell_max, lmax+1) + nshell_max = MAX(nshell_max, lmax + 1) ELSE CPABORT("Unknown basis type. ") END IF @@ -374,9 +374,9 @@ SUBROUTINE write_mo_set_low(mo_array, qs_kind_set, particle_set, ires, rt_mos) ELSEIF (ASSOCIATED(dftb_parameter)) THEN CALL get_dftb_atom_param(dftb_parameter, lmax=lmax) nset_info(iatom) = 1 - nshell_info(1, iatom) = lmax+1 - DO ishell = 1, lmax+1 - lshell = ishell-1 + nshell_info(1, iatom) = lmax + 1 + DO ishell = 1, lmax + 1 + lshell = ishell - 1 nso_info(ishell, 1, iatom) = nso(lshell) END DO ELSE @@ -410,7 +410,7 @@ SUBROUTINE write_mo_set_low(mo_array, qs_kind_set, particle_set, ires, rt_mos) mo_array(ispin)%mo_set%occupation_numbers(1:nmo) END IF IF (PRESENT(rt_mos)) THEN - DO imat = 2*ispin-1, 2*ispin + DO imat = 2*ispin - 1, 2*ispin CALL cp_fm_write_unformatted(rt_mos(imat)%matrix, ires) END DO ELSE @@ -747,7 +747,7 @@ SUBROUTINE read_mos_restart_low(mos, para_env, qs_kind_set, particle_set, natom, DO iset = 1, nset_info(iatom) DO ishell = 1, nshell_info(iset, iatom) offset_info(ishell, iset, iatom) = i - i = i+nso_info(ishell, iset, iatom) + i = i + nso_info(ishell, iset, iatom) END DO END DO END DO @@ -827,7 +827,7 @@ SUBROUTINE read_mos_restart_low(mos, para_env, qs_kind_set, particle_set, natom, CALL mp_bcast(mos(ispin)%mo_set%eigenvalues, source, group) CALL mp_bcast(mos(ispin)%mo_set%occupation_numbers, source, group) IF (PRESENT(rt_mos)) THEN - DO imat = 2*ispin-1, 2*ispin + DO imat = 2*ispin - 1, 2*ispin DO i = 1, nmo IF (para_env%ionode) THEN READ (rst_unit) vecbuffer @@ -870,13 +870,13 @@ SUBROUTINE read_mos_restart_low(mos, para_env, qs_kind_set, particle_set, natom, DO iset = 1, nset ishell_read = 1 IF (minbas) THEN - nnshell = lmax+1 + nnshell = lmax + 1 ELSE nnshell = nshell(iset) END IF DO ishell = 1, nnshell IF (minbas) THEN - lshell = ishell-1 + lshell = ishell - 1 ELSE lshell = l(ishell, iset) END IF @@ -884,10 +884,10 @@ SUBROUTINE read_mos_restart_low(mos, para_env, qs_kind_set, particle_set, natom, IF (use_this) THEN ! avoids out of bound access of the lower line if false IF (nso(lshell) == nso_info(ishell_read, iset_read, iatom)) THEN offset_read = offset_info(ishell_read, iset_read, iatom) - ishell_read = ishell_read+1 + ishell_read = ishell_read + 1 IF (ishell_read > nshell_info(iset, iatom)) THEN ishell_read = 1 - iset_read = iset_read+1 + iset_read = iset_read + 1 END IF ELSE use_this = .FALSE. @@ -895,15 +895,15 @@ SUBROUTINE read_mos_restart_low(mos, para_env, qs_kind_set, particle_set, natom, END IF DO iso = 1, nso(lshell) IF (use_this) THEN - IF (offset_read-1+iso .LT. 1 .OR. offset_read-1+iso .GT. nao_read) THEN + IF (offset_read - 1 + iso .LT. 1 .OR. offset_read - 1 + iso .GT. nao_read) THEN vecbuffer(1, irow) = 0.0_dp ELSE - vecbuffer(1, irow) = vecbuffer_read(1, offset_read-1+iso) + vecbuffer(1, irow) = vecbuffer_read(1, offset_read - 1 + iso) END IF ELSE vecbuffer(1, irow) = 0.0_dp END IF - irow = irow+1 + irow = irow + 1 END DO use_this = .TRUE. END DO @@ -925,7 +925,7 @@ SUBROUTINE read_mos_restart_low(mos, para_env, qs_kind_set, particle_set, natom, IF (para_env%ionode) THEN !ignore nmo = 0 IF (nmo > 0) THEN - DO i = nmo+1, nmo_read + DO i = nmo + 1, nmo_read READ (rst_unit) vecbuffer_read END DO END IF @@ -934,20 +934,20 @@ SUBROUTINE read_mos_restart_low(mos, para_env, qs_kind_set, particle_set, natom, IF (.NOT. PRESENT(rt_mos)) THEN IF (ispin == 1 .AND. nspin_read < nspin) THEN - mos(ispin+1)%mo_set%homo = mos(ispin)%mo_set%homo - mos(ispin+1)%mo_set%lfomo = mos(ispin)%mo_set%lfomo + mos(ispin + 1)%mo_set%homo = mos(ispin)%mo_set%homo + mos(ispin + 1)%mo_set%lfomo = mos(ispin)%mo_set%lfomo nelectron = mos(ispin)%mo_set%nelectron IF (my_mult .NE. 1) THEN CALL cp_abort(__LOCATION__, & "Restarting an LSD calculation from an LDA wfn only works for multiplicity=1 (singlets).") END IF - IF (mos(ispin+1)%mo_set%nelectron < 0) THEN + IF (mos(ispin + 1)%mo_set%nelectron < 0) THEN CPABORT("LSD: too few electrons for this multiplisity. ") END IF - mos(ispin+1)%mo_set%eigenvalues = mos(ispin)%mo_set%eigenvalues + mos(ispin + 1)%mo_set%eigenvalues = mos(ispin)%mo_set%eigenvalues mos(ispin)%mo_set%occupation_numbers = mos(ispin)%mo_set%occupation_numbers/2.0_dp - mos(ispin+1)%mo_set%occupation_numbers = mos(ispin)%mo_set%occupation_numbers - CALL cp_fm_to_fm(mos(ispin)%mo_set%mo_coeff, mos(ispin+1)%mo_set%mo_coeff) + mos(ispin + 1)%mo_set%occupation_numbers = mos(ispin)%mo_set%occupation_numbers + CALL cp_fm_to_fm(mos(ispin)%mo_set%mo_coeff, mos(ispin + 1)%mo_set%mo_coeff) EXIT END IF END IF @@ -1051,7 +1051,7 @@ SUBROUTINE write_mo_set_to_output_unit(mo_set, atomic_kind_set, qs_kind_set, par my_last = .FALSE. END IF - scf_step = logger%iter_info%iteration(logger%iter_info%n_rlevel)-1 + scf_step = logger%iter_info%iteration(logger%iter_info%n_rlevel) - 1 IF (p_evec) THEN CALL cp_fm_get_info(mo_set%mo_coeff, & @@ -1079,22 +1079,22 @@ SUBROUTINE write_mo_set_to_output_unit(mo_set, atomic_kind_set, qs_kind_set, par fmtstr2 = "(T2,21X, (1X,F . ))" fmtstr3 = "(T2,I5,1X,I5,1X,A,1X,A6, (1X,F . ))" - width = before+after+3 + width = before + after + 3 ncol = INT(56/width) - right = MAX((after-2), 1) - left = width-right-5 + right = MAX((after - 2), 1) + left = width - right - 5 WRITE (UNIT=fmtstr1(11:12), FMT="(I2)") ncol WRITE (UNIT=fmtstr1(14:15), FMT="(I2)") left WRITE (UNIT=fmtstr1(21:22), FMT="(I2)") right WRITE (UNIT=fmtstr2(9:10), FMT="(I2)") ncol - WRITE (UNIT=fmtstr2(16:17), FMT="(I2)") width-1 + WRITE (UNIT=fmtstr2(16:17), FMT="(I2)") width - 1 WRITE (UNIT=fmtstr2(19:20), FMT="(I2)") after WRITE (UNIT=fmtstr3(25:26), FMT="(I2)") ncol - WRITE (UNIT=fmtstr3(32:33), FMT="(I2)") width-1 + WRITE (UNIT=fmtstr3(32:33), FMT="(I2)") width - 1 WRITE (UNIT=fmtstr3(35:36), FMT="(I2)") after IF (p_evec) THEN @@ -1136,20 +1136,20 @@ SUBROUTINE write_mo_set_to_output_unit(mo_set, atomic_kind_set, qs_kind_set, par orbtramat(lshell)%s2c, nso(lshell), & smatrix(isgf, 1), nsgf, 0.0_dp, & cmatrix(icgf, 1), ncgf) - icgf = icgf+nco(lshell) - isgf = isgf+nso(lshell) + icgf = icgf + nco(lshell) + isgf = isgf + nso(lshell) END DO END DO ELSE IF (ASSOCIATED(dftb_parameter)) THEN CALL get_dftb_atom_param(dftb_parameter, lmax=lmax) - DO ishell = 1, lmax+1 - lshell = ishell-1 + DO ishell = 1, lmax + 1 + lshell = ishell - 1 CALL dgemm("T", "N", nco(lshell), nsgf, nso(lshell), 1.0_dp, & orbtramat(lshell)%s2c, nso(lshell), & smatrix(isgf, 1), nsgf, 0.0_dp, & cmatrix(icgf, 1), ncgf) - icgf = icgf+nco(lshell) - isgf = isgf+nso(lshell) + icgf = icgf + nco(lshell) + isgf = isgf + nso(lshell) END DO ELSE CPABORT("Unknown basis set type. ") @@ -1212,7 +1212,7 @@ SUBROUTINE write_mo_set_to_output_unit(mo_set, atomic_kind_set, qs_kind_set, par DO icol = first_mo, last_mo, ncol from = icol - to = MIN((from+ncol-1), last_mo) + to = MIN((from + ncol - 1), last_mo) WRITE (UNIT=iw, FMT=fmtstr1) (jcol, jcol=from, to) WRITE (UNIT=iw, FMT=fmtstr2) (mo_set%eigenvalues(jcol), jcol=from, to) @@ -1251,24 +1251,24 @@ SUBROUTINE write_mo_set_to_output_unit(mo_set, atomic_kind_set, qs_kind_set, par WRITE (UNIT=iw, FMT=fmtstr3) & irow, iatom, ADJUSTR(element_symbol), bcgf_symbol(icgf), & (cmatrix(irow, jcol), jcol=from, to) - icgf = icgf+1 - irow = irow+1 + icgf = icgf + 1 + irow = irow + 1 END DO END DO END DO ELSE IF (ASSOCIATED(dftb_parameter)) THEN CALL get_dftb_atom_param(dftb_parameter, lmax=lmax) icgf = 1 - DO ishell = 1, lmax+1 - lshell = ishell-1 + DO ishell = 1, lmax + 1 + lshell = ishell - 1 DO ico = 1, nco(lshell) symbol = cgf_symbol(1, indco(1:3, icgf)) symbol(1:2) = " " WRITE (UNIT=iw, FMT=fmtstr3) & irow, iatom, ADJUSTR(element_symbol), symbol, & (cmatrix(irow, jcol), jcol=from, to) - icgf = icgf+1 - irow = irow+1 + icgf = icgf + 1 + irow = irow + 1 END DO END DO ELSE @@ -1291,24 +1291,24 @@ SUBROUTINE write_mo_set_to_output_unit(mo_set, atomic_kind_set, qs_kind_set, par WRITE (UNIT=iw, FMT=fmtstr3) & irow, iatom, ADJUSTR(element_symbol), bsgf_symbol(isgf), & (smatrix(irow, jcol), jcol=from, to) - isgf = isgf+1 - irow = irow+1 + isgf = isgf + 1 + irow = irow + 1 END DO END DO END DO ELSE IF (ASSOCIATED(dftb_parameter)) THEN CALL get_dftb_atom_param(dftb_parameter, lmax=lmax) isgf = 1 - DO ishell = 1, lmax+1 - lshell = ishell-1 + DO ishell = 1, lmax + 1 + lshell = ishell - 1 DO iso = 1, nso(lshell) - symbol = sgf_symbol(1, lshell, -lshell+iso-1) + symbol = sgf_symbol(1, lshell, -lshell + iso - 1) symbol(1:2) = " " WRITE (UNIT=iw, FMT=fmtstr3) & irow, iatom, ADJUSTR(element_symbol), symbol, & (smatrix(irow, jcol), jcol=from, to) - isgf = isgf+1 - irow = irow+1 + isgf = isgf + 1 + irow = irow + 1 END DO END DO ELSE @@ -1353,7 +1353,7 @@ SUBROUTINE write_mo_set_to_output_unit(mo_set, atomic_kind_set, qs_kind_set, par WRITE (UNIT=iw, FMT=fmtstr6) " Fermi energy:", mo_set%mu IF ((mo_set%homo > 0)) THEN IF ((mo_set%occupation_numbers(mo_set%homo) == mo_set%maxocc) .AND. (last_mo > mo_set%homo)) THEN - gap = mo_set%eigenvalues(mo_set%homo+1)- & + gap = mo_set%eigenvalues(mo_set%homo + 1) - & mo_set%eigenvalues(mo_set%homo) fmtstr7 = "(A,T17,F24. ,A,F6.2,A,/)" WRITE (UNIT=fmtstr7(12:13), FMT="(I2)") after diff --git a/src/qs_mo_methods.F b/src/qs_mo_methods.F index eaa3456135..c237ced6f7 100644 --- a/src/qs_mo_methods.F +++ b/src/qs_mo_methods.F @@ -592,16 +592,16 @@ SUBROUTINE subspace_eigenvalues_ks_fm(orbitals, ks_matrix, evals_arg, ionode, sc IF (.NOT. PRESENT(scr)) CPABORT("SCR?") IF (ionode) THEN DO i = 1, ncol_global, 4 - j = MIN(3, ncol_global-i) + j = MIN(3, ncol_global - i) SELECT CASE (j) CASE (3) - WRITE (scr, '(1X,4F16.8)') evals(i:i+j) + WRITE (scr, '(1X,4F16.8)') evals(i:i + j) CASE (2) - WRITE (scr, '(1X,3F16.8)') evals(i:i+j) + WRITE (scr, '(1X,3F16.8)') evals(i:i + j) CASE (1) - WRITE (scr, '(1X,2F16.8)') evals(i:i+j) + WRITE (scr, '(1X,2F16.8)') evals(i:i + j) CASE (0) - WRITE (scr, '(1X,1F16.8)') evals(i:i+j) + WRITE (scr, '(1X,1F16.8)') evals(i:i + j) END SELECT ENDDO ENDIF @@ -742,16 +742,16 @@ SUBROUTINE subspace_eigenvalues_ks_dbcsr(orbitals, ks_matrix, evals_arg, ionode, IF (.NOT. PRESENT(scr)) CPABORT("SCR?") IF (ionode) THEN DO i = 1, ncol_global, 4 - j = MIN(3, ncol_global-i) + j = MIN(3, ncol_global - i) SELECT CASE (j) CASE (3) - WRITE (scr, '(1X,4F16.8)') evals(i:i+j) + WRITE (scr, '(1X,4F16.8)') evals(i:i + j) CASE (2) - WRITE (scr, '(1X,3F16.8)') evals(i:i+j) + WRITE (scr, '(1X,3F16.8)') evals(i:i + j) CASE (1) - WRITE (scr, '(1X,2F16.8)') evals(i:i+j) + WRITE (scr, '(1X,2F16.8)') evals(i:i + j) CASE (0) - WRITE (scr, '(1X,1F16.8)') evals(i:i+j) + WRITE (scr, '(1X,1F16.8)') evals(i:i + j) END SELECT ENDDO ENDIF @@ -838,7 +838,7 @@ SUBROUTINE calculate_orthonormality(orthonormality, mo_array, matrix_s) DO i = 1, nrow_local DO j = 1, ncol_local alpha = overlap%local_data(i, j) - IF (row_indices(i) .EQ. col_indices(j)) alpha = alpha-1.0_dp + IF (row_indices(i) .EQ. col_indices(j)) alpha = alpha - 1.0_dp max_alpha = MAX(max_alpha, ABS(alpha)) ENDDO ENDDO diff --git a/src/qs_mo_occupation.F b/src/qs_mo_occupation.F index d00abbaab9..a5bdad20e2 100644 --- a/src/qs_mo_occupation.F +++ b/src/qs_mo_occupation.F @@ -81,13 +81,13 @@ SUBROUTINE set_mo_occupation_3(mo_array, smear) occupation_numbers=occ_a) CALL get_mo_set(mo_set=mo_array(2)%mo_set, nmo=nmo_b, eigenvalues=eigval_b, & occupation_numbers=occ_b) - all_nmo = nmo_a+nmo_b + all_nmo = nmo_a + nmo_b ALLOCATE (all_eigval(all_nmo)) ALLOCATE (all_occ(all_nmo)) ALLOCATE (all_index(all_nmo)) all_eigval(1:nmo_a) = eigval_a(1:nmo_a) - all_eigval(nmo_a+1:all_nmo) = eigval_b(1:nmo_b) + all_eigval(nmo_a + 1:all_nmo) = eigval_b(1:nmo_b) CALL sort(all_eigval, all_nmo, all_index) @@ -99,20 +99,20 @@ SUBROUTINE set_mo_occupation_3(mo_array, smear) all_nelec = 0.0_dp nelec_a = accurate_sum(occ_a(:)) nelec_b = accurate_sum(occ_b(:)) - all_nelec = nelec_a+nelec_b + all_nelec = nelec_a + nelec_b DO i = 1, all_nmo IF (all_index(i) <= nmo_a) THEN all_occ(i) = occ_a(all_index(i)) ELSE - all_occ(i) = occ_b(all_index(i)-nmo_a) + all_occ(i) = occ_b(all_index(i) - nmo_a) END IF END DO CALL FermiFixed(all_occ, mu, kTS, all_eigval, all_nelec, & smear%electronic_temperature, 1._dp, xas_estate, occ_estate) - is_large = ABS(MAXVAL(all_occ)-1.0_dp) > smear%eps_fermi_dirac + is_large = ABS(MAXVAL(all_occ) - 1.0_dp) > smear%eps_fermi_dirac ! this is not a real problem, but the temperature might be a bit large IF (is_large) & CPWARN("Fermi-Dirac smearing includes the first MO") @@ -124,7 +124,7 @@ SUBROUTINE set_mo_occupation_3(mo_array, smear) "Add more MOs for proper smearing.") ! check that the total electron count is accurate - is_large = (ABS(all_nelec-accurate_sum(all_occ(:))) > smear%eps_fermi_dirac*all_nelec) + is_large = (ABS(all_nelec - accurate_sum(all_occ(:))) > smear%eps_fermi_dirac*all_nelec) IF (is_large) & CPWARN("Total number of electrons is not accurate") @@ -133,8 +133,8 @@ SUBROUTINE set_mo_occupation_3(mo_array, smear) occ_a(all_index(i)) = all_occ(i) eigval_a(all_index(i)) = all_eigval(i) ELSE - occ_b(all_index(i)-nmo_a) = all_occ(i) - eigval_b(all_index(i)-nmo_a) = all_eigval(i) + occ_b(all_index(i) - nmo_a) = all_occ(i) + eigval_b(all_index(i) - nmo_a) = all_eigval(i) END IF END DO @@ -153,14 +153,14 @@ SUBROUTINE set_mo_occupation_3(mo_array, smear) EXIT END IF END DO - homo_a = lfomo_a-1 + homo_a = lfomo_a - 1 DO i = nmo_a, lfomo_a, -1 IF (occ_a(i) > smear%eps_fermi_dirac) THEN homo_a = i EXIT END IF END DO - homo_b = lfomo_b-1 + homo_b = lfomo_b - 1 DO i = nmo_b, lfomo_b, -1 IF (occ_b(i) > smear%eps_fermi_dirac) THEN homo_b = i @@ -230,10 +230,10 @@ SUBROUTINE set_mo_occupation_2(mo_array, smear, eval_deriv) RETURN END IF ELSE - nelec_f = mo_set_a%n_el_f+mo_set_b%n_el_f - IF (ABS((mo_set_a%n_el_f-mo_set_b%n_el_f)-smear%fixed_mag_mom) > smear%eps_fermi_dirac*nelec_f) THEN - mo_set_a%n_el_f = nelec_f/2.0_dp+smear%fixed_mag_mom/2.0_dp - mo_set_b%n_el_f = nelec_f/2.0_dp-smear%fixed_mag_mom/2.0_dp + nelec_f = mo_set_a%n_el_f + mo_set_b%n_el_f + IF (ABS((mo_set_a%n_el_f - mo_set_b%n_el_f) - smear%fixed_mag_mom) > smear%eps_fermi_dirac*nelec_f) THEN + mo_set_a%n_el_f = nelec_f/2.0_dp + smear%fixed_mag_mom/2.0_dp + mo_set_b%n_el_f = nelec_f/2.0_dp - smear%fixed_mag_mom/2.0_dp END IF CPASSERT(.NOT. (PRESENT(eval_deriv))) CALL set_mo_occupation_1(mo_set_a, smear=smear) @@ -254,9 +254,9 @@ SUBROUTINE set_mo_occupation_2(mo_array, smear, eval_deriv) RETURN END IF - nelec = mo_set_a%nelectron+mo_set_b%nelectron + nelec = mo_set_a%nelectron + mo_set_b%nelectron - multiplicity_old = mo_set_a%nelectron-mo_set_b%nelectron+1 + multiplicity_old = mo_set_a%nelectron - mo_set_b%nelectron + 1 IF (mo_set_a%nelectron >= mo_set_a%nmo) & CALL cp_warn(__LOCATION__, & @@ -277,10 +277,10 @@ SUBROUTINE set_mo_occupation_2(mo_array, smear, eval_deriv) ! Threshold is needed to ensure a preference for alpha occupation in the case ! of degeneracy threshold = MAX(mo_set_a%flexible_electron_count, mo_set_b%flexible_electron_count) - IF ((eigval_a(lumo_a)-threshold) < eigval_b(lumo_b)) THEN - lumo_a = lumo_a+1 + IF ((eigval_a(lumo_a) - threshold) < eigval_b(lumo_b)) THEN + lumo_a = lumo_a + 1 ELSE - lumo_b = lumo_b+1 + lumo_b = lumo_b + 1 END IF IF (lumo_a > mo_set_a%nmo) THEN IF (i /= nelec) & @@ -288,8 +288,8 @@ SUBROUTINE set_mo_occupation_2(mo_array, smear, eval_deriv) "All alpha MOs are occupied. Add more alpha MOs to "// & "allow for a higher multiplicity") IF (i < nelec) THEN - lumo_a = lumo_a-1 - lumo_b = lumo_b+1 + lumo_a = lumo_a - 1 + lumo_b = lumo_b + 1 END IF END IF IF (lumo_b > mo_set_b%nmo) THEN @@ -298,14 +298,14 @@ SUBROUTINE set_mo_occupation_2(mo_array, smear, eval_deriv) "All beta MOs are occupied. Add more beta MOs to "// & "allow for a lower multiplicity") IF (i < nelec) THEN - lumo_a = lumo_a+1 - lumo_b = lumo_b-1 + lumo_a = lumo_a + 1 + lumo_b = lumo_b - 1 END IF END IF END DO - mo_set_a%homo = lumo_a-1 - mo_set_b%homo = lumo_b-1 + mo_set_a%homo = lumo_a - 1 + mo_set_b%homo = lumo_b - 1 IF (mo_set_b%homo > mo_set_a%homo) THEN CALL cp_warn(__LOCATION__, & @@ -314,13 +314,13 @@ SUBROUTINE set_mo_occupation_2(mo_array, smear, eval_deriv) ") than alpha ("// & TRIM(ADJUSTL(cp_to_string(mo_set_a%homo)))// & ") MOs are occupied. Resorting to low spin state") - mo_set_a%homo = nelec/2+MODULO(nelec, 2) + mo_set_a%homo = nelec/2 + MODULO(nelec, 2) mo_set_b%homo = nelec/2 END IF mo_set_a%nelectron = mo_set_a%homo mo_set_b%nelectron = mo_set_b%homo - multiplicity_new = mo_set_a%nelectron-mo_set_b%nelectron+1 + multiplicity_new = mo_set_a%nelectron - mo_set_b%nelectron + 1 IF (multiplicity_new /= multiplicity_old) & CALL cp_warn(__LOCATION__, & @@ -386,15 +386,15 @@ SUBROUTINE set_mo_occupation_1(mo_set, smear, eval_deriv, xas_env) occ_estate = 0.0_dp IF (PRESENT(xas_env)) THEN CALL get_xas_env(xas_env=xas_env, xas_nelectron=xas_nelectron, occ_estate=occ_estate, xas_estate=xas_estate) - nomo = INT(xas_nelectron+1-occ_estate) - IF (MOD(xas_nelectron+1-occ_estate, 1.0_dp) > EPSILON(0.0_dp)) nomo = nomo+1 + nomo = INT(xas_nelectron + 1 - occ_estate) + IF (MOD(xas_nelectron + 1 - occ_estate, 1.0_dp) > EPSILON(0.0_dp)) nomo = nomo + 1 mo_set%occupation_numbers(1:nomo) = mo_set%maxocc IF (xas_estate > 0) mo_set%occupation_numbers(xas_estate) = occ_estate el_count = SUM(mo_set%occupation_numbers(1:nomo)) - IF (el_count > xas_nelectron) mo_set%occupation_numbers(nomo) = mo_set%occupation_numbers(nomo)-(el_count-xas_nelectron) + IF (el_count > xas_nelectron) mo_set%occupation_numbers(nomo) = mo_set%occupation_numbers(nomo) - (el_count - xas_nelectron) el_count = SUM(mo_set%occupation_numbers(1:nomo)) - is_large = ABS(el_count-xas_nelectron) > xas_nelectron*EPSILON(el_count) + is_large = ABS(el_count - xas_nelectron) > xas_nelectron*EPSILON(el_count) CPASSERT(.NOT. is_large) ELSE IF (MODULO(mo_set%nelectron, INT(mo_set%maxocc)) == 0) THEN @@ -402,10 +402,10 @@ SUBROUTINE set_mo_occupation_1(mo_set, smear, eval_deriv, xas_env) ! Initialize MO occupations mo_set%occupation_numbers(1:nomo) = mo_set%maxocc ELSE - nomo = INT(mo_set%nelectron/mo_set%maxocc)+1 + nomo = INT(mo_set%nelectron/mo_set%maxocc) + 1 ! Initialize MO occupations - mo_set%occupation_numbers(1:nomo-1) = mo_set%maxocc - mo_set%occupation_numbers(nomo) = mo_set%nelectron-(nomo-1)*mo_set%maxocc + mo_set%occupation_numbers(1:nomo - 1) = mo_set%maxocc + mo_set%occupation_numbers(nomo) = mo_set%nelectron - (nomo - 1)*mo_set%maxocc END IF END IF nmo = SIZE(mo_set%eigenvalues) @@ -414,7 +414,7 @@ SUBROUTINE set_mo_occupation_1(mo_set, smear, eval_deriv, xas_env) CPASSERT((SIZE(mo_set%occupation_numbers) == nmo)) mo_set%homo = nomo - mo_set%lfomo = nomo+1 + mo_set%lfomo = nomo + 1 mo_set%mu = mo_set%eigenvalues(nomo) ! Check consistency of the array lengths @@ -446,7 +446,7 @@ SUBROUTINE set_mo_occupation_1(mo_set, smear, eval_deriv, xas_env) ! Perform smearing IF (smear%do_smear) THEN IF (PRESENT(xas_env)) THEN - i_first = xas_estate+1 + i_first = xas_estate + 1 nelec = xas_nelectron ELSE i_first = 1 @@ -472,7 +472,7 @@ SUBROUTINE set_mo_occupation_1(mo_set, smear, eval_deriv, xas_env) smear%electronic_temperature, mo_set%maxocc, lengthscale, xas_estate, occ_estate) ! deriv of E_{KS}-kT*S wrt to f_i - eval_deriv = eval_deriv-mo_set%eigenvalues+mo_set%mu + eval_deriv = eval_deriv - mo_set%eigenvalues + mo_set%mu ! correspondingly the deriv of E_{KS}-kT*S wrt to e_i eval_deriv = MATMUL(TRANSPOSE(dfde), eval_deriv) @@ -486,7 +486,7 @@ SUBROUTINE set_mo_occupation_1(mo_set, smear, eval_deriv, xas_env) EXIT END IF END DO - is_large = ABS(MAXVAL(mo_set%occupation_numbers)-mo_set%maxocc) > smear%eps_fermi_dirac + is_large = ABS(MAXVAL(mo_set%occupation_numbers) - mo_set%maxocc) > smear%eps_fermi_dirac ! this is not a real problem, but the temperature might be a bit large IF (is_large) & CPWARN("Fermi-Dirac smearing includes the first MO") @@ -505,7 +505,7 @@ SUBROUTINE set_mo_occupation_1(mo_set, smear, eval_deriv, xas_env) "Add more MOs for proper smearing.") ! check that the total electron count is accurate - is_large = (ABS(nelec-accurate_sum(mo_set%occupation_numbers(:))) > smear%eps_fermi_dirac*nelec) + is_large = (ABS(nelec - accurate_sum(mo_set%occupation_numbers(:))) > smear%eps_fermi_dirac*nelec) IF (is_large) & CPWARN("Total number of electrons is not accurate") @@ -514,11 +514,11 @@ SUBROUTINE set_mo_occupation_1(mo_set, smear, eval_deriv, xas_env) CPASSERT(.NOT. PRESENT(eval_deriv)) ! Define the energy window for the eigenvalues - e1 = mo_set%eigenvalues(mo_set%homo)-0.5_dp*smear%window_size + e1 = mo_set%eigenvalues(mo_set%homo) - 0.5_dp*smear%window_size IF (e1 <= mo_set%eigenvalues(1)) & CPWARN("Energy window for smearing includes the first MO") - e2 = mo_set%eigenvalues(mo_set%homo)+0.5_dp*smear%window_size + e2 = mo_set%eigenvalues(mo_set%homo) + 0.5_dp*smear%window_size IF (e2 >= mo_set%eigenvalues(nmo)) & CALL cp_warn(__LOCATION__, & "Energy window for smearing includes the last MO => "// & @@ -545,16 +545,16 @@ SUBROUTINE set_mo_occupation_1(mo_set, smear, eval_deriv, xas_env) nelec = 0.0_dp DO imo = mo_set%lfomo, mo_set%homo - nelec = nelec+mo_set%occupation_numbers(imo) - edist = edist+ABS(e2-mo_set%eigenvalues(imo)) + nelec = nelec + mo_set%occupation_numbers(imo) + edist = edist + ABS(e2 - mo_set%eigenvalues(imo)) END DO ! Smear electrons inside the energy window DO imo = mo_set%lfomo, mo_set%homo - edelta = ABS(e2-mo_set%eigenvalues(imo)) + edelta = ABS(e2 - mo_set%eigenvalues(imo)) mo_set%occupation_numbers(imo) = MIN(mo_set%maxocc, nelec*edelta/edist) - nelec = nelec-mo_set%occupation_numbers(imo) - edist = edist-edelta + nelec = nelec - mo_set%occupation_numbers(imo) + edist = edist - edelta END DO CASE (smear_list) @@ -573,7 +573,7 @@ SUBROUTINE set_mo_occupation_1(mo_set, smear, eval_deriv, xas_env) ! Check, if the smearing involves more than one MO IF (mo_set%lfomo == mo_set%homo) THEN mo_set%homo = nomo - mo_set%lfomo = nomo+1 + mo_set%lfomo = nomo + 1 ELSE mo_set%uniform_occupation = .FALSE. END IF diff --git a/src/qs_mo_types.F b/src/qs_mo_types.F index b56b7b6920..4dcf7d327b 100644 --- a/src/qs_mo_types.F +++ b/src/qs_mo_types.F @@ -245,17 +245,17 @@ SUBROUTINE init_mo_set(mo_set, fm_pool, fm_ref, name) nomo = NINT(mo_set%nelectron/mo_set%maxocc) mo_set%occupation_numbers(1:nomo) = mo_set%maxocc ELSE - nomo = INT(mo_set%nelectron/mo_set%maxocc)+1 + nomo = INT(mo_set%nelectron/mo_set%maxocc) + 1 ! Initialize MO occupations - mo_set%occupation_numbers(1:nomo-1) = mo_set%maxocc - mo_set%occupation_numbers(nomo) = mo_set%nelectron-(nomo-1)*mo_set%maxocc + mo_set%occupation_numbers(1:nomo - 1) = mo_set%maxocc + mo_set%occupation_numbers(nomo) = mo_set%nelectron - (nomo - 1)*mo_set%maxocc END IF CPASSERT(nmo >= nomo) CPASSERT((SIZE(mo_set%occupation_numbers) == nmo)) mo_set%homo = nomo - mo_set%lfomo = nomo+1 + mo_set%lfomo = nomo + 1 mo_set%mu = mo_set%eigenvalues(nomo) END SUBROUTINE init_mo_set diff --git a/src/qs_modify_pab_block.F b/src/qs_modify_pab_block.F index e6386abbd9..7d6388bc6d 100644 --- a/src/qs_modify_pab_block.F +++ b/src/qs_modify_pab_block.F @@ -73,48 +73,48 @@ SUBROUTINE prepare_dadb(pab_local, pab, lxa, lya, lza, lxb, lyb, lzb, o1, o2, ze jco = coset(lxb, lyb, lzb) ! x (all safe if lxa = 0, as the spurious added terms have zero prefactor) - ico_l = coset(MAX(lxa-1, 0), lya, lza) - jco_l = coset(MAX(lxb-1, 0), lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lxa*lxb*pab(o1+ico, o2+jco) - ico_l = coset(MAX(lxa-1, 0), lya, lza) - jco_l = coset((lxb+1), lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*lxa*zetb*pab(o1+ico, o2+jco) - ico_l = coset((lxa+1), lya, lza) - jco_l = coset(MAX(lxb-1, 0), lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zeta*lxb*pab(o1+ico, o2+jco) - ico_l = coset((lxa+1), lya, lza) - jco_l = coset((lxb+1), lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zeta*zetb*pab(o1+ico, o2+jco) + ico_l = coset(MAX(lxa - 1, 0), lya, lza) + jco_l = coset(MAX(lxb - 1, 0), lyb, lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lxa*lxb*pab(o1 + ico, o2 + jco) + ico_l = coset(MAX(lxa - 1, 0), lya, lza) + jco_l = coset((lxb + 1), lyb, lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*lxa*zetb*pab(o1 + ico, o2 + jco) + ico_l = coset((lxa + 1), lya, lza) + jco_l = coset(MAX(lxb - 1, 0), lyb, lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zeta*lxb*pab(o1 + ico, o2 + jco) + ico_l = coset((lxa + 1), lya, lza) + jco_l = coset((lxb + 1), lyb, lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 4.0_dp*zeta*zetb*pab(o1 + ico, o2 + jco) ! y - ico_l = coset(lxa, MAX(lya-1, 0), lza) - jco_l = coset(lxb, MAX(lyb-1, 0), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lya*lyb*pab(o1+ico, o2+jco) - ico_l = coset(lxa, MAX(lya-1, 0), lza) - jco_l = coset(lxb, (lyb+1), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*lya*zetb*pab(o1+ico, o2+jco) - ico_l = coset(lxa, (lya+1), lza) - jco_l = coset(lxb, MAX(lyb-1, 0), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zeta*lyb*pab(o1+ico, o2+jco) - ico_l = coset(lxa, (lya+1), lza) - jco_l = coset(lxb, (lyb+1), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zeta*zetb*pab(o1+ico, o2+jco) + ico_l = coset(lxa, MAX(lya - 1, 0), lza) + jco_l = coset(lxb, MAX(lyb - 1, 0), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lya*lyb*pab(o1 + ico, o2 + jco) + ico_l = coset(lxa, MAX(lya - 1, 0), lza) + jco_l = coset(lxb, (lyb + 1), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*lya*zetb*pab(o1 + ico, o2 + jco) + ico_l = coset(lxa, (lya + 1), lza) + jco_l = coset(lxb, MAX(lyb - 1, 0), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zeta*lyb*pab(o1 + ico, o2 + jco) + ico_l = coset(lxa, (lya + 1), lza) + jco_l = coset(lxb, (lyb + 1), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 4.0_dp*zeta*zetb*pab(o1 + ico, o2 + jco) ! z - ico_l = coset(lxa, lya, MAX(lza-1, 0)) - jco_l = coset(lxb, lyb, MAX(lzb-1, 0)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lza*lzb*pab(o1+ico, o2+jco) - ico_l = coset(lxa, lya, MAX(lza-1, 0)) - jco_l = coset(lxb, lyb, (lzb+1)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*lza*zetb*pab(o1+ico, o2+jco) - ico_l = coset(lxa, lya, (lza+1)) - jco_l = coset(lxb, lyb, MAX(lzb-1, 0)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zeta*lzb*pab(o1+ico, o2+jco) - ico_l = coset(lxa, lya, (lza+1)) - jco_l = coset(lxb, lyb, (lzb+1)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zeta*zetb*pab(o1+ico, o2+jco) + ico_l = coset(lxa, lya, MAX(lza - 1, 0)) + jco_l = coset(lxb, lyb, MAX(lzb - 1, 0)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lza*lzb*pab(o1 + ico, o2 + jco) + ico_l = coset(lxa, lya, MAX(lza - 1, 0)) + jco_l = coset(lxb, lyb, (lzb + 1)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*lza*zetb*pab(o1 + ico, o2 + jco) + ico_l = coset(lxa, lya, (lza + 1)) + jco_l = coset(lxb, lyb, MAX(lzb - 1, 0)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zeta*lzb*pab(o1 + ico, o2 + jco) + ico_l = coset(lxa, lya, (lza + 1)) + jco_l = coset(lxb, lyb, (lzb + 1)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 4.0_dp*zeta*zetb*pab(o1 + ico, o2 + jco) END SUBROUTINE prepare_dadb @@ -153,48 +153,48 @@ SUBROUTINE prepare_diadib(pab_local, pab, ider, lxa, lya, lza, lxb, lyb, lzb, o1 jco = coset(lxb, lyb, lzb) IF (ider == 1) THEN ! x (all safe if lxa = 0, as the spurious added terms have zero prefactor) - ico_l = coset(MAX(lxa-1, 0), lya, lza) - jco_l = coset(MAX(lxb-1, 0), lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lxa*lxb*pab(o1+ico, o2+jco) - ico_l = coset(MAX(lxa-1, 0), lya, lza) - jco_l = coset((lxb+1), lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*lxa*zetb*pab(o1+ico, o2+jco) - ico_l = coset((lxa+1), lya, lza) - jco_l = coset(MAX(lxb-1, 0), lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zeta*lxb*pab(o1+ico, o2+jco) - ico_l = coset((lxa+1), lya, lza) - jco_l = coset((lxb+1), lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zeta*zetb*pab(o1+ico, o2+jco) + ico_l = coset(MAX(lxa - 1, 0), lya, lza) + jco_l = coset(MAX(lxb - 1, 0), lyb, lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lxa*lxb*pab(o1 + ico, o2 + jco) + ico_l = coset(MAX(lxa - 1, 0), lya, lza) + jco_l = coset((lxb + 1), lyb, lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*lxa*zetb*pab(o1 + ico, o2 + jco) + ico_l = coset((lxa + 1), lya, lza) + jco_l = coset(MAX(lxb - 1, 0), lyb, lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zeta*lxb*pab(o1 + ico, o2 + jco) + ico_l = coset((lxa + 1), lya, lza) + jco_l = coset((lxb + 1), lyb, lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 4.0_dp*zeta*zetb*pab(o1 + ico, o2 + jco) ELSEIF (ider == 2) THEN ! y - ico_l = coset(lxa, MAX(lya-1, 0), lza) - jco_l = coset(lxb, MAX(lyb-1, 0), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lya*lyb*pab(o1+ico, o2+jco) - ico_l = coset(lxa, MAX(lya-1, 0), lza) - jco_l = coset(lxb, (lyb+1), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*lya*zetb*pab(o1+ico, o2+jco) - ico_l = coset(lxa, (lya+1), lza) - jco_l = coset(lxb, MAX(lyb-1, 0), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zeta*lyb*pab(o1+ico, o2+jco) - ico_l = coset(lxa, (lya+1), lza) - jco_l = coset(lxb, (lyb+1), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zeta*zetb*pab(o1+ico, o2+jco) + ico_l = coset(lxa, MAX(lya - 1, 0), lza) + jco_l = coset(lxb, MAX(lyb - 1, 0), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lya*lyb*pab(o1 + ico, o2 + jco) + ico_l = coset(lxa, MAX(lya - 1, 0), lza) + jco_l = coset(lxb, (lyb + 1), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*lya*zetb*pab(o1 + ico, o2 + jco) + ico_l = coset(lxa, (lya + 1), lza) + jco_l = coset(lxb, MAX(lyb - 1, 0), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zeta*lyb*pab(o1 + ico, o2 + jco) + ico_l = coset(lxa, (lya + 1), lza) + jco_l = coset(lxb, (lyb + 1), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 4.0_dp*zeta*zetb*pab(o1 + ico, o2 + jco) ELSEIF (ider == 3) THEN ! z - ico_l = coset(lxa, lya, MAX(lza-1, 0)) - jco_l = coset(lxb, lyb, MAX(lzb-1, 0)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lza*lzb*pab(o1+ico, o2+jco) - ico_l = coset(lxa, lya, MAX(lza-1, 0)) - jco_l = coset(lxb, lyb, (lzb+1)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*lza*zetb*pab(o1+ico, o2+jco) - ico_l = coset(lxa, lya, (lza+1)) - jco_l = coset(lxb, lyb, MAX(lzb-1, 0)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zeta*lzb*pab(o1+ico, o2+jco) - ico_l = coset(lxa, lya, (lza+1)) - jco_l = coset(lxb, lyb, (lzb+1)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zeta*zetb*pab(o1+ico, o2+jco) + ico_l = coset(lxa, lya, MAX(lza - 1, 0)) + jco_l = coset(lxb, lyb, MAX(lzb - 1, 0)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lza*lzb*pab(o1 + ico, o2 + jco) + ico_l = coset(lxa, lya, MAX(lza - 1, 0)) + jco_l = coset(lxb, lyb, (lzb + 1)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*lza*zetb*pab(o1 + ico, o2 + jco) + ico_l = coset(lxa, lya, (lza + 1)) + jco_l = coset(lxb, lyb, MAX(lzb - 1, 0)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zeta*lzb*pab(o1 + ico, o2 + jco) + ico_l = coset(lxa, lya, (lza + 1)) + jco_l = coset(lxb, lyb, (lzb + 1)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 4.0_dp*zeta*zetb*pab(o1 + ico, o2 + jco) END IF END SUBROUTINE prepare_diadib @@ -235,43 +235,43 @@ SUBROUTINE prepare_dijadijb(pab_local, pab, ider1, ider2, lxa, lya, lza, lxb, ly jco = coset(lxb, lyb, lzb) IF ((ider1 == 1 .AND. ider2 == 2) .OR. (ider1 == 2 .AND. ider2 == 1)) THEN ! xy - ico_l = coset(MAX(lxa-1, 0), MAX(lya-1, 0), lza) - func_a = lxa*lya*pab(o1+ico, o2+jco) + ico_l = coset(MAX(lxa - 1, 0), MAX(lya - 1, 0), lza) + func_a = lxa*lya*pab(o1 + ico, o2 + jco) CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=1) - ico_l = coset(lxa+1, MAX(lya-1, 0), lza) - func_a = -2.0_dp*zeta*lya*pab(o1+ico, o2+jco) + ico_l = coset(lxa + 1, MAX(lya - 1, 0), lza) + func_a = -2.0_dp*zeta*lya*pab(o1 + ico, o2 + jco) CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=1) - ico_l = coset(MAX(lxa-1, 0), lya+1, lza) - func_a = -2.0_dp*zeta*lxa*pab(o1+ico, o2+jco) + ico_l = coset(MAX(lxa - 1, 0), lya + 1, lza) + func_a = -2.0_dp*zeta*lxa*pab(o1 + ico, o2 + jco) CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=1) - ico_l = coset(lxa+1, lya+1, lza) - func_a = 4.0_dp*zeta*zeta*pab(o1+ico, o2+jco) + ico_l = coset(lxa + 1, lya + 1, lza) + func_a = 4.0_dp*zeta*zeta*pab(o1 + ico, o2 + jco) CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=1) ELSEIF ((ider1 == 2 .AND. ider2 == 3) .OR. (ider1 == 3 .AND. ider2 == 2)) THEN ! yz - ico_l = coset(lxa, MAX(lya-1, 0), MAX(lza-1, 0)) - func_a = lya*lza*pab(o1+ico, o2+jco) + ico_l = coset(lxa, MAX(lya - 1, 0), MAX(lza - 1, 0)) + func_a = lya*lza*pab(o1 + ico, o2 + jco) CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=2) - ico_l = coset(lxa, lya+1, MAX(lza-1, 0)) - func_a = -2.0_dp*zeta*lza*pab(o1+ico, o2+jco) + ico_l = coset(lxa, lya + 1, MAX(lza - 1, 0)) + func_a = -2.0_dp*zeta*lza*pab(o1 + ico, o2 + jco) CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=2) - ico_l = coset(lxa, MAX(lya-1, 0), lza+1) - func_a = -2.0_dp*zeta*lya*pab(o1+ico, o2+jco) + ico_l = coset(lxa, MAX(lya - 1, 0), lza + 1) + func_a = -2.0_dp*zeta*lya*pab(o1 + ico, o2 + jco) CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=2) - ico_l = coset(lxa, lya+1, lza+1) - func_a = 4.0_dp*zeta*zeta*pab(o1+ico, o2+jco) + ico_l = coset(lxa, lya + 1, lza + 1) + func_a = 4.0_dp*zeta*zeta*pab(o1 + ico, o2 + jco) CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=2) ELSEIF ((ider1 == 3 .AND. ider2 == 1) .OR. (ider1 == 1 .AND. ider2 == 3)) THEN ! zx - ico_l = coset(MAX(lxa-1, 0), lya, MAX(lza-1, 0)) - func_a = lza*lxa*pab(o1+ico, o2+jco) + ico_l = coset(MAX(lxa - 1, 0), lya, MAX(lza - 1, 0)) + func_a = lza*lxa*pab(o1 + ico, o2 + jco) CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=3) - ico_l = coset(MAX(lxa-1, 0), lya, lza+1) - func_a = -2.0_dp*zeta*lxa*pab(o1+ico, o2+jco) + ico_l = coset(MAX(lxa - 1, 0), lya, lza + 1) + func_a = -2.0_dp*zeta*lxa*pab(o1 + ico, o2 + jco) CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=3) - ico_l = coset(lxa+1, lya, MAX(lza-1, 0)) - func_a = -2.0_dp*zeta*lza*pab(o1+ico, o2+jco) + ico_l = coset(lxa + 1, lya, MAX(lza - 1, 0)) + func_a = -2.0_dp*zeta*lza*pab(o1 + ico, o2 + jco) CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=3) - ico_l = coset(lxa+1, lya, lza+1) - func_a = 4.0_dp*zeta*zeta*pab(o1+ico, o2+jco) + ico_l = coset(lxa + 1, lya, lza + 1) + func_a = 4.0_dp*zeta*zeta*pab(o1 + ico, o2 + jco) CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=3) END IF @@ -301,36 +301,36 @@ SUBROUTINE oneterm_dijdij(pab_local, func_a, ico_l, lx, ly, lz, zet, idir) IF (idir == 1) THEN l1 = lx l2 = ly - jco_l = coset(MAX(lx-1, 0), MAX(ly-1, 0), lz) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+l1*l2*func_a - jco_l = coset(lx+1, MAX(ly-1, 0), lz) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zet*l2*func_a - jco_l = coset(MAX(lx-1, 0), ly+1, lz) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zet*l1*func_a - jco_l = coset(lx+1, ly+1, lz) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zet*zet*func_a + jco_l = coset(MAX(lx - 1, 0), MAX(ly - 1, 0), lz) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + l1*l2*func_a + jco_l = coset(lx + 1, MAX(ly - 1, 0), lz) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zet*l2*func_a + jco_l = coset(MAX(lx - 1, 0), ly + 1, lz) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zet*l1*func_a + jco_l = coset(lx + 1, ly + 1, lz) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 4.0_dp*zet*zet*func_a ELSEIF (idir == 2) THEN l1 = ly l2 = lz - jco_l = coset(lx, MAX(ly-1, 0), MAX(lz-1, 0)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+l1*l2*func_a - jco_l = coset(lx, ly+1, MAX(lz-1, 0)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zet*l2*func_a - jco_l = coset(lx, MAX(ly-1, 0), lz+1) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zet*l1*func_a - jco_l = coset(lx, ly+1, lz+1) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zet*zet*func_a + jco_l = coset(lx, MAX(ly - 1, 0), MAX(lz - 1, 0)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + l1*l2*func_a + jco_l = coset(lx, ly + 1, MAX(lz - 1, 0)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zet*l2*func_a + jco_l = coset(lx, MAX(ly - 1, 0), lz + 1) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zet*l1*func_a + jco_l = coset(lx, ly + 1, lz + 1) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 4.0_dp*zet*zet*func_a ELSEIF (idir == 3) THEN l1 = lz l2 = lx - jco_l = coset(MAX(lx-1, 0), ly, MAX(lz-1, 0)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+l1*l2*func_a - jco_l = coset(MAX(lx-1, 0), ly, lz+1) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zet*l2*func_a - jco_l = coset(lx+1, ly, MAX(lz-1, 0)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zet*l1*func_a - jco_l = coset(lx+1, ly, lz+1) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zet*zet*func_a + jco_l = coset(MAX(lx - 1, 0), ly, MAX(lz - 1, 0)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + l1*l2*func_a + jco_l = coset(MAX(lx - 1, 0), ly, lz + 1) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zet*l2*func_a + jco_l = coset(lx + 1, ly, MAX(lz - 1, 0)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zet*l1*func_a + jco_l = coset(lx + 1, ly, lz + 1) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 4.0_dp*zet*zet*func_a END IF END SUBROUTINE oneterm_dijdij @@ -371,34 +371,34 @@ SUBROUTINE prepare_diiadiib(pab_local, pab, ider, lxa, lya, lza, lxb, lyb, lzb, jco = coset(lxb, lyb, lzb) IF (ider == 1) THEN ! x - ico_l = coset(MAX(lxa-2, 0), lya, lza) - func_a = lxa*(lxa-1)*pab(o1+ico, o2+jco) + ico_l = coset(MAX(lxa - 2, 0), lya, lza) + func_a = lxa*(lxa - 1)*pab(o1 + ico, o2 + jco) CALL oneterm_diidii(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=1) ico_l = coset(lxa, lya, lza) - func_a = -2.0_dp*zeta*(2*lxa+1)*pab(o1+ico, o2+jco) + func_a = -2.0_dp*zeta*(2*lxa + 1)*pab(o1 + ico, o2 + jco) CALL oneterm_diidii(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=1) - ico_l = coset(lxa+2, lya, lza) - func_a = 4.0_dp*zeta*zeta*pab(o1+ico, o2+jco) + ico_l = coset(lxa + 2, lya, lza) + func_a = 4.0_dp*zeta*zeta*pab(o1 + ico, o2 + jco) CALL oneterm_diidii(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=1) ELSEIF (ider == 2) THEN ! y - ico_l = coset(lxa, MAX(lya-2, 0), lza) - func_a = lya*(lya-1)*pab(o1+ico, o2+jco) + ico_l = coset(lxa, MAX(lya - 2, 0), lza) + func_a = lya*(lya - 1)*pab(o1 + ico, o2 + jco) CALL oneterm_diidii(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=2) ico_l = coset(lxa, lya, lza) - func_a = -2.0_dp*zeta*(2*lya+1)*pab(o1+ico, o2+jco) + func_a = -2.0_dp*zeta*(2*lya + 1)*pab(o1 + ico, o2 + jco) CALL oneterm_diidii(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=2) - ico_l = coset(lxa, lya+2, lza) - func_a = 4.0_dp*zeta*zeta*pab(o1+ico, o2+jco) + ico_l = coset(lxa, lya + 2, lza) + func_a = 4.0_dp*zeta*zeta*pab(o1 + ico, o2 + jco) CALL oneterm_diidii(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=2) ELSEIF (ider == 3) THEN ! z - ico_l = coset(lxa, lya, MAX(lza-2, 0)) - func_a = lza*(lza-1)*pab(o1+ico, o2+jco) + ico_l = coset(lxa, lya, MAX(lza - 2, 0)) + func_a = lza*(lza - 1)*pab(o1 + ico, o2 + jco) CALL oneterm_diidii(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=3) ico_l = coset(lxa, lya, lza) - func_a = -2.0_dp*zeta*(2*lza+1)*pab(o1+ico, o2+jco) + func_a = -2.0_dp*zeta*(2*lza + 1)*pab(o1 + ico, o2 + jco) CALL oneterm_diidii(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=3) - ico_l = coset(lxa, lya, lza+2) - func_a = 4.0_dp*zeta*zeta*pab(o1+ico, o2+jco) + ico_l = coset(lxa, lya, lza + 2) + func_a = 4.0_dp*zeta*zeta*pab(o1 + ico, o2 + jco) CALL oneterm_diidii(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=3) END IF @@ -426,28 +426,28 @@ SUBROUTINE oneterm_diidii(pab_local, func_a, ico_l, lx, ly, lz, zet, idir) IF (idir == 1) THEN l1 = lx - jco_l = coset(MAX(lx-2, 0), ly, lz) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+l1*(l1-1)*func_a + jco_l = coset(MAX(lx - 2, 0), ly, lz) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + l1*(l1 - 1)*func_a jco_l = coset(lx, ly, lz) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zet*(2*l1+1)*func_a - jco_l = coset(lx+2, ly, lz) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zet*zet*func_a + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zet*(2*l1 + 1)*func_a + jco_l = coset(lx + 2, ly, lz) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 4.0_dp*zet*zet*func_a ELSEIF (idir == 2) THEN l1 = ly - jco_l = coset(lx, MAX(ly-2, 0), lz) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+l1*(l1-1)*func_a + jco_l = coset(lx, MAX(ly - 2, 0), lz) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + l1*(l1 - 1)*func_a jco_l = coset(lx, ly, lz) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zet*(2*l1+1)*func_a - jco_l = coset(lx, ly+2, lz) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zet*zet*func_a + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zet*(2*l1 + 1)*func_a + jco_l = coset(lx, ly + 2, lz) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 4.0_dp*zet*zet*func_a ELSEIF (idir == 3) THEN l1 = lz - jco_l = coset(lx, ly, MAX(lz-2, 0)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+l1*(l1-1)*func_a + jco_l = coset(lx, ly, MAX(lz - 2, 0)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + l1*(l1 - 1)*func_a jco_l = coset(lx, ly, lz) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zet*(2*l1+1)*func_a - jco_l = coset(lx, ly, lz+2) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zet*zet*func_a + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zet*(2*l1 + 1)*func_a + jco_l = coset(lx, ly, lz + 2) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 4.0_dp*zet*zet*func_a END IF END SUBROUTINE oneterm_diidii @@ -488,43 +488,43 @@ SUBROUTINE prepare_adb_m_dab(pab_local, pab, idir, lxa, lya, lza, lxb, lyb, lzb, IF (idir == 1) THEN ! x ico_l = coset(lxa, lya, lza) - jco_l = coset(MAX(lxb-1, 0), lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lxb*pab(o1+ico, o2+jco) + jco_l = coset(MAX(lxb - 1, 0), lyb, lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lxb*pab(o1 + ico, o2 + jco) ico_l = coset(lxa, lya, lza) - jco_l = coset((lxb+1), lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco) - ico_l = coset(MAX(lxa-1, 0), lya, lza) + jco_l = coset((lxb + 1), lyb, lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zetb*pab(o1 + ico, o2 + jco) + ico_l = coset(MAX(lxa - 1, 0), lya, lza) jco_l = coset(lxb, lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lxa*pab(o1+ico, o2+jco) - ico_l = coset((lxa+1), lya, lza) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - lxa*pab(o1 + ico, o2 + jco) + ico_l = coset((lxa + 1), lya, lza) jco_l = coset(lxb, lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 2.0_dp*zeta*pab(o1 + ico, o2 + jco) ELSEIF (idir == 2) THEN ! y ico_l = coset(lxa, lya, lza) - jco_l = coset(lxb, MAX(lyb-1, 0), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lyb*pab(o1+ico, o2+jco) + jco_l = coset(lxb, MAX(lyb - 1, 0), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lyb*pab(o1 + ico, o2 + jco) ico_l = coset(lxa, lya, lza) - jco_l = coset(lxb, (lyb+1), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco) - ico_l = coset(lxa, MAX(lya-1, 0), lza) + jco_l = coset(lxb, (lyb + 1), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zetb*pab(o1 + ico, o2 + jco) + ico_l = coset(lxa, MAX(lya - 1, 0), lza) jco_l = coset(lxb, lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lya*pab(o1+ico, o2+jco) - ico_l = coset(lxa, (lya+1), lza) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - lya*pab(o1 + ico, o2 + jco) + ico_l = coset(lxa, (lya + 1), lza) jco_l = coset(lxb, lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 2.0_dp*zeta*pab(o1 + ico, o2 + jco) ELSE ! z ico_l = coset(lxa, lya, lza) - jco_l = coset(lxb, lyb, MAX(lzb-1, 0)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lzb*pab(o1+ico, o2+jco) + jco_l = coset(lxb, lyb, MAX(lzb - 1, 0)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lzb*pab(o1 + ico, o2 + jco) ico_l = coset(lxa, lya, lza) - jco_l = coset(lxb, lyb, (lzb+1)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco) - ico_l = coset(lxa, lya, MAX(lza-1, 0)) + jco_l = coset(lxb, lyb, (lzb + 1)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zetb*pab(o1 + ico, o2 + jco) + ico_l = coset(lxa, lya, MAX(lza - 1, 0)) jco_l = coset(lxb, lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lza*pab(o1+ico, o2+jco) - ico_l = coset(lxa, lya, (lza+1)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - lza*pab(o1 + ico, o2 + jco) + ico_l = coset(lxa, lya, (lza + 1)) jco_l = coset(lxb, lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 2.0_dp*zeta*pab(o1 + ico, o2 + jco) END IF END SUBROUTINE prepare_adb_m_dab @@ -566,43 +566,43 @@ SUBROUTINE prepare_dab_p_adb(pab_local, pab, idir, lxa, lya, lza, lxb, lyb, lzb, IF (idir == 1) THEN ! x ico_l = coset(lxa, lya, lza) - jco_l = coset(MAX(lxb-1, 0), lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lxb*pab(o1+ico, o2+jco) + jco_l = coset(MAX(lxb - 1, 0), lyb, lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lxb*pab(o1 + ico, o2 + jco) ico_l = coset(lxa, lya, lza) - jco_l = coset((lxb+1), lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco) - ico_l = coset(MAX(lxa-1, 0), lya, lza) + jco_l = coset((lxb + 1), lyb, lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zetb*pab(o1 + ico, o2 + jco) + ico_l = coset(MAX(lxa - 1, 0), lya, lza) jco_l = coset(lxb, lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lxa*pab(o1+ico, o2+jco) - ico_l = coset((lxa+1), lya, lza) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lxa*pab(o1 + ico, o2 + jco) + ico_l = coset((lxa + 1), lya, lza) jco_l = coset(lxb, lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zeta*pab(o1+ico, o2+jco) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zeta*pab(o1 + ico, o2 + jco) ELSEIF (idir == 2) THEN ! y ico_l = coset(lxa, lya, lza) - jco_l = coset(lxb, MAX(lyb-1, 0), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lyb*pab(o1+ico, o2+jco) + jco_l = coset(lxb, MAX(lyb - 1, 0), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lyb*pab(o1 + ico, o2 + jco) ico_l = coset(lxa, lya, lza) - jco_l = coset(lxb, (lyb+1), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco) - ico_l = coset(lxa, MAX(lya-1, 0), lza) + jco_l = coset(lxb, (lyb + 1), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zetb*pab(o1 + ico, o2 + jco) + ico_l = coset(lxa, MAX(lya - 1, 0), lza) jco_l = coset(lxb, lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lya*pab(o1+ico, o2+jco) - ico_l = coset(lxa, (lya+1), lza) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lya*pab(o1 + ico, o2 + jco) + ico_l = coset(lxa, (lya + 1), lza) jco_l = coset(lxb, lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zeta*pab(o1+ico, o2+jco) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zeta*pab(o1 + ico, o2 + jco) ELSE ! z ico_l = coset(lxa, lya, lza) - jco_l = coset(lxb, lyb, MAX(lzb-1, 0)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lzb*pab(o1+ico, o2+jco) + jco_l = coset(lxb, lyb, MAX(lzb - 1, 0)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lzb*pab(o1 + ico, o2 + jco) ico_l = coset(lxa, lya, lza) - jco_l = coset(lxb, lyb, (lzb+1)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco) - ico_l = coset(lxa, lya, MAX(lza-1, 0)) + jco_l = coset(lxb, lyb, (lzb + 1)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zetb*pab(o1 + ico, o2 + jco) + ico_l = coset(lxa, lya, MAX(lza - 1, 0)) jco_l = coset(lxb, lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lza*pab(o1+ico, o2+jco) - ico_l = coset(lxa, lya, (lza+1)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lza*pab(o1 + ico, o2 + jco) + ico_l = coset(lxa, lya, (lza + 1)) jco_l = coset(lxb, lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zeta*pab(o1+ico, o2+jco) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zeta*pab(o1 + ico, o2 + jco) END IF END SUBROUTINE prepare_dab_p_adb @@ -649,163 +649,163 @@ SUBROUTINE prepare_ardb_m_darb(pab_local, pab, idir, ir, lxa, lya, lza, lxb, lyb ico_l = coset(lxa, lya, lza) jco_l = coset(lxb, lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lxb*pab(o1+ico, o2+jco) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lxb*pab(o1 + ico, o2 + jco) ico_l = coset(lxa, lya, lza) - jco_l = coset((lxb+2), lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco) + jco_l = coset((lxb + 2), lyb, lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zetb*pab(o1 + ico, o2 + jco) - ico_l = coset(MAX(lxa-1, 0), lya, lza) - jco_l = coset((lxb+1), lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lxa*pab(o1+ico, o2+jco) + ico_l = coset(MAX(lxa - 1, 0), lya, lza) + jco_l = coset((lxb + 1), lyb, lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - lxa*pab(o1 + ico, o2 + jco) - ico_l = coset((lxa+1), lya, lza) - jco_l = coset((lxb+1), lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco) + ico_l = coset((lxa + 1), lya, lza) + jco_l = coset((lxb + 1), lyb, lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 2.0_dp*zeta*pab(o1 + ico, o2 + jco) ELSEIF (idir == 1 .AND. ir == 2) THEN ico_l = coset(lxa, lya, lza) - jco_l = coset(MAX(lxb-1, 0), (lyb+1), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lxb*pab(o1+ico, o2+jco) + jco_l = coset(MAX(lxb - 1, 0), (lyb + 1), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lxb*pab(o1 + ico, o2 + jco) ico_l = coset(lxa, lya, lza) - jco_l = coset((lxb+1), (lyb+1), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco) + jco_l = coset((lxb + 1), (lyb + 1), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zetb*pab(o1 + ico, o2 + jco) - ico_l = coset(MAX(lxa-1, 0), lya, lza) - jco_l = coset(lxb, (lyb+1), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lxa*pab(o1+ico, o2+jco) + ico_l = coset(MAX(lxa - 1, 0), lya, lza) + jco_l = coset(lxb, (lyb + 1), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - lxa*pab(o1 + ico, o2 + jco) - ico_l = coset((lxa+1), lya, lza) - jco_l = coset(lxb, (lyb+1), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco) + ico_l = coset((lxa + 1), lya, lza) + jco_l = coset(lxb, (lyb + 1), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 2.0_dp*zeta*pab(o1 + ico, o2 + jco) ELSEIF (idir == 1 .AND. ir == 3) THEN ico_l = coset(lxa, lya, lza) - jco_l = coset(MAX(lxb-1, 0), lyb, (lzb+1)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lxb*pab(o1+ico, o2+jco) + jco_l = coset(MAX(lxb - 1, 0), lyb, (lzb + 1)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lxb*pab(o1 + ico, o2 + jco) ico_l = coset(lxa, lya, lza) - jco_l = coset((lxb+1), lyb, (lzb+1)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco) + jco_l = coset((lxb + 1), lyb, (lzb + 1)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zetb*pab(o1 + ico, o2 + jco) - ico_l = coset(MAX(lxa-1, 0), lya, lza) - jco_l = coset(lxb, lyb, (lzb+1)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lxa*pab(o1+ico, o2+jco) + ico_l = coset(MAX(lxa - 1, 0), lya, lza) + jco_l = coset(lxb, lyb, (lzb + 1)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - lxa*pab(o1 + ico, o2 + jco) - ico_l = coset((lxa+1), lya, lza) - jco_l = coset(lxb, lyb, (lzb+1)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco) + ico_l = coset((lxa + 1), lya, lza) + jco_l = coset(lxb, lyb, (lzb + 1)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 2.0_dp*zeta*pab(o1 + ico, o2 + jco) ELSEIF (idir == 2 .AND. ir == 1) THEN ico_l = coset(lxa, lya, lza) - jco_l = coset((lxb+1), MAX(lyb-1, 0), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lyb*pab(o1+ico, o2+jco) + jco_l = coset((lxb + 1), MAX(lyb - 1, 0), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lyb*pab(o1 + ico, o2 + jco) ico_l = coset(lxa, lya, lza) - jco_l = coset((lxb+1), (lyb+1), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco) + jco_l = coset((lxb + 1), (lyb + 1), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zetb*pab(o1 + ico, o2 + jco) - ico_l = coset(lxa, MAX(lya-1, 0), lza) - jco_l = coset((lxb+1), lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lya*pab(o1+ico, o2+jco) + ico_l = coset(lxa, MAX(lya - 1, 0), lza) + jco_l = coset((lxb + 1), lyb, lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - lya*pab(o1 + ico, o2 + jco) - ico_l = coset(lxa, (lya+1), lza) - jco_l = coset((lxb+1), lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco) + ico_l = coset(lxa, (lya + 1), lza) + jco_l = coset((lxb + 1), lyb, lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 2.0_dp*zeta*pab(o1 + ico, o2 + jco) ELSEIF (idir == 2 .AND. ir == 2) THEN ico_l = coset(lxa, lya, lza) jco_l = coset(lxb, lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lyb*pab(o1+ico, o2+jco) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lyb*pab(o1 + ico, o2 + jco) ico_l = coset(lxa, lya, lza) - jco_l = coset(lxb, (lyb+2), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco) + jco_l = coset(lxb, (lyb + 2), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zetb*pab(o1 + ico, o2 + jco) - ico_l = coset(lxa, MAX(lya-1, 0), lza) - jco_l = coset(lxb, (lyb+1), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lya*pab(o1+ico, o2+jco) + ico_l = coset(lxa, MAX(lya - 1, 0), lza) + jco_l = coset(lxb, (lyb + 1), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - lya*pab(o1 + ico, o2 + jco) - ico_l = coset(lxa, (lya+1), lza) - jco_l = coset(lxb, (lyb+1), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco) + ico_l = coset(lxa, (lya + 1), lza) + jco_l = coset(lxb, (lyb + 1), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 2.0_dp*zeta*pab(o1 + ico, o2 + jco) ELSEIF (idir == 2 .AND. ir == 3) THEN ico_l = coset(lxa, lya, lza) - jco_l = coset(lxb, MAX(lyb-1, 0), (lzb+1)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lyb*pab(o1+ico, o2+jco) + jco_l = coset(lxb, MAX(lyb - 1, 0), (lzb + 1)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lyb*pab(o1 + ico, o2 + jco) ico_l = coset(lxa, lya, lza) - jco_l = coset(lxb, (lyb+1), (lzb+1)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco) + jco_l = coset(lxb, (lyb + 1), (lzb + 1)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zetb*pab(o1 + ico, o2 + jco) - ico_l = coset(lxa, MAX(lya-1, 0), lza) - jco_l = coset(lxb, lyb, (lzb+1)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lya*pab(o1+ico, o2+jco) + ico_l = coset(lxa, MAX(lya - 1, 0), lza) + jco_l = coset(lxb, lyb, (lzb + 1)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - lya*pab(o1 + ico, o2 + jco) - ico_l = coset(lxa, (lya+1), lza) - jco_l = coset(lxb, lyb, (lzb+1)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco) + ico_l = coset(lxa, (lya + 1), lza) + jco_l = coset(lxb, lyb, (lzb + 1)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 2.0_dp*zeta*pab(o1 + ico, o2 + jco) ELSEIF (idir == 3 .AND. ir == 1) THEN ico_l = coset(lxa, lya, lza) - jco_l = coset((lxb+1), lyb, MAX(lzb-1, 0)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lzb*pab(o1+ico, o2+jco) + jco_l = coset((lxb + 1), lyb, MAX(lzb - 1, 0)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lzb*pab(o1 + ico, o2 + jco) ico_l = coset(lxa, lya, lza) - jco_l = coset((lxb+1), lyb, (lzb+1)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco) + jco_l = coset((lxb + 1), lyb, (lzb + 1)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zetb*pab(o1 + ico, o2 + jco) - ico_l = coset(lxa, lya, MAX(lza-1, 0)) - jco_l = coset((lxb+1), lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lza*pab(o1+ico, o2+jco) + ico_l = coset(lxa, lya, MAX(lza - 1, 0)) + jco_l = coset((lxb + 1), lyb, lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - lza*pab(o1 + ico, o2 + jco) - ico_l = coset(lxa, lya, (lza+1)) - jco_l = coset((lxb+1), lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco) + ico_l = coset(lxa, lya, (lza + 1)) + jco_l = coset((lxb + 1), lyb, lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 2.0_dp*zeta*pab(o1 + ico, o2 + jco) ELSEIF (idir == 3 .AND. ir == 2) THEN ico_l = coset(lxa, lya, lza) - jco_l = coset(lxb, (lyb+1), MAX(lzb-1, 0)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lzb*pab(o1+ico, o2+jco) + jco_l = coset(lxb, (lyb + 1), MAX(lzb - 1, 0)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lzb*pab(o1 + ico, o2 + jco) ico_l = coset(lxa, lya, lza) - jco_l = coset(lxb, (lyb+1), (lzb+1)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco) + jco_l = coset(lxb, (lyb + 1), (lzb + 1)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zetb*pab(o1 + ico, o2 + jco) - ico_l = coset(lxa, lya, MAX(lza-1, 0)) - jco_l = coset(lxb, (lyb+1), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lza*pab(o1+ico, o2+jco) + ico_l = coset(lxa, lya, MAX(lza - 1, 0)) + jco_l = coset(lxb, (lyb + 1), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - lza*pab(o1 + ico, o2 + jco) - ico_l = coset(lxa, lya, (lza+1)) - jco_l = coset(lxb, (lyb+1), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco) + ico_l = coset(lxa, lya, (lza + 1)) + jco_l = coset(lxb, (lyb + 1), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 2.0_dp*zeta*pab(o1 + ico, o2 + jco) ELSEIF (idir == 3 .AND. ir == 3) THEN ico_l = coset(lxa, lya, lza) jco_l = coset(lxb, lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lzb*pab(o1+ico, o2+jco) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + lzb*pab(o1 + ico, o2 + jco) ico_l = coset(lxa, lya, lza) - jco_l = coset(lxb, lyb, (lzb+2)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco) + jco_l = coset(lxb, lyb, (lzb + 2)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - 2.0_dp*zetb*pab(o1 + ico, o2 + jco) - ico_l = coset(lxa, lya, MAX(lza-1, 0)) - jco_l = coset(lxb, lyb, (lzb+1)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lza*pab(o1+ico, o2+jco) + ico_l = coset(lxa, lya, MAX(lza - 1, 0)) + jco_l = coset(lxb, lyb, (lzb + 1)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) - lza*pab(o1 + ico, o2 + jco) - ico_l = coset(lxa, lya, (lza+1)) - jco_l = coset(lxb, lyb, (lzb+1)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco) + ico_l = coset(lxa, lya, (lza + 1)) + jco_l = coset(lxb, lyb, (lzb + 1)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + 2.0_dp*zeta*pab(o1 + ico, o2 + jco) END IF @@ -840,20 +840,20 @@ SUBROUTINE prepare_arb(pab_local, pab, ir, lxa, lya, lza, lxb, lyb, lzb, o1, o2) IF (ir == 1) THEN ico_l = coset(lxa, lya, lza) - jco_l = coset((lxb+1), lyb, lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+pab(o1+ico, o2+jco) + jco_l = coset((lxb + 1), lyb, lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + pab(o1 + ico, o2 + jco) ELSEIF (ir == 2) THEN ico_l = coset(lxa, lya, lza) - jco_l = coset(lxb, (lyb+1), lzb) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+pab(o1+ico, o2+jco) + jco_l = coset(lxb, (lyb + 1), lzb) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + pab(o1 + ico, o2 + jco) ELSEIF (ir == 3) THEN ico_l = coset(lxa, lya, lza) - jco_l = coset(lxb, lyb, (lzb+1)) - pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+pab(o1+ico, o2+jco) + jco_l = coset(lxb, lyb, (lzb + 1)) + pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l) + pab(o1 + ico, o2 + jco) END IF diff --git a/src/qs_mom_methods.F b/src/qs_mom_methods.F index cd0ed812bf..4e24482258 100644 --- a/src/qs_mom_methods.F +++ b/src/qs_mom_methods.F @@ -171,8 +171,8 @@ SUBROUTINE mom_reoccupy_orbitals(mo_set, deocc_orb_set, occ_orb_set, spin) iorb = occ_orb_set(norbs) ENDIF - IF (iorb-nmo > 1) THEN - CALL integer_to_string(iorb-nmo, str_iorb) + IF (iorb - nmo > 1) THEN + CALL integer_to_string(iorb - nmo, str_iorb) str_prefix = 's' ELSE str_iorb = 'an' diff --git a/src/qs_moments.F b/src/qs_moments.F index e06d028e06..7c2ab90d90 100644 --- a/src/qs_moments.F +++ b/src/qs_moments.F @@ -150,7 +150,7 @@ SUBROUTINE build_local_moment_matrix(qs_env, moments, nmoments, ref_point, ref_p NULLIFY (qs_kind_set, cell, particle_set, sab_orb) - nm = (6+11*nmoments+6*nmoments**2+nmoments**3)/6-1 + nm = (6 + 11*nmoments + 6*nmoments**2 + nmoments**3)/6 - 1 CPASSERT(SIZE(moments) >= nm) NULLIFY (qs_kind_set, particle_set, sab_orb, cell) @@ -244,7 +244,7 @@ SUBROUTINE build_local_moment_matrix(qs_env, moments, nmoments, ref_point, ref_p ! fold atomic position back into unit cell IF (PRESENT(ref_points)) THEN - rc(:) = 0.5_dp*(ref_points(:, iatom)+ref_points(:, jatom)) + rc(:) = 0.5_dp*(ref_points(:, iatom) + ref_points(:, jatom)) ELSE IF (PRESENT(ref_point)) THEN rc(:) = ref_point(:) ELSE @@ -252,13 +252,13 @@ SUBROUTINE build_local_moment_matrix(qs_env, moments, nmoments, ref_point, ref_p END IF ! using PBC here might screw a molecule that fits the box (but e.g. hasn't been shifted by center_molecule) ! by folding around the center, such screwing can be avoided for a proper choice of center. - ra(:) = pbc(particle_set(iatom)%r(:)-rc, cell)+rc - rb(:) = pbc(particle_set(jatom)%r(:)-rc, cell)+rc + ra(:) = pbc(particle_set(iatom)%r(:) - rc, cell) + rc + rb(:) = pbc(particle_set(jatom)%r(:) - rc, cell) + rc ! we dont use PBC at this point - rab(:) = ra(:)-rb(:) - rac(:) = ra(:)-rc(:) - rbc(:) = rb(:)-rc(:) - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab(:) = ra(:) - rb(:) + rac(:) = ra(:) - rc(:) + rbc(:) = rb(:) - rc(:) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) dab = SQRT(rab2) DO iset = 1, nseta @@ -268,7 +268,7 @@ SUBROUTINE build_local_moment_matrix(qs_env, moments, nmoments, ref_point, ref_p DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) @@ -476,7 +476,7 @@ SUBROUTINE build_local_magmom_matrix(qs_env, magmom, nmoments, ref_point, ref_po ! fold atomic position back into unit cell IF (PRESENT(ref_points)) THEN - rc(:) = 0.5_dp*(ref_points(:, iatom)+ref_points(:, jatom)) + rc(:) = 0.5_dp*(ref_points(:, iatom) + ref_points(:, jatom)) ELSE IF (PRESENT(ref_point)) THEN rc(:) = ref_point(:) ELSE @@ -484,13 +484,13 @@ SUBROUTINE build_local_magmom_matrix(qs_env, magmom, nmoments, ref_point, ref_po END IF ! using PBC here might screw a molecule that fits the box (but e.g. hasn't been shifted by center_molecule) ! by folding around the center, such screwing can be avoided for a proper choice of center. - ra(:) = pbc(particle_set(iatom)%r(:)-rc, cell)+rc - rb(:) = pbc(particle_set(jatom)%r(:)-rc, cell)+rc + ra(:) = pbc(particle_set(iatom)%r(:) - rc, cell) + rc + rb(:) = pbc(particle_set(jatom)%r(:) - rc, cell) + rc ! we dont use PBC at this point - rab(:) = ra(:)-rb(:) - rac(:) = ra(:)-rc(:) - rbc(:) = rb(:)-rc(:) - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab(:) = ra(:) - rb(:) + rac(:) = ra(:) - rc(:) + rbc(:) = rb(:) - rc(:) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) dab = SQRT(rab2) DO iset = 1, nseta @@ -500,7 +500,7 @@ SUBROUTINE build_local_magmom_matrix(qs_env, magmom, nmoments, ref_point, ref_po DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) @@ -676,8 +676,8 @@ SUBROUTINE build_berry_moment_matrix(qs_env, cosmat, sinmat, kvec, sab_orb_exter IF (ASSOCIATED(cblock) .AND. ASSOCIATED(sblock)) THEN ra(:) = pbc(particle_set(iatom)%r(:), cell) - rb(:) = ra+rab - dab = SQRT(rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3)) + rb(:) = ra + rab + dab = SQRT(rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3)) DO iset = 1, nseta @@ -686,7 +686,7 @@ SUBROUTINE build_berry_moment_matrix(qs_env, cosmat, sinmat, kvec, sab_orb_exter DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) @@ -886,8 +886,8 @@ SUBROUTINE build_berry_kpoint_matrix(qs_env, cosmat, sinmat, kvec) CPASSERT(found) ra(:) = pbc(particle_set(iatom)%r(:), cell) - rb(:) = ra+rab - dab = SQRT(rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3)) + rb(:) = ra + rab + dab = SQRT(rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3)) DO iset = 1, nseta @@ -896,7 +896,7 @@ SUBROUTINE build_berry_kpoint_matrix(qs_env, cosmat, sinmat, kvec) DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) @@ -990,12 +990,12 @@ SUBROUTINE qs_moment_berry_phase(qs_env, magnetic, nmoments, reference, ref_poin ! restrict maximum moment available nmom = MIN(nmoments, 2) - nm = (6+11*nmom+6*nmom**2+nmom**3)/6-1 + nm = (6 + 11*nmom + 6*nmom**2 + nmom**3)/6 - 1 ! rmom(:,1)=electronic ! rmom(:,2)=nuclear ! rmom(:,1)=total - ALLOCATE (rmom(nm+1, 3)) - ALLOCATE (rlab(nm+1)) + ALLOCATE (rmom(nm + 1, 3)) + ALLOCATE (rlab(nm + 1)) rmom = 0.0_dp rlab = "" IF (magnetic) THEN @@ -1035,7 +1035,7 @@ SUBROUTINE qs_moment_berry_phase(qs_env, magnetic, nmoments, reference, ref_poin DO ispin = 1, dft_control%nspins NULLIFY (tmp_fm_struct, mo_coeff) CALL get_mo_set(mo_set=mos(ispin)%mo_set, mo_coeff=mo_coeff, nao=nao, nmo=nmo) - nmotot = nmotot+nmo + nmotot = nmotot + nmo CALL cp_fm_create(opvec(ispin)%matrix, mo_coeff%matrix_struct) CALL cp_fm_struct_create(tmp_fm_struct, nrow_global=nmo, & ncol_global=nmo, para_env=para_env, context=mo_coeff%matrix_struct%context) @@ -1061,10 +1061,10 @@ SUBROUTINE qs_moment_berry_phase(qs_env, magnetic, nmoments, reference, ref_poin ! label DO l = 1, nm - ix = indco(1, l+1) - iy = indco(2, l+1) - iz = indco(3, l+1) - CALL set_label(rlab(l+1), ix, iy, iz) + ix = indco(1, l + 1) + iy = indco(2, l + 1) + iz = indco(3, l + 1) + CALL set_label(rlab(l + 1), ix, iy, iz) END DO ! nuclear contribution @@ -1073,7 +1073,7 @@ SUBROUTINE qs_moment_berry_phase(qs_env, magnetic, nmoments, reference, ref_poin CALL get_atomic_kind(atomic_kind, kind_number=ikind) CALL get_qs_kind(qs_kind_set(ikind), core_charge=charge, ghost=ghost, floating=floating) IF (.NOT. ghost .AND. .NOT. floating) THEN - rmom(1, 2) = rmom(1, 2)-charge + rmom(1, 2) = rmom(1, 2) - charge ENDIF END DO ria = twopi*MATMUL(cell%h_inv, rcc) @@ -1120,7 +1120,7 @@ SUBROUTINE qs_moment_berry_phase(qs_env, magnetic, nmoments, reference, ref_poin ria = pbc(ria, cell) DO i = 1, 3 DO j = i, 3 - kvec(:) = twopi*(cell%h_inv(i, :)+cell%h_inv(j, :)) + kvec(:) = twopi*(cell%h_inv(i, :) + cell%h_inv(j, :)) dd = SUM(kvec(:)*ria(:)) zdeta = CMPLX(COS(dd), SIN(dd), KIND=dp)**charge zij(i, j) = zij(i, j)*zdeta @@ -1138,15 +1138,15 @@ SUBROUTINE qs_moment_berry_phase(qs_env, magnetic, nmoments, reference, ref_poin cij = 0.5_dp*cij/twopi/twopi cij = MATMUL(MATMUL(cell%hmat, cij), TRANSPOSE(cell%hmat)) DO k = 4, 9 - ix = indco(1, k+1) - iy = indco(2, k+1) - iz = indco(3, k+1) + ix = indco(1, k + 1) + iy = indco(2, k + 1) + iz = indco(3, k + 1) IF (ix == 0) THEN - rmom(k+1, 2) = cij(iy, iz) + rmom(k + 1, 2) = cij(iy, iz) ELSE IF (iy == 0) THEN - rmom(k+1, 2) = cij(ix, iz) + rmom(k + 1, 2) = cij(ix, iz) ELSE IF (iz == 0) THEN - rmom(k+1, 2) = cij(ix, iy) + rmom(k + 1, 2) = cij(ix, iy) END IF END DO CASE (3) @@ -1169,7 +1169,7 @@ SUBROUTINE qs_moment_berry_phase(qs_env, magnetic, nmoments, reference, ref_poin trace = 0.0_dp DO ispin = 1, dft_control%nspins CALL dbcsr_dot(rho_ao(ispin)%matrix, matrix_s(1)%matrix, trace) - rmom(1, 1) = rmom(1, 1)+trace + rmom(1, 1) = rmom(1, 1) + trace END DO zi = 0._dp @@ -1213,7 +1213,7 @@ SUBROUTINE qs_moment_berry_phase(qs_env, magnetic, nmoments, reference, ref_poin CPABORT("Berry phase moments bigger than 1 not implemented") DO i = 1, 3 DO j = i, 3 - kvec(:) = twopi*(cell%h_inv(i, :)+cell%h_inv(j, :)) + kvec(:) = twopi*(cell%h_inv(i, :) + cell%h_inv(j, :)) CALL build_berry_moment_matrix(qs_env, cosmat, sinmat, kvec) IF (qs_env%run_rtp) THEN CALL get_qs_env(qs_env, rtp=rtp) @@ -1256,8 +1256,8 @@ SUBROUTINE qs_moment_berry_phase(qs_env, magnetic, nmoments, reference, ref_poin ! Dipole (apply periodic (2 Pi) boundary conditions) ci = AIMAG(LOG(zi)) DO i = 1, 3 - IF (qq(i)+ci(i) > pi) ci(i) = ci(i)-twopi - IF (qq(i)+ci(i) < -pi) ci(i) = ci(i)+twopi + IF (qq(i) + ci(i) > pi) ci(i) = ci(i) - twopi + IF (qq(i) + ci(i) < -pi) ci(i) = ci(i) + twopi END DO rmom(2:4, 1) = MATMUL(cell%hmat, ci)/twopi CASE (2) @@ -1272,15 +1272,15 @@ SUBROUTINE qs_moment_berry_phase(qs_env, magnetic, nmoments, reference, ref_poin cij = 0.5_dp*cij/twopi/twopi cij = MATMUL(MATMUL(cell%hmat, cij), TRANSPOSE(cell%hmat)) DO k = 4, 9 - ix = indco(1, k+1) - iy = indco(2, k+1) - iz = indco(3, k+1) + ix = indco(1, k + 1) + iy = indco(2, k + 1) + iz = indco(3, k + 1) IF (ix == 0) THEN - rmom(k+1, 1) = cij(iy, iz) + rmom(k + 1, 1) = cij(iy, iz) ELSE IF (iy == 0) THEN - rmom(k+1, 1) = cij(ix, iz) + rmom(k + 1, 1) = cij(ix, iz) ELSE IF (iz == 0) THEN - rmom(k+1, 1) = cij(ix, iy) + rmom(k + 1, 1) = cij(ix, iy) END IF END DO CASE (3) @@ -1294,7 +1294,7 @@ SUBROUTINE qs_moment_berry_phase(qs_env, magnetic, nmoments, reference, ref_poin END SELECT END DO - rmom(:, 3) = rmom(:, 1)+rmom(:, 2) + rmom(:, 3) = rmom(:, 1) + rmom(:, 2) description = "[DIPOLE]" CALL cp_results_erase(results=results, description=description) CALL put_results(results=results, description=description, & @@ -1397,16 +1397,16 @@ SUBROUTINE op_orbbas_rtp(cosmat, sinmat, mos, op_fm_set, mos_new) CALL cp_fm_set_all(work, 0.0_dp, 0.0_dp) DO icol = 1, lcol - work%local_data(:, icol) = mos_new(2*i-1)%matrix%local_data(:, icol) - work%local_data(:, icol+lcol) = mos_new(2*i)%matrix%local_data(:, icol) + work%local_data(:, icol) = mos_new(2*i - 1)%matrix%local_data(:, icol) + work%local_data(:, icol + lcol) = mos_new(2*i)%matrix%local_data(:, icol) END DO CALL cp_dbcsr_sm_fm_multiply(cosmat, work, work1, ncol=newdim) CALL cp_dbcsr_sm_fm_multiply(sinmat, work, work2, ncol=newdim) DO icol = 1, lcol - work%local_data(:, icol) = work1%local_data(:, icol)-work2%local_data(:, icol+lcol) - work%local_data(:, icol+lcol) = work1%local_data(:, icol+lcol)+work2%local_data(:, icol) + work%local_data(:, icol) = work1%local_data(:, icol) - work2%local_data(:, icol + lcol) + work%local_data(:, icol + lcol) = work1%local_data(:, icol + lcol) + work2%local_data(:, icol) END DO CALL cp_fm_release(work1) @@ -1420,12 +1420,12 @@ SUBROUTINE op_orbbas_rtp(cosmat, sinmat, mos, op_fm_set, mos_new) CALL cp_fm_create(work1, matrix_struct=newstruct1) - CALL cp_gemm("T", "N", nmo, newdim, nao, 1.0_dp, mos_new(2*i-1)%matrix, & + CALL cp_gemm("T", "N", nmo, newdim, nao, 1.0_dp, mos_new(2*i - 1)%matrix, & work, 0.0_dp, work1) DO icol = 1, lcol op_fm_set(1, i)%matrix%local_data(:, icol) = work1%local_data(:, icol) - op_fm_set(2, i)%matrix%local_data(:, icol) = work1%local_data(:, icol+lcol) + op_fm_set(2, i)%matrix%local_data(:, icol) = work1%local_data(:, icol + lcol) END DO CALL cp_gemm("T", "N", nmo, newdim, nao, 1.0_dp, mos_new(2*i)%matrix, & @@ -1433,9 +1433,9 @@ SUBROUTINE op_orbbas_rtp(cosmat, sinmat, mos, op_fm_set, mos_new) DO icol = 1, lcol op_fm_set(1, i)%matrix%local_data(:, icol) = & - op_fm_set(1, i)%matrix%local_data(:, icol)+work1%local_data(:, icol+lcol) + op_fm_set(1, i)%matrix%local_data(:, icol) + work1%local_data(:, icol + lcol) op_fm_set(2, i)%matrix%local_data(:, icol) = & - op_fm_set(2, i)%matrix%local_data(:, icol)-work1%local_data(:, icol) + op_fm_set(2, i)%matrix%local_data(:, icol) - work1%local_data(:, icol) END DO CALL cp_fm_release(work) @@ -1499,7 +1499,7 @@ SUBROUTINE qs_moment_locop(qs_env, magnetic, nmoments, reference, ref_point, uni ! electronic contribution NULLIFY (moments, matrix_s) CALL get_qs_env(qs_env=qs_env, matrix_s=matrix_s) - nm = (6+11*nmom+6*nmom**2+nmom**3)/6-1 + nm = (6 + 11*nmom + 6*nmom**2 + nmom**3)/6 - 1 CALL dbcsr_allocate_matrix_set(moments, nm) DO i = 1, nm ALLOCATE (moments(i)%matrix) @@ -1523,24 +1523,24 @@ SUBROUTINE qs_moment_locop(qs_env, magnetic, nmoments, reference, ref_point, uni CALL qs_rho_get(rho, rho_ao=rho_ao) nm = SIZE(moments) - ALLOCATE (rmom(nm+1, 3)) - ALLOCATE (rlab(nm+1)) + ALLOCATE (rmom(nm + 1, 3)) + ALLOCATE (rlab(nm + 1)) rmom = 0.0_dp rlab = "" trace = 0.0_dp DO ispin = 1, dft_control%nspins CALL dbcsr_dot(rho_ao(ispin)%matrix, matrix_s(1)%matrix, trace) - rmom(1, 1) = rmom(1, 1)+trace + rmom(1, 1) = rmom(1, 1) + trace END DO DO i = 1, SIZE(moments) strace = 0._dp DO ispin = 1, dft_control%nspins CALL dbcsr_dot(rho_ao(ispin)%matrix, moments(i)%matrix, trace) - strace = strace+trace + strace = strace + trace END DO - rmom(i+1, 1) = strace + rmom(i + 1, 1) = strace END DO CALL dbcsr_deallocate_matrix_set(moments) @@ -1552,28 +1552,28 @@ SUBROUTINE qs_moment_locop(qs_env, magnetic, nmoments, reference, ref_point, uni DO ia = 1, local_particles%n_el(ikind) iatom = local_particles%list(ikind)%array(ia) ! fold atomic positions back into unit cell - ria = pbc(particle_set(iatom)%r-rcc, cell)+rcc - ria = ria-rcc + ria = pbc(particle_set(iatom)%r - rcc, cell) + rcc + ria = ria - rcc atomic_kind => particle_set(iatom)%atomic_kind CALL get_atomic_kind(atomic_kind, kind_number=akind) CALL get_qs_kind(qs_kind_set(akind), core_charge=charge) - rmom(1, 2) = rmom(1, 2)-charge + rmom(1, 2) = rmom(1, 2) - charge DO l = 1, nm - ix = indco(1, l+1) - iy = indco(2, l+1) - iz = indco(3, l+1) + ix = indco(1, l + 1) + iy = indco(2, l + 1) + iz = indco(3, l + 1) dd = 1._dp IF (ix > 0) dd = dd*ria(1)**ix IF (iy > 0) dd = dd*ria(2)**iy IF (iz > 0) dd = dd*ria(3)**iz - rmom(l+1, 2) = rmom(l+1, 2)-charge*dd - CALL set_label(rlab(l+1), ix, iy, iz) + rmom(l + 1, 2) = rmom(l + 1, 2) - charge*dd + CALL set_label(rlab(l + 1), ix, iy, iz) END DO END DO END DO CALL mp_sum(rmom(:, 2), para_env%group) rmom(:, :) = -rmom(:, :) - rmom(:, 3) = rmom(:, 1)+rmom(:, 2) + rmom(:, 3) = rmom(:, 1) + rmom(:, 2) ! magnetic moments IF (magnetic) THEN @@ -1603,7 +1603,7 @@ SUBROUTINE qs_moment_locop(qs_env, magnetic, nmoments, reference, ref_point, uni CALL dbcsr_multiply("T", "N", 1.0_dp, rho_ao(ispin)%matrix, magmom(i)%matrix, & 0.0_dp, rho_magmom_ao) CALL dbcsr_trace(rho_magmom_ao, trace) - strace = strace+trace + strace = strace + trace END DO mmom(i) = strace END DO @@ -1649,10 +1649,10 @@ SUBROUTINE set_label(label, ix, iy, iz) DO i = 1, ix WRITE (label(i:), "(A1)") "X" END DO - DO i = ix+1, ix+iy + DO i = ix + 1, ix + iy WRITE (label(i:), "(A1)") "Y" END DO - DO i = ix+iy+1, ix+iy+iz + DO i = ix + iy + 1, ix + iy + iz WRITE (label(i:), "(A1)") "Z" END DO @@ -1730,12 +1730,12 @@ SUBROUTINE print_moments(unit_number, nmom, rmom, rlab, rcc, cell, periodic, mmo CASE DEFAULT WRITE (unit_number, "(T3,A,A,I2)") "Higher moment [Debye*Angstrom**(L-1)]", & " L=", l - i0 = (6+11*(l-1)+6*(l-1)**2+(l-1)**3)/6 - i1 = (6+11*l+6*l**2+l**3)/6-1 - dd = debye/(bohr)**(l-1) + i0 = (6 + 11*(l - 1) + 6*(l - 1)**2 + (l - 1)**3)/6 + i1 = (6 + 11*l + 6*l**2 + l**3)/6 - 1 + dd = debye/(bohr)**(l - 1) DO i = i0, i1, 3 WRITE (unit_number, "(T18,3(A,A,F14.8,4X))") & - (TRIM(rlab(j+1)), "=", rmom(j+1, 3)*dd, j=i, MIN(i1, i+2)) + (TRIM(rlab(j + 1)), "=", rmom(j + 1, 3)*dd, j=i, MIN(i1, i + 2)) END DO END SELECT END DO @@ -1744,7 +1744,7 @@ SUBROUTINE print_moments(unit_number, nmom, rmom, rlab, rcc, cell, periodic, mmo dd = SQRT(SUM(mmom(1:3)**2)) WRITE (unit_number, "(T3,A)") "Magnetic Dipole Moment (only orbital contrib.) [a.u.]" WRITE (unit_number, "(T5,3(A,A,F14.8,1X),T60,A,T67,F14.8)") & - (TRIM(rlab(i+1)), "=", mmom(i), i=1, 3), "Total=", dd + (TRIM(rlab(i + 1)), "=", mmom(i), i=1, 3), "Total=", dd END IF END IF END IF diff --git a/src/qs_neighbor_list_types.F b/src/qs_neighbor_list_types.F index 258178ee20..a7206179d7 100644 --- a/src/qs_neighbor_list_types.F +++ b/src/qs_neighbor_list_types.F @@ -173,9 +173,9 @@ SUBROUTINE neighbor_list_iterator_create(iterator_set, nl, search, nthread) mthread = 1 IF (PRESENT(nthread)) mthread = nthread - ALLOCATE (iterator_set(0:mthread-1)) + ALLOCATE (iterator_set(0:mthread - 1)) - DO il = 0, mthread-1 + DO il = 0, mthread - 1 ALLOCATE (iterator_set(il)%neighbor_list_iterator) iterator => iterator_set(il)%neighbor_list_iterator @@ -230,7 +230,7 @@ SUBROUTINE neighbor_list_iterator_create(iterator_set, nl, search, nthread) NULLIFY (list_search(il)%atom_list, list_search(il)%atom_index, list_search(il)%neighbor_list) END IF END DO - DO il = 0, mthread-1 + DO il = 0, mthread - 1 iterator => iterator_set(il)%neighbor_list_iterator iterator%list_search => list_search END DO @@ -268,7 +268,7 @@ SUBROUTINE neighbor_list_iterator_release(iterator_set) END IF mthread = SIZE(iterator_set) - DO il = 0, mthread-1 + DO il = 0, mthread - 1 DEALLOCATE (iterator_set(il)%neighbor_list_iterator) END DO DEALLOCATE (iterator_set) @@ -306,7 +306,7 @@ SUBROUTINE nl_set_sub_iterator(iterator_set, ikind, jkind, iatom, mepos) ! Set up my thread-local iterator for the list of iatom / jkind nodes iterator => iterator_set(me)%neighbor_list_iterator - ij = ikind+iterator%nkind*(jkind-1) + ij = ikind + iterator%nkind*(jkind - 1) IF (ASSOCIATED(iterator%list_search)) THEN list_search => iterator%list_search(ij) nlist = list_search%nlist @@ -384,14 +384,14 @@ FUNCTION neighbor_list_iterate(iterator_set, mepos) RESULT(istat) IF (iterator%inode < iterator%nnode) THEN ! we can be sure that there is another node in this list - iterator%inode = iterator%inode+1 + iterator%inode = iterator%inode + 1 iterator%neighbor_node => iterator%neighbor_node%next_neighbor_node ELSE - iab = MAX(iterator%ikind+iterator%nkind*(iterator%jkind-1), 0) + iab = MAX(iterator%ikind + iterator%nkind*(iterator%jkind - 1), 0) kindloop: DO ! look for the next list with nnode /= 0 listloop: DO IF (iterator%ilist >= iterator%nlist) EXIT listloop - iterator%ilist = iterator%ilist+1 + iterator%ilist = iterator%ilist + 1 IF (ASSOCIATED(iterator%neighbor_list)) THEN iterator%neighbor_list => iterator%neighbor_list%next_neighbor_list ELSE @@ -405,9 +405,9 @@ FUNCTION neighbor_list_iterate(iterator_set, mepos) RESULT(istat) istat = 1 EXIT kindloop ELSE - iab = iab+1 - iterator%jkind = (iab-1)/iterator%nkind+1 - iterator%ikind = iab-iterator%nkind*(iterator%jkind-1) + iab = iab + 1 + iterator%jkind = (iab - 1)/iterator%nkind + 1 + iterator%ikind = iab - iterator%nkind*(iterator%jkind - 1) iterator%ilist = 0 IF (.NOT. ASSOCIATED(nl(iab)%neighbor_list_set)) THEN iterator%ilist = 0 @@ -473,7 +473,7 @@ FUNCTION nl_sub_iterate(iterator_set, mepos) RESULT(istat) iterator%neighbor_node => first_node(iterator%neighbor_list) ELSEIF (iterator%inode > 0) THEN ! we can be sure that there is another node in this list - iterator%inode = iterator%inode+1 + iterator%inode = iterator%inode + 1 iterator%neighbor_node => iterator%neighbor_node%next_neighbor_node ELSE CPABORT("wrong") @@ -528,7 +528,7 @@ RECURSIVE FUNCTION nl_sub_iterate_ref(iter_sub, iter_ref, mepos) RESULT(iter_sta CALL nl_set_sub_iterator(iter_sub, kind_ref, 1, atom_ref) RETURN ELSE - kind_sub = kind_sub+1 + kind_sub = kind_sub + 1 CALL nl_set_sub_iterator(iter_sub, kind_ref, kind_sub, atom_ref) iter_stat = nl_sub_iterate_ref(iter_sub, iter_ref) ENDIF @@ -702,7 +702,7 @@ SUBROUTINE add_neighbor_list(neighbor_list_set, atom, neighbor_list) ! *** Increment the neighbor list counter *** - neighbor_list_set%nlist = neighbor_list_set%nlist+1 + neighbor_list_set%nlist = neighbor_list_set%nlist + 1 ! *** Return a pointer to the new neighbor list *** @@ -809,7 +809,7 @@ SUBROUTINE add_neighbor_node(neighbor_list, neighbor, cell, r, exclusion_list, n ! *** Increment the neighbor node counter *** - neighbor_list%nnode = neighbor_list%nnode+1 + neighbor_list%nnode = neighbor_list%nnode + 1 ELSE diff --git a/src/qs_neighbor_lists.F b/src/qs_neighbor_lists.F index 87104268f4..650c0df866 100644 --- a/src/qs_neighbor_lists.F +++ b/src/qs_neighbor_lists.F @@ -382,7 +382,7 @@ SUBROUTINE build_qs_neighbor_lists(qs_env, para_env, molecular, force_env_sectio ! This sets the id number of the qs neighbor lists, new lists, means new version ! new version implies new sparsity of the matrices - last_qs_neighbor_list_id_nr = last_qs_neighbor_list_id_nr+1 + last_qs_neighbor_list_id_nr = last_qs_neighbor_list_id_nr + 1 CALL set_ks_env(ks_env=ks_env, neighbor_list_id=last_qs_neighbor_list_id_nr) CALL get_ks_env(ks_env=ks_env, & @@ -650,7 +650,7 @@ SUBROUTINE build_qs_neighbor_lists(qs_env, para_env, molecular, force_env_sectio ELSE CALL pair_radius_setup(orb_present, orb_present, orb_radius, orb_radius, pair_radius) END IF - pair_radius = pair_radius+roperator + pair_radius = pair_radius + roperator ELSE CALL pair_radius_setup(orb_present, orb_present, orb_radius, orb_radius, pair_radius) END IF @@ -1138,7 +1138,7 @@ SUBROUTINE build_neighbor_lists(ab_list, particle_set, atom, cell, pair_radius, DO jkind = 1, nkind IF (.NOT. pres_b(jkind)) CYCLE - iab = ikind+nkind*(jkind-1) + iab = ikind + nkind*(jkind - 1) ! Calculate the square of the maximum interaction distance IF (pair_radius(ikind, jkind) <= 0._dp) CYCLE @@ -1169,7 +1169,7 @@ SUBROUTINE build_neighbor_lists(ab_list, particle_set, atom, cell, pair_radius, 0.5_dp*subcells*subcell_scale/sab_max_guard(:)))) ! number of image cells to be considered - ncell(:) = (INT(sab_max(:))+1)*periodic(:) + ncell(:) = (INT(sab_max(:)) + 1)*periodic(:) CALL allocate_neighbor_list_set(neighbor_list_set=ab_list(iab)%neighbor_list_set, & symmetric=my_symmetric) @@ -1189,12 +1189,12 @@ SUBROUTINE build_neighbor_lists(ab_list, particle_set, atom, cell, pair_radius, atom_a = atom(ikind)%list(iatom) r = r_pbc(:, atom_a) CALL give_ijk_subcell(r, i, j, k, cell, nsubcell) - subcell(i, j, k)%natom = subcell(i, j, k)%natom+1 + subcell(i, j, k)%natom = subcell(i, j, k)%natom + 1 END DO DO k = 1, nsubcell(3) DO j = 1, nsubcell(2) DO i = 1, nsubcell(1) - maxat = subcell(i, j, k)%natom+subcell(i, j, k)%natom/10 + maxat = subcell(i, j, k)%natom + subcell(i, j, k)%natom/10 ALLOCATE (subcell(i, j, k)%atom_list(maxat)) subcell(i, j, k)%natom = 0 END DO @@ -1205,7 +1205,7 @@ SUBROUTINE build_neighbor_lists(ab_list, particle_set, atom, cell, pair_radius, atom_a = atom(ikind)%list(iatom) r = r_pbc(:, atom_a) CALL give_ijk_subcell(r, i, j, k, cell, nsubcell) - subcell(i, j, k)%natom = subcell(i, j, k)%natom+1 + subcell(i, j, k)%natom = subcell(i, j, k)%natom + 1 subcell(i, j, k)%atom_list(subcell(i, j, k)%natom) = iatom_local END DO @@ -1225,9 +1225,9 @@ SUBROUTINE build_neighbor_lists(ab_list, particle_set, atom, cell, pair_radius, CALL real_to_scaled(sb_pbc(:), r(:), cell) loop2_kcell: DO kcell = -ncell(3), ncell(3) - sb(3) = sb_pbc(3)+REAL(kcell, dp) - sb_min(3) = sb(3)-sab_max(3) - sb_max(3) = sb(3)+sab_max(3) + sb(3) = sb_pbc(3) + REAL(kcell, dp) + sb_min(3) = sb(3) - sab_max(3) + sb_max(3) = sb(3) + sab_max(3) IF (periodic(3) /= 0) THEN IF (sb_min(3) >= 0.5_dp) EXIT loop2_kcell IF (sb_max(3) < -0.5_dp) CYCLE loop2_kcell @@ -1235,9 +1235,9 @@ SUBROUTINE build_neighbor_lists(ab_list, particle_set, atom, cell, pair_radius, cell_b(3) = kcell loop2_jcell: DO jcell = -ncell(2), ncell(2) - sb(2) = sb_pbc(2)+REAL(jcell, dp) - sb_min(2) = sb(2)-sab_max(2) - sb_max(2) = sb(2)+sab_max(2) + sb(2) = sb_pbc(2) + REAL(jcell, dp) + sb_min(2) = sb(2) - sab_max(2) + sb_max(2) = sb(2) + sab_max(2) IF (periodic(2) /= 0) THEN IF (sb_min(2) >= 0.5_dp) EXIT loop2_jcell IF (sb_max(2) < -0.5_dp) CYCLE loop2_jcell @@ -1245,9 +1245,9 @@ SUBROUTINE build_neighbor_lists(ab_list, particle_set, atom, cell, pair_radius, cell_b(2) = jcell loop2_icell: DO icell = -ncell(1), ncell(1) - sb(1) = sb_pbc(1)+REAL(icell, dp) - sb_min(1) = sb(1)-sab_max(1) - sb_max(1) = sb(1)+sab_max(1) + sb(1) = sb_pbc(1) + REAL(icell, dp) + sb_min(1) = sb(1) - sab_max(1) + sb_max(1) = sb(1) + sab_max(1) IF (periodic(1) /= 0) THEN IF (sb_min(1) >= 0.5_dp) EXIT loop2_icell IF (sb_max(1) < -0.5_dp) CYCLE loop2_icell @@ -1289,9 +1289,9 @@ SUBROUTINE build_neighbor_lists(ab_list, particle_set, atom, cell, pair_radius, END IF IF (my_symmetric) THEN IF (atom_a > atom_b) THEN - include_ab = (MODULO(atom_a+atom_b, 2) /= 0) + include_ab = (MODULO(atom_a + atom_b, 2) /= 0) ELSE - include_ab = (MODULO(atom_a+atom_b, 2) == 0) + include_ab = (MODULO(atom_a + atom_b, 2) == 0) END IF IF (my_sort_atomb) THEN IF ((.NOT. ANY(atomb_to_keep == atom_b)) .AND. & @@ -1304,15 +1304,15 @@ SUBROUTINE build_neighbor_lists(ab_list, particle_set, atom, cell, pair_radius, END IF IF (include_ab) THEN ra(:) = r_pbc(:, atom_a) - rab(:) = rb(:)-ra(:) - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab(:) = rb(:) - ra(:) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) IF (rab2 < rab2_max) THEN include_ab = .TRUE. IF (my_mic) THEN ! only if rab is minimum image the pair will be included ! ideally the range of the pair list is < L/2 so that this never triggers rab_pbc(:) = pbc(rab(:), cell) - IF (SUM((rab_pbc-rab)**2) > EPSILON(1.0_dp)) THEN + IF (SUM((rab_pbc - rab)**2) > EPSILON(1.0_dp)) THEN include_ab = .FALSE. ENDIF ENDIF @@ -1513,7 +1513,7 @@ SUBROUTINE combine_lists(list, n, ikind, atom) nb = 0 END IF - ALLOCATE (list(na+nb)) + ALLOCATE (list(na + nb)) n = na IF (na .GT. 0) list(1:na) = lista(1:na) @@ -1522,7 +1522,7 @@ SUBROUTINE combine_lists(list, n, ikind, atom) DO i = 1, na IF (listb(ib) == list(i)) CYCLE loopb END DO - n = n+1 + n = n + 1 list(n) = listb(ib) END DO loopb ENDIF @@ -1556,7 +1556,7 @@ SUBROUTINE pair_radius_setup(present_a, present_b, radius_a, radius_b, pair_radi IF (.NOT. present_a(i)) CYCLE DO j = 1, nkind IF (.NOT. present_b(j)) CYCLE - pair_radius(i, j) = radius_a(i)+radius_b(j) + pair_radius(i, j) = radius_a(i) + radius_b(j) END DO END DO @@ -1594,7 +1594,7 @@ SUBROUTINE write_neighbor_distribution(ab, qs_kind_set, output_unit, para_env) CALL timeset(routineN, handle) group = para_env%group - mype = para_env%mepos+1 + mype = para_env%mepos + 1 npe = para_env%num_pe ! Allocate work storage @@ -1616,8 +1616,8 @@ SUBROUTINE write_neighbor_distribution(ab, qs_kind_set, output_unit, para_env) CALL get_iterator_info(nl_iterator, ikind=ikind, jkind=jkind, inode=inode, nnode=nnode) IF (inode == 1) THEN n = nnsgf(ikind)*nnsgf(jkind) - nblock(mype) = nblock(mype)+nnode - nelement(mype) = nelement(mype)+n*nnode + nblock(mype) = nblock(mype) + nnode + nelement(mype) = nelement(mype) + n*nnode END IF END DO CALL neighbor_list_iterator_release(nl_iterator) @@ -1648,16 +1648,16 @@ SUBROUTINE write_neighbor_distribution(ab, qs_kind_set, output_unit, para_env) FMT="(/,/,T2,A,/,/,T3,A,/,/,(T4,I6,T27,I10,T55,I10))") & "DISTRIBUTION OF THE NEIGHBOR LISTS", & "Process Number of particle pairs Number of matrix elements", & - (ipe-1, nblock(ipe), nelement(ipe), ipe=1, npe) + (ipe - 1, nblock(ipe), nelement(ipe), ipe=1, npe) WRITE (UNIT=output_unit, FMT="(/,T7,A3,T27,I10,T55,I10)") & "Sum", SUM(nblock), SUM(nelement) ELSE WRITE (UNIT=output_unit, FMT="(/,T2,A)") "DISTRIBUTION OF THE NEIGHBOR LISTS" WRITE (UNIT=output_unit, FMT="(T15,A,T68,I13)") "Total number of particle pairs:", nblock_sum WRITE (UNIT=output_unit, FMT="(T15,A,T68,I13)") "Total number of matrix elements:", nelement_sum - WRITE (UNIT=output_unit, FMT="(T15,A,T68,I13)") "Average number of particle pairs:", (nblock_sum+npe-1)/npe + WRITE (UNIT=output_unit, FMT="(T15,A,T68,I13)") "Average number of particle pairs:", (nblock_sum + npe - 1)/npe WRITE (UNIT=output_unit, FMT="(T15,A,T68,I13)") "Maximum number of particle pairs:", nblock_max - WRITE (UNIT=output_unit, FMT="(T15,A,T68,I13)") "Average number of matrix element:", (nelement_sum+npe-1)/npe + WRITE (UNIT=output_unit, FMT="(T15,A,T68,I13)") "Average number of matrix element:", (nelement_sum + npe - 1)/npe WRITE (UNIT=output_unit, FMT="(T15,A,T68,I13)") "Maximum number of matrix elements:", nelement_max ENDIF END IF @@ -1738,10 +1738,10 @@ SUBROUTINE write_neighbor_lists(ab, particle_set, cell, para_env, neighbor_list_ DO WHILE (neighbor_list_iterate(nl_iterator) == 0) CALL get_iterator_info(nl_iterator, inode=inode, nnode=nnode, & iatom=iatom, jatom=jatom, cell=cell_b, r=rab) - nneighbor = nneighbor+1 + nneighbor = nneighbor + 1 ra(:) = pbc(particle_set(iatom)%r, cell) - rb(:) = ra(:)+rab(:) - dab = SQRT(rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3)) + rb(:) = ra(:) + rab(:) + dab = SQRT(rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3)) IF (iw > 0) THEN IF (inode == 1) THEN WRITE (UNIT=iw, FMT="(/,T2,I5,3X,I6,3X,3F12.6)") & diff --git a/src/qs_nl_hash_table_types.F b/src/qs_nl_hash_table_types.F index 540f844cae..e5285c2dfe 100644 --- a/src/qs_nl_hash_table_types.F +++ b/src/qs_nl_hash_table_types.F @@ -127,7 +127,7 @@ RECURSIVE SUBROUTINE nl_hash_table_add(hash_table, key, val) ! add a new task to the list of tasks with that key IF (hash_table%obj%table(islot)%key == EMPTY_KEY) THEN - hash_table%obj%nelements = hash_table%obj%nelements+1 + hash_table%obj%nelements = hash_table%obj%nelements + 1 hash_table%obj%table(islot)%key = key END IF @@ -168,7 +168,7 @@ SUBROUTINE nl_hash_table_create(hash_table, nmax) ! book keeping stuff hash_table%obj%ref_count = 1 - hash_table%obj%id_nr = last_nl_hash_table_id+1 + hash_table%obj%id_nr = last_nl_hash_table_id + 1 last_nl_hash_table_id = hash_table%obj%id_nr END SUBROUTINE nl_hash_table_create @@ -341,7 +341,7 @@ SUBROUTINE nl_hash_table_release(hash_table) IF (ASSOCIATED(hash_table%obj)) THEN check_ok = hash_table%obj%ref_count > 0 CPASSERT(check_ok) - hash_table%obj%ref_count = hash_table%obj%ref_count-1 + hash_table%obj%ref_count = hash_table%obj%ref_count - 1 IF (hash_table%obj%ref_count == 0) THEN hash_table%obj%ref_count = 1 IF (ASSOCIATED(hash_table%obj%table)) THEN @@ -403,7 +403,7 @@ PURE FUNCTION nl_hash_table_linear_probe(hash_table, key) RESULT(islot) END DO ! if unsuccessful, search from 1 to guess - DO islot = 1, guess-1 + DO islot = 1, guess - 1 IF ((hash_table%obj%table(islot)%key == key) .OR. & (hash_table%obj%table(islot)%key == EMPTY_KEY)) RETURN END DO @@ -429,7 +429,7 @@ PURE FUNCTION nl_hash_table_hash_function(hash_table, key) RESULT(hash) prime_8 = INT(hash_table%obj%prime, int_8) ! IAND with nmax-1 is equivalent to MOD nmax if nmax is alway a power of 2. - hash_8 = IAND(key*prime_8, nmax_8-1)+1_int_8 + hash_8 = IAND(key*prime_8, nmax_8 - 1) + 1_int_8 hash = INT(hash_8) END FUNCTION nl_hash_table_hash_function diff --git a/src/qs_o3c_methods.F b/src/qs_o3c_methods.F index 2de6731be1..fb099c87fc 100644 --- a/src/qs_o3c_methods.F +++ b/src/qs_o3c_methods.F @@ -187,17 +187,17 @@ SUBROUTINE calculate_o3c_integrals(o3c, calculate_forces, matrix_p) ALLOCATE (tvec(nk, nspin)) tvec(:, :) = 0.0_dp - rjk(1:3) = rik(1:3)-rij(1:3) + rjk(1:3) = rik(1:3) - rij(1:3) dij = NORM2(rij) dik = NORM2(rik) djk = NORM2(rjk) DO iset = 1, nseta DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dij) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dij) CYCLE DO kset = 1, nsetc - IF (set_radius_a(iset)+set_radius_c(kset) < dik) CYCLE - IF (set_radius_b(jset)+set_radius_c(kset) < djk) CYCLE + IF (set_radius_a(iset) + set_radius_c(kset) < dik) CYCLE + IF (set_radius_b(jset) + set_radius_c(kset) < djk) CYCLE ncoa = npgfa(iset)*ncoset(la_max(iset)) ncob = npgfb(jset)*ncoset(lb_max(jset)) @@ -207,9 +207,9 @@ SUBROUTINE calculate_o3c_integrals(o3c, calculate_forces, matrix_p) sgfb = first_sgfb(1, jset) sgfc = first_sgfc(1, kset) - egfa = sgfa+nsgfa(iset)-1 - egfb = sgfb+nsgfb(jset)-1 - egfc = sgfc+nsgfc(kset)-1 + egfa = sgfa + nsgfa(iset) - 1 + egfb = sgfb + nsgfb(jset) - 1 + egfc = sgfc + nsgfc(kset) - 1 IF (ncoa*ncob*ncoc > 0) THEN ALLOCATE (sabc(ncoa, ncob, ncoc)) @@ -262,7 +262,7 @@ SUBROUTINE calculate_o3c_integrals(o3c, calculate_forces, matrix_p) END DO IF (do_force) THEN ! translational invariance - iadbc(:, :, :, :) = -idabc(:, :, :, :)-iabdc(:, :, :, :) + iadbc(:, :, :, :) = -idabc(:, :, :, :) - iabdc(:, :, :, :) ! ! get the atom indices CALL get_o3c_iterator_info(o3c_iterator, mepos=mepos, & @@ -290,9 +290,9 @@ SUBROUTINE calculate_o3c_integrals(o3c, calculate_forces, matrix_p) row=irow, col=icol, BLOCK=pblock, found=found) IF (found) THEN IF (trans) THEN - pmat(:, :) = pmat(:, :)+TRANSPOSE(pblock(:, :)) + pmat(:, :) = pmat(:, :) + TRANSPOSE(pblock(:, :)) ELSE - pmat(:, :) = pmat(:, :)+pblock(:, :) + pmat(:, :) = pmat(:, :) + pblock(:, :) END IF END IF END DO @@ -402,7 +402,7 @@ SUBROUTINE calculate_o3c_libint_integrals(o3c, op, t_c_filename, para_env, r_cut maxlk = MAX(maxlk, imax) max_nset = MAX(max_nset, iset) END DO - m_max = maxli+maxlj+maxlk + m_max = maxli + maxlj + maxlk !Screening do_screen = .FALSE. @@ -482,7 +482,7 @@ SUBROUTINE calculate_o3c_libint_integrals(o3c, op, t_c_filename, para_env, r_cut ncoa = basis_set%npgf(iset)*ncoset(basis_set%lmax(iset)) sgfa = basis_set%first_sgf(1, iset) - egfa = sgfa+basis_set%nsgf_set(iset)-1 + egfa = sgfa + basis_set%nsgf_set(iset) - 1 max_contr(iset, ibasis) = & MAXVAL((/(SUM(ABS(basis_set%sphi(1:ncoa, i))), i=sgfa, egfa)/)) @@ -502,7 +502,7 @@ SUBROUTINE calculate_o3c_libint_integrals(o3c, op, t_c_filename, para_env, r_cut CALL get_o3c_iterator_info(o3c_iterator, mepos=mepos, ikind=ikind, jkind=jkind, & kkind=kkind, rij=rij, rik=rik, integral=iabc, tvec=tvec) - rjk = rik-rij + rjk = rik - rij !basis basis_set_a => basis_set_list_a(ikind)%gto_basis_set @@ -561,17 +561,17 @@ SUBROUTINE calculate_o3c_libint_integrals(o3c, op, t_c_filename, para_env, r_cut DO iset = 1, nseta ncoa = npgfa(iset)*ncoset(la_max(iset)) sgfa = first_sgfa(1, iset) - egfa = sgfa+nsgfa(iset)-1 + egfa = sgfa + nsgfa(iset) - 1 DO jset = 1, nsetb ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) - egfb = sgfb+nsgfb(jset)-1 + egfb = sgfb + nsgfb(jset) - 1 DO kset = 1, nsetc ncoc = npgfc(kset)*ncoset(lc_max(kset)) sgfc = first_sgfc(1, kset) - egfc = sgfc+nsgfc(kset)-1 + egfc = sgfc + nsgfc(kset) - 1 ALLOCATE (sabc(ncoa, ncob, ncoc)) sabc = 0.0_dp diff --git a/src/qs_o3c_types.F b/src/qs_o3c_types.F index 95f1e9784b..410ccddc15 100644 --- a/src/qs_o3c_types.F +++ b/src/qs_o3c_types.F @@ -153,7 +153,7 @@ SUBROUTINE init_o3c_container(o3c, nspin, basis_set_list_a, basis_set_list_b, ba nij = 0 CALL neighbor_list_iterator_create(nl_iterator, sab_nl) DO WHILE (neighbor_list_iterate(nl_iterator) == 0) - nij = nij+1 + nij = nij + 1 END DO CALL neighbor_list_iterator_release(nl_iterator) o3c%nijpairs = nij @@ -165,7 +165,7 @@ SUBROUTINE init_o3c_container(o3c, nspin, basis_set_list_a, basis_set_list_b, ba CALL neighbor_list_iterator_create(nl_iterator, sab_nl) CALL neighbor_list_iterator_create(ac_iterator, sac_nl, search=.TRUE.) DO WHILE (neighbor_list_iterate(nl_iterator) == 0) - nij = nij+1 + nij = nij + 1 ijpair => o3c%ijpair(nij) CALL get_iterator_info(nl_iterator, ikind=ijpair%ikind, jkind=ijpair%jkind, & iatom=ijpair%iatom, jatom=ijpair%jatom, & @@ -178,10 +178,10 @@ SUBROUTINE init_o3c_container(o3c, nspin, basis_set_list_a, basis_set_list_b, ba IF (my_sort_bc) THEN !we only take ijk if rjk = 0 OR rik = 0 (because of symmetry) CALL get_iterator_info(ac_iterator, r=rik) - rjk(:) = rik(:)-ijpair%rij(:) + rjk(:) = rik(:) - ijpair%rij(:) IF (.NOT. (ALL(ABS(rjk) .LE. 1.0E-4_dp) .OR. ALL(ABS(rik) .LE. 1.0E-4_dp))) CYCLE END IF - nk = nk+1 + nk = nk + 1 END DO END DO ! ijk lists @@ -195,11 +195,11 @@ SUBROUTINE init_o3c_container(o3c, nspin, basis_set_list_a, basis_set_list_b, ba IF (my_sort_bc) THEN !we only take ijk if rjk = 0 OR rik = 0 (because of symmetry) CALL get_iterator_info(ac_iterator, r=rik) - rjk(:) = rik(:)-ijpair%rij(:) + rjk(:) = rik(:) - ijpair%rij(:) IF (.NOT. (ALL(ABS(rjk) .LE. 1.0E-4_dp) .OR. ALL(ABS(rik) .LE. 1.0E-4_dp))) CYCLE END IF - nk = nk+1 + nk = nk + 1 ijk => ijpair%ijk(nk) CALL get_iterator_info(ac_iterator, jatom=ijk%katom, r=ijk%rik, cell=ijk%cellk) ijk%kkind = kkind @@ -383,8 +383,8 @@ SUBROUTINE o3c_iterator_create(o3c, o3c_iterator, nthread) o3c_iterator%o3c => o3c o3c_iterator%ijp_last = 0 o3c_iterator%k_last = 0 - ALLOCATE (o3c_iterator%ijp_thread(0:n-1)) - ALLOCATE (o3c_iterator%k_thread(0:n-1)) + ALLOCATE (o3c_iterator%ijp_thread(0:n - 1)) + ALLOCATE (o3c_iterator%k_thread(0:n - 1)) o3c_iterator%ijp_thread = 0 o3c_iterator%k_thread = 0 @@ -534,7 +534,7 @@ FUNCTION o3c_iterate(o3c_iterator, mepos) RESULT(istat) ELSE IF (klist == o3c%ijpair(ijpair)%nklist) THEN ! last step in this ij list istat = 1 - DO ij = ijpair+1, o3c%nijpairs + DO ij = ijpair + 1, o3c%nijpairs IF (o3c%ijpair(ij)%nklist > 0) THEN o3c_iterator%ijp_thread(me) = ij o3c_iterator%k_thread(me) = 1 @@ -545,7 +545,7 @@ FUNCTION o3c_iterate(o3c_iterator, mepos) RESULT(istat) ELSE ! increase klist o3c_iterator%ijp_thread(me) = ijpair - o3c_iterator%k_thread(me) = klist+1 + o3c_iterator%k_thread(me) = klist + 1 istat = 0 END IF diff --git a/src/qs_oce_methods.F b/src/qs_oce_methods.F index 8b7248de17..5a63b7efe9 100644 --- a/src/qs_oce_methods.F +++ b/src/qs_oce_methods.F @@ -143,11 +143,11 @@ SUBROUTINE build_oce_block(oces, atom_ka, atom_kb, rab, nder, sgf_list, nsgf_cnt ENDIF lm = MAX(maxlb, maxlprj) - lds = ncoset(lm+nder+1) + lds = ncoset(lm + nder + 1) msab = MAX(maxnprja*ncoset(maxlprj), maxcob) ALLOCATE (c2s(lds, lds)) - ALLOCATE (s(lds, lds, ncoset(nder+1))) + ALLOCATE (s(lds, lds, ncoset(nder + 1))) ALLOCATE (spa_sb(np_car, ntotsgfb)) ALLOCATE (spa_tmp(msab, msab*maxder)) ALLOCATE (ovs(np_sph, maxcob*nsetb*maxder)) @@ -159,17 +159,17 @@ SUBROUTINE build_oce_block(oces, atom_ka, atom_kb, rab, nder, sgf_list, nsgf_cnt DO jset = 1, nsetb ! ! Set the contribution list - IF (hard_radius_a+set_radius_b(jset) >= dab) THEN + IF (hard_radius_a + set_radius_b(jset) >= dab) THEN isgfb = first_sgfb(1, jset) - lsgfb = isgfb-1+nsgfb(jset) + lsgfb = isgfb - 1 + nsgfb(jset) DO jc = isgfb, lsgfb - nsgf_cnt = nsgf_cnt+1 + nsgf_cnt = nsgf_cnt + 1 sgf_list(nsgf_cnt) = jc ENDDO ! check if this function is hard radius = exp_radius(lb_max(jset), MAXVAL(zetb(1:npgfb(jset), jset)), eps_fit, 1.0_dp) - IF (radius .LE. hard_radius_b) sgf_hard_only = sgf_hard_only+1 + IF (radius .LE. hard_radius_b) sgf_hard_only = sgf_hard_only + 1 ! ***integral between proj of iatom and primitives of jatom ! *** Calculate the primitives overlap *** @@ -178,9 +178,9 @@ SUBROUTINE build_oce_block(oces, atom_ka, atom_kb, rab, nder, sgf_list, nsgf_cnt s = 0.0_dp ncob = npgfb(jset)*ncoset(lb_max(jset)) isgfb = first_sgfb(1, jset) - lsgfb = isgfb-1+nsgfb(jset) + lsgfb = isgfb - 1 + nsgfb(jset) - lsgfb_cnt = isgfb_cnt-1+nsgfb(jset) + lsgfb_cnt = isgfb_cnt - 1 + nsgfb(jset) DO lprj = 0, maxlprj CALL overlap(lprj, lprj, nprjla(lprj), & @@ -191,24 +191,24 @@ SUBROUTINE build_oce_block(oces, atom_ka, atom_kb, rab, nder, sgf_list, nsgf_cnt nder, .TRUE., s, lds) DO iso = 1, nso(lprj) DO ico = 1, nco(lprj) - lx = indco(1, ico+ncoset(lprj-1)) - ly = indco(2, ico+ncoset(lprj-1)) - lz = indco(3, ico+ncoset(lprj-1)) - c2s(iso, ico) = orbtramat(lprj)%c2s(iso, ico)/SQRT((4.0_dp*pi)/dfac(2*lprj+1)* & - dfac(2*lx-1)*dfac(2*ly-1)*dfac(2*lz-1)) + lx = indco(1, ico + ncoset(lprj - 1)) + ly = indco(2, ico + ncoset(lprj - 1)) + lz = indco(3, ico + ncoset(lprj - 1)) + c2s(iso, ico) = orbtramat(lprj)%c2s(iso, ico)/SQRT((4.0_dp*pi)/dfac(2*lprj + 1)* & + dfac(2*lx - 1)*dfac(2*ly - 1)*dfac(2*lz - 1)) ENDDO ENDDO DO ider = 1, maxder - is = (ider-1)*SIZE(spa_tmp, 1) - isp = (ider-1)*maxcob*nsetb + is = (ider - 1)*SIZE(spa_tmp, 1) + isp = (ider - 1)*maxcob*nsetb DO ipgf = 1, nprjla(lprj) - lpoint = ncoset(lprj-1)+1+(ipgf-1)*ncoset(lprj) - m = fp_spha(lprj)+(ipgf-1)*nso(lprj) + lpoint = ncoset(lprj - 1) + 1 + (ipgf - 1)*ncoset(lprj) + m = fp_spha(lprj) + (ipgf - 1)*nso(lprj) DO ip = 1, npgfb(jset) - ic = (ip-1)*ncoset(lb_max(jset)) - igau = isp+ic+m1+ncoset(lb_min(jset)-1)+1 - ig1 = is+ic+ncoset(lb_min(jset)-1)+1 - n = ncoset(lb_max(jset))-ncoset(lb_min(jset)-1) + ic = (ip - 1)*ncoset(lb_max(jset)) + igau = isp + ic + m1 + ncoset(lb_min(jset) - 1) + 1 + ig1 = is + ic + ncoset(lb_min(jset) - 1) + 1 + n = ncoset(lb_max(jset)) - ncoset(lb_min(jset) - 1) CALL DGEMM("N", "N", nso(lprj), n, nco(lprj), 1._dp, c2s, lds, spa_tmp(lpoint, ig1), msab, & 0._dp, ovs(m, igau), np_sph) ENDDO @@ -221,11 +221,11 @@ SUBROUTINE build_oce_block(oces, atom_ka, atom_kb, rab, nder, sgf_list, nsgf_cnt DO ipgf = 1, npgfb(jset) DO lshell = lb_min(jset), lb_max(jset) IF (zetb(ipgf, jset) >= zisominb(lshell)) THEN - igau = n*(ipgf-1)+ncoset(lshell-1) + igau = n*(ipgf - 1) + ncoset(lshell - 1) DO ider = 1, maxder - is = maxcob*(ider-1) - isp = (ider-1)*maxcob*nsetb - ovs(:, igau+1+isp+m1:igau+nco(lshell)+isp+m1) = 0.0_dp + is = maxcob*(ider - 1) + isp = (ider - 1)*maxcob*nsetb + ovs(:, igau + 1 + isp + m1:igau + nco(lshell) + isp + m1) = 0.0_dp ENDDO ENDIF ENDDO @@ -234,7 +234,7 @@ SUBROUTINE build_oce_block(oces, atom_ka, atom_kb, rab, nder, sgf_list, nsgf_cnt ! *** Contraction step (integrals and derivatives) DO ider = 1, maxder - first_col = (ider-1)*maxcob*nsetb+1+m1 + first_col = (ider - 1)*maxcob*nsetb + 1 + m1 CALL dgemm("N", "N", np_sph, nsgfb(jset), ncob, & 1.0_dp, ovs(1, first_col), SIZE(ovs, 1), & sphi_b(1, isgfb), SIZE(sphi_b, 1), & @@ -245,9 +245,9 @@ SUBROUTINE build_oce_block(oces, atom_ka, atom_kb, rab, nder, sgf_list, nsgf_cnt spa_sb(1, isgfb), SIZE(spa_sb, 1), & 1.0_dp, oces(ider)%block(1, isgfb_cnt), SIZE(oces(ider)%block, 1)) ENDDO - isgfb_cnt = isgfb_cnt+nsgfb(jset) + isgfb_cnt = isgfb_cnt + nsgfb(jset) END IF ! radius - m1 = m1+maxcob + m1 = m1 + maxcob ENDDO !jset ! check if the screened functions are all soft @@ -310,15 +310,15 @@ SUBROUTINE build_oce_block_local(oceh, oces, atom_ka, sgf_list, nsgf_cnt) nsgf_cnt = 0 DO iset = 1, nseta isgfa = first_sgfa(1, iset) - lsgfa = isgfa-1+nsgf_seta(iset) + lsgfa = isgfa - 1 + nsgf_seta(iset) DO jc = isgfa, lsgfa - nsgf_cnt = nsgf_cnt+1 + nsgf_cnt = nsgf_cnt + 1 sgf_list(nsgf_cnt) = jc ENDDO - n = maxsoa*(iset-1) + n = maxsoa*(iset - 1) - prjloc_h(n+1:n+maxsoa, isgfa:lsgfa) = local_oce_h(1:maxsoa, isgfa:lsgfa) - prjloc_s(n+1:n+maxsoa, isgfa:lsgfa) = local_oce_s(1:maxsoa, isgfa:lsgfa) + prjloc_h(n + 1:n + maxsoa, isgfa:lsgfa) = local_oce_h(1:maxsoa, isgfa:lsgfa) + prjloc_s(n + 1:n + maxsoa, isgfa:lsgfa) = local_oce_s(1:maxsoa, isgfa:lsgfa) ENDDO DO i = 1, nsgfa @@ -406,13 +406,13 @@ SUBROUTINE build_oce_matrices(intac, calculate_forces, nder, & maxsgf=maxsgf) maxl = MAX(maxlgto, maxlprj) - CALL init_orbital_pointers(maxl+nder+1) + CALL init_orbital_pointers(maxl + nder + 1) ldsab = MAX(maxco, ncoset(maxlprj), maxsgf, maxprj) - ldai = ncoset(maxl+nder+1) + ldai = ncoset(maxl + nder + 1) ALLOCATE (sab(ldsab, ldsab*maxder), work(ldsab, ldsab*maxder)) sab = 0.0_dp - ALLOCATE (ai_work(ldai, ldai, ncoset(nder+1))) + ALLOCATE (ai_work(ldai, ldai, ncoset(nder + 1))) ai_work = 0.0_dp ALLOCATE (oceh(maxder), oces(maxder)) @@ -428,7 +428,7 @@ SUBROUTINE build_oce_matrices(intac, calculate_forces, nder, & CALL get_iterator_info(nl_iterator, ikind=ikind, jkind=jkind, iatom=atom_a, jatom=atom_b, & nlist=nlist, ilist=ilist, nnode=nneighbor, inode=jneighbor, cell=cell_b, r=rab) - iac = ikind+nkind*(jkind-1) + iac = ikind + nkind*(jkind - 1) dab = SQRT(SUM(rab*rab)) qs_kind => qs_kind_set(ikind) @@ -700,7 +700,7 @@ SUBROUTINE prj_scatter(ain, aout, atom) ip = n2oindex(i) DO j = 1, nbas jp = n2oindex(j) - aout(jp, ip) = aout(jp, ip)+ain(j, i) + aout(jp, ip) = aout(jp, ip) + ain(j, i) END DO END DO diff --git a/src/qs_operators_ao.F b/src/qs_operators_ao.F index 10423c447a..54919faed1 100644 --- a/src/qs_operators_ao.F +++ b/src/qs_operators_ao.F @@ -126,7 +126,7 @@ SUBROUTINE build_lin_mom_matrix(qs_env, matrix) maxlgto=maxlgto, & maxsgf=maxsgf) - ldai = ncoset(maxlgto+1) + ldai = ncoset(maxlgto + 1) CALL init_orbital_pointers(ldai) ALLOCATE (rr_work(ldai, ldai, 3), intab(maxco, maxco, 3), work(maxco, maxsgf), integral(3)) @@ -200,7 +200,7 @@ SUBROUTINE build_lin_mom_matrix(qs_env, matrix) ENDDO END IF - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) dab = SQRT(rab2) DO iset = 1, nseta @@ -210,7 +210,7 @@ SUBROUTINE build_lin_mom_matrix(qs_env, matrix) DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) @@ -322,7 +322,7 @@ SUBROUTINE lin_mom(la_max, la_min, npgfa, rpgfa, zeta, lb_max, lb_min, npgfb, rp ! *** Calculate the distance of the centers a and c *** - rab2 = rab(1)**2+rab(2)**2+rab(3)**2 + rab2 = rab(1)**2 + rab(2)**2 + rab(3)**2 dab = SQRT(rab2) ! *** Loop over all pairs of primitive Gaussian-type functions *** @@ -337,20 +337,20 @@ SUBROUTINE lin_mom(la_max, la_min, npgfa, rpgfa, zeta, lb_max, lb_min, npgfb, rp ! *** Screening *** - IF (rpgfa(ipgf)+rpgfb(jpgf) < dab) THEN - DO j = nb+1, nb+ncoset(lb_max) - DO i = na+1, na+ncoset(la_max) + IF (rpgfa(ipgf) + rpgfb(jpgf) < dab) THEN + DO j = nb + 1, nb + ncoset(lb_max) + DO i = na + 1, na + ncoset(la_max) intab(i, j, 1) = 0.0_dp intab(i, j, 2) = 0.0_dp intab(i, j, 3) = 0.0_dp ENDDO ENDDO - nb = nb+ncoset(lb_max) + nb = nb + ncoset(lb_max) CYCLE ENDIF ! *** Calculate some prefactors *** - zet = zeta(ipgf)+zetb(jpgf) + zet = zeta(ipgf) + zetb(jpgf) xhi = zeta(ipgf)*zetb(jpgf)/zet rap = zetb(jpgf)*rab/zet rbp = -zeta(ipgf)*rab/zet @@ -359,36 +359,36 @@ SUBROUTINE lin_mom(la_max, la_min, npgfa, rpgfa, zeta, lb_max, lb_min, npgfb, rp ! *** Calculate the recurrence relation *** - CALL os_rr_ovlp(rap, la_max+1, rbp, lb_max, zet, ldrr, rr) + CALL os_rr_ovlp(rap, la_max + 1, rbp, lb_max, zet, ldrr, rr) ! *** Calculate the primitive linear momentum integrals *** DO lb = lb_min, lb_max DO bx = 0, lb - DO by = 0, lb-bx - bz = lb-bx-by + DO by = 0, lb - bx + bz = lb - bx - by cob = coset(bx, by, bz) - mb = nb+cob + mb = nb + cob DO la = la_min, la_max DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay coa = coset(ax, ay, az) - ma = na+coa + ma = na + coa ! ! ! (a|p_x|b) = 2*a*(a+1x|b) - N_x(a)*(a-1_x|b) - dumx = 2.0_dp*zeta(ipgf)*rr(ax+1, bx, 1) - IF (ax .GT. 0) dumx = dumx-REAL(ax, dp)*rr(ax-1, bx, 1) + dumx = 2.0_dp*zeta(ipgf)*rr(ax + 1, bx, 1) + IF (ax .GT. 0) dumx = dumx - REAL(ax, dp)*rr(ax - 1, bx, 1) intab(ma, mb, 1) = f0*dumx*rr(ay, by, 2)*rr(az, bz, 3) ! ! (a|p_y|b) - dumy = 2.0_dp*zeta(ipgf)*rr(ay+1, by, 2) - IF (ay .GT. 0) dumy = dumy-REAL(ay, dp)*rr(ay-1, by, 2) + dumy = 2.0_dp*zeta(ipgf)*rr(ay + 1, by, 2) + IF (ay .GT. 0) dumy = dumy - REAL(ay, dp)*rr(ay - 1, by, 2) intab(ma, mb, 2) = f0*rr(ax, bx, 1)*dumy*rr(az, bz, 3) ! ! (a|p_z|b) - dumz = 2.0_dp*zeta(ipgf)*rr(az+1, bz, 3) - IF (az .GT. 0) dumz = dumz-REAL(az, dp)*rr(az-1, bz, 3) + dumz = 2.0_dp*zeta(ipgf)*rr(az + 1, bz, 3) + IF (az .GT. 0) dumz = dumz - REAL(az, dp)*rr(az - 1, bz, 3) intab(ma, mb, 3) = f0*rr(ax, bx, 1)*rr(ay, by, 2)*dumz ! ENDDO @@ -399,11 +399,11 @@ SUBROUTINE lin_mom(la_max, la_min, npgfa, rpgfa, zeta, lb_max, lb_min, npgfb, rp ENDDO ENDDO !lb - nb = nb+ncoset(lb_max) + nb = nb + ncoset(lb_max) ENDDO - na = na+ncoset(la_max) + na = na + ncoset(la_max) ENDDO @@ -481,7 +481,7 @@ SUBROUTINE build_ang_mom_matrix(qs_env, matrix, rc) maxlgto=maxlgto, & maxsgf=maxsgf) - ldai = ncoset(maxlgto+1) + ldai = ncoset(maxlgto + 1) CALL init_orbital_pointers(ldai) ALLOCATE (rr_work(ldai, ldai, 3), intab(maxco, maxco, 3), work(maxco, maxsgf), integral(3)) @@ -557,7 +557,7 @@ SUBROUTINE build_ang_mom_matrix(qs_env, matrix, rc) ENDDO END IF - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) dab = SQRT(rab2) DO iset = 1, nseta @@ -567,12 +567,12 @@ SUBROUTINE build_ang_mom_matrix(qs_env, matrix, rc) DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE !IF(PRESENT(wancen)) THEN ! rc = wancen rac = pbc(rc, ra, cell) - rbc = rac+rab + rbc = rac + rab !ELSE ! rc(1:3) = rb(1:3) ! rac(1:3) = -rab(1:3) @@ -690,7 +690,7 @@ SUBROUTINE ang_mom(la_max, la_min, npgfa, rpgfa, zeta, lb_max, lb_min, npgfb, rp ! *** Calculate the distance of the centers a and c *** - rab2 = rab(1)**2+rab(2)**2+rab(3)**2 + rab2 = rab(1)**2 + rab(2)**2 + rab(3)**2 dab = SQRT(rab2) ! *** Loop over all pairs of primitive Gaussian-type functions *** @@ -705,20 +705,20 @@ SUBROUTINE ang_mom(la_max, la_min, npgfa, rpgfa, zeta, lb_max, lb_min, npgfb, rp ! *** Screening *** - IF (rpgfa(ipgf)+rpgfb(jpgf) < dab) THEN - DO j = nb+1, nb+ncoset(lb_max) - DO i = na+1, na+ncoset(la_max) + IF (rpgfa(ipgf) + rpgfb(jpgf) < dab) THEN + DO j = nb + 1, nb + ncoset(lb_max) + DO i = na + 1, na + ncoset(la_max) intab(i, j, 1) = 0.0_dp intab(i, j, 2) = 0.0_dp intab(i, j, 3) = 0.0_dp ENDDO ENDDO - nb = nb+ncoset(lb_max) + nb = nb + ncoset(lb_max) CYCLE ENDIF ! *** Calculate some prefactors *** - zet = zeta(ipgf)+zetb(jpgf) + zet = zeta(ipgf) + zetb(jpgf) xhi = zeta(ipgf)*zetb(jpgf)/zet rap = zetb(jpgf)*rab/zet rbp = -zeta(ipgf)*rab/zet @@ -727,44 +727,44 @@ SUBROUTINE ang_mom(la_max, la_min, npgfa, rpgfa, zeta, lb_max, lb_min, npgfb, rp ! *** Calculate the recurrence relation *** - CALL os_rr_ovlp(rap, la_max+1, rbp, lb_max, zet, ldrr, rr) + CALL os_rr_ovlp(rap, la_max + 1, rbp, lb_max, zet, ldrr, rr) ! *** Calculate the primitive Fermi contact integrals *** DO lb = lb_min, lb_max DO bx = 0, lb - DO by = 0, lb-bx - bz = lb-bx-by + DO by = 0, lb - bx + bz = lb - bx - by cob = coset(bx, by, bz) - mb = nb+cob + mb = nb + cob DO la = la_min, la_max DO ax = 0, la - DO ay = 0, la-ax - az = la-ax-ay + DO ay = 0, la - ax + az = la - ax - ay coa = coset(ax, ay, az) - ma = na+coa + ma = na + coa ! - dumx = -2.0_dp*zeta(ipgf)*rr(ax+1, bx, 1) - dumy = -2.0_dp*zeta(ipgf)*rr(ay+1, by, 2) - dumz = -2.0_dp*zeta(ipgf)*rr(az+1, bz, 3) - IF (ax .GT. 0) dumx = dumx+REAL(ax, dp)*rr(ax-1, bx, 1) - IF (ay .GT. 0) dumy = dumy+REAL(ay, dp)*rr(ay-1, by, 2) - IF (az .GT. 0) dumz = dumz+REAL(az, dp)*rr(az-1, bz, 3) + dumx = -2.0_dp*zeta(ipgf)*rr(ax + 1, bx, 1) + dumy = -2.0_dp*zeta(ipgf)*rr(ay + 1, by, 2) + dumz = -2.0_dp*zeta(ipgf)*rr(az + 1, bz, 3) + IF (ax .GT. 0) dumx = dumx + REAL(ax, dp)*rr(ax - 1, bx, 1) + IF (ay .GT. 0) dumy = dumy + REAL(ay, dp)*rr(ay - 1, by, 2) + IF (az .GT. 0) dumz = dumz + REAL(az, dp)*rr(az - 1, bz, 3) ! ! (a|l_z|b) intab(ma, mb, 1) = -f0*rr(ax, bx, 1)*( & - & (rr(ay+1, by, 2)+rac(2)*rr(ay, by, 2))*dumz & - & -(rr(az+1, bz, 3)+rac(3)*rr(az, bz, 3))*dumy) + & (rr(ay + 1, by, 2) + rac(2)*rr(ay, by, 2))*dumz & + & - (rr(az + 1, bz, 3) + rac(3)*rr(az, bz, 3))*dumy) ! ! (a|l_y|b) intab(ma, mb, 2) = -f0*rr(ay, by, 2)*( & - & (rr(az+1, bz, 3)+rac(3)*rr(az, bz, 3))*dumx & - & -(rr(ax+1, bx, 1)+rac(1)*rr(ax, bx, 1))*dumz) + & (rr(az + 1, bz, 3) + rac(3)*rr(az, bz, 3))*dumx & + & - (rr(ax + 1, bx, 1) + rac(1)*rr(ax, bx, 1))*dumz) ! ! (a|l_z|b) intab(ma, mb, 3) = -f0*rr(az, bz, 3)*( & - & (rr(ax+1, bx, 1)+rac(1)*rr(ax, bx, 1))*dumy & - & -(rr(ay+1, by, 2)+rac(2)*rr(ay, by, 2))*dumx) + & (rr(ax + 1, bx, 1) + rac(1)*rr(ax, bx, 1))*dumy & + & - (rr(ay + 1, by, 2) + rac(2)*rr(ay, by, 2))*dumx) ! ENDDO ENDDO @@ -774,11 +774,11 @@ SUBROUTINE ang_mom(la_max, la_min, npgfa, rpgfa, zeta, lb_max, lb_min, npgfb, rp ENDDO ENDDO !lb - nb = nb+ncoset(lb_max) + nb = nb + ncoset(lb_max) ENDDO - na = na+ncoset(la_max) + na = na + ncoset(la_max) ENDDO @@ -948,7 +948,7 @@ SUBROUTINE p_xyz_ao(op, qs_env, minimum_image) CPASSERT(ASSOCIATED(op_dip(i)%block)) END DO END IF ! new_atom_b - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) dab = SQRT(rab2) DO iset = 1, nseta @@ -961,7 +961,7 @@ SUBROUTINE p_xyz_ao(op, qs_env, minimum_image) ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) - IF (set_radius_a(iset)+set_radius_b(jset) >= dab) THEN + IF (set_radius_a(iset) + set_radius_b(jset) >= dab) THEN ! *** Calculate the primitive overlap integrals *** CALL diffop(la_max(iset), npgfa(iset), zeta(:, iset), & @@ -1132,7 +1132,7 @@ SUBROUTINE rRc_xyz_ao(op, qs_env, rc, order, minimum_image, soft) smom = 1 IF (order == -2) smom = 4 - M_dim = ncoset(ABS(order))-1 + M_dim = ncoset(ABS(order)) - 1 CPASSERT(M_dim <= SIZE(op, 1)) ALLOCATE (mab(ldab, ldab, 1:M_dim)) @@ -1194,7 +1194,7 @@ SUBROUTINE rRc_xyz_ao(op, qs_env, rc, order, minimum_image, soft) IF (ABS(rab(1)) > Lxo2 .OR. ABS(rab(2)) > Lyo2 .OR. ABS(rab(3)) > Lzo2) CYCLE END IF - rb = rab+ra + rb = rab + ra IF (jatom /= last_jatom) THEN new_atom_b = .TRUE. @@ -1220,7 +1220,7 @@ SUBROUTINE rRc_xyz_ao(op, qs_env, rc, order, minimum_image, soft) END DO ! imom END IF ! new_atom_b - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) dab = SQRT(rab2) DO iset = 1, nseta @@ -1233,7 +1233,7 @@ SUBROUTINE rRc_xyz_ao(op, qs_env, rc, order, minimum_image, soft) ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) - IF (set_radius_a(iset)+set_radius_b(jset) >= dab) THEN + IF (set_radius_a(iset) + set_radius_b(jset) >= dab) THEN rac = pbc(rc, ra, cell) rbc = pbc(rc, rb, cell) @@ -1404,7 +1404,7 @@ SUBROUTINE rRc_xyz_der_ao(op, op_der, qs_env, rc, order, minimum_image, soft) ldab = ldwork - M_dim = ncoset(order)-1 + M_dim = ncoset(order) - 1 CPASSERT(M_dim <= SIZE(op, 1)) ALLOCATE (mab(ldab, ldab, M_dim)) @@ -1476,7 +1476,7 @@ SUBROUTINE rRc_xyz_der_ao(op, op_der, qs_env, rc, order, minimum_image, soft) IF (ABS(rab(1)) > Lxo2 .OR. ABS(rab(2)) > Lyo2 .OR. ABS(rab(3)) > Lzo2) CYCLE END IF - rb = rab+ra + rb = rab + ra IF (jatom /= last_jatom) THEN new_atom_b = .TRUE. @@ -1508,7 +1508,7 @@ SUBROUTINE rRc_xyz_der_ao(op, op_der, qs_env, rc, order, minimum_image, soft) END DO ! imom END IF ! new_atom_b - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) dab = SQRT(rab2) DO iset = 1, nseta @@ -1521,22 +1521,22 @@ SUBROUTINE rRc_xyz_der_ao(op, op_der, qs_env, rc, order, minimum_image, soft) ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) - IF (set_radius_a(iset)+set_radius_b(jset) >= dab) THEN + IF (set_radius_a(iset) + set_radius_b(jset) >= dab) THEN rac = pbc(rc, ra, cell) - rbc = rac+rab + rbc = rac + rab ! rac = pbc(rc,ra,cell) ! rbc = pbc(rc,rb,cell) - ALLOCATE (mab_tmp(npgfa(iset)*ncoset(la_max(iset)+1), & - npgfb(jset)*ncoset(lb_max(jset)+1), ncoset(order)-1)) + ALLOCATE (mab_tmp(npgfa(iset)*ncoset(la_max(iset) + 1), & + npgfb(jset)*ncoset(lb_max(jset) + 1), ncoset(order) - 1)) - lda_min = MAX(0, la_min(iset)-1) - ldb_min = MAX(0, lb_min(jset)-1) + lda_min = MAX(0, la_min(iset) - 1) + ldb_min = MAX(0, lb_min(jset) - 1) ! *** Calculate the primitive overlap integrals *** - CALL moment(la_max(iset)+1, npgfa(iset), zeta(:, iset), & + CALL moment(la_max(iset) + 1, npgfa(iset), zeta(:, iset), & rpgfa(:, iset), lda_min, & - lb_max(jset)+1, npgfb(jset), zetb(:, jset), rpgfb(:, jset), & + lb_max(jset) + 1, npgfb(jset), zetb(:, jset), rpgfb(:, jset), & order, rac, rbc, mab_tmp) ! *** Calculate the derivatives @@ -1556,14 +1556,14 @@ SUBROUTINE rRc_xyz_der_ao(op, op_der, qs_env, rc, order, minimum_image, soft) DO jpgf = 1, npgfb(jset) DO j = 1, ncoset(lb_max(jset)) DO i = 1, ncoset(la_max(iset)) - mab(i+na, j+nb, imom) = mab_tmp(i+nda, j+ndb, imom) + mab(i + na, j + nb, imom) = mab_tmp(i + nda, j + ndb, imom) END DO ! i END DO ! j - nb = nb+ncoset(lb_max(jset)) - ndb = ndb+ncoset(lb_max(jset)+1) + nb = nb + ncoset(lb_max(jset)) + ndb = ndb + ncoset(lb_max(jset) + 1) END DO ! jpgf - na = na+ncoset(la_max(iset)) - nda = nda+ncoset(la_max(iset)+1) + na = na + ncoset(la_max(iset)) + nda = nda + ncoset(la_max(iset) + 1) END DO ! ipgf ! *** Contraction *** diff --git a/src/qs_ot.F b/src/qs_ot.F index 833718ae48..0d9f075a32 100644 --- a/src/qs_ot.F +++ b/src/qs_ot.F @@ -146,8 +146,8 @@ SUBROUTINE qs_ot_on_the_fly_localize(qs_ot_env, C_NEW, SC, G_OLD, D) row_size=row_size, col_size=col_size) DO p = 1, col_size ! p DO i = 1, row_size ! i - tmp = SQRT(DATA(i, p)**2+f2_eps) - f2 = f2+tmp + tmp = SQRT(DATA(i, p)**2 + f2_eps) + f2 = f2 + tmp DATA(i, p) = DATA(i, p)/tmp ENDDO ENDDO @@ -924,8 +924,8 @@ SUBROUTINE qs_ot_rot_mat_derivative(qs_ot_env) row_offset=row_offset, col_offset=col_offset) DO j = 1, col_size DO i = 1, row_size - e1 = qs_ot_env%rot_mat_evals(row_offset+i-1) - e2 = qs_ot_env%rot_mat_evals(col_offset+j-1) + e1 = qs_ot_env%rot_mat_evals(row_offset + i - 1) + e2 = qs_ot_env%rot_mat_evals(col_offset + j - 1) data_z(i, j) = data_z(i, j)*cint(e1, e2) ENDDO ENDDO @@ -966,14 +966,14 @@ FUNCTION cint(e1, e2) l1 = (0.0_dp, -1.0_dp)*e1 l2 = (0.0_dp, -1.0_dp)*e2 - IF (ABS(l1-l2) .GT. 0.5_dp) THEN - cint = (EXP(l1)-EXP(l2))/(l1-l2) + IF (ABS(l1 - l2) .GT. 0.5_dp) THEN + cint = (EXP(l1) - EXP(l2))/(l1 - l2) ELSE x = 1.0_dp cint = 0.0_dp DO I = 1, 16 - cint = cint+x - x = x*(l1-l2)/REAL(I+1, KIND=dp) + cint = cint + x + x = x*(l1 - l2)/REAL(I + 1, KIND=dp) ENDDO cint = cint*EXP(l2) ENDIF @@ -1002,8 +1002,8 @@ SUBROUTINE decide_strategy(qs_ot_env) N = 0 num_error = qs_ot_env%largest_eval_upper_bound/(2.0_dp) DO WHILE (num_error > qs_ot_env%settings%eps_taylor .AND. N <= qs_ot_env%settings%max_taylor) - N = N+1 - num_error = num_error*qs_ot_env%largest_eval_upper_bound/REAL((2*N+1)*(2*N+2), KIND=dp) + N = N + 1 + num_error = num_error*qs_ot_env%largest_eval_upper_bound/REAL((2*N + 1)*(2*N + 2), KIND=dp) END DO qs_ot_env%taylor_order = N IF (qs_ot_env%taylor_order <= qs_ot_env%settings%max_taylor) THEN @@ -1299,7 +1299,7 @@ SUBROUTINE qs_ot_get_derivative_taylor(matrix_hc, matrix_x, matrix_sx, matrix_gx ! OOM+OMO+MOO ! ... DO i = 2, qs_ot_env%taylor_order - sinfactor = sinfactor*(-1.0_dp)/REAL(2*i*(2*i+1), KIND=dp) + sinfactor = sinfactor*(-1.0_dp)/REAL(2*i*(2*i + 1), KIND=dp) CALL dbcsr_multiply('N', 'N', rone, qs_ot_env%matrix_p, matrix_left, rzero, qs_ot_env%matrix_buf1) CALL dbcsr_multiply('N', 'N', rone, matrix_right, qs_ot_env%matrix_p, rzero, matrix_left) CALL dbcsr_copy(matrix_right, matrix_left) @@ -1328,7 +1328,7 @@ SUBROUTINE qs_ot_get_derivative_taylor(matrix_hc, matrix_x, matrix_sx, matrix_gx ! OOM+OMO+MOO ! ... DO i = 2, qs_ot_env%taylor_order - cosfactor = cosfactor*(-1.0_dp)/REAL(2*i*(2*i-1), KIND=dp) + cosfactor = cosfactor*(-1.0_dp)/REAL(2*i*(2*i - 1), KIND=dp) CALL dbcsr_multiply('N', 'N', rone, qs_ot_env%matrix_p, matrix_left, rzero, qs_ot_env%matrix_buf1) CALL dbcsr_multiply('N', 'N', rone, matrix_right, qs_ot_env%matrix_p, rzero, matrix_left) CALL dbcsr_copy(matrix_right, matrix_left) @@ -1392,8 +1392,8 @@ SUBROUTINE qs_ot_p2m_taylor(qs_ot_env) rzero, qs_ot_env%matrix_buf1) CALL dbcsr_copy(qs_ot_env%matrix_r, qs_ot_env%matrix_buf1) ! add to the taylor expansion so far - cosfactor = cosfactor*(-1.0_dp)/REAL(2*i*(2*i-1), KIND=dp) - sinfactor = sinfactor*(-1.0_dp)/REAL(2*i*(2*i+1), KIND=dp) + cosfactor = cosfactor*(-1.0_dp)/REAL(2*i*(2*i - 1), KIND=dp) + sinfactor = sinfactor*(-1.0_dp)/REAL(2*i*(2*i + 1), KIND=dp) CALL dbcsr_add(qs_ot_env%matrix_cosp, qs_ot_env%matrix_r, & alpha_scalar=1.0_dp, beta_scalar=cosfactor) CALL dbcsr_add(qs_ot_env%matrix_sinp, qs_ot_env%matrix_r, & @@ -1462,10 +1462,10 @@ SUBROUTINE qs_ot_p2m_diag(qs_ot_env) row_offset=row_offset, col_offset=col_offset) DO j = 1, col_size DO i = 1, row_size - a = (SQRT(qs_ot_env%evals(row_offset+i-1)) & - -SQRT(qs_ot_env%evals(col_offset+j-1)))/2.0_dp - b = (SQRT(qs_ot_env%evals(row_offset+i-1)) & - +SQRT(qs_ot_env%evals(col_offset+j-1)))/2.0_dp + a = (SQRT(qs_ot_env%evals(row_offset + i - 1)) & + - SQRT(qs_ot_env%evals(col_offset + j - 1)))/2.0_dp + b = (SQRT(qs_ot_env%evals(row_offset + i - 1)) & + + SQRT(qs_ot_env%evals(col_offset + j - 1)))/2.0_dp DATA(i, j) = -0.5_dp*qs_ot_sinc(a)*qs_ot_sinc(b) ENDDO ENDDO @@ -1480,8 +1480,8 @@ SUBROUTINE qs_ot_p2m_diag(qs_ot_env) row_offset=row_offset, col_offset=col_offset) DO j = 1, col_size DO i = 1, row_size - a = SQRT(qs_ot_env%evals(row_offset+i-1)) - b = SQRT(qs_ot_env%evals(col_offset+j-1)) + a = SQRT(qs_ot_env%evals(row_offset + i - 1)) + b = SQRT(qs_ot_env%evals(col_offset + j - 1)) DATA(i, j) = qs_ot_sincf(a, b) ENDDO ENDDO @@ -1514,7 +1514,7 @@ FUNCTION qs_ot_sinc(x) qs_ot_sinc = SIN(x)/x ELSE y = x*x - qs_ot_sinc = q1+y*(q2+y*(q3+y*(q4+y*(q5+y*(q6+y*(q7+y*(q8+y*(q9+y*(q10))))))))) + qs_ot_sinc = q1 + y*(q2 + y*(q3 + y*(q4 + y*(q5 + y*(q6 + y*(q7 + y*(q8 + y*(q9 + y*(q10))))))))) ENDIF END FUNCTION qs_ot_sinc ! computes (1/(x^2-y^2))*(sinc(x)-sinc(y)) for all positive values of the arguments @@ -1556,27 +1556,27 @@ FUNCTION qs_ot_sincf(xa, ya) ybx = 0.0_dp ENDIF - sf = -1.0_dp/((1.0_dp+ybx)*6.0_dp) + sf = -1.0_dp/((1.0_dp + ybx)*6.0_dp) rs = 1.0_dp ybxs = ybx xs = 1.0_dp DO i = 1, 10 - qs_ot_sincf = qs_ot_sincf+sf*rs*xs*(1.0_dp+ybxs) - sf = -sf/(REAL((2*i+2), dp)*REAL((2*i+3), dp)) - rs = rs+ybxs + qs_ot_sincf = qs_ot_sincf + sf*rs*xs*(1.0_dp + ybxs) + sf = -sf/(REAL((2*i + 2), dp)*REAL((2*i + 3), dp)) + rs = rs + ybxs ybxs = ybxs*ybx xs = xs*x*x ENDDO ELSE ! no series expansion - IF (x-y .GT. 0.1_dp) THEN ! safe to use the normal form - qs_ot_sincf = (qs_ot_sinc(x)-qs_ot_sinc(y))/((x+y)*(x-y)) + IF (x - y .GT. 0.1_dp) THEN ! safe to use the normal form + qs_ot_sincf = (qs_ot_sinc(x) - qs_ot_sinc(y))/((x + y)*(x - y)) ELSE - a = (x+y)/2.0_dp - b = (x-y)/2.0_dp ! might be close to zero + a = (x + y)/2.0_dp + b = (x - y)/2.0_dp ! might be close to zero ! y (=(a-b)) can not be close to zero since it is close to x>0.5 - qs_ot_sincf = (qs_ot_sinc(b)*COS(a)-qs_ot_sinc(a)*COS(b))/(2*x*y) + qs_ot_sincf = (qs_ot_sinc(b)*COS(a) - qs_ot_sinc(a)*COS(b))/(2*x*y) ENDIF ENDIF diff --git a/src/qs_ot_eigensolver.F b/src/qs_ot_eigensolver.F index 12a786ebd6..79a8b8b343 100644 --- a/src/qs_ot_eigensolver.F +++ b/src/qs_ot_eigensolver.F @@ -146,7 +146,7 @@ SUBROUTINE ot_eigensolver(matrix_h, matrix_s, matrix_orthogonal_space_fm, & CALL cp_fm_get_info(matrix_orthogonal_space_fm, ncol_global=ortho_space_k) IF (PRESENT(size_ortho_space)) ortho_space_k = size_ortho_space - ortho_k = ortho_space_k+k + ortho_k = ortho_space_k + k ELSE ortho_k = k ENDIF @@ -203,7 +203,7 @@ SUBROUTINE ot_eigensolver(matrix_h, matrix_s, matrix_orthogonal_space_fm, & CALL dbcsr_copy_columns_hack(qs_ot_env(1)%matrix_sc0, matrix_s_ortho, ortho_space_k, 1, 1, & para_env=qs_ot_env(1)%para_env, blacs_env=qs_ot_env(1)%blacs_env) !CALL dbcsr_copy_columns(qs_ot_env(1)%matrix_sc0,matrix_c,k,1,ortho_space_k+1) - CALL dbcsr_copy_columns_hack(qs_ot_env(1)%matrix_sc0, matrix_c, k, 1, ortho_space_k+1, & + CALL dbcsr_copy_columns_hack(qs_ot_env(1)%matrix_sc0, matrix_c, k, 1, ortho_space_k + 1, & para_env=qs_ot_env(1)%para_env, blacs_env=qs_ot_env(1)%blacs_env) CALL dbcsr_release_p(matrix_buf1_ortho) @@ -250,8 +250,8 @@ SUBROUTINE ot_eigensolver(matrix_h, matrix_s, matrix_orthogonal_space_fm, & ieigensolver = 0 eigensolver_loop: DO - ieigensolver = ieigensolver+1 - iter_total = iter_total+1 + ieigensolver = ieigensolver + 1 + iter_total = iter_total + 1 ! the energy is cHc, the gradient is 2*H*c CALL dbcsr_multiply('N', 'N', 1.0_dp, matrix_h, matrix_c, & diff --git a/src/qs_ot_minimizer.F b/src/qs_ot_minimizer.F index 42f87eb610..0092035672 100644 --- a/src/qs_ot_minimizer.F +++ b/src/qs_ot_minimizer.F @@ -81,7 +81,7 @@ SUBROUTINE ot_mini(qs_ot_env, matrix_hc) qs_ot_env(1)%gradient = 0.0_dp DO ispin = 1, nspin IF (do_ks) THEN - SELECT CASE (qs_ot_env (1)%settings%ot_algorithm) + SELECT CASE (qs_ot_env(1)%settings%ot_algorithm) CASE ("TOD") CALL qs_ot_get_derivative(matrix_hc(ispin)%matrix, qs_ot_env(ispin)%matrix_x, & qs_ot_env(ispin)%matrix_sx, & @@ -98,34 +98,34 @@ SUBROUTINE ot_mini(qs_ot_env, matrix_hc) IF (qs_ot_env(1)%use_dx) THEN IF (do_ks) THEN CALL dbcsr_dot(qs_ot_env(ispin)%matrix_gx, qs_ot_env(ispin)%matrix_dx, tmp) - qs_ot_env(1)%gradient = qs_ot_env(1)%gradient+tmp + qs_ot_env(1)%gradient = qs_ot_env(1)%gradient + tmp IF (qs_ot_env(1)%settings%do_rotation) THEN CALL dbcsr_dot(qs_ot_env(ispin)%rot_mat_gx, qs_ot_env(ispin)%rot_mat_dx, tmp) - qs_ot_env(1)%gradient = qs_ot_env(1)%gradient+0.5_dp*tmp + qs_ot_env(1)%gradient = qs_ot_env(1)%gradient + 0.5_dp*tmp ENDIF END IF IF (do_ener) THEN tmp = DOT_PRODUCT(qs_ot_env(ispin)%ener_gx, qs_ot_env(ispin)%ener_dx) - qs_ot_env(1)%gradient = qs_ot_env(1)%gradient+tmp + qs_ot_env(1)%gradient = qs_ot_env(1)%gradient + tmp ENDIF ELSE IF (do_ks) THEN CALL dbcsr_dot(qs_ot_env(ispin)%matrix_gx, qs_ot_env(ispin)%matrix_gx, tmp) - qs_ot_env(1)%gradient = qs_ot_env(1)%gradient-tmp + qs_ot_env(1)%gradient = qs_ot_env(1)%gradient - tmp IF (qs_ot_env(1)%settings%do_rotation) THEN CALL dbcsr_dot(qs_ot_env(ispin)%rot_mat_gx, qs_ot_env(ispin)%rot_mat_gx, tmp) - qs_ot_env(1)%gradient = qs_ot_env(1)%gradient-0.5_dp*tmp + qs_ot_env(1)%gradient = qs_ot_env(1)%gradient - 0.5_dp*tmp ENDIF ENDIF IF (do_ener) THEN tmp = DOT_PRODUCT(qs_ot_env(ispin)%ener_gx, qs_ot_env(ispin)%ener_gx) - qs_ot_env(1)%gradient = qs_ot_env(1)%gradient-tmp + qs_ot_env(1)%gradient = qs_ot_env(1)%gradient - tmp ENDIF ENDIF ENDDO ENDIF - SELECT CASE (qs_ot_env (1)%settings%OT_METHOD) + SELECT CASE (qs_ot_env(1)%settings%OT_METHOD) CASE ("CG") IF (current_point_is_fine(qs_ot_env)) THEN qs_ot_env(1)%OT_METHOD_FULL = "OT CG" @@ -204,7 +204,7 @@ SUBROUTINE do_line_search(qs_ot_env) CHARACTER(len=*), PARAMETER :: routineN = 'do_line_search', routineP = moduleN//':'//routineN - SELECT CASE (qs_ot_env (1)%settings%line_search_method) + SELECT CASE (qs_ot_env(1)%settings%line_search_method) CASE ("GOLD") CALL do_line_search_gold(qs_ot_env) CASE ("3PNT") @@ -256,7 +256,7 @@ SUBROUTINE take_step(ds, qs_ot_env) END IF IF (do_ener) THEN DO ispin = 1, nspin - qs_ot_env(ispin)%ener_x = qs_ot_env(ispin)%ener_x+ds*qs_ot_env(ispin)%ener_dx + qs_ot_env(ispin)%ener_x = qs_ot_env(ispin)%ener_x + ds*qs_ot_env(ispin)%ener_dx ENDDO ENDIF ELSE @@ -272,7 +272,7 @@ SUBROUTINE take_step(ds, qs_ot_env) ENDIF IF (do_ener) THEN DO ispin = 1, nspin - qs_ot_env(ispin)%ener_x = qs_ot_env(ispin)%ener_x-ds*qs_ot_env(ispin)%ener_gx + qs_ot_env(ispin)%ener_x = qs_ot_env(ispin)%ener_x - ds*qs_ot_env(ispin)%ener_gx ENDDO ENDIF ENDIF @@ -297,12 +297,12 @@ SUBROUTINE do_line_search_gold(qs_ot_env) CALL timeset(routineN, handle) - qs_ot_env(1)%line_search_count = qs_ot_env(1)%line_search_count+1 + qs_ot_env(1)%line_search_count = qs_ot_env(1)%line_search_count + 1 count = qs_ot_env(1)%line_search_count qs_ot_env(1)%line_search_might_be_done = .FALSE. qs_ot_env(1)%energy_only = .TRUE. - IF (count+1 .GT. SIZE(qs_ot_env(1)%OT_pos)) THEN + IF (count + 1 .GT. SIZE(qs_ot_env(1)%OT_pos)) THEN ! should not happen, we pass with a warning first ! you can increase the size of OT_pos and the like in qs_ot_env CPABORT("MAX ITER EXCEEDED : FATAL") @@ -321,15 +321,15 @@ SUBROUTINE do_line_search_gold(qs_ot_env) ! keep left on the left, keep (bring) right on the right ! and mid in between these two IF (qs_ot_env(1)%line_search_right .EQ. 0) THEN ! we do not yet have the right bracket - IF (qs_ot_env(1)%ot_energy(count-1) .LT. qs_ot_env(1)%ot_energy(count)) THEN + IF (qs_ot_env(1)%ot_energy(count - 1) .LT. qs_ot_env(1)%ot_energy(count)) THEN qs_ot_env(1)%line_search_right = count - qs_ot_env(1)%ot_pos(count+1) = qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_mid)+ & - (qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_right)- & - qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_mid))*gold_sec + qs_ot_env(1)%ot_pos(count + 1) = qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_mid) + & + (qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_right) - & + qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_mid))*gold_sec ELSE qs_ot_env(1)%line_search_left = qs_ot_env(1)%line_search_mid qs_ot_env(1)%line_search_mid = count - qs_ot_env(1)%ot_pos(count+1) = qs_ot_env(1)%ot_pos(count)/gold_sec ! expand + qs_ot_env(1)%ot_pos(count + 1) = qs_ot_env(1)%ot_pos(count)/gold_sec ! expand ENDIF ELSE ! first determine where we are and construct the new triplet @@ -350,33 +350,33 @@ SUBROUTINE do_line_search_gold(qs_ot_env) ENDIF ! now find the new point in the largest section IF ((qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_right) & - -qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_mid)) .GT. & + - qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_mid)) .GT. & (qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_mid) & - -qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_left))) THEN - qs_ot_env(1)%ot_pos(count+1) = & - qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_mid)+ & + - qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_left))) THEN + qs_ot_env(1)%ot_pos(count + 1) = & + qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_mid) + & gold_sec*(qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_right) & - -qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_mid)) + - qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_mid)) ELSE - qs_ot_env(1)%ot_pos(count+1) = & - qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_left)+ & + qs_ot_env(1)%ot_pos(count + 1) = & + qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_left) + & gold_sec*(qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_mid) & - -qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_left)) + - qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_left)) ENDIF ! check for termination IF (((qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_right) & - -qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_mid)) .LT. & + - qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_mid)) .LT. & qs_ot_env(1)%ds_min*qs_ot_env(1)%settings%gold_target) .AND. & ((qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_mid) & - -qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_left)) .LT. & + - qs_ot_env(1)%ot_pos(qs_ot_env(1)%line_search_left)) .LT. & qs_ot_env(1)%ds_min*qs_ot_env(1)%settings%gold_target)) THEN qs_ot_env(1)%energy_only = .FALSE. qs_ot_env(1)%line_search_might_be_done = .TRUE. ENDIF ENDIF ENDIF - ds = qs_ot_env(1)%OT_pos(count+1)-qs_ot_env(1)%OT_pos(count) - qs_ot_env(1)%ds_min = qs_ot_env(1)%OT_pos(count+1) + ds = qs_ot_env(1)%OT_pos(count + 1) - qs_ot_env(1)%OT_pos(count) + qs_ot_env(1)%ds_min = qs_ot_env(1)%OT_pos(count + 1) CALL take_step(ds, qs_ot_env) @@ -405,18 +405,18 @@ SUBROUTINE do_line_search_3pnt(qs_ot_env) qs_ot_env(1)%energy_only = .TRUE. ! a three point interpolation based on the energy - qs_ot_env(1)%line_search_count = qs_ot_env(1)%line_search_count+1 + qs_ot_env(1)%line_search_count = qs_ot_env(1)%line_search_count + 1 count = qs_ot_env(1)%line_search_count qs_ot_env(1)%ot_energy(count) = qs_ot_env(1)%etotal SELECT CASE (count) CASE (1) qs_ot_env(1)%ot_pos(count) = 0.0_dp - qs_ot_env(1)%ot_pos(count+1) = qs_ot_env(1)%ds_min*0.8_dp + qs_ot_env(1)%ot_pos(count + 1) = qs_ot_env(1)%ds_min*0.8_dp CASE (2) - IF (qs_ot_env(1)%OT_energy(count) .GT. qs_ot_env(1)%OT_energy(count-1)) THEN - qs_ot_env(1)%OT_pos(count+1) = qs_ot_env(1)%ds_min*0.5_dp + IF (qs_ot_env(1)%OT_energy(count) .GT. qs_ot_env(1)%OT_energy(count - 1)) THEN + qs_ot_env(1)%OT_pos(count + 1) = qs_ot_env(1)%ds_min*0.5_dp ELSE - qs_ot_env(1)%OT_pos(count+1) = qs_ot_env(1)%ds_min*1.4_dp + qs_ot_env(1)%OT_pos(count + 1) = qs_ot_env(1)%ds_min*1.4_dp ENDIF CASE (3) xa = qs_ot_env(1)%OT_pos(1) @@ -425,30 +425,30 @@ SUBROUTINE do_line_search_3pnt(qs_ot_env) fa = qs_ot_env(1)%OT_energy(1) fb = qs_ot_env(1)%OT_energy(2) fc = qs_ot_env(1)%OT_energy(3) - nom = (xb-xa)**2*(fb-fc)-(xb-xc)**2*(fb-fa) - denom = (xb-xa)*(fb-fc)-(xb-xc)*(fb-fa) - IF (ABS(denom) .LE. 1.0E-18_dp*MAX(ABS(fb-fc), ABS(fb-fa))) THEN + nom = (xb - xa)**2*(fb - fc) - (xb - xc)**2*(fb - fa) + denom = (xb - xa)*(fb - fc) - (xb - xc)*(fb - fa) + IF (ABS(denom) .LE. 1.0E-18_dp*MAX(ABS(fb - fc), ABS(fb - fa))) THEN pos = xb ELSE - pos = xb-0.5_dp*nom/denom ! position of the stationary point + pos = xb - 0.5_dp*nom/denom ! position of the stationary point ENDIF - val = (pos-xa)*(pos-xb)*fc/((xc-xa)*(xc-xb))+ & - (pos-xb)*(pos-xc)*fa/((xa-xb)*(xa-xc))+ & - (pos-xc)*(pos-xa)*fb/((xb-xc)*(xb-xa)) + val = (pos - xa)*(pos - xb)*fc/((xc - xa)*(xc - xb)) + & + (pos - xb)*(pos - xc)*fa/((xa - xb)*(xa - xc)) + & + (pos - xc)*(pos - xa)*fb/((xb - xc)*(xb - xa)) IF (val .LT. fa .AND. val .LE. fb .AND. val .LE. fc) THEN ! OK, we go to a minimum ! we take a guard against too large steps - qs_ot_env(1)%OT_pos(count+1) = MAX(MAXVAL(qs_ot_env(1)%OT_pos(1:3))*0.01_dp, & - MIN(pos, MAXVAL(qs_ot_env(1)%OT_pos(1:3))*4.0_dp)) + qs_ot_env(1)%OT_pos(count + 1) = MAX(MAXVAL(qs_ot_env(1)%OT_pos(1:3))*0.01_dp, & + MIN(pos, MAXVAL(qs_ot_env(1)%OT_pos(1:3))*4.0_dp)) ELSE ! just take an extended step - qs_ot_env(1)%OT_pos(count+1) = MAXVAL(qs_ot_env(1)%OT_pos(1:3))*2.0_dp + qs_ot_env(1)%OT_pos(count + 1) = MAXVAL(qs_ot_env(1)%OT_pos(1:3))*2.0_dp ENDIF qs_ot_env(1)%energy_only = .FALSE. qs_ot_env(1)%line_search_might_be_done = .TRUE. CASE DEFAULT CPABORT("NYI") END SELECT - ds = qs_ot_env(1)%OT_pos(count+1)-qs_ot_env(1)%OT_pos(count) - qs_ot_env(1)%ds_min = qs_ot_env(1)%OT_pos(count+1) + ds = qs_ot_env(1)%OT_pos(count + 1) - qs_ot_env(1)%OT_pos(count) + qs_ot_env(1)%ds_min = qs_ot_env(1)%OT_pos(count + 1) CALL take_step(ds, qs_ot_env) @@ -476,38 +476,38 @@ SUBROUTINE do_line_search_2pnt(qs_ot_env) qs_ot_env(1)%energy_only = .TRUE. ! a three point interpolation based on the energy - qs_ot_env(1)%line_search_count = qs_ot_env(1)%line_search_count+1 + qs_ot_env(1)%line_search_count = qs_ot_env(1)%line_search_count + 1 count = qs_ot_env(1)%line_search_count qs_ot_env(1)%ot_energy(count) = qs_ot_env(1)%etotal SELECT CASE (count) CASE (1) qs_ot_env(1)%ot_pos(count) = 0.0_dp qs_ot_env(1)%ot_grad(count) = qs_ot_env(1)%gradient - qs_ot_env(1)%ot_pos(count+1) = qs_ot_env(1)%ds_min*1.0_dp + qs_ot_env(1)%ot_pos(count + 1) = qs_ot_env(1)%ds_min*1.0_dp CASE (2) x0 = 0.0_dp c = qs_ot_env(1)%ot_energy(1) b = qs_ot_env(1)%ot_grad(1) x1 = qs_ot_env(1)%ot_pos(2) - a = (qs_ot_env(1)%ot_energy(2)-b*x1-c)/(x1**2) + a = (qs_ot_env(1)%ot_energy(2) - b*x1 - c)/(x1**2) IF (a .LE. 0.0_dp) a = 1.0E-15_dp pos = -b/(2.0_dp*a) - val = a*pos**2+b*pos+c + val = a*pos**2 + b*pos + c qs_ot_env(1)%energy_only = .FALSE. qs_ot_env(1)%line_search_might_be_done = .TRUE. IF (val .LT. qs_ot_env(1)%ot_energy(1) .AND. val .LE. qs_ot_env(1)%ot_energy(2)) THEN ! we go to a minimum, but ... ! we take a guard against too large steps - qs_ot_env(1)%OT_pos(count+1) = MAX(MAXVAL(qs_ot_env(1)%OT_pos(1:2))*0.01_dp, & - MIN(pos, MAXVAL(qs_ot_env(1)%OT_pos(1:2))*4.0_dp)) + qs_ot_env(1)%OT_pos(count + 1) = MAX(MAXVAL(qs_ot_env(1)%OT_pos(1:2))*0.01_dp, & + MIN(pos, MAXVAL(qs_ot_env(1)%OT_pos(1:2))*4.0_dp)) ELSE ! just take an extended step - qs_ot_env(1)%OT_pos(count+1) = MAXVAL(qs_ot_env(1)%OT_pos(1:2))*2.0_dp + qs_ot_env(1)%OT_pos(count + 1) = MAXVAL(qs_ot_env(1)%OT_pos(1:2))*2.0_dp ENDIF CASE DEFAULT CPABORT("NYI") END SELECT - ds = qs_ot_env(1)%OT_pos(count+1)-qs_ot_env(1)%OT_pos(count) - qs_ot_env(1)%ds_min = qs_ot_env(1)%OT_pos(count+1) + ds = qs_ot_env(1)%OT_pos(count + 1) - qs_ot_env(1)%OT_pos(count) + qs_ot_env(1)%ds_min = qs_ot_env(1)%OT_pos(count + 1) CALL take_step(ds, qs_ot_env) @@ -563,7 +563,7 @@ SUBROUTINE ot_new_sd_direction(qs_ot_env) CALL apply_preconditioner(qs_ot_env(ispin)%preconditioner, & qs_ot_env(ispin)%matrix_gx, qs_ot_env(ispin)%matrix_dx) CALL dbcsr_dot(qs_ot_env(ispin)%matrix_gx, qs_ot_env(ispin)%matrix_dx, tmp) - qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm+tmp + qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm + tmp ENDDO IF (qs_ot_env(1)%gnorm .LT. 0.0_dp) THEN logger => cp_get_default_logger() @@ -578,7 +578,7 @@ SUBROUTINE ot_new_sd_direction(qs_ot_env) CALL dbcsr_copy(qs_ot_env(ispin)%rot_mat_dx, qs_ot_env(ispin)%rot_mat_gx) CALL dbcsr_dot(qs_ot_env(ispin)%rot_mat_gx, qs_ot_env(ispin)%rot_mat_dx, tmp) ! added 0.5, because we have (antisymmetry) only half the number of variables - qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm+0.5_dp*tmp + qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm + 0.5_dp*tmp ENDDO DO ispin = 1, nspin CALL dbcsr_scale(qs_ot_env(ispin)%rot_mat_dx, -1.0_dp) @@ -589,7 +589,7 @@ SUBROUTINE ot_new_sd_direction(qs_ot_env) DO ispin = 1, nspin qs_ot_env(ispin)%ener_dx = qs_ot_env(ispin)%ener_gx tmp = DOT_PRODUCT(qs_ot_env(ispin)%ener_dx, qs_ot_env(ispin)%ener_gx) - qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm+tmp + qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm + tmp qs_ot_env(ispin)%ener_dx = -qs_ot_env(ispin)%ener_dx ENDDO ENDIF @@ -598,20 +598,20 @@ SUBROUTINE ot_new_sd_direction(qs_ot_env) IF (do_ks) THEN DO ispin = 1, nspin CALL dbcsr_dot(qs_ot_env(ispin)%matrix_gx, qs_ot_env(ispin)%matrix_gx, tmp) - qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm+tmp + qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm + tmp ENDDO IF (qs_ot_env(1)%settings%do_rotation) THEN DO ispin = 1, nspin CALL dbcsr_dot(qs_ot_env(ispin)%rot_mat_gx, qs_ot_env(ispin)%rot_mat_gx, tmp) ! added 0.5, because we have (antisymmetry) only half the number of variables - qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm+0.5_dp*tmp + qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm + 0.5_dp*tmp ENDDO ENDIF ENDIF IF (do_ener) THEN DO ispin = 1, nspin tmp = DOT_PRODUCT(qs_ot_env(ispin)%ener_gx, qs_ot_env(ispin)%ener_gx) - qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm+tmp + qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm + tmp ENDDO ENDIF ENDIF @@ -623,17 +623,17 @@ SUBROUTINE ot_new_sd_direction(qs_ot_env) CALL dbcsr_get_info(qs_ot_env(1)%matrix_x, nfullrows_total=n) DO ispin = 1, nspin CALL dbcsr_get_info(qs_ot_env(ispin)%matrix_x, nfullcols_total=itmp) - k = k+itmp + k = k + itmp ENDDO ENDIF IF (do_ener) THEN DO ispin = 1, nspin - nener = nener+SIZE(qs_ot_env(ispin)%ener_x) + nener = nener + SIZE(qs_ot_env(ispin)%ener_x) ENDDO ENDIF ! Handling the case of no free variables to optimize - IF (INT(n, KIND=int_8)*INT(k, KIND=int_8)+nener /= 0) THEN - qs_ot_env(1)%delta = SQRT(ABS(qs_ot_env(1)%gnorm)/(INT(n, KIND=int_8)*INT(k, KIND=int_8)+nener)) + IF (INT(n, KIND=int_8)*INT(k, KIND=int_8) + nener /= 0) THEN + qs_ot_env(1)%delta = SQRT(ABS(qs_ot_env(1)%gnorm)/(INT(n, KIND=int_8)*INT(k, KIND=int_8) + nener)) qs_ot_env(1)%gradient = -qs_ot_env(1)%gnorm ELSE qs_ot_env(1)%delta = 0.0_dp @@ -676,20 +676,20 @@ SUBROUTINE ot_new_cg_direction(qs_ot_env) IF (do_ks) THEN DO ispin = 1, nspin CALL dbcsr_dot(qs_ot_env(ispin)%matrix_gx, qs_ot_env(ispin)%matrix_gx_old, tmp) - gnorm_cross = gnorm_cross+tmp + gnorm_cross = gnorm_cross + tmp ENDDO IF (qs_ot_env(1)%settings%do_rotation) THEN DO ispin = 1, nspin CALL dbcsr_dot(qs_ot_env(ispin)%rot_mat_gx, qs_ot_env(ispin)%rot_mat_gx_old, tmp) ! added 0.5, because we have (antisymmetry) only half the number of variables - gnorm_cross = gnorm_cross+0.5_dp*tmp + gnorm_cross = gnorm_cross + 0.5_dp*tmp ENDDO ENDIF END IF IF (do_ener) THEN DO ispin = 1, nspin tmp = DOT_PRODUCT(qs_ot_env(ispin)%ener_gx, qs_ot_env(ispin)%ener_gx_old) - gnorm_cross = gnorm_cross+tmp + gnorm_cross = gnorm_cross + tmp ENDDO END IF @@ -703,7 +703,7 @@ SUBROUTINE ot_new_cg_direction(qs_ot_env) IF (do_ks) THEN DO ispin = 1, nspin CALL dbcsr_dot(qs_ot_env(ispin)%matrix_gx, qs_ot_env(ispin)%matrix_gx_old, tmp) - qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm+tmp + qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm + tmp ENDDO IF (qs_ot_env(1)%gnorm .LT. 0.0_dp) THEN WRITE (cp_logger_get_default_unit_nr(logger), *) "WARNING Preconditioner not positive definite !" @@ -717,7 +717,7 @@ SUBROUTINE ot_new_cg_direction(qs_ot_env) CALL dbcsr_copy(qs_ot_env(ispin)%rot_mat_gx_old, qs_ot_env(ispin)%rot_mat_gx) CALL dbcsr_dot(qs_ot_env(ispin)%rot_mat_gx, qs_ot_env(ispin)%rot_mat_gx_old, tmp) ! added 0.5, because we have (antisymmetry) only half the number of variables - qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm+0.5_dp*tmp + qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm + 0.5_dp*tmp ENDDO DO ispin = 1, nspin CALL dbcsr_copy(qs_ot_env(ispin)%rot_mat_gx, qs_ot_env(ispin)%rot_mat_gx_old) @@ -728,7 +728,7 @@ SUBROUTINE ot_new_cg_direction(qs_ot_env) DO ispin = 1, nspin qs_ot_env(ispin)%ener_gx_old = qs_ot_env(ispin)%ener_gx tmp = DOT_PRODUCT(qs_ot_env(ispin)%ener_gx, qs_ot_env(ispin)%ener_gx_old) - qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm+tmp + qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm + tmp qs_ot_env(ispin)%ener_gx = qs_ot_env(ispin)%ener_gx_old ENDDO END IF @@ -737,14 +737,14 @@ SUBROUTINE ot_new_cg_direction(qs_ot_env) qs_ot_env(1)%gnorm = 0.0_dp DO ispin = 1, nspin CALL dbcsr_dot(qs_ot_env(ispin)%matrix_gx, qs_ot_env(ispin)%matrix_gx, tmp) - qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm+tmp + qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm + tmp CALL dbcsr_copy(qs_ot_env(ispin)%matrix_gx_old, qs_ot_env(ispin)%matrix_gx) ENDDO IF (qs_ot_env(1)%settings%do_rotation) THEN DO ispin = 1, nspin CALL dbcsr_dot(qs_ot_env(ispin)%rot_mat_gx, qs_ot_env(ispin)%rot_mat_gx, tmp) ! added 0.5, because we have (antisymmetry) only half the number of variables - qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm+0.5_dp*tmp + qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm + 0.5_dp*tmp CALL dbcsr_copy(qs_ot_env(ispin)%rot_mat_gx_old, qs_ot_env(ispin)%rot_mat_gx) ENDDO ENDIF @@ -752,7 +752,7 @@ SUBROUTINE ot_new_cg_direction(qs_ot_env) IF (do_ener) THEN DO ispin = 1, nspin tmp = DOT_PRODUCT(qs_ot_env(ispin)%ener_gx, qs_ot_env(ispin)%ener_gx) - qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm+tmp + qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm + tmp qs_ot_env(ispin)%ener_gx_old = qs_ot_env(ispin)%ener_gx ENDDO ENDIF @@ -765,18 +765,18 @@ SUBROUTINE ot_new_cg_direction(qs_ot_env) CALL dbcsr_get_info(qs_ot_env(1)%matrix_x, nfullrows_total=n) DO ispin = 1, nspin CALL dbcsr_get_info(qs_ot_env(ispin)%matrix_x, nfullcols_total=itmp) - k = k+itmp + k = k + itmp ENDDO END IF IF (do_ener) THEN DO ispin = 1, nspin - nener = nener+SIZE(qs_ot_env(ispin)%ener_x) + nener = nener + SIZE(qs_ot_env(ispin)%ener_x) ENDDO ENDIF ! Handling the case of no free variables to optimize - IF (INT(n, KIND=int_8)*INT(k, KIND=int_8)+nener /= 0) THEN - qs_ot_env(1)%delta = SQRT(ABS(qs_ot_env(1)%gnorm)/(INT(n, KIND=int_8)*INT(k, KIND=int_8)+nener)) - beta_pr = (qs_ot_env(1)%gnorm-gnorm_cross)/qs_ot_env(1)%gnorm_old + IF (INT(n, KIND=int_8)*INT(k, KIND=int_8) + nener /= 0) THEN + qs_ot_env(1)%delta = SQRT(ABS(qs_ot_env(1)%gnorm)/(INT(n, KIND=int_8)*INT(k, KIND=int_8) + nener)) + beta_pr = (qs_ot_env(1)%gnorm - gnorm_cross)/qs_ot_env(1)%gnorm_old ELSE qs_ot_env(1)%delta = 0.0_dp beta_pr = 0.0_dp @@ -789,20 +789,20 @@ SUBROUTINE ot_new_cg_direction(qs_ot_env) CALL dbcsr_add(qs_ot_env(ispin)%matrix_dx, qs_ot_env(ispin)%matrix_gx, & alpha_scalar=beta_pr, beta_scalar=-1.0_dp) CALL dbcsr_dot(qs_ot_env(ispin)%matrix_gx, qs_ot_env(ispin)%matrix_dx, tmp) - test_down = test_down+tmp + test_down = test_down + tmp IF (qs_ot_env(1)%settings%do_rotation) THEN CALL dbcsr_add(qs_ot_env(ispin)%rot_mat_dx, qs_ot_env(ispin)%rot_mat_gx, & alpha_scalar=beta_pr, beta_scalar=-1.0_dp) CALL dbcsr_dot(qs_ot_env(ispin)%rot_mat_gx, qs_ot_env(ispin)%rot_mat_dx, tmp) - test_down = test_down+0.5_dp*tmp + test_down = test_down + 0.5_dp*tmp ENDIF ENDDO END IF IF (do_ener) THEN DO ispin = 1, nspin - qs_ot_env(ispin)%ener_dx = beta_pr*qs_ot_env(ispin)%ener_dx-qs_ot_env(ispin)%ener_gx + qs_ot_env(ispin)%ener_dx = beta_pr*qs_ot_env(ispin)%ener_dx - qs_ot_env(ispin)%ener_gx tmp = DOT_PRODUCT(qs_ot_env(ispin)%ener_gx, qs_ot_env(ispin)%ener_dx) - test_down = test_down+tmp + test_down = test_down + tmp ENDDO ENDIF @@ -820,12 +820,12 @@ SUBROUTINE ot_new_cg_direction(qs_ot_env) END IF IF (do_ener) THEN DO ispin = 1, nspin - qs_ot_env(ispin)%ener_dx = beta_pr*qs_ot_env(ispin)%ener_dx-qs_ot_env(ispin)%ener_gx + qs_ot_env(ispin)%ener_dx = beta_pr*qs_ot_env(ispin)%ener_dx - qs_ot_env(ispin)%ener_gx ENDDO ENDIF ENDIF ! since we change the direction we have to adjust the gradient - qs_ot_env(1)%gradient = beta_pr*qs_ot_env(1)%gradient-qs_ot_env(1)%gnorm + qs_ot_env(1)%gradient = beta_pr*qs_ot_env(1)%gradient - qs_ot_env(1)%gnorm qs_ot_env(1)%gnorm_old = qs_ot_env(1)%gnorm CALL timestop(handle) @@ -858,12 +858,12 @@ SUBROUTINE ot_diis_step(qs_ot_env) diis_m = qs_ot_env(1)%settings%diis_m IF (qs_ot_env(1)%diis_iter .LT. diis_m) THEN - diis_bound = qs_ot_env(1)%diis_iter+1 + diis_bound = qs_ot_env(1)%diis_iter + 1 ELSE diis_bound = diis_m ENDIF - j = MOD(qs_ot_env(1)%diis_iter, diis_m)+1 ! index in the circular array + j = MOD(qs_ot_env(1)%diis_iter, diis_m) + 1 ! index in the circular array ! copy the position and the error vector in the diis buffers @@ -888,7 +888,7 @@ SUBROUTINE ot_diis_step(qs_ot_env) qs_ot_env(ispin)%matrix_gx, qs_ot_env(ispin)%matrix_h_e(j)%matrix) CALL dbcsr_dot(qs_ot_env(ispin)%matrix_gx, qs_ot_env(ispin)%matrix_h_e(j)%matrix, & tmp) - qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm+tmp + qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm + tmp ENDDO IF (qs_ot_env(1)%gnorm .LT. 0.0_dp) THEN WRITE (cp_logger_get_default_unit_nr(logger), *) "WARNING Preconditioner not positive definite !" @@ -901,7 +901,7 @@ SUBROUTINE ot_diis_step(qs_ot_env) CALL dbcsr_copy(qs_ot_env(ispin)%rot_mat_h_e(j)%matrix, qs_ot_env(ispin)%rot_mat_gx) CALL dbcsr_dot(qs_ot_env(ispin)%rot_mat_gx, qs_ot_env(ispin)%rot_mat_h_e(j)%matrix, & tmp) - qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm+0.5_dp*tmp + qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm + 0.5_dp*tmp ENDDO DO ispin = 1, nspin CALL dbcsr_scale(qs_ot_env(ispin)%rot_mat_h_e(j)%matrix, -qs_ot_env(1)%ds_min) @@ -912,7 +912,7 @@ SUBROUTINE ot_diis_step(qs_ot_env) DO ispin = 1, nspin qs_ot_env(ispin)%ener_h_e(j, :) = qs_ot_env(ispin)%ener_gx(:) tmp = DOT_PRODUCT(qs_ot_env(ispin)%ener_h_e(j, :), qs_ot_env(ispin)%ener_gx(:)) - qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm+tmp + qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm + tmp qs_ot_env(ispin)%ener_h_e(j, :) = -qs_ot_env(1)%ds_min*qs_ot_env(ispin)%ener_h_e(j, :) ENDDO ENDIF @@ -921,14 +921,14 @@ SUBROUTINE ot_diis_step(qs_ot_env) IF (do_ks) THEN DO ispin = 1, nspin CALL dbcsr_dot(qs_ot_env(ispin)%matrix_gx, qs_ot_env(ispin)%matrix_gx, tmp) - qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm+tmp + qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm + tmp CALL dbcsr_add(qs_ot_env(ispin)%matrix_h_e(j)%matrix, & qs_ot_env(ispin)%matrix_gx, alpha_scalar=0.0_dp, beta_scalar=-qs_ot_env(1)%ds_min) ENDDO IF (qs_ot_env(1)%settings%do_rotation) THEN DO ispin = 1, nspin CALL dbcsr_dot(qs_ot_env(ispin)%rot_mat_gx, qs_ot_env(ispin)%rot_mat_gx, tmp) - qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm+0.5_dp*tmp + qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm + 0.5_dp*tmp CALL dbcsr_add(qs_ot_env(ispin)%rot_mat_h_e(j)%matrix, & qs_ot_env(ispin)%rot_mat_gx, alpha_scalar=0.0_dp, beta_scalar=-qs_ot_env(1)%ds_min) ENDDO @@ -937,7 +937,7 @@ SUBROUTINE ot_diis_step(qs_ot_env) IF (do_ener) THEN DO ispin = 1, nspin tmp = DOT_PRODUCT(qs_ot_env(ispin)%ener_gx(:), qs_ot_env(ispin)%ener_gx(:)) - qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm+tmp + qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm + tmp qs_ot_env(ispin)%ener_h_e(j, :) = -qs_ot_env(1)%ds_min*qs_ot_env(ispin)%ener_gx(:) ENDDO END IF @@ -949,17 +949,17 @@ SUBROUTINE ot_diis_step(qs_ot_env) CALL dbcsr_get_info(qs_ot_env(1)%matrix_x, nfullrows_total=n) DO ispin = 1, nspin CALL dbcsr_get_info(qs_ot_env(ispin)%matrix_x, nfullcols_total=itmp) - k = k+itmp + k = k + itmp ENDDO END IF IF (do_ener) THEN DO ispin = 1, nspin - nener = nener+SIZE(qs_ot_env(ispin)%ener_x) + nener = nener + SIZE(qs_ot_env(ispin)%ener_x) ENDDO ENDIF ! Handling the case of no free variables to optimize - IF (INT(n, KIND=int_8)*INT(k, KIND=int_8)+nener /= 0) THEN - qs_ot_env(1)%delta = SQRT(ABS(qs_ot_env(1)%gnorm)/(INT(n, KIND=int_8)*INT(k, KIND=int_8)+nener)) + IF (INT(n, KIND=int_8)*INT(k, KIND=int_8) + nener /= 0) THEN + qs_ot_env(1)%delta = SQRT(ABS(qs_ot_env(1)%gnorm)/(INT(n, KIND=int_8)*INT(k, KIND=int_8) + nener)) qs_ot_env(1)%gradient = -qs_ot_env(1)%gnorm ELSE qs_ot_env(1)%delta = 0.0_dp @@ -979,19 +979,19 @@ SUBROUTINE ot_diis_step(qs_ot_env) CALL dbcsr_dot(qs_ot_env(ispin)%matrix_h_e(j)%matrix, & qs_ot_env(ispin)%matrix_h_e(i)%matrix, & tmp) - qs_ot_env(1)%ls_diis(i, j) = qs_ot_env(1)%ls_diis(i, j)+tmp + qs_ot_env(1)%ls_diis(i, j) = qs_ot_env(1)%ls_diis(i, j) + tmp IF (qs_ot_env(ispin)%settings%do_rotation) THEN CALL dbcsr_dot(qs_ot_env(ispin)%rot_mat_h_e(j)%matrix, & qs_ot_env(ispin)%rot_mat_h_e(i)%matrix, & tmp) - qs_ot_env(1)%ls_diis(i, j) = qs_ot_env(1)%ls_diis(i, j)+0.5_dp*tmp + qs_ot_env(1)%ls_diis(i, j) = qs_ot_env(1)%ls_diis(i, j) + 0.5_dp*tmp ENDIF ENDDO END IF IF (do_ener) THEN DO ispin = 1, nspin tmp = DOT_PRODUCT(qs_ot_env(ispin)%ener_h_e(j, :), qs_ot_env(ispin)%ener_h_e(i, :)) - qs_ot_env(1)%ls_diis(i, j) = qs_ot_env(1)%ls_diis(i, j)+tmp + qs_ot_env(1)%ls_diis(i, j) = qs_ot_env(1)%ls_diis(i, j) + tmp ENDDO END IF ELSE @@ -1001,34 +1001,34 @@ SUBROUTINE ot_diis_step(qs_ot_env) CALL dbcsr_dot(qs_ot_env(ispin)%matrix_gx, & qs_ot_env(ispin)%matrix_h_e(i)%matrix, & tmp) - qs_ot_env(1)%ls_diis(i, j) = qs_ot_env(1)%ls_diis(i, j)-qs_ot_env(1)%ds_min*tmp + qs_ot_env(1)%ls_diis(i, j) = qs_ot_env(1)%ls_diis(i, j) - qs_ot_env(1)%ds_min*tmp IF (qs_ot_env(ispin)%settings%do_rotation) THEN CALL dbcsr_dot(qs_ot_env(ispin)%rot_mat_gx, & qs_ot_env(ispin)%rot_mat_h_e(i)%matrix, & tmp) - qs_ot_env(1)%ls_diis(i, j) = qs_ot_env(1)%ls_diis(i, j)-qs_ot_env(1)%ds_min*0.5_dp*tmp + qs_ot_env(1)%ls_diis(i, j) = qs_ot_env(1)%ls_diis(i, j) - qs_ot_env(1)%ds_min*0.5_dp*tmp ENDIF ENDDO END IF IF (do_ener) THEN DO ispin = 1, nspin tmp = DOT_PRODUCT(qs_ot_env(ispin)%ener_gx(:), qs_ot_env(ispin)%ener_h_e(i, :)) - qs_ot_env(1)%ls_diis(i, j) = qs_ot_env(1)%ls_diis(i, j)-qs_ot_env(1)%ds_min*tmp + qs_ot_env(1)%ls_diis(i, j) = qs_ot_env(1)%ls_diis(i, j) - qs_ot_env(1)%ds_min*tmp ENDDO END IF ENDIF qs_ot_env(1)%ls_diis(j, i) = qs_ot_env(1)%ls_diis(i, j) - qs_ot_env(1)%ls_diis(i, diis_bound+1) = 1.0_dp - qs_ot_env(1)%ls_diis(diis_bound+1, i) = 1.0_dp + qs_ot_env(1)%ls_diis(i, diis_bound + 1) = 1.0_dp + qs_ot_env(1)%ls_diis(diis_bound + 1, i) = 1.0_dp qs_ot_env(1)%c_diis(i) = 0.0_dp ENDDO - qs_ot_env(1)%ls_diis(diis_bound+1, diis_bound+1) = 0.0_dp - qs_ot_env(1)%c_diis(diis_bound+1) = 1.0_dp + qs_ot_env(1)%ls_diis(diis_bound + 1, diis_bound + 1) = 0.0_dp + qs_ot_env(1)%c_diis(diis_bound + 1) = 1.0_dp ! put in buffer, dgesv destroys qs_ot_env(1)%lss_diis = qs_ot_env(1)%ls_diis - CALL DGESV(diis_bound+1, 1, qs_ot_env(1)%lss_diis, diis_m+1, qs_ot_env(1)%ipivot, & - qs_ot_env(1)%c_diis, diis_m+1, info) + CALL DGESV(diis_bound + 1, 1, qs_ot_env(1)%lss_diis, diis_m + 1, qs_ot_env(1)%ipivot, & + qs_ot_env(1)%c_diis, diis_m + 1, info) IF (info .NE. 0) THEN do_ot_sd = .TRUE. @@ -1069,15 +1069,15 @@ SUBROUTINE ot_diis_step(qs_ot_env) qs_ot_env(ispin)%ener_x(:) = 0.0_dp DO i = 1, diis_bound qs_ot_env(ispin)%ener_x(:) = qs_ot_env(ispin)%ener_x(:) & - +qs_ot_env(1)%c_diis(i)*qs_ot_env(ispin)%ener_h_e(i, :) + + qs_ot_env(1)%c_diis(i)*qs_ot_env(ispin)%ener_h_e(i, :) END DO DO i = 1, diis_bound qs_ot_env(ispin)%ener_x(:) = qs_ot_env(ispin)%ener_x(:) & - +qs_ot_env(1)%c_diis(i)*qs_ot_env(ispin)%ener_h_x(i, :) + + qs_ot_env(1)%c_diis(i)*qs_ot_env(ispin)%ener_h_x(i, :) END DO ENDDO END IF - qs_ot_env(1)%diis_iter = qs_ot_env(1)%diis_iter+1 + qs_ot_env(1)%diis_iter = qs_ot_env(1)%diis_iter + 1 IF (qs_ot_env(1)%settings%safer_diis) THEN ! now, final check, is the step in fact in the direction of the -gradient ? ! if not we're walking towards a sadle point, and should avoid that @@ -1088,29 +1088,29 @@ SUBROUTINE ot_diis_step(qs_ot_env) DO ispin = 1, nspin CALL dbcsr_dot(qs_ot_env(ispin)%matrix_h_x(j)%matrix, & qs_ot_env(ispin)%matrix_gx, tmp) - tr_xold_gx = tr_xold_gx+tmp + tr_xold_gx = tr_xold_gx + tmp CALL dbcsr_dot(qs_ot_env(ispin)%matrix_x, & qs_ot_env(ispin)%matrix_gx, tmp) - tr_xnew_gx = tr_xnew_gx+tmp + tr_xnew_gx = tr_xnew_gx + tmp IF (qs_ot_env(ispin)%settings%do_rotation) THEN CALL dbcsr_dot(qs_ot_env(ispin)%rot_mat_h_x(j)%matrix, & qs_ot_env(ispin)%rot_mat_gx, tmp) - tr_xold_gx = tr_xold_gx+0.5_dp*tmp + tr_xold_gx = tr_xold_gx + 0.5_dp*tmp CALL dbcsr_dot(qs_ot_env(ispin)%rot_mat_x, & qs_ot_env(ispin)%rot_mat_gx, tmp) - tr_xnew_gx = tr_xnew_gx+0.5_dp*tmp + tr_xnew_gx = tr_xnew_gx + 0.5_dp*tmp ENDIF ENDDO END IF IF (do_ener) THEN DO ispin = 1, nspin tmp = DOT_PRODUCT(qs_ot_env(ispin)%ener_h_x(j, :), qs_ot_env(ispin)%ener_gx(:)) - tr_xold_gx = tr_xold_gx+tmp + tr_xold_gx = tr_xold_gx + tmp tmp = DOT_PRODUCT(qs_ot_env(ispin)%ener_x(:), qs_ot_env(ispin)%ener_gx(:)) - tr_xnew_gx = tr_xnew_gx+tmp + tr_xnew_gx = tr_xnew_gx + tmp ENDDO END IF - overlap = (tr_xnew_gx-tr_xold_gx) + overlap = (tr_xnew_gx - tr_xold_gx) ! OK, bad luck, take a SD step along the preconditioned gradient IF (overlap .GT. 0.0_dp) THEN do_ot_sd = .TRUE. @@ -1143,8 +1143,8 @@ SUBROUTINE ot_diis_step(qs_ot_env) IF (do_ener) THEN DO ispin = 1, nspin qs_ot_env(ispin)%ener_x(:) = 0._dp - qs_ot_env(ispin)%ener_x(:) = qs_ot_env(ispin)%ener_x(:)+qs_ot_env(ispin)%ener_h_e(j, :) - qs_ot_env(ispin)%ener_x(:) = qs_ot_env(ispin)%ener_x(:)+qs_ot_env(ispin)%ener_h_x(j, :) + qs_ot_env(ispin)%ener_x(:) = qs_ot_env(ispin)%ener_x(:) + qs_ot_env(ispin)%ener_h_e(j, :) + qs_ot_env(ispin)%ener_x(:) = qs_ot_env(ispin)%ener_x(:) + qs_ot_env(ispin)%ener_h_x(j, :) ENDDO END IF ENDIF @@ -1208,13 +1208,13 @@ SUBROUTINE ot_broyden_step(qs_ot_env) diis_m = qs_ot_env(1)%settings%diis_m IF (qs_ot_env(1)%diis_iter .LT. diis_m) THEN - diis_bound = qs_ot_env(1)%diis_iter+1 + diis_bound = qs_ot_env(1)%diis_iter + 1 ELSE diis_bound = diis_m ENDIF ! We want x:s, f:s and one random vector - k = 2*diis_bound+1 + k = 2*diis_bound + 1 ALLOCATE (S(k, k)) ALLOCATE (G(k, k)) ALLOCATE (f(k)) @@ -1226,7 +1226,7 @@ SUBROUTINE ot_broyden_step(qs_ot_env) ENDDO S = 0.0 - j = MOD(qs_ot_env(1)%diis_iter, diis_m)+1 ! index in the circular array + j = MOD(qs_ot_env(1)%diis_iter, diis_m) + 1 ! index in the circular array DO ispin = 1, nspin CALL dbcsr_copy(qs_ot_env(ispin)%matrix_h_x(j)%matrix, qs_ot_env(ispin)%matrix_x) @@ -1239,7 +1239,7 @@ SUBROUTINE ot_broyden_step(qs_ot_env) qs_ot_env(ispin)%matrix_gx, qs_ot_env(ispin)%matrix_h_e(j)%matrix) CALL dbcsr_dot(qs_ot_env(ispin)%matrix_gx, qs_ot_env(ispin)%matrix_h_e(j)%matrix, & tmp) - qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm+tmp + qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm + tmp ENDDO IF (qs_ot_env(1)%gnorm .LT. 0.0_dp) THEN WRITE (cp_logger_get_default_unit_nr(logger), *) "WARNING Preconditioner not positive definite !" @@ -1251,7 +1251,7 @@ SUBROUTINE ot_broyden_step(qs_ot_env) qs_ot_env(1)%gnorm = 0.0_dp DO ispin = 1, nspin CALL dbcsr_dot(qs_ot_env(ispin)%matrix_gx, qs_ot_env(ispin)%matrix_gx, tmp) - qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm+tmp + qs_ot_env(1)%gnorm = qs_ot_env(1)%gnorm + tmp CALL dbcsr_add(qs_ot_env(ispin)%matrix_h_e(j)%matrix, & qs_ot_env(ispin)%matrix_gx, alpha_scalar=0.0_dp, beta_scalar=-1.0_dp) ENDDO @@ -1262,7 +1262,7 @@ SUBROUTINE ot_broyden_step(qs_ot_env) CALL dbcsr_get_info(qs_ot_env(1)%matrix_x, nfullrows_total=n) DO ispin = 1, nspin CALL dbcsr_get_info(qs_ot_env(ispin)%matrix_x, nfullcols_total=itmp) - k = k+itmp + k = k + itmp ENDDO ! Handling the case of no free variables to optimize @@ -1276,7 +1276,7 @@ SUBROUTINE ot_broyden_step(qs_ot_env) IF (diis_bound == diis_m) THEN DO i = 1, diis_bound - circ_index(i) = MOD(j+i-1, diis_m)+1 + circ_index(i) = MOD(j + i - 1, diis_m) + 1 ENDDO ELSE DO i = 1, diis_bound @@ -1291,49 +1291,49 @@ SUBROUTINE ot_broyden_step(qs_ot_env) CALL dbcsr_dot( & qs_ot_env(ispin)%matrix_h_x(circ_index(i))%matrix, & qs_ot_env(ispin)%matrix_h_x(circ_index(i))%matrix, tmp) - S(i, i) = S(i, i)+tmp + S(i, i) = S(i, i) + tmp CALL dbcsr_dot( & qs_ot_env(ispin)%matrix_h_e(circ_index(i))%matrix, & qs_ot_env(ispin)%matrix_h_e(circ_index(i))%matrix, tmp) - S(i+diis_bound, i+diis_bound) = S(i+diis_bound, i+diis_bound)+tmp + S(i + diis_bound, i + diis_bound) = S(i + diis_bound, i + diis_bound) + tmp CALL dbcsr_dot( & qs_ot_env(ispin)%matrix_h_x(circ_index(i))%matrix, & qs_ot_env(ispin)%matrix_x, tmp) - S(i, 2*diis_bound+1) = S(i, 2*diis_bound+1)+tmp - S(i, 2*diis_bound+1) = S(2*diis_bound+1, i) + S(i, 2*diis_bound + 1) = S(i, 2*diis_bound + 1) + tmp + S(i, 2*diis_bound + 1) = S(2*diis_bound + 1, i) CALL dbcsr_dot( & qs_ot_env(ispin)%matrix_h_e(circ_index(i))%matrix, & qs_ot_env(ispin)%matrix_x, tmp) - S(i+diis_bound, 2*diis_bound+1) = S(i+diis_bound, 2*diis_bound+1)+tmp - S(i+diis_bound, 2*diis_bound+1) = S(2*diis_bound+1, diis_bound+i) - DO k = (i+1), diis_bound + S(i + diis_bound, 2*diis_bound + 1) = S(i + diis_bound, 2*diis_bound + 1) + tmp + S(i + diis_bound, 2*diis_bound + 1) = S(2*diis_bound + 1, diis_bound + i) + DO k = (i + 1), diis_bound CALL dbcsr_dot( & qs_ot_env(ispin)%matrix_h_x(circ_index(i))%matrix, & qs_ot_env(ispin)%matrix_h_x(circ_index(k))%matrix, & tmp) - S(i, k) = S(i, k)+tmp + S(i, k) = S(i, k) + tmp S(k, i) = S(i, k) CALL dbcsr_dot( & qs_ot_env(ispin)%matrix_h_e(circ_index(i))%matrix, & qs_ot_env(ispin)%matrix_h_e(circ_index(k))%matrix, & tmp) - S(diis_bound+i, diis_bound+k) = S(diis_bound+i, diis_bound+k)+tmp - S(diis_bound+k, diis_bound+i) = S(diis_bound+i, diis_bound+k) + S(diis_bound + i, diis_bound + k) = S(diis_bound + i, diis_bound + k) + tmp + S(diis_bound + k, diis_bound + i) = S(diis_bound + i, diis_bound + k) ENDDO DO k = 1, diis_bound CALL dbcsr_dot( & qs_ot_env(ispin)%matrix_h_x(circ_index(i))%matrix, & qs_ot_env(ispin)%matrix_h_e(circ_index(k))%matrix, tmp) - S(i, k+diis_bound) = S(i, k+diis_bound)+tmp - S(k+diis_bound, i) = S(i, k+diis_bound) + S(i, k + diis_bound) = S(i, k + diis_bound) + tmp + S(k + diis_bound, i) = S(i, k + diis_bound) ENDDO ENDDO CALL dbcsr_dot(qs_ot_env(ispin)%matrix_x, qs_ot_env(ispin)%matrix_x, tmp) - S(2*diis_bound+1, 2*diis_bound+1) = S(2*diis_bound+1, 2*diis_bound+1)+tmp + S(2*diis_bound + 1, 2*diis_bound + 1) = S(2*diis_bound + 1, 2*diis_bound + 1) + tmp ENDDO ! normalize - k = 2*diis_bound+1 + k = 2*diis_bound + 1 tmp = SQRT(S(k, k)) S(k, :) = S(k, :)/tmp S(:, k) = S(:, k)/tmp @@ -1348,24 +1348,24 @@ SUBROUTINE ot_broyden_step(qs_ot_env) qs_ot_env(ispin)%matrix_h_x(circ_index(i))%matrix, & qs_ot_env(ispin)%matrix_h_e(circ_index(i))%matrix, & tmp) - tmp2 = tmp2+tmp + tmp2 = tmp2 + tmp CALL dbcsr_dot( & - qs_ot_env(ispin)%matrix_h_x(circ_index(i-1))%matrix, & + qs_ot_env(ispin)%matrix_h_x(circ_index(i - 1))%matrix, & qs_ot_env(ispin)%matrix_h_e(circ_index(i))%matrix, & tmp) - tmp2 = tmp2-tmp + tmp2 = tmp2 - tmp CALL dbcsr_dot( & qs_ot_env(ispin)%matrix_h_x(circ_index(i))%matrix, & - qs_ot_env(ispin)%matrix_h_e(circ_index(i-1))%matrix, & + qs_ot_env(ispin)%matrix_h_e(circ_index(i - 1))%matrix, & tmp) - tmp2 = tmp2-tmp + tmp2 = tmp2 - tmp CALL dbcsr_dot( & - qs_ot_env(ispin)%matrix_h_x(circ_index(i-1))%matrix, & - qs_ot_env(ispin)%matrix_h_e(circ_index(i-1))%matrix, & + qs_ot_env(ispin)%matrix_h_x(circ_index(i - 1))%matrix, & + qs_ot_env(ispin)%matrix_h_e(circ_index(i - 1))%matrix, & tmp) - tmp2 = tmp2+tmp + tmp2 = tmp2 + tmp ENDDO - qs_ot_env(1)%c_broy(i-1) = tmp2 + qs_ot_env(1)%c_broy(i - 1) = tmp2 ENDIF qs_ot_env(1)%energy_h(j) = qs_ot_env(1)%etotal @@ -1379,7 +1379,7 @@ SUBROUTINE ot_broyden_step(qs_ot_env) CALL dbcsr_set(qs_ot_env(ispin)%matrix_x, 0.0_dp) CALL dbcsr_add(qs_ot_env(ispin)%matrix_x, & qs_ot_env(ispin)%matrix_h_x(i)%matrix, & - alpha_scalar=1.0_dp, beta_scalar=(1.0_dp-gamma)) + alpha_scalar=1.0_dp, beta_scalar=(1.0_dp - gamma)) CALL dbcsr_add(qs_ot_env(ispin)%matrix_x, & qs_ot_env(ispin)%matrix_h_x(circ_index(diis_bound))%matrix, & alpha_scalar=1.0_dp, beta_scalar=gamma) @@ -1391,28 +1391,28 @@ SUBROUTINE ot_broyden_step(qs_ot_env) x = 0.0 ! f is df_i x(i) = 1.0 - x(i-1) = -1.0 + x(i - 1) = -1.0 ! x is dx_i - f(diis_bound+i) = 1.0 - f(diis_bound+i-1) = -1.0 + f(diis_bound + i) = 1.0 + f(diis_bound + i - 1) = -1.0 tmp = 1.0_dp ! We want a pos def Hessian IF (enable_flip) THEN - IF (qs_ot_env(1)%c_broy(i-1) .GT. 0) THEN + IF (qs_ot_env(1)%c_broy(i - 1) .GT. 0) THEN !qs_ot_env(1)%OT_METHOD_FULL="OT FLIP" tmp = -1.0_dp ENDIF ENDIF ! get dx-Gdf - x(:) = tmp*x-MATMUL(G, f) + x(:) = tmp*x - MATMUL(G, f) ! dfSdf ! we calculate matmul(S, f) twice. They're small... tmp = DOT_PRODUCT(f, MATMUL(S, f)) ! NOTE THAT S IS SYMMETRIC !!! f(:) = MATMUL(S, f)/tmp ! the spread is an outer vector product - G(:, :) = G+SPREAD(x, dim=2, ncopies=SIZE(f))*SPREAD(f, dim=1, ncopies=SIZE(x)) + G(:, :) = G + SPREAD(x, dim=2, ncopies=SIZE(f))*SPREAD(f, dim=1, ncopies=SIZE(x)) ENDDO f = 0.0_dp f(2*diis_bound) = 1.0_dp @@ -1424,7 +1424,7 @@ SUBROUTINE ot_broyden_step(qs_ot_env) DO i = 1, diis_bound CALL dbcsr_add(qs_ot_env(ispin)%matrix_x, & qs_ot_env(ispin)%matrix_h_e(circ_index(i))%matrix, & - alpha_scalar=1.0_dp, beta_scalar=-x(i+diis_bound)) + alpha_scalar=1.0_dp, beta_scalar=-x(i + diis_bound)) ENDDO DO i = 1, diis_bound CALL dbcsr_add(qs_ot_env(ispin)%matrix_x, & @@ -1446,7 +1446,7 @@ SUBROUTINE ot_broyden_step(qs_ot_env) CALL dbcsr_dot(qs_ot_env(ispin)%matrix_gx, & qs_ot_env(ispin)%matrix_x, & tmp2) - tmp = tmp+tmp2 + tmp = tmp + tmp2 ENDDO DO ispin = 1, nspin @@ -1473,7 +1473,7 @@ SUBROUTINE ot_broyden_step(qs_ot_env) DEALLOCATE (S, G, f, x, circ_index) ! update for next round - qs_ot_env(1)%diis_iter = qs_ot_env(1)%diis_iter+1 + qs_ot_env(1)%diis_iter = qs_ot_env(1)%diis_iter + 1 qs_ot_env(1)%broyden_adaptive_sigma = MAX(sigma, sigma_min) END SUBROUTINE ot_broyden_step @@ -1512,7 +1512,7 @@ FUNCTION new_sigma(G, S, n) RESULT(sigma) sigma = SUM(ABS(eigv))/MAX(1, SIZE(eigv)) CASE (3) ! Estimator based on induced 2-norm - sigma = (MAXVAL(ABS(eigv))+MINVAL(ABS(eigv)))*0.5_dp + sigma = (MAXVAL(ABS(eigv)) + MINVAL(ABS(eigv)))*0.5_dp END SELECT DEALLOCATE (H, eigv) @@ -1555,7 +1555,7 @@ SUBROUTINE hess_G(G, S, H, n) v(:) = MATMUL(G, Q(:, i)) DO j = 1, i H(j, i) = DOT_PRODUCT(Q(:, j), MATMUL(S, v)) - v(:) = v-H(j, i)*Q(:, j) + v(:) = v - H(j, i)*Q(:, j) ENDDO IF (i .LT. k) THEN tmp = DOT_PRODUCT(v, MATMUL(S, v)) @@ -1569,8 +1569,8 @@ SUBROUTINE hess_G(G, S, H, n) n = i EXIT ENDIF - H(i+1, i) = tmp - Q(:, i+1) = v/H(i+1, i) + H(i + 1, i) = tmp + Q(:, i + 1) = v/H(i + 1, i) ENDIF ENDDO diff --git a/src/qs_ot_scf.F b/src/qs_ot_scf.F index be27ec04fd..6aaf62c691 100644 --- a/src/qs_ot_scf.F +++ b/src/qs_ot_scf.F @@ -230,17 +230,17 @@ SUBROUTINE ot_scf_mini(mo_array, matrix_dedc, smear, matrix_s, energy, & ! subtract the current ener_x from the diagonal CALL dbcsr_get_diag(qs_ot_env(ispin)%matrix_buf2, expectation_values(ispin)%array) - expectation_values(ispin)%array = expectation_values(ispin)%array-qs_ot_env(ispin)%ener_x + expectation_values(ispin)%array = expectation_values(ispin)%array - qs_ot_env(ispin)%ener_x CALL dbcsr_set_diag(qs_ot_env(ispin)%matrix_buf2, expectation_values(ispin)%array) ! get nondiag energy trace (D^T D) CALL dbcsr_dot(qs_ot_env(ispin)%matrix_buf2, qs_ot_env(ispin)%matrix_buf2, trace) - ener_nondiag = ener_nondiag+0.5_dp*qs_ot_env(1)%settings%nondiag_energy_strength*trace + ener_nondiag = ener_nondiag + 0.5_dp*qs_ot_env(1)%settings%nondiag_energy_strength*trace ! get gradient (again ignoring dependencies of H) IF (.NOT. energy_only) THEN ! first for the ener_x (-2*(diag(C^T H C)-ener_x)) - qs_ot_env(ispin)%ener_gx = qs_ot_env(ispin)%ener_gx- & + qs_ot_env(ispin)%ener_gx = qs_ot_env(ispin)%ener_gx - & qs_ot_env(1)%settings%nondiag_energy_strength*expectation_values(ispin)%array ! next for the rot_mat_u derivative (2 * k * \tilde H U D) @@ -270,7 +270,7 @@ SUBROUTINE ot_scf_mini(mo_array, matrix_dedc, smear, matrix_s, energy, & ENDDO ! notice we use qs_ot_env(1) for driving all output and the minimization in case of LSD - qs_ot_env(1)%etotal = energy+ener_nondiag + qs_ot_env(1)%etotal = energy + ener_nondiag CALL ot_mini(qs_ot_env, matrix_dedc_scaled) @@ -281,7 +281,7 @@ SUBROUTINE ot_scf_mini(mo_array, matrix_dedc, smear, matrix_s, energy, & DO ispin = 1, SIZE(qs_ot_env) CALL get_mo_set(mo_set=mo_array(ispin)%mo_set, mo_coeff_b=mo_coeff) CALL dbcsr_get_info(mo_coeff, nfullrows_total=n, nfullcols_total=k) - SELECT CASE (qs_ot_env (1)%settings%ot_algorithm) + SELECT CASE (qs_ot_env(1)%settings%ot_algorithm) CASE ("TOD") IF (ASSOCIATED(matrix_s)) THEN CALL dbcsr_multiply('N', 'N', 1.0_dp, matrix_s, qs_ot_env(ispin)%matrix_x, & @@ -423,7 +423,7 @@ SUBROUTINE ot_scf_init(mo_array, matrix_s, qs_ot_env, matrix_ks, broyden_adaptiv qs_ot_env(ispin)%ener_x = mo_array(ispin)%mo_set%eigenvalues ENDIF - SELECT CASE (qs_ot_env (1)%settings%ot_algorithm) + SELECT CASE (qs_ot_env(1)%settings%ot_algorithm) CASE ("TOD") ! get c CALL qs_ot_get_p(qs_ot_env(ispin)%matrix_x, qs_ot_env(ispin)%matrix_sx, qs_ot_env(ispin)) diff --git a/src/qs_ot_types.F b/src/qs_ot_types.F index d140433343..4a8340cc19 100644 --- a/src/qs_ot_types.F +++ b/src/qs_ot_types.F @@ -351,13 +351,13 @@ SUBROUTINE qs_ot_allocate(qs_ot_env, matrix_s, fm_struct_ref, ortho_k) IF (qs_ot_env%settings%ot_method .EQ. "DIIS" .OR. & qs_ot_env%settings%ot_method .EQ. "BROY") THEN - ALLOCATE (qs_ot_env%ls_diis(m_diis+1, m_diis+1)) + ALLOCATE (qs_ot_env%ls_diis(m_diis + 1, m_diis + 1)) qs_ot_env%ls_diis = 0.0_dp - ALLOCATE (qs_ot_env%lss_diis(m_diis+1, m_diis+1)) - ALLOCATE (qs_ot_env%c_diis(m_diis+1)) + ALLOCATE (qs_ot_env%lss_diis(m_diis + 1, m_diis + 1)) + ALLOCATE (qs_ot_env%c_diis(m_diis + 1)) ALLOCATE (qs_ot_env%c_broy(m_diis)) ALLOCATE (qs_ot_env%energy_h(m_diis)) - ALLOCATE (qs_ot_env%ipivot(m_diis+1)) + ALLOCATE (qs_ot_env%ipivot(m_diis + 1)) ENDIF ALLOCATE (qs_ot_env%evals(k)) diff --git a/src/qs_outer_scf.F b/src/qs_outer_scf.F index 702ec10dfb..bf018eb9f9 100644 --- a/src/qs_outer_scf.F +++ b/src/qs_outer_scf.F @@ -140,7 +140,7 @@ SUBROUTINE outer_loop_gradient(qs_env, scf_env) CPASSERT(is_constraint) scf_env%outer_scf%variables(:, ihistory) = ddapc_restraint_control%strength - scf_env%outer_scf%gradient(:, ihistory) = ddapc_restraint_control%ddapc_order_p- & + scf_env%outer_scf%gradient(:, ihistory) = ddapc_restraint_control%ddapc_order_p - & ddapc_restraint_control%target CASE (outer_scf_s2_constraint) CPASSERT(dft_control%qs_control%s2_restraint) @@ -149,14 +149,14 @@ SUBROUTINE outer_loop_gradient(qs_env, scf_env) CPASSERT(is_constraint) scf_env%outer_scf%variables(:, ihistory) = s2_restraint_control%strength - scf_env%outer_scf%gradient(:, ihistory) = s2_restraint_control%s2_order_p- & + scf_env%outer_scf%gradient(:, ihistory) = s2_restraint_control%s2_order_p - & s2_restraint_control%target CASE (outer_scf_cdft_constraint) CPASSERT(dft_control%qs_control%cdft) cdft_control => dft_control%qs_control%cdft_control DO ivar = 1, SIZE(scf_env%outer_scf%gradient, 1) scf_env%outer_scf%variables(ivar, ihistory) = cdft_control%strength(ivar) - scf_env%outer_scf%gradient(ivar, ihistory) = cdft_control%value(ivar)- & + scf_env%outer_scf%gradient(ivar, ihistory) = cdft_control%value(ivar) - & cdft_control%target(ivar) END DO CASE (outer_scf_basis_center_opt) @@ -203,7 +203,7 @@ SUBROUTINE outer_loop_optimize(scf_env, scf_control) NULLIFY (inv_jacobian) IF (scf_control%outer_scf%type == outer_scf_basis_center_opt) THEN - scf_env%outer_scf%variables(:, ihistory+1) = scf_env%outer_scf%variables(:, ihistory) + scf_env%outer_scf%variables(:, ihistory + 1) = scf_env%outer_scf%variables(:, ihistory) ELSE DO WHILE (.TRUE.) ! if we need a different run type we'll restart here @@ -215,7 +215,7 @@ SUBROUTINE outer_loop_optimize(scf_env, scf_control) ihigh = -1 interval = HUGE(interval) DO i = 1, ihistory - DO j = i+1, ihistory + DO j = i + 1, ihistory ! distrust often used points IF (scf_env%outer_scf%count(i) .GT. scf_control%outer_scf%bisect_trust_count) CYCLE IF (scf_env%outer_scf%count(j) .GT. scf_control%outer_scf%bisect_trust_count) CYCLE @@ -223,7 +223,7 @@ SUBROUTINE outer_loop_optimize(scf_env, scf_control) ! if they bracket a zero use them IF (scf_env%outer_scf%gradient(1, i)* & scf_env%outer_scf%gradient(1, j) < 0.0_dp) THEN - tmp = ABS(scf_env%outer_scf%variables(1, i)-scf_env%outer_scf%variables(1, j)) + tmp = ABS(scf_env%outer_scf%variables(1, i) - scf_env%outer_scf%variables(1, j)) IF (tmp < interval) THEN ilow = i ihigh = j @@ -236,18 +236,18 @@ SUBROUTINE outer_loop_optimize(scf_env, scf_control) optimizer_type = outer_scf_optimizer_diis CYCLE ENDIF - scf_env%outer_scf%count(ilow) = scf_env%outer_scf%count(ilow)+1 - scf_env%outer_scf%count(ihigh) = scf_env%outer_scf%count(ihigh)+1 - scf_env%outer_scf%variables(:, ihistory+1) = 0.5_dp*(scf_env%outer_scf%variables(:, ilow)+ & - scf_env%outer_scf%variables(:, ihigh)) + scf_env%outer_scf%count(ilow) = scf_env%outer_scf%count(ilow) + 1 + scf_env%outer_scf%count(ihigh) = scf_env%outer_scf%count(ihigh) + 1 + scf_env%outer_scf%variables(:, ihistory + 1) = 0.5_dp*(scf_env%outer_scf%variables(:, ilow) + & + scf_env%outer_scf%variables(:, ihigh)) CASE (outer_scf_optimizer_none) - scf_env%outer_scf%variables(:, ihistory+1) = scf_env%outer_scf%variables(:, ihistory) + scf_env%outer_scf%variables(:, ihistory + 1) = scf_env%outer_scf%variables(:, ihistory) CASE (outer_scf_optimizer_sd) ! Notice that we are just trying to find a stationary point ! e.g. the ddpac_constraint, one maximizes the function, so the stepsize might have ! to be negative - scf_env%outer_scf%variables(:, ihistory+1) = scf_env%outer_scf%variables(:, ihistory)- & - scf_control%outer_scf%step_size*scf_env%outer_scf%gradient(:, ihistory) + scf_env%outer_scf%variables(:, ihistory + 1) = scf_env%outer_scf%variables(:, ihistory) - & + scf_control%outer_scf%step_size*scf_env%outer_scf%gradient(:, ihistory) CASE (outer_scf_optimizer_diis) CPASSERT(scf_control%outer_scf%diis_buffer_length > 0) ! set up DIIS matrix @@ -256,36 +256,36 @@ SUBROUTINE outer_loop_optimize(scf_env, scf_control) optimizer_type = outer_scf_optimizer_sd CYCLE ELSE - ALLOCATE (b(nb+1, nb+1), a(nb+1, nb+1), ev(nb+1)) + ALLOCATE (b(nb + 1, nb + 1), a(nb + 1, nb + 1), ev(nb + 1)) DO I = 1, nb DO J = I, nb - ibuf = ihistory-nb+i - jbuf = ihistory-nb+j + ibuf = ihistory - nb + i + jbuf = ihistory - nb + j b(I, J) = DOT_PRODUCT(scf_env%outer_scf%gradient(:, ibuf), & scf_env%outer_scf%gradient(:, jbuf)) b(J, I) = b(I, J) ENDDO ENDDO - b(nb+1, :) = -1.0_dp - b(:, nb+1) = -1.0_dp - b(nb+1, nb+1) = 0.0_dp + b(nb + 1, :) = -1.0_dp + b(:, nb + 1) = -1.0_dp + b(nb + 1, nb + 1) = 0.0_dp CALL diamat_all(b, ev) a(:, :) = b - DO I = 1, nb+1 + DO I = 1, nb + 1 IF (ABS(ev(I)) .LT. 1.0E-12_dp) THEN a(:, I) = 0.0_dp ELSE a(:, I) = a(:, I)/ev(I) ENDIF END DO - ev(:) = -MATMUL(a, b(nb+1, :)) + ev(:) = -MATMUL(a, b(nb + 1, :)) - scf_env%outer_scf%variables(:, ihistory+1) = 0.0_dp + scf_env%outer_scf%variables(:, ihistory + 1) = 0.0_dp DO i = 1, nb - ibuf = ihistory-nb+i - scf_env%outer_scf%variables(:, ihistory+1) = scf_env%outer_scf%variables(:, ihistory+1)+ & - ev(i)*scf_env%outer_scf%variables(:, ibuf) + ibuf = ihistory - nb + i + scf_env%outer_scf%variables(:, ihistory + 1) = scf_env%outer_scf%variables(:, ihistory + 1) + & + ev(i)*scf_env%outer_scf%variables(:, ibuf) ENDDO DEALLOCATE (a, b, ev) ENDIF @@ -299,12 +299,12 @@ SUBROUTINE outer_loop_optimize(scf_env, scf_control) CYCLE END IF ! secant update - scf_env%outer_scf%variables(1, ihistory+1) = scf_env%outer_scf%variables(1, ihistory)- & - (scf_env%outer_scf%variables(1, ihistory)- & - scf_env%outer_scf%variables(1, ihistory-1))/ & - (scf_env%outer_scf%gradient(1, ihistory)- & - scf_env%outer_scf%gradient(1, ihistory-1))* & - scf_env%outer_scf%gradient(1, ihistory) + scf_env%outer_scf%variables(1, ihistory + 1) = scf_env%outer_scf%variables(1, ihistory) - & + (scf_env%outer_scf%variables(1, ihistory) - & + scf_env%outer_scf%variables(1, ihistory - 1))/ & + (scf_env%outer_scf%gradient(1, ihistory) - & + scf_env%outer_scf%gradient(1, ihistory - 1))* & + scf_env%outer_scf%gradient(1, ihistory) CASE (outer_scf_optimizer_broyden) IF (.NOT. ASSOCIATED(scf_env%outer_scf%inv_jacobian)) THEN ! Inverse Jacobian not yet built, switch to sd @@ -325,8 +325,8 @@ SUBROUTINE outer_loop_optimize(scf_env, scf_control) nvar = SIZE(scf_env%outer_scf%gradient, 1) ALLOCATE (f(nvar, 1), x(nvar, 1)) DO i = 1, nvar - f(i, 1) = scf_env%outer_scf%gradient(i, ihistory)-scf_env%outer_scf%gradient(i, ihistory-1) - x(i, 1) = scf_env%outer_scf%variables(i, ihistory)-scf_env%outer_scf%variables(i, ihistory-1) + f(i, 1) = scf_env%outer_scf%gradient(i, ihistory) - scf_env%outer_scf%gradient(i, ihistory - 1) + x(i, 1) = scf_env%outer_scf%variables(i, ihistory) - scf_env%outer_scf%variables(i, ihistory - 1) END DO SELECT CASE (scf_control%outer_scf%cdft_opt_control%broyden_type) CASE (broyden_type_1, broyden_type_1_explicit, broyden_type_1_ls, broyden_type_1_explicit_ls) @@ -336,15 +336,15 @@ SUBROUTINE outer_loop_optimize(scf_env, scf_control) scale = SUM(MATMUL(TRANSPOSE(x), MATMUL(inv_jacobian, f))) scale = 1.0_dp/scale IF (scale < 1.0E-12_dp) scale = 1.0E-12_dp - inv_jacobian = inv_jacobian+scale*MATMUL((x-MATMUL(inv_jacobian, f)), & - MATMUL(TRANSPOSE(x), inv_jacobian)) + inv_jacobian = inv_jacobian + scale*MATMUL((x - MATMUL(inv_jacobian, f)), & + MATMUL(TRANSPOSE(x), inv_jacobian)) CASE (broyden_type_2, broyden_type_2_explicit, broyden_type_2_ls, broyden_type_2_explicit_ls) ! Broyden's 2nd method ! J_(n+1)^(-1) = J_n^(-1) + (dx_n - J_n^(-1)*df_n)*(df_n^T)/(||df_n||^2) scale = SUM(MATMUL(TRANSPOSE(f), f)) scale = 1.0_dp/scale IF (scale < 1.0E-12_dp) scale = 1.0E-12_dp - inv_jacobian = inv_jacobian+scale*MATMUL((x-MATMUL(inv_jacobian, f)), TRANSPOSE(inv_jacobian)) + inv_jacobian = inv_jacobian + scale*MATMUL((x - MATMUL(inv_jacobian, f)), TRANSPOSE(inv_jacobian)) CASE DEFAULT CALL cp_abort(__LOCATION__, & "Unknown Broyden type: "// & @@ -354,16 +354,16 @@ SUBROUTINE outer_loop_optimize(scf_env, scf_control) DEALLOCATE (f, x) END IF ! Update variables x_(n+1) = x_n - J^(-1)*f(x_n) - scf_env%outer_scf%variables(:, ihistory+1) = scf_env%outer_scf%variables(:, ihistory)- & - scf_control%outer_scf%cdft_opt_control%newton_step* & - MATMUL(inv_jacobian, scf_env%outer_scf%gradient(:, ihistory)) + scf_env%outer_scf%variables(:, ihistory + 1) = scf_env%outer_scf%variables(:, ihistory) - & + scf_control%outer_scf%cdft_opt_control%newton_step* & + MATMUL(inv_jacobian, scf_env%outer_scf%gradient(:, ihistory)) scf_control%outer_scf%cdft_opt_control%broyden_update = .TRUE. CASE (outer_scf_optimizer_newton, outer_scf_optimizer_newton_ls) CPASSERT(ASSOCIATED(scf_env%outer_scf%inv_jacobian)) inv_jacobian => scf_env%outer_scf%inv_jacobian - scf_env%outer_scf%variables(:, ihistory+1) = scf_env%outer_scf%variables(:, ihistory)- & - scf_control%outer_scf%cdft_opt_control%newton_step* & - MATMUL(inv_jacobian, scf_env%outer_scf%gradient(:, ihistory)) + scf_env%outer_scf%variables(:, ihistory + 1) = scf_env%outer_scf%variables(:, ihistory) - & + scf_control%outer_scf%cdft_opt_control%newton_step* & + MATMUL(inv_jacobian, scf_env%outer_scf%gradient(:, ihistory)) CASE DEFAULT CPABORT("") END SELECT @@ -413,13 +413,13 @@ SUBROUTINE outer_loop_update_qs_env(qs_env, scf_env) is_constraint = (ddapc_restraint_control%functional_form == do_ddapc_constraint) IF (is_constraint) EXIT END DO - ddapc_restraint_control%strength = scf_env%outer_scf%variables(1, ihistory+1) + ddapc_restraint_control%strength = scf_env%outer_scf%variables(1, ihistory + 1) CASE (outer_scf_s2_constraint) s2_restraint_control => dft_control%qs_control%s2_restraint_control - s2_restraint_control%strength = scf_env%outer_scf%variables(1, ihistory+1) + s2_restraint_control%strength = scf_env%outer_scf%variables(1, ihistory + 1) CASE (outer_scf_cdft_constraint) cdft_control => dft_control%qs_control%cdft_control - cdft_control%strength(:) = scf_env%outer_scf%variables(:, ihistory+1) + cdft_control%strength(:) = scf_env%outer_scf%variables(:, ihistory + 1) CASE (outer_scf_basis_center_opt) CALL qs_update_basis_center_pos(qs_env) CASE DEFAULT @@ -468,8 +468,8 @@ SUBROUTINE outer_loop_extrapolate(qs_env) CPASSERT(nhistory > 0) ! add the current version of qs_env to the history - outer_scf_ihistory = outer_scf_ihistory+1 - ivec = 1+MODULO(outer_scf_ihistory-1, nhistory) + outer_scf_ihistory = outer_scf_ihistory + 1 + ivec = 1 + MODULO(outer_scf_ihistory - 1, nhistory) SELECT CASE (scf_control%outer_scf%type) CASE (outer_scf_none) outer_scf_history(1, ivec) = 0.0_dp @@ -497,12 +497,12 @@ SUBROUTINE outer_loop_extrapolate(qs_env) ! multilinear extrapolation nvec = MIN(nhistory, outer_scf_ihistory) alpha = nvec - ivec = 1+MODULO(outer_scf_ihistory-1, nhistory) + ivec = 1 + MODULO(outer_scf_ihistory - 1, nhistory) extrapolation(:) = alpha*outer_scf_history(:, ivec) DO ihis = 2, nvec - alpha = -1.0_dp*alpha*REAL(nvec-ihis+1, dp)/REAL(ihis, dp) - ivec = 1+MODULO(outer_scf_ihistory-ihis, nhistory) - extrapolation(:) = extrapolation+alpha*outer_scf_history(:, ivec) + alpha = -1.0_dp*alpha*REAL(nvec - ihis + 1, dp)/REAL(ihis, dp) + ivec = 1 + MODULO(outer_scf_ihistory - ihis, nhistory) + extrapolation(:) = extrapolation + alpha*outer_scf_history(:, ivec) ENDDO ! update qs_env to use this extrapolation @@ -584,19 +584,19 @@ SUBROUTINE outer_loop_switch(scf_env, scf_control, cdft_control, dir) ! Now switch IF (ASSOCIATED(scf_env%outer_scf%energy)) & DEALLOCATE (scf_env%outer_scf%energy) - ALLOCATE (scf_env%outer_scf%energy(scf_control%outer_scf%max_scf+1)) + ALLOCATE (scf_env%outer_scf%energy(scf_control%outer_scf%max_scf + 1)) scf_env%outer_scf%energy = 0.0_dp IF (ASSOCIATED(scf_env%outer_scf%variables)) & DEALLOCATE (scf_env%outer_scf%variables) - ALLOCATE (scf_env%outer_scf%variables(1, scf_control%outer_scf%max_scf+1)) + ALLOCATE (scf_env%outer_scf%variables(1, scf_control%outer_scf%max_scf + 1)) scf_env%outer_scf%variables = 0.0_dp IF (ASSOCIATED(scf_env%outer_scf%gradient)) & DEALLOCATE (scf_env%outer_scf%gradient) - ALLOCATE (scf_env%outer_scf%gradient(1, scf_control%outer_scf%max_scf+1)) + ALLOCATE (scf_env%outer_scf%gradient(1, scf_control%outer_scf%max_scf + 1)) scf_env%outer_scf%gradient = 0.0_dp IF (ASSOCIATED(scf_env%outer_scf%count)) & DEALLOCATE (scf_env%outer_scf%count) - ALLOCATE (scf_env%outer_scf%count(scf_control%outer_scf%max_scf+1)) + ALLOCATE (scf_env%outer_scf%count(scf_control%outer_scf%max_scf + 1)) scf_env%outer_scf%count = 0 ! OT SCF does not need Jacobian scf_env%outer_scf%deallocate_jacobian = .TRUE. @@ -617,19 +617,19 @@ SUBROUTINE outer_loop_switch(scf_env, scf_control, cdft_control, dir) nvariables = SIZE(cdft_control%constraint%variables, 1) IF (ASSOCIATED(scf_env%outer_scf%energy)) & DEALLOCATE (scf_env%outer_scf%energy) - ALLOCATE (scf_env%outer_scf%energy(scf_control%outer_scf%max_scf+1)) + ALLOCATE (scf_env%outer_scf%energy(scf_control%outer_scf%max_scf + 1)) scf_env%outer_scf%energy = cdft_control%constraint%energy IF (ASSOCIATED(scf_env%outer_scf%variables)) & DEALLOCATE (scf_env%outer_scf%variables) - ALLOCATE (scf_env%outer_scf%variables(nvariables, scf_control%outer_scf%max_scf+1)) + ALLOCATE (scf_env%outer_scf%variables(nvariables, scf_control%outer_scf%max_scf + 1)) scf_env%outer_scf%variables = cdft_control%constraint%variables IF (ASSOCIATED(scf_env%outer_scf%gradient)) & DEALLOCATE (scf_env%outer_scf%gradient) - ALLOCATE (scf_env%outer_scf%gradient(nvariables, scf_control%outer_scf%max_scf+1)) + ALLOCATE (scf_env%outer_scf%gradient(nvariables, scf_control%outer_scf%max_scf + 1)) scf_env%outer_scf%gradient = cdft_control%constraint%gradient IF (ASSOCIATED(scf_env%outer_scf%count)) & DEALLOCATE (scf_env%outer_scf%count) - ALLOCATE (scf_env%outer_scf%count(scf_control%outer_scf%max_scf+1)) + ALLOCATE (scf_env%outer_scf%count(scf_control%outer_scf%max_scf + 1)) scf_env%outer_scf%count = cdft_control%constraint%count scf_env%outer_scf%iter_count = cdft_control%constraint%iter_count scf_env%outer_scf%deallocate_jacobian = cdft_control%constraint%deallocate_jacobian diff --git a/src/qs_overlap.F b/src/qs_overlap.F index db6f6c258f..3657164e07 100644 --- a/src/qs_overlap.F +++ b/src/qs_overlap.F @@ -356,21 +356,21 @@ SUBROUTINE build_overlap_matrix(ks_env, matrix_s, matrixkp_s, matrix_name, & END IF trans = do_symmetric .AND. (iatom > jatom) - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) dab = SQRT(rab2) DO iset = 1, nseta ncoa = npgfa(iset)*ncoset(la_max(iset)) - n1 = npgfa(iset)*(ncoset(la_max(iset))-ncoset(la_min(iset)-1)) + n1 = npgfa(iset)*(ncoset(la_max(iset)) - ncoset(la_min(iset) - 1)) sgfa = first_sgfa(1, iset) DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE ncob = npgfb(jset)*ncoset(lb_max(jset)) - n2 = npgfb(jset)*(ncoset(lb_max(jset))-ncoset(lb_min(jset)-1)) + n2 = npgfb(jset)*(ncoset(lb_max(jset)) - ncoset(lb_min(jset) - 1)) sgfb = first_sgfb(1, jset) ! calculate integrals and derivatives @@ -398,8 +398,8 @@ SUBROUTINE build_overlap_matrix(ks_env, matrix_s, matrixkp_s, matrix_name, & trans=trans) CALL force_trace(force_a, oint(:, :, 2:4), pmat, n1, n2, 3) !$OMP CRITICAL(forceupdate) - force(ikind)%overlap(:, atom_a) = force(ikind)%overlap(:, atom_a)-ff*force_a(:) - force(jkind)%overlap(:, atom_b) = force(jkind)%overlap(:, atom_b)+ff*force_a(:) + force(ikind)%overlap(:, atom_a) = force(ikind)%overlap(:, atom_a) - ff*force_a(:) + force(jkind)%overlap(:, atom_b) = force(jkind)%overlap(:, atom_b) + ff*force_a(:) IF (use_virial) THEN CALL virial_pair_force(virial%pv_virial, -f0, force_a, rab) END IF @@ -428,7 +428,7 @@ SUBROUTINE build_overlap_matrix(ks_env, matrix_s, matrixkp_s, matrix_name, & CALL neighbor_list_iterator_release(nl_iterator) IF (do_forces .AND. use_virial) THEN - virial%pv_overlap = virial%pv_virial-pv_loc + virial%pv_overlap = virial%pv_virial - pv_loc ENDIF IF (dokp) THEN @@ -605,21 +605,21 @@ SUBROUTINE build_overlap_matrix_simple(ks_env, matrix_s, & CPASSERT(found) trans = do_symmetric .AND. (iatom > jatom) - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) dab = SQRT(rab2) DO iset = 1, nseta ncoa = npgfa(iset)*ncoset(la_max(iset)) - n1 = npgfa(iset)*(ncoset(la_max(iset))-ncoset(la_min(iset)-1)) + n1 = npgfa(iset)*(ncoset(la_max(iset)) - ncoset(la_min(iset) - 1)) sgfa = first_sgfa(1, iset) DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE ncob = npgfb(jset)*ncoset(lb_max(jset)) - n2 = npgfb(jset)*(ncoset(lb_max(jset))-ncoset(lb_min(jset)-1)) + n2 = npgfb(jset)*(ncoset(lb_max(jset)) - ncoset(lb_min(jset) - 1)) sgfb = first_sgfb(1, jset) ! calculate integrals and derivatives @@ -799,21 +799,21 @@ SUBROUTINE build_overlap_force(ks_env, force, basis_type_a, basis_type_b, & END IF trans = do_symmetric .AND. (iatom > jatom) - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) dab = SQRT(rab2) DO iset = 1, nseta ncoa = npgfa(iset)*ncoset(la_max(iset)) - n1 = npgfa(iset)*(ncoset(la_max(iset))-ncoset(la_min(iset)-1)) + n1 = npgfa(iset)*(ncoset(la_max(iset)) - ncoset(la_min(iset) - 1)) sgfa = first_sgfa(1, iset) DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE ncob = npgfb(jset)*ncoset(lb_max(jset)) - n2 = npgfb(jset)*(ncoset(lb_max(jset))-ncoset(lb_min(jset)-1)) + n2 = npgfb(jset)*(ncoset(lb_max(jset)) - ncoset(lb_min(jset) - 1)) sgfb = first_sgfb(1, jset) IF (ASSOCIATED(p_block) .AND. ((iatom /= jatom) .OR. use_virial)) THEN @@ -827,8 +827,8 @@ SUBROUTINE build_overlap_force(ks_env, force, basis_type_a, basis_type_b, & lb_max(jset), lb_min(jset), npgfb(jset), rpgfb(:, jset), zetb(:, jset), & rab, dab=drab) CALL force_trace(force_a, drab, pab, n1, n2, 3) - force(1:3, iatom) = force(1:3, iatom)-ff*force_a(1:3) - force(1:3, jatom) = force(1:3, jatom)+ff*force_a(1:3) + force(1:3, iatom) = force(1:3, iatom) - ff*force_a(1:3) + force(1:3, jatom) = force(1:3, jatom) + ff*force_a(1:3) IF (use_virial) THEN CALL virial_pair_force(virial%pv_virial, -f0, force_a, rab) END IF diff --git a/src/qs_p_env_methods.F b/src/qs_p_env_methods.F index 72f62b25c0..0fbed30641 100644 --- a/src/qs_p_env_methods.F +++ b/src/qs_p_env_methods.F @@ -166,7 +166,7 @@ SUBROUTINE p_env_create(p_env, qs_env, kpp1_env, p1_option, & p_env%ev_h0) p_env%ref_count = 1 - last_p_env_id = last_p_env_id+1 + last_p_env_id = last_p_env_id + 1 p_env%id_nr = last_p_env_id p_env%iter = 0 @@ -407,7 +407,7 @@ SUBROUTINE p_env_psi0_changed(p_env, qs_env, psi0, Hrho_psi0d) CALL qs_rho_get(rho, rho_ao=rho_ao) n_spins = dft_control%nspins - p_env%iter = p_env%iter+1 + p_env%iter = p_env%iter + 1 CALL mpools_get(qs_env%mpools, & ao_mo_fm_pools=ao_mo_fm_pools) ! def my_psi0 @@ -715,7 +715,7 @@ SUBROUTINE p_op_l2(p_env, qs_env, p1, res, alpha, beta) my_beta = 0.0_dp IF (PRESENT(beta)) my_beta = beta - iter = iter+1 + iter = iter + 1 CPASSERT(ASSOCIATED(p_env)) CPASSERT(p_env%ref_count > 0) diff --git a/src/qs_p_env_types.F b/src/qs_p_env_types.F index 4d9d42f770..aee70f2c13 100644 --- a/src/qs_p_env_types.F +++ b/src/qs_p_env_types.F @@ -116,7 +116,7 @@ SUBROUTINE p_env_retain(p_env) CPASSERT(ASSOCIATED(p_env)) CPASSERT(p_env%ref_count > 0) - p_env%ref_count = p_env%ref_count+1 + p_env%ref_count = p_env%ref_count + 1 END SUBROUTINE p_env_retain ! ************************************************************************************************** @@ -136,7 +136,7 @@ SUBROUTINE p_env_release(p_env) IF (ASSOCIATED(p_env)) THEN CPASSERT(p_env%ref_count > 0) - p_env%ref_count = p_env%ref_count-1 + p_env%ref_count = p_env%ref_count - 1 IF (p_env%ref_count < 1) THEN CALL kpp1_release(p_env%kpp1_env) CALL cp_fm_vect_dealloc(p_env%S_psi0) diff --git a/src/qs_pdos.F b/src/qs_pdos.F index 59514c2e30..0acfd9e0fe 100644 --- a/src/qs_pdos.F +++ b/src/qs_pdos.F @@ -233,11 +233,11 @@ SUBROUTINE calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particl ncol_global=ncol_global) CALL section_vals_val_get(dft_section, "PRINT%PDOS%OUT_EACH_MO", i_val=out_each) - IF (out_each == -1) out_each = nao+1 + IF (out_each == -1) out_each = nao + 1 CALL section_vals_val_get(dft_section, "PRINT%PDOS%NLUMO", i_val=nlumo) - IF (nlumo == -1) nlumo = nao-homo - do_virt = (nlumo > (nmo-homo)) - nvirt = nlumo-(nmo-homo) + IF (nlumo == -1) nlumo = nao - homo + do_virt = (nlumo > (nmo - homo)) + nvirt = nlumo - (nmo - homo) ! Generate virtual orbitals IF (do_virt) THEN IF (PRESENT(ispin)) THEN @@ -314,11 +314,11 @@ SUBROUTINE calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particl CALL section_vals_val_get(ldos_section, "LIST", i_rep_section=ildos, i_rep_val=ir, & i_vals=list) IF (ASSOCIATED(list)) THEN - CALL reallocate(ldos_p(ildos)%ldos%list_index, 1, ldos_p(ildos)%ldos%nlist+SIZE(list)) + CALL reallocate(ldos_p(ildos)%ldos%list_index, 1, ldos_p(ildos)%ldos%nlist + SIZE(list)) DO i = 1, SIZE(list) - ldos_p(ildos)%ldos%list_index(i+ldos_p(ildos)%ldos%nlist) = list(i) + ldos_p(ildos)%ldos%list_index(i + ldos_p(ildos)%ldos%nlist) = list(i) END DO - ldos_p(ildos)%ldos%nlist = ldos_p(ildos)%ldos%nlist+SIZE(list) + ldos_p(ildos)%ldos%nlist = ldos_p(ildos)%ldos%nlist + SIZE(list) END IF END DO ELSE @@ -330,9 +330,9 @@ SUBROUTINE calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particl CALL section_vals_val_get(ldos_section, "COMPONENTS", i_rep_section=ildos, & l_val=ldos_p(ildos)%ldos%separate_components) IF (ldos_p(ildos)%ldos%separate_components) THEN - ALLOCATE (ldos_p(ildos)%ldos%pdos_array(nsoset(maxlgto), nmo+nvirt)) + ALLOCATE (ldos_p(ildos)%ldos%pdos_array(nsoset(maxlgto), nmo + nvirt)) ELSE - ALLOCATE (ldos_p(ildos)%ldos%pdos_array(0:maxlgto, nmo+nvirt)) + ALLOCATE (ldos_p(ildos)%ldos%pdos_array(0:maxlgto, nmo + nvirt)) END IF ldos_p(ildos)%ldos%pdos_array = 0.0_dp ldos_p(ildos)%ldos%maxl = -1 @@ -377,18 +377,18 @@ SUBROUTINE calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particl CALL section_vals_val_get(ldos_section, "LIST", i_rep_section=ildos, i_rep_val=ir, & i_vals=list) IF (ASSOCIATED(list)) THEN - CALL reallocate(r_ldos_p(ildos)%ldos%list_index, 1, r_ldos_p(ildos)%ldos%nlist+SIZE(list)) + CALL reallocate(r_ldos_p(ildos)%ldos%list_index, 1, r_ldos_p(ildos)%ldos%nlist + SIZE(list)) DO i = 1, SIZE(list) - r_ldos_p(ildos)%ldos%list_index(i+r_ldos_p(ildos)%ldos%nlist) = list(i) + r_ldos_p(ildos)%ldos%list_index(i + r_ldos_p(ildos)%ldos%nlist) = list(i) END DO - r_ldos_p(ildos)%ldos%nlist = r_ldos_p(ildos)%ldos%nlist+SIZE(list) + r_ldos_p(ildos)%ldos%nlist = r_ldos_p(ildos)%ldos%nlist + SIZE(list) END IF END DO ELSE ! stop, LDOS without list of atoms is not implemented END IF - ALLOCATE (r_ldos_p(ildos)%ldos%pdos_array(nmo+nvirt)) + ALLOCATE (r_ldos_p(ildos)%ldos%pdos_array(nmo + nvirt)) r_ldos_p(ildos)%ldos%pdos_array = 0.0_dp read_r(1:3, ildos) = .FALSE. CALL section_vals_val_get(ldos_section, "XRANGE", i_rep_section=ildos, explicit=read_r(1, ildos)) @@ -437,12 +437,12 @@ SUBROUTINE calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particl DO jy = bo(1, 2), bo(2, 2) DO jx = bo(1, 1), bo(2, 1) !compute the position of the grid point - i = jx-wf_r%pw%pw_grid%bounds(1, 1) - j = jy-wf_r%pw%pw_grid%bounds(1, 2) - k = jz-wf_r%pw%pw_grid%bounds(1, 3) - r(3) = k*dh(3, 3)+j*dh(3, 2)+i*dh(3, 1) - r(2) = k*dh(2, 3)+j*dh(2, 2)+i*dh(2, 1) - r(1) = k*dh(1, 3)+j*dh(1, 2)+i*dh(1, 1) + i = jx - wf_r%pw%pw_grid%bounds(1, 1) + j = jy - wf_r%pw%pw_grid%bounds(1, 2) + k = jz - wf_r%pw%pw_grid%bounds(1, 3) + r(3) = k*dh(3, 3) + j*dh(3, 2) + i*dh(3, 1) + r(2) = k*dh(2, 3) + j*dh(2, 2) + i*dh(2, 1) + r(1) = k*dh(1, 3) + j*dh(1, 2) + i*dh(1, 1) DO il = 1, r_ldos_p(ildos)%ldos%nlist iatom = r_ldos_p(ildos)%ldos%list_index(il) @@ -482,7 +482,7 @@ SUBROUTINE calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particl in_z = 1 END IF IF (in_x*in_y*in_z > 0) THEN - r_ldos_p(ildos)%ldos%npoints = r_ldos_p(ildos)%ldos%npoints+1 + r_ldos_p(ildos)%ldos%npoints = r_ldos_p(ildos)%ldos%npoints + 1 r_ldos_p(ildos)%ldos%index_grid_local(1, r_ldos_p(ildos)%ldos%npoints) = jx r_ldos_p(ildos)%ldos%index_grid_local(2, r_ldos_p(ildos)%ldos%npoints) = jy r_ldos_p(ildos)%ldos%index_grid_local(3, r_ldos_p(ildos)%ldos%npoints) = jz @@ -502,15 +502,15 @@ SUBROUTINE calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particl CALL section_vals_val_get(dft_section, "PRINT%PDOS%COMPONENTS", l_val=separate_components) IF (separate_components) THEN - ALLOCATE (pdos_array(nsoset(maxlgto), nkind, nmo+nvirt)) + ALLOCATE (pdos_array(nsoset(maxlgto), nkind, nmo + nvirt)) ELSE - ALLOCATE (pdos_array(0:maxlgto, nkind, nmo+nvirt)) + ALLOCATE (pdos_array(0:maxlgto, nkind, nmo + nvirt)) END IF IF (do_virt) THEN - ALLOCATE (eigenvalues(nmo+nvirt)) + ALLOCATE (eigenvalues(nmo + nvirt)) eigenvalues(1:nmo) = mo_set%eigenvalues(1:nmo) - eigenvalues(nmo+1:nmo+nvirt) = evals_virt(1:nvirt) - ALLOCATE (occupation_numbers(nmo+nvirt)) + eigenvalues(nmo + 1:nmo + nvirt) = evals_virt(1:nvirt) + ALLOCATE (occupation_numbers(nmo + nvirt)) occupation_numbers(:) = 0.0_dp occupation_numbers(1:nmo) = mo_set%occupation_numbers(1:nmo) ELSE @@ -529,20 +529,20 @@ SUBROUTINE calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particl DO ildos = 1, n_r_ldos IF (eigenvalues(1) > r_ldos_p(ildos)%ldos%eval_range(1)) & r_ldos_p(ildos)%ldos%eval_range(1) = eigenvalues(1) - IF (eigenvalues(nmo+nvirt) < r_ldos_p(ildos)%ldos%eval_range(2)) & - r_ldos_p(ildos)%ldos%eval_range(2) = eigenvalues(nmo+nvirt) + IF (eigenvalues(nmo + nvirt) < r_ldos_p(ildos)%ldos%eval_range(2)) & + r_ldos_p(ildos)%ldos%eval_range(2) = eigenvalues(nmo + nvirt) END DO IF (output_unit > 0) WRITE (UNIT=output_unit, FMT='(/,(T15,A))') & "---- PDOS: start iteration on the KS states --- " - DO imo = 1, nmo+nvirt + DO imo = 1, nmo + nvirt IF (output_unit > 0 .AND. MOD(imo, out_each) == 0) WRITE (UNIT=output_unit, FMT='((T20,A,I10))') & " KS state index : ", imo ! Extract the eigenvector from the distributed full matrix IF (imo > nmo) THEN - CALL cp_fm_get_submatrix(matrix_work, vecbuffer, 1, imo-nmo, & + CALL cp_fm_get_submatrix(matrix_work, vecbuffer, 1, imo - nmo, & nao, 1, transpose=.TRUE.) ELSE CALL cp_fm_get_submatrix(matrix_shalfc, vecbuffer, 1, imo, & @@ -566,11 +566,11 @@ SUBROUTINE calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particl DO ishell = 1, nshell(iset) lshell = l(ishell, iset) DO iso = 1, nso(lshell) - lcomponent = nsoset(lshell-1)+iso + lcomponent = nsoset(lshell - 1) + iso pdos_array(lcomponent, ikind, imo) = & - pdos_array(lcomponent, ikind, imo)+ & + pdos_array(lcomponent, ikind, imo) + & vecbuffer(1, irow)*vecbuffer(1, irow) - irow = irow+1 + irow = irow + 1 END DO ! iso END DO ! ishell END DO ! iset @@ -581,9 +581,9 @@ SUBROUTINE calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particl lshell = l(ishell, iset) DO iso = 1, nso(lshell) pdos_array(lshell, ikind, imo) = & - pdos_array(lshell, ikind, imo)+ & + pdos_array(lshell, ikind, imo) + & vecbuffer(1, irow)*vecbuffer(1, irow) - irow = irow+1 + irow = irow + 1 END DO ! iso END DO ! ishell END DO ! iset @@ -611,11 +611,11 @@ SUBROUTINE calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particl DO ishell = 1, nshell(iset) lshell = l(ishell, iset) DO iso = 1, nso(lshell) - lcomponent = nsoset(lshell-1)+iso + lcomponent = nsoset(lshell - 1) + iso ldos_p(ildos)%ldos%pdos_array(lcomponent, imo) = & - ldos_p(ildos)%ldos%pdos_array(lcomponent, imo)+ & + ldos_p(ildos)%ldos%pdos_array(lcomponent, imo) + & vecbuffer(1, irow)*vecbuffer(1, irow) - irow = irow+1 + irow = irow + 1 END DO ! iso END DO ! ishell END DO ! iset @@ -626,9 +626,9 @@ SUBROUTINE calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particl lshell = l(ishell, iset) DO iso = 1, nso(lshell) ldos_p(ildos)%ldos%pdos_array(lshell, imo) = & - ldos_p(ildos)%ldos%pdos_array(lshell, imo)+ & + ldos_p(ildos)%ldos%pdos_array(lshell, imo) + & vecbuffer(1, irow)*vecbuffer(1, irow) - irow = irow+1 + irow = irow + 1 END DO ! iso END DO ! ishell END DO ! iset @@ -642,7 +642,7 @@ SUBROUTINE calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particl r_ldos_p(ildos)%ldos%eval_range(2) >= eigenvalues(imo)) THEN IF (imo > nmo) THEN - CALL calculate_wavefunction(mo_virt, imo-nmo, & + CALL calculate_wavefunction(mo_virt, imo - nmo, & wf_r, wf_g, atomic_kind_set, qs_kind_set, cell, dft_control, particle_set, & pw_env) ELSE @@ -652,11 +652,11 @@ SUBROUTINE calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particl END IF r_ldos_p(ildos)%ldos%pdos_array(imo) = 0.0_dp DO il = 1, r_ldos_p(ildos)%ldos%npoints - j = j+1 + j = j + 1 jx = r_ldos_p(ildos)%ldos%index_grid_local(1, il) jy = r_ldos_p(ildos)%ldos%index_grid_local(2, il) jz = r_ldos_p(ildos)%ldos%index_grid_local(3, il) - r_ldos_p(ildos)%ldos%pdos_array(imo) = r_ldos_p(ildos)%ldos%pdos_array(imo)+ & + r_ldos_p(ildos)%ldos%pdos_array(imo) = r_ldos_p(ildos)%ldos%pdos_array(imo) + & wf_r%pw%cr3d(jx, jy, jz)*wf_r%pw%cr3d(jx, jy, jz) END DO r_ldos_p(ildos)%ldos%pdos_array(imo) = r_ldos_p(ildos)%ldos%pdos_array(imo)*dvol @@ -707,8 +707,8 @@ SUBROUTINE calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particl WRITE (UNIT=fmtstr1(15:16), FMT="(I2)") nsoset(maxl) WRITE (UNIT=fmtstr2(6:7), FMT="(I2)") nsoset(maxl) ELSE - WRITE (UNIT=fmtstr1(15:16), FMT="(I2)") maxl+1 - WRITE (UNIT=fmtstr2(6:7), FMT="(I2)") maxl+1 + WRITE (UNIT=fmtstr1(15:16), FMT="(I2)") maxl + 1 + WRITE (UNIT=fmtstr2(6:7), FMT="(I2)") maxl + 1 END IF WRITE (UNIT=iw, FMT="(A,I0,A,F12.6,A)") & @@ -726,7 +726,7 @@ SUBROUTINE calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particl WRITE (UNIT=iw, FMT=fmtstr2) & "# MO Eigenvalue [a.u.] Occupation", & ((TRIM(tmp_str(0, il, im)), im=-il, il), il=0, maxl) - DO imo = 1, nmo+nvirt + DO imo = 1, nmo + nvirt WRITE (UNIT=iw, FMT=fmtstr1) imo, eigenvalues(imo), occupation_numbers(imo), & (pdos_array(lshell, ikind, imo), lshell=1, nsoset(maxl)) END DO @@ -735,7 +735,7 @@ SUBROUTINE calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particl WRITE (UNIT=iw, FMT=fmtstr2) & "# MO Eigenvalue [a.u.] Occupation", & (TRIM(l_sym(il)), il=0, maxl) - DO imo = 1, nmo+nvirt + DO imo = 1, nmo + nvirt WRITE (UNIT=iw, FMT=fmtstr1) imo, eigenvalues(imo), occupation_numbers(imo), & (pdos_array(lshell, ikind, imo), lshell=0, maxl) END DO @@ -775,8 +775,8 @@ SUBROUTINE calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particl WRITE (UNIT=fmtstr1(15:16), FMT="(I2)") nsoset(ldos_p(ildos)%ldos%maxl) WRITE (UNIT=fmtstr2(6:7), FMT="(I2)") nsoset(ldos_p(ildos)%ldos%maxl) ELSE - WRITE (UNIT=fmtstr1(15:16), FMT="(I2)") ldos_p(ildos)%ldos%maxl+1 - WRITE (UNIT=fmtstr2(6:7), FMT="(I2)") ldos_p(ildos)%ldos%maxl+1 + WRITE (UNIT=fmtstr1(15:16), FMT="(I2)") ldos_p(ildos)%ldos%maxl + 1 + WRITE (UNIT=fmtstr2(6:7), FMT="(I2)") ldos_p(ildos)%ldos%maxl + 1 END IF WRITE (UNIT=iw, FMT="(A,I0,A,I0,A,I0,A,F12.6,A)") & @@ -795,7 +795,7 @@ SUBROUTINE calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particl WRITE (UNIT=iw, FMT=fmtstr2) & "# MO Eigenvalue [a.u.] Occupation", & ((TRIM(tmp_str(0, il, im)), im=-il, il), il=0, ldos_p(ildos)%ldos%maxl) - DO imo = 1, nmo+nvirt + DO imo = 1, nmo + nvirt WRITE (UNIT=iw, FMT=fmtstr1) imo, eigenvalues(imo), occupation_numbers(imo), & (ldos_p(ildos)%ldos%pdos_array(lshell, imo), lshell=1, nsoset(ldos_p(ildos)%ldos%maxl)) END DO @@ -804,7 +804,7 @@ SUBROUTINE calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particl WRITE (UNIT=iw, FMT=fmtstr2) & "# MO Eigenvalue [a.u.] Occupation", & (TRIM(l_sym(il)), il=0, ldos_p(ildos)%ldos%maxl) - DO imo = 1, nmo+nvirt + DO imo = 1, nmo + nvirt WRITE (UNIT=iw, FMT=fmtstr1) imo, eigenvalues(imo), occupation_numbers(imo), & (ldos_p(ildos)%ldos%pdos_array(lshell, imo), lshell=0, ldos_p(ildos)%ldos%maxl) END DO @@ -848,7 +848,7 @@ SUBROUTINE calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particl " Hartree, E(Fermi) = ", e_fermi, " a.u." WRITE (UNIT=iw, FMT="(A)") & "# MO Eigenvalue [a.u.] Occupation LDOS" - DO imo = 1, nmo+nvirt + DO imo = 1, nmo + nvirt IF (r_ldos_p(ildos)%ldos%eval_range(1) <= eigenvalues(imo) .AND. & r_ldos_p(ildos)%ldos%eval_range(2) >= eigenvalues(imo)) THEN WRITE (UNIT=iw, FMT="(I8,2X,2F16.6,E20.10,E20.10)") imo, eigenvalues(imo), occupation_numbers(imo), & diff --git a/src/qs_resp.F b/src/qs_resp.F index b7bd6dc1c7..94412ea835 100644 --- a/src/qs_resp.F +++ b/src/qs_resp.F @@ -184,7 +184,7 @@ SUBROUTINE resp_fit(qs_env) CALL qs_subsys_get(subsys, particles=particles) natom = particles%n_els - nvar = natom+resp_env%ncons + nvar = natom + resp_env%ncons CALL resp_allocate(resp_env, natom, nvar) ALLOCATE (ipiv(nvar)) @@ -224,7 +224,7 @@ SUBROUTINE resp_fit(qs_env) CALL DGETRS('N', nvar, 1, resp_env%matrix, nvar, ipiv, resp_env%rhs, nvar, info) CPASSERT(info == 0) - IF (resp_env%use_repeat_method) resp_env%offset = resp_env%rhs(natom+1) + IF (resp_env%use_repeat_method) resp_env%offset = resp_env%rhs(natom + 1) CALL print_resp_charges(qs_env, resp_env, output_unit, natom) CALL print_fitting_points(qs_env, resp_env) CALL print_pot_from_resp_charges(qs_env, resp_env, particles, natom, output_unit) @@ -402,7 +402,7 @@ SUBROUTINE init_resp(resp_env, rep_sys, subsys, atomic_kind_set, & ! get the general keywords CALL section_vals_val_get(resp_section, "INTEGER_TOTAL_CHARGE", & l_val=resp_env%itc) - IF (resp_env%itc) resp_env%ncons = resp_env%ncons+1 + IF (resp_env%itc) resp_env%ncons = resp_env%ncons + 1 CALL section_vals_val_get(resp_section, "RESTRAIN_HEAVIES_TO_ZERO", & l_val=resp_env%rheavies) @@ -427,7 +427,7 @@ SUBROUTINE init_resp(resp_env, rep_sys, subsys, atomic_kind_set, & CALL section_vals_val_get(resp_section, "USE_REPEAT_METHOD", & l_val=resp_env%use_repeat_method) IF (resp_env%use_repeat_method) THEN - resp_env%ncons = resp_env%ncons+1 + resp_env%ncons = resp_env%ncons + 1 ! restrain heavies should be off resp_env%rheavies = .FALSE. END IF @@ -476,7 +476,7 @@ SUBROUTINE init_resp(resp_env, rep_sys, subsys, atomic_kind_set, & IF (.NOT. explicit) CYCLE CALL build_atom_list(cons_section, subsys, atom_list_cons, i) !instead of using EQUAL_CHARGES the constraint sections could be repeated - resp_env%ncons = resp_env%ncons+SIZE(atom_list_cons)-2 + resp_env%ncons = resp_env%ncons + SIZE(atom_list_cons) - 2 DEALLOCATE (atom_list_cons) END DO END IF @@ -484,8 +484,8 @@ SUBROUTINE init_resp(resp_env, rep_sys, subsys, atomic_kind_set, & IF (explicit) THEN CALL section_vals_get(rest_section, n_repetition=resp_env%nrest_sec) END IF - resp_env%ncons = resp_env%ncons+resp_env%ncons_sec - resp_env%nres = resp_env%nres+resp_env%nrest_sec + resp_env%ncons = resp_env%ncons + resp_env%ncons_sec + resp_env%nres = resp_env%nres + resp_env%nrest_sec CALL timestop(handle) @@ -632,11 +632,11 @@ SUBROUTINE get_parameter_molecular_sys(resp_env, sphere_section, cell, & element_symbol=symbol, & kind_number=kind_number) IF (.NOT. rmin_is_set(kind_number)) THEN - n_rmin_missing = n_rmin_missing+1 + n_rmin_missing = n_rmin_missing + 1 missing_rmin = TRIM(missing_rmin)//" "//TRIM(symbol)//"," END IF IF (.NOT. rmax_is_set(kind_number)) THEN - n_rmax_missing = n_rmax_missing+1 + n_rmax_missing = n_rmax_missing + 1 missing_rmax = TRIM(missing_rmax)//" "//TRIM(symbol)//"," END IF END DO @@ -723,7 +723,7 @@ SUBROUTINE build_atom_list(section, subsys, atom_list, rep) DO i = 1, n_var CALL section_vals_val_get(section, "ATOM_LIST", i_rep_section=irep, & i_rep_val=i, i_vals=indexes) - num_atom = num_atom+SIZE(indexes) + num_atom = num_atom + SIZE(indexes) ENDDO ALLOCATE (atom_list(num_atom)) atom_list = 0 @@ -731,18 +731,18 @@ SUBROUTINE build_atom_list(section, subsys, atom_list, rep) DO i = 1, n_var CALL section_vals_val_get(section, "ATOM_LIST", i_rep_section=irep, & i_rep_val=i, i_vals=indexes) - atom_list(num_atom:num_atom+SIZE(indexes)-1) = indexes(:) - num_atom = num_atom+SIZE(indexes) + atom_list(num_atom:num_atom + SIZE(indexes) - 1) = indexes(:) + num_atom = num_atom + SIZE(indexes) ENDDO !check atom list - num_atom = num_atom-1 + num_atom = num_atom - 1 CALL qs_subsys_get(subsys, nparticle=max_index) CPASSERT(SIZE(atom_list) /= 0) index_in_range = (MAXVAL(atom_list) <= max_index) & .AND. (MINVAL(atom_list) > 0) CPASSERT(index_in_range) DO i = 1, num_atom - DO j = i+1, num_atom + DO j = i + 1, num_atom atom_a = atom_list(i) atom_b = atom_list(j) IF (atom_a == atom_b) & @@ -839,22 +839,22 @@ SUBROUTINE calc_resp_matrix_nonper(qs_env, resp_env, atomic_kind_set, particles, IF (.NOT. (MODULO(jy, resp_env%stride(2)) == 0)) CYCLE IF (.NOT. (MODULO(jx, resp_env%stride(1)) == 0)) CYCLE !bounds bo reach from -np/2 to np/2. shift of np/2 so that r(1,1,1)=(0,0,0) - l = jx-gbo(1, 1) - k = jy-gbo(1, 2) - p = jz-gbo(1, 3) - r(3) = p*dh(3, 3)+k*dh(3, 2)+l*dh(3, 1) - r(2) = p*dh(2, 3)+k*dh(2, 2)+l*dh(2, 1) - r(1) = p*dh(1, 3)+k*dh(1, 2)+l*dh(1, 1) + l = jx - gbo(1, 1) + k = jy - gbo(1, 2) + p = jz - gbo(1, 3) + r(3) = p*dh(3, 3) + k*dh(3, 2) + l*dh(3, 1) + r(2) = p*dh(2, 3) + k*dh(2, 2) + l*dh(2, 1) + r(1) = p*dh(1, 3) + k*dh(1, 2) + l*dh(1, 1) IF (r(3) < resp_env%box_low(3) .OR. r(3) > resp_env%box_hi(3)) CYCLE IF (r(2) < resp_env%box_low(2) .OR. r(2) > resp_env%box_hi(2)) CYCLE IF (r(1) < resp_env%box_low(1) .OR. r(1) > resp_env%box_hi(1)) CYCLE ! compute distance from the grid point to all atoms not_in_range = .FALSE. DO i = 1, natom - vec = r-particles%els(i)%r - vec_pbc(1) = vec(1)-hmat(1, 1)*ANINT(hmat_inv(1, 1)*vec(1)) - vec_pbc(2) = vec(2)-hmat(2, 2)*ANINT(hmat_inv(2, 2)*vec(2)) - vec_pbc(3) = vec(3)-hmat(3, 3)*ANINT(hmat_inv(3, 3)*vec(3)) + vec = r - particles%els(i)%r + vec_pbc(1) = vec(1) - hmat(1, 1)*ANINT(hmat_inv(1, 1)*vec(1)) + vec_pbc(2) = vec(2) - hmat(2, 2)*ANINT(hmat_inv(2, 2)*vec(2)) + vec_pbc(3) = vec(3) - hmat(3, 3)*ANINT(hmat_inv(3, 3)*vec(3)) dist(i) = SQRT(SUM(vec_pbc**2)) CALL get_atomic_kind(atomic_kind=particle_set(i)%atomic_kind, & kind_number=kind_number) @@ -865,13 +865,13 @@ SUBROUTINE calc_resp_matrix_nonper(qs_env, resp_env, atomic_kind_set, particles, EXIT ENDIF ENDDO - IF (dist(i) < rmin+delta) not_in_range(i, 1) = .TRUE. - IF (dist(i) > rmax-delta) not_in_range(i, 2) = .TRUE. + IF (dist(i) < rmin + delta) not_in_range(i, 1) = .TRUE. + IF (dist(i) > rmax - delta) not_in_range(i, 2) = .TRUE. ENDDO ! check if the point is sufficiently close and far. if OK, we can use ! the point for fitting, add/subtract 1.0E-13 to get rid of rounding errors when shifting atoms IF (ANY(not_in_range(:, 1)) .OR. ALL(not_in_range(:, 2))) CYCLE - resp_env%npoints_proc = resp_env%npoints_proc+1 + resp_env%npoints_proc = resp_env%npoints_proc + 1 IF (resp_env%npoints_proc > now) THEN now = 2*now CALL reallocate(resp_env%fitpoints, 1, 3, 1, now) @@ -882,7 +882,7 @@ SUBROUTINE calc_resp_matrix_nonper(qs_env, resp_env, atomic_kind_set, particles, ! correct for the fact that v_hartree is scaled by dvol, and has the opposite sign IF (qs_env%qmmm) THEN ! If it's a QM/MM run let's remove the contribution of the MM potential out of the Hartree pot - vj = -v_hartree_pw%cr3d(jx, jy, jz)/dvol+qs_env%ks_qmmm_env%v_qmmm_rspace%pw%cr3d(jx, jy, jz) + vj = -v_hartree_pw%cr3d(jx, jy, jz)/dvol + qs_env%ks_qmmm_env%v_qmmm_rspace%pw%cr3d(jx, jy, jz) ELSE vj = -v_hartree_pw%cr3d(jx, jy, jz)/dvol END IF @@ -890,9 +890,9 @@ SUBROUTINE calc_resp_matrix_nonper(qs_env, resp_env, atomic_kind_set, particles, DO i = 1, natom DO m = 1, natom - matrix(m, i) = matrix(m, i)+2.0_dp*dist(i)*dist(m) + matrix(m, i) = matrix(m, i) + 2.0_dp*dist(i)*dist(m) ENDDO - rhs(i) = rhs(i)+2.0_dp*vj*dist(i) + rhs(i) = rhs(i) + 2.0_dp*vj*dist(i) ENDDO ENDDO ENDDO @@ -1005,7 +1005,7 @@ SUBROUTINE calc_resp_matrix_periodic(qs_env, resp_env, rep_sys, particles, cell, DO i = 1, natom DO j = 1, natom ! calculate matrix - resp_env%matrix(i, j) = resp_env%matrix(i, j)+2.0_dp*SUM(vpot(:, i)*vpot(:, j)) + resp_env%matrix(i, j) = resp_env%matrix(i, j) + 2.0_dp*SUM(vpot(:, i)*vpot(:, j)) ENDDO ! calculate vector resp_env%rhs CALL calculate_rhs(qs_env, resp_env, resp_env%rhs(i), vpot(:, i)) @@ -1100,12 +1100,12 @@ SUBROUTINE get_fitting_points(qs_env, resp_env, rep_sys, particles, cell) DO jx = bo(1, 1), bo(2, 1) IF (.NOT. (MODULO(jx, resp_env%stride(1)) == 0)) CYCLE !bounds gbo reach from -np/2 to np/2. shift of np/2 so that r(1,1,1)=(0,0,0) - l = jx-gbo(1, 1) - k = jy-gbo(1, 2) - p = jz-gbo(1, 3) - r(3) = p*dh(3, 3)+k*dh(3, 2)+l*dh(3, 1) - r(2) = p*dh(2, 3)+k*dh(2, 2)+l*dh(2, 1) - r(1) = p*dh(1, 3)+k*dh(1, 2)+l*dh(1, 1) + l = jx - gbo(1, 1) + k = jy - gbo(1, 2) + p = jz - gbo(1, 3) + r(3) = p*dh(3, 3) + k*dh(3, 2) + l*dh(3, 1) + r(2) = p*dh(2, 3) + k*dh(2, 2) + l*dh(2, 1) + r(1) = p*dh(1, 3) + k*dh(1, 2) + l*dh(1, 1) IF (resp_env%molecular_sys) THEN not_in_range = .FALSE. DO m = 1, natom @@ -1120,8 +1120,8 @@ SUBROUTINE get_fitting_points(qs_env, resp_env, rep_sys, particles, cell) EXIT ENDIF ENDDO - IF (dist(m) < rmin+delta) not_in_range(m, 1) = .TRUE. - IF (dist(m) > rmax-delta) not_in_range(m, 2) = .TRUE. + IF (dist(m) < rmin + delta) not_in_range(m, 1) = .TRUE. + IF (dist(m) > rmax - delta) not_in_range(m, 2) = .TRUE. ENDDO IF (ANY(not_in_range(:, 1)) .OR. ALL(not_in_range(:, 2))) CYCLE ELSE @@ -1131,29 +1131,29 @@ SUBROUTINE get_fitting_points(qs_env, resp_env, rep_sys, particles, cell) in_y = 0 in_x = 0 iatom = rep_sys(i)%p_resp%atom_surf_list(m) - SELECT CASE (rep_sys (i)%p_resp%my_fit) + SELECT CASE (rep_sys(i)%p_resp%my_fit) CASE (do_resp_x_dir, do_resp_y_dir, do_resp_z_dir) vec_pbc = pbc(particles%els(iatom)%r, r, cell) CASE (do_resp_minus_x_dir, do_resp_minus_y_dir, do_resp_minus_z_dir) vec_pbc = pbc(r, particles%els(iatom)%r, cell) END SELECT - SELECT CASE (rep_sys (i)%p_resp%my_fit) + SELECT CASE (rep_sys(i)%p_resp%my_fit) !subtract delta=1.0E-13 to get rid of rounding errors when shifting atoms CASE (do_resp_x_dir, do_resp_minus_x_dir) - IF (ABS(vec_pbc(3)) < rep_sys(i)%p_resp%length-delta) in_z = 1 - IF (ABS(vec_pbc(2)) < rep_sys(i)%p_resp%length-delta) in_y = 1 - IF (vec_pbc(1) > rep_sys(i)%p_resp%range_surf(1)+delta .AND. & - vec_pbc(1) < rep_sys(i)%p_resp%range_surf(2)-delta) in_x = 1 + IF (ABS(vec_pbc(3)) < rep_sys(i)%p_resp%length - delta) in_z = 1 + IF (ABS(vec_pbc(2)) < rep_sys(i)%p_resp%length - delta) in_y = 1 + IF (vec_pbc(1) > rep_sys(i)%p_resp%range_surf(1) + delta .AND. & + vec_pbc(1) < rep_sys(i)%p_resp%range_surf(2) - delta) in_x = 1 CASE (do_resp_y_dir, do_resp_minus_y_dir) - IF (ABS(vec_pbc(3)) < rep_sys(i)%p_resp%length-delta) in_z = 1 - IF (vec_pbc(2) > rep_sys(i)%p_resp%range_surf(1)+delta .AND. & - vec_pbc(2) < rep_sys(i)%p_resp%range_surf(2)-delta) in_y = 1 - IF (ABS(vec_pbc(1)) < rep_sys(i)%p_resp%length-delta) in_x = 1 + IF (ABS(vec_pbc(3)) < rep_sys(i)%p_resp%length - delta) in_z = 1 + IF (vec_pbc(2) > rep_sys(i)%p_resp%range_surf(1) + delta .AND. & + vec_pbc(2) < rep_sys(i)%p_resp%range_surf(2) - delta) in_y = 1 + IF (ABS(vec_pbc(1)) < rep_sys(i)%p_resp%length - delta) in_x = 1 CASE (do_resp_z_dir, do_resp_minus_z_dir) - IF (vec_pbc(3) > rep_sys(i)%p_resp%range_surf(1)+delta .AND. & - vec_pbc(3) < rep_sys(i)%p_resp%range_surf(2)-delta) in_z = 1 - IF (ABS(vec_pbc(2)) < rep_sys(i)%p_resp%length-delta) in_y = 1 - IF (ABS(vec_pbc(1)) < rep_sys(i)%p_resp%length-delta) in_x = 1 + IF (vec_pbc(3) > rep_sys(i)%p_resp%range_surf(1) + delta .AND. & + vec_pbc(3) < rep_sys(i)%p_resp%range_surf(2) - delta) in_z = 1 + IF (ABS(vec_pbc(2)) < rep_sys(i)%p_resp%length - delta) in_y = 1 + IF (ABS(vec_pbc(1)) < rep_sys(i)%p_resp%length - delta) in_x = 1 END SELECT IF (in_z*in_y*in_x == 1) EXIT ENDDO @@ -1161,7 +1161,7 @@ SUBROUTINE get_fitting_points(qs_env, resp_env, rep_sys, particles, cell) ENDDO IF (in_z*in_y*in_x == 0) CYCLE ENDIF - resp_env%npoints_proc = resp_env%npoints_proc+1 + resp_env%npoints_proc = resp_env%npoints_proc + 1 IF (resp_env%npoints_proc > now) THEN now = 2*now CALL reallocate(resp_env%fitpoints, 1, 3, 1, now) @@ -1221,9 +1221,9 @@ SUBROUTINE calculate_rhs(qs_env, resp_env, rhs, vpot) vhartree(ip) = -v_hartree_pw%cr3d(jx, jy, jz)/dvol IF (qs_env%qmmm) THEN !taking into account that v_qmmm has also opposite sign - vhartree(ip) = vhartree(ip)+qs_env%ks_qmmm_env%v_qmmm_rspace%pw%cr3d(jx, jy, jz) + vhartree(ip) = vhartree(ip) + qs_env%ks_qmmm_env%v_qmmm_rspace%pw%cr3d(jx, jy, jz) ENDIF - rhs = rhs+2.0_dp*vhartree(ip)*vpot(ip) + rhs = rhs + 2.0_dp*vhartree(ip)*vpot(ip) ENDDO IF (resp_env%use_repeat_method) THEN @@ -1274,7 +1274,7 @@ SUBROUTINE print_fitting_points(qs_env, resp_env) conv = cp_unit_from_cp2k(1.0_dp, "angstrom") gbo = v_hartree_pw%pw_grid%bounds dh = v_hartree_pw%pw_grid%dh - nobjects = SIZE(particle_set)+resp_env%npoints + nobjects = SIZE(particle_set) + resp_env%npoints resp_section => section_vals_get_subs_vals(input, "PROPERTIES%RESP") print_key => section_vals_get_subs_vals(resp_section, "PRINT%COORD_FIT_POINTS") @@ -1305,12 +1305,12 @@ SUBROUTINE print_fitting_points(qs_env, resp_env) jx = resp_env%fitpoints(1, ip) jy = resp_env%fitpoints(2, ip) jz = resp_env%fitpoints(3, ip) - l = jx-gbo(1, 1) - k = jy-gbo(1, 2) - p = jz-gbo(1, 3) - r(3) = p*dh(3, 3)+k*dh(3, 2)+l*dh(3, 1) - r(2) = p*dh(2, 3)+k*dh(2, 2)+l*dh(2, 1) - r(1) = p*dh(1, 3)+k*dh(1, 2)+l*dh(1, 1) + l = jx - gbo(1, 1) + k = jy - gbo(1, 2) + p = jz - gbo(1, 3) + r(3) = p*dh(3, 3) + k*dh(3, 2) + l*dh(3, 1) + r(2) = p*dh(2, 3) + k*dh(2, 2) + l*dh(2, 1) + r(1) = p*dh(1, 3) + k*dh(1, 2) + l*dh(1, 1) r(:) = r(:)*conv WRITE (UNIT=output_unit, FMT="(A,2X,3F10.5)") "X", r(1), r(2), r(3) ENDDO @@ -1323,27 +1323,27 @@ SUBROUTINE print_fitting_points(qs_env, resp_env) IF (output_unit > 0) THEN my_pos = para_env%mepos DO i = 1, para_env%num_pe - IF (my_pos == i-1) CYCLE - CALL mp_irecv(msgout=tmp_size, source=i-1, comm=para_env%group, & + IF (my_pos == i - 1) CYCLE + CALL mp_irecv(msgout=tmp_size, source=i - 1, comm=para_env%group, & request=req(1)) CALL mp_wait(req(1)) ALLOCATE (tmp_points(3, tmp_size(1))) - CALL mp_irecv(msgout=tmp_points, source=i-1, comm=para_env%group, & + CALL mp_irecv(msgout=tmp_points, source=i - 1, comm=para_env%group, & request=req(3)) CALL mp_wait(req(3)) - CALL mp_irecv(msgout=tmp_npoints, source=i-1, comm=para_env%group, & + CALL mp_irecv(msgout=tmp_npoints, source=i - 1, comm=para_env%group, & request=req(5)) CALL mp_wait(req(5)) DO ip = 1, tmp_npoints(1) jx = tmp_points(1, ip) jy = tmp_points(2, ip) jz = tmp_points(3, ip) - l = jx-gbo(1, 1) - k = jy-gbo(1, 2) - p = jz-gbo(1, 3) - r(3) = p*dh(3, 3)+k*dh(3, 2)+l*dh(3, 1) - r(2) = p*dh(2, 3)+k*dh(2, 2)+l*dh(2, 1) - r(1) = p*dh(1, 3)+k*dh(1, 2)+l*dh(1, 1) + l = jx - gbo(1, 1) + k = jy - gbo(1, 2) + p = jz - gbo(1, 3) + r(3) = p*dh(3, 3) + k*dh(3, 2) + l*dh(3, 1) + r(2) = p*dh(2, 3) + k*dh(2, 2) + l*dh(2, 1) + r(1) = p*dh(1, 3) + k*dh(1, 2) + l*dh(1, 1) r(:) = r(:)*conv WRITE (UNIT=output_unit, FMT="(A,2X,3F10.5)") "X", r(1), r(2), r(3) ENDDO @@ -1426,16 +1426,16 @@ SUBROUTINE add_restraints_and_constraints(qs_env, resp_env, rest_section, & IF (explicit_coeff) THEN DO k = 1, SIZE(atom_list_res) resp_env%matrix(atom_list_res(m), atom_list_res(k)) = & - resp_env%matrix(atom_list_res(m), atom_list_res(k))+ & + resp_env%matrix(atom_list_res(m), atom_list_res(k)) + & atom_coef(m)*atom_coef(k)*2.0_dp*strength ENDDO - resp_env%rhs(atom_list_res(m)) = resp_env%rhs(atom_list_res(m))+ & + resp_env%rhs(atom_list_res(m)) = resp_env%rhs(atom_list_res(m)) + & 2.0_dp*TARGET*strength*atom_coef(m) ELSE resp_env%matrix(atom_list_res(m), atom_list_res(m)) = & - resp_env%matrix(atom_list_res(m), atom_list_res(m))+ & + resp_env%matrix(atom_list_res(m), atom_list_res(m)) + & 2.0_dp*strength - resp_env%rhs(atom_list_res(m)) = resp_env%rhs(atom_list_res(m))+ & + resp_env%rhs(atom_list_res(m)) = resp_env%rhs(atom_list_res(m)) + & 2.0_dp*TARGET*strength ENDIF ENDDO @@ -1447,18 +1447,18 @@ SUBROUTINE add_restraints_and_constraints(qs_env, resp_env, rest_section, & DO i = 1, natom CALL get_atomic_kind(atomic_kind=particle_set(i)%atomic_kind, z=z) IF (z .NE. 1) THEN - resp_env%matrix(i, i) = resp_env%matrix(i, i)+2.0_dp*resp_env%rheavies_strength + resp_env%matrix(i, i) = resp_env%matrix(i, i) + 2.0_dp*resp_env%rheavies_strength ENDIF ENDDO ENDIF !*** add the constraints ncons_v = 0 - ncons_v = ncons_v+natom + ncons_v = ncons_v + natom ! REPEAT charges: treat the offset like a constraint IF (resp_env%use_repeat_method) THEN - ncons_v = ncons_v+1 + ncons_v = ncons_v + 1 resp_env%matrix(1:natom, ncons_v) = resp_env%sum_vpot(1:natom) resp_env%matrix(ncons_v, 1:natom) = resp_env%sum_vpot(1:natom) resp_env%matrix(ncons_v, ncons_v) = 2.0_dp @@ -1467,7 +1467,7 @@ SUBROUTINE add_restraints_and_constraints(qs_env, resp_env, rest_section, & ! total charge constraint IF (resp_env%itc) THEN - ncons_v = ncons_v+1 + ncons_v = ncons_v + 1 resp_env%matrix(1:natom, ncons_v) = 1.0_dp resp_env%matrix(ncons_v, 1:natom) = 1.0_dp resp_env%rhs(ncons_v) = dft_control%charge @@ -1477,7 +1477,7 @@ SUBROUTINE add_restraints_and_constraints(qs_env, resp_env, rest_section, & DO i = 1, resp_env%ncons_sec CALL build_atom_list(cons_section, subsys, atom_list_cons, i) IF (.NOT. resp_env%equal_charges) THEN - ncons_v = ncons_v+1 + ncons_v = ncons_v + 1 CALL section_vals_val_get(cons_section, "ATOM_COEF", i_rep_section=i, r_vals=atom_coef) CALL section_vals_val_get(cons_section, "TARGET", i_rep_section=i, r_val=TARGET) CPASSERT(SIZE(atom_list_cons) == SIZE(atom_coef)) @@ -1490,7 +1490,7 @@ SUBROUTINE add_restraints_and_constraints(qs_env, resp_env, rest_section, & my_atom_coef(1) = 1.0_dp my_atom_coef(2) = -1.0_dp DO k = 2, SIZE(atom_list_cons) - ncons_v = ncons_v+1 + ncons_v = ncons_v + 1 resp_env%matrix(atom_list_cons(1), ncons_v) = my_atom_coef(1) resp_env%matrix(ncons_v, atom_list_cons(1)) = my_atom_coef(1) resp_env%matrix(atom_list_cons(k), ncons_v) = my_atom_coef(2) @@ -1556,7 +1556,7 @@ SUBROUTINE print_resp_parameter_info(qs_env, resp_env, rep_sys, my_per) WRITE (output_unit, '(T3,A,T75,I6)') "Number of explicit constraints: ", resp_env%ncons_sec ELSE IF (resp_env%itc) THEN - WRITE (output_unit, '(T3,A,T75,I6)') "Number of explicit constraints: ", resp_env%ncons-1 + WRITE (output_unit, '(T3,A,T75,I6)') "Number of explicit constraints: ", resp_env%ncons - 1 ELSE WRITE (output_unit, '(T3,A,T75,I6)') "Number of explicit constraints: ", resp_env%ncons ENDIF @@ -1769,7 +1769,7 @@ SUBROUTINE print_pot_from_resp_charges(qs_env, resp_env, particles, natom, outpu ! REPEAT: correct for offset, take into account that potentials have reverse sign ! and are scaled by dvol IF (resp_env%use_repeat_method) THEN - v_resp_rspace%pw%cr3d(:, :, :) = v_resp_rspace%pw%cr3d(:, :, :)-resp_env%offset*dvol + v_resp_rspace%pw%cr3d(:, :, :) = v_resp_rspace%pw%cr3d(:, :, :) - resp_env%offset*dvol ENDIF CALL pw_release(v_resp_gspace%pw) CALL pw_release(rho_resp%pw) @@ -1812,9 +1812,9 @@ SUBROUTINE print_pot_from_resp_charges(qs_env, resp_env, particles, natom, outpu jx = resp_env%fitpoints(1, ip) jy = resp_env%fitpoints(2, ip) jz = resp_env%fitpoints(3, ip) - sum_diff = sum_diff+(v_hartree_rspace%cr3d(jx, jy, jz)- & - v_resp_rspace%pw%cr3d(jx, jy, jz))**2 - sum_hartree = sum_hartree+v_hartree_rspace%cr3d(jx, jy, jz)**2 + sum_diff = sum_diff + (v_hartree_rspace%cr3d(jx, jy, jz) - & + v_resp_rspace%pw%cr3d(jx, jy, jz))**2 + sum_hartree = sum_hartree + v_hartree_rspace%cr3d(jx, jy, jz)**2 ENDDO CALL mp_sum(sum_diff, para_env%group) CALL mp_sum(sum_hartree, para_env%group) diff --git a/src/qs_rho0_ggrid.F b/src/qs_rho0_ggrid.F index 63ba6ec8ce..9a5d180087 100644 --- a/src/qs_rho0_ggrid.F +++ b/src/qs_rho0_ggrid.F @@ -204,11 +204,11 @@ SUBROUTINE put_rho0_on_grid(qs_env, rho0, tot_rs_int) IF (rs_grid%desc%parallel .AND. .NOT. rs_grid%desc%distributed) THEN ! replicated realspace grid, split the atoms up between procs IF (MODULO(nat, rs_grid%desc%group_size) == rs_grid%desc%my_pos) THEN - npme = npme+1 + npme = npme + 1 cores(npme) = iat ENDIF ELSE - npme = npme+1 + npme = npme + 1 cores(npme) = iat ENDIF @@ -562,7 +562,7 @@ SUBROUTINE integrate_vhg0_rspace(qs_env, v_rspace, calculate_forces, & num_pe = para_env%num_pe mepos = para_env%mepos - DO j = 0, num_pe-1 + DO j = 0, num_pe - 1 bo = get_limit(nat, num_pe, j) IF (.NOT. grid_distributed .AND. j /= mepos) CYCLE @@ -596,37 +596,37 @@ SUBROUTINE integrate_vhg0_rspace(qs_env, v_rspace, calculate_forces, & ! Convert from cartesian to spherical DO lshell = 0, l0_ikind DO is = 1, nso(lshell) - iso = is+nsoset(lshell-1) + iso = is + nsoset(lshell - 1) hab_sph(iso) = 0.0_dp hdab_sph(1:3, iso) = 0.0_dp a_hdab_sph(1:3, 1:3, iso) = 0.0_dp DO ic = 1, nco(lshell) - ico = ic+ncoset(lshell-1) + ico = ic + ncoset(lshell - 1) lx = indco(1, ico) ly = indco(2, ico) lz = indco(3, ico) - hab_sph(iso) = hab_sph(iso)+ & + hab_sph(iso) = hab_sph(iso) + & orbtramat(lshell)%c2s(is, ic)*hab(ico, 1)* & norm_l(lshell)/ & - SQRT(c4pi*dfac(2*lx-1)*dfac(2*ly-1)*dfac(2*lz-1)/ & - dfac(2*lshell+1)) + SQRT(c4pi*dfac(2*lx - 1)*dfac(2*ly - 1)*dfac(2*lz - 1)/ & + dfac(2*lshell + 1)) IF (calculate_forces) THEN - hdab_sph(1:3, iso) = hdab_sph(1:3, iso)+ & + hdab_sph(1:3, iso) = hdab_sph(1:3, iso) + & orbtramat(lshell)%c2s(is, ic)*hdab(1:3, ico, 1)* & norm_l(lshell)/ & - SQRT(c4pi*dfac(2*lx-1)*dfac(2*ly-1)*dfac(2*lz-1)/ & - dfac(2*lshell+1)) + SQRT(c4pi*dfac(2*lx - 1)*dfac(2*ly - 1)*dfac(2*lz - 1)/ & + dfac(2*lshell + 1)) END IF IF (use_virial) THEN DO ii = 1, 3 DO i = 1, 3 - a_hdab_sph(i, ii, iso) = a_hdab_sph(i, ii, iso)+ & + a_hdab_sph(i, ii, iso) = a_hdab_sph(i, ii, iso) + & orbtramat(lshell)%c2s(is, ic)*a_hdab(i, ii, ico, 1)* & norm_l(lshell)/ & - SQRT(c4pi*dfac(2*lx-1)*dfac(2*ly-1)*dfac(2*lz-1)/ & - dfac(2*lshell+1)) + SQRT(c4pi*dfac(2*lx - 1)*dfac(2*ly - 1)*dfac(2*lz - 1)/ & + dfac(2*lshell + 1)) END DO END DO END IF @@ -652,19 +652,19 @@ SUBROUTINE integrate_vhg0_rspace(qs_env, v_rspace, calculate_forces, & iso1 = cg_list(1, icg, iso) iso2 = cg_list(2, icg, iso) - ig1 = iso1+n1*(ipgf1-1)+m1 - ig2 = iso2+n2*(ipgf2-1)+m2 + ig1 = iso1 + n1*(ipgf1 - 1) + m1 + ig2 = iso2 + n2*(ipgf2 - 1) + m2 - intloc(ig1, ig2) = intloc(ig1, ig2)+Qlm_gg(ig1, ig2, iso)*hab_sph(iso) + intloc(ig1, ig2) = intloc(ig1, ig2) + Qlm_gg(ig1, ig2, iso)*hab_sph(iso) END DO ! icg END DO ! iso END DO ! ipgf2 END DO ! ipgf1 - m2 = m2+maxso + m2 = m2 + maxso END DO ! iset2 - m1 = m1+maxso + m1 = m1 + maxso END DO ! iset1 IF (grid_distributed) THEN @@ -676,26 +676,26 @@ SUBROUTINE integrate_vhg0_rspace(qs_env, v_rspace, calculate_forces, & rho_atom => rho_atom_set(iatom) CALL get_rho_atom(rho_atom=rho_atom, ga_Vlocal_gb_h=int_local_h, ga_Vlocal_gb_s=int_local_s) DO ispin = 1, nspins - int_local_h(ispin)%r_coef = int_local_h(ispin)%r_coef+intloc - int_local_s(ispin)%r_coef = int_local_s(ispin)%r_coef+intloc + int_local_h(ispin)%r_coef = int_local_h(ispin)%r_coef + intloc + int_local_s(ispin)%r_coef = int_local_s(ispin)%r_coef + intloc END DO END IF IF (calculate_forces) THEN force_tmp(1:3) = 0.0_dp DO iso = 1, nsoset(l0_ikind) - force_tmp(1) = force_tmp(1)+Qlm(iso)*hdab_sph(1, iso) - force_tmp(2) = force_tmp(2)+Qlm(iso)*hdab_sph(2, iso) - force_tmp(3) = force_tmp(3)+Qlm(iso)*hdab_sph(3, iso) + force_tmp(1) = force_tmp(1) + Qlm(iso)*hdab_sph(1, iso) + force_tmp(2) = force_tmp(2) + Qlm(iso)*hdab_sph(2, iso) + force_tmp(3) = force_tmp(3) + Qlm(iso)*hdab_sph(3, iso) END DO - force(ikind)%g0s_Vh_elec(1:3, iat) = force(ikind)%g0s_Vh_elec(1:3, iat)+force_tmp(1:3) + force(ikind)%g0s_Vh_elec(1:3, iat) = force(ikind)%g0s_Vh_elec(1:3, iat) + force_tmp(1:3) END IF IF (use_virial) THEN my_virial_a = 0.0_dp DO iso = 1, nsoset(l0_ikind) DO ii = 1, 3 DO i = 1, 3 - virial%pv_virial(i, ii) = virial%pv_virial(i, ii)+Qlm(iso)*a_hdab_sph(i, ii, iso) + virial%pv_virial(i, ii) = virial%pv_virial(i, ii) + Qlm(iso)*a_hdab_sph(i, ii, iso) END DO END DO END DO diff --git a/src/qs_rho0_methods.F b/src/qs_rho0_methods.F index f217af2ed8..32e04f5c82 100644 --- a/src/qs_rho0_methods.F +++ b/src/qs_rho0_methods.F @@ -141,19 +141,19 @@ SUBROUTINE calculate_mpole_gau(mp_gau, orb_basis, harmonics, nchannels, nsotot) l1 = indso(1, iso1) l2 = indso(1, iso2) - ig1 = iso1+n1*(ipgf1-1)+m1 - ig2 = iso2+n2*(ipgf2-1)+m2 + ig1 = iso1 + n1*(ipgf1 - 1) + m1 + ig2 = iso2 + n2*(ipgf2 - 1) + m2 - mp_gau%Qlm_gg(ig1, ig2, iso) = fourpi/(2._dp*l+1._dp)* & - my_CG(iso1, iso2, iso)*gaussint_sph(zet1+zet2, l+l1+l2) + mp_gau%Qlm_gg(ig1, ig2, iso) = fourpi/(2._dp*l + 1._dp)* & + my_CG(iso1, iso2, iso)*gaussint_sph(zet1 + zet2, l + l1 + l2) END DO ! icg END DO ! iso END DO ! ipgf2 END DO ! ipgf1 - m2 = m2+maxso + m2 = m2 + maxso END DO ! iset2 - m1 = m1+maxso + m1 = m1 + maxso END DO ! iset1 DEALLOCATE (cg_list, cg_n_list) @@ -259,8 +259,8 @@ SUBROUTINE calculate_rho0_atom(gapw_control, rho_atom_set, rho0_atom_set, & DO ispin = 1, nspins mpole_rho%Q0(ispin) = (trace_r_AxB(mpole_gau%Qlm_gg(:, :, 1), nsotot, & cpc_ah(:, :, ispin), nsotot, nsotot, nsotot) & - -trace_r_AxB(mpole_gau%Qlm_gg(:, :, 1), nsotot, & - cpc_as(:, :, ispin), nsotot, nsotot, nsotot))/SQRT(fourpi) + - trace_r_AxB(mpole_gau%Qlm_gg(:, :, 1), nsotot, & + cpc_as(:, :, ispin), nsotot, nsotot, nsotot))/SQRT(fourpi) END DO END IF ! Multipoles of local charge distribution @@ -271,16 +271,16 @@ SUBROUTINE calculate_rho0_atom(gapw_control, rho_atom_set, rho0_atom_set, & mpole_rho%Qlm_s(iso) = 0.0_dp DO ispin = 1, nspins - mpole_rho%Qlm_h(iso) = mpole_rho%Qlm_h(iso)+ & + mpole_rho%Qlm_h(iso) = mpole_rho%Qlm_h(iso) + & trace_r_AxB(mpole_gau%Qlm_gg(:, :, iso), nsotot, & cpc_ah(:, :, ispin), nsotot, nsotot, nsotot) - mpole_rho%Qlm_s(iso) = mpole_rho%Qlm_s(iso)+ & + mpole_rho%Qlm_s(iso) = mpole_rho%Qlm_s(iso) + & trace_r_AxB(mpole_gau%Qlm_gg(:, :, iso), nsotot, & cpc_as(:, :, ispin), nsotot, nsotot, nsotot) END DO ! ispin - mpole_rho%Qlm_tot(iso) = mpole_rho%Qlm_tot(iso)+ & - mpole_rho%Qlm_h(iso)-mpole_rho%Qlm_s(iso) + mpole_rho%Qlm_tot(iso) = mpole_rho%Qlm_tot(iso) + & + mpole_rho%Qlm_h(iso) - mpole_rho%Qlm_s(iso) END IF rho0_atom_set(iatom)%rho0_rad_h%r_coef(1:nr, iso) = & @@ -290,10 +290,10 @@ SUBROUTINE calculate_rho0_atom(gapw_control, rho_atom_set, rho0_atom_set, & sum1 = 0.0_dp DO ir = 1, nr - sum1 = sum1+g_atom%wr(ir)* & + sum1 = sum1 + g_atom%wr(ir)* & rho0_atom_set(iatom)%rho0_rad_h%r_coef(ir, iso) ENDDO - rho0_h_tot = rho0_h_tot+sum1*harmonics%slm_int(iso) + rho0_h_tot = rho0_h_tot + sum1*harmonics%slm_int(iso) END DO ! iso IF (paw_atom) THEN DEALLOCATE (cpc_ah, cpc_as) @@ -309,7 +309,7 @@ SUBROUTINE calculate_rho0_atom(gapw_control, rho_atom_set, rho0_atom_set, & DO lshell = 0, lmax0 DO ic = 1, nco(lshell) - ico = ic+ncoset(lshell-1) + ico = ic + ncoset(lshell - 1) mpole_rho%Qlm_car(ico) = 0.0_dp END DO END DO @@ -321,19 +321,19 @@ SUBROUTINE calculate_rho0_atom(gapw_control, rho_atom_set, rho0_atom_set, & DO lshell = 0, lmax0 DO ic = 1, nco(lshell) - ico = ic+ncoset(lshell-1) + ico = ic + ncoset(lshell - 1) mpole_rho%Qlm_car(ico) = 0.0_dp lx = indco(1, ico) ly = indco(2, ico) lz = indco(3, ico) DO is = 1, nso(lshell) - iso = is+nsoset(lshell-1) + iso = is + nsoset(lshell - 1) - mpole_rho%Qlm_car(ico) = mpole_rho%Qlm_car(ico)+ & + mpole_rho%Qlm_car(ico) = mpole_rho%Qlm_car(ico) + & orbtramat(lshell)%c2s(is, ic)*mpole_rho%Qlm_tot(iso)* & norm_g0l_h(lshell) & - /SQRT(dfac(2*lx-1)*dfac(2*ly-1)*dfac(2*lz-1)*fourpi/dfac(2*lshell+1)) + /SQRT(dfac(2*lx - 1)*dfac(2*ly - 1)*dfac(2*lz - 1)*fourpi/dfac(2*lshell + 1)) END DO END DO @@ -453,7 +453,7 @@ SUBROUTINE init_rho0(qs_env, gapw_control, & l_rho1_max = indso(1, harmonics%max_iso_not0) IF (paw_atom) THEN - rho0_mpole%lmax0_kind(ikind) = MIN(2*maxl, l_rho1_max, maxl+laddg, lmaxg) + rho0_mpole%lmax0_kind(ikind) = MIN(2*maxl, l_rho1_max, maxl + laddg, lmaxg) ELSE rho0_mpole%lmax0_kind(ikind) = 0 END IF @@ -503,7 +503,7 @@ SUBROUTINE init_rho0(qs_env, gapw_control, & DO radius = exp_radius(rho0_mpole%lmax_0, rho0_mpole%zet0_h, eps_Vrho0, 1.0_dp) IF (radius <= rc_min) EXIT - rho0_mpole%zet0_h = rho0_mpole%zet0_h+0.1_dp + rho0_mpole%zet0_h = rho0_mpole%zet0_h + 0.1_dp END DO END IF @@ -511,7 +511,7 @@ SUBROUTINE init_rho0(qs_env, gapw_control, & ! Allocate and calculate the normalization factors for g0_lm_h and g0_lm_s CALL reallocate(rho0_mpole%norm_g0l_h, 0, rho0_mpole%lmax_0) DO l = 0, rho0_mpole%lmax_0 - rho0_mpole%norm_g0l_h(l) = (2._dp*l+1._dp)/ & + rho0_mpole%norm_g0l_h(l) = (2._dp*l + 1._dp)/ & (fourpi*gaussint_sph(rho0_mpole%zet0_h, 2*l)) END DO diff --git a/src/qs_rho0_types.F b/src/qs_rho0_types.F index 7bef3f09d6..0d19dda85c 100644 --- a/src/qs_rho0_types.F +++ b/src/qs_rho0_types.F @@ -270,10 +270,10 @@ SUBROUTINE calculate_g0(rho0_mpole, grid_atom, ik) rho0_mpole%mp_gau(ik)%g0_h(1:nr, l) = gh_tmp(1:nr)* & rho0_mpole%norm_g0l_h(l) - prefactor = fourpi/(2.0_dp*l+1.0_dp)*rho0_mpole%norm_g0l_h(l) + prefactor = fourpi/(2.0_dp*l + 1.0_dp)*rho0_mpole%norm_g0l_h(l) CALL whittaker_c0a(int1, grid_atom%rad, gexp, erf_z_h, z_h, l, l, nr) DO ir = 1, nr - rho0_mpole%mp_gau(ik)%vg0_h(ir, l) = prefactor*(int1(ir)+ & + rho0_mpole%mp_gau(ik)%vg0_h(ir, l) = prefactor*(int1(ir) + & int2(ir)*grid_atom%rad2l(ir, l)) END DO diff --git a/src/qs_rho_atom_methods.F b/src/qs_rho_atom_methods.F index 9198a577a9..05fbf167c7 100644 --- a/src/qs_rho_atom_methods.F +++ b/src/qs_rho_atom_methods.F @@ -65,10 +65,10 @@ MODULE qs_rho_atom_methods whittaker_ci !$ USE OMP_LIB, ONLY: omp_get_max_threads, & -!$ omp_get_thread_num, & -!$ omp_lock_kind, & -!$ omp_init_lock, omp_set_lock, & -!$ omp_unset_lock, omp_destroy_lock +!$ omp_get_thread_num, & +!$ omp_lock_kind, & +!$ omp_init_lock, omp_set_lock, & +!$ omp_unset_lock, omp_destroy_lock #include "./base/base_uses.f90" @@ -204,34 +204,34 @@ SUBROUTINE calculate_rho_atom(para_env, rho_atom_set, qs_kind, atom_list, & n1s = nsoset(lmax(iset1)) DO ipgf1 = 1, npgf(iset1) - iso1_first = nsoset(lmin(iset1)-1)+1+n1s*(ipgf1-1)+m1s - iso1_last = nsoset(lmax(iset1))+n1s*(ipgf1-1)+m1s - size1 = iso1_last-iso1_first+1 + iso1_first = nsoset(lmin(iset1) - 1) + 1 + n1s*(ipgf1 - 1) + m1s + iso1_last = nsoset(lmax(iset1)) + n1s*(ipgf1 - 1) + m1s + size1 = iso1_last - iso1_first + 1 iso1_first = o2nindex(iso1_first) iso1_last = o2nindex(iso1_last) - i1 = iso1_last-iso1_first+1 + i1 = iso1_last - iso1_first + 1 CPASSERT(size1 == i1) - i1 = nsoset(lmin(iset1)-1)+1 + i1 = nsoset(lmin(iset1) - 1) + 1 g1(1:nr) = EXP(-zet(ipgf1, iset1)*grid_atom%rad2(1:nr)) n2s = nsoset(lmax(iset2)) DO ipgf2 = 1, npgf(iset2) - iso2_first = nsoset(lmin(iset2)-1)+1+n2s*(ipgf2-1)+m2s - iso2_last = nsoset(lmax(iset2))+n2s*(ipgf2-1)+m2s - size2 = iso2_last-iso2_first+1 + iso2_first = nsoset(lmin(iset2) - 1) + 1 + n2s*(ipgf2 - 1) + m2s + iso2_last = nsoset(lmax(iset2)) + n2s*(ipgf2 - 1) + m2s + size2 = iso2_last - iso2_first + 1 iso2_first = o2nindex(iso2_first) iso2_last = o2nindex(iso2_last) - i2 = iso2_last-iso2_first+1 + i2 = iso2_last - iso2_first + 1 CPASSERT(size2 == i2) - i2 = nsoset(lmin(iset2)-1)+1 + i2 = nsoset(lmin(iset2) - 1) + 1 g2(1:nr) = EXP(-zet(ipgf2, iset2)*grid_atom%rad2(1:nr)) - lmin12 = lmin(iset1)+lmin(iset2) - lmax12 = lmax(iset1)+lmax(iset2) + lmin12 = lmin(iset1) + lmin(iset2) + lmax12 = lmax(iset1) + lmax(iset2) - zet12 = zet(ipgf1, iset1)+zet(ipgf2, iset2) - root_zet12 = SQRT(zet(ipgf1, iset1)+zet(ipgf2, iset2)) + zet12 = zet(ipgf1, iset1) + zet(ipgf2, iset2) + root_zet12 = SQRT(zet(ipgf1, iset1) + zet(ipgf2, iset2)) DO ir = 1, nr erf_zet12(ir) = erf(root_zet12*grid_atom%rad(ir)) END DO @@ -250,36 +250,36 @@ SUBROUTINE calculate_rho_atom(para_env, rho_atom_set, qs_kind, atom_list, & ELSE gg0(1:nr) = g1(1:nr)*g2(1:nr) gg(1:nr, lmin12) = grid_atom%rad2l(1:nr, lmin12)*g1(1:nr)*g2(1:nr) - gg_lm1(1:nr, lmin12) = grid_atom%rad2l(1:nr, lmin12-1)*g1(1:nr)*g2(1:nr) + gg_lm1(1:nr, lmin12) = grid_atom%rad2l(1:nr, lmin12 - 1)*g1(1:nr)*g2(1:nr) END IF ! reduce the number of terms in the expansion local densities IF (lmax12 .GT. lmax_expansion) lmax12 = lmax_expansion - DO l = lmin12+1, lmax12 - gg(1:nr, l) = grid_atom%rad(1:nr)*gg(1:nr, l-1) - gg_lm1(1:nr, l) = gg(1:nr, l-1) - dgg(1:nr, l-1) = dgg(1:nr, l-1)-2.0_dp*(zet(ipgf1, iset1) & - +zet(ipgf2, iset2))*gg(1:nr, l) + DO l = lmin12 + 1, lmax12 + gg(1:nr, l) = grid_atom%rad(1:nr)*gg(1:nr, l - 1) + gg_lm1(1:nr, l) = gg(1:nr, l - 1) + dgg(1:nr, l - 1) = dgg(1:nr, l - 1) - 2.0_dp*(zet(ipgf1, iset1) & + + zet(ipgf2, iset2))*gg(1:nr, l) END DO - dgg(1:nr, lmax12) = dgg(1:nr, lmax12)-2.0_dp*(zet(ipgf1, iset1) & - +zet(ipgf2, iset2))*grid_atom%rad(1:nr)*gg(1:nr, lmax12) + dgg(1:nr, lmax12) = dgg(1:nr, lmax12) - 2.0_dp*(zet(ipgf1, iset1) & + + zet(ipgf2, iset2))*grid_atom%rad(1:nr)*gg(1:nr, lmax12) c2 = SQRT(pi*pi*pi/(zet12*zet12*zet12)) DO iso = 1, max_iso_not0_local l_iso = indso(1, iso) - c1 = fourpi/(2._dp*REAL(l_iso, dp)+1._dp) + c1 = fourpi/(2._dp*REAL(l_iso, dp) + 1._dp) DO icg = 1, cg_n_list(iso) iso1 = cg_list(1, icg, iso) iso2 = cg_list(2, icg, iso) - l = indso(1, iso1)+indso(1, iso2) + l = indso(1, iso1) + indso(1, iso2) CPASSERT(l <= lmax_expansion) IF (done_vgg(l, l_iso)) CYCLE - L_sum = l+l_iso - L_sub = l-l_iso + L_sum = l + l_iso + L_sub = l - l_iso IF (l_sum == 0) THEN vgg(1:nr, l, l_iso) = erf_zet12(1:nr)*grid_atom%oorad2l(1:nr, 1)*c2 @@ -289,7 +289,7 @@ SUBROUTINE calculate_rho_atom(para_env, rho_atom_set, qs_kind, atom_list, & DO ir = 1, nr int2(ir) = grid_atom%rad2l(ir, l_iso)*int2(ir) - vgg(ir, l, l_iso) = c1*(int1(ir)+int2(ir)) + vgg(ir, l, l_iso) = c1*(int1(ir) + int2(ir)) END DO END IF done_vgg(l, l_iso) = .TRUE. @@ -305,10 +305,10 @@ SUBROUTINE calculate_rho_atom(para_env, rho_atom_set, qs_kind, atom_list, & CPCS_sphere = 0.0_dp coeff => rho_atom_set(iatom)%cpc_h(i)%r_coef - CPCH_sphere(i1:i1+size1-1, i2:i2+size2-1) = coeff(iso1_first:iso1_last, iso2_first:iso2_last) + CPCH_sphere(i1:i1 + size1 - 1, i2:i2 + size2 - 1) = coeff(iso1_first:iso1_last, iso2_first:iso2_last) coeff => rho_atom_set(iatom)%cpc_s(i)%r_coef - CPCS_sphere(i1:i1+size1-1, i2:i2+size2-1) = coeff(iso1_first:iso1_last, iso2_first:iso2_last) + CPCS_sphere(i1:i1 + size1 - 1, i2:i2 + size2 - 1) = coeff(iso1_first:iso1_last, iso2_first:iso2_last) DO iso = 1, max_iso_not0_local l_iso = indso(1, iso) @@ -324,51 +324,51 @@ SUBROUTINE calculate_rho_atom(para_env, rho_atom_set, qs_kind, atom_list, & isom2 = soset(l2, -m2) dd(1:nr) = REAL(l1*l2, dp)/grid_atom%rad2(1:nr) & - -2._dp*REAL(l1, dp)*zet(ipgf2, iset2) & - -2._dp*REAL(l2, dp)*zet(ipgf1, iset1) & - +4._dp*zet(ipgf1, iset1)*zet(ipgf2, iset2)*grid_atom%rad2(1:nr) - l = indso(1, iso1)+indso(1, iso2) + - 2._dp*REAL(l1, dp)*zet(ipgf2, iset2) & + - 2._dp*REAL(l2, dp)*zet(ipgf1, iset1) & + + 4._dp*zet(ipgf1, iset1)*zet(ipgf2, iset2)*grid_atom%rad2(1:nr) + l = indso(1, iso1) + indso(1, iso2) CPASSERT(l <= lmax_expansion) rho_atom_set(iatom)%rho_rad_h(i)%r_coef(1:nr, iso) = & - rho_atom_set(iatom)%rho_rad_h(i)%r_coef(1:nr, iso)+ & + rho_atom_set(iatom)%rho_rad_h(i)%r_coef(1:nr, iso) + & gg(1:nr, l)*CPCH_sphere(iso1, iso2)*my_CG(iso1, iso2, iso) rho_atom_set(iatom)%rho_rad_s(i)%r_coef(1:nr, iso) = & - rho_atom_set(iatom)%rho_rad_s(i)%r_coef(1:nr, iso)+ & + rho_atom_set(iatom)%rho_rad_s(i)%r_coef(1:nr, iso) + & gg(1:nr, l)*CPCS_sphere(iso1, iso2)*my_CG(iso1, iso2, iso) rho_atom_set(iatom)%drho_rad_h(i)%r_coef(1:nr, iso) = & - rho_atom_set(iatom)%drho_rad_h(i)%r_coef(1:nr, iso)+ & + rho_atom_set(iatom)%drho_rad_h(i)%r_coef(1:nr, iso) + & dgg(1:nr, l)*CPCH_sphere(iso1, iso2)*my_CG(iso1, iso2, iso) rho_atom_set(iatom)%drho_rad_s(i)%r_coef(1:nr, iso) = & - rho_atom_set(iatom)%drho_rad_s(i)%r_coef(1:nr, iso)+ & + rho_atom_set(iatom)%drho_rad_s(i)%r_coef(1:nr, iso) + & dgg(1:nr, l)*CPCS_sphere(iso1, iso2)*my_CG(iso1, iso2, iso) rho_atom_set(iatom)%vrho_rad_h(i)%r_coef(1:nr, iso) = & - rho_atom_set(iatom)%vrho_rad_h(i)%r_coef(1:nr, iso)+ & + rho_atom_set(iatom)%vrho_rad_h(i)%r_coef(1:nr, iso) + & vgg(1:nr, l, l_iso)*CPCH_sphere(iso1, iso2)*my_CG(iso1, iso2, iso) rho_atom_set(iatom)%vrho_rad_s(i)%r_coef(1:nr, iso) = & - rho_atom_set(iatom)%vrho_rad_s(i)%r_coef(1:nr, iso)+ & + rho_atom_set(iatom)%vrho_rad_s(i)%r_coef(1:nr, iso) + & vgg(1:nr, l, l_iso)*CPCS_sphere(iso1, iso2)*my_CG(iso1, iso2, iso) rho_atom_set(iatom)%trho_rad_h(1, i)%r_coef(1:nr, iso) = & - rho_atom_set(iatom)%trho_rad_h(1, i)%r_coef(1:nr, iso)+ & + rho_atom_set(iatom)%trho_rad_h(1, i)%r_coef(1:nr, iso) + & 0.5_dp*gg(1:nr, l)*dd(1:nr)*CPCH_sphere(iso1, iso2)*my_CG(iso1, iso2, iso) rho_atom_set(iatom)%trho_rad_s(1, i)%r_coef(1:nr, iso) = & - rho_atom_set(iatom)%trho_rad_s(1, i)%r_coef(1:nr, iso)+ & + rho_atom_set(iatom)%trho_rad_s(1, i)%r_coef(1:nr, iso) + & 0.5_dp*gg(1:nr, l)*dd(1:nr)*CPCS_sphere(iso1, iso2)*my_CG(iso1, iso2, iso) rho_atom_set(iatom)%trho_rad_h(3, i)%r_coef(1:nr, iso) = & - rho_atom_set(iatom)%trho_rad_h(3, i)%r_coef(1:nr, iso)+ & + rho_atom_set(iatom)%trho_rad_h(3, i)%r_coef(1:nr, iso) + & 0.5_dp*REAL(m1*m2, dp)*gg(1:nr, l)*CPCH_sphere(iso1, iso2)* & my_CG(isom1, isom2, iso)/grid_atom%rad2(1:nr) rho_atom_set(iatom)%trho_rad_s(3, i)%r_coef(1:nr, iso) = & - rho_atom_set(iatom)%trho_rad_s(3, i)%r_coef(1:nr, iso)+ & + rho_atom_set(iatom)%trho_rad_s(3, i)%r_coef(1:nr, iso) + & 0.5_dp*REAL(m1*m2, dp)*gg(1:nr, l)*CPCS_sphere(iso1, iso2)* & my_CG(isom1, isom2, iso)/grid_atom%rad2(1:nr) @@ -381,15 +381,15 @@ SUBROUTINE calculate_rho_atom(para_env, rho_atom_set, qs_kind, atom_list, & DO icg = 1, dacg_n_list(iso) iso1 = dacg_list(1, icg, iso) iso2 = dacg_list(2, icg, iso) - l = indso(1, iso1)+indso(1, iso2) + l = indso(1, iso1) + indso(1, iso2) CPASSERT(l <= lmax_expansion) DO j = 1, 3 rho_atom_set(iatom)%rho_rad_h_d(j, i)%r_coef(1:nr, iso) = & - rho_atom_set(iatom)%rho_rad_h_d(j, i)%r_coef(1:nr, iso)+ & + rho_atom_set(iatom)%rho_rad_h_d(j, i)%r_coef(1:nr, iso) + & gg_lm1(1:nr, l)*CPCH_sphere(iso1, iso2)*my_CG_dxyz(j, iso1, iso2, iso) rho_atom_set(iatom)%rho_rad_s_d(j, i)%r_coef(1:nr, iso) = & - rho_atom_set(iatom)%rho_rad_s_d(j, i)%r_coef(1:nr, iso)+ & + rho_atom_set(iatom)%rho_rad_s_d(j, i)%r_coef(1:nr, iso) + & gg_lm1(1:nr, l)*CPCS_sphere(iso1, iso2)*my_CG_dxyz(j, iso1, iso2, iso) END DO END DO ! icg @@ -405,15 +405,15 @@ SUBROUTINE calculate_rho_atom(para_env, rho_atom_set, qs_kind, atom_list, & iso1 = dbcg_list(1, icg, iso) iso2 = dbcg_list(2, icg, iso) - l = indso(1, iso1)+indso(1, iso2) + l = indso(1, iso1) + indso(1, iso2) CPASSERT(l <= lmax_expansion) rho_atom_set(iatom)%trho_rad_h(2, i)%r_coef(1:nr, iso) = & - rho_atom_set(iatom)%trho_rad_h(2, i)%r_coef(1:nr, iso)+ & + rho_atom_set(iatom)%trho_rad_h(2, i)%r_coef(1:nr, iso) + & 0.5_dp*gg(1:nr, l)*CPCH_sphere(iso1, iso2)* & my_dCG(iso1, iso2, iso)/grid_atom%rad2(1:nr) rho_atom_set(iatom)%trho_rad_s(2, i)%r_coef(1:nr, iso) = & - rho_atom_set(iatom)%trho_rad_s(2, i)%r_coef(1:nr, iso)+ & + rho_atom_set(iatom)%trho_rad_s(2, i)%r_coef(1:nr, iso) + & 0.5_dp*gg(1:nr, l)*CPCS_sphere(iso1, iso2)* & my_dCG(iso1, iso2, iso)/grid_atom%rad2(1:nr) END DO ! icg @@ -424,9 +424,9 @@ SUBROUTINE calculate_rho_atom(para_env, rho_atom_set, qs_kind, atom_list, & ENDDO ! ipgf2 ENDDO ! ipgf1 - m2s = m2s+maxso + m2s = m2s + maxso ENDDO ! iset2 - m1s = m1s+maxso + m1s = m1s + maxso ENDDO ! iset1 DO iat = bo(1), bo(2) @@ -438,11 +438,11 @@ SUBROUTINE calculate_rho_atom(para_env, rho_atom_set, qs_kind, atom_list, & rho_s = 0.0_dp rho_h = 0.0_dp DO ir = 1, nr - rho_h = rho_h+rho_atom_set(iatom)%rho_rad_h(i)%r_coef(ir, iso)*grid_atom%wr(ir) - rho_s = rho_s+rho_atom_set(iatom)%rho_rad_s(i)%r_coef(ir, iso)*grid_atom%wr(ir) + rho_h = rho_h + rho_atom_set(iatom)%rho_rad_h(i)%r_coef(ir, iso)*grid_atom%wr(ir) + rho_s = rho_s + rho_atom_set(iatom)%rho_rad_s(i)%r_coef(ir, iso)*grid_atom%wr(ir) END DO ! ir - tot_rho1_h(i) = tot_rho1_h(i)+rho_h*harmonics%slm_int(iso) - tot_rho1_s(i) = tot_rho1_s(i)+rho_s*harmonics%slm_int(iso) + tot_rho1_h(i) = tot_rho1_h(i) + rho_h*harmonics%slm_int(iso) + tot_rho1_s(i) = tot_rho1_s(i) + rho_s*harmonics%slm_int(iso) END DO ! iso END DO ! ispin @@ -672,7 +672,7 @@ SUBROUTINE calculate_rho_atom_coeff(qs_env, rho_ao, rho_atom_set) CALL dbcsr_get_block_p(matrix=rho_ao(ispin, img)%matrix, & row=irow, col=icol, BLOCK=p_block_spin(ispin)%r_coef, & found=found) - pmax = pmax+MAXVAL(ABS(p_block_spin(ispin)%r_coef)) + pmax = pmax + MAXVAL(ABS(p_block_spin(ispin)%r_coef)) ENDDO DO kkind = 1, nkind @@ -687,8 +687,8 @@ SUBROUTINE calculate_rho_atom_coeff(qs_env, rho_ao, rho_atom_set) CALL get_paw_proj_set(paw_proj_set=paw_proj, nsatbas=nsatbas) nsoctot = nsatbas - iac = ikind+nkind*(kkind-1) - ibc = jkind+nkind*(kkind-1) + iac = ikind + nkind*(kkind - 1) + ibc = jkind + nkind*(kkind - 1) IF (.NOT. ASSOCIATED(oce%intac(iac)%alist)) CYCLE IF (.NOT. ASSOCIATED(oce%intac(ibc)%alist)) CYCLE @@ -700,7 +700,7 @@ SUBROUTINE calculate_rho_atom_coeff(qs_env, rho_ao, rho_atom_set) DO kac = 1, alist_ac%nclist DO kbc = 1, alist_bc%nclist IF (alist_ac%clist(kac)%catom /= alist_bc%clist(kbc)%catom) CYCLE - IF (ALL(cell_b+alist_bc%clist(kbc)%cell-alist_ac%clist(kac)%cell == 0)) THEN + IF (ALL(cell_b + alist_bc%clist(kbc)%cell - alist_ac%clist(kac)%cell == 0)) THEN IF (pmax*alist_bc%clist(kbc)%maxac*alist_ac%clist(kac)%maxac < eps_cpc) CYCLE n_cont_a = alist_ac%clist(kac)%nsgf_cnt @@ -751,7 +751,7 @@ SUBROUTINE calculate_rho_atom_coeff(qs_env, rho_ao, rho_atom_set) r_coef_h => rho_atom(katom)%cpc_h(ispin)%r_coef r_coef_s => rho_atom(katom)%cpc_s(ispin)%r_coef -!$ CALL omp_set_lock(locks((katom-1)*nspins+ispin)) +!$ CALL omp_set_lock(locks((katom - 1)*nspins + ispin)) IF (iatom <= jatom) THEN CALL proj_blk(C_coeff_hh_a, C_coeff_ss_a, n_cont_a, & C_coeff_hh_b, C_coeff_ss_b, n_cont_b, & @@ -763,7 +763,7 @@ SUBROUTINE calculate_rho_atom_coeff(qs_env, rho_ao, rho_atom_set) p_matrix, max_nsgf, r_coef_h, r_coef_s, nsoctot, & len_PC1, len_CPC, factor, distab) ENDIF -!$ CALL omp_unset_lock(locks((katom-1)*nspins+ispin)) +!$ CALL omp_unset_lock(locks((katom - 1)*nspins + ispin)) END DO EXIT !search loop over jatom-katom list @@ -801,8 +801,8 @@ SUBROUTINE calculate_rho_atom_coeff(qs_env, rho_ao, rho_atom_set) CALL mp_sum(rho_atom(iatom)%cpc_s(ispin)%r_coef, para_env%group) r_coef_h => rho_atom(iatom)%cpc_h(ispin)%r_coef r_coef_s => rho_atom(iatom)%cpc_s(ispin)%r_coef - r_coef_h(:, :) = r_coef_h(:, :)+TRANSPOSE(r_coef_h(:, :)) - r_coef_s(:, :) = r_coef_s(:, :)+TRANSPOSE(r_coef_s(:, :)) + r_coef_h(:, :) = r_coef_h(:, :) + TRANSPOSE(r_coef_h(:, :)) + r_coef_s(:, :) = r_coef_s(:, :) + TRANSPOSE(r_coef_s(:, :)) END IF ENDDO @@ -870,21 +870,21 @@ SUBROUTINE init_rho_atom(qs_env, gapw_control) ALLOCATE (rga(lcleb, 2)) DO lc1 = 0, maxlgto - DO iso1 = nsoset(lc1-1)+1, nsoset(lc1) + DO iso1 = nsoset(lc1 - 1) + 1, nsoset(lc1) l1 = indso(1, iso1) m1 = indso(2, iso1) DO lc2 = 0, maxlgto - DO iso2 = nsoset(lc2-1)+1, nsoset(lc2) + DO iso2 = nsoset(lc2 - 1) + 1, nsoset(lc2) l2 = indso(1, iso2) m2 = indso(2, iso2) CALL clebsch_gordon(l1, m1, l2, m2, rga) - IF (l1+l2 > llmax) THEN + IF (l1 + l2 > llmax) THEN l1l2 = llmax ELSE - l1l2 = l1+l2 + l1l2 = l1 + l2 END IF - mp = m1+m2 - mm = m1-m2 + mp = m1 + m2 + mm = m1 - m2 IF (m1*m2 < 0 .OR. (m1*m2 == 0 .AND. (m1 < 0 .OR. m2 < 0))) THEN mp = -ABS(mp) mm = -ABS(mm) @@ -892,21 +892,21 @@ SUBROUTINE init_rho_atom(qs_env, gapw_control) mp = ABS(mp) mm = ABS(mm) END IF - DO lp = MOD(l1+l2, 2), l1l2, 2 - il = lp/2+1 + DO lp = MOD(l1 + l2, 2), l1l2, 2 + il = lp/2 + 1 IF (ABS(mp) <= lp) THEN IF (mp >= 0) THEN - iso = nsoset(lp-1)+lp+1+mp + iso = nsoset(lp - 1) + lp + 1 + mp ELSE - iso = nsoset(lp-1)+lp+1-ABS(mp) + iso = nsoset(lp - 1) + lp + 1 - ABS(mp) END IF my_CG(iso1, iso2, iso) = rga(il, 1) ENDIF IF (mp /= mm .AND. ABS(mm) <= lp) THEN IF (mm >= 0) THEN - iso = nsoset(lp-1)+lp+1+mm + iso = nsoset(lp - 1) + lp + 1 + mm ELSE - iso = nsoset(lp-1)+lp+1-ABS(mm) + iso = nsoset(lp - 1) + lp + 1 - ABS(mm) END IF my_CG(iso1, iso2, iso) = rga(il, 2) ENDIF diff --git a/src/qs_rho_methods.F b/src/qs_rho_methods.F index 4e872fe208..1f4b183d06 100644 --- a/src/qs_rho_methods.F +++ b/src/qs_rho_methods.F @@ -445,8 +445,8 @@ SUBROUTINE qs_rho_update_rho(rho_struct, qs_env, local_rho_set, pw_env_external, DO ispin = 1, nspins rho_ao => rho_ao_kp(ispin, :) CALL calculate_drho_elec(matrix_p_kp=rho_ao, & - drho=drho_r(3*(ispin-1)+1:3*ispin), & - drho_gspace=drho_g(3*(ispin-1)+1:3*ispin), & + drho=drho_r(3*(ispin - 1) + 1:3*ispin), & + drho_gspace=drho_g(3*(ispin - 1) + 1:3*ispin), & qs_env=qs_env, soft_valid=gapw) END DO CALL qs_rho_set(rho_struct, drho_r_valid=.TRUE., drho_g_valid=.TRUE.) @@ -514,8 +514,8 @@ SUBROUTINE qs_rho_update_rho(rho_struct, qs_env, local_rho_set, pw_env_external, DO ispin = 1, nspins rho_ao => rho_xc_ao(ispin, :) CALL calculate_drho_elec(matrix_p_kp=rho_ao, & - drho=rho_xc_r(3*(ispin-1)+1:3*ispin), & - drho_gspace=drho_xc_g(3*(ispin-1)+1:3*ispin), & + drho=rho_xc_r(3*(ispin - 1) + 1:3*ispin), & + drho_gspace=drho_xc_g(3*(ispin - 1) + 1:3*ispin), & qs_env=qs_env, soft_valid=gapw_xc) END DO CALL qs_rho_set(rho_xc, drho_r_valid=.TRUE., drho_g_valid=.TRUE.) diff --git a/src/qs_rho_types.F b/src/qs_rho_types.F index 304a58805c..e4f033ae7a 100644 --- a/src/qs_rho_types.F +++ b/src/qs_rho_types.F @@ -111,7 +111,7 @@ SUBROUTINE qs_rho_create(rho) IF (ASSOCIATED(rho)) CPABORT("rho already associated") ALLOCATE (rho) - last_rho_id_nr = last_rho_id_nr+1 + last_rho_id_nr = last_rho_id_nr + 1 rho%id_nr = last_rho_id_nr rho%rebuild_each = 5 rho%ref_count = 1 @@ -132,7 +132,7 @@ SUBROUTINE qs_rho_retain(rho_struct) CPASSERT(ASSOCIATED(rho_struct)) CPASSERT(rho_struct%ref_count > 0) - rho_struct%ref_count = rho_struct%ref_count+1 + rho_struct%ref_count = rho_struct%ref_count + 1 END SUBROUTINE qs_rho_retain ! ************************************************************************************************** @@ -151,7 +151,7 @@ SUBROUTINE qs_rho_release(rho_struct) IF (ASSOCIATED(rho_struct)) THEN CPASSERT(rho_struct%ref_count > 0) - rho_struct%ref_count = rho_struct%ref_count-1 + rho_struct%ref_count = rho_struct%ref_count - 1 IF (rho_struct%ref_count < 1) THEN CALL qs_rho_clear(rho_struct) DEALLOCATE (rho_struct) diff --git a/src/qs_sccs.F b/src/qs_sccs.F index 8e12a45ea7..b7d0545e9e 100644 --- a/src/qs_sccs.F +++ b/src/qs_sccs.F @@ -350,21 +350,21 @@ SUBROUTINE sccs(qs_env, rho_tot_gspace, v_hartree_gspace, v_sccs, h_stress) cavity_surface = 0.0_dp cavity_volume = 0.0_dp - IF (should_output .AND. (ABS(eps0-1.0_dp) > tol)) THEN + IF (should_output .AND. (ABS(eps0 - 1.0_dp) > tol)) THEN ! Initialise the switching function theta theta => work_r3d(4)%pw CALL pw_zero(theta) ! Calculate the (quantum) volume of the solute cavity - f = 1.0_dp/(eps0-1.0_dp) + f = 1.0_dp/(eps0 - 1.0_dp) !$OMP PARALLEL DO DEFAULT(NONE) & !$OMP PRIVATE(i,j,k) & !$OMP SHARED(eps0,eps_elec,f,lb,theta,ub) DO k = lb(3), ub(3) DO j = lb(2), ub(2) DO i = lb(1), ub(1) - theta%cr3d(i, j, k) = f*(eps0-eps_elec%cr3d(i, j, k)) + theta%cr3d(i, j, k) = f*(eps0 - eps_elec%cr3d(i, j, k)) END DO END DO END DO @@ -392,9 +392,9 @@ SUBROUTINE sccs(qs_env, rho_tot_gspace, v_hartree_gspace, v_sccs, h_stress) DO j = lb(2), ub(2) DO i = lb(1), ub(1) norm_drho_elec%cr3d(i, j, k) = SQRT(drho_elec(1)%pw%cr3d(i, j, k)* & - drho_elec(1)%pw%cr3d(i, j, k)+ & + drho_elec(1)%pw%cr3d(i, j, k) + & drho_elec(2)%pw%cr3d(i, j, k)* & - drho_elec(2)%pw%cr3d(i, j, k)+ & + drho_elec(2)%pw%cr3d(i, j, k) + & drho_elec(3)%pw%cr3d(i, j, k)* & drho_elec(3)%pw%cr3d(i, j, k)) END DO @@ -480,7 +480,7 @@ SUBROUTINE sccs(qs_env, rho_tot_gspace, v_hartree_gspace, v_sccs, h_stress) v_sccs%cr3d(i, j, k) = sccs_control%gamma_solvent*theta%cr3d(i, j, k)* & (drho_elec(di)%pw%cr3d(i, j, k)* & drho_elec(dj)%pw%cr3d(i, j, k)* & - d2rho_elec(di, dj)%pw%cr3d(i, j, k)/norm_drho2- & + d2rho_elec(di, dj)%pw%cr3d(i, j, k)/norm_drho2 - & d2rho_elec(di, di)%pw%cr3d(i, j, k))/norm_drho2 END DO END DO @@ -597,7 +597,7 @@ SUBROUTINE sccs(qs_env, rho_tot_gspace, v_hartree_gspace, v_sccs, h_stress) iter_loop: DO ! Increment iteration counter - iter = iter+1 + iter = iter + 1 ! Check if the requested maximum number of SCCS iterations is reached IF (iter > sccs_control%max_iter) THEN @@ -628,15 +628,15 @@ SUBROUTINE sccs(qs_env, rho_tot_gspace, v_hartree_gspace, v_sccs, h_stress) DO k = lb(3), ub(3) DO j = lb(2), ub(2) DO i = lb(1), ub(1) - rho_iter_new = (dln_eps_elec(1)%pw%cr3d(i, j, k)*dphi_tot(1)%pw%cr3d(i, j, k)+ & - dln_eps_elec(2)%pw%cr3d(i, j, k)*dphi_tot(2)%pw%cr3d(i, j, k)+ & + rho_iter_new = (dln_eps_elec(1)%pw%cr3d(i, j, k)*dphi_tot(1)%pw%cr3d(i, j, k) + & + dln_eps_elec(2)%pw%cr3d(i, j, k)*dphi_tot(2)%pw%cr3d(i, j, k) + & dln_eps_elec(3)%pw%cr3d(i, j, k)*dphi_tot(3)%pw%cr3d(i, j, k))*f - rho_iter_new = rho_iter_old%cr3d(i, j, k)+ & - sccs_control%mixing*(rho_iter_new-rho_iter_old%cr3d(i, j, k)) - rho_delta = ABS(rho_iter_new-rho_iter_old%cr3d(i, j, k)) + rho_iter_new = rho_iter_old%cr3d(i, j, k) + & + sccs_control%mixing*(rho_iter_new - rho_iter_old%cr3d(i, j, k)) + rho_delta = ABS(rho_iter_new - rho_iter_old%cr3d(i, j, k)) rho_delta_max = MAX(rho_delta, rho_delta_max) - rho_delta_avg = rho_delta_avg+rho_delta - rho_tot%cr3d(i, j, k) = rho_tot_zero%cr3d(i, j, k)+rho_iter_new + rho_delta_avg = rho_delta_avg + rho_delta + rho_tot%cr3d(i, j, k) = rho_tot_zero%cr3d(i, j, k) + rho_iter_new rho_iter_old%cr3d(i, j, k) = rho_iter_new END DO END DO @@ -783,10 +783,10 @@ SUBROUTINE sccs(qs_env, rho_tot_gspace, v_hartree_gspace, v_sccs, h_stress) DO k = lb(3), ub(3) DO j = lb(2), ub(2) DO i = lb(1), ub(1) - dphi2 = dphi_tot(1)%pw%cr3d(i, j, k)*dphi_tot(1)%pw%cr3d(i, j, k)+ & - dphi_tot(2)%pw%cr3d(i, j, k)*dphi_tot(2)%pw%cr3d(i, j, k)+ & + dphi2 = dphi_tot(1)%pw%cr3d(i, j, k)*dphi_tot(1)%pw%cr3d(i, j, k) + & + dphi_tot(2)%pw%cr3d(i, j, k)*dphi_tot(2)%pw%cr3d(i, j, k) + & dphi_tot(3)%pw%cr3d(i, j, k)*dphi_tot(3)%pw%cr3d(i, j, k) - v_sccs%cr3d(i, j, k) = v_sccs%cr3d(i, j, k)+f*deps_elec%cr3d(i, j, k)*dphi2 + v_sccs%cr3d(i, j, k) = v_sccs%cr3d(i, j, k) + f*deps_elec%cr3d(i, j, k)*dphi2 END DO END DO END DO @@ -844,11 +844,11 @@ SUBROUTINE andreussi(rho_elec, eps_elec, deps_elec, epsilon_solvent, rho_max, & CALL timeset(routineN, handle) f = LOG(epsilon_solvent)/twopi - diff = rho_max-rho_min + diff = rho_max - rho_min IF (diff > tol) THEN ln_rho_max = LOG(rho_max) ln_rho_min = LOG(rho_min) - q = twopi/(ln_rho_max-ln_rho_min) + q = twopi/(ln_rho_max - ln_rho_min) dq = -f*q END IF @@ -870,10 +870,10 @@ SUBROUTINE andreussi(rho_elec, eps_elec, deps_elec, epsilon_solvent, rho_max, & ELSE IF (rho <= rho_max) THEN IF (diff > tol) THEN x = LOG(rho) - y = q*(ln_rho_max-x) - t = f*(y-SIN(y)) + y = q*(ln_rho_max - x) + t = f*(y - SIN(y)) eps_elec%cr3d(i, j, k) = EXP(t) - dt = dq*(1.0_dp-COS(y)) + dt = dq*(1.0_dp - COS(y)) deps_elec%cr3d(i, j, k) = eps_elec%cr3d(i, j, k)*dt/rho ELSE eps_elec%cr3d(i, j, k) = 1.0_dp @@ -920,8 +920,8 @@ SUBROUTINE fattebert_gygi(rho_elec, eps_elec, deps_elec, epsilon_solvent, beta, CALL timeset(routineN, handle) - df = (1.0_dp-epsilon_solvent)/rho_zero - f = 0.5_dp*(epsilon_solvent-1.0_dp) + df = (1.0_dp - epsilon_solvent)/rho_zero + f = 0.5_dp*(epsilon_solvent - 1.0_dp) q = 1.0_dp/rho_zero twobeta = 2.0_dp*beta @@ -943,8 +943,8 @@ SUBROUTINE fattebert_gygi(rho_elec, eps_elec, deps_elec, epsilon_solvent, beta, ELSE s = rho*q p = s**twobeta - t = 1.0_dp/(1.0_dp+p) - eps_elec%cr3d(i, j, k) = 1.0_dp+f*(1.0_dp+(1.0_dp-p)*t) + t = 1.0_dp/(1.0_dp + p) + eps_elec%cr3d(i, j, k) = 1.0_dp + f*(1.0_dp + (1.0_dp - p)*t) deps_elec%cr3d(i, j, k) = df*twobeta*t*t*p/s END IF END DO @@ -1009,7 +1009,7 @@ SUBROUTINE derive(f, df, method, pw_env, input, para_env) CASE (sccs_derivative_cd7) border_points = 3 END SELECT - CALL init_input_type(input_settings, 2*border_points+1, rs_grid_section, & + CALL init_input_type(input_settings, 2*border_points + 1, rs_grid_section, & 1, (/-1, -1, -1/)) CALL rs_grid_create_descriptor(rs_desc, f%pw_grid, input_settings, & border_points=border_points) @@ -1103,13 +1103,13 @@ SUBROUTINE surface_andreussi(rho_elec, norm_drho_elec, dtheta, & CALL timeset(routineN, handle) - e = epsilon_solvent-1.0_dp + e = epsilon_solvent - 1.0_dp f = LOG(epsilon_solvent)/twopi - diff = rho_max-rho_min + diff = rho_max - rho_min IF (diff > tol) THEN ln_rho_max = LOG(rho_max) ln_rho_min = LOG(rho_min) - q = twopi/(ln_rho_max-ln_rho_min) + q = twopi/(ln_rho_max - ln_rho_min) END IF lb(1:3) = rho_elec%pw_grid%bounds_local(1, 1:3) @@ -1124,14 +1124,14 @@ SUBROUTINE surface_andreussi(rho_elec, norm_drho_elec, dtheta, & DO j = lb(2), ub(2) DO i = lb(1), ub(1) DO l = 1, 2 - rho = rho_elec%cr3d(i, j, k)+(REAL(l, KIND=dp)-1.5_dp)*delta_rho + rho = rho_elec%cr3d(i, j, k) + (REAL(l, KIND=dp) - 1.5_dp)*delta_rho IF (rho < rho_min) THEN eps_elec = epsilon_solvent ELSE IF (rho <= rho_max) THEN IF (diff > tol) THEN x = LOG(rho) - y = q*(ln_rho_max-x) - t = f*(y-SIN(y)) + y = q*(ln_rho_max - x) + t = f*(y - SIN(y)) eps_elec = EXP(t) ELSE eps_elec = 1.0_dp @@ -1139,9 +1139,9 @@ SUBROUTINE surface_andreussi(rho_elec, norm_drho_elec, dtheta, & ELSE eps_elec = 1.0_dp END IF - theta(l) = (epsilon_solvent-eps_elec)/e + theta(l) = (epsilon_solvent - eps_elec)/e END DO - dtheta%cr3d(i, j, k) = (theta(2)-theta(1))*norm_drho_elec%cr3d(i, j, k)/delta_rho + dtheta%cr3d(i, j, k) = (theta(2) - theta(1))*norm_drho_elec%cr3d(i, j, k)/delta_rho END DO END DO END DO @@ -1186,7 +1186,7 @@ SUBROUTINE surface_fattebert_gygi(rho_elec, norm_drho_elec, dtheta, & CALL timeset(routineN, handle) - e = epsilon_solvent-1.0_dp + e = epsilon_solvent - 1.0_dp f = 0.5_dp*e q = 1.0_dp/rho_zero twobeta = 2.0_dp*beta @@ -1203,18 +1203,18 @@ SUBROUTINE surface_fattebert_gygi(rho_elec, norm_drho_elec, dtheta, & DO j = lb(2), ub(2) DO i = lb(1), ub(1) DO l = 1, 2 - rho = rho_elec%cr3d(i, j, k)+(REAL(l, KIND=dp)-1.5_dp)*delta_rho + rho = rho_elec%cr3d(i, j, k) + (REAL(l, KIND=dp) - 1.5_dp)*delta_rho IF (rho < tol) THEN eps_elec = epsilon_solvent ELSE s = rho*q p = s**twobeta - t = 1.0_dp/(1.0_dp+p) - eps_elec = 1.0_dp+f*(1.0_dp+(1.0_dp-p)*t) + t = 1.0_dp/(1.0_dp + p) + eps_elec = 1.0_dp + f*(1.0_dp + (1.0_dp - p)*t) END IF - theta(l) = (epsilon_solvent-eps_elec)/e + theta(l) = (epsilon_solvent - eps_elec)/e END DO - dtheta%cr3d(i, j, k) = (theta(2)-theta(1))*norm_drho_elec%cr3d(i, j, k)/delta_rho + dtheta%cr3d(i, j, k) = (theta(2) - theta(1))*norm_drho_elec%cr3d(i, j, k)/delta_rho END DO END DO END DO diff --git a/src/qs_scf.F b/src/qs_scf.F index 15b9bbbc81..ce97948017 100644 --- a/src/qs_scf.F +++ b/src/qs_scf.F @@ -253,7 +253,7 @@ SUBROUTINE scf(qs_env) IF (used_history) used_history = .FALSE. ! Update a counter and check if the Jacobian should be deallocated IF (ASSOCIATED(scf_env%outer_scf%inv_jacobian)) THEN - scf_control%outer_scf%cdft_opt_control%ijacobian(2) = scf_control%outer_scf%cdft_opt_control%ijacobian(2)+1 + scf_control%outer_scf%cdft_opt_control%ijacobian(2) = scf_control%outer_scf%cdft_opt_control%ijacobian(2) + 1 IF (scf_control%outer_scf%cdft_opt_control%ijacobian(2) .GE. & scf_control%outer_scf%cdft_opt_control%jacobian_freq(2) .AND. & scf_control%outer_scf%cdft_opt_control%jacobian_freq(2) > 0) & @@ -428,13 +428,13 @@ SUBROUTINE scf_env_do_scf(scf_env, scf_control, qs_env, converged, should_stop) CALL timeset(routineN//"_inner_loop", handle2) - scf_env%iter_count = scf_env%iter_count+1 - iter_count = iter_count+1 + scf_env%iter_count = scf_env%iter_count + 1 + iter_count = iter_count + 1 CALL cp_iterate(logger%iter_info, last=.FALSE., iter_nr=iter_count) IF (output_unit > 0) CALL m_flush(output_unit) - total_steps = total_steps+1 + total_steps = total_steps + 1 just_energy = energy_only CALL qs_ks_update_qs_env(qs_env, just_energy=just_energy, & @@ -537,12 +537,12 @@ SUBROUTINE scf_env_do_scf(scf_env, scf_control, qs_env, converged, should_stop) IF (dft_control%qs_control%cdft) & dft_control%qs_control%cdft_control%total_steps = & - dft_control%qs_control%cdft_control%total_steps+total_steps + dft_control%qs_control%cdft_control%total_steps + total_steps IF (.NOT. converged) CPWARN("SCF run NOT converged") IF (.NOT. converged .AND. scf_control%stop_higher_iter_level) THEN - logger%iter_info%last_iter(logger%iter_info%n_rlevel-1) = .TRUE. + logger%iter_info%last_iter(logger%iter_info%n_rlevel - 1) = .TRUE. CPWARN("MD iteration also stops") END IF @@ -753,7 +753,7 @@ SUBROUTINE init_scf_loop(scf_env, qs_env, scf_section) broyden_adaptive_sigma=qs_env%broyden_adaptive_sigma, & qs_ot_env=scf_env%qs_ot_env, matrix_ks=matrix_ks(1)%matrix) - SELECT CASE (scf_env%qs_ot_env (1)%settings%preconditioner_type) + SELECT CASE (scf_env%qs_ot_env(1)%settings%preconditioner_type) CASE (ot_precond_none) CASE (ot_precond_full_all, ot_precond_full_single_inverse) ! this will rotate the MOs to be eigen states, which is not compatible with rotation @@ -969,12 +969,12 @@ SUBROUTINE cdft_scf(qs_env, should_stop) ! but the constraint optimizer keeps jumping over the optimal solution IF (scf_env%outer_scf%iter_count == 1 .AND. scf_env%iter_count == 1 & .AND. cdft_control%total_steps /= 1) & - cdft_control%nreused = cdft_control%nreused-1 + cdft_control%nreused = cdft_control%nreused - 1 ! SCF converged in less than precond_freq steps IF (scf_env%outer_scf%iter_count == 1 .AND. scf_env%iter_count .LE. cdft_control%precond_freq .AND. & cdft_control%total_steps /= 1 .AND. cdft_control%nreused .LT. cdft_control%max_reuse) THEN reuse_precond = .TRUE. - cdft_control%nreused = cdft_control%nreused+1 + cdft_control%nreused = cdft_control%nreused + 1 ELSE reuse_precond = .FALSE. cdft_control%nreused = 0 @@ -982,9 +982,9 @@ SUBROUTINE cdft_scf(qs_env, should_stop) END IF ! Update history purging counters IF (first_iteration .AND. cdft_control%purge_history) THEN - cdft_control%istep = cdft_control%istep+1 + cdft_control%istep = cdft_control%istep + 1 IF (scf_env%outer_scf%iter_count .GT. 1) THEN - cdft_control%nbad_conv = cdft_control%nbad_conv+1 + cdft_control%nbad_conv = cdft_control%nbad_conv + 1 IF (cdft_control%nbad_conv .GE. cdft_control%purge_freq .AND. & cdft_control%istep .GE. cdft_control%purge_offset) THEN cdft_control%nbad_conv = 0 @@ -1012,7 +1012,7 @@ SUBROUTINE cdft_scf(qs_env, should_stop) CALL qs_ks_did_change(ks_env, potential_changed=.TRUE.) END DO cdft_outer_loop - cdft_control%ienergy = cdft_control%ienergy+1 + cdft_control%ienergy = cdft_control%ienergy + 1 ! Store needed arrays for ET coupling calculation IF (cdft_control%do_et) THEN @@ -1221,7 +1221,7 @@ SUBROUTINE qs_calculate_inverse_jacobian(qs_env) p_rmpv => rho_ao_kp(:, 1) ! Allocate work nvar = SIZE(scf_env%outer_scf%variables, 1) - max_scf = scf_control%outer_scf%max_scf+1 + max_scf = scf_control%outer_scf%max_scf + 1 ALLOCATE (gradient(nvar, max_scf)) gradient = scf_env%outer_scf%gradient ALLOCATE (energy(max_scf)) @@ -1231,7 +1231,7 @@ SUBROUTINE qs_calculate_inverse_jacobian(qs_env) nsteps = cdft_control%total_steps ! Setup finite difference scheme CALL prepare_jacobian_stencil(qs_env, output_unit, nwork, pwork, coeff, step_multiplier, dh) - twork = pwork-nwork + twork = pwork - nwork DO i = 1, nvar jacobian(i, :) = coeff(0)*scf_env%outer_scf%gradient(i, iter_count) END DO @@ -1248,7 +1248,7 @@ SUBROUTINE qs_calculate_inverse_jacobian(qs_env) counter = 0 DO iwork = nwork, pwork IF (iwork == 0) CYCLE - counter = counter+1 + counter = counter + 1 IF (output_unit > 0) THEN WRITE (output_unit, FMT="(A)") " #####################################" WRITE (output_unit, '(A,I3,A,I3,A)') & @@ -1260,9 +1260,9 @@ SUBROUTINE qs_calculate_inverse_jacobian(qs_env) ELSE step_size = scf_control%outer_scf%cdft_opt_control%jacobian_step(i) END IF - scf_env%outer_scf%variables(:, iter_count+1) = scf_env%outer_scf%variables(:, iter_count) - scf_env%outer_scf%variables(i, iter_count+1) = scf_env%outer_scf%variables(i, iter_count)+ & - step_multiplier(iwork)*step_size + scf_env%outer_scf%variables(:, iter_count + 1) = scf_env%outer_scf%variables(:, iter_count) + scf_env%outer_scf%variables(i, iter_count + 1) = scf_env%outer_scf%variables(i, iter_count) + & + step_multiplier(iwork)*step_size CALL outer_loop_update_qs_env(qs_env, scf_env) CALL qs_ks_did_change(ks_env, potential_changed=.TRUE.) CALL outer_loop_switch(scf_env, scf_control, cdft_control, cdft2ot) @@ -1270,18 +1270,18 @@ SUBROUTINE qs_calculate_inverse_jacobian(qs_env) converged=converged, should_stop=should_stop) CALL outer_loop_switch(scf_env, scf_control, cdft_control, ot2cdft) ! Update (iter_count + 1) element of gradient and print constraint info - scf_env%outer_scf%iter_count = scf_env%outer_scf%iter_count+1 + scf_env%outer_scf%iter_count = scf_env%outer_scf%iter_count + 1 CALL outer_loop_gradient(qs_env, scf_env) CALL qs_scf_cdft_info(output_unit, scf_control, scf_env, cdft_control, & energy_qs, cdft_control%total_steps, & should_stop=.FALSE., outer_loop_converged=.FALSE., cdft_loop=.FALSE.) - scf_env%outer_scf%iter_count = scf_env%outer_scf%iter_count-1 + scf_env%outer_scf%iter_count = scf_env%outer_scf%iter_count - 1 ! Update Jacobian DO j = 1, nvar - jacobian(j, i) = jacobian(j, i)+coeff(iwork)*scf_env%outer_scf%gradient(j, iter_count+1) + jacobian(j, i) = jacobian(j, i) + coeff(iwork)*scf_env%outer_scf%gradient(j, iter_count + 1) END DO ! Reset everything to last converged state - scf_env%outer_scf%variables(:, iter_count+1) = 0.0_dp + scf_env%outer_scf%variables(:, iter_count + 1) = 0.0_dp scf_env%outer_scf%gradient = gradient scf_env%outer_scf%energy = energy cdft_control%total_steps = nsteps @@ -1328,7 +1328,7 @@ SUBROUTINE qs_calculate_inverse_jacobian(qs_env) CALL print_inverse_jacobian(logger, scf_env%outer_scf%inv_jacobian, iter_count) END IF ! Update counter - scf_control%outer_scf%cdft_opt_control%ijacobian(1) = scf_control%outer_scf%cdft_opt_control%ijacobian(1)+1 + scf_control%outer_scf%cdft_opt_control%ijacobian(1) = scf_control%outer_scf%cdft_opt_control%ijacobian(1) + 1 CALL timestop(handle) END SUBROUTINE qs_calculate_inverse_jacobian @@ -1428,7 +1428,7 @@ SUBROUTINE qs_cdft_line_search(qs_env) nsteps = cdft_control%total_steps ! Allocate work nvar = SIZE(scf_env%outer_scf%variables, 1) - max_scf = scf_control%outer_scf%max_scf+1 + max_scf = scf_control%outer_scf%max_scf + 1 max_linesearch = scf_control%outer_scf%cdft_opt_control%max_ls continue_ls = scf_control%outer_scf%cdft_opt_control%continue_ls factor = scf_control%outer_scf%cdft_opt_control%factor_ls @@ -1443,7 +1443,7 @@ SUBROUTINE qs_cdft_line_search(qs_env) IF (scf_control%outer_scf%cdft_opt_control%broyden_update) THEN CALL outer_loop_optimize(scf_env, scf_control) ! Reset the variables and prevent a reupdate of inv_jacobian - scf_env%outer_scf%variables(:, iter_count+1) = 0 + scf_env%outer_scf%variables(:, iter_count + 1) = 0 scf_control%outer_scf%cdft_opt_control%broyden_update = .FALSE. END IF ! Print some info @@ -1475,8 +1475,8 @@ SUBROUTINE qs_cdft_line_search(qs_env) END IF inv_jacobian => scf_env%outer_scf%inv_jacobian ! Newton update of CDFT variables with a step size of alpha - scf_env%outer_scf%variables(:, iter_count+1) = scf_env%outer_scf%variables(:, iter_count)-alpha* & - MATMUL(inv_jacobian, scf_env%outer_scf%gradient(:, iter_count)) + scf_env%outer_scf%variables(:, iter_count + 1) = scf_env%outer_scf%variables(:, iter_count) - alpha* & + MATMUL(inv_jacobian, scf_env%outer_scf%gradient(:, iter_count)) ! With updated CDFT variables, perform SCF CALL outer_loop_update_qs_env(qs_env, scf_env) CALL qs_ks_did_change(ks_env, potential_changed=.TRUE.) @@ -1485,22 +1485,22 @@ SUBROUTINE qs_cdft_line_search(qs_env) converged=converged, should_stop=should_stop) CALL outer_loop_switch(scf_env, scf_control, cdft_control, ot2cdft) ! Update (iter_count + 1) element of gradient and print constraint info - scf_env%outer_scf%iter_count = scf_env%outer_scf%iter_count+1 + scf_env%outer_scf%iter_count = scf_env%outer_scf%iter_count + 1 CALL outer_loop_gradient(qs_env, scf_env) CALL qs_scf_cdft_info(output_unit, scf_control, scf_env, cdft_control, & energy_qs, cdft_control%total_steps, & should_stop=.FALSE., outer_loop_converged=.FALSE., cdft_loop=.FALSE.) - scf_env%outer_scf%iter_count = scf_env%outer_scf%iter_count-1 + scf_env%outer_scf%iter_count = scf_env%outer_scf%iter_count - 1 ! Store sign of initial gradient for each variable for continue_ls IF (continue_ls .AND. .NOT. ALLOCATED(positive_sign)) THEN ALLOCATE (positive_sign(nvar)) DO ispin = 1, nvar - positive_sign(ispin) = scf_env%outer_scf%gradient(ispin, iter_count+1) .GE. 0.0_dp + positive_sign(ispin) = scf_env%outer_scf%gradient(ispin, iter_count + 1) .GE. 0.0_dp END DO END IF ! Check if the L2 norm of the gradient decreased inv_jacobian => scf_env%outer_scf%inv_jacobian - IF (dnrm2(nvar, scf_env%outer_scf%gradient(:, iter_count+1), 1) .LT. & + IF (dnrm2(nvar, scf_env%outer_scf%gradient(:, iter_count + 1), 1) .LT. & dnrm2(nvar, scf_env%outer_scf%gradient(:, iter_count), 1)) THEN ! Optimal step size found IF (.NOT. continue_ls) THEN @@ -1510,7 +1510,7 @@ SUBROUTINE qs_cdft_line_search(qs_env) ! if max number of steps is not exceeded IF (found_solution) THEN ! Check if the norm also decreased w.r.t. to previously found solution - IF (dnrm2(nvar, scf_env%outer_scf%gradient(:, iter_count+1), 1) .GT. norm_ls) THEN + IF (dnrm2(nvar, scf_env%outer_scf%gradient(:, iter_count + 1), 1) .GT. norm_ls) THEN ! Norm increased => accept previous solution and exit continue_ls_exit = .TRUE. END IF @@ -1520,13 +1520,13 @@ SUBROUTINE qs_cdft_line_search(qs_env) should_exit = .FALSE. alpha_ls = alpha found_solution = .TRUE. - norm_ls = dnrm2(nvar, scf_env%outer_scf%gradient(:, iter_count+1), 1) + norm_ls = dnrm2(nvar, scf_env%outer_scf%gradient(:, iter_count + 1), 1) ! Check if the sign of the gradient has changed for all variables (w.r.t initial gradient) ! In this case we should exit because further line search steps will just increase the norm sign_changed = .TRUE. DO ispin = 1, nvar sign_changed = sign_changed .AND. (positive_sign(ispin) .NEQV. & - scf_env%outer_scf%gradient(ispin, iter_count+1) .GE. 0.0_dp) + scf_env%outer_scf%gradient(ispin, iter_count + 1) .GE. 0.0_dp) END DO IF (.NOT. ASSOCIATED(mos_ls)) THEN ALLOCATE (mos_ls(nspins)) @@ -1542,7 +1542,7 @@ SUBROUTINE qs_cdft_line_search(qs_env) ! Exit on last iteration IF (i == max_linesearch) continue_ls_exit = .TRUE. ! Exit if constraint target is satisfied to requested tolerance - IF (SQRT(MAXVAL(scf_env%outer_scf%gradient(:, scf_env%outer_scf%iter_count+1)**2)) .LT. & + IF (SQRT(MAXVAL(scf_env%outer_scf%gradient(:, scf_env%outer_scf%iter_count + 1)**2)) .LT. & scf_control%outer_scf%eps_scf) & continue_ls_exit = .TRUE. ! Exit if line search jumped over the optimal step length @@ -1578,7 +1578,7 @@ SUBROUTINE qs_cdft_line_search(qs_env) alpha = alpha*(1.0_dp/factor) END IF ! Reset outer SCF environment to last converged state - scf_env%outer_scf%variables(:, iter_count+1) = 0.0_dp + scf_env%outer_scf%variables(:, iter_count + 1) = 0.0_dp scf_env%outer_scf%gradient = gradient scf_env%outer_scf%energy = energy ! Exit line search if a suitable step size was found diff --git a/src/qs_scf_block_davidson.F b/src/qs_scf_block_davidson.F index 189f34b09f..e9820443d2 100644 --- a/src/qs_scf_block_davidson.F +++ b/src/qs_scf_block_davidson.F @@ -169,10 +169,10 @@ SUBROUTINE generate_extended_space(bdav_env, mo_set, matrix_h, matrix_s, output_ inotconv = 0 DO imo = 1, nmo IF (vnorm(imo) <= bdav_env%eps_iter) THEN - nmo_converged = nmo_converged+1 + nmo_converged = nmo_converged + 1 iconv(nmo_converged) = imo ELSE - nmo_not_converged = nmo_not_converged+1 + nmo_not_converged = nmo_not_converged + 1 inotconv(nmo_not_converged) = imo END IF END DO @@ -185,12 +185,12 @@ SUBROUTINE generate_extended_space(bdav_env, mo_set, matrix_h, matrix_s, output_ DO j = 1, nmo_converged imo = iconv(j) - IF (imo == i_last+1) THEN + IF (imo == i_last + 1) THEN i_last = imo iconv_set(nset, 2) = imo ELSE i_last = imo - nset = nset+1 + nset = nset + 1 iconv_set(nset, 1) = imo iconv_set(nset, 2) = imo END IF @@ -202,12 +202,12 @@ SUBROUTINE generate_extended_space(bdav_env, mo_set, matrix_h, matrix_s, output_ DO j = 1, nmo_not_converged imo = inotconv(j) - IF (imo == i_last+1) THEN + IF (imo == i_last + 1) THEN i_last = imo inotconv_set(nset, 2) = imo ELSE i_last = imo - nset = nset+1 + nset = nset + 1 inotconv_set(nset, 1) = imo inotconv_set(nset, 2) = imo END IF @@ -225,7 +225,7 @@ SUBROUTINE generate_extended_space(bdav_env, mo_set, matrix_h, matrix_s, output_ t2 = m_walltime() IF (output_unit > 0) THEN WRITE (output_unit, '(T16,I5,T24,I6,T33,E12.4,2x,E12.4,T60,F8.3)') & - iter, nmo_converged, max_norm, min_norm, t2-t1 + iter, nmo_converged, max_norm, min_norm, t2 - t1 WRITE (output_unit, *) " Reached convergence in ", iter, & " Davidson iterations" @@ -286,9 +286,9 @@ SUBROUTINE generate_extended_space(bdav_env, mo_set, matrix_h, matrix_s, output_ DO j = 1, nset_conv i_first = iconv_set(j, 1) i_last = iconv_set(j, 2) - n = i_last-i_first+1 + n = i_last - i_first + 1 CALL cp_fm_to_fm_submat(mo_coeff, c_conv, nao, n, 1, i_first, 1, jj) - jj = jj+n + jj = jj + n END DO CALL cp_fm_symm('L', 'U', nao, nmo_converged, 1.0_dp, s_fm, c_conv, 0.0_dp, m_tmp) CALL cp_gemm('N', 'T', nao, nao, nmo_converged, 1.0_dp, m_tmp, m_tmp, 0.0_dp, c_out) @@ -310,10 +310,10 @@ SUBROUTINE generate_extended_space(bdav_env, mo_set, matrix_h, matrix_s, output_ DO j = 1, nset_not_conv i_first = inotconv_set(j, 1) i_last = inotconv_set(j, 2) - n = i_last-i_first+1 + n = i_last - i_first + 1 CALL cp_fm_to_fm_submat(mo_coeff, c_notconv, nao, n, 1, i_first, 1, jj) - eig_not_conv(jj:jj+n-1) = ritz_coeff(i_first:i_last) - jj = jj+n + eig_not_conv(jj:jj + n - 1) = ritz_coeff(i_first:i_last) + jj = jj + n END DO CALL cp_gemm('N', 'N', nao, nmo_not_converged, nao, 1.0_dp, c_out, c_notconv, 0.0_dp, m_hc) CALL cp_fm_symm('L', 'U', nao, nmo_not_converged, 1.0_dp, s_fm, c_notconv, 0.0_dp, m_sc) @@ -370,14 +370,14 @@ SUBROUTINE generate_extended_space(bdav_env, mo_set, matrix_h, matrix_s, output_ ! compute ZSC CALL cp_gemm('T', 'N', nmat, nmat, nao, 1.0_dp, c_pz, m_sc, 0.0_dp, m_tmp) - CALL cp_fm_to_fm_submat(m_tmp, s_block, nmat, nmat, 1, 1, 1+nmat, 1) + CALL cp_fm_to_fm_submat(m_tmp, s_block, nmat, nmat, 1, 1, 1 + nmat, 1) CALL cp_fm_transpose(m_tmp, mt_tmp) - CALL cp_fm_to_fm_submat(mt_tmp, s_block, nmat, nmat, 1, 1, 1, 1+nmat) + CALL cp_fm_to_fm_submat(mt_tmp, s_block, nmat, nmat, 1, 1, 1, 1 + nmat) ! compute ZHC CALL cp_gemm('T', 'N', nmat, nmat, nao, 1.0_dp, c_pz, m_hc, 0.0_dp, m_tmp) - CALL cp_fm_to_fm_submat(m_tmp, h_block, nmat, nmat, 1, 1, 1+nmat, 1) + CALL cp_fm_to_fm_submat(m_tmp, h_block, nmat, nmat, 1, 1, 1 + nmat, 1) CALL cp_fm_transpose(m_tmp, mt_tmp) - CALL cp_fm_to_fm_submat(mt_tmp, h_block, nmat, nmat, 1, 1, 1, 1+nmat) + CALL cp_fm_to_fm_submat(mt_tmp, h_block, nmat, nmat, 1, 1, 1, 1 + nmat) CALL cp_fm_release(mt_tmp) @@ -396,10 +396,10 @@ SUBROUTINE generate_extended_space(bdav_env, mo_set, matrix_h, matrix_s, output_ ! compute ZSZ CALL cp_gemm('T', 'N', nmat, nmat, nao, 1.0_dp, c_pz, m_sc, 0.0_dp, m_tmp) - CALL cp_fm_to_fm_submat(m_tmp, s_block, nmat, nmat, 1, 1, 1+nmat, 1+nmat) + CALL cp_fm_to_fm_submat(m_tmp, s_block, nmat, nmat, 1, 1, 1 + nmat, 1 + nmat) ! compute ZHZ CALL cp_gemm('T', 'N', nmat, nmat, nao, 1.0_dp, c_pz, m_hc, 0.0_dp, m_tmp) - CALL cp_fm_to_fm_submat(m_tmp, h_block, nmat, nmat, 1, 1, 1+nmat, 1+nmat) + CALL cp_fm_to_fm_submat(m_tmp, h_block, nmat, nmat, 1, 1, 1 + nmat, 1 + nmat) CALL cp_fm_release(m_sc) @@ -409,7 +409,7 @@ SUBROUTINE generate_extended_space(bdav_env, mo_set, matrix_h, matrix_s, output_ ! extract egenvectors CALL cp_fm_to_fm_submat(v_block, m_tmp, nmat, nmat, 1, 1, 1, 1) CALL cp_gemm('N', 'N', nao, nmat, nmat, 1.0_dp, c_notconv, m_tmp, 0.0_dp, m_hc) - CALL cp_fm_to_fm_submat(v_block, m_tmp, nmat, nmat, 1+nmat, 1, 1, 1) + CALL cp_fm_to_fm_submat(v_block, m_tmp, nmat, nmat, 1 + nmat, 1, 1, 1) CALL cp_gemm('N', 'N', nao, nmat, nmat, 1.0_dp, c_pz, m_tmp, 1.0_dp, m_hc) CALL cp_fm_release(m_tmp) @@ -427,10 +427,10 @@ SUBROUTINE generate_extended_space(bdav_env, mo_set, matrix_h, matrix_s, output_ DO j = 1, nset_not_conv i_first = inotconv_set(j, 1) i_last = inotconv_set(j, 2) - n = i_last-i_first+1 + n = i_last - i_first + 1 CALL cp_fm_to_fm_submat(m_hc, mo_coeff, nao, n, 1, jj, 1, i_first) - eigenvalues(i_first:i_last) = evals(jj:jj+n-1) - jj = jj+n + eigenvalues(i_first:i_last) = evals(jj:jj + n - 1) + jj = jj + n END DO DEALLOCATE (iconv_set) DEALLOCATE (inotconv_set) @@ -447,7 +447,7 @@ SUBROUTINE generate_extended_space(bdav_env, mo_set, matrix_h, matrix_s, output_ t2 = m_walltime() IF (output_unit > 0) THEN WRITE (output_unit, '(T16,I5,T24,I6,T33,E12.4,2x,E12.4,T60,F8.3)') & - iter, nmo_converged, max_norm, min_norm, t2-t1 + iter, nmo_converged, max_norm, min_norm, t2 - t1 END IF t1 = m_walltime() @@ -585,10 +585,10 @@ SUBROUTINE generate_extended_space_sparse(bdav_env, mo_set, matrix_h, matrix_s, DO imo = 1, nmo IF (vnorm(imo) <= bdav_env%eps_iter) THEN - nmo_converged = nmo_converged+1 + nmo_converged = nmo_converged + 1 iconv(nmo_converged) = imo ELSE - nmo_not_converged = nmo_not_converged+1 + nmo_not_converged = nmo_not_converged + 1 inotconv(nmo_not_converged) = imo END IF END DO @@ -601,12 +601,12 @@ SUBROUTINE generate_extended_space_sparse(bdav_env, mo_set, matrix_h, matrix_s, DO j = 1, nmo_converged imo = iconv(j) - IF (imo == i_last+1) THEN + IF (imo == i_last + 1) THEN i_last = imo iconv_set(nset, 2) = imo ELSE i_last = imo - nset = nset+1 + nset = nset + 1 iconv_set(nset, 1) = imo iconv_set(nset, 2) = imo END IF @@ -618,12 +618,12 @@ SUBROUTINE generate_extended_space_sparse(bdav_env, mo_set, matrix_h, matrix_s, DO j = 1, nmo_not_converged imo = inotconv(j) - IF (imo == i_last+1) THEN + IF (imo == i_last + 1) THEN i_last = imo inotconv_set(nset, 2) = imo ELSE i_last = imo - nset = nset+1 + nset = nset + 1 inotconv_set(nset, 1) = imo inotconv_set(nset, 2) = imo END IF @@ -645,7 +645,7 @@ SUBROUTINE generate_extended_space_sparse(bdav_env, mo_set, matrix_h, matrix_s, t2 = m_walltime() IF (output_unit > 0) THEN WRITE (output_unit, '(T16,I5,T24,I6,T33,E12.4,2x,E12.4,T60,F8.3)') & - iter, nmo_converged, max_norm, min_norm, t2-t1 + iter, nmo_converged, max_norm, min_norm, t2 - t1 WRITE (output_unit, *) " Reached convergence in ", iter, & " Davidson iterations" @@ -669,9 +669,9 @@ SUBROUTINE generate_extended_space_sparse(bdav_env, mo_set, matrix_h, matrix_s, DO j = 1, nset_conv i_first = iconv_set(j, 1) i_last = iconv_set(j, 2) - n = i_last-i_first+1 + n = i_last - i_first + 1 CALL cp_fm_to_fm_submat(mo_coeff, mo_conv_fm, nao, n, 1, i_first, 1, jj) - jj = jj+n + jj = jj + n END DO ! allocate c_out sparse matrix, to project out the converged MOS @@ -716,10 +716,10 @@ SUBROUTINE generate_extended_space_sparse(bdav_env, mo_set, matrix_h, matrix_s, DO j = 1, nset_not_conv i_first = inotconv_set(j, 1) i_last = inotconv_set(j, 2) - n = i_last-i_first+1 + n = i_last - i_first + 1 CALL cp_fm_to_fm_submat(mo_coeff, mo_notconv_fm, nao, n, 1, i_first, 1, jj) - eig_not_conv(jj:jj+n-1) = ritz_coeff(i_first:i_last) - jj = jj+n + eig_not_conv(jj:jj + n - 1) = ritz_coeff(i_first:i_last) + jj = jj + n END DO ! allocate mo_conv sparse @@ -816,17 +816,17 @@ SUBROUTINE generate_extended_space_sparse(bdav_env, mo_set, matrix_h, matrix_s, ! set the bottom left part of S[C,Z] block matrix ZSC !copy sparse to full CALL copy_dbcsr_to_fm(matrix_mm, matrix_mm_fm) - CALL cp_fm_to_fm_submat(matrix_mm_fm, s_block, nmat, nmat, 1, 1, 1+nmat, 1) + CALL cp_fm_to_fm_submat(matrix_mm_fm, s_block, nmat, nmat, 1, 1, 1 + nmat, 1) CALL cp_fm_transpose(matrix_mm_fm, matrix_mmt_fm) - CALL cp_fm_to_fm_submat(matrix_mmt_fm, s_block, nmat, nmat, 1, 1, 1, 1+nmat) + CALL cp_fm_to_fm_submat(matrix_mmt_fm, s_block, nmat, nmat, 1, 1, 1, 1 + nmat) ! compute the bottom left ZHC (top right is transpose) CALL dbcsr_multiply('t', 'n', 1.0_dp, matrix_pz, matrix_hc, 0.0_dp, matrix_mm, last_column=nmat) ! set the bottom left part of S[C,Z] block matrix ZHC CALL copy_dbcsr_to_fm(matrix_mm, matrix_mm_fm) - CALL cp_fm_to_fm_submat(matrix_mm_fm, h_block, nmat, nmat, 1, 1, 1+nmat, 1) + CALL cp_fm_to_fm_submat(matrix_mm_fm, h_block, nmat, nmat, 1, 1, 1 + nmat, 1) CALL cp_fm_transpose(matrix_mm_fm, matrix_mmt_fm) - CALL cp_fm_to_fm_submat(matrix_mmt_fm, h_block, nmat, nmat, 1, 1, 1, 1+nmat) + CALL cp_fm_to_fm_submat(matrix_mmt_fm, h_block, nmat, nmat, 1, 1, 1, 1 + nmat) CALL cp_fm_release(matrix_mmt_fm) @@ -839,13 +839,13 @@ SUBROUTINE generate_extended_space_sparse(bdav_env, mo_set, matrix_h, matrix_s, CALL dbcsr_multiply('t', 'n', 1.0_dp, matrix_pz, matrix_sc, 0.0_dp, matrix_mm, last_column=k) ! set the bottom right part of S[C,Z] block matrix ZSZ CALL copy_dbcsr_to_fm(matrix_mm, matrix_mm_fm) - CALL cp_fm_to_fm_submat(matrix_mm_fm, s_block, nmat, nmat, 1, 1, 1+nmat, 1+nmat) + CALL cp_fm_to_fm_submat(matrix_mm_fm, s_block, nmat, nmat, 1, 1, 1 + nmat, 1 + nmat) ! compute the bottom right ZHZ CALL dbcsr_multiply('t', 'n', 1.0_dp, matrix_pz, matrix_hc, 0.0_dp, matrix_mm, last_column=k) ! set the bottom right part of H[C,Z] block matrix ZHZ CALL copy_dbcsr_to_fm(matrix_mm, matrix_mm_fm) - CALL cp_fm_to_fm_submat(matrix_mm_fm, h_block, nmat, nmat, 1, 1, 1+nmat, 1+nmat) + CALL cp_fm_to_fm_submat(matrix_mm_fm, h_block, nmat, nmat, 1, 1, 1 + nmat, 1 + nmat) CALL dbcsr_release_p(matrix_mm) CALL dbcsr_release_p(matrix_sc) @@ -865,7 +865,7 @@ SUBROUTINE generate_extended_space_sparse(bdav_env, mo_set, matrix_h, matrix_s, ! extract egenvectors CALL cp_fm_to_fm_submat(v_block, matrix_mm_fm, nmat, nmat, 1, 1, 1, 1) CALL cp_gemm('N', 'N', nao, nmat, nmat, 1.0_dp, mo_notconv_fm, matrix_mm_fm, 0.0_dp, matrix_nm_fm) - CALL cp_fm_to_fm_submat(v_block, matrix_mm_fm, nmat, nmat, 1+nmat, 1, 1, 1) + CALL cp_fm_to_fm_submat(v_block, matrix_mm_fm, nmat, nmat, 1 + nmat, 1, 1, 1) CALL cp_gemm('N', 'N', nao, nmat, nmat, 1.0_dp, matrix_z_fm, matrix_mm_fm, 1.0_dp, matrix_nm_fm) CALL dbcsr_release_p(matrix_z) @@ -883,10 +883,10 @@ SUBROUTINE generate_extended_space_sparse(bdav_env, mo_set, matrix_h, matrix_s, DO j = 1, nset_not_conv i_first = inotconv_set(j, 1) i_last = inotconv_set(j, 2) - n = i_last-i_first+1 + n = i_last - i_first + 1 CALL cp_fm_to_fm_submat(matrix_nm_fm, mo_coeff, nao, n, 1, jj, 1, i_first) - eigenvalues(i_first:i_last) = evals(jj:jj+n-1) - jj = jj+n + eigenvalues(i_first:i_last) = evals(jj:jj + n - 1) + jj = jj + n END DO DEALLOCATE (iconv_set) DEALLOCATE (inotconv_set) @@ -906,7 +906,7 @@ SUBROUTINE generate_extended_space_sparse(bdav_env, mo_set, matrix_h, matrix_s, t2 = m_walltime() IF (output_unit > 0) THEN WRITE (output_unit, '(T16,I5,T24,I6,T33,E12.4,2x,E12.4,T60,F8.3)') & - iter, nmo_converged, max_norm, min_norm, t2-t1 + iter, nmo_converged, max_norm, min_norm, t2 - t1 END IF t1 = m_walltime() diff --git a/src/qs_scf_diagonalization.F b/src/qs_scf_diagonalization.F index 953eb94b0f..e1cce6a78b 100644 --- a/src/qs_scf_diagonalization.F +++ b/src/qs_scf_diagonalization.F @@ -370,7 +370,7 @@ SUBROUTINE do_general_diag_kp(matrix_ks, matrix_s, kpoints, scf_env, scf_control nkp_groups=nkp_groups, kp_dist=kp_dist, sab_nl=sab_nl, & cell_to_index=cell_to_index) CPASSERT(ASSOCIATED(sab_nl)) - kplocal = kp_range(2)-kp_range(1)+1 + kplocal = kp_range(2) - kp_range(1) + 1 ! allocate some work matrices ALLOCATE (rmatrix, cmatrix, tmpmat) @@ -415,9 +415,9 @@ SUBROUTINE do_general_diag_kp(matrix_ks, matrix_s, kpoints, scf_env, scf_control DO ispin = 1, nspin DO igroup = 1, nkp_groups ! number of current kpoint - ik = kp_dist(1, igroup)+ikp-1 + ik = kp_dist(1, igroup) + ikp - 1 my_kpgrp = (ik >= kpoints%kp_range(1) .AND. ik <= kpoints%kp_range(2)) - indx = indx+1 + indx = indx + 1 IF (use_real_wfn) THEN ! FT of matrices KS and S, then transfer to FM type CALL dbcsr_set(rmatrix, 0.0_dp) @@ -486,9 +486,9 @@ SUBROUTINE do_general_diag_kp(matrix_ks, matrix_s, kpoints, scf_env, scf_control DO ispin = 1, nspin DO igroup = 1, nkp_groups ! number of current kpoint - ik = kp_dist(1, igroup)+ikp-1 + ik = kp_dist(1, igroup) + ikp - 1 my_kpgrp = (ik >= kpoints%kp_range(1) .AND. ik <= kpoints%kp_range(2)) - indx = indx+1 + indx = indx + 1 IF (my_kpgrp) THEN IF (use_real_wfn) THEN CALL cp_fm_finish_copy_general(rksmat, info(indx, 1)) @@ -540,9 +540,9 @@ SUBROUTINE do_general_diag_kp(matrix_ks, matrix_s, kpoints, scf_env, scf_control DO ispin = 1, nspin DO igroup = 1, nkp_groups ! number of current kpoint - ik = kp_dist(1, igroup)+ikp-1 + ik = kp_dist(1, igroup) + ikp - 1 my_kpgrp = (ik >= kpoints%kp_range(1) .AND. ik <= kpoints%kp_range(2)) - indx = indx+1 + indx = indx + 1 IF (use_real_wfn) THEN CALL cp_fm_cleanup_copy_general(fmwork(1)%matrix, info(indx, 1)) CALL cp_fm_cleanup_copy_general(fmwork(3)%matrix, info(indx, 2)) @@ -750,7 +750,7 @@ SUBROUTINE do_scf_diag_subspace(qs_env, scf_env, subspace_env, mos, rho, & subspace_env%p_matrix_mix(ispin, 1)%matrix) DO i = 1, nmo - sum_band = sum_band+mo_eigenvalues(i)*mo_occupations(i) + sum_band = sum_band + mo_eigenvalues(i)*mo_occupations(i) END DO !check for self consistency @@ -776,13 +776,13 @@ SUBROUTINE do_scf_diag_subspace(qs_env, scf_env, subspace_env, mos, rho, & rho, para_env, scf_env%iter_count) END IF - ene_diff = energy%total-ene_old + ene_diff = energy%total - ene_old converged = (ABS(ene_diff) < subspace_env%eps_ene .AND. & iter_delta < subspace_env%eps_adapt*scf_env%iter_delta) t2 = m_walltime() IF (output_unit > 0) THEN WRITE (output_unit, "(T4,I5,T11,F8.3,T18,E14.4,T34,F12.5,T46,F16.8,T62,E14.4)") & - iloop, t2-t1, iter_delta, sum_band, energy%total, ene_diff + iloop, t2 - t1, iter_delta, sum_band, energy%total, ene_diff CALL m_flush(output_unit) END IF IF (converged) THEN @@ -1265,10 +1265,10 @@ SUBROUTINE do_roks_diag(scf_env, mos, matrix_ks, matrix_s, & ! Apply level-shifting using 50:50 split of the shift (could be relaxed) - DO imo = homob+1, homoa + DO imo = homob + 1, homoa CALL cp_fm_add_to_element(ksa, imo, imo, 0.5_dp*level_shift_loc) END DO - DO imo = homoa+1, nmo + DO imo = homoa + 1, nmo CALL cp_fm_add_to_element(ksa, imo, imo, level_shift_loc) END DO @@ -1325,11 +1325,11 @@ SUBROUTINE do_roks_diag(scf_env, mos, matrix_ks, matrix_s, & ! Correct MO eigenvalues, if level-shifting was applied IF (level_shift_loc /= 0.0_dp) THEN - DO imo = homob+1, homoa - eiga(imo) = eiga(imo)-0.5_dp*level_shift_loc + DO imo = homob + 1, homoa + eiga(imo) = eiga(imo) - 0.5_dp*level_shift_loc END DO - DO imo = homoa+1, nmo - eiga(imo) = eiga(imo)-level_shift_loc + DO imo = homoa + 1, nmo + eiga(imo) = eiga(imo) - level_shift_loc END DO END IF @@ -1473,7 +1473,7 @@ SUBROUTINE do_block_krylov_diag(scf_env, mos, matrix_ks, & IF (output_unit > 0) & WRITE (output_unit, '(T8,I3,T16,I5,T24,I6,T33,E12.4,2x,E12.4,T60,F8.3)') & ispin, iter, scf_env%krylov_space%nmo_conv, & - scf_env%krylov_space%max_res_norm, scf_env%krylov_space%min_res_norm, t2-t1 + scf_env%krylov_space%max_res_norm, scf_env%krylov_space%min_res_norm, t2 - t1 CYCLE ELSE @@ -1485,7 +1485,7 @@ SUBROUTINE do_block_krylov_diag(scf_env, mos, matrix_ks, & IF (output_unit > 0) THEN WRITE (output_unit, '(T8,I3,T16,I5,T24,I6,T33,E12.4,2x,E12.4,T60,F8.3)') & ispin, iter, scf_env%krylov_space%nmo_conv, & - scf_env%krylov_space%max_res_norm, scf_env%krylov_space%min_res_norm, t2-t1 + scf_env%krylov_space%max_res_norm, scf_env%krylov_space%min_res_norm, t2 - t1 END IF t1 = m_walltime() IF (scf_env%krylov_space%max_res_norm < eps_iter) THEN diff --git a/src/qs_scf_initialization.F b/src/qs_scf_initialization.F index b026b16ffa..edd3990d90 100644 --- a/src/qs_scf_initialization.F +++ b/src/qs_scf_initialization.F @@ -280,7 +280,7 @@ SUBROUTINE qs_scf_ensure_outer_loop_vars(scf_env, scf_control, nvar) INTEGER :: nhistory, nvariables IF (scf_control%outer_scf%have_scf) THEN - nhistory = scf_control%outer_scf%max_scf+1 + nhistory = scf_control%outer_scf%max_scf + 1 IF (PRESENT(nvar)) THEN IF (nvar > 0) THEN nvariables = nvar @@ -332,7 +332,7 @@ SUBROUTINE qs_scf_ensure_cdft_loop_vars(qs_env, scf_env, dft_control, scf_contro CPABORT("Section SCF&OUTER_SCF must be active for CDFT calculations.") ! Initialize CDFT and outer_loop variables (constraint settings active in scf_control) IF (dft_control%qs_control%cdft_control%constraint_control%have_scf) THEN - nhistory = dft_control%qs_control%cdft_control%constraint_control%max_scf+1 + nhistory = dft_control%qs_control%cdft_control%constraint_control%max_scf + 1 IF (scf_control%outer_scf%type /= outer_scf_none) THEN nvariables = outer_loop_variables_count(scf_control, & dft_control%qs_control%cdft_control) @@ -676,7 +676,7 @@ SUBROUTINE qs_scf_ensure_mos(qs_env, scf_env) DO ik = 1, SIZE(kpoints%kp_env) CALL mpools_get(kpoints%mpools, ao_mo_fm_pools=ao_mo_fm_pools) mos_k => kpoints%kp_env(ik)%kpoint_env%mos - ikk = kpoints%kp_range(1)+ik-1 + ikk = kpoints%kp_range(1) + ik - 1 CPASSERT(ASSOCIATED(mos_k)) DO ispin = 1, SIZE(mos_k, 2) DO ic = 1, SIZE(mos_k, 1) @@ -870,7 +870,7 @@ SUBROUTINE qs_scf_ensure_diagonalization(scf_env, scf_section, qs_env, & ELSEIF (scf_control%use_ot) THEN scf_env%method = ot_method_nr need_coeff_b = .TRUE. - IF (scf_control%added_mos(1)+scf_control%added_mos(2) > 0) & + IF (scf_control%added_mos(1) + scf_control%added_mos(2) > 0) & CPABORT("OT with ADDED_MOS/=0 not implemented") IF (dft_control%restricted .AND. dft_control%nspins .NE. 2) & CPABORT("nspin must be 2 for restricted (ROKS)") @@ -1024,7 +1024,7 @@ SUBROUTINE init_scf_run(scf_env, qs_env, scf_section, scf_control) extension=".scfLog") IF (output_unit > 0) THEN WRITE (UNIT=output_unit, FMT="(T2,A,T71,I10)") & - "Number of independent orbital functions:", nao-ndep + "Number of independent orbital functions:", nao - ndep END IF CALL cp_print_key_finished_output(output_unit, logger, scf_section, & "PRINT%PROGRAM_RUN_INFO") diff --git a/src/qs_scf_lanczos.F b/src/qs_scf_lanczos.F index 6aaec503f3..e21cf19ebc 100644 --- a/src/qs_scf_lanczos.F +++ b/src/qs_scf_lanczos.F @@ -255,9 +255,9 @@ SUBROUTINE lanczos_refinement(krylov_space, ks, c0, c1, eval, nao, & END DO DO imo = 1, nmo IF (c_res(imo) <= eps_iter) THEN - nmo_converged = nmo_converged+1 + nmo_converged = nmo_converged + 1 ELSE - nmo_nc = nmo-nmo_converged + nmo_nc = nmo - nmo_converged EXIT END IF END DO @@ -277,20 +277,20 @@ SUBROUTINE lanczos_refinement(krylov_space, ks, c0, c1, eval, nao, & RETURN ELSE IF (krylov_space%nmo_nc > 0) THEN - CALL cp_fm_to_fm(c0, c1, nmo_nc, nmo_converged+1, 1) + CALL cp_fm_to_fm(c0, c1, nmo_nc, nmo_converged + 1, 1) nblock = krylov_space%nblock IF (MODULO(nmo_nc, nblock) > 0.0_dp) THEN - num_blocks = nmo_nc/nblock+1 + num_blocks = nmo_nc/nblock + 1 ELSE num_blocks = nmo_nc/nblock END IF DO ib = 1, num_blocks - imo_low = (ib-1)*nblock+1 + imo_low = (ib - 1)*nblock + 1 imo_up = MIN(ib*nblock, nmo_nc) - nmob = imo_up-imo_low+1 + nmob = imo_up - imo_low + 1 ndim = krylov_space%nkrylov*nmob NULLIFY (fm_struct_tmp) @@ -391,14 +391,14 @@ SUBROUTINE lanczos_refinement(krylov_space, ks, c0, c1, eval, nao, & CALL cp_gemm('N', 'N', nao, nmob, nmob, rone, v_mat(ik)%matrix, a_mat, & rzero, c_tmp) CALL cp_fm_scale_and_add(rmone, c_tmp, rone, hc) - CALL cp_fm_to_fm(v_mat(ik-1)%matrix, hc, nmob, 1, 1) + CALL cp_fm_to_fm(v_mat(ik - 1)%matrix, hc, nmob, 1, 1) CALL cp_fm_triangular_multiply(b_mat, hc, side='R', transpose_tr=.TRUE., & n_rows=nao, n_cols=nmob, alpha=rmone) CALL cp_fm_scale_and_add(rone, c_tmp, rone, hc) ! Build the block tridiagonal matrix - it = (ik-2)*nmob+1 - jt = (ik-1)*nmob+1 + it = (ik - 2)*nmob + 1 + jt = (ik - 1)*nmob + 1 CALL cp_fm_get_submatrix(a_mat, tblock, 1, 1, nmob, nmob) CALL cp_fm_set_submatrix(t_mat, tblock, jt, jt, nmob, nmob) @@ -421,9 +421,9 @@ SUBROUTINE lanczos_refinement(krylov_space, ks, c0, c1, eval, nao, & ! !Compute the refined vectors CALL cp_fm_set_all(c2_tmp, rzero) DO ik = 1, krylov_space%nkrylov - jt = (ik-1)*nmob + jt = (ik - 1)*nmob CALL cp_gemm('N', 'N', nao, ndim, nmob, rone, v_mat(ik)%matrix, t_vec, rone, c2_tmp, & - b_first_row=(jt+1)) + b_first_row=(jt + 1)) END DO DEALLOCATE (tvblock) @@ -454,7 +454,7 @@ SUBROUTINE lanczos_refinement(krylov_space, ks, c0, c1, eval, nao, & DEALLOCATE (q_mat) !Copy in the converged set to enlarge the converged subspace - CALL cp_fm_to_fm(v_mat(1)%matrix, c0, nmob, 1, (nmo_converged+imo_low)) + CALL cp_fm_to_fm(v_mat(1)%matrix, c0, nmob, 1, (nmo_converged + imo_low)) CALL timestop(hand4) IF (nmob < nblock) THEN @@ -600,9 +600,9 @@ SUBROUTINE lanczos_refinement_2v(krylov_space, ks, c0, c1, eval, nao, & END DO DO imo = 1, nmo IF (c_res(imo) <= eps_iter) THEN - nmo_converged = nmo_converged+1 + nmo_converged = nmo_converged + 1 ELSE - nmo_nc = nmo-nmo_converged + nmo_nc = nmo - nmo_converged EXIT END IF END DO @@ -620,20 +620,20 @@ SUBROUTINE lanczos_refinement_2v(krylov_space, ks, c0, c1, eval, nao, & ! Do nothing ELSE IF (krylov_space%nmo_nc > 0) THEN - CALL cp_fm_to_fm(c0, c1, nmo_nc, nmo_converged+1, 1) + CALL cp_fm_to_fm(c0, c1, nmo_nc, nmo_converged + 1, 1) nblock = krylov_space%nblock IF (MODULO(nmo_nc, nblock) > 0.0_dp) THEN - num_blocks = nmo_nc/nblock+1 + num_blocks = nmo_nc/nblock + 1 ELSE num_blocks = nmo_nc/nblock END IF DO ib = 1, num_blocks - imo_low = (ib-1)*nblock+1 + imo_low = (ib - 1)*nblock + 1 imo_up = MIN(ib*nblock, nmo_nc) - nmob = imo_up-imo_low+1 + nmob = imo_up - imo_low + 1 ndim = krylov_space%nkrylov*nmob ! Allocation @@ -768,32 +768,32 @@ SUBROUTINE lanczos_refinement_2v(krylov_space, ks, c0, c1, eval, nao, & CALL cp_fm_scale_and_add(rmone, c_tmp, rone, hc) IF (SIZE(c_tmp%local_data, 2) == nmob) THEN - a_loc => v_mat(ik-1)%matrix%local_data + a_loc => v_mat(ik - 1)%matrix%local_data DO j = 1, nmob DO i = 1, j DO ia = 1, SIZE(c_tmp%local_data, 1) - b_loc(ia, i) = b_loc(ia, i)-a_loc(ia, j)*b_block(i, j) + b_loc(ia, i) = b_loc(ia, i) - a_loc(ia, j)*b_block(i, j) END DO END DO END DO END IF ! Build the block tridiagonal matrix - it = (ik-2)*nmob - jt = (ik-1)*nmob + it = (ik - 2)*nmob + jt = (ik - 1)*nmob DO j = 1, nmob - t_mat(jt+1:jt+nmob, jt+j) = a_block(1:nmob, j) + t_mat(jt + 1:jt + nmob, jt + j) = a_block(1:nmob, j) DO i = 1, nmob - t_mat(it+i, jt+j) = b_block(j, i) - t_mat(jt+j, it+i) = b_block(j, i) + t_mat(it + i, jt + j) = b_block(j, i) + t_mat(jt + j, it + i) = b_block(j, i) END DO END DO END DO ! ik CALL timestop(hand2) CALL timeset(routineN//"_diag_tri", hand3) - lwork = 1+6*ndim+2*ndim**2+5000 - liwork = 5*ndim+3 + lwork = 1 + 6*ndim + 2*ndim**2 + 5000 + liwork = 5*ndim + 3 ALLOCATE (work(lwork)) ALLOCATE (iwork(liwork)) @@ -816,9 +816,9 @@ SUBROUTINE lanczos_refinement_2v(krylov_space, ks, c0, c1, eval, nao, & IF (SIZE(c2_tmp%local_data, 2) == ndim) THEN ! a_loc => v_mat(ik)%matrix%local_data a_loc => v_tmp%local_data - it = (ik-1)*nmob + it = (ik - 1)*nmob CALL dgemm('N', 'N', SIZE(c2_tmp%local_data, 1), ndim, nmob, 1.0_dp, a_loc(1, 1), & - SIZE(c2_tmp%local_data, 1), t_mat(it+1, 1), ndim, 1.0_dp, & + SIZE(c2_tmp%local_data, 1), t_mat(it + 1, 1), ndim, 1.0_dp, & b_loc(1, 1), SIZE(c2_tmp%local_data, 1)) END IF END DO !ik @@ -854,7 +854,7 @@ SUBROUTINE lanczos_refinement_2v(krylov_space, ks, c0, c1, eval, nao, & DEALLOCATE (q_mat) !Copy in the converged set to enlarge the converged subspace - CALL cp_fm_to_fm(v_mat(1)%matrix, c0, nmob, 1, (nmo_converged+imo_low)) + CALL cp_fm_to_fm(v_mat(1)%matrix, c0, nmob, 1, (nmo_converged + imo_low)) CALL timestop(hand4) CALL cp_fm_release(c2_tmp) diff --git a/src/qs_scf_loop_utils.F b/src/qs_scf_loop_utils.F index c2a6748b9d..858a2dc005 100644 --- a/src/qs_scf_loop_utils.F +++ b/src/qs_scf_loop_utils.F @@ -242,8 +242,8 @@ SUBROUTINE qs_scf_new_mos(qs_env, scf_env, scf_control, scf_section, diis_step, energy%efermi = 0.0_dp CALL get_qs_env(qs_env, mos=mos) DO ispin = 1, SIZE(mos) - energy%kTS = energy%kTS+mos(ispin)%mo_set%kTS - energy%efermi = energy%efermi+mos(ispin)%mo_set%mu + energy%kTS = energy%kTS + mos(ispin)%mo_set%kTS + energy%efermi = energy%efermi + mos(ispin)%mo_set%mu ENDDO energy%efermi = energy%efermi/REAL(SIZE(mos), KIND=dp) @@ -326,8 +326,8 @@ SUBROUTINE qs_scf_new_mos_kp(qs_env, scf_env, scf_control, diis_step) energy%efermi = 0.0_dp mos => kpoints%kp_env(1)%kpoint_env%mos DO ispin = 1, SIZE(mos, 2) - energy%kTS = energy%kTS+mos(1, ispin)%mo_set%kTS - energy%efermi = energy%efermi+mos(1, ispin)%mo_set%mu + energy%kTS = energy%kTS + mos(1, ispin)%mo_set%kTS + energy%efermi = energy%efermi + mos(1, ispin)%mo_set%mu ENDDO energy%efermi = energy%efermi/REAL(SIZE(mos, 2), KIND=dp) @@ -475,7 +475,7 @@ SUBROUTINE qs_scf_check_outer_exit(qs_env, scf_env, scf_control, should_stop, & outer_loop_converged = .TRUE. IF (scf_control%outer_scf%have_scf) THEN ! We have an outer SCF loop... - scf_env%outer_scf%iter_count = scf_env%outer_scf%iter_count+1 + scf_env%outer_scf%iter_count = scf_env%outer_scf%iter_count + 1 outer_loop_converged = .FALSE. CALL outer_loop_gradient(qs_env, scf_env) diff --git a/src/qs_scf_methods.F b/src/qs_scf_methods.F index 3dd3e544d1..83d61aa425 100644 --- a/src/qs_scf_methods.F +++ b/src/qs_scf_methods.F @@ -129,7 +129,7 @@ SUBROUTINE scf_env_density_mixing(p_mix_new, mixing_store, rho_ao, para_env, & CALL dbcsr_add(matrix_a=p_mix_new(ispin, ic)%matrix, & alpha_scalar=1.0_dp/my_p_mix, & matrix_b=rho_ao(ispin, ic)%matrix, & - beta_scalar=(my_p_mix-1.0_dp)/my_p_mix) + beta_scalar=(my_p_mix - 1.0_dp)/my_p_mix) END IF ELSE CALL cp_sm_mix(m1=p_mix_new(ispin, ic)%matrix, & @@ -359,12 +359,12 @@ SUBROUTINE eigensolver_symm(matrix_ks_fm, mo_set, ortho, work, do_level_shift, & IF (use_jacobi) THEN CALL cp_fm_symm("L", "U", nao, homo, 1.0_dp, matrix_ks_fm, mo_coeff, 0.0_dp, work) - CALL cp_gemm("T", "N", homo, nao-homo, nao, 1.0_dp, work, mo_coeff, & - 0.0_dp, matrix_ks_fm, b_first_col=homo+1, c_first_col=homo+1) + CALL cp_gemm("T", "N", homo, nao - homo, nao, 1.0_dp, work, mo_coeff, & + 0.0_dp, matrix_ks_fm, b_first_col=homo + 1, c_first_col=homo + 1) ! Block Jacobi (pseudo-diagonalization, only one sweep) CALL cp_fm_block_jacobi(matrix_ks_fm, mo_coeff, mo_eigenvalues, & - jacobi_threshold, homo+1) + jacobi_threshold, homo + 1) ELSE ! full S^(-1/2) has been computed @@ -440,10 +440,10 @@ SUBROUTINE eigensolver_simple(matrix_ks, mo_set, work, do_level_shift, & IF (use_jacobi) THEN CALL cp_fm_symm("L", "U", nao, homo, 1.0_dp, matrix_ks, mo_coeff, 0.0_dp, work) - CALL cp_gemm("T", "N", homo, nao-homo, nao, 1.0_dp, work, mo_coeff, & - 0.0_dp, matrix_ks, b_first_col=homo+1, c_first_col=homo+1) + CALL cp_gemm("T", "N", homo, nao - homo, nao, 1.0_dp, work, mo_coeff, & + 0.0_dp, matrix_ks, b_first_col=homo + 1, c_first_col=homo + 1) ! Block Jacobi (pseudo-diagonalization, only one sweep) - CALL cp_fm_block_jacobi(matrix_ks, mo_coeff, mo_eigenvalues, jacobi_threshold, homo+1) + CALL cp_fm_block_jacobi(matrix_ks, mo_coeff, mo_eigenvalues, jacobi_threshold, homo + 1) ELSE CALL choose_eigv_solver(matrix_ks, work, mo_eigenvalues) @@ -507,16 +507,16 @@ SUBROUTINE cp_sm_mix(m1, m2, p_mix, delta, para_env, m3) DO j = 1, SIZE(p_new_block, 2) DO i = 1, SIZE(p_new_block, 1) - p_delta_block(i, j) = p_new_block(i, j)-p_old_block(i, j) + p_delta_block(i, j) = p_new_block(i, j) - p_old_block(i, j) delta = MAX(delta, ABS(p_delta_block(i, j))) END DO END DO ELSE DO j = 1, SIZE(p_new_block, 2) DO i = 1, SIZE(p_new_block, 1) - p_new_block(i, j) = p_new_block(i, j)-p_old_block(i, j) + p_new_block(i, j) = p_new_block(i, j) - p_old_block(i, j) delta = MAX(delta, ABS(p_new_block(i, j))) - p_new_block(i, j) = p_old_block(i, j)+p_mix*p_new_block(i, j) + p_new_block(i, j) = p_old_block(i, j) + p_mix*p_new_block(i, j) END DO END DO ENDIF @@ -590,12 +590,12 @@ SUBROUTINE combine_ks_matrices_1(ksa, ksb, occa, occb, roks_parameter) DO icol_local = 1, ncol_local icol_global = col_indices(icol_local) - j = INT(occa(icol_global))+INT(occb(icol_global)) + j = INT(occa(icol_global)) + INT(occb(icol_global)) DO irow_local = 1, nrow_local irow_global = row_indices(irow_local) - i = INT(occa(irow_global))+INT(occb(irow_global)) + i = INT(occa(irow_global)) + INT(occb(irow_global)) fa(irow_local, icol_local) = & - roks_parameter(i, j, 1)*fa(irow_local, icol_local)+ & + roks_parameter(i, j, 1)*fa(irow_local, icol_local) + & roks_parameter(i, j, 2)*fb(irow_local, icol_local) END DO END DO @@ -664,7 +664,7 @@ SUBROUTINE combine_ks_matrices_2(ksa, ksb, occa, occb, f, nalpha, nbeta) compatible_matrices = cp_fm_struct_equivalent(ksa_struct, ksb_struct) CPASSERT(compatible_matrices) - beta = 1.0_dp/(1.0_dp-f) + beta = 1.0_dp/(1.0_dp - f) DO icol_local = 1, ncol_local @@ -674,7 +674,7 @@ SUBROUTINE combine_ks_matrices_2(ksa, ksb, occa, occb, f, nalpha, nbeta) irow_global = row_indices(irow_local) - t1 = 0.5_dp*(fa(irow_local, icol_local)+fb(irow_local, icol_local)) + t1 = 0.5_dp*(fa(irow_local, icol_local) + fb(irow_local, icol_local)) IF ((0 < irow_global) .AND. (irow_global <= nbeta)) THEN IF ((0 < icol_global) .AND. (icol_global <= nbeta)) THEN @@ -682,10 +682,10 @@ SUBROUTINE combine_ks_matrices_2(ksa, ksb, occa, occb, f, nalpha, nbeta) fa(irow_local, icol_local) = t1 ELSE IF ((nbeta < icol_global) .AND. (icol_global <= nalpha)) THEN ! closed-open - ta = 0.5_dp*(f-REAL(occa(icol_global), KIND=dp))/f - tb = 0.5_dp*(f-REAL(occb(icol_global), KIND=dp))/f - t2 = ta*fa(irow_local, icol_local)+tb*fb(irow_local, icol_local) - fa(irow_local, icol_local) = t1+(beta-1.0_dp)*t2 + ta = 0.5_dp*(f - REAL(occa(icol_global), KIND=dp))/f + tb = 0.5_dp*(f - REAL(occb(icol_global), KIND=dp))/f + t2 = ta*fa(irow_local, icol_local) + tb*fb(irow_local, icol_local) + fa(irow_local, icol_local) = t1 + (beta - 1.0_dp)*t2 ELSE ! closed-virtual fa(irow_local, icol_local) = t1 @@ -693,26 +693,26 @@ SUBROUTINE combine_ks_matrices_2(ksa, ksb, occa, occb, f, nalpha, nbeta) ELSE IF ((nbeta < irow_global) .AND. (irow_global <= nalpha)) THEN IF ((0 < irow_global) .AND. (irow_global <= nbeta)) THEN ! open-closed - ta = 0.5_dp*(f-REAL(occa(irow_global), KIND=dp))/f - tb = 0.5_dp*(f-REAL(occb(irow_global), KIND=dp))/f - t2 = ta*fa(irow_local, icol_local)+tb*fb(irow_local, icol_local) - fa(irow_local, icol_local) = t1+(beta-1.0_dp)*t2 + ta = 0.5_dp*(f - REAL(occa(irow_global), KIND=dp))/f + tb = 0.5_dp*(f - REAL(occb(irow_global), KIND=dp))/f + t2 = ta*fa(irow_local, icol_local) + tb*fb(irow_local, icol_local) + fa(irow_local, icol_local) = t1 + (beta - 1.0_dp)*t2 ELSE IF ((nbeta < icol_global) .AND. (icol_global <= nalpha)) THEN ! open-open - ta = 0.5_dp*(f-REAL(occa(icol_global), KIND=dp))/f - tb = 0.5_dp*(f-REAL(occb(icol_global), KIND=dp))/f - t2 = ta*fa(irow_local, icol_local)+tb*fb(irow_local, icol_local) + ta = 0.5_dp*(f - REAL(occa(icol_global), KIND=dp))/f + tb = 0.5_dp*(f - REAL(occb(icol_global), KIND=dp))/f + t2 = ta*fa(irow_local, icol_local) + tb*fb(irow_local, icol_local) IF (irow_global == icol_global) THEN - fa(irow_local, icol_local) = t1-t2 + fa(irow_local, icol_local) = t1 - t2 ELSE - fa(irow_local, icol_local) = t1-0.5_dp*t2 + fa(irow_local, icol_local) = t1 - 0.5_dp*t2 END IF ELSE ! open-virtual - ta = 0.5_dp*(f-REAL(occa(irow_global), KIND=dp))/f - tb = 0.5_dp*(f-REAL(occb(irow_global), KIND=dp))/f - t2 = ta*fa(irow_local, icol_local)+tb*fb(irow_local, icol_local) - fa(irow_local, icol_local) = t1-t2 + ta = 0.5_dp*(f - REAL(occa(irow_global), KIND=dp))/f + tb = 0.5_dp*(f - REAL(occb(irow_global), KIND=dp))/f + t2 = ta*fa(irow_local, icol_local) + tb*fb(irow_local, icol_local) + fa(irow_local, icol_local) = t1 - t2 END IF ELSE IF ((0 < irow_global) .AND. (irow_global < nbeta)) THEN @@ -720,10 +720,10 @@ SUBROUTINE combine_ks_matrices_2(ksa, ksb, occa, occb, f, nalpha, nbeta) fa(irow_local, icol_local) = t1 ELSE IF ((nbeta < icol_global) .AND. (icol_global <= nalpha)) THEN ! virtual-open - ta = 0.5_dp*(f-REAL(occa(icol_global), KIND=dp))/f - tb = 0.5_dp*(f-REAL(occb(icol_global), KIND=dp))/f - t2 = ta*fa(irow_local, icol_local)+tb*fb(irow_local, icol_local) - fa(irow_local, icol_local) = t1-t2 + ta = 0.5_dp*(f - REAL(occa(icol_global), KIND=dp))/f + tb = 0.5_dp*(f - REAL(occb(icol_global), KIND=dp))/f + t2 = ta*fa(irow_local, icol_local) + tb*fb(irow_local, icol_local) + fa(irow_local, icol_local) = t1 - t2 ELSE ! virtual-virtual fa(irow_local, icol_local) = t1 @@ -761,8 +761,8 @@ SUBROUTINE correct_mo_eigenvalues(mo_eigenvalues, homo, nmo, level_shift) INTEGER :: imo - DO imo = homo+1, nmo - mo_eigenvalues(imo) = mo_eigenvalues(imo)-level_shift + DO imo = homo + 1, nmo + mo_eigenvalues(imo) = mo_eigenvalues(imo) - level_shift END DO END SUBROUTINE correct_mo_eigenvalues @@ -831,7 +831,7 @@ SUBROUTINE shift_unocc_mos(matrix_ks_fm, mo_coeff, homo, nmo, nao, & ! MO index : 1 .. homo homo+1 ... nmo ALLOCATE (weights(nmo)) weights(1:homo) = 0.0_dp - weights(homo+1:nmo) = level_shift + weights(homo + 1:nmo) = level_shift ! DELTA * U * C ! DELTA is a diagonal matrix, so simply scale all the columns of (U * C) by weights(:) CALL cp_fm_column_scale(u_mo_scaled, weights) diff --git a/src/qs_scf_output.F b/src/qs_scf_output.F index c1cc04eddd..c1f1dce5c4 100644 --- a/src/qs_scf_output.F +++ b/src/qs_scf_output.F @@ -247,19 +247,19 @@ SUBROUTINE qs_scf_loop_info(scf_env, output_unit, just_energy, t1, t2, energy) WRITE (UNIT=output_unit, & FMT="(T2,I5,1X,A,T20,E8.2,1X,F6.1,16X,F20.10)") & scf_env%iter_count, TRIM(scf_env%iter_method), scf_env%iter_param, & - t2-t1, energy%total + t2 - t1, energy%total ELSE IF ((ABS(scf_env%iter_delta) < 1.0E-8_dp) .OR. & (ABS(scf_env%iter_delta) >= 1.0E5_dp)) THEN WRITE (UNIT=output_unit, & FMT="(T2,I5,1X,A,T20,E8.2,1X,F6.1,1X,ES14.4,1X,F20.10,1X,ES9.2)") & scf_env%iter_count, TRIM(scf_env%iter_method), scf_env%iter_param, & - t2-t1, scf_env%iter_delta, energy%total, energy%total-energy%tot_old + t2 - t1, scf_env%iter_delta, energy%total, energy%total - energy%tot_old ELSE WRITE (UNIT=output_unit, & FMT="(T2,I5,1X,A,T20,E8.2,1X,F6.1,1X,F14.8,1X,F20.10,1X,ES9.2)") & scf_env%iter_count, TRIM(scf_env%iter_method), scf_env%iter_param, & - t2-t1, scf_env%iter_delta, energy%total, energy%total-energy%tot_old + t2 - t1, scf_env%iter_delta, energy%total, energy%total - energy%tot_old END IF END IF END IF @@ -317,32 +317,32 @@ SUBROUTINE qs_scf_print_scf_summary(output_unit, rho, qs_charges, energy, nelect WRITE (UNIT=output_unit, FMT="(/,(T3,A,T41,2F20.10))") & "Electronic density on regular grids: ", & accurate_sum(tot_rho_r), & - accurate_sum(tot_rho_r)+nelectron_total, & + accurate_sum(tot_rho_r) + nelectron_total, & "Core density on regular grids:", & qs_charges%total_rho_core_rspace, & - qs_charges%total_rho_core_rspace-REAL(nelectron_total+dft_control%charge, dp) + qs_charges%total_rho_core_rspace - REAL(nelectron_total + dft_control%charge, dp) IF (gapw) THEN tot1_h = qs_charges%total_rho1_hard(1) tot1_s = qs_charges%total_rho1_soft(1) DO ispin = 2, dft_control%nspins - tot1_h = tot1_h+qs_charges%total_rho1_hard(ispin) - tot1_s = tot1_s+qs_charges%total_rho1_soft(ispin) + tot1_h = tot1_h + qs_charges%total_rho1_hard(ispin) + tot1_s = tot1_s + qs_charges%total_rho1_soft(ispin) END DO WRITE (UNIT=output_unit, FMT="((T3,A,T41,2F20.10))") & "Hard and soft densities (Lebedev):", & tot1_h, tot1_s WRITE (UNIT=output_unit, FMT="(T3,A,T41,F20.10)") & "Total Rho_soft + Rho1_hard - Rho1_soft (r-space): ", & - accurate_sum(tot_rho_r)+tot1_h-tot1_s, & + accurate_sum(tot_rho_r) + tot1_h - tot1_s, & "Total charge density (r-space): ", & - accurate_sum(tot_rho_r)+tot1_h-tot1_s & - +qs_charges%total_rho_core_rspace, & + accurate_sum(tot_rho_r) + tot1_h - tot1_s & + + qs_charges%total_rho_core_rspace, & "Total Rho_soft + Rho0_soft (g-space):", & qs_charges%total_rho_gspace ELSE WRITE (UNIT=output_unit, FMT="(T3,A,T41,F20.10)") & "Total charge density on r-space grids: ", & - accurate_sum(tot_rho_r)+ & + accurate_sum(tot_rho_r) + & qs_charges%total_rho_core_rspace, & "Total charge density g-space grids: ", & qs_charges%total_rho_gspace @@ -354,7 +354,7 @@ SUBROUTINE qs_scf_print_scf_summary(output_unit, rho, qs_charges, energy, nelect "Core Hamiltonian energy [eV]: ", energy%core*evolt, & "Two-electron integral energy [eV]: ", energy%hartree*evolt, & "Electronic energy [eV]: ", & - (energy%core+0.5_dp*energy%hartree)*evolt + (energy%core + 0.5_dp*energy%hartree)*evolt IF (energy%dispersion /= 0.0_dp) & WRITE (UNIT=output_unit, FMT="(T3,A,T56,F25.14)") & "Dispersion energy [eV]: ", energy%dispersion*evolt @@ -382,7 +382,7 @@ SUBROUTINE qs_scf_print_scf_summary(output_unit, rho, qs_charges, energy, nelect "Electric field interaction energy: ", energy%efield ELSE IF (dft_control%do_admm) THEN - exc_energy = energy%exc+energy%exc_aux_fit + exc_energy = energy%exc + energy%exc_aux_fit ELSE exc_energy = energy%exc END IF @@ -474,7 +474,7 @@ SUBROUTINE qs_scf_print_scf_summary(output_unit, rho, qs_charges, energy, nelect WRITE (UNIT=output_unit, FMT="(/,(T3,A,T56,F25.14))") & "Atomic reference energy [eV]: ", energy%core_self*evolt, & "Heat of formation [kcal/mol]: ", & - (energy%total+energy%core_self)*kcalmol + (energy%total + energy%core_self)*kcalmol ELSE WRITE (UNIT=output_unit, FMT="(/,(T3,A,T56,F25.14))") & "Total energy: ", energy%total @@ -853,7 +853,7 @@ SUBROUTINE qs_scf_cdft_constraint_info(output_unit, cdft_control) IF (igroup > 1) WRITE (output_unit, '(T3,A)') ' ' WRITE (output_unit, '(T3,A,T54,(3X,I18))') & 'Atomic group :', igroup - SELECT CASE (cdft_control%group (igroup)%constraint_type) + SELECT CASE (cdft_control%group(igroup)%constraint_type) CASE (cdft_charge_constraint) IF (cdft_control%group(igroup)%is_fragment_constraint) THEN WRITE (output_unit, '(T3,A,T42,A)') & @@ -894,7 +894,7 @@ SUBROUTINE qs_scf_cdft_constraint_info(output_unit, cdft_control) WRITE (output_unit, '(T3,A,T54,(3X,F18.12))') & 'Current value of constraint :', cdft_control%value(igroup) WRITE (output_unit, '(T3,A,T59,(3X,ES13.3))') & - 'Deviation from target :', cdft_control%value(igroup)-cdft_control%target(igroup) + 'Deviation from target :', cdft_control%value(igroup) - cdft_control%target(igroup) WRITE (output_unit, '(T3,A,T54,(3X,F18.12))') & 'Strength of constraint :', cdft_control%strength(igroup) END DO diff --git a/src/qs_scf_post_gpw.F b/src/qs_scf_post_gpw.F index 338955fcb3..ca1bf4f02c 100644 --- a/src/qs_scf_post_gpw.F +++ b/src/qs_scf_post_gpw.F @@ -550,21 +550,21 @@ SUBROUTINE scf_post_calculation_gpw(qs_env, wf_type) DO ispin = 1, dft_control%nspins CALL get_mo_set(mo_set=mos(ispin)%mo_set, homo=homo, nmo=nmo, eigenvalues=mo_eigenvalues) - IF (nlumo > nmo-homo) THEN + IF (nlumo > nmo - homo) THEN ! this case not yet implemented ELSE IF (nlumo .EQ. -1) THEN - nlumo = nmo-homo + nlumo = nmo - homo END IF IF (output_unit > 0) WRITE (output_unit, *) " " IF (output_unit > 0) WRITE (output_unit, *) " Lowest eigenvalues of the unoccupied subspace spin ", ispin IF (output_unit > 0) WRITE (output_unit, *) "---------------------------------------------" - IF (output_unit > 0) WRITE (output_unit, '(4(1X,1F16.8))') mo_eigenvalues(homo+1:homo+nlumo) + IF (output_unit > 0) WRITE (output_unit, '(4(1X,1F16.8))') mo_eigenvalues(homo + 1:homo + nlumo) ! Prints the cube files of UNOCCUPIED ORBITALS CALL get_mo_set(mo_set=mos(ispin)%mo_set, mo_coeff=mo_coeff) CALL qs_scf_post_unocc_cubes(input, dft_section, dft_control, logger, qs_env, & - mo_coeff, wf_g, wf_r, particles, nlumo, homo, ispin, lumo=homo+1) + mo_coeff, wf_g, wf_r, particles, nlumo, homo, ispin, lumo=homo + 1) END IF END DO @@ -630,7 +630,7 @@ SUBROUTINE scf_post_calculation_gpw(qs_env, wf_type) IF (output_unit > 0) WRITE (output_unit, *) " " DO ispin = 1, dft_control%nspins IF (.NOT. scf_control%smear%do_smear) THEN - gap = homo_lumo(ispin, 2)-homo_lumo(ispin, 1) + gap = homo_lumo(ispin, 2) - homo_lumo(ispin, 1) IF (output_unit > 0) WRITE (output_unit, '(T2,A,F12.6)') & "HOMO - LUMO gap [eV] :", gap*evolt END IF @@ -791,8 +791,8 @@ SUBROUTINE make_lumo(qs_env, scf_env, unoccupied_orbs, unoccupied_evals, nlumo, IF (output_unit > 0) WRITE (output_unit, FMT='(1X,A)') "-----------------------------------------------------" CALL get_mo_set(mo_set=mos(ispin)%mo_set, mo_coeff=mo_coeff, homo=homo, nao=nao, nmo=nmo) CALL cp_fm_get_info(mo_coeff, nrow_global=n) - nlumos = MAX(1, MIN(nlumo, nao-nmo)) - IF (nlumo == -1) nlumos = nao-nmo + nlumos = MAX(1, MIN(nlumo, nao - nmo)) + IF (nlumo == -1) nlumos = nao - nmo ALLOCATE (unoccupied_evals(ispin)%array(nlumos)) CALL cp_fm_struct_create(fm_struct_tmp, para_env=para_env, context=blacs_env, & nrow_global=n, ncol_global=nlumos) @@ -955,20 +955,20 @@ SUBROUTINE qs_scf_post_occ_cubes(input, dft_section, dft_control, logger, qs_env CALL section_vals_val_get(dft_section, "PRINT%MO_CUBES%HOMO_LIST", i_rep_val=ir, & i_vals=list) IF (ASSOCIATED(list)) THEN - CALL reallocate(list_index, 1, nlist+SIZE(list)) + CALL reallocate(list_index, 1, nlist + SIZE(list)) DO i = 1, SIZE(list) - list_index(i+nlist) = list(i) + list_index(i + nlist) = list(i) END DO - nlist = nlist+SIZE(list) + nlist = nlist + SIZE(list) END IF END DO ELSE IF (nhomo == -1) nhomo = homo - nlist = homo-MAX(1, homo-nhomo+1)+1 + nlist = homo - MAX(1, homo - nhomo + 1) + 1 ALLOCATE (list_index(nlist)) DO i = 1, nlist - list_index(i) = MAX(1, homo-nhomo+1)+i-1 + list_index(i) = MAX(1, homo - nhomo + 1) + i - 1 END DO END IF DO i = 1, nlist @@ -986,7 +986,7 @@ SUBROUTINE qs_scf_post_occ_cubes(input, dft_section, dft_control, logger, qs_env unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%MO_CUBES", extension=".cube", & middle_name=TRIM(filename), file_position=my_pos_cube, log_filename=.FALSE., & mpi_io=mpi_io) - WRITE (title, *) "WAVEFUNCTION ", ivector, " spin ", ispin, " i.e. HOMO - ", ivector-homo + WRITE (title, *) "WAVEFUNCTION ", ivector, " spin ", ispin, " i.e. HOMO - ", ivector - homo CALL cp_pw_to_cube(wf_r%pw, unit_nr, title, particles=particles, & stride=section_get_ivals(dft_section, "PRINT%MO_CUBES%STRIDE"), mpi_io=mpi_io) CALL cp_print_key_finished_output(unit_nr, logger, input, "DFT%PRINT%MO_CUBES", mpi_io=mpi_io) @@ -1051,7 +1051,7 @@ SUBROUTINE qs_scf_post_unocc_cubes(input, dft_section, dft_control, logger, qs_e END IF ifirst = 1 IF (PRESENT(lumo)) ifirst = lumo - DO ivector = ifirst, ifirst+nlumos-1 + DO ivector = ifirst, ifirst + nlumos - 1 CALL get_qs_env(qs_env=qs_env, & atomic_kind_set=atomic_kind_set, & qs_kind_set=qs_kind_set, & @@ -1062,7 +1062,7 @@ SUBROUTINE qs_scf_post_unocc_cubes(input, dft_section, dft_control, logger, qs_e qs_kind_set, cell, dft_control, particle_set, pw_env) IF (ifirst == 1) THEN - index_mo = homo+ivector + index_mo = homo + ivector ELSE index_mo = ivector END IF @@ -1072,7 +1072,7 @@ SUBROUTINE qs_scf_post_unocc_cubes(input, dft_section, dft_control, logger, qs_e unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%MO_CUBES", extension=".cube", & middle_name=TRIM(filename), file_position=my_pos_cube, log_filename=.FALSE., & mpi_io=mpi_io) - WRITE (title, *) "WAVEFUNCTION ", index_mo, " spin ", ispin, " i.e. LUMO + ", ifirst+ivector-2 + WRITE (title, *) "WAVEFUNCTION ", index_mo, " spin ", ispin, " i.e. LUMO + ", ifirst + ivector - 2 CALL cp_pw_to_cube(wf_r%pw, unit_nr, title, particles=particles, & stride=section_get_ivals(dft_section, "PRINT%MO_CUBES%STRIDE"), mpi_io=mpi_io) CALL cp_print_key_finished_output(unit_nr, logger, input, "DFT%PRINT%MO_CUBES", mpi_io=mpi_io) @@ -1730,7 +1730,7 @@ SUBROUTINE write_mo_dependent_results(qs_env, scf_env) IF (nmo > 0) THEN all_equal = all_equal .AND. & (ALL(occupation_numbers(1:homo) == maxocc) .AND. & - ALL(occupation_numbers(homo+1:nmo) == 0.0_dp)) + ALL(occupation_numbers(homo + 1:nmo) == 0.0_dp)) END IF END DO IF (.NOT. all_equal) THEN @@ -1926,7 +1926,7 @@ SUBROUTINE write_mo_free_results(qs_env) ccdens(:, 2, ikind) = 0._dp CALL project_function_a(ccdens(1:ngto, 2, ikind), ccdens(1:ngto, 1, ikind), & ppdens(1:ngto, 2, ikind), ppdens(1:ngto, 1, ikind), 0) - ccdens(:, 2, ikind) = aedens(:, 2, ikind)-ccdens(:, 2, ikind) + ccdens(:, 2, ikind) = aedens(:, 2, ikind) - ccdens(:, 2, ikind) IF (unit_nr > 0) THEN WRITE (unit_nr, FMT="(I6,A10,A20)") ikind, TRIM(element_symbol), TRIM(name) WRITE (unit_nr, FMT="(I6)") ngto @@ -1963,7 +1963,7 @@ SUBROUTINE write_mo_free_results(qs_env) bfun = 0._dp DO ispin = 1, dft_control%nspins IF (ASSOCIATED(rho_atom%rho_rad_h(1)%r_coef)) THEN - bfun(:, :) = bfun+rho_atom%rho_rad_h(ispin)%r_coef-rho_atom%rho_rad_s(ispin)%r_coef + bfun(:, :) = bfun + rho_atom%rho_rad_h(ispin)%r_coef - rho_atom%rho_rad_s(ispin)%r_coef END IF END DO CALL mp_sum(bfun, para_env%group) @@ -2028,7 +2028,7 @@ SUBROUTINE write_mo_free_results(qs_env) q_max=q_max, & rho_hard=rho_hard, & rho_soft=rho_soft) - rho_total = rho_hard+rho_soft + rho_total = rho_hard + rho_soft CALL get_pw_grid_info(pw_grid=rho_elec_gspace%pw%pw_grid, & vol=volume) CALL pw_transfer(rho_elec_gspace%pw, rho_elec_rspace%pw, debug=.FALSE.) @@ -2071,7 +2071,7 @@ SUBROUTINE write_mo_free_results(qs_env) rho_hard=rho_hard, & rho_soft=rho_soft, & fsign=-1.0_dp) - rho_total = rho_hard+rho_soft + rho_total = rho_hard + rho_soft CALL pw_transfer(rho_elec_gspace%pw, rho_elec_rspace%pw, debug=.FALSE.) rho_total_rspace = pw_integrate_function(rho_elec_rspace%pw, isign=-1)/volume filename = "TOTAL_SPIN_DENSITY" @@ -2568,7 +2568,7 @@ SUBROUTINE hirshfeld_charges(qs_env, input_section, unit_nr) CALL get_atomic_kind(atomic_kind, kind_number=ikind) CALL get_qs_kind(qs_kind_set(ikind), paw_atom=paw_atom) IF (paw_atom) THEN - charges(iat, 1:nspin) = charges(iat, 1:nspin)+mp_rho(iat)%q0(1:nspin) + charges(iat, 1:nspin) = charges(iat, 1:nspin) + mp_rho(iat)%q0(1:nspin) END IF END DO END IF @@ -3231,7 +3231,7 @@ SUBROUTINE write_adjacency_matrix(qs_env, input) CALL basis_set_list_setup(basis_set_list_a, "ORB", qs_kind_set) CALL basis_set_list_setup(basis_set_list_b, "ORB", qs_kind_set) - adjm_size = ((natom+1)*natom)/2 + adjm_size = ((natom + 1)*natom)/2 ALLOCATE (interact_adjm(4*adjm_size)) interact_adjm = 0 @@ -3255,19 +3255,19 @@ SUBROUTINE write_adjacency_matrix(qs_env, input) rowind = jatom colind = iatom ! swap the kinds too - ikind = ikind+jkind - jkind = ikind-jkind - ikind = ikind-jkind + ikind = ikind + jkind + jkind = ikind - jkind + ikind = ikind - jkind END IF ! indexing upper triangular matrix - ind = adjm_size-(natom-rowind+1)*((natom-rowind+1)+1)/2+colind-rowind+1 + ind = adjm_size - (natom - rowind + 1)*((natom - rowind + 1) + 1)/2 + colind - rowind + 1 ! convert the upper triangular matrix into a adjm_size x 4 matrix ! columns are: iatom, jatom, ikind, jkind - interact_adjm((ind-1)*4+1) = rowind - interact_adjm((ind-1)*4+2) = colind - interact_adjm((ind-1)*4+3) = ikind - interact_adjm((ind-1)*4+4) = jkind + interact_adjm((ind - 1)*4 + 1) = rowind + interact_adjm((ind - 1)*4 + 2) = colind + interact_adjm((ind - 1)*4 + 3) = ikind + interact_adjm((ind - 1)*4 + 4) = jkind ENDDO CALL mp_sum(interact_adjm, para_env%group) @@ -3279,8 +3279,8 @@ SUBROUTINE write_adjacency_matrix(qs_env, input) WRITE (unit_nr, "(1A,2X,1A,5X,1A,4X,A5,3X,A5)") "#", "iatom", "jatom", "ikind", "jkind" DO k = 1, 4*adjm_size, 4 ! print only the interacting atoms - IF (interact_adjm(k) .GT. 0 .AND. interact_adjm(k+1) .GT. 0) THEN - WRITE (unit_nr, "(I8,2X,I8,3X,I6,2X,I6)") interact_adjm(k:k+3) + IF (interact_adjm(k) .GT. 0 .AND. interact_adjm(k + 1) .GT. 0) THEN + WRITE (unit_nr, "(I8,2X,I8,3X,I6,2X,I6)") interact_adjm(k:k + 3) END IF END DO END IF diff --git a/src/qs_scf_post_se.F b/src/qs_scf_post_se.F index b2fa66009a..0cd0aa7e21 100644 --- a/src/qs_scf_post_se.F +++ b/src/qs_scf_post_se.F @@ -283,11 +283,11 @@ SUBROUTINE qs_scf_post_moments(input, logger, qs_env) block=pblock, found=found) IF (found) THEN DO j = 1, natorb - tcharge(i) = tcharge(i)+pblock(j, j) + tcharge(i) = tcharge(i) + pblock(j, j) END DO END IF END DO - ncharge(iat) = zeff-SUM(tcharge) + ncharge(iat) = zeff - SUM(tcharge) END DO END DO ! Contributions from net atomic charges @@ -303,7 +303,7 @@ SUBROUTINE qs_scf_post_moments(input, logger, qs_env) zphase = CMPLX(COS(ria), SIN(ria), dp)**charge_tot dria = twopi*MATMUL(cell%h_inv, drcc) - dzphase = charge_tot*CMPLX(-SIN(ria), COS(ria), dp)**(charge_tot-1.0_dp)*dria + dzphase = charge_tot*CMPLX(-SIN(ria), COS(ria), dp)**(charge_tot - 1.0_dp)*dria ggamma = CMPLX(1.0_dp, 0.0_dp, KIND=dp) dggamma = CMPLX(0.0_dp, 0.0_dp, KIND=dp) @@ -320,19 +320,19 @@ SUBROUTINE qs_scf_post_moments(input, logger, qs_env) theta = SUM(ria(:)*gvec(:)) dtheta = SUM(via(:)*gvec(:)) zeta = CMPLX(COS(theta), SIN(theta), KIND=dp)**(-q) - dzeta = -q*CMPLX(-SIN(theta), COS(theta), KIND=dp)**(-q-1.0_dp)*dtheta - dggamma(j) = dggamma(j)*zeta+ggamma(j)*dzeta + dzeta = -q*CMPLX(-SIN(theta), COS(theta), KIND=dp)**(-q - 1.0_dp)*dtheta + dggamma(j) = dggamma(j)*zeta + ggamma(j)*dzeta ggamma(j) = ggamma(j)*zeta END DO ENDDO END DO - dggamma = dggamma*zphase+ggamma*dzphase + dggamma = dggamma*zphase + ggamma*dzphase ggamma = ggamma*zphase IF (ALL(REAL(ggamma, KIND=dp) /= 0.0_dp)) THEN tmp = AIMAG(ggamma)/REAL(ggamma, KIND=dp) ci = ATAN(tmp) - dci = (1.0_dp/(1.0_dp+tmp**2))* & - (AIMAG(dggamma)*REAL(ggamma, KIND=dp)-AIMAG(ggamma)* & + dci = (1.0_dp/(1.0_dp + tmp**2))* & + (AIMAG(dggamma)*REAL(ggamma, KIND=dp) - AIMAG(ggamma)* & REAL(dggamma, KIND=dp))/(REAL(ggamma, KIND=dp))**2 dipole = MATMUL(cell%hmat, ci)/twopi dipole_deriv = MATMUL(cell%hmat, dci)/twopi @@ -343,8 +343,8 @@ SUBROUTINE qs_scf_post_moments(input, logger, qs_env) ! no pbc(particle_set(i)%r(:),cell) so that the total dipole is the sum of the molecular dipoles ria = particle_set(i)%r(:) q = ncharge(i) - dipole = dipole-q*(ria-rcc) - dipole_deriv(:) = dipole_deriv(:)-q*(particle_set(i)%v(:)-drcc) + dipole = dipole - q*(ria - rcc) + dipole_deriv(:) = dipole_deriv(:) - q*(particle_set(i)%v(:) - drcc) END DO END IF ! Contributions from atomic polarization @@ -364,12 +364,12 @@ SUBROUTINE qs_scf_post_moments(input, logger, qs_env) block=pblock, found=found) IF (found) THEN CPASSERT(natorb == SIZE(pblock, 1)) - ix = coset(1, 0, 0)-1 - dipole(1) = dipole(1)+SUM(pblock*mom(:, :, ix)) - ix = coset(0, 1, 0)-1 - dipole(2) = dipole(2)+SUM(pblock*mom(:, :, ix)) - ix = coset(0, 0, 1)-1 - dipole(3) = dipole(3)+SUM(pblock*mom(:, :, ix)) + ix = coset(1, 0, 0) - 1 + dipole(1) = dipole(1) + SUM(pblock*mom(:, :, ix)) + ix = coset(0, 1, 0) - 1 + dipole(2) = dipole(2) + SUM(pblock*mom(:, :, ix)) + ix = coset(0, 0, 1) - 1 + dipole(3) = dipole(3) + SUM(pblock*mom(:, :, ix)) END IF END DO END DO @@ -515,11 +515,11 @@ SUBROUTINE qs_scf_post_charges(input, logger, qs_env, rho, & block=pblock, found=found) IF (found) THEN DO j = 1, natorb - charges(iat, i) = charges(iat, i)+pblock(j, j) + charges(iat, i) = charges(iat, i) + pblock(j, j) END DO END IF END DO - mcharge(iat) = zeff-SUM(charges(iat, 1:nspin)) + mcharge(iat) = zeff - SUM(charges(iat, 1:nspin)) END DO END DO ! @@ -558,7 +558,7 @@ SUBROUTINE qs_scf_post_charges(input, logger, qs_env, rho, & iat = atomic_kind_set(ikind)%atom_list(iatom) WRITE (UNIT=unit_nr, & FMT="(T2,I6,5X,A2,2X,I6,T29,4(1X,F12.6))") & - iat, ana, ikind, charges(iat, 1:2), mcharge(iat), charges(iat, 1)-charges(iat, 2) + iat, ana, ikind, charges(iat, 1:2), mcharge(iat), charges(iat, 1) - charges(iat, 2) END DO END DO WRITE (UNIT=unit_nr, & diff --git a/src/qs_scf_post_tb.F b/src/qs_scf_post_tb.F index 2bc2ef58dc..c7c5e0adb1 100644 --- a/src/qs_scf_post_tb.F +++ b/src/qs_scf_post_tb.F @@ -219,7 +219,7 @@ SUBROUTINE scf_post_calculation_tb(qs_env, tb_type, no_mos) nkind = SIZE(atomic_kind_set) DO ikind = 1, nkind CALL get_atomic_kind(atomic_kind_set(ikind), natom=nat) - SELECT CASE (TRIM (tb_type)) + SELECT CASE (TRIM(tb_type)) CASE ("DFTB") CALL get_qs_kind(qs_kind_set(ikind), dftb_parameter=dftb_kind) CALL get_dftb_atom_param(dftb_kind, zeff=zeff) @@ -231,7 +231,7 @@ SUBROUTINE scf_post_calculation_tb(qs_env, tb_type, no_mos) END SELECT DO iatom = 1, nat iat = atomic_kind_set(ikind)%atom_list(iatom) - mcharge(iat) = zeff-SUM(charges(iat, 1:nspins)) + mcharge(iat) = zeff - SUM(charges(iat, 1:nspins)) END DO END DO @@ -294,7 +294,7 @@ SUBROUTINE scf_post_calculation_tb(qs_env, tb_type, no_mos) WRITE (UNIT=unit_nr, & FMT="(T2,I6,3X,A6,I6,T29,4(1X,F12.6))") & iat, ADJUSTL(ana), ikind, charges(iat, 1:2), mcharge(iat), & - charges(iat, 1)-charges(iat, 2) + charges(iat, 1) - charges(iat, 2) END DO END DO WRITE (UNIT=unit_nr, & @@ -687,7 +687,7 @@ SUBROUTINE tb_dipole(qs_env, input, unit_nr, charges) zphase = CMPLX(COS(ria), SIN(ria), dp)**charge_tot dria = twopi*MATMUL(cell%h_inv, drcc) - dzphase = charge_tot*CMPLX(-SIN(ria), COS(ria), dp)**(charge_tot-1.0_dp)*dria + dzphase = charge_tot*CMPLX(-SIN(ria), COS(ria), dp)**(charge_tot - 1.0_dp)*dria ggamma = CMPLX(1.0_dp, 0.0_dp, KIND=dp) dggamma = CMPLX(0.0_dp, 0.0_dp, KIND=dp) @@ -704,19 +704,19 @@ SUBROUTINE tb_dipole(qs_env, input, unit_nr, charges) theta = SUM(ria(:)*gvec(:)) dtheta = SUM(via(:)*gvec(:)) zeta = CMPLX(COS(theta), SIN(theta), KIND=dp)**(-q) - dzeta = -q*CMPLX(-SIN(theta), COS(theta), KIND=dp)**(-q-1.0_dp)*dtheta - dggamma(j) = dggamma(j)*zeta+ggamma(j)*dzeta + dzeta = -q*CMPLX(-SIN(theta), COS(theta), KIND=dp)**(-q - 1.0_dp)*dtheta + dggamma(j) = dggamma(j)*zeta + ggamma(j)*dzeta ggamma(j) = ggamma(j)*zeta END DO ENDDO END DO - dggamma = dggamma*zphase+ggamma*dzphase + dggamma = dggamma*zphase + ggamma*dzphase ggamma = ggamma*zphase IF (ALL(REAL(ggamma, KIND=dp) /= 0.0_dp)) THEN tmp = AIMAG(ggamma)/REAL(ggamma, KIND=dp) ci = ATAN(tmp) - dci = (1.0_dp/(1.0_dp+tmp**2))* & - (AIMAG(dggamma)*REAL(ggamma, KIND=dp)-AIMAG(ggamma)*REAL(dggamma, KIND=dp))/(REAL(ggamma, KIND=dp))**2 + dci = (1.0_dp/(1.0_dp + tmp**2))* & + (AIMAG(dggamma)*REAL(ggamma, KIND=dp) - AIMAG(ggamma)*REAL(dggamma, KIND=dp))/(REAL(ggamma, KIND=dp))**2 dipole = MATMUL(cell%hmat, ci)/twopi dipole_deriv = MATMUL(cell%hmat, dci)/twopi END IF @@ -726,8 +726,8 @@ SUBROUTINE tb_dipole(qs_env, input, unit_nr, charges) ! no pbc(particle_set(i)%r(:),cell) so that the total dipole is the sum of the molecular dipoles ria = particle_set(i)%r(:) q = charges(i) - dipole = dipole-q*(ria-rcc) - dipole_deriv(:) = dipole_deriv(:)-q*(particle_set(i)%v(:)-drcc) + dipole = dipole - q*(ria - rcc) + dipole_deriv(:) = dipole_deriv(:) - q*(particle_set(i)%v(:) - drcc) END DO END IF CALL cp_results_erase(results=results, description=description) @@ -794,7 +794,7 @@ SUBROUTINE wfn_mix_tb(qs_env, dft_section, scf_env) DO ispin = 1, SIZE(mos) CALL get_mo_set(mos(ispin)%mo_set, mo_coeff=mo_coeff, eigenvalues=mo_eigenvalues, nmo=nmo) - CALL cp_fm_struct_create(fmstruct=ao_lumo_struct, nrow_global=nao, ncol_global=nao-nmo, & + CALL cp_fm_struct_create(fmstruct=ao_lumo_struct, nrow_global=nao, ncol_global=nao - nmo, & template_fmstruct=mo_coeff%matrix_struct) CALL cp_fm_create(lumos(ispin)%matrix, matrix_struct=ao_lumo_struct) @@ -803,7 +803,7 @@ SUBROUTINE wfn_mix_tb(qs_env, dft_section, scf_env) CALL choose_eigv_solver(KS_tmp, work, mo_eigenvalues) CALL cp_fm_cholesky_restore(work, nao, S_tmp, MO_tmp, "SOLVE") CALL cp_fm_to_fm_submat(MO_tmp, mo_coeff, nao, nmo, 1, 1, 1, 1) - CALL cp_fm_to_fm_submat(MO_tmp, lumos(ispin)%matrix, nao, nao-nmo, 1, nmo+1, 1, 1) + CALL cp_fm_to_fm_submat(MO_tmp, lumos(ispin)%matrix, nao, nao - nmo, 1, nmo + 1, 1, 1) CALL cp_fm_struct_release(ao_lumo_struct) END DO @@ -962,8 +962,8 @@ SUBROUTINE make_lumo(qs_env, scf_env, unoccupied_orbs, unoccupied_evals, nlumo, IF (iounit > 0) WRITE (iounit, FMT='(1X,A)') "-----------------------------------------------------" CALL get_mo_set(mo_set=mos(ispin)%mo_set, mo_coeff=mo_coeff, homo=homo, nao=nao, nmo=nmo) CALL cp_fm_get_info(mo_coeff, nrow_global=n) - nlumos = MAX(1, MIN(nlumo, nao-nmo)) - IF (nlumo == -1) nlumos = nao-nmo + nlumos = MAX(1, MIN(nlumo, nao - nmo)) + IF (nlumo == -1) nlumos = nao - nmo ALLOCATE (unoccupied_evals(ispin)%array(nlumos)) CALL cp_fm_struct_create(fm_struct_tmp, para_env=para_env, context=blacs_env, & nrow_global=n, ncol_global=nlumos) @@ -1545,20 +1545,20 @@ SUBROUTINE print_mo_cubes(qs_env, cube_section) NULLIFY (list) CALL section_vals_val_get(cube_section, "HOMO_LIST", i_rep_val=ir, i_vals=list) IF (ASSOCIATED(list)) THEN - CALL reallocate(list_index, 1, nlist+SIZE(list)) + CALL reallocate(list_index, 1, nlist + SIZE(list)) DO i = 1, SIZE(list) - list_index(i+nlist) = list(i) + list_index(i + nlist) = list(i) END DO - nlist = nlist+SIZE(list) + nlist = nlist + SIZE(list) END IF END DO nhomo = MAXVAL(list_index) ELSE IF (nhomo == -1) nhomo = homo - nlist = homo-MAX(1, homo-nhomo+1)+1 + nlist = homo - MAX(1, homo - nhomo + 1) + 1 ALLOCATE (list_index(nlist)) DO i = 1, nlist - list_index(i) = MAX(1, homo-nhomo+1)+i-1 + list_index(i) = MAX(1, homo - nhomo + 1) + i - 1 END DO END IF @@ -1602,7 +1602,7 @@ SUBROUTINE print_mo_cubes(qs_env, cube_section) unit_nr = cp_print_key_unit_nr(logger, cube_section, '', extension=".cube", & middle_name=TRIM(filename), file_position=my_pos_cube, & log_filename=.FALSE., mpi_io=mpi_io) - WRITE (title, *) "WAVEFUNCTION ", ivector, " spin ", ispin, " i.e. HOMO - ", ivector-homo + WRITE (title, *) "WAVEFUNCTION ", ivector, " spin ", ispin, " i.e. HOMO - ", ivector - homo CALL cp_pw_to_cube(wf_r%pw, unit_nr, title, particles=particles, & stride=section_get_ivals(cube_section, "STRIDE"), mpi_io=mpi_io) CALL cp_print_key_finished_output(unit_nr, logger, cube_section, '', mpi_io=mpi_io) @@ -1617,11 +1617,11 @@ SUBROUTINE print_mo_cubes(qs_env, cube_section) CALL get_mo_set(mo_set=mos(ispin)%mo_set, mo_coeff=mo_coeff, & eigenvalues=mo_eigenvalues, homo=homo, nmo=nmo) IF (write_cube) THEN - ifirst = homo+1 + ifirst = homo + 1 IF (nlumo == -1) THEN ilast = nmo ELSE - ilast = ifirst+nlumo-1 + ilast = ifirst + nlumo - 1 ilast = MIN(nmo, ilast) END IF DO ivector = ifirst, ilast @@ -1632,7 +1632,7 @@ SUBROUTINE print_mo_cubes(qs_env, cube_section) unit_nr = cp_print_key_unit_nr(logger, cube_section, '', extension=".cube", & middle_name=TRIM(filename), file_position=my_pos_cube, & log_filename=.FALSE., mpi_io=mpi_io) - WRITE (title, *) "WAVEFUNCTION ", ivector, " spin ", ispin, " i.e. LUMO + ", ivector-ifirst + WRITE (title, *) "WAVEFUNCTION ", ivector, " spin ", ispin, " i.e. LUMO + ", ivector - ifirst CALL cp_pw_to_cube(wf_r%pw, unit_nr, title, particles=particles, & stride=section_get_ivals(cube_section, "STRIDE"), mpi_io=mpi_io) CALL cp_print_key_finished_output(unit_nr, logger, cube_section, '', mpi_io=mpi_io) diff --git a/src/qs_scf_types.F b/src/qs_scf_types.F index 7d32e07d96..fac9622178 100644 --- a/src/qs_scf_types.F +++ b/src/qs_scf_types.F @@ -142,7 +142,7 @@ SUBROUTINE scf_env_create(scf_env) ALLOCATE (scf_env) scf_env%ref_count = 1 scf_env%print_count = 0 - last_scf_env_id = last_scf_env_id+1 + last_scf_env_id = last_scf_env_id + 1 scf_env%id_nr = last_scf_env_id scf_env%print_count = 0 scf_env%iter_count = 0 @@ -213,7 +213,7 @@ SUBROUTINE scf_env_retain(scf_env) CPASSERT(ASSOCIATED(scf_env)) CPASSERT(scf_env%ref_count > 0) - scf_env%ref_count = scf_env%ref_count+1 + scf_env%ref_count = scf_env%ref_count + 1 CALL timestop(handle) @@ -276,7 +276,7 @@ SUBROUTINE scf_env_release(scf_env) IF (ASSOCIATED(scf_env)) THEN CPASSERT(scf_env%ref_count > 0) - scf_env%ref_count = scf_env%ref_count-1 + scf_env%ref_count = scf_env%ref_count - 1 IF (scf_env%ref_count < 1) THEN CALL cp_fm_vect_dealloc(scf_env%scf_work1) CALL cp_fm_release(scf_env%scf_work2) diff --git a/src/qs_scf_wfn_mix.F b/src/qs_scf_wfn_mix.F index ad0c4ec8aa..46055f2e63 100644 --- a/src/qs_scf_wfn_mix.F +++ b/src/qs_scf_wfn_mix.F @@ -137,21 +137,21 @@ SUBROUTINE wfn_mix(mos, particle_set, dft_section, qs_kind_set, & ! first get a copy of the proper orig IF (.NOT. ORIG_IS_VIRTUAL) THEN CALL cp_fm_to_fm(mos(orig_spin_index)%mo_set%mo_coeff, matrix_x, 1, & - mos(orig_spin_index)%mo_set%nmo-orig_mo_index+1, 1) + mos(orig_spin_index)%mo_set%nmo - orig_mo_index + 1, 1) ELSE CALL cp_fm_to_fm(unoccupied_orbs(orig_spin_index)%matrix, matrix_x, 1, orig_mo_index, 1) ENDIF ! now get a copy of the target CALL cp_fm_to_fm(mos_new(result_spin_index)%mo_set%mo_coeff, matrix_y, & - 1, mos_new(result_spin_index)%mo_set%nmo-result_mo_index+1, 1) + 1, mos_new(result_spin_index)%mo_set%nmo - result_mo_index + 1, 1) ! properly mix CALL cp_fm_scale_and_add(result_scale, matrix_y, orig_scale, matrix_x) ! and copy back in the result mos CALL cp_fm_to_fm(matrix_y, mos_new(result_spin_index)%mo_set%mo_coeff, & - 1, 1, mos_new(result_spin_index)%mo_set%nmo-result_mo_index+1) + 1, 1, mos_new(result_spin_index)%mo_set%nmo - result_mo_index + 1) ENDDO diff --git a/src/qs_spin_orbit.F b/src/qs_spin_orbit.F index f56d3083b3..795017a699 100644 --- a/src/qs_spin_orbit.F +++ b/src/qs_spin_orbit.F @@ -129,10 +129,10 @@ SUBROUTINE build_pso_matrix(qs_env, matrix_so, rc) maxlgto=maxlgto, & maxsgf=maxsgf) - ldai = ncoset(maxlgto+1) + ldai = ncoset(maxlgto + 1) CALL init_orbital_pointers(ldai) - ALLOCATE (rr_work(0:2*maxlgto+2, ldai, ldai)) + ALLOCATE (rr_work(0:2*maxlgto + 2, ldai, ldai)) ALLOCATE (soab(maxco, maxco, 3)) ALLOCATE (work(maxco, maxsgf)) ALLOCATE (soint(3)) @@ -185,11 +185,11 @@ SUBROUTINE build_pso_matrix(qs_env, matrix_so, rc) IF (inode == 1) last_jatom = 0 - rb = rab+ra - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rb = rab + ra + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) dab = SQRT(rab2) rac = pbc(ra, rc, cell) - rbc = rac-rab + rbc = rac - rab IF (jatom /= last_jatom) THEN new_atom_b = .TRUE. @@ -221,7 +221,7 @@ SUBROUTINE build_pso_matrix(qs_env, matrix_so, rc) DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE ncob = npgfb(jset)*ncoset(lb_max(jset)) sgfb = first_sgfb(1, jset) diff --git a/src/qs_subsys_methods.F b/src/qs_subsys_methods.F index f18a2b133d..33b92e6c18 100644 --- a/src/qs_subsys_methods.F +++ b/src/qs_subsys_methods.F @@ -225,7 +225,7 @@ SUBROUTINE num_ao_el_per_molecule(molecule_kind_set, qs_kind_set) ! For now, only the total number of electrons can be obtained ! from init_atom_electronic_state n_occ_alpha_and_beta(ARBITRARY_SPIN) = & - n_occ_alpha_and_beta(ARBITRARY_SPIN)+SUM(ne_explicit)+ & + n_occ_alpha_and_beta(ARBITRARY_SPIN) + SUM(ne_explicit) + & SUM(NINT(2*edelta(:, :, ARBITRARY_SPIN))) ! We need a way to specify the number of alpha and beta electrons ! on each molecule (i.e. multiplicity is not enough) @@ -244,7 +244,7 @@ SUBROUTINE num_ao_el_per_molecule(molecule_kind_set, qs_kind_set) zeff = 0.0_dp zeff_correction = 0.0_dp END IF - z_molecule = z_molecule+NINT(zeff-zeff_correction) + z_molecule = z_molecule + NINT(zeff - zeff_correction) ! this one does not work because nelem is not adjusted in the symmetry breaking code !CALL get_atomic_kind(atomic_kind,z=z) @@ -255,13 +255,13 @@ SUBROUTINE num_ao_el_per_molecule(molecule_kind_set, qs_kind_set) ELSE nsgf = 0 ENDIF - n_ao = n_ao+nsgf + n_ao = n_ao + nsgf END DO ! iatom ! At this point we have the number of electrons (alpha+beta) on the molecule ! as they are seen by the ATOMIC GUESS routines - charge_molecule = REAL(z_molecule-n_occ_alpha_and_beta(ARBITRARY_SPIN), dp) + charge_molecule = REAL(z_molecule - n_occ_alpha_and_beta(ARBITRARY_SPIN), dp) CALL set_molecule_kind(molecule_kind=molecule_kind, & nelectron=n_occ_alpha_and_beta(ARBITRARY_SPIN), & charge=charge_molecule, & diff --git a/src/qs_subsys_types.F b/src/qs_subsys_types.F index 7d3f0f1854..2c3dcd15cf 100644 --- a/src/qs_subsys_types.F +++ b/src/qs_subsys_types.F @@ -80,7 +80,7 @@ SUBROUTINE qs_subsys_retain(subsys) CPASSERT(ASSOCIATED(subsys)) CPASSERT(subsys%ref_count > 0) - subsys%ref_count = subsys%ref_count+1 + subsys%ref_count = subsys%ref_count + 1 END SUBROUTINE qs_subsys_retain ! ************************************************************************************************** @@ -96,7 +96,7 @@ SUBROUTINE qs_subsys_release(subsys) IF (ASSOCIATED(subsys)) THEN CPASSERT(subsys%ref_count > 0) - subsys%ref_count = subsys%ref_count-1 + subsys%ref_count = subsys%ref_count - 1 IF (subsys%ref_count == 0) THEN CALL cp_subsys_release(subsys%cp_subsys) CALL cell_release(subsys%cell_ref) diff --git a/src/qs_tddfpt2_methods.F b/src/qs_tddfpt2_methods.F index 797c204eb3..bf70248d86 100644 --- a/src/qs_tddfpt2_methods.F +++ b/src/qs_tddfpt2_methods.F @@ -406,10 +406,10 @@ SUBROUTINE tddfpt(qs_env) nmo_virt = HUGE(nmo_virt) DO ispin = 1, nspins CALL get_mo_set(mos(ispin)%mo_set, nmo=nmo_avail, homo=nmo_occ) - nmo_virt = MIN(nmo_virt, nmo_avail-nmo_occ) + nmo_virt = MIN(nmo_virt, nmo_avail - nmo_occ) END DO ! number of unoccupied orbitals to compute - nmo_virt = tddfpt_control%nlumo-nmo_virt + nmo_virt = tddfpt_control%nlumo - nmo_virt IF (nmo_virt > 0) THEN ALLOCATE (evals_virt(nspins), mos_virt(nspins)) @@ -450,7 +450,7 @@ SUBROUTINE tddfpt(qs_env) ! multiplicity of molecular system IF (nspins > 1) THEN - mult = ABS(SIZE(gs_mos(1)%evals_occ)-SIZE(gs_mos(2)%evals_occ))+1 + mult = ABS(SIZE(gs_mos(1)%evals_occ) - SIZE(gs_mos(2)%evals_occ)) + 1 IF (mult > 2) & CALL cp_warn(__LOCATION__, "There is a convergence issue for multiplicity >= 3") ELSE @@ -750,7 +750,7 @@ SUBROUTINE tddfpt_create_work_matrices(work_matrices, gs_mos, nstates, do_hfx, q igroup = sub_env%group_distribution(para_env%mepos) ngroups = sub_env%ngroups - DO istate = ngroups-igroup, nstates, ngroups + DO istate = ngroups - igroup, nstates, ngroups DO ispin = 1, nspins CALL cp_fm_create(work_matrices%evects_sub(ispin, istate)%matrix, fm_struct_evects(ispin)%struct) CALL cp_fm_create(work_matrices%Aop_evects_sub(ispin, istate)%matrix, fm_struct_evects(ispin)%struct) @@ -1138,7 +1138,7 @@ SUBROUTINE tddfpt_init_ground_state_mos(gs_mos, mo_set, nlumo, blacs_env, choles CALL get_mo_set(mo_set, nao=nao, nmo=nmo_scf, homo=nmo_occ, maxocc=maxocc, & nelectron=nelectrons, occupation_numbers=mo_occ_scf) - nmo_virt = nao-nmo_occ + nmo_virt = nao - nmo_occ IF (nlumo >= 0) & nmo_virt = MIN(nmo_virt, nlumo) @@ -1150,9 +1150,9 @@ SUBROUTINE tddfpt_init_ground_state_mos(gs_mos, mo_set, nlumo, blacs_env, choles ! diagonalise the Kohn-Sham matrix one more time if the number of available unoccupied states are too small IF (ASSOCIATED(evals_virt)) THEN CPASSERT(ASSOCIATED(mos_virt)) - IF (nmo_virt > nmo_scf-nmo_occ+SIZE(evals_virt)) do_eigen = .TRUE. + IF (nmo_virt > nmo_scf - nmo_occ + SIZE(evals_virt)) do_eigen = .TRUE. ELSE - IF (nmo_virt > nmo_scf-nmo_occ) do_eigen = .TRUE. + IF (nmo_virt > nmo_scf - nmo_occ) do_eigen = .TRUE. END IF ! ++ allocate storage space for gs_mos @@ -1178,10 +1178,10 @@ SUBROUTINE tddfpt_init_ground_state_mos(gs_mos, mo_set, nlumo, blacs_env, choles IF (do_eigen) THEN ! ++ set of molecular orbitals - CALL cp_fm_struct_create(wfn_fm_struct, nrow_global=nao, ncol_global=nmo_occ+nmo_virt, context=blacs_env) + CALL cp_fm_struct_create(wfn_fm_struct, nrow_global=nao, ncol_global=nmo_occ + nmo_virt, context=blacs_env) CALL fm_pool_create(wfn_fm_pool, wfn_fm_struct) - CALL allocate_mo_set(mos_extended, nao, nmo_occ+nmo_virt, nelectrons, & + CALL allocate_mo_set(mos_extended, nao, nmo_occ + nmo_virt, nelectrons, & REAL(nelectrons, dp), maxocc, flexible_electron_count=0.0_dp) CALL init_mo_set(mos_extended, fm_pool=wfn_fm_pool, name="mos-extended") CALL fm_pool_release(wfn_fm_pool) @@ -1197,7 +1197,7 @@ SUBROUTINE tddfpt_init_ground_state_mos(gs_mos, mo_set, nlumo, blacs_env, choles DO imo = 1, nmo_scf mo_occ_extended(imo) = mo_occ_scf(imo) END DO - mo_occ_extended(nmo_scf+1:) = 0.0_dp + mo_occ_extended(nmo_scf + 1:) = 0.0_dp ! ++ allocate temporary matrices NULLIFY (matrix_ks_fm, ortho_fm, work_fm) @@ -1264,7 +1264,7 @@ SUBROUTINE tddfpt_init_ground_state_mos(gs_mos, mo_set, nlumo, blacs_env, choles sign_int = -1 END IF - sum_sign_array(icol_global) = sum_sign_array(icol_global)+sign_int + sum_sign_array(icol_global) = sum_sign_array(icol_global) + sign_int irow_global = row_indices(irow_local) IF (sign_int > 0) THEN @@ -1308,16 +1308,16 @@ SUBROUTINE tddfpt_init_ground_state_mos(gs_mos, mo_set, nlumo, blacs_env, choles CALL cp_fm_to_fm(mo_coeff_extended, gs_mos%mos_occ, ncol=nmo_occ, source_start=1, target_start=1) gs_mos%evals_occ(1:nmo_occ) = mo_evals_extended(1:nmo_occ) - IF (ASSOCIATED(evals_virt) .AND. (.NOT. do_eigen) .AND. nmo_virt > nmo_scf-nmo_occ) THEN - CALL cp_fm_to_fm(mo_coeff_extended, gs_mos%mos_virt, ncol=nmo_scf-nmo_occ, & - source_start=nmo_occ+1, target_start=1) - CALL cp_fm_to_fm(mos_virt, gs_mos%mos_virt, ncol=nmo_virt-(nmo_scf-nmo_occ), & - source_start=1, target_start=nmo_scf-nmo_occ+1) - gs_mos%evals_virt(1:nmo_scf-nmo_occ) = evals_virt(nmo_occ+1:nmo_occ+nmo_scf) - gs_mos%evals_virt(nmo_scf-nmo_occ+1:nmo_virt) = evals_virt(1:nmo_virt-(nmo_scf-nmo_occ)) + IF (ASSOCIATED(evals_virt) .AND. (.NOT. do_eigen) .AND. nmo_virt > nmo_scf - nmo_occ) THEN + CALL cp_fm_to_fm(mo_coeff_extended, gs_mos%mos_virt, ncol=nmo_scf - nmo_occ, & + source_start=nmo_occ + 1, target_start=1) + CALL cp_fm_to_fm(mos_virt, gs_mos%mos_virt, ncol=nmo_virt - (nmo_scf - nmo_occ), & + source_start=1, target_start=nmo_scf - nmo_occ + 1) + gs_mos%evals_virt(1:nmo_scf - nmo_occ) = evals_virt(nmo_occ + 1:nmo_occ + nmo_scf) + gs_mos%evals_virt(nmo_scf - nmo_occ + 1:nmo_virt) = evals_virt(1:nmo_virt - (nmo_scf - nmo_occ)) ELSE - CALL cp_fm_to_fm(mo_coeff_extended, gs_mos%mos_virt, ncol=nmo_virt, source_start=nmo_occ+1, target_start=1) - gs_mos%evals_virt(1:nmo_virt) = mo_evals_extended(nmo_occ+1:nmo_occ+nmo_virt) + CALL cp_fm_to_fm(mo_coeff_extended, gs_mos%mos_virt, ncol=nmo_virt, source_start=nmo_occ + 1, target_start=1) + gs_mos%evals_virt(1:nmo_virt) = mo_evals_extended(nmo_occ + 1:nmo_occ + nmo_virt) END IF IF (do_eigen) & @@ -1377,7 +1377,7 @@ PURE FUNCTION tddfpt_total_number_of_states(gs_mos) RESULT(nstates_total) nspins = SIZE(gs_mos) DO ispin = 1, nspins - nstates_total = nstates_total+ & + nstates_total = nstates_total + & SIZE(gs_mos(ispin)%evals_occ, kind=int_8)* & SIZE(gs_mos(ispin)%evals_virt, kind=int_8) END DO @@ -1458,11 +1458,11 @@ SUBROUTINE tddfpt_guess_vectors(evects, evals, gs_mos, log_unit) DO ispin = 1, nspins DO imo_occ = 1, nmo_occ_selected(ispin) ! Here imo_occ enumerate Occupied orbitals in inverse order (from the last to the first element) - e_occ = gs_mos(ispin)%evals_occ(nmo_occ_avail(ispin)-imo_occ+1) + e_occ = gs_mos(ispin)%evals_occ(nmo_occ_avail(ispin) - imo_occ + 1) DO imo_virt = 1, nmo_virt_selected(ispin) - istate = istate+1 - e_virt_minus_occ(istate) = gs_mos(ispin)%evals_virt(imo_virt)-e_occ + istate = istate + 1 + e_virt_minus_occ(istate) = gs_mos(ispin)%evals_virt(imo_virt) - e_occ END DO END DO END DO @@ -1493,25 +1493,25 @@ SUBROUTINE tddfpt_guess_vectors(evects, evals, gs_mos, log_unit) WRITE (log_unit, '(1X,I8,11X,A19,8X,F14.5)') & istate, "*** restarted ***", evals(istate)*evolt ELSE - ind = inds(istate)-1 + ind = inds(istate) - 1 IF (nspins > 1) THEN IF (ind < nstates_occ_virt_alpha) THEN ispin = 1 spin_label = '(alp)' ELSE ispin = 2 - ind = ind-nstates_occ_virt_alpha + ind = ind - nstates_occ_virt_alpha spin_label = '(bet)' END IF END IF - imo_occ = nmo_occ_avail(ispin)-ind/nmo_virt_selected(ispin) - imo_virt = MOD(ind, nmo_virt_selected(ispin))+1 + imo_occ = nmo_occ_avail(ispin) - ind/nmo_virt_selected(ispin) + imo_virt = MOD(ind, nmo_virt_selected(ispin)) + 1 evals(istate) = e_virt_minus_occ(istate) IF (log_unit > 0) & WRITE (log_unit, '(1X,I8,5X,I8,1X,A5,3X,I8,1X,A5,2X,F14.5)') & - istate, imo_occ, spin_label, nmo_occ_avail(ispin)+imo_virt, spin_label, e_virt_minus_occ(istate)*evolt + istate, imo_occ, spin_label, nmo_occ_avail(ispin) + imo_virt, spin_label, e_virt_minus_occ(istate)*evolt DO jspin = 1, nspins ! .NOT. ASSOCIATED(evects(jspin, istate)%matrix)) @@ -1706,7 +1706,7 @@ SUBROUTINE tddfpt_orthonormalize_psi1_psi1(evects, nvects_new, S_evects, matrix_ nspins = SIZE(evects, 1) nvects_total = SIZE(evects, 2) - nvects_old = nvects_total-nvects_new + nvects_old = nvects_total - nvects_new IF (debug_this_module) THEN CPASSERT(SIZE(S_evects, 1) == nspins) @@ -1718,9 +1718,9 @@ SUBROUTINE tddfpt_orthonormalize_psi1_psi1(evects, nvects_new, S_evects, matrix_ CALL cp_fm_get_info(matrix=evects(ispin, 1)%matrix, ncol_global=nmo_occ(ispin)) END DO - DO jvect = nvects_old+1, nvects_total + DO jvect = nvects_old + 1, nvects_total ! - DO ivect = 1, jvect-1 + DO ivect = 1, jvect - 1 CALL cp_fm_trace(evects(:, jvect), S_evects(:, ivect), weights(1:nspins)) norm = accurate_sum(weights(1:nspins)) @@ -2554,15 +2554,15 @@ SUBROUTINE tddfpt_compute_residual_vects(residual_vects, evals, ritz_vects, Aop_ work_fm_ao_mo_occ(ispin)%matrix, 0.0_dp, work_fm_mo_virt_mo_occ(ispin)%matrix) DO icol_local = 1, ncols_local - e_occ_plus_lambda = gs_mos(ispin)%evals_occ(col_indices_local(icol_local))+lambda + e_occ_plus_lambda = gs_mos(ispin)%evals_occ(col_indices_local(icol_local)) + lambda DO irow_local = 1, nrows_local - eref = gs_mos(ispin)%evals_virt(row_indices_local(irow_local))-e_occ_plus_lambda + eref = gs_mos(ispin)%evals_virt(row_indices_local(irow_local)) - e_occ_plus_lambda ! eref = e_virt - e_occ - lambda = e_virt - e_occ - (eref_scale*lambda + (1-eref_scale)*lambda); ! eref_new = e_virt - e_occ - eref_scale*lambda = eref + (1 - eref_scale)*lambda IF (ABS(eref) < threshold) & - eref = eref+(1.0_dp-eref_scale)*lambda + eref = eref + (1.0_dp - eref_scale)*lambda weights_ldata(irow_local, icol_local) = weights_ldata(irow_local, icol_local)/eref END DO @@ -2691,9 +2691,9 @@ FUNCTION tddfpt_davidson_solver(evects, evals, S_evects, gs_mos, do_hfx, tddfpt_ ! davidson iteration CALL cp_iterate(logger%iter_info, iter_nr_out=iter) - CALL tddfpt_compute_Aop_evects(Aop_evects=Aop_krylov(:, nvects_exist+1:nvects_exist+nvects_new), & - evects=krylov_vects(:, nvects_exist+1:nvects_exist+nvects_new), & - S_evects=S_krylov(:, nvects_exist+1:nvects_exist+nvects_new), & + CALL tddfpt_compute_Aop_evects(Aop_evects=Aop_krylov(:, nvects_exist + 1:nvects_exist + nvects_new), & + evects=krylov_vects(:, nvects_exist + 1:nvects_exist + nvects_new), & + S_evects=S_krylov(:, nvects_exist + 1:nvects_exist + nvects_new), & gs_mos=gs_mos, is_rks_triplets=tddfpt_control%rks_triplets, & do_hfx=do_hfx, matrix_ks=matrix_ks, & qs_env=qs_env, kernel_env=kernel_env, & @@ -2702,50 +2702,50 @@ FUNCTION tddfpt_davidson_solver(evects, evals, S_evects, gs_mos, do_hfx, tddfpt_ work_matrices=work_matrices) CALL tddfpt_compute_ritz_vects(ritz_vects=evects, Aop_ritz=Aop_ritz, & - evals=evals_last(1:nvects_exist+nvects_new), & - krylov_vects=krylov_vects(:, 1:nvects_exist+nvects_new), & - Aop_krylov=Aop_krylov(:, 1:nvects_exist+nvects_new)) + evals=evals_last(1:nvects_exist + nvects_new), & + krylov_vects=krylov_vects(:, 1:nvects_exist + nvects_new), & + Aop_krylov=Aop_krylov(:, 1:nvects_exist + nvects_new)) CALL tddfpt_write_restart(evects=evects, evals=evals_last(1:nstates), gs_mos=gs_mos, & logger=logger, tddfpt_print_section=tddfpt_print_section) - conv = MAXVAL(ABS(evals_last(1:nstates)-evals(1:nstates))) + conv = MAXVAL(ABS(evals_last(1:nstates) - evals(1:nstates))) - nvects_exist = nvects_exist+nvects_new - IF (nvects_exist+nvects_new > max_krylov_vects) & - nvects_new = max_krylov_vects-nvects_exist + nvects_exist = nvects_exist + nvects_new + IF (nvects_exist + nvects_new > max_krylov_vects) & + nvects_new = max_krylov_vects - nvects_exist IF (iter >= tddfpt_control%niters) nvects_new = 0 IF (conv > tddfpt_control%conv .AND. nvects_new > 0) THEN ! compute residual vectors for the next iteration DO istate = 1, nvects_new DO ispin = 1, nspins - NULLIFY (Aop_krylov(ispin, nvects_exist+istate)%matrix, & - krylov_vects(ispin, nvects_exist+istate)%matrix, & - S_krylov(ispin, nvects_exist+istate)%matrix) + NULLIFY (Aop_krylov(ispin, nvects_exist + istate)%matrix, & + krylov_vects(ispin, nvects_exist + istate)%matrix, & + S_krylov(ispin, nvects_exist + istate)%matrix) CALL fm_pool_create_fm(work_matrices%fm_pool_ao_mo_occ(ispin)%pool, & - krylov_vects(ispin, nvects_exist+istate)%matrix) + krylov_vects(ispin, nvects_exist + istate)%matrix) CALL fm_pool_create_fm(work_matrices%fm_pool_ao_mo_occ(ispin)%pool, & - S_krylov(ispin, nvects_exist+istate)%matrix) + S_krylov(ispin, nvects_exist + istate)%matrix) CALL fm_pool_create_fm(work_matrices%fm_pool_ao_mo_occ(ispin)%pool, & - Aop_krylov(ispin, nvects_exist+istate)%matrix) + Aop_krylov(ispin, nvects_exist + istate)%matrix) END DO END DO - CALL tddfpt_compute_residual_vects(residual_vects=krylov_vects(:, nvects_exist+1:nvects_exist+nvects_new), & + CALL tddfpt_compute_residual_vects(residual_vects=krylov_vects(:, nvects_exist + 1:nvects_exist + nvects_new), & evals=evals_last(1:nvects_new), & ritz_vects=evects(:, 1:nvects_new), Aop_ritz=Aop_ritz(:, 1:nvects_new), & gs_mos=gs_mos, matrix_s=matrix_s(1)%matrix, & work_fm_ao_mo_occ=work_matrices%wfm_ao_mo_occ, & work_fm_mo_virt_mo_occ=work_matrices%wfm_mo_virt_mo_occ) - CALL tddfpt_orthogonalize_psi1_psi0(krylov_vects(:, nvects_exist+1:nvects_exist+nvects_new), & + CALL tddfpt_orthogonalize_psi1_psi0(krylov_vects(:, nvects_exist + 1:nvects_exist + nvects_new), & work_matrices%S_C0_C0T, work_matrices%wfm_ao_mo_occ) - CALL tddfpt_orthonormalize_psi1_psi1(krylov_vects(:, 1:nvects_exist+nvects_new), nvects_new, & - S_krylov(:, 1:nvects_exist+nvects_new), matrix_s(1)%matrix) + CALL tddfpt_orthonormalize_psi1_psi1(krylov_vects(:, 1:nvects_exist + nvects_new), nvects_new, & + S_krylov(:, 1:nvects_exist + nvects_new), matrix_s(1)%matrix) - is_nonortho = tddfpt_is_nonorthogonal_psi1_psi0(krylov_vects(:, nvects_exist+1:nvects_exist+nvects_new), & + is_nonortho = tddfpt_is_nonorthogonal_psi1_psi0(krylov_vects(:, nvects_exist + 1:nvects_exist + nvects_new), & work_matrices%S_C0, tddfpt_control%orthogonal_eps, & work_matrices%wfm_mo_occ_mo_occ) ELSE @@ -2759,7 +2759,7 @@ FUNCTION tddfpt_davidson_solver(evects, evals, S_evects, gs_mos, do_hfx, tddfpt_ WRITE (energy_unit, '(/,4X,A,T14,A,T36,A)') "State", "Exc. energy (eV)", "Convergence (eV)" DO istate = 1, nstates WRITE (energy_unit, '(1X,I8,T12,F14.7,T38,ES11.4)') istate, & - evals_last(istate)*evolt, (evals_last(istate)-evals(istate))*evolt + evals_last(istate)*evolt, (evals_last(istate) - evals(istate))*evolt END DO WRITE (energy_unit, *) CALL m_flush(energy_unit) @@ -2768,11 +2768,11 @@ FUNCTION tddfpt_davidson_solver(evects, evals, S_evects, gs_mos, do_hfx, tddfpt_ IF (iter_unit > 0) THEN nstates_conv = 0 DO istate = 1, nstates - IF (ABS(evals_last(istate)-evals(istate)) <= tddfpt_control%conv) & - nstates_conv = nstates_conv+1 + IF (ABS(evals_last(istate) - evals(istate)) <= tddfpt_control%conv) & + nstates_conv = nstates_conv + 1 END DO - WRITE (iter_unit, '(1X,I8,T12,F7.1,T24,ES11.4,T42,I8)') iter, t2-t1, conv, nstates_conv + WRITE (iter_unit, '(1X,I8,T12,F7.1,T24,ES11.4,T42,I8)') iter, t2 - t1, conv, nstates_conv CALL m_flush(iter_unit) END IF @@ -2789,7 +2789,7 @@ FUNCTION tddfpt_davidson_solver(evects, evals, S_evects, gs_mos, do_hfx, tddfpt_ END IF END DO - DO istate = nvects_exist+nvects_new, 1, -1 + DO istate = nvects_exist + nvects_new, 1, -1 DO ispin = nspins, 1, -1 CALL fm_pool_give_back_fm(work_matrices%fm_pool_ao_mo_occ(ispin)%pool, Aop_krylov(ispin, istate)%matrix) CALL fm_pool_give_back_fm(work_matrices%fm_pool_ao_mo_occ(ispin)%pool, S_krylov(ispin, istate)%matrix) @@ -3111,7 +3111,7 @@ SUBROUTINE tddfpt_dipole_operator(dipole_op_mos_occ, tddfpt_control, gs_mos, qs_ CALL dbcsr_deallocate_matrix_set(rRc_xyz) CASE (tddfpt_dipole_velocity) - IF (SIZE(matrix_s) < nderivs+1) THEN + IF (SIZE(matrix_s) < nderivs + 1) THEN CPABORT("Where is the derivative?") END IF @@ -3136,13 +3136,13 @@ SUBROUTINE tddfpt_dipole_operator(dipole_op_mos_occ, tddfpt_control, gs_mos, qs_ DO irow = 1, nrows_local ! ediff_inv_weights(a, i) = 1.0 / (E_virt_a - E_occ_i) ! imo_virt = row_indices(irow) - local_data_ediff(irow, icol) = 1.0_dp/(gs_mos(ispin)%evals_virt(row_indices(irow))-eval_occ) + local_data_ediff(irow, icol) = 1.0_dp/(gs_mos(ispin)%evals_virt(row_indices(irow)) - eval_occ) END DO END DO !$OMP END PARALLEL DO DO ideriv = 1, nderivs - CALL cp_dbcsr_sm_fm_multiply(matrix_s(ideriv+1)%matrix, & + CALL cp_dbcsr_sm_fm_multiply(matrix_s(ideriv + 1)%matrix, & gs_mos(ispin)%mos_occ, & dipole_op_mos_occ(ideriv, ispin)%matrix, & ncol=nmo_occ(ispin), alpha=1.0_dp, beta=0.0_dp) @@ -3261,7 +3261,7 @@ SUBROUTINE tddfpt_print_summary(log_unit, evects, evals, mult, dipole_op_mos_occ IF (nspins == 1) THEN trans_dipoles(:, :, 1) = SQRT(2.0_dp)*trans_dipoles(:, :, 1) ELSE - trans_dipoles(:, :, 1) = SQRT(trans_dipoles(:, :, 1)**2+trans_dipoles(:, :, 2)**2) + trans_dipoles(:, :, 1) = SQRT(trans_dipoles(:, :, 1)**2 + trans_dipoles(:, :, 2)**2) END IF END IF @@ -3378,7 +3378,7 @@ SUBROUTINE tddfpt_print_excitation_analysis(log_unit, evects, gs_mos, matrix_s, nexcs_max_local = 0 DO ispin = 1, nspins CALL cp_fm_get_info(weights_fm(ispin)%matrix, nrow_local=nrows_local, ncol_local=ncols_local) - nexcs_max_local = nexcs_max_local+INT(nrows_local, int_8)*INT(ncols_local, int_8) + nexcs_max_local = nexcs_max_local + INT(nrows_local, int_8)*INT(ncols_local, int_8) END DO ALLOCATE (weights_local(nexcs_max_local), inds_local(nexcs_max_local)) @@ -3402,17 +3402,17 @@ SUBROUTINE tddfpt_print_excitation_analysis(log_unit, evects, gs_mos, matrix_s, DO irow = 1, nrows_local IF (ABS(local_data(irow, icol)) >= min_amplitude) THEN ! number of non-negligible excitations - nexcs_local = nexcs_local+1 + nexcs_local = nexcs_local + 1 ! excitation amplitude weights_local(nexcs_local) = local_data(irow, icol) ! index of single excitation (ivirt, iocc, ispin) in compressed form - inds_local(nexcs_local) = nmo_virt_occ+INT(row_indices(irow), int_8)+ & - INT(col_indices(icol)-1, int_8)*nmo_virt8(ispin) + inds_local(nexcs_local) = nmo_virt_occ + INT(row_indices(irow), int_8) + & + INT(col_indices(icol) - 1, int_8)*nmo_virt8(ispin) END IF END DO END DO - nmo_virt_occ = nmo_virt_occ+nmo_virt8(ispin)*nmo_occ8(ispin) + nmo_virt_occ = nmo_virt_occ + nmo_virt8(ispin)*nmo_occ8(ispin) END DO IF (para_env%ionode) THEN @@ -3421,22 +3421,22 @@ SUBROUTINE tddfpt_print_excitation_analysis(log_unit, evects, gs_mos, matrix_s, ! collect number of non-negligible excitations from other nodes DO iproc = 1, para_env%num_pe - IF (iproc-1 /= para_env%mepos) THEN - CALL mp_irecv(nexcs_recv(iproc:iproc), iproc-1, para_env%group, recv_handlers(iproc), 0) + IF (iproc - 1 /= para_env%mepos) THEN + CALL mp_irecv(nexcs_recv(iproc:iproc), iproc - 1, para_env%group, recv_handlers(iproc), 0) ELSE nexcs_recv(iproc) = nexcs_local END IF END DO DO iproc = 1, para_env%num_pe - IF (iproc-1 /= para_env%mepos) & + IF (iproc - 1 /= para_env%mepos) & CALL mp_wait(recv_handlers(iproc)) END DO ! compute total number of non-negligible excitations nexcs = 0 DO iproc = 1, para_env%num_pe - nexcs = nexcs+nexcs_recv(iproc) + nexcs = nexcs + nexcs_recv(iproc) END DO ! receive indices and amplitudes of selected excitations @@ -3446,25 +3446,25 @@ SUBROUTINE tddfpt_print_excitation_analysis(log_unit, evects, gs_mos, matrix_s, nmo_virt_occ = 0 DO iproc = 1, para_env%num_pe IF (nexcs_recv(iproc) > 0) THEN - IF (iproc-1 /= para_env%mepos) THEN + IF (iproc - 1 /= para_env%mepos) THEN ! excitation amplitudes - CALL mp_irecv(weights_recv(nmo_virt_occ+1:nmo_virt_occ+nexcs_recv(iproc)), & - iproc-1, para_env%group, recv_handlers(iproc), 1) + CALL mp_irecv(weights_recv(nmo_virt_occ + 1:nmo_virt_occ + nexcs_recv(iproc)), & + iproc - 1, para_env%group, recv_handlers(iproc), 1) ! compressed indices - CALL mp_irecv(inds_recv(nmo_virt_occ+1:nmo_virt_occ+nexcs_recv(iproc)), & - iproc-1, para_env%group, recv_handlers2(iproc), 2) + CALL mp_irecv(inds_recv(nmo_virt_occ + 1:nmo_virt_occ + nexcs_recv(iproc)), & + iproc - 1, para_env%group, recv_handlers2(iproc), 2) ELSE ! data on master node - weights_recv(nmo_virt_occ+1:nmo_virt_occ+nexcs_recv(iproc)) = weights_local(1:nexcs_recv(iproc)) - inds_recv(nmo_virt_occ+1:nmo_virt_occ+nexcs_recv(iproc)) = inds_local(1:nexcs_recv(iproc)) + weights_recv(nmo_virt_occ + 1:nmo_virt_occ + nexcs_recv(iproc)) = weights_local(1:nexcs_recv(iproc)) + inds_recv(nmo_virt_occ + 1:nmo_virt_occ + nexcs_recv(iproc)) = inds_local(1:nexcs_recv(iproc)) END IF - nmo_virt_occ = nmo_virt_occ+nexcs_recv(iproc) + nmo_virt_occ = nmo_virt_occ + nexcs_recv(iproc) END IF END DO DO iproc = 1, para_env%num_pe - IF (iproc-1 /= para_env%mepos .AND. nexcs_recv(iproc) > 0) THEN + IF (iproc - 1 /= para_env%mepos .AND. nexcs_recv(iproc) > 0) THEN CALL mp_wait(recv_handlers(iproc)) CALL mp_wait(recv_handlers2(iproc)) END IF @@ -3497,23 +3497,23 @@ SUBROUTINE tddfpt_print_excitation_analysis(log_unit, evects, gs_mos, matrix_s, WRITE (log_unit, '(1X,I8)') istate DO iexc = 1, nexcs - ind = inds_recv(inds(iexc))-1 + ind = inds_recv(inds(iexc)) - 1 IF (nspins > 1) THEN IF (ind < nmo_virt_occ_alpha) THEN state_spin = 1 spin_label = '(alp)' ELSE state_spin = 2 - ind = ind-nmo_virt_occ_alpha + ind = ind - nmo_virt_occ_alpha spin_label = '(bet)' END IF END IF - imo_occ = ind/nmo_virt8(state_spin)+1 - imo_virt = MOD(ind, nmo_virt8(state_spin))+1 + imo_occ = ind/nmo_virt8(state_spin) + 1 + imo_virt = MOD(ind, nmo_virt8(state_spin)) + 1 WRITE (log_unit, '(T14,I8,1X,A5,T30,I8,1X,A5,T50,F9.6)') imo_occ, spin_label, & - nmo_occ8(state_spin)+imo_virt, spin_label, weights_recv(inds(iexc)) + nmo_occ8(state_spin) + imo_virt, spin_label, weights_recv(inds(iexc)) END DO END IF diff --git a/src/qs_tddfpt2_subgroups.F b/src/qs_tddfpt2_subgroups.F index a80e20a394..11577013e9 100644 --- a/src/qs_tddfpt2_subgroups.F +++ b/src/qs_tddfpt2_subgroups.F @@ -200,7 +200,7 @@ SUBROUTINE tddfpt_sub_env_init(sub_env, qs_env, mos_occ) NULLIFY (sub_env%admm_A) IF (sub_env%is_split) THEN - ALLOCATE (sub_env%group_distribution(0:para_env_global%num_pe-1)) + ALLOCATE (sub_env%group_distribution(0:para_env_global%num_pe - 1)) CALL mp_comm_split(comm=para_env_global%group, sub_comm=sub_env%mpi_comm, ngroups=sub_env%ngroups, & group_distribution=sub_env%group_distribution, subgroup_min_size=tddfpt_control%nprocs) @@ -436,7 +436,7 @@ SUBROUTINE init_tddfpt_mgrid(qs_control, tddfpt_control, mgrid_saved) ELSE qs_control%e_cutoff(1) = qs_control%cutoff DO igrid = 2, ngrids - qs_control%e_cutoff(igrid) = qs_control%e_cutoff(igrid-1)/qs_control%progression_factor + qs_control%e_cutoff(igrid) = qs_control%e_cutoff(igrid - 1)/qs_control%progression_factor END DO END IF @@ -711,7 +711,7 @@ SUBROUTINE tddfpt_fm_replicate_across_subgroups(fm_src, fm_dest_sub, sub_env) igroup_local = sub_env%group_distribution(para_env_global%mepos) ngroups = sub_env%ngroups - DO igroup = 0, ngroups-1 + DO igroup = 0, ngroups - 1 IF (igroup == igroup_local) THEN CALL cp_fm_copy_general(fm_src, fm_dest_sub, para_env_global) ELSE diff --git a/src/qs_tddfpt_eigensolver.F b/src/qs_tddfpt_eigensolver.F index abde682bd4..a06d103f38 100644 --- a/src/qs_tddfpt_eigensolver.F +++ b/src/qs_tddfpt_eigensolver.F @@ -276,12 +276,12 @@ FUNCTION iterative_solver(in_evals, & n_kv = n_ev iteration: DO - CALL allocate_krylov_vectors(b, "b-", k+1, n_kv, nspins, kv_fm_struct) - CALL allocate_krylov_vectors(Ab, "Ab-", k+1, n_kv, nspins, kv_fm_struct) - CALL allocate_krylov_vectors(Sb, "Sb-", k+1, n_kv, nspins, kv_fm_struct) + CALL allocate_krylov_vectors(b, "b-", k + 1, n_kv, nspins, kv_fm_struct) + CALL allocate_krylov_vectors(Ab, "Ab-", k + 1, n_kv, nspins, kv_fm_struct) + CALL allocate_krylov_vectors(Sb, "Sb-", k + 1, n_kv, nspins, kv_fm_struct) DO i = 1, n_kv - k = k+1 + k = k + 1 IF (k <= SIZE(t_env%evecs, 1)) THEN ! the first iteration @@ -298,10 +298,10 @@ FUNCTION iterative_solver(in_evals, & DO spin = 1, nspins IF (tddfpt_control%invert_S) THEN CALL cp_fm_symm('L', 'U', p_env%n_ao(spin), p_env%n_mo(spin), & - 1.0_dp, t_env%invS(spin)%matrix, Ab(k-1, spin)%matrix, & + 1.0_dp, t_env%invS(spin)%matrix, Ab(k - 1, spin)%matrix, & 0.0_dp, b(k, spin)%matrix) ELSE - CALL cp_fm_to_fm(Ab(k-1, spin)%matrix, b(k, spin)%matrix) + CALL cp_fm_to_fm(Ab(k - 1, spin)%matrix, b(k, spin)%matrix) END IF END DO @@ -312,10 +312,10 @@ FUNCTION iterative_solver(in_evals, & DO spin = 1, nspins CALL cp_fm_set_all(R(spin)%matrix, 0.0_dp) - DO j = 1, k-i + DO j = 1, k - i CALL cp_fm_to_fm(Ab(j, spin)%matrix, X(spin)%matrix) CALL cp_fm_scale_and_add(1.0_dp, X(spin)%matrix, & - -evals(iev, iter-1), Sb(j, spin)%matrix) + -evals(iev, iter - 1), Sb(j, spin)%matrix) CALL cp_fm_get_element(Us%matrix, j, iev, tmp) CALL cp_fm_scale_and_add(1.0_dp, R(spin)%matrix, & tmp, X(spin)%matrix) @@ -335,9 +335,9 @@ FUNCTION iterative_solver(in_evals, & IF (dft_control%tddfpt_control%precond) THEN DO col = 1, p_env%n_mo(spin) IF (col <= n_ev) THEN - tmp2 = ABS(evals(iev, iter-1)-in_evals(col)) + tmp2 = ABS(evals(iev, iter - 1) - in_evals(col)) ELSE - tmp2 = ABS(evals(iev, iter-1)-(in_evals(n_ev)+10.0_dp)) + tmp2 = ABS(evals(iev, iter - 1) - (in_evals(n_ev) + 10.0_dp)) END IF ! protect against division by 0 by a introducing a cutoff. tmp2 = MAX(tmp2, 100*EPSILON(1.0_dp)) @@ -361,7 +361,7 @@ FUNCTION iterative_solver(in_evals, & CALL p_preortho(p_env, qs_env, b(k, :)) DO j = 1, tddfpt_control%n_reortho - CALL reorthogonalize(b(k, :), b, Sb, R, k-1) ! R is temp + CALL reorthogonalize(b(k, :), b, Sb, R, k - 1) ! R is temp END DO CALL normalize(b(k, :), R, matrix_s) ! R is temp DO spin = 1, nspins @@ -404,7 +404,7 @@ FUNCTION iterative_solver(in_evals, & Atilde_ij = 0.0_dp DO spin = 1, nspins CALL cp_fm_trace(b(i, spin)%matrix, Ab(j, spin)%matrix, tmp) - Atilde_ij = Atilde_ij+tmp + Atilde_ij = Atilde_ij + tmp END DO CALL cp_fm_set_element(Atilde%matrix, i, j, Atilde_ij) END DO @@ -423,7 +423,7 @@ FUNCTION iterative_solver(in_evals, & evals_difference = 1.0_dp IF (iter /= 1) THEN - evals_difference(:) = ABS((evals(1:n_ev, iter-1)-evals(1:n_ev, iter))) + evals_difference(:) = ABS((evals(1:n_ev, iter - 1) - evals(1:n_ev, iter))) ! For debugging IF (output_unit > 0) THEN WRITE (output_unit, *) @@ -457,14 +457,14 @@ FUNCTION iterative_solver(in_evals, & DO i = 1, n_ev IF (must_improve(i) == 1) THEN must_improve(j) = i - j = j+1 + j = j + 1 END IF END DO END IF - IF (k+n_kv > max_kv) EXIT iteration + IF (k + n_kv > max_kv) EXIT iteration - iter = iter+1 + iter = iter + 1 END DO iteration @@ -552,7 +552,7 @@ SUBROUTINE apply_op(X, R, p_env, qs_env, do_kernel) CALL timeset(routineN, handle) - counter = counter+1 + counter = counter + 1 CALL get_qs_env(qs_env, dft_control=dft_control) nspins = dft_control%nspins @@ -618,7 +618,7 @@ SUBROUTINE allocate_krylov_vectors(vectors, vectors_name, & INTEGER :: index, spin DO spin = 1, nspins - DO index = startv, startv+n_v-1 + DO index = startv, startv + n_v - 1 NULLIFY (vectors(index, spin)%matrix) mat_name = routineP//vectors_name//TRIM(cp_to_string(index)) & //","//TRIM(cp_to_string(spin)) diff --git a/src/qs_tddfpt_utils.F b/src/qs_tddfpt_utils.F index 23f3232093..ed1c4c136c 100644 --- a/src/qs_tddfpt_utils.F +++ b/src/qs_tddfpt_utils.F @@ -203,7 +203,7 @@ SUBROUTINE co_initial_guess(matrices, energies, n_v, qs_env) ! create a SORTED list of initial guesses ! !-----------------------------------------! ! first element - evd = tddfpt_control%lumos_eigenvalues(1, spin)-orbital_eigenvalues(n_orbits) + evd = tddfpt_control%lumos_eigenvalues(1, spin) - orbital_eigenvalues(n_orbits) ALLOCATE (sorter_start) sorter_start%orbit = n_orbits sorter_start%lumo = 1 @@ -215,7 +215,7 @@ SUBROUTINE co_initial_guess(matrices, energies, n_v, qs_env) IF (oo == n_orbits .AND. vo == 1) CYCLE ! already in list - evd = tddfpt_control%lumos_eigenvalues(vo, spin)-orbital_eigenvalues(oo) + evd = tddfpt_control%lumos_eigenvalues(vo, spin) - orbital_eigenvalues(oo) sorter_iterator => sorter_start NULLIFY (sorter_pointer) @@ -250,11 +250,11 @@ SUBROUTINE co_initial_guess(matrices, energies, n_v, qs_env) guess(:, sorter_iterator%orbit), 1) CALL cp_fm_set_submatrix(matrices(i, spin)%matrix, & guess(:, 1:n_orbits)) - energies(i) = energies(i)+sorter_iterator%value/REAL(n_spins, dp) + energies(i) = energies(i) + sorter_iterator%value/REAL(n_spins, dp) sorter_iterator => sorter_iterator%next END DO IF (n_v > n_orbits*n_lumos) THEN - DO i = n_orbits*n_lumos+1, n_v + DO i = n_orbits*n_lumos + 1, n_v CALL cp_fm_init_random(matrices(i, spin)%matrix, n_orbits) energies(i) = 1.0E38_dp END DO @@ -345,14 +345,14 @@ SUBROUTINE find_contributions(qs_env, t_env) 1, virt, nrows(spin), 1) contribution = 0.0_dp DO j = 1, nrows(spin) - contribution = contribution+homo_coeff_col(j, 1)*lumo_coeff_col(j, 1) + contribution = contribution + homo_coeff_col(j, 1)*lumo_coeff_col(j, 1) END DO - summed_contributions = summed_contributions+(contribution)**2 + summed_contributions = summed_contributions + (contribution)**2 IF (ABS(contribution) > 5.0e-2_dp) THEN IF (output_unit > 0) WRITE (output_unit, '(14X,I5,A,I5,10X,F8.3,5X,F8.3)') & - occ, " ->", nhomos(spin)+virt, ABS(contribution), summed_contributions + occ, " ->", nhomos(spin) + virt, ABS(contribution), summed_contributions END IF - IF (ABS(summed_contributions-1.0_dp) < 1.0e-3_dp) CYCLE searchloop + IF (ABS(summed_contributions - 1.0_dp) < 1.0e-3_dp) CYCLE searchloop END DO END DO searchloop END DO @@ -398,7 +398,7 @@ SUBROUTINE normalize(X, tmp_vec, metric) X(spin)%matrix%matrix_struct%ncol_global, & 1.0_dp, 0.0_dp) CALL cp_fm_trace(X(spin)%matrix, tmp_vec(spin)%matrix, tmp) - norm = norm+tmp + norm = norm + tmp END DO norm = SQRT(norm) @@ -446,7 +446,7 @@ SUBROUTINE reorthogonalize(X, V_set, SV_set, work, n) dot_product = 0.0_dp DO spin = 1, n_spins CALL cp_fm_trace(SV_set(i, spin)%matrix, work(spin)%matrix, tmp) - dot_product = dot_product+tmp + dot_product = dot_product + tmp END DO DO spin = 1, n_spins CALL cp_fm_scale_and_add(1.0_dp, X(spin)%matrix, & diff --git a/src/qs_vxc.F b/src/qs_vxc.F index a1643da6a8..5a70c26c7a 100644 --- a/src/qs_vxc.F +++ b/src/qs_vxc.F @@ -202,7 +202,7 @@ SUBROUTINE qs_vxc_create(ks_env, rho_struct, xc_section, vxc_rho, vxc_tau, exc, ! no idea yet what to do here in that case CPASSERT(.NOT. tau_r_valid) CASE (sic_mauri_us) - my_scaling = 1.0_dp-dft_control%sic_scaling_b + my_scaling = 1.0_dp - dft_control%sic_scaling_b ! no idea yet what to do here in that case CPASSERT(.NOT. tau_r_valid) CASE (sic_eo) @@ -419,7 +419,7 @@ SUBROUTINE qs_vxc_create(ks_env, rho_struct, xc_section, vxc_rho, vxc_tau, exc, virial_xc=virial_xc_tmp) END IF - exc = exc-dft_control%sic_scaling_b*exc_m + exc = exc - dft_control%sic_scaling_b*exc_m ! and take care of the potential only vxc_rho is taken into account IF (.NOT. my_just_energy) THEN @@ -491,7 +491,7 @@ SUBROUTINE qs_vxc_create(ks_env, rho_struct, xc_section, vxc_rho, vxc_tau, exc, virial_xc=virial_xc_tmp) END IF - exc = exc-dft_control%sic_scaling_b*nelec_spin(ispin)*exc_m + exc = exc - dft_control%sic_scaling_b*nelec_spin(ispin)*exc_m ! and take care of the potential only vxc_rho is taken into account IF (.NOT. my_just_energy) THEN @@ -536,7 +536,7 @@ SUBROUTINE qs_vxc_create(ks_env, rho_struct, xc_section, vxc_rho, vxc_tau, exc, virial_xc=virial_xc_tmp) END IF - exc = exc+dft_control%sic_scaling_b*exc_m + exc = exc + dft_control%sic_scaling_b*exc_m ! and take care of the potential IF (.NOT. my_just_energy) THEN diff --git a/src/qs_vxc_atom.F b/src/qs_vxc_atom.F index d00e0867fc..a319cf297d 100644 --- a/src/qs_vxc_atom.F +++ b/src/qs_vxc_atom.F @@ -315,7 +315,7 @@ SUBROUTINE calculate_vxc_atom(qs_env, energy_only, gradient_atom_set, adiabatic_ CALL vxc_of_r_new(xc_fun_section, rho_set_h, deriv_set, 1, needs, weight, & lsd, na, nr, exc_h, vxc_h, vxg_h, vtau_h, energy_only=energy_only, & epr_xc=epr_xc, adiabatic_rescale_factor=my_adiabatic_rescale_factor) - rho_atom%exc_h = rho_atom%exc_h+exc_h + rho_atom%exc_h = rho_atom%exc_h + exc_h !-------------------! ! soft atom density ! @@ -324,7 +324,7 @@ SUBROUTINE calculate_vxc_atom(qs_env, energy_only, gradient_atom_set, adiabatic_ CALL vxc_of_r_new(xc_fun_section, rho_set_s, deriv_set, 1, needs, weight, & lsd, na, nr, exc_s, vxc_s, vxg_s, vtau_s, energy_only=energy_only, & epr_xc=epr_xc, adiabatic_rescale_factor=my_adiabatic_rescale_factor) - rho_atom%exc_s = rho_atom%exc_s+exc_s + rho_atom%exc_s = rho_atom%exc_s + exc_s IF (epr_xc) THEN DO ispin = 1, nspins @@ -333,10 +333,10 @@ SUBROUTINE calculate_vxc_atom(qs_env, energy_only, gradient_atom_set, adiabatic_ DO ia = 1, na gradient_atom_set(iatom)%nablavks_vec_rad_h(idir, ispin)%r_coef(ir, ia) = & gradient_atom_set(iatom)%nablavks_vec_rad_h(idir, ispin)%r_coef(ir, ia) & - +vxg_h(idir, ia, ir, ispin) + + vxg_h(idir, ia, ir, ispin) gradient_atom_set(iatom)%nablavks_vec_rad_s(idir, ispin)%r_coef(ir, ia) = & gradient_atom_set(iatom)%nablavks_vec_rad_s(idir, ispin)%r_coef(ir, ia) & - +vxg_s(idir, ia, ir, ispin) + + vxg_s(idir, ia, ir, ispin) END DO ! ia END DO ! ir END DO ! idir @@ -345,7 +345,7 @@ SUBROUTINE calculate_vxc_atom(qs_env, energy_only, gradient_atom_set, adiabatic_ ! Add contributions to the exc energy - energy%exc1 = energy%exc1+rho_atom%exc_h-rho_atom%exc_s + energy%exc1 = energy%exc1 + rho_atom%exc_h - rho_atom%exc_s ! Integration to get the matrix elements relative to the vxc_atom ! here the products with the primitives is done: gaVxcgb @@ -764,10 +764,10 @@ SUBROUTINE calc_rho_angular(grid_atom, harmonics, nspins, grad_func, & DO ispin = 1, nspins DO iso = 1, harmonics%max_iso_not0 DO ia = 1, na - rho_h(ia, ispin) = rho_h(ia, ispin)+ & + rho_h(ia, ispin) = rho_h(ia, ispin) + & r_h(ispin)%r_coef(ir, iso)* & harmonics%slm(ia, iso) - rho_s(ia, ispin) = rho_s(ia, ispin)+ & + rho_s(ia, ispin) = rho_s(ia, ispin) + & r_s(ispin)%r_coef(ir, iso)* & harmonics%slm(ia, iso) END DO ! ia @@ -780,51 +780,51 @@ SUBROUTINE calc_rho_angular(grid_atom, harmonics, nspins, grad_func, & DO ia = 1, na ! components of the gradient of rho1 hard - drho_h(1, ia, ir, ispin) = drho_h(1, ia, ir, ispin)+ & + drho_h(1, ia, ir, ispin) = drho_h(1, ia, ir, ispin) + & dr_h(ispin)%r_coef(ir, iso)* & - harmonics%a(1, ia)*harmonics%slm(ia, iso)+ & + harmonics%a(1, ia)*harmonics%slm(ia, iso) + & r_h_d(1, ispin)%r_coef(ir, iso)* & harmonics%slm(ia, iso) - drho_h(2, ia, ir, ispin) = drho_h(2, ia, ir, ispin)+ & + drho_h(2, ia, ir, ispin) = drho_h(2, ia, ir, ispin) + & dr_h(ispin)%r_coef(ir, iso)* & - harmonics%a(2, ia)*harmonics%slm(ia, iso)+ & + harmonics%a(2, ia)*harmonics%slm(ia, iso) + & r_h_d(2, ispin)%r_coef(ir, iso)* & harmonics%slm(ia, iso) - drho_h(3, ia, ir, ispin) = drho_h(3, ia, ir, ispin)+ & + drho_h(3, ia, ir, ispin) = drho_h(3, ia, ir, ispin) + & dr_h(ispin)%r_coef(ir, iso)* & - harmonics%a(3, ia)*harmonics%slm(ia, iso)+ & + harmonics%a(3, ia)*harmonics%slm(ia, iso) + & r_h_d(3, ispin)%r_coef(ir, iso)* & harmonics%slm(ia, iso) ! components of the gradient of rho1 soft - drho_s(1, ia, ir, ispin) = drho_s(1, ia, ir, ispin)+ & + drho_s(1, ia, ir, ispin) = drho_s(1, ia, ir, ispin) + & dr_s(ispin)%r_coef(ir, iso)* & - harmonics%a(1, ia)*harmonics%slm(ia, iso)+ & + harmonics%a(1, ia)*harmonics%slm(ia, iso) + & r_s_d(1, ispin)%r_coef(ir, iso)* & harmonics%slm(ia, iso) - drho_s(2, ia, ir, ispin) = drho_s(2, ia, ir, ispin)+ & + drho_s(2, ia, ir, ispin) = drho_s(2, ia, ir, ispin) + & dr_s(ispin)%r_coef(ir, iso)* & - harmonics%a(2, ia)*harmonics%slm(ia, iso)+ & + harmonics%a(2, ia)*harmonics%slm(ia, iso) + & r_s_d(2, ispin)%r_coef(ir, iso)* & harmonics%slm(ia, iso) - drho_s(3, ia, ir, ispin) = drho_s(3, ia, ir, ispin)+ & + drho_s(3, ia, ir, ispin) = drho_s(3, ia, ir, ispin) + & dr_s(ispin)%r_coef(ir, iso)* & - harmonics%a(3, ia)*harmonics%slm(ia, iso)+ & + harmonics%a(3, ia)*harmonics%slm(ia, iso) + & r_s_d(3, ispin)%r_coef(ir, iso)* & harmonics%slm(ia, iso) drho_h(4, ia, ir, ispin) = SQRT( & - drho_h(1, ia, ir, ispin)*drho_h(1, ia, ir, ispin)+ & - drho_h(2, ia, ir, ispin)*drho_h(2, ia, ir, ispin)+ & + drho_h(1, ia, ir, ispin)*drho_h(1, ia, ir, ispin) + & + drho_h(2, ia, ir, ispin)*drho_h(2, ia, ir, ispin) + & drho_h(3, ia, ir, ispin)*drho_h(3, ia, ir, ispin)) drho_s(4, ia, ir, ispin) = SQRT( & - drho_s(1, ia, ir, ispin)*drho_s(1, ia, ir, ispin)+ & - drho_s(2, ia, ir, ispin)*drho_s(2, ia, ir, ispin)+ & + drho_s(1, ia, ir, ispin)*drho_s(1, ia, ir, ispin) + & + drho_s(2, ia, ir, ispin)*drho_s(2, ia, ir, ispin) + & drho_s(3, ia, ir, ispin)*drho_s(3, ia, ir, ispin)) END DO ! ia @@ -870,21 +870,21 @@ SUBROUTINE calc_tau_angular(grid_atom, harmonics, nspins, ir, & DO ispin = 1, nspins DO iso = 1, harmonics%max_iso_not0 DO ia = 1, na - tau_h(ia, ispin) = tau_h(ia, ispin)+ & + tau_h(ia, ispin) = tau_h(ia, ispin) + & trho_h(1, ispin)%r_coef(ir, iso)*harmonics%slm(ia, iso) - tau_h(ia, ispin) = tau_h(ia, ispin)+ & + tau_h(ia, ispin) = tau_h(ia, ispin) + & trho_h(3, ispin)%r_coef(ir, iso)*harmonics%slm(ia, iso) - tau_s(ia, ispin) = tau_s(ia, ispin)+ & + tau_s(ia, ispin) = tau_s(ia, ispin) + & trho_s(1, ispin)%r_coef(ir, iso)*harmonics%slm(ia, iso) - tau_s(ia, ispin) = tau_s(ia, ispin)+ & + tau_s(ia, ispin) = tau_s(ia, ispin) + & trho_s(3, ispin)%r_coef(ir, iso)*harmonics%slm(ia, iso) END DO ! ia END DO ! iso DO iso = 1, harmonics%max_iso_not0 DO ia = 1, na - tau_h(ia, ispin) = tau_h(ia, ispin)+ & + tau_h(ia, ispin) = tau_h(ia, ispin) + & trho_h(2, ispin)%r_coef(ir, iso)*harmonics%slm(ia, iso)*grid_atom%usin_azi(ia)**2 - tau_s(ia, ispin) = tau_s(ia, ispin)+ & + tau_s(ia, ispin) = tau_s(ia, ispin) + & trho_s(2, ispin)%r_coef(ir, iso)*harmonics%slm(ia, iso)*grid_atom%usin_azi(ia)**2 END DO ! ia END DO ! iso @@ -935,8 +935,8 @@ SUBROUTINE calc_rho_nlcc(grid_atom, nspins, grad_func, & xsp = REAL(nspins, KIND=dp) rho = rho_nlcc(ir)/xsp DO ispin = 1, nspins - rho_h(1:na, ispin) = rho_h(1:na, ispin)+rho - rho_s(1:na, ispin) = rho_s(1:na, ispin)+rho + rho_h(1:na, ispin) = rho_h(1:na, ispin) + rho + rho_s(1:na, ispin) = rho_s(1:na, ispin) + rho END DO ! ispin IF (grad_func) THEN @@ -952,22 +952,22 @@ SUBROUTINE calc_rho_nlcc(grid_atom, nspins, grad_func, & END IF dz = grid_atom%cos_pol(ia) ! components of the gradient of rho1 hard - drho_h(1, ia, ir, ispin) = drho_h(1, ia, ir, ispin)+drho*dx - drho_h(2, ia, ir, ispin) = drho_h(2, ia, ir, ispin)+drho*dy - drho_h(3, ia, ir, ispin) = drho_h(3, ia, ir, ispin)+drho*dz + drho_h(1, ia, ir, ispin) = drho_h(1, ia, ir, ispin) + drho*dx + drho_h(2, ia, ir, ispin) = drho_h(2, ia, ir, ispin) + drho*dy + drho_h(3, ia, ir, ispin) = drho_h(3, ia, ir, ispin) + drho*dz ! components of the gradient of rho1 soft - drho_s(1, ia, ir, ispin) = drho_s(1, ia, ir, ispin)+drho*dx - drho_s(2, ia, ir, ispin) = drho_s(2, ia, ir, ispin)+drho*dy - drho_s(3, ia, ir, ispin) = drho_s(3, ia, ir, ispin)+drho*dz + drho_s(1, ia, ir, ispin) = drho_s(1, ia, ir, ispin) + drho*dx + drho_s(2, ia, ir, ispin) = drho_s(2, ia, ir, ispin) + drho*dy + drho_s(3, ia, ir, ispin) = drho_s(3, ia, ir, ispin) + drho*dz ! norm of gradient drho_h(4, ia, ir, ispin) = SQRT( & - drho_h(1, ia, ir, ispin)*drho_h(1, ia, ir, ispin)+ & - drho_h(2, ia, ir, ispin)*drho_h(2, ia, ir, ispin)+ & + drho_h(1, ia, ir, ispin)*drho_h(1, ia, ir, ispin) + & + drho_h(2, ia, ir, ispin)*drho_h(2, ia, ir, ispin) + & drho_h(3, ia, ir, ispin)*drho_h(3, ia, ir, ispin)) drho_s(4, ia, ir, ispin) = SQRT( & - drho_s(1, ia, ir, ispin)*drho_s(1, ia, ir, ispin)+ & - drho_s(2, ia, ir, ispin)*drho_s(2, ia, ir, ispin)+ & + drho_s(1, ia, ir, ispin)*drho_s(1, ia, ir, ispin) + & + drho_s(2, ia, ir, ispin)*drho_s(2, ia, ir, ispin) + & drho_s(3, ia, ir, ispin)*drho_s(3, ia, ir, ispin)) END DO ! ia END DO ! ispin @@ -1051,17 +1051,17 @@ SUBROUTINE gaVxcgb_noGC(vxc_h, vxc_s, qs_kind, rho_atom, nspins) n2 = nsoset(lmax(iset2)) DO ipgf1 = 1, npgf(iset1) - ngau1 = n1*(ipgf1-1)+m1 - size1 = nsoset(lmax(iset1))-nsoset(lmin(iset1)-1) - nngau1 = nsoset(lmin(iset1)-1)+ngau1 + ngau1 = n1*(ipgf1 - 1) + m1 + size1 = nsoset(lmax(iset1)) - nsoset(lmin(iset1) - 1) + nngau1 = nsoset(lmin(iset1) - 1) + ngau1 g1(1:nr) = EXP(-zet(ipgf1, iset1)*grid_atom%rad2(1:nr)) DO ipgf2 = 1, npgf(iset2) - ngau2 = n2*(ipgf2-1)+m2 + ngau2 = n2*(ipgf2 - 1) + m2 g2(1:nr) = EXP(-zet(ipgf2, iset2)*grid_atom%rad2(1:nr)) - lmin12 = lmin(iset1)+lmin(iset2) - lmax12 = lmax(iset1)+lmax(iset2) + lmin12 = lmin(iset1) + lmin(iset2) + lmax12 = lmax(iset1) + lmax(iset2) ! reduce expansion local densities IF (lmin12 .LE. lmax_expansion) THEN @@ -1076,12 +1076,12 @@ SUBROUTINE gaVxcgb_noGC(vxc_h, vxc_s, qs_kind, rho_atom, nspins) ! limit the expansion of the local densities to a max L IF (lmax12 .GT. lmax_expansion) lmax12 = lmax_expansion - DO l = lmin12+1, lmax12 - gg(1:nr, l) = grid_atom%rad(1:nr)*gg(:, l-1) + DO l = lmin12 + 1, lmax12 + gg(1:nr, l) = grid_atom%rad(1:nr)*gg(:, l - 1) END DO DO ispin = 1, nspins - ld = lmax12+1 + ld = lmax12 + 1 DO ir = 1, nr vx(1:na, ir) = vxc_h(1:na, ir, ispin) END DO @@ -1099,15 +1099,15 @@ SUBROUTINE gaVxcgb_noGC(vxc_h, vxc_s, qs_kind, rho_atom, nspins) DO icg = 1, cg_n_list(iso) iso1 = cg_list(1, icg, iso) iso2 = cg_list(2, icg, iso) - l = indso(1, iso1)+indso(1, iso2) + l = indso(1, iso1) + indso(1, iso2) CPASSERT(l <= lmax_expansion) DO ia = 1, na - matso_h(iso1, iso2) = matso_h(iso1, iso2)+ & + matso_h(iso1, iso2) = matso_h(iso1, iso2) + & gVg_h(ia, l)* & my_CG(iso1, iso2, iso)* & harmonics%slm(ia, iso) - matso_s(iso1, iso2) = matso_s(iso1, iso2)+ & + matso_s(iso1, iso2) = matso_s(iso1, iso2) + & gVg_s(ia, l)* & my_CG(iso1, iso2, iso)* & harmonics%slm(ia, iso) @@ -1116,13 +1116,13 @@ SUBROUTINE gaVxcgb_noGC(vxc_h, vxc_s, qs_kind, rho_atom, nspins) END DO ! Write in the global matrix - DO ic = nsoset(lmin(iset2)-1)+1, nsoset(lmax(iset2)) - iso1 = nsoset(lmin(iset1)-1)+1 - iso2 = ngau2+ic + DO ic = nsoset(lmin(iset2) - 1) + 1, nsoset(lmax(iset2)) + iso1 = nsoset(lmin(iset1) - 1) + 1 + iso2 = ngau2 + ic CALL daxpy(size1, 1.0_dp, matso_h(iso1, ic), 1, & - int_hh(ispin)%r_coef(nngau1+1, iso2), 1) + int_hh(ispin)%r_coef(nngau1 + 1, iso2), 1) CALL daxpy(size1, 1.0_dp, matso_s(iso1, ic), 1, & - int_ss(ispin)%r_coef(nngau1+1, iso2), 1) + int_ss(ispin)%r_coef(nngau1 + 1, iso2), 1) END DO END DO ! ispin @@ -1131,9 +1131,9 @@ SUBROUTINE gaVxcgb_noGC(vxc_h, vxc_s, qs_kind, rho_atom, nspins) END DO ! ipfg2 END DO ! ipfg1 - m2 = m2+maxso + m2 = m2 + maxso END DO ! iset2 - m1 = m1+maxso + m1 = m1 + maxso END DO ! iset1 DEALLOCATE (g1, g2, gg, matso_h, matso_s, gVg_s, gVg_h, vx) @@ -1238,17 +1238,17 @@ SUBROUTINE gaVxcgb_GC(vxc_h, vxc_s, vxg_h, vxg_s, qs_kind, rho_atom, & n2 = nsoset(lmax(iset2)) DO ipgf1 = 1, npgf(iset1) - ngau1 = n1*(ipgf1-1)+m1 - size1 = nsoset(lmax(iset1))-nsoset(lmin(iset1)-1) - nngau1 = nsoset(lmin(iset1)-1)+ngau1 + ngau1 = n1*(ipgf1 - 1) + m1 + size1 = nsoset(lmax(iset1)) - nsoset(lmin(iset1) - 1) + nngau1 = nsoset(lmin(iset1) - 1) + ngau1 g1(1:nr) = EXP(-zet(ipgf1, iset1)*grid_atom%rad2(1:nr)) DO ipgf2 = 1, npgf(iset2) - ngau2 = n2*(ipgf2-1)+m2 + ngau2 = n2*(ipgf2 - 1) + m2 g2(1:nr) = EXP(-zet(ipgf2, iset2)*grid_atom%rad2(1:nr)) - lmin12 = lmin(iset1)+lmin(iset2) - lmax12 = lmax(iset1)+lmax(iset2) + lmin12 = lmin(iset1) + lmin(iset2) + lmax12 = lmax(iset1) + lmax(iset2) !test reduce expansion local densities IF (lmin12 .LE. lmax_expansion) THEN @@ -1265,13 +1265,13 @@ SUBROUTINE gaVxcgb_GC(vxc_h, vxc_s, vxg_h, vxg_s, qs_kind, rho_atom, & !test reduce expansion local densities IF (lmax12 .GT. lmax_expansion) lmax12 = lmax_expansion - DO l = lmin12+1, lmax12 - gg(1:nr, l) = grid_atom%rad(1:nr)*gg(:, l-1) - dgg(1:nr, l-1) = dgg(1:nr, l-1)-2.0_dp*(zet(ipgf1, iset1)+ & - zet(ipgf2, iset2))*gg(1:nr, l) + DO l = lmin12 + 1, lmax12 + gg(1:nr, l) = grid_atom%rad(1:nr)*gg(:, l - 1) + dgg(1:nr, l - 1) = dgg(1:nr, l - 1) - 2.0_dp*(zet(ipgf1, iset1) + & + zet(ipgf2, iset2))*gg(1:nr, l) END DO - dgg(1:nr, lmax12) = dgg(1:nr, lmax12)-2.0_dp*(zet(ipgf1, iset1)+ & - zet(ipgf2, iset2))*grid_atom%rad(1:nr)* & + dgg(1:nr, lmax12) = dgg(1:nr, lmax12) - 2.0_dp*(zet(ipgf1, iset1) + & + zet(ipgf2, iset2))*grid_atom%rad(1:nr)* & gg(1:nr, lmax12) gVXCg_h = 0.0_dp @@ -1283,43 +1283,43 @@ SUBROUTINE gaVxcgb_GC(vxc_h, vxc_s, vxg_h, vxg_s, qs_kind, rho_atom, & DO l = lmin12, lmax12 DO ia = 1, na DO ir = 1, nr - gVXCg_h(ia, l) = gVXCg_h(ia, l)+ & - gg(ir, l)*vxc_h(ia, ir, ispin)+ & + gVXCg_h(ia, l) = gVXCg_h(ia, l) + & + gg(ir, l)*vxc_h(ia, ir, ispin) + & dgg(ir, l)* & - (vxg_h(1, ia, ir, ispin)*harmonics%a(1, ia)+ & - vxg_h(2, ia, ir, ispin)*harmonics%a(2, ia)+ & + (vxg_h(1, ia, ir, ispin)*harmonics%a(1, ia) + & + vxg_h(2, ia, ir, ispin)*harmonics%a(2, ia) + & vxg_h(3, ia, ir, ispin)*harmonics%a(3, ia)) - gVXCg_s(ia, l) = gVXCg_s(ia, l)+ & - gg(ir, l)*vxc_s(ia, ir, ispin)+ & + gVXCg_s(ia, l) = gVXCg_s(ia, l) + & + gg(ir, l)*vxc_s(ia, ir, ispin) + & dgg(ir, l)* & - (vxg_s(1, ia, ir, ispin)*harmonics%a(1, ia)+ & - vxg_s(2, ia, ir, ispin)*harmonics%a(2, ia)+ & + (vxg_s(1, ia, ir, ispin)*harmonics%a(1, ia) + & + vxg_s(2, ia, ir, ispin)*harmonics%a(2, ia) + & vxg_s(3, ia, ir, ispin)*harmonics%a(3, ia)) urad = grid_atom%oorad2l(ir, 1) - gVXGg_h(1, ia, l) = gVXGg_h(1, ia, l)+ & + gVXGg_h(1, ia, l) = gVXGg_h(1, ia, l) + & vxg_h(1, ia, ir, ispin)* & gg(ir, l)*urad - gVXGg_h(2, ia, l) = gVXGg_h(2, ia, l)+ & + gVXGg_h(2, ia, l) = gVXGg_h(2, ia, l) + & vxg_h(2, ia, ir, ispin)* & gg(ir, l)*urad - gVXGg_h(3, ia, l) = gVXGg_h(3, ia, l)+ & + gVXGg_h(3, ia, l) = gVXGg_h(3, ia, l) + & vxg_h(3, ia, ir, ispin)* & gg(ir, l)*urad - gVXGg_s(1, ia, l) = gVXGg_s(1, ia, l)+ & + gVXGg_s(1, ia, l) = gVXGg_s(1, ia, l) + & vxg_s(1, ia, ir, ispin)* & gg(ir, l)*urad - gVXGg_s(2, ia, l) = gVXGg_s(2, ia, l)+ & + gVXGg_s(2, ia, l) = gVXGg_s(2, ia, l) + & vxg_s(2, ia, ir, ispin)* & gg(ir, l)*urad - gVXGg_s(3, ia, l) = gVXGg_s(3, ia, l)+ & + gVXGg_s(3, ia, l) = gVXGg_s(3, ia, l) + & vxg_s(3, ia, ir, ispin)* & gg(ir, l)*urad @@ -1334,16 +1334,16 @@ SUBROUTINE gaVxcgb_GC(vxc_h, vxc_s, vxg_h, vxg_s, qs_kind, rho_atom, & iso1 = cg_list(1, icg, iso) iso2 = cg_list(2, icg, iso) - l = indso(1, iso1)+indso(1, iso2) + l = indso(1, iso1) + indso(1, iso2) !test reduce expansion local densities CPASSERT(l <= lmax_expansion) DO ia = 1, na - matso_h(iso1, iso2) = matso_h(iso1, iso2)+ & + matso_h(iso1, iso2) = matso_h(iso1, iso2) + & gVXCg_h(ia, l)* & harmonics%slm(ia, iso)* & my_CG(iso1, iso2, iso) - matso_s(iso1, iso2) = matso_s(iso1, iso2)+ & + matso_s(iso1, iso2) = matso_s(iso1, iso2) + & gVXCg_s(ia, l)* & harmonics%slm(ia, iso)* & my_CG(iso1, iso2, iso) @@ -1360,19 +1360,19 @@ SUBROUTINE gaVxcgb_GC(vxc_h, vxc_s, vxg_h, vxg_s, qs_kind, rho_atom, & iso1 = dcg_list(1, icg, iso) iso2 = dcg_list(2, icg, iso) - l = indso(1, iso1)+indso(1, iso2) + l = indso(1, iso1) + indso(1, iso2) !test reduce expansion local densities CPASSERT(l <= lmax_expansion) DO ia = 1, na - matso_h(iso1, iso2) = matso_h(iso1, iso2)+ & - (gVXGg_h(1, ia, l)*my_CG_dxyz(1, iso1, iso2, iso)+ & - gVXGg_h(2, ia, l)*my_CG_dxyz(2, iso1, iso2, iso)+ & + matso_h(iso1, iso2) = matso_h(iso1, iso2) + & + (gVXGg_h(1, ia, l)*my_CG_dxyz(1, iso1, iso2, iso) + & + gVXGg_h(2, ia, l)*my_CG_dxyz(2, iso1, iso2, iso) + & gVXGg_h(3, ia, l)*my_CG_dxyz(3, iso1, iso2, iso))* & harmonics%slm(ia, iso) - matso_s(iso1, iso2) = matso_s(iso1, iso2)+ & - (gVXGg_s(1, ia, l)*my_CG_dxyz(1, iso1, iso2, iso)+ & - gVXGg_s(2, ia, l)*my_CG_dxyz(2, iso1, iso2, iso)+ & + matso_s(iso1, iso2) = matso_s(iso1, iso2) + & + (gVXGg_s(1, ia, l)*my_CG_dxyz(1, iso1, iso2, iso) + & + gVXGg_s(2, ia, l)*my_CG_dxyz(2, iso1, iso2, iso) + & gVXGg_s(3, ia, l)*my_CG_dxyz(3, iso1, iso2, iso))* & harmonics%slm(ia, iso) @@ -1386,20 +1386,20 @@ SUBROUTINE gaVxcgb_GC(vxc_h, vxc_s, vxg_h, vxg_s, qs_kind, rho_atom, & END IF ! lmax_expansion ! Write in the global matrix - DO ic = nsoset(lmin(iset2)-1)+1, nsoset(lmax(iset2)) - iso1 = nsoset(lmin(iset1)-1)+1 - iso2 = ngau2+ic + DO ic = nsoset(lmin(iset2) - 1) + 1, nsoset(lmax(iset2)) + iso1 = nsoset(lmin(iset1) - 1) + 1 + iso2 = ngau2 + ic CALL daxpy(size1, 1.0_dp, matso_h(iso1, ic), 1, & - int_hh(ispin)%r_coef(nngau1+1, iso2), 1) + int_hh(ispin)%r_coef(nngau1 + 1, iso2), 1) CALL daxpy(size1, 1.0_dp, matso_s(iso1, ic), 1, & - int_ss(ispin)%r_coef(nngau1+1, iso2), 1) + int_ss(ispin)%r_coef(nngau1 + 1, iso2), 1) END DO END DO ! ipfg2 END DO ! ipfg1 - m2 = m2+maxso + m2 = m2 + maxso END DO ! iset2 - m1 = m1+maxso + m1 = m1 + maxso END DO ! iset1 END DO ! ispin @@ -1506,33 +1506,33 @@ SUBROUTINE dgaVtaudgb(vtau_h, vtau_s, qs_kind, rho_atom, nspins) n2 = nsoset(lmax(iset2)) DO ipgf1 = 1, npgf(iset1) - ngau1 = n1*(ipgf1-1)+m1 - size1 = nsoset(lmax(iset1))-nsoset(lmin(iset1)-1) - nngau1 = nsoset(lmin(iset1)-1)+ngau1 + ngau1 = n1*(ipgf1 - 1) + m1 + size1 = nsoset(lmax(iset1)) - nsoset(lmin(iset1) - 1) + nngau1 = nsoset(lmin(iset1) - 1) + ngau1 g1(1:nr) = EXP(-zet(ipgf1, iset1)*grid_atom%rad2(1:nr)) DO ipgf2 = 1, npgf(iset2) - ngau2 = n2*(ipgf2-1)+m2 + ngau2 = n2*(ipgf2 - 1) + m2 g2(1:nr) = EXP(-zet(ipgf2, iset2)*grid_atom%rad2(1:nr)) - lmin12 = lmin(iset1)+lmin(iset2) - lmax12 = lmax(iset1)+lmax(iset2) + lmin12 = lmin(iset1) + lmin(iset2) + lmax12 = lmax(iset1) + lmax(iset2) IF (lmin12 .LE. lmax_expansion) THEN fgr = 0._dp dgr = 0._dp DO l1 = 0, maxl DO l2 = 0, maxl - IF (l1+l2 > lmax_expansion) CYCLE - IF (l1+l2 > 0) THEN - gg(1:nr) = g1(1:nr)*g2(1:nr)*grid_atom%rad2l(1:nr, l1+l2) + IF (l1 + l2 > lmax_expansion) CYCLE + IF (l1 + l2 > 0) THEN + gg(1:nr) = g1(1:nr)*g2(1:nr)*grid_atom%rad2l(1:nr, l1 + l2) ELSE gg(1:nr) = g1(1:nr)*g2(1:nr) END IF - dd(1:nr) = REAL(l1*l2, dp)/grid_atom%rad2(1:nr)- & - 2._dp*REAL(l1, dp)*zet(ipgf2, iset2)- & - 2._dp*REAL(l2, dp)*zet(ipgf1, iset1)+ & + dd(1:nr) = REAL(l1*l2, dp)/grid_atom%rad2(1:nr) - & + 2._dp*REAL(l1, dp)*zet(ipgf2, iset2) - & + 2._dp*REAL(l2, dp)*zet(ipgf1, iset1) + & 4._dp*zet(ipgf1, iset1)*zet(ipgf2, iset2)*grid_atom%rad2(1:nr) fgr(1:nr, l1, l2) = dd(1:nr)*gg(1:nr) - dgr(1:nr, l1+l2) = gg(1:nr)/grid_atom%rad2(1:nr) + dgr(1:nr, l1 + l2) = gg(1:nr)/grid_atom%rad2(1:nr) END DO END DO END IF @@ -1552,17 +1552,17 @@ SUBROUTINE dgaVtaudgb(vtau_h, vtau_s, qs_kind, rho_atom, nspins) isom1 = soset(l1, -mm1) isom2 = soset(l2, -mm2) - IF (l1+l2 > lmax_expansion) CYCLE + IF (l1 + l2 > lmax_expansion) CYCLE - matso_h(iso1, iso2) = matso_h(iso1, iso2)+my_CG(iso1, iso2, iso)* & + matso_h(iso1, iso2) = matso_h(iso1, iso2) + my_CG(iso1, iso2, iso)* & DOT_PRODUCT(vth(1:nr, ispin), fgr(1:nr, l1, l2)) - matso_s(iso1, iso2) = matso_s(iso1, iso2)+my_CG(iso1, iso2, iso)* & + matso_s(iso1, iso2) = matso_s(iso1, iso2) + my_CG(iso1, iso2, iso)* & DOT_PRODUCT(vts(1:nr, ispin), fgr(1:nr, l1, l2)) ! d azimuthal - matso_h(iso1, iso2) = matso_h(iso1, iso2)+REAL(mm1*mm2, dp)*my_CG(isom1, isom2, iso)* & - DOT_PRODUCT(vth(1:nr, ispin), dgr(1:nr, l1+l2)) - matso_s(iso1, iso2) = matso_s(iso1, iso2)+REAL(mm1*mm2, dp)*my_CG(isom1, isom2, iso)* & - DOT_PRODUCT(vts(1:nr, ispin), dgr(1:nr, l1+l2)) + matso_h(iso1, iso2) = matso_h(iso1, iso2) + REAL(mm1*mm2, dp)*my_CG(isom1, isom2, iso)* & + DOT_PRODUCT(vth(1:nr, ispin), dgr(1:nr, l1 + l2)) + matso_s(iso1, iso2) = matso_s(iso1, iso2) + REAL(mm1*mm2, dp)*my_CG(isom1, isom2, iso)* & + DOT_PRODUCT(vts(1:nr, ispin), dgr(1:nr, l1 + l2)) END DO END DO END IF @@ -1574,26 +1574,26 @@ SUBROUTINE dgaVtaudgb(vtau_h, vtau_s, qs_kind, rho_atom, nspins) l1 = indso(1, iso1) l2 = indso(1, iso2) - matso_h(iso1, iso2) = matso_h(iso1, iso2)+my_dCG(iso1, iso2, iso)* & - DOT_PRODUCT(dvth(1:nr, ispin), dgr(1:nr, l1+l2)) - matso_s(iso1, iso2) = matso_s(iso1, iso2)+my_dCG(iso1, iso2, iso)* & - DOT_PRODUCT(dvts(1:nr, ispin), dgr(1:nr, l1+l2)) + matso_h(iso1, iso2) = matso_h(iso1, iso2) + my_dCG(iso1, iso2, iso)* & + DOT_PRODUCT(dvth(1:nr, ispin), dgr(1:nr, l1 + l2)) + matso_s(iso1, iso2) = matso_s(iso1, iso2) + my_dCG(iso1, iso2, iso)* & + DOT_PRODUCT(dvts(1:nr, ispin), dgr(1:nr, l1 + l2)) END DO END DO ! Write in the global matrix - DO ic = nsoset(lmin(iset2)-1)+1, nsoset(lmax(iset2)) - iso1 = nsoset(lmin(iset1)-1)+1 - iso2 = ngau2+ic - CALL daxpy(size1, 1.0_dp, matso_h(iso1, ic), 1, int_hh(ispin)%r_coef(nngau1+1, iso2), 1) - CALL daxpy(size1, 1.0_dp, matso_s(iso1, ic), 1, int_ss(ispin)%r_coef(nngau1+1, iso2), 1) + DO ic = nsoset(lmin(iset2) - 1) + 1, nsoset(lmax(iset2)) + iso1 = nsoset(lmin(iset1) - 1) + 1 + iso2 = ngau2 + ic + CALL daxpy(size1, 1.0_dp, matso_h(iso1, ic), 1, int_hh(ispin)%r_coef(nngau1 + 1, iso2), 1) + CALL daxpy(size1, 1.0_dp, matso_s(iso1, ic), 1, int_ss(ispin)%r_coef(nngau1 + 1, iso2), 1) END DO END DO ! ipfg2 END DO ! ipfg1 - m2 = m2+maxso + m2 = m2 + maxso END DO ! iset2 - m1 = m1+maxso + m1 = m1 + maxso END DO ! iset1 DEALLOCATE (vth, vts, dvth, dvts) END DO ! ispin diff --git a/src/qs_wannier90.F b/src/qs_wannier90.F index 4613e53b40..4766cb675d 100644 --- a/src/qs_wannier90.F +++ b/src/qs_wannier90.F @@ -219,15 +219,15 @@ SUBROUTINE wannier90_files(qs_env, input, iw) nexcl = 0 DO i_rep = 1, n_rep CALL section_vals_val_get(input, "EXCLUDE_BANDS", i_rep_val=i_rep, i_vals=invals) - nexcl = nexcl+SIZE(invals) + nexcl = nexcl + SIZE(invals) END DO IF (nexcl > 0) THEN ALLOCATE (exclude_bands(nexcl)) nexcl = 0 DO i_rep = 1, n_rep CALL section_vals_val_get(input, "EXCLUDE_BANDS", i_rep_val=i_rep, i_vals=invals) - exclude_bands(nexcl+1:nexcl+SIZE(invals)) = invals(:) - nexcl = nexcl+SIZE(invals) + exclude_bands(nexcl + 1:nexcl + SIZE(invals)) = invals(:) + nexcl = nexcl + SIZE(invals) END DO END IF ! @@ -250,10 +250,10 @@ SUBROUTINE wannier90_files(qs_env, input, iw) kpoint%use_real_wfn = .FALSE. kpoint%parallel_group_size = 0 i = 0 - DO ix = 0, mp_grid(1)-1 - DO iy = 0, mp_grid(2)-1 - DO iz = 0, mp_grid(3)-1 - i = i+1 + DO ix = 0, mp_grid(1) - 1 + DO iy = 0, mp_grid(2) - 1 + DO iz = 0, mp_grid(3) - 1 + i = i + 1 kpt_latt(1, i) = REAL(ix, KIND=dp)/REAL(mp_grid(1), KIND=dp) kpt_latt(2, i) = REAL(iy, KIND=dp)/REAL(mp_grid(2), KIND=dp) kpt_latt(3, i) = REAL(iz, KIND=dp)/REAL(mp_grid(3), KIND=dp) @@ -269,7 +269,7 @@ SUBROUTINE wannier90_files(qs_env, input, iw) ! number of bands in calculation CALL get_qs_env(qs_env, mos=mos) CALL get_mo_set(mo_set=mos(1)%mo_set, nao=nao, nmo=num_bands_tot) - num_bands_tot = MIN(nao, num_bands_tot+nadd) + num_bands_tot = MIN(nao, num_bands_tot + nadd) num_bands = num_wann num_atoms = SIZE(particle_set) ALLOCATE (atoms_cart(3, num_atoms)) @@ -360,7 +360,7 @@ SUBROUTINE wannier90_files(qs_env, input, iw) DO ik = 1, SIZE(kpoint%kp_env) CALL mpools_get(kpoint%mpools, ao_mo_fm_pools=ao_mo_fm_pools) moskp => kpoint%kp_env(ik)%kpoint_env%mos - ikk = kpoint%kp_range(1)+ik-1 + ikk = kpoint%kp_range(1) + ik - 1 CPASSERT(ASSOCIATED(moskp)) DO ispin = 1, SIZE(moskp, 2) DO ic = 1, SIZE(moskp, 1) @@ -403,14 +403,14 @@ SUBROUTINE wannier90_files(qs_env, input, iw) nbs = 0 DO ik = 1, num_kpts DO i = 1, nntot - bvec(1:3) = kpt_latt(1:3, nnlist(ik, i))-kpt_latt(1:3, ik)+nncell(1:3, ik, i) + bvec(1:3) = kpt_latt(1:3, nnlist(ik, i)) - kpt_latt(1:3, ik) + nncell(1:3, ik, i) ibs = 0 DO k = 1, nbs - IF (SUM(ABS(bvec(1:3)-b_latt(1:3, k))) < 1.e-6_dp) THEN + IF (SUM(ABS(bvec(1:3) - b_latt(1:3, k))) < 1.e-6_dp) THEN ibs = k EXIT END IF - IF (SUM(ABS(bvec(1:3)+b_latt(1:3, k))) < 1.e-6_dp) THEN + IF (SUM(ABS(bvec(1:3) + b_latt(1:3, k))) < 1.e-6_dp) THEN ibs = -k EXIT END IF @@ -420,7 +420,7 @@ SUBROUTINE wannier90_files(qs_env, input, iw) nblist(ik, i) = ibs ELSE ! new lattice vector - nbs = nbs+1 + nbs = nbs + 1 b_latt(1:3, nbs) = bvec(1:3) nblist(ik, i) = nbs END IF @@ -475,7 +475,7 @@ SUBROUTINE wannier90_files(qs_env, input, iw) ! get the MO coefficients for this k-point my_kpgrp = (ik >= kpoint%kp_range(1) .AND. ik <= kpoint%kp_range(2)) IF (my_kpgrp) THEN - ikk = ik-kpoint%kp_range(1)+1 + ikk = ik - kpoint%kp_range(1) + 1 kp => kpoint%kp_env(ikk)%kpoint_env CPASSERT(SIZE(kp%mos, 1) == 2) fmr => kp%mos(1, ispin)%mo_set%mo_coeff @@ -493,7 +493,7 @@ SUBROUTINE wannier90_files(qs_env, input, iw) ik2 = nnlist(ik, i) mygrp = (ik2 >= kpoint%kp_range(1) .AND. ik2 <= kpoint%kp_range(2)) IF (mygrp) THEN - ikk = ik2-kpoint%kp_range(1)+1 + ikk = ik2 - kpoint%kp_range(1) + 1 kp => kpoint%kp_env(ikk)%kpoint_env CPASSERT(SIZE(kp%mos, 1) == 2) fmr => kp%mos(1, ispin)%mo_set%mo_coeff @@ -591,7 +591,7 @@ SUBROUTINE wannier90_files(qs_env, input, iw) my_kpgrp = (ik >= kp_range(1) .AND. ik <= kp_range(2)) DO ispin = 1, nspins IF (my_kpgrp) THEN - ikpgr = ik-kp_range(1)+1 + ikpgr = ik - kp_range(1) + 1 kp => kpoint%kp_env(ikpgr)%kpoint_env CALL get_mo_set(kp%mos(1, ispin)%mo_set, eigenvalues=eigenvalues) eigval(1:nmo) = eigenvalues(1:nmo) diff --git a/src/qs_wf_history_methods.F b/src/qs_wf_history_methods.F index 9dcfbaba0d..3d184090d8 100644 --- a/src/qs_wf_history_methods.F +++ b/src/qs_wf_history_methods.F @@ -119,7 +119,7 @@ SUBROUTINE wfs_create(snapshot) CHARACTER(len=*), PARAMETER :: routineN = 'wfs_create', routineP = moduleN//':'//routineN ALLOCATE (snapshot) - last_wfs_id = last_wfs_id+1 + last_wfs_id = last_wfs_id + 1 snapshot%id_nr = last_wfs_id NULLIFY (snapshot%wf, snapshot%rho_r, & snapshot%rho_g, snapshot%rho_ao, snapshot%rho_ao_kp, & @@ -318,7 +318,7 @@ SUBROUTINE wfi_create(wf_history, interpolation_method_nr, extrapolation_order, CALL timeset(routineN, handle) ALLOCATE (wf_history) - last_wfi_id = last_wfi_id+1 + last_wfi_id = last_wfi_id + 1 wf_history%id_nr = last_wfi_id wf_history%ref_count = 1 wf_history%memory_depth = 0 @@ -358,14 +358,14 @@ SUBROUTINE wfi_create(wf_history, interpolation_method_nr, extrapolation_order, IF (.NOT. has_unit_metric) wf_history%store_overlap = .TRUE. CASE (wfi_ps_method_nr) CALL cite_reference(VandeVondele2005a) - wf_history%memory_depth = extrapolation_order+1 + wf_history%memory_depth = extrapolation_order + 1 wf_history%store_wf = .TRUE. IF (.NOT. has_unit_metric) wf_history%store_overlap = .TRUE. CASE (wfi_frozen_method_nr) wf_history%memory_depth = 1 wf_history%store_frozen_density = .TRUE. CASE (wfi_aspc_nr) - wf_history%memory_depth = extrapolation_order+2 + wf_history%memory_depth = extrapolation_order + 2 wf_history%store_wf = .TRUE. IF (.NOT. has_unit_metric) wf_history%store_overlap = .TRUE. CASE default @@ -670,7 +670,7 @@ SUBROUTINE wfi_extrapolate(wf_history, qs_env, dt, extrapolation_method_nr, & my_orthogonal_wf = .TRUE. t0 = 0.0_dp t1 = t1_state%dt - t2 = t1+dt + t2 = t1 + dt CALL qs_rho_get(rho, rho_ao=rho_ao) DO ispin = 1, SIZE(mos) CALL get_mo_set(mos(ispin)%mo_set, mo_coeff=mo_coeff, & @@ -678,11 +678,11 @@ SUBROUTINE wfi_extrapolate(wf_history, qs_env, dt, extrapolation_method_nr, & CALL cp_fm_scale_and_add(alpha=0.0_dp, & matrix_a=mo_coeff, & matrix_b=t1_state%wf(ispin)%matrix, & - beta=(t2-t0)/(t1-t0)) + beta=(t2 - t0)/(t1 - t0)) ! this copy should be unnecessary CALL cp_fm_scale_and_add(alpha=1.0_dp, & matrix_a=mo_coeff, & - beta=(t1-t2)/(t1-t0), matrix_b=t0_state%wf(ispin)%matrix) + beta=(t1 - t2)/(t1 - t0), matrix_b=t0_state%wf(ispin)%matrix) CALL reorthogonalize_vectors(qs_env, & v_matrix=mo_coeff, & n_col=nmo) @@ -710,7 +710,7 @@ SUBROUTINE wfi_extrapolate(wf_history, qs_env, dt, extrapolation_method_nr, & t0 = 0.0_dp t1 = t1_state%dt - t2 = t1+dt + t2 = t1 + dt IF (do_kpoints) THEN CALL qs_rho_get(rho, rho_ao_kp=rho_ao_kp) DO ispin = 1, SIZE(rho_ao_kp, 1) @@ -720,9 +720,9 @@ SUBROUTINE wfi_extrapolate(wf_history, qs_env, dt, extrapolation_method_nr, & CPWARN("Change in cell neighborlist: might affect quality of initial guess") ELSE CALL dbcsr_add(rho_ao_kp(ispin, img)%matrix, t1_state%rho_ao_kp(ispin, img)%matrix, & - alpha_scalar=0.0_dp, beta_scalar=(t2-t0)/(t1-t0)) ! this copy should be unnecessary + alpha_scalar=0.0_dp, beta_scalar=(t2 - t0)/(t1 - t0)) ! this copy should be unnecessary CALL dbcsr_add(rho_ao_kp(ispin, img)%matrix, t0_state%rho_ao_kp(ispin, img)%matrix, & - alpha_scalar=1.0_dp, beta_scalar=(t1-t2)/(t1-t0)) + alpha_scalar=1.0_dp, beta_scalar=(t1 - t2)/(t1 - t0)) END IF END DO END DO @@ -730,9 +730,9 @@ SUBROUTINE wfi_extrapolate(wf_history, qs_env, dt, extrapolation_method_nr, & CALL qs_rho_get(rho, rho_ao=rho_ao) DO ispin = 1, SIZE(rho_ao) CALL dbcsr_add(rho_ao(ispin)%matrix, t1_state%rho_ao(ispin)%matrix, & - alpha_scalar=0.0_dp, beta_scalar=(t2-t0)/(t1-t0)) ! this copy should be unnecessary + alpha_scalar=0.0_dp, beta_scalar=(t2 - t0)/(t1 - t0)) ! this copy should be unnecessary CALL dbcsr_add(rho_ao(ispin)%matrix, t0_state%rho_ao(ispin)%matrix, & - alpha_scalar=1.0_dp, beta_scalar=(t1-t2)/(t1-t0)) + alpha_scalar=1.0_dp, beta_scalar=(t1 - t2)/(t1 - t0)) END DO END IF CALL qs_rho_update_rho(rho, qs_env=qs_env) @@ -843,7 +843,7 @@ SUBROUTINE wfi_extrapolate(wf_history, qs_env, dt, extrapolation_method_nr, & t1_state%wf(ispin)%matrix, 0.0_dp, csc) END IF CALL cp_gemm('N', 'N', n, k, k, 1.0_dp, t0_state%wf(ispin)%matrix, csc, 0.0_dp, fm_tmp) - alpha = -1.0_dp*alpha*REAL(nvec-i+1, dp)/REAL(i, dp) + alpha = -1.0_dp*alpha*REAL(nvec - i + 1, dp)/REAL(i, dp) CALL cp_fm_scale_and_add(1.0_dp, mo_coeff, alpha, fm_tmp) ENDDO @@ -898,11 +898,11 @@ SUBROUTINE wfi_extrapolate(wf_history, qs_env, dt, extrapolation_method_nr, & t1_state => wfi_get_snapshot(wf_history, & wf_index=1) CALL cp_fm_to_fm(t1_state%wf(ispin)%matrix, mo_coeff) - alpha = REAL(4*nvec-2, KIND=dp)/REAL(nvec+1, KIND=dp) + alpha = REAL(4*nvec - 2, KIND=dp)/REAL(nvec + 1, KIND=dp) IF ((io_unit > 0) .AND. (print_level > low_print_level)) THEN WRITE (UNIT=io_unit, FMT="(/,T2,A,/,/,T3,A,I0,/,/,T3,A2,I0,A4,F10.6)") & "Parameters for the always stable predictor-corrector (ASPC) method:", & - "ASPC order: ", MAX(nvec-2, 0), & + "ASPC order: ", MAX(nvec - 2, 0), & "B(", 1, ") = ", alpha END IF CALL cp_fm_scale(alpha, mo_coeff) @@ -917,8 +917,8 @@ SUBROUTINE wfi_extrapolate(wf_history, qs_env, dt, extrapolation_method_nr, & t1_state%wf(ispin)%matrix, 0.0_dp, csc) END IF CALL cp_gemm('N', 'N', n, k, k, 1.0_dp, t0_state%wf(ispin)%matrix, csc, 0.0_dp, fm_tmp) - alpha = (-1.0_dp)**(i+1)*REAL(i, KIND=dp)* & - binomial(2*nvec, nvec-i)/binomial(2*nvec-2, nvec-1) + alpha = (-1.0_dp)**(i + 1)*REAL(i, KIND=dp)* & + binomial(2*nvec, nvec - i)/binomial(2*nvec - 2, nvec - 1) IF ((io_unit > 0) .AND. (print_level > low_print_level)) THEN WRITE (UNIT=io_unit, FMT="(T3,A2,I0,A4,F10.6)") & "B(", i, ") = ", alpha @@ -1009,10 +1009,10 @@ SUBROUTINE wfi_update(wf_history, qs_env, dt) CPASSERT(ASSOCIATED(qs_env)) CPASSERT(qs_env%ref_count > 0) - wf_history%snapshot_count = wf_history%snapshot_count+1 + wf_history%snapshot_count = wf_history%snapshot_count + 1 IF (wf_history%memory_depth > 0) THEN wf_history%last_state_index = MODULO(wf_history%snapshot_count, & - wf_history%memory_depth)+1 + wf_history%memory_depth) + 1 CALL wfs_update(snapshot=wf_history%past_states & (wf_history%last_state_index)%snapshot, wf_history=wf_history, & qs_env=qs_env, dt=dt) diff --git a/src/qs_wf_history_types.F b/src/qs_wf_history_types.F index 70829ad0aa..11080747df 100644 --- a/src/qs_wf_history_types.F +++ b/src/qs_wf_history_types.F @@ -132,7 +132,7 @@ SUBROUTINE wfs_release(snapshot) IF (ASSOCIATED(snapshot)) THEN CPASSERT(snapshot%ref_count > 0) - snapshot%ref_count = snapshot%ref_count-1 + snapshot%ref_count = snapshot%ref_count - 1 IF (snapshot%ref_count == 0) THEN IF (ASSOCIATED(snapshot%wf)) THEN DO i = 1, SIZE(snapshot%wf) @@ -173,7 +173,7 @@ SUBROUTINE wfi_retain(wf_history) CHARACTER(len=*), PARAMETER :: routineN = 'wfi_retain', routineP = moduleN//':'//routineN CPASSERT(ASSOCIATED(wf_history)) - wf_history%ref_count = wf_history%ref_count+1 + wf_history%ref_count = wf_history%ref_count + 1 END SUBROUTINE wfi_retain @@ -194,7 +194,7 @@ SUBROUTINE wfi_release(wf_history) IF (ASSOCIATED(wf_history)) THEN CPASSERT(wf_history%ref_count > 0) - wf_history%ref_count = wf_history%ref_count-1 + wf_history%ref_count = wf_history%ref_count - 1 IF (wf_history%ref_count == 0) THEN IF (ASSOCIATED(wf_history%past_states)) THEN DO i = 1, SIZE(wf_history%past_states) @@ -233,8 +233,8 @@ FUNCTION wfi_get_snapshot(wf_history, wf_index) RESULT(res) CPABORT("") END IF res => wf_history%past_states( & - MODULO(wf_history%snapshot_count+1-wf_index, & - wf_history%memory_depth)+1)%snapshot + MODULO(wf_history%snapshot_count + 1 - wf_index, & + wf_history%memory_depth) + 1)%snapshot END FUNCTION wfi_get_snapshot END MODULE qs_wf_history_types diff --git a/src/rel_control_types.F b/src/rel_control_types.F index 22cba5ace7..56c3858870 100644 --- a/src/rel_control_types.F +++ b/src/rel_control_types.F @@ -108,7 +108,7 @@ SUBROUTINE rel_c_retain(rel_control) CPASSERT(ASSOCIATED(rel_control)) CPASSERT(rel_control%ref_count > 0) - rel_control%ref_count = rel_control%ref_count+1 + rel_control%ref_count = rel_control%ref_count + 1 END SUBROUTINE rel_c_retain @@ -130,7 +130,7 @@ SUBROUTINE rel_c_release(rel_control) IF (ASSOCIATED(rel_control)) THEN CPASSERT(rel_control%ref_count > 0) - rel_control%ref_count = rel_control%ref_count-1 + rel_control%ref_count = rel_control%ref_count - 1 IF (rel_control%ref_count < 1) THEN DEALLOCATE (rel_control) END IF diff --git a/src/replica_methods.F b/src/replica_methods.F index 633e57846c..a39d5e9a4e 100644 --- a/src/replica_methods.F +++ b/src/replica_methods.F @@ -123,29 +123,29 @@ SUBROUTINE rep_env_create(rep_env, para_env, input, input_declaration, nrep, pre IF (row_force) forcedim = 2 END IF my_prep = MIN(prep, para_env%num_pe) - dims(3-forcedim) = MIN(para_env%num_pe/my_prep, nrep) + dims(3 - forcedim) = MIN(para_env%num_pe/my_prep, nrep) dims(forcedim) = my_prep IF ((dims(1)*dims(2) /= para_env%num_pe) .AND. (unit_nr > 0)) THEN WRITE (unit_nr, FMT="(T2,A)") "REPLICA| WARNING: number of processors is not divisible by the number of replicas" - WRITE (unit_nr, FMT="(T2,A,I0,A)") "REPLICA| ", para_env%num_pe-dims(1)*dims(2), " MPI process(es) will be idle" + WRITE (unit_nr, FMT="(T2,A,I0,A)") "REPLICA| ", para_env%num_pe - dims(1)*dims(2), " MPI process(es) will be idle" END IF CALL mp_cart_create(comm_old=para_env%group, ndims=2, dims=dims, pos=pos, comm_cart=comm_cart) IF (comm_cart /= mp_comm_null) THEN CALL cp_cart_create(cart, comm_cart, ndims=2, owns_group=.TRUE.) NULLIFY (para_env_full) CALL cp_para_env_create(para_env_full, comm_cart, owns_group=.FALSE.) - rdim(3-forcedim) = .FALSE. + rdim(3 - forcedim) = .FALSE. rdim(forcedim) = .TRUE. CALL mp_cart_sub(comm=comm_cart, rdim=rdim, sub_comm=comm_f) CALL cp_para_env_create(para_env_f, comm_f, owns_group=.TRUE.) - rdim(3-forcedim) = .TRUE. + rdim(3 - forcedim) = .TRUE. rdim(forcedim) = .FALSE. CALL mp_cart_sub(comm=comm_cart, rdim=rdim, sub_comm=comm_inter_rep) CALL cp_para_env_create(para_env_inter_rep, comm_inter_rep, & owns_group=.TRUE.) ALLOCATE (rep_env) END IF - ALLOCATE (gridinfo(2, 0:para_env%num_pe-1)) + ALLOCATE (gridinfo(2, 0:para_env%num_pe - 1)) gridinfo = 0 gridinfo(:, para_env%mepos) = pos CALL mp_sum(gridinfo, para_env%group) @@ -153,17 +153,17 @@ SUBROUTINE rep_env_create(rep_env, para_env, input, input_declaration, nrep, pre WRITE (unit_nr, FMT="(T2,A,T71,I10)") "REPLICA| layout of the replica grid, number of groups ", para_env_inter_rep%num_pe WRITE (unit_nr, FMT="(T2,A,T71,I10)") "REPLICA| layout of the replica grid, size of each group", para_env_f%num_pe WRITE (unit_nr, FMT="(T2,A)", ADVANCE="NO") "REPLICA| MPI process to grid (group,rank) correspondence:" - DO i = 0, para_env%num_pe-1 + DO i = 0, para_env%num_pe - 1 IF (MODULO(i, 4) == 0) WRITE (unit_nr, *) WRITE (unit_nr, FMT='(A3,I4,A3,I4,A1,I4,A1)', ADVANCE="NO") & - " (", i, " : ", gridinfo(3-forcedim, i), ",", & + " (", i, " : ", gridinfo(3 - forcedim, i), ",", & gridinfo(forcedim, i), ")" END DO WRITE (unit_nr, *) ENDIF DEALLOCATE (gridinfo) IF (ASSOCIATED(rep_env)) THEN - last_rep_env_id = last_rep_env_id+1 + last_rep_env_id = last_rep_env_id + 1 rep_env%id_nr = last_rep_env_id rep_env%ref_count = 1 rep_env%nrep = nrep @@ -175,9 +175,9 @@ SUBROUTINE rep_env_create(rep_env, para_env, input, input_declaration, nrep, pre NULLIFY (rep_env%results) rep_env%force_dim = forcedim - rep_env%my_rep_group = cart%mepos(3-forcedim) - ALLOCATE (rep_env%inter_rep_rank(0:para_env_inter_rep%num_pe-1), & - rep_env%force_rank(0:para_env_f%num_pe-1)) + rep_env%my_rep_group = cart%mepos(3 - forcedim) + ALLOCATE (rep_env%inter_rep_rank(0:para_env_inter_rep%num_pe - 1), & + rep_env%force_rank(0:para_env_f%num_pe - 1)) rep_env%inter_rep_rank = 0 rep_env%inter_rep_rank(rep_env%my_rep_group) = para_env_inter_rep%mepos CALL mp_sum(rep_env%inter_rep_rank, para_env_inter_rep%group) @@ -192,8 +192,8 @@ SUBROUTINE rep_env_create(rep_env, para_env, input, input_declaration, nrep, pre ! with the structure PROJECT_NAME-r-N where N is the ! number of the local replica.. lp = LEN_TRIM(input_file_path) - input_file_path(lp+1:LEN(input_file_path)) = "-r-"// & - ADJUSTL(cp_to_string(rep_env%my_rep_group)) + input_file_path(lp + 1:LEN(input_file_path)) = "-r-"// & + ADJUSTL(cp_to_string(rep_env%my_rep_group)) lp = LEN_TRIM(input_file_path) ! Setup new project name CALL section_vals_val_set(input, "GLOBAL%PROJECT_NAME", & @@ -205,7 +205,7 @@ SUBROUTINE rep_env_create(rep_env, para_env, input, input_declaration, nrep, pre ! Dump an input file to warm-up new force_eval structures and ! delete them immediately afterwards.. - input_file_path(lp+1:LEN(input_file_path)) = ".inp" + input_file_path(lp + 1:LEN(input_file_path)) = ".inp" IF (para_env_f%ionode) THEN CALL open_file(file_name=TRIM(input_file_path), file_status="UNKNOWN", & file_form="FORMATTED", file_action="WRITE", & @@ -233,21 +233,21 @@ SUBROUTINE rep_env_create(rep_env, para_env, input, input_declaration, nrep, pre i0 = nrep/para_env_inter_rep%num_pe ir = MODULO(nrep, para_env_inter_rep%num_pe) - DO ip = 0, para_env_inter_rep%num_pe-1 - DO i = i0*ip+MIN(ip, ir)+1, i0*(ip+1)+MIN(ip+1, ir) + DO ip = 0, para_env_inter_rep%num_pe - 1 + DO i = i0*ip + MIN(ip, ir) + 1, i0*(ip + 1) + MIN(ip + 1, ir) rep_env%replica_owner(i) = ip END DO END DO nrep_local = i0 - IF (rep_env%my_rep_group < ir) nrep_local = nrep_local+1 + IF (rep_env%my_rep_group < ir) nrep_local = nrep_local + 1 ALLOCATE (rep_env%local_rep_indices(nrep_local), & rep_env%rep_is_local(nrep)) nrep_local = 0 rep_env%rep_is_local = .FALSE. DO irep = 1, nrep IF (rep_env%replica_owner(irep) == rep_env%my_rep_group) THEN - nrep_local = nrep_local+1 + nrep_local = nrep_local + 1 rep_env%local_rep_indices(nrep_local) = irep rep_env%rep_is_local(irep) = .TRUE. END IF @@ -260,7 +260,7 @@ SUBROUTINE rep_env_create(rep_env, para_env, input, input_declaration, nrep, pre rep_env%para_env_inter_rep => para_env_inter_rep ALLOCATE (rep_env%r(rep_env%ndim, nrep), rep_env%v(rep_env%ndim, nrep), & - rep_env%f(rep_env%ndim+1, nrep)) + rep_env%f(rep_env%ndim + 1, nrep)) rep_env%r = 0._dp rep_env%f = 0._dp @@ -485,7 +485,7 @@ SUBROUTINE rep_env_calc_e_f_int(rep_env, calc_f) CALL f_env_rm_defaults(f_env, ierr) CPASSERT(ierr == 0) CALL calc_force(rep_env%f_env_id, rep_env%r(:, irep), ndim, & - rep_env%f(ndim+1, irep), rep_env%f(:ndim, irep), & + rep_env%f(ndim + 1, irep), rep_env%f(:ndim, irep), & my_calc_f, ierr) CPASSERT(ierr == 0) END DO diff --git a/src/replica_types.F b/src/replica_types.F index 89c5e079b8..eb199545ad 100644 --- a/src/replica_types.F +++ b/src/replica_types.F @@ -144,7 +144,7 @@ SUBROUTINE rep_env_release(rep_env) CALL timeset(routineN, handle) IF (ASSOCIATED(rep_env)) THEN CPASSERT(rep_env%ref_count > 0) - rep_env%ref_count = rep_env%ref_count-1 + rep_env%ref_count = rep_env%ref_count - 1 IF (rep_env%ref_count == 0) THEN CALL rep_env_destroy_low(rep_env%id_nr, ierr) IF (rep_env%f_env_id > 0) THEN @@ -335,7 +335,7 @@ SUBROUTINE rep_envs_add_rep_env(rep_env) IF (.NOT. ASSOCIATED(rep_envs)) THEN ALLOCATE (rep_envs(1)) ELSE - ALLOCATE (new_rep_envs(SIZE(rep_envs)+1)) + ALLOCATE (new_rep_envs(SIZE(rep_envs) + 1)) DO i = 1, SIZE(rep_envs) new_rep_envs(i)%rep_env => rep_envs(i)%rep_env END DO @@ -367,11 +367,11 @@ SUBROUTINE rep_envs_rm_rep_env(rep_env) IF (ASSOCIATED(rep_env)) THEN CPASSERT(module_initialized) - ALLOCATE (new_rep_envs(SIZE(rep_envs)-1)) + ALLOCATE (new_rep_envs(SIZE(rep_envs) - 1)) ii = 0 DO i = 1, SIZE(rep_envs) IF (rep_envs(i)%rep_env%id_nr /= rep_env%id_nr) THEN - ii = ii+1 + ii = ii + 1 new_rep_envs(ii)%rep_env => rep_envs(i)%rep_env END IF END DO diff --git a/src/restraint.F b/src/restraint.F index c4768c4a2c..6a0098670a 100644 --- a/src/restraint.F +++ b/src/restraint.F @@ -123,35 +123,35 @@ SUBROUTINE restraint_control(force_env) molecule_kind => molecule_kind_set(ikind) CALL get_molecule_kind(molecule_kind, fixd_list=fixd_list) IF (fixd_list(ii)%restraint%active) THEN - n_restraint = n_restraint+1 + n_restraint = n_restraint + 1 iparticle = fixd_list(ii)%fixd k0 = fixd_list(ii)%restraint%k0 targ = fixd_list(ii)%coord rab = 0.0_dp - SELECT CASE (fixd_list (ii)%itype) + SELECT CASE (fixd_list(ii)%itype) CASE (use_perd_x) - rab(1) = particle_set(iparticle)%r(1)-targ(1) + rab(1) = particle_set(iparticle)%r(1) - targ(1) CASE (use_perd_y) - rab(2) = particle_set(iparticle)%r(2)-targ(2) + rab(2) = particle_set(iparticle)%r(2) - targ(2) CASE (use_perd_z) - rab(3) = particle_set(iparticle)%r(3)-targ(3) + rab(3) = particle_set(iparticle)%r(3) - targ(3) CASE (use_perd_xy) - rab(1) = particle_set(iparticle)%r(1)-targ(1) - rab(2) = particle_set(iparticle)%r(2)-targ(2) + rab(1) = particle_set(iparticle)%r(1) - targ(1) + rab(2) = particle_set(iparticle)%r(2) - targ(2) CASE (use_perd_xz) - rab(1) = particle_set(iparticle)%r(1)-targ(1) - rab(3) = particle_set(iparticle)%r(3)-targ(3) + rab(1) = particle_set(iparticle)%r(1) - targ(1) + rab(3) = particle_set(iparticle)%r(3) - targ(3) CASE (use_perd_yz) - rab(2) = particle_set(iparticle)%r(2)-targ(2) - rab(3) = particle_set(iparticle)%r(3)-targ(3) + rab(2) = particle_set(iparticle)%r(2) - targ(2) + rab(3) = particle_set(iparticle)%r(3) - targ(3) CASE (use_perd_xyz) - rab = particle_set(iparticle)%r-targ + rab = particle_set(iparticle)%r - targ END SELECT rab2 = DOT_PRODUCT(rab, rab) ! Energy - energy_fixd = energy_fixd+k0*rab2 + energy_fixd = energy_fixd + k0*rab2 ! Forces - force(:, iparticle) = force(:, iparticle)-2.0_dp*k0*rab + force(:, iparticle) = force(:, iparticle) - 2.0_dp*k0*rab END IF END DO CALL release_local_fixd_list(lfixd_list) @@ -171,17 +171,17 @@ SUBROUTINE restraint_control(force_env) ng4x6_restraint=n4x6con_restraint) ! 3x3 IF (n3x3con_restraint /= 0) THEN - n_restraint = n_restraint+n3x3con_restraint + n_restraint = n_restraint + n3x3con_restraint CALL restraint_3x3_int(molecule, particle_set, energy_3x3, force) ENDIF ! 4x6 IF (n4x6con_restraint /= 0) THEN - n_restraint = n_restraint+n4x6con_restraint + n_restraint = n_restraint + n4x6con_restraint CALL restraint_4x6_int(molecule, particle_set, energy_4x6, force) ENDIF ! collective variables IF (ncolv%nrestraint /= 0) THEN - n_restraint = n_restraint+ncolv%nrestraint + n_restraint = n_restraint + ncolv%nrestraint CALL restraint_colv_int(molecule, particle_set, cell, energy_colv, force) ENDIF END DO @@ -201,21 +201,21 @@ SUBROUTINE restraint_control(force_env) IF (gci%nrestraint > 0) THEN ! 3x3 IF (gci%ng3x3_restraint /= 0) THEN - n_restraint = n_restraint+gci%ng3x3_restraint + n_restraint = n_restraint + gci%ng3x3_restraint CALL restraint_3x3_ext(gci, particle_set, energy_3x3, force) ENDIF ! 4x6 IF (gci%ng4x6_restraint /= 0) THEN - n_restraint = n_restraint+gci%ng4x6_restraint + n_restraint = n_restraint + gci%ng4x6_restraint CALL restraint_4x6_ext(gci, particle_set, energy_4x6, force) ENDIF ! collective variables IF (gci%ncolv%nrestraint /= 0) THEN - n_restraint = n_restraint+gci%ncolv%nrestraint + n_restraint = n_restraint + gci%ncolv%nrestraint CALL restraint_colv_ext(gci, particle_set, cell, energy_colv, force) ENDIF DO iparticle = 1, SIZE(particle_set) - particle_set(iparticle)%f = particle_set(iparticle)%f+force(:, iparticle) + particle_set(iparticle)%f = particle_set(iparticle)%f + force(:, iparticle) END DO END IF END IF @@ -223,9 +223,9 @@ SUBROUTINE restraint_control(force_env) ! Store restraint energies CALL force_env_get(force_env=force_env, additional_potential=extended_energies) - extended_energies = extended_energies+energy_3x3+ & - energy_fixd+ & - energy_4x6+ & + extended_energies = extended_energies + energy_3x3 + & + energy_fixd + & + energy_4x6 + & energy_colv CALL force_env_set(force_env=force_env, additional_potential=extended_energies) CALL timestop(handle) @@ -456,26 +456,26 @@ SUBROUTINE restraint_3x3_low(ng3x3, g3x3_list, fixd_list, first_atom, & DO iconst = 1, ng3x3 IF (.NOT. g3x3_list(iconst)%restraint%active) CYCLE - index_a = g3x3_list(iconst)%a+first_atom-1 - index_b = g3x3_list(iconst)%b+first_atom-1 - index_c = g3x3_list(iconst)%c+first_atom-1 - r0_12(:) = particle_set(index_a)%r-particle_set(index_b)%r - r0_13(:) = particle_set(index_a)%r-particle_set(index_c)%r - r0_23(:) = particle_set(index_b)%r-particle_set(index_c)%r + index_a = g3x3_list(iconst)%a + first_atom - 1 + index_b = g3x3_list(iconst)%b + first_atom - 1 + index_c = g3x3_list(iconst)%c + first_atom - 1 + r0_12(:) = particle_set(index_a)%r - particle_set(index_b)%r + r0_13(:) = particle_set(index_a)%r - particle_set(index_c)%r + r0_23(:) = particle_set(index_b)%r - particle_set(index_c)%r rab = SQRT(DOT_PRODUCT(r0_12, r0_12)) rac = SQRT(DOT_PRODUCT(r0_13, r0_13)) rbc = SQRT(DOT_PRODUCT(r0_23, r0_23)) - tab = rab-g3x3_list(ng3x3)%dab - tac = rac-g3x3_list(ng3x3)%dac - tbc = rbc-g3x3_list(ng3x3)%dbc + tab = rab - g3x3_list(ng3x3)%dab + tac = rac - g3x3_list(ng3x3)%dac + tbc = rbc - g3x3_list(ng3x3)%dbc k = g3x3_list(iconst)%restraint%k0 ! Update Energy - energy = energy+k*(tab**2+tac**2+tbc**2) + energy = energy + k*(tab**2 + tac**2 + tbc**2) ! Update Forces - force(:, index_a) = force(:, index_a)-2.0_dp*k*(r0_12/rab*tab+r0_13/rac*tac) - force(:, index_b) = force(:, index_b)-2.0_dp*k*(-r0_12/rab*tab+r0_23/rbc*tbc) - force(:, index_c) = force(:, index_c)-2.0_dp*k*(-r0_13/rac*tac-r0_23/rbc*tbc) + force(:, index_a) = force(:, index_a) - 2.0_dp*k*(r0_12/rab*tab + r0_13/rac*tac) + force(:, index_b) = force(:, index_b) - 2.0_dp*k*(-r0_12/rab*tab + r0_23/rbc*tbc) + force(:, index_c) = force(:, index_c) - 2.0_dp*k*(-r0_13/rac*tac - r0_23/rbc*tbc) ! Fixed atoms IF (ASSOCIATED(fixd_list)) THEN IF (SIZE(fixd_list) > 0) THEN @@ -521,16 +521,16 @@ SUBROUTINE restraint_4x6_low(ng4x6, g4x6_list, fixd_list, first_atom, & DO iconst = 1, ng4x6 IF (.NOT. g4x6_list(iconst)%restraint%active) CYCLE - index_a = g4x6_list(iconst)%a+first_atom-1 - index_b = g4x6_list(iconst)%b+first_atom-1 - index_c = g4x6_list(iconst)%c+first_atom-1 - index_d = g4x6_list(iconst)%d+first_atom-1 - r0_12(:) = particle_set(index_a)%r-particle_set(index_b)%r - r0_13(:) = particle_set(index_a)%r-particle_set(index_c)%r - r0_14(:) = particle_set(index_a)%r-particle_set(index_d)%r - r0_23(:) = particle_set(index_b)%r-particle_set(index_c)%r - r0_24(:) = particle_set(index_b)%r-particle_set(index_d)%r - r0_34(:) = particle_set(index_c)%r-particle_set(index_d)%r + index_a = g4x6_list(iconst)%a + first_atom - 1 + index_b = g4x6_list(iconst)%b + first_atom - 1 + index_c = g4x6_list(iconst)%c + first_atom - 1 + index_d = g4x6_list(iconst)%d + first_atom - 1 + r0_12(:) = particle_set(index_a)%r - particle_set(index_b)%r + r0_13(:) = particle_set(index_a)%r - particle_set(index_c)%r + r0_14(:) = particle_set(index_a)%r - particle_set(index_d)%r + r0_23(:) = particle_set(index_b)%r - particle_set(index_c)%r + r0_24(:) = particle_set(index_b)%r - particle_set(index_d)%r + r0_34(:) = particle_set(index_c)%r - particle_set(index_d)%r rab = SQRT(DOT_PRODUCT(r0_12, r0_12)) rac = SQRT(DOT_PRODUCT(r0_13, r0_13)) @@ -539,21 +539,21 @@ SUBROUTINE restraint_4x6_low(ng4x6, g4x6_list, fixd_list, first_atom, & rbd = SQRT(DOT_PRODUCT(r0_24, r0_24)) rcd = SQRT(DOT_PRODUCT(r0_34, r0_34)) - tab = rab-g4x6_list(ng4x6)%dab - tac = rac-g4x6_list(ng4x6)%dac - tad = rad-g4x6_list(ng4x6)%dad - tbc = rbc-g4x6_list(ng4x6)%dbc - tbd = rbd-g4x6_list(ng4x6)%dbd - tcd = rcd-g4x6_list(ng4x6)%dcd + tab = rab - g4x6_list(ng4x6)%dab + tac = rac - g4x6_list(ng4x6)%dac + tad = rad - g4x6_list(ng4x6)%dad + tbc = rbc - g4x6_list(ng4x6)%dbc + tbd = rbd - g4x6_list(ng4x6)%dbd + tcd = rcd - g4x6_list(ng4x6)%dcd k = g4x6_list(iconst)%restraint%k0 ! Update Energy - energy = energy+k*(tab**2+tac**2+tad**2+tbc**2+tbd**2+tcd**2) + energy = energy + k*(tab**2 + tac**2 + tad**2 + tbc**2 + tbd**2 + tcd**2) ! Update Forces - force(:, index_a) = force(:, index_a)-2.0_dp*k*(r0_12/rab*tab+r0_13/rac*tac+r0_14/rad*tad) - force(:, index_b) = force(:, index_b)-2.0_dp*k*(-r0_12/rab*tab+r0_23/rbc*tbc+r0_24/rbd*tbd) - force(:, index_c) = force(:, index_c)-2.0_dp*k*(-r0_13/rac*tac-r0_23/rbc*tbc+r0_34/rcd*tcd) - force(:, index_d) = force(:, index_d)-2.0_dp*k*(-r0_14/rad*tad-r0_24/rbd*tbd-r0_34/rcd*tcd) + force(:, index_a) = force(:, index_a) - 2.0_dp*k*(r0_12/rab*tab + r0_13/rac*tac + r0_14/rad*tad) + force(:, index_b) = force(:, index_b) - 2.0_dp*k*(-r0_12/rab*tab + r0_23/rbc*tbc + r0_24/rbd*tbd) + force(:, index_c) = force(:, index_c) - 2.0_dp*k*(-r0_13/rac*tac - r0_23/rbc*tbc + r0_34/rcd*tcd) + force(:, index_d) = force(:, index_d) - 2.0_dp*k*(-r0_14/rad*tad - r0_24/rbd*tbd - r0_34/rcd*tcd) ! Fixed atoms IF (ASSOCIATED(fixd_list)) THEN IF (SIZE(fixd_list) > 0) THEN @@ -605,11 +605,11 @@ SUBROUTINE restraint_colv_low(colv_list, fixd_list, lcolv, & targ = colv_list(iconst)%expected_value tab = diff_colvar(lcolv(iconst)%colvar, targ) ! Update Energy - energy = energy+k*tab**2 + energy = energy + k*tab**2 ! Update Forces DO iatm = 1, SIZE(lcolv(iconst)%colvar%i_atom) ind = lcolv(iconst)%colvar%i_atom(iatm) - force(:, ind) = force(:, ind)-2.0_dp*k*tab*lcolv(iconst)%colvar%dsdr(:, iatm) + force(:, ind) = force(:, ind) - 2.0_dp*k*tab*lcolv(iconst)%colvar%dsdr(:, iatm) END DO END DO diff --git a/src/ri_environment_methods.F b/src/ri_environment_methods.F index 1cdd09c97f..4ae45e673a 100644 --- a/src/ri_environment_methods.F +++ b/src/ri_environment_methods.F @@ -179,20 +179,20 @@ SUBROUTINE calculate_ri_integrals(lri_env, qs_env, calculate_forces) IF (iatom <= jatom) THEN DO ispin = 1, dft_control%nspins DO j = j1, j2 - m = j-j1+1 + m = j - j1 + 1 DO i = i1, i2 - n = i-i1+1 - fblk(n, m) = fblk(n, m)+fout(i, ispin)*avec(j, ispin)+avec(i, ispin)*fout(j, ispin) + n = i - i1 + 1 + fblk(n, m) = fblk(n, m) + fout(i, ispin)*avec(j, ispin) + avec(i, ispin)*fout(j, ispin) END DO END DO END DO ELSE DO ispin = 1, dft_control%nspins DO i = i1, i2 - n = i-i1+1 + n = i - i1 + 1 DO j = j1, j2 - m = j-j1+1 - fblk(m, n) = fblk(m, n)+fout(i, ispin)*avec(j, ispin)+avec(i, ispin)*fout(j, ispin) + m = j - j1 + 1 + fblk(m, n) = fblk(m, n) + fout(i, ispin)*avec(j, ispin) + avec(i, ispin)*fout(j, ispin) END DO END DO END DO @@ -232,7 +232,7 @@ SUBROUTINE calculate_ri_integrals(lri_env, qs_env, calculate_forces) DO i = 1, nbas IF (eval(i) < 1.0e-10_dp) THEN eval(i) = 0.0_dp - izero = izero+1 + izero = izero + 1 ELSE eval(i) = SQRT(1.0_dp/eval(i)) ENDIF @@ -330,7 +330,7 @@ SUBROUTINE ri_metric_solver(mat, vecr, vecx, matp, solver, ptr) n = SIZE(vecr) ALLOCATE (vect(n)) CALL ri_matvec(mat, vecx, vect, ptr) - vect(:) = vect(:)-vecr(:) + vect(:) = vect(:) - vecr(:) rerror = MAXVAL(ABS(vect(:))) DEALLOCATE (vect) IF (rerror > threshold) THEN @@ -403,7 +403,7 @@ SUBROUTINE calculate_ri_densities(lri_env, qs_env, pmatrix, & atom_a = atom_of_kind(iatom) i1 = bas_ptr(1, iatom) i2 = bas_ptr(2, iatom) - n = i2-i1+1 + n = i2 - i1 + 1 lri_coef(ikind)%acoef(atom_a, 1:n) = avec(i1:i2, ispin) END DO END DO @@ -464,18 +464,18 @@ SUBROUTINE calculate_tvec_ri(lri_env, o3c, para_env) nlimit = 0 DO isweep = 1, nsweep - nlimit(1:2, isweep) = get_limit(natom, nsweep, isweep-1) + nlimit(1:2, isweep) = get_limit(natom, nsweep, isweep - 1) END DO DO ispin = 1, nspin DO isweep = 1, nsweep il = nlimit(1, isweep) iu = nlimit(2, isweep) - ma = iu-il+1 + ma = iu - il + 1 IF (ma < 1) CYCLE ibl = bas_ptr(1, il) ibu = bas_ptr(2, iu) - mba = ibu-ibl+1 + mba = ibu - ibl + 1 ALLOCATE (ta(mba, nthread)) ta = 0.0_dp @@ -491,17 +491,17 @@ SUBROUTINE calculate_tvec_ri(lri_env, o3c, para_env) DO WHILE (o3c_iterate(o3c_iterator, mepos=mepos) == 0) CALL get_o3c_iterator_info(o3c_iterator, mepos=mepos, katom=katom, tvec=tvl) IF (katom < il .OR. katom > iu) CYCLE - i1 = bas_ptr(1, katom)-ibl+1 - i2 = bas_ptr(2, katom)-ibl+1 - m = i2-i1+1 - ta(i1:i2, mepos+1) = ta(i1:i2, mepos+1)+tvl(1:m, ispin) + i1 = bas_ptr(1, katom) - ibl + 1 + i2 = bas_ptr(2, katom) - ibl + 1 + m = i2 - i1 + 1 + ta(i1:i2, mepos + 1) = ta(i1:i2, mepos + 1) + tvl(1:m, ispin) END DO !$OMP END PARALLEL CALL o3c_iterator_release(o3c_iterator) ! sum over threads DO it = 1, nthread - tvec(ibl:ibu, ispin) = tvec(ibl:ibu, ispin)+ta(1:mba, it) + tvec(ibl:ibu, ispin) = tvec(ibl:ibu, ispin) + ta(1:mba, it) END DO DEALLOCATE (ta) END DO @@ -565,13 +565,13 @@ SUBROUTINE calculate_avec_ri(lri_env, pmatrix) DO ispin = 1, nspin nelec = lri_env%ri_fit%echarge(ispin) nrm1t = SUM(nvec(:)*rm1t(:, ispin)) - lri_env%ri_fit%lambda(ispin) = 2.0_dp*(nrm1t-nelec)/lri_env%ri_fit%ntrm1n + lri_env%ri_fit%lambda(ispin) = 2.0_dp*(nrm1t - nelec)/lri_env%ri_fit%ntrm1n END DO ! calculate avec = rm1t - lambda/2 * rm1n avec => lri_env%ri_fit%avec DO ispin = 1, nspin - avec(:, ispin) = rm1t(:, ispin)-0.5_dp*lri_env%ri_fit%lambda(ispin)*rm1n(:) + avec(:, ispin) = rm1t(:, ispin) - 0.5_dp*lri_env%ri_fit%lambda(ispin)*rm1n(:) END DO CALL timestop(handle) @@ -622,15 +622,15 @@ SUBROUTINE ri_matvec(mat, vi, vo, ptr) CALL dbcsr_iterator_next_block(iter, iatom, jatom, block) n1 = ptr(1, iatom) n2 = ptr(2, iatom) - nb = n2-n1+1 + nb = n2 - n1 + 1 m1 = ptr(1, jatom) m2 = ptr(2, jatom) - mb = m2-m1+1 + mb = m2 - m1 + 1 CPASSERT(nb == SIZE(block, 1)) CPASSERT(mb == SIZE(block, 2)) - vo(n1:n2) = vo(n1:n2)+MATMUL(block, vi(m1:m2)) + vo(n1:n2) = vo(n1:n2) + MATMUL(block, vi(m1:m2)) IF (symm .AND. (iatom /= jatom)) THEN - vo(m1:m2) = vo(m1:m2)+MATMUL(TRANSPOSE(block), vi(n1:n2)) + vo(m1:m2) = vo(m1:m2) + MATMUL(TRANSPOSE(block), vi(n1:n2)) END IF END DO CALL dbcsr_iterator_stop(iter) diff --git a/src/rmsd.F b/src/rmsd.F index 8c3ad449ca..64113abb16 100644 --- a/src/rmsd.F +++ b/src/rmsd.F @@ -95,18 +95,18 @@ SUBROUTINE rmsd3(particle_set, r, r0, output_unit, weights, my_val, & zz = 0.0_dp mtot = 0.0_dp DO i = 1, natom - mtot = mtot+particle_set(i)%atomic_kind%mass - xx = xx+r((i-1)*3+1)*particle_set(i)%atomic_kind%mass - yy = yy+r((i-1)*3+2)*particle_set(i)%atomic_kind%mass - zz = zz+r((i-1)*3+3)*particle_set(i)%atomic_kind%mass + mtot = mtot + particle_set(i)%atomic_kind%mass + xx = xx + r((i - 1)*3 + 1)*particle_set(i)%atomic_kind%mass + yy = yy + r((i - 1)*3 + 2)*particle_set(i)%atomic_kind%mass + zz = zz + r((i - 1)*3 + 3)*particle_set(i)%atomic_kind%mass END DO xx = xx/mtot yy = yy/mtot zz = zz/mtot DO i = 1, natom - rp(1, i) = r((i-1)*3+1)-xx - rp(2, i) = r((i-1)*3+2)-yy - rp(3, i) = r((i-1)*3+3)-zz + rp(1, i) = r((i - 1)*3 + 1) - xx + rp(2, i) = r((i - 1)*3 + 2) - yy + rp(3, i) = r((i - 1)*3 + 3) - zz END DO IF (PRESENT(transl)) THEN transl(1) = xx @@ -119,26 +119,26 @@ SUBROUTINE rmsd3(particle_set, r, r0, output_unit, weights, my_val, & yy = 0.0_dp zz = 0.0_dp DO i = 1, natom - xx = xx+r0((i-1)*3+1)*particle_set(i)%atomic_kind%mass - yy = yy+r0((i-1)*3+2)*particle_set(i)%atomic_kind%mass - zz = zz+r0((i-1)*3+3)*particle_set(i)%atomic_kind%mass + xx = xx + r0((i - 1)*3 + 1)*particle_set(i)%atomic_kind%mass + yy = yy + r0((i - 1)*3 + 2)*particle_set(i)%atomic_kind%mass + zz = zz + r0((i - 1)*3 + 3)*particle_set(i)%atomic_kind%mass END DO xx = xx/mtot yy = yy/mtot zz = zz/mtot DO i = 1, natom - r0p(1, i) = r0((i-1)*3+1)-xx - r0p(2, i) = r0((i-1)*3+2)-yy - r0p(3, i) = r0((i-1)*3+3)-zz + r0p(1, i) = r0((i - 1)*3 + 1) - xx + r0p(2, i) = r0((i - 1)*3 + 2) - yy + r0p(3, i) = r0((i - 1)*3 + 3) - zz END DO loc_tr(1) = xx loc_tr(2) = yy loc_tr(3) = zz ! Give back the translational vector IF (PRESENT(transl)) THEN - transl(1) = transl(1)-xx - transl(2) = transl(2)-yy - transl(3) = transl(3)-zz + transl(1) = transl(1) - xx + transl(2) = transl(2) - yy + transl(3) = transl(3) - zz END IF M = 0.0_dp ! @@ -150,20 +150,20 @@ SUBROUTINE rmsd3(particle_set, r, r0, output_unit, weights, my_val, & rr0(1) = r0p(1, I) rr0(2) = r0p(2, I) rr0(3) = r0p(3, I) - rrsq = w(I)*(rr0(1)**2+rr0(2)**2+rr0(3)**2+rr(1)**2+rr(2)**2+rr(3)**2) + rrsq = w(I)*(rr0(1)**2 + rr0(2)**2 + rr0(3)**2 + rr(1)**2 + rr(2)**2 + rr(3)**2) rr0(1) = w(I)*rr0(1) rr0(2) = w(I)*rr0(2) rr0(3) = w(I)*rr0(3) - M(1, 1) = M(1, 1)+rrsq+2.0_dp*(-rr0(1)*rr(1)-rr0(2)*rr(2)-rr0(3)*rr(3)) - M(2, 2) = M(2, 2)+rrsq+2.0_dp*(-rr0(1)*rr(1)+rr0(2)*rr(2)+rr0(3)*rr(3)) - M(3, 3) = M(3, 3)+rrsq+2.0_dp*(rr0(1)*rr(1)-rr0(2)*rr(2)+rr0(3)*rr(3)) - M(4, 4) = M(4, 4)+rrsq+2.0_dp*(rr0(1)*rr(1)+rr0(2)*rr(2)-rr0(3)*rr(3)) - M(1, 2) = M(1, 2)+2.0_dp*(-rr0(2)*rr(3)+rr0(3)*rr(2)) - M(1, 3) = M(1, 3)+2.0_dp*(rr0(1)*rr(3)-rr0(3)*rr(1)) - M(1, 4) = M(1, 4)+2.0_dp*(-rr0(1)*rr(2)+rr0(2)*rr(1)) - M(2, 3) = M(2, 3)-2.0_dp*(rr0(1)*rr(2)+rr0(2)*rr(1)) - M(2, 4) = M(2, 4)-2.0_dp*(rr0(1)*rr(3)+rr0(3)*rr(1)) - M(3, 4) = M(3, 4)-2.0_dp*(rr0(2)*rr(3)+rr0(3)*rr(2)) + M(1, 1) = M(1, 1) + rrsq + 2.0_dp*(-rr0(1)*rr(1) - rr0(2)*rr(2) - rr0(3)*rr(3)) + M(2, 2) = M(2, 2) + rrsq + 2.0_dp*(-rr0(1)*rr(1) + rr0(2)*rr(2) + rr0(3)*rr(3)) + M(3, 3) = M(3, 3) + rrsq + 2.0_dp*(rr0(1)*rr(1) - rr0(2)*rr(2) + rr0(3)*rr(3)) + M(4, 4) = M(4, 4) + rrsq + 2.0_dp*(rr0(1)*rr(1) + rr0(2)*rr(2) - rr0(3)*rr(3)) + M(1, 2) = M(1, 2) + 2.0_dp*(-rr0(2)*rr(3) + rr0(3)*rr(2)) + M(1, 3) = M(1, 3) + 2.0_dp*(rr0(1)*rr(3) - rr0(3)*rr(1)) + M(1, 4) = M(1, 4) + 2.0_dp*(-rr0(1)*rr(2) + rr0(2)*rr(1)) + M(2, 3) = M(2, 3) - 2.0_dp*(rr0(1)*rr(2) + rr0(2)*rr(1)) + M(2, 4) = M(2, 4) - 2.0_dp*(rr0(1)*rr(3) + rr0(3)*rr(1)) + M(3, 4) = M(3, 4) - 2.0_dp*(rr0(2)*rr(3) + rr0(3)*rr(2)) END DO ! Symmetrize M(2, 1) = M(1, 2) @@ -189,7 +189,7 @@ SUBROUTINE rmsd3(particle_set, r, r0, output_unit, weights, my_val, & my_val = lambda(1)/REAL(natom, KIND=dp) ENDIF END IF - IF (ABS(lambda(1)-lambda(2)) < epsi) THEN + IF (ABS(lambda(1) - lambda(2)) < epsi) THEN IF (output_unit > 0) WRITE (output_unit, FMT='(T2,"RMSD3|",A)') & 'NORMAL EXECUTION, NON-UNIQUE SOLUTION' END IF @@ -204,9 +204,9 @@ SUBROUTINE rmsd3(particle_set, r, r0, output_unit, weights, my_val, & rr0(2) = W(I)*2.0_dp*r0p(2, I) rr0(3) = W(I)*2.0_dp*r0p(3, I) - dm_r(1, 1, 1) = (rr(1)-rr0(1)) - dm_r(1, 1, 2) = (rr(2)-rr0(2)) - dm_r(1, 1, 3) = (rr(3)-rr0(3)) + dm_r(1, 1, 1) = (rr(1) - rr0(1)) + dm_r(1, 1, 2) = (rr(2) - rr0(2)) + dm_r(1, 1, 3) = (rr(3) - rr0(3)) dm_r(1, 2, 1) = 0.0_dp dm_r(1, 2, 2) = rr0(3) @@ -220,9 +220,9 @@ SUBROUTINE rmsd3(particle_set, r, r0, output_unit, weights, my_val, & dm_r(1, 4, 2) = -rr0(1) dm_r(1, 4, 3) = 0.0_dp - dm_r(2, 2, 1) = (rr(1)-rr0(1)) - dm_r(2, 2, 2) = (rr(2)+rr0(2)) - dm_r(2, 2, 3) = (rr(3)+rr0(3)) + dm_r(2, 2, 1) = (rr(1) - rr0(1)) + dm_r(2, 2, 2) = (rr(2) + rr0(2)) + dm_r(2, 2, 3) = (rr(3) + rr0(3)) dm_r(2, 3, 1) = -rr0(2) dm_r(2, 3, 2) = -rr0(1) @@ -232,17 +232,17 @@ SUBROUTINE rmsd3(particle_set, r, r0, output_unit, weights, my_val, & dm_r(2, 4, 2) = 0.0_dp dm_r(2, 4, 3) = -rr0(1) - dm_r(3, 3, 1) = (rr(1)+rr0(1)) - dm_r(3, 3, 2) = (rr(2)-rr0(2)) - dm_r(3, 3, 3) = (rr(3)+rr0(3)) + dm_r(3, 3, 1) = (rr(1) + rr0(1)) + dm_r(3, 3, 2) = (rr(2) - rr0(2)) + dm_r(3, 3, 3) = (rr(3) + rr0(3)) dm_r(3, 4, 1) = 0.0_dp dm_r(3, 4, 2) = -rr0(3) dm_r(3, 4, 3) = -rr0(2) - dm_r(4, 4, 1) = (rr(1)+rr0(1)) - dm_r(4, 4, 2) = (rr(2)+rr0(2)) - dm_r(4, 4, 3) = (rr(3)-rr0(3)) + dm_r(4, 4, 1) = (rr(1) + rr0(1)) + dm_r(4, 4, 2) = (rr(2) + rr0(2)) + dm_r(4, 4, 3) = (rr(3) - rr0(3)) DO ix = 1, 3 dm_r(2, 1, ix) = dm_r(1, 2, ix) @@ -257,7 +257,7 @@ SUBROUTINE rmsd3(particle_set, r, r0, output_unit, weights, my_val, & drmsd3(ix, I) = 0.0_dp DO k = 1, 4 DO j = 1, 4 - drmsd3(ix, i) = drmsd3(ix, i)+Q(K-1)*Q(j-1)*dm_r(j, k, ix) + drmsd3(ix, i) = drmsd3(ix, i) + Q(K - 1)*Q(j - 1)*dm_r(j, k, ix) END DO END DO drmsd3(ix, I) = drmsd3(ix, I)/REAL(natom, KIND=dp) @@ -265,21 +265,21 @@ SUBROUTINE rmsd3(particle_set, r, r0, output_unit, weights, my_val, & END DO END IF ! Computes the rotation matrix in terms of quaternions - my_rot(1, 1) = -2.0_dp*Q(2)**2-2.0_dp*Q(3)**2+1.0_dp - my_rot(1, 2) = 2.0_dp*(-Q(0)*Q(3)+Q(1)*Q(2)) - my_rot(1, 3) = 2.0_dp*(Q(0)*Q(2)+Q(1)*Q(3)) - my_rot(2, 1) = 2.0_dp*(Q(0)*Q(3)+Q(1)*Q(2)) - my_rot(2, 2) = -2.0_dp*Q(1)**2-2.0_dp*Q(3)**2+1.0_dp - my_rot(2, 3) = 2.0_dp*(-Q(0)*Q(1)+Q(2)*Q(3)) - my_rot(3, 1) = 2.0_dp*(-Q(0)*Q(2)+Q(1)*Q(3)) - my_rot(3, 2) = 2.0_dp*(Q(0)*Q(1)+Q(2)*Q(3)) - my_rot(3, 3) = -2.0_dp*Q(1)**2-2.0_dp*Q(2)**2+1.0_dp + my_rot(1, 1) = -2.0_dp*Q(2)**2 - 2.0_dp*Q(3)**2 + 1.0_dp + my_rot(1, 2) = 2.0_dp*(-Q(0)*Q(3) + Q(1)*Q(2)) + my_rot(1, 3) = 2.0_dp*(Q(0)*Q(2) + Q(1)*Q(3)) + my_rot(2, 1) = 2.0_dp*(Q(0)*Q(3) + Q(1)*Q(2)) + my_rot(2, 2) = -2.0_dp*Q(1)**2 - 2.0_dp*Q(3)**2 + 1.0_dp + my_rot(2, 3) = 2.0_dp*(-Q(0)*Q(1) + Q(2)*Q(3)) + my_rot(3, 1) = 2.0_dp*(-Q(0)*Q(2) + Q(1)*Q(3)) + my_rot(3, 2) = 2.0_dp*(Q(0)*Q(1) + Q(2)*Q(3)) + my_rot(3, 3) = -2.0_dp*Q(1)**2 - 2.0_dp*Q(2)**2 + 1.0_dp IF (PRESENT(rot)) rot = my_rot ! Give back coordinates rotated in order to minimize the RMSD IF (my_rotate) THEN DO i = 1, natom - CALL matvec_3x3(r((i-1)*3+1:(i-1)*3+3), TRANSPOSE(my_rot), rp(:, i)) - r((i-1)*3+1:(i-1)*3+3) = r((i-1)*3+1:(i-1)*3+3)+loc_tr + CALL matvec_3x3(r((i - 1)*3 + 1:(i - 1)*3 + 3), TRANSPOSE(my_rot), rp(:, i)) + r((i - 1)*3 + 1:(i - 1)*3 + 3) = r((i - 1)*3 + 1:(i - 1)*3 + 3) + loc_tr END DO END IF DEALLOCATE (w) diff --git a/src/rpa_axk.F b/src/rpa_axk.F index 905e93809b..d4047ab507 100644 --- a/src/rpa_axk.F +++ b/src/rpa_axk.F @@ -183,8 +183,8 @@ SUBROUTINE compute_axk_ener(qs_env, fm_mat_Q, fm_mat_Q_gemm, dimen_RI, dimen_ia, DO iib = 1, dimen_RI IF (ABS(eigenval(iib)) .GE. thresh) THEN eigenval(iib) = & - SQRT((1.0_dp/(eigenval(iib)**2))*LOG(1.0_dp+eigenval(iib)) & - -1.0_dp/(eigenval(iib)*(eigenval(iib)+1.0_dp))) + SQRT((1.0_dp/(eigenval(iib)**2))*LOG(1.0_dp + eigenval(iib)) & + - 1.0_dp/(eigenval(iib)*(eigenval(iib) + 1.0_dp))) ELSE eigenval(iib) = 0.707_dp ENDIF @@ -221,12 +221,12 @@ SUBROUTINE compute_axk_ener(qs_env, fm_mat_Q, fm_mat_Q_gemm, dimen_RI, dimen_ia, DO iiB = 1, nrow_local i_global = row_indices(iiB) - iocc = MAX(1, i_global-1)/virtual+1 - avirt = i_global-(iocc-1)*virtual - eigen_diff = eig(avirt+homo)-eig(iocc) + iocc = MAX(1, i_global - 1)/virtual + 1 + avirt = i_global - (iocc - 1)*virtual + eigen_diff = eig(avirt + homo) - eig(iocc) fm_mat_S%local_data(iiB, jjB) = fm_mat_S%local_data(iiB, jjB)* & - SQRT(eigen_diff/(eigen_diff**2+omega**2)) + SQRT(eigen_diff/(eigen_diff**2 + omega**2)) END DO END DO @@ -254,12 +254,12 @@ SUBROUTINE compute_axk_ener(qs_env, fm_mat_Q, fm_mat_Q_gemm, dimen_RI, dimen_ia, DO iiB = 1, nrow_local i_global = row_indices(iiB) - iocc = MAX(1, i_global-1)/virtual+1 - avirt = i_global-(iocc-1)*virtual - eigen_diff = eig(avirt+homo)-eig(iocc) + iocc = MAX(1, i_global - 1)/virtual + 1 + avirt = i_global - (iocc - 1)*virtual + eigen_diff = eig(avirt + homo) - eig(iocc) fm_mat_S%local_data(iiB, jjB) = fm_mat_S%local_data(iiB, jjB)/ & - SQRT(eigen_diff/(eigen_diff**2+omega**2)) + SQRT(eigen_diff/(eigen_diff**2 + omega**2)) END DO END DO @@ -284,7 +284,7 @@ SUBROUTINE compute_axk_ener(qs_env, fm_mat_Q, fm_mat_Q_gemm, dimen_RI, dimen_ia, iitmp = get_limit(dimen_RI, ngroup, color_sub) my_group_L_start = iitmp(1) my_group_L_end = iitmp(2) - my_group_L_size = iitmp(2)-iitmp(1)+1 + my_group_L_size = iitmp(2) - iitmp(1) + 1 ! Copy Gamma_ia_P^3 to dbcsr matrix set CALL gamma_fm_to_dbcsr(fm_mat_Gamma_3, dbcsr_Gamma_3, para_env_RPA, para_env_sub, & @@ -306,7 +306,7 @@ SUBROUTINE compute_axk_ener(qs_env, fm_mat_Q, fm_mat_Q_gemm, dimen_RI, dimen_ia, L_counter = 0 DO kkb = my_group_L_start, my_group_L_end - L_counter = L_counter+1 + L_counter = L_counter + 1 ! One-index transformed Gamma_3 ALLOCATE (dbcsr_Gamma_inu_P(L_counter)%matrix) CALL dbcsr_init_p(dbcsr_Gamma_inu_P(L_counter)%matrix) @@ -325,7 +325,7 @@ SUBROUTINE compute_axk_ener(qs_env, fm_mat_Q, fm_mat_Q_gemm, dimen_RI, dimen_ia, !! Loup over auxiliary basis functions: multiplication L_counter = 0 DO kkb = my_group_L_start, my_group_L_end - L_counter = L_counter+1 + L_counter = L_counter + 1 ! Do dbcsr multiplication: transform the virtual index CALL dbcsr_multiply("N", "T", 1.0_dp, mo_coeff_v, dbcsr_Gamma_3(L_counter)%matrix, & 0.0_dp, dbcsr_Gamma_inu_P(L_counter)%matrix, filter_eps=eps_filter) @@ -340,7 +340,7 @@ SUBROUTINE compute_axk_ener(qs_env, fm_mat_Q, fm_mat_Q_gemm, dimen_RI, dimen_ia, ! Gamma_3 not needed anymore L_counter = 0 DO kkb = my_group_L_start, my_group_L_end - L_counter = L_counter+1 + L_counter = L_counter + 1 CALL dbcsr_release(dbcsr_Gamma_3(L_counter)%matrix) DEALLOCATE (dbcsr_Gamma_3(L_counter)%matrix) ENDDO @@ -359,7 +359,7 @@ SUBROUTINE compute_axk_ener(qs_env, fm_mat_Q, fm_mat_Q_gemm, dimen_RI, dimen_ia, L_counter = 0 DO kkb = my_group_L_start, my_group_L_end - L_counter = L_counter+1 + L_counter = L_counter + 1 CALL dbcsr_release(dbcsr_Gamma_inu_P(L_counter)%matrix) CALL dbcsr_release(dbcsr_Gamma_munu_P(L_counter)%matrix) DEALLOCATE (dbcsr_Gamma_inu_P(L_counter)%matrix) @@ -443,7 +443,7 @@ SUBROUTINE integrate_exchange(qs_env, dbcsr_Gamma_munu_P, mat_munu, para_env_sub P_stack_size = P_stack_size aux = 0 DO kkb = my_group_L_start, my_group_L_end - aux = aux+1 + aux = aux + 1 CALL dbcsr_copy(rho_work_ao(1)%matrix, dbcsr_Gamma_munu_P(aux)%matrix) @@ -462,7 +462,7 @@ SUBROUTINE integrate_exchange(qs_env, dbcsr_Gamma_munu_P, mat_munu, para_env_sub CALL dbcsr_multiply("T", "N", 1.0_dp, mat_2d(1, 1)%matrix, dbcsr_Gamma_munu_P(aux)%matrix, & 0.0_dp, dbcsr_Gamma_munu_P(aux)%matrix, filter_eps=eps_filter) CALL dbcsr_trace(dbcsr_Gamma_munu_P(aux)%matrix, e_axk_p) - axk_corr = axk_corr+e_axk_P + axk_corr = axk_corr + e_axk_P ENDDO CALL dbcsr_release(mat_2d(1, 1)%matrix) diff --git a/src/rpa_communication.F b/src/rpa_communication.F index 28ea86ee5c..99291a5587 100644 --- a/src/rpa_communication.F +++ b/src/rpa_communication.F @@ -108,12 +108,12 @@ SUBROUTINE initialize_buffer(fm_mat_source, fm_mat_dest, RPA_proc_map, buffer_re ! create the RPA proc_map IF (.NOT. (ALLOCATED(RPA_proc_map))) THEN - ALLOCATE (RPA_proc_map(-para_env_RPA%num_pe:2*para_env_RPA%num_pe-1)) + ALLOCATE (RPA_proc_map(-para_env_RPA%num_pe:2*para_env_RPA%num_pe - 1)) RPA_proc_map = 0 - DO i = 0, para_env_RPA%num_pe-1 + DO i = 0, para_env_RPA%num_pe - 1 RPA_proc_map(i) = i - RPA_proc_map(-i-1) = para_env_RPA%num_pe-i-1 - RPA_proc_map(para_env_RPA%num_pe+i) = i + RPA_proc_map(-i - 1) = para_env_RPA%num_pe - i - 1 + RPA_proc_map(para_env_RPA%num_pe + i) = i END DO END IF @@ -144,14 +144,14 @@ SUBROUTINE initialize_buffer(fm_mat_source, fm_mat_dest, RPA_proc_map, buffer_re npcol_d = fm_mat_dest%matrix_struct%context%num_pe(2) ! 0) create the map for the local sizes - ALLOCATE (local_size_source(2, 0:para_env_RPA%num_pe-1)) + ALLOCATE (local_size_source(2, 0:para_env_RPA%num_pe - 1)) local_size_source = 0 local_size_source(1, para_env_RPA%mepos) = nrow_local_s local_size_source(2, para_env_RPA%mepos) = ncol_local_s CALL mp_sum(local_size_source, para_env_RPA%group) ! 1) loop over my local data and define a map for the proc to send data - ALLOCATE (map_send_size(0:para_env_RPA%num_pe-1)) + ALLOCATE (map_send_size(0:para_env_RPA%num_pe - 1)) map_send_size = 0 dummy_proc = 0 DO jjB = 1, ncol_local_s @@ -163,12 +163,12 @@ SUBROUTINE initialize_buffer(fm_mat_source, fm_mat_dest, RPA_proc_map, buffer_re send_prow = cp_fm_indxg2p(i_global, nrow_block_d, dummy_proc, & fm_mat_dest%matrix_struct%first_p_pos(1), nprow_d) proc_send = fm_mat_dest%matrix_struct%context%blacs2mpi(send_prow, send_pcol) - map_send_size(proc_send) = map_send_size(proc_send)+1 + map_send_size(proc_send) = map_send_size(proc_send) + 1 END DO END DO ! 2) loop over my local data of fm_mat_S and define a map for the proc from which rec data - ALLOCATE (map_rec_size(0:para_env_RPA%num_pe-1)) + ALLOCATE (map_rec_size(0:para_env_RPA%num_pe - 1)) map_rec_size = 0 DO jjB = 1, ncol_local_d j_global = col_indices_d(jjB) @@ -179,16 +179,16 @@ SUBROUTINE initialize_buffer(fm_mat_source, fm_mat_dest, RPA_proc_map, buffer_re rec_prow = cp_fm_indxg2p(i_global, nrow_block_s, dummy_proc, & fm_mat_source%matrix_struct%first_p_pos(1), nprow_s) proc_receive = fm_mat_source%matrix_struct%context%blacs2mpi(rec_prow, rec_pcol) - map_rec_size(proc_receive) = map_rec_size(proc_receive)+1 + map_rec_size(proc_receive) = map_rec_size(proc_receive) + 1 END DO END DO ! 3) calculate the number of messages to send and allocate the send buffer number_of_send = 0 - DO proc_shift = 1, para_env_RPA%num_pe-1 - proc_send = RPA_proc_map(para_env_RPA%mepos+proc_shift) + DO proc_shift = 1, para_env_RPA%num_pe - 1 + proc_send = RPA_proc_map(para_env_RPA%mepos + proc_shift) IF (map_send_size(proc_send) > 0) THEN - number_of_send = number_of_send+1 + number_of_send = number_of_send + 1 END IF END DO @@ -196,16 +196,16 @@ SUBROUTINE initialize_buffer(fm_mat_source, fm_mat_dest, RPA_proc_map, buffer_re ! 3.5) prepare the index map CALL timeset(routineN//"_bS", handle2) - ALLOCATE (proc2counter(0:para_env_RPA%num_pe-1)) + ALLOCATE (proc2counter(0:para_env_RPA%num_pe - 1)) proc2counter = 0 ! allocate buffer for sending send_counter = 0 - DO proc_shift = 1, para_env_RPA%num_pe-1 - proc_send = RPA_proc_map(para_env_RPA%mepos+proc_shift) + DO proc_shift = 1, para_env_RPA%num_pe - 1 + proc_send = RPA_proc_map(para_env_RPA%mepos + proc_shift) size_send_buffer = map_send_size(proc_send) IF (map_send_size(proc_send) > 0) THEN - send_counter = send_counter+1 + send_counter = send_counter + 1 ! prepare the sending buffer ALLOCATE (buffer_send(send_counter)%indx(2, size_send_buffer)) buffer_send(send_counter)%indx = 0 @@ -214,7 +214,7 @@ SUBROUTINE initialize_buffer(fm_mat_source, fm_mat_dest, RPA_proc_map, buffer_re END IF END DO - ALLOCATE (index_counter(0:para_env_RPA%num_pe-1)) + ALLOCATE (index_counter(0:para_env_RPA%num_pe - 1)) index_counter = 0 DO iiB = 1, nrow_local_s i_global = row_indices_s(iiB) @@ -226,7 +226,7 @@ SUBROUTINE initialize_buffer(fm_mat_source, fm_mat_dest, RPA_proc_map, buffer_re fm_mat_dest%matrix_struct%first_p_pos(2), npcol_d) iii = fm_mat_dest%matrix_struct%context%blacs2mpi(send_prow, send_pcol) IF (iii == para_env_RPA%mepos) CYCLE - index_counter(iii) = index_counter(iii)+1 + index_counter(iii) = index_counter(iii) + 1 send_counter = proc2counter(iii) buffer_send(send_counter)%indx(1, index_counter(iii)) = iiB buffer_send(send_counter)%indx(2, index_counter(iii)) = jjB @@ -239,10 +239,10 @@ SUBROUTINE initialize_buffer(fm_mat_source, fm_mat_dest, RPA_proc_map, buffer_re ! 4) calculate the number of messages to receive and allocate the rec buffer number_of_rec = 0 - DO proc_shift = 1, para_env_RPA%num_pe-1 - proc_receive = RPA_proc_map(para_env_RPA%mepos-proc_shift) + DO proc_shift = 1, para_env_RPA%num_pe - 1 + proc_receive = RPA_proc_map(para_env_RPA%mepos - proc_shift) IF (map_rec_size(proc_receive) > 0) THEN - number_of_rec = number_of_rec+1 + number_of_rec = number_of_rec + 1 END IF END DO @@ -252,12 +252,12 @@ SUBROUTINE initialize_buffer(fm_mat_source, fm_mat_dest, RPA_proc_map, buffer_re CALL timeset(routineN//"_bR", handle2) rec_counter = 0 proc2counter = 0 - DO proc_shift = 1, para_env_RPA%num_pe-1 - proc_receive = RPA_proc_map(para_env_RPA%mepos-proc_shift) + DO proc_shift = 1, para_env_RPA%num_pe - 1 + proc_receive = RPA_proc_map(para_env_RPA%mepos - proc_shift) size_rec_buffer = map_rec_size(proc_receive) IF (map_rec_size(proc_receive) > 0) THEN - rec_counter = rec_counter+1 + rec_counter = rec_counter + 1 ! allocate the auxilliary index structure ALLOCATE (buffer_rec(rec_counter)%indx(2, size_rec_buffer)) buffer_rec(rec_counter)%indx = 0 @@ -274,8 +274,8 @@ SUBROUTINE initialize_buffer(fm_mat_source, fm_mat_dest, RPA_proc_map, buffer_re !$OMP buffer_rec,proc2counter)& !$OMP PRIVATE(proc_receive,size_rec_buffer,rec_local_row,rec_local_col,ref_rec_prow,ref_rec_pcol,& !$OMP rec_counter,iii,i_global,rec_prow,i_local,j_global,rec_pcol,j_local) - DO proc_shift = 1, para_env_RPA%num_pe-1 - proc_receive = RPA_proc_map(para_env_RPA%mepos-proc_shift) + DO proc_shift = 1, para_env_RPA%num_pe - 1 + proc_receive = RPA_proc_map(para_env_RPA%mepos - proc_shift) size_rec_buffer = map_rec_size(proc_receive) rec_local_row = local_size_source(1, proc_receive) @@ -305,7 +305,7 @@ SUBROUTINE initialize_buffer(fm_mat_source, fm_mat_dest, RPA_proc_map, buffer_re j_local = cp_fm_indxg2l(j_global, ncol_block_d, dummy_proc, & fm_mat_dest%matrix_struct%first_p_pos(2), npcol_d) - iii = iii+1 + iii = iii + 1 buffer_rec(rec_counter)%indx(1, iii) = i_local buffer_rec(rec_counter)%indx(2, iii) = j_local END IF @@ -422,12 +422,12 @@ SUBROUTINE fm_redistribute(fm_mat_source, fm_mat_dest, RPA_proc_map, buffer_rec, ! 1) prepare receiving buffer CALL timeset(routineN//"_post", handle2) rec_counter = 0 - DO proc_shift = 1, para_env_RPA%num_pe-1 - proc_receive = RPA_proc_map(para_env_RPA%mepos-proc_shift) + DO proc_shift = 1, para_env_RPA%num_pe - 1 + proc_receive = RPA_proc_map(para_env_RPA%mepos - proc_shift) size_rec_buffer = map_rec_size(proc_receive) IF (map_rec_size(proc_receive) > 0) THEN - rec_counter = rec_counter+1 + rec_counter = rec_counter + 1 ! prepare the buffer for receive ALLOCATE (buffer_rec(rec_counter)%msg(size_rec_buffer)) buffer_rec(rec_counter)%msg = 0.0_dp @@ -445,12 +445,12 @@ SUBROUTINE fm_redistribute(fm_mat_source, fm_mat_dest, RPA_proc_map, buffer_rec, ! allocate buffer for sending, fill the buffer, send the message ALLOCATE (req_send(number_of_send)) send_counter = 0 - DO proc_shift = 1, para_env_RPA%num_pe-1 - proc_send = RPA_proc_map(para_env_RPA%mepos+proc_shift) + DO proc_shift = 1, para_env_RPA%num_pe - 1 + proc_send = RPA_proc_map(para_env_RPA%mepos + proc_shift) size_send_buffer = map_send_size(proc_send) IF (map_send_size(proc_send) > 0) THEN - send_counter = send_counter+1 + send_counter = send_counter + 1 ! allocate ALLOCATE (buffer_send(send_counter)%msg(size_send_buffer)) buffer_send(send_counter)%msg = 0.0_dp @@ -478,8 +478,8 @@ SUBROUTINE fm_redistribute(fm_mat_source, fm_mat_dest, RPA_proc_map, buffer_rec, ! 3) fill the fm_mat_dest matrix with the received data CALL timeset(routineN//"_fill", handle2) rec_counter = 0 - DO proc_shift = 1, para_env_RPA%num_pe-1 - proc_receive = RPA_proc_map(para_env_RPA%mepos-proc_shift) + DO proc_shift = 1, para_env_RPA%num_pe - 1 + proc_receive = RPA_proc_map(para_env_RPA%mepos - proc_shift) size_rec_buffer = map_rec_size(proc_receive) rec_local_row = local_size_source(1, proc_receive) @@ -489,7 +489,7 @@ SUBROUTINE fm_redistribute(fm_mat_source, fm_mat_dest, RPA_proc_map, buffer_rec, ref_rec_pcol = fm_mat_source%matrix_struct%context%mpi2blacs(2, proc_receive) IF (map_rec_size(proc_receive) > 0) THEN - rec_counter = rec_counter+1 + rec_counter = rec_counter + 1 CALL mp_wait(buffer_rec(rec_counter)%msg_req) @@ -679,9 +679,9 @@ SUBROUTINE gamma_fm_to_dbcsr(fm_mat_Gamma_3, dbcsr_Gamma_3, para_env_RPA, para_e npcol = fm_ia%matrix_struct%context%num_pe(2) ! 0) create array containing the processes position and supporting infos - ALLOCATE (grid_2_mepos(0:nprow-1, 0:npcol-1)) + ALLOCATE (grid_2_mepos(0:nprow - 1, 0:npcol - 1)) grid_2_mepos = 0 - ALLOCATE (mepos_2_grid(0:para_env_sub%num_pe-1, 2)) + ALLOCATE (mepos_2_grid(0:para_env_sub%num_pe - 1, 2)) mepos_2_grid = 0 ! fill the info array grid_2_mepos(myprow, mypcol) = para_env_sub%mepos @@ -692,22 +692,22 @@ SUBROUTINE gamma_fm_to_dbcsr(fm_mat_Gamma_3, dbcsr_Gamma_3, para_env_RPA, para_e CALL mp_sum(mepos_2_grid, para_env_sub%group) ! loop over local index range and define the sending map - ALLOCATE (map_send_size(0:para_env_sub%num_pe-1)) + ALLOCATE (map_send_size(0:para_env_sub%num_pe - 1)) map_send_size = 0 dummy_proc = 0 DO iaia = my_ia_start, my_ia_end - i_global = (iaia-1)/virtual+1 - j_global = MOD(iaia-1, virtual)+1 + i_global = (iaia - 1)/virtual + 1 + j_global = MOD(iaia - 1, virtual) + 1 send_prow = cp_fm_indxg2p(i_global, nrow_block, dummy_proc, & fm_ia%matrix_struct%first_p_pos(1), nprow) send_pcol = cp_fm_indxg2p(j_global, ncol_block, dummy_proc, & fm_ia%matrix_struct%first_p_pos(2), npcol) proc_send = grid_2_mepos(send_prow, send_pcol) - map_send_size(proc_send) = map_send_size(proc_send)+1 + map_send_size(proc_send) = map_send_size(proc_send) + 1 END DO ! loop over local data of fm_ia and define the receiving map - ALLOCATE (map_rec_size(0:para_env_sub%num_pe-1)) + ALLOCATE (map_rec_size(0:para_env_sub%num_pe - 1)) map_rec_size = 0 part_ia = REAL(dimen_ia, KIND=dp)/REAL(para_env_sub%num_pe, KIND=dp) @@ -715,47 +715,47 @@ SUBROUTINE gamma_fm_to_dbcsr(fm_mat_Gamma_3, dbcsr_Gamma_3, para_env_RPA, para_e i_global = row_indices(iiB) DO jjB = 1, ncol_local j_global = col_indices(jjB) - iaia = (i_global-1)*virtual+j_global - proc_receive = INT(REAL(iaia-1, KIND=dp)/part_ia) + iaia = (i_global - 1)*virtual + j_global + proc_receive = INT(REAL(iaia - 1, KIND=dp)/part_ia) proc_receive = MAX(0, proc_receive) - proc_receive = MIN(proc_receive, para_env_sub%num_pe-1) + proc_receive = MIN(proc_receive, para_env_sub%num_pe - 1) DO itmp = get_limit(dimen_ia, para_env_sub%num_pe, proc_receive) IF (iaia >= itmp(1) .AND. iaia <= itmp(2)) EXIT - IF (iaia < itmp(1)) proc_receive = proc_receive-1 - IF (iaia > itmp(2)) proc_receive = proc_receive+1 + IF (iaia < itmp(1)) proc_receive = proc_receive - 1 + IF (iaia > itmp(2)) proc_receive = proc_receive + 1 END DO - map_rec_size(proc_receive) = map_rec_size(proc_receive)+1 + map_rec_size(proc_receive) = map_rec_size(proc_receive) + 1 END DO END DO ! create the sub_proc_map - ALLOCATE (sub_proc_map(-para_env_sub%num_pe:2*para_env_sub%num_pe-1)) - DO i = 0, para_env_sub%num_pe-1 + ALLOCATE (sub_proc_map(-para_env_sub%num_pe:2*para_env_sub%num_pe - 1)) + DO i = 0, para_env_sub%num_pe - 1 sub_proc_map(i) = i - sub_proc_map(-i-1) = para_env_sub%num_pe-i-1 - sub_proc_map(para_env_sub%num_pe+i) = i + sub_proc_map(-i - 1) = para_env_sub%num_pe - i - 1 + sub_proc_map(para_env_sub%num_pe + i) = i END DO ! allocate the buffer for sending data number_of_send = 0 - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_send = sub_proc_map(para_env_sub%mepos+proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_send = sub_proc_map(para_env_sub%mepos + proc_shift) IF (map_send_size(proc_send) > 0) THEN - number_of_send = number_of_send+1 + number_of_send = number_of_send + 1 END IF END DO ! allocate the structure that will hold the messages to be sent ALLOCATE (buffer_send(number_of_send)) ! and the map from the grid of processess to the message position - ALLOCATE (grid_ref_2_send_pos(0:nprow-1, 0:npcol-1)) + ALLOCATE (grid_ref_2_send_pos(0:nprow - 1, 0:npcol - 1)) grid_ref_2_send_pos = 0 ! finally allocate each message send_counter = 0 - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_send = sub_proc_map(para_env_sub%mepos+proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_send = sub_proc_map(para_env_sub%mepos + proc_shift) size_send_buffer = map_send_size(proc_send) IF (map_send_size(proc_send) > 0) THEN - send_counter = send_counter+1 + send_counter = send_counter + 1 ! allocate the sending buffer (msg) ALLOCATE (buffer_send(send_counter)%msg(size_send_buffer)) buffer_send(send_counter)%proc = proc_send @@ -770,10 +770,10 @@ SUBROUTINE gamma_fm_to_dbcsr(fm_mat_Gamma_3, dbcsr_Gamma_3, para_env_RPA, para_e ! allocate the buffer for receiving data number_of_rec = 0 - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) IF (map_rec_size(proc_receive) > 0) THEN - number_of_rec = number_of_rec+1 + number_of_rec = number_of_rec + 1 END IF END DO @@ -783,11 +783,11 @@ SUBROUTINE gamma_fm_to_dbcsr(fm_mat_Gamma_3, dbcsr_Gamma_3, para_env_RPA, para_e ALLOCATE (indices_rec(number_of_rec)) ! finally allocate each message and fill the array of indeces rec_counter = 0 - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) size_rec_buffer = map_rec_size(proc_receive) IF (map_rec_size(proc_receive) > 0) THEN - rec_counter = rec_counter+1 + rec_counter = rec_counter + 1 ! prepare the buffer for receive ALLOCATE (buffer_rec(rec_counter)%msg(size_rec_buffer)) buffer_rec(rec_counter)%proc = proc_receive @@ -797,14 +797,14 @@ SUBROUTINE gamma_fm_to_dbcsr(fm_mat_Gamma_3, dbcsr_Gamma_3, para_env_RPA, para_e CALL get_group_dist(gd_ia, proc_receive, rec_iaia_start, rec_iaia_end, rec_iaia_size) iii = 0 DO iaia = rec_iaia_start, rec_iaia_end - i_global = (iaia-1)/virtual+1 - j_global = MOD(iaia-1, virtual)+1 + i_global = (iaia - 1)/virtual + 1 + j_global = MOD(iaia - 1, virtual) + 1 rec_prow = cp_fm_indxg2p(i_global, nrow_block, dummy_proc, & fm_ia%matrix_struct%first_p_pos(1), nprow) rec_pcol = cp_fm_indxg2p(j_global, ncol_block, dummy_proc, & fm_ia%matrix_struct%first_p_pos(2), npcol) IF (grid_2_mepos(rec_prow, rec_pcol) /= para_env_sub%mepos) CYCLE - iii = iii+1 + iii = iii + 1 i_local = cp_fm_indxg2l(i_global, nrow_block, dummy_proc, & fm_ia%matrix_struct%first_p_pos(1), nprow) j_local = cp_fm_indxg2l(j_global, ncol_block, dummy_proc, & @@ -822,14 +822,14 @@ SUBROUTINE gamma_fm_to_dbcsr(fm_mat_Gamma_3, dbcsr_Gamma_3, para_env_RPA, para_e indices_map_my = 0 iii = 0 DO iaia = my_ia_start, my_ia_end - i_global = (iaia-1)/virtual+1 - j_global = MOD(iaia-1, virtual)+1 + i_global = (iaia - 1)/virtual + 1 + j_global = MOD(iaia - 1, virtual) + 1 rec_prow = cp_fm_indxg2p(i_global, nrow_block, dummy_proc, & fm_ia%matrix_struct%first_p_pos(1), nprow) rec_pcol = cp_fm_indxg2p(j_global, ncol_block, dummy_proc, & fm_ia%matrix_struct%first_p_pos(2), npcol) IF (grid_2_mepos(rec_prow, rec_pcol) /= para_env_sub%mepos) CYCLE - iii = iii+1 + iii = iii + 1 i_local = cp_fm_indxg2l(i_global, nrow_block, dummy_proc, & fm_ia%matrix_struct%first_p_pos(1), nprow) j_local = cp_fm_indxg2l(j_global, ncol_block, dummy_proc, & @@ -857,10 +857,10 @@ SUBROUTINE gamma_fm_to_dbcsr(fm_mat_Gamma_3, dbcsr_Gamma_3, para_env_RPA, para_e ! zero the matries of the buffers and post the messages to be received CALL cp_fm_set_all(matrix=fm_ia, alpha=0.0_dp) rec_counter = 0 - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) IF (map_rec_size(proc_receive) > 0) THEN - rec_counter = rec_counter+1 + rec_counter = rec_counter + 1 buffer_rec(rec_counter)%msg = 0.0_dp CALL mp_irecv(buffer_rec(rec_counter)%msg, proc_receive, para_env_sub%group, & buffer_rec(rec_counter)%msg_req) @@ -873,8 +873,8 @@ SUBROUTINE gamma_fm_to_dbcsr(fm_mat_Gamma_3, dbcsr_Gamma_3, para_env_RPA, para_e iii_vet = 0 jjj = 0 DO iaia = my_ia_start, my_ia_end - i_global = (iaia-1)/virtual+1 - j_global = MOD(iaia-1, virtual)+1 + i_global = (iaia - 1)/virtual + 1 + j_global = MOD(iaia - 1, virtual) + 1 send_prow = cp_fm_indxg2p(i_global, nrow_block, dummy_proc, & fm_ia%matrix_struct%first_p_pos(1), nprow) send_pcol = cp_fm_indxg2p(j_global, ncol_block, dummy_proc, & @@ -883,26 +883,26 @@ SUBROUTINE gamma_fm_to_dbcsr(fm_mat_Gamma_3, dbcsr_Gamma_3, para_env_RPA, para_e ! we don't need to send to ourselves IF (grid_2_mepos(send_prow, send_pcol) == para_env_sub%mepos) THEN ! filling fm_ia with local data - jjj = jjj+1 + jjj = jjj + 1 i_local = indices_map_my(1, jjj) j_local = indices_map_my(2, jjj) fm_ia%local_data(i_local, j_local) = & - Gamma_2D(iaia-my_ia_start+1, kkB) + Gamma_2D(iaia - my_ia_start + 1, kkB) ELSE send_counter = grid_ref_2_send_pos(send_prow, send_pcol) - iii_vet(send_counter) = iii_vet(send_counter)+1 + iii_vet(send_counter) = iii_vet(send_counter) + 1 iii = iii_vet(send_counter) buffer_send(send_counter)%msg(iii) = & - Gamma_2D(iaia-my_ia_start+1, kkB) + Gamma_2D(iaia - my_ia_start + 1, kkB) END IF END DO req_send = 0 send_counter = 0 - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_send = sub_proc_map(para_env_sub%mepos+proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_send = sub_proc_map(para_env_sub%mepos + proc_shift) IF (map_send_size(proc_send) > 0) THEN - send_counter = send_counter+1 + send_counter = send_counter + 1 CALL mp_isend(buffer_send(send_counter)%msg, proc_send, para_env_sub%group, & buffer_send(send_counter)%msg_req) req_send(send_counter) = buffer_send(send_counter)%msg_req @@ -911,11 +911,11 @@ SUBROUTINE gamma_fm_to_dbcsr(fm_mat_Gamma_3, dbcsr_Gamma_3, para_env_RPA, para_e ! receive the messages and fill the fm_ia rec_counter = 0 - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) size_rec_buffer = map_rec_size(proc_receive) IF (map_rec_size(proc_receive) > 0) THEN - rec_counter = rec_counter+1 + rec_counter = rec_counter + 1 ! wait for the message CALL mp_wait(buffer_rec(rec_counter)%msg_req) DO iii = 1, size_rec_buffer @@ -1011,9 +1011,9 @@ SUBROUTINE communicate_buffer(para_env, num_entries_rec, num_entries_send, buffe send_counter = 0 rec_counter = 0 - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 IF (num_entries_rec(imepos) > 0) THEN - rec_counter = rec_counter+1 + rec_counter = rec_counter + 1 IF (my_do_indx) THEN CALL mp_irecv(buffer_rec(imepos)%indx, imepos, para_env%group, req_array(rec_counter, 3), tag=4) END IF @@ -1023,9 +1023,9 @@ SUBROUTINE communicate_buffer(para_env, num_entries_rec, num_entries_send, buffe END IF END DO - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 IF (num_entries_send(imepos) > 0) THEN - send_counter = send_counter+1 + send_counter = send_counter + 1 IF (my_do_indx) THEN CALL mp_isend(buffer_send(imepos)%indx, imepos, para_env%group, req_array(send_counter, 1), tag=4) END IF diff --git a/src/rpa_gw.F b/src/rpa_gw.F index 193efbf7bd..c8be3e4b16 100644 --- a/src/rpa_gw.F +++ b/src/rpa_gw.F @@ -450,7 +450,7 @@ SUBROUTINE allocate_matrices_gw(vec_Sigma_c_gw, color_rpa_group, dimen_nm_gw, & my_open_shell = .TRUE. END IF - gw_corr_lev_tot = gw_corr_lev_occ+gw_corr_lev_virt + gw_corr_lev_tot = gw_corr_lev_occ + gw_corr_lev_virt ! fill the omega_frequency vector ALLOCATE (vec_omega_gw(num_integ_points)) @@ -470,7 +470,7 @@ SUBROUTINE allocate_matrices_gw(vec_Sigma_c_gw, color_rpa_group, dimen_nm_gw, & DO jquad = 1, num_integ_points IF (vec_omega_gw(jquad) < omega_max_fit) THEN - num_fit_points = num_fit_points+1 + num_fit_points = num_fit_points + 1 END IF END DO @@ -491,7 +491,7 @@ SUBROUTINE allocate_matrices_gw(vec_Sigma_c_gw, color_rpa_group, dimen_nm_gw, & iquad = 0 DO jquad = 1, num_integ_points IF (vec_omega_gw(jquad) < omega_max_fit) THEN - iquad = iquad+1 + iquad = iquad + 1 vec_omega_fit_gw(iquad) = vec_omega_gw(jquad) END IF END DO @@ -530,8 +530,8 @@ SUBROUTINE allocate_matrices_gw(vec_Sigma_c_gw, color_rpa_group, dimen_nm_gw, & ! XC potential and add exact exchange IF (mp2_env%ri_g0w0%hf_like_ev_start) THEN DO n_level_gw = 1, gw_corr_lev_tot - n_level_gw_ref = n_level_gw+homo-gw_corr_lev_occ - Eigenval(n_level_gw_ref) = Eigenval(n_level_gw_ref)+ & + n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ + Eigenval(n_level_gw_ref) = Eigenval(n_level_gw_ref) + & mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw(n_level_gw_ref, 1, 1) END DO END IF @@ -548,8 +548,8 @@ SUBROUTINE allocate_matrices_gw(vec_Sigma_c_gw, color_rpa_group, dimen_nm_gw, & ! XC potential and add exact exchange IF (mp2_env%ri_g0w0%hf_like_ev_start) THEN DO n_level_gw = 1, gw_corr_lev_tot - n_level_gw_ref = n_level_gw+homo-gw_corr_lev_occ - Eigenval_beta(n_level_gw_ref) = Eigenval_beta(n_level_gw_ref)+ & + n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ + Eigenval_beta(n_level_gw_ref) = Eigenval_beta(n_level_gw_ref) + & mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw(n_level_gw_ref, 2, 1) END DO END IF @@ -557,7 +557,7 @@ SUBROUTINE allocate_matrices_gw(vec_Sigma_c_gw, color_rpa_group, dimen_nm_gw, & IF (do_periodic) THEN - ALLOCATE (delta_corr(1+homo-gw_corr_lev_occ:homo+gw_corr_lev_virt)) + ALLOCATE (delta_corr(1 + homo - gw_corr_lev_occ:homo + gw_corr_lev_virt)) delta_corr(:) = 0.0_dp first_cycle_periodic_correction = .TRUE. @@ -669,9 +669,9 @@ SUBROUTINE get_vec_sigma_x(vec_Sigma_x_gw, nmo, fm_mat_S_gw, para_env, num_integ nm_global = row_indices(iiB) ! transform the index nm to n and m, formulae copied from Mauro's code - n_global = MAX(1, nm_global-1)/nmo+1 - m_global = nm_global-(n_global-1)*nmo - n_global = n_global+homo-gw_corr_lev_occ + n_global = MAX(1, nm_global - 1)/nmo + 1 + m_global = nm_global - (n_global - 1)*nmo + n_global = n_global + homo - gw_corr_lev_occ IF (m_global <= homo) THEN @@ -680,7 +680,7 @@ SUBROUTINE get_vec_sigma_x(vec_Sigma_x_gw, nmo, fm_mat_S_gw, para_env, num_integ ! Sigma_x_n = -sum_m^occ sum_P (B_(nm)^P)^2 vec_Sigma_x_gw(n_global, 1) = & - vec_Sigma_x_gw(n_global, 1)- & + vec_Sigma_x_gw(n_global, 1) - & fm_mat_S_gw%local_data(iiB, jjB)**2 END DO @@ -692,7 +692,7 @@ SUBROUTINE get_vec_sigma_x(vec_Sigma_x_gw, nmo, fm_mat_S_gw, para_env, num_integ CALL mp_sum(vec_Sigma_x_gw, para_env%group) vec_Sigma_x_minus_vxc_gw11(:) = & - vec_Sigma_x_minus_vxc_gw11(:)+ & + vec_Sigma_x_minus_vxc_gw11(:) + & vec_Sigma_x_gw(:, 1) CALL timestop(handle) @@ -1091,7 +1091,7 @@ SUBROUTINE GW_matrix_operations(vec_Sigma_c_gw, dimen_nm_gw, dimen_RI, gw_corr_l DO iiB = 1, nrow_local i_global = row_indices(iiB) IF (j_global == i_global .AND. i_global <= dimen_RI) THEN - fm_mat_Q%local_data(iiB, jjB) = fm_mat_Q%local_data(iiB, jjB)-1.0_dp + fm_mat_Q%local_data(iiB, jjB) = fm_mat_Q%local_data(iiB, jjB) - 1.0_dp END IF END DO END DO @@ -1125,7 +1125,7 @@ SUBROUTINE GW_matrix_operations(vec_Sigma_c_gw, dimen_nm_gw, dimen_RI, gw_corr_l DO iiB = 1, nrow_local i_global = row_indices(iiB) IF (j_global == i_global .AND. i_global <= dimen_RI) THEN - fm_mat_Q%local_data(iiB, jjB) = fm_mat_Q%local_data(iiB, jjB)-1.0_dp + fm_mat_Q%local_data(iiB, jjB) = fm_mat_Q%local_data(iiB, jjB) - 1.0_dp END IF END DO END DO @@ -1228,14 +1228,14 @@ SUBROUTINE calc_vec_W_gw(vec_Sigma_c_gw, dimen_nm_gw, dimen_RI, gw_corr_lev_occ, DO iiB = 1, nrow_local nm_global = row_indices(iiB) DO jjB = 1, ncol_local - vec_W_gw(nm_global) = vec_W_gw(nm_global)+ & + vec_W_gw(nm_global) = vec_W_gw(nm_global) + & fm_mat_S_gw_work%local_data(iiB, jjB)*fm_mat_S_gw%local_data(iiB, jjB) END DO ! transform the index nm of vec_W_gw back to n and m, formulae copied from Mauro's code - n_global = MAX(1, nm_global-1)/nmo+1 - m_global = nm_global-(n_global-1)*nmo - n_global = n_global+homo-gw_corr_lev_occ + n_global = MAX(1, nm_global - 1)/nmo + 1 + m_global = nm_global - (n_global - 1)*nmo + n_global = n_global + homo - gw_corr_lev_occ ! compute self-energy for imaginary frequencies DO iquad = 1, num_fit_points @@ -1252,9 +1252,9 @@ SUBROUTINE calc_vec_W_gw(vec_Sigma_c_gw, dimen_nm_gw, dimen_RI, gw_corr_lev_occ, ! set the Fermi energy for occ orbitals slightly above the HOMO and ! for virt orbitals slightly below the LUMO IF (n_global <= homo) THEN - e_fermi = Eigenval(homo)+fermi_level_offset + e_fermi = Eigenval(homo) + fermi_level_offset ELSE - e_fermi = Eigenval(homo+1)-fermi_level_offset + e_fermi = Eigenval(homo + 1) - fermi_level_offset END IF ! add here the periodic correction @@ -1267,11 +1267,11 @@ SUBROUTINE calc_vec_W_gw(vec_Sigma_c_gw, dimen_nm_gw, dimen_RI, gw_corr_lev_occ, ! update the self-energy (use that vec_W_gw(iw) is symmetric), divide the integration ! weight by 2, because the integration is from -infty to +infty and not just 0 to +infty ! as for RPA, also we need for virtual orbitals a complex conjugate - vec_Sigma_c_gw(n_global-homo+gw_corr_lev_occ, iquad, 1) = & - vec_Sigma_c_gw(n_global-homo+gw_corr_lev_occ, iquad, 1)- & - 0.5_dp/pi*wj(jquad)/2.0_dp*(vec_W_gw(nm_global)+delta_corr_nn)* & - (1.0_dp/(im_unit*(omega+omega_i)+e_fermi-Eigenval(m_global))+ & - 1.0_dp/(im_unit*(-omega+omega_i)+e_fermi-Eigenval(m_global))) + vec_Sigma_c_gw(n_global - homo + gw_corr_lev_occ, iquad, 1) = & + vec_Sigma_c_gw(n_global - homo + gw_corr_lev_occ, iquad, 1) - & + 0.5_dp/pi*wj(jquad)/2.0_dp*(vec_W_gw(nm_global) + delta_corr_nn)* & + (1.0_dp/(im_unit*(omega + omega_i) + e_fermi - Eigenval(m_global)) + & + 1.0_dp/(im_unit*(-omega + omega_i) + e_fermi - Eigenval(m_global))) END DO END DO @@ -1510,12 +1510,12 @@ SUBROUTINE GW_postprocessing(vec_Sigma_c_gw, count_ev_sc_GW, gw_corr_lev_occ, & IF (do_periodic .AND. mp2_env%ri_g0w0%do_average_deg_levels) THEN - CALL average_degenerate_levels(vec_Sigma_c_gw, Eigenval(1+homo-gw_corr_lev_occ:homo+gw_corr_lev_virt), & + CALL average_degenerate_levels(vec_Sigma_c_gw, Eigenval(1 + homo - gw_corr_lev_occ:homo + gw_corr_lev_virt), & mp2_env%ri_g0w0%eps_eigenval) IF (my_open_shell) THEN CALL average_degenerate_levels(vec_Sigma_c_gw_beta, & - Eigenval_beta(1+homo_beta-gw_corr_lev_occ_beta: & - homo_beta+gw_corr_lev_virt_beta), & + Eigenval_beta(1 + homo_beta - gw_corr_lev_occ_beta: & + homo_beta + gw_corr_lev_virt_beta), & mp2_env%ri_g0w0%eps_eigenval) END IF END IF @@ -1849,7 +1849,7 @@ SUBROUTINE compute_eps_head_Berry(eps_head, kpoints, matrix_berry_re_mo_mo, matr correct_kpoint(1:3) = twopi*kpoints%xkp(1:3, ikp) - abs_k_square = (correct_kpoint(1))**2+(correct_kpoint(2))**2+(correct_kpoint(3))**2 + abs_k_square = (correct_kpoint(1))**2 + (correct_kpoint(2))**2 + (correct_kpoint(3))**2 ! real part of the Berry phase CALL dbcsr_iterator_start(iter, matrix_berry_re_mo_mo(ikp)%matrix) @@ -1859,16 +1859,16 @@ SUBROUTINE compute_eps_head_Berry(eps_head, kpoints, matrix_berry_re_mo_mo, matr row_size=row_size, col_size=col_size, & row_offset=row_offset, col_offset=col_offset) - IF (row_offset+row_size <= homo .OR. col_offset > homo) CYCLE + IF (row_offset + row_size <= homo .OR. col_offset > homo) CYCLE IF (row_offset <= homo) THEN - row_start_in_block = homo-row_offset+2 + row_start_in_block = homo - row_offset + 2 ELSE row_start_in_block = 1 END IF - IF (col_offset+col_size-1 > homo) THEN - col_end_in_block = homo-col_offset+1 + IF (col_offset + col_size - 1 > homo) THEN + col_end_in_block = homo - col_offset + 1 ELSE col_end_in_block = col_size END IF @@ -1877,11 +1877,11 @@ SUBROUTINE compute_eps_head_Berry(eps_head, kpoints, matrix_berry_re_mo_mo, matr DO i_col = 1, col_end_in_block - eigen_diff = Eigenval(i_col+col_offset-1)-Eigenval(i_row+row_offset-1) + eigen_diff = Eigenval(i_col + col_offset - 1) - Eigenval(i_row + row_offset - 1) cos_square = (data_block(i_row, i_col))**2 - P_head(ikp) = P_head(ikp)+2.0_dp*eigen_diff/(omega**2+eigen_diff**2)*cos_square/abs_k_square + P_head(ikp) = P_head(ikp) + 2.0_dp*eigen_diff/(omega**2 + eigen_diff**2)*cos_square/abs_k_square END DO @@ -1899,16 +1899,16 @@ SUBROUTINE compute_eps_head_Berry(eps_head, kpoints, matrix_berry_re_mo_mo, matr row_size=row_size, col_size=col_size, & row_offset=row_offset, col_offset=col_offset) - IF (row_offset+row_size <= homo .OR. col_offset > homo) CYCLE + IF (row_offset + row_size <= homo .OR. col_offset > homo) CYCLE IF (row_offset <= homo) THEN - row_start_in_block = homo-row_offset+2 + row_start_in_block = homo - row_offset + 2 ELSE row_start_in_block = 1 END IF - IF (col_offset+col_size-1 > homo) THEN - col_end_in_block = homo-col_offset+1 + IF (col_offset + col_size - 1 > homo) THEN + col_end_in_block = homo - col_offset + 1 ELSE col_end_in_block = col_size END IF @@ -1917,11 +1917,11 @@ SUBROUTINE compute_eps_head_Berry(eps_head, kpoints, matrix_berry_re_mo_mo, matr DO i_col = 1, col_end_in_block - eigen_diff = Eigenval(i_col+col_offset-1)-Eigenval(i_row+row_offset-1) + eigen_diff = Eigenval(i_col + col_offset - 1) - Eigenval(i_row + row_offset - 1) sin_square = (data_block(i_row, i_col))**2 - P_head(ikp) = P_head(ikp)+2.0_dp*eigen_diff/(omega**2+eigen_diff**2)*sin_square/abs_k_square + P_head(ikp) = P_head(ikp) + 2.0_dp*eigen_diff/(omega**2 + eigen_diff**2)*sin_square/abs_k_square END DO @@ -1937,7 +1937,7 @@ SUBROUTINE compute_eps_head_Berry(eps_head, kpoints, matrix_berry_re_mo_mo, matr ! normalize eps_head ! 2.0_dp due to closed shell - eps_head(:) = 1.0_dp-2.0_dp*P_head(:)/cell_volume*fourpi + eps_head(:) = 1.0_dp - 2.0_dp*P_head(:)/cell_volume*fourpi DEALLOCATE (P_head) @@ -2226,8 +2226,8 @@ SUBROUTINE get_berry_phase(qs_env, kpoints, matrix_berry_re_mo_mo, matrix_berry_ CALL cp_fm_syevd(fm_mat_P, fm_mat_eigv_P, evals_P) ! only invert the eigenvalues which correspond to the MOs used in the aux. basis - evals_P_sqrt_inv(1:nmo-nmo_for_aux_bas) = 0.0_dp - evals_P_sqrt_inv(nmo-nmo_for_aux_bas+1:nmo) = 1.0_dp/SQRT(evals_P(nmo-nmo_for_aux_bas+1:nmo)) + evals_P_sqrt_inv(1:nmo - nmo_for_aux_bas) = 0.0_dp + evals_P_sqrt_inv(nmo - nmo_for_aux_bas + 1:nmo) = 1.0_dp/SQRT(evals_P(nmo - nmo_for_aux_bas + 1:nmo)) CALL cp_fm_to_fm(fm_mat_eigv_P, fm_mat_scaled_eigv_P) @@ -2325,7 +2325,7 @@ SUBROUTINE get_berry_phase(qs_env, kpoints, matrix_berry_re_mo_mo, matrix_berry_ correct_kpoint(1:3) = -twopi*kpoints%xkp(1:3, ikp) - abs_kpoint = SQRT(correct_kpoint(1)**2+correct_kpoint(2)**2+correct_kpoint(3)**2) + abs_kpoint = SQRT(correct_kpoint(1)**2 + correct_kpoint(2)**2 + correct_kpoint(3)**2) IF (abs_kpoint < eps_kpoint) THEN @@ -2498,7 +2498,7 @@ SUBROUTINE remove_unnecessary_blocks(mat_mo_coeff_Gamma_occ_and_GW, homo, gw_cor CALL dbcsr_iterator_next_block(iter, row, col, data_block, & col_offset=col_offset) - IF (col_offset > homo+gw_corr_lev_virt) THEN + IF (col_offset > homo + gw_corr_lev_virt) THEN data_block = 0.0_dp @@ -2564,7 +2564,7 @@ SUBROUTINE kpoint_sum_for_eps_inv_head_Berry(delta_corr, eps_inv_head, kpoints, IF (do_extra_kpoints) THEN NULLIFY (delta_corr_extra) - ALLOCATE (delta_corr_extra(1+homo-gw_corr_lev_occ:homo+gw_corr_lev_virt)) + ALLOCATE (delta_corr_extra(1 + homo - gw_corr_lev_occ:homo + gw_corr_lev_virt)) delta_corr_extra = 0.0_dp END IF @@ -2576,7 +2576,7 @@ SUBROUTINE kpoint_sum_for_eps_inv_head_Berry(delta_corr, eps_inv_head, kpoints, correct_kpoint(1:3) = twopi*kpoints%xkp(1:3, ikp) - abs_k_square = (correct_kpoint(1))**2+(correct_kpoint(2))**2+(correct_kpoint(3))**2 + abs_k_square = (correct_kpoint(1))**2 + (correct_kpoint(2))**2 + (correct_kpoint(3))**2 ! cos part of the Berry phase CALL dbcsr_iterator_start(iter, matrix_berry_re_mo_mo(ikp)%matrix) @@ -2588,32 +2588,32 @@ SUBROUTINE kpoint_sum_for_eps_inv_head_Berry(delta_corr, eps_inv_head, kpoints, DO i_col = 1, col_size - DO n_level_gw = 1+homo-gw_corr_lev_occ, homo+gw_corr_lev_virt + DO n_level_gw = 1 + homo - gw_corr_lev_occ, homo + gw_corr_lev_virt - IF (n_level_gw == i_col+col_offset-1) THEN + IF (n_level_gw == i_col + col_offset - 1) THEN DO i_row = 1, row_size - contribution = weight*(eps_inv_head(ikp)-1.0_dp)/abs_k_square*(data_block(i_row, i_col))**2 + contribution = weight*(eps_inv_head(ikp) - 1.0_dp)/abs_k_square*(data_block(i_row, i_col))**2 - m_level = i_row+row_offset-1 + m_level = i_row + row_offset - 1 ! we only compute the correction for n=m IF (m_level .NE. n_level_gw) CYCLE IF (.NOT. do_extra_kpoints) THEN - delta_corr(n_level_gw) = delta_corr(n_level_gw)+contribution + delta_corr(n_level_gw) = delta_corr(n_level_gw) + contribution ELSE IF (ikp <= nkp*8/9) THEN - delta_corr(n_level_gw) = delta_corr(n_level_gw)+contribution + delta_corr(n_level_gw) = delta_corr(n_level_gw) + contribution ELSE - delta_corr_extra(n_level_gw) = delta_corr_extra(n_level_gw)+contribution + delta_corr_extra(n_level_gw) = delta_corr_extra(n_level_gw) + contribution END IF @@ -2641,32 +2641,32 @@ SUBROUTINE kpoint_sum_for_eps_inv_head_Berry(delta_corr, eps_inv_head, kpoints, DO i_col = 1, col_size - DO n_level_gw = 1+homo-gw_corr_lev_occ, homo+gw_corr_lev_virt + DO n_level_gw = 1 + homo - gw_corr_lev_occ, homo + gw_corr_lev_virt - IF (n_level_gw == i_col+col_offset-1) THEN + IF (n_level_gw == i_col + col_offset - 1) THEN DO i_row = 1, row_size - m_level = i_row+row_offset-1 + m_level = i_row + row_offset - 1 - contribution = weight*(eps_inv_head(ikp)-1.0_dp)/abs_k_square*(data_block(i_row, i_col))**2 + contribution = weight*(eps_inv_head(ikp) - 1.0_dp)/abs_k_square*(data_block(i_row, i_col))**2 ! we only compute the correction for n=m IF (m_level .NE. n_level_gw) CYCLE IF (.NOT. do_extra_kpoints) THEN - delta_corr(n_level_gw) = delta_corr(n_level_gw)+contribution + delta_corr(n_level_gw) = delta_corr(n_level_gw) + contribution ELSE IF (ikp <= nkp*8/9) THEN - delta_corr(n_level_gw) = delta_corr(n_level_gw)+contribution + delta_corr(n_level_gw) = delta_corr(n_level_gw) + contribution ELSE - delta_corr_extra(n_level_gw) = delta_corr_extra(n_level_gw)+contribution + delta_corr_extra(n_level_gw) = delta_corr_extra(n_level_gw) + contribution END IF @@ -2684,7 +2684,7 @@ SUBROUTINE kpoint_sum_for_eps_inv_head_Berry(delta_corr, eps_inv_head, kpoints, CALL dbcsr_iterator_stop(iter_new) - check_int_one_over_ksq = check_int_one_over_ksq+weight/abs_k_square + check_int_one_over_ksq = check_int_one_over_ksq + weight/abs_k_square END DO @@ -2701,7 +2701,7 @@ SUBROUTINE kpoint_sum_for_eps_inv_head_Berry(delta_corr, eps_inv_head, kpoints, CALL mp_sum(delta_corr_extra, para_env_RPA%group) - delta_corr(:) = delta_corr(:)+(delta_corr(:)-delta_corr_extra(:)) + delta_corr(:) = delta_corr(:) + (delta_corr(:) - delta_corr_extra(:)) DEALLOCATE (delta_corr_extra) @@ -2786,9 +2786,9 @@ SUBROUTINE get_kpoints(qs_env, kpoints, kp_grid, num_kp_grids, para_env, h_inv, IF (do_mo_coeff_Gamma_only) THEN - outer_kp_grid(1) = kp_grid(1)-1 - outer_kp_grid(2) = kp_grid(2)-1 - outer_kp_grid(3) = kp_grid(3)-1 + outer_kp_grid(1) = kp_grid(1) - 1 + outer_kp_grid(2) = kp_grid(2) - 1 + outer_kp_grid(3) = kp_grid(3) - 1 CALL get_qs_env(qs_env=qs_env, cell=cell, particle_set=particle_set) @@ -2802,8 +2802,8 @@ SUBROUTINE get_kpoints(qs_env, kpoints, kp_grid, num_kp_grids, para_env, h_inv, kpoints%full_grid = .FALSE. kpoints%use_real_wfn = .FALSE. kpoints%eps_geo = 1.e-6_dp - npoints = kp_grid(1)*kp_grid(2)*kp_grid(3)/2+ & - (num_kp_grids-1)*((outer_kp_grid(1)+1)/2*outer_kp_grid(2)*outer_kp_grid(3)-1) + npoints = kp_grid(1)*kp_grid(2)*kp_grid(3)/2 + & + (num_kp_grids - 1)*((outer_kp_grid(1) + 1)/2*outer_kp_grid(2)*outer_kp_grid(3) - 1) IF (do_extra_kpoints) THEN @@ -2816,7 +2816,7 @@ SUBROUTINE get_kpoints(qs_env, kpoints, kp_grid, num_kp_grids, para_env, h_inv, IF (do_extra_kpoints) THEN - npoints = kp_grid(1)*kp_grid(2)*kp_grid(3)/2+kp_grid(1)*kp_grid(2)*kp_grid(3)/2/8 + npoints = kp_grid(1)*kp_grid(2)*kp_grid(3)/2 + kp_grid(1)*kp_grid(2)*kp_grid(3)/2/8 END IF @@ -2834,33 +2834,33 @@ SUBROUTINE get_kpoints(qs_env, kpoints, kp_grid, num_kp_grids, para_env, h_inv, kpoint_weight_left = 1.0_dp ! the outer grids - DO i_grid_level = 1, num_kp_grids-1 + DO i_grid_level = 1, num_kp_grids - 1 single_weight = kpoint_weight_left/REAL(nkp_outer_grid, KIND=dp) - start_kp = i+1 + start_kp = i + 1 DO ix = 1, outer_kp_grid(1) DO iy = 1, outer_kp_grid(2) DO iz = 1, outer_kp_grid(3) ! exclude Gamma - IF (2*ix-outer_kp_grid(1)-1 == 0 .AND. 2*iy-outer_kp_grid(2)-1 == 0 .AND. & - 2*iz-outer_kp_grid(3)-1 == 0) CYCLE + IF (2*ix - outer_kp_grid(1) - 1 == 0 .AND. 2*iy - outer_kp_grid(2) - 1 == 0 .AND. & + 2*iz - outer_kp_grid(3) - 1 == 0) CYCLE ! use time reversal symmetry k<->-k - IF (2*ix-outer_kp_grid(1)-1 < 0) CYCLE + IF (2*ix - outer_kp_grid(1) - 1 < 0) CYCLE - i = i+1 - kpt_latt(1) = REAL(2*ix-outer_kp_grid(1)-1, KIND=dp)/(2._dp*REAL(outer_kp_grid(1), KIND=dp)) & + i = i + 1 + kpt_latt(1) = REAL(2*ix - outer_kp_grid(1) - 1, KIND=dp)/(2._dp*REAL(outer_kp_grid(1), KIND=dp)) & *reducing_factor(1) - kpt_latt(2) = REAL(2*iy-outer_kp_grid(2)-1, KIND=dp)/(2._dp*REAL(outer_kp_grid(2), KIND=dp)) & + kpt_latt(2) = REAL(2*iy - outer_kp_grid(2) - 1, KIND=dp)/(2._dp*REAL(outer_kp_grid(2), KIND=dp)) & *reducing_factor(2) - kpt_latt(3) = REAL(2*iz-outer_kp_grid(3)-1, KIND=dp)/(2._dp*REAL(outer_kp_grid(3), KIND=dp)) & + kpt_latt(3) = REAL(2*iz - outer_kp_grid(3) - 1, KIND=dp)/(2._dp*REAL(outer_kp_grid(3), KIND=dp)) & *reducing_factor(3) kpoints%xkp(1:3, i) = MATMUL(TRANSPOSE(h_inv), kpt_latt(:)) - IF (2*ix-outer_kp_grid(1)-1 == 0) THEN + IF (2*ix - outer_kp_grid(1) - 1 == 0) THEN kpoints%wkp(i) = single_weight ELSE kpoints%wkp(i) = 2._dp*single_weight @@ -2872,7 +2872,7 @@ SUBROUTINE get_kpoints(qs_env, kpoints, kp_grid, num_kp_grids, para_env, h_inv, end_kp = i - kpoint_weight_left = kpoint_weight_left-SUM(kpoints%wkp(start_kp:end_kp)) + kpoint_weight_left = kpoint_weight_left - SUM(kpoints%wkp(start_kp:end_kp)) reducing_factor(1) = reducing_factor(1)/REAL(outer_kp_grid(1), KIND=dp) reducing_factor(2) = reducing_factor(2)/REAL(outer_kp_grid(2), KIND=dp) @@ -2888,12 +2888,12 @@ SUBROUTINE get_kpoints(qs_env, kpoints, kp_grid, num_kp_grids, para_env, h_inv, DO iz = 1, kp_grid(3) ! use time reversal symmetry k<->-k - IF (2*ix-kp_grid(1)-1 < 0) CYCLE + IF (2*ix - kp_grid(1) - 1 < 0) CYCLE - i = i+1 - kpt_latt(1) = REAL(2*ix-kp_grid(1)-1, KIND=dp)/(2._dp*REAL(kp_grid(1), KIND=dp))*reducing_factor(1) - kpt_latt(2) = REAL(2*iy-kp_grid(2)-1, KIND=dp)/(2._dp*REAL(kp_grid(2), KIND=dp))*reducing_factor(2) - kpt_latt(3) = REAL(2*iz-kp_grid(3)-1, KIND=dp)/(2._dp*REAL(kp_grid(3), KIND=dp))*reducing_factor(3) + i = i + 1 + kpt_latt(1) = REAL(2*ix - kp_grid(1) - 1, KIND=dp)/(2._dp*REAL(kp_grid(1), KIND=dp))*reducing_factor(1) + kpt_latt(2) = REAL(2*iy - kp_grid(2) - 1, KIND=dp)/(2._dp*REAL(kp_grid(2), KIND=dp))*reducing_factor(2) + kpt_latt(3) = REAL(2*iz - kp_grid(3) - 1, KIND=dp)/(2._dp*REAL(kp_grid(3), KIND=dp))*reducing_factor(3) kpoints%xkp(1:3, i) = MATMUL(TRANSPOSE(h_inv), kpt_latt(:)) @@ -2912,12 +2912,12 @@ SUBROUTINE get_kpoints(qs_env, kpoints, kp_grid, num_kp_grids, para_env, h_inv, DO iz = 1, kp_grid(3)/2 ! use time reversal symmetry k<->-k - IF (2*ix-kp_grid(1)/2-1 < 0) CYCLE + IF (2*ix - kp_grid(1)/2 - 1 < 0) CYCLE - i = i+1 - kpt_latt(1) = REAL(2*ix-kp_grid(1)/2-1, KIND=dp)/(REAL(kp_grid(1), KIND=dp)) - kpt_latt(2) = REAL(2*iy-kp_grid(2)/2-1, KIND=dp)/(REAL(kp_grid(2), KIND=dp)) - kpt_latt(3) = REAL(2*iz-kp_grid(3)/2-1, KIND=dp)/(REAL(kp_grid(3), KIND=dp)) + i = i + 1 + kpt_latt(1) = REAL(2*ix - kp_grid(1)/2 - 1, KIND=dp)/(REAL(kp_grid(1), KIND=dp)) + kpt_latt(2) = REAL(2*iy - kp_grid(2)/2 - 1, KIND=dp)/(REAL(kp_grid(2), KIND=dp)) + kpt_latt(3) = REAL(2*iz - kp_grid(3)/2 - 1, KIND=dp)/(REAL(kp_grid(3), KIND=dp)) kpoints%xkp(1:3, i) = MATMUL(TRANSPOSE(h_inv), kpt_latt(:)) @@ -2979,13 +2979,13 @@ SUBROUTINE average_degenerate_levels(vec_Sigma_c_gw, Eigenval_DFT, eps_eigenval) DO i_level_gw = 2, num_levels_gw - IF (ABS(Eigenval_DFT(i_level_gw)-Eigenval_DFT(i_level_gw-1)) < eps_eigenval) THEN + IF (ABS(Eigenval_DFT(i_level_gw) - Eigenval_DFT(i_level_gw - 1)) < eps_eigenval) THEN - list_degenerate_levels(i_level_gw) = list_degenerate_levels(i_level_gw-1) + list_degenerate_levels(i_level_gw) = list_degenerate_levels(i_level_gw - 1) ELSE - list_degenerate_levels(i_level_gw) = list_degenerate_levels(i_level_gw-1)+1 + list_degenerate_levels(i_level_gw) = list_degenerate_levels(i_level_gw - 1) + 1 END IF @@ -3007,7 +3007,7 @@ SUBROUTINE average_degenerate_levels(vec_Sigma_c_gw, Eigenval_DFT, eps_eigenval) IF (i_deg_level == list_degenerate_levels(i_level_gw)) THEN - degeneracy = degeneracy+1 + degeneracy = degeneracy + 1 END IF @@ -3015,14 +3015,14 @@ SUBROUTINE average_degenerate_levels(vec_Sigma_c_gw, Eigenval_DFT, eps_eigenval) DO jquad = 1, num_integ_points - avg_self_energy(jquad) = SUM(vec_Sigma_c_gw(first_degenerate_level:first_degenerate_level+degeneracy-1, jquad, 1)) & + avg_self_energy(jquad) = SUM(vec_Sigma_c_gw(first_degenerate_level:first_degenerate_level + degeneracy - 1, jquad, 1)) & /REAL(degeneracy, KIND=dp) END DO - DO j_deg_level = 0, degeneracy-1 + DO j_deg_level = 0, degeneracy - 1 - vec_Sigma_c_gw(first_degenerate_level+j_deg_level, :, 1) = avg_self_energy(:) + vec_Sigma_c_gw(first_degenerate_level + j_deg_level, :, 1) = avg_self_energy(:) END DO @@ -3167,7 +3167,7 @@ SUBROUTINE fit_and_continuation_2pole(vec_gw_energ, vec_gw_energ_error_fit, vec_ im_unit = (0.0_dp, 1.0_dp) re_unit = (1.0_dp, 0.0_dp) - num_var = 2*num_poles+1 + num_var = 2*num_poles + 1 ALLOCATE (Lambda(num_var)) Lambda = (0.0_dp, 0.0_dp) ALLOCATE (Lambda_without_offset(num_var)) @@ -3185,63 +3185,63 @@ SUBROUTINE fit_and_continuation_2pole(vec_gw_energ, vec_gw_energ_error_fit, vec_ sign_occ_virt = 1.0_dp END IF - n_level_gw_ref = n_level_gw+homo-gw_corr_lev_occ + n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ DO jquad = 1, num_fit_points vec_omega_fit_gw_sign(jquad) = ABS(vec_omega_fit_gw(jquad))*sign_occ_virt END DO ! initial guess - range_step = (vec_omega_fit_gw_sign(num_fit_points)-vec_omega_fit_gw_sign(1))/(num_poles-1) + range_step = (vec_omega_fit_gw_sign(num_fit_points) - vec_omega_fit_gw_sign(1))/(num_poles - 1) DO iii = 1, num_poles - Lambda_Im(2*iii+1) = vec_omega_fit_gw_sign(1)+(iii-1)*range_step + Lambda_Im(2*iii + 1) = vec_omega_fit_gw_sign(1) + (iii - 1)*range_step END DO - range_step = (vec_omega_fit_gw_sign(num_fit_points)-vec_omega_fit_gw_sign(1))/num_poles + range_step = (vec_omega_fit_gw_sign(num_fit_points) - vec_omega_fit_gw_sign(1))/num_poles DO iii = 1, num_poles - Lambda_Re(2*iii+1) = ABS(vec_omega_fit_gw_sign(1)+(iii-0.5_dp)*range_step) + Lambda_Re(2*iii + 1) = ABS(vec_omega_fit_gw_sign(1) + (iii - 0.5_dp)*range_step) END DO DO iii = 1, num_var - Lambda(iii) = Lambda_Re(iii)+im_unit*Lambda_Im(iii) + Lambda(iii) = Lambda_Re(iii) + im_unit*Lambda_Im(iii) END DO CALL calc_chi2(chi2_old, Lambda, vec_Sigma_c_gw, vec_omega_fit_gw_sign, num_poles, & num_fit_points, n_level_gw) - ALLOCATE (mat_A_gw(num_poles+1, num_poles+1)) - ALLOCATE (vec_b_gw(num_poles+1)) - ALLOCATE (ipiv(num_poles+1)) + ALLOCATE (mat_A_gw(num_poles + 1, num_poles + 1)) + ALLOCATE (vec_b_gw(num_poles + 1)) + ALLOCATE (ipiv(num_poles + 1)) mat_A_gw = (0.0_dp, 0.0_dp) vec_b_gw = 0.0_dp - DO iii = 1, num_poles+1 + DO iii = 1, num_poles + 1 mat_A_gw(iii, 1) = (1.0_dp, 0.0_dp) END DO integ_range = num_fit_points/num_poles - DO kkk = 1, num_poles+1 - xpos = (kkk-1)*integ_range+1 + DO kkk = 1, num_poles + 1 + xpos = (kkk - 1)*integ_range + 1 xpos = MIN(xpos, num_fit_points) ! calculate coefficient at this point DO iii = 1, num_poles jjj = iii*2 - func_val = (1.0_dp, 0.0_dp)/(im_unit*vec_omega_fit_gw_sign(xpos)- & - CMPLX(Lambda_Re(jjj+1), Lambda_Im(jjj+1), KIND=dp)) - mat_A_gw(kkk, iii+1) = func_val + func_val = (1.0_dp, 0.0_dp)/(im_unit*vec_omega_fit_gw_sign(xpos) - & + CMPLX(Lambda_Re(jjj + 1), Lambda_Im(jjj + 1), KIND=dp)) + mat_A_gw(kkk, iii + 1) = func_val END DO vec_b_gw(kkk) = vec_Sigma_c_gw(n_level_gw, xpos) END DO ! Solve system of linear equations - CALL ZGETRF(num_poles+1, num_poles+1, mat_A_gw, num_poles+1, ipiv, info) + CALL ZGETRF(num_poles + 1, num_poles + 1, mat_A_gw, num_poles + 1, ipiv, info) - CALL ZGETRS('N', num_poles+1, 1, mat_A_gw, num_poles+1, ipiv, vec_b_gw, num_poles+1, info) + CALL ZGETRS('N', num_poles + 1, 1, mat_A_gw, num_poles + 1, ipiv, vec_b_gw, num_poles + 1, info) Lambda_Re(1) = REAL(vec_b_gw(1)) Lambda_Im(1) = AIMAG(vec_b_gw(1)) DO iii = 1, num_poles jjj = iii*2 - Lambda_Re(jjj) = REAL(vec_b_gw(iii+1)) - Lambda_Im(jjj) = AIMAG(vec_b_gw(iii+1)) + Lambda_Re(jjj) = REAL(vec_b_gw(iii + 1)) + Lambda_Im(jjj) = AIMAG(vec_b_gw(iii + 1)) END DO DEALLOCATE (mat_A_gw) @@ -3268,7 +3268,7 @@ SUBROUTINE fit_and_continuation_2pole(vec_gw_energ, vec_gw_energ_error_fit, vec_ ! calc delta lambda DO iii = 1, num_var - Lambda(iii) = Lambda_Re(iii)+im_unit*Lambda_Im(iii) + Lambda(iii) = Lambda_Re(iii) + im_unit*Lambda_Im(iii) END DO dLambda = (0.0_dp, 0.0_dp) @@ -3276,9 +3276,9 @@ SUBROUTINE fit_and_continuation_2pole(vec_gw_energ, vec_gw_energ_error_fit, vec_ func_val = Lambda(1) DO iii = 1, num_poles jjj = iii*2 - func_val = func_val+Lambda(jjj)/(vec_omega_fit_gw_sign(kkk)*im_unit-Lambda(jjj+1)) + func_val = func_val + Lambda(jjj)/(vec_omega_fit_gw_sign(kkk)*im_unit - Lambda(jjj + 1)) END DO - dLambda(kkk) = vec_Sigma_c_gw(n_level_gw, kkk)-func_val + dLambda(kkk) = vec_Sigma_c_gw(n_level_gw, kkk) - func_val END DO rho1 = SUM(dLambda*dLambda) @@ -3286,16 +3286,16 @@ SUBROUTINE fit_and_continuation_2pole(vec_gw_energ, vec_gw_energ_error_fit, vec_ mat_B_gw = (0.0_dp, 0.0_dp) DO iii = 1, num_fit_points mat_B_gw(iii, 1) = 1.0_dp - mat_B_gw(iii, num_var+1) = im_unit + mat_B_gw(iii, num_var + 1) = im_unit END DO DO iii = 1, num_poles jjj = iii*2 DO kkk = 1, num_fit_points - mat_B_gw(kkk, jjj) = 1.0_dp/(im_unit*vec_omega_fit_gw_sign(kkk)-Lambda(jjj+1)) - mat_B_gw(kkk, jjj+num_var) = im_unit/(im_unit*vec_omega_fit_gw_sign(kkk)-Lambda(jjj+1)) - mat_B_gw(kkk, jjj+1) = Lambda(jjj)/(im_unit*vec_omega_fit_gw_sign(kkk)-Lambda(jjj+1))**2 - mat_B_gw(kkk, jjj+1+num_var) = (-Lambda_Im(jjj)+im_unit*Lambda_Re(jjj))/ & - (im_unit*vec_omega_fit_gw_sign(kkk)-Lambda(jjj+1))**2 + mat_B_gw(kkk, jjj) = 1.0_dp/(im_unit*vec_omega_fit_gw_sign(kkk) - Lambda(jjj + 1)) + mat_B_gw(kkk, jjj + num_var) = im_unit/(im_unit*vec_omega_fit_gw_sign(kkk) - Lambda(jjj + 1)) + mat_B_gw(kkk, jjj + 1) = Lambda(jjj)/(im_unit*vec_omega_fit_gw_sign(kkk) - Lambda(jjj + 1))**2 + mat_B_gw(kkk, jjj + 1 + num_var) = (-Lambda_Im(jjj) + im_unit*Lambda_Re(jjj))/ & + (im_unit*vec_omega_fit_gw_sign(kkk) - Lambda(jjj + 1))**2 END DO END DO @@ -3317,7 +3317,7 @@ SUBROUTINE fit_and_continuation_2pole(vec_gw_energ, vec_gw_energ_error_fit, vec_ ! scale diagonal elements of a_mat DO iii = 1, num_var*2 - mat_A_gw(iii, iii) = mat_A_gw(iii, iii)+ScalParam*mat_A_gw(iii, iii) + mat_A_gw(iii, iii) = mat_A_gw(iii, iii) + ScalParam*mat_A_gw(iii, iii) END DO ! solve linear system @@ -3333,7 +3333,7 @@ SUBROUTINE fit_and_continuation_2pole(vec_gw_energ, vec_gw_energ_error_fit, vec_ CALL timestop(handle4) DO iii = 1, num_var - Lambda(iii) = Lambda_Re(iii)+im_unit*Lambda_Im(iii)+vec_b_gw(iii)+vec_b_gw(iii+num_var) + Lambda(iii) = Lambda_Re(iii) + im_unit*Lambda_Im(iii) + vec_b_gw(iii) + vec_b_gw(iii + num_var) END DO ! calculate chi2 @@ -3346,10 +3346,10 @@ SUBROUTINE fit_and_continuation_2pole(vec_gw_energ, vec_gw_energ_error_fit, vec_ IF (chi2 < chi2_old) THEN ScalParam = MAX(ScalParam/Ldown, 1E-12_dp) DO iii = 1, num_var - Lambda_Re(iii) = Lambda_Re(iii)+REAL(vec_b_gw(iii)+vec_b_gw(iii+num_var)) - Lambda_Im(iii) = Lambda_Im(iii)+AIMAG(vec_b_gw(iii)+vec_b_gw(iii+num_var)) + Lambda_Re(iii) = Lambda_Re(iii) + REAL(vec_b_gw(iii) + vec_b_gw(iii + num_var)) + Lambda_Im(iii) = Lambda_Im(iii) + AIMAG(vec_b_gw(iii) + vec_b_gw(iii + num_var)) END DO - IF (chi2_old/chi2-1.0_dp < stop_crit) could_exit = .TRUE. + IF (chi2_old/chi2 - 1.0_dp < stop_crit) could_exit = .TRUE. chi2_old = chi2 ELSE ScalParam = ScalParam*Lup @@ -3368,11 +3368,11 @@ SUBROUTINE fit_and_continuation_2pole(vec_gw_energ, vec_gw_energ_error_fit, vec_ DO iii = 1, num_poles jjj = iii*2 ! calculate value of the fit function - func_val = func_val+Lambda(jjj)/(-Lambda(jjj+1)) + func_val = func_val + Lambda(jjj)/(-Lambda(jjj + 1)) END DO - Lambda_Re(1) = Lambda_Re(1)-REAL(func_val)+REAL(vec_Sigma_c_gw(n_level_gw, num_fit_points)) - Lambda_Im(1) = Lambda_Im(1)-AIMAG(func_val)+AIMAG(vec_Sigma_c_gw(n_level_gw, num_fit_points)) + Lambda_Re(1) = Lambda_Re(1) - REAL(func_val) + REAL(vec_Sigma_c_gw(n_level_gw, num_fit_points)) + Lambda_Im(1) = Lambda_Im(1) - AIMAG(func_val) + AIMAG(vec_Sigma_c_gw(n_level_gw, num_fit_points)) END IF @@ -3402,7 +3402,7 @@ SUBROUTINE fit_and_continuation_2pole(vec_gw_energ, vec_gw_energ_error_fit, vec_ DO iii = 1, num_poles jjj = iii*2 ! calculate value of the fit function - func_val = func_val+Lambda(jjj)/(im_unit*vec_omega_fit_gw_sign(kkk)-Lambda(jjj+1)) + func_val = func_val + Lambda(jjj)/(im_unit*vec_omega_fit_gw_sign(kkk) - Lambda(jjj + 1)) END DO WRITE (output_unit, '(1F16.3,4F16.5)') vec_omega_fit_gw_sign(kkk)*evolt, REAL(func_val)*evolt, & AIMAG(func_val)*evolt, REAL(vec_Sigma_c_gw(n_level_gw, kkk))*evolt, & @@ -3416,14 +3416,14 @@ SUBROUTINE fit_and_continuation_2pole(vec_gw_energ, vec_gw_energ_error_fit, vec_ IF (do_gw_im_time) THEN ! for cubic-scaling GW, we have one Green's function for occ and virt states with the Fermi level ! in the middle of homo and lumo - e_fermi = 0.5_dp*(Eigenval(homo)+Eigenval(homo+1)) + e_fermi = 0.5_dp*(Eigenval(homo) + Eigenval(homo + 1)) ELSE ! in case of O(N^4) GW, we have the Fermi level differently for occ and virt states, see ! Fig. 1 in JCTC 12, 3623-3635 (2016) IF (n_level_gw <= gw_corr_lev_occ) THEN - e_fermi = Eigenval(homo)+fermi_level_offset + e_fermi = Eigenval(homo) + fermi_level_offset ELSE - e_fermi = Eigenval(homo+1)-fermi_level_offset + e_fermi = Eigenval(homo + 1) - fermi_level_offset END IF END IF @@ -3435,7 +3435,7 @@ SUBROUTINE fit_and_continuation_2pole(vec_gw_energ, vec_gw_energ_error_fit, vec_ func_val = Lambda(1) DO iii = 1, num_poles jjj = iii*2 - func_val = func_val+Lambda(jjj)/(Eigenval(n_level_gw_ref)-e_fermi-Lambda(jjj+1)) + func_val = func_val + Lambda(jjj)/(Eigenval(n_level_gw_ref) - e_fermi - Lambda(jjj + 1)) END DO gw_energ = REAL(func_val) @@ -3449,12 +3449,12 @@ SUBROUTINE fit_and_continuation_2pole(vec_gw_energ, vec_gw_energ_error_fit, vec_ z_value(n_level_gw) = 1.0_dp DO iii = 1, num_poles jjj = iii*2 - z_value(n_level_gw) = z_value(n_level_gw)+REAL(Lambda(jjj)/ & - (Eigenval(n_level_gw_ref)-e_fermi-Lambda(jjj+1))**2) - func_val = func_val+Lambda(jjj)/(Eigenval(n_level_gw_ref)-e_fermi-Lambda(jjj+1)) + z_value(n_level_gw) = z_value(n_level_gw) + REAL(Lambda(jjj)/ & + (Eigenval(n_level_gw_ref) - e_fermi - Lambda(jjj + 1))**2) + func_val = func_val + Lambda(jjj)/(Eigenval(n_level_gw_ref) - e_fermi - Lambda(jjj + 1)) END DO ! m is the slope of the correl self-energy - m_value(n_level_gw) = 1.0_dp-z_value(n_level_gw) + m_value(n_level_gw) = 1.0_dp - z_value(n_level_gw) z_value(n_level_gw) = 1.0_dp/z_value(n_level_gw) gw_energ = REAL(func_val) vec_gw_energ(n_level_gw) = gw_energ @@ -3462,9 +3462,9 @@ SUBROUTINE fit_and_continuation_2pole(vec_gw_energ, vec_gw_energ_error_fit, vec_ ! in case one wants to do Newton-Raphson on top of the Z-shot IF (crossing_search == ri_rpa_g0w0_crossing_newton) THEN - level_energ_GW = (Eigenval_scf(n_level_gw_ref)- & - m_value(n_level_gw)*Eigenval(n_level_gw_ref)+ & - vec_gw_energ(n_level_gw)+ & + level_energ_GW = (Eigenval_scf(n_level_gw_ref) - & + m_value(n_level_gw)*Eigenval(n_level_gw_ref) + & + vec_gw_energ(n_level_gw) + & vec_Sigma_x_minus_vxc_gw(n_level_gw_ref))* & z_value(n_level_gw) @@ -3476,24 +3476,24 @@ SUBROUTINE fit_and_continuation_2pole(vec_gw_energ, vec_gw_energ_error_fit, vec_ z_value(n_level_gw) = 1.0_dp DO iii = 1, num_poles jjj = iii*2 - func_val = func_val+Lambda(jjj)/(level_energ_GW-e_fermi-Lambda(jjj+1)) + func_val = func_val + Lambda(jjj)/(level_energ_GW - e_fermi - Lambda(jjj + 1)) END DO ! calculate the derivative of the fit function for level_energ_GW deriv_val_real = -1.0_dp DO iii = 1, num_poles jjj = iii*2 - deriv_val_real = deriv_val_real+REAL(Lambda(jjj))/((ABS(level_energ_GW-e_fermi-Lambda(jjj+1)))**2) & - -(REAL(Lambda(jjj))*(level_energ_GW-e_fermi)-REAL(Lambda(jjj)*CONJG(Lambda(jjj+1))))* & - 2.0_dp*(level_energ_GW-e_fermi-REAL(Lambda(jjj+1)))/ & - ((ABS(level_energ_GW-e_fermi-Lambda(jjj+1)))**2) + deriv_val_real = deriv_val_real + REAL(Lambda(jjj))/((ABS(level_energ_GW - e_fermi - Lambda(jjj + 1)))**2) & + - (REAL(Lambda(jjj))*(level_energ_GW - e_fermi) - REAL(Lambda(jjj)*CONJG(Lambda(jjj + 1))))* & + 2.0_dp*(level_energ_GW - e_fermi - REAL(Lambda(jjj + 1)))/ & + ((ABS(level_energ_GW - e_fermi - Lambda(jjj + 1)))**2) END DO - delta = (Eigenval_scf(n_level_gw_ref)+vec_Sigma_x_minus_vxc_gw(n_level_gw_ref)+REAL(func_val)-level_energ_GW)/ & + delta = (Eigenval_scf(n_level_gw_ref) + vec_Sigma_x_minus_vxc_gw(n_level_gw_ref) + REAL(func_val) - level_energ_GW)/ & deriv_val_real - level_energ_GW = level_energ_GW-delta + level_energ_GW = level_energ_GW - delta IF (ABS(delta) < 1.0E-08) EXIT @@ -3560,13 +3560,13 @@ SUBROUTINE fit_and_continuation_2pole(vec_gw_energ, vec_gw_energ_error_fit, vec_ vec_gw_energ_error_fit(n_level_gw) = 0.0_dp DO kkk = 1, num_poles - vec_gw_energ_error_fit(n_level_gw) = vec_gw_energ_error_fit(n_level_gw)+ & - (stat_errors(4*kkk-1)+stat_errors(4*kkk))* & - ABS(1.0_dp/(Eigenval(n_level_gw_ref)-e_fermi-Lambda(2*kkk+1))- & - 1.0_dp/(-Lambda(2*kkk+1)))+ & - (stat_errors(4*kkk+1)+stat_errors(4*kkk+2))*ABS(Lambda(2*kkk))* & - ABS(1.0_dp/(Eigenval(n_level_gw_ref)-e_fermi-Lambda(2*kkk+1))**2- & - 1.0_dp/(-Lambda(2*kkk+1))**2) + vec_gw_energ_error_fit(n_level_gw) = vec_gw_energ_error_fit(n_level_gw) + & + (stat_errors(4*kkk - 1) + stat_errors(4*kkk))* & + ABS(1.0_dp/(Eigenval(n_level_gw_ref) - e_fermi - Lambda(2*kkk + 1)) - & + 1.0_dp/(-Lambda(2*kkk + 1))) + & + (stat_errors(4*kkk + 1) + stat_errors(4*kkk + 2))*ABS(Lambda(2*kkk))* & + ABS(1.0_dp/(Eigenval(n_level_gw_ref) - e_fermi - Lambda(2*kkk + 1))**2 - & + 1.0_dp/(-Lambda(2*kkk + 1))**2) END DO DEALLOCATE (mat_N_gw) @@ -3661,18 +3661,18 @@ SUBROUTINE continuation_pade(vec_gw_energ, vec_omega_fit_gw, & IF (do_gw_im_time) THEN ! for cubic-scaling GW, we have one Green's function for occ and virt states with the Fermi level ! in the middle of homo and lumo - e_fermi = 0.5_dp*(Eigenval(homo)+Eigenval(homo+1)) + e_fermi = 0.5_dp*(Eigenval(homo) + Eigenval(homo + 1)) ELSE ! in case of O(N^4) GW, we have the Fermi level differently for occ and virt states, see ! Fig. 1 in JCTC 12, 3623-3635 (2016) IF (n_level_gw <= gw_corr_lev_occ) THEN - e_fermi = Eigenval(homo)+fermi_level_offset + e_fermi = Eigenval(homo) + fermi_level_offset ELSE - e_fermi = Eigenval(homo+1)-fermi_level_offset + e_fermi = Eigenval(homo + 1) - fermi_level_offset END IF END IF - n_level_gw_ref = n_level_gw+homo-gw_corr_lev_occ + n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ !*** reorder, such that omega=i*0 is first entry ALLOCATE (Sigma_c_gw_reorder(num_fit_points)) @@ -3685,8 +3685,8 @@ SUBROUTINE continuation_pade(vec_gw_energ, vec_omega_fit_gw, & ENDDO ELSE DO jquad = 1, num_fit_points - Sigma_c_gw_reorder(jquad) = vec_Sigma_c_gw(n_level_gw, num_fit_points-jquad+1) - vec_omega_fit_gw_sign_reorder(jquad) = vec_omega_fit_gw_sign(num_fit_points-jquad+1) + Sigma_c_gw_reorder(jquad) = vec_Sigma_c_gw(n_level_gw, num_fit_points - jquad + 1) + vec_omega_fit_gw_sign_reorder(jquad) = vec_omega_fit_gw_sign(num_fit_points - jquad + 1) ENDDO ENDIF @@ -3705,14 +3705,14 @@ SUBROUTINE continuation_pade(vec_gw_energ, vec_omega_fit_gw, & !*** calculate start_value for iterative cross-searching methods IF ((crossing_search == ri_rpa_g0w0_crossing_bisection) .OR. & (crossing_search == ri_rpa_g0w0_crossing_newton)) THEN - energy_val = Eigenval(n_level_gw_ref)-e_fermi + energy_val = Eigenval(n_level_gw_ref) - e_fermi CALL evaluate_pade_function(energy_val, nparam_pade, omega_points_pade, & coeff_pade, sigma_c_pade) CALL get_z_and_m_value_pade(energy_val, nparam_pade, omega_points_pade, & coeff_pade, z_value(n_level_gw), m_value(n_level_gw)) - level_energ_GW = (Eigenval_scf(n_level_gw_ref)- & - m_value(n_level_gw)*Eigenval(n_level_gw_ref)+ & - REAL(sigma_c_pade)+ & + level_energ_GW = (Eigenval_scf(n_level_gw_ref) - & + m_value(n_level_gw)*Eigenval(n_level_gw_ref) + & + REAL(sigma_c_pade) + & vec_Sigma_x_minus_vxc_gw(n_level_gw_ref))* & z_value(n_level_gw) ENDIF @@ -3720,13 +3720,13 @@ SUBROUTINE continuation_pade(vec_gw_energ, vec_omega_fit_gw, & !*** perform crossing search SELECT CASE (crossing_search) CASE (ri_rpa_g0w0_crossing_none) - energy_val = Eigenval(n_level_gw_ref)-e_fermi + energy_val = Eigenval(n_level_gw_ref) - e_fermi CALL evaluate_pade_function(energy_val, nparam_pade, omega_points_pade, & coeff_pade, sigma_c_pade) vec_gw_energ(n_level_gw) = REAL(sigma_c_pade) CASE (ri_rpa_g0w0_crossing_z_shot) - energy_val = Eigenval(n_level_gw_ref)-e_fermi + energy_val = Eigenval(n_level_gw_ref) - e_fermi CALL evaluate_pade_function(energy_val, nparam_pade, omega_points_pade, & coeff_pade, sigma_c_pade) vec_gw_energ(n_level_gw) = REAL(sigma_c_pade) @@ -3792,17 +3792,17 @@ SUBROUTINE get_pade_parameters(y, x, num_fit_points, nparam, xpoints, coeff) im_unit = (0.0_dp, 1.0_dp) - nstep = INT(num_fit_points/(nparam-1)) + nstep = INT(num_fit_points/(nparam - 1)) CPASSERT(LBOUND(x, 1) == 1) CPASSERT(LBOUND(y, 1) == 1) ALLOCATE (ypoints(nparam)) !omega=i0 is in element x(1) idat = 1 - DO iparam = 1, nparam-1 + DO iparam = 1, nparam - 1 xpoints(iparam) = im_unit*x(idat) ypoints(iparam) = y(idat) - idat = idat+nstep + idat = idat + nstep ENDDO xpoints(nparam) = im_unit*x(num_fit_points) ypoints(nparam) = y(num_fit_points) @@ -3813,8 +3813,8 @@ SUBROUTINE get_pade_parameters(y, x, num_fit_points, nparam, xpoints, coeff) g_mat(:, 1) = ypoints(:) DO iparam = 2, nparam DO idat = iparam, nparam - g_mat(idat, iparam) = (g_mat(iparam-1, iparam-1)-g_mat(idat, iparam-1))/ & - ((xpoints(idat)-xpoints(iparam-1))*g_mat(idat, iparam-1)) + g_mat(idat, iparam) = (g_mat(iparam - 1, iparam - 1) - g_mat(idat, iparam - 1))/ & + ((xpoints(idat) - xpoints(iparam - 1))*g_mat(idat, iparam - 1)) ENDDO ENDDO @@ -3857,7 +3857,7 @@ SUBROUTINE evaluate_pade_function(x_val, nparam, xpoints, coeff, func_val) func_val = re_unit DO iparam = nparam, 2, -1 - func_val = re_unit+coeff(iparam)*(re_unit*x_val-xpoints(iparam-1))/func_val + func_val = re_unit + coeff(iparam)*(re_unit*x_val - xpoints(iparam - 1))/func_val ENDDO func_val = coeff(1)/func_val @@ -3896,19 +3896,19 @@ SUBROUTINE get_z_and_m_value_pade(x_val, nparam, xpoints, coeff, z_value, m_valu func_val = re_unit dev_val = (0.0_dp, 0.0_dp) DO iparam = nparam, 2, -1 - numerator = coeff(iparam)*(re_unit*x_val-xpoints(iparam-1)) + numerator = coeff(iparam)*(re_unit*x_val - xpoints(iparam - 1)) dev_numerator = coeff(iparam)*re_unit denominator = func_val dev_denominator = dev_val - dev_val = dev_numerator/denominator-(numerator*dev_denominator)/(denominator**2) - func_val = re_unit+coeff(iparam)*(re_unit*x_val-xpoints(iparam-1))/func_val + dev_val = dev_numerator/denominator - (numerator*dev_denominator)/(denominator**2) + func_val = re_unit + coeff(iparam)*(re_unit*x_val - xpoints(iparam - 1))/func_val ENDDO dev_val = -1.0_dp*coeff(1)/(func_val**2)*dev_val func_val = coeff(1)/func_val IF (PRESENT(z_value)) THEN - z_value = 1.0_dp-REAL(dev_val) + z_value = 1.0_dp - REAL(dev_val) z_value = 1.0_dp/z_value ENDIF IF (PRESENT(m_value)) m_value = REAL(dev_val) @@ -3960,14 +3960,14 @@ SUBROUTINE get_sigma_c_bisection_pade(gw_energ, Eigenval_scf, Sigma_x_minus_vxc_ icount = 0 DO WHILE (ABS(delta) > threshold) - icount = icount+1 - qp_energy = qp_energy_old+0.5_dp*delta + icount = icount + 1 + qp_energy = qp_energy_old + 0.5_dp*delta qp_energy_old = qp_energy - energy_val = qp_energy-e_fermi + energy_val = qp_energy - e_fermi CALL evaluate_pade_function(energy_val, nparam_pade, omega_points_pade, & coeff_pade, sigma_c) - qp_energy = Eigenval_scf+REAL(sigma_c)+Sigma_x_minus_vxc_gw - delta = qp_energy-qp_energy_old + qp_energy = Eigenval_scf + REAL(sigma_c) + Sigma_x_minus_vxc_gw + delta = qp_energy - qp_energy_old IF (icount > 500) THEN CPABORT("Self-consistent quasi-particle solution not found") EXIT @@ -4026,17 +4026,17 @@ SUBROUTINE get_sigma_c_newton_pade(gw_energ, Eigenval_scf, Sigma_x_minus_vxc_gw, icount = 0 DO WHILE (ABS(delta) > threshold) - icount = icount+1 - energy_val = qp_energy-e_fermi + icount = icount + 1 + energy_val = qp_energy - e_fermi CALL evaluate_pade_function(energy_val, nparam_pade, omega_points_pade, & coeff_pade, sigma_c) !get m_value --> derivative of function CALL get_z_and_m_value_pade(energy_val, nparam_pade, omega_points_pade, & coeff_pade, m_value=m_value) qp_energy_old = qp_energy - qp_energy = qp_energy-(Eigenval_scf+Sigma_x_minus_vxc_gw+REAL(sigma_c)-qp_energy)/ & - (m_value-1.0_dp) - delta = qp_energy-qp_energy_old + qp_energy = qp_energy - (Eigenval_scf + Sigma_x_minus_vxc_gw + REAL(sigma_c) - qp_energy)/ & + (m_value - 1.0_dp) + delta = qp_energy - qp_energy_old IF (icount > 500) THEN CPABORT("Self-consistent quasi-particle solution not found") EXIT @@ -4090,8 +4090,8 @@ SUBROUTINE check_fit_pade(vec_omega_fit_gw_sign, Sigma_c_gw, & DO kkk = 1, num_fit_points func_val = re_unit DO iparam = nparam_pade, 2, -1 - func_val = re_unit+coeff_pade(iparam) & - *(im_unit*vec_omega_fit_gw_sign(kkk)-omega_points_pade(iparam-1))/func_val + func_val = re_unit + coeff_pade(iparam) & + *(im_unit*vec_omega_fit_gw_sign(kkk) - omega_points_pade(iparam - 1))/func_val ENDDO func_val = coeff_pade(1)/func_val @@ -4219,8 +4219,8 @@ SUBROUTINE print_and_update_for_ev_sc(vec_gw_energ, vec_gw_energ_error_fit, & IF (crossing_search == ri_rpa_g0w0_crossing_none) THEN DO n_level_gw = 1, gw_corr_lev_tot - n_level_gw_ref = n_level_gw+homo-gw_corr_lev_occ - new_energy = Eigenval_scf(n_level_gw_ref)+vec_gw_energ(n_level_gw)+ & + n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ + new_energy = Eigenval_scf(n_level_gw_ref) + vec_gw_energ(n_level_gw) + & vec_Sigma_x_minus_vxc_gw(n_level_gw_ref) is_energy_okay = .TRUE. @@ -4247,7 +4247,7 @@ SUBROUTINE print_and_update_for_ev_sc(vec_gw_energ, vec_gw_energ_error_fit, & END IF DO n_level_gw = 1, gw_corr_lev_tot - n_level_gw_ref = n_level_gw+homo-gw_corr_lev_occ + n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ IF (n_level_gw <= gw_corr_lev_occ) THEN occ_virt = 'occ' ELSE @@ -4277,11 +4277,11 @@ SUBROUTINE print_and_update_for_ev_sc(vec_gw_energ, vec_gw_energ_error_fit, & DO n_level_gw = 1, gw_corr_lev_tot - n_level_gw_ref = n_level_gw+homo-gw_corr_lev_occ + n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ - new_energy = (Eigenval_scf(n_level_gw_ref)- & - m_value(n_level_gw)*Eigenval(n_level_gw_ref)+ & - vec_gw_energ(n_level_gw)+ & + new_energy = (Eigenval_scf(n_level_gw_ref) - & + m_value(n_level_gw)*Eigenval(n_level_gw_ref) + & + vec_gw_energ(n_level_gw) + & vec_Sigma_x_minus_vxc_gw(n_level_gw_ref))* & z_value(n_level_gw) @@ -4308,7 +4308,7 @@ SUBROUTINE print_and_update_for_ev_sc(vec_gw_energ, vec_gw_energ_error_fit, & END IF DO n_level_gw = 1, gw_corr_lev_tot - n_level_gw_ref = n_level_gw+homo-gw_corr_lev_occ + n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ IF (n_level_gw <= gw_corr_lev_occ) THEN occ_virt = 'occ' ELSE @@ -4337,13 +4337,13 @@ SUBROUTINE print_and_update_for_ev_sc(vec_gw_energ, vec_gw_energ_error_fit, & IF (unit_nr > 0) THEN IF (do_closed_shell) THEN WRITE (unit_nr, '(T3,A)') ' ' - WRITE (unit_nr, '(T3,A,F57.2)') 'GW HOMO-LUMO gap (eV)', (Eigenval(homo+1)-Eigenval(homo))*evolt + WRITE (unit_nr, '(T3,A,F57.2)') 'GW HOMO-LUMO gap (eV)', (Eigenval(homo + 1) - Eigenval(homo))*evolt ELSE IF (my_do_alpha) THEN WRITE (unit_nr, '(T3,A)') ' ' - WRITE (unit_nr, '(T3,A,F51.2)') 'Alpha GW HOMO-LUMO gap (eV)', (Eigenval(homo+1)-Eigenval(homo))*evolt + WRITE (unit_nr, '(T3,A,F51.2)') 'Alpha GW HOMO-LUMO gap (eV)', (Eigenval(homo + 1) - Eigenval(homo))*evolt ELSE IF (my_do_beta) THEN WRITE (unit_nr, '(T3,A)') ' ' - WRITE (unit_nr, '(T3,A,F52.2)') 'Beta GW HOMO-LUMO gap (eV)', (Eigenval(homo+1)-Eigenval(homo))*evolt + WRITE (unit_nr, '(T3,A,F52.2)') 'Beta GW HOMO-LUMO gap (eV)', (Eigenval(homo + 1) - Eigenval(homo))*evolt END IF END IF @@ -4361,32 +4361,32 @@ SUBROUTINE print_and_update_for_ev_sc(vec_gw_energ, vec_gw_energ_error_fit, & eigen_diff = 0.0_dp DO n_level_gw = 1, gw_corr_lev_occ - n_level_gw_ref = n_level_gw+homo-gw_corr_lev_occ - eigen_diff = eigen_diff+Eigenval(n_level_gw_ref)-Eigenval_last(n_level_gw_ref) + n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ + eigen_diff = eigen_diff + Eigenval(n_level_gw_ref) - Eigenval_last(n_level_gw_ref) END DO eigen_diff = eigen_diff/gw_corr_lev_occ ! correct the eigenvalues of the occupied orbitals which have not been corrected by GW - DO n_level_gw = 1, homo-gw_corr_lev_occ - Eigenval(n_level_gw) = Eigenval(n_level_gw)+eigen_diff + DO n_level_gw = 1, homo - gw_corr_lev_occ + Eigenval(n_level_gw) = Eigenval(n_level_gw) + eigen_diff END DO END IF ! 2) the virtual: check if there are virtual orbitals not being corrected by GW - IF (gw_corr_lev_virt < nmo-homo .AND. gw_corr_lev_virt > 0) THEN + IF (gw_corr_lev_virt < nmo - homo .AND. gw_corr_lev_virt > 0) THEN ! calculate average GW correction for virtual orbitals eigen_diff = 0.0_dp DO n_level_gw = 1, gw_corr_lev_virt - n_level_gw_ref = n_level_gw+homo - eigen_diff = eigen_diff+Eigenval(n_level_gw_ref)-Eigenval_last(n_level_gw_ref) + n_level_gw_ref = n_level_gw + homo + eigen_diff = eigen_diff + Eigenval(n_level_gw_ref) - Eigenval_last(n_level_gw_ref) END DO eigen_diff = eigen_diff/gw_corr_lev_virt ! correct the eigenvalues of the virtual orbitals which have not been corrected by GW - DO n_level_gw = homo+gw_corr_lev_virt+1, nmo - Eigenval(n_level_gw) = Eigenval(n_level_gw)+eigen_diff + DO n_level_gw = homo + gw_corr_lev_virt + 1, nmo + Eigenval(n_level_gw) = Eigenval(n_level_gw) + eigen_diff END DO END IF @@ -4437,7 +4437,7 @@ SUBROUTINE calc_mat_N(N_ij, Lambda, Sigma_c, vec_omega_fit_gw, i, j, & CALL timeset(routineN, handle) - num_var = 2*num_poles+1 + num_var = 2*num_poles + 1 ALLOCATE (Lambda_tmp(num_var)) Lambda_tmp = (0.0_dp, 0.0_dp) chi2_sum = 0.0_dp @@ -4452,45 +4452,45 @@ SUBROUTINE calc_mat_N(N_ij, Lambda, Sigma_c, vec_omega_fit_gw, i, j, & ! Fitting parameters with offset h Lambda_tmp(:) = Lambda(:) IF (MODULO(i, 2) == 0) THEN - Lambda_tmp(i/2) = Lambda_tmp(i/2)+h*re_unit + Lambda_tmp(i/2) = Lambda_tmp(i/2) + h*re_unit ELSE - Lambda_tmp((i+1)/2) = Lambda_tmp((i+1)/2)+h*im_unit + Lambda_tmp((i + 1)/2) = Lambda_tmp((i + 1)/2) + h*im_unit END IF IF (MODULO(j, 2) == 0) THEN - Lambda_tmp(j/2) = Lambda_tmp(j/2)+h*re_unit + Lambda_tmp(j/2) = Lambda_tmp(j/2) + h*re_unit ELSE - Lambda_tmp((j+1)/2) = Lambda_tmp((j+1)/2)+h*im_unit + Lambda_tmp((j + 1)/2) = Lambda_tmp((j + 1)/2) + h*im_unit END IF CALL calc_chi2(chi2, Lambda_tmp, Sigma_c, vec_omega_fit_gw, num_poles, & num_fit_points, n_level_gw) - chi2_sum = chi2_sum+chi2 + chi2_sum = chi2_sum + chi2 IF (MODULO(i, 2) == 0) THEN - Lambda_tmp(i/2) = Lambda_tmp(i/2)-2.0_dp*h*re_unit + Lambda_tmp(i/2) = Lambda_tmp(i/2) - 2.0_dp*h*re_unit ELSE - Lambda_tmp((i+1)/2) = Lambda_tmp((i+1)/2)-2.0_dp*h*im_unit + Lambda_tmp((i + 1)/2) = Lambda_tmp((i + 1)/2) - 2.0_dp*h*im_unit END IF CALL calc_chi2(chi2, Lambda_tmp, Sigma_c, vec_omega_fit_gw, num_poles, & num_fit_points, n_level_gw) - chi2_sum = chi2_sum-chi2 + chi2_sum = chi2_sum - chi2 IF (MODULO(j, 2) == 0) THEN - Lambda_tmp(j/2) = Lambda_tmp(j/2)-2.0_dp*h*re_unit + Lambda_tmp(j/2) = Lambda_tmp(j/2) - 2.0_dp*h*re_unit ELSE - Lambda_tmp((j+1)/2) = Lambda_tmp((j+1)/2)-2.0_dp*h*im_unit + Lambda_tmp((j + 1)/2) = Lambda_tmp((j + 1)/2) - 2.0_dp*h*im_unit END IF CALL calc_chi2(chi2, Lambda_tmp, Sigma_c, vec_omega_fit_gw, num_poles, & num_fit_points, n_level_gw) - chi2_sum = chi2_sum+chi2 + chi2_sum = chi2_sum + chi2 IF (MODULO(i, 2) == 0) THEN - Lambda_tmp(i/2) = Lambda_tmp(i/2)+2.0_dp*h*re_unit + Lambda_tmp(i/2) = Lambda_tmp(i/2) + 2.0_dp*h*re_unit ELSE - Lambda_tmp((i+1)/2) = Lambda_tmp((i+1)/2)+2.0_dp*h*im_unit + Lambda_tmp((i + 1)/2) = Lambda_tmp((i + 1)/2) + 2.0_dp*h*im_unit END IF CALL calc_chi2(chi2, Lambda_tmp, Sigma_c, vec_omega_fit_gw, num_poles, & num_fit_points, n_level_gw) - chi2_sum = chi2_sum-chi2 + chi2_sum = chi2_sum - chi2 ! Second derivative with symmetric difference quotient N_ij = 1.0_dp/2.0_dp*chi2_sum/(4.0_dp*h*h) @@ -4535,9 +4535,9 @@ SUBROUTINE calc_chi2(chi2, Lambda, Sigma_c, vec_omega_fit_gw, num_poles, & DO iii = 1, num_poles jjj = iii*2 ! calculate value of the fit function - func_val = func_val+Lambda(jjj)/(im_unit*vec_omega_fit_gw(kkk)-Lambda(jjj+1)) + func_val = func_val + Lambda(jjj)/(im_unit*vec_omega_fit_gw(kkk) - Lambda(jjj + 1)) END DO - chi2 = chi2+(ABS(Sigma_c(n_level_gw, kkk)-func_val))**2 + chi2 = chi2 + (ABS(Sigma_c(n_level_gw, kkk) - func_val))**2 END DO CALL timestop(handle) @@ -4612,7 +4612,7 @@ SUBROUTINE apply_ic_corr(Eigenval, Eigenval_scf, ic_corr_list, & WRITE (unit_nr, *) ' ' DO n_level_gw = 1, gw_corr_lev_tot - n_level_gw_ref = n_level_gw+homo-gw_corr_lev_occ + n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ IF (n_level_gw <= gw_corr_lev_occ) THEN occ_virt = 'occ' ELSE @@ -4623,7 +4623,7 @@ SUBROUTINE apply_ic_corr(Eigenval, Eigenval_scf, ic_corr_list, & n_level_gw_ref, ' ( ', occ_virt, ') ', & Eigenval(n_level_gw_ref)*evolt, & ic_corr_list(n_level_gw)*evolt, & - (Eigenval(n_level_gw_ref)+ic_corr_list(n_level_gw))*evolt + (Eigenval(n_level_gw_ref) + ic_corr_list(n_level_gw))*evolt END DO @@ -4631,22 +4631,22 @@ SUBROUTINE apply_ic_corr(Eigenval, Eigenval_scf, ic_corr_list, & END IF - Eigenval(homo-gw_corr_lev_occ+1:homo+gw_corr_lev_virt) = Eigenval(homo-gw_corr_lev_occ+1: & - homo+gw_corr_lev_virt) & - +ic_corr_list(1:gw_corr_lev_tot) + Eigenval(homo - gw_corr_lev_occ + 1:homo + gw_corr_lev_virt) = Eigenval(homo - gw_corr_lev_occ + 1: & + homo + gw_corr_lev_virt) & + + ic_corr_list(1:gw_corr_lev_tot) - Eigenval_scf(homo-gw_corr_lev_occ+1:homo+gw_corr_lev_virt) = Eigenval_scf(homo-gw_corr_lev_occ+1: & - homo+gw_corr_lev_virt) & - +ic_corr_list(1:gw_corr_lev_tot) + Eigenval_scf(homo - gw_corr_lev_occ + 1:homo + gw_corr_lev_virt) = Eigenval_scf(homo - gw_corr_lev_occ + 1: & + homo + gw_corr_lev_virt) & + + ic_corr_list(1:gw_corr_lev_tot) IF (unit_nr > 0) THEN IF (do_closed_shell) THEN - WRITE (unit_nr, '(T3,A,F52.2)') 'G0W0 IC HOMO-LUMO gap (eV)', Eigenval(homo+1)-Eigenval(homo) + WRITE (unit_nr, '(T3,A,F52.2)') 'G0W0 IC HOMO-LUMO gap (eV)', Eigenval(homo + 1) - Eigenval(homo) ELSE IF (my_do_alpha) THEN - WRITE (unit_nr, '(T3,A,F46.2)') 'G0W0 Alpha IC HOMO-LUMO gap (eV)', Eigenval(homo+1)-Eigenval(homo) + WRITE (unit_nr, '(T3,A,F46.2)') 'G0W0 Alpha IC HOMO-LUMO gap (eV)', Eigenval(homo + 1) - Eigenval(homo) ELSE IF (my_do_beta) THEN - WRITE (unit_nr, '(T3,A,F47.2)') 'G0W0 Beta IC HOMO-LUMO gap (eV)', Eigenval(homo+1)-Eigenval(homo) + WRITE (unit_nr, '(T3,A,F47.2)') 'G0W0 Beta IC HOMO-LUMO gap (eV)', Eigenval(homo + 1) - Eigenval(homo) END IF WRITE (unit_nr, *) ' ' @@ -4661,32 +4661,32 @@ SUBROUTINE apply_ic_corr(Eigenval, Eigenval_scf, ic_corr_list, & eigen_diff = 0.0_dp DO n_level_gw = 1, gw_corr_lev_occ - eigen_diff = eigen_diff+ic_corr_list(n_level_gw) + eigen_diff = eigen_diff + ic_corr_list(n_level_gw) END DO eigen_diff = eigen_diff/gw_corr_lev_occ ! correct the eigenvalues of the occupied orbitals which have not been corrected by the IC model - DO n_level_gw = 1, homo-gw_corr_lev_occ - Eigenval(n_level_gw) = Eigenval(n_level_gw)+eigen_diff - Eigenval_scf(n_level_gw) = Eigenval_scf(n_level_gw)+eigen_diff + DO n_level_gw = 1, homo - gw_corr_lev_occ + Eigenval(n_level_gw) = Eigenval(n_level_gw) + eigen_diff + Eigenval_scf(n_level_gw) = Eigenval_scf(n_level_gw) + eigen_diff END DO END IF ! 2) the virtual: check if there are virtual orbitals not being corrected by the IC model - IF (gw_corr_lev_virt < nmo-homo .AND. gw_corr_lev_virt > 0) THEN + IF (gw_corr_lev_virt < nmo - homo .AND. gw_corr_lev_virt > 0) THEN ! calculate average IC correction for virtual orbitals eigen_diff = 0.0_dp - DO n_level_gw = gw_corr_lev_occ+1, gw_corr_lev_tot - eigen_diff = eigen_diff+ic_corr_list(n_level_gw) + DO n_level_gw = gw_corr_lev_occ + 1, gw_corr_lev_tot + eigen_diff = eigen_diff + ic_corr_list(n_level_gw) END DO eigen_diff = eigen_diff/gw_corr_lev_virt ! correct the eigenvalues of the virtual orbitals which have not been corrected by the IC model - DO n_level_gw = homo+gw_corr_lev_virt+1, nmo - Eigenval(n_level_gw) = Eigenval(n_level_gw)+eigen_diff - Eigenval_scf(n_level_gw) = Eigenval_scf(n_level_gw)+eigen_diff + DO n_level_gw = homo + gw_corr_lev_virt + 1, nmo + Eigenval(n_level_gw) = Eigenval(n_level_gw) + eigen_diff + Eigenval_scf(n_level_gw) = Eigenval_scf(n_level_gw) + eigen_diff END DO END IF @@ -4839,7 +4839,7 @@ SUBROUTINE compute_self_energy_im_time_gw(num_integ_points, nmo, tau_tj, tj, mat ALLOCATE (vec_Sigma_c_gw_sin_omega(gw_corr_lev_tot, num_integ_points)) vec_Sigma_c_gw_sin_omega = 0.0_dp - ALLOCATE (delta_corr_omega(1+homo-gw_corr_lev_occ:homo+gw_corr_lev_virt, num_integ_points)) + ALLOCATE (delta_corr_omega(1 + homo - gw_corr_lev_occ:homo + gw_corr_lev_virt, num_integ_points)) delta_corr_omega(:, :) = (0.0_dp, 0.0_dp) DO jquad = 1, num_integ_points @@ -4902,16 +4902,16 @@ SUBROUTINE compute_self_energy_im_time_gw(num_integ_points, nmo, tau_tj, tj, mat CALL timeset(routineN//"_cubic_GW_operation_5", handle3) - n_level_gw_ref = n_level_gw+homo-gw_corr_lev_occ + n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ CALL timestop(handle3) CALL timeset(routineN//"_cubic_GW_operation_7", handle3) - vec_Sigma_c_gw_cos_tau(n_level_gw, jquad) = 0.5_dp*(vec_Sigma_c_gw_pos_tau(n_level_gw, jquad)+ & + vec_Sigma_c_gw_cos_tau(n_level_gw, jquad) = 0.5_dp*(vec_Sigma_c_gw_pos_tau(n_level_gw, jquad) + & vec_Sigma_c_gw_neg_tau(n_level_gw, jquad)) - vec_Sigma_c_gw_sin_tau(n_level_gw, jquad) = 0.5_dp*(vec_Sigma_c_gw_pos_tau(n_level_gw, jquad)- & + vec_Sigma_c_gw_sin_tau(n_level_gw, jquad) = 0.5_dp*(vec_Sigma_c_gw_pos_tau(n_level_gw, jquad) - & vec_Sigma_c_gw_neg_tau(n_level_gw, jquad)) CALL timestop(handle3) @@ -4934,10 +4934,10 @@ SUBROUTINE compute_self_energy_im_time_gw(num_integ_points, nmo, tau_tj, tj, mat weight_cos = weights_cos_tf_t_to_w(jquad, iquad)*COS(omega*tau) weight_sin = weights_sin_tf_t_to_w(jquad, iquad)*SIN(omega*tau) - vec_Sigma_c_gw_cos_omega(:, jquad) = vec_Sigma_c_gw_cos_omega(:, jquad)+ & + vec_Sigma_c_gw_cos_omega(:, jquad) = vec_Sigma_c_gw_cos_omega(:, jquad) + & weight_cos*vec_Sigma_c_gw_cos_tau(:, iquad) - vec_Sigma_c_gw_sin_omega(:, jquad) = vec_Sigma_c_gw_sin_omega(:, jquad)+ & + vec_Sigma_c_gw_sin_omega(:, jquad) = vec_Sigma_c_gw_sin_omega(:, jquad) + & weight_sin*vec_Sigma_c_gw_sin_tau(:, iquad) END DO @@ -4948,7 +4948,7 @@ SUBROUTINE compute_self_energy_im_time_gw(num_integ_points, nmo, tau_tj, tj, mat ! should be computed with -omega, which results in an additional minus for vec_Sigma_c_gw_sin_omega: vec_Sigma_c_gw_sin_omega(1:gw_corr_lev_occ, :) = -vec_Sigma_c_gw_sin_omega(1:gw_corr_lev_occ, :) - vec_Sigma_c_gw(:, 1:num_fit_points, 1) = vec_Sigma_c_gw_cos_omega(:, 1:num_fit_points)+ & + vec_Sigma_c_gw(:, 1:num_fit_points, 1) = vec_Sigma_c_gw_cos_omega(:, 1:num_fit_points) + & im_unit*vec_Sigma_c_gw_sin_omega(:, 1:num_fit_points) IF (do_ri_Sigma_x .AND. count_ev_sc_GW == 1) THEN @@ -4991,7 +4991,7 @@ SUBROUTINE compute_self_energy_im_time_gw(num_integ_points, nmo, tau_tj, tj, mat CALL timeset(routineN//"_RI_HFX_operation_5", handle3) - n_level_gw_ref = n_level_gw+homo-gw_corr_lev_occ + n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ CALL dbcsr_dot(mat_contr_gf_occ, & mat_contr_W, & @@ -5004,13 +5004,13 @@ SUBROUTINE compute_self_energy_im_time_gw(num_integ_points, nmo, tau_tj, tj, mat IF (my_do_beta) THEN mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw(:, 2, 1) = & - mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw(:, 2, 1)+ & + mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw(:, 2, 1) + & vec_Sigma_x_gw(:, 1) ELSE mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw(:, 1, 1) = & - mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw(:, 1, 1)+ & + mp2_env%ri_g0w0%vec_Sigma_x_minus_vxc_gw(:, 1, 1) + & vec_Sigma_x_gw(:, 1) END IF @@ -5047,7 +5047,7 @@ SUBROUTINE compute_self_energy_im_time_gw(num_integ_points, nmo, tau_tj, tj, mat DO n_level_gw = 1, gw_corr_lev_tot - n_level_gw_ref = n_level_gw+homo-gw_corr_lev_occ + n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ IF (n_level_gw <= gw_corr_lev_occ) THEN sign_occ_virt = -1.0_dp @@ -5060,10 +5060,10 @@ SUBROUTINE compute_self_energy_im_time_gw(num_integ_points, nmo, tau_tj, tj, mat omega_sign = tj(jquad)*sign_occ_virt delta_corr_omega(n_level_gw_ref, jquad) = & - delta_corr_omega(n_level_gw_ref, jquad)- & + delta_corr_omega(n_level_gw_ref, jquad) - & 0.5_dp/pi*weight_i/2.0_dp*delta_corr(n_level_gw_ref)* & - (1.0_dp/(im_unit*(omega_i+omega_sign)+e_fermi-Eigenval(n_level_gw_ref))+ & - 1.0_dp/(im_unit*(-omega_i+omega_sign)+e_fermi-Eigenval(n_level_gw_ref))) + (1.0_dp/(im_unit*(omega_i + omega_sign) + e_fermi - Eigenval(n_level_gw_ref)) + & + 1.0_dp/(im_unit*(-omega_i + omega_sign) + e_fermi - Eigenval(n_level_gw_ref))) END DO @@ -5071,11 +5071,11 @@ SUBROUTINE compute_self_energy_im_time_gw(num_integ_points, nmo, tau_tj, tj, mat END DO - gw_lev_start = 1+homo-gw_corr_lev_occ - gw_lev_end = homo+gw_corr_lev_virt + gw_lev_start = 1 + homo - gw_corr_lev_occ + gw_lev_end = homo + gw_corr_lev_virt ! add the periodic correction - vec_Sigma_c_gw(1:gw_corr_lev_tot, :, 1) = vec_Sigma_c_gw(1:gw_corr_lev_tot, :, 1)+ & + vec_Sigma_c_gw(1:gw_corr_lev_tot, :, 1) = vec_Sigma_c_gw(1:gw_corr_lev_tot, :, 1) + & delta_corr_omega(gw_lev_start:gw_lev_end, 1:num_fit_points) END IF @@ -5141,10 +5141,10 @@ SUBROUTINE compute_Greens_function(mat_greens_fct_occ, mat_greens_fct_virt, matr ! release memory IF (jquad > 1) THEN - CALL dbcsr_set(mat_greens_fct_occ(jquad-1)%matrix, 0.0_dp) - CALL dbcsr_set(mat_greens_fct_virt(jquad-1)%matrix, 0.0_dp) - CALL dbcsr_filter(mat_greens_fct_occ(jquad-1)%matrix, 0.0_dp) - CALL dbcsr_filter(mat_greens_fct_virt(jquad-1)%matrix, 0.0_dp) + CALL dbcsr_set(mat_greens_fct_occ(jquad - 1)%matrix, 0.0_dp) + CALL dbcsr_set(mat_greens_fct_virt(jquad - 1)%matrix, 0.0_dp) + CALL dbcsr_filter(mat_greens_fct_occ(jquad - 1)%matrix, 0.0_dp) + CALL dbcsr_filter(mat_greens_fct_virt(jquad - 1)%matrix, 0.0_dp) END IF tau = tau_tj(jquad) @@ -5165,9 +5165,9 @@ SUBROUTINE compute_Greens_function(mat_greens_fct_occ, mat_greens_fct_virt, matr DO iiB = 1, ncol_local i_global = col_indices(iiB) - IF (ABS(tau*0.5_dp*(Eigenval(i_global)-e_fermi)) < stabilize_exp) THEN + IF (ABS(tau*0.5_dp*(Eigenval(i_global) - e_fermi)) < stabilize_exp) THEN fm_mo_coeff_occ_scaled%local_data(jjB, iiB) = & - fm_mo_coeff_occ%local_data(jjB, iiB)*EXP(tau*0.5_dp*(Eigenval(i_global)-e_fermi)) + fm_mo_coeff_occ%local_data(jjB, iiB)*EXP(tau*0.5_dp*(Eigenval(i_global) - e_fermi)) ELSE fm_mo_coeff_occ_scaled%local_data(jjB, iiB) = 0.0_dp END IF @@ -5180,9 +5180,9 @@ SUBROUTINE compute_Greens_function(mat_greens_fct_occ, mat_greens_fct_virt, matr DO iiB = 1, ncol_local i_global = col_indices(iiB) - IF (ABS(tau*0.5_dp*(Eigenval(i_global)-e_fermi)) < stabilize_exp) THEN + IF (ABS(tau*0.5_dp*(Eigenval(i_global) - e_fermi)) < stabilize_exp) THEN fm_mo_coeff_virt_scaled%local_data(jjB, iiB) = & - fm_mo_coeff_virt%local_data(jjB, iiB)*EXP(-tau*0.5_dp*(Eigenval(i_global)-e_fermi)) + fm_mo_coeff_virt%local_data(jjB, iiB)*EXP(-tau*0.5_dp*(Eigenval(i_global) - e_fermi)) ELSE fm_mo_coeff_virt_scaled%local_data(jjB, iiB) = 0.0_dp END IF diff --git a/src/rpa_gw_ic.F b/src/rpa_gw_ic.F index 77a2cfa668..5b2d5dc403 100644 --- a/src/rpa_gw_ic.F +++ b/src/rpa_gw_ic.F @@ -179,7 +179,7 @@ SUBROUTINE calculate_ic_correction(Eigenval, mat_SinvVSinv, mat_3c_overl_nnP_ic, ' E_n after ic corr' DO n_level_gw = 1, gw_corr_lev_tot - n_level_gw_ref = n_level_gw+homo-gw_corr_lev_occ + n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ IF (n_level_gw <= gw_corr_lev_occ) THEN occ_virt = 'occ' ELSE @@ -190,27 +190,27 @@ SUBROUTINE calculate_ic_correction(Eigenval, mat_SinvVSinv, mat_3c_overl_nnP_ic, n_level_gw_ref, ' ( ', occ_virt, ') ', & Eigenval(n_level_gw_ref)*evolt, & Delta_Sigma_Neaton(n_level_gw)*evolt, & - (Eigenval(n_level_gw_ref)+Delta_Sigma_Neaton(n_level_gw))*evolt + (Eigenval(n_level_gw_ref) + Delta_Sigma_Neaton(n_level_gw))*evolt END DO IF (do_closed_shell) THEN WRITE (unit_nr, '(T3,A)') ' ' - WRITE (unit_nr, '(T3,A,F57.2)') 'IC HOMO-LUMO gap (eV)', (Eigenval(homo+1)+ & - Delta_Sigma_Neaton(gw_corr_lev_occ+1)- & - Eigenval(homo)- & + WRITE (unit_nr, '(T3,A,F57.2)') 'IC HOMO-LUMO gap (eV)', (Eigenval(homo + 1) + & + Delta_Sigma_Neaton(gw_corr_lev_occ + 1) - & + Eigenval(homo) - & Delta_Sigma_Neaton(gw_corr_lev_occ))*evolt ELSE IF (my_do_alpha) THEN WRITE (unit_nr, '(T3,A)') ' ' - WRITE (unit_nr, '(T3,A,F51.2)') 'Alpha IC HOMO-LUMO gap (eV)', (Eigenval(homo+1)+ & - Delta_Sigma_Neaton(gw_corr_lev_occ+1)- & - Eigenval(homo)- & + WRITE (unit_nr, '(T3,A,F51.2)') 'Alpha IC HOMO-LUMO gap (eV)', (Eigenval(homo + 1) + & + Delta_Sigma_Neaton(gw_corr_lev_occ + 1) - & + Eigenval(homo) - & Delta_Sigma_Neaton(gw_corr_lev_occ))*evolt ELSE IF (my_do_beta) THEN WRITE (unit_nr, '(T3,A)') ' ' - WRITE (unit_nr, '(T3,A,F52.2)') 'Beta IC HOMO-LUMO gap (eV)', (Eigenval(homo+1)+ & - Delta_Sigma_Neaton(gw_corr_lev_occ+1)- & - Eigenval(homo)- & + WRITE (unit_nr, '(T3,A,F52.2)') 'Beta IC HOMO-LUMO gap (eV)', (Eigenval(homo + 1) + & + Delta_Sigma_Neaton(gw_corr_lev_occ + 1) - & + Eigenval(homo) - & Delta_Sigma_Neaton(gw_corr_lev_occ))*evolt END IF @@ -225,9 +225,9 @@ SUBROUTINE calculate_ic_correction(Eigenval, mat_SinvVSinv, mat_3c_overl_nnP_ic, END IF - Eigenval(homo-gw_corr_lev_occ+1:homo+gw_corr_lev_virt) = Eigenval(homo-gw_corr_lev_occ+1: & - homo+gw_corr_lev_virt) & - +Delta_Sigma_Neaton(1:gw_corr_lev_tot) + Eigenval(homo - gw_corr_lev_occ + 1:homo + gw_corr_lev_virt) = Eigenval(homo - gw_corr_lev_occ + 1: & + homo + gw_corr_lev_virt) & + + Delta_Sigma_Neaton(1:gw_corr_lev_tot) END IF @@ -237,7 +237,7 @@ SUBROUTINE calculate_ic_correction(Eigenval, mat_SinvVSinv, mat_3c_overl_nnP_ic, CPASSERT(SIZE(mp2_env%ri_g0w0%gw_eigenvalues) == gw_corr_lev_tot) - Eigenval(homo-gw_corr_lev_occ+1:homo+gw_corr_lev_virt) = mp2_env%ri_g0w0%gw_eigenvalues(1:gw_corr_lev_tot) + Eigenval(homo - gw_corr_lev_occ + 1:homo + gw_corr_lev_virt) = mp2_env%ri_g0w0%gw_eigenvalues(1:gw_corr_lev_tot) END IF @@ -246,7 +246,7 @@ SUBROUTINE calculate_ic_correction(Eigenval, mat_SinvVSinv, mat_3c_overl_nnP_ic, ! initial guess coeff_homo(homo) = 1.0_dp - ALLOCATE (coeff_lumo(nmo-homo)) + ALLOCATE (coeff_lumo(nmo - homo)) coeff_lumo = 0.0_dp ! initial guess coeff_lumo(1) = 1.0_dp @@ -375,7 +375,7 @@ SUBROUTINE calculate_ic_correction(Eigenval, mat_SinvVSinv, mat_3c_overl_nnP_ic, ! build vec_P_occ DO n_level_gw = 1, gw_corr_lev_occ - n_level_gw_ref = n_level_gw+homo-gw_corr_lev_occ + n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ CALL dbcsr_multiply("N", "N", 1.0_dp, mat_B_nm_P(n_level_gw)%matrix, & coeff_homo_dbcsr, 0.0_dp, temp_RI_vector) @@ -406,7 +406,7 @@ SUBROUTINE calculate_ic_correction(Eigenval, mat_SinvVSinv, mat_3c_overl_nnP_ic, ' HOMO with IC (eV): ', & -Eigenval_M_occ(1)*evolt - IF (ABS(old_energy+Eigenval_M_occ(1)) < 1.0E-5) EXIT + IF (ABS(old_energy + Eigenval_M_occ(1)) < 1.0E-5) EXIT old_energy = -Eigenval_M_occ(1) @@ -414,7 +414,7 @@ SUBROUTINE calculate_ic_correction(Eigenval, mat_SinvVSinv, mat_3c_overl_nnP_ic, END DO - IF (unit_nr > 0) WRITE (unit_nr, '(T3,A,T40,F41.2)') 'Gas phase LUMO (eV): ', Eigenval(homo+1)*evolt + IF (unit_nr > 0) WRITE (unit_nr, '(T3,A,T40,F41.2)') 'Gas phase LUMO (eV): ', Eigenval(homo + 1)*evolt DO sc_iter = 1, 20 @@ -423,21 +423,21 @@ SUBROUTINE calculate_ic_correction(Eigenval, mat_SinvVSinv, mat_3c_overl_nnP_ic, CALL dbcsr_set(vec_P_virt_dbcsr, 0.0_dp) ! build vec_P_virt - DO n_level_gw = gw_corr_lev_occ+1, gw_corr_lev_tot + DO n_level_gw = gw_corr_lev_occ + 1, gw_corr_lev_tot - n_level_gw_ref = n_level_gw+homo-gw_corr_lev_occ + n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ CALL dbcsr_multiply("N", "N", 1.0_dp, mat_B_nm_P(n_level_gw)%matrix, & coeff_lumo_dbcsr, 0.0_dp, temp_RI_vector) - CALL dbcsr_add(vec_P_virt_dbcsr, temp_RI_vector, 1.0_dp, coeff_lumo(n_level_gw_ref-homo)) + CALL dbcsr_add(vec_P_virt_dbcsr, temp_RI_vector, 1.0_dp, coeff_lumo(n_level_gw_ref - homo)) END DO ! build N matrix DO n_level_gw = 1, gw_corr_lev_virt - CALL dbcsr_multiply("T", "N", 1.0_dp, mat_3c_overl_nnP_ic_reflected(n_level_gw+gw_corr_lev_occ)%matrix, & + CALL dbcsr_multiply("T", "N", 1.0_dp, mat_3c_overl_nnP_ic_reflected(n_level_gw + gw_corr_lev_occ)%matrix, & vec_P_virt_dbcsr, 0.0_dp, mat_N_virt_dbcsr(n_level_gw)%matrix) END DO @@ -454,11 +454,11 @@ SUBROUTINE calculate_ic_correction(Eigenval, mat_SinvVSinv, mat_3c_overl_nnP_ic, ' LUMO with IC (eV): ', & Eigenval_M_virt(1)*evolt - IF (ABS(old_energy-Eigenval_M_virt(1)) < 1.0E-5) EXIT + IF (ABS(old_energy - Eigenval_M_virt(1)) < 1.0E-5) EXIT old_energy = Eigenval_M_virt(1) - CALL update_coeff_homo(coeff_lumo, fm_mat_U_virt, para_env, nmo-homo, & + CALL update_coeff_homo(coeff_lumo, fm_mat_U_virt, para_env, nmo - homo, & gw_corr_lev_virt, do_lumo=.TRUE.) END DO @@ -607,7 +607,7 @@ SUBROUTINE update_coeff_homo(coeff_homo, fm_mat_U_occ, para_env, homo, gw_corr_l IF (my_do_homo) THEN - coeff_homo_update(i_global+homo-gw_corr_lev_occ) = fm_mat_U_occ%local_data(iiB, jjB) + coeff_homo_update(i_global + homo - gw_corr_lev_occ) = fm_mat_U_occ%local_data(iiB, jjB) ELSE @@ -692,7 +692,7 @@ SUBROUTINE fill_fm_mat_M_virt(fm_mat_M_virt, mat_N_virt_dbcsr, matrix_s, Eigenva DO row_block = 1, nblkrows_total IF (row_index >= row_blk_offset(row_block) .AND. & - row_index <= row_blk_offset(row_block)+row_blk_sizes(row_block)-1) THEN + row_index <= row_blk_offset(row_block) + row_blk_sizes(row_block) - 1) THEN blk_from_indx(row_index) = row_block @@ -702,9 +702,9 @@ SUBROUTINE fill_fm_mat_M_virt(fm_mat_M_virt, mat_N_virt_dbcsr, matrix_s, Eigenva END DO - ALLOCATE (num_entries_send(0:para_env%num_pe-1)) + ALLOCATE (num_entries_send(0:para_env%num_pe - 1)) num_entries_send = 0 - ALLOCATE (num_entries_rec(0:para_env%num_pe-1)) + ALLOCATE (num_entries_rec(0:para_env%num_pe - 1)) num_entries_rec = 0 DO n_level_gw = 1, gw_corr_lev_virt @@ -717,7 +717,7 @@ SUBROUTINE fill_fm_mat_M_virt(fm_mat_M_virt, mat_N_virt_dbcsr, matrix_s, Eigenva DO i_row = 1, row_size - m_level_gw = row_offset-1+i_row-homo + m_level_gw = row_offset - 1 + i_row - homo IF (m_level_gw < 1) CYCLE @@ -726,7 +726,7 @@ SUBROUTINE fill_fm_mat_M_virt(fm_mat_M_virt, mat_N_virt_dbcsr, matrix_s, Eigenva CALL dbcsr_get_stored_coordinates(matrix_tmp, blk_from_indx(m_level_gw), & blk_from_indx(n_level_gw), imepos) - num_entries_send(imepos) = num_entries_send(imepos)+1 + num_entries_send(imepos) = num_entries_send(imepos) + 1 END DO @@ -738,11 +738,11 @@ SUBROUTINE fill_fm_mat_M_virt(fm_mat_M_virt, mat_N_virt_dbcsr, matrix_s, Eigenva CALL mp_alltoall(num_entries_send, num_entries_rec, 1, para_env%group) - ALLOCATE (buffer_rec(0:para_env%num_pe-1)) - ALLOCATE (buffer_send(0:para_env%num_pe-1)) + ALLOCATE (buffer_rec(0:para_env%num_pe - 1)) + ALLOCATE (buffer_send(0:para_env%num_pe - 1)) ! allocate data message and corresponding indices - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 ALLOCATE (buffer_rec(imepos)%msg(num_entries_rec(imepos))) buffer_rec(imepos)%msg = 0.0_dp @@ -758,7 +758,7 @@ SUBROUTINE fill_fm_mat_M_virt(fm_mat_M_virt, mat_N_virt_dbcsr, matrix_s, Eigenva END DO - ALLOCATE (entry_counter(0:para_env%num_pe-1)) + ALLOCATE (entry_counter(0:para_env%num_pe - 1)) entry_counter(:) = 1 DO n_level_gw = 1, gw_corr_lev_virt @@ -771,7 +771,7 @@ SUBROUTINE fill_fm_mat_M_virt(fm_mat_M_virt, mat_N_virt_dbcsr, matrix_s, Eigenva DO i_row = 1, row_size - m_level_gw = row_offset-1+i_row-homo + m_level_gw = row_offset - 1 + i_row - homo IF (m_level_gw < 1) CYCLE @@ -786,7 +786,7 @@ SUBROUTINE fill_fm_mat_M_virt(fm_mat_M_virt, mat_N_virt_dbcsr, matrix_s, Eigenva buffer_send(imepos)%indx(offset, 1) = m_level_gw buffer_send(imepos)%indx(offset, 2) = n_level_gw - entry_counter(imepos) = entry_counter(imepos)+1 + entry_counter(imepos) = entry_counter(imepos) + 1 END DO @@ -809,17 +809,17 @@ SUBROUTINE fill_fm_mat_M_virt(fm_mat_M_virt, mat_N_virt_dbcsr, matrix_s, Eigenva row_offset=row_offset, row_size=row_size, & col_offset=col_offset, col_size=col_size) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 DO i_index = 1, num_entries_rec(imepos) IF (buffer_rec(imepos)%indx(i_index, 1) >= row_offset .AND. & - buffer_rec(imepos)%indx(i_index, 1) <= row_offset+row_size-1 .AND. & + buffer_rec(imepos)%indx(i_index, 1) <= row_offset + row_size - 1 .AND. & buffer_rec(imepos)%indx(i_index, 2) >= col_offset .AND. & - buffer_rec(imepos)%indx(i_index, 2) <= col_offset+col_size-1) THEN + buffer_rec(imepos)%indx(i_index, 2) <= col_offset + col_size - 1) THEN - i_row = buffer_rec(imepos)%indx(i_index, 1)-row_offset+1 - i_col = buffer_rec(imepos)%indx(i_index, 2)-col_offset+1 + i_row = buffer_rec(imepos)%indx(i_index, 1) - row_offset + 1 + i_col = buffer_rec(imepos)%indx(i_index, 2) - col_offset + 1 data_block(i_row, i_col) = buffer_rec(imepos)%msg(i_index) @@ -851,13 +851,13 @@ SUBROUTINE fill_fm_mat_M_virt(fm_mat_M_virt, mat_N_virt_dbcsr, matrix_s, Eigenva DO iiB = 1, nrow_local i_global = row_indices(iiB) IF (j_global == i_global) THEN - fm_mat_M_virt%local_data(iiB, jjB) = fm_mat_M_virt%local_data(iiB, jjB)+ & - Eigenval(i_global+homo) + fm_mat_M_virt%local_data(iiB, jjB) = fm_mat_M_virt%local_data(iiB, jjB) + & + Eigenval(i_global + homo) END IF END DO END DO - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 DEALLOCATE (buffer_rec(imepos)%msg) DEALLOCATE (buffer_rec(imepos)%indx) DEALLOCATE (buffer_send(imepos)%msg) @@ -929,7 +929,7 @@ SUBROUTINE fill_fm_mat_M_occ(fm_mat_M_occ, mat_N_occ_dbcsr, matrix_s, Eigenval, DO row_block = 1, nblkrows_total IF (row_index >= row_blk_offset(row_block) .AND. & - row_index <= row_blk_offset(row_block)+row_blk_sizes(row_block)-1) THEN + row_index <= row_blk_offset(row_block) + row_blk_sizes(row_block) - 1) THEN blk_from_indx(row_index) = row_block @@ -939,9 +939,9 @@ SUBROUTINE fill_fm_mat_M_occ(fm_mat_M_occ, mat_N_occ_dbcsr, matrix_s, Eigenval, END DO - ALLOCATE (num_entries_send(0:para_env%num_pe-1)) + ALLOCATE (num_entries_send(0:para_env%num_pe - 1)) num_entries_send = 0 - ALLOCATE (num_entries_rec(0:para_env%num_pe-1)) + ALLOCATE (num_entries_rec(0:para_env%num_pe - 1)) num_entries_rec = 0 DO n_level_gw = 1, gw_corr_lev_occ @@ -952,31 +952,31 @@ SUBROUTINE fill_fm_mat_M_occ(fm_mat_M_occ, mat_N_occ_dbcsr, matrix_s, Eigenval, CALL dbcsr_iterator_next_block(iter, row, col, data_block, & row_offset=row_offset, row_size=row_size) - IF (row_offset+row_size-1 <= homo) THEN + IF (row_offset + row_size - 1 <= homo) THEN DO i_row = 1, row_size - m_level_gw = row_offset-1+i_row-(homo-gw_corr_lev_occ) + m_level_gw = row_offset - 1 + i_row - (homo - gw_corr_lev_occ) IF (m_level_gw < 1) CYCLE CALL dbcsr_get_stored_coordinates(matrix_tmp, blk_from_indx(m_level_gw), & blk_from_indx(n_level_gw), imepos) - num_entries_send(imepos) = num_entries_send(imepos)+1 + num_entries_send(imepos) = num_entries_send(imepos) + 1 END DO ELSE IF (row_offset <= homo) THEN - DO m_level_gw = row_offset-(homo-gw_corr_lev_occ), gw_corr_lev_occ + DO m_level_gw = row_offset - (homo - gw_corr_lev_occ), gw_corr_lev_occ IF (m_level_gw < 1) CYCLE CALL dbcsr_get_stored_coordinates(matrix_tmp, blk_from_indx(m_level_gw), & blk_from_indx(n_level_gw), imepos) - num_entries_send(imepos) = num_entries_send(imepos)+1 + num_entries_send(imepos) = num_entries_send(imepos) + 1 END DO @@ -990,11 +990,11 @@ SUBROUTINE fill_fm_mat_M_occ(fm_mat_M_occ, mat_N_occ_dbcsr, matrix_s, Eigenval, CALL mp_alltoall(num_entries_send, num_entries_rec, 1, para_env%group) - ALLOCATE (buffer_rec(0:para_env%num_pe-1)) - ALLOCATE (buffer_send(0:para_env%num_pe-1)) + ALLOCATE (buffer_rec(0:para_env%num_pe - 1)) + ALLOCATE (buffer_send(0:para_env%num_pe - 1)) ! allocate data message and corresponding indices - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 ALLOCATE (buffer_rec(imepos)%msg(num_entries_rec(imepos))) buffer_rec(imepos)%msg = 0.0_dp @@ -1010,7 +1010,7 @@ SUBROUTINE fill_fm_mat_M_occ(fm_mat_M_occ, mat_N_occ_dbcsr, matrix_s, Eigenval, END DO - ALLOCATE (entry_counter(0:para_env%num_pe-1)) + ALLOCATE (entry_counter(0:para_env%num_pe - 1)) entry_counter(:) = 1 DO n_level_gw = 1, gw_corr_lev_occ @@ -1021,11 +1021,11 @@ SUBROUTINE fill_fm_mat_M_occ(fm_mat_M_occ, mat_N_occ_dbcsr, matrix_s, Eigenval, CALL dbcsr_iterator_next_block(iter, row, col, data_block, & row_offset=row_offset, row_size=row_size) - IF (row_offset+row_size-1 <= homo) THEN + IF (row_offset + row_size - 1 <= homo) THEN DO i_row = 1, row_size - m_level_gw = row_offset-1+i_row-(homo-gw_corr_lev_occ) + m_level_gw = row_offset - 1 + i_row - (homo - gw_corr_lev_occ) IF (m_level_gw < 1) CYCLE @@ -1038,13 +1038,13 @@ SUBROUTINE fill_fm_mat_M_occ(fm_mat_M_occ, mat_N_occ_dbcsr, matrix_s, Eigenval, buffer_send(imepos)%indx(offset, 1) = m_level_gw buffer_send(imepos)%indx(offset, 2) = n_level_gw - entry_counter(imepos) = entry_counter(imepos)+1 + entry_counter(imepos) = entry_counter(imepos) + 1 END DO ELSE IF (row_offset <= homo) THEN - DO m_level_gw = row_offset-(homo-gw_corr_lev_occ), gw_corr_lev_occ + DO m_level_gw = row_offset - (homo - gw_corr_lev_occ), gw_corr_lev_occ IF (m_level_gw < 1) CYCLE @@ -1053,13 +1053,13 @@ SUBROUTINE fill_fm_mat_M_occ(fm_mat_M_occ, mat_N_occ_dbcsr, matrix_s, Eigenval, offset = entry_counter(imepos) - i_row = m_level_gw+(homo-gw_corr_lev_occ)-row_offset+1 + i_row = m_level_gw + (homo - gw_corr_lev_occ) - row_offset + 1 buffer_send(imepos)%msg(offset) = data_block(i_row, 1) buffer_send(imepos)%indx(offset, 1) = m_level_gw buffer_send(imepos)%indx(offset, 2) = n_level_gw - entry_counter(imepos) = entry_counter(imepos)+1 + entry_counter(imepos) = entry_counter(imepos) + 1 END DO @@ -1084,17 +1084,17 @@ SUBROUTINE fill_fm_mat_M_occ(fm_mat_M_occ, mat_N_occ_dbcsr, matrix_s, Eigenval, row_offset=row_offset, row_size=row_size, & col_offset=col_offset, col_size=col_size) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 DO i_index = 1, num_entries_rec(imepos) IF (buffer_rec(imepos)%indx(i_index, 1) >= row_offset .AND. & - buffer_rec(imepos)%indx(i_index, 1) <= row_offset+row_size-1 .AND. & + buffer_rec(imepos)%indx(i_index, 1) <= row_offset + row_size - 1 .AND. & buffer_rec(imepos)%indx(i_index, 2) >= col_offset .AND. & - buffer_rec(imepos)%indx(i_index, 2) <= col_offset+col_size-1) THEN + buffer_rec(imepos)%indx(i_index, 2) <= col_offset + col_size - 1) THEN - i_row = buffer_rec(imepos)%indx(i_index, 1)-row_offset+1 - i_col = buffer_rec(imepos)%indx(i_index, 2)-col_offset+1 + i_row = buffer_rec(imepos)%indx(i_index, 1) - row_offset + 1 + i_col = buffer_rec(imepos)%indx(i_index, 2) - col_offset + 1 data_block(i_row, i_col) = buffer_rec(imepos)%msg(i_index) @@ -1122,13 +1122,13 @@ SUBROUTINE fill_fm_mat_M_occ(fm_mat_M_occ, mat_N_occ_dbcsr, matrix_s, Eigenval, DO iiB = 1, nrow_local i_global = row_indices(iiB) IF (j_global == i_global) THEN - fm_mat_M_occ%local_data(iiB, jjB) = fm_mat_M_occ%local_data(iiB, jjB)+ & - Eigenval(i_global+homo-gw_corr_lev_occ) + fm_mat_M_occ%local_data(iiB, jjB) = fm_mat_M_occ%local_data(iiB, jjB) + & + Eigenval(i_global + homo - gw_corr_lev_occ) END IF END DO END DO - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 DEALLOCATE (buffer_rec(imepos)%msg) DEALLOCATE (buffer_rec(imepos)%indx) DEALLOCATE (buffer_send(imepos)%msg) @@ -1169,15 +1169,15 @@ SUBROUTINE fill_coeff_dbcsr_occ(coeff_dbcsr, coeff, homo) CALL dbcsr_iterator_next_block(iter, row, col, data_block, & row_offset=row_offset, row_size=row_size) - IF (row_offset+row_size-1 <= homo) THEN + IF (row_offset + row_size - 1 <= homo) THEN - data_block(1:row_size, 1) = coeff(row_offset:row_offset+row_size-1) + data_block(1:row_size, 1) = coeff(row_offset:row_offset + row_size - 1) ELSE IF (row_offset <= homo) THEN - end_data_block = homo-row_offset+1 + end_data_block = homo - row_offset + 1 - data_block(1:end_data_block, 1) = coeff(row_offset:row_offset+end_data_block-1) + data_block(1:end_data_block, 1) = coeff(row_offset:row_offset + end_data_block - 1) END IF @@ -1218,13 +1218,13 @@ SUBROUTINE fill_coeff_dbcsr_virt(coeff_dbcsr, coeff, homo) IF (row_offset > homo) THEN - data_block(1:row_size, 1) = coeff(row_offset-homo:row_offset+row_size-homo-1) + data_block(1:row_size, 1) = coeff(row_offset - homo:row_offset + row_size - homo - 1) - ELSE IF (row_offset+row_size-1 > homo) THEN + ELSE IF (row_offset + row_size - 1 > homo) THEN - start_data_block = homo-row_offset+1 + start_data_block = homo - row_offset + 1 - data_block(start_data_block:row_size, 1) = coeff(1:row_offset+row_size-homo) + data_block(start_data_block:row_size, 1) = coeff(1:row_offset + row_size - homo) END IF diff --git a/src/rpa_gw_im_time_util.F b/src/rpa_gw_im_time_util.F index d236d12a48..7ae7b1cbb4 100644 --- a/src/rpa_gw_im_time_util.F +++ b/src/rpa_gw_im_time_util.F @@ -123,10 +123,10 @@ SUBROUTINE get_mat_3c_overl_int_gw(mat_3c_overl_int, mat_3c_overl_int_gw, mo_coe ! set MO coeffs to zero where DO irow_global = 1, nmo - DO icol_global = 1, homo-gw_corr_lev_occ + DO icol_global = 1, homo - gw_corr_lev_occ CALL cp_fm_set_element(fm_mat_mo_coeff_gw, irow_global, icol_global, 0.0_dp) END DO - DO icol_global = homo+gw_corr_lev_virt+1, nmo + DO icol_global = homo + gw_corr_lev_virt + 1, nmo CALL cp_fm_set_element(fm_mat_mo_coeff_gw, irow_global, icol_global, 0.0_dp) END DO END DO @@ -204,9 +204,9 @@ SUBROUTINE get_mat_3c_overl_int_gw(mat_3c_overl_int, mat_3c_overl_int_gw, mo_coe END DO NULLIFY (mat_3c_overl_int_gw_dummy) - CALL dbcsr_allocate_matrix_set(mat_3c_overl_int_gw_dummy, gw_corr_lev_occ+gw_corr_lev_virt) + CALL dbcsr_allocate_matrix_set(mat_3c_overl_int_gw_dummy, gw_corr_lev_occ + gw_corr_lev_virt) - DO n_level_gw = 1, gw_corr_lev_occ+gw_corr_lev_virt + DO n_level_gw = 1, gw_corr_lev_occ + gw_corr_lev_virt ALLOCATE (mat_3c_overl_int_gw_dummy(n_level_gw)%matrix) CALL dbcsr_create(matrix=mat_3c_overl_int_gw_dummy(n_level_gw)%matrix, & @@ -247,9 +247,9 @@ SUBROUTINE get_mat_3c_overl_int_gw(mat_3c_overl_int, mat_3c_overl_int_gw, mo_coe CALL mp_sum(norm, para_env%group) - DO n_level_gw = 1, gw_corr_lev_occ+gw_corr_lev_virt + DO n_level_gw = 1, gw_corr_lev_occ + gw_corr_lev_virt - n_level_gw_ref = n_level_gw+homo-gw_corr_lev_occ + n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ CALL dbcsr_scale(mat_3c_overl_nnP_ic_reflected(n_level_gw)%matrix, 1.0_dp/norm(n_level_gw_ref)) @@ -309,9 +309,9 @@ SUBROUTINE fill_mat_3c_overl_nnP_ic(mat_3c_overl_nnP_ic, mat_3c_overl_int_gw, ma template=mat_mo_coeff_gw, & matrix_type=dbcsr_type_no_symmetry) - DO n_level_gw = 1, gw_corr_lev_occ+gw_corr_lev_virt + DO n_level_gw = 1, gw_corr_lev_occ + gw_corr_lev_virt - n_level_gw_ref = n_level_gw+homo-gw_corr_lev_occ + n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ CALL dbcsr_copy(mat_mo_coeff_gw_copy, mat_mo_coeff_gw) @@ -330,7 +330,7 @@ SUBROUTINE fill_mat_3c_overl_nnP_ic(mat_3c_overl_nnP_ic, mat_3c_overl_int_gw, ma DO i_col = 1, col_size - col_global = i_col+col_offset-1 + col_global = i_col + col_offset - 1 IF (is_occ) THEN @@ -357,7 +357,7 @@ SUBROUTINE fill_mat_3c_overl_nnP_ic(mat_3c_overl_nnP_ic, mat_3c_overl_int_gw, ma DO i_col = 1, col_size - col_global = i_col+col_offset-1 + col_global = i_col + col_offset - 1 IF (col_global .NE. n_level_gw_ref) THEN @@ -435,10 +435,10 @@ SUBROUTINE fill_mat_3c_overl_int_gw(mat_3c_overl_int_gw, mat_3c_overl_int_gw_for NULLIFY (data_block) - ALLOCATE (num_entries_send(0:para_env%num_pe-1)) + ALLOCATE (num_entries_send(0:para_env%num_pe - 1)) num_entries_send(:) = 0 - ALLOCATE (num_blocks_send(0:para_env%num_pe-1)) + ALLOCATE (num_blocks_send(0:para_env%num_pe - 1)) num_blocks_send(:) = 0 CALL timestop(handle1) @@ -458,15 +458,15 @@ SUBROUTINE fill_mat_3c_overl_int_gw(mat_3c_overl_int_gw, mat_3c_overl_int_gw_for row_size=row_size, col_size=col_size, & row_offset=row_offset, col_offset=col_offset) - DO LLL = my_group_L_start, my_group_L_start+my_group_L_size-1 + DO LLL = my_group_L_start, my_group_L_start + my_group_L_size - 1 row_RI = row_from_LLL(LLL) CALL dbcsr_get_stored_coordinates(mat_3c_overl_int_gw(1)%matrix, row_RI, col, imepos_dest) - num_entries_send(imepos_dest) = num_entries_send(imepos_dest)+row_size*col_size/my_group_L_size + num_entries_send(imepos_dest) = num_entries_send(imepos_dest) + row_size*col_size/my_group_L_size - num_blocks_send(imepos_dest) = num_blocks_send(imepos_dest)+col_size/my_group_L_size + num_blocks_send(imepos_dest) = num_blocks_send(imepos_dest) + col_size/my_group_L_size END DO @@ -480,24 +480,24 @@ SUBROUTINE fill_mat_3c_overl_int_gw(mat_3c_overl_int_gw, mat_3c_overl_int_gw_for CALL timeset("GW3c_send_sizes", handle1) - ALLOCATE (num_entries_rec(0:para_env%num_pe-1)) - ALLOCATE (num_blocks_rec(0:para_env%num_pe-1)) + ALLOCATE (num_entries_rec(0:para_env%num_pe - 1)) + ALLOCATE (num_blocks_rec(0:para_env%num_pe - 1)) IF (para_env%num_pe > 1) THEN - ALLOCATE (sizes_rec(0:2*para_env%num_pe-1)) - ALLOCATE (sizes_send(0:2*para_env%num_pe-1)) + ALLOCATE (sizes_rec(0:2*para_env%num_pe - 1)) + ALLOCATE (sizes_send(0:2*para_env%num_pe - 1)) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 sizes_send(2*imepos) = num_entries_send(imepos) - sizes_send(2*imepos+1) = num_blocks_send(imepos) + sizes_send(2*imepos + 1) = num_blocks_send(imepos) END DO CALL mp_alltoall(sizes_send, sizes_rec, 2, para_env%group) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 num_entries_rec(imepos) = sizes_rec(2*imepos) - num_blocks_rec(imepos) = sizes_rec(2*imepos+1) + num_blocks_rec(imepos) = sizes_rec(2*imepos + 1) END DO DEALLOCATE (sizes_rec, sizes_send) @@ -513,11 +513,11 @@ SUBROUTINE fill_mat_3c_overl_int_gw(mat_3c_overl_int_gw, mat_3c_overl_int_gw_for CALL timeset("GW3c_fill_buffer_send", handle1) - ALLOCATE (buffer_rec(0:para_env%num_pe-1)) - ALLOCATE (buffer_send(0:para_env%num_pe-1)) + ALLOCATE (buffer_rec(0:para_env%num_pe - 1)) + ALLOCATE (buffer_send(0:para_env%num_pe - 1)) ! allocate data message and corresponding indices - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 ALLOCATE (buffer_rec(imepos)%msg(num_entries_rec(imepos))) buffer_rec(imepos)%msg = 0.0_dp @@ -533,10 +533,10 @@ SUBROUTINE fill_mat_3c_overl_int_gw(mat_3c_overl_int_gw, mat_3c_overl_int_gw_for END DO - ALLOCATE (entry_counter(0:para_env%num_pe-1)) + ALLOCATE (entry_counter(0:para_env%num_pe - 1)) entry_counter(:) = 0 - ALLOCATE (block_counter(0:para_env%num_pe-1)) + ALLOCATE (block_counter(0:para_env%num_pe - 1)) block_counter(:) = 0 DO i_cut_RI = 1, cut_RI @@ -552,7 +552,7 @@ SUBROUTINE fill_mat_3c_overl_int_gw(mat_3c_overl_int_gw, mat_3c_overl_int_gw_for row_size=row_size, col_size=col_size, & row_offset=row_offset, col_offset=col_offset) - DO LLL = my_group_L_start, my_group_L_start+my_group_L_size-1 + DO LLL = my_group_L_start, my_group_L_start + my_group_L_size - 1 row_RI = row_from_LLL(LLL) @@ -561,18 +561,18 @@ SUBROUTINE fill_mat_3c_overl_int_gw(mat_3c_overl_int_gw, mat_3c_overl_int_gw_for col_size_orig = col_size/my_group_L_size - col_offset_data_block = (LLL-my_group_L_start)*col_size_orig+1 + col_offset_data_block = (LLL - my_group_L_start)*col_size_orig + 1 DO i_col_orig = 1, col_size_orig - block = block_counter(imepos_dest)+1 + block = block_counter(imepos_dest) + 1 CALL dbcsr_get_stored_coordinates(mat_3c_overl_int_gw(1)%matrix, row_RI, col, imepos_dest) offset = entry_counter(imepos_dest) - buffer_send(imepos_dest)%msg(offset+1:offset+row_size) = & - data_block(1:row_size, col_offset_data_block+i_col_orig-1) + buffer_send(imepos_dest)%msg(offset + 1:offset + row_size) = & + data_block(1:row_size, col_offset_data_block + i_col_orig - 1) buffer_send(imepos_dest)%indx(block, 1) = LLL buffer_send(imepos_dest)%indx(block, 2) = col @@ -584,9 +584,9 @@ SUBROUTINE fill_mat_3c_overl_int_gw(mat_3c_overl_int_gw, mat_3c_overl_int_gw_for buffer_send(imepos_dest)%indx(block, 8) = offset buffer_send(imepos_dest)%indx(block, 9) = i_col_orig - entry_counter(imepos_dest) = entry_counter(imepos_dest)+row_size + entry_counter(imepos_dest) = entry_counter(imepos_dest) + row_size - block_counter(imepos_dest) = block_counter(imepos_dest)+1 + block_counter(imepos_dest) = block_counter(imepos_dest) + 1 END DO @@ -622,7 +622,7 @@ SUBROUTINE fill_mat_3c_overl_int_gw(mat_3c_overl_int_gw, mat_3c_overl_int_gw_for first_cycle = .TRUE. - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 DO i_block = 1, num_blocks_rec(imepos) @@ -662,8 +662,8 @@ SUBROUTINE fill_mat_3c_overl_int_gw(mat_3c_overl_int_gw, mat_3c_overl_int_gw_for DEALLOCATE (rows_to_allocate) DEALLOCATE (cols_to_allocate) - ALLOCATE (rows_to_allocate(integer_block_counter+1)) - ALLOCATE (cols_to_allocate(integer_block_counter+1)) + ALLOCATE (rows_to_allocate(integer_block_counter + 1)) + ALLOCATE (cols_to_allocate(integer_block_counter + 1)) rows_to_allocate(1:integer_block_counter) = rows_tmp(1:integer_block_counter) cols_to_allocate(1:integer_block_counter) = cols_tmp(1:integer_block_counter) @@ -671,10 +671,10 @@ SUBROUTINE fill_mat_3c_overl_int_gw(mat_3c_overl_int_gw, mat_3c_overl_int_gw_for DEALLOCATE (rows_tmp) DEALLOCATE (cols_tmp) - rows_to_allocate(integer_block_counter+1) = row_RI - cols_to_allocate(integer_block_counter+1) = col_prim + rows_to_allocate(integer_block_counter + 1) = row_RI + cols_to_allocate(integer_block_counter + 1) = col_prim - integer_block_counter = integer_block_counter+1 + integer_block_counter = integer_block_counter + 1 END IF @@ -688,7 +688,7 @@ SUBROUTINE fill_mat_3c_overl_int_gw(mat_3c_overl_int_gw, mat_3c_overl_int_gw_for CALL timeset("GW3c_fill_mat", handle1) - DO n_level_gw = 1, gw_corr_lev_occ+gw_corr_lev_virt + DO n_level_gw = 1, gw_corr_lev_occ + gw_corr_lev_virt IF (rows_to_allocate(1) .NE. 0) THEN @@ -700,7 +700,7 @@ SUBROUTINE fill_mat_3c_overl_int_gw(mat_3c_overl_int_gw, mat_3c_overl_int_gw_for CALL dbcsr_finalize(mat_3c_overl_int_gw(n_level_gw)%matrix) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 DO i_block = 1, num_blocks_rec(imepos) @@ -723,14 +723,14 @@ SUBROUTINE fill_mat_3c_overl_int_gw(mat_3c_overl_int_gw, mat_3c_overl_int_gw_for offset_buffer = buffer_rec(imepos)%indx(i_block, 8) i_col_orig = buffer_rec(imepos)%indx(i_block, 9) - DO i_row_rec = row_offset_rec, row_offset_rec+row_size_rec-1 + DO i_row_rec = row_offset_rec, row_offset_rec + row_size_rec - 1 - IF (i_row_rec == n_level_gw+homo-gw_corr_lev_occ) THEN + IF (i_row_rec == n_level_gw + homo - gw_corr_lev_occ) THEN - RI_index_data_block = LLL-row_offset+1 + RI_index_data_block = LLL - row_offset + 1 data_block(RI_index_data_block, i_col_orig) = & - buffer_rec(imepos)%msg(offset_buffer+1+i_row_rec-row_offset_rec) + buffer_rec(imepos)%msg(offset_buffer + 1 + i_row_rec - row_offset_rec) END IF @@ -753,12 +753,12 @@ SUBROUTINE fill_mat_3c_overl_int_gw(mat_3c_overl_int_gw, mat_3c_overl_int_gw_for CALL timestop(handle1) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 DEALLOCATE (buffer_send(imepos)%msg) DEALLOCATE (buffer_send(imepos)%indx) END DO - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 DEALLOCATE (buffer_rec(imepos)%msg) DEALLOCATE (buffer_rec(imepos)%indx) END DO @@ -810,10 +810,10 @@ SUBROUTINE replicate_mat_to_subgroup_simple(para_env, para_env_sub, mat_dm_globa NULLIFY (data_block) - ALLOCATE (num_entries_blocks_send(0:2*para_env%num_pe-1)) + ALLOCATE (num_entries_blocks_send(0:2*para_env%num_pe - 1)) num_entries_blocks_send(:) = 0 - ALLOCATE (num_entries_blocks_rec(0:2*para_env%num_pe-1)) + ALLOCATE (num_entries_blocks_rec(0:2*para_env%num_pe - 1)) num_entries_blocks_rec(:) = 0 ngroup = para_env%num_pe/para_env_sub%num_pe @@ -829,12 +829,12 @@ SUBROUTINE replicate_mat_to_subgroup_simple(para_env, para_env_sub, mat_dm_globa CALL dbcsr_get_stored_coordinates(mat_local, row, col, imepos_sub) - DO igroup = 0, ngroup-1 + DO igroup = 0, ngroup - 1 - imepos = imepos_sub+igroup*num_pe_sub + imepos = imepos_sub + igroup*num_pe_sub - num_entries_blocks_send(2*imepos) = num_entries_blocks_send(2*imepos)+row_size*col_size - num_entries_blocks_send(2*imepos+1) = num_entries_blocks_send(2*imepos+1)+1 + num_entries_blocks_send(2*imepos) = num_entries_blocks_send(2*imepos) + row_size*col_size + num_entries_blocks_send(2*imepos + 1) = num_entries_blocks_send(2*imepos + 1) + 1 END DO @@ -863,11 +863,11 @@ SUBROUTINE replicate_mat_to_subgroup_simple(para_env, para_env_sub, mat_dm_globa CALL timeset("get_data_D", handle1) - ALLOCATE (buffer_rec(0:para_env%num_pe-1)) - ALLOCATE (buffer_send(0:para_env%num_pe-1)) + ALLOCATE (buffer_rec(0:para_env%num_pe - 1)) + ALLOCATE (buffer_send(0:para_env%num_pe - 1)) ! allocate data message and corresponding indices - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 ALLOCATE (buffer_rec(imepos)%msg(num_entries_blocks_rec(2*imepos))) buffer_rec(imepos)%msg = 0.0_dp @@ -875,18 +875,18 @@ SUBROUTINE replicate_mat_to_subgroup_simple(para_env, para_env_sub, mat_dm_globa ALLOCATE (buffer_send(imepos)%msg(num_entries_blocks_send(2*imepos))) buffer_send(imepos)%msg = 0.0_dp - ALLOCATE (buffer_rec(imepos)%indx(num_entries_blocks_rec(2*imepos+1), 3)) + ALLOCATE (buffer_rec(imepos)%indx(num_entries_blocks_rec(2*imepos + 1), 3)) buffer_rec(imepos)%indx = 0 - ALLOCATE (buffer_send(imepos)%indx(num_entries_blocks_send(2*imepos+1), 3)) + ALLOCATE (buffer_send(imepos)%indx(num_entries_blocks_send(2*imepos + 1), 3)) buffer_send(imepos)%indx = 0 END DO - ALLOCATE (entry_counter(0:para_env%num_pe-1)) + ALLOCATE (entry_counter(0:para_env%num_pe - 1)) entry_counter(:) = 0 - ALLOCATE (blk_counter(0:para_env%num_pe-1)) + ALLOCATE (blk_counter(0:para_env%num_pe - 1)) blk_counter = 0 CALL dbcsr_iterator_start(iter, mat_dm_global) @@ -898,20 +898,20 @@ SUBROUTINE replicate_mat_to_subgroup_simple(para_env, para_env_sub, mat_dm_globa CALL dbcsr_get_stored_coordinates(mat_local, row, col, imepos_sub) - DO igroup = 0, ngroup-1 + DO igroup = 0, ngroup - 1 - imepos = imepos_sub+igroup*num_pe_sub + imepos = imepos_sub + igroup*num_pe_sub msg_offset = entry_counter(imepos) block_size = row_size*col_size - buffer_send(imepos)%msg(msg_offset+1:msg_offset+block_size) = & + buffer_send(imepos)%msg(msg_offset + 1:msg_offset + block_size) = & RESHAPE(data_block(1:row_size, 1:col_size), (/block_size/)) - entry_counter(imepos) = entry_counter(imepos)+block_size + entry_counter(imepos) = entry_counter(imepos) + block_size - blk_counter(imepos) = blk_counter(imepos)+1 + blk_counter(imepos) = blk_counter(imepos) + 1 block_offset = blk_counter(imepos) @@ -931,10 +931,10 @@ SUBROUTINE replicate_mat_to_subgroup_simple(para_env, para_env_sub, mat_dm_globa ALLOCATE (req_array(1:para_env%num_pe, 4)) - ALLOCATE (sizes_rec(0:para_env%num_pe-1)) - ALLOCATE (sizes_send(0:para_env%num_pe-1)) + ALLOCATE (sizes_rec(0:para_env%num_pe - 1)) + ALLOCATE (sizes_send(0:para_env%num_pe - 1)) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 sizes_send(imepos) = num_entries_blocks_send(2*imepos) sizes_rec(imepos) = num_entries_blocks_rec(2*imepos) @@ -960,7 +960,7 @@ SUBROUTINE replicate_mat_to_subgroup_simple(para_env, para_env_sub, mat_dm_globa DO i_entry = 1, nmo DO i_block = 1, nblkrows_total - IF (i_entry >= row_blk_offset(i_block) .AND. i_entry <= row_blk_offset(i_block)+row_blk_size(i_block)-1) THEN + IF (i_entry >= row_blk_offset(i_block) .AND. i_entry <= row_blk_offset(i_block) + row_blk_size(i_block) - 1) THEN row_block_from_index(i_entry) = i_block @@ -976,8 +976,8 @@ SUBROUTINE replicate_mat_to_subgroup_simple(para_env, para_env_sub, mat_dm_globa num_blocks = 0 ! get the number of blocks, which have to be allocated - DO imepos = 0, para_env%num_pe-1 - num_blocks = num_blocks+num_entries_blocks_rec(2*imepos+1) + DO imepos = 0, para_env%num_pe - 1 + num_blocks = num_blocks + num_entries_blocks_rec(2*imepos + 1) END DO ALLOCATE (rows_to_allocate_all(num_blocks)) @@ -988,11 +988,11 @@ SUBROUTINE replicate_mat_to_subgroup_simple(para_env, para_env_sub, mat_dm_globa block_counter = 0 - DO i_mepos = 0, para_env%num_pe-1 + DO i_mepos = 0, para_env%num_pe - 1 - DO i_block = 1, num_entries_blocks_rec(2*i_mepos+1) + DO i_block = 1, num_entries_blocks_rec(2*i_mepos + 1) - block_counter = block_counter+1 + block_counter = block_counter + 1 rows_to_allocate_all(block_counter) = buffer_rec(i_mepos)%indx(i_block, 1) cols_to_allocate_all(block_counter) = buffer_rec(i_mepos)%indx(i_block, 2) @@ -1019,9 +1019,9 @@ SUBROUTINE replicate_mat_to_subgroup_simple(para_env, para_env_sub, mat_dm_globa CALL dbcsr_iterator_next_block(iter, row, col, data_block, & row_size=row_size, col_size=col_size) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 - DO i_block = 1, num_entries_blocks_rec(2*imepos+1) + DO i_block = 1, num_entries_blocks_rec(2*imepos + 1) row_from_buffer = buffer_rec(imepos)%indx(i_block, 1) col_from_buffer = buffer_rec(imepos)%indx(i_block, 2) @@ -1030,7 +1030,7 @@ SUBROUTINE replicate_mat_to_subgroup_simple(para_env, para_env_sub, mat_dm_globa IF (row == row_from_buffer .AND. col == col_from_buffer) THEN data_block(1:row_size, 1:col_size) = & - RESHAPE(buffer_rec(imepos)%msg(offset+1:offset+row_size*col_size), & + RESHAPE(buffer_rec(imepos)%msg(offset + 1:offset + row_size*col_size), & (/row_size, col_size/)) END IF @@ -1045,7 +1045,7 @@ SUBROUTINE replicate_mat_to_subgroup_simple(para_env, para_env_sub, mat_dm_globa CALL timestop(handle1) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 DEALLOCATE (buffer_rec(imepos)%msg) DEALLOCATE (buffer_rec(imepos)%indx) DEALLOCATE (buffer_send(imepos)%msg) @@ -1130,7 +1130,7 @@ SUBROUTINE reflect_mat_row(mat_reflected, mat_orig, para_env, qs_env, unit_nr, d ra(:) = pbc(particle_set(i_atom)%r, cell) - sum_z = sum_z+ra(3) + sum_z = sum_z + ra(3) END DO @@ -1142,7 +1142,7 @@ SUBROUTINE reflect_mat_row(mat_reflected, mat_orig, para_env, qs_env, unit_nr, d ra(:) = pbc(particle_set(i_atom)%r, cell) - sum_z = sum_z+ABS(ra(3)-z_reflection) + sum_z = sum_z + ABS(ra(3) - z_reflection) END DO @@ -1154,8 +1154,8 @@ SUBROUTINE reflect_mat_row(mat_reflected, mat_orig, para_env, qs_env, unit_nr, d ra(:) = pbc(particle_set(i_atom)%r, cell) - IF (ABS(ra(3)-z_reflection) < min_z_dist) THEN - min_z_dist = ABS(ra(3)-z_reflection) + IF (ABS(ra(3) - z_reflection) < min_z_dist) THEN + min_z_dist = ABS(ra(3) - z_reflection) END IF END DO @@ -1180,7 +1180,7 @@ SUBROUTINE reflect_mat_row(mat_reflected, mat_orig, para_env, qs_env, unit_nr, d rb(:) = pbc(particle_set(j_atom)%r, cell) - delta = (ra(1)-rb(1))**2+(ra(2)-rb(2))**2+(ra(3)+rb(3)-2.0_dp*z_reflection)**2 + delta = (ra(1) - rb(1))**2 + (ra(2) - rb(2))**2 + (ra(3) + rb(3) - 2.0_dp*z_reflection)**2 ! SQRT(delta) < eps_dist IF (delta < eps_dist2) THEN @@ -1200,13 +1200,13 @@ SUBROUTINE reflect_mat_row(mat_reflected, mat_orig, para_env, qs_env, unit_nr, d END DO - ALLOCATE (buffer_rec(0:para_env%num_pe-1)) - ALLOCATE (buffer_send(0:para_env%num_pe-1)) + ALLOCATE (buffer_rec(0:para_env%num_pe - 1)) + ALLOCATE (buffer_send(0:para_env%num_pe - 1)) - ALLOCATE (num_entries_rec(0:para_env%num_pe-1)) - ALLOCATE (num_blocks_rec(0:para_env%num_pe-1)) - ALLOCATE (num_entries_send(0:para_env%num_pe-1)) - ALLOCATE (num_blocks_send(0:para_env%num_pe-1)) + ALLOCATE (num_entries_rec(0:para_env%num_pe - 1)) + ALLOCATE (num_blocks_rec(0:para_env%num_pe - 1)) + ALLOCATE (num_entries_send(0:para_env%num_pe - 1)) + ALLOCATE (num_blocks_send(0:para_env%num_pe - 1)) num_entries_rec = 0 num_blocks_rec = 0 num_entries_send = 0 @@ -1222,8 +1222,8 @@ SUBROUTINE reflect_mat_row(mat_reflected, mat_orig, para_env, qs_env, unit_nr, d CALL dbcsr_get_stored_coordinates(mat_reflected, row_reflected, col, imepos) - num_entries_send(imepos) = num_entries_send(imepos)+row_size*col_size - num_blocks_send(imepos) = num_blocks_send(imepos)+1 + num_entries_send(imepos) = num_entries_send(imepos) + row_size*col_size + num_blocks_send(imepos) = num_blocks_send(imepos) + 1 END DO @@ -1231,21 +1231,21 @@ SUBROUTINE reflect_mat_row(mat_reflected, mat_orig, para_env, qs_env, unit_nr, d IF (para_env%num_pe > 1) THEN - ALLOCATE (sizes_rec(0:2*para_env%num_pe-1)) - ALLOCATE (sizes_send(0:2*para_env%num_pe-1)) + ALLOCATE (sizes_rec(0:2*para_env%num_pe - 1)) + ALLOCATE (sizes_send(0:2*para_env%num_pe - 1)) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 sizes_send(2*imepos) = num_entries_send(imepos) - sizes_send(2*imepos+1) = num_blocks_send(imepos) + sizes_send(2*imepos + 1) = num_blocks_send(imepos) END DO CALL mp_alltoall(sizes_send, sizes_rec, 2, para_env%group) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 num_entries_rec(imepos) = sizes_rec(2*imepos) - num_blocks_rec(imepos) = sizes_rec(2*imepos+1) + num_blocks_rec(imepos) = sizes_rec(2*imepos + 1) END DO DEALLOCATE (sizes_rec, sizes_send) @@ -1258,7 +1258,7 @@ SUBROUTINE reflect_mat_row(mat_reflected, mat_orig, para_env, qs_env, unit_nr, d END IF ! allocate data message and corresponding indices - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 ALLOCATE (buffer_rec(imepos)%msg(num_entries_rec(imepos))) buffer_rec(imepos)%msg = 0.0_dp @@ -1274,10 +1274,10 @@ SUBROUTINE reflect_mat_row(mat_reflected, mat_orig, para_env, qs_env, unit_nr, d END DO - ALLOCATE (block_counter(0:para_env%num_pe-1)) + ALLOCATE (block_counter(0:para_env%num_pe - 1)) block_counter(:) = 0 - ALLOCATE (entry_counter(0:para_env%num_pe-1)) + ALLOCATE (entry_counter(0:para_env%num_pe - 1)) entry_counter(:) = 0 CALL dbcsr_iterator_start(iter, mat_orig) @@ -1294,18 +1294,18 @@ SUBROUTINE reflect_mat_row(mat_reflected, mat_orig, para_env, qs_env, unit_nr, d offset = entry_counter(imepos) - buffer_send(imepos)%msg(offset+1:offset+block_size) = & + buffer_send(imepos)%msg(offset + 1:offset + block_size) = & RESHAPE(data_block(1:row_size, 1:col_size), (/block_size/)) - block = block_counter(imepos)+1 + block = block_counter(imepos) + 1 buffer_send(imepos)%indx(block, 1) = row_reflected buffer_send(imepos)%indx(block, 2) = col buffer_send(imepos)%indx(block, 3) = offset - entry_counter(imepos) = entry_counter(imepos)+block_size + entry_counter(imepos) = entry_counter(imepos) + block_size - block_counter(imepos) = block_counter(imepos)+1 + block_counter(imepos) = block_counter(imepos) + 1 END DO @@ -1318,7 +1318,7 @@ SUBROUTINE reflect_mat_row(mat_reflected, mat_orig, para_env, qs_env, unit_nr, d DEALLOCATE (req_array) ! fill the reflected matrix - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 DO i_block = 1, num_blocks_rec(imepos) @@ -1335,7 +1335,7 @@ SUBROUTINE reflect_mat_row(mat_reflected, mat_orig, para_env, qs_env, unit_nr, d offset = buffer_rec(imepos)%indx(i_block, 3) - data_block(:, :) = RESHAPE(buffer_rec(imepos)%msg(offset+1:offset+row_size*col_size), & + data_block(:, :) = RESHAPE(buffer_rec(imepos)%msg(offset + 1:offset + row_size*col_size), & (/row_size, col_size/)) END IF @@ -1348,7 +1348,7 @@ SUBROUTINE reflect_mat_row(mat_reflected, mat_orig, para_env, qs_env, unit_nr, d END DO - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 DEALLOCATE (buffer_rec(imepos)%msg) DEALLOCATE (buffer_rec(imepos)%indx) DEALLOCATE (buffer_send(imepos)%msg) diff --git a/src/rpa_gw_kpoints.F b/src/rpa_gw_kpoints.F index aa76b00ee6..33d364a9da 100644 --- a/src/rpa_gw_kpoints.F +++ b/src/rpa_gw_kpoints.F @@ -199,7 +199,7 @@ SUBROUTINE compute_Wc_real_space_tau_GW(fm_mat_W_tau, cfm_mat_Q, fm_mat_L_re, fm DO iiB = 1, nrow_local i_global = row_indices(iiB) IF (j_global == i_global .AND. i_global <= dimen_RI) THEN - cfm_mat_Q%local_data(iiB, jjB) = cfm_mat_Q%local_data(iiB, jjB)-z_one + cfm_mat_Q%local_data(iiB, jjB) = cfm_mat_Q%local_data(iiB, jjB) - z_one END IF END DO END DO @@ -282,22 +282,22 @@ SUBROUTINE compute_Wc_real_space_tau_GW(fm_mat_W_tau, cfm_mat_Q, fm_mat_L_re, fm ycell = index_to_cell(2, icell) zcell = index_to_cell(3, icell) - arg = REAL(xcell, dp)*xkp(1, ikp)+REAL(ycell, dp)*xkp(2, ikp)+REAL(zcell, dp)*xkp(3, ikp) + arg = REAL(xcell, dp)*xkp(1, ikp) + REAL(ycell, dp)*xkp(2, ikp) + REAL(zcell, dp)*xkp(3, ikp) coskl = wkp_W(ikp)*COS(twopi*arg) sinkl = wkp_W(ikp)*SIN(twopi*arg) cell_vector(1:3) = MATMUL(hmat, REAL(index_to_cell(1:3, icell), dp)) - rab_cell_i(1:3) = pbc(particle_set(iatom)%r(1:3), cell)- & - (pbc(particle_set(jatom)%r(1:3), cell)+cell_vector(1:3)) + rab_cell_i(1:3) = pbc(particle_set(iatom)%r(1:3), cell) - & + (pbc(particle_set(jatom)%r(1:3), cell) + cell_vector(1:3)) - abs_rab_cell = SQRT(rab_cell_i(1)**2+rab_cell_i(2)**2+rab_cell_i(3)**2) + abs_rab_cell = SQRT(rab_cell_i(1)**2 + rab_cell_i(2)**2 + rab_cell_i(3)**2) IF (abs_rab_cell/d_0 < cutoff_exp) THEN - sum_exp = sum_exp+EXP(-abs_rab_cell/d_0) - sum_exp_k_re = sum_exp_k_re+EXP(-abs_rab_cell/d_0)*coskl - sum_exp_k_im = sum_exp_k_im+EXP(-abs_rab_cell/d_0)*sinkl + sum_exp = sum_exp + EXP(-abs_rab_cell/d_0) + sum_exp_k_re = sum_exp_k_re + EXP(-abs_rab_cell/d_0)*coskl + sum_exp_k_im = sum_exp_k_im + EXP(-abs_rab_cell/d_0)*sinkl END IF END DO @@ -310,10 +310,10 @@ SUBROUTINE compute_Wc_real_space_tau_GW(fm_mat_W_tau, cfm_mat_Q, fm_mat_L_re, fm END IF - contribution = weight_re*REAL(cfm_mat_work_2%local_data(irow, jcol))+ & + contribution = weight_re*REAL(cfm_mat_work_2%local_data(irow, jcol)) + & weight_im*AIMAG(cfm_mat_work_2%local_data(irow, jcol)) - fm_mat_work_local%local_data(irow, jcol) = fm_mat_work_local%local_data(irow, jcol)+contribution + fm_mat_work_local%local_data(irow, jcol) = fm_mat_work_local%local_data(irow, jcol) + contribution END DO END DO @@ -506,7 +506,7 @@ SUBROUTINE compute_Wc_kp_tau_GW(cfm_mat_W_kp_tau, cfm_mat_Q, fm_mat_L_re, fm_mat DO iiB = 1, nrow_local i_global = row_indices(iiB) IF (j_global == i_global .AND. i_global <= dimen_RI) THEN - cfm_mat_Q%local_data(iiB, jjB) = cfm_mat_Q%local_data(iiB, jjB)-z_one + cfm_mat_Q%local_data(iiB, jjB) = cfm_mat_Q%local_data(iiB, jjB) - z_one END IF END DO END DO @@ -595,18 +595,18 @@ SUBROUTINE compute_wkp_W(wkp_W, kpoints, h_mat, h_inv, exp_kpoints, periodic) DO j_y = 1, nsuperfine DO k_z = 1, nsuperfine/2 - x_vec = (/REAL(i_x-nsuperfine/2, dp)-0.5_dp, & - REAL(j_y-nsuperfine/2, dp)-0.5_dp, & - REAL(k_z-nsuperfine/2, dp)-0.5_dp/)/ & + x_vec = (/REAL(i_x - nsuperfine/2, dp) - 0.5_dp, & + REAL(j_y - nsuperfine/2, dp) - 0.5_dp, & + REAL(k_z - nsuperfine/2, dp) - 0.5_dp/)/ & REAL(nsuperfine, dp) k_vec = MATMUL(h_inv(1:3, 1:3), x_vec) - k_sq = k_vec(1)**2+k_vec(2)**2+k_vec(3)**2 - integral = integral+weight*k_sq**(exp_kpoints*0.5_dp) + k_sq = k_vec(1)**2 + k_vec(2)**2 + k_vec(3)**2 + integral = integral + weight*k_sq**(exp_kpoints*0.5_dp) END DO END DO END DO - num_lin_eqs = nkp+2 + num_lin_eqs = nkp + 2 ALLOCATE (matrix_lin_eqs(num_lin_eqs, num_lin_eqs)) matrix_lin_eqs(:, :) = 0.0_dp @@ -614,14 +614,14 @@ SUBROUTINE compute_wkp_W(wkp_W, kpoints, h_mat, h_inv, exp_kpoints, periodic) DO ikp = 1, nkp k_vec = MATMUL(h_inv(1:3, 1:3), xkp(1:3, ikp)) - k_sq = k_vec(1)**2+k_vec(2)**2+k_vec(3)**2 + k_sq = k_vec(1)**2 + k_vec(2)**2 + k_vec(3)**2 matrix_lin_eqs(ikp, ikp) = 2.0_dp - matrix_lin_eqs(ikp, nkp+1) = 1.0_dp - matrix_lin_eqs(ikp, nkp+2) = 1.0_dp*k_sq**(exp_kpoints*0.5_dp) + matrix_lin_eqs(ikp, nkp + 1) = 1.0_dp + matrix_lin_eqs(ikp, nkp + 2) = 1.0_dp*k_sq**(exp_kpoints*0.5_dp) - matrix_lin_eqs(nkp+1, ikp) = 1.0_dp - matrix_lin_eqs(nkp+2, ikp) = 1.0_dp*k_sq**(exp_kpoints*0.5_dp) + matrix_lin_eqs(nkp + 1, ikp) = 1.0_dp + matrix_lin_eqs(nkp + 2, ikp) = 1.0_dp*k_sq**(exp_kpoints*0.5_dp) END DO @@ -633,8 +633,8 @@ SUBROUTINE compute_wkp_W(wkp_W, kpoints, h_mat, h_inv, exp_kpoints, periodic) ALLOCATE (right_side(num_lin_eqs)) right_side = 0.0_dp - right_side(nkp+1) = 1.0_dp - right_side(nkp+2) = integral + right_side(nkp + 1) = 1.0_dp + right_side(nkp + 2) = integral wkp_W(1:num_lin_eqs) = MATMUL(matrix_lin_eqs, right_side) @@ -672,9 +672,9 @@ SUBROUTINE compute_wkp_W(wkp_W, kpoints, h_mat, h_inv, exp_kpoints, periodic) DO j_y = 1, n_y DO k_z = 1, n_z - x_vec = (/REAL(i_x-nsuperfine/2, dp)-0.5_dp, & - REAL(j_y-nsuperfine/2, dp)-0.5_dp, & - REAL(k_z-nsuperfine/2, dp)-0.5_dp/)/ & + x_vec = (/REAL(i_x - nsuperfine/2, dp) - 0.5_dp, & + REAL(j_y - nsuperfine/2, dp) - 0.5_dp, & + REAL(k_z - nsuperfine/2, dp) - 0.5_dp/)/ & REAL(nsuperfine, dp) DO i_dim = 1, 3 @@ -684,13 +684,13 @@ SUBROUTINE compute_wkp_W(wkp_W, kpoints, h_mat, h_inv, exp_kpoints, periodic) END DO k_vec = MATMUL(h_inv(1:3, 1:3), x_vec) - a_vec_dot_k_vec = a_vec(1)*k_vec(1)+a_vec(2)*k_vec(2)+a_vec(3)*k_vec(3) - integral = integral+weight*LOG(2.0_dp-2.0_dp*COS(a_vec_dot_k_vec)) + a_vec_dot_k_vec = a_vec(1)*k_vec(1) + a_vec(2)*k_vec(2) + a_vec(3)*k_vec(3) + integral = integral + weight*LOG(2.0_dp - 2.0_dp*COS(a_vec_dot_k_vec)) END DO END DO END DO - num_lin_eqs = nkp+2 + num_lin_eqs = nkp + 2 ALLOCATE (matrix_lin_eqs(num_lin_eqs, num_lin_eqs)) matrix_lin_eqs(:, :) = 0.0_dp @@ -698,16 +698,16 @@ SUBROUTINE compute_wkp_W(wkp_W, kpoints, h_mat, h_inv, exp_kpoints, periodic) DO ikp = 1, nkp k_vec = MATMUL(h_inv(1:3, 1:3), xkp(1:3, ikp)) - k_sq = k_vec(1)**2+k_vec(2)**2+k_vec(3)**2 + k_sq = k_vec(1)**2 + k_vec(2)**2 + k_vec(3)**2 matrix_lin_eqs(ikp, ikp) = 2.0_dp - matrix_lin_eqs(ikp, nkp+1) = 1.0_dp + matrix_lin_eqs(ikp, nkp + 1) = 1.0_dp - a_vec_dot_k_vec = a_vec(1)*k_vec(1)+a_vec(2)*k_vec(2)+a_vec(3)*k_vec(3) - matrix_lin_eqs(ikp, nkp+2) = LOG(2.0_dp-2.0_dp*COS(a_vec_dot_k_vec)) + a_vec_dot_k_vec = a_vec(1)*k_vec(1) + a_vec(2)*k_vec(2) + a_vec(3)*k_vec(3) + matrix_lin_eqs(ikp, nkp + 2) = LOG(2.0_dp - 2.0_dp*COS(a_vec_dot_k_vec)) - matrix_lin_eqs(nkp+1, ikp) = 1.0_dp - matrix_lin_eqs(nkp+2, ikp) = LOG(2.0_dp-2.0_dp*COS(a_vec_dot_k_vec)) + matrix_lin_eqs(nkp + 1, ikp) = 1.0_dp + matrix_lin_eqs(nkp + 2, ikp) = LOG(2.0_dp - 2.0_dp*COS(a_vec_dot_k_vec)) END DO @@ -719,8 +719,8 @@ SUBROUTINE compute_wkp_W(wkp_W, kpoints, h_mat, h_inv, exp_kpoints, periodic) ALLOCATE (right_side(num_lin_eqs)) right_side = 0.0_dp - right_side(nkp+1) = 1.0_dp - right_side(nkp+2) = integral + right_side(nkp + 1) = 1.0_dp + right_side(nkp + 2) = integral wkp_W(1:num_lin_eqs) = MATMUL(matrix_lin_eqs, right_side) @@ -1130,9 +1130,9 @@ SUBROUTINE cell_sum_self_ener(vec_Sigma_c_gw, vec_Sigma_x_gw, vec_Sigma_x_minus_ IF (cycle_R1_S2_n_level(i_cell_R1_plus_S2, i_cell_S2, n_level_gw, jquad)) CYCLE - x_cell_R1 = x_cell_R1_plus_S2-index_to_cell_3c(1, i_cell_S2) - y_cell_R1 = y_cell_R1_plus_S2-index_to_cell_3c(2, i_cell_S2) - z_cell_R1 = z_cell_R1_plus_S2-index_to_cell_3c(3, i_cell_S2) + x_cell_R1 = x_cell_R1_plus_S2 - index_to_cell_3c(1, i_cell_S2) + y_cell_R1 = y_cell_R1_plus_S2 - index_to_cell_3c(2, i_cell_S2) + z_cell_R1 = z_cell_R1_plus_S2 - index_to_cell_3c(3, i_cell_S2) CALL trafo_I_T_R1_plus_S2_to_M_R1_S2(mat_I_muP_occ_re, mat_I_muP_virt_re, & mat_I_muP_occ_im, mat_I_muP_virt_im, & @@ -1164,13 +1164,13 @@ SUBROUTINE cell_sum_self_ener(vec_Sigma_c_gw, vec_Sigma_x_gw, vec_Sigma_x_minus_ END DO ! jquad END DO ! R1+S2 - vec_Sigma_x_minus_vxc_gw(:) = vec_Sigma_x_minus_vxc_gw(:)+vec_Sigma_x_gw(:) + vec_Sigma_x_minus_vxc_gw(:) = vec_Sigma_x_minus_vxc_gw(:) + vec_Sigma_x_gw(:) im_unit = (0.0_dp, 1.0_dp) - vec_Sigma_c_gw_cos_tau(:, 1:num_integ_points) = 0.5_dp*(vec_Sigma_c_gw_pos_tau(:, 1:num_integ_points)+ & + vec_Sigma_c_gw_cos_tau(:, 1:num_integ_points) = 0.5_dp*(vec_Sigma_c_gw_pos_tau(:, 1:num_integ_points) + & vec_Sigma_c_gw_neg_tau(:, 1:num_integ_points)) - vec_Sigma_c_gw_sin_tau(:, 1:num_integ_points) = 0.5_dp*(vec_Sigma_c_gw_pos_tau(:, 1:num_integ_points)- & + vec_Sigma_c_gw_sin_tau(:, 1:num_integ_points) = 0.5_dp*(vec_Sigma_c_gw_pos_tau(:, 1:num_integ_points) - & vec_Sigma_c_gw_neg_tau(:, 1:num_integ_points)) ! Fourier transform from time to frequency @@ -1183,10 +1183,10 @@ SUBROUTINE cell_sum_self_ener(vec_Sigma_c_gw, vec_Sigma_x_gw, vec_Sigma_x_minus_ weight_cos = weights_cos_tf_t_to_w(jquad, iquad)*COS(omega*tau) weight_sin = weights_sin_tf_t_to_w(jquad, iquad)*SIN(omega*tau) - vec_Sigma_c_gw_cos_omega(:, jquad) = vec_Sigma_c_gw_cos_omega(:, jquad)+ & + vec_Sigma_c_gw_cos_omega(:, jquad) = vec_Sigma_c_gw_cos_omega(:, jquad) + & weight_cos*vec_Sigma_c_gw_cos_tau(:, iquad) - vec_Sigma_c_gw_sin_omega(:, jquad) = vec_Sigma_c_gw_sin_omega(:, jquad)+ & + vec_Sigma_c_gw_sin_omega(:, jquad) = vec_Sigma_c_gw_sin_omega(:, jquad) + & weight_sin*vec_Sigma_c_gw_sin_tau(:, iquad) END DO @@ -1198,7 +1198,7 @@ SUBROUTINE cell_sum_self_ener(vec_Sigma_c_gw, vec_Sigma_x_gw, vec_Sigma_x_minus_ vec_Sigma_c_gw_sin_omega(1:gw_corr_lev_occ, :) = -vec_Sigma_c_gw_sin_omega(1:gw_corr_lev_occ, :) ! the third index k-point is already absorbed when calling the subroutine - vec_Sigma_c_gw(:, 1:num_fit_points) = vec_Sigma_c_gw_cos_omega(:, 1:num_fit_points)+ & + vec_Sigma_c_gw(:, 1:num_fit_points) = vec_Sigma_c_gw_cos_omega(:, 1:num_fit_points) + & im_unit*vec_Sigma_c_gw_sin_omega(:, 1:num_fit_points) DEALLOCATE (vec_Sigma_c_gw_pos_tau) @@ -1286,7 +1286,7 @@ SUBROUTINE trace_for_self_ener(mat_contr_W_re, mat_contr_W_im, n_level_gw, jquad mat_contr_W_re, & trace_neg_tau_im_2) - IF (ABS(trace_neg_tau_re_1)+ABS(trace_neg_tau_re_2)+ABS(trace_neg_tau_im_1)+ & + IF (ABS(trace_neg_tau_re_1) + ABS(trace_neg_tau_re_2) + ABS(trace_neg_tau_im_1) + & ABS(trace_neg_tau_im_2) < eps_filter) THEN cycle_R1_S2_n_level(i_cell_R1_plus_S2, i_cell_S2, n_level_gw, jquad) = .TRUE. END IF @@ -1295,22 +1295,22 @@ SUBROUTINE trace_for_self_ener(mat_contr_W_re, mat_contr_W_im, n_level_gw, jquad cycle_R1_plus_S2_n_level(i_cell_R1_plus_S2, n_level_gw, jquad) = .TRUE. END IF - IF (ABS(trace_neg_tau_re_1)+ABS(trace_neg_tau_re_2)+ABS(trace_neg_tau_im_1)+ & + IF (ABS(trace_neg_tau_re_1) + ABS(trace_neg_tau_re_2) + ABS(trace_neg_tau_im_1) + & ABS(trace_neg_tau_im_2) > eps_filter) THEN cycle_R1_plus_S2_n_level(i_cell_R1_plus_S2, n_level_gw, jquad) = .FALSE. END IF IF (jquad == 0) THEN - n_level_gw_ref = n_level_gw+homo-gw_corr_lev_occ + n_level_gw_ref = n_level_gw + homo - gw_corr_lev_occ - vec_Sigma_x_gw(n_level_gw_ref) = vec_Sigma_x_gw(n_level_gw_ref)+trace_neg_tau_re_1-trace_neg_tau_re_2 + vec_Sigma_x_gw(n_level_gw_ref) = vec_Sigma_x_gw(n_level_gw_ref) + trace_neg_tau_re_1 - trace_neg_tau_re_2 ELSE - vec_Sigma_c_gw_neg_tau(n_level_gw, jquad) = vec_Sigma_c_gw_neg_tau(n_level_gw, jquad)+ & - CMPLX(trace_neg_tau_re_1-trace_neg_tau_re_2, & - trace_neg_tau_im_1+trace_neg_tau_im_2, dp) + vec_Sigma_c_gw_neg_tau(n_level_gw, jquad) = vec_Sigma_c_gw_neg_tau(n_level_gw, jquad) + & + CMPLX(trace_neg_tau_re_1 - trace_neg_tau_re_2, & + trace_neg_tau_im_1 + trace_neg_tau_im_2, dp) END IF @@ -1332,9 +1332,9 @@ SUBROUTINE trace_for_self_ener(mat_contr_W_re, mat_contr_W_im, n_level_gw, jquad IF (jquad > 0) THEN - vec_Sigma_c_gw_pos_tau(n_level_gw, jquad) = vec_Sigma_c_gw_pos_tau(n_level_gw, jquad)+ & - CMPLX(trace_pos_tau_re_1-trace_pos_tau_re_2, & - trace_pos_tau_im_1+trace_pos_tau_im_2, dp) + vec_Sigma_c_gw_pos_tau(n_level_gw, jquad) = vec_Sigma_c_gw_pos_tau(n_level_gw, jquad) + & + CMPLX(trace_pos_tau_re_1 - trace_pos_tau_re_2, & + trace_pos_tau_im_1 + trace_pos_tau_im_2, dp) END IF @@ -1409,9 +1409,9 @@ SUBROUTINE mult_3c_with_W(mat_W_R, mat_3c_overl_int_gw_kp_re, mat_3c_overl_int_g DO i_cell_R1_minus_R2 = 1, num_cells_3c - x_cell_R2 = x_cell_R1-index_to_cell_3c(1, i_cell_R1_minus_R2) - y_cell_R2 = y_cell_R1-index_to_cell_3c(2, i_cell_R1_minus_R2) - z_cell_R2 = z_cell_R1-index_to_cell_3c(3, i_cell_R1_minus_R2) + x_cell_R2 = x_cell_R1 - index_to_cell_3c(1, i_cell_R1_minus_R2) + y_cell_R2 = y_cell_R1 - index_to_cell_3c(2, i_cell_R1_minus_R2) + z_cell_R2 = z_cell_R1 - index_to_cell_3c(3, i_cell_R1_minus_R2) IF (x_cell_R2 < bound_R2_1 .OR. & x_cell_R2 > bound_R2_2 .OR. & @@ -1426,9 +1426,9 @@ SUBROUTINE mult_3c_with_W(mat_W_R, mat_3c_overl_int_gw_kp_re, mat_3c_overl_int_g i_cell_R2 = cell_to_index_R2(x_cell_R2, y_cell_R2, z_cell_R2) - x_cell_R1_plus_S2_minus_R2 = x_cell_R1_plus_S2-x_cell_R2 - y_cell_R1_plus_S2_minus_R2 = y_cell_R1_plus_S2-y_cell_R2 - z_cell_R1_plus_S2_minus_R2 = z_cell_R1_plus_S2-z_cell_R2 + x_cell_R1_plus_S2_minus_R2 = x_cell_R1_plus_S2 - x_cell_R2 + y_cell_R1_plus_S2_minus_R2 = y_cell_R1_plus_S2 - y_cell_R2 + z_cell_R1_plus_S2_minus_R2 = z_cell_R1_plus_S2 - z_cell_R2 IF (x_cell_R1_plus_S2_minus_R2 < bound_1 .OR. & x_cell_R1_plus_S2_minus_R2 > bound_2 .OR. & @@ -1523,10 +1523,10 @@ SUBROUTINE trafo_I_T_R1_plus_S2_to_M_R1_S2(mat_I_muP_occ_re, mat_I_muP_virt_re, DO i_cell_T = 1, num_cells_3c - xcell = index_to_cell_3c(1, i_cell_T)-x_cell_R1 - ycell = index_to_cell_3c(2, i_cell_T)-y_cell_R1 - zcell = index_to_cell_3c(3, i_cell_T)-z_cell_R1 - arg = REAL(xcell, dp)*xkp(1, ikp)+REAL(ycell, dp)*xkp(2, ikp)+REAL(zcell, dp)*xkp(3, ikp) + xcell = index_to_cell_3c(1, i_cell_T) - x_cell_R1 + ycell = index_to_cell_3c(2, i_cell_T) - y_cell_R1 + zcell = index_to_cell_3c(3, i_cell_T) - z_cell_R1 + arg = REAL(xcell, dp)*xkp(1, ikp) + REAL(ycell, dp)*xkp(2, ikp) + REAL(zcell, dp)*xkp(3, ikp) coskl = COS(twopi*arg) sinkl = SIN(twopi*arg) @@ -1572,7 +1572,7 @@ SUBROUTINE dbcsr_scale_and_add_local(mat_A, mat_B, beta) CPASSERT(found) - block_to_compute(:, :) = block_to_compute(:, :)+beta*data_block(:, :) + block_to_compute(:, :) = block_to_compute(:, :) + beta*data_block(:, :) END DO @@ -1670,9 +1670,9 @@ SUBROUTINE compute_I_muP_T_R1_plus_S2(i_cell_R1_plus_S2, x_cell_R1_plus_S2, y_ce DO i_cell_S1 = 1, num_cells_dm - x_cell_2 = x_cell_R1_plus_S2+index_to_cell_dm(1, i_cell_S1) - y_cell_2 = y_cell_R1_plus_S2+index_to_cell_dm(2, i_cell_S1) - z_cell_2 = z_cell_R1_plus_S2+index_to_cell_dm(3, i_cell_S1) + x_cell_2 = x_cell_R1_plus_S2 + index_to_cell_dm(1, i_cell_S1) + y_cell_2 = y_cell_R1_plus_S2 + index_to_cell_dm(2, i_cell_S1) + z_cell_2 = z_cell_R1_plus_S2 + index_to_cell_dm(3, i_cell_S1) IF (x_cell_2 < bound_1 .OR. & x_cell_2 > bound_2 .OR. & @@ -2229,9 +2229,9 @@ SUBROUTINE compute_cell_vec_for_R1_plus_S2_or_R1(index_to_cell_R1_plus_S2, cell_ IF (already_there) CYCLE - x_cell_R1_plus_S2_minus_S1 = x_cell_R1_plus_S2-index_to_cell_dm(1, i_cell_S_1) - y_cell_R1_plus_S2_minus_S1 = y_cell_R1_plus_S2-index_to_cell_dm(2, i_cell_S_1) - z_cell_R1_plus_S2_minus_S1 = z_cell_R1_plus_S2-index_to_cell_dm(3, i_cell_S_1) + x_cell_R1_plus_S2_minus_S1 = x_cell_R1_plus_S2 - index_to_cell_dm(1, i_cell_S_1) + y_cell_R1_plus_S2_minus_S1 = y_cell_R1_plus_S2 - index_to_cell_dm(2, i_cell_S_1) + z_cell_R1_plus_S2_minus_S1 = z_cell_R1_plus_S2 - index_to_cell_dm(3, i_cell_S_1) IF (x_cell_R1_plus_S2_minus_S1 .GE. bound_1 .AND. & x_cell_R1_plus_S2_minus_S1 .LE. bound_2 .AND. & @@ -2256,11 +2256,11 @@ SUBROUTINE compute_cell_vec_for_R1_plus_S2_or_R1(index_to_cell_R1_plus_S2, cell_ ALLOCATE (index_to_cell_tmp(3, size_set)) index_to_cell_tmp(1:3, 1:size_set) = index_to_cell_R1_plus_S2(1:3, 1:size_set) DEALLOCATE (index_to_cell_R1_plus_S2) - ALLOCATE (index_to_cell_R1_plus_S2(3, size_set+1)) + ALLOCATE (index_to_cell_R1_plus_S2(3, size_set + 1)) index_to_cell_R1_plus_S2(1:3, 1:size_set) = index_to_cell_tmp(1:3, 1:size_set) - index_to_cell_R1_plus_S2(1, size_set+1) = x_cell_R1_plus_S2 - index_to_cell_R1_plus_S2(2, size_set+1) = y_cell_R1_plus_S2 - index_to_cell_R1_plus_S2(3, size_set+1) = z_cell_R1_plus_S2 + index_to_cell_R1_plus_S2(1, size_set + 1) = x_cell_R1_plus_S2 + index_to_cell_R1_plus_S2(2, size_set + 1) = y_cell_R1_plus_S2 + index_to_cell_R1_plus_S2(3, size_set + 1) = z_cell_R1_plus_S2 DEALLOCATE (index_to_cell_tmp) already_there = .TRUE. @@ -2422,11 +2422,11 @@ SUBROUTINE get_mat_3c_gw_kp(mat_3c_overl_int, ikp, & ! set MO coeffs to zero for non-GW corrected levels DO irow_global = 1, nmo - DO icol_global = 1, homo-gw_corr_lev_occ + DO icol_global = 1, homo - gw_corr_lev_occ CALL cp_fm_set_element(fm_mat_mo_coeff_gw_re, irow_global, icol_global, 0.0_dp) CALL cp_fm_set_element(fm_mat_mo_coeff_gw_im, irow_global, icol_global, 0.0_dp) END DO - DO icol_global = homo+gw_corr_lev_virt+1, nmo + DO icol_global = homo + gw_corr_lev_virt + 1, nmo CALL cp_fm_set_element(fm_mat_mo_coeff_gw_re, irow_global, icol_global, 0.0_dp) CALL cp_fm_set_element(fm_mat_mo_coeff_gw_im, irow_global, icol_global, 0.0_dp) END DO @@ -2511,7 +2511,7 @@ SUBROUTINE get_mat_3c_gw_kp(mat_3c_overl_int, ikp, & my_group_L_starts_im_time, my_group_L_sizes_im_time, cut_RI, & para_env, gw_corr_lev_occ, gw_corr_lev_virt, homo) - DO n_level_gw = 1, gw_corr_lev_occ+gw_corr_lev_virt + DO n_level_gw = 1, gw_corr_lev_occ + gw_corr_lev_virt nblks = dbcsr_get_num_blocks(mat_3c_overl_int_gw_kp_re(n_level_gw, i_cell, j_cell)%matrix) CALL mp_sum(nblks, para_env%group) @@ -2665,7 +2665,7 @@ SUBROUTINE trafo_W_from_k_to_R(index_to_cell_R2, mat_W_R, mat_3c_overl_int_gw_kp ycell = index_to_cell_R2(2, icell) zcell = index_to_cell_R2(3, icell) - arg = REAL(xcell, dp)*xkp(1, ik)+REAL(ycell, dp)*xkp(2, ik)+REAL(zcell, dp)*xkp(3, ik) + arg = REAL(xcell, dp)*xkp(1, ik) + REAL(ycell, dp)*xkp(2, ik) + REAL(zcell, dp)*xkp(3, ik) coskl = wkp_W(ik)*COS(twopi*arg) sinkl = wkp_W(ik)*SIN(twopi*arg) diff --git a/src/rpa_im_time.F b/src/rpa_im_time.F index bbeeb3c357..cbe3de3359 100644 --- a/src/rpa_im_time.F +++ b/src/rpa_im_time.F @@ -306,7 +306,7 @@ SUBROUTINE compute_mat_P_omega_t(mat_P_omega, fm_scaled_dm_occ_tau, & CALL dbcsr_t_create(t_3c_M, t_3c_M_occ, name="M occ (RI | AO AO)") CALL dbcsr_t_create(t_3c_M, t_3c_M_virt, name="M virt (RI | AO AO)") - DO i_cell_T = 1, num_cells_dm/2+1 + DO i_cell_T = 1, num_cells_dm/2 + 1 IF (.NOT. does_mat_P_T_tau_have_blocks(i_cell_T)) CYCLE @@ -573,7 +573,7 @@ SUBROUTINE compute_mat_P_omega_t(mat_P_omega, fm_scaled_dm_occ_tau, & t2 = m_walltime() IF (unit_nr_prv > 0) WRITE (unit_nr_prv, '(T3,A,1X,I3,A,11X,F25.6)') & - 'RPA_IM_TIME_INFO| Time for time point', jquad, ':', t2-t1 + 'RPA_IM_TIME_INFO| Time for time point', jquad, ':', t2 - t1 END DO ! time points @@ -824,7 +824,7 @@ SUBROUTINE compute_mat_P_omega(mat_P_omega, fm_scaled_dm_occ_tau, & CALL timestop(handle4) ! loop over T for chi^T(it) - DO i_cell_T = 1, num_cells_dm/2+1 + DO i_cell_T = 1, num_cells_dm/2 + 1 IF (does_mat_P_T_tau_have_blocks(i_cell_T) .EQV. .FALSE.) CYCLE @@ -1193,7 +1193,7 @@ SUBROUTINE sync_does_mat_P_T_tau_have_blocks(does_mat_P_T_tau_have_blocks, para_ END DO IF ((jquad == 1) .AND. (does_mat_P_T_tau_have_blocks(i_cell_T) .EQV. .FALSE.)) THEN - DO j_cell_T_new = i_cell_T+1, SIZE(does_mat_P_T_tau_have_blocks) + DO j_cell_T_new = i_cell_T + 1, SIZE(does_mat_P_T_tau_have_blocks) ! check if there is a cell which is closer to the 0-cell where the P matrix is already zero IF (ABS(index_to_cell_dm(1, i_cell_T)) .LE. ABS(index_to_cell_dm(1, j_cell_T_new)) .AND. & @@ -1217,7 +1217,7 @@ SUBROUTINE sync_does_mat_P_T_tau_have_blocks(does_mat_P_T_tau_have_blocks, para_ END DO - IF (SUM(integ_does_mat_P_T_tau_have_blocks(i_cell_T+1:SIZE(integ_does_mat_P_T_tau_have_blocks))) == 0) THEN + IF (SUM(integ_does_mat_P_T_tau_have_blocks(i_cell_T + 1:SIZE(integ_does_mat_P_T_tau_have_blocks))) == 0) THEN IF (unit_nr > 0) WRITE (UNIT=unit_nr, FMT="(T3,A,T75,i6)") & "RPA_IM_TIME_INFO| Number of periodic images T for Chi_PQ^T(it):", & SUM(integ_does_mat_P_T_tau_have_blocks) @@ -1326,10 +1326,10 @@ SUBROUTINE replicate_dm_to_subgroup(para_env, para_env_sub, mat_dm_global, nmo, NULLIFY (data_block) - ALLOCATE (num_entries_blocks_send(0:2*para_env%num_pe-1)) + ALLOCATE (num_entries_blocks_send(0:2*para_env%num_pe - 1)) num_entries_blocks_send(:) = 0 - ALLOCATE (num_entries_blocks_rec(0:2*para_env%num_pe-1)) + ALLOCATE (num_entries_blocks_rec(0:2*para_env%num_pe - 1)) num_entries_blocks_rec(:) = 0 ngroup = para_env%num_pe/para_env_sub%num_pe @@ -1344,16 +1344,16 @@ SUBROUTINE replicate_dm_to_subgroup(para_env, para_env_sub, mat_dm_global, nmo, row_offset=row_offset, col_offset=col_offset) ! check whether block is in the range of the memory cutoff - IF (row_offset+row_size-1 >= starts_array_cm(i_mem) .AND. row_offset < ends_array_cm(i_mem)) THEN + IF (row_offset + row_size - 1 >= starts_array_cm(i_mem) .AND. row_offset < ends_array_cm(i_mem)) THEN CALL dbcsr_get_stored_coordinates(mat_dm_loc_cut(1, 1, 1)%matrix, row, col, imepos_sub) - DO igroup = 0, ngroup-1 + DO igroup = 0, ngroup - 1 - imepos = imepos_sub+igroup*num_pe_sub + imepos = imepos_sub + igroup*num_pe_sub - num_entries_blocks_send(2*imepos) = num_entries_blocks_send(2*imepos)+row_size*col_size - num_entries_blocks_send(2*imepos+1) = num_entries_blocks_send(2*imepos+1)+1 + num_entries_blocks_send(2*imepos) = num_entries_blocks_send(2*imepos) + row_size*col_size + num_entries_blocks_send(2*imepos + 1) = num_entries_blocks_send(2*imepos + 1) + 1 END DO @@ -1384,11 +1384,11 @@ SUBROUTINE replicate_dm_to_subgroup(para_env, para_env_sub, mat_dm_global, nmo, CALL timeset("get_data_D", handle1) - ALLOCATE (buffer_rec(0:para_env%num_pe-1)) - ALLOCATE (buffer_send(0:para_env%num_pe-1)) + ALLOCATE (buffer_rec(0:para_env%num_pe - 1)) + ALLOCATE (buffer_send(0:para_env%num_pe - 1)) ! allocate data message and corresponding indices - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 ALLOCATE (buffer_rec(imepos)%msg(num_entries_blocks_rec(2*imepos))) buffer_rec(imepos)%msg = 0.0_dp @@ -1396,18 +1396,18 @@ SUBROUTINE replicate_dm_to_subgroup(para_env, para_env_sub, mat_dm_global, nmo, ALLOCATE (buffer_send(imepos)%msg(num_entries_blocks_send(2*imepos))) buffer_send(imepos)%msg = 0.0_dp - ALLOCATE (buffer_rec(imepos)%indx(num_entries_blocks_rec(2*imepos+1), 3)) + ALLOCATE (buffer_rec(imepos)%indx(num_entries_blocks_rec(2*imepos + 1), 3)) buffer_rec(imepos)%indx = 0 - ALLOCATE (buffer_send(imepos)%indx(num_entries_blocks_send(2*imepos+1), 3)) + ALLOCATE (buffer_send(imepos)%indx(num_entries_blocks_send(2*imepos + 1), 3)) buffer_send(imepos)%indx = 0 END DO - ALLOCATE (entry_counter(0:para_env%num_pe-1)) + ALLOCATE (entry_counter(0:para_env%num_pe - 1)) entry_counter(:) = 0 - ALLOCATE (blk_counter(0:para_env%num_pe-1)) + ALLOCATE (blk_counter(0:para_env%num_pe - 1)) blk_counter = 0 CALL dbcsr_iterator_start(iter, mat_dm_global(jquad, i_cell)%matrix) @@ -1418,24 +1418,24 @@ SUBROUTINE replicate_dm_to_subgroup(para_env, para_env_sub, mat_dm_global, nmo, row_offset=row_offset, col_offset=col_offset) ! check whether block is in the range of the memory cutoff - IF (row_offset+row_size-1 >= starts_array_cm(i_mem) .AND. row_offset < ends_array_cm(i_mem)) THEN + IF (row_offset + row_size - 1 >= starts_array_cm(i_mem) .AND. row_offset < ends_array_cm(i_mem)) THEN CALL dbcsr_get_stored_coordinates(mat_dm_loc_cut(1, 1, 1)%matrix, row, col, imepos_sub) - DO igroup = 0, ngroup-1 + DO igroup = 0, ngroup - 1 - imepos = imepos_sub+igroup*num_pe_sub + imepos = imepos_sub + igroup*num_pe_sub msg_offset = entry_counter(imepos) block_size = row_size*col_size - buffer_send(imepos)%msg(msg_offset+1:msg_offset+block_size) = & + buffer_send(imepos)%msg(msg_offset + 1:msg_offset + block_size) = & RESHAPE(data_block(1:row_size, 1:col_size), (/block_size/)) - entry_counter(imepos) = entry_counter(imepos)+block_size + entry_counter(imepos) = entry_counter(imepos) + block_size - blk_counter(imepos) = blk_counter(imepos)+1 + blk_counter(imepos) = blk_counter(imepos) + 1 block_offset = blk_counter(imepos) @@ -1457,10 +1457,10 @@ SUBROUTINE replicate_dm_to_subgroup(para_env, para_env_sub, mat_dm_global, nmo, ALLOCATE (req_array(1:para_env%num_pe, 4)) - ALLOCATE (sizes_rec(0:para_env%num_pe-1)) - ALLOCATE (sizes_send(0:para_env%num_pe-1)) + ALLOCATE (sizes_rec(0:para_env%num_pe - 1)) + ALLOCATE (sizes_send(0:para_env%num_pe - 1)) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 sizes_send(imepos) = num_entries_blocks_send(2*imepos) sizes_rec(imepos) = num_entries_blocks_rec(2*imepos) @@ -1487,7 +1487,7 @@ SUBROUTINE replicate_dm_to_subgroup(para_env, para_env_sub, mat_dm_global, nmo, DO i_block = 1, nblkrows_total IF (i_entry >= row_blk_offset(i_block) .AND. & - i_entry <= row_blk_offset(i_block)+row_blk_size(i_block)-1) THEN + i_entry <= row_blk_offset(i_block) + row_blk_size(i_block) - 1) THEN row_block_from_index(i_entry) = i_block @@ -1503,8 +1503,8 @@ SUBROUTINE replicate_dm_to_subgroup(para_env, para_env_sub, mat_dm_global, nmo, num_blocks = 0 ! get the number of blocks, which have to be allocated - DO imepos = 0, para_env%num_pe-1 - num_blocks = num_blocks+num_entries_blocks_rec(2*imepos+1) + DO imepos = 0, para_env%num_pe - 1 + num_blocks = num_blocks + num_entries_blocks_rec(2*imepos + 1) END DO ALLOCATE (rows_to_allocate_all(num_blocks)) @@ -1515,11 +1515,11 @@ SUBROUTINE replicate_dm_to_subgroup(para_env, para_env_sub, mat_dm_global, nmo, block_counter = 0 - DO i_mepos = 0, para_env%num_pe-1 + DO i_mepos = 0, para_env%num_pe - 1 - DO i_block = 1, num_entries_blocks_rec(2*i_mepos+1) + DO i_block = 1, num_entries_blocks_rec(2*i_mepos + 1) - block_counter = block_counter+1 + block_counter = block_counter + 1 rows_to_allocate_all(block_counter) = buffer_rec(i_mepos)%indx(i_block, 1) cols_to_allocate_all(block_counter) = buffer_rec(i_mepos)%indx(i_block, 2) @@ -1545,7 +1545,7 @@ SUBROUTINE replicate_dm_to_subgroup(para_env, para_env_sub, mat_dm_global, nmo, IF (ANY(non_zero_blocks_3c(i_cut_RI, :, :) == col)) THEN - counter_blk_to_alloc(i_cut_RI) = counter_blk_to_alloc(i_cut_RI)+1 + counter_blk_to_alloc(i_cut_RI) = counter_blk_to_alloc(i_cut_RI) + 1 block_counter = counter_blk_to_alloc(i_cut_RI) rows_to_allocate(block_counter, i_cut_RI) = row @@ -1611,9 +1611,9 @@ SUBROUTINE replicate_dm_to_subgroup(para_env, para_env_sub, mat_dm_global, nmo, CALL dbcsr_iterator_next_block(iter, row, col, data_block, & row_size=row_size, col_size=col_size) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 - DO i_block = 1, num_entries_blocks_rec(2*imepos+1) + DO i_block = 1, num_entries_blocks_rec(2*imepos + 1) row_from_buffer = buffer_rec(imepos)%indx(i_block, 1) col_from_buffer = buffer_rec(imepos)%indx(i_block, 2) @@ -1622,7 +1622,7 @@ SUBROUTINE replicate_dm_to_subgroup(para_env, para_env_sub, mat_dm_global, nmo, IF (row == row_from_buffer .AND. col == col_from_buffer) THEN data_block(1:row_size, 1:col_size) = & - RESHAPE(buffer_rec(imepos)%msg(offset+1:offset+row_size*col_size), & + RESHAPE(buffer_rec(imepos)%msg(offset + 1:offset + row_size*col_size), & (/row_size, col_size/)) END IF @@ -1639,7 +1639,7 @@ SUBROUTINE replicate_dm_to_subgroup(para_env, para_env_sub, mat_dm_global, nmo, CALL timestop(handle1) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 DEALLOCATE (buffer_rec(imepos)%msg) DEALLOCATE (buffer_rec(imepos)%indx) DEALLOCATE (buffer_send(imepos)%msg) @@ -1732,13 +1732,13 @@ SUBROUTINE fill_mat_P_global_from_mat_P_local(mat_P_global, mat_P_global_copy, m CALL dbcsr_set(mat_P_global%matrix, 0.0_dp) CALL dbcsr_set(mat_P_global_copy%matrix, 0.0_dp) - ALLOCATE (buffer_rec(0:para_env%num_pe-1)) - ALLOCATE (buffer_send(0:para_env%num_pe-1)) + ALLOCATE (buffer_rec(0:para_env%num_pe - 1)) + ALLOCATE (buffer_send(0:para_env%num_pe - 1)) - ALLOCATE (num_entries_rec(0:para_env%num_pe-1)) - ALLOCATE (num_blocks_rec(0:para_env%num_pe-1)) - ALLOCATE (num_entries_send(0:para_env%num_pe-1)) - ALLOCATE (num_blocks_send(0:para_env%num_pe-1)) + ALLOCATE (num_entries_rec(0:para_env%num_pe - 1)) + ALLOCATE (num_blocks_rec(0:para_env%num_pe - 1)) + ALLOCATE (num_entries_send(0:para_env%num_pe - 1)) + ALLOCATE (num_blocks_send(0:para_env%num_pe - 1)) num_entries_rec = 0 num_blocks_rec = 0 num_entries_send = 0 @@ -1752,8 +1752,8 @@ SUBROUTINE fill_mat_P_global_from_mat_P_local(mat_P_global, mat_P_global_copy, m CALL dbcsr_get_stored_coordinates(mat_P_global%matrix, row, col, imepos) - num_entries_send(imepos) = num_entries_send(imepos)+row_size*col_size - num_blocks_send(imepos) = num_blocks_send(imepos)+1 + num_entries_send(imepos) = num_entries_send(imepos) + row_size*col_size + num_blocks_send(imepos) = num_blocks_send(imepos) + 1 END DO @@ -1765,21 +1765,21 @@ SUBROUTINE fill_mat_P_global_from_mat_P_local(mat_P_global, mat_P_global_copy, m IF (para_env%num_pe > 1) THEN - ALLOCATE (sizes_rec(0:2*para_env%num_pe-1)) - ALLOCATE (sizes_send(0:2*para_env%num_pe-1)) + ALLOCATE (sizes_rec(0:2*para_env%num_pe - 1)) + ALLOCATE (sizes_send(0:2*para_env%num_pe - 1)) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 sizes_send(2*imepos) = num_entries_send(imepos) - sizes_send(2*imepos+1) = num_blocks_send(imepos) + sizes_send(2*imepos + 1) = num_blocks_send(imepos) END DO CALL mp_alltoall(sizes_send, sizes_rec, 2, para_env%group) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 num_entries_rec(imepos) = sizes_rec(2*imepos) - num_blocks_rec(imepos) = sizes_rec(2*imepos+1) + num_blocks_rec(imepos) = sizes_rec(2*imepos + 1) END DO DEALLOCATE (sizes_rec, sizes_send) @@ -1796,7 +1796,7 @@ SUBROUTINE fill_mat_P_global_from_mat_P_local(mat_P_global, mat_P_global_copy, m CALL timeset("fill_Q_2_fill_buffer", handle1) ! allocate data message and corresponding indices - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 ALLOCATE (buffer_rec(imepos)%msg(num_entries_rec(imepos))) buffer_rec(imepos)%msg = 0.0_dp @@ -1812,10 +1812,10 @@ SUBROUTINE fill_mat_P_global_from_mat_P_local(mat_P_global, mat_P_global_copy, m END DO - ALLOCATE (block_counter(0:para_env%num_pe-1)) + ALLOCATE (block_counter(0:para_env%num_pe - 1)) block_counter(:) = 0 - ALLOCATE (entry_counter(0:para_env%num_pe-1)) + ALLOCATE (entry_counter(0:para_env%num_pe - 1)) entry_counter(:) = 0 ! fill buffer_send @@ -1831,18 +1831,18 @@ SUBROUTINE fill_mat_P_global_from_mat_P_local(mat_P_global, mat_P_global_copy, m offset = entry_counter(imepos) - buffer_send(imepos)%msg(offset+1:offset+block_size) = & + buffer_send(imepos)%msg(offset + 1:offset + block_size) = & RESHAPE(data_block(1:row_size, 1:col_size), (/block_size/)) - block = block_counter(imepos)+1 + block = block_counter(imepos) + 1 buffer_send(imepos)%indx(block, 1) = row buffer_send(imepos)%indx(block, 2) = col buffer_send(imepos)%indx(block, 3) = offset - entry_counter(imepos) = entry_counter(imepos)+block_size + entry_counter(imepos) = entry_counter(imepos) + block_size - block_counter(imepos) = block_counter(imepos)+1 + block_counter(imepos) = block_counter(imepos) + 1 END DO @@ -1859,9 +1859,9 @@ SUBROUTINE fill_mat_P_global_from_mat_P_local(mat_P_global, mat_P_global_copy, m send_counter = 0 rec_counter = 0 - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 IF (num_entries_rec(imepos) > 0) THEN - rec_counter = rec_counter+1 + rec_counter = rec_counter + 1 CALL mp_irecv(buffer_rec(imepos)%indx, imepos, para_env%group, req_array(rec_counter, 3), tag=4) END IF IF (num_entries_rec(imepos) > 0) THEN @@ -1869,9 +1869,9 @@ SUBROUTINE fill_mat_P_global_from_mat_P_local(mat_P_global, mat_P_global_copy, m END IF END DO - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 IF (num_entries_send(imepos) > 0) THEN - send_counter = send_counter+1 + send_counter = send_counter + 1 CALL mp_isend(buffer_send(imepos)%indx, imepos, para_env%group, req_array(send_counter, 1), tag=4) END IF IF (num_entries_send(imepos) > 0) THEN @@ -1902,7 +1902,7 @@ SUBROUTINE fill_mat_P_global_from_mat_P_local(mat_P_global, mat_P_global_copy, m block_size = row_size*col_size - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 DO block = 1, num_blocks_rec(imepos) @@ -1912,8 +1912,8 @@ SUBROUTINE fill_mat_P_global_from_mat_P_local(mat_P_global, mat_P_global_copy, m offset = buffer_rec(imepos)%indx(block, 3) - data_block(1:row_size, 1:col_size) = data_block(1:row_size, 1:col_size)+ & - RESHAPE(buffer_rec(imepos)%msg(offset+1:offset+ & + data_block(1:row_size, 1:col_size) = data_block(1:row_size, 1:col_size) + & + RESHAPE(buffer_rec(imepos)%msg(offset + 1:offset + & row_size*col_size), & (/row_size, col_size/)) @@ -1934,7 +1934,7 @@ SUBROUTINE fill_mat_P_global_from_mat_P_local(mat_P_global, mat_P_global_copy, m ! just remove the blocks which are exactly zero from mat_P_global CALL dbcsr_filter(mat_P_global%matrix, eps_filter_im_time) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 DEALLOCATE (buffer_rec(imepos)%msg) DEALLOCATE (buffer_send(imepos)%msg) DEALLOCATE (buffer_rec(imepos)%indx) @@ -1989,16 +1989,16 @@ SUBROUTINE print_occupation_3c(mat_munu_array, unit_nr, matrix_name, para_env, c DO i_cut_RI = 1, cut_RI - local_occupation = local_occupation+dbcsr_get_occupation(mat_munu_array(i_cut_RI)%matrix) + local_occupation = local_occupation + dbcsr_get_occupation(mat_munu_array(i_cut_RI)%matrix) END DO local_occupation = local_occupation/REAL(cut_RI, KIND=dp) - ALLOCATE (buffer_send(0:para_env%num_pe-1)) - ALLOCATE (buffer_rec(0:para_env%num_pe-1)) + ALLOCATE (buffer_send(0:para_env%num_pe - 1)) + ALLOCATE (buffer_rec(0:para_env%num_pe - 1)) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 ALLOCATE (buffer_send(imepos)%msg(1)) buffer_send(imepos)%msg(1) = local_occupation @@ -2007,9 +2007,9 @@ SUBROUTINE print_occupation_3c(mat_munu_array, unit_nr, matrix_name, para_env, c IF (para_env%num_pe > 1) THEN - ALLOCATE (req_array(0:para_env%num_pe-1, 2)) + ALLOCATE (req_array(0:para_env%num_pe - 1, 2)) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 CALL mp_isend(buffer_send(imepos)%msg, imepos, para_env%group, req_array(imepos, 1), tag=2) CALL mp_irecv(buffer_rec(imepos)%msg, imepos, para_env%group, req_array(imepos, 2), tag=2) END DO @@ -2024,9 +2024,9 @@ SUBROUTINE print_occupation_3c(mat_munu_array, unit_nr, matrix_name, para_env, c END IF - ALLOCATE (occupation(0:para_env%num_pe-1)) + ALLOCATE (occupation(0:para_env%num_pe - 1)) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 occupation(imepos) = buffer_rec(imepos)%msg(1) @@ -2036,7 +2036,7 @@ SUBROUTINE print_occupation_3c(mat_munu_array, unit_nr, matrix_name, para_env, c min_occupation = MINVAL(occupation) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 DEALLOCATE (buffer_send(imepos)%msg) DEALLOCATE (buffer_rec(imepos)%msg) END DO @@ -2088,10 +2088,10 @@ SUBROUTINE print_occupation_2c(mat_munu, unit_nr, matrix_name, para_env, one_num local_occupation = dbcsr_get_occupation(mat_munu) - ALLOCATE (buffer_send(0:para_env%num_pe-1)) - ALLOCATE (buffer_rec(0:para_env%num_pe-1)) + ALLOCATE (buffer_send(0:para_env%num_pe - 1)) + ALLOCATE (buffer_rec(0:para_env%num_pe - 1)) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 ALLOCATE (buffer_send(imepos)%msg(1)) buffer_send(imepos)%msg(1) = local_occupation @@ -2100,9 +2100,9 @@ SUBROUTINE print_occupation_2c(mat_munu, unit_nr, matrix_name, para_env, one_num IF (para_env%num_pe > 1) THEN - ALLOCATE (req_array(0:para_env%num_pe-1, 2)) + ALLOCATE (req_array(0:para_env%num_pe - 1, 2)) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 CALL mp_isend(buffer_send(imepos)%msg, imepos, para_env%group, req_array(imepos, 1), tag=2) CALL mp_irecv(buffer_rec(imepos)%msg, imepos, para_env%group, req_array(imepos, 2), tag=2) END DO @@ -2117,9 +2117,9 @@ SUBROUTINE print_occupation_2c(mat_munu, unit_nr, matrix_name, para_env, one_num END IF - ALLOCATE (occupation(0:para_env%num_pe-1)) + ALLOCATE (occupation(0:para_env%num_pe - 1)) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 occupation(imepos) = buffer_rec(imepos)%msg(1) @@ -2129,7 +2129,7 @@ SUBROUTINE print_occupation_2c(mat_munu, unit_nr, matrix_name, para_env, one_num min_occupation = MINVAL(occupation) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 DEALLOCATE (buffer_send(imepos)%msg) DEALLOCATE (buffer_rec(imepos)%msg) END DO @@ -2273,9 +2273,9 @@ SUBROUTINE compute_mat_dm_global(fm_scaled_dm_occ_tau, fm_scaled_dm_virt_tau, ta ! hard coded: exponential function gets NaN if argument is negative with large absolute value ! use 69, since e^(-69) = 10^(-30) which should be sufficiently small that it does not matter - IF (ABS(tau*0.5_dp*(Eigenval(i_global)-e_fermi)) < stabilize_exp) THEN + IF (ABS(tau*0.5_dp*(Eigenval(i_global) - e_fermi)) < stabilize_exp) THEN fm_mo_coeff_occ_scaled%local_data(jjB, iiB) = & - fm_mo_coeff_occ%local_data(jjB, iiB)*EXP(tau*0.5_dp*(Eigenval(i_global)-e_fermi)) + fm_mo_coeff_occ%local_data(jjB, iiB)*EXP(tau*0.5_dp*(Eigenval(i_global) - e_fermi)) ELSE fm_mo_coeff_occ_scaled%local_data(jjB, iiB) = 0.0_dp END IF @@ -2295,9 +2295,9 @@ SUBROUTINE compute_mat_dm_global(fm_scaled_dm_occ_tau, fm_scaled_dm_virt_tau, ta DO iiB = 1, ncol_local i_global = col_indices(iiB) - IF (ABS(tau*0.5_dp*(Eigenval(i_global)-e_fermi)) < stabilize_exp) THEN + IF (ABS(tau*0.5_dp*(Eigenval(i_global) - e_fermi)) < stabilize_exp) THEN fm_mo_coeff_virt_scaled%local_data(jjB, iiB) = & - fm_mo_coeff_virt%local_data(jjB, iiB)*EXP(-tau*0.5_dp*(Eigenval(i_global)-e_fermi)) + fm_mo_coeff_virt%local_data(jjB, iiB)*EXP(-tau*0.5_dp*(Eigenval(i_global) - e_fermi)) ELSE fm_mo_coeff_virt_scaled%local_data(jjB, iiB) = 0.0_dp END IF @@ -2382,10 +2382,10 @@ SUBROUTINE compute_mat_dm_global(fm_scaled_dm_occ_tau, fm_scaled_dm_virt_tau, ta ! release memory IF (jquad > 1) THEN - CALL dbcsr_set(mat_dm_occ_global(jquad-1, 1)%matrix, 0.0_dp) - CALL dbcsr_set(mat_dm_virt_global(jquad-1, 1)%matrix, 0.0_dp) - CALL dbcsr_filter(mat_dm_occ_global(jquad-1, 1)%matrix, 0.0_dp) - CALL dbcsr_filter(mat_dm_virt_global(jquad-1, 1)%matrix, 0.0_dp) + CALL dbcsr_set(mat_dm_occ_global(jquad - 1, 1)%matrix, 0.0_dp) + CALL dbcsr_set(mat_dm_virt_global(jquad - 1, 1)%matrix, 0.0_dp) + CALL dbcsr_filter(mat_dm_occ_global(jquad - 1, 1)%matrix, 0.0_dp) + CALL dbcsr_filter(mat_dm_virt_global(jquad - 1, 1)%matrix, 0.0_dp) END IF IF (memory_info) THEN @@ -2398,7 +2398,7 @@ SUBROUTINE compute_mat_dm_global(fm_scaled_dm_occ_tau, fm_scaled_dm_virt_tau, ta END IF ! do kpoints IF (jquad == 1) THEN - ALLOCATE (does_mat_P_T_tau_have_blocks(num_cells_dm/2+1)) + ALLOCATE (does_mat_P_T_tau_have_blocks(num_cells_dm/2 + 1)) does_mat_P_T_tau_have_blocks(:) = .TRUE. END IF @@ -2492,7 +2492,7 @@ SUBROUTINE get_cycle_due_to_sparse_dm(cycle_due_to_sparse_dm, mat_dm_occ_global, DO j_mem = 1, cut_memory ! check whether row index is restricted due to mem_cut and col index due to sparse virt dm - IF (row_offset+row_size-1 >= starts_array_cm_mao_virt(i_mem) .AND. & + IF (row_offset + row_size - 1 >= starts_array_cm_mao_virt(i_mem) .AND. & row_offset < ends_array_cm_mao_virt(i_mem) .AND. & ANY(non_zero_blocks_in_dm_virt(jquad, j_mem, :) == col)) THEN @@ -2502,7 +2502,7 @@ SUBROUTINE get_cycle_due_to_sparse_dm(cycle_due_to_sparse_dm, mat_dm_occ_global, ! check whether row index is restricted due to sparse occ dm and col index due to j_mem ! use the fact that mat_3c_overl_int_cut is symmetric (neglecting the combined col index) - IF (row_offset+row_size-1 >= starts_array_cm_mao_occ(i_mem) .AND. & + IF (row_offset + row_size - 1 >= starts_array_cm_mao_occ(i_mem) .AND. & row_offset < ends_array_cm_mao_occ(i_mem) .AND. & ANY(non_zero_blocks_in_dm_occ(jquad, j_mem, :) == col)) THEN @@ -2540,7 +2540,7 @@ SUBROUTINE get_cycle_due_to_sparse_dm(cycle_due_to_sparse_dm, mat_dm_occ_global, ALLOCATE (cycle_combined(cut_memory, cut_memory, num_integ_points)) cycle_combined = 0 - cycle_combined(:, :, :) = cycle_due_to_sparse_dm_occ_tmp(:, :, :)+ & + cycle_combined(:, :, :) = cycle_due_to_sparse_dm_occ_tmp(:, :, :) + & cycle_due_to_sparse_dm_virt_tmp(:, :, :) DO i_mem = 1, cut_memory @@ -2603,7 +2603,7 @@ SUBROUTINE get_non_zero_blocks_dm(mat_dm_global, non_zero_blocks_in_dm, & DO i_mem = 1, cut_memory ! check whether block is in the range of the memory cutoff - IF (row_offset+row_size-1 >= starts_array_cm(i_mem) .AND. row_offset < ends_array_cm(i_mem)) THEN + IF (row_offset + row_size - 1 >= starts_array_cm(i_mem) .AND. row_offset < ends_array_cm(i_mem)) THEN ! 1 means that the block is there non_zero_blocks_in_dm(jquad, i_mem, col) = 1 @@ -2726,10 +2726,10 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, NULLIFY (data_block) - ALLOCATE (num_entries_send(0:para_env%num_pe-1)) + ALLOCATE (num_entries_send(0:para_env%num_pe - 1)) num_entries_send(:) = 0 - ALLOCATE (num_blocks_send(0:para_env%num_pe-1)) + ALLOCATE (num_blocks_send(0:para_env%num_pe - 1)) num_blocks_send(:) = 0 CALL timestop(handle1) @@ -2750,7 +2750,7 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, row_offset=row_offset, col_offset=col_offset) ! process to send to - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 color_sub_P = imepos/group_size_P mepos_P = MODULO(imepos, group_size_P) @@ -2769,19 +2769,19 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, start_row = starts_array_prim_fullrow(color_sub_row, i_mem) end_row = ends_array_prim_fullrow(color_sub_row, i_mem) - row_size_to_send = end_row-start_row+1 + row_size_to_send = end_row - start_row + 1 ELSE IF (row == starts_array_prim_row(color_sub_row, i_mem)) THEN start_row = starts_array_prim_fullrow(color_sub_row, i_mem) - end_row = row_offset+row_size-1 - row_size_to_send = end_row-start_row+1 + end_row = row_offset + row_size - 1 + row_size_to_send = end_row - start_row + 1 ELSE IF (row == ends_array_prim_row(color_sub_row, i_mem)) THEN start_row = row_offset end_row = ends_array_prim_fullrow(color_sub_row, i_mem) - row_size_to_send = end_row-start_row+1 + row_size_to_send = end_row - start_row + 1 ELSE @@ -2792,21 +2792,21 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, IF (col == starts_array_prim_col(color_sub_col, j_mem) .AND. & col == ends_array_prim_col(color_sub_col, j_mem)) THEN - start_col = (starts_array_prim_fullcol(color_sub_col, j_mem)-1)*my_group_L_size+1 + start_col = (starts_array_prim_fullcol(color_sub_col, j_mem) - 1)*my_group_L_size + 1 end_col = ends_array_prim_fullcol(color_sub_col, j_mem)*my_group_L_size - col_size_to_send = end_col-start_col+1 + col_size_to_send = end_col - start_col + 1 ELSE IF (col == starts_array_prim_col(color_sub_col, j_mem)) THEN - start_col = (starts_array_prim_fullcol(color_sub_col, j_mem)-1)*my_group_L_size+1 - end_col = col_offset+col_size-1 - col_size_to_send = end_col-start_col+1 + start_col = (starts_array_prim_fullcol(color_sub_col, j_mem) - 1)*my_group_L_size + 1 + end_col = col_offset + col_size - 1 + col_size_to_send = end_col - start_col + 1 ELSE IF (col == ends_array_prim_col(color_sub_col, j_mem)) THEN start_col = col_offset end_col = ends_array_prim_fullcol(color_sub_col, j_mem)*my_group_L_size - col_size_to_send = end_col-start_col+1 + col_size_to_send = end_col - start_col + 1 ELSE @@ -2816,12 +2816,12 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, DO LLL = 1, my_group_L_size - IF (mepos_P == mepos_P_from_RI_row(row_from_LLL(LLL+my_group_L_start-1))) THEN + IF (mepos_P == mepos_P_from_RI_row(row_from_LLL(LLL + my_group_L_start - 1))) THEN - num_entries_send(imepos) = num_entries_send(imepos)+ & + num_entries_send(imepos) = num_entries_send(imepos) + & row_size_to_send*col_size_to_send/my_group_L_size - num_blocks_send(imepos) = num_blocks_send(imepos)+1 + num_blocks_send(imepos) = num_blocks_send(imepos) + 1 END IF @@ -2836,7 +2836,7 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, ! col_offset_orig = col_offset/my_group_L_size - col_offset_orig = (col_offset-1)/my_group_L_size+1 + col_offset_orig = (col_offset - 1)/my_group_L_size + 1 IF (col >= starts_array_prim_row(color_sub_row, i_mem) .AND. & col <= ends_array_prim_row(color_sub_row, i_mem) .AND. & @@ -2848,19 +2848,19 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, start_col = starts_array_prim_fullrow(color_sub_row, i_mem) end_col = ends_array_prim_fullrow(color_sub_row, i_mem) - col_size_to_send = (end_col-start_col+1)*my_group_L_size + col_size_to_send = (end_col - start_col + 1)*my_group_L_size ELSE IF (col == starts_array_prim_row(color_sub_row, i_mem)) THEN start_col = starts_array_prim_fullrow(color_sub_row, i_mem) - end_col = col_offset_orig+col_size_orig-1 - col_size_to_send = (end_col-start_col+1)*my_group_L_size + end_col = col_offset_orig + col_size_orig - 1 + col_size_to_send = (end_col - start_col + 1)*my_group_L_size ELSE IF (col == ends_array_prim_row(color_sub_row, i_mem)) THEN start_col = col_offset_orig end_col = ends_array_prim_fullrow(color_sub_row, i_mem) - col_size_to_send = (end_col-start_col+1)*my_group_L_size + col_size_to_send = (end_col - start_col + 1)*my_group_L_size ELSE @@ -2873,19 +2873,19 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, start_row = starts_array_prim_fullcol(color_sub_col, j_mem) end_row = ends_array_prim_fullcol(color_sub_col, j_mem) - row_size_to_send = end_row-start_row+1 + row_size_to_send = end_row - start_row + 1 ELSE IF (row == starts_array_prim_col(color_sub_col, j_mem)) THEN start_row = starts_array_prim_fullcol(color_sub_col, j_mem) - end_row = row_offset+row_size-1 - row_size_to_send = end_row-start_row+1 + end_row = row_offset + row_size - 1 + row_size_to_send = end_row - start_row + 1 ELSE IF (row == ends_array_prim_col(color_sub_col, j_mem)) THEN start_row = row_offset end_row = ends_array_prim_fullcol(color_sub_col, j_mem) - row_size_to_send = end_row-start_row+1 + row_size_to_send = end_row - start_row + 1 ELSE @@ -2895,12 +2895,12 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, DO LLL = 1, my_group_L_size - IF (mepos_P == mepos_P_from_RI_row(row_from_LLL(LLL+my_group_L_start-1))) THEN + IF (mepos_P == mepos_P_from_RI_row(row_from_LLL(LLL + my_group_L_start - 1))) THEN - num_entries_send(imepos) = num_entries_send(imepos)+ & + num_entries_send(imepos) = num_entries_send(imepos) + & row_size_to_send*col_size_to_send/my_group_L_size - num_blocks_send(imepos) = num_blocks_send(imepos)+1 + num_blocks_send(imepos) = num_blocks_send(imepos) + 1 END IF @@ -2925,27 +2925,27 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, CALL timeset("send_sizes_M", handle1) - ALLOCATE (buffer_rec(0:para_env%num_pe-1)) - ALLOCATE (buffer_send(0:para_env%num_pe-1)) + ALLOCATE (buffer_rec(0:para_env%num_pe - 1)) + ALLOCATE (buffer_send(0:para_env%num_pe - 1)) - ALLOCATE (num_entries_rec(0:para_env%num_pe-1)) - ALLOCATE (num_blocks_rec(0:para_env%num_pe-1)) + ALLOCATE (num_entries_rec(0:para_env%num_pe - 1)) + ALLOCATE (num_blocks_rec(0:para_env%num_pe - 1)) IF (para_env%num_pe > 1) THEN - ALLOCATE (sizes_rec(0:2*para_env%num_pe-1)) - ALLOCATE (sizes_send(0:2*para_env%num_pe-1)) + ALLOCATE (sizes_rec(0:2*para_env%num_pe - 1)) + ALLOCATE (sizes_send(0:2*para_env%num_pe - 1)) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 sizes_send(2*imepos) = num_entries_send(imepos) - sizes_send(2*imepos+1) = num_blocks_send(imepos) + sizes_send(2*imepos + 1) = num_blocks_send(imepos) END DO CALL mp_alltoall(sizes_send, sizes_rec, 2, para_env%group) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 num_entries_rec(imepos) = sizes_rec(2*imepos) - num_blocks_rec(imepos) = sizes_rec(2*imepos+1) + num_blocks_rec(imepos) = sizes_rec(2*imepos + 1) END DO DEALLOCATE (sizes_rec, sizes_send) @@ -2962,7 +2962,7 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, CALL timeset("fill_buffer_send_M", handle1) ! allocate data message and corresponding indices - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 ALLOCATE (buffer_rec(imepos)%msg(num_entries_rec(imepos))) buffer_rec(imepos)%msg = 0.0_dp @@ -2978,10 +2978,10 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, END DO - ALLOCATE (entry_counter(0:para_env%num_pe-1)) + ALLOCATE (entry_counter(0:para_env%num_pe - 1)) entry_counter(:) = 0 - ALLOCATE (block_counter(0:para_env%num_pe-1)) + ALLOCATE (block_counter(0:para_env%num_pe - 1)) block_counter(:) = 0 DO i_cut_RI = 1, cut_RI @@ -2997,7 +2997,7 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, row_size=row_size, col_size=col_size, & row_offset=row_offset, col_offset=col_offset) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 ! color_sub_row = imepos/n_group_col ! color_sub_col = MODULO(imepos,n_group_col) @@ -3020,20 +3020,20 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, IF (row == starts_array_prim_row(color_sub_row, i_mem) .AND. & row == ends_array_prim_row(color_sub_row, i_mem)) THEN - row_start_in_data_block = starts_array_prim_fullrow(color_sub_row, i_mem)-row_offset+1 - row_end_in_data_block = ends_array_prim_fullrow(color_sub_row, i_mem)-row_offset+1 + row_start_in_data_block = starts_array_prim_fullrow(color_sub_row, i_mem) - row_offset + 1 + row_end_in_data_block = ends_array_prim_fullrow(color_sub_row, i_mem) - row_offset + 1 ELSE IF (row == starts_array_prim_row(color_sub_row, i_mem) .AND. & row .NE. ends_array_prim_row(color_sub_row, i_mem)) THEN - row_start_in_data_block = starts_array_prim_fullrow(color_sub_row, i_mem)-row_offset+1 + row_start_in_data_block = starts_array_prim_fullrow(color_sub_row, i_mem) - row_offset + 1 row_end_in_data_block = row_size ELSE IF (row .NE. starts_array_prim_row(color_sub_row, i_mem) .AND. & row == ends_array_prim_row(color_sub_row, i_mem)) THEN row_start_in_data_block = 1 - row_end_in_data_block = ends_array_prim_fullrow(color_sub_row, i_mem)-row_offset+1 + row_end_in_data_block = ends_array_prim_fullrow(color_sub_row, i_mem) - row_offset + 1 ELSE @@ -3043,28 +3043,28 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, END IF - row_size_in_data_block = row_end_in_data_block-row_start_in_data_block+1 + row_size_in_data_block = row_end_in_data_block - row_start_in_data_block + 1 - col_offset_orig = (col_offset-1)/my_group_L_size+1 + col_offset_orig = (col_offset - 1)/my_group_L_size + 1 ! For terminal blocks, we have to compute the sizes IF (col == starts_array_prim_col(color_sub_col, j_mem) .AND. & col == ends_array_prim_col(color_sub_col, j_mem)) THEN - col_start_in_data_block = starts_array_prim_fullcol(color_sub_col, j_mem)-col_offset_orig+1 - col_end_in_data_block = ends_array_prim_fullcol(color_sub_col, j_mem)-col_offset_orig+1 + col_start_in_data_block = starts_array_prim_fullcol(color_sub_col, j_mem) - col_offset_orig + 1 + col_end_in_data_block = ends_array_prim_fullcol(color_sub_col, j_mem) - col_offset_orig + 1 ELSE IF (col == starts_array_prim_col(color_sub_col, j_mem) .AND. & col .NE. ends_array_prim_col(color_sub_col, j_mem)) THEN - col_start_in_data_block = starts_array_prim_fullcol(color_sub_col, j_mem)-col_offset_orig+1 + col_start_in_data_block = starts_array_prim_fullcol(color_sub_col, j_mem) - col_offset_orig + 1 col_end_in_data_block = col_size_orig ELSE IF (col .NE. starts_array_prim_col(color_sub_col, j_mem) .AND. & col == ends_array_prim_col(color_sub_col, j_mem)) THEN col_start_in_data_block = 1 - col_end_in_data_block = ends_array_prim_fullcol(color_sub_col, j_mem)-col_offset_orig+1 + col_end_in_data_block = ends_array_prim_fullcol(color_sub_col, j_mem) - col_offset_orig + 1 ELSE @@ -3073,26 +3073,26 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, END IF - col_size_in_data_block = col_end_in_data_block-col_start_in_data_block+1 + col_size_in_data_block = col_end_in_data_block - col_start_in_data_block + 1 block_size = row_size_in_data_block*col_size_in_data_block DO LLL = 1, my_group_L_size - IF (mepos_P .NE. mepos_P_from_RI_row(row_from_LLL(LLL+my_group_L_start-1))) CYCLE + IF (mepos_P .NE. mepos_P_from_RI_row(row_from_LLL(LLL + my_group_L_start - 1))) CYCLE offset = entry_counter(imepos) - col_offset_data_block = (LLL-1)*col_size_orig+col_start_in_data_block + col_offset_data_block = (LLL - 1)*col_size_orig + col_start_in_data_block - buffer_send(imepos)%msg(offset+1:offset+block_size) = & + buffer_send(imepos)%msg(offset + 1:offset + block_size) = & RESHAPE(data_block(row_start_in_data_block:row_end_in_data_block, & - col_offset_data_block:col_offset_data_block+col_size_in_data_block-1), & + col_offset_data_block:col_offset_data_block + col_size_in_data_block - 1), & (/block_size/)) - block = block_counter(imepos)+1 + block = block_counter(imepos) + 1 - buffer_send(imepos)%indx(block, 1) = LLL+my_group_L_start-1 + buffer_send(imepos)%indx(block, 1) = LLL + my_group_L_start - 1 buffer_send(imepos)%indx(block, 2) = row buffer_send(imepos)%indx(block, 3) = row_offset buffer_send(imepos)%indx(block, 4) = row_size @@ -3102,9 +3102,9 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, buffer_send(imepos)%indx(block, 8) = offset buffer_send(imepos)%indx(block, 9) = block_size - entry_counter(imepos) = entry_counter(imepos)+block_size + entry_counter(imepos) = entry_counter(imepos) + block_size - block_counter(imepos) = block_counter(imepos)+1 + block_counter(imepos) = block_counter(imepos) + 1 END DO @@ -3119,26 +3119,26 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, col_size_orig = col_size/my_group_L_size - col_offset_orig = (col_offset-1)/my_group_L_size+1 + col_offset_orig = (col_offset - 1)/my_group_L_size + 1 ! For terminal blocks, we have to compute the sizes IF (col == starts_array_prim_row(color_sub_row, i_mem) .AND. & col == ends_array_prim_row(color_sub_row, i_mem)) THEN - col_start_in_data_block = starts_array_prim_fullrow(color_sub_row, i_mem)-col_offset_orig+1 - col_end_in_data_block = ends_array_prim_fullrow(color_sub_row, i_mem)-col_offset_orig+1 + col_start_in_data_block = starts_array_prim_fullrow(color_sub_row, i_mem) - col_offset_orig + 1 + col_end_in_data_block = ends_array_prim_fullrow(color_sub_row, i_mem) - col_offset_orig + 1 ELSE IF (col == starts_array_prim_row(color_sub_row, i_mem) .AND. & col .NE. ends_array_prim_row(color_sub_row, i_mem)) THEN - col_start_in_data_block = starts_array_prim_fullrow(color_sub_row, i_mem)-col_offset_orig+1 + col_start_in_data_block = starts_array_prim_fullrow(color_sub_row, i_mem) - col_offset_orig + 1 col_end_in_data_block = col_size_orig ELSE IF (col .NE. starts_array_prim_row(color_sub_row, i_mem) .AND. & col == ends_array_prim_row(color_sub_row, i_mem)) THEN col_start_in_data_block = 1 - col_end_in_data_block = ends_array_prim_fullrow(color_sub_row, i_mem)-col_offset_orig+1 + col_end_in_data_block = ends_array_prim_fullrow(color_sub_row, i_mem) - col_offset_orig + 1 ELSE @@ -3147,26 +3147,26 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, END IF - col_size_in_data_block = col_end_in_data_block-col_start_in_data_block+1 + col_size_in_data_block = col_end_in_data_block - col_start_in_data_block + 1 ! For terminal blocks, we have to compute the sizes IF (row == starts_array_prim_col(color_sub_col, j_mem) .AND. & row == ends_array_prim_col(color_sub_col, j_mem)) THEN - row_start_in_data_block = starts_array_prim_fullcol(color_sub_col, j_mem)-row_offset+1 - row_end_in_data_block = ends_array_prim_fullcol(color_sub_col, j_mem)-row_offset+1 + row_start_in_data_block = starts_array_prim_fullcol(color_sub_col, j_mem) - row_offset + 1 + row_end_in_data_block = ends_array_prim_fullcol(color_sub_col, j_mem) - row_offset + 1 ELSE IF (row == starts_array_prim_col(color_sub_col, j_mem) .AND. & row .NE. ends_array_prim_col(color_sub_col, j_mem)) THEN - row_start_in_data_block = starts_array_prim_fullcol(color_sub_col, j_mem)-row_offset+1 + row_start_in_data_block = starts_array_prim_fullcol(color_sub_col, j_mem) - row_offset + 1 row_end_in_data_block = row_size ELSE IF (row .NE. starts_array_prim_col(color_sub_col, j_mem) .AND. & row == ends_array_prim_col(color_sub_col, j_mem)) THEN row_start_in_data_block = 1 - row_end_in_data_block = ends_array_prim_fullcol(color_sub_col, j_mem)-row_offset+1 + row_end_in_data_block = ends_array_prim_fullcol(color_sub_col, j_mem) - row_offset + 1 ELSE @@ -3176,27 +3176,27 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, END IF - row_size_in_data_block = row_end_in_data_block-row_start_in_data_block+1 + row_size_in_data_block = row_end_in_data_block - row_start_in_data_block + 1 block_size = row_size_in_data_block*col_size_in_data_block DO LLL = 1, my_group_L_size - IF (mepos_P .NE. mepos_P_from_RI_row(row_from_LLL(LLL+my_group_L_start-1))) CYCLE + IF (mepos_P .NE. mepos_P_from_RI_row(row_from_LLL(LLL + my_group_L_start - 1))) CYCLE offset = entry_counter(imepos) - col_offset_data_block = (LLL-1)*col_size_orig+col_start_in_data_block + col_offset_data_block = (LLL - 1)*col_size_orig + col_start_in_data_block - buffer_send(imepos)%msg(offset+1:offset+block_size) = & + buffer_send(imepos)%msg(offset + 1:offset + block_size) = & RESHAPE(TRANSPOSE(data_block(row_start_in_data_block:row_end_in_data_block, & - col_offset_data_block:col_offset_data_block+ & - col_size_in_data_block-1)), & + col_offset_data_block:col_offset_data_block + & + col_size_in_data_block - 1)), & (/block_size/)) - block = block_counter(imepos)+1 + block = block_counter(imepos) + 1 - buffer_send(imepos)%indx(block, 1) = LLL+my_group_L_start-1 + buffer_send(imepos)%indx(block, 1) = LLL + my_group_L_start - 1 buffer_send(imepos)%indx(block, 2) = col buffer_send(imepos)%indx(block, 3) = col_offset buffer_send(imepos)%indx(block, 4) = col_size_orig @@ -3206,9 +3206,9 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, buffer_send(imepos)%indx(block, 8) = offset buffer_send(imepos)%indx(block, 9) = block_size - entry_counter(imepos) = entry_counter(imepos)+block_size + entry_counter(imepos) = entry_counter(imepos) + block_size - block_counter(imepos) = block_counter(imepos)+1 + block_counter(imepos) = block_counter(imepos) + 1 END DO @@ -3240,9 +3240,9 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, send_counter = 0 rec_counter = 0 - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 IF (num_entries_rec(imepos) > 0) THEN - rec_counter = rec_counter+1 + rec_counter = rec_counter + 1 CALL mp_irecv(buffer_rec(imepos)%indx, imepos, para_env%group, req_array(rec_counter, 3), tag=4) END IF IF (num_entries_rec(imepos) > 0) THEN @@ -3250,9 +3250,9 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, END IF END DO - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 IF (num_entries_send(imepos) > 0) THEN - send_counter = send_counter+1 + send_counter = send_counter + 1 CALL mp_isend(buffer_send(imepos)%indx, imepos, para_env%group, req_array(send_counter, 1), tag=4) END IF IF (num_entries_send(imepos) > 0) THEN @@ -3270,7 +3270,7 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, END IF - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 DEALLOCATE (buffer_send(imepos)%msg) DEALLOCATE (buffer_send(imepos)%indx) END DO @@ -3282,9 +3282,9 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, num_blocks = 0 ! get the number of blocks, which have to be allocated - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 - num_blocks = num_blocks+num_blocks_rec(imepos) + num_blocks = num_blocks + num_blocks_rec(imepos) END DO @@ -3295,7 +3295,7 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, block_counter_int = 0 - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 DO block = 1, num_blocks_rec(imepos) @@ -3314,7 +3314,7 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, IF (is_new_block .AND. buffer_rec(imepos)%indx(block, 1) .NE. 0) THEN - block_counter_int = block_counter_int+1 + block_counter_int = block_counter_int + 1 rows_to_allocate(block_counter_int) = row_from_LLL(buffer_rec(imepos)%indx(block, 1)) @@ -3359,13 +3359,13 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, buffer_mat_M(:, :) = 0.0_dp - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 DO block = 1, num_blocks_rec(imepos) LLL = buffer_rec(imepos)%indx(block, 1) - IF (LLL >= row_offset .AND. LLL < row_offset+row_size) THEN + IF (LLL >= row_offset .AND. LLL < row_offset + row_size) THEN row_rec_prim = buffer_rec(imepos)%indx(block, 2) row_offset_rec_prim = buffer_rec(imepos)%indx(block, 3) @@ -3374,15 +3374,15 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, offset_rec = buffer_rec(imepos)%indx(block, 8) block_size = buffer_rec(imepos)%indx(block, 9) - row_rec_prim_rel = row_rec_prim-row_offset_prim+1 - col_rec_prim_rel = col_rec_prim-col_offset_prim+1 + row_rec_prim_rel = row_rec_prim - row_offset_prim + 1 + col_rec_prim_rel = col_rec_prim - col_offset_prim + 1 - row_offset_data_block = LLL-row_offset + row_offset_data_block = LLL - row_offset col_offset_data_block = offset_combi_block(row_rec_prim, col_rec_prim) - buffer_mat_M(row_offset_data_block+1, col_offset_data_block+1:col_offset_data_block+block_size) = & - buffer_rec(imepos)%msg(offset_rec+1:offset_rec+block_size) + buffer_mat_M(row_offset_data_block + 1, col_offset_data_block + 1:col_offset_data_block + block_size) = & + buffer_rec(imepos)%msg(offset_rec + 1:offset_rec + block_size) END IF @@ -3398,7 +3398,7 @@ SUBROUTINE fill_mat_M_P_munu_from_M_mu_Pnu(mat_M_P_munu, mat_M_mu_Pnu, para_env, CALL dbcsr_filter(mat_M_P_munu%matrix, eps_filter_im_time) - DO imepos = 0, para_env%num_pe-1 + DO imepos = 0, para_env%num_pe - 1 DEALLOCATE (buffer_rec(imepos)%msg) DEALLOCATE (buffer_rec(imepos)%indx) END DO @@ -3476,27 +3476,27 @@ SUBROUTINE setup_mat_for_mem_cut_3c(mat_3c_overl_int_cut, mat_3c_overl_int, cut_ ! set the block to zero if it is outside the range for cutting the mu-sigma combined index IF (col_offset > ends_array_cm(i_mem)*my_group_L_size .OR. & - col_offset+col_size-1 < (starts_array_cm(i_mem)-1)*my_group_L_size+1) THEN + col_offset + col_size - 1 < (starts_array_cm(i_mem) - 1)*my_group_L_size + 1) THEN data_block = 0.0_dp END IF IF (col_offset >= ends_array_cm(i_mem)*my_group_L_size .AND. & - col_offset+col_size-1 < ends_array_cm(i_mem)*my_group_L_size) THEN + col_offset + col_size - 1 < ends_array_cm(i_mem)*my_group_L_size) THEN - col_end_in_data_block = ends_array_cm(i_mem)*my_group_L_size-col_offset+1 + col_end_in_data_block = ends_array_cm(i_mem)*my_group_L_size - col_offset + 1 - data_block(:, col_end_in_data_block+1:col_size) = 0.0_dp + data_block(:, col_end_in_data_block + 1:col_size) = 0.0_dp END IF - IF (col_offset > (starts_array_cm(i_mem)-1)*my_group_L_size+1 .AND. & - col_offset+col_size-1 <= (starts_array_cm(i_mem)-1)*my_group_L_size+1) THEN + IF (col_offset > (starts_array_cm(i_mem) - 1)*my_group_L_size + 1 .AND. & + col_offset + col_size - 1 <= (starts_array_cm(i_mem) - 1)*my_group_L_size + 1) THEN - col_start_in_data_block = (starts_array_cm(i_mem)-1)*my_group_L_size+1 + col_start_in_data_block = (starts_array_cm(i_mem) - 1)*my_group_L_size + 1 - data_block(:, 1:col_start_in_data_block-1) = 0.0_dp + data_block(:, 1:col_start_in_data_block - 1) = 0.0_dp END IF @@ -3596,7 +3596,7 @@ SUBROUTINE kpoint_density_matrices_rpa(kpoint, tau, e_fermi, stabilize_exp, remo CALL cp_fm_create(fwork, matrix_struct) CALL get_kpoint_info(kpoint, kp_range=kp_range) - kplocal = kp_range(2)-kp_range(1)+1 + kplocal = kp_range(2) - kp_range(1) + 1 DO ikpgr = 1, kplocal kp => kpoint%kp_env(ikpgr)%kpoint_env @@ -3613,7 +3613,7 @@ SUBROUTINE kpoint_density_matrices_rpa(kpoint, tau, e_fermi, stabilize_exp, remo CALL cp_fm_column_scale(fwork, occupation) END IF IF (remove_occ) THEN - CALL cp_fm_column_scale(fwork, 2.0_dp/REAL(nspin, KIND=dp)-occupation) + CALL cp_fm_column_scale(fwork, 2.0_dp/REAL(nspin, KIND=dp) - occupation) END IF ! proper spin @@ -3622,8 +3622,8 @@ SUBROUTINE kpoint_density_matrices_rpa(kpoint, tau, e_fermi, stabilize_exp, remo END IF DO i_mo = 1, nmo - IF (ABS(tau*0.5_dp*(eigenvalues(i_mo)-e_fermi)) < stabilize_exp) THEN - exp_scaling(i_mo) = EXP(-ABS(tau*(eigenvalues(i_mo)-e_fermi))) + IF (ABS(tau*0.5_dp*(eigenvalues(i_mo) - e_fermi)) < stabilize_exp) THEN + exp_scaling(i_mo) = EXP(-ABS(tau*(eigenvalues(i_mo) - e_fermi))) ELSE exp_scaling(i_mo) = 0.0_dp END IF @@ -3645,7 +3645,7 @@ SUBROUTINE kpoint_density_matrices_rpa(kpoint, tau, e_fermi, stabilize_exp, remo CALL cp_fm_column_scale(fwork, occupation) END IF IF (remove_occ) THEN - CALL cp_fm_column_scale(fwork, 2.0_dp/REAL(nspin, KIND=dp)-occupation) + CALL cp_fm_column_scale(fwork, 2.0_dp/REAL(nspin, KIND=dp) - occupation) END IF ! proper spin @@ -3654,8 +3654,8 @@ SUBROUTINE kpoint_density_matrices_rpa(kpoint, tau, e_fermi, stabilize_exp, remo END IF DO i_mo = 1, nmo - IF (ABS(tau*0.5_dp*(eigenvalues(i_mo)-e_fermi)) < stabilize_exp) THEN - exp_scaling(i_mo) = EXP(-ABS(tau*(eigenvalues(i_mo)-e_fermi))) + IF (ABS(tau*0.5_dp*(eigenvalues(i_mo) - e_fermi)) < stabilize_exp) THEN + exp_scaling(i_mo) = EXP(-ABS(tau*(eigenvalues(i_mo) - e_fermi))) ELSE exp_scaling(i_mo) = 0.0_dp END IF @@ -3733,7 +3733,7 @@ SUBROUTINE compute_transl_dm(mat_dm_global, qs_env, ispin, num_integ_points, jqu ! we always use an odd number of image cells ! CAUTION: also at another point, cell_grid_dm is defined, these definitions have to be identical DO i_dim = 1, 3 - cell_grid_dm(i_dim) = (kpoints%nkp_grid(i_dim)/2)*2-1 + cell_grid_dm(i_dim) = (kpoints%nkp_grid(i_dim)/2)*2 - 1 END DO num_cells_dm = cell_grid_dm(1)*cell_grid_dm(2)*cell_grid_dm(3) @@ -3884,7 +3884,7 @@ SUBROUTINE density_matrix_from_kp_to_transl(kpoints, mat_dm_global_work, index_t ycell = index_to_cell(2, icell) zcell = index_to_cell(3, icell) - arg = REAL(xcell, dp)*xkp(1, ik)+REAL(ycell, dp)*xkp(2, ik)+REAL(zcell, dp)*xkp(3, ik) + arg = REAL(xcell, dp)*xkp(1, ik) + REAL(ycell, dp)*xkp(2, ik) + REAL(zcell, dp)*xkp(3, ik) coskl = wkp(ik)*COS(twopi*arg) sinkl = wkp(ik)*SIN(twopi*arg) @@ -3965,7 +3965,7 @@ SUBROUTINE init_cell_index_rpa(cell_grid, cell_to_index, index_to_cell, cell) DO ycell = -itm(2), itm(2) DO zcell = -itm(3), itm(3) - cell_counter = cell_counter+1 + cell_counter = cell_counter + 1 cell_to_index_unsorted(xcell, ycell, zcell) = cell_counter index_to_cell_unsorted(1, cell_counter) = xcell @@ -3974,7 +3974,7 @@ SUBROUTINE init_cell_index_rpa(cell_grid, cell_to_index, index_to_cell, cell) cell_vector(1:3) = MATMUL(hmat, REAL(index_to_cell_unsorted(1:3, cell_counter), dp)) - abs_cell_vectors(cell_counter) = SQRT(cell_vector(1)**2+cell_vector(2)**2+cell_vector(3)**2) + abs_cell_vectors(cell_counter) = SQRT(cell_vector(1)**2 + cell_vector(2)**2 + cell_vector(3)**2) END DO END DO @@ -3982,9 +3982,9 @@ SUBROUTINE init_cell_index_rpa(cell_grid, cell_to_index, index_to_cell, cell) ! first only do all symmetry non-equivalent cells, we need that because chi^T is computed for ! cell indices T from index_to_cell(:,1:num_cells/2+1) - DO i_cell = 1, num_cells/2+1 + DO i_cell = 1, num_cells/2 + 1 - index_min_dist = MINLOC(abs_cell_vectors(1:num_cells/2+1), DIM=1) + index_min_dist = MINLOC(abs_cell_vectors(1:num_cells/2 + 1), DIM=1) xcell = index_to_cell_unsorted(1, index_min_dist) ycell = index_to_cell_unsorted(2, index_min_dist) @@ -4001,7 +4001,7 @@ SUBROUTINE init_cell_index_rpa(cell_grid, cell_to_index, index_to_cell, cell) END DO ! now all the remaining cells - DO i_cell = num_cells/2+2, num_cells + DO i_cell = num_cells/2 + 2, num_cells index_min_dist = MINLOC(abs_cell_vectors(1:num_cells), DIM=1) @@ -4067,9 +4067,9 @@ SUBROUTINE get_diff_index_3c(i_cell_R, i_cell_S, i_cell_R_minus_S, index_to_cell y_cell_S = index_to_cell_dm(2, i_cell_S) z_cell_S = index_to_cell_dm(3, i_cell_S) - x_cell_R_minus_S = x_cell_R-x_cell_S - y_cell_R_minus_S = y_cell_R-y_cell_S - z_cell_R_minus_S = z_cell_R-z_cell_S + x_cell_R_minus_S = x_cell_R - x_cell_S + y_cell_R_minus_S = y_cell_R - y_cell_S + z_cell_R_minus_S = z_cell_R - z_cell_S IF (x_cell_R_minus_S .GE. LBOUND(cell_to_index_3c, 1) .AND. & x_cell_R_minus_S .LE. UBOUND(cell_to_index_3c, 1) .AND. & @@ -4159,9 +4159,9 @@ SUBROUTINE get_diff_diff_index_3c(i_cell_R, i_cell_S, i_cell_T, i_cell_R_minus_S y_cell_T = index_to_cell_dm(2, i_cell_T) z_cell_T = index_to_cell_dm(3, i_cell_T) - x_cell_R_minus_S_minus_T = x_cell_R-x_cell_S-x_cell_T - y_cell_R_minus_S_minus_T = y_cell_R-y_cell_S-y_cell_T - z_cell_R_minus_S_minus_T = z_cell_R-z_cell_S-z_cell_T + x_cell_R_minus_S_minus_T = x_cell_R - x_cell_S - x_cell_T + y_cell_R_minus_S_minus_T = y_cell_R - y_cell_S - y_cell_T + z_cell_R_minus_S_minus_T = z_cell_R - z_cell_S - z_cell_T IF (x_cell_R_minus_S_minus_T .GE. LBOUND(cell_to_index_3c, 1) .AND. & x_cell_R_minus_S_minus_T .LE. UBOUND(cell_to_index_3c, 1) .AND. & diff --git a/src/rpa_kpoints.F b/src/rpa_kpoints.F index 224be08c5a..644b533cea 100644 --- a/src/rpa_kpoints.F +++ b/src/rpa_kpoints.F @@ -405,7 +405,7 @@ SUBROUTINE cholesky_decomp_Q(cfm_mat_Q, para_env_RPA, trace_Qomega, dimen_RI) i_global = row_indices(iiB) IF (j_global == i_global .AND. i_global <= dimen_RI) THEN trace_Qomega(i_global) = REAL(cfm_mat_Q%local_data(iiB, jjB)) - cfm_mat_Q%local_data(iiB, jjB) = cfm_mat_Q%local_data(iiB, jjB)+z_one + cfm_mat_Q%local_data(iiB, jjB) = cfm_mat_Q%local_data(iiB, jjB) + z_one END IF END DO END DO @@ -475,10 +475,10 @@ SUBROUTINE frequency_and_kpoint_integration(Erpa, cfm_mat_Q, para_env_RPA, trace DO iiB = 1, dimen_RI IF (MODULO(iiB, para_env_RPA%num_pe) /= para_env_RPA%mepos) CYCLE ! FComega=FComega+(LOG(Q_log(iiB))-trace_Qomega(iiB))/2.0_dp - FComega = FComega+(Q_log(iiB)-trace_Qomega(iiB))/2.0_dp + FComega = FComega + (Q_log(iiB) - trace_Qomega(iiB))/2.0_dp END DO - Erpa = Erpa+FComega*freq_weight*kp_weight + Erpa = Erpa + FComega*freq_weight*kp_weight DEALLOCATE (Q_log) @@ -628,7 +628,7 @@ SUBROUTINE get_P_cell_T_from_P_gamma(mat_P_omega, qs_env, kpoints, jquad) ! we have at most 3 neigboring cells per dimension and at least one because ! the density response at Gamma is only divided to neighboring IF (periodic(i_dim) == 1) THEN - cell_grid_P(i_dim) = MAX(MIN((kpoints%nkp_grid(i_dim)/2)*2-1, 1), 3) + cell_grid_P(i_dim) = MAX(MIN((kpoints%nkp_grid(i_dim)/2)*2 - 1, 1), 3) ELSE cell_grid_P(i_dim) = 1 END IF @@ -666,11 +666,11 @@ SUBROUTINE get_P_cell_T_from_P_gamma(mat_P_omega, qs_env, kpoints, jquad) DO i_cell = 1, num_cells_P cell_vector(1:3) = MATMUL(hmat, REAL(index_to_cell_P(1:3, i_cell), dp)) - rab_cell_i(1:3) = pbc(particle_set(row)%r(1:3), cell)- & - (pbc(particle_set(col)%r(1:3), cell)+cell_vector(1:3)) - abs_rab_cell(i_cell) = SQRT(rab_cell_i(1)**2+rab_cell_i(2)**2+rab_cell_i(3)**2) + rab_cell_i(1:3) = pbc(particle_set(row)%r(1:3), cell) - & + (pbc(particle_set(col)%r(1:3), cell) + cell_vector(1:3)) + abs_rab_cell(i_cell) = SQRT(rab_cell_i(1)**2 + rab_cell_i(2)**2 + rab_cell_i(3)**2) IF (abs_rab_cell(i_cell)/d_0 < cutoff_exp) THEN - sum_exp = sum_exp+EXP(-abs_rab_cell(i_cell)/d_0) + sum_exp = sum_exp + EXP(-abs_rab_cell(i_cell)/d_0) END IF END DO @@ -787,7 +787,7 @@ SUBROUTINE real_space_to_kpoint_transform_rpa(real_mat_kp, imag_mat_kp, mat_real num_cells = SIZE(index_to_cell, 2) - CPASSERT(SIZE(mat_real_space) >= num_cells/2+1) + CPASSERT(SIZE(mat_real_space) >= num_cells/2 + 1) DO ik = 1, nkp @@ -798,11 +798,11 @@ SUBROUTINE real_space_to_kpoint_transform_rpa(real_mat_kp, imag_mat_kp, mat_real CALL dbcsr_reserve_all_blocks(real_mat_kp(ik)%matrix) CALL dbcsr_reserve_all_blocks(imag_mat_kp(ik)%matrix) - DO i_cell = 1, num_cells/2+1 + DO i_cell = 1, num_cells/2 + 1 cell(:) = index_to_cell(:, i_cell) - arg = REAL(cell(1), dp)*xkp(1, ik)+REAL(cell(2), dp)*xkp(2, ik)+REAL(cell(3), dp)*xkp(3, ik) + arg = REAL(cell(1), dp)*xkp(1, ik) + REAL(cell(2), dp)*xkp(2, ik) + REAL(cell(3), dp)*xkp(3, ik) coskl = COS(twopi*arg) sinkl = SIN(twopi*arg) @@ -862,7 +862,7 @@ SUBROUTINE dbcsr_add_local(mat_a, mat_b, alpha, beta) CPASSERT(found) - block_to_compute(:, :) = alpha*block_to_compute(:, :)+beta*data_block(:, :) + block_to_compute(:, :) = alpha*block_to_compute(:, :) + beta*data_block(:, :) END DO CALL dbcsr_iterator_stop(iter) diff --git a/src/rpa_main.F b/src/rpa_main.F index 29574496e2..34bfe322a4 100644 --- a/src/rpa_main.F +++ b/src/rpa_main.F @@ -275,9 +275,9 @@ SUBROUTINE rpa_ri_compute_en(qs_env, Erpa, mp2_env, BIb_C, BIb_C_gw, BIb_C_bse_i PRESENT(homo_beta) .AND. & PRESENT(Eigenval_beta)) my_open_shell = .TRUE. - virtual = nmo-homo + virtual = nmo - homo IF (my_open_shell) THEN - virtual_beta = nmo-homo_beta + virtual_beta = nmo - homo_beta END IF IF (do_ri_sos_laplace_mp2) THEN @@ -285,12 +285,12 @@ SUBROUTINE rpa_ri_compute_en(qs_env, Erpa, mp2_env, BIb_C, BIb_C_gw, BIb_C_bse_i input_integ_group_size = mp2_env%ri_laplace%integ_group_size ! check the range for the minimax approximation - Emin = 2.0_dp*(Eigenval(homo+1)-Eigenval(homo)) - Emax = 2.0_dp*(MAXVAL(Eigenval)-MINVAL(Eigenval)) + Emin = 2.0_dp*(Eigenval(homo + 1) - Eigenval(homo)) + Emax = 2.0_dp*(MAXVAL(Eigenval) - MINVAL(Eigenval)) IF (my_open_shell) THEN IF (homo_beta > 0) THEN - Emin_beta = 2.0_dp*(Eigenval_beta(homo_beta+1)-Eigenval_beta(homo_beta)) - Emax_beta = 2.0_dp*(MAXVAL(Eigenval_beta)-MINVAL(Eigenval_beta)) + Emin_beta = 2.0_dp*(Eigenval_beta(homo_beta + 1) - Eigenval_beta(homo_beta)) + Emax_beta = 2.0_dp*(MAXVAL(Eigenval_beta) - MINVAL(Eigenval_beta)) Emin = MIN(Emin, Emin_beta) Emax = MAX(Emax, Emax_beta) END IF @@ -300,9 +300,9 @@ SUBROUTINE rpa_ri_compute_en(qs_env, Erpa, mp2_env, BIb_C, BIb_C_gw, BIb_C_bse_i ierr = 0 CALL check_exp_minimax_range(num_integ_points, E_Range, ierr) IF (ierr /= 0) THEN - jjB = num_integ_points-1 + jjB = num_integ_points - 1 DO iiB = 1, jjB - num_integ_points = num_integ_points-1 + num_integ_points = num_integ_points - 1 ierr = 0 CALL check_exp_minimax_range(num_integ_points, E_Range, ierr) IF (ierr == 0) EXIT @@ -342,12 +342,12 @@ SUBROUTINE rpa_ri_compute_en(qs_env, Erpa, mp2_env, BIb_C, BIb_C_gw, BIb_C_bse_i mem_for_QK = REAL(dimen_RI_red, KIND=dp)*dimen_RI_red*8.0_dp/(1024_dp**2) IF (my_open_shell) THEN - mem_for_iaK = mem_for_iaK+REAL(homo_beta, KIND=dp)*virtual_beta*dimen_RI_red*8.0_dp/(1024_dp**2) + mem_for_iaK = mem_for_iaK + REAL(homo_beta, KIND=dp)*virtual_beta*dimen_RI_red*8.0_dp/(1024_dp**2) mem_for_QK = mem_for_QK*2.0_dp END IF CALL m_memory(mem) - mem_real = (mem+1024*1024-1)/(1024*1024) + mem_real = (mem + 1024*1024 - 1)/(1024*1024) ! mp_min .... a hack.. it should be mp_max, but as it turns out, on some processes the previously freed memory (hfx) ! has not been given back to the OS yet. CALL mp_min(mem_real, para_env%group) @@ -357,7 +357,7 @@ SUBROUTINE rpa_ri_compute_en(qs_env, Erpa, mp2_env, BIb_C, BIb_C_gw, BIb_C_bse_i IF (unit_nr > 0) WRITE (unit_nr, '(T3,A,T68,F9.2,A4)') 'RI_INFO| Minimum required memory per MPI process:', & mem_min, ' MiB' - mem_real = allowed_memory-mem_real + mem_real = allowed_memory - mem_real mem_real = MAX(mem_real, mem_min) IF (unit_nr > 0) WRITE (unit_nr, '(T3,A,T68,F9.2,A4)') 'RI_INFO| Available memory per MPI process:', & @@ -365,7 +365,7 @@ SUBROUTINE rpa_ri_compute_en(qs_env, Erpa, mp2_env, BIb_C, BIb_C_gw, BIb_C_bse_i mem_per_group = mem_real*para_env_sub%num_pe - needed_mem = mem_for_iaK*2.0_dp+mem_for_QK*3.0_dp + needed_mem = mem_for_iaK*2.0_dp + mem_for_QK*3.0_dp ! here we try to find the best rpa/laplace group size skip_integ_group_opt = .FALSE. @@ -395,9 +395,9 @@ SUBROUTINE rpa_ri_compute_en(qs_env, Erpa, mp2_env, BIb_C, BIb_C_gw, BIb_C_bse_i min_integ_group_size = MAX(1, ngroup/num_integ_points) - integ_group_size = min_integ_group_size-1 - DO iiB = min_integ_group_size+1, ngroup - integ_group_size = integ_group_size+1 + integ_group_size = min_integ_group_size - 1 + DO iiB = min_integ_group_size + 1, ngroup + integ_group_size = integ_group_size + 1 ! check that the ngroup is a multiple of integ_group_size IF (MOD(ngroup, integ_group_size) /= 0) CYCLE @@ -469,11 +469,11 @@ SUBROUTINE rpa_ri_compute_en(qs_env, Erpa, mp2_env, BIb_C, BIb_C_gw, BIb_C_bse_i CALL timeset(routineN//"_reorder", handle2) ! create the sub_proc_map - ALLOCATE (sub_proc_map(-para_env_sub%num_pe:2*para_env_sub%num_pe-1)) - DO i = 0, para_env_sub%num_pe-1 + ALLOCATE (sub_proc_map(-para_env_sub%num_pe:2*para_env_sub%num_pe - 1)) + DO i = 0, para_env_sub%num_pe - 1 sub_proc_map(i) = i - sub_proc_map(-i-1) = para_env_sub%num_pe-i-1 - sub_proc_map(para_env_sub%num_pe+i) = i + sub_proc_map(-i - 1) = para_env_sub%num_pe - i - 1 + sub_proc_map(para_env_sub%num_pe + i) = i END DO ! not necessary for imaginary time @@ -510,13 +510,13 @@ SUBROUTINE rpa_ri_compute_en(qs_env, Erpa, mp2_env, BIb_C, BIb_C_gw, BIb_C_bse_i CALL timeset(routineN//"_reorder_gw", handle3) CALL calculate_BIb_C_2D(BIb_C_2D_gw, BIb_C_gw, para_env_sub, dimen_nm_gw, & - gw_corr_lev_occ+gw_corr_lev_virt, nmo, gd_B_all, & + gw_corr_lev_occ + gw_corr_lev_virt, nmo, gd_B_all, & sub_proc_map, my_nm_gw_size, my_nm_gw_start, my_nm_gw_end, my_group_L_size) ! The same for open shell IF (my_open_shell) THEN CALL calculate_BIb_C_2D(BIb_C_2D_gw_beta, BIb_C_gw_beta, para_env_sub, dimen_nm_gw, & - gw_corr_lev_occ+gw_corr_lev_virt, nmo, gd_B_all, & + gw_corr_lev_occ + gw_corr_lev_virt, nmo, gd_B_all, & sub_proc_map, my_nm_gw_size, my_nm_gw_start, my_nm_gw_end, my_group_L_size) DEALLOCATE (BIb_C_gw_beta) END IF @@ -796,7 +796,7 @@ SUBROUTINE calculate_BIb_C_2D(BIb_C_2D, BIb_C, para_env_sub, dimen_ia, homo, vir itmp = get_limit(dimen_ia, para_env_sub%num_pe, para_env_sub%mepos) my_ia_start = itmp(1) my_ia_end = itmp(2) - my_ia_size = my_ia_end-my_ia_start+1 + my_ia_size = my_ia_end - my_ia_start + 1 CALL get_group_dist(gd_B_virtual, para_env_sub%mepos, sizes=my_B_size, starts=my_B_virtual_start) @@ -808,16 +808,16 @@ SUBROUTINE calculate_BIb_C_2D(BIb_C_2D, BIb_C, para_env_sub, dimen_ia, homo, vir !$OMP my_group_L_size) DO iiB = 1, homo DO jjB = 1, my_B_size - ia_global = (iiB-1)*virtual+my_B_virtual_start+jjB-1 + ia_global = (iiB - 1)*virtual + my_B_virtual_start + jjB - 1 IF (ia_global >= my_ia_start .AND. ia_global <= my_ia_end) THEN - BIb_C_2D(ia_global-my_ia_start+1, 1:my_group_L_size) = BIb_C(1:my_group_L_size, jjB, iiB) + BIb_C_2D(ia_global - my_ia_start + 1, 1:my_group_L_size) = BIb_C(1:my_group_L_size, jjB, iiB) END IF END DO END DO - DO proc_shift = 1, para_env_sub%num_pe-1 - proc_send = sub_proc_map(para_env_sub%mepos+proc_shift) - proc_receive = sub_proc_map(para_env_sub%mepos-proc_shift) + DO proc_shift = 1, para_env_sub%num_pe - 1 + proc_send = sub_proc_map(para_env_sub%mepos + proc_shift) + proc_receive = sub_proc_map(para_env_sub%mepos - proc_shift) CALL get_group_dist(gd_B_virtual, proc_receive, rec_B_virtual_start, rec_B_virtual_end, rec_B_size) @@ -827,18 +827,18 @@ SUBROUTINE calculate_BIb_C_2D(BIb_C_2D, BIb_C, para_env_sub, dimen_ia, homo, vir ALLOCATE (BIb_C_rec(my_group_L_size, rec_B_size, MIN(homo, occ_chunk))) DO occ_low = 1, homo, occ_chunk - occ_high = MIN(homo, occ_low+occ_chunk-1) + occ_high = MIN(homo, occ_low + occ_chunk - 1) CALL mp_sendrecv(BIb_C(:, :, occ_low:occ_high), proc_send, & - BIb_C_rec(:, :, 1:occ_high-occ_low+1), proc_receive, & + BIb_C_rec(:, :, 1:occ_high - occ_low + 1), proc_receive, & para_env_sub%group) !$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(jjB,ia_global) & !$OMP SHARED(occ_low,occ_high,rec_B_size,virtual,rec_B_virtual_start,my_ia_start,my_ia_end,BIb_C_rec,BIb_C_2D,& !$OMP my_group_L_size) DO iiB = occ_low, occ_high DO jjB = 1, rec_B_size - ia_global = (iiB-1)*virtual+rec_B_virtual_start+jjB-1 + ia_global = (iiB - 1)*virtual + rec_B_virtual_start + jjB - 1 IF (ia_global >= my_ia_start .AND. ia_global <= my_ia_end) THEN - BIb_C_2D(ia_global-my_ia_start+1, 1:my_group_L_size) = BIb_C_rec(1:my_group_L_size, jjB, iiB-occ_low+1) + BIb_C_2D(ia_global - my_ia_start + 1, 1:my_group_L_size) = BIb_C_rec(1:my_group_L_size, jjB, iiB - occ_low + 1) END IF END DO END DO @@ -979,9 +979,9 @@ SUBROUTINE create_integ_mat(BIb_C_2D, para_env, para_env_sub, color_sub, ngroup, row_col_proc_ratio = dimen_ia_for_block_size/dimen_RI row_col_proc_ratio = MAX(1, row_col_proc_ratio) - iproc_row = MIN(MAX(INT(SQRT(REAL(para_env_RPA%num_pe*row_col_proc_ratio, KIND=dp))), 1), para_env_RPA%num_pe)+1 + iproc_row = MIN(MAX(INT(SQRT(REAL(para_env_RPA%num_pe*row_col_proc_ratio, KIND=dp))), 1), para_env_RPA%num_pe) + 1 DO iproc = 1, para_env_RPA%num_pe - iproc_row = iproc_row-1 + iproc_row = iproc_row - 1 IF (MOD(para_env_RPA%num_pe, iproc_row) == 0) EXIT END DO @@ -1034,12 +1034,12 @@ SUBROUTINE create_integ_mat(BIb_C_2D, para_env, para_env_sub, color_sub, ngroup, IF (.NOT. my_do_im_time) THEN ! create the RPA proc_map - ALLOCATE (RPA_proc_map(-para_env_RPA%num_pe:2*para_env_RPA%num_pe-1)) + ALLOCATE (RPA_proc_map(-para_env_RPA%num_pe:2*para_env_RPA%num_pe - 1)) RPA_proc_map = 0 - DO i = 0, para_env_RPA%num_pe-1 + DO i = 0, para_env_RPA%num_pe - 1 RPA_proc_map(i) = i - RPA_proc_map(-i-1) = para_env_RPA%num_pe-i-1 - RPA_proc_map(para_env_RPA%num_pe+i) = i + RPA_proc_map(-i - 1) = para_env_RPA%num_pe - i - 1 + RPA_proc_map(para_env_RPA%num_pe + i) = i END DO CALL create_group_dist(gd_ia, my_ia_start, my_ia_end, my_ia_size, para_env_RPA) @@ -1049,7 +1049,7 @@ SUBROUTINE create_integ_mat(BIb_C_2D, para_env, para_env_sub, color_sub, ngroup, ! create the info array mepos_in_RPA_group = MOD(color_sub, integ_group_size) - ALLOCATE (group_grid_2_mepos(0:para_env_sub%num_pe-1, 0:integ_group_size-1)) + ALLOCATE (group_grid_2_mepos(0:para_env_sub%num_pe - 1, 0:integ_group_size - 1)) group_grid_2_mepos = 0 group_grid_2_mepos(para_env_sub%mepos, mepos_in_RPA_group) = para_env_RPA%mepos CALL mp_sum(group_grid_2_mepos, para_env_RPA%group) @@ -1207,7 +1207,7 @@ SUBROUTINE create_occ_virt_mo_coeffs(fm_mo_coeff_occ, fm_mo_coeff_virt, mo_coeff ! set all virtual MO coeffs to zero DO irow_global = 1, nmo - DO icol_global = homo+1, nmo + DO icol_global = homo + 1, nmo CALL cp_fm_set_element(fm_mo_coeff_occ, irow_global, icol_global, 0.0_dp) END DO END DO @@ -1525,7 +1525,7 @@ SUBROUTINE rpa_num_int(qs_env, Erpa, mp2_env, para_env, para_env_RPA, para_env_s PRESENT(fm_mat_Q_gemm_beta) .AND. & PRESENT(fm_mat_Q_beta)) my_open_shell = .TRUE. - nmo = homo+virtual + nmo = homo + virtual do_gw_im_time = my_do_gw .AND. do_im_time do_ri_Sigma_x = mp2_env%ri_g0w0%do_ri_Sigma_x @@ -1607,7 +1607,7 @@ SUBROUTINE rpa_num_int(qs_env, Erpa, mp2_env, para_env, para_env_RPA, para_env_s CALL dbcsr_get_info(matrix_s(1)%matrix, & row_blk_size=prim_blk_sizes) - gw_corr_lev_tot = gw_corr_lev_occ+gw_corr_lev_virt + gw_corr_lev_tot = gw_corr_lev_occ + gw_corr_lev_virt IF (.NOT. do_kpoints_cubic_RPA) THEN IF (my_open_shell) THEN @@ -1783,9 +1783,9 @@ SUBROUTINE rpa_num_int(qs_env, Erpa, mp2_env, para_env, para_env_RPA, para_env_s IF (do_im_time) THEN IF (.NOT. do_kpoints_cubic_RPA) THEN - e_fermi = (Eigenval(homo)+Eigenval(homo+1))*0.5_dp + e_fermi = (Eigenval(homo) + Eigenval(homo + 1))*0.5_dp IF (my_open_shell) THEN - e_fermi_beta = (Eigenval_beta(homo_beta)+Eigenval_beta(homo_beta+1))*0.5_dp + e_fermi_beta = (Eigenval_beta(homo_beta) + Eigenval_beta(homo_beta + 1))*0.5_dp END IF END IF @@ -1976,7 +1976,7 @@ SUBROUTINE rpa_num_int(qs_env, Erpa, mp2_env, para_env, para_env_RPA, para_env_s local_size_source_axk, mp2_env, mat_munu, unit_nr, e_axk_corr) ! Evaluate the final AXK energy correction - e_axk = e_axk+e_axk_corr*wj(jquad) + e_axk = e_axk + e_axk_corr*wj(jquad) ENDIF ! do_ri_axk IF (do_ri_sos_laplace_mp2) THEN @@ -2122,7 +2122,7 @@ SUBROUTINE rpa_num_int(qs_env, Erpa, mp2_env, para_env, para_env_RPA, para_env_s END IF ! if HOMO-LUMO gap differs by less than mp2_env%ri_g0w0%eps_ev_sc_iter, exit ev sc GW loop - IF (ABS(Eigenval(homo)-Eigenval_last(homo)-Eigenval(homo+1)+Eigenval_last(homo+1)) & + IF (ABS(Eigenval(homo) - Eigenval_last(homo) - Eigenval(homo + 1) + Eigenval_last(homo + 1)) & < mp2_env%ri_g0w0%eps_ev_sc_iter) THEN EXIT END IF diff --git a/src/rpa_rse.F b/src/rpa_rse.F index 99a1f78221..820a61b989 100644 --- a/src/rpa_rse.F +++ b/src/rpa_rse.F @@ -278,8 +278,8 @@ SUBROUTINE rse_energy(qs_env, mp2_env, para_env, dft_control, & DO iiB = 1, nrow_local i_global = row_indices(iiB) IF ((i_global .LE. homo) .AND. (j_global .GT. homo)) THEN - rse_corr = rse_corr+fm_X_mo%local_data(iib, jjb)**2.0_dp/ & - (eigenval(i_global)-eigenval(j_global)-diag_diff(i_global)+diag_diff(j_global)) + rse_corr = rse_corr + fm_X_mo%local_data(iib, jjb)**2.0_dp/ & + (eigenval(i_global) - eigenval(j_global) - diag_diff(i_global) + diag_diff(j_global)) ENDIF END DO END DO @@ -320,14 +320,14 @@ SUBROUTINE rse_energy(qs_env, mp2_env, para_env, dft_control, & DO iiB = 1, nrow_local i_global = row_indices(iiB) IF ((i_global .LE. homo_beta) .AND. (j_global .GT. homo_beta)) THEN - rse_corr_beta = rse_corr_beta+fm_X_mo_beta%local_data(iib, jjb)**2.0_dp/ & - (eigenval_beta(i_global)-eigenval_beta(j_global)-diag_diff(i_global)+diag_diff(j_global)) + rse_corr_beta = rse_corr_beta + fm_X_mo_beta%local_data(iib, jjb)**2.0_dp/ & + (eigenval_beta(i_global) - eigenval_beta(j_global) - diag_diff(i_global) + diag_diff(j_global)) ENDIF END DO END DO !$OMP END PARALLEL DO CALL mp_sum(rse_corr_beta, para_env%group) - rse_corr = 0.5_dp*(rse_corr+rse_corr_beta) + rse_corr = 0.5_dp*(rse_corr + rse_corr_beta) ENDIF mp2_env%ri_rpa%rse_corr_diag = rse_corr @@ -642,7 +642,7 @@ SUBROUTINE non_diag_rse(fm_F_mo, eigenval, dimen, homo, para_env, & i_global = row_indices(iiB) IF (i_global .EQ. j_global) THEN fm_F_mo%local_data(iib, jjb) = & - fm_F_mo%local_data(iib, jjb)+eigenval(i_global) + fm_F_mo%local_data(iib, jjb) + eigenval(i_global) ENDIF END DO END DO @@ -663,7 +663,7 @@ SUBROUTINE non_diag_rse(fm_F_mo, eigenval, dimen, homo, para_env, & DO iiB = 1, nrow_local i_global = row_indices(iiB) IF (i_global .EQ. j_global) fm_F_mo_beta%local_data(iib, jjb) = & - fm_F_mo_beta%local_data(iib, jjb)+eigenval_beta(i_global) + fm_F_mo_beta%local_data(iib, jjb) + eigenval_beta(i_global) END DO END DO !$OMP END PARALLEL DO @@ -684,7 +684,7 @@ SUBROUTINE non_diag_rse(fm_F_mo, eigenval, dimen, homo, para_env, & s_firstrow=1, s_firstcol=1, & t_firstrow=1, t_firstcol=1) - virtual = dimen-homo + virtual = dimen - homo NULLIFY (fm_F_vv, fm_U, fm_struct_tmp) CALL cp_fm_struct_create(fm_struct_tmp, para_env=para_env, context=blacs_env, & nrow_global=virtual, ncol_global=virtual) @@ -696,7 +696,7 @@ SUBROUTINE non_diag_rse(fm_F_mo, eigenval, dimen, homo, para_env, & CALL cp_fm_to_fm_submat(msource=fm_F_mo, mtarget=fm_F_vv, & nrow=virtual, ncol=virtual, & - s_firstrow=homo+1, s_firstcol=homo+1, & + s_firstrow=homo + 1, s_firstcol=homo + 1, & t_firstrow=1, t_firstcol=1) ! Diagonalize occupied-occupied and virtual-virtual matrices @@ -712,7 +712,7 @@ SUBROUTINE non_diag_rse(fm_F_mo, eigenval, dimen, homo, para_env, & ALLOCATE (eig_semi_can(dimen)) eig_semi_can = 0.0_dp eig_semi_can(1:homo) = eig_o(:) - eig_semi_can(homo+1:dimen) = eig_v(:) + eig_semi_can(homo + 1:dimen) = eig_v(:) ! Create occupied-virtual block NULLIFY (fm_F_ov, fm_tmp, fm_struct_tmp) @@ -726,7 +726,7 @@ SUBROUTINE non_diag_rse(fm_F_mo, eigenval, dimen, homo, para_env, & CALL cp_fm_to_fm_submat(msource=fm_F_mo, mtarget=fm_F_ov, & nrow=homo, ncol=virtual, & - s_firstrow=1, s_firstcol=homo+1, & + s_firstrow=1, s_firstcol=homo + 1, & t_firstrow=1, t_firstcol=1) CALL cp_fm_get_info(matrix=fm_F_ov, & @@ -758,8 +758,8 @@ SUBROUTINE non_diag_rse(fm_F_mo, eigenval, dimen, homo, para_env, & j_global = col_indices(jjB) DO iiB = 1, nrow_local i_global = row_indices(iiB) - rse_corr = rse_corr+fm_F_ov%local_data(iib, jjb)**2.0_dp/ & - (eig_semi_can(i_global)-eig_semi_can(j_global+homo)) + rse_corr = rse_corr + fm_F_ov%local_data(iib, jjb)**2.0_dp/ & + (eig_semi_can(i_global) - eig_semi_can(j_global + homo)) END DO END DO !$OMP END PARALLEL DO @@ -793,7 +793,7 @@ SUBROUTINE non_diag_rse(fm_F_mo, eigenval, dimen, homo, para_env, & nrow=homo_beta, ncol=homo_beta, & s_firstrow=1, s_firstcol=1, & t_firstrow=1, t_firstcol=1) - virtual_beta = dimen-homo_beta + virtual_beta = dimen - homo_beta NULLIFY (fm_F_vv, fm_U, fm_struct_tmp) CALL cp_fm_struct_create(fm_struct_tmp, para_env=para_env, context=blacs_env, & nrow_global=virtual_beta, ncol_global=virtual_beta) @@ -805,7 +805,7 @@ SUBROUTINE non_diag_rse(fm_F_mo, eigenval, dimen, homo, para_env, & CALL cp_fm_to_fm_submat(msource=fm_F_mo_beta, mtarget=fm_F_vv, & nrow=virtual_beta, ncol=virtual_beta, & - s_firstrow=homo_beta+1, s_firstcol=homo_beta+1, & + s_firstrow=homo_beta + 1, s_firstcol=homo_beta + 1, & t_firstrow=1, t_firstcol=1) ! Diagonalize occupied-occupied and virtual-virtual matrices @@ -820,7 +820,7 @@ SUBROUTINE non_diag_rse(fm_F_mo, eigenval, dimen, homo, para_env, & ALLOCATE (eig_semi_can(dimen)) eig_semi_can = 0.0_dp eig_semi_can(1:homo_beta) = eig_o(:) - eig_semi_can(homo_beta+1:dimen) = eig_v(:) + eig_semi_can(homo_beta + 1:dimen) = eig_v(:) ! Create occupied-virtual block NULLIFY (fm_F_ov, fm_tmp, fm_struct_tmp) @@ -834,7 +834,7 @@ SUBROUTINE non_diag_rse(fm_F_mo, eigenval, dimen, homo, para_env, & CALL cp_fm_to_fm_submat(msource=fm_F_mo_beta, mtarget=fm_F_ov, & nrow=homo_beta, ncol=virtual_beta, & - s_firstrow=1, s_firstcol=homo_beta+1, & + s_firstrow=1, s_firstcol=homo_beta + 1, & t_firstrow=1, t_firstcol=1) CALL cp_gemm(transa='N', transb='N', m=homo_beta, n=virtual_beta, k=homo_beta, alpha=1.0_dp, & @@ -857,8 +857,8 @@ SUBROUTINE non_diag_rse(fm_F_mo, eigenval, dimen, homo, para_env, & j_global = col_indices(jjB) DO iiB = 1, nrow_local i_global = row_indices(iiB) - rse_corr_beta = rse_corr_beta+fm_F_ov%local_data(iib, jjb)**2.0_dp/ & - (eig_semi_can(i_global)-eig_semi_can(j_global+homo_beta)) + rse_corr_beta = rse_corr_beta + fm_F_ov%local_data(iib, jjb)**2.0_dp/ & + (eig_semi_can(i_global) - eig_semi_can(j_global + homo_beta)) END DO END DO !$OMP END PARALLEL DO @@ -876,7 +876,7 @@ SUBROUTINE non_diag_rse(fm_F_mo, eigenval, dimen, homo, para_env, & CALL cp_fm_release(fm_O) CALL cp_fm_release(fm_tmp) - rse_corr = 0.5_dp*(rse_corr+rse_corr_beta) + rse_corr = 0.5_dp*(rse_corr + rse_corr_beta) ENDIF diff --git a/src/rpa_util.F b/src/rpa_util.F index 8d47e5f836..f99b82688b 100644 --- a/src/rpa_util.F +++ b/src/rpa_util.F @@ -308,7 +308,7 @@ SUBROUTINE alloc_im_time(qs_env, mp2_env, para_env, para_env_sub, dimen_RI, dime ! we always use an odd number of image cells ! CAUTION: also at another point, cell_grid_dm is defined, these definitions have to be identical DO i_dim = 1, 3 - cell_grid_dm(i_dim) = (kpoints%nkp_grid(i_dim)/2)*2-1 + cell_grid_dm(i_dim) = (kpoints%nkp_grid(i_dim)/2)*2 - 1 END DO num_cells_dm = cell_grid_dm(1)*cell_grid_dm(2)*cell_grid_dm(3) ALLOCATE (index_to_cell_3c(3, SIZE(kpoints%index_to_cell, 2))) @@ -376,9 +376,9 @@ SUBROUTINE alloc_im_time(qs_env, mp2_env, para_env, para_env_sub, dimen_RI, dime END IF IF (do_kpoints_cubic_RPA) THEN - size_P = MAX(num_cells_dm/2+1, nkp) + size_P = MAX(num_cells_dm/2 + 1, nkp) ELSE IF (do_kpoints_from_Gamma) THEN - size_P = MAX(3**(periodic(1)+periodic(2)+periodic(3)), nkp) + size_P = MAX(3**(periodic(1) + periodic(2) + periodic(3)), nkp) ELSE size_P = 1 END IF @@ -400,46 +400,46 @@ SUBROUTINE alloc_im_time(qs_env, mp2_env, para_env, para_env_sub, dimen_RI, dime CALL dbcsr_copy(mat_P_global_copy%matrix, mat_P_global%matrix) n_group_row = mp2_env%ri_rpa_im_time_util(1)%n_group_row - ALLOCATE (sizes_array_prim_row(0:n_group_row-1, cut_memory)) + ALLOCATE (sizes_array_prim_row(0:n_group_row - 1, cut_memory)) DO i_mem = 1, cut_memory sizes_array_prim_row(:, i_mem) = mp2_env%ri_rpa_im_time_util(i_mem)%sizes_array_prim_row(:) END DO - ALLOCATE (starts_array_prim_row(0:n_group_row-1, cut_memory)) + ALLOCATE (starts_array_prim_row(0:n_group_row - 1, cut_memory)) DO i_mem = 1, cut_memory starts_array_prim_row(:, i_mem) = mp2_env%ri_rpa_im_time_util(i_mem)%starts_array_prim_row(:) END DO - ALLOCATE (ends_array_prim_row(0:n_group_row-1, cut_memory)) + ALLOCATE (ends_array_prim_row(0:n_group_row - 1, cut_memory)) DO i_mem = 1, cut_memory ends_array_prim_row(:, i_mem) = mp2_env%ri_rpa_im_time_util(i_mem)%ends_array_prim_row(:) END DO - ALLOCATE (starts_array_prim_fullrow(0:n_group_row-1, cut_memory)) + ALLOCATE (starts_array_prim_fullrow(0:n_group_row - 1, cut_memory)) DO i_mem = 1, cut_memory starts_array_prim_fullrow(:, i_mem) = mp2_env%ri_rpa_im_time_util(i_mem)%starts_array_prim_fullrow(:) END DO - ALLOCATE (ends_array_prim_fullrow(0:n_group_row-1, cut_memory)) + ALLOCATE (ends_array_prim_fullrow(0:n_group_row - 1, cut_memory)) DO i_mem = 1, cut_memory ends_array_prim_fullrow(:, i_mem) = mp2_env%ri_rpa_im_time_util(i_mem)%ends_array_prim_fullrow(:) END DO n_group_col = mp2_env%ri_rpa_im_time_util(1)%n_group_col - ALLOCATE (sizes_array_prim_col(0:n_group_col-1, cut_memory)) + ALLOCATE (sizes_array_prim_col(0:n_group_col - 1, cut_memory)) DO j_mem = 1, cut_memory sizes_array_prim_col(:, j_mem) = mp2_env%ri_rpa_im_time_util(j_mem)%sizes_array_prim_col(:) END DO - ALLOCATE (starts_array_prim_col(0:n_group_col-1, cut_memory)) + ALLOCATE (starts_array_prim_col(0:n_group_col - 1, cut_memory)) DO j_mem = 1, cut_memory starts_array_prim_col(:, j_mem) = mp2_env%ri_rpa_im_time_util(j_mem)%starts_array_prim_col(:) END DO - ALLOCATE (ends_array_prim_col(0:n_group_col-1, cut_memory)) + ALLOCATE (ends_array_prim_col(0:n_group_col - 1, cut_memory)) DO j_mem = 1, cut_memory ends_array_prim_col(:, j_mem) = mp2_env%ri_rpa_im_time_util(j_mem)%ends_array_prim_col(:) END DO - ALLOCATE (starts_array_prim_fullcol(0:n_group_col-1, cut_memory)) + ALLOCATE (starts_array_prim_fullcol(0:n_group_col - 1, cut_memory)) DO j_mem = 1, cut_memory starts_array_prim_fullcol(:, j_mem) = mp2_env%ri_rpa_im_time_util(j_mem)%starts_array_prim_fullcol(:) END DO - ALLOCATE (ends_array_prim_fullcol(0:n_group_col-1, cut_memory)) + ALLOCATE (ends_array_prim_fullcol(0:n_group_col - 1, cut_memory)) DO j_mem = 1, cut_memory ends_array_prim_fullcol(:, j_mem) = mp2_env%ri_rpa_im_time_util(j_mem)%ends_array_prim_fullcol(:) END DO @@ -458,8 +458,8 @@ SUBROUTINE alloc_im_time(qs_env, mp2_env, para_env, para_env_sub, dimen_RI, dime n_local_col = sizes_array_prim_col(color_sub_col, j_mem) col_start_local = starts_array_prim_col(color_sub_col, j_mem) - ALLOCATE (offset_combi_block(i_mem, j_mem)%array(row_start_local:row_start_local+n_local_row-1, & - col_start_local:col_start_local+n_local_col-1)) + ALLOCATE (offset_combi_block(i_mem, j_mem)%array(row_start_local:row_start_local + n_local_row - 1, & + col_start_local:col_start_local + n_local_col - 1)) offset_combi_block(i_mem, j_mem)%array(:, :) = & mp2_env%ri_rpa_im_time_2d_util(i_mem, j_mem)%offset_combi_block(:, :) @@ -504,7 +504,7 @@ SUBROUTINE alloc_im_time(qs_env, mp2_env, para_env, para_env_sub, dimen_RI, dime DO LLL = 1, dimen_RI DO row = 1, nblkrows_total - IF (row_blk_offset(row) <= LLL .AND. LLL < row_blk_offset(row)+row_blk_size(row)) THEN + IF (row_blk_offset(row) <= LLL .AND. LLL < row_blk_offset(row) + row_blk_size(row)) THEN row_from_LLL(LLL) = row END IF END DO @@ -539,7 +539,7 @@ SUBROUTINE alloc_im_time(qs_env, mp2_env, para_env, para_env_sub, dimen_RI, dime multiply_needed_virt = .TRUE. ENDIF - ALLOCATE (has_mat_P_blocks(num_cells_dm/2+1, cut_memory, cut_memory, num_3c_repl, num_3c_repl)) + ALLOCATE (has_mat_P_blocks(num_cells_dm/2 + 1, cut_memory, cut_memory, num_3c_repl, num_3c_repl)) has_mat_P_blocks = .TRUE. IF (do_kpoints_cubic_RPA .OR. do_kpoints_from_Gamma) THEN @@ -890,8 +890,8 @@ SUBROUTINE calculate_equal_blk_size(blk_size_new, dimen_RI_red, nblk) col_per_blk = dimen_RI_red/nblk ! Determine a new distribution for the columns (corresponding to the number of columns) - IF (remainder > 0) blk_size_new(1:remainder) = col_per_blk+1 - blk_size_new(remainder+1:nblk) = col_per_blk + IF (remainder > 0) blk_size_new(1:remainder) = col_per_blk + 1 + blk_size_new(remainder + 1:nblk) = col_per_blk END SUBROUTINE calculate_equal_blk_size @@ -1129,12 +1129,12 @@ SUBROUTINE calc_fm_mat_S_rpa(fm_mat_S, first_cycle, count_ev_sc_GW, virtual, Eig DO iiB = 1, nrow_local i_global = row_indices(iiB) - iocc = MAX(1, i_global-1)/virtual+1 - avirt = i_global-(iocc-1)*virtual - eigen_diff = Eigenval_last(avirt+homo)-Eigenval_last(iocc) + iocc = MAX(1, i_global - 1)/virtual + 1 + avirt = i_global - (iocc - 1)*virtual + eigen_diff = Eigenval_last(avirt + homo) - Eigenval_last(iocc) fm_mat_S%local_data(iiB, jjB) = fm_mat_S%local_data(iiB, jjB)/ & - SQRT(eigen_diff/(eigen_diff**2+omega_old**2)) + SQRT(eigen_diff/(eigen_diff**2 + omega_old**2)) END DO END DO @@ -1152,12 +1152,12 @@ SUBROUTINE calc_fm_mat_S_rpa(fm_mat_S, first_cycle, count_ev_sc_GW, virtual, Eig DO iiB = 1, nrow_local i_global = row_indices(iiB) - iocc = MAX(1, i_global-1)/virtual+1 - avirt = i_global-(iocc-1)*virtual - eigen_diff = Eigenval(avirt+homo)-Eigenval(iocc) + iocc = MAX(1, i_global - 1)/virtual + 1 + avirt = i_global - (iocc - 1)*virtual + eigen_diff = Eigenval(avirt + homo) - Eigenval(iocc) fm_mat_S%local_data(iiB, jjB) = fm_mat_S%local_data(iiB, jjB)* & - SQRT(eigen_diff/(eigen_diff**2+omega**2)) + SQRT(eigen_diff/(eigen_diff**2 + omega**2)) END DO END DO @@ -1172,12 +1172,12 @@ SUBROUTINE calc_fm_mat_S_rpa(fm_mat_S, first_cycle, count_ev_sc_GW, virtual, Eig DO iiB = 1, nrow_local i_global = row_indices(iiB) - iocc = MAX(1, i_global-1)/virtual+1 - avirt = i_global-(iocc-1)*virtual - eigen_diff = Eigenval(avirt+homo)-Eigenval(iocc) + iocc = MAX(1, i_global - 1)/virtual + 1 + avirt = i_global - (iocc - 1)*virtual + eigen_diff = Eigenval(avirt + homo) - Eigenval(iocc) fm_mat_S%local_data(iiB, jjB) = fm_mat_S%local_data(iiB, jjB)* & - SQRT((eigen_diff**2+omega_old**2)/(eigen_diff**2+omega**2)) + SQRT((eigen_diff**2 + omega_old**2)/(eigen_diff**2 + omega**2)) END DO END DO @@ -1250,9 +1250,9 @@ SUBROUTINE contract_S_to_Q(mm_style, dimen_RI, dimen_ia, alpha, fm_mat_S, fm_mat CPABORT("") END SELECT t_end = m_walltime() - actual_flop_rate = 2.0_dp*REAL(dimen_ia, KIND=dp)*dimen_RI*REAL(dimen_RI, KIND=dp)/(MAX(0.01_dp, t_end-t_start)) - IF (para_env_RPA%mepos == 0) my_flop_rate = my_flop_rate+actual_flop_rate - my_num_dgemm_call = my_num_dgemm_call+1 + actual_flop_rate = 2.0_dp*REAL(dimen_ia, KIND=dp)*dimen_RI*REAL(dimen_RI, KIND=dp)/(MAX(0.01_dp, t_end - t_start)) + IF (para_env_RPA%mepos == 0) my_flop_rate = my_flop_rate + actual_flop_rate + my_num_dgemm_call = my_num_dgemm_call + 1 ! copy/redistribute fm_mat_Q_gemm to fm_mat_Q CALL cp_fm_set_all(matrix=fm_mat_Q, alpha=0.0_dp) @@ -1302,7 +1302,7 @@ SUBROUTINE RPA_postprocessing_start(dimen_RI, trace_Qomega, fm_mat_Q, para_env_R i_global = row_indices(iiB) IF (j_global == i_global .AND. i_global <= dimen_RI) THEN trace_Qomega(i_global) = fm_mat_Q%local_data(iiB, jjB) - fm_mat_Q%local_data(iiB, jjB) = fm_mat_Q%local_data(iiB, jjB)+1.0_dp + fm_mat_Q%local_data(iiB, jjB) = fm_mat_Q%local_data(iiB, jjB) + 1.0_dp END IF END DO END DO @@ -1369,9 +1369,9 @@ SUBROUTINE RPA_postprocessing_nokp(dimen_RI, trace_Qomega, fm_mat_Q, para_env_RP FComega = 0.0_dp DO iiB = 1, dimen_RI IF (MODULO(iiB, para_env_RPA%num_pe) /= para_env_RPA%mepos) CYCLE - FComega = FComega+(Q_log(iiB)-trace_Qomega(iiB))/2.0_dp + FComega = FComega + (Q_log(iiB) - trace_Qomega(iiB))/2.0_dp END DO - Erpa = Erpa+FComega*wjquad + Erpa = Erpa + FComega*wjquad DEALLOCATE (Q_log) @@ -1410,7 +1410,7 @@ SUBROUTINE get_non_zero_blocks_3c(mat_3c_overl_int, para_env_sub, cut_RI, non_ze CALL dbcsr_get_info(mat_3c_overl_int(1, 1, 1)%matrix, nblkrows_total=nblkrows_total) - ALLOCATE (non_zero_blocks_3c_tmp(1:cut_RI, 1:nblkrows_total, 0:(para_env_sub%num_pe-1))) + ALLOCATE (non_zero_blocks_3c_tmp(1:cut_RI, 1:nblkrows_total, 0:(para_env_sub%num_pe - 1))) non_zero_blocks_3c_tmp = 0 DO i_cut_RI = 1, cut_RI @@ -1439,12 +1439,12 @@ SUBROUTINE get_non_zero_blocks_3c(mat_3c_overl_int, para_env_sub, cut_RI, non_ze maxlength = 0 - DO imepos = 0, para_env_sub%num_pe-1 + DO imepos = 0, para_env_sub%num_pe - 1 DO i_cut_RI = 1, cut_RI maxlength_tmp = 0 DO iblk = 1, nblkrows_total IF (non_zero_blocks_3c_tmp(i_cut_RI, iblk, imepos) .NE. 0) THEN - maxlength_tmp = maxlength_tmp+1 + maxlength_tmp = maxlength_tmp + 1 END IF END DO IF (maxlength_tmp > maxlength) THEN @@ -1454,15 +1454,15 @@ SUBROUTINE get_non_zero_blocks_3c(mat_3c_overl_int, para_env_sub, cut_RI, non_ze END DO ! save memory with smaller non_zero_blocks_3c - ALLOCATE (non_zero_blocks_3c(1:cut_RI, 1:maxlength, 0:(para_env_sub%num_pe-1))) + ALLOCATE (non_zero_blocks_3c(1:cut_RI, 1:maxlength, 0:(para_env_sub%num_pe - 1))) non_zero_blocks_3c = 0 - DO imepos = 0, para_env_sub%num_pe-1 + DO imepos = 0, para_env_sub%num_pe - 1 DO i_cut_RI = 1, cut_RI block_counter = 0 DO iblk = 1, nblkrows_total IF (non_zero_blocks_3c_tmp(i_cut_RI, iblk, imepos) .NE. 0) THEN - block_counter = block_counter+1 + block_counter = block_counter + 1 non_zero_blocks_3c(i_cut_RI, block_counter, imepos) = iblk END IF END DO @@ -1519,7 +1519,7 @@ SUBROUTINE get_non_zero_blocks_3c_cut_col(mat_3c_overl_int_cut_col, para_env_sub END DO END DO - ALLOCATE (non_zero_blocks_3c_tmp(1:cut_RI, 1:nblkrows_total_max, 0:(para_env_sub%num_pe-1))) + ALLOCATE (non_zero_blocks_3c_tmp(1:cut_RI, 1:nblkrows_total_max, 0:(para_env_sub%num_pe - 1))) non_zero_blocks_3c_tmp = 0 maxlength = 0 @@ -1553,12 +1553,12 @@ SUBROUTINE get_non_zero_blocks_3c_cut_col(mat_3c_overl_int_cut_col, para_env_sub maxlength_tmp = 0 - DO imepos = 0, para_env_sub%num_pe-1 + DO imepos = 0, para_env_sub%num_pe - 1 DO i_cut_RI = 1, cut_RI maxlength_tmp = 0 DO iblk = 1, nblkrows_total IF (non_zero_blocks_3c_tmp(i_cut_RI, iblk, imepos) .NE. 0) THEN - maxlength_tmp = maxlength_tmp+1 + maxlength_tmp = maxlength_tmp + 1 END IF END DO IF (maxlength_tmp > maxlength) THEN @@ -1573,7 +1573,7 @@ SUBROUTINE get_non_zero_blocks_3c_cut_col(mat_3c_overl_int_cut_col, para_env_sub ! end determine maxlength ! save memory with a smaller non_zero_blocks_3c_cut - ALLOCATE (non_zero_blocks_3c_cut(1:cut_RI, 1:maxlength, 0:(para_env_sub%num_pe-1), 1:cut_memory)) + ALLOCATE (non_zero_blocks_3c_cut(1:cut_RI, 1:maxlength, 0:(para_env_sub%num_pe - 1), 1:cut_memory)) non_zero_blocks_3c_cut = 0 ! now, fill non_zero_blocks_3c_cut @@ -1602,12 +1602,12 @@ SUBROUTINE get_non_zero_blocks_3c_cut_col(mat_3c_overl_int_cut_col, para_env_sub CALL mp_sum(non_zero_blocks_3c_tmp, para_env_sub%group) - DO imepos = 0, para_env_sub%num_pe-1 + DO imepos = 0, para_env_sub%num_pe - 1 DO i_cut_RI = 1, cut_RI block_counter = 0 DO iblk = 1, nblkrows_total IF (non_zero_blocks_3c_tmp(i_cut_RI, iblk, imepos) .NE. 0) THEN - block_counter = block_counter+1 + block_counter = block_counter + 1 non_zero_blocks_3c_cut(i_cut_RI, block_counter, imepos, i_mem) = iblk END IF END DO @@ -1682,7 +1682,7 @@ SUBROUTINE check_sparsity_arrays_for_kp(needed_cutRI_mem_R1vec_R2vec_for_kp, & END IF - occ_local_sum_j_cell = occ_local_sum_j_cell+occ_local + occ_local_sum_j_cell = occ_local_sum_j_cell + occ_local END DO ! j_cell @@ -1753,7 +1753,7 @@ SUBROUTINE get_sub_para_kp(fm_struct_sub_kp, para_env, nkp, dimen_RI, & ikp_local = 0 first_ikp_local = 1 DO ikp = 1, nkp - IF (nkp > para_env%num_pe .OR. do_kpoints_cubic_RPA .OR. ikp == color_sub_kp+1) THEN + IF (nkp > para_env%num_pe .OR. do_kpoints_cubic_RPA .OR. ikp == color_sub_kp + 1) THEN ikp_local(ikp) = ikp first_ikp_local = ikp END IF diff --git a/src/rt_propagation_forces.F b/src/rt_propagation_forces.F index cf9bda4b6a..1197b6a609 100644 --- a/src/rt_propagation_forces.F +++ b/src/rt_propagation_forces.F @@ -127,7 +127,7 @@ SUBROUTINE calc_c_mat_force_fm(qs_env) CALL get_atomic_kind_set(atomic_kind_set=atomic_kind_set, atom_of_kind=atom_of_kind, kind_of=kind_of) DO ispin = 1, SIZE(SinvH) - re = 2*ispin-1 + re = 2*ispin - 1 im = 2*ispin alpha = mos(ispin)%mo_set%maxocc @@ -243,7 +243,7 @@ SUBROUTINE calc_c_mat_force_ls(qs_env) CALL get_rtp(rtp=rtp, rho_new=rho_new, S_minus_half=S_minus_half) DO ispin = 1, SIZE(SinvH) - re = 2*ispin-1 + re = 2*ispin - 1 im = 2*ispin CALL dbcsr_multiply("N", "N", one, SinvH(ispin)%matrix, rho_new(re)%matrix, zero, tmp, & filter_eps=rtp%filter_eps) @@ -308,7 +308,7 @@ SUBROUTINE compute_forces(force, tmp, S_der, rho_im, C_mat, kind_of, atom_of_kin kind_atom = atom_of_kind(col_atom) !The block_values are in a vector format, ! so the dot_product is the sum over all elements of the hamand product, that I need - force(ikind)%ehrenfest(i, kind_atom) = force(ikind)%ehrenfest(i, kind_atom)+ & + force(ikind)%ehrenfest(i, kind_atom) = force(ikind)%ehrenfest(i, kind_atom) + & 2.0_dp*DOT_PRODUCT(block_values, block_values2) ENDIF END DO @@ -325,7 +325,7 @@ SUBROUTINE compute_forces(force, tmp, S_der, rho_im, C_mat, kind_of, atom_of_kin kind_atom = atom_of_kind(col_atom) !The block_values are in a vector format, so the dot_product is ! the sum over all elements of the hamand product, that I need - force(ikind)%ehrenfest(i, kind_atom) = force(ikind)%ehrenfest(i, kind_atom)+ & + force(ikind)%ehrenfest(i, kind_atom) = force(ikind)%ehrenfest(i, kind_atom) + & 2.0_dp*DOT_PRODUCT(block_values, block_values2) ENDIF END DO @@ -416,7 +416,7 @@ SUBROUTINE rt_admm_forces_none(qs_env, admm_env, KS_aux_re, KS_aux_im, matrix_s_ "W MATRIX AUX Q") DO ispin = 1, SIZE(KS_aux_re) - re = 2*ispin-1; im = 2*ispin + re = 2*ispin - 1; im = 2*ispin naux = admm_env%nao_aux_fit; nmo = admm_env%nmo(ispin); nao = admm_env%nao_orb ALLOCATE (tmp_aux_aux(2), tmp_aux_nao(2), tmp_aux_mo(2), tmp_aux_mo1(2)) diff --git a/src/rt_propagation_types.F b/src/rt_propagation_types.F index 1dc1438adc..fd5fef6de9 100644 --- a/src/rt_propagation_types.F +++ b/src/rt_propagation_types.F @@ -200,23 +200,23 @@ SUBROUTINE rt_prop_create(rtp, mos, mpools, dft_control, template, linear_scalin END IF DO i = 1, nspin DO j = 1, 2 - NULLIFY (rtp%mos%old(2*(i-1)+j)%matrix) - NULLIFY (rtp%mos%new(2*(i-1)+j)%matrix) - NULLIFY (rtp%mos%next(2*(i-1)+j)%matrix) - CALL cp_fm_create(rtp%mos%old(2*(i-1)+j)%matrix, & + NULLIFY (rtp%mos%old(2*(i - 1) + j)%matrix) + NULLIFY (rtp%mos%new(2*(i - 1) + j)%matrix) + NULLIFY (rtp%mos%next(2*(i - 1) + j)%matrix) + CALL cp_fm_create(rtp%mos%old(2*(i - 1) + j)%matrix, & matrix_struct=mos(i)%mo_set%mo_coeff%matrix_struct, & - name="mos_old"//TRIM(ADJUSTL(cp_to_string(2*(i-1)+j)))) - CALL cp_fm_create(rtp%mos%new(2*(i-1)+j)%matrix, & + name="mos_old"//TRIM(ADJUSTL(cp_to_string(2*(i - 1) + j)))) + CALL cp_fm_create(rtp%mos%new(2*(i - 1) + j)%matrix, & matrix_struct=mos(i)%mo_set%mo_coeff%matrix_struct, & - name="mos_new"//TRIM(ADJUSTL(cp_to_string(2*(i-1)+j)))) - CALL cp_fm_create(rtp%mos%next(2*(i-1)+j)%matrix, & + name="mos_new"//TRIM(ADJUSTL(cp_to_string(2*(i - 1) + j)))) + CALL cp_fm_create(rtp%mos%next(2*(i - 1) + j)%matrix, & matrix_struct=mos(i)%mo_set%mo_coeff%matrix_struct, & - name="mos_next"//TRIM(ADJUSTL(cp_to_string(2*(i-1)+j)))) + name="mos_next"//TRIM(ADJUSTL(cp_to_string(2*(i - 1) + j)))) IF (dft_control%do_admm) THEN - NULLIFY (rtp%mos%admm(2*(i-1)+j)%matrix) - CALL cp_fm_create(rtp%mos%admm(2*(i-1)+j)%matrix, & + NULLIFY (rtp%mos%admm(2*(i - 1) + j)%matrix) + CALL cp_fm_create(rtp%mos%admm(2*(i - 1) + j)%matrix, & matrix_struct=mos_aux(i)%mo_set%mo_coeff%matrix_struct, & - name="mos_admm"//TRIM(ADJUSTL(cp_to_string(2*(i-1)+j)))) + name="mos_admm"//TRIM(ADJUSTL(cp_to_string(2*(i - 1) + j)))) END IF END DO END DO diff --git a/src/rtp_admm_methods.F b/src/rtp_admm_methods.F index 5fdea8f3c9..8d6bff9bed 100644 --- a/src/rtp_admm_methods.F +++ b/src/rtp_admm_methods.F @@ -340,13 +340,13 @@ SUBROUTINE rtp_fit_mo_coeffs_none(qs_env, admm_env, para_env, matrix_s_aux_fit, occupation_numbers=occ_num_aux) CALL cp_gemm('N', 'N', nao_aux_fit, nmo, nao_orb, & - 1.0_dp, admm_env%A, mos_new(2*ispin-1)%matrix, 0.0_dp, & - rtp_coeff_aux_fit(2*ispin-1)%matrix) + 1.0_dp, admm_env%A, mos_new(2*ispin - 1)%matrix, 0.0_dp, & + rtp_coeff_aux_fit(2*ispin - 1)%matrix) CALL cp_gemm('N', 'N', nao_aux_fit, nmo, nao_orb, & 1.0_dp, admm_env%A, mos_new(2*ispin)%matrix, 0.0_dp, & rtp_coeff_aux_fit(2*ispin)%matrix) - CALL cp_fm_to_fm(rtp_coeff_aux_fit(2*ispin-1)%matrix, mo_coeff_aux_fit) + CALL cp_fm_to_fm(rtp_coeff_aux_fit(2*ispin - 1)%matrix, mo_coeff_aux_fit) END DO CALL timestop(handle) @@ -376,8 +376,8 @@ SUBROUTINE calculate_rtp_admm_density(density_matrix_aux, density_matrix_aux_im, CALL timeset(routineN, handle) - re = 2*ispin-1; im = 2*ispin - alpha = 3*one-REAL(SIZE(rtp_coeff_aux_fit)/2, dp) + re = 2*ispin - 1; im = 2*ispin + alpha = 3*one - REAL(SIZE(rtp_coeff_aux_fit)/2, dp) CALL dbcsr_set(density_matrix_aux, zero) CALL cp_fm_get_info(rtp_coeff_aux_fit(re)%matrix, ncol_global=ncol) CALL cp_dbcsr_plus_fm_fm_t(sparse_matrix=density_matrix_aux, & @@ -480,7 +480,7 @@ SUBROUTINE rt_merge_ks_matrix_none(ispin, admm_env, & CALL timeset(routineN, handle) - counter = counter+1 + counter = counter + 1 nao_aux_fit = admm_env%nao_aux_fit nao_orb = admm_env%nao_orb nmo = admm_env%nmo(ispin) diff --git a/src/s_square_methods.F b/src/s_square_methods.F index 4a86e83e33..d964cd748f 100644 --- a/src/s_square_methods.F +++ b/src/s_square_methods.F @@ -87,7 +87,7 @@ SUBROUTINE compute_s_square(mos, matrix_s, s_square, s_square_ideal, & NULLIFY (fm_struct_tmp, matrix_sc_a, matrix_sc_b, matrix_overlap, para_env, context, local_data) - SELECT CASE (SIZE (mos)) + SELECT CASE (SIZE(mos)) CASE (1) s_square = 0.0_dp s_square_ideal = 0.0_dp @@ -100,7 +100,7 @@ SUBROUTINE compute_s_square(mos, matrix_s, s_square, s_square_ideal, & IF (.NOT. uniform_occupation) CPWARN("Found non-uniform occupation") CALL cp_fm_get_info(c_alpha, ncol_global=na) CALL cp_fm_get_info(c_beta, ncol_global=nb) - s_square_ideal = REAL((nalpha-nbeta)*(nalpha-nbeta+2), KIND=dp)/4.0_dp + s_square_ideal = REAL((nalpha - nbeta)*(nalpha - nbeta + 2), KIND=dp)/4.0_dp ! create overlap matrix CALL cp_fm_get_info(c_alpha, para_env=para_env, context=context) CALL cp_fm_struct_create(fm_struct_tmp, para_env=para_env, context=context, & @@ -120,11 +120,11 @@ SUBROUTINE compute_s_square(mos, matrix_s, s_square, s_square_ideal, & tmp = 0.0_dp DO j = 1, ncol_local DO i = 1, nrow_local - tmp = tmp+local_data(i, j)**2 + tmp = tmp + local_data(i, j)**2 ENDDO ENDDO CALL mp_sum(tmp, para_env%group) - s_square = s_square_ideal+nb-tmp + s_square = s_square_ideal + nb - tmp IF (PRESENT(mo_derivs)) THEN ! this gets really wrong for fractional occupations CPASSERT(SIZE(mo_derivs, 1) == 2) @@ -188,7 +188,7 @@ SUBROUTINE s2_restraint(mos, matrix_s, mo_derivs, energy, & CALL compute_s_square(mos, matrix_s, s_square, s_square_ideal, & mo_derivs, s2_restraint_control%strength) ENDIF - energy = s2_restraint_control%strength*(s_square-s2_restraint_control%target) + energy = s2_restraint_control%strength*(s_square - s2_restraint_control%target) s2_restraint_control%s2_order_p = s_square CASE (do_s2_restraint) ! not yet implemented CPABORT("") diff --git a/src/sap_kind_types.F b/src/sap_kind_types.F index 8a600fb0f2..e30f944f9e 100644 --- a/src/sap_kind_types.F +++ b/src/sap_kind_types.F @@ -151,7 +151,7 @@ SUBROUTINE alist_pre_align_blk(blk_in, ldin, blk_out, ldout, ilist, in, jlist, j INTEGER :: i, i0, i1, i2, i3, inn, inn1, j, j0 inn = MOD(in, 4) - inn1 = inn+1 + inn1 = inn + 1 DO j = 1, jn j0 = jlist(j) DO i = 1, inn @@ -160,13 +160,13 @@ SUBROUTINE alist_pre_align_blk(blk_in, ldin, blk_out, ldout, ilist, in, jlist, j ENDDO DO i = inn1, in, 4 i0 = ilist(i) - i1 = ilist(i+1) - i2 = ilist(i+2) - i3 = ilist(i+3) + i1 = ilist(i + 1) + i2 = ilist(i + 2) + i3 = ilist(i + 3) blk_out(i, j) = blk_in(i0, j0) - blk_out(i+1, j) = blk_in(i1, j0) - blk_out(i+2, j) = blk_in(i2, j0) - blk_out(i+3, j) = blk_in(i3, j0) + blk_out(i + 1, j) = blk_in(i1, j0) + blk_out(i + 2, j) = blk_in(i2, j0) + blk_out(i + 3, j) = blk_in(i3, j0) ENDDO ENDDO END SUBROUTINE alist_pre_align_blk @@ -192,22 +192,22 @@ SUBROUTINE alist_post_align_blk(blk_in, ldin, blk_out, ldout, ilist, in, jlist, INTEGER :: i, i0, i1, i2, i3, inn, inn1, j, j0 inn = MOD(in, 4) - inn1 = inn+1 + inn1 = inn + 1 DO j = 1, jn j0 = jlist(j) DO i = 1, inn i0 = ilist(i) - blk_out(i0, j0) = blk_out(i0, j0)+blk_in(i, j) + blk_out(i0, j0) = blk_out(i0, j0) + blk_in(i, j) ENDDO DO i = inn1, in, 4 i0 = ilist(i) - i1 = ilist(i+1) - i2 = ilist(i+2) - i3 = ilist(i+3) - blk_out(i0, j0) = blk_out(i0, j0)+blk_in(i, j) - blk_out(i1, j0) = blk_out(i1, j0)+blk_in(i+1, j) - blk_out(i2, j0) = blk_out(i2, j0)+blk_in(i+2, j) - blk_out(i3, j0) = blk_out(i3, j0)+blk_in(i+3, j) + i1 = ilist(i + 1) + i2 = ilist(i + 2) + i3 = ilist(i + 3) + blk_out(i0, j0) = blk_out(i0, j0) + blk_in(i, j) + blk_out(i1, j0) = blk_out(i1, j0) + blk_in(i + 1, j) + blk_out(i2, j0) = blk_out(i2, j0) + blk_in(i + 2, j) + blk_out(i3, j0) = blk_out(i3, j0) + blk_in(i + 3, j) ENDDO ENDDO END SUBROUTINE alist_post_align_blk diff --git a/src/scf_control_types.F b/src/scf_control_types.F index ab382ff0aa..99ce373cfb 100644 --- a/src/scf_control_types.F +++ b/src/scf_control_types.F @@ -261,7 +261,7 @@ SUBROUTINE scf_c_create(scf_control) NULLIFY (scf_control%smear) - last_scf_c_id_nr = last_scf_c_id_nr+1 + last_scf_c_id_nr = last_scf_c_id_nr + 1 CALL timestop(handle) @@ -283,7 +283,7 @@ SUBROUTINE scf_c_retain(scf_control) CPASSERT(ASSOCIATED(scf_control)) CPASSERT(scf_control%ref_count > 0) - scf_control%ref_count = scf_control%ref_count+1 + scf_control%ref_count = scf_control%ref_count + 1 END SUBROUTINE scf_c_retain @@ -304,7 +304,7 @@ SUBROUTINE scf_c_release(scf_control) IF (ASSOCIATED(scf_control)) THEN CPASSERT(scf_control%ref_count > 0) - scf_control%ref_count = scf_control%ref_count-1 + scf_control%ref_count = scf_control%ref_count - 1 IF (scf_control%ref_count < 1) THEN IF (ASSOCIATED(scf_control%smear%list)) THEN DEALLOCATE (scf_control%smear%list) diff --git a/src/se_core_core.F b/src/se_core_core.F index fb67b78669..bf2abed5de 100644 --- a/src/se_core_core.F +++ b/src/se_core_core.F @@ -178,7 +178,7 @@ SUBROUTINE se_core_core_interaction(qs_env, para_env, calculate_forces) IF (.NOT. se_defined(jkind)) CYCLE se_kind_a => se_kind_param(ikind)%se_param se_kind_b => se_kind_param(jkind)%se_param - iab = ikind+nkind*(jkind-1) + iab = ikind + nkind*(jkind - 1) dr1 = DOT_PRODUCT(rij, rij) enucij = 0._dp IF (dr1 > rij_threshold) THEN @@ -189,14 +189,14 @@ SUBROUTINE se_core_core_interaction(qs_env, para_env, calculate_forces) ! Core-Core energy term CALL corecore(se_kind_a, se_kind_b, rij, enuc=enuc, itype=itype, anag=anag, & se_int_control=se_int_control, se_taper=se_taper) - enucij = enucij+enuc + enucij = enucij + enuc ! Residual integral (1/R^3) correction IF (se_int_control%do_ewald_r3) THEN r2inv = 1.0_dp/dr1 rinv = SQRT(r2inv) r3inv = rinv**3 ! Core-Core term - enucij = enucij+se_kind_a%expns3_int(jkind)%expns3%core_core*r3inv + enucij = enucij + se_kind_a%expns3_int(jkind)%expns3%core_core*r3inv END IF ! Core-Core Derivatives @@ -211,21 +211,21 @@ SUBROUTINE se_core_core_interaction(qs_env, para_env, calculate_forces) IF (se_int_control%do_ewald_r3) THEN dr3inv = -3.0_dp*rij*r3inv*r2inv ! Derivatives of core-core terms - force_ab = force_ab+se_kind_a%expns3_int(jkind)%expns3%core_core*dr3inv + force_ab = force_ab + se_kind_a%expns3_int(jkind)%expns3%core_core*dr3inv END IF IF (use_virial) THEN CALL virial_pair_force(virial%pv_virial, -1.0_dp, force_ab, rij) END IF ! Sum up force components - force(ikind)%all_potential(1, atom_a) = force(ikind)%all_potential(1, atom_a)-force_ab(1) - force(jkind)%all_potential(1, atom_b) = force(jkind)%all_potential(1, atom_b)+force_ab(1) + force(ikind)%all_potential(1, atom_a) = force(ikind)%all_potential(1, atom_a) - force_ab(1) + force(jkind)%all_potential(1, atom_b) = force(jkind)%all_potential(1, atom_b) + force_ab(1) - force(ikind)%all_potential(2, atom_a) = force(ikind)%all_potential(2, atom_a)-force_ab(2) - force(jkind)%all_potential(2, atom_b) = force(jkind)%all_potential(2, atom_b)+force_ab(2) + force(ikind)%all_potential(2, atom_a) = force(ikind)%all_potential(2, atom_a) - force_ab(2) + force(jkind)%all_potential(2, atom_b) = force(jkind)%all_potential(2, atom_b) + force_ab(2) - force(ikind)%all_potential(3, atom_a) = force(ikind)%all_potential(3, atom_a)-force_ab(3) - force(jkind)%all_potential(3, atom_b) = force(jkind)%all_potential(3, atom_b)+force_ab(3) + force(ikind)%all_potential(3, atom_a) = force(ikind)%all_potential(3, atom_a) - force_ab(3) + force(jkind)%all_potential(3, atom_b) = force(jkind)%all_potential(3, atom_b) + force_ab(3) END IF CASE DEFAULT CPABORT("") @@ -235,14 +235,14 @@ SUBROUTINE se_core_core_interaction(qs_env, para_env, calculate_forces) ! Core-Core energy term (self term in periodic systems) CALL corecore(se_kind_a, se_kind_b, rij, enuc=enuc, itype=itype, anag=anag, & se_int_control=se_int_control, se_taper=se_taper) - enucij = enucij+0.5_dp*enuc + enucij = enucij + 0.5_dp*enuc END IF END IF IF (atener) THEN - atprop%atecc(iatom) = atprop%atecc(iatom)+0.5_dp*enucij - atprop%atecc(jatom) = atprop%atecc(jatom)+0.5_dp*enucij + atprop%atecc(iatom) = atprop%atecc(iatom) + 0.5_dp*enucij + atprop%atecc(jatom) = atprop%atecc(jatom) + 0.5_dp*enucij END IF - enuclear = enuclear+enucij + enuclear = enuclear + enucij END DO CALL neighbor_list_iterator_release(nl_iterator) diff --git a/src/se_core_matrix.F b/src/se_core_matrix.F index 053fe305a6..f1b4147509 100644 --- a/src/se_core_matrix.F +++ b/src/se_core_matrix.F @@ -208,7 +208,7 @@ SUBROUTINE build_se_core_matrix(qs_env, para_env, calculate_forces) CALL get_se_param(se_kind_a, defined=defined, natorb=natorb_a, & beta=beta_a, uss=uss, upp=upp, udd=udd, uff=uff, eisol=eisol, eheat=eheat, & nr=nr_a, sto_exponents=sto_exponents_a) - econst = econst-(eisol-eheat)*REAL(natom, dp) + econst = econst - (eisol - eheat)*REAL(natom, dp) se_defined(ikind) = (defined .AND. natorb_a >= 1) hmt(1, ikind) = beta_a(0) hmt(2:4, ikind) = beta_a(1) @@ -264,7 +264,7 @@ SUBROUTINE build_se_core_matrix(qs_env, para_env, calculate_forces) CASE (do_method_am1, do_method_rm1, do_method_mndo, do_method_pdg, & do_method_pm3, do_method_pm6, do_method_pm6fm, do_method_mndod, do_method_pnnl) DO i = 1, SIZE(h_blocka, 1) - h_blocka(i, i) = h_blocka(i, i)+ua(i) + h_blocka(i, i) = h_blocka(i, i) + ua(i) END DO END SELECT @@ -307,13 +307,13 @@ SUBROUTINE build_se_core_matrix(qs_env, para_env, calculate_forces) IF (irow == iatom) THEN DO i = 1, SIZE(h_block, 1) DO j = 1, SIZE(h_block, 2) - h_block(i, j) = h_block(i, j)+kh*(ha(i)+hb(j))*s_block(i, j) + h_block(i, j) = h_block(i, j) + kh*(ha(i) + hb(j))*s_block(i, j) END DO END DO ELSE DO i = 1, SIZE(h_block, 1) DO j = 1, SIZE(h_block, 2) - h_block(i, j) = h_block(i, j)+kh*(ha(j)+hb(i))*s_block(i, j) + h_block(i, j) = h_block(i, j) + kh*(ha(j) + hb(i))*s_block(i, j) END DO END DO END IF @@ -343,19 +343,19 @@ SUBROUTINE build_se_core_matrix(qs_env, para_env, calculate_forces) ! enddo ! enddo - CALL dbcsr_get_block_p(matrix_s(icor+1)%matrix, irow, icol, dsmat, found) + CALL dbcsr_get_block_p(matrix_s(icor + 1)%matrix, irow, icol, dsmat, found) CPASSERT(ASSOCIATED(dsmat)) dsmat = 2._dp*kh*dsmat*pabmat IF (irow == iatom) THEN DO i = 1, SIZE(h_block, 1) DO j = 1, SIZE(h_block, 2) - force_ab(icor) = force_ab(icor)+(ha(i)+hb(j))*dsmat(i, j) + force_ab(icor) = force_ab(icor) + (ha(i) + hb(j))*dsmat(i, j) END DO END DO ELSE DO i = 1, SIZE(h_block, 1) DO j = 1, SIZE(h_block, 2) - force_ab(icor) = force_ab(icor)+(ha(j)+hb(i))*dsmat(i, j) + force_ab(icor) = force_ab(icor) + (ha(j) + hb(i))*dsmat(i, j) END DO END DO END IF @@ -367,9 +367,9 @@ SUBROUTINE build_se_core_matrix(qs_env, para_env, calculate_forces) IF (calculate_forces .AND. (iatom /= jatom .OR. dr > rij_threshold)) THEN IF (irow == iatom) force_ab = -force_ab force(ikind)%all_potential(:, atom_a) = & - force(ikind)%all_potential(:, atom_a)-force_ab(:) + force(ikind)%all_potential(:, atom_a) - force_ab(:) force(jkind)%all_potential(:, atom_b) = & - force(jkind)%all_potential(:, atom_b)+force_ab(:) + force(jkind)%all_potential(:, atom_b) + force_ab(:) IF (use_virial) THEN CALL virial_pair_force(virial%pv_virial, -1.0_dp, force_ab, rij) END IF @@ -680,7 +680,7 @@ SUBROUTINE makeS(R, nra, nrb, ZSA, ZSB, ZPA, ZPB, S) ct = -v(3)/rr IF (ABS(ct) < 1.0_dp) THEN - st = SQRT(1.0_dp-ct**2) + st = SQRT(1.0_dp - ct**2) cp = -v(1)/(rr*st) sp = -v(2)/(rr*st) Arot(1, 1) = ct*cp @@ -706,81 +706,81 @@ SUBROUTINE makeS(R, nra, nrb, ZSA, ZSB, ZPA, ZPB, S) za = ZSA zb = ZSB - fac2 = SQRT(za**(2*nra+1)*zb**(2*nrb+1)) - xx = 0.5_dp*rr*(za+zb) - yy = 0.5_dp*rr*(za-zb) + fac2 = SQRT(za**(2*nra + 1)*zb**(2*nrb + 1)) + xx = 0.5_dp*rr*(za + zb) + yy = 0.5_dp*rr*(za - zb) J = 0.0_dp DO k = 1, nc1(nra, nrb) - J = J+REAL(c1(nra, nrb, k), dp)*AA(ma1(nra, nrb, k), xx)*BB(mb1(nra, nrb, k), yy) + J = J + REAL(c1(nra, nrb, k), dp)*AA(ma1(nra, nrb, k), xx)*BB(mb1(nra, nrb, k), yy) ENDDO - J = J*rr**(nra+nrb+1) - J = J/2.0_dp**(nra+nrb+2) + J = J*rr**(nra + nrb + 1) + J = J/2.0_dp**(nra + nrb + 2) - S(1, 1) = S(1, 1)+fac1*fac2*J + S(1, 1) = S(1, 1) + fac1*fac2*J za = ZPA zb = ZSB - fac2 = SQRT(za**(2*nra+1)*zb**(2*nrb+1)) - xx = 0.5_dp*rr*(za+zb) - yy = 0.5_dp*rr*(za-zb) + fac2 = SQRT(za**(2*nra + 1)*zb**(2*nrb + 1)) + xx = 0.5_dp*rr*(za + zb) + yy = 0.5_dp*rr*(za - zb) Jc = 0.0_dp DO k = 1, nc2(nra, nrb) - Jc = Jc+REAL(c2(nra, nrb, k), dp)*AA(ma2(nra, nrb, k), xx)*BB(mb2(nra, nrb, k), yy) + Jc = Jc + REAL(c2(nra, nrb, k), dp)*AA(ma2(nra, nrb, k), xx)*BB(mb2(nra, nrb, k), yy) ENDDO - Jc = Jc*rr**(nra+nrb+1) - Jc = Jc/2.0_dp**(nra+nrb+2) + Jc = Jc*rr**(nra + nrb + 1) + Jc = Jc/2.0_dp**(nra + nrb + 2) DO k1 = 1, 3 - S(k1+1, 1) = S(k1+1, 1) & - & +SQRT(3.0_dp)*Arot(k1, 3)*fac1*fac2*Jc + S(k1 + 1, 1) = S(k1 + 1, 1) & + & + SQRT(3.0_dp)*Arot(k1, 3)*fac1*fac2*Jc ENDDO za = ZSA zb = ZPB - fac2 = SQRT(za**(2*nra+1)*zb**(2*nrb+1)) - xx = 0.5_dp*rr*(za+zb) - yy = 0.5_dp*rr*(za-zb) + fac2 = SQRT(za**(2*nra + 1)*zb**(2*nrb + 1)) + xx = 0.5_dp*rr*(za + zb) + yy = 0.5_dp*rr*(za - zb) Jc = 0.0_dp DO k = 1, nc3(nra, nrb) - Jc = Jc+REAL(c3(nra, nrb, k), dp)*AA(ma3(nra, nrb, k), xx)*BB(mb3(nra, nrb, k), yy) + Jc = Jc + REAL(c3(nra, nrb, k), dp)*AA(ma3(nra, nrb, k), xx)*BB(mb3(nra, nrb, k), yy) ENDDO - Jc = Jc*rr**(nra+nrb+1) - Jc = Jc/2.0_dp**(nra+nrb+2) + Jc = Jc*rr**(nra + nrb + 1) + Jc = Jc/2.0_dp**(nra + nrb + 2) DO k1 = 1, 3 - S(1, k1+1) = S(1, k1+1) & - & -SQRT(3.0_dp)*Arot(k1, 3)*fac1*fac2*Jc + S(1, k1 + 1) = S(1, k1 + 1) & + & - SQRT(3.0_dp)*Arot(k1, 3)*fac1*fac2*Jc ENDDO za = ZPA zb = ZPB - fac2 = SQRT(za**(2*nra+1)*zb**(2*nrb+1)) - xx = 0.5_dp*rr*(za+zb) - yy = 0.5_dp*rr*(za-zb) + fac2 = SQRT(za**(2*nra + 1)*zb**(2*nrb + 1)) + xx = 0.5_dp*rr*(za + zb) + yy = 0.5_dp*rr*(za - zb) Jss = 0.0_dp DO k = 1, nc4(nra, nrb) - Jss = Jss+REAL(c4(nra, nrb, k), dp)*AA(ma4(nra, nrb, k), xx)*BB(mb4(nra, nrb, k), yy) + Jss = Jss + REAL(c4(nra, nrb, k), dp)*AA(ma4(nra, nrb, k), xx)*BB(mb4(nra, nrb, k), yy) ENDDO - Jss = Jss*rr**(nra+nrb+1) - Jss = Jss/2.0_dp**(nra+nrb+2) + Jss = Jss*rr**(nra + nrb + 1) + Jss = Jss/2.0_dp**(nra + nrb + 2) Jcc = 0.0_dp DO k = 1, nc5(nra, nrb) - Jcc = Jcc+REAL(c5(nra, nrb, k), dp)*AA(ma5(nra, nrb, k), xx)*BB(mb5(nra, nrb, k), yy) + Jcc = Jcc + REAL(c5(nra, nrb, k), dp)*AA(ma5(nra, nrb, k), xx)*BB(mb5(nra, nrb, k), yy) ENDDO - Jcc = Jcc*rr**(nra+nrb+1) - Jcc = Jcc/2.0_dp**(nra+nrb+2) + Jcc = Jcc*rr**(nra + nrb + 1) + Jcc = Jcc/2.0_dp**(nra + nrb + 2) DO k1 = 1, 3 DO k2 = 1, 3 - S(k1+1, k2+1) = S(k1+1, k2+1) & - & +1.5_dp*Arot(k1, 1)*Arot(k2, 1)*fac1*fac2*Jss & - & +1.5_dp*Arot(k1, 2)*Arot(k2, 2)*fac1*fac2*Jss & - & -3.0_dp*Arot(k1, 3)*Arot(k2, 3)*fac1*fac2*Jcc + S(k1 + 1, k2 + 1) = S(k1 + 1, k2 + 1) & + & + 1.5_dp*Arot(k1, 1)*Arot(k2, 1)*fac1*fac2*Jss & + & + 1.5_dp*Arot(k1, 2)*Arot(k2, 2)*fac1*fac2*Jss & + & - 3.0_dp*Arot(k1, 3)*Arot(k2, 3)*fac1*fac2*Jcc ENDDO ENDDO @@ -1060,7 +1060,7 @@ SUBROUTINE makedS(R, nra, nrb, ZSA, ZSB, ZPA, ZPB, dS) IF (ABS(ct) >= 1.0_dp) THEN dct(:) = v(:)*v(3)/rr**3 - dct(3) = dct(3)-1.0_dp/rr + dct(3) = dct(3) - 1.0_dp/rr Arot(1, 1) = ct Arot(1, 2) = 0.0_dp @@ -1084,20 +1084,20 @@ SUBROUTINE makedS(R, nra, nrb, ZSA, ZSB, ZPA, ZPB, dS) ELSE - xx = SQRT(v(1)**2+v(2)**2) + xx = SQRT(v(1)**2 + v(2)**2) st = xx/rr cp = -v(1)/xx sp = -v(2)/xx dct(:) = v(:)*v(3)/rr**3 - dct(3) = dct(3)-1.0_dp/rr + dct(3) = dct(3) - 1.0_dp/rr dst(:) = -ct*dct(:)/st dcp(:) = v(:)*v(1)/(rr**3*st) - dcp(:) = dcp(:)+v(1)*dst(:)/(rr*st**2) - dcp(1) = dcp(1)-1.0_dp/(rr*st) + dcp(:) = dcp(:) + v(1)*dst(:)/(rr*st**2) + dcp(1) = dcp(1) - 1.0_dp/(rr*st) dsp(:) = v(:)*v(2)/(rr**3*st) - dsp(:) = dsp(:)+v(2)*dst(:)/(rr*st**2) - dsp(2) = dsp(2)-1.0_dp/(rr*st) + dsp(:) = dsp(:) + v(2)*dst(:)/(rr*st**2) + dsp(2) = dsp(2) - 1.0_dp/(rr*st) Arot(1, 1) = ct*cp Arot(1, 2) = -sp @@ -1109,12 +1109,12 @@ SUBROUTINE makedS(R, nra, nrb, ZSA, ZSB, ZPA, ZPB, dS) Arot(3, 2) = 0.0_dp Arot(3, 3) = ct - dArot(1, 1, :) = dct(:)*cp+ct*dcp(:) + dArot(1, 1, :) = dct(:)*cp + ct*dcp(:) dArot(1, 2, :) = -dsp(:) - dArot(1, 3, :) = dst(:)*cp+st*dcp(:) - dArot(2, 1, :) = dct(:)*sp+ct*dsp(:) + dArot(1, 3, :) = dst(:)*cp + st*dcp(:) + dArot(2, 1, :) = dct(:)*sp + ct*dsp(:) dArot(2, 2, :) = dcp(:) - dArot(2, 3, :) = dst(:)*sp+st*dsp(:) + dArot(2, 3, :) = dst(:)*sp + st*dsp(:) dArot(3, 1, :) = -dst(:) dArot(3, 2, :) = 0.0_dp dArot(3, 3, :) = dct(:) @@ -1123,132 +1123,132 @@ SUBROUTINE makedS(R, nra, nrb, ZSA, ZSB, ZPA, ZPB, dS) za = ZSA zb = ZSB - fac2 = SQRT(za**(2*nra+1)*zb**(2*nrb+1)) - xx = 0.5_dp*rr*(za+zb) - yy = 0.5_dp*rr*(za-zb) - dxx = 0.5_dp*(za+zb) - dyy = 0.5_dp*(za-zb) + fac2 = SQRT(za**(2*nra + 1)*zb**(2*nrb + 1)) + xx = 0.5_dp*rr*(za + zb) + yy = 0.5_dp*rr*(za - zb) + dxx = 0.5_dp*(za + zb) + dyy = 0.5_dp*(za - zb) w = 0.0_dp w1 = 0.0_dp w2 = 0.0_dp - f = rr**(nra+nrb+1)/2.0_dp**(nra+nrb+2) + f = rr**(nra + nrb + 1)/2.0_dp**(nra + nrb + 2) DO k = 1, nc1(nra, nrb) - w = w+REAL(c1(nra, nrb, k), dp)*AA(ma1(nra, nrb, k), xx)*BB(mb1(nra, nrb, k), yy) - w1 = w1+REAL(c1(nra, nrb, k), dp)*AA(ma1(nra, nrb, k)+1, xx)*BB(mb1(nra, nrb, k), yy) - w2 = w2+REAL(c1(nra, nrb, k), dp)*AA(ma1(nra, nrb, k), xx)*BB(mb1(nra, nrb, k)+1, yy) + w = w + REAL(c1(nra, nrb, k), dp)*AA(ma1(nra, nrb, k), xx)*BB(mb1(nra, nrb, k), yy) + w1 = w1 + REAL(c1(nra, nrb, k), dp)*AA(ma1(nra, nrb, k) + 1, xx)*BB(mb1(nra, nrb, k), yy) + w2 = w2 + REAL(c1(nra, nrb, k), dp)*AA(ma1(nra, nrb, k), xx)*BB(mb1(nra, nrb, k) + 1, yy) ENDDO J = f*w - dJ = f*REAL(nra+nrb+1, dp)*w/rr - dJ = dJ-dxx*f*w1 - dJ = dJ-dyy*f*w2 + dJ = f*REAL(nra + nrb + 1, dp)*w/rr + dJ = dJ - dxx*f*w1 + dJ = dJ - dyy*f*w2 - dS(1, 1, :) = dS(1, 1, :)+fac1*fac2*dJ*v(:)/rr + dS(1, 1, :) = dS(1, 1, :) + fac1*fac2*dJ*v(:)/rr za = ZPA zb = ZSB - fac2 = SQRT(za**(2*nra+1)*zb**(2*nrb+1)) - xx = 0.5_dp*rr*(za+zb) - yy = 0.5_dp*rr*(za-zb) - dxx = 0.5_dp*(za+zb) - dyy = 0.5_dp*(za-zb) + fac2 = SQRT(za**(2*nra + 1)*zb**(2*nrb + 1)) + xx = 0.5_dp*rr*(za + zb) + yy = 0.5_dp*rr*(za - zb) + dxx = 0.5_dp*(za + zb) + dyy = 0.5_dp*(za - zb) w = 0.0_dp w1 = 0.0_dp w2 = 0.0_dp - f = rr**(nra+nrb+1)/2.0_dp**(nra+nrb+2) + f = rr**(nra + nrb + 1)/2.0_dp**(nra + nrb + 2) DO k = 1, nc2(nra, nrb) - w = w+REAL(c2(nra, nrb, k), dp)*AA(ma2(nra, nrb, k), xx)*BB(mb2(nra, nrb, k), yy) - w1 = w1+REAL(c2(nra, nrb, k), dp)*AA(ma2(nra, nrb, k)+1, xx)*BB(mb2(nra, nrb, k), yy) - w2 = w2+REAL(c2(nra, nrb, k), dp)*AA(ma2(nra, nrb, k), xx)*BB(mb2(nra, nrb, k)+1, yy) + w = w + REAL(c2(nra, nrb, k), dp)*AA(ma2(nra, nrb, k), xx)*BB(mb2(nra, nrb, k), yy) + w1 = w1 + REAL(c2(nra, nrb, k), dp)*AA(ma2(nra, nrb, k) + 1, xx)*BB(mb2(nra, nrb, k), yy) + w2 = w2 + REAL(c2(nra, nrb, k), dp)*AA(ma2(nra, nrb, k), xx)*BB(mb2(nra, nrb, k) + 1, yy) ENDDO Jc = f*w - dJc = f*REAL(nra+nrb+1, dp)*w/rr - dJc = dJc-dxx*f*w1 - dJc = dJc-dyy*f*w2 + dJc = f*REAL(nra + nrb + 1, dp)*w/rr + dJc = dJc - dxx*f*w1 + dJc = dJc - dyy*f*w2 DO k1 = 1, 3 - dS(k1+1, 1, :) = dS(k1+1, 1, :) & - & +SQRT(3.0_dp)*Arot(k1, 3)*fac1*fac2*dJc*v(:)/rr & - & +SQRT(3.0_dp)*dArot(k1, 3, :)*fac1*fac2*Jc + dS(k1 + 1, 1, :) = dS(k1 + 1, 1, :) & + & + SQRT(3.0_dp)*Arot(k1, 3)*fac1*fac2*dJc*v(:)/rr & + & + SQRT(3.0_dp)*dArot(k1, 3, :)*fac1*fac2*Jc ENDDO za = ZSA zb = ZPB - fac2 = SQRT(za**(2*nra+1)*zb**(2*nrb+1)) - xx = 0.5_dp*rr*(za+zb) - yy = 0.5_dp*rr*(za-zb) - dxx = 0.5_dp*(za+zb) - dyy = 0.5_dp*(za-zb) + fac2 = SQRT(za**(2*nra + 1)*zb**(2*nrb + 1)) + xx = 0.5_dp*rr*(za + zb) + yy = 0.5_dp*rr*(za - zb) + dxx = 0.5_dp*(za + zb) + dyy = 0.5_dp*(za - zb) w = 0.0_dp w1 = 0.0_dp w2 = 0.0_dp - f = rr**(nra+nrb+1)/2.0_dp**(nra+nrb+2) + f = rr**(nra + nrb + 1)/2.0_dp**(nra + nrb + 2) DO k = 1, nc3(nra, nrb) - w = w+REAL(c3(nra, nrb, k), dp)*AA(ma3(nra, nrb, k), xx)*BB(mb3(nra, nrb, k), yy) - w1 = w1+REAL(c3(nra, nrb, k), dp)*AA(ma3(nra, nrb, k)+1, xx)*BB(mb3(nra, nrb, k), yy) - w2 = w2+REAL(c3(nra, nrb, k), dp)*AA(ma3(nra, nrb, k), xx)*BB(mb3(nra, nrb, k)+1, yy) + w = w + REAL(c3(nra, nrb, k), dp)*AA(ma3(nra, nrb, k), xx)*BB(mb3(nra, nrb, k), yy) + w1 = w1 + REAL(c3(nra, nrb, k), dp)*AA(ma3(nra, nrb, k) + 1, xx)*BB(mb3(nra, nrb, k), yy) + w2 = w2 + REAL(c3(nra, nrb, k), dp)*AA(ma3(nra, nrb, k), xx)*BB(mb3(nra, nrb, k) + 1, yy) ENDDO Jc = f*w - dJc = f*REAL(nra+nrb+1, dp)*w/rr - dJc = dJc-dxx*f*w1 - dJc = dJc-dyy*f*w2 + dJc = f*REAL(nra + nrb + 1, dp)*w/rr + dJc = dJc - dxx*f*w1 + dJc = dJc - dyy*f*w2 DO k1 = 1, 3 - dS(1, k1+1, :) = dS(1, k1+1, :) & - & -SQRT(3.0_dp)*Arot(k1, 3)*fac1*fac2*dJc*v(:)/rr & - & -SQRT(3.0_dp)*dArot(k1, 3, :)*fac1*fac2*Jc + dS(1, k1 + 1, :) = dS(1, k1 + 1, :) & + & - SQRT(3.0_dp)*Arot(k1, 3)*fac1*fac2*dJc*v(:)/rr & + & - SQRT(3.0_dp)*dArot(k1, 3, :)*fac1*fac2*Jc ENDDO za = ZPA zb = ZPB - fac2 = SQRT(za**(2*nra+1)*zb**(2*nrb+1)) - xx = 0.5_dp*rr*(za+zb) - yy = 0.5_dp*rr*(za-zb) - dxx = 0.5_dp*(za+zb) - dyy = 0.5_dp*(za-zb) + fac2 = SQRT(za**(2*nra + 1)*zb**(2*nrb + 1)) + xx = 0.5_dp*rr*(za + zb) + yy = 0.5_dp*rr*(za - zb) + dxx = 0.5_dp*(za + zb) + dyy = 0.5_dp*(za - zb) w = 0.0_dp w1 = 0.0_dp w2 = 0.0_dp - f = rr**(nra+nrb+1)/2.0_dp**(nra+nrb+2) + f = rr**(nra + nrb + 1)/2.0_dp**(nra + nrb + 2) DO k = 1, nc4(nra, nrb) - w = w+REAL(c4(nra, nrb, k), dp)*AA(ma4(nra, nrb, k), xx)*BB(mb4(nra, nrb, k), yy) - w1 = w1+REAL(c4(nra, nrb, k), dp)*AA(ma4(nra, nrb, k)+1, xx)*BB(mb4(nra, nrb, k), yy) - w2 = w2+REAL(c4(nra, nrb, k), dp)*AA(ma4(nra, nrb, k), xx)*BB(mb4(nra, nrb, k)+1, yy) + w = w + REAL(c4(nra, nrb, k), dp)*AA(ma4(nra, nrb, k), xx)*BB(mb4(nra, nrb, k), yy) + w1 = w1 + REAL(c4(nra, nrb, k), dp)*AA(ma4(nra, nrb, k) + 1, xx)*BB(mb4(nra, nrb, k), yy) + w2 = w2 + REAL(c4(nra, nrb, k), dp)*AA(ma4(nra, nrb, k), xx)*BB(mb4(nra, nrb, k) + 1, yy) ENDDO Jss = f*w - dJss = f*REAL(nra+nrb+1, dp)*w/rr - dJss = dJss-dxx*f*w1 - dJss = dJss-dyy*f*w2 + dJss = f*REAL(nra + nrb + 1, dp)*w/rr + dJss = dJss - dxx*f*w1 + dJss = dJss - dyy*f*w2 w = 0.0_dp w1 = 0.0_dp w2 = 0.0_dp - f = rr**(nra+nrb+1)/2.0_dp**(nra+nrb+2) + f = rr**(nra + nrb + 1)/2.0_dp**(nra + nrb + 2) DO k = 1, nc5(nra, nrb) - w = w+REAL(c5(nra, nrb, k), dp)*AA(ma5(nra, nrb, k), xx)*BB(mb5(nra, nrb, k), yy) - w1 = w1+REAL(c5(nra, nrb, k), dp)*AA(ma5(nra, nrb, k)+1, xx)*BB(mb5(nra, nrb, k), yy) - w2 = w2+REAL(c5(nra, nrb, k), dp)*AA(ma5(nra, nrb, k), xx)*BB(mb5(nra, nrb, k)+1, yy) + w = w + REAL(c5(nra, nrb, k), dp)*AA(ma5(nra, nrb, k), xx)*BB(mb5(nra, nrb, k), yy) + w1 = w1 + REAL(c5(nra, nrb, k), dp)*AA(ma5(nra, nrb, k) + 1, xx)*BB(mb5(nra, nrb, k), yy) + w2 = w2 + REAL(c5(nra, nrb, k), dp)*AA(ma5(nra, nrb, k), xx)*BB(mb5(nra, nrb, k) + 1, yy) ENDDO Jcc = f*w - dJcc = f*REAL(nra+nrb+1, dp)*w/rr - dJcc = dJcc-dxx*f*w1 - dJcc = dJcc-dyy*f*w2 + dJcc = f*REAL(nra + nrb + 1, dp)*w/rr + dJcc = dJcc - dxx*f*w1 + dJcc = dJcc - dyy*f*w2 DO k1 = 1, 3 DO k2 = 1, 3 - dS(k1+1, k2+1, :) = dS(k1+1, k2+1, :) & - & +1.5_dp*Arot(k1, 1)*Arot(k2, 1)*fac1*fac2*dJss*v(:)/rr & - & +1.5_dp*dArot(k1, 1, :)*Arot(k2, 1)*fac1*fac2*Jss & - & +1.5_dp*Arot(k1, 1)*dArot(k2, 1, :)*fac1*fac2*Jss & - & +1.5_dp*Arot(k1, 2)*Arot(k2, 2)*fac1*fac2*dJss*v(:)/rr & - & +1.5_dp*dArot(k1, 2, :)*Arot(k2, 2)*fac1*fac2*Jss & - & +1.5_dp*Arot(k1, 2)*dArot(k2, 2, :)*fac1*fac2*Jss & - & -3.0_dp*Arot(k1, 3)*Arot(k2, 3)*fac1*fac2*dJcc*v(:)/rr & - & -3.0_dp*dArot(k1, 3, :)*Arot(k2, 3)*fac1*fac2*Jcc & - & -3.0_dp*Arot(k1, 3)*dArot(k2, 3, :)*fac1*fac2*Jcc + dS(k1 + 1, k2 + 1, :) = dS(k1 + 1, k2 + 1, :) & + & + 1.5_dp*Arot(k1, 1)*Arot(k2, 1)*fac1*fac2*dJss*v(:)/rr & + & + 1.5_dp*dArot(k1, 1, :)*Arot(k2, 1)*fac1*fac2*Jss & + & + 1.5_dp*Arot(k1, 1)*dArot(k2, 1, :)*fac1*fac2*Jss & + & + 1.5_dp*Arot(k1, 2)*Arot(k2, 2)*fac1*fac2*dJss*v(:)/rr & + & + 1.5_dp*dArot(k1, 2, :)*Arot(k2, 2)*fac1*fac2*Jss & + & + 1.5_dp*Arot(k1, 2)*dArot(k2, 2, :)*fac1*fac2*Jss & + & - 3.0_dp*Arot(k1, 3)*Arot(k2, 3)*fac1*fac2*dJcc*v(:)/rr & + & - 3.0_dp*dArot(k1, 3, :)*Arot(k2, 3)*fac1*fac2*Jcc & + & - 3.0_dp*Arot(k1, 3)*dArot(k2, 3, :)*fac1*fac2*Jcc ENDDO ENDDO @@ -1273,79 +1273,79 @@ FUNCTION AA(n, x) p = 1.0_dp ELSE IF (n == 1) THEN - p = 1.0_dp+x + p = 1.0_dp + x ELSE IF (n == 2) THEN - p = 2.0_dp+x*( & - 2.0_dp+x) + p = 2.0_dp + x*( & + 2.0_dp + x) ELSE IF (n == 3) THEN - p = 6.0_dp+x*( & - 6.0_dp+x*( & - 3.0_dp+x)) + p = 6.0_dp + x*( & + 6.0_dp + x*( & + 3.0_dp + x)) ELSE IF (n == 4) THEN - p = 24.0_dp+x*( & - 24.0_dp+x*( & - 12.0_dp+x*( & - 4.0_dp+x))) + p = 24.0_dp + x*( & + 24.0_dp + x*( & + 12.0_dp + x*( & + 4.0_dp + x))) ELSE IF (n == 5) THEN - p = 120.0_dp+x*( & - 120.0_dp+x*( & - 60.0_dp+x*( & - 20.0_dp+x*( & - 5.0_dp+x)))) + p = 120.0_dp + x*( & + 120.0_dp + x*( & + 60.0_dp + x*( & + 20.0_dp + x*( & + 5.0_dp + x)))) ELSE IF (n == 6) THEN - p = 720.0_dp+x*( & - 720.0_dp+x*( & - 360.0_dp+x*( & - 120.0_dp+x*( & - 30.0_dp+x*( & - 6.0_dp+x))))) + p = 720.0_dp + x*( & + 720.0_dp + x*( & + 360.0_dp + x*( & + 120.0_dp + x*( & + 30.0_dp + x*( & + 6.0_dp + x))))) ELSE IF (n == 7) THEN - p = 5040.0_dp+x*( & - 5040.0_dp+x*( & - 2520.0_dp+x*( & - 840.0_dp+x*( & - 210.0_dp+x*( & - 42.0_dp+x*( & - 7.0_dp+x)))))) + p = 5040.0_dp + x*( & + 5040.0_dp + x*( & + 2520.0_dp + x*( & + 840.0_dp + x*( & + 210.0_dp + x*( & + 42.0_dp + x*( & + 7.0_dp + x)))))) ELSE IF (n == 8) THEN - p = 40320.0_dp+x*( & - 40320.0_dp+x*( & - 20160.0_dp+x*( & - 6720.0_dp+x*( & - 1680.0_dp+x*( & - 336.0_dp+x*( & - 56.0_dp+x*( & - 8.0_dp+x))))))) + p = 40320.0_dp + x*( & + 40320.0_dp + x*( & + 20160.0_dp + x*( & + 6720.0_dp + x*( & + 1680.0_dp + x*( & + 336.0_dp + x*( & + 56.0_dp + x*( & + 8.0_dp + x))))))) ELSE IF (n == 9) THEN - p = 362880.0_dp+x*( & - 362880.0_dp+x*( & - 181440.0_dp+x*( & - 60480.0_dp+x*( & - 15120.0_dp+x*( & - 3024.0_dp+x*( & - 504.0_dp+x*( & - 72.0_dp+x*( & - 9.0_dp+x)))))))) + p = 362880.0_dp + x*( & + 362880.0_dp + x*( & + 181440.0_dp + x*( & + 60480.0_dp + x*( & + 15120.0_dp + x*( & + 3024.0_dp + x*( & + 504.0_dp + x*( & + 72.0_dp + x*( & + 9.0_dp + x)))))))) ELSE IF (n == 10) THEN - p = 3628800.0_dp+x*( & - 3628800.0_dp+x*( & - 1814400.0_dp+x*( & - 604800.0_dp+x*( & - 151200.0_dp+x*( & - 30240.0_dp+x*( & - 5040.0_dp+x*( & - 720.0_dp+x*( & - 90.0_dp+x*( & - 10.0_dp+x))))))))) + p = 3628800.0_dp + x*( & + 3628800.0_dp + x*( & + 1814400.0_dp + x*( & + 604800.0_dp + x*( & + 151200.0_dp + x*( & + 30240.0_dp + x*( & + 5040.0_dp + x*( & + 720.0_dp + x*( & + 90.0_dp + x*( & + 10.0_dp + x))))))))) ELSE p = 1.0_dp WRITE (*, *) ' n= ', n, ' in AA(n,x) ' @@ -1361,7 +1361,7 @@ FUNCTION AA(n, x) ENDIF ENDIF - AA = EXP(-x)*p/x**(n+1) + AA = EXP(-x)*p/x**(n + 1) END FUNCTION AA @@ -1377,12 +1377,12 @@ FUNCTION BB(n, y) REAL(kind=dp) :: y, BB IF (ABS(y) > 1.0e-20_dp) THEN - BB = REAL((-1)**(n+1), dp)*AA(n, -y)-AA(n, y) + BB = REAL((-1)**(n + 1), dp)*AA(n, -y) - AA(n, y) ELSE IF (MOD(n, 2) == 0) THEN - BB = 2.0_dp/REAL(n+1, dp) + BB = 2.0_dp/REAL(n + 1, dp) ELSE - BB = -y*2.0_dp/REAL(n+2, dp) + BB = -y*2.0_dp/REAL(n + 2, dp) ENDIF ENDIF diff --git a/src/se_fock_matrix.F b/src/se_fock_matrix.F index 8ac4b9c5ec..70c24341c8 100644 --- a/src/se_fock_matrix.F +++ b/src/se_fock_matrix.F @@ -192,7 +192,7 @@ SUBROUTINE build_se_fock_matrix(qs_env, calculate_forces, just_energy) ! NOTE: If we are performing SCP-NDDO, ks_matrix contains coulomb piece from SCP. DO ispin = 1, nspins CALL dbcsr_dot(ks_matrix(ispin)%matrix, matrix_p(ispin)%matrix, ecoul) - energy%hartree = energy%hartree+ecoul + energy%hartree = energy%hartree + ecoul END DO ! WRITE ( *, * ) 'AFTER Hartree', ecoul, energy%hartree @@ -206,7 +206,7 @@ SUBROUTINE build_se_fock_matrix(qs_env, calculate_forces, just_energy) ! Compute QM/MM Energy CALL dbcsr_dot(qs_env%ks_qmmm_env%matrix_h(1)%matrix, & matrix_p(ispin)%matrix, qmmm_el) - energy%qmmm_el = energy%qmmm_el+qmmm_el + energy%qmmm_el = energy%qmmm_el + qmmm_el END DO END IF @@ -214,11 +214,11 @@ SUBROUTINE build_se_fock_matrix(qs_env, calculate_forces, just_energy) ! Collect all the energy terms energy%mulliken = 0.0_dp energy%exc = 0.0_dp - energy%total = energy%total+energy%core+ & - energy%core_overlap+ & - 0.5_dp*energy%hartree+ & - energy%qmmm_el+ & - energy%dispersion+ & + energy%total = energy%total + energy%core + & + energy%core_overlap + & + 0.5_dp*energy%hartree + & + energy%qmmm_el + & + energy%dispersion + & energy%mulliken ! WRITE ( *, * ) ' AFTER TOTAL', energy%total diff --git a/src/se_fock_matrix_coulomb.F b/src/se_fock_matrix_coulomb.F index 3c1f0dd52e..d3c556365c 100644 --- a/src/se_fock_matrix_coulomb.F +++ b/src/se_fock_matrix_coulomb.F @@ -260,7 +260,7 @@ SUBROUTINE build_fock_matrix_coulomb(qs_env, ks_matrix, matrix_p, energy, calcul CALL dbcsr_get_block_p(matrix=diagmat_ks(2)%matrix, & row=iatom, col=iatom, BLOCK=ksa_block_b, found=found) CPASSERT(ASSOCIATED(ksa_block_b)) - p_block_tot_a(1:natorb_a, 1:natorb_a) = pa_block_a+pa_block_b + p_block_tot_a(1:natorb_a, 1:natorb_a) = pa_block_a + pa_block_b pa_b(1:natorb_a2) = RESHAPE(pa_block_b, (/natorb_a2/)) END IF @@ -297,7 +297,7 @@ SUBROUTINE build_fock_matrix_coulomb(qs_env, ks_matrix, matrix_p, energy, calcul CPASSERT(ASSOCIATED(ksb_block_b)) check = (SIZE(pb_block_a, 1) == SIZE(pb_block_b, 1)) .AND. (SIZE(pb_block_a, 2) == SIZE(pb_block_b, 2)) CPASSERT(check) - p_block_tot_b(1:natorb_b, 1:natorb_b) = pb_block_a+pb_block_b + p_block_tot_b(1:natorb_b, 1:natorb_b) = pb_block_a + pb_block_b pb_b(1:natorb_b2) = RESHAPE(pb_block_b, (/natorb_b2/)) END IF @@ -311,7 +311,7 @@ SUBROUTINE build_fock_matrix_coulomb(qs_env, ks_matrix, matrix_p, energy, calcul CALL fock2_1el(se_kind_a, se_kind_b, rij, ksa_block_a, ksb_block_a, & pa_a, pb_a, ecore=ecab, itype=itype, anag=anag, se_int_control=se_int_control, & se_taper=se_taper, store_int_env=store_int_env) - ecore2 = ecore2+ecab(1)+ecab(2) + ecore2 = ecore2 + ecab(1) + ecab(2) ELSE IF (nspins == 2) THEN ecab = 0._dp CALL fock2_1el(se_kind_a, se_kind_b, rij, ksa_block_a, ksb_block_a, & @@ -320,11 +320,11 @@ SUBROUTINE build_fock_matrix_coulomb(qs_env, ks_matrix, matrix_p, energy, calcul CALL fock2_1el(se_kind_a, se_kind_b, rij, ksa_block_b, ksb_block_b, & pa_b, pb_b, ecore=ecab, itype=itype, anag=anag, se_int_control=se_int_control, & se_taper=se_taper, store_int_env=store_int_env) - ecore2 = ecore2+ecab(1)+ecab(2) + ecore2 = ecore2 + ecab(1) + ecab(2) END IF IF (atener) THEN - atprop%atecoul(iatom) = atprop%atecoul(iatom)+ecab(1) - atprop%atecoul(jatom) = atprop%atecoul(jatom)+ecab(2) + atprop%atecoul(iatom) = atprop%atecoul(iatom) + ecab(1) + atprop%atecoul(jatom) = atprop%atecoul(jatom) + ecab(2) END IF ! Coulomb Terms IF (nspins == 1) THEN @@ -362,14 +362,14 @@ SUBROUTINE build_fock_matrix_coulomb(qs_env, ks_matrix, matrix_p, energy, calcul END IF ! Sum up force components - force(ikind)%all_potential(1, atom_a) = force(ikind)%all_potential(1, atom_a)-force_ab(1) - force(jkind)%all_potential(1, atom_b) = force(jkind)%all_potential(1, atom_b)+force_ab(1) + force(ikind)%all_potential(1, atom_a) = force(ikind)%all_potential(1, atom_a) - force_ab(1) + force(jkind)%all_potential(1, atom_b) = force(jkind)%all_potential(1, atom_b) + force_ab(1) - force(ikind)%all_potential(2, atom_a) = force(ikind)%all_potential(2, atom_a)-force_ab(2) - force(jkind)%all_potential(2, atom_b) = force(jkind)%all_potential(2, atom_b)+force_ab(2) + force(ikind)%all_potential(2, atom_a) = force(ikind)%all_potential(2, atom_a) - force_ab(2) + force(jkind)%all_potential(2, atom_b) = force(jkind)%all_potential(2, atom_b) + force_ab(2) - force(ikind)%all_potential(3, atom_a) = force(ikind)%all_potential(3, atom_a)-force_ab(3) - force(jkind)%all_potential(3, atom_b) = force(jkind)%all_potential(3, atom_b)+force_ab(3) + force(ikind)%all_potential(3, atom_a) = force(ikind)%all_potential(3, atom_a) - force_ab(3) + force(jkind)%all_potential(3, atom_b) = force(jkind)%all_potential(3, atom_b) + force_ab(3) ! Derivatives of the Coulomb Terms force_ab = 0._dp @@ -392,14 +392,14 @@ SUBROUTINE build_fock_matrix_coulomb(qs_env, ks_matrix, matrix_p, energy, calcul CALL virial_pair_force(virial%pv_virial, -1.0_dp, force_ab, rij) END IF ! Sum up force components - force(ikind)%rho_elec(1, atom_a) = force(ikind)%rho_elec(1, atom_a)-force_ab(1) - force(jkind)%rho_elec(1, atom_b) = force(jkind)%rho_elec(1, atom_b)+force_ab(1) + force(ikind)%rho_elec(1, atom_a) = force(ikind)%rho_elec(1, atom_a) - force_ab(1) + force(jkind)%rho_elec(1, atom_b) = force(jkind)%rho_elec(1, atom_b) + force_ab(1) - force(ikind)%rho_elec(2, atom_a) = force(ikind)%rho_elec(2, atom_a)-force_ab(2) - force(jkind)%rho_elec(2, atom_b) = force(jkind)%rho_elec(2, atom_b)+force_ab(2) + force(ikind)%rho_elec(2, atom_a) = force(ikind)%rho_elec(2, atom_a) - force_ab(2) + force(jkind)%rho_elec(2, atom_b) = force(jkind)%rho_elec(2, atom_b) + force_ab(2) - force(ikind)%rho_elec(3, atom_a) = force(ikind)%rho_elec(3, atom_a)-force_ab(3) - force(jkind)%rho_elec(3, atom_b) = force(jkind)%rho_elec(3, atom_b)+force_ab(3) + force(ikind)%rho_elec(3, atom_a) = force(ikind)%rho_elec(3, atom_a) - force_ab(3) + force(jkind)%rho_elec(3, atom_b) = force(jkind)%rho_elec(3, atom_b) + force_ab(3) END IF CASE DEFAULT CPABORT("") @@ -421,9 +421,9 @@ SUBROUTINE build_fock_matrix_coulomb(qs_env, ks_matrix, matrix_p, energy, calcul ecore=ecores, itype=itype, anag=anag, se_int_control=se_int_control, & se_taper=se_taper, store_int_env=store_int_env) END IF - ecore2 = ecore2+ecores + ecore2 = ecore2 + ecores IF (atener) THEN - atprop%atecoul(iatom) = atprop%atecoul(iatom)+ecores + atprop%atecoul(iatom) = atprop%atecoul(iatom) + ecores END IF ! Coulomb Terms IF (nspins == 1) THEN @@ -460,7 +460,7 @@ SUBROUTINE build_fock_matrix_coulomb(qs_env, ks_matrix, matrix_p, energy, calcul ! Two-centers one-electron terms CALL mp_sum(ecore2, para_env%group) - energy%hartree = ecore2-energy%core + energy%hartree = ecore2 - energy%core ! WRITE ( *, * ) 'IN SE_F_COUL', ecore2, energy%core CALL finalize_se_taper(se_taper) @@ -639,13 +639,13 @@ SUBROUTINE build_fock_matrix_coulomb_lr(qs_env, ks_matrix, matrix_p, energy, & ! Charge IF (mpole%task(1) .AND. task(1)) THEN - se_nddo_mpole%charge(iatom) = se_nddo_mpole%charge(iatom)+ & + se_nddo_mpole%charge(iatom) = se_nddo_mpole%charge(iatom) + & fac*pa_block_a(indi, indj)*mpole%c END IF ! Dipole IF (mpole%task(2) .AND. task(2)) THEN - se_nddo_mpole%dipole(:, iatom) = se_nddo_mpole%dipole(:, iatom)+ & + se_nddo_mpole%dipole(:, iatom) = se_nddo_mpole%dipole(:, iatom) + & fac*pa_block_a(indi, indj)*mpole%d(:) END IF @@ -653,7 +653,7 @@ SUBROUTINE build_fock_matrix_coulomb_lr(qs_env, ks_matrix, matrix_p, energy, & IF (mpole%task(3) .AND. task(3)) THEN qsph = fac*mpole%qs*pa_block_a(indi, indj) CALL quadrupole_sph_to_cart(qcart, qsph) - se_nddo_mpole%quadrupole(:, :, iatom) = se_nddo_mpole%quadrupole(:, :, iatom)+ & + se_nddo_mpole%quadrupole(:, :, iatom) = se_nddo_mpole%quadrupole(:, :, iatom) + & qcart END IF END DO @@ -720,16 +720,16 @@ SUBROUTINE build_fock_matrix_coulomb_lr(qs_env, ks_matrix, matrix_p, energy, & ! Virial for the long-range part and correction IF (use_virial) THEN ! Sum up contribution of pv_glob on each thread and keep only one copy of pv_local - virial%pv_virial = virial%pv_virial+pv_glob + virial%pv_virial = virial%pv_virial + pv_glob IF (para_env%ionode) THEN - virial%pv_virial = virial%pv_virial+pv_local + virial%pv_virial = virial%pv_virial + pv_local END IF END IF ! Debug Statements IF (debug_this_module) THEN CALL mp_sum(energy_glob, para_env%group) - WRITE (*, *) "TOTAL ENERGY AFTER EWALD:", energy_local+energy_glob+e_neut+e_self, & + WRITE (*, *) "TOTAL ENERGY AFTER EWALD:", energy_local + energy_glob + e_neut + e_self, & energy_local, energy_glob, e_neut, e_self END IF @@ -743,7 +743,7 @@ SUBROUTINE build_fock_matrix_coulomb_lr(qs_env, ks_matrix, matrix_p, energy, & nparticle_local = local_particles%n_el(ikind) DO ilist = 1, nparticle_local - node = node+1 + node = node + 1 iatom = local_particles%list(ikind)%array(ilist) DO ispin = 1, nspins CALL dbcsr_get_block_p(matrix=diagmat_ks(ispin)%matrix, & @@ -760,41 +760,41 @@ SUBROUTINE build_fock_matrix_coulomb_lr(qs_env, ks_matrix, matrix_p, energy, & ! Charge IF (mpole%task(1) .AND. task(1)) THEN - tmp = tmp+mpole%c*se_nddo_mpole%efield0(iatom) + tmp = tmp + mpole%c*se_nddo_mpole%efield0(iatom) END IF ! Dipole IF (mpole%task(2) .AND. task(2)) THEN - tmp = tmp-DOT_PRODUCT(mpole%d, se_nddo_mpole%efield1(:, iatom)) + tmp = tmp - DOT_PRODUCT(mpole%d, se_nddo_mpole%efield1(:, iatom)) END IF ! Quadrupole IF (mpole%task(3) .AND. task(3)) THEN - tmp = tmp-(1.0_dp/3.0_dp)*SUM(mpole%qc*RESHAPE(se_nddo_mpole%efield2(:, iatom), (/3, 3/))) + tmp = tmp - (1.0_dp/3.0_dp)*SUM(mpole%qc*RESHAPE(se_nddo_mpole%efield2(:, iatom), (/3, 3/))) END IF - ksa_block_a(indi, indj) = ksa_block_a(indi, indj)+tmp + ksa_block_a(indi, indj) = ksa_block_a(indi, indj) + tmp ksa_block_a(indj, indi) = ksa_block_a(indi, indj) END DO END DO ! Nuclear term and forces - IF (task(1)) enuc = enuc+se_kind_a%zeff*se_nddo_mpole%efield0(iatom) + IF (task(1)) enuc = enuc + se_kind_a%zeff*se_nddo_mpole%efield0(iatom) IF (atener) THEN - atprop%atecoul(iatom) = atprop%atecoul(iatom)+ & + atprop%atecoul(iatom) = atprop%atecoul(iatom) + & 0.5_dp*se_kind_a%zeff*se_nddo_mpole%efield0(iatom) END IF IF (calculate_forces) THEN atom_a = atom_of_kind(iatom) - force_a = forces_r(1:3, iatom)+forces_g(1:3, node) + force_a = forces_r(1:3, iatom) + forces_g(1:3, node) ! Derivatives of the periodic Coulomb Terms - force(ikind)%all_potential(:, atom_a) = force(ikind)%all_potential(:, atom_a)-force_a(:) + force(ikind)%all_potential(:, atom_a) = force(ikind)%all_potential(:, atom_a) - force_a(:) END IF END DO END DO ! Sum nuclear energy contribution CALL mp_sum(enuc, para_env%group) - energy%core_overlap = energy%core_overlap+energy%core_overlap0+0.5_dp*enuc + energy%core_overlap = energy%core_overlap + energy%core_overlap0 + 0.5_dp*enuc ! Debug Statements IF (debug_this_module) THEN @@ -994,7 +994,7 @@ SUBROUTINE build_fock_matrix_coul_lrc(qs_env, ks_matrix, matrix_p, energy, & CALL dbcsr_get_block_p(matrix=diagmat_ks(2)%matrix, & row=iatom, col=iatom, BLOCK=ksa_block_b, found=found) CPASSERT(ASSOCIATED(ksa_block_b)) - p_block_tot_a(1:natorb_a, 1:natorb_a) = pa_block_a+pa_block_b + p_block_tot_a(1:natorb_a, 1:natorb_a) = pa_block_a + pa_block_b pa_b(1:natorb_a2) = RESHAPE(pa_block_b, (/natorb_a2/)) END IF @@ -1041,7 +1041,7 @@ SUBROUTINE build_fock_matrix_coul_lrc(qs_env, ks_matrix, matrix_p, energy, & CPASSERT(ASSOCIATED(ksb_block_b)) check = (SIZE(pb_block_a, 1) == SIZE(pb_block_b, 1)) .AND. (SIZE(pb_block_a, 2) == SIZE(pb_block_b, 2)) CPASSERT(check) - p_block_tot_b(1:natorb_b, 1:natorb_b) = pb_block_a+pb_block_b + p_block_tot_b(1:natorb_b, 1:natorb_b) = pb_block_a + pb_block_b pb_b(1:natorb_b2) = RESHAPE(pb_block_b, (/natorb_b2/)) END IF @@ -1051,7 +1051,7 @@ SUBROUTINE build_fock_matrix_coul_lrc(qs_env, ks_matrix, matrix_p, energy, & ! Evaluate nuclear contribution.. CALL corecore_el(se_kind_a, se_kind_b, rij, enuc=enuc, itype=itype, anag=anag, & se_int_control=se_int_control, se_taper=se_taper) - enuclear = enuclear+enuc + enuclear = enuclear + enuc ! Two-centers One-electron terms IF (nspins == 1) THEN @@ -1059,7 +1059,7 @@ SUBROUTINE build_fock_matrix_coul_lrc(qs_env, ks_matrix, matrix_p, energy, & CALL fock2_1el(se_kind_a, se_kind_b, rij, ksa_block_a, ksb_block_a, & pa_a, pb_a, ecore=ecab, itype=itype, anag=anag, se_int_control=se_int_control, & se_taper=se_taper, store_int_env=store_int_env) - ecore2 = ecore2+ecab(1)+ecab(2) + ecore2 = ecore2 + ecab(1) + ecab(2) ELSE IF (nspins == 2) THEN ecab = 0._dp CALL fock2_1el(se_kind_a, se_kind_b, rij, ksa_block_a, ksb_block_a, & @@ -1068,11 +1068,11 @@ SUBROUTINE build_fock_matrix_coul_lrc(qs_env, ks_matrix, matrix_p, energy, & CALL fock2_1el(se_kind_a, se_kind_b, rij, ksa_block_b, ksb_block_b, & pa_b, pb_b, ecore=ecab, itype=itype, anag=anag, se_int_control=se_int_control, & se_taper=se_taper, store_int_env=store_int_env) - ecore2 = ecore2+ecab(1)+ecab(2) + ecore2 = ecore2 + ecab(1) + ecab(2) END IF IF (atener) THEN - atprop%atecoul(iatom) = atprop%atecoul(iatom)+ecab(1)+0.5_dp*enuc - atprop%atecoul(jatom) = atprop%atecoul(jatom)+ecab(2)+0.5_dp*enuc + atprop%atecoul(iatom) = atprop%atecoul(iatom) + ecab(1) + 0.5_dp*enuc + atprop%atecoul(jatom) = atprop%atecoul(jatom) + ecab(2) + 0.5_dp*enuc END IF ! Coulomb Terms IF (nspins == 1) THEN @@ -1111,17 +1111,17 @@ SUBROUTINE build_fock_matrix_coul_lrc(qs_env, ks_matrix, matrix_p, energy, & IF (use_virial) THEN CALL virial_pair_force(virial%pv_virial, -1.0_dp, force_ab, rij) END IF - force_ab = force_ab+force_ab0 + force_ab = force_ab + force_ab0 ! Sum up force components - force(ikind)%all_potential(1, atom_a) = force(ikind)%all_potential(1, atom_a)-force_ab(1) - force(jkind)%all_potential(1, atom_b) = force(jkind)%all_potential(1, atom_b)+force_ab(1) + force(ikind)%all_potential(1, atom_a) = force(ikind)%all_potential(1, atom_a) - force_ab(1) + force(jkind)%all_potential(1, atom_b) = force(jkind)%all_potential(1, atom_b) + force_ab(1) - force(ikind)%all_potential(2, atom_a) = force(ikind)%all_potential(2, atom_a)-force_ab(2) - force(jkind)%all_potential(2, atom_b) = force(jkind)%all_potential(2, atom_b)+force_ab(2) + force(ikind)%all_potential(2, atom_a) = force(ikind)%all_potential(2, atom_a) - force_ab(2) + force(jkind)%all_potential(2, atom_b) = force(jkind)%all_potential(2, atom_b) + force_ab(2) - force(ikind)%all_potential(3, atom_a) = force(ikind)%all_potential(3, atom_a)-force_ab(3) - force(jkind)%all_potential(3, atom_b) = force(jkind)%all_potential(3, atom_b)+force_ab(3) + force(ikind)%all_potential(3, atom_a) = force(ikind)%all_potential(3, atom_a) - force_ab(3) + force(jkind)%all_potential(3, atom_b) = force(jkind)%all_potential(3, atom_b) + force_ab(3) ! Derivatives of the Coulomb Terms force_ab = 0._dp @@ -1145,14 +1145,14 @@ SUBROUTINE build_fock_matrix_coul_lrc(qs_env, ks_matrix, matrix_p, energy, & END IF ! Sum up force components - force(ikind)%rho_elec(1, atom_a) = force(ikind)%rho_elec(1, atom_a)-force_ab(1) - force(jkind)%rho_elec(1, atom_b) = force(jkind)%rho_elec(1, atom_b)+force_ab(1) + force(ikind)%rho_elec(1, atom_a) = force(ikind)%rho_elec(1, atom_a) - force_ab(1) + force(jkind)%rho_elec(1, atom_b) = force(jkind)%rho_elec(1, atom_b) + force_ab(1) - force(ikind)%rho_elec(2, atom_a) = force(ikind)%rho_elec(2, atom_a)-force_ab(2) - force(jkind)%rho_elec(2, atom_b) = force(jkind)%rho_elec(2, atom_b)+force_ab(2) + force(ikind)%rho_elec(2, atom_a) = force(ikind)%rho_elec(2, atom_a) - force_ab(2) + force(jkind)%rho_elec(2, atom_b) = force(jkind)%rho_elec(2, atom_b) + force_ab(2) - force(ikind)%rho_elec(3, atom_a) = force(ikind)%rho_elec(3, atom_a)-force_ab(3) - force(jkind)%rho_elec(3, atom_b) = force(jkind)%rho_elec(3, atom_b)+force_ab(3) + force(ikind)%rho_elec(3, atom_a) = force(ikind)%rho_elec(3, atom_a) - force_ab(3) + force(jkind)%rho_elec(3, atom_b) = force(jkind)%rho_elec(3, atom_b) + force_ab(3) END IF CASE DEFAULT CPABORT("") @@ -1165,15 +1165,15 @@ SUBROUTINE build_fock_matrix_coul_lrc(qs_env, ks_matrix, matrix_p, energy, & ! Sum-up Virial constribution (long-range correction) IF (use_virial) THEN - pv_glob(1, 1) = pv_glob(1, 1)+ptens11 - pv_glob(1, 2) = pv_glob(1, 2)+(ptens12+ptens21)*0.5_dp - pv_glob(1, 3) = pv_glob(1, 3)+(ptens13+ptens31)*0.5_dp + pv_glob(1, 1) = pv_glob(1, 1) + ptens11 + pv_glob(1, 2) = pv_glob(1, 2) + (ptens12 + ptens21)*0.5_dp + pv_glob(1, 3) = pv_glob(1, 3) + (ptens13 + ptens31)*0.5_dp pv_glob(2, 1) = pv_glob(1, 2) - pv_glob(2, 2) = pv_glob(2, 2)+ptens22 - pv_glob(2, 3) = pv_glob(2, 3)+(ptens23+ptens32)*0.5_dp + pv_glob(2, 2) = pv_glob(2, 2) + ptens22 + pv_glob(2, 3) = pv_glob(2, 3) + (ptens23 + ptens32)*0.5_dp pv_glob(3, 1) = pv_glob(1, 3) pv_glob(3, 2) = pv_glob(2, 3) - pv_glob(3, 3) = pv_glob(3, 3)+ptens33 + pv_glob(3, 3) = pv_glob(3, 3) + ptens33 END IF IF (calculate_forces) THEN @@ -1184,9 +1184,9 @@ SUBROUTINE build_fock_matrix_coul_lrc(qs_env, ks_matrix, matrix_p, energy, & CALL mp_sum(efield0, para_env%group) CALL mp_sum(efield1, para_env%group) CALL mp_sum(efield2, para_env%group) - se_nddo_mpole%efield0 = se_nddo_mpole%efield0-efield0 - se_nddo_mpole%efield1 = se_nddo_mpole%efield1-efield1 - se_nddo_mpole%efield2 = se_nddo_mpole%efield2-efield2 + se_nddo_mpole%efield0 = se_nddo_mpole%efield0 - efield0 + se_nddo_mpole%efield1 = se_nddo_mpole%efield1 - efield1 + se_nddo_mpole%efield2 = se_nddo_mpole%efield2 - efield2 ! deallocate working arrays DEALLOCATE (efield0) DEALLOCATE (efield1) @@ -1195,7 +1195,7 @@ SUBROUTINE build_fock_matrix_coul_lrc(qs_env, ks_matrix, matrix_p, energy, & ! Corrections for two-centers one-electron terms + nuclear terms CALL mp_sum(enuclear, para_env%group) CALL mp_sum(ecore2, para_env%group) - energy%hartree = energy%hartree+ecore2 + energy%hartree = energy%hartree + ecore2 energy%core_overlap = enuclear CALL finalize_se_taper(se_taper) CALL timestop(handle) @@ -1361,7 +1361,7 @@ SUBROUTINE build_fock_matrix_coul_lr_r3(qs_env, ks_matrix, matrix_p, energy, cal CALL dbcsr_get_block_p(matrix=diagmat_ks(2)%matrix, & row=iatom, col=iatom, BLOCK=ksa_block_b, found=found) CPASSERT(ASSOCIATED(ksa_block_b)) - p_block_tot_a(1:natorb_a, 1:natorb_a) = pa_block_a+pa_block_b + p_block_tot_a(1:natorb_a, 1:natorb_a) = pa_block_a + pa_block_b pa_b(1:natorb_a2) = RESHAPE(pa_block_b, (/natorb_a2/)) END IF END IF @@ -1397,7 +1397,7 @@ SUBROUTINE build_fock_matrix_coul_lr_r3(qs_env, ks_matrix, matrix_p, energy, cal CPASSERT(ASSOCIATED(ksb_block_b)) check = (SIZE(pb_block_a, 1) == SIZE(pb_block_b, 1)) .AND. (SIZE(pb_block_a, 2) == SIZE(pb_block_b, 2)) CPASSERT(check) - p_block_tot_b(1:natorb_b, 1:natorb_b) = pb_block_a+pb_block_b + p_block_tot_b(1:natorb_b, 1:natorb_b) = pb_block_a + pb_block_b pb_b(1:natorb_b2) = RESHAPE(pb_block_b, (/natorb_b2/)) END IF @@ -1416,7 +1416,7 @@ SUBROUTINE build_fock_matrix_coul_lr_r3(qs_env, ks_matrix, matrix_p, energy, cal CALL fock2_1el_r3(se_kind_a, se_kind_b, ksa_block_a, ksb_block_a, pa_a, pb_a, & ecore=ecab, e1b=se_kind_a%expns3_int(jkind)%expns3%e1b, & e2a=se_kind_a%expns3_int(jkind)%expns3%e2a, rp=r3inv) - ecore2 = ecore2+ecab(1)+ecab(2) + ecore2 = ecore2 + ecab(1) + ecab(2) ELSE IF (nspins == 2) THEN ecab = 0._dp CALL fock2_1el_r3(se_kind_a, se_kind_b, ksa_block_a, ksb_block_a, pa_block_a, & @@ -1426,11 +1426,11 @@ SUBROUTINE build_fock_matrix_coul_lr_r3(qs_env, ks_matrix, matrix_p, energy, cal CALL fock2_1el_r3(se_kind_a, se_kind_b, ksa_block_b, ksb_block_b, pa_b, pb_b, & ecore=ecab, e1b=se_kind_a%expns3_int(jkind)%expns3%e1b, & e2a=se_kind_a%expns3_int(jkind)%expns3%e2a, rp=r3inv) - ecore2 = ecore2+ecab(1)+ecab(2) + ecore2 = ecore2 + ecab(1) + ecab(2) END IF IF (atener) THEN - atprop%atecoul(iatom) = atprop%atecoul(iatom)+ecab(1) - atprop%atecoul(jatom) = atprop%atecoul(jatom)+ecab(2) + atprop%atecoul(iatom) = atprop%atecoul(iatom) + ecab(1) + atprop%atecoul(jatom) = atprop%atecoul(jatom) + ecab(2) END IF ! Coulomb Terms IF (nspins == 1) THEN @@ -1464,14 +1464,14 @@ SUBROUTINE build_fock_matrix_coul_lr_r3(qs_env, ks_matrix, matrix_p, energy, cal END IF ! Sum up force components - force(ikind)%all_potential(1, atom_a) = force(ikind)%all_potential(1, atom_a)-force_ab(1) - force(jkind)%all_potential(1, atom_b) = force(jkind)%all_potential(1, atom_b)+force_ab(1) + force(ikind)%all_potential(1, atom_a) = force(ikind)%all_potential(1, atom_a) - force_ab(1) + force(jkind)%all_potential(1, atom_b) = force(jkind)%all_potential(1, atom_b) + force_ab(1) - force(ikind)%all_potential(2, atom_a) = force(ikind)%all_potential(2, atom_a)-force_ab(2) - force(jkind)%all_potential(2, atom_b) = force(jkind)%all_potential(2, atom_b)+force_ab(2) + force(ikind)%all_potential(2, atom_a) = force(ikind)%all_potential(2, atom_a) - force_ab(2) + force(jkind)%all_potential(2, atom_b) = force(jkind)%all_potential(2, atom_b) + force_ab(2) - force(ikind)%all_potential(3, atom_a) = force(ikind)%all_potential(3, atom_a)-force_ab(3) - force(jkind)%all_potential(3, atom_b) = force(jkind)%all_potential(3, atom_b)+force_ab(3) + force(ikind)%all_potential(3, atom_a) = force(ikind)%all_potential(3, atom_a) - force_ab(3) + force(jkind)%all_potential(3, atom_b) = force(jkind)%all_potential(3, atom_b) + force_ab(3) ! Derivatives of the Coulomb Terms force_ab = 0.0_dp @@ -1487,14 +1487,14 @@ SUBROUTINE build_fock_matrix_coul_lr_r3(qs_env, ks_matrix, matrix_p, energy, cal END IF ! Sum up force components - force(ikind)%rho_elec(1, atom_a) = force(ikind)%rho_elec(1, atom_a)-force_ab(1) - force(jkind)%rho_elec(1, atom_b) = force(jkind)%rho_elec(1, atom_b)+force_ab(1) + force(ikind)%rho_elec(1, atom_a) = force(ikind)%rho_elec(1, atom_a) - force_ab(1) + force(jkind)%rho_elec(1, atom_b) = force(jkind)%rho_elec(1, atom_b) + force_ab(1) - force(ikind)%rho_elec(2, atom_a) = force(ikind)%rho_elec(2, atom_a)-force_ab(2) - force(jkind)%rho_elec(2, atom_b) = force(jkind)%rho_elec(2, atom_b)+force_ab(2) + force(ikind)%rho_elec(2, atom_a) = force(ikind)%rho_elec(2, atom_a) - force_ab(2) + force(jkind)%rho_elec(2, atom_b) = force(jkind)%rho_elec(2, atom_b) + force_ab(2) - force(ikind)%rho_elec(3, atom_a) = force(ikind)%rho_elec(3, atom_a)-force_ab(3) - force(jkind)%rho_elec(3, atom_b) = force(jkind)%rho_elec(3, atom_b)+force_ab(3) + force(ikind)%rho_elec(3, atom_a) = force(ikind)%rho_elec(3, atom_a) - force_ab(3) + force(jkind)%rho_elec(3, atom_b) = force(jkind)%rho_elec(3, atom_b) + force_ab(3) END IF CASE DEFAULT CPABORT("") @@ -1520,7 +1520,7 @@ SUBROUTINE build_fock_matrix_coul_lr_r3(qs_env, ks_matrix, matrix_p, energy, cal ! Two-centers one-electron terms CALL mp_sum(ecore2, para_env%group) - energy%hartree = energy%hartree+ecore2 + energy%hartree = energy%hartree + ecore2 CALL timestop(handle) END SUBROUTINE build_fock_matrix_coul_lr_r3 diff --git a/src/se_fock_matrix_dbg.F b/src/se_fock_matrix_dbg.F index 5b1e8028e5..2a72d4605f 100644 --- a/src/se_fock_matrix_dbg.F +++ b/src/se_fock_matrix_dbg.F @@ -66,14 +66,14 @@ SUBROUTINE dbg_energy_coulomb_lr(energy, ks_matrix, nspins, qs_env, matrix_p, & ! Compute the Hartree energy DO ispin = 1, nspins CALL dbcsr_dot(ks_matrix(ispin)%matrix, matrix_p(ispin)%matrix, ecoul) - energy%hartree = energy%hartree+ecoul + energy%hartree = energy%hartree + ecoul WRITE (*, *) ispin, "ECOUL ", ecoul END DO WRITE (*, *) "ENUC in DBG:", energy%core_overlap ! Debug statements - WRITE (*, *) "TOTAL ENE", 0.5_dp*energy%hartree+energy%core_overlap + WRITE (*, *) "TOTAL ENE", 0.5_dp*energy%hartree + energy%core_overlap CPABORT("Debug energy for Coulomb Long-Range") END SUBROUTINE dbg_energy_coulomb_lr diff --git a/src/se_fock_matrix_exchange.F b/src/se_fock_matrix_exchange.F index 7a7816ad93..ce104d4876 100644 --- a/src/se_fock_matrix_exchange.F +++ b/src/se_fock_matrix_exchange.F @@ -197,7 +197,7 @@ SUBROUTINE build_fock_matrix_exchange(qs_env, ks_matrix, matrix_p, calculate_for CPASSERT(ASSOCIATED(p_block_b)) check = (size_p_block_a(1) == SIZE(p_block_b, 1)) .AND. (size_p_block_a(2) == SIZE(p_block_b, 2)) CPASSERT(check) - p_block_tot(1:SIZE(p_block_a, 1), 1:SIZE(p_block_a, 2)) = p_block_a+p_block_b + p_block_tot(1:SIZE(p_block_a, 1), 1:SIZE(p_block_a, 2)) = p_block_a + p_block_b END IF dr = DOT_PRODUCT(rij, rij) @@ -250,14 +250,14 @@ SUBROUTINE build_fock_matrix_exchange(qs_env, ks_matrix, matrix_p, calculate_for CALL virial_pair_force(virial%pv_virial, -1.0_dp, force_ab, rij) END IF - force(ikind)%rho_elec(1, atom_a) = force(ikind)%rho_elec(1, atom_a)-force_ab(1) - force(jkind)%rho_elec(1, atom_b) = force(jkind)%rho_elec(1, atom_b)+force_ab(1) + force(ikind)%rho_elec(1, atom_a) = force(ikind)%rho_elec(1, atom_a) - force_ab(1) + force(jkind)%rho_elec(1, atom_b) = force(jkind)%rho_elec(1, atom_b) + force_ab(1) - force(ikind)%rho_elec(2, atom_a) = force(ikind)%rho_elec(2, atom_a)-force_ab(2) - force(jkind)%rho_elec(2, atom_b) = force(jkind)%rho_elec(2, atom_b)+force_ab(2) + force(ikind)%rho_elec(2, atom_a) = force(ikind)%rho_elec(2, atom_a) - force_ab(2) + force(jkind)%rho_elec(2, atom_b) = force(jkind)%rho_elec(2, atom_b) + force_ab(2) - force(ikind)%rho_elec(3, atom_a) = force(ikind)%rho_elec(3, atom_a)-force_ab(3) - force(jkind)%rho_elec(3, atom_b) = force(jkind)%rho_elec(3, atom_b)+force_ab(3) + force(ikind)%rho_elec(3, atom_a) = force(ikind)%rho_elec(3, atom_a) - force_ab(3) + force(jkind)%rho_elec(3, atom_b) = force(jkind)%rho_elec(3, atom_b) + force_ab(3) END IF END IF END DO diff --git a/src/semi_empirical_expns3_methods.F b/src/semi_empirical_expns3_methods.F index a96ae818a6..1a6e4d59cf 100644 --- a/src/semi_empirical_expns3_methods.F +++ b/src/semi_empirical_expns3_methods.F @@ -192,7 +192,7 @@ SUBROUTINE setup_c3_coeff(sepi, sepj, ikind, jkind, itype) DO j = 1, sepj%natorb lk = l_index(j) kl = indexa(j, j) - kr = kr+1 + kr = kr + 1 sepi%expns3_int(jkind)%expns3%w(kr) = & ijkl_low_3(sepi, sepj, ij, kl, li, li, lk, lk, 0, do_method_undef, coeff_int_3) END DO @@ -206,7 +206,7 @@ SUBROUTINE setup_c3_coeff(sepi, sepj, ikind, jkind, itype) DO j = 1, sepi%natorb lk = l_index(j) kl = indexa(j, j) - kr = kr+1 + kr = kr + 1 sepj%expns3_int(ikind)%expns3%w(kr) = & ijkl_low_3(sepj, sepi, ij, kl, li, li, lk, lk, 0, do_method_undef, coeff_int_3) END DO diff --git a/src/semi_empirical_int3_utils.F b/src/semi_empirical_int3_utils.F index 05224d5181..092a202f02 100644 --- a/src/semi_empirical_int3_utils.F +++ b/src/semi_empirical_int3_utils.F @@ -57,10 +57,10 @@ FUNCTION ijkl_low_3(sepi, sepj, ij, kl, li, lj, lk, ll, ic, itype, eval) RESULT( REAL(KIND=dp) :: add, ccc, chrg, pij, pkl, sum sum = 0.0_dp - l1 = ABS(li-lj) - lij = indexb(li+1, lj+1) - l2 = ABS(lk-ll) - lkl = indexb(lk+1, ll+1) + l1 = ABS(li - lj) + lij = indexb(li + 1, lj + 1) + l2 = ABS(lk - ll) + lkl = indexb(lk + 1, ll + 1) ! Standard value of the integral IF (l1 == 0) THEN @@ -92,7 +92,7 @@ FUNCTION ijkl_low_3(sepi, sepj, ij, kl, li, lj, lk, ll, ic, itype, eval) RESULT( IF (itype == do_method_pchg) THEN add = 0.0_dp ELSE - add = (pij+pkl)**2 + add = (pij + pkl)**2 END IF ccc = clm_d(ij, l1, 0)*clm_d(kl, l2, 0) IF (ABS(ccc) > EPSILON(0.0_dp)) THEN diff --git a/src/semi_empirical_int_ana.F b/src/semi_empirical_int_ana.F index 481ab0d864..93ad66455c 100644 --- a/src/semi_empirical_int_ana.F +++ b/src/semi_empirical_int_ana.F @@ -146,10 +146,10 @@ RECURSIVE SUBROUTINE rotnuc_ana(sepi, sepj, rijv, itype, e1b, e2a, de1b, de2a, & DO n = 1, 2 IF (.NOT. task(n)) CYCLE DO i = 1, last_orbital(n) - ind1 = i-1 + ind1 = i - 1 DO j = 1, i - ind2 = j-1 - m = (i*(i-1))/2+j + ind2 = j - 1 + m = (i*(i - 1))/2 + j ! Perform Rotations ... IF (ind2 == 0) THEN IF (ind1 == 0) THEN @@ -160,26 +160,26 @@ RECURSIVE SUBROUTINE rotnuc_ana(sepi, sepj, rijv, itype, e1b, e2a, de1b, de2a, & tmp(m) = ij_matrix%sp(1, ind1)*core(2, n) ELSE ! Type of Integral (SD/) - tmp(m) = ij_matrix%sd(1, ind1-3)*core(5, n) + tmp(m) = ij_matrix%sd(1, ind1 - 3)*core(5, n) END IF ELSE IF (ind2 < 4) THEN IF (ind1 < 4) THEN ! Type of Integral (PP/) ipp = indpp(ind1, ind2) - tmp(m) = core(3, n)*ij_matrix%pp(ipp, 1, 1)+ & - core(4, n)*(ij_matrix%pp(ipp, 2, 2)+ij_matrix%pp(ipp, 3, 3)) + tmp(m) = core(3, n)*ij_matrix%pp(ipp, 1, 1) + & + core(4, n)*(ij_matrix%pp(ipp, 2, 2) + ij_matrix%pp(ipp, 3, 3)) ELSE ! Type of Integral (PD/) - idp = inddp(ind1-3, ind2) - tmp(m) = core(6, n)*ij_matrix%pd(idp, 1, 1)+ & - core(8, n)*(ij_matrix%pd(idp, 2, 2)+ij_matrix%pd(idp, 3, 3)) + idp = inddp(ind1 - 3, ind2) + tmp(m) = core(6, n)*ij_matrix%pd(idp, 1, 1) + & + core(8, n)*(ij_matrix%pd(idp, 2, 2) + ij_matrix%pd(idp, 3, 3)) END IF ELSE ! Type of Integral (DD/) - idd = inddd(ind1-3, ind2-3) - tmp(m) = core(7, n)*ij_matrix%dd(idd, 1, 1)+ & - core(9, n)*(ij_matrix%dd(idd, 2, 2)+ij_matrix%dd(idd, 3, 3))+ & - core(10, n)*(ij_matrix%dd(idd, 4, 4)+ij_matrix%dd(idd, 5, 5)) + idd = inddd(ind1 - 3, ind2 - 3) + tmp(m) = core(7, n)*ij_matrix%dd(idd, 1, 1) + & + core(9, n)*(ij_matrix%dd(idd, 2, 2) + ij_matrix%dd(idd, 3, 3)) + & + core(10, n)*(ij_matrix%dd(idd, 4, 4) + ij_matrix%dd(idd, 5, 5)) END IF END DO END DO @@ -203,10 +203,10 @@ RECURSIVE SUBROUTINE rotnuc_ana(sepi, sepj, rijv, itype, e1b, e2a, de1b, de2a, & DO n = 1, 2 IF (.NOT. task(n)) CYCLE DO i = 1, last_orbital(n) - ind1 = i-1 + ind1 = i - 1 DO j = 1, i - ind2 = j-1 - m = (i*(i-1))/2+j + ind2 = j - 1 + m = (i*(i - 1))/2 + j ! Perform Rotations ... IF (ind2 == 0) THEN IF (ind1 == 0) THEN @@ -216,84 +216,84 @@ RECURSIVE SUBROUTINE rotnuc_ana(sepi, sepj, rijv, itype, e1b, e2a, de1b, de2a, & tmp_d(3, m) = dcore(1, n)*drij(3) ELSE IF (ind1 < 4) THEN ! Type of Integral (SP/) - tmp_d(1, m) = ij_matrix%sp_d(1, 1, ind1)*core(2, n)+ & + tmp_d(1, m) = ij_matrix%sp_d(1, 1, ind1)*core(2, n) + & ij_matrix%sp(1, ind1)*dcore(2, n)*drij(1) - tmp_d(2, m) = ij_matrix%sp_d(2, 1, ind1)*core(2, n)+ & + tmp_d(2, m) = ij_matrix%sp_d(2, 1, ind1)*core(2, n) + & ij_matrix%sp(1, ind1)*dcore(2, n)*drij(2) - tmp_d(3, m) = ij_matrix%sp_d(3, 1, ind1)*core(2, n)+ & + tmp_d(3, m) = ij_matrix%sp_d(3, 1, ind1)*core(2, n) + & ij_matrix%sp(1, ind1)*dcore(2, n)*drij(3) ELSE ! Type of Integral (SD/) - tmp_d(1, m) = ij_matrix%sd_d(1, 1, ind1-3)*core(5, n)+ & - ij_matrix%sd(1, ind1-3)*dcore(5, n)*drij(1) + tmp_d(1, m) = ij_matrix%sd_d(1, 1, ind1 - 3)*core(5, n) + & + ij_matrix%sd(1, ind1 - 3)*dcore(5, n)*drij(1) - tmp_d(2, m) = ij_matrix%sd_d(2, 1, ind1-3)*core(5, n)+ & - ij_matrix%sd(1, ind1-3)*dcore(5, n)*drij(2) + tmp_d(2, m) = ij_matrix%sd_d(2, 1, ind1 - 3)*core(5, n) + & + ij_matrix%sd(1, ind1 - 3)*dcore(5, n)*drij(2) - tmp_d(3, m) = ij_matrix%sd_d(3, 1, ind1-3)*core(5, n)+ & - ij_matrix%sd(1, ind1-3)*dcore(5, n)*drij(3) + tmp_d(3, m) = ij_matrix%sd_d(3, 1, ind1 - 3)*core(5, n) + & + ij_matrix%sd(1, ind1 - 3)*dcore(5, n)*drij(3) END IF ELSE IF (ind2 < 4) THEN IF (ind1 < 4) THEN ! Type of Integral (PP/) ipp = indpp(ind1, ind2) - tmp_d(1, m) = dcore(3, n)*drij(1)*ij_matrix%pp(ipp, 1, 1)+ & - core(3, n)*ij_matrix%pp_d(1, ipp, 1, 1)+ & - dcore(4, n)*drij(1)*(ij_matrix%pp(ipp, 2, 2)+ij_matrix%pp(ipp, 3, 3))+ & - core(4, n)*(ij_matrix%pp_d(1, ipp, 2, 2)+ij_matrix%pp_d(1, ipp, 3, 3)) - - tmp_d(2, m) = dcore(3, n)*drij(2)*ij_matrix%pp(ipp, 1, 1)+ & - core(3, n)*ij_matrix%pp_d(2, ipp, 1, 1)+ & - dcore(4, n)*drij(2)*(ij_matrix%pp(ipp, 2, 2)+ij_matrix%pp(ipp, 3, 3))+ & - core(4, n)*(ij_matrix%pp_d(2, ipp, 2, 2)+ij_matrix%pp_d(2, ipp, 3, 3)) - - tmp_d(3, m) = dcore(3, n)*drij(3)*ij_matrix%pp(ipp, 1, 1)+ & - core(3, n)*ij_matrix%pp_d(3, ipp, 1, 1)+ & - dcore(4, n)*drij(3)*(ij_matrix%pp(ipp, 2, 2)+ij_matrix%pp(ipp, 3, 3))+ & - core(4, n)*(ij_matrix%pp_d(3, ipp, 2, 2)+ij_matrix%pp_d(3, ipp, 3, 3)) + tmp_d(1, m) = dcore(3, n)*drij(1)*ij_matrix%pp(ipp, 1, 1) + & + core(3, n)*ij_matrix%pp_d(1, ipp, 1, 1) + & + dcore(4, n)*drij(1)*(ij_matrix%pp(ipp, 2, 2) + ij_matrix%pp(ipp, 3, 3)) + & + core(4, n)*(ij_matrix%pp_d(1, ipp, 2, 2) + ij_matrix%pp_d(1, ipp, 3, 3)) + + tmp_d(2, m) = dcore(3, n)*drij(2)*ij_matrix%pp(ipp, 1, 1) + & + core(3, n)*ij_matrix%pp_d(2, ipp, 1, 1) + & + dcore(4, n)*drij(2)*(ij_matrix%pp(ipp, 2, 2) + ij_matrix%pp(ipp, 3, 3)) + & + core(4, n)*(ij_matrix%pp_d(2, ipp, 2, 2) + ij_matrix%pp_d(2, ipp, 3, 3)) + + tmp_d(3, m) = dcore(3, n)*drij(3)*ij_matrix%pp(ipp, 1, 1) + & + core(3, n)*ij_matrix%pp_d(3, ipp, 1, 1) + & + dcore(4, n)*drij(3)*(ij_matrix%pp(ipp, 2, 2) + ij_matrix%pp(ipp, 3, 3)) + & + core(4, n)*(ij_matrix%pp_d(3, ipp, 2, 2) + ij_matrix%pp_d(3, ipp, 3, 3)) ELSE ! Type of Integral (PD/) - idp = inddp(ind1-3, ind2) - tmp_d(1, m) = dcore(6, n)*drij(1)*ij_matrix%pd(idp, 1, 1)+ & - core(6, n)*ij_matrix%pd_d(1, idp, 1, 1)+ & - dcore(8, n)*drij(1)*(ij_matrix%pd(idp, 2, 2)+ij_matrix%pd(idp, 3, 3))+ & - core(8, n)*(ij_matrix%pd_d(1, idp, 2, 2)+ij_matrix%pd_d(1, idp, 3, 3)) - - tmp_d(2, m) = dcore(6, n)*drij(2)*ij_matrix%pd(idp, 1, 1)+ & - core(6, n)*ij_matrix%pd_d(2, idp, 1, 1)+ & - dcore(8, n)*drij(2)*(ij_matrix%pd(idp, 2, 2)+ij_matrix%pd(idp, 3, 3))+ & - core(8, n)*(ij_matrix%pd_d(2, idp, 2, 2)+ij_matrix%pd_d(2, idp, 3, 3)) - - tmp_d(3, m) = dcore(6, n)*drij(3)*ij_matrix%pd(idp, 1, 1)+ & - core(6, n)*ij_matrix%pd_d(3, idp, 1, 1)+ & - dcore(8, n)*drij(3)*(ij_matrix%pd(idp, 2, 2)+ij_matrix%pd(idp, 3, 3))+ & - core(8, n)*(ij_matrix%pd_d(3, idp, 2, 2)+ij_matrix%pd_d(3, idp, 3, 3)) + idp = inddp(ind1 - 3, ind2) + tmp_d(1, m) = dcore(6, n)*drij(1)*ij_matrix%pd(idp, 1, 1) + & + core(6, n)*ij_matrix%pd_d(1, idp, 1, 1) + & + dcore(8, n)*drij(1)*(ij_matrix%pd(idp, 2, 2) + ij_matrix%pd(idp, 3, 3)) + & + core(8, n)*(ij_matrix%pd_d(1, idp, 2, 2) + ij_matrix%pd_d(1, idp, 3, 3)) + + tmp_d(2, m) = dcore(6, n)*drij(2)*ij_matrix%pd(idp, 1, 1) + & + core(6, n)*ij_matrix%pd_d(2, idp, 1, 1) + & + dcore(8, n)*drij(2)*(ij_matrix%pd(idp, 2, 2) + ij_matrix%pd(idp, 3, 3)) + & + core(8, n)*(ij_matrix%pd_d(2, idp, 2, 2) + ij_matrix%pd_d(2, idp, 3, 3)) + + tmp_d(3, m) = dcore(6, n)*drij(3)*ij_matrix%pd(idp, 1, 1) + & + core(6, n)*ij_matrix%pd_d(3, idp, 1, 1) + & + dcore(8, n)*drij(3)*(ij_matrix%pd(idp, 2, 2) + ij_matrix%pd(idp, 3, 3)) + & + core(8, n)*(ij_matrix%pd_d(3, idp, 2, 2) + ij_matrix%pd_d(3, idp, 3, 3)) END IF ELSE ! Type of Integral (DD/) - idd = inddd(ind1-3, ind2-3) - tmp_d(1, m) = dcore(7, n)*drij(1)*ij_matrix%dd(idd, 1, 1)+ & - core(7, n)*ij_matrix%dd_d(1, idd, 1, 1)+ & - dcore(9, n)*drij(1)*(ij_matrix%dd(idd, 2, 2)+ij_matrix%dd(idd, 3, 3))+ & - core(9, n)*(ij_matrix%dd_d(1, idd, 2, 2)+ij_matrix%dd_d(1, idd, 3, 3))+ & - dcore(10, n)*drij(1)*(ij_matrix%dd(idd, 4, 4)+ij_matrix%dd(idd, 5, 5))+ & - core(10, n)*(ij_matrix%dd_d(1, idd, 4, 4)+ij_matrix%dd_d(1, idd, 5, 5)) - - tmp_d(2, m) = dcore(7, n)*drij(2)*ij_matrix%dd(idd, 1, 1)+ & - core(7, n)*ij_matrix%dd_d(2, idd, 1, 1)+ & - dcore(9, n)*drij(2)*(ij_matrix%dd(idd, 2, 2)+ij_matrix%dd(idd, 3, 3))+ & - core(9, n)*(ij_matrix%dd_d(2, idd, 2, 2)+ij_matrix%dd_d(2, idd, 3, 3))+ & - dcore(10, n)*drij(2)*(ij_matrix%dd(idd, 4, 4)+ij_matrix%dd(idd, 5, 5))+ & - core(10, n)*(ij_matrix%dd_d(2, idd, 4, 4)+ij_matrix%dd_d(2, idd, 5, 5)) - - tmp_d(3, m) = dcore(7, n)*drij(3)*ij_matrix%dd(idd, 1, 1)+ & - core(7, n)*ij_matrix%dd_d(3, idd, 1, 1)+ & - dcore(9, n)*drij(3)*(ij_matrix%dd(idd, 2, 2)+ij_matrix%dd(idd, 3, 3))+ & - core(9, n)*(ij_matrix%dd_d(3, idd, 2, 2)+ij_matrix%dd_d(3, idd, 3, 3))+ & - dcore(10, n)*drij(3)*(ij_matrix%dd(idd, 4, 4)+ij_matrix%dd(idd, 5, 5))+ & - core(10, n)*(ij_matrix%dd_d(3, idd, 4, 4)+ij_matrix%dd_d(3, idd, 5, 5)) + idd = inddd(ind1 - 3, ind2 - 3) + tmp_d(1, m) = dcore(7, n)*drij(1)*ij_matrix%dd(idd, 1, 1) + & + core(7, n)*ij_matrix%dd_d(1, idd, 1, 1) + & + dcore(9, n)*drij(1)*(ij_matrix%dd(idd, 2, 2) + ij_matrix%dd(idd, 3, 3)) + & + core(9, n)*(ij_matrix%dd_d(1, idd, 2, 2) + ij_matrix%dd_d(1, idd, 3, 3)) + & + dcore(10, n)*drij(1)*(ij_matrix%dd(idd, 4, 4) + ij_matrix%dd(idd, 5, 5)) + & + core(10, n)*(ij_matrix%dd_d(1, idd, 4, 4) + ij_matrix%dd_d(1, idd, 5, 5)) + + tmp_d(2, m) = dcore(7, n)*drij(2)*ij_matrix%dd(idd, 1, 1) + & + core(7, n)*ij_matrix%dd_d(2, idd, 1, 1) + & + dcore(9, n)*drij(2)*(ij_matrix%dd(idd, 2, 2) + ij_matrix%dd(idd, 3, 3)) + & + core(9, n)*(ij_matrix%dd_d(2, idd, 2, 2) + ij_matrix%dd_d(2, idd, 3, 3)) + & + dcore(10, n)*drij(2)*(ij_matrix%dd(idd, 4, 4) + ij_matrix%dd(idd, 5, 5)) + & + core(10, n)*(ij_matrix%dd_d(2, idd, 4, 4) + ij_matrix%dd_d(2, idd, 5, 5)) + + tmp_d(3, m) = dcore(7, n)*drij(3)*ij_matrix%dd(idd, 1, 1) + & + core(7, n)*ij_matrix%dd_d(3, idd, 1, 1) + & + dcore(9, n)*drij(3)*(ij_matrix%dd(idd, 2, 2) + ij_matrix%dd(idd, 3, 3)) + & + core(9, n)*(ij_matrix%dd_d(3, idd, 2, 2) + ij_matrix%dd_d(3, idd, 3, 3)) + & + dcore(10, n)*drij(3)*(ij_matrix%dd(idd, 4, 4) + ij_matrix%dd(idd, 5, 5)) + & + core(10, n)*(ij_matrix%dd_d(3, idd, 4, 4) + ij_matrix%dd_d(3, idd, 5, 5)) END IF END DO END DO @@ -401,27 +401,27 @@ RECURSIVE SUBROUTINE corecore_ana(sepi, sepj, rijv, itype, enuc, denuc, se_int_c IF (itype /= do_method_pm6 .AND. itype /= do_method_pm6fm) THEN alpi = sepi%alp alpj = sepj%alp - scale = EXP(-alpi*rij)+EXP(-alpj*rij) + scale = EXP(-alpi*rij) + EXP(-alpj*rij) IF (l_denuc) THEN - dscale = -alpi*EXP(-alpi*rij)-alpj*EXP(-alpj*rij) + dscale = -alpi*EXP(-alpi*rij) - alpj*EXP(-alpj*rij) END IF - nt = sepi%z+sepj%z + nt = sepi%z + sepj%z IF (nt == 8 .OR. nt == 9) THEN IF (sepi%z == 7 .OR. sepi%z == 8) THEN - scale = scale+(angstrom*rij-1._dp)*EXP(-alpi*rij) + scale = scale + (angstrom*rij - 1._dp)*EXP(-alpi*rij) IF (l_denuc) THEN - dscale = dscale+angstrom*EXP(-alpi*rij)-(angstrom*rij-1._dp)*alpi*EXP(-alpi*rij) + dscale = dscale + angstrom*EXP(-alpi*rij) - (angstrom*rij - 1._dp)*alpi*EXP(-alpi*rij) END IF END IF IF (sepj%z == 7 .OR. sepj%z == 8) THEN - scale = scale+(angstrom*rij-1._dp)*EXP(-alpj*rij) + scale = scale + (angstrom*rij - 1._dp)*EXP(-alpj*rij) IF (l_denuc) THEN - dscale = dscale+angstrom*EXP(-alpj*rij)-(angstrom*rij-1._dp)*alpj*EXP(-alpj*rij) + dscale = dscale + angstrom*EXP(-alpj*rij) - (angstrom*rij - 1._dp)*alpj*EXP(-alpj*rij) END IF END IF ENDIF IF (l_denuc) THEN - dscale = SIGN(1.0_dp, scale*tmp)*(dscale*tmp+scale*dtmp) + dscale = SIGN(1.0_dp, scale*tmp)*(dscale*tmp + scale*dtmp) dzz = -zz/rij**2 END IF scale = ABS(scale*tmp) @@ -506,22 +506,22 @@ RECURSIVE SUBROUTINE corecore_ana(sepi, sepj, rijv, itype, enuc, denuc, se_int_c ! AM1/PM3/PDG correction to nuclear repulsion DO ig = 1, SIZE(fni1) IF (ABS(fni1(ig)) > 0._dp) THEN - ax = fni2(ig)*(rij-fni3(ig))**2 + ax = fni2(ig)*(rij - fni3(ig))**2 IF (ax <= 25._dp) THEN - scale = scale+zz*fni1(ig)*EXP(-ax) + scale = scale + zz*fni1(ig)*EXP(-ax) IF (l_denuc) THEN - dax = fni2(ig)*2.0_dp*(rij-fni3(ig)) - dscale = dscale+dzz*fni1(ig)*EXP(-ax)-dax*zz*fni1(ig)*EXP(-ax) + dax = fni2(ig)*2.0_dp*(rij - fni3(ig)) + dscale = dscale + dzz*fni1(ig)*EXP(-ax) - dax*zz*fni1(ig)*EXP(-ax) END IF ENDIF ENDIF IF (ABS(fnj1(ig)) > 0._dp) THEN - ax = fnj2(ig)*(rij-fnj3(ig))**2 + ax = fnj2(ig)*(rij - fnj3(ig))**2 IF (ax <= 25._dp) THEN - scale = scale+zz*fnj1(ig)*EXP(-ax) + scale = scale + zz*fnj1(ig)*EXP(-ax) IF (l_denuc) THEN - dax = fnj2(ig)*2.0_dp*(rij-fnj3(ig)) - dscale = dscale+dzz*fnj1(ig)*EXP(-ax)-dax*zz*fnj1(ig)*EXP(-ax) + dax = fnj2(ig)*2.0_dp*(rij - fnj3(ig)) + dscale = dscale + dzz*fnj1(ig)*EXP(-ax) - dax*zz*fnj1(ig)*EXP(-ax) END IF ENDIF ENDIF @@ -540,15 +540,15 @@ RECURSIVE SUBROUTINE corecore_ana(sepi, sepj, rijv, itype, enuc, denuc, se_int_c daj = sepj%d(1) dbj = sepj%d(2) apdg = 10._dp*angstrom**2 - qcorr = (zaf*pai+zbf*paj)*EXP(-apdg*(rij-dai-daj)**2)+ & - (zaf*pai+zbf*pbj)*EXP(-apdg*(rij-dai-dbj)**2)+ & - (zaf*pbi+zbf*paj)*EXP(-apdg*(rij-dbi-daj)**2)+ & - (zaf*pbi+zbf*pbj)*EXP(-apdg*(rij-dbi-dbj)**2) + qcorr = (zaf*pai + zbf*paj)*EXP(-apdg*(rij - dai - daj)**2) + & + (zaf*pai + zbf*pbj)*EXP(-apdg*(rij - dai - dbj)**2) + & + (zaf*pbi + zbf*paj)*EXP(-apdg*(rij - dbi - daj)**2) + & + (zaf*pbi + zbf*pbj)*EXP(-apdg*(rij - dbi - dbj)**2) IF (l_denuc) THEN - dqcorr = (zaf*pai+zbf*paj)*EXP(-apdg*(rij-dai-daj)**2)*(-2.0_dp*apdg*(rij-dai-daj))+ & - (zaf*pai+zbf*pbj)*EXP(-apdg*(rij-dai-dbj)**2)*(-2.0_dp*apdg*(rij-dai-dbj))+ & - (zaf*pbi+zbf*paj)*EXP(-apdg*(rij-dbi-daj)**2)*(-2.0_dp*apdg*(rij-dbi-daj))+ & - (zaf*pbi+zbf*pbj)*EXP(-apdg*(rij-dbi-dbj)**2)*(-2.0_dp*apdg*(rij-dbi-dbj)) + dqcorr = (zaf*pai + zbf*paj)*EXP(-apdg*(rij - dai - daj)**2)*(-2.0_dp*apdg*(rij - dai - daj)) + & + (zaf*pai + zbf*pbj)*EXP(-apdg*(rij - dai - dbj)**2)*(-2.0_dp*apdg*(rij - dai - dbj)) + & + (zaf*pbi + zbf*paj)*EXP(-apdg*(rij - dbi - daj)**2)*(-2.0_dp*apdg*(rij - dbi - daj)) + & + (zaf*pbi + zbf*pbj)*EXP(-apdg*(rij - dbi - dbj)**2)*(-2.0_dp*apdg*(rij - dbi - dbj)) END IF ELSEIF (itype == do_method_pchg) THEN qcorr = 0.0_dp @@ -570,44 +570,44 @@ RECURSIVE SUBROUTINE corecore_ana(sepi, sepj, rijv, itype, enuc, denuc, se_int_c IF ((sepi%z == 1 .AND. (sepj%z == 6 .OR. sepj%z == 7 .OR. sepj%z == 8)) .OR. & (sepj%z == 1 .AND. (sepi%z == 6 .OR. sepi%z == 7 .OR. sepi%z == 8))) THEN ! Special Case O-H or N-H or C-H - IF (l_denuc) dscale = dscale*(2._dp*xab*EXP(-aab*rija*rija))- & + IF (l_denuc) dscale = dscale*(2._dp*xab*EXP(-aab*rija*rija)) - & scale*2._dp*xab*EXP(-aab*rija*rija)*(2.0_dp*aab*rija)*drija IF (l_enuc) scale = scale*(2._dp*xab*EXP(-aab*rija*rija)) ELSEIF (sepi%z == 6 .AND. sepj%z == 6) THEN ! Special Case C-C IF (l_denuc) dscale = & - dscale*(2._dp*xab*EXP(-aab*(rija+0.0003_dp*rija**6))+9.28_dp*EXP(-5.98_dp*rija)) & - -scale*2._dp*xab*EXP(-aab*(rija+0.0003_dp*rija**6))*aab*(1.0_dp+6.0_dp*0.0003_dp*rija**5)*drija & - -scale*9.28_dp*EXP(-5.98_dp*rija)*5.98_dp*drija - IF (l_enuc) scale = scale*(2._dp*xab*EXP(-aab*(rija+0.0003_dp*rija**6))+9.28_dp*EXP(-5.98_dp*rija)) + dscale*(2._dp*xab*EXP(-aab*(rija + 0.0003_dp*rija**6)) + 9.28_dp*EXP(-5.98_dp*rija)) & + - scale*2._dp*xab*EXP(-aab*(rija + 0.0003_dp*rija**6))*aab*(1.0_dp + 6.0_dp*0.0003_dp*rija**5)*drija & + - scale*9.28_dp*EXP(-5.98_dp*rija)*5.98_dp*drija + IF (l_enuc) scale = scale*(2._dp*xab*EXP(-aab*(rija + 0.0003_dp*rija**6)) + 9.28_dp*EXP(-5.98_dp*rija)) ELSEIF ((sepi%z == 8 .AND. sepj%z == 14) .OR. & (sepj%z == 8 .AND. sepi%z == 14)) THEN ! Special Case Si-O IF (l_denuc) dscale = & - dscale*(2._dp*xab*EXP(-aab*(rija+0.0003_dp*rija**6))-0.0007_dp*EXP(-(rija-2.9_dp)**2)) & - -scale*2._dp*xab*EXP(-aab*(rija+0.0003_dp*rija**6))*aab*(1.0_dp+6.0_dp*0.0003_dp*rija**5)*drija+ & - scale*0.0007_dp*EXP(-(rija-2.9_dp)**2)*(2.0_dp*(rija-2.9_dp)*drija) - IF (l_enuc) scale = scale*(2._dp*xab*EXP(-aab*(rija+0.0003_dp*rija**6))-0.0007_dp*EXP(-(rija-2.9_dp)**2)) + dscale*(2._dp*xab*EXP(-aab*(rija + 0.0003_dp*rija**6)) - 0.0007_dp*EXP(-(rija - 2.9_dp)**2)) & + - scale*2._dp*xab*EXP(-aab*(rija + 0.0003_dp*rija**6))*aab*(1.0_dp + 6.0_dp*0.0003_dp*rija**5)*drija + & + scale*0.0007_dp*EXP(-(rija - 2.9_dp)**2)*(2.0_dp*(rija - 2.9_dp)*drija) + IF (l_enuc) scale = scale*(2._dp*xab*EXP(-aab*(rija + 0.0003_dp*rija**6)) - 0.0007_dp*EXP(-(rija - 2.9_dp)**2)) ELSE ! General Case ! Factor of 2 found by experiment - IF (l_denuc) dscale = dscale*(2._dp*xab*EXP(-aab*(rija+0.0003_dp*rija**6))) & - -scale*2._dp*xab*EXP(-aab*(rija+0.0003_dp*rija**6))*aab*(1.0_dp+6.0_dp*0.0003_dp*rija**5)*drija - IF (l_enuc) scale = scale*(2._dp*xab*EXP(-aab*(rija+0.0003_dp*rija**6))) + IF (l_denuc) dscale = dscale*(2._dp*xab*EXP(-aab*(rija + 0.0003_dp*rija**6))) & + - scale*2._dp*xab*EXP(-aab*(rija + 0.0003_dp*rija**6))*aab*(1.0_dp + 6.0_dp*0.0003_dp*rija**5)*drija + IF (l_enuc) scale = scale*(2._dp*xab*EXP(-aab*(rija + 0.0003_dp*rija**6))) END IF ! General correction term a*exp(-b*(rij-c)^2) - xtmp = 1.e-8_dp/evolt*((REAL(sepi%z, dp)**(1._dp/3._dp)+REAL(sepj%z, dp)**(1._dp/3._dp))/rija)**12 + xtmp = 1.e-8_dp/evolt*((REAL(sepi%z, dp)**(1._dp/3._dp) + REAL(sepj%z, dp)**(1._dp/3._dp))/rija)**12 IF (l_enuc) THEN - qcorr = (sepi%a*EXP(-sepi%b*(rij-sepi%c)**2))*zz/rij+ & - (sepj%a*EXP(-sepj%b*(rij-sepj%c)**2))*zz/rij+ & + qcorr = (sepi%a*EXP(-sepi%b*(rij - sepi%c)**2))*zz/rij + & + (sepj%a*EXP(-sepj%b*(rij - sepj%c)**2))*zz/rij + & ! Hard core repulsion xtmp END IF IF (l_denuc) THEN - dqcorr = (sepi%a*EXP(-sepi%b*(rij-sepi%c)**2)*(-2.0_dp*sepi%b*(rij-sepi%c)))*zz/rij- & - (sepi%a*EXP(-sepi%b*(rij-sepi%c)**2))*zz/rij**2+ & - (sepj%a*EXP(-sepj%b*(rij-sepj%c)**2)*(-2.0_dp*sepj%b*(rij-sepj%c)))*zz/rij- & - (sepj%a*EXP(-sepj%b*(rij-sepj%c)**2))*zz/rij**2+ & + dqcorr = (sepi%a*EXP(-sepi%b*(rij - sepi%c)**2)*(-2.0_dp*sepi%b*(rij - sepi%c)))*zz/rij - & + (sepi%a*EXP(-sepi%b*(rij - sepi%c)**2))*zz/rij**2 + & + (sepj%a*EXP(-sepj%b*(rij - sepj%c)**2)*(-2.0_dp*sepj%b*(rij - sepj%c)))*zz/rij - & + (sepj%a*EXP(-sepj%b*(rij - sepj%c)**2))*zz/rij**2 + & ! Hard core repulsion (-12.0_dp*xtmp/rija*drija) END IF @@ -616,13 +616,13 @@ RECURSIVE SUBROUTINE corecore_ana(sepi, sepj, rijv, itype, enuc, denuc, se_int_c ! Only at the very end let's sum-up the several contributions energy/derivatives ! This assignment should be method indipendent IF (l_enuc) THEN - enuc = enuc_loc+scale+qcorr + enuc = enuc_loc + scale + qcorr END IF IF (l_denuc) THEN drij(1) = rijv(1)/rij drij(2) = rijv(2)/rij drij(3) = rijv(3)/rij - denuc = (denuc_loc+dscale+dqcorr)*drij + denuc = (denuc_loc + dscale + dqcorr)*drij END IF ! Debug statement IF (debug_this_module) THEN @@ -740,7 +740,7 @@ SUBROUTINE invert_integral(sepi, sepj, int1el, int2el) END DO DO i = 1, sepi%natorb DO j = 1, i - ndim = ndim+1 + ndim = ndim + 1 ! Get the integral in the original frame (along z) DO ind = 1, 2 @@ -753,7 +753,7 @@ SUBROUTINE invert_integral(sepi, sepj, int1el, int2el) jfac = fac_x_to_z(jnd, j) gind = indexb(imap, jmap) - tmp1el(ndim) = tmp1el(ndim)+ifac*jfac*int1el(gind) + tmp1el(ndim) = tmp1el(ndim) + ifac*jfac*int1el(gind) END DO END DO END DO @@ -776,7 +776,7 @@ SUBROUTINE invert_integral(sepi, sepj, int1el, int2el) DO j = 1, i DO k = 1, sepj%natorb DO l = 1, k - ndim = ndim+1 + ndim = ndim + 1 ! Get the integral in the original frame (along z) DO ind = 1, 2 @@ -800,8 +800,8 @@ SUBROUTINE invert_integral(sepi, sepj, int1el, int2el) lfac = fac_x_to_z(lnd, l) gknd = indexb(kmap, lmap) - tind = (gind-1)*tdim+gknd - tmp2el(ndim) = tmp2el(ndim)+ifac*jfac*lfac*kfac*int2el(tind) + tind = (gind - 1)*tdim + gknd + tmp2el(ndim) = tmp2el(ndim) + ifac*jfac*lfac*kfac*int2el(tind) END DO END DO @@ -936,7 +936,7 @@ SUBROUTINE dssss_nucint_ana(sepi, sepj, rij, ssss, dssss, itype, se_taper, se_in ! Tapering the value of the integrals IF (lgrad) THEN - dssss = ft*dssss+dft*ssss + dssss = ft*dssss + dft*ssss END IF ssss = ft*ssss @@ -1034,10 +1034,10 @@ SUBROUTINE dcore_nucint_ana(sepi, sepj, rij, core, dcore, itype, se_taper, & ! Tapering the value of the integrals IF (lgrad) THEN DO i = 1, sepi%core_size - dcore(i, 1) = ft*dcore(i, 1)+dft*core(i, 1) + dcore(i, 1) = ft*dcore(i, 1) + dft*core(i, 1) END DO DO i = 1, sepj%core_size - dcore(i, 2) = ft*dcore(i, 2)+dft*core(i, 2) + dcore(i, 2) = ft*dcore(i, 2) + dft*core(i, 2) END DO END IF DO i = 1, sepi%core_size @@ -1336,27 +1336,27 @@ RECURSIVE SUBROUTINE rotint_ana(sepi, sepj, rijv, w, dw, se_int_control, se_tape ! (SS/) i = 1 j = 1 - iw_loc = (indexb(i, j)-1)*limkl+kl + iw_loc = (indexb(i, j) - 1)*limkl + kl ww(iw_loc) = wrepp CASE (2) ! (SP/) j = 1 DO i = 1, 3 - iw_loc = (indexb(i+1, j)-1)*limkl+kl - ww(iw_loc) = ww(iw_loc)+ij_matrix%sp(i1-1, i)*wrepp + iw_loc = (indexb(i + 1, j) - 1)*limkl + kl + ww(iw_loc) = ww(iw_loc) + ij_matrix%sp(i1 - 1, i)*wrepp END DO CASE (3) ! (PP/) DO i = 1, 3 - cc = ij_matrix%pp(i, i1-1, j1-1) - iw_loc = (indexb(i+1, i+1)-1)*limkl+kl - ww(iw_loc) = ww(iw_loc)+cc*wrepp - iminus = i-1 + cc = ij_matrix%pp(i, i1 - 1, j1 - 1) + iw_loc = (indexb(i + 1, i + 1) - 1)*limkl + kl + ww(iw_loc) = ww(iw_loc) + cc*wrepp + iminus = i - 1 IF (iminus /= 0) THEN DO j = 1, iminus - cc = ij_matrix%pp(1+i+j, i1-1, j1-1) - iw_loc = (indexb(i+1, j+1)-1)*limkl+kl - ww(iw_loc) = ww(iw_loc)+cc*wrepp + cc = ij_matrix%pp(1 + i + j, i1 - 1, j1 - 1) + iw_loc = (indexb(i + 1, j + 1) - 1)*limkl + kl + ww(iw_loc) = ww(iw_loc) + cc*wrepp END DO END IF END DO @@ -1364,31 +1364,31 @@ RECURSIVE SUBROUTINE rotint_ana(sepi, sepj, rijv, w, dw, se_int_control, se_tape ! (SD/) j = 1 DO i = 1, 5 - iw_loc = (indexb(i+4, j)-1)*limkl+kl - ww(iw_loc) = ww(iw_loc)+ij_matrix%sd(i1-4, i)*wrepp + iw_loc = (indexb(i + 4, j) - 1)*limkl + kl + ww(iw_loc) = ww(iw_loc) + ij_matrix%sd(i1 - 4, i)*wrepp END DO CASE (5) ! (DP/) DO i = 1, 5 DO j = 1, 3 - iw_loc = (indexb(i+4, j+1)-1)*limkl+kl - ij1 = 3*(i-1)+j - ww(iw_loc) = ww(iw_loc)+ij_matrix%pd(ij1, i1-4, j1-1)*wrepp + iw_loc = (indexb(i + 4, j + 1) - 1)*limkl + kl + ij1 = 3*(i - 1) + j + ww(iw_loc) = ww(iw_loc) + ij_matrix%pd(ij1, i1 - 4, j1 - 1)*wrepp END DO END DO CASE (6) ! (DD/) DO i = 1, 5 - cc = ij_matrix%dd(i, i1-4, j1-4) - iw_loc = (indexb(i+4, i+4)-1)*limkl+kl - ww(iw_loc) = ww(iw_loc)+cc*wrepp - iminus = i-1 + cc = ij_matrix%dd(i, i1 - 4, j1 - 4) + iw_loc = (indexb(i + 4, i + 4) - 1)*limkl + kl + ww(iw_loc) = ww(iw_loc) + cc*wrepp + iminus = i - 1 IF (iminus /= 0) THEN DO j = 1, iminus ij1 = inddd(i, j) - cc = ij_matrix%dd(ij1, i1-4, j1-4) - iw_loc = (indexb(i+4, j+4)-1)*limkl+kl - ww(iw_loc) = ww(iw_loc)+cc*wrepp + cc = ij_matrix%dd(ij1, i1 - 4, j1 - 4) + iw_loc = (indexb(i + 4, j + 4) - 1)*limkl + kl + ww(iw_loc) = ww(iw_loc) + cc*wrepp END DO END IF END DO @@ -1441,7 +1441,7 @@ RECURSIVE SUBROUTINE rotint_ana(sepi, sepj, rijv, w, dw, se_int_control, se_tape ! (SS/) i = 1 j = 1 - iw_loc = (indexb(i, j)-1)*limkl+kl + iw_loc = (indexb(i, j) - 1)*limkl + kl ww_d(1, iw_loc) = wrepp_d(1) ww_d(2, iw_loc) = wrepp_d(2) ww_d(3, iw_loc) = wrepp_d(3) @@ -1449,38 +1449,38 @@ RECURSIVE SUBROUTINE rotint_ana(sepi, sepj, rijv, w, dw, se_int_control, se_tape ! (SP/) j = 1 DO i = 1, 3 - iw_loc = (indexb(i+1, j)-1)*limkl+kl - ww_d(1, iw_loc) = ww_d(1, iw_loc)+ij_matrix%sp_d(1, i1-1, i)*wrepp+ & - ij_matrix%sp(i1-1, i)*wrepp_d(1) + iw_loc = (indexb(i + 1, j) - 1)*limkl + kl + ww_d(1, iw_loc) = ww_d(1, iw_loc) + ij_matrix%sp_d(1, i1 - 1, i)*wrepp + & + ij_matrix%sp(i1 - 1, i)*wrepp_d(1) - ww_d(2, iw_loc) = ww_d(2, iw_loc)+ij_matrix%sp_d(2, i1-1, i)*wrepp+ & - ij_matrix%sp(i1-1, i)*wrepp_d(2) + ww_d(2, iw_loc) = ww_d(2, iw_loc) + ij_matrix%sp_d(2, i1 - 1, i)*wrepp + & + ij_matrix%sp(i1 - 1, i)*wrepp_d(2) - ww_d(3, iw_loc) = ww_d(3, iw_loc)+ij_matrix%sp_d(3, i1-1, i)*wrepp+ & - ij_matrix%sp(i1-1, i)*wrepp_d(3) + ww_d(3, iw_loc) = ww_d(3, iw_loc) + ij_matrix%sp_d(3, i1 - 1, i)*wrepp + & + ij_matrix%sp(i1 - 1, i)*wrepp_d(3) END DO CASE (3) ! (PP/) DO i = 1, 3 - cc = ij_matrix%pp(i, i1-1, j1-1) - cc_d(1) = ij_matrix%pp_d(1, i, i1-1, j1-1) - cc_d(2) = ij_matrix%pp_d(2, i, i1-1, j1-1) - cc_d(3) = ij_matrix%pp_d(3, i, i1-1, j1-1) - iw_loc = (indexb(i+1, i+1)-1)*limkl+kl - ww_d(1, iw_loc) = ww_d(1, iw_loc)+cc_d(1)*wrepp+cc*wrepp_d(1) - ww_d(2, iw_loc) = ww_d(2, iw_loc)+cc_d(2)*wrepp+cc*wrepp_d(2) - ww_d(3, iw_loc) = ww_d(3, iw_loc)+cc_d(3)*wrepp+cc*wrepp_d(3) - iminus = i-1 + cc = ij_matrix%pp(i, i1 - 1, j1 - 1) + cc_d(1) = ij_matrix%pp_d(1, i, i1 - 1, j1 - 1) + cc_d(2) = ij_matrix%pp_d(2, i, i1 - 1, j1 - 1) + cc_d(3) = ij_matrix%pp_d(3, i, i1 - 1, j1 - 1) + iw_loc = (indexb(i + 1, i + 1) - 1)*limkl + kl + ww_d(1, iw_loc) = ww_d(1, iw_loc) + cc_d(1)*wrepp + cc*wrepp_d(1) + ww_d(2, iw_loc) = ww_d(2, iw_loc) + cc_d(2)*wrepp + cc*wrepp_d(2) + ww_d(3, iw_loc) = ww_d(3, iw_loc) + cc_d(3)*wrepp + cc*wrepp_d(3) + iminus = i - 1 IF (iminus /= 0) THEN DO j = 1, iminus - cc = ij_matrix%pp(1+i+j, i1-1, j1-1) - cc_d(1) = ij_matrix%pp_d(1, 1+i+j, i1-1, j1-1) - cc_d(2) = ij_matrix%pp_d(2, 1+i+j, i1-1, j1-1) - cc_d(3) = ij_matrix%pp_d(3, 1+i+j, i1-1, j1-1) - iw_loc = (indexb(i+1, j+1)-1)*limkl+kl - ww_d(1, iw_loc) = ww_d(1, iw_loc)+cc_d(1)*wrepp+cc*wrepp_d(1) - ww_d(2, iw_loc) = ww_d(2, iw_loc)+cc_d(2)*wrepp+cc*wrepp_d(2) - ww_d(3, iw_loc) = ww_d(3, iw_loc)+cc_d(3)*wrepp+cc*wrepp_d(3) + cc = ij_matrix%pp(1 + i + j, i1 - 1, j1 - 1) + cc_d(1) = ij_matrix%pp_d(1, 1 + i + j, i1 - 1, j1 - 1) + cc_d(2) = ij_matrix%pp_d(2, 1 + i + j, i1 - 1, j1 - 1) + cc_d(3) = ij_matrix%pp_d(3, 1 + i + j, i1 - 1, j1 - 1) + iw_loc = (indexb(i + 1, j + 1) - 1)*limkl + kl + ww_d(1, iw_loc) = ww_d(1, iw_loc) + cc_d(1)*wrepp + cc*wrepp_d(1) + ww_d(2, iw_loc) = ww_d(2, iw_loc) + cc_d(2)*wrepp + cc*wrepp_d(2) + ww_d(3, iw_loc) = ww_d(3, iw_loc) + cc_d(3)*wrepp + cc*wrepp_d(3) END DO END IF END DO @@ -1488,53 +1488,53 @@ RECURSIVE SUBROUTINE rotint_ana(sepi, sepj, rijv, w, dw, se_int_control, se_tape ! (SD/) j = 1 DO i = 1, 5 - iw_loc = (indexb(i+4, j)-1)*limkl+kl - ww_d(1, iw_loc) = ww_d(1, iw_loc)+ij_matrix%sd_d(1, i1-4, i)*wrepp+ & - ij_matrix%sd(i1-4, i)*wrepp_d(1) + iw_loc = (indexb(i + 4, j) - 1)*limkl + kl + ww_d(1, iw_loc) = ww_d(1, iw_loc) + ij_matrix%sd_d(1, i1 - 4, i)*wrepp + & + ij_matrix%sd(i1 - 4, i)*wrepp_d(1) - ww_d(2, iw_loc) = ww_d(2, iw_loc)+ij_matrix%sd_d(2, i1-4, i)*wrepp+ & - ij_matrix%sd(i1-4, i)*wrepp_d(2) + ww_d(2, iw_loc) = ww_d(2, iw_loc) + ij_matrix%sd_d(2, i1 - 4, i)*wrepp + & + ij_matrix%sd(i1 - 4, i)*wrepp_d(2) - ww_d(3, iw_loc) = ww_d(3, iw_loc)+ij_matrix%sd_d(3, i1-4, i)*wrepp+ & - ij_matrix%sd(i1-4, i)*wrepp_d(3) + ww_d(3, iw_loc) = ww_d(3, iw_loc) + ij_matrix%sd_d(3, i1 - 4, i)*wrepp + & + ij_matrix%sd(i1 - 4, i)*wrepp_d(3) END DO CASE (5) ! (DP/) DO i = 1, 5 DO j = 1, 3 - iw_loc = (indexb(i+4, j+1)-1)*limkl+kl - ij1 = 3*(i-1)+j - ww_d(1, iw_loc) = ww_d(1, iw_loc)+ij_matrix%pd_d(1, ij1, i1-4, j1-1)*wrepp+ & - ij_matrix%pd(ij1, i1-4, j1-1)*wrepp_d(1) + iw_loc = (indexb(i + 4, j + 1) - 1)*limkl + kl + ij1 = 3*(i - 1) + j + ww_d(1, iw_loc) = ww_d(1, iw_loc) + ij_matrix%pd_d(1, ij1, i1 - 4, j1 - 1)*wrepp + & + ij_matrix%pd(ij1, i1 - 4, j1 - 1)*wrepp_d(1) - ww_d(2, iw_loc) = ww_d(2, iw_loc)+ij_matrix%pd_d(2, ij1, i1-4, j1-1)*wrepp+ & - ij_matrix%pd(ij1, i1-4, j1-1)*wrepp_d(2) + ww_d(2, iw_loc) = ww_d(2, iw_loc) + ij_matrix%pd_d(2, ij1, i1 - 4, j1 - 1)*wrepp + & + ij_matrix%pd(ij1, i1 - 4, j1 - 1)*wrepp_d(2) - ww_d(3, iw_loc) = ww_d(3, iw_loc)+ij_matrix%pd_d(3, ij1, i1-4, j1-1)*wrepp+ & - ij_matrix%pd(ij1, i1-4, j1-1)*wrepp_d(3) + ww_d(3, iw_loc) = ww_d(3, iw_loc) + ij_matrix%pd_d(3, ij1, i1 - 4, j1 - 1)*wrepp + & + ij_matrix%pd(ij1, i1 - 4, j1 - 1)*wrepp_d(3) END DO END DO CASE (6) ! (DD/) DO i = 1, 5 - cc = ij_matrix%dd(i, i1-4, j1-4) - cc_d = ij_matrix%dd_d(:, i, i1-4, j1-4) - iw_loc = (indexb(i+4, i+4)-1)*limkl+kl - ww_d(1, iw_loc) = ww_d(1, iw_loc)+cc_d(1)*wrepp+cc*wrepp_d(1) - ww_d(2, iw_loc) = ww_d(2, iw_loc)+cc_d(2)*wrepp+cc*wrepp_d(2) - ww_d(3, iw_loc) = ww_d(3, iw_loc)+cc_d(3)*wrepp+cc*wrepp_d(3) - iminus = i-1 + cc = ij_matrix%dd(i, i1 - 4, j1 - 4) + cc_d = ij_matrix%dd_d(:, i, i1 - 4, j1 - 4) + iw_loc = (indexb(i + 4, i + 4) - 1)*limkl + kl + ww_d(1, iw_loc) = ww_d(1, iw_loc) + cc_d(1)*wrepp + cc*wrepp_d(1) + ww_d(2, iw_loc) = ww_d(2, iw_loc) + cc_d(2)*wrepp + cc*wrepp_d(2) + ww_d(3, iw_loc) = ww_d(3, iw_loc) + cc_d(3)*wrepp + cc*wrepp_d(3) + iminus = i - 1 IF (iminus /= 0) THEN DO j = 1, iminus ij1 = inddd(i, j) - cc = ij_matrix%dd(ij1, i1-4, j1-4) - cc_d(1) = ij_matrix%dd_d(1, ij1, i1-4, j1-4) - cc_d(2) = ij_matrix%dd_d(2, ij1, i1-4, j1-4) - cc_d(3) = ij_matrix%dd_d(3, ij1, i1-4, j1-4) - iw_loc = (indexb(i+4, j+4)-1)*limkl+kl - ww_d(1, iw_loc) = ww_d(1, iw_loc)+cc_d(1)*wrepp+cc*wrepp_d(1) - ww_d(2, iw_loc) = ww_d(2, iw_loc)+cc_d(2)*wrepp+cc*wrepp_d(2) - ww_d(3, iw_loc) = ww_d(3, iw_loc)+cc_d(3)*wrepp+cc*wrepp_d(3) + cc = ij_matrix%dd(ij1, i1 - 4, j1 - 4) + cc_d(1) = ij_matrix%dd_d(1, ij1, i1 - 4, j1 - 4) + cc_d(2) = ij_matrix%dd_d(2, ij1, i1 - 4, j1 - 4) + cc_d(3) = ij_matrix%dd_d(3, ij1, i1 - 4, j1 - 4) + iw_loc = (indexb(i + 4, j + 4) - 1)*limkl + kl + ww_d(1, iw_loc) = ww_d(1, iw_loc) + cc_d(1)*wrepp + cc*wrepp_d(1) + ww_d(2, iw_loc) = ww_d(2, iw_loc) + cc_d(2)*wrepp + cc*wrepp_d(2) + ww_d(3, iw_loc) = ww_d(3, iw_loc) + cc_d(3)*wrepp + cc*wrepp_d(3) END DO END IF END DO @@ -1720,7 +1720,7 @@ SUBROUTINE dterep_sp_ana(sepi, sepj, rij, drep, rep, se_int_control, & ELSE IF (nold == 0) THEN tmp = d_ijkl_sp(sepi, sepj, ij, kl, li, lj, lk, ll, 0, rij, & se_int_control, se_int_screen, do_method_undef) - drep(numb) = dft*rep(numb)+ft*tmp + drep(numb) = dft*rep(numb) + ft*tmp END IF END IF END DO @@ -1785,7 +1785,7 @@ SUBROUTINE dterep_d_ana(sepi, sepj, rij, drep, rep, se_int_control, & ELSE IF (nold == 0) THEN tmp = d_ijkl_d(sepi, sepj, ij, kl, li, lj, lk, ll, 0, rij, & se_int_control, se_int_screen, do_method_undef) - drep(numb) = dft*rep(numb)+ft*tmp + drep(numb) = dft*rep(numb) + ft*tmp END IF END IF END DO diff --git a/src/semi_empirical_int_arrays.F b/src/semi_empirical_int_arrays.F index 29e2dc7089..6417dda7bb 100644 --- a/src/semi_empirical_int_arrays.F +++ b/src/semi_empirical_int_arrays.F @@ -174,7 +174,7 @@ SUBROUTINE setup_index_array() ! dzy 7 15 22 28 33 37 40 41 42 ! dx2-y2 8 16 23 29 34 38 41 43 44 ! dxy 9 17 24 30 35 39 42 44 45 - indexa(i, j) = (9*(j-1))-(j*(j-1))/2+i + indexa(i, j) = (9*(j - 1)) - (j*(j - 1))/2 + i indexa(j, i) = indexa(i, j) ! indexb: ! s pz px py dz2 dzx dzy dx2-y2 dxy @@ -187,7 +187,7 @@ SUBROUTINE setup_index_array() ! dzy 22 23 24 25 26 27 28 35 43 ! dx2-y2 29 30 31 32 33 34 35 36 44 ! dxy 37 38 39 40 41 42 43 44 45 - indexb(i, j) = (i*(i-1))/2+j + indexb(i, j) = (i*(i - 1))/2 + j indexb(j, i) = indexb(i, j) END DO END DO diff --git a/src/semi_empirical_int_debug.F b/src/semi_empirical_int_debug.F index 7cf5fa71c5..b8c9bf8d17 100644 --- a/src/semi_empirical_int_debug.F +++ b/src/semi_empirical_int_debug.F @@ -19,10 +19,10 @@ SUBROUTINE check_rotmat_der(sepi, sepj, rjiv, ij_matrix, do_invert) USE kinds, ONLY: dp USE semi_empirical_int_utils, ONLY: rotmat USE semi_empirical_types, ONLY: rotmat_create, & - rotmat_release, & - rotmat_type, & - semi_empirical_type, & - se_int_control_type + rotmat_release, & + rotmat_type, & + semi_empirical_type, & + se_int_control_type #include "./base/base_uses.f90" IMPLICIT NONE TYPE(semi_empirical_type), POINTER :: sepi, sepj @@ -60,12 +60,12 @@ SUBROUTINE check_rotmat_der(sepi, sepj, rjiv, ij_matrix, do_invert) DO i = 1, 2 IF (i == 1) matrix => matrix_p IF (i == 2) matrix => matrix_m - r0 = rjiv+(-1.0_dp)**(i-1)*x + r0 = rjiv + (-1.0_dp)**(i - 1)*x r = SQRT(DOT_PRODUCT(r0, r0)) CALL rotmat(sepi, sepj, r0, r, matrix, do_derivatives=.FALSE., debug_invert=do_invert) END DO ! SP - matrix_n%sp_d(j, :, :) = (matrix_p%sp-matrix_m%sp)/(2.0_dp*dx) + matrix_n%sp_d(j, :, :) = (matrix_p%sp - matrix_m%sp)/(2.0_dp*dx) DO i = 1, 3 DO k = 1, 3 IF (.NOT. check_value(matrix_n%sp_d(j, k, i), ij_matrix%sp_d(j, k, i), dx, 0.1_dp)) THEN @@ -75,7 +75,7 @@ SUBROUTINE check_rotmat_der(sepi, sepj, rjiv, ij_matrix, do_invert) END DO END DO ! PP - matrix_n%pp_d(j, :, :, :) = (matrix_p%pp-matrix_m%pp)/(2.0_dp*dx) + matrix_n%pp_d(j, :, :, :) = (matrix_p%pp - matrix_m%pp)/(2.0_dp*dx) DO i = 1, 3 DO k = 1, 3 DO l = 1, 6 @@ -89,7 +89,7 @@ SUBROUTINE check_rotmat_der(sepi, sepj, rjiv, ij_matrix, do_invert) ! d-orbitals debug IF (sepi%dorb .OR. sepj%dorb) THEN ! SD - matrix_n%sd_d(j, :, :) = (matrix_p%sd-matrix_m%sd)/(2.0_dp*dx) + matrix_n%sd_d(j, :, :) = (matrix_p%sd - matrix_m%sd)/(2.0_dp*dx) DO i = 1, 5 DO k = 1, 5 IF (.NOT. check_value(matrix_n%sd_d(j, k, i), ij_matrix%sd_d(j, k, i), dx, 0.1_dp)) THEN @@ -99,7 +99,7 @@ SUBROUTINE check_rotmat_der(sepi, sepj, rjiv, ij_matrix, do_invert) END DO END DO ! DP - matrix_n%pd_d(j, :, :, :) = (matrix_p%pd-matrix_m%pd)/(2.0_dp*dx) + matrix_n%pd_d(j, :, :, :) = (matrix_p%pd - matrix_m%pd)/(2.0_dp*dx) DO i = 1, 3 DO k = 1, 5 DO l = 1, 15 @@ -111,7 +111,7 @@ SUBROUTINE check_rotmat_der(sepi, sepj, rjiv, ij_matrix, do_invert) END DO END DO ! DD - matrix_n%dd_d(j, :, :, :) = (matrix_p%dd-matrix_m%dd)/(2.0_dp*dx) + matrix_n%dd_d(j, :, :, :) = (matrix_p%dd - matrix_m%dd)/(2.0_dp*dx) DO i = 1, 5 DO k = 1, 5 DO l = 1, 15 @@ -153,11 +153,11 @@ SUBROUTINE rot_2el_2c_first_debug(sepi, sepj, rijv, se_int_control, se_taper, in USE semi_empirical_int_arrays, ONLY: indexb USE semi_empirical_int_num, ONLY: terep_num USE semi_empirical_types, ONLY: semi_empirical_type, & - rotmat_type, & - rotmat_create, & - rotmat_release, & - se_int_control_type, & - se_taper_type + rotmat_type, & + rotmat_create, & + rotmat_release, & + se_int_control_type, & + se_taper_type USE semi_empirical_int_utils, ONLY: rot_2el_2c_first #include "./base/base_uses.f90" IMPLICIT NONE @@ -199,7 +199,7 @@ SUBROUTINE rot_2el_2c_first_debug(sepi, sepj, rijv, se_int_control, se_taper, in x = 0.0_dp x(imap(j)) = dx DO i = 1, 2 - r0 = rijv+(-1.0_dp)**(i-1)*x + r0 = rijv + (-1.0_dp)**(i - 1)*x r = SQRT(DOT_PRODUCT(r0, r0)) CALL rotmat_create(matrix) @@ -222,7 +222,7 @@ SUBROUTINE rot_2el_2c_first_debug(sepi, sepj, rijv, se_int_control, se_taper, in DO i = 1, 45 DO k = 1, limkl ! Compute the numerical derivative - v_n(i, k) = (v_p(i, k)-v_m(i, k))/(2.0_dp*dx) + v_n(i, k) = (v_p(i, k) - v_m(i, k))/(2.0_dp*dx) IF (.NOT. check_value(v_d(j, i, k), v_n(i, k), dx, 0.1_dp)) THEN WRITE (*, *) "ERROR for rot_2el_2c_first derivative V_D(j,i,k), j,i,k::", j, i, k CPABORT("") @@ -252,8 +252,8 @@ SUBROUTINE check_dssss_nucint_ana(sepi, sepj, r, dssss, itype, se_int_control, s USE kinds, ONLY: dp USE semi_empirical_int_num, ONLY: ssss_nucint_num USE semi_empirical_types, ONLY: semi_empirical_type, & - se_int_control_type, & - se_taper_type + se_int_control_type, & + se_taper_type #include "./base/base_uses.f90" IMPLICIT NONE TYPE(semi_empirical_type), POINTER :: sepi, sepj @@ -271,11 +271,11 @@ SUBROUTINE check_dssss_nucint_ana(sepi, sepj, r, dssss, itype, se_int_control, s delta = 1.0E-8_dp od = 0.5_dp/delta - rn = r+delta + rn = r + delta CALL ssss_nucint_num(sepi, sepj, rn, ssssp, itype, se_taper, se_int_control) - rn = r-delta + rn = r - delta CALL ssss_nucint_num(sepi, sepj, rn, ssssm, itype, se_taper, se_int_control) - nssss = od*(ssssp-ssssm) + nssss = od*(ssssp - ssssm) ! check WRITE (*, *) "DEBUG::"//routineP IF (.NOT. check_value(nssss, dssss, delta, 0.1_dp)) THEN @@ -304,8 +304,8 @@ SUBROUTINE check_dcore_nucint_ana(sepi, sepj, r, dcore, itype, se_int_control, s USE kinds, ONLY: dp USE semi_empirical_int_num, ONLY: core_nucint_num USE semi_empirical_types, ONLY: semi_empirical_type, & - se_int_control_type, & - se_taper_type + se_int_control_type, & + se_taper_type #include "./base/base_uses.f90" IMPLICIT NONE TYPE(semi_empirical_type), POINTER :: sepi, sepj @@ -325,11 +325,11 @@ SUBROUTINE check_dcore_nucint_ana(sepi, sepj, r, dcore, itype, se_int_control, s delta = 1.0E-8_dp od = 0.5_dp/delta - rn = r+delta + rn = r + delta CALL core_nucint_num(sepi, sepj, rn, corep, itype, se_taper, se_int_control) - rn = r-delta + rn = r - delta CALL core_nucint_num(sepi, sepj, rn, corem, itype, se_taper, se_int_control) - ncore = od*(corep-corem) + ncore = od*(corep - corem) ! check WRITE (*, *) "DEBUG::"//routineP DO i = 1, 2 @@ -371,8 +371,8 @@ FUNCTION check_value(num, ana, minval, thrs) RESULT(passed) ! skip.. RETURN END IF - IF (ABS((num-ana)/num*100._dp) > thrs) THEN - WRITE (*, *) ABS(num-ana)/num*100._dp, thrs + IF (ABS((num - ana)/num*100._dp) > thrs) THEN + WRITE (*, *) ABS(num - ana)/num*100._dp, thrs passed = .FALSE. END IF IF (.NOT. passed) THEN @@ -403,10 +403,10 @@ SUBROUTINE check_drotnuc_ana(sepi, sepj, rijv, itype, se_int_control, se_taper, USE kinds, ONLY: dp USE semi_empirical_int_num, ONLY: rotnuc_num, & - drotnuc_num + drotnuc_num USE semi_empirical_types, ONLY: semi_empirical_type, & - se_int_control_type, & - se_taper_type + se_int_control_type, & + se_taper_type #include "./base/base_uses.f90" IMPLICIT NONE TYPE(semi_empirical_type), POINTER :: sepi, sepj @@ -508,10 +508,10 @@ SUBROUTINE check_dcorecore_ana(sepi, sepj, rijv, itype, se_int_control, se_taper USE kinds, ONLY: dp USE semi_empirical_int_num, ONLY: corecore_num, & - dcorecore_num + dcorecore_num USE semi_empirical_types, ONLY: semi_empirical_type, & - se_int_control_type, & - se_taper_type + se_int_control_type, & + se_taper_type #include "./base/base_uses.f90" IMPLICIT NONE TYPE(semi_empirical_type), POINTER :: sepi, sepj @@ -573,8 +573,8 @@ SUBROUTINE check_dterep_ana(sepi, sepj, r, ri, dri, se_int_control, se_taper, lg USE kinds, ONLY: dp USE semi_empirical_int_num, ONLY: terep_num USE semi_empirical_types, ONLY: semi_empirical_type, & - se_int_control_type, & - se_taper_type + se_int_control_type, & + se_taper_type #include "./base/base_uses.f90" IMPLICIT NONE TYPE(semi_empirical_type), POINTER :: sepi, sepj @@ -597,16 +597,16 @@ SUBROUTINE check_dterep_ana(sepi, sepj, r, ri, dri, se_int_control, se_taper, lg rn = r CALL terep_num(sepi, sepj, rn, ri0, se_taper, se_int_control) IF (lgrad) THEN - rn = r+delta + rn = r + delta CALL terep_num(sepi, sepj, rn, rip, se_taper, se_int_control) - rn = r-delta + rn = r - delta CALL terep_num(sepi, sepj, rn, rim, se_taper, se_int_control) - nri = od*(rip-rim) + nri = od*(rip - rim) END IF ! check WRITE (*, *) "DEBUG::"//routineP DO j = 1, 491 - IF (ABS(ri(j)-ri0(j)) > EPSILON(0.0_dp)) THEN + IF (ABS(ri(j) - ri0(j)) > EPSILON(0.0_dp)) THEN WRITE (*, *) "Error in value of the integral RI", j, ri(j), ri0(j) CPABORT("") END IF @@ -615,7 +615,7 @@ SUBROUTINE check_dterep_ana(sepi, sepj, r, ri, dri, se_int_control, se_taper, lg WRITE (*, *) "ERROR for derivative of RI integral, RI(j), j::", j WRITE (*, *) "FULL SET OF INTEGRALS: INDX ANAL NUM DIFF" DO i = 1, 491 - WRITE (*, '(I5,3F15.9)') i, dri(i), nri(i), nri(i)-dri(i) + WRITE (*, '(I5,3F15.9)') i, dri(i), nri(i), nri(i) - dri(i) END DO CPABORT("") END IF @@ -642,10 +642,10 @@ SUBROUTINE check_rotint_ana(sepi, sepj, rijv, w, dw, se_int_control, se_taper) USE kinds, ONLY: dp USE semi_empirical_int_num, ONLY: rotint_num, & - drotint_num + drotint_num USE semi_empirical_types, ONLY: semi_empirical_type, & - se_int_control_type, & - se_taper_type + se_int_control_type, & + se_taper_type #include "./base/base_uses.f90" IMPLICIT NONE TYPE(semi_empirical_type), POINTER :: sepi, sepj diff --git a/src/semi_empirical_int_gks.F b/src/semi_empirical_int_gks.F index 639ff29e9e..417bedf113 100644 --- a/src/semi_empirical_int_gks.F +++ b/src/semi_empirical_int_gks.F @@ -80,7 +80,7 @@ SUBROUTINE rotnuc_gks(sepi, sepj, rij, e1b, e2a, se_int_control) i = 0 DO mu = 1, sepi%natorb DO nu = 1, mu - i = i+1 + i = i + 1 e1b(i) = -Coul(i, 1)*sepj%zeff END DO END DO @@ -88,7 +88,7 @@ SUBROUTINE rotnuc_gks(sepi, sepj, rij, e1b, e2a, se_int_control) i = 0 DO mu = 1, sepj%natorb DO nu = 1, mu - i = i+1 + i = i + 1 e2a(i) = -Coul(1, i)*sepi%zeff END DO END DO @@ -131,12 +131,12 @@ SUBROUTINE rotint_gks(sepi, sepj, rij, w, se_int_control) ind1 = 0 DO mu = 1, sepi%natorb DO nu = 1, mu - ind1 = ind1+1 + ind1 = ind1 + 1 ind2 = 0 DO lam = 1, sepj%natorb DO sig = 1, lam - i = i+1 - ind2 = ind2+1 + i = i + 1 + ind2 = ind2 + 1 w(i) = Coul(ind1, ind2) END DO END DO @@ -177,7 +177,7 @@ SUBROUTINE drotnuc_gks(sepi, sepj, rij, de1b, de2a, se_int_control) i = 0 DO mu = 1, sepi%natorb DO nu = 1, mu - i = i+1 + i = i + 1 de1b(1, i) = dCoul(1, i, 1)*sepj%zeff de1b(2, i) = dCoul(2, i, 1)*sepj%zeff de1b(3, i) = dCoul(3, i, 1)*sepj%zeff @@ -187,7 +187,7 @@ SUBROUTINE drotnuc_gks(sepi, sepj, rij, de1b, de2a, se_int_control) i = 0 DO mu = 1, sepj%natorb DO nu = 1, mu - i = i+1 + i = i + 1 de2a(1, i) = dCoul(1, 1, i)*sepi%zeff de2a(2, i) = dCoul(2, 1, i)*sepi%zeff de2a(3, i) = dCoul(3, 1, i)*sepi%zeff @@ -228,12 +228,12 @@ SUBROUTINE drotint_gks(sepi, sepj, rij, dw, se_int_control) ind1 = 0 DO mu = 1, sepi%natorb DO nu = 1, mu - ind1 = ind1+1 + ind1 = ind1 + 1 ind2 = 0 DO lam = 1, sepj%natorb DO sig = 1, lam - i = i+1 - ind2 = ind2+1 + i = i + 1 + ind2 = ind2 + 1 dw(1, i) = -dCoul(1, ind1, ind2) dw(2, i) = -dCoul(2, ind1, ind2) dw(3, i) = -dCoul(3, ind1, ind2) @@ -280,14 +280,14 @@ SUBROUTINE makeCoul(RAB, sepi, sepj, Coul, se_int_control) v(3) = RAB(3) rr = SQRT(DOT_PRODUCT(v, v)) - a2 = 0.5_dp*(1.0_dp/ACOULA+1.0_dp/ACOULB) + a2 = 0.5_dp*(1.0_dp/ACOULA + 1.0_dp/ACOULB) w0 = a2*rr w = EXP(-w0) - w1 = (1.0_dp+0.5_dp*w0) - w2 = (w1+0.5_dp*w0+0.5_dp*w0**2) - w3 = (w2+w0**3/6.0_dp) - w4 = (w3+w0**4/30.0_dp) - w5 = (w3+8.0_dp*w0**4/210.0_dp+w0**5/210.0_dp) + w1 = (1.0_dp + 0.5_dp*w0) + w2 = (w1 + 0.5_dp*w0 + 0.5_dp*w0**2) + w3 = (w2 + w0**3/6.0_dp) + w4 = (w3 + w0**4/30.0_dp) + w5 = (w3 + 8.0_dp*w0**4/210.0_dp + w0**5/210.0_dp) IF (shortrange) THEN f = (-w*w1)/rr @@ -296,11 +296,11 @@ SUBROUTINE makeCoul(RAB, sepi, sepj, Coul, se_int_control) d3 = -15.0_dp*(-w*w4)/rr**7 d4 = 105.0_dp*(-w*w5)/rr**9 ELSE - f = (1.0_dp-w*w1)/rr - d1 = -1.0_dp*(1.0_dp-w*w2)/rr**3 - d2 = 3.0_dp*(1.0_dp-w*w3)/rr**5 - d3 = -15.0_dp*(1.0_dp-w*w4)/rr**7 - d4 = 105.0_dp*(1.0_dp-w*w5)/rr**9 + f = (1.0_dp - w*w1)/rr + d1 = -1.0_dp*(1.0_dp - w*w2)/rr**3 + d2 = 3.0_dp*(1.0_dp - w*w3)/rr**5 + d3 = -15.0_dp*(1.0_dp - w*w4)/rr**7 + d4 = 105.0_dp*(1.0_dp - w*w5)/rr**9 ENDIF CALL build_d_tensor_gks(d1f, d2f, d3f, d4f, v=v, d1=d1, d2=d2, d3=d3, d4=d4) @@ -308,26 +308,26 @@ SUBROUTINE makeCoul(RAB, sepi, sepj, Coul, se_int_control) imA = 0 DO iA = 1, sepi%natorb DO jA = 1, iA - imA = imA+1 + imA = imA + 1 imB = 0 DO iB = 1, sepj%natorb DO jB = 1, iB - imB = imB+1 + imB = imB + 1 w = M0A(imA)*M0B(imB)*f DO k1 = 1, 3 - w = w+(M1A(k1, imA)*M0B(imB)-M0A(imA)*M1B(k1, imB))*d1f(k1) + w = w + (M1A(k1, imA)*M0B(imB) - M0A(imA)*M1B(k1, imB))*d1f(k1) ENDDO DO k2 = 1, 3 DO k1 = 1, 3 - w = w+(M2A(k1, k2, imA)*M0B(imB)-M1A(k1, imA)*M1B(k2, imB)+M0A(imA)*M2B(k1, k2, imB))*d2f(k1, k2) + w = w + (M2A(k1, k2, imA)*M0B(imB) - M1A(k1, imA)*M1B(k2, imB) + M0A(imA)*M2B(k1, k2, imB))*d2f(k1, k2) ENDDO ENDDO DO k3 = 1, 3 DO k2 = 1, 3 DO k1 = 1, 3 - w = w+(-M2A(k1, k2, imA)*M1B(k3, imB)+M1A(k1, imA)*M2B(k2, k3, imB))*d3f(k1, k2, k3) + w = w + (-M2A(k1, k2, imA)*M1B(k3, imB) + M1A(k1, imA)*M2B(k2, k3, imB))*d3f(k1, k2, k3) ENDDO ENDDO ENDDO @@ -336,7 +336,7 @@ SUBROUTINE makeCoul(RAB, sepi, sepj, Coul, se_int_control) DO k3 = 1, 3 DO k2 = 1, 3 DO k1 = 1, 3 - w = w+M2A(k1, k2, imA)*M2B(k3, k4, imB)*d4f(k1, k2, k3, k4) + w = w + M2A(k1, k2, imA)*M2B(k3, k4, imB)*d4f(k1, k2, k3, k4) ENDDO ENDDO ENDDO @@ -385,15 +385,15 @@ SUBROUTINE makedCoul(RAB, sepi, sepj, dCoul, se_int_control) v(3) = RAB(3) rr = SQRT(DOT_PRODUCT(v, v)) - a2 = 0.5_dp*(1.0_dp/ACOULA+1.0_dp/ACOULB) + a2 = 0.5_dp*(1.0_dp/ACOULA + 1.0_dp/ACOULB) w0 = a2*rr w = EXP(-w0) - w1 = (1.0_dp+0.5_dp*w0) - w2 = (w1+0.5_dp*w0+0.5_dp*w0**2) - w3 = (w2+w0**3/6.0_dp) - w4 = (w3+w0**4/30.0_dp) - w5 = (w3+4.0_dp*w0**4/105.0_dp+w0**5/210.0_dp) - w6 = (w3+15.0_dp*w0**4/378.0_dp+2.0_dp*w0**5/315.0_dp+w0**6/1890.0_dp) + w1 = (1.0_dp + 0.5_dp*w0) + w2 = (w1 + 0.5_dp*w0 + 0.5_dp*w0**2) + w3 = (w2 + w0**3/6.0_dp) + w4 = (w3 + w0**4/30.0_dp) + w5 = (w3 + 4.0_dp*w0**4/105.0_dp + w0**5/210.0_dp) + w6 = (w3 + 15.0_dp*w0**4/378.0_dp + 2.0_dp*w0**5/315.0_dp + w0**6/1890.0_dp) IF (shortrange) THEN f = (-w*w1)/rr @@ -403,12 +403,12 @@ SUBROUTINE makedCoul(RAB, sepi, sepj, dCoul, se_int_control) d4 = 105.0_dp*(-w*w5)/rr**9 d5 = -945.0_dp*(-w*w6)/rr**11 ELSE - f = (1.0_dp-w*w1)/rr - d1 = -1.0_dp*(1.0_dp-w*w2)/rr**3 - d2 = 3.0_dp*(1.0_dp-w*w3)/rr**5 - d3 = -15.0_dp*(1.0_dp-w*w4)/rr**7 - d4 = 105.0_dp*(1.0_dp-w*w5)/rr**9 - d5 = -945.0_dp*(1.0_dp-w*w6)/rr**11 + f = (1.0_dp - w*w1)/rr + d1 = -1.0_dp*(1.0_dp - w*w2)/rr**3 + d2 = 3.0_dp*(1.0_dp - w*w3)/rr**5 + d3 = -15.0_dp*(1.0_dp - w*w4)/rr**7 + d4 = 105.0_dp*(1.0_dp - w*w5)/rr**9 + d5 = -945.0_dp*(1.0_dp - w*w6)/rr**11 ENDIF CALL build_d_tensor_gks(d1f, d2f, d3f, d4f, d5f, v, d1, d2, d3, d4, d5) @@ -416,38 +416,38 @@ SUBROUTINE makedCoul(RAB, sepi, sepj, dCoul, se_int_control) imA = 0 DO iA = 1, sepi%natorb DO jA = 1, iA - imA = imA+1 + imA = imA + 1 imB = 0 DO iB = 1, sepj%natorb DO jB = 1, iB - imB = imB+1 + imB = imB + 1 tmp = M0A(imA)*M0B(imB) wv(1) = tmp*d1f(1) wv(2) = tmp*d1f(2) wv(3) = tmp*d1f(3) DO k1 = 1, 3 - tmp = M1A(k1, imA)*M0B(imB)-M0A(imA)*M1B(k1, imB) - wv(1) = wv(1)+tmp*d2f(1, k1) - wv(2) = wv(2)+tmp*d2f(2, k1) - wv(3) = wv(3)+tmp*d2f(3, k1) + tmp = M1A(k1, imA)*M0B(imB) - M0A(imA)*M1B(k1, imB) + wv(1) = wv(1) + tmp*d2f(1, k1) + wv(2) = wv(2) + tmp*d2f(2, k1) + wv(3) = wv(3) + tmp*d2f(3, k1) ENDDO DO k2 = 1, 3 DO k1 = 1, 3 - tmp = M2A(k1, k2, imA)*M0B(imB)-M1A(k1, imA)*M1B(k2, imB)+M0A(imA)*M2B(k1, k2, imB) - wv(1) = wv(1)+tmp*d3f(1, k1, k2) - wv(2) = wv(2)+tmp*d3f(2, k1, k2) - wv(3) = wv(3)+tmp*d3f(3, k1, k2) + tmp = M2A(k1, k2, imA)*M0B(imB) - M1A(k1, imA)*M1B(k2, imB) + M0A(imA)*M2B(k1, k2, imB) + wv(1) = wv(1) + tmp*d3f(1, k1, k2) + wv(2) = wv(2) + tmp*d3f(2, k1, k2) + wv(3) = wv(3) + tmp*d3f(3, k1, k2) ENDDO ENDDO DO k3 = 1, 3 DO k2 = 1, 3 DO k1 = 1, 3 - tmp = -M2A(k1, k2, imA)*M1B(k3, imB)+M1A(k1, imA)*M2B(k2, k3, imB) - wv(1) = wv(1)+tmp*d4f(1, k1, k2, k3) - wv(2) = wv(2)+tmp*d4f(2, k1, k2, k3) - wv(3) = wv(3)+tmp*d4f(3, k1, k2, k3) + tmp = -M2A(k1, k2, imA)*M1B(k3, imB) + M1A(k1, imA)*M2B(k2, k3, imB) + wv(1) = wv(1) + tmp*d4f(1, k1, k2, k3) + wv(2) = wv(2) + tmp*d4f(2, k1, k2, k3) + wv(3) = wv(3) + tmp*d4f(3, k1, k2, k3) ENDDO ENDDO ENDDO @@ -457,9 +457,9 @@ SUBROUTINE makedCoul(RAB, sepi, sepj, dCoul, se_int_control) DO k2 = 1, 3 DO k1 = 1, 3 tmp = M2A(k1, k2, imA)*M2B(k3, k4, imB) - wv(1) = wv(1)+tmp*d5f(1, k1, k2, k3, k4) - wv(2) = wv(2)+tmp*d5f(2, k1, k2, k3, k4) - wv(3) = wv(3)+tmp*d5f(3, k1, k2, k3, k4) + wv(1) = wv(1) + tmp*d5f(1, k1, k2, k3, k4) + wv(2) = wv(2) + tmp*d5f(2, k1, k2, k3, k4) + wv(3) = wv(3) + tmp*d5f(3, k1, k2, k3, k4) ENDDO ENDDO ENDDO @@ -532,15 +532,15 @@ SUBROUTINE corecore_gks(sepi, sepj, rijv, enuc, denuc, se_int_control) zz = sepi%zeff*sepj%zeff alpi = sepi%alp alpj = sepj%alp - scale = EXP(-alpi*rij)+EXP(-alpj*rij) + scale = EXP(-alpi*rij) + EXP(-alpj*rij) IF (l_enuc) THEN - enuc = zz*CoulE(1, 1)+scale*zz*Coul(1, 1) + enuc = zz*CoulE(1, 1) + scale*zz*Coul(1, 1) END IF IF (l_denuc) THEN - dscale = -alpi*EXP(-alpi*rij)-alpj*EXP(-alpj*rij) - denuc(1) = zz*dCoulE(1, 1, 1)+dscale*(rijv(1)/rij)*zz*Coul(1, 1)+scale*zz*dCoul(1, 1, 1) - denuc(2) = zz*dCoulE(2, 1, 1)+dscale*(rijv(2)/rij)*zz*Coul(1, 1)+scale*zz*dCoul(2, 1, 1) - denuc(3) = zz*dCoulE(3, 1, 1)+dscale*(rijv(3)/rij)*zz*Coul(1, 1)+scale*zz*dCoul(3, 1, 1) + dscale = -alpi*EXP(-alpi*rij) - alpj*EXP(-alpj*rij) + denuc(1) = zz*dCoulE(1, 1, 1) + dscale*(rijv(1)/rij)*zz*Coul(1, 1) + scale*zz*dCoul(1, 1, 1) + denuc(2) = zz*dCoulE(2, 1, 1) + dscale*(rijv(2)/rij)*zz*Coul(1, 1) + scale*zz*dCoul(2, 1, 1) + denuc(3) = zz*dCoulE(3, 1, 1) + dscale*(rijv(3)/rij)*zz*Coul(1, 1) + scale*zz*dCoul(3, 1, 1) END IF ELSE @@ -613,52 +613,52 @@ SUBROUTINE makeCoulE(RAB, sepi, sepj, Coul, se_int_control) r7 = r5*r2 r9 = r7*r2 - a2 = 0.5_dp*(1.0_dp/ACOULA+1.0_dp/ACOULB) + a2 = 0.5_dp*(1.0_dp/ACOULA + 1.0_dp/ACOULB) w0 = a2*rr w = EXP(-w0) - w1 = (1.0_dp+0.5_dp*w0) - w2 = (w1+0.5_dp*w0+0.5_dp*w0**2) - w3 = (w2+w0**3/6.0_dp) - w4 = (w3+w0**4/30.0_dp) - w5 = (w3+8.0_dp*w0**4/210.0_dp+w0**5/210.0_dp) - - f = (1.0_dp-w*w1)*r1 - d1 = -1.0_dp*(1.0_dp-w*w2)*r3 - d2 = 3.0_dp*(1.0_dp-w*w3)*r5 - d3 = -15.0_dp*(1.0_dp-w*w4)*r7 - d4 = 105.0_dp*(1.0_dp-w*w5)*r9 + w1 = (1.0_dp + 0.5_dp*w0) + w2 = (w1 + 0.5_dp*w0 + 0.5_dp*w0**2) + w3 = (w2 + w0**3/6.0_dp) + w4 = (w3 + w0**4/30.0_dp) + w5 = (w3 + 8.0_dp*w0**4/210.0_dp + w0**5/210.0_dp) + + f = (1.0_dp - w*w1)*r1 + d1 = -1.0_dp*(1.0_dp - w*w2)*r3 + d2 = 3.0_dp*(1.0_dp - w*w3)*r5 + d3 = -15.0_dp*(1.0_dp - w*w4)*r7 + d4 = 105.0_dp*(1.0_dp - w*w5)*r9 kr = alpha*rr kr2 = kr*kr - w0 = 1.0_dp-erfc(kr) + w0 = 1.0_dp - erfc(kr) w1 = 2.0_dp*oorootpi*EXP(-kr2) w2 = w1*kr - f = f-w0*r1 - d1 = d1+(-w2+w0)*r3 - d2 = d2+(w2*(3.0_dp+kr2*2.0_dp)-3.0_dp*w0)*r5 - d3 = d3+(-w2*(15.0_dp+kr2*(10.0_dp+kr2*4.0_dp))+15.0_dp*w0)*r7 - d4 = d4+(w2*(105.0_dp+kr2*(70.0_dp+kr2*(28.0_dp+kr2*8.0_dp)))-105.0_dp*w0)*r9 + f = f - w0*r1 + d1 = d1 + (-w2 + w0)*r3 + d2 = d2 + (w2*(3.0_dp + kr2*2.0_dp) - 3.0_dp*w0)*r5 + d3 = d3 + (-w2*(15.0_dp + kr2*(10.0_dp + kr2*4.0_dp)) + 15.0_dp*w0)*r7 + d4 = d4 + (w2*(105.0_dp + kr2*(70.0_dp + kr2*(28.0_dp + kr2*8.0_dp))) - 105.0_dp*w0)*r9 CALL build_d_tensor_gks(d1f, d2f, d3f, d4f, v=v, d1=d1, d2=d2, d3=d3, d4=d4) - DO imA = 1, (sepi%natorb*(sepi%natorb+1))/2 - DO imB = 1, (sepj%natorb*(sepj%natorb+1))/2 + DO imA = 1, (sepi%natorb*(sepi%natorb + 1))/2 + DO imB = 1, (sepj%natorb*(sepj%natorb + 1))/2 w = M0A(imA)*M0B(imB)*f DO k1 = 1, 3 - w = w+(M1A(k1, imA)*M0B(imB)-M0A(imA)*M1B(k1, imB))*d1f(k1) + w = w + (M1A(k1, imA)*M0B(imB) - M0A(imA)*M1B(k1, imB))*d1f(k1) ENDDO DO k2 = 1, 3 DO k1 = 1, 3 - w = w+(M2A(k1, k2, imA)*M0B(imB)-M1A(k1, imA)*M1B(k2, imB)+M0A(imA)*M2B(k1, k2, imB))*d2f(k1, k2) + w = w + (M2A(k1, k2, imA)*M0B(imB) - M1A(k1, imA)*M1B(k2, imB) + M0A(imA)*M2B(k1, k2, imB))*d2f(k1, k2) ENDDO ENDDO DO k3 = 1, 3 DO k2 = 1, 3 DO k1 = 1, 3 - w = w+(-M2A(k1, k2, imA)*M1B(k3, imB)+M1A(k1, imA)*M2B(k2, k3, imB))*d3f(k1, k2, k3) + w = w + (-M2A(k1, k2, imA)*M1B(k3, imB) + M1A(k1, imA)*M2B(k2, k3, imB))*d3f(k1, k2, k3) ENDDO ENDDO ENDDO @@ -667,7 +667,7 @@ SUBROUTINE makeCoulE(RAB, sepi, sepj, Coul, se_int_control) DO k3 = 1, 3 DO k2 = 1, 3 DO k1 = 1, 3 - w = w+M2A(k1, k2, imA)*M2B(k3, k4, imB)*d4f(k1, k2, k3, k4) + w = w + M2A(k1, k2, imA)*M2B(k3, k4, imB)*d4f(k1, k2, k3, k4) ENDDO ENDDO ENDDO @@ -692,9 +692,9 @@ SUBROUTINE makeCoulE(RAB, sepi, sepj, Coul, se_int_control) mp = pw_grid%mapm%pos(pw_grid%g_hat(2, gpt)) np = pw_grid%mapn%pos(pw_grid%g_hat(3, gpt)) - lp = lp+bds(1, 1) - mp = mp+bds(1, 2) - np = np+bds(1, 3) + lp = lp + bds(1, 1) + mp = mp + bds(1, 2) + np = np + bds(1, 3) IF (pw_grid%gsq(gpt) == 0.0_dp) CYCLE kk(:) = pw_grid%g(:, gpt) @@ -704,19 +704,19 @@ SUBROUTINE makeCoulE(RAB, sepi, sepj, Coul, se_int_control) cc = COS(kr) ss = SIN(kr) - f = f+cc*ff + f = f + cc*ff DO k1 = 1, 3 - d1f(k1) = d1f(k1)-kk(k1)*ss*ff + d1f(k1) = d1f(k1) - kk(k1)*ss*ff ENDDO DO k2 = 1, 3 DO k1 = 1, 3 - d2f(k1, k2) = d2f(k1, k2)-kk(k1)*kk(k2)*cc*ff + d2f(k1, k2) = d2f(k1, k2) - kk(k1)*kk(k2)*cc*ff ENDDO ENDDO DO k3 = 1, 3 DO k2 = 1, 3 DO k1 = 1, 3 - d3f(k1, k2, k3) = d3f(k1, k2, k3)+kk(k1)*kk(k2)*kk(k3)*ss*ff + d3f(k1, k2, k3) = d3f(k1, k2, k3) + kk(k1)*kk(k2)*kk(k3)*ss*ff ENDDO ENDDO ENDDO @@ -724,7 +724,7 @@ SUBROUTINE makeCoulE(RAB, sepi, sepj, Coul, se_int_control) DO k3 = 1, 3 DO k2 = 1, 3 DO k1 = 1, 3 - d4f(k1, k2, k3, k4) = d4f(k1, k2, k3, k4)+kk(k1)*kk(k2)*kk(k3)*kk(k4)*cc*ff + d4f(k1, k2, k3, k4) = d4f(k1, k2, k3, k4) + kk(k1)*kk(k2)*kk(k3)*kk(k4)*cc*ff ENDDO ENDDO ENDDO @@ -732,22 +732,22 @@ SUBROUTINE makeCoulE(RAB, sepi, sepj, Coul, se_int_control) ENDDO - DO imA = 1, (sepi%natorb*(sepi%natorb+1))/2 - DO imB = 1, (sepj%natorb*(sepj%natorb+1))/2 + DO imA = 1, (sepi%natorb*(sepi%natorb + 1))/2 + DO imB = 1, (sepj%natorb*(sepj%natorb + 1))/2 w = M0A(imA)*M0B(imB)*f DO k1 = 1, 3 - w = w+(M1A(k1, imA)*M0B(imB)-M0A(imA)*M1B(k1, imB))*d1f(k1) + w = w + (M1A(k1, imA)*M0B(imB) - M0A(imA)*M1B(k1, imB))*d1f(k1) ENDDO DO k2 = 1, 3 DO k1 = 1, 3 - w = w+(M2A(k1, k2, imA)*M0B(imB)-M1A(k1, imA)*M1B(k2, imB)+M0A(imA)*M2B(k1, k2, imB))*d2f(k1, k2) + w = w + (M2A(k1, k2, imA)*M0B(imB) - M1A(k1, imA)*M1B(k2, imB) + M0A(imA)*M2B(k1, k2, imB))*d2f(k1, k2) ENDDO ENDDO DO k3 = 1, 3 DO k2 = 1, 3 DO k1 = 1, 3 - w = w+(-M2A(k1, k2, imA)*M1B(k3, imB)+M1A(k1, imA)*M2B(k2, k3, imB))*d3f(k1, k2, k3) + w = w + (-M2A(k1, k2, imA)*M1B(k3, imB) + M1A(k1, imA)*M2B(k2, k3, imB))*d3f(k1, k2, k3) ENDDO ENDDO ENDDO @@ -756,21 +756,21 @@ SUBROUTINE makeCoulE(RAB, sepi, sepj, Coul, se_int_control) DO k3 = 1, 3 DO k2 = 1, 3 DO k1 = 1, 3 - w = w+M2A(k1, k2, imA)*M2B(k3, k4, imB)*d4f(k1, k2, k3, k4) + w = w + M2A(k1, k2, imA)*M2B(k3, k4, imB)*d4f(k1, k2, k3, k4) ENDDO ENDDO ENDDO ENDDO - Coul(imA, imB) = Coul(imA, imB)+w + Coul(imA, imB) = Coul(imA, imB) + w ENDDO ENDDO - DO imA = 1, (sepi%natorb*(sepi%natorb+1))/2 - DO imB = 1, (sepj%natorb*(sepj%natorb+1))/2 + DO imA = 1, (sepi%natorb*(sepi%natorb + 1))/2 + DO imB = 1, (sepj%natorb*(sepj%natorb + 1))/2 w = -M0A(imA)*M0B(imB)*0.25_dp*fourpi/(pw_grid%vol*alpha**2) - Coul(imA, imB) = Coul(imA, imB)+w + Coul(imA, imB) = Coul(imA, imB) + w ENDDO ENDDO @@ -825,7 +825,7 @@ SUBROUTINE makedCoulE(RAB, sepi, sepj, dCoul, se_int_control) v(3) = RAB(3) rr = SQRT(DOT_PRODUCT(v, v)) - a2 = 0.5_dp*(1.0_dp/ACOULA+1.0_dp/ACOULB) + a2 = 0.5_dp*(1.0_dp/ACOULA + 1.0_dp/ACOULB) r1 = 1.0_dp/rr r2 = r1*r1 @@ -837,37 +837,37 @@ SUBROUTINE makedCoulE(RAB, sepi, sepj, dCoul, se_int_control) w0 = a2*rr w = EXP(-w0) - w1 = (1.0_dp+0.5_dp*w0) - w2 = (w1+0.5_dp*w0+0.5_dp*w0**2) - w3 = (w2+w0**3/6.0_dp) - w4 = (w3+w0**4/30.0_dp) - w5 = (w3+8.0_dp*w0**4/210.0_dp+w0**5/210.0_dp) - w6 = (w3+5.0_dp*w0**4/126.0_dp+2.0_dp*w0**5/315.0_dp+w0**6/1890.0_dp) - - f = (1.0_dp-w*w1)*r1 - d1 = -1.0_dp*(1.0_dp-w*w2)*r3 - d2 = 3.0_dp*(1.0_dp-w*w3)*r5 - d3 = -15.0_dp*(1.0_dp-w*w4)*r7 - d4 = 105.0_dp*(1.0_dp-w*w5)*r9 - d5 = -945.0_dp*(1.0_dp-w*w6)*r11 + w1 = (1.0_dp + 0.5_dp*w0) + w2 = (w1 + 0.5_dp*w0 + 0.5_dp*w0**2) + w3 = (w2 + w0**3/6.0_dp) + w4 = (w3 + w0**4/30.0_dp) + w5 = (w3 + 8.0_dp*w0**4/210.0_dp + w0**5/210.0_dp) + w6 = (w3 + 5.0_dp*w0**4/126.0_dp + 2.0_dp*w0**5/315.0_dp + w0**6/1890.0_dp) + + f = (1.0_dp - w*w1)*r1 + d1 = -1.0_dp*(1.0_dp - w*w2)*r3 + d2 = 3.0_dp*(1.0_dp - w*w3)*r5 + d3 = -15.0_dp*(1.0_dp - w*w4)*r7 + d4 = 105.0_dp*(1.0_dp - w*w5)*r9 + d5 = -945.0_dp*(1.0_dp - w*w6)*r11 kr = alpha*rr kr2 = kr*kr - w0 = 1.0_dp-erfc(kr) + w0 = 1.0_dp - erfc(kr) w1 = 2.0_dp*oorootpi*EXP(-kr2) w2 = w1*kr - f = f-w0*r1 - d1 = d1+(-w2+w0)*r3 - d2 = d2+(w2*(3.0_dp+kr2*2.0_dp)-3.0_dp*w0)*r5 - d3 = d3+(-w2*(15.0_dp+kr2*(10.0_dp+kr2*4.0_dp))+15.0_dp*w0)*r7 - d4 = d4+(w2*(105.0_dp+kr2*(70.0_dp+kr2*(28.0_dp+kr2*8.0_dp)))-105.0_dp*w0)*r9 - d5 = d5+(-w2*(945.0_dp+kr2*(630.0_dp+kr2*(252.0_dp+kr2*(72.0_dp+kr2*16.0_dp))))+945.0_dp*w0)*r11 + f = f - w0*r1 + d1 = d1 + (-w2 + w0)*r3 + d2 = d2 + (w2*(3.0_dp + kr2*2.0_dp) - 3.0_dp*w0)*r5 + d3 = d3 + (-w2*(15.0_dp + kr2*(10.0_dp + kr2*4.0_dp)) + 15.0_dp*w0)*r7 + d4 = d4 + (w2*(105.0_dp + kr2*(70.0_dp + kr2*(28.0_dp + kr2*8.0_dp))) - 105.0_dp*w0)*r9 + d5 = d5 + (-w2*(945.0_dp + kr2*(630.0_dp + kr2*(252.0_dp + kr2*(72.0_dp + kr2*16.0_dp)))) + 945.0_dp*w0)*r11 CALL build_d_tensor_gks(d1f, d2f, d3f, d4f, d5f, v, d1, d2, d3, d4, d5) - DO imA = 1, (sepi%natorb*(sepi%natorb+1))/2 - DO imB = 1, (sepj%natorb*(sepj%natorb+1))/2 + DO imA = 1, (sepi%natorb*(sepi%natorb + 1))/2 + DO imB = 1, (sepj%natorb*(sepj%natorb + 1))/2 tmp = M0A(imA)*M0B(imB) wv(1) = tmp*d1f(1) @@ -875,26 +875,26 @@ SUBROUTINE makedCoulE(RAB, sepi, sepj, dCoul, se_int_control) wv(3) = tmp*d1f(3) DO k1 = 1, 3 - tmp = M1A(k1, imA)*M0B(imB)-M0A(imA)*M1B(k1, imB) - wv(1) = wv(1)+tmp*d2f(1, k1) - wv(2) = wv(2)+tmp*d2f(2, k1) - wv(3) = wv(3)+tmp*d2f(3, k1) + tmp = M1A(k1, imA)*M0B(imB) - M0A(imA)*M1B(k1, imB) + wv(1) = wv(1) + tmp*d2f(1, k1) + wv(2) = wv(2) + tmp*d2f(2, k1) + wv(3) = wv(3) + tmp*d2f(3, k1) ENDDO DO k2 = 1, 3 DO k1 = 1, 3 - tmp = M2A(k1, k2, imA)*M0B(imB)-M1A(k1, imA)*M1B(k2, imB)+M0A(imA)*M2B(k1, k2, imB) - wv(1) = wv(1)+tmp*d3f(1, k1, k2) - wv(2) = wv(2)+tmp*d3f(2, k1, k2) - wv(3) = wv(3)+tmp*d3f(3, k1, k2) + tmp = M2A(k1, k2, imA)*M0B(imB) - M1A(k1, imA)*M1B(k2, imB) + M0A(imA)*M2B(k1, k2, imB) + wv(1) = wv(1) + tmp*d3f(1, k1, k2) + wv(2) = wv(2) + tmp*d3f(2, k1, k2) + wv(3) = wv(3) + tmp*d3f(3, k1, k2) ENDDO ENDDO DO k3 = 1, 3 DO k2 = 1, 3 DO k1 = 1, 3 - tmp = -M2A(k1, k2, imA)*M1B(k3, imB)+M1A(k1, imA)*M2B(k2, k3, imB) - wv(1) = wv(1)+tmp*d4f(1, k1, k2, k3) - wv(2) = wv(2)+tmp*d4f(2, k1, k2, k3) - wv(3) = wv(3)+tmp*d4f(3, k1, k2, k3) + tmp = -M2A(k1, k2, imA)*M1B(k3, imB) + M1A(k1, imA)*M2B(k2, k3, imB) + wv(1) = wv(1) + tmp*d4f(1, k1, k2, k3) + wv(2) = wv(2) + tmp*d4f(2, k1, k2, k3) + wv(3) = wv(3) + tmp*d4f(3, k1, k2, k3) ENDDO ENDDO ENDDO @@ -904,9 +904,9 @@ SUBROUTINE makedCoulE(RAB, sepi, sepj, dCoul, se_int_control) DO k2 = 1, 3 DO k1 = 1, 3 tmp = M2A(k1, k2, imA)*M2B(k3, k4, imB) - wv(1) = wv(1)+tmp*d5f(1, k1, k2, k3, k4) - wv(2) = wv(2)+tmp*d5f(2, k1, k2, k3, k4) - wv(3) = wv(3)+tmp*d5f(3, k1, k2, k3, k4) + wv(1) = wv(1) + tmp*d5f(1, k1, k2, k3, k4) + wv(2) = wv(2) + tmp*d5f(2, k1, k2, k3, k4) + wv(3) = wv(3) + tmp*d5f(3, k1, k2, k3, k4) ENDDO ENDDO ENDDO @@ -934,9 +934,9 @@ SUBROUTINE makedCoulE(RAB, sepi, sepj, dCoul, se_int_control) mp = pw_grid%mapm%pos(pw_grid%g_hat(2, gpt)) np = pw_grid%mapn%pos(pw_grid%g_hat(3, gpt)) - lp = lp+bds(1, 1) - mp = mp+bds(1, 2) - np = np+bds(1, 3) + lp = lp + bds(1, 1) + mp = mp + bds(1, 2) + np = np + bds(1, 3) IF (pw_grid%gsq(gpt) == 0.0_dp) CYCLE kk(:) = pw_grid%g(:, gpt) @@ -946,19 +946,19 @@ SUBROUTINE makedCoulE(RAB, sepi, sepj, dCoul, se_int_control) cc = COS(kr) ss = SIN(kr) - f = f+cc*ff + f = f + cc*ff DO k1 = 1, 3 - d1f(k1) = d1f(k1)-kk(k1)*ss*ff + d1f(k1) = d1f(k1) - kk(k1)*ss*ff ENDDO DO k2 = 1, 3 DO k1 = 1, 3 - d2f(k1, k2) = d2f(k1, k2)-kk(k1)*kk(k2)*cc*ff + d2f(k1, k2) = d2f(k1, k2) - kk(k1)*kk(k2)*cc*ff ENDDO ENDDO DO k3 = 1, 3 DO k2 = 1, 3 DO k1 = 1, 3 - d3f(k1, k2, k3) = d3f(k1, k2, k3)+kk(k1)*kk(k2)*kk(k3)*ss*ff + d3f(k1, k2, k3) = d3f(k1, k2, k3) + kk(k1)*kk(k2)*kk(k3)*ss*ff ENDDO ENDDO ENDDO @@ -966,7 +966,7 @@ SUBROUTINE makedCoulE(RAB, sepi, sepj, dCoul, se_int_control) DO k3 = 1, 3 DO k2 = 1, 3 DO k1 = 1, 3 - d4f(k1, k2, k3, k4) = d4f(k1, k2, k3, k4)+kk(k1)*kk(k2)*kk(k3)*kk(k4)*cc*ff + d4f(k1, k2, k3, k4) = d4f(k1, k2, k3, k4) + kk(k1)*kk(k2)*kk(k3)*kk(k4)*cc*ff ENDDO ENDDO ENDDO @@ -976,7 +976,7 @@ SUBROUTINE makedCoulE(RAB, sepi, sepj, dCoul, se_int_control) DO k3 = 1, 3 DO k2 = 1, 3 DO k1 = 1, 3 - d5f(k1, k2, k3, k4, k5) = d5f(k1, k2, k3, k4, k5)-kk(k1)*kk(k2)*kk(k3)*kk(k4)*kk(k5)*ss*ff + d5f(k1, k2, k3, k4, k5) = d5f(k1, k2, k3, k4, k5) - kk(k1)*kk(k2)*kk(k3)*kk(k4)*kk(k5)*ss*ff ENDDO ENDDO ENDDO @@ -984,33 +984,33 @@ SUBROUTINE makedCoulE(RAB, sepi, sepj, dCoul, se_int_control) ENDDO ENDDO - DO imA = 1, (sepi%natorb*(sepi%natorb+1))/2 - DO imB = 1, (sepj%natorb*(sepj%natorb+1))/2 + DO imA = 1, (sepi%natorb*(sepi%natorb + 1))/2 + DO imB = 1, (sepj%natorb*(sepj%natorb + 1))/2 tmp = M0A(imA)*M0B(imB) wv(1) = tmp*d1f(1) wv(2) = tmp*d1f(2) wv(3) = tmp*d1f(3) DO k1 = 1, 3 - tmp = M1A(k1, imA)*M0B(imB)-M0A(imA)*M1B(k1, imB) - wv(1) = wv(1)+tmp*d2f(1, k1) - wv(2) = wv(2)+tmp*d2f(2, k1) - wv(3) = wv(3)+tmp*d2f(3, k1) + tmp = M1A(k1, imA)*M0B(imB) - M0A(imA)*M1B(k1, imB) + wv(1) = wv(1) + tmp*d2f(1, k1) + wv(2) = wv(2) + tmp*d2f(2, k1) + wv(3) = wv(3) + tmp*d2f(3, k1) ENDDO DO k2 = 1, 3 DO k1 = 1, 3 - tmp = M2A(k1, k2, imA)*M0B(imB)-M1A(k1, imA)*M1B(k2, imB)+M0A(imA)*M2B(k1, k2, imB) - wv(1) = wv(1)+tmp*d3f(1, k1, k2) - wv(2) = wv(2)+tmp*d3f(2, k1, k2) - wv(3) = wv(3)+tmp*d3f(3, k1, k2) + tmp = M2A(k1, k2, imA)*M0B(imB) - M1A(k1, imA)*M1B(k2, imB) + M0A(imA)*M2B(k1, k2, imB) + wv(1) = wv(1) + tmp*d3f(1, k1, k2) + wv(2) = wv(2) + tmp*d3f(2, k1, k2) + wv(3) = wv(3) + tmp*d3f(3, k1, k2) ENDDO ENDDO DO k3 = 1, 3 DO k2 = 1, 3 DO k1 = 1, 3 - tmp = -M2A(k1, k2, imA)*M1B(k3, imB)+M1A(k1, imA)*M2B(k2, k3, imB) - wv(1) = wv(1)+tmp*d4f(1, k1, k2, k3) - wv(2) = wv(2)+tmp*d4f(2, k1, k2, k3) - wv(3) = wv(3)+tmp*d4f(3, k1, k2, k3) + tmp = -M2A(k1, k2, imA)*M1B(k3, imB) + M1A(k1, imA)*M2B(k2, k3, imB) + wv(1) = wv(1) + tmp*d4f(1, k1, k2, k3) + wv(2) = wv(2) + tmp*d4f(2, k1, k2, k3) + wv(3) = wv(3) + tmp*d4f(3, k1, k2, k3) ENDDO ENDDO ENDDO @@ -1020,17 +1020,17 @@ SUBROUTINE makedCoulE(RAB, sepi, sepj, dCoul, se_int_control) DO k2 = 1, 3 DO k1 = 1, 3 tmp = M2A(k1, k2, imA)*M2B(k3, k4, imB) - wv(1) = wv(1)+tmp*d5f(1, k1, k2, k3, k4) - wv(2) = wv(2)+tmp*d5f(2, k1, k2, k3, k4) - wv(3) = wv(3)+tmp*d5f(3, k1, k2, k3, k4) + wv(1) = wv(1) + tmp*d5f(1, k1, k2, k3, k4) + wv(2) = wv(2) + tmp*d5f(2, k1, k2, k3, k4) + wv(3) = wv(3) + tmp*d5f(3, k1, k2, k3, k4) ENDDO ENDDO ENDDO ENDDO - dCoul(1, imA, imB) = dCoul(1, imA, imB)+wv(1) - dCoul(2, imA, imB) = dCoul(2, imA, imB)+wv(2) - dCoul(3, imA, imB) = dCoul(3, imA, imB)+wv(3) + dCoul(1, imA, imB) = dCoul(1, imA, imB) + wv(1) + dCoul(2, imA, imB) = dCoul(2, imA, imB) + wv(2) + dCoul(3, imA, imB) = dCoul(3, imA, imB) + wv(3) ENDDO ENDDO @@ -1070,42 +1070,42 @@ SUBROUTINE build_d_tensor_gks(d1f, d2f, d3f, d4f, d5f, v, d1, d2, d3, d4, d5) d3f = 0.0_dp d4f = 0.0_dp DO k1 = 1, 3 - d1f(k1) = d1f(k1)+v(k1)*d1 + d1f(k1) = d1f(k1) + v(k1)*d1 ENDDO DO k1 = 1, 3 DO k2 = 1, 3 - d2f(k2, k1) = d2f(k2, k1)+v(k1)*v(k2)*d2 + d2f(k2, k1) = d2f(k2, k1) + v(k1)*v(k2)*d2 ENDDO - d2f(k1, k1) = d2f(k1, k1)+d1 + d2f(k1, k1) = d2f(k1, k1) + d1 ENDDO DO k1 = 1, 3 DO k2 = 1, 3 DO k3 = 1, 3 - d3f(k3, k2, k1) = d3f(k3, k2, k1)+v(k1)*v(k2)*v(k3)*d3 + d3f(k3, k2, k1) = d3f(k3, k2, k1) + v(k1)*v(k2)*v(k3)*d3 ENDDO w = v(k1)*d2 - d3f(k1, k2, k2) = d3f(k1, k2, k2)+w - d3f(k2, k1, k2) = d3f(k2, k1, k2)+w - d3f(k2, k2, k1) = d3f(k2, k2, k1)+w + d3f(k1, k2, k2) = d3f(k1, k2, k2) + w + d3f(k2, k1, k2) = d3f(k2, k1, k2) + w + d3f(k2, k2, k1) = d3f(k2, k2, k1) + w ENDDO ENDDO DO k1 = 1, 3 DO k2 = 1, 3 DO k3 = 1, 3 DO k4 = 1, 3 - d4f(k4, k3, k2, k1) = d4f(k4, k3, k2, k1)+v(k1)*v(k2)*v(k3)*v(k4)*d4 + d4f(k4, k3, k2, k1) = d4f(k4, k3, k2, k1) + v(k1)*v(k2)*v(k3)*v(k4)*d4 ENDDO w = v(k1)*v(k2)*d3 - d4f(k1, k2, k3, k3) = d4f(k1, k2, k3, k3)+w - d4f(k1, k3, k2, k3) = d4f(k1, k3, k2, k3)+w - d4f(k3, k1, k2, k3) = d4f(k3, k1, k2, k3)+w - d4f(k1, k3, k3, k2) = d4f(k1, k3, k3, k2)+w - d4f(k3, k1, k3, k2) = d4f(k3, k1, k3, k2)+w - d4f(k3, k3, k1, k2) = d4f(k3, k3, k1, k2)+w + d4f(k1, k2, k3, k3) = d4f(k1, k2, k3, k3) + w + d4f(k1, k3, k2, k3) = d4f(k1, k3, k2, k3) + w + d4f(k3, k1, k2, k3) = d4f(k3, k1, k2, k3) + w + d4f(k1, k3, k3, k2) = d4f(k1, k3, k3, k2) + w + d4f(k3, k1, k3, k2) = d4f(k3, k1, k3, k2) + w + d4f(k3, k3, k1, k2) = d4f(k3, k3, k1, k2) + w ENDDO - d4f(k1, k1, k2, k2) = d4f(k1, k1, k2, k2)+d2 - d4f(k1, k2, k1, k2) = d4f(k1, k2, k1, k2)+d2 - d4f(k1, k2, k2, k1) = d4f(k1, k2, k2, k1)+d2 + d4f(k1, k1, k2, k2) = d4f(k1, k1, k2, k2) + d2 + d4f(k1, k2, k1, k2) = d4f(k1, k2, k1, k2) + d2 + d4f(k1, k2, k2, k1) = d4f(k1, k2, k2, k1) + d2 ENDDO ENDDO IF (PRESENT(d5f) .AND. PRESENT(d5)) THEN @@ -1116,36 +1116,36 @@ SUBROUTINE build_d_tensor_gks(d1f, d2f, d3f, d4f, d5f, v, d1, d2, d3, d4, d5) DO k3 = 1, 3 DO k4 = 1, 3 DO k5 = 1, 3 - d5f(k5, k4, k3, k2, k1) = d5f(k5, k4, k3, k2, k1)+v(k1)*v(k2)*v(k3)*v(k4)*v(k5)*d5 + d5f(k5, k4, k3, k2, k1) = d5f(k5, k4, k3, k2, k1) + v(k1)*v(k2)*v(k3)*v(k4)*v(k5)*d5 ENDDO w = v(k1)*v(k2)*v(k3)*d4 - d5f(k1, k2, k3, k4, k4) = d5f(k1, k2, k3, k4, k4)+w - d5f(k1, k2, k4, k3, k4) = d5f(k1, k2, k4, k3, k4)+w - d5f(k1, k4, k2, k3, k4) = d5f(k1, k4, k2, k3, k4)+w - d5f(k4, k1, k2, k3, k4) = d5f(k4, k1, k2, k3, k4)+w - d5f(k1, k2, k4, k4, k3) = d5f(k1, k2, k4, k4, k3)+w - d5f(k1, k4, k2, k4, k3) = d5f(k1, k4, k2, k4, k3)+w - d5f(k4, k1, k2, k4, k3) = d5f(k4, k1, k2, k4, k3)+w - d5f(k1, k4, k4, k2, k3) = d5f(k1, k4, k4, k2, k3)+w - d5f(k4, k1, k4, k2, k3) = d5f(k4, k1, k4, k2, k3)+w - d5f(k4, k4, k1, k2, k3) = d5f(k4, k4, k1, k2, k3)+w + d5f(k1, k2, k3, k4, k4) = d5f(k1, k2, k3, k4, k4) + w + d5f(k1, k2, k4, k3, k4) = d5f(k1, k2, k4, k3, k4) + w + d5f(k1, k4, k2, k3, k4) = d5f(k1, k4, k2, k3, k4) + w + d5f(k4, k1, k2, k3, k4) = d5f(k4, k1, k2, k3, k4) + w + d5f(k1, k2, k4, k4, k3) = d5f(k1, k2, k4, k4, k3) + w + d5f(k1, k4, k2, k4, k3) = d5f(k1, k4, k2, k4, k3) + w + d5f(k4, k1, k2, k4, k3) = d5f(k4, k1, k2, k4, k3) + w + d5f(k1, k4, k4, k2, k3) = d5f(k1, k4, k4, k2, k3) + w + d5f(k4, k1, k4, k2, k3) = d5f(k4, k1, k4, k2, k3) + w + d5f(k4, k4, k1, k2, k3) = d5f(k4, k4, k1, k2, k3) + w ENDDO w = v(k1)*d3 - d5f(k1, k2, k2, k3, k3) = d5f(k1, k2, k2, k3, k3)+w - d5f(k1, k2, k3, k2, k3) = d5f(k1, k2, k3, k2, k3)+w - d5f(k1, k2, k3, k3, k2) = d5f(k1, k2, k3, k3, k2)+w - d5f(k2, k1, k2, k3, k3) = d5f(k2, k1, k2, k3, k3)+w - d5f(k2, k1, k3, k2, k3) = d5f(k2, k1, k3, k2, k3)+w - d5f(k2, k1, k3, k3, k2) = d5f(k2, k1, k3, k3, k2)+w - d5f(k2, k2, k1, k3, k3) = d5f(k2, k2, k1, k3, k3)+w - d5f(k2, k3, k1, k2, k3) = d5f(k2, k3, k1, k2, k3)+w - d5f(k2, k3, k1, k3, k2) = d5f(k2, k3, k1, k3, k2)+w - d5f(k2, k2, k3, k1, k3) = d5f(k2, k2, k3, k1, k3)+w - d5f(k2, k3, k2, k1, k3) = d5f(k2, k3, k2, k1, k3)+w - d5f(k2, k3, k3, k1, k2) = d5f(k2, k3, k3, k1, k2)+w - d5f(k2, k2, k3, k3, k1) = d5f(k2, k2, k3, k3, k1)+w - d5f(k2, k3, k2, k3, k1) = d5f(k2, k3, k2, k3, k1)+w - d5f(k2, k3, k3, k2, k1) = d5f(k2, k3, k3, k2, k1)+w + d5f(k1, k2, k2, k3, k3) = d5f(k1, k2, k2, k3, k3) + w + d5f(k1, k2, k3, k2, k3) = d5f(k1, k2, k3, k2, k3) + w + d5f(k1, k2, k3, k3, k2) = d5f(k1, k2, k3, k3, k2) + w + d5f(k2, k1, k2, k3, k3) = d5f(k2, k1, k2, k3, k3) + w + d5f(k2, k1, k3, k2, k3) = d5f(k2, k1, k3, k2, k3) + w + d5f(k2, k1, k3, k3, k2) = d5f(k2, k1, k3, k3, k2) + w + d5f(k2, k2, k1, k3, k3) = d5f(k2, k2, k1, k3, k3) + w + d5f(k2, k3, k1, k2, k3) = d5f(k2, k3, k1, k2, k3) + w + d5f(k2, k3, k1, k3, k2) = d5f(k2, k3, k1, k3, k2) + w + d5f(k2, k2, k3, k1, k3) = d5f(k2, k2, k3, k1, k3) + w + d5f(k2, k3, k2, k1, k3) = d5f(k2, k3, k2, k1, k3) + w + d5f(k2, k3, k3, k1, k2) = d5f(k2, k3, k3, k1, k2) + w + d5f(k2, k2, k3, k3, k1) = d5f(k2, k2, k3, k3, k1) + w + d5f(k2, k3, k2, k3, k1) = d5f(k2, k3, k2, k3, k1) + w + d5f(k2, k3, k3, k2, k1) = d5f(k2, k3, k3, k2, k1) + w ENDDO ENDDO ENDDO @@ -1198,25 +1198,25 @@ SUBROUTINE makeCoulE0(sepi, Coul, se_int_control) mp = pw_grid%mapm%pos(pw_grid%g_hat(2, gpt)) np = pw_grid%mapn%pos(pw_grid%g_hat(3, gpt)) - lp = lp+bds(1, 1) - mp = mp+bds(1, 2) - np = np+bds(1, 3) + lp = lp + bds(1, 1) + mp = mp + bds(1, 2) + np = np + bds(1, 3) IF (pw_grid%gsq(gpt) == 0.0_dp) CYCLE kk(:) = pw_grid%g(:, gpt) ff = 2.0_dp*fourpi*rho0(lp, mp, np)**2*pw_grid%vol/pw_grid%gsq(gpt) - f = f+ff + f = f + ff DO k2 = 1, 3 DO k1 = 1, 3 - d2f(k1, k2) = d2f(k1, k2)-kk(k1)*kk(k2)*ff + d2f(k1, k2) = d2f(k1, k2) - kk(k1)*kk(k2)*ff ENDDO ENDDO DO k4 = 1, 3 DO k3 = 1, 3 DO k2 = 1, 3 DO k1 = 1, 3 - d4f(k1, k2, k3, k4) = d4f(k1, k2, k3, k4)+kk(k1)*kk(k2)*kk(k3)*kk(k4)*ff + d4f(k1, k2, k3, k4) = d4f(k1, k2, k3, k4) + kk(k1)*kk(k2)*kk(k3)*kk(k4)*ff ENDDO ENDDO ENDDO @@ -1224,13 +1224,13 @@ SUBROUTINE makeCoulE0(sepi, Coul, se_int_control) ENDDO - DO imA = 1, (sepi%natorb*(sepi%natorb+1))/2 - DO imB = 1, (sepi%natorb*(sepi%natorb+1))/2 + DO imA = 1, (sepi%natorb*(sepi%natorb + 1))/2 + DO imB = 1, (sepi%natorb*(sepi%natorb + 1))/2 w = M0A(imA)*M0A(imB)*f DO k2 = 1, 3 DO k1 = 1, 3 - w = w+(M2A(k1, k2, imA)*M0A(imB)-M1A(k1, imA)*M1A(k2, imB)+M0A(imA)*M2A(k1, k2, imB))*d2f(k1, k2) + w = w + (M2A(k1, k2, imA)*M0A(imB) - M1A(k1, imA)*M1A(k2, imB) + M0A(imA)*M2A(k1, k2, imB))*d2f(k1, k2) ENDDO ENDDO @@ -1238,7 +1238,7 @@ SUBROUTINE makeCoulE0(sepi, Coul, se_int_control) DO k3 = 1, 3 DO k2 = 1, 3 DO k1 = 1, 3 - w = w+M2A(k1, k2, imA)*M2A(k3, k4, imB)*d4f(k1, k2, k3, k4) + w = w + M2A(k1, k2, imA)*M2A(k3, k4, imB)*d4f(k1, k2, k3, k4) ENDDO ENDDO ENDDO @@ -1249,35 +1249,35 @@ SUBROUTINE makeCoulE0(sepi, Coul, se_int_control) ENDDO ENDDO - DO imA = 1, (sepi%natorb*(sepi%natorb+1))/2 - DO imB = 1, (sepi%natorb*(sepi%natorb+1))/2 + DO imA = 1, (sepi%natorb*(sepi%natorb + 1))/2 + DO imB = 1, (sepi%natorb*(sepi%natorb + 1))/2 w = -M0A(imA)*M0A(imB)*0.25_dp*fourpi/(pw_grid%vol*alpha**2) - Coul(imA, imB) = Coul(imA, imB)+w + Coul(imA, imB) = Coul(imA, imB) + w ENDDO ENDDO - DO imA = 1, (sepi%natorb*(sepi%natorb+1))/2 - DO imB = 1, (sepi%natorb*(sepi%natorb+1))/2 + DO imA = 1, (sepi%natorb*(sepi%natorb + 1))/2 + DO imB = 1, (sepi%natorb*(sepi%natorb + 1))/2 w = M0A(imA)*M0A(imB) - Coul(imA, imB) = Coul(imA, imB)-2.0_dp*alpha*oorootpi*w + Coul(imA, imB) = Coul(imA, imB) - 2.0_dp*alpha*oorootpi*w w = 0.0_dp DO k1 = 1, 3 - w = w+M1A(k1, imA)*M1A(k1, imB) - w = w-M0A(imA)*M2A(k1, k1, imB) - w = w-M2A(k1, k1, imA)*M0A(imB) + w = w + M1A(k1, imA)*M1A(k1, imB) + w = w - M0A(imA)*M2A(k1, k1, imB) + w = w - M2A(k1, k1, imA)*M0A(imB) ENDDO - Coul(imA, imB) = Coul(imA, imB)-4.0_dp*alpha**3*oorootpi*w/3.0_dp + Coul(imA, imB) = Coul(imA, imB) - 4.0_dp*alpha**3*oorootpi*w/3.0_dp w = 0.0_dp DO k2 = 1, 3 DO k1 = 1, 3 - w = w+2.0_dp*M2A(k1, k2, imA)*M2A(k1, k2, imB) - w = w+M2A(k1, k1, imA)*M2A(k2, k2, imB) + w = w + 2.0_dp*M2A(k1, k2, imA)*M2A(k1, k2, imB) + w = w + M2A(k1, k1, imA)*M2A(k2, k2, imB) ENDDO ENDDO - Coul(imA, imB) = Coul(imA, imB)-8.0_dp*alpha**5*oorootpi*w/5.0_dp + Coul(imA, imB) = Coul(imA, imB) - 8.0_dp*alpha**5*oorootpi*w/5.0_dp ENDDO ENDDO END SUBROUTINE makeCoulE0 diff --git a/src/semi_empirical_int_num.F b/src/semi_empirical_int_num.F index dfbdb042f7..b270ec132d 100644 --- a/src/semi_empirical_int_num.F +++ b/src/semi_empirical_int_num.F @@ -139,27 +139,27 @@ SUBROUTINE rotint_num(sepi, sepj, rijv, w, se_int_control, se_taper) ! (SS/) i = 1 j = 1 - iw_loc = (indexb(i, j)-1)*limkl+kl + iw_loc = (indexb(i, j) - 1)*limkl + kl ww(iw_loc) = wrepp CASE (2) ! (SP/) j = 1 DO i = 1, 3 - iw_loc = (indexb(i+1, j)-1)*limkl+kl - ww(iw_loc) = ww(iw_loc)+ij_matrix%sp(i1-1, i)*wrepp + iw_loc = (indexb(i + 1, j) - 1)*limkl + kl + ww(iw_loc) = ww(iw_loc) + ij_matrix%sp(i1 - 1, i)*wrepp END DO CASE (3) ! (PP/) DO i = 1, 3 - cc = ij_matrix%pp(i, i1-1, j1-1) - iw_loc = (indexb(i+1, i+1)-1)*limkl+kl - ww(iw_loc) = ww(iw_loc)+cc*wrepp - iminus = i-1 + cc = ij_matrix%pp(i, i1 - 1, j1 - 1) + iw_loc = (indexb(i + 1, i + 1) - 1)*limkl + kl + ww(iw_loc) = ww(iw_loc) + cc*wrepp + iminus = i - 1 IF (iminus /= 0) THEN DO j = 1, iminus - cc = ij_matrix%pp(1+i+j, i1-1, j1-1) - iw_loc = (indexb(i+1, j+1)-1)*limkl+kl - ww(iw_loc) = ww(iw_loc)+cc*wrepp + cc = ij_matrix%pp(1 + i + j, i1 - 1, j1 - 1) + iw_loc = (indexb(i + 1, j + 1) - 1)*limkl + kl + ww(iw_loc) = ww(iw_loc) + cc*wrepp END DO END IF END DO @@ -167,31 +167,31 @@ SUBROUTINE rotint_num(sepi, sepj, rijv, w, se_int_control, se_taper) ! (SD/) j = 1 DO i = 1, 5 - iw_loc = (indexb(i+4, j)-1)*limkl+kl - ww(iw_loc) = ww(iw_loc)+ij_matrix%sd(i1-4, i)*wrepp + iw_loc = (indexb(i + 4, j) - 1)*limkl + kl + ww(iw_loc) = ww(iw_loc) + ij_matrix%sd(i1 - 4, i)*wrepp END DO CASE (5) ! (DP/) DO i = 1, 5 DO j = 1, 3 - iw_loc = (indexb(i+4, j+1)-1)*limkl+kl - ij1 = 3*(i-1)+j - ww(iw_loc) = ww(iw_loc)+ij_matrix%pd(ij1, i1-4, j1-1)*wrepp + iw_loc = (indexb(i + 4, j + 1) - 1)*limkl + kl + ij1 = 3*(i - 1) + j + ww(iw_loc) = ww(iw_loc) + ij_matrix%pd(ij1, i1 - 4, j1 - 1)*wrepp END DO END DO CASE (6) ! (DD/) DO i = 1, 5 - cc = ij_matrix%dd(i, i1-4, j1-4) - iw_loc = (indexb(i+4, i+4)-1)*limkl+kl - ww(iw_loc) = ww(iw_loc)+cc*wrepp - iminus = i-1 + cc = ij_matrix%dd(i, i1 - 4, j1 - 4) + iw_loc = (indexb(i + 4, i + 4) - 1)*limkl + kl + ww(iw_loc) = ww(iw_loc) + cc*wrepp + iminus = i - 1 IF (iminus /= 0) THEN DO j = 1, iminus ij1 = inddd(i, j) - cc = ij_matrix%dd(ij1, i1-4, j1-4) - iw_loc = (indexb(i+4, j+4)-1)*limkl+kl - ww(iw_loc) = ww(iw_loc)+cc*wrepp + cc = ij_matrix%dd(ij1, i1 - 4, j1 - 4) + iw_loc = (indexb(i + 4, j + 4) - 1)*limkl + kl + ww(iw_loc) = ww(iw_loc) + cc*wrepp END DO END IF END DO @@ -438,10 +438,10 @@ SUBROUTINE rotnuc_num(sepi, sepj, rijv, e1b, e2a, itype, se_int_control, se_tape DO n = 1, 2 IF (.NOT. task(n)) CYCLE DO i = 1, last_orbital(n) - ind1 = i-1 + ind1 = i - 1 DO j = 1, i - ind2 = j-1 - m = (i*(i-1))/2+j + ind2 = j - 1 + m = (i*(i - 1))/2 + j ! Perform Rotations ... IF (ind2 == 0) THEN IF (ind1 == 0) THEN @@ -452,26 +452,26 @@ SUBROUTINE rotnuc_num(sepi, sepj, rijv, e1b, e2a, itype, se_int_control, se_tape tmp(m) = ij_matrix%sp(1, ind1)*core(2, n) ELSE ! Type of Integral (SD/) - tmp(m) = ij_matrix%sd(1, ind1-3)*core(5, n) + tmp(m) = ij_matrix%sd(1, ind1 - 3)*core(5, n) END IF ELSE IF (ind2 < 4) THEN IF (ind1 < 4) THEN ! Type of Integral (PP/) ipp = indpp(ind1, ind2) - tmp(m) = core(3, n)*ij_matrix%pp(ipp, 1, 1)+ & - core(4, n)*(ij_matrix%pp(ipp, 2, 2)+ij_matrix%pp(ipp, 3, 3)) + tmp(m) = core(3, n)*ij_matrix%pp(ipp, 1, 1) + & + core(4, n)*(ij_matrix%pp(ipp, 2, 2) + ij_matrix%pp(ipp, 3, 3)) ELSE ! Type of Integral (PD/) - idp = inddp(ind1-3, ind2) - tmp(m) = core(6, n)*ij_matrix%pd(idp, 1, 1)+ & - core(8, n)*(ij_matrix%pd(idp, 2, 2)+ij_matrix%pd(idp, 3, 3)) + idp = inddp(ind1 - 3, ind2) + tmp(m) = core(6, n)*ij_matrix%pd(idp, 1, 1) + & + core(8, n)*(ij_matrix%pd(idp, 2, 2) + ij_matrix%pd(idp, 3, 3)) END IF ELSE ! Type of Integral (DD/) - idd = inddd(ind1-3, ind2-3) - tmp(m) = core(7, n)*ij_matrix%dd(idd, 1, 1)+ & - core(9, n)*(ij_matrix%dd(idd, 2, 2)+ij_matrix%dd(idd, 3, 3))+ & - core(10, n)*(ij_matrix%dd(idd, 4, 4)+ij_matrix%dd(idd, 5, 5)) + idd = inddd(ind1 - 3, ind2 - 3) + tmp(m) = core(7, n)*ij_matrix%dd(idd, 1, 1) + & + core(9, n)*(ij_matrix%dd(idd, 2, 2) + ij_matrix%dd(idd, 3, 3)) + & + core(10, n)*(ij_matrix%dd(idd, 4, 4) + ij_matrix%dd(idd, 5, 5)) END IF END DO END DO @@ -546,12 +546,12 @@ SUBROUTINE corecore_num(sepi, sepj, rijv, enuc, itype, se_int_control, se_taper) IF (itype /= do_method_pm6 .AND. itype /= do_method_pm6fm) THEN alpi = sepi%alp alpj = sepj%alp - scale = EXP(-alpi*rij)+EXP(-alpj*rij) + scale = EXP(-alpi*rij) + EXP(-alpj*rij) - nt = sepi%z+sepj%z + nt = sepi%z + sepj%z IF (nt == 8 .OR. nt == 9) THEN - IF (sepi%z == 7 .OR. sepi%z == 8) scale = scale+(angstrom*rij-1._dp)*EXP(-alpi*rij) - IF (sepj%z == 7 .OR. sepj%z == 8) scale = scale+(angstrom*rij-1._dp)*EXP(-alpj*rij) + IF (sepi%z == 7 .OR. sepi%z == 8) scale = scale + (angstrom*rij - 1._dp)*EXP(-alpi*rij) + IF (sepj%z == 7 .OR. sepj%z == 8) scale = scale + (angstrom*rij - 1._dp)*EXP(-alpj*rij) ENDIF scale = ABS(scale*zz*ssss) zz = zz/rij @@ -599,15 +599,15 @@ SUBROUTINE corecore_num(sepi, sepj, rijv, enuc, itype, se_int_control, se_taper) ! AM1/PM3/PDG correction to nuclear repulsion DO ig = 1, SIZE(fni1) IF (ABS(fni1(ig)) > 0._dp) THEN - ax = fni2(ig)*(rij-fni3(ig))**2 + ax = fni2(ig)*(rij - fni3(ig))**2 IF (ax <= 25._dp) THEN - scale = scale+zz*fni1(ig)*EXP(-ax) + scale = scale + zz*fni1(ig)*EXP(-ax) ENDIF ENDIF IF (ABS(fnj1(ig)) > 0._dp) THEN - ax = fnj2(ig)*(rij-fnj3(ig))**2 + ax = fnj2(ig)*(rij - fnj3(ig))**2 IF (ax <= 25._dp) THEN - scale = scale+zz*fnj1(ig)*EXP(-ax) + scale = scale + zz*fnj1(ig)*EXP(-ax) ENDIF ENDIF END DO @@ -626,10 +626,10 @@ SUBROUTINE corecore_num(sepi, sepj, rijv, enuc, itype, se_int_control, se_taper) dbj = sepj%d(2) apdg = 10._dp*angstrom**2 qcorr = & - (zaf*pai+zbf*paj)*EXP(-apdg*(rij-dai-daj)**2)+ & - (zaf*pai+zbf*pbj)*EXP(-apdg*(rij-dai-dbj)**2)+ & - (zaf*pbi+zbf*paj)*EXP(-apdg*(rij-dbi-daj)**2)+ & - (zaf*pbi+zbf*pbj)*EXP(-apdg*(rij-dbi-dbj)**2) + (zaf*pai + zbf*paj)*EXP(-apdg*(rij - dai - daj)**2) + & + (zaf*pai + zbf*pbj)*EXP(-apdg*(rij - dai - dbj)**2) + & + (zaf*pbi + zbf*paj)*EXP(-apdg*(rij - dbi - daj)**2) + & + (zaf*pbi + zbf*pbj)*EXP(-apdg*(rij - dbi - dbj)**2) ELSEIF (itype == do_method_pchg) THEN qcorr = 0.0_dp scale = 0.0_dp @@ -648,24 +648,24 @@ SUBROUTINE corecore_num(sepi, sepj, rijv, enuc, itype, se_int_control, se_taper) scale = scale*(2._dp*xab*EXP(-aab*rija*rija)) ELSEIF (sepi%z == 6 .AND. sepj%z == 6) THEN ! Special Case C-C - scale = scale*(2._dp*xab*EXP(-aab*(rija+0.0003_dp*rija**6))+9.28_dp*EXP(-5.98_dp*rija)) + scale = scale*(2._dp*xab*EXP(-aab*(rija + 0.0003_dp*rija**6)) + 9.28_dp*EXP(-5.98_dp*rija)) ELSEIF ((sepi%z == 8 .AND. sepj%z == 14) .OR. & (sepj%z == 8 .AND. sepi%z == 14)) THEN ! Special Case Si-O - scale = scale*(2._dp*xab*EXP(-aab*(rija+0.0003_dp*rija**6))-0.0007_dp*EXP(-(rija-2.9_dp)**2)) + scale = scale*(2._dp*xab*EXP(-aab*(rija + 0.0003_dp*rija**6)) - 0.0007_dp*EXP(-(rija - 2.9_dp)**2)) ELSE ! General Case ! Factor of 2 found by experiment - scale = scale*(2._dp*xab*EXP(-aab*(rija+0.0003_dp*rija**6))) + scale = scale*(2._dp*xab*EXP(-aab*(rija + 0.0003_dp*rija**6))) END IF ! General correction term a*exp(-b*(rij-c)^2) - qcorr = (sepi%a*EXP(-sepi%b*(rij-sepi%c)**2))*sepi%zeff*sepj%zeff/rij+ & - (sepj%a*EXP(-sepj%b*(rij-sepj%c)**2))*sepi%zeff*sepj%zeff/rij + qcorr = (sepi%a*EXP(-sepi%b*(rij - sepi%c)**2))*sepi%zeff*sepj%zeff/rij + & + (sepj%a*EXP(-sepj%b*(rij - sepj%c)**2))*sepi%zeff*sepj%zeff/rij ! Hard core repulsion - tmp = (REAL(sepi%z, dp)**(1._dp/3._dp)+REAL(sepj%z, dp)**(1._dp/3._dp)) - qcorr = qcorr+1.e-8_dp/evolt*(tmp/rija)**12 + tmp = (REAL(sepi%z, dp)**(1._dp/3._dp) + REAL(sepj%z, dp)**(1._dp/3._dp)) + qcorr = qcorr + 1.e-8_dp/evolt*(tmp/rija)**12 END IF - enuc = enuc+scale+qcorr + enuc = enuc + scale + qcorr END IF END SUBROUTINE corecore_num @@ -1027,12 +1027,12 @@ SUBROUTINE drotint_num(sepi, sepj, r, dw, delta, se_int_control, se_taper) nsize = sepi%atm_int_size*sepj%atm_int_size DO i = 1, 3 rr = r - rr(i) = rr(i)+delta + rr(i) = rr(i) + delta CALL rotint_num(sepi, sepj, rr, wp, se_int_control, se_taper=se_taper) - rr(i) = rr(i)-2._dp*delta + rr(i) = rr(i) - 2._dp*delta CALL rotint_num(sepi, sepj, rr, wm, se_int_control, se_taper=se_taper) DO j = 1, nsize - dw(i, j) = od*(wp(j)-wm(j)) + dw(i, j) = od*(wp(j) - wm(j)) END DO END DO @@ -1073,18 +1073,18 @@ SUBROUTINE drotnuc_num(sepi, sepj, r, de1b, de2a, itype, delta, se_int_control, od = 0.5_dp/delta DO i = 1, 3 rr = r - rr(i) = rr(i)+delta + rr(i) = rr(i) + delta CALL rotnuc_num(sepi, sepj, rr, e1p, e2p, itype, se_int_control, se_taper=se_taper) - rr(i) = rr(i)-2._dp*delta + rr(i) = rr(i) - 2._dp*delta CALL rotnuc_num(sepi, sepj, rr, e1m, e2m, itype, se_int_control, se_taper=se_taper) IF (l_de1b) THEN DO j = 1, sepi%atm_int_size - de1b(i, j) = od*(e1p(j)-e1m(j)) + de1b(i, j) = od*(e1p(j) - e1m(j)) END DO END IF IF (l_de2a) THEN DO j = 1, sepj%atm_int_size - de2a(i, j) = od*(e2p(j)-e2m(j)) + de2a(i, j) = od*(e2p(j) - e2m(j)) END DO END IF END DO @@ -1119,11 +1119,11 @@ SUBROUTINE dcorecore_num(sepi, sepj, r, denuc, itype, delta, se_int_control, se_ od = 0.5_dp/delta DO i = 1, 3 rr = r - rr(i) = rr(i)+delta + rr(i) = rr(i) + delta CALL corecore_num(sepi, sepj, rr, enucp, itype, se_int_control, se_taper=se_taper) - rr(i) = rr(i)-2._dp*delta + rr(i) = rr(i) - 2._dp*delta CALL corecore_num(sepi, sepj, rr, enucm, itype, se_int_control, se_taper=se_taper) - denuc(i) = od*(enucp-enucm) + denuc(i) = od*(enucp - enucm) END DO END SUBROUTINE dcorecore_num @@ -1157,11 +1157,11 @@ SUBROUTINE dcorecore_el_num(sepi, sepj, r, denuc, itype, delta, se_int_control, od = 0.5_dp/delta DO i = 1, 3 rr = r - rr(i) = rr(i)+delta + rr(i) = rr(i) + delta CALL corecore_el_num(sepi, sepj, rr, enucp, itype, se_int_control, se_taper=se_taper) - rr(i) = rr(i)-2._dp*delta + rr(i) = rr(i) - 2._dp*delta CALL corecore_el_num(sepi, sepj, rr, enucm, itype, se_int_control, se_taper=se_taper) - denuc(i) = od*(enucp-enucm) + denuc(i) = od*(enucp - enucm) END DO END SUBROUTINE dcorecore_el_num diff --git a/src/semi_empirical_int_utils.F b/src/semi_empirical_int_utils.F index 014903551a..8dad3527b7 100644 --- a/src/semi_empirical_int_utils.F +++ b/src/semi_empirical_int_utils.F @@ -82,8 +82,8 @@ FUNCTION ijkl_sp(sepi, sepj, ij, kl, li, lj, lk, ll, ic, r, se_int_control, & IF ((.NOT. se_int_control%pc_coulomb_int) .AND. (itype /= do_method_pchg)) THEN ! Handle the 1/r^3 term, this term is ALWAYS false for KDSO-D integrals IF (se_int_control%shortrange .AND. se_int_control%do_ewald_r3) THEN - res = res-ijkl_low_3(sepi, sepj, ij, kl, li, lj, lk, ll, ic, & - itype, charg_int_3) + res = res - ijkl_low_3(sepi, sepj, ij, kl, li, lj, lk, ll, ic, & + itype, charg_int_3) END IF END IF END FUNCTION ijkl_sp @@ -136,7 +136,7 @@ FUNCTION d_ijkl_sp(sepi, sepj, ij, kl, li, lj, lk, ll, ic, r, se_int_control, & dfs = ijkl_sp_low(sepi, sepj, ij, kl, li, lj, lk, ll, ic, r, se_int_screen, & se_int_control%integral_screening, .FALSE., .FALSE., & se_int_control%max_multipole, itype, dcharg_int_nri_fs) - res = res+dfs*se_int_screen%dft + res = res + dfs*se_int_screen%dft ! In case we need the shortrange part we have to evaluate an additional derivative ! to handle the derivative of the Tapering term @@ -144,7 +144,7 @@ FUNCTION d_ijkl_sp(sepi, sepj, ij, kl, li, lj, lk, ll, ic, r, se_int_control, & srd = ijkl_sp_low(sepi, sepj, ij, kl, li, lj, lk, ll, ic, r, se_int_screen, & se_int_control%integral_screening, .FALSE., .TRUE., & se_int_control%max_multipole, itype, dcharg_int_nri) - res = res-srd + res = res - srd END IF END IF ELSE @@ -158,8 +158,8 @@ FUNCTION d_ijkl_sp(sepi, sepj, ij, kl, li, lj, lk, ll, ic, r, se_int_control, & IF ((.NOT. se_int_control%pc_coulomb_int) .AND. (itype /= do_method_pchg)) THEN ! Handle the 1/r^3 term, this term is ALWAYS false for KDSO-D integrals IF (se_int_control%shortrange .AND. se_int_control%do_ewald_r3) THEN - res = res-ijkl_low_3(sepi, sepj, ij, kl, li, lj, lk, ll, ic, & - itype, dcharg_int_3) + res = res - ijkl_low_3(sepi, sepj, ij, kl, li, lj, lk, ll, ic, & + itype, dcharg_int_3) END IF END IF @@ -212,12 +212,12 @@ FUNCTION ijkl_sp_low(sepi, sepj, ij, kl, li, lj, lk, ll, ic, r, se_int_screen, & REAL(KIND=dp) :: add, chrg, dij, dkl, fact_ij, fact_kl, & fact_screen, pij, pkl, s1, sum - l1min = ABS(li-lj) - l1max = li+lj - lij = indexb(li+1, lj+1) - l2min = ABS(lk-ll) - l2max = lk+ll - lkl = indexb(lk+1, ll+1) + l1min = ABS(li - lj) + l1max = li + lj + lij = indexb(li + 1, lj + 1) + l2min = ABS(lk - ll) + l2max = lk + ll + lkl = indexb(lk + 1, ll + 1) l1max = MIN(l1max, 2) l1min = MIN(l1min, 2) @@ -266,7 +266,7 @@ FUNCTION ijkl_sp_low(sepi, sepj, ij, kl, li, lj, lk, ll, ic, r, se_int_screen, & IF (itype == do_method_pchg) THEN add = 0.0_dp ELSE - add = (pij+pkl)**2 + add = (pij + pkl)**2 END IF lmin = MAX(l1, l2) s1 = 0.0_dp @@ -274,10 +274,10 @@ FUNCTION ijkl_sp_low(sepi, sepj, ij, kl, li, lj, lk, ll, ic, r, se_int_screen, & ccc = clm_sp(ij, l1, m)*clm_sp(kl, l2, m) IF (ABS(ccc) > EPSILON(0.0_dp)) THEN chrg = eval(r, l1, l2, clm_sp(ij, l1, m), clm_sp(kl, l2, m), dij, dkl, add, fact_screen) - s1 = s1+chrg + s1 = s1 + chrg END IF END DO - sum = sum+s1 + sum = sum + s1 END DO END DO res = sum @@ -306,14 +306,14 @@ FUNCTION ijkl_sp_low(sepi, sepj, ij, kl, li, lj, lk, ll, ic, r, se_int_screen, & ccc = clm_sp(ij, l1, m)*clm_sp(kl, l2, m) IF (ABS(ccc) > EPSILON(0.0_dp)) THEN chrg = eval(r, l1, l2, clm_sp(ij, l1, m), clm_sp(kl, l2, m), dij, dkl, add, fact_screen) - s1 = s1+chrg + s1 = s1 + chrg END IF END DO - sum = sum+s1 + sum = sum + s1 END DO END DO IF (pc_coulomb_int) res = sum - IF (shortrange) res = res-sum + IF (shortrange) res = res - sum END IF END FUNCTION ijkl_sp_low @@ -370,7 +370,7 @@ FUNCTION charg_int_nri(r, l1_i, l2_i, m1_i, m2_i, da_i, db_i, add0, fact_screen) m2 = m1_i da = db_i db = da_i - fact = (-1.0_dp)**(l1+l2) + fact = (-1.0_dp)**(l1 + l2) ELSE IF (l1_i == l2_i) THEN l1 = l1_i l2 = l2_i @@ -391,86 +391,86 @@ FUNCTION charg_int_nri(r, l1_i, l2_i, m1_i, m2_i, da_i, db_i, add0, fact_screen) charg = 0.0_dp ! Q - Q. IF (l1 == 0 .AND. l2 == 0) THEN - charg = fact/SQRT(r**2+add) + charg = fact/SQRT(r**2 + add) RETURN END IF ! Q - Z. IF (l1 == 0 .AND. l2 == 1 .AND. m2 == CLMz) THEN - charg = 1.0_dp/SQRT((r+db)**2+add)-1.0_dp/SQRT((r-db)**2+add) + charg = 1.0_dp/SQRT((r + db)**2 + add) - 1.0_dp/SQRT((r - db)**2 + add) charg = charg*0.5_dp*fact RETURN END IF ! Z - Z. IF (l1 == 1 .AND. l2 == 1 .AND. m1 == CLMz .AND. m2 == CLMz) THEN dzdz = & - +1.0_dp/SQRT((r+da-db)**2+add)+1.0_dp/SQRT((r-da+db)**2+add) & - -1.0_dp/SQRT((r-da-db)**2+add)-1.0_dp/SQRT((r+da+db)**2+add) + +1.0_dp/SQRT((r + da - db)**2 + add) + 1.0_dp/SQRT((r - da + db)**2 + add) & + - 1.0_dp/SQRT((r - da - db)**2 + add) - 1.0_dp/SQRT((r + da + db)**2 + add) charg = dzdz*0.25_dp*fact RETURN END IF ! X - X IF (l1 == 1 .AND. l2 == 1 .AND. m1 == CLMp .AND. m2 == CLMp) THEN - dxdx = 2.0_dp/SQRT(r**2+(da-db)**2+add)-2.0_dp/SQRT(r**2+(da+db)**2+add) + dxdx = 2.0_dp/SQRT(r**2 + (da - db)**2 + add) - 2.0_dp/SQRT(r**2 + (da + db)**2 + add) charg = dxdx*0.25_dp*fact RETURN END IF ! Q - ZZ IF (l1 == 0 .AND. l2 == 2 .AND. m2 == CLMzz) THEN - qqzz = 1.0_dp/SQRT((r-db)**2+add)-2.0_dp/SQRT(r**2+add)+1.0_dp/SQRT((r+db)**2+add) + qqzz = 1.0_dp/SQRT((r - db)**2 + add) - 2.0_dp/SQRT(r**2 + add) + 1.0_dp/SQRT((r + db)**2 + add) charg = qqzz*0.25_dp*fact RETURN END IF ! Q - XX IF (l1 == 0 .AND. l2 == 2 .AND. (m2 == CLMyy .OR. m2 == CLMxx)) THEN - qqxx = -1.0_dp/SQRT(r**2+add)+1.0_dp/SQRT(r**2+add+db**2) + qqxx = -1.0_dp/SQRT(r**2 + add) + 1.0_dp/SQRT(r**2 + add + db**2) charg = qqxx*0.5_dp*fact RETURN END IF ! Z - ZZ IF (l1 == 1 .AND. l2 == 2 .AND. m1 == CLMz .AND. m2 == CLMzz) THEN dzqzz = & - +1.0_dp/SQRT((r-da-db)**2+add)-2.0_dp/SQRT((r-da)**2+add) & - +1.0_dp/SQRT((r-da+db)**2+add)-1.0_dp/SQRT((r+da-db)**2+add) & - +2.0_dp/SQRT((r+da)**2+add)-1.0_dp/SQRT((r+da+db)**2+add) + +1.0_dp/SQRT((r - da - db)**2 + add) - 2.0_dp/SQRT((r - da)**2 + add) & + + 1.0_dp/SQRT((r - da + db)**2 + add) - 1.0_dp/SQRT((r + da - db)**2 + add) & + + 2.0_dp/SQRT((r + da)**2 + add) - 1.0_dp/SQRT((r + da + db)**2 + add) charg = dzqzz*0.125_dp*fact RETURN END IF ! Z - XX IF (l1 == 1 .AND. l2 == 2 .AND. m1 == CLMz .AND. (m2 == CLMyy .OR. m2 == CLMxx)) THEN dzqxx = & - +1.0_dp/SQRT((r+da)**2+add)-1.0_dp/SQRT((r+da)**2+add+db**2) & - -1.0_dp/SQRT((r-da)**2+add)+1.0_dp/SQRT((r-da)**2+add+db**2) + +1.0_dp/SQRT((r + da)**2 + add) - 1.0_dp/SQRT((r + da)**2 + add + db**2) & + - 1.0_dp/SQRT((r - da)**2 + add) + 1.0_dp/SQRT((r - da)**2 + add + db**2) charg = dzqxx*0.25_dp*fact RETURN END IF ! ZZ - ZZ IF (l1 == 2 .AND. l2 == 2 .AND. m1 == CLMzz .AND. m2 == CLMzz) THEN zzzz = & - +1.0_dp/SQRT((r-da-db)**2+add)+1.0_dp/SQRT((r+da+db)**2+add) & - +1.0_dp/SQRT((r-da+db)**2+add)+1.0_dp/SQRT((r+da-db)**2+add) + +1.0_dp/SQRT((r - da - db)**2 + add) + 1.0_dp/SQRT((r + da + db)**2 + add) & + + 1.0_dp/SQRT((r - da + db)**2 + add) + 1.0_dp/SQRT((r + da - db)**2 + add) xyxy = & - +1.0_dp/SQRT((r-da)**2+add)+1.0_dp/SQRT((r+da)**2+add) & - +1.0_dp/SQRT((r-db)**2+add)+1.0_dp/SQRT((r+db)**2+add) & - -2.0_dp/SQRT(r**2+add) - charg = (zzzz*0.0625_dp-xyxy*0.125_dp)*fact + +1.0_dp/SQRT((r - da)**2 + add) + 1.0_dp/SQRT((r + da)**2 + add) & + + 1.0_dp/SQRT((r - db)**2 + add) + 1.0_dp/SQRT((r + db)**2 + add) & + - 2.0_dp/SQRT(r**2 + add) + charg = (zzzz*0.0625_dp - xyxy*0.125_dp)*fact RETURN END IF ! ZZ - XX IF (l1 == 2 .AND. l2 == 2 .AND. m1 == CLMzz .AND. (m2 == CLMxx .OR. m2 == CLMyy)) THEN zzzz = & - -1.0_dp/SQRT((r+da)**2+add)+1.0_dp/SQRT((r+da)**2+db**2+add) & - -1.0_dp/SQRT((r-da)**2+add)+1.0_dp/SQRT((r-da)**2+db**2+add) + -1.0_dp/SQRT((r + da)**2 + add) + 1.0_dp/SQRT((r + da)**2 + db**2 + add) & + - 1.0_dp/SQRT((r - da)**2 + add) + 1.0_dp/SQRT((r - da)**2 + db**2 + add) xyxy = & - +1.0_dp/SQRT(r**2+db**2+add)-1.0_dp/SQRT(r**2+add) - charg = (zzzz*0.125_dp-xyxy*0.25_dp)*fact + +1.0_dp/SQRT(r**2 + db**2 + add) - 1.0_dp/SQRT(r**2 + add) + charg = (zzzz*0.125_dp - xyxy*0.25_dp)*fact RETURN END IF ! X - ZX IF (l1 == 1 .AND. l2 == 2 .AND. m1 == CLMp .AND. m2 == CLMzp) THEN db = db/2.0_dp dxqxz = & - -1.0_dp/SQRT((r-db)**2+(da-db)**2+add)+1.0_dp/SQRT((r+db)**2+(da-db)**2+add) & - +1.0_dp/SQRT((r-db)**2+(da+db)**2+add)-1.0_dp/SQRT((r+db)**2+(da+db)**2+add) + -1.0_dp/SQRT((r - db)**2 + (da - db)**2 + add) + 1.0_dp/SQRT((r + db)**2 + (da - db)**2 + add) & + + 1.0_dp/SQRT((r - db)**2 + (da + db)**2 + add) - 1.0_dp/SQRT((r + db)**2 + (da + db)**2 + add) charg = dxqxz*0.25_dp*fact RETURN END IF @@ -479,40 +479,40 @@ FUNCTION charg_int_nri(r, l1_i, l2_i, m1_i, m2_i, da_i, db_i, add0, fact_screen) da = da/2.0_dp db = db/2.0_dp qxzqxz = & - +1.0_dp/SQRT((r+da-db)**2+(da-db)**2+add)-1.0_dp/SQRT((r+da+db)**2+(da-db)**2+add) & - -1.0_dp/SQRT((r-da-db)**2+(da-db)**2+add)+1.0_dp/SQRT((r-da+db)**2+(da-db)**2+add) & - -1.0_dp/SQRT((r+da-db)**2+(da+db)**2+add)+1.0_dp/SQRT((r+da+db)**2+(da+db)**2+add) & - +1.0_dp/SQRT((r-da-db)**2+(da+db)**2+add)-1.0_dp/SQRT((r-da+db)**2+(da+db)**2+add) + +1.0_dp/SQRT((r + da - db)**2 + (da - db)**2 + add) - 1.0_dp/SQRT((r + da + db)**2 + (da - db)**2 + add) & + - 1.0_dp/SQRT((r - da - db)**2 + (da - db)**2 + add) + 1.0_dp/SQRT((r - da + db)**2 + (da - db)**2 + add) & + - 1.0_dp/SQRT((r + da - db)**2 + (da + db)**2 + add) + 1.0_dp/SQRT((r + da + db)**2 + (da + db)**2 + add) & + + 1.0_dp/SQRT((r - da - db)**2 + (da + db)**2 + add) - 1.0_dp/SQRT((r - da + db)**2 + (da + db)**2 + add) charg = qxzqxz*0.125_dp*fact RETURN END IF ! XX - XX IF (l1 == 2 .AND. l2 == 2 .AND. (((m1 == CLMyy) .AND. (m2 == CLMyy)) .OR. ((m1 == CLMxx) .AND. (m2 == CLMxx)))) THEN qxxqxx = & - +2.0_dp/SQRT(r**2+add)+1.0_dp/SQRT(r**2+(da-db)**2+add) & - +1.0_dp/SQRT(r**2+(da+db)**2+add)-2.0_dp/SQRT(r**2+da**2+add) & - -2.0_dp/SQRT(r**2+db**2+add) + +2.0_dp/SQRT(r**2 + add) + 1.0_dp/SQRT(r**2 + (da - db)**2 + add) & + + 1.0_dp/SQRT(r**2 + (da + db)**2 + add) - 2.0_dp/SQRT(r**2 + da**2 + add) & + - 2.0_dp/SQRT(r**2 + db**2 + add) charg = qxxqxx*0.125_dp*fact RETURN END IF ! XX - YY IF (l1 == 2 .AND. l2 == 2 .AND. m1 == CLMyy .AND. m2 == CLMxx) THEN qxxqyy = & - +1.0_dp/SQRT(r**2+add)-1.0_dp/SQRT(r**2+da**2+add) & - -1.0_dp/SQRT(r**2+db**2+add)+1.0_dp/SQRT(r**2+da**2+db**2+add) + +1.0_dp/SQRT(r**2 + add) - 1.0_dp/SQRT(r**2 + da**2 + add) & + - 1.0_dp/SQRT(r**2 + db**2 + add) + 1.0_dp/SQRT(r**2 + da**2 + db**2 + add) charg = qxxqyy*0.25_dp*fact RETURN END IF ! XY - XY IF (l1 == 2 .AND. l2 == 2 .AND. m1 == CLMxy .AND. m2 == CLMxy) THEN qxxqxx = & - +2.0_dp/SQRT(r**2+add)+1.0_dp/SQRT(r**2+(da-db)**2+add) & - +1.0_dp/SQRT(r**2+(da+db)**2+add)-2.0_dp/SQRT(r**2+da**2+add) & - -2.0_dp/SQRT(r**2+db**2+add) + +2.0_dp/SQRT(r**2 + add) + 1.0_dp/SQRT(r**2 + (da - db)**2 + add) & + + 1.0_dp/SQRT(r**2 + (da + db)**2 + add) - 2.0_dp/SQRT(r**2 + da**2 + add) & + - 2.0_dp/SQRT(r**2 + db**2 + add) qxxqyy = & - +1.0_dp/SQRT(r**2+add)-1.0_dp/SQRT(r**2+da**2+add) & - -1.0_dp/SQRT(r**2+db**2+add)+1.0_dp/SQRT(r**2+da**2+db**2+add) - charg = 0.5_dp*(qxxqxx*0.125_dp-qxxqyy*0.25_dp)*fact + +1.0_dp/SQRT(r**2 + add) - 1.0_dp/SQRT(r**2 + da**2 + add) & + - 1.0_dp/SQRT(r**2 + db**2 + add) + 1.0_dp/SQRT(r**2 + da**2 + db**2 + add) + charg = 0.5_dp*(qxxqxx*0.125_dp - qxxqyy*0.25_dp)*fact RETURN END IF ! We should NEVER reach this point @@ -574,7 +574,7 @@ FUNCTION dcharg_int_nri(r, l1_i, l2_i, m1_i, m2_i, da_i, db_i, add0, fact_screen m2 = m1_i da = db_i db = da_i - fact = (-1.0_dp)**(l1+l2) + fact = (-1.0_dp)**(l1 + l2) ELSE IF (l1_i == l2_i) THEN l1 = l1_i l2 = l2_i @@ -595,86 +595,86 @@ FUNCTION dcharg_int_nri(r, l1_i, l2_i, m1_i, m2_i, da_i, db_i, add0, fact_screen add = add0*fact_screen ! Q - Q. IF (l1 == 0 .AND. l2 == 0) THEN - charg = r/SQRT(r**2+add)**3 + charg = r/SQRT(r**2 + add)**3 charg = -charg*fact RETURN END IF ! Q - Z. IF (l1 == 0 .AND. l2 == 1 .AND. m2 == CLMz) THEN - charg = (r+db)/SQRT((r+db)**2+add)**3-(r-db)/SQRT((r-db)**2+add)**3 + charg = (r + db)/SQRT((r + db)**2 + add)**3 - (r - db)/SQRT((r - db)**2 + add)**3 charg = -charg*0.5_dp*fact RETURN END IF ! Z - Z. IF (l1 == 1 .AND. l2 == 1 .AND. m1 == CLMz .AND. m2 == CLMz) THEN dzdz = & - +(r+da-db)/SQRT((r+da-db)**2+add)**3+(r-da+db)/SQRT((r-da+db)**2+add)**3 & - -(r-da-db)/SQRT((r-da-db)**2+add)**3-(r+da+db)/SQRT((r+da+db)**2+add)**3 + +(r + da - db)/SQRT((r + da - db)**2 + add)**3 + (r - da + db)/SQRT((r - da + db)**2 + add)**3 & + - (r - da - db)/SQRT((r - da - db)**2 + add)**3 - (r + da + db)/SQRT((r + da + db)**2 + add)**3 charg = -dzdz*0.25_dp*fact RETURN END IF ! X - X IF (l1 == 1 .AND. l2 == 1 .AND. m1 == CLMp .AND. m2 == CLMp) THEN - dxdx = 2.0_dp*r/SQRT(r**2+(da-db)**2+add)**3-2.0_dp*r/SQRT(r**2+(da+db)**2+add)**3 + dxdx = 2.0_dp*r/SQRT(r**2 + (da - db)**2 + add)**3 - 2.0_dp*r/SQRT(r**2 + (da + db)**2 + add)**3 charg = -dxdx*0.25_dp*fact RETURN END IF ! Q - ZZ IF (l1 == 0 .AND. l2 == 2 .AND. m2 == CLMzz) THEN - qqzz = (r-db)/SQRT((r-db)**2+add)**3-2.0_dp*r/SQRT(r**2+add)**3+(r+db)/SQRT((r+db)**2+add)**3 + qqzz = (r - db)/SQRT((r - db)**2 + add)**3 - 2.0_dp*r/SQRT(r**2 + add)**3 + (r + db)/SQRT((r + db)**2 + add)**3 charg = -qqzz*0.25_dp*fact RETURN END IF ! Q - XX IF (l1 == 0 .AND. l2 == 2 .AND. (m2 == CLMyy .OR. m2 == CLMxx)) THEN - qqxx = -r/SQRT(r**2+add)**3+r/SQRT(r**2+add+db**2)**3 + qqxx = -r/SQRT(r**2 + add)**3 + r/SQRT(r**2 + add + db**2)**3 charg = -qqxx*0.5_dp*fact RETURN END IF ! Z - ZZ IF (l1 == 1 .AND. l2 == 2 .AND. m1 == CLMz .AND. m2 == CLMzz) THEN dzqzz = & - +(r-da-db)/SQRT((r-da-db)**2+add)**3-2.0_dp*(r-da)/SQRT((r-da)**2+add)**3 & - +(r-da+db)/SQRT((r-da+db)**2+add)**3-(r+da-db)/SQRT((r+da-db)**2+add)**3 & - +2.0_dp*(r+da)/SQRT((r+da)**2+add)**3-(r+da+db)/SQRT((r+da+db)**2+add)**3 + +(r - da - db)/SQRT((r - da - db)**2 + add)**3 - 2.0_dp*(r - da)/SQRT((r - da)**2 + add)**3 & + + (r - da + db)/SQRT((r - da + db)**2 + add)**3 - (r + da - db)/SQRT((r + da - db)**2 + add)**3 & + + 2.0_dp*(r + da)/SQRT((r + da)**2 + add)**3 - (r + da + db)/SQRT((r + da + db)**2 + add)**3 charg = -dzqzz*0.125_dp*fact RETURN END IF ! Z - XX IF (l1 == 1 .AND. l2 == 2 .AND. m1 == CLMz .AND. (m2 == CLMyy .OR. m2 == CLMxx)) THEN dzqxx = & - +(r+da)/SQRT((r+da)**2+add)**3-(r+da)/SQRT((r+da)**2+add+db**2)**3 & - -(r-da)/SQRT((r-da)**2+add)**3+(r-da)/SQRT((r-da)**2+add+db**2)**3 + +(r + da)/SQRT((r + da)**2 + add)**3 - (r + da)/SQRT((r + da)**2 + add + db**2)**3 & + - (r - da)/SQRT((r - da)**2 + add)**3 + (r - da)/SQRT((r - da)**2 + add + db**2)**3 charg = -dzqxx*0.25_dp*fact RETURN END IF ! ZZ - ZZ IF (l1 == 2 .AND. l2 == 2 .AND. m1 == CLMzz .AND. m2 == CLMzz) THEN zzzz = & - +(r-da-db)/SQRT((r-da-db)**2+add)**3+(r+da+db)/SQRT((r+da+db)**2+add)**3 & - +(r-da+db)/SQRT((r-da+db)**2+add)**3+(r+da-db)/SQRT((r+da-db)**2+add)**3 + +(r - da - db)/SQRT((r - da - db)**2 + add)**3 + (r + da + db)/SQRT((r + da + db)**2 + add)**3 & + + (r - da + db)/SQRT((r - da + db)**2 + add)**3 + (r + da - db)/SQRT((r + da - db)**2 + add)**3 xyxy = & - +(r-da)/SQRT((r-da)**2+add)**3+(r+da)/SQRT((r+da)**2+add)**3 & - +(r-db)/SQRT((r-db)**2+add)**3+(r+db)/SQRT((r+db)**2+add)**3 & - -2.0_dp*r/SQRT(r**2+add)**3 - charg = -(zzzz*0.0625_dp-xyxy*0.125_dp)*fact + +(r - da)/SQRT((r - da)**2 + add)**3 + (r + da)/SQRT((r + da)**2 + add)**3 & + + (r - db)/SQRT((r - db)**2 + add)**3 + (r + db)/SQRT((r + db)**2 + add)**3 & + - 2.0_dp*r/SQRT(r**2 + add)**3 + charg = -(zzzz*0.0625_dp - xyxy*0.125_dp)*fact RETURN END IF ! ZZ - XX IF (l1 == 2 .AND. l2 == 2 .AND. m1 == CLMzz .AND. (m2 == CLMxx .OR. m2 == CLMyy)) THEN zzzz = & - -(r+da)/SQRT((r+da)**2+add)**3+(r+da)/SQRT((r+da)**2+db**2+add)**3 & - -(r-da)/SQRT((r-da)**2+add)**3+(r-da)/SQRT((r-da)**2+db**2+add)**3 - xyxy = r/SQRT(r**2+db**2+add)**3-r/SQRT(r**2+add)**3 - charg = -(zzzz*0.125_dp-xyxy*0.25_dp)*fact + -(r + da)/SQRT((r + da)**2 + add)**3 + (r + da)/SQRT((r + da)**2 + db**2 + add)**3 & + - (r - da)/SQRT((r - da)**2 + add)**3 + (r - da)/SQRT((r - da)**2 + db**2 + add)**3 + xyxy = r/SQRT(r**2 + db**2 + add)**3 - r/SQRT(r**2 + add)**3 + charg = -(zzzz*0.125_dp - xyxy*0.25_dp)*fact RETURN END IF ! X - ZX IF (l1 == 1 .AND. l2 == 2 .AND. m1 == CLMp .AND. m2 == CLMzp) THEN db = db/2.0_dp dxqxz = & - -(r-db)/SQRT((r-db)**2+(da-db)**2+add)**3+(r+db)/SQRT((r+db)**2+(da-db)**2+add)**3 & - +(r-db)/SQRT((r-db)**2+(da+db)**2+add)**3-(r+db)/SQRT((r+db)**2+(da+db)**2+add)**3 + -(r - db)/SQRT((r - db)**2 + (da - db)**2 + add)**3 + (r + db)/SQRT((r + db)**2 + (da - db)**2 + add)**3 & + + (r - db)/SQRT((r - db)**2 + (da + db)**2 + add)**3 - (r + db)/SQRT((r + db)**2 + (da + db)**2 + add)**3 charg = -dxqxz*0.25_dp*fact RETURN END IF @@ -683,40 +683,40 @@ FUNCTION dcharg_int_nri(r, l1_i, l2_i, m1_i, m2_i, da_i, db_i, add0, fact_screen da = da/2.0_dp db = db/2.0_dp qxzqxz = & - +(r+da-db)/SQRT((r+da-db)**2+(da-db)**2+add)**3-(r+da+db)/SQRT((r+da+db)**2+(da-db)**2+add)**3 & - -(r-da-db)/SQRT((r-da-db)**2+(da-db)**2+add)**3+(r-da+db)/SQRT((r-da+db)**2+(da-db)**2+add)**3 & - -(r+da-db)/SQRT((r+da-db)**2+(da+db)**2+add)**3+(r+da+db)/SQRT((r+da+db)**2+(da+db)**2+add)**3 & - +(r-da-db)/SQRT((r-da-db)**2+(da+db)**2+add)**3-(r-da+db)/SQRT((r-da+db)**2+(da+db)**2+add)**3 + +(r + da - db)/SQRT((r + da - db)**2 + (da - db)**2 + add)**3 - (r + da + db)/SQRT((r + da + db)**2 + (da - db)**2 + add)**3 & + - (r - da - db)/SQRT((r - da - db)**2 + (da - db)**2 + add)**3 + (r - da + db)/SQRT((r - da + db)**2 + (da - db)**2 + add)**3 & + - (r + da - db)/SQRT((r + da - db)**2 + (da + db)**2 + add)**3 + (r + da + db)/SQRT((r + da + db)**2 + (da + db)**2 + add)**3 & + + (r - da - db)/SQRT((r - da - db)**2 + (da + db)**2 + add)**3 - (r - da + db)/SQRT((r - da + db)**2 + (da + db)**2 + add)**3 charg = -qxzqxz*0.125_dp*fact RETURN END IF ! XX - XX IF (l1 == 2 .AND. l2 == 2 .AND. (((m1 == CLMyy) .AND. (m2 == CLMyy)) .OR. ((m1 == CLMxx) .AND. (m2 == CLMxx)))) THEN qxxqxx = & - +2.0_dp*r/SQRT(r**2+add)**3+r/SQRT(r**2+(da-db)**2+add)**3 & - +r/SQRT(r**2+(da+db)**2+add)**3-2.0_dp*r/SQRT(r**2+da**2+add)**3 & - -2.0_dp*r/SQRT(r**2+db**2+add)**3 + +2.0_dp*r/SQRT(r**2 + add)**3 + r/SQRT(r**2 + (da - db)**2 + add)**3 & + + r/SQRT(r**2 + (da + db)**2 + add)**3 - 2.0_dp*r/SQRT(r**2 + da**2 + add)**3 & + - 2.0_dp*r/SQRT(r**2 + db**2 + add)**3 charg = -qxxqxx*0.125_dp*fact RETURN END IF ! XX - YY IF (l1 == 2 .AND. l2 == 2 .AND. m1 == CLMyy .AND. m2 == CLMxx) THEN qxxqyy = & - +r/SQRT(r**2+add)**3-r/SQRT(r**2+da**2+add)**3 & - -r/SQRT(r**2+db**2+add)**3+r/SQRT(r**2+da**2+db**2+add)**3 + +r/SQRT(r**2 + add)**3 - r/SQRT(r**2 + da**2 + add)**3 & + - r/SQRT(r**2 + db**2 + add)**3 + r/SQRT(r**2 + da**2 + db**2 + add)**3 charg = -qxxqyy*0.25_dp*fact RETURN END IF ! XY - XY IF (l1 == 2 .AND. l2 == 2 .AND. m1 == CLMxy .AND. m2 == CLMxy) THEN qxxqxx = & - +2.0_dp*r/SQRT(r**2+add)**3+r/SQRT(r**2+(da-db)**2+add)**3 & - +r/SQRT(r**2+(da+db)**2+add)**3-2.0_dp*r/SQRT(r**2+da**2+add)**3 & - -2.0_dp*r/SQRT(r**2+db**2+add)**3 + +2.0_dp*r/SQRT(r**2 + add)**3 + r/SQRT(r**2 + (da - db)**2 + add)**3 & + + r/SQRT(r**2 + (da + db)**2 + add)**3 - 2.0_dp*r/SQRT(r**2 + da**2 + add)**3 & + - 2.0_dp*r/SQRT(r**2 + db**2 + add)**3 qxxqyy = & - +r/SQRT(r**2+add)**3-r/SQRT(r**2+da**2+add)**3 & - -r/SQRT(r**2+db**2+add)**3+r/SQRT(r**2+da**2+db**2+add)**3 - charg = -0.5_dp*(qxxqxx*0.125_dp-qxxqyy*0.25_dp)*fact + +r/SQRT(r**2 + add)**3 - r/SQRT(r**2 + da**2 + add)**3 & + - r/SQRT(r**2 + db**2 + add)**3 + r/SQRT(r**2 + da**2 + db**2 + add)**3 + charg = -0.5_dp*(qxxqxx*0.125_dp - qxxqyy*0.25_dp)*fact RETURN END IF ! We should NEVER reach this point @@ -780,7 +780,7 @@ FUNCTION dcharg_int_nri_fs(r, l1_i, l2_i, m1_i, m2_i, da_i, db_i, add0, fact_scr m2 = m1_i da = db_i db = da_i - fact = (-1.0_dp)**(l1+l2) + fact = (-1.0_dp)**(l1 + l2) ELSE IF (l1_i == l2_i) THEN l1 = l1_i l2 = l2_i @@ -803,86 +803,86 @@ FUNCTION dcharg_int_nri_fs(r, l1_i, l2_i, m1_i, m2_i, da_i, db_i, add0, fact_scr fact = fact*0.5_dp ! Q - Q. IF (l1 == 0 .AND. l2 == 0) THEN - charg = add0/SQRT(r**2+add)**3 + charg = add0/SQRT(r**2 + add)**3 charg = -charg*fact RETURN END IF ! Q - Z. IF (l1 == 0 .AND. l2 == 1 .AND. m2 == CLMz) THEN - charg = add0/SQRT((r+db)**2+add)**3-add0/SQRT((r-db)**2+add)**3 + charg = add0/SQRT((r + db)**2 + add)**3 - add0/SQRT((r - db)**2 + add)**3 charg = -charg*0.5_dp*fact RETURN END IF ! Z - Z. IF (l1 == 1 .AND. l2 == 1 .AND. m1 == CLMz .AND. m2 == CLMz) THEN dzdz = & - +add0/SQRT((r+da-db)**2+add)**3+add0/SQRT((r-da+db)**2+add)**3 & - -add0/SQRT((r-da-db)**2+add)**3-add0/SQRT((r+da+db)**2+add)**3 + +add0/SQRT((r + da - db)**2 + add)**3 + add0/SQRT((r - da + db)**2 + add)**3 & + - add0/SQRT((r - da - db)**2 + add)**3 - add0/SQRT((r + da + db)**2 + add)**3 charg = -dzdz*0.25_dp*fact RETURN END IF ! X - X IF (l1 == 1 .AND. l2 == 1 .AND. m1 == CLMp .AND. m2 == CLMp) THEN - dxdx = 2.0_dp*add0/SQRT(r**2+(da-db)**2+add)**3-2.0_dp*add0/SQRT(r**2+(da+db)**2+add)**3 + dxdx = 2.0_dp*add0/SQRT(r**2 + (da - db)**2 + add)**3 - 2.0_dp*add0/SQRT(r**2 + (da + db)**2 + add)**3 charg = -dxdx*0.25_dp*fact RETURN END IF ! Q - ZZ IF (l1 == 0 .AND. l2 == 2 .AND. m2 == CLMzz) THEN - qqzz = add0/SQRT((r-db)**2+add)**3-2.0_dp*add0/SQRT(r**2+add)**3+add0/SQRT((r+db)**2+add)**3 + qqzz = add0/SQRT((r - db)**2 + add)**3 - 2.0_dp*add0/SQRT(r**2 + add)**3 + add0/SQRT((r + db)**2 + add)**3 charg = -qqzz*0.25_dp*fact RETURN END IF ! Q - XX IF (l1 == 0 .AND. l2 == 2 .AND. (m2 == CLMyy .OR. m2 == CLMxx)) THEN - qqxx = -add0/SQRT(r**2+add)**3+add0/SQRT(r**2+add+db**2)**3 + qqxx = -add0/SQRT(r**2 + add)**3 + add0/SQRT(r**2 + add + db**2)**3 charg = -qqxx*0.5_dp*fact RETURN END IF ! Z - ZZ IF (l1 == 1 .AND. l2 == 2 .AND. m1 == CLMz .AND. m2 == CLMzz) THEN dzqzz = & - +add0/SQRT((r-da-db)**2+add)**3-2.0_dp*add0/SQRT((r-da)**2+add)**3 & - +add0/SQRT((r-da+db)**2+add)**3-add0/SQRT((r+da-db)**2+add)**3 & - +2.0_dp*add0/SQRT((r+da)**2+add)**3-add0/SQRT((r+da+db)**2+add)**3 + +add0/SQRT((r - da - db)**2 + add)**3 - 2.0_dp*add0/SQRT((r - da)**2 + add)**3 & + + add0/SQRT((r - da + db)**2 + add)**3 - add0/SQRT((r + da - db)**2 + add)**3 & + + 2.0_dp*add0/SQRT((r + da)**2 + add)**3 - add0/SQRT((r + da + db)**2 + add)**3 charg = -dzqzz*0.125_dp*fact RETURN END IF ! Z - XX IF (l1 == 1 .AND. l2 == 2 .AND. m1 == CLMz .AND. (m2 == CLMyy .OR. m2 == CLMxx)) THEN dzqxx = & - +add0/SQRT((r+da)**2+add)**3-add0/SQRT((r+da)**2+add+db**2)**3 & - -add0/SQRT((r-da)**2+add)**3+add0/SQRT((r-da)**2+add+db**2)**3 + +add0/SQRT((r + da)**2 + add)**3 - add0/SQRT((r + da)**2 + add + db**2)**3 & + - add0/SQRT((r - da)**2 + add)**3 + add0/SQRT((r - da)**2 + add + db**2)**3 charg = -dzqxx*0.25_dp*fact RETURN END IF ! ZZ - ZZ IF (l1 == 2 .AND. l2 == 2 .AND. m1 == CLMzz .AND. m2 == CLMzz) THEN zzzz = & - +add0/SQRT((r-da-db)**2+add)**3+add0/SQRT((r+da+db)**2+add)**3 & - +add0/SQRT((r-da+db)**2+add)**3+add0/SQRT((r+da-db)**2+add)**3 + +add0/SQRT((r - da - db)**2 + add)**3 + add0/SQRT((r + da + db)**2 + add)**3 & + + add0/SQRT((r - da + db)**2 + add)**3 + add0/SQRT((r + da - db)**2 + add)**3 xyxy = & - +add0/SQRT((r-da)**2+add)**3+add0/SQRT((r+da)**2+add)**3 & - +add0/SQRT((r-db)**2+add)**3+add0/SQRT((r+db)**2+add)**3 & - -2.0_dp*add0/SQRT(r**2+add)**3 - charg = -(zzzz*0.0625_dp-xyxy*0.125_dp)*fact + +add0/SQRT((r - da)**2 + add)**3 + add0/SQRT((r + da)**2 + add)**3 & + + add0/SQRT((r - db)**2 + add)**3 + add0/SQRT((r + db)**2 + add)**3 & + - 2.0_dp*add0/SQRT(r**2 + add)**3 + charg = -(zzzz*0.0625_dp - xyxy*0.125_dp)*fact RETURN END IF ! ZZ - XX IF (l1 == 2 .AND. l2 == 2 .AND. m1 == CLMzz .AND. (m2 == CLMxx .OR. m2 == CLMyy)) THEN zzzz = & - -add0/SQRT((r+da)**2+add)**3+add0/SQRT((r+da)**2+db**2+add)**3 & - -add0/SQRT((r-da)**2+add)**3+add0/SQRT((r-da)**2+db**2+add)**3 - xyxy = add0/SQRT(r**2+db**2+add)**3-add0/SQRT(r**2+add)**3 - charg = -(zzzz*0.125_dp-xyxy*0.25_dp)*fact + -add0/SQRT((r + da)**2 + add)**3 + add0/SQRT((r + da)**2 + db**2 + add)**3 & + - add0/SQRT((r - da)**2 + add)**3 + add0/SQRT((r - da)**2 + db**2 + add)**3 + xyxy = add0/SQRT(r**2 + db**2 + add)**3 - add0/SQRT(r**2 + add)**3 + charg = -(zzzz*0.125_dp - xyxy*0.25_dp)*fact RETURN END IF ! X - ZX IF (l1 == 1 .AND. l2 == 2 .AND. m1 == CLMp .AND. m2 == CLMzp) THEN db = db/2.0_dp dxqxz = & - -add0/SQRT((r-db)**2+(da-db)**2+add)**3+add0/SQRT((r+db)**2+(da-db)**2+add)**3 & - +add0/SQRT((r-db)**2+(da+db)**2+add)**3-add0/SQRT((r+db)**2+(da+db)**2+add)**3 + -add0/SQRT((r - db)**2 + (da - db)**2 + add)**3 + add0/SQRT((r + db)**2 + (da - db)**2 + add)**3 & + + add0/SQRT((r - db)**2 + (da + db)**2 + add)**3 - add0/SQRT((r + db)**2 + (da + db)**2 + add)**3 charg = -dxqxz*0.25_dp*fact RETURN END IF @@ -891,40 +891,40 @@ FUNCTION dcharg_int_nri_fs(r, l1_i, l2_i, m1_i, m2_i, da_i, db_i, add0, fact_scr da = da/2.0_dp db = db/2.0_dp qxzqxz = & - +add0/SQRT((r+da-db)**2+(da-db)**2+add)**3-add0/SQRT((r+da+db)**2+(da-db)**2+add)**3 & - -add0/SQRT((r-da-db)**2+(da-db)**2+add)**3+add0/SQRT((r-da+db)**2+(da-db)**2+add)**3 & - -add0/SQRT((r+da-db)**2+(da+db)**2+add)**3+add0/SQRT((r+da+db)**2+(da+db)**2+add)**3 & - +add0/SQRT((r-da-db)**2+(da+db)**2+add)**3-add0/SQRT((r-da+db)**2+(da+db)**2+add)**3 + +add0/SQRT((r + da - db)**2 + (da - db)**2 + add)**3 - add0/SQRT((r + da + db)**2 + (da - db)**2 + add)**3 & + - add0/SQRT((r - da - db)**2 + (da - db)**2 + add)**3 + add0/SQRT((r - da + db)**2 + (da - db)**2 + add)**3 & + - add0/SQRT((r + da - db)**2 + (da + db)**2 + add)**3 + add0/SQRT((r + da + db)**2 + (da + db)**2 + add)**3 & + + add0/SQRT((r - da - db)**2 + (da + db)**2 + add)**3 - add0/SQRT((r - da + db)**2 + (da + db)**2 + add)**3 charg = -qxzqxz*0.125_dp*fact RETURN END IF ! XX - XX IF (l1 == 2 .AND. l2 == 2 .AND. (((m1 == CLMyy) .AND. (m2 == CLMyy)) .OR. ((m1 == CLMxx) .AND. (m2 == CLMxx)))) THEN qxxqxx = & - +2.0_dp*add0/SQRT(r**2+add)**3+add0/SQRT(r**2+(da-db)**2+add)**3 & - +add0/SQRT(r**2+(da+db)**2+add)**3-2.0_dp*add0/SQRT(r**2+da**2+add)**3 & - -2.0_dp*add0/SQRT(r**2+db**2+add)**3 + +2.0_dp*add0/SQRT(r**2 + add)**3 + add0/SQRT(r**2 + (da - db)**2 + add)**3 & + + add0/SQRT(r**2 + (da + db)**2 + add)**3 - 2.0_dp*add0/SQRT(r**2 + da**2 + add)**3 & + - 2.0_dp*add0/SQRT(r**2 + db**2 + add)**3 charg = -qxxqxx*0.125_dp*fact RETURN END IF ! XX - YY IF (l1 == 2 .AND. l2 == 2 .AND. m1 == CLMyy .AND. m2 == CLMxx) THEN qxxqyy = & - +add0/SQRT(r**2+add)**3-add0/SQRT(r**2+da**2+add)**3 & - -add0/SQRT(r**2+db**2+add)**3+add0/SQRT(r**2+da**2+db**2+add)**3 + +add0/SQRT(r**2 + add)**3 - add0/SQRT(r**2 + da**2 + add)**3 & + - add0/SQRT(r**2 + db**2 + add)**3 + add0/SQRT(r**2 + da**2 + db**2 + add)**3 charg = -qxxqyy*0.25_dp*fact RETURN END IF ! XY - XY IF (l1 == 2 .AND. l2 == 2 .AND. m1 == CLMxy .AND. m2 == CLMxy) THEN qxxqxx = & - +2.0_dp*add0/SQRT(r**2+add)**3+add0/SQRT(r**2+(da-db)**2+add)**3 & - +add0/SQRT(r**2+(da+db)**2+add)**3-2.0_dp*add0/SQRT(r**2+da**2+add)**3 & - -2.0_dp*add0/SQRT(r**2+db**2+add)**3 + +2.0_dp*add0/SQRT(r**2 + add)**3 + add0/SQRT(r**2 + (da - db)**2 + add)**3 & + + add0/SQRT(r**2 + (da + db)**2 + add)**3 - 2.0_dp*add0/SQRT(r**2 + da**2 + add)**3 & + - 2.0_dp*add0/SQRT(r**2 + db**2 + add)**3 qxxqyy = & - +add0/SQRT(r**2+add)**3-add0/SQRT(r**2+da**2+add)**3 & - -add0/SQRT(r**2+db**2+add)**3+add0/SQRT(r**2+da**2+db**2+add)**3 - charg = -0.5_dp*(qxxqxx*0.125_dp-qxxqyy*0.25_dp)*fact + +add0/SQRT(r**2 + add)**3 - add0/SQRT(r**2 + da**2 + add)**3 & + - add0/SQRT(r**2 + db**2 + add)**3 + add0/SQRT(r**2 + da**2 + db**2 + add)**3 + charg = -0.5_dp*(qxxqxx*0.125_dp - qxxqyy*0.25_dp)*fact RETURN END IF ! We should NEVER reach this point @@ -982,8 +982,8 @@ FUNCTION ijkl_d(sepi, sepj, ij, kl, li, lj, lk, ll, ic, r, se_int_control, & IF ((.NOT. se_int_control%pc_coulomb_int) .AND. (itype /= do_method_pchg)) THEN ! Handle the 1/r^3 term, this term is ALWAYS false for KDSO-D integrals IF (se_int_control%shortrange .AND. se_int_control%do_ewald_r3) THEN - res = res-ijkl_low_3(sepi, sepj, ij, kl, li, lj, lk, ll, ic, & - itype, charg_int_3) + res = res - ijkl_low_3(sepi, sepj, ij, kl, li, lj, lk, ll, ic, & + itype, charg_int_3) END IF END IF END FUNCTION ijkl_d @@ -1042,7 +1042,7 @@ FUNCTION d_ijkl_d(sepi, sepj, ij, kl, li, lj, lk, ll, ic, r, se_int_control, & dfs = ijkl_d_low(sepi, sepj, ij, kl, li, lj, lk, ll, ic, r, se_int_screen, & se_int_control%integral_screening, .FALSE., .FALSE., & se_int_control%max_multipole, itype, dcharg_int_ri_fs) - res = res+dfs*se_int_screen%dft + res = res + dfs*se_int_screen%dft ! In case we need the shortrange part we have to evaluate an additional derivative ! to handle the derivative of the Tapering term @@ -1050,7 +1050,7 @@ FUNCTION d_ijkl_d(sepi, sepj, ij, kl, li, lj, lk, ll, ic, r, se_int_control, & srd = ijkl_d_low(sepi, sepj, ij, kl, li, lj, lk, ll, ic, r, se_int_screen, & se_int_control%integral_screening, .FALSE., .TRUE., & se_int_control%max_multipole, itype, dcharg_int_ri) - res = res-srd + res = res - srd END IF END IF ELSE @@ -1064,8 +1064,8 @@ FUNCTION d_ijkl_d(sepi, sepj, ij, kl, li, lj, lk, ll, ic, r, se_int_control, & IF ((.NOT. se_int_control%pc_coulomb_int) .AND. (itype /= do_method_pchg)) THEN ! Handle the 1/r^3 term, this term is ALWAYS false for KDSO-D integrals IF (se_int_control%shortrange .AND. se_int_control%do_ewald_r3) THEN - res = res-ijkl_low_3(sepi, sepj, ij, kl, li, lj, lk, ll, ic, & - itype, dcharg_int_3) + res = res - ijkl_low_3(sepi, sepj, ij, kl, li, lj, lk, ll, ic, & + itype, dcharg_int_3) END IF END IF @@ -1123,12 +1123,12 @@ FUNCTION ijkl_d_low(sepi, sepj, ij, kl, li, lj, lk, ll, ic, r, se_int_screen, & REAL(KIND=dp) :: add, ccc, chrg, dij, dkl, fact_screen, & pij, pkl, s1, sum - l1min = ABS(li-lj) - l1max = li+lj - lij = indexb(li+1, lj+1) - l2min = ABS(lk-ll) - l2max = lk+ll - lkl = indexb(lk+1, ll+1) + l1min = ABS(li - lj) + l1max = li + lj + lij = indexb(li + 1, lj + 1) + l2min = ABS(lk - ll) + l2max = lk + ll + lkl = indexb(lk + 1, ll + 1) l1max = MIN(l1max, 2) l1min = MIN(l1min, 2) @@ -1177,7 +1177,7 @@ FUNCTION ijkl_d_low(sepi, sepj, ij, kl, li, lj, lk, ll, ic, r, se_int_screen, & IF (itype == do_method_pchg) THEN add = 0.0_dp ELSE - add = (pij+pkl)**2 + add = (pij + pkl)**2 END IF lmin = MIN(l1, l2) s1 = 0.0_dp @@ -1186,10 +1186,10 @@ FUNCTION ijkl_d_low(sepi, sepj, ij, kl, li, lj, lk, ll, ic, r, se_int_screen, & IF (ABS(ccc) > EPSILON(0.0_dp)) THEN mm = ABS(m) chrg = eval(r, l1, l2, mm, dij, dkl, add, fact_screen) - s1 = s1+chrg*ccc + s1 = s1 + chrg*ccc END IF END DO - sum = sum+s1 + sum = sum + s1 END DO END DO res = sum @@ -1219,14 +1219,14 @@ FUNCTION ijkl_d_low(sepi, sepj, ij, kl, li, lj, lk, ll, ic, r, se_int_screen, & IF (ABS(ccc) > EPSILON(0.0_dp)) THEN mm = ABS(m) chrg = eval(r, l1, l2, mm, dij, dkl, add, fact_screen) - s1 = s1+chrg*ccc + s1 = s1 + chrg*ccc END IF END DO - sum = sum+s1 + sum = sum + s1 END DO END DO IF (pc_coulomb_int) res = sum - IF (shortrange) res = res-sum + IF (shortrange) res = res - sum END IF END FUNCTION ijkl_d_low @@ -1275,70 +1275,70 @@ FUNCTION charg_int_ri(r, l1_i, l2_i, m, da_i, db_i, add0, fact_screen) RESULT(ch l2 = l1_i da = db_i db = da_i - fact = (-1.0_dp)**(l1+l2) + fact = (-1.0_dp)**(l1 + l2) END IF charg = 0.0_dp add = add0*fact_screen ! Q - Q. IF (l1 == 0 .AND. l2 == 0) THEN - charg = fact/SQRT(r**2+add) + charg = fact/SQRT(r**2 + add) RETURN END IF ! Q - Z. IF (l1 == 0 .AND. l2 == 1) THEN - charg = 1.0_dp/SQRT((r+db)**2+add)-1.0_dp/SQRT((r-db)**2+add) + charg = 1.0_dp/SQRT((r + db)**2 + add) - 1.0_dp/SQRT((r - db)**2 + add) charg = charg*0.5_dp*fact RETURN END IF ! Z - Z. IF (l1 == 1 .AND. l2 == 1 .AND. m == 0) THEN dzdz = & - +1.0_dp/SQRT((r+da-db)**2+add)+1.0_dp/SQRT((r-da+db)**2+add) & - -1.0_dp/SQRT((r-da-db)**2+add)-1.0_dp/SQRT((r+da+db)**2+add) + +1.0_dp/SQRT((r + da - db)**2 + add) + 1.0_dp/SQRT((r - da + db)**2 + add) & + - 1.0_dp/SQRT((r - da - db)**2 + add) - 1.0_dp/SQRT((r + da + db)**2 + add) charg = dzdz*0.25_dp*fact RETURN END IF ! X - X IF (l1 == 1 .AND. l2 == 1 .AND. m == 1) THEN - dxdx = 2.0_dp/SQRT(r**2+(da-db)**2+add)-2.0_dp/SQRT(r**2+(da+db)**2+add) + dxdx = 2.0_dp/SQRT(r**2 + (da - db)**2 + add) - 2.0_dp/SQRT(r**2 + (da + db)**2 + add) charg = dxdx*0.25_dp*fact RETURN END IF ! Q - ZZ IF (l1 == 0 .AND. l2 == 2) THEN - qqzz = 1.0_dp/SQRT((r-db)**2+add)-2.0_dp/SQRT(r**2+db**2+add)+1.0_dp/SQRT((r+db)**2+add) + qqzz = 1.0_dp/SQRT((r - db)**2 + add) - 2.0_dp/SQRT(r**2 + db**2 + add) + 1.0_dp/SQRT((r + db)**2 + add) charg = qqzz*0.25_dp*fact RETURN END IF ! Z - ZZ IF (l1 == 1 .AND. l2 == 2 .AND. m == 0) THEN dzqzz = & - +1.0_dp/SQRT((r-da-db)**2+add)-2.0_dp/SQRT((r-da)**2+db**2+add) & - +1.0_dp/SQRT((r+db-da)**2+add)-1.0_dp/SQRT((r-db+da)**2+add) & - +2.0_dp/SQRT((r+da)**2+db**2+add)-1.0_dp/SQRT((r+da+db)**2+add) + +1.0_dp/SQRT((r - da - db)**2 + add) - 2.0_dp/SQRT((r - da)**2 + db**2 + add) & + + 1.0_dp/SQRT((r + db - da)**2 + add) - 1.0_dp/SQRT((r - db + da)**2 + add) & + + 2.0_dp/SQRT((r + da)**2 + db**2 + add) - 1.0_dp/SQRT((r + da + db)**2 + add) charg = dzqzz*0.125_dp*fact RETURN END IF ! ZZ - ZZ IF (l1 == 2 .AND. l2 == 2 .AND. m == 0) THEN zzzz = & - +1.0_dp/SQRT((r-da-db)**2+add)+1.0_dp/SQRT((r+da+db)**2+add) & - +1.0_dp/SQRT((r-da+db)**2+add)+1.0_dp/SQRT((r+da-db)**2+add) & - -2.0_dp/SQRT((r-da)**2+db**2+add)-2.0_dp/SQRT((r-db)**2+da**2+add) & - -2.0_dp/SQRT((r+da)**2+db**2+add)-2.0_dp/SQRT((r+db)**2+da**2+add) & - +2.0_dp/SQRT(r**2+(da-db)**2+add)+2.0_dp/SQRT(r**2+(da+db)**2+add) + +1.0_dp/SQRT((r - da - db)**2 + add) + 1.0_dp/SQRT((r + da + db)**2 + add) & + + 1.0_dp/SQRT((r - da + db)**2 + add) + 1.0_dp/SQRT((r + da - db)**2 + add) & + - 2.0_dp/SQRT((r - da)**2 + db**2 + add) - 2.0_dp/SQRT((r - db)**2 + da**2 + add) & + - 2.0_dp/SQRT((r + da)**2 + db**2 + add) - 2.0_dp/SQRT((r + db)**2 + da**2 + add) & + + 2.0_dp/SQRT(r**2 + (da - db)**2 + add) + 2.0_dp/SQRT(r**2 + (da + db)**2 + add) xyxy = & - +4.0_dp/SQRT(r**2+(da-db)**2+add)+4.0_dp/SQRT(r**2+(da+db)**2+add) & - -8.0_dp/SQRT(r**2+da**2+db**2+add) - charg = (zzzz*0.0625_dp-xyxy*0.015625_dp)*fact + +4.0_dp/SQRT(r**2 + (da - db)**2 + add) + 4.0_dp/SQRT(r**2 + (da + db)**2 + add) & + - 8.0_dp/SQRT(r**2 + da**2 + db**2 + add) + charg = (zzzz*0.0625_dp - xyxy*0.015625_dp)*fact RETURN END IF ! X - ZX IF (l1 == 1 .AND. l2 == 2 .AND. m == 1) THEN ab = db/SQRT(2.0_dp) dxqxz = & - -2.0_dp/SQRT((r-ab)**2+(da-ab)**2+add)+2.0_dp/SQRT((r+ab)**2+(da-ab)**2+add) & - +2.0_dp/SQRT((r-ab)**2+(da+ab)**2+add)-2.0_dp/SQRT((r+ab)**2+(da+ab)**2+add) + -2.0_dp/SQRT((r - ab)**2 + (da - ab)**2 + add) + 2.0_dp/SQRT((r + ab)**2 + (da - ab)**2 + add) & + + 2.0_dp/SQRT((r - ab)**2 + (da + ab)**2 + add) - 2.0_dp/SQRT((r + ab)**2 + (da + ab)**2 + add) charg = dxqxz*0.125_dp*fact RETURN END IF @@ -1347,16 +1347,16 @@ FUNCTION charg_int_ri(r, l1_i, l2_i, m, da_i, db_i, add0, fact_screen) RESULT(ch aa = da/SQRT(2.0_dp) ab = db/SQRT(2.0_dp) qxzqxz = & - +2.0_dp/SQRT((r+aa-ab)**2+(aa-ab)**2+add)-2.0_dp/SQRT((r+aa+ab)**2+(aa-ab)**2+add) & - -2.0_dp/SQRT((r-aa-ab)**2+(aa-ab)**2+add)+2.0_dp/SQRT((r-aa+ab)**2+(aa-ab)**2+add) & - -2.0_dp/SQRT((r+aa-ab)**2+(aa+ab)**2+add)+2.0_dp/SQRT((r+aa+ab)**2+(aa+ab)**2+add) & - +2.0_dp/SQRT((r-aa-ab)**2+(aa+ab)**2+add)-2.0_dp/SQRT((r-aa+ab)**2+(aa+ab)**2+add) + +2.0_dp/SQRT((r + aa - ab)**2 + (aa - ab)**2 + add) - 2.0_dp/SQRT((r + aa + ab)**2 + (aa - ab)**2 + add) & + - 2.0_dp/SQRT((r - aa - ab)**2 + (aa - ab)**2 + add) + 2.0_dp/SQRT((r - aa + ab)**2 + (aa - ab)**2 + add) & + - 2.0_dp/SQRT((r + aa - ab)**2 + (aa + ab)**2 + add) + 2.0_dp/SQRT((r + aa + ab)**2 + (aa + ab)**2 + add) & + + 2.0_dp/SQRT((r - aa - ab)**2 + (aa + ab)**2 + add) - 2.0_dp/SQRT((r - aa + ab)**2 + (aa + ab)**2 + add) charg = qxzqxz*0.0625_dp*fact RETURN END IF ! XX - XX IF (l1 == 2 .AND. l2 == 2 .AND. m == 2) THEN - xyxy = 4.0_dp/SQRT(r**2+(da-db)**2+add)+4.0_dp/SQRT(r**2+(da+db)**2+add)-8.0_dp/SQRT(r**2+da**2+db**2+add) + xyxy = 4.0_dp/SQRT(r**2 + (da - db)**2 + add) + 4.0_dp/SQRT(r**2 + (da + db)**2 + add) - 8.0_dp/SQRT(r**2 + da**2 + db**2 + add) charg = xyxy*0.0625_dp*fact RETURN END IF @@ -1410,71 +1410,71 @@ FUNCTION dcharg_int_ri(r, l1_i, l2_i, m, da_i, db_i, add0, fact_screen) RESULT(c l2 = l1_i da = db_i db = da_i - fact = (-1.0_dp)**(l1+l2) + fact = (-1.0_dp)**(l1 + l2) END IF charg = 0.0_dp add = add0*fact_screen ! Q - Q. IF (l1 == 0 .AND. l2 == 0) THEN - charg = r/SQRT(r**2+add)**3 + charg = r/SQRT(r**2 + add)**3 charg = -fact*charg RETURN END IF ! Q - Z. IF (l1 == 0 .AND. l2 == 1) THEN - charg = (r+db)/SQRT((r+db)**2+add)**3-(r-db)/SQRT((r-db)**2+add)**3 + charg = (r + db)/SQRT((r + db)**2 + add)**3 - (r - db)/SQRT((r - db)**2 + add)**3 charg = -charg*0.5_dp*fact RETURN END IF ! Z - Z. IF (l1 == 1 .AND. l2 == 1 .AND. m == 0) THEN dzdz = & - +(r+da-db)/SQRT((r+da-db)**2+add)**3+(r-da+db)/SQRT((r-da+db)**2+add)**3 & - -(r-da-db)/SQRT((r-da-db)**2+add)**3-(r+da+db)/SQRT((r+da+db)**2+add)**3 + +(r + da - db)/SQRT((r + da - db)**2 + add)**3 + (r - da + db)/SQRT((r - da + db)**2 + add)**3 & + - (r - da - db)/SQRT((r - da - db)**2 + add)**3 - (r + da + db)/SQRT((r + da + db)**2 + add)**3 charg = -dzdz*0.25_dp*fact RETURN END IF ! X - X IF (l1 == 1 .AND. l2 == 1 .AND. m == 1) THEN - dxdx = 2.0_dp*r/SQRT(r**2+(da-db)**2+add)**3-2.0_dp*r/SQRT(r**2+(da+db)**2+add)**3 + dxdx = 2.0_dp*r/SQRT(r**2 + (da - db)**2 + add)**3 - 2.0_dp*r/SQRT(r**2 + (da + db)**2 + add)**3 charg = -dxdx*0.25_dp*fact RETURN END IF ! Q - ZZ IF (l1 == 0 .AND. l2 == 2) THEN - qqzz = (r-db)/SQRT((r-db)**2+add)**3-2.0_dp*r/SQRT(r**2+db**2+add)**3+(r+db)/SQRT((r+db)**2+add)**3 + qqzz = (r - db)/SQRT((r - db)**2 + add)**3 - 2.0_dp*r/SQRT(r**2 + db**2 + add)**3 + (r + db)/SQRT((r + db)**2 + add)**3 charg = -qqzz*0.25_dp*fact RETURN END IF ! Z - ZZ IF (l1 == 1 .AND. l2 == 2 .AND. m == 0) THEN dzqzz = & - +(r-da-db)/SQRT((r-da-db)**2+add)**3-2.0_dp*(r-da)/SQRT((r-da)**2+db**2+add)**3 & - +(r+db-da)/SQRT((r+db-da)**2+add)**3-(r-db+da)/SQRT((r-db+da)**2+add)**3 & - +2.0_dp*(r+da)/SQRT((r+da)**2+db**2+add)**3-(r+da+db)/SQRT((r+da+db)**2+add)**3 + +(r - da - db)/SQRT((r - da - db)**2 + add)**3 - 2.0_dp*(r - da)/SQRT((r - da)**2 + db**2 + add)**3 & + + (r + db - da)/SQRT((r + db - da)**2 + add)**3 - (r - db + da)/SQRT((r - db + da)**2 + add)**3 & + + 2.0_dp*(r + da)/SQRT((r + da)**2 + db**2 + add)**3 - (r + da + db)/SQRT((r + da + db)**2 + add)**3 charg = -dzqzz*0.125_dp*fact RETURN END IF ! ZZ - ZZ IF (l1 == 2 .AND. l2 == 2 .AND. m == 0) THEN zzzz = & - +(r-da-db)/SQRT((r-da-db)**2+add)**3+(r+da+db)/SQRT((r+da+db)**2+add)**3 & - +(r-da+db)/SQRT((r-da+db)**2+add)**3+(r+da-db)/SQRT((r+da-db)**2+add)**3 & - -2.0_dp*(r-da)/SQRT((r-da)**2+db**2+add)**3-2.0_dp*(r-db)/SQRT((r-db)**2+da**2+add)**3 & - -2.0_dp*(r+da)/SQRT((r+da)**2+db**2+add)**3-2.0_dp*(r+db)/SQRT((r+db)**2+da**2+add)**3 & - +2.0_dp*r/SQRT(r**2+(da-db)**2+add)**3+2.0_dp*r/SQRT(r**2+(da+db)**2+add)**3 + +(r - da - db)/SQRT((r - da - db)**2 + add)**3 + (r + da + db)/SQRT((r + da + db)**2 + add)**3 & + + (r - da + db)/SQRT((r - da + db)**2 + add)**3 + (r + da - db)/SQRT((r + da - db)**2 + add)**3 & + - 2.0_dp*(r - da)/SQRT((r - da)**2 + db**2 + add)**3 - 2.0_dp*(r - db)/SQRT((r - db)**2 + da**2 + add)**3 & + - 2.0_dp*(r + da)/SQRT((r + da)**2 + db**2 + add)**3 - 2.0_dp*(r + db)/SQRT((r + db)**2 + da**2 + add)**3 & + + 2.0_dp*r/SQRT(r**2 + (da - db)**2 + add)**3 + 2.0_dp*r/SQRT(r**2 + (da + db)**2 + add)**3 xyxy = & - +4.0_dp*r/SQRT(r**2+(da-db)**2+add)**3+4.0_dp*r/SQRT(r**2+(da+db)**2+add)**3 & - -8.0_dp*r/SQRT(r**2+da**2+db**2+add)**3 - charg = -(zzzz*0.0625_dp-xyxy*0.015625_dp)*fact + +4.0_dp*r/SQRT(r**2 + (da - db)**2 + add)**3 + 4.0_dp*r/SQRT(r**2 + (da + db)**2 + add)**3 & + - 8.0_dp*r/SQRT(r**2 + da**2 + db**2 + add)**3 + charg = -(zzzz*0.0625_dp - xyxy*0.015625_dp)*fact RETURN END IF ! X - ZX IF (l1 == 1 .AND. l2 == 2 .AND. m == 1) THEN ab = db/SQRT(2.0_dp) dxqxz = & - -2.0_dp*(r-ab)/SQRT((r-ab)**2+(da-ab)**2+add)**3+2.0_dp*(r+ab)/SQRT((r+ab)**2+(da-ab)**2+add)**3 & - +2.0_dp*(r-ab)/SQRT((r-ab)**2+(da+ab)**2+add)**3-2.0_dp*(r+ab)/SQRT((r+ab)**2+(da+ab)**2+add)**3 + -2.0_dp*(r - ab)/SQRT((r - ab)**2 + (da - ab)**2 + add)**3 + 2.0_dp*(r + ab)/SQRT((r + ab)**2 + (da - ab)**2 + add)**3 & + + 2.0_dp*(r - ab)/SQRT((r - ab)**2 + (da + ab)**2 + add)**3 - 2.0_dp*(r + ab)/SQRT((r + ab)**2 + (da + ab)**2 + add)**3 charg = -dxqxz*0.125_dp*fact RETURN END IF @@ -1548,7 +1548,7 @@ FUNCTION dcharg_int_ri_fs(r, l1_i, l2_i, m, da_i, db_i, add0, fact_screen) RESUL l2 = l1_i da = db_i db = da_i - fact = (-1.0_dp)**(l1+l2) + fact = (-1.0_dp)**(l1 + l2) END IF charg = 0.0_dp add = add0*fact_screen @@ -1556,65 +1556,65 @@ FUNCTION dcharg_int_ri_fs(r, l1_i, l2_i, m, da_i, db_i, add0, fact_screen) RESUL fact = fact*0.5_dp ! Q - Q. IF (l1 == 0 .AND. l2 == 0) THEN - charg = add0/SQRT(r**2+add)**3 + charg = add0/SQRT(r**2 + add)**3 charg = -fact*charg RETURN END IF ! Q - Z. IF (l1 == 0 .AND. l2 == 1) THEN - charg = add0/SQRT((r+db)**2+add)**3-add0/SQRT((r-db)**2+add)**3 + charg = add0/SQRT((r + db)**2 + add)**3 - add0/SQRT((r - db)**2 + add)**3 charg = -charg*0.5_dp*fact RETURN END IF ! Z - Z. IF (l1 == 1 .AND. l2 == 1 .AND. m == 0) THEN dzdz = & - +add0/SQRT((r+da-db)**2+add)**3+add0/SQRT((r-da+db)**2+add)**3 & - -add0/SQRT((r-da-db)**2+add)**3-add0/SQRT((r+da+db)**2+add)**3 + +add0/SQRT((r + da - db)**2 + add)**3 + add0/SQRT((r - da + db)**2 + add)**3 & + - add0/SQRT((r - da - db)**2 + add)**3 - add0/SQRT((r + da + db)**2 + add)**3 charg = -dzdz*0.25_dp*fact RETURN END IF ! X - X IF (l1 == 1 .AND. l2 == 1 .AND. m == 1) THEN - dxdx = 2.0_dp*add0/SQRT(r**2+(da-db)**2+add)**3-2.0_dp*add0/SQRT(r**2+(da+db)**2+add)**3 + dxdx = 2.0_dp*add0/SQRT(r**2 + (da - db)**2 + add)**3 - 2.0_dp*add0/SQRT(r**2 + (da + db)**2 + add)**3 charg = -dxdx*0.25_dp*fact RETURN END IF ! Q - ZZ IF (l1 == 0 .AND. l2 == 2) THEN - qqzz = add0/SQRT((r-db)**2+add)**3-2.0_dp*add0/SQRT(r**2+db**2+add)**3+add0/SQRT((r+db)**2+add)**3 + qqzz = add0/SQRT((r - db)**2 + add)**3 - 2.0_dp*add0/SQRT(r**2 + db**2 + add)**3 + add0/SQRT((r + db)**2 + add)**3 charg = -qqzz*0.25_dp*fact RETURN END IF ! Z - ZZ IF (l1 == 1 .AND. l2 == 2 .AND. m == 0) THEN dzqzz = & - +add0/SQRT((r-da-db)**2+add)**3-2.0_dp*add0/SQRT((r-da)**2+db**2+add)**3 & - +add0/SQRT((r+db-da)**2+add)**3-add0/SQRT((r-db+da)**2+add)**3 & - +2.0_dp*add0/SQRT((r+da)**2+db**2+add)**3-add0/SQRT((r+da+db)**2+add)**3 + +add0/SQRT((r - da - db)**2 + add)**3 - 2.0_dp*add0/SQRT((r - da)**2 + db**2 + add)**3 & + + add0/SQRT((r + db - da)**2 + add)**3 - add0/SQRT((r - db + da)**2 + add)**3 & + + 2.0_dp*add0/SQRT((r + da)**2 + db**2 + add)**3 - add0/SQRT((r + da + db)**2 + add)**3 charg = -dzqzz*0.125_dp*fact RETURN END IF ! ZZ - ZZ IF (l1 == 2 .AND. l2 == 2 .AND. m == 0) THEN zzzz = & - +add0/SQRT((r-da-db)**2+add)**3+add0/SQRT((r+da+db)**2+add)**3 & - +add0/SQRT((r-da+db)**2+add)**3+add0/SQRT((r+da-db)**2+add)**3 & - -2.0_dp*add0/SQRT((r-da)**2+db**2+add)**3-2.0_dp*add0/SQRT((r-db)**2+da**2+add)**3 & - -2.0_dp*add0/SQRT((r+da)**2+db**2+add)**3-2.0_dp*add0/SQRT((r+db)**2+da**2+add)**3 & - +2.0_dp*add0/SQRT(r**2+(da-db)**2+add)**3+2.0_dp*add0/SQRT(r**2+(da+db)**2+add)**3 + +add0/SQRT((r - da - db)**2 + add)**3 + add0/SQRT((r + da + db)**2 + add)**3 & + + add0/SQRT((r - da + db)**2 + add)**3 + add0/SQRT((r + da - db)**2 + add)**3 & + - 2.0_dp*add0/SQRT((r - da)**2 + db**2 + add)**3 - 2.0_dp*add0/SQRT((r - db)**2 + da**2 + add)**3 & + - 2.0_dp*add0/SQRT((r + da)**2 + db**2 + add)**3 - 2.0_dp*add0/SQRT((r + db)**2 + da**2 + add)**3 & + + 2.0_dp*add0/SQRT(r**2 + (da - db)**2 + add)**3 + 2.0_dp*add0/SQRT(r**2 + (da + db)**2 + add)**3 xyxy = & - +4.0_dp*add0/SQRT(r**2+(da-db)**2+add)**3+4.0_dp*add0/SQRT(r**2+(da+db)**2+add)**3 & - -8.0_dp*add0/SQRT(r**2+da**2+db**2+add)**3 - charg = -(zzzz*0.0625_dp-xyxy*0.015625_dp)*fact + +4.0_dp*add0/SQRT(r**2 + (da - db)**2 + add)**3 + 4.0_dp*add0/SQRT(r**2 + (da + db)**2 + add)**3 & + - 8.0_dp*add0/SQRT(r**2 + da**2 + db**2 + add)**3 + charg = -(zzzz*0.0625_dp - xyxy*0.015625_dp)*fact RETURN END IF ! X - ZX IF (l1 == 1 .AND. l2 == 2 .AND. m == 1) THEN ab = db/SQRT(2.0_dp) dxqxz = & - -2.0_dp*add0/SQRT((r-ab)**2+(da-ab)**2+add)**3+2.0_dp*add0/SQRT((r+ab)**2+(da-ab)**2+add)**3 & - +2.0_dp*add0/SQRT((r-ab)**2+(da+ab)**2+add)**3-2.0_dp*add0/SQRT((r+ab)**2+(da+ab)**2+add)**3 + -2.0_dp*add0/SQRT((r - ab)**2 + (da - ab)**2 + add)**3 + 2.0_dp*add0/SQRT((r + ab)**2 + (da - ab)**2 + add)**3 & + + 2.0_dp*add0/SQRT((r - ab)**2 + (da + ab)**2 + add)**3 - 2.0_dp*add0/SQRT((r + ab)**2 + (da + ab)**2 + add)**3 charg = -dxqxz*0.125_dp*fact RETURN END IF @@ -1623,17 +1623,17 @@ FUNCTION dcharg_int_ri_fs(r, l1_i, l2_i, m, da_i, db_i, add0, fact_screen) RESUL aa = da/SQRT(2.0_dp) ab = db/SQRT(2.0_dp) qxzqxz = & - +2.0_dp*add0/SQRT((r+aa-ab)**2+(aa-ab)**2+add)**3-2.0_dp*add0/SQRT((r+aa+ab)**2+(aa-ab)**2+add)**3 & - -2.0_dp*add0/SQRT((r-aa-ab)**2+(aa-ab)**2+add)**3+2.0_dp*add0/SQRT((r-aa+ab)**2+(aa-ab)**2+add)**3 & - -2.0_dp*add0/SQRT((r+aa-ab)**2+(aa+ab)**2+add)**3+2.0_dp*add0/SQRT((r+aa+ab)**2+(aa+ab)**2+add)**3 & - +2.0_dp*add0/SQRT((r-aa-ab)**2+(aa+ab)**2+add)**3-2.0_dp*add0/SQRT((r-aa+ab)**2+(aa+ab)**2+add)**3 + +2.0_dp*add0/SQRT((r + aa - ab)**2 + (aa - ab)**2 + add)**3 - 2.0_dp*add0/SQRT((r + aa + ab)**2 + (aa - ab)**2 + add)**3 & + - 2.0_dp*add0/SQRT((r - aa - ab)**2 + (aa - ab)**2 + add)**3 + 2.0_dp*add0/SQRT((r - aa + ab)**2 + (aa - ab)**2 + add)**3 & + - 2.0_dp*add0/SQRT((r + aa - ab)**2 + (aa + ab)**2 + add)**3 + 2.0_dp*add0/SQRT((r + aa + ab)**2 + (aa + ab)**2 + add)**3 & + + 2.0_dp*add0/SQRT((r - aa - ab)**2 + (aa + ab)**2 + add)**3 - 2.0_dp*add0/SQRT((r - aa + ab)**2 + (aa + ab)**2 + add)**3 charg = -qxzqxz*0.0625_dp*fact RETURN END IF ! XX - XX IF (l1 == 2 .AND. l2 == 2 .AND. m == 2) THEN - xyxy = 4.0_dp*add0/SQRT(r**2+(da-db)**2+add)**3+4.0_dp*add0/SQRT(r**2+(da+db)**2+add)**3- & - 8.0_dp*add0/SQRT(r**2+da**2+db**2+add)**3 + xyxy = 4.0_dp*add0/SQRT(r**2 + (da - db)**2 + add)**3 + 4.0_dp*add0/SQRT(r**2 + (da + db)**2 + add)**3 - & + 8.0_dp*add0/SQRT(r**2 + da**2 + db**2 + add)**3 charg = -xyxy*0.0625_dp*fact RETURN END IF @@ -1735,7 +1735,7 @@ RECURSIVE SUBROUTINE rotmat(sepi, sepj, rjiv, r, ij_matrix, do_derivatives, & x22 = rjiv(imap(2)) x33 = rjiv(imap(3)) cb = x33/r - b = x11**2+x22**2 + b = x11**2 + x22**2 sqb = SQRT(b) ca = x11/sqb sa = x22/sqb @@ -1755,21 +1755,21 @@ RECURSIVE SUBROUTINE rotmat(sepi, sepj, rjiv, r, ij_matrix, do_derivatives, & ca2 = ca**2 cb2 = cb**2 sb2 = sb**2 - c2a = 2.0_dp*ca2-1.0_dp - c2b = 2.0_dp*cb2-1.0_dp + c2a = 2.0_dp*ca2 - 1.0_dp + c2b = 2.0_dp*cb2 - 1.0_dp s2a = 2.0_dp*sa*ca s2b = 2.0_dp*sb*cb d(1, 1) = pt5sq3*c2a*sb2 d(2, 1) = 0.5_dp*c2a*s2b d(3, 1) = -s2a*sb - d(4, 1) = c2a*(cb2+0.5_dp*sb2) + d(4, 1) = c2a*(cb2 + 0.5_dp*sb2) d(5, 1) = -s2a*cb d(1, 2) = pt5sq3*ca*s2b d(2, 2) = ca*c2b d(3, 2) = -sa*cb d(4, 2) = -0.5_dp*ca*s2b d(5, 2) = sa*sb - d(1, 3) = cb2-0.5_dp*sb2 + d(1, 3) = cb2 - 0.5_dp*sb2 d(2, 3) = -pt5sq3*s2b d(3, 3) = 0.0_dp d(4, 3) = pt5sq3*sb2 @@ -1782,7 +1782,7 @@ RECURSIVE SUBROUTINE rotmat(sepi, sepj, rjiv, r, ij_matrix, do_derivatives, & d(1, 5) = pt5sq3*s2a*sb2 d(2, 5) = 0.5_dp*s2a*s2b d(3, 5) = c2a*sb - d(4, 5) = s2a*(cb2+0.5_dp*sb2) + d(4, 5) = s2a*(cb2 + 0.5_dp*sb2) d(5, 5) = c2a*cb END IF ! Rotation Elements for : S-P @@ -1800,13 +1800,13 @@ RECURSIVE SUBROUTINE rotmat(sepi, sepj, rjiv, r, ij_matrix, do_derivatives, & ij_matrix%pp(5, k, k) = p(k, 1)*p(k, 3) ij_matrix%pp(6, k, k) = p(k, 2)*p(k, 3) IF (k /= 1) THEN - DO l = 1, k-1 + DO l = 1, k - 1 ij_matrix%pp(1, k, l) = 2.0_dp*p(k, 1)*p(l, 1) ij_matrix%pp(2, k, l) = 2.0_dp*p(k, 2)*p(l, 2) ij_matrix%pp(3, k, l) = 2.0_dp*p(k, 3)*p(l, 3) - ij_matrix%pp(4, k, l) = p(k, 1)*p(l, 2)+p(k, 2)*p(l, 1) - ij_matrix%pp(5, k, l) = p(k, 1)*p(l, 3)+p(k, 3)*p(l, 1) - ij_matrix%pp(6, k, l) = p(k, 2)*p(l, 3)+p(k, 3)*p(l, 2) + ij_matrix%pp(4, k, l) = p(k, 1)*p(l, 2) + p(k, 2)*p(l, 1) + ij_matrix%pp(5, k, l) = p(k, 1)*p(l, 3) + p(k, 3)*p(l, 1) + ij_matrix%pp(6, k, l) = p(k, 2)*p(l, 3) + p(k, 3)*p(l, 2) END DO END IF END DO @@ -1855,22 +1855,22 @@ RECURSIVE SUBROUTINE rotmat(sepi, sepj, rjiv, r, ij_matrix, do_derivatives, & ij_matrix%dd(14, k, k) = d(k, 3)*d(k, 5) ij_matrix%dd(15, k, k) = d(k, 4)*d(k, 5) IF (k /= 1) THEN - DO l = 1, k-1 + DO l = 1, k - 1 ij_matrix%dd(1, k, l) = 2.0_dp*d(k, 1)*d(l, 1) ij_matrix%dd(2, k, l) = 2.0_dp*d(k, 2)*d(l, 2) ij_matrix%dd(3, k, l) = 2.0_dp*d(k, 3)*d(l, 3) ij_matrix%dd(4, k, l) = 2.0_dp*d(k, 4)*d(l, 4) ij_matrix%dd(5, k, l) = 2.0_dp*d(k, 5)*d(l, 5) - ij_matrix%dd(6, k, l) = d(k, 1)*d(l, 2)+d(k, 2)*d(l, 1) - ij_matrix%dd(7, k, l) = d(k, 1)*d(l, 3)+d(k, 3)*d(l, 1) - ij_matrix%dd(8, k, l) = d(k, 2)*d(l, 3)+d(k, 3)*d(l, 2) - ij_matrix%dd(9, k, l) = d(k, 1)*d(l, 4)+d(k, 4)*d(l, 1) - ij_matrix%dd(10, k, l) = d(k, 2)*d(l, 4)+d(k, 4)*d(l, 2) - ij_matrix%dd(11, k, l) = d(k, 3)*d(l, 4)+d(k, 4)*d(l, 3) - ij_matrix%dd(12, k, l) = d(k, 1)*d(l, 5)+d(k, 5)*d(l, 1) - ij_matrix%dd(13, k, l) = d(k, 2)*d(l, 5)+d(k, 5)*d(l, 2) - ij_matrix%dd(14, k, l) = d(k, 3)*d(l, 5)+d(k, 5)*d(l, 3) - ij_matrix%dd(15, k, l) = d(k, 4)*d(l, 5)+d(k, 5)*d(l, 4) + ij_matrix%dd(6, k, l) = d(k, 1)*d(l, 2) + d(k, 2)*d(l, 1) + ij_matrix%dd(7, k, l) = d(k, 1)*d(l, 3) + d(k, 3)*d(l, 1) + ij_matrix%dd(8, k, l) = d(k, 2)*d(l, 3) + d(k, 3)*d(l, 2) + ij_matrix%dd(9, k, l) = d(k, 1)*d(l, 4) + d(k, 4)*d(l, 1) + ij_matrix%dd(10, k, l) = d(k, 2)*d(l, 4) + d(k, 4)*d(l, 2) + ij_matrix%dd(11, k, l) = d(k, 3)*d(l, 4) + d(k, 4)*d(l, 3) + ij_matrix%dd(12, k, l) = d(k, 1)*d(l, 5) + d(k, 5)*d(l, 1) + ij_matrix%dd(13, k, l) = d(k, 2)*d(l, 5) + d(k, 5)*d(l, 2) + ij_matrix%dd(14, k, l) = d(k, 3)*d(l, 5) + d(k, 5)*d(l, 3) + ij_matrix%dd(15, k, l) = d(k, 4)*d(l, 5) + d(k, 5)*d(l, 4) END DO END IF END DO @@ -1884,20 +1884,20 @@ RECURSIVE SUBROUTINE rotmat(sepi, sepj, rjiv, r, ij_matrix, do_derivatives, & x22_d = 0.0_dp; x22_d(2) = 1.0_dp x33_d = 0.0_dp; x33_d(3) = 1.0_dp r_d = (/x11, x22, x33/)/r - b_d = 2.0_dp*(x11*x11_d+x22*x22_d) + b_d = 2.0_dp*(x11*x11_d + x22*x22_d) sqb_d = (0.5_dp/sqb)*b_d r2i = 1.0_dp/r**2 sqb2i = 1.0_dp/sqb**2 - cb_d = (x33_d*r-x33*r_d)*r2i - ca_d = (x11_d*sqb-x11*sqb_d)*sqb2i - sa_d = (x22_d*sqb-x22*sqb_d)*sqb2i - sb_d = (sqb_d*r-sqb*r_d)*r2i + cb_d = (x33_d*r - x33*r_d)*r2i + ca_d = (x11_d*sqb - x11*sqb_d)*sqb2i + sa_d = (x22_d*sqb - x22*sqb_d)*sqb2i + sb_d = (sqb_d*r - sqb*r_d)*r2i ! Calculate derivatives of rotation matrix elements - p_d(:, 1, 1) = ca_d*sb+ca*sb_d - p_d(:, 2, 1) = ca_d*cb+ca*cb_d + p_d(:, 1, 1) = ca_d*sb + ca*sb_d + p_d(:, 2, 1) = ca_d*cb + ca*cb_d p_d(:, 3, 1) = -sa_d - p_d(:, 1, 2) = sa_d*sb+sa*sb_d - p_d(:, 2, 2) = sa_d*cb+sa*cb_d + p_d(:, 1, 2) = sa_d*sb + sa*sb_d + p_d(:, 2, 2) = sa_d*cb + sa*cb_d p_d(:, 3, 2) = ca_d p_d(:, 1, 3) = cb_d p_d(:, 2, 3) = -sb_d @@ -1908,33 +1908,33 @@ RECURSIVE SUBROUTINE rotmat(sepi, sepj, rjiv, r, ij_matrix, do_derivatives, & sb2_d = 2.0_dp*sb*sb_d c2a_d = 2.0_dp*ca2_d c2b_d = 2.0_dp*cb2_d - s2a_d = 2.0_dp*(sa_d*ca+sa*ca_d) - s2b_d = 2.0_dp*(sb_d*cb+sb*cb_d) - d_d(:, 1, 1) = pt5sq3*(c2a_d*sb2+c2a*sb2_d) - d_d(:, 2, 1) = 0.5_dp*(c2a_d*s2b+c2a*s2b_d) - d_d(:, 3, 1) = -s2a_d*sb-s2a*sb_d - d_d(:, 4, 1) = c2a_d*(cb2+0.5_dp*sb2)+c2a*(cb2_d+0.5_dp*sb2_d) - d_d(:, 5, 1) = -s2a_d*cb-s2a*cb_d - d_d(:, 1, 2) = pt5sq3*(ca_d*s2b+ca*s2b_d) - d_d(:, 2, 2) = ca_d*c2b+ca*c2b_d - d_d(:, 3, 2) = -sa_d*cb-sa*cb_d - d_d(:, 4, 2) = -0.5_dp*(ca_d*s2b+ca*s2b_d) - d_d(:, 5, 2) = sa_d*sb+sa*sb_d - d_d(:, 1, 3) = cb2_d-0.5_dp*sb2_d + s2a_d = 2.0_dp*(sa_d*ca + sa*ca_d) + s2b_d = 2.0_dp*(sb_d*cb + sb*cb_d) + d_d(:, 1, 1) = pt5sq3*(c2a_d*sb2 + c2a*sb2_d) + d_d(:, 2, 1) = 0.5_dp*(c2a_d*s2b + c2a*s2b_d) + d_d(:, 3, 1) = -s2a_d*sb - s2a*sb_d + d_d(:, 4, 1) = c2a_d*(cb2 + 0.5_dp*sb2) + c2a*(cb2_d + 0.5_dp*sb2_d) + d_d(:, 5, 1) = -s2a_d*cb - s2a*cb_d + d_d(:, 1, 2) = pt5sq3*(ca_d*s2b + ca*s2b_d) + d_d(:, 2, 2) = ca_d*c2b + ca*c2b_d + d_d(:, 3, 2) = -sa_d*cb - sa*cb_d + d_d(:, 4, 2) = -0.5_dp*(ca_d*s2b + ca*s2b_d) + d_d(:, 5, 2) = sa_d*sb + sa*sb_d + d_d(:, 1, 3) = cb2_d - 0.5_dp*sb2_d d_d(:, 2, 3) = -pt5sq3*s2b_d d_d(:, 3, 3) = 0.0_dp d_d(:, 4, 3) = pt5sq3*sb2_d d_d(:, 5, 3) = 0.0_dp - d_d(:, 1, 4) = pt5sq3*(sa_d*s2b+sa*s2b_d) - d_d(:, 2, 4) = sa_d*c2b+sa*c2b_d - d_d(:, 3, 4) = ca_d*cb+ca*cb_d - d_d(:, 4, 4) = -0.5_dp*(sa_d*s2b+sa*s2b_d) - d_d(:, 5, 4) = -ca_d*sb-ca*sb_d - d_d(:, 1, 5) = pt5sq3*(s2a_d*sb2+s2a*sb2_d) - d_d(:, 2, 5) = 0.5_dp*(s2a_d*s2b+s2a*s2b_d) - d_d(:, 3, 5) = c2a_d*sb+c2a*sb_d - d_d(:, 4, 5) = s2a_d*(cb2+0.5_dp*sb2)+s2a*(cb2_d+0.5_dp*sb2_d) - d_d(:, 5, 5) = c2a_d*cb+c2a*cb_d + d_d(:, 1, 4) = pt5sq3*(sa_d*s2b + sa*s2b_d) + d_d(:, 2, 4) = sa_d*c2b + sa*c2b_d + d_d(:, 3, 4) = ca_d*cb + ca*cb_d + d_d(:, 4, 4) = -0.5_dp*(sa_d*s2b + sa*s2b_d) + d_d(:, 5, 4) = -ca_d*sb - ca*sb_d + d_d(:, 1, 5) = pt5sq3*(s2a_d*sb2 + s2a*sb2_d) + d_d(:, 2, 5) = 0.5_dp*(s2a_d*s2b + s2a*s2b_d) + d_d(:, 3, 5) = c2a_d*sb + c2a*sb_d + d_d(:, 4, 5) = s2a_d*(cb2 + 0.5_dp*sb2) + s2a*(cb2_d + 0.5_dp*sb2_d) + d_d(:, 5, 5) = c2a_d*cb + c2a*cb_d END IF ! Derivative for Rotation Elements for : S-P DO k = 1, 3 @@ -1944,23 +1944,23 @@ RECURSIVE SUBROUTINE rotmat(sepi, sepj, rjiv, r, ij_matrix, do_derivatives, & END DO ! Derivative for Rotation Elements for : P-P DO k = 1, 3 - ij_matrix%pp_d(:, 1, k, k) = p_d(:, k, 1)*p(k, 1)+p(k, 1)*p_d(:, k, 1) - ij_matrix%pp_d(:, 2, k, k) = p_d(:, k, 2)*p(k, 2)+p(k, 2)*p_d(:, k, 2) - ij_matrix%pp_d(:, 3, k, k) = p_d(:, k, 3)*p(k, 3)+p(k, 3)*p_d(:, k, 3) - ij_matrix%pp_d(:, 4, k, k) = p_d(:, k, 1)*p(k, 2)+p(k, 1)*p_d(:, k, 2) - ij_matrix%pp_d(:, 5, k, k) = p_d(:, k, 1)*p(k, 3)+p(k, 1)*p_d(:, k, 3) - ij_matrix%pp_d(:, 6, k, k) = p_d(:, k, 2)*p(k, 3)+p(k, 2)*p_d(:, k, 3) + ij_matrix%pp_d(:, 1, k, k) = p_d(:, k, 1)*p(k, 1) + p(k, 1)*p_d(:, k, 1) + ij_matrix%pp_d(:, 2, k, k) = p_d(:, k, 2)*p(k, 2) + p(k, 2)*p_d(:, k, 2) + ij_matrix%pp_d(:, 3, k, k) = p_d(:, k, 3)*p(k, 3) + p(k, 3)*p_d(:, k, 3) + ij_matrix%pp_d(:, 4, k, k) = p_d(:, k, 1)*p(k, 2) + p(k, 1)*p_d(:, k, 2) + ij_matrix%pp_d(:, 5, k, k) = p_d(:, k, 1)*p(k, 3) + p(k, 1)*p_d(:, k, 3) + ij_matrix%pp_d(:, 6, k, k) = p_d(:, k, 2)*p(k, 3) + p(k, 2)*p_d(:, k, 3) IF (k /= 1) THEN - DO l = 1, k-1 - ij_matrix%pp_d(:, 1, k, l) = 2.0_dp*(p_d(:, k, 1)*p(l, 1)+p(k, 1)*p_d(:, l, 1)) - ij_matrix%pp_d(:, 2, k, l) = 2.0_dp*(p_d(:, k, 2)*p(l, 2)+p(k, 2)*p_d(:, l, 2)) - ij_matrix%pp_d(:, 3, k, l) = 2.0_dp*(p_d(:, k, 3)*p(l, 3)+p(k, 3)*p_d(:, l, 3)) - ij_matrix%pp_d(:, 4, k, l) = (p_d(:, k, 1)*p(l, 2)+p(k, 1)*p_d(:, l, 2))+ & - (p_d(:, k, 2)*p(l, 1)+p(k, 2)*p_d(:, l, 1)) - ij_matrix%pp_d(:, 5, k, l) = (p_d(:, k, 1)*p(l, 3)+p(k, 1)*p_d(:, l, 3))+ & - (p_d(:, k, 3)*p(l, 1)+p(k, 3)*p_d(:, l, 1)) - ij_matrix%pp_d(:, 6, k, l) = (p_d(:, k, 2)*p(l, 3)+p(k, 2)*p_d(:, l, 3))+ & - (p_d(:, k, 3)*p(l, 2)+p(k, 3)*p_d(:, l, 2)) + DO l = 1, k - 1 + ij_matrix%pp_d(:, 1, k, l) = 2.0_dp*(p_d(:, k, 1)*p(l, 1) + p(k, 1)*p_d(:, l, 1)) + ij_matrix%pp_d(:, 2, k, l) = 2.0_dp*(p_d(:, k, 2)*p(l, 2) + p(k, 2)*p_d(:, l, 2)) + ij_matrix%pp_d(:, 3, k, l) = 2.0_dp*(p_d(:, k, 3)*p(l, 3) + p(k, 3)*p_d(:, l, 3)) + ij_matrix%pp_d(:, 4, k, l) = (p_d(:, k, 1)*p(l, 2) + p(k, 1)*p_d(:, l, 2)) + & + (p_d(:, k, 2)*p(l, 1) + p(k, 2)*p_d(:, l, 1)) + ij_matrix%pp_d(:, 5, k, l) = (p_d(:, k, 1)*p(l, 3) + p(k, 1)*p_d(:, l, 3)) + & + (p_d(:, k, 3)*p(l, 1) + p(k, 3)*p_d(:, l, 1)) + ij_matrix%pp_d(:, 6, k, l) = (p_d(:, k, 2)*p(l, 3) + p(k, 2)*p_d(:, l, 3)) + & + (p_d(:, k, 3)*p(l, 2) + p(k, 3)*p_d(:, l, 2)) END DO END IF END DO @@ -1974,67 +1974,67 @@ RECURSIVE SUBROUTINE rotmat(sepi, sepj, rjiv, r, ij_matrix, do_derivatives, & ! Rotation Elements for : D-P DO k = 1, 5 DO l = 1, 3 - ij_matrix%pd_d(:, 1, k, l) = (d_d(:, k, 1)*p(l, 1)+d(k, 1)*p_d(:, l, 1)) - ij_matrix%pd_d(:, 2, k, l) = (d_d(:, k, 1)*p(l, 2)+d(k, 1)*p_d(:, l, 2)) - ij_matrix%pd_d(:, 3, k, l) = (d_d(:, k, 1)*p(l, 3)+d(k, 1)*p_d(:, l, 3)) - ij_matrix%pd_d(:, 4, k, l) = (d_d(:, k, 2)*p(l, 1)+d(k, 2)*p_d(:, l, 1)) - ij_matrix%pd_d(:, 5, k, l) = (d_d(:, k, 2)*p(l, 2)+d(k, 2)*p_d(:, l, 2)) - ij_matrix%pd_d(:, 6, k, l) = (d_d(:, k, 2)*p(l, 3)+d(k, 2)*p_d(:, l, 3)) - ij_matrix%pd_d(:, 7, k, l) = (d_d(:, k, 3)*p(l, 1)+d(k, 3)*p_d(:, l, 1)) - ij_matrix%pd_d(:, 8, k, l) = (d_d(:, k, 3)*p(l, 2)+d(k, 3)*p_d(:, l, 2)) - ij_matrix%pd_d(:, 9, k, l) = (d_d(:, k, 3)*p(l, 3)+d(k, 3)*p_d(:, l, 3)) - ij_matrix%pd_d(:, 10, k, l) = (d_d(:, k, 4)*p(l, 1)+d(k, 4)*p_d(:, l, 1)) - ij_matrix%pd_d(:, 11, k, l) = (d_d(:, k, 4)*p(l, 2)+d(k, 4)*p_d(:, l, 2)) - ij_matrix%pd_d(:, 12, k, l) = (d_d(:, k, 4)*p(l, 3)+d(k, 4)*p_d(:, l, 3)) - ij_matrix%pd_d(:, 13, k, l) = (d_d(:, k, 5)*p(l, 1)+d(k, 5)*p_d(:, l, 1)) - ij_matrix%pd_d(:, 14, k, l) = (d_d(:, k, 5)*p(l, 2)+d(k, 5)*p_d(:, l, 2)) - ij_matrix%pd_d(:, 15, k, l) = (d_d(:, k, 5)*p(l, 3)+d(k, 5)*p_d(:, l, 3)) + ij_matrix%pd_d(:, 1, k, l) = (d_d(:, k, 1)*p(l, 1) + d(k, 1)*p_d(:, l, 1)) + ij_matrix%pd_d(:, 2, k, l) = (d_d(:, k, 1)*p(l, 2) + d(k, 1)*p_d(:, l, 2)) + ij_matrix%pd_d(:, 3, k, l) = (d_d(:, k, 1)*p(l, 3) + d(k, 1)*p_d(:, l, 3)) + ij_matrix%pd_d(:, 4, k, l) = (d_d(:, k, 2)*p(l, 1) + d(k, 2)*p_d(:, l, 1)) + ij_matrix%pd_d(:, 5, k, l) = (d_d(:, k, 2)*p(l, 2) + d(k, 2)*p_d(:, l, 2)) + ij_matrix%pd_d(:, 6, k, l) = (d_d(:, k, 2)*p(l, 3) + d(k, 2)*p_d(:, l, 3)) + ij_matrix%pd_d(:, 7, k, l) = (d_d(:, k, 3)*p(l, 1) + d(k, 3)*p_d(:, l, 1)) + ij_matrix%pd_d(:, 8, k, l) = (d_d(:, k, 3)*p(l, 2) + d(k, 3)*p_d(:, l, 2)) + ij_matrix%pd_d(:, 9, k, l) = (d_d(:, k, 3)*p(l, 3) + d(k, 3)*p_d(:, l, 3)) + ij_matrix%pd_d(:, 10, k, l) = (d_d(:, k, 4)*p(l, 1) + d(k, 4)*p_d(:, l, 1)) + ij_matrix%pd_d(:, 11, k, l) = (d_d(:, k, 4)*p(l, 2) + d(k, 4)*p_d(:, l, 2)) + ij_matrix%pd_d(:, 12, k, l) = (d_d(:, k, 4)*p(l, 3) + d(k, 4)*p_d(:, l, 3)) + ij_matrix%pd_d(:, 13, k, l) = (d_d(:, k, 5)*p(l, 1) + d(k, 5)*p_d(:, l, 1)) + ij_matrix%pd_d(:, 14, k, l) = (d_d(:, k, 5)*p(l, 2) + d(k, 5)*p_d(:, l, 2)) + ij_matrix%pd_d(:, 15, k, l) = (d_d(:, k, 5)*p(l, 3) + d(k, 5)*p_d(:, l, 3)) END DO END DO ! Rotation Elements for : D-D DO k = 1, 5 - ij_matrix%dd_d(:, 1, k, k) = (d_d(:, k, 1)*d(k, 1)+d(k, 1)*d_d(:, k, 1)) - ij_matrix%dd_d(:, 2, k, k) = (d_d(:, k, 2)*d(k, 2)+d(k, 2)*d_d(:, k, 2)) - ij_matrix%dd_d(:, 3, k, k) = (d_d(:, k, 3)*d(k, 3)+d(k, 3)*d_d(:, k, 3)) - ij_matrix%dd_d(:, 4, k, k) = (d_d(:, k, 4)*d(k, 4)+d(k, 4)*d_d(:, k, 4)) - ij_matrix%dd_d(:, 5, k, k) = (d_d(:, k, 5)*d(k, 5)+d(k, 5)*d_d(:, k, 5)) - ij_matrix%dd_d(:, 6, k, k) = (d_d(:, k, 1)*d(k, 2)+d(k, 1)*d_d(:, k, 2)) - ij_matrix%dd_d(:, 7, k, k) = (d_d(:, k, 1)*d(k, 3)+d(k, 1)*d_d(:, k, 3)) - ij_matrix%dd_d(:, 8, k, k) = (d_d(:, k, 2)*d(k, 3)+d(k, 2)*d_d(:, k, 3)) - ij_matrix%dd_d(:, 9, k, k) = (d_d(:, k, 1)*d(k, 4)+d(k, 1)*d_d(:, k, 4)) - ij_matrix%dd_d(:, 10, k, k) = (d_d(:, k, 2)*d(k, 4)+d(k, 2)*d_d(:, k, 4)) - ij_matrix%dd_d(:, 11, k, k) = (d_d(:, k, 3)*d(k, 4)+d(k, 3)*d_d(:, k, 4)) - ij_matrix%dd_d(:, 12, k, k) = (d_d(:, k, 1)*d(k, 5)+d(k, 1)*d_d(:, k, 5)) - ij_matrix%dd_d(:, 13, k, k) = (d_d(:, k, 2)*d(k, 5)+d(k, 2)*d_d(:, k, 5)) - ij_matrix%dd_d(:, 14, k, k) = (d_d(:, k, 3)*d(k, 5)+d(k, 3)*d_d(:, k, 5)) - ij_matrix%dd_d(:, 15, k, k) = (d_d(:, k, 4)*d(k, 5)+d(k, 4)*d_d(:, k, 5)) + ij_matrix%dd_d(:, 1, k, k) = (d_d(:, k, 1)*d(k, 1) + d(k, 1)*d_d(:, k, 1)) + ij_matrix%dd_d(:, 2, k, k) = (d_d(:, k, 2)*d(k, 2) + d(k, 2)*d_d(:, k, 2)) + ij_matrix%dd_d(:, 3, k, k) = (d_d(:, k, 3)*d(k, 3) + d(k, 3)*d_d(:, k, 3)) + ij_matrix%dd_d(:, 4, k, k) = (d_d(:, k, 4)*d(k, 4) + d(k, 4)*d_d(:, k, 4)) + ij_matrix%dd_d(:, 5, k, k) = (d_d(:, k, 5)*d(k, 5) + d(k, 5)*d_d(:, k, 5)) + ij_matrix%dd_d(:, 6, k, k) = (d_d(:, k, 1)*d(k, 2) + d(k, 1)*d_d(:, k, 2)) + ij_matrix%dd_d(:, 7, k, k) = (d_d(:, k, 1)*d(k, 3) + d(k, 1)*d_d(:, k, 3)) + ij_matrix%dd_d(:, 8, k, k) = (d_d(:, k, 2)*d(k, 3) + d(k, 2)*d_d(:, k, 3)) + ij_matrix%dd_d(:, 9, k, k) = (d_d(:, k, 1)*d(k, 4) + d(k, 1)*d_d(:, k, 4)) + ij_matrix%dd_d(:, 10, k, k) = (d_d(:, k, 2)*d(k, 4) + d(k, 2)*d_d(:, k, 4)) + ij_matrix%dd_d(:, 11, k, k) = (d_d(:, k, 3)*d(k, 4) + d(k, 3)*d_d(:, k, 4)) + ij_matrix%dd_d(:, 12, k, k) = (d_d(:, k, 1)*d(k, 5) + d(k, 1)*d_d(:, k, 5)) + ij_matrix%dd_d(:, 13, k, k) = (d_d(:, k, 2)*d(k, 5) + d(k, 2)*d_d(:, k, 5)) + ij_matrix%dd_d(:, 14, k, k) = (d_d(:, k, 3)*d(k, 5) + d(k, 3)*d_d(:, k, 5)) + ij_matrix%dd_d(:, 15, k, k) = (d_d(:, k, 4)*d(k, 5) + d(k, 4)*d_d(:, k, 5)) IF (k /= 1) THEN - DO l = 1, k-1 - ij_matrix%dd_d(:, 1, k, l) = 2.0_dp*(d_d(:, k, 1)*d(l, 1)+d(k, 1)*d_d(:, l, 1)) - ij_matrix%dd_d(:, 2, k, l) = 2.0_dp*(d_d(:, k, 2)*d(l, 2)+d(k, 2)*d_d(:, l, 2)) - ij_matrix%dd_d(:, 3, k, l) = 2.0_dp*(d_d(:, k, 3)*d(l, 3)+d(k, 3)*d_d(:, l, 3)) - ij_matrix%dd_d(:, 4, k, l) = 2.0_dp*(d_d(:, k, 4)*d(l, 4)+d(k, 4)*d_d(:, l, 4)) - ij_matrix%dd_d(:, 5, k, l) = 2.0_dp*(d_d(:, k, 5)*d(l, 5)+d(k, 5)*d_d(:, l, 5)) - ij_matrix%dd_d(:, 6, k, l) = (d_d(:, k, 1)*d(l, 2)+d(k, 1)*d_d(:, l, 2))+ & - (d_d(:, k, 2)*d(l, 1)+d(k, 2)*d_d(:, l, 1)) - ij_matrix%dd_d(:, 7, k, l) = (d_d(:, k, 1)*d(l, 3)+d(k, 1)*d_d(:, l, 3))+ & - (d_d(:, k, 3)*d(l, 1)+d(k, 3)*d_d(:, l, 1)) - ij_matrix%dd_d(:, 8, k, l) = (d_d(:, k, 2)*d(l, 3)+d(k, 2)*d_d(:, l, 3))+ & - (d_d(:, k, 3)*d(l, 2)+d(k, 3)*d_d(:, l, 2)) - ij_matrix%dd_d(:, 9, k, l) = (d_d(:, k, 1)*d(l, 4)+d(k, 1)*d_d(:, l, 4))+ & - (d_d(:, k, 4)*d(l, 1)+d(k, 4)*d_d(:, l, 1)) - ij_matrix%dd_d(:, 10, k, l) = (d_d(:, k, 2)*d(l, 4)+d(k, 2)*d_d(:, l, 4))+ & - (d_d(:, k, 4)*d(l, 2)+d(k, 4)*d_d(:, l, 2)) - ij_matrix%dd_d(:, 11, k, l) = (d_d(:, k, 3)*d(l, 4)+d(k, 3)*d_d(:, l, 4))+ & - (d_d(:, k, 4)*d(l, 3)+d(k, 4)*d_d(:, l, 3)) - ij_matrix%dd_d(:, 12, k, l) = (d_d(:, k, 1)*d(l, 5)+d(k, 1)*d_d(:, l, 5))+ & - (d_d(:, k, 5)*d(l, 1)+d(k, 5)*d_d(:, l, 1)) - ij_matrix%dd_d(:, 13, k, l) = (d_d(:, k, 2)*d(l, 5)+d(k, 2)*d_d(:, l, 5))+ & - (d_d(:, k, 5)*d(l, 2)+d(k, 5)*d_d(:, l, 2)) - ij_matrix%dd_d(:, 14, k, l) = (d_d(:, k, 3)*d(l, 5)+d(k, 3)*d_d(:, l, 5))+ & - (d_d(:, k, 5)*d(l, 3)+d(k, 5)*d_d(:, l, 3)) - ij_matrix%dd_d(:, 15, k, l) = (d_d(:, k, 4)*d(l, 5)+d(k, 4)*d_d(:, l, 5))+ & - (d_d(:, k, 5)*d(l, 4)+d(k, 5)*d_d(:, l, 4)) + DO l = 1, k - 1 + ij_matrix%dd_d(:, 1, k, l) = 2.0_dp*(d_d(:, k, 1)*d(l, 1) + d(k, 1)*d_d(:, l, 1)) + ij_matrix%dd_d(:, 2, k, l) = 2.0_dp*(d_d(:, k, 2)*d(l, 2) + d(k, 2)*d_d(:, l, 2)) + ij_matrix%dd_d(:, 3, k, l) = 2.0_dp*(d_d(:, k, 3)*d(l, 3) + d(k, 3)*d_d(:, l, 3)) + ij_matrix%dd_d(:, 4, k, l) = 2.0_dp*(d_d(:, k, 4)*d(l, 4) + d(k, 4)*d_d(:, l, 4)) + ij_matrix%dd_d(:, 5, k, l) = 2.0_dp*(d_d(:, k, 5)*d(l, 5) + d(k, 5)*d_d(:, l, 5)) + ij_matrix%dd_d(:, 6, k, l) = (d_d(:, k, 1)*d(l, 2) + d(k, 1)*d_d(:, l, 2)) + & + (d_d(:, k, 2)*d(l, 1) + d(k, 2)*d_d(:, l, 1)) + ij_matrix%dd_d(:, 7, k, l) = (d_d(:, k, 1)*d(l, 3) + d(k, 1)*d_d(:, l, 3)) + & + (d_d(:, k, 3)*d(l, 1) + d(k, 3)*d_d(:, l, 1)) + ij_matrix%dd_d(:, 8, k, l) = (d_d(:, k, 2)*d(l, 3) + d(k, 2)*d_d(:, l, 3)) + & + (d_d(:, k, 3)*d(l, 2) + d(k, 3)*d_d(:, l, 2)) + ij_matrix%dd_d(:, 9, k, l) = (d_d(:, k, 1)*d(l, 4) + d(k, 1)*d_d(:, l, 4)) + & + (d_d(:, k, 4)*d(l, 1) + d(k, 4)*d_d(:, l, 1)) + ij_matrix%dd_d(:, 10, k, l) = (d_d(:, k, 2)*d(l, 4) + d(k, 2)*d_d(:, l, 4)) + & + (d_d(:, k, 4)*d(l, 2) + d(k, 4)*d_d(:, l, 2)) + ij_matrix%dd_d(:, 11, k, l) = (d_d(:, k, 3)*d(l, 4) + d(k, 3)*d_d(:, l, 4)) + & + (d_d(:, k, 4)*d(l, 3) + d(k, 4)*d_d(:, l, 3)) + ij_matrix%dd_d(:, 12, k, l) = (d_d(:, k, 1)*d(l, 5) + d(k, 1)*d_d(:, l, 5)) + & + (d_d(:, k, 5)*d(l, 1) + d(k, 5)*d_d(:, l, 1)) + ij_matrix%dd_d(:, 13, k, l) = (d_d(:, k, 2)*d(l, 5) + d(k, 2)*d_d(:, l, 5)) + & + (d_d(:, k, 5)*d(l, 2) + d(k, 5)*d_d(:, l, 2)) + ij_matrix%dd_d(:, 14, k, l) = (d_d(:, k, 3)*d(l, 5) + d(k, 3)*d_d(:, l, 5)) + & + (d_d(:, k, 5)*d(l, 3) + d(k, 5)*d_d(:, l, 3)) + ij_matrix%dd_d(:, 15, k, l) = (d_d(:, k, 4)*d(l, 5) + d(k, 4)*d_d(:, l, 5)) + & + (d_d(:, k, 5)*d(l, 4) + d(k, 5)*d_d(:, l, 4)) END DO END IF END DO @@ -2129,62 +2129,62 @@ RECURSIVE SUBROUTINE rot_2el_2c_first(sepi, sepj, rijv, se_int_control, se_taper IF (mm == 1) THEN v(ij, 1) = wrepp ELSE IF (mm == 2) THEN - k = k1-1 - v(ij, 2) = v(ij, 2)+ij_matrix%sp(k, 1)*wrepp - v(ij, 4) = v(ij, 4)+ij_matrix%sp(k, 2)*wrepp - v(ij, 7) = v(ij, 7)+ij_matrix%sp(k, 3)*wrepp + k = k1 - 1 + v(ij, 2) = v(ij, 2) + ij_matrix%sp(k, 1)*wrepp + v(ij, 4) = v(ij, 4) + ij_matrix%sp(k, 2)*wrepp + v(ij, 7) = v(ij, 7) + ij_matrix%sp(k, 3)*wrepp ELSE IF (mm == 3) THEN - k = k1-1 - l = l1-1 - v(ij, 3) = v(ij, 3)+ij_matrix%pp(1, k, l)*wrepp - v(ij, 6) = v(ij, 6)+ij_matrix%pp(2, k, l)*wrepp - v(ij, 10) = v(ij, 10)+ij_matrix%pp(3, k, l)*wrepp - v(ij, 5) = v(ij, 5)+ij_matrix%pp(4, k, l)*wrepp - v(ij, 8) = v(ij, 8)+ij_matrix%pp(5, k, l)*wrepp - v(ij, 9) = v(ij, 9)+ij_matrix%pp(6, k, l)*wrepp + k = k1 - 1 + l = l1 - 1 + v(ij, 3) = v(ij, 3) + ij_matrix%pp(1, k, l)*wrepp + v(ij, 6) = v(ij, 6) + ij_matrix%pp(2, k, l)*wrepp + v(ij, 10) = v(ij, 10) + ij_matrix%pp(3, k, l)*wrepp + v(ij, 5) = v(ij, 5) + ij_matrix%pp(4, k, l)*wrepp + v(ij, 8) = v(ij, 8) + ij_matrix%pp(5, k, l)*wrepp + v(ij, 9) = v(ij, 9) + ij_matrix%pp(6, k, l)*wrepp ELSE IF (mm == 4) THEN - k = k1-4 - v(ij, 11) = v(ij, 11)+ij_matrix%sd(k, 1)*wrepp - v(ij, 16) = v(ij, 16)+ij_matrix%sd(k, 2)*wrepp - v(ij, 22) = v(ij, 22)+ij_matrix%sd(k, 3)*wrepp - v(ij, 29) = v(ij, 29)+ij_matrix%sd(k, 4)*wrepp - v(ij, 37) = v(ij, 37)+ij_matrix%sd(k, 5)*wrepp + k = k1 - 4 + v(ij, 11) = v(ij, 11) + ij_matrix%sd(k, 1)*wrepp + v(ij, 16) = v(ij, 16) + ij_matrix%sd(k, 2)*wrepp + v(ij, 22) = v(ij, 22) + ij_matrix%sd(k, 3)*wrepp + v(ij, 29) = v(ij, 29) + ij_matrix%sd(k, 4)*wrepp + v(ij, 37) = v(ij, 37) + ij_matrix%sd(k, 5)*wrepp ELSE IF (mm == 5) THEN - k = k1-4 - l = l1-1 - v(ij, 12) = v(ij, 12)+ij_matrix%pd(1, k, l)*wrepp - v(ij, 13) = v(ij, 13)+ij_matrix%pd(2, k, l)*wrepp - v(ij, 14) = v(ij, 14)+ij_matrix%pd(3, k, l)*wrepp - v(ij, 17) = v(ij, 17)+ij_matrix%pd(4, k, l)*wrepp - v(ij, 18) = v(ij, 18)+ij_matrix%pd(5, k, l)*wrepp - v(ij, 19) = v(ij, 19)+ij_matrix%pd(6, k, l)*wrepp - v(ij, 23) = v(ij, 23)+ij_matrix%pd(7, k, l)*wrepp - v(ij, 24) = v(ij, 24)+ij_matrix%pd(8, k, l)*wrepp - v(ij, 25) = v(ij, 25)+ij_matrix%pd(9, k, l)*wrepp - v(ij, 30) = v(ij, 30)+ij_matrix%pd(10, k, l)*wrepp - v(ij, 31) = v(ij, 31)+ij_matrix%pd(11, k, l)*wrepp - v(ij, 32) = v(ij, 32)+ij_matrix%pd(12, k, l)*wrepp - v(ij, 38) = v(ij, 38)+ij_matrix%pd(13, k, l)*wrepp - v(ij, 39) = v(ij, 39)+ij_matrix%pd(14, k, l)*wrepp - v(ij, 40) = v(ij, 40)+ij_matrix%pd(15, k, l)*wrepp + k = k1 - 4 + l = l1 - 1 + v(ij, 12) = v(ij, 12) + ij_matrix%pd(1, k, l)*wrepp + v(ij, 13) = v(ij, 13) + ij_matrix%pd(2, k, l)*wrepp + v(ij, 14) = v(ij, 14) + ij_matrix%pd(3, k, l)*wrepp + v(ij, 17) = v(ij, 17) + ij_matrix%pd(4, k, l)*wrepp + v(ij, 18) = v(ij, 18) + ij_matrix%pd(5, k, l)*wrepp + v(ij, 19) = v(ij, 19) + ij_matrix%pd(6, k, l)*wrepp + v(ij, 23) = v(ij, 23) + ij_matrix%pd(7, k, l)*wrepp + v(ij, 24) = v(ij, 24) + ij_matrix%pd(8, k, l)*wrepp + v(ij, 25) = v(ij, 25) + ij_matrix%pd(9, k, l)*wrepp + v(ij, 30) = v(ij, 30) + ij_matrix%pd(10, k, l)*wrepp + v(ij, 31) = v(ij, 31) + ij_matrix%pd(11, k, l)*wrepp + v(ij, 32) = v(ij, 32) + ij_matrix%pd(12, k, l)*wrepp + v(ij, 38) = v(ij, 38) + ij_matrix%pd(13, k, l)*wrepp + v(ij, 39) = v(ij, 39) + ij_matrix%pd(14, k, l)*wrepp + v(ij, 40) = v(ij, 40) + ij_matrix%pd(15, k, l)*wrepp ELSE IF (mm == 6) THEN - k = k1-4 - l = l1-4 - v(ij, 15) = v(ij, 15)+ij_matrix%dd(1, k, l)*wrepp - v(ij, 21) = v(ij, 21)+ij_matrix%dd(2, k, l)*wrepp - v(ij, 28) = v(ij, 28)+ij_matrix%dd(3, k, l)*wrepp - v(ij, 36) = v(ij, 36)+ij_matrix%dd(4, k, l)*wrepp - v(ij, 45) = v(ij, 45)+ij_matrix%dd(5, k, l)*wrepp - v(ij, 20) = v(ij, 20)+ij_matrix%dd(6, k, l)*wrepp - v(ij, 26) = v(ij, 26)+ij_matrix%dd(7, k, l)*wrepp - v(ij, 27) = v(ij, 27)+ij_matrix%dd(8, k, l)*wrepp - v(ij, 33) = v(ij, 33)+ij_matrix%dd(9, k, l)*wrepp - v(ij, 34) = v(ij, 34)+ij_matrix%dd(10, k, l)*wrepp - v(ij, 35) = v(ij, 35)+ij_matrix%dd(11, k, l)*wrepp - v(ij, 41) = v(ij, 41)+ij_matrix%dd(12, k, l)*wrepp - v(ij, 42) = v(ij, 42)+ij_matrix%dd(13, k, l)*wrepp - v(ij, 43) = v(ij, 43)+ij_matrix%dd(14, k, l)*wrepp - v(ij, 44) = v(ij, 44)+ij_matrix%dd(15, k, l)*wrepp + k = k1 - 4 + l = l1 - 4 + v(ij, 15) = v(ij, 15) + ij_matrix%dd(1, k, l)*wrepp + v(ij, 21) = v(ij, 21) + ij_matrix%dd(2, k, l)*wrepp + v(ij, 28) = v(ij, 28) + ij_matrix%dd(3, k, l)*wrepp + v(ij, 36) = v(ij, 36) + ij_matrix%dd(4, k, l)*wrepp + v(ij, 45) = v(ij, 45) + ij_matrix%dd(5, k, l)*wrepp + v(ij, 20) = v(ij, 20) + ij_matrix%dd(6, k, l)*wrepp + v(ij, 26) = v(ij, 26) + ij_matrix%dd(7, k, l)*wrepp + v(ij, 27) = v(ij, 27) + ij_matrix%dd(8, k, l)*wrepp + v(ij, 33) = v(ij, 33) + ij_matrix%dd(9, k, l)*wrepp + v(ij, 34) = v(ij, 34) + ij_matrix%dd(10, k, l)*wrepp + v(ij, 35) = v(ij, 35) + ij_matrix%dd(11, k, l)*wrepp + v(ij, 41) = v(ij, 41) + ij_matrix%dd(12, k, l)*wrepp + v(ij, 42) = v(ij, 42) + ij_matrix%dd(13, k, l)*wrepp + v(ij, 43) = v(ij, 43) + ij_matrix%dd(14, k, l)*wrepp + v(ij, 44) = v(ij, 44) + ij_matrix%dd(15, k, l)*wrepp END IF END IF END DO @@ -2225,160 +2225,160 @@ RECURSIVE SUBROUTINE rot_2el_2c_first(sepi, sepj, rijv, se_int_control, se_taper v_d(2, ij, 1) = wrepp_d(2) v_d(3, ij, 1) = wrepp_d(3) ELSE IF (mm == 2) THEN - k = k1-1 - v_d(1, ij, 2) = v_d(1, ij, 2)+ij_matrix%sp_d(1, k, 1)*wrepp+ij_matrix%sp(k, 1)*wrepp_d(1) - v_d(1, ij, 4) = v_d(1, ij, 4)+ij_matrix%sp_d(1, k, 2)*wrepp+ij_matrix%sp(k, 2)*wrepp_d(1) - v_d(1, ij, 7) = v_d(1, ij, 7)+ij_matrix%sp_d(1, k, 3)*wrepp+ij_matrix%sp(k, 3)*wrepp_d(1) - - v_d(2, ij, 2) = v_d(2, ij, 2)+ij_matrix%sp_d(2, k, 1)*wrepp+ij_matrix%sp(k, 1)*wrepp_d(2) - v_d(2, ij, 4) = v_d(2, ij, 4)+ij_matrix%sp_d(2, k, 2)*wrepp+ij_matrix%sp(k, 2)*wrepp_d(2) - v_d(2, ij, 7) = v_d(2, ij, 7)+ij_matrix%sp_d(2, k, 3)*wrepp+ij_matrix%sp(k, 3)*wrepp_d(2) - - v_d(3, ij, 2) = v_d(3, ij, 2)+ij_matrix%sp_d(3, k, 1)*wrepp+ij_matrix%sp(k, 1)*wrepp_d(3) - v_d(3, ij, 4) = v_d(3, ij, 4)+ij_matrix%sp_d(3, k, 2)*wrepp+ij_matrix%sp(k, 2)*wrepp_d(3) - v_d(3, ij, 7) = v_d(3, ij, 7)+ij_matrix%sp_d(3, k, 3)*wrepp+ij_matrix%sp(k, 3)*wrepp_d(3) + k = k1 - 1 + v_d(1, ij, 2) = v_d(1, ij, 2) + ij_matrix%sp_d(1, k, 1)*wrepp + ij_matrix%sp(k, 1)*wrepp_d(1) + v_d(1, ij, 4) = v_d(1, ij, 4) + ij_matrix%sp_d(1, k, 2)*wrepp + ij_matrix%sp(k, 2)*wrepp_d(1) + v_d(1, ij, 7) = v_d(1, ij, 7) + ij_matrix%sp_d(1, k, 3)*wrepp + ij_matrix%sp(k, 3)*wrepp_d(1) + + v_d(2, ij, 2) = v_d(2, ij, 2) + ij_matrix%sp_d(2, k, 1)*wrepp + ij_matrix%sp(k, 1)*wrepp_d(2) + v_d(2, ij, 4) = v_d(2, ij, 4) + ij_matrix%sp_d(2, k, 2)*wrepp + ij_matrix%sp(k, 2)*wrepp_d(2) + v_d(2, ij, 7) = v_d(2, ij, 7) + ij_matrix%sp_d(2, k, 3)*wrepp + ij_matrix%sp(k, 3)*wrepp_d(2) + + v_d(3, ij, 2) = v_d(3, ij, 2) + ij_matrix%sp_d(3, k, 1)*wrepp + ij_matrix%sp(k, 1)*wrepp_d(3) + v_d(3, ij, 4) = v_d(3, ij, 4) + ij_matrix%sp_d(3, k, 2)*wrepp + ij_matrix%sp(k, 2)*wrepp_d(3) + v_d(3, ij, 7) = v_d(3, ij, 7) + ij_matrix%sp_d(3, k, 3)*wrepp + ij_matrix%sp(k, 3)*wrepp_d(3) ELSE IF (mm == 3) THEN - k = k1-1 - l = l1-1 - v_d(1, ij, 3) = v_d(1, ij, 3)+ij_matrix%pp_d(1, 1, k, l)*wrepp+ij_matrix%pp(1, k, l)*wrepp_d(1) - v_d(1, ij, 6) = v_d(1, ij, 6)+ij_matrix%pp_d(1, 2, k, l)*wrepp+ij_matrix%pp(2, k, l)*wrepp_d(1) - v_d(1, ij, 10) = v_d(1, ij, 10)+ij_matrix%pp_d(1, 3, k, l)*wrepp+ij_matrix%pp(3, k, l)*wrepp_d(1) - v_d(1, ij, 5) = v_d(1, ij, 5)+ij_matrix%pp_d(1, 4, k, l)*wrepp+ij_matrix%pp(4, k, l)*wrepp_d(1) - v_d(1, ij, 8) = v_d(1, ij, 8)+ij_matrix%pp_d(1, 5, k, l)*wrepp+ij_matrix%pp(5, k, l)*wrepp_d(1) - v_d(1, ij, 9) = v_d(1, ij, 9)+ij_matrix%pp_d(1, 6, k, l)*wrepp+ij_matrix%pp(6, k, l)*wrepp_d(1) - - v_d(2, ij, 3) = v_d(2, ij, 3)+ij_matrix%pp_d(2, 1, k, l)*wrepp+ij_matrix%pp(1, k, l)*wrepp_d(2) - v_d(2, ij, 6) = v_d(2, ij, 6)+ij_matrix%pp_d(2, 2, k, l)*wrepp+ij_matrix%pp(2, k, l)*wrepp_d(2) - v_d(2, ij, 10) = v_d(2, ij, 10)+ij_matrix%pp_d(2, 3, k, l)*wrepp+ij_matrix%pp(3, k, l)*wrepp_d(2) - v_d(2, ij, 5) = v_d(2, ij, 5)+ij_matrix%pp_d(2, 4, k, l)*wrepp+ij_matrix%pp(4, k, l)*wrepp_d(2) - v_d(2, ij, 8) = v_d(2, ij, 8)+ij_matrix%pp_d(2, 5, k, l)*wrepp+ij_matrix%pp(5, k, l)*wrepp_d(2) - v_d(2, ij, 9) = v_d(2, ij, 9)+ij_matrix%pp_d(2, 6, k, l)*wrepp+ij_matrix%pp(6, k, l)*wrepp_d(2) - - v_d(3, ij, 3) = v_d(3, ij, 3)+ij_matrix%pp_d(3, 1, k, l)*wrepp+ij_matrix%pp(1, k, l)*wrepp_d(3) - v_d(3, ij, 6) = v_d(3, ij, 6)+ij_matrix%pp_d(3, 2, k, l)*wrepp+ij_matrix%pp(2, k, l)*wrepp_d(3) - v_d(3, ij, 10) = v_d(3, ij, 10)+ij_matrix%pp_d(3, 3, k, l)*wrepp+ij_matrix%pp(3, k, l)*wrepp_d(3) - v_d(3, ij, 5) = v_d(3, ij, 5)+ij_matrix%pp_d(3, 4, k, l)*wrepp+ij_matrix%pp(4, k, l)*wrepp_d(3) - v_d(3, ij, 8) = v_d(3, ij, 8)+ij_matrix%pp_d(3, 5, k, l)*wrepp+ij_matrix%pp(5, k, l)*wrepp_d(3) - v_d(3, ij, 9) = v_d(3, ij, 9)+ij_matrix%pp_d(3, 6, k, l)*wrepp+ij_matrix%pp(6, k, l)*wrepp_d(3) + k = k1 - 1 + l = l1 - 1 + v_d(1, ij, 3) = v_d(1, ij, 3) + ij_matrix%pp_d(1, 1, k, l)*wrepp + ij_matrix%pp(1, k, l)*wrepp_d(1) + v_d(1, ij, 6) = v_d(1, ij, 6) + ij_matrix%pp_d(1, 2, k, l)*wrepp + ij_matrix%pp(2, k, l)*wrepp_d(1) + v_d(1, ij, 10) = v_d(1, ij, 10) + ij_matrix%pp_d(1, 3, k, l)*wrepp + ij_matrix%pp(3, k, l)*wrepp_d(1) + v_d(1, ij, 5) = v_d(1, ij, 5) + ij_matrix%pp_d(1, 4, k, l)*wrepp + ij_matrix%pp(4, k, l)*wrepp_d(1) + v_d(1, ij, 8) = v_d(1, ij, 8) + ij_matrix%pp_d(1, 5, k, l)*wrepp + ij_matrix%pp(5, k, l)*wrepp_d(1) + v_d(1, ij, 9) = v_d(1, ij, 9) + ij_matrix%pp_d(1, 6, k, l)*wrepp + ij_matrix%pp(6, k, l)*wrepp_d(1) + + v_d(2, ij, 3) = v_d(2, ij, 3) + ij_matrix%pp_d(2, 1, k, l)*wrepp + ij_matrix%pp(1, k, l)*wrepp_d(2) + v_d(2, ij, 6) = v_d(2, ij, 6) + ij_matrix%pp_d(2, 2, k, l)*wrepp + ij_matrix%pp(2, k, l)*wrepp_d(2) + v_d(2, ij, 10) = v_d(2, ij, 10) + ij_matrix%pp_d(2, 3, k, l)*wrepp + ij_matrix%pp(3, k, l)*wrepp_d(2) + v_d(2, ij, 5) = v_d(2, ij, 5) + ij_matrix%pp_d(2, 4, k, l)*wrepp + ij_matrix%pp(4, k, l)*wrepp_d(2) + v_d(2, ij, 8) = v_d(2, ij, 8) + ij_matrix%pp_d(2, 5, k, l)*wrepp + ij_matrix%pp(5, k, l)*wrepp_d(2) + v_d(2, ij, 9) = v_d(2, ij, 9) + ij_matrix%pp_d(2, 6, k, l)*wrepp + ij_matrix%pp(6, k, l)*wrepp_d(2) + + v_d(3, ij, 3) = v_d(3, ij, 3) + ij_matrix%pp_d(3, 1, k, l)*wrepp + ij_matrix%pp(1, k, l)*wrepp_d(3) + v_d(3, ij, 6) = v_d(3, ij, 6) + ij_matrix%pp_d(3, 2, k, l)*wrepp + ij_matrix%pp(2, k, l)*wrepp_d(3) + v_d(3, ij, 10) = v_d(3, ij, 10) + ij_matrix%pp_d(3, 3, k, l)*wrepp + ij_matrix%pp(3, k, l)*wrepp_d(3) + v_d(3, ij, 5) = v_d(3, ij, 5) + ij_matrix%pp_d(3, 4, k, l)*wrepp + ij_matrix%pp(4, k, l)*wrepp_d(3) + v_d(3, ij, 8) = v_d(3, ij, 8) + ij_matrix%pp_d(3, 5, k, l)*wrepp + ij_matrix%pp(5, k, l)*wrepp_d(3) + v_d(3, ij, 9) = v_d(3, ij, 9) + ij_matrix%pp_d(3, 6, k, l)*wrepp + ij_matrix%pp(6, k, l)*wrepp_d(3) ELSE IF (mm == 4) THEN - k = k1-4 - v_d(1, ij, 11) = v_d(1, ij, 11)+ij_matrix%sd_d(1, k, 1)*wrepp+ij_matrix%sd(k, 1)*wrepp_d(1) - v_d(1, ij, 16) = v_d(1, ij, 16)+ij_matrix%sd_d(1, k, 2)*wrepp+ij_matrix%sd(k, 2)*wrepp_d(1) - v_d(1, ij, 22) = v_d(1, ij, 22)+ij_matrix%sd_d(1, k, 3)*wrepp+ij_matrix%sd(k, 3)*wrepp_d(1) - v_d(1, ij, 29) = v_d(1, ij, 29)+ij_matrix%sd_d(1, k, 4)*wrepp+ij_matrix%sd(k, 4)*wrepp_d(1) - v_d(1, ij, 37) = v_d(1, ij, 37)+ij_matrix%sd_d(1, k, 5)*wrepp+ij_matrix%sd(k, 5)*wrepp_d(1) - - v_d(2, ij, 11) = v_d(2, ij, 11)+ij_matrix%sd_d(2, k, 1)*wrepp+ij_matrix%sd(k, 1)*wrepp_d(2) - v_d(2, ij, 16) = v_d(2, ij, 16)+ij_matrix%sd_d(2, k, 2)*wrepp+ij_matrix%sd(k, 2)*wrepp_d(2) - v_d(2, ij, 22) = v_d(2, ij, 22)+ij_matrix%sd_d(2, k, 3)*wrepp+ij_matrix%sd(k, 3)*wrepp_d(2) - v_d(2, ij, 29) = v_d(2, ij, 29)+ij_matrix%sd_d(2, k, 4)*wrepp+ij_matrix%sd(k, 4)*wrepp_d(2) - v_d(2, ij, 37) = v_d(2, ij, 37)+ij_matrix%sd_d(2, k, 5)*wrepp+ij_matrix%sd(k, 5)*wrepp_d(2) - - v_d(3, ij, 11) = v_d(3, ij, 11)+ij_matrix%sd_d(3, k, 1)*wrepp+ij_matrix%sd(k, 1)*wrepp_d(3) - v_d(3, ij, 16) = v_d(3, ij, 16)+ij_matrix%sd_d(3, k, 2)*wrepp+ij_matrix%sd(k, 2)*wrepp_d(3) - v_d(3, ij, 22) = v_d(3, ij, 22)+ij_matrix%sd_d(3, k, 3)*wrepp+ij_matrix%sd(k, 3)*wrepp_d(3) - v_d(3, ij, 29) = v_d(3, ij, 29)+ij_matrix%sd_d(3, k, 4)*wrepp+ij_matrix%sd(k, 4)*wrepp_d(3) - v_d(3, ij, 37) = v_d(3, ij, 37)+ij_matrix%sd_d(3, k, 5)*wrepp+ij_matrix%sd(k, 5)*wrepp_d(3) + k = k1 - 4 + v_d(1, ij, 11) = v_d(1, ij, 11) + ij_matrix%sd_d(1, k, 1)*wrepp + ij_matrix%sd(k, 1)*wrepp_d(1) + v_d(1, ij, 16) = v_d(1, ij, 16) + ij_matrix%sd_d(1, k, 2)*wrepp + ij_matrix%sd(k, 2)*wrepp_d(1) + v_d(1, ij, 22) = v_d(1, ij, 22) + ij_matrix%sd_d(1, k, 3)*wrepp + ij_matrix%sd(k, 3)*wrepp_d(1) + v_d(1, ij, 29) = v_d(1, ij, 29) + ij_matrix%sd_d(1, k, 4)*wrepp + ij_matrix%sd(k, 4)*wrepp_d(1) + v_d(1, ij, 37) = v_d(1, ij, 37) + ij_matrix%sd_d(1, k, 5)*wrepp + ij_matrix%sd(k, 5)*wrepp_d(1) + + v_d(2, ij, 11) = v_d(2, ij, 11) + ij_matrix%sd_d(2, k, 1)*wrepp + ij_matrix%sd(k, 1)*wrepp_d(2) + v_d(2, ij, 16) = v_d(2, ij, 16) + ij_matrix%sd_d(2, k, 2)*wrepp + ij_matrix%sd(k, 2)*wrepp_d(2) + v_d(2, ij, 22) = v_d(2, ij, 22) + ij_matrix%sd_d(2, k, 3)*wrepp + ij_matrix%sd(k, 3)*wrepp_d(2) + v_d(2, ij, 29) = v_d(2, ij, 29) + ij_matrix%sd_d(2, k, 4)*wrepp + ij_matrix%sd(k, 4)*wrepp_d(2) + v_d(2, ij, 37) = v_d(2, ij, 37) + ij_matrix%sd_d(2, k, 5)*wrepp + ij_matrix%sd(k, 5)*wrepp_d(2) + + v_d(3, ij, 11) = v_d(3, ij, 11) + ij_matrix%sd_d(3, k, 1)*wrepp + ij_matrix%sd(k, 1)*wrepp_d(3) + v_d(3, ij, 16) = v_d(3, ij, 16) + ij_matrix%sd_d(3, k, 2)*wrepp + ij_matrix%sd(k, 2)*wrepp_d(3) + v_d(3, ij, 22) = v_d(3, ij, 22) + ij_matrix%sd_d(3, k, 3)*wrepp + ij_matrix%sd(k, 3)*wrepp_d(3) + v_d(3, ij, 29) = v_d(3, ij, 29) + ij_matrix%sd_d(3, k, 4)*wrepp + ij_matrix%sd(k, 4)*wrepp_d(3) + v_d(3, ij, 37) = v_d(3, ij, 37) + ij_matrix%sd_d(3, k, 5)*wrepp + ij_matrix%sd(k, 5)*wrepp_d(3) ELSE IF (mm == 5) THEN - k = k1-4 - l = l1-1 - v_d(1, ij, 12) = v_d(1, ij, 12)+ij_matrix%pd_d(1, 1, k, l)*wrepp+ij_matrix%pd(1, k, l)*wrepp_d(1) - v_d(1, ij, 13) = v_d(1, ij, 13)+ij_matrix%pd_d(1, 2, k, l)*wrepp+ij_matrix%pd(2, k, l)*wrepp_d(1) - v_d(1, ij, 14) = v_d(1, ij, 14)+ij_matrix%pd_d(1, 3, k, l)*wrepp+ij_matrix%pd(3, k, l)*wrepp_d(1) - v_d(1, ij, 17) = v_d(1, ij, 17)+ij_matrix%pd_d(1, 4, k, l)*wrepp+ij_matrix%pd(4, k, l)*wrepp_d(1) - v_d(1, ij, 18) = v_d(1, ij, 18)+ij_matrix%pd_d(1, 5, k, l)*wrepp+ij_matrix%pd(5, k, l)*wrepp_d(1) - v_d(1, ij, 19) = v_d(1, ij, 19)+ij_matrix%pd_d(1, 6, k, l)*wrepp+ij_matrix%pd(6, k, l)*wrepp_d(1) - v_d(1, ij, 23) = v_d(1, ij, 23)+ij_matrix%pd_d(1, 7, k, l)*wrepp+ij_matrix%pd(7, k, l)*wrepp_d(1) - v_d(1, ij, 24) = v_d(1, ij, 24)+ij_matrix%pd_d(1, 8, k, l)*wrepp+ij_matrix%pd(8, k, l)*wrepp_d(1) - v_d(1, ij, 25) = v_d(1, ij, 25)+ij_matrix%pd_d(1, 9, k, l)*wrepp+ij_matrix%pd(9, k, l)*wrepp_d(1) - v_d(1, ij, 30) = v_d(1, ij, 30)+ij_matrix%pd_d(1, 10, k, l)*wrepp+ij_matrix%pd(10, k, l)*wrepp_d(1) - v_d(1, ij, 31) = v_d(1, ij, 31)+ij_matrix%pd_d(1, 11, k, l)*wrepp+ij_matrix%pd(11, k, l)*wrepp_d(1) - v_d(1, ij, 32) = v_d(1, ij, 32)+ij_matrix%pd_d(1, 12, k, l)*wrepp+ij_matrix%pd(12, k, l)*wrepp_d(1) - v_d(1, ij, 38) = v_d(1, ij, 38)+ij_matrix%pd_d(1, 13, k, l)*wrepp+ij_matrix%pd(13, k, l)*wrepp_d(1) - v_d(1, ij, 39) = v_d(1, ij, 39)+ij_matrix%pd_d(1, 14, k, l)*wrepp+ij_matrix%pd(14, k, l)*wrepp_d(1) - v_d(1, ij, 40) = v_d(1, ij, 40)+ij_matrix%pd_d(1, 15, k, l)*wrepp+ij_matrix%pd(15, k, l)*wrepp_d(1) - - v_d(2, ij, 12) = v_d(2, ij, 12)+ij_matrix%pd_d(2, 1, k, l)*wrepp+ij_matrix%pd(1, k, l)*wrepp_d(2) - v_d(2, ij, 13) = v_d(2, ij, 13)+ij_matrix%pd_d(2, 2, k, l)*wrepp+ij_matrix%pd(2, k, l)*wrepp_d(2) - v_d(2, ij, 14) = v_d(2, ij, 14)+ij_matrix%pd_d(2, 3, k, l)*wrepp+ij_matrix%pd(3, k, l)*wrepp_d(2) - v_d(2, ij, 17) = v_d(2, ij, 17)+ij_matrix%pd_d(2, 4, k, l)*wrepp+ij_matrix%pd(4, k, l)*wrepp_d(2) - v_d(2, ij, 18) = v_d(2, ij, 18)+ij_matrix%pd_d(2, 5, k, l)*wrepp+ij_matrix%pd(5, k, l)*wrepp_d(2) - v_d(2, ij, 19) = v_d(2, ij, 19)+ij_matrix%pd_d(2, 6, k, l)*wrepp+ij_matrix%pd(6, k, l)*wrepp_d(2) - v_d(2, ij, 23) = v_d(2, ij, 23)+ij_matrix%pd_d(2, 7, k, l)*wrepp+ij_matrix%pd(7, k, l)*wrepp_d(2) - v_d(2, ij, 24) = v_d(2, ij, 24)+ij_matrix%pd_d(2, 8, k, l)*wrepp+ij_matrix%pd(8, k, l)*wrepp_d(2) - v_d(2, ij, 25) = v_d(2, ij, 25)+ij_matrix%pd_d(2, 9, k, l)*wrepp+ij_matrix%pd(9, k, l)*wrepp_d(2) - v_d(2, ij, 30) = v_d(2, ij, 30)+ij_matrix%pd_d(2, 10, k, l)*wrepp+ij_matrix%pd(10, k, l)*wrepp_d(2) - v_d(2, ij, 31) = v_d(2, ij, 31)+ij_matrix%pd_d(2, 11, k, l)*wrepp+ij_matrix%pd(11, k, l)*wrepp_d(2) - v_d(2, ij, 32) = v_d(2, ij, 32)+ij_matrix%pd_d(2, 12, k, l)*wrepp+ij_matrix%pd(12, k, l)*wrepp_d(2) - v_d(2, ij, 38) = v_d(2, ij, 38)+ij_matrix%pd_d(2, 13, k, l)*wrepp+ij_matrix%pd(13, k, l)*wrepp_d(2) - v_d(2, ij, 39) = v_d(2, ij, 39)+ij_matrix%pd_d(2, 14, k, l)*wrepp+ij_matrix%pd(14, k, l)*wrepp_d(2) - v_d(2, ij, 40) = v_d(2, ij, 40)+ij_matrix%pd_d(2, 15, k, l)*wrepp+ij_matrix%pd(15, k, l)*wrepp_d(2) - - v_d(3, ij, 12) = v_d(3, ij, 12)+ij_matrix%pd_d(3, 1, k, l)*wrepp+ij_matrix%pd(1, k, l)*wrepp_d(3) - v_d(3, ij, 13) = v_d(3, ij, 13)+ij_matrix%pd_d(3, 2, k, l)*wrepp+ij_matrix%pd(2, k, l)*wrepp_d(3) - v_d(3, ij, 14) = v_d(3, ij, 14)+ij_matrix%pd_d(3, 3, k, l)*wrepp+ij_matrix%pd(3, k, l)*wrepp_d(3) - v_d(3, ij, 17) = v_d(3, ij, 17)+ij_matrix%pd_d(3, 4, k, l)*wrepp+ij_matrix%pd(4, k, l)*wrepp_d(3) - v_d(3, ij, 18) = v_d(3, ij, 18)+ij_matrix%pd_d(3, 5, k, l)*wrepp+ij_matrix%pd(5, k, l)*wrepp_d(3) - v_d(3, ij, 19) = v_d(3, ij, 19)+ij_matrix%pd_d(3, 6, k, l)*wrepp+ij_matrix%pd(6, k, l)*wrepp_d(3) - v_d(3, ij, 23) = v_d(3, ij, 23)+ij_matrix%pd_d(3, 7, k, l)*wrepp+ij_matrix%pd(7, k, l)*wrepp_d(3) - v_d(3, ij, 24) = v_d(3, ij, 24)+ij_matrix%pd_d(3, 8, k, l)*wrepp+ij_matrix%pd(8, k, l)*wrepp_d(3) - v_d(3, ij, 25) = v_d(3, ij, 25)+ij_matrix%pd_d(3, 9, k, l)*wrepp+ij_matrix%pd(9, k, l)*wrepp_d(3) - v_d(3, ij, 30) = v_d(3, ij, 30)+ij_matrix%pd_d(3, 10, k, l)*wrepp+ij_matrix%pd(10, k, l)*wrepp_d(3) - v_d(3, ij, 31) = v_d(3, ij, 31)+ij_matrix%pd_d(3, 11, k, l)*wrepp+ij_matrix%pd(11, k, l)*wrepp_d(3) - v_d(3, ij, 32) = v_d(3, ij, 32)+ij_matrix%pd_d(3, 12, k, l)*wrepp+ij_matrix%pd(12, k, l)*wrepp_d(3) - v_d(3, ij, 38) = v_d(3, ij, 38)+ij_matrix%pd_d(3, 13, k, l)*wrepp+ij_matrix%pd(13, k, l)*wrepp_d(3) - v_d(3, ij, 39) = v_d(3, ij, 39)+ij_matrix%pd_d(3, 14, k, l)*wrepp+ij_matrix%pd(14, k, l)*wrepp_d(3) - v_d(3, ij, 40) = v_d(3, ij, 40)+ij_matrix%pd_d(3, 15, k, l)*wrepp+ij_matrix%pd(15, k, l)*wrepp_d(3) + k = k1 - 4 + l = l1 - 1 + v_d(1, ij, 12) = v_d(1, ij, 12) + ij_matrix%pd_d(1, 1, k, l)*wrepp + ij_matrix%pd(1, k, l)*wrepp_d(1) + v_d(1, ij, 13) = v_d(1, ij, 13) + ij_matrix%pd_d(1, 2, k, l)*wrepp + ij_matrix%pd(2, k, l)*wrepp_d(1) + v_d(1, ij, 14) = v_d(1, ij, 14) + ij_matrix%pd_d(1, 3, k, l)*wrepp + ij_matrix%pd(3, k, l)*wrepp_d(1) + v_d(1, ij, 17) = v_d(1, ij, 17) + ij_matrix%pd_d(1, 4, k, l)*wrepp + ij_matrix%pd(4, k, l)*wrepp_d(1) + v_d(1, ij, 18) = v_d(1, ij, 18) + ij_matrix%pd_d(1, 5, k, l)*wrepp + ij_matrix%pd(5, k, l)*wrepp_d(1) + v_d(1, ij, 19) = v_d(1, ij, 19) + ij_matrix%pd_d(1, 6, k, l)*wrepp + ij_matrix%pd(6, k, l)*wrepp_d(1) + v_d(1, ij, 23) = v_d(1, ij, 23) + ij_matrix%pd_d(1, 7, k, l)*wrepp + ij_matrix%pd(7, k, l)*wrepp_d(1) + v_d(1, ij, 24) = v_d(1, ij, 24) + ij_matrix%pd_d(1, 8, k, l)*wrepp + ij_matrix%pd(8, k, l)*wrepp_d(1) + v_d(1, ij, 25) = v_d(1, ij, 25) + ij_matrix%pd_d(1, 9, k, l)*wrepp + ij_matrix%pd(9, k, l)*wrepp_d(1) + v_d(1, ij, 30) = v_d(1, ij, 30) + ij_matrix%pd_d(1, 10, k, l)*wrepp + ij_matrix%pd(10, k, l)*wrepp_d(1) + v_d(1, ij, 31) = v_d(1, ij, 31) + ij_matrix%pd_d(1, 11, k, l)*wrepp + ij_matrix%pd(11, k, l)*wrepp_d(1) + v_d(1, ij, 32) = v_d(1, ij, 32) + ij_matrix%pd_d(1, 12, k, l)*wrepp + ij_matrix%pd(12, k, l)*wrepp_d(1) + v_d(1, ij, 38) = v_d(1, ij, 38) + ij_matrix%pd_d(1, 13, k, l)*wrepp + ij_matrix%pd(13, k, l)*wrepp_d(1) + v_d(1, ij, 39) = v_d(1, ij, 39) + ij_matrix%pd_d(1, 14, k, l)*wrepp + ij_matrix%pd(14, k, l)*wrepp_d(1) + v_d(1, ij, 40) = v_d(1, ij, 40) + ij_matrix%pd_d(1, 15, k, l)*wrepp + ij_matrix%pd(15, k, l)*wrepp_d(1) + + v_d(2, ij, 12) = v_d(2, ij, 12) + ij_matrix%pd_d(2, 1, k, l)*wrepp + ij_matrix%pd(1, k, l)*wrepp_d(2) + v_d(2, ij, 13) = v_d(2, ij, 13) + ij_matrix%pd_d(2, 2, k, l)*wrepp + ij_matrix%pd(2, k, l)*wrepp_d(2) + v_d(2, ij, 14) = v_d(2, ij, 14) + ij_matrix%pd_d(2, 3, k, l)*wrepp + ij_matrix%pd(3, k, l)*wrepp_d(2) + v_d(2, ij, 17) = v_d(2, ij, 17) + ij_matrix%pd_d(2, 4, k, l)*wrepp + ij_matrix%pd(4, k, l)*wrepp_d(2) + v_d(2, ij, 18) = v_d(2, ij, 18) + ij_matrix%pd_d(2, 5, k, l)*wrepp + ij_matrix%pd(5, k, l)*wrepp_d(2) + v_d(2, ij, 19) = v_d(2, ij, 19) + ij_matrix%pd_d(2, 6, k, l)*wrepp + ij_matrix%pd(6, k, l)*wrepp_d(2) + v_d(2, ij, 23) = v_d(2, ij, 23) + ij_matrix%pd_d(2, 7, k, l)*wrepp + ij_matrix%pd(7, k, l)*wrepp_d(2) + v_d(2, ij, 24) = v_d(2, ij, 24) + ij_matrix%pd_d(2, 8, k, l)*wrepp + ij_matrix%pd(8, k, l)*wrepp_d(2) + v_d(2, ij, 25) = v_d(2, ij, 25) + ij_matrix%pd_d(2, 9, k, l)*wrepp + ij_matrix%pd(9, k, l)*wrepp_d(2) + v_d(2, ij, 30) = v_d(2, ij, 30) + ij_matrix%pd_d(2, 10, k, l)*wrepp + ij_matrix%pd(10, k, l)*wrepp_d(2) + v_d(2, ij, 31) = v_d(2, ij, 31) + ij_matrix%pd_d(2, 11, k, l)*wrepp + ij_matrix%pd(11, k, l)*wrepp_d(2) + v_d(2, ij, 32) = v_d(2, ij, 32) + ij_matrix%pd_d(2, 12, k, l)*wrepp + ij_matrix%pd(12, k, l)*wrepp_d(2) + v_d(2, ij, 38) = v_d(2, ij, 38) + ij_matrix%pd_d(2, 13, k, l)*wrepp + ij_matrix%pd(13, k, l)*wrepp_d(2) + v_d(2, ij, 39) = v_d(2, ij, 39) + ij_matrix%pd_d(2, 14, k, l)*wrepp + ij_matrix%pd(14, k, l)*wrepp_d(2) + v_d(2, ij, 40) = v_d(2, ij, 40) + ij_matrix%pd_d(2, 15, k, l)*wrepp + ij_matrix%pd(15, k, l)*wrepp_d(2) + + v_d(3, ij, 12) = v_d(3, ij, 12) + ij_matrix%pd_d(3, 1, k, l)*wrepp + ij_matrix%pd(1, k, l)*wrepp_d(3) + v_d(3, ij, 13) = v_d(3, ij, 13) + ij_matrix%pd_d(3, 2, k, l)*wrepp + ij_matrix%pd(2, k, l)*wrepp_d(3) + v_d(3, ij, 14) = v_d(3, ij, 14) + ij_matrix%pd_d(3, 3, k, l)*wrepp + ij_matrix%pd(3, k, l)*wrepp_d(3) + v_d(3, ij, 17) = v_d(3, ij, 17) + ij_matrix%pd_d(3, 4, k, l)*wrepp + ij_matrix%pd(4, k, l)*wrepp_d(3) + v_d(3, ij, 18) = v_d(3, ij, 18) + ij_matrix%pd_d(3, 5, k, l)*wrepp + ij_matrix%pd(5, k, l)*wrepp_d(3) + v_d(3, ij, 19) = v_d(3, ij, 19) + ij_matrix%pd_d(3, 6, k, l)*wrepp + ij_matrix%pd(6, k, l)*wrepp_d(3) + v_d(3, ij, 23) = v_d(3, ij, 23) + ij_matrix%pd_d(3, 7, k, l)*wrepp + ij_matrix%pd(7, k, l)*wrepp_d(3) + v_d(3, ij, 24) = v_d(3, ij, 24) + ij_matrix%pd_d(3, 8, k, l)*wrepp + ij_matrix%pd(8, k, l)*wrepp_d(3) + v_d(3, ij, 25) = v_d(3, ij, 25) + ij_matrix%pd_d(3, 9, k, l)*wrepp + ij_matrix%pd(9, k, l)*wrepp_d(3) + v_d(3, ij, 30) = v_d(3, ij, 30) + ij_matrix%pd_d(3, 10, k, l)*wrepp + ij_matrix%pd(10, k, l)*wrepp_d(3) + v_d(3, ij, 31) = v_d(3, ij, 31) + ij_matrix%pd_d(3, 11, k, l)*wrepp + ij_matrix%pd(11, k, l)*wrepp_d(3) + v_d(3, ij, 32) = v_d(3, ij, 32) + ij_matrix%pd_d(3, 12, k, l)*wrepp + ij_matrix%pd(12, k, l)*wrepp_d(3) + v_d(3, ij, 38) = v_d(3, ij, 38) + ij_matrix%pd_d(3, 13, k, l)*wrepp + ij_matrix%pd(13, k, l)*wrepp_d(3) + v_d(3, ij, 39) = v_d(3, ij, 39) + ij_matrix%pd_d(3, 14, k, l)*wrepp + ij_matrix%pd(14, k, l)*wrepp_d(3) + v_d(3, ij, 40) = v_d(3, ij, 40) + ij_matrix%pd_d(3, 15, k, l)*wrepp + ij_matrix%pd(15, k, l)*wrepp_d(3) ELSE IF (mm == 6) THEN - k = k1-4 - l = l1-4 - v_d(1, ij, 15) = v_d(1, ij, 15)+ij_matrix%dd_d(1, 1, k, l)*wrepp+ij_matrix%dd(1, k, l)*wrepp_d(1) - v_d(1, ij, 21) = v_d(1, ij, 21)+ij_matrix%dd_d(1, 2, k, l)*wrepp+ij_matrix%dd(2, k, l)*wrepp_d(1) - v_d(1, ij, 28) = v_d(1, ij, 28)+ij_matrix%dd_d(1, 3, k, l)*wrepp+ij_matrix%dd(3, k, l)*wrepp_d(1) - v_d(1, ij, 36) = v_d(1, ij, 36)+ij_matrix%dd_d(1, 4, k, l)*wrepp+ij_matrix%dd(4, k, l)*wrepp_d(1) - v_d(1, ij, 45) = v_d(1, ij, 45)+ij_matrix%dd_d(1, 5, k, l)*wrepp+ij_matrix%dd(5, k, l)*wrepp_d(1) - v_d(1, ij, 20) = v_d(1, ij, 20)+ij_matrix%dd_d(1, 6, k, l)*wrepp+ij_matrix%dd(6, k, l)*wrepp_d(1) - v_d(1, ij, 26) = v_d(1, ij, 26)+ij_matrix%dd_d(1, 7, k, l)*wrepp+ij_matrix%dd(7, k, l)*wrepp_d(1) - v_d(1, ij, 27) = v_d(1, ij, 27)+ij_matrix%dd_d(1, 8, k, l)*wrepp+ij_matrix%dd(8, k, l)*wrepp_d(1) - v_d(1, ij, 33) = v_d(1, ij, 33)+ij_matrix%dd_d(1, 9, k, l)*wrepp+ij_matrix%dd(9, k, l)*wrepp_d(1) - v_d(1, ij, 34) = v_d(1, ij, 34)+ij_matrix%dd_d(1, 10, k, l)*wrepp+ij_matrix%dd(10, k, l)*wrepp_d(1) - v_d(1, ij, 35) = v_d(1, ij, 35)+ij_matrix%dd_d(1, 11, k, l)*wrepp+ij_matrix%dd(11, k, l)*wrepp_d(1) - v_d(1, ij, 41) = v_d(1, ij, 41)+ij_matrix%dd_d(1, 12, k, l)*wrepp+ij_matrix%dd(12, k, l)*wrepp_d(1) - v_d(1, ij, 42) = v_d(1, ij, 42)+ij_matrix%dd_d(1, 13, k, l)*wrepp+ij_matrix%dd(13, k, l)*wrepp_d(1) - v_d(1, ij, 43) = v_d(1, ij, 43)+ij_matrix%dd_d(1, 14, k, l)*wrepp+ij_matrix%dd(14, k, l)*wrepp_d(1) - v_d(1, ij, 44) = v_d(1, ij, 44)+ij_matrix%dd_d(1, 15, k, l)*wrepp+ij_matrix%dd(15, k, l)*wrepp_d(1) - - v_d(2, ij, 15) = v_d(2, ij, 15)+ij_matrix%dd_d(2, 1, k, l)*wrepp+ij_matrix%dd(1, k, l)*wrepp_d(2) - v_d(2, ij, 21) = v_d(2, ij, 21)+ij_matrix%dd_d(2, 2, k, l)*wrepp+ij_matrix%dd(2, k, l)*wrepp_d(2) - v_d(2, ij, 28) = v_d(2, ij, 28)+ij_matrix%dd_d(2, 3, k, l)*wrepp+ij_matrix%dd(3, k, l)*wrepp_d(2) - v_d(2, ij, 36) = v_d(2, ij, 36)+ij_matrix%dd_d(2, 4, k, l)*wrepp+ij_matrix%dd(4, k, l)*wrepp_d(2) - v_d(2, ij, 45) = v_d(2, ij, 45)+ij_matrix%dd_d(2, 5, k, l)*wrepp+ij_matrix%dd(5, k, l)*wrepp_d(2) - v_d(2, ij, 20) = v_d(2, ij, 20)+ij_matrix%dd_d(2, 6, k, l)*wrepp+ij_matrix%dd(6, k, l)*wrepp_d(2) - v_d(2, ij, 26) = v_d(2, ij, 26)+ij_matrix%dd_d(2, 7, k, l)*wrepp+ij_matrix%dd(7, k, l)*wrepp_d(2) - v_d(2, ij, 27) = v_d(2, ij, 27)+ij_matrix%dd_d(2, 8, k, l)*wrepp+ij_matrix%dd(8, k, l)*wrepp_d(2) - v_d(2, ij, 33) = v_d(2, ij, 33)+ij_matrix%dd_d(2, 9, k, l)*wrepp+ij_matrix%dd(9, k, l)*wrepp_d(2) - v_d(2, ij, 34) = v_d(2, ij, 34)+ij_matrix%dd_d(2, 10, k, l)*wrepp+ij_matrix%dd(10, k, l)*wrepp_d(2) - v_d(2, ij, 35) = v_d(2, ij, 35)+ij_matrix%dd_d(2, 11, k, l)*wrepp+ij_matrix%dd(11, k, l)*wrepp_d(2) - v_d(2, ij, 41) = v_d(2, ij, 41)+ij_matrix%dd_d(2, 12, k, l)*wrepp+ij_matrix%dd(12, k, l)*wrepp_d(2) - v_d(2, ij, 42) = v_d(2, ij, 42)+ij_matrix%dd_d(2, 13, k, l)*wrepp+ij_matrix%dd(13, k, l)*wrepp_d(2) - v_d(2, ij, 43) = v_d(2, ij, 43)+ij_matrix%dd_d(2, 14, k, l)*wrepp+ij_matrix%dd(14, k, l)*wrepp_d(2) - v_d(2, ij, 44) = v_d(2, ij, 44)+ij_matrix%dd_d(2, 15, k, l)*wrepp+ij_matrix%dd(15, k, l)*wrepp_d(2) - - v_d(3, ij, 15) = v_d(3, ij, 15)+ij_matrix%dd_d(3, 1, k, l)*wrepp+ij_matrix%dd(1, k, l)*wrepp_d(3) - v_d(3, ij, 21) = v_d(3, ij, 21)+ij_matrix%dd_d(3, 2, k, l)*wrepp+ij_matrix%dd(2, k, l)*wrepp_d(3) - v_d(3, ij, 28) = v_d(3, ij, 28)+ij_matrix%dd_d(3, 3, k, l)*wrepp+ij_matrix%dd(3, k, l)*wrepp_d(3) - v_d(3, ij, 36) = v_d(3, ij, 36)+ij_matrix%dd_d(3, 4, k, l)*wrepp+ij_matrix%dd(4, k, l)*wrepp_d(3) - v_d(3, ij, 45) = v_d(3, ij, 45)+ij_matrix%dd_d(3, 5, k, l)*wrepp+ij_matrix%dd(5, k, l)*wrepp_d(3) - v_d(3, ij, 20) = v_d(3, ij, 20)+ij_matrix%dd_d(3, 6, k, l)*wrepp+ij_matrix%dd(6, k, l)*wrepp_d(3) - v_d(3, ij, 26) = v_d(3, ij, 26)+ij_matrix%dd_d(3, 7, k, l)*wrepp+ij_matrix%dd(7, k, l)*wrepp_d(3) - v_d(3, ij, 27) = v_d(3, ij, 27)+ij_matrix%dd_d(3, 8, k, l)*wrepp+ij_matrix%dd(8, k, l)*wrepp_d(3) - v_d(3, ij, 33) = v_d(3, ij, 33)+ij_matrix%dd_d(3, 9, k, l)*wrepp+ij_matrix%dd(9, k, l)*wrepp_d(3) - v_d(3, ij, 34) = v_d(3, ij, 34)+ij_matrix%dd_d(3, 10, k, l)*wrepp+ij_matrix%dd(10, k, l)*wrepp_d(3) - v_d(3, ij, 35) = v_d(3, ij, 35)+ij_matrix%dd_d(3, 11, k, l)*wrepp+ij_matrix%dd(11, k, l)*wrepp_d(3) - v_d(3, ij, 41) = v_d(3, ij, 41)+ij_matrix%dd_d(3, 12, k, l)*wrepp+ij_matrix%dd(12, k, l)*wrepp_d(3) - v_d(3, ij, 42) = v_d(3, ij, 42)+ij_matrix%dd_d(3, 13, k, l)*wrepp+ij_matrix%dd(13, k, l)*wrepp_d(3) - v_d(3, ij, 43) = v_d(3, ij, 43)+ij_matrix%dd_d(3, 14, k, l)*wrepp+ij_matrix%dd(14, k, l)*wrepp_d(3) - v_d(3, ij, 44) = v_d(3, ij, 44)+ij_matrix%dd_d(3, 15, k, l)*wrepp+ij_matrix%dd(15, k, l)*wrepp_d(3) + k = k1 - 4 + l = l1 - 4 + v_d(1, ij, 15) = v_d(1, ij, 15) + ij_matrix%dd_d(1, 1, k, l)*wrepp + ij_matrix%dd(1, k, l)*wrepp_d(1) + v_d(1, ij, 21) = v_d(1, ij, 21) + ij_matrix%dd_d(1, 2, k, l)*wrepp + ij_matrix%dd(2, k, l)*wrepp_d(1) + v_d(1, ij, 28) = v_d(1, ij, 28) + ij_matrix%dd_d(1, 3, k, l)*wrepp + ij_matrix%dd(3, k, l)*wrepp_d(1) + v_d(1, ij, 36) = v_d(1, ij, 36) + ij_matrix%dd_d(1, 4, k, l)*wrepp + ij_matrix%dd(4, k, l)*wrepp_d(1) + v_d(1, ij, 45) = v_d(1, ij, 45) + ij_matrix%dd_d(1, 5, k, l)*wrepp + ij_matrix%dd(5, k, l)*wrepp_d(1) + v_d(1, ij, 20) = v_d(1, ij, 20) + ij_matrix%dd_d(1, 6, k, l)*wrepp + ij_matrix%dd(6, k, l)*wrepp_d(1) + v_d(1, ij, 26) = v_d(1, ij, 26) + ij_matrix%dd_d(1, 7, k, l)*wrepp + ij_matrix%dd(7, k, l)*wrepp_d(1) + v_d(1, ij, 27) = v_d(1, ij, 27) + ij_matrix%dd_d(1, 8, k, l)*wrepp + ij_matrix%dd(8, k, l)*wrepp_d(1) + v_d(1, ij, 33) = v_d(1, ij, 33) + ij_matrix%dd_d(1, 9, k, l)*wrepp + ij_matrix%dd(9, k, l)*wrepp_d(1) + v_d(1, ij, 34) = v_d(1, ij, 34) + ij_matrix%dd_d(1, 10, k, l)*wrepp + ij_matrix%dd(10, k, l)*wrepp_d(1) + v_d(1, ij, 35) = v_d(1, ij, 35) + ij_matrix%dd_d(1, 11, k, l)*wrepp + ij_matrix%dd(11, k, l)*wrepp_d(1) + v_d(1, ij, 41) = v_d(1, ij, 41) + ij_matrix%dd_d(1, 12, k, l)*wrepp + ij_matrix%dd(12, k, l)*wrepp_d(1) + v_d(1, ij, 42) = v_d(1, ij, 42) + ij_matrix%dd_d(1, 13, k, l)*wrepp + ij_matrix%dd(13, k, l)*wrepp_d(1) + v_d(1, ij, 43) = v_d(1, ij, 43) + ij_matrix%dd_d(1, 14, k, l)*wrepp + ij_matrix%dd(14, k, l)*wrepp_d(1) + v_d(1, ij, 44) = v_d(1, ij, 44) + ij_matrix%dd_d(1, 15, k, l)*wrepp + ij_matrix%dd(15, k, l)*wrepp_d(1) + + v_d(2, ij, 15) = v_d(2, ij, 15) + ij_matrix%dd_d(2, 1, k, l)*wrepp + ij_matrix%dd(1, k, l)*wrepp_d(2) + v_d(2, ij, 21) = v_d(2, ij, 21) + ij_matrix%dd_d(2, 2, k, l)*wrepp + ij_matrix%dd(2, k, l)*wrepp_d(2) + v_d(2, ij, 28) = v_d(2, ij, 28) + ij_matrix%dd_d(2, 3, k, l)*wrepp + ij_matrix%dd(3, k, l)*wrepp_d(2) + v_d(2, ij, 36) = v_d(2, ij, 36) + ij_matrix%dd_d(2, 4, k, l)*wrepp + ij_matrix%dd(4, k, l)*wrepp_d(2) + v_d(2, ij, 45) = v_d(2, ij, 45) + ij_matrix%dd_d(2, 5, k, l)*wrepp + ij_matrix%dd(5, k, l)*wrepp_d(2) + v_d(2, ij, 20) = v_d(2, ij, 20) + ij_matrix%dd_d(2, 6, k, l)*wrepp + ij_matrix%dd(6, k, l)*wrepp_d(2) + v_d(2, ij, 26) = v_d(2, ij, 26) + ij_matrix%dd_d(2, 7, k, l)*wrepp + ij_matrix%dd(7, k, l)*wrepp_d(2) + v_d(2, ij, 27) = v_d(2, ij, 27) + ij_matrix%dd_d(2, 8, k, l)*wrepp + ij_matrix%dd(8, k, l)*wrepp_d(2) + v_d(2, ij, 33) = v_d(2, ij, 33) + ij_matrix%dd_d(2, 9, k, l)*wrepp + ij_matrix%dd(9, k, l)*wrepp_d(2) + v_d(2, ij, 34) = v_d(2, ij, 34) + ij_matrix%dd_d(2, 10, k, l)*wrepp + ij_matrix%dd(10, k, l)*wrepp_d(2) + v_d(2, ij, 35) = v_d(2, ij, 35) + ij_matrix%dd_d(2, 11, k, l)*wrepp + ij_matrix%dd(11, k, l)*wrepp_d(2) + v_d(2, ij, 41) = v_d(2, ij, 41) + ij_matrix%dd_d(2, 12, k, l)*wrepp + ij_matrix%dd(12, k, l)*wrepp_d(2) + v_d(2, ij, 42) = v_d(2, ij, 42) + ij_matrix%dd_d(2, 13, k, l)*wrepp + ij_matrix%dd(13, k, l)*wrepp_d(2) + v_d(2, ij, 43) = v_d(2, ij, 43) + ij_matrix%dd_d(2, 14, k, l)*wrepp + ij_matrix%dd(14, k, l)*wrepp_d(2) + v_d(2, ij, 44) = v_d(2, ij, 44) + ij_matrix%dd_d(2, 15, k, l)*wrepp + ij_matrix%dd(15, k, l)*wrepp_d(2) + + v_d(3, ij, 15) = v_d(3, ij, 15) + ij_matrix%dd_d(3, 1, k, l)*wrepp + ij_matrix%dd(1, k, l)*wrepp_d(3) + v_d(3, ij, 21) = v_d(3, ij, 21) + ij_matrix%dd_d(3, 2, k, l)*wrepp + ij_matrix%dd(2, k, l)*wrepp_d(3) + v_d(3, ij, 28) = v_d(3, ij, 28) + ij_matrix%dd_d(3, 3, k, l)*wrepp + ij_matrix%dd(3, k, l)*wrepp_d(3) + v_d(3, ij, 36) = v_d(3, ij, 36) + ij_matrix%dd_d(3, 4, k, l)*wrepp + ij_matrix%dd(4, k, l)*wrepp_d(3) + v_d(3, ij, 45) = v_d(3, ij, 45) + ij_matrix%dd_d(3, 5, k, l)*wrepp + ij_matrix%dd(5, k, l)*wrepp_d(3) + v_d(3, ij, 20) = v_d(3, ij, 20) + ij_matrix%dd_d(3, 6, k, l)*wrepp + ij_matrix%dd(6, k, l)*wrepp_d(3) + v_d(3, ij, 26) = v_d(3, ij, 26) + ij_matrix%dd_d(3, 7, k, l)*wrepp + ij_matrix%dd(7, k, l)*wrepp_d(3) + v_d(3, ij, 27) = v_d(3, ij, 27) + ij_matrix%dd_d(3, 8, k, l)*wrepp + ij_matrix%dd(8, k, l)*wrepp_d(3) + v_d(3, ij, 33) = v_d(3, ij, 33) + ij_matrix%dd_d(3, 9, k, l)*wrepp + ij_matrix%dd(9, k, l)*wrepp_d(3) + v_d(3, ij, 34) = v_d(3, ij, 34) + ij_matrix%dd_d(3, 10, k, l)*wrepp + ij_matrix%dd(10, k, l)*wrepp_d(3) + v_d(3, ij, 35) = v_d(3, ij, 35) + ij_matrix%dd_d(3, 11, k, l)*wrepp + ij_matrix%dd(11, k, l)*wrepp_d(3) + v_d(3, ij, 41) = v_d(3, ij, 41) + ij_matrix%dd_d(3, 12, k, l)*wrepp + ij_matrix%dd(12, k, l)*wrepp_d(3) + v_d(3, ij, 42) = v_d(3, ij, 42) + ij_matrix%dd_d(3, 13, k, l)*wrepp + ij_matrix%dd(13, k, l)*wrepp_d(3) + v_d(3, ij, 43) = v_d(3, ij, 43) + ij_matrix%dd_d(3, 14, k, l)*wrepp + ij_matrix%dd(14, k, l)*wrepp_d(3) + v_d(3, ij, 44) = v_d(3, ij, 44) + ij_matrix%dd_d(3, 15, k, l)*wrepp + ij_matrix%dd(15, k, l)*wrepp_d(3) END IF END IF END DO @@ -2429,14 +2429,14 @@ SUBROUTINE store_2el_2c_diag(limij, limkl, ww, w, ww_dx, ww_dy, ww_dz, dw) IF (PRESENT(ww) .AND. PRESENT(w)) THEN DO ij = 1, limij DO kl = 1, limkl - l = l+1 + l = l + 1 w(l) = ww(kl, ij) END DO END DO ELSE IF (PRESENT(ww_dx) .AND. PRESENT(ww_dy) .AND. PRESENT(ww_dz) .AND. PRESENT(dw)) THEN DO ij = 1, limij DO kl = 1, limkl - l = l+1 + l = l + 1 dw(1, l) = ww_dx(kl, ij) dw(2, l) = ww_dy(kl, ij) dw(3, l) = ww_dz(kl, ij) diff --git a/src/semi_empirical_integrals.F b/src/semi_empirical_integrals.F index 0fa70fb795..b64836b48e 100644 --- a/src/semi_empirical_integrals.F +++ b/src/semi_empirical_integrals.F @@ -86,7 +86,7 @@ SUBROUTINE rotint(sepi, sepj, rij, w, anag, se_int_control, se_taper, store_int_ w(:) = 0.0_dp IF (.NOT. store_int_env%memory_parameter%do_all_on_the_fly) THEN - nints = (sepi%natorb*(sepi%natorb+1)/2)*(sepj%natorb*(sepj%natorb+1)/2) + nints = (sepi%natorb*(sepi%natorb + 1)/2)*(sepj%natorb*(sepj%natorb + 1)/2) cache_size = store_int_env%memory_parameter%cache_size eps_storage = store_int_env%memory_parameter%eps_storage_scaling IF (store_int_env%filling_containers) THEN @@ -95,7 +95,7 @@ SUBROUTINE rotint(sepi, sepj, rij, w, anag, se_int_control, se_taper, store_int_ buffer_overflow = .TRUE. store_int_env%memory_parameter%ram_counter = store_int_env%nbuffer ELSE - store_int_env%nbuffer = store_int_env%nbuffer+1 + store_int_env%nbuffer = store_int_env%nbuffer + 1 buffer_overflow = .FALSE. END IF ! Compute Integrals @@ -113,12 +113,12 @@ SUBROUTINE rotint(sepi, sepj, rij, w, anag, se_int_control, se_taper, store_int_ IF (store_int_env%compress) THEN ! Store integrals in the containers IF (store_int_env%nbuffer > SIZE(store_int_env%max_val_buffer)) THEN - new_size = store_int_env%nbuffer+1000 + new_size = store_int_env%nbuffer + 1000 CALL reallocate(store_int_env%max_val_buffer, 1, new_size) END IF store_int_env%max_val_buffer(store_int_env%nbuffer) = MAXVAL(ABS(w(1:nints))) - nbits = EXPONENT(store_int_env%max_val_buffer(store_int_env%nbuffer)/eps_storage)+1 + nbits = EXPONENT(store_int_env%max_val_buffer(store_int_env%nbuffer)/eps_storage) + 1 buffer_left = nints buffer_start = 1 DO WHILE (buffer_left > 0) @@ -130,19 +130,19 @@ SUBROUTINE rotint(sepi, sepj, rij, w, anag, se_int_control, se_taper, store_int_ eps_storage, 1.0_dp, & store_int_env%memory_parameter%actual_memory_usage, & .FALSE.) - buffer_left = buffer_left-buffer_size - buffer_start = buffer_start+buffer_size + buffer_left = buffer_left - buffer_size + buffer_start = buffer_start + buffer_size END DO ELSE ! Skip compression memory_usage = store_int_env%memory_parameter%actual_memory_usage - CPASSERT((nints/1.2_dp) <= HUGE(0)-memory_usage) - IF (memory_usage+nints > SIZE(store_int_env%uncompressed_container)) THEN - new_size = INT((memory_usage+nints)*1.2_dp) + CPASSERT((nints/1.2_dp) <= HUGE(0) - memory_usage) + IF (memory_usage + nints > SIZE(store_int_env%uncompressed_container)) THEN + new_size = INT((memory_usage + nints)*1.2_dp) CALL reallocate(store_int_env%uncompressed_container, 1, new_size) END IF - store_int_env%uncompressed_container(memory_usage:memory_usage+nints-1) = w(1:nints) - store_int_env%memory_parameter%actual_memory_usage = memory_usage+nints + store_int_env%uncompressed_container(memory_usage:memory_usage + nints - 1) = w(1:nints) + store_int_env%memory_parameter%actual_memory_usage = memory_usage + nints END IF END IF ELSE @@ -150,14 +150,14 @@ SUBROUTINE rotint(sepi, sepj, rij, w, anag, se_int_control, se_taper, store_int_ IF (store_int_env%memory_parameter%ram_counter == store_int_env%nbuffer) THEN buffer_overflow = .TRUE. ELSE - store_int_env%nbuffer = store_int_env%nbuffer+1 + store_int_env%nbuffer = store_int_env%nbuffer + 1 buffer_overflow = .FALSE. END IF ! Get integrals from cache unless we overflowed IF (.NOT. buffer_overflow) THEN IF (store_int_env%compress) THEN ! Get Integrals from containers - nbits = EXPONENT(store_int_env%max_val_buffer(store_int_env%nbuffer)/eps_storage)+1 + nbits = EXPONENT(store_int_env%max_val_buffer(store_int_env%nbuffer)/eps_storage) + 1 buffer_left = nints buffer_start = 1 DO WHILE (buffer_left > 0) @@ -169,14 +169,14 @@ SUBROUTINE rotint(sepi, sepj, rij, w, anag, se_int_control, se_taper, store_int_ eps_storage, 1.0_dp, & store_int_env%memory_parameter%actual_memory_usage, & .FALSE.) - buffer_left = buffer_left-buffer_size - buffer_start = buffer_start+buffer_size + buffer_left = buffer_left - buffer_size + buffer_start = buffer_start + buffer_size END DO ELSE ! Skip compression memory_usage = store_int_env%memory_parameter%actual_memory_usage - w(1:nints) = store_int_env%uncompressed_container(memory_usage:memory_usage+nints-1) - store_int_env%memory_parameter%actual_memory_usage = memory_usage+nints + w(1:nints) = store_int_env%uncompressed_container(memory_usage:memory_usage + nints - 1) + store_int_env%memory_parameter%actual_memory_usage = memory_usage + nints END IF ELSE IF (se_int_control%integral_screening == do_se_IS_slater) THEN @@ -244,9 +244,9 @@ SUBROUTINE rotnuc(sepi, sepj, rij, e1b, e2a, itype, anag, se_int_control, se_tap IF (.NOT. do_all_on_the_fly) THEN nints_1 = 0 nints_2 = 0 - IF (PRESENT(e1b)) nints_1 = (sepi%natorb*(sepi%natorb+1)/2) - IF (PRESENT(e2a)) nints_2 = (sepj%natorb*(sepj%natorb+1)/2) - nints = nints_1+nints_2 + IF (PRESENT(e1b)) nints_1 = (sepi%natorb*(sepi%natorb + 1)/2) + IF (PRESENT(e2a)) nints_2 = (sepj%natorb*(sepj%natorb + 1)/2) + nints = nints_1 + nints_2 ! This is the upper limit for an spd basis set CPASSERT(nints <= 90) cache_size = store_int_env%memory_parameter%cache_size @@ -257,7 +257,7 @@ SUBROUTINE rotnuc(sepi, sepj, rij, e1b, e2a, itype, anag, se_int_control, se_tap buffer_overflow = .TRUE. store_int_env%memory_parameter%ram_counter = store_int_env%nbuffer ELSE - store_int_env%nbuffer = store_int_env%nbuffer+1 + store_int_env%nbuffer = store_int_env%nbuffer + 1 buffer_overflow = .FALSE. END IF ! Compute Integrals @@ -276,17 +276,17 @@ SUBROUTINE rotnuc(sepi, sepj, rij, e1b, e2a, itype, anag, se_int_control, se_tap ! Store integrals if we did not go overflow IF (.NOT. buffer_overflow) THEN IF (PRESENT(e1b)) w(1:nints_1) = e1b(1:nints_1) - IF (PRESENT(e2a)) w(nints_1+1:nints) = e2a(1:nints_2) + IF (PRESENT(e2a)) w(nints_1 + 1:nints) = e2a(1:nints_2) IF (store_int_env%compress) THEN ! Store integrals in the containers IF (store_int_env%nbuffer > SIZE(store_int_env%max_val_buffer)) THEN - new_size = store_int_env%nbuffer+1000 + new_size = store_int_env%nbuffer + 1000 CALL reallocate(store_int_env%max_val_buffer, 1, new_size) END IF store_int_env%max_val_buffer(store_int_env%nbuffer) = MAXVAL(ABS(w(1:nints))) - nbits = EXPONENT(store_int_env%max_val_buffer(store_int_env%nbuffer)/eps_storage)+1 + nbits = EXPONENT(store_int_env%max_val_buffer(store_int_env%nbuffer)/eps_storage) + 1 buffer_left = nints buffer_start = 1 DO WHILE (buffer_left > 0) @@ -298,19 +298,19 @@ SUBROUTINE rotnuc(sepi, sepj, rij, e1b, e2a, itype, anag, se_int_control, se_tap eps_storage, 1.0_dp, & store_int_env%memory_parameter%actual_memory_usage, & .FALSE.) - buffer_left = buffer_left-buffer_size - buffer_start = buffer_start+buffer_size + buffer_left = buffer_left - buffer_size + buffer_start = buffer_start + buffer_size END DO ELSE ! Skip compression memory_usage = store_int_env%memory_parameter%actual_memory_usage - CPASSERT((nints/1.2_dp) <= HUGE(0)-memory_usage) - IF (memory_usage+nints > SIZE(store_int_env%uncompressed_container)) THEN - new_size = INT((memory_usage+nints)*1.2_dp) + CPASSERT((nints/1.2_dp) <= HUGE(0) - memory_usage) + IF (memory_usage + nints > SIZE(store_int_env%uncompressed_container)) THEN + new_size = INT((memory_usage + nints)*1.2_dp) CALL reallocate(store_int_env%uncompressed_container, 1, new_size) END IF - store_int_env%uncompressed_container(memory_usage:memory_usage+nints-1) = w(1:nints) - store_int_env%memory_parameter%actual_memory_usage = memory_usage+nints + store_int_env%uncompressed_container(memory_usage:memory_usage + nints - 1) = w(1:nints) + store_int_env%memory_parameter%actual_memory_usage = memory_usage + nints END IF END IF ELSE @@ -318,14 +318,14 @@ SUBROUTINE rotnuc(sepi, sepj, rij, e1b, e2a, itype, anag, se_int_control, se_tap IF (store_int_env%memory_parameter%ram_counter == store_int_env%nbuffer) THEN buffer_overflow = .TRUE. ELSE - store_int_env%nbuffer = store_int_env%nbuffer+1 + store_int_env%nbuffer = store_int_env%nbuffer + 1 buffer_overflow = .FALSE. END IF ! Get integrals from cache unless we overflowed IF (.NOT. buffer_overflow) THEN IF (store_int_env%compress) THEN ! Get Integrals from containers - nbits = EXPONENT(store_int_env%max_val_buffer(store_int_env%nbuffer)/eps_storage)+1 + nbits = EXPONENT(store_int_env%max_val_buffer(store_int_env%nbuffer)/eps_storage) + 1 buffer_left = nints buffer_start = 1 DO WHILE (buffer_left > 0) @@ -337,17 +337,17 @@ SUBROUTINE rotnuc(sepi, sepj, rij, e1b, e2a, itype, anag, se_int_control, se_tap eps_storage, 1.0_dp, & store_int_env%memory_parameter%actual_memory_usage, & .FALSE.) - buffer_left = buffer_left-buffer_size - buffer_start = buffer_start+buffer_size + buffer_left = buffer_left - buffer_size + buffer_start = buffer_start + buffer_size END DO ELSE ! Skip compression memory_usage = store_int_env%memory_parameter%actual_memory_usage - w(1:nints) = store_int_env%uncompressed_container(memory_usage:memory_usage+nints-1) - store_int_env%memory_parameter%actual_memory_usage = memory_usage+nints + w(1:nints) = store_int_env%uncompressed_container(memory_usage:memory_usage + nints - 1) + store_int_env%memory_parameter%actual_memory_usage = memory_usage + nints END IF IF (PRESENT(e1b)) e1b(1:nints_1) = w(1:nints_1) - IF (PRESENT(e2a)) e2a(1:nints_2) = w(nints_1+1:nints) + IF (PRESENT(e2a)) e2a(1:nints_2) = w(nints_1 + 1:nints) ELSE IF (se_int_control%integral_screening == do_se_IS_slater) THEN CALL rotnuc_gks(sepi, sepj, rij, e1b=e1b, e2a=e2a, & diff --git a/src/semi_empirical_mpole_methods.F b/src/semi_empirical_mpole_methods.F index 096123994d..56d1a8f187 100644 --- a/src/semi_empirical_mpole_methods.F +++ b/src/semi_empirical_mpole_methods.F @@ -75,7 +75,7 @@ SUBROUTINE semi_empirical_mpole_p_setup(mpoles, se_parameter, method) ! If there are atomic orbitals proceed with the expansion in multipoles natorb = se_parameter%natorb IF (natorb /= 0) THEN - ndim = natorb*(natorb+1)/2 + ndim = natorb*(natorb + 1)/2 CALL semi_empirical_mpole_p_create(mpoles, ndim) ! Select method for multipolar expansion @@ -104,7 +104,7 @@ SUBROUTINE semi_empirical_mpole_p_setup(mpoles, se_parameter, method) ! Charge IF (alm(ind1, 0, 0) /= 0.0_dp) THEN - dlm = 1.0_dp/SQRT(REAL((2*0+1), KIND=dp)) + dlm = 1.0_dp/SQRT(REAL((2*0 + 1), KIND=dp)) tmp = -dlm*amn(indexb(a, b), 0) mpole%c = tmp*alm(ind1, 0, 0) mpole%task(1) = .TRUE. @@ -112,7 +112,7 @@ SUBROUTINE semi_empirical_mpole_p_setup(mpoles, se_parameter, method) ! Dipole IF (ANY(alm(ind1, 1, -1:1) /= 0.0_dp)) THEN - dlm = 1.0_dp/SQRT(REAL((2*1+1), KIND=dp)) + dlm = 1.0_dp/SQRT(REAL((2*1 + 1), KIND=dp)) tmp = -dlm*amn(indexb(a, b), 1) mpole%d(1) = tmp*alm(ind1, 1, 1) mpole%d(2) = tmp*alm(ind1, 1, -1) @@ -122,7 +122,7 @@ SUBROUTINE semi_empirical_mpole_p_setup(mpoles, se_parameter, method) ! Quadrupole IF (ANY(alm(ind1, 2, -2:2) /= 0.0_dp)) THEN - dlm = 1.0_dp/SQRT(REAL((2*2+1), KIND=dp)) + dlm = 1.0_dp/SQRT(REAL((2*2 + 1), KIND=dp)) tmp = -dlm*amn(indexb(a, b), 2) ! Spherical components @@ -164,34 +164,34 @@ SUBROUTINE semi_empirical_mpole_p_setup(mpoles, se_parameter, method) ZP = se_parameter%sto_exponents(1) nr = se_parameter%nr - ws = REAL((2*nr+2)*(2*nr+1), dp)/(24.0_dp*ZS**2) + ws = REAL((2*nr + 2)*(2*nr + 1), dp)/(24.0_dp*ZS**2) DO k = 1, 3 M2(k, k, indexb(1, 1)) = ws ENDDO IF (ZP > 0._dp) THEN zt = SQRT(ZS*ZP) - zb = 0.5_dp*(ZS+ZP) + zb = 0.5_dp*(ZS + ZP) DO k = 1, 3 - M1(k, indexb(1, 1+k)) = (zt/zb)**(2*nr+1)*REAL(2*nr+1, dp)/(2.0*zb*SQRT(3.0_dp)) + M1(k, indexb(1, 1 + k)) = (zt/zb)**(2*nr + 1)*REAL(2*nr + 1, dp)/(2.0*zb*SQRT(3.0_dp)) ENDDO - wp = REAL((2*nr+2)*(2*nr+1), dp)/(40.0_dp*ZP**2) + wp = REAL((2*nr + 2)*(2*nr + 1), dp)/(40.0_dp*ZP**2) DO k1 = 1, 3 DO k2 = 1, 3 IF (k1 == k2) THEN - M2(k2, k2, indexb(1+k1, 1+k1)) = 3.0_dp*wp + M2(k2, k2, indexb(1 + k1, 1 + k1)) = 3.0_dp*wp ELSE - M2(k2, k2, indexb(1+k1, 1+k1)) = wp + M2(k2, k2, indexb(1 + k1, 1 + k1)) = wp ENDIF ENDDO ENDDO - M2(1, 2, indexb(1+1, 1+2)) = wp - M2(2, 1, indexb(1+1, 1+2)) = wp - M2(2, 3, indexb(1+2, 1+3)) = wp - M2(3, 2, indexb(1+2, 1+3)) = wp - M2(3, 1, indexb(1+3, 1+1)) = wp - M2(1, 3, indexb(1+3, 1+1)) = wp + M2(1, 2, indexb(1 + 1, 1 + 2)) = wp + M2(2, 1, indexb(1 + 1, 1 + 2)) = wp + M2(2, 3, indexb(1 + 2, 1 + 3)) = wp + M2(3, 2, indexb(1 + 2, 1 + 3)) = wp + M2(3, 1, indexb(1 + 3, 1 + 1)) = wp + M2(1, 3, indexb(1 + 3, 1 + 1)) = wp ENDIF DO i = 1, natorb @@ -248,10 +248,10 @@ SUBROUTINE quadrupole_sph_to_cart(qcart, qsph) ! qs(5) - dxy ! Cartesian components - qcart(1, 1) = (qsph(4)-qsph(1)/SQRT(3.0_dp))*SQRT(3.0_dp)/2.0_dp + qcart(1, 1) = (qsph(4) - qsph(1)/SQRT(3.0_dp))*SQRT(3.0_dp)/2.0_dp qcart(2, 1) = qsph(5)*SQRT(3.0_dp)/2.0_dp qcart(3, 1) = qsph(2)*SQRT(3.0_dp)/2.0_dp - qcart(2, 2) = -(qsph(4)+qsph(1)/SQRT(3.0_dp))*SQRT(3.0_dp)/2.0_dp + qcart(2, 2) = -(qsph(4) + qsph(1)/SQRT(3.0_dp))*SQRT(3.0_dp)/2.0_dp qcart(3, 2) = qsph(3)*SQRT(3.0_dp)/2.0_dp qcart(3, 3) = qsph(1) ! Symmetrize tensor diff --git a/src/semi_empirical_par_utils.F b/src/semi_empirical_par_utils.F index 1b0325199b..6611e821f4 100644 --- a/src/semi_empirical_par_utils.F +++ b/src/semi_empirical_par_utils.F @@ -232,10 +232,10 @@ SUBROUTINE valence_electrons(sep, extended_basis_set) END SELECT ! Determine the number of atomic orbitals natorb = 0 - IF (nqs(z) > 0) natorb = natorb+1 - IF ((nqp(z) > 0) .OR. use_p_orbitals) natorb = natorb+3 - IF (extended_basis_set .AND. element_has_d(sep)) natorb = natorb+5 - IF (extended_basis_set .AND. element_has_f(sep)) natorb = natorb+7 + IF (nqs(z) > 0) natorb = natorb + 1 + IF ((nqp(z) > 0) .OR. use_p_orbitals) natorb = natorb + 3 + IF (extended_basis_set .AND. element_has_d(sep)) natorb = natorb + 5 + IF (extended_basis_set .AND. element_has_f(sep)) natorb = natorb + 7 ! Check and assignemnt check = (natorb <= 4) .OR. (extended_basis_set) CPASSERT(check) @@ -362,17 +362,17 @@ SUBROUTINE calpar(z, sep) p = 2.0_dp p4 = p**4 ! GSSC is the number of two-electron terms of type - gssc = REAL(MAX(ios-1, 0), KIND=dp) + gssc = REAL(MAX(ios - 1, 0), KIND=dp) k = iop ! GSPC is the number of two-electron terms of type gspc = REAL(ios*k, KIND=dp) - l = MIN(k, 6-k) + l = MIN(k, 6 - k) ! GP2C is the number of two-electron terms of type ! plus 0.5 of the number of HPP integrals. ! (HPP is not used; instead it is replaced by 0.5(GPP-GP2)) - gp2c = REAL((k*(k-1))/2, KIND=dp)+0.5_dp*REAL((l*(l-1))/2, KIND=dp) + gp2c = REAL((k*(k - 1))/2, KIND=dp) + 0.5_dp*REAL((l*(l - 1))/2, KIND=dp) ! GPPC is minus 0.5 times the number of HPP integrals. - gppc = -0.5_dp*REAL((l*(l-1))/2, KIND=dp) + gppc = -0.5_dp*REAL((l*(l - 1))/2, KIND=dp) ! HSPC is the number of two-electron terms of type . ! (S and P must have the same spin. In all cases, if ! P is non-zero, there are two S electrons) @@ -380,44 +380,44 @@ SUBROUTINE calpar(z, sep) ! Constraint the value of the STO exponent zp = MAX(0.3_dp, zp) ! Take into account constraints on the values of the integrals - hpp = 0.5_dp*(gpp-gp2) + hpp = 0.5_dp*(gpp - gp2) hpp = MAX(0.1_dp, hpp) hsp = MAX(1.E-7_dp, hsp) ! Evaluation of EISOL - eisol = uss*ios+upp*iop+udd*iod+gss*gssc+gpp*gppc+gsp*gspc+gp2*gp2c+hsp*hspc + eisol = uss*ios + upp*iop + udd*iod + gss*gssc + gpp*gppc + gsp*gspc + gp2*gp2c + hsp*hspc ! Principal quantum number qn = REAL(nqs(z), KIND=dp) CPASSERT(qn > 0) ! Charge separation evaluation - dd = (2.0_dp*qn+1)*(4.0_dp*zs*zp)**(qn+0.5_dp)/(zs+zp)**(2.0_dp*qn+2)/SQRT(3.0_dp) - qq = SQRT((4.0_dp*qn*qn+6.0_dp*qn+2.0_dp)/20.0_dp)/zp + dd = (2.0_dp*qn + 1)*(4.0_dp*zs*zp)**(qn + 0.5_dp)/(zs + zp)**(2.0_dp*qn + 2)/SQRT(3.0_dp) + qq = SQRT((4.0_dp*qn*qn + 6.0_dp*qn + 2.0_dp)/20.0_dp)/zp ! Calculation of the additive terms in atomic units jmax = 5 gdd1 = (hsp/(evolt*dd**2))**(1.0_dp/3.0_dp) d1 = gdd1 - d2 = gdd1+0.04_dp + d2 = gdd1 + 0.04_dp DO j = 1, jmax - df = d2-d1 - hsp1 = 0.5_dp*d1-0.5_dp/SQRT(4.0_dp*dd**2+1.0_dp/d1**2) - hsp2 = 0.5_dp*d2-0.5_dp/SQRT(4.0_dp*dd**2+1.0_dp/d2**2) - IF (ABS(hsp2-hsp1) < EPSILON(0.0_dp)) EXIT - d3 = d1+df*(hsp/evolt-hsp1)/(hsp2-hsp1) + df = d2 - d1 + hsp1 = 0.5_dp*d1 - 0.5_dp/SQRT(4.0_dp*dd**2 + 1.0_dp/d1**2) + hsp2 = 0.5_dp*d2 - 0.5_dp/SQRT(4.0_dp*dd**2 + 1.0_dp/d2**2) + IF (ABS(hsp2 - hsp1) < EPSILON(0.0_dp)) EXIT + d3 = d1 + df*(hsp/evolt - hsp1)/(hsp2 - hsp1) d1 = d2 d2 = d3 END DO gqq = (p4*hpp/(evolt*48.0_dp*qq**4))**0.2_dp q1 = gqq - q2 = gqq+0.04_dp + q2 = gqq + 0.04_dp DO j = 1, jmax - qf = q2-q1 - hpp1 = 0.25_dp*q1-0.5_dp/SQRT(4.0_dp*qq**2+1.0_dp/q1**2)+0.25_dp/SQRT(8.0_dp*qq**2+1.0_dp/q1**2) - hpp2 = 0.25_dp*q2-0.5_dp/SQRT(4.0_dp*qq**2+1.0_dp/q2**2)+0.25_dp/SQRT(8.0_dp*qq**2+1.0_dp/q2**2) - IF (ABS(hpp2-hpp1) < EPSILON(0.0_dp)) EXIT - q3 = q1+qf*(hpp/evolt-hpp1)/(hpp2-hpp1) + qf = q2 - q1 + hpp1 = 0.25_dp*q1 - 0.5_dp/SQRT(4.0_dp*qq**2 + 1.0_dp/q1**2) + 0.25_dp/SQRT(8.0_dp*qq**2 + 1.0_dp/q1**2) + hpp2 = 0.25_dp*q2 - 0.5_dp/SQRT(4.0_dp*qq**2 + 1.0_dp/q2**2) + 0.25_dp/SQRT(8.0_dp*qq**2 + 1.0_dp/q2**2) + IF (ABS(hpp2 - hpp1) < EPSILON(0.0_dp)) EXIT + q3 = q1 + qf*(hpp/evolt - hpp1)/(hpp2 - hpp1) q1 = q2 q2 = q3 END DO @@ -636,8 +636,8 @@ FUNCTION amn_l_low(z1, z2, n1, n2, l) RESULT(amnl) INTEGER, INTENT(IN) :: n1, n2, l REAL(KIND=dp) :: amnl - amnl = fac(n1+n2+l)/SQRT(fac(2*n1)*fac(2*n2))*(2.0_dp*z1/(z1+z2))**n1* & - (2.0_dp*z2/(z1+z2))**n2*2.0_dp*SQRT(z1*z2)/(z1+z2)**(l+1) + amnl = fac(n1 + n2 + l)/SQRT(fac(2*n1)*fac(2*n2))*(2.0_dp*z1/(z1 + z2))**n1* & + (2.0_dp*z2/(z1 + z2))**n2*2.0_dp*SQRT(z1*z2)/(z1 + z2)**(l + 1) END FUNCTION amn_l_low @@ -677,7 +677,7 @@ SUBROUTINE eval_cs_ko(sep, amn) ! PP sep%ko(7) = sep%ko(1) d = SQRT(amn(3)*2.0_dp/5.0_dp) - fg = 0.5_dp*(sep%gpp-sep%gp2) + fg = 0.5_dp*(sep%gpp - sep%gp2) sep%cs(3) = d sep%ko(3) = ko_ij(2, d, fg) ! Terms involving d-orbitals @@ -689,14 +689,14 @@ SUBROUTINE eval_cs_ko(sep, amn) sep%ko(4) = ko_ij(2, d, fg) ! PD d = amn(5)/SQRT(5.0_dp) - fg = sep%onec2el(23)-1.8_dp*sep%onec2el(35) + fg = sep%onec2el(23) - 1.8_dp*sep%onec2el(35) sep%cs(5) = d sep%ko(5) = ko_ij(1, d, fg) ! DD - fg = 0.2_dp*(sep%onec2el(29)+2.0_dp*sep%onec2el(30)+2.0_dp*sep%onec2el(31)) + fg = 0.2_dp*(sep%onec2el(29) + 2.0_dp*sep%onec2el(30) + 2.0_dp*sep%onec2el(31)) sep%ko(8) = ko_ij(0, 1.0_dp, fg) d = SQRT(amn(6)*2.0_dp/7.0_dp) - fg = sep%onec2el(44)-(20.0_dp/35.0_dp)*sep%onec2el(52) + fg = sep%onec2el(44) - (20.0_dp/35.0_dp)*sep%onec2el(52) sep%cs(6) = d sep%ko(6) = ko_ij(2, d, fg) END IF @@ -739,15 +739,15 @@ SUBROUTINE eval_1c_2el_spd(sep) sep%onec2el(2) = 2.0_dp/(3.0_dp*s5)*r125 sep%onec2el(3) = 1.0_dp/s15*r125 sep%onec2el(4) = 2.0_dp/(5.0_dp*s5)*r234 - sep%onec2el(5) = r036+4.0_dp/35.0_dp*r236 - sep%onec2el(6) = r036+2.0_dp/35.0_dp*r236 - sep%onec2el(7) = r036-4.0_dp/35.0_dp*r236 + sep%onec2el(5) = r036 + 4.0_dp/35.0_dp*r236 + sep%onec2el(6) = r036 + 2.0_dp/35.0_dp*r236 + sep%onec2el(7) = r036 - 4.0_dp/35.0_dp*r236 sep%onec2el(8) = -1.0_dp/(3.0_dp*s5)*r125 sep%onec2el(9) = SQRT(3.0_dp/125.0_dp)*r234 sep%onec2el(10) = s3/35.0_dp*r236 sep%onec2el(11) = 3.0_dp/35.0_dp*r236 sep%onec2el(12) = -1.0_dp/(5.0_dp*s5)*r234 - sep%onec2el(13) = r036-2.0_dp/35.0_dp*r236 + sep%onec2el(13) = r036 - 2.0_dp/35.0_dp*r236 sep%onec2el(14) = -2.0_dp*s3/35.0_dp*r236 sep%onec2el(15) = -sep%onec2el(3) sep%onec2el(16) = -sep%onec2el(11) @@ -757,35 +757,35 @@ SUBROUTINE eval_1c_2el_spd(sep) sep%onec2el(20) = 2.0_dp/(7.0_dp*s5)*r246 sep%onec2el(21) = sep%onec2el(20)/2.0_dp sep%onec2el(22) = -sep%onec2el(20) - sep%onec2el(23) = 4.0_dp/15.0_dp*r155+27.0_dp/245.0_dp*r355 - sep%onec2el(24) = 2.0_dp*s3/15.0_dp*r155-9.0_dp*s3/245.0_dp*r355 - sep%onec2el(25) = 1.0_dp/15.0_dp*r155+18.0_dp/245.0_dp*r355 - sep%onec2el(26) = -s3/15.0_dp*r155+12.0_dp*s3/245.0_dp*r355 - sep%onec2el(27) = -s3/15.0_dp*r155-3.0_dp*s3/245.0_dp*r355 + sep%onec2el(23) = 4.0_dp/15.0_dp*r155 + 27.0_dp/245.0_dp*r355 + sep%onec2el(24) = 2.0_dp*s3/15.0_dp*r155 - 9.0_dp*s3/245.0_dp*r355 + sep%onec2el(25) = 1.0_dp/15.0_dp*r155 + 18.0_dp/245.0_dp*r355 + sep%onec2el(26) = -s3/15.0_dp*r155 + 12.0_dp*s3/245.0_dp*r355 + sep%onec2el(27) = -s3/15.0_dp*r155 - 3.0_dp*s3/245.0_dp*r355 sep%onec2el(28) = -sep%onec2el(27) - sep%onec2el(29) = r066+4.0_dp/49.0_dp*r266+4.0_dp/49.0_dp*r466 - sep%onec2el(30) = r066+2.0_dp/49.0_dp*r266-24.0_dp/441.0_dp*r466 - sep%onec2el(31) = r066-4.0_dp/49.0_dp*r266+6.0_dp/441.0_dp*r466 + sep%onec2el(29) = r066 + 4.0_dp/49.0_dp*r266 + 4.0_dp/49.0_dp*r466 + sep%onec2el(30) = r066 + 2.0_dp/49.0_dp*r266 - 24.0_dp/441.0_dp*r466 + sep%onec2el(31) = r066 - 4.0_dp/49.0_dp*r266 + 6.0_dp/441.0_dp*r466 sep%onec2el(32) = SQRT(3.0_dp/245.0_dp)*r246 - sep%onec2el(33) = 1.0_dp/5.0_dp*r155+24.0_dp/245.0_dp*r355 - sep%onec2el(34) = 1.0_dp/5.0_dp*r155-6.0_dp/245.0_dp*r355 + sep%onec2el(33) = 1.0_dp/5.0_dp*r155 + 24.0_dp/245.0_dp*r355 + sep%onec2el(34) = 1.0_dp/5.0_dp*r155 - 6.0_dp/245.0_dp*r355 sep%onec2el(35) = 3.0_dp/49.0_dp*r355 - sep%onec2el(36) = 1.0_dp/49.0_dp*r266+30.0_dp/441.0_dp*r466 - sep%onec2el(37) = s3/49.0_dp*r266-5.0_dp*s3/441.0_dp*r466 - sep%onec2el(38) = r066-2.0_dp/49.0_dp*r266-4.0_dp/441.0_dp*r466 - sep%onec2el(39) = -2.0_dp*s3/49.0_dp*r266+10.0_dp*s3/441.0_dp*r466 + sep%onec2el(36) = 1.0_dp/49.0_dp*r266 + 30.0_dp/441.0_dp*r466 + sep%onec2el(37) = s3/49.0_dp*r266 - 5.0_dp*s3/441.0_dp*r466 + sep%onec2el(38) = r066 - 2.0_dp/49.0_dp*r266 - 4.0_dp/441.0_dp*r466 + sep%onec2el(39) = -2.0_dp*s3/49.0_dp*r266 + 10.0_dp*s3/441.0_dp*r466 sep%onec2el(40) = -sep%onec2el(32) sep%onec2el(41) = -sep%onec2el(34) sep%onec2el(42) = -sep%onec2el(35) sep%onec2el(43) = -sep%onec2el(37) - sep%onec2el(44) = 3.0_dp/49.0_dp*r266+20.0_dp/441.0_dp*r466 + sep%onec2el(44) = 3.0_dp/49.0_dp*r266 + 20.0_dp/441.0_dp*r466 sep%onec2el(45) = -sep%onec2el(39) - sep%onec2el(46) = 1.0_dp/5.0_dp*r155-3.0_dp/35.0_dp*r355 + sep%onec2el(46) = 1.0_dp/5.0_dp*r155 - 3.0_dp/35.0_dp*r355 sep%onec2el(47) = -sep%onec2el(46) - sep%onec2el(48) = 4.0_dp/49.0_dp*r266+15.0_dp/441.0_dp*r466 - sep%onec2el(49) = 3.0_dp/49.0_dp*r266-5.0_dp/147.0_dp*r466 + sep%onec2el(48) = 4.0_dp/49.0_dp*r266 + 15.0_dp/441.0_dp*r466 + sep%onec2el(49) = 3.0_dp/49.0_dp*r266 - 5.0_dp/147.0_dp*r466 sep%onec2el(50) = -sep%onec2el(49) - sep%onec2el(51) = r066+4.0_dp/49.0_dp*r266-34.0_dp/441.0_dp*r466 + sep%onec2el(51) = r066 + 4.0_dp/49.0_dp*r266 - 34.0_dp/441.0_dp*r466 sep%onec2el(52) = 35.0_dp/441.0_dp*r466 sep%f0dd = r066 sep%f2dd = r266 @@ -893,35 +893,35 @@ FUNCTION sc_param_low(k, na, ea, nb, eb, nc, ec, nd, ed) RESULT(res) aeb = LOG(eb) aec = LOG(ec) aed = LOG(ed) - nab = na+nb - ncd = nc+nd - ecd = ec+ed - eab = ea+eb - e = ecd+eab - n = nab+ncd + nab = na + nb + ncd = nc + nd + ecd = ec + ed + eab = ea + eb + e = ecd + eab + n = nab + ncd ae = LOG(e) a2 = LOG(2.0_dp) acd = LOG(ecd) aab = LOG(eab) - ff = fac(n-1)/SQRT(fac(2*na)*fac(2*nb)*fac(2*nc)*fac(2*nd)) - tmp = na*aea+nb*aeb+nc*aec+nd*aed+0.5_dp*(aea+aeb+aec+aed)+a2*(n+2)-ae*n + ff = fac(n - 1)/SQRT(fac(2*na)*fac(2*nb)*fac(2*nc)*fac(2*nd)) + tmp = na*aea + nb*aeb + nc*aec + nd*aed + 0.5_dp*(aea + aeb + aec + aed) + a2*(n + 2) - ae*n c = evolt*ff*EXP(tmp) s0 = 1.0_dp/e s1 = 0.0_dp s2 = 0.0_dp - m = ncd-k + m = ncd - k DO i = 1, m s0 = s0*e/ecd - s1 = s1+s0*(binomial(ncd-k-1, i-1)-binomial(ncd+k, i-1))/binomial(n-1, i-1) + s1 = s1 + s0*(binomial(ncd - k - 1, i - 1) - binomial(ncd + k, i - 1))/binomial(n - 1, i - 1) END DO m1 = m - m2 = ncd+k + m2 = ncd + k DO i = m1, m2 s0 = s0*e/ecd - s2 = s2+s0*binomial(m2, i)/binomial(n-1, i) + s2 = s2 + s0*binomial(m2, i)/binomial(n - 1, i) END DO - s3 = EXP(ae*n-acd*(m2+1)-aab*(nab-k))/binomial(n-1, m2) - res = c*(s1-s2+s3) + s3 = EXP(ae*n - acd*(m2 + 1) - aab*(nab - k))/binomial(n - 1, m2) + res = c*(s1 - s2 + s3) END FUNCTION sc_param_low ! ************************************************************************************************** @@ -949,10 +949,10 @@ SUBROUTINE eisol_corr(sep, r016, r066, r244, r266, r466) CHARACTER(len=*), PARAMETER :: routineN = 'eisol_corr', routineP = moduleN//':'//routineN - sep%eisol = sep%eisol+ir016(sep%z)*r016+ & - ir066(sep%z)*r066- & - ir244(sep%z)*r244/5.0_dp- & - ir266(sep%z)*r266/49.0_dp- & + sep%eisol = sep%eisol + ir016(sep%z)*r016 + & + ir066(sep%z)*r066 - & + ir244(sep%z)*r244/5.0_dp - & + ir266(sep%z)*r266/49.0_dp - & ir466(sep%z)*r466/49.0_dp END SUBROUTINE eisol_corr @@ -994,16 +994,16 @@ FUNCTION ko_ij(l, d, fg) RESULT(res) a1 = 0.1_dp a2 = 5.0_dp DO i = 1, niter - delta = a2-a1 + delta = a2 - a1 IF (delta < epsil) EXIT - y1 = a1+delta*g1 - y2 = a1+delta*g2 + y1 = a1 + delta*g1 + y2 = a1 + delta*g2 IF (l == 1) THEN - f1 = (ev4*(1/y1-1/SQRT(y1**2+dsq))-fg)**2 - f2 = (ev4*(1/y2-1/SQRT(y2**2+dsq))-fg)**2 + f1 = (ev4*(1/y1 - 1/SQRT(y1**2 + dsq)) - fg)**2 + f2 = (ev4*(1/y2 - 1/SQRT(y2**2 + dsq)) - fg)**2 ELSE IF (l == 2) THEN - f1 = (ev8*(1.0_dp/y1-2.0_dp/SQRT(y1**2+dsq*0.5_dp)+1.0_dp/SQRT(y1**2+dsq))-fg)**2 - f2 = (ev8*(1/y2-2.0_dp/SQRT(y2**2+dsq*0.5_dp)+1.0_dp/SQRT(y2**2+dsq))-fg)**2 + f1 = (ev8*(1.0_dp/y1 - 2.0_dp/SQRT(y1**2 + dsq*0.5_dp) + 1.0_dp/SQRT(y1**2 + dsq)) - fg)**2 + f2 = (ev8*(1/y2 - 2.0_dp/SQRT(y2**2 + dsq*0.5_dp) + 1.0_dp/SQRT(y2**2 + dsq)) - fg)**2 END IF IF (f1 < f2) THEN a2 = y2 @@ -1041,7 +1041,7 @@ SUBROUTINE setup_1c_2el_int(sep) gss=gss, gsp=gsp, gpp=gpp, gp2=gp2, hsp=hsp) CPASSERT(defined) - isize = natorb*(natorb+1)/2 + isize = natorb*(natorb + 1)/2 ALLOCATE (sep%w(isize, isize)) ! Initialize array sep%w = 0.0_dp @@ -1050,9 +1050,9 @@ SUBROUTINE setup_1c_2el_int(sep) ip = 1 sep%w(ip, ip) = gss IF (natorb > 2) THEN - ipx = ip+2 - ipy = ip+5 - ipz = ip+9 + ipx = ip + 2 + ipy = ip + 5 + ipz = ip + 9 sep%w(ipx, ip) = gsp sep%w(ipy, ip) = gsp sep%w(ipz, ip) = gsp @@ -1068,19 +1068,19 @@ SUBROUTINE setup_1c_2el_int(sep) sep%w(ipx, ipy) = gp2 sep%w(ipx, ipz) = gp2 sep%w(ipy, ipz) = gp2 - sep%w(ip+1, ip+1) = hsp - sep%w(ip+3, ip+3) = hsp - sep%w(ip+6, ip+6) = hsp - sep%w(ip+4, ip+4) = 0.5_dp*(gpp-gp2) - sep%w(ip+7, ip+7) = 0.5_dp*(gpp-gp2) - sep%w(ip+8, ip+8) = 0.5_dp*(gpp-gp2) + sep%w(ip + 1, ip + 1) = hsp + sep%w(ip + 3, ip + 3) = hsp + sep%w(ip + 6, ip + 6) = hsp + sep%w(ip + 4, ip + 4) = 0.5_dp*(gpp - gp2) + sep%w(ip + 7, ip + 7) = 0.5_dp*(gpp - gp2) + sep%w(ip + 8, ip + 8) = 0.5_dp*(gpp - gp2) IF (sep%dorb) THEN - ij0 = ip-1 + ij0 = ip - 1 DO i = 1, 243 ij = int_ij(i) kl = int_kl(i) ind = int_onec2el(i) - sep%w(ij+ij0, kl+ij0) = sep%onec2el(ind)/evolt + sep%w(ij + ij0, kl + ij0) = sep%onec2el(ind)/evolt END DO END IF END IF diff --git a/src/semi_empirical_parameters.F b/src/semi_empirical_parameters.F index 605dcd91f3..e152521288 100644 --- a/src/semi_empirical_parameters.F +++ b/src/semi_empirical_parameters.F @@ -7465,11 +7465,11 @@ SUBROUTINE init_pm6_pair_params() aab_pm6(83, 83) = 1.0740640163_dp DO i = 0, nelem - DO j = i+1, nelem - xab = xab_pm6(i, j)+xab_pm6(j, i) + DO j = i + 1, nelem + xab = xab_pm6(i, j) + xab_pm6(j, i) xab_pm6(i, j) = xab xab_pm6(j, i) = xab - aab = aab_pm6(i, j)+aab_pm6(j, i) + aab = aab_pm6(i, j) + aab_pm6(j, i) aab_pm6(i, j) = aab aab_pm6(j, i) = aab END DO @@ -9355,11 +9355,11 @@ SUBROUTINE init_pm6fm_pair_params() aab_pm6fm(83, 83) = 1.0740640163_dp DO i = 0, nelem - DO j = i+1, nelem - xab = xab_pm6fm(i, j)+xab_pm6fm(j, i) + DO j = i + 1, nelem + xab = xab_pm6fm(i, j) + xab_pm6fm(j, i) xab_pm6fm(i, j) = xab xab_pm6fm(j, i) = xab - aab = aab_pm6fm(i, j)+aab_pm6fm(j, i) + aab = aab_pm6fm(i, j) + aab_pm6fm(j, i) aab_pm6fm(i, j) = aab aab_pm6fm(j, i) = aab END DO diff --git a/src/semi_empirical_store_int_types.F b/src/semi_empirical_store_int_types.F index 674dbf894b..a8aab40740 100644 --- a/src/semi_empirical_store_int_types.F +++ b/src/semi_empirical_store_int_types.F @@ -246,7 +246,7 @@ SUBROUTINE semi_empirical_si_finalize(store_int_env, geometry_did_change) ELSE ! Skip compression CALL reallocate(store_int_env%uncompressed_container, 1, & - store_int_env%memory_parameter%actual_memory_usage-1) + store_int_env%memory_parameter%actual_memory_usage - 1) END IF END IF IF (store_int_env%compress) THEN diff --git a/src/semi_empirical_utils.F b/src/semi_empirical_utils.F index e0de136944..c7f6a95260 100644 --- a/src/semi_empirical_utils.F +++ b/src/semi_empirical_utils.F @@ -244,7 +244,7 @@ SUBROUTINE init_se_param(sep, orb_basis_set, ngauss) nq = 0 lq = 0 zet = 0._dp - DO l = 0, nshell-1 + DO l = 0, nshell - 1 nq(l) = get_se_basis(sep, l) lq(l) = l zet(l) = sep%sto_exponents(l) @@ -335,7 +335,7 @@ SUBROUTINE se_param_set_default(sep, z, method) IF (sep%dorb) sep%core_size = 10 ! Get size of the all possible combinations of atomic orbitals - sep%atm_int_size = (sep%natorb+1)*sep%natorb/2 + sep%atm_int_size = (sep%natorb + 1)*sep%natorb/2 END SUBROUTINE se_param_set_default diff --git a/src/shg_int/construct_shg.F b/src/shg_int/construct_shg.F index b9cf71c8f4..cd9f7b9ae6 100644 --- a/src/shg_int/construct_shg.F +++ b/src/shg_int/construct_shg.F @@ -76,8 +76,8 @@ SUBROUTINE get_real_scaled_solid_harmonic(Rlm_c, Rlm_s, l, r, r2) Rlm_s(1, -1) = Rs ENDIF DO li = 2, l - temp_c = (-r(1)*Rc+r(2)*Rs)/(REAL(2*(li-1)+2, dp)) - Rs = (-r(2)*Rc-r(1)*Rs)/(REAL(2*(li-1)+2, dp)) + temp_c = (-r(1)*Rc + r(2)*Rs)/(REAL(2*(li - 1) + 2, dp)) + Rs = (-r(2)*Rc - r(1)*Rs)/(REAL(2*(li - 1) + 2, dp)) Rc = temp_c Rlm_c(li, li) = Rc Rlm_s(li, li) = Rs @@ -90,18 +90,18 @@ SUBROUTINE get_real_scaled_solid_harmonic(Rlm_c, Rlm_s, l, r, r2) ENDIF ENDDO - DO mi = 0, l-1 + DO mi = 0, l - 1 Rmlm = Rlm_c(mi, mi) Rlm = r(3)*Rlm_c(mi, mi) - Rlm_c(mi+1, mi) = Rlm + Rlm_c(mi + 1, mi) = Rlm IF (MODULO(mi, 2) /= 0) THEN - Rlm_c(mi+1, -mi) = -Rlm + Rlm_c(mi + 1, -mi) = -Rlm ELSE - Rlm_c(mi+1, -mi) = Rlm + Rlm_c(mi + 1, -mi) = Rlm ENDIF - DO li = mi+2, l - prefac = (li+mi)*(li-mi) - Rplm = (REAL(2*li-1, dp)*r(3)*Rlm-r2*Rmlm)/REAL(prefac, dp) + DO li = mi + 2, l + prefac = (li + mi)*(li - mi) + Rplm = (REAL(2*li - 1, dp)*r(3)*Rlm - r2*Rmlm)/REAL(prefac, dp) Rmlm = Rlm Rlm = Rplm Rlm_c(li, mi) = Rlm @@ -112,18 +112,18 @@ SUBROUTINE get_real_scaled_solid_harmonic(Rlm_c, Rlm_s, l, r, r2) ENDIF ENDDO ENDDO - DO mi = 1, l-1 + DO mi = 1, l - 1 Rmlm = Rlm_s(mi, mi) Rlm = r(3)*Rlm_s(mi, mi) - Rlm_s(mi+1, mi) = Rlm + Rlm_s(mi + 1, mi) = Rlm IF (MODULO(mi, 2) /= 0) THEN - Rlm_s(mi+1, -mi) = Rlm + Rlm_s(mi + 1, -mi) = Rlm ELSE - Rlm_s(mi+1, -mi) = -Rlm + Rlm_s(mi + 1, -mi) = -Rlm ENDIF - DO li = mi+2, l - prefac = (li+mi)*(li-mi) - Rplm = (REAL(2*li-1, dp)*r(3)*Rlm-r2*Rmlm)/REAL(prefac, dp) + DO li = mi + 2, l + prefac = (li + mi)*(li - mi) + Rplm = (REAL(2*li - 1, dp)*r(3)*Rlm - r2*Rmlm)/REAL(prefac, dp) Rmlm = Rlm Rlm = Rplm Rlm_s(li, mi) = Rlm @@ -155,7 +155,7 @@ SUBROUTINE get_Alm(lmax, A) DO l = 0, lmax DO m = 0, l - temp = SQRT(fac(l+m)*fac(l-m)) + temp = SQRT(fac(l + m)*fac(l - m)) IF (MODULO(m, 2) /= 0) temp = -temp IF (m /= 0) temp = temp*SQRT(2.0_dp) A(l, m) = temp @@ -192,11 +192,11 @@ SUBROUTINE get_dA_prefactors(lmax, dA_p, dA_m, dA) bm_m = 1.0_dp bm_p = 1.0_dp IF (m /= 0) bm = SQRT(2.0_dp) - IF (m-1 /= 0) bm_m = SQRT(2.0_dp) - IF (m+1 /= 0) bm_p = SQRT(2.0_dp) - dA_p(l, m) = -bm/bm_p*SQRT(REAL((l-m)*(l-m-1), dp)) - dA_m(l, m) = -bm/bm_m*SQRT(REAL((l+m)*(l+m-1), dp)) - dA(l, m) = 2.0_dp*SQRT(REAL((l+m)*(l-m), dp)) + IF (m - 1 /= 0) bm_m = SQRT(2.0_dp) + IF (m + 1 /= 0) bm_p = SQRT(2.0_dp) + dA_p(l, m) = -bm/bm_p*SQRT(REAL((l - m)*(l - m - 1), dp)) + dA_m(l, m) = -bm/bm_m*SQRT(REAL((l + m)*(l + m - 1), dp)) + dA(l, m) = 2.0_dp*SQRT(REAL((l + m)*(l - m), dp)) IF (m == 0) dA_p(l, m) = 2.0_dp*dA_p(l, m) ENDDO ENDDO @@ -237,9 +237,9 @@ SUBROUTINE get_W_matrix(lamax, lbmax, lmax, Rc, Rs, Waux_mat) CALL get_Alm(lmax, A) DO lb = 0, lbmax - nlb = nsoset(lb-1) + nlb = nsoset(lb - 1) DO la = 0, lamax(lb) - nla = nsoset(la-1) + nla = nsoset(la - 1) labmin = MIN(la, lb) DO mb = 0, lb A_lbmb = A(lb, mb) @@ -248,20 +248,20 @@ SUBROUTINE get_W_matrix(lamax, lbmax, lmax, Rc, Rs, Waux_mat) A_lama = A(la, ma) Alm_fac = A_lama*A_lbmb DO j = 0, labmin - laj = la-j - lbj = lb-j - prefac = Alm_fac*REAL(2**(la+lb-j), dp)*dfac(2*j-1) + laj = la - j + lbj = lb - j + prefac = Alm_fac*REAL(2**(la + lb - j), dp)*dfac(2*j - 1) delta_k = 0.5_dp Wmat = 0.0_dp DO k = 0, j - ma_m = ma-k - ma_p = ma+k + ma_m = ma - k + ma_p = ma + k IF (laj < ABS(ma_m) .AND. laj < ABS(ma_p)) CYCLE - mb_m = mb-k - mb_p = mb+k + mb_m = mb - k + mb_p = mb + k IF (lbj < ABS(mb_m) .AND. lbj < ABS(mb_p)) CYCLE IF (k /= 0) delta_k = 1.0_dp - A_jk = fac(j+k)*fac(j-k) + A_jk = fac(j + k)*fac(j - k) IF (k /= 0) A_jk = 2.0_dp*A_jk IF (MODULO(k, 2) /= 0) THEN sign_fac = -1.0_dp @@ -276,29 +276,29 @@ SUBROUTINE get_W_matrix(lamax, lbmax, lmax, Rc, Rs, Waux_mat) Rsb_m = Rs(lbj, mb_m) Rcb_p = Rc(lbj, mb_p) Rsb_p = Rs(lbj, mb_p) - Wa(1) = delta_k*(Rca_m+sign_fac*Rca_p) - Wb(1) = delta_k*(Rcb_m+sign_fac*Rcb_p) - Wa(2) = -Rsa_m+sign_fac*Rsa_p - Wb(2) = -Rsb_m+sign_fac*Rsb_p - Wmat(1) = Wmat(1)+prefac/A_jk*(Wa(1)*Wb(1)+Wa(2)*Wb(2)) + Wa(1) = delta_k*(Rca_m + sign_fac*Rca_p) + Wb(1) = delta_k*(Rcb_m + sign_fac*Rcb_p) + Wa(2) = -Rsa_m + sign_fac*Rsa_p + Wb(2) = -Rsb_m + sign_fac*Rsb_p + Wmat(1) = Wmat(1) + prefac/A_jk*(Wa(1)*Wb(1) + Wa(2)*Wb(2)) IF (mb > 0) THEN - Wb(3) = delta_k*(Rsb_m+sign_fac*Rsb_p) - Wb(4) = Rcb_m-sign_fac*Rcb_p - Wmat(2) = Wmat(2)+prefac/A_jk*(Wa(1)*Wb(3)+Wa(2)*Wb(4)) + Wb(3) = delta_k*(Rsb_m + sign_fac*Rsb_p) + Wb(4) = Rcb_m - sign_fac*Rcb_p + Wmat(2) = Wmat(2) + prefac/A_jk*(Wa(1)*Wb(3) + Wa(2)*Wb(4)) ENDIF IF (ma > 0) THEN - Wa(3) = delta_k*(Rsa_m+sign_fac*Rsa_p) - Wa(4) = Rca_m-sign_fac*Rca_p - Wmat(3) = Wmat(3)+prefac/A_jk*(Wa(3)*Wb(1)+Wa(4)*Wb(2)) + Wa(3) = delta_k*(Rsa_m + sign_fac*Rsa_p) + Wa(4) = Rca_m - sign_fac*Rca_p + Wmat(3) = Wmat(3) + prefac/A_jk*(Wa(3)*Wb(1) + Wa(4)*Wb(2)) ENDIF IF (ma > 0 .AND. mb > 0) THEN - Wmat(4) = Wmat(4)+prefac/A_jk*(Wa(3)*Wb(3)+Wa(4)*Wb(4)) + Wmat(4) = Wmat(4) + prefac/A_jk*(Wa(3)*Wb(3) + Wa(4)*Wb(4)) ENDIF ENDDO - Waux_mat(j+1, nla+la+1+ma, nlb+lb+1+mb) = Wmat(1) - IF (mb > 0) Waux_mat(j+1, nla+la+1+ma, nlb+lb+1-mb) = Wmat(2) - IF (ma > 0) Waux_mat(j+1, nla+la+1-ma, nlb+lb+1+mb) = Wmat(3) - IF (ma > 0 .AND. mb > 0) Waux_mat(j+1, nla+la+1-ma, nlb+lb+1-mb) = Wmat(4) + Waux_mat(j + 1, nla + la + 1 + ma, nlb + lb + 1 + mb) = Wmat(1) + IF (mb > 0) Waux_mat(j + 1, nla + la + 1 + ma, nlb + lb + 1 - mb) = Wmat(2) + IF (ma > 0) Waux_mat(j + 1, nla + la + 1 - ma, nlb + lb + 1 + mb) = Wmat(3) + IF (ma > 0 .AND. mb > 0) Waux_mat(j + 1, nla + la + 1 - ma, nlb + lb + 1 - mb) = Wmat(4) ENDDO ENDDO ENDDO @@ -347,122 +347,122 @@ SUBROUTINE get_dW_matrix(lamax, lbmax, Waux_mat, dWaux_mat) CALL get_dA_prefactors(lmax, dA_p, dA_m, dA) DO lb = 0, lbmax - nlb = nsoset(lb-1) + nlb = nsoset(lb - 1) nlbm = 0 - IF (lb > 0) nlbm = nsoset(lb-2) + IF (lb > 0) nlbm = nsoset(lb - 2) DO la = 0, lamax(lb) - nla = nsoset(la-1) + nla = nsoset(la - 1) nlam = 0 - IF (la > 0) nlam = nsoset(la-2) + IF (la > 0) nlam = nsoset(la - 2) labmin = MIN(la, lb) - lamb = MIN(la-1, lb) - labm = MIN(la, lb-1) + lamb = MIN(la - 1, lb) + labm = MIN(la, lb - 1) DO mb = 0, lb dAb = dA(lb, mb) dAb_p = dA_p(lb, mb) dAb_m = dA_m(lb, mb) - ipb = nlb+lb+mb+1 - imb = nlb+lb-mb+1 - ipbm = nlbm+lb+mb - imbm = nlbm+lb-mb + ipb = nlb + lb + mb + 1 + imb = nlb + lb - mb + 1 + ipbm = nlbm + lb + mb + imbm = nlbm + lb - mb DO ma = 0, la dAa = dA(la, ma) dAa_p = dA_p(la, ma) dAa_m = dA_m(la, ma) - ipa = nla+la+ma+1 - ima = nla+la-ma+1 - ipam = nlam+la+ma - imam = nlam+la-ma + ipa = nla + la + ma + 1 + ima = nla + la - ma + 1 + ipam = nlam + la + ma + imam = nlam + la - ma Wam(:, :) = 0.0_dp Wamm(:, :) = 0.0_dp Wamp(:, :) = 0.0_dp !*** Wam: la-1, ma - IF (ma <= la-1) THEN - Wam(0:lamb, 1) = Waux_mat(1:lamb+1, ipam, ipb) - IF (mb > 0) Wam(0:lamb, 2) = Waux_mat(1:lamb+1, ipam, imb) - IF (ma > 0) Wam(0:lamb, 3) = Waux_mat(1:lamb+1, imam, ipb) - IF (ma > 0 .AND. mb > 0) Wam(0:lamb, 4) = Waux_mat(1:lamb+1, imam, imb) + IF (ma <= la - 1) THEN + Wam(0:lamb, 1) = Waux_mat(1:lamb + 1, ipam, ipb) + IF (mb > 0) Wam(0:lamb, 2) = Waux_mat(1:lamb + 1, ipam, imb) + IF (ma > 0) Wam(0:lamb, 3) = Waux_mat(1:lamb + 1, imam, ipb) + IF (ma > 0 .AND. mb > 0) Wam(0:lamb, 4) = Waux_mat(1:lamb + 1, imam, imb) ENDIF !*** Wamm: la-1, ma-1 - IF (ma-1 >= 0) THEN - Wamm(0:lamb, 1) = Waux_mat(1:lamb+1, ipam-1, ipb) - IF (mb > 0) Wamm(0:lamb, 2) = Waux_mat(1:lamb+1, ipam-1, imb) - IF (ma-1 > 0) Wamm(0:lamb, 3) = Waux_mat(1:lamb+1, imam+1, ipb) !order: e.g. -1 0 1, if < 0 |m|, -1 means -m+1 - IF (ma-1 > 0 .AND. mb > 0) Wamm(0:lamb, 4) = Waux_mat(1:lamb+1, imam+1, imb) + IF (ma - 1 >= 0) THEN + Wamm(0:lamb, 1) = Waux_mat(1:lamb + 1, ipam - 1, ipb) + IF (mb > 0) Wamm(0:lamb, 2) = Waux_mat(1:lamb + 1, ipam - 1, imb) + IF (ma - 1 > 0) Wamm(0:lamb, 3) = Waux_mat(1:lamb + 1, imam + 1, ipb) !order: e.g. -1 0 1, if < 0 |m|, -1 means -m+1 + IF (ma - 1 > 0 .AND. mb > 0) Wamm(0:lamb, 4) = Waux_mat(1:lamb + 1, imam + 1, imb) ENDIF !*** Wamp: la-1, ma+1 - IF (ma+1 <= la-1) THEN - Wamp(0:lamb, 1) = Waux_mat(1:lamb+1, ipam+1, ipb) - IF (mb > 0) Wamp(0:lamb, 2) = Waux_mat(1:lamb+1, ipam+1, imb) - IF (ma+1 > 0) Wamp(0:lamb, 3) = Waux_mat(1:lamb+1, imam-1, ipb) - IF (ma+1 > 0 .AND. mb > 0) Wamp(0:lamb, 4) = Waux_mat(1:lamb+1, imam-1, imb) + IF (ma + 1 <= la - 1) THEN + Wamp(0:lamb, 1) = Waux_mat(1:lamb + 1, ipam + 1, ipb) + IF (mb > 0) Wamp(0:lamb, 2) = Waux_mat(1:lamb + 1, ipam + 1, imb) + IF (ma + 1 > 0) Wamp(0:lamb, 3) = Waux_mat(1:lamb + 1, imam - 1, ipb) + IF (ma + 1 > 0 .AND. mb > 0) Wamp(0:lamb, 4) = Waux_mat(1:lamb + 1, imam - 1, imb) ENDIF Wbm(:, :) = 0.0_dp Wbmm(:, :) = 0.0_dp Wbmp(:, :) = 0.0_dp !*** Wbm: lb-1, mb - IF (mb <= lb-1) THEN - Wbm(0:labm, 1) = Waux_mat(1:labm+1, ipa, ipbm) - IF (mb > 0) Wbm(0:labm, 2) = Waux_mat(1:labm+1, ipa, imbm) - IF (ma > 0) Wbm(0:labm, 3) = Waux_mat(1:labm+1, ima, ipbm) - IF (ma > 0 .AND. mb > 0) Wbm(0:labm, 4) = Waux_mat(1:labm+1, ima, imbm) + IF (mb <= lb - 1) THEN + Wbm(0:labm, 1) = Waux_mat(1:labm + 1, ipa, ipbm) + IF (mb > 0) Wbm(0:labm, 2) = Waux_mat(1:labm + 1, ipa, imbm) + IF (ma > 0) Wbm(0:labm, 3) = Waux_mat(1:labm + 1, ima, ipbm) + IF (ma > 0 .AND. mb > 0) Wbm(0:labm, 4) = Waux_mat(1:labm + 1, ima, imbm) ENDIF !*** Wbmm: lb-1, mb-1 - IF (mb-1 >= 0) THEN - Wbmm(0:labm, 1) = Waux_mat(1:labm+1, ipa, ipbm-1) - IF (mb-1 > 0) Wbmm(0:labm, 2) = Waux_mat(1:labm+1, ipa, imbm+1) - IF (ma > 0) Wbmm(0:labm, 3) = Waux_mat(1:labm+1, ima, ipbm-1) - IF (ma > 0 .AND. mb-1 > 0) Wbmm(0:labm, 4) = Waux_mat(1:labm+1, ima, imbm+1) + IF (mb - 1 >= 0) THEN + Wbmm(0:labm, 1) = Waux_mat(1:labm + 1, ipa, ipbm - 1) + IF (mb - 1 > 0) Wbmm(0:labm, 2) = Waux_mat(1:labm + 1, ipa, imbm + 1) + IF (ma > 0) Wbmm(0:labm, 3) = Waux_mat(1:labm + 1, ima, ipbm - 1) + IF (ma > 0 .AND. mb - 1 > 0) Wbmm(0:labm, 4) = Waux_mat(1:labm + 1, ima, imbm + 1) ENDIF !*** Wbmp: lb-1, mb+1 - IF (mb+1 <= lb-1) THEN - Wbmp(0:labm, 1) = Waux_mat(1:labm+1, ipa, ipbm+1) - IF (mb+1 > 0) Wbmp(0:labm, 2) = Waux_mat(1:labm+1, ipa, imbm-1) - IF (ma > 0) Wbmp(0:labm, 3) = Waux_mat(1:labm+1, ima, ipbm+1) - IF (ma > 0 .AND. mb+1 > 0) Wbmp(0:labm, 4) = Waux_mat(1:labm+1, ima, imbm-1) + IF (mb + 1 <= lb - 1) THEN + Wbmp(0:labm, 1) = Waux_mat(1:labm + 1, ipa, ipbm + 1) + IF (mb + 1 > 0) Wbmp(0:labm, 2) = Waux_mat(1:labm + 1, ipa, imbm - 1) + IF (ma > 0) Wbmp(0:labm, 3) = Waux_mat(1:labm + 1, ima, ipbm + 1) + IF (ma > 0 .AND. mb + 1 > 0) Wbmp(0:labm, 4) = Waux_mat(1:labm + 1, ima, imbm - 1) ENDIF DO j = 0, labmin !*** x component - dWaux_mat(1, j+1, ipa, ipb) = dAa_p*Wamp(j, 1)-dAa_m*Wamm(j, 1) & - -dAb_p*Wbmp(j, 1)+dAb_m*Wbmm(j, 1) + dWaux_mat(1, j + 1, ipa, ipb) = dAa_p*Wamp(j, 1) - dAa_m*Wamm(j, 1) & + - dAb_p*Wbmp(j, 1) + dAb_m*Wbmm(j, 1) IF (mb > 0) THEN - dWaux_mat(1, j+1, ipa, imb) = dAa_p*Wamp(j, 2)-dAa_m*Wamm(j, 2) & - -dAb_p*Wbmp(j, 2)+dAb_m*Wbmm(j, 2) + dWaux_mat(1, j + 1, ipa, imb) = dAa_p*Wamp(j, 2) - dAa_m*Wamm(j, 2) & + - dAb_p*Wbmp(j, 2) + dAb_m*Wbmm(j, 2) ENDIF IF (ma > 0) THEN - dWaux_mat(1, j+1, ima, ipb) = dAa_p*Wamp(j, 3)-dAa_m*Wamm(j, 3) & - -dAb_p*Wbmp(j, 3)+dAb_m*Wbmm(j, 3) + dWaux_mat(1, j + 1, ima, ipb) = dAa_p*Wamp(j, 3) - dAa_m*Wamm(j, 3) & + - dAb_p*Wbmp(j, 3) + dAb_m*Wbmm(j, 3) ENDIF IF (ma > 0 .AND. mb > 0) THEN - dWaux_mat(1, j+1, ima, imb) = dAa_p*Wamp(j, 4)-dAa_m*Wamm(j, 4) & - -dAb_p*Wbmp(j, 4)+dAb_m*Wbmm(j, 4) + dWaux_mat(1, j + 1, ima, imb) = dAa_p*Wamp(j, 4) - dAa_m*Wamm(j, 4) & + - dAb_p*Wbmp(j, 4) + dAb_m*Wbmm(j, 4) ENDIF !**** y component - dWaux_mat(2, j+1, ipa, ipb) = dAa_p*Wamp(j, 3)+dAa_m*Wamm(j, 3) & - -dAb_p*Wbmp(j, 2)-dAb_m*Wbmm(j, 2) + dWaux_mat(2, j + 1, ipa, ipb) = dAa_p*Wamp(j, 3) + dAa_m*Wamm(j, 3) & + - dAb_p*Wbmp(j, 2) - dAb_m*Wbmm(j, 2) IF (mb > 0) THEN - dWaux_mat(2, j+1, ipa, imb) = dAa_p*Wamp(j, 4)+dAa_m*Wamm(j, 4) & - +dAb_p*Wbmp(j, 1)+dAb_m*Wbmm(j, 1) + dWaux_mat(2, j + 1, ipa, imb) = dAa_p*Wamp(j, 4) + dAa_m*Wamm(j, 4) & + + dAb_p*Wbmp(j, 1) + dAb_m*Wbmm(j, 1) ENDIF IF (ma > 0) THEN - dWaux_mat(2, j+1, ima, ipb) = -dAa_p*Wamp(j, 1)-dAa_m*Wamm(j, 1) & - -dAb_p*Wbmp(j, 4)-dAb_m*Wbmm(j, 4) + dWaux_mat(2, j + 1, ima, ipb) = -dAa_p*Wamp(j, 1) - dAa_m*Wamm(j, 1) & + - dAb_p*Wbmp(j, 4) - dAb_m*Wbmm(j, 4) ENDIF IF (ma > 0 .AND. mb > 0) THEN - dWaux_mat(2, j+1, ima, imb) = -dAa_p*Wamp(j, 2)-dAa_m*Wamm(j, 2) & - +dAb_p*Wbmp(j, 3)+dAb_m*Wbmm(j, 3) + dWaux_mat(2, j + 1, ima, imb) = -dAa_p*Wamp(j, 2) - dAa_m*Wamm(j, 2) & + + dAb_p*Wbmp(j, 3) + dAb_m*Wbmm(j, 3) ENDIF !**** z compnent - dWaux_mat(3, j+1, ipa, ipb) = dAa*Wam(j, 1)-dAb*Wbm(j, 1) + dWaux_mat(3, j + 1, ipa, ipb) = dAa*Wam(j, 1) - dAb*Wbm(j, 1) IF (mb > 0) THEN - dWaux_mat(3, j+1, ipa, imb) = dAa*Wam(j, 2)-dAb*Wbm(j, 2) + dWaux_mat(3, j + 1, ipa, imb) = dAa*Wam(j, 2) - dAb*Wbm(j, 2) ENDIF IF (ma > 0) THEN - dWaux_mat(3, j+1, ima, ipb) = dAa*Wam(j, 3)-dAb*Wbm(j, 3) + dWaux_mat(3, j + 1, ima, ipb) = dAa*Wam(j, 3) - dAb*Wbm(j, 3) ENDIF IF (ma > 0 .AND. mb > 0) THEN - dWaux_mat(3, j+1, ima, imb) = dAa*Wam(j, 4)-dAb*Wbm(j, 4) + dWaux_mat(3, j + 1, ima, imb) = dAa*Wam(j, 4) - dAb*Wbm(j, 4) ENDIF ENDDO @@ -510,23 +510,23 @@ SUBROUTINE construct_int_shg_ab(la, first_sgfa, nshella, lb, first_sgfb, nshellb DO jshellb = 1, nshellb lbj = lb(jshellb) - fnlb = nsoset(lbj-1)+1 + fnlb = nsoset(lbj - 1) + 1 lnlb = nsoset(lbj) fsgfb = first_sgfb(jshellb) - lsgfb = fsgfb+2*lbj + lsgfb = fsgfb + 2*lbj DO ishella = 1, nshella lai = la(ishella) - fnla = nsoset(lai-1)+1 + fnla = nsoset(lai - 1) + 1 lnla = nsoset(lai) fsgfa = first_sgfa(ishella) - lsgfa = fsgfa+2*lai + lsgfa = fsgfa + 2*lai labmin = MIN(lai, lbj) DO mbj = 0, 2*lbj DO mai = 0, 2*lai DO j = 0, labmin - prefac = swork_cont(lai+lbj-j+1, ishella, jshellb) - sab(fsgfa+mai, fsgfb+mbj) = sab(fsgfa+mai, fsgfb+mbj) & - +prefac*Waux_mat(j+1, fnla+mai, fnlb+mbj) + prefac = swork_cont(lai + lbj - j + 1, ishella, jshellb) + sab(fsgfa + mai, fsgfb + mbj) = sab(fsgfa + mai, fsgfb + mbj) & + + prefac*Waux_mat(j + 1, fnla + mai, fnlb + mbj) ENDDO ENDDO ENDDO @@ -573,24 +573,24 @@ SUBROUTINE construct_dev_shg_ab(la, first_sgfa, nshella, lb, first_sgfb, nshellb rabx2(:) = 2.0_dp*rab DO jshellb = 1, nshellb lbj = lb(jshellb) - fnlb = nsoset(lbj-1)+1 + fnlb = nsoset(lbj - 1) + 1 lnlb = nsoset(lbj) fsgfb = first_sgfb(jshellb) - lsgfb = fsgfb+2*lbj + lsgfb = fsgfb + 2*lbj DO ishella = 1, nshella lai = la(ishella) - fnla = nsoset(lai-1)+1 + fnla = nsoset(lai - 1) + 1 lnla = nsoset(lai) fsgfa = first_sgfa(ishella) - lsgfa = fsgfa+2*lai + lsgfa = fsgfa + 2*lai labmin = MIN(lai, lbj) DO j = 0, labmin - prefac = swork_cont(lai+lbj-j+1, ishella, jshellb) - dprefac = swork_cont(lai+lbj-j+2, ishella, jshellb) !j+1 + prefac = swork_cont(lai + lbj - j + 1, ishella, jshellb) + dprefac = swork_cont(lai + lbj - j + 2, ishella, jshellb) !j+1 DO i = 1, 3 dsab(fsgfa:lsgfa, fsgfb:lsgfb, i) = dsab(fsgfa:lsgfa, fsgfb:lsgfb, i) & - +rabx2(i)*dprefac*Waux_mat(j+1, fnla:lnla, fnlb:lnlb) & - +prefac*dWaux_mat(i, j+1, fnla:lnla, fnlb:lnlb) + + rabx2(i)*dprefac*Waux_mat(j + 1, fnla:lnla, fnlb:lnlb) & + + prefac*dWaux_mat(i, j + 1, fnla:lnla, fnlb:lnlb) ENDDO ENDDO ENDDO @@ -645,16 +645,16 @@ SUBROUTINE construct_overlap_shg_aba(la, first_sgfa, nshella, lb, first_sgfb, ns DO kshella = 1, nshellca lak = lca(kshella) sgfca = first_sgfca(kshella) - ka = sgfca+lak + ka = sgfca + lak DO jshellb = 1, nshellb lbj = lb(jshellb) - nlb = nsoset(lbj-1)+lbj+1 + nlb = nsoset(lbj - 1) + lbj + 1 sgfb = first_sgfb(jshellb) - jb = sgfb+lbj + jb = sgfb + lbj DO ishella = 1, nshella lai = la(ishella) sgfa = first_sgfa(ishella) - ia = sgfa+lai + ia = sgfa + lai DO mai = -lai, lai, 1 DO mak = -lak, lak, 1 isoa1 = indso_inv(lai, mai) @@ -664,15 +664,15 @@ SUBROUTINE construct_overlap_shg_aba(la, first_sgfa, nshella, lb, first_sgfb, ns isoaa = cg_none0_list(isoa1, isoa2, ilist) laa = indso(1, isoaa) maa = indso(2, isoaa) - nla = nsoset(laa-1)+laa+1 + nla = nsoset(laa - 1) + laa + 1 labmin = MIN(laa, lbj) - il = INT((lai+lak-laa)/2) + il = INT((lai + lak - laa)/2) stemp = 0.0_dp DO j = 0, labmin - prefac = swork_cont(laa+lbj-j+1, il, ishella, jshellb, kshella) - stemp = stemp+prefac*Waux_mat(j+1, nla+maa, nlb+mbj) + prefac = swork_cont(laa + lbj - j + 1, il, ishella, jshellb, kshella) + stemp = stemp + prefac*Waux_mat(j + 1, nla + maa, nlb + mbj) ENDDO - saba(ia+mai, jb+mbj, ka+mak) = saba(ia+mai, jb+mbj, ka+mak)+cg_coeff(isoa1, isoa2, isoaa)*stemp + saba(ia + mai, jb + mbj, ka + mak) = saba(ia + mai, jb + mbj, ka + mak) + cg_coeff(isoa1, isoa2, isoaa)*stemp ENDDO ENDDO ENDDO @@ -738,16 +738,16 @@ SUBROUTINE dev_overlap_shg_aba(la, first_sgfa, nshella, lb, first_sgfb, nshellb, DO kshella = 1, nshellca lak = lca(kshella) sgfca = first_sgfca(kshella) - ka = sgfca+lak + ka = sgfca + lak DO jshellb = 1, nshellb lbj = lb(jshellb) - nlb = nsoset(lbj-1)+lbj+1 + nlb = nsoset(lbj - 1) + lbj + 1 sgfb = first_sgfb(jshellb) - jb = sgfb+lbj + jb = sgfb + lbj DO ishella = 1, nshella lai = la(ishella) sgfa = first_sgfa(ishella) - ia = sgfa+lai + ia = sgfa + lai DO mai = -lai, lai, 1 DO mak = -lak, lak, 1 isoa1 = indso_inv(lai, mai) @@ -757,21 +757,21 @@ SUBROUTINE dev_overlap_shg_aba(la, first_sgfa, nshella, lb, first_sgfb, nshellb, isoaa = cg_none0_list(isoa1, isoa2, ilist) laa = indso(1, isoaa) maa = indso(2, isoaa) - nla = nsoset(laa-1)+laa+1 + nla = nsoset(laa - 1) + laa + 1 labmin = MIN(laa, lbj) - il = (lai+lak-laa)/2 ! lai+lak-laa always even + il = (lai + lak - laa)/2 ! lai+lak-laa always even dtemp = 0.0_dp DO j = 0, labmin - prefac = swork_cont(laa+lbj-j+1, il, ishella, jshellb, kshella) - dprefac = swork_cont(laa+lbj-j+2, il, ishella, jshellb, kshella) + prefac = swork_cont(laa + lbj - j + 1, il, ishella, jshellb, kshella) + dprefac = swork_cont(laa + lbj - j + 2, il, ishella, jshellb, kshella) DO i = 1, 3 - dtemp(i) = dtemp(i)+rabx2(i)*dprefac*Waux_mat(j+1, nla+maa, nlb+mbj) & - +prefac*dWaux_mat(i, j+1, nla+maa, nlb+mbj) + dtemp(i) = dtemp(i) + rabx2(i)*dprefac*Waux_mat(j + 1, nla + maa, nlb + mbj) & + + prefac*dWaux_mat(i, j + 1, nla + maa, nlb + mbj) ENDDO ENDDO DO i = 1, 3 - dsaba(ia+mai, jb+mbj, ka+mak, i) = dsaba(ia+mai, jb+mbj, ka+mak, i) & - +cg_coeff(isoa1, isoa2, isoaa)*dtemp(i) + dsaba(ia + mai, jb + mbj, ka + mak, i) = dsaba(ia + mai, jb + mbj, ka + mak, i) & + + cg_coeff(isoa1, isoa2, isoaa)*dtemp(i) ENDDO ENDDO ENDDO @@ -830,16 +830,16 @@ SUBROUTINE construct_overlap_shg_abb(la, first_sgfa, nshella, lb, first_sgfb, ns DO kshellb = 1, nshellcb lbk = lcb(kshellb) sgfcb = first_sgfcb(kshellb) - kb = sgfcb+lbk + kb = sgfcb + lbk DO jshellb = 1, nshellb lbj = lb(jshellb) sgfb = first_sgfb(jshellb) - jb = sgfb+lbj + jb = sgfb + lbj DO ishella = 1, nshella lai = la(ishella) - nla = nsoset(lai-1)+lai+1 + nla = nsoset(lai - 1) + lai + 1 sgfa = first_sgfa(ishella) - ia = sgfa+lai + ia = sgfa + lai DO mbj = -lbj, lbj, 1 DO mbk = -lbk, lbk, 1 isob1 = indso_inv(lbj, mbj) @@ -849,18 +849,18 @@ SUBROUTINE construct_overlap_shg_abb(la, first_sgfa, nshella, lb, first_sgfb, ns isobb = cg_none0_list(isob1, isob2, ilist) lbb = indso(1, isobb) mbb = indso(2, isobb) - nlb = nsoset(lbb-1)+lbb+1 + nlb = nsoset(lbb - 1) + lbb + 1 ! tsgin: because we take the transpose of auxmat (calculated for (la,lb)) tsign = 1.0_dp - IF (MODULO(lbb-lai, 2) /= 0) tsign = -1.0_dp + IF (MODULO(lbb - lai, 2) /= 0) tsign = -1.0_dp labmin = MIN(lai, lbb) - il = INT((lbj+lbk-lbb)/2) + il = INT((lbj + lbk - lbb)/2) stemp = 0.0_dp DO j = 0, labmin - prefac = swork_cont(lai+lbb-j+1, il, ishella, jshellb, kshellb) - stemp = stemp+prefac*Waux_mat(j+1, nlb+mbb, nla+mai) + prefac = swork_cont(lai + lbb - j + 1, il, ishella, jshellb, kshellb) + stemp = stemp + prefac*Waux_mat(j + 1, nlb + mbb, nla + mai) ENDDO - sabb(ia+mai, jb+mbj, kb+mbk) = sabb(ia+mai, jb+mbj, kb+mbk)+tsign*cg_coeff(isob1, isob2, isobb)*stemp + sabb(ia + mai, jb + mbj, kb + mbk) = sabb(ia + mai, jb + mbj, kb + mbk) + tsign*cg_coeff(isob1, isob2, isobb)*stemp ENDDO ENDDO ENDDO @@ -927,16 +927,16 @@ SUBROUTINE dev_overlap_shg_abb(la, first_sgfa, nshella, lb, first_sgfb, nshellb, DO kshellb = 1, nshellcb lbk = lcb(kshellb) sgfcb = first_sgfcb(kshellb) - kb = sgfcb+lbk + kb = sgfcb + lbk DO jshellb = 1, nshellb lbj = lb(jshellb) sgfb = first_sgfb(jshellb) - jb = sgfb+lbj + jb = sgfb + lbj DO ishella = 1, nshella lai = la(ishella) - nla = nsoset(lai-1)+lai+1 + nla = nsoset(lai - 1) + lai + 1 sgfa = first_sgfa(ishella) - ia = sgfa+lai + ia = sgfa + lai DO mbj = -lbj, lbj, 1 DO mbk = -lbk, lbk, 1 isob1 = indso_inv(lbj, mbj) @@ -946,24 +946,24 @@ SUBROUTINE dev_overlap_shg_abb(la, first_sgfa, nshella, lb, first_sgfb, nshellb, isobb = cg_none0_list(isob1, isob2, ilist) lbb = indso(1, isobb) mbb = indso(2, isobb) - nlb = nsoset(lbb-1)+lbb+1 + nlb = nsoset(lbb - 1) + lbb + 1 ! tsgin: because we take the transpose of auxmat (calculated for (la,lb)) tsign = 1.0_dp - IF (MODULO(lbb-lai, 2) /= 0) tsign = -1.0_dp + IF (MODULO(lbb - lai, 2) /= 0) tsign = -1.0_dp labmin = MIN(lai, lbb) - il = (lbj+lbk-lbb)/2 + il = (lbj + lbk - lbb)/2 dtemp = 0.0_dp DO j = 0, labmin - prefac = swork_cont(lai+lbb-j+1, il, ishella, jshellb, kshellb) - dprefac = swork_cont(lai+lbb-j+2, il, ishella, jshellb, kshellb) + prefac = swork_cont(lai + lbb - j + 1, il, ishella, jshellb, kshellb) + dprefac = swork_cont(lai + lbb - j + 2, il, ishella, jshellb, kshellb) DO i = 1, 3 - dtemp(i) = dtemp(i)+rabx2(i)*dprefac*Waux_mat(j+1, nlb+mbb, nla+mai) & - +prefac*dWaux_mat(i, j+1, nlb+mbb, nla+mai) + dtemp(i) = dtemp(i) + rabx2(i)*dprefac*Waux_mat(j + 1, nlb + mbb, nla + mai) & + + prefac*dWaux_mat(i, j + 1, nlb + mbb, nla + mai) ENDDO ENDDO DO i = 1, 3 - dsabb(ia+mai, jb+mbj, kb+mbk, i) = dsabb(ia+mai, jb+mbj, kb+mbk, i) & - +tsign*cg_coeff(isob1, isob2, isobb)*dtemp(i) + dsabb(ia + mai, jb + mbj, kb + mbk, i) = dsabb(ia + mai, jb + mbj, kb + mbk, i) & + + tsign*cg_coeff(isob1, isob2, isobb)*dtemp(i) ENDDO ENDDO ENDDO diff --git a/src/shg_int/generic_shg_integrals.F b/src/shg_int/generic_shg_integrals.F index 75088eef50..f6bdea2fa0 100644 --- a/src/shg_int/generic_shg_integrals.F +++ b/src/shg_int/generic_shg_integrals.F @@ -276,7 +276,7 @@ SUBROUTINE int_overlap_aba_shg(saba, dsaba, rab, oba, obb, fba, scon_obb, & REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: Waux_mat REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :, :) :: dWaux_mat - laa_max = MAXVAL(oba%lmax)+MAXVAL(fba%lmax) + laa_max = MAXVAL(oba%lmax) + MAXVAL(fba%lmax) lb_max = MAXVAL(obb%lmax) saba = 0.0_dp @@ -336,7 +336,7 @@ SUBROUTINE int_overlap_abb_shg(sabb, dsabb, rab, oba, obb, fbb, scon_oba, & REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :, :) :: dWaux_mat la_max = MAXVAL(oba%lmax) - lbb_max = MAXVAL(obb%lmax)+MAXVAL(fbb%lmax) + lbb_max = MAXVAL(obb%lmax) + MAXVAL(fbb%lmax) sabb = 0.0_dp IF (calculate_forces) dsabb = 0.0_dp @@ -379,16 +379,16 @@ SUBROUTINE precalc_angular_shg_part(la_max, lb_max, rab, Waux_mat, dWaux_mat, ca REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: Rc, Rs NULLIFY (la_max_all) - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) lmax = MAX(la_max, lb_max) ALLOCATE (la_max_all(0:lb_max)) ALLOCATE (Rc(0:lmax, -2*lmax:2*lmax), Rs(0:lmax, -2*lmax:2*lmax)) Rc = 0._dp Rs = 0._dp - mdim(1) = MIN(la_max, lb_max)+1 - mdim(2) = nsoset(la_max)+1 - mdim(3) = nsoset(lb_max)+1 + mdim(1) = MIN(la_max, lb_max) + 1 + mdim(2) = nsoset(la_max) + 1 + mdim(3) = nsoset(lb_max) + 1 ALLOCATE (Waux_mat(mdim(1), mdim(2), mdim(3))) ALLOCATE (dWaux_mat(3, mdim(1), mdim(2), mdim(3))) @@ -485,7 +485,7 @@ SUBROUTINE int_operator_ab_shg_low(s_operator_ab, vab, dvab, rab, fba, fbb, scon nsgfb_set = MAXVAL(nsgfb) ndev = 0 IF (calculate_forces) ndev = 1 - nds_max = la_max_set+lb_max_set+ndev+1 + nds_max = la_max_set + lb_max_set + ndev + 1 ALLOCATE (swork(npgfa_set, npgfb_set, nds_max)) ALLOCATE (swork_cont(nds_max, nshella_set, nshellb_set)) @@ -496,7 +496,7 @@ SUBROUTINE int_operator_ab_shg_low(s_operator_ab, vab, dvab, rab, fba, fbb, scon DO jset = 1, nsetb - nds = la_max(iset)+lb_max(jset)+ndev+1 + nds = la_max(iset) + lb_max(jset) + ndev + 1 swork(1:npgfa(iset), 1:npgfb(jset), 1:nds) = 0.0_dp CALL s_operator_ab(la_max(iset), npgfa(iset), zeta(:, iset), & lb_max(jset), npgfb(jset), zetb(:, jset), & @@ -602,7 +602,7 @@ SUBROUTINE int_overlap_ab_shg_low(sab, dsab, rab, fba, fbb, scona_shg, sconb_shg nshellb_set = MAXVAL(nshellb) ndev = 0 IF (calculate_forces) ndev = 1 - nds_max = la_max_set+lb_max_set+ndev+1 + nds_max = la_max_set + lb_max_set + ndev + 1 ALLOCATE (swork(npgfa_set, npgfb_set, nds_max)) ALLOCATE (swork_cont(nds_max, nshella_set, nshellb_set)) @@ -616,9 +616,9 @@ SUBROUTINE int_overlap_ab_shg_low(sab, dsab, rab, fba, fbb, scona_shg, sconb_shg DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE - nds = la_max(iset)+lb_max(jset)+ndev+1 + nds = la_max(iset) + lb_max(jset) + ndev + 1 swork(1:npgfa(iset), 1:npgfb(jset), 1:nds) = 0.0_dp CALL s_overlap_ab(la_max(iset), npgfa(iset), zeta(:, iset), & lb_max(jset), npgfb(jset), zetb(:, jset), & @@ -731,8 +731,8 @@ SUBROUTINE int_ra2m_ab_shg_low(vab, dvab, rab, fba, fbb, sconb_shg, scon_ra2m, m nshellb_set = MAXVAL(nshellb) ndev = 0 IF (calculate_forces) ndev = 1 - nds_max = la_max_set+lb_max_set+ndev+1 - ALLOCATE (swork(npgfa_set, npgfb_set, 1:m+1, nds_max)) + nds_max = la_max_set + lb_max_set + ndev + 1 + ALLOCATE (swork(npgfa_set, npgfb_set, 1:m + 1, nds_max)) ALLOCATE (swork_cont(nds_max, nshella_set, nshellb_set)) vab = 0.0_dp @@ -742,16 +742,16 @@ SUBROUTINE int_ra2m_ab_shg_low(vab, dvab, rab, fba, fbb, sconb_shg, scon_ra2m, m DO jset = 1, nsetb - nds = la_max(iset)+lb_max(jset)+ndev+1 - swork(1:npgfa(iset), 1:npgfb(jset), 1:m+1, 1:nds) = 0.0_dp + nds = la_max(iset) + lb_max(jset) + ndev + 1 + swork(1:npgfa(iset), 1:npgfb(jset), 1:m + 1, 1:nds) = 0.0_dp CALL s_ra2m_ab(la_max(iset), npgfa(iset), zeta(:, iset), & lb_max(jset), npgfb(jset), zetb(:, jset), & m, rab, swork, calculate_forces) CALL contract_s_ra2m_ab(npgfa(iset), nshella(iset), & - scon_ra2m(1:npgfa(iset), 1:m+1, 1:nshella(iset), iset), & + scon_ra2m(1:npgfa(iset), 1:m + 1, 1:nshella(iset), iset), & npgfb(jset), nshellb(jset), & sconb_shg(1:npgfb(jset), 1:nshellb(jset), jset), & - swork(1:npgfa(iset), 1:npgfb(jset), 1:m+1, 1:nds), & + swork(1:npgfa(iset), 1:npgfb(jset), 1:m + 1, 1:nds), & swork_cont(1:nds, 1:nshella(iset), 1:nshellb(jset)), & m, nds) CALL construct_int_shg_ab(la(:, iset), first_sgfa(:, iset), nshella(iset), & @@ -863,7 +863,7 @@ SUBROUTINE int_overlap_abb_shg_low(abbint, dabbint, rab, oba, obb, fbb, scon_oba zetcb => fbb%zet dab = SQRT(SUM(rab**2)) - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) la_max_set = MAXVAL(la_max) lb_max_set = MAXVAL(lb_max) @@ -878,27 +878,27 @@ SUBROUTINE int_overlap_abb_shg_low(abbint, dabbint, rab, oba, obb, fbb, scon_oba ndev = 0 IF (calculate_forces) ndev = 1 - lbb_max_set = lb_max_set+lcb_max_set + lbb_max_set = lb_max_set + lcb_max_set ! allocate some work storage.... - nds_max = la_max_set+lbb_max_set+ndev+1 + nds_max = la_max_set + lbb_max_set + ndev + 1 nl_set = INT((lbb_max_set)/2) - ALLOCATE (swork(npgfa_set, npgfb_set, npgfcb_set, nl_set+1, nds_max)) + ALLOCATE (swork(npgfa_set, npgfb_set, npgfcb_set, nl_set + 1, nds_max)) ALLOCATE (swork_cont(nds_max, 0:nl_set, nshella_set, nshellb_set, nshellcb_set)) DO iset = 1, nseta DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE DO kset = 1, nsetcb - IF (set_radius_a(iset)+set_radius_cb(kset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_cb(kset) < dab) CYCLE - lbb_max = lb_max(jset)+lcb_max(kset) - nds = la_max(iset)+lbb_max+ndev+1 - nl = INT((lbb_max)/2)+1 + lbb_max = lb_max(jset) + lcb_max(kset) + nds = la_max(iset) + lbb_max + ndev + 1 + nl = INT((lbb_max)/2) + 1 swork(1:npgfa(iset), 1:npgfb(jset), 1:npgfcb(kset), 1:nl, 1:nds) = 0.0_dp CALL s_overlap_abb(la_max(iset), npgfa(iset), zeta(:, iset), & lb_max(jset), npgfb(jset), zetb(:, jset), & @@ -930,11 +930,11 @@ SUBROUTINE int_overlap_abb_shg_low(abbint, dabbint, rab, oba, obb, fbb, scon_oba ENDIF ! max value of integrals in this set triple sgfa = first_sgfa(1, iset) - na = sgfa+nsgfa(iset)-1 + na = sgfa + nsgfa(iset) - 1 sgfb = first_sgfb(1, jset) - nb = sgfb+nsgfb(jset)-1 + nb = sgfb + nsgfb(jset) - 1 sgfcb = first_sgfcb(1, kset) - ncb = sgfcb+nsgfcb(kset)-1 + ncb = sgfcb + nsgfcb(kset) - 1 END DO END DO END DO @@ -1013,41 +1013,41 @@ SUBROUTINE get_abb_same_kind(abbint, dabbint, abaint, dabdaint, rab, oba, fba, & DO ishella = 1, nshella(iset) sgfa_start = first_sgfa(ishella, iset) - sgfa_end = sgfa_start+2*la(ishella, iset) + sgfa_end = sgfa_start + 2*la(ishella, iset) lai_set(sgfa_start:sgfa_end) = la(ishella, iset) ENDDO istart = first_sgfa(1, iset) - iend = istart+nsgfa_set(iset)-1 + iend = istart + nsgfa_set(iset) - 1 DO jset = 1, nseta - IF (set_radius_a(iset)+set_radius_a(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_a(jset) < dab) CYCLE DO jshella = 1, nshella(jset) sgfa_start = first_sgfa(jshella, jset) - sgfa_end = sgfa_start+2*la(jshella, jset) + sgfa_end = sgfa_start + 2*la(jshella, jset) laj_set(sgfa_start:sgfa_end) = la(jshella, jset) ENDDO jstart = first_sgfa(1, jset) - jend = jstart+nsgfa_set(jset)-1 + jend = jstart + nsgfa_set(jset) - 1 DO kset = 1, nsetca - IF (set_radius_a(iset)+set_radius_ca(kset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_ca(kset) < dab) CYCLE DO kshella = 1, nshellca(kset) sgfa_start = first_sgfca(kshella, kset) - sgfa_end = sgfa_start+2*lca(kshella, kset) + sgfa_end = sgfa_start + 2*lca(kshella, kset) lak_set(sgfa_start:sgfa_end) = lca(kshella, kset) ENDDO kstart = first_sgfca(1, kset) - kend = kstart+nsgfca_set(kset)-1 + kend = kstart + nsgfca_set(kset) - 1 DO ksgfa = kstart, kend lak = lak_set(ksgfa) DO jsgfa = jstart, jend laj = laj_set(jsgfa) DO isgfa = istart, iend lai = lai_set(isgfa) - IF (MODULO((lai+laj+lak), 2) /= 0) THEN + IF (MODULO((lai + laj + lak), 2) /= 0) THEN IF (calculate_ints) THEN abbint(isgfa, jsgfa, ksgfa) = & -abaint(jsgfa, isgfa, ksgfa) @@ -1175,7 +1175,7 @@ SUBROUTINE int_overlap_aba_shg_low(abaint, dabdaint, rab, oba, obb, fba, scon_ob zetca => fba%zet dab = SQRT(SUM(rab**2)) - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) la_max_set = MAXVAL(la_max) lb_max_set = MAXVAL(lb_max) @@ -1190,28 +1190,28 @@ SUBROUTINE int_overlap_aba_shg_low(abaint, dabdaint, rab, oba, obb, fba, scon_ob ndev = 0 IF (calculate_forces) ndev = 1 - laa_max_set = la_max_set+lca_max_set + laa_max_set = la_max_set + lca_max_set ! allocate some work storage.... - nds_max = laa_max_set+lb_max_set+ndev+1 + nds_max = laa_max_set + lb_max_set + ndev + 1 nl_set = INT((laa_max_set)/2) - ALLOCATE (swork(npgfb_set, npgfa_set, npgfca_set, nl_set+1, nds_max)) + ALLOCATE (swork(npgfb_set, npgfa_set, npgfca_set, nl_set + 1, nds_max)) ALLOCATE (swork_cont(nds_max, 0:nl_set, nshella_set, nshellb_set, nshellca_set)) DO iset = 1, nseta DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE DO kset = 1, nsetca - IF (set_radius_b(jset)+set_radius_ca(kset) < dab) CYCLE + IF (set_radius_b(jset) + set_radius_ca(kset) < dab) CYCLE !*** calculate s_baa here - laa_max = la_max(iset)+lca_max(kset) - nds = laa_max+lb_max(jset)+ndev+1 - nl = INT(laa_max/2)+1 + laa_max = la_max(iset) + lca_max(kset) + nds = laa_max + lb_max(jset) + ndev + 1 + nl = INT(laa_max/2) + 1 swork(1:npgfb(jset), 1:npgfa(iset), 1:npgfca(kset), 1:nl, 1:nds) = 0.0_dp CALL s_overlap_abb(lb_max(jset), npgfb(jset), zetb(:, jset), & la_max(iset), npgfa(iset), zeta(:, iset), & @@ -1242,11 +1242,11 @@ SUBROUTINE int_overlap_aba_shg_low(abaint, dabdaint, rab, oba, obb, fba, scon_ob ENDIF ! max value of integrals in this set triple sgfa = first_sgfa(1, iset) - na = sgfa+nsgfa(iset)-1 + na = sgfa + nsgfa(iset) - 1 sgfb = first_sgfb(1, jset) - nb = sgfb+nsgfb(jset)-1 + nb = sgfb + nsgfb(jset) - 1 sgfca = first_sgfca(1, kset) - nca = sgfca+nsgfca(kset)-1 + nca = sgfca + nsgfca(kset) - 1 END DO END DO @@ -1291,7 +1291,7 @@ SUBROUTINE lri_precalc_angular_shg_part(oba, obb, fba, fbb, rab, Waux_mat, dWaux REAL(KIND=dp) :: rab2 REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: Rc, Rs - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) !*** 1 Waux_mat of size (li_max,lj_max) for elements ! i j @@ -1305,8 +1305,8 @@ SUBROUTINE lri_precalc_angular_shg_part(oba, obb, fba, fbb, rab, Waux_mat, dWaux lca_max = MAXVAL(fba%lmax) lcb_max = MAXVAL(fbb%lmax) - laa_max = la_max+lca_max - lbb_max = lb_max+lcb_max + laa_max = la_max + lca_max + lbb_max = lb_max + lcb_max li_max = MAX(laa_max, lbb_max) lj_max = MAX(la_max, lb_max, lcb_max) lmax = li_max @@ -1315,9 +1315,9 @@ SUBROUTINE lri_precalc_angular_shg_part(oba, obb, fba, fbb, rab, Waux_mat, dWaux ALLOCATE (Rc(0:lmax, -2*lmax:2*lmax), Rs(0:lmax, -2*lmax:2*lmax)) Rc = 0._dp Rs = 0._dp - mdim(1) = li_max+lj_max+1 - mdim(2) = nsoset(li_max)+1 - mdim(3) = nsoset(lj_max)+1 + mdim(1) = li_max + lj_max + 1 + mdim(2) = nsoset(li_max) + 1 + mdim(3) = nsoset(lj_max) + 1 ALLOCATE (Waux_mat(mdim(1), mdim(2), mdim(3))) ALLOCATE (dWaux_mat(3, mdim(1), mdim(2), mdim(3))) !Waux_mat = 0._dp !.. takes time diff --git a/src/shg_int/generic_shg_integrals_init.F b/src/shg_int/generic_shg_integrals_init.F index 912c350bcd..f2dd752947 100644 --- a/src/shg_int/generic_shg_integrals_init.F +++ b/src/shg_int/generic_shg_integrals_init.F @@ -106,17 +106,17 @@ SUBROUTINE basis_norm_shg(basis, norm) DO iset = 1, basis%nset DO ishell = 1, basis%nshell(iset) l = basis%l(ishell, iset) - expa = 0.5_dp*REAL(2*l+3, dp) - ppl = fac(2*l+2)*pi**(1.5_dp)/fac(l+1) - ppl = ppl/(2._dp**REAL(2*l+1, dp)) - ppl = ppl/REAL(2*l+1, dp) + expa = 0.5_dp*REAL(2*l + 3, dp) + ppl = fac(2*l + 2)*pi**(1.5_dp)/fac(l + 1) + ppl = ppl/(2._dp**REAL(2*l + 1, dp)) + ppl = ppl/REAL(2*l + 1, dp) DO ipgf = 1, basis%npgf(iset) cci = basis%gcc(ipgf, ishell, iset) aai = basis%zet(ipgf, iset) DO jpgf = 1, basis%npgf(iset) ccj = basis%gcc(jpgf, ishell, iset) aaj = basis%zet(jpgf, iset) - norm(iset, ishell) = norm(iset, ishell)+cci*ccj*ppl/(aai+aaj)**expa + norm(iset, ishell) = norm(iset, ishell) + cci*ccj*ppl/(aai + aaj)**expa END DO END DO norm(iset, ishell) = 1.0_dp/SQRT(norm(iset, ishell)) @@ -179,7 +179,7 @@ SUBROUTINE contraction_matrix_shg_mix(orb_basis, ri_basis, orb_index, ri_index, DO iset = 1, nset_orb DO ishell = 1, nshell_orb(iset) DO ipgf = 1, npgf_orb(iset) - nf_orb = nf_orb+1 + nf_orb = nf_orb + 1 orb_index(ipgf, ishell, iset) = nf_orb END DO END DO @@ -190,7 +190,7 @@ SUBROUTINE contraction_matrix_shg_mix(orb_basis, ri_basis, orb_index, ri_index, DO iset = 1, nset_ri DO ishell = 1, nshell_ri(iset) DO ipgf = 1, npgf_ri(iset) - nf_ri = nf_ri+1 + nf_ri = nf_ri + 1 ri_index(ipgf, ishell, iset) = nf_ri END DO END DO @@ -198,29 +198,29 @@ SUBROUTINE contraction_matrix_shg_mix(orb_basis, ri_basis, orb_index, ri_index, lmax_orb = MAXVAL(orb_basis%lmax) lmax_ri = MAXVAL(ri_basis%lmax) - nl_max = INT((lmax_orb+lmax_ri)/2)+1 + nl_max = INT((lmax_orb + lmax_ri)/2) + 1 ALLOCATE (scon_mix(nl_max, nf_ri, nf_orb, nl_max)) scon_mix = 0.0_dp - ALLOCATE (shg_fac(0:nl_max-1)) + ALLOCATE (shg_fac(0:nl_max - 1)) shg_fac(0) = 1.0_dp DO iset = 1, nset_orb DO ishell = 1, nshell_orb(iset) l1 = orb_basis%l(ishell, iset) - const1 = SQRT(1.0_dp/REAL(2*l1+1, dp)) + const1 = SQRT(1.0_dp/REAL(2*l1 + 1, dp)) DO jset = 1, nset_ri DO jshell = 1, nshell_ri(jset) l2 = ri_basis%l(jshell, jset) - const2 = SQRT(1.0_dp/REAL(2*l2+1, dp)) - nl = INT((l1+l2)/2) + const2 = SQRT(1.0_dp/REAL(2*l2 + 1, dp)) + nl = INT((l1 + l2)/2) IF (l1 == 0 .OR. l2 == 0) nl = 0 DO il = 0, nl - l = l1+l2-2*il - const = const1*const2*2.0_dp*SQRT(pi*REAL(2*l+1, dp)) + l = l1 + l2 - 2*il + const = const1*const2*2.0_dp*SQRT(pi*REAL(2*l + 1, dp)) DO iil = 1, il - shg_fac(iil) = fac(l+iil-1)*ifac(l)*REAL(l, dp) & - *fac(il)/fac(il-iil)/fac(iil) + shg_fac(iil) = fac(l + iil - 1)*ifac(l)*REAL(l, dp) & + *fac(il)/fac(il - iil)/fac(iil) ENDDO DO ipgf = 1, npgf_orb(iset) forb = orb_index(ipgf, ishell, iset) @@ -230,11 +230,11 @@ SUBROUTINE contraction_matrix_shg_mix(orb_basis, ri_basis, orb_index, ri_index, fri = ri_index(jpgf, jshell, jset) gcc_ri = ri_basis%gcc(jpgf, jshell, jset) scon2 = norm_ri(jset, jshell)*gcc_ri - zet = zet_orb(ipgf, iset)+zet_ri(jpgf, jset) + zet = zet_orb(ipgf, iset) + zet_ri(jpgf, jset) cjf = 1.0_dp/((2._dp*zet)**l) prefac = const*cjf*scon1*scon2 DO iil = 0, il - scon_mix(iil+1, fri, forb, il+1) = prefac*shg_fac(iil)/zet**iil + scon_mix(iil + 1, fri, forb, il + 1) = prefac*shg_fac(iil)/zet**iil ENDDO ENDDO ENDDO @@ -278,7 +278,7 @@ SUBROUTINE contraction_matrix_shg_rx2m(basis, m, scon_shg, scon_rx2m) maxpgf = SIZE(basis%gcc, 1) maxshell = SIZE(basis%gcc, 2) - ALLOCATE (scon_rx2m(maxpgf, m+1, maxshell, nset)) + ALLOCATE (scon_rx2m(maxpgf, m + 1, maxshell, nset)) scon_rx2m = 0.0_dp ALLOCATE (shg_fac(0:m)) shg_fac(0) = 1.0_dp @@ -287,13 +287,13 @@ SUBROUTINE contraction_matrix_shg_rx2m(basis, m, scon_shg, scon_rx2m) DO ishell = 1, nshell(iset) l = basis%l(ishell, iset) DO j = 1, m - shg_fac(j) = fac(l+j-1)*ifac(l)*REAL(l, dp) & - *fac(m)/fac(m-j)/fac(j) + shg_fac(j) = fac(l + j - 1)*ifac(l)*REAL(l, dp) & + *fac(m)/fac(m - j)/fac(j) ENDDO DO ipgf = 1, npgf(iset) DO j = 0, m - scon_rx2m(ipgf, j+1, ishell, iset) = scon_shg(ipgf, ishell, iset) & - *shg_fac(j)/zet(ipgf, iset)**j + scon_rx2m(ipgf, j + 1, ishell, iset) = scon_shg(ipgf, ishell, iset) & + *shg_fac(j)/zet(ipgf, iset)**j ENDDO ENDDO ENDDO @@ -332,7 +332,7 @@ SUBROUTINE get_clebsch_gordon_coefficients(my_cg, cg_none0_list, ncg_none0, & nlist_max = 6 nsfunc1 = nsoset(maxl1) nsfunc2 = nsoset(maxl2) - maxl = maxl1+maxl2 + maxl = maxl1 + maxl2 nsfunc = nsoset(maxl) CALL clebsch_gordon_init(maxl) @@ -347,17 +347,17 @@ SUBROUTINE get_clebsch_gordon_coefficients(my_cg, cg_none0_list, ncg_none0, & ALLOCATE (rga(maxl, 2)) rga = 0.0_dp DO lc1 = 0, maxl1 - DO iso1 = nsoset(lc1-1)+1, nsoset(lc1) + DO iso1 = nsoset(lc1 - 1) + 1, nsoset(lc1) l1 = indso(1, iso1) m1 = indso(2, iso1) DO lc2 = 0, maxl2 - DO iso2 = nsoset(lc2-1)+1, nsoset(lc2) + DO iso2 = nsoset(lc2 - 1) + 1, nsoset(lc2) l2 = indso(1, iso2) m2 = indso(2, iso2) CALL clebsch_gordon(l1, m1, l2, m2, rga) - l1l2 = l1+l2 - mp = m1+m2 - mm = m1-m2 + l1l2 = l1 + l2 + mp = m1 + m2 + mm = m1 - m2 IF (m1*m2 < 0 .OR. (m1*m2 == 0 .AND. (m1 < 0 .OR. m2 < 0))) THEN mp = -ABS(mp) mm = -ABS(mm) @@ -365,21 +365,21 @@ SUBROUTINE get_clebsch_gordon_coefficients(my_cg, cg_none0_list, ncg_none0, & mp = ABS(mp) mm = ABS(mm) END IF - DO lp = MOD(l1+l2, 2), l1l2, 2 - il = lp/2+1 + DO lp = MOD(l1 + l2, 2), l1l2, 2 + il = lp/2 + 1 IF (ABS(mp) <= lp) THEN IF (mp >= 0) THEN - iso = nsoset(lp-1)+lp+1+mp + iso = nsoset(lp - 1) + lp + 1 + mp ELSE - iso = nsoset(lp-1)+lp+1-ABS(mp) + iso = nsoset(lp - 1) + lp + 1 - ABS(mp) END IF my_cg(iso1, iso2, iso) = rga(il, 1) ENDIF IF (mp /= mm .AND. ABS(mm) <= lp) THEN IF (mm >= 0) THEN - iso = nsoset(lp-1)+lp+1+mm + iso = nsoset(lp - 1) + lp + 1 + mm ELSE - iso = nsoset(lp-1)+lp+1-ABS(mm) + iso = nsoset(lp - 1) + lp + 1 - ABS(mm) END IF my_cg(iso1, iso2, iso) = rga(il, 2) ENDIF @@ -387,7 +387,7 @@ SUBROUTINE get_clebsch_gordon_coefficients(my_cg, cg_none0_list, ncg_none0, & nlist = 0 DO ilist = 1, nsfunc IF (ABS(my_cg(iso1, iso2, ilist)) > 1.E-8_dp) THEN - nlist = nlist+1 + nlist = nlist + 1 IF (nlist > nlist_max) THEN CALL reallocate(cg_none0_list, 1, nsfunc1, 1, nsfunc2, 1, nlist) nlist_max = nlist diff --git a/src/shg_int/s_contract_shg.F b/src/shg_int/s_contract_shg.F index ae6f69c6fc..294ce2aee9 100644 --- a/src/shg_int/s_contract_shg.F +++ b/src/shg_int/s_contract_shg.F @@ -68,7 +68,7 @@ SUBROUTINE s_overlap_ab(la_max, npgfa, zeta, lb_max, npgfb, zetb, rab, s, calcul REAL(KIND=dp) :: a, b, rab2, xhi, zet ! Distance of the centers a and b - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) ndev = 0 IF (calculate_forces) ndev = 1 ! Loops over all pairs of primitive Gaussian-type functions @@ -80,14 +80,14 @@ SUBROUTINE s_overlap_ab(la_max, npgfa, zeta, lb_max, npgfb, zetb, rab, s, calcul ! Calculate some prefactors a = zeta(ipgfa) b = zetb(jpgfb) - zet = a+b + zet = a + b xhi = a*b/zet ! [s|s] integral s(ipgfa, jpgfb, 1) = (pi/zet)**(1.5_dp)*EXP(-xhi*rab2) - DO ids = 2, la_max+lb_max+ndev+1 - s(ipgfa, jpgfb, ids) = -xhi*s(ipgfa, jpgfb, ids-1) + DO ids = 2, la_max + lb_max + ndev + 1 + s(ipgfa, jpgfb, ids) = -xhi*s(ipgfa, jpgfb, ids - 1) ENDDO END DO @@ -136,17 +136,17 @@ SUBROUTINE s_overlap_abb(la_max, npgfa, zeta, lb_max, npgfb, zetb, lcb_max, npgf REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: coeff_srs ! Distance of the centers a and b - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) ndev = 0 IF (calculate_forces) ndev = 1 - lbb_max = lb_max+lcb_max + lbb_max = lb_max + lcb_max nl = INT(lbb_max/2) IF (lb_max == 0 .OR. lcb_max == 0) nl = 0 - lmax = la_max+lbb_max + lmax = la_max + lbb_max - ALLOCATE (dtemp(nl+1), dsr_int(nl+1)) - ALLOCATE (coeff_srs(nl+1, nl+1, nl+1)) + ALLOCATE (dtemp(nl + 1), dsr_int(nl + 1)) + ALLOCATE (coeff_srs(nl + 1, nl + 1, nl + 1)) IF (nl > 5) CALL get_prefac_sabb(nl, coeff_srs) sqrt_pi3 = SQRT(pi**3) @@ -158,9 +158,9 @@ SUBROUTINE s_overlap_abb(la_max, npgfa, zeta, lb_max, npgfb, zetb, lcb_max, npgf !Calculate some prefactors a = zeta(ipgfa) - b = zetb(jpgfb)+zetcb(kpgfb) + b = zetb(jpgfb) + zetcb(kpgfb) - zet = a+b + zet = a + b xhi = a*b/zet exp_rab2 = EXP(-xhi*rab2) @@ -168,154 +168,154 @@ SUBROUTINE s_overlap_abb(la_max, npgfa, zeta, lb_max, npgfb, zetb, lcb_max, npgf sqrt_zet = SQRT(zet) DO il = 0, nl - nds = lmax-2*il+ndev+1 + nds = lmax - 2*il + ndev + 1 SELECT CASE (il) CASE (0) ! [s|s] integral - s(ipgfa, jpgfb, kpgfb, il+1, 1) = (pi/zet)**(1.5_dp)*exp_rab2 + s(ipgfa, jpgfb, kpgfb, il + 1, 1) = (pi/zet)**(1.5_dp)*exp_rab2 DO ids = 2, nds - n = ids-1 - s(ipgfa, jpgfb, kpgfb, il+1, ids) = (-xhi)**n*s(ipgfa, jpgfb, kpgfb, il+1, 1) + n = ids - 1 + s(ipgfa, jpgfb, kpgfb, il + 1, ids) = (-xhi)**n*s(ipgfa, jpgfb, kpgfb, il + 1, 1) ENDDO CASE (1) ![s|r^2|s] integral - sr_int = sqrt_pi3/sqrt_zet**5*(3.0_dp+2.0_dp*pfac*rab2)/2.0_dp - s(ipgfa, jpgfb, kpgfb, il+1, 1) = exp_rab2*sr_int + sr_int = sqrt_pi3/sqrt_zet**5*(3.0_dp + 2.0_dp*pfac*rab2)/2.0_dp + s(ipgfa, jpgfb, kpgfb, il + 1, 1) = exp_rab2*sr_int k = sqrt_pi3*a**2/sqrt_zet**7 DO ids = 2, nds - n = ids-1 - s(ipgfa, jpgfb, kpgfb, il+1, ids) = (-xhi)**n*exp_rab2*sr_int & - +n*(-xhi)**(n-1)*k*exp_rab2 + n = ids - 1 + s(ipgfa, jpgfb, kpgfb, il + 1, ids) = (-xhi)**n*exp_rab2*sr_int & + + n*(-xhi)**(n - 1)*k*exp_rab2 ENDDO CASE (2) ![s|r^4|s] integral prefac = sqrt_pi3/4.0_dp/sqrt_zet**7 - temp = 15.0_dp+20.0_dp*pfac*rab2+4.0_dp*(pfac*rab2)**2 + temp = 15.0_dp + 20.0_dp*pfac*rab2 + 4.0_dp*(pfac*rab2)**2 sr_int = prefac*temp - s(ipgfa, jpgfb, kpgfb, il+1, 1) = exp_rab2*sr_int + s(ipgfa, jpgfb, kpgfb, il + 1, 1) = exp_rab2*sr_int !** derivatives k = sqrt_pi3*a**4/sqrt_zet**11 - dsr_int(1) = prefac*(20.0_dp*pfac+8.0_dp*pfac**2*rab2) + dsr_int(1) = prefac*(20.0_dp*pfac + 8.0_dp*pfac**2*rab2) DO ids = 2, nds - n = ids-1 + n = ids - 1 dtemp(1) = (-xhi)**n*exp_rab2*sr_int - dtemp(2) = n*(-xhi)**(n-1)*exp_rab2*dsr_int(1) - dtemp(3) = (n**2-n)*(-xhi)**(n-2)*k*exp_rab2 - s(ipgfa, jpgfb, kpgfb, il+1, ids) = dtemp(1)+dtemp(2)+dtemp(3) + dtemp(2) = n*(-xhi)**(n - 1)*exp_rab2*dsr_int(1) + dtemp(3) = (n**2 - n)*(-xhi)**(n - 2)*k*exp_rab2 + s(ipgfa, jpgfb, kpgfb, il + 1, ids) = dtemp(1) + dtemp(2) + dtemp(3) ENDDO CASE (3) ![s|r^6|s] integral prefac = sqrt_pi3/8.0_dp/sqrt_zet**9 - temp = 105.0_dp+210.0_dp*pfac*rab2 - temp = temp+84.0_dp*(pfac*rab2)**2+8.0_dp*(pfac*rab2)**3 + temp = 105.0_dp + 210.0_dp*pfac*rab2 + temp = temp + 84.0_dp*(pfac*rab2)**2 + 8.0_dp*(pfac*rab2)**3 sr_int = prefac*temp - s(ipgfa, jpgfb, kpgfb, il+1, 1) = exp_rab2*sr_int + s(ipgfa, jpgfb, kpgfb, il + 1, 1) = exp_rab2*sr_int !** derivatives k = sqrt_pi3*a**6/sqrt_zet**15 - dsr_int(1) = prefac*(210.0_dp*pfac+168.0_dp*pfac**2*rab2 & - +24.0_dp*pfac**3*rab2**2) - dsr_int(2) = prefac*(168.0_dp*pfac**2+48.0_dp*pfac**3*rab2) + dsr_int(1) = prefac*(210.0_dp*pfac + 168.0_dp*pfac**2*rab2 & + + 24.0_dp*pfac**3*rab2**2) + dsr_int(2) = prefac*(168.0_dp*pfac**2 + 48.0_dp*pfac**3*rab2) DO ids = 2, nds - n = ids-1 + n = ids - 1 dtemp(1) = (-xhi)**n*exp_rab2*sr_int - dtemp(2) = REAL(n, dp)*(-xhi)**(n-1)*exp_rab2*dsr_int(1) - dtemp(3) = REAL(n**2-n, dp)/2.0_dp*(-xhi)**(n-2) & + dtemp(2) = REAL(n, dp)*(-xhi)**(n - 1)*exp_rab2*dsr_int(1) + dtemp(3) = REAL(n**2 - n, dp)/2.0_dp*(-xhi)**(n - 2) & *exp_rab2*dsr_int(2) - dtemp(4) = REAL(n*(n-1)*(n-2), dp)*(-xhi)**(n-3)*k*exp_rab2 - s(ipgfa, jpgfb, kpgfb, il+1, ids) = dtemp(1)+dtemp(2) & - +dtemp(3)+dtemp(4) + dtemp(4) = REAL(n*(n - 1)*(n - 2), dp)*(-xhi)**(n - 3)*k*exp_rab2 + s(ipgfa, jpgfb, kpgfb, il + 1, ids) = dtemp(1) + dtemp(2) & + + dtemp(3) + dtemp(4) ENDDO CASE (4) ![s|r^8|s] integral prefac = sqrt_pi3/16.0_dp/sqrt_zet**11 - temp = 945.0_dp+2520.0_dp*pfac*rab2+1512.0_dp*(pfac*rab2)**2 - temp = temp+288.0_dp*(pfac*rab2)**3+16.0_dp*(pfac*rab2)**4 + temp = 945.0_dp + 2520.0_dp*pfac*rab2 + 1512.0_dp*(pfac*rab2)**2 + temp = temp + 288.0_dp*(pfac*rab2)**3 + 16.0_dp*(pfac*rab2)**4 sr_int = prefac*temp - s(ipgfa, jpgfb, kpgfb, il+1, 1) = exp_rab2*sr_int + s(ipgfa, jpgfb, kpgfb, il + 1, 1) = exp_rab2*sr_int !** derivatives k = sqrt_pi3*a**8/sqrt_zet**19 - dsr_int(1) = 2520.0_dp*pfac+3024.0_dp*pfac**2*rab2 - dsr_int(1) = dsr_int(1)+864.0_dp*pfac**3*rab2**2 & - +64.0_dp*pfac**4*rab2**3 + dsr_int(1) = 2520.0_dp*pfac + 3024.0_dp*pfac**2*rab2 + dsr_int(1) = dsr_int(1) + 864.0_dp*pfac**3*rab2**2 & + + 64.0_dp*pfac**4*rab2**3 dsr_int(1) = prefac*dsr_int(1) - dsr_int(2) = 3024.0_dp*pfac**2+1728.0_dp*pfac**3*rab2 - dsr_int(2) = dsr_int(2)+192.0_dp*pfac**4*rab2**2 + dsr_int(2) = 3024.0_dp*pfac**2 + 1728.0_dp*pfac**3*rab2 + dsr_int(2) = dsr_int(2) + 192.0_dp*pfac**4*rab2**2 dsr_int(2) = prefac*dsr_int(2) - dsr_int(3) = 1728.0_dp*pfac**3+384.0_dp*pfac**4*rab2 + dsr_int(3) = 1728.0_dp*pfac**3 + 384.0_dp*pfac**4*rab2 dsr_int(3) = prefac*dsr_int(3) DO ids = 2, nds - n = ids-1 + n = ids - 1 dtemp(1) = (-xhi)**n*exp_rab2*sr_int - dtemp(2) = REAL(n, dp)*(-xhi)**(n-1)*exp_rab2*dsr_int(1) - dtemp(3) = REAL(n**2-n, dp)/2.0_dp*(-xhi)**(n-2) & + dtemp(2) = REAL(n, dp)*(-xhi)**(n - 1)*exp_rab2*dsr_int(1) + dtemp(3) = REAL(n**2 - n, dp)/2.0_dp*(-xhi)**(n - 2) & *exp_rab2*dsr_int(2) - dtemp(4) = REAL(n*(n-1)*(n-2), dp)/6.0_dp*(-xhi)**(n-3) & + dtemp(4) = REAL(n*(n - 1)*(n - 2), dp)/6.0_dp*(-xhi)**(n - 3) & *exp_rab2*dsr_int(3) - dtemp(5) = REAL(n*(n-1)*(n-2)*(n-3), dp)*(-xhi)**(n-4) & + dtemp(5) = REAL(n*(n - 1)*(n - 2)*(n - 3), dp)*(-xhi)**(n - 4) & *k*exp_rab2 - s(ipgfa, jpgfb, kpgfb, il+1, ids) = dtemp(1)+dtemp(2)+dtemp(3) & - +dtemp(4)+dtemp(5) + s(ipgfa, jpgfb, kpgfb, il + 1, ids) = dtemp(1) + dtemp(2) + dtemp(3) & + + dtemp(4) + dtemp(5) ENDDO CASE (5) ![s|r^10|s] integral prefac = sqrt_pi3/32.0_dp/sqrt_zet**13 - temp = 10395.0_dp+34650.0_dp*pfac*rab2 - temp = temp+27720.0_dp*(pfac*rab2)**2+7920.0_dp*(pfac*rab2)**3 - temp = temp+880.0_dp*(pfac*rab2)**4+32.0_dp*(pfac*rab2)**5 + temp = 10395.0_dp + 34650.0_dp*pfac*rab2 + temp = temp + 27720.0_dp*(pfac*rab2)**2 + 7920.0_dp*(pfac*rab2)**3 + temp = temp + 880.0_dp*(pfac*rab2)**4 + 32.0_dp*(pfac*rab2)**5 sr_int = prefac*temp - s(ipgfa, jpgfb, kpgfb, il+1, 1) = exp_rab2*sr_int + s(ipgfa, jpgfb, kpgfb, il + 1, 1) = exp_rab2*sr_int !** derivatives k = sqrt_pi3*a**10/sqrt_zet**23 - dsr_int(1) = 34650.0_dp*pfac+55440.0_dp*pfac**2*rab2 - dsr_int(1) = dsr_int(1)+23760.0_dp*pfac**3*rab2**2 - dsr_int(1) = dsr_int(1)+3520.0_dp*pfac**4*rab2**3 - dsr_int(1) = dsr_int(1)+160.0_dp*pfac**5*rab2**4 + dsr_int(1) = 34650.0_dp*pfac + 55440.0_dp*pfac**2*rab2 + dsr_int(1) = dsr_int(1) + 23760.0_dp*pfac**3*rab2**2 + dsr_int(1) = dsr_int(1) + 3520.0_dp*pfac**4*rab2**3 + dsr_int(1) = dsr_int(1) + 160.0_dp*pfac**5*rab2**4 dsr_int(1) = prefac*dsr_int(1) - dsr_int(2) = 55440.0_dp*pfac**2+47520.0_dp*pfac**3*rab2 - dsr_int(2) = dsr_int(2)+10560.0_dp*pfac**4*rab2**2 - dsr_int(2) = dsr_int(2)+640.0_dp*pfac**5*rab2**3 + dsr_int(2) = 55440.0_dp*pfac**2 + 47520.0_dp*pfac**3*rab2 + dsr_int(2) = dsr_int(2) + 10560.0_dp*pfac**4*rab2**2 + dsr_int(2) = dsr_int(2) + 640.0_dp*pfac**5*rab2**3 dsr_int(2) = prefac*dsr_int(2) - dsr_int(3) = 47520.0_dp*pfac**3+21120.0_dp*pfac**4*rab2 - dsr_int(3) = dsr_int(3)+1920.0_dp*pfac**5*rab2**2 + dsr_int(3) = 47520.0_dp*pfac**3 + 21120.0_dp*pfac**4*rab2 + dsr_int(3) = dsr_int(3) + 1920.0_dp*pfac**5*rab2**2 dsr_int(3) = prefac*dsr_int(3) - dsr_int(4) = 21120.0_dp*pfac**4+3840.0_dp*pfac**5*rab2 + dsr_int(4) = 21120.0_dp*pfac**4 + 3840.0_dp*pfac**5*rab2 dsr_int(4) = prefac*dsr_int(4) DO ids = 2, nds - n = ids-1 + n = ids - 1 dtemp(1) = (-xhi)**n*exp_rab2*sr_int - dtemp(2) = REAL(n, dp)*(-xhi)**(n-1)*exp_rab2*dsr_int(1) - dtemp(3) = REAL(n**2-n, dp)/2.0_dp*(-xhi)**(n-2) & + dtemp(2) = REAL(n, dp)*(-xhi)**(n - 1)*exp_rab2*dsr_int(1) + dtemp(3) = REAL(n**2 - n, dp)/2.0_dp*(-xhi)**(n - 2) & *exp_rab2*dsr_int(2) - dtemp(4) = REAL(n*(n-1)*(n-2), dp)/6.0_dp*(-xhi)**(n-3) & + dtemp(4) = REAL(n*(n - 1)*(n - 2), dp)/6.0_dp*(-xhi)**(n - 3) & *exp_rab2*dsr_int(3) - dtemp(5) = REAL(n*(n-1)*(n-2)*(n-3), dp)/24.0_dp*(-xhi)**(n-4) & + dtemp(5) = REAL(n*(n - 1)*(n - 2)*(n - 3), dp)/24.0_dp*(-xhi)**(n - 4) & *exp_rab2*dsr_int(4) - dtemp(6) = REAL(n*(n-1)*(n-2)*(n-3)*(n-4), dp)*(-xhi)**(n-5) & + dtemp(6) = REAL(n*(n - 1)*(n - 2)*(n - 3)*(n - 4), dp)*(-xhi)**(n - 5) & *k*exp_rab2 - s(ipgfa, jpgfb, kpgfb, il+1, ids) = dtemp(1)+dtemp(2)+dtemp(3) & - +dtemp(4)+dtemp(5)+dtemp(6) + s(ipgfa, jpgfb, kpgfb, il + 1, ids) = dtemp(1) + dtemp(2) + dtemp(3) & + + dtemp(4) + dtemp(5) + dtemp(6) ENDDO CASE DEFAULT !*** general formula; factor 1.5-2 slower than explicit expressions - prefac = exp_rab2/sqrt_zet**(2*il+3) + prefac = exp_rab2/sqrt_zet**(2*il + 3) sr_int = 0.0_dp DO i = 0, il - sr_int = sr_int+coeff_srs(i+1, 1, il+1)*(pfac)**i*rab2**i + sr_int = sr_int + coeff_srs(i + 1, 1, il + 1)*(pfac)**i*rab2**i ENDDO - s(ipgfa, jpgfb, kpgfb, il+1, 1) = prefac*sr_int + s(ipgfa, jpgfb, kpgfb, il + 1, 1) = prefac*sr_int DO ids = 2, nds - n = ids-1 + n = ids - 1 nfac = 1 dfsr_int = (-xhi)**n*sr_int DO j = 1, il temp = 0.0_dp DO i = j, il - temp = temp+coeff_srs(i+1, j+1, il+1)*(pfac)**i*rab2**(i-j) + temp = temp + coeff_srs(i + 1, j + 1, il + 1)*(pfac)**i*rab2**(i - j) ENDDO - nfac = nfac*(n-j+1) - dfsr_int = dfsr_int+temp*REAL(nfac, dp)/fac(j)*(-xhi)**(n-j) + nfac = nfac*(n - j + 1) + dfsr_int = dfsr_int + temp*REAL(nfac, dp)/fac(j)*(-xhi)**(n - j) ENDDO - s(ipgfa, jpgfb, kpgfb, il+1, ids) = prefac*dfsr_int + s(ipgfa, jpgfb, kpgfb, il + 1, ids) = prefac*dfsr_int ENDDO END SELECT @@ -368,12 +368,12 @@ SUBROUTINE s_ra2m_ab(la_max, npgfa, zeta, lb_max, npgfb, zetb, m, rab, s, calcul REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: coeff_srs ! Distance of the centers a and b - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) ndev = 0 IF (calculate_forces) ndev = 1 - ALLOCATE (dtemp(m+1), dsr_int(m+1)) - ALLOCATE (coeff_srs(m+1, m+1, m+1)) + ALLOCATE (dtemp(m + 1), dsr_int(m + 1)) + ALLOCATE (coeff_srs(m + 1, m + 1, m + 1)) CALL get_prefac_sabb(m, coeff_srs) !IF(m > 5) CALL get_prefac_sabb(m, coeff_srs) sqrt_pi3 = SQRT(pi**3) @@ -385,161 +385,161 @@ SUBROUTINE s_ra2m_ab(la_max, npgfa, zeta, lb_max, npgfb, zetb, m, rab, s, calcul ! Calculate some prefactors a = zeta(ipgfa) b = zetb(jpgfb) - zet = a+b + zet = a + b xhi = a*b/zet exp_rab2 = EXP(-xhi*rab2) sqrt_zet = SQRT(zet) pfac = b**2/zet - nds = la_max+lb_max+ndev+1 + nds = la_max + lb_max + ndev + 1 DO il = 0, m SELECT CASE (il) CASE (0) ! [s|s] integral - s(ipgfa, jpgfb, m-il+1, 1) = (pi/zet)**(1.5_dp)*exp_rab2 + s(ipgfa, jpgfb, m - il + 1, 1) = (pi/zet)**(1.5_dp)*exp_rab2 DO ids = 2, nds - n = ids-1 - s(ipgfa, jpgfb, m-il+1, ids) = (-xhi)**n*s(ipgfa, jpgfb, m-il+1, 1) + n = ids - 1 + s(ipgfa, jpgfb, m - il + 1, ids) = (-xhi)**n*s(ipgfa, jpgfb, m - il + 1, 1) ENDDO CASE (1) ![s|r^2|s] integral - sr_int = sqrt_pi3/sqrt_zet**5*(3.0_dp+2.0_dp*pfac*rab2)/2.0_dp - s(ipgfa, jpgfb, m-il+1, 1) = exp_rab2*sr_int + sr_int = sqrt_pi3/sqrt_zet**5*(3.0_dp + 2.0_dp*pfac*rab2)/2.0_dp + s(ipgfa, jpgfb, m - il + 1, 1) = exp_rab2*sr_int k = sqrt_pi3*b**2/sqrt_zet**7 DO ids = 2, nds - n = ids-1 - s(ipgfa, jpgfb, m-il+1, ids) = (-xhi)**n*exp_rab2*sr_int & - +n*(-xhi)**(n-1)*k*exp_rab2 + n = ids - 1 + s(ipgfa, jpgfb, m - il + 1, ids) = (-xhi)**n*exp_rab2*sr_int & + + n*(-xhi)**(n - 1)*k*exp_rab2 ENDDO CASE (2) ![s|r^4|s] integral prefac = sqrt_pi3/4.0_dp/sqrt_zet**7 - temp = 15.0_dp+20.0_dp*pfac*rab2+4.0_dp*(pfac*rab2)**2 + temp = 15.0_dp + 20.0_dp*pfac*rab2 + 4.0_dp*(pfac*rab2)**2 sr_int = prefac*temp - s(ipgfa, jpgfb, m-il+1, 1) = exp_rab2*sr_int + s(ipgfa, jpgfb, m - il + 1, 1) = exp_rab2*sr_int !** derivatives k = sqrt_pi3*b**4/sqrt_zet**11 - dsr_int(1) = prefac*(20.0_dp*pfac+8.0_dp*pfac**2*rab2) + dsr_int(1) = prefac*(20.0_dp*pfac + 8.0_dp*pfac**2*rab2) DO ids = 2, nds - n = ids-1 + n = ids - 1 dtemp(1) = (-xhi)**n*exp_rab2*sr_int - dtemp(2) = n*(-xhi)**(n-1)*exp_rab2*dsr_int(1) - dtemp(3) = (n**2-n)*(-xhi)**(n-2)*k*exp_rab2 - s(ipgfa, jpgfb, m-il+1, ids) = dtemp(1)+dtemp(2)+dtemp(3) + dtemp(2) = n*(-xhi)**(n - 1)*exp_rab2*dsr_int(1) + dtemp(3) = (n**2 - n)*(-xhi)**(n - 2)*k*exp_rab2 + s(ipgfa, jpgfb, m - il + 1, ids) = dtemp(1) + dtemp(2) + dtemp(3) ENDDO CASE (3) ![s|r^6|s] integral prefac = sqrt_pi3/8.0_dp/sqrt_zet**9 - temp = 105.0_dp+210.0_dp*pfac*rab2 - temp = temp+84.0_dp*(pfac*rab2)**2+8.0_dp*(pfac*rab2)**3 + temp = 105.0_dp + 210.0_dp*pfac*rab2 + temp = temp + 84.0_dp*(pfac*rab2)**2 + 8.0_dp*(pfac*rab2)**3 sr_int = prefac*temp - s(ipgfa, jpgfb, m-il+1, 1) = exp_rab2*sr_int + s(ipgfa, jpgfb, m - il + 1, 1) = exp_rab2*sr_int !** derivatives k = sqrt_pi3*b**6/sqrt_zet**15 - dsr_int(1) = prefac*(210.0_dp*pfac+168.0_dp*pfac**2*rab2 & - +24.0_dp*pfac**3*rab2**2) - dsr_int(2) = prefac*(168.0_dp*pfac**2+48.0_dp*pfac**3*rab2) + dsr_int(1) = prefac*(210.0_dp*pfac + 168.0_dp*pfac**2*rab2 & + + 24.0_dp*pfac**3*rab2**2) + dsr_int(2) = prefac*(168.0_dp*pfac**2 + 48.0_dp*pfac**3*rab2) DO ids = 2, nds - n = ids-1 + n = ids - 1 dtemp(1) = (-xhi)**n*exp_rab2*sr_int - dtemp(2) = REAL(n, dp)*(-xhi)**(n-1)*exp_rab2*dsr_int(1) - dtemp(3) = REAL(n**2-n, dp)/2.0_dp*(-xhi)**(n-2) & + dtemp(2) = REAL(n, dp)*(-xhi)**(n - 1)*exp_rab2*dsr_int(1) + dtemp(3) = REAL(n**2 - n, dp)/2.0_dp*(-xhi)**(n - 2) & *exp_rab2*dsr_int(2) - dtemp(4) = REAL(n*(n-1)*(n-2), dp)*(-xhi)**(n-3)*k*exp_rab2 - s(ipgfa, jpgfb, m-il+1, ids) = dtemp(1)+dtemp(2) & - +dtemp(3)+dtemp(4) + dtemp(4) = REAL(n*(n - 1)*(n - 2), dp)*(-xhi)**(n - 3)*k*exp_rab2 + s(ipgfa, jpgfb, m - il + 1, ids) = dtemp(1) + dtemp(2) & + + dtemp(3) + dtemp(4) ENDDO CASE (4) ![s|r^8|s] integral prefac = sqrt_pi3/16.0_dp/sqrt_zet**11 - temp = 945.0_dp+2520.0_dp*pfac*rab2+1512.0_dp*(pfac*rab2)**2 - temp = temp+288.0_dp*(pfac*rab2)**3+16.0_dp*(pfac*rab2)**4 + temp = 945.0_dp + 2520.0_dp*pfac*rab2 + 1512.0_dp*(pfac*rab2)**2 + temp = temp + 288.0_dp*(pfac*rab2)**3 + 16.0_dp*(pfac*rab2)**4 sr_int = prefac*temp - s(ipgfa, jpgfb, m-il+1, 1) = exp_rab2*sr_int + s(ipgfa, jpgfb, m - il + 1, 1) = exp_rab2*sr_int !** derivatives k = sqrt_pi3*b**8/sqrt_zet**19 - dsr_int(1) = 2520.0_dp*pfac+3024.0_dp*pfac**2*rab2 - dsr_int(1) = dsr_int(1)+864.0_dp*pfac**3*rab2**2 & - +64.0_dp*pfac**4*rab2**3 + dsr_int(1) = 2520.0_dp*pfac + 3024.0_dp*pfac**2*rab2 + dsr_int(1) = dsr_int(1) + 864.0_dp*pfac**3*rab2**2 & + + 64.0_dp*pfac**4*rab2**3 dsr_int(1) = prefac*dsr_int(1) - dsr_int(2) = 3024.0_dp*pfac**2+1728.0_dp*pfac**3*rab2 - dsr_int(2) = dsr_int(2)+192.0_dp*pfac**4*rab2**2 + dsr_int(2) = 3024.0_dp*pfac**2 + 1728.0_dp*pfac**3*rab2 + dsr_int(2) = dsr_int(2) + 192.0_dp*pfac**4*rab2**2 dsr_int(2) = prefac*dsr_int(2) - dsr_int(3) = 1728.0_dp*pfac**3+384.0_dp*pfac**4*rab2 + dsr_int(3) = 1728.0_dp*pfac**3 + 384.0_dp*pfac**4*rab2 dsr_int(3) = prefac*dsr_int(3) DO ids = 2, nds - n = ids-1 + n = ids - 1 dtemp(1) = (-xhi)**n*exp_rab2*sr_int - dtemp(2) = REAL(n, dp)*(-xhi)**(n-1)*exp_rab2*dsr_int(1) - dtemp(3) = REAL(n**2-n, dp)/2.0_dp*(-xhi)**(n-2) & + dtemp(2) = REAL(n, dp)*(-xhi)**(n - 1)*exp_rab2*dsr_int(1) + dtemp(3) = REAL(n**2 - n, dp)/2.0_dp*(-xhi)**(n - 2) & *exp_rab2*dsr_int(2) - dtemp(4) = REAL(n*(n-1)*(n-2), dp)/6.0_dp*(-xhi)**(n-3) & + dtemp(4) = REAL(n*(n - 1)*(n - 2), dp)/6.0_dp*(-xhi)**(n - 3) & *exp_rab2*dsr_int(3) - dtemp(5) = REAL(n*(n-1)*(n-2)*(n-3), dp)*(-xhi)**(n-4) & + dtemp(5) = REAL(n*(n - 1)*(n - 2)*(n - 3), dp)*(-xhi)**(n - 4) & *k*exp_rab2 - s(ipgfa, jpgfb, m-il+1, ids) = dtemp(1)+dtemp(2)+dtemp(3) & - +dtemp(4)+dtemp(5) + s(ipgfa, jpgfb, m - il + 1, ids) = dtemp(1) + dtemp(2) + dtemp(3) & + + dtemp(4) + dtemp(5) ENDDO CASE (5) ![s|r^10|s] integral prefac = sqrt_pi3/32.0_dp/sqrt_zet**13 - temp = 10395.0_dp+34650.0_dp*pfac*rab2 - temp = temp+27720.0_dp*(pfac*rab2)**2+7920.0_dp*(pfac*rab2)**3 - temp = temp+880.0_dp*(pfac*rab2)**4+32.0_dp*(pfac*rab2)**5 + temp = 10395.0_dp + 34650.0_dp*pfac*rab2 + temp = temp + 27720.0_dp*(pfac*rab2)**2 + 7920.0_dp*(pfac*rab2)**3 + temp = temp + 880.0_dp*(pfac*rab2)**4 + 32.0_dp*(pfac*rab2)**5 sr_int = prefac*temp - s(ipgfa, jpgfb, m-il+1, 1) = exp_rab2*sr_int + s(ipgfa, jpgfb, m - il + 1, 1) = exp_rab2*sr_int !** derivatives k = sqrt_pi3*b**10/sqrt_zet**23 - dsr_int(1) = 34650.0_dp*pfac+55440.0_dp*pfac**2*rab2 - dsr_int(1) = dsr_int(1)+23760.0_dp*pfac**3*rab2**2 - dsr_int(1) = dsr_int(1)+3520.0_dp*pfac**4*rab2**3 - dsr_int(1) = dsr_int(1)+160.0_dp*pfac**5*rab2**4 + dsr_int(1) = 34650.0_dp*pfac + 55440.0_dp*pfac**2*rab2 + dsr_int(1) = dsr_int(1) + 23760.0_dp*pfac**3*rab2**2 + dsr_int(1) = dsr_int(1) + 3520.0_dp*pfac**4*rab2**3 + dsr_int(1) = dsr_int(1) + 160.0_dp*pfac**5*rab2**4 dsr_int(1) = prefac*dsr_int(1) - dsr_int(2) = 55440.0_dp*pfac**2+47520.0_dp*pfac**3*rab2 - dsr_int(2) = dsr_int(2)+10560.0_dp*pfac**4*rab2**2 - dsr_int(2) = dsr_int(2)+640.0_dp*pfac**5*rab2**3 + dsr_int(2) = 55440.0_dp*pfac**2 + 47520.0_dp*pfac**3*rab2 + dsr_int(2) = dsr_int(2) + 10560.0_dp*pfac**4*rab2**2 + dsr_int(2) = dsr_int(2) + 640.0_dp*pfac**5*rab2**3 dsr_int(2) = prefac*dsr_int(2) - dsr_int(3) = 47520.0_dp*pfac**3+21120.0_dp*pfac**4*rab2 - dsr_int(3) = dsr_int(3)+1920.0_dp*pfac**5*rab2**2 + dsr_int(3) = 47520.0_dp*pfac**3 + 21120.0_dp*pfac**4*rab2 + dsr_int(3) = dsr_int(3) + 1920.0_dp*pfac**5*rab2**2 dsr_int(3) = prefac*dsr_int(3) - dsr_int(4) = 21120.0_dp*pfac**4+3840.0_dp*pfac**5*rab2 + dsr_int(4) = 21120.0_dp*pfac**4 + 3840.0_dp*pfac**5*rab2 dsr_int(4) = prefac*dsr_int(4) DO ids = 2, nds - n = ids-1 + n = ids - 1 dtemp(1) = (-xhi)**n*exp_rab2*sr_int - dtemp(2) = REAL(n, dp)*(-xhi)**(n-1)*exp_rab2*dsr_int(1) - dtemp(3) = REAL(n**2-n, dp)/2.0_dp*(-xhi)**(n-2) & + dtemp(2) = REAL(n, dp)*(-xhi)**(n - 1)*exp_rab2*dsr_int(1) + dtemp(3) = REAL(n**2 - n, dp)/2.0_dp*(-xhi)**(n - 2) & *exp_rab2*dsr_int(2) - dtemp(4) = REAL(n*(n-1)*(n-2), dp)/6.0_dp*(-xhi)**(n-3) & + dtemp(4) = REAL(n*(n - 1)*(n - 2), dp)/6.0_dp*(-xhi)**(n - 3) & *exp_rab2*dsr_int(3) - dtemp(5) = REAL(n*(n-1)*(n-2)*(n-3), dp)/24.0_dp*(-xhi)**(n-4) & + dtemp(5) = REAL(n*(n - 1)*(n - 2)*(n - 3), dp)/24.0_dp*(-xhi)**(n - 4) & *exp_rab2*dsr_int(4) - dtemp(6) = REAL(n*(n-1)*(n-2)*(n-3)*(n-4), dp)*(-xhi)**(n-5) & + dtemp(6) = REAL(n*(n - 1)*(n - 2)*(n - 3)*(n - 4), dp)*(-xhi)**(n - 5) & *k*exp_rab2 - s(ipgfa, jpgfb, m-il+1, ids) = dtemp(1)+dtemp(2)+dtemp(3) & - +dtemp(4)+dtemp(5)+dtemp(6) + s(ipgfa, jpgfb, m - il + 1, ids) = dtemp(1) + dtemp(2) + dtemp(3) & + + dtemp(4) + dtemp(5) + dtemp(6) ENDDO CASE DEFAULT - prefac = exp_rab2/sqrt_zet**(2*il+3) + prefac = exp_rab2/sqrt_zet**(2*il + 3) sr_int = 0.0_dp DO i = 0, il - sr_int = sr_int+coeff_srs(i+1, 1, il+1)*(pfac)**i*rab2**i + sr_int = sr_int + coeff_srs(i + 1, 1, il + 1)*(pfac)**i*rab2**i ENDDO - s(ipgfa, jpgfb, m-il+1, 1) = prefac*sr_int + s(ipgfa, jpgfb, m - il + 1, 1) = prefac*sr_int DO ids = 2, nds - n = ids-1 + n = ids - 1 nfac = 1 dfsr_int = (-xhi)**n*sr_int DO j = 1, il temp = 0.0_dp DO i = j, il - temp = temp+coeff_srs(i+1, j+1, il+1)*(pfac)**i*rab2**(i-j) + temp = temp + coeff_srs(i + 1, j + 1, il + 1)*(pfac)**i*rab2**(i - j) ENDDO - nfac = nfac*(n-j+1) - dfsr_int = dfsr_int+temp*REAL(nfac, dp)/fac(j)*(-xhi)**(n-j) + nfac = nfac*(n - j + 1) + dfsr_int = dfsr_int + temp*REAL(nfac, dp)/fac(j)*(-xhi)**(n - j) ENDDO - s(ipgfa, jpgfb, m-il+1, ids) = prefac*dfsr_int + s(ipgfa, jpgfb, m - il + 1, ids) = prefac*dfsr_int ENDDO END SELECT ENDDO @@ -569,10 +569,10 @@ SUBROUTINE get_prefac_sabb(nl, prefac) sqrt_pi3 = SQRT(pi**3) DO il = 0, nl - temp = dfac(2*il+1)*sqrt_pi3*fac(il)/2.0_dp**il + temp = dfac(2*il + 1)*sqrt_pi3*fac(il)/2.0_dp**il DO j = 0, il DO k = j, il - prefac(k+1, j+1, il+1) = temp*2.0_dp**k/dfac(2*k+1)/fac(il-k)/fac(k-j) + prefac(k + 1, j + 1, il + 1) = temp*2.0_dp**k/dfac(2*k + 1)/fac(il - k)/fac(k - j) ENDDO ENDDO ENDDO @@ -612,10 +612,10 @@ SUBROUTINE s_coulomb_ab(la_max, npgfa, zeta, lb_max, npgfb, zetb, omega, rab, v, dummy = omega ! Distance of the centers a and b - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) ndev = 0 IF (calculate_forces) ndev = 1 - nmax = la_max+lb_max+ndev+1 + nmax = la_max + lb_max + ndev + 1 ALLOCATE (f(0:nmax)) ! Loops over all pairs of primitive Gaussian-type functions DO ipgfa = 1, npgfa @@ -624,14 +624,14 @@ SUBROUTINE s_coulomb_ab(la_max, npgfa, zeta, lb_max, npgfb, zetb, omega, rab, v, ! Calculate some prefactors a = zeta(ipgfa) b = zetb(jpgfb) - zet = a+b + zet = a + b xhi = a*b/zet prefac = 2.0_dp*SQRT(pi**5)/(a*b)/SQRT(zet) T = xhi*rab2 - CALL fgamma(nmax-1, T, f) + CALL fgamma(nmax - 1, T, f) DO ids = 1, nmax - n = ids-1 + n = ids - 1 v(ipgfa, jpgfb, ids) = prefac*(-xhi)**n*f(n) ENDDO @@ -673,10 +673,10 @@ SUBROUTINE s_verf_ab(la_max, npgfa, zeta, lb_max, npgfb, zetb, omega, rab, v, ca REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: f ! Distance of the centers a and b - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) ndev = 0 IF (calculate_forces) ndev = 1 - nmax = la_max+lb_max+ndev+1 + nmax = la_max + lb_max + ndev + 1 ALLOCATE (f(0:nmax)) ! Loops over all pairs of primitive Gaussian-type functions DO ipgfa = 1, npgfa @@ -685,16 +685,16 @@ SUBROUTINE s_verf_ab(la_max, npgfa, zeta, lb_max, npgfb, zetb, omega, rab, v, ca ! Calculate some prefactors a = zeta(ipgfa) b = zetb(jpgfb) - zet = a+b + zet = a + b xhi = a*b/zet - comega = omega**2/(omega**2+xhi) + comega = omega**2/(omega**2 + xhi) prefac = 2.0_dp*SQRT(pi**5)*SQRT(comega)/(a*b)/SQRT(zet) T = xhi*rab2 Arg = comega*T - CALL fgamma(nmax-1, Arg, f) + CALL fgamma(nmax - 1, Arg, f) DO ids = 1, nmax - n = ids-1 + n = ids - 1 v(ipgfa, jpgfb, ids) = prefac*(-xhi*comega)**n*f(n) ENDDO @@ -737,10 +737,10 @@ SUBROUTINE s_verfc_ab(la_max, npgfa, zeta, lb_max, npgfb, zetb, omega, rab, v, c REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: fv, fverf ! Distance of the centers a and b - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) ndev = 0 IF (calculate_forces) ndev = 1 - nmax = la_max+lb_max+ndev+1 + nmax = la_max + lb_max + ndev + 1 ALLOCATE (fv(0:nmax), fverf(0:nmax)) ! Loops over all pairs of primitive Gaussian-type functions DO ipgfa = 1, npgfa @@ -749,18 +749,18 @@ SUBROUTINE s_verfc_ab(la_max, npgfa, zeta, lb_max, npgfb, zetb, omega, rab, v, c ! Calculate some prefactors a = zeta(ipgfa) b = zetb(jpgfb) - zet = a+b + zet = a + b xhi = a*b/zet - comega = omega**2/(omega**2+xhi) + comega = omega**2/(omega**2 + xhi) prefac = 2.0_dp*SQRT(pi**5)/(a*b)/SQRT(zet) T = xhi*rab2 comegaT = comega*T - CALL fgamma(nmax-1, T, fv) - CALL fgamma(nmax-1, comegaT, fverf) + CALL fgamma(nmax - 1, T, fv) + CALL fgamma(nmax - 1, comegaT, fverf) DO ids = 1, nmax - n = ids-1 - v(ipgfa, jpgfb, ids) = prefac*(-xhi)**n*(fv(n)-SQRT(comega)*comega**n*fverf(n)) + n = ids - 1 + v(ipgfa, jpgfb, ids) = prefac*(-xhi)**n*(fv(n) - SQRT(comega)*comega**n*fverf(n)) ENDDO END DO @@ -802,10 +802,10 @@ SUBROUTINE s_vgauss_ab(la_max, npgfa, zeta, lb_max, npgfb, zetb, omega, rab, v, REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: f ! Distance of the centers a and b - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) ndev = 0 IF (calculate_forces) ndev = 1 - nmax = la_max+lb_max+ndev+1 + nmax = la_max + lb_max + ndev + 1 ALLOCATE (f(0:nmax)) ! Loops over all pairs of primitive Gaussian-type functions v = 0.0_dp @@ -815,22 +815,22 @@ SUBROUTINE s_vgauss_ab(la_max, npgfa, zeta, lb_max, npgfb, zetb, omega, rab, v, ! Calculate some prefactors a = zeta(ipgfa) b = zetb(jpgfb) - zet = a+b + zet = a + b xhi = a*b/zet - eta = xhi/(xhi+omega) + eta = xhi/(xhi + omega) oeta = omega*eta xeta = xhi*eta T = xhi*rab2 - expT = EXP(-omega/(omega+xhi)*T) - prefac = 2.0_dp*SQRT(pi**5/zet**3)/(xhi+omega)*expT + expT = EXP(-omega/(omega + xhi)*T) + prefac = 2.0_dp*SQRT(pi**5/zet**3)/(xhi + omega)*expT etaT = eta*T - CALL fgamma(nmax-1, etaT, f) + CALL fgamma(nmax - 1, etaT, f) DO ids = 1, nmax - n = ids-1 + n = ids - 1 DO j = 0, n v(ipgfa, jpgfb, ids) = v(ipgfa, jpgfb, ids) & - +prefac*fac(n)/fac(j)/fac(n-j)*(-oeta)**(n-j)*(-xeta)**j*f(j) + + prefac*fac(n)/fac(j)/fac(n - j)*(-oeta)**(n - j)*(-xeta)**j*f(j) ENDDO ENDDO @@ -873,10 +873,10 @@ SUBROUTINE s_gauss_ab(la_max, npgfa, zeta, lb_max, npgfb, zetb, omega, rab, v, c REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: f ! Distance of the centers a and b - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) ndev = 0 IF (calculate_forces) ndev = 1 - nmax = la_max+lb_max+ndev+1 + nmax = la_max + lb_max + ndev + 1 ALLOCATE (f(0:nmax)) ! Loops over all pairs of primitive Gaussian-type functions DO ipgfa = 1, npgfa @@ -885,16 +885,16 @@ SUBROUTINE s_gauss_ab(la_max, npgfa, zeta, lb_max, npgfb, zetb, omega, rab, v, c ! Calculate some prefactors a = zeta(ipgfa) b = zetb(jpgfb) - zet = a+b + zet = a + b xhi = a*b/zet - eta = xhi/(xhi+omega) + eta = xhi/(xhi + omega) oeta = omega*eta T = xhi*rab2 - expT = EXP(-omega/(omega+xhi)*T) - prefac = pi**3/SQRT(zet**3)/SQRT((xhi+omega)**3)*expT + expT = EXP(-omega/(omega + xhi)*T) + prefac = pi**3/SQRT(zet**3)/SQRT((xhi + omega)**3)*expT DO ids = 1, nmax - n = ids-1 + n = ids - 1 v(ipgfa, jpgfb, ids) = prefac*(-oeta)**n ENDDO @@ -946,13 +946,13 @@ SUBROUTINE contract_sint_ab_clow(la, npgfa, nshella, scona_shg, lb, npgfb, nshel lai = la(ishella) DO jshellb = 1, nshellb lbj = lb(jshellb) - nds = lai+lbj+1 - ids_start = nds-MIN(lai, lbj) + nds = lai + lbj + 1 + ids_start = nds - MIN(lai, lbj) DO ipgfa = 1, npgfa DO jpgfb = 1, npgfb - DO ids = ids_start, nds+ndev + DO ids = ids_start, nds + ndev swork_cont(ids, ishella, jshellb) = swork_cont(ids, ishella, jshellb) & - +scona_shg(ipgfa, ishella) & + + scona_shg(ipgfa, ishella) & *sconb_shg(jpgfb, jshellb) & *swork(ipgfa, jpgfb, ids) ENDDO @@ -1037,7 +1037,7 @@ SUBROUTINE contract_s_ra2m_ab(npgfa, nshella, scon_ra2m, npgfb, nshellb, sconb, INTEGER :: i, my_m REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: work_pc - my_m = m+1 + my_m = m + 1 ALLOCATE (work_pc(npgfb, nds_max, nshella)) work_pc = 0.0_dp swork_cont = 0.0_dp @@ -1115,23 +1115,23 @@ SUBROUTINE contract_s_overlap_abb(la, npgfa, nshella, scona_shg, lb, npgfb, nshe lbk = lcb(kshellb) DO jshellb = 1, nshellb lbj = lb(jshellb) - nl = INT((lbj+lbk)/2) + nl = INT((lbj + lbk)/2) IF (lbj == 0 .OR. lbk == 0) nl = 0 DO ishella = 1, nshella lai = la(ishella) DO il = 0, nl - lbb = lbj+lbk-2*il - nds = lai+lbb+1 - ids_start = nds-MIN(lai, lbb) + lbb = lbj + lbk - 2*il + nds = lai + lbb + 1 + ids_start = nds - MIN(lai, lbb) DO jpgfb = 1, npgfb forb = orbb_index(jpgfb, jshellb) DO kpgfb = 1, npgfcb fri = rib_index(kpgfb, kshellb) - DO ids = ids_start, nds+ndev + DO ids = ids_start, nds + ndev DO iil = 0, il swork_cont(ids, il, ishella, jshellb, kshellb) = & swork_cont(ids, il, ishella, jshellb, kshellb) & - +sconb_mix(iil+1, fri, forb, il+1)*work_ppc(jpgfb, kpgfb, il-iil+1, ids, ishella) + + sconb_mix(iil + 1, fri, forb, il + 1)*work_ppc(jpgfb, kpgfb, il - iil + 1, ids, ishella) ENDDO ENDDO ENDDO @@ -1209,21 +1209,21 @@ SUBROUTINE contract_s_overlap_aba(la, npgfa, nshella, lb, npgfb, nshellb, sconb_ lbj = lb(jshellb) DO ishella = 1, nshella lai = la(ishella) - nl = INT((lai+lak)/2) + nl = INT((lai + lak)/2) IF (lai == 0 .OR. lak == 0) nl = 0 DO il = 0, nl - laa = lai+lak-2*il - nds = laa+lbj+1 - ids_start = nds-MIN(laa, lbj) + laa = lai + lak - 2*il + nds = laa + lbj + 1 + ids_start = nds - MIN(laa, lbj) DO kpgfa = 1, npgfca fri = ria_index(kpgfa, kshella) DO ipgfa = 1, npgfa forb = orba_index(ipgfa, ishella) - DO ids = ids_start, nds+ndev + DO ids = ids_start, nds + ndev DO iil = 0, il swork_cont(ids, il, ishella, jshellb, kshella) = & swork_cont(ids, il, ishella, jshellb, kshella) & - +scona_mix(iil+1, fri, forb, il+1)*work_ppc(ipgfa, kpgfa, il-iil+1, ids, jshellb) + + scona_mix(iil + 1, fri, forb, il + 1)*work_ppc(ipgfa, kpgfa, il - iil + 1, ids, jshellb) ENDDO ENDDO ENDDO diff --git a/src/shg_integrals_test.F b/src/shg_integrals_test.F index ee6cd8225b..49318c2361 100644 --- a/src/shg_integrals_test.F +++ b/src/shg_integrals_test.F @@ -251,19 +251,19 @@ SUBROUTINE shg_integrals_perf_acc_test(iw, shg_integrals_test_section) CALL allocate_gto_basis_set(fba) CALL read_gto_basis_set(TRIM("CA"), basis_type, fba, basis_section, irep=3) lcamax = MAXVAL(fba%lmax) - lmax = MAX(lamax+lcamax, lbmax) + lmax = MAX(lamax + lcamax, lbmax) ENDIF IF (test_overlap_abb) THEN CALL allocate_gto_basis_set(fbb) CALL read_gto_basis_set(TRIM("CB"), basis_type, fbb, basis_section, irep=3) lcbmax = MAXVAL(fbb%lmax) - lmax = MAX(lamax, lbmax+lcbmax) + lmax = MAX(lamax, lbmax + lcbmax) ENDIF IF (test_overlap_aba .AND. test_overlap_abb) THEN - lmax = MAX(MAX(lamax+lcamax, lbmax), MAX(lamax, lbmax+lcbmax)) + lmax = MAX(MAX(lamax + lcamax, lbmax), MAX(lamax, lbmax + lcbmax)) ENDIF !*** Initialize basis set information - CALL init_orbital_pointers(lmax+1) + CALL init_orbital_pointers(lmax + 1) CALL init_spherical_harmonics(lmax, output_unit=-100) oba%norm_type = 2 CALL init_orb_basis_set(oba) @@ -283,7 +283,7 @@ SUBROUTINE shg_integrals_perf_acc_test(iw, shg_integrals_test_section) CALL contraction_matrix_shg(obb, sconb_shg) !*** Create range of rab (atomic distances) to be tested - nab_xyz = CEILING(REAL(nab_min, KIND=dp)**(1.0_dp/3.0_dp)-1.0E-06) + nab_xyz = CEILING(REAL(nab_min, KIND=dp)**(1.0_dp/3.0_dp) - 1.0E-06) nab = nab_xyz**3 ALLOCATE (rab(3, nab)) @@ -291,7 +291,7 @@ SUBROUTINE shg_integrals_perf_acc_test(iw, shg_integrals_test_section) DO iab = 1, nab_xyz DO jab = 1, nab_xyz DO kab = 1, nab_xyz - count_ab = count_ab+1 + count_ab = count_ab + 1 rab(:, count_ab) = [iab*ABS(cell_par(1)), jab*ABS(cell_par(2)), kab*ABS(cell_par(3))]/nab_xyz ENDDO ENDDO @@ -718,7 +718,7 @@ SUBROUTINE test_shg_overlap_aba_integrals(oba, obb, fba, fbb, rab, nrep, scon_ob fba%set_radius(:) = 1.0E+09_dp fba%pgf_radius(:, :) = 1.0E+09_dp nfa = fba%nsgf - maxl_ri = MAXVAL(fba%lmax)+1 ! + 1 to avoid fail for l=0 + maxl_ri = MAXVAL(fba%lmax) + 1 ! + 1 to avoid fail for l=0 ALLOCATE (saba_shg(nba, nbb, nfa), dsaba_shg(nba, nbb, nfa, 3)) ALLOCATE (saba_os(nba, nbb, nfa), dsaba_os(nba, nbb, nfa, 3)) CALL contraction_matrix_shg_mix(oba, fba, oba_index, fba_index, scona_mix) @@ -727,8 +727,8 @@ SUBROUTINE test_shg_overlap_aba_integrals(oba, obb, fba, fbb, rab, nrep, scon_ob fbb%set_radius(:) = 1.0E+09_dp fbb%pgf_radius(:, :) = 1.0E+09_dp nfb = fbb%nsgf - maxl_ri = MAXVAL(fbb%lmax)+1 - lbb_max = MAXVAL(obb%lmax)+MAXVAL(fbb%lmax) + maxl_ri = MAXVAL(fbb%lmax) + 1 + lbb_max = MAXVAL(obb%lmax) + MAXVAL(fbb%lmax) ALLOCATE (sabb_shg(nba, nbb, nfb), dsabb_shg(nba, nbb, nfb, 3)) ALLOCATE (sabb_os(nba, nbb, nfb), dsabb_os(nba, nbb, nfb, 3)) CALL contraction_matrix_shg_mix(obb, fbb, obb_index, fbb_index, sconb_mix) @@ -826,7 +826,7 @@ SUBROUTINE calculate_deviation_ab(vab_shg, vab_os, dvab_shg, dvab_os, dmax, ddma ! integrals vab DO j = 1, SIZE(vab_shg, 2) DO i = 1, SIZE(vab_shg, 1) - diff = ABS(vab_shg(i, j)-vab_os(i, j)) + diff = ABS(vab_shg(i, j) - vab_os(i, j)) dmax = MAX(dmax, diff) ENDDO ENDDO @@ -835,7 +835,7 @@ SUBROUTINE calculate_deviation_ab(vab_shg, vab_os, dvab_shg, dvab_os, dmax, ddma DO k = 1, 3 DO j = 1, SIZE(dvab_shg, 2) DO i = 1, SIZE(dvab_shg, 1) - diff = ABS(dvab_shg(i, j, k)-dvab_os(i, j, k)) + diff = ABS(dvab_shg(i, j, k) - dvab_os(i, j, k)) ddmax = MAX(ddmax, diff) ENDDO ENDDO @@ -871,7 +871,7 @@ SUBROUTINE calculate_deviation_abx(vab_shg, vab_os, dvab_shg, dvab_os, dmax, ddm DO k = 1, SIZE(vab_shg, 3) DO j = 1, SIZE(vab_shg, 2) DO i = 1, SIZE(vab_shg, 1) - diff = ABS(vab_shg(i, j, k)-vab_os(i, j, k)) + diff = ABS(vab_shg(i, j, k) - vab_os(i, j, k)) dmax = MAX(dmax, diff) ENDDO ENDDO @@ -882,7 +882,7 @@ SUBROUTINE calculate_deviation_abx(vab_shg, vab_os, dvab_shg, dvab_os, dmax, ddm DO k = 1, SIZE(dvab_shg, 3) DO j = 1, SIZE(dvab_shg, 2) DO i = 1, SIZE(dvab_shg, 1) - diff = ABS(dvab_shg(i, j, k, l)-dvab_os(i, j, k, l)) + diff = ABS(dvab_shg(i, j, k, l) - dvab_os(i, j, k, l)) ddmax = MAX(ddmax, diff) ENDDO ENDDO diff --git a/src/sirius_interface.F b/src/sirius_interface.F index 68f45262c4..2df2829610 100644 --- a/src/sirius_interface.F +++ b/src/sirius_interface.F @@ -165,7 +165,7 @@ SUBROUTINE cp_sirius_create_env(pwdft_env) ! NOT the single values, but the whole section_vals_type independently ifun = 0 DO - ifun = ifun+1 + ifun = ifun + 1 xc_fun => section_vals_get_subs_vals2(xc_section, i_section=ifun) IF (.NOT. ASSOCIATED(xc_fun)) EXIT IF (TRIM(xc_fun%section%name) == "LIBXC") THEN @@ -258,12 +258,12 @@ SUBROUTINE cp_sirius_create_env(pwdft_env) rp(1:nmesh) = atom_grid%rad(1:nmesh) ELSE DO i = 1, nmesh - rp(i) = atom_grid%rad(nmesh-i+1) + rp(i) = atom_grid%rad(nmesh - i + 1) END DO END IF ! add new atom type CALL sirius_add_atom_type(sctx, string(label), & - zn=NINT(zeff+0.001d0), & + zn=NINT(zeff + 0.001d0), & mass=REAL(mass, KIND=C_DOUBLE), & spin_orbit=bool(.FALSE.)) ! @@ -281,11 +281,11 @@ SUBROUTINE cp_sirius_create_env(pwdft_env) ! we need to multiply by r so that data transfered to sirius are r \beta(r) not beta(r) ef(1:nmesh) = EXP(-0.5_dp*rp(1:nmesh)*rp(1:nmesh)/(rl*rl)) DO i = 1, gth_atompot%nl(l) - pf = rl**(l+0.5_dp*(4._dp*i-1._dp)) - j = l+2*i-1 + pf = rl**(l + 0.5_dp*(4._dp*i - 1._dp)) + j = l + 2*i - 1 pf = SQRT(2._dp)/(pf*SQRT(gamma1(j))) - beta(:) = pf*rp**(l+2*i-2)*ef - ibeta = ibeta+1 + beta(:) = pf*rp**(l + 2*i - 2)*ef + ibeta = ibeta + 1 fun(1:nmesh) = beta(1:nmesh)*rp(1:nmesh) CALL sirius_add_atom_type_radial_function(sctx, string(label), & string("beta"), fun(1), nmesh, l=l) @@ -299,8 +299,8 @@ SUBROUTINE cp_sirius_create_env(pwdft_env) dion = 0.0_dp DO l = 0, 3 IF (gth_atompot%nl(l) == 0) CYCLE - ibeta = SUM(gth_atompot%nl(0:l-1))+1 - i = ibeta+gth_atompot%nl(l)-1 + ibeta = SUM(gth_atompot%nl(0:l - 1)) + 1 + i = ibeta + gth_atompot%nl(l) - 1 dion(ibeta:i, ibeta:i) = gth_atompot%hnl(1:gth_atompot%nl(l), 1:gth_atompot%nl(l), l) END DO CALL sirius_set_atom_type_dion(sctx, string(label), nbeta, dion(1, 1)) @@ -317,7 +317,7 @@ SUBROUTINE cp_sirius_create_env(pwdft_env) fe(:) = EXP(-0.5_dp*rc(:)*rc(:)) DO j = 1, gth_atompot%nct_nlcc(i) cval = gth_atompot%cval_nlcc(j, i) - corden(:) = corden(:)+fe(:)*rc(:)**(2*j-2)*cval + corden(:) = corden(:) + fe(:)*rc(:)**(2*j - 2)*cval END DO END DO fun(1:nmesh) = corden(1:nmesh)*rp(1:nmesh) @@ -348,7 +348,7 @@ SUBROUTINE cp_sirius_create_env(pwdft_env) fun(1:nmesh) = wavefunction(1:nmesh, iwf)*rp(i) ELSE DO i = 1, nmesh - fun(i) = wavefunction(nmesh-i+1, iwf)*rp(i) + fun(i) = wavefunction(nmesh - i + 1, iwf)*rp(i) END DO END IF CALL sirius_add_atom_type_radial_function(sctx, & @@ -361,7 +361,7 @@ SUBROUTINE cp_sirius_create_env(pwdft_env) fun(1:nmesh) = fourpi*density(1:nmesh)*atom_grid%rad(1:nmesh)**2 ELSE DO i = 1, nmesh - fun(i) = fourpi*density(nmesh-i+1)*atom_grid%rad(nmesh-i+1)**2 + fun(i) = fourpi*density(nmesh - i + 1)*atom_grid%rad(nmesh - i + 1)**2 END DO END IF CALL sirius_add_atom_type_radial_function(sctx, string(label), string("ps_rho_total"), & @@ -499,7 +499,7 @@ SUBROUTINE cp_sirius_fill_in_section(sctx, section, section_name) CALL sirius_option_get_length(section_name, number_of_options) - DO elem = 0, number_of_options-1 + DO elem = 0, number_of_options - 1 option_name = CHAR(0) CALL sirius_option_get_name_and_type(section_name, elem, option_name, ctype) option_name1 = TRIM(ADJUSTL(option_name)) diff --git a/src/splines_methods.F b/src/splines_methods.F index 76006f350f..e9ccd1f6ef 100644 --- a/src/splines_methods.F +++ b/src/splines_methods.F @@ -109,33 +109,33 @@ SUBROUTINE init_spline(spl, dx, y1a, y1b) REAL(KIND=dp), POINTER :: ww(:) n = spl%n - spl%xn = spl%x1+(n-1)*dx + spl%xn = spl%x1 + (n - 1)*dx spl%h = dx spl%invh = 1.0_dp/dx spl%h26 = dx**2/6.0_dp ALLOCATE (ww(1:n)) IF (PRESENT(y1a)) THEN spl%y2(1) = -0.5_dp - ww(1) = 3.0_dp*((spl%y(2)-spl%y(1))/dx-y1a)/dx + ww(1) = 3.0_dp*((spl%y(2) - spl%y(1))/dx - y1a)/dx ELSE spl%y2(1) = 0.0_dp ww(1) = 0.0_dp END IF - DO i = 2, n-1 + DO i = 2, n - 1 s = 0.5_dp - p = 0.5_dp*spl%y2(i-1)+2.0_dp + p = 0.5_dp*spl%y2(i - 1) + 2.0_dp spl%y2(i) = -0.5_dp/p - ww(i) = (3.0_dp*(spl%y(i+1)-2.0_dp*spl%y(i)+spl%y(i-1))/(dx*dx) & - -0.5_dp*ww(i-1))/p + ww(i) = (3.0_dp*(spl%y(i + 1) - 2.0_dp*spl%y(i) + spl%y(i - 1))/(dx*dx) & + - 0.5_dp*ww(i - 1))/p END DO IF (PRESENT(y1b)) THEN - spl%y2(n) = (3.0_dp*(y1b-(spl%y(n)-spl%y(n-1))/dx)/dx- & - 0.5_dp*ww(n-1))/(0.5_dp*spl%y2(n-1)+1.0_dp) + spl%y2(n) = (3.0_dp*(y1b - (spl%y(n) - spl%y(n - 1))/dx)/dx - & + 0.5_dp*ww(n - 1))/(0.5_dp*spl%y2(n - 1) + 1.0_dp) ELSE spl%y2(n) = 0.0_dp END IF - DO i = n-1, 1, -1 - spl%y2(i) = spl%y2(i)*spl%y2(i+1)+ww(i) + DO i = n - 1, 1, -1 + spl%y2(i) = spl%y2(i)*spl%y2(i + 1) + ww(i) END DO DEALLOCATE (ww) @@ -184,24 +184,24 @@ FUNCTION potential_s(spl_p, xxi, y1, spl_f, logger) ! for the smaller point available in the spline.. ! This should happen in very few cases though.. output_unit = cp_logger_get_default_unit_nr(logger) - yy = spl_p(1)%spline_data%xn-spl_p(1)%spline_data%h + yy = spl_p(1)%spline_data%xn - spl_p(1)%spline_data%h WRITE (output_unit, FMT='(/,80("*"),/,"*",1X,"Value of r in Input =",F11.6,'// & '" not in the spline range. Using =",F11.6,T80,"*",/,80("*"))') SQRT(1.0_dp/xx), SQRT(1.0_dp/yy) xx = yy END IF - i = INT((xx-spl_p(1)%spline_data%x1)*invh+1) - a = (spl_p(1)%spline_data%x1-xx)*invh+REAL(i, kind=dp) - b = 1.0_dp-a + i = INT((xx - spl_p(1)%spline_data%x1)*invh + 1) + a = (spl_p(1)%spline_data%x1 - xx)*invh + REAL(i, kind=dp) + b = 1.0_dp - a ylo = spl_p(1)%spline_data%y(i) - yhi = spl_p(1)%spline_data%y(i+1) + yhi = spl_p(1)%spline_data%y(i + 1) y2lo = spl_p(1)%spline_data%y2(i) - y2hi = spl_p(1)%spline_data%y2(i+1) - potential_s = (a*ylo+b*yhi-((a+1.0_dp)*y2lo+(b+1.0_dp)*y2hi)*a*b*h26)*spl_f%fscale(1) - y1 = invh*((yhi-ylo)+((f13-a*a)*y2lo-(f13-b*b)*y2hi)*3.0_dp*h26) + y2hi = spl_p(1)%spline_data%y2(i + 1) + potential_s = (a*ylo + b*yhi - ((a + 1.0_dp)*y2lo + (b + 1.0_dp)*y2hi)*a*b*h26)*spl_f%fscale(1) + y1 = invh*((yhi - ylo) + ((f13 - a*a)*y2lo - (f13 - b*b)*y2hi)*3.0_dp*h26) y1 = 2.0_dp*y1*x4*spl_f%dscale(1) - potential_s = potential_s+spl_f%cutoff + potential_s = potential_s + spl_f%cutoff END FUNCTION potential_s ! ************************************************************************************************** @@ -230,17 +230,17 @@ FUNCTION spline_value(spl, xx, y1) h26 = spl%h26 invh = spl%invh - i = INT((xx-spl%x1)*invh+1) + i = INT((xx - spl%x1)*invh + 1) - a = (spl%x1-xx)*invh+REAL(i, kind=dp) - b = 1.0_dp-a + a = (spl%x1 - xx)*invh + REAL(i, kind=dp) + b = 1.0_dp - a ylo = spl%y(i) - yhi = spl%y(i+1) + yhi = spl%y(i + 1) y2lo = spl%y2(i) - y2hi = spl%y2(i+1) - spline_value = a*ylo+b*yhi-((a+1.0_dp)*y2lo+(b+1.0_dp)*y2hi)*a*b*h26 - IF (PRESENT(y1)) y1 = invh*((yhi-ylo)+ & - ((f13-a*a)*y2lo-(f13-b*b)*y2hi)*3.0_dp*h26) + y2hi = spl%y2(i + 1) + spline_value = a*ylo + b*yhi - ((a + 1.0_dp)*y2lo + (b + 1.0_dp)*y2hi)*a*b*h26 + IF (PRESENT(y1)) y1 = invh*((yhi - ylo) + & + ((f13 - a*a)*y2lo - (f13 - b*b)*y2hi)*3.0_dp*h26) END FUNCTION spline_value END MODULE splines_methods diff --git a/src/splines_types.F b/src/splines_types.F index 8ae306fc51..cf44d5d466 100644 --- a/src/splines_types.F +++ b/src/splines_types.F @@ -94,7 +94,7 @@ SUBROUTINE spline_env_release(spline_env) IF (ASSOCIATED(spline_env)) THEN CPASSERT(spline_env%ref_count > 0) - spline_env%ref_count = spline_env%ref_count-1 + spline_env%ref_count = spline_env%ref_count - 1 IF (spline_env%ref_count < 1) THEN DEALLOCATE (spline_env%spltab) DO i = 1, SIZE(spline_env%spl_pp) @@ -121,7 +121,7 @@ SUBROUTINE spline_data_release(spline_data) IF (ASSOCIATED(spline_data)) THEN CPASSERT(spline_data%ref_count > 0) - spline_data%ref_count = spline_data%ref_count-1 + spline_data%ref_count = spline_data%ref_count - 1 IF (spline_data%ref_count < 1) THEN IF (ASSOCIATED(spline_data%y)) THEN DEALLOCATE (spline_data%y) @@ -174,7 +174,7 @@ SUBROUTINE spline_data_retain(spline_data) CPASSERT(ASSOCIATED(spline_data)) CPASSERT(spline_data%ref_count > 0) - spline_data%ref_count = spline_data%ref_count+1 + spline_data%ref_count = spline_data%ref_count + 1 END SUBROUTINE spline_data_retain ! ************************************************************************************************** @@ -211,7 +211,7 @@ SUBROUTINE spline_env_retain(spline_env) CPASSERT(ASSOCIATED(spline_env)) CPASSERT(spline_env%ref_count > 0) - spline_env%ref_count = spline_env%ref_count+1 + spline_env%ref_count = spline_env%ref_count + 1 END SUBROUTINE spline_env_retain ! ************************************************************************************************** @@ -240,13 +240,13 @@ SUBROUTINE spline_env_create(spline_env, ntype, ntab_in) NULLIFY (spline_env%spl_pp) NULLIFY (spline_env%spltab) spline_env%ref_count = 1 - last_spline_env_id_nr = last_spline_env_id_nr+1 + last_spline_env_id_nr = last_spline_env_id_nr + 1 spline_env%id_nr = last_spline_env_id_nr ! Allocate the number of spline data tables (upper triangular) IF (PRESENT(ntab_in)) THEN ntab = ntab_in ELSE - ntab = (ntype*ntype+ntype)/2 + ntab = (ntype*ntype + ntype)/2 END IF ALLOCATE (spline_env%spl_pp(ntab)) @@ -344,7 +344,7 @@ SUBROUTINE spline_data_create(spline_data) ALLOCATE (spline_data) spline_data%ref_count = 1 - last_spline_data_id_nr = last_spline_data_id_nr+1 + last_spline_data_id_nr = last_spline_data_id_nr + 1 spline_data%id_nr = last_spline_data_id_nr NULLIFY (spline_data%y) NULLIFY (spline_data%y2) diff --git a/src/spme.F b/src/spme.F index 44f4624e95..50614377f4 100644 --- a/src/spme.F +++ b/src/spme.F @@ -255,12 +255,12 @@ SUBROUTINE spme_evaluate(ewald_env, ewald_pw, box, particle_set, & ! integrate box and potential CALL dg_sum_patch_force_1d(rpot, rhos, center(:, p1), fat1) IF (atprop%energy) THEN - atprop%atener(p1) = atprop%atener(p1)+0.5_dp*fat1*dvols + atprop%atener(p1) = atprop%atener(p1) + 0.5_dp*fat1*dvols END IF IF (atprop%stress) THEN - atprop%atstress(1, 1, p1) = atprop%atstress(1, 1, p1)+0.5_dp*fat1*dvols - atprop%atstress(2, 2, p1) = atprop%atstress(2, 2, p1)+0.5_dp*fat1*dvols - atprop%atstress(3, 3, p1) = atprop%atstress(3, 3, p1)+0.5_dp*fat1*dvols + atprop%atstress(1, 1, p1) = atprop%atstress(1, 1, p1) + 0.5_dp*fat1*dvols + atprop%atstress(2, 2, p1) = atprop%atstress(2, 2, p1) + 0.5_dp*fat1*dvols + atprop%atstress(3, 3, p1) = atprop%atstress(3, 3, p1) + 0.5_dp*fat1*dvols END IF END DO ! Core-shell model @@ -274,7 +274,7 @@ SUBROUTINE spme_evaluate(ewald_env, ewald_pw, box, particle_set, & CALL dg_sum_patch_force_1d(rpot, rhos, shell_center(:, p1_shell), fat1) p1 = shell_particle_set(p1_shell)%atom_index IF (atprop%energy) THEN - atprop%atener(p1) = atprop%atener(p1)+0.5_dp*fat1*dvols + atprop%atener(p1) = atprop%atener(p1) + 0.5_dp*fat1*dvols END IF END DO ipart = 0 @@ -286,7 +286,7 @@ SUBROUTINE spme_evaluate(ewald_env, ewald_pw, box, particle_set, & CALL dg_sum_patch_force_1d(rpot, rhos, core_center(:, p1_shell), fat1) p1 = core_particle_set(p1_shell)%atom_index IF (atprop%energy) THEN - atprop%atener(p1) = atprop%atener(p1)+0.5_dp*fat1*dvols + atprop%atener(p1) = atprop%atener(p1) + 0.5_dp*fat1*dvols END IF END DO END IF @@ -295,7 +295,7 @@ SUBROUTINE spme_evaluate(ewald_env, ewald_pw, box, particle_set, & ffb = 1.0_dp/fourpi DO i = 1, 3 DO ig = grid_spme%first_gne0, grid_spme%ngpts_cut_local - phi_g%cc(ig) = ffb*dphi_g(i)%pw%cc(ig)*(ffa*grid_spme%gsq(ig)+1.0_dp) + phi_g%cc(ig) = ffb*dphi_g(i)%pw%cc(ig)*(ffa*grid_spme%gsq(ig) + 1.0_dp) phi_g%cc(ig) = phi_g%cc(ig)*poisson_env%green_fft%influence_fn%cc(ig) END DO IF (grid_spme%have_g0) phi_g%cc(1) = 0.0_dp @@ -317,8 +317,8 @@ SUBROUTINE spme_evaluate(ewald_env, ewald_pw, box, particle_set, & is_core=.FALSE., is_shell=.FALSE., unit_charge=.FALSE., charges=charges) ! integrate box and potential CALL dg_sum_patch_force_1d(rpot, rhos, center(:, p1), fat1) - atprop%atstress(i, j, p1) = atprop%atstress(i, j, p1)+fat1*dvols - IF (i /= j) atprop%atstress(j, i, p1) = atprop%atstress(j, i, p1)+fat1*dvols + atprop%atstress(i, j, p1) = atprop%atstress(i, j, p1) + fat1*dvols + IF (i /= j) atprop%atstress(j, i, p1) = atprop%atstress(j, i, p1) + fat1*dvols END DO END DO @@ -340,7 +340,7 @@ SUBROUTINE spme_evaluate(ewald_env, ewald_pw, box, particle_set, & END DO ffa = (1.0_dp/fourpi)*(0.5_dp/alpha)**2 f_stress = -ffa*f_stress - pv_g = h_stress+f_stress + pv_g = h_stress + f_stress END IF !--------END OF STRESS TENSOR CALCULATION ----------- ! move derivative of potential to real space grid and @@ -373,9 +373,9 @@ SUBROUTINE spme_evaluate(ewald_env, ewald_pw, box, particle_set, & ! add boxes to real space grid (big box) CALL dg_sum_patch_force_3d(drpot, rhos, center(:, p1), fat) - fg_coulomb(1, p1) = fg_coulomb(1, p1)-fat(1)*dvols - fg_coulomb(2, p1) = fg_coulomb(2, p1)-fat(2)*dvols - fg_coulomb(3, p1) = fg_coulomb(3, p1)-fat(3)*dvols + fg_coulomb(1, p1) = fg_coulomb(1, p1) - fat(1)*dvols + fg_coulomb(2, p1) = fg_coulomb(2, p1) - fat(2)*dvols + fg_coulomb(3, p1) = fg_coulomb(3, p1) - fat(3)*dvols END DO ! Shell-Model IF (PRESENT(shell_particle_set) .AND. (PRESENT(core_particle_set))) THEN @@ -393,9 +393,9 @@ SUBROUTINE spme_evaluate(ewald_env, ewald_pw, box, particle_set, & ! add boxes to real space grid (big box) CALL dg_sum_patch_force_3d(drpot, rhos, shell_center(:, p1_shell), fat) - fgshell_coulomb(1, p1_shell) = fgshell_coulomb(1, p1_shell)-fat(1)*dvols - fgshell_coulomb(2, p1_shell) = fgshell_coulomb(2, p1_shell)-fat(2)*dvols - fgshell_coulomb(3, p1_shell) = fgshell_coulomb(3, p1_shell)-fat(3)*dvols + fgshell_coulomb(1, p1_shell) = fgshell_coulomb(1, p1_shell) - fat(1)*dvols + fgshell_coulomb(2, p1_shell) = fgshell_coulomb(2, p1_shell) - fat(2)*dvols + fgshell_coulomb(3, p1_shell) = fgshell_coulomb(3, p1_shell) - fat(3)*dvols END DO END IF @@ -413,9 +413,9 @@ SUBROUTINE spme_evaluate(ewald_env, ewald_pw, box, particle_set, & ! add boxes to real space grid (big box) CALL dg_sum_patch_force_3d(drpot, rhos, core_center(:, p1_shell), fat) - fgcore_coulomb(1, p1_shell) = fgcore_coulomb(1, p1_shell)-fat(1)*dvols - fgcore_coulomb(2, p1_shell) = fgcore_coulomb(2, p1_shell)-fat(2)*dvols - fgcore_coulomb(3, p1_shell) = fgcore_coulomb(3, p1_shell)-fat(3)*dvols + fgcore_coulomb(1, p1_shell) = fgcore_coulomb(1, p1_shell) - fat(1)*dvols + fgcore_coulomb(2, p1_shell) = fgcore_coulomb(2, p1_shell) - fat(2)*dvols + fgcore_coulomb(3, p1_shell) = fgcore_coulomb(3, p1_shell) - fat(3)*dvols END DO END IF @@ -561,7 +561,7 @@ SUBROUTINE spme_potential(ewald_env, ewald_pw, box, particle_set_a, charges_a, & is_core=.FALSE., is_shell=.FALSE., unit_charge=.TRUE.) ! integrate box and potential CALL dg_sum_patch_force_1d(rpot, rhos, center(:, p1), fat1) - potential(p1) = potential(p1)+fat1*dvols + potential(p1) = potential(p1) + fat1*dvols END DO !------------------CLEANING UP ---------------------- @@ -712,9 +712,9 @@ SUBROUTINE spme_forces(ewald_env, ewald_pw, box, particle_set_a, charges_a, & is_core=.FALSE., is_shell=.FALSE., unit_charge=.FALSE., charges=charges_b) ! add boxes to real space grid (big box) CALL dg_sum_patch_force_3d(drpot, rhos, center(:, p1), fat) - forces_b(1, p1) = forces_b(1, p1)-fat(1)*dvols - forces_b(2, p1) = forces_b(2, p1)-fat(2)*dvols - forces_b(3, p1) = forces_b(3, p1)-fat(3)*dvols + forces_b(1, p1) = forces_b(1, p1) - fat(1)*dvols + forces_b(2, p1) = forces_b(2, p1) - fat(2)*dvols + forces_b(3, p1) = forces_b(3, p1) - fat(3)*dvols END DO !------------------CLEANING UP ---------------------- IF (ASSOCIATED(drpot)) THEN @@ -872,22 +872,22 @@ SUBROUTINE spme_get_patch(rhos, n, delta, q, coeff) deltal(1, 0) = 1.0_dp deltal(2, 0) = 1.0_dp deltal(3, 0) = 1.0_dp - DO l = 1, n-1 - deltal(1, l) = deltal(1, l-1)*delta(1) - deltal(2, l) = deltal(2, l-1)*delta(2) - deltal(3, l) = deltal(3, l-1)*delta(3) + DO l = 1, n - 1 + deltal(1, l) = deltal(1, l - 1)*delta(1) + deltal(2, l) = deltal(2, l - 1)*delta(2) + deltal(3, l) = deltal(3, l - 1)*delta(3) END DO w_assign = 0.0_dp - DO j = -(n-1), n-1, 2 - DO l = 0, n-1 - w_assign(1, j) = w_assign(1, j)+coeff(j, l)*deltal(1, l) - w_assign(2, j) = w_assign(2, j)+coeff(j, l)*deltal(2, l) - w_assign(3, j) = w_assign(3, j)+coeff(j, l)*deltal(3, l) + DO j = -(n - 1), n - 1, 2 + DO l = 0, n - 1 + w_assign(1, j) = w_assign(1, j) + coeff(j, l)*deltal(1, l) + w_assign(2, j) = w_assign(2, j) + coeff(j, l)*deltal(2, l) + w_assign(3, j) = w_assign(3, j) + coeff(j, l)*deltal(3, l) END DO END DO DO i = 1, n - j = n+1-2*i + j = n + 1 - 2*i f_assign(1, i) = w_assign(1, j) f_assign(2, i) = w_assign(2, j) f_assign(3, i) = w_assign(3, j) @@ -932,7 +932,7 @@ SUBROUTINE get_delta(box, r, npts, delta, n) rmp = REAL(mp, KIND=dp) ! compute the scaled coordinate of atomi CALL real_to_scaled(s, r, box) - s = s-REAL(NINT(s), KIND=dp) + s = s - REAL(NINT(s), KIND=dp) ! find the continuous ``grid'' point grid_i(1:3) = REAL(npts(1:3), KIND=dp)*s(1:3) @@ -940,15 +940,15 @@ SUBROUTINE get_delta(box, r, npts, delta, n) ! find the closest grid point IF (MOD(n, 2) == 0) THEN - center(:) = INT(grid_i(:)+rmp)-mp - ca(:) = REAL(center(:), KIND=dp)+0.5_dp + center(:) = INT(grid_i(:) + rmp) - mp + ca(:) = REAL(center(:), KIND=dp) + 0.5_dp ELSE center(:) = NINT(grid_i(:)) ca(:) = REAL(center(:), KIND=dp) END IF ! find the distance vector - delta(:) = grid_i(:)-ca(:) + delta(:) = grid_i(:) - ca(:) END SUBROUTINE get_delta diff --git a/src/start/cp2k.F b/src/start/cp2k.F index 518920e46a..238c9062dc 100644 --- a/src/start/cp2k.F +++ b/src/start/cp2k.F @@ -98,7 +98,7 @@ PROGRAM cp2k DO i = l, 1, -1 IF (command(i:i) == "/" .OR. command(i:i) == "\") EXIT END DO - command = command(i+1:l) + command = command(i + 1:l) ! check if binary was invoked as cp2k_shell IF (command(1:10) == "cp2k_shell") THEN @@ -112,7 +112,7 @@ PROGRAM cp2k i_arg = 0 arg_loop: DO WHILE (i_arg < COMMAND_ARGUMENT_COUNT()) - i_arg = i_arg+1 + i_arg = i_arg + 1 CALL GET_COMMAND_ARGUMENT(i_arg, arg_att, status=ierr) CPASSERT(ierr == 0) SELECT CASE (arg_att) @@ -139,7 +139,7 @@ PROGRAM cp2k usage = .TRUE. run_it = .FALSE. CASE ("-i") - i_arg = i_arg+1 + i_arg = i_arg + 1 CALL GET_COMMAND_ARGUMENT(i_arg, arg_att, status=ierr) CPASSERT(ierr == 0) ! argument does not start with a - it is an filename @@ -153,7 +153,7 @@ PROGRAM cp2k EXIT arg_loop ENDIF CASE ("-o") - i_arg = i_arg+1 + i_arg = i_arg + 1 CALL GET_COMMAND_ARGUMENT(i_arg, arg_att, status=ierr) CPASSERT(ierr == 0) ! argument does not start with a - it is an filename diff --git a/src/start/cp2k_runs.F b/src/start/cp2k_runs.F index 0fa6bc94d5..bd85ebeac4 100644 --- a/src/start/cp2k_runs.F +++ b/src/start/cp2k_runs.F @@ -404,7 +404,7 @@ RECURSIVE SUBROUTINE cp2k_run(input_declaration, input_file_name, output_unit, m IF (output_unit > 0) THEN WRITE (output_unit, *) WRITE (output_unit, '(T2,"MEMORY| Estimated peak process memory [MiB]",T73,I8)') & - (m_memory_max_mpi+(1024*1024)-1)/(1024*1024) + (m_memory_max_mpi + (1024*1024) - 1)/(1024*1024) ENDIF IF (prog_name_id == do_cp2k) THEN @@ -494,8 +494,8 @@ RECURSIVE SUBROUTINE farming_run(input_declaration, root_section, para_env) IF (output_unit > 0) WRITE (output_unit, FMT="(T2,A)") "FARMING| using a master-slave setup" ALLOCATE (master_slave_partition(0:1)) - master_slave_partition = (/1, para_env%num_pe-1/) - ALLOCATE (group_distribution(0:para_env%num_pe-1)) + master_slave_partition = (/1, para_env%num_pe - 1/) + ALLOCATE (group_distribution(0:para_env%num_pe - 1)) CALL mp_comm_split(para_env%group, slave_group, ngroups, group_distribution, & n_subgroups=2, group_partition=master_slave_partition) @@ -509,10 +509,10 @@ RECURSIVE SUBROUTINE farming_run(input_declaration, root_section, para_env) ! on the master node, num_slaves corresponds to the size of the master group ! due to the mp_environ call. CPASSERT(num_slaves == 1) - num_slaves = para_env%num_pe-1 + num_slaves = para_env%num_pe - 1 slave_rank = -1 ENDIF - CPASSERT(num_slaves == para_env%num_pe-1) + CPASSERT(num_slaves == para_env%num_pe - 1) ELSE ! all processes are slaves IF (output_unit > 0) WRITE (output_unit, FMT="(T2,A)") "FARMING| using a slave-only setup" @@ -522,19 +522,19 @@ RECURSIVE SUBROUTINE farming_run(input_declaration, root_section, para_env) IF (output_unit > 0) WRITE (output_unit, FMT="(T2,A,I0)") "FARMING| number of slaves ", num_slaves ! keep track of which para_env rank is which slave/master - ALLOCATE (slave_distribution(0:para_env%num_pe-1)) + ALLOCATE (slave_distribution(0:para_env%num_pe - 1)) slave_distribution = 0 slave_distribution(para_env%mepos) = slave_rank CALL mp_sum(slave_distribution, para_env%group) ! we do have a primus inter pares primus_slave = 0 - DO i = 1, para_env%num_pe-1 + DO i = 1, para_env%num_pe - 1 IF (slave_distribution(i) == 0) primus_slave = i ENDDO ! split the current communicator for the slaves ! in a new_group, new_size and new_rank according to the number of groups required according to the input - ALLOCATE (group_distribution(0:num_slaves-1)) + ALLOCATE (group_distribution(0:num_slaves - 1)) group_distribution = -1 IF (slave) THEN IF (farming_env%group_size_wish_set) THEN @@ -576,7 +576,7 @@ RECURSIVE SUBROUTINE farming_run(input_declaration, root_section, para_env) IF (output_unit > 0) THEN WRITE (output_unit, FMT="(T2,A,T71,I10)") "FARMING| Number of created MPI (slave) groups:", ngroups WRITE (output_unit, FMT="(T2,A)", ADVANCE="NO") "FARMING| MPI (slave) process to group correspondence:" - DO i = 0, num_slaves-1 + DO i = 0, num_slaves - 1 IF (MODULO(i, 4) == 0) WRITE (output_unit, *) WRITE (output_unit, FMT='(A3,I6,A3,I6,A1)', ADVANCE="NO") & " (", i, " : ", group_distribution(i), ")" @@ -589,11 +589,11 @@ RECURSIVE SUBROUTINE farming_run(input_declaration, root_section, para_env) ! and determine the future restart point IF (farming_env%cycle) THEN n_jobs_to_run = farming_env%max_steps*ngroups - i_job_to_restart = MODULO(farming_env%restart_n+n_jobs_to_run-1, farming_env%njobs)+1 + i_job_to_restart = MODULO(farming_env%restart_n + n_jobs_to_run - 1, farming_env%njobs) + 1 ELSE n_jobs_to_run = MIN(farming_env%njobs, farming_env%max_steps*ngroups) - n_jobs_to_run = MIN(n_jobs_to_run, farming_env%njobs-farming_env%restart_n+1) - i_job_to_restart = n_jobs_to_run+farming_env%restart_n + n_jobs_to_run = MIN(n_jobs_to_run, farming_env%njobs - farming_env%restart_n + 1) + i_job_to_restart = n_jobs_to_run + farming_env%restart_n ENDIF ! and write the restart now, that's the point where the next job starts, even if this one is running @@ -606,8 +606,8 @@ RECURSIVE SUBROUTINE farming_run(input_declaration, root_section, para_env) ! this is the job range to be executed. ijob_start = farming_env%restart_n - ijob_end = ijob_start+n_jobs_to_run-1 - IF (output_unit > 0 .AND. ijob_end-ijob_start < 0) THEN + ijob_end = ijob_start + n_jobs_to_run - 1 + IF (output_unit > 0 .AND. ijob_end - ijob_start < 0) THEN WRITE (output_unit, FMT="(T2,A)") "FARMING| --- WARNING --- NO JOBS NEED EXECUTION ? " WRITE (output_unit, FMT="(T2,A)") "FARMING| is the cycle keyword required ?" WRITE (output_unit, FMT="(T2,A)") "FARMING| or is a stray RESTART file present ?" @@ -645,7 +645,7 @@ RECURSIVE SUBROUTINE farming_run(input_declaration, root_section, para_env) t1 = m_walltime() DO t2 = m_walltime() - IF (t2-t1 > farming_env%wait_time) EXIT + IF (t2 - t1 > farming_env%wait_time) EXIT ENDDO CASE (do_nothing) EXIT @@ -654,9 +654,9 @@ RECURSIVE SUBROUTINE farming_run(input_declaration, root_section, para_env) END SELECT ENDDO ELSE ! master - ALLOCATE (slave_status(0:ngroups-1)) + ALLOCATE (slave_status(0:ngroups - 1)) slave_status = slave_status_wait - ijob_current = ijob_start-1 + ijob_current = ijob_start - 1 DO IF (ALL(slave_status == slave_status_done)) EXIT @@ -715,21 +715,21 @@ RECURSIVE SUBROUTINE farming_run(input_declaration, root_section, para_env) ! the i-th job in the input is always executed by the MODULO(i-1,ngroups)-th group ! (needed for cyclic runs, we don't want two groups working on the same job) IF (output_unit > 0) THEN - IF (ijob_end-ijob_start >= 0) THEN + IF (ijob_end - ijob_start >= 0) THEN WRITE (output_unit, FMT="(T2,A)") "FARMING| List of jobs : " DO ijob = ijob_start, ijob_end - i = MODULO(ijob-1, farming_env%njobs)+1 + i = MODULO(ijob - 1, farming_env%njobs) + 1 WRITE (output_unit, FMT=*) "Job: ", i, " Dir: ", TRIM(farming_env%Job(i)%cwd), " Input: ", & - TRIM(farming_env%Job(i)%input), " MPI group:", MODULO(i-1, ngroups) + TRIM(farming_env%Job(i)%input), " MPI group:", MODULO(i - 1, ngroups) ENDDO ENDIF CALL m_flush(output_unit) ENDIF DO ijob = ijob_start, ijob_end - i = MODULO(ijob-1, farming_env%njobs)+1 + i = MODULO(ijob - 1, farming_env%njobs) + 1 ! this farms out the jobs - IF (MODULO(i-1, ngroups) == group_distribution(slave_rank)) THEN + IF (MODULO(i - 1, ngroups) == group_distribution(slave_rank)) THEN IF (output_unit > 0) THEN WRITE (output_unit, FMT="(T2,A,I5.5,A)", ADVANCE="NO") " Running Job ", i, & " in "//TRIM(farming_env%Job(i)%cwd)//"." @@ -749,16 +749,16 @@ RECURSIVE SUBROUTINE farming_run(input_declaration, root_section, para_env) t1 = m_walltime() CALL mp_sync(para_env%group) t2 = m_walltime() - ALLOCATE (waittime(0:para_env%num_pe-1)) + ALLOCATE (waittime(0:para_env%num_pe - 1)) waittime = 0.0_dp - waittime(para_env%mepos) = t2-t1 + waittime(para_env%mepos) = t2 - t1 CALL mp_sum(waittime, para_env%group) IF (output_unit > 0) THEN WRITE (output_unit, '(T2,A)') "Process idle times [s] at the end of the run" - DO i = 0, para_env%num_pe-1 + DO i = 0, para_env%num_pe - 1 WRITE (output_unit, FMT='(A2,I6,A3,F8.3,A1)', ADVANCE="NO") & " (", i, " : ", waittime(i), ")" - IF (MOD(i+1, 4) == 0) WRITE (output_unit, '(A)') "" + IF (MOD(i + 1, 4) == 0) WRITE (output_unit, '(A)') "" ENDDO CALL m_flush(output_unit) ENDIF @@ -875,12 +875,12 @@ SUBROUTINE write_xml_file() WRITE (UNIT=unit_number, FMT="(A)") & " 0) - ie = INDEX(html_entity_table(i), ";")-1 + ie = INDEX(html_entity_table(i), ";") - 1 CPASSERT(ie >= is) WRITE (UNIT=unit_number, FMT="(A)") & - "" + "" END DO WRITE (UNIT=unit_number, FMT="(A)") & "]>" diff --git a/src/start/cp2k_shell.F b/src/start/cp2k_shell.F index 60212fc8fd..b304fc6f42 100644 --- a/src/start/cp2k_shell.F +++ b/src/start/cp2k_shell.F @@ -590,7 +590,7 @@ SUBROUTINE set_pos_command(shell, arg1) IF (.NOT. my_assert(ierr == 0, 'set_pos error', shell)) RETURN max_change = 0.0_dp DO i = 1, SIZE(pos) - max_change = MAX(max_change, ABS(pos(i)-old_pos(i))) + max_change = MAX(max_change, ABS(pos(i) - old_pos(i))) END DO DEALLOCATE (pos, old_pos) IF (shell%iw > 0) THEN diff --git a/src/start/libcp2k.F b/src/start/libcp2k.F index 828157b5b6..842fd9518d 100644 --- a/src/start/libcp2k.F +++ b/src/start/libcp2k.F @@ -66,13 +66,13 @@ SUBROUTINE cp2k_get_version(version_str, str_length) BIND(C) INTEGER :: i, n n = LEN_TRIM(cp2k_version) - CPASSERT(str_length >= n+1) + CPASSERT(str_length >= n + 1) ! copy string DO i = 1, n version_str(i) = cp2k_version(i:i) ENDDO - version_str(n+1) = C_NULL_CHAR + version_str(n + 1) = C_NULL_CHAR END SUBROUTINE cp2k_get_version ! ************************************************************************************************** @@ -429,7 +429,7 @@ INTEGER(C_INT) FUNCTION cp2k_active_space_get_mo_count(f_env_id) RESULT(nmo) BIN CALL f_env_add_defaults(f_env_id, f_env) - try:BLOCK + try: BLOCK CALL get_qs_env(f_env%force_env%qs_env, active_space=active_space_env) IF (.NOT. ASSOCIATED(active_space_env)) & @@ -469,7 +469,7 @@ INTEGER(C_LONG) FUNCTION cp2k_active_space_get_fock_sub(f_env_id, buf, buf_len) CALL f_env_add_defaults(f_env_id, f_env) - try:BLOCK + try: BLOCK CALL get_qs_env(f_env%force_env%qs_env, active_space=active_space_env) IF (.NOT. ASSOCIATED(active_space_env)) & @@ -480,11 +480,11 @@ INTEGER(C_LONG) FUNCTION cp2k_active_space_get_fock_sub(f_env_id, buf, buf_len) IF (buf_len < norb*norb) & EXIT try - DO i = 0, norb-1 - DO j = 0, norb-1 - CALL cp_fm_get_element(active_space_env%fock_sub(1)%matrix, i+1, j+1, mval) - buf(norb*i+j) = mval - buf(norb*j+i) = mval + DO i = 0, norb - 1 + DO j = 0, norb - 1 + CALL cp_fm_get_element(active_space_env%fock_sub(1)%matrix, i + 1, j + 1, mval) + buf(norb*i + j) = mval + buf(norb*j + i) = mval END DO END DO @@ -516,7 +516,7 @@ INTEGER(C_LONG) FUNCTION cp2k_active_space_get_eri_nze_count(f_env_id) RESULT(nz CALL f_env_add_defaults(f_env_id, f_env) - try:BLOCK + try: BLOCK CALL get_qs_env(f_env%force_env%qs_env, active_space=active_space_env) IF (.NOT. ASSOCIATED(active_space_env)) & @@ -560,7 +560,7 @@ INTEGER(C_LONG) FUNCTION cp2k_active_space_get_eri(f_env_id, & CALL f_env_add_defaults(f_env_id, f_env) - try:BLOCK + try: BLOCK CALL get_qs_env(f_env%force_env%qs_env, active_space=active_space_env) IF (.NOT. ASSOCIATED(active_space_env)) & @@ -617,13 +617,13 @@ LOGICAL FUNCTION eri2array_func(this, i, j, k, l, val) RESULT(cont) INTEGER, INTENT(in) :: i, j, k, l REAL(KIND=dp), INTENT(in) :: val - this%coords(4*(this%idx-1)+1) = i - this%coords(4*(this%idx-1)+2) = j - this%coords(4*(this%idx-1)+3) = k - this%coords(4*(this%idx-1)+4) = l + this%coords(4*(this%idx - 1) + 1) = i + this%coords(4*(this%idx - 1) + 2) = j + this%coords(4*(this%idx - 1) + 3) = k + this%coords(4*(this%idx - 1) + 4) = l this%values(this%idx) = val - this%idx = this%idx+1 + this%idx = this%idx + 1 cont = .TRUE. END FUNCTION eri2array_func diff --git a/src/statistical_methods.F b/src/statistical_methods.F index 6621756c23..7777c81012 100644 --- a/src/statistical_methods.F +++ b/src/statistical_methods.F @@ -81,7 +81,7 @@ SUBROUTINE sw_test(ix, n, w, pw) IF (MOD(n, 2) == 0) THEN n2 = n/2 ELSE - n2 = (n-1)/2 + n2 = (n - 1)/2 END IF ALLOCATE (x(n)) ALLOCATE (itmp(n)) @@ -89,7 +89,7 @@ SUBROUTINE sw_test(ix, n, w, pw) x(:) = ix CALL sort(x, n, itmp) ! Check for zero range - range = x(n)-x(1) + range = x(n) - x(1) IF (range < small) failure = .TRUE. IF (failure .AND. (output_unit > 0)) THEN WRITE (output_unit, '(A)') "Shapiro Wilk test: two data points are numerically identical." @@ -102,26 +102,26 @@ SUBROUTINE sw_test(ix, n, w, pw) IF (n == 3) THEN a(1) = sqrth ELSE - an25 = an+qtr + an25 = an + qtr summ2 = zero DO i = 1, n2 - CALL ppnd7((i-th)/an25, a(i)) - summ2 = summ2+a(i)**2 + CALL ppnd7((i - th)/an25, a(i)) + summ2 = summ2 + a(i)**2 END DO summ2 = summ2*two ssumm2 = SQRT(summ2) rsn = one/SQRT(an) - a1 = poly(c1, 6, rsn)-a(1)/ssumm2 + a1 = poly(c1, 6, rsn) - a(1)/ssumm2 ! Normalize coefficients IF (n > 5) THEN i1 = 3 - a2 = -a(2)/ssumm2+poly(c2, 6, rsn) - fac = SQRT((summ2-two*a(1)**2-two*a(2)**2)/(one-two*a1**2-two*a2**2)) + a2 = -a(2)/ssumm2 + poly(c2, 6, rsn) + fac = SQRT((summ2 - two*a(1)**2 - two*a(2)**2)/(one - two*a1**2 - two*a2**2)) a(1) = a1 a(2) = a2 ELSE i1 = 2 - fac = SQRT((summ2-two*a(1)**2)/(one-two*a1**2)) + fac = SQRT((summ2 - two*a(1)**2)/(one - two*a1**2)) a(1) = a1 END IF DO i = i1, n2 @@ -132,13 +132,13 @@ SUBROUTINE sw_test(ix, n, w, pw) xx = x(1)/range sx = xx sa = -a(1) - j = n-1 + j = n - 1 DO i = 2, n xi = x(i)/range - sx = sx+xi - IF (i /= j) sa = sa+SIGN(1, i-j)*a(MIN(i, j)) + sx = sx + xi + IF (i /= j) sa = sa + SIGN(1, i - j)*a(MIN(i, j)) xx = xi - j = j-1 + j = j - 1 END DO ! Calculate W statistic as squared correlation ! between data and coefficients @@ -150,24 +150,24 @@ SUBROUTINE sw_test(ix, n, w, pw) j = n DO i = 1, n IF (i /= j) THEN - asa = SIGN(1, i-j)*a(MIN(i, j))-sa + asa = SIGN(1, i - j)*a(MIN(i, j)) - sa ELSE asa = -sa END IF - xsx = x(i)/range-sx - ssa = ssa+asa*asa - ssx = ssx+xsx*xsx - sax = sax+asa*xsx - j = j-1 + xsx = x(i)/range - sx + ssa = ssa + asa*asa + ssx = ssx + xsx*xsx + sax = sax + asa*xsx + j = j - 1 END DO ! W1 equals (1-W) calculated to avoid excessive rounding error ! for W very near 1 (a potential problem in very large samples) ssassx = SQRT(ssa*ssx) - w1 = (ssassx-sax)*(ssassx+sax)/(ssa*ssx) - w = one-w1 + w1 = (ssassx - sax)*(ssassx + sax)/(ssa*ssx) + w = one - w1 ! Calculate significance level for W (exact for N=3) IF (n == 3) THEN - pw = pi6*(ASIN(SQRT(w))-stqr) + pw = pi6*(ASIN(SQRT(w)) - stqr) ELSE y = LOG(w1) xx = LOG(an) @@ -178,15 +178,15 @@ SUBROUTINE sw_test(ix, n, w, pw) IF (y >= gamma) THEN pw = small ELSE - y = -LOG(gamma-y) + y = -LOG(gamma - y) m = poly(c3, 4, an) s = EXP(poly(c4, 4, an)) - pw = alnorm((y-m)/s, .TRUE.) + pw = alnorm((y - m)/s, .TRUE.) END IF ELSE m = poly(c5, 4, xx) s = EXP(poly(c6, 3, xx)) - pw = alnorm((y-m)/s, .TRUE.) + pw = alnorm((y - m)/s, .TRUE.) END IF END IF DEALLOCATE (x) @@ -221,17 +221,17 @@ SUBROUTINE ppnd7(p, normal_dev) REAL(KIND=dp) :: q, r - q = p-half + q = p - half IF (ABS(q) <= split1) THEN - r = const1-q*q - normal_dev = q*(((a3*r+a2)*r+a1)*r+a0)/ & - (((b3*r+b2)*r+b1)*r+one) + r = const1 - q*q + normal_dev = q*(((a3*r + a2)*r + a1)*r + a0)/ & + (((b3*r + b2)*r + b1)*r + one) RETURN ELSE IF (q < zero) THEN r = p ELSE - r = one-p + r = one - p END IF IF (r <= zero) THEN normal_dev = zero @@ -239,11 +239,11 @@ SUBROUTINE ppnd7(p, normal_dev) END IF r = SQRT(-LOG(r)) IF (r <= split2) THEN - r = r-const2 - normal_dev = (((c3*r+c2)*r+c1)*r+c0)/((d2*r+d1)*r+one) + r = r - const2 + normal_dev = (((c3*r + c2)*r + c1)*r + c0)/((d2*r + d1)*r + one) ELSE - r = r-split2 - normal_dev = (((e3*r+e2)*r+e1)*r+e0)/((f2*r+f1)*r+one) + r = r - split2 + normal_dev = (((e3*r + e2)*r + e1)*r + e0)/((f2*r + f1)*r + one) END IF IF (q < zero) normal_dev = -normal_dev RETURN @@ -286,16 +286,16 @@ FUNCTION alnorm(x, upper) RESULT(fn_val) ENDIF IF (.NOT. (z <= ltone .OR. up .AND. z <= utzero)) THEN fn_val = zero - IF (.NOT. up) fn_val = one-fn_val + IF (.NOT. up) fn_val = one - fn_val RETURN ENDIF y = half*z*z IF (z <= con) THEN - fn_val = r*EXP(-y)/(z+c1+d1/(z+c2+d2/(z+c3+d3/(z+c4+d4/(z+c5+d5/(z+c6)))))) + fn_val = r*EXP(-y)/(z + c1 + d1/(z + c2 + d2/(z + c3 + d3/(z + c4 + d4/(z + c5 + d5/(z + c6)))))) ELSE - fn_val = half-z*(p-q*y/(y+a1+b1/(y+a2+b2/(y+a3)))) + fn_val = half - z*(p - q*y/(y + a1 + b1/(y + a2 + b2/(y + a3)))) ENDIF - IF (.NOT. up) fn_val = one-fn_val + IF (.NOT. up) fn_val = one - fn_val END FUNCTION alnorm @@ -325,16 +325,16 @@ FUNCTION poly(c, nord, x) RESULT(fn_val) IF (nord == 1) RETURN p = x*c(nord) IF (nord == 2) THEN - fn_val = fn_val+p + fn_val = fn_val + p RETURN ENDIF - n2 = nord-2 - j = n2+1 + n2 = nord - 2 + j = n2 + 1 DO i = 1, n2 - p = (p+c(j))*x - j = j-1 + p = (p + c(j))*x + j = j - 1 END DO - fn_val = fn_val+p + fn_val = fn_val + p END FUNCTION poly ! ************************************************************************************************** @@ -362,21 +362,21 @@ SUBROUTINE k_test(xdata, istart, n, tau, z, prob) INTEGER :: is, j, k, nt REAL(KIND=dp) :: a1, var - nt = n-istart+1 + nt = n - istart + 1 IF (nt .GE. min_sample_size) THEN is = 0 - DO j = istart, n-1 - DO k = j+1, n - a1 = xdata(j)-xdata(k) + DO j = istart, n - 1 + DO k = j + 1, n + a1 = xdata(j) - xdata(k) IF (a1 .GT. 0.0_dp) THEN - is = is+1 + is = is + 1 ELSE IF (a1 .LT. 0.0_dp) THEN - is = is-1 + is = is - 1 END IF END DO END DO tau = REAL(is, KIND=dp) - var = REAL(nt, KIND=dp)*REAL(nt-1, KIND=dp)*REAL(2*nt+5, KIND=dp)/18.0_dp + var = REAL(nt, KIND=dp)*REAL(nt - 1, KIND=dp)*REAL(2*nt + 5, KIND=dp)/18.0_dp z = tau/SQRT(var) prob = erf(ABS(z)/SQRT(2.0_dp)) ELSE @@ -410,20 +410,20 @@ SUBROUTINE vn_test(xdata, n, r, u, prob) x = 0.0_dp q = 0.0_dp s = 0.0_dp - DO i = 1, n-1 - x = x+xdata(i) - q = q+(xdata(i+1)-xdata(i))**2 + DO i = 1, n - 1 + x = x + xdata(i) + q = q + (xdata(i + 1) - xdata(i))**2 END DO - x = x+xdata(n) + x = x + xdata(n) x = x/REAL(n, KIND=dp) DO i = 1, n - s = s+(xdata(i)-x)**2 + s = s + (xdata(i) - x)**2 END DO - s = s/REAL(n-1, KIND=dp) - q = q/REAL(2*(n-1), KIND=dp) + s = s/REAL(n - 1, KIND=dp) + q = q/REAL(2*(n - 1), KIND=dp) r = q/s - var = SQRT(1.0_dp/REAL(n+1, KIND=dp)*(1.0_dp+1.0_dp/REAL(n-1, KIND=dp))) - u = (r-1.0_dp)/var + var = SQRT(1.0_dp/REAL(n + 1, KIND=dp)*(1.0_dp + 1.0_dp/REAL(n - 1, KIND=dp))) + u = (r - 1.0_dp)/var prob = erf(ABS(u)/SQRT(2.0_dp)) ELSE r = 0.0_dp @@ -456,7 +456,7 @@ SUBROUTINE tests(xdata, globenv) NULLIFY (xdata) ALLOCATE (xdata(n)) DO i = 1, 10 - xdata(i) = 5.0_dp-REAL(i, KIND=dp)/2.0_dp+0.1* & + xdata(i) = 5.0_dp - REAL(i, KIND=dp)/2.0_dp + 0.1* & next_random_number(globenv%gaussian_rng_stream) WRITE (3, *) xdata(i) END DO @@ -473,10 +473,10 @@ SUBROUTINE tests(xdata, globenv) ! Test for normality distribution and for serial correlation DO i = 1, n - ALLOCATE (ydata(n-i+1)) + ALLOCATE (ydata(n - i + 1)) ydata = xdata(i:n) - CALL sw_test(ydata, n-i+1, w, pw) - CALL vn_test(ydata, n-i+1, r, u, prob) + CALL sw_test(ydata, n - i + 1, w, pw) + CALL vn_test(ydata, n - i + 1, r, u, prob) WRITE (*, *) "Shapiro Wilks test", i, w, pw WRITE (*, *) "Von Neu", i, r, u, prob DEALLOCATE (ydata) diff --git a/src/stm_images.F b/src/stm_images.F index 705041f0b3..821cd17b43 100644 --- a/src/stm_images.F +++ b/src/stm_images.F @@ -186,20 +186,20 @@ SUBROUTINE th_stm_image(qs_env, stm_section, particles, unoccupied_orbs, & ELSE CALL get_mo_set(mo_set=mos(ispin)%mo_set, mo_coeff=mo_coeff, & eigenvalues=mo_eigenvalues, nmo=nmo, mu=efermi, occupation_numbers=mo_occ) - ndim = nmo+nadd_unocc(ispin) + ndim = nmo + nadd_unocc(ispin) ALLOCATE (evals(ispin)%array(ndim)) evals(ispin)%array(1:nmo) = mo_eigenvalues(1:nmo) - evals(ispin)%array(1+nmo:ndim) = unoccupied_evals(ispin)%array(1:nadd_unocc(ispin)) + evals(ispin)%array(1 + nmo:ndim) = unoccupied_evals(ispin)%array(1:nadd_unocc(ispin)) ALLOCATE (occupation(ispin)%array(ndim)) occupation(ispin)%array(1:nmo) = mo_occ(1:nmo) - occupation(ispin)%array(1+nmo:ndim) = 0.0_dp + occupation(ispin)%array(1 + nmo:ndim) = 0.0_dp CALL cp_fm_struct_create(fm_struct_tmp, ncol_global=ndim, & template_fmstruct=mo_coeff%matrix_struct) CALL cp_fm_create(mo_arrays(ispin)%matrix, fm_struct_tmp, name="mo_arrays") CALL cp_fm_struct_release(fm_struct_tmp) CALL cp_fm_to_fm(mo_coeff, mo_arrays(ispin)%matrix, nmo, 1, 1) CALL cp_fm_to_fm(unoccupied_orbs(ispin)%matrix, mo_arrays(ispin)%matrix, & - nadd_unocc(ispin), 1, nmo+1) + nadd_unocc(ispin), 1, nmo + 1) END IF ENDDO IF (use_ref_energy) efermi = ref_energy @@ -308,27 +308,27 @@ SUBROUTINE stm_cubes(ks_env, stm_section, stm_density_ao, wf_r, wf_g, mo_arrays, IF (stm_biases(ibias) < 0.0_dp) THEN nmo = SIZE(evals(ispin)%array) DO imo = 1, nmo - IF (evals(ispin)%array(imo) > (efermi+stm_biases(ibias)) .AND. & + IF (evals(ispin)%array(imo) > (efermi + stm_biases(ibias)) .AND. & evals(ispin)%array(imo) <= efermi) THEN IF (nstates(ispin) == 0) state_start(ispin) = imo - nstates(ispin) = nstates(ispin)+1 + nstates(ispin) = nstates(ispin) + 1 END IF END DO - IF ((output_unit > 0) .AND. evals(ispin)%array(1) > efermi+stm_biases(ibias)) & + IF ((output_unit > 0) .AND. evals(ispin)%array(1) > efermi + stm_biases(ibias)) & WRITE (output_unit, '(T4,A)') "Warning: EFermi+bias below lowest computed occupied MO" ELSE nmo = SIZE(evals(ispin)%array) DO imo = 1, nmo - IF (evals(ispin)%array(imo) <= (efermi+stm_biases(ibias)) .AND. & + IF (evals(ispin)%array(imo) <= (efermi + stm_biases(ibias)) .AND. & evals(ispin)%array(imo) > efermi) THEN IF (nstates(ispin) == 0) state_start(ispin) = imo - nstates(ispin) = nstates(ispin)+1 + nstates(ispin) = nstates(ispin) + 1 END IF END DO - IF ((output_unit > 0) .AND. evals(ispin)%array(nmo) < efermi+stm_biases(ibias)) & + IF ((output_unit > 0) .AND. evals(ispin)%array(nmo) < efermi + stm_biases(ibias)) & WRITE (output_unit, '(T4,A)') "Warning: E-Fermi+bias above highest computed unoccupied MO" ENDIF - istates = istates+nstates(ispin) + istates = istates + nstates(ispin) ENDDO IF ((output_unit > 0)) WRITE (output_unit, '(T4,A,I0,A)') "Using a total of ", istates, " states" IF (istates == 0) CYCLE @@ -346,16 +346,16 @@ SUBROUTINE stm_cubes(ks_env, stm_section, stm_density_ao, wf_r, wf_g, mo_arrays, alpha = 1.0_dp IF (nspin == 1) alpha = 2.0_dp DO ispin = 1, nspin - CALL cp_fm_to_fm(mo_arrays(ispin)%matrix, matrix_v, nstates(ispin), state_start(ispin), istates+1) - CALL cp_fm_to_fm(mo_arrays(ispin)%matrix, matrix_vf, nstates(ispin), state_start(ispin), istates+1) + CALL cp_fm_to_fm(mo_arrays(ispin)%matrix, matrix_v, nstates(ispin), state_start(ispin), istates + 1) + CALL cp_fm_to_fm(mo_arrays(ispin)%matrix, matrix_vf, nstates(ispin), state_start(ispin), istates + 1) IF (stm_biases(ibias) < 0.0_dp) THEN - occ_tot(istates+1:istates+nstates(ispin)) = & - occupation(ispin)%array(state_start(ispin):state_start(ispin)-1+nstates(ispin)) + occ_tot(istates + 1:istates + nstates(ispin)) = & + occupation(ispin)%array(state_start(ispin):state_start(ispin) - 1 + nstates(ispin)) ELSE - occ_tot(istates+1:istates+nstates(ispin)) = & - alpha-occupation(ispin)%array(state_start(ispin):state_start(ispin)-1+nstates(ispin)) + occ_tot(istates + 1:istates + nstates(ispin)) = & + alpha - occupation(ispin)%array(state_start(ispin):state_start(ispin) - 1 + nstates(ispin)) END IF - istates = istates+nstates(ispin) + istates = istates + nstates(ispin) ENDDO CALL cp_fm_column_scale(matrix_vf, occ_tot(1:istates)) diff --git a/src/subcell_types.F b/src/subcell_types.F index b26d0e05db..42ba28bb29 100644 --- a/src/subcell_types.F +++ b/src/subcell_types.F @@ -76,13 +76,13 @@ SUBROUTINE allocate_subcell(subcell, nsubcell, maxatom, cell) c_min = -0.5_dp DO k = 1, nc - c_max = c_min+delta_c + c_max = c_min + delta_c b_min = -0.5_dp DO j = 1, nb - b_max = b_min+delta_b + b_max = b_min + delta_b a_min = -0.5_dp DO i = 1, na - a_max = a_min+delta_a + a_max = a_min + delta_a subcell(i, j, k)%s_min(1) = a_min subcell(i, j, k)%s_min(2) = b_min subcell(i, j, k)%s_min(3) = c_min @@ -164,18 +164,18 @@ SUBROUTINE reorder_atoms_subcell(atom_list, kind_of, work) i0 = 1 j0 = SIZE(atom_list) - i1 = j0+1 + i1 = j0 + 1 j1 = 2*j0 - i2 = j1+1 + i2 = j1 + 1 j2 = 3*j0 ! Sort kind DO i = 1, SIZE(atom_list) - work(i0+i-1) = kind_of(atom_list(i)) + work(i0 + i - 1) = kind_of(atom_list(i)) END DO CALL sort(work(i0:j0), SIZE(atom_list), work(i1:j1)) work(i2:j2) = atom_list DO i = 1, SIZE(atom_list) - atom_list(i) = work(i2+work(i1+i-1)-1) + atom_list(i) = work(i2 + work(i1 + i - 1) - 1) END DO END SUBROUTINE reorder_atoms_subcell @@ -201,10 +201,10 @@ SUBROUTINE give_ijk_subcell(r, i, j, k, cell, nsubcell) r_pbc = r CALL real_to_scaled(s_pbc, r_pbc, cell) - s(:) = s_pbc+0.5_dp - i = INT(s(1)*REAL(nsubcell(1), KIND=dp))+1 - j = INT(s(2)*REAL(nsubcell(2), KIND=dp))+1 - k = INT(s(3)*REAL(nsubcell(3), KIND=dp))+1 + s(:) = s_pbc + 0.5_dp + i = INT(s(1)*REAL(nsubcell(1), KIND=dp)) + 1 + j = INT(s(2)*REAL(nsubcell(2), KIND=dp)) + 1 + k = INT(s(3)*REAL(nsubcell(3), KIND=dp)) + 1 i = MIN(MAX(i, 1), nsubcell(1)) j = MIN(MAX(j, 1), nsubcell(2)) k = MIN(MAX(k, 1), nsubcell(3)) diff --git a/src/subsys/atomic_kind_types.F b/src/subsys/atomic_kind_types.F index efc37f19fe..220b41c3b1 100644 --- a/src/subsys/atomic_kind_types.F +++ b/src/subsys/atomic_kind_types.F @@ -275,7 +275,7 @@ SUBROUTINE get_atomic_kind_set(atomic_kind_set, & maxatom = MAX(maxatom, atomic_kind%natom) END IF IF (PRESENT(natom)) THEN - natom = natom+atomic_kind_set(ikind)%natom + natom = natom + atomic_kind_set(ikind)%natom END IF IF (PRESENT(fist_potential_present)) THEN IF (ASSOCIATED(fist_potential)) THEN diff --git a/src/subsys/atprop_types.F b/src/subsys/atprop_types.F index 397c10e8cd..20f67cd92b 100644 --- a/src/subsys/atprop_types.F +++ b/src/subsys/atprop_types.F @@ -148,7 +148,7 @@ SUBROUTINE atprop_array_add(array_a, array_b) IF (ASSOCIATED(array_b)) THEN CPASSERT(ASSOCIATED(array_a)) - array_a = array_a+array_b + array_a = array_a + array_b END IF END SUBROUTINE atprop_array_add diff --git a/src/subsys/cell_types.F b/src/subsys/cell_types.F index 83e8331421..485322a547 100644 --- a/src/subsys/cell_types.F +++ b/src/subsys/cell_types.F @@ -109,7 +109,7 @@ SUBROUTINE cell_clone(cell_in, cell_out) cell_out%orthorhombic = cell_in%orthorhombic cell_out%symmetry_id = cell_in%symmetry_id cell_out%ref_count = 1 - last_cell_id = last_cell_id+1 + last_cell_id = last_cell_id + 1 cell_out%id_nr = last_cell_id END SUBROUTINE cell_clone @@ -208,14 +208,14 @@ SUBROUTINE get_cell(cell, alpha, beta, gamma, deth, orthorhombic, abc, periodic, ! Calculate the lengths of the cell vectors a, b, and c IF (PRESENT(abc)) THEN - abc(1) = SQRT(cell%hmat(1, 1)*cell%hmat(1, 1)+ & - cell%hmat(2, 1)*cell%hmat(2, 1)+ & + abc(1) = SQRT(cell%hmat(1, 1)*cell%hmat(1, 1) + & + cell%hmat(2, 1)*cell%hmat(2, 1) + & cell%hmat(3, 1)*cell%hmat(3, 1)) - abc(2) = SQRT(cell%hmat(1, 2)*cell%hmat(1, 2)+ & - cell%hmat(2, 2)*cell%hmat(2, 2)+ & + abc(2) = SQRT(cell%hmat(1, 2)*cell%hmat(1, 2) + & + cell%hmat(2, 2)*cell%hmat(2, 2) + & cell%hmat(3, 2)*cell%hmat(3, 2)) - abc(3) = SQRT(cell%hmat(1, 3)*cell%hmat(1, 3)+ & - cell%hmat(2, 3)*cell%hmat(2, 3)+ & + abc(3) = SQRT(cell%hmat(1, 3)*cell%hmat(1, 3) + & + cell%hmat(2, 3)*cell%hmat(2, 3) + & cell%hmat(3, 3)*cell%hmat(3, 3)) END IF @@ -296,18 +296,18 @@ SUBROUTINE set_cell_param(cell, cell_length, cell_angle, periodic, do_init_cell) CPASSERT(ALL(cell_angle /= 0.0_dp)) eps = EPSILON(0.0_dp) cos_gamma = COS(cell_angle(3)); IF (ABS(cos_gamma) < eps) cos_gamma = 0.0_dp - IF (ABS(ABS(cos_gamma)-1.0_dp) < eps) cos_gamma = SIGN(1.0_dp, cos_gamma) + IF (ABS(ABS(cos_gamma) - 1.0_dp) < eps) cos_gamma = SIGN(1.0_dp, cos_gamma) sin_gamma = SIN(cell_angle(3)); IF (ABS(sin_gamma) < eps) sin_gamma = 0.0_dp - IF (ABS(ABS(sin_gamma)-1.0_dp) < eps) sin_gamma = SIGN(1.0_dp, sin_gamma) + IF (ABS(ABS(sin_gamma) - 1.0_dp) < eps) sin_gamma = SIGN(1.0_dp, sin_gamma) cos_beta = COS(cell_angle(2)); IF (ABS(cos_beta) < eps) cos_beta = 0.0_dp - IF (ABS(ABS(cos_beta)-1.0_dp) < eps) cos_beta = SIGN(1.0_dp, cos_beta) + IF (ABS(ABS(cos_beta) - 1.0_dp) < eps) cos_beta = SIGN(1.0_dp, cos_beta) cos_alpha = COS(cell_angle(1)); IF (ABS(cos_alpha) < eps) cos_alpha = 0.0_dp - IF (ABS(ABS(cos_alpha)-1.0_dp) < eps) cos_alpha = SIGN(1.0_dp, cos_alpha) + IF (ABS(ABS(cos_alpha) - 1.0_dp) < eps) cos_alpha = SIGN(1.0_dp, cos_alpha) cell%hmat(:, 1) = (/1.0_dp, 0.0_dp, 0.0_dp/) cell%hmat(:, 2) = (/cos_gamma, sin_gamma, 0.0_dp/) - cell%hmat(:, 3) = (/cos_beta, (cos_alpha-cos_gamma*cos_beta)/sin_gamma, 0.0_dp/) - cell%hmat(3, 3) = SQRT(1.0_dp-cell%hmat(1, 3)**2-cell%hmat(2, 3)**2) + cell%hmat(:, 3) = (/cos_beta, (cos_alpha - cos_gamma*cos_beta)/sin_gamma, 0.0_dp/) + cell%hmat(3, 3) = SQRT(1.0_dp - cell%hmat(1, 3)**2 - cell%hmat(2, 3)**2) cell%hmat(:, 1) = cell%hmat(:, 1)*cell_length(1) cell%hmat(:, 2) = cell%hmat(:, 2)*cell_length(2) @@ -376,15 +376,15 @@ SUBROUTINE init_cell(cell, hmat, periodic) cell_sym_tetragonal_bc) SELECT CASE (cell%symmetry_id) CASE (cell_sym_tetragonal_ab) - a = 0.5_dp*(abc(1)+abc(2)) + a = 0.5_dp*(abc(1) + abc(2)) abc(1) = a abc(2) = a CASE (cell_sym_tetragonal_ac) - a = 0.5_dp*(abc(1)+abc(3)) + a = 0.5_dp*(abc(1) + abc(3)) abc(1) = a abc(3) = a CASE (cell_sym_tetragonal_bc) - a = 0.5_dp*(abc(2)+abc(3)) + a = 0.5_dp*(abc(2) + abc(3)) abc(2) = a abc(3) = a END SELECT @@ -394,7 +394,7 @@ SUBROUTINE init_cell(cell, hmat, periodic) cell%hmat(3, 1) = 0.0_dp; cell%hmat(3, 2) = 0.0_dp; cell%hmat(3, 3) = abc(3) CASE (cell_sym_hexagonal) CALL get_cell(cell=cell, abc=abc) - a = 0.5_dp*(abc(1)+abc(2)) + a = 0.5_dp*(abc(1) + abc(2)) acosa = 0.5_dp*a asina = sqrt3*acosa cell%hmat(1, 1) = a; cell%hmat(1, 2) = acosa; cell%hmat(1, 3) = 0.0_dp @@ -403,15 +403,15 @@ SUBROUTINE init_cell(cell, hmat, periodic) CASE (cell_sym_rhombohedral) CALL get_cell(cell=cell, abc=abc) a = SUM(abc(1:3))/3.0_dp - alpha = (angle(cell%hmat(:, 3), cell%hmat(:, 2))+ & - angle(cell%hmat(:, 1), cell%hmat(:, 3))+ & + alpha = (angle(cell%hmat(:, 3), cell%hmat(:, 2)) + & + angle(cell%hmat(:, 1), cell%hmat(:, 3)) + & angle(cell%hmat(:, 1), cell%hmat(:, 2)))/3.0_dp acosa = a*COS(alpha) asina = a*SIN(alpha) acosah = a*COS(0.5_dp*alpha) asinah = a*SIN(0.5_dp*alpha) norm = acosa/acosah - norm_c = SQRT(1.0_dp-norm*norm) + norm_c = SQRT(1.0_dp - norm*norm) cell%hmat(1, 1) = a; cell%hmat(1, 2) = acosa; cell%hmat(1, 3) = acosah*norm cell%hmat(2, 1) = 0.0_dp; cell%hmat(2, 2) = asina; cell%hmat(2, 3) = asinah*norm cell%hmat(3, 1) = 0.0_dp; cell%hmat(3, 2) = 0.0_dp; cell%hmat(3, 3) = a*norm_c @@ -424,7 +424,7 @@ SUBROUTINE init_cell(cell, hmat, periodic) CASE (cell_sym_monoclinic_gamma_ab) ! Cell symmetry with a=b, alpha=beta=90deg and gammma unequal 90deg CALL get_cell(cell=cell, abc=abc) - a = 0.5_dp*(abc(1)+abc(2)) + a = 0.5_dp*(abc(1) + abc(2)) gamma = angle(cell%hmat(:, 1), cell%hmat(:, 2)) acosgamma = a*COS(gamma) asingamma = a*SIN(gamma) @@ -505,7 +505,7 @@ FUNCTION plane_distance(h, k, l, cell) RESULT(distance) IF (cell%orthorhombic) THEN - d = (x/a)**2+(y/b)**2+(z/c)**2 + d = (x/a)**2 + (y/b)**2 + (z/c)**2 ELSE @@ -522,13 +522,13 @@ FUNCTION plane_distance(h, k, l, cell) RESULT(distance) cosb = COS(beta) cosg = COS(gamma) - d = ((x*b*c*SIN(alpha))**2+ & - (y*c*a*SIN(beta))**2+ & - (z*a*b*SIN(gamma))**2+ & - 2.0_dp*a*b*c*(x*y*c*(cosa*cosb-cosg)+ & - z*x*b*(cosg*cosa-cosb)+ & - y*z*a*(cosb*cosg-cosa)))/ & - ((a*b*c)**2*(1.0_dp-cosa**2-cosb**2-cosg**2+ & + d = ((x*b*c*SIN(alpha))**2 + & + (y*c*a*SIN(beta))**2 + & + (z*a*b*SIN(gamma))**2 + & + 2.0_dp*a*b*c*(x*y*c*(cosa*cosb - cosg) + & + z*x*b*(cosg*cosa - cosb) + & + y*z*a*(cosb*cosg - cosa)))/ & + ((a*b*c)**2*(1.0_dp - cosa**2 - cosb**2 - cosg**2 + & 2.0_dp*cosa*cosb*cosg)) END IF @@ -556,19 +556,19 @@ FUNCTION pbc1(r, cell) RESULT(r_pbc) REAL(KIND=dp), DIMENSION(3) :: s IF (cell%orthorhombic) THEN - r_pbc(1) = r(1)-cell%hmat(1, 1)*cell%perd(1)*ANINT(cell%h_inv(1, 1)*r(1)) - r_pbc(2) = r(2)-cell%hmat(2, 2)*cell%perd(2)*ANINT(cell%h_inv(2, 2)*r(2)) - r_pbc(3) = r(3)-cell%hmat(3, 3)*cell%perd(3)*ANINT(cell%h_inv(3, 3)*r(3)) + r_pbc(1) = r(1) - cell%hmat(1, 1)*cell%perd(1)*ANINT(cell%h_inv(1, 1)*r(1)) + r_pbc(2) = r(2) - cell%hmat(2, 2)*cell%perd(2)*ANINT(cell%h_inv(2, 2)*r(2)) + r_pbc(3) = r(3) - cell%hmat(3, 3)*cell%perd(3)*ANINT(cell%h_inv(3, 3)*r(3)) ELSE - s(1) = cell%h_inv(1, 1)*r(1)+cell%h_inv(1, 2)*r(2)+cell%h_inv(1, 3)*r(3) - s(2) = cell%h_inv(2, 1)*r(1)+cell%h_inv(2, 2)*r(2)+cell%h_inv(2, 3)*r(3) - s(3) = cell%h_inv(3, 1)*r(1)+cell%h_inv(3, 2)*r(2)+cell%h_inv(3, 3)*r(3) - s(1) = s(1)-cell%perd(1)*ANINT(s(1)) - s(2) = s(2)-cell%perd(2)*ANINT(s(2)) - s(3) = s(3)-cell%perd(3)*ANINT(s(3)) - r_pbc(1) = cell%hmat(1, 1)*s(1)+cell%hmat(1, 2)*s(2)+cell%hmat(1, 3)*s(3) - r_pbc(2) = cell%hmat(2, 1)*s(1)+cell%hmat(2, 2)*s(2)+cell%hmat(2, 3)*s(3) - r_pbc(3) = cell%hmat(3, 1)*s(1)+cell%hmat(3, 2)*s(2)+cell%hmat(3, 3)*s(3) + s(1) = cell%h_inv(1, 1)*r(1) + cell%h_inv(1, 2)*r(2) + cell%h_inv(1, 3)*r(3) + s(2) = cell%h_inv(2, 1)*r(1) + cell%h_inv(2, 2)*r(2) + cell%h_inv(2, 3)*r(3) + s(3) = cell%h_inv(3, 1)*r(1) + cell%h_inv(3, 2)*r(2) + cell%h_inv(3, 3)*r(3) + s(1) = s(1) - cell%perd(1)*ANINT(s(1)) + s(2) = s(2) - cell%perd(2)*ANINT(s(2)) + s(3) = s(3) - cell%perd(3)*ANINT(s(3)) + r_pbc(1) = cell%hmat(1, 1)*s(1) + cell%hmat(1, 2)*s(2) + cell%hmat(1, 3)*s(3) + r_pbc(2) = cell%hmat(2, 1)*s(1) + cell%hmat(2, 2)*s(2) + cell%hmat(2, 3)*s(3) + r_pbc(3) = cell%hmat(3, 1)*s(1) + cell%hmat(3, 2)*s(2) + cell%hmat(3, 3)*s(3) END IF END FUNCTION pbc1 @@ -594,22 +594,22 @@ FUNCTION pbc2(r, cell, nl) RESULT(r_pbc) REAL(KIND=dp), DIMENSION(3) :: s IF (cell%orthorhombic) THEN - r_pbc(1) = r(1)-cell%hmat(1, 1)*cell%perd(1)* & - REAL(NINT(cell%h_inv(1, 1)*r(1))-nl(1), dp) - r_pbc(2) = r(2)-cell%hmat(2, 2)*cell%perd(2)* & - REAL(NINT(cell%h_inv(2, 2)*r(2))-nl(2), dp) - r_pbc(3) = r(3)-cell%hmat(3, 3)*cell%perd(3)* & - REAL(NINT(cell%h_inv(3, 3)*r(3))-nl(3), dp) + r_pbc(1) = r(1) - cell%hmat(1, 1)*cell%perd(1)* & + REAL(NINT(cell%h_inv(1, 1)*r(1)) - nl(1), dp) + r_pbc(2) = r(2) - cell%hmat(2, 2)*cell%perd(2)* & + REAL(NINT(cell%h_inv(2, 2)*r(2)) - nl(2), dp) + r_pbc(3) = r(3) - cell%hmat(3, 3)*cell%perd(3)* & + REAL(NINT(cell%h_inv(3, 3)*r(3)) - nl(3), dp) ELSE - s(1) = cell%h_inv(1, 1)*r(1)+cell%h_inv(1, 2)*r(2)+cell%h_inv(1, 3)*r(3) - s(2) = cell%h_inv(2, 1)*r(1)+cell%h_inv(2, 2)*r(2)+cell%h_inv(2, 3)*r(3) - s(3) = cell%h_inv(3, 1)*r(1)+cell%h_inv(3, 2)*r(2)+cell%h_inv(3, 3)*r(3) - s(1) = s(1)-cell%perd(1)*REAL(NINT(s(1))-nl(1), dp) - s(2) = s(2)-cell%perd(2)*REAL(NINT(s(2))-nl(2), dp) - s(3) = s(3)-cell%perd(3)*REAL(NINT(s(3))-nl(3), dp) - r_pbc(1) = cell%hmat(1, 1)*s(1)+cell%hmat(1, 2)*s(2)+cell%hmat(1, 3)*s(3) - r_pbc(2) = cell%hmat(2, 1)*s(1)+cell%hmat(2, 2)*s(2)+cell%hmat(2, 3)*s(3) - r_pbc(3) = cell%hmat(3, 1)*s(1)+cell%hmat(3, 2)*s(2)+cell%hmat(3, 3)*s(3) + s(1) = cell%h_inv(1, 1)*r(1) + cell%h_inv(1, 2)*r(2) + cell%h_inv(1, 3)*r(3) + s(2) = cell%h_inv(2, 1)*r(1) + cell%h_inv(2, 2)*r(2) + cell%h_inv(2, 3)*r(3) + s(3) = cell%h_inv(3, 1)*r(1) + cell%h_inv(3, 2)*r(2) + cell%h_inv(3, 3)*r(3) + s(1) = s(1) - cell%perd(1)*REAL(NINT(s(1)) - nl(1), dp) + s(2) = s(2) - cell%perd(2)*REAL(NINT(s(2)) - nl(2), dp) + s(3) = s(3) - cell%perd(3)*REAL(NINT(s(3)) - nl(3), dp) + r_pbc(1) = cell%hmat(1, 1)*s(1) + cell%hmat(1, 2)*s(2) + cell%hmat(1, 3)*s(3) + r_pbc(2) = cell%hmat(2, 1)*s(1) + cell%hmat(2, 2)*s(2) + cell%hmat(2, 3)*s(3) + r_pbc(3) = cell%hmat(3, 1)*s(1) + cell%hmat(3, 2)*s(2) + cell%hmat(3, 3)*s(3) END IF END FUNCTION pbc2 @@ -648,9 +648,9 @@ FUNCTION pbc3(ra, rb, cell) RESULT(rab_pbc) DO kcell = -periodic(3), periodic(3) r = REAL((/icell, jcell, kcell/), dp) CALL scaled_to_real(s2r, r, cell) - rb_image(:) = rb_pbc(:)+s2r - rab(:) = rb_image(:)-ra_pbc(:) - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rb_image(:) = rb_pbc(:) + s2r + rab(:) = rb_image(:) - ra_pbc(:) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) IF (rab2 < rab2_pbc) THEN rab2_pbc = rab2 rab_pbc(:) = rab(:) @@ -681,19 +681,19 @@ FUNCTION pbc4(r, cell, positive_range) RESULT(r_pbc) IF (positive_range) THEN IF (cell%orthorhombic) THEN - r_pbc(1) = r(1)-cell%hmat(1, 1)*cell%perd(1)*FLOOR(cell%h_inv(1, 1)*r(1)) - r_pbc(2) = r(2)-cell%hmat(2, 2)*cell%perd(2)*FLOOR(cell%h_inv(2, 2)*r(2)) - r_pbc(3) = r(3)-cell%hmat(3, 3)*cell%perd(3)*FLOOR(cell%h_inv(3, 3)*r(3)) + r_pbc(1) = r(1) - cell%hmat(1, 1)*cell%perd(1)*FLOOR(cell%h_inv(1, 1)*r(1)) + r_pbc(2) = r(2) - cell%hmat(2, 2)*cell%perd(2)*FLOOR(cell%h_inv(2, 2)*r(2)) + r_pbc(3) = r(3) - cell%hmat(3, 3)*cell%perd(3)*FLOOR(cell%h_inv(3, 3)*r(3)) ELSE - s(1) = cell%h_inv(1, 1)*r(1)+cell%h_inv(1, 2)*r(2)+cell%h_inv(1, 3)*r(3) - s(2) = cell%h_inv(2, 1)*r(1)+cell%h_inv(2, 2)*r(2)+cell%h_inv(2, 3)*r(3) - s(3) = cell%h_inv(3, 1)*r(1)+cell%h_inv(3, 2)*r(2)+cell%h_inv(3, 3)*r(3) - s(1) = s(1)-cell%perd(1)*FLOOR(s(1)) - s(2) = s(2)-cell%perd(2)*FLOOR(s(2)) - s(3) = s(3)-cell%perd(3)*FLOOR(s(3)) - r_pbc(1) = cell%hmat(1, 1)*s(1)+cell%hmat(1, 2)*s(2)+cell%hmat(1, 3)*s(3) - r_pbc(2) = cell%hmat(2, 1)*s(1)+cell%hmat(2, 2)*s(2)+cell%hmat(2, 3)*s(3) - r_pbc(3) = cell%hmat(3, 1)*s(1)+cell%hmat(3, 2)*s(2)+cell%hmat(3, 3)*s(3) + s(1) = cell%h_inv(1, 1)*r(1) + cell%h_inv(1, 2)*r(2) + cell%h_inv(1, 3)*r(3) + s(2) = cell%h_inv(2, 1)*r(1) + cell%h_inv(2, 2)*r(2) + cell%h_inv(2, 3)*r(3) + s(3) = cell%h_inv(3, 1)*r(1) + cell%h_inv(3, 2)*r(2) + cell%h_inv(3, 3)*r(3) + s(1) = s(1) - cell%perd(1)*FLOOR(s(1)) + s(2) = s(2) - cell%perd(2)*FLOOR(s(2)) + s(3) = s(3) - cell%perd(3)*FLOOR(s(3)) + r_pbc(1) = cell%hmat(1, 1)*s(1) + cell%hmat(1, 2)*s(2) + cell%hmat(1, 3)*s(3) + r_pbc(2) = cell%hmat(2, 1)*s(1) + cell%hmat(2, 2)*s(2) + cell%hmat(2, 3)*s(3) + r_pbc(3) = cell%hmat(3, 1)*s(1) + cell%hmat(3, 2)*s(2) + cell%hmat(3, 3)*s(3) END IF ELSE r_pbc = pbc1(r, cell) @@ -722,9 +722,9 @@ SUBROUTINE real_to_scaled(s, r, cell) s(2) = cell%h_inv(2, 2)*r(2) s(3) = cell%h_inv(3, 3)*r(3) ELSE - s(1) = cell%h_inv(1, 1)*r(1)+cell%h_inv(1, 2)*r(2)+cell%h_inv(1, 3)*r(3) - s(2) = cell%h_inv(2, 1)*r(1)+cell%h_inv(2, 2)*r(2)+cell%h_inv(2, 3)*r(3) - s(3) = cell%h_inv(3, 1)*r(1)+cell%h_inv(3, 2)*r(2)+cell%h_inv(3, 3)*r(3) + s(1) = cell%h_inv(1, 1)*r(1) + cell%h_inv(1, 2)*r(2) + cell%h_inv(1, 3)*r(3) + s(2) = cell%h_inv(2, 1)*r(1) + cell%h_inv(2, 2)*r(2) + cell%h_inv(2, 3)*r(3) + s(3) = cell%h_inv(3, 1)*r(1) + cell%h_inv(3, 2)*r(2) + cell%h_inv(3, 3)*r(3) END IF END SUBROUTINE real_to_scaled @@ -750,9 +750,9 @@ SUBROUTINE scaled_to_real(r, s, cell) r(2) = cell%hmat(2, 2)*s(2) r(3) = cell%hmat(3, 3)*s(3) ELSE - r(1) = cell%hmat(1, 1)*s(1)+cell%hmat(1, 2)*s(2)+cell%hmat(1, 3)*s(3) - r(2) = cell%hmat(2, 1)*s(1)+cell%hmat(2, 2)*s(2)+cell%hmat(2, 3)*s(3) - r(3) = cell%hmat(3, 1)*s(1)+cell%hmat(3, 2)*s(2)+cell%hmat(3, 3)*s(3) + r(1) = cell%hmat(1, 1)*s(1) + cell%hmat(1, 2)*s(2) + cell%hmat(1, 3)*s(3) + r(2) = cell%hmat(2, 1)*s(1) + cell%hmat(2, 2)*s(2) + cell%hmat(2, 3)*s(3) + r(3) = cell%hmat(3, 1)*s(1) + cell%hmat(3, 2)*s(2) + cell%hmat(3, 3)*s(3) END IF END SUBROUTINE scaled_to_real @@ -777,7 +777,7 @@ SUBROUTINE cell_create(cell, hmat, periodic) CPASSERT(.NOT. ASSOCIATED(cell)) ALLOCATE (cell) - last_cell_id = last_cell_id+1 + last_cell_id = last_cell_id + 1 cell%id_nr = last_cell_id cell%ref_count = 1 IF (PRESENT(periodic)) THEN @@ -806,7 +806,7 @@ SUBROUTINE cell_retain(cell) CPASSERT(ASSOCIATED(cell)) CPASSERT(cell%ref_count > 0) - cell%ref_count = cell%ref_count+1 + cell%ref_count = cell%ref_count + 1 END SUBROUTINE cell_retain @@ -825,7 +825,7 @@ SUBROUTINE cell_release(cell) IF (ASSOCIATED(cell)) THEN CPASSERT(cell%ref_count > 0) - cell%ref_count = cell%ref_count-1 + cell%ref_count = cell%ref_count - 1 IF (cell%ref_count == 0) THEN DEALLOCATE (cell) END IF diff --git a/src/subsys/colvar_types.F b/src/subsys/colvar_types.F index 5a29c50b40..c1881861fe 100644 --- a/src/subsys/colvar_types.F +++ b/src/subsys/colvar_types.F @@ -544,74 +544,74 @@ SUBROUTINE colvar_setup(colvar) i = colvar%dist_param%i_at j = colvar%dist_param%j_at ! Number of real atoms involved in the colvar - colvar%n_atom_s = COLV_SIZE(colvar, i)+ & + colvar%n_atom_s = COLV_SIZE(colvar, i) + & COLV_SIZE(colvar, j) ! Create a List of points... ALLOCATE (list(np)) list(1) = colvar%dist_param%i_at list(2) = colvar%dist_param%j_at CASE (coord_colvar_id) - np = colvar%coord_param%n_atoms_from+colvar%coord_param%n_atoms_to & - +colvar%coord_param%n_atoms_to_b + np = colvar%coord_param%n_atoms_from + colvar%coord_param%n_atoms_to & + + colvar%coord_param%n_atoms_to_b ! Number of real atoms involved in the colvar colvar%n_atom_s = 0 DO ii = 1, colvar%coord_param%n_atoms_from i = colvar%coord_param%i_at_from(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO DO ii = 1, colvar%coord_param%n_atoms_to i = colvar%coord_param%i_at_to(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO IF (colvar%coord_param%n_atoms_to_b /= 0) THEN DO ii = 1, colvar%coord_param%n_atoms_to_b i = colvar%coord_param%i_at_to_b(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO END IF ! Create a List of points... ALLOCATE (list(np)) idum = 0 DO ii = 1, colvar%coord_param%n_atoms_from - idum = idum+1 + idum = idum + 1 i = colvar%coord_param%i_at_from(ii) list(idum) = i ENDDO DO ii = 1, colvar%coord_param%n_atoms_to - idum = idum+1 + idum = idum + 1 i = colvar%coord_param%i_at_to(ii) list(idum) = i ENDDO IF (colvar%coord_param%n_atoms_to_b /= 0) THEN DO ii = 1, colvar%coord_param%n_atoms_to_b - idum = idum+1 + idum = idum + 1 i = colvar%coord_param%i_at_to_b(ii) list(idum) = i ENDDO END IF CPASSERT(idum == np) CASE (population_colvar_id) - np = colvar%population_param%n_atoms_from+colvar%population_param%n_atoms_to + np = colvar%population_param%n_atoms_from + colvar%population_param%n_atoms_to ! Number of real atoms involved in the colvar colvar%n_atom_s = 0 DO ii = 1, colvar%population_param%n_atoms_from i = colvar%population_param%i_at_from(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO DO ii = 1, colvar%population_param%n_atoms_to i = colvar%population_param%i_at_to(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO ! Create a List of points... ALLOCATE (list(np)) idum = 0 DO ii = 1, colvar%population_param%n_atoms_from - idum = idum+1 + idum = idum + 1 i = colvar%population_param%i_at_from(ii) list(idum) = i ENDDO DO ii = 1, colvar%population_param%n_atoms_to - idum = idum+1 + idum = idum + 1 i = colvar%population_param%i_at_to(ii) list(idum) = i ENDDO @@ -622,13 +622,13 @@ SUBROUTINE colvar_setup(colvar) colvar%n_atom_s = 0 DO ii = 1, colvar%gyration_param%n_atoms i = colvar%gyration_param%i_at(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO ! Create a List of points... ALLOCATE (list(np)) idum = 0 DO ii = 1, colvar%gyration_param%n_atoms - idum = idum+1 + idum = idum + 1 i = colvar%gyration_param%i_at(ii) list(idum) = i ENDDO @@ -639,13 +639,13 @@ SUBROUTINE colvar_setup(colvar) colvar%n_atom_s = 0 DO ii = 1, 3 i = colvar%angle_param%i_at_angle(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO ! Create a List of points... ALLOCATE (list(np)) idum = 0 DO ii = 1, 3 - idum = idum+1 + idum = idum + 1 i = colvar%angle_param%i_at_angle(ii) list(idum) = i ENDDO @@ -656,13 +656,13 @@ SUBROUTINE colvar_setup(colvar) colvar%n_atom_s = 0 DO ii = 1, 4 i = colvar%torsion_param%i_at_tors(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO ! Create a List of points... ALLOCATE (list(np)) idum = 0 DO ii = 1, 4 - idum = idum+1 + idum = idum + 1 i = colvar%torsion_param%i_at_tors(ii) list(idum) = i ENDDO @@ -673,26 +673,26 @@ SUBROUTINE colvar_setup(colvar) colvar%n_atom_s = 0 DO ii = 1, 3 i = colvar%plane_distance_param%plane(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO i = colvar%plane_distance_param%point - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ! Create a List of points... ALLOCATE (list(np)) idum = 0 DO ii = 1, 3 - idum = idum+1 + idum = idum + 1 i = colvar%plane_distance_param%plane(ii) list(idum) = i ENDDO i = colvar%plane_distance_param%point list(4) = i - idum = idum+1 + idum = idum + 1 CPASSERT(idum == np) CASE (plane_plane_angle_colvar_id) np = 0 - IF (colvar%plane_plane_angle_param%plane1%type_of_def == plane_def_atoms) np = np+3 - IF (colvar%plane_plane_angle_param%plane2%type_of_def == plane_def_atoms) np = np+3 + IF (colvar%plane_plane_angle_param%plane1%type_of_def == plane_def_atoms) np = np + 3 + IF (colvar%plane_plane_angle_param%plane2%type_of_def == plane_def_atoms) np = np + 3 ! if np is equal to zero this means that this is not a COLLECTIVE variable.. IF (np == 0) & CALL cp_abort(__LOCATION__, & @@ -705,13 +705,13 @@ SUBROUTINE colvar_setup(colvar) IF (colvar%plane_plane_angle_param%plane1%type_of_def == plane_def_atoms) THEN DO ii = 1, 3 i = colvar%plane_plane_angle_param%plane1%points(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO END IF IF (colvar%plane_plane_angle_param%plane2%type_of_def == plane_def_atoms) THEN DO ii = 1, 3 i = colvar%plane_plane_angle_param%plane2%points(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO END IF @@ -720,14 +720,14 @@ SUBROUTINE colvar_setup(colvar) idum = 0 IF (colvar%plane_plane_angle_param%plane1%type_of_def == plane_def_atoms) THEN DO ii = 1, 3 - idum = idum+1 + idum = idum + 1 i = colvar%plane_plane_angle_param%plane1%points(ii) list(idum) = i ENDDO END IF IF (colvar%plane_plane_angle_param%plane2%type_of_def == plane_def_atoms) THEN DO ii = 1, 3 - idum = idum+1 + idum = idum + 1 i = colvar%plane_plane_angle_param%plane2%points(ii) list(idum) = i ENDDO @@ -739,13 +739,13 @@ SUBROUTINE colvar_setup(colvar) colvar%n_atom_s = 0 DO ii = 1, 4 i = colvar%dfunct_param%i_at_dfunct(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO ! Create a List of points... ALLOCATE (list(np)) idum = 0 DO ii = 1, 4 - idum = idum+1 + idum = idum + 1 i = colvar%dfunct_param%i_at_dfunct(ii) list(idum) = i ENDDO @@ -755,13 +755,13 @@ SUBROUTINE colvar_setup(colvar) ! Number of real atoms involved in the colvar colvar%n_atom_s = 0 i = colvar%rotation_param%i_at1_bond1 - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) i = colvar%rotation_param%i_at2_bond1 - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) i = colvar%rotation_param%i_at1_bond2 - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) i = colvar%rotation_param%i_at2_bond2 - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ! Create a List of points... ALLOCATE (list(np)) i = colvar%rotation_param%i_at1_bond1 @@ -773,49 +773,49 @@ SUBROUTINE colvar_setup(colvar) i = colvar%rotation_param%i_at2_bond2 list(4) = i CASE (qparm_colvar_id) - np = colvar%qparm_param%n_atoms_from+colvar%qparm_param%n_atoms_to + np = colvar%qparm_param%n_atoms_from + colvar%qparm_param%n_atoms_to ! Number of real atoms involved in the colvar colvar%n_atom_s = 0 DO ii = 1, colvar%qparm_param%n_atoms_from i = colvar%qparm_param%i_at_from(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO DO ii = 1, colvar%qparm_param%n_atoms_to i = colvar%qparm_param%i_at_to(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO ! Create a List of points... ALLOCATE (list(np)) idum = 0 DO ii = 1, colvar%qparm_param%n_atoms_from - idum = idum+1 + idum = idum + 1 i = colvar%qparm_param%i_at_from(ii) list(idum) = i ENDDO DO ii = 1, colvar%qparm_param%n_atoms_to - idum = idum+1 + idum = idum + 1 i = colvar%qparm_param%i_at_to(ii) list(idum) = i ENDDO CPASSERT(idum == np) CASE (hydronium_shell_colvar_id) - np = colvar%hydronium_shell_param%n_oxygens+colvar%hydronium_shell_param%n_hydrogens + np = colvar%hydronium_shell_param%n_oxygens + colvar%hydronium_shell_param%n_hydrogens ALLOCATE (list(np)) CALL setup_hydronium_colvars(colvar, hydronium_shell_colvar_id, list) CASE (hydronium_dist_colvar_id) - np = colvar%hydronium_dist_param%n_oxygens+colvar%hydronium_dist_param%n_hydrogens + np = colvar%hydronium_dist_param%n_oxygens + colvar%hydronium_dist_param%n_hydrogens ALLOCATE (list(np)) CALL setup_hydronium_colvars(colvar, hydronium_dist_colvar_id, list) CASE (acid_hyd_dist_colvar_id) np = colvar%acid_hyd_dist_param%n_oxygens_water & - +colvar%acid_hyd_dist_param%n_oxygens_acid & - +colvar%acid_hyd_dist_param%n_hydrogens + + colvar%acid_hyd_dist_param%n_oxygens_acid & + + colvar%acid_hyd_dist_param%n_hydrogens ALLOCATE (list(np)) CALL setup_acid_hydronium_colvars(colvar, acid_hyd_dist_colvar_id, list) CASE (acid_hyd_shell_colvar_id) np = colvar%acid_hyd_shell_param%n_oxygens_water & - +colvar%acid_hyd_shell_param%n_oxygens_acid & - +colvar%acid_hyd_shell_param%n_hydrogens + + colvar%acid_hyd_shell_param%n_oxygens_acid & + + colvar%acid_hyd_shell_param%n_hydrogens ALLOCATE (list(np)) CALL setup_acid_hydronium_colvars(colvar, acid_hyd_shell_colvar_id, list) CASE (rmsd_colvar_id) @@ -824,13 +824,13 @@ SUBROUTINE colvar_setup(colvar) colvar%n_atom_s = 0 DO ii = 1, colvar%rmsd_param%n_atoms i = colvar%rmsd_param%i_rmsd(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO ! Create a List of points... ALLOCATE (list(np)) idum = 0 DO ii = 1, colvar%rmsd_param%n_atoms - idum = idum+1 + idum = idum + 1 i = colvar%rmsd_param%i_rmsd(ii) list(idum) = i END DO @@ -840,21 +840,21 @@ SUBROUTINE colvar_setup(colvar) colvar%n_atom_s = colvar%reaction_path_param%n_components ELSE DO ii = 1, SIZE(colvar%reaction_path_param%colvar_p) - colvar%n_atom_s = colvar%n_atom_s+colvar%reaction_path_param%colvar_p(ii)%colvar%n_atom_s + colvar%n_atom_s = colvar%n_atom_s + colvar%reaction_path_param%colvar_p(ii)%colvar%n_atom_s END DO END IF ALLOCATE (list(colvar%n_atom_s)) idum = 0 IF (colvar%reaction_path_param%dist_rmsd .OR. colvar%reaction_path_param%rmsd) THEN DO ii = 1, SIZE(colvar%reaction_path_param%i_rmsd) - idum = idum+1 + idum = idum + 1 i = colvar%reaction_path_param%i_rmsd(ii) list(idum) = i END DO ELSE DO ii = 1, SIZE(colvar%reaction_path_param%colvar_p) DO j = 1, colvar%reaction_path_param%colvar_p(ii)%colvar%n_atom_s - idum = idum+1 + idum = idum + 1 list(idum) = colvar%reaction_path_param%colvar_p(ii)%colvar%i_atom(j) END DO END DO @@ -864,7 +864,7 @@ SUBROUTINE colvar_setup(colvar) ! Number of real atoms involved in the colvar colvar%n_atom_s = 0 i = colvar%xyz_diag_param%i_atom - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ! Create a List of points... ALLOCATE (list(np)) i = colvar%xyz_diag_param%i_atom @@ -874,9 +874,9 @@ SUBROUTINE colvar_setup(colvar) ! Number of real atoms involved in the colvar colvar%n_atom_s = 0 i = colvar%xyz_outerdiag_param%i_atoms(1) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) i = colvar%xyz_outerdiag_param%i_atoms(2) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ! Create a List of points... ALLOCATE (list(np)) i = colvar%xyz_outerdiag_param%i_atoms(1) @@ -893,13 +893,13 @@ SUBROUTINE colvar_setup(colvar) colvar%n_atom_s = 0 DO ii = 1, 3 i = colvar%Wc%ids(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO ! Create a List of points... ALLOCATE (list(np)) idum = 0 DO ii = 1, 3 - idum = idum+1 + idum = idum + 1 i = colvar%Wc%ids(ii) list(idum) = i ENDDO @@ -911,7 +911,7 @@ SUBROUTINE colvar_setup(colvar) DO j = 1, colvar%HBP%nPoints DO ii = 1, 3 i = colvar%HBP%ids(j, ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO ENDDO ! Create a List of points... @@ -919,7 +919,7 @@ SUBROUTINE colvar_setup(colvar) idum = 0 DO j = 1, colvar%HBP%nPoints DO ii = 1, 3 - idum = idum+1 + idum = idum + 1 i = colvar%HBP%ids(j, ii) list(idum) = i ENDDO @@ -931,49 +931,49 @@ SUBROUTINE colvar_setup(colvar) colvar%n_atom_s = 0 DO ii = 1, colvar%ring_puckering_param%nring i = colvar%ring_puckering_param%atoms(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO ! Create a List of points... ALLOCATE (list(np)) idum = 0 DO ii = 1, colvar%ring_puckering_param%nring - idum = idum+1 + idum = idum + 1 i = colvar%ring_puckering_param%atoms(ii) list(idum) = i ENDDO CPASSERT(idum == np) CASE (mindist_colvar_id) - np = colvar%mindist_param%n_dist_from+ & - colvar%mindist_param%n_coord_from+colvar%mindist_param%n_coord_to + np = colvar%mindist_param%n_dist_from + & + colvar%mindist_param%n_coord_from + colvar%mindist_param%n_coord_to ! Number of real atoms involved in the colvar colvar%n_atom_s = 0 DO ii = 1, colvar%mindist_param%n_dist_from i = colvar%mindist_param%i_dist_from(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO DO ii = 1, colvar%mindist_param%n_coord_from i = colvar%mindist_param%i_coord_from(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO DO ii = 1, colvar%mindist_param%n_coord_to i = colvar%mindist_param%i_coord_to(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO ! Create a List of points... ALLOCATE (list(np)) idum = 0 DO ii = 1, colvar%mindist_param%n_dist_from - idum = idum+1 + idum = idum + 1 i = colvar%mindist_param%i_dist_from(ii) list(idum) = i ENDDO DO ii = 1, colvar%mindist_param%n_coord_from - idum = idum+1 + idum = idum + 1 i = colvar%mindist_param%i_coord_from(ii) list(idum) = i ENDDO DO ii = 1, colvar%mindist_param%n_coord_to - idum = idum+1 + idum = idum + 1 i = colvar%mindist_param%i_coord_to(ii) list(idum) = i ENDDO @@ -981,13 +981,13 @@ SUBROUTINE colvar_setup(colvar) CASE (combine_colvar_id) colvar%n_atom_s = 0 DO ii = 1, SIZE(colvar%combine_cvs_param%colvar_p) - colvar%n_atom_s = colvar%n_atom_s+colvar%combine_cvs_param%colvar_p(ii)%colvar%n_atom_s + colvar%n_atom_s = colvar%n_atom_s + colvar%combine_cvs_param%colvar_p(ii)%colvar%n_atom_s END DO ALLOCATE (list(colvar%n_atom_s)) idum = 0 DO ii = 1, SIZE(colvar%combine_cvs_param%colvar_p) DO j = 1, colvar%combine_cvs_param%colvar_p(ii)%colvar%n_atom_s - idum = idum+1 + idum = idum + 1 list(idum) = colvar%combine_cvs_param%colvar_p(ii)%colvar%i_atom(j) END DO END DO @@ -1008,11 +1008,11 @@ SUBROUTINE colvar_setup(colvar) IF (.NOT. colvar%use_points) THEN ! No point centers colvar%i_atom(i) = list(i) - iend = iend+1 + iend = iend + 1 ELSE IF (ASSOCIATED(colvar%points(list(i))%atoms)) THEN - iend = istart+SIZE(colvar%points(list(i))%atoms) - colvar%i_atom(istart+1:iend) = colvar%points(list(i))%atoms + iend = istart + SIZE(colvar%points(list(i))%atoms) + colvar%i_atom(istart + 1:iend) = colvar%points(list(i))%atoms istart = iend END IF END IF @@ -1055,33 +1055,33 @@ SUBROUTINE setup_hydronium_colvars(colvar, colvar_id, list) i_hydrogens => colvar%hydronium_dist_param%i_hydrogens END SELECT - np = n_oxygens+n_hydrogens + np = n_oxygens + n_hydrogens ! Number of real atoms involved in the colvar colvar%n_atom_s = 0 DO ii = 1, n_oxygens i = i_oxygens(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO DO ii = 1, n_hydrogens i = i_hydrogens(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO idum = 0 DO ii = 1, n_oxygens - idum = idum+1 + idum = idum + 1 i = i_oxygens(ii) list(idum) = i IF (ANY(i_hydrogens == i)) & CPABORT("COLVAR: atoms doubled in OXYGENS and HYDROGENS list") ENDDO DO ii = 1, n_hydrogens - idum = idum+1 + idum = idum + 1 i = i_hydrogens(ii) list(idum) = i ENDDO CPASSERT(idum == np) DO i = 1, np - DO ii = i+1, np + DO ii = i + 1, np IF (list(i) == list(ii)) THEN IF (i <= n_oxygens) & CPABORT("atoms doubled in OXYGENS list") @@ -1133,24 +1133,24 @@ SUBROUTINE setup_acid_hydronium_colvars(colvar, colvar_id, list) i_hydrogens => colvar%acid_hyd_shell_param%i_hydrogens END SELECT - np = n_oxygens_water+n_oxygens_acid+n_hydrogens + np = n_oxygens_water + n_oxygens_acid + n_hydrogens ! Number of real atoms involved in the colvar colvar%n_atom_s = 0 DO ii = 1, n_oxygens_water i = i_oxygens_water(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO DO ii = 1, n_oxygens_acid i = i_oxygens_acid(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO DO ii = 1, n_hydrogens i = i_hydrogens(ii) - colvar%n_atom_s = colvar%n_atom_s+COLV_SIZE(colvar, i) + colvar%n_atom_s = colvar%n_atom_s + COLV_SIZE(colvar, i) ENDDO idum = 0 DO ii = 1, n_oxygens_water - idum = idum+1 + idum = idum + 1 i = i_oxygens_water(ii) list(idum) = i IF (ANY(i_hydrogens == i)) & @@ -1159,26 +1159,26 @@ SUBROUTINE setup_acid_hydronium_colvars(colvar, colvar_id, list) CPABORT("COLVAR: atoms doubled in OXYGENS_WATER and OXYGENS_ACID list") ENDDO DO ii = 1, n_oxygens_acid - idum = idum+1 + idum = idum + 1 i = i_oxygens_acid(ii) list(idum) = i IF (ANY(i_hydrogens == i)) & CPABORT("COLVAR: atoms doubled in OXYGENS_ACID and HYDROGENS list") ENDDO DO ii = 1, n_hydrogens - idum = idum+1 + idum = idum + 1 i = i_hydrogens(ii) list(idum) = i ENDDO CPASSERT(idum == np) DO i = 1, np - DO ii = i+1, np + DO ii = i + 1, np IF (list(i) == list(ii)) THEN IF (i <= n_oxygens_water) & CPABORT("atoms doubled in OXYGENS_WATER list") - IF (i > n_oxygens_water .AND. i <= n_oxygens_water+n_oxygens_acid) & + IF (i > n_oxygens_water .AND. i <= n_oxygens_water + n_oxygens_acid) & CPABORT("atoms doubled in OXYGENS_ACID list") - IF (i > n_oxygens_water+n_oxygens_acid) & + IF (i > n_oxygens_water + n_oxygens_acid) & CPABORT("atoms doubled in HYDROGENS list") ENDIF ENDDO @@ -1408,8 +1408,8 @@ RECURSIVE SUBROUTINE colvar_clone(colvar_out, colvar_in, i_atom_offset) IF (colvar_in%use_points) my_offset = 0 SELECT CASE (colvar_out%type_id) CASE (dist_colvar_id) - colvar_out%dist_param%i_at = colvar_in%dist_param%i_at+my_offset - colvar_out%dist_param%j_at = colvar_in%dist_param%j_at+my_offset + colvar_out%dist_param%i_at = colvar_in%dist_param%i_at + my_offset + colvar_out%dist_param%j_at = colvar_in%dist_param%j_at + my_offset colvar_out%dist_param%axis_id = colvar_in%dist_param%axis_id CASE (coord_colvar_id) colvar_out%coord_param%n_atoms_to = colvar_in%coord_param%n_atoms_to @@ -1436,7 +1436,7 @@ RECURSIVE SUBROUTINE colvar_clone(colvar_out, colvar_in, i_atom_offset) ! INDEX ndim = SIZE(colvar_in%coord_param%i_at_from) ALLOCATE (colvar_out%coord_param%i_at_from(ndim)) - colvar_out%coord_param%i_at_from = colvar_in%coord_param%i_at_from+my_offset + colvar_out%coord_param%i_at_from = colvar_in%coord_param%i_at_from + my_offset END IF IF (colvar_in%coord_param%use_kinds_to) THEN ! KINDS @@ -1447,7 +1447,7 @@ RECURSIVE SUBROUTINE colvar_clone(colvar_out, colvar_in, i_atom_offset) ! INDEX ndim = SIZE(colvar_in%coord_param%i_at_to) ALLOCATE (colvar_out%coord_param%i_at_to(ndim)) - colvar_out%coord_param%i_at_to = colvar_in%coord_param%i_at_to+my_offset + colvar_out%coord_param%i_at_to = colvar_in%coord_param%i_at_to + my_offset END IF IF (colvar_in%coord_param%use_kinds_to_b) THEN ! KINDS @@ -1458,7 +1458,7 @@ RECURSIVE SUBROUTINE colvar_clone(colvar_out, colvar_in, i_atom_offset) ! INDEX ndim = SIZE(colvar_in%coord_param%i_at_to_b) ALLOCATE (colvar_out%coord_param%i_at_to_b(ndim)) - colvar_out%coord_param%i_at_to_b = colvar_in%coord_param%i_at_to_b+my_offset + colvar_out%coord_param%i_at_to_b = colvar_in%coord_param%i_at_to_b + my_offset END IF CASE (population_colvar_id) @@ -1480,7 +1480,7 @@ RECURSIVE SUBROUTINE colvar_clone(colvar_out, colvar_in, i_atom_offset) ! INDEX ndim = SIZE(colvar_in%population_param%i_at_from) ALLOCATE (colvar_out%population_param%i_at_from(ndim)) - colvar_out%population_param%i_at_from = colvar_in%population_param%i_at_from+my_offset + colvar_out%population_param%i_at_from = colvar_in%population_param%i_at_from + my_offset END IF IF (colvar_in%population_param%use_kinds_to) THEN ! KINDS @@ -1491,7 +1491,7 @@ RECURSIVE SUBROUTINE colvar_clone(colvar_out, colvar_in, i_atom_offset) ! INDEX ndim = SIZE(colvar_in%population_param%i_at_to) ALLOCATE (colvar_out%population_param%i_at_to(ndim)) - colvar_out%population_param%i_at_to = colvar_in%population_param%i_at_to+my_offset + colvar_out%population_param%i_at_to = colvar_in%population_param%i_at_to + my_offset END IF CASE (gyration_colvar_id) @@ -1507,38 +1507,38 @@ RECURSIVE SUBROUTINE colvar_clone(colvar_out, colvar_in, i_atom_offset) ! INDEX ndim = SIZE(colvar_in%gyration_param%i_at) ALLOCATE (colvar_out%gyration_param%i_at(ndim)) - colvar_out%gyration_param%i_at = colvar_in%gyration_param%i_at+my_offset + colvar_out%gyration_param%i_at = colvar_in%gyration_param%i_at + my_offset END IF CASE (angle_colvar_id) - colvar_out%angle_param%i_at_angle = colvar_in%angle_param%i_at_angle+my_offset + colvar_out%angle_param%i_at_angle = colvar_in%angle_param%i_at_angle + my_offset CASE (torsion_colvar_id) - colvar_out%torsion_param%i_at_tors = colvar_in%torsion_param%i_at_tors+my_offset + colvar_out%torsion_param%i_at_tors = colvar_in%torsion_param%i_at_tors + my_offset colvar_out%torsion_param%o0 = colvar_in%torsion_param%o0 CASE (plane_distance_colvar_id) colvar_out%plane_distance_param%use_pbc = colvar_in%plane_distance_param%use_pbc - colvar_out%plane_distance_param%plane = colvar_in%plane_distance_param%plane+my_offset - colvar_out%plane_distance_param%point = colvar_in%plane_distance_param%point+my_offset + colvar_out%plane_distance_param%plane = colvar_in%plane_distance_param%plane + my_offset + colvar_out%plane_distance_param%point = colvar_in%plane_distance_param%point + my_offset CASE (plane_plane_angle_colvar_id) colvar_out%plane_plane_angle_param%plane1%type_of_def = colvar_in%plane_plane_angle_param%plane1%type_of_def IF (colvar_out%plane_plane_angle_param%plane1%type_of_def == plane_def_vec) THEN colvar_out%plane_plane_angle_param%plane1%normal_vec = colvar_in%plane_plane_angle_param%plane1%normal_vec ELSE - colvar_out%plane_plane_angle_param%plane1%points = colvar_in%plane_plane_angle_param%plane1%points+my_offset + colvar_out%plane_plane_angle_param%plane1%points = colvar_in%plane_plane_angle_param%plane1%points + my_offset END IF colvar_out%plane_plane_angle_param%plane2%type_of_def = colvar_in%plane_plane_angle_param%plane2%type_of_def IF (colvar_out%plane_plane_angle_param%plane2%type_of_def == plane_def_vec) THEN colvar_out%plane_plane_angle_param%plane2%normal_vec = colvar_in%plane_plane_angle_param%plane2%normal_vec ELSE - colvar_out%plane_plane_angle_param%plane2%points = colvar_in%plane_plane_angle_param%plane2%points+my_offset + colvar_out%plane_plane_angle_param%plane2%points = colvar_in%plane_plane_angle_param%plane2%points + my_offset END IF CASE (rotation_colvar_id) - colvar_out%rotation_param%i_at1_bond1 = colvar_in%rotation_param%i_at1_bond1+my_offset - colvar_out%rotation_param%i_at2_bond1 = colvar_in%rotation_param%i_at2_bond1+my_offset - colvar_out%rotation_param%i_at1_bond2 = colvar_in%rotation_param%i_at1_bond2+my_offset - colvar_out%rotation_param%i_at2_bond2 = colvar_in%rotation_param%i_at2_bond2+my_offset + colvar_out%rotation_param%i_at1_bond1 = colvar_in%rotation_param%i_at1_bond1 + my_offset + colvar_out%rotation_param%i_at2_bond1 = colvar_in%rotation_param%i_at2_bond1 + my_offset + colvar_out%rotation_param%i_at1_bond2 = colvar_in%rotation_param%i_at1_bond2 + my_offset + colvar_out%rotation_param%i_at2_bond2 = colvar_in%rotation_param%i_at2_bond2 + my_offset CASE (dfunct_colvar_id) - colvar_out%dfunct_param%i_at_dfunct = colvar_in%dfunct_param%i_at_dfunct+my_offset + colvar_out%dfunct_param%i_at_dfunct = colvar_in%dfunct_param%i_at_dfunct + my_offset colvar_out%dfunct_param%coeff = colvar_in%dfunct_param%coeff colvar_out%dfunct_param%use_pbc = colvar_in%dfunct_param%use_pbc CASE (qparm_colvar_id) @@ -1552,16 +1552,16 @@ RECURSIVE SUBROUTINE colvar_clone(colvar_out, colvar_in, i_atom_offset) ALLOCATE (colvar_out%qparm_param%i_at_from(ndim)) ndim = SIZE(colvar_in%qparm_param%i_at_to) ALLOCATE (colvar_out%qparm_param%i_at_to(ndim)) - colvar_out%qparm_param%i_at_from = colvar_in%qparm_param%i_at_from+my_offset - colvar_out%qparm_param%i_at_to = colvar_in%qparm_param%i_at_from+my_offset + colvar_out%qparm_param%i_at_from = colvar_in%qparm_param%i_at_from + my_offset + colvar_out%qparm_param%i_at_to = colvar_in%qparm_param%i_at_from + my_offset CASE (xyz_diag_colvar_id) - colvar_out%xyz_diag_param%i_atom = colvar_in%xyz_diag_param%i_atom+my_offset + colvar_out%xyz_diag_param%i_atom = colvar_in%xyz_diag_param%i_atom + my_offset colvar_out%xyz_diag_param%component = colvar_in%xyz_diag_param%component colvar_out%xyz_diag_param%r0 = colvar_in%xyz_diag_param%r0 colvar_out%xyz_diag_param%use_pbc = colvar_in%xyz_diag_param%use_pbc colvar_out%xyz_diag_param%use_absolute_position = colvar_in%xyz_diag_param%use_absolute_position CASE (xyz_outerdiag_colvar_id) - colvar_out%xyz_outerdiag_param%i_atoms = colvar_in%xyz_outerdiag_param%i_atoms+my_offset + colvar_out%xyz_outerdiag_param%i_atoms = colvar_in%xyz_outerdiag_param%i_atoms + my_offset colvar_out%xyz_outerdiag_param%components = colvar_in%xyz_outerdiag_param%components colvar_out%xyz_outerdiag_param%r0 = colvar_in%xyz_outerdiag_param%r0 colvar_out%xyz_outerdiag_param%use_pbc = colvar_in%xyz_outerdiag_param%use_pbc @@ -1584,8 +1584,8 @@ RECURSIVE SUBROUTINE colvar_clone(colvar_out, colvar_in, i_atom_offset) ALLOCATE (colvar_out%hydronium_shell_param%i_oxygens(ndim)) ndim = SIZE(colvar_in%hydronium_shell_param%i_hydrogens) ALLOCATE (colvar_out%hydronium_shell_param%i_hydrogens(ndim)) - colvar_out%hydronium_shell_param%i_oxygens = colvar_in%hydronium_shell_param%i_oxygens+my_offset - colvar_out%hydronium_shell_param%i_hydrogens = colvar_in%hydronium_shell_param%i_hydrogens+my_offset + colvar_out%hydronium_shell_param%i_oxygens = colvar_in%hydronium_shell_param%i_oxygens + my_offset + colvar_out%hydronium_shell_param%i_hydrogens = colvar_in%hydronium_shell_param%i_hydrogens + my_offset CASE (hydronium_dist_colvar_id) colvar_out%hydronium_dist_param%n_hydrogens = colvar_in%hydronium_dist_param%n_hydrogens colvar_out%hydronium_dist_param%n_oxygens = colvar_in%hydronium_dist_param%n_oxygens @@ -1603,8 +1603,8 @@ RECURSIVE SUBROUTINE colvar_clone(colvar_out, colvar_in, i_atom_offset) ALLOCATE (colvar_out%hydronium_dist_param%i_oxygens(ndim)) ndim = SIZE(colvar_in%hydronium_dist_param%i_hydrogens) ALLOCATE (colvar_out%hydronium_dist_param%i_hydrogens(ndim)) - colvar_out%hydronium_dist_param%i_oxygens = colvar_in%hydronium_dist_param%i_oxygens+my_offset - colvar_out%hydronium_dist_param%i_hydrogens = colvar_in%hydronium_dist_param%i_hydrogens+my_offset + colvar_out%hydronium_dist_param%i_oxygens = colvar_in%hydronium_dist_param%i_oxygens + my_offset + colvar_out%hydronium_dist_param%i_hydrogens = colvar_in%hydronium_dist_param%i_hydrogens + my_offset CASE (acid_hyd_dist_colvar_id) colvar_out%acid_hyd_dist_param%n_hydrogens = colvar_in%acid_hyd_dist_param%n_hydrogens colvar_out%acid_hyd_dist_param%n_oxygens_water = colvar_in%acid_hyd_dist_param%n_oxygens_water @@ -1625,9 +1625,9 @@ RECURSIVE SUBROUTINE colvar_clone(colvar_out, colvar_in, i_atom_offset) ALLOCATE (colvar_out%acid_hyd_dist_param%i_oxygens_acid(ndim)) ndim = SIZE(colvar_in%acid_hyd_dist_param%i_hydrogens) ALLOCATE (colvar_out%acid_hyd_dist_param%i_hydrogens(ndim)) - colvar_out%acid_hyd_dist_param%i_oxygens_water = colvar_in%acid_hyd_dist_param%i_oxygens_water+my_offset - colvar_out%acid_hyd_dist_param%i_oxygens_acid = colvar_in%acid_hyd_dist_param%i_oxygens_acid+my_offset - colvar_out%acid_hyd_dist_param%i_hydrogens = colvar_in%acid_hyd_dist_param%i_hydrogens+my_offset + colvar_out%acid_hyd_dist_param%i_oxygens_water = colvar_in%acid_hyd_dist_param%i_oxygens_water + my_offset + colvar_out%acid_hyd_dist_param%i_oxygens_acid = colvar_in%acid_hyd_dist_param%i_oxygens_acid + my_offset + colvar_out%acid_hyd_dist_param%i_hydrogens = colvar_in%acid_hyd_dist_param%i_hydrogens + my_offset CASE (acid_hyd_shell_colvar_id) colvar_out%acid_hyd_shell_param%n_hydrogens = colvar_in%acid_hyd_shell_param%n_hydrogens colvar_out%acid_hyd_shell_param%n_oxygens_water = colvar_in%acid_hyd_shell_param%n_oxygens_water @@ -1654,9 +1654,9 @@ RECURSIVE SUBROUTINE colvar_clone(colvar_out, colvar_in, i_atom_offset) ALLOCATE (colvar_out%acid_hyd_shell_param%i_oxygens_acid(ndim)) ndim = SIZE(colvar_in%acid_hyd_shell_param%i_hydrogens) ALLOCATE (colvar_out%acid_hyd_shell_param%i_hydrogens(ndim)) - colvar_out%acid_hyd_shell_param%i_oxygens_water = colvar_in%acid_hyd_shell_param%i_oxygens_water+my_offset - colvar_out%acid_hyd_shell_param%i_oxygens_acid = colvar_in%acid_hyd_shell_param%i_oxygens_acid+my_offset - colvar_out%acid_hyd_shell_param%i_hydrogens = colvar_in%acid_hyd_shell_param%i_hydrogens+my_offset + colvar_out%acid_hyd_shell_param%i_oxygens_water = colvar_in%acid_hyd_shell_param%i_oxygens_water + my_offset + colvar_out%acid_hyd_shell_param%i_oxygens_acid = colvar_in%acid_hyd_shell_param%i_oxygens_acid + my_offset + colvar_out%acid_hyd_shell_param%i_hydrogens = colvar_in%acid_hyd_shell_param%i_hydrogens + my_offset CASE (reaction_path_colvar_id, distance_from_path_colvar_id) colvar_out%reaction_path_param%dist_rmsd = colvar_in%reaction_path_param%dist_rmsd colvar_out%reaction_path_param%rmsd = colvar_in%reaction_path_param%rmsd @@ -1727,7 +1727,7 @@ RECURSIVE SUBROUTINE colvar_clone(colvar_out, colvar_in, i_atom_offset) ! INDEX ndim = SIZE(colvar_in%rmsd_param%i_rmsd) ALLOCATE (colvar_out%rmsd_param%i_rmsd(ndim)) - colvar_out%rmsd_param%i_rmsd = colvar_in%rmsd_param%i_rmsd+my_offset + colvar_out%rmsd_param%i_rmsd = colvar_in%rmsd_param%i_rmsd + my_offset ! A and Bconfigurations and weights ndim = SIZE(colvar_in%rmsd_param%weights) ALLOCATE (colvar_out%rmsd_param%weights(ndim)) @@ -1737,14 +1737,14 @@ RECURSIVE SUBROUTINE colvar_clone(colvar_out, colvar_in, i_atom_offset) ALLOCATE (colvar_out%rmsd_param%r_ref(ndim, ndim2)) colvar_out%rmsd_param%r_ref = colvar_in%rmsd_param%r_ref CASE (Wc_colvar_id) - colvar_out%Wc%ids = colvar_in%Wc%ids+my_offset + colvar_out%Wc%ids = colvar_in%Wc%ids + my_offset colvar_out%Wc%rcut = colvar_in%Wc%rcut CASE (HBP_colvar_id) ndim = colvar_out%HBP%nPoints ALLOCATE (colvar_out%HBP%ids(ndim, 3)) ALLOCATE (colvar_out%HBP%ewc(ndim)) - colvar_out%HBP%ids = colvar_in%HBP%ids+my_offset - colvar_out%HBP%ewc = colvar_in%HBP%ewc+my_offset + colvar_out%HBP%ids = colvar_in%HBP%ids + my_offset + colvar_out%HBP%ewc = colvar_in%HBP%ewc + my_offset colvar_out%HBP%nPoints = colvar_in%HBP%nPoints colvar_out%HBP%rcut = colvar_in%HBP%rcut colvar_out%HBP%shift = colvar_in%HBP%shift @@ -1753,7 +1753,7 @@ RECURSIVE SUBROUTINE colvar_clone(colvar_out, colvar_in, i_atom_offset) colvar_out%ring_puckering_param%nring = colvar_in%ring_puckering_param%nring colvar_out%ring_puckering_param%iq = colvar_in%ring_puckering_param%iq ALLOCATE (colvar_out%ring_puckering_param%atoms(ndim)) - colvar_out%ring_puckering_param%atoms = colvar_in%ring_puckering_param%atoms+my_offset + colvar_out%ring_puckering_param%atoms = colvar_in%ring_puckering_param%atoms + my_offset CASE (mindist_colvar_id) colvar_out%mindist_param%n_dist_from = colvar_in%mindist_param%n_dist_from colvar_out%mindist_param%n_coord_to = colvar_in%mindist_param%n_coord_to @@ -1770,7 +1770,7 @@ RECURSIVE SUBROUTINE colvar_clone(colvar_out, colvar_in, i_atom_offset) ! INDEX ndim = SIZE(colvar_in%mindist_param%i_dist_from) ALLOCATE (colvar_out%mindist_param%i_dist_from(ndim)) - colvar_out%mindist_param%i_dist_from = colvar_in%mindist_param%i_dist_from+my_offset + colvar_out%mindist_param%i_dist_from = colvar_in%mindist_param%i_dist_from + my_offset IF (colvar_in%mindist_param%use_kinds_from) THEN ! KINDS ndim = SIZE(colvar_in%mindist_param%k_coord_from) @@ -1780,7 +1780,7 @@ RECURSIVE SUBROUTINE colvar_clone(colvar_out, colvar_in, i_atom_offset) ! INDEX ndim = SIZE(colvar_in%mindist_param%i_coord_from) ALLOCATE (colvar_out%mindist_param%i_coord_from(ndim)) - colvar_out%mindist_param%i_coord_from = colvar_in%mindist_param%i_coord_from+my_offset + colvar_out%mindist_param%i_coord_from = colvar_in%mindist_param%i_coord_from + my_offset END IF IF (colvar_in%mindist_param%use_kinds_to) THEN ! KINDS @@ -1791,7 +1791,7 @@ RECURSIVE SUBROUTINE colvar_clone(colvar_out, colvar_in, i_atom_offset) ! INDEX ndim = SIZE(colvar_in%mindist_param%i_coord_to) ALLOCATE (colvar_out%mindist_param%i_coord_to(ndim)) - colvar_out%mindist_param%i_coord_to = colvar_in%mindist_param%i_coord_to+my_offset + colvar_out%mindist_param%i_coord_to = colvar_in%mindist_param%i_coord_to + my_offset END IF END SELECT @@ -1823,7 +1823,7 @@ SUBROUTINE colvar_clone_points(colvar_out, colvar_in, offset) IF (ASSOCIATED(colvar_in%points(i)%atoms)) THEN natoms = SIZE(colvar_in%points(i)%atoms) ALLOCATE (colvar_out%points(i)%atoms(natoms)) - colvar_out%points(i)%atoms = colvar_in%points(i)%atoms+offset + colvar_out%points(i)%atoms = colvar_in%points(i)%atoms + offset ELSE NULLIFY (colvar_out%points(i)%atoms) END IF @@ -1939,7 +1939,7 @@ SUBROUTINE eval_point_pos(point, particles, r) CASE (do_clv_geo_center) r = 0.0_dp DO i = 1, SIZE(point%atoms) - r = r+particles(point%atoms(i))%r*point%weights(i) + r = r + particles(point%atoms(i))%r*point%weights(i) END DO CASE (do_clv_fix_point) r = point%r @@ -1964,7 +1964,7 @@ SUBROUTINE eval_point_mass(point, particles, m) CASE (do_clv_geo_center) m = 0.0_dp DO i = 1, SIZE(point%atoms) - m = m+particles(point%atoms(i))%atomic_kind%mass*point%weights(i) + m = m + particles(point%atoms(i))%atomic_kind%mass*point%weights(i) END DO CASE (do_clv_fix_point) m = 0.0_dp @@ -1989,17 +1989,17 @@ SUBROUTINE eval_point_der(points, i, dsdr, f) INTEGER :: ind, j REAL(KIND=dp) :: fac - SELECT CASE (points (i)%type_id) + SELECT CASE (points(i)%type_id) CASE (do_clv_geo_center) ind = 0 - DO j = 1, i-1 + DO j = 1, i - 1 IF (ASSOCIATED(points(j)%atoms)) THEN - ind = ind+SIZE(points(j)%atoms) + ind = ind + SIZE(points(j)%atoms) END IF END DO DO j = 1, SIZE(points(i)%atoms) fac = points(i)%weights(j) - dsdr(:, ind+j) = dsdr(:, ind+j)+f*fac + dsdr(:, ind + j) = dsdr(:, ind + j) + f*fac END DO CASE (do_clv_fix_point) ! Do nothing if it's a fixed point in space @@ -2022,7 +2022,7 @@ FUNCTION diff_colvar(colvar, b) RESULT(diff) CHARACTER(len=*), PARAMETER :: routineN = 'diff_colvar', routineP = moduleN//':'//routineN - diff = colvar%ss-b + diff = colvar%ss - b IF (colvar%type_id == torsion_colvar_id) THEN ! The difference of a periodic COLVAR is always within [-pi,pi] diff = SIGN(1.0_dp, ASIN(SIN(diff)))*ACOS(COS(diff)) diff --git a/src/subsys/cp_subsys_types.F b/src/subsys/cp_subsys_types.F index 7d3a87aca5..0cf548d223 100644 --- a/src/subsys/cp_subsys_types.F +++ b/src/subsys/cp_subsys_types.F @@ -141,7 +141,7 @@ SUBROUTINE cp_subsys_retain(subsys) CPASSERT(ASSOCIATED(subsys)) CPASSERT(subsys%ref_count > 0) - subsys%ref_count = subsys%ref_count+1 + subsys%ref_count = subsys%ref_count + 1 END SUBROUTINE cp_subsys_retain ! ************************************************************************************************** @@ -159,7 +159,7 @@ SUBROUTINE cp_subsys_release(subsys) IF (ASSOCIATED(subsys)) THEN CPASSERT(subsys%ref_count > 0) - subsys%ref_count = subsys%ref_count-1 + subsys%ref_count = subsys%ref_count - 1 IF (subsys%ref_count == 0) THEN CALL atomic_kind_list_release(subsys%atomic_kinds) CALL particle_list_release(subsys%particles) @@ -427,7 +427,7 @@ SUBROUTINE cp_subsys_get(subsys, ref_count, atomic_kinds, atomic_kind_set, & n_shell = 0 END IF IF (PRESENT(natom)) natom = n_atom - IF (PRESENT(nparticle)) nparticle = n_atom+n_shell + IF (PRESENT(nparticle)) nparticle = n_atom + n_shell IF (PRESENT(ncore)) ncore = n_core IF (PRESENT(nshell)) nshell = n_shell END IF @@ -492,17 +492,17 @@ SUBROUTINE pack_subsys_particles(subsys, f, r, s, v, fscale, cell) shell_index = particles%els(iatom)%shell_index IF (shell_index == 0) THEN DO i = 1, 3 - j = j+1 + j = j + 1 f(j) = particles%els(iatom)%f(i) END DO ELSE DO i = 1, 3 - j = j+1 + j = j + 1 f(j) = core_particles%els(shell_index)%f(i) END DO - k = 3*(natom+shell_index-1) + k = 3*(natom + shell_index - 1) DO i = 1, 3 - f(k+i) = shell_particles%els(shell_index)%f(i) + f(k + i) = shell_particles%els(shell_index)%f(i) END DO END IF END DO @@ -518,17 +518,17 @@ SUBROUTINE pack_subsys_particles(subsys, f, r, s, v, fscale, cell) shell_index = particles%els(iatom)%shell_index IF (shell_index == 0) THEN DO i = 1, 3 - j = j+1 + j = j + 1 r(j) = particles%els(iatom)%r(i) END DO ELSE DO i = 1, 3 - j = j+1 + j = j + 1 r(j) = core_particles%els(shell_index)%r(i) END DO - k = 3*(natom+shell_index-1) + k = 3*(natom + shell_index - 1) DO i = 1, 3 - r(k+i) = shell_particles%els(shell_index)%r(i) + r(k + i) = shell_particles%els(shell_index)%r(i) END DO END IF END DO @@ -545,19 +545,19 @@ SUBROUTINE pack_subsys_particles(subsys, f, r, s, v, fscale, cell) IF (shell_index == 0) THEN CALL real_to_scaled(rs, particles%els(iatom)%r, cell) DO i = 1, 3 - j = j+1 + j = j + 1 s(j) = rs(i) END DO ELSE CALL real_to_scaled(rs, core_particles%els(shell_index)%r, cell) DO i = 1, 3 - j = j+1 + j = j + 1 s(j) = rs(i) END DO CALL real_to_scaled(rs, shell_particles%els(shell_index)%r, cell) - k = 3*(natom+shell_index-1) + k = 3*(natom + shell_index - 1) DO i = 1, 3 - s(k+i) = rs(i) + s(k + i) = rs(i) END DO END IF END DO @@ -572,17 +572,17 @@ SUBROUTINE pack_subsys_particles(subsys, f, r, s, v, fscale, cell) shell_index = particles%els(iatom)%shell_index IF (shell_index == 0) THEN DO i = 1, 3 - j = j+1 + j = j + 1 v(j) = particles%els(iatom)%v(i) END DO ELSE DO i = 1, 3 - j = j+1 + j = j + 1 v(j) = core_particles%els(shell_index)%v(i) END DO - k = 3*(natom+shell_index-1) + k = 3*(natom + shell_index - 1) DO i = 1, 3 - v(k+i) = shell_particles%els(shell_index)%v(i) + v(k + i) = shell_particles%els(shell_index)%v(i) END DO END IF END DO @@ -649,17 +649,17 @@ SUBROUTINE unpack_subsys_particles(subsys, f, r, s, v, fscale, cell) shell_index = particles%els(iatom)%shell_index IF (shell_index == 0) THEN DO i = 1, 3 - j = j+1 + j = j + 1 particles%els(iatom)%f(i) = my_fscale*f(j) END DO ELSE DO i = 1, 3 - j = j+1 + j = j + 1 core_particles%els(shell_index)%f(i) = my_fscale*f(j) END DO - k = 3*(natom+shell_index-1) + k = 3*(natom + shell_index - 1) DO i = 1, 3 - shell_particles%els(shell_index)%f(i) = my_fscale*f(k+i) + shell_particles%els(shell_index)%f(i) = my_fscale*f(k + i) END DO END IF END DO @@ -674,23 +674,23 @@ SUBROUTINE unpack_subsys_particles(subsys, f, r, s, v, fscale, cell) shell_index = particles%els(iatom)%shell_index IF (shell_index == 0) THEN DO i = 1, 3 - j = j+1 + j = j + 1 particles%els(iatom)%r(i) = r(j) END DO ELSE DO i = 1, 3 - j = j+1 + j = j + 1 core_particles%els(shell_index)%r(i) = r(j) END DO - k = 3*(natom+shell_index-1) + k = 3*(natom + shell_index - 1) DO i = 1, 3 - shell_particles%els(shell_index)%r(i) = r(k+i) + shell_particles%els(shell_index)%r(i) = r(k + i) END DO ! Update atomic position due to core and shell motion mass = particles%els(iatom)%atomic_kind%mass fc = core_particles%els(shell_index)%atomic_kind%shell%mass_core/mass fs = shell_particles%els(shell_index)%atomic_kind%shell%mass_shell/mass - particles%els(iatom)%r(1:3) = fc*core_particles%els(shell_index)%r(1:3)+ & + particles%els(iatom)%r(1:3) = fc*core_particles%els(shell_index)%r(1:3) + & fs*shell_particles%els(shell_index)%r(1:3) END IF END DO @@ -706,26 +706,26 @@ SUBROUTINE unpack_subsys_particles(subsys, f, r, s, v, fscale, cell) shell_index = particles%els(iatom)%shell_index IF (shell_index == 0) THEN DO i = 1, 3 - j = j+1 + j = j + 1 rs(i) = s(j) END DO CALL scaled_to_real(particles%els(iatom)%r, rs, cell) ELSE DO i = 1, 3 - j = j+1 + j = j + 1 rs(i) = s(j) END DO CALL scaled_to_real(core_particles%els(shell_index)%r, rs, cell) - k = 3*(natom+shell_index-1) + k = 3*(natom + shell_index - 1) DO i = 1, 3 - rs(i) = s(k+i) + rs(i) = s(k + i) END DO CALL scaled_to_real(shell_particles%els(shell_index)%r, rs, cell) ! Update atomic position due to core and shell motion mass = particles%els(iatom)%atomic_kind%mass fc = core_particles%els(shell_index)%atomic_kind%shell%mass_core/mass fs = shell_particles%els(shell_index)%atomic_kind%shell%mass_shell/mass - particles%els(iatom)%r(1:3) = fc*core_particles%els(shell_index)%r(1:3)+ & + particles%els(iatom)%r(1:3) = fc*core_particles%els(shell_index)%r(1:3) + & fs*shell_particles%els(shell_index)%r(1:3) END IF END DO @@ -740,23 +740,23 @@ SUBROUTINE unpack_subsys_particles(subsys, f, r, s, v, fscale, cell) shell_index = particles%els(iatom)%shell_index IF (shell_index == 0) THEN DO i = 1, 3 - j = j+1 + j = j + 1 particles%els(iatom)%v(i) = v(j) END DO ELSE DO i = 1, 3 - j = j+1 + j = j + 1 core_particles%els(shell_index)%v(i) = v(j) END DO - k = 3*(natom+shell_index-1) + k = 3*(natom + shell_index - 1) DO i = 1, 3 - shell_particles%els(shell_index)%v(i) = v(k+i) + shell_particles%els(shell_index)%v(i) = v(k + i) END DO ! Update atomic velocity due to core and shell motion mass = particles%els(iatom)%atomic_kind%mass fc = core_particles%els(shell_index)%atomic_kind%shell%mass_core/mass fs = shell_particles%els(shell_index)%atomic_kind%shell%mass_shell/mass - particles%els(iatom)%v(1:3) = fc*core_particles%els(shell_index)%v(1:3)+ & + particles%els(iatom)%v(1:3) = fc*core_particles%els(shell_index)%v(1:3) + & fs*shell_particles%els(shell_index)%v(1:3) END IF END DO diff --git a/src/subsys/external_potential_types.F b/src/subsys/external_potential_types.F index 49c1de566f..5d39c4f714 100644 --- a/src/subsys/external_potential_types.F +++ b/src/subsys/external_potential_types.F @@ -1106,29 +1106,29 @@ SUBROUTINE init_cprj_ppnl(potential) DO l = 0, potential%lppnl alpha_ppnl = potential%alpha_ppnl(l) DO iprj_ppnl = 1, potential%nprj_ppnl(l) - lp = iprj_ppnl-1 - lprj_ppnl = l+2*lp - cp = SQRT(2.0_dp**(2.0_dp*REAL(lprj_ppnl, dp)+3.5_dp)* & - alpha_ppnl**(REAL(lprj_ppnl, dp)+1.5_dp)/ & - (rootpi*dfac(2*lprj_ppnl+1))) + lp = iprj_ppnl - 1 + lprj_ppnl = l + 2*lp + cp = SQRT(2.0_dp**(2.0_dp*REAL(lprj_ppnl, dp) + 3.5_dp)* & + alpha_ppnl**(REAL(lprj_ppnl, dp) + 1.5_dp)/ & + (rootpi*dfac(2*lprj_ppnl + 1))) potential%cprj_ppnl(iprj_ppnl, l) = cp DO cx = 0, l - DO cy = 0, l-cx - cz = l-cx-cy - iprj = nprj+co(cx, cy, cz) + DO cy = 0, l - cx + cz = l - cx - cy + iprj = nprj + co(cx, cy, cz) DO px = 0, lp - DO py = 0, lp-px - pz = lp-px-py - cpx = cx+2*px - cpy = cy+2*py - cpz = cz+2*pz + DO py = 0, lp - px + pz = lp - px - py + cpx = cx + 2*px + cpy = cy + 2*py + cpz = cz + 2*pz ico = coset(cpx, cpy, cpz) potential%cprj(ico, iprj) = cp*fac(lp)/(fac(px)*fac(py)*fac(pz)) END DO END DO END DO END DO - nprj = nprj+nco(l) + nprj = nprj + nco(l) END DO END DO @@ -1186,15 +1186,15 @@ SUBROUTINE init_vprj_ppnl(potential) DO l = 0, potential%lppnl DO iprj_ppnl = 1, potential%nprj_ppnl(l) - iprj = nprj+(iprj_ppnl-1)*nco(l) + iprj = nprj + (iprj_ppnl - 1)*nco(l) DO jprj_ppnl = 1, potential%nprj_ppnl(l) - jprj = nprj+(jprj_ppnl-1)*nco(l) + jprj = nprj + (jprj_ppnl - 1)*nco(l) DO ico = 1, nco(l) - i = iprj+ico + i = iprj + ico DO jco = 1, nco(l) - j = jprj+jco + j = jprj + jco DO iso = 1, nso(l) - potential%vprj_ppnl(i, j) = potential%vprj_ppnl(i, j)+ & + potential%vprj_ppnl(i, j) = potential%vprj_ppnl(i, j) + & orbtramat(l)%slm(iso, ico)* & potential%hprj_ppnl(iprj_ppnl, & jprj_ppnl, l)* & @@ -1204,7 +1204,7 @@ SUBROUTINE init_vprj_ppnl(potential) END DO END DO END DO - nprj = nprj+potential%nprj_ppnl(l)*nco(l) + nprj = nprj + potential%nprj_ppnl(l)*nco(l) END DO END SUBROUTINE init_vprj_ppnl @@ -1231,66 +1231,66 @@ SUBROUTINE init_all_potential(potential, itype, zeff, zeff_correction) IF (PRESENT(zeff)) potential%zeff = zeff IF (PRESENT(zeff_correction)) potential%zeff_correction = zeff_correction - dz = potential%z-INT(potential%zeff-potential%zeff_correction) + dz = potential%z - INT(potential%zeff - potential%zeff_correction) SELECT CASE (dz) CASE DEFAULT CASE (2) - potential%elec_conf(0) = potential%elec_conf(0)-2 + potential%elec_conf(0) = potential%elec_conf(0) - 2 CASE (10) - potential%elec_conf(0) = potential%elec_conf(0)-4 - potential%elec_conf(1) = potential%elec_conf(1)-6 + potential%elec_conf(0) = potential%elec_conf(0) - 4 + potential%elec_conf(1) = potential%elec_conf(1) - 6 CASE (18) - potential%elec_conf(0) = potential%elec_conf(0)-6 - potential%elec_conf(1) = potential%elec_conf(1)-12 + potential%elec_conf(0) = potential%elec_conf(0) - 6 + potential%elec_conf(1) = potential%elec_conf(1) - 12 CASE (28) - potential%elec_conf(0) = potential%elec_conf(0)-6 - potential%elec_conf(1) = potential%elec_conf(1)-12 - potential%elec_conf(2) = potential%elec_conf(2)-10 + potential%elec_conf(0) = potential%elec_conf(0) - 6 + potential%elec_conf(1) = potential%elec_conf(1) - 12 + potential%elec_conf(2) = potential%elec_conf(2) - 10 CASE (30) - potential%elec_conf(0) = potential%elec_conf(0)-8 - potential%elec_conf(1) = potential%elec_conf(1)-12 - potential%elec_conf(2) = potential%elec_conf(2)-10 + potential%elec_conf(0) = potential%elec_conf(0) - 8 + potential%elec_conf(1) = potential%elec_conf(1) - 12 + potential%elec_conf(2) = potential%elec_conf(2) - 10 CASE (36) - potential%elec_conf(0) = potential%elec_conf(0)-8 - potential%elec_conf(1) = potential%elec_conf(1)-18 - potential%elec_conf(2) = potential%elec_conf(2)-10 + potential%elec_conf(0) = potential%elec_conf(0) - 8 + potential%elec_conf(1) = potential%elec_conf(1) - 18 + potential%elec_conf(2) = potential%elec_conf(2) - 10 CASE (46) - potential%elec_conf(0) = potential%elec_conf(0)-8 - potential%elec_conf(1) = potential%elec_conf(1)-18 - potential%elec_conf(2) = potential%elec_conf(2)-20 + potential%elec_conf(0) = potential%elec_conf(0) - 8 + potential%elec_conf(1) = potential%elec_conf(1) - 18 + potential%elec_conf(2) = potential%elec_conf(2) - 20 CASE (48) - potential%elec_conf(0) = potential%elec_conf(0)-10 - potential%elec_conf(1) = potential%elec_conf(1)-18 - potential%elec_conf(2) = potential%elec_conf(2)-20 + potential%elec_conf(0) = potential%elec_conf(0) - 10 + potential%elec_conf(1) = potential%elec_conf(1) - 18 + potential%elec_conf(2) = potential%elec_conf(2) - 20 CASE (54) - potential%elec_conf(0) = potential%elec_conf(0)-10 - potential%elec_conf(1) = potential%elec_conf(1)-24 - potential%elec_conf(2) = potential%elec_conf(2)-20 + potential%elec_conf(0) = potential%elec_conf(0) - 10 + potential%elec_conf(1) = potential%elec_conf(1) - 24 + potential%elec_conf(2) = potential%elec_conf(2) - 20 CASE (68) - potential%elec_conf(0) = potential%elec_conf(0)-10 - potential%elec_conf(1) = potential%elec_conf(1)-24 - potential%elec_conf(2) = potential%elec_conf(2)-20 - potential%elec_conf(3) = potential%elec_conf(3)-14 + potential%elec_conf(0) = potential%elec_conf(0) - 10 + potential%elec_conf(1) = potential%elec_conf(1) - 24 + potential%elec_conf(2) = potential%elec_conf(2) - 20 + potential%elec_conf(3) = potential%elec_conf(3) - 14 CASE (78) - potential%elec_conf(0) = potential%elec_conf(0)-10 - potential%elec_conf(1) = potential%elec_conf(1)-24 - potential%elec_conf(2) = potential%elec_conf(2)-30 - potential%elec_conf(3) = potential%elec_conf(3)-14 + potential%elec_conf(0) = potential%elec_conf(0) - 10 + potential%elec_conf(1) = potential%elec_conf(1) - 24 + potential%elec_conf(2) = potential%elec_conf(2) - 30 + potential%elec_conf(3) = potential%elec_conf(3) - 14 CASE (80) - potential%elec_conf(0) = potential%elec_conf(0)-12 - potential%elec_conf(1) = potential%elec_conf(1)-24 - potential%elec_conf(2) = potential%elec_conf(2)-30 - potential%elec_conf(3) = potential%elec_conf(3)-14 + potential%elec_conf(0) = potential%elec_conf(0) - 12 + potential%elec_conf(1) = potential%elec_conf(1) - 24 + potential%elec_conf(2) = potential%elec_conf(2) - 30 + potential%elec_conf(3) = potential%elec_conf(3) - 14 CASE (86) - potential%elec_conf(0) = potential%elec_conf(0)-12 - potential%elec_conf(1) = potential%elec_conf(1)-30 - potential%elec_conf(2) = potential%elec_conf(2)-30 - potential%elec_conf(3) = potential%elec_conf(3)-14 + potential%elec_conf(0) = potential%elec_conf(0) - 12 + potential%elec_conf(1) = potential%elec_conf(1) - 30 + potential%elec_conf(2) = potential%elec_conf(2) - 30 + potential%elec_conf(3) = potential%elec_conf(3) - 14 CASE (100) - potential%elec_conf(0) = potential%elec_conf(0)-12 - potential%elec_conf(1) = potential%elec_conf(1)-30 - potential%elec_conf(2) = potential%elec_conf(2)-30 - potential%elec_conf(3) = potential%elec_conf(3)-28 + potential%elec_conf(0) = potential%elec_conf(0) - 12 + potential%elec_conf(1) = potential%elec_conf(1) - 30 + potential%elec_conf(2) = potential%elec_conf(2) - 30 + potential%elec_conf(3) = potential%elec_conf(3) - 28 END SELECT IF (PRESENT(itype)) THEN @@ -1331,7 +1331,7 @@ SUBROUTINE init_sgp_potential(potential) nprj = 0 DO l = 0, potential%lmax nnl = potential%n_nonlocal - IF (potential%is_nonlocal(l)) nprj = nprj+nnl*nso(l) + IF (potential%is_nonlocal(l)) nprj = nprj + nnl*nso(l) END DO ALLOCATE (potential%cprj_ppnl(potential%nppnl, nprj)) cprj => potential%cprj_ppnl @@ -1341,14 +1341,14 @@ SUBROUTINE init_sgp_potential(potential) ! n1 = 0 DO la = 0, potential%lmax - n1 = n1+nnl*nco(la) + n1 = n1 + nnl*nco(la) END DO ALLOCATE (ind1(n1, 3)) n1 = 0 DO i1 = 1, nnl DO la = 0, potential%lmax DO j1 = 1, nco(la) - n1 = n1+1 + n1 = n1 + 1 ind1(n1, 1) = la ind1(n1, 2) = j1 ind1(n1, 3) = i1 @@ -1360,7 +1360,7 @@ SUBROUTINE init_sgp_potential(potential) DO i2 = 1, nnl DO lb = 0, potential%lmax IF (.NOT. potential%is_nonlocal(lb)) CYCLE - n2 = n2+nso(lb) + n2 = n2 + nso(lb) END DO END DO ALLOCATE (ind2(n2, 3)) @@ -1369,7 +1369,7 @@ SUBROUTINE init_sgp_potential(potential) DO lb = 0, potential%lmax IF (.NOT. potential%is_nonlocal(lb)) CYCLE DO j2 = 1, nso(lb) - n2 = n2+1 + n2 = n2 + 1 ind2(n2, 1) = lb ind2(n2, 2) = j2 ind2(n2, 3) = i2 @@ -1491,8 +1491,8 @@ SUBROUTINE read_all_potential(element_symbol, potential_name, potential, zeff_co line2 = " "//line//" " symbol2 = " "//TRIM(symbol)//" " apname2 = " "//TRIM(apname)//" " - strlen1 = LEN_TRIM(symbol2)+1 - strlen2 = LEN_TRIM(apname2)+1 + strlen1 = LEN_TRIM(symbol2) + 1 + strlen2 = LEN_TRIM(apname2) + 1 IF ((INDEX(line2, symbol2(:strlen1)) > 0) .AND. & (INDEX(line2, apname2(:strlen2)) > 0)) match = .TRUE. @@ -1511,7 +1511,7 @@ SUBROUTINE read_all_potential(element_symbol, potential_name, potential, zeff_co READ (line_att, *) elec_conf(l) CALL remove_word(line_att) DO WHILE (LEN_TRIM(line_att) /= 0) - l = l+1 + l = l + 1 CALL reallocate(elec_conf, 0, l) READ (line_att, *) elec_conf(l) CALL remove_word(line_att) @@ -1519,11 +1519,11 @@ SUBROUTINE read_all_potential(element_symbol, potential_name, potential, zeff_co ELSE CALL parser_get_object(parser, elec_conf(l), newline=.TRUE.) DO WHILE (parser_test_next_token(parser) == "INT") - l = l+1 + l = l + 1 CALL reallocate(elec_conf, 0, l) CALL parser_get_object(parser, elec_conf(l)) END DO - irep = irep+1 + irep = irep + 1 IF (update_input) THEN WRITE (line_att, '(100(1X,I0))') elec_conf CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, & @@ -1535,7 +1535,7 @@ SUBROUTINE read_all_potential(element_symbol, potential_name, potential, zeff_co potential%elec_conf(:) = elec_conf(:) potential%zeff_correction = zeff_correction - potential%zeff = REAL(SUM(elec_conf), dp)+zeff_correction + potential%zeff = REAL(SUM(elec_conf), dp) + zeff_correction DEALLOCATE (elec_conf) @@ -1551,7 +1551,7 @@ SUBROUTINE read_all_potential(element_symbol, potential_name, potential, zeff_co READ (line_att, *) r ELSE CALL parser_get_object(parser, r, newline=.TRUE.) - irep = irep+1 + irep = irep + 1 IF (update_input) THEN WRITE (line_att, '(E24.16)') r CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, & @@ -1580,11 +1580,11 @@ SUBROUTINE read_all_potential(element_symbol, potential_name, potential, zeff_co IF (.NOT. read_from_input) THEN ! Dump the potential info the in potential section IF (match .AND. update_input) THEN - irep = irep+1 + irep = irep + 1 WRITE (line_att, '(A)') " # Potential name: "//apname2(:strlen2)//" for symbol: "//symbol2(:strlen1) CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, & c_val=TRIM(line_att)) - irep = irep+1 + irep = irep + 1 WRITE (line_att, '(A)') " # Potential read from the potential filename: "//TRIM(potential_file_name) CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, & c_val=TRIM(line_att)) @@ -1675,8 +1675,8 @@ SUBROUTINE read_local_potential(element_symbol, potential_name, potential, & line2 = " "//line//" " symbol2 = " "//TRIM(symbol)//" " apname2 = " "//TRIM(apname)//" " - strlen1 = LEN_TRIM(symbol2)+1 - strlen2 = LEN_TRIM(apname2)+1 + strlen1 = LEN_TRIM(symbol2) + 1 + strlen2 = LEN_TRIM(apname2) + 1 IF ((INDEX(line2, symbol2(:strlen1)) > 0) .AND. & (INDEX(line2, apname2(:strlen2)) > 0)) match = .TRUE. @@ -1695,7 +1695,7 @@ SUBROUTINE read_local_potential(element_symbol, potential_name, potential, & ELSE CALL parser_get_object(parser, ngau, newline=.TRUE.) CALL parser_get_object(parser, npol) - irep = irep+1 + irep = irep + 1 IF (update_input) THEN WRITE (line_att, '(2(1X,I0))') ngau, npol CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, & @@ -1718,7 +1718,7 @@ SUBROUTINE read_local_potential(element_symbol, potential_name, potential, & DO ipol = 1, npol CALL parser_get_object(parser, cval(igau, ipol), newline=.FALSE.) END DO - irep = irep+1 + irep = irep + 1 IF (update_input) THEN WRITE (line_att, '(8(E24.16))') alpha(igau), (cval(igau, ipol), ipol=1, npol) CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, & @@ -1737,7 +1737,7 @@ SUBROUTINE read_local_potential(element_symbol, potential_name, potential, & potential%radius = 0.0_dp DO igau = 1, ngau DO ipol = 1, npol - l = 2*(ipol-1) + l = 2*(ipol - 1) potential%radius = MAX(potential%radius, & exp_radius(l, alpha(igau), eps_tpot, cval(igau, ipol))) END DO @@ -1760,11 +1760,11 @@ SUBROUTINE read_local_potential(element_symbol, potential_name, potential, & IF (.NOT. read_from_input) THEN ! Dump the potential info in the potential section IF (match .AND. update_input) THEN - irep = irep+1 + irep = irep + 1 WRITE (line_att, '(A)') " # Potential name: "//apname2(:strlen2)//" for symbol: "//symbol2(:strlen1) CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, & c_val=TRIM(line_att)) - irep = irep+1 + irep = irep + 1 WRITE (line_att, '(A)') " # Potential read from the potential filename: "//TRIM(potential_file_name) CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, & c_val=TRIM(line_att)) @@ -1877,14 +1877,14 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co line2 = " "//line//" " symbol2 = " "//TRIM(symbol)//" " apname2 = " "//TRIM(apname)//" " - strlen1 = LEN_TRIM(symbol2)+1 - strlen2 = LEN_TRIM(apname2)+1 + strlen1 = LEN_TRIM(symbol2) + 1 + strlen2 = LEN_TRIM(apname2) + 1 i = INDEX(line2, symbol2(:strlen1)) j = INDEX(line2, apname2(:strlen2)) IF (i > 0 .AND. j > 0) THEN match = .TRUE. - i = i+1+INDEX(line2(i+1:), " ") + i = i + 1 + INDEX(line2(i + 1:), " ") potential%aliases = line2(i:) ! copy all names into aliases field ENDIF END IF @@ -1902,7 +1902,7 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co READ (line_att, *) elec_conf(l) CALL remove_word(line_att) DO WHILE (LEN_TRIM(line_att) /= 0) - l = l+1 + l = l + 1 CALL reallocate(elec_conf, 0, l) READ (line_att, *) elec_conf(l) CALL remove_word(line_att) @@ -1910,11 +1910,11 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co ELSE CALL parser_get_object(parser, elec_conf(l), newline=.TRUE.) DO WHILE (parser_test_next_token(parser) == "INT") - l = l+1 + l = l + 1 CALL reallocate(elec_conf, 0, l) CALL parser_get_object(parser, elec_conf(l)) END DO - irep = irep+1 + irep = irep + 1 IF (update_input) THEN WRITE (line_att, '(100(1X,I0))') elec_conf CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, & @@ -1926,7 +1926,7 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co potential%elec_conf(:) = elec_conf(:) potential%zeff_correction = zeff_correction - potential%zeff = REAL(SUM(elec_conf), dp)+zeff_correction + potential%zeff = REAL(SUM(elec_conf), dp) + zeff_correction DEALLOCATE (elec_conf) @@ -1944,7 +1944,7 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co ELSE line_att = "" CALL parser_get_object(parser, r, newline=.TRUE.) - istr = LEN_TRIM(line_att)+1 + istr = LEN_TRIM(line_att) + 1 WRITE (line_att(istr:), '(E24.16)') r END IF alpha = 1.0_dp/(2.0_dp*r**2) @@ -1963,7 +1963,7 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co CALL remove_word(line_att) ELSE CALL parser_get_object(parser, n) - istr = LEN_TRIM(line_att)+1 + istr = LEN_TRIM(line_att) + 1 WRITE (line_att(istr:), '(1X,I0)') n END IF potential%nexp_ppl = n @@ -1975,15 +1975,15 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co CALL remove_word(line_att) ELSE CALL parser_get_object(parser, ci) - istr = LEN_TRIM(line_att)+1 + istr = LEN_TRIM(line_att) + 1 WRITE (line_att(istr:), '(E24.16)') ci END IF rc2 = (2.0_dp*potential%alpha_ppl) - potential%cexp_ppl(i) = rc2**(i-1)*ci + potential%cexp_ppl(i) = rc2**(i - 1)*ci END DO IF (.NOT. read_from_input) THEN - irep = irep+1 + irep = irep + 1 IF (update_input) THEN CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, & c_val=TRIM(line_att)) @@ -1995,7 +1995,7 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co "Error reading the Potential from input file!!") END IF END IF - maxlppl = 2*(n-1) + maxlppl = 2*(n - 1) IF (maxlppl > -1) CALL init_orbital_pointers(maxlppl) @@ -2011,7 +2011,7 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co CALL remove_word(line_att) READ (line_att, *) potential%nexp_lpot n = potential%nexp_lpot - maxlppl = 2*(n-1) + maxlppl = 2*(n - 1) IF (maxlppl > -1) CALL init_orbital_pointers(maxlppl) NULLIFY (potential%alpha_lpot, potential%nct_lpot, potential%cval_lpot) CALL reallocate(potential%alpha_lpot, 1, n) @@ -2028,7 +2028,7 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co CALL remove_word(line_att) DO ic = 1, potential%nct_lpot(ipot) READ (line_att, *) ci - rc2 = (2._dp*potential%alpha_lpot(ipot))**(ic-1) + rc2 = (2._dp*potential%alpha_lpot(ipot))**(ic - 1) potential%cval_lpot(ic, ipot) = ci*rc2 CALL remove_word(line_att) END DO @@ -2077,7 +2077,7 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co CALL remove_word(line_att) DO ic = 1, potential%nct_lsd(ipot) READ (line_att, *) ci - rc2 = (2._dp*potential%alpha_lsd(ipot))**(ic-1) + rc2 = (2._dp*potential%alpha_lsd(ipot))**(ic - 1) potential%cval_lsd(ic, ipot) = ci*rc2 CALL remove_word(line_att) END DO @@ -2103,7 +2103,7 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co CALL reallocate(potential%nct_lpot, 1, n) CALL reallocate(potential%cval_lpot, 1, 4, 1, n) ! add to input section - irep = irep+1 + irep = irep + 1 IF (update_input) THEN WRITE (line_att, '(A,1X,I0)') "LPOT", n CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, & @@ -2117,11 +2117,11 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co DO ic = 1, potential%nct_lpot(ipot) CALL parser_get_object(parser, ci) tmp_vals(ic) = ci - rc2 = (2._dp*potential%alpha_lpot(ipot))**(ic-1) + rc2 = (2._dp*potential%alpha_lpot(ipot))**(ic - 1) potential%cval_lpot(ic, ipot) = ci*rc2 END DO ! add to input section - irep = irep+1 + irep = irep + 1 IF (update_input) THEN WRITE (line_att, '(E24.16,1X,I0,100(1X,E24.16))') r, potential%nct_lpot(ipot), & tmp_vals(1:potential%nct_lpot(ipot)) @@ -2140,7 +2140,7 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co CALL reallocate(potential%cval_nlcc, 1, 4, 1, n) ! add to input section WRITE (line_att, '(A,1X,I0)') "NLCC", n - irep = irep+1 + irep = irep + 1 CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, & c_val=TRIM(line_att)) DO ipot = 1, potential%nexp_nlcc @@ -2154,7 +2154,7 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co potential%cval_nlcc(ic, ipot) = potential%cval_nlcc(ic, ipot)/(4.0_dp*pi) END DO ! add to input section - irep = irep+1 + irep = irep + 1 IF (update_input) THEN WRITE (line_att, '(E24.16,1X,I0,100(1X,E24.16))') & potential%alpha_nlcc(ipot), potential%nct_nlcc(ipot), & @@ -2173,7 +2173,7 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co CALL reallocate(potential%nct_lsd, 1, n) CALL reallocate(potential%cval_lsd, 1, 4, 1, n) ! add to input section - irep = irep+1 + irep = irep + 1 IF (update_input) THEN WRITE (line_att, '(A,1X,I0)') "LSD", n CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, & @@ -2187,11 +2187,11 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co DO ic = 1, potential%nct_lsd(ipot) CALL parser_get_object(parser, ci) tmp_vals(ic) = ci - rc2 = (2._dp*potential%alpha_lsd(ipot))**(ic-1) + rc2 = (2._dp*potential%alpha_lsd(ipot))**(ic - 1) potential%cval_lsd(ic, ipot) = ci*rc2 END DO ! add to input section - irep = irep+1 + irep = irep + 1 IF (update_input) THEN WRITE (line_att, '(E24.16,1X,I0,100(1X,E24.16))') r, potential%nct_lsd(ipot), & tmp_vals(1:potential%nct_lsd(ipot)) @@ -2231,17 +2231,17 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co CALL remove_word(line_att) ELSE CALL parser_get_object(parser, n) - irep = irep+1 + irep = irep + 1 IF (update_input) THEN WRITE (line_att, '(1X,I0)') n CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, & c_val=TRIM(line_att)) END IF END IF - potential%lppnl = n-1 + potential%lppnl = n - 1 potential%nppnl = 0 - potential%lprj_ppnl_max = n-1 + potential%lprj_ppnl_max = n - 1 potential%nprj_ppnl_max = 0 IF (n > 0) THEN @@ -2276,7 +2276,7 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co line_att = "" CALL parser_get_object(parser, r, newline=.TRUE.) CALL parser_get_object(parser, nprj_ppnl) - istr = LEN_TRIM(line_att)+1 + istr = LEN_TRIM(line_att) + 1 WRITE (line_att(istr:), '(E24.16,1X,I0)') r, nprj_ppnl END IF IF (r == 0.0_dp .AND. nprj_ppnl /= 0) THEN @@ -2289,7 +2289,7 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co potential%alpha_ppnl(l) = 0.0_dp IF (r /= 0.0_dp .AND. n /= 0) potential%alpha_ppnl(l) = 1.0_dp/(2.0_dp*r**2) potential%nprj_ppnl(l) = nprj_ppnl - nppnl = nppnl+nprj_ppnl*nco(l) + nppnl = nppnl + nprj_ppnl*nco(l) IF (nprj_ppnl > nprj_ppnl_max) THEN nprj_ppnl_max = nprj_ppnl CALL reallocate(hprj_ppnl, 1, nprj_ppnl_max, & @@ -2303,7 +2303,7 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co CALL remove_word(line_att) ELSE CALL parser_get_object(parser, hprj_ppnl(i, i, l)) - istr = LEN_TRIM(line_att)+1 + istr = LEN_TRIM(line_att) + 1 WRITE (line_att(istr:), '(E24.16)') hprj_ppnl(i, i, l) END IF ELSE @@ -2319,28 +2319,28 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co READ (line_att, *) hprj_ppnl(i, i, l) CALL remove_word(line_att) ELSE - irep = irep+1 + irep = irep + 1 CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, & c_val=TRIM(line_att)) line_att = "" CALL parser_get_object(parser, hprj_ppnl(i, i, l), newline=.TRUE.) - istr = LEN_TRIM(line_att)+1 + istr = LEN_TRIM(line_att) + 1 WRITE (line_att(istr:), '(E24.16)') hprj_ppnl(i, i, l) END IF END IF - DO j = i+1, nprj_ppnl + DO j = i + 1, nprj_ppnl IF (read_from_input) THEN READ (line_att, *) hprj_ppnl(i, j, l) CALL remove_word(line_att) ELSE CALL parser_get_object(parser, hprj_ppnl(i, j, l)) - istr = LEN_TRIM(line_att)+1 + istr = LEN_TRIM(line_att) + 1 WRITE (line_att(istr:), '(E24.16)') hprj_ppnl(i, j, l) END IF END DO END DO IF (.NOT. read_from_input) THEN - irep = irep+1 + irep = irep + 1 IF (update_input) THEN CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, & c_val=TRIM(line_att)) @@ -2355,7 +2355,7 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co IF (nprj_ppnl > 1) THEN CALL symmetrize_matrix(hprj_ppnl(:, :, l), "upper_to_lower") END IF - lprj_ppnl_max = MAX(lprj_ppnl_max, l+2*(nprj_ppnl-1)) + lprj_ppnl_max = MAX(lprj_ppnl_max, l + 2*(nprj_ppnl - 1)) END DO potential%nppnl = nppnl @@ -2391,11 +2391,11 @@ SUBROUTINE read_gth_potential(element_symbol, potential_name, potential, zeff_co IF (.NOT. read_from_input) THEN ! Dump the potential info the in potential section IF (match .AND. update_input) THEN - irep = irep+1 + irep = irep + 1 WRITE (line_att, '(A)') " # Potential name: "//apname2(:strlen2)//" for symbol: "//symbol2(:strlen1) CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, & c_val=TRIM(line_att)) - irep = irep+1 + irep = irep + 1 WRITE (line_att, '(A)') " # Potential read from the potential filename: "//TRIM(potential_file_name) CALL section_vals_val_set(potential_section, "_DEFAULT_KEYWORD_", i_rep_val=irep, & c_val=TRIM(line_att)) @@ -2429,7 +2429,7 @@ SUBROUTINE set_default_all_potential(potential, z, zeff_correction) ALLOCATE (elec_conf(0:3)) elec_conf(0:3) = ptable(z)%e_conv(0:3) - zeff = REAL(SUM(elec_conf), dp)+zeff_correction + zeff = REAL(SUM(elec_conf), dp) + zeff_correction name = ptable(z)%name r = ptable(z)%covalent_radius*0.5_dp @@ -2499,7 +2499,7 @@ SUBROUTINE set_all_potential(potential, name, alpha_core_charge, & IF (PRESENT(zeff_correction)) potential%zeff_correction = zeff_correction IF (PRESENT(elec_conf)) THEN IF (.NOT. ASSOCIATED(potential%elec_conf)) THEN - CALL reallocate(potential%elec_conf, 0, SIZE(elec_conf)-1) + CALL reallocate(potential%elec_conf, 0, SIZE(elec_conf) - 1) END IF potential%elec_conf(:) = elec_conf(:) END IF @@ -2671,7 +2671,7 @@ SUBROUTINE set_gth_potential(potential, name, alpha_core_charge, alpha_ppl, & IF (ASSOCIATED(potential%elec_conf)) THEN DEALLOCATE (potential%elec_conf) ENDIF - ALLOCATE (potential%elec_conf(0:SIZE(elec_conf)-1)) + ALLOCATE (potential%elec_conf(0:SIZE(elec_conf) - 1)) potential%elec_conf(:) = elec_conf(:) ENDIF IF (PRESENT(nprj_ppnl)) potential%nprj_ppnl => nprj_ppnl @@ -2774,7 +2774,7 @@ SUBROUTINE set_sgp_potential(potential, name, description, aliases, elec_conf, & IF (ASSOCIATED(potential%elec_conf)) THEN DEALLOCATE (potential%elec_conf) ENDIF - ALLOCATE (potential%elec_conf(0:SIZE(elec_conf)-1)) + ALLOCATE (potential%elec_conf(0:SIZE(elec_conf) - 1)) potential%elec_conf(:) = elec_conf(:) ENDIF @@ -2876,7 +2876,7 @@ SUBROUTINE write_local_potential(potential, output_unit) DO igau = 1, potential%ngau WRITE (UNIT=output_unit, FMT="(T8,A,F12.6,T50,A,4(T68,I2,F10.4))") & "Exponent: ", potential%alpha(igau), & - "Coefficients: ", (2*ipol-2, potential%cval(igau, ipol), ipol=1, potential%npol) + "Coefficients: ", (2*ipol - 2, potential%cval(igau, ipol), ipol=1, potential%npol) END DO END IF @@ -2920,7 +2920,7 @@ SUBROUTINE write_gth_potential(potential, output_unit) WRITE (UNIT=output_unit, FMT="(/,T8,A,/,/,T27,A,/,T21,5F12.6)") & "Parameters of the local part of the GTH pseudopotential:", & "rloc C1 C2 C3 C4", & - r, (potential%cexp_ppl(i)*r**(2*(i-1)), i=1, potential%nexp_ppl) + r, (potential%cexp_ppl(i)*r**(2*(i - 1)), i=1, potential%nexp_ppl) IF (potential%lppnl > -1) THEN WRITE (UNIT=output_unit, FMT="(/,T8,A,/,/,T20,A,/)") & diff --git a/src/subsys/molecule_kind_types.F b/src/subsys/molecule_kind_types.F index 0235984669..61c23aeee7 100644 --- a/src/subsys/molecule_kind_types.F +++ b/src/subsys/molecule_kind_types.F @@ -265,69 +265,69 @@ SUBROUTINE setup_colvar_counters(colv_list, ncolv) IF (ASSOCIATED(colv_list)) THEN DO k = 1, SIZE(colv_list) - IF (colv_list(k)%restraint%active) ncolv%nrestraint = ncolv%nrestraint+1 - SELECT CASE (colv_list (k)%type_id) + IF (colv_list(k)%restraint%active) ncolv%nrestraint = ncolv%nrestraint + 1 + SELECT CASE (colv_list(k)%type_id) CASE (angle_colvar_id) - ncolv%nangle = ncolv%nangle+1 + ncolv%nangle = ncolv%nangle + 1 CASE (coord_colvar_id) - ncolv%ncoord = ncolv%ncoord+1 + ncolv%ncoord = ncolv%ncoord + 1 CASE (population_colvar_id) - ncolv%npopulation = ncolv%npopulation+1 + ncolv%npopulation = ncolv%npopulation + 1 CASE (gyration_colvar_id) - ncolv%ngyration = ncolv%ngyration+1 + ncolv%ngyration = ncolv%ngyration + 1 CASE (rotation_colvar_id) - ncolv%nrot = ncolv%nrot+1 + ncolv%nrot = ncolv%nrot + 1 CASE (dist_colvar_id) - ncolv%ndist = ncolv%ndist+1 + ncolv%ndist = ncolv%ndist + 1 CASE (dfunct_colvar_id) - ncolv%ndfunct = ncolv%ndfunct+1 + ncolv%ndfunct = ncolv%ndfunct + 1 CASE (plane_distance_colvar_id) - ncolv%nplane_dist = ncolv%nplane_dist+1 + ncolv%nplane_dist = ncolv%nplane_dist + 1 CASE (plane_plane_angle_colvar_id) - ncolv%nplane_angle = ncolv%nplane_angle+1 + ncolv%nplane_angle = ncolv%nplane_angle + 1 CASE (torsion_colvar_id) - ncolv%ntorsion = ncolv%ntorsion+1 + ncolv%ntorsion = ncolv%ntorsion + 1 CASE (qparm_colvar_id) - ncolv%nqparm = ncolv%nqparm+1 + ncolv%nqparm = ncolv%nqparm + 1 CASE (xyz_diag_colvar_id) - ncolv%nxyz_diag = ncolv%nxyz_diag+1 + ncolv%nxyz_diag = ncolv%nxyz_diag + 1 CASE (xyz_outerdiag_colvar_id) - ncolv%nxyz_outerdiag = ncolv%nxyz_outerdiag+1 + ncolv%nxyz_outerdiag = ncolv%nxyz_outerdiag + 1 CASE (hydronium_shell_colvar_id) - ncolv%nhydronium_shell = ncolv%nhydronium_shell+1 + ncolv%nhydronium_shell = ncolv%nhydronium_shell + 1 CASE (hydronium_dist_colvar_id) - ncolv%nhydronium_dist = ncolv%nhydronium_dist+1 + ncolv%nhydronium_dist = ncolv%nhydronium_dist + 1 CASE (acid_hyd_dist_colvar_id) - ncolv%nacid_hyd_dist = ncolv%nacid_hyd_dist+1 + ncolv%nacid_hyd_dist = ncolv%nacid_hyd_dist + 1 CASE (acid_hyd_shell_colvar_id) - ncolv%nacid_hyd_shell = ncolv%nacid_hyd_shell+1 + ncolv%nacid_hyd_shell = ncolv%nacid_hyd_shell + 1 CASE (reaction_path_colvar_id) - ncolv%nreactionpath = ncolv%nreactionpath+1 + ncolv%nreactionpath = ncolv%nreactionpath + 1 CASE (combine_colvar_id) - ncolv%ncombinecvs = ncolv%ncombinecvs+1 + ncolv%ncombinecvs = ncolv%ncombinecvs + 1 CASE DEFAULT CPABORT("") END SELECT END DO END IF - ncolv%ntot = ncolv%ndist+ & - ncolv%nangle+ & - ncolv%ntorsion+ & - ncolv%ncoord+ & - ncolv%nplane_dist+ & - ncolv%nplane_angle+ & - ncolv%ndfunct+ & - ncolv%nrot+ & - ncolv%nqparm+ & - ncolv%nxyz_diag+ & - ncolv%nxyz_outerdiag+ & - ncolv%nhydronium_shell+ & - ncolv%nhydronium_dist+ & - ncolv%nacid_hyd_dist+ & - ncolv%nacid_hyd_shell+ & - ncolv%nreactionpath+ & - ncolv%ncombinecvs+ & - ncolv%npopulation+ & + ncolv%ntot = ncolv%ndist + & + ncolv%nangle + & + ncolv%ntorsion + & + ncolv%ncoord + & + ncolv%nplane_dist + & + ncolv%nplane_angle + & + ncolv%ndfunct + & + ncolv%nrot + & + ncolv%nqparm + & + ncolv%nxyz_diag + & + ncolv%nxyz_outerdiag + & + ncolv%nhydronium_shell + & + ncolv%nhydronium_dist + & + ncolv%nacid_hyd_dist + & + ncolv%nacid_hyd_shell + & + ncolv%nreactionpath + & + ncolv%ncombinecvs + & + ncolv%npopulation + & ncolv%ngyration END SUBROUTINE setup_colvar_counters @@ -661,10 +661,10 @@ SUBROUTINE get_molecule_kind(molecule_kind, atom_list, bond_list, bend_list, & IF (PRESENT(nub)) nub = molecule_kind%nub IF (PRESENT(nimpr)) nimpr = molecule_kind%nimpr IF (PRESENT(nopbend)) nopbend = molecule_kind%nopbend - IF (PRESENT(nconstraint)) nconstraint = (molecule_kind%ncolv%ntot-molecule_kind%ncolv%nrestraint)+ & - 3*(molecule_kind%ng3x3-molecule_kind%ng3x3_restraint)+ & - 6*(molecule_kind%ng4x6-molecule_kind%ng4x6_restraint)+ & - 3*(molecule_kind%nvsite-molecule_kind%nvsite_restraint) + IF (PRESENT(nconstraint)) nconstraint = (molecule_kind%ncolv%ntot - molecule_kind%ncolv%nrestraint) + & + 3*(molecule_kind%ng3x3 - molecule_kind%ng3x3_restraint) + & + 6*(molecule_kind%ng4x6 - molecule_kind%ng4x6_restraint) + & + 3*(molecule_kind%nvsite - molecule_kind%nvsite_restraint) IF (PRESENT(ncolv)) ncolv = molecule_kind%ncolv IF (PRESENT(ng3x3)) ng3x3 = molecule_kind%ng3x3 IF (PRESENT(ng4x6)) ng4x6 = molecule_kind%ng4x6 @@ -677,13 +677,13 @@ SUBROUTINE get_molecule_kind(molecule_kind, atom_list, bond_list, bend_list, & IF (molecule_kind%nfixd /= 0) THEN DO i = 1, SIZE(molecule_kind%fixd_list) IF (molecule_kind%fixd_list(i)%restraint%active) CYCLE - SELECT CASE (molecule_kind%fixd_list (i)%itype) + SELECT CASE (molecule_kind%fixd_list(i)%itype) CASE (use_perd_x, use_perd_y, use_perd_z) - nconstraint_fixd = nconstraint_fixd+1 + nconstraint_fixd = nconstraint_fixd + 1 CASE (use_perd_xy, use_perd_xz, use_perd_yz) - nconstraint_fixd = nconstraint_fixd+2 + nconstraint_fixd = nconstraint_fixd + 2 CASE (use_perd_xyz) - nconstraint_fixd = nconstraint_fixd+3 + nconstraint_fixd = nconstraint_fixd + 3 END SELECT END DO END IF @@ -692,9 +692,9 @@ SUBROUTINE get_molecule_kind(molecule_kind, atom_list, bond_list, bend_list, & IF (PRESENT(ng4x6_restraint)) ng4x6_restraint = molecule_kind%ng4x6_restraint IF (PRESENT(nvsite_restraint)) nvsite_restraint = molecule_kind%nvsite_restraint IF (PRESENT(nfixd_restraint)) nfixd_restraint = molecule_kind%nfixd_restraint - IF (PRESENT(nrestraints)) nrestraints = molecule_kind%ncolv%nrestraint+ & - molecule_kind%ng3x3_restraint+ & - molecule_kind%ng4x6_restraint+ & + IF (PRESENT(nrestraints)) nrestraints = molecule_kind%ncolv%nrestraint + & + molecule_kind%ng3x3_restraint + & + molecule_kind%ng4x6_restraint + & molecule_kind%nvsite_restraint IF (PRESENT(nmolecule)) nmolecule = molecule_kind%nmolecule IF (PRESENT(nshell)) nshell = molecule_kind%nshell @@ -785,17 +785,17 @@ SUBROUTINE get_molecule_kind_set(molecule_kind_set, maxatom, natom, & nrestraints=nrestraints_tot, & nmolecule=nm) IF (PRESENT(maxatom)) maxatom = MAX(maxatom, na) - IF (PRESENT(natom)) natom = natom+na*nm - IF (PRESENT(nbond)) nbond = nbond+ibond*nm - IF (PRESENT(nbend)) nbend = nbend+ibend*nm - IF (PRESENT(nub)) nub = nub+iub*nm - IF (PRESENT(ntorsion)) ntorsion = ntorsion+itorsion*nm - IF (PRESENT(nimpr)) nimpr = nimpr+iimpr*nm - IF (PRESENT(nopbend)) nopbend = nopbend+iopbend*nm - IF (PRESENT(nconstraint)) nconstraint = nconstraint+nc*nm+nc_fixd - IF (PRESENT(nconstraint_fixd)) nconstraint_fixd = nconstraint_fixd+nc_fixd - IF (PRESENT(nmolecule)) nmolecule = nmolecule+nm - IF (PRESENT(nrestraints)) nrestraints = nrestraints+nm*nrestraints_tot+nfixd_restraint + IF (PRESENT(natom)) natom = natom + na*nm + IF (PRESENT(nbond)) nbond = nbond + ibond*nm + IF (PRESENT(nbend)) nbend = nbend + ibend*nm + IF (PRESENT(nub)) nub = nub + iub*nm + IF (PRESENT(ntorsion)) ntorsion = ntorsion + itorsion*nm + IF (PRESENT(nimpr)) nimpr = nimpr + iimpr*nm + IF (PRESENT(nopbend)) nopbend = nopbend + iopbend*nm + IF (PRESENT(nconstraint)) nconstraint = nconstraint + nc*nm + nc_fixd + IF (PRESENT(nconstraint_fixd)) nconstraint_fixd = nconstraint_fixd + nc_fixd + IF (PRESENT(nmolecule)) nmolecule = nmolecule + nm + IF (PRESENT(nrestraints)) nrestraints = nrestraints + nm*nrestraints_tot + nfixd_restraint END DO @@ -1127,7 +1127,7 @@ SUBROUTINE write_molecule_kind_set(molecule_kind_set, subsys_section) ntorsion=ntors, & nimpr=nimpr, & nopbend=nopbend) - ntotal = nbond+nbend+nub+ntors+nimpr+nopbend + ntotal = nbond + nbend + nub + ntors + nimpr + nopbend IF (ntotal > 0) THEN WRITE (UNIT=output_unit, FMT="(/,/,T2,A,T45,A30,I6)") & "MOLECULE KIND SET INFORMATION", & diff --git a/src/subsys/multipole_types.F b/src/subsys/multipole_types.F index df965ffa45..4f7c2cbd3b 100644 --- a/src/subsys/multipole_types.F +++ b/src/subsys/multipole_types.F @@ -81,7 +81,7 @@ SUBROUTINE create_multipole_type(multipoles, particle_set, subsys_section, max_m ALLOCATE (multipoles) - last_multipole_id_nr = last_multipole_id_nr+1 + last_multipole_id_nr = last_multipole_id_nr + 1 multipoles%id_nr = last_multipole_id_nr multipoles%ref_count = 1 multipoles%task = .FALSE. @@ -142,7 +142,7 @@ SUBROUTINE create_multipole_type(multipoles, particle_set, subsys_section, max_m CALL section_vals_val_get(work_section, "_DEFAULT_KEYWORD_", i_rep_val=iparticle, r_vals=work) DO i = 1, 3 DO j = 1, 3 - ind2 = 3*(MIN(i, j)-1)-(MIN(i, j)*(MIN(i, j)-1))/2+MAX(i, j) + ind2 = 3*(MIN(i, j) - 1) - (MIN(i, j)*(MIN(i, j) - 1))/2 + MAX(i, j) multipoles%quadrupoles(i, j, iparticle) = work(ind2) END DO END DO @@ -168,7 +168,7 @@ SUBROUTINE release_multipole_type(multipoles) IF (ASSOCIATED(multipoles)) THEN CPASSERT(multipoles%ref_count > 0) - multipoles%ref_count = multipoles%ref_count-1 + multipoles%ref_count = multipoles%ref_count - 1 IF (multipoles%ref_count == 0) THEN IF (ASSOCIATED(multipoles%charges)) THEN DEALLOCATE (multipoles%charges) @@ -202,7 +202,7 @@ SUBROUTINE retain_multipole_type(multipoles) IF (ASSOCIATED(multipoles)) THEN CPASSERT(multipoles%ref_count > 0) - multipoles%ref_count = multipoles%ref_count+1 + multipoles%ref_count = multipoles%ref_count + 1 END IF END SUBROUTINE retain_multipole_type diff --git a/src/subsys/particle_types.F b/src/subsys/particle_types.F index 87d38635bb..ecb45f06b7 100644 --- a/src/subsys/particle_types.F +++ b/src/subsys/particle_types.F @@ -148,7 +148,7 @@ SUBROUTINE update_particle_set(particle_set, int_group, pos, vel, for, add) CALL mp_sum(pos, int_group) IF (my_add) THEN DO iparticle = 1, nparticle - particle_set(iparticle)%r(:) = particle_set(iparticle)%r(:)+pos(:, iparticle) + particle_set(iparticle)%r(:) = particle_set(iparticle)%r(:) + pos(:, iparticle) END DO ELSE DO iparticle = 1, nparticle @@ -160,7 +160,7 @@ SUBROUTINE update_particle_set(particle_set, int_group, pos, vel, for, add) CALL mp_sum(vel, int_group) IF (my_add) THEN DO iparticle = 1, nparticle - particle_set(iparticle)%v(:) = particle_set(iparticle)%v(:)+vel(:, iparticle) + particle_set(iparticle)%v(:) = particle_set(iparticle)%v(:) + vel(:, iparticle) END DO ELSE DO iparticle = 1, nparticle @@ -172,7 +172,7 @@ SUBROUTINE update_particle_set(particle_set, int_group, pos, vel, for, add) CALL mp_sum(for, int_group) IF (my_add) THEN DO iparticle = 1, nparticle - particle_set(iparticle)%f(:) = particle_set(iparticle)%f(:)+for(:, iparticle) + particle_set(iparticle)%f(:) = particle_set(iparticle)%f(:) + for(:, iparticle) END DO ELSE DO iparticle = 1, nparticle @@ -206,15 +206,15 @@ FUNCTION get_particle_pos_or_vel(iatom, particle_set, vector) RESULT(x) INTEGER :: ic, is REAL(KIND=dp) :: fc, fs, mass - ic = 3*(iatom-1) + ic = 3*(iatom - 1) IF (particle_set(iatom)%shell_index == 0) THEN - x(1:3) = vector(ic+1:ic+3) + x(1:3) = vector(ic + 1:ic + 3) ELSE - is = 3*(SIZE(particle_set)+particle_set(iatom)%shell_index-1) + is = 3*(SIZE(particle_set) + particle_set(iatom)%shell_index - 1) mass = particle_set(iatom)%atomic_kind%mass fc = particle_set(iatom)%atomic_kind%shell%mass_core/mass fs = particle_set(iatom)%atomic_kind%shell%mass_shell/mass - x(1:3) = fc*vector(ic+1:ic+3)+fs*vector(is+1:is+3) + x(1:3) = fc*vector(ic + 1:ic + 3) + fs*vector(is + 1:is + 3) END IF END FUNCTION get_particle_pos_or_vel @@ -243,18 +243,18 @@ SUBROUTINE update_particle_pos_or_vel(iatom, particle_set, x, vector) INTEGER :: ic, is REAL(KIND=dp) :: fc, fs, mass - ic = 3*(iatom-1) + ic = 3*(iatom - 1) IF (particle_set(iatom)%shell_index == 0) THEN - vector(ic+1:ic+3) = vector(ic+1:ic+3)+x(1:3) - x(1:3) = vector(ic+1:ic+3) + vector(ic + 1:ic + 3) = vector(ic + 1:ic + 3) + x(1:3) + x(1:3) = vector(ic + 1:ic + 3) ELSE - is = 3*(SIZE(particle_set)+particle_set(iatom)%shell_index-1) + is = 3*(SIZE(particle_set) + particle_set(iatom)%shell_index - 1) mass = particle_set(iatom)%atomic_kind%mass fc = particle_set(iatom)%atomic_kind%shell%mass_core/mass fs = particle_set(iatom)%atomic_kind%shell%mass_shell/mass - vector(ic+1:ic+3) = vector(ic+1:ic+3)+x(1:3) - vector(is+1:is+3) = vector(is+1:is+3)+x(1:3) - x(1:3) = fc*vector(ic+1:ic+3)+fs*vector(is+1:is+3) + vector(ic + 1:ic + 3) = vector(ic + 1:ic + 3) + x(1:3) + vector(is + 1:is + 3) = vector(is + 1:is + 3) + x(1:3) + x(1:3) = fc*vector(ic + 1:ic + 3) + fs*vector(is + 1:is + 3) END IF END SUBROUTINE update_particle_pos_or_vel diff --git a/src/subsys/shell_potential_types.F b/src/subsys/shell_potential_types.F index b3a12cefae..a1b0e18c19 100644 --- a/src/subsys/shell_potential_types.F +++ b/src/subsys/shell_potential_types.F @@ -76,7 +76,7 @@ SUBROUTINE get_shell(shell, charge, charge_core, charge_shell, mass_core, & CHARACTER(LEN=*), PARAMETER :: routineN = 'get_shell', routineP = moduleN//':'//routineN IF (ASSOCIATED(shell)) THEN - IF (PRESENT(charge)) charge = shell%charge_core+shell%charge_shell + IF (PRESENT(charge)) charge = shell%charge_core + shell%charge_shell IF (PRESENT(charge_core)) charge_core = shell%charge_core IF (PRESENT(charge_shell)) charge_shell = shell%charge_shell IF (PRESENT(mass_core)) mass_core = shell%mass_core @@ -141,7 +141,7 @@ SUBROUTINE shell_retain(shell) CPASSERT(ASSOCIATED(shell)) CPASSERT(shell%ref_count > 0) - shell%ref_count = shell%ref_count+1 + shell%ref_count = shell%ref_count + 1 END SUBROUTINE shell_retain @@ -157,7 +157,7 @@ SUBROUTINE shell_release(shell) IF (ASSOCIATED(shell)) THEN CPASSERT(shell%ref_count > 0) - shell%ref_count = shell%ref_count-1 + shell%ref_count = shell%ref_count - 1 IF (shell%ref_count == 0) THEN DEALLOCATE (shell) END IF diff --git a/src/subsys/virial_types.F b/src/subsys/virial_types.F index 39364200f9..c157c52d75 100644 --- a/src/subsys/virial_types.F +++ b/src/subsys/virial_types.F @@ -94,47 +94,47 @@ SUBROUTINE sym_virial(virial) INTEGER :: i, j DO i = 1, 3 - DO j = 1, i-1 + DO j = 1, i - 1 ! Symmetrize total - virial%pv_total(j, i) = (virial%pv_total(i, j)+virial%pv_total(j, i))*0.5_dp + virial%pv_total(j, i) = (virial%pv_total(i, j) + virial%pv_total(j, i))*0.5_dp virial%pv_total(i, j) = virial%pv_total(j, i) ! Symmetrize Kinetic - virial%pv_kinetic(j, i) = (virial%pv_kinetic(i, j)+virial%pv_kinetic(j, i))*0.5_dp + virial%pv_kinetic(j, i) = (virial%pv_kinetic(i, j) + virial%pv_kinetic(j, i))*0.5_dp virial%pv_kinetic(i, j) = virial%pv_kinetic(j, i) ! Symmetrize Virial - virial%pv_virial(j, i) = (virial%pv_virial(i, j)+virial%pv_virial(j, i))*0.5_dp + virial%pv_virial(j, i) = (virial%pv_virial(i, j) + virial%pv_virial(j, i))*0.5_dp virial%pv_virial(i, j) = virial%pv_virial(j, i) ! Symmetrize XC - virial%pv_xc(j, i) = (virial%pv_xc(i, j)+virial%pv_xc(j, i))*0.5_dp + virial%pv_xc(j, i) = (virial%pv_xc(i, j) + virial%pv_xc(j, i))*0.5_dp virial%pv_xc(i, j) = virial%pv_xc(j, i) ! Symmetrize tensor parts - virial%pv_ekin(j, i) = (virial%pv_ekin(i, j)+virial%pv_ekin(j, i))*0.5_dp + virial%pv_ekin(j, i) = (virial%pv_ekin(i, j) + virial%pv_ekin(j, i))*0.5_dp virial%pv_ekin(i, j) = virial%pv_ekin(j, i) ! - virial%pv_overlap(j, i) = (virial%pv_overlap(i, j)+virial%pv_overlap(j, i))*0.5_dp + virial%pv_overlap(j, i) = (virial%pv_overlap(i, j) + virial%pv_overlap(j, i))*0.5_dp virial%pv_overlap(i, j) = virial%pv_overlap(j, i) ! - virial%pv_hartree(j, i) = (virial%pv_hartree(i, j)+virial%pv_hartree(j, i))*0.5_dp + virial%pv_hartree(j, i) = (virial%pv_hartree(i, j) + virial%pv_hartree(j, i))*0.5_dp virial%pv_hartree(i, j) = virial%pv_hartree(j, i) ! - virial%pv_exc(j, i) = (virial%pv_exc(i, j)+virial%pv_exc(j, i))*0.5_dp + virial%pv_exc(j, i) = (virial%pv_exc(i, j) + virial%pv_exc(j, i))*0.5_dp virial%pv_exc(i, j) = virial%pv_exc(j, i) ! - virial%pv_vdw(j, i) = (virial%pv_vdw(i, j)+virial%pv_vdw(j, i))*0.5_dp + virial%pv_vdw(j, i) = (virial%pv_vdw(i, j) + virial%pv_vdw(j, i))*0.5_dp virial%pv_vdw(i, j) = virial%pv_vdw(j, i) ! - virial%pv_ppl(j, i) = (virial%pv_ppl(i, j)+virial%pv_ppl(j, i))*0.5_dp + virial%pv_ppl(j, i) = (virial%pv_ppl(i, j) + virial%pv_ppl(j, i))*0.5_dp virial%pv_ppl(i, j) = virial%pv_ppl(j, i) ! - virial%pv_ppnl(j, i) = (virial%pv_ppnl(i, j)+virial%pv_ppnl(j, i))*0.5_dp + virial%pv_ppnl(j, i) = (virial%pv_ppnl(i, j) + virial%pv_ppnl(j, i))*0.5_dp virial%pv_ppnl(i, j) = virial%pv_ppnl(j, i) ! - virial%pv_fock_4c(j, i) = (virial%pv_fock_4c(i, j)+virial%pv_fock_4c(j, i))*0.5_dp + virial%pv_fock_4c(j, i) = (virial%pv_fock_4c(i, j) + virial%pv_fock_4c(j, i))*0.5_dp virial%pv_fock_4c(i, j) = virial%pv_fock_4c(j, i) ! Symmetrize constraints - virial%pv_constraint(j, i) = (virial%pv_constraint(i, j)+virial%pv_constraint(j, i))*0.5_dp + virial%pv_constraint(j, i) = (virial%pv_constraint(i, j) + virial%pv_constraint(j, i))*0.5_dp virial%pv_constraint(i, j) = virial%pv_constraint(j, i) END DO END DO @@ -245,7 +245,7 @@ SUBROUTINE virial_create(virial) ALLOCATE (virial) CALL zero_virial(virial) - last_virial_id_nr = last_virial_id_nr+1 + last_virial_id_nr = last_virial_id_nr + 1 virial%id_nr = last_virial_id_nr virial%ref_count = 1 END SUBROUTINE virial_create @@ -266,7 +266,7 @@ SUBROUTINE virial_release(virial) IF (ASSOCIATED(virial)) THEN CPASSERT(virial%ref_count > 0) - virial%ref_count = virial%ref_count-1 + virial%ref_count = virial%ref_count - 1 IF (virial%ref_count .EQ. 0) THEN DEALLOCATE (virial) ENDIF diff --git a/src/surface_dipole.F b/src/surface_dipole.F index 815f1af2ee..221d69d055 100644 --- a/src/surface_dipole.F +++ b/src/surface_dipole.F @@ -167,7 +167,7 @@ SUBROUTINE calc_dipsurf_potential(qs_env, energy) END DO ENDIF - surfarea = cell%hmat(isurf, isurf)*cell%hmat(jsurf, jsurf)- & + surfarea = cell%hmat(isurf, isurf)*cell%hmat(jsurf, jsurf) - & cell%hmat(isurf, jsurf)*cell%hmat(jsurf, isurf) dsurf = surfarea/REAL(ngrid(isurf)*ngrid(jsurf), dp) @@ -178,25 +178,25 @@ SUBROUTINE calc_dipsurf_potential(qs_env, energy) ! locate where the vacuum is, and set the reference point for the calculation of the dipole rhoavsurf(ilow:iup) = rhoavsurf(ilow:iup)/surfarea - ilayer_min = ilow-1+MINLOC(ABS(rhoavsurf(ilow:iup)), 1) + ilayer_min = ilow - 1 + MINLOC(ABS(rhoavsurf(ilow:iup)), 1) rhoav_min = ABS(rhoavsurf(ilayer_min)) IF (rhoav_min >= 1.E-5_dp) & CPABORT(" Dipole correction needs more vacuum space above the surface ") - height_min = REAL((ilayer_min-ilow), dp)*dh(idir_surfdip, idir_surfdip) + height_min = REAL((ilayer_min - ilow), dp)*dh(idir_surfdip, idir_surfdip) ! surface dipole form average rhoavsurf ! \sum_i NjdjNkdkdi rhoav_i (i-imin)di dip_hh = 0.0_dp dip_fac = wf_r%pw%pw_grid%vol*dh(idir_surfdip, idir_surfdip)/REAL(ngrid(idir_surfdip), dp) - DO i = ilayer_min+1, ilayer_min+ngrid(idir_surfdip) - hh = REAL((i-ilayer_min), dp) + DO i = ilayer_min + 1, ilayer_min + ngrid(idir_surfdip) + hh = REAL((i - ilayer_min), dp) IF (i > iup) THEN - irho = i-ngrid(idir_surfdip) + irho = i - ngrid(idir_surfdip) ELSE irho = i END IF - dip_hh = dip_hh+rhoavsurf(irho)*hh*dip_fac + dip_hh = dip_hh + rhoavsurf(irho)*hh*dip_fac END DO DEALLOCATE (rhoavsurf) @@ -205,27 +205,27 @@ SUBROUTINE calc_dipsurf_potential(qs_env, energy) CALL pw_zero(vdip_r%pw) vdip_fac = dip_hh*4.0_dp*pi - DO i = ilayer_min+1, ilayer_min+ngrid(idir_surfdip) - hh = REAL((i-ilayer_min), dp)*dh(idir_surfdip, idir_surfdip) - vdip = vdip_fac*(-0.5_dp+(hh/cell%hmat(idir_surfdip, idir_surfdip)))* & + DO i = ilayer_min + 1, ilayer_min + ngrid(idir_surfdip) + hh = REAL((i - ilayer_min), dp)*dh(idir_surfdip, idir_surfdip) + vdip = vdip_fac*(-0.5_dp + (hh/cell%hmat(idir_surfdip, idir_surfdip)))* & v_hartree_rspace%pw_grid%dvol/surfarea IF (i > iup) THEN - irho = i-ngrid(idir_surfdip) + irho = i - ngrid(idir_surfdip) ELSE irho = i END IF IF (idir_surfdip == 3) THEN vdip_r%pw%cr3d(bo(1, 1):bo(2, 1), bo(1, 2):bo(2, 2), irho) = & - vdip_r%pw%cr3d(bo(1, 1):bo(2, 1), bo(1, 2):bo(2, 2), irho)+vdip + vdip_r%pw%cr3d(bo(1, 1):bo(2, 1), bo(1, 2):bo(2, 2), irho) + vdip ELSEIF (idir_surfdip == 2) THEN IF (irho >= bo(1, 2) .AND. irho <= bo(2, 2)) THEN vdip_r%pw%cr3d(bo(1, 1):bo(2, 1), irho, bo(1, 3):bo(2, 3)) = & - vdip_r%pw%cr3d(bo(1, 1):bo(2, 1), irho, bo(1, 3):bo(2, 3))+vdip + vdip_r%pw%cr3d(bo(1, 1):bo(2, 1), irho, bo(1, 3):bo(2, 3)) + vdip END IF ELSE IF (irho >= bo(1, 1) .AND. irho <= bo(2, 1)) THEN vdip_r%pw%cr3d(irho, bo(1, 2):bo(2, 2), bo(1, 3):bo(2, 3)) = & - vdip_r%pw%cr3d(irho, bo(1, 2):bo(2, 2), bo(1, 3):bo(2, 3))+vdip + vdip_r%pw%cr3d(irho, bo(1, 2):bo(2, 2), bo(1, 3):bo(2, 3)) + vdip END IF END IF diff --git a/src/swarm/glbopt_history.F b/src/swarm/glbopt_history.F index 9717bb0659..c17dadb593 100644 --- a/src/swarm/glbopt_history.F +++ b/src/swarm/glbopt_history.F @@ -125,8 +125,8 @@ SUBROUTINE goedecker_fingerprint(pos, res) ALLOCATE (matrix(N, N), work(N, N)) DO i = 1, N matrix(i, i) = 1.0 - DO j = i+1, N - d = pos(3*i-2:3*i)-pos(3*j-2:3*j) + DO j = i + 1, N + d = pos(3*i - 2:3*i) - pos(3*j - 2:3*j) d2 = SUM(d**2) t = EXP(-0.5*d2) matrix(i, j) = t @@ -153,7 +153,7 @@ FUNCTION history_fingerprint_match(history, fp1, fp2) RESULT(res) TYPE(history_fingerprint_type), INTENT(IN) :: fp1, fp2 LOGICAL :: res - res = (ABS(fp1%Epot-fp2%Epot) < history%E_precision) .AND. & + res = (ABS(fp1%Epot - fp2%Epot) < history%E_precision) .AND. & (fingerprint_distance(fp1, fp2) < history%fp_precision) END FUNCTION history_fingerprint_match @@ -170,7 +170,7 @@ PURE FUNCTION fingerprint_distance(fp1, fp2) RESULT(res) TYPE(history_fingerprint_type), INTENT(IN) :: fp1, fp2 REAL(KIND=dp) :: res - res = SQRT(SUM((fp1%goedecker-fp2%goedecker)**2)/SIZE(fp1%goedecker)) + res = SQRT(SUM((fp1%goedecker - fp2%goedecker)**2)/SIZE(fp1%goedecker)) END FUNCTION fingerprint_distance ! ************************************************************************************************** @@ -195,10 +195,10 @@ SUBROUTINE history_add(history, fingerprint, id) IF (n == history%length) THEN ! grow history%entries array tmp => history%entries - ALLOCATE (history%entries(n+history_grow_unit)) + ALLOCATE (history%entries(n + history_grow_unit)) history%entries(1:n) = tmp(:) DEALLOCATE (tmp) - n = n+history_grow_unit + n = n + history_grow_unit ENDIF k = interpolation_search(history, fingerprint%Epot) @@ -206,22 +206,22 @@ SUBROUTINE history_add(history, fingerprint, id) !history%entries(k+1:) = history%entries(k:n-1) !Workaround for an XLF bug - pointer array copy does !not work correctly - DO i = n, k+1, -1 - history%entries(i) = history%entries(i-1) + DO i = n, k + 1, -1 + history%entries(i) = history%entries(i - 1) END DO ALLOCATE (history%entries(k)%p) history%entries(k)%p = fingerprint IF (PRESENT(id)) & history%entries(k)%id = id - history%length = history%length+1 + history%length = history%length + 1 IF (debug) THEN ! check history for correct order DO k = 1, history%length !WRITE(*,*) "history: ", k, "Epot",history%entries(k)%p%Epot IF (k > 1) THEN - IF (history%entries(k-1)%p%Epot > history%entries(k)%p%Epot) & + IF (history%entries(k - 1)%p%Epot > history%entries(k)%p%Epot) & CPABORT("history_add: history in wrong order") END IF END DO @@ -257,16 +257,16 @@ SUBROUTINE history_lookup(history, fingerprint, found, id) Epot = fingerprint%Epot k = interpolation_search(history, fingerprint%Epot) - DO k_min = k-1, 1, -1 - IF (history%entries(k_min)%p%Epot < Epot-history%E_precision) EXIT + DO k_min = k - 1, 1, -1 + IF (history%entries(k_min)%p%Epot < Epot - history%E_precision) EXIT ENDDO DO k_max = k, history%length - IF (history%entries(k_max)%p%Epot > Epot+history%E_precision) EXIT + IF (history%entries(k_max)%p%Epot > Epot + history%E_precision) EXIT ENDDO - k_min = MAX(k_min+1, 1) - k_max = MIN(k_max-1, history%length) + k_min = MAX(k_min + 1, 1) + k_max = MIN(k_max - 1, history%length) IF (debug) found_i = -1 @@ -308,19 +308,19 @@ FUNCTION interpolation_search(history, Efind) RESULT(res) DO WHILE (low < high) !linear interpolation - slope = REAL(high-low, KIND=dp)/(history%entries(high)%p%Epot-history%entries(low)%p%Epot) - mid = low+INT(slope*(Efind-history%entries(low)%p%Epot)) + slope = REAL(high - low, KIND=dp)/(history%entries(high)%p%Epot - history%entries(low)%p%Epot) + mid = low + INT(slope*(Efind - history%entries(low)%p%Epot)) mid = MIN(MAX(mid, low), high) IF (history%entries(mid)%p%Epot < Efind) THEN - low = mid+1 + low = mid + 1 ELSE - high = mid-1 + high = mid - 1 END IF END DO IF (0 < low .AND. low <= history%length) THEN - IF (Efind > history%entries(low)%p%Epot) low = low+1 + IF (Efind > history%entries(low)%p%Epot) low = low + 1 END IF res = low @@ -345,7 +345,7 @@ SUBROUTINE verify_history_lookup(history, fingerprint, found_i_ref) best_fp_match = HUGE(1.0_dp) DO i = 1, history%length - Epot_dist = ABS(fingerprint%Epot-history%entries(i)%p%Epot) + Epot_dist = ABS(fingerprint%Epot - history%entries(i)%p%Epot) IF (Epot_dist > history%E_precision) CYCLE fp_dist = fingerprint_distance(fingerprint, history%entries(i)%p) !WRITE(*,*) "entry ", i, " dist: ",dist diff --git a/src/swarm/glbopt_master.F b/src/swarm/glbopt_master.F index 7228d745f8..6a9346e017 100644 --- a/src/swarm/glbopt_master.F +++ b/src/swarm/glbopt_master.F @@ -231,7 +231,7 @@ SUBROUTINE progress_report(this, report) INTEGER :: gopt_steps, md_steps, report_worker_id REAL(KIND=dp) :: report_Epot - this%i_iteration = this%i_iteration+1 + this%i_iteration = this%i_iteration + 1 CALL swarm_message_get(report, "worker_id", report_worker_id) CALL swarm_message_get(report, "status", status) @@ -240,9 +240,9 @@ SUBROUTINE progress_report(this, report) CALL swarm_message_get(report, "Epot", report_Epot) CALL swarm_message_get(report, "md_steps", md_steps) CALL swarm_message_get(report, "gopt_steps", gopt_steps) - this%total_md_steps = this%total_md_steps+md_steps - this%total_gopt_steps = this%total_gopt_steps+gopt_steps - this%count_reports = this%count_reports+1 + this%total_md_steps = this%total_md_steps + md_steps + this%total_gopt_steps = this%total_gopt_steps + gopt_steps + this%count_reports = this%count_reports + 1 IF (report_Epot < this%E_lowest) THEN this%E_lowest = report_Epot diff --git a/src/swarm/glbopt_mincrawl.F b/src/swarm/glbopt_mincrawl.F index 03478dcb35..aa5717024f 100644 --- a/src/swarm/glbopt_mincrawl.F +++ b/src/swarm/glbopt_mincrawl.F @@ -151,7 +151,7 @@ SUBROUTINE mincrawl_init(this, glbopt_section, n_workers, iw, particle_set) ALLOCATE (this%tempdist_init(this%tempstep_max)) this%tempdist_init = 0.0 DO i = 1, this%tempstep_max - this%tempdist_init(i) = 1.0/(1.0+EXP((this%tempstep_init-i)/this%tempdist_init_width)) + this%tempdist_init(i) = 1.0/(1.0 + EXP((this%tempstep_init - i)/this%tempdist_init_width)) ENDDO CALL create_rng_stream(this%rng_stream, name="mincrawl") @@ -196,8 +196,8 @@ SUBROUTINE mincrawl_steer(this, report, cmd) RETURN ENDIF - best_minima%n_active = best_minima%n_active+1 - best_minima%n_sampled = best_minima%n_sampled+1 + best_minima%n_active = best_minima%n_active + 1 + best_minima%n_sampled = best_minima%n_sampled + 1 this%workers(wid)%start_minima => best_minima this%workers(wid)%tempstep = choose_tempstep(this, best_minima) @@ -275,8 +275,8 @@ FUNCTION choose_tempstep(this, minima) RESULT(step) DO r = next_random_number(this%rng_stream) - step = INT(r*SIZE(minima%tempdist))+1 - a = 1.0-2.0*ABS(minima%tempdist(step)-0.5) + step = INT(r*SIZE(minima%tempdist)) + 1 + a = 1.0 - 2.0*ABS(minima%tempdist(step) - 0.5) r = next_random_number(this%rng_stream) IF (r < a) EXIT END DO @@ -371,7 +371,7 @@ SUBROUTINE mincrawl_register_minima(this, report) CALL history_lookup(this%history, report_fp, minima_known) IF (ASSOCIATED(start_minima)) THEN - start_minima%n_active = start_minima%n_active-1 + start_minima%n_active = start_minima%n_active - 1 IF (start_minima%n_active < 0) CPABORT("negative n_active") ! update tempdist and escape_hist @@ -386,12 +386,12 @@ SUBROUTINE mincrawl_register_minima(this, report) ENDIF IF (.NOT. minima_known) THEN - this%n_minima = this%n_minima+1 + this%n_minima = this%n_minima + 1 IF (this%n_minima > SIZE(this%minimas)) THEN ALLOCATE (minimas_tmp(SIZE(this%minimas))) minimas_tmp(:) = this%minimas DEALLOCATE (this%minimas) - ALLOCATE (this%minimas(SIZE(minimas_tmp)+1000)) + ALLOCATE (this%minimas(SIZE(minimas_tmp) + 1000)) this%minimas(:SIZE(minimas_tmp)) = minimas_tmp DEALLOCATE (minimas_tmp) ENDIF @@ -450,8 +450,8 @@ SUBROUTINE update_tempdist(this, tempdist, center, direction) INTEGER :: i DO i = 1, SIZE(tempdist) - tempdist(i) = tempdist(i)+this%tempdist_update_height & - *REAL(direction, KIND=dp)*EXP(-((center-i)/this%tempdist_update_width)**2) + tempdist(i) = tempdist(i) + this%tempdist_update_height & + *REAL(direction, KIND=dp)*EXP(-((center - i)/this%tempdist_update_width)**2) tempdist(i) = MAX(0.0_dp, MIN(1.0_dp, tempdist(i))) ENDDO END SUBROUTINE update_tempdist diff --git a/src/swarm/glbopt_minhop.F b/src/swarm/glbopt_minhop.F index f365179722..593014840b 100644 --- a/src/swarm/glbopt_minhop.F +++ b/src/swarm/glbopt_minhop.F @@ -221,7 +221,7 @@ SUBROUTINE minhop_steer(this, report, cmd) this%worker_state(wid)%fp_hop = report_fp ENDIF - IF (this%worker_state(wid)%Epot_hop-this%worker_state(wid)%Epot < this%worker_state(wid)%Eaccept) THEN + IF (this%worker_state(wid)%Epot_hop - this%worker_state(wid)%Epot < this%worker_state(wid)%Eaccept) THEN ! accept IF (this%iw > 0) WRITE (this%iw, '(A)') " MINHOP| Accept" this%worker_state(wid)%Epot = this%worker_state(wid)%Epot_hop @@ -230,12 +230,12 @@ SUBROUTINE minhop_steer(this, report, cmd) this%worker_state(wid)%Epot_hop = HUGE(1.0) this%worker_state(wid)%Eaccept = this%worker_state(wid)%Eaccept*this%alpha1 !decreasing Eaccept - this%n_accepted = this%n_accepted+1 + this%n_accepted = this%n_accepted + 1 ELSE ! not accept IF (this%iw > 0) WRITE (this%iw, '(A)') " MINHOP| Reject" this%worker_state(wid)%Eaccept = this%worker_state(wid)%Eaccept*this%alpha2 !increasing Eaccept - this%n_rejected = this%n_rejected+1 + this%n_rejected = this%n_rejected + 1 ENDIF END IF diff --git a/src/swarm/glbopt_worker.F b/src/swarm/glbopt_worker.F index 1761515762..c34ecf4e55 100644 --- a/src/swarm/glbopt_worker.F +++ b/src/swarm/glbopt_worker.F @@ -189,7 +189,7 @@ SUBROUTINE run_mdgopt(worker, cmd, report) ENDIF ! setup mdctrl callback - ALLOCATE (mdctrl_data%epot_history(worker%bump_steps_downwards+worker%bump_steps_upwards+1)) + ALLOCATE (mdctrl_data%epot_history(worker%bump_steps_downwards + worker%bump_steps_upwards + 1)) mdctrl_data%epot_history = 0.0 mdctrl_data%md_bump_counter = 0 mdctrl_data%bump_steps_upwards = worker%bump_steps_upwards @@ -212,7 +212,7 @@ SUBROUTINE run_mdgopt(worker, cmd, report) prev_iframe = iframe IF (iframe == 0) iframe = 1 ! qs_mol_dyn behaves differently for STEP_START_VAL=0 - CALL section_vals_val_set(worker%root_section, "MOTION%MD%STEP_START_VAL", i_val=iframe-1) + CALL section_vals_val_set(worker%root_section, "MOTION%MD%STEP_START_VAL", i_val=iframe - 1) CALL section_vals_val_set(worker%root_section, "MOTION%MD%TEMPERATURE", r_val=temperature) IF (worker%iw > 0) THEN @@ -223,8 +223,8 @@ SUBROUTINE run_mdgopt(worker, cmd, report) ! run MD CALL qs_mol_dyn(worker%force_env, worker%globenv, mdctrl=mdctrl_p) - iframe = mdctrl_data%itimes+1 - md_steps = iframe-prev_iframe + iframe = mdctrl_data%itimes + 1 + md_steps = iframe - prev_iframe IF (worker%iw > 0) WRITE (worker%iw, '(A,I4,A)') " GLBOPT| md ended after ", md_steps, " steps." ! fix fragmentation @@ -232,7 +232,7 @@ SUBROUTINE run_mdgopt(worker, cmd, report) CALL pack_subsys_particles(worker%subsys, r=positions) n_fragments = 0 DO - n_fragments = n_fragments+1 + n_fragments = n_fragments + 1 IF (fix_fragmentation(positions, worker%fragmentation_threshold)) EXIT END DO CALL unpack_subsys_particles(worker%subsys, r=positions) @@ -242,17 +242,17 @@ SUBROUTINE run_mdgopt(worker, cmd, report) ! setup geometry optimization IF (worker%iw > 0) WRITE (worker%iw, '(A,13X,I10)') " GLBOPT| Starting local optimisation at trajectory frame ", iframe - CALL section_vals_val_set(worker%root_section, "MOTION%GEO_OPT%STEP_START_VAL", i_val=iframe-1) + CALL section_vals_val_set(worker%root_section, "MOTION%GEO_OPT%STEP_START_VAL", i_val=iframe - 1) CALL section_vals_val_set(worker%root_section, "MOTION%GEO_OPT%MAX_ITER", & - i_val=iframe+worker%gopt_max_iter) + i_val=iframe + worker%gopt_max_iter) ! run geometry optimization CALL cp_geo_opt(worker%force_env, worker%globenv, rm_restart_info=.FALSE.) prev_iframe = iframe CALL section_vals_val_get(worker%root_section, "MOTION%GEO_OPT%STEP_START_VAL", i_val=iframe) - iframe = iframe+2 ! Compensates for different START_VAL interpretation. - gopt_steps = iframe-prev_iframe-1 + iframe = iframe + 2 ! Compensates for different START_VAL interpretation. + gopt_steps = iframe - prev_iframe - 1 IF (worker%iw > 0) WRITE (worker%iw, '(A,I4,A)') " GLBOPT| gopt ended after ", gopt_steps, " steps." CALL force_env_get(worker%force_env, potential_energy=Epot) IF (worker%iw > 0) WRITE (worker%iw, '(A,25X,E20.10)') ' GLBOPT| Potential Energy [Hartree]', Epot @@ -295,12 +295,12 @@ FUNCTION fix_fragmentation(positions, bondlength) RESULT(all_connected) marked(1) = .TRUE.; stack(1) = 1; stack_size = 1 DO WHILE (stack_size > 0) - i = stack(stack_size); stack_size = stack_size-1 !pop + i = stack(stack_size); stack_size = stack_size - 1 !pop DO j = 1, n_particles IF (norm(diff(positions, i, j)) < 1.25*bondlength) THEN ! they are close = they are connected IF (.NOT. marked(j)) THEN marked(j) = .TRUE. - stack(stack_size+1) = j; stack_size = stack_size+1; !push + stack(stack_size + 1) = j; stack_size = stack_size + 1; !push END IF END IF END DO @@ -329,10 +329,10 @@ FUNCTION fix_fragmentation(positions, bondlength) RESULT(all_connected) END DO dr = diff(positions, cluster_edge, fragment_edge) - s = 1.0-bondlength/norm(dr) + s = 1.0 - bondlength/norm(dr) DO i = 1, n_particles IF (marked(i)) CYCLE - positions(3*i-2:3*i) = positions(3*i-2:3*i)-s*dr + positions(3*i - 2:3*i) = positions(3*i - 2:3*i) - s*dr END DO END FUNCTION fix_fragmentation @@ -350,7 +350,7 @@ PURE FUNCTION diff(positions, i, j) RESULT(dr) INTEGER, INTENT(IN) :: i, j REAL(KIND=dp), DIMENSION(3) :: dr - dr = positions(3*i-2:3*i)-positions(3*j-2:3*j) + dr = positions(3*i - 2:3*i) - positions(3*j - 2:3*j) END FUNCTION diff ! ************************************************************************************************** diff --git a/src/swarm/swarm.F b/src/swarm/swarm.F index 04bc859ec8..a7d731e468 100644 --- a/src/swarm/swarm.F +++ b/src/swarm/swarm.F @@ -245,7 +245,7 @@ SUBROUTINE swarm_parallel_master_driver(swarm_mpi, n_workers, root_section, glob ! Each iteration if the loop does s.th. different depending on j. ! First (j==0) it receives one report with (blocking) MPI, ! then it searches through the list is_waiting. - j = MOD(j+1, n_workers+1) + j = MOD(j + 1, n_workers + 1) IF (j == 0) THEN CALL swarm_mpi_recv_report(swarm_mpi, report) ELSE IF (is_waiting(j)) THEN @@ -265,7 +265,7 @@ SUBROUTINE swarm_parallel_master_driver(swarm_mpi, n_workers, root_section, glob is_waiting(wid) = .TRUE. ELSE CALL swarm_mpi_send_command(swarm_mpi, cmd) - IF (TRIM(command) == "shutdown") i_shutdowns = i_shutdowns+1 + IF (TRIM(command) == "shutdown") i_shutdowns = i_shutdowns + 1 ENDIF CALL swarm_message_free(cmd) END DO diff --git a/src/swarm/swarm_master.F b/src/swarm/swarm_master.F index 393dba067e..2777bb9222 100644 --- a/src/swarm/swarm_master.F +++ b/src/swarm/swarm_master.F @@ -256,7 +256,7 @@ SUBROUTINE swarm_master_steer(master, report, cmd) IF (.NOT. master%ignore_last_iteration) THEN ! There are no queued commands. Do the normal processing. - master%i_iteration = master%i_iteration+1 + master%i_iteration = master%i_iteration + 1 IF (master%iw > 0) WRITE (master%iw, '(A,A,1X,I8,A,A)') ' SWARM| ', REPEAT("*", 15), & master%i_iteration, ' Master / Worker Communication ', REPEAT("*", 15) @@ -301,8 +301,8 @@ SUBROUTINE swarm_master_steer(master, report, cmd) ! Don't pollute comlog with "continue waiting"-commands. CALL swarm_message_get(report, "status", status) CALL swarm_message_get(cmd, "command", command) - IF (TRIM(status) == "wait_done") master%n_waiting = master%n_waiting-1 - IF (TRIM(command) == "wait") master%n_waiting = master%n_waiting+1 + IF (TRIM(status) == "wait_done") master%n_waiting = master%n_waiting - 1 + IF (TRIM(command) == "wait") master%n_waiting = master%n_waiting + 1 IF (master%n_waiting < 0) CPABORT("master%n_waiting < 0") IF (TRIM(status) /= "wait_done" .OR. TRIM(command) /= "wait") THEN CALL swarm_message_file_write(report, master%comlog_unit) diff --git a/src/swarm/swarm_mpi.F b/src/swarm/swarm_mpi.F index 924fa27891..60b313fb3c 100644 --- a/src/swarm/swarm_mpi.F +++ b/src/swarm/swarm_mpi.F @@ -94,14 +94,14 @@ SUBROUTINE swarm_mpi_init(swarm_mpi, world_para_env, root_section, n_workers, wo worker_id = -1 swarm_mpi%world => world_para_env - IF (MOD(swarm_mpi%world%num_pe-1, n_workers) /= 0) THEN + IF (MOD(swarm_mpi%world%num_pe - 1, n_workers) /= 0) THEN CPABORT("number of processors-1 is not divisible by n_workers.") ENDIF - IF (swarm_mpi%world%num_pe < n_workers+1) THEN + IF (swarm_mpi%world%num_pe < n_workers + 1) THEN CPABORT("There are not enough processes for n_workers + 1. Aborting.") ENDIF - pe_per_worker = (swarm_mpi%world%num_pe-1)/n_workers + pe_per_worker = (swarm_mpi%world%num_pe - 1)/n_workers IF (iw > 0) THEN WRITE (iw, '(A,45X,I8)') " SWARM| Number of mpi ranks", swarm_mpi%world%num_pe @@ -109,7 +109,7 @@ SUBROUTINE swarm_mpi_init(swarm_mpi, world_para_env, root_section, n_workers, wo ENDIF ! the last task becomes the master. Preseves node-alignment of other tasks. - im_the_master = (swarm_mpi%world%mepos == swarm_mpi%world%num_pe-1) + im_the_master = (swarm_mpi%world%mepos == swarm_mpi%world%num_pe - 1) ! First split split para_env%group into a master- and a workers-groups... IF (im_the_master) THEN @@ -122,7 +122,7 @@ SUBROUTINE swarm_mpi_init(swarm_mpi, world_para_env, root_section, n_workers, wo CALL mp_comm_split_direct(swarm_mpi%world%group, subgroup, 2) CALL mp_environ(subgroup_size, subgroup_rank, subgroup) !WRITE (*,*) "Hello, this is a Worker - there are ",subgroup_size, " of us." - IF (subgroup_size /= swarm_mpi%world%num_pe-1) CPABORT("mp_comm_split_direct failed (worker)") + IF (subgroup_size /= swarm_mpi%world%num_pe - 1) CPABORT("mp_comm_split_direct failed (worker)") ENDIF ALLOCATE (swarm_mpi%wid2group(n_workers)) @@ -132,7 +132,7 @@ SUBROUTINE swarm_mpi_init(swarm_mpi, world_para_env, root_section, n_workers, wo ! ...then split workers-group into n_workers groups - one for each worker. group_distribution_p => group_distribution CALL mp_comm_split(subgroup, worker_group, n_groups_created, group_distribution_p, n_subgroups=n_workers) - worker_id = group_distribution(subgroup_rank)+1 ! shall start by 1 + worker_id = group_distribution(subgroup_rank) + 1 ! shall start by 1 IF (n_groups_created /= n_workers) CPABORT("mp_comm_split failed.") CALL cp_para_env_create(swarm_mpi%worker, group=worker_group) CALL mp_comm_free(subgroup) @@ -223,7 +223,7 @@ SUBROUTINE logger_init_worker(swarm_mpi, root_section, worker_id) CPABORT("Did not expect so many workers.") ENDIF WRITE (worker_name, "(A,I5.5)") 'WORKER', worker_id - IF (LEN_TRIM(project_name)+1+LEN_TRIM(worker_name) > default_string_length) THEN + IF (LEN_TRIM(project_name) + 1 + LEN_TRIM(worker_name) > default_string_length) THEN CPABORT("project name too long") ENDIF output_path = TRIM(project_name)//"-"//TRIM(worker_name)//".out" @@ -342,7 +342,7 @@ SUBROUTINE swarm_mpi_send_report(swarm_mpi, report) IF (swarm_mpi%worker%source /= swarm_mpi%worker%mepos) RETURN - dest = swarm_mpi%world%num_pe-1 + dest = swarm_mpi%world%num_pe - 1 tag = 42 CALL swarm_message_mpi_send(report, group=swarm_mpi%world%group, dest=dest, tag=tag) @@ -403,7 +403,7 @@ SUBROUTINE swarm_mpi_recv_command(swarm_mpi, cmd) ! First: The rank-0 of the worker groups receives the command from the master. IF (swarm_mpi%worker%ionode) THEN - src = swarm_mpi%world%num_pe-1 ! + src = swarm_mpi%world%num_pe - 1 ! tag = 42 CALL swarm_message_mpi_recv(cmd, group=swarm_mpi%world%group, src=src, tag=tag) diff --git a/src/taper_types.F b/src/taper_types.F index 1def098a60..e73370beaf 100644 --- a/src/taper_types.F +++ b/src/taper_types.F @@ -49,7 +49,7 @@ SUBROUTINE taper_create(taper, rc, range) IF (range > EPSILON(0.0_dp)) THEN taper%apply_taper = .TRUE. CPASSERT(range > 0.0_dp) - taper%r0 = 2.0_dp*rc-20.0_dp*range + taper%r0 = 2.0_dp*rc - 20.0_dp*range taper%rscale = 1.0_dp/range ELSE taper%apply_taper = .FALSE. @@ -88,8 +88,8 @@ FUNCTION taper_eval(taper, rij) RESULT(ft) ft = 1._dp IF (taper%apply_taper) THEN - dr = taper%rscale*(rij-taper%r0) - ft = 0.5_dp*(1.0_dp-TANH(dr)) + dr = taper%rscale*(rij - taper%r0) + ft = 0.5_dp*(1.0_dp - TANH(dr)) END IF END FUNCTION taper_eval @@ -110,8 +110,8 @@ FUNCTION dtaper_eval(taper, rij) RESULT(dft) dft = 0.0_dp IF (taper%apply_taper) THEN - dr = taper%rscale*(rij-taper%r0) - dft = -0.5_dp*(1.0_dp-TANH(dr)**2)*taper%rscale + dr = taper%rscale*(rij - taper%r0) + dft = -0.5_dp*(1.0_dp - TANH(dr)**2)*taper%rscale END IF END FUNCTION dtaper_eval diff --git a/src/task_list_methods.F b/src/task_list_methods.F index b72712dca1..a923245ab0 100644 --- a/src/task_list_methods.F +++ b/src/task_list_methods.F @@ -66,7 +66,7 @@ MODULE task_list_methods USE util, ONLY: sort !$ USE OMP_LIB, ONLY: omp_destroy_lock, omp_get_num_threads, omp_init_lock, & -!$ omp_lock_kind, omp_set_lock, omp_unset_lock +!$ omp_lock_kind, omp_set_lock, omp_unset_lock #include "./base/base_uses.f90" IMPLICIT NONE @@ -338,7 +338,7 @@ SUBROUTINE generate_qs_task_list(ks_env, task_list, & jatom_old = jatom img_old = img ELSE IF (iatom .NE. iatom_old .OR. jatom .NE. jatom_old .OR. img .NE. img_old) THEN - ipair = ipair+1 + ipair = ipair + 1 iatom_old = iatom jatom_old = jatom img_old = img @@ -366,7 +366,7 @@ SUBROUTINE generate_qs_task_list(ks_env, task_list, & nimages, natoms, maxset, maxpgf) IF (igrid_level .NE. igrid_level_old) THEN IF (igrid_level_old .NE. -1) THEN - task_list%taskstop(ipair, igrid_level_old) = i-1 + task_list%taskstop(ipair, igrid_level_old) = i - 1 END IF ipair = 1 task_list%taskstart(ipair, igrid_level) = i @@ -375,9 +375,9 @@ SUBROUTINE generate_qs_task_list(ks_env, task_list, & jatom_old = jatom img_old = img ELSE IF (iatom .NE. iatom_old .OR. jatom .NE. jatom_old .OR. img .NE. img_old) THEN - ipair = ipair+1 + ipair = ipair + 1 task_list%taskstart(ipair, igrid_level) = i - task_list%taskstop(ipair-1, igrid_level) = i-1 + task_list%taskstop(ipair - 1, igrid_level) = i - 1 iatom_old = iatom jatom_old = jatom img_old = img @@ -506,26 +506,26 @@ SUBROUTINE task_list_inner_loop(tasks, dist_ab, ntasks, curr_tasks, rs_descs, df jpgf, jset, lb_cube(3), ub_cube(3) REAL(KIND=dp) :: dab, rab2, radius, zetp - rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3) + rab2 = rab(1)*rab(1) + rab(2)*rab(2) + rab(3)*rab(3) dab = SQRT(rab2) loop_iset: DO iset = 1, nseta - IF (set_radius_a(iset)+kind_radius_b < dab) CYCLE + IF (set_radius_a(iset) + kind_radius_b < dab) CYCLE loop_jset: DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dab) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dab) CYCLE loop_ipgf: DO ipgf = 1, npgfa(iset) - IF (rpgfa(ipgf, iset)+set_radius_b(jset) < dab) CYCLE + IF (rpgfa(ipgf, iset) + set_radius_b(jset) < dab) CYCLE loop_jpgf: DO jpgf = 1, npgfb(jset) - IF (rpgfa(ipgf, iset)+rpgfb(jpgf, jset) < dab) CYCLE + IF (rpgfa(ipgf, iset) + rpgfb(jpgf, jset) < dab) CYCLE - zetp = zeta(ipgf, iset)+zetb(jpgf, jset) + zetp = zeta(ipgf, iset) + zetb(jpgf, jset) igrid_level = gaussian_gridlevel(gridlevel_info, zetp) CALL compute_pgf_properties(cube_center, lb_cube, ub_cube, radius, & @@ -608,9 +608,9 @@ SUBROUTINE compute_pgf_properties(cube_center, lb_cube, ub_cube, radius, & ! the radius for this task - zetp = zeta+zetb - rp(:) = ra(:)+zetb/zetp*rab(:) - rb(:) = ra(:)+rab(:) + zetp = zeta + zetb + rp(:) = ra(:) + zetb/zetp*rab(:) + rb(:) = ra(:) + rab(:) cutoff = 1.0_dp f = zetb/zetp prefactor = EXP(-zeta*f*rab2) @@ -620,15 +620,15 @@ SUBROUTINE compute_pgf_properties(cube_center, lb_cube, ub_cube, radius, & CALL compute_cube_center(cube_center, rs_desc, zeta, zetb, ra, rab) ! compute cube_center, the center of the gaussian product to map (folded to within the unit cell) cube_center(:) = MODULO(cube_center(:), rs_desc%npts(:)) - cube_center(:) = cube_center(:)+rs_desc%lb(:) + cube_center(:) = cube_center(:) + rs_desc%lb(:) IF (rs_desc%orthorhombic) THEN CALL return_cube(cube_info, radius, lb_cube, ub_cube, sphere_bounds) ELSE CALL return_cube_nonortho(cube_info, radius, lb_cube, ub_cube, rp) !? unclear if extent is computed correctly. - extent(:) = ub_cube(:)-lb_cube(:) - lb_cube(:) = -extent(:)/2-1 + extent(:) = ub_cube(:) - lb_cube(:) + lb_cube(:) = -extent(:)/2 - 1 ub_cube(:) = extent(:)/2 ENDIF @@ -657,7 +657,7 @@ INTEGER FUNCTION cost_model(lb_cube, ub_cube, fraction, lmax, is_ortho) INTEGER :: cmax REAL(KIND=dp) :: v1, v2, v3, v4, v5 - cmax = MAXVAL(((ub_cube-lb_cube)+1)/2) + cmax = MAXVAL(((ub_cube - lb_cube) + 1)/2) IF (is_ortho) THEN v1 = 1.504760E+00_dp @@ -672,7 +672,7 @@ INTEGER FUNCTION cost_model(lb_cube, ub_cube, fraction, lmax, is_ortho) v4 = 6.122446E-01_dp v5 = 3.886382E+00_dp ENDIF - cost_model = CEILING(((lmax+v1)*(cmax+v2)**3*v3*fraction+v4+v5*lmax**7)/1000.0_dp) + cost_model = CEILING(((lmax + v1)*(cmax + v2)**3*v3*fraction + v4 + v5*lmax**7)/1000.0_dp) END FUNCTION cost_model ! ************************************************************************************************** @@ -735,9 +735,9 @@ SUBROUTINE pgf_to_tasks(tasks, dist_ab, ntasks, curr_tasks, & LOGICAL :: is_ortho REAL(KIND=dp) :: tfraction - ntasks = ntasks+1 + ntasks = ntasks + 1 IF (ntasks > curr_tasks) THEN - curr_tasks = INT((curr_tasks+add_tasks)*mult_tasks) + curr_tasks = INT((curr_tasks + add_tasks)*mult_tasks) CALL reallocate(tasks, 1, 6, 1, curr_tasks) END IF @@ -759,7 +759,7 @@ SUBROUTINE pgf_to_tasks(tasks, dist_ab, ntasks, curr_tasks, & CALL reallocate(dist_ab, 1, 3, 1, SIZE(tasks, 2)) ENDIF - lmax = la_max+lb_max + lmax = la_max + lb_max is_ortho = (tasks(4, ntasks) == 0 .OR. tasks(4, ntasks) == 1) .AND. rs_desc%orthorhombic ! we assume the load is shared equally between processes dealing with a generalised Gaussian. ! this could be refined in the future @@ -769,16 +769,16 @@ SUBROUTINE pgf_to_tasks(tasks, dist_ab, ntasks, curr_tasks, & DO j = 1, added_tasks - tasks(2, ntasks-added_tasks+j) = encode_rank(rs_desc%my_pos, igrid_level, n_levels) - tasks(5, ntasks-added_tasks+j) = cost + tasks(2, ntasks - added_tasks + j) = encode_rank(rs_desc%my_pos, igrid_level, n_levels) + tasks(5, ntasks - added_tasks + j) = cost !encode the atom pairs and basis info as a single long integer - CALL pair2int(tasks(3, ntasks-added_tasks+j), igrid_level, cindex, & + CALL pair2int(tasks(3, ntasks - added_tasks + j), igrid_level, cindex, & iatom, jatom, iset, jset, ipgf, jpgf, nimages, natoms, maxset, maxpgf) - dist_ab(1, ntasks-added_tasks+j) = rab(1) - dist_ab(2, ntasks-added_tasks+j) = rab(2) - dist_ab(3, ntasks-added_tasks+j) = rab(3) + dist_ab(1, ntasks - added_tasks + j) = rab(1) + dist_ab(2, ntasks - added_tasks + j) = rab(2) + dist_ab(3, ntasks - added_tasks + j) = rab(3) ENDDO @@ -831,11 +831,11 @@ SUBROUTINE pair2int(res, ilevel, image, iatom, jatom, iset, jset, ipgf, jpgf, & nlev3 = natom8**2*nlev2 nlev4 = nimages8*nlev3 ! - res = ilevel*nlev4+ & - (image-1)*nlev3+ & - ((iatom-1)*natom8+jatom-1)*nlev2+ & - ((iset-1)*maxset8+jset-1)*nlev1+ & - (ipgf-1)*maxpgf8+jpgf-1 + res = ilevel*nlev4 + & + (image - 1)*nlev3 + & + ((iatom - 1)*natom8 + jatom - 1)*nlev2 + & + ((iset - 1)*maxset8 + jset - 1)*nlev1 + & + (ipgf - 1)*maxpgf8 + jpgf - 1 END SUBROUTINE pair2int @@ -874,18 +874,18 @@ SUBROUTINE int2pair(res, ilevel, image, iatom, jatom, iset, jset, ipgf, jpgf, & ! ilevel = INT(res/nlev4) tmp = MOD(res, nlev4) - img = tmp/nlev3+1 + img = tmp/nlev3 + 1 tmp = MOD(tmp, nlev3) ijatom = tmp/nlev2 - iatom8 = ijatom/natom8+1 - jatom8 = MOD(ijatom, natom8)+1 + iatom8 = ijatom/natom8 + 1 + jatom8 = MOD(ijatom, natom8) + 1 tmp = MOD(tmp, nlev2) ijset = tmp/nlev1 - iset8 = ijset/maxset8+1 - jset8 = MOD(ijset, maxset8)+1 + iset8 = ijset/maxset8 + 1 + jset8 = MOD(ijset, maxset8) + 1 tmp = MOD(tmp, nlev1) - ipgf8 = tmp/maxpgf8+1 - jpgf8 = MOD(tmp, maxpgf8)+1 + ipgf8 = tmp/maxpgf8 + 1 + jpgf8 = MOD(tmp, maxpgf8) + 1 ! image = INT(img) iatom = INT(iatom8); jatom = INT(jatom8); iset = INT(iset8); jset = INT(jset8) @@ -974,17 +974,17 @@ SUBROUTINE balance_global_list(list_global) Ncpu = SIZE(list_global, 3) maxdest = SIZE(list_global, 2) - ALLOCATE (load(0:Ncpu-1)) + ALLOCATE (load(0:Ncpu - 1)) load = 0.0_dp - ALLOCATE (optimized_load(0:Ncpu-1)) + ALLOCATE (optimized_load(0:Ncpu - 1)) ! figure out the number of fluxes ! we assume that the global_list is symmetric Nflux = 0 - DO icpu = 0, ncpu-1 + DO icpu = 0, ncpu - 1 DO idest = 1, maxdest dest = list_global(1, idest, icpu) - IF (dest < ncpu .AND. dest > icpu) Nflux = Nflux+1 + IF (dest < ncpu .AND. dest > icpu) Nflux = Nflux + 1 ENDDO ENDDO ALLOCATE (optimized_flux(Nflux)) @@ -994,14 +994,14 @@ SUBROUTINE balance_global_list(list_global) ! reorder data flux_limits = 0 Nflux = 0 - DO icpu = 0, ncpu-1 + DO icpu = 0, ncpu - 1 load(icpu) = SUM(list_global(2, :, icpu)) DO idest = 1, maxdest dest = list_global(1, idest, icpu) IF (dest < ncpu) THEN IF (dest .NE. icpu) THEN IF (dest > icpu) THEN - Nflux = Nflux+1 + Nflux = Nflux + 1 flux_limits(2, Nflux) = list_global(2, idest, icpu) flux_connections(1, Nflux) = icpu flux_connections(2, Nflux) = dest @@ -1033,13 +1033,13 @@ SUBROUTINE balance_global_list(list_global) DO k = 1, Max_iter max_load_shift = 0.0_dp DO iflux = 1, Nflux - load_shift = (optimized_load(flux_connections(1, iflux))-optimized_load(flux_connections(2, iflux)))/2 - load_shift = MAX(flux_limits(1, iflux)-optimized_flux(iflux), load_shift) - load_shift = MIN(flux_limits(2, iflux)-optimized_flux(iflux), load_shift) + load_shift = (optimized_load(flux_connections(1, iflux)) - optimized_load(flux_connections(2, iflux)))/2 + load_shift = MAX(flux_limits(1, iflux) - optimized_flux(iflux), load_shift) + load_shift = MIN(flux_limits(2, iflux) - optimized_flux(iflux), load_shift) max_load_shift = MAX(ABS(load_shift), max_load_shift) - optimized_load(flux_connections(1, iflux)) = optimized_load(flux_connections(1, iflux))-load_shift - optimized_load(flux_connections(2, iflux)) = optimized_load(flux_connections(2, iflux))+load_shift - optimized_flux(iflux) = optimized_flux(iflux)+load_shift + optimized_load(flux_connections(1, iflux)) = optimized_load(flux_connections(1, iflux)) - load_shift + optimized_load(flux_connections(2, iflux)) = optimized_load(flux_connections(2, iflux)) + load_shift + optimized_flux(iflux) = optimized_flux(iflux) + load_shift ENDDO IF (max_load_shift < tolerance) THEN solution_optimal = .TRUE. @@ -1050,7 +1050,7 @@ SUBROUTINE balance_global_list(list_global) ! now adjust the load list to reflect the optimized fluxes ! reorder data Nflux = 0 - DO icpu = 0, ncpu-1 + DO icpu = 0, ncpu - 1 DO idest = 1, maxdest IF (list_global(1, idest, icpu) == icpu) ilocal = idest ENDDO @@ -1059,13 +1059,13 @@ SUBROUTINE balance_global_list(list_global) IF (dest < ncpu) THEN IF (dest .NE. icpu) THEN IF (dest > icpu) THEN - Nflux = Nflux+1 + Nflux = Nflux + 1 IF (optimized_flux(Nflux) > 0) THEN - list_global(2, ilocal, icpu) = list_global(2, ilocal, icpu)+ & - list_global(2, idest, icpu)-NINT(optimized_flux(Nflux)) + list_global(2, ilocal, icpu) = list_global(2, ilocal, icpu) + & + list_global(2, idest, icpu) - NINT(optimized_flux(Nflux)) list_global(2, idest, icpu) = NINT(optimized_flux(Nflux)) ELSE - list_global(2, ilocal, icpu) = list_global(2, ilocal, icpu)+ & + list_global(2, ilocal, icpu) = list_global(2, ilocal, icpu) + & list_global(2, idest, icpu) list_global(2, idest, icpu) = 0 ENDIF @@ -1073,12 +1073,12 @@ SUBROUTINE balance_global_list(list_global) DO iflux = 1, Nflux IF (flux_connections(1, iflux) == dest .AND. flux_connections(2, iflux) == icpu) THEN IF (optimized_flux(iflux) > 0) THEN - list_global(2, ilocal, icpu) = list_global(2, ilocal, icpu)+ & + list_global(2, ilocal, icpu) = list_global(2, ilocal, icpu) + & list_global(2, idest, icpu) list_global(2, idest, icpu) = 0 ELSE - list_global(2, ilocal, icpu) = list_global(2, ilocal, icpu)+ & - list_global(2, idest, icpu)+NINT(optimized_flux(iflux)) + list_global(2, ilocal, icpu) = list_global(2, ilocal, icpu) + & + list_global(2, idest, icpu) + NINT(optimized_flux(iflux)) list_global(2, idest, icpu) = -NINT(optimized_flux(iflux)) ENDIF EXIT @@ -1147,11 +1147,11 @@ SUBROUTINE optimize_load_list(list, group, my_pos) !need to deduct 1 because `list' was passed in to this routine as being indexed from zero IF (load_partial(idest, icpu) > list_global(2, idest, icpu)) THEN - IF (load_partial(idest, icpu)-list(2, idest, icpu-1) < list_global(2, idest, icpu)) THEN - list(2, idest, icpu-1) = list_global(2, idest, icpu) & - -(load_partial(idest, icpu)-list(2, idest, icpu-1)) + IF (load_partial(idest, icpu) - list(2, idest, icpu - 1) < list_global(2, idest, icpu)) THEN + list(2, idest, icpu - 1) = list_global(2, idest, icpu) & + - (load_partial(idest, icpu) - list(2, idest, icpu - 1)) ELSE - list(2, idest, icpu-1) = 0 + list(2, idest, icpu - 1) = 0 ENDIF ENDIF @@ -1209,7 +1209,7 @@ SUBROUTINE compute_load_list(list, rs_descs, grid_level, tasks, & CALL timeset(routineN, handle) - ALLOCATE (loads(0:rs_descs(grid_level)%rs_desc%group_size-1)) + ALLOCATE (loads(0:rs_descs(grid_level)%rs_desc%group_size - 1)) CALL get_current_loads(loads, rs_descs, grid_level, ntasks, nimages, natoms, maxset, maxpgf, & tasks, use_reordered_ranks=.FALSE.) @@ -1227,25 +1227,25 @@ SUBROUTINE compute_load_list(list, rs_descs, grid_level, tasks, & DO ! first find the range of tasks that deal with the same atom pair - itask_start = itask_stop+1 + itask_start = itask_stop + 1 itask_stop = itask_start IF (itask_stop > ntasks) EXIT CALL int2pair(tasks(3, itask_stop), ilevel, img_old, iatom, jatom, iset, jset, ipgf, jpgf, & nimages, natoms, maxset, maxpgf) - ipair_old = (iatom-1)*natom8+(jatom-1) + ipair_old = (iatom - 1)*natom8 + (jatom - 1) DO - IF (itask_stop+1 > ntasks) EXIT - CALL int2pair(tasks(3, itask_stop+1), ilevel, img, iatom, jatom, iset, jset, ipgf, jpgf, & + IF (itask_stop + 1 > ntasks) EXIT + CALL int2pair(tasks(3, itask_stop + 1), ilevel, img, iatom, jatom, iset, jset, ipgf, jpgf, & nimages, natoms, maxset, maxpgf) - ipair = (iatom-1)*natom8+(jatom-1) + ipair = (iatom - 1)*natom8 + (jatom - 1) IF (ipair == ipair_old .AND. img == img_old) THEN - itask_stop = itask_stop+1 + itask_stop = itask_stop + 1 ELSE EXIT ENDIF ENDDO ipair = ipair_old - nshort = itask_stop-itask_start+1 + nshort = itask_stop - itask_start + 1 ! find the unique list of destinations on this grid level only DEALLOCATE (all_dests) @@ -1253,10 +1253,10 @@ SUBROUTINE compute_load_list(list, rs_descs, grid_level, tasks, & DEALLOCATE (index) ALLOCATE (INDEX(nshort)) DO i = 1, nshort - CALL int2pair(tasks(3, itask_start+i-1), ilevel, img, iatom, jatom, iset, jset, ipgf, jpgf, & + CALL int2pair(tasks(3, itask_start + i - 1), ilevel, img, iatom, jatom, iset, jset, ipgf, jpgf, & nimages, natoms, maxset, maxpgf) IF (ilevel .EQ. grid_level) THEN - all_dests(i) = decode_rank(tasks(1, itask_start+i-1), SIZE(rs_descs)) + all_dests(i) = decode_rank(tasks(1, itask_start + i - 1), SIZE(rs_descs)) ELSE all_dests(i) = HUGE(all_dests(i)) END IF @@ -1265,7 +1265,7 @@ SUBROUTINE compute_load_list(list, rs_descs, grid_level, tasks, & ndest_pair = 1 DO i = 2, nshort IF ((all_dests(ndest_pair) .NE. all_dests(i)) .AND. (all_dests(i) .NE. HUGE(all_dests(i)))) THEN - ndest_pair = ndest_pair+1 + ndest_pair = ndest_pair + 1 all_dests(ndest_pair) = all_dests(i) ENDIF ENDDO @@ -1277,52 +1277,52 @@ SUBROUTINE compute_load_list(list, rs_descs, grid_level, tasks, & nimages, natoms, maxset, maxpgf) ! Only proceed with tasks which are on this grid level IF (ilevel .NE. grid_level) CYCLE - ipair = (iatom-1)*natom8+(jatom-1) + ipair = (iatom - 1)*natom8 + (jatom - 1) cost = INT(tasks(5, itask)) - SELECT CASE (tasks (4, itask)) + SELECT CASE (tasks(4, itask)) CASE (1) bit_pattern = tasks(6, itask) nopt = 0 IF (BTEST(bit_pattern, 0)) THEN rank = rs_grid_locate_rank(rs_descs(ilevel)%rs_desc, dest, (/-1, 0, 0/)) IF (ANY(all_dests(1:ndest_pair) .EQ. rank)) THEN - nopt = nopt+1 + nopt = nopt + 1 options(nopt) = rank ENDIF ENDIF IF (BTEST(bit_pattern, 1)) THEN rank = rs_grid_locate_rank(rs_descs(ilevel)%rs_desc, dest, (/+1, 0, 0/)) IF (ANY(all_dests(1:ndest_pair) .EQ. rank)) THEN - nopt = nopt+1 + nopt = nopt + 1 options(nopt) = rank ENDIF ENDIF IF (BTEST(bit_pattern, 2)) THEN rank = rs_grid_locate_rank(rs_descs(ilevel)%rs_desc, dest, (/0, -1, 0/)) IF (ANY(all_dests(1:ndest_pair) .EQ. rank)) THEN - nopt = nopt+1 + nopt = nopt + 1 options(nopt) = rank ENDIF ENDIF IF (BTEST(bit_pattern, 3)) THEN rank = rs_grid_locate_rank(rs_descs(ilevel)%rs_desc, dest, (/0, +1, 0/)) IF (ANY(all_dests(1:ndest_pair) .EQ. rank)) THEN - nopt = nopt+1 + nopt = nopt + 1 options(nopt) = rank ENDIF ENDIF IF (BTEST(bit_pattern, 4)) THEN rank = rs_grid_locate_rank(rs_descs(ilevel)%rs_desc, dest, (/0, 0, -1/)) IF (ANY(all_dests(1:ndest_pair) .EQ. rank)) THEN - nopt = nopt+1 + nopt = nopt + 1 options(nopt) = rank ENDIF ENDIF IF (BTEST(bit_pattern, 5)) THEN rank = rs_grid_locate_rank(rs_descs(ilevel)%rs_desc, dest, (/0, 0, +1/)) IF (ANY(all_dests(1:ndest_pair) .EQ. rank)) THEN - nopt = nopt+1 + nopt = nopt + 1 options(nopt) = rank ENDIF ENDIF @@ -1337,13 +1337,13 @@ SUBROUTINE compute_load_list(list, rs_descs, grid_level, tasks, & ENDIF li = list_index(list, rank, dest) IF (create_list) THEN - list(2, li, dest) = list(2, li, dest)+cost + list(2, li, dest) = list(2, li, dest) + cost ELSE IF (list(1, li, dest) == dest) THEN tasks(1, itask) = encode_rank(dest, ilevel, SIZE(rs_descs)) ELSE IF (list(2, li, dest) >= cost) THEN - list(2, li, dest) = list(2, li, dest)-cost + list(2, li, dest) = list(2, li, dest) - cost tasks(1, itask) = encode_rank(list(1, li, dest), ilevel, SIZE(rs_descs)) ELSE tasks(1, itask) = encode_rank(dest, ilevel, SIZE(rs_descs)) @@ -1353,13 +1353,13 @@ SUBROUTINE compute_load_list(list, rs_descs, grid_level, tasks, & CASE (2) ! generalised li = list_index(list, dest, dest) IF (create_list) THEN - list(2, li, dest) = list(2, li, dest)+cost + list(2, li, dest) = list(2, li, dest) + cost ELSE IF (list(1, li, dest) == dest) THEN tasks(1, itask) = encode_rank(dest, ilevel, SIZE(rs_descs)) ELSE IF (list(2, li, dest) >= cost) THEN - list(2, li, dest) = list(2, li, dest)-cost + list(2, li, dest) = list(2, li, dest) - cost tasks(1, itask) = encode_rank(list(1, li, dest), ilevel, SIZE(rs_descs)) ELSE tasks(1, itask) = encode_rank(dest, ilevel, SIZE(rs_descs)) @@ -1394,7 +1394,7 @@ INTEGER FUNCTION list_index(list, rank, dest) list_index = 1 DO IF (list(1, list_index, dest) == rank) EXIT - list_index = list_index+1 + list_index = list_index + 1 ENDDO END FUNCTION list_index ! ************************************************************************************************** @@ -1426,14 +1426,14 @@ SUBROUTINE create_destination_list(list, rs_descs, grid_level) ncpu = rs_descs(grid_level)%rs_desc%group_size ultimate_max = 7 - ALLOCATE (list(2, ultimate_max, 0:ncpu-1)) + ALLOCATE (list(2, ultimate_max, 0:ncpu - 1)) ALLOCATE (INDEX(ultimate_max)) ALLOCATE (sublist(ultimate_max)) sublist = HUGE(sublist) maxcount = 1 - DO icpu = 0, ncpu-1 + DO icpu = 0, ncpu - 1 sublist(1) = icpu sublist(2) = rs_grid_locate_rank(rs_descs(grid_level)%rs_desc, icpu, (/-1, 0, 0/)) sublist(3) = rs_grid_locate_rank(rs_descs(grid_level)%rs_desc, icpu, (/+1, 0, 0/)) @@ -1446,17 +1446,17 @@ SUBROUTINE create_destination_list(list, rs_descs, grid_level) j = 1 DO i = 2, 7 IF (sublist(i) .NE. sublist(j)) THEN - j = j+1 + j = j + 1 sublist(j) = sublist(i) ENDIF ENDDO maxcount = MAX(maxcount, j) - sublist(j+1:ultimate_max) = HUGE(sublist) + sublist(j + 1:ultimate_max) = HUGE(sublist) list(1, :, icpu) = sublist list(2, :, icpu) = 0 ENDDO - CALL reallocate(list, 1, 2, 1, maxcount, 0, ncpu-1) + CALL reallocate(list, 1, 2, 1, maxcount, 0, ncpu - 1) CALL timestop(handle) @@ -1516,13 +1516,13 @@ SUBROUTINE get_current_loads(loads, rs_descs, grid_level, ntasks, nimages, natom CALL int2pair(tasks(3, i), ilevel, img, iatom, jatom, iset, jset, ipgf, jpgf, nimages, natom, maxset, maxpgf) IF (ilevel .NE. grid_level) CYCLE IF (use_reordered_ranks) THEN - send_buf_i(rs_descs(ilevel)%rs_desc%virtual2real(decode_rank(tasks(1, i), SIZE(rs_descs)))+1) = & - send_buf_i(rs_descs(ilevel)%rs_desc%virtual2real(decode_rank(tasks(1, i), SIZE(rs_descs)))+1) & - +tasks(5, i) + send_buf_i(rs_descs(ilevel)%rs_desc%virtual2real(decode_rank(tasks(1, i), SIZE(rs_descs))) + 1) = & + send_buf_i(rs_descs(ilevel)%rs_desc%virtual2real(decode_rank(tasks(1, i), SIZE(rs_descs))) + 1) & + + tasks(5, i) ELSE - send_buf_i(decode_rank(tasks(1, i), SIZE(rs_descs))+1) = & - send_buf_i(decode_rank(tasks(1, i), SIZE(rs_descs))+1) & - +tasks(5, i) + send_buf_i(decode_rank(tasks(1, i), SIZE(rs_descs)) + 1) = & + send_buf_i(decode_rank(tasks(1, i), SIZE(rs_descs)) + 1) & + + tasks(5, i) END IF END DO CALL mp_alltoall(send_buf_i, recv_buf_i, 1, desc%group) @@ -1584,7 +1584,7 @@ SUBROUTINE load_balance_replicated(rs_descs, ntasks, tasks, nimages, natoms, max DO i = 1, SIZE(rs_descs) CALL get_current_loads(loads, rs_descs, i, ntasks, nimages, natoms, maxset, maxpgf, & tasks, use_reordered_ranks=.TRUE.) - recv_buf_i(:) = recv_buf_i+loads + recv_buf_i(:) = recv_buf_i + loads END DO total_cost_global = SUM(recv_buf_i) @@ -1599,13 +1599,13 @@ SUBROUTINE load_balance_replicated(rs_descs, ntasks, tasks, nimages, natoms, max ALLOCATE (load_imbalance(desc%group_size)) ALLOCATE (INDEX(desc%group_size)) - load_imbalance(:) = recv_buf_i-average_cost + load_imbalance(:) = recv_buf_i - average_cost no_overloaded = 0 no_underloaded = 0 DO i = 1, desc%group_size - IF (load_imbalance(i) .GT. 0) no_overloaded = no_overloaded+1 - IF (load_imbalance(i) .LT. 0) no_underloaded = no_underloaded+1 + IF (load_imbalance(i) .GT. 0) no_overloaded = no_overloaded + 1 + IF (load_imbalance(i) .LT. 0) no_underloaded = no_underloaded + 1 ENDDO ! sort the recv_buffer on number of tasks, gives us index which provides a @@ -1618,7 +1618,7 @@ SUBROUTINE load_balance_replicated(rs_descs, ntasks, tasks, nimages, natoms, max DO i = 1, ntasks IF (tasks(4, i) .EQ. 0 & .AND. decode_rank(tasks(1, i), SIZE(rs_descs)) == decode_rank(tasks(2, i), SIZE(rs_descs))) THEN - cost_task_rep = cost_task_rep+tasks(5, i) + cost_task_rep = cost_task_rep + tasks(5, i) ENDIF ENDDO @@ -1638,24 +1638,24 @@ SUBROUTINE load_balance_replicated(rs_descs, ntasks, tasks, nimages, natoms, max ! task balancing will be incomplete ! only need to do anything if I've excess tasks - IF (load_imbalance(desc%my_pos+1) .GT. 0) THEN + IF (load_imbalance(desc%my_pos + 1) .GT. 0) THEN count = 0 ! weighted amount of tasks offloaded offset = 0 ! no of underloaded processes already filled by other more overloaded procs ! calculate offset - DO i = desc%group_size, desc%group_size-no_overloaded+1, -1 - IF (INDEX(i) .EQ. desc%my_pos+1) THEN + DO i = desc%group_size, desc%group_size - no_overloaded + 1, -1 + IF (INDEX(i) .EQ. desc%my_pos + 1) THEN EXIT ELSE - offset = offset+load_imbalance(INDEX(i)) + offset = offset + load_imbalance(INDEX(i)) ENDIF ENDDO ! find my starting processor to send to proc_receiving = HUGE(proc_receiving) DO i = 1, no_underloaded - offset = offset+load_imbalance(INDEX(i)) + offset = offset + load_imbalance(INDEX(i)) IF (offset .LE. 0) THEN proc_receiving = i EXIT @@ -1673,12 +1673,12 @@ SUBROUTINE load_balance_replicated(rs_descs, ntasks, tasks, nimages, natoms, max IF (proc_receiving .GT. no_underloaded) EXIT ! set new destination CALL int2pair(tasks(3, j), ilevel, img, iatom, jatom, iset, jset, ipgf, jpgf, nimages, natoms, maxset, maxpgf) - tasks(1, j) = encode_rank(INDEX(proc_receiving)-1, ilevel, SIZE(rs_descs)) - offset = offset+tasks(5, j) - count = count+tasks(5, j) - IF (count .GE. load_imbalance(desc%my_pos+1)) EXIT + tasks(1, j) = encode_rank(INDEX(proc_receiving) - 1, ilevel, SIZE(rs_descs)) + offset = offset + tasks(5, j) + count = count + tasks(5, j) + IF (count .GE. load_imbalance(desc%my_pos + 1)) EXIT IF (offset .GT. 0) THEN - proc_receiving = proc_receiving+1 + proc_receiving = proc_receiving + 1 ! just avoid sending to non existing procs due to integer truncation ! in the computation of the average IF (proc_receiving .GT. no_underloaded) EXIT @@ -1747,7 +1747,7 @@ SUBROUTINE create_local_tasks(rs_descs, ntasks, tasks, rval, & send_buf_i = 0 DO i = 1, ntasks rank = rs_descs(decode_level(tasks(1, i), SIZE(rs_descs)))%rs_desc%virtual2real(decode_rank(tasks(1, i), SIZE(rs_descs))) - send_buf_i(rank+1) = send_buf_i(rank+1)+1 + send_buf_i(rank + 1) = send_buf_i(rank + 1) + 1 END DO CALL mp_alltoall(send_buf_i, recv_buf_i, 1, desc%group) @@ -1766,8 +1766,8 @@ SUBROUTINE create_local_tasks(rs_descs, ntasks, tasks, rval, & DO i = 2, desc%group_size send_sizes(i) = INT(send_buf_i(i)*task_dim) recv_sizes(i) = INT(recv_buf_i(i)*task_dim) - send_disps(i) = send_disps(i-1)+send_sizes(i-1) - recv_disps(i) = recv_disps(i-1)+recv_sizes(i-1) + send_disps(i) = send_disps(i - 1) + send_sizes(i - 1) + recv_disps(i) = recv_disps(i - 1) + recv_sizes(i - 1) ENDDO ! deallocate old send/recv buffers @@ -1782,11 +1782,11 @@ SUBROUTINE create_local_tasks(rs_descs, ntasks, tasks, rval, & send_buf_i = 0 send_sizes = 0 DO j = 1, ntasks - i = rs_descs(decode_level(tasks(1, j), SIZE(rs_descs)))%rs_desc%virtual2real(decode_rank(tasks(1, j), SIZE(rs_descs)))+1 + i = rs_descs(decode_level(tasks(1, j), SIZE(rs_descs)))%rs_desc%virtual2real(decode_rank(tasks(1, j), SIZE(rs_descs))) + 1 DO k = 1, task_dim - send_buf_i(send_disps(i)+send_sizes(i)+k) = tasks(k, j) + send_buf_i(send_disps(i) + send_sizes(i) + k) = tasks(k, j) ENDDO - send_sizes(i) = send_sizes(i)+task_dim + send_sizes(i) = send_sizes(i) + task_dim ENDDO ! do communication @@ -1800,10 +1800,10 @@ SUBROUTINE create_local_tasks(rs_descs, ntasks, tasks, rval, & ! do unpacking l = 0 DO i = 1, desc%group_size - DO j = 0, recv_sizes(i)/task_dim-1 - l = l+1 + DO j = 0, recv_sizes(i)/task_dim - 1 + l = l + 1 DO k = 1, task_dim - tasks_recv(k, l) = recv_buf_i(recv_disps(i)+j*task_dim+k) + tasks_recv(k, l) = recv_buf_i(recv_disps(i) + j*task_dim + k) ENDDO ENDDO ENDDO @@ -1825,11 +1825,11 @@ SUBROUTINE create_local_tasks(rs_descs, ntasks, tasks, rval, & !do packing send_sizes = 0 DO j = 1, ntasks - i = rs_descs(decode_level(tasks(1, j), SIZE(rs_descs)))%rs_desc%virtual2real(decode_rank(tasks(1, j), SIZE(rs_descs)))+1 + i = rs_descs(decode_level(tasks(1, j), SIZE(rs_descs)))%rs_desc%virtual2real(decode_rank(tasks(1, j), SIZE(rs_descs))) + 1 DO k = 1, task_dim - send_buf_r(send_disps(i)+send_sizes(i)+k) = rval(k, j) + send_buf_r(send_disps(i) + send_sizes(i) + k) = rval(k, j) ENDDO - send_sizes(i) = send_sizes(i)+task_dim + send_sizes(i) = send_sizes(i) + task_dim ENDDO ! do communication @@ -1842,10 +1842,10 @@ SUBROUTINE create_local_tasks(rs_descs, ntasks, tasks, rval, & ! do unpacking l = 0 DO i = 1, desc%group_size - DO j = 0, recv_sizes(i)/task_dim-1 - l = l+1 + DO j = 0, recv_sizes(i)/task_dim - 1 + l = l + 1 DO k = 1, task_dim - rval_recv(k, l) = recv_buf_r(recv_disps(i)+j*task_dim+k) + rval_recv(k, l) = recv_buf_r(recv_disps(i) + j*task_dim + k) ENDDO ENDDO ENDDO @@ -1921,8 +1921,8 @@ SUBROUTINE distribute_tasks(rs_descs, ntasks, natoms, maxset, maxpgf, nimages, & IF (distributed_grids) THEN - ALLOCATE (loads(0:desc%group_size-1, SIZE(rs_descs))) - ALLOCATE (total_loads(0:desc%group_size-1)) + ALLOCATE (loads(0:desc%group_size - 1, SIZE(rs_descs))) + ALLOCATE (total_loads(0:desc%group_size - 1)) total_loads = 0 @@ -1937,7 +1937,7 @@ SUBROUTINE distribute_tasks(rs_descs, ntasks, natoms, maxset, maxpgf, nimages, & CALL get_current_loads(loads(:, igrid_level), rs_descs, igrid_level, ntasks, nimages, natoms, maxset, maxpgf, & tasks, use_reordered_ranks=.FALSE.) - total_loads(:) = total_loads+loads(:, igrid_level) + total_loads(:) = total_loads + loads(:, igrid_level) END IF END DO @@ -1950,7 +1950,7 @@ SUBROUTINE distribute_tasks(rs_descs, ntasks, natoms, maxset, maxpgf, nimages, & IF (.NOT. rs_descs(igrid_level)%rs_desc%distributed) THEN CALL get_current_loads(loads(:, igrid_level), rs_descs, igrid_level, ntasks, nimages, natoms, maxset, maxpgf, & tasks, use_reordered_ranks=.FALSE.) - replicated_load = replicated_load+SUM(loads(:, igrid_level)) + replicated_load = replicated_load + SUM(loads(:, igrid_level)) END IF END DO @@ -1968,23 +1968,23 @@ SUBROUTINE distribute_tasks(rs_descs, ntasks, natoms, maxset, maxpgf, nimages, & total_loads(:) = loads(:, igrid_level) fixed_first_grid = .TRUE. ELSE - ALLOCATE (trial_loads(0:desc%group_size-1)) + ALLOCATE (trial_loads(0:desc%group_size - 1)) - trial_loads(:) = total_loads+loads(:, igrid_level) + trial_loads(:) = total_loads + loads(:, igrid_level) max_load = MAXVAL(trial_loads) load_gap = 0 - DO irank = 0, desc%group_size-1 - load_gap = load_gap+max_load-trial_loads(irank) + DO irank = 0, desc%group_size - 1 + load_gap = load_gap + max_load - trial_loads(irank) END DO ! If there is not enough replicated load to load balance well enough ! then we will reorder this grid level IF (load_gap > replicated_load*1.05_dp) THEN - ALLOCATE (INDEX(0:desc%group_size-1)) - ALLOCATE (total_index(0:desc%group_size-1)) - ALLOCATE (total_loads_tmp(0:desc%group_size-1)) - ALLOCATE (real2virtual(0:desc%group_size-1)) + ALLOCATE (INDEX(0:desc%group_size - 1)) + ALLOCATE (total_index(0:desc%group_size - 1)) + ALLOCATE (total_loads_tmp(0:desc%group_size - 1)) + ALLOCATE (real2virtual(0:desc%group_size - 1)) total_loads_tmp(:) = total_loads CALL sort(total_loads_tmp, desc%group_size, total_index) @@ -1992,10 +1992,10 @@ SUBROUTINE distribute_tasks(rs_descs, ntasks, natoms, maxset, maxpgf, nimages, & ! Reorder so that the rank with smallest load on this grid level is paired with ! the highest load in total - DO irank = 0, desc%group_size-1 - total_loads(total_index(irank)-1) = total_loads(total_index(irank)-1)+ & - loads(desc%group_size-irank-1, igrid_level) - real2virtual(total_index(irank)-1) = INDEX(desc%group_size-irank-1)-1 + DO irank = 0, desc%group_size - 1 + total_loads(total_index(irank) - 1) = total_loads(total_index(irank) - 1) + & + loads(desc%group_size - irank - 1, igrid_level) + real2virtual(total_index(irank) - 1) = INDEX(desc%group_size - irank - 1) - 1 END DO CALL rs_grid_reorder_ranks(rs_descs(igrid_level)%rs_desc, real2virtual) @@ -2159,12 +2159,12 @@ SUBROUTINE get_atom_pair(atom_pair, my_tasks, send, symmetric, natoms, maxset, & ! If sending, we need to use the 'real rank' as the pair has to be sent to the process which ! actually has the correct part of the rs_grid to do the mapping atom_pair(i) = rs_descs(ilevel)%rs_desc%virtual2real(decode_rank(my_tasks(1, i), SIZE(rs_descs))) & - *natom8*natom8*nim8+(arow-1)*natom8*nim8+(acol-1)*nim8+(img-1) + *natom8*natom8*nim8 + (arow - 1)*natom8*nim8 + (acol - 1)*nim8 + (img - 1) ELSE ! If we are recieving, then no conversion is needed as the rank is that of the process with the ! required matrix block, and the ordering of the rs grid is irrelevant atom_pair(i) = decode_rank(my_tasks(2, i), SIZE(rs_descs)) & - *natom8*natom8*nim8+(arow-1)*natom8*nim8+(acol-1)*nim8+(img-1) + *natom8*natom8*nim8 + (arow - 1)*natom8*nim8 + (acol - 1)*nim8 + (img - 1) ENDIF ENDDO @@ -2179,8 +2179,8 @@ SUBROUTINE get_atom_pair(atom_pair, my_tasks, send, symmetric, natoms, maxset, & j = 1 ! first atom pair must be allowed DO i = 2, SIZE(atom_pair) - IF (atom_pair(i) .GT. atom_pair(i-1)) THEN - j = j+1 + IF (atom_pair(i) .GT. atom_pair(i - 1)) THEN + j = j + 1 atom_pair(j) = atom_pair(i) ENDIF ENDDO @@ -2241,7 +2241,7 @@ SUBROUTINE rs_distribute_matrix(rs_descs, pmats, atom_pair_send, atom_pair_recv, END IF desc => rs_descs(1)%rs_desc - me = desc%my_pos+1 + me = desc%my_pos + 1 ! allocate local arrays ALLOCATE (send_sizes(desc%group_size)) @@ -2272,26 +2272,26 @@ SUBROUTINE rs_distribute_matrix(rs_descs, pmats, atom_pair_send, atom_pair_recv, DO i = 1, SIZE(atom_pair_send) ! proc we're sending this block to - k = INT(atom_pair_send(i)/(nim8*natom8**2))+1 + k = INT(atom_pair_send(i)/(nim8*natom8**2)) + 1 pair = MOD(atom_pair_send(i), nim8*natom8**2) - arow = INT(pair/(nim8*natom8))+1 - acol = INT(MOD(pair, nim8*natom8)/nim8)+1 + arow = INT(pair/(nim8*natom8)) + 1 + acol = INT(MOD(pair, nim8*natom8)/nim8) + 1 - nrow = last_row(arow)-first_row(arow)+1 - ncol = last_col(acol)-first_col(acol)+1 + nrow = last_row(arow) - first_row(arow) + 1 + ncol = last_col(acol) - first_col(acol) + 1 - send_sizes(k) = send_sizes(k)+nrow*ncol - send_pair_count(k) = send_pair_count(k)+1 + send_sizes(k) = send_sizes(k) + nrow*ncol + send_pair_count(k) = send_pair_count(k) + 1 ENDDO send_disps = 0 send_pair_disps = 0 DO i = 2, desc%group_size - send_disps(i) = send_disps(i-1)+send_sizes(i-1) - send_pair_disps(i) = send_pair_disps(i-1)+send_pair_count(i-1) + send_disps(i) = send_disps(i - 1) + send_sizes(i - 1) + send_pair_disps(i) = send_pair_disps(i - 1) + send_pair_count(i - 1) ENDDO ALLOCATE (send_buf_r(SUM(send_sizes))) @@ -2303,26 +2303,26 @@ SUBROUTINE rs_distribute_matrix(rs_descs, pmats, atom_pair_send, atom_pair_recv, DO i = 1, SIZE(atom_pair_recv) ! proc we're receiving this data from - k = INT(atom_pair_recv(i)/(nim8*natom8**2))+1 + k = INT(atom_pair_recv(i)/(nim8*natom8**2)) + 1 pair = MOD(atom_pair_recv(i), nim8*natom8**2) - arow = INT(pair/(nim8*natom8))+1 - acol = INT(MOD(pair, nim8*natom8)/nim8)+1 + arow = INT(pair/(nim8*natom8)) + 1 + acol = INT(MOD(pair, nim8*natom8)/nim8) + 1 - nrow = last_row(arow)-first_row(arow)+1 - ncol = last_col(acol)-first_col(acol)+1 + nrow = last_row(arow) - first_row(arow) + 1 + ncol = last_col(acol) - first_col(acol) + 1 - recv_sizes(k) = recv_sizes(k)+nrow*ncol - recv_pair_count(k) = recv_pair_count(k)+1 + recv_sizes(k) = recv_sizes(k) + nrow*ncol + recv_pair_count(k) = recv_pair_count(k) + 1 ENDDO recv_disps = 0 recv_pair_disps = 0 DO i = 2, desc%group_size - recv_disps(i) = recv_disps(i-1)+recv_sizes(i-1) - recv_pair_disps(i) = recv_pair_disps(i-1)+recv_pair_count(i-1) + recv_disps(i) = recv_disps(i - 1) + recv_sizes(i - 1) + recv_pair_disps(i) = recv_pair_disps(i - 1) + recv_pair_count(i - 1) ENDDO ALLOCATE (recv_buf_r(SUM(recv_sizes))) @@ -2339,7 +2339,7 @@ SUBROUTINE rs_distribute_matrix(rs_descs, pmats, atom_pair_send, atom_pair_recv, nthread = 1 !$ nthread = omp_get_num_threads() nthread_left = 1 -!$ nthread_left = MAX(1, nthread-1) +!$ nthread_left = MAX(1, nthread - 1) ! do packing !$OMP DO schedule(guided) @@ -2347,14 +2347,14 @@ SUBROUTINE rs_distribute_matrix(rs_descs, pmats, atom_pair_send, atom_pair_recv, IF (l .EQ. me) CYCLE send_sizes(l) = 0 DO i = 1, send_pair_count(l) - pair = MOD(atom_pair_send(send_pair_disps(l)+i), nim8*natom8**2) + pair = MOD(atom_pair_send(send_pair_disps(l) + i), nim8*natom8**2) - arow = INT(pair/(nim8*natom8))+1 - acol = INT(MOD(pair, nim8*natom8)/nim8)+1 - img = INT(MOD(pair, nim8))+1 + arow = INT(pair/(nim8*natom8)) + 1 + acol = INT(MOD(pair, nim8*natom8)/nim8) + 1 + img = INT(MOD(pair, nim8)) + 1 - nrow = last_row(arow)-first_row(arow)+1 - ncol = last_col(acol)-first_col(acol)+1 + nrow = last_row(arow) - first_row(arow) + 1 + ncol = last_col(acol) - first_col(acol) + 1 pmat => pmats(img)%matrix CALL dbcsr_get_block_p(matrix=pmat, row=arow, col=acol, & @@ -2363,10 +2363,10 @@ SUBROUTINE rs_distribute_matrix(rs_descs, pmats, atom_pair_send, atom_pair_recv, DO k = 1, ncol DO j = 1, nrow - send_buf_r(send_disps(l)+send_sizes(l)+j+(k-1)*nrow) = p_block(j, k) + send_buf_r(send_disps(l) + send_sizes(l) + j + (k - 1)*nrow) = p_block(j, k) ENDDO ENDDO - send_sizes(l) = send_sizes(l)+nrow*ncol + send_sizes(l) = send_sizes(l) + nrow*ncol ENDDO ENDDO !$OMP END DO @@ -2397,14 +2397,14 @@ SUBROUTINE rs_distribute_matrix(rs_descs, pmats, atom_pair_send, atom_pair_recv, ! Distribute work over remaining threads assuming one is still in the alltoall !$OMP DO schedule(dynamic,MAX(1,send_pair_count(me)/nthread_left)) DO i = 1, send_pair_count(me) - pair = MOD(atom_pair_send(send_pair_disps(me)+i), nim8*natom8**2) + pair = MOD(atom_pair_send(send_pair_disps(me) + i), nim8*natom8**2) - arow = INT(pair/(nim8*natom8))+1 - acol = INT(MOD(pair, nim8*natom8)/nim8)+1 - img = INT(MOD(pair, nim8))+1 + arow = INT(pair/(nim8*natom8)) + 1 + acol = INT(MOD(pair, nim8*natom8)/nim8) + 1 + img = INT(MOD(pair, nim8)) + 1 - nrow = last_row(arow)-first_row(arow)+1 - ncol = last_col(acol)-first_col(acol)+1 + nrow = last_row(arow) - first_row(arow) + 1 + ncol = last_col(acol) - first_col(acol) + 1 hmat => hmats(img)%matrix pmat => pmats(img)%matrix @@ -2415,13 +2415,13 @@ SUBROUTINE rs_distribute_matrix(rs_descs, pmats, atom_pair_send, atom_pair_recv, BLOCK=p_block, found=found) CPASSERT(found) -!$ call omp_set_lock(locks((arow-1)*nthread*10/nblkrows_total+1)) +!$ call omp_set_lock(locks((arow - 1)*nthread*10/nblkrows_total + 1)) DO k = 1, ncol DO j = 1, nrow - h_block(j, k) = h_block(j, k)+p_block(j, k) + h_block(j, k) = h_block(j, k) + p_block(j, k) ENDDO ENDDO -!$ call omp_unset_lock(locks((arow-1)*nthread*10/nblkrows_total+1)) +!$ call omp_unset_lock(locks((arow - 1)*nthread*10/nblkrows_total + 1)) ENDDO !$OMP END DO ELSE @@ -2443,14 +2443,14 @@ SUBROUTINE rs_distribute_matrix(rs_descs, pmats, atom_pair_send, atom_pair_recv, IF (l .EQ. me) CYCLE recv_sizes(l) = 0 DO i = 1, recv_pair_count(l) - pair = MOD(atom_pair_recv(recv_pair_disps(l)+i), nim8*natom8**2) + pair = MOD(atom_pair_recv(recv_pair_disps(l) + i), nim8*natom8**2) - arow = INT(pair/(nim8*natom8))+1 - acol = INT(MOD(pair, nim8*natom8)/nim8)+1 - img = INT(MOD(pair, nim8))+1 + arow = INT(pair/(nim8*natom8)) + 1 + acol = INT(MOD(pair, nim8*natom8)/nim8) + 1 + img = INT(MOD(pair, nim8)) + 1 - nrow = last_row(arow)-first_row(arow)+1 - ncol = last_col(acol)-first_col(acol)+1 + nrow = last_row(arow) - first_row(arow) + 1 + ncol = last_col(acol) - first_col(acol) + 1 pmat => pmats(img)%matrix NULLIFY (p_block) @@ -2466,18 +2466,18 @@ SUBROUTINE rs_distribute_matrix(rs_descs, pmats, atom_pair_send, atom_pair_recv, IF (scatter .AND. .NOT. ASSOCIATED(p_block)) THEN CALL dbcsr_put_block(pmat, arow, acol, & - block=recv_buf_r(recv_disps(l)+recv_sizes(l)+1:recv_disps(l)+recv_sizes(l)+nrow*ncol)) + block=recv_buf_r(recv_disps(l) + recv_sizes(l) + 1:recv_disps(l) + recv_sizes(l) + nrow*ncol)) END IF IF (.NOT. scatter) THEN -!$ call omp_set_lock(locks((arow-1)*nthread*10/nblkrows_total+1)) +!$ call omp_set_lock(locks((arow - 1)*nthread*10/nblkrows_total + 1)) DO k = 1, ncol DO j = 1, nrow - h_block(j, k) = h_block(j, k)+recv_buf_r(recv_disps(l)+recv_sizes(l)+j+(k-1)*nrow) + h_block(j, k) = h_block(j, k) + recv_buf_r(recv_disps(l) + recv_sizes(l) + j + (k - 1)*nrow) ENDDO ENDDO -!$ call omp_unset_lock(locks((arow-1)*nthread*10/nblkrows_total+1)) +!$ call omp_unset_lock(locks((arow - 1)*nthread*10/nblkrows_total + 1)) ENDIF - recv_sizes(l) = recv_sizes(l)+nrow*ncol + recv_sizes(l) = recv_sizes(l) + nrow*ncol ENDDO ENDDO !$OMP END DO @@ -2565,11 +2565,11 @@ SUBROUTINE rs_find_node(rs_desc, igrid_level, n_levels, cube_center, ntasks, tas dest = rs_desc%coord2rank(coord(1), coord(2), coord(3)) ! the real cube coordinates - lbc = lb_cube+cube_center - ubc = ub_cube+cube_center + lbc = lb_cube + cube_center + ubc = ub_cube + cube_center - IF (ALL((rs_desc%lb_global(:, dest)-rs_desc%border) .LE. lbc) .AND. & - ALL((rs_desc%ub_global(:, dest)+rs_desc%border) .GE. ubc)) THEN + IF (ALL((rs_desc%lb_global(:, dest) - rs_desc%border) .LE. lbc) .AND. & + ALL((rs_desc%ub_global(:, dest) + rs_desc%border) .GE. ubc)) THEN !standard distributed collocation/integration tasks(1, ntasks) = encode_rank(dest, igrid_level, n_levels) tasks(4, ntasks) = 1 @@ -2594,25 +2594,25 @@ SUBROUTINE rs_find_node(rs_desc, igrid_level, n_levels, cube_center, ntasks, tas DO i = 1, 3 IF (rs_desc%perd(i) == 1) THEN bit_pattern = IBCLR(bit_pattern, bit_index) - bit_index = bit_index+1 + bit_index = bit_index + 1 bit_pattern = IBCLR(bit_pattern, bit_index) - bit_index = bit_index+1 + bit_index = bit_index + 1 ELSE ! fits the left neighbor ? - IF (ubc(i) <= rs_desc%lb_global(i, dest)-1+rs_desc%border) THEN + IF (ubc(i) <= rs_desc%lb_global(i, dest) - 1 + rs_desc%border) THEN bit_pattern = IBSET(bit_pattern, bit_index) - bit_index = bit_index+1 + bit_index = bit_index + 1 ELSE bit_pattern = IBCLR(bit_pattern, bit_index) - bit_index = bit_index+1 + bit_index = bit_index + 1 ENDIF ! fits the right neighbor ? - IF (lbc(i) >= rs_desc%ub_global(i, dest)+1-rs_desc%border) THEN + IF (lbc(i) >= rs_desc%ub_global(i, dest) + 1 - rs_desc%border) THEN bit_pattern = IBSET(bit_pattern, bit_index) - bit_index = bit_index+1 + bit_index = bit_index + 1 ELSE bit_pattern = IBCLR(bit_pattern, bit_index) - bit_index = bit_index+1 + bit_index = bit_index + 1 ENDIF ENDIF ENDDO @@ -2626,18 +2626,18 @@ SUBROUTINE rs_find_node(rs_desc, igrid_level, n_levels, cube_center, ntasks, tas ! i.e. ub_coord-lb_coord+1 might be larger than group_dim lb_coord = coord ub_coord = coord - lb_domain = rs_desc%lb_global(:, dest)-rs_desc%border - ub_domain = rs_desc%ub_global(:, dest)+rs_desc%border + lb_domain = rs_desc%lb_global(:, dest) - rs_desc%border + ub_domain = rs_desc%ub_global(:, dest) + rs_desc%border DO i = 1, 3 ! only if the grid is not periodic in this direction we need to take care of adding neighbors IF (rs_desc%perd(i) == 0) THEN ! if the domain lower bound is greater than the lbc we need to add the size of the neighbor domain DO IF (lb_domain(i) > lbc(i)) THEN - lb_coord(i) = lb_coord(i)-1 + lb_coord(i) = lb_coord(i) - 1 icoord = MODULO(lb_coord, rs_desc%group_dim) idest = rs_desc%coord2rank(icoord(1), icoord(2), icoord(3)) - lb_domain(i) = lb_domain(i)-(rs_desc%ub_global(i, idest)-rs_desc%lb_global(i, idest)+1) + lb_domain(i) = lb_domain(i) - (rs_desc%ub_global(i, idest) - rs_desc%lb_global(i, idest) + 1) ELSE EXIT ENDIF @@ -2645,10 +2645,10 @@ SUBROUTINE rs_find_node(rs_desc, igrid_level, n_levels, cube_center, ntasks, tas ! same for the upper bound DO IF (ub_domain(i) < ubc(i)) THEN - ub_coord(i) = ub_coord(i)+1 + ub_coord(i) = ub_coord(i) + 1 icoord = MODULO(ub_coord, rs_desc%group_dim) idest = rs_desc%coord2rank(icoord(1), icoord(2), icoord(3)) - ub_domain(i) = ub_domain(i)+(rs_desc%ub_global(i, idest)-rs_desc%lb_global(i, idest)+1) + ub_domain(i) = ub_domain(i) + (rs_desc%ub_global(i, idest) - rs_desc%lb_global(i, idest) + 1) ELSE EXIT ENDIF @@ -2658,20 +2658,20 @@ SUBROUTINE rs_find_node(rs_desc, igrid_level, n_levels, cube_center, ntasks, tas ! some care is needed for the periodic boundaries DO i = 1, 3 - IF (ub_domain(i)-lb_domain(i)+1 >= rs_desc%npts(i)) THEN + IF (ub_domain(i) - lb_domain(i) + 1 >= rs_desc%npts(i)) THEN dir_periodic(i) = .TRUE. lb_coord(i) = 0 - ub_coord(i) = rs_desc%group_dim(i)-1 + ub_coord(i) = rs_desc%group_dim(i) - 1 ELSE dir_periodic(i) = .FALSE. ENDIF ENDDO - added_tasks = PRODUCT(ub_coord-lb_coord+1) + added_tasks = PRODUCT(ub_coord - lb_coord + 1) itask = ntasks - ntasks = ntasks+added_tasks-1 + ntasks = ntasks + added_tasks - 1 IF (ntasks > SIZE(tasks, 2)) THEN - curr_tasks = INT((SIZE(tasks, 2)+add_tasks)*mult_tasks) + curr_tasks = INT((SIZE(tasks, 2) + add_tasks)*mult_tasks) CALL reallocate(tasks, 1, 6, 1, curr_tasks) END IF DO iz = lb_coord(3), ub_coord(3) @@ -2690,7 +2690,7 @@ SUBROUTINE rs_find_node(rs_desc, igrid_level, n_levels, cube_center, ntasks, tas IF (iy == ub_coord(2) .AND. .NOT. dir_periodic(2)) tasks(6, itask) = IBSET(tasks(6, itask), 3) IF (iz == lb_coord(3) .AND. .NOT. dir_periodic(3)) tasks(6, itask) = IBSET(tasks(6, itask), 4) IF (iz == ub_coord(3) .AND. .NOT. dir_periodic(3)) tasks(6, itask) = IBSET(tasks(6, itask), 5) - itask = itask+1 + itask = itask + 1 ENDDO ENDDO ENDDO @@ -2717,7 +2717,7 @@ FUNCTION encode_rank(rank, grid_level, n_levels) RESULT(encoded_int) ! ordered so can still sort by rank - encoded_int = rank*n_levels+grid_level-1 + encoded_int = rank*n_levels + grid_level - 1 END FUNCTION @@ -2753,7 +2753,7 @@ FUNCTION decode_level(encoded_int, n_levels) RESULT(grid_level) n_levels8 = n_levels - grid_level = INT(MODULO(encoded_int, n_levels8))+1 + grid_level = INT(MODULO(encoded_int, n_levels8)) + 1 END FUNCTION decode_level diff --git a/src/tmc/tmc_analysis.F b/src/tmc/tmc_analysis.F index 726032ebb9..bbefb5ac98 100644 --- a/src/tmc/tmc_analysis.F +++ b/src/tmc/tmc_analysis.F @@ -172,8 +172,8 @@ SUBROUTINE tmc_read_ana_input(tmc_ana_section, tmc_ana) IF (explicit_key) THEN CALL tmc_ana_dipole_analysis_create(tmc_ana%dip_ana) CALL section_vals_val_get(tmc_ana_section, "DIPOLE_ANALYSIS", c_val=c_tmp) - SELECT CASE (TRIM (c_tmp)) - CASE (TRIM (tmc_default_unspecified_name)) + SELECT CASE (TRIM(c_tmp)) + CASE (TRIM(tmc_default_unspecified_name)) tmc_ana%dip_ana%ana_type = ana_type_default CASE ("ICE") tmc_ana%dip_ana%ana_type = ana_type_ice @@ -488,7 +488,7 @@ SUBROUTINE do_tmc_analysis(elem, ana_env) CALL timeset(routineN, handle) IF (ASSOCIATED(ana_env%last_elem) .AND. & (ana_env%last_elem%nr .LT. elem%nr)) THEN - weight_act = elem%nr-ana_env%last_elem%nr + weight_act = elem%nr - ana_env%last_elem%nr ! calculates the 3 dimensional distributed density IF (ASSOCIATED(ana_env%density_3d)) & CALL calc_density_3d(elem=ana_env%last_elem, & @@ -776,15 +776,15 @@ SUBROUTINE calc_density_3d(elem, weight, atoms, ana_env) CALL get_scaled_cell(cell=ana_env%cell, box_scale=elem%box_scale, & abc=cell_size, vol=vol_cell) ! volume summed over configurations for average volume [A] - ana_env%density_3d%sum_vol = ana_env%density_3d%sum_vol+ & + ana_env%density_3d%sum_vol = ana_env%density_3d%sum_vol + & vol_cell*(au2a)**3*weight - ana_env%density_3d%sum_vol2 = ana_env%density_3d%sum_vol2+ & + ana_env%density_3d%sum_vol2 = ana_env%density_3d%sum_vol2 + & (vol_cell*(au2a)**3)**2*weight ana_env%density_3d%sum_box_length(:) = ana_env%density_3d%sum_box_length(:) & - +cell_size(:)*(au2a)*weight + + cell_size(:)*(au2a)*weight ana_env%density_3d%sum_box_length2(:) = ana_env%density_3d%sum_box_length2(:) & - +(cell_size(:)*(au2a))**2*weight + + (cell_size(:)*(au2a))**2*weight ! sub interval length interval_size(1) = cell_size(1)/REAL(bin_x, dp) @@ -799,26 +799,26 @@ SUBROUTINE calc_density_3d(elem, weight, atoms, ana_env) ! count every atom DO atom = 1, SIZE(elem%pos), ana_env%dim_per_elem - atom_pos(:) = elem%pos(atom:atom+2) + atom_pos(:) = elem%pos(atom:atom + 2) ! fold into box CALL get_scaled_cell(cell=ana_env%cell, box_scale=elem%box_scale, & vec=atom_pos) ! shifts the box to positive values (before 0,0,0 is the center) - atom_pos(:) = atom_pos(:)+0.5_dp*cell_size(:) + atom_pos(:) = atom_pos(:) + 0.5_dp*cell_size(:) ! calculate the index of the sub box - bin_x = INT(atom_pos(1)/interval_size(1))+1 - bin_y = INT(atom_pos(2)/interval_size(2))+1 - bin_z = INT(atom_pos(3)/interval_size(3))+1 + bin_x = INT(atom_pos(1)/interval_size(1)) + 1 + bin_y = INT(atom_pos(2)/interval_size(2)) + 1 + bin_z = INT(atom_pos(3)/interval_size(3)) + 1 CPASSERT(bin_x .GT. 0 .AND. bin_y .GT. 0 .AND. bin_z .GT. 0) CPASSERT(bin_x .LE. SIZE(ana_env%density_3d%sum_density(:, 1, 1))) CPASSERT(bin_y .LE. SIZE(ana_env%density_3d%sum_density(1, :, 1))) CPASSERT(bin_z .LE. SIZE(ana_env%density_3d%sum_density(1, 1, :))) ! sum mass in [g] (in bins and total) - mass_bin(bin_x, bin_y, bin_z) = mass_bin(bin_x, bin_y, bin_z)+ & - atoms(INT(atom/REAL(ana_env%dim_per_elem, KIND=dp))+1)%mass/massunit*1000*a_mass - mass_total = mass_total+ & - atoms(INT(atom/REAL(ana_env%dim_per_elem, KIND=dp))+1)%mass/massunit*1000*a_mass + mass_bin(bin_x, bin_y, bin_z) = mass_bin(bin_x, bin_y, bin_z) + & + atoms(INT(atom/REAL(ana_env%dim_per_elem, KIND=dp)) + 1)%mass/massunit*1000*a_mass + mass_total = mass_total + & + atoms(INT(atom/REAL(ana_env%dim_per_elem, KIND=dp)) + 1)%mass/massunit*1000*a_mass !mass_bin(bin_x,bin_y,bin_z) = mass_bin(bin_x,bin_y,bin_z) + & ! atoms(INT(atom/REAL(ana_env%dim_per_elem,KIND=dp))+1)%mass/& ! massunit/n_avogadro @@ -827,18 +827,18 @@ SUBROUTINE calc_density_3d(elem, weight, atoms, ana_env) ! massunit/n_avogadro END DO ! check total cell density - r_tmp = mass_total/vol_cell-SUM(mass_bin(:, :, :))/vol_sub_box/SIZE(mass_bin(:, :, :)) + r_tmp = mass_total/vol_cell - SUM(mass_bin(:, :, :))/vol_sub_box/SIZE(mass_bin(:, :, :)) CPASSERT(ABS(r_tmp) .LT. 1E-5) ! calculate density (mass per volume) and sum up for average value - ana_env%density_3d%sum_density(:, :, :) = ana_env%density_3d%sum_density(:, :, :)+ & + ana_env%density_3d%sum_density(:, :, :) = ana_env%density_3d%sum_density(:, :, :) + & weight*mass_bin(:, :, :)/vol_sub_box ! calculate density squared ( (mass per volume)^2 ) for variance and sum up for average value - ana_env%density_3d%sum_dens2(:, :, :) = ana_env%density_3d%sum_dens2(:, :, :)+ & + ana_env%density_3d%sum_dens2(:, :, :) = ana_env%density_3d%sum_dens2(:, :, :) + & weight*(mass_bin(:, :, :)/vol_sub_box)**2 - ana_env%density_3d%conf_counter = ana_env%density_3d%conf_counter+weight + ana_env%density_3d%conf_counter = ana_env%density_3d%conf_counter + weight ! print out the actual and average density in file IF (ana_env%density_3d%print_dens) THEN @@ -856,14 +856,14 @@ SUBROUTINE calc_density_3d(elem, weight, atoms, ana_env) "dens_average[g/cm^3]", "density_variance", & "averages:volume", "box_lenth_x", "box_lenth_y", "box_lenth_z", & "variances:volume", "box_lenth_x", "box_lenth_y", "box_lenth_z" - WRITE (file_ptr, FMT="(I8,11F20.10)") ana_env%density_3d%conf_counter+1-weight, & + WRITE (file_ptr, FMT="(I8,11F20.10)") ana_env%density_3d%conf_counter + 1 - weight, & SUM(mass_bin(:, :, :))/vol_sub_box/SIZE(mass_bin(:, :, :)), & SUM(ana_env%density_3d%sum_density(:, :, :))/ & SIZE(ana_env%density_3d%sum_density(:, :, :))/ & REAL(ana_env%density_3d%conf_counter, KIND=dp), & SUM(ana_env%density_3d%sum_dens2(:, :, :))/ & SIZE(ana_env%density_3d%sum_dens2(:, :, :))/ & - REAL(ana_env%density_3d%conf_counter, KIND=dp)- & + REAL(ana_env%density_3d%conf_counter, KIND=dp) - & (SUM(ana_env%density_3d%sum_density(:, :, :))/ & SIZE(ana_env%density_3d%sum_density(:, :, :))/ & REAL(ana_env%density_3d%conf_counter, KIND=dp))**2, & @@ -872,11 +872,11 @@ SUBROUTINE calc_density_3d(elem, weight, atoms, ana_env) ana_env%density_3d%sum_box_length(:)/ & REAL(ana_env%density_3d%conf_counter, KIND=dp), & ana_env%density_3d%sum_vol2/ & - REAL(ana_env%density_3d%conf_counter, KIND=dp)- & + REAL(ana_env%density_3d%conf_counter, KIND=dp) - & (ana_env%density_3d%sum_vol/ & REAL(ana_env%density_3d%conf_counter, KIND=dp))**2, & ana_env%density_3d%sum_box_length2(:)/ & - REAL(ana_env%density_3d%conf_counter, KIND=dp)- & + REAL(ana_env%density_3d%conf_counter, KIND=dp) - & (ana_env%density_3d%sum_box_length(:)/ & REAL(ana_env%density_3d%conf_counter, KIND=dp))**2 CALL close_file(unit_number=file_ptr) @@ -951,11 +951,11 @@ SUBROUTINE print_density_3d(ana_env) DO j = 1, SIZE(ana_env%density_3d%sum_density(1, :, 1)) DO k = 1, SIZE(ana_env%density_3d%sum_density(1, 1, :)) WRITE (file_ptr_dens, FMT='(3F10.2,F20.10)') & - (i-0.5_dp)*interval_size(1), (j-0.5_dp)*interval_size(2), (k-0.5_dp)*interval_size(3), & + (i - 0.5_dp)*interval_size(1), (j - 0.5_dp)*interval_size(2), (k - 0.5_dp)*interval_size(3), & ana_env%density_3d%sum_density(i, j, k)/REAL(ana_env%density_3d%conf_counter, KIND=dp) WRITE (file_ptr_vari, FMT='(3F10.2,F20.10)') & - (i-0.5_dp)*interval_size(1), (j-0.5_dp)*interval_size(2), (k-0.5_dp)*interval_size(3), & - ana_env%density_3d%sum_dens2(i, j, k)/REAL(ana_env%density_3d%conf_counter, KIND=dp)- & + (i - 0.5_dp)*interval_size(1), (j - 0.5_dp)*interval_size(2), (k - 0.5_dp)*interval_size(3), & + ana_env%density_3d%sum_dens2(i, j, k)/REAL(ana_env%density_3d%conf_counter, KIND=dp) - & (ana_env%density_3d%sum_density(i, j, k)/REAL(ana_env%density_3d%conf_counter, KIND=dp))**2 END DO END DO @@ -978,7 +978,7 @@ SUBROUTINE print_density_3d(ana_env) WRITE (ana_env%io_unit, FMT=fmt_my) plabel, "density variance:", & cp_to_string(SUM(ana_env%density_3d%sum_dens2(:, :, :))/ & SIZE(ana_env%density_3d%sum_dens2(:, :, :))/ & - REAL(ana_env%density_3d%conf_counter, KIND=dp)- & + REAL(ana_env%density_3d%conf_counter, KIND=dp) - & (SUM(ana_env%density_3d%sum_density(:, :, :))/ & SIZE(ana_env%density_3d%sum_density(:, :, :))/ & REAL(ana_env%density_3d%conf_counter, KIND=dp))**2) @@ -1038,24 +1038,24 @@ SUBROUTINE ana_pair_correl_init(ana_pair_correl, atoms, cell) ! initialise the atom pairs ALLOCATE (pairs_tmp(SIZE(atoms))) DO f_n = 1, SIZE(atoms) - DO s_n = f_n+1, SIZE(atoms) + DO s_n = f_n + 1, SIZE(atoms) ! search if atom pair is already selected list_ind = search_pair_in_list(pair_list=pairs_tmp, n1=atoms(f_n)%name, & - n2=atoms(s_n)%name, list_end=counter-1) + n2=atoms(s_n)%name, list_end=counter - 1) ! add to list IF (list_ind .LT. 0) THEN pairs_tmp(counter)%f_n = atoms(f_n)%name pairs_tmp(counter)%s_n = atoms(s_n)%name pairs_tmp(counter)%pair_count = 1 - counter = counter+1 + counter = counter + 1 ELSE - pairs_tmp(list_ind)%pair_count = pairs_tmp(list_ind)%pair_count+1 + pairs_tmp(list_ind)%pair_count = pairs_tmp(list_ind)%pair_count + 1 END IF END DO END DO - ALLOCATE (ana_pair_correl%pairs(counter-1)) - DO list = 1, counter-1 + ALLOCATE (ana_pair_correl%pairs(counter - 1)) + DO list = 1, counter - 1 ana_pair_correl%pairs(list)%f_n = pairs_tmp(list)%f_n ana_pair_correl%pairs(list)%s_n = pairs_tmp(list)%s_n ana_pair_correl%pairs(list)%pair_count = pairs_tmp(list)%pair_count @@ -1107,24 +1107,24 @@ SUBROUTINE calc_paircorrelation(elem, weight, atoms, ana_env) dist = -1.0_dp first_elem_loop: DO i = 1, SIZE(elem%pos), ana_env%dim_per_elem - second_elem_loop: DO j = i+3, SIZE(elem%pos), ana_env%dim_per_elem - dist = nearest_distance(x1=elem%pos(i:i+ana_env%dim_per_elem-1), & - x2=elem%pos(j:j+ana_env%dim_per_elem-1), & + second_elem_loop: DO j = i + 3, SIZE(elem%pos), ana_env%dim_per_elem + dist = nearest_distance(x1=elem%pos(i:i + ana_env%dim_per_elem - 1), & + x2=elem%pos(j:j + ana_env%dim_per_elem - 1), & cell=ana_env%cell, box_scale=elem%box_scale) ind = CEILING(dist/ana_env%pair_correl%step_lenght) IF (ind .LE. ana_env%pair_correl%nr_bins) THEN pair_ind = search_pair_in_list(pair_list=ana_env%pair_correl%pairs, & - n1=atoms(INT(i/REAL(ana_env%dim_per_elem, KIND=dp))+1)%name, & - n2=atoms(INT(j/REAL(ana_env%dim_per_elem, KIND=dp))+1)%name) + n1=atoms(INT(i/REAL(ana_env%dim_per_elem, KIND=dp)) + 1)%name, & + n2=atoms(INT(j/REAL(ana_env%dim_per_elem, KIND=dp)) + 1)%name) CPASSERT(pair_ind .GT. 0) ana_env%pair_correl%g_r(pair_ind, ind) = & - ana_env%pair_correl%g_r(pair_ind, ind)+weight + ana_env%pair_correl%g_r(pair_ind, ind) + weight END IF END DO second_elem_loop END DO first_elem_loop - ana_env%pair_correl%conf_counter = ana_env%pair_correl%conf_counter+weight + ana_env%pair_correl%conf_counter = ana_env%pair_correl%conf_counter + weight CALL get_cell(cell=ana_env%cell, abc=cell_size) - ana_env%pair_correl%sum_box_scale = ana_env%pair_correl%sum_box_scale+ & + ana_env%pair_correl%sum_box_scale = ana_env%pair_correl%sum_box_scale + & (elem%box_scale(:)*weight) ! end the timing CALL timestop(handle) @@ -1179,8 +1179,8 @@ SUBROUTINE print_paircorrelation(ana_env) "[A] (for Vol changes: refering to the reference cell)" DO bin = 1, ana_env%pair_correl%nr_bins voldr = 4.0/3.0*PI*ana_env%pair_correl%step_lenght**3* & - (REAL(bin, KIND=dp)**3-REAL(bin-1, KIND=dp)**3) - WRITE (file_ptr, *) (bin-0.5)*ana_env%pair_correl%step_lenght*au2a, & + (REAL(bin, KIND=dp)**3 - REAL(bin - 1, KIND=dp)**3) + WRITE (file_ptr, *) (bin - 0.5)*ana_env%pair_correl%step_lenght*au2a, & (ana_env%pair_correl%g_r(pair, bin)/ana_env%pair_correl%conf_counter)/ & (voldr*ana_env%pair_correl%pairs(pair)%pair_count/vol) END DO @@ -1275,8 +1275,8 @@ SUBROUTINE calc_dipole_moment(elem, weight, ana_env) dip_cl(:) = 0.0_dp DO i = 1, SIZE(elem%pos, 1), ana_env%dim_per_elem - dip_cl(:) = dip_cl(:)+elem%pos(i:i+ana_env%dim_per_elem-1)* & - ana_env%dip_mom%charges(INT(i/REAL(ana_env%dim_per_elem, KIND=dp))+1) + dip_cl(:) = dip_cl(:) + elem%pos(i:i + ana_env%dim_per_elem - 1)* & + ana_env%dip_mom%charges(INT(i/REAL(ana_env%dim_per_elem, KIND=dp)) + 1) END DO ! if there are no exact dipoles save these ones in element structure @@ -1289,10 +1289,10 @@ SUBROUTINE calc_dipole_moment(elem, weight, ana_env) file_name = expand_file_name_temp(tmc_default_trajectory_file_name, & ana_env%temperature) CALL write_dipoles_in_file(file_name=file_name, & - conf_nr=ana_env%dip_mom%conf_counter+1, dip=dip_cl, & + conf_nr=ana_env%dip_mom%conf_counter + 1, dip=dip_cl, & file_ext="dip_cl") END IF - ana_env%dip_mom%conf_counter = ana_env%dip_mom%conf_counter+weight + ana_env%dip_mom%conf_counter = ana_env%dip_mom%conf_counter + weight ana_env%dip_mom%last_dip_cl(:) = dip_cl DEALLOCATE (dip_cl) @@ -1357,35 +1357,35 @@ SUBROUTINE calc_dipole_analysis(elem, weight, ana_env) ! fold exact dipole moments using the classical ones IF (ASSOCIATED(ana_env%dip_mom)) THEN IF (ALL(ana_env%dip_mom%last_dip_cl .NE. elem%dipole)) THEN - elem%dipole = pbc(r=elem%dipole(:)-ana_env%dip_mom%last_dip_cl, & - cell=scaled_cell)+ana_env%dip_mom%last_dip_cl + elem%dipole = pbc(r=elem%dipole(:) - ana_env%dip_mom%last_dip_cl, & + cell=scaled_cell) + ana_env%dip_mom%last_dip_cl END IF END IF - ana_env%dip_ana%conf_counter = ana_env%dip_ana%conf_counter+weight_act + ana_env%dip_ana%conf_counter = ana_env%dip_ana%conf_counter + weight_act ! dipole sqared absolut value summed and weight_acted with volume and conf weight_act - ana_env%dip_ana%mu2_pv_s = ana_env%dip_ana%mu2_pv_s+ & + ana_env%dip_ana%mu2_pv_s = ana_env%dip_ana%mu2_pv_s + & DOT_PRODUCT(elem%dipole(:), elem%dipole(:))/vol*weight_act tmp_dip(:, :) = 0.0_dp tmp_dip(:, 1) = elem%dipole(:) ! dipole sum, weight_acted with volume and conf weight_act - ana_env%dip_ana%mu_pv(:) = ana_env%dip_ana%mu_pv(:)+ & + ana_env%dip_ana%mu_pv(:) = ana_env%dip_ana%mu_pv(:) + & tmp_dip(:, 1)/vol*weight_act ! dipole sum, weight_acted with square root of volume and conf weight_act - ana_env%dip_ana%mu_psv(:) = ana_env%dip_ana%mu_psv(:)+ & + ana_env%dip_ana%mu_psv(:) = ana_env%dip_ana%mu_psv(:) + & tmp_dip(:, 1)/SQRT(vol)*weight_act ! dipole squared sum, weight_acted with volume and conf weight_act - ana_env%dip_ana%mu2_pv(:) = ana_env%dip_ana%mu2_pv(:)+ & + ana_env%dip_ana%mu2_pv(:) = ana_env%dip_ana%mu2_pv(:) + & tmp_dip(:, 1)**2/vol*weight_act ! calculate the directional average with componentwise correlation per volume tmp_dip(:, :) = MATMUL(tmp_dip(:, :), TRANSPOSE(tmp_dip(:, :))) - ana_env%dip_ana%mu2_pv_mat(:, :) = ana_env%dip_ana%mu2_pv_mat(:, :)+ & + ana_env%dip_ana%mu2_pv_mat(:, :) = ana_env%dip_ana%mu2_pv_mat(:, :) + & tmp_dip(:, :)/vol*weight_act END SUBROUTINE calc_dipole_analysis @@ -1422,7 +1422,7 @@ SUBROUTINE print_act_dipole_analysis(elem, ana_env) tmc_default_trajectory_file_name, & ana_env%temperature) CALL write_dipoles_in_file(file_name=file_name, & - conf_nr=INT(ana_env%dip_ana%conf_counter)+1, dip=elem%dipole, & + conf_nr=INT(ana_env%dip_ana%conf_counter) + 1, dip=elem%dipole, & file_ext="dip_folded") ! set output file name @@ -1447,13 +1447,13 @@ SUBROUTINE print_act_dipole_analysis(elem, ana_env) ! calc the dielectric constant ! 1+( - ^2 ) / (3*e_0*V*k*T) - diel_const = 1.0_dp+(ana_env%dip_ana%mu2_pv_s/(ana_env%dip_ana%conf_counter)- & - DOT_PRODUCT(ana_env%dip_ana%mu_psv(:)/(ana_env%dip_ana%conf_counter), & - ana_env%dip_ana%mu_psv(:)/(ana_env%dip_ana%conf_counter)))* & + diel_const = 1.0_dp + (ana_env%dip_ana%mu2_pv_s/(ana_env%dip_ana%conf_counter) - & + DOT_PRODUCT(ana_env%dip_ana%mu_psv(:)/(ana_env%dip_ana%conf_counter), & + ana_env%dip_ana%mu_psv(:)/(ana_env%dip_ana%conf_counter)))* & diel_const_norm ! symmetrized dielctric constant ! 1+( ) / (3*e_0*V*k*T) - diel_const_sym = 1.0_dp+ana_env%dip_ana%mu2_pv_s/(ana_env%dip_ana%conf_counter)* & + diel_const_sym = 1.0_dp + ana_env%dip_ana%mu2_pv_s/(ana_env%dip_ana%conf_counter)* & diel_const_norm ! print dielectric constant trajectory ! if szmetry used print only every 8th configuration, hence every different (not mirrowed) @@ -1487,7 +1487,7 @@ SUBROUTINE print_act_dipole_analysis(elem, ana_env) WRITE (file_ptr, FMT="(I8,10F20.10)") counter_tmp, & 4.0_dp*PI/(kB*ana_env%temperature)* & - (ana_env%dip_ana%mu2_pv_mat(:, :)/REAL(ana_env%dip_ana%conf_counter, KIND=dp)- & + (ana_env%dip_ana%mu2_pv_mat(:, :)/REAL(ana_env%dip_ana%conf_counter, KIND=dp) - & MATMUL(tmp_dip(:, :), TRANSPOSE(tmp_dip(:, :)))) CALL close_file(unit_number=file_ptr) END SUBROUTINE print_act_dipole_analysis @@ -1522,7 +1522,7 @@ SUBROUTINE print_dipole_analysis(ana_env) !dielectric constant tmp_dip(:, 1) = ana_env%dip_ana%mu_psv(:)/REAL(ana_env%dip_ana%conf_counter, KIND=dp) diel_const(:, :) = 4.0_dp*PI/(kB*ana_env%temperature)* & - (ana_env%dip_ana%mu2_pv_mat(:, :)/REAL(ana_env%dip_ana%conf_counter, KIND=dp)- & + (ana_env%dip_ana%mu2_pv_mat(:, :)/REAL(ana_env%dip_ana%conf_counter, KIND=dp) - & MATMUL(tmp_dip(:, :), TRANSPOSE(tmp_dip(:, :)))) !dielectric constant for symmetric case @@ -1530,8 +1530,8 @@ SUBROUTINE print_dipole_analysis(ana_env) ana_env%dip_ana%mu2_pv(:)/REAL(ana_env%dip_ana%conf_counter, KIND=dp) DO i = 1, 3 - diel_const(i, i) = diel_const(i, i)+1.0_dp ! +1 for unpolarizable models, 1.592 for polarizable - diel_const_scalar = diel_const_scalar+diel_const(i, i) + diel_const(i, i) = diel_const(i, i) + 1.0_dp ! +1 for unpolarizable models, 1.592 for polarizable + diel_const_scalar = diel_const_scalar + diel_const(i, i) END DO diel_const_scalar = diel_const_scalar/REAL(3, KIND=dp) @@ -1613,13 +1613,13 @@ SUBROUTINE calc_displacement(elem, ana_env) DO ind = 1, SIZE(elem%pos), ana_env%dim_per_elem ! fold into box - atom_disp(:) = elem%pos(ind:ind+2)-ana_env%last_elem%pos(ind:ind+2) + atom_disp(:) = elem%pos(ind:ind + 2) - ana_env%last_elem%pos(ind:ind + 2) CALL get_scaled_cell(cell=ana_env%cell, box_scale=elem%box_scale, & vec=atom_disp) - disp = disp+SUM((atom_disp(:)*au2a)**2) + disp = disp + SUM((atom_disp(:)*au2a)**2) END DO - ana_env%displace%disp = ana_env%displace%disp+disp - ana_env%displace%conf_counter = ana_env%displace%conf_counter+1 + ana_env%displace%disp = ana_env%displace%disp + disp + ana_env%displace%conf_counter = ana_env%displace%conf_counter + 1 IF (ana_env%displace%print_disp) THEN file_name_tmp = expand_file_name_temp(TRIM(ana_env%out_file_prefix)// & diff --git a/src/tmc/tmc_calculations.F b/src/tmc/tmc_calculations.F index b5bf69afc9..c013ffc504 100644 --- a/src/tmc/tmc_calculations.F +++ b/src/tmc/tmc_calculations.F @@ -256,7 +256,7 @@ FUNCTION nearest_distance(x1, x2, cell, box_scale) RESULT(res) CPASSERT(SIZE(x1) .EQ. 3) CPASSERT(SIZE(x2) .EQ. 3) - dist_vec(:) = x2(:)-x1(:) ! distance vector between atoms + dist_vec(:) = x2(:) - x1(:) ! distance vector between atoms ALLOCATE (tmp_box_scale(3)) IF (PRESENT(box_scale)) THEN CPASSERT(SIZE(box_scale) .EQ. 3) @@ -293,8 +293,8 @@ SUBROUTINE geometrical_center(pos, center) center = 0.0_dp DO i = 1, SIZE(pos), SIZE(center) - center(:) = center(:)+ & - pos(i:i+SIZE(center)-1)/(SIZE(pos)/REAL(SIZE(center), KIND=dp)) + center(:) = center(:) + & + pos(i:i + SIZE(center) - 1)/(SIZE(pos)/REAL(SIZE(center), KIND=dp)) END DO ! end the timing CALL timestop(handle) @@ -331,13 +331,13 @@ SUBROUTINE center_of_mass(pos, atoms, center) DO i = 1, SIZE(pos), SIZE(center) IF (PRESENT(atoms)) THEN CPASSERT(SIZE(atoms) .EQ. SIZE(pos)/SIZE(center)) - mass_tmp = atoms(INT(i/REAL(SIZE(center), KIND=dp))+1)%mass - center(:) = center(:)+pos(i:i+SIZE(center)-1)/ & + mass_tmp = atoms(INT(i/REAL(SIZE(center), KIND=dp)) + 1)%mass + center(:) = center(:) + pos(i:i + SIZE(center) - 1)/ & (SIZE(pos)/REAL(SIZE(center), KIND=dp))*mass_tmp - mass_sum = mass_sum+mass_tmp + mass_sum = mass_sum + mass_tmp ELSE CPWARN("try to calculate center of mass without any mass.") - center(:) = center(:)+pos(i:i+SIZE(center)-1)/ & + center(:) = center(:) + pos(i:i + SIZE(center) - 1)/ & (SIZE(pos)/REAL(SIZE(center), KIND=dp)) mass_sum = 1.0_dp END IF @@ -380,7 +380,7 @@ SUBROUTINE init_vel(vel, atoms, temerature, rng_stream, rnd_seed) rnd1 = next_random_number(rng_stream) rnd2 = next_random_number(rng_stream) - mass_tmp = atoms(INT(i/REAL(3, KIND=dp))+1)%mass + mass_tmp = atoms(INT(i/REAL(3, KIND=dp)) + 1)%mass vel(i) = SQRT(-2.0_dp*LOG(rnd1))*COS(2.0_dp*PI*rnd2)* & SQRT(kB*temerature/mass_tmp) @@ -413,8 +413,8 @@ FUNCTION calc_e_kin(vel, atoms) RESULT(ekin) ekin = 0.0_dp DO i = 1, SIZE(vel) - mass_tmp = atoms(INT(i/REAL(3, KIND=dp))+1)%mass - ekin = ekin+0.5_dp*mass_tmp*vel(i)*vel(i) + mass_tmp = atoms(INT(i/REAL(3, KIND=dp)) + 1)%mass + ekin = ekin + 0.5_dp*mass_tmp*vel(i)*vel(i) END DO END FUNCTION calc_e_kin @@ -454,21 +454,21 @@ SUBROUTINE three_point_extrapolate(v1, v2, v3, extrapolate, res_err) CALL swap(e2, e3) ! we need extra care if some of the difference e1-e2, e3-e2 are nearly zero, ! since the formulae suffer from sever loss of precision - d12 = e1-e2 - d23 = e2-e3 - ddd = d12-d23 + d12 = e1 - e2 + d23 = e2 - e3 + ddd = d12 - d23 IF (d12 == 0 .OR. d23 == 0 .OR. ABS(ddd) == 0) THEN ! a degenerate case, we do no extrapolation extrapolate = e3 - res_err = e1-e3 + res_err = e1 - e3 ELSE a = d23/d12 b = (d12**3/(d23*ddd)) - c = e2-(d12*d23)/ddd + c = e2 - (d12*d23)/ddd ! extrapolation, let's only look 4 iterations ahead, more is presumably anyway not accurate ! fewer is maybe more stable - extrapolate = a**7*b+c - res_err = e3-extrapolate + extrapolate = a**7*b + c + res_err = e3 - extrapolate ENDIF CPASSERT(extrapolate .NE. HUGE(extrapolate)) CONTAINS @@ -518,11 +518,11 @@ FUNCTION compute_prob(E_n_mu, E_n_sigma, E_o_mu, E_o_sigma, E_classical_diff, & ! REAL(KIND=dp) :: diff,E_n,E_o,surface,lower_bound,upper_bound,delta prob = 0.5_dp*ERFC(-0.5_dp*SQRT(2.0_dp)*( & - (-prior_sigma**2-E_o_sigma**2-E_n_sigma**2)*LOG(p)+ & - ((E_classical_diff-E_n_mu+E_o_mu)*prior_sigma**2-prior_mu*(E_n_sigma**2+E_o_sigma**2))*beta)/ & - (SQRT(E_o_sigma**2+E_n_sigma**2)*SQRT(prior_sigma**2+E_o_sigma**2+E_n_sigma**2)*prior_sigma*beta)) + (-prior_sigma**2 - E_o_sigma**2 - E_n_sigma**2)*LOG(p) + & + ((E_classical_diff - E_n_mu + E_o_mu)*prior_sigma**2 - prior_mu*(E_n_sigma**2 + E_o_sigma**2))*beta)/ & + (SQRT(E_o_sigma**2 + E_n_sigma**2)*SQRT(prior_sigma**2 + E_o_sigma**2 + E_n_sigma**2)*prior_sigma*beta)) - prob = MIN(1.0_dp-EPSILON(1.0_dp), MAX(EPSILON(1.0_dp), prob)) + prob = MIN(1.0_dp - EPSILON(1.0_dp), MAX(EPSILON(1.0_dp), prob)) END FUNCTION compute_prob @@ -568,32 +568,32 @@ FUNCTION compute_estimated_prob(elem_old, elem_new, E_classical_diff, & ! using 3 point extrapolation of two different intervals -> more stable estimation ! the energies are sorted in the three_point_extrapolate routine ! ! But with array of length 4 we have to select the 3 connected ones - CALL three_point_extrapolate(v1=elem_new%scf_energies(MOD(elem_new%scf_energies_count-3, 4)+1), & - v2=elem_new%scf_energies(MOD(elem_new%scf_energies_count-2, 4)+1), & - v3=elem_new%scf_energies(MOD(elem_new%scf_energies_count-1, 4)+1), & + CALL three_point_extrapolate(v1=elem_new%scf_energies(MOD(elem_new%scf_energies_count - 3, 4) + 1), & + v2=elem_new%scf_energies(MOD(elem_new%scf_energies_count - 2, 4) + 1), & + v3=elem_new%scf_energies(MOD(elem_new%scf_energies_count - 1, 4) + 1), & extrapolate=E_mu_tmp, res_err=E_sigma_tmp) IF ((elem_new%scf_energies_count .GT. 3)) THEN - CALL three_point_extrapolate(v1=elem_new%scf_energies(MOD(elem_new%scf_energies_count-4, 4)+1), & - v2=elem_new%scf_energies(MOD(elem_new%scf_energies_count-3, 4)+1), & - v3=elem_new%scf_energies(MOD(elem_new%scf_energies_count-2, 4)+1), & + CALL three_point_extrapolate(v1=elem_new%scf_energies(MOD(elem_new%scf_energies_count - 4, 4) + 1), & + v2=elem_new%scf_energies(MOD(elem_new%scf_energies_count - 3, 4) + 1), & + v3=elem_new%scf_energies(MOD(elem_new%scf_energies_count - 2, 4) + 1), & extrapolate=E_n_mu, res_err=E_n_sigma) - E_n_sigma = MAX(E_n_sigma, ABS(E_n_mu-E_mu_tmp)) + E_n_sigma = MAX(E_n_sigma, ABS(E_n_mu - E_mu_tmp)) ELSE E_n_sigma = E_sigma_tmp E_n_mu = E_mu_tmp END IF !-- the old/parent element energy estimation - CALL three_point_extrapolate(v1=elem_old%scf_energies(MOD(elem_old%scf_energies_count-3, 4)+1), & - v2=elem_old%scf_energies(MOD(elem_old%scf_energies_count-2, 4)+1), & - v3=elem_old%scf_energies(MOD(elem_old%scf_energies_count-1, 4)+1), & + CALL three_point_extrapolate(v1=elem_old%scf_energies(MOD(elem_old%scf_energies_count - 3, 4) + 1), & + v2=elem_old%scf_energies(MOD(elem_old%scf_energies_count - 2, 4) + 1), & + v3=elem_old%scf_energies(MOD(elem_old%scf_energies_count - 1, 4) + 1), & extrapolate=E_mu_tmp, res_err=E_sigma_tmp) IF ((elem_old%scf_energies_count .GT. 3)) THEN - CALL three_point_extrapolate(v1=elem_old%scf_energies(MOD(elem_old%scf_energies_count-4, 4)+1), & - v2=elem_old%scf_energies(MOD(elem_old%scf_energies_count-3, 4)+1), & - v3=elem_old%scf_energies(MOD(elem_old%scf_energies_count-2, 4)+1), & + CALL three_point_extrapolate(v1=elem_old%scf_energies(MOD(elem_old%scf_energies_count - 4, 4) + 1), & + v2=elem_old%scf_energies(MOD(elem_old%scf_energies_count - 3, 4) + 1), & + v3=elem_old%scf_energies(MOD(elem_old%scf_energies_count - 2, 4) + 1), & extrapolate=E_o_mu, res_err=E_o_sigma) - E_o_sigma = MAX(E_o_sigma, ABS(E_o_mu-E_mu_tmp)) + E_o_sigma = MAX(E_o_sigma, ABS(E_o_mu - E_mu_tmp)) ELSE E_o_sigma = E_sigma_tmp E_o_mu = E_mu_tmp @@ -601,7 +601,7 @@ FUNCTION compute_estimated_prob(elem_old, elem_new, E_classical_diff, & ! calculate the estimation for the average of the trajectory elements prior_sigma = SQRT(ABS(tmc_params%prior_NMC_acc%aver_2 & - -tmc_params%prior_NMC_acc%aver**2)) + - tmc_params%prior_NMC_acc%aver**2)) ! calculate the probability of acceptance for those two elements with their energy ! swap and 2 potential moves are distinguished using the difference in classical energy and different betas @@ -640,7 +640,7 @@ SUBROUTINE get_subtree_efficiency(tmc_env, eff) IF (tmc_env%m_env%tree_node_count(i) > 0) & eff(i) = tmc_env%params%move_types%mv_count(0, i)/ & (tmc_env%m_env%tree_node_count(i)*1.0_dp) - eff(0) = eff(0)+tmc_env%params%move_types%mv_count(0, i)/ & + eff(0) = eff(0) + tmc_env%params%move_types%mv_count(0, i)/ & (SUM(tmc_env%m_env%tree_node_count(1:))*1.0_dp) END DO END SUBROUTINE get_subtree_efficiency diff --git a/src/tmc/tmc_cancelation.F b/src/tmc/tmc_cancelation.F index a084dfe3f5..a6a12490f0 100644 --- a/src/tmc/tmc_cancelation.F +++ b/src/tmc/tmc_cancelation.F @@ -74,14 +74,14 @@ SUBROUTINE add_to_canceling_list(elem, tmc_env) CASE (status_calculate_energy) elem%stat = status_cancel_ener need_to_cancel = .TRUE. - tmc_env%m_env%count_cancel_ener = tmc_env%m_env%count_cancel_ener+1 + tmc_env%m_env%count_cancel_ener = tmc_env%m_env%count_cancel_ener + 1 CASE (status_calc_approx_ener) !TODO maybe elem status for approx ener cancel !elem%stat = status_cancel_ener !need_to_cancel = .TRUE. CASE (status_calculate_NMC_steps, status_calculate_MD) elem%stat = status_cancel_nmc need_to_cancel = .TRUE. - tmc_env%m_env%count_cancel_NMC = tmc_env%m_env%count_cancel_NMC+1 + tmc_env%m_env%count_cancel_NMC = tmc_env%m_env%count_cancel_NMC + 1 CASE (status_accepted, status_accepted_result, status_rejected, & status_rejected_result, status_calculated, status_created, & status_cancel_nmc, status_cancel_ener, status_canceled_nmc, & diff --git a/src/tmc/tmc_dot_tree.F b/src/tmc/tmc_dot_tree.F index e76116a949..045f95e9da 100644 --- a/src/tmc/tmc_dot_tree.F +++ b/src/tmc/tmc_dot_tree.F @@ -345,7 +345,7 @@ SUBROUTINE create_global_tree_dot(new_element, tmc_params) ref_count = 0 tmp_pt_list_elem => new_element%conf(i)%elem%gt_nodes_references DO WHILE (ASSOCIATED(tmp_pt_list_elem)) - ref_count = ref_count+1 + ref_count = ref_count + 1 ! create a list with all references IF (.FALSE.) WRITE (list_of_nr, *) TRIM(ADJUSTL(list_of_nr)), " ", tmp_pt_list_elem%gt_elem%nr tmp_pt_list_elem => tmp_pt_list_elem%next @@ -410,7 +410,7 @@ SUBROUTINE create_dot_color(tree_element, tmc_params) tmp_pt_list_elem => tree_element%gt_nodes_references ref_count = 0 DO WHILE (ASSOCIATED(tmp_pt_list_elem)) - ref_count = ref_count+1 + ref_count = ref_count + 1 ! print a list with all references IF (.FALSE.) THEN WRITE (list_of_nr, *) TRIM(ADJUSTL(list_of_nr)), " ", tmp_pt_list_elem%gt_elem%nr diff --git a/src/tmc/tmc_file_io.F b/src/tmc/tmc_file_io.F index 7e1e118619..5a94d1f4fe 100644 --- a/src/tmc/tmc_file_io.F +++ b/src/tmc/tmc_file_io.F @@ -82,7 +82,7 @@ FUNCTION expand_file_name_ending(file_name, extra) RESULT(result_file_name) ind = INDEX(file_name, ".", BACK=.TRUE.) IF (.NOT. ind .EQ. 0) THEN - WRITE (result_file_name, *) file_name(1:ind-1), ".", & + WRITE (result_file_name, *) file_name(1:ind - 1), ".", & TRIM(ADJUSTL(extra)) ELSE WRITE (result_file_name, *) TRIM(file_name), ".", extra @@ -112,7 +112,7 @@ FUNCTION expand_file_name_char(file_name, extra) RESULT(result_file_name) ind = INDEX(file_name, ".", BACK=.TRUE.) IF (.NOT. ind .EQ. 0) THEN - WRITE (result_file_name, *) file_name(1:ind-1), "_", & + WRITE (result_file_name, *) file_name(1:ind - 1), "_", & TRIM(ADJUSTL(extra)), file_name(ind:LEN_TRIM(file_name)) ELSE WRITE (result_file_name, *) TRIM(file_name), "_", extra @@ -147,7 +147,7 @@ FUNCTION expand_file_name_temp(file_name, rvalue) RESULT(result_file_name) WRITE (rval_to_string, "(F16.2)") rvalue ind = INDEX(file_name, ".", BACK=.TRUE.) IF (.NOT. ind .EQ. 0) THEN - WRITE (result_file_name, *) file_name(1:ind-1), "_T", & + WRITE (result_file_name, *) file_name(1:ind - 1), "_T", & TRIM(ADJUSTL(rval_to_string)), file_name(ind:LEN_TRIM(file_name)) ELSE IF (LEN(file_name) .EQ. 0) THEN @@ -187,7 +187,7 @@ FUNCTION expand_file_name_int(file_name, ivalue) RESULT(result_file_name) WRITE (rval_to_string, *) ivalue ind = INDEX(file_name, ".", BACK=.TRUE.) IF (.NOT. ind .EQ. 0) THEN - WRITE (result_file_name, *) file_name(1:ind-1), "_", & + WRITE (result_file_name, *) file_name(1:ind - 1), "_", & TRIM(ADJUSTL(rval_to_string)), file_name(ind:LEN_TRIM(file_name)) ELSE IF (LEN(file_name) .EQ. 0) THEN @@ -339,7 +339,7 @@ SUBROUTINE read_restart_file(tmc_env, job_counts, timings, file_name) job_counts, & timings - IF (ANY(ABS(tmc_env%params%Temp(:)-tmp_temp(:)) .GE. 0.005)) & + IF (ANY(ABS(tmc_env%params%Temp(:) - tmp_temp(:)) .GE. 0.005)) & CALL cp_abort(__LOCATION__, "the temperatures differ from the previous calculation. "// & "There were the following temperatures used:") IF (ANY(mv_weight_tmp(:) .NE. tmc_env%params%move_types%mv_weight(:))) & @@ -500,8 +500,8 @@ SUBROUTINE write_element_in_file(elem, tmc_params, temp_index, file_name, conf_n WRITE (file_ptr, *) TRIM(header) DO i = 1, SIZE(elem%pos), tmc_params%dim_per_elem WRITE (file_ptr, FMT="(A4,1X,1000F20.10)") & - TRIM(tmc_params%atoms((i-1)/tmc_params%dim_per_elem+1)%name), & - elem%pos(i:i+tmc_params%dim_per_elem-1)*au2a + TRIM(tmc_params%atoms((i - 1)/tmc_params%dim_per_elem + 1)%name), & + elem%pos(i:i + tmc_params%dim_per_elem - 1)*au2a END DO CALL close_file(unit_number=file_ptr) END IF @@ -516,8 +516,8 @@ SUBROUTINE write_element_in_file(elem, tmc_params, temp_index, file_name, conf_n WRITE (file_ptr, *) TRIM(header) DO i = 1, SIZE(elem%pos), tmc_params%dim_per_elem WRITE (file_ptr, FMT="(A4,1X,1000F20.10)") & - TRIM(tmc_params%atoms((i-1)/tmc_params%dim_per_elem+1)%name), & - elem%frc(i:i+tmc_params%dim_per_elem-1) + TRIM(tmc_params%atoms((i - 1)/tmc_params%dim_per_elem + 1)%name), & + elem%frc(i:i + tmc_params%dim_per_elem - 1) END DO CALL close_file(unit_number=file_ptr) END IF @@ -569,7 +569,7 @@ SUBROUTINE write_element_in_file(elem, tmc_params, temp_index, file_name, conf_n unit_number=file_ptr) END IF WRITE (file_ptr, FMT="(I8,14F20.10)") conf_nr, elem%potential, elem%e_pot_approx, & - elem%scf_energies(MOD(elem%scf_energies_count, 4)+1), elem%ekin + elem%scf_energies(MOD(elem%scf_energies_count, 4) + 1), elem%ekin CALL close_file(unit_number=file_ptr) END IF @@ -789,7 +789,7 @@ SUBROUTINE read_pos_from_file(elem, tmc_ana, stat, conf_nr, header_info) search_next_conf: DO c_tmp(:) = " " - tmc_ana%lc_traj = tmc_ana%lc_traj+1 + tmc_ana%lc_traj = tmc_ana%lc_traj + 1 READ (tmc_ana%id_traj, '(A)', IOSTAT=status) c_tmp(:) IF (status .GT. 0) & CALL cp_abort(__LOCATION__, & @@ -800,7 +800,7 @@ SUBROUTINE read_pos_from_file(elem, tmc_ana, stat, conf_nr, header_info) EXIT search_next_conf END IF IF (INDEX(c_tmp, "=") .GT. 0) THEN - READ (c_tmp(INDEX(c_tmp, "=")+1:), *, IOSTAT=status) i_tmp ! read the configuration number + READ (c_tmp(INDEX(c_tmp, "=") + 1:), *, IOSTAT=status) i_tmp ! read the configuration number IF (status .NE. 0) & CALL cp_abort(__LOCATION__, & "configuration header read error (for conf nr) at line: "// & @@ -817,9 +817,9 @@ SUBROUTINE read_pos_from_file(elem, tmc_ana, stat, conf_nr, header_info) IF (stat .EQ. TMC_STATUS_OK) THEN pos_loop: DO i = 1, SIZE(elem%pos), tmc_ana%dim_per_elem - tmc_ana%lc_traj = tmc_ana%lc_traj+1 + tmc_ana%lc_traj = tmc_ana%lc_traj + 1 READ (tmc_ana%id_traj, FMT="(A4,1X,1000F20.10)", IOSTAT=status) & - c_tmp, elem%pos(i:i+tmc_ana%dim_per_elem-1) + c_tmp, elem%pos(i:i + tmc_ana%dim_per_elem - 1) IF (status .NE. 0) THEN CALL cp_abort(__LOCATION__, & "configuration pos read error at line: "// & @@ -862,12 +862,12 @@ SUBROUTINE read_dipole_from_file(elem, tmc_ana, stat, conf_nr) ! start the timing CALL timeset(routineN, handle) - tmc_ana%lc_dip = tmc_ana%lc_dip+1 + tmc_ana%lc_dip = tmc_ana%lc_dip + 1 READ (tmc_ana%id_dip, FMT="(A)", IOSTAT=status) c_tmp IF (status .EQ. 0) THEN ! skip the initial line (header) IF (INDEX(c_tmp, "#") .GT. 0) THEN - tmc_ana%lc_dip = tmc_ana%lc_dip+1 + tmc_ana%lc_dip = tmc_ana%lc_dip + 1 READ (tmc_ana%id_dip, FMT="(A)", IOSTAT=status) c_tmp END IF END IF @@ -921,12 +921,12 @@ SUBROUTINE read_cell_from_file(elem, tmc_ana, stat, conf_nr) ! start the timing CALL timeset(routineN, handle) - tmc_ana%lc_cell = tmc_ana%lc_cell+1 + tmc_ana%lc_cell = tmc_ana%lc_cell + 1 READ (tmc_ana%id_cell, FMT="(A)", IOSTAT=status) c_tmp IF (status .EQ. 0) THEN ! skip the initial line (header) IF (INDEX(c_tmp, "#") .GT. 0) THEN - tmc_ana%lc_cell = tmc_ana%lc_cell+1 + tmc_ana%lc_cell = tmc_ana%lc_cell + 1 READ (tmc_ana%id_cell, FMT="(A)", IOSTAT=status) c_tmp END IF END IF diff --git a/src/tmc/tmc_master.F b/src/tmc/tmc_master.F index bbcd1e94c4..3b3f1e3de1 100644 --- a/src/tmc/tmc_master.F +++ b/src/tmc/tmc_master.F @@ -144,7 +144,7 @@ SUBROUTINE cancel_calculations(cancel_list, work_list, cancel_count, & work_list(wg)%canceled = .TRUE. ! counting the amount of canceled elements - cancel_count = cancel_count+1 + cancel_count = cancel_count + 1 ! delete element from canceling list IF (.NOT. ASSOCIATED(cancel_list%next)) THEN @@ -271,8 +271,8 @@ SUBROUTINE do_tmc_master(tmc_env, globenv) worker_timings_aver(:) = 0.0_dp ! remembers state of workers and their actual configurations ! the actual working group, communicating with - ALLOCATE (worker_info(tmc_env%tmc_comp_set%para_env_m_w%num_pe-1)) - ALLOCATE (ana_worker_info(tmc_env%tmc_comp_set%para_env_m_ana%num_pe-1)) + ALLOCATE (worker_info(tmc_env%tmc_comp_set%para_env_m_w%num_pe - 1)) + ALLOCATE (ana_worker_info(tmc_env%tmc_comp_set%para_env_m_ana%num_pe - 1)) ! get the start configuration form the first (exact energy) worker, ! master should/could have no Force environment @@ -319,14 +319,14 @@ SUBROUTINE do_tmc_master(tmc_env, globenv) ! init restart counter (espacially for restart case) IF (tmc_env%m_env%restart_out_step .NE. 0) THEN restart_count = INT(tmc_env%m_env%result_count(0)/ & - REAL(tmc_env%m_env%restart_out_step, KIND=dp))+1 + REAL(tmc_env%m_env%restart_out_step, KIND=dp)) + 1 END IF restarted_elem_nr = tmc_env%m_env%result_count(0) !TODO check conf and cell of both input files (cell has to be equal, ! beacuse it is used as reference cell for scaling the cell) ! communicate the reference cell size - DO wg = 1, tmc_env%tmc_comp_set%para_env_m_w%num_pe-1 + DO wg = 1, tmc_env%tmc_comp_set%para_env_m_w%num_pe - 1 stat = TMC_STATUS_WORKER_INIT CALL tmc_message(msg_type=stat, send_recv=send_msg, dest=wg, & para_env=tmc_env%tmc_comp_set%para_env_m_w, & @@ -335,7 +335,7 @@ SUBROUTINE do_tmc_master(tmc_env, globenv) ! send the atom informations to all analysis workers IF (tmc_env%tmc_comp_set%para_env_m_ana%num_pe .GT. 1) THEN - DO wg = 1, tmc_env%tmc_comp_set%para_env_m_ana%num_pe-1 + DO wg = 1, tmc_env%tmc_comp_set%para_env_m_ana%num_pe - 1 stat = TMC_STAT_INIT_ANALYSIS CALL tmc_message(msg_type=stat, send_recv=send_msg, dest=wg, & para_env=tmc_env%tmc_comp_set%para_env_m_ana, & @@ -360,7 +360,7 @@ SUBROUTINE do_tmc_master(tmc_env, globenv) IF (tmc_env%m_env%gt_head%conf(1)%elem%stat .EQ. status_calc_approx_ener) THEN wg = 1 IF (tmc_env%tmc_comp_set%group_cc_nr .GT. 0) & - wg = tmc_env%tmc_comp_set%group_ener_nr+1 + wg = tmc_env%tmc_comp_set%group_ener_nr + 1 stat = TMC_STAT_APPROX_ENERGY_REQUEST CALL tmc_message(msg_type=stat, send_recv=send_msg, dest=wg, & para_env=tmc_env%tmc_comp_set%para_env_m_w, & @@ -428,12 +428,12 @@ SUBROUTINE do_tmc_master(tmc_env, globenv) worker_info(wg)%busy = .FALSE. IF (ASSOCIATED(worker_info(wg)%elem)) THEN - SELECT CASE (worker_info (wg)%elem%stat) + SELECT CASE (worker_info(wg)%elem%stat) CASE (status_cancel_ener) !-- timings - worker_timings_aver(4) = (worker_timings_aver(4)*nr_of_job(6)+ & - (m_walltime()-worker_info(wg)%start_time))/REAL(nr_of_job(6)+1, KIND=dp) - nr_of_job(6) = nr_of_job(6)+1 + worker_timings_aver(4) = (worker_timings_aver(4)*nr_of_job(6) + & + (m_walltime() - worker_info(wg)%start_time))/REAL(nr_of_job(6) + 1, KIND=dp) + nr_of_job(6) = nr_of_job(6) + 1 worker_info(wg)%elem%stat = status_canceled_ener worker_info(wg)%elem%potential = 8000.0_dp @@ -443,9 +443,9 @@ SUBROUTINE do_tmc_master(tmc_env, globenv) END IF CASE (status_cancel_nmc) !-- timings - worker_timings_aver(3) = (worker_timings_aver(3)*nr_of_job(5)+ & - (m_walltime()-worker_info(wg)%start_time))/REAL(nr_of_job(5)+1, KIND=dp) - nr_of_job(5) = nr_of_job(5)+1 + worker_timings_aver(3) = (worker_timings_aver(3)*nr_of_job(5) + & + (m_walltime() - worker_info(wg)%start_time))/REAL(nr_of_job(5) + 1, KIND=dp) + nr_of_job(5) = nr_of_job(5) + 1 worker_info(wg)%elem%stat = status_canceled_nmc worker_info(wg)%elem%potential = 8000.0_dp @@ -464,7 +464,7 @@ SUBROUTINE do_tmc_master(tmc_env, globenv) CPABORT("") ! -- ENERGY RESULT ----------------- CASE (TMC_STAT_APPROX_ENERGY_RESULT) - nr_of_job(3) = nr_of_job(3)+1 + nr_of_job(3) = nr_of_job(3) + 1 worker_info(wg)%busy = .FALSE. worker_info(wg)%elem%stat = status_created IF (tmc_env%params%DRAW_TREE) THEN @@ -478,11 +478,11 @@ SUBROUTINE do_tmc_master(tmc_env, globenv) CASE (TMC_STAT_NMC_RESULT, TMC_STAT_MD_RESULT) IF (.NOT. worker_info(wg)%canceled) worker_info(wg)%busy = .FALSE. !-- timings for Nested Monte Carlo calculation - worker_timings_aver(1) = (worker_timings_aver(1)*nr_of_job(3)+ & - (m_walltime()-worker_info(wg)%start_time))/REAL(nr_of_job(3)+1, KIND=dp) - nr_of_job(3) = nr_of_job(3)+1 + worker_timings_aver(1) = (worker_timings_aver(1)*nr_of_job(3) + & + (m_walltime() - worker_info(wg)%start_time))/REAL(nr_of_job(3) + 1, KIND=dp) + nr_of_job(3) = nr_of_job(3) + 1 - worker_info(wg)%start_time = m_walltime()-worker_info(wg)%start_time + worker_info(wg)%start_time = m_walltime() - worker_info(wg)%start_time CALL set_walltime_delay(worker_info(wg)%start_time, walltime_delay) worker_info(wg)%elem%stat = status_created IF (tmc_env%params%DRAW_TREE) THEN @@ -522,7 +522,7 @@ SUBROUTINE do_tmc_master(tmc_env, globenv) tmc_params=tmc_env%params, & elem=worker_info(wg)%elem) worker_info(wg)%busy = .TRUE. - nr_of_job(2) = nr_of_job(2)+1 + nr_of_job(2) = nr_of_job(2) + 1 IF (tmc_env%params%DRAW_TREE) THEN CALL create_dot_color(tree_element=worker_info(wg)%elem, & tmc_params=tmc_env%params) @@ -536,11 +536,11 @@ SUBROUTINE do_tmc_master(tmc_env, globenv) ! -- ENERGY RESULT -------------------- CASE (TMC_STAT_ENERGY_RESULT) !-- timings - worker_timings_aver(2) = (worker_timings_aver(2)*nr_of_job(4)+ & - (m_walltime()-worker_info(wg)%start_time))/REAL(nr_of_job(4)+1, KIND=dp) - nr_of_job(4) = nr_of_job(4)+1 + worker_timings_aver(2) = (worker_timings_aver(2)*nr_of_job(4) + & + (m_walltime() - worker_info(wg)%start_time))/REAL(nr_of_job(4) + 1, KIND=dp) + nr_of_job(4) = nr_of_job(4) + 1 - worker_info(wg)%start_time = m_walltime()-worker_info(wg)%start_time + worker_info(wg)%start_time = m_walltime() - worker_info(wg)%start_time CALL set_walltime_delay(worker_info(wg)%start_time, walltime_delay) IF (.NOT. worker_info(wg)%canceled) & @@ -634,15 +634,15 @@ SUBROUTINE do_tmc_master(tmc_env, globenv) CALL external_control(should_stop=external_stop, flag="TMC", globenv=globenv) IF ((ANY(tmc_env%m_env%result_count(1:) .GE. tmc_env%m_env%num_MC_elem) & .AND. flag) .OR. & - (m_walltime()-run_time_start .GT. & - tmc_env%m_env%walltime-walltime_delay-walltime_offset) .OR. & + (m_walltime() - run_time_start .GT. & + tmc_env%m_env%walltime - walltime_delay - walltime_offset) .OR. & external_stop) THEN WRITE (tmc_env%m_env%io_unit, FMT="(/,T2,A)") REPEAT("=", 79) ! calculations NOT finished, walltime exceeded IF (.NOT. ANY(tmc_env%m_env%result_count(1:) & .GE. tmc_env%m_env%num_MC_elem)) THEN WRITE (tmc_env%m_env%io_unit, *) "Walltime exceeded.", & - m_walltime()-run_time_start, " of ", tmc_env%m_env%walltime-walltime_delay-walltime_offset, & + m_walltime() - run_time_start, " of ", tmc_env%m_env%walltime - walltime_delay - walltime_offset, & "(incl. delay", walltime_delay, "and offset", walltime_offset, ") left" ELSE ! calculations finished @@ -681,8 +681,8 @@ SUBROUTINE do_tmc_master(tmc_env, globenv) ! ===================================================================== !-- NEW TASK (if worker not busy sumit next task) ! ===================================================================== - worker_counter = worker_counter+1 - wg = MODULO(worker_counter, tmc_env%tmc_comp_set%para_env_m_w%num_pe-1)+1 + worker_counter = worker_counter + 1 + wg = MODULO(worker_counter, tmc_env%tmc_comp_set%para_env_m_w%num_pe - 1) + 1 IF (DEBUG .GE. 16 .AND. ALL(worker_info(:)%busy)) & WRITE (tmc_env%m_env%io_unit, *) "all workers are busy" @@ -740,7 +740,7 @@ SUBROUTINE do_tmc_master(tmc_env, globenv) para_env=tmc_env%tmc_comp_set%para_env_m_w, & tmc_params=tmc_env%params, & elem=gt_elem_tmp%conf(gt_elem_tmp%mv_conf)%elem) - nr_of_job(1) = nr_of_job(1)+1 + nr_of_job(1) = nr_of_job(1) + 1 CASE (status_created, status_calculate_energy) ! in case of parallel tempering the node can be already be calculating (related to another global tree node !-- send task to calculate system property @@ -753,7 +753,7 @@ SUBROUTINE do_tmc_master(tmc_env, globenv) para_env=tmc_env%tmc_comp_set%para_env_m_w, & tmc_params=tmc_env%params, & elem=gt_elem_tmp%conf(gt_elem_tmp%mv_conf)%elem) - nr_of_job(2) = nr_of_job(2)+1 + nr_of_job(2) = nr_of_job(2) + 1 CASE (status_calculate_MD) stat = TMC_STAT_MD_REQUEST CALL tmc_message(msg_type=stat, send_recv=send_msg, dest=wg, & @@ -761,7 +761,7 @@ SUBROUTINE do_tmc_master(tmc_env, globenv) tmc_params=tmc_env%params, & elem=gt_elem_tmp%conf(gt_elem_tmp%mv_conf)%elem) ! temperature=tmc_env%params%Temp(gt_elem_tmp%mv_conf), & - nr_of_job(1) = nr_of_job(1)+1 + nr_of_job(1) = nr_of_job(1) + 1 CASE (status_calculate_NMC_steps) !-- send information of element, which should be calculated stat = TMC_STAT_NMC_REQUEST @@ -769,7 +769,7 @@ SUBROUTINE do_tmc_master(tmc_env, globenv) para_env=tmc_env%tmc_comp_set%para_env_m_w, & tmc_params=tmc_env%params, & elem=gt_elem_tmp%conf(gt_elem_tmp%mv_conf)%elem) - nr_of_job(1) = nr_of_job(1)+1 + nr_of_job(1) = nr_of_job(1) + 1 CASE (status_cancel_nmc, status_cancel_ener) ! skip that task until receipt is received ! no status update @@ -835,8 +835,8 @@ SUBROUTINE do_tmc_master(tmc_env, globenv) tmc_env%m_env%estim_corr_wrong(2), & tmc_env%m_env%estim_corr_wrong(4) WRITE (tmc_env%m_env%io_unit, *) & - "Time: ", INT(m_walltime()-run_time_start), "of", & - INT(tmc_env%m_env%walltime-walltime_delay-walltime_offset), & + "Time: ", INT(m_walltime() - run_time_start), "of", & + INT(tmc_env%m_env%walltime - walltime_delay - walltime_offset), & "sec needed. " CALL m_memory(mem) WRITE (tmc_env%m_env%io_unit, *) & @@ -851,7 +851,7 @@ SUBROUTINE do_tmc_master(tmc_env, globenv) restart_count*tmc_env%m_env%restart_out_step) THEN CALL print_restart_file(tmc_env=tmc_env, job_counts=nr_of_job, & timings=worker_timings_aver) - restart_count = restart_count+1 + restart_count = restart_count + 1 END IF END IF !worker busy? @@ -891,9 +891,9 @@ SUBROUTINE do_tmc_master(tmc_env, globenv) END IF WRITE (tmc_env%m_env%io_unit, FMT="(A,F10.2)") & " computing time of one Markov chain element ", & - (m_walltime()-run_time_start)/REAL(tmc_env%m_env%result_count(0)- & - restarted_elem_nr, KIND=dp) - WRITE (tmc_env%m_env%io_unit, FMT="(A,F10.2)") " TMC run time[s]: ", m_walltime()-run_time_start + (m_walltime() - run_time_start)/REAL(tmc_env%m_env%result_count(0) - & + restarted_elem_nr, KIND=dp) + WRITE (tmc_env%m_env%io_unit, FMT="(A,F10.2)") " TMC run time[s]: ", m_walltime() - run_time_start WRITE (tmc_env%m_env%io_unit, FMT="(/,T2,A)") REPEAT("=", 79) !-- FINALIZE @@ -940,7 +940,7 @@ SUBROUTINE set_walltime_delay(time, walltime_delay) CPASSERT(time .GE. 0.0_dp) IF (time .GT. walltime_delay) THEN - walltime_delay = INT(time)+1 + walltime_delay = INT(time) + 1 END IF END SUBROUTINE set_walltime_delay diff --git a/src/tmc/tmc_messages.F b/src/tmc/tmc_messages.F index a1fa2e4ee5..dde6e7fe8f 100644 --- a/src/tmc/tmc_messages.F +++ b/src/tmc/tmc_messages.F @@ -268,7 +268,7 @@ SUBROUTINE tmc_message(msg_type, send_recv, dest, para_env, tmc_params, & CALL mp_probe(dest, para_env%group, tmp_tag) flag = .TRUE. ELSE - participant_loop: DO i = 0, para_env%num_pe-1 + participant_loop: DO i = 0, para_env%num_pe - 1 IF (i .NE. para_env%mepos) THEN dest = i CALL mp_probe(dest, para_env%group, tmp_tag) @@ -337,7 +337,7 @@ SUBROUTINE tmc_message(msg_type, send_recv, dest, para_env, tmc_params, & END IF msg_type = m_send%info(1) - SELECT CASE (m_send%info (1)) + SELECT CASE (m_send%info(1)) CASE (TMC_STAT_START_CONF_REQUEST, TMC_CANCELING_MESSAGE, & TMC_CANCELING_RECEIPT, TMC_STATUS_WAIT_FOR_NEW_TASK, & TMC_STATUS_CALCULATING, TMC_STAT_ANALYSIS_RESULT) @@ -514,28 +514,28 @@ SUBROUTINE create_worker_init_message(tmc_params, m_send) CPASSERT(ASSOCIATED(tmc_params%cell)) counter = 1 - msg_size_int = 1+SIZE(tmc_params%cell%perd)+1+1+1+1 + msg_size_int = 1 + SIZE(tmc_params%cell%perd) + 1 + 1 + 1 + 1 ALLOCATE (m_send%task_int(msg_size_int)) m_send%task_int(counter) = SIZE(tmc_params%cell%perd) ! periodicity of the cell - counter = counter+1+m_send%task_int(counter) - m_send%task_int(2:counter-1) = tmc_params%cell%perd(:) + counter = counter + 1 + m_send%task_int(counter) + m_send%task_int(2:counter - 1) = tmc_params%cell%perd(:) m_send%task_int(counter) = 1 - m_send%task_int(counter+1) = tmc_params%cell%symmetry_id - m_send%task_int(counter+2) = 0 - IF (tmc_params%cell%orthorhombic) m_send%task_int(counter+2) = 1 - counter = counter+3 + m_send%task_int(counter + 1) = tmc_params%cell%symmetry_id + m_send%task_int(counter + 2) = 0 + IF (tmc_params%cell%orthorhombic) m_send%task_int(counter + 2) = 1 + counter = counter + 3 m_send%task_int(counter) = message_end_flag CPASSERT(counter .EQ. SIZE(m_send%task_int)) !float array with cell vectors - msg_size_real = 1+SIZE(tmc_params%cell%hmat)+1 + msg_size_real = 1 + SIZE(tmc_params%cell%hmat) + 1 ALLOCATE (m_send%task_real(msg_size_real)) counter = 1 m_send%task_real(counter) = SIZE(tmc_params%cell%hmat) ! cell vectors for cell size - m_send%task_real(counter+1:counter+SIZE(tmc_params%cell%hmat)) = & + m_send%task_real(counter + 1:counter + SIZE(tmc_params%cell%hmat)) = & RESHAPE(tmc_params%cell%hmat(:, :), & (/SIZE(tmc_params%cell%hmat)/)) - counter = counter+1+INT(m_send%task_real(counter)) + counter = counter + 1 + INT(m_send%task_real(counter)) m_send%task_real(counter) = REAL(message_end_flag, KIND=dp) !message end CPASSERT(SIZE(m_send%task_real) .EQ. msg_size_real) CPASSERT(INT(m_send%task_real(msg_size_real)) .EQ. message_end_flag) @@ -566,12 +566,12 @@ SUBROUTINE read_worker_init_message(tmc_params, m_send) !int array flag = INT(m_send%task_int(1)) .EQ. SIZE(tmc_params%cell%perd) CPASSERT(flag) - counter = 1+m_send%task_int(1)+1 - tmc_params%cell%perd = m_send%task_int(2:counter-1) - tmc_params%cell%symmetry_id = m_send%task_int(counter+1) + counter = 1 + m_send%task_int(1) + 1 + tmc_params%cell%perd = m_send%task_int(2:counter - 1) + tmc_params%cell%symmetry_id = m_send%task_int(counter + 1) tmc_params%cell%orthorhombic = .FALSE. - IF (m_send%task_int(counter+2) .EQ. 1) tmc_params%cell%orthorhombic = .TRUE. - counter = counter+3 + IF (m_send%task_int(counter + 2) .EQ. 1) tmc_params%cell%orthorhombic = .TRUE. + counter = counter + 3 CPASSERT(counter .EQ. m_send%info(2)) CPASSERT(m_send%task_int(counter) .EQ. message_end_flag) @@ -580,9 +580,9 @@ SUBROUTINE read_worker_init_message(tmc_params, m_send) flag = INT(m_send%task_real(counter)) .EQ. SIZE(tmc_params%cell%hmat) CPASSERT(flag) tmc_params%cell%hmat = & - RESHAPE(m_send%task_real(counter+1:counter+ & + RESHAPE(m_send%task_real(counter + 1:counter + & SIZE(tmc_params%cell%hmat)), (/3, 3/)) - counter = counter+1+INT(m_send%task_real(counter)) + counter = counter + 1 + INT(m_send%task_real(counter)) CPASSERT(counter .EQ. m_send%info(3)) CPASSERT(INT(m_send%task_real(m_send%info(3))) .EQ. message_end_flag) @@ -621,51 +621,51 @@ SUBROUTINE create_start_conf_message(msg_type, elem, result_count, & CPASSERT(.NOT. ALLOCATED(m_send%task_char)) counter = 1 - msg_size_int = 1+SIZE(tmc_params%cell%perd)+1+1+1+1+SIZE(elem%mol)+1 + msg_size_int = 1 + SIZE(tmc_params%cell%perd) + 1 + 1 + 1 + 1 + SIZE(elem%mol) + 1 IF (msg_type .EQ. TMC_STAT_INIT_ANALYSIS) THEN CPASSERT(PRESENT(result_count)) CPASSERT(ASSOCIATED(result_count)) - msg_size_int = msg_size_int+1+SIZE(result_count(1:)) + msg_size_int = msg_size_int + 1 + SIZE(result_count(1:)) END IF ALLOCATE (m_send%task_int(msg_size_int)) m_send%task_int(counter) = SIZE(tmc_params%cell%perd) ! periodicity of the cell - counter = counter+1+m_send%task_int(counter) - m_send%task_int(2:counter-1) = tmc_params%cell%perd(:) + counter = counter + 1 + m_send%task_int(counter) + m_send%task_int(2:counter - 1) = tmc_params%cell%perd(:) m_send%task_int(counter) = 1 - m_send%task_int(counter+1) = tmc_params%cell%symmetry_id - m_send%task_int(counter+2) = 0 - IF (tmc_params%cell%orthorhombic) m_send%task_int(counter+2) = 1 - counter = counter+3 + m_send%task_int(counter + 1) = tmc_params%cell%symmetry_id + m_send%task_int(counter + 2) = 0 + IF (tmc_params%cell%orthorhombic) m_send%task_int(counter + 2) = 1 + counter = counter + 3 m_send%task_int(counter) = SIZE(elem%mol) - m_send%task_int(counter+1:counter+m_send%task_int(counter)) = elem%mol(:) - counter = counter+1+m_send%task_int(counter) + m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%mol(:) + counter = counter + 1 + m_send%task_int(counter) IF (msg_type .EQ. TMC_STAT_INIT_ANALYSIS) THEN m_send%task_int(counter) = SIZE(result_count(1:)) - m_send%task_int(counter+1:counter+m_send%task_int(counter)) = & + m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = & result_count(1:) - counter = counter+1+m_send%task_int(counter) + counter = counter + 1 + m_send%task_int(counter) END IF m_send%task_int(counter) = message_end_flag CPASSERT(counter .EQ. SIZE(m_send%task_int)) counter = 0 !float array with pos, cell vectors, atom_mass - msg_size_real = 1+SIZE(elem%pos)+1+SIZE(tmc_params%cell%hmat) & - +1+SIZE(tmc_params%atoms)+1 + msg_size_real = 1 + SIZE(elem%pos) + 1 + SIZE(tmc_params%cell%hmat) & + + 1 + SIZE(tmc_params%atoms) + 1 ALLOCATE (m_send%task_real(msg_size_real)) m_send%task_real(1) = REAL(SIZE(elem%pos), KIND=dp) ! positions - counter = 2+INT(m_send%task_real(1)) - m_send%task_real(2:counter-1) = elem%pos + counter = 2 + INT(m_send%task_real(1)) + m_send%task_real(2:counter - 1) = elem%pos m_send%task_real(counter) = SIZE(tmc_params%cell%hmat) ! cell vectors for cell size - m_send%task_real(counter+1:counter+SIZE(tmc_params%cell%hmat)) = & + m_send%task_real(counter + 1:counter + SIZE(tmc_params%cell%hmat)) = & RESHAPE(tmc_params%cell%hmat(:, :), & (/SIZE(tmc_params%cell%hmat)/)) - counter = counter+1+INT(m_send%task_real(counter)) + counter = counter + 1 + INT(m_send%task_real(counter)) m_send%task_real(counter) = SIZE(tmc_params%atoms) ! atom mass DO i = 1, SIZE(tmc_params%atoms) - m_send%task_real(counter+i) = tmc_params%atoms(i)%mass + m_send%task_real(counter + i) = tmc_params%atoms(i)%mass END DO - counter = counter+1+INT(m_send%task_real(counter)) + counter = counter + 1 + INT(m_send%task_real(counter)) m_send%task_real(counter) = REAL(message_end_flag, KIND=dp) !message end CPASSERT(SIZE(m_send%task_real) .EQ. msg_size_real) CPASSERT(INT(m_send%task_real(msg_size_real)) .EQ. message_end_flag) @@ -709,41 +709,41 @@ SUBROUTINE read_start_conf_message(msg_type, elem, result_count, m_send, & !int array flag = INT(m_send%task_int(1)) .EQ. SIZE(tmc_params%cell%perd) CPASSERT(flag) - counter = 1+m_send%task_int(1)+1 - tmc_params%cell%perd = m_send%task_int(2:counter-1) - tmc_params%cell%symmetry_id = m_send%task_int(counter+1) + counter = 1 + m_send%task_int(1) + 1 + tmc_params%cell%perd = m_send%task_int(2:counter - 1) + tmc_params%cell%symmetry_id = m_send%task_int(counter + 1) tmc_params%cell%orthorhombic = .FALSE. - IF (m_send%task_int(counter+2) .EQ. 1) tmc_params%cell%orthorhombic = .TRUE. - counter = counter+3 - elem%mol(:) = m_send%task_int(counter+1:counter+m_send%task_int(counter)) - counter = counter+1+m_send%task_int(counter) + IF (m_send%task_int(counter + 2) .EQ. 1) tmc_params%cell%orthorhombic = .TRUE. + counter = counter + 3 + elem%mol(:) = m_send%task_int(counter + 1:counter + m_send%task_int(counter)) + counter = counter + 1 + m_send%task_int(counter) IF (msg_type .EQ. TMC_STAT_INIT_ANALYSIS) THEN CPASSERT(PRESENT(result_count)) CPASSERT(.NOT. ASSOCIATED(result_count)) ALLOCATE (result_count(m_send%task_int(counter))) - result_count(:) = m_send%task_int(counter+1:counter+m_send%task_int(counter)) - counter = counter+1+m_send%task_int(counter) + result_count(:) = m_send%task_int(counter + 1:counter + m_send%task_int(counter)) + counter = counter + 1 + m_send%task_int(counter) END IF CPASSERT(counter .EQ. m_send%info(2)) CPASSERT(m_send%task_int(counter) .EQ. message_end_flag) counter = 0 !float array with pos, cell vectors, atom_mass - counter = 2+INT(m_send%task_real(1)) - elem%pos = m_send%task_real(2:counter-1) + counter = 2 + INT(m_send%task_real(1)) + elem%pos = m_send%task_real(2:counter - 1) flag = INT(m_send%task_real(counter)) .EQ. SIZE(tmc_params%cell%hmat) CPASSERT(flag) tmc_params%cell%hmat = & - RESHAPE(m_send%task_real(counter+1:counter+ & + RESHAPE(m_send%task_real(counter + 1:counter + & SIZE(tmc_params%cell%hmat)), (/3, 3/)) - counter = counter+1+INT(m_send%task_real(counter)) + counter = counter + 1 + INT(m_send%task_real(counter)) CALL allocate_tmc_atom_type(atoms=tmc_params%atoms, & nr_atoms=INT(m_send%task_real(counter))) DO i = 1, SIZE(tmc_params%atoms) - tmc_params%atoms(i)%mass = m_send%task_real(counter+i) + tmc_params%atoms(i)%mass = m_send%task_real(counter + i) END DO - counter = counter+1+INT(m_send%task_real(counter)) + counter = counter + 1 + INT(m_send%task_real(counter)) CPASSERT(counter .EQ. m_send%info(3)) CPASSERT(INT(m_send%task_real(m_send%info(3))) .EQ. message_end_flag) @@ -779,30 +779,30 @@ SUBROUTINE create_energy_request_message(elem, m_send, & counter = 0 !first integer array - msg_size_int = 1+1+1+1+1 ! 1+SIZE(elem%sub_tree_nr) +1+SIZE(elem%nr) + msg_size_int = 1 + 1 + 1 + 1 + 1 ! 1+SIZE(elem%sub_tree_nr) +1+SIZE(elem%nr) ALLOCATE (m_send%task_int(msg_size_int)) counter = 1 m_send%task_int(counter) = 1 !SIZE(elem%sub_tree_nr) - m_send%task_int(counter+1:counter+m_send%task_int(counter)) = elem%sub_tree_nr - counter = counter+1+m_send%task_int(counter) + m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%sub_tree_nr + counter = counter + 1 + m_send%task_int(counter) m_send%task_int(counter) = 1 !SIZE(elem%nr) - m_send%task_int(counter+1:counter+m_send%task_int(counter)) = elem%nr - counter = counter+1+m_send%task_int(counter) + m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%nr + counter = counter + 1 + m_send%task_int(counter) m_send%task_int(counter) = message_end_flag CPASSERT(SIZE(m_send%task_int) .EQ. msg_size_int) CPASSERT(m_send%task_int(msg_size_int) .EQ. message_end_flag) !then float array with pos - msg_size_real = 1+SIZE(elem%pos)+1 - IF (tmc_params%pressure .GE. 0.0_dp) msg_size_real = msg_size_real+1+SIZE(elem%box_scale(:)) + msg_size_real = 1 + SIZE(elem%pos) + 1 + IF (tmc_params%pressure .GE. 0.0_dp) msg_size_real = msg_size_real + 1 + SIZE(elem%box_scale(:)) ALLOCATE (m_send%task_real(msg_size_real)) m_send%task_real(1) = SIZE(elem%pos) - counter = 2+INT(m_send%task_real(1)) - m_send%task_real(2:counter-1) = elem%pos + counter = 2 + INT(m_send%task_real(1)) + m_send%task_real(2:counter - 1) = elem%pos IF (tmc_params%pressure .GE. 0.0_dp) THEN m_send%task_real(counter) = SIZE(elem%box_scale) - m_send%task_real(counter+1:counter+INT(m_send%task_real(counter))) = elem%box_scale(:) - counter = counter+1+INT(m_send%task_real(counter)) + m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter))) = elem%box_scale(:) + counter = counter + 1 + INT(m_send%task_real(counter)) END IF m_send%task_real(counter) = REAL(message_end_flag, KIND=dp) !message end @@ -840,20 +840,20 @@ SUBROUTINE read_energy_request_message(elem, m_send, tmc_params) ! read the integer values CPASSERT(m_send%info(2) .GT. 0) counter = 1 - elem%sub_tree_nr = m_send%task_int(counter+1) - counter = counter+1+m_send%task_int(counter) - elem%nr = m_send%task_int(counter+1) - counter = counter+1+m_send%task_int(counter) + elem%sub_tree_nr = m_send%task_int(counter + 1) + counter = counter + 1 + m_send%task_int(counter) + elem%nr = m_send%task_int(counter + 1) + counter = counter + 1 + m_send%task_int(counter) CPASSERT(m_send%task_int(counter) .EQ. message_end_flag) !float array with pos counter = 0 - counter = 1+NINT(m_send%task_real(1)) + counter = 1 + NINT(m_send%task_real(1)) elem%pos = m_send%task_real(2:counter) - counter = counter+1 + counter = counter + 1 IF (tmc_params%pressure .GE. 0.0_dp) THEN - elem%box_scale(:) = m_send%task_real(counter+1:counter+INT(m_send%task_real(counter))) - counter = counter+1+INT(m_send%task_real(counter)) + elem%box_scale(:) = m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter))) + counter = counter + 1 + INT(m_send%task_real(counter)) END IF CPASSERT(counter .EQ. m_send%info(3)) @@ -888,22 +888,22 @@ SUBROUTINE create_energy_result_message(elem, m_send, tmc_params) msg_size_int = 0 ! for checking the tree element mapping, send back the tree numbers IF (DEBUG .GT. 0) THEN - msg_size_int = 1+1+1+1+1 ! 1+SIZE(elem%sub_tree_nr) +1+SIZE(elem%nr) + msg_size_int = 1 + 1 + 1 + 1 + 1 ! 1+SIZE(elem%sub_tree_nr) +1+SIZE(elem%nr) ALLOCATE (m_send%task_int(msg_size_int)) counter = 1 m_send%task_int(counter) = 1 !SIZE(elem%sub_tree_nr) - m_send%task_int(counter+1:counter+m_send%task_int(counter)) = elem%sub_tree_nr - counter = counter+1+m_send%task_int(counter) + m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%sub_tree_nr + counter = counter + 1 + m_send%task_int(counter) m_send%task_int(counter) = 1 !SIZE(elem%nr) - m_send%task_int(counter+1:counter+m_send%task_int(counter)) = elem%nr - counter = counter+m_send%task_int(counter)+1 + m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%nr + counter = counter + m_send%task_int(counter) + 1 m_send%task_int(counter) = message_end_flag !message end END IF !then float array with energy of exact potential - msg_size_real = 1+1+1 - IF (tmc_params%print_forces) msg_size_real = msg_size_real+1+SIZE(elem%frc) - IF (tmc_params%print_dipole) msg_size_real = msg_size_real+1+SIZE(elem%dipole) + msg_size_real = 1 + 1 + 1 + IF (tmc_params%print_forces) msg_size_real = msg_size_real + 1 + SIZE(elem%frc) + IF (tmc_params%print_dipole) msg_size_real = msg_size_real + 1 + SIZE(elem%dipole) ALLOCATE (m_send%task_real(msg_size_real)) m_send%task_real(1) = 1 @@ -911,13 +911,13 @@ SUBROUTINE create_energy_result_message(elem, m_send, tmc_params) counter = 3 IF (tmc_params%print_forces) THEN m_send%task_real(counter) = SIZE(elem%frc) - m_send%task_real(counter+1:counter+NINT(m_send%task_real(counter))) = elem%frc - counter = counter+NINT(m_send%task_real(counter))+1 + m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter))) = elem%frc + counter = counter + NINT(m_send%task_real(counter)) + 1 END IF IF (tmc_params%print_dipole) THEN m_send%task_real(counter) = SIZE(elem%dipole) - m_send%task_real(counter+1:counter+NINT(m_send%task_real(counter))) = elem%dipole - counter = counter+NINT(m_send%task_real(counter))+1 + m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter))) = elem%dipole + counter = counter + NINT(m_send%task_real(counter)) + 1 END IF m_send%task_real(counter) = REAL(message_end_flag, KIND=dp) !message end @@ -952,10 +952,10 @@ SUBROUTINE read_energy_result_message(elem, m_send, tmc_params) ! for checking the tree element mapping, check the tree numbers IF (DEBUG .GT. 0) THEN counter = 1 - IF (elem%sub_tree_nr .NE. m_send%task_int(counter+1) .OR. & - elem%nr .NE. m_send%task_int(counter+3)) THEN + IF (elem%sub_tree_nr .NE. m_send%task_int(counter + 1) .OR. & + elem%nr .NE. m_send%task_int(counter + 3)) THEN WRITE (*, *) "ERROR: read_energy_result: master got energy result of subtree elem ", & - m_send%task_int(counter+1), m_send%task_int(counter+3), & + m_send%task_int(counter + 1), m_send%task_int(counter + 3), & " but expect result of subtree elem", elem%sub_tree_nr, elem%nr CPABORT("read_energy_result: got energy result from unexpected tree element.") END IF @@ -967,12 +967,12 @@ SUBROUTINE read_energy_result_message(elem, m_send, tmc_params) elem%potential = m_send%task_real(2) counter = 3 IF (tmc_params%print_forces) THEN - elem%frc(:) = m_send%task_real((counter+1):(counter+NINT(m_send%task_real(counter)))) - counter = counter+1+NINT(m_send%task_real(counter)) + elem%frc(:) = m_send%task_real((counter + 1):(counter + NINT(m_send%task_real(counter)))) + counter = counter + 1 + NINT(m_send%task_real(counter)) END IF IF (tmc_params%print_dipole) THEN - elem%dipole(:) = m_send%task_real((counter+1):(counter+NINT(m_send%task_real(counter)))) - counter = counter+1+NINT(m_send%task_real(counter)) + elem%dipole(:) = m_send%task_real((counter + 1):(counter + NINT(m_send%task_real(counter)))) + counter = counter + 1 + NINT(m_send%task_real(counter)) END IF CPASSERT(counter .EQ. m_send%info(3)) @@ -1006,8 +1006,8 @@ SUBROUTINE create_approx_energy_result_message(elem, m_send, & counter = 0 !then float array with energy of exact potential - msg_size_real = 1+1+1 - IF (tmc_params%pressure .GE. 0.0_dp) msg_size_real = msg_size_real+1+SIZE(elem%box_scale(:)) + msg_size_real = 1 + 1 + 1 + IF (tmc_params%pressure .GE. 0.0_dp) msg_size_real = msg_size_real + 1 + SIZE(elem%box_scale(:)) ALLOCATE (m_send%task_real(msg_size_real)) m_send%task_real(1) = 1 @@ -1016,8 +1016,8 @@ SUBROUTINE create_approx_energy_result_message(elem, m_send, & ! the box size for NpT IF (tmc_params%pressure .GE. 0.0_dp) THEN m_send%task_real(counter) = SIZE(elem%box_scale) - m_send%task_real(counter+1:counter+INT(m_send%task_real(counter))) = elem%box_scale(:) - counter = counter+1+INT(m_send%task_real(counter)) + m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter))) = elem%box_scale(:) + counter = counter + 1 + INT(m_send%task_real(counter)) END IF m_send%task_real(counter) = REAL(message_end_flag, KIND=dp) !message end @@ -1051,8 +1051,8 @@ SUBROUTINE read_approx_energy_result(elem, m_send, tmc_params) elem%e_pot_approx = m_send%task_real(2) counter = 3 IF (tmc_params%pressure .GE. 0.0_dp) THEN - elem%box_scale(:) = m_send%task_real(counter+1:counter+INT(m_send%task_real(counter))) - counter = counter+1+INT(m_send%task_real(counter)) + elem%box_scale(:) = m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter))) + counter = counter + 1 + INT(m_send%task_real(counter)) END IF CPASSERT(counter .EQ. m_send%info(3)) @@ -1090,59 +1090,59 @@ SUBROUTINE create_NMC_request_massage(msg_type, elem, m_send, & counter = 0 !first integer array with element status,mol_info, move type, sub tree, element nr, temp index - msg_size_int = 1+SIZE(elem%elem_stat)+1+SIZE(elem%mol)+1+1+1+1+1+1+1+1+1 + msg_size_int = 1 + SIZE(elem%elem_stat) + 1 + SIZE(elem%mol) + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 ALLOCATE (m_send%task_int(msg_size_int)) ! element status m_send%task_int(1) = SIZE(elem%elem_stat) - counter = 2+m_send%task_int(1) - m_send%task_int(2:counter-1) = elem%elem_stat + counter = 2 + m_send%task_int(1) + m_send%task_int(2:counter - 1) = elem%elem_stat m_send%task_int(counter) = SIZE(elem%mol) - m_send%task_int(counter+1:counter+m_send%task_int(counter)) = elem%mol(:) - counter = counter+1+m_send%task_int(counter) + m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%mol(:) + counter = counter + 1 + m_send%task_int(counter) ! element move type m_send%task_int(counter) = 1 - m_send%task_int(counter+1) = elem%move_type - counter = counter+2 + m_send%task_int(counter + 1) = elem%move_type + counter = counter + 2 m_send%task_int(counter) = 1 - m_send%task_int(counter+1) = elem%nr - counter = counter+2 + m_send%task_int(counter + 1) = elem%nr + counter = counter + 2 m_send%task_int(counter) = 1 - m_send%task_int(counter+1) = elem%sub_tree_nr - counter = counter+2 + m_send%task_int(counter + 1) = elem%sub_tree_nr + counter = counter + 2 m_send%task_int(counter) = 1 - m_send%task_int(counter+1) = elem%temp_created - m_send%task_int(counter+2) = message_end_flag !message end + m_send%task_int(counter + 1) = elem%temp_created + m_send%task_int(counter + 2) = message_end_flag !message end counter = 0 !then float array with pos, (vel), random number seed, subbox_center - msg_size_real = 1+SIZE(elem%pos)+1+SIZE(elem%rng_seed)+1+SIZE(elem%subbox_center(:))+1 + msg_size_real = 1 + SIZE(elem%pos) + 1 + SIZE(elem%rng_seed) + 1 + SIZE(elem%subbox_center(:)) + 1 IF (msg_type .EQ. TMC_STAT_MD_REQUEST .OR. msg_type .EQ. TMC_STAT_MD_BROADCAST) & - msg_size_real = msg_size_real+1+SIZE(elem%vel) ! the velocities - IF (tmc_params%pressure .GE. 0.0_dp) msg_size_real = msg_size_real+1+SIZE(elem%box_scale(:)) ! box size for NpT + msg_size_real = msg_size_real + 1 + SIZE(elem%vel) ! the velocities + IF (tmc_params%pressure .GE. 0.0_dp) msg_size_real = msg_size_real + 1 + SIZE(elem%box_scale(:)) ! box size for NpT ALLOCATE (m_send%task_real(msg_size_real)) m_send%task_real(1) = SIZE(elem%pos) - counter = 2+INT(m_send%task_real(1)) - m_send%task_real(2:counter-1) = elem%pos + counter = 2 + INT(m_send%task_real(1)) + m_send%task_real(2:counter - 1) = elem%pos IF (msg_type .EQ. TMC_STAT_MD_REQUEST .OR. msg_type .EQ. TMC_STAT_MD_BROADCAST) THEN m_send%task_real(counter) = SIZE(elem%vel) - m_send%task_real(counter+1:counter+NINT(m_send%task_real(counter))) = elem%vel - counter = counter+1+NINT(m_send%task_real(counter)) + m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter))) = elem%vel + counter = counter + 1 + NINT(m_send%task_real(counter)) END IF ! rng seed m_send%task_real(counter) = SIZE(elem%rng_seed) - m_send%task_real(counter+1:counter+SIZE(elem%rng_seed)) = RESHAPE(elem%rng_seed(:, :, :), (/SIZE(elem%rng_seed)/)) - counter = counter+NINT(m_send%task_real(counter))+1 + m_send%task_real(counter + 1:counter + SIZE(elem%rng_seed)) = RESHAPE(elem%rng_seed(:, :, :), (/SIZE(elem%rng_seed)/)) + counter = counter + NINT(m_send%task_real(counter)) + 1 ! sub box center m_send%task_real(counter) = SIZE(elem%subbox_center(:)) - m_send%task_real(counter+1:counter+SIZE(elem%subbox_center)) = elem%subbox_center(:) - counter = counter+1+NINT(m_send%task_real(counter)) + m_send%task_real(counter + 1:counter + SIZE(elem%subbox_center)) = elem%subbox_center(:) + counter = counter + 1 + NINT(m_send%task_real(counter)) ! the box size for NpT IF (tmc_params%pressure .GE. 0.0_dp) THEN m_send%task_real(counter) = SIZE(elem%box_scale) - m_send%task_real(counter+1:counter+INT(m_send%task_real(counter))) = elem%box_scale(:) - counter = counter+1+INT(m_send%task_real(counter)) + m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter))) = elem%box_scale(:) + counter = counter + 1 + INT(m_send%task_real(counter)) END IF m_send%task_real(counter) = message_end_flag !message end @@ -1179,47 +1179,47 @@ SUBROUTINE read_NMC_request_massage(msg_type, elem, m_send, & counter = 0 !first integer array with number of dimentions and random seed size - rnd_seed_size = m_send%task_int(1+m_send%task_int(1)+1) + rnd_seed_size = m_send%task_int(1 + m_send%task_int(1) + 1) IF (.NOT. ASSOCIATED(elem)) THEN CALL allocate_new_sub_tree_node(next_el=elem, nr_dim=NINT(m_send%task_real(1)), & tmc_params=tmc_params) END IF ! element status - counter = 2+m_send%task_int(1) - elem%elem_stat = m_send%task_int(2:counter-1) - elem%mol(:) = m_send%task_int(counter+1:counter+m_send%task_int(counter)) - counter = counter+1+m_send%task_int(counter) + counter = 2 + m_send%task_int(1) + elem%elem_stat = m_send%task_int(2:counter - 1) + elem%mol(:) = m_send%task_int(counter + 1:counter + m_send%task_int(counter)) + counter = counter + 1 + m_send%task_int(counter) ! element move type - elem%move_type = m_send%task_int(counter+1) - counter = counter+2 - elem%nr = m_send%task_int(counter+1) - counter = counter+2 - elem%sub_tree_nr = m_send%task_int(counter+1) - counter = counter+2 - elem%temp_created = m_send%task_int(counter+1) - counter = counter+2 + elem%move_type = m_send%task_int(counter + 1) + counter = counter + 2 + elem%nr = m_send%task_int(counter + 1) + counter = counter + 2 + elem%sub_tree_nr = m_send%task_int(counter + 1) + counter = counter + 2 + elem%temp_created = m_send%task_int(counter + 1) + counter = counter + 2 CPASSERT(counter .EQ. m_send%info(2)) counter = 0 !then float array with pos, (vel), subbox_center and temp num_dim = NINT(m_send%task_real(1)) - counter = 2+INT(m_send%task_real(1)) - elem%pos = m_send%task_real(2:counter-1) + counter = 2 + INT(m_send%task_real(1)) + elem%pos = m_send%task_real(2:counter - 1) IF (msg_type .EQ. TMC_STAT_MD_REQUEST .OR. msg_type .EQ. TMC_STAT_MD_BROADCAST) THEN - elem%vel = m_send%task_real(counter+1:counter+NINT(m_send%task_real(counter))) - counter = counter+NINT(m_send%task_real(counter))+1 + elem%vel = m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter))) + counter = counter + NINT(m_send%task_real(counter)) + 1 END IF ! rng seed - elem%rng_seed(:, :, :) = RESHAPE(m_send%task_real(counter+1:counter+SIZE(elem%rng_seed)), (/3, 2, 3/)) - counter = counter+NINT(m_send%task_real(counter))+1 + elem%rng_seed(:, :, :) = RESHAPE(m_send%task_real(counter + 1:counter + SIZE(elem%rng_seed)), (/3, 2, 3/)) + counter = counter + NINT(m_send%task_real(counter)) + 1 ! sub box center - elem%subbox_center(:) = m_send%task_real(counter+1:counter+INT(m_send%task_real(counter))) - counter = counter+1+NINT(m_send%task_real(counter)) + elem%subbox_center(:) = m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter))) + counter = counter + 1 + NINT(m_send%task_real(counter)) IF (tmc_params%pressure .GE. 0.0_dp) THEN - elem%box_scale(:) = m_send%task_real(counter+1:counter+INT(m_send%task_real(counter))) - counter = counter+1+INT(m_send%task_real(counter)) + elem%box_scale(:) = m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter))) + counter = counter + 1 + INT(m_send%task_real(counter)) ELSE elem%box_scale(:) = 1.0_dp END IF @@ -1258,100 +1258,100 @@ SUBROUTINE create_NMC_result_massage(msg_type, elem, m_send, tmc_params) CPASSERT(ASSOCIATED(tmc_params)) !first integer array with status, nmc_acc_counts, subbox_acc_count and (subbox rejectance) - msg_size_int = 1+SIZE(elem%mol) & - +1+SIZE(tmc_params%nmc_move_types%mv_count) & - +1+SIZE(tmc_params%nmc_move_types%acc_count)+1 - IF (DEBUG .GT. 0) msg_size_int = msg_size_int+1+1+1+1 + msg_size_int = 1 + SIZE(elem%mol) & + + 1 + SIZE(tmc_params%nmc_move_types%mv_count) & + + 1 + SIZE(tmc_params%nmc_move_types%acc_count) + 1 + IF (DEBUG .GT. 0) msg_size_int = msg_size_int + 1 + 1 + 1 + 1 IF (.NOT. ANY(tmc_params%sub_box_size .LE. 0.1_dp)) & - msg_size_int = msg_size_int+1+SIZE(tmc_params%nmc_move_types%subbox_count) & - +1+SIZE(tmc_params%nmc_move_types%subbox_acc_count) + msg_size_int = msg_size_int + 1 + SIZE(tmc_params%nmc_move_types%subbox_count) & + + 1 + SIZE(tmc_params%nmc_move_types%subbox_acc_count) ALLOCATE (m_send%task_int(msg_size_int)) counter = 1 IF (DEBUG .GT. 0) THEN ! send the element number back m_send%task_int(counter) = 1 - m_send%task_int(counter+1) = elem%sub_tree_nr - counter = counter+1+m_send%task_int(counter) + m_send%task_int(counter + 1) = elem%sub_tree_nr + counter = counter + 1 + m_send%task_int(counter) m_send%task_int(counter) = 1 - m_send%task_int(counter+1) = elem%nr - counter = counter+1+m_send%task_int(counter) + m_send%task_int(counter + 1) = elem%nr + counter = counter + 1 + m_send%task_int(counter) END IF ! the molecule information m_send%task_int(counter) = SIZE(elem%mol) - m_send%task_int(counter+1:counter+m_send%task_int(counter)) = elem%mol(:) - counter = counter+1+m_send%task_int(counter) + m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = elem%mol(:) + counter = counter + 1 + m_send%task_int(counter) ! the counters for each move type m_send%task_int(counter) = SIZE(tmc_params%nmc_move_types%mv_count) - m_send%task_int(counter+1:counter+m_send%task_int(counter)) = & + m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = & RESHAPE(tmc_params%nmc_move_types%mv_count(:, :), & (/SIZE(tmc_params%nmc_move_types%mv_count)/)) - counter = counter+1+m_send%task_int(counter) + counter = counter + 1 + m_send%task_int(counter) ! the counter for the accepted moves m_send%task_int(counter) = SIZE(tmc_params%nmc_move_types%acc_count) - m_send%task_int(counter+1:counter+m_send%task_int(counter)) = & + m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = & RESHAPE(tmc_params%nmc_move_types%acc_count(:, :), & (/SIZE(tmc_params%nmc_move_types%acc_count)/)) - counter = counter+1+m_send%task_int(counter) + counter = counter + 1 + m_send%task_int(counter) ! amount of rejected subbox moves IF (.NOT. ANY(tmc_params%sub_box_size .LE. 0.1_dp)) THEN m_send%task_int(counter) = SIZE(tmc_params%nmc_move_types%subbox_count) - m_send%task_int(counter+1:counter+m_send%task_int(counter)) = & + m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = & RESHAPE(tmc_params%nmc_move_types%subbox_count(:, :), & (/SIZE(tmc_params%nmc_move_types%subbox_count)/)) - counter = counter+1+m_send%task_int(counter) + counter = counter + 1 + m_send%task_int(counter) m_send%task_int(counter) = SIZE(tmc_params%nmc_move_types%subbox_acc_count) - m_send%task_int(counter+1:counter+m_send%task_int(counter)) = & + m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = & RESHAPE(tmc_params%nmc_move_types%subbox_acc_count(:, :), & (/SIZE(tmc_params%nmc_move_types%subbox_acc_count)/)) - counter = counter+1+m_send%task_int(counter) + counter = counter + 1 + m_send%task_int(counter) END IF m_send%task_int(counter) = message_end_flag ! message end counter = 0 !then float array with pos,(vel, e_kin_befor_md, ekin),(forces),rng_seed, ! potential,e_pot_approx,acc_prob,subbox_prob - msg_size_real = 1+SIZE(elem%pos) & ! pos - +1+SIZE(elem%rng_seed) & ! rng_seed - +1+1 & ! potential - +1+1 & ! e_pot_approx - +1 ! check bit + msg_size_real = 1 + SIZE(elem%pos) & ! pos + + 1 + SIZE(elem%rng_seed) & ! rng_seed + + 1 + 1 & ! potential + + 1 + 1 & ! e_pot_approx + + 1 ! check bit IF (msg_type .EQ. TMC_STAT_MD_REQUEST .OR. msg_type .EQ. TMC_STAT_MD_RESULT .OR. & msg_type .EQ. TMC_STAT_MD_BROADCAST) & - msg_size_real = msg_size_real+1+SIZE(elem%vel)+1+1+1+1 ! for MD also: vel, e_kin_befor_md, ekin + msg_size_real = msg_size_real + 1 + SIZE(elem%vel) + 1 + 1 + 1 + 1 ! for MD also: vel, e_kin_befor_md, ekin ALLOCATE (m_send%task_real(msg_size_real)) ! pos counter = 1 m_send%task_real(counter) = SIZE(elem%pos) - m_send%task_real(counter+1:counter+NINT(m_send%task_real(counter))) = elem%pos - counter = counter+1+NINT(m_send%task_real(counter)) + m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter))) = elem%pos + counter = counter + 1 + NINT(m_send%task_real(counter)) ! rng seed m_send%task_real(counter) = SIZE(elem%rng_seed) - m_send%task_real(counter+1:counter+SIZE(elem%rng_seed)) = & + m_send%task_real(counter + 1:counter + SIZE(elem%rng_seed)) = & RESHAPE(elem%rng_seed(:, :, :), (/SIZE(elem%rng_seed)/)) - counter = counter+1+NINT(m_send%task_real(counter)) + counter = counter + 1 + NINT(m_send%task_real(counter)) ! potential m_send%task_real(counter) = 1 - m_send%task_real(counter+1) = elem%potential - counter = counter+2 + m_send%task_real(counter + 1) = elem%potential + counter = counter + 2 ! approximate potential energy m_send%task_real(counter) = 1 - m_send%task_real(counter+1) = elem%e_pot_approx - counter = counter+2 + m_send%task_real(counter + 1) = elem%e_pot_approx + counter = counter + 2 ! for MD also: vel, e_kin_befor_md, ekin IF (msg_type .EQ. TMC_STAT_MD_REQUEST .OR. msg_type .EQ. TMC_STAT_MD_RESULT .OR. & msg_type .EQ. TMC_STAT_MD_BROADCAST) THEN m_send%task_real(counter) = SIZE(elem%vel) - m_send%task_real(counter+1:counter+NINT(m_send%task_real(counter))) = elem%vel - counter = counter+1+INT(m_send%task_real(counter)) + m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter))) = elem%vel + counter = counter + 1 + INT(m_send%task_real(counter)) m_send%task_real(counter) = 1 - m_send%task_real(counter+1) = elem%ekin_before_md - counter = counter+2 + m_send%task_real(counter + 1) = elem%ekin_before_md + counter = counter + 2 m_send%task_real(counter) = 1 - m_send%task_real(counter+1) = elem%ekin - counter = counter+2 + m_send%task_real(counter + 1) = elem%ekin + counter = counter + 2 END IF m_send%task_real(counter) = message_end_flag ! message end @@ -1392,42 +1392,42 @@ SUBROUTINE read_NMC_result_massage(msg_type, elem, m_send, tmc_params) !first integer array with element status, random number seed, and move type counter = 1 IF (DEBUG .GT. 0) THEN - IF ((m_send%task_int(counter+1) .NE. elem%sub_tree_nr) .AND. (m_send%task_int(counter+3) .NE. elem%nr)) THEN + IF ((m_send%task_int(counter + 1) .NE. elem%sub_tree_nr) .AND. (m_send%task_int(counter + 3) .NE. elem%nr)) THEN CPABORT("read_NMC_result_massage: got result of wrong element") ENDIF - counter = counter+2+2 + counter = counter + 2 + 2 END IF ! the molecule information - elem%mol(:) = m_send%task_int(counter+1:counter+m_send%task_int(counter)) - counter = counter+1+m_send%task_int(counter) + elem%mol(:) = m_send%task_int(counter + 1:counter + m_send%task_int(counter)) + counter = counter + 1 + m_send%task_int(counter) ! the counters for each move type - ALLOCATE (mv_counter(0:SIZE(tmc_params%nmc_move_types%mv_count(:, 1))-1, & + ALLOCATE (mv_counter(0:SIZE(tmc_params%nmc_move_types%mv_count(:, 1)) - 1, & SIZE(tmc_params%nmc_move_types%mv_count(1, :)))) - mv_counter(:, :) = RESHAPE(m_send%task_int(counter+1:counter+m_send%task_int(counter)), & + mv_counter(:, :) = RESHAPE(m_send%task_int(counter + 1:counter + m_send%task_int(counter)), & (/SIZE(tmc_params%nmc_move_types%mv_count(:, 1)), & SIZE(tmc_params%nmc_move_types%mv_count(1, :))/)) - counter = counter+1+m_send%task_int(counter) + counter = counter + 1 + m_send%task_int(counter) ! the counter for the accepted moves - ALLOCATE (acc_counter(0:SIZE(tmc_params%nmc_move_types%acc_count(:, 1))-1, & + ALLOCATE (acc_counter(0:SIZE(tmc_params%nmc_move_types%acc_count(:, 1)) - 1, & SIZE(tmc_params%nmc_move_types%acc_count(1, :)))) - acc_counter(:, :) = RESHAPE(m_send%task_int(counter+1:counter+m_send%task_int(counter)), & + acc_counter(:, :) = RESHAPE(m_send%task_int(counter + 1:counter + m_send%task_int(counter)), & (/SIZE(tmc_params%nmc_move_types%acc_count(:, 1)), & SIZE(tmc_params%nmc_move_types%acc_count(1, :))/)) - counter = counter+1+m_send%task_int(counter) + counter = counter + 1 + m_send%task_int(counter) ! amount of rejected subbox moves IF (.NOT. ANY(tmc_params%sub_box_size .LE. 0.1_dp)) THEN ALLOCATE (subbox_counter(SIZE(tmc_params%nmc_move_types%subbox_count(:, 1)), & SIZE(tmc_params%nmc_move_types%subbox_count(1, :)))) - subbox_counter(:, :) = RESHAPE(m_send%task_int(counter+1:counter+m_send%task_int(counter)), & + subbox_counter(:, :) = RESHAPE(m_send%task_int(counter + 1:counter + m_send%task_int(counter)), & (/SIZE(tmc_params%nmc_move_types%subbox_count(:, 1)), & SIZE(tmc_params%nmc_move_types%subbox_count(1, :))/)) - counter = counter+1+m_send%task_int(counter) + counter = counter + 1 + m_send%task_int(counter) ALLOCATE (subbox_acc_counter(SIZE(tmc_params%nmc_move_types%subbox_acc_count(:, 1)), & SIZE(tmc_params%nmc_move_types%subbox_acc_count(1, :)))) - subbox_acc_counter(:, :) = RESHAPE(m_send%task_int(counter+1:counter+m_send%task_int(counter)), & + subbox_acc_counter(:, :) = RESHAPE(m_send%task_int(counter + 1:counter + m_send%task_int(counter)), & (/SIZE(tmc_params%nmc_move_types%subbox_acc_count(:, 1)), & SIZE(tmc_params%nmc_move_types%subbox_acc_count(1, :))/)) - counter = counter+1+m_send%task_int(counter) + counter = counter + 1 + m_send%task_int(counter) END IF CPASSERT(counter .EQ. m_send%info(2)) @@ -1435,27 +1435,27 @@ SUBROUTINE read_NMC_result_massage(msg_type, elem, m_send, tmc_params) !then float array with pos, (vel, e_kin_befor_md, ekin), (forces), rng_seed, potential, e_pot_approx counter = 1 ! pos - elem%pos = m_send%task_real(counter+1:counter+NINT(m_send%task_real(counter))) - counter = counter+1+NINT(m_send%task_real(counter)) + elem%pos = m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter))) + counter = counter + 1 + NINT(m_send%task_real(counter)) ! rng seed - elem%rng_seed(:, :, :) = RESHAPE(m_send%task_real(counter+1:counter+SIZE(elem%rng_seed)), (/3, 2, 3/)) - counter = counter+1+NINT(m_send%task_real(counter)) + elem%rng_seed(:, :, :) = RESHAPE(m_send%task_real(counter + 1:counter + SIZE(elem%rng_seed)), (/3, 2, 3/)) + counter = counter + 1 + NINT(m_send%task_real(counter)) ! potential - elem%potential = m_send%task_real(counter+1) - counter = counter+2 + elem%potential = m_send%task_real(counter + 1) + counter = counter + 2 ! approximate potential energy - elem%e_pot_approx = m_send%task_real(counter+1) - counter = counter+2 + elem%e_pot_approx = m_send%task_real(counter + 1) + counter = counter + 2 ! for MD also: vel, e_kin_befor_md, ekin IF (msg_type .EQ. TMC_STAT_MD_REQUEST .OR. msg_type .EQ. TMC_STAT_MD_RESULT .OR. & msg_type .EQ. TMC_STAT_MD_BROADCAST) THEN - elem%vel = m_send%task_real(counter+1:counter+NINT(m_send%task_real(counter))) - counter = counter+1+INT(m_send%task_real(counter)) + elem%vel = m_send%task_real(counter + 1:counter + NINT(m_send%task_real(counter))) + counter = counter + 1 + INT(m_send%task_real(counter)) IF (.NOT. (tmc_params%task_type .EQ. task_type_gaussian_adaptation)) & - elem%ekin_before_md = m_send%task_real(counter+1) - counter = counter+2 - elem%ekin = m_send%task_real(counter+1) - counter = counter+2 + elem%ekin_before_md = m_send%task_real(counter + 1) + counter = counter + 2 + elem%ekin = m_send%task_real(counter + 1) + counter = counter + 2 END IF CALL add_mv_prob(move_types=tmc_params%nmc_move_types, prob_opt=tmc_params%esimate_acc_prob, & @@ -1504,30 +1504,30 @@ SUBROUTINE create_analysis_request_message(list_elem, m_send, & counter = 0 !first integer array - msg_size_int = 1+1+1+1+1 ! 1+SIZE(list_elem%elem%sub_tree_nr) +1+SIZE(list_elem%elem%nr) + msg_size_int = 1 + 1 + 1 + 1 + 1 ! 1+SIZE(list_elem%elem%sub_tree_nr) +1+SIZE(list_elem%elem%nr) ALLOCATE (m_send%task_int(msg_size_int)) counter = 1 m_send%task_int(counter) = 1 ! temperature index - m_send%task_int(counter+1:counter+m_send%task_int(counter)) = list_elem%temp_ind - counter = counter+1+m_send%task_int(counter) + m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = list_elem%temp_ind + counter = counter + 1 + m_send%task_int(counter) m_send%task_int(counter) = 1 ! Markov chain number - m_send%task_int(counter+1:counter+m_send%task_int(counter)) = list_elem%nr - counter = counter+1+m_send%task_int(counter) + m_send%task_int(counter + 1:counter + m_send%task_int(counter)) = list_elem%nr + counter = counter + 1 + m_send%task_int(counter) m_send%task_int(counter) = message_end_flag CPASSERT(SIZE(m_send%task_int) .EQ. msg_size_int) CPASSERT(m_send%task_int(msg_size_int) .EQ. message_end_flag) !then float array with pos - msg_size_real = 1+SIZE(list_elem%elem%pos)+1 - IF (tmc_params%pressure .GE. 0.0_dp) msg_size_real = msg_size_real+1+SIZE(list_elem%elem%box_scale(:)) + msg_size_real = 1 + SIZE(list_elem%elem%pos) + 1 + IF (tmc_params%pressure .GE. 0.0_dp) msg_size_real = msg_size_real + 1 + SIZE(list_elem%elem%box_scale(:)) ALLOCATE (m_send%task_real(msg_size_real)) m_send%task_real(1) = SIZE(list_elem%elem%pos) - counter = 2+INT(m_send%task_real(1)) - m_send%task_real(2:counter-1) = list_elem%elem%pos + counter = 2 + INT(m_send%task_real(1)) + m_send%task_real(2:counter - 1) = list_elem%elem%pos IF (tmc_params%pressure .GE. 0.0_dp) THEN m_send%task_real(counter) = SIZE(list_elem%elem%box_scale) - m_send%task_real(counter+1:counter+INT(m_send%task_real(counter))) = list_elem%elem%box_scale(:) - counter = counter+1+INT(m_send%task_real(counter)) + m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter))) = list_elem%elem%box_scale(:) + counter = counter + 1 + INT(m_send%task_real(counter)) END IF m_send%task_real(counter) = REAL(message_end_flag, KIND=dp) !message end @@ -1565,20 +1565,20 @@ SUBROUTINE read_analysis_request_message(elem, m_send, tmc_params) ! read the integer values CPASSERT(m_send%info(2) .GT. 0) counter = 1 - elem%sub_tree_nr = m_send%task_int(counter+1) - counter = counter+1+m_send%task_int(counter) - elem%nr = m_send%task_int(counter+1) - counter = counter+1+m_send%task_int(counter) + elem%sub_tree_nr = m_send%task_int(counter + 1) + counter = counter + 1 + m_send%task_int(counter) + elem%nr = m_send%task_int(counter + 1) + counter = counter + 1 + m_send%task_int(counter) CPASSERT(m_send%task_int(counter) .EQ. message_end_flag) !float array with pos counter = 0 - counter = 1+NINT(m_send%task_real(1)) + counter = 1 + NINT(m_send%task_real(1)) elem%pos = m_send%task_real(2:counter) - counter = counter+1 + counter = counter + 1 IF (tmc_params%pressure .GE. 0.0_dp) THEN - elem%box_scale(:) = m_send%task_real(counter+1:counter+INT(m_send%task_real(counter))) - counter = counter+1+INT(m_send%task_real(counter)) + elem%box_scale(:) = m_send%task_real(counter + 1:counter + INT(m_send%task_real(counter))) + counter = counter + 1 + INT(m_send%task_real(counter)) END IF CPASSERT(counter .EQ. m_send%info(3)) @@ -1604,8 +1604,8 @@ SUBROUTINE read_scf_step_ener(elem, m_send) CPASSERT(ASSOCIATED(elem)) CPASSERT(ASSOCIATED(m_send)) - elem%scf_energies(MOD(elem%scf_energies_count, 4)+1) = m_send%task_real(1) - elem%scf_energies_count = elem%scf_energies_count+1 + elem%scf_energies(MOD(elem%scf_energies_count, 4) + 1) = m_send%task_real(1) + elem%scf_energies_count = elem%scf_energies_count + 1 END SUBROUTINE read_scf_step_ener @@ -1682,7 +1682,7 @@ SUBROUTINE stop_whole_group(para_env, worker_info, tmc_params) CPASSERT(ASSOCIATED(para_env)) CPASSERT(ASSOCIATED(tmc_params)) - ALLOCATE (rank_stoped(0:para_env%num_pe-1)) + ALLOCATE (rank_stoped(0:para_env%num_pe - 1)) rank_stoped(:) = .FALSE. rank_stoped(para_env%mepos) = .TRUE. @@ -1690,7 +1690,7 @@ SUBROUTINE stop_whole_group(para_env, worker_info, tmc_params) IF (PRESENT(worker_info)) THEN CPASSERT(ASSOCIATED(worker_info)) ! canceling running jobs and stop workers - worker_group_loop: DO dest_rank = 1, para_env%num_pe-1 + worker_group_loop: DO dest_rank = 1, para_env%num_pe - 1 ! busy workers have to be canceled IF (worker_info(dest_rank)%busy) THEN stat = TMC_CANCELING_MESSAGE diff --git a/src/tmc/tmc_move_handle.F b/src/tmc/tmc_move_handle.F index 7f37834e79..5e68b75e31 100644 --- a/src/tmc/tmc_move_handle.F +++ b/src/tmc/tmc_move_handle.F @@ -106,7 +106,7 @@ SUBROUTINE read_init_move_types(tmc_params, tmc_section) DO i_rep = 1, n_items CALL section_vals_val_get(move_type_section, "PROB", i_rep_section=i_rep, & r_val=mv_prob) - mv_prob_sum = mv_prob_sum+mv_prob + mv_prob_sum = mv_prob_sum + mv_prob END DO END IF @@ -140,14 +140,14 @@ SUBROUTINE read_init_move_types(tmc_params, tmc_section) DO i_rep = 1, n_NMC_items CALL section_vals_val_get(move_type_section, "PROB", i_rep_section=i_rep, & r_val=mv_prob) - nmc_prob_sum = nmc_prob_sum+mv_prob + nmc_prob_sum = nmc_prob_sum + mv_prob END DO END IF ! get the total weight/amount of move probabilities - mv_prob_sum = mv_prob_sum+nmc_prob + mv_prob_sum = mv_prob_sum + nmc_prob - IF (n_items+n_NMC_items .GT. 0) THEN + IF (n_items + n_NMC_items .GT. 0) THEN ! initilaize the move array with related sizes, probs, etc. CALL move_types_create(tmc_params%move_types, tmc_params%nr_temp) @@ -157,10 +157,10 @@ SUBROUTINE read_init_move_types(tmc_params, tmc_section) "in total less equal 0") ! get the sizes, probs, etc. for each move type and convert units - DO i_tmp = 1, n_items+n_NMC_items + DO i_tmp = 1, n_items + n_NMC_items ! select the corect section IF (i_tmp .GT. n_items) THEN - i_rep = i_tmp-n_items + i_rep = i_tmp - n_items IF (i_rep .EQ. 1) THEN ! set the NMC stuff (approx potential) tmc_params%move_types%mv_weight(mv_type_NMC_moves) = & @@ -312,10 +312,10 @@ SUBROUTINE read_init_move_types(tmc_params, tmc_section) END IF mv_prob_sum = SUM(tmc_params%move_types%mv_weight(:)) flag = .TRUE. - CPASSERT(ABS(mv_prob_sum-1.0_dp) .LT. 0.01_dp) + CPASSERT(ABS(mv_prob_sum - 1.0_dp) .LT. 0.01_dp) IF (ASSOCIATED(tmc_params%nmc_move_types)) THEN mv_prob_sum = SUM(tmc_params%nmc_move_types%mv_weight(:)) - CPASSERT(ABS(mv_prob_sum-1.0_dp) < 10*EPSILON(1.0_dp)) + CPASSERT(ABS(mv_prob_sum - 1.0_dp) < 10*EPSILON(1.0_dp)) END IF END SUBROUTINE read_init_move_types @@ -373,7 +373,7 @@ SUBROUTINE check_moves(tmc_params, move_types, mol_array) ") is not contained in the system. ") ! check if not be swapped with the same atom type IF (ANY(move_types%atom_lists(list_i)%atoms(atom_j) .EQ. & - move_types%atom_lists(list_i)%atoms(atom_j+1:))) THEN + move_types%atom_lists(list_i)%atoms(atom_j + 1:))) THEN CALL cp_abort(__LOCATION__, & "ATOM_SWAP can not swap two atoms of same kind ("// & TRIM(move_types%atom_lists(list_i)%atoms(atom_j))// & @@ -455,7 +455,7 @@ SUBROUTINE print_move_types(init, file_io, tmc_params) CPASSERT(file_io .GT. 0) CPASSERT(ASSOCIATED(tmc_params%move_types)) - FLUSH(file_io) + FLUSH (file_io) IF (.NOT. init .AND. & tmc_params%move_types%mv_weight(mv_type_NMC_moves) .GT. 0 .AND. & @@ -477,13 +477,13 @@ SUBROUTINE print_move_types(init, file_io, tmc_params) c_tit = ""; c_a = ""; c_b = ""; c_c = "" IF (init .AND. temper .GT. 1) EXIT temp_loop WRITE (c_t, "(F10.2)") tmc_params%Temp(temper) - typ_loop: DO move = 0, SIZE(tmc_params%move_types%mv_weight)+nr_nmc_moves + typ_loop: DO move = 0, SIZE(tmc_params%move_types%mv_weight) + nr_nmc_moves ! the NMC moves IF (move .LE. SIZE(tmc_params%move_types%mv_weight)) THEN typ = move move_types => tmc_params%move_types ELSE - typ = move-SIZE(tmc_params%move_types%mv_weight) + typ = move - SIZE(tmc_params%move_types%mv_weight) move_types => tmc_params%nmc_move_types END IF ! total average @@ -770,8 +770,8 @@ SUBROUTINE prob_update(move_types, pt_el, elem, acc, subbox, prob_opt) IF (PRESENT(subbox)) THEN ! only update subbox acceptance IF (acc) & - move_types%subbox_acc_count(mv_type, conf_moved) = move_types%subbox_acc_count(mv_type, conf_moved)+1 - move_types%subbox_count(mv_type, conf_moved) = move_types%subbox_count(mv_type, conf_moved)+1 + move_types%subbox_acc_count(mv_type, conf_moved) = move_types%subbox_acc_count(mv_type, conf_moved) + 1 + move_types%subbox_count(mv_type, conf_moved) = move_types%subbox_count(mv_type, conf_moved) + 1 ! No more to do change_type = 0 change_res = 0 @@ -790,17 +790,17 @@ SUBROUTINE prob_update(move_types, pt_el, elem, acc, subbox, prob_opt) !-- INcrease or DEcrease accaptance rate ! MOVE types IF (change_type .GT. 0) THEN - move_types%acc_count(mv_type, conf_moved) = move_types%acc_count(mv_type, conf_moved)+1 + move_types%acc_count(mv_type, conf_moved) = move_types%acc_count(mv_type, conf_moved) + 1 END IF ! RESULTs IF (change_res .GT. 0) THEN - move_types%acc_count(0, conf_moved) = move_types%acc_count(0, conf_moved)+1 + move_types%acc_count(0, conf_moved) = move_types%acc_count(0, conf_moved) + 1 END IF - IF (conf_moved .GT. 0) move_types%mv_count(0, conf_moved) = move_types%mv_count(0, conf_moved)+ABS(change_res) + IF (conf_moved .GT. 0) move_types%mv_count(0, conf_moved) = move_types%mv_count(0, conf_moved) + ABS(change_res) IF (mv_type .GE. 0 .AND. conf_moved .GT. 0) & - move_types%mv_count(mv_type, conf_moved) = move_types%mv_count(mv_type, conf_moved)+ABS(change_type) + move_types%mv_count(mv_type, conf_moved) = move_types%mv_count(mv_type, conf_moved) + ABS(change_type) IF (prob_opt) THEN WHERE (move_types%mv_count .GT. 0) & @@ -834,8 +834,8 @@ SUBROUTINE add_mv_prob(move_types, prob_opt, mv_counter, acc_counter, & IF (PRESENT(mv_counter)) THEN CPASSERT(PRESENT(acc_counter)) - move_types%mv_count(:, :) = move_types%mv_count(:, :)+mv_counter(:, :) - move_types%acc_count(:, :) = move_types%acc_count(:, :)+acc_counter(:, :) + move_types%mv_count(:, :) = move_types%mv_count(:, :) + mv_counter(:, :) + move_types%acc_count(:, :) = move_types%acc_count(:, :) + acc_counter(:, :) IF (prob_opt) THEN WHERE (move_types%mv_count .GT. 0) & move_types%acc_prob(:, :) = move_types%acc_count(:, :)/REAL(move_types%mv_count(:, :), KIND=dp) @@ -844,8 +844,8 @@ SUBROUTINE add_mv_prob(move_types, prob_opt, mv_counter, acc_counter, & IF (PRESENT(subbox_counter)) THEN CPASSERT(PRESENT(subbox_acc_counter)) - move_types%subbox_count(:, :) = move_types%subbox_count(:, :)+subbox_counter(:, :) - move_types%subbox_acc_count(:, :) = move_types%subbox_acc_count(:, :)+subbox_acc_counter(:, :) + move_types%subbox_count(:, :) = move_types%subbox_count(:, :) + subbox_counter(:, :) + move_types%subbox_acc_count(:, :) = move_types%subbox_acc_count(:, :) + subbox_acc_counter(:, :) END IF END SUBROUTINE add_mv_prob diff --git a/src/tmc/tmc_moves.F b/src/tmc/tmc_moves.F index 05a4f33ac3..cf6c3c9e47 100644 --- a/src/tmc/tmc_moves.F +++ b/src/tmc/tmc_moves.F @@ -135,22 +135,22 @@ SUBROUTINE change_pos(tmc_params, move_types, rng_stream, elem, mv_conf, & move_elements_loop: DO ! select atom IF (tmc_params%nr_elem_mv .EQ. 0) THEN - ind = (i-1)*(tmc_params%dim_per_elem)+1 + ind = (i - 1)*(tmc_params%dim_per_elem) + 1 ELSE rnd = next_random_number(rng_stream) ! next random number ind = tmc_params%dim_per_elem* & - INT(rnd*(SIZE(elem%pos)/tmc_params%dim_per_elem))+1 + INT(rnd*(SIZE(elem%pos)/tmc_params%dim_per_elem)) + 1 END IF ! apply move IF (elem%elem_stat(ind) .EQ. status_ok) THEN ! displace atom - DO d = 0, tmc_params%dim_per_elem-1 + DO d = 0, tmc_params%dim_per_elem - 1 rnd = next_random_number(rng_stream) ! next random number - elem%pos(ind+d) = elem%pos(ind+d)+(rnd-0.5)*2.0* & - move_types%mv_size(mv_type_atom_trans, mv_conf) + elem%pos(ind + d) = elem%pos(ind + d) + (rnd - 0.5)*2.0* & + move_types%mv_size(mv_type_atom_trans, mv_conf) END DO ! check if new position is in subbox - elem_center = elem%pos(ind:ind+tmc_params%dim_per_elem-1) + elem_center = elem%pos(ind:ind + tmc_params%dim_per_elem - 1) IF (.NOT. check_pos_in_subbox(pos=elem_center, & subbox_center=elem%subbox_center, & box_scale=elem%box_scale, tmc_params=tmc_params) & @@ -160,9 +160,9 @@ SUBROUTINE change_pos(tmc_params, move_types, rng_stream, elem, mv_conf, & END IF ELSE ! element was not in sub box, search new one instead - IF (tmc_params%nr_elem_mv .GT. 0) i = i-1 + IF (tmc_params%nr_elem_mv .GT. 0) i = i - 1 END IF - i = i+1 + i = i + 1 IF (i .GT. act_nr_elem_mv) EXIT move_elements_loop END DO move_elements_loop DEALLOCATE (elem_center) @@ -180,7 +180,7 @@ SUBROUTINE change_pos(tmc_params, move_types, rng_stream, elem, mv_conf, & DO m = 1, nr_molec CALL get_mol_indeces(tmc_params=tmc_params, mol_arr=elem%mol, mol=m, & start_ind=ind, end_ind=ind_e) - CALL geometrical_center(pos=elem%pos(ind:ind_e+tmc_params%dim_per_elem-1), & + CALL geometrical_center(pos=elem%pos(ind:ind_e + tmc_params%dim_per_elem - 1), & center=elem_center) IF (check_pos_in_subbox(pos=elem_center, & subbox_center=elem%subbox_center, & @@ -198,7 +198,7 @@ SUBROUTINE change_pos(tmc_params, move_types, rng_stream, elem, mv_conf, & m = counter ELSE rnd = next_random_number(rng_stream) ! next random number - m = INT(rnd*nr_molec)+1 + m = INT(rnd*nr_molec) + 1 END IF CALL get_mol_indeces(tmc_params=tmc_params, mol_arr=elem%mol, mol=m, & start_ind=ind, end_ind=ind_e) @@ -211,19 +211,19 @@ SUBROUTINE change_pos(tmc_params, move_types, rng_stream, elem, mv_conf, & ! calculate displacement DO d = 1, tmc_params%dim_per_elem rnd = next_random_number(rng_stream) ! next random number - direction(d) = (rnd-0.5)*2.0_dp*move_types%mv_size( & + direction(d) = (rnd - 0.5)*2.0_dp*move_types%mv_size( & mv_type_mol_trans, mv_conf) END DO ! check if displaced position is still in subbox - elem_center(:) = elem_center(:)+direction(:) + elem_center(:) = elem_center(:) + direction(:) IF (check_pos_in_subbox(pos=elem_center, & subbox_center=elem%subbox_center, & box_scale=elem%box_scale, tmc_params=tmc_params) & ) THEN ! apply move - atom_in_mol_loop: DO i = ind, ind_e+tmc_params%dim_per_elem-1, tmc_params%dim_per_elem - dim_loop: DO d = 0, tmc_params%dim_per_elem-1 - elem%pos(i+d) = elem%pos(i+d)+direction(d+1) + atom_in_mol_loop: DO i = ind, ind_e + tmc_params%dim_per_elem - 1, tmc_params%dim_per_elem + dim_loop: DO d = 0, tmc_params%dim_per_elem - 1 + elem%pos(i + d) = elem%pos(i + d) + direction(d + 1) END DO dim_loop END DO atom_in_mol_loop ELSE @@ -233,9 +233,9 @@ SUBROUTINE change_pos(tmc_params, move_types, rng_stream, elem, mv_conf, & END IF ELSE ! element was not in sub box, search new one instead - IF (tmc_params%nr_elem_mv .GT. 0) counter = counter-1 + IF (tmc_params%nr_elem_mv .GT. 0) counter = counter - 1 END IF - counter = counter+1 + counter = counter + 1 IF (counter .GT. act_nr_elem_mv) EXIT move_molecule_loop END DO move_molecule_loop DEALLOCATE (direction) @@ -255,7 +255,7 @@ SUBROUTINE change_pos(tmc_params, move_types, rng_stream, elem, mv_conf, & DO m = 1, nr_molec CALL get_mol_indeces(tmc_params=tmc_params, mol_arr=elem%mol, mol=m, & start_ind=ind, end_ind=ind_e) - CALL geometrical_center(pos=elem%pos(ind:ind_e+tmc_params%dim_per_elem-1), & + CALL geometrical_center(pos=elem%pos(ind:ind_e + tmc_params%dim_per_elem - 1), & center=elem_center) IF (check_pos_in_subbox(pos=elem_center, & subbox_center=elem%subbox_center, & @@ -272,7 +272,7 @@ SUBROUTINE change_pos(tmc_params, move_types, rng_stream, elem, mv_conf, & m = counter ELSE rnd = next_random_number(rng_stream) ! next random number - m = INT(rnd*nr_molec)+1 + m = INT(rnd*nr_molec) + 1 END IF CALL get_mol_indeces(tmc_params=tmc_params, mol_arr=elem%mol, mol=m, & start_ind=ind, end_ind=ind_e) @@ -287,22 +287,22 @@ SUBROUTINE change_pos(tmc_params, move_types, rng_stream, elem, mv_conf, & move_types=move_types, rng_stream=rng_stream, & dim_per_elem=tmc_params%dim_per_elem) ! update sub box status of single atom - DO i = ind, ind_e+tmc_params%dim_per_elem-1, tmc_params%dim_per_elem - elem_center = elem%pos(i:i+tmc_params%dim_per_elem-1) + DO i = ind, ind_e + tmc_params%dim_per_elem - 1, tmc_params%dim_per_elem + elem_center = elem%pos(i:i + tmc_params%dim_per_elem - 1) IF (check_pos_in_subbox(pos=elem_center, & subbox_center=elem%subbox_center, & box_scale=elem%box_scale, tmc_params=tmc_params) & ) THEN - elem%elem_stat(i:i+tmc_params%dim_per_elem-1) = status_ok + elem%elem_stat(i:i + tmc_params%dim_per_elem - 1) = status_ok ELSE - elem%elem_stat(i:i+tmc_params%dim_per_elem-1) = status_frozen + elem%elem_stat(i:i + tmc_params%dim_per_elem - 1) = status_frozen END IF END DO ELSE ! element was not in sub box, search new one instead - IF (tmc_params%nr_elem_mv .GT. 0) counter = counter-1 + IF (tmc_params%nr_elem_mv .GT. 0) counter = counter - 1 END IF - counter = counter+1 + counter = counter + 1 IF (counter .GT. act_nr_elem_mv) EXIT rot_molecule_loop END DO rot_molecule_loop END IF @@ -317,7 +317,7 @@ SUBROUTINE change_pos(tmc_params, move_types, rng_stream, elem, mv_conf, & !-- attention, move type size is in atomic units of velocity IF (elem%elem_stat(i) .NE. status_frozen) THEN CALL vel_change(vel=elem%vel(i), & - atom_kind=tmc_params%atoms(INT(i/REAL(tmc_params%dim_per_elem, KIND=dp))+1), & + atom_kind=tmc_params%atoms(INT(i/REAL(tmc_params%dim_per_elem, KIND=dp)) + 1), & phi=move_types%mv_size(mv_type_MD, 1), & ! TODO parallel tempering move sizes for vel_change temp=tmc_params%Temp(mv_conf), & rnd_sign_change=.TRUE., & ! MD_vel_invert, & @@ -401,8 +401,8 @@ SUBROUTINE get_mol_indeces(tmc_params, mol_arr, mol, start_ind, end_ind) CPASSERT(start_ind .GT. 0) CPASSERT(end_ind .GT. 0) ! convert to indeces mapped for the position array (multiple dim per atom) - start_ind = (start_ind-1)*tmc_params%dim_per_elem+1 - end_ind = (end_ind-1)*tmc_params%dim_per_elem+1 + start_ind = (start_ind - 1)*tmc_params%dim_per_elem + 1 + end_ind = (end_ind - 1)*tmc_params%dim_per_elem + 1 END SUBROUTINE ! ************************************************************************************************** @@ -445,7 +445,7 @@ FUNCTION check_pos_in_subbox(pos, subbox_center, box_scale, tmc_params) & inside = .TRUE. ! return if no subbox is defined IF (.NOT. ANY(tmc_params%sub_box_size(:) .LE. 0.1_dp)) THEN - pos_tmp(:) = pos(:)-subbox_center(:) + pos_tmp(:) = pos(:) - subbox_center(:) CALL get_scaled_cell(cell=tmc_params%cell, box_scale=box_scale, & vec=pos_tmp) ! check @@ -518,14 +518,14 @@ SUBROUTINE elements_in_new_subbox(tmc_params, rng_stream, elem, & ! check all elements if they are in subbox DO i = 1, SIZE(elem%pos), tmc_params%dim_per_elem - atom_tmp(:) = elem%pos(i:i+tmc_params%dim_per_elem-1) + atom_tmp(:) = elem%pos(i:i + tmc_params%dim_per_elem - 1) IF (check_pos_in_subbox(pos=atom_tmp, & subbox_center=center_of_sub_box, box_scale=elem%box_scale, & tmc_params=tmc_params)) THEN - elem%elem_stat(i:i+tmc_params%dim_per_elem-1) = status_ok - nr_of_sub_box_elements = nr_of_sub_box_elements+1 + elem%elem_stat(i:i + tmc_params%dim_per_elem - 1) = status_ok + nr_of_sub_box_elements = nr_of_sub_box_elements + 1 ELSE - elem%elem_stat(i:i+tmc_params%dim_per_elem-1) = status_frozen + elem%elem_stat(i:i + tmc_params%dim_per_elem - 1) = status_frozen END IF END DO DEALLOCATE (atom_tmp) @@ -572,27 +572,27 @@ SUBROUTINE do_mol_rot(pos, ind_start, ind_end, max_angle, move_types, & ! calculate rotation matrix (using quanternions) rnd = next_random_number(rng_stream) ! next random number - a1 = (rnd-0.5)*2.0*max_angle !move_types%mv_size(mv_type_mol_rot,mv_conf) + a1 = (rnd - 0.5)*2.0*max_angle !move_types%mv_size(mv_type_mol_rot,mv_conf) rnd = next_random_number(rng_stream) ! next random number - a2 = (rnd-0.5)*2.0*max_angle !move_types%mv_size(mv_type_mol_rot,mv_conf) + a2 = (rnd - 0.5)*2.0*max_angle !move_types%mv_size(mv_type_mol_rot,mv_conf) rnd = next_random_number(rng_stream) ! next random number - a3 = (rnd-0.5)*2.0*max_angle !move_types%mv_size(mv_type_mol_rot,mv_conf) - q0 = COS(a2/2)*COS((a1+a3)/2.0_dp) - q1 = SIN(a2/2)*COS((a1-a3)/2.0_dp) - q2 = SIN(a2/2)*SIN((a1-a3)/2.0_dp) - q3 = COS(a2/2)*SIN((a1+a3)/2.0_dp) - rot = RESHAPE((/q0*q0+q1*q1-q2*q2-q3*q3, 2*(q1*q2-q0*q3), 2*(q1*q3+q0*q2), & - 2*(q1*q2+q0*q3), q0*q0-q1*q1+q2*q2-q3*q3, 2*(q2*q3-q0*q1), & - 2*(q1*q3-q0*q2), 2*(q2*q3+q0*q1), q0*q0-q1*q1-q2*q2+q3*q3/), (/3, 3/)) + a3 = (rnd - 0.5)*2.0*max_angle !move_types%mv_size(mv_type_mol_rot,mv_conf) + q0 = COS(a2/2)*COS((a1 + a3)/2.0_dp) + q1 = SIN(a2/2)*COS((a1 - a3)/2.0_dp) + q2 = SIN(a2/2)*SIN((a1 - a3)/2.0_dp) + q3 = COS(a2/2)*SIN((a1 + a3)/2.0_dp) + rot = RESHAPE((/q0*q0 + q1*q1 - q2*q2 - q3*q3, 2*(q1*q2 - q0*q3), 2*(q1*q3 + q0*q2), & + 2*(q1*q2 + q0*q3), q0*q0 - q1*q1 + q2*q2 - q3*q3, 2*(q2*q3 - q0*q1), & + 2*(q1*q3 - q0*q2), 2*(q2*q3 + q0*q1), q0*q0 - q1*q1 - q2*q2 + q3*q3/), (/3, 3/)) ALLOCATE (elem_center(dim_per_elem)) ! calculate geometrical center - CALL geometrical_center(pos=pos(ind_start:ind_end+dim_per_elem-1), & + CALL geometrical_center(pos=pos(ind_start:ind_end + dim_per_elem - 1), & center=elem_center) ! proceed rotation - atom_loop: DO i = ind_start, ind_end+dim_per_elem-1, dim_per_elem - pos(i:i+2) = MATMUL(pos(i:i+2)-elem_center(:), rot)+elem_center(:) + atom_loop: DO i = ind_start, ind_end + dim_per_elem - 1, dim_per_elem + pos(i:i + 2) = MATMUL(pos(i:i + 2) - elem_center(:), rot) + elem_center(:) END DO atom_loop DEALLOCATE (elem_center) END SUBROUTINE do_mol_rot @@ -649,7 +649,7 @@ SUBROUTINE vel_change(vel, atom_kind, phi, temp, rnd_sign_change, rng_stream) ELSE d = 1 END IF - vel = SIN(phi)*delta_vel+COS(phi)*vel*d*1.0_dp + vel = SIN(phi)*delta_vel + COS(phi)*vel*d*1.0_dp END SUBROUTINE vel_change ! ************************************************************************************************** @@ -708,14 +708,14 @@ SUBROUTINE search_and_do_proton_displace_loop(elem, short_loop, rng_stream, & ! select randomly one atom rnd = next_random_number(rng_stream) ! the randomly selected first atom - mol = INT(rnd*nr_mol)+1 - counter = counter+1 + mol = INT(rnd*nr_mol) + 1 + counter = counter + 1 mol_arr(counter) = mol ! do until the loop is closed ! (until path connects back to any spot of the path) chain_completition_loop: DO - counter = counter+1 + counter = counter + 1 ! find nearest neighbor ! (with same state, in the chain, proton donator or proton accptor) CALL find_nearest_proton_acceptor_donator(elem=elem, mol=mol, & @@ -725,15 +725,15 @@ SUBROUTINE search_and_do_proton_displace_loop(elem, short_loop, rng_stream, & EXIT chain_completition_loop mol_arr(counter) = mol END DO chain_completition_loop - counter = counter-1 ! last searched element is equal to one other in list + counter = counter - 1 ! last searched element is equal to one other in list ! just take the loop of molecules out of the chain DO k = 1, counter IF (mol_arr(k) .EQ. mol) & EXIT END DO - mol_arr(1:counter-k+1) = mol_arr(k:counter) - counter = counter-k+1 + mol_arr(1:counter - k + 1) = mol_arr(k:counter) + counter = counter - k + 1 ! check if loop is minimum size of 6 molecules IF (counter .LT. 6) THEN @@ -815,7 +815,7 @@ SUBROUTINE find_nearest_proton_acceptor_donator(elem, mol, donor_acceptor, & CALL get_mol_indeces(tmc_params=tmc_params, mol_arr=elem%mol, & mol=mol_tmp, start_ind=ind_n, end_ind=ind_e) ! check if selected molecule is water respectively consists of 3 atoms - IF (MOD(ind_e-ind_n, 3) .GT. 0) THEN + IF (MOD(ind_e - ind_n, 3) .GT. 0) THEN CALL cp_warn(__LOCATION__, & "selected a molecule with more than 3 atoms, "// & "the proton reordering does not support, skip molecule") @@ -826,15 +826,15 @@ SUBROUTINE find_nearest_proton_acceptor_donator(elem, mol, donor_acceptor, & tmc_params=tmc_params) .EQ. proton_acceptor) THEN !distance of fist proton to certain O distH1(mol_tmp) = nearest_distance( & - x1=elem%pos(ind+tmc_params%dim_per_elem: & - ind+2*tmc_params%dim_per_elem-1), & - x2=elem%pos(ind_n:ind_n+tmc_params%dim_per_elem-1), & + x1=elem%pos(ind + tmc_params%dim_per_elem: & + ind + 2*tmc_params%dim_per_elem - 1), & + x2=elem%pos(ind_n:ind_n + tmc_params%dim_per_elem - 1), & cell=tmc_params%cell, box_scale=elem%box_scale) !distance of second proton to certain O distH2(mol_tmp) = nearest_distance( & - x1=elem%pos(ind+2*tmc_params%dim_per_elem: & - ind+3*tmc_params%dim_per_elem-1), & - x2=elem%pos(ind_n:ind_n+tmc_params%dim_per_elem-1), & + x1=elem%pos(ind + 2*tmc_params%dim_per_elem: & + ind + 3*tmc_params%dim_per_elem - 1), & + x2=elem%pos(ind_n:ind_n + tmc_params%dim_per_elem - 1), & cell=tmc_params%cell, box_scale=elem%box_scale) END IF END IF @@ -844,14 +844,14 @@ SUBROUTINE find_nearest_proton_acceptor_donator(elem, mol, donor_acceptor, & tmc_params=tmc_params) .EQ. proton_donor) THEN !distance of selected O to all first protons of other melecules distO(mol_tmp) = nearest_distance( & - x1=elem%pos(ind:ind+tmc_params%dim_per_elem-1), & - x2=elem%pos(ind_n+tmc_params%dim_per_elem: & - ind_n+2*tmc_params%dim_per_elem-1), & + x1=elem%pos(ind:ind + tmc_params%dim_per_elem - 1), & + x2=elem%pos(ind_n + tmc_params%dim_per_elem: & + ind_n + 2*tmc_params%dim_per_elem - 1), & cell=tmc_params%cell, box_scale=elem%box_scale) dist_tmp = nearest_distance( & - x1=elem%pos(ind:ind+tmc_params%dim_per_elem-1), & - x2=elem%pos(ind_n+2*tmc_params%dim_per_elem: & - ind_n+3*tmc_params%dim_per_elem-1), & + x1=elem%pos(ind:ind + tmc_params%dim_per_elem - 1), & + x2=elem%pos(ind_n + 2*tmc_params%dim_per_elem: & + ind_n + 3*tmc_params%dim_per_elem - 1), & cell=tmc_params%cell, box_scale=elem%box_scale) IF (dist_tmp .LT. distO(mol_tmp)) distO(mol_tmp) = dist_tmp END IF @@ -863,31 +863,31 @@ SUBROUTINE find_nearest_proton_acceptor_donator(elem, mol, donor_acceptor, & !check for neighboring proton acceptors IF (donor_acceptor .EQ. proton_acceptor) THEN neighbor_mol(mol_tmp) = MINLOC(distH1(:), 1) - neighbor_mol(mol_tmp+1) = MINLOC(distH2(:), 1) + neighbor_mol(mol_tmp + 1) = MINLOC(distH2(:), 1) ! if both smallest distances points to the shortest molecule search also the second next shortest distance - IF (neighbor_mol(mol_tmp) .EQ. neighbor_mol(mol_tmp+1)) THEN + IF (neighbor_mol(mol_tmp) .EQ. neighbor_mol(mol_tmp + 1)) THEN distH1(neighbor_mol(mol_tmp)) = HUGE(distH1(1)) - distH2(neighbor_mol(mol_tmp+1)) = HUGE(distH2(1)) + distH2(neighbor_mol(mol_tmp + 1)) = HUGE(distH2(1)) IF (MINVAL(distH1(:), 1) .LT. MINVAL(distH2(:), 1)) THEN neighbor_mol(mol_tmp) = MINLOC(distH1(:), 1) ELSE - neighbor_mol(mol_tmp+1) = MINLOC(distH2(:), 1) + neighbor_mol(mol_tmp + 1) = MINLOC(distH2(:), 1) END IF END IF - mol_tmp = mol_tmp+2 + mol_tmp = mol_tmp + 2 END IF !check for neighboring proton donors IF (donor_acceptor .EQ. proton_donor) THEN neighbor_mol(mol_tmp) = MINLOC(distO(:), 1) distO(neighbor_mol(mol_tmp)) = HUGE(distO(1)) - neighbor_mol(mol_tmp+1) = MINLOC(distO(:), 1) + neighbor_mol(mol_tmp + 1) = MINLOC(distO(:), 1) END IF ! select randomly the next neighboring molecule rnd = next_random_number(rng_stream) ! the randomly selected atom: return value! - mol_tmp = neighbor_mol(INT(rnd*SIZE(neighbor_mol(:)))+1) + mol_tmp = neighbor_mol(INT(rnd*SIZE(neighbor_mol(:))) + 1) mol = mol_tmp DEALLOCATE (distO) @@ -927,27 +927,27 @@ FUNCTION check_donor_acceptor(elem, i_orig, i_neighbor, tmc_params) & ! 1. proton of orig with neighbor O distances(1) = nearest_distance( & - x1=elem%pos(i_neighbor:i_neighbor+tmc_params%dim_per_elem-1), & - x2=elem%pos(i_orig+tmc_params%dim_per_elem: & - i_orig+2*tmc_params%dim_per_elem-1), & + x1=elem%pos(i_neighbor:i_neighbor + tmc_params%dim_per_elem - 1), & + x2=elem%pos(i_orig + tmc_params%dim_per_elem: & + i_orig + 2*tmc_params%dim_per_elem - 1), & cell=tmc_params%cell, box_scale=elem%box_scale) ! 2. proton of orig with neighbor O distances(2) = nearest_distance( & - x1=elem%pos(i_neighbor:i_neighbor+tmc_params%dim_per_elem-1), & - x2=elem%pos(i_orig+2*tmc_params%dim_per_elem: & - i_orig+3*tmc_params%dim_per_elem-1), & + x1=elem%pos(i_neighbor:i_neighbor + tmc_params%dim_per_elem - 1), & + x2=elem%pos(i_orig + 2*tmc_params%dim_per_elem: & + i_orig + 3*tmc_params%dim_per_elem - 1), & cell=tmc_params%cell, box_scale=elem%box_scale) ! 1. proton of neighbor with orig O distances(3) = nearest_distance( & - x1=elem%pos(i_orig:i_orig+tmc_params%dim_per_elem-1), & - x2=elem%pos(i_neighbor+tmc_params%dim_per_elem: & - i_neighbor+2*tmc_params%dim_per_elem-1), & + x1=elem%pos(i_orig:i_orig + tmc_params%dim_per_elem - 1), & + x2=elem%pos(i_neighbor + tmc_params%dim_per_elem: & + i_neighbor + 2*tmc_params%dim_per_elem - 1), & cell=tmc_params%cell, box_scale=elem%box_scale) ! 2. proton of neigbor with orig O distances(4) = nearest_distance( & - x1=elem%pos(i_orig:i_orig+tmc_params%dim_per_elem-1), & - x2=elem%pos(i_neighbor+2*tmc_params%dim_per_elem: & - i_neighbor+3*tmc_params%dim_per_elem-1), & + x1=elem%pos(i_orig:i_orig + tmc_params%dim_per_elem - 1), & + x2=elem%pos(i_neighbor + 2*tmc_params%dim_per_elem: & + i_neighbor + 3*tmc_params%dim_per_elem - 1), & cell=tmc_params%cell, box_scale=elem%box_scale) IF (MINLOC(distances(:), 1) .LE. 2) THEN @@ -993,14 +993,14 @@ SUBROUTINE rotate_molecules_in_chain(tmc_params, elem, mol_arr_in, & ! start the timing CALL timeset(routineN, handle) - ALLOCATE (ind_arr(0:SIZE(mol_arr_in)+1)) + ALLOCATE (ind_arr(0:SIZE(mol_arr_in) + 1)) DO i = 1, SIZE(mol_arr_in) CALL get_mol_indeces(tmc_params=tmc_params, mol_arr=elem%mol, & mol=mol_arr_in(i), & start_ind=ind_arr(i), end_ind=ind) END DO - ind_arr(0) = ind_arr(SIZE(ind_arr)-2) - ind_arr(SIZE(ind_arr)-1) = ind_arr(1) + ind_arr(0) = ind_arr(SIZE(ind_arr) - 2) + ind_arr(SIZE(ind_arr) - 1) = ind_arr(1) ! get the scaled cell ALLOCATE (tmp_cell) @@ -1008,59 +1008,59 @@ SUBROUTINE rotate_molecules_in_chain(tmc_params, elem, mol_arr_in, & scaled_cell=tmp_cell) ! rotate single molecules - DO i = 1, SIZE(ind_arr)-2 + DO i = 1, SIZE(ind_arr) - 2 ! the 3 O atoms - vec_1O(:) = elem%pos(ind_arr(i-1):ind_arr(i-1)+tmc_params%dim_per_elem-1) - vec_2O(:) = elem%pos(ind_arr(i):ind_arr(i)+tmc_params%dim_per_elem-1) - vec_3O(:) = elem%pos(ind_arr(i+1):ind_arr(i+1)+tmc_params%dim_per_elem-1) + vec_1O(:) = elem%pos(ind_arr(i - 1):ind_arr(i - 1) + tmc_params%dim_per_elem - 1) + vec_2O(:) = elem%pos(ind_arr(i):ind_arr(i) + tmc_params%dim_per_elem - 1) + vec_3O(:) = elem%pos(ind_arr(i + 1):ind_arr(i + 1) + tmc_params%dim_per_elem - 1) ! the H atoms ! distinguished between the one fixed (rotation axis with 2 O) ! and the moved one ! if true the first H atom is between the O atoms IF (nearest_distance( & - x1=elem%pos(ind_arr(i+donor_acceptor): & - ind_arr(i+donor_acceptor)+tmc_params%dim_per_elem-1), & - x2=elem%pos(ind_arr(i)+tmc_params%dim_per_elem: & - ind_arr(i)+2*tmc_params%dim_per_elem-1), & + x1=elem%pos(ind_arr(i + donor_acceptor): & + ind_arr(i + donor_acceptor) + tmc_params%dim_per_elem - 1), & + x2=elem%pos(ind_arr(i) + tmc_params%dim_per_elem: & + ind_arr(i) + 2*tmc_params%dim_per_elem - 1), & cell=tmc_params%cell, box_scale=elem%box_scale) & .LT. & nearest_distance( & - x1=elem%pos(ind_arr(i+donor_acceptor): & - ind_arr(i+donor_acceptor)+tmc_params%dim_per_elem-1), & - x2=elem%pos(ind_arr(i)+2*tmc_params%dim_per_elem: & - ind_arr(i)+3*tmc_params%dim_per_elem-1), & + x1=elem%pos(ind_arr(i + donor_acceptor): & + ind_arr(i + donor_acceptor) + tmc_params%dim_per_elem - 1), & + x2=elem%pos(ind_arr(i) + 2*tmc_params%dim_per_elem: & + ind_arr(i) + 3*tmc_params%dim_per_elem - 1), & cell=tmc_params%cell, box_scale=elem%box_scale) & ) THEN - vec_2H_m = elem%pos(ind_arr(i)+tmc_params%dim_per_elem: & - ind_arr(i)+2*tmc_params%dim_per_elem-1) - vec_2H_f = elem%pos(ind_arr(i)+2*tmc_params%dim_per_elem: & - ind_arr(i)+3*tmc_params%dim_per_elem-1) + vec_2H_m = elem%pos(ind_arr(i) + tmc_params%dim_per_elem: & + ind_arr(i) + 2*tmc_params%dim_per_elem - 1) + vec_2H_f = elem%pos(ind_arr(i) + 2*tmc_params%dim_per_elem: & + ind_arr(i) + 3*tmc_params%dim_per_elem - 1) H_offset = 1 ELSE - vec_2H_f = elem%pos(ind_arr(i)+tmc_params%dim_per_elem: & - ind_arr(i)+2*tmc_params%dim_per_elem-1) - vec_2H_m = elem%pos(ind_arr(i)+2*tmc_params%dim_per_elem: & - ind_arr(i)+3*tmc_params%dim_per_elem-1) + vec_2H_f = elem%pos(ind_arr(i) + tmc_params%dim_per_elem: & + ind_arr(i) + 2*tmc_params%dim_per_elem - 1) + vec_2H_m = elem%pos(ind_arr(i) + 2*tmc_params%dim_per_elem: & + ind_arr(i) + 3*tmc_params%dim_per_elem - 1) H_offset = 2 END IF IF (.TRUE.) THEN !TODO find a better switch for the pauling model ! do rotation (NOT pauling model) - tmp_1 = pbc(vec_2O-vec_1O, tmp_cell) - tmp_2 = pbc(vec_3O-vec_2H_f, tmp_cell) + tmp_1 = pbc(vec_2O - vec_1O, tmp_cell) + tmp_2 = pbc(vec_3O - vec_2H_f, tmp_cell) - dihe_angle = donor_acceptor*dihedral_angle(tmp_1, vec_2H_f-vec_2O, tmp_2) - DO ind = ind_arr(i), ind_arr(i)+tmc_params%dim_per_elem*3-1, tmc_params%dim_per_elem + dihe_angle = donor_acceptor*dihedral_angle(tmp_1, vec_2H_f - vec_2O, tmp_2) + DO ind = ind_arr(i), ind_arr(i) + tmc_params%dim_per_elem*3 - 1, tmc_params%dim_per_elem ! set rotation vector !vec_rotated = rotate_vector(vec_2H_m-vec_2O, dihe_angle, vec_2H_f-vec_2O) vec_rotated = rotate_vector(elem%pos(ind: & - ind+tmc_params%dim_per_elem-1)-vec_2O, & - dihe_angle, vec_2H_f-vec_2O) + ind + tmc_params%dim_per_elem - 1) - vec_2O, & + dihe_angle, vec_2H_f - vec_2O) ! set new position !elem%pos(ind_arr(i)+H_offset*dim_per_elem:ind_arr(i)+(H_offset+1)*dim_per_elem-1) = vec_2O+vec_rotated - elem%pos(ind:ind+tmc_params%dim_per_elem-1) = vec_2O+vec_rotated + elem%pos(ind:ind + tmc_params%dim_per_elem - 1) = vec_2O + vec_rotated END DO ELSE ! using the pauling model @@ -1073,31 +1073,31 @@ SUBROUTINE rotate_molecules_in_chain(tmc_params, elem, mol_arr_in, & tmc_params%dim_per_elem*3 IF (ind .EQ. ind_arr(i)) CYCLE search_O_loop tmp = nearest_distance(x1=vec_2H_f, & - x2=elem%pos(ind:ind+tmc_params%dim_per_elem-1), & + x2=elem%pos(ind:ind + tmc_params%dim_per_elem - 1), & cell=tmc_params%cell, box_scale=elem%box_scale) IF (dist_near .GT. tmp) THEN dist_near = tmp - vec_4O = elem%pos(ind:ind+tmc_params%dim_per_elem-1) + vec_4O = elem%pos(ind:ind + tmc_params%dim_per_elem - 1) END IF END DO search_O_loop - rot_axis = pbc(-vec_2O(:)+vec_4O(:), tmp_cell) - tmp_1 = pbc(vec_2O-vec_1O, tmp_cell) - tmp_2 = pbc(vec_3O-vec_4O, tmp_cell) + rot_axis = pbc(-vec_2O(:) + vec_4O(:), tmp_cell) + tmp_1 = pbc(vec_2O - vec_1O, tmp_cell) + tmp_2 = pbc(vec_3O - vec_4O, tmp_cell) dihe_angle = donor_acceptor*dihedral_angle(tmp_1, rot_axis, tmp_2) - vec_rotated = rotate_vector(vec_2H_m-vec_2O, dihe_angle, rot_axis) + vec_rotated = rotate_vector(vec_2H_m - vec_2O, dihe_angle, rot_axis) ! set new position - elem%pos(ind_arr(i)+H_offset*tmc_params%dim_per_elem: & - ind_arr(i)+(H_offset+1)*tmc_params%dim_per_elem-1) & - = vec_2O+vec_rotated - vec_rotated = rotate_vector(vec_2H_f-vec_2O, dihe_angle, rot_axis) + elem%pos(ind_arr(i) + H_offset*tmc_params%dim_per_elem: & + ind_arr(i) + (H_offset + 1)*tmc_params%dim_per_elem - 1) & + = vec_2O + vec_rotated + vec_rotated = rotate_vector(vec_2H_f - vec_2O, dihe_angle, rot_axis) IF (H_offset .EQ. 1) THEN H_offset = 2 ELSE H_offset = 1 END IF - elem%pos(ind_arr(i)+H_offset*tmc_params%dim_per_elem: & - ind_arr(i)+(H_offset+1)*tmc_params%dim_per_elem-1) & - = vec_2O+vec_rotated + elem%pos(ind_arr(i) + H_offset*tmc_params%dim_per_elem: & + ind_arr(i) + (H_offset + 1)*tmc_params%dim_per_elem - 1) & + = vec_2O + vec_rotated END IF END DO DEALLOCATE (tmp_cell) @@ -1164,15 +1164,15 @@ SUBROUTINE change_volume(conf, T_ind, move_types, rng_stream, tmc_params, & CALL get_scaled_cell(cell=tmc_params%cell, box_scale=conf%box_scale, & abc=box_length_new, vol=vol) rnd = next_random_number(rng_stream) - vol = vol+(rnd-0.5_dp)*2.0_dp*move_types%mv_size(mv_type_volume_move, T_ind) + vol = vol + (rnd - 0.5_dp)*2.0_dp*move_types%mv_size(mv_type_volume_move, T_ind) box_length_new(:) = vol**(1/REAL(3, KIND=dp)) ELSE CALL get_scaled_cell(cell=tmc_params%cell, box_scale=conf%box_scale, & abc=box_length_new, vol=vol) rnd = next_random_number(rng_stream) - vol = vol+(rnd-0.5_dp)*2.0_dp*move_types%mv_size(mv_type_volume_move, T_ind) + vol = vol + (rnd - 0.5_dp)*2.0_dp*move_types%mv_size(mv_type_volume_move, T_ind) rnd = next_random_number(rng_stream) - dir = 1+INT(rnd*3) + dir = 1 + INT(rnd*3) box_length_new(dir) = 1.0_dp box_length_new(dir) = vol/PRODUCT(box_length_new(:)) END IF @@ -1182,16 +1182,16 @@ SUBROUTINE change_volume(conf, T_ind, move_types, rng_stream, tmc_params, & ! l_n = l_o +- rnd * mv_size IF (tmc_params%v_isotropic) THEN rnd = next_random_number(rng_stream) - box_length_new(:) = box_length_new(:)+ & - (rnd-0.5_dp)*2.0_dp* & + box_length_new(:) = box_length_new(:) + & + (rnd - 0.5_dp)*2.0_dp* & move_types%mv_size(mv_type_volume_move, T_ind) ELSE ! select a random direction rnd = next_random_number(rng_stream) - dir = 1+INT(rnd*3) + dir = 1 + INT(rnd*3) rnd = next_random_number(rng_stream) - box_length_new(dir) = box_length_new(dir)+ & - (rnd-0.5_dp)*2.0_dp* & + box_length_new(dir) = box_length_new(dir) + & + (rnd - 0.5_dp)*2.0_dp* & move_types%mv_size(mv_type_volume_move, T_ind) END IF END IF @@ -1209,8 +1209,8 @@ SUBROUTINE change_volume(conf, T_ind, move_types, rng_stream, tmc_params, & IF (mv_cen_of_mass .EQV. .FALSE.) THEN ! homogene scaling of atomic coordinates DO atom = 1, SIZE(conf%pos), tmc_params%dim_per_elem - conf%pos(atom:atom+tmc_params%dim_per_elem-1) = & - conf%pos(atom:atom+tmc_params%dim_per_elem-1)*scaling(:) + conf%pos(atom:atom + tmc_params%dim_per_elem - 1) = & + conf%pos(atom:atom + tmc_params%dim_per_elem - 1)*scaling(:) END DO ELSE DO mol = 1, MAXVAL(conf%mol(:)) @@ -1221,16 +1221,16 @@ SUBROUTINE change_volume(conf, T_ind, move_types, rng_stream, tmc_params, & CALL get_mol_indeces(tmc_params=tmc_params, mol_arr=conf%mol, mol=mol, & start_ind=ind, end_ind=ind_e) CALL center_of_mass( & - pos=conf%pos(ind:ind_e+tmc_params%dim_per_elem-1), & - atoms=tmc_params%atoms(INT(ind/REAL(tmc_params%dim_per_elem, KIND=dp))+1: & - INT(ind_e/REAL(tmc_params%dim_per_elem, KIND=dp))+1), & + pos=conf%pos(ind:ind_e + tmc_params%dim_per_elem - 1), & + atoms=tmc_params%atoms(INT(ind/REAL(tmc_params%dim_per_elem, KIND=dp)) + 1: & + INT(ind_e/REAL(tmc_params%dim_per_elem, KIND=dp)) + 1), & center=disp) ! calculate the center of mass DISPLACEMENT - disp(:) = disp(:)*(scaling(:)-1.0_dp) + disp(:) = disp(:)*(scaling(:) - 1.0_dp) ! displace all atoms of the molecule - DO atom = ind, ind_e+tmc_params%dim_per_elem-1, tmc_params%dim_per_elem - conf%pos(atom:atom+tmc_params%dim_per_elem-1) = & - conf%pos(atom:atom+tmc_params%dim_per_elem-1)+disp(:) + DO atom = ind, ind_e + tmc_params%dim_per_elem - 1, tmc_params%dim_per_elem + conf%pos(atom:atom + tmc_params%dim_per_elem - 1) = & + conf%pos(atom:atom + tmc_params%dim_per_elem - 1) + disp(:) END DO END DO END IF @@ -1273,10 +1273,10 @@ SUBROUTINE swap_atoms(conf, move_types, rng_stream, tmc_params) atom_search_loop: DO ! select one atom randomly a_1 = INT(SIZE(conf%pos)/REAL(tmc_params%dim_per_elem, KIND=dp)* & - next_random_number(rng_stream))+1 + next_random_number(rng_stream)) + 1 ! select the second atom randomly a_2 = INT(SIZE(conf%pos)/REAL(tmc_params%dim_per_elem, KIND=dp)* & - next_random_number(rng_stream))+1 + next_random_number(rng_stream)) + 1 ! check if they have different kinds IF (tmc_params%atoms(a_1)%name .NE. tmc_params%atoms(a_2)%name) THEN ! if present, check if atoms have different type related to the specified table @@ -1299,12 +1299,12 @@ SUBROUTINE swap_atoms(conf, move_types, rng_stream, tmc_params) IF (found) THEN ! perform coordinate exchange ALLOCATE (pos_tmp(tmc_params%dim_per_elem)) - ind_1 = (a_1-1)*tmc_params%dim_per_elem+1 - pos_tmp(:) = conf%pos(ind_1:ind_1+tmc_params%dim_per_elem-1) - ind_2 = (a_2-1)*tmc_params%dim_per_elem+1 - conf%pos(ind_1:ind_1+tmc_params%dim_per_elem-1) = & - conf%pos(ind_2:ind_2+tmc_params%dim_per_elem-1) - conf%pos(ind_2:ind_2+tmc_params%dim_per_elem-1) = pos_tmp(:) + ind_1 = (a_1 - 1)*tmc_params%dim_per_elem + 1 + pos_tmp(:) = conf%pos(ind_1:ind_1 + tmc_params%dim_per_elem - 1) + ind_2 = (a_2 - 1)*tmc_params%dim_per_elem + 1 + conf%pos(ind_1:ind_1 + tmc_params%dim_per_elem - 1) = & + conf%pos(ind_2:ind_2 + tmc_params%dim_per_elem - 1) + conf%pos(ind_2:ind_2 + tmc_params%dim_per_elem - 1) = pos_tmp(:) DEALLOCATE (pos_tmp) END IF END SUBROUTINE swap_atoms diff --git a/src/tmc/tmc_setup.F b/src/tmc/tmc_setup.F index c8e5dbeb02..bfab4e468d 100644 --- a/src/tmc/tmc_setup.F +++ b/src/tmc/tmc_setup.F @@ -432,7 +432,7 @@ SUBROUTINE do_analyze_files(input_declaration, root_section, para_env) CALL deallocate_sub_tree_node(tree_elem=ana_list(temp)%temp%last_elem) IF (ASSOCIATED(ana_list(temp)%temp%last_elem)) & ana_list(temp)%temp%conf_offset = ana_list(temp)%temp%conf_offset & - +ana_list(temp)%temp%last_elem%nr + + ana_list(temp)%temp%last_elem%nr END DO CALL finalize_tmc_analysis(ana_env=ana_list(temp)%temp) ! write analysis restart file @@ -519,7 +519,7 @@ SUBROUTINE tmc_read_ana_files_input(input_declaration, input, ana_list, elem, tm ALLOCATE (Temps(nr_temp)) Temps(1) = tmin DO t_act = 2, SIZE(Temps) - Temps(t_act) = Temps(t_act-1)+(tmax-tmin)/(SIZE(Temps)-1.0_dp) + Temps(t_act) = Temps(t_act - 1) + (tmax - tmin)/(SIZE(Temps) - 1.0_dp) END DO IF (ANY(Temps .LT. 0.0_dp)) & CALL cp_abort(__LOCATION__, "The temperatures are negative. Should be specified using "// & @@ -651,7 +651,7 @@ SUBROUTINE tmc_preread_input(input, tmc_env) ALLOCATE (tmc_env%params%Temp(tmc_env%params%nr_temp)) tmc_env%params%Temp(1) = tmin DO itmp = 2, SIZE(tmc_env%params%Temp) - tmc_env%params%Temp(itmp) = tmc_env%params%Temp(itmp-1)+(tmax-tmin)/(SIZE(tmc_env%params%Temp)-1.0_dp) + tmc_env%params%Temp(itmp) = tmc_env%params%Temp(itmp - 1) + (tmax - tmin)/(SIZE(tmc_env%params%Temp) - 1.0_dp) END DO IF (ANY(tmc_env%params%Temp .LT. 0.0_dp)) & CALL cp_abort(__LOCATION__, "The temperatures are negative. Should be specified using "// & @@ -661,8 +661,8 @@ SUBROUTINE tmc_preread_input(input, tmc_env) CALL section_vals_val_get(tmc_section, "TASK_TYPE", explicit=explicit_key) IF (explicit_key) THEN CALL section_vals_val_get(tmc_section, "TASK_TYPE", c_val=c_tmp) - SELECT CASE (TRIM (c_tmp)) - CASE (TRIM (tmc_default_unspecified_name)) + SELECT CASE (TRIM(c_tmp)) + CASE (TRIM(tmc_default_unspecified_name)) tmc_env%params%task_type = task_type_MC CASE ("IDEAL_GAS") tmc_env%params%task_type = task_type_ideal_gas @@ -828,7 +828,7 @@ SUBROUTINE tmc_redistributing_cores(tmc_comp_set, para_env, ana_on_the_fly, & ! colors and positions for new communicators ! variables for printing tmc_comp_set%group_nr = -1 - my_mpi_undefined = para_env%num_pe+10000 !HUGE(my_mpi_undefined)! mp_undefined + my_mpi_undefined = para_env%num_pe + 10000 !HUGE(my_mpi_undefined)! mp_undefined master_worker_group = my_mpi_undefined master_worker_rank = -1 cc_group = my_mpi_undefined @@ -847,10 +847,10 @@ SUBROUTINE tmc_redistributing_cores(tmc_comp_set, para_env, ana_on_the_fly, & success = .FALSE. ELSE ! check if there are enougth cores available - IF (tmc_comp_set%group_ener_size*tmc_comp_set%group_ener_nr .GT. (para_env%num_pe-1)) & + IF (tmc_comp_set%group_ener_size*tmc_comp_set%group_ener_nr .GT. (para_env%num_pe - 1)) & CPWARN("The selected energy group size is too huge. ") IF (flag) THEN - tmc_comp_set%group_ener_nr = INT((para_env%num_pe-1)/ & + tmc_comp_set%group_ener_nr = INT((para_env%num_pe - 1)/ & REAL(tmc_comp_set%group_ener_size, KIND=dp)) IF (tmc_comp_set%group_ener_nr .LT. 1) & CPWARN("The selected energy group size is too huge. ") @@ -860,8 +860,8 @@ SUBROUTINE tmc_redistributing_cores(tmc_comp_set, para_env, ana_on_the_fly, & ! set the amount of configurational change worker groups tmc_comp_set%group_cc_nr = 0 IF (tmc_comp_set%group_cc_size .GT. 0) THEN - tmc_comp_set%group_cc_nr = INT((para_env%num_pe-1-tmc_comp_set%ana_on_the_fly & - -tmc_comp_set%group_ener_size*tmc_comp_set%group_ener_nr)/ & + tmc_comp_set%group_cc_nr = INT((para_env%num_pe - 1 - tmc_comp_set%ana_on_the_fly & + - tmc_comp_set%group_ener_size*tmc_comp_set%group_ener_nr)/ & REAL(tmc_comp_set%group_cc_size, KIND=dp)) IF (tmc_comp_set%group_cc_nr .LT. 1) & @@ -870,51 +870,51 @@ SUBROUTINE tmc_redistributing_cores(tmc_comp_set, para_env, ana_on_the_fly, & IF (flag) success = .FALSE. END IF - total_used = tmc_comp_set%group_ener_size*tmc_comp_set%group_ener_nr+ & - tmc_comp_set%group_cc_size*tmc_comp_set%group_cc_nr+ & + total_used = tmc_comp_set%group_ener_size*tmc_comp_set%group_ener_nr + & + tmc_comp_set%group_cc_size*tmc_comp_set%group_cc_nr + & tmc_comp_set%ana_on_the_fly - IF (para_env%num_pe-1 .GT. total_used) & + IF (para_env%num_pe - 1 .GT. total_used) & CPWARN(" mpi ranks are unused, but can be used for analysis.") ! duplicate communicator CALL mp_comm_dup(para_env%group, my_mpi_world) ! determine the master node - IF (para_env%mepos == para_env%num_pe-1) THEN + IF (para_env%mepos == para_env%num_pe - 1) THEN master = .TRUE. - master_worker_group = para_env%num_pe+3 ! belong to master_worker_comm + master_worker_group = para_env%num_pe + 3 ! belong to master_worker_comm master_worker_rank = 0 ! rank in m_w_comm - master_first_e_worker_g = para_env%num_pe+3 ! belong to master_first_energy_worker_comm + master_first_e_worker_g = para_env%num_pe + 3 ! belong to master_first_energy_worker_comm master_first_e_worker_r = 0 tmc_comp_set%group_nr = 0 !para_env%num_pe +3 - master_ana_group = para_env%num_pe+4 + master_ana_group = para_env%num_pe + 4 master_ana_rank = 0 ELSE ! energy calculation groups IF (para_env%mepos .LT. tmc_comp_set%group_ener_size*tmc_comp_set%group_ener_nr) THEN - tmc_comp_set%group_nr = INT(para_env%mepos/tmc_comp_set%group_ener_size)+1 ! assign to groups + tmc_comp_set%group_nr = INT(para_env%mepos/tmc_comp_set%group_ener_size) + 1 ! assign to groups ! master of worker group IF (MODULO(para_env%mepos, tmc_comp_set%group_ener_size) .EQ. 0) THEN ! tmc_comp_set%group_nr masters - master_worker_group = para_env%num_pe+3 ! belong to master_worker_comm + master_worker_group = para_env%num_pe + 3 ! belong to master_worker_comm master_worker_rank = tmc_comp_set%group_nr ! rank in m_w_comm IF (master_worker_rank .EQ. 1) THEN - master_first_e_worker_g = para_env%num_pe+3 ! belong to master_first_energy_worker_comm + master_first_e_worker_g = para_env%num_pe + 3 ! belong to master_first_energy_worker_comm master_first_e_worker_r = 1 END IF END IF cc_group = tmc_comp_set%group_nr - cc_group_rank = para_env%mepos- & - (tmc_comp_set%group_nr-1)*tmc_comp_set%group_ener_size ! rank in worker group + cc_group_rank = para_env%mepos - & + (tmc_comp_set%group_nr - 1)*tmc_comp_set%group_ener_size ! rank in worker group ! configurational change groups - ELSE IF (para_env%mepos .LT. (tmc_comp_set%group_ener_size*tmc_comp_set%group_ener_nr+ & + ELSE IF (para_env%mepos .LT. (tmc_comp_set%group_ener_size*tmc_comp_set%group_ener_nr + & tmc_comp_set%group_cc_size*tmc_comp_set%group_cc_nr)) THEN - cc_group_rank = para_env%mepos-tmc_comp_set%group_ener_size*tmc_comp_set%group_ener_nr ! temporary - tmc_comp_set%group_nr = tmc_comp_set%group_ener_nr+1+INT(cc_group_rank/tmc_comp_set%group_cc_size) + cc_group_rank = para_env%mepos - tmc_comp_set%group_ener_size*tmc_comp_set%group_ener_nr ! temporary + tmc_comp_set%group_nr = tmc_comp_set%group_ener_nr + 1 + INT(cc_group_rank/tmc_comp_set%group_cc_size) cc_group = tmc_comp_set%group_nr ! master of worker group IF (MODULO(cc_group_rank, tmc_comp_set%group_cc_size) .EQ. 0) THEN ! tmc_comp_set%group_nr masters - master_worker_group = para_env%num_pe+3 ! belong to master_worker_comm + master_worker_group = para_env%num_pe + 3 ! belong to master_worker_comm master_worker_rank = tmc_comp_set%group_nr ! rank in m_w_comm END IF !cc_group_rank = cc_group_rank-(tmc_comp_set%group_nr-1)*tmc_comp_set%group_cc_size ! rank in worker group @@ -922,11 +922,11 @@ SUBROUTINE tmc_redistributing_cores(tmc_comp_set, para_env, ana_on_the_fly, & ELSE ! not used cores ! up to now we use just one core for doing the analysis - IF (para_env%mepos .EQ. para_env%num_pe-2) THEN - tmc_comp_set%group_nr = para_env%mepos-(para_env%num_pe-1) ! negative + IF (para_env%mepos .EQ. para_env%num_pe - 2) THEN + tmc_comp_set%group_nr = para_env%mepos - (para_env%num_pe - 1) ! negative CPASSERT(tmc_comp_set%group_nr .LT. 0) - IF (para_env%mepos .GE. para_env%num_pe-1-ana_on_the_fly) THEN - master_ana_group = para_env%num_pe+4 + IF (para_env%mepos .GE. para_env%num_pe - 1 - ana_on_the_fly) THEN + master_ana_group = para_env%num_pe + 4 master_ana_rank = -tmc_comp_set%group_nr END IF END IF @@ -1031,7 +1031,7 @@ SUBROUTINE tmc_print_params(tmc_env) WRITE (UNIT=file_nr, FMT="(T2,A,T35,A,T80,A)") "-", "distribution of cores", "-" WRITE (file_nr, FMT=fmt_my) plabel, "number of all working groups ", & - cp_to_string(tmc_env%tmc_comp_set%para_env_m_w%num_pe-1) + cp_to_string(tmc_env%tmc_comp_set%para_env_m_w%num_pe - 1) WRITE (file_nr, FMT=fmt_my) plabel, "number of groups (ener|cc)", & cp_to_string(tmc_env%tmc_comp_set%group_ener_nr)//" | "// & cp_to_string(tmc_env%tmc_comp_set%group_cc_nr) @@ -1040,7 +1040,7 @@ SUBROUTINE tmc_print_params(tmc_env) cp_to_string(tmc_env%tmc_comp_set%group_cc_size) IF (ASSOCIATED(tmc_env%tmc_comp_set%para_env_m_ana)) & WRITE (file_nr, FMT=fmt_my) plabel, "Analysis groups ", & - cp_to_string(tmc_env%tmc_comp_set%para_env_m_ana%num_pe-1) + cp_to_string(tmc_env%tmc_comp_set%para_env_m_ana%num_pe - 1) IF (SIZE(tmc_env%params%Temp(:)) .LE. 7) THEN WRITE (fmt_tmp, *) '(T2,A,"| ",A,T25,A56)' c_tmp = "" diff --git a/src/tmc/tmc_tree_acceptance.F b/src/tmc/tmc_tree_acceptance.F index 28c8fabea7..6843f23647 100644 --- a/src/tmc/tmc_tree_acceptance.F +++ b/src/tmc/tmc_tree_acceptance.F @@ -119,11 +119,11 @@ SUBROUTINE acceptance_check(tree_element, parent_element, tmc_params, & !for different potentials we have to regard the differences in energy ! min(1,e^{-\beta*[(E_{exact}(n)-E_{approx}(n))-(E_{exact}(o)-E_{approx}(o))]}) elem_ener = 1.0_dp/(kB*temperature)*tree_element%potential & - -1.0_dp/(kB*tmc_params%Temp(tree_element%temp_created)) & + - 1.0_dp/(kB*tmc_params%Temp(tree_element%temp_created)) & *tree_element%e_pot_approx END IF parent_ener = 1.0_dp/(kB*temperature)*parent_element%potential & - -1.0_dp/(kB*tmc_params%Temp(tree_element%temp_created)) & + - 1.0_dp/(kB*tmc_params%Temp(tree_element%temp_created)) & *parent_element%e_pot_approx !-- always accepted if new energy is smaller than old energy @@ -132,7 +132,7 @@ SUBROUTINE acceptance_check(tree_element, parent_element, tmc_params, & ELSE !-- gaussian distributed acceptance if new energy is greater than old energy IF (rnd_nr .LT. & - EXP(-(elem_ener-parent_ener))) THEN + EXP(-(elem_ener - parent_ener))) THEN accept = .TRUE. ELSE accept = .FALSE. @@ -149,14 +149,14 @@ SUBROUTINE acceptance_check(tree_element, parent_element, tmc_params, & ! comparing aproximated energies IF (PRESENT(approx_ener)) THEN elem_ener = tree_element%e_pot_approx & - +tree_element%ekin + + tree_element%ekin parent_ener = parent_element%e_pot_approx & - +ekin_last_acc + + ekin_last_acc ELSE elem_ener = tree_element%potential & - +tree_element%ekin + + tree_element%ekin parent_ener = parent_element%potential & - +ekin_last_acc + + ekin_last_acc END IF !-- always accepted if new energy is smaller than old energy @@ -165,7 +165,7 @@ SUBROUTINE acceptance_check(tree_element, parent_element, tmc_params, & ELSE !-- gaussian distributed acceptance if new energy is greater than old energy IF (rnd_nr .LT. & - EXP(-1.0_dp/(kB*temperature)*(elem_ener-parent_ener))) THEN + EXP(-1.0_dp/(kB*temperature)*(elem_ener - parent_ener))) THEN accept = .TRUE. ELSE accept = .FALSE. @@ -176,11 +176,11 @@ SUBROUTINE acceptance_check(tree_element, parent_element, tmc_params, & ! update the estimated energy acceptance probability distribution IF (diff_pot_check) THEN CPASSERT(ASSOCIATED(tmc_params%prior_NMC_acc)) - tmc_params%prior_NMC_acc%counter = tmc_params%prior_NMC_acc%counter+1 - tmc_params%prior_NMC_acc%aver = (tmc_params%prior_NMC_acc%aver*(tmc_params%prior_NMC_acc%counter-1)+ & - ((elem_ener-parent_ener)))/REAL(tmc_params%prior_NMC_acc%counter, KIND=dp) - tmc_params%prior_NMC_acc%aver_2 = (tmc_params%prior_NMC_acc%aver_2*(tmc_params%prior_NMC_acc%counter-1)+ & - (elem_ener-parent_ener)**2)/REAL(tmc_params%prior_NMC_acc%counter, KIND=dp) + tmc_params%prior_NMC_acc%counter = tmc_params%prior_NMC_acc%counter + 1 + tmc_params%prior_NMC_acc%aver = (tmc_params%prior_NMC_acc%aver*(tmc_params%prior_NMC_acc%counter - 1) + & + ((elem_ener - parent_ener)))/REAL(tmc_params%prior_NMC_acc%counter, KIND=dp) + tmc_params%prior_NMC_acc%aver_2 = (tmc_params%prior_NMC_acc%aver_2*(tmc_params%prior_NMC_acc%counter - 1) + & + (elem_ener - parent_ener)**2)/REAL(tmc_params%prior_NMC_acc%counter, KIND=dp) END IF ! end the timing @@ -228,14 +228,14 @@ SUBROUTINE swap_acceptance_check(tree_elem, conf1, conf2, tmc_params, accept) IF (tmc_params%pressure .GT. 0.0_dp) THEN ! pt-NVT elem1_ener = conf1%potential & - +conf1%ekin + + conf1%ekin elem2_ener = conf2%potential & - +conf2%ekin + + conf2%ekin ! the swap is done with prob: exp((\beta_i-\beta_j)(U_i-U_j)), ! BUT because they are already swaped we exchange the energies. - IF (tree_elem%rnd_nr .LT. EXP((1.0_dp/(kB*tmc_params%Temp(tree_elem%mv_conf))- & - 1.0_dp/(kB*tmc_params%Temp(tree_elem%mv_conf+1))) & - *(elem2_ener-elem1_ener))) THEN + IF (tree_elem%rnd_nr .LT. EXP((1.0_dp/(kB*tmc_params%Temp(tree_elem%mv_conf)) - & + 1.0_dp/(kB*tmc_params%Temp(tree_elem%mv_conf + 1))) & + *(elem2_ener - elem1_ener))) THEN accept = .TRUE. ELSE accept = .FALSE. @@ -248,11 +248,11 @@ SUBROUTINE swap_acceptance_check(tree_elem, conf1, conf2, tmc_params, accept) vol=vol2) ! delta= (beta_m-beta_n)(U_n-U_m) + (beta_m*P_m-beta_n*P_n)(V_n-V_m) delta = (1.0_dp/(kB*tmc_params%Temp(tree_elem%mv_conf)) & - -1.0_dp/(kB*tmc_params%Temp(tree_elem%mv_conf+1)))* & - ((conf2%potential+conf2%ekin)-(conf1%potential+conf1%ekin))+ & + - 1.0_dp/(kB*tmc_params%Temp(tree_elem%mv_conf + 1)))* & + ((conf2%potential + conf2%ekin) - (conf1%potential + conf1%ekin)) + & (1.0_dp/(kB*tmc_params%Temp(tree_elem%mv_conf))*tmc_params%pressure & - -1.0_dp/(kB*tmc_params%Temp(tree_elem%mv_conf+1))*tmc_params%pressure)* & - (vol2-vol1) + - 1.0_dp/(kB*tmc_params%Temp(tree_elem%mv_conf + 1))*tmc_params%pressure)* & + (vol2 - vol1) IF (tree_elem%rnd_nr .LT. EXP(delta)) THEN accept = .TRUE. ELSE @@ -309,21 +309,21 @@ SUBROUTINE volume_acceptance_check(parent_elem, new_elem, temperature, & ! delta_H = delta_U + P*delta_V - kB*T*N*ln(V_n/V_p) IF (.FALSE.) THEN ! the volume move in volume space (dV) - d_enthalpy = (new_elem%potential-parent_elem%potential)+ & - tmc_params%pressure*(n_vol-p_vol)- & + d_enthalpy = (new_elem%potential - parent_elem%potential) + & + tmc_params%pressure*(n_vol - p_vol) - & kB*temperature*(SIZE(new_elem%pos)/ & tmc_params%dim_per_elem)* & LOG(n_vol/p_vol) ELSE IF (tmc_params%v_isotropic) THEN - d_enthalpy = (new_elem%potential-parent_elem%potential)+ & - tmc_params%pressure*(n_vol-p_vol)- & + d_enthalpy = (new_elem%potential - parent_elem%potential) + & + tmc_params%pressure*(n_vol - p_vol) - & kB*temperature*((SIZE(new_elem%pos)/ & - tmc_params%dim_per_elem)+2/REAL(3, KIND=dp))* & + tmc_params%dim_per_elem) + 2/REAL(3, KIND=dp))* & LOG(n_vol/p_vol) ELSE - d_enthalpy = (new_elem%potential-parent_elem%potential)+ & - tmc_params%pressure*(n_vol-p_vol)- & + d_enthalpy = (new_elem%potential - parent_elem%potential) + & + tmc_params%pressure*(n_vol - p_vol) - & kB*temperature*(SIZE(new_elem%pos)/ & tmc_params%dim_per_elem)* & LOG(n_vol/p_vol) @@ -755,14 +755,14 @@ SUBROUTINE tree_update(tmc_env, result_acc, something_updated) !-- set result counters ! counter for certain temperature tmc_env%m_env%result_count(gt_act_elem%mv_conf) = & - tmc_env%m_env%result_count(gt_act_elem%mv_conf)+1 + tmc_env%m_env%result_count(gt_act_elem%mv_conf) + 1 ! in case of swapped also count the result for ! the other swapped temperature IF (gt_act_elem%swaped) & - tmc_env%m_env%result_count(gt_act_elem%mv_conf+1) = & - tmc_env%m_env%result_count(gt_act_elem%mv_conf+1)+1 + tmc_env%m_env%result_count(gt_act_elem%mv_conf + 1) = & + tmc_env%m_env%result_count(gt_act_elem%mv_conf + 1) + 1 ! count also for global tree Markov Chain - tmc_env%m_env%result_count(0) = tmc_env%m_env%result_count(0)+1 + tmc_env%m_env%result_count(0) = tmc_env%m_env%result_count(0) + 1 ! flag for doing tree cleaning with canceling and deallocation something_updated = .TRUE. @@ -779,11 +779,11 @@ SUBROUTINE tree_update(tmc_env, result_acc, something_updated) IF (gt_act_elem%prob_acc .GT. 0.0_dp) THEN IF (gt_act_elem%prob_acc .GE. 0.5_dp) THEN ! wrong estimate (estimated accepted) - tmc_env%m_env%estim_corr_wrong(4) = tmc_env%m_env%estim_corr_wrong(4)+1 + tmc_env%m_env%estim_corr_wrong(4) = tmc_env%m_env%estim_corr_wrong(4) + 1 IF (DEBUG .GT. 0) WRITE (tmc_env%m_env%io_unit, *) & "Wrong guess for NACC (elem/estim acc prob)", gt_act_elem%nr, gt_act_elem%prob_acc ELSE - tmc_env%m_env%estim_corr_wrong(3) = tmc_env%m_env%estim_corr_wrong(3)+1 + tmc_env%m_env%estim_corr_wrong(3) = tmc_env%m_env%estim_corr_wrong(3) + 1 END IF END IF gt_act_elem%stat = status_rejected_result @@ -795,11 +795,11 @@ SUBROUTINE tree_update(tmc_env, result_acc, something_updated) IF (gt_act_elem%prob_acc .GT. 0.0_dp) THEN IF (gt_act_elem%prob_acc .LE. 0.5_dp) THEN ! wrong estimate (estimated NOT accepted) - tmc_env%m_env%estim_corr_wrong(2) = tmc_env%m_env%estim_corr_wrong(2)+1 + tmc_env%m_env%estim_corr_wrong(2) = tmc_env%m_env%estim_corr_wrong(2) + 1 IF (DEBUG .GT. 0) WRITE (tmc_env%m_env%io_unit, *) & "wrong guess for ACC (elem/estim acc prob)", gt_act_elem%nr, gt_act_elem%prob_acc ELSE - tmc_env%m_env%estim_corr_wrong(1) = tmc_env%m_env%estim_corr_wrong(1)+1 + tmc_env%m_env%estim_corr_wrong(1) = tmc_env%m_env%estim_corr_wrong(1) + 1 END IF END IF gt_act_elem%stat = status_accepted_result @@ -814,7 +814,7 @@ SUBROUTINE tree_update(tmc_env, result_acc, something_updated) ! ATTENTION: act_element != gt_act_elem%conf(gt_act_elem%mv_conf), ! because we take the last accepted conf tmc_env%m_env%result_list(gt_act_elem%mv_conf)%elem => act_element - tmc_env%m_env%result_list(gt_act_elem%mv_conf+1)%elem => tmp_element + tmc_env%m_env%result_list(gt_act_elem%mv_conf + 1)%elem => tmp_element END IF tmc_env%m_env%gt_act => gt_act_elem END IF ! result acceptance check @@ -842,7 +842,7 @@ SUBROUTINE tree_update(tmc_env, result_acc, something_updated) IF (gt_act_elem%swaped) & CALL write_result_list_element(result_list=tmc_env%m_env%result_list, & result_count=tmc_env%m_env%result_count, & - conf_updated=gt_act_elem%mv_conf+1, accepted=result_acc, & + conf_updated=gt_act_elem%mv_conf + 1, accepted=result_acc, & tmc_params=tmc_env%params) ! save for analysis @@ -852,10 +852,10 @@ SUBROUTINE tree_update(tmc_env, result_acc, something_updated) temp_ind=gt_act_elem%mv_conf, & nr=tmc_env%m_env%result_count(gt_act_elem%mv_conf)) IF (gt_act_elem%swaped) THEN - CALL add_to_list(elem=tmc_env%m_env%result_list(gt_act_elem%mv_conf+1)%elem, & + CALL add_to_list(elem=tmc_env%m_env%result_list(gt_act_elem%mv_conf + 1)%elem, & list=tmc_env%m_env%analysis_list, & - temp_ind=gt_act_elem%mv_conf+1, & - nr=tmc_env%m_env%result_count(gt_act_elem%mv_conf+1)) + temp_ind=gt_act_elem%mv_conf + 1, & + nr=tmc_env%m_env%result_count(gt_act_elem%mv_conf + 1)) END IF END IF END DO search_calculated_element_loop @@ -1019,8 +1019,8 @@ SUBROUTINE update_prob_gt_node_list(reference_list, act_elem, parent_elem, act_p elem_new=act_elem, & E_classical_diff=0.0_dp, & rnd_nr=tmp_pt_ptr%gt_elem%rnd_nr, & - beta=1.0_dp/(kB*(tmc_env%params%Temp(tmp_pt_ptr%gt_elem%mv_conf)- & - tmc_env%params%Temp(tmp_pt_ptr%gt_elem%mv_conf+1))), & + beta=1.0_dp/(kB*(tmc_env%params%Temp(tmp_pt_ptr%gt_elem%mv_conf) - & + tmc_env%params%Temp(tmp_pt_ptr%gt_elem%mv_conf + 1))), & tmc_params=tmc_env%params) ELSE tmp_pt_ptr => tmp_pt_ptr%next @@ -1031,7 +1031,7 @@ SUBROUTINE update_prob_gt_node_list(reference_list, act_elem, parent_elem, act_p IF (ready_for_update_acc_prob(parent_elem)) THEN tmp_prob = compute_estimated_prob(elem_old=parent_elem, & elem_new=act_elem, & - E_classical_diff=act_elem%e_pot_approx-parent_elem%e_pot_approx, & + E_classical_diff=act_elem%e_pot_approx - parent_elem%e_pot_approx, & rnd_nr=tmp_pt_ptr%gt_elem%rnd_nr, & beta=1.0_dp/(kB*tmc_env%params%Temp(tmp_pt_ptr%gt_elem%mv_conf)), & tmc_params=tmc_env%params) diff --git a/src/tmc/tmc_tree_build.F b/src/tmc/tmc_tree_build.F index d5e9980293..309b6ef697 100644 --- a/src/tmc/tmc_tree_build.F +++ b/src/tmc/tmc_tree_build.F @@ -361,7 +361,7 @@ SUBROUTINE init_tree_mod(start_elem, tmc_env, job_counts, worker_timings) global_tree%nr = 0 global_tree%swaped = .FALSE. global_tree%mv_conf = 1 - global_tree%mv_next_conf = MODULO(global_tree%mv_conf, SIZE(global_tree%conf))+1 + global_tree%mv_next_conf = MODULO(global_tree%mv_conf, SIZE(global_tree%conf)) + 1 global_tree%conf_n_acc = .TRUE. global_tree%stat = status_created @@ -452,7 +452,7 @@ SUBROUTINE finalize_init(gt_tree_ptr, tmc_env) END DO IF (tmc_env%m_env%restart_in_file_name .EQ. "") THEN - tmc_env%m_env%result_count(:) = tmc_env%m_env%result_count(:)+1 + tmc_env%m_env%result_count(:) = tmc_env%m_env%result_count(:) + 1 tmc_env%m_env%result_list(:) = gt_tree_ptr%conf(:) !-- write initial elements in result files DO i = 1, SIZE(tmc_env%m_env%result_list) @@ -551,13 +551,13 @@ SUBROUTINE create_new_gt_tree_node(tmc_env, stat, new_elem, & ! check for existing subtree element CPASSERT(ASSOCIATED(new_elem%conf(new_elem%mv_conf)%elem)) - SELECT CASE (new_elem%conf (new_elem%mv_conf)%elem%stat) + SELECT CASE (new_elem%conf(new_elem%mv_conf)%elem%stat) CASE (status_cancel_nmc, status_cancel_ener, status_canceled_nmc, & status_canceled_ener) ! reactivating subtree element ! (but global tree element already exist) CALL add_to_references(gt_elem=new_elem) - reactivation_cc_count = reactivation_cc_count+1 + reactivation_cc_count = reactivation_cc_count + 1 CASE DEFAULT CALL cp_abort(__LOCATION__, & "global tree node creation using existing sub tree element, "// & @@ -572,7 +572,7 @@ SUBROUTINE create_new_gt_tree_node(tmc_env, stat, new_elem, & ! when standard MC moves with single potential are done ! the Nested Monte Carlo routine needs to do the configuration ! to have old configuration to see if change is accepted - SELECT CASE (new_elem%conf (new_elem%mv_conf)%elem%move_type) + SELECT CASE (new_elem%conf(new_elem%mv_conf)%elem%move_type) CASE (mv_type_MD) new_elem%conf(new_elem%mv_conf)%elem%stat = status_calculate_MD CASE (mv_type_NMC_moves) @@ -599,7 +599,7 @@ SUBROUTINE create_new_gt_tree_node(tmc_env, stat, new_elem, & ! set initial values CALL allocate_new_global_tree_node(next_el=new_elem, & nr_temp=tmc_env%params%nr_temp) - tmc_env%m_env%tree_node_count(0) = tmc_env%m_env%tree_node_count(0)+1 + tmc_env%m_env%tree_node_count(0) = tmc_env%m_env%tree_node_count(0) + 1 new_elem%nr = tmc_env%m_env%tree_node_count(0) !-- set pointers to and from element one level up @@ -658,11 +658,11 @@ SUBROUTINE create_new_gt_tree_node(tmc_env, stat, new_elem, & !new_elem%mv_conf = 1+INT(size(new_elem%conf)*rnd) ! one temperature after each other new_elem%mv_conf = new_elem%parent%mv_next_conf - new_elem%mv_next_conf = MODULO(new_elem%mv_conf, SIZE(new_elem%conf))+1 + new_elem%mv_next_conf = MODULO(new_elem%mv_conf, SIZE(new_elem%conf)) + 1 ! simulated annealing temperature decrease new_elem%Temp = tmp_elem%Temp - IF (n_acc) new_elem%Temp = tmp_elem%Temp*(1-tmc_env%m_env%temp_decrease) + IF (n_acc) new_elem%Temp = tmp_elem%Temp*(1 - tmc_env%m_env%temp_decrease) !-- rnd for swap rnd = next_random_number(tmc_env%rng_stream) @@ -680,14 +680,14 @@ SUBROUTINE create_new_gt_tree_node(tmc_env, stat, new_elem, & ! and the conf to move in next move new_elem%mv_next_conf = new_elem%mv_conf ! do swap with conf swap_conf and swap_conf+1 - swap_conf = 1+INT((tmc_env%params%nr_temp-1)*rnd2) + swap_conf = 1 + INT((tmc_env%params%nr_temp - 1)*rnd2) new_elem%mv_conf = swap_conf !-- swaping pointers to subtree elements ! exchange the pointer to the sub tree elements tree_elem => new_elem%conf(new_elem%mv_conf)%elem new_elem%conf(new_elem%mv_conf)%elem => & - new_elem%conf(new_elem%mv_conf+1)%elem - new_elem%conf(new_elem%mv_conf+1)%elem => tree_elem + new_elem%conf(new_elem%mv_conf + 1)%elem + new_elem%conf(new_elem%mv_conf + 1)%elem => tree_elem new_elem%stat = status_calculated new_elem%swaped = .TRUE. @@ -759,7 +759,7 @@ SUBROUTINE create_new_gt_tree_node(tmc_env, stat, new_elem, & new_elem%stat .EQ. status_rejected_result) & CPABORT("selected existing RESULT gt node") !-- set status of global tree element for decision in master routine - SELECT CASE (new_elem%conf (new_elem%mv_conf)%elem%stat) + SELECT CASE (new_elem%conf(new_elem%mv_conf)%elem%stat) CASE (status_rejected_result, status_rejected, status_accepted, & status_accepted_result, status_calculated) ! energy is already calculated @@ -803,7 +803,7 @@ SUBROUTINE create_new_gt_tree_node(tmc_env, stat, new_elem, & status_calculate_NMC_steps new_elem%stat = status_calculate_NMC_steps stat = new_elem%conf(new_elem%mv_conf)%elem%stat - reactivation_cc_count = reactivation_cc_count+1 + reactivation_cc_count = reactivation_cc_count + 1 IF (tmc_env%params%DRAW_TREE) & CALL create_dot_color(tree_element=new_elem%conf(new_elem%mv_conf)%elem, & tmc_params=tmc_env%params) @@ -862,7 +862,7 @@ SUBROUTINE create_new_subtree_node(act_gt_el, tmc_env) new_elem%parent => parent_elem !-- set initial values - parent_elem%next_elem_nr = parent_elem%next_elem_nr+1 + parent_elem%next_elem_nr = parent_elem%next_elem_nr + 1 new_elem%nr = parent_elem%next_elem_nr new_elem%rng_seed = parent_elem%rng_seed @@ -902,7 +902,7 @@ SUBROUTINE create_new_subtree_node(act_gt_el, tmc_env) ! set the temperature for the NMC moves rnd = next_random_number(tmc_env%rng_stream) IF (tmc_env%params%NMC_inp_file .NE. "") THEN - new_elem%temp_created = INT(tmc_env%params%nr_temp*rnd)+1 + new_elem%temp_created = INT(tmc_env%params%nr_temp*rnd) + 1 ELSE new_elem%temp_created = act_gt_el%mv_conf END IF diff --git a/src/tmc/tmc_tree_references.F b/src/tmc/tmc_tree_references.F index 41fac96fb6..5dcd451fbe 100644 --- a/src/tmc/tmc_tree_references.F +++ b/src/tmc/tmc_tree_references.F @@ -75,12 +75,12 @@ SUBROUTINE add_to_references(gt_elem) ! add reference to swapped elem ALLOCATE (tmp_pt_list_elem) tmp_pt_list_elem%gt_elem => gt_elem - IF (ASSOCIATED(gt_elem%conf(gt_elem%mv_conf+1)%elem%gt_nodes_references)) THEN - tmp_pt_list_elem%next => gt_elem%conf(gt_elem%mv_conf+1)%elem%gt_nodes_references + IF (ASSOCIATED(gt_elem%conf(gt_elem%mv_conf + 1)%elem%gt_nodes_references)) THEN + tmp_pt_list_elem%next => gt_elem%conf(gt_elem%mv_conf + 1)%elem%gt_nodes_references ELSE tmp_pt_list_elem%next => NULL() END IF - gt_elem%conf(gt_elem%mv_conf+1)%elem%gt_nodes_references => tmp_pt_list_elem + gt_elem%conf(gt_elem%mv_conf + 1)%elem%gt_nodes_references => tmp_pt_list_elem END IF ! end the timing CALL timestop(handle) @@ -114,7 +114,7 @@ SUBROUTINE remove_gt_references(gt_ptr, tmc_env) ! in case of parallel tempering also the reference in the second swaped configuration has to be removed IF (gt_ptr%swaped) THEN CALL search_and_remove_reference_in_list(gt_ptr=gt_ptr, & - elem=gt_ptr%conf(gt_ptr%mv_conf+1)%elem, tmc_env=tmc_env) + elem=gt_ptr%conf(gt_ptr%mv_conf + 1)%elem, tmc_env=tmc_env) END IF ! end the timing CALL timestop(handle) @@ -156,8 +156,8 @@ SUBROUTINE remove_subtree_element_of_all_references(ptr) IF (ASSOCIATED(ptr, tmp_gt_list_ptr%gt_elem%conf(tmp_gt_list_ptr%gt_elem%mv_conf)%elem)) THEN tmp_gt_list_ptr%gt_elem%conf(tmp_gt_list_ptr%gt_elem%mv_conf)%elem => NULL() ! in case of swapping the second configuration could be the related one - ELSE IF (ASSOCIATED(ptr, tmp_gt_list_ptr%gt_elem%conf(tmp_gt_list_ptr%gt_elem%mv_conf+1)%elem)) THEN - tmp_gt_list_ptr%gt_elem%conf(tmp_gt_list_ptr%gt_elem%mv_conf+1)%elem => NULL() + ELSE IF (ASSOCIATED(ptr, tmp_gt_list_ptr%gt_elem%conf(tmp_gt_list_ptr%gt_elem%mv_conf + 1)%elem)) THEN + tmp_gt_list_ptr%gt_elem%conf(tmp_gt_list_ptr%gt_elem%mv_conf + 1)%elem => NULL() ELSE list_of_nr = "" DO i = 1, SIZE(tmp_gt_list_ptr%gt_elem%conf) diff --git a/src/tmc/tmc_tree_search.F b/src/tmc/tmc_tree_search.F index 71aad1381d..2e77f9dc0d 100644 --- a/src/tmc/tmc_tree_search.F +++ b/src/tmc/tmc_tree_search.F @@ -162,7 +162,7 @@ RECURSIVE SUBROUTINE most_prob_end(global_tree_elem, prob, n_acc, & END IF !-- do probability multiplication ! (in logscale because of realy small probabilities) - prob_n_acc = prob_n_acc+LOG(global_tree_elem%prob_acc) + prob_n_acc = prob_n_acc + LOG(global_tree_elem%prob_acc) ELSE ! prob of going in acc or rej direction is ! calculated in parent element @@ -188,11 +188,11 @@ RECURSIVE SUBROUTINE most_prob_end(global_tree_elem, prob, n_acc, & END IF !-- do probability multiplication ! (in logscale because of realy small probabilities) - prob_n_nacc = prob_n_nacc+LOG(1-global_tree_elem%prob_acc) + prob_n_nacc = prob_n_nacc + LOG(1 - global_tree_elem%prob_acc) ELSE ! prob of going in acc or rej direction is ! calculated in parent element - prob_n_nacc = LOG(1-global_tree_elem%prob_acc) + prob_n_nacc = LOG(1 - global_tree_elem%prob_acc) IF (PRESENT(search_energy_node)) prob_n_nacc = -100000 ptr_nacc => global_tree_elem tmp_nacc = .FALSE. @@ -256,7 +256,7 @@ SUBROUTINE search_next_energy_calc(gt_head, new_gt_elem, stat, react_count) IF (new_gt_elem%conf(new_gt_elem%mv_conf)%elem%stat .EQ. & status_canceled_ener) THEN CALL add_to_references(gt_elem=new_gt_elem) - react_count = react_count+1 + react_count = react_count + 1 new_gt_elem%conf(new_gt_elem%mv_conf)%elem%stat = status_created END IF ! if elem status is not status_created @@ -388,10 +388,10 @@ SUBROUTINE get_subtree_elements_to_check(gt_act_elem, elem1, elem2) elem1 => search_parent_element(gt_act_elem%conf(gt_act_elem%mv_conf)%elem) END IF ! second element - IF (gt_act_elem%conf_n_acc(gt_act_elem%conf(gt_act_elem%mv_conf+1)%elem%sub_tree_nr)) THEN - elem2 => gt_act_elem%conf(gt_act_elem%mv_conf+1)%elem + IF (gt_act_elem%conf_n_acc(gt_act_elem%conf(gt_act_elem%mv_conf + 1)%elem%sub_tree_nr)) THEN + elem2 => gt_act_elem%conf(gt_act_elem%mv_conf + 1)%elem ELSE - elem2 => search_parent_element(gt_act_elem%conf(gt_act_elem%mv_conf+1)%elem) + elem2 => search_parent_element(gt_act_elem%conf(gt_act_elem%mv_conf + 1)%elem) END IF ELSE elem1 => gt_act_elem%conf(gt_act_elem%mv_conf)%elem @@ -530,7 +530,7 @@ RECURSIVE SUBROUTINE search_canceling_elements(pt_elem_in, prob, tmc_env) IF (PRESENT(prob)) THEN IF (prob .LT. 1.0E-10 .AND. ASSOCIATED(pt_elem_in%acc)) THEN pt_elem => pt_elem_in%acc - ELSE IF (prob .GT. (1.0_dp-1.0E-10) .AND. ASSOCIATED(pt_elem_in%nacc)) THEN + ELSE IF (prob .GT. (1.0_dp - 1.0E-10) .AND. ASSOCIATED(pt_elem_in%nacc)) THEN pt_elem => pt_elem_in%nacc ELSE ready = .FALSE. @@ -541,7 +541,7 @@ RECURSIVE SUBROUTINE search_canceling_elements(pt_elem_in, prob, tmc_env) IF (ready) THEN IF (ASSOCIATED(pt_elem%conf(pt_elem%mv_conf)%elem)) THEN - SELECT CASE (pt_elem%conf (pt_elem%mv_conf)%elem%stat) + SELECT CASE (pt_elem%conf(pt_elem%mv_conf)%elem%stat) CASE (status_accepted_result, status_accepted, status_rejected_result, & status_rejected, status_created, status_cancel_nmc, & status_cancel_ener, status_canceled_nmc, status_canceled_ener, & @@ -643,7 +643,7 @@ RECURSIVE SUBROUTINE count_prepared_nodes_in_subtree(tree_ptr, counter) END IF CASE (status_created, status_calculate_MD, status_calculate_NMC_steps, & status_calc_approx_ener, status_calculated, status_calculate_energy) - IF (tree_ptr%stat .EQ. status_created) counter = counter+1 + IF (tree_ptr%stat .EQ. status_created) counter = counter + 1 IF (ASSOCIATED(tree_ptr%acc)) THEN tmp_ptr => tree_ptr%acc CALL count_prepared_nodes_in_subtree(tmp_ptr, counter) @@ -732,7 +732,7 @@ RECURSIVE SUBROUTINE count_nodes_in_global_tree(ptr, counter) CPASSERT(ASSOCIATED(ptr)) - counter = counter+1 + counter = counter + 1 IF (ASSOCIATED(ptr%acc)) & CALL count_nodes_in_global_tree(ptr%acc, counter) @@ -755,7 +755,7 @@ RECURSIVE SUBROUTINE count_nodes_in_tree(ptr, counter) CPASSERT(ASSOCIATED(ptr)) - counter = counter+1 + counter = counter + 1 IF (ASSOCIATED(ptr%acc)) & CALL count_nodes_in_tree(ptr%acc, counter) diff --git a/src/tmc/tmc_worker.F b/src/tmc/tmc_worker.F index 989883ee10..05cee8608b 100644 --- a/src/tmc/tmc_worker.F +++ b/src/tmc/tmc_worker.F @@ -848,7 +848,7 @@ SUBROUTINE get_atom_kinds_and_cell(env_id, atoms, cell) atoms(iparticle)%name = particles%els(iparticle)%atomic_kind%name atoms(iparticle)%mass = particles%els(iparticle)%atomic_kind%mass END DO - CPASSERT(iparticle-1 .EQ. nr_atoms) + CPASSERT(iparticle - 1 .EQ. nr_atoms) ENDIF END SUBROUTINE get_atom_kinds_and_cell diff --git a/src/topology.F b/src/topology.F index 33c28bfec5..b866ac9c2d 100644 --- a/src/topology.F +++ b/src/topology.F @@ -358,7 +358,7 @@ SUBROUTINE connectivity_control(topology, para_env, qmmm, qmmm_env, subsys_secti DO i = 1, topology%natoms IF (elements(i) == "__DEF__") CYCLE ! If present an underscore let's skip all that over the underscore - id = INDEX(elements(i), "_")-1 + id = INDEX(elements(i), "_") - 1 IF (id == -1) id = LEN_TRIM(elements(i)) ! Many atomic kind have been defined as ELEMENT+LETTER+NUMBER ! the number at the end can vary arbitrarily.. diff --git a/src/topology_amber.F b/src/topology_amber.F index d06f4f4b21..aa56b167a7 100644 --- a/src/topology_amber.F +++ b/src/topology_amber.F @@ -43,22 +43,21 @@ MODULE topology_amber USE util, ONLY: sort #include "./base/base_uses.f90" - IMPLICIT NONE + IMPLICIT NONE CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'topology_amber' - REAL(KIND=dp), PARAMETER, PRIVATE :: amber_conv_factor = 20.4550_dp,& - amber_conv_charge = 18.2223_dp - INTEGER, PARAMETER, PRIVATE :: buffer_size = 1 + REAL(KIND=dp), PARAMETER, PRIVATE :: amber_conv_factor = 20.4550_dp, & + amber_conv_charge = 18.2223_dp + INTEGER, PARAMETER, PRIVATE :: buffer_size = 1 + PRIVATE + PUBLIC :: read_coordinate_crd, read_connectivity_amber, rdparm_amber_8 - PRIVATE - PUBLIC :: read_coordinate_crd, read_connectivity_amber, rdparm_amber_8 - - ! Reading Amber sections routines - INTERFACE rd_amber_section - MODULE PROCEDURE rd_amber_section_i1, rd_amber_section_c1, rd_amber_section_r1,& - rd_amber_section_i3, rd_amber_section_i4, rd_amber_section_i5 - END INTERFACE + ! Reading Amber sections routines + INTERFACE rd_amber_section + MODULE PROCEDURE rd_amber_section_i1, rd_amber_section_c1, rd_amber_section_r1, & + rd_amber_section_i3, rd_amber_section_i4, rd_amber_section_i5 + END INTERFACE CONTAINS @@ -96,7 +95,7 @@ MODULE topology_amber !> \param subsys_section ... !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008 ! ************************************************************************************************** - SUBROUTINE read_coordinate_crd (topology,para_env,subsys_section) + SUBROUTINE read_coordinate_crd(topology, para_env, subsys_section) TYPE(topology_parameters_type) :: topology TYPE(cp_para_env_type), POINTER :: para_env TYPE(section_vals_type), POINTER :: subsys_section @@ -113,163 +112,163 @@ SUBROUTINE read_coordinate_crd (topology,para_env,subsys_section) TYPE(cp_parser_type), POINTER :: parser TYPE(section_vals_type), POINTER :: velocity_section - NULLIFY(parser, logger, velocity) - logger => cp_get_default_logger() - iw = cp_print_key_unit_nr(logger,subsys_section,"PRINT%TOPOLOGY_INFO/CRD_INFO",& - extension=".subsysLog") - CALL timeset(routineN,handle) - - atom_info => topology%atom_info - IF (iw>0) WRITE(iw,*) " Reading in CRD file ",TRIM(topology%coord_file_name) - - ! Title Section - IF(iw>0) WRITE(iw,'(T2,A)') 'CRD_INFO| Parsing the TITLE section' - CALL parser_create(parser,topology%coord_file_name,para_env=para_env) - CALL parser_get_next_line(parser,1) - ! Title may be missing - IF (parser_test_next_token(parser)=="STR") THEN - CALL parser_get_object(parser,string,string_length=default_string_length) - IF(iw>0) WRITE(iw,'(T2,A)') 'CRD_INFO| '//TRIM(string) - ! Natom and Time (which we ignore) - CALL parser_get_next_line(parser,1) - END IF - CALL parser_get_object(parser,natom) - topology%natoms = natom - IF(iw>0) WRITE(iw,'(T2,A,I0)') 'CRD_INFO| Number of atoms: ',natom - CALL reallocate(atom_info%id_molname, 1, natom) - CALL reallocate(atom_info%id_resname, 1, natom) - CALL reallocate(atom_info%resid, 1, natom) - CALL reallocate(atom_info%id_atmname, 1, natom) - CALL reallocate(atom_info%r, 1,3,1,natom) - CALL reallocate(atom_info%atm_mass, 1, natom) - CALL reallocate(atom_info%atm_charge, 1, natom) - CALL reallocate(atom_info%occup, 1, natom) - CALL reallocate(atom_info%beta, 1, natom) - CALL reallocate(atom_info%id_element, 1, natom) - - ! Element is assigned on the basis of the atm_name - topology%aa_element = .TRUE. - - ! Coordinates - CALL parser_get_next_line(parser,1,at_end=my_end) - DO j = 1, natom-MOD(natom,2), 2 - IF (my_end) EXIT - READ(parser%input_line,*)atom_info%r(1,j ),atom_info%r(2,j ),atom_info%r(3,j ),& - atom_info%r(1,j+1),atom_info%r(2,j+1),atom_info%r(3,j+1) - ! All these information will have to be setup elsewhere.. - ! CRD file does not contain anything related.. - atom_info%id_atmname(j ) = str2id(s2s("__UNDEF__")) - atom_info%id_molname(j ) = str2id(s2s("__UNDEF__")) - atom_info%id_resname(j ) = str2id(s2s("__UNDEF__")) - atom_info%id_element(j ) = str2id(s2s("__UNDEF__")) - atom_info%resid (j ) = HUGE(0) - atom_info%atm_mass (j ) = HUGE(0.0_dp) - atom_info%atm_charge (j ) = -HUGE(0.0_dp) - atom_info%r(1,j ) = cp_unit_to_cp2k(atom_info%r(1,j ),"angstrom") - atom_info%r(2,j ) = cp_unit_to_cp2k(atom_info%r(2,j ),"angstrom") - atom_info%r(3,j ) = cp_unit_to_cp2k(atom_info%r(3,j ),"angstrom") - - atom_info%id_atmname(j+1) = str2id(s2s("__UNDEF__")) - atom_info%id_molname(j+1) = str2id(s2s("__UNDEF__")) - atom_info%id_resname(j+1) = str2id(s2s("__UNDEF__")) - atom_info%id_element(j+1) = str2id(s2s("__UNDEF__")) - atom_info%resid (j+1) = HUGE(0) - atom_info%atm_mass (j+1) = HUGE(0.0_dp) - atom_info%atm_charge (j+1) = -HUGE(0.0_dp) - atom_info%r(1,j+1) = cp_unit_to_cp2k(atom_info%r(1,j+1),"angstrom") - atom_info%r(2,j+1) = cp_unit_to_cp2k(atom_info%r(2,j+1),"angstrom") - atom_info%r(3,j+1) = cp_unit_to_cp2k(atom_info%r(3,j+1),"angstrom") - - CALL parser_get_next_line(parser,1,at_end=my_end) - END DO - ! Trigger error - IF ((my_end).AND.(j/=natom-MOD(natom,2)+1)) THEN - IF(j/=natom)& - CPABORT("Error while reading CRD file. Unexpected end of file.") - ELSE IF (MOD(natom,2)/=0) THEN - ! In case let's handle the last atom - j = natom - READ(parser%input_line,*)atom_info%r(1,j ),atom_info%r(2,j ),atom_info%r(3,j ) - ! All these information will have to be setup elsewhere.. - ! CRD file does not contain anything related.. - atom_info%id_atmname(j ) = str2id(s2s("__UNDEF__")) - atom_info%id_molname(j ) = str2id(s2s("__UNDEF__")) - atom_info%id_resname(j ) = str2id(s2s("__UNDEF__")) - atom_info%id_element(j ) = str2id(s2s("__UNDEF__")) - atom_info%resid (j ) = HUGE(0) - atom_info%atm_mass (j ) = HUGE(0.0_dp) - atom_info%atm_charge (j ) = -HUGE(0.0_dp) - atom_info%r(1,j ) = cp_unit_to_cp2k(atom_info%r(1,j ),"angstrom") - atom_info%r(2,j ) = cp_unit_to_cp2k(atom_info%r(2,j ),"angstrom") - atom_info%r(3,j ) = cp_unit_to_cp2k(atom_info%r(3,j ),"angstrom") - - CALL parser_get_next_line(parser,1,at_end=my_end) - END IF - - IF (my_end) THEN - IF(j/=natom)& - CPWARN("No VELOCITY or BOX information found in CRD file. ") - ELSE - ! Velocities - CALL reallocate(velocity,1,3,1,natom) - DO j = 1, natom-MOD(natom,2), 2 - IF (my_end) EXIT - READ(parser%input_line,*)velocity(1,j ),velocity(2,j ),velocity(3,j ),& - velocity(1,j+1),velocity(2,j+1),velocity(3,j+1) - - velocity(1,j ) = cp_unit_to_cp2k(velocity(1,j ),"angstrom*ps^-1") - velocity(2,j ) = cp_unit_to_cp2k(velocity(2,j ),"angstrom*ps^-1") - velocity(3,j ) = cp_unit_to_cp2k(velocity(3,j ),"angstrom*ps^-1") - velocity(1:3,j ) = velocity(1:3,j )*amber_conv_factor - - velocity(1,j+1) = cp_unit_to_cp2k(velocity(1,j+1),"angstrom*ps^-1") - velocity(2,j+1) = cp_unit_to_cp2k(velocity(2,j+1),"angstrom*ps^-1") - velocity(3,j+1) = cp_unit_to_cp2k(velocity(3,j+1),"angstrom*ps^-1") - velocity(1:3,j+1) = velocity(1:3,j+1)*amber_conv_factor - - CALL parser_get_next_line(parser,1,at_end=my_end) - END DO - setup_velocities = .TRUE. - IF ((my_end).AND.(j/=natom-MOD(natom,2)+1)) THEN - IF(j/=natom)& - CALL cp_warn(__LOCATION__,& - "No VELOCITY information found in CRD file. Ignoring BOX information. "//& - "Please provide the BOX information directly from the main CP2K input! ") - setup_velocities = .FALSE. - ELSE IF (MOD(natom,2)/=0) THEN - ! In case let's handle the last atom - j = natom - READ(parser%input_line,*)velocity(1,j ),velocity(2,j ),velocity(3,j ) - - velocity(1,j ) = cp_unit_to_cp2k(velocity(1,j ),"angstrom*ps^-1") - velocity(2,j ) = cp_unit_to_cp2k(velocity(2,j ),"angstrom*ps^-1") - velocity(3,j ) = cp_unit_to_cp2k(velocity(3,j ),"angstrom*ps^-1") - velocity(1:3,j ) = velocity(1:3,j )*amber_conv_factor - - CALL parser_get_next_line(parser,1,at_end=my_end) - END IF - IF (setup_velocities) THEN - velocity_section => section_vals_get_subs_vals(subsys_section,"VELOCITY") - CALL section_velocity_val_set(velocity_section, velocity=velocity, & - conv_factor=1.0_dp) - END IF - DEALLOCATE(velocity) - END IF - IF (my_end) THEN - IF(j/=natom)& - CPWARN("BOX information missing in CRD file. ") - ELSE - IF(j/=natom)& - CALL cp_warn(__LOCATION__,& - "BOX information found in CRD file. They will be ignored."//& - "Please provide the BOX information directly from the main CP2K input!") - END IF - CALL parser_release(parser) - CALL cp_print_key_finished_output(iw,logger,subsys_section,& - "PRINT%TOPOLOGY_INFO/CRD_INFO") - CALL timestop(handle) - - END SUBROUTINE read_coordinate_crd + NULLIFY (parser, logger, velocity) + logger => cp_get_default_logger() + iw = cp_print_key_unit_nr(logger, subsys_section, "PRINT%TOPOLOGY_INFO/CRD_INFO", & + extension=".subsysLog") + CALL timeset(routineN, handle) + + atom_info => topology%atom_info + IF (iw > 0) WRITE (iw, *) " Reading in CRD file ", TRIM(topology%coord_file_name) + + ! Title Section + IF (iw > 0) WRITE (iw, '(T2,A)') 'CRD_INFO| Parsing the TITLE section' + CALL parser_create(parser, topology%coord_file_name, para_env=para_env) + CALL parser_get_next_line(parser, 1) + ! Title may be missing + IF (parser_test_next_token(parser) == "STR") THEN + CALL parser_get_object(parser, string, string_length=default_string_length) + IF (iw > 0) WRITE (iw, '(T2,A)') 'CRD_INFO| '//TRIM(string) + ! Natom and Time (which we ignore) + CALL parser_get_next_line(parser, 1) + END IF + CALL parser_get_object(parser, natom) + topology%natoms = natom + IF (iw > 0) WRITE (iw, '(T2,A,I0)') 'CRD_INFO| Number of atoms: ', natom + CALL reallocate(atom_info%id_molname, 1, natom) + CALL reallocate(atom_info%id_resname, 1, natom) + CALL reallocate(atom_info%resid, 1, natom) + CALL reallocate(atom_info%id_atmname, 1, natom) + CALL reallocate(atom_info%r, 1, 3, 1, natom) + CALL reallocate(atom_info%atm_mass, 1, natom) + CALL reallocate(atom_info%atm_charge, 1, natom) + CALL reallocate(atom_info%occup, 1, natom) + CALL reallocate(atom_info%beta, 1, natom) + CALL reallocate(atom_info%id_element, 1, natom) + + ! Element is assigned on the basis of the atm_name + topology%aa_element = .TRUE. + + ! Coordinates + CALL parser_get_next_line(parser, 1, at_end=my_end) + DO j = 1, natom - MOD(natom, 2), 2 + IF (my_end) EXIT + READ (parser%input_line, *) atom_info%r(1, j), atom_info%r(2, j), atom_info%r(3, j), & + atom_info%r(1, j + 1), atom_info%r(2, j + 1), atom_info%r(3, j + 1) + ! All these information will have to be setup elsewhere.. + ! CRD file does not contain anything related.. + atom_info%id_atmname(j) = str2id(s2s("__UNDEF__")) + atom_info%id_molname(j) = str2id(s2s("__UNDEF__")) + atom_info%id_resname(j) = str2id(s2s("__UNDEF__")) + atom_info%id_element(j) = str2id(s2s("__UNDEF__")) + atom_info%resid(j) = HUGE(0) + atom_info%atm_mass(j) = HUGE(0.0_dp) + atom_info%atm_charge(j) = -HUGE(0.0_dp) + atom_info%r(1, j) = cp_unit_to_cp2k(atom_info%r(1, j), "angstrom") + atom_info%r(2, j) = cp_unit_to_cp2k(atom_info%r(2, j), "angstrom") + atom_info%r(3, j) = cp_unit_to_cp2k(atom_info%r(3, j), "angstrom") + + atom_info%id_atmname(j + 1) = str2id(s2s("__UNDEF__")) + atom_info%id_molname(j + 1) = str2id(s2s("__UNDEF__")) + atom_info%id_resname(j + 1) = str2id(s2s("__UNDEF__")) + atom_info%id_element(j + 1) = str2id(s2s("__UNDEF__")) + atom_info%resid(j + 1) = HUGE(0) + atom_info%atm_mass(j + 1) = HUGE(0.0_dp) + atom_info%atm_charge(j + 1) = -HUGE(0.0_dp) + atom_info%r(1, j + 1) = cp_unit_to_cp2k(atom_info%r(1, j + 1), "angstrom") + atom_info%r(2, j + 1) = cp_unit_to_cp2k(atom_info%r(2, j + 1), "angstrom") + atom_info%r(3, j + 1) = cp_unit_to_cp2k(atom_info%r(3, j + 1), "angstrom") + + CALL parser_get_next_line(parser, 1, at_end=my_end) + END DO + ! Trigger error + IF ((my_end) .AND. (j /= natom - MOD(natom, 2) + 1)) THEN + IF (j /= natom) & + CPABORT("Error while reading CRD file. Unexpected end of file.") + ELSE IF (MOD(natom, 2) /= 0) THEN + ! In case let's handle the last atom + j = natom + READ (parser%input_line, *) atom_info%r(1, j), atom_info%r(2, j), atom_info%r(3, j) + ! All these information will have to be setup elsewhere.. + ! CRD file does not contain anything related.. + atom_info%id_atmname(j) = str2id(s2s("__UNDEF__")) + atom_info%id_molname(j) = str2id(s2s("__UNDEF__")) + atom_info%id_resname(j) = str2id(s2s("__UNDEF__")) + atom_info%id_element(j) = str2id(s2s("__UNDEF__")) + atom_info%resid(j) = HUGE(0) + atom_info%atm_mass(j) = HUGE(0.0_dp) + atom_info%atm_charge(j) = -HUGE(0.0_dp) + atom_info%r(1, j) = cp_unit_to_cp2k(atom_info%r(1, j), "angstrom") + atom_info%r(2, j) = cp_unit_to_cp2k(atom_info%r(2, j), "angstrom") + atom_info%r(3, j) = cp_unit_to_cp2k(atom_info%r(3, j), "angstrom") + + CALL parser_get_next_line(parser, 1, at_end=my_end) + END IF + + IF (my_end) THEN + IF (j /= natom) & + CPWARN("No VELOCITY or BOX information found in CRD file. ") + ELSE + ! Velocities + CALL reallocate(velocity, 1, 3, 1, natom) + DO j = 1, natom - MOD(natom, 2), 2 + IF (my_end) EXIT + READ (parser%input_line, *) velocity(1, j), velocity(2, j), velocity(3, j), & + velocity(1, j + 1), velocity(2, j + 1), velocity(3, j + 1) + + velocity(1, j) = cp_unit_to_cp2k(velocity(1, j), "angstrom*ps^-1") + velocity(2, j) = cp_unit_to_cp2k(velocity(2, j), "angstrom*ps^-1") + velocity(3, j) = cp_unit_to_cp2k(velocity(3, j), "angstrom*ps^-1") + velocity(1:3, j) = velocity(1:3, j)*amber_conv_factor + + velocity(1, j + 1) = cp_unit_to_cp2k(velocity(1, j + 1), "angstrom*ps^-1") + velocity(2, j + 1) = cp_unit_to_cp2k(velocity(2, j + 1), "angstrom*ps^-1") + velocity(3, j + 1) = cp_unit_to_cp2k(velocity(3, j + 1), "angstrom*ps^-1") + velocity(1:3, j + 1) = velocity(1:3, j + 1)*amber_conv_factor + + CALL parser_get_next_line(parser, 1, at_end=my_end) + END DO + setup_velocities = .TRUE. + IF ((my_end) .AND. (j /= natom - MOD(natom, 2) + 1)) THEN + IF (j /= natom) & + CALL cp_warn(__LOCATION__, & + "No VELOCITY information found in CRD file. Ignoring BOX information. "// & + "Please provide the BOX information directly from the main CP2K input! ") + setup_velocities = .FALSE. + ELSE IF (MOD(natom, 2) /= 0) THEN + ! In case let's handle the last atom + j = natom + READ (parser%input_line, *) velocity(1, j), velocity(2, j), velocity(3, j) + + velocity(1, j) = cp_unit_to_cp2k(velocity(1, j), "angstrom*ps^-1") + velocity(2, j) = cp_unit_to_cp2k(velocity(2, j), "angstrom*ps^-1") + velocity(3, j) = cp_unit_to_cp2k(velocity(3, j), "angstrom*ps^-1") + velocity(1:3, j) = velocity(1:3, j)*amber_conv_factor + + CALL parser_get_next_line(parser, 1, at_end=my_end) + END IF + IF (setup_velocities) THEN + velocity_section => section_vals_get_subs_vals(subsys_section, "VELOCITY") + CALL section_velocity_val_set(velocity_section, velocity=velocity, & + conv_factor=1.0_dp) + END IF + DEALLOCATE (velocity) + END IF + IF (my_end) THEN + IF (j /= natom) & + CPWARN("BOX information missing in CRD file. ") + ELSE + IF (j /= natom) & + CALL cp_warn(__LOCATION__, & + "BOX information found in CRD file. They will be ignored."// & + "Please provide the BOX information directly from the main CP2K input!") + END IF + CALL parser_release(parser) + CALL cp_print_key_finished_output(iw, logger, subsys_section, & + "PRINT%TOPOLOGY_INFO/CRD_INFO") + CALL timestop(handle) + + END SUBROUTINE read_coordinate_crd ! ************************************************************************************************** !> \brief Read AMBER topology file (.top) : At this level we parse only the @@ -282,7 +281,7 @@ END SUBROUTINE read_coordinate_crd !> \param subsys_section ... !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008 ! ************************************************************************************************** - SUBROUTINE read_connectivity_amber (filename, topology, para_env, subsys_section) + SUBROUTINE read_connectivity_amber(filename, topology, para_env, subsys_section) CHARACTER(LEN=*), INTENT(IN) :: filename TYPE(topology_parameters_type), INTENT(INOUT) :: topology TYPE(cp_para_env_type), POINTER :: para_env @@ -296,26 +295,26 @@ SUBROUTINE read_connectivity_amber (filename, topology, para_env, subsys_section TYPE(connectivity_info_type), POINTER :: conn_info TYPE(cp_logger_type), POINTER :: logger - NULLIFY(logger) - CALL timeset(routineN,handle) - logger => cp_get_default_logger() - iw = cp_print_key_unit_nr(logger,subsys_section,"PRINT%TOPOLOGY_INFO/AMBER_INFO",& - extension=".subsysLog") + NULLIFY (logger) + CALL timeset(routineN, handle) + logger => cp_get_default_logger() + iw = cp_print_key_unit_nr(logger, subsys_section, "PRINT%TOPOLOGY_INFO/AMBER_INFO", & + extension=".subsysLog") - atom_info => topology%atom_info - conn_info => topology%conn_info + atom_info => topology%atom_info + conn_info => topology%conn_info - ! Read the Amber topology file - CALL rdparm_amber_8(filename, iw, para_env, do_connectivity=.TRUE., do_forcefield=.FALSE.,& - atom_info=atom_info, conn_info=conn_info) + ! Read the Amber topology file + CALL rdparm_amber_8(filename, iw, para_env, do_connectivity=.TRUE., do_forcefield=.FALSE., & + atom_info=atom_info, conn_info=conn_info) - ! Molnames have been internally generated - topology%molname_generated = .TRUE. + ! Molnames have been internally generated + topology%molname_generated = .TRUE. - CALL cp_print_key_finished_output(iw,logger,subsys_section,& - "PRINT%TOPOLOGY_INFO/AMBER_INFO") - CALL timestop(handle) - END SUBROUTINE read_connectivity_amber + CALL cp_print_key_finished_output(iw, logger, subsys_section, & + "PRINT%TOPOLOGY_INFO/AMBER_INFO") + CALL timestop(handle) + END SUBROUTINE read_connectivity_amber ! ************************************************************************************************** !> \brief Access information form the AMBER topology file @@ -364,8 +363,8 @@ END SUBROUTINE read_connectivity_amber !> \param particle_set ... !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008 ! ************************************************************************************************** - SUBROUTINE rdparm_amber_8(filename, output_unit, para_env, do_connectivity,& - do_forcefield, atom_info, conn_info, amb_info, particle_set) + SUBROUTINE rdparm_amber_8(filename, output_unit, para_env, do_connectivity, & + do_forcefield, atom_info, conn_info, amb_info, particle_set) CHARACTER(LEN=*), INTENT(IN) :: filename INTEGER, INTENT(IN) :: output_unit @@ -397,538 +396,538 @@ SUBROUTINE rdparm_amber_8(filename, output_unit, para_env, do_connectivity,& req, rk, teq, tk TYPE(cp_parser_type), POINTER :: parser - CALL timeset(routineN,handle) - NULLIFY(parser) - IF (output_unit>0) WRITE(output_unit,'(/,A)')" AMBER_INFO| Reading Amber Topology File: "//& + CALL timeset(routineN, handle) + NULLIFY (parser) + IF (output_unit > 0) WRITE (output_unit, '(/,A)') " AMBER_INFO| Reading Amber Topology File: "// & TRIM(filename) - CALL parser_create(parser,filename,para_env=para_env,parse_white_lines=.TRUE.) - valid_format = check_amber_8_std(parser, output_unit) - IF (valid_format) THEN - DO WHILE (get_section_parmtop(parser, section, input_format)) - SELECT CASE (TRIM(section)) - CASE("TITLE") - ! Who cares about the title? - CYCLE - CASE("POINTERS") - CALL rd_amber_section(parser, section, info, 31) - ! Assign pointers to the corresponding labels - ! just for convenience to have something more human readable - natom = info( 1) - ntypes = info( 2) - nbonh = info( 3) - mbona = info( 4) - ntheth = info( 5) - mtheta = info( 6) - nphih = info( 7) - mphia = info( 8) - nhparm = info( 9) - nparm = info(10) - nnb = info(11) - nres = info(12) - nbona = info(13) - ntheta = info(14) - nphia = info(15) - numbnd = info(16) - numang = info(17) - nptra = info(18) - natyp = info(19) - nphb = info(20) - ifpert = info(21) - nbper = info(22) - ngper = info(23) - ndper = info(24) - mbper = info(25) - mgper = info(26) - mdper = info(27) - ifbox = info(28) - nmxrs = info(29) - ifcap = info(30) - numextra = info(31) - - ! Print some info if requested - IF (output_unit>0) THEN - WRITE(output_unit,'(A,/)')" AMBER_INFO| Information from AMBER topology file:" - WRITE(output_unit,1000)& - natom, ntypes, nbonh, mbona, ntheth, mtheta, nphih, & - mphia, nhparm, nparm, nnb, nres, nbona, ntheta, & - nphia, numbnd, numang, nptra, natyp, nphb, ifbox, & - nmxrs, ifcap, numextra - END IF - - ! Allocate temporary arrays - IF (do_connectivity) THEN - check = PRESENT(atom_info).AND.PRESENT(conn_info) - CPASSERT(check) - natom_prev = 0 - IF(ASSOCIATED(atom_info%id_molname)) natom_prev = SIZE(atom_info%id_molname) - ! Allocate for extracting connectivity infos - ALLOCATE(labres (nres )) - ALLOCATE(ipres (nres )) - END IF - IF (do_forcefield) THEN - ! Allocate for extracting forcefield infos - ALLOCATE(iac (natom )) - ALLOCATE(ico (ntypes*ntypes )) - ALLOCATE(rk (numbnd )) - ALLOCATE(req (numbnd )) - ALLOCATE(tk (numang )) - ALLOCATE(teq (numang )) - ALLOCATE(pk (nptra )) - ALLOCATE(pn (nptra )) - ALLOCATE(phase (nptra )) - ALLOCATE(cn1 (ntypes*(ntypes+1)/2)) - ALLOCATE(cn2 (ntypes*(ntypes+1)/2)) - ALLOCATE(asol (ntypes*(ntypes+1)/2)) - ALLOCATE(bsol (ntypes*(ntypes+1)/2)) - END IF - ! Always Allocate - ALLOCATE(ibh (nbonh )) - ALLOCATE(jbh (nbonh )) - ALLOCATE(icbh (nbonh )) - ALLOCATE(ib (nbona )) - ALLOCATE(jb (nbona )) - ALLOCATE(icb (nbona )) - ALLOCATE(ith (ntheth )) - ALLOCATE(jth (ntheth )) - ALLOCATE(kth (ntheth )) - ALLOCATE(icth (ntheth )) - ALLOCATE(it (ntheta )) - ALLOCATE(jt (ntheta )) - ALLOCATE(kt (ntheta )) - ALLOCATE(ict (ntheta )) - ALLOCATE(iph (nphih )) - ALLOCATE(jph (nphih )) - ALLOCATE(kph (nphih )) - ALLOCATE(lph (nphih )) - ALLOCATE(icph (nphih )) - ALLOCATE(ip (nphia )) - ALLOCATE(jp (nphia )) - ALLOCATE(kp (nphia )) - ALLOCATE(lp (nphia )) - ALLOCATE(icp (nphia )) - CASE("ATOM_NAME") - ! Atom names are just ignored according the CP2K philosophy - CYCLE - CASE("AMBER_ATOM_TYPE") - IF (.NOT.do_connectivity) CYCLE - CALL reallocate(atom_info%id_atmname,1,natom_prev+natom) - ALLOCATE(strtmp_a(natom)) - CALL rd_amber_section(parser, section, strtmp_a , natom) - DO i=1,natom - atom_info%id_atmname(natom_prev+i)=str2id(strtmp_a(i)) - ENDDO - DEALLOCATE(strtmp_a) - CASE("CHARGE") - IF (.NOT.do_connectivity) CYCLE - CALL reallocate(atom_info%atm_charge,1,natom_prev+natom) - CALL rd_amber_section(parser, section, atom_info%atm_charge(natom_prev+1:), natom) - ! Convert charges into atomic units - atom_info%atm_charge(natom_prev+1:) = atom_info%atm_charge(natom_prev+1:)/amber_conv_charge - CASE("MASS") - IF (.NOT.do_connectivity) CYCLE - CALL reallocate(atom_info%atm_mass,1,natom_prev+natom) - CALL rd_amber_section(parser, section, atom_info%atm_mass(natom_prev+1:), natom) - CASE("RESIDUE_LABEL") - IF (.NOT.do_connectivity) CYCLE - CALL reallocate(atom_info%id_resname,1,natom_prev+natom) - CALL rd_amber_section(parser, section, labres, nres) - CASE("RESIDUE_POINTER") - IF (.NOT.do_connectivity) CYCLE - CALL reallocate(atom_info%resid,1,natom_prev+natom) - CALL rd_amber_section(parser, section, ipres, nres) - CASE("ATOM_TYPE_INDEX") - IF (.NOT.do_forcefield) CYCLE - CALL rd_amber_section(parser, section, iac, natom) - CASE("NONBONDED_PARM_INDEX") - IF (.NOT.do_forcefield) CYCLE - CALL rd_amber_section(parser, section, ico, ntypes**2) - CASE("BOND_FORCE_CONSTANT") - IF (.NOT.do_forcefield) CYCLE - CALL rd_amber_section(parser, section, rk, numbnd) - CASE("BOND_EQUIL_VALUE") - IF (.NOT.do_forcefield) CYCLE - CALL rd_amber_section(parser, section, req, numbnd) - CASE("ANGLE_FORCE_CONSTANT") - IF (.NOT.do_forcefield) CYCLE - CALL rd_amber_section(parser, section, tk, numang) - CASE("ANGLE_EQUIL_VALUE") - IF (.NOT.do_forcefield) CYCLE - CALL rd_amber_section(parser, section, teq, numang) - CASE("DIHEDRAL_FORCE_CONSTANT") - IF (.NOT.do_forcefield) CYCLE - CALL rd_amber_section(parser, section, pk, nptra) - CASE("DIHEDRAL_PERIODICITY") - IF (.NOT.do_forcefield) CYCLE - CALL rd_amber_section(parser, section, pn, nptra) - CASE("DIHEDRAL_PHASE") - IF (.NOT.do_forcefield) CYCLE - CALL rd_amber_section(parser, section, phase, nptra) - CASE("LENNARD_JONES_ACOEF") - IF (.NOT.do_forcefield) CYCLE - CALL rd_amber_section(parser, section, cn1, ntypes*(ntypes+1)/2) - CASE("LENNARD_JONES_BCOEF") - IF (.NOT.do_forcefield) CYCLE - CALL rd_amber_section(parser, section, cn2, ntypes*(ntypes+1)/2) - CASE("HBOND_ACOEF") - IF (.NOT.do_forcefield) CYCLE - CALL rd_amber_section(parser, section, asol, nphb) - CASE("HBOND_BCOEF") - IF (.NOT.do_forcefield) CYCLE - CALL rd_amber_section(parser, section, bsol, nphb) - CASE("BONDS_INC_HYDROGEN") - ! We always need to parse this information both for connectivity and forcefields - CALL rd_amber_section(parser, section, ibh, jbh, icbh, nbonh) - ! Conver to an atomic index - ibh(:) = ibh(:)/3+1 - jbh(:) = jbh(:)/3+1 - CASE("BONDS_WITHOUT_HYDROGEN") - ! We always need to parse this information both for connectivity and forcefields - CALL rd_amber_section(parser, section, ib, jb, icb, nbona) - ! Conver to an atomic index - ib(:) = ib(:)/3+1 - jb(:) = jb(:)/3+1 - CASE("ANGLES_INC_HYDROGEN") - ! We always need to parse this information both for connectivity and forcefields - CALL rd_amber_section(parser, section, ith, jth, kth, icth, ntheth) - ! Conver to an atomic index - ith(:) = ith(:)/3+1 - jth(:) = jth(:)/3+1 - kth(:) = kth(:)/3+1 - CASE("ANGLES_WITHOUT_HYDROGEN") - ! We always need to parse this information both for connectivity and forcefields - CALL rd_amber_section(parser, section, it, jt, kt, ict, ntheta) - ! Conver to an atomic index - it(:) = it(:)/3+1 - jt(:) = jt(:)/3+1 - kt(:) = kt(:)/3+1 - CASE("DIHEDRALS_INC_HYDROGEN") - ! We always need to parse this information both for connectivity and forcefields - CALL rd_amber_section(parser, section, iph, jph, kph, lph, icph, nphih) - ! Conver to an atomic index - iph(:) = iph(:)/3+1 - jph(:) = jph(:)/3+1 - kph(:) = ABS(kph(:))/3+1 - lph(:) = ABS(lph(:))/3+1 - CASE("DIHEDRALS_WITHOUT_HYDROGEN") - ! We always need to parse this information both for connectivity and forcefields - CALL rd_amber_section(parser, section, ip, jp, kp, lp, icp, nphia) - ! Conver to an atomic index - ip(:) = ip(:)/3+1 - jp(:) = jp(:)/3+1 - kp(:) = ABS(kp(:))/3+1 - lp(:) = ABS(lp(:))/3+1 - CASE DEFAULT - ! Just Ignore other sections... - END SELECT - END DO - END IF - - ! Extracts connectivity info from the AMBER topology file - IF (do_connectivity) THEN - CALL timeset(TRIM(routineN)//"_connectivity",handle2) - ! ---------------------------------------------------------- - ! Conform Amber Names with CHARMM convention (kind<->charge) - ! ---------------------------------------------------------- - ALLOCATE(isymbl(natom)) - ALLOCATE(iwork(natom)) - - DO i=1,SIZE(isymbl) - isymbl(i) = id2str(atom_info%id_atmname(natom_prev+i)) - ENDDO - - ! Sort atom names + charges and identify unique types - CALL sort(isymbl, natom, iwork) - - istart = 1 - DO i = 2, natom - IF (TRIM(isymbl(i))/=TRIM(isymbl(istart))) THEN - CALL conform_atom_type_low(isymbl, iwork, i, istart, atom_info%atm_charge(natom_prev+1:)) - istart = i - END IF - END DO - CALL conform_atom_type_low(isymbl, iwork, i, istart, atom_info%atm_charge(natom_prev+1:)) - - ! Copy back the modified and conformed atom types - DO i = 1, natom - atom_info%id_atmname(natom_prev+iwork(i)) = str2id(s2s(isymbl(i))) - END DO - - ! ----------------------------------------------------------- - ! Fill residue_name and residue_id information before exiting - ! ----------------------------------------------------------- - DO i = 1, nres-1 - atom_info%id_resname(natom_prev+ipres(i):natom_prev+ipres(i+1)) = str2id(s2s(labres(i))) - atom_info%resid(natom_prev+ipres(i):natom_prev+ipres(i+1)) = i - END DO - atom_info%id_resname(natom_prev+ipres(i):natom_prev+natom) = str2id(s2s(labres(i))) - atom_info%resid(natom_prev+ipres(i):natom_prev+natom) = i - - ! Deallocate when extracting connectivity infos - DEALLOCATE(iwork) - DEALLOCATE(isymbl) - DEALLOCATE(labres) - DEALLOCATE(ipres) - - ! ---------------------------------------------------------- - ! Copy connectivity - ! ---------------------------------------------------------- - ! BONDS - nbond_prev = 0 - IF(ASSOCIATED(conn_info%bond_a)) nbond_prev = SIZE(conn_info%bond_a) - - CALL reallocate(conn_info%bond_a,1,nbond_prev+nbonh+nbona) - CALL reallocate(conn_info%bond_b,1,nbond_prev+nbonh+nbona) - DO i = 1, nbonh - index_now = nbond_prev + i - conn_info%bond_a(index_now) = natom_prev+ibh(i) - conn_info%bond_b(index_now) = natom_prev+jbh(i) - END DO - DO i = 1, nbona - index_now = nbond_prev + i + nbonh - conn_info%bond_a(index_now) = natom_prev+ib(i) - conn_info%bond_b(index_now) = natom_prev+jb(i) - END DO - - ! ANGLES - ntheta_prev = 0 - IF(ASSOCIATED(conn_info%theta_a)) ntheta_prev = SIZE(conn_info%theta_a) - - CALL reallocate(conn_info%theta_a,1,ntheta_prev+ntheth+ntheta) - CALL reallocate(conn_info%theta_b,1,ntheta_prev+ntheth+ntheta) - CALL reallocate(conn_info%theta_c,1,ntheta_prev+ntheth+ntheta) - DO i = 1, ntheth - index_now = ntheta_prev + i - conn_info%theta_a(index_now) = natom_prev+ith(i) - conn_info%theta_b(index_now) = natom_prev+jth(i) - conn_info%theta_c(index_now) = natom_prev+kth(i) - END DO - DO i = 1, ntheta - index_now = ntheta_prev + i + ntheth - conn_info%theta_a(index_now) = natom_prev+it(i) - conn_info%theta_b(index_now) = natom_prev+jt(i) - conn_info%theta_c(index_now) = natom_prev+kt(i) - END DO - - ! TORSIONS - ! For torsions we need to find out the unique torsions - ! defined in the amber parmtop - nphi_prev = 0 - IF(ASSOCIATED(conn_info%phi_a)) nphi_prev = SIZE(conn_info%phi_a) - - CALL reallocate(conn_info%phi_a,1,nphi_prev+nphih+nphia) - CALL reallocate(conn_info%phi_b,1,nphi_prev+nphih+nphia) - CALL reallocate(conn_info%phi_c,1,nphi_prev+nphih+nphia) - CALL reallocate(conn_info%phi_d,1,nphi_prev+nphih+nphia) - - IF (nphih+nphia /= 0) THEN - ALLOCATE(full_torsions(4,nphih+nphia)) - ALLOCATE(iwork(nphih+nphia)) - - DO i = 1, nphih - full_torsions(1,i) = iph(i) - full_torsions(2,i) = jph(i) - full_torsions(3,i) = kph(i) - full_torsions(4,i) = lph(i) - END DO - DO i = 1, nphia - full_torsions(1,nphih+i) = ip(i) - full_torsions(2,nphih+i) = jp(i) - full_torsions(3,nphih+i) = kp(i) - full_torsions(4,nphih+i) = lp(i) - END DO - CALL sort(full_torsions, 1, nphih+nphia, 1, 4, iwork) - - unique_torsions = nphi_prev+1 - conn_info%phi_a(unique_torsions) = natom_prev+full_torsions(1,1) - conn_info%phi_b(unique_torsions) = natom_prev+full_torsions(2,1) - conn_info%phi_c(unique_torsions) = natom_prev+full_torsions(3,1) - conn_info%phi_d(unique_torsions) = natom_prev+full_torsions(4,1) - DO i = 2, nphih+nphia - IF ( (full_torsions(1,i)/=full_torsions(1,i-1)).OR.& - (full_torsions(2,i)/=full_torsions(2,i-1)).OR.& - (full_torsions(3,i)/=full_torsions(3,i-1)).OR.& - (full_torsions(4,i)/=full_torsions(4,i-1))) THEN - unique_torsions = unique_torsions + 1 - conn_info%phi_a(unique_torsions) = natom_prev+full_torsions(1,i) - conn_info%phi_b(unique_torsions) = natom_prev+full_torsions(2,i) - conn_info%phi_c(unique_torsions) = natom_prev+full_torsions(3,i) - conn_info%phi_d(unique_torsions) = natom_prev+full_torsions(4,i) - END IF - END DO - CALL reallocate(conn_info%phi_a,1,unique_torsions) - CALL reallocate(conn_info%phi_b,1,unique_torsions) - CALL reallocate(conn_info%phi_c,1,unique_torsions) - CALL reallocate(conn_info%phi_d,1,unique_torsions) - - DEALLOCATE(full_torsions) - DEALLOCATE(iwork) - END IF - ! IMPROPERS - CALL reallocate(conn_info%impr_a,1,0) - CALL reallocate(conn_info%impr_b,1,0) - CALL reallocate(conn_info%impr_c,1,0) - CALL reallocate(conn_info%impr_d,1,0) - - ! ---------------------------------------------------------- - ! Generate molecule names - ! ---------------------------------------------------------- - CALL reallocate(atom_info%id_molname,1,natom_prev+natom) - atom_info%id_molname(natom_prev+1:natom_prev+natom) = str2id(s2s("__UNDEF__")) - CALL topology_generate_molname(conn_info, natom, natom_prev, nbond_prev,& - atom_info%id_molname(natom_prev+1:natom_prev+natom)) - CALL timestop(handle2) - END IF - - ! Extracts force fields info from the AMBER topology file - IF (do_forcefield) THEN - CALL timeset(TRIM(routineN)//"_forcefield",handle2) - ! ---------------------------------------------------------- - ! Force Fields informations related to bonds - ! ---------------------------------------------------------- - CALL reallocate(amb_info%bond_a, 1,buffer_size) - CALL reallocate(amb_info%bond_b, 1,buffer_size) - CALL reallocate(amb_info%bond_k, 1,buffer_size) - CALL reallocate(amb_info%bond_r0,1,buffer_size) - nsize = 0 - ! Bonds containing hydrogens - CALL post_process_bonds_info(amb_info%bond_a, amb_info%bond_b,& - amb_info%bond_k, amb_info%bond_r0, particle_set, nsize, & - nbonh, ibh, jbh, icbh, rk, req) - ! Bonds non-containing hydrogens - CALL post_process_bonds_info(amb_info%bond_a, amb_info%bond_b,& - amb_info%bond_k, amb_info%bond_r0, particle_set, nsize, & - nbona, ib, jb, icb, rk, req) - ! Shrink arrays size to the minimal request - CALL reallocate(amb_info%bond_a, 1,nsize) - CALL reallocate(amb_info%bond_b, 1,nsize) - CALL reallocate(amb_info%bond_k, 1,nsize) - CALL reallocate(amb_info%bond_r0,1,nsize) - - ! ---------------------------------------------------------- - ! Force Fields informations related to bends - ! ---------------------------------------------------------- - CALL reallocate(amb_info%bend_a, 1,buffer_size) - CALL reallocate(amb_info%bend_b, 1,buffer_size) - CALL reallocate(amb_info%bend_c, 1,buffer_size) - CALL reallocate(amb_info%bend_k, 1,buffer_size) - CALL reallocate(amb_info%bend_theta0,1,buffer_size) - nsize = 0 - ! Bends containing hydrogens - CALL post_process_bends_info(amb_info%bend_a, amb_info%bend_b,& - amb_info%bend_c, amb_info%bend_k, amb_info%bend_theta0, & - particle_set, nsize, ntheth, ith, jth, kth, icth, tk, teq) - ! Bends non-containing hydrogens - CALL post_process_bends_info(amb_info%bend_a, amb_info%bend_b,& - amb_info%bend_c, amb_info%bend_k, amb_info%bend_theta0, & - particle_set, nsize, ntheta, it, jt, kt, ict, tk, teq) - ! Shrink arrays size to the minimal request - CALL reallocate(amb_info%bend_a, 1,nsize) - CALL reallocate(amb_info%bend_b, 1,nsize) - CALL reallocate(amb_info%bend_c, 1,nsize) - CALL reallocate(amb_info%bend_k, 1,nsize) - CALL reallocate(amb_info%bend_theta0,1,nsize) - - ! ---------------------------------------------------------- - ! Force Fields informations related to torsions - ! in amb_info%phi0 we store PHI0 - ! ---------------------------------------------------------- - CALL reallocate(amb_info%torsion_a, 1,buffer_size) - CALL reallocate(amb_info%torsion_b, 1,buffer_size) - CALL reallocate(amb_info%torsion_c, 1,buffer_size) - CALL reallocate(amb_info%torsion_d, 1,buffer_size) - CALL reallocate(amb_info%torsion_k, 1,buffer_size) - CALL reallocate(amb_info%torsion_m, 1,buffer_size) - CALL reallocate(amb_info%torsion_phi0, 1,buffer_size) - nsize = 0 - ! Torsions containing hydrogens - CALL post_process_torsions_info(amb_info%torsion_a, amb_info%torsion_b,& - amb_info%torsion_c, amb_info%torsion_d, amb_info%torsion_k, & - amb_info%torsion_m, amb_info%torsion_phi0, particle_set, nsize,& - nphih, iph, jph, kph, lph, icph, pk, pn, phase) - ! Torsions non-containing hydrogens - CALL post_process_torsions_info(amb_info%torsion_a, amb_info%torsion_b,& - amb_info%torsion_c, amb_info%torsion_d, amb_info%torsion_k, & - amb_info%torsion_m, amb_info%torsion_phi0, particle_set, nsize,& - nphia, ip, jp, kp, lp, icp, pk, pn, phase) - ! Shrink arrays size to the minimal request - CALL reallocate(amb_info%torsion_a, 1,nsize) - CALL reallocate(amb_info%torsion_b, 1,nsize) - CALL reallocate(amb_info%torsion_c, 1,nsize) - CALL reallocate(amb_info%torsion_d, 1,nsize) - CALL reallocate(amb_info%torsion_k, 1,nsize) - CALL reallocate(amb_info%torsion_m, 1,nsize) - CALL reallocate(amb_info%torsion_phi0, 1,nsize) - - ! ---------------------------------------------------------- - ! Post process of LJ parameters - ! ---------------------------------------------------------- - CALL reallocate(amb_info%nonbond_a, 1, buffer_size) - CALL reallocate(amb_info%nonbond_eps, 1, buffer_size) - CALL reallocate(amb_info%nonbond_rmin2, 1, buffer_size) - - nsize = 0 - CALL post_process_LJ_info(amb_info%nonbond_a, amb_info%nonbond_eps,& - amb_info%nonbond_rmin2, particle_set, ntypes, nsize, iac, ico,& - cn1, cn2, natom) - - ! Shrink arrays size to the minimal request - CALL reallocate(amb_info%nonbond_a, 1, nsize) - CALL reallocate(amb_info%nonbond_eps, 1, nsize) - CALL reallocate(amb_info%nonbond_rmin2, 1, nsize) - - ! Deallocate at the end of the dirty job - DEALLOCATE(iac) - DEALLOCATE(ico) - DEALLOCATE(rk) - DEALLOCATE(req) - DEALLOCATE(tk) - DEALLOCATE(teq) - DEALLOCATE(pk) - DEALLOCATE(pn) - DEALLOCATE(phase) - DEALLOCATE(cn1) - DEALLOCATE(cn2) - DEALLOCATE(asol) - DEALLOCATE(bsol) - CALL timestop(handle2) - END IF - ! Always Deallocate - DEALLOCATE(ibh) - DEALLOCATE(jbh) - DEALLOCATE(icbh) - DEALLOCATE(ib) - DEALLOCATE(jb) - DEALLOCATE(icb) - DEALLOCATE(ith) - DEALLOCATE(jth) - DEALLOCATE(kth) - DEALLOCATE(icth) - DEALLOCATE(it) - DEALLOCATE(jt) - DEALLOCATE(kt) - DEALLOCATE(ict) - DEALLOCATE(iph) - DEALLOCATE(jph) - DEALLOCATE(kph) - DEALLOCATE(lph) - DEALLOCATE(icph) - DEALLOCATE(ip) - DEALLOCATE(jp) - DEALLOCATE(kp) - DEALLOCATE(lp) - DEALLOCATE(icp) - CALL parser_release(parser) - CALL timestop(handle) - RETURN - ! Output info Format -1000 FORMAT(T2, & - /' NATOM = ',i7,' NTYPES = ',i7,' NBONH = ',i7,' MBONA = ',i7, & - /' NTHETH = ',i7,' MTHETA = ',i7,' NPHIH = ',i7,' MPHIA = ',i7, & - /' NHPARM = ',i7,' NPARM = ',i7,' NNB = ',i7,' NRES = ',i7, & - /' NBONA = ',i7,' NTHETA = ',i7,' NPHIA = ',i7,' NUMBND = ',i7, & - /' NUMANG = ',i7,' NPTRA = ',i7,' NATYP = ',i7,' NPHB = ',i7, & - /' IFBOX = ',i7,' NMXRS = ',i7,' IFCAP = ',i7,' NEXTRA = ',i7, /) - END SUBROUTINE rdparm_amber_8 + CALL parser_create(parser, filename, para_env=para_env, parse_white_lines=.TRUE.) + valid_format = check_amber_8_std(parser, output_unit) + IF (valid_format) THEN + DO WHILE (get_section_parmtop(parser, section, input_format)) + SELECT CASE (TRIM(section)) + CASE ("TITLE") + ! Who cares about the title? + CYCLE + CASE ("POINTERS") + CALL rd_amber_section(parser, section, info, 31) + ! Assign pointers to the corresponding labels + ! just for convenience to have something more human readable + natom = info(1) + ntypes = info(2) + nbonh = info(3) + mbona = info(4) + ntheth = info(5) + mtheta = info(6) + nphih = info(7) + mphia = info(8) + nhparm = info(9) + nparm = info(10) + nnb = info(11) + nres = info(12) + nbona = info(13) + ntheta = info(14) + nphia = info(15) + numbnd = info(16) + numang = info(17) + nptra = info(18) + natyp = info(19) + nphb = info(20) + ifpert = info(21) + nbper = info(22) + ngper = info(23) + ndper = info(24) + mbper = info(25) + mgper = info(26) + mdper = info(27) + ifbox = info(28) + nmxrs = info(29) + ifcap = info(30) + numextra = info(31) + + ! Print some info if requested + IF (output_unit > 0) THEN + WRITE (output_unit, '(A,/)') " AMBER_INFO| Information from AMBER topology file:" + WRITE (output_unit, 1000) & + natom, ntypes, nbonh, mbona, ntheth, mtheta, nphih, & + mphia, nhparm, nparm, nnb, nres, nbona, ntheta, & + nphia, numbnd, numang, nptra, natyp, nphb, ifbox, & + nmxrs, ifcap, numextra + END IF + + ! Allocate temporary arrays + IF (do_connectivity) THEN + check = PRESENT(atom_info) .AND. PRESENT(conn_info) + CPASSERT(check) + natom_prev = 0 + IF (ASSOCIATED(atom_info%id_molname)) natom_prev = SIZE(atom_info%id_molname) + ! Allocate for extracting connectivity infos + ALLOCATE (labres(nres)) + ALLOCATE (ipres(nres)) + END IF + IF (do_forcefield) THEN + ! Allocate for extracting forcefield infos + ALLOCATE (iac(natom)) + ALLOCATE (ico(ntypes*ntypes)) + ALLOCATE (rk(numbnd)) + ALLOCATE (req(numbnd)) + ALLOCATE (tk(numang)) + ALLOCATE (teq(numang)) + ALLOCATE (pk(nptra)) + ALLOCATE (pn(nptra)) + ALLOCATE (phase(nptra)) + ALLOCATE (cn1(ntypes*(ntypes + 1)/2)) + ALLOCATE (cn2(ntypes*(ntypes + 1)/2)) + ALLOCATE (asol(ntypes*(ntypes + 1)/2)) + ALLOCATE (bsol(ntypes*(ntypes + 1)/2)) + END IF + ! Always Allocate + ALLOCATE (ibh(nbonh)) + ALLOCATE (jbh(nbonh)) + ALLOCATE (icbh(nbonh)) + ALLOCATE (ib(nbona)) + ALLOCATE (jb(nbona)) + ALLOCATE (icb(nbona)) + ALLOCATE (ith(ntheth)) + ALLOCATE (jth(ntheth)) + ALLOCATE (kth(ntheth)) + ALLOCATE (icth(ntheth)) + ALLOCATE (it(ntheta)) + ALLOCATE (jt(ntheta)) + ALLOCATE (kt(ntheta)) + ALLOCATE (ict(ntheta)) + ALLOCATE (iph(nphih)) + ALLOCATE (jph(nphih)) + ALLOCATE (kph(nphih)) + ALLOCATE (lph(nphih)) + ALLOCATE (icph(nphih)) + ALLOCATE (ip(nphia)) + ALLOCATE (jp(nphia)) + ALLOCATE (kp(nphia)) + ALLOCATE (lp(nphia)) + ALLOCATE (icp(nphia)) + CASE ("ATOM_NAME") + ! Atom names are just ignored according the CP2K philosophy + CYCLE + CASE ("AMBER_ATOM_TYPE") + IF (.NOT. do_connectivity) CYCLE + CALL reallocate(atom_info%id_atmname, 1, natom_prev + natom) + ALLOCATE (strtmp_a(natom)) + CALL rd_amber_section(parser, section, strtmp_a, natom) + DO i = 1, natom + atom_info%id_atmname(natom_prev + i) = str2id(strtmp_a(i)) + ENDDO + DEALLOCATE (strtmp_a) + CASE ("CHARGE") + IF (.NOT. do_connectivity) CYCLE + CALL reallocate(atom_info%atm_charge, 1, natom_prev + natom) + CALL rd_amber_section(parser, section, atom_info%atm_charge(natom_prev + 1:), natom) + ! Convert charges into atomic units + atom_info%atm_charge(natom_prev + 1:) = atom_info%atm_charge(natom_prev + 1:)/amber_conv_charge + CASE ("MASS") + IF (.NOT. do_connectivity) CYCLE + CALL reallocate(atom_info%atm_mass, 1, natom_prev + natom) + CALL rd_amber_section(parser, section, atom_info%atm_mass(natom_prev + 1:), natom) + CASE ("RESIDUE_LABEL") + IF (.NOT. do_connectivity) CYCLE + CALL reallocate(atom_info%id_resname, 1, natom_prev + natom) + CALL rd_amber_section(parser, section, labres, nres) + CASE ("RESIDUE_POINTER") + IF (.NOT. do_connectivity) CYCLE + CALL reallocate(atom_info%resid, 1, natom_prev + natom) + CALL rd_amber_section(parser, section, ipres, nres) + CASE ("ATOM_TYPE_INDEX") + IF (.NOT. do_forcefield) CYCLE + CALL rd_amber_section(parser, section, iac, natom) + CASE ("NONBONDED_PARM_INDEX") + IF (.NOT. do_forcefield) CYCLE + CALL rd_amber_section(parser, section, ico, ntypes**2) + CASE ("BOND_FORCE_CONSTANT") + IF (.NOT. do_forcefield) CYCLE + CALL rd_amber_section(parser, section, rk, numbnd) + CASE ("BOND_EQUIL_VALUE") + IF (.NOT. do_forcefield) CYCLE + CALL rd_amber_section(parser, section, req, numbnd) + CASE ("ANGLE_FORCE_CONSTANT") + IF (.NOT. do_forcefield) CYCLE + CALL rd_amber_section(parser, section, tk, numang) + CASE ("ANGLE_EQUIL_VALUE") + IF (.NOT. do_forcefield) CYCLE + CALL rd_amber_section(parser, section, teq, numang) + CASE ("DIHEDRAL_FORCE_CONSTANT") + IF (.NOT. do_forcefield) CYCLE + CALL rd_amber_section(parser, section, pk, nptra) + CASE ("DIHEDRAL_PERIODICITY") + IF (.NOT. do_forcefield) CYCLE + CALL rd_amber_section(parser, section, pn, nptra) + CASE ("DIHEDRAL_PHASE") + IF (.NOT. do_forcefield) CYCLE + CALL rd_amber_section(parser, section, phase, nptra) + CASE ("LENNARD_JONES_ACOEF") + IF (.NOT. do_forcefield) CYCLE + CALL rd_amber_section(parser, section, cn1, ntypes*(ntypes + 1)/2) + CASE ("LENNARD_JONES_BCOEF") + IF (.NOT. do_forcefield) CYCLE + CALL rd_amber_section(parser, section, cn2, ntypes*(ntypes + 1)/2) + CASE ("HBOND_ACOEF") + IF (.NOT. do_forcefield) CYCLE + CALL rd_amber_section(parser, section, asol, nphb) + CASE ("HBOND_BCOEF") + IF (.NOT. do_forcefield) CYCLE + CALL rd_amber_section(parser, section, bsol, nphb) + CASE ("BONDS_INC_HYDROGEN") + ! We always need to parse this information both for connectivity and forcefields + CALL rd_amber_section(parser, section, ibh, jbh, icbh, nbonh) + ! Conver to an atomic index + ibh(:) = ibh(:)/3 + 1 + jbh(:) = jbh(:)/3 + 1 + CASE ("BONDS_WITHOUT_HYDROGEN") + ! We always need to parse this information both for connectivity and forcefields + CALL rd_amber_section(parser, section, ib, jb, icb, nbona) + ! Conver to an atomic index + ib(:) = ib(:)/3 + 1 + jb(:) = jb(:)/3 + 1 + CASE ("ANGLES_INC_HYDROGEN") + ! We always need to parse this information both for connectivity and forcefields + CALL rd_amber_section(parser, section, ith, jth, kth, icth, ntheth) + ! Conver to an atomic index + ith(:) = ith(:)/3 + 1 + jth(:) = jth(:)/3 + 1 + kth(:) = kth(:)/3 + 1 + CASE ("ANGLES_WITHOUT_HYDROGEN") + ! We always need to parse this information both for connectivity and forcefields + CALL rd_amber_section(parser, section, it, jt, kt, ict, ntheta) + ! Conver to an atomic index + it(:) = it(:)/3 + 1 + jt(:) = jt(:)/3 + 1 + kt(:) = kt(:)/3 + 1 + CASE ("DIHEDRALS_INC_HYDROGEN") + ! We always need to parse this information both for connectivity and forcefields + CALL rd_amber_section(parser, section, iph, jph, kph, lph, icph, nphih) + ! Conver to an atomic index + iph(:) = iph(:)/3 + 1 + jph(:) = jph(:)/3 + 1 + kph(:) = ABS(kph(:))/3 + 1 + lph(:) = ABS(lph(:))/3 + 1 + CASE ("DIHEDRALS_WITHOUT_HYDROGEN") + ! We always need to parse this information both for connectivity and forcefields + CALL rd_amber_section(parser, section, ip, jp, kp, lp, icp, nphia) + ! Conver to an atomic index + ip(:) = ip(:)/3 + 1 + jp(:) = jp(:)/3 + 1 + kp(:) = ABS(kp(:))/3 + 1 + lp(:) = ABS(lp(:))/3 + 1 + CASE DEFAULT + ! Just Ignore other sections... + END SELECT + END DO + END IF + + ! Extracts connectivity info from the AMBER topology file + IF (do_connectivity) THEN + CALL timeset(TRIM(routineN)//"_connectivity", handle2) + ! ---------------------------------------------------------- + ! Conform Amber Names with CHARMM convention (kind<->charge) + ! ---------------------------------------------------------- + ALLOCATE (isymbl(natom)) + ALLOCATE (iwork(natom)) + + DO i = 1, SIZE(isymbl) + isymbl(i) = id2str(atom_info%id_atmname(natom_prev + i)) + ENDDO + + ! Sort atom names + charges and identify unique types + CALL sort(isymbl, natom, iwork) + + istart = 1 + DO i = 2, natom + IF (TRIM(isymbl(i)) /= TRIM(isymbl(istart))) THEN + CALL conform_atom_type_low(isymbl, iwork, i, istart, atom_info%atm_charge(natom_prev + 1:)) + istart = i + END IF + END DO + CALL conform_atom_type_low(isymbl, iwork, i, istart, atom_info%atm_charge(natom_prev + 1:)) + + ! Copy back the modified and conformed atom types + DO i = 1, natom + atom_info%id_atmname(natom_prev + iwork(i)) = str2id(s2s(isymbl(i))) + END DO + + ! ----------------------------------------------------------- + ! Fill residue_name and residue_id information before exiting + ! ----------------------------------------------------------- + DO i = 1, nres - 1 + atom_info%id_resname(natom_prev + ipres(i):natom_prev + ipres(i + 1)) = str2id(s2s(labres(i))) + atom_info%resid(natom_prev + ipres(i):natom_prev + ipres(i + 1)) = i + END DO + atom_info%id_resname(natom_prev + ipres(i):natom_prev + natom) = str2id(s2s(labres(i))) + atom_info%resid(natom_prev + ipres(i):natom_prev + natom) = i + + ! Deallocate when extracting connectivity infos + DEALLOCATE (iwork) + DEALLOCATE (isymbl) + DEALLOCATE (labres) + DEALLOCATE (ipres) + + ! ---------------------------------------------------------- + ! Copy connectivity + ! ---------------------------------------------------------- + ! BONDS + nbond_prev = 0 + IF (ASSOCIATED(conn_info%bond_a)) nbond_prev = SIZE(conn_info%bond_a) + + CALL reallocate(conn_info%bond_a, 1, nbond_prev + nbonh + nbona) + CALL reallocate(conn_info%bond_b, 1, nbond_prev + nbonh + nbona) + DO i = 1, nbonh + index_now = nbond_prev + i + conn_info%bond_a(index_now) = natom_prev + ibh(i) + conn_info%bond_b(index_now) = natom_prev + jbh(i) + END DO + DO i = 1, nbona + index_now = nbond_prev + i + nbonh + conn_info%bond_a(index_now) = natom_prev + ib(i) + conn_info%bond_b(index_now) = natom_prev + jb(i) + END DO + + ! ANGLES + ntheta_prev = 0 + IF (ASSOCIATED(conn_info%theta_a)) ntheta_prev = SIZE(conn_info%theta_a) + + CALL reallocate(conn_info%theta_a, 1, ntheta_prev + ntheth + ntheta) + CALL reallocate(conn_info%theta_b, 1, ntheta_prev + ntheth + ntheta) + CALL reallocate(conn_info%theta_c, 1, ntheta_prev + ntheth + ntheta) + DO i = 1, ntheth + index_now = ntheta_prev + i + conn_info%theta_a(index_now) = natom_prev + ith(i) + conn_info%theta_b(index_now) = natom_prev + jth(i) + conn_info%theta_c(index_now) = natom_prev + kth(i) + END DO + DO i = 1, ntheta + index_now = ntheta_prev + i + ntheth + conn_info%theta_a(index_now) = natom_prev + it(i) + conn_info%theta_b(index_now) = natom_prev + jt(i) + conn_info%theta_c(index_now) = natom_prev + kt(i) + END DO + + ! TORSIONS + ! For torsions we need to find out the unique torsions + ! defined in the amber parmtop + nphi_prev = 0 + IF (ASSOCIATED(conn_info%phi_a)) nphi_prev = SIZE(conn_info%phi_a) + + CALL reallocate(conn_info%phi_a, 1, nphi_prev + nphih + nphia) + CALL reallocate(conn_info%phi_b, 1, nphi_prev + nphih + nphia) + CALL reallocate(conn_info%phi_c, 1, nphi_prev + nphih + nphia) + CALL reallocate(conn_info%phi_d, 1, nphi_prev + nphih + nphia) + + IF (nphih + nphia /= 0) THEN + ALLOCATE (full_torsions(4, nphih + nphia)) + ALLOCATE (iwork(nphih + nphia)) + + DO i = 1, nphih + full_torsions(1, i) = iph(i) + full_torsions(2, i) = jph(i) + full_torsions(3, i) = kph(i) + full_torsions(4, i) = lph(i) + END DO + DO i = 1, nphia + full_torsions(1, nphih + i) = ip(i) + full_torsions(2, nphih + i) = jp(i) + full_torsions(3, nphih + i) = kp(i) + full_torsions(4, nphih + i) = lp(i) + END DO + CALL sort(full_torsions, 1, nphih + nphia, 1, 4, iwork) + + unique_torsions = nphi_prev + 1 + conn_info%phi_a(unique_torsions) = natom_prev + full_torsions(1, 1) + conn_info%phi_b(unique_torsions) = natom_prev + full_torsions(2, 1) + conn_info%phi_c(unique_torsions) = natom_prev + full_torsions(3, 1) + conn_info%phi_d(unique_torsions) = natom_prev + full_torsions(4, 1) + DO i = 2, nphih + nphia + IF ((full_torsions(1, i) /= full_torsions(1, i - 1)) .OR. & + (full_torsions(2, i) /= full_torsions(2, i - 1)) .OR. & + (full_torsions(3, i) /= full_torsions(3, i - 1)) .OR. & + (full_torsions(4, i) /= full_torsions(4, i - 1))) THEN + unique_torsions = unique_torsions + 1 + conn_info%phi_a(unique_torsions) = natom_prev + full_torsions(1, i) + conn_info%phi_b(unique_torsions) = natom_prev + full_torsions(2, i) + conn_info%phi_c(unique_torsions) = natom_prev + full_torsions(3, i) + conn_info%phi_d(unique_torsions) = natom_prev + full_torsions(4, i) + END IF + END DO + CALL reallocate(conn_info%phi_a, 1, unique_torsions) + CALL reallocate(conn_info%phi_b, 1, unique_torsions) + CALL reallocate(conn_info%phi_c, 1, unique_torsions) + CALL reallocate(conn_info%phi_d, 1, unique_torsions) + + DEALLOCATE (full_torsions) + DEALLOCATE (iwork) + END IF + ! IMPROPERS + CALL reallocate(conn_info%impr_a, 1, 0) + CALL reallocate(conn_info%impr_b, 1, 0) + CALL reallocate(conn_info%impr_c, 1, 0) + CALL reallocate(conn_info%impr_d, 1, 0) + + ! ---------------------------------------------------------- + ! Generate molecule names + ! ---------------------------------------------------------- + CALL reallocate(atom_info%id_molname, 1, natom_prev + natom) + atom_info%id_molname(natom_prev + 1:natom_prev + natom) = str2id(s2s("__UNDEF__")) + CALL topology_generate_molname(conn_info, natom, natom_prev, nbond_prev, & + atom_info%id_molname(natom_prev + 1:natom_prev + natom)) + CALL timestop(handle2) + END IF + + ! Extracts force fields info from the AMBER topology file + IF (do_forcefield) THEN + CALL timeset(TRIM(routineN)//"_forcefield", handle2) + ! ---------------------------------------------------------- + ! Force Fields informations related to bonds + ! ---------------------------------------------------------- + CALL reallocate(amb_info%bond_a, 1, buffer_size) + CALL reallocate(amb_info%bond_b, 1, buffer_size) + CALL reallocate(amb_info%bond_k, 1, buffer_size) + CALL reallocate(amb_info%bond_r0, 1, buffer_size) + nsize = 0 + ! Bonds containing hydrogens + CALL post_process_bonds_info(amb_info%bond_a, amb_info%bond_b, & + amb_info%bond_k, amb_info%bond_r0, particle_set, nsize, & + nbonh, ibh, jbh, icbh, rk, req) + ! Bonds non-containing hydrogens + CALL post_process_bonds_info(amb_info%bond_a, amb_info%bond_b, & + amb_info%bond_k, amb_info%bond_r0, particle_set, nsize, & + nbona, ib, jb, icb, rk, req) + ! Shrink arrays size to the minimal request + CALL reallocate(amb_info%bond_a, 1, nsize) + CALL reallocate(amb_info%bond_b, 1, nsize) + CALL reallocate(amb_info%bond_k, 1, nsize) + CALL reallocate(amb_info%bond_r0, 1, nsize) + + ! ---------------------------------------------------------- + ! Force Fields informations related to bends + ! ---------------------------------------------------------- + CALL reallocate(amb_info%bend_a, 1, buffer_size) + CALL reallocate(amb_info%bend_b, 1, buffer_size) + CALL reallocate(amb_info%bend_c, 1, buffer_size) + CALL reallocate(amb_info%bend_k, 1, buffer_size) + CALL reallocate(amb_info%bend_theta0, 1, buffer_size) + nsize = 0 + ! Bends containing hydrogens + CALL post_process_bends_info(amb_info%bend_a, amb_info%bend_b, & + amb_info%bend_c, amb_info%bend_k, amb_info%bend_theta0, & + particle_set, nsize, ntheth, ith, jth, kth, icth, tk, teq) + ! Bends non-containing hydrogens + CALL post_process_bends_info(amb_info%bend_a, amb_info%bend_b, & + amb_info%bend_c, amb_info%bend_k, amb_info%bend_theta0, & + particle_set, nsize, ntheta, it, jt, kt, ict, tk, teq) + ! Shrink arrays size to the minimal request + CALL reallocate(amb_info%bend_a, 1, nsize) + CALL reallocate(amb_info%bend_b, 1, nsize) + CALL reallocate(amb_info%bend_c, 1, nsize) + CALL reallocate(amb_info%bend_k, 1, nsize) + CALL reallocate(amb_info%bend_theta0, 1, nsize) + + ! ---------------------------------------------------------- + ! Force Fields informations related to torsions + ! in amb_info%phi0 we store PHI0 + ! ---------------------------------------------------------- + CALL reallocate(amb_info%torsion_a, 1, buffer_size) + CALL reallocate(amb_info%torsion_b, 1, buffer_size) + CALL reallocate(amb_info%torsion_c, 1, buffer_size) + CALL reallocate(amb_info%torsion_d, 1, buffer_size) + CALL reallocate(amb_info%torsion_k, 1, buffer_size) + CALL reallocate(amb_info%torsion_m, 1, buffer_size) + CALL reallocate(amb_info%torsion_phi0, 1, buffer_size) + nsize = 0 + ! Torsions containing hydrogens + CALL post_process_torsions_info(amb_info%torsion_a, amb_info%torsion_b, & + amb_info%torsion_c, amb_info%torsion_d, amb_info%torsion_k, & + amb_info%torsion_m, amb_info%torsion_phi0, particle_set, nsize, & + nphih, iph, jph, kph, lph, icph, pk, pn, phase) + ! Torsions non-containing hydrogens + CALL post_process_torsions_info(amb_info%torsion_a, amb_info%torsion_b, & + amb_info%torsion_c, amb_info%torsion_d, amb_info%torsion_k, & + amb_info%torsion_m, amb_info%torsion_phi0, particle_set, nsize, & + nphia, ip, jp, kp, lp, icp, pk, pn, phase) + ! Shrink arrays size to the minimal request + CALL reallocate(amb_info%torsion_a, 1, nsize) + CALL reallocate(amb_info%torsion_b, 1, nsize) + CALL reallocate(amb_info%torsion_c, 1, nsize) + CALL reallocate(amb_info%torsion_d, 1, nsize) + CALL reallocate(amb_info%torsion_k, 1, nsize) + CALL reallocate(amb_info%torsion_m, 1, nsize) + CALL reallocate(amb_info%torsion_phi0, 1, nsize) + + ! ---------------------------------------------------------- + ! Post process of LJ parameters + ! ---------------------------------------------------------- + CALL reallocate(amb_info%nonbond_a, 1, buffer_size) + CALL reallocate(amb_info%nonbond_eps, 1, buffer_size) + CALL reallocate(amb_info%nonbond_rmin2, 1, buffer_size) + + nsize = 0 + CALL post_process_LJ_info(amb_info%nonbond_a, amb_info%nonbond_eps, & + amb_info%nonbond_rmin2, particle_set, ntypes, nsize, iac, ico, & + cn1, cn2, natom) + + ! Shrink arrays size to the minimal request + CALL reallocate(amb_info%nonbond_a, 1, nsize) + CALL reallocate(amb_info%nonbond_eps, 1, nsize) + CALL reallocate(amb_info%nonbond_rmin2, 1, nsize) + + ! Deallocate at the end of the dirty job + DEALLOCATE (iac) + DEALLOCATE (ico) + DEALLOCATE (rk) + DEALLOCATE (req) + DEALLOCATE (tk) + DEALLOCATE (teq) + DEALLOCATE (pk) + DEALLOCATE (pn) + DEALLOCATE (phase) + DEALLOCATE (cn1) + DEALLOCATE (cn2) + DEALLOCATE (asol) + DEALLOCATE (bsol) + CALL timestop(handle2) + END IF + ! Always Deallocate + DEALLOCATE (ibh) + DEALLOCATE (jbh) + DEALLOCATE (icbh) + DEALLOCATE (ib) + DEALLOCATE (jb) + DEALLOCATE (icb) + DEALLOCATE (ith) + DEALLOCATE (jth) + DEALLOCATE (kth) + DEALLOCATE (icth) + DEALLOCATE (it) + DEALLOCATE (jt) + DEALLOCATE (kt) + DEALLOCATE (ict) + DEALLOCATE (iph) + DEALLOCATE (jph) + DEALLOCATE (kph) + DEALLOCATE (lph) + DEALLOCATE (icph) + DEALLOCATE (ip) + DEALLOCATE (jp) + DEALLOCATE (kp) + DEALLOCATE (lp) + DEALLOCATE (icp) + CALL parser_release(parser) + CALL timestop(handle) + RETURN + ! Output info Format +1000 FORMAT(T2, & + /' NATOM = ', i7, ' NTYPES = ', i7, ' NBONH = ', i7, ' MBONA = ', i7, & + /' NTHETH = ', i7, ' MTHETA = ', i7, ' NPHIH = ', i7, ' MPHIA = ', i7, & + /' NHPARM = ', i7, ' NPARM = ', i7, ' NNB = ', i7, ' NRES = ', i7, & + /' NBONA = ', i7, ' NTHETA = ', i7, ' NPHIA = ', i7, ' NUMBND = ', i7, & + /' NUMANG = ', i7, ' NPTRA = ', i7, ' NATYP = ', i7, ' NPHB = ', i7, & + /' IFBOX = ', i7, ' NMXRS = ', i7, ' IFCAP = ', i7, ' NEXTRA = ', i7,/) + END SUBROUTINE rdparm_amber_8 ! ************************************************************************************************** !> \brief Low level routine to identify and rename unique atom types @@ -939,7 +938,7 @@ END SUBROUTINE rdparm_amber_8 !> \param charges ... !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008 ! ************************************************************************************************** - SUBROUTINE conform_atom_type_low(isymbl, iwork, i, istart, charges) + SUBROUTINE conform_atom_type_low(isymbl, iwork, i, istart, charges) CHARACTER(LEN=default_string_length), DIMENSION(:) :: isymbl INTEGER, DIMENSION(:) :: iwork INTEGER, INTENT(IN) :: i @@ -955,55 +954,55 @@ SUBROUTINE conform_atom_type_low(isymbl, iwork, i, istart, charges) REAL(KIND=dp) :: ctmp REAL(KIND=dp), DIMENSION(:), POINTER :: cwork - CALL timeset(routineN, handle) - iend = i - 1 - isize= iend-istart+1 - ALLOCATE(cwork(isize)) - ALLOCATE(lindx(isize)) - ALLOCATE(cindx(isize)) - ind = 0 - DO k = istart, iend - ind = ind + 1 - cwork(ind) = charges(iwork(k)) - lindx(ind) = k - END DO - CALL sort(cwork, isize, cindx) - - ctmp = cwork(1) - counter = 1 - DO k = 2, isize - IF (cwork(k)/=ctmp) THEN - counter = counter + 1 - ctmp = cwork(k) - END IF - END DO - IF (counter /= 1) THEN - counter = 1 - kstart = 1 - ctmp = cwork(1) - DO k = 2, isize - IF (cwork(k)/=ctmp) THEN - kend = k - 1 - DO j = kstart, kend - gind= lindx(cindx(j)) - isymbl(gind) = TRIM(isymbl(gind))//ADJUSTL(cp_to_string(counter)) - END DO - counter = counter + 1 - ctmp = cwork(k) - kstart = k - END IF - END DO - kend = k - 1 - DO j = kstart, kend - gind= lindx(cindx(j)) - isymbl(gind) = TRIM(isymbl(gind))//ADJUSTL(cp_to_string(counter)) - END DO - END IF - DEALLOCATE(cwork) - DEALLOCATE(lindx) - DEALLOCATE(cindx) - CALL timestop(handle) - END SUBROUTINE conform_atom_type_low + CALL timeset(routineN, handle) + iend = i - 1 + isize = iend - istart + 1 + ALLOCATE (cwork(isize)) + ALLOCATE (lindx(isize)) + ALLOCATE (cindx(isize)) + ind = 0 + DO k = istart, iend + ind = ind + 1 + cwork(ind) = charges(iwork(k)) + lindx(ind) = k + END DO + CALL sort(cwork, isize, cindx) + + ctmp = cwork(1) + counter = 1 + DO k = 2, isize + IF (cwork(k) /= ctmp) THEN + counter = counter + 1 + ctmp = cwork(k) + END IF + END DO + IF (counter /= 1) THEN + counter = 1 + kstart = 1 + ctmp = cwork(1) + DO k = 2, isize + IF (cwork(k) /= ctmp) THEN + kend = k - 1 + DO j = kstart, kend + gind = lindx(cindx(j)) + isymbl(gind) = TRIM(isymbl(gind))//ADJUSTL(cp_to_string(counter)) + END DO + counter = counter + 1 + ctmp = cwork(k) + kstart = k + END IF + END DO + kend = k - 1 + DO j = kstart, kend + gind = lindx(cindx(j)) + isymbl(gind) = TRIM(isymbl(gind))//ADJUSTL(cp_to_string(counter)) + END DO + END IF + DEALLOCATE (cwork) + DEALLOCATE (lindx) + DEALLOCATE (cindx) + CALL timestop(handle) + END SUBROUTINE conform_atom_type_low ! ************************************************************************************************** !> \brief Set of Low level subroutines reading section for parmtop @@ -1014,7 +1013,7 @@ END SUBROUTINE conform_atom_type_low !> \param dim ... !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008 ! ************************************************************************************************** - SUBROUTINE rd_amber_section_i1(parser, section, array1, dim) + SUBROUTINE rd_amber_section_i1(parser, section, array1, dim) TYPE(cp_parser_type), POINTER :: parser CHARACTER(LEN=default_string_length), INTENT(IN) :: section INTEGER, DIMENSION(:) :: array1 @@ -1026,20 +1025,20 @@ SUBROUTINE rd_amber_section_i1(parser, section, array1, dim) INTEGER :: i LOGICAL :: my_end - CALL parser_get_next_line(parser,1,at_end=my_end) - i = 1 - DO WHILE ((i<=dim).AND.(.NOT.my_end)) - IF (parser_test_next_token(parser)=="EOL")& - CALL parser_get_next_line(parser,1,at_end=my_end) - IF (my_end) EXIT - CALL parser_get_object(parser,array1(i)) - i = i + 1 - END DO - ! Trigger end of file aborting - IF(my_end.AND.(i<=dim))& - CALL cp_abort(__LOCATION__,& - "End of file while reading section "//TRIM(section)//" in amber topology file!") - END SUBROUTINE rd_amber_section_i1 + CALL parser_get_next_line(parser, 1, at_end=my_end) + i = 1 + DO WHILE ((i <= dim) .AND. (.NOT. my_end)) + IF (parser_test_next_token(parser) == "EOL") & + CALL parser_get_next_line(parser, 1, at_end=my_end) + IF (my_end) EXIT + CALL parser_get_object(parser, array1(i)) + i = i + 1 + END DO + ! Trigger end of file aborting + IF (my_end .AND. (i <= dim)) & + CALL cp_abort(__LOCATION__, & + "End of file while reading section "//TRIM(section)//" in amber topology file!") + END SUBROUTINE rd_amber_section_i1 ! ************************************************************************************************** !> \brief Set of Low level subroutines reading section for parmtop @@ -1052,7 +1051,7 @@ END SUBROUTINE rd_amber_section_i1 !> \param dim ... !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008 ! ************************************************************************************************** - SUBROUTINE rd_amber_section_i3(parser, section, array1, array2, array3, dim) + SUBROUTINE rd_amber_section_i3(parser, section, array1, array2, array3, dim) TYPE(cp_parser_type), POINTER :: parser CHARACTER(LEN=default_string_length), INTENT(IN) :: section INTEGER, DIMENSION(:) :: array1, array2, array3 @@ -1064,31 +1063,31 @@ SUBROUTINE rd_amber_section_i3(parser, section, array1, array2, array3, dim) INTEGER :: i LOGICAL :: my_end - CALL parser_get_next_line(parser,1,at_end=my_end) - i = 1 - DO WHILE ((i<=dim).AND.(.NOT.my_end)) - !array1 - IF (parser_test_next_token(parser)=="EOL")& - CALL parser_get_next_line(parser,1,at_end=my_end) - IF (my_end) EXIT - CALL parser_get_object (parser,array1(i)) - !array2 - IF (parser_test_next_token(parser)=="EOL")& - CALL parser_get_next_line(parser,1,at_end=my_end) - IF (my_end) EXIT - CALL parser_get_object (parser,array2(i)) - !array3 - IF (parser_test_next_token(parser)=="EOL")& - CALL parser_get_next_line(parser,1,at_end=my_end) - IF (my_end) EXIT - CALL parser_get_object (parser,array3(i)) - i = i + 1 - END DO - ! Trigger end of file aborting - IF(my_end.AND.(i<=dim))& - CALL cp_abort(__LOCATION__,& - "End of file while reading section "//TRIM(section)//" in amber topology file!") - END SUBROUTINE rd_amber_section_i3 + CALL parser_get_next_line(parser, 1, at_end=my_end) + i = 1 + DO WHILE ((i <= dim) .AND. (.NOT. my_end)) + !array1 + IF (parser_test_next_token(parser) == "EOL") & + CALL parser_get_next_line(parser, 1, at_end=my_end) + IF (my_end) EXIT + CALL parser_get_object(parser, array1(i)) + !array2 + IF (parser_test_next_token(parser) == "EOL") & + CALL parser_get_next_line(parser, 1, at_end=my_end) + IF (my_end) EXIT + CALL parser_get_object(parser, array2(i)) + !array3 + IF (parser_test_next_token(parser) == "EOL") & + CALL parser_get_next_line(parser, 1, at_end=my_end) + IF (my_end) EXIT + CALL parser_get_object(parser, array3(i)) + i = i + 1 + END DO + ! Trigger end of file aborting + IF (my_end .AND. (i <= dim)) & + CALL cp_abort(__LOCATION__, & + "End of file while reading section "//TRIM(section)//" in amber topology file!") + END SUBROUTINE rd_amber_section_i3 ! ************************************************************************************************** !> \brief Set of Low level subroutines reading section for parmtop @@ -1102,7 +1101,7 @@ END SUBROUTINE rd_amber_section_i3 !> \param dim ... !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008 ! ************************************************************************************************** - SUBROUTINE rd_amber_section_i4(parser, section, array1, array2, array3, array4, dim) + SUBROUTINE rd_amber_section_i4(parser, section, array1, array2, array3, array4, dim) TYPE(cp_parser_type), POINTER :: parser CHARACTER(LEN=default_string_length), INTENT(IN) :: section INTEGER, DIMENSION(:) :: array1, array2, array3, array4 @@ -1114,36 +1113,36 @@ SUBROUTINE rd_amber_section_i4(parser, section, array1, array2, array3, array4, INTEGER :: i LOGICAL :: my_end - CALL parser_get_next_line(parser,1,at_end=my_end) - i = 1 - DO WHILE ((i<=dim).AND.(.NOT.my_end)) - !array1 - IF (parser_test_next_token(parser)=="EOL")& - CALL parser_get_next_line(parser,1,at_end=my_end) - IF (my_end) EXIT - CALL parser_get_object (parser,array1(i)) - !array2 - IF (parser_test_next_token(parser)=="EOL")& - CALL parser_get_next_line(parser,1,at_end=my_end) - IF (my_end) EXIT - CALL parser_get_object (parser,array2(i)) - !array3 - IF (parser_test_next_token(parser)=="EOL")& - CALL parser_get_next_line(parser,1,at_end=my_end) - IF (my_end) EXIT - CALL parser_get_object (parser,array3(i)) - !array4 - IF (parser_test_next_token(parser)=="EOL")& - CALL parser_get_next_line(parser,1,at_end=my_end) - IF (my_end) EXIT - CALL parser_get_object (parser,array4(i)) - i = i + 1 - END DO - ! Trigger end of file aborting - IF(my_end.AND.(i<=dim))& - CALL cp_abort(__LOCATION__,& - "End of file while reading section "//TRIM(section)//" in amber topology file!") - END SUBROUTINE rd_amber_section_i4 + CALL parser_get_next_line(parser, 1, at_end=my_end) + i = 1 + DO WHILE ((i <= dim) .AND. (.NOT. my_end)) + !array1 + IF (parser_test_next_token(parser) == "EOL") & + CALL parser_get_next_line(parser, 1, at_end=my_end) + IF (my_end) EXIT + CALL parser_get_object(parser, array1(i)) + !array2 + IF (parser_test_next_token(parser) == "EOL") & + CALL parser_get_next_line(parser, 1, at_end=my_end) + IF (my_end) EXIT + CALL parser_get_object(parser, array2(i)) + !array3 + IF (parser_test_next_token(parser) == "EOL") & + CALL parser_get_next_line(parser, 1, at_end=my_end) + IF (my_end) EXIT + CALL parser_get_object(parser, array3(i)) + !array4 + IF (parser_test_next_token(parser) == "EOL") & + CALL parser_get_next_line(parser, 1, at_end=my_end) + IF (my_end) EXIT + CALL parser_get_object(parser, array4(i)) + i = i + 1 + END DO + ! Trigger end of file aborting + IF (my_end .AND. (i <= dim)) & + CALL cp_abort(__LOCATION__, & + "End of file while reading section "//TRIM(section)//" in amber topology file!") + END SUBROUTINE rd_amber_section_i4 ! ************************************************************************************************** !> \brief Set of Low level subroutines reading section for parmtop @@ -1158,8 +1157,8 @@ END SUBROUTINE rd_amber_section_i4 !> \param dim ... !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008 ! ************************************************************************************************** - SUBROUTINE rd_amber_section_i5(parser, section, array1, array2, array3, array4, & - array5, dim) + SUBROUTINE rd_amber_section_i5(parser, section, array1, array2, array3, array4, & + array5, dim) TYPE(cp_parser_type), POINTER :: parser CHARACTER(LEN=default_string_length), INTENT(IN) :: section INTEGER, DIMENSION(:) :: array1, array2, array3, array4, array5 @@ -1171,41 +1170,41 @@ SUBROUTINE rd_amber_section_i5(parser, section, array1, array2, array3, array4, INTEGER :: i LOGICAL :: my_end - CALL parser_get_next_line(parser,1,at_end=my_end) - i = 1 - DO WHILE ((i<=dim).AND.(.NOT.my_end)) - !array1 - IF (parser_test_next_token(parser)=="EOL")& - CALL parser_get_next_line(parser,1,at_end=my_end) - IF (my_end) EXIT - CALL parser_get_object (parser,array1(i)) - !array2 - IF (parser_test_next_token(parser)=="EOL")& - CALL parser_get_next_line(parser,1,at_end=my_end) - IF (my_end) EXIT - CALL parser_get_object (parser,array2(i)) - !array3 - IF (parser_test_next_token(parser)=="EOL")& - CALL parser_get_next_line(parser,1,at_end=my_end) - IF (my_end) EXIT - CALL parser_get_object (parser,array3(i)) - !array4 - IF (parser_test_next_token(parser)=="EOL")& - CALL parser_get_next_line(parser,1,at_end=my_end) - IF (my_end) EXIT - CALL parser_get_object (parser,array4(i)) - !array5 - IF (parser_test_next_token(parser)=="EOL")& - CALL parser_get_next_line(parser,1,at_end=my_end) - IF (my_end) EXIT - CALL parser_get_object (parser,array5(i)) - i = i + 1 - END DO - ! Trigger end of file aborting - IF(my_end.AND.(i<=dim))& - CALL cp_abort(__LOCATION__,& - "End of file while reading section "//TRIM(section)//" in amber topology file!") - END SUBROUTINE rd_amber_section_i5 + CALL parser_get_next_line(parser, 1, at_end=my_end) + i = 1 + DO WHILE ((i <= dim) .AND. (.NOT. my_end)) + !array1 + IF (parser_test_next_token(parser) == "EOL") & + CALL parser_get_next_line(parser, 1, at_end=my_end) + IF (my_end) EXIT + CALL parser_get_object(parser, array1(i)) + !array2 + IF (parser_test_next_token(parser) == "EOL") & + CALL parser_get_next_line(parser, 1, at_end=my_end) + IF (my_end) EXIT + CALL parser_get_object(parser, array2(i)) + !array3 + IF (parser_test_next_token(parser) == "EOL") & + CALL parser_get_next_line(parser, 1, at_end=my_end) + IF (my_end) EXIT + CALL parser_get_object(parser, array3(i)) + !array4 + IF (parser_test_next_token(parser) == "EOL") & + CALL parser_get_next_line(parser, 1, at_end=my_end) + IF (my_end) EXIT + CALL parser_get_object(parser, array4(i)) + !array5 + IF (parser_test_next_token(parser) == "EOL") & + CALL parser_get_next_line(parser, 1, at_end=my_end) + IF (my_end) EXIT + CALL parser_get_object(parser, array5(i)) + i = i + 1 + END DO + ! Trigger end of file aborting + IF (my_end .AND. (i <= dim)) & + CALL cp_abort(__LOCATION__, & + "End of file while reading section "//TRIM(section)//" in amber topology file!") + END SUBROUTINE rd_amber_section_i5 ! ************************************************************************************************** !> \brief Set of Low level subroutines reading section for parmtop @@ -1216,7 +1215,7 @@ END SUBROUTINE rd_amber_section_i5 !> \param dim ... !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008 ! ************************************************************************************************** - SUBROUTINE rd_amber_section_c1(parser, section, array1, dim) + SUBROUTINE rd_amber_section_c1(parser, section, array1, dim) TYPE(cp_parser_type), POINTER :: parser CHARACTER(LEN=default_string_length), INTENT(IN) :: section CHARACTER(LEN=default_string_length), DIMENSION(:) :: array1 @@ -1228,20 +1227,20 @@ SUBROUTINE rd_amber_section_c1(parser, section, array1, dim) INTEGER :: i LOGICAL :: my_end - CALL parser_get_next_line(parser,1,at_end=my_end) - i = 1 - DO WHILE ((i<=dim).AND.(.NOT.my_end)) - IF (parser_test_next_token(parser)=="EOL")& - CALL parser_get_next_line(parser,1,at_end=my_end) - IF (my_end) EXIT - CALL parser_get_object(parser,array1(i),lower_to_upper=.TRUE.) - i = i + 1 - END DO - ! Trigger end of file aborting - IF(my_end.AND.(i<=dim))& - CALL cp_abort(__LOCATION__,& - "End of file while reading section "//TRIM(section)//" in amber topology file!") - END SUBROUTINE rd_amber_section_c1 + CALL parser_get_next_line(parser, 1, at_end=my_end) + i = 1 + DO WHILE ((i <= dim) .AND. (.NOT. my_end)) + IF (parser_test_next_token(parser) == "EOL") & + CALL parser_get_next_line(parser, 1, at_end=my_end) + IF (my_end) EXIT + CALL parser_get_object(parser, array1(i), lower_to_upper=.TRUE.) + i = i + 1 + END DO + ! Trigger end of file aborting + IF (my_end .AND. (i <= dim)) & + CALL cp_abort(__LOCATION__, & + "End of file while reading section "//TRIM(section)//" in amber topology file!") + END SUBROUTINE rd_amber_section_c1 ! ************************************************************************************************** !> \brief Set of Low level subroutines reading section for parmtop @@ -1252,7 +1251,7 @@ END SUBROUTINE rd_amber_section_c1 !> \param dim ... !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008 ! ************************************************************************************************** - SUBROUTINE rd_amber_section_r1(parser, section, array1, dim) + SUBROUTINE rd_amber_section_r1(parser, section, array1, dim) TYPE(cp_parser_type), POINTER :: parser CHARACTER(LEN=default_string_length), INTENT(IN) :: section REAL(KIND=dp), DIMENSION(:) :: array1 @@ -1264,20 +1263,20 @@ SUBROUTINE rd_amber_section_r1(parser, section, array1, dim) INTEGER :: i LOGICAL :: my_end - CALL parser_get_next_line(parser,1,at_end=my_end) - i = 1 - DO WHILE ((i<=dim).AND.(.NOT.my_end)) - IF (parser_test_next_token(parser)=="EOL")& - CALL parser_get_next_line(parser,1,at_end=my_end) - IF (my_end) EXIT - CALL parser_get_object(parser,array1(i)) - i = i + 1 - END DO - ! Trigger end of file aborting - IF(my_end.AND.(i<=dim))& - CALL cp_abort(__LOCATION__,& - "End of file while reading section "//TRIM(section)//" in amber topology file!") - END SUBROUTINE rd_amber_section_r1 + CALL parser_get_next_line(parser, 1, at_end=my_end) + i = 1 + DO WHILE ((i <= dim) .AND. (.NOT. my_end)) + IF (parser_test_next_token(parser) == "EOL") & + CALL parser_get_next_line(parser, 1, at_end=my_end) + IF (my_end) EXIT + CALL parser_get_object(parser, array1(i)) + i = i + 1 + END DO + ! Trigger end of file aborting + IF (my_end .AND. (i <= dim)) & + CALL cp_abort(__LOCATION__, & + "End of file while reading section "//TRIM(section)//" in amber topology file!") + END SUBROUTINE rd_amber_section_r1 ! ************************************************************************************************** !> \brief Check the version of the AMBER topology file (we can handle from v8 on) @@ -1287,7 +1286,7 @@ END SUBROUTINE rd_amber_section_r1 !> \return ... !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008 ! ************************************************************************************************** - FUNCTION get_section_parmtop(parser, section, input_format) RESULT(another_section) + FUNCTION get_section_parmtop(parser, section, input_format) RESULT(another_section) TYPE(cp_parser_type), POINTER :: parser CHARACTER(LEN=default_string_length), INTENT(OUT) :: section, input_format LOGICAL :: another_section @@ -1298,27 +1297,27 @@ FUNCTION get_section_parmtop(parser, section, input_format) RESULT(another_sect INTEGER :: end_f, indflag, start_f LOGICAL :: found, my_end - CALL parser_search_string(parser,"%FLAG",.TRUE.,found,begin_line=.TRUE.) - IF (found) THEN - ! section label - indflag = INDEX(parser%input_line,"%FLAG")+LEN_TRIM("%FLAG") - DO WHILE (INDEX(parser%input_line(indflag:indflag)," ") /= 0) - indflag = indflag + 1 - END DO - section = TRIM(parser%input_line(indflag:)) - ! Input format - CALL parser_get_next_line(parser,1,at_end=my_end) - IF(INDEX(parser%input_line,"%FORMAT")==0 .OR. my_end)& - CPABORT("Expecting %FORMAT. Not found! Abort reading of AMBER topology file!") - - start_f = INDEX(parser%input_line,"(") - end_f = INDEX(parser%input_line,")") - input_format = parser%input_line(start_f:end_f) - another_section = .TRUE. - ELSE - another_section = .FALSE. - END IF - END FUNCTION get_section_parmtop + CALL parser_search_string(parser, "%FLAG", .TRUE., found, begin_line=.TRUE.) + IF (found) THEN + ! section label + indflag = INDEX(parser%input_line, "%FLAG") + LEN_TRIM("%FLAG") + DO WHILE (INDEX(parser%input_line(indflag:indflag), " ") /= 0) + indflag = indflag + 1 + END DO + section = TRIM(parser%input_line(indflag:)) + ! Input format + CALL parser_get_next_line(parser, 1, at_end=my_end) + IF (INDEX(parser%input_line, "%FORMAT") == 0 .OR. my_end) & + CPABORT("Expecting %FORMAT. Not found! Abort reading of AMBER topology file!") + + start_f = INDEX(parser%input_line, "(") + end_f = INDEX(parser%input_line, ")") + input_format = parser%input_line(start_f:end_f) + another_section = .TRUE. + ELSE + another_section = .FALSE. + END IF + END FUNCTION get_section_parmtop ! ************************************************************************************************** !> \brief Check the version of the AMBER topology file (we can handle from v8 on) @@ -1327,7 +1326,7 @@ END FUNCTION get_section_parmtop !> \return ... !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008 ! ************************************************************************************************** - FUNCTION check_amber_8_std(parser, output_unit) RESULT(found_AMBER_V8) + FUNCTION check_amber_8_std(parser, output_unit) RESULT(found_AMBER_V8) TYPE(cp_parser_type), POINTER :: parser INTEGER, INTENT(IN) :: output_unit LOGICAL :: found_AMBER_V8 @@ -1335,15 +1334,15 @@ FUNCTION check_amber_8_std(parser, output_unit) RESULT(found_AMBER_V8) CHARACTER(len=*), PARAMETER :: routineN = 'check_amber_8_std', & routineP = moduleN//':'//routineN - CALL parser_search_string(parser,"%VERSION ",.TRUE.,found_AMBER_V8,begin_line=.TRUE.) - IF(.NOT.found_AMBER_V8)& - CALL cp_abort(__LOCATION__,& - "This is not an AMBER V.8 PRMTOP format file. Cannot interpret older "//& - "AMBER file formats. ") - IF (output_unit>0) WRITE(output_unit,'(" AMBER_INFO| ",A)')"Amber PrmTop V.8 or greater.",& + CALL parser_search_string(parser, "%VERSION ", .TRUE., found_AMBER_V8, begin_line=.TRUE.) + IF (.NOT. found_AMBER_V8) & + CALL cp_abort(__LOCATION__, & + "This is not an AMBER V.8 PRMTOP format file. Cannot interpret older "// & + "AMBER file formats. ") + IF (output_unit > 0) WRITE (output_unit, '(" AMBER_INFO| ",A)') "Amber PrmTop V.8 or greater.", & TRIM(parser%input_line) - END FUNCTION check_amber_8_std + END FUNCTION check_amber_8_std ! ************************************************************************************************** !> \brief Post processing of forcefield information related to bonds @@ -1361,8 +1360,8 @@ END FUNCTION check_amber_8_std !> \param req ... !> \author Teodoro Laino [tlaino] - 11.2008 ! ************************************************************************************************** - SUBROUTINE post_process_bonds_info(label_a, label_b, k, r0, particle_set, ibond, & - nbond, ib, jb, icb, rk, req) + SUBROUTINE post_process_bonds_info(label_a, label_b, k, r0, particle_set, ibond, & + nbond, ib, jb, icb, rk, req) CHARACTER(LEN=default_string_length), & DIMENSION(:), POINTER :: label_a, label_b REAL(KIND=dp), DIMENSION(:), POINTER :: k, r0 @@ -1382,55 +1381,55 @@ SUBROUTINE post_process_bonds_info(label_a, label_b, k, r0, particle_set, ibond, INTEGER, ALLOCATABLE, DIMENSION(:) :: iwork LOGICAL :: l_dum - CALL timeset(routineN, handle) - IF (nbond/=0) THEN - ALLOCATE(work_label(2,nbond)) - ALLOCATE(iwork(nbond)) - DO i = 1, nbond - name_atm_a = particle_set(ib(i))%atomic_kind%name - name_atm_b = particle_set(jb(i))%atomic_kind%name - l_dum = qmmm_ff_precond_only_qm(id1=name_atm_a, id2=name_atm_b) - work_label(1,i) = name_atm_a - work_label(2,i) = name_atm_b - END DO - CALL sort(work_label, 1, nbond, 1, 2, iwork) - - ibond = ibond + 1 - ! In case we need more space ... give it up... - IF (ibond>SIZE(label_a)) THEN - CALL reallocate(label_a, 1,INT(buffer_size+ibond*1.5_dp)) - CALL reallocate(label_b, 1,INT(buffer_size+ibond*1.5_dp)) - CALL reallocate(k, 1,INT(buffer_size+ibond*1.5_dp)) - CALL reallocate(r0,1,INT(buffer_size+ibond*1.5_dp)) - END IF - label_a(ibond) = work_label(1,1) - label_b(ibond) = work_label(2,1) - k(ibond) = rk (icb(iwork(1))) - r0(ibond) = req(icb(iwork(1))) - - DO i = 2, nbond - IF ((work_label(1,i)/=label_a(ibond)).OR.& - (work_label(2,i)/=label_b(ibond))) THEN - ibond = ibond + 1 - ! In case we need more space ... give it up... - IF (ibond>SIZE(label_a)) THEN - CALL reallocate(label_a, 1,INT(buffer_size+ibond*1.5_dp)) - CALL reallocate(label_b, 1,INT(buffer_size+ibond*1.5_dp)) - CALL reallocate(k, 1,INT(buffer_size+ibond*1.5_dp)) - CALL reallocate(r0,1,INT(buffer_size+ibond*1.5_dp)) - END IF - label_a(ibond) = work_label(1,i) - label_b(ibond) = work_label(2,i) - k(ibond) = rk(icb(iwork(i))) - r0(ibond) = req(icb(iwork(i))) - END IF - END DO - - DEALLOCATE(work_label) - DEALLOCATE(iwork) - END IF - CALL timestop(handle) - END SUBROUTINE post_process_bonds_info + CALL timeset(routineN, handle) + IF (nbond /= 0) THEN + ALLOCATE (work_label(2, nbond)) + ALLOCATE (iwork(nbond)) + DO i = 1, nbond + name_atm_a = particle_set(ib(i))%atomic_kind%name + name_atm_b = particle_set(jb(i))%atomic_kind%name + l_dum = qmmm_ff_precond_only_qm(id1=name_atm_a, id2=name_atm_b) + work_label(1, i) = name_atm_a + work_label(2, i) = name_atm_b + END DO + CALL sort(work_label, 1, nbond, 1, 2, iwork) + + ibond = ibond + 1 + ! In case we need more space ... give it up... + IF (ibond > SIZE(label_a)) THEN + CALL reallocate(label_a, 1, INT(buffer_size + ibond*1.5_dp)) + CALL reallocate(label_b, 1, INT(buffer_size + ibond*1.5_dp)) + CALL reallocate(k, 1, INT(buffer_size + ibond*1.5_dp)) + CALL reallocate(r0, 1, INT(buffer_size + ibond*1.5_dp)) + END IF + label_a(ibond) = work_label(1, 1) + label_b(ibond) = work_label(2, 1) + k(ibond) = rk(icb(iwork(1))) + r0(ibond) = req(icb(iwork(1))) + + DO i = 2, nbond + IF ((work_label(1, i) /= label_a(ibond)) .OR. & + (work_label(2, i) /= label_b(ibond))) THEN + ibond = ibond + 1 + ! In case we need more space ... give it up... + IF (ibond > SIZE(label_a)) THEN + CALL reallocate(label_a, 1, INT(buffer_size + ibond*1.5_dp)) + CALL reallocate(label_b, 1, INT(buffer_size + ibond*1.5_dp)) + CALL reallocate(k, 1, INT(buffer_size + ibond*1.5_dp)) + CALL reallocate(r0, 1, INT(buffer_size + ibond*1.5_dp)) + END IF + label_a(ibond) = work_label(1, i) + label_b(ibond) = work_label(2, i) + k(ibond) = rk(icb(iwork(i))) + r0(ibond) = req(icb(iwork(i))) + END IF + END DO + + DEALLOCATE (work_label) + DEALLOCATE (iwork) + END IF + CALL timestop(handle) + END SUBROUTINE post_process_bonds_info ! ************************************************************************************************** !> \brief Post processing of forcefield information related to bends @@ -1450,8 +1449,8 @@ END SUBROUTINE post_process_bonds_info !> \param teq ... !> \author Teodoro Laino [tlaino] - 11.2008 ! ************************************************************************************************** - SUBROUTINE post_process_bends_info(label_a, label_b, label_c, k, theta0, & - particle_set, itheta, ntheta, it, jt, kt, ict, tk, teq) + SUBROUTINE post_process_bends_info(label_a, label_b, label_c, k, theta0, & + particle_set, itheta, ntheta, it, jt, kt, ict, tk, teq) CHARACTER(LEN=default_string_length), & DIMENSION(:), POINTER :: label_a, label_b, label_c REAL(KIND=dp), DIMENSION(:), POINTER :: k, theta0 @@ -1471,64 +1470,64 @@ SUBROUTINE post_process_bends_info(label_a, label_b, label_c, k, theta0, & INTEGER, ALLOCATABLE, DIMENSION(:) :: iwork LOGICAL :: l_dum - CALL timeset(routineN,handle) - IF (ntheta/=0) THEN - ALLOCATE(work_label(3,ntheta)) - ALLOCATE(iwork(ntheta)) - DO i = 1, ntheta - name_atm_a = particle_set(it(i))%atomic_kind%name - name_atm_b = particle_set(jt(i))%atomic_kind%name - name_atm_c = particle_set(kt(i))%atomic_kind%name - l_dum = qmmm_ff_precond_only_qm(id1=name_atm_a, id2=name_atm_b,& - id3=name_atm_c) - work_label(1,i) = name_atm_a - work_label(2,i) = name_atm_b - work_label(3,i) = name_atm_c - END DO - - CALL sort(work_label, 1, ntheta, 1, 3, iwork) - - itheta = itheta + 1 - ! In case we need more space ... give it up... - IF (itheta>SIZE(label_a)) THEN - CALL reallocate(label_a, 1,INT(buffer_size+itheta*1.5_dp)) - CALL reallocate(label_b, 1,INT(buffer_size+itheta*1.5_dp)) - CALL reallocate(label_c, 1,INT(buffer_size+itheta*1.5_dp)) - CALL reallocate(k, 1,INT(buffer_size+itheta*1.5_dp)) - CALL reallocate(theta0,1,INT(buffer_size+itheta*1.5_dp)) - END IF - label_a(itheta) = work_label(1,1) - label_b(itheta) = work_label(2,1) - label_c(itheta) = work_label(3,1) - k(itheta) = tk (ict(iwork(1))) - theta0(itheta) = teq(ict(iwork(1))) - - DO i = 2, ntheta - IF ((work_label(1,i)/=label_a(itheta)).OR.& - (work_label(2,i)/=label_b(itheta)).OR.& - (work_label(3,i)/=label_c(itheta))) THEN - itheta = itheta + 1 - ! In case we need more space ... give it up... - IF (itheta>SIZE(label_a)) THEN - CALL reallocate(label_a, 1,INT(buffer_size+itheta*1.5_dp)) - CALL reallocate(label_b, 1,INT(buffer_size+itheta*1.5_dp)) - CALL reallocate(label_c, 1,INT(buffer_size+itheta*1.5_dp)) - CALL reallocate(k, 1,INT(buffer_size+itheta*1.5_dp)) - CALL reallocate(theta0,1,INT(buffer_size+itheta*1.5_dp)) - END IF - label_a(itheta) = work_label(1,i) - label_b(itheta) = work_label(2,i) - label_c(itheta) = work_label(3,i) - k(itheta) = tk (ict(iwork(i))) - theta0(itheta) = teq(ict(iwork(i))) - END IF - END DO - - DEALLOCATE(work_label) - DEALLOCATE(iwork) - END IF - CALL timestop(handle) - END SUBROUTINE post_process_bends_info + CALL timeset(routineN, handle) + IF (ntheta /= 0) THEN + ALLOCATE (work_label(3, ntheta)) + ALLOCATE (iwork(ntheta)) + DO i = 1, ntheta + name_atm_a = particle_set(it(i))%atomic_kind%name + name_atm_b = particle_set(jt(i))%atomic_kind%name + name_atm_c = particle_set(kt(i))%atomic_kind%name + l_dum = qmmm_ff_precond_only_qm(id1=name_atm_a, id2=name_atm_b, & + id3=name_atm_c) + work_label(1, i) = name_atm_a + work_label(2, i) = name_atm_b + work_label(3, i) = name_atm_c + END DO + + CALL sort(work_label, 1, ntheta, 1, 3, iwork) + + itheta = itheta + 1 + ! In case we need more space ... give it up... + IF (itheta > SIZE(label_a)) THEN + CALL reallocate(label_a, 1, INT(buffer_size + itheta*1.5_dp)) + CALL reallocate(label_b, 1, INT(buffer_size + itheta*1.5_dp)) + CALL reallocate(label_c, 1, INT(buffer_size + itheta*1.5_dp)) + CALL reallocate(k, 1, INT(buffer_size + itheta*1.5_dp)) + CALL reallocate(theta0, 1, INT(buffer_size + itheta*1.5_dp)) + END IF + label_a(itheta) = work_label(1, 1) + label_b(itheta) = work_label(2, 1) + label_c(itheta) = work_label(3, 1) + k(itheta) = tk(ict(iwork(1))) + theta0(itheta) = teq(ict(iwork(1))) + + DO i = 2, ntheta + IF ((work_label(1, i) /= label_a(itheta)) .OR. & + (work_label(2, i) /= label_b(itheta)) .OR. & + (work_label(3, i) /= label_c(itheta))) THEN + itheta = itheta + 1 + ! In case we need more space ... give it up... + IF (itheta > SIZE(label_a)) THEN + CALL reallocate(label_a, 1, INT(buffer_size + itheta*1.5_dp)) + CALL reallocate(label_b, 1, INT(buffer_size + itheta*1.5_dp)) + CALL reallocate(label_c, 1, INT(buffer_size + itheta*1.5_dp)) + CALL reallocate(k, 1, INT(buffer_size + itheta*1.5_dp)) + CALL reallocate(theta0, 1, INT(buffer_size + itheta*1.5_dp)) + END IF + label_a(itheta) = work_label(1, i) + label_b(itheta) = work_label(2, i) + label_c(itheta) = work_label(3, i) + k(itheta) = tk(ict(iwork(i))) + theta0(itheta) = teq(ict(iwork(i))) + END IF + END DO + + DEALLOCATE (work_label) + DEALLOCATE (iwork) + END IF + CALL timestop(handle) + END SUBROUTINE post_process_bends_info ! ************************************************************************************************** !> \brief Post processing of forcefield information related to torsions @@ -1552,8 +1551,8 @@ END SUBROUTINE post_process_bends_info !> \param phase ... !> \author Teodoro Laino [tlaino] - 11.2008 ! ************************************************************************************************** - SUBROUTINE post_process_torsions_info(label_a, label_b, label_c, label_d, k,& - m, phi0, particle_set, iphi, nphi, ip, jp, kp, lp, icp, pk, pn, phase) + SUBROUTINE post_process_torsions_info(label_a, label_b, label_c, label_d, k, & + m, phi0, particle_set, iphi, nphi, ip, jp, kp, lp, icp, pk, pn, phase) CHARACTER(LEN=default_string_length), & DIMENSION(:), POINTER :: label_a, label_b, label_c, label_d REAL(KIND=dp), DIMENSION(:), POINTER :: k @@ -1576,93 +1575,93 @@ SUBROUTINE post_process_torsions_info(label_a, label_b, label_c, label_d, k,& INTEGER, ALLOCATABLE, DIMENSION(:) :: iwork LOGICAL :: l_dum - CALL timeset(routineN, handle) - IF (nphi/=0) THEN - ALLOCATE(work_label(6,nphi)) - ALLOCATE(iwork(nphi)) - DO i = 1, nphi - name_atm_a = particle_set(ip(i))%atomic_kind%name - name_atm_b = particle_set(jp(i))%atomic_kind%name - name_atm_c = particle_set(kp(i))%atomic_kind%name - name_atm_d = particle_set(lp(i))%atomic_kind%name - l_dum = qmmm_ff_precond_only_qm(id1=name_atm_a, id2=name_atm_b,& - id3=name_atm_c, id4=name_atm_d) - work_label(1,i) = name_atm_a - work_label(2,i) = name_atm_b - work_label(3,i) = name_atm_c - work_label(4,i) = name_atm_d - ! Phase and multiplicity must be kept into account - ! for the ordering of the torsions - work_label(5,i) = TRIM(ADJUSTL(cp_to_string(phase(icp(i))))) - work_label(6,i) = TRIM(ADJUSTL(cp_to_string(pn(icp(i))))) - END DO - - CALL sort(work_label, 1, nphi, 1, 6, iwork) - - iphi = iphi + 1 - ! In case we need more space ... give it up... - IF (iphi>SIZE(label_a)) THEN - CALL reallocate(label_a, 1,INT(buffer_size+iphi*1.5_dp)) - CALL reallocate(label_b, 1,INT(buffer_size+iphi*1.5_dp)) - CALL reallocate(label_c, 1,INT(buffer_size+iphi*1.5_dp)) - CALL reallocate(label_d, 1,INT(buffer_size+iphi*1.5_dp)) - CALL reallocate(k, 1, INT(buffer_size+iphi*1.5_dp)) - CALL reallocate(m, 1, INT(buffer_size+iphi*1.5_dp)) - CALL reallocate(phi0,1,INT(buffer_size+iphi*1.5_dp)) - END IF - label_a(iphi) = work_label(1,1) - label_b(iphi) = work_label(2,1) - label_c(iphi) = work_label(3,1) - label_d(iphi) = work_label(4,1) - k(iphi) = pk (icp(iwork(1)))*0.5_dp - m(iphi) = NINT(pn (icp(iwork(1)))) - IF (m(iphi)-pn (icp(iwork(1))).GT.EPSILON(1.0_dp)) THEN - ! non integer torsions not supported - CPABORT("") - ENDIF - - phi0(iphi) = phase(icp(iwork(1))) - - DO i = 2, nphi - ! We don't consider the possibility that a torsion can have same - ! phase, periodicity but different value of k.. in this case the - ! potential should be summed-up - IF ((work_label(1,i)/=label_a(iphi)).OR.& - (work_label(2,i)/=label_b(iphi)).OR.& - (work_label(3,i)/=label_c(iphi)).OR.& - (work_label(4,i)/=label_d(iphi)).OR.& - (pn(icp(iwork(i)))/=m(iphi)) .OR.& - (phase(icp(iwork(i)))/=phi0(iphi))) THEN - iphi = iphi + 1 - ! In case we need more space ... give it up... - IF (iphi>SIZE(label_a)) THEN - CALL reallocate(label_a, 1,INT(buffer_size+iphi*1.5_dp)) - CALL reallocate(label_b, 1,INT(buffer_size+iphi*1.5_dp)) - CALL reallocate(label_c, 1,INT(buffer_size+iphi*1.5_dp)) - CALL reallocate(label_d, 1,INT(buffer_size+iphi*1.5_dp)) - CALL reallocate(k, 1,INT(buffer_size+iphi*1.5_dp)) - CALL reallocate(m, 1,INT(buffer_size+iphi*1.5_dp)) - CALL reallocate(phi0,1,INT(buffer_size+iphi*1.5_dp)) - END IF - label_a(iphi) = work_label(1,i) - label_b(iphi) = work_label(2,i) - label_c(iphi) = work_label(3,i) - label_d(iphi) = work_label(4,i) - k(iphi) = pk (icp(iwork(i)))*0.5_dp - m(iphi) = NINT(pn (icp(iwork(i)))) - IF (m(iphi)-pn (icp(iwork(i))).GT.EPSILON(1.0_dp)) THEN - ! non integer torsions not supported - CPABORT("") - ENDIF - phi0(iphi) = phase(icp(iwork(i))) - END IF - END DO - - DEALLOCATE(work_label) - DEALLOCATE(iwork) - END IF - CALL timestop(handle) - END SUBROUTINE post_process_torsions_info + CALL timeset(routineN, handle) + IF (nphi /= 0) THEN + ALLOCATE (work_label(6, nphi)) + ALLOCATE (iwork(nphi)) + DO i = 1, nphi + name_atm_a = particle_set(ip(i))%atomic_kind%name + name_atm_b = particle_set(jp(i))%atomic_kind%name + name_atm_c = particle_set(kp(i))%atomic_kind%name + name_atm_d = particle_set(lp(i))%atomic_kind%name + l_dum = qmmm_ff_precond_only_qm(id1=name_atm_a, id2=name_atm_b, & + id3=name_atm_c, id4=name_atm_d) + work_label(1, i) = name_atm_a + work_label(2, i) = name_atm_b + work_label(3, i) = name_atm_c + work_label(4, i) = name_atm_d + ! Phase and multiplicity must be kept into account + ! for the ordering of the torsions + work_label(5, i) = TRIM(ADJUSTL(cp_to_string(phase(icp(i))))) + work_label(6, i) = TRIM(ADJUSTL(cp_to_string(pn(icp(i))))) + END DO + + CALL sort(work_label, 1, nphi, 1, 6, iwork) + + iphi = iphi + 1 + ! In case we need more space ... give it up... + IF (iphi > SIZE(label_a)) THEN + CALL reallocate(label_a, 1, INT(buffer_size + iphi*1.5_dp)) + CALL reallocate(label_b, 1, INT(buffer_size + iphi*1.5_dp)) + CALL reallocate(label_c, 1, INT(buffer_size + iphi*1.5_dp)) + CALL reallocate(label_d, 1, INT(buffer_size + iphi*1.5_dp)) + CALL reallocate(k, 1, INT(buffer_size + iphi*1.5_dp)) + CALL reallocate(m, 1, INT(buffer_size + iphi*1.5_dp)) + CALL reallocate(phi0, 1, INT(buffer_size + iphi*1.5_dp)) + END IF + label_a(iphi) = work_label(1, 1) + label_b(iphi) = work_label(2, 1) + label_c(iphi) = work_label(3, 1) + label_d(iphi) = work_label(4, 1) + k(iphi) = pk(icp(iwork(1)))*0.5_dp + m(iphi) = NINT(pn(icp(iwork(1)))) + IF (m(iphi) - pn(icp(iwork(1))) .GT. EPSILON(1.0_dp)) THEN + ! non integer torsions not supported + CPABORT("") + ENDIF + + phi0(iphi) = phase(icp(iwork(1))) + + DO i = 2, nphi + ! We don't consider the possibility that a torsion can have same + ! phase, periodicity but different value of k.. in this case the + ! potential should be summed-up + IF ((work_label(1, i) /= label_a(iphi)) .OR. & + (work_label(2, i) /= label_b(iphi)) .OR. & + (work_label(3, i) /= label_c(iphi)) .OR. & + (work_label(4, i) /= label_d(iphi)) .OR. & + (pn(icp(iwork(i))) /= m(iphi)) .OR. & + (phase(icp(iwork(i))) /= phi0(iphi))) THEN + iphi = iphi + 1 + ! In case we need more space ... give it up... + IF (iphi > SIZE(label_a)) THEN + CALL reallocate(label_a, 1, INT(buffer_size + iphi*1.5_dp)) + CALL reallocate(label_b, 1, INT(buffer_size + iphi*1.5_dp)) + CALL reallocate(label_c, 1, INT(buffer_size + iphi*1.5_dp)) + CALL reallocate(label_d, 1, INT(buffer_size + iphi*1.5_dp)) + CALL reallocate(k, 1, INT(buffer_size + iphi*1.5_dp)) + CALL reallocate(m, 1, INT(buffer_size + iphi*1.5_dp)) + CALL reallocate(phi0, 1, INT(buffer_size + iphi*1.5_dp)) + END IF + label_a(iphi) = work_label(1, i) + label_b(iphi) = work_label(2, i) + label_c(iphi) = work_label(3, i) + label_d(iphi) = work_label(4, i) + k(iphi) = pk(icp(iwork(i)))*0.5_dp + m(iphi) = NINT(pn(icp(iwork(i)))) + IF (m(iphi) - pn(icp(iwork(i))) .GT. EPSILON(1.0_dp)) THEN + ! non integer torsions not supported + CPABORT("") + ENDIF + phi0(iphi) = phase(icp(iwork(i))) + END IF + END DO + + DEALLOCATE (work_label) + DEALLOCATE (iwork) + END IF + CALL timestop(handle) + END SUBROUTINE post_process_torsions_info ! ************************************************************************************************** !> \brief Post processing of forcefield information related to Lennard-Jones @@ -1679,8 +1678,8 @@ END SUBROUTINE post_process_torsions_info !> \param natom ... !> \author Teodoro Laino [tlaino] - 11.2008 ! ************************************************************************************************** - SUBROUTINE post_process_LJ_info(atom_label, eps, sigma, particle_set,& - ntypes, nsize, iac, ico, cn1, cn2, natom) + SUBROUTINE post_process_LJ_info(atom_label, eps, sigma, particle_set, & + ntypes, nsize, iac, ico, cn1, cn2, natom) CHARACTER(LEN=default_string_length), & DIMENSION(:), POINTER :: atom_label REAL(KIND=dp), DIMENSION(:), POINTER :: eps, sigma @@ -1702,67 +1701,67 @@ SUBROUTINE post_process_LJ_info(atom_label, eps, sigma, particle_set,& LOGICAL :: check, l_dum REAL(KIND=dp) :: F12, F6, my_eps, my_sigma, sigma6 - CALL timeset(routineN, handle) - ALLOCATE(work_label(natom)) - ALLOCATE(iwork(natom)) - DO i = 1, natom - name_atm_a = particle_set(i)%atomic_kind%name - l_dum = qmmm_ff_precond_only_qm(id1=name_atm_a) - work_label(i) = name_atm_a - END DO - CALL sort(work_label, natom, iwork) - - nsize = nsize + 1 - IF (nsize>SIZE(atom_label)) THEN - CALL reallocate(atom_label, 1, INT(buffer_size+nsize*1.5_dp)) - CALL reallocate(eps, 1, INT(buffer_size+nsize*1.5_dp)) - CALL reallocate(sigma, 1, INT(buffer_size+nsize*1.5_dp)) - END IF - F12 = cn1( ico(ntypes*(iac(iwork(1))-1) + iac(iwork(1)))) - F6 = cn2( ico(ntypes*(iac(iwork(1))-1) + iac(iwork(1)))) - check = (F6==0.0_dp).EQV.(F12==0.0_dp) - CPASSERT(check) - my_sigma = 0.0_dp - my_eps = 0.0_dp - IF (F6/=0.0_dp) THEN - sigma6 = (2.0_dp*F12/F6) - my_sigma = sigma6**(1.0_dp/6.0_dp) - my_eps = F6/(2.0_dp*sigma6) - END IF - atom_label(nsize) = work_label(1) - sigma(nsize) = my_sigma/2.0_dp - eps(nsize) = my_eps - - DO i = 2, natom - IF (work_label(i)/=atom_label(nsize)) THEN - nsize = nsize + 1 - ! In case we need more space ... give it up... - IF (nsize>SIZE(atom_label)) THEN - CALL reallocate(atom_label, 1, INT(buffer_size+nsize*1.5_dp)) - CALL reallocate(eps, 1, INT(buffer_size+nsize*1.5_dp)) - CALL reallocate(sigma, 1, INT(buffer_size+nsize*1.5_dp)) - END IF - F12 = cn1( ico(ntypes*(iac(iwork(i))-1) + iac(iwork(i)))) - F6 = cn2( ico(ntypes*(iac(iwork(i))-1) + iac(iwork(i)))) - check = (F6==0.0_dp).EQV.(F12==0.0_dp) - CPASSERT(check) - my_sigma = 0.0_dp - my_eps = 0.0_dp - IF (F6/=0.0_dp) THEN - sigma6 = (2.0_dp*F12/F6) - my_sigma = sigma6**(1.0_dp/6.0_dp) - my_eps = F6/(2.0_dp*sigma6) - END IF - atom_label(nsize) = work_label(i) - sigma(nsize) = my_sigma/2.0_dp - eps(nsize) = my_eps - END IF - END DO - - DEALLOCATE(work_label) - DEALLOCATE(iwork) - CALL timestop(handle) - END SUBROUTINE post_process_LJ_info + CALL timeset(routineN, handle) + ALLOCATE (work_label(natom)) + ALLOCATE (iwork(natom)) + DO i = 1, natom + name_atm_a = particle_set(i)%atomic_kind%name + l_dum = qmmm_ff_precond_only_qm(id1=name_atm_a) + work_label(i) = name_atm_a + END DO + CALL sort(work_label, natom, iwork) + + nsize = nsize + 1 + IF (nsize > SIZE(atom_label)) THEN + CALL reallocate(atom_label, 1, INT(buffer_size + nsize*1.5_dp)) + CALL reallocate(eps, 1, INT(buffer_size + nsize*1.5_dp)) + CALL reallocate(sigma, 1, INT(buffer_size + nsize*1.5_dp)) + END IF + F12 = cn1(ico(ntypes*(iac(iwork(1)) - 1) + iac(iwork(1)))) + F6 = cn2(ico(ntypes*(iac(iwork(1)) - 1) + iac(iwork(1)))) + check = (F6 == 0.0_dp) .EQV. (F12 == 0.0_dp) + CPASSERT(check) + my_sigma = 0.0_dp + my_eps = 0.0_dp + IF (F6 /= 0.0_dp) THEN + sigma6 = (2.0_dp*F12/F6) + my_sigma = sigma6**(1.0_dp/6.0_dp) + my_eps = F6/(2.0_dp*sigma6) + END IF + atom_label(nsize) = work_label(1) + sigma(nsize) = my_sigma/2.0_dp + eps(nsize) = my_eps + + DO i = 2, natom + IF (work_label(i) /= atom_label(nsize)) THEN + nsize = nsize + 1 + ! In case we need more space ... give it up... + IF (nsize > SIZE(atom_label)) THEN + CALL reallocate(atom_label, 1, INT(buffer_size + nsize*1.5_dp)) + CALL reallocate(eps, 1, INT(buffer_size + nsize*1.5_dp)) + CALL reallocate(sigma, 1, INT(buffer_size + nsize*1.5_dp)) + END IF + F12 = cn1(ico(ntypes*(iac(iwork(i)) - 1) + iac(iwork(i)))) + F6 = cn2(ico(ntypes*(iac(iwork(i)) - 1) + iac(iwork(i)))) + check = (F6 == 0.0_dp) .EQV. (F12 == 0.0_dp) + CPASSERT(check) + my_sigma = 0.0_dp + my_eps = 0.0_dp + IF (F6 /= 0.0_dp) THEN + sigma6 = (2.0_dp*F12/F6) + my_sigma = sigma6**(1.0_dp/6.0_dp) + my_eps = F6/(2.0_dp*sigma6) + END IF + atom_label(nsize) = work_label(i) + sigma(nsize) = my_sigma/2.0_dp + eps(nsize) = my_eps + END IF + END DO + + DEALLOCATE (work_label) + DEALLOCATE (iwork) + CALL timestop(handle) + END SUBROUTINE post_process_LJ_info END MODULE topology_amber diff --git a/src/topology_cif.F b/src/topology_cif.F index 69a503f40c..7cb4c7e94d 100644 --- a/src/topology_cif.F +++ b/src/topology_cif.F @@ -164,7 +164,7 @@ SUBROUTINE read_coordinate_cif(topology, para_env, subsys_section) ifield(ii) = 0 CALL parser_get_next_line(parser, 1) DO WHILE (INDEX(parser%input_line, "_atom_site_") /= 0) - ii = ii+1 + ii = ii + 1 CPASSERT(ii <= 20) ifield(ii) = -1 @@ -181,7 +181,7 @@ SUBROUTINE read_coordinate_cif(topology, para_env, subsys_section) ! Parse real info natom = 0 DO WHILE ((INDEX(parser%input_line, "loop_") == 0) .AND. (parser%input_line(1:1) /= "_")) - natom = natom+1 + natom = natom + 1 ! Resize in case needed IF (natom > SIZE(atom_info%id_molname)) THEN newsize = INT(pfactor*natom) @@ -199,7 +199,7 @@ SUBROUTINE read_coordinate_cif(topology, para_env, subsys_section) ii = 1 itype = 0 DO WHILE (ANY(ifield(ii:) > 0)) - SELECT CASE (ifield (ii)) + SELECT CASE (ifield(ii)) CASE (-1) ! Skip this field CALL parser_get_object(parser, s_tag) @@ -220,7 +220,7 @@ SUBROUTINE read_coordinate_cif(topology, para_env, subsys_section) ! Never reach this point.. CPABORT("") END SELECT - ii = ii+1 + ii = ii + 1 END DO s = atom_info%r(1:3, natom) CALL scaled_to_real(atom_info%r(1:3, natom), s, cell) @@ -231,9 +231,9 @@ SUBROUTINE read_coordinate_cif(topology, para_env, subsys_section) ! check since they should be REALLY unique.. anyway.. DO ii = 1, natom r1 = atom_info%r(1:3, ii) - DO jj = ii+1, natom + DO jj = ii + 1, natom r2 = atom_info%r(1:3, jj) - r = pbc(r1-r2, cell) + r = pbc(r1 - r2, cell) ! check = (SQRT(DOT_PRODUCT(r, r)) >= threshold) check = (DOT_PRODUCT(r, r) >= (threshold*threshold)) CPASSERT(check) @@ -267,25 +267,25 @@ SUBROUTINE read_coordinate_cif(topology, para_env, subsys_section) isym = 0 natom_orig = natom DO WHILE ((INDEX(parser%input_line, "loop_") == 0) .AND. (parser%input_line(1:1) /= "_")) - isym = isym+1 + isym = isym + 1 ! find seprator ' or " sep = "'" IF (INDEX(parser%input_line(1:), '"') > 0) sep = '"' iln0 = INDEX(parser%input_line(1:), sep) - iln1 = INDEX(parser%input_line(iln0+1:), ",")+iln0 - iln2 = INDEX(parser%input_line(iln1+1:), ",")+iln1 + iln1 = INDEX(parser%input_line(iln0 + 1:), ",") + iln0 + iln2 = INDEX(parser%input_line(iln1 + 1:), ",") + iln1 IF (iln0 == 0) THEN - iln3 = LEN_TRIM(parser%input_line)+1 + iln3 = LEN_TRIM(parser%input_line) + 1 ELSE - iln3 = INDEX(parser%input_line(iln2+1:), sep)+iln2 + iln3 = INDEX(parser%input_line(iln2 + 1:), sep) + iln2 END IF CPASSERT(iln1 /= 0) CPASSERT(iln2 /= iln1) CPASSERT(iln3 /= iln2) CALL initf(3) - CALL parsef(1, TRIM(parser%input_line(iln0+1:iln1-1)), s2a("x", "y", "z")) - CALL parsef(2, TRIM(parser%input_line(iln1+1:iln2-1)), s2a("x", "y", "z")) - CALL parsef(3, TRIM(parser%input_line(iln2+1:iln3-1)), s2a("x", "y", "z")) + CALL parsef(1, TRIM(parser%input_line(iln0 + 1:iln1 - 1)), s2a("x", "y", "z")) + CALL parsef(2, TRIM(parser%input_line(iln1 + 1:iln2 - 1)), s2a("x", "y", "z")) + CALL parsef(3, TRIM(parser%input_line(iln2 + 1:iln3 - 1)), s2a("x", "y", "z")) Loop_over_unique_atoms: DO ii = 1, natom_orig CALL real_to_scaled(s_tmp, atom_info%r(1:3, ii), cell) s(1) = evalf(1, (/s_tmp(1), s_tmp(2), s_tmp(3)/)) @@ -295,7 +295,7 @@ SUBROUTINE read_coordinate_cif(topology, para_env, subsys_section) check = .TRUE. DO jj = 1, natom r2 = atom_info%r(1:3, jj) - r = pbc(r1-r2, cell) + r = pbc(r1 - r2, cell) ! SQRT(DOT_PRODUCT(r, r)) <= threshold IF (DOT_PRODUCT(r, r) <= (threshold*threshold)) THEN check = .FALSE. @@ -304,7 +304,7 @@ SUBROUTINE read_coordinate_cif(topology, para_env, subsys_section) END DO ! If the atom generated is unique let's add to the atom set.. IF (check) THEN - natom = natom+1 + natom = natom + 1 ! Resize in case needed IF (natom > SIZE(atom_info%id_molname)) THEN newsize = INT(pfactor*natom) @@ -378,7 +378,7 @@ SUBROUTINE cif_get_real(parser, r) CALL parser_get_object(parser, s_tag) iln = LEN_TRIM(s_tag) - IF (INDEX(s_tag, "(") /= 0) iln = INDEX(s_tag, "(")-1 + IF (INDEX(s_tag, "(") /= 0) iln = INDEX(s_tag, "(") - 1 READ (s_tag(1:iln), *) r END SUBROUTINE cif_get_real diff --git a/src/topology_connectivity_util.F b/src/topology_connectivity_util.F index c177dce52e..f4f7b06c93 100644 --- a/src/topology_connectivity_util.F +++ b/src/topology_connectivity_util.F @@ -117,23 +117,23 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & map_atom_type = -1 map_atom_mol(1) = 1 map_atom_type(1) = 1 - DO i = 1, natom-1 - IF ((atom_info%map_mol_typ(i+1) /= atom_info%map_mol_typ(i)) .OR. & - ((atom_info%map_mol_res(i+1) /= atom_info%map_mol_res(i)) .AND. & + DO i = 1, natom - 1 + IF ((atom_info%map_mol_typ(i + 1) /= atom_info%map_mol_typ(i)) .OR. & + ((atom_info%map_mol_res(i + 1) /= atom_info%map_mol_res(i)) .AND. & (.NOT. (topology%conn_type == do_conn_user)))) THEN - topology%nmol_type = topology%nmol_type+1 + topology%nmol_type = topology%nmol_type + 1 END IF - map_atom_type(i+1) = topology%nmol_type - IF ((atom_info%map_mol_typ(i+1) /= atom_info%map_mol_typ(i)) .OR. & - (atom_info%map_mol_num(i+1) /= atom_info%map_mol_num(i)) .OR. & - (atom_info%map_mol_res(i+1) /= atom_info%map_mol_res(i))) THEN - topology%nmol = topology%nmol+1 + map_atom_type(i + 1) = topology%nmol_type + IF ((atom_info%map_mol_typ(i + 1) /= atom_info%map_mol_typ(i)) .OR. & + (atom_info%map_mol_num(i + 1) /= atom_info%map_mol_num(i)) .OR. & + (atom_info%map_mol_res(i + 1) /= atom_info%map_mol_res(i))) THEN + topology%nmol = topology%nmol + 1 END IF - map_atom_mol(i+1) = topology%nmol - IF ((atom_info%map_mol_typ(i+1) == atom_info%map_mol_typ(i)) .AND. & - (atom_info%map_mol_num(i+1) == atom_info%map_mol_num(i)) .AND. & - (atom_info%map_mol_res(i+1) /= atom_info%map_mol_res(i))) THEN - topology%nmol_conn = topology%nmol_conn+1 + map_atom_mol(i + 1) = topology%nmol + IF ((atom_info%map_mol_typ(i + 1) == atom_info%map_mol_typ(i)) .AND. & + (atom_info%map_mol_num(i + 1) == atom_info%map_mol_num(i)) .AND. & + (atom_info%map_mol_res(i + 1) /= atom_info%map_mol_res(i))) THEN + topology%nmol_conn = topology%nmol_conn + 1 END IF END DO IF (iw > 0) WRITE (iw, *) "topology%nmol ::", topology%nmol @@ -219,8 +219,8 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & ikind = map_atom_type(1) imol = ABS(map_atom_mol(1)) counter = 0 - DO i = 1, natom-1 - IF (ikind /= map_atom_type(i+1)) THEN + DO i = 1, natom - 1 + IF (ikind /= map_atom_type(i + 1)) THEN found = .TRUE. found_last = .FALSE. imol = ABS(map_atom_mol(i)) @@ -234,9 +234,9 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & END IF IF (found) THEN - ALLOCATE (molecule_list(imol-counter)) + ALLOCATE (molecule_list(imol - counter)) DO j = 1, SIZE(molecule_list) - molecule_list(j) = j+counter + molecule_list(j) = j + counter END DO molecule_kind => molecule_kind_set(ikind) CALL set_molecule_kind(molecule_kind=molecule_kind, & @@ -244,16 +244,16 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & IF (iw > 0) WRITE (iw, *) " molecule_list", ikind, molecule_list(:) IF (found_last) EXIT counter = imol - ikind = map_atom_type(i+1) + ikind = map_atom_type(i + 1) END IF END DO ! Treat separately the case in which the last atom is also a molecule IF (i == natom) THEN imol = ABS(map_atom_mol(natom)) ! Last atom is also a molecule by itself - ALLOCATE (molecule_list(imol-counter)) + ALLOCATE (molecule_list(imol - counter)) DO j = 1, SIZE(molecule_list) - molecule_list(j) = j+counter + molecule_list(j) = j + counter END DO molecule_kind => molecule_kind_set(ikind) CALL set_molecule_kind(molecule_kind=molecule_kind, & @@ -297,13 +297,13 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & ityp = atom_info%map_mol_typ(j) inum = atom_info%map_mol_num(j) ires = atom_info%map_mol_res(j) - imol = imol+1 + imol = imol + 1 first_list(imol) = j END IF END DO CPASSERT(imol == topology%nmol) - DO ikind = 1, topology%nmol-1 - last_list(ikind) = first_list(ikind+1)-1 + DO ikind = 1, topology%nmol - 1 + last_list(ikind) = first_list(ikind + 1) - 1 END DO last_list(topology%nmol) = topology%natoms CALL set_molecule_set(molecule_set, first_list, last_list) @@ -335,12 +335,12 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & CALL get_molecule(molecule=molecule, & first_atom=first, last_atom=last) natom = 0 - IF (first /= 0 .AND. last /= 0) natom = last-first+1 + IF (first /= 0 .AND. last /= 0) natom = last - first + 1 ALLOCATE (atom_list(natom)) DO i = 1, natom !Atomic kind information will be filled in (PART 2) NULLIFY (atom_list(i)%atomic_kind) - atom_list(i)%id_name = atom_info%id_atmname(i+first-1) + atom_list(i)%id_name = atom_info%id_atmname(i + first - 1) IF (iw > 0) WRITE (iw, '(5X,A,3I5,1X,A5)') "atom_list ", & imol, counter, i, TRIM(id2str(atom_list(i)%id_name)) END DO @@ -383,29 +383,29 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & intra_bonds = 0 inter_bonds = 0 IF (ALL(bnd_type(:, i) > 0)) THEN - intra_bonds = bnd_type(2, i)-bnd_type(1, i)+1 + intra_bonds = bnd_type(2, i) - bnd_type(1, i) + 1 END IF IF (ALL(bnd_ctype(:, i) > 0)) THEN - inter_bonds = bnd_ctype(2, i)-bnd_ctype(1, i)+1 + inter_bonds = bnd_ctype(2, i) - bnd_ctype(1, i) + 1 END IF - ibond = intra_bonds+inter_bonds + ibond = intra_bonds + inter_bonds IF (iw > 0) THEN WRITE (iw, *) " Total number bonds for molecule type ", i, " :", ibond WRITE (iw, *) " intra (bonds inside molecules) :: ", intra_bonds WRITE (iw, *) " inter (bonds between molecules) :: ", inter_bonds END IF molecule_kind => molecule_kind_set(i) - nval_tot2 = nval_tot2+ibond*SIZE(molecule_kind%molecule_list) + nval_tot2 = nval_tot2 + ibond*SIZE(molecule_kind%molecule_list) ALLOCATE (bond_list(ibond)) ibond = 0 DO j = bnd_type(1, i), bnd_type(2, i) IF (j == 0) CYCLE - ibond = ibond+1 + ibond = ibond + 1 jind = map_vars(j) first = first_list(map_atom_mol(conn_info%bond_a(jind))) - bond_list(ibond)%a = conn_info%bond_a(jind)-first+1 - bond_list(ibond)%b = conn_info%bond_b(jind)-first+1 + bond_list(ibond)%a = conn_info%bond_a(jind) - first + 1 + bond_list(ibond)%b = conn_info%bond_b(jind) - first + 1 ! Set by default id_type to charmm and modify when handling the forcefield bond_list(ibond)%id_type = do_ff_charmm IF ((topology%conn_type == do_conn_g96) .OR. (topology%conn_type == do_conn_g87)) THEN @@ -419,18 +419,18 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & conn_info%bond_a(jind), & conn_info%bond_b(jind), & "offset number at", & - conn_info%bond_a(jind)-first+1, & - conn_info%bond_b(jind)-first+1 + conn_info%bond_a(jind) - first + 1, & + conn_info%bond_b(jind) - first + 1 END IF END DO DO j = bnd_ctype(1, i), bnd_ctype(2, i) IF (j == 0) CYCLE - ibond = ibond+1 + ibond = ibond + 1 jind = map_cvars(j) min_index = MIN(conn_info%c_bond_a(jind), conn_info%c_bond_b(jind)) first = first_list(map_atom_mol(min_index)) - bond_list(ibond)%a = conn_info%c_bond_a(jind)-first+1 - bond_list(ibond)%b = conn_info%c_bond_b(jind)-first+1 + bond_list(ibond)%a = conn_info%c_bond_a(jind) - first + 1 + bond_list(ibond)%b = conn_info%c_bond_b(jind) - first + 1 ! Set by default id_type to charmm and modify when handling the forcefield bond_list(ibond)%id_type = do_ff_charmm IF ((topology%conn_type == do_conn_g96) .OR. (topology%conn_type == do_conn_g87)) THEN @@ -444,8 +444,8 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & conn_info%c_bond_a(jind), & conn_info%c_bond_b(jind), & "offset number at", & - conn_info%c_bond_a(jind)-first+1, & - conn_info%c_bond_b(jind)-first+1 + conn_info%c_bond_a(jind) - first + 1, & + conn_info%c_bond_b(jind) - first + 1 END IF END DO CALL set_molecule_kind(molecule_kind=molecule_kind, & @@ -489,7 +489,7 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & j2 = map_atom_mol(conn_info%theta_b(j)) j3 = map_atom_mol(conn_info%theta_c(j)) IF (j1 /= j2 .OR. j2 /= j3) THEN - idim = idim+1 + idim = idim + 1 END IF END DO CALL reallocate(c_var_a, 1, idim) @@ -504,7 +504,7 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & j2 = map_atom_mol(conn_info%theta_b(j)) j3 = map_atom_mol(conn_info%theta_c(j)) IF (j1 /= j2 .OR. j2 /= j3) THEN - idim = idim+1 + idim = idim + 1 c_var_a(idim) = conn_info%theta_a(j) c_var_b(idim) = conn_info%theta_b(j) c_var_c(idim) = conn_info%theta_c(j) @@ -547,29 +547,29 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & intra_bends = 0 inter_bends = 0 IF (ALL(bnd_type(:, i) > 0)) THEN - intra_bends = bnd_type(2, i)-bnd_type(1, i)+1 + intra_bends = bnd_type(2, i) - bnd_type(1, i) + 1 END IF IF (ALL(bnd_ctype(:, i) > 0)) THEN - inter_bends = bnd_ctype(2, i)-bnd_ctype(1, i)+1 + inter_bends = bnd_ctype(2, i) - bnd_ctype(1, i) + 1 END IF - ibend = intra_bends+inter_bends + ibend = intra_bends + inter_bends IF (iw > 0) THEN WRITE (iw, *) " Total number of angles for molecule type ", i, " :", ibend WRITE (iw, *) " intra (angles inside molecules) :: ", intra_bends WRITE (iw, *) " inter (angles between molecules) :: ", inter_bends END IF molecule_kind => molecule_kind_set(i) - nval_tot2 = nval_tot2+ibend*SIZE(molecule_kind%molecule_list) + nval_tot2 = nval_tot2 + ibend*SIZE(molecule_kind%molecule_list) ALLOCATE (bend_list(ibend)) ibend = 0 DO j = bnd_type(1, i), bnd_type(2, i) IF (j == 0) CYCLE - ibend = ibend+1 + ibend = ibend + 1 jind = map_vars(j) first = first_list(map_atom_mol(conn_info%theta_a(jind))) - bend_list(ibend)%a = conn_info%theta_a(jind)-first+1 - bend_list(ibend)%b = conn_info%theta_b(jind)-first+1 - bend_list(ibend)%c = conn_info%theta_c(jind)-first+1 + bend_list(ibend)%a = conn_info%theta_a(jind) - first + 1 + bend_list(ibend)%b = conn_info%theta_b(jind) - first + 1 + bend_list(ibend)%c = conn_info%theta_c(jind) - first + 1 ! Set by default id_type to charmm and modify when handling the forcefield bend_list(ibend)%id_type = do_ff_charmm IF ((topology%conn_type == do_conn_g96) .OR. (topology%conn_type == do_conn_g87)) THEN @@ -584,20 +584,20 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & conn_info%theta_b(jind), & conn_info%theta_c(jind), & "offset number at", & - conn_info%theta_a(jind)-first+1, & - conn_info%theta_b(jind)-first+1, & - conn_info%theta_c(jind)-first+1 + conn_info%theta_a(jind) - first + 1, & + conn_info%theta_b(jind) - first + 1, & + conn_info%theta_c(jind) - first + 1 END IF END DO DO j = bnd_ctype(1, i), bnd_ctype(2, i) IF (j == 0) CYCLE - ibend = ibend+1 + ibend = ibend + 1 jind = map_cvars(j) min_index = MIN(c_var_a(jind), c_var_b(jind), c_var_c(jind)) first = first_list(map_atom_mol(min_index)) - bend_list(ibend)%a = c_var_a(jind)-first+1 - bend_list(ibend)%b = c_var_b(jind)-first+1 - bend_list(ibend)%c = c_var_c(jind)-first+1 + bend_list(ibend)%a = c_var_a(jind) - first + 1 + bend_list(ibend)%b = c_var_b(jind) - first + 1 + bend_list(ibend)%c = c_var_c(jind) - first + 1 ! Set by default id_type to charmm and modify when handling the forcefield bend_list(ibend)%id_type = do_ff_charmm IF ((topology%conn_type == do_conn_g96) .OR. (topology%conn_type == do_conn_g87)) THEN @@ -612,9 +612,9 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & c_var_b(jind), & c_var_c(jind), & "offset number at", & - c_var_a(jind)-first+1, & - c_var_b(jind)-first+1, & - c_var_c(jind)-first+1 + c_var_a(jind) - first + 1, & + c_var_b(jind) - first + 1, & + c_var_c(jind) - first + 1 END IF END DO CALL set_molecule_kind(molecule_kind=molecule_kind, & @@ -649,7 +649,7 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & j2 = map_atom_mol(conn_info%ub_b(j)) j3 = map_atom_mol(conn_info%ub_c(j)) IF (j1 /= j2 .OR. j2 /= j3) THEN - idim = idim+1 + idim = idim + 1 END IF END DO CALL reallocate(c_var_a, 1, idim) @@ -661,7 +661,7 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & j2 = map_atom_mol(conn_info%ub_b(j)) j3 = map_atom_mol(conn_info%ub_c(j)) IF (j1 /= j2 .OR. j2 /= j3) THEN - idim = idim+1 + idim = idim + 1 c_var_a(idim) = conn_info%ub_a(j) c_var_b(idim) = conn_info%ub_b(j) c_var_c(idim) = conn_info%ub_c(j) @@ -701,29 +701,29 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & intra_ubs = 0 inter_ubs = 0 IF (ALL(bnd_type(:, i) > 0)) THEN - intra_ubs = bnd_type(2, i)-bnd_type(1, i)+1 + intra_ubs = bnd_type(2, i) - bnd_type(1, i) + 1 END IF IF (ALL(bnd_ctype(:, i) > 0)) THEN - inter_ubs = bnd_ctype(2, i)-bnd_ctype(1, i)+1 + inter_ubs = bnd_ctype(2, i) - bnd_ctype(1, i) + 1 END IF - iub = intra_ubs+inter_ubs + iub = intra_ubs + inter_ubs IF (iw > 0) THEN WRITE (iw, *) " Total number of Urey-Bradley for molecule type ", i, " :", iub WRITE (iw, *) " intra (UB inside molecules) :: ", intra_ubs WRITE (iw, *) " inter (UB between molecules) :: ", inter_ubs END IF molecule_kind => molecule_kind_set(i) - nval_tot2 = nval_tot2+iub*SIZE(molecule_kind%molecule_list) + nval_tot2 = nval_tot2 + iub*SIZE(molecule_kind%molecule_list) ALLOCATE (ub_list(iub)) iub = 0 DO j = bnd_type(1, i), bnd_type(2, i) IF (j == 0) CYCLE - iub = iub+1 + iub = iub + 1 jind = map_vars(j) first = first_list(map_atom_mol(conn_info%ub_a(jind))) - ub_list(iub)%a = conn_info%ub_a(jind)-first+1 - ub_list(iub)%b = conn_info%ub_b(jind)-first+1 - ub_list(iub)%c = conn_info%ub_c(jind)-first+1 + ub_list(iub)%a = conn_info%ub_a(jind) - first + 1 + ub_list(iub)%b = conn_info%ub_b(jind) - first + 1 + ub_list(iub)%c = conn_info%ub_c(jind) - first + 1 ub_list(iub)%id_type = do_ff_charmm !point this to the right ub_kind_type if using force field NULLIFY (ub_list(iub)%ub_kind) @@ -734,20 +734,20 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & conn_info%ub_b(jind), & conn_info%ub_c(jind), & "offset number at", & - conn_info%ub_a(jind)-first+1, & - conn_info%ub_b(jind)-first+1, & - conn_info%ub_c(jind)-first+1 + conn_info%ub_a(jind) - first + 1, & + conn_info%ub_b(jind) - first + 1, & + conn_info%ub_c(jind) - first + 1 END IF END DO DO j = bnd_ctype(1, i), bnd_ctype(2, i) IF (j == 0) CYCLE - iub = iub+1 + iub = iub + 1 jind = map_cvars(j) min_index = MIN(c_var_a(jind), c_var_b(jind), c_var_c(jind)) first = first_list(map_atom_mol(min_index)) - ub_list(iub)%a = c_var_a(jind)-first+1 - ub_list(iub)%b = c_var_b(jind)-first+1 - ub_list(iub)%c = c_var_c(jind)-first+1 + ub_list(iub)%a = c_var_a(jind) - first + 1 + ub_list(iub)%b = c_var_b(jind) - first + 1 + ub_list(iub)%c = c_var_c(jind) - first + 1 ub_list(iub)%id_type = do_ff_charmm !point this to the right ub_kind_type if using force field NULLIFY (ub_list(iub)%ub_kind) @@ -758,9 +758,9 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & c_var_b(jind), & c_var_c(jind), & "offset number at", & - c_var_a(jind)-first+1, & - c_var_b(jind)-first+1, & - c_var_c(jind)-first+1 + c_var_a(jind) - first + 1, & + c_var_b(jind) - first + 1, & + c_var_c(jind) - first + 1 END IF END DO CALL set_molecule_kind(molecule_kind=molecule_kind, & @@ -799,7 +799,7 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & j3 = map_atom_mol(conn_info%phi_c(j)) j4 = map_atom_mol(conn_info%phi_d(j)) IF (j1 /= j2 .OR. j2 /= j3 .OR. j3 /= j4) THEN - idim = idim+1 + idim = idim + 1 END IF END DO CALL reallocate(c_var_a, 1, idim) @@ -816,7 +816,7 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & j3 = map_atom_mol(conn_info%phi_c(j)) j4 = map_atom_mol(conn_info%phi_d(j)) IF (j1 /= j2 .OR. j2 /= j3 .OR. j3 /= j4) THEN - idim = idim+1 + idim = idim + 1 c_var_a(idim) = conn_info%phi_a(j) c_var_b(idim) = conn_info%phi_b(j) c_var_c(idim) = conn_info%phi_c(j) @@ -861,30 +861,30 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & intra_torsions = 0 inter_torsions = 0 IF (ALL(bnd_type(:, i) > 0)) THEN - intra_torsions = bnd_type(2, i)-bnd_type(1, i)+1 + intra_torsions = bnd_type(2, i) - bnd_type(1, i) + 1 END IF IF (ALL(bnd_ctype(:, i) > 0)) THEN - inter_torsions = bnd_ctype(2, i)-bnd_ctype(1, i)+1 + inter_torsions = bnd_ctype(2, i) - bnd_ctype(1, i) + 1 END IF - itorsion = intra_torsions+inter_torsions + itorsion = intra_torsions + inter_torsions IF (iw > 0) THEN WRITE (iw, *) " Total number of torsions for molecule type ", i, " :", itorsion WRITE (iw, *) " intra (torsions inside molecules) :: ", intra_torsions WRITE (iw, *) " inter (torsions between molecules) :: ", inter_torsions END IF molecule_kind => molecule_kind_set(i) - nval_tot2 = nval_tot2+itorsion*SIZE(molecule_kind%molecule_list) + nval_tot2 = nval_tot2 + itorsion*SIZE(molecule_kind%molecule_list) ALLOCATE (torsion_list(itorsion)) itorsion = 0 DO j = bnd_type(1, i), bnd_type(2, i) IF (j == 0) CYCLE - itorsion = itorsion+1 + itorsion = itorsion + 1 jind = map_vars(j) first = first_list(map_atom_mol(conn_info%phi_a(jind))) - torsion_list(itorsion)%a = conn_info%phi_a(jind)-first+1 - torsion_list(itorsion)%b = conn_info%phi_b(jind)-first+1 - torsion_list(itorsion)%c = conn_info%phi_c(jind)-first+1 - torsion_list(itorsion)%d = conn_info%phi_d(jind)-first+1 + torsion_list(itorsion)%a = conn_info%phi_a(jind) - first + 1 + torsion_list(itorsion)%b = conn_info%phi_b(jind) - first + 1 + torsion_list(itorsion)%c = conn_info%phi_c(jind) - first + 1 + torsion_list(itorsion)%d = conn_info%phi_d(jind) - first + 1 ! Set by default id_type to charmm and modify when handling the forcefield torsion_list(itorsion)%id_type = do_ff_charmm IF ((topology%conn_type == do_conn_g96) .OR. (topology%conn_type == do_conn_g87)) THEN @@ -900,22 +900,22 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & conn_info%phi_c(jind), & conn_info%phi_d(jind), & "offset number at", & - conn_info%phi_a(jind)-first+1, & - conn_info%phi_b(jind)-first+1, & - conn_info%phi_c(jind)-first+1, & - conn_info%phi_d(jind)-first+1 + conn_info%phi_a(jind) - first + 1, & + conn_info%phi_b(jind) - first + 1, & + conn_info%phi_c(jind) - first + 1, & + conn_info%phi_d(jind) - first + 1 END IF END DO DO j = bnd_ctype(1, i), bnd_ctype(2, i) IF (j == 0) CYCLE - itorsion = itorsion+1 + itorsion = itorsion + 1 jind = map_cvars(j) min_index = MIN(c_var_a(jind), c_var_b(jind), c_var_c(jind), c_var_d(jind)) first = first_list(map_atom_mol(min_index)) - torsion_list(itorsion)%a = c_var_a(jind)-first+1 - torsion_list(itorsion)%b = c_var_b(jind)-first+1 - torsion_list(itorsion)%c = c_var_c(jind)-first+1 - torsion_list(itorsion)%d = c_var_d(jind)-first+1 + torsion_list(itorsion)%a = c_var_a(jind) - first + 1 + torsion_list(itorsion)%b = c_var_b(jind) - first + 1 + torsion_list(itorsion)%c = c_var_c(jind) - first + 1 + torsion_list(itorsion)%d = c_var_d(jind) - first + 1 ! Set by default id_type to charmm and modify when handling the forcefield torsion_list(itorsion)%id_type = do_ff_charmm IF ((topology%conn_type == do_conn_g96) .OR. (topology%conn_type == do_conn_g87)) THEN @@ -931,10 +931,10 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & c_var_c(jind), & c_var_d(jind), & "offset number at", & - c_var_a(jind)-first+1, & - c_var_b(jind)-first+1, & - c_var_c(jind)-first+1, & - c_var_d(jind)-first+1 + c_var_a(jind) - first + 1, & + c_var_b(jind) - first + 1, & + c_var_c(jind) - first + 1, & + c_var_d(jind) - first + 1 END IF END DO CALL set_molecule_kind(molecule_kind=molecule_kind, & @@ -978,7 +978,7 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & j3 = map_atom_mol(conn_info%impr_c(j)) j4 = map_atom_mol(conn_info%impr_d(j)) IF (j1 /= j2 .OR. j2 /= j3 .OR. j3 /= j4) THEN - idim = idim+1 + idim = idim + 1 END IF END DO CALL reallocate(c_var_a, 1, idim) @@ -995,7 +995,7 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & j3 = map_atom_mol(conn_info%impr_c(j)) j4 = map_atom_mol(conn_info%impr_d(j)) IF (j1 /= j2 .OR. j2 /= j3 .OR. j3 /= j4) THEN - idim = idim+1 + idim = idim + 1 c_var_a(idim) = conn_info%impr_a(j) c_var_b(idim) = conn_info%impr_b(j) c_var_c(idim) = conn_info%impr_c(j) @@ -1040,12 +1040,12 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & intra_imprs = 0 inter_imprs = 0 IF (ALL(bnd_type(:, i) > 0)) THEN - intra_imprs = bnd_type(2, i)-bnd_type(1, i)+1 + intra_imprs = bnd_type(2, i) - bnd_type(1, i) + 1 END IF IF (ALL(bnd_ctype(:, i) > 0)) THEN - inter_imprs = bnd_ctype(2, i)-bnd_ctype(1, i)+1 + inter_imprs = bnd_ctype(2, i) - bnd_ctype(1, i) + 1 END IF - iimpr = intra_imprs+inter_imprs + iimpr = intra_imprs + inter_imprs IF (iw > 0) THEN WRITE (iw, *) " Total number of imprs for molecule type ", i, " :", iimpr WRITE (iw, *) " intra (imprs inside molecules) :: ", intra_imprs @@ -1055,28 +1055,28 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & WRITE (iw, *) " inter (opbends between molecules) :: ", inter_imprs END IF molecule_kind => molecule_kind_set(i) - nval_tot2 = nval_tot2+iimpr*SIZE(molecule_kind%molecule_list) + nval_tot2 = nval_tot2 + iimpr*SIZE(molecule_kind%molecule_list) ALLOCATE (impr_list(iimpr), STAT=stat) ALLOCATE (opbend_list(iimpr), STAT=stat) CPASSERT(stat == 0) iimpr = 0 DO j = bnd_type(1, i), bnd_type(2, i) IF (j == 0) CYCLE - iimpr = iimpr+1 + iimpr = iimpr + 1 jind = map_vars(j) first = first_list(map_atom_mol(conn_info%impr_a(jind))) - impr_list(iimpr)%a = conn_info%impr_a(jind)-first+1 - impr_list(iimpr)%b = conn_info%impr_b(jind)-first+1 - impr_list(iimpr)%c = conn_info%impr_c(jind)-first+1 - impr_list(iimpr)%d = conn_info%impr_d(jind)-first+1 + impr_list(iimpr)%a = conn_info%impr_a(jind) - first + 1 + impr_list(iimpr)%b = conn_info%impr_b(jind) - first + 1 + impr_list(iimpr)%c = conn_info%impr_c(jind) - first + 1 + impr_list(iimpr)%d = conn_info%impr_d(jind) - first + 1 ! Atom sequence for improper is A B C D in which A is central atom, ! B is deviating atom and C & D are secondairy atoms. Atom sequence for ! opbend is B D C A in which A is central atom, B is deviating. Hence ! to create an opbend out of an improper, B and D need to be interchanged. - opbend_list(iimpr)%a = conn_info%impr_b(jind)-first+1 - opbend_list(iimpr)%b = conn_info%impr_d(jind)-first+1 - opbend_list(iimpr)%c = conn_info%impr_c(jind)-first+1 - opbend_list(iimpr)%d = conn_info%impr_a(jind)-first+1 + opbend_list(iimpr)%a = conn_info%impr_b(jind) - first + 1 + opbend_list(iimpr)%b = conn_info%impr_d(jind) - first + 1 + opbend_list(iimpr)%c = conn_info%impr_c(jind) - first + 1 + opbend_list(iimpr)%d = conn_info%impr_a(jind) - first + 1 ! Set by default id_type of improper to charmm and modify when handling the forcefield impr_list(iimpr)%id_type = do_ff_charmm ! Set by default id_type of opbend to harmonic and modify when handling the forcefield @@ -1095,10 +1095,10 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & conn_info%impr_c(jind), & conn_info%impr_d(jind), & "offset number at", & - conn_info%impr_a(jind)-first+1, & - conn_info%impr_b(jind)-first+1, & - conn_info%impr_c(jind)-first+1, & - conn_info%impr_d(jind)-first+1 + conn_info%impr_a(jind) - first + 1, & + conn_info%impr_b(jind) - first + 1, & + conn_info%impr_c(jind) - first + 1, & + conn_info%impr_d(jind) - first + 1 WRITE (iw, '(7X,A,I3,1X,A,I4,I4,I4,I4,1X,A,I4,I4,I4,I4)') & "molecule_kind", i, "intra OPBEND", & conn_info%impr_b(jind), & @@ -1106,26 +1106,26 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & conn_info%impr_c(jind), & conn_info%impr_a(jind), & "offset number at", & - conn_info%impr_b(jind)-first+1, & - conn_info%impr_d(jind)-first+1, & - conn_info%impr_c(jind)-first+1, & - conn_info%impr_a(jind)-first+1 + conn_info%impr_b(jind) - first + 1, & + conn_info%impr_d(jind) - first + 1, & + conn_info%impr_c(jind) - first + 1, & + conn_info%impr_a(jind) - first + 1 END IF END DO DO j = bnd_ctype(1, i), bnd_ctype(2, i) IF (j == 0) CYCLE - iimpr = iimpr+1 + iimpr = iimpr + 1 jind = map_cvars(j) min_index = MIN(c_var_a(jind), c_var_b(jind), c_var_c(jind), c_var_d(jind)) first = first_list(map_atom_mol(min_index)) - impr_list(iimpr)%a = c_var_a(jind)-first+1 - impr_list(iimpr)%b = c_var_b(jind)-first+1 - impr_list(iimpr)%c = c_var_c(jind)-first+1 - impr_list(iimpr)%d = c_var_d(jind)-first+1 - opbend_list(iimpr)%a = c_var_b(jind)-first+1 - opbend_list(iimpr)%b = c_var_d(jind)-first+1 - opbend_list(iimpr)%c = c_var_c(jind)-first+1 - opbend_list(iimpr)%d = c_var_a(jind)-first+1 + impr_list(iimpr)%a = c_var_a(jind) - first + 1 + impr_list(iimpr)%b = c_var_b(jind) - first + 1 + impr_list(iimpr)%c = c_var_c(jind) - first + 1 + impr_list(iimpr)%d = c_var_d(jind) - first + 1 + opbend_list(iimpr)%a = c_var_b(jind) - first + 1 + opbend_list(iimpr)%b = c_var_d(jind) - first + 1 + opbend_list(iimpr)%c = c_var_c(jind) - first + 1 + opbend_list(iimpr)%d = c_var_a(jind) - first + 1 ! Set by default id_type of improper to charmm and modify when handling the forcefield impr_list(iimpr)%id_type = do_ff_charmm ! Set by default id_type of opbend to harmonic and modify when handling the forcefield @@ -1144,10 +1144,10 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & c_var_c(jind), & c_var_d(jind), & "offset number at", & - c_var_a(jind)-first+1, & - c_var_b(jind)-first+1, & - c_var_c(jind)-first+1, & - c_var_d(jind)-first+1 + c_var_a(jind) - first + 1, & + c_var_b(jind) - first + 1, & + c_var_c(jind) - first + 1, & + c_var_d(jind) - first + 1 WRITE (iw, '(7X,A,I3,1X,A,I4,I4,I4,I4,1X,A,I4,I4,I4,I4)') & "molecule_kind", i, "inter OPBEND", & c_var_b(jind), & @@ -1155,10 +1155,10 @@ SUBROUTINE topology_connectivity_pack(molecule_kind_set, molecule_set, & c_var_c(jind), & c_var_a(jind), & "offset number at", & - c_var_b(jind)-first+1, & - c_var_d(jind)-first+1, & - c_var_c(jind)-first+1, & - c_var_a(jind)-first+1 + c_var_b(jind) - first + 1, & + c_var_d(jind) - first + 1, & + c_var_c(jind) - first + 1, & + c_var_a(jind) - first + 1 END IF END DO CALL set_molecule_kind(molecule_kind=molecule_kind, & @@ -1222,12 +1222,12 @@ SUBROUTINE find_bnd_typ(nmol_type, map_vars, map_var_mol, bnd_type, nvar1) DO j = 1, nvar1 IF (map_var_mol(j) /= -1) EXIT END DO - IF (j == nvar1+1) RETURN + IF (j == nvar1 + 1) RETURN i = map_var_mol(j) bnd_type(1, i) = j DO ibond = j, nvar1 IF (map_var_mol(ibond) /= i) THEN - bnd_type(2, i) = ibond-1 + bnd_type(2, i) = ibond - 1 i = map_var_mol(ibond) bnd_type(1, i) = ibond END IF @@ -1322,57 +1322,57 @@ SUBROUTINE topology_conn_multiple(topology, subsys_section) DO k = 1, multiple_unit_cell(3) DO j = 1, multiple_unit_cell(2) DO i = 1, multiple_unit_cell(1) - ind = ind+1 + ind = ind + 1 IF (ind == 1) CYCLE - a = (ind-1)*natoms_orig + a = (ind - 1)*natoms_orig ! Bonds IF (nbond > 0) THEN - m = (ind-1)*nbond - conn_info%bond_a(m+1:m+nbond) = conn_info%bond_a(1:nbond)+a - conn_info%bond_b(m+1:m+nbond) = conn_info%bond_b(1:nbond)+a + m = (ind - 1)*nbond + conn_info%bond_a(m + 1:m + nbond) = conn_info%bond_a(1:nbond) + a + conn_info%bond_b(m + 1:m + nbond) = conn_info%bond_b(1:nbond) + a END IF ! Theta IF (ntheta > 0) THEN - m = (ind-1)*ntheta - conn_info%theta_a(m+1:m+ntheta) = conn_info%theta_a(1:ntheta)+a - conn_info%theta_b(m+1:m+ntheta) = conn_info%theta_b(1:ntheta)+a - conn_info%theta_c(m+1:m+ntheta) = conn_info%theta_c(1:ntheta)+a + m = (ind - 1)*ntheta + conn_info%theta_a(m + 1:m + ntheta) = conn_info%theta_a(1:ntheta) + a + conn_info%theta_b(m + 1:m + ntheta) = conn_info%theta_b(1:ntheta) + a + conn_info%theta_c(m + 1:m + ntheta) = conn_info%theta_c(1:ntheta) + a END IF ! Phi IF (nphi > 0) THEN - m = (ind-1)*nphi - conn_info%phi_a(m+1:m+nphi) = conn_info%phi_a(1:nphi)+a - conn_info%phi_b(m+1:m+nphi) = conn_info%phi_b(1:nphi)+a - conn_info%phi_c(m+1:m+nphi) = conn_info%phi_c(1:nphi)+a - conn_info%phi_d(m+1:m+nphi) = conn_info%phi_d(1:nphi)+a + m = (ind - 1)*nphi + conn_info%phi_a(m + 1:m + nphi) = conn_info%phi_a(1:nphi) + a + conn_info%phi_b(m + 1:m + nphi) = conn_info%phi_b(1:nphi) + a + conn_info%phi_c(m + 1:m + nphi) = conn_info%phi_c(1:nphi) + a + conn_info%phi_d(m + 1:m + nphi) = conn_info%phi_d(1:nphi) + a END IF ! Impropers IF (nimpr > 0) THEN - m = (ind-1)*nimpr - conn_info%impr_a(m+1:m+nimpr) = conn_info%impr_a(1:nimpr)+a - conn_info%impr_b(m+1:m+nimpr) = conn_info%impr_b(1:nimpr)+a - conn_info%impr_c(m+1:m+nimpr) = conn_info%impr_c(1:nimpr)+a - conn_info%impr_d(m+1:m+nimpr) = conn_info%impr_d(1:nimpr)+a + m = (ind - 1)*nimpr + conn_info%impr_a(m + 1:m + nimpr) = conn_info%impr_a(1:nimpr) + a + conn_info%impr_b(m + 1:m + nimpr) = conn_info%impr_b(1:nimpr) + a + conn_info%impr_c(m + 1:m + nimpr) = conn_info%impr_c(1:nimpr) + a + conn_info%impr_d(m + 1:m + nimpr) = conn_info%impr_d(1:nimpr) + a END IF ! Para_res IF (nbond_c > 0) THEN - m = (ind-1)*nbond_c - conn_info%c_bond_a(m+1:m+nbond_c) = conn_info%c_bond_a(1:nbond_c)+a - conn_info%c_bond_b(m+1:m+nbond_c) = conn_info%c_bond_b(1:nbond_c)+a + m = (ind - 1)*nbond_c + conn_info%c_bond_a(m + 1:m + nbond_c) = conn_info%c_bond_a(1:nbond_c) + a + conn_info%c_bond_b(m + 1:m + nbond_c) = conn_info%c_bond_b(1:nbond_c) + a END IF ! Urey-Bradley IF (nub > 0) THEN - m = (ind-1)*nub - conn_info%ub_a(m+1:m+nub) = conn_info%ub_a(1:nub)+a - conn_info%ub_b(m+1:m+nub) = conn_info%ub_b(1:nub)+a - conn_info%ub_c(m+1:m+nub) = conn_info%ub_c(1:nub)+a + m = (ind - 1)*nub + conn_info%ub_a(m + 1:m + nub) = conn_info%ub_a(1:nub) + a + conn_info%ub_b(m + 1:m + nub) = conn_info%ub_b(1:nub) + a + conn_info%ub_c(m + 1:m + nub) = conn_info%ub_c(1:nub) + a END IF ! ONFO IF (nonfo > 0) THEN - m = (ind-1)*nonfo - conn_info%onfo_a(m+1:m+nonfo) = conn_info%onfo_a(1:nonfo)+a - conn_info%onfo_b(m+1:m+nonfo) = conn_info%onfo_b(1:nonfo)+a + m = (ind - 1)*nonfo + conn_info%onfo_a(m + 1:m + nonfo) = conn_info%onfo_a(1:nonfo) + a + conn_info%onfo_b(m + 1:m + nonfo) = conn_info%onfo_b(1:nonfo) + a END IF END DO END DO diff --git a/src/topology_constraint_util.F b/src/topology_constraint_util.F index 0a31552a27..cc1950540f 100644 --- a/src/topology_constraint_util.F +++ b/src/topology_constraint_util.F @@ -187,9 +187,9 @@ SUBROUTINE topology_constraint_pack(molecule_kind_set, molecule_set, & gci%ng4x6_restraint = 0 gci%nvsite_restraint = 0 CALL setup_colvar_counters(gci%colv_list, gci%ncolv) - gci%nrestraint = gci%ng3x3_restraint+ & - gci%ng4x6_restraint+ & - gci%nvsite_restraint+ & + gci%nrestraint = gci%ng3x3_restraint + & + gci%ng4x6_restraint + & + gci%nvsite_restraint + & gci%ncolv%nrestraint CALL timestop(handle2) CALL timeset(routineN//"_2", handle2) @@ -260,7 +260,7 @@ SUBROUTINE topology_constraint_pack(molecule_kind_set, molecule_set, & ! on the first molecule of this kind molecule => molecule_set(molecule_list(1)) CALL get_molecule(molecule, first_atom=first_atom, last_atom=last_atom) - natom = last_atom-first_atom+1 + natom = last_atom - first_atom + 1 DO k = 1, nbond ishbond = .FALSE. j = bond_list(k)%a @@ -282,12 +282,12 @@ SUBROUTINE topology_constraint_pack(molecule_kind_set, molecule_set, & IF (.NOT. (is_qm) .AND. exclude_mm) ishbond = .FALSE. END IF IF (ishbond) THEN - nhdist = nhdist+1 + nhdist = nhdist + 1 END IF END DO END DO n_start_colv = cons_info%nconst_colv - cons_info%nconst_colv = nhdist+n_start_colv + cons_info%nconst_colv = nhdist + n_start_colv CALL reallocate(cons_info%const_colv_mol, 1, cons_info%nconst_colv) CALL reallocate(cons_info%const_colv_molname, 1, cons_info%nconst_colv) CALL reallocate(cons_info%const_colv_target, 1, cons_info%nconst_colv) @@ -300,11 +300,11 @@ SUBROUTINE topology_constraint_pack(molecule_kind_set, molecule_set, & CALL reallocate(cons_info%colv_exclude_qm, 1, cons_info%nconst_colv) CALL reallocate(cons_info%colv_exclude_mm, 1, cons_info%nconst_colv) ! Bonds involving hydrogens are by their nature only intramolecular - cons_info%colv_intermolecular(n_start_colv+1:cons_info%nconst_colv) = .FALSE. - cons_info%colv_exclude_qm(n_start_colv+1:cons_info%nconst_colv) = .FALSE. - cons_info%colv_exclude_mm(n_start_colv+1:cons_info%nconst_colv) = .FALSE. - cons_info%colv_restraint(n_start_colv+1:cons_info%nconst_colv) = cons_info%hbonds_restraint - cons_info%colv_k0(n_start_colv+1:cons_info%nconst_colv) = cons_info%hbonds_k0 + cons_info%colv_intermolecular(n_start_colv + 1:cons_info%nconst_colv) = .FALSE. + cons_info%colv_exclude_qm(n_start_colv + 1:cons_info%nconst_colv) = .FALSE. + cons_info%colv_exclude_mm(n_start_colv + 1:cons_info%nconst_colv) = .FALSE. + cons_info%colv_restraint(n_start_colv + 1:cons_info%nconst_colv) = cons_info%hbonds_restraint + cons_info%colv_k0(n_start_colv + 1:cons_info%nconst_colv) = cons_info%hbonds_k0 ! nhdist = 0 DO i = 1, SIZE(molecule_kind_set) @@ -315,8 +315,8 @@ SUBROUTINE topology_constraint_pack(molecule_kind_set, molecule_set, & molecule_list=molecule_list) molecule => molecule_set(molecule_list(1)) CALL get_molecule(molecule, first_atom=first_atom, last_atom=last_atom) - natom = last_atom-first_atom+1 - offset = first_atom-1 + natom = last_atom - first_atom + 1 + offset = first_atom - 1 DO k = 1, nbond ishbond = .FALSE. j = bond_list(k)%a @@ -338,8 +338,8 @@ SUBROUTINE topology_constraint_pack(molecule_kind_set, molecule_set, & IF (.NOT. (is_qm) .AND. exclude_mm) ishbond = .FALSE. END IF IF (ishbond) THEN - nhdist = nhdist+1 - rvec = particle_set(offset+bond_list(k)%a)%r-particle_set(offset+bond_list(k)%b)%r + nhdist = nhdist + 1 + rvec = particle_set(offset + bond_list(k)%a)%r - particle_set(offset + bond_list(k)%b)%r rmod = SQRT(DOT_PRODUCT(rvec, rvec)) IF (ASSOCIATED(hdist)) THEN IF (SIZE(hdist) > 0) THEN @@ -357,15 +357,15 @@ SUBROUTINE topology_constraint_pack(molecule_kind_set, molecule_set, & END IF END IF END IF - cons_info%const_colv_mol(nhdist+n_start_colv) = i - cons_info%const_colv_molname(nhdist+n_start_colv) = "UNDEF" - cons_info%const_colv_target(nhdist+n_start_colv) = rmod - cons_info%const_colv_target_growth(nhdist+n_start_colv) = 0.0_dp - CALL colvar_create(cons_info%colvar_set(nhdist+n_start_colv)%colvar, & + cons_info%const_colv_mol(nhdist + n_start_colv) = i + cons_info%const_colv_molname(nhdist + n_start_colv) = "UNDEF" + cons_info%const_colv_target(nhdist + n_start_colv) = rmod + cons_info%const_colv_target_growth(nhdist + n_start_colv) = 0.0_dp + CALL colvar_create(cons_info%colvar_set(nhdist + n_start_colv)%colvar, & dist_colvar_id) - cons_info%colvar_set(nhdist+n_start_colv)%colvar%dist_param%i_at = bond_list(k)%a - cons_info%colvar_set(nhdist+n_start_colv)%colvar%dist_param%j_at = bond_list(k)%b - CALL colvar_setup(cons_info%colvar_set(nhdist+n_start_colv)%colvar) + cons_info%colvar_set(nhdist + n_start_colv)%colvar%dist_param%i_at = bond_list(k)%a + cons_info%colvar_set(nhdist + n_start_colv)%colvar%dist_param%j_at = bond_list(k)%b + CALL colvar_setup(cons_info%colvar_set(nhdist + n_start_colv)%colvar) END IF END DO END DO @@ -444,7 +444,7 @@ SUBROUTINE topology_constraint_pack(molecule_kind_set, molecule_set, & gci%lcolv => lcolv gci%ncolv = ncolv ! Total number of Intermolecular constraints - gci%ntot = gci%ncolv%ntot+gci%ntot + gci%ntot = gci%ncolv%ntot + gci%ntot DEALLOCATE (constr_x_glob) END IF END IF @@ -498,7 +498,7 @@ SUBROUTINE topology_constraint_pack(molecule_kind_set, molecule_set, & gci%ng3x3 = ng3x3 gci%ng3x3_restraint = ng3x3_restraint ! Total number of Intermolecular constraints - gci%ntot = 3*gci%ng3x3+gci%ntot + gci%ntot = 3*gci%ng3x3 + gci%ntot DEALLOCATE (constr_x_glob) END IF END IF @@ -551,7 +551,7 @@ SUBROUTINE topology_constraint_pack(molecule_kind_set, molecule_set, & gci%ng4x6 = ng4x6 gci%ng4x6_restraint = ng4x6_restraint ! Total number of Intermolecular constraints - gci%ntot = 6*gci%ng4x6+gci%ntot + gci%ntot = 6*gci%ng4x6 + gci%ntot DEALLOCATE (constr_x_glob) END IF END IF @@ -595,7 +595,7 @@ SUBROUTINE topology_constraint_pack(molecule_kind_set, molecule_set, & gci%nvsite = nvsite gci%nvsite_restraint = nvsite_restraint ! Total number of Intermolecular constraints - gci%ntot = gci%nvsite+gci%ntot + gci%ntot = gci%nvsite + gci%ntot DEALLOCATE (constr_x_glob) END IF END IF @@ -651,7 +651,7 @@ SUBROUTINE topology_constraint_pack(molecule_kind_set, molecule_set, & END SELECT END IF IF (ANY(cons_info%fixed_atoms == k) .OR. fix_atom_qmmm .OR. fix_atom_molname) THEN - nfixed_atoms = nfixed_atoms+1 + nfixed_atoms = nfixed_atoms + 1 END IF END DO END DO @@ -732,7 +732,7 @@ SUBROUTINE topology_constraint_pack(molecule_kind_set, molecule_set, & END IF ! Let's store the atom index IF (fix_fixed_atom .OR. fix_atom_qmmm .OR. fix_atom_molname) THEN - kk = kk+1 + kk = kk + 1 fixd_list(kk)%fixd = k fixd_list(kk)%coord = particle_set(k)%r fixd_list(kk)%itype = itype @@ -754,8 +754,8 @@ SUBROUTINE topology_constraint_pack(molecule_kind_set, molecule_set, & CPABORT("") END IF IF (fixd_list(kk)%restraint%active) THEN - nfixd_restraint = nfixd_restraint+1 - nfixd_restart = nfixd_restart+1 + nfixd_restraint = nfixd_restraint + 1 + nfixd_restart = nfixd_restart + 1 ! Check that we use the components that we really want.. SELECT CASE (itype) CASE (use_perd_x) @@ -845,8 +845,8 @@ SUBROUTINE topology_constraint_pack(molecule_kind_set, molecule_set, & END IF CALL set_molecule_kind(molecule_kind, nfixd=nfixed_atoms, nfixd_restraint=nfixd_restraint, & fixd_list=fixd_list) - fixd_list_gci(nfixd_list_gci+1:nfixd_list_gci+nfixed_atoms) = fixd_list - nfixd_list_gci = nfixd_list_gci+nfixed_atoms + fixd_list_gci(nfixd_list_gci + 1:nfixd_list_gci + nfixed_atoms) = fixd_list + nfixd_list_gci = nfixd_list_gci + nfixed_atoms END DO IF (iw > 0) THEN WRITE (iw, *) "TOTAL NUMBER OF FIXED ATOMS:", nfixd_list_gci @@ -862,9 +862,9 @@ SUBROUTINE topology_constraint_pack(molecule_kind_set, molecule_set, & DEALLOCATE (fixd_list_gci) END IF ! Final setup of the number of possible restraints - gci%nrestraint = gci%ng3x3_restraint+ & - gci%ng4x6_restraint+ & - gci%nvsite_restraint+ & + gci%nrestraint = gci%ng3x3_restraint + & + gci%ng4x6_restraint + & + gci%nvsite_restraint + & gci%ncolv%nrestraint CALL cp_print_key_finished_output(iw, logger, subsys_section, & "PRINT%TOPOLOGY_INFO/UTIL_INFO") @@ -912,7 +912,7 @@ SUBROUTINE setup_colv_list(colv_list, ilist, gind, cons_info, topology, & ncolv_mol = 0 DO kk = 1, SIZE(ilist) j = ilist(kk) - ncolv_mol = ncolv_mol+1 + ncolv_mol = ncolv_mol + 1 kdim = SIZE(cons_info%colvar_set(j)%colvar%i_atom) ALLOCATE (colv_list(ncolv_mol)%i_atoms(kdim)) colv_list(ncolv_mol)%inp_seq_num = j @@ -926,7 +926,7 @@ SUBROUTINE setup_colv_list(colv_list, ilist, gind, cons_info, topology, & ! Let's compute the value.. NULLIFY (local_colvar) CALL colvar_clone(local_colvar, cons_info%colvar_set(j)%colvar, & - i_atom_offset=first_atom-1) + i_atom_offset=first_atom - 1) CALL colvar_eval_mol_f(local_colvar, topology%cell, particle_set) colv_list(ncolv_mol)%expected_value = local_colvar%ss CALL colvar_release(local_colvar) @@ -937,7 +937,7 @@ SUBROUTINE setup_colv_list(colv_list, ilist, gind, cons_info, topology, & ! In case of Restraint let's check for possible restart values IF (colv_list(ncolv_mol)%restraint%active .AND. & (colv_list(ncolv_mol)%expected_value_growth_speed == 0.0_dp)) THEN - gind = gind+1 + gind = gind + 1 IF (restart_restraint_clv) THEN CALL section_vals_val_get(colvar_rest, "_DEFAULT_KEYWORD_", & i_rep_val=gind, r_val=rmod) @@ -989,7 +989,7 @@ SUBROUTINE setup_g3x3_list(g3x3_list, ilist, cons_info, ng3x3_restraint) ! Restraint g3x3_list(ng3x3)%restraint%active = cons_info%g33_restraint(j) g3x3_list(ng3x3)%restraint%k0 = cons_info%g33_k0(j) - IF (g3x3_list(ng3x3)%restraint%active) ng3x3_restraint = ng3x3_restraint+1 + IF (g3x3_list(ng3x3)%restraint%active) ng3x3_restraint = ng3x3_restraint + 1 END DO END SUBROUTINE setup_g3x3_list @@ -1032,7 +1032,7 @@ SUBROUTINE setup_g4x6_list(g4x6_list, ilist, cons_info, ng4x6_restraint) ! Restraint g4x6_list(ng4x6)%restraint%active = cons_info%g46_restraint(j) g4x6_list(ng4x6)%restraint%k0 = cons_info%g46_k0(j) - IF (g4x6_list(ng4x6)%restraint%active) ng4x6_restraint = ng4x6_restraint+1 + IF (g4x6_list(ng4x6)%restraint%active) ng4x6_restraint = ng4x6_restraint + 1 END DO END SUBROUTINE setup_g4x6_list @@ -1070,7 +1070,7 @@ SUBROUTINE setup_vsite_list(vsite_list, ilist, cons_info, nvsite_restraint) ! Restraint vsite_list(nvsite)%restraint%active = cons_info%vsite_restraint(j) vsite_list(nvsite)%restraint%k0 = cons_info%vsite_k0(j) - IF (vsite_list(nvsite)%restraint%active) nvsite_restraint = nvsite_restraint+1 + IF (vsite_list(nvsite)%restraint%active) nvsite_restraint = nvsite_restraint + 1 END DO END SUBROUTINE setup_vsite_list @@ -1118,7 +1118,7 @@ SUBROUTINE setup_lcolv(lcolv, ilist, first_atom, last_atom, cons_info, & NULLIFY (lcolv(kk)%colvar, lcolv(kk)%colvar_old) ! Colvar CALL colvar_clone(lcolv(kk)%colvar, cons_info%colvar_set(k)%colvar, & - i_atom_offset=first_atom-1) + i_atom_offset=first_atom - 1) ! Some COLVARS may need additional information for evaluating the ! functional form: this is the case for COLVARS which depend on the @@ -1126,11 +1126,11 @@ SUBROUTINE setup_lcolv(lcolv, ilist, first_atom, last_atom, cons_info, & ! container in the COLVAR_RESTART section.. IF ((lcolv(kk)%colvar%type_id == xyz_diag_colvar_id) .OR. & (lcolv(kk)%colvar%type_id == xyz_outerdiag_colvar_id)) THEN - cind = cind+1 + cind = cind + 1 IF (use_clv_info) THEN CALL section_vals_val_get(colvar_func_info, "_DEFAULT_KEYWORD_", & i_rep_val=cind, r_vals=r_vals) - SELECT CASE (lcolv (kk)%colvar%type_id) + SELECT CASE (lcolv(kk)%colvar%type_id) CASE (xyz_diag_colvar_id) CPASSERT(SIZE(r_vals) == 3) lcolv(kk)%colvar%xyz_diag_param%r0 = r_vals @@ -1140,17 +1140,17 @@ SUBROUTINE setup_lcolv(lcolv, ilist, first_atom, last_atom, cons_info, & lcolv(kk)%colvar%xyz_outerdiag_param%r0(:, 2) = r_vals(4:6) END SELECT ELSE - SELECT CASE (lcolv (kk)%colvar%type_id) + SELECT CASE (lcolv(kk)%colvar%type_id) CASE (xyz_diag_colvar_id) ALLOCATE (r_vals(3)) - ind = first_atom-1+lcolv(kk)%colvar%xyz_diag_param%i_atom + ind = first_atom - 1 + lcolv(kk)%colvar%xyz_diag_param%i_atom r_vals = particle_set(ind)%r lcolv(kk)%colvar%xyz_diag_param%r0 = r_vals CASE (xyz_outerdiag_colvar_id) ALLOCATE (r_vals(6)) - ind = first_atom-1+lcolv(kk)%colvar%xyz_outerdiag_param%i_atoms(1) + ind = first_atom - 1 + lcolv(kk)%colvar%xyz_outerdiag_param%i_atoms(1) r_vals(1:3) = particle_set(ind)%r - ind = first_atom-1+lcolv(kk)%colvar%xyz_outerdiag_param%i_atoms(2) + ind = first_atom - 1 + lcolv(kk)%colvar%xyz_outerdiag_param%i_atoms(2) r_vals(4:6) = particle_set(ind)%r lcolv(kk)%colvar%xyz_outerdiag_param%r0(:, 1) = r_vals(1:3) lcolv(kk)%colvar%xyz_outerdiag_param%r0(:, 2) = r_vals(4:6) @@ -1212,12 +1212,12 @@ SUBROUTINE setup_lg3x3(lg3x3, g3x3_list, first_atom, last_atom) lg3x3(kk)%vb = 0.0_dp lg3x3(kk)%vc = 0.0_dp lg3x3(kk)%lambda = 0.0_dp - IF ((g3x3_list(kk)%a+first_atom-1 < first_atom) .OR. & - (g3x3_list(kk)%b+first_atom-1 < first_atom) .OR. & - (g3x3_list(kk)%c+first_atom-1 < first_atom) .OR. & - (g3x3_list(kk)%a+first_atom-1 > last_atom) .OR. & - (g3x3_list(kk)%b+first_atom-1 > last_atom) .OR. & - (g3x3_list(kk)%c+first_atom-1 > last_atom)) THEN + IF ((g3x3_list(kk)%a + first_atom - 1 < first_atom) .OR. & + (g3x3_list(kk)%b + first_atom - 1 < first_atom) .OR. & + (g3x3_list(kk)%c + first_atom - 1 < first_atom) .OR. & + (g3x3_list(kk)%a + first_atom - 1 > last_atom) .OR. & + (g3x3_list(kk)%b + first_atom - 1 > last_atom) .OR. & + (g3x3_list(kk)%c + first_atom - 1 > last_atom)) THEN WRITE (*, '(T5,"|",T8,A)') "Error in constraints setup!" WRITE (*, '(T5,"|",T8,A)') "A constraint has been defined for a molecule type", & " but the atoms specified in the constraint and the atoms defined for", & @@ -1274,14 +1274,14 @@ SUBROUTINE setup_lg4x6(lg4x6, g4x6_list, first_atom, last_atom) lg4x6(kk)%ve = 0.0_dp lg4x6(kk)%vf = 0.0_dp lg4x6(kk)%lambda = 0.0_dp - IF ((g4x6_list(kk)%a+first_atom-1 < first_atom) .OR. & - (g4x6_list(kk)%b+first_atom-1 < first_atom) .OR. & - (g4x6_list(kk)%c+first_atom-1 < first_atom) .OR. & - (g4x6_list(kk)%d+first_atom-1 < first_atom) .OR. & - (g4x6_list(kk)%a+first_atom-1 > last_atom) .OR. & - (g4x6_list(kk)%b+first_atom-1 > last_atom) .OR. & - (g4x6_list(kk)%c+first_atom-1 > last_atom) .OR. & - (g4x6_list(kk)%d+first_atom-1 > last_atom)) THEN + IF ((g4x6_list(kk)%a + first_atom - 1 < first_atom) .OR. & + (g4x6_list(kk)%b + first_atom - 1 < first_atom) .OR. & + (g4x6_list(kk)%c + first_atom - 1 < first_atom) .OR. & + (g4x6_list(kk)%d + first_atom - 1 < first_atom) .OR. & + (g4x6_list(kk)%a + first_atom - 1 > last_atom) .OR. & + (g4x6_list(kk)%b + first_atom - 1 > last_atom) .OR. & + (g4x6_list(kk)%c + first_atom - 1 > last_atom) .OR. & + (g4x6_list(kk)%d + first_atom - 1 > last_atom)) THEN WRITE (*, '(T5,"|",T8,A)') "Error in constraints setup!" WRITE (*, '(T5,"|",T8,A)') "A constrained has been defined for a molecule type", & " but the atoms specified in the constraint and the atoms defined for", & @@ -1341,7 +1341,7 @@ SUBROUTINE give_constraint_array(const_mol, const_molname, const_intermolecular, DO i = 1, SIZE(const_mol) IF (const_intermolecular(i)) THEN ! Intermolecular constraint - iglob = iglob+1 + iglob = iglob + 1 CALL reallocate(constr_x_glob, 1, iglob) constr_x_glob(iglob) = i ELSE @@ -1354,8 +1354,8 @@ SUBROUTINE give_constraint_array(const_mol, const_molname, const_intermolecular, " molecule index ("//cp_to_string(k)//") is out of range of the possible"// & " molecule kinds ("//cp_to_string(SIZE(molecule_kind_set))//").") isize = SIZE(constr_x_mol(k)%constr) - CALL reallocate(constr_x_mol(k)%constr, 1, isize+1) - constr_x_mol(k)%constr(isize+1) = i + CALL reallocate(constr_x_mol(k)%constr, 1, isize + 1) + constr_x_mol(k)%constr(isize + 1) = i ELSE myname = const_molname(i) found_molname = .FALSE. @@ -1367,8 +1367,8 @@ SUBROUTINE give_constraint_array(const_mol, const_molname, const_intermolecular, IF (.NOT. is_qm .AND. exclude_mm(i)) CYCLE IF (name == myname) THEN isize = SIZE(constr_x_mol(k)%constr) - CALL reallocate(constr_x_mol(k)%constr, 1, isize+1) - constr_x_mol(k)%constr(isize+1) = i + CALL reallocate(constr_x_mol(k)%constr, 1, isize + 1) + constr_x_mol(k)%constr(isize + 1) = i found_molname = .TRUE. END IF END DO diff --git a/src/topology_coordinate_util.F b/src/topology_coordinate_util.F index 13ba459ae6..fd12e5e266 100644 --- a/src/topology_coordinate_util.F +++ b/src/topology_coordinate_util.F @@ -161,27 +161,27 @@ SUBROUTINE topology_coordinate_pack(particle_set, atomic_kind_set, & IF (iw > 0) WRITE (iw, *) "boundaries of molecules (first, last) ::", first, last DO j = 1, natom IF (.NOT. ANY(id_work(1:counter) .EQ. atom_list(j)%id_name)) THEN - counter = counter+1 + counter = counter + 1 id_work(counter) = atom_list(j)%id_name - mass(counter) = atom_info%atm_mass(first+j-1) - id_element(counter) = atom_info%id_element(first+j-1) - charge(counter) = atom_info%atm_charge(first+j-1) + mass(counter) = atom_info%atm_mass(first + j - 1) + id_element(counter) = atom_info%id_element(first + j - 1) + charge(counter) = atom_info%atm_charge(first + j - 1) IF (iw > 0) WRITE (iw, '(7X,A,1X,A5,F10.5,5X,A2,5X,F10.5)') & "NEW ATOMIC KIND", id2str(id_work(counter)), mass(counter), id2str(id_element(counter)), charge(counter) ELSE found = .FALSE. DO k = 1, counter - IF ((id_work(k) == atom_list(j)%id_name) .AND. (charge(k) == atom_info%atm_charge(first+j-1))) THEN + IF ((id_work(k) == atom_list(j)%id_name) .AND. (charge(k) == atom_info%atm_charge(first + j - 1))) THEN found = .TRUE. EXIT END IF END DO IF (.NOT. found) THEN - counter = counter+1 + counter = counter + 1 id_work(counter) = atom_list(j)%id_name - mass(counter) = atom_info%atm_mass(first+j-1) - id_element(counter) = atom_info%id_element(first+j-1) - charge(counter) = atom_info%atm_charge(first+j-1) + mass(counter) = atom_info%atm_mass(first + j - 1) + id_element(counter) = atom_info%id_element(first + j - 1) + charge(counter) = atom_info%atm_charge(first + j - 1) IF (iw > 0) WRITE (iw, '(7X,A,1X,A5,F10.5,5X,A2,5X,F10.5)') & "NEW ATOMIC KIND", id2str(id_work(counter)), mass(counter), id2str(id_element(counter)), charge(counter) END IF @@ -252,7 +252,7 @@ SUBROUTINE topology_coordinate_pack(particle_set, atomic_kind_set, & DO i = 1, topology%natom_type DO j = 1, topology%natoms IF ((atom_info%id_atom_names(i) == atom_info%id_atmname(j)) .AND. (charge(i) == atom_info%atm_charge(j))) THEN - natom_of_kind(i) = natom_of_kind(i)+1 + natom_of_kind(i) = natom_of_kind(i) + 1 IF (kind_of(j) == 0) kind_of(j) = i END IF END DO @@ -280,7 +280,7 @@ SUBROUTINE topology_coordinate_pack(particle_set, atomic_kind_set, & counter = 0 DO j = 1, topology%natoms IF (kind_of(j) == i) THEN - counter = counter+1 + counter = counter + 1 iatomlist(counter) = j END IF END DO @@ -318,7 +318,7 @@ SUBROUTINE topology_coordinate_pack(particle_set, atomic_kind_set, & bounds(1, 3) = MINVAL(atom_info%r(3, :)) bounds(2, 3) = MAXVAL(atom_info%r(3, :)) - dims = bounds(2, :)-bounds(1, :) + dims = bounds(2, :) - bounds(1, :) cdims(1) = topology%cell%hmat(1, 1) cdims(2) = topology%cell%hmat(2, 2) cdims(3) = topology%cell%hmat(3, 3) @@ -347,7 +347,7 @@ SUBROUTINE topology_coordinate_pack(particle_set, atomic_kind_set, & ELSE vec = cdims/2.0_dp END IF - dims = (bounds(2, :)+bounds(1, :))/2.0_dp-vec + dims = (bounds(2, :) + bounds(1, :))/2.0_dp - vec ELSE dims = 0.0_dp END IF @@ -359,7 +359,7 @@ SUBROUTINE topology_coordinate_pack(particle_set, atomic_kind_set, & WRITE (iw, *) "atom number :: ", i, "kind number ::", ikind END IF particle_set(i)%atomic_kind => atomic_kind_set(ikind) - particle_set(i)%r(:) = atom_info%r(:, i)-dims + particle_set(i)%r(:) = atom_info%r(:, i) - dims particle_set(i)%atom_index = i END DO CALL timestop(handle2) @@ -445,7 +445,7 @@ SUBROUTINE topology_coordinate_pack(particle_set, atomic_kind_set, & DO i = 1, SIZE(ex_bond_list(iatom)%array1) ! a neighboring atom of iatom: atom_i = ex_bond_list(iatom)%array1(i) - DO j = 1, i-1 + DO j = 1, i - 1 ! another neighboring atom of iatom atom_j = ex_bond_list(iatom)%array1(j) ! It is only a true bend if there is no shorter path. @@ -460,9 +460,9 @@ SUBROUTINE topology_coordinate_pack(particle_set, atomic_kind_set, & END DO IF (check) CYCLE ! Add the genuine 1-3 pair - N = N+1 + N = N + 1 IF (SIZE(pairs, dim=1) <= N) THEN - CALL reallocate(pairs, 1, N+5, 1, 2) + CALL reallocate(pairs, 1, N + 5, 1, 2) END IF pairs(N, 1) = atom_i pairs(N, 2) = atom_j @@ -517,9 +517,9 @@ SUBROUTINE topology_coordinate_pack(particle_set, atomic_kind_set, & END DO IF (check) CYCLE ! Add the true onfo. - N = N+1 + N = N + 1 IF (SIZE(pairs, dim=1) <= N) THEN - CALL reallocate(pairs, 1, N+5, 1, 2) + CALL reallocate(pairs, 1, N + 5, 1, 2) END IF pairs(N, 1) = atom_i pairs(N, 2) = atom_j @@ -544,34 +544,34 @@ SUBROUTINE topology_coordinate_pack(particle_set, atomic_kind_set, & IF (topology%exclude_vdw == do_skip_12 .OR. & topology%exclude_vdw == do_skip_13 .OR. & topology%exclude_vdw == do_skip_14) dim1 = SIZE(ex_bond_list_vdw(iatom)%array1) - dim1 = dim1+dim0 + dim1 = dim1 + dim0 dim2 = 0 IF (topology%exclude_vdw == do_skip_13 .OR. & topology%exclude_vdw == do_skip_14) dim2 = SIZE(ex_bend_list(iatom)%array1) - dim2 = dim1+dim2 + dim2 = dim1 + dim2 dim3 = 0 IF (topology%exclude_vdw == do_skip_14) dim3 = SIZE(ex_onfo_list(iatom)%array1) - dim3 = dim2+dim3 + dim3 = dim2 + dim3 IF (dim3 /= 0) THEN NULLIFY (list, wlist) ALLOCATE (wlist(dim3)) wlist(dim0:dim0) = iatom - IF (dim1 > dim0) wlist(dim0+1:dim1) = ex_bond_list_vdw(iatom)%array1 - IF (dim2 > dim1) wlist(dim1+1:dim2) = ex_bend_list(iatom)%array1 - IF (dim3 > dim2) wlist(dim2+1:dim3) = ex_onfo_list(iatom)%array1 + IF (dim1 > dim0) wlist(dim0 + 1:dim1) = ex_bond_list_vdw(iatom)%array1 + IF (dim2 > dim1) wlist(dim1 + 1:dim2) = ex_bend_list(iatom)%array1 + IF (dim3 > dim2) wlist(dim2 + 1:dim3) = ex_onfo_list(iatom)%array1 ! Get a unique list - DO i = 1, SIZE(wlist)-1 + DO i = 1, SIZE(wlist) - 1 IF (wlist(i) == 0) CYCLE - DO j = i+1, SIZE(wlist) + DO j = i + 1, SIZE(wlist) IF (wlist(j) == wlist(i)) wlist(j) = 0 END DO END DO - dim3 = SIZE(wlist)-COUNT(wlist == 0) + dim3 = SIZE(wlist) - COUNT(wlist == 0) ALLOCATE (list(dim3)) j = 0 DO i = 1, SIZE(wlist) IF (wlist(i) == 0) CYCLE - j = j+1 + j = j + 1 list(j) = wlist(i) END DO DEALLOCATE (wlist) @@ -588,34 +588,34 @@ SUBROUTINE topology_coordinate_pack(particle_set, atomic_kind_set, & IF (topology%exclude_ei == do_skip_12 .OR. & topology%exclude_ei == do_skip_13 .OR. & topology%exclude_ei == do_skip_14) dim1 = SIZE(ex_bond_list_ei(iatom)%array1) - dim1 = dim1+dim0 + dim1 = dim1 + dim0 dim2 = 0 IF (topology%exclude_ei == do_skip_13 .OR. & topology%exclude_ei == do_skip_14) dim2 = SIZE(ex_bend_list(iatom)%array1) - dim2 = dim1+dim2 + dim2 = dim1 + dim2 dim3 = 0 IF (topology%exclude_ei == do_skip_14) dim3 = SIZE(ex_onfo_list(iatom)%array1) - dim3 = dim2+dim3 + dim3 = dim2 + dim3 IF (dim3 /= 0) THEN ALLOCATE (wlist(dim3)) wlist(dim0:dim0) = iatom - IF (dim1 > dim0) wlist(dim0+1:dim1) = ex_bond_list_ei(iatom)%array1 - IF (dim2 > dim1) wlist(dim1+1:dim2) = ex_bend_list(iatom)%array1 - IF (dim3 > dim2) wlist(dim2+1:dim3) = ex_onfo_list(iatom)%array1 + IF (dim1 > dim0) wlist(dim0 + 1:dim1) = ex_bond_list_ei(iatom)%array1 + IF (dim2 > dim1) wlist(dim1 + 1:dim2) = ex_bend_list(iatom)%array1 + IF (dim3 > dim2) wlist(dim2 + 1:dim3) = ex_onfo_list(iatom)%array1 ! Get a unique list - DO i = 1, SIZE(wlist)-1 + DO i = 1, SIZE(wlist) - 1 IF (wlist(i) == 0) CYCLE - DO j = i+1, SIZE(wlist) + DO j = i + 1, SIZE(wlist) IF (wlist(j) == wlist(i)) wlist(j) = 0 END DO END DO - dim3 = SIZE(wlist)-COUNT(wlist == 0) + dim3 = SIZE(wlist) - COUNT(wlist == 0) ALLOCATE (list2(dim3)) j = 0 DO i = 1, SIZE(wlist) IF (wlist(i) == 0) CYCLE - j = j+1 + j = j + 1 list2(j) = wlist(i) END DO DEALLOCATE (wlist) @@ -720,7 +720,7 @@ SUBROUTINE topology_coordinate_pack(particle_set, atomic_kind_set, & IF (method_name_id == do_fist) THEN CALL get_atomic_kind(atomic_kind=atomic_kind, fist_potential=fist_potential) CALL get_potential(potential=fist_potential, qeff=qeff) - IF ((id2str(atom_list(j)%id_name) == atmname) .AND. (qeff == atom_info%atm_charge(first+j-1))) THEN + IF ((id2str(atom_list(j)%id_name) == atmname) .AND. (qeff == atom_info%atm_charge(first + j - 1))) THEN atom_list(j)%atomic_kind => atomic_kind_set(k) EXIT END IF @@ -789,7 +789,7 @@ SUBROUTINE setup_exclusion_list(exclude_section, keyword, ex_bond_list, & c_vals=names) IF (((TRIM(names(1)) == TRIM(flag1)) .AND. (TRIM(names(2)) == TRIM(flag2))) .OR. & ((TRIM(names(1)) == TRIM(flag2)) .AND. (TRIM(names(2)) == TRIM(flag1)))) THEN - l = l+1 + l = l + 1 ex_bond_list_w(j)%array1(l) = ind END IF END DO diff --git a/src/topology_cp2k.F b/src/topology_cp2k.F index 1e41e9eed1..bf431dc807 100644 --- a/src/topology_cp2k.F +++ b/src/topology_cp2k.F @@ -139,7 +139,7 @@ SUBROUTINE read_coordinate_cp2k(topology, para_env, subsys_section) DO CALL parser_get_object(parser, object=string, newline=.TRUE., at_end=eof) IF (eof) EXIT - natom = natom+1 + natom = natom + 1 IF (natom > SIZE(atom_info%id_atmname)) THEN newsize = INT(pfactor*natom) CALL reallocate(atom_info%id_molname, 1, newsize) diff --git a/src/topology_generate_util.F b/src/topology_generate_util.F index b1284cc983..1e7fe3aed6 100644 --- a/src/topology_generate_util.F +++ b/src/topology_generate_util.F @@ -112,9 +112,9 @@ SUBROUTINE topology_generate_molname(conn_info, natom, natom_prev, nbond_prev, & ALLOCATE (atom_bond_list(I)%array1(0)) ENDDO N = 0 - IF (ASSOCIATED(conn_info%bond_a)) N = SIZE(conn_info%bond_a)-nbond_prev - CALL reorder_structure(atom_bond_list, conn_info%bond_a(nbond_prev+1:)-natom_prev, & - conn_info%bond_b(nbond_prev+1:)-natom_prev, N) + IF (ASSOCIATED(conn_info%bond_a)) N = SIZE(conn_info%bond_a) - nbond_prev + CALL reorder_structure(atom_bond_list, conn_info%bond_a(nbond_prev + 1:) - natom_prev, & + conn_info%bond_b(nbond_prev + 1:) - natom_prev, N) nmol = 0 check = ALL(id_molname == str2id(s2s("__UNDEF__"))) .OR. ALL(id_molname /= str2id(s2s("__UNDEF__"))) @@ -123,7 +123,7 @@ SUBROUTINE topology_generate_molname(conn_info, natom, natom_prev, nbond_prev, & IF (id2str(id_molname(i)) == "__UNDEF__") THEN molname = TRIM(basename)//ADJUSTL(cp_to_string(nmol)) CALL generate_molname_low(i, atom_bond_list, molname, id_molname) - nmol = nmol+1 + nmol = nmol + 1 END IF END DO DO I = 1, natom @@ -243,17 +243,17 @@ SUBROUTINE topology_generate_molecule(topology, qmmm, qmmm_env, subsys_section) DO iatom = 2, natom IF (topology%conn_type == do_conn_off) THEN ! No connectivity: each atom becomes a molecule of its own molecule kind - ntype = ntype+1 + ntype = ntype + 1 atom_info%map_mol_typ(iatom) = ntype ELSE IF (topology%conn_type == do_conn_user) THEN ! User-defined connectivity: 5th column of COORD section or molecule ! or residue name in the case of PDB files - IF (atom_info%id_molname(iatom) == atom_info%id_molname(iatom-1)) THEN - atom_info%map_mol_typ(iatom) = atom_info%map_mol_typ(iatom-1) - IF (atom_info%id_resname(iatom) == atom_info%id_resname(iatom-1)) THEN - atom_info%map_mol_res(iatom) = atom_info%map_mol_res(iatom-1) + IF (atom_info%id_molname(iatom) == atom_info%id_molname(iatom - 1)) THEN + atom_info%map_mol_typ(iatom) = atom_info%map_mol_typ(iatom - 1) + IF (atom_info%id_resname(iatom) == atom_info%id_resname(iatom - 1)) THEN + atom_info%map_mol_res(iatom) = atom_info%map_mol_res(iatom - 1) ELSE - resid = resid+1 + resid = resid + 1 atom_info%map_mol_res(iatom) = resid END IF ELSE @@ -267,19 +267,19 @@ SUBROUTINE topology_generate_molecule(topology, qmmm, qmmm_env, subsys_section) END IF END DO IF (.NOT. found) THEN - ntype = ntype+1 + ntype = ntype + 1 atom_info%map_mol_typ(iatom) = ntype IF (ntype > SIZE(wrk1)) CALL reallocate(wrk1, 1, 2*SIZE(wrk1)) wrk1(ntype) = atom_info%id_molname(iatom) END IF - resid = resid+1 + resid = resid + 1 atom_info%map_mol_res(iatom) = resid END IF ELSE - IF (atom_info%id_molname(iatom-1) == atom_info%id_molname(iatom)) THEN + IF (atom_info%id_molname(iatom - 1) == atom_info%id_molname(iatom)) THEN atom_info%map_mol_typ(iatom) = ntype ELSE - ntype = ntype+1 + ntype = ntype + 1 atom_info%map_mol_typ(iatom) = ntype END IF END IF @@ -322,12 +322,12 @@ SUBROUTINE topology_generate_molecule(topology, qmmm, qmmm_env, subsys_section) mol_typ = wrk1(istart) DO i = 2, natom IF (mol_typ /= wrk1(i)) THEN - iend = i-1 + iend = i - 1 first = MINVAL(wrk2(istart:iend)) last = MAXVAL(wrk2(istart:iend)) - nlocl = last-first+1 - IF (iend-istart+1 /= nlocl) THEN - IF (debug_this_module) WRITE (*, *) iend, istart, iend-istart+1, first, last, nlocl + nlocl = last - first + 1 + IF (iend - istart + 1 /= nlocl) THEN + IF (debug_this_module) WRITE (*, *) iend, istart, iend - istart + 1, first, last, nlocl CALL cp_abort(__LOCATION__, & "CP2K requires molecules to be contiguous and we have detected a non contiguous one!! "// & "In particular a molecule defined from index ("//cp_to_string(first)//") to ("// & @@ -340,12 +340,12 @@ SUBROUTINE topology_generate_molecule(topology, qmmm, qmmm_env, subsys_section) mol_typ = wrk1(istart) END IF END DO - iend = i-1 + iend = i - 1 first = MINVAL(wrk2(istart:iend)) last = MAXVAL(wrk2(istart:iend)) - nlocl = last-first+1 - IF (iend-istart+1 /= nlocl) THEN - IF (debug_this_module) WRITE (*, *) iend, istart, iend-istart+1, first, last, nlocl + nlocl = last - first + 1 + IF (iend - istart + 1 /= nlocl) THEN + IF (debug_this_module) WRITE (*, *) iend, istart, iend - istart + 1, first, last, nlocl CALL cp_abort(__LOCATION__, & "CP2K requires molecules to be contiguous and we have detected a non contiguous one!! "// & "In particular a molecule defined from index ("//cp_to_string(first)//") to ("// & @@ -363,10 +363,10 @@ SUBROUTINE topology_generate_molecule(topology, qmmm, qmmm_env, subsys_section) mol_num = 1 atom_info%map_mol_num(1) = 1 DO iatom = 2, natom - IF (atom_info%id_molname(iatom) /= atom_info%id_molname(iatom-1)) THEN + IF (atom_info%id_molname(iatom) /= atom_info%id_molname(iatom - 1)) THEN mol_num = 1 - ELSE IF (atom_info%map_mol_res(iatom) /= atom_info%map_mol_res(iatom-1)) THEN - mol_num = mol_num+1 + ELSE IF (atom_info%map_mol_res(iatom) /= atom_info%map_mol_res(iatom - 1)) THEN + mol_num = mol_num + 1 END IF atom_info%map_mol_num(iatom) = mol_num END DO @@ -375,12 +375,12 @@ SUBROUTINE topology_generate_molecule(topology, qmmm, qmmm_env, subsys_section) mol_num = atom_info%map_mol_num(1) DO i = 2, natom IF (atom_info%map_mol_typ(i) /= mol_typ) THEN - myind = atom_info%map_mol_num(i)-mol_num+1 - CPASSERT(myind /= atom_info%map_mol_num(i-1)) + myind = atom_info%map_mol_num(i) - mol_num + 1 + CPASSERT(myind /= atom_info%map_mol_num(i - 1)) mol_typ = atom_info%map_mol_typ(i) mol_num = atom_info%map_mol_num(i) END IF - atom_info%map_mol_num(i) = atom_info%map_mol_num(i)-mol_num+1 + atom_info%map_mol_num(i) = atom_info%map_mol_num(i) - mol_num + 1 END DO END IF IF (iw > 0) WRITE (UNIT=iw, FMT="(/,T2,A)") "End of renumbering molecules" @@ -396,11 +396,11 @@ SUBROUTINE topology_generate_molecule(topology, qmmm, qmmm_env, subsys_section) mol_num = 1 atom_info%map_mol_num(1) = 1 DO iatom = 2, natom - IF (atom_info%id_molname(iatom) /= atom_info%id_molname(iatom-1)) THEN - ntype = ntype+1 + IF (atom_info%id_molname(iatom) /= atom_info%id_molname(iatom - 1)) THEN + ntype = ntype + 1 mol_num = 1 - ELSE IF (atom_info%map_mol_res(iatom) /= atom_info%map_mol_res(iatom-1)) THEN - mol_num = mol_num+1 + ELSE IF (atom_info%map_mol_res(iatom) /= atom_info%map_mol_res(iatom - 1)) THEN + mol_num = mol_num + 1 END IF atom_info%map_mol_typ(iatom) = ntype atom_info%map_mol_num(iatom) = mol_num @@ -411,9 +411,9 @@ SUBROUTINE topology_generate_molecule(topology, qmmm, qmmm_env, subsys_section) mol_num = atom_info%map_mol_num(1) atom_info%map_mol_res(1) = mol_res DO i = 2, natom - IF ((atom_info%resid(i-1) /= atom_info%resid(i)) .OR. & - (atom_info%id_resname(i-1) /= atom_info%id_resname(i))) THEN - mol_res = mol_res+1 + IF ((atom_info%resid(i - 1) /= atom_info%resid(i)) .OR. & + (atom_info%id_resname(i - 1) /= atom_info%id_resname(i))) THEN + mol_res = mol_res + 1 END IF IF ((atom_info%map_mol_typ(i) /= mol_typ) .OR. & (atom_info%map_mol_num(i) /= mol_num)) THEN @@ -461,34 +461,34 @@ SUBROUTINE topology_generate_molecule(topology, qmmm, qmmm_env, subsys_section) IF (iw > 0) WRITE (iw, *) "QM Molecule name :: ", id2str(atom_info%id_molname(iatm)) WHERE (qm_atom_index == iatm) qm_atom_index = 0 END DO - DO iatm = 1, ifirst-1 + DO iatm = 1, ifirst - 1 IF (ANY(qm_atom_index == iatm)) do_again = .TRUE. END DO - DO iatm = ilast+1, natom + DO iatm = ilast + 1, natom IF (ANY(qm_atom_index == iatm)) do_again = .TRUE. END DO IF (iw > 0) WRITE (iw, *) " Another QM fragment? :: ", do_again IF (ifirst /= 1) THEN - jump1 = atom_info%map_mol_typ(ifirst)-atom_info%map_mol_typ(ifirst-1) + jump1 = atom_info%map_mol_typ(ifirst) - atom_info%map_mol_typ(ifirst - 1) CPASSERT(jump1 <= 1 .AND. jump1 >= 0) - jump1 = ABS(jump1-1) + jump1 = ABS(jump1 - 1) ELSE jump1 = 0 END IF IF (ilast /= natom) THEN - jump2 = atom_info%map_mol_typ(ilast+1)-atom_info%map_mol_typ(ilast) + jump2 = atom_info%map_mol_typ(ilast + 1) - atom_info%map_mol_typ(ilast) CPASSERT(jump2 <= 1 .AND. jump2 >= 0) - jump2 = ABS(jump2-1) + jump2 = ABS(jump2 - 1) ELSE jump2 = 0 END IF ! Changing mol_type consistently DO iatm = ifirst, natom - atom_info%map_mol_typ(iatm) = atom_info%map_mol_typ(iatm)+jump1 + atom_info%map_mol_typ(iatm) = atom_info%map_mol_typ(iatm) + jump1 END DO - DO iatm = ilast+1, natom - atom_info%map_mol_typ(iatm) = atom_info%map_mol_typ(iatm)+jump2 + DO iatm = ilast + 1, natom + atom_info%map_mol_typ(iatm) = atom_info%map_mol_typ(iatm) + jump2 END DO IF (jump1 == 1) THEN DO iatm = ifirst, ilast @@ -497,14 +497,14 @@ SUBROUTINE topology_generate_molecule(topology, qmmm, qmmm_env, subsys_section) END IF IF (jump2 == 1) THEN - CALL find_boundary(atom_info%map_mol_typ, natom, first, last, atom_info%map_mol_typ(ilast+1)) + CALL find_boundary(atom_info%map_mol_typ, natom, first, last, atom_info%map_mol_typ(ilast + 1)) CALL find_boundary(atom_info%map_mol_typ, atom_info%map_mol_num, natom, ifirst, ilast, & - atom_info%map_mol_typ(ilast+1), atom_info%map_mol_num(ilast+1)) - atom_in_mol = ilast-ifirst+1 + atom_info%map_mol_typ(ilast + 1), atom_info%map_mol_num(ilast + 1)) + atom_in_mol = ilast - ifirst + 1 inum = 1 DO iatm = first, last, atom_in_mol - atom_info%map_mol_num(iatm:iatm+atom_in_mol-1) = inum - inum = inum+1 + atom_info%map_mol_num(iatm:iatm + atom_in_mol - 1) = inum + inum = inum + 1 END DO END IF @@ -532,7 +532,7 @@ SUBROUTINE topology_generate_molecule(topology, qmmm, qmmm_env, subsys_section) IF (atom_in_kind <= 1) CYCLE CALL find_boundary(atom_info%map_mol_typ, natom, first, last, i) WRITE (iw, *) "Boundary atoms:", first, last - CPASSERT(last-first+1 == atom_in_kind) + CPASSERT(last - first + 1 == atom_in_kind) max_mol_num = MAXVAL(atom_info%map_mol_num(first:last)) WRITE (iw, *) "Number of molecules of kind", i, "is ::", max_mol_num atom_in_mol = atom_in_kind/max_mol_num @@ -613,8 +613,8 @@ SUBROUTINE topology_generate_bond(topology, para_env, subsys_section) CALL section_vals_val_get(isolated_section, "LIST", n_rep_val=n_rep) DO i = 1, n_rep CALL section_vals_val_get(isolated_section, "LIST", i_vals=tmp_v, i_rep_val=i) - CALL reallocate(isolated_atoms, 1, SIZE(isolated_atoms)+SIZE(tmp_v)) - isolated_atoms(SIZE(isolated_atoms)-SIZE(tmp_v)+1:SIZE(isolated_atoms)) = tmp_v + CALL reallocate(isolated_atoms, 1, SIZE(isolated_atoms) + SIZE(tmp_v)) + isolated_atoms(SIZE(isolated_atoms) - SIZE(tmp_v) + 1:SIZE(isolated_atoms)) = tmp_v END DO END IF atom_info => topology%atom_info @@ -695,7 +695,7 @@ SUBROUTINE topology_generate_bond(topology, para_env, subsys_section) END IF npairs = 0 DO i = 1, SIZE(nonbonded%neighbor_kind_pairs) - npairs = npairs+nonbonded%neighbor_kind_pairs(i)%npairs + npairs = npairs + nonbonded%neighbor_kind_pairs(i)%npairs END DO ALLOCATE (bond_a(npairs)) ALLOCATE (bond_b(npairs)) @@ -703,7 +703,7 @@ SUBROUTINE topology_generate_bond(topology, para_env, subsys_section) idim = 0 DO j = 1, SIZE(nonbonded%neighbor_kind_pairs) DO i = 1, nonbonded%neighbor_kind_pairs(j)%npairs - idim = idim+1 + idim = idim + 1 bond_a(idim) = nonbonded%neighbor_kind_pairs(j)%list(1, i) bond_b(idim) = nonbonded%neighbor_kind_pairs(j)%list(2, i) map_nb(idim) = j @@ -750,7 +750,7 @@ SUBROUTINE topology_generate_bond(topology, para_env, subsys_section) k = ABS(k) CALL matvec_3x3(cell_v, topology%cell%hmat, & REAL(nonbonded%neighbor_kind_pairs(k)%cell_vector, KIND=dp)) - dr = pbc_coord(:, iatm1)-pbc_coord(:, iatm2)-ksign*cell_v + dr = pbc_coord(:, iatm1) - pbc_coord(:, iatm2) - ksign*cell_v r2 = DOT_PRODUCT(dr, dr) IF (r2 <= r_minsq(1, 1)) THEN CALL cp_abort(__LOCATION__, & @@ -762,7 +762,7 @@ SUBROUTINE topology_generate_bond(topology, para_env, subsys_section) ! Screen neighbors IF (topology%bondparm_type == do_bondparm_covalent) THEN - rbond = radius(iatm1)+radius(iatm2) + rbond = radius(iatm1) + radius(iatm2) ELSE IF (topology%bondparm_type == do_bondparm_vdw) THEN rbond = MAX(radius(iatm1), radius(iatm2)) END IF @@ -770,7 +770,7 @@ SUBROUTINE topology_generate_bond(topology, para_env, subsys_section) rbond2 = rbond2*(bondparm_factor)**2 !Test the distance to the sum of the covalent radius IF (r2 <= rbond2) THEN - n_heavy_bonds = n_heavy_bonds+1 + n_heavy_bonds = n_heavy_bonds + 1 CALL add_bonds_list(conn_info, iatm1, iatm2, n_heavy_bonds) END IF END DO @@ -798,7 +798,7 @@ SUBROUTINE topology_generate_bond(topology, para_env, subsys_section) k = ABS(k) CALL matvec_3x3(cell_v, topology%cell%hmat, & REAL(nonbonded%neighbor_kind_pairs(k)%cell_vector, KIND=dp)) - dr = pbc_coord(:, iatm1)-pbc_coord(:, iatm2)-ksign*cell_v + dr = pbc_coord(:, iatm1) - pbc_coord(:, iatm2) - ksign*cell_v r2 = DOT_PRODUCT(dr, dr) IF (r2 <= r_minsq(1, 1)) THEN CALL cp_abort(__LOCATION__, & @@ -816,8 +816,8 @@ SUBROUTINE topology_generate_bond(topology, para_env, subsys_section) "WARNING:: No connections detected for Hydrogen - Atom Nr:", iatm1, " !" END IF ELSE - n_hydr_bonds = n_hydr_bonds+1 - n_bonds = n_bonds+1 + n_hydr_bonds = n_hydr_bonds + 1 + n_bonds = n_bonds + 1 CALL add_bonds_list(conn_info, MIN(iatm1, ibond), MAX(iatm1, ibond), n_bonds) END IF END DO @@ -901,7 +901,7 @@ SUBROUTINE topology_generate_bond(topology, para_env, subsys_section) (atom_info%id_resname(iatom) /= atom_info%id_resname(jatom))) THEN IF (iw > 0) WRITE (iw, *) " PARA_RES, bond between molecules atom ", & iatom, jatom - cbond = cbond+1 + cbond = cbond + 1 CALL reallocate(conn_info%c_bond_a, 1, cbond) CALL reallocate(conn_info%c_bond_b, 1, cbond) conn_info%c_bond_a(cbond) = iatom @@ -989,13 +989,13 @@ FUNCTION check_generate_mol(bond_a, bond_b, atom_info, bondparm_factor, output_u mol_info_tmp(1, 1) = itype DO i = 2, natom IF (mol_map(i) /= itype) THEN - nsize = nsize+1 + nsize = nsize + 1 itype = mol_map(i) mol_info_tmp(nsize, 1) = itype - mol_info_tmp(nsize-1, 2) = idim + mol_info_tmp(nsize - 1, 2) = idim idim = 1 ELSE - idim = idim+1 + idim = idim + 1 END IF END DO mol_info_tmp(nsize, 2) = idim @@ -1019,7 +1019,7 @@ FUNCTION check_generate_mol(bond_a, bond_b, atom_info, bondparm_factor, output_u DO j = 1, SIZE(mol_info) IF (itype == mol_info(j, 1)) EXIT END DO - mol_info(j, 3) = mol_info(j, 3)+1 + mol_info(j, 3) = mol_info(j, 3) + 1 IF (mol_info(j, 4) == 0) mol_info(j, 4) = mol_natom IF (mol_info(j, 4) /= mol_natom) THEN ! Two same molecules have been found with different number @@ -1099,8 +1099,8 @@ SUBROUTINE connectivity_external_control(section, Iarray1, Iarray2, Iarray3, Iar ip3 = PRESENT(Iarray3) ip4 = PRESENT(Iarray4) nsize = 2 - IF (ip3) nsize = nsize+1 - IF (ip3 .AND. ip4) nsize = nsize+1 + IF (ip3) nsize = nsize + 1 + IF (ip3 .AND. ip4) nsize = nsize + 1 ! Put the lists always in the canonical order CALL reorder_list_array(Iarray1, Iarray2, Iarray3, Iarray4, nsize, nvar) ! Go on with external control @@ -1136,20 +1136,20 @@ SUBROUTINE connectivity_external_control(section, Iarray1, Iarray2, Iarray3, Iar CALL section_vals_val_get(section, "ATOMS", i_rep_section=i, i_rep_val=j, & i_vals=atlist) CPASSERT(SIZE(atlist) == nsize) - CALL integer_to_string(nsize-1, fmt) + CALL integer_to_string(nsize - 1, fmt) CALL check_element_list(do_it, do_action, atlist, Ilist1, Ilist2, Ilist3, Ilist4, & is_impr) IF (do_action == do_add) THEN ! Add to the element to the list IF (do_it > 0) THEN - nvar = nvar+1 + nvar = nvar + 1 IF (output_unit > 0) THEN WRITE (output_unit, '(T2,"ADD|",1X,A,I6,'//TRIM(fmt)//'(A,I6),A,T64,A,I6)') & "element (", & atlist(1), (",", atlist(k), k=2, nsize), ") added.", " NEW size::", nvar END IF IF (nvar > SIZE(Iarray1)) THEN - new_size = INT(5+1.2*nvar) + new_size = INT(5 + 1.2*nvar) CALL reallocate(Iarray1, 1, new_size) CALL reallocate(Iarray2, 1, new_size) SELECT CASE (nsize) @@ -1161,17 +1161,17 @@ SUBROUTINE connectivity_external_control(section, Iarray1, Iarray2, Iarray3, Iar END SELECT END IF ! Using Ilist instead of atlist the canonical order is preserved.. - Iarray1(do_it+1:nvar) = Iarray1(do_it:nvar-1) - Iarray2(do_it+1:nvar) = Iarray2(do_it:nvar-1) + Iarray1(do_it + 1:nvar) = Iarray1(do_it:nvar - 1) + Iarray2(do_it + 1:nvar) = Iarray2(do_it:nvar - 1) Iarray1(do_it) = Ilist1(do_it) Iarray2(do_it) = Ilist2(do_it) SELECT CASE (nsize) CASE (3) - Iarray3(do_it+1:nvar) = Iarray3(do_it:nvar-1) + Iarray3(do_it + 1:nvar) = Iarray3(do_it:nvar - 1) Iarray3(do_it) = Ilist3(do_it) CASE (4) - Iarray3(do_it+1:nvar) = Iarray3(do_it:nvar-1) - Iarray4(do_it+1:nvar) = Iarray4(do_it:nvar-1) + Iarray3(do_it + 1:nvar) = Iarray3(do_it:nvar - 1) + Iarray4(do_it + 1:nvar) = Iarray4(do_it:nvar - 1) Iarray3(do_it) = Ilist3(do_it) Iarray4(do_it) = Ilist4(do_it) END SELECT @@ -1185,25 +1185,25 @@ SUBROUTINE connectivity_external_control(section, Iarray1, Iarray2, Iarray3, Iar ELSE ! Remove element from the list IF (do_it > 0) THEN - nvar = nvar-1 + nvar = nvar - 1 IF (output_unit > 0) THEN WRITE (output_unit, '(T2,"RMV|",1X,A,I6,'//TRIM(fmt)//'(A,I6),A,T64,A,I6)') & "element (", & atlist(1), (",", atlist(k), k=2, nsize), ") removed.", " NEW size::", nvar END IF - Iarray1(do_it:nvar) = Iarray1(do_it+1:nvar+1) - Iarray2(do_it:nvar) = Iarray2(do_it+1:nvar+1) - Iarray1(nvar+1) = -HUGE(0) - Iarray2(nvar+1) = -HUGE(0) + Iarray1(do_it:nvar) = Iarray1(do_it + 1:nvar + 1) + Iarray2(do_it:nvar) = Iarray2(do_it + 1:nvar + 1) + Iarray1(nvar + 1) = -HUGE(0) + Iarray2(nvar + 1) = -HUGE(0) SELECT CASE (nsize) CASE (3) - Iarray3(do_it:nvar) = Iarray3(do_it+1:nvar+1) - Iarray3(nvar+1) = -HUGE(0) + Iarray3(do_it:nvar) = Iarray3(do_it + 1:nvar + 1) + Iarray3(nvar + 1) = -HUGE(0) CASE (4) - Iarray3(do_it:nvar) = Iarray3(do_it+1:nvar+1) - Iarray4(do_it:nvar) = Iarray4(do_it+1:nvar+1) - Iarray3(nvar+1) = -HUGE(0) - Iarray4(nvar+1) = -HUGE(0) + Iarray3(do_it:nvar) = Iarray3(do_it + 1:nvar + 1) + Iarray4(do_it:nvar) = Iarray4(do_it + 1:nvar + 1) + Iarray3(nvar + 1) = -HUGE(0) + Iarray4(nvar + 1) = -HUGE(0) END SELECT ELSE IF (output_unit > 0) THEN @@ -1366,12 +1366,12 @@ SUBROUTINE check_element_list(do_it, do_action, atlist, Ilist1, Ilist2, Ilist3, END DO ! if nothing there stay within bounds IF (istart <= ndim) THEN - IF (Ilist1(istart) > tmp(1) .AND. (istart /= 1)) istart = istart-1 + IF (Ilist1(istart) > tmp(1) .AND. (istart /= 1)) istart = istart - 1 ENDIF DO iend = istart, ndim IF (Ilist1(iend) /= tmp(1)) EXIT END DO - IF (iend == ndim+1) iend = ndim + IF (iend == ndim + 1) iend = ndim ! Final search in array SELECT CASE (nsize) CASE (2) @@ -1414,23 +1414,23 @@ SUBROUTINE check_element_list(do_it, do_action, atlist, Ilist1, Ilist2, Ilist3, ! the one we're searching for ! At the end do_it gives the exact location of the element in the canonical list do_it = i - new_size = ndim+1 + new_size = ndim + 1 CALL reallocate(Ilist1, 1, new_size) CALL reallocate(Ilist2, 1, new_size) - Ilist1(i+1:new_size) = Ilist1(i:ndim) - Ilist2(i+1:new_size) = Ilist2(i:ndim) + Ilist1(i + 1:new_size) = Ilist1(i:ndim) + Ilist2(i + 1:new_size) = Ilist2(i:ndim) Ilist1(i) = tmp(1) Ilist2(i) = tmp(2) SELECT CASE (nsize) CASE (3) CALL reallocate(Ilist3, 1, new_size) - Ilist3(i+1:new_size) = Ilist3(i:ndim) + Ilist3(i + 1:new_size) = Ilist3(i:ndim) Ilist3(i) = tmp(3) CASE (4) CALL reallocate(Ilist3, 1, new_size) CALL reallocate(Ilist4, 1, new_size) - Ilist3(i+1:new_size) = Ilist3(i:ndim) - Ilist4(i+1:new_size) = Ilist4(i:ndim) + Ilist3(i + 1:new_size) = Ilist3(i:ndim) + Ilist4(i + 1:new_size) = Ilist4(i:ndim) Ilist3(i) = tmp(3) Ilist4(i) = tmp(4) END SELECT @@ -1439,18 +1439,18 @@ SUBROUTINE check_element_list(do_it, do_action, atlist, Ilist1, Ilist2, Ilist3, IF (found) THEN do_it = i ! Let's delete the element in position do_it - new_size = ndim-1 - Ilist1(i:new_size) = Ilist1(i+1:ndim) - Ilist2(i:new_size) = Ilist2(i+1:ndim) + new_size = ndim - 1 + Ilist1(i:new_size) = Ilist1(i + 1:ndim) + Ilist2(i:new_size) = Ilist2(i + 1:ndim) CALL reallocate(Ilist1, 1, new_size) CALL reallocate(Ilist2, 1, new_size) SELECT CASE (nsize) CASE (3) - Ilist3(i:new_size) = Ilist3(i+1:ndim) + Ilist3(i:new_size) = Ilist3(i + 1:ndim) CALL reallocate(Ilist3, 1, new_size) CASE (4) - Ilist3(i:new_size) = Ilist3(i+1:ndim) - Ilist4(i:new_size) = Ilist4(i+1:ndim) + Ilist3(i:new_size) = Ilist3(i + 1:ndim) + Ilist4(i:new_size) = Ilist4(i + 1:ndim) CALL reallocate(Ilist3, 1, new_size) CALL reallocate(Ilist4, 1, new_size) END SELECT @@ -1479,7 +1479,7 @@ SUBROUTINE add_bonds_list(conn_info, atm1, atm2, n_bonds) old_size = SIZE(conn_info%bond_a) IF (n_bonds > old_size) THEN - new_size = INT(5+1.2*old_size) + new_size = INT(5 + 1.2*old_size) CALL reallocate(conn_info%bond_a, 1, new_size) CALL reallocate(conn_info%bond_b, 1, new_size) END IF @@ -1525,7 +1525,7 @@ SUBROUTINE topology_generate_bend(topology, subsys_section) CALL reallocate(conn_info%bond_b, 1, nbond) END IF IF (nbond /= 0) THEN - nsize = INT(5+1.2*ntheta) + nsize = INT(5 + 1.2*ntheta) CALL reallocate(conn_info%theta_a, 1, nsize) CALL reallocate(conn_info%theta_b, 1, nsize) CALL reallocate(conn_info%theta_c, 1, nsize) @@ -1645,7 +1645,7 @@ RECURSIVE SUBROUTINE match_iterative_path(Iarray1, Iarray2, Iarray3, & CALL match_iterative_path(Iarray1=Iarray1, & Iarray2=Iarray2, & Iarray3=Iarray3, & - it_levl=my_levl+1, & + it_levl=my_levl + 1, & max_levl=max_levl, & Oarray1=Oarray1, & Oarray2=Oarray2, & @@ -1664,7 +1664,7 @@ RECURSIVE SUBROUTINE match_iterative_path(Iarray1, Iarray2, Iarray3, & CASE (4) wrk => Iarray3 END SELECT - i = Ilist(it_levl-1) + i = Ilist(it_levl - 1) DO j = 1, SIZE(Iarray1(i)%array1) ind = wrk(i)%array1(j) IF (ANY(Ilist == ind)) CYCLE @@ -1673,7 +1673,7 @@ RECURSIVE SUBROUTINE match_iterative_path(Iarray1, Iarray2, Iarray3, & CALL match_iterative_path(Iarray1=Iarray1, & Iarray2=Iarray2, & Iarray3=Iarray3, & - it_levl=it_levl+1, & + it_levl=it_levl + 1, & max_levl=max_levl, & Oarray1=Oarray1, & Oarray2=Oarray2, & @@ -1685,30 +1685,30 @@ RECURSIVE SUBROUTINE match_iterative_path(Iarray1, Iarray2, Iarray3, & ELSEIF (it_levl == max_levl) THEN IF (Ilist(1) > ind) CYCLE Ilist(it_levl) = ind - nvar = nvar+1 + nvar = nvar + 1 SELECT CASE (it_levl) CASE (2) IF (nvar > SIZE(Oarray1)) THEN - CALL reallocate(Oarray1, 1, INT(5+1.2*nvar)) - CALL reallocate(Oarray2, 1, INT(5+1.2*nvar)) + CALL reallocate(Oarray1, 1, INT(5 + 1.2*nvar)) + CALL reallocate(Oarray2, 1, INT(5 + 1.2*nvar)) END IF Oarray1(nvar) = Ilist(1) Oarray2(nvar) = Ilist(2) CASE (3) IF (nvar > SIZE(Oarray1)) THEN - CALL reallocate(Oarray1, 1, INT(5+1.2*nvar)) - CALL reallocate(Oarray2, 1, INT(5+1.2*nvar)) - CALL reallocate(Oarray3, 1, INT(5+1.2*nvar)) + CALL reallocate(Oarray1, 1, INT(5 + 1.2*nvar)) + CALL reallocate(Oarray2, 1, INT(5 + 1.2*nvar)) + CALL reallocate(Oarray3, 1, INT(5 + 1.2*nvar)) END IF Oarray1(nvar) = Ilist(1) Oarray2(nvar) = Ilist(2) Oarray3(nvar) = Ilist(3) CASE (4) IF (nvar > SIZE(Oarray1)) THEN - CALL reallocate(Oarray1, 1, INT(5+1.2*nvar)) - CALL reallocate(Oarray2, 1, INT(5+1.2*nvar)) - CALL reallocate(Oarray3, 1, INT(5+1.2*nvar)) - CALL reallocate(Oarray4, 1, INT(5+1.2*nvar)) + CALL reallocate(Oarray1, 1, INT(5 + 1.2*nvar)) + CALL reallocate(Oarray2, 1, INT(5 + 1.2*nvar)) + CALL reallocate(Oarray3, 1, INT(5 + 1.2*nvar)) + CALL reallocate(Oarray4, 1, INT(5 + 1.2*nvar)) END IF Oarray1(nvar) = Ilist(1) Oarray2(nvar) = Ilist(2) @@ -1802,7 +1802,7 @@ SUBROUTINE topology_generate_dihe(topology, subsys_section) nphi = 0 nbond = SIZE(conn_info%bond_a) IF (nbond /= 0) THEN - nsize = INT(5+1.2*nphi) + nsize = INT(5 + 1.2*nphi) CALL reallocate(conn_info%phi_a, 1, nsize) CALL reallocate(conn_info%phi_b, 1, nsize) CALL reallocate(conn_info%phi_c, 1, nsize) @@ -1893,7 +1893,7 @@ SUBROUTINE topology_generate_impr(topology, subsys_section) nimpr = 0 nbond = SIZE(conn_info%bond_a) IF (nbond /= 0) THEN - nsize = INT(5+1.2*nimpr) + nsize = INT(5 + 1.2*nimpr) CALL reallocate(conn_info%impr_a, 1, nsize) CALL reallocate(conn_info%impr_b, 1, nsize) CALL reallocate(conn_info%impr_c, 1, nsize) @@ -1922,9 +1922,9 @@ SUBROUTINE topology_generate_impr(topology, subsys_section) END DO END IF IF (.NOT. accept_impr) CYCLE - nimpr = nimpr+1 + nimpr = nimpr + 1 IF (nimpr > SIZE(conn_info%impr_a)) THEN - nsize = INT(5+1.2*nimpr) + nsize = INT(5 + 1.2*nimpr) CALL reallocate(conn_info%impr_a, 1, nsize) CALL reallocate(conn_info%impr_b, 1, nsize) CALL reallocate(conn_info%impr_c, 1, nsize) @@ -2034,8 +2034,8 @@ SUBROUTINE topology_generate_onfo(topology, subsys_section) ! Avoid onfo's in 5-rings. IF (ANY(atom_b == theta_list(atom_a)%array1)) CYCLE ! Avoid onfo's in 6-rings. - IF (ANY(atom_b == phi_list(atom_a)%array1(:i-1))) CYCLE - ionfo = ionfo+1 + IF (ANY(atom_b == phi_list(atom_a)%array1(:i - 1))) CYCLE + ionfo = ionfo + 1 conn_info%onfo_a(ionfo) = atom_a conn_info%onfo_b(ionfo) = atom_b END DO diff --git a/src/topology_gromos.F b/src/topology_gromos.F index b2582c68bb..072cae45c2 100644 --- a/src/topology_gromos.F +++ b/src/topology_gromos.F @@ -190,16 +190,16 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) IF (found) THEN CALL parser_get_next_line(parser, 1) CALL parser_get_object(parser, natom) - CALL reallocate(atom_info%id_molname, 1, natom_prev+natom) - CALL reallocate(atom_info%resid, 1, natom_prev+natom) - CALL reallocate(atom_info%id_resname, 1, natom_prev+natom) - CALL reallocate(atom_info%id_atmname, 1, natom_prev+natom) - CALL reallocate(atom_info%id_element, 1, natom_prev+natom) - CALL reallocate(atom_info%atm_charge, 1, natom_prev+natom) - CALL reallocate(atom_info%atm_mass, 1, natom_prev+natom) + CALL reallocate(atom_info%id_molname, 1, natom_prev + natom) + CALL reallocate(atom_info%resid, 1, natom_prev + natom) + CALL reallocate(atom_info%id_resname, 1, natom_prev + natom) + CALL reallocate(atom_info%id_atmname, 1, natom_prev + natom) + CALL reallocate(atom_info%id_element, 1, natom_prev + natom) + CALL reallocate(atom_info%atm_charge, 1, natom_prev + natom) + CALL reallocate(atom_info%atm_mass, 1, natom_prev + natom) CALL parser_get_next_line(parser, 1) DO iatom = 1, natom - index_now = iatom+natom_prev + index_now = iatom + natom_prev CALL parser_get_object(parser, itemp) CALL parser_get_object(parser, itemp) atom_info%resid(index_now) = itemp @@ -240,12 +240,12 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) CALL parser_get_next_line(parser, 1) CALL parser_get_object(parser, ntype) IF (ntype /= 0) THEN - itemp = (itemp-1)/6+1 + itemp = (itemp - 1)/6 + 1 offset = 0 IF (ASSOCIATED(conn_info%onfo_a)) offset = SIZE(conn_info%onfo_a) - CALL reallocate(conn_info%onfo_a, 1, offset+ntype) - CALL reallocate(conn_info%onfo_b, 1, offset+ntype) - conn_info%onfo_a(offset+1:offset+ntype) = index_now + CALL reallocate(conn_info%onfo_a, 1, offset + ntype) + CALL reallocate(conn_info%onfo_b, 1, offset + ntype) + conn_info%onfo_a(offset + 1:offset + ntype) = index_now DO i = 1, 50 ii(i) = -1 END DO @@ -267,7 +267,7 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) IF (stat .EQ. 0) EXIT END DO DO i = 1, ntype - conn_info%onfo_b(offset+i) = ii(i) + conn_info%onfo_b(offset + i) = ii(i) END DO END IF CALL parser_get_next_line(parser, 1) @@ -289,19 +289,19 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) CALL parser_get_object(parser, ntype) offset = 0 IF (ASSOCIATED(conn_info%bond_a)) offset = SIZE(conn_info%bond_a) - CALL reallocate(conn_info%bond_a, 1, offset+ntype) - CALL reallocate(conn_info%bond_b, 1, offset+ntype) - CALL reallocate(conn_info%bond_type, 1, offset+ntype) + CALL reallocate(conn_info%bond_a, 1, offset + ntype) + CALL reallocate(conn_info%bond_b, 1, offset + ntype) + CALL reallocate(conn_info%bond_type, 1, offset + ntype) DO itype = 1, ntype CALL parser_get_next_line(parser, 1) - CALL parser_get_object(parser, conn_info%bond_a(offset+itype)) - CALL parser_get_object(parser, conn_info%bond_b(offset+itype)) + CALL parser_get_object(parser, conn_info%bond_a(offset + itype)) + CALL parser_get_object(parser, conn_info%bond_b(offset + itype)) CALL parser_get_object(parser, itemp) - conn_info%bond_type(offset+itype) = itemp + conn_info%bond_type(offset + itype) = itemp IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT BONDH INFO HERE!!!!" END DO - conn_info%bond_a(offset+1:offset+ntype) = conn_info%bond_a(offset+1:offset+ntype)+natom_prev - conn_info%bond_b(offset+1:offset+ntype) = conn_info%bond_b(offset+1:offset+ntype)+natom_prev + conn_info%bond_a(offset + 1:offset + ntype) = conn_info%bond_a(offset + 1:offset + ntype) + natom_prev + conn_info%bond_b(offset + 1:offset + ntype) = conn_info%bond_b(offset + 1:offset + ntype) + natom_prev END IF ! BOND SECTION IF (iw > 0) WRITE (iw, '(T2,A)') 'GTOP_INFO| Parsing the BOND section' @@ -312,19 +312,19 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) CALL parser_get_object(parser, ntype) offset = 0 IF (ASSOCIATED(conn_info%bond_a)) offset = SIZE(conn_info%bond_a) - CALL reallocate(conn_info%bond_a, 1, offset+ntype) - CALL reallocate(conn_info%bond_b, 1, offset+ntype) - CALL reallocate(conn_info%bond_type, 1, offset+ntype) + CALL reallocate(conn_info%bond_a, 1, offset + ntype) + CALL reallocate(conn_info%bond_b, 1, offset + ntype) + CALL reallocate(conn_info%bond_type, 1, offset + ntype) DO itype = 1, ntype CALL parser_get_next_line(parser, 1) - CALL parser_get_object(parser, conn_info%bond_a(offset+itype)) - CALL parser_get_object(parser, conn_info%bond_b(offset+itype)) + CALL parser_get_object(parser, conn_info%bond_a(offset + itype)) + CALL parser_get_object(parser, conn_info%bond_b(offset + itype)) CALL parser_get_object(parser, itemp) - conn_info%bond_type(offset+itype) = itemp + conn_info%bond_type(offset + itype) = itemp IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT BOND INFO HERE!!!!" END DO - conn_info%bond_a(offset+1:offset+ntype) = conn_info%bond_a(offset+1:offset+ntype)+natom_prev - conn_info%bond_b(offset+1:offset+ntype) = conn_info%bond_b(offset+1:offset+ntype)+natom_prev + conn_info%bond_a(offset + 1:offset + ntype) = conn_info%bond_a(offset + 1:offset + ntype) + natom_prev + conn_info%bond_b(offset + 1:offset + ntype) = conn_info%bond_b(offset + 1:offset + ntype) + natom_prev END IF ! BONDANGLEH SECTION IF (iw > 0) WRITE (iw, '(T2,A)') 'GTOP_INFO| Parsing the BONDANGLEH section' @@ -335,22 +335,22 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) CALL parser_get_object(parser, ntype) offset = 0 IF (ASSOCIATED(conn_info%theta_a)) offset = SIZE(conn_info%theta_a) - CALL reallocate(conn_info%theta_a, 1, offset+ntype) - CALL reallocate(conn_info%theta_b, 1, offset+ntype) - CALL reallocate(conn_info%theta_c, 1, offset+ntype) - CALL reallocate(conn_info%theta_type, 1, offset+ntype) + CALL reallocate(conn_info%theta_a, 1, offset + ntype) + CALL reallocate(conn_info%theta_b, 1, offset + ntype) + CALL reallocate(conn_info%theta_c, 1, offset + ntype) + CALL reallocate(conn_info%theta_type, 1, offset + ntype) DO itype = 1, ntype CALL parser_get_next_line(parser, 1) - CALL parser_get_object(parser, conn_info%theta_a(offset+itype)) - CALL parser_get_object(parser, conn_info%theta_b(offset+itype)) - CALL parser_get_object(parser, conn_info%theta_c(offset+itype)) + CALL parser_get_object(parser, conn_info%theta_a(offset + itype)) + CALL parser_get_object(parser, conn_info%theta_b(offset + itype)) + CALL parser_get_object(parser, conn_info%theta_c(offset + itype)) CALL parser_get_object(parser, itemp) - conn_info%theta_type(offset+itype) = itemp + conn_info%theta_type(offset + itype) = itemp IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT BONDANGLEH INFO HERE!!!!" END DO - conn_info%theta_a(offset+1:offset+ntype) = conn_info%theta_a(offset+1:offset+ntype)+natom_prev - conn_info%theta_b(offset+1:offset+ntype) = conn_info%theta_b(offset+1:offset+ntype)+natom_prev - conn_info%theta_c(offset+1:offset+ntype) = conn_info%theta_c(offset+1:offset+ntype)+natom_prev + conn_info%theta_a(offset + 1:offset + ntype) = conn_info%theta_a(offset + 1:offset + ntype) + natom_prev + conn_info%theta_b(offset + 1:offset + ntype) = conn_info%theta_b(offset + 1:offset + ntype) + natom_prev + conn_info%theta_c(offset + 1:offset + ntype) = conn_info%theta_c(offset + 1:offset + ntype) + natom_prev END IF ! BONDANGLE SECTION IF (iw > 0) WRITE (iw, '(T2,A)') 'GTOP_INFO| Parsing the BONDANGLE section' @@ -361,22 +361,22 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) CALL parser_get_object(parser, ntype) offset = 0 IF (ASSOCIATED(conn_info%theta_a)) offset = SIZE(conn_info%theta_a) - CALL reallocate(conn_info%theta_a, 1, offset+ntype) - CALL reallocate(conn_info%theta_b, 1, offset+ntype) - CALL reallocate(conn_info%theta_c, 1, offset+ntype) - CALL reallocate(conn_info%theta_type, 1, offset+ntype) + CALL reallocate(conn_info%theta_a, 1, offset + ntype) + CALL reallocate(conn_info%theta_b, 1, offset + ntype) + CALL reallocate(conn_info%theta_c, 1, offset + ntype) + CALL reallocate(conn_info%theta_type, 1, offset + ntype) DO itype = 1, ntype CALL parser_get_next_line(parser, 1) - CALL parser_get_object(parser, conn_info%theta_a(offset+itype)) - CALL parser_get_object(parser, conn_info%theta_b(offset+itype)) - CALL parser_get_object(parser, conn_info%theta_c(offset+itype)) + CALL parser_get_object(parser, conn_info%theta_a(offset + itype)) + CALL parser_get_object(parser, conn_info%theta_b(offset + itype)) + CALL parser_get_object(parser, conn_info%theta_c(offset + itype)) CALL parser_get_object(parser, itemp) - conn_info%theta_type(offset+itype) = itemp + conn_info%theta_type(offset + itype) = itemp IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT BONDANGLE INFO HERE!!!!" END DO - conn_info%theta_a(offset+1:offset+ntype) = conn_info%theta_a(offset+1:offset+ntype)+natom_prev - conn_info%theta_b(offset+1:offset+ntype) = conn_info%theta_b(offset+1:offset+ntype)+natom_prev - conn_info%theta_c(offset+1:offset+ntype) = conn_info%theta_c(offset+1:offset+ntype)+natom_prev + conn_info%theta_a(offset + 1:offset + ntype) = conn_info%theta_a(offset + 1:offset + ntype) + natom_prev + conn_info%theta_b(offset + 1:offset + ntype) = conn_info%theta_b(offset + 1:offset + ntype) + natom_prev + conn_info%theta_c(offset + 1:offset + ntype) = conn_info%theta_c(offset + 1:offset + ntype) + natom_prev END IF ! IMPDIHEDRALH SECTION IF (iw > 0) WRITE (iw, '(T2,A)') 'GTOP_INFO| Parsing the IMPDIHEDRALH section' @@ -387,25 +387,25 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) CALL parser_get_object(parser, ntype) offset = 0 IF (ASSOCIATED(conn_info%impr_a)) offset = SIZE(conn_info%impr_a) - CALL reallocate(conn_info%impr_a, 1, offset+ntype) - CALL reallocate(conn_info%impr_b, 1, offset+ntype) - CALL reallocate(conn_info%impr_c, 1, offset+ntype) - CALL reallocate(conn_info%impr_d, 1, offset+ntype) - CALL reallocate(conn_info%impr_type, 1, offset+ntype) + CALL reallocate(conn_info%impr_a, 1, offset + ntype) + CALL reallocate(conn_info%impr_b, 1, offset + ntype) + CALL reallocate(conn_info%impr_c, 1, offset + ntype) + CALL reallocate(conn_info%impr_d, 1, offset + ntype) + CALL reallocate(conn_info%impr_type, 1, offset + ntype) DO itype = 1, ntype CALL parser_get_next_line(parser, 1) - CALL parser_get_object(parser, conn_info%impr_a(offset+itype)) - CALL parser_get_object(parser, conn_info%impr_b(offset+itype)) - CALL parser_get_object(parser, conn_info%impr_c(offset+itype)) - CALL parser_get_object(parser, conn_info%impr_d(offset+itype)) + CALL parser_get_object(parser, conn_info%impr_a(offset + itype)) + CALL parser_get_object(parser, conn_info%impr_b(offset + itype)) + CALL parser_get_object(parser, conn_info%impr_c(offset + itype)) + CALL parser_get_object(parser, conn_info%impr_d(offset + itype)) CALL parser_get_object(parser, itemp) - conn_info%impr_type(offset+itype) = itemp + conn_info%impr_type(offset + itype) = itemp IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT IMPDIHEDRALH INFO HERE!!!!" END DO - conn_info%impr_a(offset+1:offset+ntype) = conn_info%impr_a(offset+1:offset+ntype)+natom_prev - conn_info%impr_b(offset+1:offset+ntype) = conn_info%impr_b(offset+1:offset+ntype)+natom_prev - conn_info%impr_c(offset+1:offset+ntype) = conn_info%impr_c(offset+1:offset+ntype)+natom_prev - conn_info%impr_d(offset+1:offset+ntype) = conn_info%impr_d(offset+1:offset+ntype)+natom_prev + conn_info%impr_a(offset + 1:offset + ntype) = conn_info%impr_a(offset + 1:offset + ntype) + natom_prev + conn_info%impr_b(offset + 1:offset + ntype) = conn_info%impr_b(offset + 1:offset + ntype) + natom_prev + conn_info%impr_c(offset + 1:offset + ntype) = conn_info%impr_c(offset + 1:offset + ntype) + natom_prev + conn_info%impr_d(offset + 1:offset + ntype) = conn_info%impr_d(offset + 1:offset + ntype) + natom_prev END IF ! IMPDIHEDRAL SECTION IF (iw > 0) WRITE (iw, '(T2,A)') 'GTOP_INFO| Parsing the IMPDIHEDRAL section' @@ -416,25 +416,25 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) CALL parser_get_object(parser, ntype) offset = 0 IF (ASSOCIATED(conn_info%impr_a)) offset = SIZE(conn_info%impr_a) - CALL reallocate(conn_info%impr_a, 1, offset+ntype) - CALL reallocate(conn_info%impr_b, 1, offset+ntype) - CALL reallocate(conn_info%impr_c, 1, offset+ntype) - CALL reallocate(conn_info%impr_d, 1, offset+ntype) - CALL reallocate(conn_info%impr_type, 1, offset+ntype) + CALL reallocate(conn_info%impr_a, 1, offset + ntype) + CALL reallocate(conn_info%impr_b, 1, offset + ntype) + CALL reallocate(conn_info%impr_c, 1, offset + ntype) + CALL reallocate(conn_info%impr_d, 1, offset + ntype) + CALL reallocate(conn_info%impr_type, 1, offset + ntype) DO itype = 1, ntype CALL parser_get_next_line(parser, 1) - CALL parser_get_object(parser, conn_info%impr_a(offset+itype)) - CALL parser_get_object(parser, conn_info%impr_b(offset+itype)) - CALL parser_get_object(parser, conn_info%impr_c(offset+itype)) - CALL parser_get_object(parser, conn_info%impr_d(offset+itype)) + CALL parser_get_object(parser, conn_info%impr_a(offset + itype)) + CALL parser_get_object(parser, conn_info%impr_b(offset + itype)) + CALL parser_get_object(parser, conn_info%impr_c(offset + itype)) + CALL parser_get_object(parser, conn_info%impr_d(offset + itype)) CALL parser_get_object(parser, itemp) - conn_info%impr_type(offset+itype) = itemp + conn_info%impr_type(offset + itype) = itemp IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT IMPDIHEDRAL INFO HERE!!!!" END DO - conn_info%impr_a(offset+1:offset+ntype) = conn_info%impr_a(offset+1:offset+ntype)+natom_prev - conn_info%impr_b(offset+1:offset+ntype) = conn_info%impr_b(offset+1:offset+ntype)+natom_prev - conn_info%impr_c(offset+1:offset+ntype) = conn_info%impr_c(offset+1:offset+ntype)+natom_prev - conn_info%impr_d(offset+1:offset+ntype) = conn_info%impr_d(offset+1:offset+ntype)+natom_prev + conn_info%impr_a(offset + 1:offset + ntype) = conn_info%impr_a(offset + 1:offset + ntype) + natom_prev + conn_info%impr_b(offset + 1:offset + ntype) = conn_info%impr_b(offset + 1:offset + ntype) + natom_prev + conn_info%impr_c(offset + 1:offset + ntype) = conn_info%impr_c(offset + 1:offset + ntype) + natom_prev + conn_info%impr_d(offset + 1:offset + ntype) = conn_info%impr_d(offset + 1:offset + ntype) + natom_prev END IF ! DIHEDRALH SECTION IF (iw > 0) WRITE (iw, '(T2,A)') 'GTOP_INFO| Parsing the DIHEDRALH section' @@ -445,25 +445,25 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) CALL parser_get_object(parser, ntype) offset = 0 IF (ASSOCIATED(conn_info%phi_a)) offset = SIZE(conn_info%phi_a) - CALL reallocate(conn_info%phi_a, 1, offset+ntype) - CALL reallocate(conn_info%phi_b, 1, offset+ntype) - CALL reallocate(conn_info%phi_c, 1, offset+ntype) - CALL reallocate(conn_info%phi_d, 1, offset+ntype) - CALL reallocate(conn_info%phi_type, 1, offset+ntype) + CALL reallocate(conn_info%phi_a, 1, offset + ntype) + CALL reallocate(conn_info%phi_b, 1, offset + ntype) + CALL reallocate(conn_info%phi_c, 1, offset + ntype) + CALL reallocate(conn_info%phi_d, 1, offset + ntype) + CALL reallocate(conn_info%phi_type, 1, offset + ntype) DO itype = 1, ntype CALL parser_get_next_line(parser, 1) - CALL parser_get_object(parser, conn_info%phi_a(offset+itype)) - CALL parser_get_object(parser, conn_info%phi_b(offset+itype)) - CALL parser_get_object(parser, conn_info%phi_c(offset+itype)) - CALL parser_get_object(parser, conn_info%phi_d(offset+itype)) + CALL parser_get_object(parser, conn_info%phi_a(offset + itype)) + CALL parser_get_object(parser, conn_info%phi_b(offset + itype)) + CALL parser_get_object(parser, conn_info%phi_c(offset + itype)) + CALL parser_get_object(parser, conn_info%phi_d(offset + itype)) CALL parser_get_object(parser, itemp) - conn_info%phi_type(offset+itype) = itemp + conn_info%phi_type(offset + itype) = itemp IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT DIHEDRALH INFO HERE!!!!" END DO - conn_info%phi_a(offset+1:offset+ntype) = conn_info%phi_a(offset+1:offset+ntype)+natom_prev - conn_info%phi_b(offset+1:offset+ntype) = conn_info%phi_b(offset+1:offset+ntype)+natom_prev - conn_info%phi_c(offset+1:offset+ntype) = conn_info%phi_c(offset+1:offset+ntype)+natom_prev - conn_info%phi_d(offset+1:offset+ntype) = conn_info%phi_d(offset+1:offset+ntype)+natom_prev + conn_info%phi_a(offset + 1:offset + ntype) = conn_info%phi_a(offset + 1:offset + ntype) + natom_prev + conn_info%phi_b(offset + 1:offset + ntype) = conn_info%phi_b(offset + 1:offset + ntype) + natom_prev + conn_info%phi_c(offset + 1:offset + ntype) = conn_info%phi_c(offset + 1:offset + ntype) + natom_prev + conn_info%phi_d(offset + 1:offset + ntype) = conn_info%phi_d(offset + 1:offset + ntype) + natom_prev END IF ! DIHEDRAL SECTION IF (iw > 0) WRITE (iw, '(T2,A)') 'GTOP_INFO| Parsing the DIHEDRAL section' @@ -474,31 +474,31 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) CALL parser_get_object(parser, ntype) offset = 0 IF (ASSOCIATED(conn_info%phi_a)) offset = SIZE(conn_info%phi_a) - CALL reallocate(conn_info%phi_a, 1, offset+ntype) - CALL reallocate(conn_info%phi_b, 1, offset+ntype) - CALL reallocate(conn_info%phi_c, 1, offset+ntype) - CALL reallocate(conn_info%phi_d, 1, offset+ntype) - CALL reallocate(conn_info%phi_type, 1, offset+ntype) + CALL reallocate(conn_info%phi_a, 1, offset + ntype) + CALL reallocate(conn_info%phi_b, 1, offset + ntype) + CALL reallocate(conn_info%phi_c, 1, offset + ntype) + CALL reallocate(conn_info%phi_d, 1, offset + ntype) + CALL reallocate(conn_info%phi_type, 1, offset + ntype) DO itype = 1, ntype CALL parser_get_next_line(parser, 1) - CALL parser_get_object(parser, conn_info%phi_a(offset+itype)) - CALL parser_get_object(parser, conn_info%phi_b(offset+itype)) - CALL parser_get_object(parser, conn_info%phi_c(offset+itype)) - CALL parser_get_object(parser, conn_info%phi_d(offset+itype)) + CALL parser_get_object(parser, conn_info%phi_a(offset + itype)) + CALL parser_get_object(parser, conn_info%phi_b(offset + itype)) + CALL parser_get_object(parser, conn_info%phi_c(offset + itype)) + CALL parser_get_object(parser, conn_info%phi_d(offset + itype)) CALL parser_get_object(parser, itemp) - conn_info%phi_type(offset+itype) = itemp + conn_info%phi_type(offset + itype) = itemp IF (iw > 0) WRITE (iw, *) "GTOP_INFO| PUT DIHEDRAL INFO HERE!!!!" END DO - conn_info%phi_a(offset+1:offset+ntype) = conn_info%phi_a(offset+1:offset+ntype)+natom_prev - conn_info%phi_b(offset+1:offset+ntype) = conn_info%phi_b(offset+1:offset+ntype)+natom_prev - conn_info%phi_c(offset+1:offset+ntype) = conn_info%phi_c(offset+1:offset+ntype)+natom_prev - conn_info%phi_d(offset+1:offset+ntype) = conn_info%phi_d(offset+1:offset+ntype)+natom_prev + conn_info%phi_a(offset + 1:offset + ntype) = conn_info%phi_a(offset + 1:offset + ntype) + natom_prev + conn_info%phi_b(offset + 1:offset + ntype) = conn_info%phi_b(offset + 1:offset + ntype) + natom_prev + conn_info%phi_c(offset + 1:offset + ntype) = conn_info%phi_c(offset + 1:offset + ntype) + natom_prev + conn_info%phi_d(offset + 1:offset + ntype) = conn_info%phi_d(offset + 1:offset + ntype) + natom_prev END IF CALL parser_release(parser) ! SOLVENTATOM and SOLVENTCONSTR SECTION IF (iw > 0) WRITE (iw, '(T2,A)') 'GTOP_INFO| Parsing the SOLVENTATOM section' - nsolvent = (SIZE(atom_info%r(1, :))-nsolute)/3 + nsolvent = (SIZE(atom_info%r(1, :)) - nsolute)/3 NULLIFY (na, am, ac, ba, bb) CALL parser_create(parser, file_name, para_env=para_env) @@ -538,17 +538,17 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) offset = 0 IF (ASSOCIATED(atom_info%id_molname)) offset = SIZE(atom_info%id_molname) - CALL reallocate(atom_info%id_molname, 1, offset+nsolvent*natom) - CALL reallocate(atom_info%resid, 1, offset+nsolvent*natom) - CALL reallocate(atom_info%id_resname, 1, offset+nsolvent*natom) - CALL reallocate(atom_info%id_atmname, 1, offset+nsolvent*natom) - CALL reallocate(atom_info%id_element, 1, offset+nsolvent*natom) - CALL reallocate(atom_info%atm_charge, 1, offset+nsolvent*natom) - CALL reallocate(atom_info%atm_mass, 1, offset+nsolvent*natom) + CALL reallocate(atom_info%id_molname, 1, offset + nsolvent*natom) + CALL reallocate(atom_info%resid, 1, offset + nsolvent*natom) + CALL reallocate(atom_info%id_resname, 1, offset + nsolvent*natom) + CALL reallocate(atom_info%id_atmname, 1, offset + nsolvent*natom) + CALL reallocate(atom_info%id_element, 1, offset + nsolvent*natom) + CALL reallocate(atom_info%atm_charge, 1, offset + nsolvent*natom) + CALL reallocate(atom_info%atm_mass, 1, offset + nsolvent*natom) DO isolvent = 1, nsolvent - offset = nsolute+natom*isolvent-natom + offset = nsolute + natom*isolvent - natom DO iatom = 1, natom - index_now = offset+iatom + index_now = offset + iatom atom_info%id_atmname(index_now) = str2id(s2s(namearray1(na(iatom)))) atom_info%id_element(index_now) = str2id(s2s(namearray1(na(iatom)))) atom_info%id_molname(index_now) = str2id(s2s("SOL")) @@ -562,16 +562,16 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) offset = 0 IF (ASSOCIATED(conn_info%bond_a)) offset = SIZE(conn_info%bond_a) offset2 = MAXVAL(conn_info%bond_type(:)) - CALL reallocate(conn_info%bond_a, 1, offset+ncon*nsolvent) - CALL reallocate(conn_info%bond_b, 1, offset+ncon*nsolvent) - CALL reallocate(conn_info%bond_type, 1, offset+ncon*nsolvent) - offset = offset-ncon + CALL reallocate(conn_info%bond_a, 1, offset + ncon*nsolvent) + CALL reallocate(conn_info%bond_b, 1, offset + ncon*nsolvent) + CALL reallocate(conn_info%bond_type, 1, offset + ncon*nsolvent) + offset = offset - ncon DO isolvent = 1, nsolvent - offset = offset+ncon + offset = offset + ncon DO icon = 1, ncon - conn_info%bond_a(offset+icon) = nsolute+isolvent*ncon-ncon+ba(icon) - conn_info%bond_b(offset+icon) = nsolute+isolvent*ncon-ncon+bb(icon) - conn_info%bond_type(offset+icon) = offset2+isolvent*ncon-ncon+icon + conn_info%bond_a(offset + icon) = nsolute + isolvent*ncon - ncon + ba(icon) + conn_info%bond_b(offset + icon) = nsolute + isolvent*ncon - ncon + bb(icon) + conn_info%bond_type(offset + icon) = offset2 + isolvent*ncon - ncon + icon END DO END DO ! PARA_RES structure @@ -579,7 +579,7 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) nbond_prev = 0 IF (ASSOCIATED(conn_info%c_bond_a)) i = SIZE(conn_info%c_bond_a) nbond = SIZE(conn_info%bond_a) - DO ibond = 1+nbond_prev, nbond+nbond_prev + DO ibond = 1 + nbond_prev, nbond + nbond_prev iatom = conn_info%bond_a(ibond) jatom = conn_info%bond_b(ibond) IF (topology%para_res) THEN @@ -588,7 +588,7 @@ SUBROUTINE read_topology_gromos(file_name, topology, para_env, subsys_section) (atom_info%id_resname(iatom) /= atom_info%id_resname(jatom))) THEN IF (iw > 0) WRITE (iw, '(T2,A,2I3)') "GTOP_INFO| PARA_RES, bond between molecules atom ", & iatom, jatom - i = i+1 + i = i + 1 CALL reallocate(conn_info%c_bond_a, 1, i) CALL reallocate(conn_info%c_bond_b, 1, i) CALL reallocate(conn_info%c_bond_type, 1, i) @@ -698,7 +698,7 @@ SUBROUTINE read_coordinate_g96(topology, para_env, subsys_section) CALL parser_get_object(parser, string, string_length=default_string_length) DO IF (string == TRIM("END")) EXIT - natom = natom+1 + natom = natom + 1 IF (natom > SIZE(atom_info%id_molname)) THEN newsize = INT(pfactor*natom) CALL reallocate(atom_info%id_molname, 1, newsize) @@ -741,7 +741,7 @@ SUBROUTINE read_coordinate_g96(topology, para_env, subsys_section) CALL parser_get_object(parser, string, string_length=default_string_length) DO IF (string == TRIM("END")) EXIT - natom = natom+1 + natom = natom + 1 READ (string, *) & atom_info%resid(natom), strtmp, strtmp2, & itemp, velocity(1, natom), velocity(2, natom), velocity(3, natom) diff --git a/src/topology_input.F b/src/topology_input.F index 422027ccc3..97d86ef034 100644 --- a/src/topology_input.F +++ b/src/topology_input.F @@ -394,23 +394,23 @@ SUBROUTINE read_constraints_section(topology, colvar_p, constraint_section) DO jg = 1, n_rep CALL section_vals_val_get(fix_atom_section, "LIST", i_rep_section=ig, & i_rep_val=jg, i_vals=tmplist) - CALL reallocate(cons_info%fixed_atoms, 1, isize+SIZE(tmplist)) - cons_info%fixed_atoms(isize+1:isize+SIZE(tmplist)) = tmplist - CALL reallocate(cons_info%fixed_restraint, 1, isize+SIZE(tmplist)) - CALL reallocate(cons_info%fixed_k0, 1, isize+SIZE(tmplist)) - CALL reallocate(cons_info%fixed_type, 1, isize+SIZE(tmplist)) - cons_info%fixed_type(isize+1:isize+SIZE(tmplist)) = itype + CALL reallocate(cons_info%fixed_atoms, 1, isize + SIZE(tmplist)) + cons_info%fixed_atoms(isize + 1:isize + SIZE(tmplist)) = tmplist + CALL reallocate(cons_info%fixed_restraint, 1, isize + SIZE(tmplist)) + CALL reallocate(cons_info%fixed_k0, 1, isize + SIZE(tmplist)) + CALL reallocate(cons_info%fixed_type, 1, isize + SIZE(tmplist)) + cons_info%fixed_type(isize + 1:isize + SIZE(tmplist)) = itype isize = SIZE(cons_info%fixed_atoms) END DO !Check for restraints - IF ((isize-isize_old) > 0) THEN + IF ((isize - isize_old) > 0) THEN CALL check_restraint(fix_atom_section, & - is_restraint=cons_info%fixed_restraint(isize_old+1), & - k0=cons_info%fixed_k0(isize_old+1), & + is_restraint=cons_info%fixed_restraint(isize_old + 1), & + k0=cons_info%fixed_k0(isize_old + 1), & i_rep_section=ig, & label="FIXED ATOM") - cons_info%fixed_restraint(isize_old+1:isize) = cons_info%fixed_restraint(isize_old+1) - cons_info%fixed_k0(isize_old+1:isize) = cons_info%fixed_k0(isize_old+1) + cons_info%fixed_restraint(isize_old + 1:isize) = cons_info%fixed_restraint(isize_old + 1) + cons_info%fixed_k0(isize_old + 1:isize) = cons_info%fixed_k0(isize_old + 1) END IF CALL section_vals_val_get(fix_atom_section, "MOLNAME", i_rep_section=ig, & n_rep_val=n_rep) @@ -418,33 +418,33 @@ SUBROUTINE read_constraints_section(topology, colvar_p, constraint_section) DO jg = 1, n_rep CALL section_vals_val_get(fix_atom_section, "MOLNAME", i_rep_section=ig, & i_rep_val=jg, c_vals=tmpstringlist) - CALL reallocate(cons_info%fixed_molnames, 1, msize+SIZE(tmpstringlist, 1)) - CALL reallocate(cons_info%fixed_mol_type, 1, msize+SIZE(tmpstringlist, 1)) - CALL reallocate(cons_info%fixed_mol_restraint, 1, msize+SIZE(tmpstringlist, 1)) - CALL reallocate(cons_info%fixed_mol_k0, 1, msize+SIZE(tmpstringlist, 1)) - cons_info%fixed_molnames(msize+1:msize+SIZE(tmpstringlist, 1)) = tmpstringlist - cons_info%fixed_mol_type(msize+1:msize+SIZE(tmpstringlist, 1)) = itype + CALL reallocate(cons_info%fixed_molnames, 1, msize + SIZE(tmpstringlist, 1)) + CALL reallocate(cons_info%fixed_mol_type, 1, msize + SIZE(tmpstringlist, 1)) + CALL reallocate(cons_info%fixed_mol_restraint, 1, msize + SIZE(tmpstringlist, 1)) + CALL reallocate(cons_info%fixed_mol_k0, 1, msize + SIZE(tmpstringlist, 1)) + cons_info%fixed_molnames(msize + 1:msize + SIZE(tmpstringlist, 1)) = tmpstringlist + cons_info%fixed_mol_type(msize + 1:msize + SIZE(tmpstringlist, 1)) = itype msize = SIZE(cons_info%fixed_molnames) END DO ! Exclude QM or MM work only if defined MOLNAME CALL reallocate(cons_info%fixed_exclude_qm, 1, msize) CALL reallocate(cons_info%fixed_exclude_mm, 1, msize) CALL section_vals_val_get(fix_atom_section, "EXCLUDE_QM", i_rep_section=ig, & - l_val=cons_info%fixed_exclude_qm(msize_old+1)) + l_val=cons_info%fixed_exclude_qm(msize_old + 1)) CALL section_vals_val_get(fix_atom_section, "EXCLUDE_MM", i_rep_section=ig, & - l_val=cons_info%fixed_exclude_mm(msize_old+1)) - cons_info%fixed_exclude_qm(msize_old+1:msize) = cons_info%fixed_exclude_qm(msize_old+1) - cons_info%fixed_exclude_mm(msize_old+1:msize) = cons_info%fixed_exclude_mm(msize_old+1) + l_val=cons_info%fixed_exclude_mm(msize_old + 1)) + cons_info%fixed_exclude_qm(msize_old + 1:msize) = cons_info%fixed_exclude_qm(msize_old + 1) + cons_info%fixed_exclude_mm(msize_old + 1:msize) = cons_info%fixed_exclude_mm(msize_old + 1) END IF !Check for restraints IF (n_rep /= 0) THEN CALL check_restraint(fix_atom_section, & - is_restraint=cons_info%fixed_mol_restraint(msize_old+1), & - k0=cons_info%fixed_mol_k0(msize_old+1), & + is_restraint=cons_info%fixed_mol_restraint(msize_old + 1), & + k0=cons_info%fixed_mol_k0(msize_old + 1), & i_rep_section=ig, & label="FIXED ATOM") - cons_info%fixed_mol_restraint(msize_old+1:msize) = cons_info%fixed_mol_restraint(msize_old+1) - cons_info%fixed_mol_k0(msize_old+1:msize) = cons_info%fixed_mol_k0(msize_old+1) + cons_info%fixed_mol_restraint(msize_old + 1:msize) = cons_info%fixed_mol_restraint(msize_old + 1) + cons_info%fixed_mol_k0(msize_old + 1:msize) = cons_info%fixed_mol_k0(msize_old + 1) END IF CALL section_vals_val_get(fix_atom_section, "MM_SUBSYS", i_rep_section=ig, & n_rep_val=nrep, explicit=explicit) diff --git a/src/topology_multiple_unit_cell.F b/src/topology_multiple_unit_cell.F index b224a498df..acfbf5349d 100644 --- a/src/topology_multiple_unit_cell.F +++ b/src/topology_multiple_unit_cell.F @@ -94,28 +94,28 @@ SUBROUTINE topology_muc(topology, subsys_section) CALL reallocate(topology%atom_info%id_element, 1, natoms) ind = 0 DO k = 1, multiple_unit_cell(3) - trsl_k = cell%hmat(:, 3)*REAL(k-1, KIND=dp) + trsl_k = cell%hmat(:, 3)*REAL(k - 1, KIND=dp) DO j = 1, multiple_unit_cell(2) - trsl_j = cell%hmat(:, 2)*REAL(j-1, KIND=dp) + trsl_j = cell%hmat(:, 2)*REAL(j - 1, KIND=dp) DO i = 1, multiple_unit_cell(1) - trsl_i = cell%hmat(:, 1)*REAL(i-1, KIND=dp) - trsl = trsl_i+trsl_j+trsl_k - ind = ind+1 + trsl_i = cell%hmat(:, 1)*REAL(i - 1, KIND=dp) + trsl = trsl_i + trsl_j + trsl_k + ind = ind + 1 IF (ind == 1) CYCLE ! loop over atoms - n = (ind-1)*topology%natoms + n = (ind - 1)*topology%natoms DO m = 1, topology%natoms - topology%atom_info%id_atmname(n+m) = topology%atom_info%id_atmname(m) - topology%atom_info%r(1, n+m) = topology%atom_info%r(1, m)+trsl(1) - topology%atom_info%r(2, n+m) = topology%atom_info%r(2, m)+trsl(2) - topology%atom_info%r(3, n+m) = topology%atom_info%r(3, m)+trsl(3) - topology%atom_info%id_molname(n+m) = topology%atom_info%id_molname(m) - topology%atom_info%id_resname(n+m) = topology%atom_info%id_resname(m) - topology%atom_info%resid(n+m) = topology%atom_info%resid(m) - topology%atom_info%id_element(n+m) = topology%atom_info%id_element(m) - topology%atom_info%atm_mass(n+m) = topology%atom_info%atm_mass(m) - topology%atom_info%atm_charge(n+m) = topology%atom_info%atm_charge(m) + topology%atom_info%id_atmname(n + m) = topology%atom_info%id_atmname(m) + topology%atom_info%r(1, n + m) = topology%atom_info%r(1, m) + trsl(1) + topology%atom_info%r(2, n + m) = topology%atom_info%r(2, m) + trsl(2) + topology%atom_info%r(3, n + m) = topology%atom_info%r(3, m) + trsl(3) + topology%atom_info%id_molname(n + m) = topology%atom_info%id_molname(m) + topology%atom_info%id_resname(n + m) = topology%atom_info%id_resname(m) + topology%atom_info%resid(n + m) = topology%atom_info%resid(m) + topology%atom_info%id_element(n + m) = topology%atom_info%id_element(m) + topology%atom_info%atm_mass(n + m) = topology%atom_info%atm_mass(m) + topology%atom_info%atm_charge(n + m) = topology%atom_info%atm_charge(m) END DO END DO END DO diff --git a/src/topology_pdb.F b/src/topology_pdb.F index 4e885c1d44..3f977e2bed 100644 --- a/src/topology_pdb.F +++ b/src/topology_pdb.F @@ -156,7 +156,7 @@ SUBROUTINE read_coordinate_pdb(topology, para_env, subsys_section) record = TRIM(record) IF ((record == "ATOM") .OR. (record == "HETATM")) THEN - natom = natom+1 + natom = natom + 1 topology%natoms = natom IF (natom > SIZE(atom_info%id_atmname)) THEN newsize = INT(pfactor*natom) @@ -232,7 +232,7 @@ SUBROUTINE read_coordinate_pdb(topology, para_env, subsys_section) atom_info%r(2, natom) = cp_unit_to_cp2k(atom_info%r(2, natom), "angstrom") atom_info%r(3, natom) = cp_unit_to_cp2k(atom_info%r(3, natom), "angstrom") CASE ("TER") - inum_mol = inum_mol+1 + inum_mol = inum_mol + 1 WRITE (UNIT=root_mol_name, FMT='(A3,I0)') "MOL", inum_mol CASE ("REMARK") IF (iw > 0) WRITE (UNIT=iw, FMT=*) TRIM(line) @@ -338,7 +338,7 @@ SUBROUTINE write_coordinate_pdb(file_unit, topology, subsys_section) idres = atom_info%resid(i) ELSE IF ((id1 /= atom_info%map_mol_num(i)) .OR. (id2 /= atom_info%map_mol_typ(i))) THEN - idres = idres+1 + idres = idres + 1 id1 = atom_info%map_mol_num(i) id2 = atom_info%map_mol_typ(i) END IF diff --git a/src/topology_psf.F b/src/topology_psf.F index 1bc5021e83..100b5c3ebb 100644 --- a/src/topology_psf.F +++ b/src/topology_psf.F @@ -49,15 +49,15 @@ MODULE topology_psf USE util, ONLY: sort #include "./base/base_uses.f90" - IMPLICIT NONE + IMPLICIT NONE CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'topology_psf' - PRIVATE - PUBLIC :: read_topology_psf,& - write_topology_psf,& - psf_post_process,& - idm_psf + PRIVATE + PUBLIC :: read_topology_psf, & + write_topology_psf, & + psf_post_process, & + idm_psf CONTAINS @@ -74,7 +74,7 @@ MODULE topology_psf !> This routine should contain only information read from the PSF format !> and all post_process should be performef in the psf_post_process ! ************************************************************************************************** - SUBROUTINE read_topology_psf (filename,topology,para_env,subsys_section, psf_type) + SUBROUTINE read_topology_psf(filename, topology, para_env, subsys_section, psf_type) CHARACTER(LEN=*), INTENT(IN) :: filename TYPE(topology_parameters_type), INTENT(INOUT) :: topology TYPE(cp_para_env_type), POINTER :: para_env @@ -96,323 +96,323 @@ SUBROUTINE read_topology_psf (filename,topology,para_env,subsys_section, psf_typ TYPE(cp_logger_type), POINTER :: logger TYPE(cp_parser_type), POINTER :: parser - NULLIFY(parser, logger) - logger => cp_get_default_logger() - output_unit= cp_logger_get_default_io_unit(logger) - iw = cp_print_key_unit_nr(logger,subsys_section,"PRINT%TOPOLOGY_INFO/PSF_INFO",& - extension=".subsysLog") - CALL timeset(routineN,handle) - CALL parser_create(parser,filename,para_env=para_env) - - atom_info => topology%atom_info - conn_info => topology%conn_info - natom_prev = 0 - IF(ASSOCIATED(atom_info%id_molname)) natom_prev = SIZE(atom_info%id_molname) - c_int = 'I8' - label = 'PSF' - CALL parser_search_string(parser,label,.TRUE.,found,begin_line=.TRUE.) - IF (.NOT. found) THEN - IF (output_unit>0) THEN - WRITE(output_unit,'(A)')"ERROR| Missing PSF specification line" - END IF - CPABORT("") - END IF - DO WHILE (parser_test_next_token(parser)/="EOL") - CALL parser_get_object (parser,field) - SELECT CASE(field(1:3)) - CASE ("PSF") - IF (psf_type==do_conn_psf) THEN - ! X-PLOR PSF format "similar" to the plain CHARMM PSF format - psf_format = '(I8,1X,A4,I5,1X,A4,1X,A4,1X,A4,1X,2G14.6,I8)' - ENDIF - CASE ("EXT") - IF (psf_type==do_conn_psf) THEN - ! EXTEnded CHARMM31 format - psf_format = '(I10,T12,A7,T21,I8,T30,A7,T39,A6,T47,A6,T53,F10.6,T69,F8.3,T88,I1)' - c_int = 'I10' - ELSE - CPABORT("PSF_INFO| "//field(1:3)//" :: not available for UPSF format!") - ENDIF - CASE DEFAULT - CPABORT("PSF_INFO| "//field(1:3)//" :: Unimplemented keyword in CP2K PSF/UPSF format!") - END SELECT - END DO - IF(iw>0) WRITE(iw,'(T2,A)') 'PSF_INFO| Parsing the NATOM section' - ! - ! ATOM section - ! - label = '!NATOM' - CALL parser_search_string(parser,label,.TRUE.,found,begin_line=.TRUE.) - IF ( .NOT. found ) THEN - IF(iw>0) WRITE (iw,'(T2,A)') 'PSF_INFO| No NATOM section ' - natom = 0 - ELSE - CALL parser_get_object (parser,natom) - IF(natom_prev+natom>topology%natoms)& - CALL cp_abort(__LOCATION__,& - "Number of atoms in connectivity control is larger than the "//& - "number of atoms in coordinate control. check coordinates and "//& - "connectivity. ") - IF(iw>0) WRITE(iw,'(T2,A,'//TRIM(c_int)//')') 'PSF_INFO| NATOM = ',natom - !malloc the memory that we need - CALL reallocate(atom_info%id_molname,1,natom_prev+natom) - CALL reallocate(atom_info%resid,1,natom_prev+natom) - CALL reallocate(atom_info%id_resname,1,natom_prev+natom) - CALL reallocate(atom_info%id_atmname,1,natom_prev+natom) - CALL reallocate(atom_info%atm_charge,1,natom_prev+natom) - CALL reallocate(atom_info%atm_mass,1,natom_prev+natom) - !Read in the atom info - IF (psf_type==do_conn_psf_u) THEN - DO iatom=1,natom - index_now=iatom+natom_prev - CALL parser_get_next_line(parser,1) - READ(parser%input_line,FMT=*,ERR=9)i,& - strtmp1,& - atom_info%resid(index_now),& - strtmp2,& - dummy_field,& - strtmp3,& - atom_info%atm_charge(index_now),& - atom_info%atm_mass(index_now) - atom_info%id_molname(index_now)=str2id(s2s(strtmp1)) - atom_info%id_resname(index_now)=str2id(s2s(strtmp2)) - atom_info%id_atmname(index_now)=str2id(s2s(strtmp3)) - END DO - ELSE - DO iatom=1,natom - index_now=iatom+natom_prev - CALL parser_get_next_line(parser,1) - READ(parser%input_line,FMT=psf_format)& - i,& - strtmp1,& - atom_info%resid(index_now),& - strtmp2,& - dummy_field,& - strtmp3,& - atom_info%atm_charge(index_now),& - atom_info%atm_mass(index_now),& + NULLIFY (parser, logger) + logger => cp_get_default_logger() + output_unit = cp_logger_get_default_io_unit(logger) + iw = cp_print_key_unit_nr(logger, subsys_section, "PRINT%TOPOLOGY_INFO/PSF_INFO", & + extension=".subsysLog") + CALL timeset(routineN, handle) + CALL parser_create(parser, filename, para_env=para_env) + + atom_info => topology%atom_info + conn_info => topology%conn_info + natom_prev = 0 + IF (ASSOCIATED(atom_info%id_molname)) natom_prev = SIZE(atom_info%id_molname) + c_int = 'I8' + label = 'PSF' + CALL parser_search_string(parser, label, .TRUE., found, begin_line=.TRUE.) + IF (.NOT. found) THEN + IF (output_unit > 0) THEN + WRITE (output_unit, '(A)') "ERROR| Missing PSF specification line" + END IF + CPABORT("") + END IF + DO WHILE (parser_test_next_token(parser) /= "EOL") + CALL parser_get_object(parser, field) + SELECT CASE (field(1:3)) + CASE ("PSF") + IF (psf_type == do_conn_psf) THEN + ! X-PLOR PSF format "similar" to the plain CHARMM PSF format + psf_format = '(I8,1X,A4,I5,1X,A4,1X,A4,1X,A4,1X,2G14.6,I8)' + ENDIF + CASE ("EXT") + IF (psf_type == do_conn_psf) THEN + ! EXTEnded CHARMM31 format + psf_format = '(I10,T12,A7,T21,I8,T30,A7,T39,A6,T47,A6,T53,F10.6,T69,F8.3,T88,I1)' + c_int = 'I10' + ELSE + CPABORT("PSF_INFO| "//field(1:3)//" :: not available for UPSF format!") + ENDIF + CASE DEFAULT + CPABORT("PSF_INFO| "//field(1:3)//" :: Unimplemented keyword in CP2K PSF/UPSF format!") + END SELECT + END DO + IF (iw > 0) WRITE (iw, '(T2,A)') 'PSF_INFO| Parsing the NATOM section' + ! + ! ATOM section + ! + label = '!NATOM' + CALL parser_search_string(parser, label, .TRUE., found, begin_line=.TRUE.) + IF (.NOT. found) THEN + IF (iw > 0) WRITE (iw, '(T2,A)') 'PSF_INFO| No NATOM section ' + natom = 0 + ELSE + CALL parser_get_object(parser, natom) + IF (natom_prev + natom > topology%natoms) & + CALL cp_abort(__LOCATION__, & + "Number of atoms in connectivity control is larger than the "// & + "number of atoms in coordinate control. check coordinates and "// & + "connectivity. ") + IF (iw > 0) WRITE (iw, '(T2,A,'//TRIM(c_int)//')') 'PSF_INFO| NATOM = ', natom + !malloc the memory that we need + CALL reallocate(atom_info%id_molname, 1, natom_prev + natom) + CALL reallocate(atom_info%resid, 1, natom_prev + natom) + CALL reallocate(atom_info%id_resname, 1, natom_prev + natom) + CALL reallocate(atom_info%id_atmname, 1, natom_prev + natom) + CALL reallocate(atom_info%atm_charge, 1, natom_prev + natom) + CALL reallocate(atom_info%atm_mass, 1, natom_prev + natom) + !Read in the atom info + IF (psf_type == do_conn_psf_u) THEN + DO iatom = 1, natom + index_now = iatom + natom_prev + CALL parser_get_next_line(parser, 1) + READ (parser%input_line, FMT=*, ERR=9) i, & + strtmp1, & + atom_info%resid(index_now), & + strtmp2, & + dummy_field, & + strtmp3, & + atom_info%atm_charge(index_now), & + atom_info%atm_mass(index_now) + atom_info%id_molname(index_now) = str2id(s2s(strtmp1)) + atom_info%id_resname(index_now) = str2id(s2s(strtmp2)) + atom_info%id_atmname(index_now) = str2id(s2s(strtmp3)) + END DO + ELSE + DO iatom = 1, natom + index_now = iatom + natom_prev + CALL parser_get_next_line(parser, 1) + READ (parser%input_line, FMT=psf_format) & + i, & + strtmp1, & + atom_info%resid(index_now), & + strtmp2, & + dummy_field, & + strtmp3, & + atom_info%atm_charge(index_now), & + atom_info%atm_mass(index_now), & idum - atom_info%id_molname(index_now)=str2id(s2s(strtmp1)) - atom_info%id_resname(index_now)=str2id(s2s(strtmp2)) - atom_info%id_atmname(index_now)=str2id(s2s(ADJUSTL(strtmp3))) - END DO - END IF - END IF - - ! - ! BOND section - ! - nbond_prev = 0 - IF(ASSOCIATED(conn_info%bond_a)) nbond_prev = SIZE(conn_info%bond_a) - - IF(iw>0) WRITE(iw,'(T2,A)') 'PSF_INFO| Parsing the NBOND section' - IF(iw>0) WRITE(iw,'(T2,A,I8)') 'PSF_INFO| Previous number of allocated BOND: ',nbond_prev - label = '!NBOND' - CALL parser_search_string(parser,label,.TRUE.,found,begin_line=.TRUE.) - IF ( .NOT. found ) THEN - IF(iw>0) WRITE (iw,'(T2,A)')'PSF_INFO| No NBOND section ' - nbond = 0 - ELSE - CALL parser_get_object (parser,nbond) - IF(iw>0) WRITE(iw,'(T2,A,'//TRIM(c_int)//')')'PSF_INFO| NBOND = ',nbond - !malloc the memory that we need - CALL reallocate(conn_info%bond_a,1,nbond_prev+nbond) - CALL reallocate(conn_info%bond_b,1,nbond_prev+nbond) - !Read in the bond info - IF (psf_type==do_conn_psf_u) THEN - DO ibond=1,nbond,4 - CALL parser_get_next_line(parser,1) - index_now=nbond_prev+ibond-1 - READ(parser%input_line,FMT=*,ERR=9)(conn_info%bond_a(index_now+i),& - conn_info%bond_b(index_now+i),& - i=1,MIN(4,(nbond-ibond+1))) - END DO - ELSE - DO ibond=1,nbond,4 - CALL parser_get_next_line(parser,1) - index_now=nbond_prev+ibond-1 - READ(parser%input_line,FMT='(8'//TRIM(c_int)//')')& - (conn_info%bond_a(index_now+i),& - conn_info%bond_b(index_now+i),& - i=1,MIN(4,(nbond-ibond+1))) - END DO - END IF - IF ( ANY(conn_info%bond_a(nbond_prev+1:)<=0) .OR. & - ANY(conn_info%bond_a(nbond_prev+1:)>natom) .OR. & - ANY(conn_info%bond_b(nbond_prev+1:)<=0) .OR. & - ANY(conn_info%bond_b(nbond_prev+1:)>natom)) THEN - CPABORT("topology_read, invalid bond") - END IF - conn_info%bond_a(nbond_prev+1:)=conn_info%bond_a(nbond_prev+1:)+natom_prev - conn_info%bond_b(nbond_prev+1:)=conn_info%bond_b(nbond_prev+1:)+natom_prev - END IF - ! - ! THETA section - ! - ntheta_prev = 0 - IF(ASSOCIATED(conn_info%theta_a)) ntheta_prev = SIZE(conn_info%theta_a) - - IF(iw>0) WRITE(iw,'(T2,A)')'PSF_INFO| Parsing the NTHETA section' - IF(iw>0) WRITE(iw,'(T2,A,I8)') 'PSF_INFO| Previous number of allocated THETA: ',ntheta_prev - label = '!NTHETA' - CALL parser_search_string(parser,label,.TRUE.,found,begin_line=.TRUE.) - IF ( .NOT. found ) THEN - IF(iw>0) WRITE (iw,'(T2,A)')'PSF_INFO| No NTHETA section ' - ntheta = 0 - ELSE - CALL parser_get_object (parser,ntheta) - IF(iw>0) WRITE(iw,'(T2,A,'//TRIM(c_int)//')')'PSF_INFO| NTHETA = ',ntheta - !malloc the memory that we need - CALL reallocate(conn_info%theta_a,1,ntheta_prev+ntheta) - CALL reallocate(conn_info%theta_b,1,ntheta_prev+ntheta) - CALL reallocate(conn_info%theta_c,1,ntheta_prev+ntheta) - !Read in the bend info - IF (psf_type==do_conn_psf_u) THEN - DO itheta=1,ntheta,3 - CALL parser_get_next_line(parser,1) - index_now=ntheta_prev+itheta-1 - READ(parser%input_line,FMT=*,ERR=9)(conn_info%theta_a(index_now+i),& - conn_info%theta_b(index_now+i),& - conn_info%theta_c(index_now+i),& - i=1,MIN(3,(ntheta-itheta+1))) - END DO - ELSE - DO itheta=1,ntheta,3 - CALL parser_get_next_line(parser,1) - index_now=ntheta_prev+itheta-1 - READ(parser%input_line,FMT='(9'//TRIM(c_int)//')')& - (conn_info%theta_a(index_now+i),& - conn_info%theta_b(index_now+i),& - conn_info%theta_c(index_now+i),& - i=1,MIN(3,(ntheta-itheta+1))) - END DO - END IF - conn_info%theta_a(ntheta_prev+1:)=conn_info%theta_a(ntheta_prev+1:)+natom_prev - conn_info%theta_b(ntheta_prev+1:)=conn_info%theta_b(ntheta_prev+1:)+natom_prev - conn_info%theta_c(ntheta_prev+1:)=conn_info%theta_c(ntheta_prev+1:)+natom_prev - END IF - ! - ! PHI section - ! - nphi_prev = 0 - IF(ASSOCIATED(conn_info%phi_a)) nphi_prev = SIZE(conn_info%phi_a) - - IF(iw>0) WRITE(iw,'(T2,A)') 'PSF_INFO| Parsing the NPHI section' - IF(iw>0) WRITE(iw,'(T2,A,I8)') 'PSF_INFO| Previous number of allocated PHI: ',nphi_prev - label = '!NPHI' - CALL parser_search_string(parser,label,.TRUE.,found,begin_line=.TRUE.) - IF ( .NOT. found ) THEN - IF(iw>0) WRITE (iw,'(T2,A)') 'PSF_INFO| No NPHI section ' - nphi = 0 - ELSE - CALL parser_get_object (parser,nphi) - IF(iw>0) WRITE(iw,'(T2,A,'//TRIM(c_int)//')') 'PSF_INFO| NPHI = ',nphi - !malloc the memory that we need - CALL reallocate(conn_info%phi_a,1,nphi_prev+nphi) - CALL reallocate(conn_info%phi_b,1,nphi_prev+nphi) - CALL reallocate(conn_info%phi_c,1,nphi_prev+nphi) - CALL reallocate(conn_info%phi_d,1,nphi_prev+nphi) - !Read in the torsion info - IF (psf_type==do_conn_psf_u) THEN - DO iphi=1,nphi,2 - CALL parser_get_next_line(parser,1) - index_now=nphi_prev+iphi-1 - READ(parser%input_line,FMT=*,ERR=9)(conn_info%phi_a(index_now+i),& - conn_info%phi_b(index_now+i),& - conn_info%phi_c(index_now+i),& - conn_info%phi_d(index_now+i),& - i=1,MIN(2,(nphi-iphi+1))) - END DO - ELSE - DO iphi=1,nphi,2 - CALL parser_get_next_line(parser,1) - index_now=nphi_prev+iphi-1 - READ(parser%input_line,FMT='(8'//TRIM(c_int)//')')& - (conn_info%phi_a(index_now+i),& - conn_info%phi_b(index_now+i),& - conn_info%phi_c(index_now+i),& - conn_info%phi_d(index_now+i),& - i=1,MIN(2,(nphi-iphi+1))) - END DO - END IF - conn_info%phi_a(nphi_prev+1:)=conn_info%phi_a(nphi_prev+1:)+natom_prev - conn_info%phi_b(nphi_prev+1:)=conn_info%phi_b(nphi_prev+1:)+natom_prev - conn_info%phi_c(nphi_prev+1:)=conn_info%phi_c(nphi_prev+1:)+natom_prev - conn_info%phi_d(nphi_prev+1:)=conn_info%phi_d(nphi_prev+1:)+natom_prev - END IF - ! - ! IMPHI section - ! - nphi_prev = 0 - IF(ASSOCIATED(conn_info%impr_a)) nphi_prev = SIZE(conn_info%impr_a) - - IF(iw>0) WRITE(iw,'(T2,A)')'PSF_INFO| Parsing the NIMPHI section' - IF(iw>0) WRITE(iw,'(T2,A,I8)') 'PSF_INFO| Previous number of allocated IMPHI: ',nphi_prev - label = '!NIMPHI' - CALL parser_search_string(parser,label,.TRUE.,found,begin_line=.TRUE.) - IF ( .NOT. found ) THEN - IF(iw>0) WRITE (iw,'(T2,A)')'PSF_INFO| No NIMPHI section ' - nphi = 0 - ELSE - CALL parser_get_object (parser,nphi) - IF(iw>0) WRITE(iw,'(T2,A,'//TRIM(c_int)//')')'PSF_INFO| NIMPR = ',nphi - !malloc the memory that we need - CALL reallocate(conn_info%impr_a,1,nphi_prev+nphi) - CALL reallocate(conn_info%impr_b,1,nphi_prev+nphi) - CALL reallocate(conn_info%impr_c,1,nphi_prev+nphi) - CALL reallocate(conn_info%impr_d,1,nphi_prev+nphi) - !Read in the improper torsion info - IF (psf_type==do_conn_psf_u) THEN - DO iphi=1,nphi,2 - CALL parser_get_next_line(parser,1) - index_now=nphi_prev+iphi-1 - READ(parser%input_line,FMT=*,ERR=9)(conn_info%impr_a(index_now+i),& - conn_info%impr_b(index_now+i),& - conn_info%impr_c(index_now+i),& - conn_info%impr_d(index_now+i),& - i=1,MIN(2,(nphi-iphi+1))) - END DO - ELSE - DO iphi=1,nphi,2 - CALL parser_get_next_line(parser,1) - index_now=nphi_prev+iphi-1 - READ(parser%input_line,FMT='(8'//TRIM(c_int)//')')& - (conn_info%impr_a(index_now+i),& - conn_info%impr_b(index_now+i),& - conn_info%impr_c(index_now+i),& - conn_info%impr_d(index_now+i),& - i=1,MIN(2,(nphi-iphi+1))) - END DO - END IF - conn_info%impr_a(nphi_prev+1:)=conn_info%impr_a(nphi_prev+1:)+natom_prev - conn_info%impr_b(nphi_prev+1:)=conn_info%impr_b(nphi_prev+1:)+natom_prev - conn_info%impr_c(nphi_prev+1:)=conn_info%impr_c(nphi_prev+1:)+natom_prev - conn_info%impr_d(nphi_prev+1:)=conn_info%impr_d(nphi_prev+1:)+natom_prev - END IF - - CALL parser_release(parser) - CALL timestop(handle) - CALL cp_print_key_finished_output(iw,logger,subsys_section,& - "PRINT%TOPOLOGY_INFO/PSF_INFO") - RETURN -9 CONTINUE - ! Print error and exit - IF (output_unit>0) THEN - WRITE(output_unit,'(T2,A)')& - "PSF_INFO| Error while reading PSF using the unformatted PSF reading option!",& + atom_info%id_molname(index_now) = str2id(s2s(strtmp1)) + atom_info%id_resname(index_now) = str2id(s2s(strtmp2)) + atom_info%id_atmname(index_now) = str2id(s2s(ADJUSTL(strtmp3))) + END DO + END IF + END IF + + ! + ! BOND section + ! + nbond_prev = 0 + IF (ASSOCIATED(conn_info%bond_a)) nbond_prev = SIZE(conn_info%bond_a) + + IF (iw > 0) WRITE (iw, '(T2,A)') 'PSF_INFO| Parsing the NBOND section' + IF (iw > 0) WRITE (iw, '(T2,A,I8)') 'PSF_INFO| Previous number of allocated BOND: ', nbond_prev + label = '!NBOND' + CALL parser_search_string(parser, label, .TRUE., found, begin_line=.TRUE.) + IF (.NOT. found) THEN + IF (iw > 0) WRITE (iw, '(T2,A)') 'PSF_INFO| No NBOND section ' + nbond = 0 + ELSE + CALL parser_get_object(parser, nbond) + IF (iw > 0) WRITE (iw, '(T2,A,'//TRIM(c_int)//')') 'PSF_INFO| NBOND = ', nbond + !malloc the memory that we need + CALL reallocate(conn_info%bond_a, 1, nbond_prev + nbond) + CALL reallocate(conn_info%bond_b, 1, nbond_prev + nbond) + !Read in the bond info + IF (psf_type == do_conn_psf_u) THEN + DO ibond = 1, nbond, 4 + CALL parser_get_next_line(parser, 1) + index_now = nbond_prev + ibond - 1 + READ (parser%input_line, FMT=*, ERR=9) (conn_info%bond_a(index_now + i), & + conn_info%bond_b(index_now + i), & + i=1, MIN(4, (nbond - ibond + 1))) + END DO + ELSE + DO ibond = 1, nbond, 4 + CALL parser_get_next_line(parser, 1) + index_now = nbond_prev + ibond - 1 + READ (parser%input_line, FMT='(8'//TRIM(c_int)//')') & + (conn_info%bond_a(index_now + i), & + conn_info%bond_b(index_now + i), & + i=1, MIN(4, (nbond - ibond + 1))) + END DO + END IF + IF (ANY(conn_info%bond_a(nbond_prev + 1:) <= 0) .OR. & + ANY(conn_info%bond_a(nbond_prev + 1:) > natom) .OR. & + ANY(conn_info%bond_b(nbond_prev + 1:) <= 0) .OR. & + ANY(conn_info%bond_b(nbond_prev + 1:) > natom)) THEN + CPABORT("topology_read, invalid bond") + END IF + conn_info%bond_a(nbond_prev + 1:) = conn_info%bond_a(nbond_prev + 1:) + natom_prev + conn_info%bond_b(nbond_prev + 1:) = conn_info%bond_b(nbond_prev + 1:) + natom_prev + END IF + ! + ! THETA section + ! + ntheta_prev = 0 + IF (ASSOCIATED(conn_info%theta_a)) ntheta_prev = SIZE(conn_info%theta_a) + + IF (iw > 0) WRITE (iw, '(T2,A)') 'PSF_INFO| Parsing the NTHETA section' + IF (iw > 0) WRITE (iw, '(T2,A,I8)') 'PSF_INFO| Previous number of allocated THETA: ', ntheta_prev + label = '!NTHETA' + CALL parser_search_string(parser, label, .TRUE., found, begin_line=.TRUE.) + IF (.NOT. found) THEN + IF (iw > 0) WRITE (iw, '(T2,A)') 'PSF_INFO| No NTHETA section ' + ntheta = 0 + ELSE + CALL parser_get_object(parser, ntheta) + IF (iw > 0) WRITE (iw, '(T2,A,'//TRIM(c_int)//')') 'PSF_INFO| NTHETA = ', ntheta + !malloc the memory that we need + CALL reallocate(conn_info%theta_a, 1, ntheta_prev + ntheta) + CALL reallocate(conn_info%theta_b, 1, ntheta_prev + ntheta) + CALL reallocate(conn_info%theta_c, 1, ntheta_prev + ntheta) + !Read in the bend info + IF (psf_type == do_conn_psf_u) THEN + DO itheta = 1, ntheta, 3 + CALL parser_get_next_line(parser, 1) + index_now = ntheta_prev + itheta - 1 + READ (parser%input_line, FMT=*, ERR=9) (conn_info%theta_a(index_now + i), & + conn_info%theta_b(index_now + i), & + conn_info%theta_c(index_now + i), & + i=1, MIN(3, (ntheta - itheta + 1))) + END DO + ELSE + DO itheta = 1, ntheta, 3 + CALL parser_get_next_line(parser, 1) + index_now = ntheta_prev + itheta - 1 + READ (parser%input_line, FMT='(9'//TRIM(c_int)//')') & + (conn_info%theta_a(index_now + i), & + conn_info%theta_b(index_now + i), & + conn_info%theta_c(index_now + i), & + i=1, MIN(3, (ntheta - itheta + 1))) + END DO + END IF + conn_info%theta_a(ntheta_prev + 1:) = conn_info%theta_a(ntheta_prev + 1:) + natom_prev + conn_info%theta_b(ntheta_prev + 1:) = conn_info%theta_b(ntheta_prev + 1:) + natom_prev + conn_info%theta_c(ntheta_prev + 1:) = conn_info%theta_c(ntheta_prev + 1:) + natom_prev + END IF + ! + ! PHI section + ! + nphi_prev = 0 + IF (ASSOCIATED(conn_info%phi_a)) nphi_prev = SIZE(conn_info%phi_a) + + IF (iw > 0) WRITE (iw, '(T2,A)') 'PSF_INFO| Parsing the NPHI section' + IF (iw > 0) WRITE (iw, '(T2,A,I8)') 'PSF_INFO| Previous number of allocated PHI: ', nphi_prev + label = '!NPHI' + CALL parser_search_string(parser, label, .TRUE., found, begin_line=.TRUE.) + IF (.NOT. found) THEN + IF (iw > 0) WRITE (iw, '(T2,A)') 'PSF_INFO| No NPHI section ' + nphi = 0 + ELSE + CALL parser_get_object(parser, nphi) + IF (iw > 0) WRITE (iw, '(T2,A,'//TRIM(c_int)//')') 'PSF_INFO| NPHI = ', nphi + !malloc the memory that we need + CALL reallocate(conn_info%phi_a, 1, nphi_prev + nphi) + CALL reallocate(conn_info%phi_b, 1, nphi_prev + nphi) + CALL reallocate(conn_info%phi_c, 1, nphi_prev + nphi) + CALL reallocate(conn_info%phi_d, 1, nphi_prev + nphi) + !Read in the torsion info + IF (psf_type == do_conn_psf_u) THEN + DO iphi = 1, nphi, 2 + CALL parser_get_next_line(parser, 1) + index_now = nphi_prev + iphi - 1 + READ (parser%input_line, FMT=*, ERR=9) (conn_info%phi_a(index_now + i), & + conn_info%phi_b(index_now + i), & + conn_info%phi_c(index_now + i), & + conn_info%phi_d(index_now + i), & + i=1, MIN(2, (nphi - iphi + 1))) + END DO + ELSE + DO iphi = 1, nphi, 2 + CALL parser_get_next_line(parser, 1) + index_now = nphi_prev + iphi - 1 + READ (parser%input_line, FMT='(8'//TRIM(c_int)//')') & + (conn_info%phi_a(index_now + i), & + conn_info%phi_b(index_now + i), & + conn_info%phi_c(index_now + i), & + conn_info%phi_d(index_now + i), & + i=1, MIN(2, (nphi - iphi + 1))) + END DO + END IF + conn_info%phi_a(nphi_prev + 1:) = conn_info%phi_a(nphi_prev + 1:) + natom_prev + conn_info%phi_b(nphi_prev + 1:) = conn_info%phi_b(nphi_prev + 1:) + natom_prev + conn_info%phi_c(nphi_prev + 1:) = conn_info%phi_c(nphi_prev + 1:) + natom_prev + conn_info%phi_d(nphi_prev + 1:) = conn_info%phi_d(nphi_prev + 1:) + natom_prev + END IF + ! + ! IMPHI section + ! + nphi_prev = 0 + IF (ASSOCIATED(conn_info%impr_a)) nphi_prev = SIZE(conn_info%impr_a) + + IF (iw > 0) WRITE (iw, '(T2,A)') 'PSF_INFO| Parsing the NIMPHI section' + IF (iw > 0) WRITE (iw, '(T2,A,I8)') 'PSF_INFO| Previous number of allocated IMPHI: ', nphi_prev + label = '!NIMPHI' + CALL parser_search_string(parser, label, .TRUE., found, begin_line=.TRUE.) + IF (.NOT. found) THEN + IF (iw > 0) WRITE (iw, '(T2,A)') 'PSF_INFO| No NIMPHI section ' + nphi = 0 + ELSE + CALL parser_get_object(parser, nphi) + IF (iw > 0) WRITE (iw, '(T2,A,'//TRIM(c_int)//')') 'PSF_INFO| NIMPR = ', nphi + !malloc the memory that we need + CALL reallocate(conn_info%impr_a, 1, nphi_prev + nphi) + CALL reallocate(conn_info%impr_b, 1, nphi_prev + nphi) + CALL reallocate(conn_info%impr_c, 1, nphi_prev + nphi) + CALL reallocate(conn_info%impr_d, 1, nphi_prev + nphi) + !Read in the improper torsion info + IF (psf_type == do_conn_psf_u) THEN + DO iphi = 1, nphi, 2 + CALL parser_get_next_line(parser, 1) + index_now = nphi_prev + iphi - 1 + READ (parser%input_line, FMT=*, ERR=9) (conn_info%impr_a(index_now + i), & + conn_info%impr_b(index_now + i), & + conn_info%impr_c(index_now + i), & + conn_info%impr_d(index_now + i), & + i=1, MIN(2, (nphi - iphi + 1))) + END DO + ELSE + DO iphi = 1, nphi, 2 + CALL parser_get_next_line(parser, 1) + index_now = nphi_prev + iphi - 1 + READ (parser%input_line, FMT='(8'//TRIM(c_int)//')') & + (conn_info%impr_a(index_now + i), & + conn_info%impr_b(index_now + i), & + conn_info%impr_c(index_now + i), & + conn_info%impr_d(index_now + i), & + i=1, MIN(2, (nphi - iphi + 1))) + END DO + END IF + conn_info%impr_a(nphi_prev + 1:) = conn_info%impr_a(nphi_prev + 1:) + natom_prev + conn_info%impr_b(nphi_prev + 1:) = conn_info%impr_b(nphi_prev + 1:) + natom_prev + conn_info%impr_c(nphi_prev + 1:) = conn_info%impr_c(nphi_prev + 1:) + natom_prev + conn_info%impr_d(nphi_prev + 1:) = conn_info%impr_d(nphi_prev + 1:) + natom_prev + END IF + + CALL parser_release(parser) + CALL timestop(handle) + CALL cp_print_key_finished_output(iw, logger, subsys_section, & + "PRINT%TOPOLOGY_INFO/PSF_INFO") + RETURN +9 CONTINUE + ! Print error and exit + IF (output_unit > 0) THEN + WRITE (output_unit, '(T2,A)') & + "PSF_INFO| Error while reading PSF using the unformatted PSF reading option!", & "PSF_INFO| Try using PSF instead of UPSF." - END IF + END IF - CPABORT("Error while reading PSF data!") + CPABORT("Error while reading PSF data!") - END SUBROUTINE read_topology_psf + END SUBROUTINE read_topology_psf ! ************************************************************************************************** !> \brief Post processing of PSF informations !> \param topology ... !> \param subsys_section ... ! ************************************************************************************************** - SUBROUTINE psf_post_process(topology,subsys_section) + SUBROUTINE psf_post_process(topology, subsys_section) TYPE(topology_parameters_type), INTENT(INOUT) :: topology TYPE(section_vals_type), POINTER :: subsys_section @@ -427,130 +427,130 @@ SUBROUTINE psf_post_process(topology,subsys_section) TYPE(connectivity_info_type), POINTER :: conn_info TYPE(cp_logger_type), POINTER :: logger - NULLIFY(logger) - logger => cp_get_default_logger() - iw = cp_print_key_unit_nr(logger,subsys_section,"PRINT%TOPOLOGY_INFO/PSF_INFO",& - extension=".subsysLog") - CALL timeset(routineN,handle) - atom_info => topology%atom_info - conn_info => topology%conn_info - ! - ! PARA_RES structure - ! - natom = 0 - nbond = 0 - i = 0 - IF(ASSOCIATED(atom_info%id_molname)) natom = SIZE(atom_info%id_molname) - IF (ASSOCIATED(conn_info%bond_a)) nbond = SIZE(conn_info%bond_a) - IF(ASSOCIATED(conn_info%c_bond_a)) i = SIZE(conn_info%c_bond_a) - DO ibond=1,nbond - iatom = conn_info%bond_a(ibond) - jatom = conn_info%bond_b(ibond) - IF(topology%para_res) THEN - IF((atom_info%id_molname(iatom)/=atom_info%id_molname(jatom)).OR.& - (atom_info%resid(iatom)/=atom_info%resid(jatom)).OR.& - (atom_info%id_resname(iatom)/=atom_info%id_resname(jatom)))THEN - IF(iw>0) WRITE(iw,'(T2,A,2I6)') "PSF_INFO| PARA_RES, bond between molecules atom ",& - iatom,jatom - i = i + 1 - CALL reallocate(conn_info%c_bond_a,1,i) - CALL reallocate(conn_info%c_bond_b,1,i) - conn_info%c_bond_a(i) = iatom - conn_info%c_bond_b(i) = jatom - END IF - ELSE - IF(atom_info%id_molname(iatom)/=atom_info%id_molname(jatom)) THEN - CPABORT("") - END IF - END IF - END DO - ! - ! UB structure - ! - ntheta = 0 - IF (ASSOCIATED(conn_info%theta_a)) ntheta = SIZE(conn_info%theta_a) - CALL reallocate(conn_info%ub_a,1,ntheta) - CALL reallocate(conn_info%ub_b,1,ntheta) - CALL reallocate(conn_info%ub_c,1,ntheta) - conn_info%ub_a(:) = conn_info%theta_a(:) - conn_info%ub_b(:) = conn_info%theta_b(:) - conn_info%ub_c(:) = conn_info%theta_c(:) - ! - ! ONFO structure - ! - nphi = 0 - nonfo= 0 - IF (ASSOCIATED(conn_info%phi_a)) nphi = SIZE(conn_info%phi_a) - CALL reallocate(conn_info%onfo_a,1,nphi) - CALL reallocate(conn_info%onfo_b,1,nphi) - conn_info%onfo_a(1:) = conn_info%phi_a(1:) - conn_info%onfo_b(1:) = conn_info%phi_d(1:) - ! Reorder bonds - ALLOCATE(ex_bond_list(natom)) - DO I=1,natom - ALLOCATE(ex_bond_list(I)%array1(0)) - ENDDO - N = 0 - IF(ASSOCIATED(conn_info%bond_a)) N = SIZE(conn_info%bond_a) - CALL reorder_structure(ex_bond_list, conn_info%bond_a, conn_info%bond_b, N) - ! Reorder bends - ALLOCATE(ex_bend_list(natom)) - DO I=1,natom - ALLOCATE(ex_bend_list(I)%array1(0)) - ENDDO - N = 0 - IF(ASSOCIATED(conn_info%theta_a)) N = SIZE(conn_info%theta_a) - CALL reorder_structure(ex_bend_list, conn_info%theta_a, conn_info%theta_c, N) - DO ionfo=1, nphi - ! Check if the torsion is not shared between angles or bonds - IF ( ANY(ex_bond_list(conn_info%onfo_a(ionfo))%array1==conn_info%onfo_b(ionfo)).OR.& - ANY(ex_bend_list(conn_info%onfo_a(ionfo))%array1==conn_info%onfo_b(ionfo))) CYCLE - nonfo = nonfo + 1 - conn_info%onfo_a(nonfo) = conn_info%onfo_a(ionfo) - conn_info%onfo_b(nonfo) = conn_info%onfo_b(ionfo) - END DO - ! deallocate bends - DO I=1,natom - DEALLOCATE(ex_bend_list(I)%array1) - ENDDO - DEALLOCATE(ex_bend_list) - ! deallocate bonds - DO I=1,natom - DEALLOCATE(ex_bond_list(I)%array1) - ENDDO - DEALLOCATE(ex_bond_list) - ! Get unique onfo - ALLOCATE(ex_bond_list(natom)) - DO I=1,natom - ALLOCATE(ex_bond_list(I)%array1(0)) - ENDDO - N = 0 - IF(ASSOCIATED(conn_info%onfo_a)) N = nonfo - CALL reorder_structure(ex_bond_list, conn_info%onfo_a, conn_info%onfo_b, N) - nonfo = 0 - DO I=1,natom - DO ionfo = 1, SIZE(ex_bond_list(I)%array1) - IF (COUNT(ex_bond_list(I)%array1==ex_bond_list(I)%array1(ionfo))/=1) THEN - ex_bond_list(I)%array1(ionfo) = 0 - ELSE - IF (ex_bond_list(I)%array1(ionfo)<=I) CYCLE - nonfo = nonfo + 1 - conn_info%onfo_a(nonfo) = I - conn_info%onfo_b(nonfo) = ex_bond_list(I)%array1(ionfo) - END IF - END DO - END DO - DO I=1,natom - DEALLOCATE(ex_bond_list(I)%array1) - ENDDO - DEALLOCATE(ex_bond_list) - CALL reallocate(conn_info%onfo_a,1,nonfo) - CALL reallocate(conn_info%onfo_b,1,nonfo) - - CALL timestop(handle) - CALL cp_print_key_finished_output(iw,logger,subsys_section,& - "PRINT%TOPOLOGY_INFO/PSF_INFO") - END SUBROUTINE psf_post_process + NULLIFY (logger) + logger => cp_get_default_logger() + iw = cp_print_key_unit_nr(logger, subsys_section, "PRINT%TOPOLOGY_INFO/PSF_INFO", & + extension=".subsysLog") + CALL timeset(routineN, handle) + atom_info => topology%atom_info + conn_info => topology%conn_info + ! + ! PARA_RES structure + ! + natom = 0 + nbond = 0 + i = 0 + IF (ASSOCIATED(atom_info%id_molname)) natom = SIZE(atom_info%id_molname) + IF (ASSOCIATED(conn_info%bond_a)) nbond = SIZE(conn_info%bond_a) + IF (ASSOCIATED(conn_info%c_bond_a)) i = SIZE(conn_info%c_bond_a) + DO ibond = 1, nbond + iatom = conn_info%bond_a(ibond) + jatom = conn_info%bond_b(ibond) + IF (topology%para_res) THEN + IF ((atom_info%id_molname(iatom) /= atom_info%id_molname(jatom)) .OR. & + (atom_info%resid(iatom) /= atom_info%resid(jatom)) .OR. & + (atom_info%id_resname(iatom) /= atom_info%id_resname(jatom))) THEN + IF (iw > 0) WRITE (iw, '(T2,A,2I6)') "PSF_INFO| PARA_RES, bond between molecules atom ", & + iatom, jatom + i = i + 1 + CALL reallocate(conn_info%c_bond_a, 1, i) + CALL reallocate(conn_info%c_bond_b, 1, i) + conn_info%c_bond_a(i) = iatom + conn_info%c_bond_b(i) = jatom + END IF + ELSE + IF (atom_info%id_molname(iatom) /= atom_info%id_molname(jatom)) THEN + CPABORT("") + END IF + END IF + END DO + ! + ! UB structure + ! + ntheta = 0 + IF (ASSOCIATED(conn_info%theta_a)) ntheta = SIZE(conn_info%theta_a) + CALL reallocate(conn_info%ub_a, 1, ntheta) + CALL reallocate(conn_info%ub_b, 1, ntheta) + CALL reallocate(conn_info%ub_c, 1, ntheta) + conn_info%ub_a(:) = conn_info%theta_a(:) + conn_info%ub_b(:) = conn_info%theta_b(:) + conn_info%ub_c(:) = conn_info%theta_c(:) + ! + ! ONFO structure + ! + nphi = 0 + nonfo = 0 + IF (ASSOCIATED(conn_info%phi_a)) nphi = SIZE(conn_info%phi_a) + CALL reallocate(conn_info%onfo_a, 1, nphi) + CALL reallocate(conn_info%onfo_b, 1, nphi) + conn_info%onfo_a(1:) = conn_info%phi_a(1:) + conn_info%onfo_b(1:) = conn_info%phi_d(1:) + ! Reorder bonds + ALLOCATE (ex_bond_list(natom)) + DO I = 1, natom + ALLOCATE (ex_bond_list(I)%array1(0)) + ENDDO + N = 0 + IF (ASSOCIATED(conn_info%bond_a)) N = SIZE(conn_info%bond_a) + CALL reorder_structure(ex_bond_list, conn_info%bond_a, conn_info%bond_b, N) + ! Reorder bends + ALLOCATE (ex_bend_list(natom)) + DO I = 1, natom + ALLOCATE (ex_bend_list(I)%array1(0)) + ENDDO + N = 0 + IF (ASSOCIATED(conn_info%theta_a)) N = SIZE(conn_info%theta_a) + CALL reorder_structure(ex_bend_list, conn_info%theta_a, conn_info%theta_c, N) + DO ionfo = 1, nphi + ! Check if the torsion is not shared between angles or bonds + IF (ANY(ex_bond_list(conn_info%onfo_a(ionfo))%array1 == conn_info%onfo_b(ionfo)) .OR. & + ANY(ex_bend_list(conn_info%onfo_a(ionfo))%array1 == conn_info%onfo_b(ionfo))) CYCLE + nonfo = nonfo + 1 + conn_info%onfo_a(nonfo) = conn_info%onfo_a(ionfo) + conn_info%onfo_b(nonfo) = conn_info%onfo_b(ionfo) + END DO + ! deallocate bends + DO I = 1, natom + DEALLOCATE (ex_bend_list(I)%array1) + ENDDO + DEALLOCATE (ex_bend_list) + ! deallocate bonds + DO I = 1, natom + DEALLOCATE (ex_bond_list(I)%array1) + ENDDO + DEALLOCATE (ex_bond_list) + ! Get unique onfo + ALLOCATE (ex_bond_list(natom)) + DO I = 1, natom + ALLOCATE (ex_bond_list(I)%array1(0)) + ENDDO + N = 0 + IF (ASSOCIATED(conn_info%onfo_a)) N = nonfo + CALL reorder_structure(ex_bond_list, conn_info%onfo_a, conn_info%onfo_b, N) + nonfo = 0 + DO I = 1, natom + DO ionfo = 1, SIZE(ex_bond_list(I)%array1) + IF (COUNT(ex_bond_list(I)%array1 == ex_bond_list(I)%array1(ionfo)) /= 1) THEN + ex_bond_list(I)%array1(ionfo) = 0 + ELSE + IF (ex_bond_list(I)%array1(ionfo) <= I) CYCLE + nonfo = nonfo + 1 + conn_info%onfo_a(nonfo) = I + conn_info%onfo_b(nonfo) = ex_bond_list(I)%array1(ionfo) + END IF + END DO + END DO + DO I = 1, natom + DEALLOCATE (ex_bond_list(I)%array1) + ENDDO + DEALLOCATE (ex_bond_list) + CALL reallocate(conn_info%onfo_a, 1, nonfo) + CALL reallocate(conn_info%onfo_b, 1, nonfo) + + CALL timestop(handle) + CALL cp_print_key_finished_output(iw, logger, subsys_section, & + "PRINT%TOPOLOGY_INFO/PSF_INFO") + END SUBROUTINE psf_post_process ! ************************************************************************************************** !> \brief Input driven modification (IDM) of PSF defined structures @@ -559,7 +559,7 @@ END SUBROUTINE psf_post_process !> \param subsys_section ... !> \author Teodoro Laino - Zurich University 04.2007 ! ************************************************************************************************** - SUBROUTINE idm_psf(topology,section,subsys_section) + SUBROUTINE idm_psf(topology, section, subsys_section) TYPE(topology_parameters_type), INTENT(INOUT) :: topology TYPE(section_vals_type), POINTER :: section, subsys_section @@ -576,139 +576,139 @@ SUBROUTINE idm_psf(topology,section,subsys_section) TYPE(cp_logger_type), POINTER :: logger TYPE(section_vals_type), POINTER :: subsection - NULLIFY(logger) - logger => cp_get_default_logger() - iw = cp_print_key_unit_nr(logger,subsys_section,"PRINT%TOPOLOGY_INFO/PSF_INFO",& - extension=".subsysLog") - CALL timeset(routineN,handle) - CALL section_vals_get(section, explicit=explicit) - IF (explicit) THEN - atom_info => topology%atom_info - conn_info => topology%conn_info - natom = 0 - IF(ASSOCIATED(atom_info%id_molname)) natom = SIZE(atom_info%id_molname) - nbond = 0 - IF (ASSOCIATED(conn_info%bond_a)) nbond = SIZE(conn_info%bond_a) - ntheta = 0 - IF (ASSOCIATED(conn_info%theta_a)) ntheta = SIZE(conn_info%theta_a) - nphi = 0 - IF (ASSOCIATED(conn_info%phi_a)) nphi = SIZE(conn_info%phi_a) - nimpr = 0 - IF (ASSOCIATED(conn_info%impr_a)) nimpr = SIZE(conn_info%impr_a) - ! Any new defined bond - subsection => section_vals_get_subs_vals(section,"BONDS") - CALL section_vals_get(subsection, explicit=explicit) - IF (explicit) THEN - CALL section_vals_val_get(subsection,"_DEFAULT_KEYWORD_",n_rep_val=n_rep) - CALL reallocate(conn_info%bond_a,1,n_rep+nbond) - CALL reallocate(conn_info%bond_b,1,n_rep+nbond) - DO i = 1, n_rep - CALL section_vals_val_get(subsection,"_DEFAULT_KEYWORD_",i_rep_val=i, i_vals=tmp) - conn_info%bond_a(nbond+i)=tmp(1) - conn_info%bond_b(nbond+i)=tmp(2) - END DO - ! And now modify the molecule name if two molecules have been bridged - ALLOCATE(ex_bond_list(natom)) - ALLOCATE(tag_mols(natom)) - ALLOCATE(wrk(natom)) - DO j=1,natom - ALLOCATE(ex_bond_list(j)%array1(0)) - ENDDO - CALL reorder_structure(ex_bond_list, conn_info%bond_a, conn_info%bond_b, nbond+n_rep) - ! Loop over atoms to possiblyt change molecule name - tag_mols=-1 - mol_id = 1 - DO i = 1, natom - IF (tag_mols(i)/=-1) CYCLE - CALL tag_molecule(tag_mols, ex_bond_list, i, mol_id) - mol_id = mol_id + 1 - END DO - mol_id = mol_id - 1 - IF (iw>0) WRITE(iw,'(T2,A,I8)') 'PSF_INFO| Number of molecules detected after merging: ',mol_id - ! Now simply check about the contiguousness of molecule definition - CALL sort(tag_mols, natom, wrk) - item = tag_mols(1) - istart = 1 - DO i = 2, natom - IF (tag_mols(i)==item) CYCLE - iend = i-1 - noe = iend-istart+1 - istart1 = MINVAL(wrk(istart:iend)) - iend1 = MAXVAL(wrk(istart:iend)) - CPASSERT(iend1-istart1+1==noe) - atom_info%id_molname(istart1:iend1)=str2id(s2s("MOL"//cp_to_string(item))) - item = tag_mols(i) - istart = i - END DO - iend = i-1 - noe = iend-istart+1 - istart1 = MINVAL(wrk(istart:iend)) - iend1 = MAXVAL(wrk(istart:iend)) - CPASSERT(iend1-istart1+1==noe) - atom_info%id_molname(istart1:iend1)=str2id(s2s("MOL"//cp_to_string(item))) - ! Deallocate bonds - DO i=1,natom - DEALLOCATE(ex_bond_list(i)%array1) - ENDDO - DEALLOCATE(ex_bond_list) - DEALLOCATE(tag_mols) - DEALLOCATE(wrk) - END IF - ! Any new defined angle - subsection => section_vals_get_subs_vals(section,"ANGLES") - CALL section_vals_get(subsection, explicit=explicit) - IF (explicit) THEN - CALL section_vals_val_get(subsection,"_DEFAULT_KEYWORD_",n_rep_val=n_rep) - CALL reallocate(conn_info%theta_a,1,n_rep+ntheta) - CALL reallocate(conn_info%theta_b,1,n_rep+ntheta) - CALL reallocate(conn_info%theta_c,1,n_rep+ntheta) - DO i = 1, n_rep - CALL section_vals_val_get(subsection,"_DEFAULT_KEYWORD_",i_rep_val=i, i_vals=tmp) - conn_info%theta_a(ntheta+i)=tmp(1) - conn_info%theta_b(ntheta+i)=tmp(2) - conn_info%theta_c(ntheta+i)=tmp(3) - END DO - END IF - ! Any new defined torsion - subsection => section_vals_get_subs_vals(section,"TORSIONS") - CALL section_vals_get(subsection, explicit=explicit) - IF (explicit) THEN - CALL section_vals_val_get(subsection,"_DEFAULT_KEYWORD_",n_rep_val=n_rep) - CALL reallocate(conn_info%phi_a,1,n_rep+nphi) - CALL reallocate(conn_info%phi_b,1,n_rep+nphi) - CALL reallocate(conn_info%phi_c,1,n_rep+nphi) - CALL reallocate(conn_info%phi_d,1,n_rep+nphi) - DO i = 1, n_rep - CALL section_vals_val_get(subsection,"_DEFAULT_KEYWORD_",i_rep_val=i, i_vals=tmp) - conn_info%phi_a(nphi+i)=tmp(1) - conn_info%phi_b(nphi+i)=tmp(2) - conn_info%phi_c(nphi+i)=tmp(3) - conn_info%phi_d(nphi+i)=tmp(4) - END DO - END IF - ! Any new defined improper - subsection => section_vals_get_subs_vals(section,"IMPROPERS") - CALL section_vals_get(subsection, explicit=explicit) - IF (explicit) THEN - CALL section_vals_val_get(subsection,"_DEFAULT_KEYWORD_",n_rep_val=n_rep) - CALL reallocate(conn_info%impr_a,1,n_rep+nimpr) - CALL reallocate(conn_info%impr_b,1,n_rep+nimpr) - CALL reallocate(conn_info%impr_c,1,n_rep+nimpr) - CALL reallocate(conn_info%impr_d,1,n_rep+nimpr) - DO i = 1, n_rep - CALL section_vals_val_get(subsection,"_DEFAULT_KEYWORD_",i_rep_val=i, i_vals=tmp) - conn_info%impr_a(nimpr+i)=tmp(1) - conn_info%impr_b(nimpr+i)=tmp(2) - conn_info%impr_c(nimpr+i)=tmp(3) - conn_info%impr_d(nimpr+i)=tmp(4) - END DO - END IF - END IF - CALL timestop(handle) - CALL cp_print_key_finished_output(iw,logger,subsys_section,& - "PRINT%TOPOLOGY_INFO/PSF_INFO") - - END SUBROUTINE idm_psf + NULLIFY (logger) + logger => cp_get_default_logger() + iw = cp_print_key_unit_nr(logger, subsys_section, "PRINT%TOPOLOGY_INFO/PSF_INFO", & + extension=".subsysLog") + CALL timeset(routineN, handle) + CALL section_vals_get(section, explicit=explicit) + IF (explicit) THEN + atom_info => topology%atom_info + conn_info => topology%conn_info + natom = 0 + IF (ASSOCIATED(atom_info%id_molname)) natom = SIZE(atom_info%id_molname) + nbond = 0 + IF (ASSOCIATED(conn_info%bond_a)) nbond = SIZE(conn_info%bond_a) + ntheta = 0 + IF (ASSOCIATED(conn_info%theta_a)) ntheta = SIZE(conn_info%theta_a) + nphi = 0 + IF (ASSOCIATED(conn_info%phi_a)) nphi = SIZE(conn_info%phi_a) + nimpr = 0 + IF (ASSOCIATED(conn_info%impr_a)) nimpr = SIZE(conn_info%impr_a) + ! Any new defined bond + subsection => section_vals_get_subs_vals(section, "BONDS") + CALL section_vals_get(subsection, explicit=explicit) + IF (explicit) THEN + CALL section_vals_val_get(subsection, "_DEFAULT_KEYWORD_", n_rep_val=n_rep) + CALL reallocate(conn_info%bond_a, 1, n_rep + nbond) + CALL reallocate(conn_info%bond_b, 1, n_rep + nbond) + DO i = 1, n_rep + CALL section_vals_val_get(subsection, "_DEFAULT_KEYWORD_", i_rep_val=i, i_vals=tmp) + conn_info%bond_a(nbond + i) = tmp(1) + conn_info%bond_b(nbond + i) = tmp(2) + END DO + ! And now modify the molecule name if two molecules have been bridged + ALLOCATE (ex_bond_list(natom)) + ALLOCATE (tag_mols(natom)) + ALLOCATE (wrk(natom)) + DO j = 1, natom + ALLOCATE (ex_bond_list(j)%array1(0)) + ENDDO + CALL reorder_structure(ex_bond_list, conn_info%bond_a, conn_info%bond_b, nbond + n_rep) + ! Loop over atoms to possiblyt change molecule name + tag_mols = -1 + mol_id = 1 + DO i = 1, natom + IF (tag_mols(i) /= -1) CYCLE + CALL tag_molecule(tag_mols, ex_bond_list, i, mol_id) + mol_id = mol_id + 1 + END DO + mol_id = mol_id - 1 + IF (iw > 0) WRITE (iw, '(T2,A,I8)') 'PSF_INFO| Number of molecules detected after merging: ', mol_id + ! Now simply check about the contiguousness of molecule definition + CALL sort(tag_mols, natom, wrk) + item = tag_mols(1) + istart = 1 + DO i = 2, natom + IF (tag_mols(i) == item) CYCLE + iend = i - 1 + noe = iend - istart + 1 + istart1 = MINVAL(wrk(istart:iend)) + iend1 = MAXVAL(wrk(istart:iend)) + CPASSERT(iend1 - istart1 + 1 == noe) + atom_info%id_molname(istart1:iend1) = str2id(s2s("MOL"//cp_to_string(item))) + item = tag_mols(i) + istart = i + END DO + iend = i - 1 + noe = iend - istart + 1 + istart1 = MINVAL(wrk(istart:iend)) + iend1 = MAXVAL(wrk(istart:iend)) + CPASSERT(iend1 - istart1 + 1 == noe) + atom_info%id_molname(istart1:iend1) = str2id(s2s("MOL"//cp_to_string(item))) + ! Deallocate bonds + DO i = 1, natom + DEALLOCATE (ex_bond_list(i)%array1) + ENDDO + DEALLOCATE (ex_bond_list) + DEALLOCATE (tag_mols) + DEALLOCATE (wrk) + END IF + ! Any new defined angle + subsection => section_vals_get_subs_vals(section, "ANGLES") + CALL section_vals_get(subsection, explicit=explicit) + IF (explicit) THEN + CALL section_vals_val_get(subsection, "_DEFAULT_KEYWORD_", n_rep_val=n_rep) + CALL reallocate(conn_info%theta_a, 1, n_rep + ntheta) + CALL reallocate(conn_info%theta_b, 1, n_rep + ntheta) + CALL reallocate(conn_info%theta_c, 1, n_rep + ntheta) + DO i = 1, n_rep + CALL section_vals_val_get(subsection, "_DEFAULT_KEYWORD_", i_rep_val=i, i_vals=tmp) + conn_info%theta_a(ntheta + i) = tmp(1) + conn_info%theta_b(ntheta + i) = tmp(2) + conn_info%theta_c(ntheta + i) = tmp(3) + END DO + END IF + ! Any new defined torsion + subsection => section_vals_get_subs_vals(section, "TORSIONS") + CALL section_vals_get(subsection, explicit=explicit) + IF (explicit) THEN + CALL section_vals_val_get(subsection, "_DEFAULT_KEYWORD_", n_rep_val=n_rep) + CALL reallocate(conn_info%phi_a, 1, n_rep + nphi) + CALL reallocate(conn_info%phi_b, 1, n_rep + nphi) + CALL reallocate(conn_info%phi_c, 1, n_rep + nphi) + CALL reallocate(conn_info%phi_d, 1, n_rep + nphi) + DO i = 1, n_rep + CALL section_vals_val_get(subsection, "_DEFAULT_KEYWORD_", i_rep_val=i, i_vals=tmp) + conn_info%phi_a(nphi + i) = tmp(1) + conn_info%phi_b(nphi + i) = tmp(2) + conn_info%phi_c(nphi + i) = tmp(3) + conn_info%phi_d(nphi + i) = tmp(4) + END DO + END IF + ! Any new defined improper + subsection => section_vals_get_subs_vals(section, "IMPROPERS") + CALL section_vals_get(subsection, explicit=explicit) + IF (explicit) THEN + CALL section_vals_val_get(subsection, "_DEFAULT_KEYWORD_", n_rep_val=n_rep) + CALL reallocate(conn_info%impr_a, 1, n_rep + nimpr) + CALL reallocate(conn_info%impr_b, 1, n_rep + nimpr) + CALL reallocate(conn_info%impr_c, 1, n_rep + nimpr) + CALL reallocate(conn_info%impr_d, 1, n_rep + nimpr) + DO i = 1, n_rep + CALL section_vals_val_get(subsection, "_DEFAULT_KEYWORD_", i_rep_val=i, i_vals=tmp) + conn_info%impr_a(nimpr + i) = tmp(1) + conn_info%impr_b(nimpr + i) = tmp(2) + conn_info%impr_c(nimpr + i) = tmp(3) + conn_info%impr_d(nimpr + i) = tmp(4) + END DO + END IF + END IF + CALL timestop(handle) + CALL cp_print_key_finished_output(iw, logger, subsys_section, & + "PRINT%TOPOLOGY_INFO/PSF_INFO") + + END SUBROUTINE idm_psf ! ************************************************************************************************** !> \brief Teodoro Laino - 01.2006 @@ -718,7 +718,7 @@ END SUBROUTINE idm_psf !> \param subsys_section ... !> \param force_env_section ... ! ************************************************************************************************** - SUBROUTINE write_topology_psf (file_unit,topology,subsys_section,force_env_section) + SUBROUTINE write_topology_psf(file_unit, topology, subsys_section, force_env_section) INTEGER, INTENT(IN) :: file_unit TYPE(topology_parameters_type), INTENT(INOUT) :: topology TYPE(section_vals_type), POINTER :: subsys_section, force_env_section @@ -738,164 +738,164 @@ SUBROUTINE write_topology_psf (file_unit,topology,subsys_section,force_env_secti TYPE(cp_logger_type), POINTER :: logger TYPE(section_vals_type), POINTER :: print_key, tmp_section - NULLIFY(logger) - logger => cp_get_default_logger() - print_key => section_vals_get_subs_vals(subsys_section,"TOPOLOGY%DUMP_PSF") - iw = cp_print_key_unit_nr(logger,subsys_section,"PRINT%TOPOLOGY_INFO/PSF_INFO",& - extension=".subsysLog") - CALL timeset(routineN,handle) - - atom_info => topology%atom_info - conn_info => topology%conn_info - - ! Check for charges.. (need to dump them in the PSF..) - ALLOCATE(charges(topology%natoms)) - charges = atom_info%atm_charge - ! Collect charges from Input file.. - NULLIFY(tmp_section) - tmp_section => section_vals_get_subs_vals(force_env_section,"MM%FORCEFIELD%CHARGE") - CALL section_vals_get(tmp_section,explicit=explicit,n_repetition=nchg) - IF (explicit) THEN - ALLOCATE(charge_atm(nchg)) - ALLOCATE(charge_inp(nchg)) - CALL read_chrg_section(charge_atm,charge_inp,section=tmp_section,start=0) - DO j = 1, topology%natoms - record = id2str(atom_info%id_atmname(j)) - ldum = qmmm_ff_precond_only_qm(record) - CALL uppercase(record) - DO i = 1, nchg - IF (record==charge_atm(i)) THEN - charges(j) = charge_inp(i) - EXIT - END IF - END DO - END DO - DEALLOCATE(charge_atm) - DEALLOCATE(charge_inp) - END IF - ! fixup for topology output - DO j = 1, topology%natoms - IF (charges(j).EQ.-HUGE(0.0_dp)) charges(j)=-99.0_dp - ENDDO - record = cp_print_key_generate_filename(logger,print_key,& - extension=".psf",my_local=.FALSE.) - ! build the EXT format - c_int="I10" - psf_format = '(I10,T12,A,T21,I0,T30,A,T39,A,T47,A,T53,F10.6,T69,F8.3,T88,I1)' - IF(iw>0) WRITE(iw,'(T2,A)') & - "PSF_WRITE| Writing out PSF file with CHARMM31 EXTErnal format: ",TRIM(record) - - WRITE(file_unit,FMT='(A)') "PSF EXT" - WRITE(file_unit,FMT='(A)') "" - WRITE(file_unit,FMT='('//TRIM(c_int)//',A)') 1," !NTITLE" - WRITE(file_unit,FMT='(A)') " CP2K generated DUMP of connectivity" - WRITE(file_unit,FMT='(A)') "" - - WRITE(file_unit,FMT='('//TRIM(c_int)//',A)')topology%natoms," !NATOM" - my_index = 1 - i = 1 - my_tag1 = id2str(atom_info%id_molname(i)) - my_tag2 = id2str(atom_info%id_resname(i)) - my_tag3 = id2str(atom_info%id_atmname(i)) - ldum = qmmm_ff_precond_only_qm(my_tag1) - ldum = qmmm_ff_precond_only_qm(my_tag2) - ldum = qmmm_ff_precond_only_qm(my_tag3) - WRITE(file_unit,FMT=psf_format)& - i,& - TRIM(my_tag1),& - my_index,& - TRIM(my_tag2),& - TRIM(my_tag3),& - TRIM(my_tag3),& - charges(i),& - atom_info%atm_mass(i),& + NULLIFY (logger) + logger => cp_get_default_logger() + print_key => section_vals_get_subs_vals(subsys_section, "TOPOLOGY%DUMP_PSF") + iw = cp_print_key_unit_nr(logger, subsys_section, "PRINT%TOPOLOGY_INFO/PSF_INFO", & + extension=".subsysLog") + CALL timeset(routineN, handle) + + atom_info => topology%atom_info + conn_info => topology%conn_info + + ! Check for charges.. (need to dump them in the PSF..) + ALLOCATE (charges(topology%natoms)) + charges = atom_info%atm_charge + ! Collect charges from Input file.. + NULLIFY (tmp_section) + tmp_section => section_vals_get_subs_vals(force_env_section, "MM%FORCEFIELD%CHARGE") + CALL section_vals_get(tmp_section, explicit=explicit, n_repetition=nchg) + IF (explicit) THEN + ALLOCATE (charge_atm(nchg)) + ALLOCATE (charge_inp(nchg)) + CALL read_chrg_section(charge_atm, charge_inp, section=tmp_section, start=0) + DO j = 1, topology%natoms + record = id2str(atom_info%id_atmname(j)) + ldum = qmmm_ff_precond_only_qm(record) + CALL uppercase(record) + DO i = 1, nchg + IF (record == charge_atm(i)) THEN + charges(j) = charge_inp(i) + EXIT + END IF + END DO + END DO + DEALLOCATE (charge_atm) + DEALLOCATE (charge_inp) + END IF + ! fixup for topology output + DO j = 1, topology%natoms + IF (charges(j) .EQ. -HUGE(0.0_dp)) charges(j) = -99.0_dp + ENDDO + record = cp_print_key_generate_filename(logger, print_key, & + extension=".psf", my_local=.FALSE.) + ! build the EXT format + c_int = "I10" + psf_format = '(I10,T12,A,T21,I0,T30,A,T39,A,T47,A,T53,F10.6,T69,F8.3,T88,I1)' + IF (iw > 0) WRITE (iw, '(T2,A)') & + "PSF_WRITE| Writing out PSF file with CHARMM31 EXTErnal format: ", TRIM(record) + + WRITE (file_unit, FMT='(A)') "PSF EXT" + WRITE (file_unit, FMT='(A)') "" + WRITE (file_unit, FMT='('//TRIM(c_int)//',A)') 1, " !NTITLE" + WRITE (file_unit, FMT='(A)') " CP2K generated DUMP of connectivity" + WRITE (file_unit, FMT='(A)') "" + + WRITE (file_unit, FMT='('//TRIM(c_int)//',A)') topology%natoms, " !NATOM" + my_index = 1 + i = 1 + my_tag1 = id2str(atom_info%id_molname(i)) + my_tag2 = id2str(atom_info%id_resname(i)) + my_tag3 = id2str(atom_info%id_atmname(i)) + ldum = qmmm_ff_precond_only_qm(my_tag1) + ldum = qmmm_ff_precond_only_qm(my_tag2) + ldum = qmmm_ff_precond_only_qm(my_tag3) + WRITE (file_unit, FMT=psf_format) & + i, & + TRIM(my_tag1), & + my_index, & + TRIM(my_tag2), & + TRIM(my_tag3), & + TRIM(my_tag3), & + charges(i), & + atom_info%atm_mass(i), & 0 - DO i=2,topology%natoms - IF ((atom_info%map_mol_num(i)/=atom_info%map_mol_num(i-1)).OR.& - (atom_info%map_mol_res(i)/=atom_info%map_mol_res(i-1))) my_index = my_index + 1 - my_tag1 = id2str(atom_info%id_molname(i)) - my_tag2 = id2str(atom_info%id_resname(i)) - my_tag3 = id2str(atom_info%id_atmname(i)) - ldum = qmmm_ff_precond_only_qm(my_tag1) - ldum = qmmm_ff_precond_only_qm(my_tag2) - ldum = qmmm_ff_precond_only_qm(my_tag3) - WRITE(file_unit,FMT=psf_format)& - i,& - TRIM(my_tag1),& - my_index,& - TRIM(my_tag2),& - TRIM(my_tag3),& - TRIM(my_tag3),& - charges(i),& - atom_info%atm_mass(i),& + DO i = 2, topology%natoms + IF ((atom_info%map_mol_num(i) /= atom_info%map_mol_num(i - 1)) .OR. & + (atom_info%map_mol_res(i) /= atom_info%map_mol_res(i - 1))) my_index = my_index + 1 + my_tag1 = id2str(atom_info%id_molname(i)) + my_tag2 = id2str(atom_info%id_resname(i)) + my_tag3 = id2str(atom_info%id_atmname(i)) + ldum = qmmm_ff_precond_only_qm(my_tag1) + ldum = qmmm_ff_precond_only_qm(my_tag2) + ldum = qmmm_ff_precond_only_qm(my_tag3) + WRITE (file_unit, FMT=psf_format) & + i, & + TRIM(my_tag1), & + my_index, & + TRIM(my_tag2), & + TRIM(my_tag3), & + TRIM(my_tag3), & + charges(i), & + atom_info%atm_mass(i), & 0 - END DO - WRITE(file_unit,FMT='(/)') - DEALLOCATE(charges) - - WRITE(file_unit,FMT='('//TRIM(c_int)//',A)')SIZE(conn_info%bond_a)," !NBOND" - DO i=1,SIZE(conn_info%bond_a),4 - j=0 - DO WHILE ((j<4).AND.((i+j)<=SIZE(conn_info%bond_a))) - WRITE(file_unit,FMT='(2('//TRIM(c_int)//'))',ADVANCE="NO") & - conn_info%bond_a(i+j),conn_info%bond_b(i+j) - j=j+1 - END DO - WRITE(file_unit,FMT='(/)',ADVANCE="NO") - END DO - WRITE(file_unit,FMT='(/)') - - WRITE(file_unit,FMT='('//TRIM(c_int)//',A)')SIZE(conn_info%theta_a)," !NTHETA" - DO i=1,SIZE(conn_info%theta_a),3 - j=0 - DO WHILE ((j<3).AND.((i+j)<=SIZE(conn_info%theta_a))) - WRITE(file_unit,FMT='(3('//TRIM(c_int)//'))',ADVANCE="NO") & - conn_info%theta_a(i+j),conn_info%theta_b(i+j),& - conn_info%theta_c(i+j) - j=j+1 - END DO - WRITE(file_unit,FMT='(/)',ADVANCE="NO") - END DO - WRITE(file_unit,FMT='(/)') - - WRITE(file_unit,FMT='('//TRIM(c_int)//',A)')SIZE(conn_info%phi_a)," !NPHI" - DO i=1,SIZE(conn_info%phi_a),2 - j=0 - DO WHILE ((j<2).AND.((i+j)<=SIZE(conn_info%phi_a))) - WRITE(file_unit,FMT='(4('//TRIM(c_int)//'))',ADVANCE="NO") & - conn_info%phi_a(i+j),conn_info%phi_b(i+j),& - conn_info%phi_c(i+j),conn_info%phi_d(i+j) - j=j+1 - END DO - WRITE(file_unit,FMT='(/)',ADVANCE="NO") - END DO - WRITE(file_unit,FMT='(/)') - - WRITE(file_unit,FMT='('//TRIM(c_int)//',A)')SIZE(conn_info%impr_a)," !NIMPHI" - DO i=1,SIZE(conn_info%impr_a),2 - j=0 - DO WHILE ((j<2).AND.((i+j)<=SIZE(conn_info%impr_a))) - WRITE(file_unit,FMT='(4('//TRIM(c_int)//'))',ADVANCE="NO") & - conn_info%impr_a(i+j),conn_info%impr_b(i+j),& - conn_info%impr_c(i+j),conn_info%impr_d(i+j) - j=j+1 - END DO - WRITE(file_unit,FMT='(/)',ADVANCE="NO") - END DO - WRITE(file_unit,FMT='(/)') - - WRITE(file_unit,FMT='('//TRIM(c_int)//',A)') 0," !NDON" - WRITE(file_unit,FMT='(/)') - WRITE(file_unit,FMT='('//TRIM(c_int)//',A)') 0," !NACC" - WRITE(file_unit,FMT='(/)') - WRITE(file_unit,FMT='('//TRIM(c_int)//',A)') 0," !NNB" - WRITE(file_unit,FMT='(/)') - - CALL cp_print_key_finished_output(iw,logger,subsys_section,& - "PRINT%TOPOLOGY_INFO/PSF_INFO") - CALL timestop(handle) - - END SUBROUTINE write_topology_psf + END DO + WRITE (file_unit, FMT='(/)') + DEALLOCATE (charges) + + WRITE (file_unit, FMT='('//TRIM(c_int)//',A)') SIZE(conn_info%bond_a), " !NBOND" + DO i = 1, SIZE(conn_info%bond_a), 4 + j = 0 + DO WHILE ((j < 4) .AND. ((i + j) <= SIZE(conn_info%bond_a))) + WRITE (file_unit, FMT='(2('//TRIM(c_int)//'))', ADVANCE="NO") & + conn_info%bond_a(i + j), conn_info%bond_b(i + j) + j = j + 1 + END DO + WRITE (file_unit, FMT='(/)', ADVANCE="NO") + END DO + WRITE (file_unit, FMT='(/)') + + WRITE (file_unit, FMT='('//TRIM(c_int)//',A)') SIZE(conn_info%theta_a), " !NTHETA" + DO i = 1, SIZE(conn_info%theta_a), 3 + j = 0 + DO WHILE ((j < 3) .AND. ((i + j) <= SIZE(conn_info%theta_a))) + WRITE (file_unit, FMT='(3('//TRIM(c_int)//'))', ADVANCE="NO") & + conn_info%theta_a(i + j), conn_info%theta_b(i + j), & + conn_info%theta_c(i + j) + j = j + 1 + END DO + WRITE (file_unit, FMT='(/)', ADVANCE="NO") + END DO + WRITE (file_unit, FMT='(/)') + + WRITE (file_unit, FMT='('//TRIM(c_int)//',A)') SIZE(conn_info%phi_a), " !NPHI" + DO i = 1, SIZE(conn_info%phi_a), 2 + j = 0 + DO WHILE ((j < 2) .AND. ((i + j) <= SIZE(conn_info%phi_a))) + WRITE (file_unit, FMT='(4('//TRIM(c_int)//'))', ADVANCE="NO") & + conn_info%phi_a(i + j), conn_info%phi_b(i + j), & + conn_info%phi_c(i + j), conn_info%phi_d(i + j) + j = j + 1 + END DO + WRITE (file_unit, FMT='(/)', ADVANCE="NO") + END DO + WRITE (file_unit, FMT='(/)') + + WRITE (file_unit, FMT='('//TRIM(c_int)//',A)') SIZE(conn_info%impr_a), " !NIMPHI" + DO i = 1, SIZE(conn_info%impr_a), 2 + j = 0 + DO WHILE ((j < 2) .AND. ((i + j) <= SIZE(conn_info%impr_a))) + WRITE (file_unit, FMT='(4('//TRIM(c_int)//'))', ADVANCE="NO") & + conn_info%impr_a(i + j), conn_info%impr_b(i + j), & + conn_info%impr_c(i + j), conn_info%impr_d(i + j) + j = j + 1 + END DO + WRITE (file_unit, FMT='(/)', ADVANCE="NO") + END DO + WRITE (file_unit, FMT='(/)') + + WRITE (file_unit, FMT='('//TRIM(c_int)//',A)') 0, " !NDON" + WRITE (file_unit, FMT='(/)') + WRITE (file_unit, FMT='('//TRIM(c_int)//',A)') 0, " !NACC" + WRITE (file_unit, FMT='(/)') + WRITE (file_unit, FMT='('//TRIM(c_int)//',A)') 0, " !NNB" + WRITE (file_unit, FMT='(/)') + + CALL cp_print_key_finished_output(iw, logger, subsys_section, & + "PRINT%TOPOLOGY_INFO/PSF_INFO") + CALL timestop(handle) + + END SUBROUTINE write_topology_psf END MODULE topology_psf diff --git a/src/topology_util.F b/src/topology_util.F index fdd2b26d24..f7278d4bcc 100644 --- a/src/topology_util.F +++ b/src/topology_util.F @@ -185,18 +185,18 @@ SUBROUTINE topology_reorder_atoms(topology, qmmm, qmmm_env_mm, subsys_section, f old_mol = atom_info%map_mol_num(I) iindex = 0 IF (imol > 0) THEN - mol_bnd(2, imol) = i-1 + mol_bnd(2, imol) = i - 1 END IF - imol = imol+1 + imol = imol + 1 mol_bnd(1, imol) = i ENDIF - iindex = iindex+1 + iindex = iindex + 1 atm_map2(atm_map1(i)) = iindex ENDDO mol_bnd(2, imol) = natom ! Indexes of the two molecules to check iref = 1 - iund = max_mol_num/2+1 + iund = max_mol_num/2 + 1 ! Allocate reference and unordered NULLIFY (reference, unordered) ! This is the real matching of graphs @@ -227,7 +227,7 @@ SUBROUTINE topology_reorder_atoms(topology, qmmm, qmmm_env_mm, subsys_section, f END IF DO j = 1, max_mol_num IF (mol_hash(j) .NE. old_hash) THEN - unique_mol = unique_mol+1 + unique_mol = unique_mol + 1 old_hash = mol_hash(j) CALL setup_graph_set(reference_set, unique_mol, map_mol_hash(j), & map_atom_type, atom_bond_list, mol_bnd, atm_map1, atm_map2, & @@ -235,7 +235,7 @@ SUBROUTINE topology_reorder_atoms(topology, qmmm, qmmm_env_mm, subsys_section, f ! Reorder Last added reference mol_id = TRIM(ADJUSTL(cp_to_string(unique_mol))) DO i = 1, SIZE(atm_map3) - natom_loc = natom_loc+1 + natom_loc = natom_loc + 1 new_position(natom_loc) = atm_map3(i) molname(natom_loc) = mol_id mol_num(natom_loc) = unique_mol @@ -257,7 +257,7 @@ SUBROUTINE topology_reorder_atoms(topology, qmmm, qmmm_env_mm, subsys_section, f ALLOCATE (wrk(SIZE(order))) CALL sort(order, SIZE(order), wrk) DO i = 1, SIZE(order) - natom_loc = natom_loc+1 + natom_loc = natom_loc + 1 new_position(natom_loc) = atm_map3(wrk(i)) molname(natom_loc) = mol_id mol_num(natom_loc) = unique_mol @@ -266,14 +266,14 @@ SUBROUTINE topology_reorder_atoms(topology, qmmm, qmmm_env_mm, subsys_section, f DEALLOCATE (order) DEALLOCATE (wrk) ELSE - unique_mol = unique_mol+1 + unique_mol = unique_mol + 1 CALL setup_graph_set(reference_set, unique_mol, map_mol_hash(j), & map_atom_type, atom_bond_list, mol_bnd, atm_map1, atm_map2, & atm_map3) ! Reorder Last added reference mol_id = TRIM(ADJUSTL(cp_to_string(unique_mol))) DO i = 1, SIZE(atm_map3) - natom_loc = natom_loc+1 + natom_loc = natom_loc + 1 new_position(natom_loc) = atm_map3(i) molname(natom_loc) = mol_id mol_num(natom_loc) = unique_mol @@ -475,12 +475,12 @@ SUBROUTINE setup_graph_set(graph_set, idim, ind, array2, atom_bond_list, map_mol NULLIFY (tmp_graph_set) IF (ASSOCIATED(graph_set)) THEN ldim = SIZE(graph_set) - CPASSERT(ldim+1 == idim) + CPASSERT(ldim + 1 == idim) NULLIFY (tmp_graph_set) CALL allocate_graph_set(graph_set, tmp_graph_set) END IF - CALL allocate_graph_set(tmp_graph_set, graph_set, ldim, ldim+1) - CALL setup_graph(ind, graph_set(ldim+1)%graph, array2, & + CALL allocate_graph_set(tmp_graph_set, graph_set, ldim, ldim + 1) + CALL setup_graph(ind, graph_set(ldim + 1)%graph, array2, & atom_bond_list, map_mol, atm_map1, atm_map2, atm_map3) END SUBROUTINE setup_graph_set @@ -569,13 +569,13 @@ SUBROUTINE setup_graph(ind, graph, array2, atom_bond_list, map_mol, & idim = 0 ifirst = map_mol(1, ind) ilast = map_mol(2, ind) - nelement = ilast-ifirst+1 + nelement = ilast - ifirst + 1 ALLOCATE (graph(nelement)) IF (PRESENT(atm_map3)) THEN ALLOCATE (atm_map3(nelement)) END IF DO i = ifirst, ilast - idim = idim+1 + idim = idim + 1 graph(idim)%kind = array2(atm_map1(i)) nbonds = SIZE(atom_bond_list(atm_map1(i))%array1) ALLOCATE (graph(idim)%bonds(nbonds)) @@ -639,8 +639,8 @@ RECURSIVE SUBROUTINE reorder_list_array(Ilist1, Ilist2, Ilist3, Ilist4, nsize, n istart = 1 DO i = 1, Ndim IF (Ilist1(i) /= Ilist1(istart)) THEN - iend = i-1 - ldim = iend-istart+1 + iend = i - 1 + ldim = iend - istart + 1 CALL reorder_list_array_low(Ilist2, Ilist3, Ilist4, nsize, & ldim, istart, iend) istart = i @@ -648,7 +648,7 @@ RECURSIVE SUBROUTINE reorder_list_array(Ilist1, Ilist2, Ilist3, Ilist4, nsize, n END DO ! Last term to sort iend = Ndim - ldim = iend-istart+1 + ldim = iend - istart + 1 CALL reorder_list_array_low(Ilist2, Ilist3, Ilist4, nsize, & ldim, istart, iend) END IF @@ -680,7 +680,7 @@ RECURSIVE SUBROUTINE reorder_list_array_low(Ilist2, Ilist3, Ilist4, nsize, & CASE (2) ALLOCATE (tmp_2(ldim)) tmp_2(:) = Ilist2(istart:iend) - CALL reorder_list_array(tmp_2, nsize=nsize-1, ndim=ldim) + CALL reorder_list_array(tmp_2, nsize=nsize - 1, ndim=ldim) Ilist2(istart:iend) = tmp_2(:) DEALLOCATE (tmp_2) CASE (3) @@ -688,7 +688,7 @@ RECURSIVE SUBROUTINE reorder_list_array_low(Ilist2, Ilist3, Ilist4, nsize, & ALLOCATE (tmp_3(ldim)) tmp_2(:) = Ilist2(istart:iend) tmp_3(:) = Ilist3(istart:iend) - CALL reorder_list_array(tmp_2, tmp_3, nsize=nsize-1, ndim=ldim) + CALL reorder_list_array(tmp_2, tmp_3, nsize=nsize - 1, ndim=ldim) Ilist2(istart:iend) = tmp_2(:) Ilist3(istart:iend) = tmp_3(:) DEALLOCATE (tmp_2) @@ -700,7 +700,7 @@ RECURSIVE SUBROUTINE reorder_list_array_low(Ilist2, Ilist3, Ilist4, nsize, & tmp_2(:) = Ilist2(istart:iend) tmp_3(:) = Ilist3(istart:iend) tmp_4(:) = Ilist4(istart:iend) - CALL reorder_list_array(tmp_2, tmp_3, tmp_4, nsize=nsize-1, ndim=ldim) + CALL reorder_list_array(tmp_2, tmp_3, tmp_4, nsize=nsize - 1, ndim=ldim) Ilist2(istart:iend) = tmp_2(:) Ilist3(istart:iend) = tmp_3(:) Ilist4(istart:iend) = tmp_4(:) @@ -736,7 +736,7 @@ RECURSIVE SUBROUTINE give_back_molecule(icheck, bond_list, i, mol_natom, mol_map DO j = 1, SIZE(bond_list(i)%array1) k = bond_list(i)%array1(j) IF (icheck(k)) CYCLE - mol_natom = mol_natom+1 + mol_natom = mol_natom + 1 CALL give_back_molecule(icheck, bond_list, k, mol_natom, mol_map, my_mol) END DO ELSE @@ -797,16 +797,16 @@ SUBROUTINE reorder_structure1d(work, list1, list2, N) wrk_tmp => work(index1)%array1 Nsize = SIZE(wrk_tmp) - ALLOCATE (work(index1)%array1(Nsize+1)) + ALLOCATE (work(index1)%array1(Nsize + 1)) work(index1)%array1(1:Nsize) = wrk_tmp - work(index1)%array1(Nsize+1) = index2 + work(index1)%array1(Nsize + 1) = index2 DEALLOCATE (wrk_tmp) wrk_tmp => work(index2)%array1 Nsize = SIZE(wrk_tmp) - ALLOCATE (work(index2)%array1(Nsize+1)) + ALLOCATE (work(index2)%array1(Nsize + 1)) work(index2)%array1(1:Nsize) = wrk_tmp - work(index2)%array1(Nsize+1) = index1 + work(index2)%array1(Nsize + 1) = index1 DEALLOCATE (wrk_tmp) ENDDO @@ -841,30 +841,30 @@ SUBROUTINE reorder_structure2d(work, list1, list2, list3, N) wrk_tmp => work(index1)%array1 Nsize = SIZE(wrk_tmp) - ALLOCATE (work(index1)%array1(Nsize+1)) + ALLOCATE (work(index1)%array1(Nsize + 1)) work(index1)%array1(1:Nsize) = wrk_tmp - work(index1)%array1(Nsize+1) = index2 + work(index1)%array1(Nsize + 1) = index2 DEALLOCATE (wrk_tmp) wrk_tmp => work(index2)%array1 Nsize = SIZE(wrk_tmp) - ALLOCATE (work(index2)%array1(Nsize+1)) + ALLOCATE (work(index2)%array1(Nsize + 1)) work(index2)%array1(1:Nsize) = wrk_tmp - work(index2)%array1(Nsize+1) = index1 + work(index2)%array1(Nsize + 1) = index1 DEALLOCATE (wrk_tmp) wrk_tmp => work(index1)%array2 Nsize = SIZE(wrk_tmp) - ALLOCATE (work(index1)%array2(Nsize+1)) + ALLOCATE (work(index1)%array2(Nsize + 1)) work(index1)%array2(1:Nsize) = wrk_tmp - work(index1)%array2(Nsize+1) = index3 + work(index1)%array2(Nsize + 1) = index3 DEALLOCATE (wrk_tmp) wrk_tmp => work(index2)%array2 Nsize = SIZE(wrk_tmp) - ALLOCATE (work(index2)%array2(Nsize+1)) + ALLOCATE (work(index2)%array2(Nsize + 1)) work(index2)%array2(1:Nsize) = wrk_tmp - work(index2)%array2(Nsize+1) = -index3 + work(index2)%array2(Nsize + 1) = -index3 DEALLOCATE (wrk_tmp) ENDDO @@ -889,7 +889,7 @@ SUBROUTINE find_molecule(atom_bond_list, mol_info, mol_name) nmol = 0 DO I = 1, N IF (mol_info(I) == -1) THEN - nmol = nmol+1 + nmol = nmol + 1 my_mol_name = mol_name(I) CALL spread_mol(atom_bond_list, mol_info, i, nmol, my_mol_name, & mol_name) @@ -1081,39 +1081,39 @@ SUBROUTINE topology_molecules_check(topology, subsys_section) mol_typ = atom_info%map_mol_typ(iatom) END IF IF (icheck_num) THEN - IF (icheck_typ) loc_counter = loc_counter+1 + IF (icheck_typ) loc_counter = loc_counter + 1 !----------------------------------------------------------------------------- !----------------------------------------------------------------------------- ! 2. Check that each molecule has the same atom sequences !----------------------------------------------------------------------------- IF (atom_info%id_atmname(iatom) /= & - atom_info%id_atmname(first+loc_counter-1)) THEN + atom_info%id_atmname(first + loc_counter - 1)) THEN CALL cp_abort(__LOCATION__, & "different atom name for same molecule kind"// & " atom number = "//cp_to_string(iatom)// & " molecule type = "//cp_to_string(mol_typ)// & " molecule number= "//cp_to_string(mol_num)// & - " expected atom name="//TRIM(id2str(atom_info%id_atmname(first+loc_counter-1)))// & + " expected atom name="//TRIM(id2str(atom_info%id_atmname(first + loc_counter - 1)))// & " found="//TRIM(id2str(atom_info%id_atmname(iatom)))) END IF !----------------------------------------------------------------------------- !----------------------------------------------------------------------------- ! 3. Check that each molecule have the same bond sequences !----------------------------------------------------------------------------- - IF (SIZE(atom_bond_list(iatom)%array1) /= SIZE(atom_bond_list(first+loc_counter-1)%array1)) THEN + IF (SIZE(atom_bond_list(iatom)%array1) /= SIZE(atom_bond_list(first + loc_counter - 1)%array1)) THEN CALL cp_abort(__LOCATION__, & "different number of bonds for same molecule kind"// & " molecule type = "//cp_to_string(mol_typ)// & " molecule number= "//cp_to_string(mol_num)// & " expected bonds="// & - cp_to_string(SIZE(atom_bond_list(first+loc_counter-1)%array1))//" - "// & + cp_to_string(SIZE(atom_bond_list(first + loc_counter - 1)%array1))//" - "// & cp_to_string(SIZE(atom_bond_list(iatom)%array1))// & " NOT FOUND! Check the connectivity of your system.") ENDIF DO k = 1, SIZE(atom_bond_list(iatom)%array1) - IF (ALL(atom_bond_list(first+loc_counter-1)%array1-first /= & - atom_bond_list(iatom)%array1(k)-first_loc)) THEN + IF (ALL(atom_bond_list(first + loc_counter - 1)%array1 - first /= & + atom_bond_list(iatom)%array1(k) - first_loc)) THEN CALL cp_abort(__LOCATION__, & "different sequence of bonds for same molecule kind"// & " molecule type = "//cp_to_string(mol_typ)// & @@ -1126,7 +1126,7 @@ SUBROUTINE topology_molecules_check(topology, subsys_section) loc_counter = 1 first_loc = iatom END IF - IF (mol_num == 1 .AND. icheck_typ) counter = counter+1 + IF (mol_num == 1 .AND. icheck_typ) counter = counter + 1 END DO IF (iw > 0) WRITE (iw, '(A)') "End of Molecule_Check" diff --git a/src/topology_xtl.F b/src/topology_xtl.F index 76d5452292..179760627c 100644 --- a/src/topology_xtl.F +++ b/src/topology_xtl.F @@ -189,7 +189,7 @@ SUBROUTINE read_coordinate_xtl(topology, para_env, subsys_section) ! Parse real info natom = 0 DO WHILE (INDEX(parser%input_line, "EOF") == 0) - natom = natom+1 + natom = natom + 1 ! Resize in case needed IF (natom > SIZE(atom_info%id_molname)) THEN newsize = INT(pfactor*natom) @@ -228,9 +228,9 @@ SUBROUTINE read_coordinate_xtl(topology, para_env, subsys_section) ! check since they should be REALLY unique.. anyway.. DO ii = 1, natom r1 = atom_info%r(1:3, ii) - DO jj = ii+1, natom + DO jj = ii + 1, natom r2 = atom_info%r(1:3, jj) - r = pbc(r1-r2, cell) + r = pbc(r1 - r2, cell) ! SQRT(DOT_PRODUCT(r, r)) >= threshold check = (DOT_PRODUCT(r, r) >= threshold2) CPASSERT(check) @@ -256,18 +256,18 @@ SUBROUTINE read_coordinate_xtl(topology, para_env, subsys_section) isym = 0 natom_orig = natom DO WHILE (found) - isym = isym+1 - icol = INDEX(parser%input_line, "SYM MAT")+8 + isym = isym + 1 + icol = INDEX(parser%input_line, "SYM MAT") + 8 READ (parser%input_line(icol:), *) ((rot_mat(ii, jj), jj=1, 3), ii=1, 3), transl_vec(1:3) Loop_over_unique_atoms: DO ii = 1, natom_orig ! Rotate and apply translation CALL matvec_3x3(r1, rot_mat, atom_info%r(1:3, ii)) - r1 = r1+transl_vec + r1 = r1 + transl_vec ! Verify if this atom is really unique.. check = .TRUE. DO jj = 1, natom r2 = atom_info%r(1:3, jj) - r = pbc(r1-r2, cell) + r = pbc(r1 - r2, cell) ! SQRT(DOT_PRODUCT(r, r)) <= threshold IF (DOT_PRODUCT(r, r) <= threshold2) THEN check = .FALSE. @@ -276,7 +276,7 @@ SUBROUTINE read_coordinate_xtl(topology, para_env, subsys_section) END DO ! If the atom generated is unique let's add to the atom set.. IF (check) THEN - natom = natom+1 + natom = natom + 1 ! Resize in case needed IF (natom > SIZE(atom_info%id_molname)) THEN newsize = INT(pfactor*natom) diff --git a/src/topology_xyz.F b/src/topology_xyz.F index 4c7d70b63f..e511b7c032 100644 --- a/src/topology_xyz.F +++ b/src/topology_xyz.F @@ -88,7 +88,7 @@ SUBROUTINE read_coordinate_xyz(topology, para_env, subsys_section) Frames: DO ! Atom numbers CALL parser_get_object(parser, natom) - frame = frame+1 + frame = frame + 1 IF (frame == 1) THEN CALL reallocate(atom_info%id_molname, 1, natom) CALL reallocate(atom_info%id_resname, 1, natom) diff --git a/src/transport.F b/src/transport.F index 9b4e78dbd5..868e310f96 100644 --- a/src/transport.F +++ b/src/transport.F @@ -265,15 +265,15 @@ SUBROUTINE transport_init_read_input(input, transport_env) IF (contact_natoms .LE. 0) CPABORT("Number of atoms in contact region needs to be defined.") - transport_env%contacts_data((i-1)*stride_contacts+1) = contact_bandwidth - transport_env%contacts_data((i-1)*stride_contacts+2) = contact_start-1 ! C indexing - transport_env%contacts_data((i-1)*stride_contacts+3) = contact_natoms - transport_env%contacts_data((i-1)*stride_contacts+4) = contact_injsign + transport_env%contacts_data((i - 1)*stride_contacts + 1) = contact_bandwidth + transport_env%contacts_data((i - 1)*stride_contacts + 2) = contact_start - 1 ! C indexing + transport_env%contacts_data((i - 1)*stride_contacts + 3) = contact_natoms + transport_env%contacts_data((i - 1)*stride_contacts + 4) = contact_injsign IF (injecting_contact) THEN - transport_env%contacts_data((i-1)*stride_contacts+5) = 1 + transport_env%contacts_data((i - 1)*stride_contacts + 5) = 1 ELSE - transport_env%contacts_data((i-1)*stride_contacts+5) = 0 + transport_env%contacts_data((i - 1)*stride_contacts + 5) = 0 END IF END DO transport_env%params%contacts_data = C_LOC(transport_env%contacts_data(1)) @@ -501,14 +501,14 @@ SUBROUTINE convert_dbcsr_to_csr_interop(dbcsr_mat, csr_mat, csr_interop_mat) csr_interop_mat%nzvals_local = C_LOC(nzvals_local(1)) END IF - ALLOCATE (nrows_local_all(0:num_pe-1), first_row_all(0:num_pe-1)) + ALLOCATE (nrows_local_all(0:num_pe - 1), first_row_all(0:num_pe - 1)) CALL mp_allgather(csr_mat%nrows_local, nrows_local_all, mp_group) CALL cumsum_i(nrows_local_all, first_row_all) IF (mepos .EQ. 0) THEN csr_interop_mat%first_row = 0 ELSE - csr_interop_mat%first_row = first_row_all(mepos-1) + csr_interop_mat%first_row = first_row_all(mepos - 1) END IF csr_interop_mat%nrows_total = csr_mat%nrows_total csr_interop_mat%ncols_total = csr_mat%ncols_total @@ -536,7 +536,7 @@ SUBROUTINE cumsum_i(arr, cumsum) cumsum(1) = arr(1) DO i = 2, SIZE(arr) - cumsum(i) = cumsum(i-1)+arr(i) + cumsum(i) = cumsum(i - 1) + arr(i) END DO END SUBROUTINE cumsum_i diff --git a/src/transport_env_types.F b/src/transport_env_types.F index 8c4b77a2c3..ca83d818a3 100644 --- a/src/transport_env_types.F +++ b/src/transport_env_types.F @@ -244,7 +244,7 @@ SUBROUTINE csr_interop_matrix_get_info(csr_interop_mat, & IF (PRESENT(data_type)) data_type = csr_interop_mat%data_type IF (PRESENT(first_row)) first_row = csr_interop_mat%first_row - IF (PRESENT(rowptr_local)) CALL C_F_POINTER(csr_interop_mat%rowptr_local, rowptr_local, [nrows_local+1]) + IF (PRESENT(rowptr_local)) CALL C_F_POINTER(csr_interop_mat%rowptr_local, rowptr_local, [nrows_local + 1]) IF (PRESENT(colind_local)) CALL C_F_POINTER(csr_interop_mat%colind_local, colind_local, [nze_local]) IF (PRESENT(nzerow_local)) CALL C_F_POINTER(csr_interop_mat%nzerow_local, nzerow_local, [nrows_local]) IF (PRESENT(nzvals_local)) CALL C_F_POINTER(csr_interop_mat%nzvals_local, nzvals_local, [nze_local]) diff --git a/src/virial_methods.F b/src/virial_methods.F index 3606866b16..d87f1bdf2d 100644 --- a/src/virial_methods.F +++ b/src/virial_methods.F @@ -103,7 +103,7 @@ SUBROUTINE virial_evaluate(atomic_kind_set, particle_set, local_particles, & nparticle_local = local_particles%n_el(iparticle_kind) DO iparticle_local = 1, nparticle_local iparticle = local_particles%list(iparticle_kind)%array(iparticle_local) - virial%pv_kinetic(i, j) = virial%pv_kinetic(i, j)+ & + virial%pv_kinetic(i, j) = virial%pv_kinetic(i, j) + & mass*particle_set(iparticle)%v(i)*particle_set(iparticle)%v(j) END DO END DO @@ -114,7 +114,7 @@ SUBROUTINE virial_evaluate(atomic_kind_set, particle_set, local_particles, & CALL mp_sum(virial%pv_kinetic, igroup) ! total virial - virial%pv_total = virial%pv_virial+virial%pv_kinetic+virial%pv_constraint + virial%pv_total = virial%pv_virial + virial%pv_kinetic + virial%pv_constraint CALL timestop(handle) ENDIF @@ -145,7 +145,7 @@ PURE SUBROUTINE virial_pair_force(pv_virial, f0, force, rab) DO i = 1, 3 DO j = 1, 3 - pv_virial(i, j) = pv_virial(i, j)+f0*force(i)*rab(j) + pv_virial(i, j) = pv_virial(i, j) + f0*force(i)*rab(j) END DO END DO @@ -170,34 +170,34 @@ SUBROUTINE write_stress_components(virial, iounit) WRITE (UNIT=iounit, FMT="(T42,A,T64,A)") " 1/3 Trace", " Determinant" pv = virial%pv_ekin WRITE (UNIT=iounit, FMT="(T4,A,T42,F16.8,T64,F16.8)") "Kinetic Energy Stress", & - (pv(1, 1)+pv(2, 2)+pv(3, 3))/3.0_dp, det_3x3(pv) + (pv(1, 1) + pv(2, 2) + pv(3, 3))/3.0_dp, det_3x3(pv) pv = virial%pv_overlap WRITE (UNIT=iounit, FMT="(T4,A,T42,F16.8,T64,F16.8)") "Basis Overlap Stress", & - (pv(1, 1)+pv(2, 2)+pv(3, 3))/3.0_dp, det_3x3(pv) - pv = virial%pv_hartree+virial%pv_exc + (pv(1, 1) + pv(2, 2) + pv(3, 3))/3.0_dp, det_3x3(pv) + pv = virial%pv_hartree + virial%pv_exc WRITE (UNIT=iounit, FMT="(T4,A,T42,F16.8,T64,F16.8)") "ES + XC Stress", & - (pv(1, 1)+pv(2, 2)+pv(3, 3))/3.0_dp, det_3x3(pv) + (pv(1, 1) + pv(2, 2) + pv(3, 3))/3.0_dp, det_3x3(pv) pv = virial%pv_vdw WRITE (UNIT=iounit, FMT="(T4,A,T42,F16.8,T64,F16.8)") "vdW correction (ff) Stress", & - (pv(1, 1)+pv(2, 2)+pv(3, 3))/3.0_dp, det_3x3(pv) + (pv(1, 1) + pv(2, 2) + pv(3, 3))/3.0_dp, det_3x3(pv) pv = virial%pv_ppl WRITE (UNIT=iounit, FMT="(T4,A,T42,F16.8,T64,F16.8)") "Local Pseudopotential/Core Stress", & - (pv(1, 1)+pv(2, 2)+pv(3, 3))/3.0_dp, det_3x3(pv) + (pv(1, 1) + pv(2, 2) + pv(3, 3))/3.0_dp, det_3x3(pv) pv = virial%pv_ppnl WRITE (UNIT=iounit, FMT="(T4,A,T42,F16.8,T64,F16.8)") "Nonlocal Pseudopotential Stress", & - (pv(1, 1)+pv(2, 2)+pv(3, 3))/3.0_dp, det_3x3(pv) + (pv(1, 1) + pv(2, 2) + pv(3, 3))/3.0_dp, det_3x3(pv) pv = -virial%pv_fock_4c WRITE (UNIT=iounit, FMT="(T4,A,T42,F16.8,T64,F16.8)") "Exact Exchange Stress", & - (pv(1, 1)+pv(2, 2)+pv(3, 3))/3.0_dp, det_3x3(pv) + (pv(1, 1) + pv(2, 2) + pv(3, 3))/3.0_dp, det_3x3(pv) ! - pv = virial%pv_ekin+virial%pv_overlap+virial%pv_hartree+virial%pv_exc+virial%pv_vdw+ & - virial%pv_ppl+virial%pv_ppnl-virial%pv_fock_4c + pv = virial%pv_ekin + virial%pv_overlap + virial%pv_hartree + virial%pv_exc + virial%pv_vdw + & + virial%pv_ppl + virial%pv_ppnl - virial%pv_fock_4c WRITE (UNIT=iounit, FMT="(T4,A,T42,F16.8,T64,F16.8)") "Sum of Parts Stress", & - (pv(1, 1)+pv(2, 2)+pv(3, 3))/3.0_dp, det_3x3(pv) + (pv(1, 1) + pv(2, 2) + pv(3, 3))/3.0_dp, det_3x3(pv) ! pv = virial%pv_virial WRITE (UNIT=iounit, FMT="(T4,A,T42,F16.8,T64,F16.8)") "Total Stress", & - (pv(1, 1)+pv(2, 2)+pv(3, 3))/3.0_dp, det_3x3(pv) + (pv(1, 1) + pv(2, 2) + pv(3, 3))/3.0_dp, det_3x3(pv) WRITE (UNIT=iounit, FMT="(T3,A)") REPEAT("=", 78) END SUBROUTINE write_stress_components diff --git a/src/wannier90.F b/src/wannier90.F index b4d3b4052c..a2a55d0ebd 100644 --- a/src/wannier90.F +++ b/src/wannier90.F @@ -108,7 +108,7 @@ MODULE wannier90 INTEGER, PARAMETER :: num_nnmax = 12 INTEGER, PARAMETER :: nsupcell = 5 - INTEGER :: lmn(3, (2*nsupcell+1)**3) + INTEGER :: lmn(3, (2*nsupcell + 1)**3) REAL(kind=dp), PARAMETER :: eps5 = 1.0e-5_dp REAL(kind=dp), PARAMETER :: eps6 = 1.0e-6_dp @@ -174,9 +174,9 @@ SUBROUTINE wannier_setup(mp_grid_loc, num_kpts_loc, & num_shells = 0 ALLOCATE (shell_list(max_shells)) - cell_volume = real_lattice(1, 1)*(real_lattice(2, 2)*real_lattice(3, 3)-real_lattice(3, 2)*real_lattice(2, 3))+ & - real_lattice(1, 2)*(real_lattice(2, 3)*real_lattice(3, 1)-real_lattice(3, 3)*real_lattice(2, 1))+ & - real_lattice(1, 3)*(real_lattice(2, 1)*real_lattice(3, 2)-real_lattice(3, 1)*real_lattice(2, 2)) + cell_volume = real_lattice(1, 1)*(real_lattice(2, 2)*real_lattice(3, 3) - real_lattice(3, 2)*real_lattice(2, 3)) + & + real_lattice(1, 2)*(real_lattice(2, 3)*real_lattice(3, 1) - real_lattice(3, 3)*real_lattice(2, 1)) + & + real_lattice(1, 3)*(real_lattice(2, 1)*real_lattice(3, 2) - real_lattice(3, 1)*real_lattice(2, 2)) iprint = 1 search_shells = 12 kmesh_tol = 0.000001_dp @@ -366,25 +366,25 @@ SUBROUTINE w90_kmesh_get() ndnntot = 0 DO nlist = 1, search_shells DO nkp = 1, num_kpts - DO loop = 1, (2*nsupcell+1)**3 + DO loop = 1, (2*nsupcell + 1)**3 l = lmn(1, loop); m = lmn(2, loop); n = lmn(3, loop) ! - vkpp = kpt_cart(:, nkp)+MATMUL(lmn(:, loop), recip_lattice) - dist = SQRT((kpt_cart(1, 1)-vkpp(1))**2 & - +(kpt_cart(2, 1)-vkpp(2))**2+(kpt_cart(3, 1)-vkpp(3))**2) + vkpp = kpt_cart(:, nkp) + MATMUL(lmn(:, loop), recip_lattice) + dist = SQRT((kpt_cart(1, 1) - vkpp(1))**2 & + + (kpt_cart(2, 1) - vkpp(2))**2 + (kpt_cart(3, 1) - vkpp(3))**2) ! - IF ((dist .GT. kmesh_tol) .AND. (dist .GT. dnn0+kmesh_tol)) THEN - IF (dist .LT. dnn1-kmesh_tol) THEN + IF ((dist .GT. kmesh_tol) .AND. (dist .GT. dnn0 + kmesh_tol)) THEN + IF (dist .LT. dnn1 - kmesh_tol) THEN dnn1 = dist ! found a closer shell counter = 0 END IF - IF (dist .GT. (dnn1-kmesh_tol) .AND. dist .LT. (dnn1+kmesh_tol)) THEN - counter = counter+1 ! count the multiplicity of the shell + IF (dist .GT. (dnn1 - kmesh_tol) .AND. dist .LT. (dnn1 + kmesh_tol)) THEN + counter = counter + 1 ! count the multiplicity of the shell END IF END IF ENDDO ENDDO - IF (dnn1 .LT. eta-kmesh_tol) ndnntot = ndnntot+1 + IF (dnn1 .LT. eta - kmesh_tol) ndnntot = ndnntot + 1 dnn(nlist) = dnn1 multi(nlist) = counter dnn0 = dnn1 @@ -412,14 +412,14 @@ SUBROUTINE w90_kmesh_get() WRITE (stdout, '(i3,",")', advance='no') shell_list(ndnn) ENDIF ENDDO - DO l = 1, 11-num_shells + DO l = 1, 11 - num_shells WRITE (stdout, '(4x)', advance='no') ENDDO WRITE (stdout, '("|")') nntot = 0 DO loop_s = 1, num_shells - nntot = nntot+multi(shell_list(loop_s)) + nntot = nntot + multi(shell_list(loop_s)) END DO IF (nntot > num_nnmax) THEN WRITE (stdout, '(a,i2,a)') ' **WARNING: kmesh has found >', num_nnmax, ' nearest neighbours**' @@ -433,7 +433,7 @@ SUBROUTINE w90_kmesh_get() DO shell = 1, search_shells CALL kmesh_get_bvectors(multi(shell), 1, dnn(shell), bvec_tmp(:, 1:multi(shell))) DO loop = 1, multi(shell) - counter = counter+1 + counter = counter + 1 WRITE (stdout, '(a,I4,1x,a,2x,3f12.6,2x,a,2x,f12.6,a)') ' | b-vector ', counter, ': (', & bvec_tmp(:, loop)/lenconfac, ')', dnn(shell)/lenconfac, ' |' END DO @@ -454,7 +454,7 @@ SUBROUTINE w90_kmesh_get() nnx = 0 DO loop_s = 1, num_shells DO loop_b = 1, multi(shell_list(loop_s)) - nnx = nnx+1 + nnx = nnx + 1 wb_local(nnx) = bweight(loop_s) END DO END DO @@ -477,21 +477,21 @@ SUBROUTINE w90_kmesh_get() nnx = 0 ok: DO ndnnx = 1, num_shells ndnn = shell_list(ndnnx) - DO loop = 1, (2*nsupcell+1)**3 + DO loop = 1, (2*nsupcell + 1)**3 l = lmn(1, loop); m = lmn(2, loop); n = lmn(3, loop) vkpp2 = MATMUL(lmn(:, loop), recip_lattice) DO nkp2 = 1, num_kpts - vkpp = vkpp2+kpt_cart(:, nkp2) - dist = SQRT((kpt_cart(1, nkp)-vkpp(1))**2 & - +(kpt_cart(2, nkp)-vkpp(2))**2+(kpt_cart(3, nkp)-vkpp(3))**2) - IF ((dist .GE. dnn(ndnn)*(1-kmesh_tol)) .AND. (dist .LE. dnn(ndnn)*(1+kmesh_tol))) THEN - nnx = nnx+1 - nnshell(nkp, ndnn) = nnshell(nkp, ndnn)+1 + vkpp = vkpp2 + kpt_cart(:, nkp2) + dist = SQRT((kpt_cart(1, nkp) - vkpp(1))**2 & + + (kpt_cart(2, nkp) - vkpp(2))**2 + (kpt_cart(3, nkp) - vkpp(3))**2) + IF ((dist .GE. dnn(ndnn)*(1 - kmesh_tol)) .AND. (dist .LE. dnn(ndnn)*(1 + kmesh_tol))) THEN + nnx = nnx + 1 + nnshell(nkp, ndnn) = nnshell(nkp, ndnn) + 1 nnlist(nkp, nnx) = nkp2 nncell(1, nkp, nnx) = l nncell(2, nkp, nnx) = m nncell(3, nkp, nnx) = n - bk_local(:, nnx, nkp) = vkpp(:)-kpt_cart(:, nkp) + bk_local(:, nnx, nkp) = vkpp(:) - kpt_cart(:, nkp) ENDIF !if we have the right number of neighbours we can exit IF (nnshell(nkp, ndnn) == multi(ndnn)) CYCLE ok @@ -515,12 +515,12 @@ SUBROUTINE w90_kmesh_get() DO nnsh = 1, nnshell(nkp, ndnn) bb1 = 0.0_dp bbn = 0.0_dp - nnx = nnx+1 + nnx = nnx + 1 DO i = 1, 3 - bb1 = bb1+bk_local(i, nnx, 1)*bk_local(i, nnx, 1) - bbn = bbn+bk_local(i, nnx, nkp)*bk_local(i, nnx, nkp) + bb1 = bb1 + bk_local(i, nnx, 1)*bk_local(i, nnx, 1) + bbn = bbn + bk_local(i, nnx, nkp)*bk_local(i, nnx, nkp) ENDDO - IF (ABS(SQRT(bb1)-SQRT(bbn)) .GT. kmesh_tol) THEN + IF (ABS(SQRT(bb1) - SQRT(bbn)) .GT. kmesh_tol) THEN WRITE (stdout, '(1x,2f10.6)') bb1, bbn CPABORT('Non-symmetric k-point neighbours!') ENDIF @@ -540,11 +540,11 @@ SUBROUTINE w90_kmesh_get() DO ndnnx = 1, num_shells ndnn = shell_list(ndnnx) DO nnsh = 1, nnshell(1, ndnn) - nnx = nnx+1 - ddelta = ddelta+wb_local(nnx)*bk_local(i, nnx, nkp)*bk_local(j, nnx, nkp) + nnx = nnx + 1 + ddelta = ddelta + wb_local(nnx)*bk_local(i, nnx, nkp)*bk_local(j, nnx, nkp) ENDDO ENDDO - IF ((i .EQ. j) .AND. (ABS(ddelta-1.0_dp) .GT. kmesh_tol)) THEN + IF ((i .EQ. j) .AND. (ABS(ddelta - 1.0_dp) .GT. kmesh_tol)) THEN WRITE (stdout, '(1x,2i3,f12.8)') i, j, ddelta CPABORT('Eq. (B1) not satisfied in kmesh_get (1)') ENDIF @@ -565,8 +565,8 @@ SUBROUTINE w90_kmesh_get() DO ndnnx = 1, num_shells ndnn = shell_list(ndnnx) DO nnsh = 1, nnshell(1, ndnn) - nnx = nnx+1 - wbtot = wbtot+wb_local(nnx) + nnx = nnx + 1 + wbtot = wbtot + wb_local(nnx) ENDDO ENDDO @@ -584,7 +584,7 @@ SUBROUTINE w90_kmesh_get() ENDIF IF (ifound .EQ. 0) THEN ! found new vector to add to set - na = na+1 + na = na + 1 bka(1, na) = bk_local(1, nn, 1) bka(2, na) = bk_local(2, nn, 1) bka(3, na) = bk_local(3, nn, 1) @@ -655,10 +655,10 @@ SUBROUTINE w90_kmesh_supercell_sort ! ! !==================================================================! INTEGER :: counter, indx(1), l, & - lmn_cp(3, (2*nsupcell+1)**3), loop, m, & - n - REAL(kind=dp) :: dist((2*nsupcell+1)**3), & - dist_cp((2*nsupcell+1)**3), pos(3) + lmn_cp(3, (2*nsupcell + 1)**3), loop, & + m, n + REAL(kind=dp) :: dist((2*nsupcell + 1)**3), & + dist_cp((2*nsupcell + 1)**3), pos(3) counter = 1 lmn(:, counter) = 0 @@ -667,7 +667,7 @@ SUBROUTINE w90_kmesh_supercell_sort DO m = -nsupcell, nsupcell DO n = -nsupcell, nsupcell IF (l == 0 .AND. m == 0 .AND. n == 0) CYCLE - counter = counter+1 + counter = counter + 1 lmn(1, counter) = l; lmn(2, counter) = m; lmn(3, counter) = n pos = MATMUL(lmn(:, counter), recip_lattice) dist(counter) = SQRT(DOT_PRODUCT(pos, pos)) @@ -675,7 +675,7 @@ SUBROUTINE w90_kmesh_supercell_sort END DO END DO - DO loop = (2*nsupcell+1)**3, 1, -1 + DO loop = (2*nsupcell + 1)**3, 1, -1 indx = internal_maxloc(dist) dist_cp(loop) = dist(indx(1)) lmn_cp(:, loop) = lmn(:, indx(1)) @@ -699,11 +699,11 @@ FUNCTION internal_maxloc(dist) ! ! !=========================================================================! - REAL(kind=dp), INTENT(in) :: dist((2*nsupcell+1)**3) + REAL(kind=dp), INTENT(in) :: dist((2*nsupcell + 1)**3) INTEGER :: internal_maxloc INTEGER :: counter, guess(1), & - list((2*nsupcell+1)**3), loop + list((2*nsupcell + 1)**3), loop list = 0 counter = 1 @@ -711,10 +711,10 @@ FUNCTION internal_maxloc(dist) guess = MAXLOC(dist) list(1) = guess(1) ! look for any degenerate values - DO loop = 1, (2*nsupcell+1)**3 + DO loop = 1, (2*nsupcell + 1)**3 IF (loop == guess(1)) CYCLE - IF (ABS(dist(loop)-dist(guess(1))) < eps8) THEN - counter = counter+1 + IF (ABS(dist(loop) - dist(guess(1))) < eps8) THEN + counter = counter + 1 list(counter) = loop ENDIF END DO @@ -762,7 +762,7 @@ SUBROUTINE kmesh_shell_automatic(multi, dnn, bweight) b1sat = .FALSE. DO shell = 1, search_shells - cur_shell = num_shells+1 + cur_shell = num_shells + 1 ! get the b vectors for the new shell CALL kmesh_get_bvectors(multi(shell), 1, dnn(shell), bvector(:, 1:multi(shell), cur_shell)) @@ -776,7 +776,7 @@ SUBROUTINE kmesh_shell_automatic(multi, dnn, bweight) delta = DOT_PRODUCT(bvector(:, loop_bn, cur_shell), bvector(:, loop_b, loop_s))/ & SQRT(DOT_PRODUCT(bvector(:, loop_bn, cur_shell), bvector(:, loop_bn, cur_shell))* & DOT_PRODUCT(bvector(:, loop_b, loop_s), bvector(:, loop_b, loop_s))) - IF (ABS(ABS(delta)-1.0_dp) < eps6) lpar = .TRUE. + IF (ABS(ABS(delta) - 1.0_dp) < eps6) lpar = .TRUE. END DO END DO END DO @@ -789,7 +789,7 @@ SUBROUTINE kmesh_shell_automatic(multi, dnn, bweight) CYCLE END IF - num_shells = num_shells+1 + num_shells = num_shells + 1 shell_list(num_shells) = shell ALLOCATE (amat(max_shells, num_shells)) @@ -802,12 +802,12 @@ SUBROUTINE kmesh_shell_automatic(multi, dnn, bweight) amat = 0.0_dp DO loop_s = 1, num_shells DO loop_b = 1, multi(shell_list(loop_s)) - amat(1, loop_s) = amat(1, loop_s)+bvector(1, loop_b, loop_s)*bvector(1, loop_b, loop_s) - amat(2, loop_s) = amat(2, loop_s)+bvector(2, loop_b, loop_s)*bvector(2, loop_b, loop_s) - amat(3, loop_s) = amat(3, loop_s)+bvector(3, loop_b, loop_s)*bvector(3, loop_b, loop_s) - amat(4, loop_s) = amat(4, loop_s)+bvector(1, loop_b, loop_s)*bvector(2, loop_b, loop_s) - amat(5, loop_s) = amat(5, loop_s)+bvector(2, loop_b, loop_s)*bvector(3, loop_b, loop_s) - amat(6, loop_s) = amat(6, loop_s)+bvector(3, loop_b, loop_s)*bvector(1, loop_b, loop_s) + amat(1, loop_s) = amat(1, loop_s) + bvector(1, loop_b, loop_s)*bvector(1, loop_b, loop_s) + amat(2, loop_s) = amat(2, loop_s) + bvector(2, loop_b, loop_s)*bvector(2, loop_b, loop_s) + amat(3, loop_s) = amat(3, loop_s) + bvector(3, loop_b, loop_s)*bvector(3, loop_b, loop_s) + amat(4, loop_s) = amat(4, loop_s) + bvector(1, loop_b, loop_s)*bvector(2, loop_b, loop_s) + amat(5, loop_s) = amat(5, loop_s) + bvector(2, loop_b, loop_s)*bvector(3, loop_b, loop_s) + amat(6, loop_s) = amat(6, loop_s) + bvector(3, loop_b, loop_s)*bvector(1, loop_b, loop_s) END DO END DO @@ -828,7 +828,7 @@ SUBROUTINE kmesh_shell_automatic(multi, dnn, bweight) ELSE WRITE (stdout, '(1x,a)') '| SVD found small singular value, Rejecting this shell and trying the next |' b1sat = .FALSE. - num_shells = num_shells-1 + num_shells = num_shells - 1 DEALLOCATE (amat, umat, vmat, smat, singv) CYCLE END IF @@ -854,11 +854,11 @@ SUBROUTINE kmesh_shell_automatic(multi, dnn, bweight) delta = 0.0_dp DO loop_s = 1, num_shells DO loop_b = 1, multi(shell_list(loop_s)) - delta = delta+bweight(loop_s)*bvector(loop_i, loop_b, loop_s)*bvector(loop_j, loop_b, loop_s) + delta = delta + bweight(loop_s)*bvector(loop_i, loop_b, loop_s)*bvector(loop_j, loop_b, loop_s) END DO END DO IF (loop_i == loop_j) THEN - IF (ABS(delta-1.0_dp) > kmesh_tol) b1sat = .FALSE. + IF (ABS(delta - 1.0_dp) > kmesh_tol) b1sat = .FALSE. END IF IF (loop_i /= loop_j) THEN IF (ABS(delta) > kmesh_tol) b1sat = .FALSE. @@ -920,15 +920,15 @@ SUBROUTINE kmesh_get_bvectors(multi, kpt, shell_dist, bvector) bvector = 0.0_dp num_bvec = 0 - ok: DO loop = 1, (2*nsupcell+1)**3 + ok: DO loop = 1, (2*nsupcell + 1)**3 vkpp2 = MATMUL(lmn(:, loop), recip_lattice) DO nkp2 = 1, num_kpts - vkpp = vkpp2+kpt_cart(:, nkp2) - dist = SQRT((kpt_cart(1, kpt)-vkpp(1))**2 & - +(kpt_cart(2, kpt)-vkpp(2))**2+(kpt_cart(3, kpt)-vkpp(3))**2) - IF ((dist .GE. shell_dist*(1.0_dp-kmesh_tol)) .AND. dist .LE. shell_dist*(1.0_dp+kmesh_tol)) THEN - num_bvec = num_bvec+1 - bvector(:, num_bvec) = vkpp(:)-kpt_cart(:, kpt) + vkpp = vkpp2 + kpt_cart(:, nkp2) + dist = SQRT((kpt_cart(1, kpt) - vkpp(1))**2 & + + (kpt_cart(2, kpt) - vkpp(2))**2 + (kpt_cart(3, kpt) - vkpp(3))**2) + IF ((dist .GE. shell_dist*(1.0_dp - kmesh_tol)) .AND. dist .LE. shell_dist*(1.0_dp + kmesh_tol)) THEN + num_bvec = num_bvec + 1 + bvector(:, num_bvec) = vkpp(:) - kpt_cart(:, kpt) ENDIF !if we have the right number of neighbours we can exit IF (num_bvec == multi) CYCLE ok @@ -950,8 +950,8 @@ PURE SUBROUTINE utility_compar(a, b, ispos, isneg) REAL(kind=dp), DIMENSION(3), INTENT(in) :: a, b LOGICAL, INTENT(out) :: ispos, isneg - ispos = SUM((a-b)**2) .LT. eps8 - isneg = SUM((a+b)**2) .LT. eps8 + ispos = SUM((a - b)**2) .LT. eps8 + isneg = SUM((a + b)**2) .LT. eps8 END SUBROUTINE utility_compar ! ************************************************************************************************** diff --git a/src/xas_control.F b/src/xas_control.F index 7b6bb67836..cd3456c89c 100644 --- a/src/xas_control.F +++ b/src/xas_control.F @@ -144,12 +144,12 @@ SUBROUTINE read_xas_control(xas_control, xas_section) i_rep_val=ir, i_vals=list) IF (ASSOCIATED(list)) THEN - CALL reallocate(xas_control%exc_atoms, 1, nex_at+SIZE(list)) + CALL reallocate(xas_control%exc_atoms, 1, nex_at + SIZE(list)) DO i = 1, SIZE(list) - xas_control%exc_atoms(i+nex_at) = list(i) + xas_control%exc_atoms(i + nex_at) = list(i) END DO - xas_control%nexc_atoms = nex_at+SIZE(list) - nex_at = nex_at+SIZE(list) + xas_control%nexc_atoms = nex_at + SIZE(list) + nex_at = nex_at + SIZE(list) END IF END DO ! ir END IF @@ -186,11 +186,11 @@ SUBROUTINE read_xas_control(xas_control, xas_section) i_rep_val=ir, i_vals=list) IF (ASSOCIATED(list)) THEN - CALL reallocate(xas_control%orbital_list, 1, nex_st+SIZE(list)) + CALL reallocate(xas_control%orbital_list, 1, nex_st + SIZE(list)) DO i = 1, SIZE(list) - xas_control%orbital_list(i+nex_st) = list(i) + xas_control%orbital_list(i + nex_st) = list(i) END DO - nex_st = nex_st+SIZE(list) + nex_st = nex_st + SIZE(list) END IF END DO ! ir ELSE @@ -313,7 +313,7 @@ SUBROUTINE xas_control_release(xas_control) IF (ASSOCIATED(xas_control)) THEN CPASSERT(xas_control%ref_count > 0) - xas_control%ref_count = xas_control%ref_count-1 + xas_control%ref_count = xas_control%ref_count - 1 IF (xas_control%ref_count == 0) THEN IF (ASSOCIATED(xas_control%exc_atoms)) THEN DEALLOCATE (xas_control%exc_atoms) @@ -341,7 +341,7 @@ SUBROUTINE xas_control_retain(xas_control) routineP = moduleN//':'//routineN CPASSERT(ASSOCIATED(xas_control)) - xas_control%ref_count = xas_control%ref_count+1 + xas_control%ref_count = xas_control%ref_count + 1 END SUBROUTINE xas_control_retain diff --git a/src/xas_env_types.F b/src/xas_env_types.F index 6b66d51c31..2ddbcd2076 100644 --- a/src/xas_env_types.F +++ b/src/xas_env_types.F @@ -351,7 +351,7 @@ SUBROUTINE xas_env_release(xas_env) IF (ASSOCIATED(xas_env)) THEN CPASSERT(xas_env%ref_count > 0) - xas_env%ref_count = xas_env%ref_count-1 + xas_env%ref_count = xas_env%ref_count - 1 IF (xas_env%ref_count == 0) THEN DEALLOCATE (xas_env%state_of_atom, xas_env%atom_of_state) @@ -441,7 +441,7 @@ SUBROUTINE xas_env_retain(xas_env) CPASSERT(ASSOCIATED(xas_env)) CPASSERT(xas_env%ref_count > 0) - xas_env%ref_count = xas_env%ref_count+1 + xas_env%ref_count = xas_env%ref_count + 1 END SUBROUTINE xas_env_retain END MODULE xas_env_types diff --git a/src/xas_methods.F b/src/xas_methods.F index 6abc39a66b..51695ab0ae 100644 --- a/src/xas_methods.F +++ b/src/xas_methods.F @@ -424,7 +424,7 @@ SUBROUTINE xas(qs_env, dft_control) ! Take the state_to_be_excited vector from the full set and copy into excvec_coeff CALL get_mo_set(mos(my_spin)%mo_set, nmo=nmo) CALL get_xas_env(xas_env, occ_estate=occ_estate, xas_nelectron=xas_nelectron) - tmp = xas_nelectron+1.0_dp-occ_estate + tmp = xas_nelectron + 1.0_dp - occ_estate IF (nmo < tmp) & CPABORT("CLS: the required method needs added_mos to the ground state") ! If the restart file for this atom exists, the mos and the @@ -656,7 +656,7 @@ SUBROUTINE xas_env_init(xas_env, qs_env, dft_section, logger) IF (nexc_search < 0) THEN ! ground state occupation CALL get_mo_set(mos(my_spin)%mo_set, nmo=nmo, lfomo=lfomo) - nexc_search = lfomo-1 + nexc_search = lfomo - 1 END IF nexc_atoms = xas_control%nexc_atoms ALLOCATE (xas_env%exc_atoms(nexc_atoms)) @@ -671,11 +671,11 @@ SUBROUTINE xas_env_init(xas_env, qs_env, dft_section, logger) nvirtual2 = 0 IF (xas_control%added_mos .GT. 0) THEN - nvirtual2 = MIN(xas_control%added_mos, nao-nmo) + nvirtual2 = MIN(xas_control%added_mos, nao - nmo) xas_env%unoccupied_eps = xas_control%eps_added xas_env%unoccupied_max_iter = xas_control%max_iter_added END IF - nvirtual = nmo+nvirtual2 + nvirtual = nmo + nvirtual2 n_mo(1:2) = nmo @@ -708,7 +708,7 @@ SUBROUTINE xas_env_init(xas_env, qs_env, dft_section, logger) ! initialize operators for the calculation of the oscillator strengths IF (xas_control%xas_method == xas_tp_hh) THEN occ_estate = 0.5_dp - nele = REAL(nelectron, dp)-0.5_dp + nele = REAL(nelectron, dp) - 0.5_dp occ_homo = 1.0_dp occ_homo_plus = 0._dp ELSEIF (xas_control%xas_method == xas_tp_xhh) THEN @@ -718,7 +718,7 @@ SUBROUTINE xas_env_init(xas_env, qs_env, dft_section, logger) occ_homo_plus = 0.5_dp ELSEIF (xas_control%xas_method == xas_tp_fh) THEN occ_estate = 0.0_dp - nele = REAL(nelectron, dp)-1.0_dp + nele = REAL(nelectron, dp) - 1.0_dp occ_homo = 1.0_dp occ_homo_plus = 0._dp ELSEIF (xas_control%xas_method == xas_tp_xfh) THEN @@ -728,7 +728,7 @@ SUBROUTINE xas_env_init(xas_env, qs_env, dft_section, logger) occ_homo_plus = 1._dp ELSEIF (xas_control%xas_method == xes_tp_val) THEN occ_estate = xas_control%xes_core_occupation - nele = REAL(nelectron, dp)-xas_control%xes_core_occupation + nele = REAL(nelectron, dp) - xas_control%xes_core_occupation occ_homo = xas_control%xes_homo_occupation ELSEIF (xas_control%xas_method == xas_dscf) THEN occ_estate = 0.0_dp @@ -738,7 +738,7 @@ SUBROUTINE xas_env_init(xas_env, qs_env, dft_section, logger) ELSEIF (xas_control%xas_method == xas_tp_flex) THEN nele = REAL(xas_control%nel_tot, dp) occ_estate = REAL(xas_control%xas_core_occupation, dp) - IF (nele < 0.0_dp) nele = REAL(nelectron, dp)-(1.0_dp-occ_estate) + IF (nele < 0.0_dp) nele = REAL(nelectron, dp) - (1.0_dp - occ_estate) occ_homo = 1.0_dp ENDIF CALL set_xas_env(xas_env=xas_env, occ_estate=occ_estate, xas_nelectron=nele, & @@ -751,12 +751,12 @@ SUBROUTINE xas_env_init(xas_env, qs_env, dft_section, logger) CALL section_vals_val_get(xas_section, & "PRINT%CLS_FUNCTION_CUBES%CUBES_LU_BOUNDS", & i_vals=bounds) - ncubes = bounds(2)-bounds(1)+1 + ncubes = bounds(2) - bounds(1) + 1 IF (ncubes > 0) THEN ALLOCATE (xas_control%list_cubes(ncubes)) DO ik = 1, ncubes - xas_control%list_cubes(ik) = bounds(1)+(ik-1) + xas_control%list_cubes(ik) = bounds(1) + (ik - 1) END DO END IF @@ -771,11 +771,11 @@ SUBROUTINE xas_env_init(xas_env, qs_env, dft_section, logger) "PRINT%CLS_FUNCTION_CUBES%CUBES_LIST", & i_rep_val=ik, i_vals=list) IF (ASSOCIATED(list)) THEN - CALL reallocate(xas_control%list_cubes, 1, ncubes+SIZE(list)) + CALL reallocate(xas_control%list_cubes, 1, ncubes + SIZE(list)) DO i = 1, SIZE(list) - xas_control%list_cubes(i+ncubes) = list(i) + xas_control%list_cubes(i + ncubes) = list(i) END DO - ncubes = ncubes+SIZE(list) + ncubes = ncubes + SIZE(list) END IF END DO ! ik END IF @@ -785,7 +785,7 @@ SUBROUTINE xas_env_init(xas_env, qs_env, dft_section, logger) ncubes = MIN(ncubes, xas_control%added_mos) ALLOCATE (xas_control%list_cubes(ncubes)) DO ik = 1, ncubes - xas_control%list_cubes(ik) = homo+ik + xas_control%list_cubes(ik) = homo + ik END DO END IF ELSE @@ -961,7 +961,7 @@ SUBROUTINE xas_env_init(xas_env, qs_env, dft_section, logger) END IF END DO IF (.NOT. ihavethis) THEN - nk = nk+1 + nk = nk + 1 kind_type_tmp(nk) = ikind kind_z_tmp(nk) = INT(zatom) xas_env%mykind_of_atom(iat) = nk @@ -974,10 +974,10 @@ SUBROUTINE xas_env_init(xas_env, qs_env, dft_section, logger) DO ik = 1, nk NULLIFY (xas_env%my_gto_basis(ik)%gto_basis_set, sto_basis_set) ne = 0 - DO l = 1, lq(1)+1 - nj = 2*(l-1)+1 + DO l = 1, lq(1) + 1 + nj = 2*(l - 1) + 1 DO i = l, nq(1) - ne(l, i) = ptable(kind_z_tmp(ik))%e_conv(l-1)-2*nj*(i-l) + ne(l, i) = ptable(kind_z_tmp(ik))%e_conv(l - 1) - 2*nj*(i - l) ne(l, i) = MAX(ne(l, i), 0) ne(l, i) = MIN(ne(l, i), 2*nj) END DO @@ -1068,7 +1068,7 @@ SUBROUTINE cls_calculate_spectrum(xas_control, xas_env, qs_env, xas_section, & ostrength_sm=ostrength_sm, nvirtual=nvirtual, spin_channel=my_spin) CALL get_mo_set(mos(my_spin)%mo_set, homo=homo, lfomo=lfomo, nmo=nmo) - nabs = nvirtual-lfomo+1 + nabs = nvirtual - lfomo + 1 ALLOCATE (sp_em(6, homo)) ALLOCATE (sp_ab(6, nabs)) CPASSERT(ASSOCIATED(excvec_coeff)) @@ -1194,7 +1194,7 @@ SUBROUTINE xas_write(sp_em, sp_ab, estate, xas_section, iatom, state_to_be_excit ", index of excited core MO is", estate, ", # of lines ", SIZE(sp_ab, 2) ene2 = 1.0_dp DO i = 1, SIZE(sp_ab, 2) - istate = lfomo-1+i + istate = lfomo - 1 + i IF (length) ene2 = sp_ab(1, i)*sp_ab(1, i) WRITE (out_sp_ab, '(I6,5F16.8,F10.5)') istate, sp_ab(1, i)*evolt, & sp_ab(2, i)*ene2, sp_ab(3, i)*ene2, & @@ -1377,20 +1377,20 @@ SUBROUTINE spectrum_dip_vel(fm_set, op_sm, mos, excvec, & CALL cp_fm_get_element(fm_set(my_spin, i)%matrix, 1, istate, dip(i)) END DO IF (istate <= homo) THEN - sp_em(1, istate) = ene_f-ene_i + sp_em(1, istate) = ene_f - ene_i sp_em(2, istate) = dip(1) sp_em(3, istate) = dip(2) sp_em(4, istate) = dip(3) - sp_em(5, istate) = dip(1)*dip(1)+dip(2)*dip(2)+dip(3)*dip(3) + sp_em(5, istate) = dip(1)*dip(1) + dip(2)*dip(2) + dip(3)*dip(3) sp_em(6, istate) = occupation_numbers(istate) END IF IF (istate >= lfomo) THEN - i_abs = istate-lfomo+1 - sp_ab(1, i_abs) = ene_f-ene_i + i_abs = istate - lfomo + 1 + sp_ab(1, i_abs) = ene_f - ene_i sp_ab(2, i_abs) = dip(1) sp_ab(3, i_abs) = dip(2) sp_ab(4, i_abs) = dip(3) - sp_ab(5, i_abs) = dip(1)*dip(1)+dip(2)*dip(2)+dip(3)*dip(3) + sp_ab(5, i_abs) = dip(1)*dip(1) + dip(2)*dip(2) + dip(3)*dip(3) IF (istate <= nmo) sp_ab(6, i_abs) = occupation_numbers(istate) END IF @@ -1449,11 +1449,11 @@ SUBROUTINE calc_stogto_overlap(base_a, base_b, matrix) DO iset = 1, nseta - na = npgfa(iset)*(ncoset(la_max(iset))-ncoset(la_min(iset)-1)) + na = npgfa(iset)*(ncoset(la_max(iset)) - ncoset(la_min(iset) - 1)) sgfa = first_sgfa(1, iset) DO jset = 1, nsetb - nb = npgfb(jset)*(ncoset(lb_max(jset))-ncoset(lb_min(jset)-1)) + nb = npgfb(jset)*(ncoset(lb_max(jset)) - ncoset(lb_min(jset) - 1)) sgfb = first_sgfb(1, jset) CALL overlap_ab(la_max(iset), la_min(iset), npgfa(iset), rpgfa(:, iset), zeta(:, iset), & @@ -1577,7 +1577,7 @@ SUBROUTINE cls_assign_core_states(xas_control, xas_env, localized_wfn_control, q ra(1:3) = particle_set(iatom)%r(1:3) rc(1:3) = centers_wfn(1:3, istate) rac = pbc(ra, rc, cell) - dist = rac(1)*rac(1)+rac(2)*rac(2)+rac(3)*rac(3) + dist = rac(1)*rac(1) + rac(2)*rac(2) + rac(3)*rac(3) IF (dist < distmin) THEN @@ -1603,10 +1603,10 @@ SUBROUTINE cls_assign_core_states(xas_control, xas_env, localized_wfn_control, q DO i = 1, SIZE(stogto_overlap(my_kind)%array, 1) component = 0.0_dp DO j = 1, SIZE(stogto_overlap(my_kind)%array, 2) - isgf = first_sgf(iatom)+j-1 - component = component+stogto_overlap(my_kind)%array(i, j)*vecbuffer(1, isgf) + isgf = first_sgf(iatom) + j - 1 + component = component + stogto_overlap(my_kind)%array(i, j)*vecbuffer(1, isgf) END DO - sto_state_overlap(istate) = sto_state_overlap(istate)+ & + sto_state_overlap(istate) = sto_state_overlap(istate) + & component*component END DO @@ -1625,7 +1625,7 @@ SUBROUTINE cls_assign_core_states(xas_control, xas_env, localized_wfn_control, q IF (atom_of_state(istate) == iatom) THEN IF (sto_state_overlap(istate) > max_overlap(iatom)*xas_control%overlap_threshold & .AND. istate /= state_of_mytype(iat)) THEN - nexc_states(iat) = nexc_states(iat)+1 + nexc_states(iat) = nexc_states(iat) + 1 state_of_atom(iat, nexc_states(iat)) = istate END IF END IF @@ -1697,14 +1697,14 @@ SUBROUTINE cls_assign_core_states(xas_control, xas_env, localized_wfn_control, q ra(1:3) = particle_set(iat)%r(1:3) rc(1:3) = centers_wfn(1:3, chosen_state) rac = pbc(ra, rc, cell) - dist = rac(1)*rac(1)+rac(2)*rac(2)+rac(3)*rac(3) + dist = rac(1)*rac(1) + rac(2)*rac(2) + rac(3)*rac(3) IF (dist < distmin) THEN atom_of_state(chosen_state) = iat !? distmin = dist END IF END DO ! iat - nexc_states(atom_of_state(chosen_state)) = nexc_states(atom_of_state(chosen_state))+1 + nexc_states(atom_of_state(chosen_state)) = nexc_states(atom_of_state(chosen_state)) + 1 state_of_atom(atom_of_state(chosen_state), nexc_states(atom_of_state(chosen_state))) = chosen_state END DO !istate diff --git a/src/xas_restart.F b/src/xas_restart.F index 2faa975ec3..3e9d977e04 100644 --- a/src/xas_restart.F +++ b/src/xas_restart.F @@ -238,7 +238,7 @@ SUBROUTINE xas_read_restart(xas_env, xas_section, qs_env, xas_method, iatom, est END DO ! Skip extra MOs if there any IF (para_env%ionode) THEN - DO i = nmo+1, nmo_read + DO i = nmo + 1, nmo_read READ (rst_unit) vecbuffer END DO END IF @@ -400,7 +400,7 @@ SUBROUTINE xas_initialize_rho(qs_env, scf_env, scf_control) IF (ispin == my_spin) THEN IF (xas_env%homo_occ == 0) THEN CALL get_mo_set(mos(ispin)%mo_set, nelectron=nelectron) - nelectron = nelectron-1 + nelectron = nelectron - 1 CALL set_mo_set(mos(ispin)%mo_set, nelectron=nelectron) END IF CALL set_mo_occupation(mo_set=qs_env%mos(ispin)%mo_set, smear=scf_control%smear, & diff --git a/src/xas_tdp_atom.F b/src/xas_tdp_atom.F index 14d9cd19cc..005c39305d 100644 --- a/src/xas_tdp_atom.F +++ b/src/xas_tdp_atom.F @@ -271,21 +271,21 @@ SUBROUTINE init_xas_atom_grid_harmo(xas_atom_env, grid_info, do_xc, qs_env) ALLOCATE (rga(lcleb, 2)) DO lc1 = 0, maxlgto - DO iso1 = nsoset(lc1-1)+1, nsoset(lc1) + DO iso1 = nsoset(lc1 - 1) + 1, nsoset(lc1) l1 = indso(1, iso1) m1 = indso(2, iso1) DO lc2 = 0, maxlgto - DO iso2 = nsoset(lc2-1)+1, nsoset(lc2) + DO iso2 = nsoset(lc2 - 1) + 1, nsoset(lc2) l2 = indso(1, iso2) m2 = indso(2, iso2) CALL clebsch_gordon(l1, m1, l2, m2, rga) - IF (l1+l2 > llmax) THEN + IF (l1 + l2 > llmax) THEN l1l2 = llmax ELSE - l1l2 = l1+l2 + l1l2 = l1 + l2 END IF - mp = m1+m2 - mm = m1-m2 + mp = m1 + m2 + mm = m1 - m2 IF (m1*m2 < 0 .OR. (m1*m2 == 0 .AND. (m1 < 0 .OR. m2 < 0))) THEN mp = -ABS(mp) mm = -ABS(mm) @@ -293,21 +293,21 @@ SUBROUTINE init_xas_atom_grid_harmo(xas_atom_env, grid_info, do_xc, qs_env) mp = ABS(mp) mm = ABS(mm) END IF - DO lp = MOD(l1+l2, 2), l1l2, 2 - il = lp/2+1 + DO lp = MOD(l1 + l2, 2), l1l2, 2 + il = lp/2 + 1 IF (ABS(mp) <= lp) THEN IF (mp >= 0) THEN - iso = nsoset(lp-1)+lp+1+mp + iso = nsoset(lp - 1) + lp + 1 + mp ELSE - iso = nsoset(lp-1)+lp+1-ABS(mp) + iso = nsoset(lp - 1) + lp + 1 - ABS(mp) END IF my_CG(iso1, iso2, iso) = rga(il, 1) ENDIF IF (mp /= mm .AND. ABS(mm) <= lp) THEN IF (mm >= 0) THEN - iso = nsoset(lp-1)+lp+1+mm + iso = nsoset(lp - 1) + lp + 1 + mm ELSE - iso = nsoset(lp-1)+lp+1-ABS(mm) + iso = nsoset(lp - 1) + lp + 1 - ABS(mm) END IF my_CG(iso1, iso2, iso) = rga(il, 2) ENDIF @@ -405,7 +405,7 @@ SUBROUTINE truncate_radial_grid(grid_atom, max_radius) nr = grid_atom%nr na = grid_atom%ng_sphere - llmax_p1 = SIZE(grid_atom%rad2l, 2)-1 + llmax_p1 = SIZE(grid_atom%rad2l, 2) - 1 ! Find the index corresponding to the limiting radius (small ir => large radius) DO ir = 1, nr @@ -414,7 +414,7 @@ SUBROUTINE truncate_radial_grid(grid_atom, max_radius) EXIT END IF END DO - new_nr = nr-first_ir+1 + new_nr = nr - first_ir + 1 ! Reallcoate everything that depends on r grid_atom%nr = new_nr @@ -475,23 +475,23 @@ SUBROUTINE compute_sphi_so(ikind, basis_type, sphi_so, qs_env) DO iset = 1, nset sgfi = first_sgf(1, iset) DO ipgf = 1, npgf(iset) - start_s = (ipgf-1)*nsoset(lmax(iset)) - start_c = (ipgf-1)*ncoset(lmax(iset)) + start_s = (ipgf - 1)*nsoset(lmax(iset)) + start_c = (ipgf - 1)*ncoset(lmax(iset)) DO l = lmin(iset), lmax(iset) DO iso = 1, nso(l) DO ico = 1, nco(l) - lx = indco(1, ico+ncoset(l-1)) - ly = indco(2, ico+ncoset(l-1)) - lz = indco(3, ico+ncoset(l-1)) + lx = indco(1, ico + ncoset(l - 1)) + ly = indco(2, ico + ncoset(l - 1)) + lz = indco(3, ico + ncoset(l - 1)) factor = orbtramat(l)%s2c(iso, ico) & - *SQRT(4.0_dp*pi/dfac(2*l+1)*dfac(2*lx-1)*dfac(2*ly-1)*dfac(2*lz-1)) + *SQRT(4.0_dp*pi/dfac(2*l + 1)*dfac(2*lx - 1)*dfac(2*ly - 1)*dfac(2*lz - 1)) CALL daxpy(nsgf_set(iset), factor, & - sphi(start_c+ncoset(l-1)+ico, sgfi:sgfi+nsgf_set(iset)-1), 1, & - sphi_so(start_s+nsoset(l-1)+iso, sgfi:sgfi+nsgf_set(iset)-1), 1) + sphi(start_c + ncoset(l - 1) + ico, sgfi:sgfi + nsgf_set(iset) - 1), 1, & + sphi_so(start_s + nsoset(l - 1) + iso, sgfi:sgfi + nsgf_set(iset) - 1), 1) END DO !ico END DO !iso @@ -555,7 +555,7 @@ SUBROUTINE find_neighbors(base_atoms, mat_s, radius, qs_env, all_neighbors, neig END DO ! First loop over S => count the number of neighbors - ALLOCATE (n_neighbors(nbase, 0:para_env%num_pe-1)) + ALLOCATE (n_neighbors(nbase, 0:para_env%num_pe - 1)) n_neighbors = 0 CALL dbcsr_iterator_start(iter, mat_s) @@ -575,11 +575,11 @@ SUBROUTINE find_neighbors(base_atoms, mat_s, radius, qs_env, all_neighbors, neig IF (is_base_atom(iblk)) THEN ibase = blk_to_base(iblk) - n_neighbors(ibase, mepos) = n_neighbors(ibase, mepos)+1 + n_neighbors(ibase, mepos) = n_neighbors(ibase, mepos) + 1 END IF IF (is_base_atom(jblk)) THEN ibase = blk_to_base(jblk) - n_neighbors(ibase, mepos) = n_neighbors(ibase, mepos)+1 + n_neighbors(ibase, mepos) = n_neighbors(ibase, mepos) + 1 END IF END DO !iter @@ -610,13 +610,13 @@ SUBROUTINE find_neighbors(base_atoms, mat_s, radius, qs_env, all_neighbors, neig IF (is_base_atom(iblk)) THEN ibase = blk_to_base(iblk) - my_neighbor_set(ibase)%array(SUM(n_neighbors(ibase, 0:mepos-1))+inb(ibase)) = jblk - inb(ibase) = inb(ibase)+1 + my_neighbor_set(ibase)%array(SUM(n_neighbors(ibase, 0:mepos - 1)) + inb(ibase)) = jblk + inb(ibase) = inb(ibase) + 1 END IF IF (is_base_atom(jblk)) THEN ibase = blk_to_base(jblk) - my_neighbor_set(ibase)%array(SUM(n_neighbors(ibase, 0:mepos-1))+inb(ibase)) = iblk - inb(ibase) = inb(ibase)+1 + my_neighbor_set(ibase)%array(SUM(n_neighbors(ibase, 0:mepos - 1)) + inb(ibase)) = iblk + inb(ibase) = inb(ibase) + 1 END IF END DO !iter @@ -643,7 +643,7 @@ SUBROUTINE find_neighbors(base_atoms, mat_s, radius, qs_env, all_neighbors, neig i = 0 DO iat = 1, natom IF (who_is_there(iat) == 1) THEN - i = i+1 + i = i + 1 all_neighbors(i) = iat END IF END DO @@ -726,8 +726,8 @@ SUBROUTINE get_exat_ri_sinv(ri_sinv, whole_s, neighbors, idx_to_nb, basis_set_ri ALLOCATE (row_dist(nnb), col_dist(nnb)) DO inb = 1, nnb - row_dist(inb) = MODULO(nprows-inb, nprows) - col_dist(inb) = MODULO(npcols-inb, npcols) + row_dist(inb) = MODULO(nprows - inb, nprows) + col_dist(inb) = MODULO(npcols - inb, npcols) END DO CALL dbcsr_distribution_new(sinv_dist, group=group, pgrid=pgrid, row_dist=row_dist, & @@ -743,7 +743,7 @@ SUBROUTINE get_exat_ri_sinv(ri_sinv, whole_s, neighbors, idx_to_nb, basis_set_ri !do the atom overlap ? rj = pbc(particle_set(neighbors(jnb))%r, cell) rij = pbc(ri, rj, cell) - IF (SUM(rij**2) > (radius(inb)+radius(jnb))**2) CYCLE + IF (SUM(rij**2) > (radius(inb) + radius(jnb))**2) CYCLE CALL dbcsr_get_stored_coordinates(ri_sinv, inb, jnb, blk) IF (para_env%mepos == blk) THEN @@ -788,9 +788,9 @@ SUBROUTINE get_exat_ri_sinv(ri_sinv, whole_s, neighbors, idx_to_nb, basis_set_ri !send the block with unique tag to the proc where inb,jnb is in ri_sinv CALL dbcsr_get_stored_coordinates(ri_sinv, inb, jnb, dest) - is = is+1 + is = is + 1 send_buff(is)%array => block_whole - tag = natom*iat+jat + tag = natom*iat + jat CALL mp_isend(msgin=send_buff(is)%array, dest=dest, comm=group, request=send_req(is), tag=tag) END IF @@ -814,8 +814,8 @@ SUBROUTINE get_exat_ri_sinv(ri_sinv, whole_s, neighbors, idx_to_nb, basis_set_ri CALL dbcsr_get_stored_coordinates(whole_s, iat, jat, source) IF (para_env%mepos == source) CYCLE - tag = natom*iat+jat - ir = ir+1 + tag = natom*iat + jat + ir = ir + 1 recv_buff(ir)%array => block_risinv CALL mp_irecv(msgout=recv_buff(ir)%array, source=source, request=recv_req(ir), & tag=tag, comm=group) @@ -973,18 +973,18 @@ SUBROUTINE calculate_density_coeffs(xas_atom_env, qs_env) DO ibatch = 1, nbatch !excited atoms in that batch - bo = get_limit(nex, nbatch, ibatch-1) + bo = get_limit(nex, nbatch, ibatch - 1) !Get all ri atoms belonging to that batch in an array (ex atoms + neighbors in RI_REGION) - nat_batch = bo(2)-bo(1)+1 + nat_batch = bo(2) - bo(1) + 1 ALLOCATE (batch_atoms(nat_batch)) batch_atoms(:) = xas_atom_env%excited_atoms(bo(1):bo(2)) DO iex = bo(1), bo(2) DO inb = 1, SIZE(xas_atom_env%exat_neighbors(iex)%array) IF (.NOT. ANY(batch_atoms == xas_atom_env%exat_neighbors(iex)%array(inb))) THEN - CALL reallocate(batch_atoms, 1, nat_batch+1) - batch_atoms(nat_batch+1) = xas_atom_env%exat_neighbors(iex)%array(inb) - nat_batch = nat_batch+1 + CALL reallocate(batch_atoms, 1, nat_batch + 1) + batch_atoms(nat_batch + 1) = xas_atom_env%exat_neighbors(iex)%array(inb) + nat_batch = nat_batch + 1 END IF END DO !inb END DO !iex @@ -1024,7 +1024,7 @@ SUBROUTINE calculate_density_coeffs(xas_atom_env, qs_env) !get the neighbors of current excited atom exat = xas_atom_env%excited_atoms(iex) - nnb = 1+SIZE(xas_atom_env%exat_neighbors(iex)%array) + nnb = 1 + SIZE(xas_atom_env%exat_neighbors(iex)%array) ALLOCATE (neighbors(nnb)) neighbors(1) = exat neighbors(2:nnb) = xas_atom_env%exat_neighbors(iex)%array(:) @@ -1197,7 +1197,7 @@ SUBROUTINE put_density_on_atomic_grid(rho_set, ri_dcoeff, atom_kind, do_gga, bou ! Get the grid and the info we need from it grid_atom => xas_atom_env%grid_atom_set(atom_kind)%grid_atom na = grid_atom%ng_sphere - nr = bounds(2, 2)-bounds(1, 2)+1 + nr = bounds(2, 2) - bounds(1, 2) + 1 n = na*nr nspins = xas_atom_env%nspins ri_sphi_so => xas_atom_env%ri_sphi_so(atom_kind)%array @@ -1231,24 +1231,24 @@ SUBROUTINE put_density_on_atomic_grid(rho_set, ri_dcoeff, atom_kind, do_gga, bou IF (do_gga) ALLOCATE (dso(na, nr, 3, npgf(iset)*nsoset(lmax(iset)))) DO ipgf = 1, npgf(iset) - start_pgf = (ipgf-1)*nsoset(lmax(iset)) - start = (iset-1)*maxso+start_pgf + start_pgf = (ipgf - 1)*nsoset(lmax(iset)) + start = (iset - 1)*maxso + start_pgf !loop over the spherical gaussian orbitals - DO iso = nsoset(lmin(iset)-1)+1, nsoset(lmax(iset)) + DO iso = nsoset(lmin(iset) - 1) + 1, nsoset(lmax(iset)) !the spherical orbital on the grid - CALL dgemm('N', 'T', na, nr, 1, 1.0_dp, ga(:, start+iso:start+iso), na, & - gr(:, start+iso:start+iso), nr, 0.0_dp, so(:, :, start_pgf+iso), na) + CALL dgemm('N', 'T', na, nr, 1, 1.0_dp, ga(:, start + iso:start + iso), na, & + gr(:, start + iso:start + iso), nr, 0.0_dp, so(:, :, start_pgf + iso), na) !the gradient on the grid IF (do_gga) THEN DO dir = 1, 3 - CALL dgemm('N', 'T', na, nr, 1, 1.0_dp, dga1(:, start+iso:start+iso, dir), na, & - dgr1(:, start+iso:start+iso), nr, 0.0_dp, dso(:, :, dir, start_pgf+iso), na) - CALL dgemm('N', 'T', na, nr, 1, 1.0_dp, dga2(:, start+iso:start+iso, dir), na, & - dgr2(:, start+iso:start+iso), nr, 1.0_dp, dso(:, :, dir, start_pgf+iso), na) + CALL dgemm('N', 'T', na, nr, 1, 1.0_dp, dga1(:, start + iso:start + iso, dir), na, & + dgr1(:, start + iso:start + iso), nr, 0.0_dp, dso(:, :, dir, start_pgf + iso), na) + CALL dgemm('N', 'T', na, nr, 1, 1.0_dp, dga2(:, start + iso:start + iso, dir), na, & + dgr2(:, start + iso:start + iso), nr, 1.0_dp, dso(:, :, dir, start_pgf + iso), na) END DO END IF @@ -1261,7 +1261,7 @@ SUBROUTINE put_density_on_atomic_grid(rho_set, ri_dcoeff, atom_kind, do_gga, bou IF (do_gga) THEN ALLOCATE (dsgf(na, nr, 3)) END IF - sgfi = first_sgf(1, iset)-1 + sgfi = first_sgf(1, iset) - 1 DO isgf = 1, nsgf_set(iset) @@ -1270,26 +1270,26 @@ SUBROUTINE put_density_on_atomic_grid(rho_set, ri_dcoeff, atom_kind, do_gga, bou !so -> sgf DO ipgf = 1, npgf(iset) - start_pgf = (ipgf-1)*nsoset(lmax(iset)) - DO iso = nsoset(lmin(iset)-1)+1, nsoset(lmax(iset)) - CALL daxpy(n, ri_sphi_so(start_pgf+iso, sgfi+isgf), so(:, :, start_pgf+iso), 1, & + start_pgf = (ipgf - 1)*nsoset(lmax(iset)) + DO iso = nsoset(lmin(iset) - 1) + 1, nsoset(lmax(iset)) + CALL daxpy(n, ri_sphi_so(start_pgf + iso, sgfi + isgf), so(:, :, start_pgf + iso), 1, & sgf(:, :), 1) END DO !iso END DO !ipgf !put the sgf on the grid with the approriate coefficients and sum - CALL daxpy(n, ri_dcoeff(1)%array(sgfi+isgf), sgf(:, :), 1, rhoa(:, :, 1), 1) + CALL daxpy(n, ri_dcoeff(1)%array(sgfi + isgf), sgf(:, :), 1, rhoa(:, :, 1), 1) IF (nspins == 2) THEN - CALL daxpy(n, ri_dcoeff(2)%array(sgfi+isgf), sgf(:, :), 1, rhob(:, :, 1), 1) + CALL daxpy(n, ri_dcoeff(2)%array(sgfi + isgf), sgf(:, :), 1, rhob(:, :, 1), 1) END IF IF (do_gga) THEN DO ipgf = 1, npgf(iset) - start_pgf = (ipgf-1)*nsoset(lmax(iset)) - DO iso = nsoset(lmin(iset)-1)+1, nsoset(lmax(iset)) + start_pgf = (ipgf - 1)*nsoset(lmax(iset)) + DO iso = nsoset(lmin(iset) - 1) + 1, nsoset(lmax(iset)) DO dir = 1, 3 - CALL daxpy(n, ri_sphi_so(start_pgf+iso, sgfi+isgf), dso(:, :, dir, start_pgf+iso), & + CALL daxpy(n, ri_sphi_so(start_pgf + iso, sgfi + isgf), dso(:, :, dir, start_pgf + iso), & 1, dsgf(:, :, dir), 1) END DO !dir END DO !iso @@ -1297,11 +1297,11 @@ SUBROUTINE put_density_on_atomic_grid(rho_set, ri_dcoeff, atom_kind, do_gga, bou !put the gradient of the sgf on the grid with correspond RI coeff DO dir = 1, 3 - CALL daxpy(n, ri_dcoeff(1)%array(sgfi+isgf), dsgf(:, :, dir), & + CALL daxpy(n, ri_dcoeff(1)%array(sgfi + isgf), dsgf(:, :, dir), & 1, rho_set%drhoa(dir)%array(:, :, 1), 1) IF (nspins == 2) THEN - CALL daxpy(n, ri_dcoeff(2)%array(sgfi+isgf), dsgf(:, :, dir), & + CALL daxpy(n, ri_dcoeff(2)%array(sgfi + isgf), dsgf(:, :, dir), & 1, rho_set%drhob(dir)%array(:, :, 1), 1) END IF END DO !dir @@ -1399,7 +1399,7 @@ SUBROUTINE put_density_on_other_grid(rho_set, ri_dcoeff, source_iat, source_ikin harmonics => xas_atom_env%harmonics_atom_set(target_ikind)%harmonics_atom na = grid_atom%ng_sphere sr = bounds(1, 2); er = bounds(2, 2) - nr = er-sr+1 + nr = er - sr + 1 n = na*nr nspins = xas_atom_env%nspins @@ -1419,8 +1419,8 @@ SUBROUTINE put_density_on_other_grid(rho_set, ri_dcoeff, source_iat, source_ikin !$OMP PRIVATE(ia,ir) DO ir = sr, er DO ia = 1, na - pos(ia, ir, 1:3) = harmonics%a(:, ia)*grid_atom%rad(ir)+rst - pos(ia, ir, 4) = pos(ia, ir, 1)**2+pos(ia, ir, 2)**2+pos(ia, ir, 3)**2 + pos(ia, ir, 1:3) = harmonics%a(:, ia)*grid_atom%rad(ir) + rst + pos(ia, ir, 4) = pos(ia, ir, 1)**2 + pos(ia, ir, 2)**2 + pos(ia, ir, 3)**2 END DO END DO !$OMP END PARALLEL DO @@ -1448,10 +1448,10 @@ SUBROUTINE put_density_on_other_grid(rho_set, ri_dcoeff, source_iat, source_ikin !$OMP END DO NOWAIT DO ipgf = 1, npgf(iset) - start = (ipgf-1)*ncoset(lmax(iset)) + start = (ipgf - 1)*ncoset(lmax(iset)) !loop over the cartesian orbitals - DO ico = ncoset(lmin(iset)-1)+1, ncoset(lmax(iset)) + DO ico = ncoset(lmin(iset) - 1) + 1, ncoset(lmax(iset)) lx = indco(1, ico) ly = indco(2, ico) lz = indco(3, ico) @@ -1460,8 +1460,8 @@ SUBROUTINE put_density_on_other_grid(rho_set, ri_dcoeff, source_iat, source_ikin !$OMP DO COLLAPSE(2) SCHEDULE(STATIC) DO ir = sr, er DO ia = 1, na - co(ia, ir, start+ico) = pos(ia, ir, 1)**lx*pos(ia, ir, 2)**ly*pos(ia, ir, 3)**lz & - *EXP(-zet(ipgf, iset)*pos(ia, ir, 4)) + co(ia, ir, start + ico) = pos(ia, ir, 1)**lx*pos(ia, ir, 2)**ly*pos(ia, ir, 3)**lz & + *EXP(-zet(ipgf, iset)*pos(ia, ir, 4)) END DO END DO !$OMP END DO NOWAIT @@ -1476,9 +1476,9 @@ SUBROUTINE put_density_on_other_grid(rho_set, ri_dcoeff, source_iat, source_ikin !$OMP DO COLLAPSE(2) SCHEDULE(STATIC) DO ir = sr, er DO ia = 1, na - dco(ia, ir, 1, start+ico) = -2.0_dp*pos(ia, ir, 1)*zet(ipgf, iset) & - *pos(ia, ir, 2)**ly*pos(ia, ir, 3)**lz & - *EXP(-zet(ipgf, iset)*pos(ia, ir, 4)) + dco(ia, ir, 1, start + ico) = -2.0_dp*pos(ia, ir, 1)*zet(ipgf, iset) & + *pos(ia, ir, 2)**ly*pos(ia, ir, 3)**lz & + *EXP(-zet(ipgf, iset)*pos(ia, ir, 4)) END DO END DO !$OMP END DO NOWAIT @@ -1486,10 +1486,10 @@ SUBROUTINE put_density_on_other_grid(rho_set, ri_dcoeff, source_iat, source_ikin !$OMP DO COLLAPSE(2) SCHEDULE(STATIC) DO ir = sr, er DO ia = 1, na - dco(ia, ir, 1, start+ico) = (lx*pos(ia, ir, 1)**(lx-1) & - -2.0_dp*pos(ia, ir, 1)**(lx+1)*zet(ipgf, iset)) & - *pos(ia, ir, 2)**ly*pos(ia, ir, 3)**lz & - *EXP(-zet(ipgf, iset)*pos(ia, ir, 4)) + dco(ia, ir, 1, start + ico) = (lx*pos(ia, ir, 1)**(lx - 1) & + - 2.0_dp*pos(ia, ir, 1)**(lx + 1)*zet(ipgf, iset)) & + *pos(ia, ir, 2)**ly*pos(ia, ir, 3)**lz & + *EXP(-zet(ipgf, iset)*pos(ia, ir, 4)) END DO END DO !$OMP END DO NOWAIT @@ -1500,9 +1500,9 @@ SUBROUTINE put_density_on_other_grid(rho_set, ri_dcoeff, source_iat, source_ikin !$OMP DO COLLAPSE(2) SCHEDULE(STATIC) DO ir = sr, er DO ia = 1, na - dco(ia, ir, 2, start+ico) = -2.0_dp*pos(ia, ir, 2)*zet(ipgf, iset) & - *pos(ia, ir, 1)**lx*pos(ia, ir, 3)**lz & - *EXP(-zet(ipgf, iset)*pos(ia, ir, 4)) + dco(ia, ir, 2, start + ico) = -2.0_dp*pos(ia, ir, 2)*zet(ipgf, iset) & + *pos(ia, ir, 1)**lx*pos(ia, ir, 3)**lz & + *EXP(-zet(ipgf, iset)*pos(ia, ir, 4)) END DO END DO !$OMP END DO NOWAIT @@ -1510,10 +1510,10 @@ SUBROUTINE put_density_on_other_grid(rho_set, ri_dcoeff, source_iat, source_ikin !$OMP DO COLLAPSE(2) SCHEDULE(STATIC) DO ir = sr, er DO ia = 1, na - dco(ia, ir, 2, start+ico) = (ly*pos(ia, ir, 2)**(ly-1) & - -2.0_dp*pos(ia, ir, 2)**(ly+1)*zet(ipgf, iset)) & - *pos(ia, ir, 1)**lx*pos(ia, ir, 3)**lz & - *EXP(-zet(ipgf, iset)*pos(ia, ir, 4)) + dco(ia, ir, 2, start + ico) = (ly*pos(ia, ir, 2)**(ly - 1) & + - 2.0_dp*pos(ia, ir, 2)**(ly + 1)*zet(ipgf, iset)) & + *pos(ia, ir, 1)**lx*pos(ia, ir, 3)**lz & + *EXP(-zet(ipgf, iset)*pos(ia, ir, 4)) END DO END DO !$OMP END DO NOWAIT @@ -1524,9 +1524,9 @@ SUBROUTINE put_density_on_other_grid(rho_set, ri_dcoeff, source_iat, source_ikin !$OMP DO COLLAPSE(2) SCHEDULE(STATIC) DO ir = sr, er DO ia = 1, na - dco(ia, ir, 3, start+ico) = -2.0_dp*pos(ia, ir, 3)*zet(ipgf, iset) & - *pos(ia, ir, 1)**lx*pos(ia, ir, 2)**ly & - *EXP(-zet(ipgf, iset)*pos(ia, ir, 4)) + dco(ia, ir, 3, start + ico) = -2.0_dp*pos(ia, ir, 3)*zet(ipgf, iset) & + *pos(ia, ir, 1)**lx*pos(ia, ir, 2)**ly & + *EXP(-zet(ipgf, iset)*pos(ia, ir, 4)) END DO END DO !$OMP END DO NOWAIT @@ -1534,10 +1534,10 @@ SUBROUTINE put_density_on_other_grid(rho_set, ri_dcoeff, source_iat, source_ikin !$OMP DO COLLAPSE(2) SCHEDULE(STATIC) DO ir = sr, er DO ia = 1, na - dco(ia, ir, 3, start+ico) = (lz*pos(ia, ir, 3)**(lz-1) & - -2.0_dp*pos(ia, ir, 3)**(lz+1)*zet(ipgf, iset)) & - *pos(ia, ir, 1)**lx*pos(ia, ir, 2)**ly & - *EXP(-zet(ipgf, iset)*pos(ia, ir, 4)) + dco(ia, ir, 3, start + ico) = (lz*pos(ia, ir, 3)**(lz - 1) & + - 2.0_dp*pos(ia, ir, 3)**(lz + 1)*zet(ipgf, iset)) & + *pos(ia, ir, 1)**lx*pos(ia, ir, 2)**ly & + *EXP(-zet(ipgf, iset)*pos(ia, ir, 4)) END DO END DO !$OMP END DO NOWAIT @@ -1553,44 +1553,44 @@ SUBROUTINE put_density_on_other_grid(rho_set, ri_dcoeff, source_iat, source_ikin !contract the co into sgf ALLOCATE (sgf(na, nr)) IF (do_gga) ALLOCATE (dsgf(na, nr, 3)) - sgfi = first_sgf(1, iset)-1 + sgfi = first_sgf(1, iset) - 1 DO isgf = 1, nsgf_set(iset) sgf = 0.0_dp IF (do_gga) dsgf = 0.0_dp DO ipgf = 1, npgf(iset) - start = (ipgf-1)*ncoset(lmax(iset)) - DO ico = ncoset(lmin(iset)-1)+1, ncoset(lmax(iset)) - CALL daxpy(n, ri_sphi(start+ico, sgfi+isgf), co(:, :, start+ico), 1, sgf(:, :), 1) + start = (ipgf - 1)*ncoset(lmax(iset)) + DO ico = ncoset(lmin(iset) - 1) + 1, ncoset(lmax(iset)) + CALL daxpy(n, ri_sphi(start + ico, sgfi + isgf), co(:, :, start + ico), 1, sgf(:, :), 1) END DO !ico END DO !ipgf !add the density to the grid - CALL daxpy(n, ri_dcoeff(1)%array(sgfi+isgf), sgf(:, :), 1, rhoa(:, :, 1), 1) + CALL daxpy(n, ri_dcoeff(1)%array(sgfi + isgf), sgf(:, :), 1, rhoa(:, :, 1), 1) IF (nspins == 2) THEN - CALL daxpy(n, ri_dcoeff(2)%array(sgfi+isgf), sgf(:, :), 1, rhob(:, :, 1), 1) + CALL daxpy(n, ri_dcoeff(2)%array(sgfi + isgf), sgf(:, :), 1, rhob(:, :, 1), 1) END IF !deal with the gradient IF (do_gga) THEN DO ipgf = 1, npgf(iset) - start = (ipgf-1)*ncoset(lmax(iset)) - DO ico = ncoset(lmin(iset)-1)+1, ncoset(lmax(iset)) + start = (ipgf - 1)*ncoset(lmax(iset)) + DO ico = ncoset(lmin(iset) - 1) + 1, ncoset(lmax(iset)) DO dir = 1, 3 - CALL daxpy(n, ri_sphi(start+ico, sgfi+isgf), dco(:, :, dir, start+ico), 1, dsgf(:, :, dir), 1) + CALL daxpy(n, ri_sphi(start + ico, sgfi + isgf), dco(:, :, dir, start + ico), 1, dsgf(:, :, dir), 1) END DO END DO !ico END DO !ipgf DO dir = 1, 3 - CALL daxpy(n, ri_dcoeff(1)%array(sgfi+isgf), dsgf(:, :, dir), 1, & + CALL daxpy(n, ri_dcoeff(1)%array(sgfi + isgf), dsgf(:, :, dir), 1, & rho_set%drhoa(dir)%array(:, :, 1), 1) IF (nspins == 2) THEN - CALL daxpy(n, ri_dcoeff(2)%array(sgfi+isgf), dsgf(:, :, dir), 1, & + CALL daxpy(n, ri_dcoeff(2)%array(sgfi + isgf), dsgf(:, :, dir), 1, & rho_set%drhob(dir)%array(:, :, 1), 1) END IF END DO @@ -1639,7 +1639,7 @@ SUBROUTINE compute_norm_drho(rho_set, atom_kind, bounds, xas_atom_env) na = xas_atom_env%grid_atom_set(atom_kind)%grid_atom%ng_sphere sr = bounds(1, 2); er = bounds(2, 2) - nr = er-sr+1 + nr = er - sr + 1 n = na*nr nspins = xas_atom_env%nspins @@ -1651,7 +1651,7 @@ SUBROUTINE compute_norm_drho(rho_set, atom_kind, bounds, xas_atom_env) DO ir = sr, er DO ia = 1, na rho_set%norm_drhoa(ia, ir, 1) = rho_set%norm_drhoa(ia, ir, 1) & - +rho_set%drhoa(dir)%array(ia, ir, 1)**2 + + rho_set%drhoa(dir)%array(ia, ir, 1)**2 END DO !ia END DO !ir END DO !dir @@ -1665,7 +1665,7 @@ SUBROUTINE compute_norm_drho(rho_set, atom_kind, bounds, xas_atom_env) DO ir = sr, er DO ia = 1, na rho_set%norm_drhob(ia, ir, 1) = rho_set%norm_drhob(ia, ir, 1) & - +rho_set%drhob(dir)%array(ia, ir, 1)**2 + + rho_set%drhob(dir)%array(ia, ir, 1)**2 END DO END DO END DO @@ -1675,8 +1675,8 @@ SUBROUTINE compute_norm_drho(rho_set, atom_kind, bounds, xas_atom_env) DO dir = 1, 3 DO ir = sr, er DO ia = 1, na - rho_set%norm_drho(ia, ir, 1) = rho_set%norm_drho(ia, ir, 1)+ & - (rho_set%drhoa(dir)%array(ia, ir, 1)+rho_set%drhob(dir)%array(ia, ir, 1))**2 + rho_set%norm_drho(ia, ir, 1) = rho_set%norm_drho(ia, ir, 1) + & + (rho_set%drhoa(dir)%array(ia, ir, 1) + rho_set%drhob(dir)%array(ia, ir, 1))**2 END DO END DO END DO @@ -1747,7 +1747,7 @@ SUBROUTINE precompute_so_dso(do_gga, batch_size, ipe, xas_atom_env, qs_env) !Split the grid bo = get_limit(nr, batch_size, ipe) sr = bo(1); er = bo(2) - nr = er-sr+1 + nr = er - sr + 1 slm => harmonics%slm dslm_dxyz => harmonics%dslm_dxyz @@ -1780,27 +1780,27 @@ SUBROUTINE precompute_so_dso(do_gga, batch_size, ipe, xas_atom_env, qs_env) DO iset = 1, nset DO ipgf = 1, npgf(iset) - starti = (iset-1)*maxso+(ipgf-1)*nsoset(lmax(iset)) - DO iso = nsoset(lmin(iset)-1)+1, nsoset(lmax(iset)) + starti = (iset - 1)*maxso + (ipgf - 1)*nsoset(lmax(iset)) + DO iso = nsoset(lmin(iset) - 1) + 1, nsoset(lmax(iset)) l = indso(1, iso) !radial part of the gaussian - gr(1:nr, starti+iso) = grid_atom%rad(sr:er)**l*EXP(-zet(ipgf, iset)*grid_atom%rad2(sr:er)) + gr(1:nr, starti + iso) = grid_atom%rad(sr:er)**l*EXP(-zet(ipgf, iset)*grid_atom%rad2(sr:er)) !angular part of the gaussian - ga(1:na, starti+iso) = slm(1:na, iso) + ga(1:na, starti + iso) = slm(1:na, iso) IF (do_gga) THEN !radial part of the gradient => same in all three direction - dgr1(1:nr, starti+iso) = grid_atom%rad(sr:er)**(l-1) & - *EXP(-zet(ipgf, iset)*grid_atom%rad2(sr:er)) - dgr2(1:nr, starti+iso) = -2.0_dp*zet(ipgf, iset)*grid_atom%rad(sr:er)**(l+1) & - *EXP(-zet(ipgf, iset)*grid_atom%rad2(sr:er)) + dgr1(1:nr, starti + iso) = grid_atom%rad(sr:er)**(l - 1) & + *EXP(-zet(ipgf, iset)*grid_atom%rad2(sr:er)) + dgr2(1:nr, starti + iso) = -2.0_dp*zet(ipgf, iset)*grid_atom%rad(sr:er)**(l + 1) & + *EXP(-zet(ipgf, iset)*grid_atom%rad2(sr:er)) !angular part of the gradient DO dir = 1, 3 - dga1(1:na, starti+iso, dir) = dslm_dxyz(dir, 1:na, iso) - dga2(1:na, starti+iso, dir) = harmonics%a(dir, 1:na)*slm(1:na, iso) + dga1(1:na, starti + iso, dir) = dslm_dxyz(dir, 1:na, iso) + dga2(1:na, starti + iso, dir) = harmonics%a(dir, 1:na)*slm(1:na, iso) END DO END IF @@ -1885,9 +1885,9 @@ SUBROUTINE integrate_fxc_atoms(int_fxc, xas_atom_env, xas_tdp_control, qs_env) !the proc index within the batch ipe = MODULO(mepos, batch_size) !make sure we include last procs if batch_size is not divisor of total num_procs - IF (nbatch*batch_size .NE. num_pe) nbatch = nbatch+1 + IF (nbatch*batch_size .NE. num_pe) nbatch = nbatch + 1 !the size of the last batch might be less than nominal one - IF ((ibatch+1)*batch_size > num_pe) batch_size = num_pe-ibatch*batch_size + IF ((ibatch + 1)*batch_size > num_pe) batch_size = num_pe - ibatch*batch_size !distribute the excted atoms over the batches bo = get_limit(nex_atom, nbatch, ibatch) !create a subcommunicator for this batch @@ -2046,7 +2046,7 @@ SUBROUTINE integrate_gga_fxc(int_fxc, iatom, ikind, rho_set, deriv_set, bounds, grid_atom => xas_atom_env%grid_atom_set(ikind)%grid_atom na = grid_atom%ng_sphere sr = bounds(1, 2); er = bounds(2, 2) - nr = er-sr+1 + nr = er - sr + 1 weight => grid_atom%weight !get the ri_basis indo @@ -2088,21 +2088,21 @@ SUBROUTINE integrate_gga_fxc(int_fxc, iatom, ikind, rho_set, deriv_set, bounds, DO jset = 1, nset DO jpgf = 1, npgf(jset) - startj = (jset-1)*maxso+(jpgf-1)*nsoset(lmax(jset)) - DO jso = nsoset(lmin(jset)-1)+1, nsoset(lmax(jset)) + startj = (jset - 1)*maxso + (jpgf - 1)*nsoset(lmax(jset)) + DO jso = nsoset(lmin(jset) - 1) + 1, nsoset(lmax(jset)) !put the so phi_j and its gradient on the grid !so - CALL dgemm('N', 'T', na, nr, 1, 1.0_dp, ga(:, startj+jso:startj+jso), na, & - gr(:, startj+jso:startj+jso), nr, 0.0_dp, so(:, :), na) + CALL dgemm('N', 'T', na, nr, 1, 1.0_dp, ga(:, startj + jso:startj + jso), na, & + gr(:, startj + jso:startj + jso), nr, 0.0_dp, so(:, :), na) !dso DO dir = 1, 3 - CALL dgemm('N', 'T', na, nr, 1, 1.0_dp, dga1(:, startj+jso:startj+jso, dir), & - na, dgr1(:, startj+jso:startj+jso), nr, 0.0_dp, dso(:, :, dir), na) - CALL dgemm('N', 'T', na, nr, 1, 1.0_dp, dga2(:, startj+jso:startj+jso, dir), & - na, dgr2(:, startj+jso:startj+jso), nr, 1.0_dp, dso(:, :, dir), na) + CALL dgemm('N', 'T', na, nr, 1, 1.0_dp, dga1(:, startj + jso:startj + jso, dir), & + na, dgr1(:, startj + jso:startj + jso), nr, 0.0_dp, dso(:, :, dir), na) + CALL dgemm('N', 'T', na, nr, 1, 1.0_dp, dga2(:, startj + jso:startj + jso, dir), & + na, dgr2(:, startj + jso:startj + jso), nr, 1.0_dp, dso(:, :, dir), na) END DO !dir !Perform the first integration (analytically) @@ -2111,7 +2111,7 @@ SUBROUTINE integrate_gga_fxc(int_fxc, iatom, ikind, rho_set, deriv_set, bounds, !For a given phi_j, compute the second integration with all phi_i at once !=> allows for efficient gemm to take place !kernl is symmetric => avoid double computing - nsoi = startj+jso + nsoi = startj + jso ALLOCATE (res(nsoi, nsoi), work(na, nsoi)) res = 0.0_dp; work = 0.0_dp @@ -2122,7 +2122,7 @@ SUBROUTINE integrate_gga_fxc(int_fxc, iatom, ikind, rho_set, deriv_set, bounds, gr(:, 1:nsoi), nr, 0.0_dp, work, na) CALL dgemm('T', 'N', nsoi, nsoi, na, 1.0_dp, work, na, & ga(:, 1:nsoi), na, 0.0_dp, res, nsoi) - int_so(i)%array(1:nsoi, startj+jso) = get_diag(res) + int_so(i)%array(1:nsoi, startj + jso) = get_diag(res) DO dir = 1, 3 @@ -2131,18 +2131,18 @@ SUBROUTINE integrate_gga_fxc(int_fxc, iatom, ikind, rho_set, deriv_set, bounds, dgr1(:, 1:nsoi), nr, 0.0_dp, work, na) CALL dgemm('T', 'N', nsoi, nsoi, na, 1.0_dp, work, na, & dga1(:, 1:nsoi, dir), na, 0.0_dp, res, nsoi) - CALL daxpy(nsoi, 1.0_dp, get_diag(res), 1, int_so(i)%array(1:nsoi, startj+jso), 1) + CALL daxpy(nsoi, 1.0_dp, get_diag(res), 1, int_so(i)%array(1:nsoi, startj + jso), 1) CALL dgemm('N', 'N', na, nsoi, nr, 1.0_dp, vxg(i)%array(:, :, dir), na, & dgr2(:, 1:nsoi), nr, 0.0_dp, work, na) CALL dgemm('T', 'N', nsoi, nsoi, na, 1.0_dp, work, na, & dga2(:, 1:nsoi, dir), na, 0.0_dp, res, nsoi) - CALL daxpy(nsoi, 1.0_dp, get_diag(res), 1, int_so(i)%array(1:nsoi, startj+jso), 1) + CALL daxpy(nsoi, 1.0_dp, get_diag(res), 1, int_so(i)%array(1:nsoi, startj + jso), 1) END DO !symmetry - int_so(i)%array(startj+jso, 1:nsoi) = int_so(i)%array(1:nsoi, startj+jso) + int_so(i)%array(startj + jso, 1:nsoi) = int_so(i)%array(1:nsoi, startj + jso) END DO !i DEALLOCATE (res, work) @@ -2245,10 +2245,10 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight DO dir = 1, 3 !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na - dot_proda(ia, ir) = dot_proda(ia, ir)+rho_set%drhoa(dir)%array(ia, ir, 1)*dso(ia, jr, dir) - dot_prodb(ia, ir) = dot_prodb(ia, ir)+rho_set%drhob(dir)%array(ia, ir, 1)*dso(ia, jr, dir) + dot_proda(ia, ir) = dot_proda(ia, ir) + rho_set%drhoa(dir)%array(ia, ir, 1)*dso(ia, jr, dir) + dot_prodb(ia, ir) = dot_prodb(ia, ir) + rho_set%drhob(dir)%array(ia, ir, 1)*dso(ia, jr, dir) END DO !ia END DO !ir !$OMP END DO NOWAIT @@ -2261,7 +2261,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight CALL xc_derivative_get(deriv, deriv_data=d2e) !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na vxc(1)%array(ia, jr) = d2e(ia, ir, 1)*dot_proda(ia, ir) END DO !ia @@ -2273,9 +2273,9 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight CALL xc_derivative_get(deriv, deriv_data=d2e) !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na - vxc(1)%array(ia, jr) = vxc(1)%array(ia, jr)+d2e(ia, ir, 1)*dot_prodb(ia, ir) + vxc(1)%array(ia, jr) = vxc(1)%array(ia, jr) + d2e(ia, ir, 1)*dot_prodb(ia, ir) END DO !ia END DO !ir !$OMP END DO NOWAIT @@ -2283,7 +2283,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight !Vxc, take the grid weight into acocunt !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na vxc(1)%array(ia, jr) = vxc(1)%array(ia, jr)*weight(ia, ir) END DO !ia @@ -2295,7 +2295,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight CALL xc_derivative_get(deriv, deriv_data=d2e) !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na tmp(ia, ir) = d2e(ia, ir, 1)*so(ia, jr) END DO !ia @@ -2308,7 +2308,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight !$OMP DO SCHEDULE(STATIC) DO ir = sr, er DO ia = 1, na - tmp(ia, ir) = tmp(ia, ir)+d2e(ia, ir, 1)*dot_prodb(ia, ir) + tmp(ia, ir) = tmp(ia, ir) + d2e(ia, ir, 1)*dot_prodb(ia, ir) END DO !ia END DO !ir !$OMP END DO NOWAIT @@ -2319,7 +2319,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight !$OMP DO SCHEDULE(STATIC) DO ir = sr, er DO ia = 1, na - tmp(ia, ir) = tmp(ia, ir)+d2e(ia, ir, 1)*dot_proda(ia, ir) + tmp(ia, ir) = tmp(ia, ir) + d2e(ia, ir, 1)*dot_proda(ia, ir) END DO !ia END DO !ir !$OMP END DO NOWAIT @@ -2330,7 +2330,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight !$OMP DO SCHEDULE(STATIC) DO ir = sr, er DO ia = 1, na - tmp(ia, ir) = tmp(ia, ir)-d1e(ia, ir, 1)*dot_proda(ia, ir) & + tmp(ia, ir) = tmp(ia, ir) - d1e(ia, ir, 1)*dot_proda(ia, ir) & /MAX(norm_drhoa(ia, ir, 1), rho_set%drho_cutoff)**2 END DO !ia END DO !ir @@ -2340,7 +2340,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight DO dir = 1, 3 !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na vxg(1)%array(ia, jr, dir) = tmp(ia, ir)*rho_set%drhoa(dir)%array(ia, ir, 1) END DO !ia @@ -2353,7 +2353,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight CALL xc_derivative_get(deriv, deriv_data=d2e) !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na tmp(ia, ir) = d2e(ia, ir, 1)*so(ia, jr) END DO !ia @@ -2366,7 +2366,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight !$OMP DO SCHEDULE(STATIC) DO ir = sr, er DO ia = 1, na - tmp(ia, ir) = tmp(ia, ir)+d2e(ia, ir, 1)*dot_proda(ia, ir) + tmp(ia, ir) = tmp(ia, ir) + d2e(ia, ir, 1)*dot_proda(ia, ir) END DO !ia END DO !ir !$OMP END DO NOWAIT @@ -2377,7 +2377,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight !$OMP DO SCHEDULE(STATIC) DO ir = sr, er DO ia = 1, na - tmp(ia, ir) = tmp(ia, ir)+d2e(ia, ir, 1)*dot_prodb(ia, ir) + tmp(ia, ir) = tmp(ia, ir) + d2e(ia, ir, 1)*dot_prodb(ia, ir) END DO !ia END DO !ir !$OMP END DO NOWAIT @@ -2386,9 +2386,9 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight DO dir = 1, 3 !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na - vxg(1)%array(ia, jr, dir) = vxg(1)%array(ia, jr, dir)+tmp(ia, ir)*rho_set%drhob(dir)%array(ia, ir, 1) + vxg(1)%array(ia, jr, dir) = vxg(1)%array(ia, jr, dir) + tmp(ia, ir)*rho_set%drhob(dir)%array(ia, ir, 1) END DO !ia END DO !ir !$OMP END DO NOWAIT @@ -2400,9 +2400,9 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight DO dir = 1, 3 !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na - vxg(1)%array(ia, jr, dir) = vxg(1)%array(ia, jr, dir)+d1e(ia, ir, 1)*dso(ia, jr, dir) + vxg(1)%array(ia, jr, dir) = vxg(1)%array(ia, jr, dir) + d1e(ia, ir, 1)*dso(ia, jr, dir) END DO !ia END DO !ir !$OMP END DO NOWAIT @@ -2412,7 +2412,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight DO dir = 1, 3 !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na vxg(1)%array(ia, jr, dir) = vxg(1)%array(ia, jr, dir)*weight(ia, ir) END DO !ia @@ -2427,7 +2427,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight CALL xc_derivative_get(deriv, deriv_data=d2e) !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na vxc(2)%array(ia, jr) = d2e(ia, ir, 1)*dot_prodb(ia, ir) END DO !ia @@ -2439,9 +2439,9 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight CALL xc_derivative_get(deriv, deriv_data=d2e) !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na - vxc(2)%array(ia, jr) = vxc(2)%array(ia, jr)+d2e(ia, ir, 1)*dot_proda(ia, ir) + vxc(2)%array(ia, jr) = vxc(2)%array(ia, jr) + d2e(ia, ir, 1)*dot_proda(ia, ir) END DO !ia END DO !ir !$OMP END DO NOWAIT @@ -2449,7 +2449,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight !Vxc, take the grid weight into acocunt !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na vxc(2)%array(ia, jr) = vxc(2)%array(ia, jr)*weight(ia, ir) END DO !ia @@ -2461,7 +2461,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight CALL xc_derivative_get(deriv, deriv_data=d2e) !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na tmp(ia, ir) = d2e(ia, ir, 1)*so(ia, jr) END DO !ia @@ -2474,7 +2474,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight !$OMP DO SCHEDULE(STATIC) DO ir = sr, er DO ia = 1, na - tmp(ia, ir) = tmp(ia, ir)+d2e(ia, ir, 1)*dot_proda(ia, ir) + tmp(ia, ir) = tmp(ia, ir) + d2e(ia, ir, 1)*dot_proda(ia, ir) END DO !ia END DO !ir !$OMP END DO NOWAIT @@ -2485,7 +2485,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight !$OMP DO SCHEDULE(STATIC) DO ir = sr, er DO ia = 1, na - tmp(ia, ir) = tmp(ia, ir)+d2e(ia, ir, 1)*dot_prodb(ia, ir) + tmp(ia, ir) = tmp(ia, ir) + d2e(ia, ir, 1)*dot_prodb(ia, ir) END DO !ia END DO !ir !$OMP END DO NOWAIT @@ -2494,7 +2494,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight DO dir = 1, 3 !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na vxg(2)%array(ia, jr, dir) = tmp(ia, ir)*rho_set%drhoa(dir)%array(ia, ir, 1) END DO !ia @@ -2507,7 +2507,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight CALL xc_derivative_get(deriv, deriv_data=d2e) !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na tmp(ia, ir) = d2e(ia, ir, 1)*so(ia, jr) END DO !ia @@ -2520,7 +2520,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight !$OMP DO SCHEDULE(STATIC) DO ir = sr, er DO ia = 1, na - tmp(ia, ir) = tmp(ia, ir)+d2e(ia, ir, 1)*dot_prodb(ia, ir) + tmp(ia, ir) = tmp(ia, ir) + d2e(ia, ir, 1)*dot_prodb(ia, ir) END DO !ia END DO !ir !$OMP END DO NOWAIT @@ -2531,7 +2531,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight !$OMP DO SCHEDULE(STATIC) DO ir = sr, er DO ia = 1, na - tmp(ia, ir) = tmp(ia, ir)+d2e(ia, ir, 1)*dot_proda(ia, ir) + tmp(ia, ir) = tmp(ia, ir) + d2e(ia, ir, 1)*dot_proda(ia, ir) END DO !ia END DO !ir !$OMP END DO NOWAIT @@ -2540,9 +2540,9 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight DO dir = 1, 3 !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na - vxg(2)%array(ia, jr, dir) = vxg(2)%array(ia, jr, dir)+tmp(ia, ir)*rho_set%drhob(dir)%array(ia, ir, 1) + vxg(2)%array(ia, jr, dir) = vxg(2)%array(ia, jr, dir) + tmp(ia, ir)*rho_set%drhob(dir)%array(ia, ir, 1) END DO END DO !$OMP END DO NOWAIT @@ -2554,9 +2554,9 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight DO dir = 1, 3 !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na - vxg(2)%array(ia, jr, dir) = vxg(2)%array(ia, jr, dir)+d1e(ia, ir, 1)*dso(ia, jr, dir) + vxg(2)%array(ia, jr, dir) = vxg(2)%array(ia, jr, dir) + d1e(ia, ir, 1)*dso(ia, jr, dir) END DO !ia END DO !ir !$OMP END DO NOWAIT @@ -2566,7 +2566,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight DO dir = 1, 3 !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na vxg(2)%array(ia, jr, dir) = vxg(2)%array(ia, jr, dir)*weight(ia, ir) END DO !ia @@ -2582,7 +2582,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight CALL xc_derivative_get(deriv, deriv_data=d2e) !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na vxc(3)%array(ia, jr) = d2e(ia, ir, 1)*dot_prodb(ia, ir) END DO !ia @@ -2594,9 +2594,9 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight CALL xc_derivative_get(deriv, deriv_data=d2e) !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na - vxc(3)%array(ia, jr) = vxc(3)%array(ia, jr)+d2e(ia, ir, 1)*dot_proda(ia, ir) + vxc(3)%array(ia, jr) = vxc(3)%array(ia, jr) + d2e(ia, ir, 1)*dot_proda(ia, ir) END DO !i END DO !ir !$OMP END DO NOWAIT @@ -2604,7 +2604,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight !Vxc, take the grid weight into acocunt !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na vxc(3)%array(ia, jr) = vxc(3)%array(ia, jr)*weight(ia, ir) END DO !ia @@ -2616,7 +2616,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight CALL xc_derivative_get(deriv, deriv_data=d2e) !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na tmp(ia, ir) = d2e(ia, ir, 1)*so(ia, jr) END DO !ia @@ -2629,7 +2629,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight !$OMP DO SCHEDULE(STATIC) DO ir = sr, er DO ia = 1, na - tmp(ia, ir) = tmp(ia, ir)+d2e(ia, ir, 1)*dot_proda(ia, ir) + tmp(ia, ir) = tmp(ia, ir) + d2e(ia, ir, 1)*dot_proda(ia, ir) END DO !ia END DO !ir !$OMP END DO NOWAIT @@ -2640,7 +2640,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight !$OMP DO SCHEDULE(STATIC) DO ir = sr, er DO ia = 1, na - tmp(ia, ir) = tmp(ia, ir)+d2e(ia, ir, 1)*dot_prodb(ia, ir) + tmp(ia, ir) = tmp(ia, ir) + d2e(ia, ir, 1)*dot_prodb(ia, ir) END DO !ia END DO !ir !$OMP END DO NOWAIT @@ -2651,7 +2651,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight !$OMP DO SCHEDULE(STATIC) DO ir = sr, er DO ia = 1, na - tmp(ia, ir) = tmp(ia, ir)-d1e(ia, ir, 1)*dot_prodb(ia, ir) & + tmp(ia, ir) = tmp(ia, ir) - d1e(ia, ir, 1)*dot_prodb(ia, ir) & /MAX(norm_drhob(ia, ir, 1), rho_set%drho_cutoff)**2 END DO !ia END DO !ir @@ -2661,7 +2661,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight DO dir = 1, 3 !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na vxg(3)%array(ia, jr, dir) = tmp(ia, ir)*rho_set%drhob(dir)%array(ia, ir, 1) END DO !ia @@ -2674,7 +2674,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight CALL xc_derivative_get(deriv, deriv_data=d2e) !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na tmp(ia, ir) = d2e(ia, ir, 1)*so(ia, jr) END DO !ia @@ -2687,7 +2687,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight !$OMP DO SCHEDULE(STATIC) DO ir = sr, er DO ia = 1, na - tmp(ia, ir) = tmp(ia, ir)+d2e(ia, ir, 1)*dot_prodb(ia, ir) + tmp(ia, ir) = tmp(ia, ir) + d2e(ia, ir, 1)*dot_prodb(ia, ir) END DO !ia END DO !ir !$OMP END DO NOWAIT @@ -2698,7 +2698,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight !$OMP DO SCHEDULE(STATIC) DO ir = sr, er DO ia = 1, na - tmp(ia, ir) = tmp(ia, ir)+d2e(ia, ir, 1)*dot_proda(ia, ir) + tmp(ia, ir) = tmp(ia, ir) + d2e(ia, ir, 1)*dot_proda(ia, ir) END DO !ia END DO !ir !$OMP END DO NOWAIT @@ -2707,9 +2707,9 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight DO dir = 1, 3 !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na - vxg(3)%array(ia, jr, dir) = vxg(3)%array(ia, jr, dir)+tmp(ia, ir)*rho_set%drhoa(dir)%array(ia, ir, 1) + vxg(3)%array(ia, jr, dir) = vxg(3)%array(ia, jr, dir) + tmp(ia, ir)*rho_set%drhoa(dir)%array(ia, ir, 1) END DO !ia END DO !ir !$OMP END DO NOWAIT @@ -2721,9 +2721,9 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight DO dir = 1, 3 !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na - vxg(3)%array(ia, jr, dir) = vxg(3)%array(ia, jr, dir)+d1e(ia, ir, 1)*dso(ia, jr, dir) + vxg(3)%array(ia, jr, dir) = vxg(3)%array(ia, jr, dir) + d1e(ia, ir, 1)*dso(ia, jr, dir) END DO !ia END DO !ir !$OMP END DO NOWAIT @@ -2733,7 +2733,7 @@ SUBROUTINE get_vxc_vxg(vxc, vxg, so, dso, na, sr, er, rho_set, deriv_set, weight DO dir = 1, 3 !$OMP DO SCHEDULE(STATIC) DO ir = sr, er - jr = ir-sr+1 + jr = ir - sr + 1 DO ia = 1, na vxg(3)%array(ia, jr, dir) = vxg(3)%array(ia, jr, dir)*weight(ia, ir) END DO !ia @@ -2789,7 +2789,7 @@ SUBROUTINE integrate_sc_fxc(int_fxc, iatom, ikind, deriv_set, bounds, xas_atom_e grid_atom => xas_atom_env%grid_atom_set(ikind)%grid_atom na = grid_atom%ng_sphere sr = bounds(1, 2); er = bounds(2, 2) - nr = er-er+1 + nr = er - er + 1 CALL get_qs_kind(qs_kind_set(ikind), basis_set=ri_basis, basis_type="RI_XAS") CALL get_gto_basis_set(ri_basis, nset=nset, maxso=maxso, nsgf=ri_nsgf) nsotot = nset*maxso @@ -2870,7 +2870,7 @@ SUBROUTINE integrate_sf_fxc(int_fxc, iatom, ikind, rho_set, deriv_set, bounds, x grid_atom => xas_atom_env%grid_atom_set(ikind)%grid_atom na = grid_atom%ng_sphere sr = bounds(1, 2); er = bounds(2, 2) - nr = er-sr+1 + nr = er - sr + 1 CALL get_qs_kind(qs_kind_set(ikind), basis_set=ri_basis, basis_type="RI_XAS") CALL get_gto_basis_set(ri_basis, nset=nset, maxso=maxso, nsgf=ri_nsgf) nsotot = nset*maxso @@ -2903,12 +2903,12 @@ SUBROUTINE integrate_sf_fxc(int_fxc, iatom, ikind, rho_set, deriv_set, bounds, x !Need to be careful not to devide by zero. Assume that if rhoa == rhob, then !take the limit fxc = 0.5* (f_aa + f_bb - 2f_ab) - IF (ABS(rhoa(ia, ir, 1)-rhob(ia, ir, 1)) > dft_control%qs_control%eps_rho_rspace) THEN - fxc(ia, ir) = grid_atom%weight(ia, ir)/(rhoa(ia, ir, 1)-rhob(ia, ir, 1)) & - *(d1e(1)%array(ia, ir, 1)-d1e(2)%array(ia, ir, 1)) + IF (ABS(rhoa(ia, ir, 1) - rhob(ia, ir, 1)) > dft_control%qs_control%eps_rho_rspace) THEN + fxc(ia, ir) = grid_atom%weight(ia, ir)/(rhoa(ia, ir, 1) - rhob(ia, ir, 1)) & + *(d1e(1)%array(ia, ir, 1) - d1e(2)%array(ia, ir, 1)) ELSE fxc(ia, ir) = 0.5_dp*grid_atom%weight(ia, ir)* & - (d2e(1)%array(ia, ir, 1)+d2e(3)%array(ia, ir, 1)-2._dp*d2e(2)%array(ia, ir, 1)) + (d2e(1)%array(ia, ir, 1) + d2e(3)%array(ia, ir, 1) - 2._dp*d2e(2)%array(ia, ir, 1)) END IF END DO @@ -2953,17 +2953,17 @@ SUBROUTINE contract_so2sgf(int_sgf, int_so, basis, sphi_so) npgf=npgf, lmax=lmax) DO iset = 1, nset - starti = (iset-1)*maxso+1 + starti = (iset - 1)*maxso + 1 nsoi = npgf(iset)*nsoset(lmax(iset)) sgfi = first_sgf(1, iset) DO jset = 1, nset - startj = (jset-1)*maxso+1 + startj = (jset - 1)*maxso + 1 nsoj = npgf(jset)*nsoset(lmax(jset)) sgfj = first_sgf(1, jset) - CALL ab_contract(int_sgf(sgfi:sgfi+nsgf_set(iset)-1, sgfj:sgfj+nsgf_set(jset)-1), & - int_so(starti:starti+nsoi-1, startj:startj+nsoj-1), & + CALL ab_contract(int_sgf(sgfi:sgfi + nsgf_set(iset) - 1, sgfj:sgfj + nsgf_set(jset) - 1), & + int_so(starti:starti + nsoi - 1, startj:startj + nsoj - 1), & sphi_so(:, sgfi:), sphi_so(:, sgfj:), nsoi, nsoj, & nsgf_set(iset), nsgf_set(jset)) END DO !jset @@ -3026,7 +3026,7 @@ SUBROUTINE integrate_so_prod(intso, fxc, ikind, bounds, xas_atom_env, qs_env) na = grid_atom%ng_sphere sr = bounds(1, 2); er = bounds(2, 2) - nr = er-sr+1 + nr = er - sr + 1 my_CG => harmonics%my_CG max_iso_not0 = harmonics%max_iso_not0 max_s_harm = harmonics%max_s_harm @@ -3046,23 +3046,23 @@ SUBROUTINE integrate_so_prod(intso, fxc, ikind, bounds, xas_atom_env, qs_env) m2 = 0 DO iset2 = 1, nset CALL get_none0_cg_list(my_CG, lmin(iset1), lmax(iset1), lmin(iset2), lmax(iset2), & - max_s_harm, lmax(iset1)+lmax(iset2), cg_list, cg_n_list, & + max_s_harm, lmax(iset1) + lmax(iset2), cg_list, cg_n_list, & max_iso_not0_local) CPASSERT(max_iso_not0_local .LE. max_iso_not0) n2 = nsoset(lmax(iset2)) DO ipgf1 = 1, npgf(iset1) - ngau1 = n1*(ipgf1-1)+m1 - size1 = nsoset(lmax(iset1))-nsoset(lmin(iset1)-1) - nngau1 = nsoset(lmin(iset1)-1)+ngau1 + ngau1 = n1*(ipgf1 - 1) + m1 + size1 = nsoset(lmax(iset1)) - nsoset(lmin(iset1) - 1) + nngau1 = nsoset(lmin(iset1) - 1) + ngau1 g1(:) = EXP(-zet(ipgf1, iset1)*grid_atom%rad2(sr:er)) DO ipgf2 = 1, npgf(iset2) - ngau2 = n2*(ipgf2-1)+m2 + ngau2 = n2*(ipgf2 - 1) + m2 g2(:) = EXP(-zet(ipgf2, iset2)*grid_atom%rad2(sr:er)) - lmin12 = lmin(iset1)+lmin(iset2) - lmax12 = lmax(iset1)+lmax(iset2) + lmin12 = lmin(iset1) + lmin(iset2) + lmax12 = lmax(iset1) + lmax(iset2) !get the gaussian product gg = 0.0_dp @@ -3072,11 +3072,11 @@ SUBROUTINE integrate_so_prod(intso, fxc, ikind, bounds, xas_atom_env, qs_env) gg(:, lmin12) = grid_atom%rad2l(sr:er, lmin12)*g1(:)*g2(:) END IF - DO l = lmin12+1, lmax12 - gg(:, l) = grid_atom%rad(sr:er)*gg(:, l-1) + DO l = lmin12 + 1, lmax12 + gg(:, l) = grid_atom%rad(sr:er)*gg(:, l - 1) END DO - ld = lmax12+1 + ld = lmax12 + 1 CALL dgemm('N', 'N', na, ld, nr, 1.0_dp, fxc(1:na, 1:nr), na, gg(:, 0:lmax12), & nr, 0.0_dp, gfxcg(1:na, 0:lmax12), na) @@ -3086,27 +3086,27 @@ SUBROUTINE integrate_so_prod(intso, fxc, ikind, bounds, xas_atom_env, qs_env) DO icg = 1, cg_n_list(iso) iso1 = cg_list(1, icg, iso) iso2 = cg_list(2, icg, iso) - l = indso(1, iso1)+indso(1, iso2) + l = indso(1, iso1) + indso(1, iso2) DO ia = 1, na - matso(iso1, iso2) = matso(iso1, iso2)+gfxcg(ia, l)* & + matso(iso1, iso2) = matso(iso1, iso2) + gfxcg(ia, l)* & my_CG(iso1, iso2, iso)*harmonics%slm(ia, iso) END DO !ia END DO !icg END DO !iso !write in integral matrix - DO ic = nsoset(lmin(iset2)-1)+1, nsoset(lmax(iset2)) - iso1 = nsoset(lmin(iset1)-1)+1 - iso2 = ngau2+ic - CALL daxpy(size1, 1.0_dp, matso(iso1, ic), 1, intso(nngau1+1, iso2), 1) + DO ic = nsoset(lmin(iset2) - 1) + 1, nsoset(lmax(iset2)) + iso1 = nsoset(lmin(iset1) - 1) + 1 + iso2 = ngau2 + ic + CALL daxpy(size1, 1.0_dp, matso(iso1, ic), 1, intso(nngau1 + 1, iso2), 1) END DO !ic END DO !ipgf2 END DO ! ipgf1 - m2 = m2+maxso + m2 = m2 + maxso END DO !iset2 - m1 = m1+maxso + m1 = m1 + maxso END DO !iset1 CALL timestop(handle) @@ -3178,26 +3178,26 @@ SUBROUTINE integrate_so_dxdy_prod(intso, V, ikind, xas_atom_env, qs_env) DO iset = 1, nset DO ipgf = 1, npgf(iset) - starti = (iset-1)*maxso+(ipgf-1)*nsoset(lmax(iset)) - DO iso = nsoset(lmin(iset)-1)+1, nsoset(lmax(iset)) + starti = (iset - 1)*maxso + (ipgf - 1)*nsoset(lmax(iset)) + DO iso = nsoset(lmin(iset) - 1) + 1, nsoset(lmax(iset)) l = indso(1, iso) ! The x derivitive of the spherical orbital, divided in angular and radial parts ! Two of each are needed because d/dx(r^l Y_lm) * exp(-al*r^2) + r^l Y_lm * ! d/dx(exp-al*r^2) ! the purely radial part of d/dx(r^l Y_lm) * exp(-al*r^2) (same for y) - r1(1:nr, starti+iso) = grid_atom%rad(1:nr)**(l-1)*EXP(-zet(ipgf, iset)*grid_atom%rad2(1:nr)) + r1(1:nr, starti + iso) = grid_atom%rad(1:nr)**(l - 1)*EXP(-zet(ipgf, iset)*grid_atom%rad2(1:nr)) ! the purely radial part of r^l Y_lm * d/dx(exp-al*r^2) (same for y) - r2(1:nr, starti+iso) = -2.0_dp*zet(ipgf, iset)*grid_atom%rad(1:nr)**(l+1) & - *EXP(-zet(ipgf, iset)*grid_atom%rad2(1:nr)) + r2(1:nr, starti + iso) = -2.0_dp*zet(ipgf, iset)*grid_atom%rad(1:nr)**(l + 1) & + *EXP(-zet(ipgf, iset)*grid_atom%rad2(1:nr)) DO i = 1, 3 ! the purely angular part of d/dx(r^l Y_lm) * exp(-al*r^2) - a1(1:na, starti+iso, i) = dslm_dxyz(i, 1:na, iso) + a1(1:na, starti + iso, i) = dslm_dxyz(i, 1:na, iso) ! the purely angular part of r^l Y_lm * d/dx(exp-al*r^2) - a2(1:na, starti+iso, i) = harmonics%a(i, 1:na)*slm(1:na, iso) + a2(1:na, starti + iso, i) = harmonics%a(i, 1:na)*slm(1:na, iso) END DO END DO !iso @@ -3214,50 +3214,50 @@ SUBROUTINE integrate_so_dxdy_prod(intso, V, ikind, xas_atom_env, qs_env) DO iset = 1, nset DO jset = 1, nset DO ipgf = 1, npgf(iset) - starti = (iset-1)*maxso+(ipgf-1)*nsoset(lmax(iset)) + starti = (iset - 1)*maxso + (ipgf - 1)*nsoset(lmax(iset)) DO jpgf = 1, npgf(jset) - startj = (jset-1)*maxso+(jpgf-1)*nsoset(lmax(jset)) + startj = (jset - 1)*maxso + (jpgf - 1)*nsoset(lmax(jset)) DO i = 1, 3 - j = MOD(i, 3)+1 - k = MOD(i+1, 3)+1 + j = MOD(i, 3) + 1 + k = MOD(i + 1, 3) + 1 - DO iso = nsoset(lmin(iset)-1)+1, nsoset(lmax(iset)) - DO jso = nsoset(lmin(jset)-1)+1, nsoset(lmax(jset)) + DO iso = nsoset(lmin(iset) - 1) + 1, nsoset(lmax(iset)) + DO jso = nsoset(lmin(jset) - 1) + 1, nsoset(lmax(jset)) !Two component per function => 4 terms in total ! take r1*a1(j) * V * r1*a1(k) - fgr(1:nr, 1) = r1(1:nr, starti+iso)*r1(1:nr, startj+jso) - fga(1:na, 1) = a1(1:na, starti+iso, j)*a1(1:na, startj+jso, k) + fgr(1:nr, 1) = r1(1:nr, starti + iso)*r1(1:nr, startj + jso) + fga(1:na, 1) = a1(1:na, starti + iso, j)*a1(1:na, startj + jso, k) CALL dgemm('N', 'N', na, 1, nr, 1.0_dp, V, na, fgr, nr, 0.0_dp, work, na) CALL dgemm('T', 'N', 1, 1, na, 1.0_dp, work, na, fga, na, 0.0_dp, & - intso(starti+iso, startj+jso, i), 1) + intso(starti + iso, startj + jso, i), 1) ! add r1*a1(j) * V * r2*a2(k) - fgr(1:nr, 1) = r1(1:nr, starti+iso)*r2(1:nr, startj+jso) - fga(1:na, 1) = a1(1:na, starti+iso, j)*a2(1:na, startj+jso, k) + fgr(1:nr, 1) = r1(1:nr, starti + iso)*r2(1:nr, startj + jso) + fga(1:na, 1) = a1(1:na, starti + iso, j)*a2(1:na, startj + jso, k) CALL dgemm('N', 'N', na, 1, nr, 1.0_dp, V, na, fgr, nr, 0.0_dp, work, na) CALL dgemm('T', 'N', 1, 1, na, 1.0_dp, work, na, fga, na, 1.0_dp, & - intso(starti+iso, startj+jso, i), 1) + intso(starti + iso, startj + jso, i), 1) ! add r2*a2(j) * V * r1*a1(k) - fgr(1:nr, 1) = r2(1:nr, starti+iso)*r1(1:nr, startj+jso) - fga(1:na, 1) = a2(1:na, starti+iso, j)*a1(1:na, startj+jso, k) + fgr(1:nr, 1) = r2(1:nr, starti + iso)*r1(1:nr, startj + jso) + fga(1:na, 1) = a2(1:na, starti + iso, j)*a1(1:na, startj + jso, k) CALL dgemm('N', 'N', na, 1, nr, 1.0_dp, V, na, fgr, nr, 0.0_dp, work, na) CALL dgemm('T', 'N', 1, 1, na, 1.0_dp, work, na, fga, na, 1.0_dp, & - intso(starti+iso, startj+jso, i), 1) + intso(starti + iso, startj + jso, i), 1) ! add the last term: r2*a2(j) * V * r2*a2(k) - fgr(1:nr, 1) = r2(1:nr, starti+iso)*r2(1:nr, startj+jso) - fga(1:na, 1) = a2(1:na, starti+iso, j)*a2(1:na, startj+jso, k) + fgr(1:nr, 1) = r2(1:nr, starti + iso)*r2(1:nr, startj + jso) + fga(1:na, 1) = a2(1:na, starti + iso, j)*a2(1:na, startj + jso, k) CALL dgemm('N', 'N', na, 1, nr, 1.0_dp, V, na, fgr, nr, 0.0_dp, work, na) CALL dgemm('T', 'N', 1, 1, na, 1.0_dp, work, na, fga, na, 1.0_dp, & - intso(starti+iso, startj+jso, i), 1) + intso(starti + iso, startj + jso, i), 1) END DO !jso END DO !iso @@ -3269,7 +3269,7 @@ SUBROUTINE integrate_so_dxdy_prod(intso, V, ikind, xas_atom_env, qs_env) END DO !iset DO i = 1, 3 - intso(:, :, i) = intso(:, :, i)-TRANSPOSE(intso(:, :, i)) + intso(:, :, i) = intso(:, :, i) - TRANSPOSE(intso(:, :, i)) END DO END SUBROUTINE integrate_so_dxdy_prod @@ -3337,7 +3337,7 @@ SUBROUTINE integrate_soc_atoms(matrix_soc, xas_atom_env, qs_env) ALLOCATE (V(na, nr)) V = 0.0_dp DO ir = 1, nr - CALL daxpy(na, Vr(ir)/(4.0_dp*c_light_au**2-2.0_dp*Vr(ir)), grid%weight(1:na, ir), 1, & + CALL daxpy(na, Vr(ir)/(4.0_dp*c_light_au**2 - 2.0_dp*Vr(ir)), grid%weight(1:na, ir), 1, & V(1:na, ir), 1) END DO DEALLOCATE (Vr) diff --git a/src/xas_tdp_kernel.F b/src/xas_tdp_kernel.F index d8dd40548c..5901775583 100644 --- a/src/xas_tdp_kernel.F +++ b/src/xas_tdp_kernel.F @@ -144,10 +144,10 @@ SUBROUTINE kernel_coulomb_xc(coul_ker, xc_ker, donor_state, xas_tdp_env, xas_tdp CALL get_qs_env(qs_env, para_env=para_env) found = .FALSE. nbatch = para_env%num_pe/xas_tdp_control%batch_size - IF (nbatch*xas_tdp_control%batch_size .NE. para_env%num_pe) nbatch = nbatch+1 + IF (nbatch*xas_tdp_control%batch_size .NE. para_env%num_pe) nbatch = nbatch + 1 nex_atom = SIZE(xas_tdp_env%ex_atom_indices) - DO ibatch = 0, nbatch-1 + DO ibatch = 0, nbatch - 1 bo = get_limit(nex_atom, nbatch, ibatch) DO iex = bo(1), bo(2) @@ -331,16 +331,16 @@ SUBROUTINE sc_os_xc(xc_ker, contr1_int_PQ, dist, blk_size, donor_state, xas_tdp_ !Copy the alpha part into LHS, multiply by the alpha-beta kernel and the beta part of RHS CALL copy_ri_contr_int(lhs_int(1:ndo_mo), rhs_int(1:ndo_mo)) CALL ri_all_blocks_mm(lhs_int(1:ndo_mo), xas_tdp_env%ri_fxc(ri_atom, 2)%array) - CALL ri_int_product(work_mat, lhs_int(1:ndo_mo), rhs_int(ndo_mo+1:2*ndo_mo), & + CALL ri_int_product(work_mat, lhs_int(1:ndo_mo), rhs_int(ndo_mo + 1:2*ndo_mo), & quadrants, qs_env, eps_filter=xas_tdp_control%eps_filter) ! beta-beta spin quadrant (lower-right) quadrants = [.FALSE., .FALSE., .TRUE.] !Copy the beta part into LHS, multiply by the beta-beta kernel and the beta part of RHS - CALL copy_ri_contr_int(lhs_int(ndo_mo+1:2*ndo_mo), rhs_int(ndo_mo+1:2*ndo_mo)) - CALL ri_all_blocks_mm(lhs_int(ndo_mo+1:2*ndo_mo), xas_tdp_env%ri_fxc(ri_atom, 3)%array) - CALL ri_int_product(work_mat, lhs_int(ndo_mo+1:2*ndo_mo), rhs_int(ndo_mo+1:2*ndo_mo), & + CALL copy_ri_contr_int(lhs_int(ndo_mo + 1:2*ndo_mo), rhs_int(ndo_mo + 1:2*ndo_mo)) + CALL ri_all_blocks_mm(lhs_int(ndo_mo + 1:2*ndo_mo), xas_tdp_env%ri_fxc(ri_atom, 3)%array) + CALL ri_int_product(work_mat, lhs_int(ndo_mo + 1:2*ndo_mo), rhs_int(ndo_mo + 1:2*ndo_mo), & quadrants, qs_env, eps_filter=xas_tdp_control%eps_filter) ELSE IF (xas_tdp_control%do_roks) THEN @@ -454,7 +454,7 @@ SUBROUTINE ondiag_sf_os_xc(xc_ker, contr1_int_PQ, dist, blk_size, donor_state, x ! beta-beta spin quadrant (lower-right) quadrants = [.FALSE., .FALSE., .TRUE.] - CALL ri_int_product(work_mat, lhs_int(ndo_mo+1:2*ndo_mo), rhs_int(ndo_mo+1:2*ndo_mo), & + CALL ri_int_product(work_mat, lhs_int(ndo_mo + 1:2*ndo_mo), rhs_int(ndo_mo + 1:2*ndo_mo), & quadrants, qs_env, eps_filter=xas_tdp_control%eps_filter) ELSE IF (xas_tdp_control%do_roks) THEN @@ -782,13 +782,13 @@ SUBROUTINE ondiag_ex(ondiag_ex_ker, contr1_int, dist, blk_size, donor_state, xas CALL dbcsr_get_block_p(abIJ_desymm_std_dist, iblk, jblk, pblock, found) IF (found) THEN - CALL dbcsr_put_block(work_mat, (iso-1)*nblk+iblk, (jso-1)*nblk+jblk, pblock) + CALL dbcsr_put_block(work_mat, (iso - 1)*nblk + iblk, (jso - 1)*nblk + jblk, pblock) !In case of ROKS, we have (ab|IJ) for alpha-alpha spin, but it is the same for !beta-beta => replicate the blocks (alpha-beta is zero) IF (do_roks) THEN !the beta-beta block - CALL dbcsr_put_block(work_mat, (ndo_so+iso-1)*nblk+iblk, (ndo_so+jso-1)*nblk+jblk, pblock) + CALL dbcsr_put_block(work_mat, (ndo_so + iso - 1)*nblk + iblk, (ndo_so + jso - 1)*nblk + jblk, pblock) END IF END IF @@ -885,7 +885,7 @@ SUBROUTINE offdiag_ex_sc(offdiag_ex_ker, contr1_int, dist, blk_size, donor_state qs_env, eps_filter=xas_tdp_control%eps_filter, mo_transpose=.TRUE.) quadrants = [.FALSE., .FALSE., .TRUE.] - CALL ri_int_product(work_mat, lhs_int(ndo_mo+1:2*ndo_mo), rhs_int(ndo_mo+1:2*ndo_mo), & + CALL ri_int_product(work_mat, lhs_int(ndo_mo + 1:2*ndo_mo), rhs_int(ndo_mo + 1:2*ndo_mo), & quadrants, qs_env, eps_filter=xas_tdp_control%eps_filter, mo_transpose=.TRUE.) ELSE !In the restricted closed-shell case, only have one spin and a single qudarant @@ -1022,9 +1022,9 @@ SUBROUTINE contract_o3c_int(contr_int, op_type, donor_state, xas_tdp_env, xas_td ! do the contraction CALL dbcsr_set(aI_P, 0.0_dp); CALL dbcsr_set(P_Ib, 0.0_dp) IF (my_op == "C") THEN - CALL contract_o3c_once(o3c_coul, coeffs(:, (ispin-1)*ndo_mo+imo), aI_P, P_Ib, katom) + CALL contract_o3c_once(o3c_coul, coeffs(:, (ispin - 1)*ndo_mo + imo), aI_P, P_Ib, katom) ELSE - CALL contract_o3c_once(o3c_ex, coeffs(:, (ispin-1)*ndo_mo+imo), aI_P, P_Ib, katom) + CALL contract_o3c_once(o3c_ex, coeffs(:, (ispin - 1)*ndo_mo + imo), aI_P, P_Ib, katom) END IF ! Get the full "normal" (aI|P) contracted integrals @@ -1032,7 +1032,7 @@ SUBROUTINE contract_o3c_int(contr_int, op_type, donor_state, xas_tdp_env, xas_td CALL dbcsr_transposed(work3, work2) CALL change_dist(aI_P, work1, para_env) CALL dbcsr_add(work3, work1, 1.0_dp, 1.0_dp) - CALL dbcsr_complete_redistribute(work3, contr_int((ispin-1)*ndo_mo+imo)%matrix) + CALL dbcsr_complete_redistribute(work3, contr_int((ispin - 1)*ndo_mo + imo)%matrix) CALL dbcsr_release(work3) @@ -1084,8 +1084,8 @@ SUBROUTINE change_dist(mat_in, mat_out, para_env) !Allocate a pointer array which will point on the block => we won't need to send more than !nblk**2/num_pe message per processor (assumes blocks well distributed) - ALLOCATE (send_buff(nblk**2/num_pe+1), recv_buff(nblk**2/num_pe+1)) - ALLOCATE (send_req(nblk**2/num_pe+1), recv_req(nblk**2/num_pe+1)) + ALLOCATE (send_buff(nblk**2/num_pe + 1), recv_buff(nblk**2/num_pe + 1)) + ALLOCATE (send_req(nblk**2/num_pe + 1), recv_req(nblk**2/num_pe + 1)) is = 0; ir = 0 !Iterate over input matrix @@ -1107,9 +1107,9 @@ SUBROUTINE change_dist(mat_in, mat_out, para_env) !If block not on the same processor, need to send it CALL dbcsr_get_stored_coordinates(mat_out, iblk, jblk, dest) !unique tag - tag = nblk*iblk+jblk + tag = nblk*iblk + jblk !point on the block such that the buffer is not changed after isend - is = is+1 + is = is + 1 send_buff(is)%array => pbin CALL mp_isend(msgin=send_buff(is)%array, dest=dest, comm=group, request=send_req(is), & tag=tag) @@ -1133,8 +1133,8 @@ SUBROUTINE change_dist(mat_in, mat_out, para_env) !If not, need to receiv it IF (.NOT. found_in) THEN CALL dbcsr_get_stored_coordinates(mat_in, iblk, jblk, source) - tag = nblk*iblk+jblk - ir = ir+1 + tag = nblk*iblk + jblk + ir = ir + 1 recv_buff(ir)%array => pbout CALL mp_irecv(msgout=recv_buff(ir)%array, source=source, request=recv_req(ir), & tag=tag, comm=group) @@ -1515,17 +1515,17 @@ SUBROUTINE ri_int_product(kernel, lhs_int, rhs_int, quadrants, qs_env, eps_filte ! Case study on quadrant !upper-left IF (quadrants(1)) THEN - CALL dbcsr_put_block(kernel, (iso-1)*nblk+iblk, (jso-1)*nblk+jblk, pblock) + CALL dbcsr_put_block(kernel, (iso - 1)*nblk + iblk, (jso - 1)*nblk + jblk, pblock) END IF !upper-right IF (quadrants(2)) THEN - CALL dbcsr_put_block(kernel, (iso-1)*nblk+iblk, (ndo_so+jso-1)*nblk+jblk, pblock) + CALL dbcsr_put_block(kernel, (iso - 1)*nblk + iblk, (ndo_so + jso - 1)*nblk + jblk, pblock) END IF !lower-right IF (quadrants(3)) THEN - CALL dbcsr_put_block(kernel, (ndo_so+iso-1)*nblk+iblk, (ndo_so+jso-1)*nblk+jblk, pblock) + CALL dbcsr_put_block(kernel, (ndo_so + iso - 1)*nblk + iblk, (ndo_so + jso - 1)*nblk + jblk, pblock) END IF END IF diff --git a/src/xas_tdp_methods.F b/src/xas_tdp_methods.F index 353a0a2799..3c0d8f4e6a 100644 --- a/src/xas_tdp_methods.F +++ b/src/xas_tdp_methods.F @@ -473,7 +473,7 @@ SUBROUTINE xas_tdp_core(xas_tdp_section, qs_env) ! Free some unneeded attributes of current_state CALL free_ds_memory(current_state) - current_state_index = current_state_index+1 + current_state_index = current_state_index + 1 NULLIFY (current_state) END DO ! state type @@ -590,8 +590,8 @@ SUBROUTINE xas_tdp_init(xas_tdp_env, xas_tdp_control, qs_env) DO i = 1, nex_atoms at_ind = xas_tdp_env%ex_atom_indices(i) CALL get_atomic_kind(particle_set(at_ind)%atomic_kind, kind_number=j) - IF (ALL(ABS(xas_tdp_env%ex_kind_indices-j) .NE. 0)) THEN - k = k+1 + IF (ALL(ABS(xas_tdp_env%ex_kind_indices - j) .NE. 0)) THEN + k = k + 1 xas_tdp_env%ex_kind_indices(k) = j END IF END DO @@ -614,8 +614,8 @@ SUBROUTINE xas_tdp_init(xas_tdp_env, xas_tdp_control, qs_env) CALL get_atomic_kind(atomic_kind=at_kind_set(i), name=kind_name, & natom=nat_of_kind, kind_number=kind_ind) IF (ANY(xas_tdp_control%list_ex_kinds == kind_name)) THEN - nex_atoms = nex_atoms+nat_of_kind - k = k+1 + nex_atoms = nex_atoms + nat_of_kind + k = k + 1 xas_tdp_env%ex_kind_indices(k) = kind_ind END IF END DO @@ -630,13 +630,13 @@ SUBROUTINE xas_tdp_init(xas_tdp_env, xas_tdp_control, qs_env) natom=nat_of_kind, atom_list=ind_of_kind) DO j = 1, nex_kinds IF (xas_tdp_control%list_ex_kinds(j) == kind_name) THEN - xas_tdp_env%ex_atom_indices(nex_atoms+1:nex_atoms+nat_of_kind) = ind_of_kind + xas_tdp_env%ex_atom_indices(nex_atoms + 1:nex_atoms + nat_of_kind) = ind_of_kind DO k = 1, SIZE(xas_tdp_control%state_types, 1) - xas_tdp_env%state_types(k, nex_atoms+1:nex_atoms+nat_of_kind) = & + xas_tdp_env%state_types(k, nex_atoms + 1:nex_atoms + nat_of_kind) = & xas_tdp_control%state_types(k, j) END DO - nex_atoms = nex_atoms+nat_of_kind - nmatch = nmatch+1 + nex_atoms = nex_atoms + nat_of_kind + nmatch = nmatch + 1 END IF END DO END DO @@ -1242,7 +1242,7 @@ SUBROUTINE diagonalize_assigned_mo_subset(xas_tdp_env, xas_tdp_control, qs_env) DO ilmo = 1, xas_tdp_control%n_search IF (xas_tdp_env%mos_of_ex_atoms(ilmo, iat, ispin) == -1) CYCLE - i = i+1 + i = i + 1 ! put the coeff in our atom-restricted lmo_fm CALL cp_fm_to_fm_submat(mo_coeff, lmo_fm, nrow=nao, ncol=1, s_firstrow=1, & s_firstcol=ilmo, t_firstrow=1, t_firstcol=i) @@ -1266,7 +1266,7 @@ SUBROUTINE diagonalize_assigned_mo_subset(xas_tdp_env, xas_tdp_control, qs_env) DO ilmo = 1, xas_tdp_control%n_search IF (xas_tdp_env%mos_of_ex_atoms(ilmo, iat, ispin) == -1) CYCLE - i = i+1 + i = i + 1 CALL cp_fm_to_fm_submat(work, mo_coeff, nrow=nao, ncol=1, s_firstrow=1, & s_firstcol=i, t_firstrow=1, t_firstcol=ilmo) @@ -1371,9 +1371,9 @@ SUBROUTINE assign_mos_to_donor_state(donor_state, xas_tdp_env, xas_tdp_control, ! Electronic configuration (copied from MI's XAS) ne = 0 DO l = 1, 4 - nj = 2*(l-1)+1 + nj = 2*(l - 1) + 1 DO i = l, 7 - ne(l, i) = ptable(zval)%e_conv(l-1)-2*nj*(i-l) + ne(l, i) = ptable(zval)%e_conv(l - 1) - 2*nj*(i - l) ne(l, i) = MAX(ne(l, i), 0) ne(l, i) = MIN(ne(l, i), 2*nj) END DO @@ -1486,7 +1486,7 @@ SUBROUTINE assign_mos_to_donor_state(donor_state, xas_tdp_env, xas_tdp_control, DO i = 1, n_states CALL cp_fm_to_fm_submat(msource=mo_coeff, mtarget=donor_state%gs_coeffs, nrow=nao, & ncol=1, s_firstrow=1, s_firstcol=my_mos(i, ispin), & - t_firstrow=1, t_firstcol=(ispin-1)*n_states+i) + t_firstrow=1, t_firstcol=(ispin - 1)*n_states + i) END DO END DO gs_coeffs => donor_state%gs_coeffs @@ -1567,7 +1567,7 @@ SUBROUTINE assign_mos_to_donor_state(donor_state, xas_tdp_env, xas_tdp_control, ! Put the epsilon_ii into the donor_state. No off-diagonal element because of subset diag CALL cp_fm_get_diag(eval_mat, diag) - donor_state%energy_evals(:, ispin) = diag((ispin-1)*n_states+1:ispin*n_states) + donor_state%energy_evals(:, ispin) = diag((ispin - 1)*n_states + 1:ispin*n_states) END DO @@ -1797,7 +1797,7 @@ SUBROUTINE print_checks(xas_tdp_env, xas_tdp_control, qs_env) CALL assign_mos_to_donor_state(current_state, xas_tdp_env, xas_tdp_control, qs_env) CALL perform_mulliken_on_donor_state(current_state, qs_env) - current_state_index = current_state_index+1 + current_state_index = current_state_index + 1 NULLIFY (current_state) END DO !istate @@ -1850,7 +1850,7 @@ SUBROUTINE compute_lenrep_multipole(iatom, xas_tdp_env, xas_tdp_control, qs_env) IF (xas_tdp_control%do_quad) THEN DO i = 1, 6 CALL dbcsr_set(xas_tdp_env%quadmat(i)%matrix, 0.0_dp) - work(3+i)%matrix => xas_tdp_env%quadmat(i)%matrix + work(3 + i)%matrix => xas_tdp_env%quadmat(i)%matrix END DO order = 2 IF (xas_tdp_control%dipole_form == xas_dip_vel) order = -2 @@ -1947,20 +1947,20 @@ SUBROUTINE compute_dipole_fosc(donor_state, xas_tdp_control, xas_tdp_env) DO iosc = 1, nosc tot_contr = 0.0_dp - CALL cp_fm_get_submatrix(fm=mat_work, target_m=dip_block, start_row=(iosc-1)*ndo_so+1, & + CALL cp_fm_get_submatrix(fm=mat_work, target_m=dip_block, start_row=(iosc - 1)*ndo_so + 1, & start_col=1, n_rows=ndo_so, n_cols=ngs) IF (do_sg) THEN tot_contr(:) = get_diag(dip_block) ELSE IF (do_sc .AND. xas_tdp_control%do_uks) THEN tot_contr(:) = get_diag(dip_block(1:ndo_mo, 1:ndo_mo)) !alpha - tot_contr(:) = tot_contr(:)+get_diag(dip_block(ndo_mo+1:ndo_so, ndo_mo+1:ndo_so)) !beta + tot_contr(:) = tot_contr(:) + get_diag(dip_block(ndo_mo + 1:ndo_so, ndo_mo + 1:ndo_so)) !beta ELSE !roks tot_contr(:) = get_diag(dip_block(1:ndo_mo, :)) !alpha - tot_contr(:) = tot_contr(:)+get_diag(dip_block(ndo_mo+1:ndo_so, :)) !beta + tot_contr(:) = tot_contr(:) + get_diag(dip_block(ndo_mo + 1:ndo_so, :)) !beta END IF - osc_str(iosc) = osc_str(iosc)+SUM(tot_contr)**2 + osc_str(iosc) = osc_str(iosc) + SUM(tot_contr)**2 END DO !iosc END DO !j @@ -2064,35 +2064,35 @@ SUBROUTINE compute_quadrupole_fosc(donor_state, xas_tdp_control, xas_tdp_env) DO iosc = 1, nosc tot_contr = 0.0_dp - CALL cp_fm_get_submatrix(fm=mat_work, target_m=quad_block, start_row=(iosc-1)*ndo_so+1, & + CALL cp_fm_get_submatrix(fm=mat_work, target_m=quad_block, start_row=(iosc - 1)*ndo_so + 1, & start_col=1, n_rows=ndo_so, n_cols=ngs) IF (do_sg) THEN tot_contr(:) = get_diag(quad_block) ELSE IF (do_sc .AND. xas_tdp_control%do_uks) THEN tot_contr(:) = get_diag(quad_block(1:ndo_mo, 1:ndo_mo)) !alpha - tot_contr(:) = tot_contr(:)+get_diag(quad_block(ndo_mo+1:ndo_so, ndo_mo+1:ndo_so)) !beta + tot_contr(:) = tot_contr(:) + get_diag(quad_block(ndo_mo + 1:ndo_so, ndo_mo + 1:ndo_so)) !beta ELSE !roks tot_contr(:) = get_diag(quad_block(1:ndo_mo, :)) !alpha - tot_contr(:) = tot_contr(:)+get_diag(quad_block(ndo_mo+1:ndo_so, :)) !beta + tot_contr(:) = tot_contr(:) + get_diag(quad_block(ndo_mo + 1:ndo_so, :)) !beta END IF !if x2, y2, or z2 direction, need to update the trace (for later) IF (j == 1 .OR. j == 4 .OR. j == 6) THEN - osc_str(iosc) = osc_str(iosc)+SUM(tot_contr)**2 - trace(iosc) = trace(iosc)+SUM(tot_contr) + osc_str(iosc) = osc_str(iosc) + SUM(tot_contr)**2 + trace(iosc) = trace(iosc) + SUM(tot_contr) !if xy, xz or yz, need to count twice the contribution (for yx, zx and zy) ELSE - osc_str(iosc) = osc_str(iosc)+2.0_dp*SUM(tot_contr)**2 + osc_str(iosc) = osc_str(iosc) + 2.0_dp*SUM(tot_contr)**2 END IF END DO !iosc END DO !j !compute the prefactor, and remove 1/3*trace^2 - osc_str(:) = pref*1._dp/20._dp*a_fine**2*lr_evals(:)**3*(osc_str(:)-1._dp/3._dp*trace(:)**2) + osc_str(:) = pref*1._dp/20._dp*a_fine**2*lr_evals(:)**3*(osc_str(:) - 1._dp/3._dp*trace(:)**2) !clean-up CALL cp_fm_release(mat_work) @@ -2244,7 +2244,7 @@ SUBROUTINE perform_mulliken_on_donor_state(donor_state, qs_env) ALLOCATE (last_sgf(natom)) CALL get_particle_set(particle_set, qs_kind_set, first_sgf=first_sgf, last_sgf=last_sgf) - nsgf = last_sgf(at_index)-first_sgf(at_index)+1 + nsgf = last_sgf(at_index) - first_sgf(at_index) + 1 CALL cp_fm_create(work_vect, col_vect_struct) @@ -2264,7 +2264,7 @@ SUBROUTINE perform_mulliken_on_donor_state(donor_state, qs_env) ! The Mullikan population for the MOs in on the diagonal. DO ispin = 1, nspins DO i = 1, ndo_mo - mul_pop(i, ispin) = pop_mat((ispin-1)*ndo_mo+i, (ispin-1)*ndo_mo+i) + mul_pop(i, ispin) = pop_mat((ispin - 1)*ndo_mo + i, (ispin - 1)*ndo_mo + i) END DO END DO @@ -2430,11 +2430,11 @@ SUBROUTINE xas_tdp_post(ex_type, donor_state, xas_tdp_env, xas_tdp_section, qs_e print_key => section_vals_get_subs_vals(xas_tdp_section, "PRINT%CUBES") CALL section_vals_val_get(print_key, "CUBES_LU_BOUNDS", i_vals=bounds) - ncubes = bounds(2)-bounds(1)+1 + ncubes = bounds(2) - bounds(1) + 1 IF (ncubes > 0) THEN ALLOCATE (state_list(ncubes)) DO ic = 1, ncubes - state_list(ic) = bounds(1)+ic-1 + state_list(ic) = bounds(1) + ic - 1 END DO END IF @@ -2446,11 +2446,11 @@ SUBROUTINE xas_tdp_post(ex_type, donor_state, xas_tdp_env, xas_tdp_section, qs_e NULLIFY (list) CALL section_vals_val_get(print_key, "CUBES_LIST", i_rep_val=irep, i_vals=list) IF (ASSOCIATED(list)) THEN - CALL reallocate(state_list, 1, ncubes+SIZE(list)) + CALL reallocate(state_list, 1, ncubes + SIZE(list)) DO ic = 1, SIZE(list) - state_list(ncubes+ic) = list(ic) + state_list(ncubes + ic) = list(ic) END DO - ncubes = ncubes+SIZE(list) + ncubes = ncubes + SIZE(list) END IF END DO END IF @@ -2487,7 +2487,7 @@ SUBROUTINE xas_tdp_post(ex_type, donor_state, xas_tdp_env, xas_tdp_section, qs_e DO imo = 1, nmo CALL cp_fm_to_fm_submat(msource=lr_coeffs, mtarget=mo_set%mo_coeff, & nrow=nao, ncol=1, s_firstrow=1, & - s_firstcol=(imo-1)*ndo_so+(ispin-1)*ndo_mo+ido_mo, & + s_firstcol=(imo - 1)*ndo_so + (ispin - 1)*ndo_mo + ido_mo, & t_firstrow=1, t_firstcol=imo) END DO END IF diff --git a/src/xas_tdp_utils.F b/src/xas_tdp_utils.F index 79d18d6b51..02db8a509b 100644 --- a/src/xas_tdp_utils.F +++ b/src/xas_tdp_utils.F @@ -559,7 +559,7 @@ SUBROUTINE solve_xas_tdp_prob(donor_state, xas_tdp_control, xas_tdp_env, qs_env, ndo_mo = donor_state%ndo_mo nocc = nelectron/2; IF (do_os) nocc = nelectron nocc = ndo_mo*nocc - first_ex = nocc+1 !where to find the first proper eigenvalue + first_ex = nocc + 1 !where to find the first proper eigenvalue !solve by energy_range or number of states ? IF (xas_tdp_control%e_range > 0.0_dp) THEN @@ -593,7 +593,7 @@ SUBROUTINE solve_xas_tdp_prob(donor_state, xas_tdp_control, xas_tdp_env, qs_env, CALL deallocate_arnoldi_data(my_arnoldi) !Now we have an estimate for lowest excitation energy => max_ev = min_ev + e_range - max_ev = min_ev+xas_tdp_control%e_range + max_ev = min_ev + xas_tdp_control%e_range min_ev = 0.8_dp*min_ev !for safety, in case of overestimation CALL dbcsr_release(sps) @@ -604,7 +604,7 @@ SUBROUTINE solve_xas_tdp_prob(donor_state, xas_tdp_control, xas_tdp_env, qs_env, do_range = .FALSE. - nevals = nspins*nao-nocc/ndo_mo + nevals = nspins*nao - nocc/ndo_mo IF (xas_tdp_control%n_excited > 0 .AND. xas_tdp_control%n_excited < nevals) THEN nevals = xas_tdp_control%n_excited END IF @@ -637,7 +637,7 @@ SUBROUTINE solve_xas_tdp_prob(donor_state, xas_tdp_control, xas_tdp_env, qs_env, ELSE IF (diag_type == xas_tdp_diag_syevr .AND. do_range) THEN !Using syevr to loko for eigenvalue in the given energy window - CALL cp_fm_geeig_syevr(rhs_matrix, lhs_matrix, c_sum, tmp_evals(nocc+1:nrow), & + CALL cp_fm_geeig_syevr(rhs_matrix, lhs_matrix, c_sum, tmp_evals(nocc + 1:nrow), & work, vlow=min_ev, vup=max_ev) !In this case, eigenvectors are from the first comlumn on @@ -646,8 +646,8 @@ SUBROUTINE solve_xas_tdp_prob(donor_state, xas_tdp_control, xas_tdp_env, qs_env, ELSE !syevr, look for eigenvalues with indices !Usgin syevr to only compute nevals - CALL cp_fm_geeig_syevr(rhs_matrix, lhs_matrix, c_sum, tmp_evals(nocc+1:nocc+nevals), & - work, ilow=nocc+1, iup=nocc+nevals) + CALL cp_fm_geeig_syevr(rhs_matrix, lhs_matrix, c_sum, tmp_evals(nocc + 1:nocc + nevals), & + work, ilow=nocc + 1, iup=nocc + nevals) !In this case, eigenvectors are from the first comlumn on first_ex = 1 @@ -722,16 +722,16 @@ SUBROUTINE solve_xas_tdp_prob(donor_state, xas_tdp_control, xas_tdp_env, qs_env, IF (do_range) THEN WHERE (tmp_evals > max_ev) tmp_evals = 0.0_dp - nevals = MAXLOC(tmp_evals, 1)-nocc + nevals = MAXLOC(tmp_evals, 1) - nocc ALLOCATE (lr_evals(nevals)) - lr_evals(:) = tmp_evals(nocc+1:nocc+nevals) + lr_evals(:) = tmp_evals(nocc + 1:nocc + nevals) ELSE !nevals is known from the start ALLOCATE (lr_evals(nevals)) - lr_evals(:) = tmp_evals(nocc+1:nocc+nevals) + lr_evals(:) = tmp_evals(nocc + 1:nocc + nevals) END IF ! Reorganize the eigenvectors in array of cp_fm so that each ndo_mo columns corresponds to an @@ -747,9 +747,9 @@ SUBROUTINE solve_xas_tdp_prob(donor_state, xas_tdp_control, xas_tdp_env, qs_env, DO imo = 1, ndo_mo CALL cp_fm_to_fm_submat(msource=c_sum, mtarget=lr_coeffs, & - nrow=nao, ncol=1, s_firstrow=((ispin-1)*ndo_mo+imo-1)*nao+1, & - s_firstcol=first_ex+i-1, t_firstrow=1, & - t_firstcol=(i-1)*ndo_mo*nspins+(ispin-1)*ndo_mo+imo) + nrow=nao, ncol=1, s_firstrow=((ispin - 1)*ndo_mo + imo - 1)*nao + 1, & + s_firstcol=first_ex + i - 1, t_firstrow=1, & + t_firstcol=(i - 1)*ndo_mo*nspins + (ispin - 1)*ndo_mo + imo) END DO !imo END DO !ispin END DO !istate @@ -885,9 +885,9 @@ SUBROUTINE compute_submat_dist_and_blk_size(donor_state, do_os, qs_env) ALLOCATE (col_dist_sub(ndo_mo*nspins*scol_dist)) DO i = 1, ndo_mo*nspins - submat_blk_size((i-1)*nblk_row+1:i*nblk_row) = row_blk_size - row_dist_sub((i-1)*srow_dist+1:i*srow_dist) = row_dist - col_dist_sub((i-1)*scol_dist+1:i*scol_dist) = col_dist + submat_blk_size((i - 1)*nblk_row + 1:i*nblk_row) = row_blk_size + row_dist_sub((i - 1)*srow_dist + 1:i*srow_dist) = row_dist + col_dist_sub((i - 1)*scol_dist + 1:i*scol_dist) = col_dist END DO ! Create the submatrix dbcsr distribution @@ -959,7 +959,7 @@ SUBROUTINE get_q_projector(proj_Q, donor_state, do_os, xas_tdp_env, do_sf) one_sp => xas_tdp_env%q_projector(ispin)%matrix !if spin-flip, swap the alpha-alpha and beta-beta blocks - IF (my_dosf) one_sp => xas_tdp_env%q_projector(3-ispin)%matrix + IF (my_dosf) one_sp => xas_tdp_env%q_projector(3 - ispin)%matrix CALL dbcsr_iterator_start(iter, one_sp) DO WHILE (dbcsr_iterator_blocks_left(iter)) @@ -972,8 +972,8 @@ SUBROUTINE get_q_projector(proj_Q, donor_state, do_os, xas_tdp_env, do_sf) IF (found_block) THEN DO imo = 1, ndo_mo - CALL dbcsr_put_block(proj_Q, ((ispin-1)*ndo_mo+imo-1)*nblk_row+iblk, & - ((ispin-1)*ndo_mo+imo-1)*nblk_row+jblk, work_block) + CALL dbcsr_put_block(proj_Q, ((ispin - 1)*ndo_mo + imo - 1)*nblk_row + iblk, & + ((ispin - 1)*ndo_mo + imo - 1)*nblk_row + jblk, work_block) END DO END IF @@ -1077,8 +1077,8 @@ SUBROUTINE build_gs_contribution(matrix_a, donor_state, do_os, qs_env, do_sf) DO imo = 1, ndo_mo ! Put the block as it is - CALL dbcsr_put_block(matrix_a, ((ispin-1)*ndo_mo+imo-1)*nblk_row+iblk, & - ((ispin-1)*ndo_mo+imo-1)*nblk_row+jblk, work_block) + CALL dbcsr_put_block(matrix_a, ((ispin - 1)*ndo_mo + imo - 1)*nblk_row + iblk, & + ((ispin - 1)*ndo_mo + imo - 1)*nblk_row + jblk, work_block) END DO !imo END IF !found_block @@ -1102,8 +1102,8 @@ SUBROUTINE build_gs_contribution(matrix_a, donor_state, do_os, qs_env, do_sf) ! Add S matrix on block diagonal as epsilon_ii*S_pq DO imo = 1, ndo_mo - CALL dbcsr_put_block(work_matrix, ((ispin-1)*ndo_mo+imo-1)*nblk_row+iblk, & - ((ispin-1)*ndo_mo+imo-1)*nblk_row+jblk, & + CALL dbcsr_put_block(work_matrix, ((ispin - 1)*ndo_mo + imo - 1)*nblk_row + iblk, & + ((ispin - 1)*ndo_mo + imo - 1)*nblk_row + jblk, & energy_evals(imo)*work_block) END DO !imo END IF !found block @@ -1191,7 +1191,7 @@ SUBROUTINE build_metric(matrix_g, donor_state, qs_env, do_os, do_inv) ! Go over the diagonal of G => donor MOs ii, spin ss DO i = 1, ndo_mo*nspins - CALL dbcsr_put_block(matrix_g(1)%matrix, (i-1)*nblk_row+iblk, (i-1)*nblk_row+jblk, work_block) + CALL dbcsr_put_block(matrix_g(1)%matrix, (i - 1)*nblk_row + iblk, (i - 1)*nblk_row + jblk, work_block) END DO END IF @@ -1232,7 +1232,7 @@ SUBROUTINE build_metric(matrix_g, donor_state, qs_env, do_os, do_inv) ! Go over the diagonal of G => donor MOs ii spin ss DO i = 1, ndo_mo*nspins - CALL dbcsr_put_block(matrix_g(2)%matrix, (i-1)*nblk_row+iblk, (i-1)*nblk_row+jblk, work_block) + CALL dbcsr_put_block(matrix_g(2)%matrix, (i - 1)*nblk_row + iblk, (i - 1)*nblk_row + jblk, work_block) END DO END IF @@ -1386,11 +1386,11 @@ SUBROUTINE compute_ri_exchange2_int(ex_kind, xas_tdp_env, xas_tdp_control, qs_en CASE (do_potential_truncated) !Make sure the operator is up to date - IF (2*maxl+1 > get_lmax_init()) THEN + IF (2*maxl + 1 > get_lmax_init()) THEN IF (para_env%mepos == 0) THEN CALL open_file(unit_number=unit_id, file_name=xas_tdp_control%x_t_c_filename) END IF - CALL init(2*maxl+1, unit_id, para_env%mepos, para_env%group) + CALL init(2*maxl + 1, unit_id, para_env%mepos, para_env%group) IF (para_env%mepos == 0) THEN CALL close_file(unit_id) END IF @@ -1521,9 +1521,9 @@ SUBROUTINE periodic_ri_coulomb2(ri_coul2, ri_basis, qs_env) sgfq = first_sgf(1, qset) DO ppgf = 1, npgf(pset) - op = (pset-1)*maxco+(ppgf-1)*ncoset(lmax(pset)) + op = (pset - 1)*maxco + (ppgf - 1)*ncoset(lmax(pset)) DO qpgf = 1, npgf(qset) - oq = (qset-1)*maxco+(qpgf-1)*ncoset(lmax(qset)) + oq = (qset - 1)*maxco + (qpgf - 1)*ncoset(lmax(qset)) CALL eri_mme_2c_integrate(mme_param%par, lmin(pset), lmax(pset), lmin(qset), & lmax(qset), zet(ppgf, pset), zet(qpgf, qset), r, hpq, & @@ -1533,11 +1533,11 @@ SUBROUTINE periodic_ri_coulomb2(ri_coul2, ri_basis, qs_env) END DO ! ppgf !contraction into sgfs - op = (pset-1)*maxco+1 - oq = (qset-1)*maxco+1 + op = (pset - 1)*maxco + 1 + oq = (qset - 1)*maxco + 1 - CALL ab_contract(ri_coul2(sgfp:sgfp+nsgf(pset)-1, sgfq:sgfq+nsgf(qset)-1), & - hpq(op:op+ncop-1, oq:oq+ncoq-1), sphi(:, sgfp:), sphi(:, sgfq:), & + CALL ab_contract(ri_coul2(sgfp:sgfp + nsgf(pset) - 1, sgfq:sgfq + nsgf(qset) - 1), & + hpq(op:op + ncop - 1, oq:oq + ncoq - 1), sphi(:, sgfp:), sphi(:, sgfq:), & ncop, ncoq, nsgf(pset), nsgf(qset)) END DO !qset @@ -1774,7 +1774,7 @@ SUBROUTINE get_o3c_memory(o3c_mem, free_mem, ab_list, ac_list, basis_set_a, basi nsgfb = basis_set_b(jkind)%gto_basis_set%nsgf nsgfc = basis_set_c(kkind)%gto_basis_set%nsgf - o3c_mem = o3c_mem+nsgfa*nsgfb*nsgfc + o3c_mem = o3c_mem + nsgfa*nsgfb*nsgfc END DO !$OMP END PARALLEL @@ -1845,8 +1845,8 @@ SUBROUTINE get_opt_3c_dist2d(opt_3c_dist2d, ab_list, ac_list, basis_set_a, basis CALL get_qs_env(qs_env, natom=natom, para_env=para_env, blacs_env=blacs_env, & qs_kind_set=qs_kind_set, particle_set=particle_set) - myprow = blacs_env%mepos(1)+1 - mypcol = blacs_env%mepos(2)+1 + myprow = blacs_env%mepos(1) + 1 + mypcol = blacs_env%mepos(2) + 1 nprow = blacs_env%num_pe(1) npcol = blacs_env%num_pe(2) @@ -1883,9 +1883,9 @@ SUBROUTINE get_opt_3c_dist2d(opt_3c_dist2d, ab_list, ac_list, basis_set_a, basis cost = REAL(nsgfa*nsgfb*nsgfc, dp) !$OMP ATOMIC - row_cost(iatom) = row_cost(iatom)+cost + row_cost(iatom) = row_cost(iatom) + cost !$OMP ATOMIC - col_cost(jatom) = col_cost(jatom)+cost + col_cost(jatom) = col_cost(jatom) + cost END DO !$OMP END PARALLEL @@ -1902,13 +1902,13 @@ SUBROUTINE get_opt_3c_dist2d(opt_3c_dist2d, ab_list, ac_list, basis_set_a, basis DO i = 1, natom iatom = MAXLOC(row_cost, 1) ip = MINLOC(row_proc_cost, 1) - row_proc_cost(ip) = row_proc_cost(ip)+row_cost(iatom) + row_proc_cost(ip) = row_proc_cost(ip) + row_cost(iatom) row_dist(iatom, 1) = ip row_cost(iatom) = 0.0_dp iatom = MAXLOC(col_cost, 1) ip = MINLOC(col_proc_cost, 1) - col_proc_cost(ip) = col_proc_cost(ip)+col_cost(iatom) + col_proc_cost(ip) = col_proc_cost(ip) + col_cost(iatom) col_dist(iatom, 1) = ip col_cost(iatom) = 0.0_dp END DO @@ -1922,8 +1922,8 @@ SUBROUTINE get_opt_3c_dist2d(opt_3c_dist2d, ab_list, ac_list, basis_set_a, basis DO iatom = 1, natom ikind = particle_set(iatom)%atomic_kind%kind_number - IF (row_dist(iatom, 1) == myprow) nparticle_local_row(ikind) = nparticle_local_row(ikind)+1 - IF (col_dist(iatom, 1) == mypcol) nparticle_local_col(ikind) = nparticle_local_col(ikind)+1 + IF (row_dist(iatom, 1) == myprow) nparticle_local_row(ikind) = nparticle_local_row(ikind) + 1 + IF (col_dist(iatom, 1) == mypcol) nparticle_local_col(ikind) = nparticle_local_col(ikind) + 1 END DO DO ikind = 1, nkind @@ -1939,18 +1939,18 @@ SUBROUTINE get_opt_3c_dist2d(opt_3c_dist2d, ab_list, ac_list, basis_set_a, basis ikind = particle_set(iatom)%atomic_kind%kind_number IF (row_dist(iatom, 1) == myprow) THEN - nparticle_local_row(ikind) = nparticle_local_row(ikind)+1 + nparticle_local_row(ikind) = nparticle_local_row(ikind) + 1 local_particle_row(ikind)%array(nparticle_local_row(ikind)) = iatom END IF IF (col_dist(iatom, 1) == mypcol) THEN - nparticle_local_col(ikind) = nparticle_local_col(ikind)+1 + nparticle_local_col(ikind) = nparticle_local_col(ikind) + 1 local_particle_col(ikind)%array(nparticle_local_col(ikind)) = iatom END IF END DO !Finally create the dist_2d - row_dist(:, 1) = row_dist(:, 1)-1 - col_dist(:, 1) = col_dist(:, 1)-1 + row_dist(:, 1) = row_dist(:, 1) - 1 + col_dist(:, 1) = col_dist(:, 1) - 1 CALL distribution_2d_create(opt_3c_dist2d, row_distribution_ptr=row_dist, & col_distribution_ptr=col_dist, local_rows_ptr=local_particle_row, & local_cols_ptr=local_particle_col, blacs_env=blacs_env) @@ -2155,7 +2155,7 @@ SUBROUTINE build_xas_tdp_3c_nl(ac_list, basis_a, basis_c, op_type, qs_env, excit IF (ASSOCIATED(basis_c(ikind)%gto_basis_set)) THEN c_present(ikind) = .TRUE. CALL get_gto_basis_set(basis_c(ikind)%gto_basis_set, kind_radius=c_radius(ikind)) - c_radius(ikind) = c_radius(ikind)+x_range + c_radius(ikind) = c_radius(ikind) + x_range END IF END DO !ikind @@ -2258,7 +2258,7 @@ SUBROUTINE include_os_soc(donor_state, xas_tdp_env, xas_tdp_control, qs_env) sf_evals => donor_state%sf_evals nsc = SIZE(sc_evals) nsf = SIZE(sf_evals) - ntot = 1+nsc+nsf + ntot = 1 + nsc + nsf nex = nsc !by contrutciotn nsc == nsf, but keep 2 counts for clarity ndo_mo = donor_state%ndo_mo ndo_so = 2*ndo_mo @@ -2285,7 +2285,7 @@ SUBROUTINE include_os_soc(donor_state, xas_tdp_env, xas_tdp_control, qs_env) t_firstcol=1) CALL cp_fm_to_fm_submat(msource=donor_state%gs_coeffs, mtarget=gs_coeffs, nrow=nao, & ncol=ndo_mo, s_firstrow=1, s_firstcol=1, t_firstrow=1, & - t_firstcol=ndo_mo+1) + t_firstcol=ndo_mo + 1) CALL cp_fm_struct_release(vec_struct) END IF @@ -2298,10 +2298,10 @@ SUBROUTINE include_os_soc(donor_state, xas_tdp_env, xas_tdp_control, qs_env) ! Put the excitation energies on the diagonal of the real matrix. Element 1,1 is the ground state DO isc = 1, nsc - CALL cp_fm_set_element(real_fm, 1+isc, 1+isc, sc_evals(isc)) + CALL cp_fm_set_element(real_fm, 1 + isc, 1 + isc, sc_evals(isc)) END DO DO isf = 1, nsf - CALL cp_fm_set_element(real_fm, 1+nsc+isf, 1+nsc+isf, sf_evals(isf)) + CALL cp_fm_set_element(real_fm, 1 + nsc + isf, 1 + nsc + isf, sf_evals(isf)) END DO ! Create the bdcsr machinery @@ -2310,8 +2310,8 @@ SUBROUTINE include_os_soc(donor_state, xas_tdp_env, xas_tdp_control, qs_env) npcols=npcols, nprows=nprows) ALLOCATE (col_dist(nex), row_dist_new(nex)) DO iex = 1, nex - col_dist(iex) = MODULO(npcols-iex, npcols) - row_dist_new(iex) = MODULO(nprows-iex, nprows) + col_dist(iex) = MODULO(npcols - iex, npcols) + row_dist_new(iex) = MODULO(nprows - iex, nprows) END DO ALLOCATE (coeffs_dist, prod_dist) CALL dbcsr_distribution_new(coeffs_dist, group=group, pgrid=pgrid, row_dist=row_dist, & @@ -2390,7 +2390,7 @@ SUBROUTINE include_os_soc(donor_state, xas_tdp_env, xas_tdp_control, qs_env) CALL cp_dbcsr_sm_fm_multiply(orb_soc_z, mo_coeff, vec_work, ncol=homo) CALL cp_gemm('T', 'N', homo, homo, nao, 1.0_dp, mo_coeff, vec_work, 0.0_dp, prod_work) CALL cp_fm_get_diag(prod_work, diag) - gs_sum = gs_sum-SUM(diag) ! -1 because of spin integration + gs_sum = gs_sum - SUM(diag) ! -1 because of spin integration CALL cp_fm_release(vec_work) CALL cp_fm_release(prod_work) @@ -2445,13 +2445,13 @@ SUBROUTINE include_os_soc(donor_state, xas_tdp_env, xas_tdp_control, qs_env) CALL cp_gemm('T', 'N', nex*ndo_so, ndo_so, nao, -1.0_dp, sc_coeffs, vec_soc_z, 0.0_dp, gsex_fm) DO isc = 1, nsc - CALL cp_fm_get_submatrix(fm=gsex_fm, target_m=gsex_block, start_row=(isc-1)*ndo_so+1, & + CALL cp_fm_get_submatrix(fm=gsex_fm, target_m=gsex_block, start_row=(isc - 1)*ndo_so + 1, & start_col=1, n_rows=ndo_so, n_cols=ndo_so) diag(:) = get_diag(gsex_block) - soc = SUM(diag(1:ndo_mo))-SUM(diag(ndo_mo+1:ndo_so)) !minus sign because of spin integration + soc = SUM(diag(1:ndo_mo)) - SUM(diag(ndo_mo + 1:ndo_so)) !minus sign because of spin integration !purely imaginary contribution - CALL cp_fm_set_element(img_fm, 1, 1+isc, soc) + CALL cp_fm_set_element(img_fm, 1, 1 + isc, soc) END DO !isc ! Then ground-state/spin-flip SOC: @@ -2461,23 +2461,23 @@ SUBROUTINE include_os_soc(donor_state, xas_tdp_env, xas_tdp_control, qs_env) CALL cp_gemm('T', 'N', nex*ndo_so, ndo_so, nao, -1.0_dp, sc_coeffs, vec_soc_x, 0.0_dp, gsex_fm) DO isf = 1, nsf - CALL cp_fm_get_submatrix(fm=gsex_fm, target_m=gsex_block, start_row=(isf-1)*ndo_so+1, & + CALL cp_fm_get_submatrix(fm=gsex_fm, target_m=gsex_block, start_row=(isf - 1)*ndo_so + 1, & start_col=1, n_rows=ndo_so, n_cols=ndo_so) diag(:) = get_diag(gsex_block) soc = SUM(diag) !alpha and beta parts are simply added due to spin integration - CALL cp_fm_set_element(img_fm, 1, 1+nsc+isf, soc) + CALL cp_fm_set_element(img_fm, 1, 1 + nsc + isf, soc) END DO !isf !compute -sc_coeffs*SOC_y*gs_coeffs, real contribution CALL cp_gemm('T', 'N', nex*ndo_so, ndo_so, nao, -1.0_dp, sc_coeffs, vec_soc_y, 0.0_dp, gsex_fm) DO isf = 1, nsf - CALL cp_fm_get_submatrix(fm=gsex_fm, target_m=gsex_block, start_row=(isf-1)*ndo_so+1, & + CALL cp_fm_get_submatrix(fm=gsex_fm, target_m=gsex_block, start_row=(isf - 1)*ndo_so + 1, & start_col=1, n_rows=ndo_so, n_cols=ndo_so) diag(:) = get_diag(gsex_block) soc = SUM(diag(1:ndo_mo)) ! alpha-beta - soc = soc-SUM(diag(ndo_mo+1:ndo_so)) !beta-alpha - CALL cp_fm_set_element(real_fm, 1, 1+nsc+isf, soc) + soc = soc - SUM(diag(ndo_mo + 1:ndo_so)) !beta-alpha + CALL cp_fm_set_element(real_fm, 1, 1 + nsc + isf, soc) END DO !isf !ground-state cleanup @@ -2535,14 +2535,14 @@ SUBROUTINE include_os_soc(donor_state, xas_tdp_env, xas_tdp_control, qs_env) CALL copy_dbcsr_to_fm(dbcsr_tmp, work_fm) CALL cp_fm_to_fm_submat(msource=work_fm, mtarget=img_fm, nrow=nex, ncol=nex, s_firstrow=1, & - s_firstcol=1, t_firstrow=1+nsc+1, t_firstcol=1+nsc+1) + s_firstcol=1, t_firstrow=1 + nsc + 1, t_firstcol=1 + nsc + 1) ! Finally the spin-conserving/spin-flip interaction ! = sum_k,sigma ! - sum_k,l,sigma donor_state%tp_evals nsg = SIZE(sg_evals) ntp = SIZE(tp_evals) - ntot = 1+nsg+3*ntp + ntot = 1 + nsg + 3*ntp ndo_mo = donor_state%ndo_mo CALL get_qs_env(qs_env, matrix_s=matrix_s) CALL dbcsr_get_info(matrix_s(1)%matrix, nfullrows_total=nao) @@ -2714,13 +2714,13 @@ SUBROUTINE include_rcs_soc(donor_state, xas_tdp_env, xas_tdp_control, qs_env) ! Put the excitation energies on the diagonal of the real matrix DO isg = 1, nsg - CALL cp_fm_set_element(real_fm, 1+isg, 1+isg, sg_evals(isg)) + CALL cp_fm_set_element(real_fm, 1 + isg, 1 + isg, sg_evals(isg)) END DO DO itp = 1, ntp ! first T^-1, then T^0, then T^+1 - CALL cp_fm_set_element(real_fm, 1+itp+nsg, 1+itp+nsg, tp_evals(itp)) - CALL cp_fm_set_element(real_fm, 1+itp+ntp+nsg, 1+itp+ntp+nsg, tp_evals(itp)) - CALL cp_fm_set_element(real_fm, 1+itp+2*ntp+nsg, 1+itp+2*ntp+nsg, tp_evals(itp)) + CALL cp_fm_set_element(real_fm, 1 + itp + nsg, 1 + itp + nsg, tp_evals(itp)) + CALL cp_fm_set_element(real_fm, 1 + itp + ntp + nsg, 1 + itp + ntp + nsg, tp_evals(itp)) + CALL cp_fm_set_element(real_fm, 1 + itp + 2*ntp + nsg, 1 + itp + 2*ntp + nsg, tp_evals(itp)) END DO ! Create the dbcsr machinery (for fast MM, the core of this routine) @@ -2729,8 +2729,8 @@ SUBROUTINE include_rcs_soc(donor_state, xas_tdp_env, xas_tdp_control, qs_env) npcols=npcols, nprows=nprows) ALLOCATE (col_dist(nex), row_dist_new(nex)) DO iex = 1, nex - col_dist(iex) = MODULO(npcols-iex, npcols) - row_dist_new(iex) = MODULO(nprows-iex, nprows) + col_dist(iex) = MODULO(npcols - iex, npcols) + row_dist_new(iex) = MODULO(nprows - iex, nprows) END DO ALLOCATE (coeffs_dist, prod_dist) CALL dbcsr_distribution_new(coeffs_dist, group=group, pgrid=pgrid, row_dist=row_dist, & @@ -2820,35 +2820,35 @@ SUBROUTINE include_rcs_soc(donor_state, xas_tdp_env, xas_tdp_control, qs_env) CALL cp_gemm('T', 'N', ndo_mo*ntp, ndo_mo, nao, -1.0_dp, tp_coeffs, vec_soc_x, 0.0_dp, gstp_fm) DO itp = 1, ntp - CALL cp_fm_get_submatrix(fm=gstp_fm, target_m=gstp_block, start_row=(itp-1)*ndo_mo+1, & + CALL cp_fm_get_submatrix(fm=gstp_fm, target_m=gstp_block, start_row=(itp - 1)*ndo_mo + 1, & start_col=1, n_rows=ndo_mo, n_cols=ndo_mo) diag(:) = get_diag(gstp_block) soc_gst = SUM(diag) - CALL cp_fm_set_element(img_fm, 1, 1+nsg+itp, -1.0_dp*soc_gst) ! <0|H_x|T^-1> - CALL cp_fm_set_element(img_fm, 1, 1+nsg+2*ntp+itp, soc_gst) ! <0|H_x|T^+1> + CALL cp_fm_set_element(img_fm, 1, 1 + nsg + itp, -1.0_dp*soc_gst) ! <0|H_x|T^-1> + CALL cp_fm_set_element(img_fm, 1, 1 + nsg + 2*ntp + itp, soc_gst) ! <0|H_x|T^+1> END DO !gs-triplet with Ms=+-1, real part CALL cp_gemm('T', 'N', ndo_mo*ntp, ndo_mo, nao, -1.0_dp, tp_coeffs, vec_soc_y, 0.0_dp, gstp_fm) DO itp = 1, ntp - CALL cp_fm_get_submatrix(fm=gstp_fm, target_m=gstp_block, start_row=(itp-1)*ndo_mo+1, & + CALL cp_fm_get_submatrix(fm=gstp_fm, target_m=gstp_block, start_row=(itp - 1)*ndo_mo + 1, & start_col=1, n_rows=ndo_mo, n_cols=ndo_mo) diag(:) = get_diag(gstp_block) soc_gst = SUM(diag) - CALL cp_fm_set_element(real_fm, 1, 1+nsg+itp, -1.0_dp*soc_gst) ! <0|H_y|T^-1> - CALL cp_fm_set_element(real_fm, 1, 1+nsg+2*ntp+itp, -1.0_dp*soc_gst) ! <0|H_y|T^+1> + CALL cp_fm_set_element(real_fm, 1, 1 + nsg + itp, -1.0_dp*soc_gst) ! <0|H_y|T^-1> + CALL cp_fm_set_element(real_fm, 1, 1 + nsg + 2*ntp + itp, -1.0_dp*soc_gst) ! <0|H_y|T^+1> END DO !gs-triplet with Ms=0, purely imaginary CALL cp_gemm('T', 'N', ndo_mo*ntp, ndo_mo, nao, -1.0_dp, tp_coeffs, vec_soc_z, 0.0_dp, gstp_fm) DO itp = 1, ntp - CALL cp_fm_get_submatrix(fm=gstp_fm, target_m=gstp_block, start_row=(itp-1)*ndo_mo+1, & + CALL cp_fm_get_submatrix(fm=gstp_fm, target_m=gstp_block, start_row=(itp - 1)*ndo_mo + 1, & start_col=1, n_rows=ndo_mo, n_cols=ndo_mo) diag(:) = get_diag(gstp_block) soc_gst = sqrt2*SUM(diag) - CALL cp_fm_set_element(img_fm, 1, 1+nsg+ntp+itp, soc_gst) + CALL cp_fm_set_element(img_fm, 1, 1 + nsg + ntp + itp, soc_gst) END DO !gs clean-up @@ -2878,13 +2878,13 @@ SUBROUTINE include_rcs_soc(donor_state, xas_tdp_env, xas_tdp_control, qs_env) CALL copy_dbcsr_to_fm(dbcsr_tmp, tmp_fm) CALL cp_fm_to_fm_submat(msource=tmp_fm, mtarget=img_fm, nrow=nex, ncol=nex, & s_firstrow=1, s_firstcol=1, t_firstrow=2, & - t_firstcol=1+nsg+1) + t_firstcol=1 + nsg + 1) ! takes a minus sign CALL cp_fm_scale(-1.0_dp, tmp_fm) CALL cp_fm_to_fm_submat(msource=tmp_fm, mtarget=img_fm, nrow=nex, ncol=nex, & s_firstrow=1, s_firstcol=1, t_firstrow=2, & - t_firstcol=1+nsg+2*ntp+1) + t_firstcol=1 + nsg + 2*ntp + 1) !singlet-triplet with Ms=+-1, real part CALL dbcsr_multiply('N', 'N', 1.0_dp, orb_soc_y, dbcsr_tp, 0.0_dp, dbcsr_work, filter_eps=eps_filter) @@ -2897,12 +2897,12 @@ SUBROUTINE include_rcs_soc(donor_state, xas_tdp_env, xas_tdp_control, qs_env) CALL copy_dbcsr_to_fm(dbcsr_tmp, tmp_fm) CALL cp_fm_to_fm_submat(msource=tmp_fm, mtarget=real_fm, nrow=nex, ncol=nex, & s_firstrow=1, s_firstcol=1, t_firstrow=2, & - t_firstcol=1+nsg+1) + t_firstcol=1 + nsg + 1) ! CALL cp_fm_to_fm_submat(msource=tmp_fm, mtarget=real_fm, nrow=nex, ncol=nex, & s_firstrow=1, s_firstcol=1, t_firstrow=2, & - t_firstcol=1+nsg+2*ntp+1) + t_firstcol=1 + nsg + 2*ntp + 1) !singlet-triplet with Ms=0, purely imaginary CALL dbcsr_multiply('N', 'N', 1.0_dp, orb_soc_z, dbcsr_tp, 0.0_dp, dbcsr_work, filter_eps=eps_filter) @@ -2915,7 +2915,7 @@ SUBROUTINE include_rcs_soc(donor_state, xas_tdp_env, xas_tdp_control, qs_env) CALL copy_dbcsr_to_fm(dbcsr_tmp, tmp_fm) CALL cp_fm_to_fm_submat(msource=tmp_fm, mtarget=img_fm, nrow=nex, ncol=nex, & s_firstrow=1, s_firstcol=1, t_firstrow=2, & - t_firstcol=1+nsg+ntp+1) + t_firstcol=1 + nsg + ntp + 1) !Now the triplet-triplet SOC !start by computing the overlap @@ -2933,15 +2933,15 @@ SUBROUTINE include_rcs_soc(donor_state, xas_tdp_env, xas_tdp_control, qs_env) ! CALL copy_dbcsr_to_fm(dbcsr_tmp, tmp_fm) CALL cp_fm_to_fm_submat(msource=tmp_fm, mtarget=img_fm, nrow=nex, ncol=nex, & - s_firstrow=1, s_firstcol=1, t_firstrow=1+nsg+ntp+1, & - t_firstcol=1+nsg+2*ntp+1) + s_firstrow=1, s_firstcol=1, t_firstrow=1 + nsg + ntp + 1, & + t_firstcol=1 + nsg + 2*ntp + 1) !, takes a minus sign and a transpose (because computed ) CALL cp_fm_transpose(tmp_fm, work_fm) CALL cp_fm_scale(-1.0_dp, work_fm) CALL cp_fm_to_fm_submat(msource=work_fm, mtarget=img_fm, nrow=nex, ncol=nex, & - s_firstrow=1, s_firstcol=1, t_firstrow=1+nsg+1, & - t_firstcol=1+nsg+ntp+1) + s_firstrow=1, s_firstcol=1, t_firstrow=1 + nsg + 1, & + t_firstcol=1 + nsg + ntp + 1) !Ms=0 to Ms=+-1 SOC, real part CALL dbcsr_multiply('N', 'N', 1.0_dp, orb_soc_y, dbcsr_tp, 0.0_dp, dbcsr_work, filter_eps=eps_filter) @@ -2953,15 +2953,15 @@ SUBROUTINE include_rcs_soc(donor_state, xas_tdp_env, xas_tdp_control, qs_env) ! CALL copy_dbcsr_to_fm(dbcsr_tmp, tmp_fm) CALL cp_fm_to_fm_submat(msource=tmp_fm, mtarget=real_fm, nrow=nex, ncol=nex, & - s_firstrow=1, s_firstcol=1, t_firstrow=1+nsg+ntp+1, & - t_firstcol=1+nsg+2*ntp+1) + s_firstrow=1, s_firstcol=1, t_firstrow=1 + nsg + ntp + 1, & + t_firstcol=1 + nsg + 2*ntp + 1) !, takes a minus sign and a transpose CALL cp_fm_transpose(tmp_fm, work_fm) CALL cp_fm_scale(-1.0_dp, work_fm) CALL cp_fm_to_fm_submat(msource=work_fm, mtarget=real_fm, nrow=nex, ncol=nex, & - s_firstrow=1, s_firstcol=1, t_firstrow=1+nsg+1, & - t_firstcol=1+nsg+ntp+1) + s_firstrow=1, s_firstcol=1, t_firstrow=1 + nsg + 1, & + t_firstcol=1 + nsg + ntp + 1) !Ms=1 to Ms=1 and Ms=-1 to Ms=-1 SOC, purely imaginary CALL dbcsr_multiply('N', 'N', 1.0_dp, orb_soc_z, dbcsr_tp, 0.0_dp, dbcsr_work, filter_eps=eps_filter) @@ -2973,14 +2973,14 @@ SUBROUTINE include_rcs_soc(donor_state, xas_tdp_env, xas_tdp_control, qs_env) ! CALL copy_dbcsr_to_fm(dbcsr_tmp, tmp_fm) CALL cp_fm_to_fm_submat(msource=tmp_fm, mtarget=img_fm, nrow=nex, ncol=nex, & - s_firstrow=1, s_firstcol=1, t_firstrow=1+nsg+2*ntp+1, & - t_firstcol=1+nsg+2*ntp+1) + s_firstrow=1, s_firstcol=1, t_firstrow=1 + nsg + 2*ntp + 1, & + t_firstcol=1 + nsg + 2*ntp + 1) !, takes a minus sign CALL cp_fm_scale(-1.0_dp, tmp_fm) CALL cp_fm_to_fm_submat(msource=tmp_fm, mtarget=img_fm, nrow=nex, ncol=nex, & - s_firstrow=1, s_firstcol=1, t_firstrow=1+nsg+1, & - t_firstcol=1+nsg+1) + s_firstrow=1, s_firstcol=1, t_firstrow=1 + nsg + 1, & + t_firstcol=1 + nsg + 1) ! Intermediate clean-up CALL cp_fm_struct_release(work_struct) @@ -3001,8 +3001,8 @@ SUBROUTINE include_rcs_soc(donor_state, xas_tdp_env, xas_tdp_control, qs_env) CALL cp_cfm_heevd(hami_cfm, evecs_cfm, tmp_evals) ! Adjust the energies so the GS has zero, and store in the donor_state (without the GS) - ALLOCATE (donor_state%soc_evals(ntot-1)) - donor_state%soc_evals(:) = tmp_evals(2:ntot)-tmp_evals(1) + ALLOCATE (donor_state%soc_evals(ntot - 1)) + donor_state%soc_evals(:) = tmp_evals(2:ntot) - tmp_evals(1) ! Compute the dipole oscillator strengths CALL compute_soc_dipole_fosc(evecs_cfm, dbcsr_soc_package, donor_state, xas_tdp_env, & @@ -3091,7 +3091,7 @@ SUBROUTINE get_os_amew_op(amew_op, ao_op, gs_coeffs, dbcsr_soc_package, donor_st nsc = SIZE(donor_state%sc_evals) nsf = SIZE(donor_state%sf_evals) nex = nsc - ntot = 1+nsc+nsf + ntot = 1 + nsc + nsf ndo_mo = donor_state%ndo_mo ndo_so = 2*donor_state%ndo_mo !open-shell => nspins = 2 CALL get_qs_env(qs_env, matrix_s=matrix_s, para_env=para_env, blacs_env=blacs_env, mos=mos) @@ -3158,7 +3158,7 @@ SUBROUTINE get_os_amew_op(amew_op, ao_op, gs_coeffs, dbcsr_soc_package, donor_st CALL cp_dbcsr_sm_fm_multiply(ao_op_i, mo_coeff, vec_work, ncol=homo) CALL cp_gemm('T', 'N', homo, homo, nao, 1.0_dp, mo_coeff, vec_work, 0.0_dp, prod_work) CALL cp_fm_get_diag(prod_work, diag) - gsgs_op(i) = gsgs_op(i)+SUM(diag) + gsgs_op(i) = gsgs_op(i) + SUM(diag) END DO !i @@ -3205,11 +3205,11 @@ SUBROUTINE get_os_amew_op(amew_op, ao_op, gs_coeffs, dbcsr_soc_package, donor_st ! Do the ground-state/spin-conserving operator CALL cp_gemm('T', 'N', ndo_so*nsc, ndo_so, nao, 1.0_dp, sc_coeffs, vec_work, 0.0_dp, gsex_fm) DO isc = 1, nsc - CALL cp_fm_get_submatrix(fm=gsex_fm, target_m=gsex_block, start_row=(isc-1)*ndo_so+1, & + CALL cp_fm_get_submatrix(fm=gsex_fm, target_m=gsex_block, start_row=(isc - 1)*ndo_so + 1, & start_col=1, n_rows=ndo_so, n_cols=ndo_so) diag(:) = get_diag(gsex_block) op = SUM(diag) - CALL cp_fm_set_element(amew_op_i, 1, 1+isc, op) + CALL cp_fm_set_element(amew_op_i, 1, 1 + isc, op) END DO !isc ! The spin-conserving/spin-conserving operator @@ -3241,8 +3241,8 @@ SUBROUTINE get_os_amew_op(amew_op, ao_op, gs_coeffs, dbcsr_soc_package, donor_st CALL dbcsr_multiply('T', 'N', 1.0_dp, dbcsr_sf, dbcsr_work, 0.0_dp, dbcsr_prod, filter_eps=eps_filter) !need to reorganize the domo_op array by swapping the alpha-alpha and the beta-beta quarter - tmp(1:ndo_mo, 1:ndo_mo) = domo_op(ndo_mo+1:ndo_so, ndo_mo+1:ndo_so) - tmp(ndo_mo+1:ndo_so, ndo_mo+1:ndo_so) = domo_op(1:ndo_mo, 1:ndo_mo) + tmp(1:ndo_mo, 1:ndo_mo) = domo_op(ndo_mo + 1:ndo_so, ndo_mo + 1:ndo_so) + tmp(ndo_mo + 1:ndo_so, ndo_mo + 1:ndo_so) = domo_op(1:ndo_mo, 1:ndo_mo) CALL os_amew_soc_elements(dbcsr_tmp, dbcsr_prod, dbcsr_ovlp, tmp, pref_diaga=1.0_dp, & pref_diagb=1.0_dp, pref_tracea=-1.0_dp, pref_traceb=-1.0_dp, & @@ -3250,7 +3250,7 @@ SUBROUTINE get_os_amew_op(amew_op, ao_op, gs_coeffs, dbcsr_soc_package, donor_st CALL copy_dbcsr_to_fm(dbcsr_tmp, tmp_fm) CALL cp_fm_to_fm_submat(msource=tmp_fm, mtarget=amew_op_i, nrow=nex, ncol=nex, & - s_firstrow=1, s_firstcol=1, t_firstrow=1+nsc+1, t_firstcol=1+nsc+1) + s_firstrow=1, s_firstcol=1, t_firstrow=1 + nsc + 1, t_firstcol=1 + nsc + 1) !Symmetry => only upper diag explicitly built CALL cp_fm_upper_to_full(amew_op_i, work_fm) @@ -3326,7 +3326,7 @@ SUBROUTINE get_rcs_amew_op(amew_op, ao_op, dbcsr_soc_package, donor_state, eps_f sg_coeffs => donor_state%sg_coeffs nsg = SIZE(donor_state%sg_evals) ntp = nsg; nex = nsg !all the same by construction, keep them separate for clarity - ntot = 1+nsg+3*ntp + ntot = 1 + nsg + 3*ntp ndo_mo = donor_state%ndo_mo CALL get_qs_env(qs_env, matrix_s=matrix_s, para_env=para_env, blacs_env=blacs_env, mos=mos) sqrt2 = SQRT(2.0_dp) @@ -3408,11 +3408,11 @@ SUBROUTINE get_rcs_amew_op(amew_op, ao_op, dbcsr_soc_package, donor_state, eps_f ! Compute the ground-state/singlet components. ao_op*gs_coeffs already stored in vec_op CALL cp_gemm('T', 'N', ndo_mo*nsg, ndo_mo, nao, 1.0_dp, sg_coeffs, vec_op, 0.0_dp, sggs_fm) DO isg = 1, nsg - CALL cp_fm_get_submatrix(fm=sggs_fm, target_m=sggs_block, start_row=(isg-1)*ndo_mo+1, & + CALL cp_fm_get_submatrix(fm=sggs_fm, target_m=sggs_block, start_row=(isg - 1)*ndo_mo + 1, & start_col=1, n_rows=ndo_mo, n_cols=ndo_mo) diag(:) = get_diag(sggs_block) op = sqrt2*SUM(diag) - CALL cp_fm_set_element(amew_op_i, 1, 1+isg, op) + CALL cp_fm_set_element(amew_op_i, 1, 1 + isg, op) END DO ! do the singlet-singlet components @@ -3449,15 +3449,15 @@ SUBROUTINE get_rcs_amew_op(amew_op, ao_op, dbcsr_soc_package, donor_state, eps_f CALL copy_dbcsr_to_fm(dbcsr_tmp, tmp_fm) ! CALL cp_fm_to_fm_submat(msource=tmp_fm, mtarget=amew_op_i, nrow=nex, ncol=nex, & - s_firstrow=1, s_firstcol=1, t_firstrow=1+nsg+1, t_firstcol=1+nsg+1) + s_firstrow=1, s_firstcol=1, t_firstrow=1 + nsg + 1, t_firstcol=1 + nsg + 1) ! CALL cp_fm_to_fm_submat(msource=tmp_fm, mtarget=amew_op_i, nrow=nex, ncol=nex, & - s_firstrow=1, s_firstcol=1, t_firstrow=1+nsg+ntp+1, & - t_firstcol=1+nsg+ntp+1) + s_firstrow=1, s_firstcol=1, t_firstrow=1 + nsg + ntp + 1, & + t_firstcol=1 + nsg + ntp + 1) ! CALL cp_fm_to_fm_submat(msource=tmp_fm, mtarget=amew_op_i, nrow=nex, ncol=nex, & - s_firstrow=1, s_firstcol=1, t_firstrow=1+nsg+2*ntp+1, & - t_firstcol=1+nsg+2*ntp+1) + s_firstrow=1, s_firstcol=1, t_firstrow=1 + nsg + 2*ntp + 1, & + t_firstcol=1 + nsg + 2*ntp + 1) ! Symmetrize the matrix (only upper triangle built) CALL cp_fm_upper_to_full(amew_op_i, work_fm) @@ -3534,7 +3534,7 @@ SUBROUTINE os_amew_soc_elements(amew_soc, lr_soc, lr_overlap, domo_soc, pref_dia !inverse order, that is: the beta-coeffs in the alpha spot and the alpha coeffs in the !beta spot tas = 1 - tbs = ndo_mo+1 + tbs = ndo_mo + 1 IF (PRESENT(tracea_start)) tas = tracea_start IF (PRESENT(traceb_start)) tbs = traceb_start @@ -3552,20 +3552,20 @@ SUBROUTINE os_amew_soc_elements(amew_soc, lr_soc, lr_overlap, domo_soc, pref_dia CALL dbcsr_get_block_p(lr_soc, iex, jex, pblock, found) IF (found) THEN diag(:) = get_diag(pblock) - soc_elem = soc_elem+pref_diaga*SUM(diag(1:ndo_mo))+pref_diagb*(SUM(diag(ndo_mo+1:ndo_so))) + soc_elem = soc_elem + pref_diaga*SUM(diag(1:ndo_mo)) + pref_diagb*(SUM(diag(ndo_mo + 1:ndo_so))) END IF CALL dbcsr_get_block_p(lr_overlap, iex, jex, pblock, found) IF (found) THEN soc_elem = soc_elem & - +pref_tracea*SUM(pblock(tas(1):tas(1)+ndo_mo-1, tas(2):tas(2)+ndo_mo-1)* & - TRANSPOSE(domo_soc(tas(1):tas(1)+ndo_mo-1, tas(2):tas(2)+ndo_mo-1))) & - +pref_traceb*SUM(pblock(tbs(1):tbs(1)+ndo_mo-1, tbs(2):tbs(2)+ndo_mo-1)* & - TRANSPOSE(domo_soc(tbs(1):tbs(1)+ndo_mo-1, tbs(2):tbs(2)+ndo_mo-1))) + + pref_tracea*SUM(pblock(tas(1):tas(1) + ndo_mo - 1, tas(2):tas(2) + ndo_mo - 1)* & + TRANSPOSE(domo_soc(tas(1):tas(1) + ndo_mo - 1, tas(2):tas(2) + ndo_mo - 1))) & + + pref_traceb*SUM(pblock(tbs(1):tbs(1) + ndo_mo - 1, tbs(2):tbs(2) + ndo_mo - 1)* & + TRANSPOSE(domo_soc(tbs(1):tbs(1) + ndo_mo - 1, tbs(2):tbs(2) + ndo_mo - 1))) IF (do_diags) THEN diag(:) = get_diag(pblock) - soc_elem = soc_elem+pref_diags*SUM(diag) + soc_elem = soc_elem + pref_diags*SUM(diag) END IF END IF @@ -3630,16 +3630,16 @@ SUBROUTINE rcs_amew_soc_elements(amew_soc, lr_soc, lr_overlap, domo_soc, pref_tr CALL dbcsr_get_block_p(lr_soc, iex, jex, pblock, found) IF (found) THEN diag(:) = get_diag(pblock) - soc_elem = soc_elem+SUM(diag) + soc_elem = soc_elem + SUM(diag) END IF CALL dbcsr_get_block_p(lr_overlap, iex, jex, pblock, found) IF (found) THEN - soc_elem = soc_elem+pref_trace*SUM(pblock*TRANSPOSE(domo_soc)) + soc_elem = soc_elem + pref_trace*SUM(pblock*TRANSPOSE(domo_soc)) IF (do_diags) THEN diag(:) = get_diag(pblock) - soc_elem = soc_elem+pref_diags*SUM(diag) + soc_elem = soc_elem + pref_diags*SUM(diag) END IF END IF @@ -3697,7 +3697,7 @@ SUBROUTINE compute_soc_dipole_fosc(soc_evecs_cfm, dbcsr_soc_package, donor_state do_rcs = xas_tdp_control%do_singlet soc_evals => donor_state%soc_evals nosc = SIZE(soc_evals) - ntot = nosc+1 !because GS AMEW is in there + ntot = nosc + 1 !because GS AMEW is in there ALLOCATE (donor_state%soc_osc_str(nosc)) osc_str => donor_state%soc_osc_str osc_str(:) = 0.0_dp @@ -3735,7 +3735,7 @@ SUBROUTINE compute_soc_dipole_fosc(soc_evecs_cfm, dbcsr_soc_package, donor_state CALL cp_cfm_get_submatrix(dip_cfm, transdip) !transition dipoles are real numbers - osc_str(:) = osc_str(:)+REAL(transdip(2:ntot, 1))**2+AIMAG(transdip(2:ntot, 1))**2 + osc_str(:) = osc_str(:) + REAL(transdip(2:ntot, 1))**2 + AIMAG(transdip(2:ntot, 1))**2 END DO !i @@ -3807,7 +3807,7 @@ SUBROUTINE compute_soc_quadrupole_fosc(soc_evecs_cfm, dbcsr_soc_package, donor_s do_rcs = xas_tdp_control%do_singlet soc_evals => donor_state%soc_evals nosc = SIZE(soc_evals) - ntot = nosc+1 !because GS AMEW is in there + ntot = nosc + 1 !because GS AMEW is in there ALLOCATE (donor_state%soc_quad_osc_str(nosc)) osc_str => donor_state%soc_quad_osc_str osc_str(:) = 0.0_dp @@ -3848,18 +3848,18 @@ SUBROUTINE compute_soc_quadrupole_fosc(soc_evecs_cfm, dbcsr_soc_package, donor_s !if x2, y2 or z2, need to keep track of trace IF (i == 1 .OR. i == 4 .OR. i == 6) THEN - osc_str(:) = osc_str(:)+REAL(transquad(2:ntot, 1))**2+AIMAG(transquad(2:ntot, 1))**2 - trace(:) = trace(:)+transquad(2:ntot, 1) + osc_str(:) = osc_str(:) + REAL(transquad(2:ntot, 1))**2 + AIMAG(transquad(2:ntot, 1))**2 + trace(:) = trace(:) + transquad(2:ntot, 1) !if xy, xz, or yz, need to count twice (for yx, zx and zy) ELSE - osc_str(:) = osc_str(:)+2.0_dp*(REAL(transquad(2:ntot, 1))**2+AIMAG(transquad(2:ntot, 1))**2) + osc_str(:) = osc_str(:) + 2.0_dp*(REAL(transquad(2:ntot, 1))**2 + AIMAG(transquad(2:ntot, 1))**2) END IF END DO !i !remove a third of the trace - osc_str(:) = osc_str(:)-1._dp/3._dp*(REAL(trace(:))**2+AIMAG(trace(:))**2) + osc_str(:) = osc_str(:) - 1._dp/3._dp*(REAL(trace(:))**2 + AIMAG(trace(:))**2) !multiply by the prefactor osc_str(:) = osc_str(:)*1._dp/20._dp*a_fine**2*soc_evals(:)**3 diff --git a/src/xas_tp_scf.F b/src/xas_tp_scf.F index 9b67d1003e..3eb3f93de0 100644 --- a/src/xas_tp_scf.F +++ b/src/xas_tp_scf.F @@ -222,7 +222,7 @@ SUBROUTINE xas_do_tp_scf(dft_control, xas_env, iatom, istate, scf_env, qs_env, & exit_loop = .FALSE. IF (output_unit > 0) CALL m_flush(output_unit) - iter_count = iter_count+1 + iter_count = iter_count + 1 CALL cp_iterate(logger%iter_info, last=.FALSE., iter_nr=iter_count) ! ** here qs_env%rho%rho_r and qs_env%rho%rho_g should be up to date @@ -265,8 +265,8 @@ SUBROUTINE xas_do_tp_scf(dft_control, xas_env, iatom, istate, scf_env, qs_env, & energy%kTS = 0.0_dp energy%efermi = 0.0_dp DO ispin = 1, nspin - energy%kTS = energy%kTS+mos(ispin)%mo_set%kTS - energy%efermi = energy%efermi+mos(ispin)%mo_set%mu + energy%kTS = energy%kTS + mos(ispin)%mo_set%kTS + energy%efermi = energy%efermi + mos(ispin)%mo_set%mu ENDDO energy%efermi = energy%efermi/REAL(nspin, KIND=dp) @@ -295,8 +295,8 @@ SUBROUTINE xas_do_tp_scf(dft_control, xas_env, iatom, istate, scf_env, qs_env, & WRITE (UNIT=output_unit, & FMT="(T2,I5,1X,A,T20,E8.2,1X,F6.1,1X,F14.8,1X,F20.10,1X,ES9.2)") & iter_count, TRIM(scf_env%iter_method), & - scf_env%iter_param, t2-t1, scf_env%iter_delta, energy%total, & - energy%total-energy%tot_old + scf_env%iter_param, t2 - t1, scf_env%iter_delta, energy%total, & + energy%total - energy%tot_old END IF energy%tot_old = energy%total @@ -521,7 +521,7 @@ SUBROUTINE cls_prepare_states(xas_control, xas_env, qs_env, iatom, xas_section, rc(1:3) = centers_wfn(1:3, istate) rac = pbc(ra, rc, cell) - dist = rac(1)*rac(1)+rac(2)*rac(2)+rac(3)*rac(3) + dist = rac(1)*rac(1) + rac(2)*rac(2) + rac(3)*rac(3) IF (dist < 1.0_dp) THEN CALL cp_fm_get_submatrix(mo_coeff, vecbuffer, 1, istate, & @@ -530,10 +530,10 @@ SUBROUTINE cls_prepare_states(xas_control, xas_env, qs_env, iatom, xas_section, DO i = 1, SIZE(stogto_overlap(my_kind)%array, 1) component = 0.0_dp DO j = 1, SIZE(stogto_overlap(my_kind)%array, 2) - isgf = first_sgf(iatom)+j-1 - component = component+stogto_overlap(my_kind)%array(i, j)*vecbuffer(1, isgf) + isgf = first_sgf(iatom) + j - 1 + component = component + stogto_overlap(my_kind)%array(i, j)*vecbuffer(1, isgf) END DO ! j size - sto_state_overlap = sto_state_overlap+ & + sto_state_overlap = sto_state_overlap + & component*component END DO ! i size @@ -611,9 +611,9 @@ SUBROUTINE cls_prepare_states(xas_control, xas_env, qs_env, iatom, xas_section, ENDDO IF (nvirtual2 .GT. 0) THEN CALL cp_fm_to_fm(uno_orbs, all_vectors, ncol=nvirtual2, & - source_start=1, target_start=1+nmo) + source_start=1, target_start=1 + nmo) DO istate = 1, nvirtual2 - all_evals(istate+nmo) = uno_evals(istate) + all_evals(istate + nmo) = uno_evals(istate) END DO END IF END IF diff --git a/src/xc/xc.F b/src/xc/xc.F index 35e523ad87..87b35c7c9a 100644 --- a/src/xc/xc.F +++ b/src/xc/xc.F @@ -349,8 +349,8 @@ SUBROUTINE xc_vxc_pw_create_test_lsd(vxc_rho, vxc_tau, rho_r, rho_g, tau, & DO k = bo(1, 3), bo(2, 3) DO j = bo(1, 2), bo(2, 2) DO i = bo(1, 1), bo(2, 1) - ii = ii+1 - diff = ABS(vxc_rho(ispin)%pw%cr3d(i, j, k)- & + ii = ii + 1 + diff = ABS(vxc_rho(ispin)%pw%cr3d(i, j, k) - & vxc_rho2(ispin)%pw%cr3d(i, j, k)) IF (ii == 1) THEN PRINT *, "vxc", ispin, "=", vxc_rho(ispin)%pw%cr3d(i, j, k), & @@ -366,7 +366,7 @@ SUBROUTINE xc_vxc_pw_create_test_lsd(vxc_rho, vxc_tau, rho_r, rho_g, tau, & END DO END DO END DO - PRINT *, "diff exc=", ABS(exc-exc2), "diff vxc=", maxdiff + PRINT *, "diff exc=", ABS(exc - exc2), "diff vxc=", maxdiff ! CPASSERT(maxdiff<5.e-11) ! CPASSERT(ABS(exc-exc2)<1.e-14) @@ -378,8 +378,8 @@ SUBROUTINE xc_vxc_pw_create_test_lsd(vxc_rho, vxc_tau, rho_r, rho_g, tau, & DO k = bo(1, 3), bo(2, 3) DO j = bo(1, 2), bo(2, 2) DO i = bo(1, 1), bo(2, 1) - ii = ii+1 - diff = ABS(vxc_tau(ispin)%pw%cr3d(i, j, k)- & + ii = ii + 1 + diff = ABS(vxc_tau(ispin)%pw%cr3d(i, j, k) - & vxc_tau2(ispin)%pw%cr3d(i, j, k)) IF (ii == 1) THEN PRINT *, "vxc_tau", ispin, "=", vxc_tau(ispin)%pw%cr3d(i, j, k), & @@ -395,13 +395,13 @@ SUBROUTINE xc_vxc_pw_create_test_lsd(vxc_rho, vxc_tau, rho_r, rho_g, tau, & END DO END DO END DO - PRINT *, "diff exc=", ABS(exc-exc2), "diff vxc_tau=", maxdiff + PRINT *, "diff exc=", ABS(exc - exc2), "diff vxc_tau=", maxdiff END IF deriv_iter => dSet1%derivs DO WHILE (cp_sll_xc_deriv_next(deriv_iter, el_att=deriv)) CALL xc_derivative_get(deriv, & split_desc=split_desc, deriv_data=pot) - SELECT CASE (SIZE (split_desc)) + SELECT CASE (SIZE(split_desc)) CASE (0) filename = "e_0.bindata" deriv2 => xc_dset_get_derivative(dSet2, "") @@ -420,7 +420,7 @@ SUBROUTINE xc_vxc_pw_create_test_lsd(vxc_rho, vxc_tau, rho_r, rho_g, tau, & deriv_data=pot2) CALL xc_derivative_get(deriv3, & deriv_data=pot3) - pot2 = pot2+pot3 + pot2 = pot2 + pot3 ELSE deriv2 => deriv3 END IF @@ -439,7 +439,7 @@ SUBROUTINE xc_vxc_pw_create_test_lsd(vxc_rho, vxc_tau, rho_r, rho_g, tau, & DO k = bo(1, 3), bo(2, 3) DO j = bo(1, 2), bo(2, 2) DO i = bo(1, 1), bo(2, 1) - diff = ABS(pot(i, j, k)-pot2(i, j, k)) + diff = ABS(pot(i, j, k) - pot2(i, j, k)) IF (maxDiff < diff) THEN maxDiff = diff PRINT *, "ediff(", i, j, k, ")=", maxDiff, & @@ -460,7 +460,7 @@ SUBROUTINE xc_vxc_pw_create_test_lsd(vxc_rho, vxc_tau, rho_r, rho_g, tau, & DO WHILE (cp_sll_xc_deriv_next(deriv_iter, el_att=deriv)) CALL xc_derivative_get(deriv, & split_desc=split_desc, deriv_data=pot) - SELECT CASE (SIZE (split_desc)) + SELECT CASE (SIZE(split_desc)) CASE (0) filename = "e_0-2.bindata" CASE (1) @@ -613,7 +613,7 @@ SUBROUTINE xc_vxc_pw_create_debug(vxc_rho, vxc_tau, rho_r, rho_g, tau, exc, & DO WHILE (cp_sll_xc_deriv_next(deriv_iter, el_att=deriv)) CALL xc_derivative_get(deriv, & split_desc=split_desc, deriv_data=pot) - SELECT CASE (SIZE (split_desc)) + SELECT CASE (SIZE(split_desc)) CASE (0) filename = "e_0.bindata" CASE (1) @@ -685,7 +685,7 @@ SUBROUTINE xc_vxc_pw_create_debug(vxc_rho, vxc_tau, rho_r, rho_g, tau, exc, & DO WHILE (cp_sll_xc_deriv_next(deriv_iter, el_att=deriv)) CALL xc_derivative_get(deriv, & split_desc=split_desc, deriv_data=pot) - SELECT CASE (SIZE (split_desc)) + SELECT CASE (SIZE(split_desc)) CASE (0) filename = " e_0" CASE (1) @@ -754,7 +754,7 @@ SUBROUTINE xc_vxc_pw_create_debug(vxc_rho, vxc_tau, rho_r, rho_g, tau, exc, & DO WHILE (cp_sll_xc_deriv_next(deriv_iter, el_att=deriv)) CALL xc_derivative_get(deriv, & split_desc=split_desc, deriv_data=pot) - SELECT CASE (SIZE (split_desc)) + SELECT CASE (SIZE(split_desc)) CASE (0) filename = " e_0" CASE (1) @@ -895,8 +895,8 @@ SUBROUTINE smooth_cutoff(pot, rho, rhoa, rhob, rho_cutoff, & my_e_0_scale_factor = 1.0_dp IF (PRESENT(e_0_scale_factor)) my_e_0_scale_factor = e_0_scale_factor rho_smooth_cutoff = rho_cutoff*rho_smooth_cutoff_range - rho_smooth_cutoff_2 = (rho_cutoff+rho_smooth_cutoff)/2 - rho_smooth_cutoff_range_2 = rho_smooth_cutoff_2-rho_cutoff + rho_smooth_cutoff_2 = (rho_cutoff + rho_smooth_cutoff)/2 + rho_smooth_cutoff_range_2 = rho_smooth_cutoff_2 - rho_cutoff IF (rho_smooth_cutoff_range > 0.0_dp) THEN IF (PRESENT(e_0)) THEN @@ -914,20 +914,20 @@ SUBROUTINE smooth_cutoff(pot, rho, rhoa, rhob, rho_cutoff, & IF (my_rho < rho_cutoff) THEN pot(i, j, k) = 0.0_dp ELSEIF (my_rho < rho_smooth_cutoff_2) THEN - my_rho_n = (my_rho-rho_cutoff)/rho_smooth_cutoff_range_2 + my_rho_n = (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2 my_rho_n2 = my_rho_n*my_rho_n pot(i, j, k) = pot(i, j, k)* & - my_rho_n2*(my_rho_n-0.5_dp*my_rho_n2)+ & + my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2) + & my_e_0_scale_factor*e_0(i, j, k)* & - my_rho_n2*(3.0_dp-2.0_dp*my_rho_n) & + my_rho_n2*(3.0_dp - 2.0_dp*my_rho_n) & /rho_smooth_cutoff_range_2 ELSE - my_rho_n = 2.0_dp-(my_rho-rho_cutoff)/rho_smooth_cutoff_range_2 + my_rho_n = 2.0_dp - (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2 my_rho_n2 = my_rho_n*my_rho_n pot(i, j, k) = pot(i, j, k)* & - (1.0_dp-my_rho_n2*(my_rho_n-0.5_dp*my_rho_n2)) & - +my_e_0_scale_factor*e_0(i, j, k)* & - my_rho_n2*(3.0_dp-2.0_dp*my_rho_n) & + (1.0_dp - my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2)) & + + my_e_0_scale_factor*e_0(i, j, k)* & + my_rho_n2*(3.0_dp - 2.0_dp*my_rho_n) & /rho_smooth_cutoff_range_2 END IF END IF @@ -942,25 +942,25 @@ SUBROUTINE smooth_cutoff(pot, rho, rhoa, rhob, rho_cutoff, & DO k = bo(1, 3), bo(2, 3) DO j = bo(1, 2), bo(2, 2) DO i = bo(1, 1), bo(2, 1) - my_rho = rhoa(i, j, k)+rhob(i, j, k) + my_rho = rhoa(i, j, k) + rhob(i, j, k) IF (my_rho < rho_smooth_cutoff) THEN IF (my_rho < rho_cutoff) THEN pot(i, j, k) = 0.0_dp ELSEIF (my_rho < rho_smooth_cutoff_2) THEN - my_rho_n = (my_rho-rho_cutoff)/rho_smooth_cutoff_range_2 + my_rho_n = (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2 my_rho_n2 = my_rho_n*my_rho_n pot(i, j, k) = pot(i, j, k)* & - my_rho_n2*(my_rho_n-0.5_dp*my_rho_n2)+ & + my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2) + & my_e_0_scale_factor*e_0(i, j, k)* & - my_rho_n2*(3.0_dp-2.0_dp*my_rho_n) & + my_rho_n2*(3.0_dp - 2.0_dp*my_rho_n) & /rho_smooth_cutoff_range_2 ELSE - my_rho_n = 2.0_dp-(my_rho-rho_cutoff)/rho_smooth_cutoff_range_2 + my_rho_n = 2.0_dp - (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2 my_rho_n2 = my_rho_n*my_rho_n pot(i, j, k) = pot(i, j, k)* & - (1.0_dp-my_rho_n2*(my_rho_n-0.5_dp*my_rho_n2)) & - +my_e_0_scale_factor*e_0(i, j, k)* & - my_rho_n2*(3.0_dp-2.0_dp*my_rho_n) & + (1.0_dp - my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2)) & + + my_e_0_scale_factor*e_0(i, j, k)* & + my_rho_n2*(3.0_dp - 2.0_dp*my_rho_n) & /rho_smooth_cutoff_range_2 END IF END IF @@ -982,15 +982,15 @@ SUBROUTINE smooth_cutoff(pot, rho, rhoa, rhob, rho_cutoff, & IF (my_rho < rho_cutoff) THEN pot(i, j, k) = 0.0_dp ELSEIF (my_rho < rho_smooth_cutoff_2) THEN - my_rho_n = (my_rho-rho_cutoff)/rho_smooth_cutoff_range_2 + my_rho_n = (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2 my_rho_n2 = my_rho_n*my_rho_n pot(i, j, k) = pot(i, j, k)* & - my_rho_n2*(my_rho_n-0.5_dp*my_rho_n2) + my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2) ELSE - my_rho_n = 2.0_dp-(my_rho-rho_cutoff)/rho_smooth_cutoff_range_2 + my_rho_n = 2.0_dp - (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2 my_rho_n2 = my_rho_n*my_rho_n pot(i, j, k) = pot(i, j, k)* & - (1.0_dp-my_rho_n2*(my_rho_n-0.5_dp*my_rho_n2)) + (1.0_dp - my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2)) END IF END IF END DO @@ -1006,20 +1006,20 @@ SUBROUTINE smooth_cutoff(pot, rho, rhoa, rhob, rho_cutoff, & DO k = bo(1, 3), bo(2, 3) DO j = bo(1, 2), bo(2, 2) DO i = bo(1, 1), bo(2, 1) - my_rho = rhoa(i, j, k)+rhob(i, j, k) + my_rho = rhoa(i, j, k) + rhob(i, j, k) IF (my_rho < rho_smooth_cutoff) THEN IF (my_rho < rho_cutoff) THEN pot(i, j, k) = 0.0_dp ELSEIF (my_rho < rho_smooth_cutoff_2) THEN - my_rho_n = (my_rho-rho_cutoff)/rho_smooth_cutoff_range_2 + my_rho_n = (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2 my_rho_n2 = my_rho_n*my_rho_n pot(i, j, k) = pot(i, j, k)* & - my_rho_n2*(my_rho_n-0.5_dp*my_rho_n2) + my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2) ELSE - my_rho_n = 2.0_dp-(my_rho-rho_cutoff)/rho_smooth_cutoff_range_2 + my_rho_n = 2.0_dp - (my_rho - rho_cutoff)/rho_smooth_cutoff_range_2 my_rho_n2 = my_rho_n*my_rho_n pot(i, j, k) = pot(i, j, k)* & - (1.0_dp-my_rho_n2*(my_rho_n-0.5_dp*my_rho_n2)) + (1.0_dp - my_rho_n2*(my_rho_n - 0.5_dp*my_rho_n2)) END IF END IF END DO @@ -1127,7 +1127,7 @@ SUBROUTINE xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau, xc_section use_virial = compute_virial bo = rho_r(1)%pw%pw_grid%bounds_local - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) ! calculate the potential derivatives CALL xc_rho_set_and_dset_create(rho_set=rho_set, deriv_set=deriv_set, & @@ -1159,13 +1159,13 @@ SUBROUTINE xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau, xc_section SELECT CASE (desc) CASE ("(rho)", "(rhoa)", "(rhob)", "(norm_drho)", "(norm_drhoa)", & "(norm_drhob)") - n_deriv = n_deriv+1 + n_deriv = n_deriv + 1 CASE ("(tau)", "(tau_a)", "(tau_b)") has_tau = .TRUE. - n_deriv = n_deriv+1 + n_deriv = n_deriv + 1 CASE ("(laplace_rhoa)", "(laplace_rhob)") has_laplace = .TRUE. - n_deriv = n_deriv+1 + n_deriv = n_deriv + 1 CASE default !FM if you are looking at this error probably you are missing the !FM cross term (drhoa_drhob), I never got round to implement it, @@ -1177,13 +1177,13 @@ SUBROUTINE xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau, xc_section ELSE SELECT CASE (desc) CASE ("(rho)", "(norm_drho)") - n_deriv = n_deriv+1 + n_deriv = n_deriv + 1 CASE ("(tau)") has_tau = .TRUE. - n_deriv = n_deriv+1 + n_deriv = n_deriv + 1 CASE ("(laplace_rho)") has_laplace = .TRUE. - n_deriv = n_deriv+1 + n_deriv = n_deriv + 1 CASE default CPABORT("unknown functional derivative (LDA): '"//TRIM(desc)//"'") END SELECT @@ -1248,8 +1248,8 @@ SUBROUTINE xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau, xc_section DO k = bo(1, 3), bo(2, 3) DO j = bo(1, 2), bo(2, 2) DO i = bo(1, 1), bo(2, 1) - vxc_rho(1)%pw%cr3d(i, j, k) = vxc_rho(1)%pw%cr3d(i, j, k)+deriv_data(i, j, k) - vxc_rho(2)%pw%cr3d(i, j, k) = vxc_rho(2)%pw%cr3d(i, j, k)+deriv_data(i, j, k) + vxc_rho(1)%pw%cr3d(i, j, k) = vxc_rho(1)%pw%cr3d(i, j, k) + deriv_data(i, j, k) + vxc_rho(2)%pw%cr3d(i, j, k) = vxc_rho(2)%pw%cr3d(i, j, k) + deriv_data(i, j, k) END DO END DO END DO @@ -1285,8 +1285,8 @@ SUBROUTINE xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau, xc_section DO k = bo(1, 3), bo(2, 3) DO j = bo(1, 2), bo(2, 2) DO i = bo(1, 1), bo(2, 1) - ndr = SQRT(drho(1)%array(i, j, k)**2+ & - drho(2)%array(i, j, k)**2+ & + ndr = SQRT(drho(1)%array(i, j, k)**2 + & + drho(2)%array(i, j, k)**2 + & drho(3)%array(i, j, k)**2) deriv_data(i, j, k) = -deriv_data(i, j, k)/MAX(ndr, drho_cutoff) END DO @@ -1300,9 +1300,9 @@ SUBROUTINE xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau, xc_section DO k = bo(1, 3), bo(2, 3) DO j = bo(1, 2), bo(2, 2) DO i = bo(1, 1), bo(2, 1) - ndr = SQRT((drhoa(1)%array(i, j, k)+drhob(1)%array(i, j, k))**2+ & - (drhoa(2)%array(i, j, k)+drhob(2)%array(i, j, k))**2+ & - (drhoa(3)%array(i, j, k)+drhob(3)%array(i, j, k))**2) + ndr = SQRT((drhoa(1)%array(i, j, k) + drhob(1)%array(i, j, k))**2 + & + (drhoa(2)%array(i, j, k) + drhob(2)%array(i, j, k))**2 + & + (drhoa(3)%array(i, j, k) + drhob(3)%array(i, j, k))**2) deriv_data(i, j, k) = -deriv_data(i, j, k)/MAX(ndr, drho_cutoff) END DO END DO @@ -1359,14 +1359,14 @@ SUBROUTINE xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau, xc_section DO k = bo(1, 3), bo(2, 3) DO j = bo(1, 2), bo(2, 2) DO i = bo(1, 1), bo(2, 1) - my_rho = drhoa(idir)%array(i, j, k)+drhob(idir)%array(i, j, k) + my_rho = drhoa(idir)%array(i, j, k) + drhob(idir)%array(i, j, k) virial_pw%cr3d(i, j, k) = my_rho*deriv_data(i, j, k) END DO END DO END DO DO jdir = 1, idir virial_xc(idir, jdir) = pw_grid%dvol*accurate_sum(virial_pw%cr3d(:, :, :)* & - (drhoa(jdir)%array(:, :, :)+drhob(jdir)%array(:, :, :))) + (drhoa(jdir)%array(:, :, :) + drhob(jdir)%array(:, :, :))) virial_xc(jdir, idir) = virial_xc(idir, jdir) END DO END DO @@ -1381,7 +1381,7 @@ SUBROUTINE xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau, xc_section DO k = bo(1, 3), bo(2, 3) DO j = bo(1, 2), bo(2, 2) DO i = bo(1, 1), bo(2, 1) - my_rho = drhoa(idir)%array(i, j, k)+drhob(idir)%array(i, j, k) + my_rho = drhoa(idir)%array(i, j, k) + drhob(idir)%array(i, j, k) pw_to_deriv_rho(idir)%pw%cr3d(i, j, k) = my_rho*deriv_data(i, j, k) END DO END DO @@ -1433,8 +1433,8 @@ SUBROUTINE xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau, xc_section DO k = bo(1, 3), bo(2, 3) DO j = bo(1, 2), bo(2, 2) DO i = bo(1, 1), bo(2, 1) - ndr = SQRT(drho_spin(1)%array(i, j, k)**2+ & - drho_spin(2)%array(i, j, k)**2+ & + ndr = SQRT(drho_spin(1)%array(i, j, k)**2 + & + drho_spin(2)%array(i, j, k)**2 + & drho_spin(3)%array(i, j, k)**2) deriv_data(i, j, k) = -deriv_data(i, j, k)/MAX(ndr, drho_cutoff) END DO @@ -1456,7 +1456,7 @@ SUBROUTINE xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau, xc_section END DO END DO DO jdir = 1, idir - virial_xc(idir, jdir) = virial_xc(idir, jdir)+pw_grid%dvol* & + virial_xc(idir, jdir) = virial_xc(idir, jdir) + pw_grid%dvol* & accurate_sum(virial_pw%cr3d(:, :, :)* & drho_spin(jdir)%array(:, :, :)) virial_xc(jdir, idir) = virial_xc(idir, jdir) @@ -1992,7 +1992,7 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & SELECT CASE (order) CASE (1) IF (lsd) THEN - SELECT CASE (split_desc (1)) + SELECT CASE (split_desc(1)) CASE ("rho", "rhoa", "rhob") CASE ("norm_drho", "norm_drhoa", "norm_drhob") gradient_f = .TRUE. @@ -2000,7 +2000,7 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & unknown_deriv = .TRUE. END SELECT ELSE - SELECT CASE (split_desc (1)) + SELECT CASE (split_desc(1)) CASE ("rho") CASE ("norm_drho") gradient_f = .TRUE. @@ -2010,9 +2010,9 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & END IF CASE (2) IF (lsd) THEN - SELECT CASE (split_desc (1)) + SELECT CASE (split_desc(1)) CASE ("rhoa", "rhob") - SELECT CASE (split_desc (2)) + SELECT CASE (split_desc(2)) CASE ("rhoa", "rhob") CASE ("norm_drhoa", "norm_drhob", "norm_drho") gradient_f = .TRUE. @@ -2021,7 +2021,7 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & END SELECT CASE ("norm_drho", "norm_drhoa", "norm_drhob") gradient_f = .TRUE. - SELECT CASE (split_desc (2)) + SELECT CASE (split_desc(2)) CASE ("rhoa", "rhob", "norm_drhoa", "norm_drhob", "norm_drho") CASE default unknown_deriv = .TRUE. @@ -2030,9 +2030,9 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & unknown_deriv = .TRUE. END SELECT ELSE - SELECT CASE (split_desc (1)) + SELECT CASE (split_desc(1)) CASE ("rho") - SELECT CASE (split_desc (2)) + SELECT CASE (split_desc(2)) CASE ("rho") CASE ("norm_drho") gradient_f = .TRUE. @@ -2041,7 +2041,7 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & END SELECT CASE ("norm_drho") gradient_f = .TRUE. - SELECT CASE (split_desc (2)) + SELECT CASE (split_desc(2)) CASE ("rho", "norm_drho") CASE default unknown_deriv = .TRUE. @@ -2121,7 +2121,7 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & DO k = bo(1, 3), bo(2, 3) DO j = bo(1, 2), bo(2, 2) DO i = bo(1, 1), bo(2, 1) - v_xc(1)%pw%cr3d(i, j, k) = v_xc(1)%pw%cr3d(i, j, k)+ & + v_xc(1)%pw%cr3d(i, j, k) = v_xc(1)%pw%cr3d(i, j, k) + & deriv_data(i, j, k)*rho1a(i, j, k) END DO END DO @@ -2136,7 +2136,7 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & DO k = bo(1, 3), bo(2, 3) DO j = bo(1, 2), bo(2, 2) DO i = bo(1, 1), bo(2, 1) - v_xc(2)%pw%cr3d(i, j, k) = v_xc(2)%pw%cr3d(i, j, k)+ & + v_xc(2)%pw%cr3d(i, j, k) = v_xc(2)%pw%cr3d(i, j, k) + & deriv_data(i, j, k)*rho1b(i, j, k) END DO END DO @@ -2152,12 +2152,12 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & DO j = bo(1, 2), bo(2, 2) DO i = bo(1, 1), bo(2, 1) IF (nspins /= 1) THEN - v_xc(1)%pw%cr3d(i, j, k) = v_xc(1)%pw%cr3d(i, j, k)+ & + v_xc(1)%pw%cr3d(i, j, k) = v_xc(1)%pw%cr3d(i, j, k) + & deriv_data(i, j, k)*rho1b(i, j, k) - v_xc(2)%pw%cr3d(i, j, k) = v_xc(2)%pw%cr3d(i, j, k)+ & + v_xc(2)%pw%cr3d(i, j, k) = v_xc(2)%pw%cr3d(i, j, k) + & deriv_data(i, j, k)*rho1a(i, j, k) ELSE - v_xc(1)%pw%cr3d(i, j, k) = v_xc(1)%pw%cr3d(i, j, k)+ & + v_xc(1)%pw%cr3d(i, j, k) = v_xc(1)%pw%cr3d(i, j, k) + & fac*deriv_data(i, j, k)*rho1b(i, j, k) END IF END DO @@ -2174,11 +2174,11 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & DO i = bo(1, 1), bo(2, 1) dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) + dr1dr = dr1dr + drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) END DO - v_xc(1)%pw%cr3d(i, j, k) = v_xc(1)%pw%cr3d(i, j, k)+ & + v_xc(1)%pw%cr3d(i, j, k) = v_xc(1)%pw%cr3d(i, j, k) + & deriv_data(i, j, k)*dr1dr - tmp_a(1)%pw%cr3d(i, j, k) = tmp_a(1)%pw%cr3d(i, j, k)- & + tmp_a(1)%pw%cr3d(i, j, k) = tmp_a(1)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*rho1a(i, j, k) END DO END DO @@ -2195,11 +2195,11 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & DO i = bo(1, 1), bo(2, 1) dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+drhob(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) + dr1dr = dr1dr + drhob(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) END DO - v_xc(2)%pw%cr3d(i, j, k) = v_xc(2)%pw%cr3d(i, j, k)+ & + v_xc(2)%pw%cr3d(i, j, k) = v_xc(2)%pw%cr3d(i, j, k) + & deriv_data(i, j, k)*dr1dr - tmp_b(2)%pw%cr3d(i, j, k) = tmp_b(2)%pw%cr3d(i, j, k)- & + tmp_b(2)%pw%cr3d(i, j, k) = tmp_b(2)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*rho1b(i, j, k) END DO END DO @@ -2216,15 +2216,15 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & DO i = bo(1, 1), bo(2, 1) dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+drhob(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) + dr1dr = dr1dr + drhob(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) END DO IF (nspins /= 1) THEN - v_xc(1)%pw%cr3d(i, j, k) = v_xc(1)%pw%cr3d(i, j, k)+ & + v_xc(1)%pw%cr3d(i, j, k) = v_xc(1)%pw%cr3d(i, j, k) + & deriv_data(i, j, k)*dr1dr - tmp_b(2)%pw%cr3d(i, j, k) = tmp_b(2)%pw%cr3d(i, j, k)- & + tmp_b(2)%pw%cr3d(i, j, k) = tmp_b(2)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*rho1a(i, j, k) ELSE - v_xc(1)%pw%cr3d(i, j, k) = v_xc(1)%pw%cr3d(i, j, k)+ & + v_xc(1)%pw%cr3d(i, j, k) = v_xc(1)%pw%cr3d(i, j, k) + & fac*deriv_data(i, j, k)*dr1dr END IF END DO @@ -2242,14 +2242,14 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & IF (nspins /= 1) THEN dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) + dr1dr = dr1dr + drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) END DO - v_xc(2)%pw%cr3d(i, j, k) = v_xc(2)%pw%cr3d(i, j, k)+ & + v_xc(2)%pw%cr3d(i, j, k) = v_xc(2)%pw%cr3d(i, j, k) + & deriv_data(i, j, k)*dr1dr - tmp_a(1)%pw%cr3d(i, j, k) = tmp_a(1)%pw%cr3d(i, j, k)- & + tmp_a(1)%pw%cr3d(i, j, k) = tmp_a(1)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*rho1b(i, j, k) ELSE - tmp_a(1)%pw%cr3d(i, j, k) = tmp_a(1)%pw%cr3d(i, j, k)- & + tmp_a(1)%pw%cr3d(i, j, k) = tmp_a(1)%pw%cr3d(i, j, k) - & fac*deriv_data(i, j, k)*rho1b(i, j, k) END IF END DO @@ -2268,26 +2268,26 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & IF (nspins /= 1) THEN dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+(drhoa(idir)%array(i, j, k)+drhob(idir)%array(i, j, k))* & - (drho1a(idir)%array(i, j, k)+drho1b(idir)%array(i, j, k)) + dr1dr = dr1dr + (drhoa(idir)%array(i, j, k) + drhob(idir)%array(i, j, k))* & + (drho1a(idir)%array(i, j, k) + drho1b(idir)%array(i, j, k)) END DO - v_xc(1)%pw%cr3d(i, j, k) = v_xc(1)%pw%cr3d(i, j, k)+ & + v_xc(1)%pw%cr3d(i, j, k) = v_xc(1)%pw%cr3d(i, j, k) + & deriv_data(i, j, k)*dr1dr - tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k)- & + tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*rho1a(i, j, k) - tmp_c(2)%pw%cr3d(i, j, k) = tmp_c(2)%pw%cr3d(i, j, k)- & + tmp_c(2)%pw%cr3d(i, j, k) = tmp_c(2)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*rho1a(i, j, k) ELSE dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k)+ & - fac*drhoa(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k)+ & - fac*drhob(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k)+ & + dr1dr = dr1dr + drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) + & + fac*drhoa(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) + & + fac*drhob(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) + & drhob(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) END DO - v_xc(1)%pw%cr3d(i, j, k) = v_xc(1)%pw%cr3d(i, j, k)+ & + v_xc(1)%pw%cr3d(i, j, k) = v_xc(1)%pw%cr3d(i, j, k) + & deriv_data(i, j, k)*dr1dr - tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k)- & + tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*rho1a(i, j, k) END IF END DO @@ -2306,38 +2306,38 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & IF (nspins /= 1) THEN dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+(drhoa(idir)%array(i, j, k)+drhob(idir)%array(i, j, k))* & - (drho1a(idir)%array(i, j, k)+drho1b(idir)%array(i, j, k)) + dr1dr = dr1dr + (drhoa(idir)%array(i, j, k) + drhob(idir)%array(i, j, k))* & + (drho1a(idir)%array(i, j, k) + drho1b(idir)%array(i, j, k)) END DO - tmp_a(1)%pw%cr3d(i, j, k) = tmp_a(1)%pw%cr3d(i, j, k)- & + tmp_a(1)%pw%cr3d(i, j, k) = tmp_a(1)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*dr1dr dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) + dr1dr = dr1dr + drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) END DO - tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k)- & + tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*dr1dr dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) + dr1dr = dr1dr + drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) END DO - tmp_c(2)%pw%cr3d(i, j, k) = tmp_c(2)%pw%cr3d(i, j, k)- & + tmp_c(2)%pw%cr3d(i, j, k) = tmp_c(2)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*dr1dr ELSE dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k)+ & - fac*drhoa(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k)+ & - fac*drhob(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k)+ & + dr1dr = dr1dr + drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) + & + fac*drhoa(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) + & + fac*drhob(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) + & drhob(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) END DO - tmp_a(1)%pw%cr3d(i, j, k) = tmp_a(1)%pw%cr3d(i, j, k)- & + tmp_a(1)%pw%cr3d(i, j, k) = tmp_a(1)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*dr1dr dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) + dr1dr = dr1dr + drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) END DO - tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k)- & + tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*dr1dr END IF END DO @@ -2356,17 +2356,17 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & IF (nspins /= 1) THEN dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+(drhoa(idir)%array(i, j, k)+drhob(idir)%array(i, j, k))* & - (drho1a(idir)%array(i, j, k)+drho1b(idir)%array(i, j, k)) + dr1dr = dr1dr + (drhoa(idir)%array(i, j, k) + drhob(idir)%array(i, j, k))* & + (drho1a(idir)%array(i, j, k) + drho1b(idir)%array(i, j, k)) END DO - v_xc(2)%pw%cr3d(i, j, k) = v_xc(2)%pw%cr3d(i, j, k)+ & + v_xc(2)%pw%cr3d(i, j, k) = v_xc(2)%pw%cr3d(i, j, k) + & deriv_data(i, j, k)*dr1dr - tmp_c(2)%pw%cr3d(i, j, k) = tmp_c(2)%pw%cr3d(i, j, k)- & + tmp_c(2)%pw%cr3d(i, j, k) = tmp_c(2)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*rho1b(i, j, k) - tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k)- & + tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*rho1b(i, j, k) ELSE - tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k)- & + tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k) - & fac*deriv_data(i, j, k)*rho1b(i, j, k) END IF END DO @@ -2385,29 +2385,29 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & IF (nspins /= 1) THEN dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+(drhoa(idir)%array(i, j, k)+drhob(idir)%array(i, j, k))* & - (drho1a(idir)%array(i, j, k)+drho1b(idir)%array(i, j, k)) + dr1dr = dr1dr + (drhoa(idir)%array(i, j, k) + drhob(idir)%array(i, j, k))* & + (drho1a(idir)%array(i, j, k) + drho1b(idir)%array(i, j, k)) END DO - tmp_b(2)%pw%cr3d(i, j, k) = tmp_b(2)%pw%cr3d(i, j, k)- & + tmp_b(2)%pw%cr3d(i, j, k) = tmp_b(2)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*dr1dr dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+drhob(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) + dr1dr = dr1dr + drhob(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) END DO - tmp_c(2)%pw%cr3d(i, j, k) = tmp_c(2)%pw%cr3d(i, j, k)- & + tmp_c(2)%pw%cr3d(i, j, k) = tmp_c(2)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*dr1dr dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+drhob(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) + dr1dr = dr1dr + drhob(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) END DO - tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k)- & + tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*dr1dr ELSE dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+drhob(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) + dr1dr = dr1dr + drhob(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) END DO - tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k)- & + tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k) - & fac*deriv_data(i, j, k)*dr1dr END IF END DO @@ -2425,9 +2425,9 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & DO i = bo(1, 1), bo(2, 1) dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) + dr1dr = dr1dr + drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) END DO - tmp_a(1)%pw%cr3d(i, j, k) = tmp_a(1)%pw%cr3d(i, j, k)- & + tmp_a(1)%pw%cr3d(i, j, k) = tmp_a(1)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*dr1dr END DO END DO @@ -2445,9 +2445,9 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & DO i = bo(1, 1), bo(2, 1) dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+drhob(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) + dr1dr = dr1dr + drhob(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) END DO - tmp_b(2)%pw%cr3d(i, j, k) = tmp_b(2)%pw%cr3d(i, j, k)- & + tmp_b(2)%pw%cr3d(i, j, k) = tmp_b(2)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*dr1dr END DO END DO @@ -2465,19 +2465,19 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & DO i = bo(1, 1), bo(2, 1) dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+drhob(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) + dr1dr = dr1dr + drhob(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) END DO IF (nspins /= 1) THEN - tmp_a(1)%pw%cr3d(i, j, k) = tmp_a(1)%pw%cr3d(i, j, k)- & + tmp_a(1)%pw%cr3d(i, j, k) = tmp_a(1)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*dr1dr dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) + dr1dr = dr1dr + drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) END DO - tmp_b(2)%pw%cr3d(i, j, k) = tmp_b(2)%pw%cr3d(i, j, k)- & + tmp_b(2)%pw%cr3d(i, j, k) = tmp_b(2)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*dr1dr ELSE - tmp_a(1)%pw%cr3d(i, j, k) = tmp_a(1)%pw%cr3d(i, j, k)- & + tmp_a(1)%pw%cr3d(i, j, k) = tmp_a(1)%pw%cr3d(i, j, k) - & fac*deriv_data(i, j, k)*dr1dr END IF END DO @@ -2496,11 +2496,11 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & DO i = bo(1, 1), bo(2, 1) dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) + dr1dr = dr1dr + drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) END DO IF (rho_set%norm_drhoa(i, j, k) > gradient_cut) THEN dr1dr = dr1dr/(rho_set%norm_drhoa(i, j, k))**2 - tmp_a(1)%pw%cr3d(i, j, k) = tmp_a(1)%pw%cr3d(i, j, k)+ & + tmp_a(1)%pw%cr3d(i, j, k) = tmp_a(1)%pw%cr3d(i, j, k) + & deriv_data(i, j, k)*dr1dr END IF END DO @@ -2520,11 +2520,11 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & DO i = bo(1, 1), bo(2, 1) dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+drhob(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) + dr1dr = dr1dr + drhob(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) END DO IF (rho_set%norm_drhob(i, j, k) > gradient_cut) THEN dr1dr = dr1dr/(rho_set%norm_drhob(i, j, k))**2 - tmp_b(2)%pw%cr3d(i, j, k) = tmp_b(2)%pw%cr3d(i, j, k)+ & + tmp_b(2)%pw%cr3d(i, j, k) = tmp_b(2)%pw%cr3d(i, j, k) + & deriv_data(i, j, k)*dr1dr END IF END DO @@ -2544,22 +2544,22 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & IF (nspins /= 1) THEN dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+(drhoa(idir)%array(i, j, k)+drhob(idir)%array(i, j, k))* & - (drho1a(idir)%array(i, j, k)+drho1b(idir)%array(i, j, k)) + dr1dr = dr1dr + (drhoa(idir)%array(i, j, k) + drhob(idir)%array(i, j, k))* & + (drho1a(idir)%array(i, j, k) + drho1b(idir)%array(i, j, k)) END DO - tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k)- & + tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*dr1dr - tmp_c(2)%pw%cr3d(i, j, k) = tmp_c(2)%pw%cr3d(i, j, k)- & + tmp_c(2)%pw%cr3d(i, j, k) = tmp_c(2)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*dr1dr ELSE dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k)+ & - fac*drhoa(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k)+ & - fac*drhob(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k)+ & + dr1dr = dr1dr + drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) + & + fac*drhoa(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) + & + fac*drhob(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) + & drhob(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) END DO - tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k)- & + tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k) - & deriv_data(i, j, k)*dr1dr END IF END DO @@ -2578,22 +2578,22 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & IF (nspins /= 1) THEN dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+(drhoa(idir)%array(i, j, k)+drhob(idir)%array(i, j, k))* & - (drho1a(idir)%array(i, j, k)+drho1b(idir)%array(i, j, k)) + dr1dr = dr1dr + (drhoa(idir)%array(i, j, k) + drhob(idir)%array(i, j, k))* & + (drho1a(idir)%array(i, j, k) + drho1b(idir)%array(i, j, k)) END DO - tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k)+ & + tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k) + & deriv_data(i, j, k)*dr1dr - tmp_c(2)%pw%cr3d(i, j, k) = tmp_c(2)%pw%cr3d(i, j, k)+ & + tmp_c(2)%pw%cr3d(i, j, k) = tmp_c(2)%pw%cr3d(i, j, k) + & deriv_data(i, j, k)*dr1dr ELSE dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k)+ & - fac*drhoa(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k)+ & - fac*drhob(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k)+ & + dr1dr = dr1dr + drhoa(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) + & + fac*drhoa(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) + & + fac*drhob(idir)%array(i, j, k)*drho1a(idir)%array(i, j, k) + & drhob(idir)%array(i, j, k)*drho1b(idir)%array(i, j, k) END DO - tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k)+ & + tmp_c(1)%pw%cr3d(i, j, k) = tmp_c(1)%pw%cr3d(i, j, k) + & deriv_data(i, j, k)*dr1dr END IF END DO @@ -2617,30 +2617,30 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & DO idir = 1, 3 DO ispin = 1, nspins vxg(idir, ia, ir, ispin) = & - tmp_a(ispin)%pw%cr3d(ia, ir, 1)*drhoa(idir)%array(ia, ir, 1)+ & - tmp_b(ispin)%pw%cr3d(ia, ir, 1)*drhob(idir)%array(ia, ir, 1)+ & - tmp_c(ispin)%pw%cr3d(ia, ir, 1)*(drhoa(idir)%array(ia, ir, 1)+ & + tmp_a(ispin)%pw%cr3d(ia, ir, 1)*drhoa(idir)%array(ia, ir, 1) + & + tmp_b(ispin)%pw%cr3d(ia, ir, 1)*drhob(idir)%array(ia, ir, 1) + & + tmp_c(ispin)%pw%cr3d(ia, ir, 1)*(drhoa(idir)%array(ia, ir, 1) + & drhob(idir)%array(ia, ir, 1)) END DO IF (ASSOCIATED(e_drhoa)) THEN - vxg(idir, ia, ir, 1) = vxg(idir, ia, ir, 1)- & + vxg(idir, ia, ir, 1) = vxg(idir, ia, ir, 1) - & e_drhoa(ia, ir, 1)*drho1a(idir)%array(ia, ir, 1) END IF IF (nspins /= 1 .AND. ASSOCIATED(e_drhob)) THEN - vxg(idir, ia, ir, 2) = vxg(idir, ia, ir, 2)- & + vxg(idir, ia, ir, 2) = vxg(idir, ia, ir, 2) - & e_drhob(ia, ir, 1)*drho1b(idir)%array(ia, ir, 1) END IF IF (ASSOCIATED(e_norm_drho)) THEN IF (nspins /= 1) THEN - vxg(idir, ia, ir, 1) = vxg(idir, ia, ir, 1)- & - e_norm_drho(ia, ir, 1)*(drho1a(idir)%array(ia, ir, 1)+ & + vxg(idir, ia, ir, 1) = vxg(idir, ia, ir, 1) - & + e_norm_drho(ia, ir, 1)*(drho1a(idir)%array(ia, ir, 1) + & drho1b(idir)%array(ia, ir, 1)) - vxg(idir, ia, ir, 2) = vxg(idir, ia, ir, 2)- & - e_norm_drho(ia, ir, 1)*(drho1a(idir)%array(ia, ir, 1)+ & + vxg(idir, ia, ir, 2) = vxg(idir, ia, ir, 2) - & + e_norm_drho(ia, ir, 1)*(drho1a(idir)%array(ia, ir, 1) + & drho1b(idir)%array(ia, ir, 1)) ELSE - vxg(idir, ia, ir, 1) = vxg(idir, ia, ir, 1)- & - e_norm_drho(ia, ir, 1)*(drho1a(idir)%array(ia, ir, 1)+ & + vxg(idir, ia, ir, 1) = vxg(idir, ia, ir, 1) - & + e_norm_drho(ia, ir, 1)*(drho1a(idir)%array(ia, ir, 1) + & fac*drho1b(idir)%array(ia, ir, 1)) END IF END IF @@ -2659,9 +2659,9 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & DO j = bo(1, 2), bo(2, 2) DO i = bo(1, 1), bo(2, 1) tmp_r(ispin)%pw%cr3d(i, j, k) = & - tmp_a(ispin)%pw%cr3d(i, j, k)*drhoa(idir)%array(i, j, k)+ & - tmp_b(ispin)%pw%cr3d(i, j, k)*drhob(idir)%array(i, j, k)+ & - tmp_c(ispin)%pw%cr3d(i, j, k)*(drhoa(idir)%array(i, j, k)+ & + tmp_a(ispin)%pw%cr3d(i, j, k)*drhoa(idir)%array(i, j, k) + & + tmp_b(ispin)%pw%cr3d(i, j, k)*drhob(idir)%array(i, j, k) + & + tmp_c(ispin)%pw%cr3d(i, j, k)*(drhoa(idir)%array(i, j, k) + & drhob(idir)%array(i, j, k)) END DO END DO @@ -2673,7 +2673,7 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & DO k = bo(1, 3), bo(2, 3) DO j = bo(1, 2), bo(2, 2) DO i = bo(1, 1), bo(2, 1) - tmp_r(1)%pw%cr3d(i, j, k) = tmp_r(1)%pw%cr3d(i, j, k)- & + tmp_r(1)%pw%cr3d(i, j, k) = tmp_r(1)%pw%cr3d(i, j, k) - & e_drhoa(i, j, k)*drho1a(idir)%array(i, j, k) END DO END DO @@ -2685,7 +2685,7 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & DO k = bo(1, 3), bo(2, 3) DO j = bo(1, 2), bo(2, 2) DO i = bo(1, 1), bo(2, 1) - tmp_r(2)%pw%cr3d(i, j, k) = tmp_r(2)%pw%cr3d(i, j, k)- & + tmp_r(2)%pw%cr3d(i, j, k) = tmp_r(2)%pw%cr3d(i, j, k) - & e_drhob(i, j, k)*drho1b(idir)%array(i, j, k) END DO END DO @@ -2698,15 +2698,15 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & DO j = bo(1, 2), bo(2, 2) DO i = bo(1, 1), bo(2, 1) IF (nspins /= 1) THEN - tmp_r(1)%pw%cr3d(i, j, k) = tmp_r(1)%pw%cr3d(i, j, k)- & - e_norm_drho(i, j, k)*(drho1a(idir)%array(i, j, k)+ & + tmp_r(1)%pw%cr3d(i, j, k) = tmp_r(1)%pw%cr3d(i, j, k) - & + e_norm_drho(i, j, k)*(drho1a(idir)%array(i, j, k) + & drho1b(idir)%array(i, j, k)) - tmp_r(2)%pw%cr3d(i, j, k) = tmp_r(2)%pw%cr3d(i, j, k)- & - e_norm_drho(i, j, k)*(drho1a(idir)%array(i, j, k)+ & + tmp_r(2)%pw%cr3d(i, j, k) = tmp_r(2)%pw%cr3d(i, j, k) - & + e_norm_drho(i, j, k)*(drho1a(idir)%array(i, j, k) + & drho1b(idir)%array(i, j, k)) ELSE - tmp_r(1)%pw%cr3d(i, j, k) = tmp_r(1)%pw%cr3d(i, j, k)- & - e_norm_drho(i, j, k)*(drho1a(idir)%array(i, j, k)+ & + tmp_r(1)%pw%cr3d(i, j, k) = tmp_r(1)%pw%cr3d(i, j, k) - & + e_norm_drho(i, j, k)*(drho1a(idir)%array(i, j, k) + & fac*drho1b(idir)%array(i, j, k)) END IF END DO @@ -2834,9 +2834,9 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & DO i = bo(1, 1), bo(2, 1) dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+drho(idir)%array(i, j, k)*drho1(idir)%array(i, j, k) + dr1dr = dr1dr + drho(idir)%array(i, j, k)*drho1(idir)%array(i, j, k) END DO - v_xc(1)%pw%cr3d(i, j, k) = v_xc(1)%pw%cr3d(i, j, k)+ & + v_xc(1)%pw%cr3d(i, j, k) = v_xc(1)%pw%cr3d(i, j, k) + & deriv_data(i, j, k)*dr1dr v_drho%pw%cr3d(i, j, k) = -1._dp*deriv_data(i, j, k)*rho1(i, j, k) END DO @@ -2854,9 +2854,9 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & DO i = bo(1, 1), bo(2, 1) dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+drho(idir)%array(i, j, k)*drho1(idir)%array(i, j, k) + dr1dr = dr1dr + drho(idir)%array(i, j, k)*drho1(idir)%array(i, j, k) END DO - v_drho%pw%cr3d(i, j, k) = v_drho%pw%cr3d(i, j, k)-deriv_data(i, j, k)*dr1dr + v_drho%pw%cr3d(i, j, k) = v_drho%pw%cr3d(i, j, k) - deriv_data(i, j, k)*dr1dr END DO END DO END DO @@ -2873,11 +2873,11 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & DO i = bo(1, 1), bo(2, 1) dr1dr = 0._dp DO idir = 1, 3 - dr1dr = dr1dr+drho(idir)%array(i, j, k)*drho1(idir)%array(i, j, k) + dr1dr = dr1dr + drho(idir)%array(i, j, k)*drho1(idir)%array(i, j, k) END DO IF (rho_set%norm_drho(i, j, k) > gradient_cut) THEN dr1dr = dr1dr/(rho_set%norm_drho(i, j, k))**2 - v_drho%pw%cr3d(i, j, k) = v_drho%pw%cr3d(i, j, k)+deriv_data(i, j, k)*dr1dr + v_drho%pw%cr3d(i, j, k) = v_drho%pw%cr3d(i, j, k) + deriv_data(i, j, k)*dr1dr END IF END DO END DO @@ -2895,7 +2895,7 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & DO ir = bo(1, 2), bo(2, 2) vxg(idir, ia, ir, 1) = drho(idir)%array(ia, ir, 1)*v_drho%pw%cr3d(ia, ir, 1) IF (ASSOCIATED(e_norm_drho)) THEN - vxg(idir, ia, ir, 1) = vxg(idir, ia, ir, 1)-drho1(idir)%array(ia, ir, 1)*e_norm_drho(ia, ir, 1) + vxg(idir, ia, ir, 1) = vxg(idir, ia, ir, 1) - drho1(idir)%array(ia, ir, 1)*e_norm_drho(ia, ir, 1) END IF END DO END DO @@ -2937,7 +2937,7 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, deriv_set, rho_set, rho1_set, & DO k = bo(1, 3), bo(2, 3) DO j = bo(1, 2), bo(2, 2) DO i = bo(1, 1), bo(2, 1) - tmp_r(1)%pw%cr3d(i, j, k) = drho(idir)%array(i, j, k)*v_drho%pw%cr3d(i, j, k)- & + tmp_r(1)%pw%cr3d(i, j, k) = drho(idir)%array(i, j, k)*v_drho%pw%cr3d(i, j, k) - & drho1(idir)%array(i, j, k)*deriv_data(i, j, k) END DO END DO @@ -3108,7 +3108,7 @@ SUBROUTINE divide_by_norm_drho(deriv_set, rho_set, lsd) desc=desc, split_desc=split_desc) IF (order == 1 .OR. order == 2) THEN DO idesc = 1, SIZE(split_desc) - SELECT CASE (split_desc (idesc)) + SELECT CASE (split_desc(idesc)) CASE ("norm_drho") !$OMP PARALLEL DO PRIVATE(i,j,k) DEFAULT(NONE) SHARED(bo,deriv_att,rho_set,drho_cutoff) DO k = bo(1, 3), bo(2, 3) diff --git a/src/xc/xc_atom.F b/src/xc/xc_atom.F index 8bf4fa06fc..45441b6046 100644 --- a/src/xc/xc_atom.F +++ b/src/xc/xc_atom.F @@ -159,7 +159,7 @@ SUBROUTINE vxc_of_r_new(xc_fun_section, rho_set, deriv_set, deriv_order, needs, exc = 0.0_dp DO ir = 1, nr DO ia = 1, na - exc = exc+deriv_data(ia, ir, 1)*w(ia, ir) + exc = exc + deriv_data(ia, ir, 1)*w(ia, ir) END DO END DO NULLIFY (deriv_data) @@ -172,7 +172,7 @@ SUBROUTINE vxc_of_r_new(xc_fun_section, rho_set, deriv_set, deriv_order, needs, exc = 0.0_dp DO ir = 1, nr DO ia = 1, na - exc = exc+deriv_data(ia, ir, 1)*w(ia, ir) + exc = exc + deriv_data(ia, ir, 1)*w(ia, ir) END DO END DO NULLIFY (deriv_data) @@ -196,8 +196,8 @@ SUBROUTINE vxc_of_r_new(xc_fun_section, rho_set, deriv_set, deriv_order, needs, deriv_att => xc_dset_get_derivative(deriv_set, "(rho)") IF (ASSOCIATED(deriv_att)) THEN CALL xc_derivative_get(deriv_att, deriv_data=deriv_data) - vxc(:, :, 1) = vxc(:, :, 1)+deriv_data(:, :, 1)*w(:, :)*my_adiabatic_rescale_factor - vxc(:, :, 2) = vxc(:, :, 2)+deriv_data(:, :, 1)*w(:, :)*my_adiabatic_rescale_factor + vxc(:, :, 1) = vxc(:, :, 1) + deriv_data(:, :, 1)*w(:, :)*my_adiabatic_rescale_factor + vxc(:, :, 2) = vxc(:, :, 2) + deriv_data(:, :, 1)*w(:, :)*my_adiabatic_rescale_factor NULLIFY (deriv_data) END IF ELSE @@ -256,8 +256,8 @@ SUBROUTINE vxc_of_r_new(xc_fun_section, rho_set, deriv_set, deriv_order, needs, DO idir = 1, 3 IF (rho_set%norm_drho(ia, ir, 1) > drho_cutoff) THEN vxg(idir, ia, ir, 1:2) = & - vxg(idir, ia, ir, 1:2)+( & - rho_set%drhoa(idir)%array(ia, ir, 1)+ & + vxg(idir, ia, ir, 1:2) + ( & + rho_set%drhoa(idir)%array(ia, ir, 1) + & rho_set%drhob(idir)%array(ia, ir, 1))* & deriv_data(ia, ir, 1)*w(ia, ir)/rho_set%norm_drho(ia, ir, 1)* & my_adiabatic_rescale_factor @@ -670,7 +670,7 @@ SUBROUTINE fill_rho_set(rho_set, lsd, nspins, needs, rho, drho, tau, na, ir) ! this should never be the case unless you use LDA functionals with LSD IF (.NOT. tddft_split) THEN DO ia = 1, na - rho_set%rho(ia, ir, 1) = rho(ia, 1)+rho(ia, 2) + rho_set%rho(ia, ir, 1) = rho(ia, 1) + rho(ia, 2) END DO ELSE DO ia = 1, na @@ -684,7 +684,7 @@ SUBROUTINE fill_rho_set(rho_set, lsd, nspins, needs, rho, drho, tau, na, ir) IF (needs%rho_1_3) THEN IF (.NOT. tddft_split) THEN DO ia = 1, na - rho_set%rho_1_3(ia, ir, 1) = MAX(rho(ia, 1)+rho(ia, 2), 0.0_dp)**f13 + rho_set%rho_1_3(ia, ir, 1) = MAX(rho(ia, 1) + rho(ia, 2), 0.0_dp)**f13 END DO ELSE DO ia = 1, na @@ -731,9 +731,9 @@ SUBROUTINE fill_rho_set(rho_set, lsd, nspins, needs, rho, drho, tau, na, ir) IF (.NOT. tddft_split) THEN DO ia = 1, na rho_set%norm_drho(ia, ir, 1) = SQRT( & - (drho(1, ia, ir, 1)+drho(1, ia, ir, 2))**2+ & - (drho(2, ia, ir, 1)+drho(2, ia, ir, 2))**2+ & - (drho(3, ia, ir, 1)+drho(3, ia, ir, 2))**2) + (drho(1, ia, ir, 1) + drho(1, ia, ir, 2))**2 + & + (drho(2, ia, ir, 1) + drho(2, ia, ir, 2))**2 + & + (drho(3, ia, ir, 1) + drho(3, ia, ir, 2))**2) END DO ELSE DO ia = 1, na @@ -768,8 +768,8 @@ SUBROUTINE fill_rho_set(rho_set, lsd, nspins, needs, rho, drho, tau, na, ir) IF (.NOT. tddft_split) THEN DO ia = 1, na rho_set%drhoa_drhob(ia, ir, 1) = & - (drho(1, ia, ir, 1)*drho(1, ia, ir, 2))+ & - (drho(2, ia, ir, 1)*drho(2, ia, ir, 2))+ & + (drho(1, ia, ir, 1)*drho(1, ia, ir, 2)) + & + (drho(2, ia, ir, 1)*drho(2, ia, ir, 2)) + & (drho(3, ia, ir, 1)*drho(3, ia, ir, 2)) END DO ELSE @@ -789,7 +789,7 @@ SUBROUTINE fill_rho_set(rho_set, lsd, nspins, needs, rho, drho, tau, na, ir) IF (.NOT. tddft_split) THEN DO idir = 1, 3 DO ia = 1, na - rho_set%drho(idir)%array(ia, ir, 1) = drho(idir, ia, ir, 1)+drho(idir, ia, ir, 2) + rho_set%drho(idir)%array(ia, ir, 1) = drho(idir, ia, ir, 1) + drho(idir, ia, ir, 2) END DO END DO ELSE @@ -833,7 +833,7 @@ SUBROUTINE fill_rho_set(rho_set, lsd, nspins, needs, rho, drho, tau, na, ir) IF (needs%tau) THEN IF (my_nspins == 2) THEN DO ia = 1, na - rho_set%tau(ia, ir, 1) = tau(ia, 1)+tau(ia, 2) + rho_set%tau(ia, ir, 1) = tau(ia, 1) + tau(ia, 2) END DO rho_set%owns%tau = .TRUE. rho_set%has%tau = .TRUE. diff --git a/src/xc/xc_b97.F b/src/xc/xc_b97.F index 83adbceb41..ef15c75263 100644 --- a/src/xc/xc_b97.F +++ b/src/xc/xc_b97.F @@ -49,7 +49,7 @@ MODULE xc_b97 PUBLIC :: b97_lda_info, b97_lsd_info, b97_lda_eval, b97_lsd_eval REAL(dp), DIMENSION(10) :: params_b97_orig = (/0.8094_dp, 0.5073_dp, 0.7481_dp, & - 0.9454_dp, 0.7471_dp, -4.5961_dp, 0.1737_dp, 2.3487_dp, -2.4868_dp, 1.0_dp-0.1943_dp/) + 0.9454_dp, 0.7471_dp, -4.5961_dp, 0.1737_dp, 2.3487_dp, -2.4868_dp, 1.0_dp - 0.1943_dp/) REAL(dp), DIMENSION(10) :: params_b97_grimme = (/1.08662_dp, -0.52127_dp, 3.25429_dp, & 0.69041_dp, 6.30270_dp, -14.9712_dp, 0.22340_dp, -1.56208_dp, 1.94293_dp, 1.0_dp/) REAL(dp), DIMENSION(10) :: params_b97_mardirossian = (/0.833_dp, 0.603_dp, 1.194_dp, & @@ -274,7 +274,7 @@ SUBROUTINE b97_lda_eval(rho_set, deriv_set, grad_deriv, b97_params) CALL xc_rho_set_get(rho_set, rho=rho, & norm_drho=norm_drho, local_bounds=bo, rho_cutoff=epsilon_rho, & drho_cutoff=epsilon_norm_drho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rho @@ -392,7 +392,7 @@ SUBROUTINE b97_lsd_eval(rho_set, deriv_set, grad_deriv, b97_params) norm_drhob=norm_drhob, & rho_cutoff=epsilon_rho, & local_bounds=bo) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rhoa e_0 => dummy @@ -693,11 +693,11 @@ SUBROUTINE b97_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, & DO ii = 1, npoints my_rhoa = MAX(rhoa(ii), 0.0_dp) my_rhob = MAX(rhob(ii), 0.0_dp) - rho = my_rhoa+my_rhob + rho = my_rhoa + my_rhob IF (rho > epsilon_rho) THEN my_rhoa = MAX(my_rhoa, 0.5_dp*epsilon_rho) my_rhob = MAX(my_rhob, 0.5_dp*epsilon_rho) - rho = my_rhoa+my_rhob + rho = my_rhoa + my_rhob my_norm_drhoa = norm_drhoa(ii) my_norm_drhob = norm_drhob(ii) t7 = my_rhoa**(0.1e1_dp/0.3e1_dp) @@ -707,11 +707,11 @@ SUBROUTINE b97_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, & s_a = my_norm_drhoa*t12 t13 = s_a**2 t14 = gamma_x*t13 - t15 = 0.1e1_dp+t14 + t15 = 0.1e1_dp + t14 t16 = 0.1e1_dp/t15 u_x_a = t14*t16 - t18 = c_x_1+u_x_a*c_x_2 - gx_a = c_x_0+u_x_a*t18 + t18 = c_x_1 + u_x_a*c_x_2 + gx_a = c_x_0 + u_x_a*t18 t20 = my_rhob**(0.1e1_dp/0.3e1_dp) t21 = t20*my_rhob e_lsda_x_b = -0.3e1_dp/0.8e1_dp*t4*t6*t21 @@ -719,114 +719,114 @@ SUBROUTINE b97_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, & s_b = my_norm_drhob*t25 t26 = s_b**2 t27 = gamma_x*t26 - t28 = 0.1e1_dp+t27 + t28 = 0.1e1_dp + t27 t29 = 0.1e1_dp/t28 u_x_b = t27*t29 - t31 = c_x_1+u_x_b*c_x_2 - gx_b = c_x_0+u_x_b*t31 - t33 = my_rhoa-my_rhob + t31 = c_x_1 + u_x_b*c_x_2 + gx_b = c_x_0 + u_x_b*t31 + t33 = my_rhoa - my_rhob t34 = 0.1e1_dp/rho chi = t33*t34 t35 = 0.1e1_dp/pi t36 = t35*t34 t37 = t36**(0.1e1_dp/0.3e1_dp) rs = t4*t37/0.4e1_dp - t40 = 0.1e1_dp+alpha_1_1*rs + t40 = 0.1e1_dp + alpha_1_1*rs t42 = 0.1e1_dp/A_1 t43 = SQRT(rs) t46 = t43*rs - t48 = p_1+0.1e1_dp + t48 = p_1 + 0.1e1_dp t49 = rs**t48 t50 = beta_4_1*t49 - t51 = beta_1_1*t43+beta_2_1*rs+beta_3_1*t46+t50 - t55 = 0.1e1_dp+t42/t51/0.2e1_dp + t51 = beta_1_1*t43 + beta_2_1*rs + beta_3_1*t46 + t50 + t55 = 0.1e1_dp + t42/t51/0.2e1_dp t56 = LOG(t55) e_c_u_0 = -0.2e1_dp*A_1*t40*t56 - t60 = 0.1e1_dp+alpha_1_2*rs + t60 = 0.1e1_dp + alpha_1_2*rs t62 = 0.1e1_dp/A_2 - t66 = p_2+0.1e1_dp + t66 = p_2 + 0.1e1_dp t67 = rs**t66 t68 = beta_4_2*t67 - t69 = beta_1_2*t43+beta_2_2*rs+beta_3_2*t46+t68 - t73 = 0.1e1_dp+t62/t69/0.2e1_dp + t69 = beta_1_2*t43 + beta_2_2*rs + beta_3_2*t46 + t68 + t73 = 0.1e1_dp + t62/t69/0.2e1_dp t74 = LOG(t73) - t78 = 0.1e1_dp+alpha_1_3*rs + t78 = 0.1e1_dp + alpha_1_3*rs t80 = 0.1e1_dp/A_3 - t84 = p_3+0.1e1_dp + t84 = p_3 + 0.1e1_dp t85 = rs**t84 t86 = beta_4_3*t85 - t87 = beta_1_3*t43+beta_2_3*rs+beta_3_3*t46+t86 - t91 = 0.1e1_dp+t80/t87/0.2e1_dp + t87 = beta_1_3*t43 + beta_2_3*rs + beta_3_3*t46 + t86 + t91 = 0.1e1_dp + t80/t87/0.2e1_dp t92 = LOG(t91) alpha_c = 0.2e1_dp*A_3*t78*t92 t94 = 2**(0.1e1_dp/0.3e1_dp) - t97 = 1/(2*t94-2) - t98 = 0.1e1_dp+chi + t97 = 1/(2*t94 - 2) + t98 = 0.1e1_dp + chi t99 = t98**(0.1e1_dp/0.3e1_dp) - t101 = 0.1e1_dp-chi + t101 = 0.1e1_dp - chi t102 = t101**(0.1e1_dp/0.3e1_dp) - f = (t99*t98+t102*t101-0.2e1_dp)*t97 + f = (t99*t98 + t102*t101 - 0.2e1_dp)*t97 t105 = alpha_c*f t106 = 0.9e1_dp/0.8e1_dp/t97 t107 = chi**2 t108 = t107**2 - t110 = t106*(0.1e1_dp-t108) - t112 = -0.2e1_dp*A_2*t60*t74-e_c_u_0 + t110 = t106*(0.1e1_dp - t108) + t112 = -0.2e1_dp*A_2*t60*t74 - e_c_u_0 t113 = t112*f - epsilon_c_unif = e_c_u_0+t105*t110+t113*t108 + epsilon_c_unif = e_c_u_0 + t105*t110 + t113*t108 t116 = t35/my_rhoa t117 = t116**(0.1e1_dp/0.3e1_dp) rs_a = t4*t117/0.4e1_dp - t120 = 0.1e1_dp+alpha_1_2*rs_a + t120 = 0.1e1_dp + alpha_1_2*rs_a t122 = SQRT(rs_a) t125 = t122*rs_a t127 = rs_a**t66 t128 = beta_4_2*t127 - t129 = beta_1_2*t122+beta_2_2*rs_a+beta_3_2*t125+t128 - t133 = 0.1e1_dp+t62/t129/0.2e1_dp + t129 = beta_1_2*t122 + beta_2_2*rs_a + beta_3_2*t125 + t128 + t133 = 0.1e1_dp + t62/t129/0.2e1_dp t134 = LOG(t133) epsilon_c_unif_a = -0.2e1_dp*A_2*t120*t134 t138 = t35/my_rhob t139 = t138**(0.1e1_dp/0.3e1_dp) rs_b = t4*t139/0.4e1_dp - t142 = 0.1e1_dp+alpha_1_2*rs_b + t142 = 0.1e1_dp + alpha_1_2*rs_b t144 = SQRT(rs_b) t147 = t144*rs_b t149 = rs_b**t66 t150 = beta_4_2*t149 - t151 = beta_1_2*t144+beta_2_2*rs_b+beta_3_2*t147+t150 - t155 = 0.1e1_dp+t62/t151/0.2e1_dp + t151 = beta_1_2*t144 + beta_2_2*rs_b + beta_3_2*t147 + t150 + t155 = 0.1e1_dp + t62/t151/0.2e1_dp t156 = LOG(t155) epsilon_c_unif_b = -0.2e1_dp*A_2*t142*t156 s_a_2 = t13 s_b_2 = t26 - s_avg_2 = s_a_2/0.2e1_dp+s_b_2/0.2e1_dp + s_avg_2 = s_a_2/0.2e1_dp + s_b_2/0.2e1_dp e_lsda_c_a = epsilon_c_unif_a*my_rhoa e_lsda_c_b = epsilon_c_unif_b*my_rhob t160 = gamma_c_ab*s_avg_2 - t161 = 0.1e1_dp+t160 + t161 = 0.1e1_dp + t160 t162 = 0.1e1_dp/t161 u_c_ab = t160*t162 t163 = gamma_c_ss*s_a_2 - t164 = 0.1e1_dp+t163 + t164 = 0.1e1_dp + t163 t165 = 0.1e1_dp/t164 u_c_a = t163*t165 t166 = gamma_c_ss*s_b_2 - t167 = 0.1e1_dp+t166 + t167 = 0.1e1_dp + t166 t168 = 0.1e1_dp/t167 u_c_b = t166*t168 - e_lsda_c_ab = epsilon_c_unif*rho-e_lsda_c_a-e_lsda_c_b - t170 = c_cab_1+u_c_ab*c_cab_2 - gc_ab = c_cab_0+u_c_ab*t170 - t173 = c_css_1+u_c_a*c_css_2 - gc_a = c_css_0+u_c_a*t173 - t176 = c_css_1+u_c_b*c_css_2 - gc_b = c_css_0+u_c_b*t176 + e_lsda_c_ab = epsilon_c_unif*rho - e_lsda_c_a - e_lsda_c_b + t170 = c_cab_1 + u_c_ab*c_cab_2 + gc_ab = c_cab_0 + u_c_ab*t170 + t173 = c_css_1 + u_c_a*c_css_2 + gc_a = c_css_0 + u_c_a*t173 + t176 = c_css_1 + u_c_b*c_css_2 + gc_b = c_css_0 + u_c_b*t176 IF (grad_deriv >= 0) THEN - exc = scale_x*(e_lsda_x_a*gx_a+e_lsda_x_b*gx_b)+scale_c & - *(e_lsda_c_ab*gc_ab+e_lsda_c_a*gc_a+e_lsda_c_b*gc_b) - e_0(ii) = e_0(ii)+exc + exc = scale_x*(e_lsda_x_a*gx_a + e_lsda_x_b*gx_b) + scale_c & + *(e_lsda_c_ab*gc_ab + e_lsda_c_a*gc_a + e_lsda_c_b*gc_b) + e_0(ii) = e_0(ii) + exc END IF IF (grad_deriv /= 0) THEN @@ -842,12 +842,12 @@ SUBROUTINE b97_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, & t197 = t15**2 t198 = 0.1e1_dp/t197 t199 = t198*s_arhoa - u_x_arhoa = 0.2e1_dp*t191*t192-0.2e1_dp*t196*t199 - gx_arhoa = u_x_arhoa*t18+u_x_a*u_x_arhoa*c_x_2 + u_x_arhoa = 0.2e1_dp*t191*t192 - 0.2e1_dp*t196*t199 + gx_arhoa = u_x_arhoa*t18 + u_x_a*u_x_arhoa*c_x_2 t207 = rho**2 t208 = 0.1e1_dp/t207 t209 = t33*t208 - chirhoa = t34-t209 + chirhoa = t34 - t209 t210 = t37**2 t212 = 0.1e1_dp/t210*t35 rsrhoa = -t4*t212*t208/0.12e2_dp @@ -859,34 +859,34 @@ SUBROUTINE b97_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, & t224 = beta_1_1*t223 t228 = beta_3_1*t43 t232 = 0.1e1_dp/rs - t235 = t224*rsrhoa/0.2e1_dp+beta_2_1*rsrhoa+0.3e1_dp/ & - 0.2e1_dp*t228*rsrhoa+t50*t48*rsrhoa*t232 + t235 = t224*rsrhoa/0.2e1_dp + beta_2_1*rsrhoa + 0.3e1_dp/ & + 0.2e1_dp*t228*rsrhoa + t50*t48*rsrhoa*t232 t236 = 0.1e1_dp/t55 t237 = t235*t236 - e_c_u_0rhoa = -0.2e1_dp*t216*rsrhoa*t56+t222*t237 + e_c_u_0rhoa = -0.2e1_dp*t216*rsrhoa*t56 + t222*t237 t239 = A_2*alpha_1_2 t243 = t69**2 t244 = 0.1e1_dp/t243 t245 = t60*t244 t246 = beta_1_2*t223 t250 = beta_3_2*t43 - t256 = t246*rsrhoa/0.2e1_dp+beta_2_2*rsrhoa+0.3e1_dp/ & - 0.2e1_dp*t250*rsrhoa+t68*t66*rsrhoa*t232 + t256 = t246*rsrhoa/0.2e1_dp + beta_2_2*rsrhoa + 0.3e1_dp/ & + 0.2e1_dp*t250*rsrhoa + t68*t66*rsrhoa*t232 t257 = 0.1e1_dp/t73 t258 = t256*t257 - e_c_u_1rhoa = -0.2e1_dp*t239*rsrhoa*t74+t245*t258 + e_c_u_1rhoa = -0.2e1_dp*t239*rsrhoa*t74 + t245*t258 t260 = A_3*alpha_1_3 t264 = t87**2 t265 = 0.1e1_dp/t264 t266 = t78*t265 t267 = beta_1_3*t223 t271 = beta_3_3*t43 - t277 = t267*rsrhoa/0.2e1_dp+beta_2_3*rsrhoa+0.3e1_dp/ & - 0.2e1_dp*t271*rsrhoa+t86*t84*rsrhoa*t232 + t277 = t267*rsrhoa/0.2e1_dp + beta_2_3*rsrhoa + 0.3e1_dp/ & + 0.2e1_dp*t271*rsrhoa + t86*t84*rsrhoa*t232 t278 = 0.1e1_dp/t91 t279 = t277*t278 - alpha_crhoa = 0.2e1_dp*t260*rsrhoa*t92-t266*t279 - frhoa = (0.4e1_dp/0.3e1_dp*t99*chirhoa-0.4e1_dp/0.3e1_dp & + alpha_crhoa = 0.2e1_dp*t260*rsrhoa*t92 - t266*t279 + frhoa = (0.4e1_dp/0.3e1_dp*t99*chirhoa - 0.4e1_dp/0.3e1_dp & *t102*chirhoa)*t97 t285 = alpha_crhoa*f t287 = alpha_c*frhoa @@ -894,13 +894,13 @@ SUBROUTINE b97_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, & t290 = t106*t289 t291 = t290*chirhoa t293 = 0.4e1_dp*t105*t291 - t294 = e_c_u_1rhoa-e_c_u_0rhoa + t294 = e_c_u_1rhoa - e_c_u_0rhoa t295 = t294*f t297 = t112*frhoa t299 = t289*chirhoa t301 = 0.4e1_dp*t113*t299 - epsilon_c_unifrhoa = e_c_u_0rhoa+t285*t110+t287*t110- & - t293+t295*t108+t297*t108+t301 + epsilon_c_unifrhoa = e_c_u_0rhoa + t285*t110 + t287*t110 - & + t293 + t295*t108 + t297*t108 + t301 t302 = t117**2 t304 = 0.1e1_dp/t302*t35 rs_arhoa = -t4*t304/t186/0.12e2_dp @@ -911,34 +911,34 @@ SUBROUTINE b97_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, & t316 = beta_1_2*t315 t320 = beta_3_2*t122 t324 = 0.1e1_dp/rs_a - t327 = t316*rs_arhoa/0.2e1_dp+beta_2_2*rs_arhoa+0.3e1_dp & - /0.2e1_dp*t320*rs_arhoa+t128*t66*rs_arhoa*t324 + t327 = t316*rs_arhoa/0.2e1_dp + beta_2_2*rs_arhoa + 0.3e1_dp & + /0.2e1_dp*t320*rs_arhoa + t128*t66*rs_arhoa*t324 t328 = 0.1e1_dp/t133 - epsilon_c_unif_arhoa = -0.2e1_dp*t239*rs_arhoa*t134+t314* & + epsilon_c_unif_arhoa = -0.2e1_dp*t239*rs_arhoa*t134 + t314* & t327*t328 s_a_2rhoa = 0.2e1_dp*s_a*s_arhoa s_avg_2rhoa = s_a_2rhoa/0.2e1_dp - e_lsda_c_arhoa = epsilon_c_unif_arhoa*my_rhoa+epsilon_c_unif_a + e_lsda_c_arhoa = epsilon_c_unif_arhoa*my_rhoa + epsilon_c_unif_a t336 = gamma_c_ab**2 t337 = t336*s_avg_2 t338 = t161**2 t339 = 0.1e1_dp/t338 - u_c_abrhoa = gamma_c_ab*s_avg_2rhoa*t162-t337*t339*s_avg_2rhoa + u_c_abrhoa = gamma_c_ab*s_avg_2rhoa*t162 - t337*t339*s_avg_2rhoa t344 = gamma_c_ss**2 t345 = t344*s_a_2 t346 = t164**2 t347 = 0.1e1_dp/t346 - u_c_arhoa = gamma_c_ss*s_a_2rhoa*t165-t345*t347*s_a_2rhoa - e_lsda_c_abrhoa = epsilon_c_unifrhoa*rho+epsilon_c_unif- & + u_c_arhoa = gamma_c_ss*s_a_2rhoa*t165 - t345*t347*s_a_2rhoa + e_lsda_c_abrhoa = epsilon_c_unifrhoa*rho + epsilon_c_unif - & e_lsda_c_arhoa - gc_abrhoa = u_c_abrhoa*t170+u_c_ab*u_c_abrhoa*c_cab_2 - gc_arhoa = u_c_arhoa*t173+u_c_a*u_c_arhoa*c_css_2 + gc_abrhoa = u_c_abrhoa*t170 + u_c_ab*u_c_abrhoa*c_cab_2 + gc_arhoa = u_c_arhoa*t173 + u_c_a*u_c_arhoa*c_css_2 IF (grad_deriv > 0 .OR. grad_deriv == -1) THEN - exc_rhoa = scale_x*(e_lsda_x_arhoa*gx_a+e_lsda_x_a* & - gx_arhoa)+scale_c*(e_lsda_c_abrhoa*gc_ab+e_lsda_c_ab* & - gc_abrhoa+e_lsda_c_arhoa*gc_a+e_lsda_c_a*gc_arhoa) - e_ra(ii) = e_ra(ii)+exc_rhoa + exc_rhoa = scale_x*(e_lsda_x_arhoa*gx_a + e_lsda_x_a* & + gx_arhoa) + scale_c*(e_lsda_c_abrhoa*gc_ab + e_lsda_c_ab* & + gc_abrhoa + e_lsda_c_arhoa*gc_a + e_lsda_c_a*gc_arhoa) + e_ra(ii) = e_ra(ii) + exc_rhoa END IF e_lsda_x_brhob = -t4*t6*t20/0.2e1_dp @@ -951,32 +951,32 @@ SUBROUTINE b97_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, & t375 = t28**2 t376 = 0.1e1_dp/t375 t377 = t376*s_brhob - u_x_brhob = 0.2e1_dp*t370*t371-0.2e1_dp*t374*t377 - gx_brhob = u_x_brhob*t31+u_x_b*u_x_brhob*c_x_2 - chirhob = -t34-t209 + u_x_brhob = 0.2e1_dp*t370*t371 - 0.2e1_dp*t374*t377 + gx_brhob = u_x_brhob*t31 + u_x_b*u_x_brhob*c_x_2 + chirhob = -t34 - t209 rsrhob = rsrhoa - t396 = t224*rsrhob/0.2e1_dp+beta_2_1*rsrhob+0.3e1_dp/ & - 0.2e1_dp*t228*rsrhob+t50*t48*rsrhob*t232 - e_c_u_0rhob = -0.2e1_dp*t216*rsrhob*t56+t222*t396*t236 - t410 = t246*rsrhob/0.2e1_dp+beta_2_2*rsrhob+0.3e1_dp/ & - 0.2e1_dp*t250*rsrhob+t68*t66*rsrhob*t232 - e_c_u_1rhob = -0.2e1_dp*t239*rsrhob*t74+t245*t410*t257 - t424 = t267*rsrhob/0.2e1_dp+beta_2_3*rsrhob+0.3e1_dp/ & - 0.2e1_dp*t271*rsrhob+t86*t84*rsrhob*t232 - alpha_crhob = 0.2e1_dp*t260*rsrhob*t92-t266*t424*t278 - frhob = (0.4e1_dp/0.3e1_dp*t99*chirhob-0.4e1_dp/0.3e1_dp & + t396 = t224*rsrhob/0.2e1_dp + beta_2_1*rsrhob + 0.3e1_dp/ & + 0.2e1_dp*t228*rsrhob + t50*t48*rsrhob*t232 + e_c_u_0rhob = -0.2e1_dp*t216*rsrhob*t56 + t222*t396*t236 + t410 = t246*rsrhob/0.2e1_dp + beta_2_2*rsrhob + 0.3e1_dp/ & + 0.2e1_dp*t250*rsrhob + t68*t66*rsrhob*t232 + e_c_u_1rhob = -0.2e1_dp*t239*rsrhob*t74 + t245*t410*t257 + t424 = t267*rsrhob/0.2e1_dp + beta_2_3*rsrhob + 0.3e1_dp/ & + 0.2e1_dp*t271*rsrhob + t86*t84*rsrhob*t232 + alpha_crhob = 0.2e1_dp*t260*rsrhob*t92 - t266*t424*t278 + frhob = (0.4e1_dp/0.3e1_dp*t99*chirhob - 0.4e1_dp/0.3e1_dp & *t102*chirhob)*t97 t431 = alpha_crhob*f t433 = alpha_c*frhob t435 = t290*chirhob t437 = 0.4e1_dp*t105*t435 - t438 = e_c_u_1rhob-e_c_u_0rhob + t438 = e_c_u_1rhob - e_c_u_0rhob t439 = t438*f t441 = t112*frhob t443 = t289*chirhob t445 = 0.4e1_dp*t113*t443 - epsilon_c_unifrhob = e_c_u_0rhob+t431*t110+t433*t110- & - t437+t439*t108+t441*t108+t445 + epsilon_c_unifrhob = e_c_u_0rhob + t431*t110 + t433*t110 - & + t437 + t439*t108 + t441*t108 + t445 t446 = t139**2 t448 = 0.1e1_dp/t446*t35 rs_brhob = -t4*t448/t365/0.12e2_dp @@ -987,72 +987,72 @@ SUBROUTINE b97_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, & t460 = beta_1_2*t459 t464 = beta_3_2*t144 t468 = 0.1e1_dp/rs_b - t471 = t460*rs_brhob/0.2e1_dp+beta_2_2*rs_brhob+0.3e1_dp & - /0.2e1_dp*rs_brhob*t464+t150*t66*rs_brhob*t468 + t471 = t460*rs_brhob/0.2e1_dp + beta_2_2*rs_brhob + 0.3e1_dp & + /0.2e1_dp*rs_brhob*t464 + t150*t66*rs_brhob*t468 t472 = 0.1e1_dp/t155 - epsilon_c_unif_brhob = -0.2e1_dp*t239*rs_brhob*t156+t458* & + epsilon_c_unif_brhob = -0.2e1_dp*t239*rs_brhob*t156 + t458* & t471*t472 s_b_2rhob = 0.2e1_dp*s_b*s_brhob s_avg_2rhob = s_b_2rhob/0.2e1_dp - e_lsda_c_brhob = epsilon_c_unif_brhob*my_rhob+epsilon_c_unif_b + e_lsda_c_brhob = epsilon_c_unif_brhob*my_rhob + epsilon_c_unif_b t480 = t339*s_avg_2rhob - u_c_abrhob = gamma_c_ab*s_avg_2rhob*t162-t337*t480 + u_c_abrhob = gamma_c_ab*s_avg_2rhob*t162 - t337*t480 t484 = t344*s_b_2 t485 = t167**2 t486 = 0.1e1_dp/t485 - u_c_brhob = gamma_c_ss*s_b_2rhob*t168-t484*t486*s_b_2rhob - e_lsda_c_abrhob = epsilon_c_unifrhob*rho+epsilon_c_unif- & + u_c_brhob = gamma_c_ss*s_b_2rhob*t168 - t484*t486*s_b_2rhob + e_lsda_c_abrhob = epsilon_c_unifrhob*rho + epsilon_c_unif - & e_lsda_c_brhob - gc_abrhob = u_c_abrhob*t170+u_c_ab*u_c_abrhob*c_cab_2 - gc_brhob = u_c_brhob*t176+u_c_b*u_c_brhob*c_css_2 + gc_abrhob = u_c_abrhob*t170 + u_c_ab*u_c_abrhob*c_cab_2 + gc_brhob = u_c_brhob*t176 + u_c_b*u_c_brhob*c_css_2 IF (grad_deriv > 0 .OR. grad_deriv == -1) THEN - exc_rhob = scale_x*(e_lsda_x_brhob*gx_b+e_lsda_x_b* & - gx_brhob)+scale_c*(e_lsda_c_abrhob*gc_ab+e_lsda_c_ab* & - gc_abrhob+e_lsda_c_brhob*gc_b+e_lsda_c_b*gc_brhob) - e_rb(ii) = e_rb(ii)+exc_rhob + exc_rhob = scale_x*(e_lsda_x_brhob*gx_b + e_lsda_x_b* & + gx_brhob) + scale_c*(e_lsda_c_abrhob*gc_ab + e_lsda_c_ab* & + gc_abrhob + e_lsda_c_brhob*gc_b + e_lsda_c_b*gc_brhob) + e_rb(ii) = e_rb(ii) + exc_rhob END IF s_anorm_drhoa = t12 - u_x_anorm_drhoa = 0.2e1_dp*t191*t16*s_anorm_drhoa-0.2e1_dp & + u_x_anorm_drhoa = 0.2e1_dp*t191*t16*s_anorm_drhoa - 0.2e1_dp & *t196*t198*s_anorm_drhoa - gx_anorm_drhoa = u_x_anorm_drhoa*t18+u_x_a*u_x_anorm_drhoa*c_x_2 + gx_anorm_drhoa = u_x_anorm_drhoa*t18 + u_x_a*u_x_anorm_drhoa*c_x_2 s_a_2norm_drhoa = 0.2e1_dp*s_a*s_anorm_drhoa s_avg_2norm_drhoa = s_a_2norm_drhoa/0.2e1_dp t512 = t339*s_avg_2norm_drhoa - u_c_abnorm_drhoa = gamma_c_ab*s_avg_2norm_drhoa*t162-t337*t512 + u_c_abnorm_drhoa = gamma_c_ab*s_avg_2norm_drhoa*t162 - t337*t512 t516 = t347*s_a_2norm_drhoa - u_c_anorm_drhoa = gamma_c_ss*s_a_2norm_drhoa*t165-t345*t516 - gc_abnorm_drhoa = u_c_abnorm_drhoa*t170+u_c_ab* & + u_c_anorm_drhoa = gamma_c_ss*s_a_2norm_drhoa*t165 - t345*t516 + gc_abnorm_drhoa = u_c_abnorm_drhoa*t170 + u_c_ab* & u_c_abnorm_drhoa*c_cab_2 - gc_anorm_drhoa = u_c_anorm_drhoa*t173+u_c_a*u_c_anorm_drhoa & + gc_anorm_drhoa = u_c_anorm_drhoa*t173 + u_c_a*u_c_anorm_drhoa & *c_css_2 IF (grad_deriv > 0 .OR. grad_deriv == -1) THEN - exc_norm_drhoa = scale_x*e_lsda_x_a*gx_anorm_drhoa+scale_c* & - (e_lsda_c_ab*gc_abnorm_drhoa+e_lsda_c_a*gc_anorm_drhoa) - e_ndra(ii) = e_ndra(ii)+exc_norm_drhoa + exc_norm_drhoa = scale_x*e_lsda_x_a*gx_anorm_drhoa + scale_c* & + (e_lsda_c_ab*gc_abnorm_drhoa + e_lsda_c_a*gc_anorm_drhoa) + e_ndra(ii) = e_ndra(ii) + exc_norm_drhoa END IF s_bnorm_drhob = t25 - u_x_bnorm_drhob = 0.2e1_dp*t370*t29*s_bnorm_drhob-0.2e1_dp & + u_x_bnorm_drhob = 0.2e1_dp*t370*t29*s_bnorm_drhob - 0.2e1_dp & *t374*t376*s_bnorm_drhob - gx_bnorm_drhob = u_x_bnorm_drhob*t31+u_x_b*u_x_bnorm_drhob*c_x_2 + gx_bnorm_drhob = u_x_bnorm_drhob*t31 + u_x_b*u_x_bnorm_drhob*c_x_2 s_b_2norm_drhob = 0.2e1_dp*s_b*s_bnorm_drhob s_avg_2norm_drhob = s_b_2norm_drhob/0.2e1_dp t539 = t339*s_avg_2norm_drhob - u_c_abnorm_drhob = gamma_c_ab*s_avg_2norm_drhob*t162-t337*t539 + u_c_abnorm_drhob = gamma_c_ab*s_avg_2norm_drhob*t162 - t337*t539 t543 = t486*s_b_2norm_drhob - u_c_bnorm_drhob = gamma_c_ss*s_b_2norm_drhob*t168-t484*t543 - gc_abnorm_drhob = u_c_abnorm_drhob*t170+u_c_ab* & + u_c_bnorm_drhob = gamma_c_ss*s_b_2norm_drhob*t168 - t484*t543 + gc_abnorm_drhob = u_c_abnorm_drhob*t170 + u_c_ab* & u_c_abnorm_drhob*c_cab_2 - gc_bnorm_drhob = u_c_bnorm_drhob*t176+u_c_b*u_c_bnorm_drhob & + gc_bnorm_drhob = u_c_bnorm_drhob*t176 + u_c_b*u_c_bnorm_drhob & *c_css_2 IF (grad_deriv > 0 .OR. grad_deriv == -1) THEN - exc_norm_drhob = scale_x*e_lsda_x_b*gx_bnorm_drhob+scale_c* & - (e_lsda_c_ab*gc_abnorm_drhob+e_lsda_c_b*gc_bnorm_drhob) - e_ndrb(ii) = e_ndrb(ii)+exc_norm_drhob + exc_norm_drhob = scale_x*e_lsda_x_b*gx_bnorm_drhob + scale_c* & + (e_lsda_c_ab*gc_abnorm_drhob + e_lsda_c_b*gc_bnorm_drhob) + e_ndrb(ii) = e_ndrb(ii) + exc_norm_drhob END IF IF (grad_deriv > 1 .OR. grad_deriv < -1) THEN @@ -1065,17 +1065,17 @@ SUBROUTINE b97_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, & t576 = s_a_2**2 t577 = t575*t576 t579 = 0.1e1_dp/t197/t15 - u_x_arhoarhoa = 0.2e1_dp*gamma_x*t564*t16-0.10e2_dp*t568 & - *t198*t564+0.2e1_dp*t191*t16*s_arhoarhoa+0.8e1_dp* & - t577*t579*t564-0.2e1_dp*t196*t198*s_arhoarhoa + u_x_arhoarhoa = 0.2e1_dp*gamma_x*t564*t16 - 0.10e2_dp*t568 & + *t198*t564 + 0.2e1_dp*t191*t16*s_arhoarhoa + 0.8e1_dp* & + t577*t579*t564 - 0.2e1_dp*t196*t198*s_arhoarhoa u_x_a1rhoa = u_x_arhoa t600 = 0.1e1_dp/t207/rho t601 = t33*t600 - chirhoarhoa = -0.2e1_dp*t208+0.2e1_dp*t601 + chirhoarhoa = -0.2e1_dp*t208 + 0.2e1_dp*t601 t605 = 0.3141592654e1_dp**2 t606 = 0.1e1_dp/t605 t608 = t207**2 - rsrhoarhoa = -t4/t210/t36*t606/t608/0.18e2_dp+ & + rsrhoarhoa = -t4/t210/t36*t606/t608/0.18e2_dp + & t4*t212*t600/0.6e1_dp t619 = alpha_1_1*rsrhoa t621 = t221*t235*t236 @@ -1092,12 +1092,12 @@ SUBROUTINE b97_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, & t661 = t40/t659 t662 = t55**2 t663 = 0.1e1_dp/t662 - e_c_u_0rhoarhoa = -0.2e1_dp*t216*rsrhoarhoa*t56+0.2e1_dp* & - t619*t621-0.2e1_dp*t626*t627*t236+t222*(-t632*t633 & - /0.4e1_dp+t224*rsrhoarhoa/0.2e1_dp+beta_2_1*rsrhoarhoa+ & - 0.3e1_dp/0.4e1_dp*t639*t633+0.3e1_dp/0.2e1_dp*t228* & - rsrhoarhoa+t50*t644*t633*t647+t50*t48*rsrhoarhoa* & - t232-t50*t48*t633*t647)*t236+t661*t627*t663*t42/ & + e_c_u_0rhoarhoa = -0.2e1_dp*t216*rsrhoarhoa*t56 + 0.2e1_dp* & + t619*t621 - 0.2e1_dp*t626*t627*t236 + t222*(-t632*t633 & + /0.4e1_dp + t224*rsrhoarhoa/0.2e1_dp + beta_2_1*rsrhoarhoa + & + 0.3e1_dp/0.4e1_dp*t639*t633 + 0.3e1_dp/0.2e1_dp*t228* & + rsrhoarhoa + t50*t644*t633*t647 + t50*t48*rsrhoarhoa* & + t232 - t50*t48*t633*t647)*t236 + t661*t627*t663*t42/ & 0.2e1_dp e_c_u_01rhoa = e_c_u_0rhoa t671 = alpha_1_2*rsrhoa @@ -1128,31 +1128,31 @@ SUBROUTINE b97_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, & t766 = chirhoa**2 t771 = t102**2 t772 = 0.1e1_dp/t771 - frhoarhoa = (0.4e1_dp/0.9e1_dp*t765*t766+0.4e1_dp/ & - 0.3e1_dp*t99*chirhoarhoa+0.4e1_dp/0.9e1_dp*t772*t766- & + frhoarhoa = (0.4e1_dp/0.9e1_dp*t765*t766 + 0.4e1_dp/ & + 0.3e1_dp*t99*chirhoarhoa + 0.4e1_dp/0.9e1_dp*t772*t766 - & 0.4e1_dp/0.3e1_dp*t102*chirhoarhoa)*t97 f1rhoa = frhoa t790 = alpha_c1rhoa*f t793 = alpha_c*f1rhoa t796 = t106*t107 - t811 = e_c_u_1rhoa-e_c_u_01rhoa + t811 = e_c_u_1rhoa - e_c_u_01rhoa t818 = t811*f t821 = t112*f1rhoa - t830 = -0.4e1_dp*t105*t290*chirhoarhoa+(-0.2e1_dp*t239* & - rsrhoarhoa*t74+0.2e1_dp*t671*t673-0.2e1_dp*t678*t679 & - *t257+t245*(-t683*t633/0.4e1_dp+t246*rsrhoarhoa/ & - 0.2e1_dp+beta_2_2*rsrhoarhoa+0.3e1_dp/0.4e1_dp*t689*t633 & - +0.3e1_dp/0.2e1_dp*t250*rsrhoarhoa+t68*t694*t633* & - t647+t68*t66*rsrhoarhoa*t232-t68*t66*t633*t647)* & - t257+t709*t679*t711*t62/0.2e1_dp-e_c_u_0rhoarhoa)*f* & - t108+t294*f1rhoa*t108+0.4e1_dp*t295*t299+t811*frhoa & - *t108+t112*frhoarhoa*t108+0.4e1_dp*t297*t299+0.4e1_dp & - *t818*t299+0.4e1_dp*t821*t299+0.12e2_dp*t113*t107* & - t766+0.4e1_dp*t113*t289*chirhoarhoa - epsilon_c_unif1rhoa = e_c_u_01rhoa+t790*t110+t793*t110- & - t293+t818*t108+t821*t108+t301 + t830 = -0.4e1_dp*t105*t290*chirhoarhoa + (-0.2e1_dp*t239* & + rsrhoarhoa*t74 + 0.2e1_dp*t671*t673 - 0.2e1_dp*t678*t679 & + *t257 + t245*(-t683*t633/0.4e1_dp + t246*rsrhoarhoa/ & + 0.2e1_dp + beta_2_2*rsrhoarhoa + 0.3e1_dp/0.4e1_dp*t689*t633 & + + 0.3e1_dp/0.2e1_dp*t250*rsrhoarhoa + t68*t694*t633* & + t647 + t68*t66*rsrhoarhoa*t232 - t68*t66*t633*t647)* & + t257 + t709*t679*t711*t62/0.2e1_dp - e_c_u_0rhoarhoa)*f* & + t108 + t294*f1rhoa*t108 + 0.4e1_dp*t295*t299 + t811*frhoa & + *t108 + t112*frhoarhoa*t108 + 0.4e1_dp*t297*t299 + 0.4e1_dp & + *t818*t299 + 0.4e1_dp*t821*t299 + 0.12e2_dp*t113*t107* & + t766 + 0.4e1_dp*t113*t289*chirhoarhoa + epsilon_c_unif1rhoa = e_c_u_01rhoa + t790*t110 + t793*t110 - & + t293 + t818*t108 + t821*t108 + t301 t838 = t186**2 - rs_arhoarhoa = -t4/t302/t116*t606/t838/0.18e2_dp+ & + rs_arhoarhoa = -t4/t302/t116*t606/t838/0.18e2_dp + & t4*t304/t560/0.6e1_dp t858 = t327**2 t864 = rs_arhoa**2 @@ -1161,65 +1161,65 @@ SUBROUTINE b97_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, & t889 = t312**2 t892 = t133**2 epsilon_c_unif_a1rhoa = epsilon_c_unif_arhoa - s_a_2rhoarhoa = 0.2e1_dp*t564+0.2e1_dp*s_a*s_arhoarhoa + s_a_2rhoarhoa = 0.2e1_dp*t564 + 0.2e1_dp*s_a*s_arhoarhoa s_a_21rhoa = s_a_2rhoa s_avg_2rhoarhoa = s_a_2rhoarhoa/0.2e1_dp s_avg_21rhoa = s_a_21rhoa/0.2e1_dp - e_lsda_c_arhoarhoa = (-0.2e1_dp*t239*rs_arhoarhoa*t134+ & - 0.2e1_dp*alpha_1_2*rs_arhoa*t313*t327*t328-0.2e1_dp* & - t120/t312/t129*t858*t328+t314*(-beta_1_2/t125*t864/ & - 0.4e1_dp+t316*rs_arhoarhoa/0.2e1_dp+beta_2_2*rs_arhoarhoa & - +0.3e1_dp/0.4e1_dp*beta_3_2*t315*t864+0.3e1_dp/ & - 0.2e1_dp*t320*rs_arhoarhoa+t128*t694*t864*t877+t128* & - t66*rs_arhoarhoa*t324-t128*t66*t864*t877)*t328+t120 & - /t889*t858/t892*t62/0.2e1_dp)*my_rhoa+epsilon_c_unif_arhoa & - +epsilon_c_unif_a1rhoa - e_lsda_c_a1rhoa = epsilon_c_unif_a1rhoa*my_rhoa+epsilon_c_unif_a + e_lsda_c_arhoarhoa = (-0.2e1_dp*t239*rs_arhoarhoa*t134 + & + 0.2e1_dp*alpha_1_2*rs_arhoa*t313*t327*t328 - 0.2e1_dp* & + t120/t312/t129*t858*t328 + t314*(-beta_1_2/t125*t864/ & + 0.4e1_dp + t316*rs_arhoarhoa/0.2e1_dp + beta_2_2*rs_arhoarhoa & + + 0.3e1_dp/0.4e1_dp*beta_3_2*t315*t864 + 0.3e1_dp/ & + 0.2e1_dp*t320*rs_arhoarhoa + t128*t694*t864*t877 + t128* & + t66*rs_arhoarhoa*t324 - t128*t66*t864*t877)*t328 + t120 & + /t889*t858/t892*t62/0.2e1_dp)*my_rhoa + epsilon_c_unif_arhoa & + + epsilon_c_unif_a1rhoa + e_lsda_c_a1rhoa = epsilon_c_unif_a1rhoa*my_rhoa + epsilon_c_unif_a t906 = t336*s_avg_2rhoa t907 = t339*s_avg_21rhoa t911 = t336*gamma_c_ab*s_avg_2 t913 = 0.1e1_dp/t338/t161 t914 = t913*s_avg_2rhoa - u_c_abrhoarhoa = gamma_c_ab*s_avg_2rhoarhoa*t162-0.2e1_dp* & - t906*t907+0.2e1_dp*t911*t914*s_avg_21rhoa-t337*t339* & + u_c_abrhoarhoa = gamma_c_ab*s_avg_2rhoarhoa*t162 - 0.2e1_dp* & + t906*t907 + 0.2e1_dp*t911*t914*s_avg_21rhoa - t337*t339* & s_avg_2rhoarhoa - u_c_ab1rhoa = gamma_c_ab*s_avg_21rhoa*t162-t337*t907 + u_c_ab1rhoa = gamma_c_ab*s_avg_21rhoa*t162 - t337*t907 t925 = t344*s_a_2rhoa t926 = t347*s_a_21rhoa t929 = t344*gamma_c_ss t930 = t929*s_a_2 t932 = 0.1e1_dp/t346/t164 t933 = t932*s_a_2rhoa - u_c_arhoarhoa = gamma_c_ss*s_a_2rhoarhoa*t165-0.2e1_dp* & - t925*t926+0.2e1_dp*t930*t933*s_a_21rhoa-t345*t347* & + u_c_arhoarhoa = gamma_c_ss*s_a_2rhoarhoa*t165 - 0.2e1_dp* & + t925*t926 + 0.2e1_dp*t930*t933*s_a_21rhoa - t345*t347* & s_a_2rhoarhoa - u_c_a1rhoa = gamma_c_ss*s_a_21rhoa*t165-t345*t926 + u_c_a1rhoa = gamma_c_ss*s_a_21rhoa*t165 - t345*t926 IF (grad_deriv > 1 .OR. grad_deriv == -2) THEN exc_rhoa_rhoa = scale_x*(-t4*t6/t555*gx_a/0.6e1_dp & - +e_lsda_x_arhoa*(u_x_a1rhoa*t18+u_x_a*u_x_a1rhoa*c_x_2) & - +e_lsda_x_arhoa*gx_arhoa+e_lsda_x_a*(u_x_arhoarhoa*t18+ & - 0.2e1_dp*u_x_arhoa*u_x_a1rhoa*c_x_2+u_x_a*u_x_arhoarhoa* & - c_x_2))+scale_c*(((e_c_u_0rhoarhoa+(0.2e1_dp*t260* & - rsrhoarhoa*t92-0.2e1_dp*t719*t721+0.2e1_dp*t726*t727* & - t278-t266*(-t731*t633/0.4e1_dp+t267*rsrhoarhoa/ & - 0.2e1_dp+beta_2_3*rsrhoarhoa+0.3e1_dp/0.4e1_dp*t737*t633 & - +0.3e1_dp/0.2e1_dp*t271*rsrhoarhoa+t86*t742*t633* & - t647+t86*t84*rsrhoarhoa*t232-t86*t84*t633*t647)* & - t278-t757*t727*t759*t80/0.2e1_dp)*f*t110+alpha_crhoa & - *f1rhoa*t110-0.4e1_dp*t285*t291+alpha_c1rhoa*frhoa* & - t110+alpha_c*frhoarhoa*t110-0.4e1_dp*t287*t291- & - 0.4e1_dp*t790*t291-0.4e1_dp*t793*t291-0.12e2_dp*t105* & - t796*t766+t830)*rho+epsilon_c_unifrhoa+ & - epsilon_c_unif1rhoa-e_lsda_c_arhoarhoa)*gc_ab+e_lsda_c_abrhoa & - *(u_c_ab1rhoa*t170+u_c_ab*u_c_ab1rhoa*c_cab_2)+( & - epsilon_c_unif1rhoa*rho+epsilon_c_unif-e_lsda_c_a1rhoa)* & - gc_abrhoa+e_lsda_c_ab*(u_c_abrhoarhoa*t170+0.2e1_dp* & - u_c_abrhoa*u_c_ab1rhoa*c_cab_2+u_c_ab*u_c_abrhoarhoa* & - c_cab_2)+e_lsda_c_arhoarhoa*gc_a+e_lsda_c_arhoa*(u_c_a1rhoa & - *t173+u_c_a*u_c_a1rhoa*c_css_2)+e_lsda_c_a1rhoa*gc_arhoa & - +e_lsda_c_a*(u_c_arhoarhoa*t173+0.2e1_dp*u_c_arhoa* & - u_c_a1rhoa*c_css_2+u_c_a*u_c_arhoarhoa*c_css_2)) - e_ra_ra(ii) = e_ra_ra(ii)+exc_rhoa_rhoa + + e_lsda_x_arhoa*(u_x_a1rhoa*t18 + u_x_a*u_x_a1rhoa*c_x_2) & + + e_lsda_x_arhoa*gx_arhoa + e_lsda_x_a*(u_x_arhoarhoa*t18 + & + 0.2e1_dp*u_x_arhoa*u_x_a1rhoa*c_x_2 + u_x_a*u_x_arhoarhoa* & + c_x_2)) + scale_c*(((e_c_u_0rhoarhoa + (0.2e1_dp*t260* & + rsrhoarhoa*t92 - 0.2e1_dp*t719*t721 + 0.2e1_dp*t726*t727* & + t278 - t266*(-t731*t633/0.4e1_dp + t267*rsrhoarhoa/ & + 0.2e1_dp + beta_2_3*rsrhoarhoa + 0.3e1_dp/0.4e1_dp*t737*t633 & + + 0.3e1_dp/0.2e1_dp*t271*rsrhoarhoa + t86*t742*t633* & + t647 + t86*t84*rsrhoarhoa*t232 - t86*t84*t633*t647)* & + t278 - t757*t727*t759*t80/0.2e1_dp)*f*t110 + alpha_crhoa & + *f1rhoa*t110 - 0.4e1_dp*t285*t291 + alpha_c1rhoa*frhoa* & + t110 + alpha_c*frhoarhoa*t110 - 0.4e1_dp*t287*t291 - & + 0.4e1_dp*t790*t291 - 0.4e1_dp*t793*t291 - 0.12e2_dp*t105* & + t796*t766 + t830)*rho + epsilon_c_unifrhoa + & + epsilon_c_unif1rhoa - e_lsda_c_arhoarhoa)*gc_ab + e_lsda_c_abrhoa & + *(u_c_ab1rhoa*t170 + u_c_ab*u_c_ab1rhoa*c_cab_2) + ( & + epsilon_c_unif1rhoa*rho + epsilon_c_unif - e_lsda_c_a1rhoa)* & + gc_abrhoa + e_lsda_c_ab*(u_c_abrhoarhoa*t170 + 0.2e1_dp* & + u_c_abrhoa*u_c_ab1rhoa*c_cab_2 + u_c_ab*u_c_abrhoarhoa* & + c_cab_2) + e_lsda_c_arhoarhoa*gc_a + e_lsda_c_arhoa*(u_c_a1rhoa & + *t173 + u_c_a*u_c_a1rhoa*c_css_2) + e_lsda_c_a1rhoa*gc_arhoa & + + e_lsda_c_a*(u_c_arhoarhoa*t173 + 0.2e1_dp*u_c_arhoa* & + u_c_a1rhoa*c_css_2 + u_c_a*u_c_arhoarhoa*c_css_2)) + e_ra_ra(ii) = e_ra_ra(ii) + exc_rhoa_rhoa END IF chirhoarhob = 0.2e1_dp*t601 @@ -1228,52 +1228,52 @@ SUBROUTINE b97_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, & t976 = alpha_1_1*rsrhob t981 = rsrhoa*rsrhob t993 = rsrhob*t647*rsrhoa - e_c_u_0rhoarhob = -0.2e1_dp*t216*rsrhoarhob*t56+t619* & - t974+t976*t621-0.2e1_dp*t626*t237*t396+t222*(-t632* & - t981/0.4e1_dp+t224*rsrhoarhob/0.2e1_dp+beta_2_1* & - rsrhoarhob+0.3e1_dp/0.4e1_dp*t639*t981+0.3e1_dp/0.2e1_dp & - *t228*rsrhoarhob+t50*t644*t993+t50*t48*rsrhoarhob* & - t232-t50*t48*t993)*t236+t661*t235*t663*t42*t396/ & + e_c_u_0rhoarhob = -0.2e1_dp*t216*rsrhoarhob*t56 + t619* & + t974 + t976*t621 - 0.2e1_dp*t626*t237*t396 + t222*(-t632* & + t981/0.4e1_dp + t224*rsrhoarhob/0.2e1_dp + beta_2_1* & + rsrhoarhob + 0.3e1_dp/0.4e1_dp*t639*t981 + 0.3e1_dp/0.2e1_dp & + *t228*rsrhoarhob + t50*t644*t993 + t50*t48*rsrhoarhob* & + t232 - t50*t48*t993)*t236 + t661*t235*t663*t42*t396/ & 0.2e1_dp t1012 = t244*t410*t257 t1014 = alpha_1_2*rsrhob t1047 = t265*t424*t278 t1049 = alpha_1_3*rsrhob - frhoarhob = (0.4e1_dp/0.9e1_dp*t765*chirhoa*chirhob+ & - 0.4e1_dp/0.3e1_dp*t99*chirhoarhob+0.4e1_dp/0.9e1_dp*t772 & - *chirhoa*chirhob-0.4e1_dp/0.3e1_dp*t102*chirhoarhob)* & + frhoarhob = (0.4e1_dp/0.9e1_dp*t765*chirhoa*chirhob + & + 0.4e1_dp/0.3e1_dp*t99*chirhoarhob + 0.4e1_dp/0.9e1_dp*t772 & + *chirhoa*chirhob - 0.4e1_dp/0.3e1_dp*t102*chirhoarhob)* & t97 t1107 = t107*chirhoa*chirhob - t1136 = -0.4e1_dp*t105*t290*chirhoarhob+(-0.2e1_dp*t239 & - *rsrhoarhob*t74+t671*t1012+t1014*t673-0.2e1_dp*t678* & - t258*t410+t245*(-t683*t981/0.4e1_dp+t246*rsrhoarhob/ & - 0.2e1_dp+beta_2_2*rsrhoarhob+0.3e1_dp/0.4e1_dp*t689* & - t981+0.3e1_dp/0.2e1_dp*t250*rsrhoarhob+t68*t694*t993+ & - t68*t66*rsrhoarhob*t232-t68*t66*t993)*t257+t709* & - t256*t711*t62*t410/0.2e1_dp-e_c_u_0rhoarhob)*f*t108+ & - t294*frhob*t108+0.4e1_dp*t295*t443+t438*frhoa*t108+ & - t112*frhoarhob*t108+0.4e1_dp*t297*t443+0.4e1_dp*t439 & - *t299+0.4e1_dp*t441*t299+0.12e2_dp*t113*t1107+ & + t1136 = -0.4e1_dp*t105*t290*chirhoarhob + (-0.2e1_dp*t239 & + *rsrhoarhob*t74 + t671*t1012 + t1014*t673 - 0.2e1_dp*t678* & + t258*t410 + t245*(-t683*t981/0.4e1_dp + t246*rsrhoarhob/ & + 0.2e1_dp + beta_2_2*rsrhoarhob + 0.3e1_dp/0.4e1_dp*t689* & + t981 + 0.3e1_dp/0.2e1_dp*t250*rsrhoarhob + t68*t694*t993 + & + t68*t66*rsrhoarhob*t232 - t68*t66*t993)*t257 + t709* & + t256*t711*t62*t410/0.2e1_dp - e_c_u_0rhoarhob)*f*t108 + & + t294*frhob*t108 + 0.4e1_dp*t295*t443 + t438*frhoa*t108 + & + t112*frhoarhob*t108 + 0.4e1_dp*t297*t443 + 0.4e1_dp*t439 & + *t299 + 0.4e1_dp*t441*t299 + 0.12e2_dp*t113*t1107 + & 0.4e1_dp*t113*t289*chirhoarhob - u_c_abrhoarhob = -0.2e1_dp*t906*t480+0.2e1_dp*t911*t914 & + u_c_abrhoarhob = -0.2e1_dp*t906*t480 + 0.2e1_dp*t911*t914 & *s_avg_2rhob IF (grad_deriv > 1 .OR. grad_deriv == -2) THEN - exc_rhoa_rhob = scale_c*(((e_c_u_0rhoarhob+(0.2e1_dp*t260* & - rsrhoarhob*t92-t719*t1047-t1049*t721+0.2e1_dp*t726* & - t279*t424-t266*(-t731*t981/0.4e1_dp+t267*rsrhoarhob/ & - 0.2e1_dp+beta_2_3*rsrhoarhob+0.3e1_dp/0.4e1_dp*t737*t981 & - +0.3e1_dp/0.2e1_dp*t271*rsrhoarhob+t86*t742*t993+t86 & - *t84*rsrhoarhob*t232-t86*t84*t993)*t278-t757*t277 & - *t759*t80*t424/0.2e1_dp)*f*t110+alpha_crhoa*frhob* & - t110-0.4e1_dp*t285*t435+alpha_crhob*frhoa*t110+alpha_c & - *frhoarhob*t110-0.4e1_dp*t287*t435-0.4e1_dp*t431* & - t291-0.4e1_dp*t433*t291-0.12e2_dp*t105*t106*t1107+ & - t1136)*rho+epsilon_c_unifrhoa+epsilon_c_unifrhob)*gc_ab+ & - e_lsda_c_abrhoa*gc_abrhob+e_lsda_c_abrhob*gc_abrhoa+ & - e_lsda_c_ab*(u_c_abrhoarhob*t170+0.2e1_dp*u_c_abrhoa* & - u_c_abrhob*c_cab_2+u_c_ab*u_c_abrhoarhob*c_cab_2)) - e_ra_rb(ii) = e_ra_rb(ii)+exc_rhoa_rhob + exc_rhoa_rhob = scale_c*(((e_c_u_0rhoarhob + (0.2e1_dp*t260* & + rsrhoarhob*t92 - t719*t1047 - t1049*t721 + 0.2e1_dp*t726* & + t279*t424 - t266*(-t731*t981/0.4e1_dp + t267*rsrhoarhob/ & + 0.2e1_dp + beta_2_3*rsrhoarhob + 0.3e1_dp/0.4e1_dp*t737*t981 & + + 0.3e1_dp/0.2e1_dp*t271*rsrhoarhob + t86*t742*t993 + t86 & + *t84*rsrhoarhob*t232 - t86*t84*t993)*t278 - t757*t277 & + *t759*t80*t424/0.2e1_dp)*f*t110 + alpha_crhoa*frhob* & + t110 - 0.4e1_dp*t285*t435 + alpha_crhob*frhoa*t110 + alpha_c & + *frhoarhob*t110 - 0.4e1_dp*t287*t435 - 0.4e1_dp*t431* & + t291 - 0.4e1_dp*t433*t291 - 0.12e2_dp*t105*t106*t1107 + & + t1136)*rho + epsilon_c_unifrhoa + epsilon_c_unifrhob)*gc_ab + & + e_lsda_c_abrhoa*gc_abrhob + e_lsda_c_abrhob*gc_abrhoa + & + e_lsda_c_ab*(u_c_abrhoarhob*t170 + 0.2e1_dp*u_c_abrhoa* & + u_c_abrhob*c_cab_2 + u_c_ab*u_c_abrhoarhob*c_cab_2)) + e_ra_rb(ii) = e_ra_rb(ii) + exc_rhoa_rhob END IF t1152 = t20**2 @@ -1284,52 +1284,52 @@ SUBROUTINE b97_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, & t1172 = s_b_2**2 t1173 = t575*t1172 t1175 = 0.1e1_dp/t375/t28 - u_x_brhobrhob = 0.2e1_dp*gamma_x*t1161*t29-0.10e2_dp* & - t1165*t376*t1161+0.2e1_dp*t370*t29*s_brhobrhob+ & - 0.8e1_dp*t1173*t1175*t1161-0.2e1_dp*t374*t376* & + u_x_brhobrhob = 0.2e1_dp*gamma_x*t1161*t29 - 0.10e2_dp* & + t1165*t376*t1161 + 0.2e1_dp*t370*t29*s_brhobrhob + & + 0.8e1_dp*t1173*t1175*t1161 - 0.2e1_dp*t374*t376* & s_brhobrhob u_x_b1rhob = u_x_brhob - chirhobrhob = 0.2e1_dp*t208+0.2e1_dp*t601 + chirhobrhob = 0.2e1_dp*t208 + 0.2e1_dp*t601 rsrhobrhob = rsrhoarhob t1201 = t396**2 t1205 = rsrhob**2 - e_c_u_0rhobrhob = -0.2e1_dp*t216*rsrhobrhob*t56+0.2e1_dp* & - t976*t974-0.2e1_dp*t626*t1201*t236+t222*(-t632* & - t1205/0.4e1_dp+t224*rsrhobrhob/0.2e1_dp+beta_2_1* & - rsrhobrhob+0.3e1_dp/0.4e1_dp*t639*t1205+0.3e1_dp/ & - 0.2e1_dp*t228*rsrhobrhob+t50*t644*t1205*t647+t50*t48 & - *rsrhobrhob*t232-t50*t48*t1205*t647)*t236+t661* & + e_c_u_0rhobrhob = -0.2e1_dp*t216*rsrhobrhob*t56 + 0.2e1_dp* & + t976*t974 - 0.2e1_dp*t626*t1201*t236 + t222*(-t632* & + t1205/0.4e1_dp + t224*rsrhobrhob/0.2e1_dp + beta_2_1* & + rsrhobrhob + 0.3e1_dp/0.4e1_dp*t639*t1205 + 0.3e1_dp/ & + 0.2e1_dp*t228*rsrhobrhob + t50*t644*t1205*t647 + t50*t48 & + *rsrhobrhob*t232 - t50*t48*t1205*t647)*t236 + t661* & t1201*t663*t42/0.2e1_dp e_c_u_01rhob = e_c_u_0rhob t1236 = t410**2 t1270 = t424**2 alpha_c1rhob = alpha_crhob t1299 = chirhob**2 - frhobrhob = (0.4e1_dp/0.9e1_dp*t765*t1299+0.4e1_dp/ & - 0.3e1_dp*t99*chirhobrhob+0.4e1_dp/0.9e1_dp*t772*t1299- & + frhobrhob = (0.4e1_dp/0.9e1_dp*t765*t1299 + 0.4e1_dp/ & + 0.3e1_dp*t99*chirhobrhob + 0.4e1_dp/0.9e1_dp*t772*t1299 - & 0.4e1_dp/0.3e1_dp*t102*chirhobrhob)*t97 f1rhob = frhob t1321 = alpha_c1rhob*f t1324 = alpha_c*f1rhob - t1341 = e_c_u_1rhob-e_c_u_01rhob + t1341 = e_c_u_1rhob - e_c_u_01rhob t1348 = t1341*f t1351 = t112*f1rhob - t1360 = -0.4e1_dp*t105*t290*chirhobrhob+(-0.2e1_dp*t239 & - *rsrhobrhob*t74+0.2e1_dp*t1014*t1012-0.2e1_dp*t678* & - t1236*t257+t245*(-t683*t1205/0.4e1_dp+t246*rsrhobrhob & - /0.2e1_dp+beta_2_2*rsrhobrhob+0.3e1_dp/0.4e1_dp*t689* & - t1205+0.3e1_dp/0.2e1_dp*t250*rsrhobrhob+t68*t694*t1205 & - *t647+t68*t66*rsrhobrhob*t232-t68*t66*t1205*t647) & - *t257+t709*t1236*t711*t62/0.2e1_dp-e_c_u_0rhobrhob)*f & - *t108+t438*f1rhob*t108+0.4e1_dp*t439*t443+t1341* & - frhob*t108+t112*frhobrhob*t108+0.4e1_dp*t441*t443+ & - 0.4e1_dp*t1348*t443+0.4e1_dp*t1351*t443+0.12e2_dp*t113 & - *t107*t1299+0.4e1_dp*t113*t289*chirhobrhob - epsilon_c_unif1rhob = e_c_u_01rhob+t1321*t110+t1324*t110- & - t437+t1348*t108+t1351*t108+t445 + t1360 = -0.4e1_dp*t105*t290*chirhobrhob + (-0.2e1_dp*t239 & + *rsrhobrhob*t74 + 0.2e1_dp*t1014*t1012 - 0.2e1_dp*t678* & + t1236*t257 + t245*(-t683*t1205/0.4e1_dp + t246*rsrhobrhob & + /0.2e1_dp + beta_2_2*rsrhobrhob + 0.3e1_dp/0.4e1_dp*t689* & + t1205 + 0.3e1_dp/0.2e1_dp*t250*rsrhobrhob + t68*t694*t1205 & + *t647 + t68*t66*rsrhobrhob*t232 - t68*t66*t1205*t647) & + *t257 + t709*t1236*t711*t62/0.2e1_dp - e_c_u_0rhobrhob)*f & + *t108 + t438*f1rhob*t108 + 0.4e1_dp*t439*t443 + t1341* & + frhob*t108 + t112*frhobrhob*t108 + 0.4e1_dp*t441*t443 + & + 0.4e1_dp*t1348*t443 + 0.4e1_dp*t1351*t443 + 0.12e2_dp*t113 & + *t107*t1299 + 0.4e1_dp*t113*t289*chirhobrhob + epsilon_c_unif1rhob = e_c_u_01rhob + t1321*t110 + t1324*t110 - & + t437 + t1348*t108 + t1351*t108 + t445 t1368 = t365**2 rs_brhobrhob = -t4/t446/t138*t606/t1368/0.18e2_dp & - +t4*t448/t1157/0.6e1_dp + + t4*t448/t1157/0.6e1_dp t1388 = t471**2 t1394 = rs_brhob**2 t1406 = rs_b**2 @@ -1337,108 +1337,108 @@ SUBROUTINE b97_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, & t1419 = t456**2 t1422 = t155**2 epsilon_c_unif_b1rhob = epsilon_c_unif_brhob - s_b_2rhobrhob = 0.2e1_dp*t1161+0.2e1_dp*s_b*s_brhobrhob + s_b_2rhobrhob = 0.2e1_dp*t1161 + 0.2e1_dp*s_b*s_brhobrhob s_b_21rhob = s_b_2rhob s_avg_2rhobrhob = s_b_2rhobrhob/0.2e1_dp s_avg_21rhob = s_b_21rhob/0.2e1_dp - e_lsda_c_brhobrhob = (-0.2e1_dp*t239*rs_brhobrhob*t156+ & - 0.2e1_dp*alpha_1_2*rs_brhob*t457*t471*t472-0.2e1_dp* & - t142/t456/t151*t1388*t472+t458*(-beta_1_2/t147*t1394 & - /0.4e1_dp+t460*rs_brhobrhob/0.2e1_dp+beta_2_2* & - rs_brhobrhob+0.3e1_dp/0.4e1_dp*beta_3_2*t459*t1394+ & - 0.3e1_dp/0.2e1_dp*t464*rs_brhobrhob+t150*t694*t1394* & - t1407+t150*t66*rs_brhobrhob*t468-t150*t66*t1394* & - t1407)*t472+t142/t1419*t1388/t1422*t62/0.2e1_dp)* & - my_rhob+epsilon_c_unif_brhob+epsilon_c_unif_b1rhob - e_lsda_c_b1rhob = epsilon_c_unif_b1rhob*my_rhob+epsilon_c_unif_b + e_lsda_c_brhobrhob = (-0.2e1_dp*t239*rs_brhobrhob*t156 + & + 0.2e1_dp*alpha_1_2*rs_brhob*t457*t471*t472 - 0.2e1_dp* & + t142/t456/t151*t1388*t472 + t458*(-beta_1_2/t147*t1394 & + /0.4e1_dp + t460*rs_brhobrhob/0.2e1_dp + beta_2_2* & + rs_brhobrhob + 0.3e1_dp/0.4e1_dp*beta_3_2*t459*t1394 + & + 0.3e1_dp/0.2e1_dp*t464*rs_brhobrhob + t150*t694*t1394* & + t1407 + t150*t66*rs_brhobrhob*t468 - t150*t66*t1394* & + t1407)*t472 + t142/t1419*t1388/t1422*t62/0.2e1_dp)* & + my_rhob + epsilon_c_unif_brhob + epsilon_c_unif_b1rhob + e_lsda_c_b1rhob = epsilon_c_unif_b1rhob*my_rhob + epsilon_c_unif_b t1436 = t336*s_avg_2rhob t1437 = t339*s_avg_21rhob t1440 = t913*s_avg_2rhob - u_c_abrhobrhob = gamma_c_ab*s_avg_2rhobrhob*t162-0.2e1_dp* & - t1436*t1437+0.2e1_dp*t911*t1440*s_avg_21rhob-t337*t339 & + u_c_abrhobrhob = gamma_c_ab*s_avg_2rhobrhob*t162 - 0.2e1_dp* & + t1436*t1437 + 0.2e1_dp*t911*t1440*s_avg_21rhob - t337*t339 & *s_avg_2rhobrhob - u_c_ab1rhob = gamma_c_ab*s_avg_21rhob*t162-t337*t1437 + u_c_ab1rhob = gamma_c_ab*s_avg_21rhob*t162 - t337*t1437 t1451 = t344*s_b_2rhob t1452 = t486*s_b_21rhob t1455 = t929*s_b_2 t1457 = 0.1e1_dp/t485/t167 t1458 = t1457*s_b_2rhob - u_c_brhobrhob = gamma_c_ss*s_b_2rhobrhob*t168-0.2e1_dp* & - t1451*t1452+0.2e1_dp*t1455*t1458*s_b_21rhob-t484*t486 & + u_c_brhobrhob = gamma_c_ss*s_b_2rhobrhob*t168 - 0.2e1_dp* & + t1451*t1452 + 0.2e1_dp*t1455*t1458*s_b_21rhob - t484*t486 & *s_b_2rhobrhob - u_c_b1rhob = gamma_c_ss*s_b_21rhob*t168-t484*t1452 + u_c_b1rhob = gamma_c_ss*s_b_21rhob*t168 - t484*t1452 IF (grad_deriv > 1 .OR. grad_deriv == -2) THEN exc_rhob_rhob = scale_x*(-t4*t6/t1152*gx_b/ & - 0.6e1_dp+e_lsda_x_brhob*(u_x_b1rhob*t31+u_x_b*u_x_b1rhob* & - c_x_2)+e_lsda_x_brhob*gx_brhob+e_lsda_x_b*(u_x_brhobrhob* & - t31+0.2e1_dp*u_x_brhob*u_x_b1rhob*c_x_2+u_x_b* & - u_x_brhobrhob*c_x_2))+scale_c*(((e_c_u_0rhobrhob+(0.2e1_dp* & - t260*rsrhobrhob*t92-0.2e1_dp*t1049*t1047+0.2e1_dp* & - t726*t1270*t278-t266*(-t731*t1205/0.4e1_dp+t267* & - rsrhobrhob/0.2e1_dp+beta_2_3*rsrhobrhob+0.3e1_dp/0.4e1_dp & - *t737*t1205+0.3e1_dp/0.2e1_dp*t271*rsrhobrhob+t86* & - t742*t1205*t647+t86*t84*rsrhobrhob*t232-t86*t84* & - t1205*t647)*t278-t757*t1270*t759*t80/0.2e1_dp)*f* & - t110+alpha_crhob*f1rhob*t110-0.4e1_dp*t431*t435+ & - alpha_c1rhob*frhob*t110+alpha_c*frhobrhob*t110-0.4e1_dp & - *t433*t435-0.4e1_dp*t1321*t435-0.4e1_dp*t1324*t435- & - 0.12e2_dp*t105*t796*t1299+t1360)*rho+epsilon_c_unifrhob & - +epsilon_c_unif1rhob-e_lsda_c_brhobrhob)*gc_ab+ & - e_lsda_c_abrhob*(u_c_ab1rhob*t170+u_c_ab*u_c_ab1rhob* & - c_cab_2)+(epsilon_c_unif1rhob*rho+epsilon_c_unif- & - e_lsda_c_b1rhob)*gc_abrhob+e_lsda_c_ab*(u_c_abrhobrhob*t170 & - +0.2e1_dp*u_c_abrhob*u_c_ab1rhob*c_cab_2+u_c_ab* & - u_c_abrhobrhob*c_cab_2)+e_lsda_c_brhobrhob*gc_b+ & - e_lsda_c_brhob*(u_c_b1rhob*t176+u_c_b*u_c_b1rhob*c_css_2) & - +e_lsda_c_b1rhob*gc_brhob+e_lsda_c_b*(u_c_brhobrhob*t176+ & - 0.2e1_dp*u_c_brhob*u_c_b1rhob*c_css_2+u_c_b*u_c_brhobrhob & + 0.6e1_dp + e_lsda_x_brhob*(u_x_b1rhob*t31 + u_x_b*u_x_b1rhob* & + c_x_2) + e_lsda_x_brhob*gx_brhob + e_lsda_x_b*(u_x_brhobrhob* & + t31 + 0.2e1_dp*u_x_brhob*u_x_b1rhob*c_x_2 + u_x_b* & + u_x_brhobrhob*c_x_2)) + scale_c*(((e_c_u_0rhobrhob + (0.2e1_dp* & + t260*rsrhobrhob*t92 - 0.2e1_dp*t1049*t1047 + 0.2e1_dp* & + t726*t1270*t278 - t266*(-t731*t1205/0.4e1_dp + t267* & + rsrhobrhob/0.2e1_dp + beta_2_3*rsrhobrhob + 0.3e1_dp/0.4e1_dp & + *t737*t1205 + 0.3e1_dp/0.2e1_dp*t271*rsrhobrhob + t86* & + t742*t1205*t647 + t86*t84*rsrhobrhob*t232 - t86*t84* & + t1205*t647)*t278 - t757*t1270*t759*t80/0.2e1_dp)*f* & + t110 + alpha_crhob*f1rhob*t110 - 0.4e1_dp*t431*t435 + & + alpha_c1rhob*frhob*t110 + alpha_c*frhobrhob*t110 - 0.4e1_dp & + *t433*t435 - 0.4e1_dp*t1321*t435 - 0.4e1_dp*t1324*t435 - & + 0.12e2_dp*t105*t796*t1299 + t1360)*rho + epsilon_c_unifrhob & + + epsilon_c_unif1rhob - e_lsda_c_brhobrhob)*gc_ab + & + e_lsda_c_abrhob*(u_c_ab1rhob*t170 + u_c_ab*u_c_ab1rhob* & + c_cab_2) + (epsilon_c_unif1rhob*rho + epsilon_c_unif - & + e_lsda_c_b1rhob)*gc_abrhob + e_lsda_c_ab*(u_c_abrhobrhob*t170 & + + 0.2e1_dp*u_c_abrhob*u_c_ab1rhob*c_cab_2 + u_c_ab* & + u_c_abrhobrhob*c_cab_2) + e_lsda_c_brhobrhob*gc_b + & + e_lsda_c_brhob*(u_c_b1rhob*t176 + u_c_b*u_c_b1rhob*c_css_2) & + + e_lsda_c_b1rhob*gc_brhob + e_lsda_c_b*(u_c_brhobrhob*t176 + & + 0.2e1_dp*u_c_brhob*u_c_b1rhob*c_css_2 + u_c_b*u_c_brhobrhob & *c_css_2)) - e_rb_rb(ii) = e_rb_rb(ii)+exc_rhob_rhob + e_rb_rb(ii) = e_rb_rb(ii) + exc_rhob_rhob END IF s_arhoanorm_drhoa = -0.4e1_dp/0.3e1_dp*t188 - u_x_arhoanorm_drhoa = 0.2e1_dp*gamma_x*s_anorm_drhoa*t192- & - 0.10e2_dp*t568*t199*s_anorm_drhoa+0.2e1_dp*t191*t16* & - s_arhoanorm_drhoa+0.8e1_dp*t577*t579*s_arhoa*s_anorm_drhoa & - -0.2e1_dp*t196*t198*s_arhoanorm_drhoa - s_a_2rhoanorm_drhoa = 0.2e1_dp*s_anorm_drhoa*s_arhoa+ & + u_x_arhoanorm_drhoa = 0.2e1_dp*gamma_x*s_anorm_drhoa*t192 - & + 0.10e2_dp*t568*t199*s_anorm_drhoa + 0.2e1_dp*t191*t16* & + s_arhoanorm_drhoa + 0.8e1_dp*t577*t579*s_arhoa*s_anorm_drhoa & + - 0.2e1_dp*t196*t198*s_arhoanorm_drhoa + s_a_2rhoanorm_drhoa = 0.2e1_dp*s_anorm_drhoa*s_arhoa + & 0.2e1_dp*s_a*s_arhoanorm_drhoa s_avg_2rhoanorm_drhoa = s_a_2rhoanorm_drhoa/0.2e1_dp - u_c_abrhoanorm_drhoa = gamma_c_ab*s_avg_2rhoanorm_drhoa*t162- & - 0.2e1_dp*t906*t512+0.2e1_dp*t911*t914*s_avg_2norm_drhoa & - -t337*t339*s_avg_2rhoanorm_drhoa - u_c_arhoanorm_drhoa = gamma_c_ss*s_a_2rhoanorm_drhoa*t165- & - 0.2e1_dp*t925*t516+0.2e1_dp*t930*t933*s_a_2norm_drhoa- & + u_c_abrhoanorm_drhoa = gamma_c_ab*s_avg_2rhoanorm_drhoa*t162 - & + 0.2e1_dp*t906*t512 + 0.2e1_dp*t911*t914*s_avg_2norm_drhoa & + - t337*t339*s_avg_2rhoanorm_drhoa + u_c_arhoanorm_drhoa = gamma_c_ss*s_a_2rhoanorm_drhoa*t165 - & + 0.2e1_dp*t925*t516 + 0.2e1_dp*t930*t933*s_a_2norm_drhoa - & t345*t347*s_a_2rhoanorm_drhoa IF (grad_deriv > 1 .OR. grad_deriv == -2) THEN - exc_rhoa_norm_drhoa = scale_x*(e_lsda_x_arhoa*gx_anorm_drhoa+ & - e_lsda_x_a*(u_x_arhoanorm_drhoa*t18+0.2e1_dp*u_x_arhoa* & - u_x_anorm_drhoa*c_x_2+u_x_a*u_x_arhoanorm_drhoa*c_x_2))+ & - scale_c*(e_lsda_c_abrhoa*gc_abnorm_drhoa+e_lsda_c_ab*( & - u_c_abrhoanorm_drhoa*t170+0.2e1_dp*u_c_abrhoa* & - u_c_abnorm_drhoa*c_cab_2+u_c_ab*u_c_abrhoanorm_drhoa*c_cab_2 & - )+e_lsda_c_arhoa*gc_anorm_drhoa+e_lsda_c_a*( & - u_c_arhoanorm_drhoa*t173+0.2e1_dp*u_c_arhoa*u_c_anorm_drhoa & - *c_css_2+u_c_a*u_c_arhoanorm_drhoa*c_css_2)) - e_ra_ndra(ii) = e_ra_ndra(ii)+exc_rhoa_norm_drhoa + exc_rhoa_norm_drhoa = scale_x*(e_lsda_x_arhoa*gx_anorm_drhoa + & + e_lsda_x_a*(u_x_arhoanorm_drhoa*t18 + 0.2e1_dp*u_x_arhoa* & + u_x_anorm_drhoa*c_x_2 + u_x_a*u_x_arhoanorm_drhoa*c_x_2)) + & + scale_c*(e_lsda_c_abrhoa*gc_abnorm_drhoa + e_lsda_c_ab*( & + u_c_abrhoanorm_drhoa*t170 + 0.2e1_dp*u_c_abrhoa* & + u_c_abnorm_drhoa*c_cab_2 + u_c_ab*u_c_abrhoanorm_drhoa*c_cab_2 & + ) + e_lsda_c_arhoa*gc_anorm_drhoa + e_lsda_c_a*( & + u_c_arhoanorm_drhoa*t173 + 0.2e1_dp*u_c_arhoa*u_c_anorm_drhoa & + *c_css_2 + u_c_a*u_c_arhoanorm_drhoa*c_css_2)) + e_ra_ndra(ii) = e_ra_ndra(ii) + exc_rhoa_norm_drhoa END IF - u_c_abrhobnorm_drhoa = -0.2e1_dp*t1436*t512+0.2e1_dp*t911 & + u_c_abrhobnorm_drhoa = -0.2e1_dp*t1436*t512 + 0.2e1_dp*t911 & *t1440*s_avg_2norm_drhoa IF (grad_deriv > 1 .OR. grad_deriv == -2) THEN exc_rhob_norm_drhoa = scale_c*(e_lsda_c_abrhob*gc_abnorm_drhoa & - +e_lsda_c_ab*(u_c_abrhobnorm_drhoa*t170+0.2e1_dp* & - u_c_abrhob*u_c_abnorm_drhoa*c_cab_2+u_c_ab* & - u_c_abrhobnorm_drhoa*c_cab_2)) - e_rb_ndra(ii) = e_rb_ndra(ii)+exc_rhob_norm_drhoa + + e_lsda_c_ab*(u_c_abrhobnorm_drhoa*t170 + 0.2e1_dp* & + u_c_abrhob*u_c_abnorm_drhoa*c_cab_2 + u_c_ab* & + u_c_abrhobnorm_drhoa*c_cab_2)) + e_rb_ndra(ii) = e_rb_ndra(ii) + exc_rhob_norm_drhoa END IF t1571 = s_anorm_drhoa**2 - u_x_anorm_drhoanorm_drhoa = 0.2e1_dp*gamma_x*t1571*t16- & - 0.10e2_dp*t568*t198*t1571+0.8e1_dp*t577*t579*t1571 + u_x_anorm_drhoanorm_drhoa = 0.2e1_dp*gamma_x*t1571*t16 - & + 0.10e2_dp*t568*t198*t1571 + 0.8e1_dp*t577*t579*t1571 s_a_2norm_drhoanorm_drhoa = 0.2e1_dp*t1571 s_a_21norm_drhoa = s_a_2norm_drhoa s_avg_2norm_drhoanorm_drhoa = s_a_2norm_drhoanorm_drhoa/0.2e1_dp @@ -1447,108 +1447,108 @@ SUBROUTINE b97_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, & t1590 = t339*s_avg_21norm_drhoa t1593 = t913*s_avg_2norm_drhoa u_c_abnorm_drhoanorm_drhoa = gamma_c_ab* & - s_avg_2norm_drhoanorm_drhoa*t162-0.2e1_dp*t1589*t1590+ & - 0.2e1_dp*t911*t1593*s_avg_21norm_drhoa-t337*t339* & + s_avg_2norm_drhoanorm_drhoa*t162 - 0.2e1_dp*t1589*t1590 + & + 0.2e1_dp*t911*t1593*s_avg_21norm_drhoa - t337*t339* & s_avg_2norm_drhoanorm_drhoa t1605 = t347*s_a_21norm_drhoa u_c_anorm_drhoanorm_drhoa = gamma_c_ss*s_a_2norm_drhoanorm_drhoa & - *t165-0.2e1_dp*t344*s_a_2norm_drhoa*t1605+0.2e1_dp* & - t930*t932*s_a_2norm_drhoa*s_a_21norm_drhoa-t345*t347* & + *t165 - 0.2e1_dp*t344*s_a_2norm_drhoa*t1605 + 0.2e1_dp* & + t930*t932*s_a_2norm_drhoa*s_a_21norm_drhoa - t345*t347* & s_a_2norm_drhoanorm_drhoa IF (grad_deriv > 1 .OR. grad_deriv == -2) THEN exc_norm_drhoa_norm_drhoa = scale_x*e_lsda_x_a*( & - u_x_anorm_drhoanorm_drhoa*t18+0.2e1_dp*u_x_anorm_drhoa**2* & - c_x_2+u_x_a*u_x_anorm_drhoanorm_drhoa*c_x_2)+scale_c*( & - e_lsda_c_ab*(u_c_abnorm_drhoanorm_drhoa*t170+0.2e1_dp* & - u_c_abnorm_drhoa*(gamma_c_ab*s_avg_21norm_drhoa*t162-t337* & - t1590)*c_cab_2+u_c_ab*u_c_abnorm_drhoanorm_drhoa*c_cab_2)+ & - e_lsda_c_a*(u_c_anorm_drhoanorm_drhoa*t173+0.2e1_dp* & - u_c_anorm_drhoa*(gamma_c_ss*s_a_21norm_drhoa*t165-t345* & - t1605)*c_css_2+u_c_a*u_c_anorm_drhoanorm_drhoa*c_css_2)) - e_ndra_ndra(ii) = e_ndra_ndra(ii)+exc_norm_drhoa_norm_drhoa + u_x_anorm_drhoanorm_drhoa*t18 + 0.2e1_dp*u_x_anorm_drhoa**2* & + c_x_2 + u_x_a*u_x_anorm_drhoanorm_drhoa*c_x_2) + scale_c*( & + e_lsda_c_ab*(u_c_abnorm_drhoanorm_drhoa*t170 + 0.2e1_dp* & + u_c_abnorm_drhoa*(gamma_c_ab*s_avg_21norm_drhoa*t162 - t337* & + t1590)*c_cab_2 + u_c_ab*u_c_abnorm_drhoanorm_drhoa*c_cab_2) + & + e_lsda_c_a*(u_c_anorm_drhoanorm_drhoa*t173 + 0.2e1_dp* & + u_c_anorm_drhoa*(gamma_c_ss*s_a_21norm_drhoa*t165 - t345* & + t1605)*c_css_2 + u_c_a*u_c_anorm_drhoanorm_drhoa*c_css_2)) + e_ndra_ndra(ii) = e_ndra_ndra(ii) + exc_norm_drhoa_norm_drhoa END IF - u_c_abrhoanorm_drhob = -0.2e1_dp*t906*t539+0.2e1_dp*t911* & + u_c_abrhoanorm_drhob = -0.2e1_dp*t906*t539 + 0.2e1_dp*t911* & t914*s_avg_2norm_drhob IF (grad_deriv > 1 .OR. grad_deriv == -2) THEN exc_rhoa_norm_drhob = scale_c*(e_lsda_c_abrhoa*gc_abnorm_drhob & - +e_lsda_c_ab*(u_c_abrhoanorm_drhob*t170+0.2e1_dp* & - u_c_abrhoa*u_c_abnorm_drhob*c_cab_2+u_c_ab* & - u_c_abrhoanorm_drhob*c_cab_2)) - e_ra_ndrb(ii) = e_ra_ndrb(ii)+exc_rhoa_norm_drhob + + e_lsda_c_ab*(u_c_abrhoanorm_drhob*t170 + 0.2e1_dp* & + u_c_abrhoa*u_c_abnorm_drhob*c_cab_2 + u_c_ab* & + u_c_abrhoanorm_drhob*c_cab_2)) + e_ra_ndrb(ii) = e_ra_ndrb(ii) + exc_rhoa_norm_drhob END IF s_brhobnorm_drhob = -0.4e1_dp/0.3e1_dp*t367 - u_x_brhobnorm_drhob = 0.2e1_dp*gamma_x*s_bnorm_drhob*t371- & - 0.10e2_dp*t1165*t377*s_bnorm_drhob+0.2e1_dp*t370*t29* & - s_brhobnorm_drhob+0.8e1_dp*t1173*t1175*s_brhob* & - s_bnorm_drhob-0.2e1_dp*t374*t376*s_brhobnorm_drhob - s_b_2rhobnorm_drhob = 0.2e1_dp*s_bnorm_drhob*s_brhob+ & + u_x_brhobnorm_drhob = 0.2e1_dp*gamma_x*s_bnorm_drhob*t371 - & + 0.10e2_dp*t1165*t377*s_bnorm_drhob + 0.2e1_dp*t370*t29* & + s_brhobnorm_drhob + 0.8e1_dp*t1173*t1175*s_brhob* & + s_bnorm_drhob - 0.2e1_dp*t374*t376*s_brhobnorm_drhob + s_b_2rhobnorm_drhob = 0.2e1_dp*s_bnorm_drhob*s_brhob + & 0.2e1_dp*s_b*s_brhobnorm_drhob s_avg_2rhobnorm_drhob = s_b_2rhobnorm_drhob/0.2e1_dp - u_c_abrhobnorm_drhob = gamma_c_ab*s_avg_2rhobnorm_drhob*t162- & - 0.2e1_dp*t1436*t539+0.2e1_dp*t911*t1440* & - s_avg_2norm_drhob-t337*t339*s_avg_2rhobnorm_drhob - u_c_brhobnorm_drhob = gamma_c_ss*s_b_2rhobnorm_drhob*t168- & - 0.2e1_dp*t1451*t543+0.2e1_dp*t1455*t1458*s_b_2norm_drhob & - -t484*t486*s_b_2rhobnorm_drhob + u_c_abrhobnorm_drhob = gamma_c_ab*s_avg_2rhobnorm_drhob*t162 - & + 0.2e1_dp*t1436*t539 + 0.2e1_dp*t911*t1440* & + s_avg_2norm_drhob - t337*t339*s_avg_2rhobnorm_drhob + u_c_brhobnorm_drhob = gamma_c_ss*s_b_2rhobnorm_drhob*t168 - & + 0.2e1_dp*t1451*t543 + 0.2e1_dp*t1455*t1458*s_b_2norm_drhob & + - t484*t486*s_b_2rhobnorm_drhob IF (grad_deriv > 1 .OR. grad_deriv == -2) THEN - exc_rhob_norm_drhob = scale_x*(e_lsda_x_brhob*gx_bnorm_drhob+ & - e_lsda_x_b*(u_x_brhobnorm_drhob*t31+0.2e1_dp*u_x_brhob* & - u_x_bnorm_drhob*c_x_2+u_x_b*u_x_brhobnorm_drhob*c_x_2))+ & - scale_c*(e_lsda_c_abrhob*gc_abnorm_drhob+e_lsda_c_ab*( & - u_c_abrhobnorm_drhob*t170+0.2e1_dp*u_c_abrhob* & - u_c_abnorm_drhob*c_cab_2+u_c_ab*u_c_abrhobnorm_drhob*c_cab_2 & - )+e_lsda_c_brhob*gc_bnorm_drhob+e_lsda_c_b*( & - u_c_brhobnorm_drhob*t176+0.2e1_dp*u_c_brhob*u_c_bnorm_drhob & - *c_css_2+u_c_b*u_c_brhobnorm_drhob*c_css_2)) - e_rb_ndrb(ii) = e_rb_ndrb(ii)+exc_rhob_norm_drhob + exc_rhob_norm_drhob = scale_x*(e_lsda_x_brhob*gx_bnorm_drhob + & + e_lsda_x_b*(u_x_brhobnorm_drhob*t31 + 0.2e1_dp*u_x_brhob* & + u_x_bnorm_drhob*c_x_2 + u_x_b*u_x_brhobnorm_drhob*c_x_2)) + & + scale_c*(e_lsda_c_abrhob*gc_abnorm_drhob + e_lsda_c_ab*( & + u_c_abrhobnorm_drhob*t170 + 0.2e1_dp*u_c_abrhob* & + u_c_abnorm_drhob*c_cab_2 + u_c_ab*u_c_abrhobnorm_drhob*c_cab_2 & + ) + e_lsda_c_brhob*gc_bnorm_drhob + e_lsda_c_b*( & + u_c_brhobnorm_drhob*t176 + 0.2e1_dp*u_c_brhob*u_c_bnorm_drhob & + *c_css_2 + u_c_b*u_c_brhobnorm_drhob*c_css_2)) + e_rb_ndrb(ii) = e_rb_ndrb(ii) + exc_rhob_norm_drhob END IF - u_c_abnorm_drhoanorm_drhob = -0.2e1_dp*t1589*t539+0.2e1_dp* & + u_c_abnorm_drhoanorm_drhob = -0.2e1_dp*t1589*t539 + 0.2e1_dp* & t911*t1593*s_avg_2norm_drhob IF (grad_deriv > 1 .OR. grad_deriv == -2) THEN exc_norm_drhoa_norm_drhob = scale_c*e_lsda_c_ab*( & - u_c_abnorm_drhoanorm_drhob*t170+0.2e1_dp*u_c_abnorm_drhoa* & - u_c_abnorm_drhob*c_cab_2+u_c_ab*u_c_abnorm_drhoanorm_drhob* & + u_c_abnorm_drhoanorm_drhob*t170 + 0.2e1_dp*u_c_abnorm_drhoa* & + u_c_abnorm_drhob*c_cab_2 + u_c_ab*u_c_abnorm_drhoanorm_drhob* & c_cab_2) - e_ndra_ndrb(ii) = e_ndra_ndrb(ii)+exc_norm_drhoa_norm_drhob + e_ndra_ndrb(ii) = e_ndra_ndrb(ii) + exc_norm_drhoa_norm_drhob END IF t1719 = s_bnorm_drhob**2 - u_x_bnorm_drhobnorm_drhob = 0.2e1_dp*gamma_x*t1719*t29- & - 0.10e2_dp*t1165*t376*t1719+0.8e1_dp*t1173*t1175*t1719 + u_x_bnorm_drhobnorm_drhob = 0.2e1_dp*gamma_x*t1719*t29 - & + 0.10e2_dp*t1165*t376*t1719 + 0.8e1_dp*t1173*t1175*t1719 s_b_2norm_drhobnorm_drhob = 0.2e1_dp*t1719 s_b_21norm_drhob = s_b_2norm_drhob s_avg_2norm_drhobnorm_drhob = s_b_2norm_drhobnorm_drhob/0.2e1_dp s_avg_21norm_drhob = s_b_21norm_drhob/0.2e1_dp t1738 = t339*s_avg_21norm_drhob u_c_abnorm_drhobnorm_drhob = gamma_c_ab* & - s_avg_2norm_drhobnorm_drhob*t162-0.2e1_dp*t336* & - s_avg_2norm_drhob*t1738+0.2e1_dp*t911*t913* & - s_avg_2norm_drhob*s_avg_21norm_drhob-t337*t339* & + s_avg_2norm_drhobnorm_drhob*t162 - 0.2e1_dp*t336* & + s_avg_2norm_drhob*t1738 + 0.2e1_dp*t911*t913* & + s_avg_2norm_drhob*s_avg_21norm_drhob - t337*t339* & s_avg_2norm_drhobnorm_drhob t1753 = t486*s_b_21norm_drhob u_c_bnorm_drhobnorm_drhob = gamma_c_ss*s_b_2norm_drhobnorm_drhob & - *t168-0.2e1_dp*t344*s_b_2norm_drhob*t1753+0.2e1_dp* & - t1455*t1457*s_b_2norm_drhob*s_b_21norm_drhob-t484*t486* & + *t168 - 0.2e1_dp*t344*s_b_2norm_drhob*t1753 + 0.2e1_dp* & + t1455*t1457*s_b_2norm_drhob*s_b_21norm_drhob - t484*t486* & s_b_2norm_drhobnorm_drhob IF (grad_deriv > 1 .OR. grad_deriv == -2) THEN exc_norm_drhob_norm_drhob = scale_x*e_lsda_x_b*( & - u_x_bnorm_drhobnorm_drhob*t31+0.2e1_dp*u_x_bnorm_drhob**2* & - c_x_2+u_x_b*u_x_bnorm_drhobnorm_drhob*c_x_2)+scale_c*( & - e_lsda_c_ab*(u_c_abnorm_drhobnorm_drhob*t170+0.2e1_dp* & - u_c_abnorm_drhob*(gamma_c_ab*s_avg_21norm_drhob*t162-t337* & - t1738)*c_cab_2+u_c_ab*u_c_abnorm_drhobnorm_drhob*c_cab_2)+ & - e_lsda_c_b*(u_c_bnorm_drhobnorm_drhob*t176+0.2e1_dp* & - u_c_bnorm_drhob*(gamma_c_ss*s_b_21norm_drhob*t168-t484* & - t1753)*c_css_2+u_c_b*u_c_bnorm_drhobnorm_drhob*c_css_2)) - e_ndrb_ndrb(ii) = e_ndrb_ndrb(ii)+exc_norm_drhob_norm_drhob + u_x_bnorm_drhobnorm_drhob*t31 + 0.2e1_dp*u_x_bnorm_drhob**2* & + c_x_2 + u_x_b*u_x_bnorm_drhobnorm_drhob*c_x_2) + scale_c*( & + e_lsda_c_ab*(u_c_abnorm_drhobnorm_drhob*t170 + 0.2e1_dp* & + u_c_abnorm_drhob*(gamma_c_ab*s_avg_21norm_drhob*t162 - t337* & + t1738)*c_cab_2 + u_c_ab*u_c_abnorm_drhobnorm_drhob*c_cab_2) + & + e_lsda_c_b*(u_c_bnorm_drhobnorm_drhob*t176 + 0.2e1_dp* & + u_c_bnorm_drhob*(gamma_c_ss*s_b_21norm_drhob*t168 - t484* & + t1753)*c_css_2 + u_c_b*u_c_bnorm_drhobnorm_drhob*c_css_2)) + e_ndrb_ndrb(ii) = e_ndrb_ndrb(ii) + exc_norm_drhob_norm_drhob END IF END IF ! <1 || >1 END IF ! /=0 @@ -1710,11 +1710,11 @@ SUBROUTINE b97_lda_calc(rho_tot, norm_drho, & DO ii = 1, npoints my_rhoa = 0.5_dp*MAX(rho_tot(ii), 0.0_dp) my_rhob = my_rhoa - rho = my_rhoa+my_rhob + rho = my_rhoa + my_rhob IF (rho > epsilon_rho) THEN my_rhoa = MAX(my_rhoa, 0.5_dp*epsilon_rho) my_rhob = MAX(my_rhob, 0.5_dp*epsilon_rho) - rho = my_rhoa+my_rhob + rho = my_rhoa + my_rhob my_norm_drhoa = 0.5_dp*norm_drho(ii) my_norm_drhob = 0.5_dp*norm_drho(ii) t7 = my_rhoa**(0.1e1_dp/0.3e1_dp) @@ -1724,11 +1724,11 @@ SUBROUTINE b97_lda_calc(rho_tot, norm_drho, & s_a = my_norm_drhoa*t12 t13 = s_a**2 t14 = gamma_x*t13 - t15 = 0.1e1_dp+t14 + t15 = 0.1e1_dp + t14 t16 = 0.1e1_dp/t15 u_x_a = t14*t16 - t18 = c_x_1+u_x_a*c_x_2 - gx_a = c_x_0+u_x_a*t18 + t18 = c_x_1 + u_x_a*c_x_2 + gx_a = c_x_0 + u_x_a*t18 t20 = my_rhob**(0.1e1_dp/0.3e1_dp) t21 = t20*my_rhob e_lsda_x_b = -0.3e1_dp/0.8e1_dp*t4*t6*t21 @@ -1736,114 +1736,114 @@ SUBROUTINE b97_lda_calc(rho_tot, norm_drho, & s_b = my_norm_drhob*t25 t26 = s_b**2 t27 = gamma_x*t26 - t28 = 0.1e1_dp+t27 + t28 = 0.1e1_dp + t27 t29 = 0.1e1_dp/t28 u_x_b = t27*t29 - t31 = c_x_1+u_x_b*c_x_2 - gx_b = c_x_0+u_x_b*t31 - t33 = my_rhoa-my_rhob + t31 = c_x_1 + u_x_b*c_x_2 + gx_b = c_x_0 + u_x_b*t31 + t33 = my_rhoa - my_rhob t34 = 0.1e1_dp/rho chi = t33*t34 t35 = 0.1e1_dp/pi t36 = t35*t34 t37 = t36**(0.1e1_dp/0.3e1_dp) rs = t4*t37/0.4e1_dp - t40 = 0.1e1_dp+alpha_1_1*rs + t40 = 0.1e1_dp + alpha_1_1*rs t42 = 0.1e1_dp/A_1 t43 = SQRT(rs) t46 = t43*rs - t48 = p_1+0.1e1_dp + t48 = p_1 + 0.1e1_dp t49 = rs**t48 t50 = beta_4_1*t49 - t51 = beta_1_1*t43+beta_2_1*rs+beta_3_1*t46+t50 - t55 = 0.1e1_dp+t42/t51/0.2e1_dp + t51 = beta_1_1*t43 + beta_2_1*rs + beta_3_1*t46 + t50 + t55 = 0.1e1_dp + t42/t51/0.2e1_dp t56 = LOG(t55) e_c_u_0 = -0.2e1_dp*A_1*t40*t56 - t60 = 0.1e1_dp+alpha_1_2*rs + t60 = 0.1e1_dp + alpha_1_2*rs t62 = 0.1e1_dp/A_2 - t66 = p_2+0.1e1_dp + t66 = p_2 + 0.1e1_dp t67 = rs**t66 t68 = beta_4_2*t67 - t69 = beta_1_2*t43+beta_2_2*rs+beta_3_2*t46+t68 - t73 = 0.1e1_dp+t62/t69/0.2e1_dp + t69 = beta_1_2*t43 + beta_2_2*rs + beta_3_2*t46 + t68 + t73 = 0.1e1_dp + t62/t69/0.2e1_dp t74 = LOG(t73) - t78 = 0.1e1_dp+alpha_1_3*rs + t78 = 0.1e1_dp + alpha_1_3*rs t80 = 0.1e1_dp/A_3 - t84 = p_3+0.1e1_dp + t84 = p_3 + 0.1e1_dp t85 = rs**t84 t86 = beta_4_3*t85 - t87 = beta_1_3*t43+beta_2_3*rs+beta_3_3*t46+t86 - t91 = 0.1e1_dp+t80/t87/0.2e1_dp + t87 = beta_1_3*t43 + beta_2_3*rs + beta_3_3*t46 + t86 + t91 = 0.1e1_dp + t80/t87/0.2e1_dp t92 = LOG(t91) alpha_c = 0.2e1_dp*A_3*t78*t92 t94 = 2**(0.1e1_dp/0.3e1_dp) - t97 = 1/(2*t94-2) - t98 = 0.1e1_dp+chi + t97 = 1/(2*t94 - 2) + t98 = 0.1e1_dp + chi t99 = t98**(0.1e1_dp/0.3e1_dp) - t101 = 0.1e1_dp-chi + t101 = 0.1e1_dp - chi t102 = t101**(0.1e1_dp/0.3e1_dp) - f = (t99*t98+t102*t101-0.2e1_dp)*t97 + f = (t99*t98 + t102*t101 - 0.2e1_dp)*t97 t105 = alpha_c*f t106 = 0.9e1_dp/0.8e1_dp/t97 t107 = chi**2 t108 = t107**2 - t110 = t106*(0.1e1_dp-t108) - t112 = -0.2e1_dp*A_2*t60*t74-e_c_u_0 + t110 = t106*(0.1e1_dp - t108) + t112 = -0.2e1_dp*A_2*t60*t74 - e_c_u_0 t113 = t112*f - epsilon_c_unif = e_c_u_0+t105*t110+t113*t108 + epsilon_c_unif = e_c_u_0 + t105*t110 + t113*t108 t116 = t35/my_rhoa t117 = t116**(0.1e1_dp/0.3e1_dp) rs_a = t4*t117/0.4e1_dp - t120 = 0.1e1_dp+alpha_1_2*rs_a + t120 = 0.1e1_dp + alpha_1_2*rs_a t122 = SQRT(rs_a) t125 = t122*rs_a t127 = rs_a**t66 t128 = beta_4_2*t127 - t129 = beta_1_2*t122+beta_2_2*rs_a+beta_3_2*t125+t128 - t133 = 0.1e1_dp+t62/t129/0.2e1_dp + t129 = beta_1_2*t122 + beta_2_2*rs_a + beta_3_2*t125 + t128 + t133 = 0.1e1_dp + t62/t129/0.2e1_dp t134 = LOG(t133) epsilon_c_unif_a = -0.2e1_dp*A_2*t120*t134 t138 = t35/my_rhob t139 = t138**(0.1e1_dp/0.3e1_dp) rs_b = t4*t139/0.4e1_dp - t142 = 0.1e1_dp+alpha_1_2*rs_b + t142 = 0.1e1_dp + alpha_1_2*rs_b t144 = SQRT(rs_b) t147 = t144*rs_b t149 = rs_b**t66 t150 = beta_4_2*t149 - t151 = beta_1_2*t144+beta_2_2*rs_b+beta_3_2*t147+t150 - t155 = 0.1e1_dp+t62/t151/0.2e1_dp + t151 = beta_1_2*t144 + beta_2_2*rs_b + beta_3_2*t147 + t150 + t155 = 0.1e1_dp + t62/t151/0.2e1_dp t156 = LOG(t155) epsilon_c_unif_b = -0.2e1_dp*A_2*t142*t156 s_a_2 = t13 s_b_2 = t26 - s_avg_2 = s_a_2/0.2e1_dp+s_b_2/0.2e1_dp + s_avg_2 = s_a_2/0.2e1_dp + s_b_2/0.2e1_dp e_lsda_c_a = epsilon_c_unif_a*my_rhoa e_lsda_c_b = epsilon_c_unif_b*my_rhob t160 = gamma_c_ab*s_avg_2 - t161 = 0.1e1_dp+t160 + t161 = 0.1e1_dp + t160 t162 = 0.1e1_dp/t161 u_c_ab = t160*t162 t163 = gamma_c_ss*s_a_2 - t164 = 0.1e1_dp+t163 + t164 = 0.1e1_dp + t163 t165 = 0.1e1_dp/t164 u_c_a = t163*t165 t166 = gamma_c_ss*s_b_2 - t167 = 0.1e1_dp+t166 + t167 = 0.1e1_dp + t166 t168 = 0.1e1_dp/t167 u_c_b = t166*t168 - e_lsda_c_ab = epsilon_c_unif*rho-e_lsda_c_a-e_lsda_c_b - t170 = c_cab_1+u_c_ab*c_cab_2 - gc_ab = c_cab_0+u_c_ab*t170 - t173 = c_css_1+u_c_a*c_css_2 - gc_a = c_css_0+u_c_a*t173 - t176 = c_css_1+u_c_b*c_css_2 - gc_b = c_css_0+u_c_b*t176 + e_lsda_c_ab = epsilon_c_unif*rho - e_lsda_c_a - e_lsda_c_b + t170 = c_cab_1 + u_c_ab*c_cab_2 + gc_ab = c_cab_0 + u_c_ab*t170 + t173 = c_css_1 + u_c_a*c_css_2 + gc_a = c_css_0 + u_c_a*t173 + t176 = c_css_1 + u_c_b*c_css_2 + gc_b = c_css_0 + u_c_b*t176 IF (grad_deriv >= 0) THEN - exc = scale_x*(e_lsda_x_a*gx_a+e_lsda_x_b*gx_b)+scale_c & - *(e_lsda_c_ab*gc_ab+e_lsda_c_a*gc_a+e_lsda_c_b*gc_b) - e_0(ii) = e_0(ii)+exc + exc = scale_x*(e_lsda_x_a*gx_a + e_lsda_x_b*gx_b) + scale_c & + *(e_lsda_c_ab*gc_ab + e_lsda_c_a*gc_a + e_lsda_c_b*gc_b) + e_0(ii) = e_0(ii) + exc END IF IF (grad_deriv /= 0) THEN @@ -1859,12 +1859,12 @@ SUBROUTINE b97_lda_calc(rho_tot, norm_drho, & t197 = t15**2 t198 = 0.1e1_dp/t197 t199 = t198*s_arhoa - u_x_arhoa = 0.2e1_dp*t191*t192-0.2e1_dp*t196*t199 - gx_arhoa = u_x_arhoa*t18+u_x_a*u_x_arhoa*c_x_2 + u_x_arhoa = 0.2e1_dp*t191*t192 - 0.2e1_dp*t196*t199 + gx_arhoa = u_x_arhoa*t18 + u_x_a*u_x_arhoa*c_x_2 t207 = rho**2 t208 = 0.1e1_dp/t207 t209 = t33*t208 - chirhoa = t34-t209 + chirhoa = t34 - t209 t210 = t37**2 t212 = 0.1e1_dp/t210*t35 rsrhoa = -t4*t212*t208/0.12e2_dp @@ -1876,34 +1876,34 @@ SUBROUTINE b97_lda_calc(rho_tot, norm_drho, & t224 = beta_1_1*t223 t228 = beta_3_1*t43 t232 = 0.1e1_dp/rs - t235 = t224*rsrhoa/0.2e1_dp+beta_2_1*rsrhoa+0.3e1_dp/ & - 0.2e1_dp*t228*rsrhoa+t50*t48*rsrhoa*t232 + t235 = t224*rsrhoa/0.2e1_dp + beta_2_1*rsrhoa + 0.3e1_dp/ & + 0.2e1_dp*t228*rsrhoa + t50*t48*rsrhoa*t232 t236 = 0.1e1_dp/t55 t237 = t235*t236 - e_c_u_0rhoa = -0.2e1_dp*t216*rsrhoa*t56+t222*t237 + e_c_u_0rhoa = -0.2e1_dp*t216*rsrhoa*t56 + t222*t237 t239 = A_2*alpha_1_2 t243 = t69**2 t244 = 0.1e1_dp/t243 t245 = t60*t244 t246 = beta_1_2*t223 t250 = beta_3_2*t43 - t256 = t246*rsrhoa/0.2e1_dp+beta_2_2*rsrhoa+0.3e1_dp/ & - 0.2e1_dp*t250*rsrhoa+t68*t66*rsrhoa*t232 + t256 = t246*rsrhoa/0.2e1_dp + beta_2_2*rsrhoa + 0.3e1_dp/ & + 0.2e1_dp*t250*rsrhoa + t68*t66*rsrhoa*t232 t257 = 0.1e1_dp/t73 t258 = t256*t257 - e_c_u_1rhoa = -0.2e1_dp*t239*rsrhoa*t74+t245*t258 + e_c_u_1rhoa = -0.2e1_dp*t239*rsrhoa*t74 + t245*t258 t260 = A_3*alpha_1_3 t264 = t87**2 t265 = 0.1e1_dp/t264 t266 = t78*t265 t267 = beta_1_3*t223 t271 = beta_3_3*t43 - t277 = t267*rsrhoa/0.2e1_dp+beta_2_3*rsrhoa+0.3e1_dp/ & - 0.2e1_dp*t271*rsrhoa+t86*t84*rsrhoa*t232 + t277 = t267*rsrhoa/0.2e1_dp + beta_2_3*rsrhoa + 0.3e1_dp/ & + 0.2e1_dp*t271*rsrhoa + t86*t84*rsrhoa*t232 t278 = 0.1e1_dp/t91 t279 = t277*t278 - alpha_crhoa = 0.2e1_dp*t260*rsrhoa*t92-t266*t279 - frhoa = (0.4e1_dp/0.3e1_dp*t99*chirhoa-0.4e1_dp/0.3e1_dp & + alpha_crhoa = 0.2e1_dp*t260*rsrhoa*t92 - t266*t279 + frhoa = (0.4e1_dp/0.3e1_dp*t99*chirhoa - 0.4e1_dp/0.3e1_dp & *t102*chirhoa)*t97 t285 = alpha_crhoa*f t287 = alpha_c*frhoa @@ -1911,13 +1911,13 @@ SUBROUTINE b97_lda_calc(rho_tot, norm_drho, & t290 = t106*t289 t291 = t290*chirhoa t293 = 0.4e1_dp*t105*t291 - t294 = e_c_u_1rhoa-e_c_u_0rhoa + t294 = e_c_u_1rhoa - e_c_u_0rhoa t295 = t294*f t297 = t112*frhoa t299 = t289*chirhoa t301 = 0.4e1_dp*t113*t299 - epsilon_c_unifrhoa = e_c_u_0rhoa+t285*t110+t287*t110- & - t293+t295*t108+t297*t108+t301 + epsilon_c_unifrhoa = e_c_u_0rhoa + t285*t110 + t287*t110 - & + t293 + t295*t108 + t297*t108 + t301 t302 = t117**2 t304 = 0.1e1_dp/t302*t35 rs_arhoa = -t4*t304/t186/0.12e2_dp @@ -1928,34 +1928,34 @@ SUBROUTINE b97_lda_calc(rho_tot, norm_drho, & t316 = beta_1_2*t315 t320 = beta_3_2*t122 t324 = 0.1e1_dp/rs_a - t327 = t316*rs_arhoa/0.2e1_dp+beta_2_2*rs_arhoa+0.3e1_dp & - /0.2e1_dp*t320*rs_arhoa+t128*t66*rs_arhoa*t324 + t327 = t316*rs_arhoa/0.2e1_dp + beta_2_2*rs_arhoa + 0.3e1_dp & + /0.2e1_dp*t320*rs_arhoa + t128*t66*rs_arhoa*t324 t328 = 0.1e1_dp/t133 - epsilon_c_unif_arhoa = -0.2e1_dp*t239*rs_arhoa*t134+t314* & + epsilon_c_unif_arhoa = -0.2e1_dp*t239*rs_arhoa*t134 + t314* & t327*t328 s_a_2rhoa = 0.2e1_dp*s_a*s_arhoa s_avg_2rhoa = s_a_2rhoa/0.2e1_dp - e_lsda_c_arhoa = epsilon_c_unif_arhoa*my_rhoa+epsilon_c_unif_a + e_lsda_c_arhoa = epsilon_c_unif_arhoa*my_rhoa + epsilon_c_unif_a t336 = gamma_c_ab**2 t337 = t336*s_avg_2 t338 = t161**2 t339 = 0.1e1_dp/t338 - u_c_abrhoa = gamma_c_ab*s_avg_2rhoa*t162-t337*t339*s_avg_2rhoa + u_c_abrhoa = gamma_c_ab*s_avg_2rhoa*t162 - t337*t339*s_avg_2rhoa t344 = gamma_c_ss**2 t345 = t344*s_a_2 t346 = t164**2 t347 = 0.1e1_dp/t346 - u_c_arhoa = gamma_c_ss*s_a_2rhoa*t165-t345*t347*s_a_2rhoa - e_lsda_c_abrhoa = epsilon_c_unifrhoa*rho+epsilon_c_unif- & + u_c_arhoa = gamma_c_ss*s_a_2rhoa*t165 - t345*t347*s_a_2rhoa + e_lsda_c_abrhoa = epsilon_c_unifrhoa*rho + epsilon_c_unif - & e_lsda_c_arhoa - gc_abrhoa = u_c_abrhoa*t170+u_c_ab*u_c_abrhoa*c_cab_2 - gc_arhoa = u_c_arhoa*t173+u_c_a*u_c_arhoa*c_css_2 + gc_abrhoa = u_c_abrhoa*t170 + u_c_ab*u_c_abrhoa*c_cab_2 + gc_arhoa = u_c_arhoa*t173 + u_c_a*u_c_arhoa*c_css_2 IF (grad_deriv > 0 .OR. grad_deriv == -1) THEN - exc_rhoa = scale_x*(e_lsda_x_arhoa*gx_a+e_lsda_x_a* & - gx_arhoa)+scale_c*(e_lsda_c_abrhoa*gc_ab+e_lsda_c_ab* & - gc_abrhoa+e_lsda_c_arhoa*gc_a+e_lsda_c_a*gc_arhoa) - e_r(ii) = e_r(ii)+0.5_dp*exc_rhoa + exc_rhoa = scale_x*(e_lsda_x_arhoa*gx_a + e_lsda_x_a* & + gx_arhoa) + scale_c*(e_lsda_c_abrhoa*gc_ab + e_lsda_c_ab* & + gc_abrhoa + e_lsda_c_arhoa*gc_a + e_lsda_c_a*gc_arhoa) + e_r(ii) = e_r(ii) + 0.5_dp*exc_rhoa END IF e_lsda_x_brhob = -t4*t6*t20/0.2e1_dp @@ -1968,32 +1968,32 @@ SUBROUTINE b97_lda_calc(rho_tot, norm_drho, & t375 = t28**2 t376 = 0.1e1_dp/t375 t377 = t376*s_brhob - u_x_brhob = 0.2e1_dp*t370*t371-0.2e1_dp*t374*t377 - gx_brhob = u_x_brhob*t31+u_x_b*u_x_brhob*c_x_2 - chirhob = -t34-t209 + u_x_brhob = 0.2e1_dp*t370*t371 - 0.2e1_dp*t374*t377 + gx_brhob = u_x_brhob*t31 + u_x_b*u_x_brhob*c_x_2 + chirhob = -t34 - t209 rsrhob = rsrhoa - t396 = t224*rsrhob/0.2e1_dp+beta_2_1*rsrhob+0.3e1_dp/ & - 0.2e1_dp*t228*rsrhob+t50*t48*rsrhob*t232 - e_c_u_0rhob = -0.2e1_dp*t216*rsrhob*t56+t222*t396*t236 - t410 = t246*rsrhob/0.2e1_dp+beta_2_2*rsrhob+0.3e1_dp/ & - 0.2e1_dp*t250*rsrhob+t68*t66*rsrhob*t232 - e_c_u_1rhob = -0.2e1_dp*t239*rsrhob*t74+t245*t410*t257 - t424 = t267*rsrhob/0.2e1_dp+beta_2_3*rsrhob+0.3e1_dp/ & - 0.2e1_dp*t271*rsrhob+t86*t84*rsrhob*t232 - alpha_crhob = 0.2e1_dp*t260*rsrhob*t92-t266*t424*t278 - frhob = (0.4e1_dp/0.3e1_dp*t99*chirhob-0.4e1_dp/0.3e1_dp & + t396 = t224*rsrhob/0.2e1_dp + beta_2_1*rsrhob + 0.3e1_dp/ & + 0.2e1_dp*t228*rsrhob + t50*t48*rsrhob*t232 + e_c_u_0rhob = -0.2e1_dp*t216*rsrhob*t56 + t222*t396*t236 + t410 = t246*rsrhob/0.2e1_dp + beta_2_2*rsrhob + 0.3e1_dp/ & + 0.2e1_dp*t250*rsrhob + t68*t66*rsrhob*t232 + e_c_u_1rhob = -0.2e1_dp*t239*rsrhob*t74 + t245*t410*t257 + t424 = t267*rsrhob/0.2e1_dp + beta_2_3*rsrhob + 0.3e1_dp/ & + 0.2e1_dp*t271*rsrhob + t86*t84*rsrhob*t232 + alpha_crhob = 0.2e1_dp*t260*rsrhob*t92 - t266*t424*t278 + frhob = (0.4e1_dp/0.3e1_dp*t99*chirhob - 0.4e1_dp/0.3e1_dp & *t102*chirhob)*t97 t431 = alpha_crhob*f t433 = alpha_c*frhob t435 = t290*chirhob t437 = 0.4e1_dp*t105*t435 - t438 = e_c_u_1rhob-e_c_u_0rhob + t438 = e_c_u_1rhob - e_c_u_0rhob t439 = t438*f t441 = t112*frhob t443 = t289*chirhob t445 = 0.4e1_dp*t113*t443 - epsilon_c_unifrhob = e_c_u_0rhob+t431*t110+t433*t110- & - t437+t439*t108+t441*t108+t445 + epsilon_c_unifrhob = e_c_u_0rhob + t431*t110 + t433*t110 - & + t437 + t439*t108 + t441*t108 + t445 t446 = t139**2 t448 = 0.1e1_dp/t446*t35 rs_brhob = -t4*t448/t365/0.12e2_dp @@ -2004,72 +2004,72 @@ SUBROUTINE b97_lda_calc(rho_tot, norm_drho, & t460 = beta_1_2*t459 t464 = beta_3_2*t144 t468 = 0.1e1_dp/rs_b - t471 = t460*rs_brhob/0.2e1_dp+beta_2_2*rs_brhob+0.3e1_dp & - /0.2e1_dp*rs_brhob*t464+t150*t66*rs_brhob*t468 + t471 = t460*rs_brhob/0.2e1_dp + beta_2_2*rs_brhob + 0.3e1_dp & + /0.2e1_dp*rs_brhob*t464 + t150*t66*rs_brhob*t468 t472 = 0.1e1_dp/t155 - epsilon_c_unif_brhob = -0.2e1_dp*t239*rs_brhob*t156+t458* & + epsilon_c_unif_brhob = -0.2e1_dp*t239*rs_brhob*t156 + t458* & t471*t472 s_b_2rhob = 0.2e1_dp*s_b*s_brhob s_avg_2rhob = s_b_2rhob/0.2e1_dp - e_lsda_c_brhob = epsilon_c_unif_brhob*my_rhob+epsilon_c_unif_b + e_lsda_c_brhob = epsilon_c_unif_brhob*my_rhob + epsilon_c_unif_b t480 = t339*s_avg_2rhob - u_c_abrhob = gamma_c_ab*s_avg_2rhob*t162-t337*t480 + u_c_abrhob = gamma_c_ab*s_avg_2rhob*t162 - t337*t480 t484 = t344*s_b_2 t485 = t167**2 t486 = 0.1e1_dp/t485 - u_c_brhob = gamma_c_ss*s_b_2rhob*t168-t484*t486*s_b_2rhob - e_lsda_c_abrhob = epsilon_c_unifrhob*rho+epsilon_c_unif- & + u_c_brhob = gamma_c_ss*s_b_2rhob*t168 - t484*t486*s_b_2rhob + e_lsda_c_abrhob = epsilon_c_unifrhob*rho + epsilon_c_unif - & e_lsda_c_brhob - gc_abrhob = u_c_abrhob*t170+u_c_ab*u_c_abrhob*c_cab_2 - gc_brhob = u_c_brhob*t176+u_c_b*u_c_brhob*c_css_2 + gc_abrhob = u_c_abrhob*t170 + u_c_ab*u_c_abrhob*c_cab_2 + gc_brhob = u_c_brhob*t176 + u_c_b*u_c_brhob*c_css_2 IF (grad_deriv > 0 .OR. grad_deriv == -1) THEN - exc_rhob = scale_x*(e_lsda_x_brhob*gx_b+e_lsda_x_b* & - gx_brhob)+scale_c*(e_lsda_c_abrhob*gc_ab+e_lsda_c_ab* & - gc_abrhob+e_lsda_c_brhob*gc_b+e_lsda_c_b*gc_brhob) - e_r(ii) = e_r(ii)+0.5_dp*exc_rhob + exc_rhob = scale_x*(e_lsda_x_brhob*gx_b + e_lsda_x_b* & + gx_brhob) + scale_c*(e_lsda_c_abrhob*gc_ab + e_lsda_c_ab* & + gc_abrhob + e_lsda_c_brhob*gc_b + e_lsda_c_b*gc_brhob) + e_r(ii) = e_r(ii) + 0.5_dp*exc_rhob END IF s_anorm_drhoa = t12 - u_x_anorm_drhoa = 0.2e1_dp*t191*t16*s_anorm_drhoa-0.2e1_dp & + u_x_anorm_drhoa = 0.2e1_dp*t191*t16*s_anorm_drhoa - 0.2e1_dp & *t196*t198*s_anorm_drhoa - gx_anorm_drhoa = u_x_anorm_drhoa*t18+u_x_a*u_x_anorm_drhoa*c_x_2 + gx_anorm_drhoa = u_x_anorm_drhoa*t18 + u_x_a*u_x_anorm_drhoa*c_x_2 s_a_2norm_drhoa = 0.2e1_dp*s_a*s_anorm_drhoa s_avg_2norm_drhoa = s_a_2norm_drhoa/0.2e1_dp t512 = t339*s_avg_2norm_drhoa - u_c_abnorm_drhoa = gamma_c_ab*s_avg_2norm_drhoa*t162-t337*t512 + u_c_abnorm_drhoa = gamma_c_ab*s_avg_2norm_drhoa*t162 - t337*t512 t516 = t347*s_a_2norm_drhoa - u_c_anorm_drhoa = gamma_c_ss*s_a_2norm_drhoa*t165-t345*t516 - gc_abnorm_drhoa = u_c_abnorm_drhoa*t170+u_c_ab* & + u_c_anorm_drhoa = gamma_c_ss*s_a_2norm_drhoa*t165 - t345*t516 + gc_abnorm_drhoa = u_c_abnorm_drhoa*t170 + u_c_ab* & u_c_abnorm_drhoa*c_cab_2 - gc_anorm_drhoa = u_c_anorm_drhoa*t173+u_c_a*u_c_anorm_drhoa & + gc_anorm_drhoa = u_c_anorm_drhoa*t173 + u_c_a*u_c_anorm_drhoa & *c_css_2 IF (grad_deriv > 0 .OR. grad_deriv == -1) THEN - exc_norm_drhoa = scale_x*e_lsda_x_a*gx_anorm_drhoa+scale_c* & - (e_lsda_c_ab*gc_abnorm_drhoa+e_lsda_c_a*gc_anorm_drhoa) - e_ndr(ii) = e_ndr(ii)+0.5_dp*exc_norm_drhoa + exc_norm_drhoa = scale_x*e_lsda_x_a*gx_anorm_drhoa + scale_c* & + (e_lsda_c_ab*gc_abnorm_drhoa + e_lsda_c_a*gc_anorm_drhoa) + e_ndr(ii) = e_ndr(ii) + 0.5_dp*exc_norm_drhoa END IF s_bnorm_drhob = t25 - u_x_bnorm_drhob = 0.2e1_dp*t370*t29*s_bnorm_drhob-0.2e1_dp & + u_x_bnorm_drhob = 0.2e1_dp*t370*t29*s_bnorm_drhob - 0.2e1_dp & *t374*t376*s_bnorm_drhob - gx_bnorm_drhob = u_x_bnorm_drhob*t31+u_x_b*u_x_bnorm_drhob*c_x_2 + gx_bnorm_drhob = u_x_bnorm_drhob*t31 + u_x_b*u_x_bnorm_drhob*c_x_2 s_b_2norm_drhob = 0.2e1_dp*s_b*s_bnorm_drhob s_avg_2norm_drhob = s_b_2norm_drhob/0.2e1_dp t539 = t339*s_avg_2norm_drhob - u_c_abnorm_drhob = gamma_c_ab*s_avg_2norm_drhob*t162-t337*t539 + u_c_abnorm_drhob = gamma_c_ab*s_avg_2norm_drhob*t162 - t337*t539 t543 = t486*s_b_2norm_drhob - u_c_bnorm_drhob = gamma_c_ss*s_b_2norm_drhob*t168-t484*t543 - gc_abnorm_drhob = u_c_abnorm_drhob*t170+u_c_ab* & + u_c_bnorm_drhob = gamma_c_ss*s_b_2norm_drhob*t168 - t484*t543 + gc_abnorm_drhob = u_c_abnorm_drhob*t170 + u_c_ab* & u_c_abnorm_drhob*c_cab_2 - gc_bnorm_drhob = u_c_bnorm_drhob*t176+u_c_b*u_c_bnorm_drhob & + gc_bnorm_drhob = u_c_bnorm_drhob*t176 + u_c_b*u_c_bnorm_drhob & *c_css_2 IF (grad_deriv > 0 .OR. grad_deriv == -1) THEN - exc_norm_drhob = scale_x*e_lsda_x_b*gx_bnorm_drhob+scale_c* & - (e_lsda_c_ab*gc_abnorm_drhob+e_lsda_c_b*gc_bnorm_drhob) - e_ndr(ii) = e_ndr(ii)+0.5_dp*exc_norm_drhob + exc_norm_drhob = scale_x*e_lsda_x_b*gx_bnorm_drhob + scale_c* & + (e_lsda_c_ab*gc_abnorm_drhob + e_lsda_c_b*gc_bnorm_drhob) + e_ndr(ii) = e_ndr(ii) + 0.5_dp*exc_norm_drhob END IF IF (grad_deriv > 1 .OR. grad_deriv < -1) THEN @@ -2082,17 +2082,17 @@ SUBROUTINE b97_lda_calc(rho_tot, norm_drho, & t576 = s_a_2**2 t577 = t575*t576 t579 = 0.1e1_dp/t197/t15 - u_x_arhoarhoa = 0.2e1_dp*gamma_x*t564*t16-0.10e2_dp*t568 & - *t198*t564+0.2e1_dp*t191*t16*s_arhoarhoa+0.8e1_dp* & - t577*t579*t564-0.2e1_dp*t196*t198*s_arhoarhoa + u_x_arhoarhoa = 0.2e1_dp*gamma_x*t564*t16 - 0.10e2_dp*t568 & + *t198*t564 + 0.2e1_dp*t191*t16*s_arhoarhoa + 0.8e1_dp* & + t577*t579*t564 - 0.2e1_dp*t196*t198*s_arhoarhoa u_x_a1rhoa = u_x_arhoa t600 = 0.1e1_dp/t207/rho t601 = t33*t600 - chirhoarhoa = -0.2e1_dp*t208+0.2e1_dp*t601 + chirhoarhoa = -0.2e1_dp*t208 + 0.2e1_dp*t601 t605 = 0.3141592654e1_dp**2 t606 = 0.1e1_dp/t605 t608 = t207**2 - rsrhoarhoa = -t4/t210/t36*t606/t608/0.18e2_dp+ & + rsrhoarhoa = -t4/t210/t36*t606/t608/0.18e2_dp + & t4*t212*t600/0.6e1_dp t619 = alpha_1_1*rsrhoa t621 = t221*t235*t236 @@ -2109,12 +2109,12 @@ SUBROUTINE b97_lda_calc(rho_tot, norm_drho, & t661 = t40/t659 t662 = t55**2 t663 = 0.1e1_dp/t662 - e_c_u_0rhoarhoa = -0.2e1_dp*t216*rsrhoarhoa*t56+0.2e1_dp* & - t619*t621-0.2e1_dp*t626*t627*t236+t222*(-t632*t633 & - /0.4e1_dp+t224*rsrhoarhoa/0.2e1_dp+beta_2_1*rsrhoarhoa+ & - 0.3e1_dp/0.4e1_dp*t639*t633+0.3e1_dp/0.2e1_dp*t228* & - rsrhoarhoa+t50*t644*t633*t647+t50*t48*rsrhoarhoa* & - t232-t50*t48*t633*t647)*t236+t661*t627*t663*t42/ & + e_c_u_0rhoarhoa = -0.2e1_dp*t216*rsrhoarhoa*t56 + 0.2e1_dp* & + t619*t621 - 0.2e1_dp*t626*t627*t236 + t222*(-t632*t633 & + /0.4e1_dp + t224*rsrhoarhoa/0.2e1_dp + beta_2_1*rsrhoarhoa + & + 0.3e1_dp/0.4e1_dp*t639*t633 + 0.3e1_dp/0.2e1_dp*t228* & + rsrhoarhoa + t50*t644*t633*t647 + t50*t48*rsrhoarhoa* & + t232 - t50*t48*t633*t647)*t236 + t661*t627*t663*t42/ & 0.2e1_dp e_c_u_01rhoa = e_c_u_0rhoa t671 = alpha_1_2*rsrhoa @@ -2145,31 +2145,31 @@ SUBROUTINE b97_lda_calc(rho_tot, norm_drho, & t766 = chirhoa**2 t771 = t102**2 t772 = 0.1e1_dp/t771 - frhoarhoa = (0.4e1_dp/0.9e1_dp*t765*t766+0.4e1_dp/ & - 0.3e1_dp*t99*chirhoarhoa+0.4e1_dp/0.9e1_dp*t772*t766- & + frhoarhoa = (0.4e1_dp/0.9e1_dp*t765*t766 + 0.4e1_dp/ & + 0.3e1_dp*t99*chirhoarhoa + 0.4e1_dp/0.9e1_dp*t772*t766 - & 0.4e1_dp/0.3e1_dp*t102*chirhoarhoa)*t97 f1rhoa = frhoa t790 = alpha_c1rhoa*f t793 = alpha_c*f1rhoa t796 = t106*t107 - t811 = e_c_u_1rhoa-e_c_u_01rhoa + t811 = e_c_u_1rhoa - e_c_u_01rhoa t818 = t811*f t821 = t112*f1rhoa - t830 = -0.4e1_dp*t105*t290*chirhoarhoa+(-0.2e1_dp*t239* & - rsrhoarhoa*t74+0.2e1_dp*t671*t673-0.2e1_dp*t678*t679 & - *t257+t245*(-t683*t633/0.4e1_dp+t246*rsrhoarhoa/ & - 0.2e1_dp+beta_2_2*rsrhoarhoa+0.3e1_dp/0.4e1_dp*t689*t633 & - +0.3e1_dp/0.2e1_dp*t250*rsrhoarhoa+t68*t694*t633* & - t647+t68*t66*rsrhoarhoa*t232-t68*t66*t633*t647)* & - t257+t709*t679*t711*t62/0.2e1_dp-e_c_u_0rhoarhoa)*f* & - t108+t294*f1rhoa*t108+0.4e1_dp*t295*t299+t811*frhoa & - *t108+t112*frhoarhoa*t108+0.4e1_dp*t297*t299+0.4e1_dp & - *t818*t299+0.4e1_dp*t821*t299+0.12e2_dp*t113*t107* & - t766+0.4e1_dp*t113*t289*chirhoarhoa - epsilon_c_unif1rhoa = e_c_u_01rhoa+t790*t110+t793*t110- & - t293+t818*t108+t821*t108+t301 + t830 = -0.4e1_dp*t105*t290*chirhoarhoa + (-0.2e1_dp*t239* & + rsrhoarhoa*t74 + 0.2e1_dp*t671*t673 - 0.2e1_dp*t678*t679 & + *t257 + t245*(-t683*t633/0.4e1_dp + t246*rsrhoarhoa/ & + 0.2e1_dp + beta_2_2*rsrhoarhoa + 0.3e1_dp/0.4e1_dp*t689*t633 & + + 0.3e1_dp/0.2e1_dp*t250*rsrhoarhoa + t68*t694*t633* & + t647 + t68*t66*rsrhoarhoa*t232 - t68*t66*t633*t647)* & + t257 + t709*t679*t711*t62/0.2e1_dp - e_c_u_0rhoarhoa)*f* & + t108 + t294*f1rhoa*t108 + 0.4e1_dp*t295*t299 + t811*frhoa & + *t108 + t112*frhoarhoa*t108 + 0.4e1_dp*t297*t299 + 0.4e1_dp & + *t818*t299 + 0.4e1_dp*t821*t299 + 0.12e2_dp*t113*t107* & + t766 + 0.4e1_dp*t113*t289*chirhoarhoa + epsilon_c_unif1rhoa = e_c_u_01rhoa + t790*t110 + t793*t110 - & + t293 + t818*t108 + t821*t108 + t301 t838 = t186**2 - rs_arhoarhoa = -t4/t302/t116*t606/t838/0.18e2_dp+ & + rs_arhoarhoa = -t4/t302/t116*t606/t838/0.18e2_dp + & t4*t304/t560/0.6e1_dp t858 = t327**2 t864 = rs_arhoa**2 @@ -2178,65 +2178,65 @@ SUBROUTINE b97_lda_calc(rho_tot, norm_drho, & t889 = t312**2 t892 = t133**2 epsilon_c_unif_a1rhoa = epsilon_c_unif_arhoa - s_a_2rhoarhoa = 0.2e1_dp*t564+0.2e1_dp*s_a*s_arhoarhoa + s_a_2rhoarhoa = 0.2e1_dp*t564 + 0.2e1_dp*s_a*s_arhoarhoa s_a_21rhoa = s_a_2rhoa s_avg_2rhoarhoa = s_a_2rhoarhoa/0.2e1_dp s_avg_21rhoa = s_a_21rhoa/0.2e1_dp - e_lsda_c_arhoarhoa = (-0.2e1_dp*t239*rs_arhoarhoa*t134+ & - 0.2e1_dp*alpha_1_2*rs_arhoa*t313*t327*t328-0.2e1_dp* & - t120/t312/t129*t858*t328+t314*(-beta_1_2/t125*t864/ & - 0.4e1_dp+t316*rs_arhoarhoa/0.2e1_dp+beta_2_2*rs_arhoarhoa & - +0.3e1_dp/0.4e1_dp*beta_3_2*t315*t864+0.3e1_dp/ & - 0.2e1_dp*t320*rs_arhoarhoa+t128*t694*t864*t877+t128* & - t66*rs_arhoarhoa*t324-t128*t66*t864*t877)*t328+t120 & - /t889*t858/t892*t62/0.2e1_dp)*my_rhoa+epsilon_c_unif_arhoa & - +epsilon_c_unif_a1rhoa - e_lsda_c_a1rhoa = epsilon_c_unif_a1rhoa*my_rhoa+epsilon_c_unif_a + e_lsda_c_arhoarhoa = (-0.2e1_dp*t239*rs_arhoarhoa*t134 + & + 0.2e1_dp*alpha_1_2*rs_arhoa*t313*t327*t328 - 0.2e1_dp* & + t120/t312/t129*t858*t328 + t314*(-beta_1_2/t125*t864/ & + 0.4e1_dp + t316*rs_arhoarhoa/0.2e1_dp + beta_2_2*rs_arhoarhoa & + + 0.3e1_dp/0.4e1_dp*beta_3_2*t315*t864 + 0.3e1_dp/ & + 0.2e1_dp*t320*rs_arhoarhoa + t128*t694*t864*t877 + t128* & + t66*rs_arhoarhoa*t324 - t128*t66*t864*t877)*t328 + t120 & + /t889*t858/t892*t62/0.2e1_dp)*my_rhoa + epsilon_c_unif_arhoa & + + epsilon_c_unif_a1rhoa + e_lsda_c_a1rhoa = epsilon_c_unif_a1rhoa*my_rhoa + epsilon_c_unif_a t906 = t336*s_avg_2rhoa t907 = t339*s_avg_21rhoa t911 = t336*gamma_c_ab*s_avg_2 t913 = 0.1e1_dp/t338/t161 t914 = t913*s_avg_2rhoa - u_c_abrhoarhoa = gamma_c_ab*s_avg_2rhoarhoa*t162-0.2e1_dp* & - t906*t907+0.2e1_dp*t911*t914*s_avg_21rhoa-t337*t339* & + u_c_abrhoarhoa = gamma_c_ab*s_avg_2rhoarhoa*t162 - 0.2e1_dp* & + t906*t907 + 0.2e1_dp*t911*t914*s_avg_21rhoa - t337*t339* & s_avg_2rhoarhoa - u_c_ab1rhoa = gamma_c_ab*s_avg_21rhoa*t162-t337*t907 + u_c_ab1rhoa = gamma_c_ab*s_avg_21rhoa*t162 - t337*t907 t925 = t344*s_a_2rhoa t926 = t347*s_a_21rhoa t929 = t344*gamma_c_ss t930 = t929*s_a_2 t932 = 0.1e1_dp/t346/t164 t933 = t932*s_a_2rhoa - u_c_arhoarhoa = gamma_c_ss*s_a_2rhoarhoa*t165-0.2e1_dp* & - t925*t926+0.2e1_dp*t930*t933*s_a_21rhoa-t345*t347* & + u_c_arhoarhoa = gamma_c_ss*s_a_2rhoarhoa*t165 - 0.2e1_dp* & + t925*t926 + 0.2e1_dp*t930*t933*s_a_21rhoa - t345*t347* & s_a_2rhoarhoa - u_c_a1rhoa = gamma_c_ss*s_a_21rhoa*t165-t345*t926 + u_c_a1rhoa = gamma_c_ss*s_a_21rhoa*t165 - t345*t926 IF (grad_deriv > 1 .OR. grad_deriv == -2) THEN exc_rhoa_rhoa = scale_x*(-t4*t6/t555*gx_a/0.6e1_dp & - +e_lsda_x_arhoa*(u_x_a1rhoa*t18+u_x_a*u_x_a1rhoa*c_x_2) & - +e_lsda_x_arhoa*gx_arhoa+e_lsda_x_a*(u_x_arhoarhoa*t18+ & - 0.2e1_dp*u_x_arhoa*u_x_a1rhoa*c_x_2+u_x_a*u_x_arhoarhoa* & - c_x_2))+scale_c*(((e_c_u_0rhoarhoa+(0.2e1_dp*t260* & - rsrhoarhoa*t92-0.2e1_dp*t719*t721+0.2e1_dp*t726*t727* & - t278-t266*(-t731*t633/0.4e1_dp+t267*rsrhoarhoa/ & - 0.2e1_dp+beta_2_3*rsrhoarhoa+0.3e1_dp/0.4e1_dp*t737*t633 & - +0.3e1_dp/0.2e1_dp*t271*rsrhoarhoa+t86*t742*t633* & - t647+t86*t84*rsrhoarhoa*t232-t86*t84*t633*t647)* & - t278-t757*t727*t759*t80/0.2e1_dp)*f*t110+alpha_crhoa & - *f1rhoa*t110-0.4e1_dp*t285*t291+alpha_c1rhoa*frhoa* & - t110+alpha_c*frhoarhoa*t110-0.4e1_dp*t287*t291- & - 0.4e1_dp*t790*t291-0.4e1_dp*t793*t291-0.12e2_dp*t105* & - t796*t766+t830)*rho+epsilon_c_unifrhoa+ & - epsilon_c_unif1rhoa-e_lsda_c_arhoarhoa)*gc_ab+e_lsda_c_abrhoa & - *(u_c_ab1rhoa*t170+u_c_ab*u_c_ab1rhoa*c_cab_2)+( & - epsilon_c_unif1rhoa*rho+epsilon_c_unif-e_lsda_c_a1rhoa)* & - gc_abrhoa+e_lsda_c_ab*(u_c_abrhoarhoa*t170+0.2e1_dp* & - u_c_abrhoa*u_c_ab1rhoa*c_cab_2+u_c_ab*u_c_abrhoarhoa* & - c_cab_2)+e_lsda_c_arhoarhoa*gc_a+e_lsda_c_arhoa*(u_c_a1rhoa & - *t173+u_c_a*u_c_a1rhoa*c_css_2)+e_lsda_c_a1rhoa*gc_arhoa & - +e_lsda_c_a*(u_c_arhoarhoa*t173+0.2e1_dp*u_c_arhoa* & - u_c_a1rhoa*c_css_2+u_c_a*u_c_arhoarhoa*c_css_2)) - e_r_r(ii) = e_r_r(ii)+0.5_dp*0.5_dp*exc_rhoa_rhoa + + e_lsda_x_arhoa*(u_x_a1rhoa*t18 + u_x_a*u_x_a1rhoa*c_x_2) & + + e_lsda_x_arhoa*gx_arhoa + e_lsda_x_a*(u_x_arhoarhoa*t18 + & + 0.2e1_dp*u_x_arhoa*u_x_a1rhoa*c_x_2 + u_x_a*u_x_arhoarhoa* & + c_x_2)) + scale_c*(((e_c_u_0rhoarhoa + (0.2e1_dp*t260* & + rsrhoarhoa*t92 - 0.2e1_dp*t719*t721 + 0.2e1_dp*t726*t727* & + t278 - t266*(-t731*t633/0.4e1_dp + t267*rsrhoarhoa/ & + 0.2e1_dp + beta_2_3*rsrhoarhoa + 0.3e1_dp/0.4e1_dp*t737*t633 & + + 0.3e1_dp/0.2e1_dp*t271*rsrhoarhoa + t86*t742*t633* & + t647 + t86*t84*rsrhoarhoa*t232 - t86*t84*t633*t647)* & + t278 - t757*t727*t759*t80/0.2e1_dp)*f*t110 + alpha_crhoa & + *f1rhoa*t110 - 0.4e1_dp*t285*t291 + alpha_c1rhoa*frhoa* & + t110 + alpha_c*frhoarhoa*t110 - 0.4e1_dp*t287*t291 - & + 0.4e1_dp*t790*t291 - 0.4e1_dp*t793*t291 - 0.12e2_dp*t105* & + t796*t766 + t830)*rho + epsilon_c_unifrhoa + & + epsilon_c_unif1rhoa - e_lsda_c_arhoarhoa)*gc_ab + e_lsda_c_abrhoa & + *(u_c_ab1rhoa*t170 + u_c_ab*u_c_ab1rhoa*c_cab_2) + ( & + epsilon_c_unif1rhoa*rho + epsilon_c_unif - e_lsda_c_a1rhoa)* & + gc_abrhoa + e_lsda_c_ab*(u_c_abrhoarhoa*t170 + 0.2e1_dp* & + u_c_abrhoa*u_c_ab1rhoa*c_cab_2 + u_c_ab*u_c_abrhoarhoa* & + c_cab_2) + e_lsda_c_arhoarhoa*gc_a + e_lsda_c_arhoa*(u_c_a1rhoa & + *t173 + u_c_a*u_c_a1rhoa*c_css_2) + e_lsda_c_a1rhoa*gc_arhoa & + + e_lsda_c_a*(u_c_arhoarhoa*t173 + 0.2e1_dp*u_c_arhoa* & + u_c_a1rhoa*c_css_2 + u_c_a*u_c_arhoarhoa*c_css_2)) + e_r_r(ii) = e_r_r(ii) + 0.5_dp*0.5_dp*exc_rhoa_rhoa END IF chirhoarhob = 0.2e1_dp*t601 @@ -2245,52 +2245,52 @@ SUBROUTINE b97_lda_calc(rho_tot, norm_drho, & t976 = alpha_1_1*rsrhob t981 = rsrhoa*rsrhob t993 = rsrhob*t647*rsrhoa - e_c_u_0rhoarhob = -0.2e1_dp*t216*rsrhoarhob*t56+t619* & - t974+t976*t621-0.2e1_dp*t626*t237*t396+t222*(-t632* & - t981/0.4e1_dp+t224*rsrhoarhob/0.2e1_dp+beta_2_1* & - rsrhoarhob+0.3e1_dp/0.4e1_dp*t639*t981+0.3e1_dp/0.2e1_dp & - *t228*rsrhoarhob+t50*t644*t993+t50*t48*rsrhoarhob* & - t232-t50*t48*t993)*t236+t661*t235*t663*t42*t396/ & + e_c_u_0rhoarhob = -0.2e1_dp*t216*rsrhoarhob*t56 + t619* & + t974 + t976*t621 - 0.2e1_dp*t626*t237*t396 + t222*(-t632* & + t981/0.4e1_dp + t224*rsrhoarhob/0.2e1_dp + beta_2_1* & + rsrhoarhob + 0.3e1_dp/0.4e1_dp*t639*t981 + 0.3e1_dp/0.2e1_dp & + *t228*rsrhoarhob + t50*t644*t993 + t50*t48*rsrhoarhob* & + t232 - t50*t48*t993)*t236 + t661*t235*t663*t42*t396/ & 0.2e1_dp t1012 = t244*t410*t257 t1014 = alpha_1_2*rsrhob t1047 = t265*t424*t278 t1049 = alpha_1_3*rsrhob - frhoarhob = (0.4e1_dp/0.9e1_dp*t765*chirhoa*chirhob+ & - 0.4e1_dp/0.3e1_dp*t99*chirhoarhob+0.4e1_dp/0.9e1_dp*t772 & - *chirhoa*chirhob-0.4e1_dp/0.3e1_dp*t102*chirhoarhob)* & + frhoarhob = (0.4e1_dp/0.9e1_dp*t765*chirhoa*chirhob + & + 0.4e1_dp/0.3e1_dp*t99*chirhoarhob + 0.4e1_dp/0.9e1_dp*t772 & + *chirhoa*chirhob - 0.4e1_dp/0.3e1_dp*t102*chirhoarhob)* & t97 t1107 = t107*chirhoa*chirhob - t1136 = -0.4e1_dp*t105*t290*chirhoarhob+(-0.2e1_dp*t239 & - *rsrhoarhob*t74+t671*t1012+t1014*t673-0.2e1_dp*t678* & - t258*t410+t245*(-t683*t981/0.4e1_dp+t246*rsrhoarhob/ & - 0.2e1_dp+beta_2_2*rsrhoarhob+0.3e1_dp/0.4e1_dp*t689* & - t981+0.3e1_dp/0.2e1_dp*t250*rsrhoarhob+t68*t694*t993+ & - t68*t66*rsrhoarhob*t232-t68*t66*t993)*t257+t709* & - t256*t711*t62*t410/0.2e1_dp-e_c_u_0rhoarhob)*f*t108+ & - t294*frhob*t108+0.4e1_dp*t295*t443+t438*frhoa*t108+ & - t112*frhoarhob*t108+0.4e1_dp*t297*t443+0.4e1_dp*t439 & - *t299+0.4e1_dp*t441*t299+0.12e2_dp*t113*t1107+ & + t1136 = -0.4e1_dp*t105*t290*chirhoarhob + (-0.2e1_dp*t239 & + *rsrhoarhob*t74 + t671*t1012 + t1014*t673 - 0.2e1_dp*t678* & + t258*t410 + t245*(-t683*t981/0.4e1_dp + t246*rsrhoarhob/ & + 0.2e1_dp + beta_2_2*rsrhoarhob + 0.3e1_dp/0.4e1_dp*t689* & + t981 + 0.3e1_dp/0.2e1_dp*t250*rsrhoarhob + t68*t694*t993 + & + t68*t66*rsrhoarhob*t232 - t68*t66*t993)*t257 + t709* & + t256*t711*t62*t410/0.2e1_dp - e_c_u_0rhoarhob)*f*t108 + & + t294*frhob*t108 + 0.4e1_dp*t295*t443 + t438*frhoa*t108 + & + t112*frhoarhob*t108 + 0.4e1_dp*t297*t443 + 0.4e1_dp*t439 & + *t299 + 0.4e1_dp*t441*t299 + 0.12e2_dp*t113*t1107 + & 0.4e1_dp*t113*t289*chirhoarhob - u_c_abrhoarhob = -0.2e1_dp*t906*t480+0.2e1_dp*t911*t914 & + u_c_abrhoarhob = -0.2e1_dp*t906*t480 + 0.2e1_dp*t911*t914 & *s_avg_2rhob IF (grad_deriv > 1 .OR. grad_deriv == -2) THEN - exc_rhoa_rhob = scale_c*(((e_c_u_0rhoarhob+(0.2e1_dp*t260* & - rsrhoarhob*t92-t719*t1047-t1049*t721+0.2e1_dp*t726* & - t279*t424-t266*(-t731*t981/0.4e1_dp+t267*rsrhoarhob/ & - 0.2e1_dp+beta_2_3*rsrhoarhob+0.3e1_dp/0.4e1_dp*t737*t981 & - +0.3e1_dp/0.2e1_dp*t271*rsrhoarhob+t86*t742*t993+t86 & - *t84*rsrhoarhob*t232-t86*t84*t993)*t278-t757*t277 & - *t759*t80*t424/0.2e1_dp)*f*t110+alpha_crhoa*frhob* & - t110-0.4e1_dp*t285*t435+alpha_crhob*frhoa*t110+alpha_c & - *frhoarhob*t110-0.4e1_dp*t287*t435-0.4e1_dp*t431* & - t291-0.4e1_dp*t433*t291-0.12e2_dp*t105*t106*t1107+ & - t1136)*rho+epsilon_c_unifrhoa+epsilon_c_unifrhob)*gc_ab+ & - e_lsda_c_abrhoa*gc_abrhob+e_lsda_c_abrhob*gc_abrhoa+ & - e_lsda_c_ab*(u_c_abrhoarhob*t170+0.2e1_dp*u_c_abrhoa* & - u_c_abrhob*c_cab_2+u_c_ab*u_c_abrhoarhob*c_cab_2)) - e_r_r(ii) = e_r_r(ii)+0.5_dp*exc_rhoa_rhob + exc_rhoa_rhob = scale_c*(((e_c_u_0rhoarhob + (0.2e1_dp*t260* & + rsrhoarhob*t92 - t719*t1047 - t1049*t721 + 0.2e1_dp*t726* & + t279*t424 - t266*(-t731*t981/0.4e1_dp + t267*rsrhoarhob/ & + 0.2e1_dp + beta_2_3*rsrhoarhob + 0.3e1_dp/0.4e1_dp*t737*t981 & + + 0.3e1_dp/0.2e1_dp*t271*rsrhoarhob + t86*t742*t993 + t86 & + *t84*rsrhoarhob*t232 - t86*t84*t993)*t278 - t757*t277 & + *t759*t80*t424/0.2e1_dp)*f*t110 + alpha_crhoa*frhob* & + t110 - 0.4e1_dp*t285*t435 + alpha_crhob*frhoa*t110 + alpha_c & + *frhoarhob*t110 - 0.4e1_dp*t287*t435 - 0.4e1_dp*t431* & + t291 - 0.4e1_dp*t433*t291 - 0.12e2_dp*t105*t106*t1107 + & + t1136)*rho + epsilon_c_unifrhoa + epsilon_c_unifrhob)*gc_ab + & + e_lsda_c_abrhoa*gc_abrhob + e_lsda_c_abrhob*gc_abrhoa + & + e_lsda_c_ab*(u_c_abrhoarhob*t170 + 0.2e1_dp*u_c_abrhoa* & + u_c_abrhob*c_cab_2 + u_c_ab*u_c_abrhoarhob*c_cab_2)) + e_r_r(ii) = e_r_r(ii) + 0.5_dp*exc_rhoa_rhob END IF t1152 = t20**2 @@ -2301,52 +2301,52 @@ SUBROUTINE b97_lda_calc(rho_tot, norm_drho, & t1172 = s_b_2**2 t1173 = t575*t1172 t1175 = 0.1e1_dp/t375/t28 - u_x_brhobrhob = 0.2e1_dp*gamma_x*t1161*t29-0.10e2_dp* & - t1165*t376*t1161+0.2e1_dp*t370*t29*s_brhobrhob+ & - 0.8e1_dp*t1173*t1175*t1161-0.2e1_dp*t374*t376* & + u_x_brhobrhob = 0.2e1_dp*gamma_x*t1161*t29 - 0.10e2_dp* & + t1165*t376*t1161 + 0.2e1_dp*t370*t29*s_brhobrhob + & + 0.8e1_dp*t1173*t1175*t1161 - 0.2e1_dp*t374*t376* & s_brhobrhob u_x_b1rhob = u_x_brhob - chirhobrhob = 0.2e1_dp*t208+0.2e1_dp*t601 + chirhobrhob = 0.2e1_dp*t208 + 0.2e1_dp*t601 rsrhobrhob = rsrhoarhob t1201 = t396**2 t1205 = rsrhob**2 - e_c_u_0rhobrhob = -0.2e1_dp*t216*rsrhobrhob*t56+0.2e1_dp* & - t976*t974-0.2e1_dp*t626*t1201*t236+t222*(-t632* & - t1205/0.4e1_dp+t224*rsrhobrhob/0.2e1_dp+beta_2_1* & - rsrhobrhob+0.3e1_dp/0.4e1_dp*t639*t1205+0.3e1_dp/ & - 0.2e1_dp*t228*rsrhobrhob+t50*t644*t1205*t647+t50*t48 & - *rsrhobrhob*t232-t50*t48*t1205*t647)*t236+t661* & + e_c_u_0rhobrhob = -0.2e1_dp*t216*rsrhobrhob*t56 + 0.2e1_dp* & + t976*t974 - 0.2e1_dp*t626*t1201*t236 + t222*(-t632* & + t1205/0.4e1_dp + t224*rsrhobrhob/0.2e1_dp + beta_2_1* & + rsrhobrhob + 0.3e1_dp/0.4e1_dp*t639*t1205 + 0.3e1_dp/ & + 0.2e1_dp*t228*rsrhobrhob + t50*t644*t1205*t647 + t50*t48 & + *rsrhobrhob*t232 - t50*t48*t1205*t647)*t236 + t661* & t1201*t663*t42/0.2e1_dp e_c_u_01rhob = e_c_u_0rhob t1236 = t410**2 t1270 = t424**2 alpha_c1rhob = alpha_crhob t1299 = chirhob**2 - frhobrhob = (0.4e1_dp/0.9e1_dp*t765*t1299+0.4e1_dp/ & - 0.3e1_dp*t99*chirhobrhob+0.4e1_dp/0.9e1_dp*t772*t1299- & + frhobrhob = (0.4e1_dp/0.9e1_dp*t765*t1299 + 0.4e1_dp/ & + 0.3e1_dp*t99*chirhobrhob + 0.4e1_dp/0.9e1_dp*t772*t1299 - & 0.4e1_dp/0.3e1_dp*t102*chirhobrhob)*t97 f1rhob = frhob t1321 = alpha_c1rhob*f t1324 = alpha_c*f1rhob - t1341 = e_c_u_1rhob-e_c_u_01rhob + t1341 = e_c_u_1rhob - e_c_u_01rhob t1348 = t1341*f t1351 = t112*f1rhob - t1360 = -0.4e1_dp*t105*t290*chirhobrhob+(-0.2e1_dp*t239 & - *rsrhobrhob*t74+0.2e1_dp*t1014*t1012-0.2e1_dp*t678* & - t1236*t257+t245*(-t683*t1205/0.4e1_dp+t246*rsrhobrhob & - /0.2e1_dp+beta_2_2*rsrhobrhob+0.3e1_dp/0.4e1_dp*t689* & - t1205+0.3e1_dp/0.2e1_dp*t250*rsrhobrhob+t68*t694*t1205 & - *t647+t68*t66*rsrhobrhob*t232-t68*t66*t1205*t647) & - *t257+t709*t1236*t711*t62/0.2e1_dp-e_c_u_0rhobrhob)*f & - *t108+t438*f1rhob*t108+0.4e1_dp*t439*t443+t1341* & - frhob*t108+t112*frhobrhob*t108+0.4e1_dp*t441*t443+ & - 0.4e1_dp*t1348*t443+0.4e1_dp*t1351*t443+0.12e2_dp*t113 & - *t107*t1299+0.4e1_dp*t113*t289*chirhobrhob - epsilon_c_unif1rhob = e_c_u_01rhob+t1321*t110+t1324*t110- & - t437+t1348*t108+t1351*t108+t445 + t1360 = -0.4e1_dp*t105*t290*chirhobrhob + (-0.2e1_dp*t239 & + *rsrhobrhob*t74 + 0.2e1_dp*t1014*t1012 - 0.2e1_dp*t678* & + t1236*t257 + t245*(-t683*t1205/0.4e1_dp + t246*rsrhobrhob & + /0.2e1_dp + beta_2_2*rsrhobrhob + 0.3e1_dp/0.4e1_dp*t689* & + t1205 + 0.3e1_dp/0.2e1_dp*t250*rsrhobrhob + t68*t694*t1205 & + *t647 + t68*t66*rsrhobrhob*t232 - t68*t66*t1205*t647) & + *t257 + t709*t1236*t711*t62/0.2e1_dp - e_c_u_0rhobrhob)*f & + *t108 + t438*f1rhob*t108 + 0.4e1_dp*t439*t443 + t1341* & + frhob*t108 + t112*frhobrhob*t108 + 0.4e1_dp*t441*t443 + & + 0.4e1_dp*t1348*t443 + 0.4e1_dp*t1351*t443 + 0.12e2_dp*t113 & + *t107*t1299 + 0.4e1_dp*t113*t289*chirhobrhob + epsilon_c_unif1rhob = e_c_u_01rhob + t1321*t110 + t1324*t110 - & + t437 + t1348*t108 + t1351*t108 + t445 t1368 = t365**2 rs_brhobrhob = -t4/t446/t138*t606/t1368/0.18e2_dp & - +t4*t448/t1157/0.6e1_dp + + t4*t448/t1157/0.6e1_dp t1388 = t471**2 t1394 = rs_brhob**2 t1406 = rs_b**2 @@ -2354,108 +2354,108 @@ SUBROUTINE b97_lda_calc(rho_tot, norm_drho, & t1419 = t456**2 t1422 = t155**2 epsilon_c_unif_b1rhob = epsilon_c_unif_brhob - s_b_2rhobrhob = 0.2e1_dp*t1161+0.2e1_dp*s_b*s_brhobrhob + s_b_2rhobrhob = 0.2e1_dp*t1161 + 0.2e1_dp*s_b*s_brhobrhob s_b_21rhob = s_b_2rhob s_avg_2rhobrhob = s_b_2rhobrhob/0.2e1_dp s_avg_21rhob = s_b_21rhob/0.2e1_dp - e_lsda_c_brhobrhob = (-0.2e1_dp*t239*rs_brhobrhob*t156+ & - 0.2e1_dp*alpha_1_2*rs_brhob*t457*t471*t472-0.2e1_dp* & - t142/t456/t151*t1388*t472+t458*(-beta_1_2/t147*t1394 & - /0.4e1_dp+t460*rs_brhobrhob/0.2e1_dp+beta_2_2* & - rs_brhobrhob+0.3e1_dp/0.4e1_dp*beta_3_2*t459*t1394+ & - 0.3e1_dp/0.2e1_dp*t464*rs_brhobrhob+t150*t694*t1394* & - t1407+t150*t66*rs_brhobrhob*t468-t150*t66*t1394* & - t1407)*t472+t142/t1419*t1388/t1422*t62/0.2e1_dp)* & - my_rhob+epsilon_c_unif_brhob+epsilon_c_unif_b1rhob - e_lsda_c_b1rhob = epsilon_c_unif_b1rhob*my_rhob+epsilon_c_unif_b + e_lsda_c_brhobrhob = (-0.2e1_dp*t239*rs_brhobrhob*t156 + & + 0.2e1_dp*alpha_1_2*rs_brhob*t457*t471*t472 - 0.2e1_dp* & + t142/t456/t151*t1388*t472 + t458*(-beta_1_2/t147*t1394 & + /0.4e1_dp + t460*rs_brhobrhob/0.2e1_dp + beta_2_2* & + rs_brhobrhob + 0.3e1_dp/0.4e1_dp*beta_3_2*t459*t1394 + & + 0.3e1_dp/0.2e1_dp*t464*rs_brhobrhob + t150*t694*t1394* & + t1407 + t150*t66*rs_brhobrhob*t468 - t150*t66*t1394* & + t1407)*t472 + t142/t1419*t1388/t1422*t62/0.2e1_dp)* & + my_rhob + epsilon_c_unif_brhob + epsilon_c_unif_b1rhob + e_lsda_c_b1rhob = epsilon_c_unif_b1rhob*my_rhob + epsilon_c_unif_b t1436 = t336*s_avg_2rhob t1437 = t339*s_avg_21rhob t1440 = t913*s_avg_2rhob - u_c_abrhobrhob = gamma_c_ab*s_avg_2rhobrhob*t162-0.2e1_dp* & - t1436*t1437+0.2e1_dp*t911*t1440*s_avg_21rhob-t337*t339 & + u_c_abrhobrhob = gamma_c_ab*s_avg_2rhobrhob*t162 - 0.2e1_dp* & + t1436*t1437 + 0.2e1_dp*t911*t1440*s_avg_21rhob - t337*t339 & *s_avg_2rhobrhob - u_c_ab1rhob = gamma_c_ab*s_avg_21rhob*t162-t337*t1437 + u_c_ab1rhob = gamma_c_ab*s_avg_21rhob*t162 - t337*t1437 t1451 = t344*s_b_2rhob t1452 = t486*s_b_21rhob t1455 = t929*s_b_2 t1457 = 0.1e1_dp/t485/t167 t1458 = t1457*s_b_2rhob - u_c_brhobrhob = gamma_c_ss*s_b_2rhobrhob*t168-0.2e1_dp* & - t1451*t1452+0.2e1_dp*t1455*t1458*s_b_21rhob-t484*t486 & + u_c_brhobrhob = gamma_c_ss*s_b_2rhobrhob*t168 - 0.2e1_dp* & + t1451*t1452 + 0.2e1_dp*t1455*t1458*s_b_21rhob - t484*t486 & *s_b_2rhobrhob - u_c_b1rhob = gamma_c_ss*s_b_21rhob*t168-t484*t1452 + u_c_b1rhob = gamma_c_ss*s_b_21rhob*t168 - t484*t1452 IF (grad_deriv > 1 .OR. grad_deriv == -2) THEN exc_rhob_rhob = scale_x*(-t4*t6/t1152*gx_b/ & - 0.6e1_dp+e_lsda_x_brhob*(u_x_b1rhob*t31+u_x_b*u_x_b1rhob* & - c_x_2)+e_lsda_x_brhob*gx_brhob+e_lsda_x_b*(u_x_brhobrhob* & - t31+0.2e1_dp*u_x_brhob*u_x_b1rhob*c_x_2+u_x_b* & - u_x_brhobrhob*c_x_2))+scale_c*(((e_c_u_0rhobrhob+(0.2e1_dp* & - t260*rsrhobrhob*t92-0.2e1_dp*t1049*t1047+0.2e1_dp* & - t726*t1270*t278-t266*(-t731*t1205/0.4e1_dp+t267* & - rsrhobrhob/0.2e1_dp+beta_2_3*rsrhobrhob+0.3e1_dp/0.4e1_dp & - *t737*t1205+0.3e1_dp/0.2e1_dp*t271*rsrhobrhob+t86* & - t742*t1205*t647+t86*t84*rsrhobrhob*t232-t86*t84* & - t1205*t647)*t278-t757*t1270*t759*t80/0.2e1_dp)*f* & - t110+alpha_crhob*f1rhob*t110-0.4e1_dp*t431*t435+ & - alpha_c1rhob*frhob*t110+alpha_c*frhobrhob*t110-0.4e1_dp & - *t433*t435-0.4e1_dp*t1321*t435-0.4e1_dp*t1324*t435- & - 0.12e2_dp*t105*t796*t1299+t1360)*rho+epsilon_c_unifrhob & - +epsilon_c_unif1rhob-e_lsda_c_brhobrhob)*gc_ab+ & - e_lsda_c_abrhob*(u_c_ab1rhob*t170+u_c_ab*u_c_ab1rhob* & - c_cab_2)+(epsilon_c_unif1rhob*rho+epsilon_c_unif- & - e_lsda_c_b1rhob)*gc_abrhob+e_lsda_c_ab*(u_c_abrhobrhob*t170 & - +0.2e1_dp*u_c_abrhob*u_c_ab1rhob*c_cab_2+u_c_ab* & - u_c_abrhobrhob*c_cab_2)+e_lsda_c_brhobrhob*gc_b+ & - e_lsda_c_brhob*(u_c_b1rhob*t176+u_c_b*u_c_b1rhob*c_css_2) & - +e_lsda_c_b1rhob*gc_brhob+e_lsda_c_b*(u_c_brhobrhob*t176+ & - 0.2e1_dp*u_c_brhob*u_c_b1rhob*c_css_2+u_c_b*u_c_brhobrhob & + 0.6e1_dp + e_lsda_x_brhob*(u_x_b1rhob*t31 + u_x_b*u_x_b1rhob* & + c_x_2) + e_lsda_x_brhob*gx_brhob + e_lsda_x_b*(u_x_brhobrhob* & + t31 + 0.2e1_dp*u_x_brhob*u_x_b1rhob*c_x_2 + u_x_b* & + u_x_brhobrhob*c_x_2)) + scale_c*(((e_c_u_0rhobrhob + (0.2e1_dp* & + t260*rsrhobrhob*t92 - 0.2e1_dp*t1049*t1047 + 0.2e1_dp* & + t726*t1270*t278 - t266*(-t731*t1205/0.4e1_dp + t267* & + rsrhobrhob/0.2e1_dp + beta_2_3*rsrhobrhob + 0.3e1_dp/0.4e1_dp & + *t737*t1205 + 0.3e1_dp/0.2e1_dp*t271*rsrhobrhob + t86* & + t742*t1205*t647 + t86*t84*rsrhobrhob*t232 - t86*t84* & + t1205*t647)*t278 - t757*t1270*t759*t80/0.2e1_dp)*f* & + t110 + alpha_crhob*f1rhob*t110 - 0.4e1_dp*t431*t435 + & + alpha_c1rhob*frhob*t110 + alpha_c*frhobrhob*t110 - 0.4e1_dp & + *t433*t435 - 0.4e1_dp*t1321*t435 - 0.4e1_dp*t1324*t435 - & + 0.12e2_dp*t105*t796*t1299 + t1360)*rho + epsilon_c_unifrhob & + + epsilon_c_unif1rhob - e_lsda_c_brhobrhob)*gc_ab + & + e_lsda_c_abrhob*(u_c_ab1rhob*t170 + u_c_ab*u_c_ab1rhob* & + c_cab_2) + (epsilon_c_unif1rhob*rho + epsilon_c_unif - & + e_lsda_c_b1rhob)*gc_abrhob + e_lsda_c_ab*(u_c_abrhobrhob*t170 & + + 0.2e1_dp*u_c_abrhob*u_c_ab1rhob*c_cab_2 + u_c_ab* & + u_c_abrhobrhob*c_cab_2) + e_lsda_c_brhobrhob*gc_b + & + e_lsda_c_brhob*(u_c_b1rhob*t176 + u_c_b*u_c_b1rhob*c_css_2) & + + e_lsda_c_b1rhob*gc_brhob + e_lsda_c_b*(u_c_brhobrhob*t176 + & + 0.2e1_dp*u_c_brhob*u_c_b1rhob*c_css_2 + u_c_b*u_c_brhobrhob & *c_css_2)) - e_r_r(ii) = e_r_r(ii)+0.5_dp*0.5_dp*exc_rhob_rhob + e_r_r(ii) = e_r_r(ii) + 0.5_dp*0.5_dp*exc_rhob_rhob END IF s_arhoanorm_drhoa = -0.4e1_dp/0.3e1_dp*t188 - u_x_arhoanorm_drhoa = 0.2e1_dp*gamma_x*s_anorm_drhoa*t192- & - 0.10e2_dp*t568*t199*s_anorm_drhoa+0.2e1_dp*t191*t16* & - s_arhoanorm_drhoa+0.8e1_dp*t577*t579*s_arhoa*s_anorm_drhoa & - -0.2e1_dp*t196*t198*s_arhoanorm_drhoa - s_a_2rhoanorm_drhoa = 0.2e1_dp*s_anorm_drhoa*s_arhoa+ & + u_x_arhoanorm_drhoa = 0.2e1_dp*gamma_x*s_anorm_drhoa*t192 - & + 0.10e2_dp*t568*t199*s_anorm_drhoa + 0.2e1_dp*t191*t16* & + s_arhoanorm_drhoa + 0.8e1_dp*t577*t579*s_arhoa*s_anorm_drhoa & + - 0.2e1_dp*t196*t198*s_arhoanorm_drhoa + s_a_2rhoanorm_drhoa = 0.2e1_dp*s_anorm_drhoa*s_arhoa + & 0.2e1_dp*s_a*s_arhoanorm_drhoa s_avg_2rhoanorm_drhoa = s_a_2rhoanorm_drhoa/0.2e1_dp - u_c_abrhoanorm_drhoa = gamma_c_ab*s_avg_2rhoanorm_drhoa*t162- & - 0.2e1_dp*t906*t512+0.2e1_dp*t911*t914*s_avg_2norm_drhoa & - -t337*t339*s_avg_2rhoanorm_drhoa - u_c_arhoanorm_drhoa = gamma_c_ss*s_a_2rhoanorm_drhoa*t165- & - 0.2e1_dp*t925*t516+0.2e1_dp*t930*t933*s_a_2norm_drhoa- & + u_c_abrhoanorm_drhoa = gamma_c_ab*s_avg_2rhoanorm_drhoa*t162 - & + 0.2e1_dp*t906*t512 + 0.2e1_dp*t911*t914*s_avg_2norm_drhoa & + - t337*t339*s_avg_2rhoanorm_drhoa + u_c_arhoanorm_drhoa = gamma_c_ss*s_a_2rhoanorm_drhoa*t165 - & + 0.2e1_dp*t925*t516 + 0.2e1_dp*t930*t933*s_a_2norm_drhoa - & t345*t347*s_a_2rhoanorm_drhoa IF (grad_deriv > 1 .OR. grad_deriv == -2) THEN - exc_rhoa_norm_drhoa = scale_x*(e_lsda_x_arhoa*gx_anorm_drhoa+ & - e_lsda_x_a*(u_x_arhoanorm_drhoa*t18+0.2e1_dp*u_x_arhoa* & - u_x_anorm_drhoa*c_x_2+u_x_a*u_x_arhoanorm_drhoa*c_x_2))+ & - scale_c*(e_lsda_c_abrhoa*gc_abnorm_drhoa+e_lsda_c_ab*( & - u_c_abrhoanorm_drhoa*t170+0.2e1_dp*u_c_abrhoa* & - u_c_abnorm_drhoa*c_cab_2+u_c_ab*u_c_abrhoanorm_drhoa*c_cab_2 & - )+e_lsda_c_arhoa*gc_anorm_drhoa+e_lsda_c_a*( & - u_c_arhoanorm_drhoa*t173+0.2e1_dp*u_c_arhoa*u_c_anorm_drhoa & - *c_css_2+u_c_a*u_c_arhoanorm_drhoa*c_css_2)) - e_r_ndr(ii) = e_r_ndr(ii)+0.5_dp*0.5_dp*exc_rhoa_norm_drhoa + exc_rhoa_norm_drhoa = scale_x*(e_lsda_x_arhoa*gx_anorm_drhoa + & + e_lsda_x_a*(u_x_arhoanorm_drhoa*t18 + 0.2e1_dp*u_x_arhoa* & + u_x_anorm_drhoa*c_x_2 + u_x_a*u_x_arhoanorm_drhoa*c_x_2)) + & + scale_c*(e_lsda_c_abrhoa*gc_abnorm_drhoa + e_lsda_c_ab*( & + u_c_abrhoanorm_drhoa*t170 + 0.2e1_dp*u_c_abrhoa* & + u_c_abnorm_drhoa*c_cab_2 + u_c_ab*u_c_abrhoanorm_drhoa*c_cab_2 & + ) + e_lsda_c_arhoa*gc_anorm_drhoa + e_lsda_c_a*( & + u_c_arhoanorm_drhoa*t173 + 0.2e1_dp*u_c_arhoa*u_c_anorm_drhoa & + *c_css_2 + u_c_a*u_c_arhoanorm_drhoa*c_css_2)) + e_r_ndr(ii) = e_r_ndr(ii) + 0.5_dp*0.5_dp*exc_rhoa_norm_drhoa END IF - u_c_abrhobnorm_drhoa = -0.2e1_dp*t1436*t512+0.2e1_dp*t911 & + u_c_abrhobnorm_drhoa = -0.2e1_dp*t1436*t512 + 0.2e1_dp*t911 & *t1440*s_avg_2norm_drhoa IF (grad_deriv > 1 .OR. grad_deriv == -2) THEN exc_rhob_norm_drhoa = scale_c*(e_lsda_c_abrhob*gc_abnorm_drhoa & - +e_lsda_c_ab*(u_c_abrhobnorm_drhoa*t170+0.2e1_dp* & - u_c_abrhob*u_c_abnorm_drhoa*c_cab_2+u_c_ab* & - u_c_abrhobnorm_drhoa*c_cab_2)) - e_r_ndr(ii) = e_r_ndr(ii)+0.5_dp*0.5_dp*exc_rhob_norm_drhoa + + e_lsda_c_ab*(u_c_abrhobnorm_drhoa*t170 + 0.2e1_dp* & + u_c_abrhob*u_c_abnorm_drhoa*c_cab_2 + u_c_ab* & + u_c_abrhobnorm_drhoa*c_cab_2)) + e_r_ndr(ii) = e_r_ndr(ii) + 0.5_dp*0.5_dp*exc_rhob_norm_drhoa END IF t1571 = s_anorm_drhoa**2 - u_x_anorm_drhoanorm_drhoa = 0.2e1_dp*gamma_x*t1571*t16- & - 0.10e2_dp*t568*t198*t1571+0.8e1_dp*t577*t579*t1571 + u_x_anorm_drhoanorm_drhoa = 0.2e1_dp*gamma_x*t1571*t16 - & + 0.10e2_dp*t568*t198*t1571 + 0.8e1_dp*t577*t579*t1571 s_a_2norm_drhoanorm_drhoa = 0.2e1_dp*t1571 s_a_21norm_drhoa = s_a_2norm_drhoa s_avg_2norm_drhoanorm_drhoa = s_a_2norm_drhoanorm_drhoa/0.2e1_dp @@ -2464,108 +2464,108 @@ SUBROUTINE b97_lda_calc(rho_tot, norm_drho, & t1590 = t339*s_avg_21norm_drhoa t1593 = t913*s_avg_2norm_drhoa u_c_abnorm_drhoanorm_drhoa = gamma_c_ab* & - s_avg_2norm_drhoanorm_drhoa*t162-0.2e1_dp*t1589*t1590+ & - 0.2e1_dp*t911*t1593*s_avg_21norm_drhoa-t337*t339* & + s_avg_2norm_drhoanorm_drhoa*t162 - 0.2e1_dp*t1589*t1590 + & + 0.2e1_dp*t911*t1593*s_avg_21norm_drhoa - t337*t339* & s_avg_2norm_drhoanorm_drhoa t1605 = t347*s_a_21norm_drhoa u_c_anorm_drhoanorm_drhoa = gamma_c_ss*s_a_2norm_drhoanorm_drhoa & - *t165-0.2e1_dp*t344*s_a_2norm_drhoa*t1605+0.2e1_dp* & - t930*t932*s_a_2norm_drhoa*s_a_21norm_drhoa-t345*t347* & + *t165 - 0.2e1_dp*t344*s_a_2norm_drhoa*t1605 + 0.2e1_dp* & + t930*t932*s_a_2norm_drhoa*s_a_21norm_drhoa - t345*t347* & s_a_2norm_drhoanorm_drhoa IF (grad_deriv > 1 .OR. grad_deriv == -2) THEN exc_norm_drhoa_norm_drhoa = scale_x*e_lsda_x_a*( & - u_x_anorm_drhoanorm_drhoa*t18+0.2e1_dp*u_x_anorm_drhoa**2* & - c_x_2+u_x_a*u_x_anorm_drhoanorm_drhoa*c_x_2)+scale_c*( & - e_lsda_c_ab*(u_c_abnorm_drhoanorm_drhoa*t170+0.2e1_dp* & - u_c_abnorm_drhoa*(gamma_c_ab*s_avg_21norm_drhoa*t162-t337* & - t1590)*c_cab_2+u_c_ab*u_c_abnorm_drhoanorm_drhoa*c_cab_2)+ & - e_lsda_c_a*(u_c_anorm_drhoanorm_drhoa*t173+0.2e1_dp* & - u_c_anorm_drhoa*(gamma_c_ss*s_a_21norm_drhoa*t165-t345* & - t1605)*c_css_2+u_c_a*u_c_anorm_drhoanorm_drhoa*c_css_2)) - e_ndr_ndr(ii) = e_ndr_ndr(ii)+0.5_dp*0.5_dp*exc_norm_drhoa_norm_drhoa + u_x_anorm_drhoanorm_drhoa*t18 + 0.2e1_dp*u_x_anorm_drhoa**2* & + c_x_2 + u_x_a*u_x_anorm_drhoanorm_drhoa*c_x_2) + scale_c*( & + e_lsda_c_ab*(u_c_abnorm_drhoanorm_drhoa*t170 + 0.2e1_dp* & + u_c_abnorm_drhoa*(gamma_c_ab*s_avg_21norm_drhoa*t162 - t337* & + t1590)*c_cab_2 + u_c_ab*u_c_abnorm_drhoanorm_drhoa*c_cab_2) + & + e_lsda_c_a*(u_c_anorm_drhoanorm_drhoa*t173 + 0.2e1_dp* & + u_c_anorm_drhoa*(gamma_c_ss*s_a_21norm_drhoa*t165 - t345* & + t1605)*c_css_2 + u_c_a*u_c_anorm_drhoanorm_drhoa*c_css_2)) + e_ndr_ndr(ii) = e_ndr_ndr(ii) + 0.5_dp*0.5_dp*exc_norm_drhoa_norm_drhoa END IF - u_c_abrhoanorm_drhob = -0.2e1_dp*t906*t539+0.2e1_dp*t911* & + u_c_abrhoanorm_drhob = -0.2e1_dp*t906*t539 + 0.2e1_dp*t911* & t914*s_avg_2norm_drhob IF (grad_deriv > 1 .OR. grad_deriv == -2) THEN exc_rhoa_norm_drhob = scale_c*(e_lsda_c_abrhoa*gc_abnorm_drhob & - +e_lsda_c_ab*(u_c_abrhoanorm_drhob*t170+0.2e1_dp* & - u_c_abrhoa*u_c_abnorm_drhob*c_cab_2+u_c_ab* & - u_c_abrhoanorm_drhob*c_cab_2)) - e_r_ndr(ii) = e_r_ndr(ii)+0.5_dp*0.5_dp*exc_rhoa_norm_drhob + + e_lsda_c_ab*(u_c_abrhoanorm_drhob*t170 + 0.2e1_dp* & + u_c_abrhoa*u_c_abnorm_drhob*c_cab_2 + u_c_ab* & + u_c_abrhoanorm_drhob*c_cab_2)) + e_r_ndr(ii) = e_r_ndr(ii) + 0.5_dp*0.5_dp*exc_rhoa_norm_drhob END IF s_brhobnorm_drhob = -0.4e1_dp/0.3e1_dp*t367 - u_x_brhobnorm_drhob = 0.2e1_dp*gamma_x*s_bnorm_drhob*t371- & - 0.10e2_dp*t1165*t377*s_bnorm_drhob+0.2e1_dp*t370*t29* & - s_brhobnorm_drhob+0.8e1_dp*t1173*t1175*s_brhob* & - s_bnorm_drhob-0.2e1_dp*t374*t376*s_brhobnorm_drhob - s_b_2rhobnorm_drhob = 0.2e1_dp*s_bnorm_drhob*s_brhob+ & + u_x_brhobnorm_drhob = 0.2e1_dp*gamma_x*s_bnorm_drhob*t371 - & + 0.10e2_dp*t1165*t377*s_bnorm_drhob + 0.2e1_dp*t370*t29* & + s_brhobnorm_drhob + 0.8e1_dp*t1173*t1175*s_brhob* & + s_bnorm_drhob - 0.2e1_dp*t374*t376*s_brhobnorm_drhob + s_b_2rhobnorm_drhob = 0.2e1_dp*s_bnorm_drhob*s_brhob + & 0.2e1_dp*s_b*s_brhobnorm_drhob s_avg_2rhobnorm_drhob = s_b_2rhobnorm_drhob/0.2e1_dp - u_c_abrhobnorm_drhob = gamma_c_ab*s_avg_2rhobnorm_drhob*t162- & - 0.2e1_dp*t1436*t539+0.2e1_dp*t911*t1440* & - s_avg_2norm_drhob-t337*t339*s_avg_2rhobnorm_drhob - u_c_brhobnorm_drhob = gamma_c_ss*s_b_2rhobnorm_drhob*t168- & - 0.2e1_dp*t1451*t543+0.2e1_dp*t1455*t1458*s_b_2norm_drhob & - -t484*t486*s_b_2rhobnorm_drhob + u_c_abrhobnorm_drhob = gamma_c_ab*s_avg_2rhobnorm_drhob*t162 - & + 0.2e1_dp*t1436*t539 + 0.2e1_dp*t911*t1440* & + s_avg_2norm_drhob - t337*t339*s_avg_2rhobnorm_drhob + u_c_brhobnorm_drhob = gamma_c_ss*s_b_2rhobnorm_drhob*t168 - & + 0.2e1_dp*t1451*t543 + 0.2e1_dp*t1455*t1458*s_b_2norm_drhob & + - t484*t486*s_b_2rhobnorm_drhob IF (grad_deriv > 1 .OR. grad_deriv == -2) THEN - exc_rhob_norm_drhob = scale_x*(e_lsda_x_brhob*gx_bnorm_drhob+ & - e_lsda_x_b*(u_x_brhobnorm_drhob*t31+0.2e1_dp*u_x_brhob* & - u_x_bnorm_drhob*c_x_2+u_x_b*u_x_brhobnorm_drhob*c_x_2))+ & - scale_c*(e_lsda_c_abrhob*gc_abnorm_drhob+e_lsda_c_ab*( & - u_c_abrhobnorm_drhob*t170+0.2e1_dp*u_c_abrhob* & - u_c_abnorm_drhob*c_cab_2+u_c_ab*u_c_abrhobnorm_drhob*c_cab_2 & - )+e_lsda_c_brhob*gc_bnorm_drhob+e_lsda_c_b*( & - u_c_brhobnorm_drhob*t176+0.2e1_dp*u_c_brhob*u_c_bnorm_drhob & - *c_css_2+u_c_b*u_c_brhobnorm_drhob*c_css_2)) - e_r_ndr(ii) = e_r_ndr(ii)+0.5_dp*0.5_dp*exc_rhob_norm_drhob + exc_rhob_norm_drhob = scale_x*(e_lsda_x_brhob*gx_bnorm_drhob + & + e_lsda_x_b*(u_x_brhobnorm_drhob*t31 + 0.2e1_dp*u_x_brhob* & + u_x_bnorm_drhob*c_x_2 + u_x_b*u_x_brhobnorm_drhob*c_x_2)) + & + scale_c*(e_lsda_c_abrhob*gc_abnorm_drhob + e_lsda_c_ab*( & + u_c_abrhobnorm_drhob*t170 + 0.2e1_dp*u_c_abrhob* & + u_c_abnorm_drhob*c_cab_2 + u_c_ab*u_c_abrhobnorm_drhob*c_cab_2 & + ) + e_lsda_c_brhob*gc_bnorm_drhob + e_lsda_c_b*( & + u_c_brhobnorm_drhob*t176 + 0.2e1_dp*u_c_brhob*u_c_bnorm_drhob & + *c_css_2 + u_c_b*u_c_brhobnorm_drhob*c_css_2)) + e_r_ndr(ii) = e_r_ndr(ii) + 0.5_dp*0.5_dp*exc_rhob_norm_drhob END IF - u_c_abnorm_drhoanorm_drhob = -0.2e1_dp*t1589*t539+0.2e1_dp* & + u_c_abnorm_drhoanorm_drhob = -0.2e1_dp*t1589*t539 + 0.2e1_dp* & t911*t1593*s_avg_2norm_drhob IF (grad_deriv > 1 .OR. grad_deriv == -2) THEN exc_norm_drhoa_norm_drhob = scale_c*e_lsda_c_ab*( & - u_c_abnorm_drhoanorm_drhob*t170+0.2e1_dp*u_c_abnorm_drhoa* & - u_c_abnorm_drhob*c_cab_2+u_c_ab*u_c_abnorm_drhoanorm_drhob* & + u_c_abnorm_drhoanorm_drhob*t170 + 0.2e1_dp*u_c_abnorm_drhoa* & + u_c_abnorm_drhob*c_cab_2 + u_c_ab*u_c_abnorm_drhoanorm_drhob* & c_cab_2) - e_ndr_ndr(ii) = e_ndr_ndr(ii)+0.5_dp*exc_norm_drhoa_norm_drhob + e_ndr_ndr(ii) = e_ndr_ndr(ii) + 0.5_dp*exc_norm_drhoa_norm_drhob END IF t1719 = s_bnorm_drhob**2 - u_x_bnorm_drhobnorm_drhob = 0.2e1_dp*gamma_x*t1719*t29- & - 0.10e2_dp*t1165*t376*t1719+0.8e1_dp*t1173*t1175*t1719 + u_x_bnorm_drhobnorm_drhob = 0.2e1_dp*gamma_x*t1719*t29 - & + 0.10e2_dp*t1165*t376*t1719 + 0.8e1_dp*t1173*t1175*t1719 s_b_2norm_drhobnorm_drhob = 0.2e1_dp*t1719 s_b_21norm_drhob = s_b_2norm_drhob s_avg_2norm_drhobnorm_drhob = s_b_2norm_drhobnorm_drhob/0.2e1_dp s_avg_21norm_drhob = s_b_21norm_drhob/0.2e1_dp t1738 = t339*s_avg_21norm_drhob u_c_abnorm_drhobnorm_drhob = gamma_c_ab* & - s_avg_2norm_drhobnorm_drhob*t162-0.2e1_dp*t336* & - s_avg_2norm_drhob*t1738+0.2e1_dp*t911*t913* & - s_avg_2norm_drhob*s_avg_21norm_drhob-t337*t339* & + s_avg_2norm_drhobnorm_drhob*t162 - 0.2e1_dp*t336* & + s_avg_2norm_drhob*t1738 + 0.2e1_dp*t911*t913* & + s_avg_2norm_drhob*s_avg_21norm_drhob - t337*t339* & s_avg_2norm_drhobnorm_drhob t1753 = t486*s_b_21norm_drhob u_c_bnorm_drhobnorm_drhob = gamma_c_ss*s_b_2norm_drhobnorm_drhob & - *t168-0.2e1_dp*t344*s_b_2norm_drhob*t1753+0.2e1_dp* & - t1455*t1457*s_b_2norm_drhob*s_b_21norm_drhob-t484*t486* & + *t168 - 0.2e1_dp*t344*s_b_2norm_drhob*t1753 + 0.2e1_dp* & + t1455*t1457*s_b_2norm_drhob*s_b_21norm_drhob - t484*t486* & s_b_2norm_drhobnorm_drhob IF (grad_deriv > 1 .OR. grad_deriv == -2) THEN exc_norm_drhob_norm_drhob = scale_x*e_lsda_x_b*( & - u_x_bnorm_drhobnorm_drhob*t31+0.2e1_dp*u_x_bnorm_drhob**2* & - c_x_2+u_x_b*u_x_bnorm_drhobnorm_drhob*c_x_2)+scale_c*( & - e_lsda_c_ab*(u_c_abnorm_drhobnorm_drhob*t170+0.2e1_dp* & - u_c_abnorm_drhob*(gamma_c_ab*s_avg_21norm_drhob*t162-t337* & - t1738)*c_cab_2+u_c_ab*u_c_abnorm_drhobnorm_drhob*c_cab_2)+ & - e_lsda_c_b*(u_c_bnorm_drhobnorm_drhob*t176+0.2e1_dp* & - u_c_bnorm_drhob*(gamma_c_ss*s_b_21norm_drhob*t168-t484* & - t1753)*c_css_2+u_c_b*u_c_bnorm_drhobnorm_drhob*c_css_2)) - e_ndr_ndr(ii) = e_ndr_ndr(ii)+0.5_dp*0.5_dp*exc_norm_drhob_norm_drhob + u_x_bnorm_drhobnorm_drhob*t31 + 0.2e1_dp*u_x_bnorm_drhob**2* & + c_x_2 + u_x_b*u_x_bnorm_drhobnorm_drhob*c_x_2) + scale_c*( & + e_lsda_c_ab*(u_c_abnorm_drhobnorm_drhob*t170 + 0.2e1_dp* & + u_c_abnorm_drhob*(gamma_c_ab*s_avg_21norm_drhob*t162 - t337* & + t1738)*c_cab_2 + u_c_ab*u_c_abnorm_drhobnorm_drhob*c_cab_2) + & + e_lsda_c_b*(u_c_bnorm_drhobnorm_drhob*t176 + 0.2e1_dp* & + u_c_bnorm_drhob*(gamma_c_ss*s_b_21norm_drhob*t168 - t484* & + t1753)*c_css_2 + u_c_b*u_c_bnorm_drhobnorm_drhob*c_css_2)) + e_ndr_ndr(ii) = e_ndr_ndr(ii) + 0.5_dp*0.5_dp*exc_norm_drhob_norm_drhob END IF END IF ! <1 || >1 END IF ! /=0 diff --git a/src/xc/xc_cs1.F b/src/xc/xc_cs1.F index 283de88403..7f1adab799 100644 --- a/src/xc/xc_cs1.F +++ b/src/xc/xc_cs1.F @@ -169,7 +169,7 @@ SUBROUTINE cs1_lda_eval(rho_set, deriv_set, order) CPASSERT(deriv_set%ref_count > 0) CALL xc_rho_set_get(rho_set, rho_1_3=rho13, rho=rho, & norm_drho=grho, local_bounds=bo, rho_cutoff=epsilon_rho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) m = ABS(order) CALL cs1_init(epsilon_rho) @@ -261,7 +261,7 @@ SUBROUTINE cs1_lsd_eval(rho_set, deriv_set, order) rhoa_1_3=rhoa_1_3, rhob_1_3=rhob_1_3, & norm_drhoa=norm_drhoa, norm_drhob=norm_drhob, & local_bounds=bo, rho_cutoff=epsilon_rho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) CALL cs1_init(epsilon_rho) IF (order >= 0) THEN @@ -331,15 +331,15 @@ SUBROUTINE cs1_u_0(rho, grho, r13, e_0, npoints) r3 = r13(ip) g = grho(ip) x = g/(r*r3) - odp = 1.0_dp/(r3+dpv) - ocp = 1.0_dp/(r*r*r3*r3+cp*g*g) - od = 1.0_dp/(r3+d) - oc = 1.0_dp/(r*r*r3*r3+c*g*g) + odp = 1.0_dp/(r3 + dpv) + ocp = 1.0_dp/(r*r*r3*r3 + cp*g*g) + od = 1.0_dp/(r3 + d) + oc = 1.0_dp/(r*r*r3*r3 + c*g*g) F1 = c1*r*r3*odp F2 = c2p*g**4*r3*r*odp*ocp*ocp F3 = c3p*r*r3*od F4 = c4p*g**4*r3*r*od*oc*oc - e_0(ip) = e_0(ip)+F1+F2+F3+F4 + e_0(ip) = e_0(ip) + F1 + F2 + F3 + F4 END IF END DO @@ -386,20 +386,20 @@ SUBROUTINE cs1_u_1(rho, grho, r13, e_rho, e_ndrho, npoints) r = rho(ip) r3 = r13(ip) g = grho(ip) - odp = 1.0_dp/(r3+dpv) - ocp = 1.0_dp/(r*r*r3*r3+cp*g*g) - od = 1.0_dp/(r3+d) - oc = 1.0_dp/(r*r*r3*r3+c*g*g) - dF1 = c1*f13*r3*(3*r3+4*dpv)*odp*odp - drF2 = -f13*c2p*g**4*r3*(13*r**3-3*r3*cp*g*g+12*r*r*r3*r3*dpv- & + odp = 1.0_dp/(r3 + dpv) + ocp = 1.0_dp/(r*r*r3*r3 + cp*g*g) + od = 1.0_dp/(r3 + d) + oc = 1.0_dp/(r*r*r3*r3 + c*g*g) + dF1 = c1*f13*r3*(3*r3 + 4*dpv)*odp*odp + drF2 = -f13*c2p*g**4*r3*(13*r**3 - 3*r3*cp*g*g + 12*r*r*r3*r3*dpv - & 4*dpv*cp*g*g)*odp**2*ocp**3 dgF2 = 4*c2p*g**3*r**4*odp*ocp**3 - dF3 = f13*r3*c3p*(3*r3+4*d)*od*od - drF4 = -f13*c4p*g**4*r3*(13*r**3-3*r3*c*g*g+12*r*r*r3*r3*d- & + dF3 = f13*r3*c3p*(3*r3 + 4*d)*od*od + drF4 = -f13*c4p*g**4*r3*(13*r**3 - 3*r3*c*g*g + 12*r*r*r3*r3*d - & 4*d*c*g*g)*od**2*oc**3 dgF4 = 4*c4p*g**3*r**4*od*oc**3 - e_rho(ip) = e_rho(ip)+dF1+drF2+dF3+drF4 - e_ndrho(ip) = e_ndrho(ip)+dgF2+dgF4 + e_rho(ip) = e_rho(ip) + dF1 + drF2 + dF3 + drF4 + e_ndrho(ip) = e_ndrho(ip) + dgF2 + dgF4 END IF END DO @@ -448,29 +448,29 @@ SUBROUTINE cs1_u_2(rho, grho, r13, e_rho_rho, e_rho_ndrho, e_ndrho_ndrho, & r = rho(ip) r3 = r13(ip) g = grho(ip) - odp = 1.0_dp/(r3+dpv) - ocp = 1.0_dp/(r*r*r3*r3+cp*g*g) - od = 1.0_dp/(r3+d) - oc = 1.0_dp/(r*r*r3*r3+c*g*g) - d2F1 = c1*f23*f13*dpv*r3/r*(r3+2*dpv)*odp**3 - d2rF2 = c2p*f13*f23*g**4*r3/r*(193*dpv*r**5*r3*r3+90*dpv*dpv*r**5*r3 & - -88*g*g*cp*r**3*r3-100*dpv*dpv*cp*g*g*r*r*r3*r3 & - +2*dpv*dpv*cp*cp*g**4-190*g*g*r**3*cp*dpv+g**4*r3*cp*cp*dpv & - +104*r**6)*odp**3*ocp**4 - drgF2 = c2p*f43*g**3*r*r*r3*(-13*r**3*r3*r3+11*cp*r*g*g-12*dpv*r**3*r3 & - +12*r3*r3*dpv*cp*g*g)*odp*odp*ocp**4 - d2gF2 = -12*c2p*g*g*r**4*(cp*g*g-r*r*r3*r3)*odp*ocp**4 - d2F3 = f13*f23*c3p*d*r3/r*(r3+2*d)*od**3 - d2rF4 = c4p*f13*f23*g**4*r3/r*(193*d*r**5*r3*r3+90*d*d*r**5*r3 & - -88*g*g*c*r**3*r3-100*d*d*c*g*g*r*r*r3*r3 & - +2*d*d*c*c*g**4-190*g*g*r**3*c*d+g**4*r3*c*c*d & - +104*r**6)*od**3*oc**4 - drgF4 = c4p*f43*g**3*r*r*r3*(-13*r**3*r3*r3+11*c*r*g*g-12*d*r**3*r3 & - +12*r3*r3*d*c*g*g)*od*od*oc**4 - d2gF4 = -12*c4p*g*g*r**4*(c*g*g-r*r*r3*r3)*od*oc**4 - e_rho_rho(ip) = e_rho_rho(ip)+d2F1+d2rF2+d2F3+d2rF4 - e_rho_ndrho(ip) = e_rho_ndrho(ip)+drgF2+drgF4 - e_ndrho_ndrho(ip) = e_ndrho_ndrho(ip)+d2gF2+d2gF4 + odp = 1.0_dp/(r3 + dpv) + ocp = 1.0_dp/(r*r*r3*r3 + cp*g*g) + od = 1.0_dp/(r3 + d) + oc = 1.0_dp/(r*r*r3*r3 + c*g*g) + d2F1 = c1*f23*f13*dpv*r3/r*(r3 + 2*dpv)*odp**3 + d2rF2 = c2p*f13*f23*g**4*r3/r*(193*dpv*r**5*r3*r3 + 90*dpv*dpv*r**5*r3 & + - 88*g*g*cp*r**3*r3 - 100*dpv*dpv*cp*g*g*r*r*r3*r3 & + + 2*dpv*dpv*cp*cp*g**4 - 190*g*g*r**3*cp*dpv + g**4*r3*cp*cp*dpv & + + 104*r**6)*odp**3*ocp**4 + drgF2 = c2p*f43*g**3*r*r*r3*(-13*r**3*r3*r3 + 11*cp*r*g*g - 12*dpv*r**3*r3 & + + 12*r3*r3*dpv*cp*g*g)*odp*odp*ocp**4 + d2gF2 = -12*c2p*g*g*r**4*(cp*g*g - r*r*r3*r3)*odp*ocp**4 + d2F3 = f13*f23*c3p*d*r3/r*(r3 + 2*d)*od**3 + d2rF4 = c4p*f13*f23*g**4*r3/r*(193*d*r**5*r3*r3 + 90*d*d*r**5*r3 & + - 88*g*g*c*r**3*r3 - 100*d*d*c*g*g*r*r*r3*r3 & + + 2*d*d*c*c*g**4 - 190*g*g*r**3*c*d + g**4*r3*c*c*d & + + 104*r**6)*od**3*oc**4 + drgF4 = c4p*f43*g**3*r*r*r3*(-13*r**3*r3*r3 + 11*c*r*g*g - 12*d*r**3*r3 & + + 12*r3*r3*d*c*g*g)*od*od*oc**4 + d2gF4 = -12*c4p*g*g*r**4*(c*g*g - r*r*r3*r3)*od*oc**4 + e_rho_rho(ip) = e_rho_rho(ip) + d2F1 + d2rF2 + d2F3 + d2rF4 + e_rho_ndrho(ip) = e_rho_ndrho(ip) + drgF2 + drgF4 + e_ndrho_ndrho(ip) = e_ndrho_ndrho(ip) + d2gF2 + d2gF4 END IF END DO @@ -527,56 +527,56 @@ SUBROUTINE cs1_u_3(rho, grho, r13, e_rho_rho_rho, e_rho_rho_ndrho, & r = rho(ip) r3 = r13(ip) g = grho(ip) - odp = 1.0_dp/(r3+dpv) - ocp = 1.0_dp/(r*r*r3*r3+cp*g*g) - od = 1.0_dp/(r3+d) - oc = 1.0_dp/(r*r*r3*r3+c*g*g) - d3F1 = -c1*f23*f13*f13*dpv*r3/(r*r)*(11*dpv*r3+4*dpv*dpv+4*r/r3)*odp**4 + odp = 1.0_dp/(r3 + dpv) + ocp = 1.0_dp/(r*r*r3*r3 + cp*g*g) + od = 1.0_dp/(r3 + d) + oc = 1.0_dp/(r*r*r3*r3 + c*g*g) + d3F1 = -c1*f23*f13*f13*dpv*r3/(r*r)*(11*dpv*r3 + 4*dpv*dpv + 4*r/r3)*odp**4 t1 = g**2; t2 = t1**2; t3 = r3; t4 = t3**2; t8 = dpv**2; t9 = t8*dpv t10 = cp**2; t11 = t10*cp; t13 = t2*t1; t16 = r**2; t17 = t4*t16 t19 = t10*t2; t22 = t16**2; t23 = t22**2; t32 = t22*t16; t37 = t16*r t58 = t22*r; t61 = cp*t1 - t74 = 4*t9*t11*t13+668*t17*t9*t19+5524*t4*t23*dpv+5171*t3*t23*t8+ & - 1620*t23*t9-3728*t3*t32*cp*t1+440*t4*t37*t10*t2+1500*t2*t3*t37*dpv*t10 & - +4*t13*t4*dpv*t11+1737*t37*t8*t19+11*t3*t8*t11*t13-3860*t3*t58*t9*t61+ & - 1976*t23*r-11535*t4*t58*t8*t61-11412*t1*t32*cp*dpv - t76 = (t3+dpv)**2; t77 = t76**2; t80 = t17+t61; t81 = t80**2; t82 = t81**2 + t74 = 4*t9*t11*t13 + 668*t17*t9*t19 + 5524*t4*t23*dpv + 5171*t3*t23*t8 + & + 1620*t23*t9 - 3728*t3*t32*cp*t1 + 440*t4*t37*t10*t2 + 1500*t2*t3*t37*dpv*t10 & + + 4*t13*t4*dpv*t11 + 1737*t37*t8*t19 + 11*t3*t8*t11*t13 - 3860*t3*t58*t9*t61 + & + 1976*t23*r - 11535*t4*t58*t8*t61 - 11412*t1*t32*cp*dpv + t76 = (t3 + dpv)**2; t77 = t76**2; t80 = t17 + t61; t81 = t80**2; t82 = t81**2 d3rF2 = -f23*f13*f13*c2p*t2/t4/r*t74/t77/t82/t80 t4 = t3*r; t6 = r**2; t7 = t6**2; t8 = t7*t6; t9 = dpv**2; t15 = t1**2 - t17 = cp**2; t23 = t3**2; t26 = t6*r; t29 = cp*t1; t33 = t17*t15; t44 = t3+dpv - t45 = t44**2; t50 = t23*t6+t29; t51 = t50**2; t52 = t51**2 - d2rgF2 = c2p*f23*f43*t1*g*t4*(90*t8*t9+193*t3*t8*dpv+44*t15*t4*t17-236*t1 & - *t7*cp+104*t23*t8-240*t3*t26*t9*t29+54*t23*t9*t33-478*t23*t26*dpv*t29 & - +97*r*dpv*t33)/t45/t44/t52/t50 - dr2gF2 = -4*c2p*g*g*r*r*r3*(-40*r**3*r3*dpv*cp*g*g+12*r3*r3*dpv*cp*cp*g**4 & - +13*r**6*r3-40*r**3*r3*r3*cp*g*g+11*r*cp*cp*g**4+12*r**6*dpv) & + t17 = cp**2; t23 = t3**2; t26 = t6*r; t29 = cp*t1; t33 = t17*t15; t44 = t3 + dpv + t45 = t44**2; t50 = t23*t6 + t29; t51 = t50**2; t52 = t51**2 + d2rgF2 = c2p*f23*f43*t1*g*t4*(90*t8*t9 + 193*t3*t8*dpv + 44*t15*t4*t17 - 236*t1 & + *t7*cp + 104*t23*t8 - 240*t3*t26*t9*t29 + 54*t23*t9*t33 - 478*t23*t26*dpv*t29 & + + 97*r*dpv*t33)/t45/t44/t52/t50 + dr2gF2 = -4*c2p*g*g*r*r*r3*(-40*r**3*r3*dpv*cp*g*g + 12*r3*r3*dpv*cp*cp*g**4 & + + 13*r**6*r3 - 40*r**3*r3*r3*cp*g*g + 11*r*cp*cp*g**4 + 12*r**6*dpv) & *odp*odp*ocp**5 - d3gF2 = c2p*24*g*r**3*r3*(r**6-5*cp*g*g*r**3*r3+2*cp*cp*g**4*r3*r3)*odp*ocp**5 - d3F3 = -f23*f13*f13*c3p*d*r3/(r*r)*(11*d*r3+4*d*d+4*r3*r3)*od**4 + d3gF2 = c2p*24*g*r**3*r3*(r**6 - 5*cp*g*g*r**3*r3 + 2*cp*cp*g**4*r3*r3)*odp*ocp**5 + d3F3 = -f23*f13*f13*c3p*d*r3/(r*r)*(11*d*r3 + 4*d*d + 4*r3*r3)*od**4 t1 = g**2; t2 = t1**2; t3 = r3; t4 = t3**2; t8 = d**2; t9 = t8*d t10 = c**2; t11 = t10*c; t13 = t2*t1; t16 = r**2; t17 = t4*t16 t19 = t10*t2; t22 = t16**2; t23 = t22**2; t32 = t22*t16; t37 = t16*r t58 = t22*r; t61 = c*t1 - t74 = 4*t9*t11*t13+668*t17*t9*t19+5524*t4*t23*d+5171*t3*t23*t8+ & - 1620*t23*t9-3728*t3*t32*c*t1+440*t4*t37*t10*t2+1500*t2*t3*t37*d*t10 & - +4*t13*t4*d*t11+1737*t37*t8*t19+11*t3*t8*t11*t13-3860*t3*t58*t9*t61+ & - 1976*t23*r-11535*t4*t58*t8*t61-11412*t1*t32*c*d - t76 = (t3+d)**2; t77 = t76**2; t80 = t17+t61; t81 = t80**2; t82 = t81**2 + t74 = 4*t9*t11*t13 + 668*t17*t9*t19 + 5524*t4*t23*d + 5171*t3*t23*t8 + & + 1620*t23*t9 - 3728*t3*t32*c*t1 + 440*t4*t37*t10*t2 + 1500*t2*t3*t37*d*t10 & + + 4*t13*t4*d*t11 + 1737*t37*t8*t19 + 11*t3*t8*t11*t13 - 3860*t3*t58*t9*t61 + & + 1976*t23*r - 11535*t4*t58*t8*t61 - 11412*t1*t32*c*d + t76 = (t3 + d)**2; t77 = t76**2; t80 = t17 + t61; t81 = t80**2; t82 = t81**2 d3rF4 = -f23*f13*f13*c4p*t2/t4/r*t74/t77/t82/t80 t4 = t3*r; t6 = r**2; t7 = t6**2; t8 = t7*t6; t9 = d**2; t15 = t1**2 - t17 = c**2; t23 = t3**2; t26 = t6*r; t29 = c*t1; t33 = t17*t15; t44 = t3+d - t45 = t44**2; t50 = t23*t6+t29; t51 = t50**2; t52 = t51**2 - d2rgF4 = c4p*f23*f43*t1*g*t4*(90*t8*t9+193*t3*t8*d+44*t15*t4*t17-236*t1 & - *t7*c+104*t23*t8-240*t3*t26*t9*t29+54*t23*t9*t33-478*t23*t26*d*t29 & - +97*r*d*t33)/t45/t44/t52/t50 - dr2gF4 = -4*c4p*g*g*r*r*r3*(-40*r**3*r3*d*c*g*g+12*r3*r3*d*c*c*g**4 & - +13*r**6*r3-40*r**3*r3*r3*c*g*g+11*r*c*c*g**4+12*r**6*d) & + t17 = c**2; t23 = t3**2; t26 = t6*r; t29 = c*t1; t33 = t17*t15; t44 = t3 + d + t45 = t44**2; t50 = t23*t6 + t29; t51 = t50**2; t52 = t51**2 + d2rgF4 = c4p*f23*f43*t1*g*t4*(90*t8*t9 + 193*t3*t8*d + 44*t15*t4*t17 - 236*t1 & + *t7*c + 104*t23*t8 - 240*t3*t26*t9*t29 + 54*t23*t9*t33 - 478*t23*t26*d*t29 & + + 97*r*d*t33)/t45/t44/t52/t50 + dr2gF4 = -4*c4p*g*g*r*r*r3*(-40*r**3*r3*d*c*g*g + 12*r3*r3*d*c*c*g**4 & + + 13*r**6*r3 - 40*r**3*r3*r3*c*g*g + 11*r*c*c*g**4 + 12*r**6*d) & *od*od*oc**5 - d3gF4 = c4p*24*g*r**3*r3*(r**6-5*c*g*g*r**3*r3+2*c*c*g**4*r3*r3)*od*oc**5 - e_rho_rho_rho(ip) = e_rho_rho_rho(ip)+d3F1+d3rF2+d3F3+d3rF4 - e_rho_rho_ndrho(ip) = e_rho_rho_ndrho(ip)+d2rgF2+d2rgF4 - e_rho_ndrho_ndrho(ip) = e_rho_ndrho_ndrho(ip)+dr2gF2+dr2gF4 - e_ndrho_ndrho_ndrho(ip) = e_ndrho_ndrho_ndrho(ip)+d3gF2+d3gF4 + d3gF4 = c4p*24*g*r**3*r3*(r**6 - 5*c*g*g*r**3*r3 + 2*c*c*g**4*r3*r3)*od*oc**5 + e_rho_rho_rho(ip) = e_rho_rho_rho(ip) + d3F1 + d3rF2 + d3F3 + d3rF4 + e_rho_rho_ndrho(ip) = e_rho_rho_ndrho(ip) + d2rgF2 + d2rgF4 + e_rho_ndrho_ndrho(ip) = e_rho_ndrho_ndrho(ip) + dr2gF2 + dr2gF4 + e_ndrho_ndrho_ndrho(ip) = e_ndrho_ndrho_ndrho(ip) + d3gF2 + d3gF4 END IF END DO @@ -629,8 +629,8 @@ SUBROUTINE cs1_ss_0(rhoa, rhob, grhoa, grhob, r13a, r13b, e_0, & r3a = r13a(ip) ga = grhoa(ip) xa = ga/(ra*r3a) - oda = 1.0_dp/(r3a+d) - oca = 1.0_dp/(ra*ra*r3a*r3a+c*ga*ga) + oda = 1.0_dp/(r3a + d) + oca = 1.0_dp/(ra*ra*r3a*r3a + c*ga*ga) F1a = c1*ra*r3a*oda F2a = c2*ga**4*r3a*ra*oda*oca*oca END IF @@ -642,13 +642,13 @@ SUBROUTINE cs1_ss_0(rhoa, rhob, grhoa, grhob, r13a, r13b, e_0, & r3b = r13b(ip) gb = grhob(ip) xb = gb/(rb*r3b) - odb = 1.0_dp/(r3b+d) - ocb = 1.0_dp/(rb*rb*r3b*r3b+c*gb*gb) + odb = 1.0_dp/(r3b + d) + ocb = 1.0_dp/(rb*rb*r3b*r3b + c*gb*gb) F1b = c1*rb*r3b*odb F2b = c2*gb**4*r3b*rb*odb*ocb*ocb END IF - e_0(ip) = e_0(ip)+F1a+F1b+F2a+F2b + e_0(ip) = e_0(ip) + F1a + F1b + F2a + F2b END DO @@ -702,11 +702,11 @@ SUBROUTINE cs1_ss_1(rhoa, rhob, grhoa, grhob, r13a, r13b, e_rhoa, & ra = rhoa(ip) r3a = r13a(ip) ga = grhoa(ip) - oda = 1.0_dp/(r3a+d) - oca = 1.0_dp/(ra*ra*r3a*r3a+c*ga*ga) - dF1a = c1*f13*r3a*(3*r3a+4*d)*oda*oda + oda = 1.0_dp/(r3a + d) + oca = 1.0_dp/(ra*ra*r3a*r3a + c*ga*ga) + dF1a = c1*f13*r3a*(3*r3a + 4*d)*oda*oda - drF2a = -f13*c2*ga**4*r3a*(13*ra**3-3*r3a*c*ga*ga+12*ra*ra*r3a*r3a*d- & + drF2a = -f13*c2*ga**4*r3a*(13*ra**3 - 3*r3a*c*ga*ga + 12*ra*ra*r3a*r3a*d - & 4*d*c*ga*ga)*oda**2*oca**3 dgF2a = 4*c2*ga**3*ra**4*oda*oca**3 @@ -720,21 +720,21 @@ SUBROUTINE cs1_ss_1(rhoa, rhob, grhoa, grhob, r13a, r13b, e_rhoa, & rb = rhob(ip) r3b = r13b(ip) gb = grhob(ip) - odb = 1.0_dp/(r3b+d) - ocb = 1.0_dp/(rb*rb*r3b*r3b+c*gb*gb) - dF1b = c1*f13*r3b*(3*r3b+4*d)*odb*odb + odb = 1.0_dp/(r3b + d) + ocb = 1.0_dp/(rb*rb*r3b*r3b + c*gb*gb) + dF1b = c1*f13*r3b*(3*r3b + 4*d)*odb*odb - drF2b = -f13*c2*gb**4*r3b*(13*rb**3-3*r3b*c*gb*gb+12*rb*rb*r3b*r3b*d- & + drF2b = -f13*c2*gb**4*r3b*(13*rb**3 - 3*r3b*c*gb*gb + 12*rb*rb*r3b*r3b*d - & 4*d*c*gb*gb)*odb**2*ocb**3 dgF2b = 4*c2*gb**3*rb**4*odb*ocb**3 END IF - e_rhoa(ip) = e_rhoa(ip)+dF1a+drF2a - e_ndrhoa(ip) = e_ndrhoa(ip)+dgF2a - e_rhob(ip) = e_rhob(ip)+dF1b+drF2b - e_ndrhob(ip) = e_ndrhob(ip)+dgF2b + e_rhoa(ip) = e_rhoa(ip) + dF1a + drF2a + e_ndrhoa(ip) = e_ndrhoa(ip) + dgF2a + e_rhob(ip) = e_rhob(ip) + dF1b + drF2b + e_ndrhob(ip) = e_ndrhob(ip) + dgF2b END DO diff --git a/src/xc/xc_derivative_desc.F b/src/xc/xc_derivative_desc.F index 9497a34acd..6e941bc020 100644 --- a/src/xc/xc_derivative_desc.F +++ b/src/xc/xc_derivative_desc.F @@ -33,7 +33,7 @@ MODULE xc_derivative_desc INTEGER, PARAMETER :: & MAX_LABEL_LENGTH = 12, & MAX_DERIVATIVE = 4, & - MAX_DERIVATIVE_DESC_LENGTH = (MAX_LABEL_LENGTH+2)*MAX_DERIVATIVE + MAX_DERIVATIVE_DESC_LENGTH = (MAX_LABEL_LENGTH + 2)*MAX_DERIVATIVE LOGICAL, PARAMETER :: debug_this_module = .FALSE. @@ -70,10 +70,10 @@ SUBROUTINE standardize_derivative_desc(deriv_desc, res) ordered = .FALSE. DO WHILE (.NOT. ordered) ordered = .TRUE. - DO i = 1, SIZE(deriv_array)-1 - IF (deriv_array(i) > deriv_array(i+1)) THEN - tmp = deriv_array(i+1) - deriv_array(i+1) = deriv_array(i) + DO i = 1, SIZE(deriv_array) - 1 + IF (deriv_array(i) > deriv_array(i + 1)) THEN + tmp = deriv_array(i + 1) + deriv_array(i + 1) = deriv_array(i) deriv_array(i) = tmp ordered = .FALSE. END IF @@ -84,8 +84,8 @@ SUBROUTINE standardize_derivative_desc(deriv_desc, res) pos = 1 DO i = 1, SIZE(deriv_array) l_label = LEN_TRIM(deriv_array(i)) - res(pos:pos+l_label+1) = '('//deriv_array(i) (1:l_label)//')' - pos = pos+l_label+2 + res(pos:pos + l_label + 1) = '('//deriv_array(i) (1:l_label)//')' + pos = pos + l_label + 2 END DO DEALLOCATE (deriv_array) @@ -110,7 +110,7 @@ SUBROUTINE create_split_derivative_desc(deriv_desc, res) nderiv = 0 DO i = 1, LEN(deriv_desc) IF (deriv_desc(i:i) == '(') THEN - nderiv = nderiv+1 + nderiv = nderiv + 1 END IF END DO @@ -119,12 +119,12 @@ SUBROUTINE create_split_derivative_desc(deriv_desc, res) nderiv = 0 DO i = 1, LEN(deriv_desc) IF (deriv_desc(i:i) == '(') THEN - nderiv = nderiv+1 - DO j = i+1, LEN(deriv_desc) + nderiv = nderiv + 1 + DO j = i + 1, LEN(deriv_desc) IF (deriv_desc(j:j) == ')') EXIT END DO !tc: should we do a check on the derivative descriptions? - res(nderiv) = deriv_desc(i+1:j-1) + res(nderiv) = deriv_desc(i + 1:j - 1) END IF END DO diff --git a/src/xc/xc_derivative_set_types.F b/src/xc/xc_derivative_set_types.F index 4c6d69a428..ef93ebcfb3 100644 --- a/src/xc/xc_derivative_set_types.F +++ b/src/xc/xc_derivative_set_types.F @@ -129,7 +129,7 @@ SUBROUTINE xc_dset_create(derivative_set, pw_pool, local_bounds) NULLIFY (derivative_set%derivs) derivative_set%ref_count = 1 - derivative_set_last_id_nr = derivative_set_last_id_nr+1 + derivative_set_last_id_nr = derivative_set_last_id_nr + 1 derivative_set%id_nr = derivative_set_last_id_nr IF (PRESENT(pw_pool)) THEN derivative_set%pw_pool => pw_pool @@ -168,7 +168,7 @@ SUBROUTINE xc_dset_release(derivative_set) CPASSERT(ASSOCIATED(derivative_set)) CPASSERT(derivative_set%ref_count > 0) - derivative_set%ref_count = derivative_set%ref_count-1 + derivative_set%ref_count = derivative_set%ref_count - 1 IF (derivative_set%ref_count == 0) THEN pos => derivative_set%derivs DO WHILE (cp_sll_xc_deriv_next(pos, el_att=deriv_att)) @@ -197,7 +197,7 @@ SUBROUTINE xc_dset_retain(deriv_set) CPASSERT(ASSOCIATED(deriv_set)) CPASSERT(deriv_set%ref_count > 0) - deriv_set%ref_count = deriv_set%ref_count+1 + deriv_set%ref_count = deriv_set%ref_count + 1 END SUBROUTINE xc_dset_retain ! ************************************************************************************************** diff --git a/src/xc/xc_derivative_types.F b/src/xc/xc_derivative_types.F index 1f0117cd58..859fe9d2c0 100644 --- a/src/xc/xc_derivative_types.F +++ b/src/xc/xc_derivative_types.F @@ -75,7 +75,7 @@ SUBROUTINE xc_derivative_create(derivative, desc, cr3d_ptr) derivative%ref_count = 1 derivative%id_nr = derivative_id_nr - derivative_id_nr = derivative_id_nr+1 + derivative_id_nr = derivative_id_nr + 1 CALL standardize_derivative_desc(desc, my_desc) CALL create_split_derivative_desc(my_desc, derivative%split_desc) derivative%desc = my_desc @@ -98,7 +98,7 @@ SUBROUTINE xc_derivative_retain(deriv) CPASSERT(ASSOCIATED(deriv)) CPASSERT(deriv%ref_count > 0) - deriv%ref_count = deriv%ref_count+1 + deriv%ref_count = deriv%ref_count + 1 END SUBROUTINE xc_derivative_retain ! ************************************************************************************************** @@ -118,7 +118,7 @@ SUBROUTINE xc_derivative_release(derivative, pw_pool) CPASSERT(ASSOCIATED(derivative)) CPASSERT(derivative%ref_count >= 1) - derivative%ref_count = derivative%ref_count-1 + derivative%ref_count = derivative%ref_count - 1 IF (derivative%ref_count == 0) THEN IF (PRESENT(pw_pool)) THEN IF (ASSOCIATED(pw_pool)) THEN diff --git a/src/xc/xc_derivatives.F b/src/xc/xc_derivatives.F index 8d37d7bbcd..b4eab41b48 100644 --- a/src/xc/xc_derivatives.F +++ b/src/xc/xc_derivatives.F @@ -585,7 +585,7 @@ SUBROUTINE xc_functionals_eval(functionals, lsd, rho_set, deriv_set, & CPASSERT(ASSOCIATED(functionals)) ifun = 0 DO - ifun = ifun+1 + ifun = ifun + 1 xc_fun => section_vals_get_subs_vals2(functionals, i_section=ifun) IF (.NOT. ASSOCIATED(xc_fun)) EXIT IF (TRIM(xc_fun%section%name) /= "LIBXC") THEN @@ -646,7 +646,7 @@ FUNCTION xc_functionals_get_needs(functionals, lsd, add_basic_components) & ifun = 0 DO - ifun = ifun+1 + ifun = ifun + 1 xc_fun => section_vals_get_subs_vals2(functionals, i_section=ifun) IF (.NOT. ASSOCIATED(xc_fun)) EXIT IF (TRIM(xc_fun%section%name) /= "LIBXC") THEN diff --git a/src/xc/xc_exchange_gga.F b/src/xc/xc_exchange_gga.F index a29bbf7c4f..62a13b7adf 100644 --- a/src/xc/xc_exchange_gga.F +++ b/src/xc/xc_exchange_gga.F @@ -95,8 +95,8 @@ SUBROUTINE xgga_info(functional, lsd, reference, shortform, needs, max_deriv) CPABORT("Invalid functional requested ("//cp_to_string(functional)//")") END SELECT IF (.NOT. lsd) THEN - IF (LEN_TRIM(reference)+6 < LEN(reference)) THEN - reference(LEN_TRIM(reference):LEN_TRIM(reference)+6) = ' {LDA}' + IF (LEN_TRIM(reference) + 6 < LEN(reference)) THEN + reference(LEN_TRIM(reference):LEN_TRIM(reference) + 6) = ' {LDA}' END IF END IF END IF @@ -120,8 +120,8 @@ SUBROUTINE xgga_info(functional, lsd, reference, shortform, needs, max_deriv) CPABORT("Invalid functional requested ("//cp_to_string(functional)//")") END SELECT IF (.NOT. lsd) THEN - IF (LEN_TRIM(shortform)+6 < LEN(shortform)) THEN - shortform(LEN_TRIM(shortform):LEN_TRIM(shortform)+6) = ' {LDA}' + IF (LEN_TRIM(shortform) + 6 < LEN(shortform)) THEN + shortform(LEN_TRIM(shortform):LEN_TRIM(shortform) + 6) = ' {LDA}' END IF END IF END IF @@ -200,12 +200,12 @@ SUBROUTINE xgga_eval(functional, lsd, rho_set, deriv_set, order) rho_spin_name = (/"(rho) ", "(---) "/) norm_drho_spin_name = (/"(norm_drho) ", "(----_----) "/) END IF - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) m = ABS(order) CALL xgga_init(rho_cutoff) ALLOCATE (s(npoints)) - ALLOCATE (fs(npoints, m+1)) + ALLOCATE (fs(npoints, m + 1)) DO ispin = 1, nspin IF (lsd) THEN @@ -364,7 +364,7 @@ SUBROUTINE x_p_0(rho, r13, fs, e_0, npoints) DO ip = 1, npoints IF (rho(ip) > eps_rho) THEN - e_0(ip) = e_0(ip)+fact*r13(ip)*rho(ip)*fs(ip, 1) + e_0(ip) = e_0(ip) + fact*r13(ip)*rho(ip)*fs(ip, 1) END IF END DO @@ -406,8 +406,8 @@ SUBROUTINE x_p_1(rho, r13, s, fs, e_rho, e_ndrho, npoints) a1 = f43*fact*r13(ip) sx = -f43*s(ip)/rho(ip) sy = sfac*tact/(r13(ip)*rho(ip)) - e_rho(ip) = e_rho(ip)+a1*fs(ip, 1)+a0*fs(ip, 2)*sx - e_ndrho(ip) = e_ndrho(ip)+a0*fs(ip, 2)*sy + e_rho(ip) = e_rho(ip) + a1*fs(ip, 1) + a0*fs(ip, 2)*sx + e_ndrho(ip) = e_ndrho(ip) + a0*fs(ip, 2)*sy END IF @@ -455,11 +455,11 @@ SUBROUTINE x_p_2(rho, r13, s, fs, e_rho_rho, e_rho_ndrho, & sy = sfac*tact/(r13(ip)*rho(ip)) sxx = 28.0_dp/9.0_dp*s(ip)/(rho(ip)*rho(ip)) sxy = -f43*sfac*tact/(r13(ip)*rho(ip)*rho(ip)) - e_rho_rho(ip) = e_rho_rho(ip)+a2*fs(ip, 1)+2.0_dp*a1*fs(ip, 2)*sx+ & - a0*fs(ip, 3)*sx*sx+a0*fs(ip, 2)*sxx + e_rho_rho(ip) = e_rho_rho(ip) + a2*fs(ip, 1) + 2.0_dp*a1*fs(ip, 2)*sx + & + a0*fs(ip, 3)*sx*sx + a0*fs(ip, 2)*sxx e_rho_ndrho(ip) = e_rho_ndrho(ip) & - +a1*fs(ip, 2)*sy+a0*fs(ip, 3)*sx*sy+a0*fs(ip, 2)*sxy - e_ndrho_ndrho(ip) = e_ndrho_ndrho(ip)+a0*fs(ip, 3)*sy*sy + + a1*fs(ip, 2)*sy + a0*fs(ip, 3)*sx*sy + a0*fs(ip, 2)*sxy + e_ndrho_ndrho(ip) = e_ndrho_ndrho(ip) + a0*fs(ip, 3)*sy*sy END IF @@ -516,20 +516,20 @@ SUBROUTINE x_p_3(rho, r13, s, fs, e_rho_rho_rho, e_rho_rho_ndrho, & sxxx = -280.0_dp/27.0_dp*s(ip)/(rho(ip)*rho(ip)*rho(ip)) sxxy = 28.0_dp/9.0_dp*sfac*tact/(r13(ip)*rho(ip)*rho(ip)*rho(ip)) e_rho_rho_rho(ip) = e_rho_rho_rho(ip) & - +a3*fs(ip, 1)+3.0_dp*a2*fs(ip, 2)*sx+ & - 3.0_dp*a1*fs(ip, 3)*sx*sx+3.0_dp*a1*fs(ip, 2)*sxx+ & - a0*fs(ip, 4)*sx*sx*sx+3.0_dp*a0*fs(ip, 3)*sx*sxx+ & + + a3*fs(ip, 1) + 3.0_dp*a2*fs(ip, 2)*sx + & + 3.0_dp*a1*fs(ip, 3)*sx*sx + 3.0_dp*a1*fs(ip, 2)*sxx + & + a0*fs(ip, 4)*sx*sx*sx + 3.0_dp*a0*fs(ip, 3)*sx*sxx + & a0*fs(ip, 2)*sxxx e_rho_rho_ndrho(ip) = e_rho_rho_ndrho(ip) & - +a2*fs(ip, 2)*sy+2.0_dp*a1*fs(ip, 3)*sx*sy+ & - 2.0_dp*a1*fs(ip, 2)*sxy+a0*fs(ip, 4)*sx*sx*sy+ & - 2.0_dp*a0*fs(ip, 3)*sx*sxy+a0*fs(ip, 3)*sxx*sy+ & + + a2*fs(ip, 2)*sy + 2.0_dp*a1*fs(ip, 3)*sx*sy + & + 2.0_dp*a1*fs(ip, 2)*sxy + a0*fs(ip, 4)*sx*sx*sy + & + 2.0_dp*a0*fs(ip, 3)*sx*sxy + a0*fs(ip, 3)*sxx*sy + & a0*fs(ip, 2)*sxxy e_rho_ndrho_ndrho(ip) = e_rho_ndrho_ndrho(ip) & - +a1*fs(ip, 3)*sy*sy+a0*fs(ip, 4)*sx*sy*sy+ & + + a1*fs(ip, 3)*sy*sy + a0*fs(ip, 4)*sx*sy*sy + & 2.0_dp*a0*fs(ip, 3)*sxy*sy e_ndrho_ndrho_ndrho(ip) = e_ndrho_ndrho_ndrho(ip) & - +a0*fs(ip, 4)*sy*sy*sy + + a0*fs(ip, 4)*sy*sy*sy END IF @@ -573,61 +573,61 @@ SUBROUTINE efactor_b88(s, fs, m) DO ip = 1, SIZE(s) x = s(ip)*f0 bs = beta*x - sbs = SQRT(x*x+1.0_dp) - as = LOG(x+sbs) + sbs = SQRT(x*x + 1.0_dp) + as = LOG(x + sbs) sas = x*as - ys = 1.0_dp/(1.0_dp+q*sas) + ys = 1.0_dp/(1.0_dp + q*sas) SELECT CASE (m) CASE (0) - fs(ip, 1) = 1.0_dp+p*x*x*ys + fs(ip, 1) = 1.0_dp + p*x*x*ys CASE (1) - asp = as+x/sbs - fs(ip, 1) = 1.0_dp+p*x*x*ys - fs(ip, 2) = (2.0_dp*p*x*ys-p*q*x*x*asp*ys*ys)*f0 + asp = as + x/sbs + fs(ip, 1) = 1.0_dp + p*x*x*ys + fs(ip, 2) = (2.0_dp*p*x*ys - p*q*x*x*asp*ys*ys)*f0 CASE (2) - asp = as+x/sbs + asp = as + x/sbs sbs3 = 1.0_dp/(sbs*sbs*sbs) - fs(ip, 1) = 1.0_dp+p*x*x*ys - fs(ip, 2) = (2.0_dp*p*x*ys-p*q*x*x*asp*ys*ys)*f0 - fs(ip, 3) = -f0*f0*p*ys**3*sbs3*(q*x*x*x*x*(q*sas+5.0_dp & - -2.0_dp*q*sbs)+2.0_dp*(x*x*(q*q*sas & - +3.0_dp*q-sbs)-sbs)) + fs(ip, 1) = 1.0_dp + p*x*x*ys + fs(ip, 2) = (2.0_dp*p*x*ys - p*q*x*x*asp*ys*ys)*f0 + fs(ip, 3) = -f0*f0*p*ys**3*sbs3*(q*x*x*x*x*(q*sas + 5.0_dp & + - 2.0_dp*q*sbs) + 2.0_dp*(x*x*(q*q*sas & + + 3.0_dp*q - sbs) - sbs)) CASE (3) - asp = as+x/sbs + asp = as + x/sbs sbs3 = 1.0_dp/(sbs*sbs*sbs) - fs(ip, 1) = 1.0_dp+p*x*x*ys - fs(ip, 2) = (2.0_dp*p*x*ys-p*q*x*x*asp*ys*ys)*f0 - fs(ip, 3) = -f0*f0*p*ys**3*sbs3*(q*x*x*x*x*(q*sas+5.0_dp & - -2.0_dp*q*sbs)+2.0_dp*(x*x*(q*q*sas & - +3.0_dp*q-sbs)-sbs)) + fs(ip, 1) = 1.0_dp + p*x*x*ys + fs(ip, 2) = (2.0_dp*p*x*ys - p*q*x*x*asp*ys*ys)*f0 + fs(ip, 3) = -f0*f0*p*ys**3*sbs3*(q*x*x*x*x*(q*sas + 5.0_dp & + - 2.0_dp*q*sbs) + 2.0_dp*(x*x*(q*q*sas & + + 3.0_dp*q - sbs) - sbs)) t1 = q*x t2 = x**2 - t4 = SQRT(1+t2) - t5 = x+t4 + t4 = SQRT(1 + t2) + t5 = x + t4 t6 = LOG(t5) - t8 = 1+t1*t6 + t8 = 1 + t1*t6 t9 = t8**2 t10 = 1/t9 t13 = 1/t4 - t15 = 1+t13*x + t15 = 1 + t13*x t16 = 1/t5 - t19 = q*t6+t1*t15*t16 + t19 = q*t6 + t1*t15*t16 t22 = p*x t24 = 1/t9/t8 t25 = t19**2 t32 = t4**2 t34 = 1/t32/t4 - t36 = -t34*t2+t13 + t36 = -t34*t2 + t13 t39 = t15**2 t40 = t5**2 t41 = 1/t40 - t44 = 2*q*t15*t16+t1*t36*t16-t1*t39*t41 + t44 = 2*q*t15*t16 + t1*t36*t16 - t1*t39*t41 t48 = p*t2 t49 = t9**2 t65 = t32**2 - t87 = -6*p*t10*t19+12*t22*t24*t25-6*t22*t10*t44-6*t48/t49*t25*t19+ & - 6*t48*t24*t19*t44-t48*t10*(3*q*t36*t16-3*q*t39*t41+3*t1*(1/t65/t4* & - t2*x-t34*x)*t16-3*t1*t36*t41*t15+2*t1*t39*t15/t40/t5) + t87 = -6*p*t10*t19 + 12*t22*t24*t25 - 6*t22*t10*t44 - 6*t48/t49*t25*t19 + & + 6*t48*t24*t19*t44 - t48*t10*(3*q*t36*t16 - 3*q*t39*t41 + 3*t1*(1/t65/t4* & + t2*x - t34*x)*t16 - 3*t1*t36*t41*t15 + 2*t1*t39*t15/t40/t5) fs(ip, 4) = t87 fs(ip, 4) = f0*f0*f0*fs(ip, 4) @@ -673,38 +673,38 @@ SUBROUTINE efactor_pw86(s, fs, m) s6 = s2*s4 SELECT CASE (m) CASE (0) - p0 = 1.0_dp+t1*s2+t2*s4+t3*s6 + p0 = 1.0_dp + t1*s2 + t2*s4 + t3*s6 fs(ip, 1) = p0**f15 CASE (1) - p0 = 1.0_dp+t1*s2+t2*s4+t3*s6 - p1 = s(ip)*(2.0_dp*t1+4.0_dp*t2*s2+6.0_dp*t3*s4) + p0 = 1.0_dp + t1*s2 + t2*s4 + t3*s6 + p1 = s(ip)*(2.0_dp*t1 + 4.0_dp*t2*s2 + 6.0_dp*t3*s4) p15 = p0**f15 fs(ip, 1) = p15 fs(ip, 2) = f15*p1*p15/p0 CASE (2) - p0 = 1.0_dp+t1*s2+t2*s4+t3*s6 - p1 = s(ip)*(2.0_dp*t1+4.0_dp*t2*s2+6.0_dp*t3*s4) + p0 = 1.0_dp + t1*s2 + t2*s4 + t3*s6 + p1 = s(ip)*(2.0_dp*t1 + 4.0_dp*t2*s2 + 6.0_dp*t3*s4) p15 = p0**f15 fs(ip, 1) = p15 fs(ip, 2) = f15*p1*p15/p0 t9 = p15**2; t10 = t9**2; t12 = t10**2; t13 = t12*t10*t9 t25 = p1*p1 - fs(ip, 3) = -14.0_dp/225.0_dp/t13/p0*t25+ & - 1.0_dp/t13*(2.0_dp*t1+12*t2*s2+30.0_dp*t3*s4)/15.0_dp + fs(ip, 3) = -14.0_dp/225.0_dp/t13/p0*t25 + & + 1.0_dp/t13*(2.0_dp*t1 + 12*t2*s2 + 30.0_dp*t3*s4)/15.0_dp CASE (3) - p0 = 1.0_dp+t1*s2+t2*s4+t3*s6 - p1 = s(ip)*(2.0_dp*t1+4.0_dp*t2*s2+6.0_dp*t3*s4) + p0 = 1.0_dp + t1*s2 + t2*s4 + t3*s6 + p1 = s(ip)*(2.0_dp*t1 + 4.0_dp*t2*s2 + 6.0_dp*t3*s4) p15 = p0**f15 fs(ip, 1) = p15 fs(ip, 2) = f15*p1*p15/p0 t9 = p15**2; t10 = t9**2; t12 = t10**2; t13 = t12*t10*t9 t25 = p1*p1 - fs(ip, 3) = -14.0_dp/225.0_dp/t13/p0*t25+ & - 1.0_dp/t13*(2.0_dp*t1+12*t2*s2+30.0_dp*t3*s4)/15.0_dp + fs(ip, 3) = -14.0_dp/225.0_dp/t13/p0*t25 + & + 1.0_dp/t13*(2.0_dp*t1 + 12*t2*s2 + 30.0_dp*t3*s4)/15.0_dp t8 = p0**2; t9 = p0**f15; t14 = p0/t9; t19 = s2*s(ip) - fs(ip, 4) = 406.0_dp/3375.0_dp/t14/t8*p1*p1*p1-14.0_dp/ & - 75.0_dp/t14/p0*p1*(2*t1+12*t2*s2+30*t3*s4)+ & - 1/t14*(24*t2*s(ip)+120*t3*t19)*f15 + fs(ip, 4) = 406.0_dp/3375.0_dp/t14/t8*p1*p1*p1 - 14.0_dp/ & + 75.0_dp/t14/p0*p1*(2*t1 + 12*t2*s2 + 30*t3*s4) + & + 1/t14*(24*t2*s(ip) + 120*t3*t19)*f15 CASE DEFAULT CPABORT("Illegal order") END SELECT @@ -753,45 +753,45 @@ SUBROUTINE efactor_ev93(s, fs, m) s6 = s2*s4 SELECT CASE (m) CASE (0) - n0 = 1._dp+a1*s2+a2*s4+a3*s6 - d0 = 1._dp+b1*s2+b2*s4+b3*s6 + n0 = 1._dp + a1*s2 + a2*s4 + a3*s6 + d0 = 1._dp + b1*s2 + b2*s4 + b3*s6 fs(ip, 1) = n0/d0 CASE (1) - n0 = 1._dp+a1*s2+a2*s4+a3*s6 - d0 = 1._dp+b1*s2+b2*s4+b3*s6 - n1 = ss*(2._dp*a1+4._dp*a2*s2+6._dp*a3*s4) - d1 = ss*(2._dp*b1+4._dp*b2*s2+6._dp*b3*s4) + n0 = 1._dp + a1*s2 + a2*s4 + a3*s6 + d0 = 1._dp + b1*s2 + b2*s4 + b3*s6 + n1 = ss*(2._dp*a1 + 4._dp*a2*s2 + 6._dp*a3*s4) + d1 = ss*(2._dp*b1 + 4._dp*b2*s2 + 6._dp*b3*s4) f0 = n0/d0 fs(ip, 1) = f0 - fs(ip, 2) = (n1-f0*d1)/d0*scale_s + fs(ip, 2) = (n1 - f0*d1)/d0*scale_s CASE (2) - n0 = 1._dp+a1*s2+a2*s4+a3*s6 - d0 = 1._dp+b1*s2+b2*s4+b3*s6 - n1 = ss*(2._dp*a1+4._dp*a2*s2+6._dp*a3*s4) - d1 = ss*(2._dp*b1+4._dp*b2*s2+6._dp*b3*s4) - n2 = 2._dp*a1+12._dp*a2*s2+30._dp*a3*s4 - d2 = 2._dp*b1+12._dp*b2*s2+30._dp*b3*s4 + n0 = 1._dp + a1*s2 + a2*s4 + a3*s6 + d0 = 1._dp + b1*s2 + b2*s4 + b3*s6 + n1 = ss*(2._dp*a1 + 4._dp*a2*s2 + 6._dp*a3*s4) + d1 = ss*(2._dp*b1 + 4._dp*b2*s2 + 6._dp*b3*s4) + n2 = 2._dp*a1 + 12._dp*a2*s2 + 30._dp*a3*s4 + d2 = 2._dp*b1 + 12._dp*b2*s2 + 30._dp*b3*s4 f0 = n0/d0 - f1 = (n1-f0*d1)/d0 + f1 = (n1 - f0*d1)/d0 fs(ip, 1) = f0 fs(ip, 2) = f1*scale_s - fs(ip, 3) = (n2-f0*d2-2._dp*f1*d1)/d0*scale_s*scale_s + fs(ip, 3) = (n2 - f0*d2 - 2._dp*f1*d1)/d0*scale_s*scale_s CASE (3) - n0 = 1._dp+a1*s2+a2*s4+a3*s6 - d0 = 1._dp+b1*s2+b2*s4+b3*s6 - n1 = ss*(2._dp*a1+4._dp*a2*s2+6._dp*a3*s4) - d1 = ss*(2._dp*b1+4._dp*b2*s2+6._dp*b3*s4) - n2 = 2._dp*a1+12._dp*a2*s2+30._dp*a3*s4 - d2 = 2._dp*b1+12._dp*b2*s2+30._dp*b3*s4 - n3 = ss*(24._dp*a2+120._dp*a3*s2) - d3 = ss*(24._dp*b2+120._dp*b3*s2) + n0 = 1._dp + a1*s2 + a2*s4 + a3*s6 + d0 = 1._dp + b1*s2 + b2*s4 + b3*s6 + n1 = ss*(2._dp*a1 + 4._dp*a2*s2 + 6._dp*a3*s4) + d1 = ss*(2._dp*b1 + 4._dp*b2*s2 + 6._dp*b3*s4) + n2 = 2._dp*a1 + 12._dp*a2*s2 + 30._dp*a3*s4 + d2 = 2._dp*b1 + 12._dp*b2*s2 + 30._dp*b3*s4 + n3 = ss*(24._dp*a2 + 120._dp*a3*s2) + d3 = ss*(24._dp*b2 + 120._dp*b3*s2) f0 = n0/d0 - f1 = (n1-f0*d1)/d0 - f2 = (n2-f0*d2-2._dp*f1*d1)/d0 + f1 = (n1 - f0*d1)/d0 + f2 = (n2 - f0*d2 - 2._dp*f1*d1)/d0 fs(ip, 1) = f0 fs(ip, 2) = f1*scale_s fs(ip, 3) = f2*scale_s*scale_s - fs(ip, 4) = (n3-f0*d3-3._dp*f2*d1-3._dp*f1*d2)/d0*scale_s*scale_s*scale_s + fs(ip, 4) = (n3 - f0*d3 - 3._dp*f2*d1 - 3._dp*f1*d2)/d0*scale_s*scale_s*scale_s CASE DEFAULT CPABORT("Illegal order") END SELECT @@ -828,23 +828,23 @@ SUBROUTINE efactor_optx(s, fs, m) DO ip = 1, SIZE(s) x = s(ip)*f0 a = gamma_bo*x*x - y = 1.0_dp/(1.0_dp+a) + y = 1.0_dp/(1.0_dp + a) SELECT CASE (m) CASE (0) - fs(ip, 1) = a1+b*a*a*y*y + fs(ip, 1) = a1 + b*a*a*y*y CASE (1) - fs(ip, 1) = a1+b*a*a*y*y + fs(ip, 1) = a1 + b*a*a*y*y fs(ip, 2) = 4.0_dp*b*f0*a*gamma_bo*x*y*y*y CASE (2) - fs(ip, 1) = a1+b*a*a*y*y + fs(ip, 1) = a1 + b*a*a*y*y fs(ip, 2) = 4.0_dp*b*f0*a*gamma_bo*x*y*y*y - fs(ip, 3) = -12.0_dp*b*f0*f0*gamma_bo*a*(a-1.0_dp)*y*y*y*y + fs(ip, 3) = -12.0_dp*b*f0*f0*gamma_bo*a*(a - 1.0_dp)*y*y*y*y CASE (3) - fs(ip, 1) = a1+b*a*a*y*y + fs(ip, 1) = a1 + b*a*a*y*y fs(ip, 2) = 4.0_dp*b*f0*a*gamma_bo*x*y*y*y - fs(ip, 3) = -12.0_dp*b*f0*f0*gamma_bo*a*(a-1.0_dp)*y*y*y*y + fs(ip, 3) = -12.0_dp*b*f0*f0*gamma_bo*a*(a - 1.0_dp)*y*y*y*y fs(ip, 4) = 24.0_dp*b*f0*f0*f0*gamma_bo*gamma_bo*x* & - (1.0_dp-5.0_dp*a+2.0_dp*a*a)*y*y*y*y*y + (1.0_dp - 5.0_dp*a + 2.0_dp*a*a)*y*y*y*y*y CASE DEFAULT CPABORT("Illegal order") END SELECT @@ -888,12 +888,12 @@ SUBROUTINE efactor_pw91(s, fs, m) x = s(ip) t3 = b**2 t4 = x**2 - t7 = SQRT(o+t3*t4) - t9 = LOG(b*x+t7) + t7 = SQRT(o + t3*t4) + t9 = LOG(b*x + t7) t10 = a1*x*t9 t12 = EXP(-a4*t4) t17 = t4**2 - fs(ip, 1) = (o+t10+(a2-a3*t12)*t4)/(o+t10+a5*t17) + fs(ip, 1) = (o + t10 + (a2 - a3*t12)*t4)/(o + t10 + a5*t17) END DO !$OMP END DO @@ -907,22 +907,22 @@ SUBROUTINE efactor_pw91(s, fs, m) x = s(ip) t2 = b**2 t3 = x**2 - t6 = SQRT(o+t2*t3) - t7 = b*x+t6 + t6 = SQRT(o + t2*t3) + t7 = b*x + t6 t8 = LOG(t7) t9 = a1*t8 t10 = a1*x - t17 = t10*(b+1/t6*t2*x)/t7 + t17 = t10*(b + 1/t6*t2*x)/t7 t19 = t3*x t21 = EXP(-a4*t3) - t26 = a2-a3*t21 + t26 = a2 - a3*t21 t30 = t10*t8 t31 = t3**2 - t33 = o+t30+a5*t31 + t33 = o + t30 + a5*t31 t38 = t33**2 fs(ip, 2) = & - (t9+t17+2._dp*a3*a4*t19*t21+2._dp*t26*x)/ & - t33-(o+t30+t26*t3)/t38*(t9+t17+4._dp*a5*t19) + (t9 + t17 + 2._dp*a3*a4*t19*t21 + 2._dp*t26*x)/ & + t33 - (o + t30 + t26*t3)/t38*(t9 + t17 + 4._dp*a5*t19) END DO !$OMP END DO @@ -936,16 +936,16 @@ SUBROUTINE efactor_pw91(s, fs, m) x = s(ip) t1 = b**2 t2 = x**2 - t5 = SQRT(o+t1*t2) + t5 = SQRT(o + t1*t2) t7 = o/t5*t1 - t9 = b+t7*x - t12 = b*x+t5 + t9 = b + t7*x + t12 = b*x + t5 t13 = o/t12 t15 = 2._dp*a1*t9*t13 t16 = a1*x t17 = t5**2 t20 = t1**2 - t25 = t16*(-o/t17/t5*t20*t2+t7)*t13 + t25 = t16*(-o/t17/t5*t20*t2 + t7)*t13 t26 = t9**2 t27 = t12**2 t30 = t16*t26/t27 @@ -956,21 +956,21 @@ SUBROUTINE efactor_pw91(s, fs, m) t44 = a3*t33 t47 = LOG(t12) t48 = t16*t47 - t50 = o+t48+a5*t39 + t50 = o + t48 + a5*t39 t53 = a1*t47 t55 = t16*t9*t13 t56 = t2*x - t60 = a2-t44 + t60 = a2 - t44 t64 = t50**2 t65 = o/t64 - t69 = t53+t55+4._dp*a5*t56 - t73 = o+t48+t60*t2 + t69 = t53 + t55 + 4._dp*a5*t56 + t73 = o + t48 + t60*t2 t77 = t69**2 fs(ip, 3) = & - (t15+t25-t30+10._dp*t31*t2*t33-4._dp*a3*t37*t39*t33+ & - 2._dp*a2-2._dp*t44)/t50-2._dp* & - (t53+t55+2._dp*t31*t56*t33+2._dp*t60*x)* & - t65*t69+2._dp*t73/t64/t50*t77-t73*t65*(t15+t25-t30+12._dp*a5*t2) + (t15 + t25 - t30 + 10._dp*t31*t2*t33 - 4._dp*a3*t37*t39*t33 + & + 2._dp*a2 - 2._dp*t44)/t50 - 2._dp* & + (t53 + t55 + 2._dp*t31*t56*t33 + 2._dp*t60*x)* & + t65*t69 + 2._dp*t73/t64/t50*t77 - t73*t65*(t15 + t25 - t30 + 12._dp*a5*t2) END DO !$OMP END DO @@ -984,16 +984,16 @@ SUBROUTINE efactor_pw91(s, fs, m) x = s(ip) t1 = b**2 t2 = x**2 - t5 = SQRT(0.1e1_dp+t1*t2) + t5 = SQRT(0.1e1_dp + t1*t2) t6 = t5**2 t9 = t1**2 t10 = 1/t6/t5*t9 t13 = 1/t5*t1 - t14 = -t10*t2+t13 - t17 = b*x+t5 + t14 = -t10*t2 + t13 + t17 = b*x + t5 t18 = 1/t17 t20 = 3*a1*t14*t18 - t22 = b+t13*x + t22 = b + t13*x t23 = t22**2 t25 = t17**2 t26 = 1/t25 @@ -1001,7 +1001,7 @@ SUBROUTINE efactor_pw91(s, fs, m) t29 = a1*x t30 = t6**2 t35 = t2*x - t40 = 3*t29*(1/t30/t5*t1*t9*t35-t10*x)*t18 + t40 = 3*t29*(1/t30/t5*t1*t9*t35 - t10*x)*t18 t44 = 3*t29*t14*t26*t22 t50 = 2*t29*t23*t22/t25/t17 t51 = a3*a4 @@ -1012,7 +1012,7 @@ SUBROUTINE efactor_pw91(s, fs, m) t64 = t2**2 t70 = LOG(t17) t71 = t29*t70 - t73 = 0.1e1_dp+t71+a5*t64 + t73 = 0.1e1_dp + t71 + a5*t64 t78 = 2*a1*t22*t18 t80 = t29*t14*t18 t82 = t29*t23*t26 @@ -1021,20 +1021,20 @@ SUBROUTINE efactor_pw91(s, fs, m) t94 = 1/t93 t96 = a1*t70 t98 = t29*t18*t22 - t101 = t96+t98+4*a5*t35 - t106 = a2-t90 - t109 = t96+t98+2*t51*t59+2*t106*x + t101 = t96 + t98 + 4*a5*t35 + t106 = a2 - t90 + t109 = t96 + t98 + 2*t51*t59 + 2*t106*x t111 = 1/t93/t73 t113 = t101**2 - t119 = t78+t80-t82+12*a5*t2 - t123 = 0.1e1_dp+t71+t106*t2 + t119 = t78 + t80 - t82 + 12*a5*t2 + t123 = 0.1e1_dp + t71 + t106*t2 t124 = t93**2 fs(ip, 4) = & - (t20-t28+t40-t44+t50+24*t51*x*t53-36._dp*t58*t59+8._dp*a3*t57*a4*t64* & - x*t53)/t73-3._dp*(t78+t80-t82+10._dp*t51*t2*t53- & - 4._dp*t58*t64*t53+2._dp*a2-2._dp*t90)*t94*t101+ & - 6._dp*t109*t111*t113-3._dp*t109*t94*t119-6*t123/t124*t113*t101+ & - 6._dp*t123*t111*t101*t119-t123*t94*(t20-t28+t40-t44+t50+24._dp*a5*x) + (t20 - t28 + t40 - t44 + t50 + 24*t51*x*t53 - 36._dp*t58*t59 + 8._dp*a3*t57*a4*t64* & + x*t53)/t73 - 3._dp*(t78 + t80 - t82 + 10._dp*t51*t2*t53 - & + 4._dp*t58*t64*t53 + 2._dp*a2 - 2._dp*t90)*t94*t101 + & + 6._dp*t109*t111*t113 - 3._dp*t109*t94*t119 - 6*t123/t124*t113*t101 + & + 6._dp*t123*t111*t101*t119 - t123*t94*(t20 - t28 + t40 - t44 + t50 + 24._dp*a5*x) END DO !$OMP END DO @@ -1074,22 +1074,22 @@ SUBROUTINE efactor_pbex(s, fs, m, pset) DO ip = 1, SIZE(s) x = s(ip)*f0 x2 = x*x - y = 1.0_dp/(1.0_dp+mk*x2) + y = 1.0_dp/(1.0_dp + mk*x2) SELECT CASE (m) CASE (0) - fs(ip, 1) = 1.0_dp+mu*x2*y + fs(ip, 1) = 1.0_dp + mu*x2*y CASE (1) - fs(ip, 1) = 1.0_dp+mu*x2*y + fs(ip, 1) = 1.0_dp + mu*x2*y fs(ip, 2) = 2.0_dp*mu*x*y*y*f0 CASE (2) - fs(ip, 1) = 1.0_dp+mu*x2*y + fs(ip, 1) = 1.0_dp + mu*x2*y fs(ip, 2) = 2.0_dp*mu*x*y*y*f0 - fs(ip, 3) = -2.0_dp*mu*(3.0_dp*mk*x2-1.0_dp)*y*y*y*f0*f0 + fs(ip, 3) = -2.0_dp*mu*(3.0_dp*mk*x2 - 1.0_dp)*y*y*y*f0*f0 CASE (3) - fs(ip, 1) = 1.0_dp+mu*x2*y + fs(ip, 1) = 1.0_dp + mu*x2*y fs(ip, 2) = 2.0_dp*mu*x*y*y*f0 - fs(ip, 3) = -2.0_dp*mu*(3.0_dp*mk*x2-1.0_dp)*y*y*y*f0*f0 - fs(ip, 4) = 24.0_dp*mu*mk*x*(mk*x2-1.0_dp)*y*y*y*y*f0*f0*f0 + fs(ip, 3) = -2.0_dp*mu*(3.0_dp*mk*x2 - 1.0_dp)*y*y*y*f0*f0 + fs(ip, 4) = 24.0_dp*mu*mk*x*(mk*x2 - 1.0_dp)*y*y*y*y*f0*f0*f0 CASE DEFAULT CPABORT("Illegal order") END SELECT diff --git a/src/xc/xc_functionals_utilities.F b/src/xc/xc_functionals_utilities.F index e9eeea794c..09059bd73e 100644 --- a/src/xc/xc_functionals_utilities.F +++ b/src/xc/xc_functionals_utilities.F @@ -140,7 +140,7 @@ SUBROUTINE setup_calculation(order, m, calc, tag) calc(0:order) = .TRUE. ELSE calc(-order) = .TRUE. - m(0:3, 2) = m(0:3, 2)-m(0:3, 1)+1 + m(0:3, 2) = m(0:3, 2) - m(0:3, 1) + 1 m(0:3, 1) = 1 END IF @@ -338,11 +338,11 @@ SUBROUTINE calc_fx_array(n, rhoa, rhob, fx, m) !$OMP PARALLEL DO PRIVATE(ip,x,rhoab) DEFAULT(NONE) SHARED(fx,m,eps_rho,n) DO ip = 1, n - rhoab = rhoa(ip)+rhob(ip) + rhoab = rhoa(ip) + rhob(ip) IF (rhoab < eps_rho) THEN fx(ip, 1:m) = 0.0_dp ELSE - x = (rhoa(ip)-rhob(ip))/rhoab + x = (rhoa(ip) - rhob(ip))/rhoab IF (x < -1.0_dp) THEN IF (m >= 0) fx(ip, 1) = 1.0_dp IF (m >= 1) fx(ip, 2) = -f43*fxfac*2.0_dp**f13 @@ -355,14 +355,14 @@ SUBROUTINE calc_fx_array(n, rhoa, rhob, fx, m) IF (m >= 3) fx(ip, 4) = -f23*f13*f43*fxfac/2.0_dp**f53 ELSE IF (m >= 0) & - fx(ip, 1) = ((1.0_dp+x)**f43+(1.0_dp-x)**f43-2.0_dp)*fxfac + fx(ip, 1) = ((1.0_dp + x)**f43 + (1.0_dp - x)**f43 - 2.0_dp)*fxfac IF (m >= 1) & - fx(ip, 2) = ((1.0_dp+x)**f13-(1.0_dp-x)**f13)*fxfac*f43 + fx(ip, 2) = ((1.0_dp + x)**f13 - (1.0_dp - x)**f13)*fxfac*f43 IF (m >= 2) & - fx(ip, 3) = ((1.0_dp+x)**(-f23)+(1.0_dp-x)**(-f23))* & + fx(ip, 3) = ((1.0_dp + x)**(-f23) + (1.0_dp - x)**(-f23))* & fxfac*f43*f13 IF (m >= 3) & - fx(ip, 4) = ((1.0_dp+x)**(-f53)-(1.0_dp-x)**(-f53))* & + fx(ip, 4) = ((1.0_dp + x)**(-f53) - (1.0_dp - x)**(-f53))* & fxfac*f43*f13*(-f23) END IF END IF @@ -393,11 +393,11 @@ SUBROUTINE calc_fx_single(rhoa, rhob, fx, m) REAL(KIND=dp) :: rhoab, x - rhoab = rhoa+rhob + rhoab = rhoa + rhob IF (rhoab < eps_rho) THEN fx(1:m) = 0.0_dp ELSE - x = (rhoa-rhob)/rhoab + x = (rhoa - rhob)/rhoab IF (x < -1.0_dp) THEN IF (m >= 0) fx(1) = 1.0_dp IF (m >= 1) fx(2) = -f43*fxfac*2.0_dp**f13 @@ -410,14 +410,14 @@ SUBROUTINE calc_fx_single(rhoa, rhob, fx, m) IF (m >= 3) fx(4) = -f23*f13*f43*fxfac/2.0_dp**f53 ELSE IF (m >= 0) & - fx(1) = ((1.0_dp+x)**f43+(1.0_dp-x)**f43-2.0_dp)*fxfac + fx(1) = ((1.0_dp + x)**f43 + (1.0_dp - x)**f43 - 2.0_dp)*fxfac IF (m >= 1) & - fx(2) = ((1.0_dp+x)**f13-(1.0_dp-x)**f13)*fxfac*f43 + fx(2) = ((1.0_dp + x)**f13 - (1.0_dp - x)**f13)*fxfac*f43 IF (m >= 2) & - fx(3) = ((1.0_dp+x)**(-f23)+(1.0_dp-x)**(-f23))* & + fx(3) = ((1.0_dp + x)**(-f23) + (1.0_dp - x)**(-f23))* & fxfac*f43*f13 IF (m >= 3) & - fx(4) = ((1.0_dp+x)**(-f53)-(1.0_dp-x)**(-f53))* & + fx(4) = ((1.0_dp + x)**(-f53) - (1.0_dp - x)**(-f53))* & fxfac*f43*f13*(-f23) END IF END IF @@ -439,9 +439,9 @@ SUBROUTINE calc_z(a, b, z, order) REAL(KIND=dp) :: c, d - c = a+b + c = a + b - z(0, 0) = (a-b)/c + z(0, 0) = (a - b)/c IF (order >= 1) THEN d = c*c z(1, 0) = 2.0_dp*b/d @@ -450,14 +450,14 @@ SUBROUTINE calc_z(a, b, z, order) IF (order >= 2) THEN d = d*c z(2, 0) = -4.0_dp*b/d - z(1, 1) = 2.0_dp*(a-b)/d + z(1, 1) = 2.0_dp*(a - b)/d z(0, 2) = 4.0_dp*a/d END IF IF (order >= 3) THEN d = d*c z(3, 0) = 12.0_dp*b/d - z(2, 1) = -4.0_dp*(a-2.0_dp*b)/d - z(1, 2) = -4.0_dp*(2.0_dp*a-b)/d + z(2, 1) = -4.0_dp*(a - 2.0_dp*b)/d + z(1, 2) = -4.0_dp*(2.0_dp*a - b)/d z(0, 3) = -12.0_dp*a/d END IF diff --git a/src/xc/xc_hcth.F b/src/xc/xc_hcth.F index 0f9ceab917..c6f1383667 100644 --- a/src/xc/xc_hcth.F +++ b/src/xc/xc_hcth.F @@ -134,7 +134,7 @@ SUBROUTINE hcth_lda_eval(iparset, rho_set, deriv_set, grad_deriv) CPASSERT(deriv_set%ref_count > 0) CALL xc_rho_set_get(rho_set, rho=rho, & norm_drho=norm_drho, local_bounds=bo, rho_cutoff=epsilon_rho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) IF (grad_deriv >= 0) THEN deriv => xc_dset_get_derivative(deriv_set, "", & @@ -333,35 +333,35 @@ SUBROUTINE hcth_lda_calc(iparset, rho, norm_drho, e_0, e_rho, e_ndrho, & rs = rsfac/rhos13 rs12 = SQRT(rs) - q = 2.0_dp*a1*(beta1(1)+(beta1(2)+(beta1(3)+ & - beta1(4)*rs12)*rs12)*rs12)*rs12 - p = 1.0_dp+1.0_dp/q - x = -2.0_dp*a1*(1.0_dp+alpha1*rs) + q = 2.0_dp*a1*(beta1(1) + (beta1(2) + (beta1(3) + & + beta1(4)*rs12)*rs12)*rs12)*rs12 + p = 1.0_dp + 1.0_dp/q + x = -2.0_dp*a1*(1.0_dp + alpha1*rs) y = LOG(p) g = x*y - dgdrs = -2.0_dp*a1*alpha1*y- & - x*a1*(beta1(1)/rs12+2.0_dp*beta1(2)+ & - 3.0_dp*beta1(3)*rs12+4.0_dp*beta1(4)*rs)/(p*q*q) + dgdrs = -2.0_dp*a1*alpha1*y - & + x*a1*(beta1(1)/rs12 + 2.0_dp*beta1(2) + & + 3.0_dp*beta1(3)*rs12 + 4.0_dp*beta1(4)*rs)/(p*q*q) drsdrho = -f13*rs/my_rho ecss = my_rho*g - vcss = g+my_rho*dgdrs*drsdrho + vcss = g + my_rho*dgdrs*drsdrho ! *** G(rho_alpha,rho_beta) => spin polarisation zeta = 0 *** rs = rsfac/rho13 rs12 = SQRT(rs) - q = 2.0_dp*a0*(beta0(1)+(beta0(2)+(beta0(3)+ & - beta0(4)*rs12)*rs12)*rs12)*rs12 - p = 1.0_dp+1.0_dp/q - x = -2.0_dp*a0*(1.0_dp+alpha0*rs) + q = 2.0_dp*a0*(beta0(1) + (beta0(2) + (beta0(3) + & + beta0(4)*rs12)*rs12)*rs12)*rs12 + p = 1.0_dp + 1.0_dp/q + x = -2.0_dp*a0*(1.0_dp + alpha0*rs) y = LOG(p) g = x*y - dgdrs = -2.0_dp*a0*alpha0*y- & - x*a0*(beta0(1)/rs12+2.0_dp*beta0(2)+ & - 3.0_dp*beta0(3)*rs12+4.0_dp*beta0(4)*rs)/(p*q*q) + dgdrs = -2.0_dp*a0*alpha0*y - & + x*a0*(beta0(1)/rs12 + 2.0_dp*beta0(2) + & + 3.0_dp*beta0(3)*rs12 + 4.0_dp*beta0(4)*rs)/(p*q*q) drsdrho = -f13*rs/my_rho - ecab = my_rho*g-ecss - vcab = g+my_rho*dgdrs*drsdrho-vcss + ecab = my_rho*g - ecss + vcab = g + my_rho*dgdrs*drsdrho - vcss ! *** GGA part (HCTH) *** @@ -373,43 +373,43 @@ SUBROUTINE hcth_lda_calc(iparset, rho, norm_drho, e_0, e_rho, e_ndrho, & ! *** g_x(rho_sigma,rho_sigma) *** gs2 = gamma_xss*s2 - q = 1.0_dp/(1.0_dp+gs2) + q = 1.0_dp/(1.0_dp + gs2) u = gs2*q - gxss = cxss(0)+(cxss(1)+(cxss(2)+(cxss(3)+cxss(4)*u)*u)*u)*u - dgxssds = q*(cxss(1)+(2.0_dp*cxss(2)+(3.0_dp*cxss(3)+ & - 4.0_dp*cxss(4)*u)*u)*u)*u + gxss = cxss(0) + (cxss(1) + (cxss(2) + (cxss(3) + cxss(4)*u)*u)*u)*u + dgxssds = q*(cxss(1) + (2.0_dp*cxss(2) + (3.0_dp*cxss(3) + & + 4.0_dp*cxss(4)*u)*u)*u)*u dgxssdrho = x*dgxssds dgxssddrho = y*dgxssds ! *** g_c(rho_sigma,rho_sigma) *** gs2 = gamma_css*s2 - q = 1.0_dp/(1.0_dp+gs2) + q = 1.0_dp/(1.0_dp + gs2) u = gs2*q - gcss = ccss(0)+(ccss(1)+(ccss(2)+(ccss(3)+ccss(4)*u)*u)*u)*u - dgcssds = q*(ccss(1)+(2.0_dp*ccss(2)+(3.0_dp*ccss(3)+ & - 4.0_dp*ccss(4)*u)*u)*u)*u + gcss = ccss(0) + (ccss(1) + (ccss(2) + (ccss(3) + ccss(4)*u)*u)*u)*u + dgcssds = q*(ccss(1) + (2.0_dp*ccss(2) + (3.0_dp*ccss(3) + & + 4.0_dp*ccss(4)*u)*u)*u)*u dgcssdrho = x*dgcssds dgcssddrho = y*dgcssds ! *** g_c(rho_alpha,rho_beta) *** gs2 = gamma_cab*s2 - q = 1.0_dp/(1.0_dp+gs2) + q = 1.0_dp/(1.0_dp + gs2) u = gs2*q - gcab = ccab(0)+(ccab(1)+(ccab(2)+(ccab(3)+ccab(4)*u)*u)*u)*u - dgcabds = q*(ccab(1)+(2.0_dp*ccab(2)+(3.0_dp*ccab(3)+ & - 4.0_dp*ccab(4)*u)*u)*u)*u + gcab = ccab(0) + (ccab(1) + (ccab(2) + (ccab(3) + ccab(4)*u)*u)*u)*u + dgcabds = q*(ccab(1) + (2.0_dp*ccab(2) + (3.0_dp*ccab(3) + & + 4.0_dp*ccab(4)*u)*u)*u)*u dgcabdrho = x*dgcabds dgcabddrho = y*dgcabds ! *** Finally collect all contributions *** - e_0(ii) = e_0(ii)+exss*gxss+ecss*gcss+ecab*gcab - e_rho(ii) = e_rho(ii)+vxss*gxss+exss*dgxssdrho+ & - vcss*gcss+ecss*dgcssdrho+ & - vcab*gcab+ecab*dgcabdrho - e_ndrho(ii) = e_ndrho(ii)+(exss*dgxssddrho+ecss*dgcssddrho+ecab*dgcabddrho)*drho + e_0(ii) = e_0(ii) + exss*gxss + ecss*gcss + ecab*gcab + e_rho(ii) = e_rho(ii) + vxss*gxss + exss*dgxssdrho + & + vcss*gcss + ecss*dgcssdrho + & + vcab*gcab + ecab*dgcabdrho + e_ndrho(ii) = e_ndrho(ii) + (exss*dgxssddrho + ecss*dgcssddrho + ecab*dgcabddrho)*drho END IF END DO diff --git a/src/xc/xc_ke_gga.F b/src/xc/xc_ke_gga.F index 5ef720ef83..f43a34f94d 100644 --- a/src/xc/xc_ke_gga.F +++ b/src/xc/xc_ke_gga.F @@ -116,8 +116,8 @@ SUBROUTINE ke_gga_info(functional, lsd, reference, shortform, needs, max_deriv) reference = "J.P.Perdew, K.Burke, M.Ernzerhof, Phys. Rev. Letter, 77, 3865 (1996)" END SELECT IF (.NOT. lsd) THEN - IF (LEN_TRIM(reference)+6 < LEN(reference)) THEN - reference(LEN_TRIM(reference):LEN_TRIM(reference)+6) = ' {spin unpolarized}' + IF (LEN_TRIM(reference) + 6 < LEN(reference)) THEN + reference(LEN_TRIM(reference):LEN_TRIM(reference) + 6) = ' {spin unpolarized}' END IF END IF END IF @@ -141,8 +141,8 @@ SUBROUTINE ke_gga_info(functional, lsd, reference, shortform, needs, max_deriv) shortform = "Perdew-Burke-Ernzerhof Functional (kinetic energy)" END SELECT IF (.NOT. lsd) THEN - IF (LEN_TRIM(shortform)+6 < LEN(shortform)) THEN - shortform(LEN_TRIM(shortform):LEN_TRIM(shortform)+6) = ' {spin unpolarized}' + IF (LEN_TRIM(shortform) + 6 < LEN(shortform)) THEN + shortform(LEN_TRIM(shortform):LEN_TRIM(shortform) + 6) = ' {spin unpolarized}' END IF END IF END IF @@ -202,11 +202,11 @@ SUBROUTINE ke_gga_lda_eval(functional, rho_set, deriv_set, order) CALL xc_rho_set_get(rho_set, rho_1_3=rho13, rho=rho, & norm_drho=grho, local_bounds=bo, rho_cutoff=rho_cutoff, & drho_cutoff=drho_cutoff) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) CALL ke_gga_init(rho_cutoff) ALLOCATE (s(npoints)) - ALLOCATE (fs(npoints, m+1)) + ALLOCATE (fs(npoints, m + 1)) ! s = norm_drho/(rho^(4/3)*2*(pi*pi*3)^(1/3)) CALL calc_wave_vector("p", rho, grho, s) @@ -350,12 +350,12 @@ SUBROUTINE ke_gga_lsd_eval(functional, rho_set, deriv_set, order) rhob=rho(2)%array, norm_drhoa=norm_drho(1)%array, & norm_drhob=norm_drho(2)%array, rho_cutoff=rho_cutoff, & local_bounds=bo) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) m = ABS(order) CALL ke_gga_init(rho_cutoff) ALLOCATE (s(npoints)) - ALLOCATE (fs(npoints, m+1)) + ALLOCATE (fs(npoints, m + 1)) fact = flsd b = b_lsd @@ -485,7 +485,7 @@ SUBROUTINE kex_p_0(rho, r13, fs, e_0, npoints) DO ip = 1, npoints IF (rho(ip) > eps_rho) THEN - e_0(ip) = e_0(ip)+fact*r13(ip)*r13(ip)*rho(ip)*fs(ip, 1) + e_0(ip) = e_0(ip) + fact*r13(ip)*r13(ip)*rho(ip)*fs(ip, 1) END IF END DO @@ -527,8 +527,8 @@ SUBROUTINE kex_p_1(rho, r13, s, fs, e_rho, e_ndrho, npoints) a1 = f53*fact*r13(ip)*r13(ip) sx = -f43*s(ip)/rho(ip) sy = sfac*tact/(r13(ip)*rho(ip)) - e_rho(ip) = e_rho(ip)+a1*fs(ip, 1)+a0*fs(ip, 2)*sx - e_ndrho(ip) = e_ndrho(ip)+a0*fs(ip, 2)*sy + e_rho(ip) = e_rho(ip) + a1*fs(ip, 1) + a0*fs(ip, 2)*sx + e_ndrho(ip) = e_ndrho(ip) + a0*fs(ip, 2)*sy END IF @@ -577,11 +577,11 @@ SUBROUTINE kex_p_2(rho, r13, s, fs, e_rho_rho, e_rho_ndrho, e_ndrho_ndrho, & sy = sfac*tact/(r13(ip)*rho(ip)) sxx = 28.0_dp/9.0_dp*s(ip)/(rho(ip)*rho(ip)) sxy = -f43*sfac*tact/(r13(ip)*rho(ip)*rho(ip)) - e_rho_rho(ip) = e_rho_rho(ip)+a2*fs(ip, 1)+2.0_dp*a1*fs(ip, 2)*sx+ & - a0*fs(ip, 3)*sx*sx+a0*fs(ip, 2)*sxx - e_rho_ndrho(ip) = e_rho_ndrho(ip)+a1*fs(ip, 2)*sy+a0*fs(ip, 3)*sx*sy+ & + e_rho_rho(ip) = e_rho_rho(ip) + a2*fs(ip, 1) + 2.0_dp*a1*fs(ip, 2)*sx + & + a0*fs(ip, 3)*sx*sx + a0*fs(ip, 2)*sxx + e_rho_ndrho(ip) = e_rho_ndrho(ip) + a1*fs(ip, 2)*sy + a0*fs(ip, 3)*sx*sy + & a0*fs(ip, 2)*sxy - e_ndrho_ndrho(ip) = e_ndrho_ndrho(ip)+a0*fs(ip, 3)*sy*sy + e_ndrho_ndrho(ip) = e_ndrho_ndrho(ip) + a0*fs(ip, 3)*sy*sy END IF @@ -637,17 +637,17 @@ SUBROUTINE kex_p_3(rho, r13, s, fs, e_rho_rho_rho, e_rho_rho_ndrho, & sxy = -f43*sfac*tact/(r13(ip)*rho(ip)*rho(ip)) sxxx = -280.0_dp/27.0_dp*s(ip)/(rho(ip)*rho(ip)*rho(ip)) sxxy = 28.0_dp/9.0_dp*sfac*tact/(r13(ip)*rho(ip)*rho(ip)*rho(ip)) - e_rho_rho_rho(ip) = e_rho_rho_rho(ip)+a3*fs(ip, 1)+3.0_dp*a2*fs(ip, 2)*sx+ & - 3.0_dp*a1*fs(ip, 3)*sx*sx+3.0_dp*a1*fs(ip, 2)*sxx+ & - a0*fs(ip, 4)*sx*sx*sx+3.0_dp*a0*fs(ip, 3)*sx*sxx+ & + e_rho_rho_rho(ip) = e_rho_rho_rho(ip) + a3*fs(ip, 1) + 3.0_dp*a2*fs(ip, 2)*sx + & + 3.0_dp*a1*fs(ip, 3)*sx*sx + 3.0_dp*a1*fs(ip, 2)*sxx + & + a0*fs(ip, 4)*sx*sx*sx + 3.0_dp*a0*fs(ip, 3)*sx*sxx + & a0*fs(ip, 2)*sxxx - e_rho_rho_ndrho(ip) = e_rho_rho_ndrho(ip)+a2*fs(ip, 2)*sy+2.0_dp*a1*fs(ip, 3)*sx*sy+ & - 2.0_dp*a1*fs(ip, 2)*sxy+a0*fs(ip, 4)*sx*sx*sy+ & - 2.0_dp*a0*fs(ip, 3)*sx*sxy+a0*fs(ip, 3)*sxx*sy+ & + e_rho_rho_ndrho(ip) = e_rho_rho_ndrho(ip) + a2*fs(ip, 2)*sy + 2.0_dp*a1*fs(ip, 3)*sx*sy + & + 2.0_dp*a1*fs(ip, 2)*sxy + a0*fs(ip, 4)*sx*sx*sy + & + 2.0_dp*a0*fs(ip, 3)*sx*sxy + a0*fs(ip, 3)*sxx*sy + & a0*fs(ip, 2)*sxxy - e_rho_ndrho_ndrho(ip) = e_rho_ndrho_ndrho(ip)+a1*fs(ip, 3)*sy*sy+a0*fs(ip, 4)*sx*sy*sy+ & + e_rho_ndrho_ndrho(ip) = e_rho_ndrho_ndrho(ip) + a1*fs(ip, 3)*sy*sy + a0*fs(ip, 4)*sx*sy*sy + & 2.0_dp*a0*fs(ip, 3)*sxy*sy - e_ndrho_ndrho_ndrho(ip) = e_ndrho_ndrho_ndrho(ip)+a0*fs(ip, 4)*sy*sy*sy + e_ndrho_ndrho_ndrho(ip) = e_ndrho_ndrho_ndrho(ip) + a0*fs(ip, 4)*sy*sy*sy END IF @@ -684,13 +684,13 @@ SUBROUTINE efactor_ol1(s, fs, m) DO ip = 1, SIZE(s) SELECT CASE (m) CASE (0) - fs(ip, 1) = 1.0_dp+t1*s(ip)*s(ip)+t2*s(ip) + fs(ip, 1) = 1.0_dp + t1*s(ip)*s(ip) + t2*s(ip) CASE (1) - fs(ip, 1) = 1.0_dp+t1*s(ip)*s(ip)+t2*s(ip) - fs(ip, 2) = 2.0_dp*t1*s(ip)+t2 + fs(ip, 1) = 1.0_dp + t1*s(ip)*s(ip) + t2*s(ip) + fs(ip, 2) = 2.0_dp*t1*s(ip) + t2 CASE (2:3) - fs(ip, 1) = 1.0_dp+t1*s(ip)*s(ip)+t2*s(ip) - fs(ip, 2) = 2.0_dp*t1*s(ip)+t2 + fs(ip, 1) = 1.0_dp + t1*s(ip)*s(ip) + t2*s(ip) + fs(ip, 2) = 2.0_dp*t1*s(ip) + t2 fs(ip, 3) = 2.0_dp*t1 CASE DEFAULT CPABORT("Illegal order.") @@ -727,21 +727,21 @@ SUBROUTINE efactor_ol2(s, fs, m) !$OMP PRIVATE(ip,y) DO ip = 1, SIZE(s) - y = 1.0_dp/(1.0_dp+t3*s(ip)) + y = 1.0_dp/(1.0_dp + t3*s(ip)) SELECT CASE (m) CASE (0) - fs(ip, 1) = 1.0_dp+t1*s(ip)*s(ip)+t2*s(ip)*y + fs(ip, 1) = 1.0_dp + t1*s(ip)*s(ip) + t2*s(ip)*y CASE (1) - fs(ip, 1) = 1.0_dp+t1*s(ip)*s(ip)+t2*s(ip)*y - fs(ip, 2) = 2.0_dp*t1*s(ip)+t2*y*y + fs(ip, 1) = 1.0_dp + t1*s(ip)*s(ip) + t2*s(ip)*y + fs(ip, 2) = 2.0_dp*t1*s(ip) + t2*y*y CASE (2) - fs(ip, 1) = 1.0_dp+t1*s(ip)*s(ip)+t2*s(ip)*y - fs(ip, 2) = 2.0_dp*t1*s(ip)+t2*y*y - fs(ip, 3) = 2.0_dp*(t1-t2*t3*y*y*y) + fs(ip, 1) = 1.0_dp + t1*s(ip)*s(ip) + t2*s(ip)*y + fs(ip, 2) = 2.0_dp*t1*s(ip) + t2*y*y + fs(ip, 3) = 2.0_dp*(t1 - t2*t3*y*y*y) CASE (3) - fs(ip, 1) = 1.0_dp+t1*s(ip)*s(ip)+t2*s(ip)*y - fs(ip, 2) = 2.0_dp*t1*s(ip)+t2*y*y - fs(ip, 3) = 2.0_dp*(t1-t2*t3*y*y*y) + fs(ip, 1) = 1.0_dp + t1*s(ip)*s(ip) + t2*s(ip)*y + fs(ip, 2) = 2.0_dp*t1*s(ip) + t2*y*y + fs(ip, 3) = 2.0_dp*(t1 - t2*t3*y*y*y) fs(ip, 4) = 6.0_dp*t2*t3*t3*y*y*y*y CASE DEFAULT CPABORT("Illegal order.") @@ -782,134 +782,134 @@ SUBROUTINE efactor_llp(s, fs, m) DO ip = 1, SIZE(s) x = s(ip) bs = b*x - sbs = SQRT(bs*bs+1.0_dp) - as = LOG(bs+sbs) + sbs = SQRT(bs*bs + 1.0_dp) + as = LOG(bs + sbs) sas = x*as - ys = 1.0_dp/(1.0_dp+q*sas) + ys = 1.0_dp/(1.0_dp + q*sas) SELECT CASE (m) CASE (0) - fs(ip, 1) = 1.0_dp+p*x*x*ys + fs(ip, 1) = 1.0_dp + p*x*x*ys CASE (1) - fs(ip, 1) = 1.0_dp+p*x*x*ys + fs(ip, 1) = 1.0_dp + p*x*x*ys t2 = q*x t4 = b**2 t5 = x**2 - t8 = SQRT(1.0_dp+t4*t5) - t9 = b*x+t8 + t8 = SQRT(1.0_dp + t4*t5) + t9 = b*x + t8 t10 = LOG(t9) - t12 = 1.0_dp+t2*t10 + t12 = 1.0_dp + t2*t10 t17 = t12**2 - fs(ip, 2) = 2.0_dp*p*x/t12-p*t5/t17*(q*t10+t2*(b+1.0_dp/t8*t4*x)/t9) + fs(ip, 2) = 2.0_dp*p*x/t12 - p*t5/t17*(q*t10 + t2*(b + 1.0_dp/t8*t4*x)/t9) CASE (2) - fs(ip, 1) = 1.0_dp+p*x*x*ys + fs(ip, 1) = 1.0_dp + p*x*x*ys ! first der t2 = q*x t4 = b**2 t5 = x**2 - t8 = SQRT(1.0_dp+t4*t5) - t9 = b*x+t8 + t8 = SQRT(1.0_dp + t4*t5) + t9 = b*x + t8 t10 = LOG(t9) - t12 = 1.0_dp+t2*t10 + t12 = 1.0_dp + t2*t10 t17 = t12**2 - fs(ip, 2) = 2.0_dp*p*x/t12-p*t5/t17*(q*t10+t2*(b+1.0_dp/t8*t4*x)/t9) + fs(ip, 2) = 2.0_dp*p*x/t12 - p*t5/t17*(q*t10 + t2*(b + 1.0_dp/t8*t4*x)/t9) ! second der t1 = q*x t3 = b**2 t4 = x**2 - t7 = SQRT(1.0_dp+t3*t4) - t8 = b*x+t7 + t7 = SQRT(1.0_dp + t3*t4) + t8 = b*x + t7 t9 = LOG(t8) - t11 = 1.0_dp+t1*t9 + t11 = 1.0_dp + t1*t9 t16 = t11**2 t17 = 1.0_dp/t16 t20 = 1.0_dp/t7*t3 - t22 = b+t20*x + t22 = b + t20*x t23 = 1/t8 - t26 = q*t9+t1*t22*t23 + t26 = q*t9 + t1*t22*t23 t30 = p*t4 t33 = t26**2 t40 = t7**2 t43 = t3**2 t49 = t22**2 t50 = t8**2 - fs(ip, 3) = 2.0_dp*p/t11-4.0_dp*p*x*t17*t26+2.0_dp*t30/t16/ & - t11*t33-t30*t17*(2.0_dp*q*t22*t23+t1* & - (-1.0_dp/t40/t7*t43*t4+t20)*t23-t1*t49/t50) + fs(ip, 3) = 2.0_dp*p/t11 - 4.0_dp*p*x*t17*t26 + 2.0_dp*t30/t16/ & + t11*t33 - t30*t17*(2.0_dp*q*t22*t23 + t1* & + (-1.0_dp/t40/t7*t43*t4 + t20)*t23 - t1*t49/t50) CASE (3) - fs(ip, 1) = 1.0_dp+p*x*x*ys + fs(ip, 1) = 1.0_dp + p*x*x*ys ! first der t2 = q*x t4 = b**2 t5 = x**2 - t8 = SQRT(1.0_dp+t4*t5) - t9 = b*x+t8 + t8 = SQRT(1.0_dp + t4*t5) + t9 = b*x + t8 t10 = LOG(t9) - t12 = 1.0_dp+t2*t10 + t12 = 1.0_dp + t2*t10 t17 = t12**2 - fs(ip, 2) = 2.0_dp*p*x/t12-p*t5/t17*(q*t10+t2*(b+1.0_dp/t8*t4*x)/t9) + fs(ip, 2) = 2.0_dp*p*x/t12 - p*t5/t17*(q*t10 + t2*(b + 1.0_dp/t8*t4*x)/t9) ! second der t1 = q*x t3 = b**2 t4 = x**2 - t7 = SQRT(1.0_dp+t3*t4) - t8 = b*x+t7 + t7 = SQRT(1.0_dp + t3*t4) + t8 = b*x + t7 t9 = LOG(t8) - t11 = 1.0_dp+t1*t9 + t11 = 1.0_dp + t1*t9 t16 = t11**2 t17 = 1.0_dp/t16 t20 = 1.0_dp/t7*t3 - t22 = b+t20*x + t22 = b + t20*x t23 = 1/t8 - t26 = q*t9+t1*t22*t23 + t26 = q*t9 + t1*t22*t23 t30 = p*t4 t33 = t26**2 t40 = t7**2 t43 = t3**2 t49 = t22**2 t50 = t8**2 - fs(ip, 3) = 2.0_dp*p/t11-4.0_dp*p*x*t17*t26+2.0_dp*t30/t16/ & - t11*t33-t30*t17*(2.0_dp*q*t22*t23+t1* & - (-1.0_dp/t40/t7*t43*t4+t20)*t23-t1*t49/t50) + fs(ip, 3) = 2.0_dp*p/t11 - 4.0_dp*p*x*t17*t26 + 2.0_dp*t30/t16/ & + t11*t33 - t30*t17*(2.0_dp*q*t22*t23 + t1* & + (-1.0_dp/t40/t7*t43*t4 + t20)*t23 - t1*t49/t50) t1 = q*x t3 = b**2 t4 = x**2 - t7 = SQRT(1+t3*t4) - t8 = b*x+t7 + t7 = SQRT(1 + t3*t4) + t8 = b*x + t7 t9 = LOG(t8) - t11 = 1.0_dp+t1*t9 + t11 = 1.0_dp + t1*t9 t12 = t11**2 t133 = 1.0_dp/t12 t17 = 1.0_dp/t7*t3 - t19 = b+t17*x + t19 = b + t17*x t20 = 1.0_dp/t8 - t23 = q*t9+t1*t19*t20 + t23 = q*t9 + t1*t19*t20 t26 = p*x t28 = 1.0_dp/t12/t11 t29 = t23**2 t36 = t7**2 t39 = t3**2 t40 = 1.0_dp/t36/t7*t39 - t42 = -t40*t4+t17 + t42 = -t40*t4 + t17 t45 = t19**2 t46 = t8**2 t47 = 1.0_dp/t46 - t50 = 2.0_dp*q*t19*t20+t1*t42*t20-t1*t45*t47 + t50 = 2.0_dp*q*t19*t20 + t1*t42*t20 - t1*t45*t47 t54 = p*t4 t55 = t12**2 t71 = t36**2 fs(ip, 4) = & - -6.0_dp*p*t133*t23+12.0_dp*t26*t28*t29- & - 6.0_dp*t26*t133*t50-6.0_dp*t54/t55*t29*t23+ & - 6.0_dp*t54*t28*t23*t50-t54*t133* & - (3.0_dp*q*t42*t20-3.0_dp*q*t45*t47+3.0_dp*t1* & - (1.0_dp/t71/t7*t39*t3*t4*x-t40*x)*t20- & - 3.0_dp*t1*t42*t47*t19+2.0_dp*t1*t45*t19/t46/t8) + -6.0_dp*p*t133*t23 + 12.0_dp*t26*t28*t29 - & + 6.0_dp*t26*t133*t50 - 6.0_dp*t54/t55*t29*t23 + & + 6.0_dp*t54*t28*t23*t50 - t54*t133* & + (3.0_dp*q*t42*t20 - 3.0_dp*q*t45*t47 + 3.0_dp*t1* & + (1.0_dp/t71/t7*t39*t3*t4*x - t40*x)*t20 - & + 3.0_dp*t1*t42*t47*t19 + 2.0_dp*t1*t45*t19/t46/t8) CASE DEFAULT CPABORT("Illegal order.") @@ -956,33 +956,33 @@ SUBROUTINE efactor_pw86(s, fs, m, f2_lsd) s6 = s2*s4 SELECT CASE (m) CASE (0) - p0 = 1.0_dp+t1*s2+t2*s4+t3*s6 + p0 = 1.0_dp + t1*s2 + t2*s4 + t3*s6 fs(ip, 1) = p0**f15 CASE (1) - p0 = 1.0_dp+t1*s2+t2*s4+t3*s6 - p1 = s1*ff*(2.0_dp*t1+4.0_dp*t2*s2+6.0_dp*t3*s4) + p0 = 1.0_dp + t1*s2 + t2*s4 + t3*s6 + p1 = s1*ff*(2.0_dp*t1 + 4.0_dp*t2*s2 + 6.0_dp*t3*s4) p15 = p0**f15 fs(ip, 1) = p15 fs(ip, 2) = f15*p1*p15/p0 CASE (2) - p0 = 1.0_dp+t1*s2+t2*s4+t3*s6 - p1 = s1*ff*(2.0_dp*t1+4.0_dp*t2*s2+6.0_dp*t3*s4) - p2 = ff*ff*(2.0_dp*t1+12.0_dp*t2*s2+30.0_dp*t3*s4) + p0 = 1.0_dp + t1*s2 + t2*s4 + t3*s6 + p1 = s1*ff*(2.0_dp*t1 + 4.0_dp*t2*s2 + 6.0_dp*t3*s4) + p2 = ff*ff*(2.0_dp*t1 + 12.0_dp*t2*s2 + 30.0_dp*t3*s4) p15 = p0**f15 fs(ip, 1) = p15 fs(ip, 2) = f15*p1*p15/p0 - fs(ip, 3) = f15*p15/p0*(p2-14.0_dp/15.0_dp*p1*p1/p0) + fs(ip, 3) = f15*p15/p0*(p2 - 14.0_dp/15.0_dp*p1*p1/p0) CASE (3) - p0 = 1.0_dp+t1*s2+t2*s4+t3*s6 - p1 = s1*ff*(2.0_dp*t1+4.0_dp*t2*s2+6.0_dp*t3*s4) - p2 = ff*ff*(2.0_dp*t1+12.0_dp*t2*s2+30.0_dp*t3*s4) - p3 = s1*ff*ff*ff*(24.0_dp*t2+120.0_dp*t3*s2) + p0 = 1.0_dp + t1*s2 + t2*s4 + t3*s6 + p1 = s1*ff*(2.0_dp*t1 + 4.0_dp*t2*s2 + 6.0_dp*t3*s4) + p2 = ff*ff*(2.0_dp*t1 + 12.0_dp*t2*s2 + 30.0_dp*t3*s4) + p3 = s1*ff*ff*ff*(24.0_dp*t2 + 120.0_dp*t3*s2) p15 = p0**f15 fs(ip, 1) = p15 fs(ip, 2) = f15*p1*p15/p0 - fs(ip, 3) = f15*p15/p0*(p2-14.0_dp/15.0_dp*p1*p1/p0) - fs(ip, 4) = f15*p15/p0*(-14.0_dp*f15*p1*p1/p0+14.0_dp*14.0_dp*f15*p1*p1*p1/p0/p0+ & - p3-14.0_dp*p2*p1/p0+14.0_dp*p1*p1/p0/p0) + fs(ip, 3) = f15*p15/p0*(p2 - 14.0_dp/15.0_dp*p1*p1/p0) + fs(ip, 4) = f15*p15/p0*(-14.0_dp*f15*p1*p1/p0 + 14.0_dp*14.0_dp*f15*p1*p1*p1/p0/p0 + & + p3 - 14.0_dp*p2*p1/p0 + 14.0_dp*p1*p1/p0/p0) CASE DEFAULT CPABORT("Illegal order.") END SELECT @@ -1022,56 +1022,56 @@ SUBROUTINE efactor_t92(s, fs, m) DO ip = 1, SIZE(s) x = s(ip) bs = b*x - sbs = SQRT(bs*bs+1.0_dp) - as = LOG(bs+sbs) + sbs = SQRT(bs*bs + 1.0_dp) + as = LOG(bs + sbs) sas = x*as - ys = 1.0_dp/(1.0_dp+q*sas) + ys = 1.0_dp/(1.0_dp + q*sas) SELECT CASE (m) CASE (0) - fs(ip, 1) = 1.0_dp+p*x*x*ys-a1*x/(1+a2*x) + fs(ip, 1) = 1.0_dp + p*x*x*ys - a1*x/(1 + a2*x) CASE (1) - asp = as+bs/sbs - fs(ip, 1) = 1.0_dp+p*x*x*ys-a1*x/(1+a2*x) - fs(ip, 2) = 2.0_dp*p*x*ys-p*q*x*x*asp*ys*ys-a1/(1+a2*x)**2 + asp = as + bs/sbs + fs(ip, 1) = 1.0_dp + p*x*x*ys - a1*x/(1 + a2*x) + fs(ip, 2) = 2.0_dp*p*x*ys - p*q*x*x*asp*ys*ys - a1/(1 + a2*x)**2 CASE (2) - asp = as+bs/sbs + asp = as + bs/sbs sbs3 = sbs*sbs*sbs - asp2 = 2.0_dp*b/sbs-b*bs*bs/sbs3 - fs(ip, 1) = 1.0_dp+p*x*x*ys-a1*x/(1+a2*x) - fs(ip, 2) = 2.0_dp*p*x*ys-p*q*x*x*asp*ys*ys-a1/(1+a2*x)**2 - fs(ip, 3) = 2.0_dp*p*ys-p*q*x*(4.0_dp*asp+x*asp2)*ys*ys+ & - 2.0_dp*p*q*q*x*x*asp*asp*ys*ys*ys+2.0_dp*a1*a2/(1+a2*x)**3 + asp2 = 2.0_dp*b/sbs - b*bs*bs/sbs3 + fs(ip, 1) = 1.0_dp + p*x*x*ys - a1*x/(1 + a2*x) + fs(ip, 2) = 2.0_dp*p*x*ys - p*q*x*x*asp*ys*ys - a1/(1 + a2*x)**2 + fs(ip, 3) = 2.0_dp*p*ys - p*q*x*(4.0_dp*asp + x*asp2)*ys*ys + & + 2.0_dp*p*q*q*x*x*asp*asp*ys*ys*ys + 2.0_dp*a1*a2/(1 + a2*x)**3 CASE (3) - asp = as+bs/sbs + asp = as + bs/sbs sbs3 = sbs*sbs*sbs sbs5 = sbs3*sbs*sbs - asp2 = 2.0_dp*b/sbs-b*bs*bs/sbs3 - asp3 = -4.0_dp*b*b*bs/sbs3+3.0_dp*b*b*bs*bs*bs/sbs5 - w1 = (4.0_dp*asp+x*asp2) - fs(ip, 1) = 1.0_dp+p*x*x*ys-a1*x/(1+a2*x) - fs(ip, 2) = 2.0_dp*p*x*ys-p*q*x*x*asp*ys*ys-a1/(1+a2*x)**2 - fs(ip, 3) = 2.0_dp*p*ys-p*q*x*w1*ys*ys+ & - 2.0_dp*p*q*q*x*x*asp*asp*ys*ys*ys+2.0_dp*a1*a2/(1+a2*x)**3 - - s2 = -6*p/(1+q*x*LOG(b*x+SQRT(1+b**2*x**2)))**2*(q*LOG(b*x+SQRT(1+b**2*x**2))+ & - q*x*(b+1/SQRT(1+b**2*x**2)*b**2*x)/(b*x+SQRT(1+b**2*x**2)))+12*p*x/ & - (1+q*x*LOG(b*x+SQRT(1+b**2*x**2)))**3*(q*LOG(b*x+SQRT(1+b**2*x**2))+ & - q*x*(b+1/SQRT(1+b**2*x**2)*b**2*x)/(b*x+SQRT(1+b**2*x**2)))**2 - s1 = s2-6*p*x/(1+q*x*LOG(b*x+SQRT(1+b**2*x**2)))**2*(2*q*(b+1/SQRT(1+b**2*x**2)*b**2*x)/ & - (b*x+SQRT(1+b**2*x**2))+q*x*(-1/SQRT(1+b**2*x**2)**3*b**4*x**2+1/SQRT(1+b**2*x**2)*b**2)/ & - (b*x+SQRT(1+b**2*x**2))-q*x*(b+1/SQRT(1+b**2*x**2)*b**2*x)**2/ & - (b*x+SQRT(1+b**2*x**2))**2)-6*p*x**2/(1+q*x*LOG(b*x+SQRT(1+b**2*x**2)))**4 & - *(q*LOG(b*x+SQRT(1+b**2*x**2))+q*x*(b+1/SQRT(1+b**2*x**2)*b**2*x)/(b*x+SQRT(1+b**2*x**2)))**3 - s2 = s1+6*p*x**2/(1+q*x*LOG(b*x+SQRT(1+b**2*x**2)))**3*(q*LOG(b*x+SQRT(1+b**2*x**2))+ & - q*x*(b+1/SQRT(1+b**2*x**2)*b**2*x)/(b*x+SQRT(1+b**2*x**2)))*(2*q*(b+1/SQRT(1+b**2*x**2)*b**2*x) & - /(b*x+SQRT(1+b**2*x**2))+q*x*(-1/SQRT(1+b**2*x**2)**3*b**4*x**2+1/SQRT(1+b**2*x**2)* & - b**2)/(b*x+SQRT(1+b**2*x**2))-q*x*(b+1/SQRT(1+b**2*x**2)*b**2*x)**2/(b*x+SQRT(1+b**2*x**2))**2) - t0 = s2-p*x**2/(1+q*x*LOG(b*x+SQRT(1+b**2*x**2)))**2*(3*q*(-1/SQRT(1+b**2*x**2)**3*b**4*x**2+ & - 1/SQRT(1+b**2*x**2)*b**2)/(b*x+SQRT(1+b**2*x**2))-3*q*(b+1/SQRT(1+b**2*x**2)*b**2*x)**2/ & - (b*x+SQRT(1+b**2*x**2))**2+q*x*(3/SQRT(1+b**2*x**2)**5*b**6*x**3-3/SQRT(1+b**2*x**2)**3*b**4*x)/ & - (b*x+SQRT(1+b**2*x**2))-3*q*x*(-1/SQRT(1+b**2*x**2)**3*b**4*x**2+1/SQRT(1+b**2*x**2)*b**2)/ & - (b*x+SQRT(1+b**2*x**2))**2*(b+1/SQRT(1+b**2*x**2)*b**2*x)+2*q*x*(b+1/SQRT(1+b**2*x**2)* & - b**2*x)**3/(b*x+SQRT(1+b**2*x**2))**3)-6*a1/(1+a2*x)**3*a2**2+6*a1*x/(1+a2*x)**4*a2**3 + asp2 = 2.0_dp*b/sbs - b*bs*bs/sbs3 + asp3 = -4.0_dp*b*b*bs/sbs3 + 3.0_dp*b*b*bs*bs*bs/sbs5 + w1 = (4.0_dp*asp + x*asp2) + fs(ip, 1) = 1.0_dp + p*x*x*ys - a1*x/(1 + a2*x) + fs(ip, 2) = 2.0_dp*p*x*ys - p*q*x*x*asp*ys*ys - a1/(1 + a2*x)**2 + fs(ip, 3) = 2.0_dp*p*ys - p*q*x*w1*ys*ys + & + 2.0_dp*p*q*q*x*x*asp*asp*ys*ys*ys + 2.0_dp*a1*a2/(1 + a2*x)**3 + + s2 = -6*p/(1 + q*x*LOG(b*x + SQRT(1 + b**2*x**2)))**2*(q*LOG(b*x + SQRT(1 + b**2*x**2)) + & + q*x*(b + 1/SQRT(1 + b**2*x**2)*b**2*x)/(b*x + SQRT(1 + b**2*x**2))) + 12*p*x/ & + (1 + q*x*LOG(b*x + SQRT(1 + b**2*x**2)))**3*(q*LOG(b*x + SQRT(1 + b**2*x**2)) + & + q*x*(b + 1/SQRT(1 + b**2*x**2)*b**2*x)/(b*x + SQRT(1 + b**2*x**2)))**2 + s1 = s2 - 6*p*x/(1 + q*x*LOG(b*x + SQRT(1 + b**2*x**2)))**2*(2*q*(b + 1/SQRT(1 + b**2*x**2)*b**2*x)/ & + (b*x + SQRT(1 + b**2*x**2)) + q*x*(-1/SQRT(1 + b**2*x**2)**3*b**4*x**2 + 1/SQRT(1 + b**2*x**2)*b**2)/ & + (b*x + SQRT(1 + b**2*x**2)) - q*x*(b + 1/SQRT(1 + b**2*x**2)*b**2*x)**2/ & + (b*x + SQRT(1 + b**2*x**2))**2) - 6*p*x**2/(1 + q*x*LOG(b*x + SQRT(1 + b**2*x**2)))**4 & + *(q*LOG(b*x + SQRT(1 + b**2*x**2)) + q*x*(b + 1/SQRT(1 + b**2*x**2)*b**2*x)/(b*x + SQRT(1 + b**2*x**2)))**3 + s2 = s1 + 6*p*x**2/(1 + q*x*LOG(b*x + SQRT(1 + b**2*x**2)))**3*(q*LOG(b*x + SQRT(1 + b**2*x**2)) + & + q*x*(b + 1/SQRT(1 + b**2*x**2)*b**2*x)/(b*x + SQRT(1 + b**2*x**2)))*(2*q*(b + 1/SQRT(1 + b**2*x**2)*b**2*x) & + /(b*x + SQRT(1 + b**2*x**2)) + q*x*(-1/SQRT(1 + b**2*x**2)**3*b**4*x**2 + 1/SQRT(1 + b**2*x**2)* & + b**2)/(b*x + SQRT(1 + b**2*x**2)) - q*x*(b + 1/SQRT(1 + b**2*x**2)*b**2*x)**2/(b*x + SQRT(1 + b**2*x**2))**2) + t0 = s2 - p*x**2/(1 + q*x*LOG(b*x + SQRT(1 + b**2*x**2)))**2*(3*q*(-1/SQRT(1 + b**2*x**2)**3*b**4*x**2 + & + 1/SQRT(1 + b**2*x**2)*b**2)/(b*x + SQRT(1 + b**2*x**2)) - 3*q*(b + 1/SQRT(1 + b**2*x**2)*b**2*x)**2/ & + (b*x + SQRT(1 + b**2*x**2))**2 + q*x*(3/SQRT(1 + b**2*x**2)**5*b**6*x**3 - 3/SQRT(1 + b**2*x**2)**3*b**4*x)/ & + (b*x + SQRT(1 + b**2*x**2)) - 3*q*x*(-1/SQRT(1 + b**2*x**2)**3*b**4*x**2 + 1/SQRT(1 + b**2*x**2)*b**2)/ & + (b*x + SQRT(1 + b**2*x**2))**2*(b + 1/SQRT(1 + b**2*x**2)*b**2*x) + 2*q*x*(b + 1/SQRT(1 + b**2*x**2)* & + b**2*x)**3/(b*x + SQRT(1 + b**2*x**2))**3) - 6*a1/(1 + a2*x)**3*a2**2 + 6*a1*x/(1 + a2*x)**4*a2**3 fs(ip, 4) = t0 @@ -1118,22 +1118,22 @@ SUBROUTINE efactor_pbex(s, fs, m, pset, f2_lsd) DO ip = 1, SIZE(s) x = s(ip)*f0 x2 = x*x - y = 1.0_dp/(1.0_dp+mk*x2) + y = 1.0_dp/(1.0_dp + mk*x2) SELECT CASE (m) CASE (0) - fs(ip, 1) = 1.0_dp+mu*x2*y + fs(ip, 1) = 1.0_dp + mu*x2*y CASE (1) - fs(ip, 1) = 1.0_dp+mu*x2*y + fs(ip, 1) = 1.0_dp + mu*x2*y fs(ip, 2) = 2.0_dp*mu*x*y*y*f0 CASE (2) - fs(ip, 1) = 1.0_dp+mu*x2*y + fs(ip, 1) = 1.0_dp + mu*x2*y fs(ip, 2) = 2.0_dp*mu*x*y*y*f0 - fs(ip, 3) = -2.0_dp*mu*(3.0_dp*mk*x2-1.0_dp)*y*y*y*f0*f0 + fs(ip, 3) = -2.0_dp*mu*(3.0_dp*mk*x2 - 1.0_dp)*y*y*y*f0*f0 CASE (3) - fs(ip, 1) = 1.0_dp+mu*x2*y + fs(ip, 1) = 1.0_dp + mu*x2*y fs(ip, 2) = 2.0_dp*mu*x*y*y*f0 - fs(ip, 3) = -2.0_dp*mu*(3.0_dp*mk*x2-1.0_dp)*y*y*y*f0*f0 - fs(ip, 4) = 24.0_dp*mu*mk*x*(mk*x2-1.0_dp)*y*y*y*y*f0*f0*f0 + fs(ip, 3) = -2.0_dp*mu*(3.0_dp*mk*x2 - 1.0_dp)*y*y*y*f0*f0 + fs(ip, 4) = 24.0_dp*mu*mk*x*(mk*x2 - 1.0_dp)*y*y*y*y*f0*f0*f0 CASE DEFAULT CPABORT("Illegal order.") END SELECT @@ -1200,12 +1200,12 @@ SUBROUTINE efactor_pw91(s, fs, m, pset, f2_lsd) x = s(ip) t3 = bb**2 t4 = x**2 - t7 = SQRT(o+t3*t4) - t9 = LOG(bb*x+t7) + t7 = SQRT(o + t3*t4) + t9 = LOG(bb*x + t7) t10 = a1*x*t9 t12 = EXP(-a4*t4) t17 = t4**2 - fs(ip, 1) = (o+t10+(a2-a3*t12)*t4)/(o+t10+a5*t17) + fs(ip, 1) = (o + t10 + (a2 - a3*t12)*t4)/(o + t10 + a5*t17) END DO !$OMP END DO END IF @@ -1215,22 +1215,22 @@ SUBROUTINE efactor_pw91(s, fs, m, pset, f2_lsd) x = s(ip) t2 = bb**2 t3 = x**2 - t6 = SQRT(o+t2*t3) - t7 = bb*x+t6 + t6 = SQRT(o + t2*t3) + t7 = bb*x + t6 t8 = LOG(t7) t9 = a1*t8 t10 = a1*x - t17 = t10*(bb+1/t6*t2*x)/t7 + t17 = t10*(bb + 1/t6*t2*x)/t7 t19 = t3*x t21 = EXP(-a4*t3) - t26 = a2-a3*t21 + t26 = a2 - a3*t21 t30 = t10*t8 t31 = t3**2 - t33 = o+t30+a5*t31 + t33 = o + t30 + a5*t31 t38 = t33**2 fs(ip, 2) = & - (t9+t17+2._dp*a3*a4*t19*t21+2._dp*t26*x)/ & - t33-(o+t30+t26*t3)/t38*(t9+t17+4._dp*a5*t19) + (t9 + t17 + 2._dp*a3*a4*t19*t21 + 2._dp*t26*x)/ & + t33 - (o + t30 + t26*t3)/t38*(t9 + t17 + 4._dp*a5*t19) END DO !$OMP END DO END IF @@ -1240,16 +1240,16 @@ SUBROUTINE efactor_pw91(s, fs, m, pset, f2_lsd) x = s(ip) t1 = bb**2 t2 = x**2 - t5 = SQRT(o+t1*t2) + t5 = SQRT(o + t1*t2) t7 = o/t5*t1 - t9 = bb+t7*x - t12 = bb*x+t5 + t9 = bb + t7*x + t12 = bb*x + t5 t13 = o/t12 t15 = 2._dp*a1*t9*t13 t16 = a1*x t17 = t5**2 t20 = t1**2 - t25 = t16*(-o/t17/t5*t20*t2+t7)*t13 + t25 = t16*(-o/t17/t5*t20*t2 + t7)*t13 t26 = t9**2 t27 = t12**2 t30 = t16*t26/t27 @@ -1260,21 +1260,21 @@ SUBROUTINE efactor_pw91(s, fs, m, pset, f2_lsd) t44 = a3*t33 t47 = LOG(t12) t48 = t16*t47 - t50 = o+t48+a5*t39 + t50 = o + t48 + a5*t39 t53 = a1*t47 t55 = t16*t9*t13 t56 = t2*x - t60 = a2-t44 + t60 = a2 - t44 t64 = t50**2 t65 = o/t64 - t69 = t53+t55+4._dp*a5*t56 - t73 = o+t48+t60*t2 + t69 = t53 + t55 + 4._dp*a5*t56 + t73 = o + t48 + t60*t2 t77 = t69**2 fs(ip, 3) = & - (t15+t25-t30+10._dp*t31*t2*t33-4._dp*a3*t37*t39*t33+ & - 2._dp*a2-2._dp*t44)/t50-2._dp* & - (t53+t55+2._dp*t31*t56*t33+2._dp*t60*x)* & - t65*t69+2._dp*t73/t64/t50*t77-t73*t65*(t15+t25-t30+12._dp*a5*t2) + (t15 + t25 - t30 + 10._dp*t31*t2*t33 - 4._dp*a3*t37*t39*t33 + & + 2._dp*a2 - 2._dp*t44)/t50 - 2._dp* & + (t53 + t55 + 2._dp*t31*t56*t33 + 2._dp*t60*x)* & + t65*t69 + 2._dp*t73/t64/t50*t77 - t73*t65*(t15 + t25 - t30 + 12._dp*a5*t2) END DO !$OMP END DO END IF @@ -1284,16 +1284,16 @@ SUBROUTINE efactor_pw91(s, fs, m, pset, f2_lsd) x = s(ip) t1 = bb**2 t2 = x**2 - t5 = SQRT(0.1e1_dp+t1*t2) + t5 = SQRT(0.1e1_dp + t1*t2) t6 = t5**2 t9 = t1**2 t10 = 1/t6/t5*t9 t13 = 1/t5*t1 - t14 = -t10*t2+t13 - t17 = bb*x+t5 + t14 = -t10*t2 + t13 + t17 = bb*x + t5 t18 = 1/t17 t20 = 3*a1*t14*t18 - t22 = bb+t13*x + t22 = bb + t13*x t23 = t22**2 t25 = t17**2 t26 = 1/t25 @@ -1301,7 +1301,7 @@ SUBROUTINE efactor_pw91(s, fs, m, pset, f2_lsd) t29 = a1*x t30 = t6**2 t35 = t2*x - t40 = 3*t29*(1/t30/t5*t1*t9*t35-t10*x)*t18 + t40 = 3*t29*(1/t30/t5*t1*t9*t35 - t10*x)*t18 t44 = 3*t29*t14*t26*t22 t50 = 2*t29*t23*t22/t25/t17 t51 = a3*a4 @@ -1312,7 +1312,7 @@ SUBROUTINE efactor_pw91(s, fs, m, pset, f2_lsd) t64 = t2**2 t70 = LOG(t17) t71 = t29*t70 - t73 = 0.1e1_dp+t71+a5*t64 + t73 = 0.1e1_dp + t71 + a5*t64 t78 = 2*a1*t22*t18 t80 = t29*t14*t18 t82 = t29*t23*t26 @@ -1321,20 +1321,20 @@ SUBROUTINE efactor_pw91(s, fs, m, pset, f2_lsd) t94 = 1/t93 t96 = a1*t70 t98 = t29*t18*t22 - t101 = t96+t98+4*a5*t35 - t106 = a2-t90 - t109 = t96+t98+2*t51*t59+2*t106*x + t101 = t96 + t98 + 4*a5*t35 + t106 = a2 - t90 + t109 = t96 + t98 + 2*t51*t59 + 2*t106*x t111 = 1/t93/t73 t113 = t101**2 - t119 = t78+t80-t82+12*a5*t2 - t123 = 0.1e1_dp+t71+t106*t2 + t119 = t78 + t80 - t82 + 12*a5*t2 + t123 = 0.1e1_dp + t71 + t106*t2 t124 = t93**2 fs(ip, 4) = & - (t20-t28+t40-t44+t50+24*t51*x*t53-36._dp*t58*t59+8._dp*a3*t57*a4*t64* & - x*t53)/t73-3._dp*(t78+t80-t82+10._dp*t51*t2*t53- & - 4._dp*t58*t64*t53+2._dp*a2-2._dp*t90)*t94*t101+ & - 6._dp*t109*t111*t113-3._dp*t109*t94*t119-6*t123/t124*t113*t101+ & - 6._dp*t123*t111*t101*t119-t123*t94*(t20-t28+t40-t44+t50+24._dp*a5*x) + (t20 - t28 + t40 - t44 + t50 + 24*t51*x*t53 - 36._dp*t58*t59 + 8._dp*a3*t57*a4*t64* & + x*t53)/t73 - 3._dp*(t78 + t80 - t82 + 10._dp*t51*t2*t53 - & + 4._dp*t58*t64*t53 + 2._dp*a2 - 2._dp*t90)*t94*t101 + & + 6._dp*t109*t111*t113 - 3._dp*t109*t94*t119 - 6*t123/t124*t113*t101 + & + 6._dp*t123*t111*t101*t119 - t123*t94*(t20 - t28 + t40 - t44 + t50 + 24._dp*a5*x) END DO !$OMP END DO END IF diff --git a/src/xc/xc_libxc.F b/src/xc/xc_libxc.F index 7d4f8f6320..8357080267 100644 --- a/src/xc/xc_libxc.F +++ b/src/xc/xc_libxc.F @@ -25,61 +25,61 @@ ! ************************************************************************************************** MODULE xc_libxc USE bibliography, ONLY: Lehtola2018, & - Marques2012, & - cite_reference + Marques2012, & + cite_reference USE input_section_types, ONLY: section_vals_type, & - section_vals_val_get + section_vals_val_get USE kinds, ONLY: default_string_length, & - dp + dp USE xc_derivative_set_types, ONLY: xc_derivative_set_type, & - xc_dset_get_derivative + xc_dset_get_derivative USE xc_derivative_types, ONLY: xc_derivative_get, & - xc_derivative_type + xc_derivative_type USE xc_rho_cflags_types, ONLY: xc_rho_cflags_type USE xc_rho_set_types, ONLY: xc_rho_set_get, & - xc_rho_set_type + xc_rho_set_type #if defined (__LIBXC) USE xc_libxc_wrap, ONLY: xc_f03_func_t, & - xc_f03_func_init, & - xc_f03_func_end, & - xc_f03_func_info_t, & - xc_f03_func_get_info, & - xc_f03_func_info_get_family, & - xc_f03_func_info_get_kind, & - xc_f03_func_info_get_name, & - xc_f03_gga_exc, & - xc_f03_gga_exc_vxc, & - xc_f03_gga_fxc, & - xc_f03_gga_vxc, & - xc_f03_lda, & - xc_f03_lda_exc, & - xc_f03_lda_exc_vxc, & - xc_f03_lda_fxc, & - xc_f03_lda_kxc, & - xc_f03_lda_vxc, & - xc_f03_mgga, & - xc_f03_mgga_exc, & - xc_f03_mgga_exc_vxc, & - xc_f03_mgga_fxc, & - xc_f03_mgga_vxc, & - XC_POLARIZED, & - XC_UNPOLARIZED, & - XC_FAMILY_LDA, & - XC_FAMILY_GGA, & - XC_FAMILY_MGGA, & - XC_FAMILY_HYB_GGA, & - XC_FAMILY_HYB_MGGA, & - XC_CORRELATION, & - XC_EXCHANGE, & - XC_EXCHANGE_CORRELATION, & - XC_KINETIC, & - xc_libxc_wrap_info_refs, & - xc_libxc_wrap_version, & - xc_libxc_wrap_functional_get_number, & - xc_libxc_wrap_needs_laplace, & - xc_libxc_wrap_functional_set_params, & - xc_libxc_wrap_is_under_development + xc_f03_func_init, & + xc_f03_func_end, & + xc_f03_func_info_t, & + xc_f03_func_get_info, & + xc_f03_func_info_get_family, & + xc_f03_func_info_get_kind, & + xc_f03_func_info_get_name, & + xc_f03_gga_exc, & + xc_f03_gga_exc_vxc, & + xc_f03_gga_fxc, & + xc_f03_gga_vxc, & + xc_f03_lda, & + xc_f03_lda_exc, & + xc_f03_lda_exc_vxc, & + xc_f03_lda_fxc, & + xc_f03_lda_kxc, & + xc_f03_lda_vxc, & + xc_f03_mgga, & + xc_f03_mgga_exc, & + xc_f03_mgga_exc_vxc, & + xc_f03_mgga_fxc, & + xc_f03_mgga_vxc, & + XC_POLARIZED, & + XC_UNPOLARIZED, & + XC_FAMILY_LDA, & + XC_FAMILY_GGA, & + XC_FAMILY_MGGA, & + XC_FAMILY_HYB_GGA, & + XC_FAMILY_HYB_MGGA, & + XC_CORRELATION, & + XC_EXCHANGE, & + XC_EXCHANGE_CORRELATION, & + XC_KINETIC, & + xc_libxc_wrap_info_refs, & + xc_libxc_wrap_version, & + xc_libxc_wrap_functional_get_number, & + xc_libxc_wrap_needs_laplace, & + xc_libxc_wrap_functional_set_params, & + xc_libxc_wrap_is_under_development #endif #include "../base/base_uses.f90" @@ -131,7 +131,7 @@ SUBROUTINE libxc_lda_info(libxc_params, reference, shortform, needs, max_deriv, CALL cite_reference(Marques2012) CALL cite_reference(Lehtola2018) - IF (ABS(func_scale-1.0_dp) < 1.0e-10_dp) func_scale = 1.0_dp + IF (ABS(func_scale - 1.0_dp) < 1.0e-10_dp) func_scale = 1.0_dp func_id = xc_libxc_wrap_functional_get_number(func_name) !$OMP CRITICAL(libxc_init) @@ -141,7 +141,7 @@ SUBROUTINE libxc_lda_info(libxc_params, reference, shortform, needs, max_deriv, !$OMP BARRIER s1 = xc_f03_func_info_get_name(xc_info) - SELECT CASE (xc_f03_func_info_get_kind (xc_info)) + SELECT CASE (xc_f03_func_info_get_kind(xc_info)) CASE (XC_EXCHANGE); WRITE (s2, '(a)') "exchange" CASE (XC_CORRELATION); WRITE (s2, '(a)') "correlation" CASE (XC_EXCHANGE_CORRELATION); WRITE (s2, '(a)') "exchange-correlation" @@ -156,7 +156,7 @@ SUBROUTINE libxc_lda_info(libxc_params, reference, shortform, needs, max_deriv, CALL xc_libxc_wrap_info_refs(xc_info, XC_UNPOLARIZED, func_scale, reference) END IF IF (PRESENT(needs)) THEN - SELECT CASE (xc_f03_func_info_get_family (xc_info)) + SELECT CASE (xc_f03_func_info_get_family(xc_info)) CASE (XC_FAMILY_LDA) needs%rho = .TRUE. CASE (XC_FAMILY_GGA, XC_FAMILY_HYB_GGA) @@ -172,7 +172,7 @@ SUBROUTINE libxc_lda_info(libxc_params, reference, shortform, needs, max_deriv, END SELECT END IF IF (PRESENT(max_deriv)) THEN - SELECT CASE (xc_f03_func_info_get_family (xc_info)) + SELECT CASE (xc_f03_func_info_get_family(xc_info)) CASE (XC_FAMILY_LDA) max_deriv = 3 CASE (XC_FAMILY_GGA, XC_FAMILY_HYB_GGA) @@ -239,7 +239,7 @@ SUBROUTINE libxc_lsd_info(libxc_params, reference, shortform, needs, max_deriv, CALL cite_reference(Marques2012) CALL cite_reference(Lehtola2018) - IF (ABS(func_scale-1.0_dp) < 1.0e-10_dp) func_scale = 1.0_dp + IF (ABS(func_scale - 1.0_dp) < 1.0e-10_dp) func_scale = 1.0_dp func_id = xc_libxc_wrap_functional_get_number(func_name) !$OMP CRITICAL(libxc_init) @@ -249,7 +249,7 @@ SUBROUTINE libxc_lsd_info(libxc_params, reference, shortform, needs, max_deriv, !$OMP BARRIER s1 = xc_f03_func_info_get_name(xc_info) - SELECT CASE (xc_f03_func_info_get_kind (xc_info)) + SELECT CASE (xc_f03_func_info_get_kind(xc_info)) CASE (XC_EXCHANGE); WRITE (s2, '(a)') "exchange" CASE (XC_CORRELATION); WRITE (s2, '(a)') "correlation" CASE (XC_EXCHANGE_CORRELATION); WRITE (s2, '(a)') "exchange-correlation" @@ -264,7 +264,7 @@ SUBROUTINE libxc_lsd_info(libxc_params, reference, shortform, needs, max_deriv, CALL xc_libxc_wrap_info_refs(xc_info, XC_POLARIZED, func_scale, reference) END IF IF (PRESENT(needs)) THEN - SELECT CASE (xc_f03_func_info_get_family (xc_info)) + SELECT CASE (xc_f03_func_info_get_family(xc_info)) CASE (XC_FAMILY_LDA) needs%rho_spin = .TRUE. CASE (XC_FAMILY_GGA, XC_FAMILY_HYB_GGA) @@ -282,7 +282,7 @@ SUBROUTINE libxc_lsd_info(libxc_params, reference, shortform, needs, max_deriv, END SELECT END IF IF (PRESENT(max_deriv)) THEN - SELECT CASE (xc_f03_func_info_get_family (xc_info)) + SELECT CASE (xc_f03_func_info_get_family(xc_info)) CASE (XC_FAMILY_LDA) max_deriv = 3 CASE (XC_FAMILY_GGA, XC_FAMILY_HYB_GGA) @@ -384,7 +384,7 @@ SUBROUTINE libxc_lda_eval(rho_set, deriv_set, grad_deriv, libxc_params) CALL section_vals_val_get(libxc_params, "scale", r_val=func_scale) CALL section_vals_val_get(libxc_params, "parameters", r_vals=params) - IF (ABS(func_scale-1.0_dp) < 1.0e-10_dp) func_scale = 1.0_dp + IF (ABS(func_scale - 1.0_dp) < 1.0e-10_dp) func_scale = 1.0_dp func_id = xc_libxc_wrap_functional_get_number(func_name) !$OMP CRITICAL(libxc_init) @@ -398,7 +398,7 @@ SUBROUTINE libxc_lda_eval(rho_set, deriv_set, grad_deriv, libxc_params) rho_cutoff=epsilon_rho, tau_cutoff=epsilon_tau, & tau=tau, local_bounds=bo) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rho @@ -434,7 +434,7 @@ SUBROUTINE libxc_lda_eval(rho_set, deriv_set, grad_deriv, libxc_params) CALL xc_derivative_get(deriv, deriv_data=e_0) END IF IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN - SELECT CASE (xc_f03_func_info_get_family (xc_info)) + SELECT CASE (xc_f03_func_info_get_family(xc_info)) CASE (XC_FAMILY_LDA) deriv => xc_dset_get_derivative(deriv_set, "(rho)", & allocate_deriv=.TRUE.) @@ -466,7 +466,7 @@ SUBROUTINE libxc_lda_eval(rho_set, deriv_set, grad_deriv, libxc_params) END SELECT END IF IF (grad_deriv >= 2 .OR. grad_deriv == -2) THEN - SELECT CASE (xc_f03_func_info_get_family (xc_info)) + SELECT CASE (xc_f03_func_info_get_family(xc_info)) CASE (XC_FAMILY_LDA) deriv => xc_dset_get_derivative(deriv_set, "(rho)(rho)", & allocate_deriv=.TRUE.) @@ -522,7 +522,7 @@ SUBROUTINE libxc_lda_eval(rho_set, deriv_set, grad_deriv, libxc_params) END SELECT END IF IF (grad_deriv >= 3 .OR. grad_deriv == -3) THEN - SELECT CASE (xc_f03_func_info_get_family (xc_info)) + SELECT CASE (xc_f03_func_info_get_family(xc_info)) CASE (XC_FAMILY_LDA) deriv => xc_dset_get_derivative(deriv_set, "(rho)(rho)(rho)", & allocate_deriv=.TRUE.) @@ -643,7 +643,7 @@ SUBROUTINE libxc_lsd_eval(rho_set, deriv_set, grad_deriv, libxc_params) CALL section_vals_val_get(libxc_params, "scale", r_val=func_scale) CALL section_vals_val_get(libxc_params, "parameters", r_vals=params) - IF (ABS(func_scale-1.0_dp) < 1.0e-10_dp) func_scale = 1.0_dp + IF (ABS(func_scale - 1.0_dp) < 1.0e-10_dp) func_scale = 1.0_dp func_id = xc_libxc_wrap_functional_get_number(func_name) !$OMP CRITICAL(libxc_init) @@ -659,7 +659,7 @@ SUBROUTINE libxc_lsd_eval(rho_set, deriv_set, grad_deriv, libxc_params) rho_cutoff=epsilon_rho, tau_cutoff=epsilon_tau, & tau_a=tau_a, tau_b=tau_b, local_bounds=bo) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rhoa @@ -742,7 +742,7 @@ SUBROUTINE libxc_lsd_eval(rho_set, deriv_set, grad_deriv, libxc_params) CALL xc_derivative_get(deriv, deriv_data=e_0) END IF IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN - SELECT CASE (xc_f03_func_info_get_family (xc_info)) + SELECT CASE (xc_f03_func_info_get_family(xc_info)) CASE (XC_FAMILY_LDA) deriv => xc_dset_get_derivative(deriv_set, "(rhoa)", & allocate_deriv=.TRUE.) @@ -801,7 +801,7 @@ SUBROUTINE libxc_lsd_eval(rho_set, deriv_set, grad_deriv, libxc_params) END SELECT END IF IF (grad_deriv >= 2 .OR. grad_deriv == -2) THEN - SELECT CASE (xc_f03_func_info_get_family (xc_info)) + SELECT CASE (xc_f03_func_info_get_family(xc_info)) CASE (XC_FAMILY_LDA) deriv => xc_dset_get_derivative(deriv_set, "(rhoa)(rhoa)", & allocate_deriv=.TRUE.) @@ -1004,7 +1004,7 @@ SUBROUTINE libxc_lsd_eval(rho_set, deriv_set, grad_deriv, libxc_params) END SELECT END IF IF (grad_deriv >= 3 .OR. grad_deriv == -3) THEN - SELECT CASE (xc_f03_func_info_get_family (xc_info)) + SELECT CASE (xc_f03_func_info_get_family(xc_info)) CASE (XC_FAMILY_LDA) deriv => xc_dset_get_derivative(deriv_set, "(rhoa)(rhoa)(rhoa)", & allocate_deriv=.TRUE.) @@ -1187,14 +1187,14 @@ SUBROUTINE libxc_lda_calc(rho, norm_drho, laplace_rho, tau, & CALL xc_libxc_wrap_functional_set_params(xc_func, xc_info, params, no_exc) !$OMP END CRITICAL(libxc_init) !$OMP BARRIER - SELECT CASE (xc_f03_func_info_get_family (xc_info)) + SELECT CASE (xc_f03_func_info_get_family(xc_info)) CASE (XC_FAMILY_LDA) IF (grad_deriv == 0) THEN !$OMP DO DO ii = 1, npoints IF (rho(ii) > epsilon_rho) THEN CALL xc_f03_lda_exc(xc_func, 1, rho(ii), exc) - e_0(ii) = e_0(ii)+sc*exc(1)*rho(ii) + e_0(ii) = e_0(ii) + sc*exc(1)*rho(ii) END IF END DO !$OMP END DO @@ -1203,7 +1203,7 @@ SUBROUTINE libxc_lda_calc(rho, norm_drho, laplace_rho, tau, & DO ii = 1, npoints IF (rho(ii) > epsilon_rho) THEN CALL xc_f03_lda_vxc(xc_func, 1, rho(ii), vrho) - e_rho(ii) = e_rho(ii)+sc*vrho(1) + e_rho(ii) = e_rho(ii) + sc*vrho(1) END IF END DO !$OMP END DO @@ -1212,8 +1212,8 @@ SUBROUTINE libxc_lda_calc(rho, norm_drho, laplace_rho, tau, & DO ii = 1, npoints IF (rho(ii) > epsilon_rho) THEN CALL xc_f03_lda_exc_vxc(xc_func, 1, rho(ii), exc, vrho) - e_0(ii) = e_0(ii)+sc*exc(1)*rho(ii) - e_rho(ii) = e_rho(ii)+sc*vrho(1) + e_0(ii) = e_0(ii) + sc*exc(1)*rho(ii) + e_rho(ii) = e_rho(ii) + sc*vrho(1) END IF END DO !$OMP END DO @@ -1222,7 +1222,7 @@ SUBROUTINE libxc_lda_calc(rho, norm_drho, laplace_rho, tau, & DO ii = 1, npoints IF (rho(ii) > epsilon_rho) THEN CALL xc_f03_lda_fxc(xc_func, 1, rho(ii), v2rho2) - e_rho_rho(ii) = e_rho_rho(ii)+sc*v2rho2(1) + e_rho_rho(ii) = e_rho_rho(ii) + sc*v2rho2(1) END IF END DO !$OMP END DO @@ -1232,9 +1232,9 @@ SUBROUTINE libxc_lda_calc(rho, norm_drho, laplace_rho, tau, & IF (rho(ii) > epsilon_rho) THEN CALL xc_f03_lda_exc_vxc(xc_func, 1, rho(ii), exc, vrho) CALL xc_f03_lda_fxc(xc_func, 1, rho(ii), v2rho2) - e_0(ii) = e_0(ii)+sc*exc(1)*rho(ii) - e_rho(ii) = e_rho(ii)+sc*vrho(1) - e_rho_rho(ii) = e_rho_rho(ii)+sc*v2rho2(1) + e_0(ii) = e_0(ii) + sc*exc(1)*rho(ii) + e_rho(ii) = e_rho(ii) + sc*vrho(1) + e_rho_rho(ii) = e_rho_rho(ii) + sc*v2rho2(1) END IF END DO !$OMP END DO @@ -1243,7 +1243,7 @@ SUBROUTINE libxc_lda_calc(rho, norm_drho, laplace_rho, tau, & DO ii = 1, npoints IF (rho(ii) > epsilon_rho) THEN CALL xc_f03_lda_kxc(xc_func, 1, rho(ii), v3rho3) - e_rho_rho_rho(ii) = e_rho_rho_rho(ii)+sc*v3rho3(1) + e_rho_rho_rho(ii) = e_rho_rho_rho(ii) + sc*v3rho3(1) END IF END DO !$OMP END DO @@ -1252,10 +1252,10 @@ SUBROUTINE libxc_lda_calc(rho, norm_drho, laplace_rho, tau, & DO ii = 1, npoints IF (rho(ii) > epsilon_rho) THEN CALL xc_f03_lda(xc_func, 1, rho(ii), exc, vrho, v2rho2, v3rho3) - e_0(ii) = e_0(ii)+sc*exc(1)*rho(ii) - e_rho(ii) = e_rho(ii)+sc*vrho(1) - e_rho_rho(ii) = e_rho_rho(ii)+sc*v2rho2(1) - e_rho_rho_rho(ii) = e_rho_rho_rho(ii)+sc*v3rho3(1) + e_0(ii) = e_0(ii) + sc*exc(1)*rho(ii) + e_rho(ii) = e_rho(ii) + sc*vrho(1) + e_rho_rho(ii) = e_rho_rho(ii) + sc*v2rho2(1) + e_rho_rho_rho(ii) = e_rho_rho_rho(ii) + sc*v3rho3(1) END IF END DO !$OMP END DO @@ -1267,7 +1267,7 @@ SUBROUTINE libxc_lda_calc(rho, norm_drho, laplace_rho, tau, & IF (rho(ii) > epsilon_rho) THEN sigma = norm_drho(ii)**2 CALL xc_f03_gga_exc(xc_func, 1, rho(ii), sigma, exc) - e_0(ii) = e_0(ii)+sc*exc(1)*rho(ii) + e_0(ii) = e_0(ii) + sc*exc(1)*rho(ii) END IF END DO !$OMP END DO @@ -1277,8 +1277,8 @@ SUBROUTINE libxc_lda_calc(rho, norm_drho, laplace_rho, tau, & IF (rho(ii) > epsilon_rho) THEN sigma = norm_drho(ii)**2 CALL xc_f03_gga_vxc(xc_func, 1, rho(ii), sigma, vrho, vsigma) - e_rho(ii) = e_rho(ii)+sc*vrho(1) - e_ndrho(ii) = e_ndrho(ii)+sc*2.0_dp*vsigma(1)*norm_drho(ii) + e_rho(ii) = e_rho(ii) + sc*vrho(1) + e_ndrho(ii) = e_ndrho(ii) + sc*2.0_dp*vsigma(1)*norm_drho(ii) END IF END DO !$OMP END DO @@ -1294,9 +1294,9 @@ SUBROUTINE libxc_lda_calc(rho, norm_drho, laplace_rho, tau, & CALL xc_f03_gga_exc_vxc(xc_func, 1, rho(ii), sigma, & exc, vrho, vsigma) END IF - e_0(ii) = e_0(ii)+sc*exc(1)*rho(ii) - e_rho(ii) = e_rho(ii)+sc*vrho(1) - e_ndrho(ii) = e_ndrho(ii)+sc*2.0_dp*vsigma(1)*norm_drho(ii) + e_0(ii) = e_0(ii) + sc*exc(1)*rho(ii) + e_rho(ii) = e_rho(ii) + sc*vrho(1) + e_ndrho(ii) = e_ndrho(ii) + sc*2.0_dp*vsigma(1)*norm_drho(ii) END IF END DO !$OMP END DO @@ -1315,10 +1315,10 @@ SUBROUTINE libxc_lda_calc(rho, norm_drho, laplace_rho, tau, & CALL xc_f03_gga_fxc(xc_func, 1, rho(ii), sigma, & v2rho2, v2rhosigma, v2sigma2) END IF - e_rho_rho(ii) = e_rho_rho(ii)+sc*v2rho2(1) - e_ndrho_rho(ii) = e_ndrho_rho(ii)+sc*2.0_dp*v2rhosigma(1)*norm_drho(ii) - e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii)+ & - sc*2.0_dp*(2.0_dp*sigma(1)*v2sigma2(1)+vsigma(1)) + e_rho_rho(ii) = e_rho_rho(ii) + sc*v2rho2(1) + e_ndrho_rho(ii) = e_ndrho_rho(ii) + sc*2.0_dp*v2rhosigma(1)*norm_drho(ii) + e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii) + & + sc*2.0_dp*(2.0_dp*sigma(1)*v2sigma2(1) + vsigma(1)) END IF END DO !$OMP END DO @@ -1338,13 +1338,13 @@ SUBROUTINE libxc_lda_calc(rho, norm_drho, laplace_rho, tau, & CALL xc_f03_gga_fxc(xc_func, 1, rho(ii), sigma, & v2rho2, v2rhosigma, v2sigma2) END IF - e_0(ii) = e_0(ii)+sc*exc(1)*rho(ii) - e_rho(ii) = e_rho(ii)+sc*vrho(1) - e_ndrho(ii) = e_ndrho(ii)+sc*2.0_dp*vsigma(1)*norm_drho(ii) - e_rho_rho(ii) = e_rho_rho(ii)+sc*v2rho2(1) - e_ndrho_rho(ii) = e_ndrho_rho(ii)+sc*2.0_dp*v2rhosigma(1)*norm_drho(ii) - e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii)+ & - sc*2.0_dp*(2.0_dp*sigma(1)*v2sigma2(1)+vsigma(1)) + e_0(ii) = e_0(ii) + sc*exc(1)*rho(ii) + e_rho(ii) = e_rho(ii) + sc*vrho(1) + e_ndrho(ii) = e_ndrho(ii) + sc*2.0_dp*vsigma(1)*norm_drho(ii) + e_rho_rho(ii) = e_rho_rho(ii) + sc*v2rho2(1) + e_ndrho_rho(ii) = e_ndrho_rho(ii) + sc*2.0_dp*v2rhosigma(1)*norm_drho(ii) + e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii) + & + sc*2.0_dp*(2.0_dp*sigma(1)*v2sigma2(1) + vsigma(1)) END IF END DO !$OMP END DO @@ -1358,7 +1358,7 @@ SUBROUTINE libxc_lda_calc(rho, norm_drho, laplace_rho, tau, & my_tau(1) = MAX(tau(ii), sigma(1)/(8.0_dp*rho(ii))) CALL xc_f03_mgga_exc(xc_func, 1, rho(ii), sigma, & laplace_rho(ii), my_tau, exc) - e_0(ii) = e_0(ii)+sc*exc(1)*rho(ii) + e_0(ii) = e_0(ii) + sc*exc(1)*rho(ii) END IF END DO !$OMP END DO @@ -1370,10 +1370,10 @@ SUBROUTINE libxc_lda_calc(rho, norm_drho, laplace_rho, tau, & my_tau(1) = MAX(tau(ii), sigma(1)/(8.0_dp*rho(ii))) CALL xc_f03_mgga_vxc(xc_func, 1, rho(ii), sigma, & laplace_rho(ii), my_tau, vrho, vsigma, vlapl, vtau) - e_rho(ii) = e_rho(ii)+sc*vrho(1) - e_ndrho(ii) = e_ndrho(ii)+sc*2.0_dp*vsigma(1)*norm_drho(ii) - e_laplace_rho(ii) = e_laplace_rho(ii)+sc*vlapl(1) - e_tau(ii) = e_tau(ii)+sc*vtau(1) + e_rho(ii) = e_rho(ii) + sc*vrho(1) + e_ndrho(ii) = e_ndrho(ii) + sc*2.0_dp*vsigma(1)*norm_drho(ii) + e_laplace_rho(ii) = e_laplace_rho(ii) + sc*vlapl(1) + e_tau(ii) = e_tau(ii) + sc*vtau(1) END IF END DO !$OMP END DO @@ -1391,11 +1391,11 @@ SUBROUTINE libxc_lda_calc(rho, norm_drho, laplace_rho, tau, & CALL xc_f03_mgga_exc_vxc(xc_func, 1, rho(ii), sigma, & laplace_rho(ii), my_tau, exc, vrho, vsigma, vlapl, vtau) END IF - e_0(ii) = e_0(ii)+sc*exc(1)*rho(ii) - e_rho(ii) = e_rho(ii)+sc*vrho(1) - e_ndrho(ii) = e_ndrho(ii)+sc*2.0_dp*vsigma(1)*norm_drho(ii) - e_laplace_rho(ii) = e_laplace_rho(ii)+sc*vlapl(1) - e_tau(ii) = e_tau(ii)+sc*vtau(1) + e_0(ii) = e_0(ii) + sc*exc(1)*rho(ii) + e_rho(ii) = e_rho(ii) + sc*vrho(1) + e_ndrho(ii) = e_ndrho(ii) + sc*2.0_dp*vsigma(1)*norm_drho(ii) + e_laplace_rho(ii) = e_laplace_rho(ii) + sc*vlapl(1) + e_tau(ii) = e_tau(ii) + sc*vtau(1) END IF END DO !$OMP END DO @@ -1418,18 +1418,18 @@ SUBROUTINE libxc_lda_calc(rho, norm_drho, laplace_rho, tau, & v2rho2, v2sigma2, v2lapl2, v2tau2, v2rhosigma, v2rholapl, & v2rhotau, v2sigmalapl, v2sigmatau, v2lapltau) END IF - e_rho_rho(ii) = e_rho_rho(ii)+sc*v2rho2(1) - e_ndrho_rho(ii) = e_ndrho_rho(ii)+sc*2.0_dp*v2rhosigma(1)*norm_drho(ii) - e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii)+ & - sc*2.0_dp*(2.0_dp*sigma(1)*v2sigma2(1)+vsigma(1)) - e_rho_laplace_rho(ii) = e_rho_laplace_rho(ii)+sc*v2rholapl(1) - e_rho_tau(ii) = e_rho_tau(ii)+sc*v2rhotau(1) - e_ndrho_laplace_rho(ii) = e_ndrho_laplace_rho(ii)+ & + e_rho_rho(ii) = e_rho_rho(ii) + sc*v2rho2(1) + e_ndrho_rho(ii) = e_ndrho_rho(ii) + sc*2.0_dp*v2rhosigma(1)*norm_drho(ii) + e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii) + & + sc*2.0_dp*(2.0_dp*sigma(1)*v2sigma2(1) + vsigma(1)) + e_rho_laplace_rho(ii) = e_rho_laplace_rho(ii) + sc*v2rholapl(1) + e_rho_tau(ii) = e_rho_tau(ii) + sc*v2rhotau(1) + e_ndrho_laplace_rho(ii) = e_ndrho_laplace_rho(ii) + & sc*2.0_dp*v2sigmalapl(1)*norm_drho(ii) - e_ndrho_tau(ii) = e_ndrho_tau(ii)+sc*2.0_dp*v2sigmatau(1)*norm_drho(ii) - e_laplace_rho_laplace_rho(ii) = e_laplace_rho_laplace_rho(ii)+sc*v2lapl2(1) - e_laplace_rho_tau(ii) = e_laplace_rho_tau(ii)+sc*v2lapltau(1) - e_tau_tau(ii) = e_tau_tau(ii)+sc*v2tau2(1) + e_ndrho_tau(ii) = e_ndrho_tau(ii) + sc*2.0_dp*v2sigmatau(1)*norm_drho(ii) + e_laplace_rho_laplace_rho(ii) = e_laplace_rho_laplace_rho(ii) + sc*v2lapl2(1) + e_laplace_rho_tau(ii) = e_laplace_rho_tau(ii) + sc*v2lapltau(1) + e_tau_tau(ii) = e_tau_tau(ii) + sc*v2tau2(1) END IF END DO !$OMP END DO @@ -1453,23 +1453,23 @@ SUBROUTINE libxc_lda_calc(rho, norm_drho, laplace_rho, tau, & v2rho2, v2sigma2, v2lapl2, v2tau2, v2rhosigma, v2rholapl, & v2rhotau, v2sigmalapl, v2sigmatau, v2lapltau) END IF - e_0(ii) = e_0(ii)+sc*exc(1)*rho(ii) - e_rho(ii) = e_rho(ii)+sc*vrho(1) - e_ndrho(ii) = e_ndrho(ii)+sc*2.0_dp*vsigma(1)*norm_drho(ii) - e_laplace_rho(ii) = e_laplace_rho(ii)+sc*vlapl(1) - e_tau(ii) = e_tau(ii)+sc*vtau(1) - e_rho_rho(ii) = e_rho_rho(ii)+sc*v2rho2(1) - e_ndrho_rho(ii) = e_ndrho_rho(ii)+sc*2.0_dp*v2rhosigma(1)*norm_drho(ii) - e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii)+ & - sc*2.0_dp*(2.0_dp*sigma(1)*v2sigma2(1)+vsigma(1)) - e_rho_laplace_rho(ii) = e_rho_laplace_rho(ii)+sc*v2rholapl(1) - e_rho_tau(ii) = e_rho_tau(ii)+sc*v2rhotau(1) - e_ndrho_laplace_rho(ii) = e_ndrho_laplace_rho(ii)+ & + e_0(ii) = e_0(ii) + sc*exc(1)*rho(ii) + e_rho(ii) = e_rho(ii) + sc*vrho(1) + e_ndrho(ii) = e_ndrho(ii) + sc*2.0_dp*vsigma(1)*norm_drho(ii) + e_laplace_rho(ii) = e_laplace_rho(ii) + sc*vlapl(1) + e_tau(ii) = e_tau(ii) + sc*vtau(1) + e_rho_rho(ii) = e_rho_rho(ii) + sc*v2rho2(1) + e_ndrho_rho(ii) = e_ndrho_rho(ii) + sc*2.0_dp*v2rhosigma(1)*norm_drho(ii) + e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii) + & + sc*2.0_dp*(2.0_dp*sigma(1)*v2sigma2(1) + vsigma(1)) + e_rho_laplace_rho(ii) = e_rho_laplace_rho(ii) + sc*v2rholapl(1) + e_rho_tau(ii) = e_rho_tau(ii) + sc*v2rhotau(1) + e_ndrho_laplace_rho(ii) = e_ndrho_laplace_rho(ii) + & sc*2.0_dp*v2sigmalapl(1)*norm_drho(ii) - e_ndrho_tau(ii) = e_ndrho_tau(ii)+sc*2.0_dp*v2sigmatau(1)*norm_drho(ii) - e_laplace_rho_laplace_rho(ii) = e_laplace_rho_laplace_rho(ii)+sc*v2lapl2(1) - e_laplace_rho_tau(ii) = e_laplace_rho_tau(ii)+sc*v2lapltau(1) - e_tau_tau(ii) = e_tau_tau(ii)+sc*v2tau2(1) + e_ndrho_tau(ii) = e_ndrho_tau(ii) + sc*2.0_dp*v2sigmatau(1)*norm_drho(ii) + e_laplace_rho_laplace_rho(ii) = e_laplace_rho_laplace_rho(ii) + sc*v2lapl2(1) + e_laplace_rho_tau(ii) = e_laplace_rho_tau(ii) + sc*v2lapltau(1) + e_tau_tau(ii) = e_tau_tau(ii) + sc*v2tau2(1) END IF END DO !$OMP END DO @@ -1643,18 +1643,18 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & !$OMP END CRITICAL(libxc_init) !$OMP BARRIER - SELECT CASE (xc_f03_func_info_get_family (xc_info)) + SELECT CASE (xc_f03_func_info_get_family(xc_info)) CASE (XC_FAMILY_LDA) IF (grad_deriv == 0) THEN !$OMP DO DO ii = 1, npoints my_rhoa = MAX(rhoa(ii), 0.0_dp) my_rhob = MAX(rhob(ii), 0.0_dp) - IF ((my_rhoa+my_rhob) > epsilon_rho) THEN + IF ((my_rhoa + my_rhob) > epsilon_rho) THEN rhov(1, 1) = MAX(my_rhoa, EPSILON(0.0_dp)*1.e4_dp) rhov(2, 1) = MAX(my_rhob, EPSILON(0.0_dp)*1.e4_dp) CALL xc_f03_lda_exc(xc_func, 1, rhov(1, 1), exc) - e_0(ii) = e_0(ii)+sc*exc(1)*(rhov(1, 1)+rhov(2, 1)) + e_0(ii) = e_0(ii) + sc*exc(1)*(rhov(1, 1) + rhov(2, 1)) END IF END DO !$OMP END DO @@ -1663,12 +1663,12 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & DO ii = 1, npoints my_rhoa = MAX(rhoa(ii), 0.0_dp) my_rhob = MAX(rhob(ii), 0.0_dp) - IF ((my_rhoa+my_rhob) > epsilon_rho) THEN + IF ((my_rhoa + my_rhob) > epsilon_rho) THEN rhov(1, 1) = MAX(my_rhoa, EPSILON(0.0_dp)*1.e4_dp) rhov(2, 1) = MAX(my_rhob, EPSILON(0.0_dp)*1.e4_dp) CALL xc_f03_lda_vxc(xc_func, 1, rhov(1, 1), vrho(1, 1)) - e_rhoa(ii) = e_rhoa(ii)+sc*vrho(1, 1) - e_rhob(ii) = e_rhob(ii)+sc*vrho(2, 1) + e_rhoa(ii) = e_rhoa(ii) + sc*vrho(1, 1) + e_rhob(ii) = e_rhob(ii) + sc*vrho(2, 1) END IF END DO !$OMP END DO @@ -1677,13 +1677,13 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & DO ii = 1, npoints my_rhoa = MAX(rhoa(ii), 0.0_dp) my_rhob = MAX(rhob(ii), 0.0_dp) - IF ((my_rhoa+my_rhob) > epsilon_rho) THEN + IF ((my_rhoa + my_rhob) > epsilon_rho) THEN rhov(1, 1) = MAX(my_rhoa, EPSILON(0.0_dp)*1.e4_dp) rhov(2, 1) = MAX(my_rhob, EPSILON(0.0_dp)*1.e4_dp) CALL xc_f03_lda_exc_vxc(xc_func, 1, rhov(1, 1), exc, vrho(1, 1)) - e_0(ii) = e_0(ii)+sc*exc(1)*(rhov(1, 1)+rhov(2, 1)) - e_rhoa(ii) = e_rhoa(ii)+sc*vrho(1, 1) - e_rhob(ii) = e_rhob(ii)+sc*vrho(2, 1) + e_0(ii) = e_0(ii) + sc*exc(1)*(rhov(1, 1) + rhov(2, 1)) + e_rhoa(ii) = e_rhoa(ii) + sc*vrho(1, 1) + e_rhob(ii) = e_rhob(ii) + sc*vrho(2, 1) END IF END DO !$OMP END DO @@ -1692,13 +1692,13 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & DO ii = 1, npoints my_rhoa = MAX(rhoa(ii), 0.0_dp) my_rhob = MAX(rhob(ii), 0.0_dp) - IF ((my_rhoa+my_rhob) > epsilon_rho) THEN + IF ((my_rhoa + my_rhob) > epsilon_rho) THEN rhov(1, 1) = MAX(my_rhoa, EPSILON(0.0_dp)*1.e4_dp) rhov(2, 1) = MAX(my_rhob, EPSILON(0.0_dp)*1.e4_dp) CALL xc_f03_lda_fxc(xc_func, 1, rhov(1, 1), v2rho2(1, 1)) - e_rhoa_rhoa(ii) = e_rhoa_rhoa(ii)+sc*v2rho2(1, 1) - e_rhoa_rhob(ii) = e_rhoa_rhob(ii)+sc*v2rho2(2, 1) - e_rhob_rhob(ii) = e_rhob_rhob(ii)+sc*v2rho2(3, 1) + e_rhoa_rhoa(ii) = e_rhoa_rhoa(ii) + sc*v2rho2(1, 1) + e_rhoa_rhob(ii) = e_rhoa_rhob(ii) + sc*v2rho2(2, 1) + e_rhob_rhob(ii) = e_rhob_rhob(ii) + sc*v2rho2(3, 1) END IF END DO !$OMP END DO @@ -1707,17 +1707,17 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & DO ii = 1, npoints my_rhoa = MAX(rhoa(ii), 0.0_dp) my_rhob = MAX(rhob(ii), 0.0_dp) - IF ((my_rhoa+my_rhob) > epsilon_rho) THEN + IF ((my_rhoa + my_rhob) > epsilon_rho) THEN rhov(1, 1) = MAX(my_rhoa, EPSILON(0.0_dp)*1.e4_dp) rhov(2, 1) = MAX(my_rhob, EPSILON(0.0_dp)*1.e4_dp) CALL xc_f03_lda_exc_vxc(xc_func, 1, rhov(1, 1), exc, vrho(1, 1)) CALL xc_f03_lda_fxc(xc_func, 1, rhov(1, 1), v2rho2(1, 1)) - e_0(ii) = e_0(ii)+sc*exc(1)*(rhov(1, 1)+rhov(2, 1)) - e_rhoa(ii) = e_rhoa(ii)+sc*vrho(1, 1) - e_rhob(ii) = e_rhob(ii)+sc*vrho(2, 1) - e_rhoa_rhoa(ii) = e_rhoa_rhoa(ii)+sc*v2rho2(1, 1) - e_rhoa_rhob(ii) = e_rhoa_rhob(ii)+sc*v2rho2(2, 1) - e_rhob_rhob(ii) = e_rhob_rhob(ii)+sc*v2rho2(3, 1) + e_0(ii) = e_0(ii) + sc*exc(1)*(rhov(1, 1) + rhov(2, 1)) + e_rhoa(ii) = e_rhoa(ii) + sc*vrho(1, 1) + e_rhob(ii) = e_rhob(ii) + sc*vrho(2, 1) + e_rhoa_rhoa(ii) = e_rhoa_rhoa(ii) + sc*v2rho2(1, 1) + e_rhoa_rhob(ii) = e_rhoa_rhob(ii) + sc*v2rho2(2, 1) + e_rhob_rhob(ii) = e_rhob_rhob(ii) + sc*v2rho2(3, 1) END IF END DO !$OMP END DO @@ -1726,14 +1726,14 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & DO ii = 1, npoints my_rhoa = MAX(rhoa(ii), 0.0_dp) my_rhob = MAX(rhob(ii), 0.0_dp) - IF ((my_rhoa+my_rhob) > epsilon_rho) THEN + IF ((my_rhoa + my_rhob) > epsilon_rho) THEN rhov(1, 1) = MAX(my_rhoa, EPSILON(0.0_dp)*1.e4_dp) rhov(2, 1) = MAX(my_rhob, EPSILON(0.0_dp)*1.e4_dp) CALL xc_f03_lda_kxc(xc_func, 1, rhov(1, 1), v3rho3(1, 1)) - e_rhoa_rhoa_rhoa(ii) = e_rhoa_rhoa_rhoa(ii)+sc*v3rho3(1, 1) - e_rhoa_rhoa_rhob(ii) = e_rhoa_rhoa_rhob(ii)+sc*v3rho3(2, 1) - e_rhoa_rhob_rhob(ii) = e_rhoa_rhob_rhob(ii)+sc*v3rho3(3, 1) - e_rhob_rhob_rhob(ii) = e_rhob_rhob_rhob(ii)+sc*v3rho3(4, 1) + e_rhoa_rhoa_rhoa(ii) = e_rhoa_rhoa_rhoa(ii) + sc*v3rho3(1, 1) + e_rhoa_rhoa_rhob(ii) = e_rhoa_rhoa_rhob(ii) + sc*v3rho3(2, 1) + e_rhoa_rhob_rhob(ii) = e_rhoa_rhob_rhob(ii) + sc*v3rho3(3, 1) + e_rhob_rhob_rhob(ii) = e_rhob_rhob_rhob(ii) + sc*v3rho3(4, 1) END IF END DO !$OMP END DO @@ -1742,20 +1742,20 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & DO ii = 1, npoints my_rhoa = MAX(rhoa(ii), 0.0_dp) my_rhob = MAX(rhob(ii), 0.0_dp) - IF ((my_rhoa+my_rhob) > epsilon_rho) THEN + IF ((my_rhoa + my_rhob) > epsilon_rho) THEN rhov(1, 1) = MAX(my_rhoa, EPSILON(0.0_dp)*1.e4_dp) rhov(2, 1) = MAX(my_rhob, EPSILON(0.0_dp)*1.e4_dp) CALL xc_f03_lda(xc_func, 1, rhov(1, 1), exc, vrho(1, 1), v2rho2(1, 1), v3rho3(1, 1)) - e_0(ii) = e_0(ii)+sc*exc(1)*(rhov(1, 1)+rhov(2, 1)) - e_rhoa(ii) = e_rhoa(ii)+sc*vrho(1, 1) - e_rhob(ii) = e_rhob(ii)+sc*vrho(2, 1) - e_rhoa_rhoa(ii) = e_rhoa_rhoa(ii)+sc*v2rho2(1, 1) - e_rhoa_rhob(ii) = e_rhoa_rhob(ii)+sc*v2rho2(2, 1) - e_rhob_rhob(ii) = e_rhob_rhob(ii)+sc*v2rho2(3, 1) - e_rhoa_rhoa_rhoa(ii) = e_rhoa_rhoa_rhoa(ii)+sc*v3rho3(1, 1) - e_rhoa_rhoa_rhob(ii) = e_rhoa_rhoa_rhob(ii)+sc*v3rho3(2, 1) - e_rhoa_rhob_rhob(ii) = e_rhoa_rhob_rhob(ii)+sc*v3rho3(3, 1) - e_rhob_rhob_rhob(ii) = e_rhob_rhob_rhob(ii)+sc*v3rho3(4, 1) + e_0(ii) = e_0(ii) + sc*exc(1)*(rhov(1, 1) + rhov(2, 1)) + e_rhoa(ii) = e_rhoa(ii) + sc*vrho(1, 1) + e_rhob(ii) = e_rhob(ii) + sc*vrho(2, 1) + e_rhoa_rhoa(ii) = e_rhoa_rhoa(ii) + sc*v2rho2(1, 1) + e_rhoa_rhob(ii) = e_rhoa_rhob(ii) + sc*v2rho2(2, 1) + e_rhob_rhob(ii) = e_rhob_rhob(ii) + sc*v2rho2(3, 1) + e_rhoa_rhoa_rhoa(ii) = e_rhoa_rhoa_rhoa(ii) + sc*v3rho3(1, 1) + e_rhoa_rhoa_rhob(ii) = e_rhoa_rhoa_rhob(ii) + sc*v3rho3(2, 1) + e_rhoa_rhob_rhob(ii) = e_rhoa_rhob_rhob(ii) + sc*v3rho3(3, 1) + e_rhob_rhob_rhob(ii) = e_rhob_rhob_rhob(ii) + sc*v3rho3(4, 1) END IF END DO !$OMP END DO @@ -1766,7 +1766,7 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & DO ii = 1, npoints my_rhoa = MAX(rhoa(ii), 0.0_dp) my_rhob = MAX(rhob(ii), 0.0_dp) - IF ((my_rhoa+my_rhob) > epsilon_rho) THEN + IF ((my_rhoa + my_rhob) > epsilon_rho) THEN rhov(1, 1) = MAX(my_rhoa, EPSILON(0.0_dp)*1.e4_dp) rhov(2, 1) = MAX(my_rhob, EPSILON(0.0_dp)*1.e4_dp) my_norm_drhoa = MAX(norm_drhoa(ii), EPSILON(0.0_dp)*1.e4_dp) @@ -1774,9 +1774,9 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & my_norm_drho = MAX(norm_drho(ii), EPSILON(0.0_dp)*1.e4_dp) sigmav(1, 1) = my_norm_drhoa**2 sigmav(3, 1) = my_norm_drhob**2 - sigmav(2, 1) = 0.5_dp*(my_norm_drho**2-sigmav(1, 1)-sigmav(3, 1)) + sigmav(2, 1) = 0.5_dp*(my_norm_drho**2 - sigmav(1, 1) - sigmav(3, 1)) CALL xc_f03_gga_exc(xc_func, 1, rhov(1, 1), sigmav(1, 1), exc) - e_0(ii) = e_0(ii)+sc*exc(1)*(rhov(1, 1)+rhov(2, 1)) + e_0(ii) = e_0(ii) + sc*exc(1)*(rhov(1, 1) + rhov(2, 1)) END IF END DO !$OMP END DO @@ -1785,7 +1785,7 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & DO ii = 1, npoints my_rhoa = MAX(rhoa(ii), 0.0_dp) my_rhob = MAX(rhob(ii), 0.0_dp) - IF ((my_rhoa+my_rhob) > epsilon_rho) THEN + IF ((my_rhoa + my_rhob) > epsilon_rho) THEN rhov(1, 1) = MAX(my_rhoa, EPSILON(0.0_dp)*1.e4_dp) rhov(2, 1) = MAX(my_rhob, EPSILON(0.0_dp)*1.e4_dp) my_norm_drhoa = MAX(norm_drhoa(ii), EPSILON(0.0_dp)*1.e4_dp) @@ -1793,15 +1793,15 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & my_norm_drho = MAX(norm_drho(ii), EPSILON(0.0_dp)*1.e4_dp) sigmav(1, 1) = my_norm_drhoa**2 sigmav(3, 1) = my_norm_drhob**2 - sigmav(2, 1) = 0.5_dp*(my_norm_drho**2-sigmav(1, 1)-sigmav(3, 1)) + sigmav(2, 1) = 0.5_dp*(my_norm_drho**2 - sigmav(1, 1) - sigmav(3, 1)) CALL xc_f03_gga_vxc(xc_func, 1, rhov(1, 1), sigmav(1, 1), vrho(1, 1), vsigma(1, 1)) - e_rhoa(ii) = e_rhoa(ii)+sc*vrho(1, 1) - e_rhob(ii) = e_rhob(ii)+sc*vrho(2, 1) - e_ndrho(ii) = e_ndrho(ii)+sc*vsigma(2, 1)*my_norm_drho - e_ndrhoa(ii) = e_ndrhoa(ii)+ & - sc*(2.0_dp*vsigma(1, 1)-vsigma(2, 1))*my_norm_drhoa - e_ndrhob(ii) = e_ndrhob(ii)+ & - sc*(2.0_dp*vsigma(3, 1)-vsigma(2, 1))*my_norm_drhob + e_rhoa(ii) = e_rhoa(ii) + sc*vrho(1, 1) + e_rhob(ii) = e_rhob(ii) + sc*vrho(2, 1) + e_ndrho(ii) = e_ndrho(ii) + sc*vsigma(2, 1)*my_norm_drho + e_ndrhoa(ii) = e_ndrhoa(ii) + & + sc*(2.0_dp*vsigma(1, 1) - vsigma(2, 1))*my_norm_drhoa + e_ndrhob(ii) = e_ndrhob(ii) + & + sc*(2.0_dp*vsigma(3, 1) - vsigma(2, 1))*my_norm_drhob END IF END DO !$OMP END DO @@ -1810,7 +1810,7 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & DO ii = 1, npoints my_rhoa = MAX(rhoa(ii), 0.0_dp) my_rhob = MAX(rhob(ii), 0.0_dp) - IF ((my_rhoa+my_rhob) > epsilon_rho) THEN + IF ((my_rhoa + my_rhob) > epsilon_rho) THEN rhov(1, 1) = MAX(my_rhoa, EPSILON(0.0_dp)*1.e4_dp) rhov(2, 1) = MAX(my_rhob, EPSILON(0.0_dp)*1.e4_dp) my_norm_drhoa = MAX(norm_drhoa(ii), EPSILON(0.0_dp)*1.e4_dp) @@ -1818,21 +1818,21 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & my_norm_drho = MAX(norm_drho(ii), EPSILON(0.0_dp)*1.e4_dp) sigmav(1, 1) = my_norm_drhoa**2 sigmav(3, 1) = my_norm_drhob**2 - sigmav(2, 1) = 0.5_dp*(my_norm_drho**2-sigmav(1, 1)-sigmav(3, 1)) + sigmav(2, 1) = 0.5_dp*(my_norm_drho**2 - sigmav(1, 1) - sigmav(3, 1)) IF (no_exc) THEN CALL xc_f03_gga_vxc(xc_func, 1, rhov(1, 1), sigmav(1, 1), vrho(1, 1), vsigma(1, 1)) exc = 0.0_dp ELSE CALL xc_f03_gga_exc_vxc(xc_func, 1, rhov(1, 1), sigmav(1, 1), exc, vrho(1, 1), vsigma(1, 1)) END IF - e_0(ii) = e_0(ii)+sc*exc(1)*(rhov(1, 1)+rhov(2, 1)) - e_rhoa(ii) = e_rhoa(ii)+sc*vrho(1, 1) - e_rhob(ii) = e_rhob(ii)+sc*vrho(2, 1) - e_ndrho(ii) = e_ndrho(ii)+sc*vsigma(2, 1)*my_norm_drho - e_ndrhoa(ii) = e_ndrhoa(ii)+ & - sc*(2.0_dp*vsigma(1, 1)-vsigma(2, 1))*my_norm_drhoa - e_ndrhob(ii) = e_ndrhob(ii)+ & - sc*(2.0_dp*vsigma(3, 1)-vsigma(2, 1))*my_norm_drhob + e_0(ii) = e_0(ii) + sc*exc(1)*(rhov(1, 1) + rhov(2, 1)) + e_rhoa(ii) = e_rhoa(ii) + sc*vrho(1, 1) + e_rhob(ii) = e_rhob(ii) + sc*vrho(2, 1) + e_ndrho(ii) = e_ndrho(ii) + sc*vsigma(2, 1)*my_norm_drho + e_ndrhoa(ii) = e_ndrhoa(ii) + & + sc*(2.0_dp*vsigma(1, 1) - vsigma(2, 1))*my_norm_drhoa + e_ndrhob(ii) = e_ndrhob(ii) + & + sc*(2.0_dp*vsigma(3, 1) - vsigma(2, 1))*my_norm_drhob END IF END DO !$OMP END DO @@ -1841,7 +1841,7 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & DO ii = 1, npoints my_rhoa = MAX(rhoa(ii), 0.0_dp) my_rhob = MAX(rhob(ii), 0.0_dp) - IF ((my_rhoa+my_rhob) > epsilon_rho) THEN + IF ((my_rhoa + my_rhob) > epsilon_rho) THEN rhov(1, 1) = MAX(my_rhoa, EPSILON(0.0_dp)*1.e4_dp) rhov(2, 1) = MAX(my_rhob, EPSILON(0.0_dp)*1.e4_dp) my_norm_drhoa = MAX(norm_drhoa(ii), EPSILON(0.0_dp)*1.e4_dp) @@ -1849,7 +1849,7 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & my_norm_drho = MAX(norm_drho(ii), EPSILON(0.0_dp)*1.e4_dp) sigmav(1, 1) = my_norm_drhoa**2 sigmav(3, 1) = my_norm_drhob**2 - sigmav(2, 1) = 0.5_dp*(my_norm_drho**2-sigmav(1, 1)-sigmav(3, 1)) + sigmav(2, 1) = 0.5_dp*(my_norm_drho**2 - sigmav(1, 1) - sigmav(3, 1)) IF (no_exc) THEN CALL xc_f03_gga_vxc(xc_func, 1, rhov(1, 1), sigmav(1, 1), vrho(1, 1), vsigma(1, 1)) CALL xc_f03_gga_fxc(xc_func, 1, rhov(1, 1), sigmav(1, 1), & @@ -1859,34 +1859,34 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & CALL xc_f03_gga_fxc(xc_func, 1, rhov(1, 1), sigmav(1, 1), & v2rho2(1, 1), v2rhosigma(1, 1), v2sigma2(1, 1)) END IF - e_rhoa_rhoa(ii) = e_rhoa_rhoa(ii)+sc*v2rho2(1, 1) - e_rhoa_rhob(ii) = e_rhoa_rhob(ii)+sc*v2rho2(2, 1) - e_rhob_rhob(ii) = e_rhob_rhob(ii)+sc*v2rho2(3, 1) - e_ndrho_rhoa(ii) = e_ndrho_rhoa(ii)+sc*v2rhosigma(2, 1)*my_norm_drho - e_ndrho_rhob(ii) = e_ndrho_rhob(ii)+sc*v2rhosigma(5, 1)*my_norm_drho - e_ndrhoa_rhoa(ii) = e_ndrhoa_rhoa(ii)+ & - sc*(2.0_dp*v2rhosigma(1, 1)-v2rhosigma(2, 1))*my_norm_drhoa - e_ndrhoa_rhob(ii) = e_ndrhoa_rhob(ii)+ & - sc*(2.0_dp*v2rhosigma(4, 1)-v2rhosigma(5, 1))*my_norm_drhoa - e_ndrhob_rhoa(ii) = e_ndrhob_rhoa(ii)+ & - sc*(2.0_dp*v2rhosigma(3, 1)-v2rhosigma(2, 1))*my_norm_drhob - e_ndrhob_rhob(ii) = e_ndrhob_rhob(ii)+ & - sc*(2.0_dp*v2rhosigma(6, 1)-v2rhosigma(5, 1))*my_norm_drhob - e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii)+ & - sc*(vsigma(2, 1)+my_norm_drho**2*v2sigma2(4, 1)) - e_ndrho_ndrhoa(ii) = e_ndrho_ndrhoa(ii)+ & - sc*(2.0_dp*v2sigma2(2, 1)-v2sigma2(4, 1))*my_norm_drho*my_norm_drhoa - e_ndrho_ndrhob(ii) = e_ndrho_ndrhob(ii)+ & - sc*(2.0_dp*v2sigma2(5, 1)-v2sigma2(4, 1))*my_norm_drho*my_norm_drhob - e_ndrhoa_ndrhoa(ii) = e_ndrhoa_ndrhoa(ii)+ & - sc*(2.0_dp*vsigma(1, 1)-vsigma(2, 1)+my_norm_drhoa**2*( & - 4.0_dp*v2sigma2(1, 1)-4.0_dp*v2sigma2(2, 1)+v2sigma2(4, 1))) - e_ndrhoa_ndrhob(ii) = e_ndrhoa_ndrhob(ii)+ & - sc*(4.0_dp*v2sigma2(3, 1)-2.0_dp*v2sigma2(2, 1)- & - 2.0_dp*v2sigma2(5, 1)+v2sigma2(4, 1))*my_norm_drhoa*my_norm_drhob - e_ndrhob_ndrhob(ii) = e_ndrhob_ndrhob(ii)+ & - sc*(2.0_dp*vsigma(3, 1)-vsigma(2, 1)+my_norm_drhob**2*( & - 4.0_dp*v2sigma2(6, 1)-4.0_dp*v2sigma2(5, 1)+v2sigma2(4, 1))) + e_rhoa_rhoa(ii) = e_rhoa_rhoa(ii) + sc*v2rho2(1, 1) + e_rhoa_rhob(ii) = e_rhoa_rhob(ii) + sc*v2rho2(2, 1) + e_rhob_rhob(ii) = e_rhob_rhob(ii) + sc*v2rho2(3, 1) + e_ndrho_rhoa(ii) = e_ndrho_rhoa(ii) + sc*v2rhosigma(2, 1)*my_norm_drho + e_ndrho_rhob(ii) = e_ndrho_rhob(ii) + sc*v2rhosigma(5, 1)*my_norm_drho + e_ndrhoa_rhoa(ii) = e_ndrhoa_rhoa(ii) + & + sc*(2.0_dp*v2rhosigma(1, 1) - v2rhosigma(2, 1))*my_norm_drhoa + e_ndrhoa_rhob(ii) = e_ndrhoa_rhob(ii) + & + sc*(2.0_dp*v2rhosigma(4, 1) - v2rhosigma(5, 1))*my_norm_drhoa + e_ndrhob_rhoa(ii) = e_ndrhob_rhoa(ii) + & + sc*(2.0_dp*v2rhosigma(3, 1) - v2rhosigma(2, 1))*my_norm_drhob + e_ndrhob_rhob(ii) = e_ndrhob_rhob(ii) + & + sc*(2.0_dp*v2rhosigma(6, 1) - v2rhosigma(5, 1))*my_norm_drhob + e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii) + & + sc*(vsigma(2, 1) + my_norm_drho**2*v2sigma2(4, 1)) + e_ndrho_ndrhoa(ii) = e_ndrho_ndrhoa(ii) + & + sc*(2.0_dp*v2sigma2(2, 1) - v2sigma2(4, 1))*my_norm_drho*my_norm_drhoa + e_ndrho_ndrhob(ii) = e_ndrho_ndrhob(ii) + & + sc*(2.0_dp*v2sigma2(5, 1) - v2sigma2(4, 1))*my_norm_drho*my_norm_drhob + e_ndrhoa_ndrhoa(ii) = e_ndrhoa_ndrhoa(ii) + & + sc*(2.0_dp*vsigma(1, 1) - vsigma(2, 1) + my_norm_drhoa**2*( & + 4.0_dp*v2sigma2(1, 1) - 4.0_dp*v2sigma2(2, 1) + v2sigma2(4, 1))) + e_ndrhoa_ndrhob(ii) = e_ndrhoa_ndrhob(ii) + & + sc*(4.0_dp*v2sigma2(3, 1) - 2.0_dp*v2sigma2(2, 1) - & + 2.0_dp*v2sigma2(5, 1) + v2sigma2(4, 1))*my_norm_drhoa*my_norm_drhob + e_ndrhob_ndrhob(ii) = e_ndrhob_ndrhob(ii) + & + sc*(2.0_dp*vsigma(3, 1) - vsigma(2, 1) + my_norm_drhob**2*( & + 4.0_dp*v2sigma2(6, 1) - 4.0_dp*v2sigma2(5, 1) + v2sigma2(4, 1))) END IF END DO !$OMP END DO @@ -1895,7 +1895,7 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & DO ii = 1, npoints my_rhoa = MAX(rhoa(ii), 0.0_dp) my_rhob = MAX(rhob(ii), 0.0_dp) - IF ((my_rhoa+my_rhob) > epsilon_rho) THEN + IF ((my_rhoa + my_rhob) > epsilon_rho) THEN rhov(1, 1) = MAX(my_rhoa, EPSILON(0.0_dp)*1.e4_dp) rhov(2, 1) = MAX(my_rhob, EPSILON(0.0_dp)*1.e4_dp) my_norm_drhoa = MAX(norm_drhoa(ii), EPSILON(0.0_dp)*1.e4_dp) @@ -1903,7 +1903,7 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & my_norm_drho = MAX(norm_drho(ii), EPSILON(0.0_dp)*1.e4_dp) sigmav(1, 1) = my_norm_drhoa**2 sigmav(3, 1) = my_norm_drhob**2 - sigmav(2, 1) = 0.5_dp*(my_norm_drho**2-sigmav(1, 1)-sigmav(3, 1)) + sigmav(2, 1) = 0.5_dp*(my_norm_drho**2 - sigmav(1, 1) - sigmav(3, 1)) IF (no_exc) THEN CALL xc_f03_gga_vxc(xc_func, 1, rhov(1, 1), sigmav(1, 1), vrho(1, 1), vsigma(1, 1)) CALL xc_f03_gga_fxc(xc_func, 1, rhov(1, 1), sigmav(1, 1), & @@ -1914,42 +1914,42 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & CALL xc_f03_gga_fxc(xc_func, 1, rhov(1, 1), sigmav(1, 1), & v2rho2(1, 1), v2rhosigma(1, 1), v2sigma2(1, 1)) END IF - e_0(ii) = e_0(ii)+sc*exc(1)*(rhov(1, 1)+rhov(2, 1)) - e_rhoa(ii) = e_rhoa(ii)+sc*vrho(1, 1) - e_rhob(ii) = e_rhob(ii)+sc*vrho(2, 1) - e_ndrho(ii) = e_ndrho(ii)+sc*vsigma(2, 1)*my_norm_drho - e_ndrhoa(ii) = e_ndrhoa(ii)+ & - sc*(2.0_dp*vsigma(1, 1)-vsigma(2, 1))*my_norm_drhoa - e_ndrhob(ii) = e_ndrhob(ii)+ & - sc*(2.0_dp*vsigma(3, 1)-vsigma(2, 1))*my_norm_drhob - e_rhoa_rhoa(ii) = e_rhoa_rhoa(ii)+sc*v2rho2(1, 1) - e_rhoa_rhob(ii) = e_rhoa_rhob(ii)+sc*v2rho2(2, 1) - e_rhob_rhob(ii) = e_rhob_rhob(ii)+sc*v2rho2(3, 1) - e_ndrho_rhoa(ii) = e_ndrho_rhoa(ii)+sc*v2rhosigma(2, 1)*my_norm_drho - e_ndrho_rhob(ii) = e_ndrho_rhob(ii)+sc*v2rhosigma(5, 1)*my_norm_drho - e_ndrhoa_rhoa(ii) = e_ndrhoa_rhoa(ii)+ & - sc*(2.0_dp*v2rhosigma(1, 1)-v2rhosigma(2, 1))*my_norm_drhoa - e_ndrhoa_rhob(ii) = e_ndrhoa_rhob(ii)+ & - sc*(2.0_dp*v2rhosigma(4, 1)-v2rhosigma(5, 1))*my_norm_drhoa - e_ndrhob_rhoa(ii) = e_ndrhob_rhoa(ii)+ & - sc*(2.0_dp*v2rhosigma(3, 1)-v2rhosigma(2, 1))*my_norm_drhob - e_ndrhob_rhob(ii) = e_ndrhob_rhob(ii)+ & - sc*(2.0_dp*v2rhosigma(6, 1)-v2rhosigma(5, 1))*my_norm_drhob - e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii)+ & - sc*(vsigma(2, 1)+my_norm_drho**2*v2sigma2(4, 1)) - e_ndrho_ndrhoa(ii) = e_ndrho_ndrhoa(ii)+ & - sc*(2.0_dp*v2sigma2(2, 1)-v2sigma2(4, 1))*my_norm_drho*my_norm_drhoa - e_ndrho_ndrhob(ii) = e_ndrho_ndrhob(ii)+ & - sc*(2.0_dp*v2sigma2(5, 1)-v2sigma2(4, 1))*my_norm_drho*my_norm_drhob - e_ndrhoa_ndrhoa(ii) = e_ndrhoa_ndrhoa(ii)+ & - sc*(2.0_dp*vsigma(1, 1)-vsigma(2, 1)+my_norm_drhoa**2*( & - 4.0_dp*v2sigma2(1, 1)-4.0_dp*v2sigma2(2, 1)+v2sigma2(4, 1))) - e_ndrhoa_ndrhob(ii) = e_ndrhoa_ndrhob(ii)+ & - sc*(4.0_dp*v2sigma2(3, 1)-2.0_dp*v2sigma2(2, 1)- & - 2.0_dp*v2sigma2(5, 1)+v2sigma2(4, 1))*my_norm_drhoa*my_norm_drhob - e_ndrhob_ndrhob(ii) = e_ndrhob_ndrhob(ii)+ & - sc*(2.0_dp*vsigma(3, 1)-vsigma(2, 1)+my_norm_drhob**2*( & - 4.0_dp*v2sigma2(6, 1)-4.0_dp*v2sigma2(5, 1)+v2sigma2(4, 1))) + e_0(ii) = e_0(ii) + sc*exc(1)*(rhov(1, 1) + rhov(2, 1)) + e_rhoa(ii) = e_rhoa(ii) + sc*vrho(1, 1) + e_rhob(ii) = e_rhob(ii) + sc*vrho(2, 1) + e_ndrho(ii) = e_ndrho(ii) + sc*vsigma(2, 1)*my_norm_drho + e_ndrhoa(ii) = e_ndrhoa(ii) + & + sc*(2.0_dp*vsigma(1, 1) - vsigma(2, 1))*my_norm_drhoa + e_ndrhob(ii) = e_ndrhob(ii) + & + sc*(2.0_dp*vsigma(3, 1) - vsigma(2, 1))*my_norm_drhob + e_rhoa_rhoa(ii) = e_rhoa_rhoa(ii) + sc*v2rho2(1, 1) + e_rhoa_rhob(ii) = e_rhoa_rhob(ii) + sc*v2rho2(2, 1) + e_rhob_rhob(ii) = e_rhob_rhob(ii) + sc*v2rho2(3, 1) + e_ndrho_rhoa(ii) = e_ndrho_rhoa(ii) + sc*v2rhosigma(2, 1)*my_norm_drho + e_ndrho_rhob(ii) = e_ndrho_rhob(ii) + sc*v2rhosigma(5, 1)*my_norm_drho + e_ndrhoa_rhoa(ii) = e_ndrhoa_rhoa(ii) + & + sc*(2.0_dp*v2rhosigma(1, 1) - v2rhosigma(2, 1))*my_norm_drhoa + e_ndrhoa_rhob(ii) = e_ndrhoa_rhob(ii) + & + sc*(2.0_dp*v2rhosigma(4, 1) - v2rhosigma(5, 1))*my_norm_drhoa + e_ndrhob_rhoa(ii) = e_ndrhob_rhoa(ii) + & + sc*(2.0_dp*v2rhosigma(3, 1) - v2rhosigma(2, 1))*my_norm_drhob + e_ndrhob_rhob(ii) = e_ndrhob_rhob(ii) + & + sc*(2.0_dp*v2rhosigma(6, 1) - v2rhosigma(5, 1))*my_norm_drhob + e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii) + & + sc*(vsigma(2, 1) + my_norm_drho**2*v2sigma2(4, 1)) + e_ndrho_ndrhoa(ii) = e_ndrho_ndrhoa(ii) + & + sc*(2.0_dp*v2sigma2(2, 1) - v2sigma2(4, 1))*my_norm_drho*my_norm_drhoa + e_ndrho_ndrhob(ii) = e_ndrho_ndrhob(ii) + & + sc*(2.0_dp*v2sigma2(5, 1) - v2sigma2(4, 1))*my_norm_drho*my_norm_drhob + e_ndrhoa_ndrhoa(ii) = e_ndrhoa_ndrhoa(ii) + & + sc*(2.0_dp*vsigma(1, 1) - vsigma(2, 1) + my_norm_drhoa**2*( & + 4.0_dp*v2sigma2(1, 1) - 4.0_dp*v2sigma2(2, 1) + v2sigma2(4, 1))) + e_ndrhoa_ndrhob(ii) = e_ndrhoa_ndrhob(ii) + & + sc*(4.0_dp*v2sigma2(3, 1) - 2.0_dp*v2sigma2(2, 1) - & + 2.0_dp*v2sigma2(5, 1) + v2sigma2(4, 1))*my_norm_drhoa*my_norm_drhob + e_ndrhob_ndrhob(ii) = e_ndrhob_ndrhob(ii) + & + sc*(2.0_dp*vsigma(3, 1) - vsigma(2, 1) + my_norm_drhob**2*( & + 4.0_dp*v2sigma2(6, 1) - 4.0_dp*v2sigma2(5, 1) + v2sigma2(4, 1))) END IF END DO !$OMP END DO @@ -1962,7 +1962,7 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & my_rhob = MAX(rhob(ii), 0.0_dp) my_tau_a = MAX(tau_a(ii), 0.0_dp) my_tau_b = MAX(tau_b(ii), 0.0_dp) - IF (((my_rhoa+my_rhob) > epsilon_rho) .AND. ((my_tau_a+my_tau_b) > epsilon_tau)) THEN + IF (((my_rhoa + my_rhob) > epsilon_rho) .AND. ((my_tau_a + my_tau_b) > epsilon_tau)) THEN rhov(1, 1) = MAX(my_rhoa, EPSILON(0.0_dp)*1.e4_dp) rhov(2, 1) = MAX(my_rhob, EPSILON(0.0_dp)*1.e4_dp) my_norm_drhoa = MAX(norm_drhoa(ii), EPSILON(0.0_dp)*1.e4_dp) @@ -1970,7 +1970,7 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & my_norm_drho = MAX(norm_drho(ii), EPSILON(0.0_dp)*1.e4_dp) sigmav(1, 1) = my_norm_drhoa**2 sigmav(3, 1) = my_norm_drhob**2 - sigmav(2, 1) = 0.5_dp*(my_norm_drho**2-sigmav(1, 1)-sigmav(3, 1)) + sigmav(2, 1) = 0.5_dp*(my_norm_drho**2 - sigmav(1, 1) - sigmav(3, 1)) laplace_rhov(1, 1) = laplace_rhoa(ii) laplace_rhov(2, 1) = laplace_rhob(ii) tauv(1, 1) = MAX(my_tau_a, EPSILON(0.0_dp)*1.e4_dp) @@ -1979,7 +1979,7 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & tauv(2, 1) = MAX(tauv(2, 1), sigmav(3, 1)/(8.0_dp*rhov(2, 1))) CALL xc_f03_mgga_exc(xc_func, 1, rhov(1, 1), sigmav(1, 1), & laplace_rhov(1, 1), tauv(1, 1), exc) - e_0(ii) = e_0(ii)+sc*exc(1)*(rhov(1, 1)+rhov(2, 1)) + e_0(ii) = e_0(ii) + sc*exc(1)*(rhov(1, 1) + rhov(2, 1)) END IF END DO !$OMP END DO @@ -1990,7 +1990,7 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & my_rhob = MAX(rhob(ii), 0.0_dp) my_tau_a = MAX(tau_a(ii), 0.0_dp) my_tau_b = MAX(tau_b(ii), 0.0_dp) - IF (((my_rhoa+my_rhob) > epsilon_rho) .AND. ((my_tau_a+my_tau_b) > epsilon_tau)) THEN + IF (((my_rhoa + my_rhob) > epsilon_rho) .AND. ((my_tau_a + my_tau_b) > epsilon_tau)) THEN rhov(1, 1) = MAX(my_rhoa, EPSILON(0.0_dp)*1.e4_dp) rhov(2, 1) = MAX(my_rhob, EPSILON(0.0_dp)*1.e4_dp) my_norm_drhoa = MAX(norm_drhoa(ii), EPSILON(0.0_dp)*1.e4_dp) @@ -1998,7 +1998,7 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & my_norm_drho = MAX(norm_drho(ii), EPSILON(0.0_dp)*1.e4_dp) sigmav(1, 1) = my_norm_drhoa**2 sigmav(3, 1) = my_norm_drhob**2 - sigmav(2, 1) = 0.5_dp*(my_norm_drho**2-sigmav(1, 1)-sigmav(3, 1)) + sigmav(2, 1) = 0.5_dp*(my_norm_drho**2 - sigmav(1, 1) - sigmav(3, 1)) laplace_rhov(1, 1) = laplace_rhoa(ii) laplace_rhov(2, 1) = laplace_rhob(ii) tauv(1, 1) = MAX(my_tau_a, EPSILON(0.0_dp)*1.e4_dp) @@ -2007,17 +2007,17 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & tauv(2, 1) = MAX(tauv(2, 1), sigmav(3, 1)/(8.0_dp*rhov(2, 1))) CALL xc_f03_mgga_vxc(xc_func, 1, rhov(1, 1), sigmav(1, 1), & laplace_rhov(1, 1), tauv(1, 1), vrho(1, 1), vsigma(1, 1), vlapl(1, 1), vtau(1, 1)) - e_rhoa(ii) = e_rhoa(ii)+sc*vrho(1, 1) - e_rhob(ii) = e_rhob(ii)+sc*vrho(2, 1) - e_ndrho(ii) = e_ndrho(ii)+sc*vsigma(2, 1)*my_norm_drho - e_ndrhoa(ii) = e_ndrhoa(ii)+ & - sc*(2.0_dp*vsigma(1, 1)-vsigma(2, 1))*my_norm_drhoa - e_ndrhob(ii) = e_ndrhob(ii)+ & - sc*(2.0_dp*vsigma(3, 1)-vsigma(2, 1))*my_norm_drhob - e_laplace_rhoa(ii) = e_laplace_rhoa(ii)+sc*vlapl(1, 1) - e_laplace_rhob(ii) = e_laplace_rhob(ii)+sc*vlapl(2, 1) - e_tau_a(ii) = e_tau_a(ii)+sc*vtau(1, 1) - e_tau_b(ii) = e_tau_b(ii)+sc*vtau(2, 1) + e_rhoa(ii) = e_rhoa(ii) + sc*vrho(1, 1) + e_rhob(ii) = e_rhob(ii) + sc*vrho(2, 1) + e_ndrho(ii) = e_ndrho(ii) + sc*vsigma(2, 1)*my_norm_drho + e_ndrhoa(ii) = e_ndrhoa(ii) + & + sc*(2.0_dp*vsigma(1, 1) - vsigma(2, 1))*my_norm_drhoa + e_ndrhob(ii) = e_ndrhob(ii) + & + sc*(2.0_dp*vsigma(3, 1) - vsigma(2, 1))*my_norm_drhob + e_laplace_rhoa(ii) = e_laplace_rhoa(ii) + sc*vlapl(1, 1) + e_laplace_rhob(ii) = e_laplace_rhob(ii) + sc*vlapl(2, 1) + e_tau_a(ii) = e_tau_a(ii) + sc*vtau(1, 1) + e_tau_b(ii) = e_tau_b(ii) + sc*vtau(2, 1) END IF END DO !$OMP END DO @@ -2028,7 +2028,7 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & my_rhob = MAX(rhob(ii), 0.0_dp) my_tau_a = MAX(tau_a(ii), 0.0_dp) my_tau_b = MAX(tau_b(ii), 0.0_dp) - IF (((my_rhoa+my_rhob) > epsilon_rho) .AND. ((my_tau_a+my_tau_b) > epsilon_tau)) THEN + IF (((my_rhoa + my_rhob) > epsilon_rho) .AND. ((my_tau_a + my_tau_b) > epsilon_tau)) THEN rhov(1, 1) = MAX(my_rhoa, EPSILON(0.0_dp)*1.e4_dp) rhov(2, 1) = MAX(my_rhob, EPSILON(0.0_dp)*1.e4_dp) my_norm_drhoa = MAX(norm_drhoa(ii), EPSILON(0.0_dp)*1.e4_dp) @@ -2036,7 +2036,7 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & my_norm_drho = MAX(norm_drho(ii), EPSILON(0.0_dp)*1.e4_dp) sigmav(1, 1) = my_norm_drhoa**2 sigmav(3, 1) = my_norm_drhob**2 - sigmav(2, 1) = 0.5_dp*(my_norm_drho**2-sigmav(1, 1)-sigmav(3, 1)) + sigmav(2, 1) = 0.5_dp*(my_norm_drho**2 - sigmav(1, 1) - sigmav(3, 1)) laplace_rhov(1, 1) = laplace_rhoa(ii) laplace_rhov(2, 1) = laplace_rhob(ii) tauv(1, 1) = MAX(my_tau_a, EPSILON(0.0_dp)*1.e4_dp) @@ -2053,18 +2053,18 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & laplace_rhov(1, 1), tauv(1, 1), exc, & vrho(1, 1), vsigma(1, 1), vlapl(1, 1), vtau(1, 1)) END IF - e_0(ii) = e_0(ii)+sc*exc(1)*(rhov(1, 1)+rhov(2, 1)) - e_rhoa(ii) = e_rhoa(ii)+sc*vrho(1, 1) - e_rhob(ii) = e_rhob(ii)+sc*vrho(2, 1) - e_ndrho(ii) = e_ndrho(ii)+sc*vsigma(2, 1)*my_norm_drho - e_ndrhoa(ii) = e_ndrhoa(ii)+ & - sc*(2.0_dp*vsigma(1, 1)-vsigma(2, 1))*my_norm_drhoa - e_ndrhob(ii) = e_ndrhob(ii)+ & - sc*(2.0_dp*vsigma(3, 1)-vsigma(2, 1))*my_norm_drhob - e_laplace_rhoa(ii) = e_laplace_rhoa(ii)+sc*vlapl(1, 1) - e_laplace_rhob(ii) = e_laplace_rhob(ii)+sc*vlapl(2, 1) - e_tau_a(ii) = e_tau_a(ii)+sc*vtau(1, 1) - e_tau_b(ii) = e_tau_b(ii)+sc*vtau(2, 1) + e_0(ii) = e_0(ii) + sc*exc(1)*(rhov(1, 1) + rhov(2, 1)) + e_rhoa(ii) = e_rhoa(ii) + sc*vrho(1, 1) + e_rhob(ii) = e_rhob(ii) + sc*vrho(2, 1) + e_ndrho(ii) = e_ndrho(ii) + sc*vsigma(2, 1)*my_norm_drho + e_ndrhoa(ii) = e_ndrhoa(ii) + & + sc*(2.0_dp*vsigma(1, 1) - vsigma(2, 1))*my_norm_drhoa + e_ndrhob(ii) = e_ndrhob(ii) + & + sc*(2.0_dp*vsigma(3, 1) - vsigma(2, 1))*my_norm_drhob + e_laplace_rhoa(ii) = e_laplace_rhoa(ii) + sc*vlapl(1, 1) + e_laplace_rhob(ii) = e_laplace_rhob(ii) + sc*vlapl(2, 1) + e_tau_a(ii) = e_tau_a(ii) + sc*vtau(1, 1) + e_tau_b(ii) = e_tau_b(ii) + sc*vtau(2, 1) END IF END DO !$OMP END DO @@ -2075,7 +2075,7 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & my_rhob = MAX(rhob(ii), 0.0_dp) my_tau_a = MAX(tau_a(ii), 0.0_dp) my_tau_b = MAX(tau_b(ii), 0.0_dp) - IF (((my_rhoa+my_rhob) > epsilon_rho) .AND. ((my_tau_a+my_tau_b) > epsilon_tau)) THEN + IF (((my_rhoa + my_rhob) > epsilon_rho) .AND. ((my_tau_a + my_tau_b) > epsilon_tau)) THEN rhov(1, 1) = MAX(my_rhoa, EPSILON(0.0_dp)*1.e4_dp) rhov(2, 1) = MAX(my_rhob, EPSILON(0.0_dp)*1.e4_dp) my_norm_drhoa = MAX(norm_drhoa(ii), EPSILON(0.0_dp)*1.e4_dp) @@ -2083,7 +2083,7 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & my_norm_drho = MAX(norm_drho(ii), EPSILON(0.0_dp)*1.e4_dp) sigmav(1, 1) = my_norm_drhoa**2 sigmav(3, 1) = my_norm_drhob**2 - sigmav(2, 1) = 0.5_dp*(my_norm_drho**2-sigmav(1, 1)-sigmav(3, 1)) + sigmav(2, 1) = 0.5_dp*(my_norm_drho**2 - sigmav(1, 1) - sigmav(3, 1)) laplace_rhov(1, 1) = laplace_rhoa(ii) laplace_rhov(2, 1) = laplace_rhob(ii) tauv(1, 1) = MAX(my_tau_a, EPSILON(0.0_dp)*1.e4_dp) @@ -2106,72 +2106,72 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & v2lapl2(1, 1), v2tau2(1, 1), v2rhosigma(1, 1), v2rholapl(1, 1), & v2rhotau(1, 1), v2sigmalapl(1, 1), v2sigmatau(1, 1), v2lapltau(1, 1)) END IF - e_rhoa_rhoa(ii) = e_rhoa_rhoa(ii)+sc*v2rho2(1, 1) - e_rhoa_rhob(ii) = e_rhoa_rhob(ii)+sc*v2rho2(2, 1) - e_rhob_rhob(ii) = e_rhob_rhob(ii)+sc*v2rho2(3, 1) - e_ndrho_rhoa(ii) = e_ndrho_rhoa(ii)+sc*v2rhosigma(2, 1)*my_norm_drho - e_ndrho_rhob(ii) = e_ndrho_rhob(ii)+sc*v2rhosigma(5, 1)*my_norm_drho - e_ndrhoa_rhoa(ii) = e_ndrhoa_rhoa(ii)+ & - sc*(2.0_dp*v2rhosigma(1, 1)-v2rhosigma(2, 1))*my_norm_drhoa - e_ndrhoa_rhob(ii) = e_ndrhoa_rhob(ii)+ & - sc*(2.0_dp*v2rhosigma(4, 1)-v2rhosigma(5, 1))*my_norm_drhoa - e_ndrhob_rhoa(ii) = e_ndrhob_rhoa(ii)+ & - sc*(2.0_dp*v2rhosigma(3, 1)-v2rhosigma(2, 1))*my_norm_drhob - e_ndrhob_rhob(ii) = e_ndrhob_rhob(ii)+ & - sc*(2.0_dp*v2rhosigma(6, 1)-v2rhosigma(5, 1))*my_norm_drhob - e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii)+ & - sc*(vsigma(2, 1)+my_norm_drho**2*v2sigma2(4, 1)) - e_ndrho_ndrhoa(ii) = e_ndrho_ndrhoa(ii)+ & - sc*(2.0_dp*v2sigma2(2, 1)-v2sigma2(4, 1))*my_norm_drho*my_norm_drhoa - e_ndrho_ndrhob(ii) = e_ndrho_ndrhob(ii)+ & - sc*(2.0_dp*v2sigma2(5, 1)-v2sigma2(4, 1))*my_norm_drho*my_norm_drhob - e_ndrhoa_ndrhoa(ii) = e_ndrhoa_ndrhoa(ii)+ & - sc*(2.0_dp*vsigma(1, 1)-vsigma(2, 1)+my_norm_drhoa**2*( & - 4.0_dp*v2sigma2(1, 1)-4.0_dp*v2sigma2(2, 1)+v2sigma2(4, 1))) - e_ndrhoa_ndrhob(ii) = e_ndrhoa_ndrhob(ii)+ & - sc*(4.0_dp*v2sigma2(3, 1)-2.0_dp*v2sigma2(2, 1)- & - 2.0_dp*v2sigma2(5, 1)+v2sigma2(4, 1))*my_norm_drhoa*my_norm_drhob - e_ndrhob_ndrhob(ii) = e_ndrhob_ndrhob(ii)+ & - sc*(2.0_dp*vsigma(3, 1)-vsigma(2, 1)+my_norm_drhob**2*( & - 4.0_dp*v2sigma2(6, 1)-4.0_dp*v2sigma2(5, 1)+v2sigma2(4, 1))) - e_rhoa_laplace_rhoa(ii) = e_rhoa_laplace_rhoa(ii)+sc*v2rholapl(1, 1) - e_rhoa_laplace_rhob(ii) = e_rhoa_laplace_rhob(ii)+sc*v2rholapl(2, 1) - e_rhob_laplace_rhoa(ii) = e_rhob_laplace_rhoa(ii)+sc*v2rholapl(3, 1) - e_rhob_laplace_rhob(ii) = e_rhob_laplace_rhob(ii)+sc*v2rholapl(4, 1) - e_rhoa_tau_a(ii) = e_rhoa_tau_a(ii)+sc*v2rhotau(1, 1) - e_rhoa_tau_b(ii) = e_rhoa_tau_b(ii)+sc*v2rhotau(2, 1) - e_rhob_tau_a(ii) = e_rhob_tau_a(ii)+sc*v2rhotau(3, 1) - e_rhob_tau_b(ii) = e_rhob_tau_b(ii)+sc*v2rhotau(4, 1) - e_ndrho_laplace_rhoa(ii) = e_ndrho_laplace_rhoa(ii)+sc*v2sigmalapl(3, 1)*my_norm_drho - e_ndrho_laplace_rhob(ii) = e_ndrho_laplace_rhob(ii)+sc*v2sigmalapl(4, 1)*my_norm_drho - e_ndrhoa_laplace_rhoa(ii) = e_ndrhoa_laplace_rhoa(ii)+ & - sc*(2.0_dp*v2sigmalapl(1, 1)-v2sigmalapl(3, 1))*my_norm_drhoa - e_ndrhoa_laplace_rhob(ii) = e_ndrhoa_laplace_rhob(ii)+ & - sc*(2.0_dp*v2sigmalapl(2, 1)-v2sigmalapl(4, 1))*my_norm_drhoa - e_ndrhob_laplace_rhoa(ii) = e_ndrhob_laplace_rhoa(ii)+ & - sc*(2.0_dp*v2sigmalapl(5, 1)-v2sigmalapl(3, 1))*my_norm_drhob - e_ndrhob_laplace_rhob(ii) = e_ndrhob_laplace_rhob(ii)+ & - sc*(2.0_dp*v2sigmalapl(6, 1)-v2sigmalapl(4, 1))*my_norm_drhob - e_ndrho_tau_a(ii) = e_ndrho_tau_a(ii)+sc*v2sigmatau(3, 1)*my_norm_drho - e_ndrho_tau_b(ii) = e_ndrho_tau_b(ii)+sc*v2sigmatau(4, 1)*my_norm_drho - e_ndrhoa_tau_a(ii) = e_ndrhoa_tau_a(ii)+ & - sc*(2.0_dp*v2sigmatau(1, 1)-v2sigmatau(3, 1))*my_norm_drhoa - e_ndrhoa_tau_b(ii) = e_ndrhoa_tau_b(ii)+ & - sc*(2.0_dp*v2sigmatau(2, 1)-v2sigmatau(4, 1))*my_norm_drhoa - e_ndrhob_tau_a(ii) = e_ndrhob_tau_a(ii)+ & - sc*(2.0_dp*v2sigmatau(5, 1)-v2sigmatau(3, 1))*my_norm_drhob - e_ndrhob_tau_b(ii) = e_ndrhob_tau_b(ii)+ & - sc*(2.0_dp*v2sigmatau(6, 1)-v2sigmatau(4, 1))*my_norm_drhob - e_laplace_rhoa_laplace_rhoa(ii) = e_laplace_rhoa_laplace_rhoa(ii)+sc*v2lapl2(1, 1) - e_laplace_rhoa_laplace_rhob(ii) = e_laplace_rhoa_laplace_rhob(ii)+sc*v2lapl2(2, 1) - e_laplace_rhob_laplace_rhob(ii) = e_laplace_rhob_laplace_rhob(ii)+sc*v2lapl2(3, 1) - e_laplace_rhoa_tau_a(ii) = e_laplace_rhoa_tau_a(ii)+sc*v2lapltau(1, 1) - e_laplace_rhoa_tau_b(ii) = e_laplace_rhoa_tau_b(ii)+sc*v2lapltau(2, 1) - e_laplace_rhob_tau_a(ii) = e_laplace_rhob_tau_a(ii)+sc*v2lapltau(3, 1) - e_laplace_rhob_tau_b(ii) = e_laplace_rhob_tau_b(ii)+sc*v2lapltau(4, 1) - e_tau_a_tau_a(ii) = e_tau_a_tau_a(ii)+sc*v2tau2(1, 1) - e_tau_a_tau_b(ii) = e_tau_a_tau_b(ii)+sc*v2tau2(2, 1) - e_tau_b_tau_b(ii) = e_tau_b_tau_b(ii)+sc*v2tau2(3, 1) + e_rhoa_rhoa(ii) = e_rhoa_rhoa(ii) + sc*v2rho2(1, 1) + e_rhoa_rhob(ii) = e_rhoa_rhob(ii) + sc*v2rho2(2, 1) + e_rhob_rhob(ii) = e_rhob_rhob(ii) + sc*v2rho2(3, 1) + e_ndrho_rhoa(ii) = e_ndrho_rhoa(ii) + sc*v2rhosigma(2, 1)*my_norm_drho + e_ndrho_rhob(ii) = e_ndrho_rhob(ii) + sc*v2rhosigma(5, 1)*my_norm_drho + e_ndrhoa_rhoa(ii) = e_ndrhoa_rhoa(ii) + & + sc*(2.0_dp*v2rhosigma(1, 1) - v2rhosigma(2, 1))*my_norm_drhoa + e_ndrhoa_rhob(ii) = e_ndrhoa_rhob(ii) + & + sc*(2.0_dp*v2rhosigma(4, 1) - v2rhosigma(5, 1))*my_norm_drhoa + e_ndrhob_rhoa(ii) = e_ndrhob_rhoa(ii) + & + sc*(2.0_dp*v2rhosigma(3, 1) - v2rhosigma(2, 1))*my_norm_drhob + e_ndrhob_rhob(ii) = e_ndrhob_rhob(ii) + & + sc*(2.0_dp*v2rhosigma(6, 1) - v2rhosigma(5, 1))*my_norm_drhob + e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii) + & + sc*(vsigma(2, 1) + my_norm_drho**2*v2sigma2(4, 1)) + e_ndrho_ndrhoa(ii) = e_ndrho_ndrhoa(ii) + & + sc*(2.0_dp*v2sigma2(2, 1) - v2sigma2(4, 1))*my_norm_drho*my_norm_drhoa + e_ndrho_ndrhob(ii) = e_ndrho_ndrhob(ii) + & + sc*(2.0_dp*v2sigma2(5, 1) - v2sigma2(4, 1))*my_norm_drho*my_norm_drhob + e_ndrhoa_ndrhoa(ii) = e_ndrhoa_ndrhoa(ii) + & + sc*(2.0_dp*vsigma(1, 1) - vsigma(2, 1) + my_norm_drhoa**2*( & + 4.0_dp*v2sigma2(1, 1) - 4.0_dp*v2sigma2(2, 1) + v2sigma2(4, 1))) + e_ndrhoa_ndrhob(ii) = e_ndrhoa_ndrhob(ii) + & + sc*(4.0_dp*v2sigma2(3, 1) - 2.0_dp*v2sigma2(2, 1) - & + 2.0_dp*v2sigma2(5, 1) + v2sigma2(4, 1))*my_norm_drhoa*my_norm_drhob + e_ndrhob_ndrhob(ii) = e_ndrhob_ndrhob(ii) + & + sc*(2.0_dp*vsigma(3, 1) - vsigma(2, 1) + my_norm_drhob**2*( & + 4.0_dp*v2sigma2(6, 1) - 4.0_dp*v2sigma2(5, 1) + v2sigma2(4, 1))) + e_rhoa_laplace_rhoa(ii) = e_rhoa_laplace_rhoa(ii) + sc*v2rholapl(1, 1) + e_rhoa_laplace_rhob(ii) = e_rhoa_laplace_rhob(ii) + sc*v2rholapl(2, 1) + e_rhob_laplace_rhoa(ii) = e_rhob_laplace_rhoa(ii) + sc*v2rholapl(3, 1) + e_rhob_laplace_rhob(ii) = e_rhob_laplace_rhob(ii) + sc*v2rholapl(4, 1) + e_rhoa_tau_a(ii) = e_rhoa_tau_a(ii) + sc*v2rhotau(1, 1) + e_rhoa_tau_b(ii) = e_rhoa_tau_b(ii) + sc*v2rhotau(2, 1) + e_rhob_tau_a(ii) = e_rhob_tau_a(ii) + sc*v2rhotau(3, 1) + e_rhob_tau_b(ii) = e_rhob_tau_b(ii) + sc*v2rhotau(4, 1) + e_ndrho_laplace_rhoa(ii) = e_ndrho_laplace_rhoa(ii) + sc*v2sigmalapl(3, 1)*my_norm_drho + e_ndrho_laplace_rhob(ii) = e_ndrho_laplace_rhob(ii) + sc*v2sigmalapl(4, 1)*my_norm_drho + e_ndrhoa_laplace_rhoa(ii) = e_ndrhoa_laplace_rhoa(ii) + & + sc*(2.0_dp*v2sigmalapl(1, 1) - v2sigmalapl(3, 1))*my_norm_drhoa + e_ndrhoa_laplace_rhob(ii) = e_ndrhoa_laplace_rhob(ii) + & + sc*(2.0_dp*v2sigmalapl(2, 1) - v2sigmalapl(4, 1))*my_norm_drhoa + e_ndrhob_laplace_rhoa(ii) = e_ndrhob_laplace_rhoa(ii) + & + sc*(2.0_dp*v2sigmalapl(5, 1) - v2sigmalapl(3, 1))*my_norm_drhob + e_ndrhob_laplace_rhob(ii) = e_ndrhob_laplace_rhob(ii) + & + sc*(2.0_dp*v2sigmalapl(6, 1) - v2sigmalapl(4, 1))*my_norm_drhob + e_ndrho_tau_a(ii) = e_ndrho_tau_a(ii) + sc*v2sigmatau(3, 1)*my_norm_drho + e_ndrho_tau_b(ii) = e_ndrho_tau_b(ii) + sc*v2sigmatau(4, 1)*my_norm_drho + e_ndrhoa_tau_a(ii) = e_ndrhoa_tau_a(ii) + & + sc*(2.0_dp*v2sigmatau(1, 1) - v2sigmatau(3, 1))*my_norm_drhoa + e_ndrhoa_tau_b(ii) = e_ndrhoa_tau_b(ii) + & + sc*(2.0_dp*v2sigmatau(2, 1) - v2sigmatau(4, 1))*my_norm_drhoa + e_ndrhob_tau_a(ii) = e_ndrhob_tau_a(ii) + & + sc*(2.0_dp*v2sigmatau(5, 1) - v2sigmatau(3, 1))*my_norm_drhob + e_ndrhob_tau_b(ii) = e_ndrhob_tau_b(ii) + & + sc*(2.0_dp*v2sigmatau(6, 1) - v2sigmatau(4, 1))*my_norm_drhob + e_laplace_rhoa_laplace_rhoa(ii) = e_laplace_rhoa_laplace_rhoa(ii) + sc*v2lapl2(1, 1) + e_laplace_rhoa_laplace_rhob(ii) = e_laplace_rhoa_laplace_rhob(ii) + sc*v2lapl2(2, 1) + e_laplace_rhob_laplace_rhob(ii) = e_laplace_rhob_laplace_rhob(ii) + sc*v2lapl2(3, 1) + e_laplace_rhoa_tau_a(ii) = e_laplace_rhoa_tau_a(ii) + sc*v2lapltau(1, 1) + e_laplace_rhoa_tau_b(ii) = e_laplace_rhoa_tau_b(ii) + sc*v2lapltau(2, 1) + e_laplace_rhob_tau_a(ii) = e_laplace_rhob_tau_a(ii) + sc*v2lapltau(3, 1) + e_laplace_rhob_tau_b(ii) = e_laplace_rhob_tau_b(ii) + sc*v2lapltau(4, 1) + e_tau_a_tau_a(ii) = e_tau_a_tau_a(ii) + sc*v2tau2(1, 1) + e_tau_a_tau_b(ii) = e_tau_a_tau_b(ii) + sc*v2tau2(2, 1) + e_tau_b_tau_b(ii) = e_tau_b_tau_b(ii) + sc*v2tau2(3, 1) END IF END DO !$OMP END DO @@ -2182,7 +2182,7 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & my_rhob = MAX(rhob(ii), 0.0_dp) my_tau_a = MAX(tau_a(ii), 0.0_dp) my_tau_b = MAX(tau_b(ii), 0.0_dp) - IF (((my_rhoa+my_rhob) > epsilon_rho) .AND. ((my_tau_a+my_tau_b) > epsilon_tau)) THEN + IF (((my_rhoa + my_rhob) > epsilon_rho) .AND. ((my_tau_a + my_tau_b) > epsilon_tau)) THEN rhov(1, 1) = MAX(my_rhoa, EPSILON(0.0_dp)*1.e4_dp) rhov(2, 1) = MAX(my_rhob, EPSILON(0.0_dp)*1.e4_dp) my_norm_drhoa = MAX(norm_drhoa(ii), EPSILON(0.0_dp)*1.e4_dp) @@ -2190,7 +2190,7 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & my_norm_drho = MAX(norm_drho(ii), EPSILON(0.0_dp)*1.e4_dp) sigmav(1, 1) = my_norm_drhoa**2 sigmav(3, 1) = my_norm_drhob**2 - sigmav(2, 1) = 0.5_dp*(my_norm_drho**2-sigmav(1, 1)-sigmav(3, 1)) + sigmav(2, 1) = 0.5_dp*(my_norm_drho**2 - sigmav(1, 1) - sigmav(3, 1)) laplace_rhov(1, 1) = laplace_rhoa(ii) laplace_rhov(2, 1) = laplace_rhob(ii) tauv(1, 1) = MAX(my_tau_a, EPSILON(0.0_dp)*1.e4_dp) @@ -2214,84 +2214,84 @@ SUBROUTINE libxc_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, & v2lapl2(1, 1), v2tau2(1, 1), v2rhosigma(1, 1), v2rholapl(1, 1), & v2rhotau(1, 1), v2sigmalapl(1, 1), v2sigmatau(1, 1), v2lapltau(1, 1)) END IF - e_0(ii) = e_0(ii)+sc*exc(1)*(rhov(1, 1)+rhov(2, 1)) - e_rhoa(ii) = e_rhoa(ii)+sc*vrho(1, 1) - e_rhob(ii) = e_rhob(ii)+sc*vrho(2, 1) - e_ndrho(ii) = e_ndrho(ii)+sc*vsigma(2, 1)*my_norm_drho - e_ndrhoa(ii) = e_ndrhoa(ii)+ & - sc*(2.0_dp*vsigma(1, 1)-vsigma(2, 1))*my_norm_drhoa - e_ndrhob(ii) = e_ndrhob(ii)+ & - sc*(2.0_dp*vsigma(3, 1)-vsigma(2, 1))*my_norm_drhob - e_laplace_rhoa(ii) = e_laplace_rhoa(ii)+sc*vlapl(1, 1) - e_laplace_rhob(ii) = e_laplace_rhob(ii)+sc*vlapl(2, 1) - e_tau_a(ii) = e_tau_a(ii)+sc*vtau(1, 1) - e_tau_b(ii) = e_tau_b(ii)+sc*vtau(2, 1) - e_rhoa_rhoa(ii) = e_rhoa_rhoa(ii)+sc*v2rho2(1, 1) - e_rhoa_rhob(ii) = e_rhoa_rhob(ii)+sc*v2rho2(2, 1) - e_rhob_rhob(ii) = e_rhob_rhob(ii)+sc*v2rho2(3, 1) - e_ndrho_rhoa(ii) = e_ndrho_rhoa(ii)+sc*v2rhosigma(2, 1)*my_norm_drho - e_ndrho_rhob(ii) = e_ndrho_rhob(ii)+sc*v2rhosigma(5, 1)*my_norm_drho - e_ndrhoa_rhoa(ii) = e_ndrhoa_rhoa(ii)+ & - sc*(2.0_dp*v2rhosigma(1, 1)-v2rhosigma(2, 1))*my_norm_drhoa - e_ndrhoa_rhob(ii) = e_ndrhoa_rhob(ii)+ & - sc*(2.0_dp*v2rhosigma(4, 1)-v2rhosigma(5, 1))*my_norm_drhoa - e_ndrhob_rhoa(ii) = e_ndrhob_rhoa(ii)+ & - sc*(2.0_dp*v2rhosigma(3, 1)-v2rhosigma(2, 1))*my_norm_drhob - e_ndrhob_rhob(ii) = e_ndrhob_rhob(ii)+ & - sc*(2.0_dp*v2rhosigma(6, 1)-v2rhosigma(5, 1))*my_norm_drhob - e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii)+ & - sc*(vsigma(2, 1)+my_norm_drho**2*v2sigma2(4, 1)) - e_ndrho_ndrhoa(ii) = e_ndrho_ndrhoa(ii)+ & - sc*(2.0_dp*v2sigma2(2, 1)-v2sigma2(4, 1))*my_norm_drho*my_norm_drhoa - e_ndrho_ndrhob(ii) = e_ndrho_ndrhob(ii)+ & - sc*(2.0_dp*v2sigma2(5, 1)-v2sigma2(4, 1))*my_norm_drho*my_norm_drhob - e_ndrhoa_ndrhoa(ii) = e_ndrhoa_ndrhoa(ii)+ & - sc*(2.0_dp*vsigma(1, 1)-vsigma(2, 1)+my_norm_drhoa**2*( & - 4.0_dp*v2sigma2(1, 1)-4.0_dp*v2sigma2(2, 1)+v2sigma2(4, 1))) - e_ndrhoa_ndrhob(ii) = e_ndrhoa_ndrhob(ii)+ & - sc*(4.0_dp*v2sigma2(3, 1)-2.0_dp*v2sigma2(2, 1)- & - 2.0_dp*v2sigma2(5, 1)+v2sigma2(4, 1))*my_norm_drhoa*my_norm_drhob - e_ndrhob_ndrhob(ii) = e_ndrhob_ndrhob(ii)+ & - sc*(2.0_dp*vsigma(3, 1)-vsigma(2, 1)+my_norm_drhob**2*( & - 4.0_dp*v2sigma2(6, 1)-4.0_dp*v2sigma2(5, 1)+v2sigma2(4, 1))) - e_rhoa_laplace_rhoa(ii) = e_rhoa_laplace_rhoa(ii)+sc*v2rholapl(1, 1) - e_rhoa_laplace_rhob(ii) = e_rhoa_laplace_rhob(ii)+sc*v2rholapl(2, 1) - e_rhob_laplace_rhoa(ii) = e_rhob_laplace_rhoa(ii)+sc*v2rholapl(3, 1) - e_rhob_laplace_rhob(ii) = e_rhob_laplace_rhob(ii)+sc*v2rholapl(4, 1) - e_rhoa_tau_a(ii) = e_rhoa_tau_a(ii)+sc*v2rhotau(1, 1) - e_rhoa_tau_b(ii) = e_rhoa_tau_b(ii)+sc*v2rhotau(2, 1) - e_rhob_tau_a(ii) = e_rhob_tau_a(ii)+sc*v2rhotau(3, 1) - e_rhob_tau_b(ii) = e_rhob_tau_b(ii)+sc*v2rhotau(4, 1) - e_ndrho_laplace_rhoa(ii) = e_ndrho_laplace_rhoa(ii)+sc*v2sigmalapl(3, 1)*my_norm_drho - e_ndrho_laplace_rhob(ii) = e_ndrho_laplace_rhob(ii)+sc*v2sigmalapl(4, 1)*my_norm_drho - e_ndrhoa_laplace_rhoa(ii) = e_ndrhoa_laplace_rhoa(ii)+ & - sc*(2.0_dp*v2sigmalapl(1, 1)-v2sigmalapl(3, 1))*my_norm_drhoa - e_ndrhoa_laplace_rhob(ii) = e_ndrhoa_laplace_rhob(ii)+ & - sc*(2.0_dp*v2sigmalapl(2, 1)-v2sigmalapl(4, 1))*my_norm_drhoa - e_ndrhob_laplace_rhoa(ii) = e_ndrhob_laplace_rhoa(ii)+ & - sc*(2.0_dp*v2sigmalapl(5, 1)-v2sigmalapl(3, 1))*my_norm_drhob - e_ndrhob_laplace_rhob(ii) = e_ndrhob_laplace_rhob(ii)+ & - sc*(2.0_dp*v2sigmalapl(6, 1)-v2sigmalapl(4, 1))*my_norm_drhob - e_ndrho_tau_a(ii) = e_ndrho_tau_a(ii)+sc*v2sigmatau(3, 1)*my_norm_drho - e_ndrho_tau_b(ii) = e_ndrho_tau_b(ii)+sc*v2sigmatau(4, 1)*my_norm_drho - e_ndrhoa_tau_a(ii) = e_ndrhoa_tau_a(ii)+ & - sc*(2.0_dp*v2sigmatau(1, 1)-v2sigmatau(3, 1))*my_norm_drhoa - e_ndrhoa_tau_b(ii) = e_ndrhoa_tau_b(ii)+ & - sc*(2.0_dp*v2sigmatau(2, 1)-v2sigmatau(4, 1))*my_norm_drhoa - e_ndrhob_tau_a(ii) = e_ndrhob_tau_a(ii)+ & - sc*(2.0_dp*v2sigmatau(5, 1)-v2sigmatau(3, 1))*my_norm_drhob - e_ndrhob_tau_b(ii) = e_ndrhob_tau_b(ii)+ & - sc*(2.0_dp*v2sigmatau(6, 1)-v2sigmatau(4, 1))*my_norm_drhob - e_laplace_rhoa_laplace_rhoa(ii) = e_laplace_rhoa_laplace_rhoa(ii)+sc*v2lapl2(1, 1) - e_laplace_rhoa_laplace_rhob(ii) = e_laplace_rhoa_laplace_rhob(ii)+sc*v2lapl2(2, 1) - e_laplace_rhob_laplace_rhob(ii) = e_laplace_rhob_laplace_rhob(ii)+sc*v2lapl2(3, 1) - e_laplace_rhoa_tau_a(ii) = e_laplace_rhoa_tau_a(ii)+sc*v2lapltau(1, 1) - e_laplace_rhoa_tau_b(ii) = e_laplace_rhoa_tau_b(ii)+sc*v2lapltau(2, 1) - e_laplace_rhob_tau_a(ii) = e_laplace_rhob_tau_a(ii)+sc*v2lapltau(3, 1) - e_laplace_rhob_tau_b(ii) = e_laplace_rhob_tau_b(ii)+sc*v2lapltau(4, 1) - e_tau_a_tau_a(ii) = e_tau_a_tau_a(ii)+sc*v2tau2(1, 1) - e_tau_a_tau_b(ii) = e_tau_a_tau_b(ii)+sc*v2tau2(2, 1) - e_tau_b_tau_b(ii) = e_tau_b_tau_b(ii)+sc*v2tau2(3, 1) + e_0(ii) = e_0(ii) + sc*exc(1)*(rhov(1, 1) + rhov(2, 1)) + e_rhoa(ii) = e_rhoa(ii) + sc*vrho(1, 1) + e_rhob(ii) = e_rhob(ii) + sc*vrho(2, 1) + e_ndrho(ii) = e_ndrho(ii) + sc*vsigma(2, 1)*my_norm_drho + e_ndrhoa(ii) = e_ndrhoa(ii) + & + sc*(2.0_dp*vsigma(1, 1) - vsigma(2, 1))*my_norm_drhoa + e_ndrhob(ii) = e_ndrhob(ii) + & + sc*(2.0_dp*vsigma(3, 1) - vsigma(2, 1))*my_norm_drhob + e_laplace_rhoa(ii) = e_laplace_rhoa(ii) + sc*vlapl(1, 1) + e_laplace_rhob(ii) = e_laplace_rhob(ii) + sc*vlapl(2, 1) + e_tau_a(ii) = e_tau_a(ii) + sc*vtau(1, 1) + e_tau_b(ii) = e_tau_b(ii) + sc*vtau(2, 1) + e_rhoa_rhoa(ii) = e_rhoa_rhoa(ii) + sc*v2rho2(1, 1) + e_rhoa_rhob(ii) = e_rhoa_rhob(ii) + sc*v2rho2(2, 1) + e_rhob_rhob(ii) = e_rhob_rhob(ii) + sc*v2rho2(3, 1) + e_ndrho_rhoa(ii) = e_ndrho_rhoa(ii) + sc*v2rhosigma(2, 1)*my_norm_drho + e_ndrho_rhob(ii) = e_ndrho_rhob(ii) + sc*v2rhosigma(5, 1)*my_norm_drho + e_ndrhoa_rhoa(ii) = e_ndrhoa_rhoa(ii) + & + sc*(2.0_dp*v2rhosigma(1, 1) - v2rhosigma(2, 1))*my_norm_drhoa + e_ndrhoa_rhob(ii) = e_ndrhoa_rhob(ii) + & + sc*(2.0_dp*v2rhosigma(4, 1) - v2rhosigma(5, 1))*my_norm_drhoa + e_ndrhob_rhoa(ii) = e_ndrhob_rhoa(ii) + & + sc*(2.0_dp*v2rhosigma(3, 1) - v2rhosigma(2, 1))*my_norm_drhob + e_ndrhob_rhob(ii) = e_ndrhob_rhob(ii) + & + sc*(2.0_dp*v2rhosigma(6, 1) - v2rhosigma(5, 1))*my_norm_drhob + e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii) + & + sc*(vsigma(2, 1) + my_norm_drho**2*v2sigma2(4, 1)) + e_ndrho_ndrhoa(ii) = e_ndrho_ndrhoa(ii) + & + sc*(2.0_dp*v2sigma2(2, 1) - v2sigma2(4, 1))*my_norm_drho*my_norm_drhoa + e_ndrho_ndrhob(ii) = e_ndrho_ndrhob(ii) + & + sc*(2.0_dp*v2sigma2(5, 1) - v2sigma2(4, 1))*my_norm_drho*my_norm_drhob + e_ndrhoa_ndrhoa(ii) = e_ndrhoa_ndrhoa(ii) + & + sc*(2.0_dp*vsigma(1, 1) - vsigma(2, 1) + my_norm_drhoa**2*( & + 4.0_dp*v2sigma2(1, 1) - 4.0_dp*v2sigma2(2, 1) + v2sigma2(4, 1))) + e_ndrhoa_ndrhob(ii) = e_ndrhoa_ndrhob(ii) + & + sc*(4.0_dp*v2sigma2(3, 1) - 2.0_dp*v2sigma2(2, 1) - & + 2.0_dp*v2sigma2(5, 1) + v2sigma2(4, 1))*my_norm_drhoa*my_norm_drhob + e_ndrhob_ndrhob(ii) = e_ndrhob_ndrhob(ii) + & + sc*(2.0_dp*vsigma(3, 1) - vsigma(2, 1) + my_norm_drhob**2*( & + 4.0_dp*v2sigma2(6, 1) - 4.0_dp*v2sigma2(5, 1) + v2sigma2(4, 1))) + e_rhoa_laplace_rhoa(ii) = e_rhoa_laplace_rhoa(ii) + sc*v2rholapl(1, 1) + e_rhoa_laplace_rhob(ii) = e_rhoa_laplace_rhob(ii) + sc*v2rholapl(2, 1) + e_rhob_laplace_rhoa(ii) = e_rhob_laplace_rhoa(ii) + sc*v2rholapl(3, 1) + e_rhob_laplace_rhob(ii) = e_rhob_laplace_rhob(ii) + sc*v2rholapl(4, 1) + e_rhoa_tau_a(ii) = e_rhoa_tau_a(ii) + sc*v2rhotau(1, 1) + e_rhoa_tau_b(ii) = e_rhoa_tau_b(ii) + sc*v2rhotau(2, 1) + e_rhob_tau_a(ii) = e_rhob_tau_a(ii) + sc*v2rhotau(3, 1) + e_rhob_tau_b(ii) = e_rhob_tau_b(ii) + sc*v2rhotau(4, 1) + e_ndrho_laplace_rhoa(ii) = e_ndrho_laplace_rhoa(ii) + sc*v2sigmalapl(3, 1)*my_norm_drho + e_ndrho_laplace_rhob(ii) = e_ndrho_laplace_rhob(ii) + sc*v2sigmalapl(4, 1)*my_norm_drho + e_ndrhoa_laplace_rhoa(ii) = e_ndrhoa_laplace_rhoa(ii) + & + sc*(2.0_dp*v2sigmalapl(1, 1) - v2sigmalapl(3, 1))*my_norm_drhoa + e_ndrhoa_laplace_rhob(ii) = e_ndrhoa_laplace_rhob(ii) + & + sc*(2.0_dp*v2sigmalapl(2, 1) - v2sigmalapl(4, 1))*my_norm_drhoa + e_ndrhob_laplace_rhoa(ii) = e_ndrhob_laplace_rhoa(ii) + & + sc*(2.0_dp*v2sigmalapl(5, 1) - v2sigmalapl(3, 1))*my_norm_drhob + e_ndrhob_laplace_rhob(ii) = e_ndrhob_laplace_rhob(ii) + & + sc*(2.0_dp*v2sigmalapl(6, 1) - v2sigmalapl(4, 1))*my_norm_drhob + e_ndrho_tau_a(ii) = e_ndrho_tau_a(ii) + sc*v2sigmatau(3, 1)*my_norm_drho + e_ndrho_tau_b(ii) = e_ndrho_tau_b(ii) + sc*v2sigmatau(4, 1)*my_norm_drho + e_ndrhoa_tau_a(ii) = e_ndrhoa_tau_a(ii) + & + sc*(2.0_dp*v2sigmatau(1, 1) - v2sigmatau(3, 1))*my_norm_drhoa + e_ndrhoa_tau_b(ii) = e_ndrhoa_tau_b(ii) + & + sc*(2.0_dp*v2sigmatau(2, 1) - v2sigmatau(4, 1))*my_norm_drhoa + e_ndrhob_tau_a(ii) = e_ndrhob_tau_a(ii) + & + sc*(2.0_dp*v2sigmatau(5, 1) - v2sigmatau(3, 1))*my_norm_drhob + e_ndrhob_tau_b(ii) = e_ndrhob_tau_b(ii) + & + sc*(2.0_dp*v2sigmatau(6, 1) - v2sigmatau(4, 1))*my_norm_drhob + e_laplace_rhoa_laplace_rhoa(ii) = e_laplace_rhoa_laplace_rhoa(ii) + sc*v2lapl2(1, 1) + e_laplace_rhoa_laplace_rhob(ii) = e_laplace_rhoa_laplace_rhob(ii) + sc*v2lapl2(2, 1) + e_laplace_rhob_laplace_rhob(ii) = e_laplace_rhob_laplace_rhob(ii) + sc*v2lapl2(3, 1) + e_laplace_rhoa_tau_a(ii) = e_laplace_rhoa_tau_a(ii) + sc*v2lapltau(1, 1) + e_laplace_rhoa_tau_b(ii) = e_laplace_rhoa_tau_b(ii) + sc*v2lapltau(2, 1) + e_laplace_rhob_tau_a(ii) = e_laplace_rhob_tau_a(ii) + sc*v2lapltau(3, 1) + e_laplace_rhob_tau_b(ii) = e_laplace_rhob_tau_b(ii) + sc*v2lapltau(4, 1) + e_tau_a_tau_a(ii) = e_tau_a_tau_a(ii) + sc*v2tau2(1, 1) + e_tau_a_tau_b(ii) = e_tau_a_tau_b(ii) + sc*v2tau2(2, 1) + e_tau_b_tau_b(ii) = e_tau_b_tau_b(ii) + sc*v2tau2(3, 1) END IF END DO !$OMP END DO diff --git a/src/xc/xc_lyp.F b/src/xc/xc_lyp.F index 2b1102f354..20e0c502e5 100644 --- a/src/xc/xc_lyp.F +++ b/src/xc/xc_lyp.F @@ -146,7 +146,7 @@ SUBROUTINE lyp_lda_eval(rho_set, deriv_set, grad_deriv, lyp_params) CALL xc_rho_set_get(rho_set, rho_1_3=rho_1_3, rho=rho, & norm_drho=norm_drho, local_bounds=bo, rho_cutoff=epsilon_rho, & drho_cutoff=epsilon_norm_drho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rho @@ -292,17 +292,17 @@ SUBROUTINE lyp_lda_calc(rho, rho_1_3, norm_drho, & t14 = b*t13 t22 = my_ndrho**2 t26 = my_rho_1_3*t22 - t37 = -0.72e2_dp*t7-0.72e2_dp*t6*d-0.72e2_dp*t14* & - t7*cf-0.72e2_dp*t14*t6*cf*d+0.3e1_dp*t14& - & *t1*t22+0.10e2_dp*t14*t26*d+0.7e1_dp*t14 & - &*t26*c+0.7e1_dp*t14*t22*c*d - t38 = my_rho_1_3+d + t37 = -0.72e2_dp*t7 - 0.72e2_dp*t6*d - 0.72e2_dp*t14* & + t7*cf - 0.72e2_dp*t14*t6*cf*d + 0.3e1_dp*t14& + & *t1*t22 + 0.10e2_dp*t14*t26*d + 0.7e1_dp*t14 & + &*t26*c + 0.7e1_dp*t14*t22*c*d + t38 = my_rho_1_3 + d t39 = t38**2 t40 = 0.1e1_dp/t39 t41 = t37*t40 e_0(ii) = e_0(ii) & - +(t4*t41/0.72e2_dp)*sc + + (t4*t41/0.72e2_dp)*sc t44 = 0.1e1_dp/t1/t5 t45 = a*t44 t48 = my_rho_1_3*t5 @@ -320,13 +320,13 @@ SUBROUTINE lyp_lda_calc(rho, rho_1_3, norm_drho, & t93 = my_rho_1_3*my_rho t94 = 0.1e1_dp/t93 t95 = t88*t94 - t98 = -0.240e3_dp*t48-0.216e3_dp*t5*d-0.24e2_dp*t52& - & *t5*t13*cf-0.240e3_dp*t14*t48*cf- & - 0.24e2_dp*t52*t2*t62-0.216e3_dp*t14*t5*cf & - &*d+0.10e2_dp/0.3e1_dp*t52*t70*t22+0.2e1_dp* & - t14*t11*t22+0.10e2_dp/0.3e1_dp*t78*t80+ & - 0.10e2_dp/0.3e1_dp*t14*t69*t22*d+0.7e1_dp/ & - 0.3e1_dp*t88*t89*t22+0.7e1_dp/0.3e1_dp*t95* & + t98 = -0.240e3_dp*t48 - 0.216e3_dp*t5*d - 0.24e2_dp*t52& + & *t5*t13*cf - 0.240e3_dp*t14*t48*cf - & + 0.24e2_dp*t52*t2*t62 - 0.216e3_dp*t14*t5*cf & + &*d + 0.10e2_dp/0.3e1_dp*t52*t70*t22 + 0.2e1_dp* & + t14*t11*t22 + 0.10e2_dp/0.3e1_dp*t78*t80 + & + 0.10e2_dp/0.3e1_dp*t14*t69*t22*d + 0.7e1_dp/ & + 0.3e1_dp*t88*t89*t22 + 0.7e1_dp/0.3e1_dp*t95* & t80 t99 = t98*t40 t102 = 0.1e1_dp/t48 @@ -335,17 +335,17 @@ SUBROUTINE lyp_lda_calc(rho, rho_1_3, norm_drho, & t106 = t37*t105 e_rho(ii) = e_rho(ii) & - -(0.5e1_dp/0.216e3_dp*t45*t41-t4*t99/0.72e2_dp& - & +t103*t106/0.108e3_dp)*sc + - (0.5e1_dp/0.216e3_dp*t45*t41 - t4*t99/0.72e2_dp& + & + t103*t106/0.108e3_dp)*sc t112 = my_rho_1_3*my_ndrho - t123 = 0.6e1_dp*t14*t1*my_ndrho+0.20e2_dp*t14*t112 & - &*d+0.14e2_dp*t14*t112*c+0.14e2_dp*t14* & + t123 = 0.6e1_dp*t14*t1*my_ndrho + 0.20e2_dp*t14*t112 & + &*d + 0.14e2_dp*t14*t112*c + 0.14e2_dp*t14* & my_ndrho*c*d t124 = t123*t40 e_ndrho(ii) = e_ndrho(ii) & - +(t4*t124/0.72e2_dp)*sc + + (t4*t124/0.72e2_dp)*sc END IF END DO !$OMP END DO @@ -368,18 +368,18 @@ SUBROUTINE lyp_lda_calc(rho, rho_1_3, norm_drho, & t14 = b*t13 t22 = my_ndrho**2 t26 = my_rho_1_3*t22 - t37 = -0.72e2_dp*t7-0.72e2_dp*t6*d-0.72e2_dp*t14* & - t7*cf-0.72e2_dp*t14*t6*cf*d+0.3e1_dp*t14& - & *t1*t22+0.10e2_dp*t14*t26*d+0.7e1_dp*t14 & - &*t26*c+0.7e1_dp*t14*t22*c*d - t38 = my_rho_1_3+d + t37 = -0.72e2_dp*t7 - 0.72e2_dp*t6*d - 0.72e2_dp*t14* & + t7*cf - 0.72e2_dp*t14*t6*cf*d + 0.3e1_dp*t14& + & *t1*t22 + 0.10e2_dp*t14*t26*d + 0.7e1_dp*t14 & + &*t26*c + 0.7e1_dp*t14*t22*c*d + t38 = my_rho_1_3 + d t39 = t38**2 t40 = 0.1e1_dp/t39 t41 = t37*t40 IF (grad_deriv >= 0) THEN e_0(ii) = e_0(ii) & - +(t4*t41/0.72e2_dp)*sc + + (t4*t41/0.72e2_dp)*sc END IF t44 = 0.1e1_dp/t1/t5 @@ -399,13 +399,13 @@ SUBROUTINE lyp_lda_calc(rho, rho_1_3, norm_drho, & t93 = my_rho_1_3*my_rho t94 = 0.1e1_dp/t93 t95 = t88*t94 - t98 = -0.240e3_dp*t48-0.216e3_dp*t5*d-0.24e2_dp*t52& - & *t5*t13*cf-0.240e3_dp*t14*t48*cf- & - 0.24e2_dp*t52*t2*t62-0.216e3_dp*t14*t5*cf & - &*d+0.10e2_dp/0.3e1_dp*t52*t70*t22+0.2e1_dp* & - t14*t11*t22+0.10e2_dp/0.3e1_dp*t78*t80+ & - 0.10e2_dp/0.3e1_dp*t14*t69*t22*d+0.7e1_dp/ & - 0.3e1_dp*t88*t89*t22+0.7e1_dp/0.3e1_dp*t95* & + t98 = -0.240e3_dp*t48 - 0.216e3_dp*t5*d - 0.24e2_dp*t52& + & *t5*t13*cf - 0.240e3_dp*t14*t48*cf - & + 0.24e2_dp*t52*t2*t62 - 0.216e3_dp*t14*t5*cf & + &*d + 0.10e2_dp/0.3e1_dp*t52*t70*t22 + 0.2e1_dp* & + t14*t11*t22 + 0.10e2_dp/0.3e1_dp*t78*t80 + & + 0.10e2_dp/0.3e1_dp*t14*t69*t22*d + 0.7e1_dp/ & + 0.3e1_dp*t88*t89*t22 + 0.7e1_dp/0.3e1_dp*t95* & t80 t99 = t98*t40 t102 = 0.1e1_dp/t48 @@ -413,17 +413,17 @@ SUBROUTINE lyp_lda_calc(rho, rho_1_3, norm_drho, & t105 = 0.1e1_dp/t39/t38 t106 = t37*t105 t112 = my_rho_1_3*my_ndrho - t123 = 0.6e1_dp*t14*t1*my_ndrho+0.20e2_dp*t14*t112 & - &*d+0.14e2_dp*t14*t112*c+0.14e2_dp*t14* & + t123 = 0.6e1_dp*t14*t1*my_ndrho + 0.20e2_dp*t14*t112 & + &*d + 0.14e2_dp*t14*t112*c + 0.14e2_dp*t14* & my_ndrho*c*d t124 = t123*t40 IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN e_rho(ii) = e_rho(ii) & - -(0.5e1_dp/0.216e3_dp*t45*t41-t4*t99/0.72e2_dp& - & +t103*t106/0.108e3_dp)*sc + - (0.5e1_dp/0.216e3_dp*t45*t41 - t4*t99/0.72e2_dp& + & + t103*t106/0.108e3_dp)*sc e_ndrho(ii) = e_ndrho(ii) & - +(t4*t124/0.72e2_dp)*sc + + (t4*t124/0.72e2_dp)*sc END IF t127 = 0.1e1_dp/t1/t6 @@ -438,16 +438,16 @@ SUBROUTINE lyp_lda_calc(rho, rho_1_3, norm_drho, & t184 = b*t87*c t185 = t102*t13 t189 = t184*t44 - t192 = -0.560e3_dp*t93-0.432e3_dp*my_rho*d-0.128e3_dp& - & *t52*my_rho*t13*cf-0.8e1_dp*t88*t1*t13* & - cf-0.560e3_dp*t14*t93*cf-0.112e3_dp*t52*t1& - & *t62-0.8e1_dp*t88*my_rho_1_3*t62-0.432e3_dp* & - t14*my_rho*cf*d-0.14e2_dp/0.9e1_dp*t52* & - t161*t22-0.11e2_dp/0.9e1_dp*t88*t166*t22- & - 0.2e1_dp/0.3e1_dp*t14*t94*t22-0.20e2_dp/ & - 0.9e1_dp*t173*t80-0.2e1_dp*t176*t80- & - 0.20e2_dp/0.9e1_dp*t14*t3*t22*d+0.7e1_dp/ & - 0.9e1_dp*t184*t185*t22+0.7e1_dp/0.9e1_dp* & + t192 = -0.560e3_dp*t93 - 0.432e3_dp*my_rho*d - 0.128e3_dp& + & *t52*my_rho*t13*cf - 0.8e1_dp*t88*t1*t13* & + cf - 0.560e3_dp*t14*t93*cf - 0.112e3_dp*t52*t1& + & *t62 - 0.8e1_dp*t88*my_rho_1_3*t62 - 0.432e3_dp* & + t14*my_rho*cf*d - 0.14e2_dp/0.9e1_dp*t52* & + t161*t22 - 0.11e2_dp/0.9e1_dp*t88*t166*t22 - & + 0.2e1_dp/0.3e1_dp*t14*t94*t22 - 0.20e2_dp/ & + 0.9e1_dp*t173*t80 - 0.2e1_dp*t176*t80 - & + 0.20e2_dp/0.9e1_dp*t14*t3*t22*d + 0.7e1_dp/ & + 0.9e1_dp*t184*t185*t22 + 0.7e1_dp/0.9e1_dp* & t189*t80 t193 = t192*t40 t196 = t98*t105 @@ -457,77 +457,77 @@ SUBROUTINE lyp_lda_calc(rho, rho_1_3, norm_drho, & t202 = 0.1e1_dp/t201 t203 = t37*t202 t215 = t13*my_ndrho*d - t227 = 0.20e2_dp/0.3e1_dp*t52*t70*my_ndrho+0.4e1_dp* & - t14*t11*my_ndrho+0.20e2_dp/0.3e1_dp*t78*t215& - & +0.20e2_dp/0.3e1_dp*t14*t69*my_ndrho*d+ & - 0.14e2_dp/0.3e1_dp*t88*t89*my_ndrho+0.14e2_dp & + t227 = 0.20e2_dp/0.3e1_dp*t52*t70*my_ndrho + 0.4e1_dp* & + t14*t11*my_ndrho + 0.20e2_dp/0.3e1_dp*t78*t215& + & + 0.20e2_dp/0.3e1_dp*t14*t69*my_ndrho*d + & + 0.14e2_dp/0.3e1_dp*t88*t89*my_ndrho + 0.14e2_dp & &/0.3e1_dp*t95*t215 t228 = t227*t40 t231 = t123*t105 - t245 = 0.6e1_dp*t14*t1+0.20e2_dp*t14*my_rho_1_3*d+ & - 0.14e2_dp*t14*my_rho_1_3*c+0.14e2_dp*t14*c* & + t245 = 0.6e1_dp*t14*t1 + 0.20e2_dp*t14*my_rho_1_3*d + & + 0.14e2_dp*t14*my_rho_1_3*c + 0.14e2_dp*t14*c* & d t246 = t245*t40 IF (grad_deriv >= 2 .OR. grad_deriv == -2) THEN e_rho_rho(ii) = e_rho_rho(ii) & - +(0.5e1_dp/0.81e2_dp*t128*t41-0.5e1_dp/0.108e3_dp& - & *t45*t99+t134*t106/0.27e2_dp+t4*t193/ & - 0.72e2_dp-t103*t196/0.54e2_dp+t200*t203/ & - 0.108e3_dp)*sc + + (0.5e1_dp/0.81e2_dp*t128*t41 - 0.5e1_dp/0.108e3_dp& + & *t45*t99 + t134*t106/0.27e2_dp + t4*t193/ & + 0.72e2_dp - t103*t196/0.54e2_dp + t200*t203/ & + 0.108e3_dp)*sc e_ndrho_rho(ii) = e_ndrho_rho(ii) & - -(0.5e1_dp/0.216e3_dp*t45*t124-t4*t228/ & - 0.72e2_dp+t103*t231/0.108e3_dp)*sc + - (0.5e1_dp/0.216e3_dp*t45*t124 - t4*t228/ & + 0.72e2_dp + t103*t231/0.108e3_dp)*sc e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii) & - +(t4*t246/0.72e2_dp)*sc + + (t4*t246/0.72e2_dp)*sc END IF t248 = t5**2 t265 = 0.1e1_dp/t248 t278 = t87**2 t279 = b*t278 - t332 = -0.432e3_dp*d-0.2240e4_dp/0.3e1_dp*my_rho_1_3- & - 0.74e2_dp/0.27e2_dp*t184*t127*t80+0.100e3_dp/ & - 0.27e2_dp*t14*t44*t22*d+0.7e1_dp/0.27e2_dp* & - t279*t127*t13*t22-0.8e1_dp/0.3e1_dp*t184* & - t70*cf-0.2240e4_dp/0.3e1_dp*t14*my_rho_1_3* & - cf-0.48e2_dp*t88*t11*t13*cf-0.944e3_dp/ & - 0.3e1_dp*t52*t61-0.40e2_dp*t88*t69*t62- & - 0.656e3_dp/0.3e1_dp*t52*t11*t62+0.7e1_dp/ & - 0.27e2_dp*t279*t265*t80+0.64e2_dp/0.27e2_dp* & - t52*t44*t13*t22-0.8e1_dp/0.3e1_dp*t184*t77& - & *t62-0.432e3_dp*t14*cf*d+0.52e2_dp/ & - 0.27e2_dp*t88*t199*t13*t22-0.20e2_dp/ & - 0.9e1_dp*t184*t133*t13*t22+0.8e1_dp/0.9e1_dp& - & *t14*t102*t22+0.100e3_dp/0.27e2_dp*t52*t199& - & *t80+0.106e3_dp/0.27e2_dp*t88*t133*t80 + t332 = -0.432e3_dp*d - 0.2240e4_dp/0.3e1_dp*my_rho_1_3 - & + 0.74e2_dp/0.27e2_dp*t184*t127*t80 + 0.100e3_dp/ & + 0.27e2_dp*t14*t44*t22*d + 0.7e1_dp/0.27e2_dp* & + t279*t127*t13*t22 - 0.8e1_dp/0.3e1_dp*t184* & + t70*cf - 0.2240e4_dp/0.3e1_dp*t14*my_rho_1_3* & + cf - 0.48e2_dp*t88*t11*t13*cf - 0.944e3_dp/ & + 0.3e1_dp*t52*t61 - 0.40e2_dp*t88*t69*t62 - & + 0.656e3_dp/0.3e1_dp*t52*t11*t62 + 0.7e1_dp/ & + 0.27e2_dp*t279*t265*t80 + 0.64e2_dp/0.27e2_dp* & + t52*t44*t13*t22 - 0.8e1_dp/0.3e1_dp*t184*t77& + & *t62 - 0.432e3_dp*t14*cf*d + 0.52e2_dp/ & + 0.27e2_dp*t88*t199*t13*t22 - 0.20e2_dp/ & + 0.9e1_dp*t184*t133*t13*t22 + 0.8e1_dp/0.9e1_dp& + & *t14*t102*t22 + 0.100e3_dp/0.27e2_dp*t52*t199& + & *t80 + 0.106e3_dp/0.27e2_dp*t88*t133*t80 IF (grad_deriv >= 3 .OR. grad_deriv == -3) THEN e_rho_rho_rho(ii) = e_rho_rho_rho(ii) & - -(0.55e2_dp/0.243e3_dp*a/t1/t248*t41-0.5e1_dp & - &/0.27e2_dp*t128*t99+0.40e2_dp/0.243e3_dp*a/ & - my_rho_1_3/t248*t106+0.5e1_dp/0.72e2_dp*t45* & - t193-t134*t196/0.9e1_dp+0.7e1_dp/0.108e3_dp* & - a*t265*t203-t4*t332*t40/0.72e2_dp+t103* & - t192*t105/0.36e2_dp-t200*t98*t202/0.36e2_dp & - &+t128*t37/t201/t38/0.81e2_dp)*sc + - (0.55e2_dp/0.243e3_dp*a/t1/t248*t41 - 0.5e1_dp & + &/0.27e2_dp*t128*t99 + 0.40e2_dp/0.243e3_dp*a/ & + my_rho_1_3/t248*t106 + 0.5e1_dp/0.72e2_dp*t45* & + t193 - t134*t196/0.9e1_dp + 0.7e1_dp/0.108e3_dp* & + a*t265*t203 - t4*t332*t40/0.72e2_dp + t103* & + t192*t105/0.36e2_dp - t200*t98*t202/0.36e2_dp & + &+ t128*t37/t201/t38/0.81e2_dp)*sc e_ndrho_rho_rho(ii) = e_ndrho_rho_rho(ii) & - +(0.5e1_dp/0.81e2_dp*t128*t124-0.5e1_dp/ & - 0.108e3_dp*t45*t228+t134*t231/0.27e2_dp+t4*& - & (-0.28e2_dp/0.9e1_dp*t52*t161*my_ndrho- & - 0.22e2_dp/0.9e1_dp*t88*t166*my_ndrho-0.4e1_dp & - &/0.3e1_dp*t14*t94*my_ndrho-0.40e2_dp/0.9e1_dp & - &*t173*t215-0.4e1_dp*t176*t215-0.40e2_dp/ & - 0.9e1_dp*t14*t3*my_ndrho*d+0.14e2_dp/ & - 0.9e1_dp*t184*t185*my_ndrho+0.14e2_dp/0.9e1_dp& - & *t189*t215)*t40/0.72e2_dp-t103*t227*t105/ & - 0.54e2_dp+t200*t123*t202/0.108e3_dp)*sc + + (0.5e1_dp/0.81e2_dp*t128*t124 - 0.5e1_dp/ & + 0.108e3_dp*t45*t228 + t134*t231/0.27e2_dp + t4*& + & (-0.28e2_dp/0.9e1_dp*t52*t161*my_ndrho - & + 0.22e2_dp/0.9e1_dp*t88*t166*my_ndrho - 0.4e1_dp & + &/0.3e1_dp*t14*t94*my_ndrho - 0.40e2_dp/0.9e1_dp & + &*t173*t215 - 0.4e1_dp*t176*t215 - 0.40e2_dp/ & + 0.9e1_dp*t14*t3*my_ndrho*d + 0.14e2_dp/ & + 0.9e1_dp*t184*t185*my_ndrho + 0.14e2_dp/0.9e1_dp& + & *t189*t215)*t40/0.72e2_dp - t103*t227*t105/ & + 0.54e2_dp + t200*t123*t202/0.108e3_dp)*sc e_ndrho_ndrho_rho(ii) = e_ndrho_ndrho_rho(ii) & - -(0.5e1_dp/0.216e3_dp*t45*t246-t4*(0.20e2_dp/ & - 0.3e1_dp*t52*t70+0.4e1_dp*t14*t11+0.20e2_dp & - &/0.3e1_dp*t52*t89*d+0.20e2_dp/0.3e1_dp*t14* & - t69*d+0.14e2_dp/0.3e1_dp*t88*t89+0.14e2_dp/ & - 0.3e1_dp*t88*t94*t13*d)*t40/0.72e2_dp+t103& + - (0.5e1_dp/0.216e3_dp*t45*t246 - t4*(0.20e2_dp/ & + 0.3e1_dp*t52*t70 + 0.4e1_dp*t14*t11 + 0.20e2_dp & + &/0.3e1_dp*t52*t89*d + 0.20e2_dp/0.3e1_dp*t14* & + t69*d + 0.14e2_dp/0.3e1_dp*t88*t89 + 0.14e2_dp/ & + 0.3e1_dp*t88*t94*t13*d)*t40/0.72e2_dp + t103& & *t245*t105/0.108e3_dp)*sc END IF END IF @@ -759,7 +759,7 @@ SUBROUTINE lyp_lsd_eval(rho_set, deriv_set, grad_deriv, lyp_params) norm_drhob=norm_drhob, norm_drho=norm_drho, & rho_cutoff=epsilon_rho, & drho_cutoff=epsilon_drho, local_bounds=bo) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rhoa e_0 => dummy @@ -933,7 +933,7 @@ SUBROUTINE lyp_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & DO ii = 1, npoints my_rhoa = MAX(rhoa(ii), 0.0_dp) my_rhob = MAX(rhob(ii), 0.0_dp) - my_rho = my_rhoa+my_rhob + my_rho = my_rhoa + my_rhob IF (my_rho > epsilon_rho) THEN my_ndrho = norm_drho(ii) my_ndrhoa = norm_drhoa(ii) @@ -942,7 +942,7 @@ SUBROUTINE lyp_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & t1 = my_rho**(0.1e1_dp/0.3e1_dp) t2 = 0.1e1_dp/t1 t3 = d*t2 - t4 = 0.1e1_dp+t3 + t4 = 0.1e1_dp + t3 t5 = 0.1e1_dp/t4 t6 = a*t5 t7 = my_rhoa*my_rhob @@ -965,39 +965,39 @@ SUBROUTINE lyp_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & t29 = my_rhob**2 t30 = my_rhob**(0.1e1_dp/0.3e1_dp) t31 = t30**2 - t35 = 0.8e1_dp*t24*(t27*t25+t31*t29) + t35 = 0.8e1_dp*t24*(t27*t25 + t31*t29) t37 = t3*t5 - t39 = 0.47e2_dp/0.18e2_dp-0.7e1_dp/0.18e2_dp*t13- & + t39 = 0.47e2_dp/0.18e2_dp - 0.7e1_dp/0.18e2_dp*t13 - & 0.7e1_dp/0.18e2_dp*t37 t40 = my_ndrho**2 t41 = t39*t40 - t44 = 0.5e1_dp/0.2e1_dp-t13/0.18e2_dp-t37/0.18e2_dp + t44 = 0.5e1_dp/0.2e1_dp - t13/0.18e2_dp - t37/0.18e2_dp t45 = my_ndrhoa**2 t46 = my_ndrhob**2 - t47 = t45+t46 + t47 = t45 + t46 t48 = t44*t47 - t49 = t13+t37-0.11e2_dp + t49 = t13 + t37 - 0.11e2_dp t50 = my_rhoa*t8 t52 = my_rhob*t8 - t54 = t50*t45+t52*t46 + t54 = t50*t45 + t52*t46 t56 = t49*t54/0.9e1_dp - t57 = t35+t41-t48-t56 + t57 = t35 + t41 - t48 - t56 t61 = 0.2e1_dp/0.3e1_dp*t16 - t62 = t61-t25 - t64 = t61-t29 - t66 = t7*t57-0.2e1_dp/0.3e1_dp*t16*t40+t62*t46+ & + t62 = t61 - t25 + t64 = t61 - t29 + t66 = t7*t57 - 0.2e1_dp/0.3e1_dp*t16*t40 + t62*t46 + & t64*t45 IF (grad_deriv >= 0 .AND. my_rho > epsilon_rho) THEN e_0(ii) = e_0(ii) & - -(0.4e1_dp*t6*t7*t8+t15*t21*t66)*sc + - (0.4e1_dp*t6*t7*t8 + t15*t21*t66)*sc END IF !-------- t72 = t27*my_rhoa t75 = t49*t8 - t78 = 0.64e2_dp/0.3e1_dp*t24*t72-t75*t45/0.9e1_dp - t82 = my_rhob*t57+t7*t78-0.2e1_dp*my_rhoa*t46 + t78 = 0.64e2_dp/0.3e1_dp*t24*t72 - t75*t45/0.9e1_dp + t82 = my_rhob*t57 + t7*t78 - 0.2e1_dp*my_rhoa*t46 t85 = t4**2 t86 = 0.1e1_dp/t85 t87 = a*t86 @@ -1021,62 +1021,62 @@ SUBROUTINE lyp_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & t118 = 0.11e2_dp/0.3e1_dp*t15*t115*t66 t120 = 0.1e1_dp/t1/my_rho t124 = d**2 - t129 = c*t120+d*t120*t5-t124/t18/my_rho*t86 + t129 = c*t120 + d*t120*t5 - t124/t18/my_rho*t86 t130 = 0.7e1_dp/0.54e2_dp*t129 t132 = t129/0.54e2_dp t135 = -t129/0.3e1_dp t138 = my_rhoa*t95 t140 = my_rhob*t95 - t142 = -t138*t45-t140*t46 - t145 = t130*t40-t132*t47-t135*t54/0.9e1_dp-t49* & + t142 = -t138*t45 - t140*t46 + t145 = t130*t40 - t132*t47 - t135*t54/0.9e1_dp - t49* & t142/0.9e1_dp - t153 = t7*t145-0.4e1_dp/0.3e1_dp*my_rho*t40+ & - 0.4e1_dp/0.3e1_dp*my_rho*t46+0.4e1_dp/0.3e1_dp& + t153 = t7*t145 - 0.4e1_dp/0.3e1_dp*my_rho*t40 + & + 0.4e1_dp/0.3e1_dp*my_rho*t46 + 0.4e1_dp/0.3e1_dp& & *my_rho*t45 t155 = t15*t21*t153 IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN e_ra(ii) = e_ra(ii) & - -(0.4e1_dp*t6*t52+t15*t21*t82+t94-t98+ & - t107+t112-t118+t155)*sc + - (0.4e1_dp*t6*t52 + t15*t21*t82 + t94 - t98 + & + t107 + t112 - t118 + t155)*sc END IF t159 = t31*my_rhob - t164 = 0.64e2_dp/0.3e1_dp*t24*t159-t75*t46/0.9e1_dp - t168 = my_rhoa*t57+t7*t164-0.2e1_dp*my_rhob*t45 + t164 = 0.64e2_dp/0.3e1_dp*t24*t159 - t75*t46/0.9e1_dp + t168 = my_rhoa*t57 + t7*t164 - 0.2e1_dp*my_rhob*t45 IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN e_rb(ii) = e_rb(ii) & - -(0.4e1_dp*t6*t50+t15*t21*t168+t94-t98+ & - t107+t112-t118+t155)*sc + - (0.4e1_dp*t6*t50 + t15*t21*t168 + t94 - t98 + & + t107 + t112 - t118 + t155)*sc END IF t171 = t39*my_ndrho - t176 = 0.2e1_dp*t7*t171-0.4e1_dp/0.3e1_dp*t16*my_ndrho + t176 = 0.2e1_dp*t7*t171 - 0.4e1_dp/0.3e1_dp*t16*my_ndrho IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN e_ndr(ii) = e_ndr(ii) & - -(t15*t21*t176)*sc + - (t15*t21*t176)*sc END IF t181 = t49*my_rhoa t182 = t8*my_ndrhoa - t185 = -0.2e1_dp*t44*my_ndrhoa-0.2e1_dp/0.9e1_dp*t181*t182 - t189 = t7*t185+0.2e1_dp*t64*my_ndrhoa + t185 = -0.2e1_dp*t44*my_ndrhoa - 0.2e1_dp/0.9e1_dp*t181*t182 + t189 = t7*t185 + 0.2e1_dp*t64*my_ndrhoa IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN e_ndra(ii) = e_ndra(ii) & - -(t15*t21*t189)*sc + - (t15*t21*t189)*sc END IF t194 = t49*my_rhob t195 = t8*my_ndrhob - t198 = -0.2e1_dp*t44*my_ndrhob-0.2e1_dp/0.9e1_dp*t194*t195 - t202 = t7*t198+0.2e1_dp*t62*my_ndrhob + t198 = -0.2e1_dp*t44*my_ndrhob - 0.2e1_dp/0.9e1_dp*t194*t195 + t202 = t7*t198 + 0.2e1_dp*t62*my_ndrhob IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN e_ndrb(ii) = e_ndrb(ii) & - -(t15*t21*t202)*sc + - (t15*t21*t202)*sc END IF !------- @@ -1101,17 +1101,17 @@ SUBROUTINE lyp_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & t265 = t124/t18/t16*t86 t268 = 0.1e1_dp/t17 t270 = t124*d*t268*t238 - t304 = t15*t21*(t7*((-0.14e2_dp/0.81e2_dp*t257- & - 0.14e2_dp/0.81e2_dp*t260+0.7e1_dp/0.27e2_dp* & - t265-0.7e1_dp/0.81e2_dp*t270)*t40-(-0.2e1_dp/ & - 0.81e2_dp*t257-0.2e1_dp/0.81e2_dp*t260+t265/ & - 0.27e2_dp-t270/0.81e2_dp)*t47-(0.4e1_dp/ & - 0.9e1_dp*t257+0.4e1_dp/0.9e1_dp*t260-0.2e1_dp & - &/0.3e1_dp*t265+0.2e1_dp/0.9e1_dp*t270)*t54/ & - 0.9e1_dp-0.2e1_dp/0.9e1_dp*t135*t142-t49*& - & (0.2e1_dp*my_rhoa*t268*t45+0.2e1_dp*my_rhob* & - t268*t46)/0.9e1_dp)-0.4e1_dp/0.3e1_dp*t40+ & - 0.4e1_dp/0.3e1_dp*t46+0.4e1_dp/0.3e1_dp*t45) + t304 = t15*t21*(t7*((-0.14e2_dp/0.81e2_dp*t257 - & + 0.14e2_dp/0.81e2_dp*t260 + 0.7e1_dp/0.27e2_dp* & + t265 - 0.7e1_dp/0.81e2_dp*t270)*t40 - (-0.2e1_dp/ & + 0.81e2_dp*t257 - 0.2e1_dp/0.81e2_dp*t260 + t265/ & + 0.27e2_dp - t270/0.81e2_dp)*t47 - (0.4e1_dp/ & + 0.9e1_dp*t257 + 0.4e1_dp/0.9e1_dp*t260 - 0.2e1_dp & + &/0.3e1_dp*t265 + 0.2e1_dp/0.9e1_dp*t270)*t54/ & + 0.9e1_dp - 0.2e1_dp/0.9e1_dp*t135*t142 - t49*& + & (0.2e1_dp*my_rhoa*t268*t45 + 0.2e1_dp*my_rhob* & + t268*t46)/0.9e1_dp) - 0.4e1_dp/0.3e1_dp*t40 + & + 0.4e1_dp/0.3e1_dp*t46 + 0.4e1_dp/0.3e1_dp*t45) t310 = 0.40e2_dp/0.9e1_dp*t88*my_rhob/t1/t17*d t313 = my_rhob*t20 t316 = 0.8e1_dp/0.9e1_dp*a*t238*my_rhoa*t313*t124 @@ -1121,17 +1121,17 @@ SUBROUTINE lyp_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & t329 = t15*t115*t82 t332 = t135*t8 t334 = t49*t95 - t341 = t15*t21*(my_rhob*t145+t7*(-t332*t45/ & - 0.9e1_dp+t334*t45/0.9e1_dp)) + t341 = t15*t21*(my_rhob*t145 + t7*(-t332*t45/ & + 0.9e1_dp + t334*t45/0.9e1_dp)) IF (grad_deriv >= 2 .OR. grad_deriv == -2) THEN e_ra_ra(ii) = e_ra_ra(ii) & - +(t210-t214-t222-t228+t232-t236-t243-t249+ & - t252+0.8e1_dp*t253-0.8e1_dp/0.3e1_dp*t255- & - t304+t310-t316-t319-0.2e1_dp/0.3e1_dp*t322- & - 0.2e1_dp/0.3e1_dp*t326+0.22e2_dp/0.3e1_dp*t329& - & -0.2e1_dp*t341-t15*t21*(0.2e1_dp*my_rhob* & - t78+0.320e3_dp/0.9e1_dp*t72*my_rhob*t24- & + + (t210 - t214 - t222 - t228 + t232 - t236 - t243 - t249 + & + t252 + 0.8e1_dp*t253 - 0.8e1_dp/0.3e1_dp*t255 - & + t304 + t310 - t316 - t319 - 0.2e1_dp/0.3e1_dp*t322 - & + 0.2e1_dp/0.3e1_dp*t326 + 0.22e2_dp/0.3e1_dp*t329& + & - 0.2e1_dp*t341 - t15*t21*(0.2e1_dp*my_rhob* & + t78 + 0.320e3_dp/0.9e1_dp*t72*my_rhob*t24 - & 0.2e1_dp*t46))*sc END IF @@ -1139,91 +1139,91 @@ SUBROUTINE lyp_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & t356 = t6*t138 t360 = t87*my_rhoa*t90*d t363 = t15*t115*t168 - t373 = t15*t21*(my_rhoa*t145+t7*(-t332*t46/ & - 0.9e1_dp+t334*t46/0.9e1_dp)) + t373 = t15*t21*(my_rhoa*t145 + t7*(-t332*t46/ & + 0.9e1_dp + t334*t46/0.9e1_dp)) t376 = t15*t108*t168*d IF (grad_deriv >= 2 .OR. grad_deriv == -2) THEN e_rb_rb(ii) = e_rb_rb(ii) & - +(t210-t214-t222-t228+t232-t236-t243-t249+ & - t252-t304+t310-t316-t319+0.8e1_dp*t356- & - 0.8e1_dp/0.3e1_dp*t360+0.22e2_dp/0.3e1_dp* & - t363-0.2e1_dp*t373-0.2e1_dp/0.3e1_dp*t354- & - 0.2e1_dp/0.3e1_dp*t376-t15*t21*(0.2e1_dp* & - my_rhoa*t164+0.320e3_dp/0.9e1_dp*my_rhoa* & - t159*t24-0.2e1_dp*t45))*sc + + (t210 - t214 - t222 - t228 + t232 - t236 - t243 - t249 + & + t252 - t304 + t310 - t316 - t319 + 0.8e1_dp*t356 - & + 0.8e1_dp/0.3e1_dp*t360 + 0.22e2_dp/0.3e1_dp* & + t363 - 0.2e1_dp*t373 - 0.2e1_dp/0.3e1_dp*t354 - & + 0.2e1_dp/0.3e1_dp*t376 - t15*t21*(0.2e1_dp* & + my_rhoa*t164 + 0.320e3_dp/0.9e1_dp*my_rhoa* & + t159*t24 - 0.2e1_dp*t45))*sc END IF - t381 = -t354/0.3e1_dp+0.4e1_dp*t356-0.4e1_dp/0.3e1_dp& - & *t360+0.11e2_dp/0.3e1_dp*t363-t373-t341- & - t376/0.3e1_dp+t310-0.4e1_dp*t6*t8+0.4e1_dp* & - t253+t210-t214-t222 - t391 = -t228+t232-t236-t243-t249+t252-0.4e1_dp/ & - 0.3e1_dp*t255-t304-t316-t319-t322/0.3e1_dp- & - t326/0.3e1_dp+0.11e2_dp/0.3e1_dp*t329-t15* & - t21*(t35+t41-t48-t56+my_rhob*t164+my_rhoa & + t381 = -t354/0.3e1_dp + 0.4e1_dp*t356 - 0.4e1_dp/0.3e1_dp& + & *t360 + 0.11e2_dp/0.3e1_dp*t363 - t373 - t341 - & + t376/0.3e1_dp + t310 - 0.4e1_dp*t6*t8 + 0.4e1_dp* & + t253 + t210 - t214 - t222 + t391 = -t228 + t232 - t236 - t243 - t249 + t252 - 0.4e1_dp/ & + 0.3e1_dp*t255 - t304 - t316 - t319 - t322/0.3e1_dp - & + t326/0.3e1_dp + 0.11e2_dp/0.3e1_dp*t329 - t15* & + t21*(t35 + t41 - t48 - t56 + my_rhob*t164 + my_rhoa & &*t78) IF (grad_deriv >= 2 .OR. grad_deriv == -2) THEN e_ra_rb(ii) = e_ra_rb(ii) & - +(t381+t391)*sc + + (t381 + t391)*sc END IF t408 = t12*t14*t5 t415 = t99*t103*t5*t176/0.3e1_dp t419 = t15*t108*t176*d/0.3e1_dp t422 = 0.11e2_dp/0.3e1_dp*t15*t115*t176 - t430 = t15*t21*(0.2e1_dp*t7*t130*my_ndrho-0.8e1_dp & + t430 = t15*t21*(0.2e1_dp*t7*t130*my_ndrho - 0.8e1_dp & &/0.3e1_dp*my_rho*my_ndrho) IF (grad_deriv >= 2 .OR. grad_deriv == -2) THEN e_ndr_ra(ii) = e_ndr_ra(ii) & - -(0.2e1_dp*t408*t313*t171+t415+t419-t422+ & - t430)*sc + - (0.2e1_dp*t408*t313*t171 + t415 + t419 - t422 + & + t430)*sc e_ndr_rb(ii) = e_ndr_rb(ii) & - -(0.2e1_dp*t408*t20*my_rhoa*t171+t415+t419- & - t422+t430)*sc + - (0.2e1_dp*t408*t20*my_rhoa*t171 + t415 + t419 - & + t422 + t430)*sc END IF t445 = t99*t103*t5*t189/0.3e1_dp t449 = t15*t108*t189*d/0.3e1_dp t452 = 0.11e2_dp/0.3e1_dp*t15*t115*t189 - t467 = t15*t21*(t7*(-0.2e1_dp*t132*my_ndrhoa- & - 0.2e1_dp/0.9e1_dp*t135*my_rhoa*t182+0.2e1_dp/ & - 0.9e1_dp*t181*t95*my_ndrhoa)+0.8e1_dp/0.3e1_dp& + t467 = t15*t21*(t7*(-0.2e1_dp*t132*my_ndrhoa - & + 0.2e1_dp/0.9e1_dp*t135*my_rhoa*t182 + 0.2e1_dp/ & + 0.9e1_dp*t181*t95*my_ndrhoa) + 0.8e1_dp/0.3e1_dp& & *my_rho*my_ndrhoa) IF (grad_deriv >= 2 .OR. grad_deriv == -2) THEN e_ndra_ra(ii) = e_ndra_ra(ii) & - -(t15*t21*(my_rhob*t185-0.2e1_dp/0.9e1_dp*t7& - & *t75*my_ndrhoa)+t445+t449-t452+t467)*sc + - (t15*t21*(my_rhob*t185 - 0.2e1_dp/0.9e1_dp*t7& + & *t75*my_ndrhoa) + t445 + t449 - t452 + t467)*sc e_ndra_rb(ii) = e_ndra_rb(ii) & - -(t15*t21*(my_rhoa*t185-0.4e1_dp*my_rhob* & - my_ndrhoa)+t445+t449-t452+t467)*sc + - (t15*t21*(my_rhoa*t185 - 0.4e1_dp*my_rhob* & + my_ndrhoa) + t445 + t449 - t452 + t467)*sc END IF t483 = t99*t103*t5*t202/0.3e1_dp t487 = t15*t108*t202*d/0.3e1_dp t490 = 0.11e2_dp/0.3e1_dp*t15*t115*t202 - t505 = t15*t21*(t7*(-0.2e1_dp*t132*my_ndrhob- & - 0.2e1_dp/0.9e1_dp*t135*my_rhob*t195+0.2e1_dp/ & - 0.9e1_dp*t194*t95*my_ndrhob)+0.8e1_dp/0.3e1_dp& + t505 = t15*t21*(t7*(-0.2e1_dp*t132*my_ndrhob - & + 0.2e1_dp/0.9e1_dp*t135*my_rhob*t195 + 0.2e1_dp/ & + 0.9e1_dp*t194*t95*my_ndrhob) + 0.8e1_dp/0.3e1_dp& & *my_rho*my_ndrhob) IF (grad_deriv >= 2 .OR. grad_deriv == -2) THEN e_ndrb_ra(ii) = e_ndrb_ra(ii) & - -(t15*t21*(my_rhob*t198-0.4e1_dp*my_rhoa* & - my_ndrhob)+t483+t487-t490+t505)*sc + - (t15*t21*(my_rhob*t198 - 0.4e1_dp*my_rhoa* & + my_ndrhob) + t483 + t487 - t490 + t505)*sc e_ndrb_rb(ii) = e_ndrb_rb(ii) & - -(t15*t21*(my_rhoa*t198-0.2e1_dp/0.9e1_dp*t7& - & *t75*my_ndrhob)+t483+t487-t490+t505)*sc + - (t15*t21*(my_rhoa*t198 - 0.2e1_dp/0.9e1_dp*t7& + & *t75*my_ndrhob) + t483 + t487 - t490 + t505)*sc END IF t515 = 0.4e1_dp/0.3e1_dp*t16 IF (grad_deriv >= 2 .OR. grad_deriv == -2) THEN e_ndr_ndr(ii) = e_ndr_ndr(ii) & - -(t15*t21*(0.2e1_dp*t7*t39-t515))*sc + - (t15*t21*(0.2e1_dp*t7*t39 - t515))*sc END IF t519 = t13/0.9e1_dp @@ -1231,12 +1231,12 @@ SUBROUTINE lyp_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & IF (grad_deriv >= 2 .OR. grad_deriv == -2) THEN e_ndra_ndra(ii) = e_ndra_ndra(ii) & - -(t15*t21*(t7*(-0.5e1_dp+t519+t520-0.2e1_dp & - &/0.9e1_dp*t181*t8)+t515-0.2e1_dp*t29))*sc + - (t15*t21*(t7*(-0.5e1_dp + t519 + t520 - 0.2e1_dp & + &/0.9e1_dp*t181*t8) + t515 - 0.2e1_dp*t29))*sc e_ndrb_ndrb(ii) = e_ndrb_ndrb(ii) & - -(t15*t21*(t7*(-0.5e1_dp+t519+t520-0.2e1_dp & - &/0.9e1_dp*t194*t8)+t515-0.2e1_dp*t25))*sc + - (t15*t21*(t7*(-0.5e1_dp + t519 + t520 - 0.2e1_dp & + &/0.9e1_dp*t194*t8) + t515 - 0.2e1_dp*t25))*sc END IF END IF END DO diff --git a/src/xc/xc_lyp_adiabatic.F b/src/xc/xc_lyp_adiabatic.F index 653ef1e3fd..45b383d08c 100644 --- a/src/xc/xc_lyp_adiabatic.F +++ b/src/xc/xc_lyp_adiabatic.F @@ -149,7 +149,7 @@ SUBROUTINE lyp_adiabatic_lda_eval(rho_set, deriv_set, grad_deriv, lyp_adiabatic_ CALL xc_rho_set_get(rho_set, rho_1_3=rho_1_3, rho=rho, & norm_drho=norm_drho, local_bounds=bo, rho_cutoff=epsilon_rho, & drho_cutoff=epsilon_norm_drho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rho @@ -235,7 +235,7 @@ SUBROUTINE lyp_adiabatic_lda_calc(rho, norm_drho, & t2 = d*lambda t3 = my_rho**(0.1e1_dp/0.3e1_dp) t4 = 0.1e1_dp/t3 - t6 = 0.10e1_dp+t2*t4 + t6 = 0.10e1_dp + t2*t4 t7 = 0.1e1_dp/t6 t9 = a*b t10 = t9*my_rho @@ -248,8 +248,8 @@ SUBROUTINE lyp_adiabatic_lda_calc(rho, norm_drho, & t17 = t3**2 t19 = 0.1e1_dp/t17/t16 t20 = t15*t19 - t25 = 0.30e1_dp+0.70e1_dp*t12+0.70e1_dp*t2*t4*t7 - t28 = Cf-0.1388888889e-1_dp*t20*t25 + t25 = 0.30e1_dp + 0.70e1_dp*t12 + 0.70e1_dp*t2*t4*t7 + t28 = Cf - 0.1388888889e-1_dp*t20*t25 t29 = t14*t28 t34 = lambda**2 t36 = t6**2 @@ -268,12 +268,12 @@ SUBROUTINE lyp_adiabatic_lda_calc(rho, norm_drho, & t57 = d**2 t58 = t57*lambda t59 = 0.1e1_dp/t17 - t63 = 0.70e1_dp*t52+0.70e1_dp*d*t4*t7-0.70e1_dp*t58*t59*t37 + t63 = 0.70e1_dp*t52 + 0.70e1_dp*d*t4*t7 - 0.70e1_dp*t58*t59*t37 t65 = t14*t15*t63 - e_0(ii) = e_0(ii)+0.20e1_dp*lambda*(-a*my_rho*t7-t10*t29)+t34*(a*t17 & - *t38+t40*t43+t40*t47+0.13888888888888888889e-1_dp*t51* & - t65) + e_0(ii) = e_0(ii) + 0.20e1_dp*lambda*(-a*my_rho*t7 - t10*t29) + t34*(a*t17 & + *t38 + t40*t43 + t40*t47 + 0.13888888888888888889e-1_dp*t51* & + t65) END IF IF (grad_deriv >= 1) THEN @@ -282,34 +282,34 @@ SUBROUTINE lyp_adiabatic_lda_calc(rho, norm_drho, & t78 = t77*t42 t87 = t16*my_rho t94 = 0.1e1_dp/t3/my_rho - t107 = 0.37037037037037037037e-1_dp*t15/t17/t87*t25-0.1388888889e-1_dp & - *t20*(-0.2333333333e1_dp*t11*t94-0.2333333333e1_dp*t2 & - *t94*t7+0.23333333333333333333e1_dp*t57*t34*t50*t37) + t107 = 0.37037037037037037037e-1_dp*t15/t17/t87*t25 - 0.1388888889e-1_dp & + *t20*(-0.2333333333e1_dp*t11*t94 - 0.2333333333e1_dp*t2 & + *t94*t7 + 0.23333333333333333333e1_dp*t57*t34*t50*t37) t117 = 0.1e1_dp/t36/t6 t122 = t9*t4 t125 = c**2 t153 = 0.1e1_dp/t87 t180 = 0.1e1_dp/t16 - t189 = 0.2e1_dp/0.3e1_dp*t71*t38+0.2e1_dp/0.3e1_dp*a*t59*t117* & - t57*lambda+0.2e1_dp/0.3e1_dp*t122*t43+t9*t59*t125*t78 & - /0.3e1_dp+0.2e1_dp/0.3e1_dp*t9*t59*c*t45*t46*lambda+t40 & - *t41*t7*t107+0.2e1_dp/0.3e1_dp*t122*t47+0.2e1_dp/0.3e1_dp* & - t9*t59*t13*t117*t28*t58+t40*t45*t107*d-0.2314814815e-1_dp & - *t9*t19*t65+0.46296296296296296297e-2_dp*t9*t153 & - *c*t77*t7*t15*t63+0.46296296296296296297e-2_dp*t9*t153 & - *t13*t37*t15*t63*d*lambda+0.13888888888888888889e-1_dp & - *t51*t14*t15*(-0.2333333333e1_dp*c*t94-0.2333333333e1_dp* & - d*t94*t7+0.70000000000000000000e1_dp*t57*t50*t37*lambda & - -0.4666666667e1_dp*t57*d*t34*t180*t117) - - e_rho(ii) = e_rho(ii)+0.20e1_dp*lambda*(-a*t7-t71*t38*lambda/0.3e1_dp-t9* & - t29-t9*t52*t78/0.3e1_dp-t9*t4*t13*t37*t28*t2/0.3e1_dp & - -t10*t14*t107)+t34*t189 + t189 = 0.2e1_dp/0.3e1_dp*t71*t38 + 0.2e1_dp/0.3e1_dp*a*t59*t117* & + t57*lambda + 0.2e1_dp/0.3e1_dp*t122*t43 + t9*t59*t125*t78 & + /0.3e1_dp + 0.2e1_dp/0.3e1_dp*t9*t59*c*t45*t46*lambda + t40 & + *t41*t7*t107 + 0.2e1_dp/0.3e1_dp*t122*t47 + 0.2e1_dp/0.3e1_dp* & + t9*t59*t13*t117*t28*t58 + t40*t45*t107*d - 0.2314814815e-1_dp & + *t9*t19*t65 + 0.46296296296296296297e-2_dp*t9*t153 & + *c*t77*t7*t15*t63 + 0.46296296296296296297e-2_dp*t9*t153 & + *t13*t37*t15*t63*d*lambda + 0.13888888888888888889e-1_dp & + *t51*t14*t15*(-0.2333333333e1_dp*c*t94 - 0.2333333333e1_dp* & + d*t94*t7 + 0.70000000000000000000e1_dp*t57*t50*t37*lambda & + - 0.4666666667e1_dp*t57*d*t34*t180*t117) + + e_rho(ii) = e_rho(ii) + 0.20e1_dp*lambda*(-a*t7 - t71*t38*lambda/0.3e1_dp - t9* & + t29 - t9*t52*t78/0.3e1_dp - t9*t4*t13*t37*t28*t2/0.3e1_dp & + - t10*t14*t107) + t34*t189 t195 = t14*my_ndrho*t25 - e_ndrho(ii) = e_ndrho(ii)+0.55555555555555555556e-1_dp*lambda*a*b*t50*t195+t34 & - *(-0.2777777778e-1_dp*t9*t180*c*t195-0.2777777778e-1_dp*t9 & - *t180*t13*t37*my_ndrho*t25*d+0.27777777777777777778e-1_dp* & + e_ndrho(ii) = e_ndrho(ii) + 0.55555555555555555556e-1_dp*lambda*a*b*t50*t195 + t34 & + *(-0.2777777778e-1_dp*t9*t180*c*t195 - 0.2777777778e-1_dp*t9 & + *t180*t13*t37*my_ndrho*t25*d + 0.27777777777777777778e-1_dp* & t51*t14*my_ndrho*t63) END IF @@ -363,7 +363,7 @@ SUBROUTINE lyp_adiabatic_lsd_eval(rho_set, deriv_set, grad_deriv, lyp_adiabatic_ norm_drhob=norm_drhob, norm_drho=norm_drho, & rho_cutoff=epsilon_rho, & local_bounds=bo) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rhoa e_0 => dummy @@ -483,19 +483,19 @@ SUBROUTINE lyp_adiabatic_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, DO ii = 1, npoints my_rhoa = MAX(rhoa(ii), 0.0_dp) my_rhob = MAX(rhob(ii), 0.0_dp) - IF (my_rhoa+my_rhob > epsilon_rho) THEN + IF (my_rhoa + my_rhob > epsilon_rho) THEN my_ndrhoa = norm_drhoa(ii) my_ndrhob = norm_drhob(ii) my_ndrho = norm_drho(ii) IF (grad_deriv >= 0) THEN t1 = a*my_rhoa - t2 = my_rhoa+my_rhob + t2 = my_rhoa + my_rhob t3 = 0.1e1_dp/t2 t4 = my_rhob*t3 t5 = d*lambda t6 = t2**(0.1e1_dp/0.3e1_dp) t7 = 0.1e1_dp/t6 - t9 = 0.10e1_dp+t5*t7 + t9 = 0.10e1_dp + t5*t7 t10 = 0.1e1_dp/t9 t14 = a*b t15 = c*lambda @@ -514,22 +514,22 @@ SUBROUTINE lyp_adiabatic_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, t31 = my_rhob**(0.1e1_dp/0.3e1_dp) t32 = t31**2 t39 = t5*t7*t10 - t41 = 0.26111111111111111111e1_dp-0.3888888889e0_dp*t16-0.3888888889e0_dp & + t41 = 0.26111111111111111111e1_dp - 0.3888888889e0_dp*t16 - 0.3888888889e0_dp & *t39 t42 = my_ndrho**2 - t46 = 0.25000000000000000000e1_dp-0.5555555556e-1_dp*t16-0.5555555556e-1_dp & + t46 = 0.25000000000000000000e1_dp - 0.5555555556e-1_dp*t16 - 0.5555555556e-1_dp & *t39 t47 = my_ndrhoa**2 t48 = my_ndrhob**2 - t49 = t47+t48 - t51 = t16+t39-0.110e2_dp - t55 = my_rhoa*t3*t47+t4*t48 - t58 = 0.12699208415745595798e2_dp*Cf*(t28*t26+t32*t30)+t41 & - *t42-t46*t49-0.1111111111e0_dp*t51*t55 + t49 = t47 + t48 + t51 = t16 + t39 - 0.110e2_dp + t55 = my_rhoa*t3*t47 + t4*t48 + t58 = 0.12699208415745595798e2_dp*Cf*(t28*t26 + t32*t30) + t41 & + *t42 - t46*t49 - 0.1111111111e0_dp*t51*t55 t62 = 0.66666666666666666667e0_dp*t19 - t63 = t62-t26 - t65 = t62-t30 - t67 = t25*t58-0.6666666667e0_dp*t19*t42+t63*t48+t65*t47 + t63 = t62 - t26 + t65 = t62 - t30 + t67 = t25*t58 - 0.6666666667e0_dp*t19*t42 + t63*t48 + t65*t47 t73 = lambda**2 t74 = t1*my_rhob t76 = 0.1e1_dp/t6/t2 @@ -551,17 +551,17 @@ SUBROUTINE lyp_adiabatic_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, t102 = d**2 t103 = t102*lambda t106 = t103/t21*t78 - t108 = -0.3888888889e0_dp*t97-0.3888888889e0_dp*t100+0.38888888888888888889e0_dp & + t108 = -0.3888888889e0_dp*t97 - 0.3888888889e0_dp*t100 + 0.38888888888888888889e0_dp & *t106 - t113 = -0.5555555556e-1_dp*t97-0.5555555556e-1_dp*t100+0.55555555555555555556e-1_dp & + t113 = -0.5555555556e-1_dp*t97 - 0.5555555556e-1_dp*t100 + 0.55555555555555555556e-1_dp & *t106 - t115 = t97+t100-t106 - t118 = t108*t42-t113*t49-0.1111111111e0_dp*t115*t55 + t115 = t97 + t100 - t106 + t118 = t108*t42 - t113*t49 - 0.1111111111e0_dp*t115*t55 t119 = my_rhob*t118 - e_0(ii) = e_0(ii)+0.20e1_dp*lambda*(-0.40e1_dp*t1*t4*t10-t18*t24*t67) & - +t73*(0.40e1_dp*t74*t80+t83*t86*t87+t18*t90*t91- & - t95*t96*t119) + e_0(ii) = e_0(ii) + 0.20e1_dp*lambda*(-0.40e1_dp*t1*t4*t10 - t18*t24*t67) & + + t73*(0.40e1_dp*t74*t80 + t83*t86*t87 + t18*t90*t91 - & + t95*t96*t119) END IF IF (grad_deriv == 1 .OR. grad_deriv == -1) THEN @@ -584,22 +584,22 @@ SUBROUTINE lyp_adiabatic_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, t165 = t5*t76*t10 t169 = 0.1e1_dp/t21/t2 t171 = t102*t73*t169*t78 - t174 = (0.12962962962962962963e0_dp*t162+0.12962962962962962963e0_dp & - *t165-0.1296296296e0_dp*t171)*t42 - t179 = (0.18518518518518518519e-1_dp*t162+0.18518518518518518519e-1_dp & - *t165-0.1851851852e-1_dp*t171)*t49 - t183 = 0.1111111111e0_dp*(-t162/0.3e1_dp-t165/0.3e1_dp+t171/0.3e1_dp) & + t174 = (0.12962962962962962963e0_dp*t162 + 0.12962962962962962963e0_dp & + *t165 - 0.1296296296e0_dp*t171)*t42 + t179 = (0.18518518518518518519e-1_dp*t162 + 0.18518518518518518519e-1_dp & + *t165 - 0.1851851852e-1_dp*t171)*t49 + t183 = 0.1111111111e0_dp*(-t162/0.3e1_dp - t165/0.3e1_dp + t171/0.3e1_dp) & *t55 t186 = my_rhoa*t128*t47 t187 = t129*t48 - t188 = t3*t47-t186-t187 + t188 = t3*t47 - t186 - t187 t194 = 0.1333333333e1_dp*t2*t42 t196 = 0.13333333333333333333e1_dp*my_rhob t199 = 0.13333333333333333333e1_dp*my_rhoa - t200 = t199+t196 - t202 = my_rhob*t58+t25*(0.33864555775321588795e2_dp*Cf*t28*my_rhoa & - +t174-t179-t183-0.1111111111e0_dp*t51*t188)-t194+(-0.6666666667e0_dp & - *my_rhoa+t196)*t48+t200*t47 + t200 = t199 + t196 + t202 = my_rhob*t58 + t25*(0.33864555775321588795e2_dp*Cf*t28*my_rhoa & + + t174 - t179 - t183 - 0.1111111111e0_dp*t51*t188) - t194 + (-0.6666666667e0_dp & + *my_rhoa + t196)*t48 + t200*t47 t212 = 0.5333333333e1_dp*t74*t135*d t216 = 0.1e1_dp/t77/t9 t220 = 0.26666666666666666667e1_dp*t74/t21/t19*t216*t103 @@ -617,55 +617,55 @@ SUBROUTINE lyp_adiabatic_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, t276 = d*t76*t10 t280 = t102*t169*t78*lambda t285 = t102*d*t73*t128*t216 - t288 = (0.12962962962962962963e0_dp*t273+0.12962962962962962963e0_dp & - *t276-0.3888888889e0_dp*t280+0.25925925925925925926e0_dp*t285) & + t288 = (0.12962962962962962963e0_dp*t273 + 0.12962962962962962963e0_dp & + *t276 - 0.3888888889e0_dp*t280 + 0.25925925925925925926e0_dp*t285) & *t42 - t294 = (0.18518518518518518519e-1_dp*t273+0.18518518518518518519e-1_dp & - *t276-0.5555555556e-1_dp*t280+0.37037037037037037037e-1_dp*t285) & + t294 = (0.18518518518518518519e-1_dp*t273 + 0.18518518518518518519e-1_dp & + *t276 - 0.5555555556e-1_dp*t280 + 0.37037037037037037037e-1_dp*t285) & *t49 - t300 = 0.1111111111e0_dp*(-t273/0.3e1_dp-t276/0.3e1_dp+t280-0.2e1_dp & + t300 = 0.1111111111e0_dp*(-t273/0.3e1_dp - t276/0.3e1_dp + t280 - 0.2e1_dp & /0.3e1_dp*t285)*t55 - t307 = 0.40e1_dp*t124*t80-t212+t220-t222+t231+t237+t83 & - *t86*t10*t202+t246-t250+t18*t90*t202*d-t259- & - t266+t270-t18*t24*t119-t95*t96*my_rhob*(t288-t294- & - t300-0.1111111111e0_dp*t115*t188) - - e_ra(ii) = e_ra(ii)+0.20e1_dp*lambda*(-0.40e1_dp*t124*t125+t132-t138-t145 & - -t151+t157-t18*t24*t202)+t73*t307 - - t316 = -t186+t3*t48-t187 - t325 = my_rhoa*t58+t25*(0.33864555775321588795e2_dp*Cf*t32*my_rhob & - +t174-t179-t183-0.1111111111e0_dp*t51*t316)-t194+t200 & - *t48+(t199-0.6666666667e0_dp*my_rhob)*t47 - t348 = 0.40e1_dp*t1*t80-t212+t220-t222+t231+t237+t83* & - t86*t10*t325+t246-t250+t18*t90*t325*d-t259-t266 & - +t270-t18*t24*my_rhoa*t118-t95*t96*my_rhob*(t288-t294 & - -t300-0.1111111111e0_dp*t115*t316) - - e_rb(ii) = e_rb(ii)+0.20e1_dp*lambda*(-0.40e1_dp*t1*t125+t132-t138-t145- & - t151+t157-t18*t24*t325)+t73*t348 + t307 = 0.40e1_dp*t124*t80 - t212 + t220 - t222 + t231 + t237 + t83 & + *t86*t10*t202 + t246 - t250 + t18*t90*t202*d - t259 - & + t266 + t270 - t18*t24*t119 - t95*t96*my_rhob*(t288 - t294 - & + t300 - 0.1111111111e0_dp*t115*t188) + + e_ra(ii) = e_ra(ii) + 0.20e1_dp*lambda*(-0.40e1_dp*t124*t125 + t132 - t138 - t145 & + - t151 + t157 - t18*t24*t202) + t73*t307 + + t316 = -t186 + t3*t48 - t187 + t325 = my_rhoa*t58 + t25*(0.33864555775321588795e2_dp*Cf*t32*my_rhob & + + t174 - t179 - t183 - 0.1111111111e0_dp*t51*t316) - t194 + t200 & + *t48 + (t199 - 0.6666666667e0_dp*my_rhob)*t47 + t348 = 0.40e1_dp*t1*t80 - t212 + t220 - t222 + t231 + t237 + t83* & + t86*t10*t325 + t246 - t250 + t18*t90*t325*d - t259 - t266 & + + t270 - t18*t24*my_rhoa*t118 - t95*t96*my_rhob*(t288 - t294 & + - t300 - 0.1111111111e0_dp*t115*t316) + + e_rb(ii) = e_rb(ii) + 0.20e1_dp*lambda*(-0.40e1_dp*t1*t125 + t132 - t138 - t145 - & + t151 + t157 - t18*t24*t325) + t73*t348 t351 = lambda*a*b t355 = t3*my_ndrhoa - t362 = t25*(-REAL(2*t46*my_ndrhoa, dp)-0.2222222222e0_dp*t51*my_rhoa & - *t355)+REAL(2*t65*my_ndrhoa, dp) + t362 = t25*(-REAL(2*t46*my_ndrhoa, dp) - 0.2222222222e0_dp*t51*my_rhoa & + *t355) + REAL(2*t65*my_ndrhoa, dp) - e_ndra(ii) = e_ndra(ii)-0.20e1_dp*t351*t94*t23*t362+t73*(t83*t86*t10* & - t362+t18*t90*t362*d-t95*t96*my_rhob*(-REAL(2*t113* & - my_ndrhoa, dp)-0.2222222222e0_dp*t115*my_rhoa*t355)) + e_ndra(ii) = e_ndra(ii) - 0.20e1_dp*t351*t94*t23*t362 + t73*(t83*t86*t10* & + t362 + t18*t90*t362*d - t95*t96*my_rhob*(-REAL(2*t113* & + my_ndrhoa, dp) - 0.2222222222e0_dp*t115*my_rhoa*t355)) t387 = t3*my_ndrhob - t394 = t25*(-REAL(2*t46*my_ndrhob, dp)-0.2222222222e0_dp*t51*my_rhob & - *t387)+REAL(2*t63*my_ndrhob, dp) + t394 = t25*(-REAL(2*t46*my_ndrhob, dp) - 0.2222222222e0_dp*t51*my_rhob & + *t387) + REAL(2*t63*my_ndrhob, dp) - e_ndrb(ii) = e_ndrb(ii)-0.20e1_dp*t351*t94*t23*t394+t73*(t83*t86*t10* & - t394+t18*t90*t394*d-t95*t96*my_rhob*(-REAL(2*t113* & - my_ndrhob, dp)-0.2222222222e0_dp*t115*my_rhob*t387)) + e_ndrb(ii) = e_ndrb(ii) - 0.20e1_dp*t351*t94*t23*t394 + t73*(t83*t86*t10* & + t394 + t18*t90*t394*d - t95*t96*my_rhob*(-REAL(2*t113* & + my_ndrhob, dp) - 0.2222222222e0_dp*t115*my_rhob*t387)) - t421 = REAL(2*t25*t41*my_ndrho, dp)-0.1333333333e1_dp*REAL(t19, dp)*REAL(my_ndrho, dp) + t421 = REAL(2*t25*t41*my_ndrho, dp) - 0.1333333333e1_dp*REAL(t19, dp)*REAL(my_ndrho, dp) - e_ndr(ii) = e_ndr(ii)-0.20e1_dp*t351*t94*t23*t421+t73*(t83*t86*t10*t421 & - +t18*t90*t421*d-REAL(2*t95*t96*my_rhob*t108*my_ndrho, dp)) + e_ndr(ii) = e_ndr(ii) - 0.20e1_dp*t351*t94*t23*t421 + t73*(t83*t86*t10*t421 & + + t18*t90*t421*d - REAL(2*t95*t96*my_rhob*t108*my_ndrho, dp)) END IF END IF diff --git a/src/xc/xc_optx.F b/src/xc/xc_optx.F index 2ba156383b..f21d3a2c24 100644 --- a/src/xc/xc_optx.F +++ b/src/xc/xc_optx.F @@ -131,7 +131,7 @@ SUBROUTINE optx_lda_eval(rho_set, deriv_set, grad_deriv, optx_params) CALL xc_rho_set_get(rho_set, rho=rho, & norm_drho=norm_drho, local_bounds=bo, rho_cutoff=epsilon_rho, & drho_cutoff=epsilon_drho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) deriv => xc_dset_get_derivative(deriv_set, "", & allocate_deriv=.TRUE.) @@ -203,7 +203,7 @@ SUBROUTINE optx_lsd_eval(rho_set, deriv_set, grad_deriv, optx_params) norm_drhoa=ndrho(1)%array, & norm_drhob=ndrho(2)%array, rho_cutoff=epsilon_rho, & drho_cutoff=epsilon_drho, local_bounds=bo) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) deriv => xc_dset_get_derivative(deriv_set, "", & allocate_deriv=.TRUE.) @@ -283,14 +283,14 @@ SUBROUTINE optx_lda_calc(rho, norm_drho, e_0, e_rho, e_ndrho, & rho43 = myrho**o43 xs = (myndrho/rho43) gamxsxs = gam*xs*xs - denom = 1.0_dp/(1.0_dp+gamxsxs) - ex = rho43*(a1*cx+a2*(gamxsxs*denom)**2) + denom = 1.0_dp/(1.0_dp + gamxsxs) + ex = rho43*(a1*cx + a2*(gamxsxs*denom)**2) ! 2.0 for both spins - e_0(ii) = e_0(ii)-(2.0_dp*ex)*sx - tmp = rho43*2.0_dp*a2*gamxsxs*denom**2*(1.0_dp-gamxsxs*denom) + e_0(ii) = e_0(ii) - (2.0_dp*ex)*sx + tmp = rho43*2.0_dp*a2*gamxsxs*denom**2*(1.0_dp - gamxsxs*denom) ! derive e_0 wrt to rho (full) and ndrho (also full) - e_rho(ii) = e_rho(ii)-((o43*ex+tmp*gamxsxs*(-2.0_dp*o43))/myrho)*sx - e_ndrho(ii) = e_ndrho(ii)-((tmp*gam*2.0_dp*myndrho/rho43**2))*sx + e_rho(ii) = e_rho(ii) - ((o43*ex + tmp*gamxsxs*(-2.0_dp*o43))/myrho)*sx + e_ndrho(ii) = e_ndrho(ii) - ((tmp*gam*2.0_dp*myndrho/rho43**2))*sx END IF END DO @@ -347,14 +347,14 @@ SUBROUTINE optx_lsd_calc(rho, norm_drho, e_0, e_rho, e_ndrho, & rho43 = myrho**o43 xs = (myndrho/rho43) gamxsxs = gam*xs*xs - denom = 1.0_dp/(1.0_dp+gamxsxs) - ex = rho43*(a1*cx+a2*(gamxsxs*denom)**2) + denom = 1.0_dp/(1.0_dp + gamxsxs) + ex = rho43*(a1*cx + a2*(gamxsxs*denom)**2) ! for a single spin - e_0(ii) = e_0(ii)-ex*sx - tmp = rho43*2.0_dp*a2*gamxsxs*denom**2*(1.0_dp-gamxsxs*denom) + e_0(ii) = e_0(ii) - ex*sx + tmp = rho43*2.0_dp*a2*gamxsxs*denom**2*(1.0_dp - gamxsxs*denom) ! derive e_0 wrt to rho and ndrho - e_rho(ii) = e_rho(ii)-((o43*ex+tmp*gamxsxs*(-2.0_dp*o43))/myrho)*sx - e_ndrho(ii) = e_ndrho(ii)-((tmp*gam*2.0_dp*myndrho/rho43**2))*sx + e_rho(ii) = e_rho(ii) - ((o43*ex + tmp*gamxsxs*(-2.0_dp*o43))/myrho)*sx + e_ndrho(ii) = e_ndrho(ii) - ((tmp*gam*2.0_dp*myndrho/rho43**2))*sx END IF END DO diff --git a/src/xc/xc_pade.F b/src/xc/xc_pade.F index c452a20f97..3c27fb7ac2 100644 --- a/src/xc/xc_pade.F +++ b/src/xc/xc_pade.F @@ -152,7 +152,7 @@ SUBROUTINE pade_lda_pw_eval(deriv_set, rho_set, order) IF (order >= 0) calc(0:order) = .TRUE. IF (order < 0) calc(-order) = .TRUE. - n = PRODUCT(rho_set%local_bounds(2, :)-rho_set%local_bounds(1, :)+(/1, 1, 1/)) + n = PRODUCT(rho_set%local_bounds(2, :) - rho_set%local_bounds(1, :) + (/1, 1, 1/)) ALLOCATE (rs(n)) CALL calc_rs_pw(rho_set%rho, rs, n) @@ -264,7 +264,7 @@ SUBROUTINE pade_lsd_pw_eval(deriv_set, rho_set, order) rhoa = rho_set%rhoa(i, j, k) rhob = rho_set%rhob(i, j, k) - fx(1) = rhoa+rhob + fx(1) = rhoa + rhob CALL calc_rs(fx(1), rs) CALL calc_fx(rhoa, rhob, fx, ABS(order)) @@ -312,10 +312,10 @@ SUBROUTINE pade_lda_0(n, rho, rs, pot) !$OMP SHARED(n,rho,eps_rho,pot,rs) DO ip = 1, n IF (rho(ip) > eps_rho) THEN - p = a0+(a1+(a2+a3*rs(ip))*rs(ip))*rs(ip) - q = (b1+(b2+(b3+b4*rs(ip))*rs(ip))*rs(ip))*rs(ip) + p = a0 + (a1 + (a2 + a3*rs(ip))*rs(ip))*rs(ip) + q = (b1 + (b2 + (b3 + b4*rs(ip))*rs(ip))*rs(ip))*rs(ip) epade = -p/q - pot(ip) = pot(ip)+epade*rho(ip) + pot(ip) = pot(ip) + epade*rho(ip) END IF END DO @@ -343,15 +343,15 @@ SUBROUTINE pade_lda_1(n, rho, rs, pot) DO ip = 1, n IF (rho(ip) > eps_rho) THEN - p = a0+(a1+(a2+a3*rs(ip))*rs(ip))*rs(ip) - q = (b1+(b2+(b3+b4*rs(ip))*rs(ip))*rs(ip))*rs(ip) + p = a0 + (a1 + (a2 + a3*rs(ip))*rs(ip))*rs(ip) + q = (b1 + (b2 + (b3 + b4*rs(ip))*rs(ip))*rs(ip))*rs(ip) epade = -p/q - dpv = a1+(2.0_dp*a2+3.0_dp*a3*rs(ip))*rs(ip) - dq = b1+(2.0_dp*b2+(3.0_dp*b3+4.0_dp*b4*rs(ip))*rs(ip))*rs(ip) - depade = f13*rs(ip)*(dpv*q-p*dq)/(q*q) + dpv = a1 + (2.0_dp*a2 + 3.0_dp*a3*rs(ip))*rs(ip) + dq = b1 + (2.0_dp*b2 + (3.0_dp*b3 + 4.0_dp*b4*rs(ip))*rs(ip))*rs(ip) + depade = f13*rs(ip)*(dpv*q - p*dq)/(q*q) - pot(ip) = pot(ip)+epade+depade + pot(ip) = pot(ip) + epade + depade END IF END DO @@ -381,16 +381,16 @@ SUBROUTINE pade_lda_01(n, rho, rs, pot0, pot1) DO ip = 1, n IF (rho(ip) > eps_rho) THEN - p = a0+(a1+(a2+a3*rs(ip))*rs(ip))*rs(ip) - q = (b1+(b2+(b3+b4*rs(ip))*rs(ip))*rs(ip))*rs(ip) + p = a0 + (a1 + (a2 + a3*rs(ip))*rs(ip))*rs(ip) + q = (b1 + (b2 + (b3 + b4*rs(ip))*rs(ip))*rs(ip))*rs(ip) epade = -p/q - dpv = a1+(2.0_dp*a2+3.0_dp*a3*rs(ip))*rs(ip) - dq = b1+(2.0_dp*b2+(3.0_dp*b3+4.0_dp*b4*rs(ip))*rs(ip))*rs(ip) - depade = f13*rs(ip)*(dpv*q-p*dq)/(q*q) + dpv = a1 + (2.0_dp*a2 + 3.0_dp*a3*rs(ip))*rs(ip) + dq = b1 + (2.0_dp*b2 + (3.0_dp*b3 + 4.0_dp*b4*rs(ip))*rs(ip))*rs(ip) + depade = f13*rs(ip)*(dpv*q - p*dq)/(q*q) - pot0(ip) = pot0(ip)+epade*rho(ip) - pot1(ip) = pot1(ip)+epade+depade + pot0(ip) = pot0(ip) + epade*rho(ip) + pot1(ip) = pot1(ip) + epade + depade END IF END DO @@ -419,21 +419,21 @@ SUBROUTINE pade_lda_2(n, rho, rs, pot) DO ip = 1, n IF (rho(ip) > eps_rho) THEN - p = a0+(a1+(a2+a3*rs(ip))*rs(ip))*rs(ip) - q = (b1+(b2+(b3+b4*rs(ip))*rs(ip))*rs(ip))*rs(ip) + p = a0 + (a1 + (a2 + a3*rs(ip))*rs(ip))*rs(ip) + q = (b1 + (b2 + (b3 + b4*rs(ip))*rs(ip))*rs(ip))*rs(ip) - dpv = a1+(2.0_dp*a2+3.0_dp*a3*rs(ip))*rs(ip) - dq = b1+(2.0_dp*b2+(3.0_dp*b3+4.0_dp*b4*rs(ip))*rs(ip))*rs(ip) + dpv = a1 + (2.0_dp*a2 + 3.0_dp*a3*rs(ip))*rs(ip) + dq = b1 + (2.0_dp*b2 + (3.0_dp*b3 + 4.0_dp*b4*rs(ip))*rs(ip))*rs(ip) - d2p = 2.0_dp*a2+6.0_dp*a3*rs(ip) - d2q = 2.0_dp*b2+(6.0_dp*b3+12.0_dp*b4*rs(ip))*rs(ip) + d2p = 2.0_dp*a2 + 6.0_dp*a3*rs(ip) + d2q = 2.0_dp*b2 + (6.0_dp*b3 + 12.0_dp*b4*rs(ip))*rs(ip) rsr = rs(ip)/rho(ip) - t1 = (p*dq-dpv*q)/(q*q) - t2 = (d2p*q-p*d2q)/(q*q) - t3 = (p*dq*dq-dpv*q*dq)/(q*q*q) + t1 = (p*dq - dpv*q)/(q*q) + t2 = (d2p*q - p*d2q)/(q*q) + t3 = (p*dq*dq - dpv*q*dq)/(q*q*q) - pot(ip) = pot(ip)-f13*(f23*t1+f13*t2*rs(ip)+f23*t3*rs(ip))*rsr + pot(ip) = pot(ip) - f13*(f23*t1 + f13*t2*rs(ip) + f23*t3*rs(ip))*rsr END IF END DO @@ -463,27 +463,27 @@ SUBROUTINE pade_lda_3(n, rho, rs, pot) DO ip = 1, n IF (rho(ip) > eps_rho) THEN - p = a0+(a1+(a2+a3*rs(ip))*rs(ip))*rs(ip) - q = (b1+(b2+(b3+b4*rs(ip))*rs(ip))*rs(ip))*rs(ip) + p = a0 + (a1 + (a2 + a3*rs(ip))*rs(ip))*rs(ip) + q = (b1 + (b2 + (b3 + b4*rs(ip))*rs(ip))*rs(ip))*rs(ip) - dpv = a1+(2.0_dp*a2+3.0_dp*a3*rs(ip))*rs(ip) - dq = b1+(2.0_dp*b2+(3.0_dp*b3+4.0_dp*b4*rs(ip))*rs(ip))*rs(ip) + dpv = a1 + (2.0_dp*a2 + 3.0_dp*a3*rs(ip))*rs(ip) + dq = b1 + (2.0_dp*b2 + (3.0_dp*b3 + 4.0_dp*b4*rs(ip))*rs(ip))*rs(ip) - d2p = 2.0_dp*a2+6.0_dp*a3*rs(ip) - d2q = 2.0_dp*b2+(6.0_dp*b3+12.0_dp*b4*rs(ip))*rs(ip) + d2p = 2.0_dp*a2 + 6.0_dp*a3*rs(ip) + d2q = 2.0_dp*b2 + (6.0_dp*b3 + 12.0_dp*b4*rs(ip))*rs(ip) d3p = 6.0_dp*a3 - d3q = 6.0_dp*b3+24.0_dp*b4*rs(ip) + d3q = 6.0_dp*b3 + 24.0_dp*b4*rs(ip) - ab1 = (dpv*q-p*dq)/(q*q) - ab2 = (d2p*q*q-p*q*d2q-2.0_dp*dpv*q*dq+2.0_dp*p*dq*dq)/(q*q*q) - ab3 = (d3p*q*q-p*q*d3q-3.0_dp*dpv*q*d2q+3.0_dp*p*dq*d2q)/(q*q*q) - ab3 = ab3-3.0_dp*ab2*dq/q + ab1 = (dpv*q - p*dq)/(q*q) + ab2 = (d2p*q*q - p*q*d2q - 2.0_dp*dpv*q*dq + 2.0_dp*p*dq*dq)/(q*q*q) + ab3 = (d3p*q*q - p*q*d3q - 3.0_dp*dpv*q*d2q + 3.0_dp*p*dq*d2q)/(q*q*q) + ab3 = ab3 - 3.0_dp*ab2*dq/q rsr1 = rs(ip)/(rho(ip)*rho(ip)) rsr2 = f13*f13*rs(ip)*rsr1 rsr3 = f13*rs(ip)*rsr2 rsr1 = -f23*f23*f23*rsr1 - pot(ip) = pot(ip)+rsr1*ab1+rsr2*ab2+rsr3*ab3 + pot(ip) = pot(ip) + rsr1*ab1 + rsr2*ab2 + rsr3*ab3 END IF END DO @@ -507,23 +507,23 @@ SUBROUTINE pade_lsd_0(rhoa, rhob, rs, fx, pot0) REAL(KIND=dp) :: fa0, fa1, fa2, fa3, fb1, fb2, fb3, fb4, & p, q, rhoab - rhoab = rhoa+rhob + rhoab = rhoa + rhob IF (rhoab > eps_rho) THEN - fa0 = a0+fx(1)*da0 - fa1 = a1+fx(1)*da1 - fa2 = a2+fx(1)*da2 - fa3 = a3+fx(1)*da3 - fb1 = b1+fx(1)*db1 - fb2 = b2+fx(1)*db2 - fb3 = b3+fx(1)*db3 - fb4 = b4+fx(1)*db4 + fa0 = a0 + fx(1)*da0 + fa1 = a1 + fx(1)*da1 + fa2 = a2 + fx(1)*da2 + fa3 = a3 + fx(1)*da3 + fb1 = b1 + fx(1)*db1 + fb2 = b2 + fx(1)*db2 + fb3 = b3 + fx(1)*db3 + fb4 = b4 + fx(1)*db4 - p = fa0+(fa1+(fa2+fa3*rs)*rs)*rs - q = (fb1+(fb2+(fb3+fb4*rs)*rs)*rs)*rs + p = fa0 + (fa1 + (fa2 + fa3*rs)*rs)*rs + q = (fb1 + (fb2 + (fb3 + fb4*rs)*rs)*rs)*rs - pot0 = pot0-p/q*rhoab + pot0 = pot0 - p/q*rhoab END IF @@ -547,33 +547,33 @@ SUBROUTINE pade_lsd_1(rhoa, rhob, rs, fx, pota, potb) REAL(KIND=dp) :: dc, dpv, dq, dr, dx, fa0, fa1, fa2, fa3, & fb1, fb2, fb3, fb4, p, q, rhoab, xp, xq - rhoab = rhoa+rhob + rhoab = rhoa + rhob IF (rhoab > eps_rho) THEN - fa0 = a0+fx(1)*da0 - fa1 = a1+fx(1)*da1 - fa2 = a2+fx(1)*da2 - fa3 = a3+fx(1)*da3 - fb1 = b1+fx(1)*db1 - fb2 = b2+fx(1)*db2 - fb3 = b3+fx(1)*db3 - fb4 = b4+fx(1)*db4 - - p = fa0+(fa1+(fa2+fa3*rs)*rs)*rs - q = (fb1+(fb2+(fb3+fb4*rs)*rs)*rs)*rs - dpv = fa1+(2.0_dp*fa2+3.0_dp*fa3*rs)*rs - dq = fb1+(2.0_dp*fb2+(3.0_dp*fb3+ & - 4.0_dp*fb4*rs)*rs)*rs - xp = da0+(da1+(da2+da3*rs)*rs)*rs - xq = (db1+(db2+(db3+db4*rs)*rs)*rs)*rs - - dr = (dpv*q-p*dq)/(q*q) - dx = 2.0_dp*(xp*q-p*xq)/(q*q)*fx(2)/rhoab - dc = f13*rs*dr-p/q - - pota = pota+dc-dx*rhob - potb = potb+dc+dx*rhoa + fa0 = a0 + fx(1)*da0 + fa1 = a1 + fx(1)*da1 + fa2 = a2 + fx(1)*da2 + fa3 = a3 + fx(1)*da3 + fb1 = b1 + fx(1)*db1 + fb2 = b2 + fx(1)*db2 + fb3 = b3 + fx(1)*db3 + fb4 = b4 + fx(1)*db4 + + p = fa0 + (fa1 + (fa2 + fa3*rs)*rs)*rs + q = (fb1 + (fb2 + (fb3 + fb4*rs)*rs)*rs)*rs + dpv = fa1 + (2.0_dp*fa2 + 3.0_dp*fa3*rs)*rs + dq = fb1 + (2.0_dp*fb2 + (3.0_dp*fb3 + & + 4.0_dp*fb4*rs)*rs)*rs + xp = da0 + (da1 + (da2 + da3*rs)*rs)*rs + xq = (db1 + (db2 + (db3 + db4*rs)*rs)*rs)*rs + + dr = (dpv*q - p*dq)/(q*q) + dx = 2.0_dp*(xp*q - p*xq)/(q*q)*fx(2)/rhoab + dc = f13*rs*dr - p/q + + pota = pota + dc - dx*rhob + potb = potb + dc + dx*rhoa END IF @@ -598,34 +598,34 @@ SUBROUTINE pade_lsd_01(rhoa, rhob, rs, fx, pot0, pota, potb) REAL(KIND=dp) :: dc, dpv, dq, dr, dx, fa0, fa1, fa2, fa3, & fb1, fb2, fb3, fb4, p, q, rhoab, xp, xq - rhoab = rhoa+rhob + rhoab = rhoa + rhob IF (rhoab > eps_rho) THEN - fa0 = a0+fx(1)*da0 - fa1 = a1+fx(1)*da1 - fa2 = a2+fx(1)*da2 - fa3 = a3+fx(1)*da3 - fb1 = b1+fx(1)*db1 - fb2 = b2+fx(1)*db2 - fb3 = b3+fx(1)*db3 - fb4 = b4+fx(1)*db4 - - p = fa0+(fa1+(fa2+fa3*rs)*rs)*rs - q = (fb1+(fb2+(fb3+fb4*rs)*rs)*rs)*rs - dpv = fa1+(2.0_dp*fa2+3.0_dp*fa3*rs)*rs - dq = fb1+(2.0_dp*fb2+(3.0_dp*fb3+ & - 4.0_dp*fb4*rs)*rs)*rs - xp = da0+(da1+(da2+da3*rs)*rs)*rs - xq = (db1+(db2+(db3+db4*rs)*rs)*rs)*rs - - dr = (dpv*q-p*dq)/(q*q) - dx = 2.0_dp*(xp*q-p*xq)/(q*q)*fx(2)/rhoab - dc = f13*rs*dr-p/q - - pot0 = pot0-p/q*rhoab - pota = pota+dc-dx*rhob - potb = potb+dc+dx*rhoa + fa0 = a0 + fx(1)*da0 + fa1 = a1 + fx(1)*da1 + fa2 = a2 + fx(1)*da2 + fa3 = a3 + fx(1)*da3 + fb1 = b1 + fx(1)*db1 + fb2 = b2 + fx(1)*db2 + fb3 = b3 + fx(1)*db3 + fb4 = b4 + fx(1)*db4 + + p = fa0 + (fa1 + (fa2 + fa3*rs)*rs)*rs + q = (fb1 + (fb2 + (fb3 + fb4*rs)*rs)*rs)*rs + dpv = fa1 + (2.0_dp*fa2 + 3.0_dp*fa3*rs)*rs + dq = fb1 + (2.0_dp*fb2 + (3.0_dp*fb3 + & + 4.0_dp*fb4*rs)*rs)*rs + xp = da0 + (da1 + (da2 + da3*rs)*rs)*rs + xq = (db1 + (db2 + (db3 + db4*rs)*rs)*rs)*rs + + dr = (dpv*q - p*dq)/(q*q) + dx = 2.0_dp*(xp*q - p*xq)/(q*q)*fx(2)/rhoab + dc = f13*rs*dr - p/q + + pot0 = pot0 - p/q*rhoab + pota = pota + dc - dx*rhob + potb = potb + dc + dx*rhoa END IF @@ -652,58 +652,58 @@ SUBROUTINE pade_lsd_2(rhoa, rhob, rs, fx, potaa, potab, potbb) fb1, fb2, fb3, fb4, or, p, q, rhoab, & xp, xq, xt, yt - rhoab = rhoa+rhob + rhoab = rhoa + rhob IF (rhoab > eps_rho) THEN - fa0 = a0+fx(1)*da0 - fa1 = a1+fx(1)*da1 - fa2 = a2+fx(1)*da2 - fa3 = a3+fx(1)*da3 - fb1 = b1+fx(1)*db1 - fb2 = b2+fx(1)*db2 - fb3 = b3+fx(1)*db3 - fb4 = b4+fx(1)*db4 + fa0 = a0 + fx(1)*da0 + fa1 = a1 + fx(1)*da1 + fa2 = a2 + fx(1)*da2 + fa3 = a3 + fx(1)*da3 + fb1 = b1 + fx(1)*db1 + fb2 = b2 + fx(1)*db2 + fb3 = b3 + fx(1)*db3 + fb4 = b4 + fx(1)*db4 - p = fa0+(fa1+(fa2+fa3*rs)*rs)*rs - q = (fb1+(fb2+(fb3+fb4*rs)*rs)*rs)*rs + p = fa0 + (fa1 + (fa2 + fa3*rs)*rs)*rs + q = (fb1 + (fb2 + (fb3 + fb4*rs)*rs)*rs)*rs - dpv = fa1+(2.0_dp*fa2+3.0_dp*fa3*rs)*rs - dq = fb1+(2.0_dp*fb2+(3.0_dp*fb3+ & - 4.0_dp*fb4*rs)*rs)*rs + dpv = fa1 + (2.0_dp*fa2 + 3.0_dp*fa3*rs)*rs + dq = fb1 + (2.0_dp*fb2 + (3.0_dp*fb3 + & + 4.0_dp*fb4*rs)*rs)*rs - d2p = 2.0_dp*fa2+6.0_dp*fa3*rs - d2q = 2.0_dp*fb2+(6.0_dp*fb3+12.0_dp*fb4*rs)*rs + d2p = 2.0_dp*fa2 + 6.0_dp*fa3*rs + d2q = 2.0_dp*fb2 + (6.0_dp*fb3 + 12.0_dp*fb4*rs)*rs - xp = da0+(da1+(da2+da3*rs)*rs)*rs - xq = (db1+(db2+(db3+db4*rs)*rs)*rs)*rs + xp = da0 + (da1 + (da2 + da3*rs)*rs)*rs + xq = (db1 + (db2 + (db3 + db4*rs)*rs)*rs)*rs - dxp = da1+(2.0_dp*da2+3.0_dp*da3*rs)*rs - dxq = db1+(2.0_dp*db2+(3.0_dp*db3+ & - 4.0_dp*db4*rs)*rs)*rs + dxp = da1 + (2.0_dp*da2 + 3.0_dp*da3*rs)*rs + dxq = db1 + (2.0_dp*db2 + (3.0_dp*db3 + & + 4.0_dp*db4*rs)*rs)*rs - dr = (dpv*q-p*dq)/(q*q) - drr = (d2p*q*q-p*q*d2q-2.0_dp*dpv*q*dq+2.0_dp*p*dq*dq)/(q*q*q) - dx = (xp*q-p*xq)/(q*q) - dxx = 2.0_dp*xq*(p*xq-xp*q)/(q*q*q) - dxr = (dxp*q*q+dpv*xq*q-xp*dq*q-p*dxq*q-2.0_dp*dpv*q*xq+2.0_dp*p*dq*xq)/(q*q*q) + dr = (dpv*q - p*dq)/(q*q) + drr = (d2p*q*q - p*q*d2q - 2.0_dp*dpv*q*dq + 2.0_dp*p*dq*dq)/(q*q*q) + dx = (xp*q - p*xq)/(q*q) + dxx = 2.0_dp*xq*(p*xq - xp*q)/(q*q*q) + dxr = (dxp*q*q + dpv*xq*q - xp*dq*q - p*dxq*q - 2.0_dp*dpv*q*xq + 2.0_dp*p*dq*xq)/(q*q*q) or = 1.0_dp/rhoab yt = rhob*or xt = rhoa*or - potaa = potaa+f23*f13*dr*rs*or-f13*f13*drr*rs*rs*or & - +f43*rs*fx(2)*dxr*yt*or & - -4.0_dp*fx(2)*fx(2)*dxx*yt*yt*or & - -4.0_dp*dx*fx(3)*yt*yt*or - potab = potab+f23*f13*dr*rs*or-f13*f13*drr*rs*rs*or & - +f23*rs*fx(2)*dxr*(yt-xt)*or & - +4.0_dp*fx(2)*fx(2)*dxx*xt*yt*or & - +4.0_dp*dx*fx(3)*xt*yt*or - potbb = potbb+f23*f13*dr*rs*or-f13*f13*drr*rs*rs*or & - -f43*rs*fx(2)*dxr*xt*or & - -4.0_dp*fx(2)*fx(2)*dxx*xt*xt*or & - -4.0_dp*dx*fx(3)*xt*xt*or + potaa = potaa + f23*f13*dr*rs*or - f13*f13*drr*rs*rs*or & + + f43*rs*fx(2)*dxr*yt*or & + - 4.0_dp*fx(2)*fx(2)*dxx*yt*yt*or & + - 4.0_dp*dx*fx(3)*yt*yt*or + potab = potab + f23*f13*dr*rs*or - f13*f13*drr*rs*rs*or & + + f23*rs*fx(2)*dxr*(yt - xt)*or & + + 4.0_dp*fx(2)*fx(2)*dxx*xt*yt*or & + + 4.0_dp*dx*fx(3)*xt*yt*or + potbb = potbb + f23*f13*dr*rs*or - f13*f13*drr*rs*rs*or & + - f43*rs*fx(2)*dxr*xt*or & + - 4.0_dp*fx(2)*fx(2)*dxx*xt*xt*or & + - 4.0_dp*dx*fx(3)*xt*xt*or END IF @@ -734,67 +734,67 @@ SUBROUTINE pade_lsd_3(rhoa, rhob, rs, fx, potaaa, potaab, potabb, potbbb) IF (.NOT. debug_flag) CPABORT("Routine not tested") - rhoab = rhoa+rhob + rhoab = rhoa + rhob IF (rhoab > eps_rho) THEN - fa0 = a0+fx(1)*da0 - fa1 = a1+fx(1)*da1 - fa2 = a2+fx(1)*da2 - fa3 = a3+fx(1)*da3 - fb1 = b1+fx(1)*db1 - fb2 = b2+fx(1)*db2 - fb3 = b3+fx(1)*db3 - fb4 = b4+fx(1)*db4 + fa0 = a0 + fx(1)*da0 + fa1 = a1 + fx(1)*da1 + fa2 = a2 + fx(1)*da2 + fa3 = a3 + fx(1)*da3 + fb1 = b1 + fx(1)*db1 + fb2 = b2 + fx(1)*db2 + fb3 = b3 + fx(1)*db3 + fb4 = b4 + fx(1)*db4 - p = fa0+(fa1+(fa2+fa3*rs)*rs)*rs - q = (fb1+(fb2+(fb3+fb4*rs)*rs)*rs)*rs + p = fa0 + (fa1 + (fa2 + fa3*rs)*rs)*rs + q = (fb1 + (fb2 + (fb3 + fb4*rs)*rs)*rs)*rs - dpv = fa1+(2.0_dp*fa2+3.0_dp*fa3*rs)*rs - dq = fb1+(2.0_dp*fb2+(3.0_dp*fb3+ & - 4.0_dp*fb4*rs)*rs)*rs + dpv = fa1 + (2.0_dp*fa2 + 3.0_dp*fa3*rs)*rs + dq = fb1 + (2.0_dp*fb2 + (3.0_dp*fb3 + & + 4.0_dp*fb4*rs)*rs)*rs - d2p = 2.0_dp*fa2+6.0_dp*fa3*rs - d2q = 2.0_dp*fb2+(6.0_dp*fb3+12.0_dp*fb4*rs)*rs + d2p = 2.0_dp*fa2 + 6.0_dp*fa3*rs + d2q = 2.0_dp*fb2 + (6.0_dp*fb3 + 12.0_dp*fb4*rs)*rs d3p = 6.0_dp*fa3 - d3q = 6.0_dp*fb3+24.0_dp*fb4*rs - - xp = da0+(da1+(da2+da3*rs)*rs)*rs - xq = (db1+(db2+(db3+db4*rs)*rs)*rs)*rs - - dxp = da1+(2.0_dp*da2+3.0_dp*da3*rs)*rs - dxq = db1+(2.0_dp*db2+(3.0_dp*db3+ & - 4.0_dp*db4*rs)*rs)*rs - - d2xp = 2.0_dp*da2+6.0_dp*da3*rs - d2xq = 2.0_dp*db2+(6.0_dp*db3+12.0_dp*db4*rs)*rs - - dr = (dpv*q-p*dq)/(q*q) - drr = (d2p*q*q-p*q*d2q-2.0_dp*dpv*q*dq+2.0_dp*p*dq*dq)/(q*q*q) - drrr = (d3p*q*q*q-3.0_dp*d2p*dq*q*q+6.0_dp*dpv*dq*dq*q-3.0_dp*dpv*d2q*q*q- & - 6.0_dp*p*dq*dq*dq+6.0_dp*p*dq*d2q*q-p*d3q*q*q)/(q*q*q*q) - dx = (xp*q-p*xq)/(q*q) - dxx = 2.0_dp*xq*(p*xq-xp*q)/(q*q*q) - dxxx = 6.0_dp*xq*(q*xp*xq-p*xq*xq)/(q*q*q*q) - dxr = (dxp*q*q+dpv*xq*q-xp*dq*q-p*dxq*q-2.0_dp*dpv*q*xq+2.0_dp*p*dq*xq)/(q*q*q) - dxxr = 2.0_dp*(2.0_dp*dxq*q*p*xq-dxq*q*q*xp+xq*xq*q*dpv-xq*q*q*dxp+ & - 2.0_dp*xq*q*xp*dq-3.0_dp*xq*xq*dq*p)/(q*q*q*q) - dxrr = (q*q*q*d2xp-2.0_dp*q*q*dxp*dq-q*q*xp*d2q-q*q*d2p*xq- & - 2.0_dp*q*q*dpv*dxq-q*q*p*d2xq+4.0_dp*dq*q*dpv*xq+4.0_dp*dq*q*p*dxq+ & - 2.0_dp*dq*dq*q*xp-6.0_dp*dq*dq*p*xq+2.0_dp*d2q*q*p*xq)/(q*q*q*q) + d3q = 6.0_dp*fb3 + 24.0_dp*fb4*rs + + xp = da0 + (da1 + (da2 + da3*rs)*rs)*rs + xq = (db1 + (db2 + (db3 + db4*rs)*rs)*rs)*rs + + dxp = da1 + (2.0_dp*da2 + 3.0_dp*da3*rs)*rs + dxq = db1 + (2.0_dp*db2 + (3.0_dp*db3 + & + 4.0_dp*db4*rs)*rs)*rs + + d2xp = 2.0_dp*da2 + 6.0_dp*da3*rs + d2xq = 2.0_dp*db2 + (6.0_dp*db3 + 12.0_dp*db4*rs)*rs + + dr = (dpv*q - p*dq)/(q*q) + drr = (d2p*q*q - p*q*d2q - 2.0_dp*dpv*q*dq + 2.0_dp*p*dq*dq)/(q*q*q) + drrr = (d3p*q*q*q - 3.0_dp*d2p*dq*q*q + 6.0_dp*dpv*dq*dq*q - 3.0_dp*dpv*d2q*q*q - & + 6.0_dp*p*dq*dq*dq + 6.0_dp*p*dq*d2q*q - p*d3q*q*q)/(q*q*q*q) + dx = (xp*q - p*xq)/(q*q) + dxx = 2.0_dp*xq*(p*xq - xp*q)/(q*q*q) + dxxx = 6.0_dp*xq*(q*xp*xq - p*xq*xq)/(q*q*q*q) + dxr = (dxp*q*q + dpv*xq*q - xp*dq*q - p*dxq*q - 2.0_dp*dpv*q*xq + 2.0_dp*p*dq*xq)/(q*q*q) + dxxr = 2.0_dp*(2.0_dp*dxq*q*p*xq - dxq*q*q*xp + xq*xq*q*dpv - xq*q*q*dxp + & + 2.0_dp*xq*q*xp*dq - 3.0_dp*xq*xq*dq*p)/(q*q*q*q) + dxrr = (q*q*q*d2xp - 2.0_dp*q*q*dxp*dq - q*q*xp*d2q - q*q*d2p*xq - & + 2.0_dp*q*q*dpv*dxq - q*q*p*d2xq + 4.0_dp*dq*q*dpv*xq + 4.0_dp*dq*q*p*dxq + & + 2.0_dp*dq*dq*q*xp - 6.0_dp*dq*dq*p*xq + 2.0_dp*d2q*q*p*xq)/(q*q*q*q) or = 1.0_dp/rhoab yt = rhob*or xt = rhoa*or - potaaa = potaaa+8.0_dp/27.0_dp*dr*rs*or*or+ & - 1.0_dp/9.0_dp*drr*rs*rs*or*or+ & - 1.0_dp/27.0_dp*drrr*rs**3*or*or+ & - dxr*or*or*yt*rs*(-8.0_dp/3.0_dp*fx(2)+4.0_dp*fx(3)*yt) - potaab = potaab+0.0_dp - potabb = potabb+0.0_dp - potbbb = potbbb+0.0_dp + potaaa = potaaa + 8.0_dp/27.0_dp*dr*rs*or*or + & + 1.0_dp/9.0_dp*drr*rs*rs*or*or + & + 1.0_dp/27.0_dp*drrr*rs**3*or*or + & + dxr*or*or*yt*rs*(-8.0_dp/3.0_dp*fx(2) + 4.0_dp*fx(3)*yt) + potaab = potaab + 0.0_dp + potabb = potabb + 0.0_dp + potbbb = potbbb + 0.0_dp END IF diff --git a/src/xc/xc_pbe.F b/src/xc/xc_pbe.F index 6384f9fce7..d79aaa5e66 100644 --- a/src/xc/xc_pbe.F +++ b/src/xc/xc_pbe.F @@ -302,7 +302,7 @@ SUBROUTINE pbe_lda_eval(rho_set, deriv_set, grad_deriv, pbe_params) CPASSERT(deriv_set%ref_count > 0) CALL xc_rho_set_get(rho_set, rho=rho, & norm_drho=norm_drho, local_bounds=bo, rho_cutoff=epsilon_rho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rho @@ -494,7 +494,7 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & CPABORT("") END SELECT - gamma_var = (0.1e1_dp-LOG(0.2e1_dp))/pi**2 + gamma_var = (0.1e1_dp - LOG(0.2e1_dp))/pi**2 p_1 = 0.10e1_dp A_1 = 0.31091e-1_dp alpha_1_1 = 0.21370e0_dp @@ -523,15 +523,15 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & t7 = t5*t6 t8 = t7**(0.1e1_dp/0.3e1_dp) rs = t4*t8/0.4e1_dp - t11 = 0.1e1_dp+alpha_1_1*rs + t11 = 0.1e1_dp + alpha_1_1*rs t13 = 0.1e1_dp/A_1 t14 = SQRT(rs) t17 = t14*rs - t19 = p_1+0.1e1_dp + t19 = p_1 + 0.1e1_dp t20 = rs**t19 t21 = beta_4_1*t20 - t22 = beta_1_1*t14+beta_2_1*rs+beta_3_1*t17+t21 - t26 = 0.1e1_dp+t13/t22/0.2e1_dp + t22 = beta_1_1*t14 + beta_2_1*rs + beta_3_1*t17 + t21 + t26 = 0.1e1_dp + t13/t22/0.2e1_dp t27 = LOG(t26) e_c_u_0 = -0.2e1_dp*A_1*t11*t27 t65 = 2**(0.1e1_dp/0.3e1_dp) @@ -547,19 +547,19 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & t77 = 0.1e1_dp/gamma_var t78 = beta*t77 t80 = EXP(-e_c_u_0*t77) - t81 = -0.1e1_dp+t80 + t81 = -0.1e1_dp + t80 A = t78/t81 t83 = t**2 t84 = A*t83 - t85 = 0.1e1_dp+t84 + t85 = 0.1e1_dp + t84 t86 = t83*t85 t87 = A**2 t88 = t83**2 - t90 = 0.1e1_dp+t84+t87*t88 + t90 = 0.1e1_dp + t84 + t87*t88 t91 = 0.1e1_dp/t90 - t94 = 0.1e1_dp+t78*t86*t91 + t94 = 0.1e1_dp + t78*t86*t91 t95 = LOG(t94) - epsilon_cGGA = e_c_u_0+gamma_var*t95 + epsilon_cGGA = e_c_u_0 + gamma_var*t95 kf = k_f ex_unif = -0.3e1_dp/0.4e1_dp*t5*kf t98 = 0.1e1_dp/kf @@ -567,13 +567,13 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & s = t99*t6/0.2e1_dp t101 = s**2 t103 = 0.1e1_dp/kappa - t105 = 0.1e1_dp+mu*t101*t103 - Fx = 0.1e1_dp+kappa-kappa/t105 + t105 = 0.1e1_dp + mu*t101*t103 + Fx = 0.1e1_dp + kappa - kappa/t105 t108 = my_rho*ex_unif IF (grad_deriv >= 0) THEN - e_0(ii) = e_0(ii)+ & - scale_ex*t108*Fx+scale_ec*my_rho*epsilon_cGGA + e_0(ii) = e_0(ii) + & + scale_ex*t108*Fx + scale_ec*my_rho*epsilon_cGGA END IF t111 = t8**2 @@ -589,11 +589,11 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & t127 = beta_1_1*t126 t131 = beta_3_1*t14 t135 = 0.1e1_dp/rs - t138 = t127*rsrho/0.2e1_dp+beta_2_1*rsrho+0.3e1_dp/ & - 0.2e1_dp*t131*rsrho+t21*t19*rsrho*t135 + t138 = t127*rsrho/0.2e1_dp + beta_2_1*rsrho + 0.3e1_dp/ & + 0.2e1_dp*t131*rsrho + t21*t19*rsrho*t135 t139 = 0.1e1_dp/t26 t140 = t138*t139 - e_c_u_0rho = -0.2e1_dp*t119*rsrho*t27+t125*t140 + e_c_u_0rho = -0.2e1_dp*t119*rsrho*t27 + t125*t140 t142 = t71**2 k_frho = t1/t142*t69/0.3e1_dp t146 = 0.1e1_dp/t73 @@ -603,7 +603,7 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & t150 = my_norm_drho*t149 t151 = t6*k_srho t153 = t75*t115 - trho = -t150*t151/0.2e1_dp-t153/0.2e1_dp + trho = -t150*t151/0.2e1_dp - t153/0.2e1_dp t155 = gamma_var**2 t157 = beta/t155 t158 = t81**2 @@ -615,7 +615,7 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & t167 = Arho*t83 t168 = A*t t170 = 0.2e1_dp*t168*trho - t171 = t167+t170 + t171 = t167 + t170 t175 = t78*t83 t176 = t90**2 t177 = 0.1e1_dp/t176 @@ -623,12 +623,12 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & t179 = A*t88 t182 = t83*t t183 = t87*t182 - t186 = t167+t170+0.2e1_dp*t179*Arho+0.4e1_dp*t183*trho + t186 = t167 + t170 + 0.2e1_dp*t179*Arho + 0.4e1_dp*t183*trho t187 = t178*t186 - t189 = 0.2e1_dp*t162*t164+t78*t83*t171*t91-t175*t187 + t189 = 0.2e1_dp*t162*t164 + t78*t83*t171*t91 - t175*t187 t190 = gamma_var*t189 t191 = 0.1e1_dp/t94 - epsilon_cGGArho = e_c_u_0rho+t190*t191 + epsilon_cGGArho = e_c_u_0rho + t190*t191 kfrho = k_frho ex_unifrho = -0.3e1_dp/0.4e1_dp*t5*kfrho t195 = kf**2 @@ -636,24 +636,24 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & t197 = my_norm_drho*t196 t198 = t6*kfrho t200 = t99*t115 - srho = -t197*t198/0.2e1_dp-t200/0.2e1_dp + srho = -t197*t198/0.2e1_dp - t200/0.2e1_dp t202 = t105**2 t204 = 0.1e1_dp/t202*mu Fxrho = 0.2e1_dp*t204*s*srho t208 = my_rho*ex_unifrho IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN - e_rho(ii) = e_rho(ii)+ & - scale_ex*(ex_unif*Fx+t208*Fx+t108*Fxrho)+ & - scale_ec*(epsilon_cGGA+my_rho*epsilon_cGGArho) + e_rho(ii) = e_rho(ii) + & + scale_ex*(ex_unif*Fx + t208*Fx + t108*Fxrho) + & + scale_ec*(epsilon_cGGA + my_rho*epsilon_cGGArho) END IF tnorm_drho = t74*t6/0.2e1_dp t214 = t163*tnorm_drho t217 = t78*t182 t218 = A*tnorm_drho - t226 = 0.2e1_dp*t168*tnorm_drho+0.4e1_dp*t183*tnorm_drho - t229 = 0.2e1_dp*t162*t214+0.2e1_dp*t217*t218*t91- & + t226 = 0.2e1_dp*t168*tnorm_drho + 0.4e1_dp*t183*tnorm_drho + t229 = 0.2e1_dp*t162*t214 + 0.2e1_dp*t217*t218*t91 - & t175*t178*t226 t230 = gamma_var*t229 Hnorm_drho = t230*t191 @@ -661,8 +661,8 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & Fxnorm_drho = 0.2e1_dp*t204*s*snorm_drho IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN - e_ndrho(ii) = e_ndrho(ii)+ & - scale_ex*t108*Fxnorm_drho+scale_ec*my_rho* & + e_ndrho(ii) = e_ndrho(ii) + & + scale_ex*t108*Fxnorm_drho + scale_ec*my_rho* & Hnorm_drho END IF @@ -671,7 +671,7 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & t240 = t114**2 t241 = 0.1e1_dp/t240 t246 = 0.1e1_dp/t114/my_rho - rsrhorho = -t4*t239*t241/0.18e2_dp+t4*t113* & + rsrhorho = -t4*t239*t241/0.18e2_dp + t4*t113* & t246/0.6e1_dp t252 = 0.2e1_dp*t119*rsrhorho*t27 t253 = alpha_1_1*rsrho @@ -691,8 +691,8 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & t280 = rs**2 t281 = 0.1e1_dp/t280 t286 = t21*t19*rsrhorho*t135 - t290 = -t266*t267/0.4e1_dp+t271+t272+0.3e1_dp/0.4e1_dp & - *t273*t267+t277+t21*t278*t267*t281+t286-t21*t19 & + t290 = -t266*t267/0.4e1_dp + t271 + t272 + 0.3e1_dp/0.4e1_dp & + *t273*t267 + t277 + t21*t278*t267*t281 + t286 - t21*t19 & *t267*t281 t291 = t290*t139 t293 = t123**2 @@ -701,15 +701,15 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & t296 = t26**2 t297 = 0.1e1_dp/t296 t299 = t261*t297*t13 - e_c_u_0rhorho = -t252+0.2e1_dp*t253*t255-0.2e1_dp*t260* & - t262+t125*t291+t295*t299/0.2e1_dp + e_c_u_0rhorho = -t252 + 0.2e1_dp*t253*t255 - 0.2e1_dp*t260* & + t262 + t125*t291 + t295*t299/0.2e1_dp e_c_u_01rho = e_c_u_0rho t305 = t69**2 k_frhorho = -0.2e1_dp/0.9e1_dp*t1/t142/t70*t305 t309 = 0.1e1_dp/t73/t72 t310 = k_frho**2 t315 = t146*k_frhorho*t5 - k_srhorho = -t309*t310*t238/0.2e1_dp+t315 + k_srhorho = -t309*t310*t238/0.2e1_dp + t315 k_s1rho = k_srho t317 = 0.1e1_dp/t148/k_s t318 = my_norm_drho*t317 @@ -719,10 +719,10 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & t327 = t115*k_s1rho t329 = t150*t327/0.2e1_dp t330 = t75*t246 - trhorho = t318*t151*k_s1rho+t323-t150*t324/0.2e1_dp+ & - t329+t330 + trhorho = t318*t151*k_s1rho + t323 - t150*t324/0.2e1_dp + & + t329 + t330 t331 = t6*k_s1rho - t1rho = -t150*t331/0.2e1_dp-t153/0.2e1_dp + t1rho = -t150*t331/0.2e1_dp - t153/0.2e1_dp t336 = beta/t155/gamma_var t338 = 0.1e1_dp/t158/t81 t339 = t336*t338 @@ -730,16 +730,16 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & t341 = e_c_u_0rho*t340 t348 = t336*t159 t349 = e_c_u_0rho*e_c_u_01rho - Arhorho = 0.2e1_dp*t339*t341*e_c_u_01rho+t157*t159* & - e_c_u_0rhorho*t80-t348*t349*t80 + Arhorho = 0.2e1_dp*t339*t341*e_c_u_01rho + t157*t159* & + e_c_u_0rhorho*t80 - t348*t349*t80 A1rho = t157*t159*e_c_u_01rho*t80 t354 = t78*t1rho t357 = A1rho*t83 t359 = 0.2e1_dp*t168*t1rho - t360 = t357+t359 + t360 = t357 + t359 t361 = t360*t91 t362 = t361*trho - t369 = t357+t359+0.2e1_dp*t179*A1rho+0.4e1_dp*t183*t1rho + t369 = t357 + t359 + 0.2e1_dp*t179*A1rho + 0.4e1_dp*t183*t1rho t370 = trho*t369 t371 = t178*t370 t374 = t163*trhorho @@ -753,7 +753,7 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & t388 = A*t1rho t390 = 0.2e1_dp*t388*trho t392 = 0.2e1_dp*t168*trhorho - t393 = t381+t384+t387+t390+t392 + t393 = t381 + t384 + t387 + t390 + t392 t397 = t171*t177 t400 = t186*t1rho t401 = t178*t400 @@ -767,23 +767,23 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & t423 = trho*A1rho t426 = t87*t83 t427 = trho*t1rho - t432 = t381+t384+t387+t390+t392+0.2e1_dp*t414*Arho+ & - 0.8e1_dp*t417*t418+0.2e1_dp*t179*Arhorho+0.8e1_dp* & - t417*t423+0.12e2_dp*t426*t427+0.4e1_dp*t183*trhorho - t435 = 0.2e1_dp*t354*t164+0.2e1_dp*t162*t362-0.2e1_dp & - *t162*t371+0.2e1_dp*t162*t374+0.2e1_dp*t162*t378+ & - t78*t83*t393*t91-t175*t397*t369-0.2e1_dp*t162*t401 & - -t175*t404*t186+0.2e1_dp*t175*t409*t410-t175*t178 & + t432 = t381 + t384 + t387 + t390 + t392 + 0.2e1_dp*t414*Arho + & + 0.8e1_dp*t417*t418 + 0.2e1_dp*t179*Arhorho + 0.8e1_dp* & + t417*t423 + 0.12e2_dp*t426*t427 + 0.4e1_dp*t183*trhorho + t435 = 0.2e1_dp*t354*t164 + 0.2e1_dp*t162*t362 - 0.2e1_dp & + *t162*t371 + 0.2e1_dp*t162*t374 + 0.2e1_dp*t162*t378 + & + t78*t83*t393*t91 - t175*t397*t369 - 0.2e1_dp*t162*t401 & + - t175*t404*t186 + 0.2e1_dp*t175*t409*t410 - t175*t178 & *t432 t436 = gamma_var*t435 t438 = t94**2 t439 = 0.1e1_dp/t438 t440 = t163*t1rho - t448 = 0.2e1_dp*t162*t440+t78*t83*t360*t91-t175* & + t448 = 0.2e1_dp*t162*t440 + t78*t83*t360*t91 - t175* & t178*t369 t449 = t439*t448 t451 = gamma_var*t448 - epsilon_cGGArhorho = e_c_u_0rhorho+t436*t191-t190*t449 + epsilon_cGGArhorho = e_c_u_0rhorho + t436*t191 - t190*t449 kfrhorho = k_frhorho ex_unifrhorho = -0.3e1_dp/0.4e1_dp*t5*kfrhorho ex_unif1rho = ex_unifrho @@ -796,30 +796,30 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & t463 = t6*kfrhorho t465 = t197*t463/0.2e1_dp t466 = t99*t246 - srhorho = t457*t459+t462-t465+t466 + srhorho = t457*t459 + t462 - t465 + t466 s1rho = srho t469 = mu**2 t470 = 0.1e1_dp/t202/t105*t469 t471 = t470*t101 t472 = srho*t103 t476 = s1rho*srho - Fxrhorho = -0.8e1_dp*t471*t472*s1rho+0.2e1_dp*t204* & - t476+0.2e1_dp*t204*s*srhorho + Fxrhorho = -0.8e1_dp*t471*t472*s1rho + 0.2e1_dp*t204* & + t476 + 0.2e1_dp*t204*s*srhorho Fx1rho = 0.2e1_dp*t204*s*s1rho t487 = my_rho*ex_unifrhorho t491 = my_rho*ex_unif1rho IF (grad_deriv >= 2 .OR. grad_deriv == -2) THEN - e_rho_rho(ii) = e_rho_rho(ii)+ & - scale_ex*(ex_unif1rho*Fx+ex_unif*Fx1rho+ & - ex_unifrho*Fx+t487*Fx+t208*Fx1rho+ex_unif*Fxrho+t491 & - *Fxrho+t108*Fxrhorho)+scale_ec*(e_c_u_01rho+t451*t191 & - +epsilon_cGGArho+my_rho*epsilon_cGGArhorho) + e_rho_rho(ii) = e_rho_rho(ii) + & + scale_ex*(ex_unif1rho*Fx + ex_unif*Fx1rho + & + ex_unifrho*Fx + t487*Fx + t208*Fx1rho + ex_unif*Fxrho + t491 & + *Fxrho + t108*Fxrhorho) + scale_ec*(e_c_u_01rho + t451*t191 & + + epsilon_cGGArho + my_rho*epsilon_cGGArhorho) END IF t496 = t149*t6 t498 = t74*t115 - tnorm_drhorho = -t496*k_srho/0.2e1_dp-t498/0.2e1_dp + tnorm_drhorho = -t496*k_srho/0.2e1_dp - t498/0.2e1_dp t500 = t78*trho t503 = t377*tnorm_drho t506 = tnorm_drho*t186 @@ -834,28 +834,28 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & t535 = t226*t186 t541 = A*trho t548 = tnorm_drho*trho - t553 = 0.2e1_dp*t382*tnorm_drho+0.2e1_dp*t541*tnorm_drho & - +0.2e1_dp*t168*tnorm_drhorho+0.8e1_dp*t417*t517+ & - 0.12e2_dp*t426*t548+0.4e1_dp*t183*tnorm_drhorho - t556 = 0.2e1_dp*t500*t214+0.2e1_dp*t162*t503-0.2e1_dp & - *t162*t507+0.2e1_dp*t162*t510+0.6e1_dp*t175*t218* & - t513+0.2e1_dp*t217*t517*t91+0.2e1_dp*t217*t521*t91- & - 0.2e1_dp*t217*t218*t525-0.2e1_dp*t162*t530-t175* & - t397*t226+0.2e1_dp*t175*t409*t535-t175*t178*t553 + t553 = 0.2e1_dp*t382*tnorm_drho + 0.2e1_dp*t541*tnorm_drho & + + 0.2e1_dp*t168*tnorm_drhorho + 0.8e1_dp*t417*t517 + & + 0.12e2_dp*t426*t548 + 0.4e1_dp*t183*tnorm_drhorho + t556 = 0.2e1_dp*t500*t214 + 0.2e1_dp*t162*t503 - 0.2e1_dp & + *t162*t507 + 0.2e1_dp*t162*t510 + 0.6e1_dp*t175*t218* & + t513 + 0.2e1_dp*t217*t517*t91 + 0.2e1_dp*t217*t521*t91 - & + 0.2e1_dp*t217*t218*t525 - 0.2e1_dp*t162*t530 - t175* & + t397*t226 + 0.2e1_dp*t175*t409*t535 - t175*t178*t553 t557 = gamma_var*t556 t559 = t439*t189 - Hnorm_drhorho = t557*t191-t230*t559 + Hnorm_drhorho = t557*t191 - t230*t559 t562 = t196*t6 - snorm_drhorho = -t562*kfrho/0.2e1_dp-t98*t115/0.2e1_dp + snorm_drhorho = -t562*kfrho/0.2e1_dp - t98*t115/0.2e1_dp t566 = snorm_drho*t103 - Fxnorm_drhorho = -0.8e1_dp*t471*t566*srho+0.2e1_dp*t204 & - *srho*snorm_drho+0.2e1_dp*t204*s*snorm_drhorho + Fxnorm_drhorho = -0.8e1_dp*t471*t566*srho + 0.2e1_dp*t204 & + *srho*snorm_drho + 0.2e1_dp*t204*s*snorm_drhorho IF (grad_deriv >= 2 .OR. grad_deriv == -2) THEN - e_ndrho_rho(ii) = e_ndrho_rho(ii)+ & - scale_ex*(ex_unif*Fxnorm_drho+t208* & - Fxnorm_drho+t108*Fxnorm_drhorho)+scale_ec*(Hnorm_drho+my_rho & - *Hnorm_drhorho) + e_ndrho_rho(ii) = e_ndrho_rho(ii) + & + scale_ex*(ex_unif*Fxnorm_drho + t208* & + Fxnorm_drho + t108*Fxnorm_drhorho) + scale_ec*(Hnorm_drho + my_rho & + *Hnorm_drhorho) END IF t581 = tnorm_drho**2 @@ -864,31 +864,31 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & t591 = t178*t590 t594 = t177*t226 t598 = t226**2 - t605 = 0.2e1_dp*t586+0.12e2_dp*t426*t581 - t609 = gamma_var*(0.2e1_dp*t78*t581*t85*t91+0.10e2_dp & - *t175*t586*t91-0.4e1_dp*t162*t591-0.4e1_dp*t217* & - t218*t594+0.2e1_dp*t175*t409*t598-t175*t178*t605) + t605 = 0.2e1_dp*t586 + 0.12e2_dp*t426*t581 + t609 = gamma_var*(0.2e1_dp*t78*t581*t85*t91 + 0.10e2_dp & + *t175*t586*t91 - 0.4e1_dp*t162*t591 - 0.4e1_dp*t217* & + t218*t594 + 0.2e1_dp*t175*t409*t598 - t175*t178*t605) t611 = t229**2 t612 = gamma_var*t611 - Hnorm_drhonorm_drho = t609*t191-t612*t439 + Hnorm_drhonorm_drho = t609*t191 - t612*t439 t614 = snorm_drho**2 - Fxnorm_drhonorm_drho = -0.8e1_dp*t470*t101*t614*t103+ & + Fxnorm_drhonorm_drho = -0.8e1_dp*t470*t101*t614*t103 + & 0.2e1_dp*t204*t614 IF (grad_deriv >= 2 .OR. grad_deriv == -2) THEN - e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii)+ & - scale_ex*t108*Fxnorm_drhonorm_drho+ & + e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii) + & + scale_ex*t108*Fxnorm_drhonorm_drho + & scale_ec*my_rho*Hnorm_drhonorm_drho END IF IF (grad_deriv >= 3 .OR. grad_deriv == -3) THEN rsrhorhorho = -0.5e1_dp/0.54e2_dp*t4/t111/t238/ & - t115*t627/t240/t114+t4*t239/t240/my_rho/0.3e1_dp & - -t4*t113*t241/0.2e1_dp + t115*t627/t240/t114 + t4*t239/t240/my_rho/0.3e1_dp & + - t4*t113*t241/0.2e1_dp rs2rho = rsrho t645 = alpha_1_1*rsrhorho - t654 = t127*rs2rho/0.2e1_dp+beta_2_1*rs2rho+0.3e1_dp/ & - 0.2e1_dp*t131*rs2rho+t21*t19*rs2rho*t135 + t654 = t127*rs2rho/0.2e1_dp + beta_2_1*rs2rho + 0.3e1_dp/ & + 0.2e1_dp*t131*rs2rho + t21*t19*rs2rho*t135 t656 = t124*t654*t139 t661 = t140*t654 t664 = rsrho*rs2rho @@ -896,8 +896,8 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & t670 = rs2rho*t281 t671 = t670*rsrho t673 = t21*t19 - t675 = -t266*t664/0.4e1_dp+t271+t272+0.3e1_dp/0.4e1_dp & - *t273*t664+t277+t669*t671+t286-t673*t671 + t675 = -t266*t664/0.4e1_dp + t271 + t272 + 0.3e1_dp/0.4e1_dp & + *t273*t664 + t277 + t669*t671 + t286 - t673*t671 t685 = alpha_1_1*rs2rho t693 = t675*t139 t701 = t297*t13 @@ -908,70 +908,70 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & t740 = rs2rho/t280/rs*t267 t743 = rsrhorho*t281*rsrho t748 = t670*rsrhorho - t758 = 0.3e1_dp/0.8e1_dp*beta_1_1/t14/t280*t714-t266* & - t717/0.2e1_dp-t266*t720/0.4e1_dp+t127*rsrhorhorho/ & - 0.2e1_dp+beta_2_1*rsrhorhorho-0.3e1_dp/0.8e1_dp*beta_3_1* & - t265*t714+0.3e1_dp/0.2e1_dp*t273*t717+0.3e1_dp/ & - 0.4e1_dp*t273*t720+0.3e1_dp/0.2e1_dp*t131*rsrhorhorho+ & - t21*t278*t19*t740+0.2e1_dp*t669*t743-0.3e1_dp*t669* & - t740+t669*t748+t21*t19*rsrhorhorho*t135-t673*t748- & - 0.2e1_dp*t673*t743+0.2e1_dp*t673*t740 + t758 = 0.3e1_dp/0.8e1_dp*beta_1_1/t14/t280*t714 - t266* & + t717/0.2e1_dp - t266*t720/0.4e1_dp + t127*rsrhorhorho/ & + 0.2e1_dp + beta_2_1*rsrhorhorho - 0.3e1_dp/0.8e1_dp*beta_3_1* & + t265*t714 + 0.3e1_dp/0.2e1_dp*t273*t717 + 0.3e1_dp/ & + 0.4e1_dp*t273*t720 + 0.3e1_dp/0.2e1_dp*t131*rsrhorhorho + & + t21*t278*t19*t740 + 0.2e1_dp*t669*t743 - 0.3e1_dp*t669* & + t740 + t669*t748 + t21*t19*rsrhorhorho*t135 - t673*t748 - & + 0.2e1_dp*t673*t743 + 0.2e1_dp*t673*t740 t776 = A_1**2 - e_c_u_0rhorhorho = -0.2e1_dp*t119*rsrhorhorho*t27+t645* & - t656+0.2e1_dp*t645*t255-0.4e1_dp*t253*t259*t661+ & - 0.2e1_dp*t253*t124*t675*t139+t253*t294*t138*t297* & - t13*t654-0.2e1_dp*t685*t259*t261*t139+0.6e1_dp*t295 & - *t262*t654-0.4e1_dp*t260*t693*t138-0.3e1_dp*t11/ & - t293/t22*t261*t702+t685*t124*t290*t139-0.2e1_dp* & - t260*t291*t654+t125*t758*t139+t295*t290*t702/ & - 0.2e1_dp+t685*t294*t299/0.2e1_dp+t295*t675*t701*t138 & - +t11/t293/t123*t261/t296/t26/t776*t654/0.2e1_dp - e_c_u_0rho1rho = -t252+t253*t656+t685*t255-0.2e1_dp* & - t260*t661+t125*t693+t295*t138*t702/0.2e1_dp + e_c_u_0rhorhorho = -0.2e1_dp*t119*rsrhorhorho*t27 + t645* & + t656 + 0.2e1_dp*t645*t255 - 0.4e1_dp*t253*t259*t661 + & + 0.2e1_dp*t253*t124*t675*t139 + t253*t294*t138*t297* & + t13*t654 - 0.2e1_dp*t685*t259*t261*t139 + 0.6e1_dp*t295 & + *t262*t654 - 0.4e1_dp*t260*t693*t138 - 0.3e1_dp*t11/ & + t293/t22*t261*t702 + t685*t124*t290*t139 - 0.2e1_dp* & + t260*t291*t654 + t125*t758*t139 + t295*t290*t702/ & + 0.2e1_dp + t685*t294*t299/0.2e1_dp + t295*t675*t701*t138 & + + t11/t293/t123*t261/t296/t26/t776*t654/0.2e1_dp + e_c_u_0rho1rho = -t252 + t253*t656 + t685*t255 - 0.2e1_dp* & + t260*t661 + t125*t693 + t295*t138*t702/0.2e1_dp e_c_u_01rhorho = e_c_u_0rho1rho - e_c_u_02rho = -0.2e1_dp*t119*rs2rho*t27+t125*t654*t139 + e_c_u_02rho = -0.2e1_dp*t119*rs2rho*t27 + t125*t654*t139 k_frhorhorho = 0.10e2_dp/0.27e2_dp*t1/t142/t114*t69 k_f2rho = kfrho t801 = k_f**2 t809 = t309*k_frhorho t812 = t238*k_f2rho - k_srho1rho = -t309*k_frho*t812/0.2e1_dp+t315 + k_srho1rho = -t309*k_frho*t812/0.2e1_dp + t315 k_s1rhorho = k_srho1rho k_s2rho = t146*k_f2rho*t5 t821 = t148**2 t825 = k_srho*k_s1rho t831 = t6*k_srho1rho - trhorhorho = -0.3e1_dp*my_norm_drho/t821*t6*t825*k_s2rho- & - t318*t321*k_s1rho+t318*t831*k_s1rho+t318*t151* & - k_s1rhorho-t318*t321*k_s2rho-t150*t246*k_srho+t150* & - t115*k_srho1rho/0.2e1_dp+t318*t324*k_s2rho+t150*t115* & - k_srhorho/0.2e1_dp-t150*t6*(0.3e1_dp/0.4e1_dp/t73/ & - t801/t238*t310*t627*k_f2rho-t809*t238*k_frho-t809* & - t812/0.2e1_dp+t146*k_frhorhorho*t5)/0.2e1_dp-t318*t327 & - *k_s2rho-t150*t246*k_s1rho+t150*t115*k_s1rhorho/ & - 0.2e1_dp-t150*t246*k_s2rho-0.3e1_dp*t75*t241 + trhorhorho = -0.3e1_dp*my_norm_drho/t821*t6*t825*k_s2rho - & + t318*t321*k_s1rho + t318*t831*k_s1rho + t318*t151* & + k_s1rhorho - t318*t321*k_s2rho - t150*t246*k_srho + t150* & + t115*k_srho1rho/0.2e1_dp + t318*t324*k_s2rho + t150*t115* & + k_srhorho/0.2e1_dp - t150*t6*(0.3e1_dp/0.4e1_dp/t73/ & + t801/t238*t310*t627*k_f2rho - t809*t238*k_frho - t809* & + t812/0.2e1_dp + t146*k_frhorhorho*t5)/0.2e1_dp - t318*t327 & + *k_s2rho - t150*t246*k_s1rho + t150*t115*k_s1rhorho/ & + 0.2e1_dp - t150*t246*k_s2rho - 0.3e1_dp*t75*t241 t868 = t150*t115*k_s2rho/0.2e1_dp - trho1rho = t318*t151*k_s2rho+t323-t150*t831/0.2e1_dp+ & - t868+t330 - t1rhorho = t318*t331*k_s2rho+t329-t150*t6*k_s1rhorho/ & - 0.2e1_dp+t868+t330 - t2rho = -t150*t6*k_s2rho/0.2e1_dp-t153/0.2e1_dp + trho1rho = t318*t151*k_s2rho + t323 - t150*t831/0.2e1_dp + & + t868 + t330 + t1rhorho = t318*t331*k_s2rho + t329 - t150*t6*k_s1rhorho/ & + 0.2e1_dp + t868 + t330 + t2rho = -t150*t6*k_s2rho/0.2e1_dp - t153/0.2e1_dp t877 = t155**2 t879 = beta/t877 t880 = t158**2 t885 = e_c_u_01rho*e_c_u_02rho Arhorhorho = 0.6e1_dp*t879/t880*e_c_u_0rho*t340*t80* & - t885+0.2e1_dp*t339*e_c_u_0rho1rho*t340*e_c_u_01rho- & - 0.6e1_dp*t879*t338*t341*t885+0.2e1_dp*t339*t341* & - e_c_u_01rhorho+0.2e1_dp*t339*e_c_u_0rhorho*t340* & - e_c_u_02rho+t157*t159*e_c_u_0rhorhorho*t80-t348* & - e_c_u_0rhorho*e_c_u_02rho*t80-t348*e_c_u_0rho1rho* & - e_c_u_01rho*t80-t348*e_c_u_0rho*e_c_u_01rhorho*t80+t879 & + t885 + 0.2e1_dp*t339*e_c_u_0rho1rho*t340*e_c_u_01rho - & + 0.6e1_dp*t879*t338*t341*t885 + 0.2e1_dp*t339*t341* & + e_c_u_01rhorho + 0.2e1_dp*t339*e_c_u_0rhorho*t340* & + e_c_u_02rho + t157*t159*e_c_u_0rhorhorho*t80 - t348* & + e_c_u_0rhorho*e_c_u_02rho*t80 - t348*e_c_u_0rho1rho* & + e_c_u_01rho*t80 - t348*e_c_u_0rho*e_c_u_01rhorho*t80 + t879 & *t159*t349*e_c_u_02rho*t80 - Arho1rho = 0.2e1_dp*t339*t341*e_c_u_02rho+t157*t159* & - e_c_u_0rho1rho*t80-t348*e_c_u_0rho*e_c_u_02rho*t80 - A1rhorho = 0.2e1_dp*t339*e_c_u_01rho*t340*e_c_u_02rho+ & - t157*t159*e_c_u_01rhorho*t80-t348*t885*t80 + Arho1rho = 0.2e1_dp*t339*t341*e_c_u_02rho + t157*t159* & + e_c_u_0rho1rho*t80 - t348*e_c_u_0rho*e_c_u_02rho*t80 + A1rhorho = 0.2e1_dp*t339*e_c_u_01rho*t340*e_c_u_02rho + & + t157*t159*e_c_u_01rhorho*t80 - t348*t885*t80 A2rho = t157*t159*e_c_u_02rho*t80 t940 = Arho1rho*t83 t942 = 0.2e1_dp*t382*t2rho @@ -982,17 +982,17 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & t950 = 0.2e1_dp*t168*trho1rho t951 = A2rho*t88 t954 = Arho*t2rho - t967 = t940+t942+t945+t948+t950+0.2e1_dp*t951*Arho+ & - 0.8e1_dp*t417*t954+0.2e1_dp*t179*Arho1rho+0.8e1_dp* & - t417*trho*A2rho+0.12e2_dp*t426*trho*t2rho+0.4e1_dp* & + t967 = t940 + t942 + t945 + t948 + t950 + 0.2e1_dp*t951*Arho + & + 0.8e1_dp*t417*t954 + 0.2e1_dp*t179*Arho1rho + 0.8e1_dp* & + t417*trho*A2rho + 0.12e2_dp*t426*trho*t2rho + 0.4e1_dp* & t183*trho1rho t976 = t78*t2rho t980 = t78*t*t85 t982 = A2rho*t83 t984 = 0.2e1_dp*t168*t2rho - t989 = t982+t984+0.2e1_dp*t179*A2rho+0.4e1_dp*t183*t2rho + t989 = t982 + t984 + 0.2e1_dp*t179*A2rho + 0.4e1_dp*t183*t2rho t990 = t369*t989 - t994 = t982+t984 + t994 = t982 + t984 t995 = t994*t177 t998 = Arhorhorho*t83 t999 = Arhorho*t @@ -1014,143 +1014,143 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & t1026 = 0.2e1_dp*t943*trhorho t1028 = 0.2e1_dp*t946*trhorho t1030 = 0.2e1_dp*t168*trhorhorho - t1031 = t998+t1001+t1004+t1006+t1008+t1011+t1014+ & - t1016+t1019+t1022+t1024+t1026+t1028+t1030 - t1035 = t940+t942+t945+t948+t950 + t1031 = t998 + t1001 + t1004 + t1006 + t1008 + t1011 + t1014 + & + t1016 + t1019 + t1022 + t1024 + t1026 + t1028 + t1030 + t1035 = t940 + t942 + t945 + t948 + t950 t1042 = t369*t2rho t1046 = A1rhorho*t83 t1048 = 0.2e1_dp*t385*t2rho t1050 = 0.2e1_dp*t943*t1rho t1052 = 0.2e1_dp*t946*t1rho t1054 = 0.2e1_dp*t168*t1rhorho - t1055 = t1046+t1048+t1050+t1052+t1054 + t1055 = t1046 + t1048 + t1050 + t1052 + t1054 t1060 = t78*t86 t1061 = t176**2 t1062 = 0.1e1_dp/t1061 - t1067 = -0.2e1_dp*t162*t178*t967*t1rho+0.2e1_dp*t175* & - t409*t967*t369+0.2e1_dp*t976*t374+0.4e1_dp*t980* & - t408*trho*t990-t175*t995*t432+t78*t83*t1031*t91- & - t175*t1035*t177*t369-0.2e1_dp*t162*t995*t370- & - 0.2e1_dp*t162*t397*t1042+0.2e1_dp*t162*t1055*t91* & - trho-0.6e1_dp*t1060*t1062*t186*t990 - t1093 = t1046+t1048+t1050+t1052+t1054+0.2e1_dp*t951* & - A1rho+0.8e1_dp*t417*t1012+0.2e1_dp*t179*A1rhorho+ & - 0.8e1_dp*t417*t1017+0.12e2_dp*t426*t1rho*t2rho+ & + t1067 = -0.2e1_dp*t162*t178*t967*t1rho + 0.2e1_dp*t175* & + t409*t967*t369 + 0.2e1_dp*t976*t374 + 0.4e1_dp*t980* & + t408*trho*t990 - t175*t995*t432 + t78*t83*t1031*t91 - & + t175*t1035*t177*t369 - 0.2e1_dp*t162*t995*t370 - & + 0.2e1_dp*t162*t397*t1042 + 0.2e1_dp*t162*t1055*t91* & + trho - 0.6e1_dp*t1060*t1062*t186*t990 + t1093 = t1046 + t1048 + t1050 + t1052 + t1054 + 0.2e1_dp*t951* & + A1rho + 0.8e1_dp*t417*t1012 + 0.2e1_dp*t179*A1rhorho + & + 0.8e1_dp*t417*t1017 + 0.12e2_dp*t426*t1rho*t2rho + & 0.4e1_dp*t183*t1rhorho t1097 = t1rho*t989 t1103 = trho*t989 t1104 = t178*t1103 t1106 = t994*t91 t1109 = t171*t408 - t1115 = t976*t362+t162*t361*trho1rho-t162*t178*t432 & - *t2rho+t175*t994*t408*t410-t162*t178*trho1rho*t369 & - -t162*t178*trho*t1093-t162*t397*t1097+t175*t409* & - t186*t1093-t354*t1104+t162*t1106*trhorho+t175*t1109 & - *t990+t175*t409*t432*t989 + t1115 = t976*t362 + t162*t361*trho1rho - t162*t178*t432 & + *t2rho + t175*t994*t408*t410 - t162*t178*trho1rho*t369 & + - t162*t178*trho*t1093 - t162*t397*t1097 + t175*t409* & + t186*t1093 - t354*t1104 + t162*t1106*trhorho + t175*t1109 & + *t990 + t175*t409*t432*t989 t1118 = t1106*trho t1121 = t360*t408 t1122 = t186*t989 t1126 = t393*t177 t1129 = t408*t186 t1148 = t186*t2rho - t1152 = 0.2e1_dp*t354*t1118+0.2e1_dp*t175*t1121*t1122 & - -t175*t1126*t989+0.4e1_dp*t980*t1129*t1042+0.2e1_dp* & - t976*t378-t175*t404*t967+0.2e1_dp*t162*t377* & - t1rhorho-0.2e1_dp*t976*t401+0.2e1_dp*t78*t1rhorho*t164 & - -0.2e1_dp*t162*t404*t1103-0.2e1_dp*t162*t404*t1148 + t1152 = 0.2e1_dp*t354*t1118 + 0.2e1_dp*t175*t1121*t1122 & + - t175*t1126*t989 + 0.4e1_dp*t980*t1129*t1042 + 0.2e1_dp* & + t976*t378 - t175*t404*t967 + 0.2e1_dp*t162*t377* & + t1rhorho - 0.2e1_dp*t976*t401 + 0.2e1_dp*t78*t1rhorho*t164 & + - 0.2e1_dp*t162*t404*t1103 - 0.2e1_dp*t162*t404*t1148 t1157 = t393*t91 t1167 = A2rho*t182 t1187 = A1rho*t182 t1196 = t87*t - t1203 = t1008+0.8e1_dp*t417*trhorho*A2rho+0.12e2_dp* & - t426*trhorho*t2rho+0.8e1_dp*t1167*t423+0.8e1_dp*t417* & - trho*A1rhorho+0.8e1_dp*t417*Arho*t1rhorho+0.8e1_dp* & - t1167*t418+0.8e1_dp*t417*Arho1rho*t1rho+0.12e2_dp*t426 & - *trho1rho*t1rho+0.12e2_dp*t426*trho*t1rhorho+t998+ & - 0.8e1_dp*t1187*t954+0.8e1_dp*t417*trho1rho*A1rho+ & - 0.8e1_dp*t417*Arhorho*t2rho+0.24e2_dp*t1196*t427*t2rho & - +0.2e1_dp*A1rhorho*t88*Arho+t1014 - t1218 = t1016+t1001+0.2e1_dp*t951*Arhorho+t1026+t1028 & - +t1022+t1011+t1030+0.2e1_dp*t179*Arhorhorho+0.4e1_dp* & - t183*trhorhorho+0.2e1_dp*t414*Arho1rho+t1004+t1006+ & - t1019+t1024+0.24e2_dp*t84*t1018+0.24e2_dp*t84*t1005+ & + t1203 = t1008 + 0.8e1_dp*t417*trhorho*A2rho + 0.12e2_dp* & + t426*trhorho*t2rho + 0.8e1_dp*t1167*t423 + 0.8e1_dp*t417* & + trho*A1rhorho + 0.8e1_dp*t417*Arho*t1rhorho + 0.8e1_dp* & + t1167*t418 + 0.8e1_dp*t417*Arho1rho*t1rho + 0.12e2_dp*t426 & + *trho1rho*t1rho + 0.12e2_dp*t426*trho*t1rhorho + t998 + & + 0.8e1_dp*t1187*t954 + 0.8e1_dp*t417*trho1rho*A1rho + & + 0.8e1_dp*t417*Arhorho*t2rho + 0.24e2_dp*t1196*t427*t2rho & + + 0.2e1_dp*A1rhorho*t88*Arho + t1014 + t1218 = t1016 + t1001 + 0.2e1_dp*t951*Arhorho + t1026 + t1028 & + + t1022 + t1011 + t1030 + 0.2e1_dp*t179*Arhorhorho + 0.4e1_dp* & + t183*trhorhorho + 0.2e1_dp*t414*Arho1rho + t1004 + t1006 + & + t1019 + t1024 + 0.24e2_dp*t84*t1018 + 0.24e2_dp*t84*t1005 + & 0.24e2_dp*t84*t1013 t1226 = t163*trho1rho - t1249 = -0.2e1_dp*t162*t178*t186*t1rhorho+0.2e1_dp* & - t162*t1157*t2rho-t175*t178*(t1203+t1218)+0.2e1_dp* & - t162*t1035*t91*t1rho+0.2e1_dp*t354*t1226-0.2e1_dp* & - t162*t995*t400+0.2e1_dp*t162*t163*trhorhorho-0.2e1_dp & - *t162*t178*trhorho*t989-t175*t1055*t177*t186- & - 0.2e1_dp*t976*t371-t175*t397*t1093+0.4e1_dp*t980* & + t1249 = -0.2e1_dp*t162*t178*t186*t1rhorho + 0.2e1_dp* & + t162*t1157*t2rho - t175*t178*(t1203 + t1218) + 0.2e1_dp* & + t162*t1035*t91*t1rho + 0.2e1_dp*t354*t1226 - 0.2e1_dp* & + t162*t995*t400 + 0.2e1_dp*t162*t163*trhorhorho - 0.2e1_dp & + *t162*t178*trhorho*t989 - t175*t1055*t177*t186 - & + 0.2e1_dp*t976*t371 - t175*t397*t1093 + 0.4e1_dp*t980* & t1129*t1097 - t1262 = 0.2e1_dp*t162*t163*t2rho+t78*t83*t994*t91- & + t1262 = 0.2e1_dp*t162*t163*t2rho + t78*t83*t994*t91 - & t175*t178*t989 t1263 = t439*t1262 - t1291 = 0.2e1_dp*t976*t164+0.2e1_dp*t162*t1118- & - 0.2e1_dp*t162*t1104+0.2e1_dp*t162*t1226+0.2e1_dp*t162 & - *t377*t2rho+t78*t83*t1035*t91-t175*t397*t989- & - 0.2e1_dp*t162*t178*t1148-t175*t995*t186+0.2e1_dp* & - t175*t409*t1122-t175*t178*t967 + t1291 = 0.2e1_dp*t976*t164 + 0.2e1_dp*t162*t1118 - & + 0.2e1_dp*t162*t1104 + 0.2e1_dp*t162*t1226 + 0.2e1_dp*t162 & + *t377*t2rho + t78*t83*t1035*t91 - t175*t397*t989 - & + 0.2e1_dp*t162*t178*t1148 - t175*t995*t186 + 0.2e1_dp* & + t175*t409*t1122 - t175*t178*t967 t1292 = gamma_var*t1291 t1295 = 0.1e1_dp/t438/t94 - t1329 = 0.2e1_dp*t976*t440+0.2e1_dp*t162*t1106*t1rho- & - 0.2e1_dp*t162*t178*t1097+0.2e1_dp*t162*t163*t1rhorho & - +0.2e1_dp*t162*t361*t2rho+t78*t83*t1055*t91-t175* & - t404*t989-0.2e1_dp*t162*t178*t1042-t175*t995*t369+ & - 0.2e1_dp*t175*t409*t990-t175*t178*t1093 + t1329 = 0.2e1_dp*t976*t440 + 0.2e1_dp*t162*t1106*t1rho - & + 0.2e1_dp*t162*t178*t1097 + 0.2e1_dp*t162*t163*t1rhorho & + + 0.2e1_dp*t162*t361*t2rho + t78*t83*t1055*t91 - t175* & + t404*t989 - 0.2e1_dp*t162*t178*t1042 - t175*t995*t369 + & + 0.2e1_dp*t175*t409*t990 - t175*t178*t1093 kfrhorhorho = k_frhorhorho kf2rho = k_f2rho ex_unifrho1rho = ex_unifrhorho ex_unif1rhorho = ex_unifrho1rho ex_unif2rho = -0.3e1_dp/0.4e1_dp*t5*kf2rho t1342 = t195**2 - srho1rho = t457*t198*kf2rho+t462/0.2e1_dp-t465+t197* & - t115*kf2rho/0.2e1_dp+t466 + srho1rho = t457*t198*kf2rho + t462/0.2e1_dp - t465 + t197* & + t115*kf2rho/0.2e1_dp + t466 s1rhorho = srho1rho - s2rho = -t197*t6*kf2rho/0.2e1_dp-t200/0.2e1_dp + s2rho = -t197*t6*kf2rho/0.2e1_dp - t200/0.2e1_dp t1380 = t202**2 t1385 = 0.1e1_dp/t1380*t469*mu*t101*s t1386 = kappa**2 t1387 = 0.1e1_dp/t1386 t1389 = s1rho*s2rho t1393 = t470*s - Fxrho1rho = -0.8e1_dp*t471*t472*s2rho+0.2e1_dp*t204* & - s2rho*srho+0.2e1_dp*t204*s*srho1rho - Fx1rhorho = -0.8e1_dp*t471*s1rho*t103*s2rho+0.2e1_dp* & - t204*t1389+0.2e1_dp*t204*s*s1rhorho + Fxrho1rho = -0.8e1_dp*t471*t472*s2rho + 0.2e1_dp*t204* & + s2rho*srho + 0.2e1_dp*t204*s*srho1rho + Fx1rhorho = -0.8e1_dp*t471*s1rho*t103*s2rho + 0.2e1_dp* & + t204*t1389 + 0.2e1_dp*t204*s*s1rhorho Fx2rho = 0.2e1_dp*t204*s*s2rho - ex_ldarhorhorho = ex_unif1rhorho*Fx+ex_unif1rho*Fx2rho+ & - ex_unif2rho*Fx1rho+ex_unif*Fx1rhorho+ex_unifrho1rho*Fx+ & - ex_unifrho*Fx2rho+ex_unifrhorho*Fx-0.3e1_dp/0.4e1_dp*my_rho & - *t5*kfrhorhorho*Fx+t487*Fx2rho+ex_unifrho*Fx1rho+my_rho & - *ex_unifrho1rho*Fx1rho+t208*Fx1rhorho+ex_unif2rho*Fxrho & - +ex_unif*Fxrho1rho+ex_unif1rho*Fxrho+my_rho*ex_unif1rhorho* & - Fxrho+t491*Fxrho1rho+ex_unif*Fxrhorho+my_rho*ex_unif2rho* & - Fxrhorho+t108*(0.48e2_dp*t1385*srho*t1387*t1389- & - 0.24e2_dp*t1393*t472*t1389-0.8e1_dp*t471*srho1rho*t103 & - *s1rho-0.8e1_dp*t471*t472*s1rhorho+0.2e1_dp*t204* & - s1rhorho*srho+0.2e1_dp*t204*s1rho*srho1rho-0.8e1_dp* & - t471*srhorho*t103*s2rho+0.2e1_dp*t204*s2rho*srhorho+ & - 0.2e1_dp*t204*s*(-0.3e1_dp*my_norm_drho/t1342*t459*kf2rho & - -t457*t115*t458+0.2e1_dp*t457*t463*kfrho-0.2e1_dp* & - t457*t461*kf2rho-0.2e1_dp*t197*t246*kfrho+0.3e1_dp/ & - 0.2e1_dp*t197*t115*kfrhorho+t457*t463*kf2rho-t197*t6 & - *kfrhorhorho/0.2e1_dp-t197*t246*kf2rho-0.3e1_dp*t99* & - t241)) - - e_rho_rho_rho(ii) = e_rho_rho_rho(ii)+ & - scale_ex*ex_ldarhorhorho+scale_ec*( & - e_c_u_01rhorho+gamma_var*t1329*t191-t451*t1263+ & - e_c_u_0rho1rho+t1292*t191-t190*t1263+epsilon_cGGArhorho+ & - my_rho*(e_c_u_0rhorhorho+gamma_var*(t1067+0.2e1_dp*t1115+ & - t1152+t1249)*t191-t436*t1263-t1292*t449+0.2e1_dp* & - t190*t1295*t448*t1262-t190*t439*t1329)) + ex_ldarhorhorho = ex_unif1rhorho*Fx + ex_unif1rho*Fx2rho + & + ex_unif2rho*Fx1rho + ex_unif*Fx1rhorho + ex_unifrho1rho*Fx + & + ex_unifrho*Fx2rho + ex_unifrhorho*Fx - 0.3e1_dp/0.4e1_dp*my_rho & + *t5*kfrhorhorho*Fx + t487*Fx2rho + ex_unifrho*Fx1rho + my_rho & + *ex_unifrho1rho*Fx1rho + t208*Fx1rhorho + ex_unif2rho*Fxrho & + + ex_unif*Fxrho1rho + ex_unif1rho*Fxrho + my_rho*ex_unif1rhorho* & + Fxrho + t491*Fxrho1rho + ex_unif*Fxrhorho + my_rho*ex_unif2rho* & + Fxrhorho + t108*(0.48e2_dp*t1385*srho*t1387*t1389 - & + 0.24e2_dp*t1393*t472*t1389 - 0.8e1_dp*t471*srho1rho*t103 & + *s1rho - 0.8e1_dp*t471*t472*s1rhorho + 0.2e1_dp*t204* & + s1rhorho*srho + 0.2e1_dp*t204*s1rho*srho1rho - 0.8e1_dp* & + t471*srhorho*t103*s2rho + 0.2e1_dp*t204*s2rho*srhorho + & + 0.2e1_dp*t204*s*(-0.3e1_dp*my_norm_drho/t1342*t459*kf2rho & + - t457*t115*t458 + 0.2e1_dp*t457*t463*kfrho - 0.2e1_dp* & + t457*t461*kf2rho - 0.2e1_dp*t197*t246*kfrho + 0.3e1_dp/ & + 0.2e1_dp*t197*t115*kfrhorho + t457*t463*kf2rho - t197*t6 & + *kfrhorhorho/0.2e1_dp - t197*t246*kf2rho - 0.3e1_dp*t99* & + t241)) + + e_rho_rho_rho(ii) = e_rho_rho_rho(ii) + & + scale_ex*ex_ldarhorhorho + scale_ec*( & + e_c_u_01rhorho + gamma_var*t1329*t191 - t451*t1263 + & + e_c_u_0rho1rho + t1292*t191 - t190*t1263 + epsilon_cGGArhorho + & + my_rho*(e_c_u_0rhorhorho + gamma_var*(t1067 + 0.2e1_dp*t1115 + & + t1152 + t1249)*t191 - t436*t1263 - t1292*t449 + 0.2e1_dp* & + t190*t1295*t448*t1262 - t190*t439*t1329)) t1468 = t149*t115 - tnorm_drhorhorho = t317*t6*t825+t1468*k_srho/0.2e1_dp- & - t496*k_srhorho/0.2e1_dp+t1468*k_s1rho/0.2e1_dp+t74* & + tnorm_drhorhorho = t317*t6*t825 + t1468*k_srho/0.2e1_dp - & + t496*k_srhorho/0.2e1_dp + t1468*k_s1rho/0.2e1_dp + t74* & t246 - tnorm_drho1rho = -t496*k_s1rho/0.2e1_dp-t498/0.2e1_dp + tnorm_drho1rho = -t496*k_s1rho/0.2e1_dp - t498/0.2e1_dp t1482 = A1rho*tnorm_drhorho t1492 = t78*t84 t1493 = tnorm_drho*t177 @@ -1159,38 +1159,38 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & t1511 = A1rho*tnorm_drho t1515 = t226*t1rho t1521 = A*tnorm_drho1rho - t1525 = 0.2e1_dp*t175*t409*t553*t369+0.2e1_dp*t217* & - t1482*t91-0.2e1_dp*t162*t178*tnorm_drhorho*t369+ & - 0.2e1_dp*t354*t510-0.6e1_dp*t1492*t1493*t400+0.6e1_dp & - *t175*t218*t91*trhorho+0.2e1_dp*t162*t1157*tnorm_drho & - +0.4e1_dp*t980*t1505-0.6e1_dp*t1492*t1493*t370+ & - 0.6e1_dp*t175*t1511*t513-0.2e1_dp*t162*t397*t1515- & - 0.2e1_dp*t354*t507+0.6e1_dp*t175*t1521*t513 + t1525 = 0.2e1_dp*t175*t409*t553*t369 + 0.2e1_dp*t217* & + t1482*t91 - 0.2e1_dp*t162*t178*tnorm_drhorho*t369 + & + 0.2e1_dp*t354*t510 - 0.6e1_dp*t1492*t1493*t400 + 0.6e1_dp & + *t175*t218*t91*trhorho + 0.2e1_dp*t162*t1157*tnorm_drho & + + 0.4e1_dp*t980*t1505 - 0.6e1_dp*t1492*t1493*t370 + & + 0.6e1_dp*t175*t1511*t513 - 0.2e1_dp*t162*t397*t1515 - & + 0.2e1_dp*t354*t507 + 0.6e1_dp*t175*t1521*t513 t1528 = Arhorho*tnorm_drho t1532 = t177*t369 t1545 = t78*t417 - t1565 = 0.2e1_dp*t385*tnorm_drho+0.2e1_dp*t388* & - tnorm_drho+0.2e1_dp*t168*tnorm_drho1rho+0.8e1_dp*t417* & - t1511+0.12e2_dp*t426*tnorm_drho*t1rho+0.4e1_dp*t183* & + t1565 = 0.2e1_dp*t385*tnorm_drho + 0.2e1_dp*t388* & + tnorm_drho + 0.2e1_dp*t168*tnorm_drho1rho + 0.8e1_dp*t417* & + t1511 + 0.12e2_dp*t426*tnorm_drho*t1rho + 0.4e1_dp*t183* & tnorm_drho1rho t1573 = t91*t1rho - t1584 = -0.2e1_dp*t354*t530+0.2e1_dp*t217*t1528*t91- & - 0.2e1_dp*t217*t517*t1532-0.2e1_dp*t217*t1511*t525+ & - 0.2e1_dp*t162*t377*tnorm_drho1rho+0.2e1_dp*t162*t361* & - tnorm_drhorho+0.4e1_dp*t1545*t1505+0.2e1_dp*t217*A* & - tnorm_drhorhorho*t91+0.2e1_dp*t175*t409*t1565*t186- & - 0.2e1_dp*t217*t521*t1532+0.6e1_dp*t175*t521*t1573- & - 0.6e1_dp*t1060*t1062*t226*t410+0.6e1_dp*t175*t517* & + t1584 = -0.2e1_dp*t354*t530 + 0.2e1_dp*t217*t1528*t91 - & + 0.2e1_dp*t217*t517*t1532 - 0.2e1_dp*t217*t1511*t525 + & + 0.2e1_dp*t162*t377*tnorm_drho1rho + 0.2e1_dp*t162*t361* & + tnorm_drhorho + 0.4e1_dp*t1545*t1505 + 0.2e1_dp*t217*A* & + tnorm_drhorhorho*t91 + 0.2e1_dp*t175*t409*t1565*t186 - & + 0.2e1_dp*t217*t521*t1532 + 0.6e1_dp*t175*t521*t1573 - & + 0.6e1_dp*t1060*t1062*t226*t410 + 0.6e1_dp*t175*t517* & t1573 t1608 = t408*t226 t1612 = t163*tnorm_drho1rho - t1628 = -0.2e1_dp*t162*t404*t506+0.2e1_dp*t354*t503- & - 0.2e1_dp*t162*t178*tnorm_drho*t432-0.2e1_dp*t162*t178 & - *t553*t1rho-0.2e1_dp*t162*t404*t529-0.2e1_dp*t162* & - t178*t1565*trho-t175*t1126*t226+0.4e1_dp*t980*t1608 & - *t370+0.2e1_dp*t500*t1612+0.12e2_dp*t78*t168* & - tnorm_drho*t91*t427+0.2e1_dp*t162*t163*tnorm_drhorhorho & - -t175*t404*t553+0.2e1_dp*t175*t1121*t535 + t1628 = -0.2e1_dp*t162*t404*t506 + 0.2e1_dp*t354*t503 - & + 0.2e1_dp*t162*t178*tnorm_drho*t432 - 0.2e1_dp*t162*t178 & + *t553*t1rho - 0.2e1_dp*t162*t404*t529 - 0.2e1_dp*t162* & + t178*t1565*trho - t175*t1126*t226 + 0.4e1_dp*t980*t1608 & + *t370 + 0.2e1_dp*t500*t1612 + 0.12e2_dp*t78*t168* & + tnorm_drho*t91*t427 + 0.2e1_dp*t162*t163*tnorm_drhorhorho & + - t175*t404*t553 + 0.2e1_dp*t175*t1121*t535 t1629 = Arho*tnorm_drho1rho t1633 = tnorm_drho*t369 t1646 = t361*tnorm_drho @@ -1198,122 +1198,122 @@ SUBROUTINE pbe_lda_calc(rho, norm_drho, & t1660 = t178*t1633 t1672 = t418*tnorm_drho t1676 = t423*tnorm_drho - t1715 = 0.2e1_dp*t999*tnorm_drho+0.2e1_dp*t1672+0.2e1_dp & - *t382*tnorm_drho1rho+0.2e1_dp*t1676+0.2e1_dp*A*trhorho & - *tnorm_drho+0.2e1_dp*t541*tnorm_drho1rho+0.2e1_dp*t385* & - tnorm_drhorho+0.2e1_dp*t388*tnorm_drhorho+0.2e1_dp*t168* & - tnorm_drhorhorho+0.8e1_dp*t1187*t517+0.24e2_dp*t84* & - t1672+0.8e1_dp*t417*t1629+0.8e1_dp*t417*t1528+ & - 0.24e2_dp*t84*t1676+0.24e2_dp*t1196*t548*t1rho+ & - 0.12e2_dp*t426*tnorm_drho1rho*trho+0.12e2_dp*t426* & - tnorm_drho*trhorho+0.8e1_dp*t417*t1482+0.12e2_dp*t426* & - tnorm_drhorho*t1rho+0.4e1_dp*t183*tnorm_drhorhorho - t1722 = 0.2e1_dp*t217*t1629*t91-0.2e1_dp*t162*t397* & - t1633-t175*t397*t1565-0.2e1_dp*t162*t178*t226* & - trhorho+0.2e1_dp*t78*trhorho*t214+0.2e1_dp*t500*t1646 & - -0.2e1_dp*t217*t1521*t525+0.2e1_dp*t175*t1109*t1652- & - 0.2e1_dp*t162*t178*tnorm_drho1rho*t186-0.2e1_dp*t500* & - t1660+0.4e1_dp*t980*t1608*t400+0.2e1_dp*t175*t409* & - t226*t432-t175*t178*t1715-0.2e1_dp*t217*t218*t177* & + t1715 = 0.2e1_dp*t999*tnorm_drho + 0.2e1_dp*t1672 + 0.2e1_dp & + *t382*tnorm_drho1rho + 0.2e1_dp*t1676 + 0.2e1_dp*A*trhorho & + *tnorm_drho + 0.2e1_dp*t541*tnorm_drho1rho + 0.2e1_dp*t385* & + tnorm_drhorho + 0.2e1_dp*t388*tnorm_drhorho + 0.2e1_dp*t168* & + tnorm_drhorhorho + 0.8e1_dp*t1187*t517 + 0.24e2_dp*t84* & + t1672 + 0.8e1_dp*t417*t1629 + 0.8e1_dp*t417*t1528 + & + 0.24e2_dp*t84*t1676 + 0.24e2_dp*t1196*t548*t1rho + & + 0.12e2_dp*t426*tnorm_drho1rho*trho + 0.12e2_dp*t426* & + tnorm_drho*trhorho + 0.8e1_dp*t417*t1482 + 0.12e2_dp*t426* & + tnorm_drhorho*t1rho + 0.4e1_dp*t183*tnorm_drhorhorho + t1722 = 0.2e1_dp*t217*t1629*t91 - 0.2e1_dp*t162*t397* & + t1633 - t175*t397*t1565 - 0.2e1_dp*t162*t178*t226* & + trhorho + 0.2e1_dp*t78*trhorho*t214 + 0.2e1_dp*t500*t1646 & + - 0.2e1_dp*t217*t1521*t525 + 0.2e1_dp*t175*t1109*t1652 - & + 0.2e1_dp*t162*t178*tnorm_drho1rho*t186 - 0.2e1_dp*t500* & + t1660 + 0.4e1_dp*t980*t1608*t400 + 0.2e1_dp*t175*t409* & + t226*t432 - t175*t178*t1715 - 0.2e1_dp*t217*t218*t177* & t432 - t1758 = 0.2e1_dp*t354*t214+0.2e1_dp*t162*t1646- & - 0.2e1_dp*t162*t1660+0.2e1_dp*t162*t1612+0.6e1_dp*t175 & - *t218*t1573+0.2e1_dp*t217*t1511*t91+0.2e1_dp*t217* & - t1521*t91-0.2e1_dp*t217*t218*t1532-0.2e1_dp*t162* & - t178*t1515-t175*t404*t226+0.2e1_dp*t175*t409*t1652- & + t1758 = 0.2e1_dp*t354*t214 + 0.2e1_dp*t162*t1646 - & + 0.2e1_dp*t162*t1660 + 0.2e1_dp*t162*t1612 + 0.6e1_dp*t175 & + *t218*t1573 + 0.2e1_dp*t217*t1511*t91 + 0.2e1_dp*t217* & + t1521*t91 - 0.2e1_dp*t217*t218*t1532 - 0.2e1_dp*t162* & + t178*t1515 - t175*t404*t226 + 0.2e1_dp*t175*t409*t1652 - & t175*t178*t1565 t1759 = gamma_var*t1758 t1761 = t1295*t189 snorm_drho1rho = snorm_drhorho t1797 = snorm_drhorho*t103 - Fxnorm_drho1rho = -0.8e1_dp*t471*t566*s1rho+0.2e1_dp* & - t204*s1rho*snorm_drho+0.2e1_dp*t204*s*snorm_drho1rho - - e_ndrho_rho_rho(ii) = e_ndrho_rho_rho(ii)+ & - scale_ex*(ex_unif1rho*Fxnorm_drho+ & - ex_unif*Fxnorm_drho1rho+ex_unifrho*Fxnorm_drho+t487* & - Fxnorm_drho+t208*Fxnorm_drho1rho+ex_unif*Fxnorm_drhorho+ & - t491*Fxnorm_drhorho+t108*(0.48e2_dp*t1385*snorm_drho* & - t1387*t476-0.24e2_dp*t1393*t566*t476-0.8e1_dp*t471* & - snorm_drho1rho*t103*srho-0.8e1_dp*t471*t566*srhorho+ & - 0.2e1_dp*t204*srhorho*snorm_drho+0.2e1_dp*t204*srho* & - snorm_drho1rho-0.8e1_dp*t471*t1797*s1rho+0.2e1_dp*t204* & - s1rho*snorm_drhorho+0.2e1_dp*t204*s*(t456*t6*t458+ & - t196*t115*kfrho-t562*kfrhorho/0.2e1_dp+t98*t246)))+ & - scale_ec*(t1759*t191-t230*t449+Hnorm_drhorho+my_rho*( & - gamma_var*(t1525+t1584+t1628+t1722)*t191-t557*t449- & - t1759*t559+0.2e1_dp*t230*t1761*t448-t230*t439*t435)) + Fxnorm_drho1rho = -0.8e1_dp*t471*t566*s1rho + 0.2e1_dp* & + t204*s1rho*snorm_drho + 0.2e1_dp*t204*s*snorm_drho1rho + + e_ndrho_rho_rho(ii) = e_ndrho_rho_rho(ii) + & + scale_ex*(ex_unif1rho*Fxnorm_drho + & + ex_unif*Fxnorm_drho1rho + ex_unifrho*Fxnorm_drho + t487* & + Fxnorm_drho + t208*Fxnorm_drho1rho + ex_unif*Fxnorm_drhorho + & + t491*Fxnorm_drhorho + t108*(0.48e2_dp*t1385*snorm_drho* & + t1387*t476 - 0.24e2_dp*t1393*t566*t476 - 0.8e1_dp*t471* & + snorm_drho1rho*t103*srho - 0.8e1_dp*t471*t566*srhorho + & + 0.2e1_dp*t204*srhorho*snorm_drho + 0.2e1_dp*t204*srho* & + snorm_drho1rho - 0.8e1_dp*t471*t1797*s1rho + 0.2e1_dp*t204* & + s1rho*snorm_drhorho + 0.2e1_dp*t204*s*(t456*t6*t458 + & + t196*t115*kfrho - t562*kfrhorho/0.2e1_dp + t98*t246))) + & + scale_ec*(t1759*t191 - t230*t449 + Hnorm_drhorho + my_rho*( & + gamma_var*(t1525 + t1584 + t1628 + t1722)*t191 - t557*t449 - & + t1759*t559 + 0.2e1_dp*t230*t1761*t448 - t230*t439*t435)) t1838 = t1504*t535 t1851 = Arho*t581 - t1878 = 0.4e1_dp*t175*t409*t226*t553-0.2e1_dp*t162* & - t178*t605*trho-0.4e1_dp*t217*t218*t177*t553+0.8e1_dp & - *t1545*t1838+0.2e1_dp*t78*t581*t171*t91-0.4e1_dp* & - t162*t397*t590-0.10e2_dp*t175*t586*t525-t175*t178* & - (0.2e1_dp*t1851+0.4e1_dp*t521*tnorm_drho+0.24e2_dp*t84* & - t1851+0.24e2_dp*t1196*t581*trho+0.24e2_dp*t426* & - tnorm_drhorho*tnorm_drho)-0.12e2_dp*t1492*t1493*t529+ & - 0.8e1_dp*t980*t1838-0.4e1_dp*t162*t178*tnorm_drhorho* & - t226+0.20e2_dp*t162*t586*t513 + t1878 = 0.4e1_dp*t175*t409*t226*t553 - 0.2e1_dp*t162* & + t178*t605*trho - 0.4e1_dp*t217*t218*t177*t553 + 0.8e1_dp & + *t1545*t1838 + 0.2e1_dp*t78*t581*t171*t91 - 0.4e1_dp* & + t162*t397*t590 - 0.10e2_dp*t175*t586*t525 - t175*t178* & + (0.2e1_dp*t1851 + 0.4e1_dp*t521*tnorm_drho + 0.24e2_dp*t84* & + t1851 + 0.24e2_dp*t1196*t581*trho + 0.24e2_dp*t426* & + tnorm_drhorho*tnorm_drho) - 0.12e2_dp*t1492*t1493*t529 + & + 0.8e1_dp*t980*t1838 - 0.4e1_dp*t162*t178*tnorm_drhorho* & + t226 + 0.20e2_dp*t162*t586*t513 t1889 = t78*t581 t1907 = t85*t1062 - t1922 = -0.4e1_dp*t500*t591+0.2e1_dp*t175*t409*t605* & - t186+0.4e1_dp*t162*t409*t598*trho-0.2e1_dp*t1889* & - t187+0.2e1_dp*t175*t1109*t598+0.20e2_dp*t175*t218* & - t91*tnorm_drhorho+0.10e2_dp*t175*t1851*t91-0.4e1_dp* & - t217*t517*t594-t175*t397*t605-0.6e1_dp*t175*t1907* & - t598*t186-0.4e1_dp*t162*t178*tnorm_drho*t553+0.4e1_dp & - *t78*tnorm_drhorho*t214-0.4e1_dp*t217*t521*t594 + t1922 = -0.4e1_dp*t500*t591 + 0.2e1_dp*t175*t409*t605* & + t186 + 0.4e1_dp*t162*t409*t598*trho - 0.2e1_dp*t1889* & + t187 + 0.2e1_dp*t175*t1109*t598 + 0.20e2_dp*t175*t218* & + t91*tnorm_drhorho + 0.10e2_dp*t175*t1851*t91 - 0.4e1_dp* & + t217*t517*t594 - t175*t397*t605 - 0.6e1_dp*t175*t1907* & + t598*t186 - 0.4e1_dp*t162*t178*tnorm_drho*t553 + 0.4e1_dp & + *t78*tnorm_drhorho*t214 - 0.4e1_dp*t217*t521*t594 t1927 = t439*t229 t1933 = t614*t1387 t1937 = t614*t103 - e_ndrho_ndrho_rho(ii) = e_ndrho_ndrho_rho(ii)+ & + e_ndrho_ndrho_rho(ii) = e_ndrho_ndrho_rho(ii) + & scale_ex*(ex_unif* & - Fxnorm_drhonorm_drho+t208*Fxnorm_drhonorm_drho+t108*( & - 0.48e2_dp*t1385*t1933*srho-0.24e2_dp*t1393*t1937*srho & - -0.16e2_dp*t471*t1797*snorm_drho+0.4e1_dp*t204* & - snorm_drhorho*snorm_drho))+scale_ec*(Hnorm_drhonorm_drho+my_rho & - *(gamma_var*(t1878+t1922)*t191-t609*t559-0.2e1_dp* & - t557*t1927+0.2e1_dp*t612*t1761)) + Fxnorm_drhonorm_drho + t208*Fxnorm_drhonorm_drho + t108*( & + 0.48e2_dp*t1385*t1933*srho - 0.24e2_dp*t1393*t1937*srho & + - 0.16e2_dp*t471*t1797*snorm_drho + 0.4e1_dp*t204* & + snorm_drhorho*snorm_drho)) + scale_ec*(Hnorm_drhonorm_drho + my_rho & + *(gamma_var*(t1878 + t1922)*t191 - t609*t559 - 0.2e1_dp* & + t557*t1927 + 0.2e1_dp*t612*t1761)) t2norm_drho = tnorm_drho t1952 = t226*t2norm_drho - t1964 = 0.2e1_dp*t168*t2norm_drho+0.4e1_dp*t183*t2norm_drho + t1964 = 0.2e1_dp*t168*t2norm_drho + 0.4e1_dp*t183*t2norm_drho t1965 = t178*t1964 t1968 = t226*t1964 t1969 = t1504*t1968 t1972 = A*t2norm_drho - t1990 = 0.2e1_dp*t1972*tnorm_drho+0.12e2_dp*t426* & + t1990 = 0.2e1_dp*t1972*tnorm_drho + 0.12e2_dp*t426* & tnorm_drho*t2norm_drho t2020 = t177*t1964 t2024 = t91*t2norm_drho t2028 = t78*t2norm_drho - t2031 = -0.20e2_dp*t1492*t1493*t1952+0.4e1_dp*t162* & - t409*t598*t2norm_drho-0.2e1_dp*t1889*t1965+0.8e1_dp* & - t1545*t1969+0.4e1_dp*t217*t1972*t408*t598-0.6e1_dp* & - t175*t1907*t598*t1964-0.2e1_dp*t217*t1972*t177*t605 & - -0.4e1_dp*t217*t218*t177*t1990+0.4e1_dp*t175*t409* & - t1990*t226-0.24e2_dp*t78*t182*t85*t177*t87*t581* & - t2norm_drho+0.2e1_dp*t175*t409*t605*t1964+0.8e1_dp* & - t980*t1969-0.2e1_dp*t162*t178*t605*t2norm_drho- & - 0.4e1_dp*t162*t178*t1990*tnorm_drho-0.10e2_dp*t175* & - t586*t2020+0.24e2_dp*t162*t586*t2024-0.4e1_dp*t2028* & + t2031 = -0.20e2_dp*t1492*t1493*t1952 + 0.4e1_dp*t162* & + t409*t598*t2norm_drho - 0.2e1_dp*t1889*t1965 + 0.8e1_dp* & + t1545*t1969 + 0.4e1_dp*t217*t1972*t408*t598 - 0.6e1_dp* & + t175*t1907*t598*t1964 - 0.2e1_dp*t217*t1972*t177*t605 & + - 0.4e1_dp*t217*t218*t177*t1990 + 0.4e1_dp*t175*t409* & + t1990*t226 - 0.24e2_dp*t78*t182*t85*t177*t87*t581* & + t2norm_drho + 0.2e1_dp*t175*t409*t605*t1964 + 0.8e1_dp* & + t980*t1969 - 0.2e1_dp*t162*t178*t605*t2norm_drho - & + 0.4e1_dp*t162*t178*t1990*tnorm_drho - 0.10e2_dp*t175* & + t586*t2020 + 0.24e2_dp*t162*t586*t2024 - 0.4e1_dp*t2028* & t591 - t2041 = 0.2e1_dp*t162*t163*t2norm_drho+0.2e1_dp*t217* & - t1972*t91-t175*t1965 + t2041 = 0.2e1_dp*t162*t163*t2norm_drho + 0.2e1_dp*t217* & + t1972*t91 - t175*t1965 s2norm_drho = snorm_drho - e_ndrho_ndrho_ndrho(ii) = e_ndrho_ndrho_ndrho(ii)+ & + e_ndrho_ndrho_ndrho(ii) = e_ndrho_ndrho_ndrho(ii) + & scale_ex*t108*(0.48e2_dp* & - t1385*t1933*s2norm_drho-0.24e2_dp*t1393*t1937* & - s2norm_drho)+scale_ec*my_rho*(gamma_var*t2031*t191-t609* & - t439*t2041-0.2e1_dp*gamma_var*(0.2e1_dp*t2028*t214+ & - 0.10e2_dp*t175*t218*t2024-0.2e1_dp*t162*t178* & - tnorm_drho*t1964-0.2e1_dp*t217*t218*t2020-0.2e1_dp* & - t162*t178*t1952-0.2e1_dp*t217*t1972*t594+0.2e1_dp* & - t175*t409*t1968-t175*t178*t1990)*t1927+0.2e1_dp*t612 & - *t1295*t2041) + t1385*t1933*s2norm_drho - 0.24e2_dp*t1393*t1937* & + s2norm_drho) + scale_ec*my_rho*(gamma_var*t2031*t191 - t609* & + t439*t2041 - 0.2e1_dp*gamma_var*(0.2e1_dp*t2028*t214 + & + 0.10e2_dp*t175*t218*t2024 - 0.2e1_dp*t162*t178* & + tnorm_drho*t1964 - 0.2e1_dp*t217*t218*t2020 - 0.2e1_dp* & + t162*t178*t1952 - 0.2e1_dp*t217*t1972*t594 + 0.2e1_dp* & + t175*t409*t1968 - t175*t178*t1990)*t1927 + 0.2e1_dp*t612 & + *t1295*t2041) END IF END IF END DO @@ -1358,7 +1358,7 @@ SUBROUTINE pbe_lsd_eval(rho_set, deriv_set, grad_deriv, pbe_params) norm_drhob=norm_drhob, norm_drho=norm_drho, & rho_cutoff=epsilon_rho, & local_bounds=bo) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rhoa e_0 => dummy @@ -1586,7 +1586,7 @@ SUBROUTINE pbe_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & CPABORT("") END SELECT - gamma_var = (0.1e1_dp-LOG(0.2e1_dp))/pi**2 + gamma_var = (0.1e1_dp - LOG(0.2e1_dp))/pi**2 p_1 = 0.10e1_dp A_1 = 0.31091e-1_dp alpha_1_1 = 0.21370e0_dp @@ -1621,69 +1621,69 @@ SUBROUTINE pbe_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & DO ii = 1, npoints my_rhoa = MAX(rhoa(ii), 0.0_dp) my_rhob = MAX(rhob(ii), 0.0_dp) - my_rho = my_rhoa+my_rhob + my_rho = my_rhoa + my_rhob IF (my_rho > epsilon_rho) THEN my_rhoa = MAX(EPSILON(0.0_dp)*1.e4_dp, my_rhoa) my_rhob = MAX(EPSILON(0.0_dp)*1.e4_dp, my_rhob) - my_rho = my_rhoa+my_rhob + my_rho = my_rhoa + my_rhob my_norm_drho = norm_drho(ii) my_norm_drhoa = norm_drhoa(ii) my_norm_drhob = norm_drhob(ii) - t1 = my_rhoa-my_rhob + t1 = my_rhoa - my_rhob t2 = 0.1e1_dp/my_rho chi = t1*t2 t8 = t7*t2 t9 = t8**(0.1e1_dp/0.3e1_dp) rs = t6*t9/0.4e1_dp - t12 = 0.1e1_dp+alpha_1_1*rs + t12 = 0.1e1_dp + alpha_1_1*rs t14 = 0.1e1_dp/A_1 t15 = SQRT(rs) t18 = t15*rs - t20 = p_1+0.1e1_dp + t20 = p_1 + 0.1e1_dp t21 = rs**t20 t22 = beta_4_1*t21 - t23 = beta_1_1*t15+beta_2_1*rs+beta_3_1*t18+t22 - t27 = 0.1e1_dp+t14/t23/0.2e1_dp + t23 = beta_1_1*t15 + beta_2_1*rs + beta_3_1*t18 + t22 + t27 = 0.1e1_dp + t14/t23/0.2e1_dp t28 = LOG(t27) e_c_u_0 = -0.2e1_dp*A_1*t12*t28 - t32 = 0.1e1_dp+alpha_1_2*rs + t32 = 0.1e1_dp + alpha_1_2*rs t34 = 0.1e1_dp/A_2 - t38 = p_2+0.1e1_dp + t38 = p_2 + 0.1e1_dp t39 = rs**t38 t40 = beta_4_2*t39 - t41 = beta_1_2*t15+beta_2_2*rs+beta_3_2*t18+t40 - t45 = 0.1e1_dp+t34/t41/0.2e1_dp + t41 = beta_1_2*t15 + beta_2_2*rs + beta_3_2*t18 + t40 + t45 = 0.1e1_dp + t34/t41/0.2e1_dp t46 = LOG(t45) - t50 = 0.1e1_dp+alpha_1_3*rs + t50 = 0.1e1_dp + alpha_1_3*rs t52 = 0.1e1_dp/A_3 - t56 = p_3+0.1e1_dp + t56 = p_3 + 0.1e1_dp t57 = rs**t56 t58 = beta_4_3*t57 - t59 = beta_1_3*t15+beta_2_3*rs+beta_3_3*t18+t58 - t63 = 0.1e1_dp+t52/t59/0.2e1_dp + t59 = beta_1_3*t15 + beta_2_3*rs + beta_3_3*t18 + t58 + t63 = 0.1e1_dp + t52/t59/0.2e1_dp t64 = LOG(t63) alpha_c = 0.2e1_dp*A_3*t50*t64 t66 = 2**(0.1e1_dp/0.3e1_dp) - t69 = 1/(2*t66-2) - t70 = 0.1e1_dp+chi + t69 = 1/(2*t66 - 2) + t70 = 0.1e1_dp + chi t71 = t70**(0.1e1_dp/0.3e1_dp) t72 = t71*t70 - t73 = 0.1e1_dp-chi + t73 = 0.1e1_dp - chi t74 = t73**(0.1e1_dp/0.3e1_dp) t75 = t74*t73 - f = (t72+t75-0.2e1_dp)*t69 + f = (t72 + t75 - 0.2e1_dp)*t69 t77 = alpha_c*f t78 = 0.9e1_dp/0.8e1_dp/t69 t79 = chi**2 t80 = t79**2 - t82 = t78*(0.1e1_dp-t80) - t84 = -0.2e1_dp*A_2*t32*t46-e_c_u_0 + t82 = t78*(0.1e1_dp - t80) + t84 = -0.2e1_dp*A_2*t32*t46 - e_c_u_0 t85 = t84*f - epsilon_c_unif = e_c_u_0+t77*t82+t85*t80 + epsilon_c_unif = e_c_u_0 + t77*t82 + t85*t80 t87 = t71**2 t88 = t74**2 - phi = t87/0.2e1_dp+t88/0.2e1_dp + phi = t87/0.2e1_dp + t88/0.2e1_dp t91 = t90*my_rho t92 = t91**(0.1e1_dp/0.3e1_dp) t93 = t3*t92*t7 @@ -1701,19 +1701,19 @@ SUBROUTINE pbe_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & t104 = t103*phi t105 = 0.1e1_dp/t104 t107 = EXP(-t102*t105) - t108 = t107-0.1e1_dp + t108 = t107 - 0.1e1_dp A = t101/t108 t110 = gamma_var*t104 t111 = t**2 t112 = A*t111 - t113 = 0.1e1_dp+t112 + t113 = 0.1e1_dp + t112 t115 = A**2 t116 = t111**2 - t118 = 0.1e1_dp+t112+t115*t116 + t118 = 0.1e1_dp + t112 + t115*t116 t119 = 0.1e1_dp/t118 - t122 = 0.1e1_dp+t101*t111*t113*t119 + t122 = 0.1e1_dp + t101*t111*t113*t119 t123 = LOG(t122) - epsilon_cGGA = epsilon_c_unif+t110*t123 + epsilon_cGGA = epsilon_c_unif + t110*t123 t124 = t3*t66 t125 = t90*my_rhoa t126 = t125**(0.1e1_dp/0.3e1_dp) @@ -1725,8 +1725,8 @@ SUBROUTINE pbe_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & s_a = t130*t131/0.2e1_dp t133 = s_a**2 t135 = 0.1e1_dp/kappa - t137 = 0.1e1_dp+mu*t133*t135 - Fx_a = 0.1e1_dp+kappa-kappa/t137 + t137 = 0.1e1_dp + mu*t133*t135 + Fx_a = 0.1e1_dp + kappa - kappa/t137 t140 = my_rhoa*ex_unif_a t142 = t90*my_rhob t143 = t142**(0.1e1_dp/0.3e1_dp) @@ -1737,20 +1737,20 @@ SUBROUTINE pbe_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & t148 = 0.1e1_dp/my_rhob s_b = t147*t148/0.2e1_dp t150 = s_b**2 - t153 = 0.1e1_dp+mu*t150*t135 - Fx_b = 0.1e1_dp+kappa-kappa/t153 + t153 = 0.1e1_dp + mu*t150*t135 + Fx_b = 0.1e1_dp + kappa - kappa/t153 t156 = my_rhob*ex_unif_b IF (grad_deriv >= 0) THEN - e_0(ii) = e_0(ii)+ & - scale_ex*(0.2e1_dp*t140*Fx_a+0.2e1_dp*t156*Fx_b) & - /0.2e1_dp+scale_ec*my_rho*epsilon_cGGA + e_0(ii) = e_0(ii) + & + scale_ex*(0.2e1_dp*t140*Fx_a + 0.2e1_dp*t156*Fx_b) & + /0.2e1_dp + scale_ec*my_rho*epsilon_cGGA END IF t162 = my_rho**2 t163 = 0.1e1_dp/t162 t164 = t1*t163 - chirhoa = t2-t164 + chirhoa = t2 - t164 t165 = t9**2 t167 = 0.1e1_dp/t165*t7 rsrhoa = -t6*t167*t163/0.12e2_dp @@ -1762,34 +1762,34 @@ SUBROUTINE pbe_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & t179 = beta_1_1*t178 t183 = beta_3_1*t15 t187 = 0.1e1_dp/rs - t190 = t179*rsrhoa/0.2e1_dp+beta_2_1*rsrhoa+0.3e1_dp/ & - 0.2e1_dp*t183*rsrhoa+t22*t20*rsrhoa*t187 + t190 = t179*rsrhoa/0.2e1_dp + beta_2_1*rsrhoa + 0.3e1_dp/ & + 0.2e1_dp*t183*rsrhoa + t22*t20*rsrhoa*t187 t191 = 0.1e1_dp/t27 t192 = t190*t191 - e_c_u_0rhoa = -0.2e1_dp*t171*rsrhoa*t28+t177*t192 + e_c_u_0rhoa = -0.2e1_dp*t171*rsrhoa*t28 + t177*t192 t194 = A_2*alpha_1_2 t198 = t41**2 t199 = 0.1e1_dp/t198 t200 = t32*t199 t201 = beta_1_2*t178 t205 = beta_3_2*t15 - t211 = t201*rsrhoa/0.2e1_dp+beta_2_2*rsrhoa+0.3e1_dp/ & - 0.2e1_dp*t205*rsrhoa+t40*t38*rsrhoa*t187 + t211 = t201*rsrhoa/0.2e1_dp + beta_2_2*rsrhoa + 0.3e1_dp/ & + 0.2e1_dp*t205*rsrhoa + t40*t38*rsrhoa*t187 t212 = 0.1e1_dp/t45 t213 = t211*t212 - e_c_u_1rhoa = -0.2e1_dp*t194*rsrhoa*t46+t200*t213 + e_c_u_1rhoa = -0.2e1_dp*t194*rsrhoa*t46 + t200*t213 t215 = A_3*alpha_1_3 t219 = t59**2 t220 = 0.1e1_dp/t219 t221 = t50*t220 t222 = beta_1_3*t178 t226 = beta_3_3*t15 - t232 = t222*rsrhoa/0.2e1_dp+beta_2_3*rsrhoa+0.3e1_dp/ & - 0.2e1_dp*t226*rsrhoa+t58*t56*rsrhoa*t187 + t232 = t222*rsrhoa/0.2e1_dp + beta_2_3*rsrhoa + 0.3e1_dp/ & + 0.2e1_dp*t226*rsrhoa + t58*t56*rsrhoa*t187 t233 = 0.1e1_dp/t63 t234 = t232*t233 - alpha_crhoa = 0.2e1_dp*t215*rsrhoa*t64-t221*t234 - frhoa = (0.4e1_dp/0.3e1_dp*t71*chirhoa-0.4e1_dp/0.3e1_dp & + alpha_crhoa = 0.2e1_dp*t215*rsrhoa*t64 - t221*t234 + frhoa = (0.4e1_dp/0.3e1_dp*t71*chirhoa - 0.4e1_dp/0.3e1_dp & *t74*chirhoa)*t69 t240 = alpha_crhoa*f t242 = alpha_c*frhoa @@ -1797,16 +1797,16 @@ SUBROUTINE pbe_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & t245 = t78*t244 t246 = t245*chirhoa t248 = 0.4e1_dp*t77*t246 - t249 = e_c_u_1rhoa-e_c_u_0rhoa + t249 = e_c_u_1rhoa - e_c_u_0rhoa t250 = t249*f t252 = t84*frhoa t254 = t244*chirhoa t256 = 0.4e1_dp*t85*t254 - epsilon_c_unifrhoa = e_c_u_0rhoa+t240*t82+t242*t82-t248 & - +t250*t80+t252*t80+t256 + epsilon_c_unifrhoa = e_c_u_0rhoa + t240*t82 + t242*t82 - t248 & + + t250*t80 + t252*t80 + t256 t257 = 0.1e1_dp/t71 t259 = 0.1e1_dp/t74 - phirhoa = t257*chirhoa/0.3e1_dp-t259*chirhoa/0.3e1_dp + phirhoa = t257*chirhoa/0.3e1_dp - t259*chirhoa/0.3e1_dp t262 = t92**2 k_frhoa = t3/t262*t90/0.3e1_dp t266 = 0.1e1_dp/t94 @@ -1818,15 +1818,15 @@ SUBROUTINE pbe_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & t274 = t273*t2 t277 = t97*t163 t278 = t96*t277 - trhoa = -t269*t98*phirhoa/0.2e1_dp-t96*t274*k_srhoa/ & - 0.2e1_dp-t278/0.2e1_dp + trhoa = -t269*t98*phirhoa/0.2e1_dp - t96*t274*k_srhoa/ & + 0.2e1_dp - t278/0.2e1_dp t280 = t108**2 t281 = 0.1e1_dp/t280 t282 = epsilon_c_unifrhoa*t100 t284 = t103**2 t285 = 0.1e1_dp/t284 t286 = t285*phirhoa - t289 = -t282*t105+0.3e1_dp*t102*t286 + t289 = -t282*t105 + 0.3e1_dp*t102*t286 Arhoa = -t101*t281*t289*t107 t293 = gamma_var*t103 t294 = t123*phirhoa @@ -1836,7 +1836,7 @@ SUBROUTINE pbe_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & t302 = Arhoa*t111 t303 = A*t t305 = 0.2e1_dp*t303*trhoa - t306 = t302+t305 + t306 = t302 + t305 t310 = t101*t111 t311 = t118**2 t312 = 0.1e1_dp/t311 @@ -1844,12 +1844,12 @@ SUBROUTINE pbe_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & t314 = A*t116 t317 = t111*t t318 = t115*t317 - t321 = t302+t305+0.2e1_dp*t314*Arhoa+0.4e1_dp*t318*trhoa - t324 = 0.2e1_dp*t297*t299+t101*t111*t306*t119-t310* & + t321 = t302 + t305 + 0.2e1_dp*t314*Arhoa + 0.4e1_dp*t318*trhoa + t324 = 0.2e1_dp*t297*t299 + t101*t111*t306*t119 - t310* & t313*t321 t325 = 0.1e1_dp/t122 t326 = t324*t325 - epsilon_cGGArhoa = epsilon_c_unifrhoa+0.3e1_dp*t293*t294+ & + epsilon_cGGArhoa = epsilon_c_unifrhoa + 0.3e1_dp*t293*t294 + & t110*t326 t329 = t126**2 kf_arhoa = t124/t329*t90/0.3e1_dp @@ -1859,62 +1859,62 @@ SUBROUTINE pbe_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & t337 = my_norm_drhoa*t336 t340 = my_rhoa**2 t341 = 0.1e1_dp/t340 - s_arhoa = -t337*t131*kf_arhoa/0.2e1_dp-t130*t341/0.2e1_dp + s_arhoa = -t337*t131*kf_arhoa/0.2e1_dp - t130*t341/0.2e1_dp t344 = t137**2 t346 = 0.1e1_dp/t344*mu Fx_arhoa = 0.2e1_dp*t346*s_a*s_arhoa t350 = my_rhoa*ex_unif_arhoa IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN - e_ra(ii) = e_ra(ii)+ & - scale_ex*(0.2e1_dp*ex_unif_a*Fx_a+0.2e1_dp* & - t350*Fx_a+0.2e1_dp*t140*Fx_arhoa)/0.2e1_dp+scale_ec*( & - epsilon_cGGA+my_rho*epsilon_cGGArhoa) + e_ra(ii) = e_ra(ii) + & + scale_ex*(0.2e1_dp*ex_unif_a*Fx_a + 0.2e1_dp* & + t350*Fx_a + 0.2e1_dp*t140*Fx_arhoa)/0.2e1_dp + scale_ec*( & + epsilon_cGGA + my_rho*epsilon_cGGArhoa) END IF - chirhob = -t2-t164 + chirhob = -t2 - t164 rsrhob = rsrhoa - t368 = t179*rsrhob/0.2e1_dp+beta_2_1*rsrhob+0.3e1_dp/ & - 0.2e1_dp*t183*rsrhob+t22*t20*rsrhob*t187 - e_c_u_0rhob = -0.2e1_dp*t171*rsrhob*t28+t177*t368*t191 - t382 = t201*rsrhob/0.2e1_dp+beta_2_2*rsrhob+0.3e1_dp/ & - 0.2e1_dp*t205*rsrhob+t40*t38*rsrhob*t187 - e_c_u_1rhob = -0.2e1_dp*t194*rsrhob*t46+t200*t382*t212 - t396 = t222*rsrhob/0.2e1_dp+beta_2_3*rsrhob+0.3e1_dp/ & - 0.2e1_dp*t226*rsrhob+t58*t56*rsrhob*t187 - alpha_crhob = 0.2e1_dp*t215*rsrhob*t64-t221*t396*t233 - frhob = (0.4e1_dp/0.3e1_dp*t71*chirhob-0.4e1_dp/0.3e1_dp & + t368 = t179*rsrhob/0.2e1_dp + beta_2_1*rsrhob + 0.3e1_dp/ & + 0.2e1_dp*t183*rsrhob + t22*t20*rsrhob*t187 + e_c_u_0rhob = -0.2e1_dp*t171*rsrhob*t28 + t177*t368*t191 + t382 = t201*rsrhob/0.2e1_dp + beta_2_2*rsrhob + 0.3e1_dp/ & + 0.2e1_dp*t205*rsrhob + t40*t38*rsrhob*t187 + e_c_u_1rhob = -0.2e1_dp*t194*rsrhob*t46 + t200*t382*t212 + t396 = t222*rsrhob/0.2e1_dp + beta_2_3*rsrhob + 0.3e1_dp/ & + 0.2e1_dp*t226*rsrhob + t58*t56*rsrhob*t187 + alpha_crhob = 0.2e1_dp*t215*rsrhob*t64 - t221*t396*t233 + frhob = (0.4e1_dp/0.3e1_dp*t71*chirhob - 0.4e1_dp/0.3e1_dp & *t74*chirhob)*t69 t403 = alpha_crhob*f t405 = alpha_c*frhob t407 = t245*chirhob t409 = 0.4e1_dp*t77*t407 - t410 = e_c_u_1rhob-e_c_u_0rhob + t410 = e_c_u_1rhob - e_c_u_0rhob t411 = t410*f t413 = t84*frhob t415 = t244*chirhob t417 = 0.4e1_dp*t85*t415 - epsilon_c_unifrhob = e_c_u_0rhob+t403*t82+t405*t82-t409 & - +t411*t80+t413*t80+t417 - phirhob = t257*chirhob/0.3e1_dp-t259*chirhob/0.3e1_dp + epsilon_c_unifrhob = e_c_u_0rhob + t403*t82 + t405*t82 - t409 & + + t411*t80 + t413*t80 + t417 + phirhob = t257*chirhob/0.3e1_dp - t259*chirhob/0.3e1_dp k_frhob = k_frhoa k_srhob = t266*k_frhob*t7 - trhob = -t269*t98*phirhob/0.2e1_dp-t96*t274*k_srhob/ & - 0.2e1_dp-t278/0.2e1_dp + trhob = -t269*t98*phirhob/0.2e1_dp - t96*t274*k_srhob/ & + 0.2e1_dp - t278/0.2e1_dp t427 = epsilon_c_unifrhob*t100 t429 = t285*phirhob - t432 = -t427*t105+0.3e1_dp*t102*t429 + t432 = -t427*t105 + 0.3e1_dp*t102*t429 Arhob = -t101*t281*t432*t107 t436 = t123*phirhob t439 = t298*trhob t442 = Arhob*t111 t444 = 0.2e1_dp*t303*trhob - t445 = t442+t444 - t453 = t442+t444+0.2e1_dp*t314*Arhob+0.4e1_dp*t318*trhob - t456 = 0.2e1_dp*t297*t439+t101*t111*t445*t119-t310* & + t445 = t442 + t444 + t453 = t442 + t444 + 0.2e1_dp*t314*Arhob + 0.4e1_dp*t318*trhob + t456 = 0.2e1_dp*t297*t439 + t101*t111*t445*t119 - t310* & t313*t453 t457 = t456*t325 - epsilon_cGGArhob = epsilon_c_unifrhob+0.3e1_dp*t293*t436+ & + epsilon_cGGArhob = epsilon_c_unifrhob + 0.3e1_dp*t293*t436 + & t110*t457 t460 = t143**2 kf_brhob = t124/t460*t90/0.3e1_dp @@ -1924,31 +1924,31 @@ SUBROUTINE pbe_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & t468 = my_norm_drhob*t467 t471 = my_rhob**2 t472 = 0.1e1_dp/t471 - s_brhob = -t468*t148*kf_brhob/0.2e1_dp-t147*t472/0.2e1_dp + s_brhob = -t468*t148*kf_brhob/0.2e1_dp - t147*t472/0.2e1_dp t475 = t153**2 t477 = 0.1e1_dp/t475*mu Fx_brhob = 0.2e1_dp*t477*s_b*s_brhob t481 = my_rhob*ex_unif_brhob IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN - e_rb(ii) = e_rb(ii)+ & - scale_ex*(0.2e1_dp*ex_unif_b*Fx_b+0.2e1_dp* & - t481*Fx_b+0.2e1_dp*t156*Fx_brhob)/0.2e1_dp+scale_ec*( & - epsilon_cGGA+my_rho*epsilon_cGGArhob) + e_rb(ii) = e_rb(ii) + & + scale_ex*(0.2e1_dp*ex_unif_b*Fx_b + 0.2e1_dp* & + t481*Fx_b + 0.2e1_dp*t156*Fx_brhob)/0.2e1_dp + scale_ec*( & + epsilon_cGGA + my_rho*epsilon_cGGArhob) END IF t488 = t95*t97 tnorm_drho = t488*t2/0.2e1_dp t493 = t101*t317 t494 = A*tnorm_drho - t502 = 0.2e1_dp*t303*tnorm_drho+0.4e1_dp*t318*tnorm_drho - t505 = 0.2e1_dp*t297*t298*tnorm_drho+0.2e1_dp*t493* & - t494*t119-t310*t313*t502 + t502 = 0.2e1_dp*t303*tnorm_drho + 0.4e1_dp*t318*tnorm_drho + t505 = 0.2e1_dp*t297*t298*tnorm_drho + 0.2e1_dp*t493* & + t494*t119 - t310*t313*t502 t506 = t505*t325 Hnorm_drho = t110*t506 IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN - e_ndr(ii) = e_ndr(ii)+ & + e_ndr(ii) = e_ndr(ii) + & scale_ec*my_rho*Hnorm_drho END IF @@ -1956,7 +1956,7 @@ SUBROUTINE pbe_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & Fx_anorm_drhoa = 0.2e1_dp*t346*s_a*s_anorm_drhoa IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN - e_ndra(ii) = e_ndra(ii)+ & + e_ndra(ii) = e_ndra(ii) + & scale_ex*t140*Fx_anorm_drhoa END IF @@ -1964,17 +1964,17 @@ SUBROUTINE pbe_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & Fx_bnorm_drhob = 0.2e1_dp*t477*s_b*s_bnorm_drhob IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN - e_ndrb(ii) = e_ndrb(ii)+ & + e_ndrb(ii) = e_ndrb(ii) + & scale_ex*t156*Fx_bnorm_drhob END IF IF (grad_deriv >= 2 .OR. grad_deriv == -2) THEN t518 = 0.1e1_dp/t162/my_rho t519 = t1*t518 - chirhoarhoa = -0.2e1_dp*t163+0.2e1_dp*t519 + chirhoarhoa = -0.2e1_dp*t163 + 0.2e1_dp*t519 t523 = 0.1e1_dp/t90 t525 = t162**2 - rsrhoarhoa = -t6/t165/t8*t523/t525/0.18e2_dp+ & + rsrhoarhoa = -t6/t165/t8*t523/t525/0.18e2_dp + & t6*t167*t518/0.6e1_dp t536 = alpha_1_1*rsrhoa t538 = t176*t190*t191 @@ -1991,12 +1991,12 @@ SUBROUTINE pbe_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & t578 = t12/t576 t579 = t27**2 t580 = 0.1e1_dp/t579 - e_c_u_0rhoarhoa = -0.2e1_dp*t171*rsrhoarhoa*t28+0.2e1_dp* & - t536*t538-0.2e1_dp*t543*t544*t191+t177*(-t549*t550 & - /0.4e1_dp+t179*rsrhoarhoa/0.2e1_dp+beta_2_1*rsrhoarhoa+ & - 0.3e1_dp/0.4e1_dp*t556*t550+0.3e1_dp/0.2e1_dp*t183* & - rsrhoarhoa+t22*t561*t550*t564+t22*t20*rsrhoarhoa* & - t187-t22*t20*t550*t564)*t191+t578*t544*t580*t14/ & + e_c_u_0rhoarhoa = -0.2e1_dp*t171*rsrhoarhoa*t28 + 0.2e1_dp* & + t536*t538 - 0.2e1_dp*t543*t544*t191 + t177*(-t549*t550 & + /0.4e1_dp + t179*rsrhoarhoa/0.2e1_dp + beta_2_1*rsrhoarhoa + & + 0.3e1_dp/0.4e1_dp*t556*t550 + 0.3e1_dp/0.2e1_dp*t183* & + rsrhoarhoa + t22*t561*t550*t564 + t22*t20*rsrhoarhoa* & + t187 - t22*t20*t550*t564)*t191 + t578*t544*t580*t14/ & 0.2e1_dp e_c_u_01rhoa = e_c_u_0rhoa t588 = alpha_1_2*rsrhoa @@ -2025,44 +2025,44 @@ SUBROUTINE pbe_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & t681 = 0.1e1_dp/t87 t682 = chirhoa**2 t687 = 0.1e1_dp/t88 - frhoarhoa = (0.4e1_dp/0.9e1_dp*t681*t682+0.4e1_dp/ & - 0.3e1_dp*t71*chirhoarhoa+0.4e1_dp/0.9e1_dp*t687*t682- & + frhoarhoa = (0.4e1_dp/0.9e1_dp*t681*t682 + 0.4e1_dp/ & + 0.3e1_dp*t71*chirhoarhoa + 0.4e1_dp/0.9e1_dp*t687*t682 - & 0.4e1_dp/0.3e1_dp*t74*chirhoarhoa)*t69 f1rhoa = frhoa t705 = alpha_c1rhoa*f t708 = alpha_c*f1rhoa t711 = t78*t79 - t726 = e_c_u_1rhoa-e_c_u_01rhoa + t726 = e_c_u_1rhoa - e_c_u_01rhoa t733 = t726*f t736 = t84*f1rhoa - t745 = -0.4e1_dp*t77*t245*chirhoarhoa+(-0.2e1_dp*t194* & - rsrhoarhoa*t46+0.2e1_dp*t588*t590-0.2e1_dp*t595*t596* & - t212+t200*(-t600*t550/0.4e1_dp+t201*rsrhoarhoa/ & - 0.2e1_dp+beta_2_2*rsrhoarhoa+0.3e1_dp/0.4e1_dp*t606*t550 & - +0.3e1_dp/0.2e1_dp*t205*rsrhoarhoa+t40*t611*t550* & - t564+t40*t38*rsrhoarhoa*t187-t40*t38*t550*t564)* & - t212+t626*t596*t628*t34/0.2e1_dp-e_c_u_0rhoarhoa)*f* & - t80+t249*f1rhoa*t80+0.4e1_dp*t250*t254+t726*frhoa* & - t80+t84*frhoarhoa*t80+0.4e1_dp*t252*t254+0.4e1_dp* & - t733*t254+0.4e1_dp*t736*t254+0.12e2_dp*t85*t79*t682 & - +0.4e1_dp*t85*t244*chirhoarhoa - epsilon_c_unifrhoarhoa = e_c_u_0rhoarhoa+(0.2e1_dp*t215* & - rsrhoarhoa*t64-0.2e1_dp*t636*t638+0.2e1_dp*t643*t644* & - t233-t221*(-t648*t550/0.4e1_dp+t222*rsrhoarhoa/ & - 0.2e1_dp+beta_2_3*rsrhoarhoa+0.3e1_dp/0.4e1_dp*t654*t550 & - +0.3e1_dp/0.2e1_dp*t226*rsrhoarhoa+t58*t659*t550* & - t564+t58*t56*rsrhoarhoa*t187-t58*t56*t550*t564)* & - t233-t674*t644*t676*t52/0.2e1_dp)*f*t82+alpha_crhoa & - *f1rhoa*t82-0.4e1_dp*t240*t246+alpha_c1rhoa*frhoa*t82 & - +alpha_c*frhoarhoa*t82-0.4e1_dp*t242*t246-0.4e1_dp* & - t705*t246-0.4e1_dp*t708*t246-0.12e2_dp*t77*t711*t682 & - +t745 - epsilon_c_unif1rhoa = e_c_u_01rhoa+t705*t82+t708*t82- & - t248+t733*t80+t736*t80+t256 + t745 = -0.4e1_dp*t77*t245*chirhoarhoa + (-0.2e1_dp*t194* & + rsrhoarhoa*t46 + 0.2e1_dp*t588*t590 - 0.2e1_dp*t595*t596* & + t212 + t200*(-t600*t550/0.4e1_dp + t201*rsrhoarhoa/ & + 0.2e1_dp + beta_2_2*rsrhoarhoa + 0.3e1_dp/0.4e1_dp*t606*t550 & + + 0.3e1_dp/0.2e1_dp*t205*rsrhoarhoa + t40*t611*t550* & + t564 + t40*t38*rsrhoarhoa*t187 - t40*t38*t550*t564)* & + t212 + t626*t596*t628*t34/0.2e1_dp - e_c_u_0rhoarhoa)*f* & + t80 + t249*f1rhoa*t80 + 0.4e1_dp*t250*t254 + t726*frhoa* & + t80 + t84*frhoarhoa*t80 + 0.4e1_dp*t252*t254 + 0.4e1_dp* & + t733*t254 + 0.4e1_dp*t736*t254 + 0.12e2_dp*t85*t79*t682 & + + 0.4e1_dp*t85*t244*chirhoarhoa + epsilon_c_unifrhoarhoa = e_c_u_0rhoarhoa + (0.2e1_dp*t215* & + rsrhoarhoa*t64 - 0.2e1_dp*t636*t638 + 0.2e1_dp*t643*t644* & + t233 - t221*(-t648*t550/0.4e1_dp + t222*rsrhoarhoa/ & + 0.2e1_dp + beta_2_3*rsrhoarhoa + 0.3e1_dp/0.4e1_dp*t654*t550 & + + 0.3e1_dp/0.2e1_dp*t226*rsrhoarhoa + t58*t659*t550* & + t564 + t58*t56*rsrhoarhoa*t187 - t58*t56*t550*t564)* & + t233 - t674*t644*t676*t52/0.2e1_dp)*f*t82 + alpha_crhoa & + *f1rhoa*t82 - 0.4e1_dp*t240*t246 + alpha_c1rhoa*frhoa*t82 & + + alpha_c*frhoarhoa*t82 - 0.4e1_dp*t242*t246 - 0.4e1_dp* & + t705*t246 - 0.4e1_dp*t708*t246 - 0.12e2_dp*t77*t711*t682 & + + t745 + epsilon_c_unif1rhoa = e_c_u_01rhoa + t705*t82 + t708*t82 - & + t248 + t733*t80 + t736*t80 + t256 t750 = 0.1e1_dp/t72 t755 = 0.1e1_dp/t75 - phirhoarhoa = -t750*t682/0.9e1_dp+t257*chirhoarhoa/ & - 0.3e1_dp-t755*t682/0.9e1_dp-t259*chirhoarhoa/0.3e1_dp + phirhoarhoa = -t750*t682/0.9e1_dp + t257*chirhoarhoa/ & + 0.3e1_dp - t755*t682/0.9e1_dp - t259*chirhoarhoa/0.3e1_dp phi1rhoa = phirhoa t763 = t90**2 k_frhoarhoa = -0.2e1_dp/0.9e1_dp*t3/t262/t91*t763 @@ -2078,36 +2078,36 @@ SUBROUTINE pbe_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & t798 = t273*t163 t801 = t96*t798*k_srhoa/0.2e1_dp t812 = t96*t97*t518 - trhoarhoa = t775*t776*phi1rhoa+t779*t776*k_s1rhoa/ & - 0.2e1_dp+t785-t269*t98*phirhoarhoa/0.2e1_dp+t779*t789 & - *phi1rhoa/0.2e1_dp+t795*t789*k_s1rhoa+t801-t96*t274* & - (-t767*t768*t523/0.2e1_dp+t266*k_frhoarhoa*t7)/ & - 0.2e1_dp+t269*t277*phi1rhoa/0.2e1_dp+t96*t798*k_s1rhoa & - /0.2e1_dp+t812 - t1rhoa = -t269*t98*phi1rhoa/0.2e1_dp-t96*t274*k_s1rhoa & - /0.2e1_dp-t278/0.2e1_dp + trhoarhoa = t775*t776*phi1rhoa + t779*t776*k_s1rhoa/ & + 0.2e1_dp + t785 - t269*t98*phirhoarhoa/0.2e1_dp + t779*t789 & + *phi1rhoa/0.2e1_dp + t795*t789*k_s1rhoa + t801 - t96*t274* & + (-t767*t768*t523/0.2e1_dp + t266*k_frhoarhoa*t7)/ & + 0.2e1_dp + t269*t277*phi1rhoa/0.2e1_dp + t96*t798*k_s1rhoa & + /0.2e1_dp + t812 + t1rhoa = -t269*t98*phi1rhoa/0.2e1_dp - t96*t274*k_s1rhoa & + /0.2e1_dp - t278/0.2e1_dp t820 = t101/t280/t108 t821 = t107**2 t822 = t289*t821 t823 = epsilon_c_unif1rhoa*t100 t825 = t285*phi1rhoa - t828 = -t823*t105+0.3e1_dp*t102*t825 + t828 = -t823*t105 + 0.3e1_dp*t102*t825 t839 = 0.1e1_dp/t284/phi t840 = t839*phirhoa t851 = t101*t281 - Arhoarhoa = 0.2e1_dp*t820*t822*t828-t101*t281*( & - -epsilon_c_unifrhoarhoa*t100*t105+0.3e1_dp*t282*t825+ & - 0.3e1_dp*t823*t286-0.12e2_dp*t102*t840*phi1rhoa+ & - 0.3e1_dp*t102*t285*phirhoarhoa)*t107-t851*t289*t828* & + Arhoarhoa = 0.2e1_dp*t820*t822*t828 - t101*t281*( & + -epsilon_c_unifrhoarhoa*t100*t105 + 0.3e1_dp*t282*t825 + & + 0.3e1_dp*t823*t286 - 0.12e2_dp*t102*t840*phi1rhoa + & + 0.3e1_dp*t102*t285*phirhoarhoa)*t107 - t851*t289*t828* & t107 A1rhoa = -t101*t281*t828*t107 t858 = gamma_var*phi t865 = A1rhoa*t111 t867 = 0.2e1_dp*t303*t1rhoa - t868 = t865+t867 - t876 = t865+t867+0.2e1_dp*t314*A1rhoa+0.4e1_dp*t318*t1rhoa - t879 = 0.2e1_dp*t297*t298*t1rhoa+t101*t111*t868*t119 & - -t310*t313*t876 + t868 = t865 + t867 + t876 = t865 + t867 + 0.2e1_dp*t314*A1rhoa + 0.4e1_dp*t318*t1rhoa + t879 = 0.2e1_dp*t297*t298*t1rhoa + t101*t111*t868*t119 & + - t310*t313*t876 t880 = t879*t325 t904 = t306*t119 t908 = Arhoarhoa*t111 @@ -2120,16 +2120,16 @@ SUBROUTINE pbe_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & t936 = t113/t311/t118 t944 = A*t317 t953 = t115*t111 - t959 = t908+t911+t914+t917+t919+0.2e1_dp*A1rhoa*t116 & - *Arhoa+0.8e1_dp*t944*Arhoa*t1rhoa+0.2e1_dp*t314* & - Arhoarhoa+0.8e1_dp*t944*trhoa*A1rhoa+0.12e2_dp*t953* & - trhoa*t1rhoa+0.4e1_dp*t318*trhoarhoa - t962 = 0.2e1_dp*t101*t1rhoa*t299+0.2e1_dp*t297*t868* & - t119*trhoa-0.2e1_dp*t297*t313*trhoa*t876+0.2e1_dp* & - t297*t298*trhoarhoa+0.2e1_dp*t297*t904*t1rhoa+t101* & - t111*(t908+t911+t914+t917+t919)*t119-t310*t924* & - t876-0.2e1_dp*t297*t313*t321*t1rhoa-t310*t868*t312* & - t321+0.2e1_dp*t310*t936*t321*t876-t310*t313*t959 + t959 = t908 + t911 + t914 + t917 + t919 + 0.2e1_dp*A1rhoa*t116 & + *Arhoa + 0.8e1_dp*t944*Arhoa*t1rhoa + 0.2e1_dp*t314* & + Arhoarhoa + 0.8e1_dp*t944*trhoa*A1rhoa + 0.12e2_dp*t953* & + trhoa*t1rhoa + 0.4e1_dp*t318*trhoarhoa + t962 = 0.2e1_dp*t101*t1rhoa*t299 + 0.2e1_dp*t297*t868* & + t119*trhoa - 0.2e1_dp*t297*t313*trhoa*t876 + 0.2e1_dp* & + t297*t298*trhoarhoa + 0.2e1_dp*t297*t904*t1rhoa + t101* & + t111*(t908 + t911 + t914 + t917 + t919)*t119 - t310*t924* & + t876 - 0.2e1_dp*t297*t313*t321*t1rhoa - t310*t868*t312* & + t321 + 0.2e1_dp*t310*t936*t321*t876 - t310*t313*t959 t965 = t122**2 t966 = 0.1e1_dp/t965 t967 = t324*t966 @@ -2143,21 +2143,21 @@ SUBROUTINE pbe_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & t1001 = s_arhoa*t135 Fx_a1rhoa = 0.2e1_dp*t346*s_a*s_a1rhoa - e_ra_ra(ii) = e_ra_ra(ii)+ & - scale_ex*(0.2e1_dp*ex_unif_a1rhoa*Fx_a+ & - 0.2e1_dp*ex_unif_a*Fx_a1rhoa+0.2e1_dp*ex_unif_arhoa*Fx_a- & - 0.3e1_dp/0.2e1_dp*my_rhoa*t7*kf_arhoarhoa*Fx_a+0.2e1_dp* & - t350*Fx_a1rhoa+0.2e1_dp*ex_unif_a*Fx_arhoa+0.2e1_dp*my_rhoa & - *ex_unif_a1rhoa*Fx_arhoa+0.2e1_dp*t140*(-0.8e1_dp*t1000 & - *t1001*s_a1rhoa+0.2e1_dp*t346*s_a1rhoa*s_arhoa+0.2e1_dp & - *t346*s_a*(my_norm_drhoa/t335/kf_a*t131*t985+t337* & - t341*kf_arhoa-t337*t131*kf_arhoarhoa/0.2e1_dp+t130/ & - t340/my_rhoa)))/0.2e1_dp+scale_ec*(epsilon_c_unif1rhoa+ & - 0.3e1_dp*t293*t123*phi1rhoa+t110*t880+epsilon_cGGArhoa+ & - my_rho*(epsilon_c_unifrhoarhoa+0.6e1_dp*t858*t294*phi1rhoa+ & - 0.3e1_dp*t293*t880*phirhoa+0.3e1_dp*t293*t123* & - phirhoarhoa+0.3e1_dp*t293*t326*phi1rhoa+t110*t962*t325 & - -t110*t967*t879)) + e_ra_ra(ii) = e_ra_ra(ii) + & + scale_ex*(0.2e1_dp*ex_unif_a1rhoa*Fx_a + & + 0.2e1_dp*ex_unif_a*Fx_a1rhoa + 0.2e1_dp*ex_unif_arhoa*Fx_a - & + 0.3e1_dp/0.2e1_dp*my_rhoa*t7*kf_arhoarhoa*Fx_a + 0.2e1_dp* & + t350*Fx_a1rhoa + 0.2e1_dp*ex_unif_a*Fx_arhoa + 0.2e1_dp*my_rhoa & + *ex_unif_a1rhoa*Fx_arhoa + 0.2e1_dp*t140*(-0.8e1_dp*t1000 & + *t1001*s_a1rhoa + 0.2e1_dp*t346*s_a1rhoa*s_arhoa + 0.2e1_dp & + *t346*s_a*(my_norm_drhoa/t335/kf_a*t131*t985 + t337* & + t341*kf_arhoa - t337*t131*kf_arhoarhoa/0.2e1_dp + t130/ & + t340/my_rhoa)))/0.2e1_dp + scale_ec*(epsilon_c_unif1rhoa + & + 0.3e1_dp*t293*t123*phi1rhoa + t110*t880 + epsilon_cGGArhoa + & + my_rho*(epsilon_c_unifrhoarhoa + 0.6e1_dp*t858*t294*phi1rhoa + & + 0.3e1_dp*t293*t880*phirhoa + 0.3e1_dp*t293*t123* & + phirhoarhoa + 0.3e1_dp*t293*t326*phi1rhoa + t110*t962*t325 & + - t110*t967*t879)) chirhoarhob = 0.2e1_dp*t519 rsrhoarhob = rsrhoarhoa @@ -2165,59 +2165,59 @@ SUBROUTINE pbe_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & t1033 = alpha_1_1*rsrhob t1038 = rsrhoa*rsrhob t1050 = rsrhob*t564*rsrhoa - e_c_u_0rhoarhob = -0.2e1_dp*t171*rsrhoarhob*t28+t536* & - t1031+t1033*t538-0.2e1_dp*t543*t192*t368+t177*(-t549 & - *t1038/0.4e1_dp+t179*rsrhoarhob/0.2e1_dp+beta_2_1* & - rsrhoarhob+0.3e1_dp/0.4e1_dp*t556*t1038+0.3e1_dp/ & - 0.2e1_dp*t183*rsrhoarhob+t22*t561*t1050+t22*t20* & - rsrhoarhob*t187-t22*t20*t1050)*t191+t578*t190*t580* & + e_c_u_0rhoarhob = -0.2e1_dp*t171*rsrhoarhob*t28 + t536* & + t1031 + t1033*t538 - 0.2e1_dp*t543*t192*t368 + t177*(-t549 & + *t1038/0.4e1_dp + t179*rsrhoarhob/0.2e1_dp + beta_2_1* & + rsrhoarhob + 0.3e1_dp/0.4e1_dp*t556*t1038 + 0.3e1_dp/ & + 0.2e1_dp*t183*rsrhoarhob + t22*t561*t1050 + t22*t20* & + rsrhoarhob*t187 - t22*t20*t1050)*t191 + t578*t190*t580* & t14*t368/0.2e1_dp t1069 = t199*t382*t212 t1071 = alpha_1_2*rsrhob t1104 = t220*t396*t233 t1106 = alpha_1_3*rsrhob - frhoarhob = (0.4e1_dp/0.9e1_dp*t681*chirhoa*chirhob+ & - 0.4e1_dp/0.3e1_dp*t71*chirhoarhob+0.4e1_dp/0.9e1_dp*t687 & - *chirhoa*chirhob-0.4e1_dp/0.3e1_dp*t74*chirhoarhob)* & + frhoarhob = (0.4e1_dp/0.9e1_dp*t681*chirhoa*chirhob + & + 0.4e1_dp/0.3e1_dp*t71*chirhoarhob + 0.4e1_dp/0.9e1_dp*t687 & + *chirhoa*chirhob - 0.4e1_dp/0.3e1_dp*t74*chirhoarhob)* & t69 t1164 = t79*chirhoa*chirhob - t1193 = -0.4e1_dp*t77*t245*chirhoarhob+(-0.2e1_dp*t194* & - rsrhoarhob*t46+t588*t1069+t1071*t590-0.2e1_dp*t595* & - t213*t382+t200*(-t600*t1038/0.4e1_dp+t201*rsrhoarhob/ & - 0.2e1_dp+beta_2_2*rsrhoarhob+0.3e1_dp/0.4e1_dp*t606* & - t1038+0.3e1_dp/0.2e1_dp*t205*rsrhoarhob+t40*t611*t1050 & - +t40*t38*rsrhoarhob*t187-t40*t38*t1050)*t212+t626 & - *t211*t628*t34*t382/0.2e1_dp-e_c_u_0rhoarhob)*f*t80+ & - t249*frhob*t80+0.4e1_dp*t250*t415+t410*frhoa*t80+ & - t84*frhoarhob*t80+0.4e1_dp*t252*t415+0.4e1_dp*t411* & - t254+0.4e1_dp*t413*t254+0.12e2_dp*t85*t1164+0.4e1_dp* & + t1193 = -0.4e1_dp*t77*t245*chirhoarhob + (-0.2e1_dp*t194* & + rsrhoarhob*t46 + t588*t1069 + t1071*t590 - 0.2e1_dp*t595* & + t213*t382 + t200*(-t600*t1038/0.4e1_dp + t201*rsrhoarhob/ & + 0.2e1_dp + beta_2_2*rsrhoarhob + 0.3e1_dp/0.4e1_dp*t606* & + t1038 + 0.3e1_dp/0.2e1_dp*t205*rsrhoarhob + t40*t611*t1050 & + + t40*t38*rsrhoarhob*t187 - t40*t38*t1050)*t212 + t626 & + *t211*t628*t34*t382/0.2e1_dp - e_c_u_0rhoarhob)*f*t80 + & + t249*frhob*t80 + 0.4e1_dp*t250*t415 + t410*frhoa*t80 + & + t84*frhoarhob*t80 + 0.4e1_dp*t252*t415 + 0.4e1_dp*t411* & + t254 + 0.4e1_dp*t413*t254 + 0.12e2_dp*t85*t1164 + 0.4e1_dp* & t85*t244*chirhoarhob - epsilon_c_unifrhoarhob = e_c_u_0rhoarhob+(0.2e1_dp*t215* & - rsrhoarhob*t64-t636*t1104-t1106*t638+0.2e1_dp*t643* & - t234*t396-t221*(-t648*t1038/0.4e1_dp+t222*rsrhoarhob/ & - 0.2e1_dp+beta_2_3*rsrhoarhob+0.3e1_dp/0.4e1_dp*t654* & - t1038+0.3e1_dp/0.2e1_dp*t226*rsrhoarhob+t58*t659*t1050 & - +t58*t56*rsrhoarhob*t187-t58*t56*t1050)*t233-t674 & - *t232*t676*t52*t396/0.2e1_dp)*f*t82+alpha_crhoa* & - frhob*t82-0.4e1_dp*t240*t407+alpha_crhob*frhoa*t82+ & - alpha_c*frhoarhob*t82-0.4e1_dp*t242*t407-0.4e1_dp*t403 & - *t246-0.4e1_dp*t405*t246-0.12e2_dp*t77*t78*t1164+ & + epsilon_c_unifrhoarhob = e_c_u_0rhoarhob + (0.2e1_dp*t215* & + rsrhoarhob*t64 - t636*t1104 - t1106*t638 + 0.2e1_dp*t643* & + t234*t396 - t221*(-t648*t1038/0.4e1_dp + t222*rsrhoarhob/ & + 0.2e1_dp + beta_2_3*rsrhoarhob + 0.3e1_dp/0.4e1_dp*t654* & + t1038 + 0.3e1_dp/0.2e1_dp*t226*rsrhoarhob + t58*t659*t1050 & + + t58*t56*rsrhoarhob*t187 - t58*t56*t1050)*t233 - t674 & + *t232*t676*t52*t396/0.2e1_dp)*f*t82 + alpha_crhoa* & + frhob*t82 - 0.4e1_dp*t240*t407 + alpha_crhob*frhoa*t82 + & + alpha_c*frhoarhob*t82 - 0.4e1_dp*t242*t407 - 0.4e1_dp*t403 & + *t246 - 0.4e1_dp*t405*t246 - 0.12e2_dp*t77*t78*t1164 + & t1193 - phirhoarhob = -t750*chirhoa*chirhob/0.9e1_dp+t257* & - chirhoarhob/0.3e1_dp-t755*chirhoa*chirhob/0.9e1_dp-t259 & + phirhoarhob = -t750*chirhoa*chirhob/0.9e1_dp + t257* & + chirhoarhob/0.3e1_dp - t755*chirhoa*chirhob/0.9e1_dp - t259 & *chirhoarhob/0.3e1_dp k_frhoarhob = k_frhoarhoa t1228 = t269*t277*phirhob/0.2e1_dp t1231 = t96*t798*k_srhob/0.2e1_dp - trhoarhob = t775*t776*phirhob+t779*t776*k_srhob/ & - 0.2e1_dp+t785-t269*t98*phirhoarhob/0.2e1_dp+t779*t789 & - *phirhob/0.2e1_dp+t795*t789*k_srhob+t801-t96*t274*( & - -t767*k_frhoa*t523*k_frhob/0.2e1_dp+t266*k_frhoarhob* & - t7)/0.2e1_dp+t1228+t1231+t812 - Arhoarhob = 0.2e1_dp*t820*t822*t432-t101*t281*( & - -epsilon_c_unifrhoarhob*t100*t105+0.3e1_dp*t282*t429+ & - 0.3e1_dp*t427*t286-0.12e2_dp*t102*t840*phirhob+ & - 0.3e1_dp*t102*t285*phirhoarhob)*t107-t851*t289*t432* & + trhoarhob = t775*t776*phirhob + t779*t776*k_srhob/ & + 0.2e1_dp + t785 - t269*t98*phirhoarhob/0.2e1_dp + t779*t789 & + *phirhob/0.2e1_dp + t795*t789*k_srhob + t801 - t96*t274*( & + -t767*k_frhoa*t523*k_frhob/0.2e1_dp + t266*k_frhoarhob* & + t7)/0.2e1_dp + t1228 + t1231 + t812 + Arhoarhob = 0.2e1_dp*t820*t822*t432 - t101*t281*( & + -epsilon_c_unifrhoarhob*t100*t105 + 0.3e1_dp*t282*t429 + & + 0.3e1_dp*t427*t286 - 0.12e2_dp*t102*t840*phirhob + & + 0.3e1_dp*t102*t285*phirhoarhob)*t107 - t851*t289*t432* & t107 t1269 = t445*t119 t1283 = Arhoarhob*t111 @@ -2227,120 +2227,120 @@ SUBROUTINE pbe_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & t1291 = 0.2e1_dp*A*trhob*trhoa t1293 = 0.2e1_dp*t303*trhoarhob t1304 = t445*t312 - t1327 = t1283+t1285+t1288+t1291+t1293+0.2e1_dp*Arhob* & - t116*Arhoa+0.8e1_dp*t944*Arhoa*trhob+0.2e1_dp*t314* & - Arhoarhob+0.8e1_dp*t944*trhoa*Arhob+0.12e2_dp*t953* & - trhoa*trhob+0.4e1_dp*t318*trhoarhob - t1330 = 0.2e1_dp*t101*trhob*t299+0.2e1_dp*t297*t1269* & - trhoa-0.2e1_dp*t297*t313*trhoa*t453+0.2e1_dp*t297* & - t298*trhoarhob+0.2e1_dp*t297*t904*trhob+t101*t111*( & - t1283+t1285+t1288+t1291+t1293)*t119-t310*t924*t453- & - 0.2e1_dp*t297*t313*t321*trhob-t310*t1304*t321+ & - 0.2e1_dp*t310*t936*t321*t453-t310*t313*t1327 - - e_ra_rb(ii) = e_ra_rb(ii)+ & - scale_ec*(epsilon_cGGArhob+epsilon_cGGArhoa+ & - my_rho*(epsilon_c_unifrhoarhob+0.6e1_dp*t858*t294*phirhob+ & - 0.3e1_dp*t293*t457*phirhoa+0.3e1_dp*t293*t123* & - phirhoarhob+0.3e1_dp*t293*t326*phirhob+t110*t1330*t325 & - -t110*t967*t456)) - - chirhobrhob = 0.2e1_dp*t163+0.2e1_dp*t519 + t1327 = t1283 + t1285 + t1288 + t1291 + t1293 + 0.2e1_dp*Arhob* & + t116*Arhoa + 0.8e1_dp*t944*Arhoa*trhob + 0.2e1_dp*t314* & + Arhoarhob + 0.8e1_dp*t944*trhoa*Arhob + 0.12e2_dp*t953* & + trhoa*trhob + 0.4e1_dp*t318*trhoarhob + t1330 = 0.2e1_dp*t101*trhob*t299 + 0.2e1_dp*t297*t1269* & + trhoa - 0.2e1_dp*t297*t313*trhoa*t453 + 0.2e1_dp*t297* & + t298*trhoarhob + 0.2e1_dp*t297*t904*trhob + t101*t111*( & + t1283 + t1285 + t1288 + t1291 + t1293)*t119 - t310*t924*t453 - & + 0.2e1_dp*t297*t313*t321*trhob - t310*t1304*t321 + & + 0.2e1_dp*t310*t936*t321*t453 - t310*t313*t1327 + + e_ra_rb(ii) = e_ra_rb(ii) + & + scale_ec*(epsilon_cGGArhob + epsilon_cGGArhoa + & + my_rho*(epsilon_c_unifrhoarhob + 0.6e1_dp*t858*t294*phirhob + & + 0.3e1_dp*t293*t457*phirhoa + 0.3e1_dp*t293*t123* & + phirhoarhob + 0.3e1_dp*t293*t326*phirhob + t110*t1330*t325 & + - t110*t967*t456)) + + chirhobrhob = 0.2e1_dp*t163 + 0.2e1_dp*t519 rsrhobrhob = rsrhoarhob t1342 = t368**2 t1346 = rsrhob**2 - e_c_u_0rhobrhob = -0.2e1_dp*t171*rsrhobrhob*t28+0.2e1_dp* & - t1033*t1031-0.2e1_dp*t543*t1342*t191+t177*(-t549* & - t1346/0.4e1_dp+t179*rsrhobrhob/0.2e1_dp+beta_2_1* & - rsrhobrhob+0.3e1_dp/0.4e1_dp*t556*t1346+0.3e1_dp/ & - 0.2e1_dp*t183*rsrhobrhob+t22*t561*t1346*t564+t22*t20 & - *rsrhobrhob*t187-t22*t20*t1346*t564)*t191+t578* & + e_c_u_0rhobrhob = -0.2e1_dp*t171*rsrhobrhob*t28 + 0.2e1_dp* & + t1033*t1031 - 0.2e1_dp*t543*t1342*t191 + t177*(-t549* & + t1346/0.4e1_dp + t179*rsrhobrhob/0.2e1_dp + beta_2_1* & + rsrhobrhob + 0.3e1_dp/0.4e1_dp*t556*t1346 + 0.3e1_dp/ & + 0.2e1_dp*t183*rsrhobrhob + t22*t561*t1346*t564 + t22*t20 & + *rsrhobrhob*t187 - t22*t20*t1346*t564)*t191 + t578* & t1342*t580*t14/0.2e1_dp e_c_u_01rhob = e_c_u_0rhob t1377 = t382**2 t1411 = t396**2 alpha_c1rhob = alpha_crhob t1440 = chirhob**2 - frhobrhob = (0.4e1_dp/0.9e1_dp*t681*t1440+0.4e1_dp/ & - 0.3e1_dp*t71*chirhobrhob+0.4e1_dp/0.9e1_dp*t687*t1440- & + frhobrhob = (0.4e1_dp/0.9e1_dp*t681*t1440 + 0.4e1_dp/ & + 0.3e1_dp*t71*chirhobrhob + 0.4e1_dp/0.9e1_dp*t687*t1440 - & 0.4e1_dp/0.3e1_dp*t74*chirhobrhob)*t69 f1rhob = frhob t1462 = alpha_c1rhob*f t1465 = alpha_c*f1rhob - t1482 = e_c_u_1rhob-e_c_u_01rhob + t1482 = e_c_u_1rhob - e_c_u_01rhob t1489 = t1482*f t1492 = t84*f1rhob - t1501 = -0.4e1_dp*t77*t245*chirhobrhob+(-0.2e1_dp*t194* & - rsrhobrhob*t46+0.2e1_dp*t1071*t1069-0.2e1_dp*t595* & - t1377*t212+t200*(-t600*t1346/0.4e1_dp+t201*rsrhobrhob & - /0.2e1_dp+beta_2_2*rsrhobrhob+0.3e1_dp/0.4e1_dp*t606* & - t1346+0.3e1_dp/0.2e1_dp*t205*rsrhobrhob+t40*t611*t1346 & - *t564+t40*t38*rsrhobrhob*t187-t40*t38*t1346*t564) & - *t212+t626*t1377*t628*t34/0.2e1_dp-e_c_u_0rhobrhob)*f & - *t80+t410*f1rhob*t80+0.4e1_dp*t411*t415+t1482* & - frhob*t80+t84*frhobrhob*t80+0.4e1_dp*t413*t415+ & - 0.4e1_dp*t1489*t415+0.4e1_dp*t1492*t415+0.12e2_dp*t85 & - *t79*t1440+0.4e1_dp*t85*t244*chirhobrhob - epsilon_c_unifrhobrhob = e_c_u_0rhobrhob+(0.2e1_dp*t215* & - rsrhobrhob*t64-0.2e1_dp*t1106*t1104+0.2e1_dp*t643* & - t1411*t233-t221*(-t648*t1346/0.4e1_dp+t222*rsrhobrhob & - /0.2e1_dp+beta_2_3*rsrhobrhob+0.3e1_dp/0.4e1_dp*t654* & - t1346+0.3e1_dp/0.2e1_dp*t226*rsrhobrhob+t58*t659*t1346 & - *t564+t58*t56*rsrhobrhob*t187-t58*t56*t1346*t564) & - *t233-t674*t1411*t676*t52/0.2e1_dp)*f*t82+ & - alpha_crhob*f1rhob*t82-0.4e1_dp*t403*t407+alpha_c1rhob* & - frhob*t82+alpha_c*frhobrhob*t82-0.4e1_dp*t405*t407- & - 0.4e1_dp*t1462*t407-0.4e1_dp*t1465*t407-0.12e2_dp*t77 & - *t711*t1440+t1501 - epsilon_c_unif1rhob = e_c_u_01rhob+t1462*t82+t1465*t82- & - t409+t1489*t80+t1492*t80+t417 - phirhobrhob = -t750*t1440/0.9e1_dp+t257*chirhobrhob/ & - 0.3e1_dp-t755*t1440/0.9e1_dp-t259*chirhobrhob/0.3e1_dp + t1501 = -0.4e1_dp*t77*t245*chirhobrhob + (-0.2e1_dp*t194* & + rsrhobrhob*t46 + 0.2e1_dp*t1071*t1069 - 0.2e1_dp*t595* & + t1377*t212 + t200*(-t600*t1346/0.4e1_dp + t201*rsrhobrhob & + /0.2e1_dp + beta_2_2*rsrhobrhob + 0.3e1_dp/0.4e1_dp*t606* & + t1346 + 0.3e1_dp/0.2e1_dp*t205*rsrhobrhob + t40*t611*t1346 & + *t564 + t40*t38*rsrhobrhob*t187 - t40*t38*t1346*t564) & + *t212 + t626*t1377*t628*t34/0.2e1_dp - e_c_u_0rhobrhob)*f & + *t80 + t410*f1rhob*t80 + 0.4e1_dp*t411*t415 + t1482* & + frhob*t80 + t84*frhobrhob*t80 + 0.4e1_dp*t413*t415 + & + 0.4e1_dp*t1489*t415 + 0.4e1_dp*t1492*t415 + 0.12e2_dp*t85 & + *t79*t1440 + 0.4e1_dp*t85*t244*chirhobrhob + epsilon_c_unifrhobrhob = e_c_u_0rhobrhob + (0.2e1_dp*t215* & + rsrhobrhob*t64 - 0.2e1_dp*t1106*t1104 + 0.2e1_dp*t643* & + t1411*t233 - t221*(-t648*t1346/0.4e1_dp + t222*rsrhobrhob & + /0.2e1_dp + beta_2_3*rsrhobrhob + 0.3e1_dp/0.4e1_dp*t654* & + t1346 + 0.3e1_dp/0.2e1_dp*t226*rsrhobrhob + t58*t659*t1346 & + *t564 + t58*t56*rsrhobrhob*t187 - t58*t56*t1346*t564) & + *t233 - t674*t1411*t676*t52/0.2e1_dp)*f*t82 + & + alpha_crhob*f1rhob*t82 - 0.4e1_dp*t403*t407 + alpha_c1rhob* & + frhob*t82 + alpha_c*frhobrhob*t82 - 0.4e1_dp*t405*t407 - & + 0.4e1_dp*t1462*t407 - 0.4e1_dp*t1465*t407 - 0.12e2_dp*t77 & + *t711*t1440 + t1501 + epsilon_c_unif1rhob = e_c_u_01rhob + t1462*t82 + t1465*t82 - & + t409 + t1489*t80 + t1492*t80 + t417 + phirhobrhob = -t750*t1440/0.9e1_dp + t257*chirhobrhob/ & + 0.3e1_dp - t755*t1440/0.9e1_dp - t259*chirhobrhob/0.3e1_dp phi1rhob = phirhob t1514 = k_frhob**2 k_s1rhob = k_srhob t1520 = t2*phirhob t1529 = t2*k_srhob - trhobrhob = t775*t1520*phi1rhob+t779*t1520*k_s1rhob/ & - 0.2e1_dp+t1228-t269*t98*phirhobrhob/0.2e1_dp+t779* & - t1529*phi1rhob/0.2e1_dp+t795*t1529*k_s1rhob+t1231-t96 & - *t274*(-t767*t1514*t523/0.2e1_dp+t266*k_frhoarhob*t7) & - /0.2e1_dp+t269*t277*phi1rhob/0.2e1_dp+t96*t798* & - k_s1rhob/0.2e1_dp+t812 - t1rhob = -t269*t98*phi1rhob/0.2e1_dp-t96*t274*k_s1rhob & - /0.2e1_dp-t278/0.2e1_dp + trhobrhob = t775*t1520*phi1rhob + t779*t1520*k_s1rhob/ & + 0.2e1_dp + t1228 - t269*t98*phirhobrhob/0.2e1_dp + t779* & + t1529*phi1rhob/0.2e1_dp + t795*t1529*k_s1rhob + t1231 - t96 & + *t274*(-t767*t1514*t523/0.2e1_dp + t266*k_frhoarhob*t7) & + /0.2e1_dp + t269*t277*phi1rhob/0.2e1_dp + t96*t798* & + k_s1rhob/0.2e1_dp + t812 + t1rhob = -t269*t98*phi1rhob/0.2e1_dp - t96*t274*k_s1rhob & + /0.2e1_dp - t278/0.2e1_dp t1550 = epsilon_c_unif1rhob*t100 t1552 = t285*phi1rhob - t1555 = -t1550*t105+0.3e1_dp*t102*t1552 - Arhobrhob = 0.2e1_dp*t820*t432*t821*t1555-t101*t281* & - (-epsilon_c_unifrhobrhob*t100*t105+0.3e1_dp*t427*t1552+ & - 0.3e1_dp*t1550*t429-0.12e2_dp*t102*t839*phirhob* & - phi1rhob+0.3e1_dp*t102*t285*phirhobrhob)*t107-t851* & + t1555 = -t1550*t105 + 0.3e1_dp*t102*t1552 + Arhobrhob = 0.2e1_dp*t820*t432*t821*t1555 - t101*t281* & + (-epsilon_c_unifrhobrhob*t100*t105 + 0.3e1_dp*t427*t1552 + & + 0.3e1_dp*t1550*t429 - 0.12e2_dp*t102*t839*phirhob* & + phi1rhob + 0.3e1_dp*t102*t285*phirhobrhob)*t107 - t851* & t432*t1555*t107 A1rhob = -t101*t281*t1555*t107 t1588 = A1rhob*t111 t1590 = 0.2e1_dp*t303*t1rhob - t1591 = t1588+t1590 - t1599 = t1588+t1590+0.2e1_dp*t314*A1rhob+0.4e1_dp*t318 & + t1591 = t1588 + t1590 + t1599 = t1588 + t1590 + 0.2e1_dp*t314*A1rhob + 0.4e1_dp*t318 & *t1rhob - t1602 = 0.2e1_dp*t297*t298*t1rhob+t101*t111*t1591* & - t119-t310*t313*t1599 + t1602 = 0.2e1_dp*t297*t298*t1rhob + t101*t111*t1591* & + t119 - t310*t313*t1599 t1603 = t1602*t325 t1630 = Arhobrhob*t111 t1632 = 0.2e1_dp*t1286*t1rhob t1635 = 0.2e1_dp*A1rhob*t*trhob t1638 = 0.2e1_dp*A*t1rhob*trhob t1640 = 0.2e1_dp*t303*trhobrhob - t1674 = t1630+t1632+t1635+t1638+t1640+0.2e1_dp*A1rhob & - *t116*Arhob+0.8e1_dp*t944*Arhob*t1rhob+0.2e1_dp*t314 & - *Arhobrhob+0.8e1_dp*t944*trhob*A1rhob+0.12e2_dp*t953* & - trhob*t1rhob+0.4e1_dp*t318*trhobrhob - t1677 = 0.2e1_dp*t101*t1rhob*t439+0.2e1_dp*t297*t1591 & - *t119*trhob-0.2e1_dp*t297*t313*trhob*t1599+0.2e1_dp* & - t297*t298*trhobrhob+0.2e1_dp*t297*t1269*t1rhob+t101* & - t111*(t1630+t1632+t1635+t1638+t1640)*t119-t310* & - t1304*t1599-0.2e1_dp*t297*t313*t453*t1rhob-t310* & - t1591*t312*t453+0.2e1_dp*t310*t936*t453*t1599-t310* & + t1674 = t1630 + t1632 + t1635 + t1638 + t1640 + 0.2e1_dp*A1rhob & + *t116*Arhob + 0.8e1_dp*t944*Arhob*t1rhob + 0.2e1_dp*t314 & + *Arhobrhob + 0.8e1_dp*t944*trhob*A1rhob + 0.12e2_dp*t953* & + trhob*t1rhob + 0.4e1_dp*t318*trhobrhob + t1677 = 0.2e1_dp*t101*t1rhob*t439 + 0.2e1_dp*t297*t1591 & + *t119*trhob - 0.2e1_dp*t297*t313*trhob*t1599 + 0.2e1_dp* & + t297*t298*trhobrhob + 0.2e1_dp*t297*t1269*t1rhob + t101* & + t111*(t1630 + t1632 + t1635 + t1638 + t1640)*t119 - t310* & + t1304*t1599 - 0.2e1_dp*t297*t313*t453*t1rhob - t310* & + t1591*t312*t453 + 0.2e1_dp*t310*t936*t453*t1599 - t310* & t313*t1674 t1680 = t456*t966 kf_brhobrhob = -0.2e1_dp/0.9e1_dp*t124/t460/t142*t763 @@ -2352,102 +2352,102 @@ SUBROUTINE pbe_lsd_calc(rhoa, rhob, norm_drho, norm_drhoa, norm_drhob, & t1713 = s_brhob*t135 Fx_b1rhob = 0.2e1_dp*t477*s_b*s_b1rhob - e_rb_rb(ii) = e_rb_rb(ii)+ & - scale_ex*(0.2e1_dp*ex_unif_b1rhob*Fx_b+ & - 0.2e1_dp*ex_unif_b*Fx_b1rhob+0.2e1_dp*ex_unif_brhob*Fx_b- & - 0.3e1_dp/0.2e1_dp*my_rhob*t7*kf_brhobrhob*Fx_b+0.2e1_dp* & - t481*Fx_b1rhob+0.2e1_dp*ex_unif_b*Fx_brhob+0.2e1_dp*my_rhob & - *ex_unif_b1rhob*Fx_brhob+0.2e1_dp*t156*(-0.8e1_dp*t1712 & - *t1713*s_b1rhob+0.2e1_dp*t477*s_b1rhob*s_brhob+0.2e1_dp & - *t477*s_b*(my_norm_drhob/t466/kf_b*t148*t1698+t468* & - t472*kf_brhob-t468*t148*kf_brhobrhob/0.2e1_dp+t147/ & - t471/my_rhob)))/0.2e1_dp+scale_ec*(epsilon_c_unif1rhob+ & - 0.3e1_dp*t293*t123*phi1rhob+t110*t1603+epsilon_cGGArhob & - +my_rho*(epsilon_c_unifrhobrhob+0.6e1_dp*t858*t436*phi1rhob & - +0.3e1_dp*t293*t1603*phirhob+0.3e1_dp*t293*t123* & - phirhobrhob+0.3e1_dp*t293*t457*phi1rhob+t110*t1677* & - t325-t110*t1680*t1602)) + e_rb_rb(ii) = e_rb_rb(ii) + & + scale_ex*(0.2e1_dp*ex_unif_b1rhob*Fx_b + & + 0.2e1_dp*ex_unif_b*Fx_b1rhob + 0.2e1_dp*ex_unif_brhob*Fx_b - & + 0.3e1_dp/0.2e1_dp*my_rhob*t7*kf_brhobrhob*Fx_b + 0.2e1_dp* & + t481*Fx_b1rhob + 0.2e1_dp*ex_unif_b*Fx_brhob + 0.2e1_dp*my_rhob & + *ex_unif_b1rhob*Fx_brhob + 0.2e1_dp*t156*(-0.8e1_dp*t1712 & + *t1713*s_b1rhob + 0.2e1_dp*t477*s_b1rhob*s_brhob + 0.2e1_dp & + *t477*s_b*(my_norm_drhob/t466/kf_b*t148*t1698 + t468* & + t472*kf_brhob - t468*t148*kf_brhobrhob/0.2e1_dp + t147/ & + t471/my_rhob)))/0.2e1_dp + scale_ec*(epsilon_c_unif1rhob + & + 0.3e1_dp*t293*t123*phi1rhob + t110*t1603 + epsilon_cGGArhob & + + my_rho*(epsilon_c_unifrhobrhob + 0.6e1_dp*t858*t436*phi1rhob & + + 0.3e1_dp*t293*t1603*phirhob + 0.3e1_dp*t293*t123* & + phirhobrhob + 0.3e1_dp*t293*t457*phi1rhob + t110*t1677* & + t325 - t110*t1680*t1602)) t1739 = t268*t97 t1741 = t95*t273 t1743 = t488*t163 - trhoanorm_drho = -t1739*t776/0.2e1_dp-t1741*t789/ & - 0.2e1_dp-t1743/0.2e1_dp + trhoanorm_drho = -t1739*t776/0.2e1_dp - t1741*t789/ & + 0.2e1_dp - t1743/0.2e1_dp t1748 = t101*tnorm_drho t1765 = t909*tnorm_drho t1766 = t494*trhoa t1767 = t303*trhoanorm_drho - t1801 = 0.2e1_dp*t1748*t299+0.4e1_dp*t310*t494*t119* & - trhoa-0.2e1_dp*t297*t313*trhoa*t502+0.2e1_dp*t297* & - t298*trhoanorm_drho+0.2e1_dp*t297*t904*tnorm_drho+t101* & - t111*(0.2e1_dp*t1765+0.2e1_dp*t1766+0.2e1_dp*t1767)* & - t119-t310*t924*t502-0.2e1_dp*t297*t313*t321* & - tnorm_drho-0.2e1_dp*t493*t494*t312*t321+0.2e1_dp*t310 & - *t936*t321*t502-t310*t313*(0.2e1_dp*t1765+0.2e1_dp* & - t1766+0.2e1_dp*t1767+0.8e1_dp*t944*Arhoa*tnorm_drho+ & - 0.12e2_dp*t953*trhoa*tnorm_drho+0.4e1_dp*t318* & - trhoanorm_drho) - - e_ra_ndr(ii) = e_ra_ndr(ii)+ & - scale_ec*(Hnorm_drho+my_rho*(0.3e1_dp* & - t293*t506*phirhoa+t110*t1801*t325-t110*t967*t505)) - - trhobnorm_drho = -t1739*t1520/0.2e1_dp-t1741*t1529/ & - 0.2e1_dp-t1743/0.2e1_dp + t1801 = 0.2e1_dp*t1748*t299 + 0.4e1_dp*t310*t494*t119* & + trhoa - 0.2e1_dp*t297*t313*trhoa*t502 + 0.2e1_dp*t297* & + t298*trhoanorm_drho + 0.2e1_dp*t297*t904*tnorm_drho + t101* & + t111*(0.2e1_dp*t1765 + 0.2e1_dp*t1766 + 0.2e1_dp*t1767)* & + t119 - t310*t924*t502 - 0.2e1_dp*t297*t313*t321* & + tnorm_drho - 0.2e1_dp*t493*t494*t312*t321 + 0.2e1_dp*t310 & + *t936*t321*t502 - t310*t313*(0.2e1_dp*t1765 + 0.2e1_dp* & + t1766 + 0.2e1_dp*t1767 + 0.8e1_dp*t944*Arhoa*tnorm_drho + & + 0.12e2_dp*t953*trhoa*tnorm_drho + 0.4e1_dp*t318* & + trhoanorm_drho) + + e_ra_ndr(ii) = e_ra_ndr(ii) + & + scale_ec*(Hnorm_drho + my_rho*(0.3e1_dp* & + t293*t506*phirhoa + t110*t1801*t325 - t110*t967*t505)) + + trhobnorm_drho = -t1739*t1520/0.2e1_dp - t1741*t1529/ & + 0.2e1_dp - t1743/0.2e1_dp t1829 = t1286*tnorm_drho t1830 = t494*trhob t1831 = t303*trhobnorm_drho - t1865 = 0.2e1_dp*t1748*t439+0.4e1_dp*t310*t494*t119* & - trhob-0.2e1_dp*t297*t313*trhob*t502+0.2e1_dp*t297* & - t298*trhobnorm_drho+0.2e1_dp*t297*t1269*tnorm_drho+t101 & - *t111*(0.2e1_dp*t1829+0.2e1_dp*t1830+0.2e1_dp*t1831)* & - t119-t310*t1304*t502-0.2e1_dp*t297*t313*t453* & - tnorm_drho-0.2e1_dp*t493*t494*t312*t453+0.2e1_dp*t310 & - *t936*t453*t502-t310*t313*(0.2e1_dp*t1829+0.2e1_dp* & - t1830+0.2e1_dp*t1831+0.8e1_dp*t944*Arhob*tnorm_drho+ & - 0.12e2_dp*t953*trhob*tnorm_drho+0.4e1_dp*t318* & - trhobnorm_drho) - - e_rb_ndr(ii) = e_rb_ndr(ii)+ & - scale_ec*(Hnorm_drho+my_rho*(0.3e1_dp* & - t293*t506*phirhob+t110*t1865*t325-t110*t1680*t505)) + t1865 = 0.2e1_dp*t1748*t439 + 0.4e1_dp*t310*t494*t119* & + trhob - 0.2e1_dp*t297*t313*trhob*t502 + 0.2e1_dp*t297* & + t298*trhobnorm_drho + 0.2e1_dp*t297*t1269*tnorm_drho + t101 & + *t111*(0.2e1_dp*t1829 + 0.2e1_dp*t1830 + 0.2e1_dp*t1831)* & + t119 - t310*t1304*t502 - 0.2e1_dp*t297*t313*t453* & + tnorm_drho - 0.2e1_dp*t493*t494*t312*t453 + 0.2e1_dp*t310 & + *t936*t453*t502 - t310*t313*(0.2e1_dp*t1829 + 0.2e1_dp* & + t1830 + 0.2e1_dp*t1831 + 0.8e1_dp*t944*Arhob*tnorm_drho + & + 0.12e2_dp*t953*trhob*tnorm_drho + 0.4e1_dp*t318* & + trhobnorm_drho) + + e_rb_ndr(ii) = e_rb_ndr(ii) + & + scale_ec*(Hnorm_drho + my_rho*(0.3e1_dp* & + t293*t506*phirhob + t110*t1865*t325 - t110*t1680*t505)) t1871 = tnorm_drho**2 t1876 = A*t1871 t1888 = t502**2 t1901 = t505**2 - e_ndr_ndr(ii) = e_ndr_ndr(ii)+ & + e_ndr_ndr(ii) = e_ndr_ndr(ii) + & scale_ec*my_rho*(t110*(0.2e1_dp* & - t101*t1871*t113*t119+0.10e2_dp*t310*t1876*t119- & - 0.4e1_dp*t297*t313*tnorm_drho*t502-0.4e1_dp*t493*t494 & - *t312*t502+0.2e1_dp*t310*t936*t1888-t310*t313*( & - 0.2e1_dp*t1876+0.12e2_dp*t953*t1871))*t325-t110*t1901 & + t101*t1871*t113*t119 + 0.10e2_dp*t310*t1876*t119 - & + 0.4e1_dp*t297*t313*tnorm_drho*t502 - 0.4e1_dp*t493*t494 & + *t312*t502 + 0.2e1_dp*t310*t936*t1888 - t310*t313*( & + 0.2e1_dp*t1876 + 0.12e2_dp*t953*t1871))*t325 - t110*t1901 & *t966) - e_ra_ndra(ii) = e_ra_ndra(ii)+ & + e_ra_ndra(ii) = e_ra_ndra(ii) + & scale_ex*(0.2e1_dp*ex_unif_a* & - Fx_anorm_drhoa+0.2e1_dp*t350*Fx_anorm_drhoa+0.2e1_dp*t140 & - *(-0.8e1_dp*t1000*t1001*s_anorm_drhoa+0.2e1_dp*t346* & - s_anorm_drhoa*s_arhoa+0.2e1_dp*t346*s_a*(-t336*t131* & - kf_arhoa/0.2e1_dp-t129*t341/0.2e1_dp)))/0.2e1_dp + Fx_anorm_drhoa + 0.2e1_dp*t350*Fx_anorm_drhoa + 0.2e1_dp*t140 & + *(-0.8e1_dp*t1000*t1001*s_anorm_drhoa + 0.2e1_dp*t346* & + s_anorm_drhoa*s_arhoa + 0.2e1_dp*t346*s_a*(-t336*t131* & + kf_arhoa/0.2e1_dp - t129*t341/0.2e1_dp)))/0.2e1_dp t1922 = s_anorm_drhoa**2 - e_ndra_ndra(ii) = e_ndra_ndra(ii)+ & + e_ndra_ndra(ii) = e_ndra_ndra(ii) + & scale_ex*t140*(-0.8e1_dp*t999* & - t133*t1922*t135+0.2e1_dp*t346*t1922) + t133*t1922*t135 + 0.2e1_dp*t346*t1922) - e_rb_ndrb(ii) = e_rb_ndrb(ii)+ & + e_rb_ndrb(ii) = e_rb_ndrb(ii) + & scale_ex*(0.2e1_dp*ex_unif_b* & - Fx_bnorm_drhob+0.2e1_dp*t481*Fx_bnorm_drhob+0.2e1_dp*t156 & - *(-0.8e1_dp*t1712*t1713*s_bnorm_drhob+0.2e1_dp*t477* & - s_bnorm_drhob*s_brhob+0.2e1_dp*t477*s_b*(-t467*t148* & - kf_brhob/0.2e1_dp-t146*t472/0.2e1_dp)))/0.2e1_dp + Fx_bnorm_drhob + 0.2e1_dp*t481*Fx_bnorm_drhob + 0.2e1_dp*t156 & + *(-0.8e1_dp*t1712*t1713*s_bnorm_drhob + 0.2e1_dp*t477* & + s_bnorm_drhob*s_brhob + 0.2e1_dp*t477*s_b*(-t467*t148* & + kf_brhob/0.2e1_dp - t146*t472/0.2e1_dp)))/0.2e1_dp t1949 = s_bnorm_drhob**2 - e_ndrb_ndrb(ii) = e_ndrb_ndrb(ii)+ & + e_ndrb_ndrb(ii) = e_ndrb_ndrb(ii) + & scale_ex*t156*(-0.8e1_dp*t1711* & - t150*t1949*t135+0.2e1_dp*t477*t1949) + t150*t1949*t135 + 0.2e1_dp*t477*t1949) END IF END IF END DO diff --git a/src/xc/xc_perdew86.F b/src/xc/xc_perdew86.F index 04f678affb..8f9e9ed080 100644 --- a/src/xc/xc_perdew86.F +++ b/src/xc/xc_perdew86.F @@ -53,7 +53,7 @@ MODULE xc_perdew86 d = 0.472_dp, & pc1 = 0.001667_dp, & pc2 = 0.002568_dp, & - pci = pc1+pc2 + pci = pc1 + pc2 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'xc_perdew86' CONTAINS @@ -145,7 +145,7 @@ SUBROUTINE p86_lda_eval(rho_set, deriv_set, order, p86_params) CALL xc_rho_set_get(rho_set, rho=rho, & norm_drho=grho, local_bounds=bo, rho_cutoff=rho_cutoff, & drho_cutoff=drho_cutoff) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) CALL p86_init(rho_cutoff) m = ABS(order) @@ -236,10 +236,10 @@ SUBROUTINE p86_u_0(rho, rs, grho, e_0, npoints) r = rs(ip) x = r*frs or = 1.0_dp/rho(ip) - cr = pc1+(pc2+a*r+b*r*r)/(1.0_dp+c*r+d*r*r+1.e4_dp*b*r*r*r) + cr = pc1 + (pc2 + a*r + b*r*r)/(1.0_dp + c*r + d*r*r + 1.e4_dp*b*r*r*r) phi = fpe*pci/cr*g*SQRT(x)*or ep = EXP(-phi) - e_0(ip) = e_0(ip)+x*or*g*g*cr*ep + e_0(ip) = e_0(ip) + x*or*g*g*cr*ep END IF END DO @@ -274,19 +274,19 @@ SUBROUTINE p86_u_1(rho, grho, rs, e_rho, e_ndrho, npoints) r = rs(ip) x = r*frs or = 1.0_dp/rho(ip) - p = pc2+a*r+b*r*r - dpv = a+2.0_dp*b*r - q = 1.0_dp+c*r+d*r*r+1.e4_dp*b*r*r*r - dq = c+2.0_dp*d*r+3.e4_dp*b*r*r - cr = pc1+p/q - dcr = (dpv*q-p*dq)/(q*q)*(-f13*r*or) + p = pc2 + a*r + b*r*r + dpv = a + 2.0_dp*b*r + q = 1.0_dp + c*r + d*r*r + 1.e4_dp*b*r*r*r + dq = c + 2.0_dp*d*r + 3.e4_dp*b*r*r + cr = pc1 + p/q + dcr = (dpv*q - p*dq)/(q*q)*(-f13*r*or) dphig = fpe*pci/cr*SQRT(x)*or phi = dphig*g - dphir = -phi*(dcr/cr+f76*or) + dphir = -phi*(dcr/cr + f76*or) ep = EXP(-phi) ff = x*or*g*ep - e_rho(ip) = e_rho(ip)+ff*g*dcr-ff*g*cr*dphir-ff*g*cr*f43*or - e_ndrho(ip) = e_ndrho(ip)+ff*cr*(2.0_dp-g*dphig) + e_rho(ip) = e_rho(ip) + ff*g*dcr - ff*g*cr*dphir - ff*g*cr*f43*or + e_ndrho(ip) = e_ndrho(ip) + ff*cr*(2.0_dp - g*dphig) END IF END DO @@ -325,32 +325,32 @@ SUBROUTINE p86_u_2(rho, grho, rs, e_rho_rho, e_rho_ndrho, e_ndrho_ndrho, & r = rs(ip) x = r*frs or = 1.0_dp/rho(ip) - p = pc2+a*r+b*r*r - dpv = a+2.0_dp*b*r + p = pc2 + a*r + b*r*r + dpv = a + 2.0_dp*b*r d2p = 2.0_dp*b - q = 1.0_dp+c*r+d*r*r+1.e4_dp*b*r*r*r - dq = c+2.0_dp*d*r+3.e4_dp*b*r*r - d2q = 2.0_dp*d+6.e4_dp*b*r - cr = pc1+p/q - dcr = (dpv*q-p*dq)/(q*q)*(-f13*r*or) - d2cr = (d2p*q*q-p*q*d2q-2*dpv*dq*q+2*p*dq*dq)/(q*q*q)*(f13*r*or)**2+ & - (dpv*q-p*dq)/(q*q)*f13*f43*r*or*or + q = 1.0_dp + c*r + d*r*r + 1.e4_dp*b*r*r*r + dq = c + 2.0_dp*d*r + 3.e4_dp*b*r*r + d2q = 2.0_dp*d + 6.e4_dp*b*r + cr = pc1 + p/q + dcr = (dpv*q - p*dq)/(q*q)*(-f13*r*or) + d2cr = (d2p*q*q - p*q*d2q - 2*dpv*dq*q + 2*p*dq*dq)/(q*q*q)*(f13*r*or)**2 + & + (dpv*q - p*dq)/(q*q)*f13*f43*r*or*or dphig = fpe*pci/cr*SQRT(x)*or phi = dphig*g - dphir = -phi*(dcr/cr+f76*or) - d2phir = -dphir*(dcr/cr+f76*or)- & - phi*((d2cr*cr-dcr*dcr)/(cr*cr)-f76*or*or) - dphigr = -dphig*(dcr/cr+f76*or) + dphir = -phi*(dcr/cr + f76*or) + d2phir = -dphir*(dcr/cr + f76*or) - & + phi*((d2cr*cr - dcr*dcr)/(cr*cr) - f76*or*or) + dphigr = -dphig*(dcr/cr + f76*or) ep = EXP(-phi) - e_rho_rho(ip) = e_rho_rho(ip)+x*or*ep*g*g* & - (-f43*or*dcr+d2cr-dcr*dphir+ & - f43*or*cr*dphir-dcr*dphir-cr*d2phir+cr*dphir*dphir+ & - f43*or*(7.*f13*or*cr-dcr+cr*dphir)) - e_rho_ndrho(ip) = e_rho_ndrho(ip)+x*or*ep*g* & - (-2*f43*cr*or+2*dcr-2*cr*dphir+f43*or*g*cr*dphig- & - g*dcr*dphig+g*cr*dphir*dphig-g*cr*dphigr) - e_ndrho_ndrho(ip) = e_ndrho_ndrho(ip)+x*or*ep*cr* & - (2.0_dp-4.0_dp*g*dphig+g*g*dphig*dphig) + e_rho_rho(ip) = e_rho_rho(ip) + x*or*ep*g*g* & + (-f43*or*dcr + d2cr - dcr*dphir + & + f43*or*cr*dphir - dcr*dphir - cr*d2phir + cr*dphir*dphir + & + f43*or*(7.*f13*or*cr - dcr + cr*dphir)) + e_rho_ndrho(ip) = e_rho_ndrho(ip) + x*or*ep*g* & + (-2*f43*cr*or + 2*dcr - 2*cr*dphir + f43*or*g*cr*dphig - & + g*dcr*dphig + g*cr*dphir*dphig - g*cr*dphigr) + e_ndrho_ndrho(ip) = e_ndrho_ndrho(ip) + x*or*ep*cr* & + (2.0_dp - 4.0_dp*g*dphig + g*g*dphig*dphig) END IF END DO @@ -392,60 +392,60 @@ SUBROUTINE p86_u_3(rho, grho, rs, e_rho_rho_rho, & r = rs(ip) x = r*frs or = 1.0_dp/rho(ip) - p = pc2+a*r+b*r*r - dpv = a+2.0_dp*b*r + p = pc2 + a*r + b*r*r + dpv = a + 2.0_dp*b*r d2p = 2.0_dp*b - q = 1.0_dp+c*r+d*r*r+1.e4_dp*b*r*r*r - dq = c+2.0_dp*d*r+3.e4_dp*b*r*r - d2q = 2.0_dp*d+6.e4*b*r + q = 1.0_dp + c*r + d*r*r + 1.e4_dp*b*r*r*r + dq = c + 2.0_dp*d*r + 3.e4_dp*b*r*r + d2q = 2.0_dp*d + 6.e4*b*r d3q = 6.e4*b pq = p/q - dpq = (dpv*q-p*dq)/(q*q) - d2pq = (d2p*q*q-2*dpv*dq*q+2*p*dq*dq-p*d2q*q)/(q*q*q) - d3pq = -(3*d2p*dq*q*q-6*dpv*dq*dq*q+3*dpv*d2q*q*q+6*p*dq*dq*dq-6*p*dq*d2q*q & - +p*d3q*q*q)/(q*q*q*q) - cr = pc1+pq + dpq = (dpv*q - p*dq)/(q*q) + d2pq = (d2p*q*q - 2*dpv*dq*q + 2*p*dq*dq - p*d2q*q)/(q*q*q) + d3pq = -(3*d2p*dq*q*q - 6*dpv*dq*dq*q + 3*dpv*d2q*q*q + 6*p*dq*dq*dq - 6*p*dq*d2q*q & + + p*d3q*q*q)/(q*q*q*q) + cr = pc1 + pq dcr = dpq*(-f13*r*or) - d2cr = d2pq*f13*f13*r*r*or*or+dpq*f13*f43*r*or*or - d3cr = d3pq*(-f13*r*or)**3+3*d2pq*(-f13*f13*f43*r*r*or*or*or)+ & + d2cr = d2pq*f13*f13*r*r*or*or + dpq*f13*f43*r*or*or + d3cr = d3pq*(-f13*r*or)**3 + 3*d2pq*(-f13*f13*f43*r*r*or*or*or) + & dpq*(-f13*f43*f13*7*r*or*or*or) oz = SQRT(x)*or/cr - dz = dcr/cr+f76*or - d2z = d2cr/cr+2*f76*dcr/cr*or+f76/6.*or*or - d3z = d3cr/cr+3*f76*d2cr/cr*or+3*f76/6.*dcr/cr*or*or-5*f76/36.*or*or*or + dz = dcr/cr + f76*or + d2z = d2cr/cr + 2*f76*dcr/cr*or + f76/6.*or*or + d3z = d3cr/cr + 3*f76*d2cr/cr*or + 3*f76/6.*dcr/cr*or*or - 5*f76/36.*or*or*or dphig = fpe*pci*oz phi = dphig*g dphir = -phi*dz dphigr = -dphig*dz - d2phir = -phi*(d2z-2*dz*dz) - d3phir = -phi*(d3z-6*d2z*dz+6*dz*dz*dz) - d2phirg = -dphigr*dz- & - dphig*((d2cr*cr-dcr*dcr)/(cr*cr)-f76*or*or) + d2phir = -phi*(d2z - 2*dz*dz) + d3phir = -phi*(d3z - 6*d2z*dz + 6*dz*dz*dz) + d2phirg = -dphigr*dz - & + dphig*((d2cr*cr - dcr*dcr)/(cr*cr) - f76*or*or) ep = EXP(-phi) e_rho_rho_rho(ip) = e_rho_rho_rho(ip) & - +g*g*x*or*ep*(-280./27.*or*or*or*cr+3*28./9.*or*or*dcr+ & - 3*28./9.*or*or*cr*(-dphir)-4*or*d2cr-8*or*dcr*(-dphir)- & - 4*or*cr*(-d2phir+dphir*dphir)+d3cr+3*d2cr*(-dphir)+ & - 3*dcr*(-d2phir+dphir*dphir)+cr*(-d3phir+3*dphir*d2phir- & - dphir**3)) + + g*g*x*or*ep*(-280./27.*or*or*or*cr + 3*28./9.*or*or*dcr + & + 3*28./9.*or*or*cr*(-dphir) - 4*or*d2cr - 8*or*dcr*(-dphir) - & + 4*or*cr*(-d2phir + dphir*dphir) + d3cr + 3*d2cr*(-dphir) + & + 3*dcr*(-d2phir + dphir*dphir) + cr*(-d3phir + 3*dphir*d2phir - & + dphir**3)) e_rho_rho_ndrho(ip) = e_rho_rho_ndrho(ip) & - +2.*x*or*ep*g*(-f43*or*dcr+d2cr-dcr*dphir+ & - f43*or*cr*dphir-dcr*dphir-cr*d2phir+cr*dphir*dphir+ & - f43*or*(7.*f13*or*cr-dcr+cr*dphir))- & - dphig*x*or*ep*g*g*(-f43*or*dcr+d2cr-dcr*dphir+ & - f43*or*cr*dphir-dcr*dphir-cr*d2phir+cr*dphir*dphir+ & - f43*or*(7.*f13*or*cr-dcr+cr*dphir))+ & - x*or*ep*g*g*(-dcr*dphigr+f43*or*cr*dphigr-dcr*dphigr-cr*d2phirg+ & - 2.*cr*dphigr*dphir+f43*or*cr*dphigr) + + 2.*x*or*ep*g*(-f43*or*dcr + d2cr - dcr*dphir + & + f43*or*cr*dphir - dcr*dphir - cr*d2phir + cr*dphir*dphir + & + f43*or*(7.*f13*or*cr - dcr + cr*dphir)) - & + dphig*x*or*ep*g*g*(-f43*or*dcr + d2cr - dcr*dphir + & + f43*or*cr*dphir - dcr*dphir - cr*d2phir + cr*dphir*dphir + & + f43*or*(7.*f13*or*cr - dcr + cr*dphir)) + & + x*or*ep*g*g*(-dcr*dphigr + f43*or*cr*dphigr - dcr*dphigr - cr*d2phirg + & + 2.*cr*dphigr*dphir + f43*or*cr*dphigr) e_rho_ndrho_ndrho(ip) = e_rho_ndrho_ndrho(ip) & - +x*or*ep*(-2*f43*cr*or+2*dcr-2*cr*dphir+f43*or*g*cr*dphig- & - g*dcr*dphig+g*cr*dphir*dphig-g*cr*dphigr)+ & - x*or*ep*g*(-2*cr*dphigr+f43*or*cr*dphig- & - dcr*dphig+cr*dphir*dphig+g*cr*dphigr*dphig-cr*dphigr)- & - x*or*ep*g*dphig*(-2*f43*cr*or+2*dcr-2*cr*dphir+f43*or*g*cr*dphig- & - g*dcr*dphig+g*cr*dphir*dphig-g*cr*dphigr) + + x*or*ep*(-2*f43*cr*or + 2*dcr - 2*cr*dphir + f43*or*g*cr*dphig - & + g*dcr*dphig + g*cr*dphir*dphig - g*cr*dphigr) + & + x*or*ep*g*(-2*cr*dphigr + f43*or*cr*dphig - & + dcr*dphig + cr*dphir*dphig + g*cr*dphigr*dphig - cr*dphigr) - & + x*or*ep*g*dphig*(-2*f43*cr*or + 2*dcr - 2*cr*dphir + f43*or*g*cr*dphig - & + g*dcr*dphig + g*cr*dphir*dphig - g*cr*dphigr) e_ndrho_ndrho_ndrho(ip) = e_ndrho_ndrho_ndrho(ip) & - +x*or*ep*cr*dphig*(-6.0_dp+6.0_dp*g*dphig-g*g*dphig*dphig) + + x*or*ep*cr*dphig*(-6.0_dp + 6.0_dp*g*dphig - g*g*dphig*dphig) END IF END DO diff --git a/src/xc/xc_perdew_wang.F b/src/xc/xc_perdew_wang.F index 4c272351c9..13a60a90d0 100644 --- a/src/xc/xc_perdew_wang.F +++ b/src/xc/xc_perdew_wang.F @@ -88,12 +88,12 @@ SUBROUTINE perdew_wang_info(method, lsd, reference, shortform, needs, & //" Phys. Rev. B 45, 13244 (1992)" & //"["//TRIM(p_string)//"]" IF (scale /= 1._dp) THEN - WRITE (reference(LEN_TRIM(reference)+1:LEN(reference)), "('s=',f5.3)") & + WRITE (reference(LEN_TRIM(reference) + 1:LEN(reference)), "('s=',f5.3)") & scale END IF IF (.NOT. lsd) THEN - IF (LEN_TRIM(reference)+6 < LEN(reference)) THEN - reference(LEN_TRIM(reference)+1:LEN_TRIM(reference)+7) = ' {LDA}' + IF (LEN_TRIM(reference) + 6 < LEN(reference)) THEN + reference(LEN_TRIM(reference) + 1:LEN_TRIM(reference) + 7) = ' {LDA}' END IF END IF END IF @@ -101,12 +101,12 @@ SUBROUTINE perdew_wang_info(method, lsd, reference, shortform, needs, & shortform = "J. P. Perdew et al., PRB 45, 13244 (1992)" & //"["//TRIM(p_string)//"]" IF (scale /= 1._dp) THEN - WRITE (shortform(LEN_TRIM(shortform)+1:LEN(shortform)), "('s=',f5.3)") & + WRITE (shortform(LEN_TRIM(shortform) + 1:LEN(shortform)), "('s=',f5.3)") & scale END IF IF (.NOT. lsd) THEN - IF (LEN_TRIM(shortform)+6 < LEN(shortform)) THEN - shortform(LEN_TRIM(shortform)+1:LEN_TRIM(shortform)+7) = ' {LDA}' + IF (LEN_TRIM(shortform) + 6 < LEN(shortform)) THEN + shortform(LEN_TRIM(shortform) + 1:LEN_TRIM(shortform) + 7) = ' {LDA}' END IF END IF END IF @@ -186,7 +186,7 @@ SUBROUTINE perdew_wang_init(method, cutoff) c1(k) = -2.0_dp*c0(k)*LOG(2.0_dp*A(k)*b1(k)) c2(k) = A(k)*a1(k) c3(k) = -2.0_dp*A(k)*(a1(k)*LOG(2.0_dp*A(k)*b1(k)) & - -(b2(k)/b1(k))**2+(b3(k)/b1(k))) + - (b2(k)/b1(k))**2 + (b3(k)/b1(k))) d0(k) = a1(k)/b4(k) d1(k) = a1(k)*b3(k)/(b4(k)**2) END DO @@ -236,7 +236,7 @@ SUBROUTINE perdew_wang_lda_eval(method, rho_set, deriv_set, order, scale) CPASSERT(deriv_set%ref_count > 0) CALL xc_rho_set_get(rho_set, rho=rho, & local_bounds=bo, rho_cutoff=rho_cutoff) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) CALL perdew_wang_init(method, rho_cutoff) @@ -312,16 +312,16 @@ SUBROUTINE perdew_wang_lda_calc(rho, e_0, e_rho, e_rho_rho, e_rho_rho_rho, npoin ed = scale*ed IF (order >= 0) THEN - e_0(k) = e_0(k)+rho(k)*ed(0) + e_0(k) = e_0(k) + rho(k)*ed(0) END IF IF (order >= 1 .OR. order == -1) THEN - e_rho(k) = e_rho(k)+ed(0)+rho(k)*ed(1) + e_rho(k) = e_rho(k) + ed(0) + rho(k)*ed(1) END IF IF (order >= 2 .OR. order == -2) THEN - e_rho_rho(k) = e_rho_rho(k)+2.0_dp*ed(1)+rho(k)*ed(2) + e_rho_rho(k) = e_rho_rho(k) + 2.0_dp*ed(1) + rho(k)*ed(2) END IF IF (order >= 3 .OR. order == -3) THEN - e_rho_rho_rho(k) = e_rho_rho_rho(k)+3.0_dp*ed(2)+rho(k)*ed(3) + e_rho_rho_rho(k) = e_rho_rho_rho(k) + 3.0_dp*ed(2) + rho(k)*ed(3) END IF END IF @@ -371,7 +371,7 @@ SUBROUTINE perdew_wang_lsd_eval(method, rho_set, deriv_set, order, scale) CPASSERT(deriv_set%ref_count > 0) CALL xc_rho_set_get(rho_set, rhoa=a, rhob=b, & local_bounds=bo, rho_cutoff=rho_cutoff) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) CALL perdew_wang_init(method, rho_cutoff) @@ -470,28 +470,28 @@ SUBROUTINE perdew_wang_lsd_calc(rhoa, rhob, e_0, ea, eb, eaa, eab, ebb, eaaa, ea !$OMP SHARED(npoints,rhoa,rhob,eps_rho,abs_order,order,e_0,ea,eb,eaa,eab,ebb,eaaa,eaab,eabb,ebbb,scale) DO k = 1, npoints - rho = rhoa(k)+rhob(k) + rho = rhoa(k) + rhob(k) IF (rho > eps_rho) THEN CALL pw_lsd_ed_loc(rhoa(k), rhob(k), ed, abs_order) ed = ed*scale IF (order >= 0) THEN - e_0(k) = e_0(k)+rho*ed(0) + e_0(k) = e_0(k) + rho*ed(0) END IF IF (order >= 1 .OR. order == -1) THEN - ea(k) = ea(k)+ed(0)+rho*ed(1) - eb(k) = eb(k)+ed(0)+rho*ed(2) + ea(k) = ea(k) + ed(0) + rho*ed(1) + eb(k) = eb(k) + ed(0) + rho*ed(2) END IF IF (order >= 2 .OR. order == -2) THEN - eaa(k) = eaa(k)+2.0_dp*ed(1)+rho*ed(3) - eab(k) = eab(k)+ed(1)+ed(2)+rho*ed(4) - ebb(k) = ebb(k)+2.0_dp*ed(2)+rho*ed(5) + eaa(k) = eaa(k) + 2.0_dp*ed(1) + rho*ed(3) + eab(k) = eab(k) + ed(1) + ed(2) + rho*ed(4) + ebb(k) = ebb(k) + 2.0_dp*ed(2) + rho*ed(5) END IF IF (order >= 3 .OR. order == -3) THEN - eaaa(k) = eaaa(k)+3.0_dp*ed(3)+rho*ed(6) - eaab(k) = eaab(k)+2.0_dp*ed(4)+ed(3)+rho*ed(7) - eabb(k) = eabb(k)+2.0_dp*ed(4)+ed(5)+rho*ed(8) - ebbb(k) = ebbb(k)+3.0_dp*ed(5)+rho*ed(9) + eaaa(k) = eaaa(k) + 3.0_dp*ed(3) + rho*ed(6) + eaab(k) = eaab(k) + 2.0_dp*ed(4) + ed(3) + rho*ed(7) + eabb(k) = eabb(k) + 2.0_dp*ed(4) + ed(5) + rho*ed(8) + ebbb(k) = ebbb(k) + 3.0_dp*ed(5) + rho*ed(9) END IF END IF @@ -534,37 +534,37 @@ SUBROUTINE calc_g(r, z, g, order) IF (r < 1.0_dp) THEN ! order 0 must always be calculated - g(0) = c0(z)*LOG(r)-c1(z)+c2(z)*r*LOG(r)-c3(z)*r - IF (order >= 1) g(1) = c0(z)/r+c2(z)*LOG(r)+c2(z)-c3(z) - IF (order >= 2) g(2) = -c0(z)/rr+c2(z)/r - IF (order >= 3) g(3) = 2.0_dp*c0(z)/(rr*r)-c2(z)/rr + g(0) = c0(z)*LOG(r) - c1(z) + c2(z)*r*LOG(r) - c3(z)*r + IF (order >= 1) g(1) = c0(z)/r + c2(z)*LOG(r) + c2(z) - c3(z) + IF (order >= 2) g(2) = -c0(z)/rr + c2(z)/r + IF (order >= 3) g(3) = 2.0_dp*c0(z)/(rr*r) - c2(z)/rr ELSE IF (r <= 100.0_dp) THEN - t3 = 1.0_dp+a1_*r - t11 = b1_*sr+b2_*r+b3_*rsr+b4_*rr + t3 = 1.0_dp + a1_*r + t11 = b1_*sr + b2_*r + b3_*rsr + b4_*rr t12 = t11**2 - t15 = 1.0_dp+0.5_dp/A_/t11 + t15 = 1.0_dp + 0.5_dp/A_/t11 t16 = LOG(t15) - t20 = 0.5_dp*b1_/sr+b2_+1.5_dp*b3_*sr+2.0_dp*b4_*r + t20 = 0.5_dp*b1_/sr + b2_ + 1.5_dp*b3_*sr + 2.0_dp*b4_*r ! order 0 must always be calculated g(0) = -2.0_dp*A_*t3*t16 IF (order >= 1) THEN - g(1) = -2.0_dp*A_*a1_*t16+t3*t20/(t12*t15) + g(1) = -2.0_dp*A_*a1_*t16 + t3*t20/(t12*t15) END IF IF (order >= 2) THEN - t40 = -0.25_dp*b1_/rsr+0.75_dp*b3_/sr+2.0_dp*b4_ + t40 = -0.25_dp*b1_/rsr + 0.75_dp*b3_/sr + 2.0_dp*b4_ g(2) = 2.0_dp*a1_*t20/(t12*t15) & - -2.0_dp*(t20**2)*t3/(t12*t11*t15) & - +t3*t40/(t12*t15) & - +0.5_dp*t3*(t20**2)/(A_*(t12**2)*(t15**2)) + - 2.0_dp*(t20**2)*t3/(t12*t11*t15) & + + t3*t40/(t12*t15) & + + 0.5_dp*t3*(t20**2)/(A_*(t12**2)*(t15**2)) END IF @@ -582,24 +582,24 @@ SUBROUTINE calc_g(r, z, g, order) g(3) = & -6.0_dp*a1_*t14*t22/t15 & - +3.0_dp*a1_*t40/(t15*t12) & - +1.5_dp*a1_*t45*t22*t48/A_ & - +6.0_dp*t55*t56/t15 & - -6.0_dp*t3*t14*t20*t40/t15 & - -3.0_dp*t3*t56*t48/(A_*t44*t11) & - +0.375_dp*t3*(b1_/(rr*sr)-b3_/rsr)/(t12*t15) & - +1.5_dp*t55*t40*t48*t20/A_ & - +0.5_dp*t3*t56/((A_**2)*t44*t12*t47*t15) + + 3.0_dp*a1_*t40/(t15*t12) & + + 1.5_dp*a1_*t45*t22*t48/A_ & + + 6.0_dp*t55*t56/t15 & + - 6.0_dp*t3*t14*t20*t40/t15 & + - 3.0_dp*t3*t56*t48/(A_*t44*t11) & + + 0.375_dp*t3*(b1_/(rr*sr) - b3_/rsr)/(t12*t15) & + + 1.5_dp*t55*t40*t48*t20/A_ & + + 0.5_dp*t3*t56/((A_**2)*t44*t12*t47*t15) END IF ELSE ! order 0 must always be calculated - g(0) = -d0(z)/r+d1(z)/rsr - IF (order >= 1) g(1) = d0(z)/rr-1.5_dp*d1(z)/(rsr*r) - IF (order >= 2) g(2) = -2.0_dp*d0(z)/(rr*r)+3.75_dp*d1(z)/(rsr*rr) - IF (order >= 3) g(3) = 6.0_dp*d0(z)/(rr*rr)-13.125_dp*d1(z)/(rsr*rr*r) + g(0) = -d0(z)/r + d1(z)/rsr + IF (order >= 1) g(1) = d0(z)/rr - 1.5_dp*d1(z)/(rsr*r) + IF (order >= 2) g(2) = -2.0_dp*d0(z)/(rr*r) + 3.75_dp*d1(z)/(rsr*rr) + IF (order >= 3) g(3) = 6.0_dp*d0(z)/(rr*rr) - 13.125_dp*d1(z)/(rsr*rr*r) END IF @@ -642,18 +642,18 @@ SUBROUTINE pw_lda_ed_loc(rho, ed, order) m = 0 IF (calc(0)) THEN ed(m) = e0(0) - m = m+1 + m = m + 1 END IF IF (calc(1)) THEN ed(m) = e0(1)*r(1) - m = m+1 + m = m + 1 END IF IF (calc(2)) THEN - ed(m) = e0(2)*r(1)**2+e0(1)*r(2) - m = m+1 + ed(m) = e0(2)*r(1)**2 + e0(1)*r(2) + m = m + 1 END IF IF (calc(3)) THEN - ed(m) = e0(3)*r(1)**3+e0(2)*3.0_dp*r(1)*r(2)+e0(1)*r(3) + ed(m) = e0(3)*r(1)**3 + e0(2)*3.0_dp*r(1)*r(2) + e0(1)*r(3) END IF END SUBROUTINE pw_lda_ed_loc @@ -688,7 +688,7 @@ SUBROUTINE pw_lsd_ed_loc(a, b, ed, order) calc(order_) = .TRUE. END IF - rho = a+b + rho = a + b CALL calc_fx(a, b, f(0:order_), order_) CALL calc_rs(rho, r(0)) @@ -701,35 +701,35 @@ SUBROUTINE pw_lsd_ed_loc(a, b, ed, order) IF (order_ >= 1) THEN r(1) = (-1.0_dp/3.0_dp)*r(0)/rho tr = e0(1) & - +fpp*ac(1)*f(0) & - -fpp*ac(1)*f(0)*z(0, 0)**4 & - +(e1(1)-e0(1))*f(0)*z(0, 0)**4 + + fpp*ac(1)*f(0) & + - fpp*ac(1)*f(0)*z(0, 0)**4 & + + (e1(1) - e0(1))*f(0)*z(0, 0)**4 tz = fpp*ac(0)*f(1) & - -fpp*ac(0)*f(1)*z(0, 0)**4 & - -fpp*ac(0)*f(0)*4.0_dp*z(0, 0)**3 & - +(e1(0)-e0(0))*f(1)*z(0, 0)**4 & - +(e1(0)-e0(0))*f(0)*4.0_dp*z(0, 0)**3 + - fpp*ac(0)*f(1)*z(0, 0)**4 & + - fpp*ac(0)*f(0)*4.0_dp*z(0, 0)**3 & + + (e1(0) - e0(0))*f(1)*z(0, 0)**4 & + + (e1(0) - e0(0))*f(0)*4.0_dp*z(0, 0)**3 END IF !! calculate second partial derivatives IF (order_ >= 2) THEN r(2) = (-4.0_dp/3.0_dp)*r(1)/rho trr = e0(2) & - +fpp*ac(2)*f(0) & - -fpp*ac(2)*f(0)*z(0, 0)**4 & - +(e1(2)-e0(2))*f(0)*z(0, 0)**4 + + fpp*ac(2)*f(0) & + - fpp*ac(2)*f(0)*z(0, 0)**4 & + + (e1(2) - e0(2))*f(0)*z(0, 0)**4 trz = fpp*ac(1)*f(1) & - -fpp*ac(1)*f(1)*z(0, 0)**4 & - -fpp*ac(1)*f(0)*4.0_dp*z(0, 0)**3 & - +(e1(1)-e0(1))*f(1)*z(0, 0)**4 & - +(e1(1)-e0(1))*f(0)*4.0_dp*z(0, 0)**3 + - fpp*ac(1)*f(1)*z(0, 0)**4 & + - fpp*ac(1)*f(0)*4.0_dp*z(0, 0)**3 & + + (e1(1) - e0(1))*f(1)*z(0, 0)**4 & + + (e1(1) - e0(1))*f(0)*4.0_dp*z(0, 0)**3 tzz = fpp*ac(0)*f(2) & - -fpp*ac(0)*f(2)*z(0, 0)**4 & - -fpp*ac(0)*f(1)*8.0_dp*z(0, 0)**3 & - -fpp*ac(0)*f(0)*12.0_dp*z(0, 0)**2 & - +(e1(0)-e0(0))*f(2)*z(0, 0)**4 & - +(e1(0)-e0(0))*f(1)*8.0_dp*z(0, 0)**3 & - +(e1(0)-e0(0))*f(0)*12.0_dp*z(0, 0)**2 + - fpp*ac(0)*f(2)*z(0, 0)**4 & + - fpp*ac(0)*f(1)*8.0_dp*z(0, 0)**3 & + - fpp*ac(0)*f(0)*12.0_dp*z(0, 0)**2 & + + (e1(0) - e0(0))*f(2)*z(0, 0)**4 & + + (e1(0) - e0(0))*f(1)*8.0_dp*z(0, 0)**3 & + + (e1(0) - e0(0))*f(0)*12.0_dp*z(0, 0)**2 END IF !! calculate third derivatives @@ -738,85 +738,85 @@ SUBROUTINE pw_lsd_ed_loc(a, b, ed, order) r(3) = (-7.0_dp/3.0_dp)*r(2)/rho trrr = e0(3) & - +fpp*ac(3)*f(0) & - -fpp*ac(3)*f(0)*z(0, 0)**4 & - +(e1(3)-e0(3))*f(0)*z(0, 0)**4 + + fpp*ac(3)*f(0) & + - fpp*ac(3)*f(0)*z(0, 0)**4 & + + (e1(3) - e0(3))*f(0)*z(0, 0)**4 trrz = fpp*ac(2)*f(1) & - -fpp*ac(2)*f(1)*z(0, 0)**4 & - -fpp*ac(2)*f(0)*4.0_dp*z(0, 0)**3 & - +(e1(2)-e0(2))*f(1)*z(0, 0)**4 & - +(e1(2)-e0(2))*f(0)*4.0_dp*z(0, 0)**3 + - fpp*ac(2)*f(1)*z(0, 0)**4 & + - fpp*ac(2)*f(0)*4.0_dp*z(0, 0)**3 & + + (e1(2) - e0(2))*f(1)*z(0, 0)**4 & + + (e1(2) - e0(2))*f(0)*4.0_dp*z(0, 0)**3 trzz = fpp*ac(1)*f(2) & - -fpp*ac(1)*f(2)*z(0, 0)**4 & - -fpp*ac(1)*f(1)*8.0_dp*z(0, 0)**3 & - -fpp*ac(1)*f(0)*12.0_dp*z(0, 0)**2 & - +(e1(1)-e0(1))*f(2)*z(0, 0)**4 & - +(e1(1)-e0(1))*f(1)*8.0_dp*z(0, 0)**3 & - +(e1(1)-e0(1))*f(0)*12.0_dp*z(0, 0)**2 + - fpp*ac(1)*f(2)*z(0, 0)**4 & + - fpp*ac(1)*f(1)*8.0_dp*z(0, 0)**3 & + - fpp*ac(1)*f(0)*12.0_dp*z(0, 0)**2 & + + (e1(1) - e0(1))*f(2)*z(0, 0)**4 & + + (e1(1) - e0(1))*f(1)*8.0_dp*z(0, 0)**3 & + + (e1(1) - e0(1))*f(0)*12.0_dp*z(0, 0)**2 tzzz = fpp*ac(0)*f(3) & - -fpp*ac(0)*f(3)*z(0, 0)**4 & - -fpp*ac(0)*f(2)*12.0_dp*z(0, 0)**3 & - -fpp*ac(0)*f(1)*36.0_dp*z(0, 0)**2 & - -fpp*ac(0)*f(0)*24.0_dp*z(0, 0) & - +(e1(0)-e0(0))*f(3)*z(0, 0)**4 & - +(e1(0)-e0(0))*f(2)*12.0_dp*z(0, 0)**3 & - +(e1(0)-e0(0))*f(1)*36.0_dp*z(0, 0)**2 & - +(e1(0)-e0(0))*f(0)*24.0_dp*z(0, 0) + - fpp*ac(0)*f(3)*z(0, 0)**4 & + - fpp*ac(0)*f(2)*12.0_dp*z(0, 0)**3 & + - fpp*ac(0)*f(1)*36.0_dp*z(0, 0)**2 & + - fpp*ac(0)*f(0)*24.0_dp*z(0, 0) & + + (e1(0) - e0(0))*f(3)*z(0, 0)**4 & + + (e1(0) - e0(0))*f(2)*12.0_dp*z(0, 0)**3 & + + (e1(0) - e0(0))*f(1)*36.0_dp*z(0, 0)**2 & + + (e1(0) - e0(0))*f(0)*24.0_dp*z(0, 0) END IF m = 0 IF (calc(0)) THEN ed(m) = e0(0) & - +fpp*ac(0)*f(0)*(1.0_dp-z(0, 0)**4) & - +(e1(0)-e0(0))*f(0)*z(0, 0)**4 - m = m+1 + + fpp*ac(0)*f(0)*(1.0_dp - z(0, 0)**4) & + + (e1(0) - e0(0))*f(0)*z(0, 0)**4 + m = m + 1 END IF IF (calc(1)) THEN - ed(m) = tr*r(1)+tz*z(1, 0) - ed(m+1) = tr*r(1)+tz*z(0, 1) - m = m+2 + ed(m) = tr*r(1) + tz*z(1, 0) + ed(m + 1) = tr*r(1) + tz*z(0, 1) + m = m + 2 END IF IF (calc(2)) THEN - ed(m) = trr*r(1)**2+2.0_dp*trz*r(1)*z(1, 0) & - +tr*r(2)+tzz*z(1, 0)**2+tz*z(2, 0) - ed(m+1) = trr*r(1)**2+trz*r(1)*(z(0, 1)+z(1, 0)) & - +tr*r(2)+tzz*z(1, 0)*z(0, 1)+tz*z(1, 1) - ed(m+2) = trr*r(1)**2+2.0_dp*trz*r(1)*z(0, 1) & - +tr*r(2)+tzz*z(0, 1)**2+tz*z(0, 2) - m = m+3 + ed(m) = trr*r(1)**2 + 2.0_dp*trz*r(1)*z(1, 0) & + + tr*r(2) + tzz*z(1, 0)**2 + tz*z(2, 0) + ed(m + 1) = trr*r(1)**2 + trz*r(1)*(z(0, 1) + z(1, 0)) & + + tr*r(2) + tzz*z(1, 0)*z(0, 1) + tz*z(1, 1) + ed(m + 2) = trr*r(1)**2 + 2.0_dp*trz*r(1)*z(0, 1) & + + tr*r(2) + tzz*z(0, 1)**2 + tz*z(0, 2) + m = m + 3 END IF IF (calc(3)) THEN ed(m) = & - trrr*r(1)**3+3.0_dp*trrz*r(1)**2*z(1, 0) & - +3.0_dp*trr*r(1)*r(2)+3.0_dp*trz*r(2)*z(1, 0)+tr*r(3) & - +3.0_dp*trzz*r(1)*z(1, 0)**2+tzzz*z(1, 0)**3 & - +3.0_dp*trz*r(1)*z(2, 0) & - +3.0_dp*tzz*z(1, 0)*z(2, 0)+tz*z(3, 0) - ed(m+1) = & - trrr*r(1)**3+trrz*r(1)**2*(2.0_dp*z(1, 0)+z(0, 1)) & - +2.0_dp*trzz*r(1)*z(1, 0)*z(0, 1) & - +2.0_dp*trz*(r(2)*z(1, 0)+r(1)*z(1, 1)) & - +3.0_dp*trr*r(2)*r(1)+trz*r(2)*z(0, 1)+tr*r(3) & - +trzz*r(1)*z(1, 0)**2+tzzz*z(1, 0)**2*z(0, 1) & - +2.0_dp*tzz*z(1, 0)*z(1, 1) & - +trz*r(1)*z(2, 0)+tzz*z(2, 0)*z(0, 1)+tz*z(2, 1) - ed(m+2) = & - trrr*r(1)**3+trrz*r(1)**2*(2.0_dp*z(0, 1)+z(1, 0)) & - +2.0_dp*trzz*r(1)*z(0, 1)*z(1, 0) & - +2.0_dp*trz*(r(2)*z(0, 1)+r(1)*z(1, 1)) & - +3.0_dp*trr*r(2)*r(1)+trz*r(2)*z(1, 0)+tr*r(3) & - +trzz*r(1)*z(0, 1)**2+tzzz*z(0, 1)**2*z(1, 0) & - +2.0_dp*tzz*z(0, 1)*z(1, 1) & - +trz*r(1)*z(0, 2)+tzz*z(0, 2)*z(1, 0)+tz*z(1, 2) - ed(m+3) = & - trrr*r(1)**3+3.0_dp*trrz*r(1)**2*z(0, 1) & - +3.0_dp*trr*r(1)*r(2)+3.0_dp*trz*r(2)*z(0, 1)+tr*r(3) & - +3.0_dp*trzz*r(1)*z(0, 1)**2+tzzz*z(0, 1)**3 & - +3.0_dp*trz*r(1)*z(0, 2) & - +3.0_dp*tzz*z(0, 1)*z(0, 2)+tz*z(0, 3) + trrr*r(1)**3 + 3.0_dp*trrz*r(1)**2*z(1, 0) & + + 3.0_dp*trr*r(1)*r(2) + 3.0_dp*trz*r(2)*z(1, 0) + tr*r(3) & + + 3.0_dp*trzz*r(1)*z(1, 0)**2 + tzzz*z(1, 0)**3 & + + 3.0_dp*trz*r(1)*z(2, 0) & + + 3.0_dp*tzz*z(1, 0)*z(2, 0) + tz*z(3, 0) + ed(m + 1) = & + trrr*r(1)**3 + trrz*r(1)**2*(2.0_dp*z(1, 0) + z(0, 1)) & + + 2.0_dp*trzz*r(1)*z(1, 0)*z(0, 1) & + + 2.0_dp*trz*(r(2)*z(1, 0) + r(1)*z(1, 1)) & + + 3.0_dp*trr*r(2)*r(1) + trz*r(2)*z(0, 1) + tr*r(3) & + + trzz*r(1)*z(1, 0)**2 + tzzz*z(1, 0)**2*z(0, 1) & + + 2.0_dp*tzz*z(1, 0)*z(1, 1) & + + trz*r(1)*z(2, 0) + tzz*z(2, 0)*z(0, 1) + tz*z(2, 1) + ed(m + 2) = & + trrr*r(1)**3 + trrz*r(1)**2*(2.0_dp*z(0, 1) + z(1, 0)) & + + 2.0_dp*trzz*r(1)*z(0, 1)*z(1, 0) & + + 2.0_dp*trz*(r(2)*z(0, 1) + r(1)*z(1, 1)) & + + 3.0_dp*trr*r(2)*r(1) + trz*r(2)*z(1, 0) + tr*r(3) & + + trzz*r(1)*z(0, 1)**2 + tzzz*z(0, 1)**2*z(1, 0) & + + 2.0_dp*tzz*z(0, 1)*z(1, 1) & + + trz*r(1)*z(0, 2) + tzz*z(0, 2)*z(1, 0) + tz*z(1, 2) + ed(m + 3) = & + trrr*r(1)**3 + 3.0_dp*trrz*r(1)**2*z(0, 1) & + + 3.0_dp*trr*r(1)*r(2) + 3.0_dp*trz*r(2)*z(0, 1) + tr*r(3) & + + 3.0_dp*trzz*r(1)*z(0, 1)**2 + tzzz*z(0, 1)**3 & + + 3.0_dp*trz*r(1)*z(0, 2) & + + 3.0_dp*tzz*z(0, 1)*z(0, 2) + tz*z(0, 3) END IF END SUBROUTINE pw_lsd_ed_loc diff --git a/src/xc/xc_perdew_zunger.F b/src/xc/xc_perdew_zunger.F index e06e3e74ce..7cb5e2a297 100644 --- a/src/xc/xc_perdew_zunger.F +++ b/src/xc/xc_perdew_zunger.F @@ -88,8 +88,8 @@ SUBROUTINE pz_info(method, lsd, reference, shortform, needs, max_deriv) //" Phys. Rev. B 23, 5048 (1981)" & //"["//TRIM(p_string)//"]" IF (.NOT. lsd) THEN - IF (LEN_TRIM(reference)+6 < LEN(reference)) THEN - reference(LEN_TRIM(reference):LEN_TRIM(reference)+6) = ' {LDA}' + IF (LEN_TRIM(reference) + 6 < LEN(reference)) THEN + reference(LEN_TRIM(reference):LEN_TRIM(reference) + 6) = ' {LDA}' END IF END IF END IF @@ -97,8 +97,8 @@ SUBROUTINE pz_info(method, lsd, reference, shortform, needs, max_deriv) shortform = "J. P. Perdew et al., PRB 23, 5048 (1981)" & //"["//TRIM(p_string)//"]" IF (.NOT. lsd) THEN - IF (LEN_TRIM(shortform)+6 < LEN(shortform)) THEN - shortform(LEN_TRIM(shortform):LEN_TRIM(shortform)+6) = ' {LDA}' + IF (LEN_TRIM(shortform) + 6 < LEN(shortform)) THEN + shortform(LEN_TRIM(shortform):LEN_TRIM(shortform) + 6) = ' {LDA}' END IF END IF END IF @@ -158,7 +158,7 @@ SUBROUTINE pz_lda_eval(method, rho_set, deriv_set, order, pz_params) CPASSERT(deriv_set%ref_count > 0) CALL xc_rho_set_get(rho_set, rho=rho, & local_bounds=bo, rho_cutoff=rho_cutoff) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) CALL pz_init(method, rho_cutoff) @@ -229,16 +229,16 @@ SUBROUTINE pz_lda_calc(rho, e_0, e_rho, e_rho_rho, e_rho_rho_rho, npoints, order CALL pz_lda_ed_loc(rho(k), ed, ABS(order), sc) IF (order >= 0) THEN - e_0(k) = e_0(k)+rho(k)*ed(0) + e_0(k) = e_0(k) + rho(k)*ed(0) END IF IF (order >= 1 .OR. order == -1) THEN - e_rho(k) = e_rho(k)+ed(0)+rho(k)*ed(1) + e_rho(k) = e_rho(k) + ed(0) + rho(k)*ed(1) END IF IF (order >= 2 .OR. order == -2) THEN - e_rho_rho(k) = e_rho_rho(k)+2.0_dp*ed(1)+rho(k)*ed(2) + e_rho_rho(k) = e_rho_rho(k) + 2.0_dp*ed(1) + rho(k)*ed(2) END IF IF (order >= 3 .OR. order == -3) THEN - e_rho_rho_rho(k) = e_rho_rho_rho(k)+3.0_dp*ed(2)+rho(k)*ed(3) + e_rho_rho_rho(k) = e_rho_rho_rho(k) + 3.0_dp*ed(2) + rho(k)*ed(3) END IF END IF @@ -292,7 +292,7 @@ SUBROUTINE pz_lsd_eval(method, rho_set, deriv_set, order, pz_params) CPASSERT(deriv_set%ref_count > 0) CALL xc_rho_set_get(rho_set, rhoa=a, rhob=b, & local_bounds=bo, rho_cutoff=rho_cutoff) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) CALL pz_init(method, rho_cutoff) @@ -385,32 +385,32 @@ SUBROUTINE pz_lsd_calc(a, b, e_0, ea, eaa, eab, ebb, eaaa, eaab, eabb, & !$OMP SHARED(order_,order,npoints,eps_rho,A,b,sc,e_0,ea,eaa,eab,ebb,eaaa,eaab,eabb,ebbb) DO k = 1, npoints - rho = a(k)+b(k) + rho = a(k) + b(k) IF (rho > eps_rho) THEN CALL pz_lsd_ed_loc(a(k), b(k), ed, order_, sc) IF (order >= 0) THEN - e_0(k) = e_0(k)+rho*ed(0) + e_0(k) = e_0(k) + rho*ed(0) END IF IF (order >= 1 .OR. order == -1) THEN - ea(k) = ea(k)+ed(0)+rho*ed(1) - ea(k) = ea(k)+ed(0)+rho*ed(2) + ea(k) = ea(k) + ed(0) + rho*ed(1) + ea(k) = ea(k) + ed(0) + rho*ed(2) END IF IF (order >= 2 .OR. order == -2) THEN - eaa(k) = eaa(k)+2.0_dp*ed(1)+rho*ed(3) - eab(k) = eab(k)+ed(1)+ed(2)+rho*ed(4) - ebb(k) = ebb(k)+2.0_dp*ed(2)+rho*ed(5) + eaa(k) = eaa(k) + 2.0_dp*ed(1) + rho*ed(3) + eab(k) = eab(k) + ed(1) + ed(2) + rho*ed(4) + ebb(k) = ebb(k) + 2.0_dp*ed(2) + rho*ed(5) END IF IF (order >= 3 .OR. order == -3) THEN - eaaa(k) = eaaa(k)+3.0_dp*ed(3)+rho*ed(6) - eaab(k) = eaab(k)+2.0_dp*ed(4)+ed(3)+rho*ed(7) - eabb(k) = eabb(k)+2.0_dp*ed(4)+ed(5)+rho*ed(8) - ebbb(k) = ebbb(k)+3.0_dp*ed(5)+rho*ed(9) + eaaa(k) = eaaa(k) + 3.0_dp*ed(3) + rho*ed(6) + eaab(k) = eaab(k) + 2.0_dp*ed(4) + ed(3) + rho*ed(7) + eabb(k) = eabb(k) + 2.0_dp*ed(4) + ed(5) + rho*ed(8) + ebbb(k) = ebbb(k) + 3.0_dp*ed(5) + rho*ed(9) END IF END IF @@ -502,42 +502,42 @@ SUBROUTINE calc_g(r, z, g, order) sr = SQRT(r) ! order 0 must always be calculated - g(0) = ga(z)/(1.0_dp+b1(z)*sr+b2(z)*r) + g(0) = ga(z)/(1.0_dp + b1(z)*sr + b2(z)*r) IF (order >= 1) THEN - g(1) = -ga(z)*(b1(z)/(2.0_dp*sr)+b2(z))/ & - (1.0_dp+b1(z)*sr+b2(z)*r)**2 + g(1) = -ga(z)*(b1(z)/(2.0_dp*sr) + b2(z))/ & + (1.0_dp + b1(z)*sr + b2(z)*r)**2 END IF IF (order >= 2) THEN rsr = r*sr g(2) = & - 2.0_dp*ga(z)*(b1(z)/(2.0_dp*sr)+b2(z))**2 & - /(1.0_dp+b1(z)*sr+b2(z)*r)**3 & - +ga(z)*b1(z) & - /(4.0_dp*(1.0_dp+b1(z)*sr+b2(z)*r)**2*rsr) + 2.0_dp*ga(z)*(b1(z)/(2.0_dp*sr) + b2(z))**2 & + /(1.0_dp + b1(z)*sr + b2(z)*r)**3 & + + ga(z)*b1(z) & + /(4.0_dp*(1.0_dp + b1(z)*sr + b2(z)*r)**2*rsr) END IF IF (order >= 3) THEN g(3) = & - -6.0_dp*ga(z)*(b1(z)/(2.0_dp*sr)+b2(z))**3/ & - (1.0_dp+b1(z)*sr+b2(z)*r)**4 & - -(3.0_dp/2.0_dp)*ga(z)*(b1(z)/(2.0_dp*sr)+b2(z))*b1(z)/ & - ((1.0_dp+b1(z)*sr+b2(z)*r)**3*rsr) & - -(3.0_dp/8.0_dp)*ga(z)*b1(z)/ & - ((1.0_dp+b1(z)*sr+b2(z)*r)**2*r*rsr) + -6.0_dp*ga(z)*(b1(z)/(2.0_dp*sr) + b2(z))**3/ & + (1.0_dp + b1(z)*sr + b2(z)*r)**4 & + - (3.0_dp/2.0_dp)*ga(z)*(b1(z)/(2.0_dp*sr) + b2(z))*b1(z)/ & + ((1.0_dp + b1(z)*sr + b2(z)*r)**3*rsr) & + - (3.0_dp/8.0_dp)*ga(z)*b1(z)/ & + ((1.0_dp + b1(z)*sr + b2(z)*r)**2*r*rsr) END IF ELSE ! order 0 must always be calculated - g(0) = A(z)*LOG(r)+B(z)+C(z)*r*LOG(r)+D(z)*r + g(0) = A(z)*LOG(r) + B(z) + C(z)*r*LOG(r) + D(z)*r IF (order >= 1) THEN - g(1) = A(z)/r+C(z)*LOG(r)+C(z)+D(z) + g(1) = A(z)/r + C(z)*LOG(r) + C(z) + D(z) END IF IF (order >= 2) THEN rr = r*r - g(2) = -A(z)/rr+C(z)/r + g(2) = -A(z)/rr + C(z)/r END IF IF (order >= 3) THEN - g(3) = 2.0_dp*A(z)/(rr*r)-C(z)/rr + g(3) = 2.0_dp*A(z)/(rr*r) - C(z)/rr END IF END IF @@ -582,18 +582,18 @@ SUBROUTINE pz_lda_ed_loc(rho, ed, order, sc) m = 0 IF (calc(0)) THEN ed(m) = sc*e0(0) - m = m+1 + m = m + 1 END IF IF (calc(1)) THEN ed(m) = sc*e0(1)*r(1) - m = m+1 + m = m + 1 END IF IF (calc(2)) THEN - ed(m) = sc*e0(2)*r(1)**2+sc*e0(1)*r(2) - m = m+1 + ed(m) = sc*e0(2)*r(1)**2 + sc*e0(1)*r(2) + m = m + 1 END IF IF (calc(3)) THEN - ed(m) = sc*e0(3)*r(1)**3+sc*e0(2)*3.0_dp*r(1)*r(2)+sc*e0(1)*r(3) + ed(m) = sc*e0(3)*r(1)**3 + sc*e0(2)*3.0_dp*r(1)*r(2) + sc*e0(1)*r(3) END IF END SUBROUTINE pz_lda_ed_loc @@ -632,7 +632,7 @@ SUBROUTINE pz_lsd_ed_loc(a, b, ed, order, sc) calc(order_) = .TRUE. END IF - rho = a+b + rho = a + b CALL calc_fx(a, b, f(0:order_), order_) CALL calc_rs(rho, r(0)) @@ -643,84 +643,84 @@ SUBROUTINE pz_lsd_ed_loc(a, b, ed, order, sc) !! calculate first partial derivatives IF (order_ >= 1) THEN r(1) = (-1.0_dp/3.0_dp)*r(0)/rho - tr = e0(1)+(e1(1)-e0(1))*f(0) - tz = (e1(0)-e0(0))*f(1) + tr = e0(1) + (e1(1) - e0(1))*f(0) + tz = (e1(0) - e0(0))*f(1) END IF !! calculate second partial derivatives IF (order_ >= 2) THEN r(2) = (-4.0_dp/3.0_dp)*r(1)/rho - trr = e0(2)+(e1(2)-e0(2))*f(0) - trz = (e1(1)-e0(1))*f(1) - tzz = (e1(0)-e0(0))*f(2) + trr = e0(2) + (e1(2) - e0(2))*f(0) + trz = (e1(1) - e0(1))*f(1) + tzz = (e1(0) - e0(0))*f(2) END IF !! calculate third derivatives IF (order_ >= 3) THEN r(3) = (-7.0_dp/3.0_dp)*r(2)/rho - trrr = e0(3)+(e1(3)-e0(3))*f(0) - trrz = (e1(2)-e0(2))*f(1) - trzz = (e1(1)-e0(1))*f(2) - tzzz = (e1(0)-e0(0))*f(3) + trrr = e0(3) + (e1(3) - e0(3))*f(0) + trrz = (e1(2) - e0(2))*f(1) + trzz = (e1(1) - e0(1))*f(2) + tzzz = (e1(0) - e0(0))*f(3) END IF m = 0 IF (calc(0)) THEN - ed(m) = e0(0)+(e1(0)-e0(0))*f(0) + ed(m) = e0(0) + (e1(0) - e0(0))*f(0) ed(m) = ed(m)*sc - m = m+1 + m = m + 1 END IF IF (calc(1)) THEN - ed(m) = tr*r(1)+tz*z(1, 0) + ed(m) = tr*r(1) + tz*z(1, 0) ed(m) = ed(m)*sc - ed(m+1) = tr*r(1)+tz*z(0, 1) - ed(m+1) = ed(m+1)*sc - m = m+2 + ed(m + 1) = tr*r(1) + tz*z(0, 1) + ed(m + 1) = ed(m + 1)*sc + m = m + 2 END IF IF (calc(2)) THEN - ed(m) = trr*r(1)**2+2.0_dp*trz*r(1)*z(1, 0) & - +tr*r(2)+tzz*z(1, 0)**2+tz*z(2, 0) + ed(m) = trr*r(1)**2 + 2.0_dp*trz*r(1)*z(1, 0) & + + tr*r(2) + tzz*z(1, 0)**2 + tz*z(2, 0) ed(m) = ed(m)*sc - ed(m+1) = trr*r(1)**2+trz*r(1)*(z(0, 1)+z(1, 0)) & - +tr*r(2)+tzz*z(1, 0)*z(0, 1)+tz*z(1, 1) - ed(m+1) = ed(m+1)*sc - ed(m+2) = trr*r(1)**2+2.0_dp*trz*r(1)*z(0, 1) & - +tr*r(2)+tzz*z(0, 1)**2+tz*z(0, 2) - ed(m+2) = ed(m+2)*sc - m = m+3 + ed(m + 1) = trr*r(1)**2 + trz*r(1)*(z(0, 1) + z(1, 0)) & + + tr*r(2) + tzz*z(1, 0)*z(0, 1) + tz*z(1, 1) + ed(m + 1) = ed(m + 1)*sc + ed(m + 2) = trr*r(1)**2 + 2.0_dp*trz*r(1)*z(0, 1) & + + tr*r(2) + tzz*z(0, 1)**2 + tz*z(0, 2) + ed(m + 2) = ed(m + 2)*sc + m = m + 3 END IF IF (calc(3)) THEN - ed(m) = trrr*r(1)**3+3.0_dp*trrz*r(1)**2*z(1, 0) & - +3.0_dp*trr*r(1)*r(2)+3.0_dp*trz*r(2)*z(1, 0) & - +tr*r(3)+3.0_dp*trzz*r(1)*z(1, 0)**2 & - +tzzz*z(1, 0)**3+3.0_dp*trz*r(1)*z(2, 0) & - +3.0_dp*tzz*z(1, 0)*z(2, 0)+tz*z(3, 0) + ed(m) = trrr*r(1)**3 + 3.0_dp*trrz*r(1)**2*z(1, 0) & + + 3.0_dp*trr*r(1)*r(2) + 3.0_dp*trz*r(2)*z(1, 0) & + + tr*r(3) + 3.0_dp*trzz*r(1)*z(1, 0)**2 & + + tzzz*z(1, 0)**3 + 3.0_dp*trz*r(1)*z(2, 0) & + + 3.0_dp*tzz*z(1, 0)*z(2, 0) + tz*z(3, 0) ed(m) = ed(m)*sc - ed(m+1) = trrr*r(1)**3+trrz*r(1)**2*(2.0_dp*z(1, 0)+z(0, 1)) & - +2.0_dp*trzz*r(1)*z(1, 0)*z(0, 1) & - +2.0_dp*trz*(r(2)*z(1, 0)+r(1)*z(1, 1)) & - +3.0_dp*trr*r(2)*r(1)+trz*r(2)*z(0, 1)+tr*r(3) & - +trzz*r(1)*z(1, 0)**2+tzzz*z(1, 0)**2*z(0, 1) & - +2.0_dp*tzz*z(1, 0)*z(1, 1) & - +trz*r(1)*z(2, 0)+tzz*z(2, 0)*z(0, 1)+tz*z(2, 1) - ed(m+1) = ed(m+1)*sc - ed(m+2) = trrr*r(1)**3+trrz*r(1)**2*(2.0_dp*z(0, 1)+z(1, 0)) & - +2.0_dp*trzz*r(1)*z(0, 1)*z(1, 0) & - +2.0_dp*trz*(r(2)*z(0, 1)+r(1)*z(1, 1)) & - +3.0_dp*trr*r(2)*r(1)+trz*r(2)*z(1, 0)+tr*r(3) & - +trzz*r(1)*z(0, 1)**2+tzzz*z(0, 1)**2*z(1, 0) & - +2.0_dp*tzz*z(0, 1)*z(1, 1) & - +trz*r(1)*z(0, 2)+tzz*z(0, 2)*z(1, 0)+tz*z(1, 2) - ed(m+2) = ed(m+2)*sc - ed(m+3) = trrr*r(1)**3+3.0_dp*trrz*r(1)**2*z(0, 1) & - +3.0_dp*trr*r(1)*r(2)+3.0_dp*trz*r(2)*z(0, 1)+tr*r(3) & - +3.0_dp*trzz*r(1)*z(0, 1)**2+tzzz*z(0, 1)**3 & - +3.0_dp*trz*r(1)*z(0, 2) & - +3.0_dp*tzz*z(0, 1)*z(0, 2)+tz*z(0, 3) - ed(m+3) = ed(m+3)*sc + ed(m + 1) = trrr*r(1)**3 + trrz*r(1)**2*(2.0_dp*z(1, 0) + z(0, 1)) & + + 2.0_dp*trzz*r(1)*z(1, 0)*z(0, 1) & + + 2.0_dp*trz*(r(2)*z(1, 0) + r(1)*z(1, 1)) & + + 3.0_dp*trr*r(2)*r(1) + trz*r(2)*z(0, 1) + tr*r(3) & + + trzz*r(1)*z(1, 0)**2 + tzzz*z(1, 0)**2*z(0, 1) & + + 2.0_dp*tzz*z(1, 0)*z(1, 1) & + + trz*r(1)*z(2, 0) + tzz*z(2, 0)*z(0, 1) + tz*z(2, 1) + ed(m + 1) = ed(m + 1)*sc + ed(m + 2) = trrr*r(1)**3 + trrz*r(1)**2*(2.0_dp*z(0, 1) + z(1, 0)) & + + 2.0_dp*trzz*r(1)*z(0, 1)*z(1, 0) & + + 2.0_dp*trz*(r(2)*z(0, 1) + r(1)*z(1, 1)) & + + 3.0_dp*trr*r(2)*r(1) + trz*r(2)*z(1, 0) + tr*r(3) & + + trzz*r(1)*z(0, 1)**2 + tzzz*z(0, 1)**2*z(1, 0) & + + 2.0_dp*tzz*z(0, 1)*z(1, 1) & + + trz*r(1)*z(0, 2) + tzz*z(0, 2)*z(1, 0) + tz*z(1, 2) + ed(m + 2) = ed(m + 2)*sc + ed(m + 3) = trrr*r(1)**3 + 3.0_dp*trrz*r(1)**2*z(0, 1) & + + 3.0_dp*trr*r(1)*r(2) + 3.0_dp*trz*r(2)*z(0, 1) + tr*r(3) & + + 3.0_dp*trzz*r(1)*z(0, 1)**2 + tzzz*z(0, 1)**3 & + + 3.0_dp*trz*r(1)*z(0, 2) & + + 3.0_dp*tzz*z(0, 1)*z(0, 2) + tz*z(0, 3) + ed(m + 3) = ed(m + 3)*sc END IF END SUBROUTINE pz_lsd_ed_loc diff --git a/src/xc/xc_rho_set_types.F b/src/xc/xc_rho_set_types.F index 3b4d400d56..dfdf4d49b5 100644 --- a/src/xc/xc_rho_set_types.F +++ b/src/xc/xc_rho_set_types.F @@ -131,7 +131,7 @@ SUBROUTINE xc_rho_set_create(rho_set, local_bounds, rho_cutoff, drho_cutoff, & CPASSERT(.NOT. ASSOCIATED(rho_set)) ALLOCATE (rho_set) rho_set%ref_count = 1 - last_rho_set_id = last_rho_set_id+1 + last_rho_set_id = last_rho_set_id + 1 rho_set%id_nr = last_rho_set_id rho_set%rho_cutoff = EPSILON(0.0_dp) IF (PRESENT(rho_cutoff)) rho_set%rho_cutoff = rho_cutoff @@ -169,7 +169,7 @@ SUBROUTINE xc_rho_set_retain(rho_set) CPASSERT(ASSOCIATED(rho_set)) CPASSERT(rho_set%ref_count > 0) - rho_set%ref_count = rho_set%ref_count+1 + rho_set%ref_count = rho_set%ref_count + 1 END SUBROUTINE xc_rho_set_retain ! ************************************************************************************************** @@ -188,7 +188,7 @@ SUBROUTINE xc_rho_set_release(rho_set, pw_pool) IF (ASSOCIATED(rho_set)) THEN CPASSERT(rho_set%ref_count > 0) - rho_set%ref_count = rho_set%ref_count-1 + rho_set%ref_count = rho_set%ref_count - 1 IF (rho_set%ref_count == 0) THEN IF (PRESENT(pw_pool)) THEN IF (ASSOCIATED(pw_pool)) THEN @@ -863,8 +863,8 @@ SUBROUTINE xc_rho_set_update(rho_set, rho_r, rho_g, tau, needs, & DO j = rho_set%local_bounds(1, 2), rho_set%local_bounds(2, 2) DO i = rho_set%local_bounds(1, 1), rho_set%local_bounds(2, 1) rho_set%norm_drho(i, j, k) = SQRT( & - drho_r(1, 1)%pw%cr3d(i, j, k)**2+ & - drho_r(2, 1)%pw%cr3d(i, j, k)**2+ & + drho_r(1, 1)%pw%cr3d(i, j, k)**2 + & + drho_r(2, 1)%pw%cr3d(i, j, k)**2 + & drho_r(3, 1)%pw%cr3d(i, j, k)**2) END DO END DO @@ -879,8 +879,8 @@ SUBROUTINE xc_rho_set_update(rho_set, rho_r, rho_g, tau, needs, & DO j = rho_set%local_bounds(1, 2), rho_set%local_bounds(2, 2) DO i = rho_set%local_bounds(1, 1), rho_set%local_bounds(2, 1) rho_set%laplace_rho(i, j, k) = & - laplace_rho_r(1, 1)%pw%cr3d(i, j, k)+ & - laplace_rho_r(2, 1)%pw%cr3d(i, j, k)+ & + laplace_rho_r(1, 1)%pw%cr3d(i, j, k) + & + laplace_rho_r(2, 1)%pw%cr3d(i, j, k) + & laplace_rho_r(3, 1)%pw%cr3d(i, j, k) END DO END DO @@ -908,7 +908,7 @@ SUBROUTINE xc_rho_set_update(rho_set, rho_r, rho_g, tau, needs, & DO k = rho_set%local_bounds(1, 3), rho_set%local_bounds(2, 3) DO j = rho_set%local_bounds(1, 2), rho_set%local_bounds(2, 2) DO i = rho_set%local_bounds(1, 1), rho_set%local_bounds(2, 1) - rho_set%rho(i, j, k) = my_rho_r(1)%pw%cr3d(i, j, k)+ & + rho_set%rho(i, j, k) = my_rho_r(1)%pw%cr3d(i, j, k) + & my_rho_r(2)%pw%cr3d(i, j, k) END DO END DO @@ -923,7 +923,7 @@ SUBROUTINE xc_rho_set_update(rho_set, rho_r, rho_g, tau, needs, & DO k = rho_set%local_bounds(1, 3), rho_set%local_bounds(2, 3) DO j = rho_set%local_bounds(1, 2), rho_set%local_bounds(2, 2) DO i = rho_set%local_bounds(1, 1), rho_set%local_bounds(2, 1) - rho_set%rho_1_3(i, j, k) = MAX(my_rho_r(1)%pw%cr3d(i, j, k)+ & + rho_set%rho_1_3(i, j, k) = MAX(my_rho_r(1)%pw%cr3d(i, j, k) + & my_rho_r(2)%pw%cr3d(i, j, k), 0.0_dp)**f13 END DO END DO @@ -974,9 +974,9 @@ SUBROUTINE xc_rho_set_update(rho_set, rho_r, rho_g, tau, needs, & DO j = rho_set%local_bounds(1, 2), rho_set%local_bounds(2, 2) DO i = rho_set%local_bounds(1, 1), rho_set%local_bounds(2, 1) rho_set%norm_drho(i, j, k) = SQRT( & - (drho_r(1, 1)%pw%cr3d(i, j, k)+drho_r(1, 2)%pw%cr3d(i, j, k))**2+ & - (drho_r(2, 1)%pw%cr3d(i, j, k)+drho_r(2, 2)%pw%cr3d(i, j, k))**2+ & - (drho_r(3, 1)%pw%cr3d(i, j, k)+drho_r(3, 2)%pw%cr3d(i, j, k))**2) + (drho_r(1, 1)%pw%cr3d(i, j, k) + drho_r(1, 2)%pw%cr3d(i, j, k))**2 + & + (drho_r(2, 1)%pw%cr3d(i, j, k) + drho_r(2, 2)%pw%cr3d(i, j, k))**2 + & + (drho_r(3, 1)%pw%cr3d(i, j, k) + drho_r(3, 2)%pw%cr3d(i, j, k))**2) END DO END DO END DO @@ -992,8 +992,8 @@ SUBROUTINE xc_rho_set_update(rho_set, rho_r, rho_g, tau, needs, & DO j = rho_set%local_bounds(1, 2), rho_set%local_bounds(2, 2) DO i = rho_set%local_bounds(1, 1), rho_set%local_bounds(2, 1) rho_set%norm_drhoa(i, j, k) = SQRT( & - drho_r(1, 1)%pw%cr3d(i, j, k)**2+ & - drho_r(2, 1)%pw%cr3d(i, j, k)**2+ & + drho_r(1, 1)%pw%cr3d(i, j, k)**2 + & + drho_r(2, 1)%pw%cr3d(i, j, k)**2 + & drho_r(3, 1)%pw%cr3d(i, j, k)**2) END DO END DO @@ -1006,8 +1006,8 @@ SUBROUTINE xc_rho_set_update(rho_set, rho_r, rho_g, tau, needs, & DO j = rho_set%local_bounds(1, 2), rho_set%local_bounds(2, 2) DO i = rho_set%local_bounds(1, 1), rho_set%local_bounds(2, 1) rho_set%norm_drhob(i, j, k) = SQRT( & - drho_r(1, 2)%pw%cr3d(i, j, k)**2+ & - drho_r(2, 2)%pw%cr3d(i, j, k)**2+ & + drho_r(1, 2)%pw%cr3d(i, j, k)**2 + & + drho_r(2, 2)%pw%cr3d(i, j, k)**2 + & drho_r(3, 2)%pw%cr3d(i, j, k)**2) END DO END DO @@ -1023,8 +1023,8 @@ SUBROUTINE xc_rho_set_update(rho_set, rho_r, rho_g, tau, needs, & DO j = rho_set%local_bounds(1, 2), rho_set%local_bounds(2, 2) DO i = rho_set%local_bounds(1, 1), rho_set%local_bounds(2, 1) rho_set%laplace_rhoa(i, j, k) = & - laplace_rho_r(1, 1)%pw%cr3d(i, j, k)+ & - laplace_rho_r(2, 1)%pw%cr3d(i, j, k)+ & + laplace_rho_r(1, 1)%pw%cr3d(i, j, k) + & + laplace_rho_r(2, 1)%pw%cr3d(i, j, k) + & laplace_rho_r(3, 1)%pw%cr3d(i, j, k) END DO END DO @@ -1037,8 +1037,8 @@ SUBROUTINE xc_rho_set_update(rho_set, rho_r, rho_g, tau, needs, & DO j = rho_set%local_bounds(1, 2), rho_set%local_bounds(2, 2) DO i = rho_set%local_bounds(1, 1), rho_set%local_bounds(2, 1) rho_set%laplace_rhob(i, j, k) = & - laplace_rho_r(1, 2)%pw%cr3d(i, j, k)+ & - laplace_rho_r(2, 2)%pw%cr3d(i, j, k)+ & + laplace_rho_r(1, 2)%pw%cr3d(i, j, k) + & + laplace_rho_r(2, 2)%pw%cr3d(i, j, k) + & laplace_rho_r(3, 2)%pw%cr3d(i, j, k) END DO END DO @@ -1054,8 +1054,8 @@ SUBROUTINE xc_rho_set_update(rho_set, rho_r, rho_g, tau, needs, & DO j = rho_set%local_bounds(1, 2), rho_set%local_bounds(2, 2) DO i = rho_set%local_bounds(1, 1), rho_set%local_bounds(2, 1) rho_set%drhoa_drhob(i, j, k) = & - drho_r(1, 1)%pw%cr3d(i, j, k)*drho_r(1, 2)%pw%cr3d(i, j, k)+ & - drho_r(2, 1)%pw%cr3d(i, j, k)*drho_r(2, 2)%pw%cr3d(i, j, k)+ & + drho_r(1, 1)%pw%cr3d(i, j, k)*drho_r(1, 2)%pw%cr3d(i, j, k) + & + drho_r(2, 1)%pw%cr3d(i, j, k)*drho_r(2, 2)%pw%cr3d(i, j, k) + & drho_r(3, 1)%pw%cr3d(i, j, k)*drho_r(3, 2)%pw%cr3d(i, j, k) END DO END DO @@ -1074,7 +1074,7 @@ SUBROUTINE xc_rho_set_update(rho_set, rho_r, rho_g, tau, needs, & DO j = rho_set%local_bounds(1, 2), rho_set%local_bounds(2, 2) DO i = rho_set%local_bounds(1, 1), rho_set%local_bounds(2, 1) rho_set%drho(idir)%array(i, j, k) = & - drho_r(idir, 1)%pw%cr3d(i, j, k)+ & + drho_r(idir, 1)%pw%cr3d(i, j, k) + & drho_r(idir, 2)%pw%cr3d(i, j, k) END DO END DO @@ -1129,7 +1129,7 @@ SUBROUTINE xc_rho_set_update(rho_set, rho_r, rho_g, tau, needs, & DO i = rho_set%local_bounds(1, 1), rho_set%local_bounds(2, 1) rho_set%tau(i, j, k) = & - tau(1)%pw%cr3d(i, j, k)+ & + tau(1)%pw%cr3d(i, j, k) + & tau(2)%pw%cr3d(i, j, k) END DO END DO diff --git a/src/xc/xc_tfw.F b/src/xc/xc_tfw.F index 9d37966300..97afd37477 100644 --- a/src/xc/xc_tfw.F +++ b/src/xc/xc_tfw.F @@ -146,7 +146,7 @@ SUBROUTINE tfw_lda_eval(rho_set, deriv_set, order) CPASSERT(deriv_set%ref_count > 0) CALL xc_rho_set_get(rho_set, rho_1_3=r13, rho=rho, & norm_drho=grho, local_bounds=bo, rho_cutoff=epsilon_rho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) CALL tfw_init(epsilon_rho) ALLOCATE (s(npoints)) @@ -272,7 +272,7 @@ SUBROUTINE tfw_lsd_eval(rho_set, deriv_set, order) rhob=rho(2)%array, norm_drhoa=norm_drho(1)%array, & norm_drhob=norm_drho(2)%array, rho_cutoff=epsilon_rho, & local_bounds=bo) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) CALL tfw_init(epsilon_rho) ALLOCATE (s(npoints)) @@ -363,7 +363,7 @@ SUBROUTINE tfw_u_0(rho, r13, s, e_0, npoints) IF (rho(ip) > eps_rho) THEN - e_0(ip) = e_0(ip)+flda*r13(ip)*r13(ip)*rho(ip)+fvw*s(ip) + e_0(ip) = e_0(ip) + flda*r13(ip)*r13(ip)*rho(ip) + fvw*s(ip) END IF @@ -398,8 +398,8 @@ SUBROUTINE tfw_u_1(rho, grho, r13, s, e_rho, e_ndrho, npoints) IF (rho(ip) > eps_rho) THEN - e_rho(ip) = e_rho(ip)+f*r13(ip)*r13(ip)-fvw*s(ip)/rho(ip) - e_ndrho(ip) = e_ndrho(ip)+2.0_dp*fvw*grho(ip)/rho(ip) + e_rho(ip) = e_rho(ip) + f*r13(ip)*r13(ip) - fvw*s(ip)/rho(ip) + e_ndrho(ip) = e_ndrho(ip) + 2.0_dp*fvw*grho(ip)/rho(ip) END IF @@ -436,9 +436,9 @@ SUBROUTINE tfw_u_2(rho, grho, r13, s, e_rho_rho, e_rho_ndrho, e_ndrho_ndrho, & IF (rho(ip) > eps_rho) THEN - e_rho_rho(ip) = e_rho_rho(ip)+f/r13(ip)+2.0_dp*fvw*s(ip)/(rho(ip)*rho(ip)) - e_rho_ndrho(ip) = e_rho_ndrho(ip)-2.0_dp*fvw*grho(ip)/(rho(ip)*rho(ip)) - e_ndrho_ndrho(ip) = e_ndrho_ndrho(ip)+2.0_dp*fvw/rho(ip) + e_rho_rho(ip) = e_rho_rho(ip) + f/r13(ip) + 2.0_dp*fvw*s(ip)/(rho(ip)*rho(ip)) + e_rho_ndrho(ip) = e_rho_ndrho(ip) - 2.0_dp*fvw*grho(ip)/(rho(ip)*rho(ip)) + e_ndrho_ndrho(ip) = e_ndrho_ndrho(ip) + 2.0_dp*fvw/rho(ip) END IF @@ -476,12 +476,12 @@ SUBROUTINE tfw_u_3(rho, grho, r13, s, e_rho_rho_rho, e_rho_rho_ndrho, & IF (rho(ip) > eps_rho) THEN - e_rho_rho_rho(ip) = e_rho_rho_rho(ip)+f/(r13(ip)*rho(ip)) & - -6.0_dp*fvw*s(ip)/(rho(ip)*rho(ip)*rho(ip)) + e_rho_rho_rho(ip) = e_rho_rho_rho(ip) + f/(r13(ip)*rho(ip)) & + - 6.0_dp*fvw*s(ip)/(rho(ip)*rho(ip)*rho(ip)) e_rho_rho_ndrho(ip) = e_rho_rho_ndrho(ip) & - +4.0_dp*fvw*grho(ip)/(rho(ip)*rho(ip)*rho(ip)) + + 4.0_dp*fvw*grho(ip)/(rho(ip)*rho(ip)*rho(ip)) e_rho_ndrho_ndrho(ip) = e_rho_ndrho_ndrho(ip) & - -2.0_dp*fvw/(rho(ip)*rho(ip)) + - 2.0_dp*fvw/(rho(ip)*rho(ip)) END IF END DO @@ -509,7 +509,7 @@ SUBROUTINE tfw_p_0(rhoa, r13a, sa, e_0, npoints) DO ip = 1, npoints IF (rhoa(ip) > eps_rho) THEN - e_0(ip) = e_0(ip)+flsd*r13a(ip)*r13a(ip)*rhoa(ip)+fvw*sa(ip) + e_0(ip) = e_0(ip) + flsd*r13a(ip)*r13a(ip)*rhoa(ip) + fvw*sa(ip) END IF END DO @@ -542,8 +542,8 @@ SUBROUTINE tfw_p_1(rhoa, grhoa, r13a, sa, e_rho, e_ndrho, npoints) DO ip = 1, npoints IF (rhoa(ip) > eps_rho) THEN - e_rho(ip) = e_rho(ip)+f*r13a(ip)*r13a(ip)-fvw*sa(ip)/rhoa(ip) - e_ndrho(ip) = e_ndrho(ip)+2.0_dp*fvw*grhoa(ip)/rhoa(ip) + e_rho(ip) = e_rho(ip) + f*r13a(ip)*r13a(ip) - fvw*sa(ip)/rhoa(ip) + e_ndrho(ip) = e_ndrho(ip) + 2.0_dp*fvw*grhoa(ip)/rhoa(ip) END IF END DO @@ -579,10 +579,10 @@ SUBROUTINE tfw_p_2(rhoa, grhoa, r13a, sa, e_rho_rho, e_rho_ndrho, & IF (rhoa(ip) > eps_rho) THEN e_rho_rho(ip) = e_rho_rho(ip) & - +f/r13a(ip)+2.0_dp*fvw*sa(ip)/(rhoa(ip)*rhoa(ip)) + + f/r13a(ip) + 2.0_dp*fvw*sa(ip)/(rhoa(ip)*rhoa(ip)) e_rho_ndrho(ip) = e_rho_ndrho(ip) & - -2.0_dp*fvw*grhoa(ip)/(rhoa(ip)*rhoa(ip)) - e_ndrho_ndrho(ip) = e_ndrho_ndrho(ip)+2.0_dp*fvw/rhoa(ip) + - 2.0_dp*fvw*grhoa(ip)/(rhoa(ip)*rhoa(ip)) + e_ndrho_ndrho(ip) = e_ndrho_ndrho(ip) + 2.0_dp*fvw/rhoa(ip) END IF END DO @@ -619,12 +619,12 @@ SUBROUTINE tfw_p_3(rhoa, grhoa, r13a, sa, e_rho_rho_rho, e_rho_rho_ndrho, & IF (rhoa(ip) > eps_rho) THEN e_rho_rho_rho(ip) = e_rho_rho_rho(ip) & - +f/(r13a(ip)*rhoa(ip)) & - -6.0_dp*fvw*sa(ip)/(rhoa(ip)*rhoa(ip)*rhoa(ip)) + + f/(r13a(ip)*rhoa(ip)) & + - 6.0_dp*fvw*sa(ip)/(rhoa(ip)*rhoa(ip)*rhoa(ip)) e_rho_rho_ndrho(ip) = e_rho_rho_ndrho(ip) & - +4.0_dp*fvw*grhoa(ip)/(rhoa(ip)*rhoa(ip)*rhoa(ip)) + + 4.0_dp*fvw*grhoa(ip)/(rhoa(ip)*rhoa(ip)*rhoa(ip)) e_rho_ndrho_ndrho(ip) = e_rho_ndrho_ndrho(ip) & - -2.0_dp*fvw/(rhoa(ip)*rhoa(ip)) + - 2.0_dp*fvw/(rhoa(ip)*rhoa(ip)) END IF END DO diff --git a/src/xc/xc_thomas_fermi.F b/src/xc/xc_thomas_fermi.F index c70be6ae4e..2f76d98a06 100644 --- a/src/xc/xc_thomas_fermi.F +++ b/src/xc/xc_thomas_fermi.F @@ -81,16 +81,16 @@ SUBROUTINE thomas_fermi_info(lsd, reference, shortform, needs, max_deriv) IF (PRESENT(reference)) THEN reference = "Thomas-Fermi kinetic energy functional: see Parr and Yang" IF (.NOT. lsd) THEN - IF (LEN_TRIM(reference)+6 < LEN(reference)) THEN - reference(LEN_TRIM(reference):LEN_TRIM(reference)+6) = ' {LDA}' + IF (LEN_TRIM(reference) + 6 < LEN(reference)) THEN + reference(LEN_TRIM(reference):LEN_TRIM(reference) + 6) = ' {LDA}' END IF END IF END IF IF (PRESENT(shortform)) THEN shortform = "Thomas-Fermi kinetic energy functional" IF (.NOT. lsd) THEN - IF (LEN_TRIM(shortform)+6 < LEN(shortform)) THEN - shortform(LEN_TRIM(shortform):LEN_TRIM(shortform)+6) = ' {LDA}' + IF (LEN_TRIM(shortform) + 6 < LEN(shortform)) THEN + shortform(LEN_TRIM(shortform):LEN_TRIM(shortform) + 6) = ' {LDA}' END IF END IF END IF @@ -137,7 +137,7 @@ SUBROUTINE thomas_fermi_lda_eval(rho_set, deriv_set, order) CPASSERT(deriv_set%ref_count > 0) CALL xc_rho_set_get(rho_set, rho_1_3=r13, rho=rho, & local_bounds=bo, rho_cutoff=epsilon_rho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) CALL thomas_fermi_init(epsilon_rho) IF (order >= 0) THEN @@ -212,7 +212,7 @@ SUBROUTINE thomas_fermi_lsd_eval(rho_set, deriv_set, order) rhob=rho(2)%array, & rho_cutoff=epsilon_rho, & local_bounds=bo) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) CALL thomas_fermi_init(epsilon_rho) DO ispin = 1, 2 @@ -277,7 +277,7 @@ SUBROUTINE thomas_fermi_lda_0(rho, r13, e_0, npoints) IF (rho(ip) > eps_rho) THEN - e_0(ip) = e_0(ip)+flda*r13(ip)*r13(ip)*rho(ip) + e_0(ip) = e_0(ip) + flda*r13(ip)*r13(ip)*rho(ip) END IF @@ -309,7 +309,7 @@ SUBROUTINE thomas_fermi_lda_1(rho, r13, e_rho, npoints) IF (rho(ip) > eps_rho) THEN - e_rho(ip) = e_rho(ip)+f*r13(ip)*r13(ip) + e_rho(ip) = e_rho(ip) + f*r13(ip)*r13(ip) END IF @@ -341,7 +341,7 @@ SUBROUTINE thomas_fermi_lda_2(rho, r13, e_rho_rho, npoints) IF (rho(ip) > eps_rho) THEN - e_rho_rho(ip) = e_rho_rho(ip)+f/r13(ip) + e_rho_rho(ip) = e_rho_rho(ip) + f/r13(ip) END IF @@ -373,7 +373,7 @@ SUBROUTINE thomas_fermi_lda_3(rho, r13, e_rho_rho_rho, npoints) IF (rho(ip) > eps_rho) THEN - e_rho_rho_rho(ip) = e_rho_rho_rho(ip)+f/(r13(ip)*rho(ip)) + e_rho_rho_rho(ip) = e_rho_rho_rho(ip) + f/(r13(ip)*rho(ip)) END IF @@ -401,7 +401,7 @@ SUBROUTINE thomas_fermi_lsd_0(rhoa, r13a, e_0, npoints) DO ip = 1, npoints IF (rhoa(ip) > eps_rho) THEN - e_0(ip) = e_0(ip)+flsd*r13a(ip)*r13a(ip)*rhoa(ip) + e_0(ip) = e_0(ip) + flsd*r13a(ip)*r13a(ip)*rhoa(ip) END IF END DO @@ -431,7 +431,7 @@ SUBROUTINE thomas_fermi_lsd_1(rhoa, r13a, e_rho, npoints) DO ip = 1, npoints IF (rhoa(ip) > eps_rho) THEN - e_rho(ip) = e_rho(ip)+f*r13a(ip)*r13a(ip) + e_rho(ip) = e_rho(ip) + f*r13a(ip)*r13a(ip) END IF END DO @@ -462,7 +462,7 @@ SUBROUTINE thomas_fermi_lsd_2(rhoa, r13a, e_rho_rho, npoints) DO ip = 1, npoints IF (rhoa(ip) > eps_rho) THEN - e_rho_rho(ip) = e_rho_rho(ip)+f/r13a(ip) + e_rho_rho(ip) = e_rho_rho(ip) + f/r13a(ip) END IF END DO @@ -492,7 +492,7 @@ SUBROUTINE thomas_fermi_lsd_3(rhoa, r13a, e_rho_rho_rho, npoints) DO ip = 1, npoints IF (rhoa(ip) > eps_rho) THEN - e_rho_rho_rho(ip) = e_rho_rho_rho(ip)+f/(r13a(ip)*rhoa(ip)) + e_rho_rho_rho(ip) = e_rho_rho_rho(ip) + f/(r13a(ip)*rhoa(ip)) END IF END DO diff --git a/src/xc/xc_tpss.F b/src/xc/xc_tpss.F index 2850418ed3..c12b176b63 100644 --- a/src/xc/xc_tpss.F +++ b/src/xc/xc_tpss.F @@ -182,7 +182,7 @@ SUBROUTINE tpss_lda_eval(rho_set, deriv_set, grad_deriv, tpss_params) CALL xc_rho_set_get(rho_set, rho=rho, & norm_drho=norm_drho, local_bounds=bo, rho_cutoff=epsilon_rho, & tau=tau, tau_cutoff=epsilon_tau) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rho @@ -273,7 +273,7 @@ SUBROUTINE tpss_lsd_eval(rho_set, deriv_set, grad_deriv, tpss_params) CALL xc_rho_set_get(rho_set, rhoa=rhoa, rhob=rhob, norm_drhoa=norm_drhoa, & norm_drhob=norm_drhob, norm_drho=norm_drho, tau_a=tau_a, tau_b=tau_b, & local_bounds=bo, rho_cutoff=epsilon_rho, tau_cutoff=epsilon_tau) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rhoa @@ -415,12 +415,12 @@ SUBROUTINE tpss_lda_calc(rho, norm_drho, tau, e_0, e_rho, e_ndrho, e_tau, & my_rho = rho(ii) my_ndrho = norm_drho(ii) IF (grad_deriv >= 0) THEN - e_0(ii) = e_0(ii)+my_tau*my_ndrho*my_rho + e_0(ii) = e_0(ii) + my_tau*my_ndrho*my_rho END IF IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN - e_rho(ii) = e_rho(ii)+my_tau*my_ndrho - e_ndrho(ii) = e_ndrho(ii)+my_tau*my_rho - e_tau(ii) = e_tau(ii)+my_rho*my_ndrho + e_rho(ii) = e_rho(ii) + my_tau*my_ndrho + e_ndrho(ii) = e_ndrho(ii) + my_tau*my_rho + e_tau(ii) = e_tau(ii) + my_rho*my_ndrho ENDIF ENDDO !$OMP END DO @@ -432,7 +432,7 @@ SUBROUTINE tpss_lda_calc(rho, norm_drho, tau, e_0, e_rho, e_ndrho, e_tau, & kappa = 0.804e0_dp beta = 0.66725e-1_dp mu = 0.21951e0_dp - gamma_var = (0.1e1_dp-LOG(0.2e1_dp))/pi**2 + gamma_var = (0.1e1_dp - LOG(0.2e1_dp))/pi**2 b = 0.4e0_dp c = 0.159096e1_dp e_var = 0.1537e1_dp @@ -475,11 +475,11 @@ SUBROUTINE tpss_lda_calc(rho, norm_drho, tau, e_0, e_rho, e_ndrho, e_tau, & IF (my_tau < tau_w) THEN ! enforce z=norm_rho**2/(8._dp*rho*tau) <1 - m = 0.5_dp*t254+4.0_dp*my_rho*my_tau + m = 0.5_dp*t254 + 4.0_dp*my_rho*my_tau my_tau = m/8._dp/my_rho my_ndrho = SQRT(m) t254 = m - non_coer = non_coer+1 + non_coer = non_coer + 1 END IF t9 = (t6*t7)**(0.1e1_dp/0.3e1_dp) @@ -506,45 +506,45 @@ SUBROUTINE tpss_lda_calc(rho, norm_drho, tau, e_0, e_rho, e_ndrho, e_tau, & t35 = 0.1e1_dp/A_1 t36 = SQRT(rs_s2) t39 = t36*rs_s2 - t41 = p_1+0.1e1_dp + t41 = p_1 + 0.1e1_dp t42 = rs_s2**t41 - t49 = LOG(0.1e1_dp+t35/(beta_1_1*t36+beta_2_1*rs_s2+ & - beta_3_1*t39+beta_4_1*t42)/0.2e1_dp) + t49 = LOG(0.1e1_dp + t35/(beta_1_1*t36 + beta_2_1*rs_s2 + & + beta_3_1*t39 + beta_4_1*t42)/0.2e1_dp) t55 = SQRT(rs_s1) t58 = t55*rs_s1 t60 = rs_s1**t41 - t67 = LOG(0.1e1_dp+t35/(beta_1_1*t55+beta_2_1*rs_s1+ & - beta_3_1*t58+beta_4_1*t60)/0.2e1_dp) - t71 = 0.1e1_dp+alpha_1_2*rs_s2 + t67 = LOG(0.1e1_dp + t35/(beta_1_1*t55 + beta_2_1*rs_s1 + & + beta_3_1*t58 + beta_4_1*t60)/0.2e1_dp) + t71 = 0.1e1_dp + alpha_1_2*rs_s2 t73 = 0.1e1_dp/A_2 - t77 = p_2+0.1e1_dp + t77 = p_2 + 0.1e1_dp t78 = rs_s2**t77 t79 = beta_4_2*t78 - t80 = beta_1_2*t36+beta_2_2*rs_s2+beta_3_2*t39+t79 - t84 = 0.1e1_dp+t73/t80/0.2e1_dp + t80 = beta_1_2*t36 + beta_2_2*rs_s2 + beta_3_2*t39 + t79 + t84 = 0.1e1_dp + t73/t80/0.2e1_dp t85 = LOG(t84) e_c_u_1_s2 = -0.2e1_dp*A_2*t71*t85 - t89 = 0.1e1_dp+alpha_1_2*rs_s1 + t89 = 0.1e1_dp + alpha_1_2*rs_s1 t94 = rs_s1**t77 t95 = beta_4_2*t94 - t96 = beta_1_2*t55+beta_2_2*rs_s1+beta_3_2*t58+t95 - t100 = 0.1e1_dp+t73/t96/0.2e1_dp + t96 = beta_1_2*t55 + beta_2_2*rs_s1 + beta_3_2*t58 + t95 + t100 = 0.1e1_dp + t73/t96/0.2e1_dp t101 = LOG(t100) e_c_u_1_s1 = -0.2e1_dp*A_2*t89*t101 - t111 = p_3+1._dp + t111 = p_3 + 1._dp rs = t4*t9/0.4e1_dp - t138 = 0.1e1_dp+alpha_1_1*rs + t138 = 0.1e1_dp + alpha_1_1*rs t140 = SQRT(rs) t143 = t140*rs t145 = rs**t41 t146 = beta_4_1*t145 - t147 = beta_1_1*t140+beta_2_1*rs+beta_3_1*t143+t146 - t151 = 0.1e1_dp+t35/t147/0.2e1_dp + t147 = beta_1_1*t140 + beta_2_1*rs + beta_3_1*t143 + t146 + t151 = 0.1e1_dp + t35/t147/0.2e1_dp t152 = LOG(t151) e_c_u_0 = -0.2e1_dp*A_1*t138*t152 t161 = rs**t77 - t168 = LOG(0.1e1_dp+t73/(beta_1_2*t140+beta_2_2*rs+ & - beta_3_2*t143+beta_4_2*t161)/0.2e1_dp) + t168 = LOG(0.1e1_dp + t73/(beta_1_2*t140 + beta_2_2*rs + & + beta_3_2*t143 + beta_4_2*t161)/0.2e1_dp) t177 = rs**t111 t186 = 0.1e1_dp/gamma_var t187 = beta*t186 @@ -552,68 +552,68 @@ SUBROUTINE tpss_lda_calc(rho, norm_drho, tau, e_0, e_rho, e_ndrho, e_tau, & t190 = t189*phi_s1 t191 = 0.1e1_dp/t190 t193 = EXP(-e_c_u_1_s1*t186*t191) - t194 = t193-0.1e1_dp + t194 = t193 - 0.1e1_dp A_s1 = t187/t194 t196 = gamma_var*t190 t197 = t_s1**2 t198 = A_s1*t197 - t199 = 0.1e1_dp+t198 + t199 = 0.1e1_dp + t198 t201 = A_s1**2 t202 = t197**2 - t204 = 0.1e1_dp+t198+t201*t202 + t204 = 0.1e1_dp + t198 + t201*t202 t205 = 0.1e1_dp/t204 - t208 = 0.1e1_dp+t187*t197*t199*t205 + t208 = 0.1e1_dp + t187*t197*t199*t205 t209 = LOG(t208) - epsilon_cGGA_1_0 = e_c_u_1_s1+t196*t209 + epsilon_cGGA_1_0 = e_c_u_1_s1 + t196*t209 t211 = phi_s2**2 t212 = t211*phi_s2 t213 = 0.1e1_dp/t212 t215 = EXP(-e_c_u_1_s2*t186*t213) - t216 = t215-0.1e1_dp + t216 = t215 - 0.1e1_dp A_s2 = t187/t216 t218 = gamma_var*t212 t219 = t_s2**2 t220 = A_s2*t219 - t221 = t220+0.1e1_dp + t221 = t220 + 0.1e1_dp t223 = A_s2**2 t224 = t219**2 - t226 = 0.1e1_dp+t220+t223*t224 + t226 = 0.1e1_dp + t220 + t223*t224 t227 = 0.1e1_dp/t226 - t230 = 0.1e1_dp+t187*t219*t221*t227 + t230 = 0.1e1_dp + t187*t219*t221*t227 t231 = LOG(t230) - epsilon_cGGA_0_1 = e_c_u_1_s2+t218*t231 + epsilon_cGGA_0_1 = e_c_u_1_s2 + t218*t231 t233 = SQRT(t1*t16*t6) k_s = 0.2e1_dp*t233 t234 = 0.1e1_dp/k_s t235 = my_ndrho*t234 t = t235*t7/0.2e1_dp t238 = EXP(-e_c_u_0*t186) - t239 = -0.1e1_dp+t238 + t239 = -0.1e1_dp + t238 A = t187/t239 t241 = t**2 t242 = A*t241 - t243 = 0.1e1_dp+t242 + t243 = 0.1e1_dp + t242 t245 = A**2 t246 = t241**2 - t248 = 0.1e1_dp+t242+t245*t246 + t248 = 0.1e1_dp + t242 + t245*t246 t249 = 0.1e1_dp/t248 - t252 = 0.1e1_dp+t187*t241*t243*t249 + t252 = 0.1e1_dp + t187*t241*t243*t249 t253 = LOG(t252) - epsilon_cGGA = e_c_u_0+gamma_var*t253 + epsilon_cGGA = e_c_u_0 + gamma_var*t253 ma = MAX(epsilon_cGGA_1_0, epsilon_cGGA) mb = MAX(epsilon_cGGA_0_1, epsilon_cGGA) t256 = tau_w**2 - t260 = ma/0.2e1_dp+mb/0.2e1_dp - t263 = 0.53e0_dp*epsilon_cGGA*t256-0.153e1_dp*t256*t260 + t260 = ma/0.2e1_dp + mb/0.2e1_dp + t263 = 0.53e0_dp*epsilon_cGGA*t256 - 0.153e1_dp*t256*t260 t264 = my_tau**2 t265 = 0.1e1_dp/t264 - epsilon_cRevPKZB = epsilon_cGGA+t263*t265 + epsilon_cRevPKZB = epsilon_cGGA + t263*t265 t267 = my_rho*epsilon_cRevPKZB t268 = d*epsilon_cRevPKZB t269 = t256*tau_w t271 = 0.1e1_dp/t264/my_tau t272 = t269*t271 - t274 = 0.1e1_dp+t268*t272 + t274 = 0.1e1_dp + t268*t272 t275 = t254*t1 t276 = t14**(0.1e1_dp/0.3e1_dp) t277 = t276**2 @@ -625,39 +625,39 @@ SUBROUTINE tpss_lda_calc(rho, norm_drho, tau, e_0, e_rho, e_ndrho, e_tau, & p = t275*t284/0.12e2_dp t286 = 0.1e1_dp/my_tau z = tau_w*t286 - t288 = 0.1e1_dp/z-0.1e1_dp + t288 = 0.1e1_dp/z - 0.1e1_dp alpha = 0.5e1_dp/0.3e1_dp*p*t288 - t290 = alpha-0.1e1_dp + t290 = alpha - 0.1e1_dp t291 = b*alpha - t293 = 0.1e1_dp+t291*t290 + t293 = 0.1e1_dp + t291*t290 t294 = SQRT(t293) t295 = 0.1e1_dp/t294 - tildeq_b = 0.9e1_dp/0.20e2_dp*t290*t295+0.2e1_dp/0.3e1_dp*p + tildeq_b = 0.9e1_dp/0.20e2_dp*t290*t295 + 0.2e1_dp/0.3e1_dp*p t299 = z**2 - t301 = 0.1e1_dp+t299 + t301 = 0.1e1_dp + t299 t302 = t301**2 t303 = 0.1e1_dp/t302 - t305 = 0.10e2_dp/0.81e2_dp+c*t299*t303 + t305 = 0.10e2_dp/0.81e2_dp + c*t299*t303 t307 = tildeq_b**2 t310 = p**2 - t313 = SQRT(0.18e2_dp*t299+0.50e2_dp*t310) + t313 = SQRT(0.18e2_dp*t299 + 0.50e2_dp*t310) t316 = 0.1e1_dp/kappa t319 = SQRT(e_var) t322 = e_var*mu - t325 = t305*p+0.146e3_dp/0.2025e4_dp*t307-0.73e2_dp/ & - 0.4050e4_dp*tildeq_b*t313+0.100e3_dp/0.6561e4_dp*t316* & - t310+0.4e1_dp/0.45e2_dp*t319*t299+t322*t310*p - t327 = 0.1e1_dp+t319*p + t325 = t305*p + 0.146e3_dp/0.2025e4_dp*t307 - 0.73e2_dp/ & + 0.4050e4_dp*tildeq_b*t313 + 0.100e3_dp/0.6561e4_dp*t316* & + t310 + 0.4e1_dp/0.45e2_dp*t319*t299 + t322*t310*p + t327 = 0.1e1_dp + t319*p t328 = t327**2 t329 = 0.1e1_dp/t328 - t331 = 0.1e1_dp+t325*t329*t316 - Fx = 0.1e1_dp+kappa-kappa/t331 + t331 = 0.1e1_dp + t325*t329*t316 + Fx = 0.1e1_dp + kappa - kappa/t331 ex_unif = -0.3e1_dp/0.4e1_dp*t1*t16*t6 t337 = my_rho*ex_unif IF (grad_deriv >= 0) THEN - e_0(ii) = e_0(ii)+ & - scale_ec*t267*t274+scale_ex*t337*Fx + e_0(ii) = e_0(ii) + & + scale_ec*t267*t274 + scale_ex*t337*Fx END IF IF (abs_grad_deriv > 0) THEN @@ -666,15 +666,15 @@ SUBROUTINE tpss_lda_calc(rho, norm_drho, tau, e_0, e_rho, e_ndrho, e_tau, & t344 = 0.1e1_dp/t340*t6*t343 rsrho = -t4*t344/0.12e2_dp t351 = t147**2 - e_c_u_0rho = -0.2e1_dp*A_1*alpha_1_1*rsrho*t152+t138/ & - t351*(beta_1_1/t140*rsrho/0.2e1_dp+beta_2_1*rsrho+ & - 0.3e1_dp/0.2e1_dp*beta_3_1*t140*rsrho+t146*t41*rsrho/ & + e_c_u_0rho = -0.2e1_dp*A_1*alpha_1_1*rsrho*t152 + t138/ & + t351*(beta_1_1/t140*rsrho/0.2e1_dp + beta_2_1*rsrho + & + 0.3e1_dp/0.2e1_dp*beta_3_1*t140*rsrho + t146*t41*rsrho/ & rs)/t151 t370 = t16**2 t371 = 0.1e1_dp/t370 t376 = k_s**2 trho = -my_ndrho/t376*t7/t233*t1*t371*t14*t6 & - /0.6e1_dp-t235*t343/0.2e1_dp + /0.6e1_dp - t235*t343/0.2e1_dp t383 = gamma_var**2 t385 = beta/t383 t386 = t239**2 @@ -690,18 +690,18 @@ SUBROUTINE tpss_lda_calc(rho, norm_drho, tau, e_0, e_rho, e_ndrho, e_tau, & t410 = t241*t t411 = t245*t410 t419 = 0.1e1_dp/t252 - epsilon_cGGArho = e_c_u_0rho+gamma_var*(0.2e1_dp*t390*t391 & - *trho+t187*t241*(t395+t398)*t249-t403*t406*(t395+ & - t398+0.2e1_dp*A*t246*Arho+0.4e1_dp*t411*trho))*t419 + epsilon_cGGArho = e_c_u_0rho + gamma_var*(0.2e1_dp*t390*t391 & + *trho + t187*t241*(t395 + t398)*t249 - t403*t406*(t395 + & + t398 + 0.2e1_dp*A*t246*Arho + 0.4e1_dp*t411*trho))*t419 tau_wrho = -t254*t343/0.8e1_dp prho = -0.2e1_dp/0.9e1_dp*t275*t278/t281/t279/my_rho zrho = tau_wrho*t286 t430 = p/t299 - alpharho = 0.5e1_dp/0.3e1_dp*prho*t288-0.5e1_dp/0.3e1_dp & + alpharho = 0.5e1_dp/0.3e1_dp*prho*t288 - 0.5e1_dp/0.3e1_dp & *t430*zrho t437 = t290/t294/t293 - tildeq_brho = 0.9e1_dp/0.20e2_dp*alpharho*t295-0.9e1_dp/ & - 0.40e2_dp*t437*(b*alpharho*t290+t291*alpharho)+ & + tildeq_brho = 0.9e1_dp/0.20e2_dp*alpharho*t295 - 0.9e1_dp/ & + 0.40e2_dp*t437*(b*alpharho*t290 + t291*alpharho) + & 0.2e1_dp/0.3e1_dp*prho t445 = c*z t450 = c*t299*z @@ -715,13 +715,13 @@ SUBROUTINE tpss_lda_calc(rho, norm_drho, tau, e_0, e_rho, e_ndrho, e_tau, & rs_s1rho = -t4*t5*t344/0.12e2_dp k_f_s1rho = t13*t371*t14/0.6e1_dp t505 = k_s_s1**2 - t_s1rho = -t21/t505*t7/t19*k_f_s1rho*t6/0.2e1_dp-t21 & + t_s1rho = -t21/t505*t7/t19*k_f_s1rho*t6/0.2e1_dp - t21 & *t22*t343/0.2e1_dp t513 = A_2*alpha_1_2 t517 = t96**2 - e_c_u_1_s1rho = -0.2e1_dp*t513*rs_s1rho*t101+t89/t517* & - (beta_1_2/t55*rs_s1rho/0.2e1_dp+beta_2_2*rs_s1rho+ & - 0.3e1_dp/0.2e1_dp*beta_3_2*t55*rs_s1rho+t95*t77* & + e_c_u_1_s1rho = -0.2e1_dp*t513*rs_s1rho*t101 + t89/t517* & + (beta_1_2/t55*rs_s1rho/0.2e1_dp + beta_2_2*rs_s1rho + & + 0.3e1_dp/0.2e1_dp*beta_3_2*t55*rs_s1rho + t95*t77* & rs_s1rho/rs_s1)/t100 t536 = t194**2 A_s1rho = t385/t536*e_c_u_1_s1rho*t191*t193 @@ -738,21 +738,21 @@ SUBROUTINE tpss_lda_calc(rho, norm_drho, tau, e_0, e_rho, e_ndrho, e_tau, & t569 = 0.1e1_dp/t208 t571 = epsilon_cGGA .LT. epsilon_cGGA_1_0 IF (t571) THEN - marho = e_c_u_1_s1rho+t196*(0.2e1_dp*t541*t542 & - *t_s1rho+t187*t197*(t546+t549)*t205-t554*t557*(t546 & - +t549+0.2e1_dp*A_s1*t202*A_s1rho+0.4e1_dp*t562* & - t_s1rho))*t569 + marho = e_c_u_1_s1rho + t196*(0.2e1_dp*t541*t542 & + *t_s1rho + t187*t197*(t546 + t549)*t205 - t554*t557*(t546 & + + t549 + 0.2e1_dp*A_s1*t202*A_s1rho + 0.4e1_dp*t562* & + t_s1rho))*t569 ELSE marho = epsilon_cGGArho END IF rs_s2rho = rs_s1rho t574 = k_s_s2**2 - t_s2rho = -t28/t574*t7/t26*k_f_s1rho*t6/0.2e1_dp-t28 & + t_s2rho = -t28/t574*t7/t26*k_f_s1rho*t6/0.2e1_dp - t28 & *t29*t343/0.2e1_dp t585 = t80**2 - e_c_u_1_s2rho = -0.2e1_dp*t513*rs_s2rho*t85+t71/t585*( & - beta_1_2/t36*rs_s2rho/0.2e1_dp+beta_2_2*rs_s2rho+ & - 0.3e1_dp/0.2e1_dp*beta_3_2*t36*rs_s2rho+t79*t77* & + e_c_u_1_s2rho = -0.2e1_dp*t513*rs_s2rho*t85 + t71/t585*( & + beta_1_2/t36*rs_s2rho/0.2e1_dp + beta_2_2*rs_s2rho + & + 0.3e1_dp/0.2e1_dp*beta_3_2*t36*rs_s2rho + t79*t77* & rs_s2rho/rs_s2)/t84 t604 = t216**2 A_s2rho = t385/t604*e_c_u_1_s2rho*t213*t215 @@ -769,101 +769,101 @@ SUBROUTINE tpss_lda_calc(rho, norm_drho, tau, e_0, e_rho, e_ndrho, e_tau, & t637 = 0.1e1_dp/t230 t639 = epsilon_cGGA .LT. epsilon_cGGA_0_1 IF (t639) THEN - mbrho = e_c_u_1_s2rho+t218*(0.2e1_dp*t609*t610 & - *t_s2rho+t187*t219*(t614+t617)*t227-t622*t625*(t614 & - +t617+0.2e1_dp*A_s2*t224*A_s2rho+0.4e1_dp*t630* & - t_s2rho))*t637 + mbrho = e_c_u_1_s2rho + t218*(0.2e1_dp*t609*t610 & + *t_s2rho + t187*t219*(t614 + t617)*t227 - t622*t625*(t614 & + + t617 + 0.2e1_dp*A_s2*t224*A_s2rho + 0.4e1_dp*t630* & + t_s2rho))*t637 ELSE mbrho = epsilon_cGGArho END IF t642 = epsilon_cGGA*tau_w t645 = tau_w*t260 - epsilon_cRevPKZBrho = epsilon_cGGArho+(0.53e0_dp* & - epsilon_cGGArho*t256+0.106e1_dp*t642*tau_wrho-0.306e1_dp* & - t645*tau_wrho-0.153e1_dp*t256*(marho/0.2e1_dp+mbrho/ & - 0.2e1_dp))*t265 + epsilon_cRevPKZBrho = epsilon_cGGArho + (0.53e0_dp* & + epsilon_cGGArho*t256 + 0.106e1_dp*t642*tau_wrho - 0.306e1_dp* & + t645*tau_wrho - 0.153e1_dp*t256*(marho/0.2e1_dp + mbrho/ & + 0.2e1_dp))*t265 t659 = t256*t271 IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN - e_rho(ii) = e_rho(ii)+ & - scale_ec*(epsilon_cRevPKZB*t274+my_rho* & - epsilon_cRevPKZBrho*t274+t267*(d*epsilon_cRevPKZBrho*t272 & - +0.3e1_dp*t268*t659*tau_wrho))+scale_ex*(ex_unif*Fx- & - my_rho*pi*t1*t371*Fx/0.4e1_dp+t337* & - t490*(((0.2e1_dp*t445*t303*zrho-0.4e1_dp*t450*t452* & - zrho)*p+t305*prho+0.292e3_dp/0.2025e4_dp*tildeq_b* & - tildeq_brho-0.73e2_dp/0.4050e4_dp*tildeq_brho*t313- & - 0.73e2_dp/0.8100e4_dp*t464*(0.36e2_dp*z*zrho+0.100e3_dp & - *p*prho)+0.200e3_dp/0.6561e4_dp*t472*prho+0.8e1_dp/ & - 0.45e2_dp*t475*zrho+0.3e1_dp*t322*t310*prho)*t329- & + e_rho(ii) = e_rho(ii) + & + scale_ec*(epsilon_cRevPKZB*t274 + my_rho* & + epsilon_cRevPKZBrho*t274 + t267*(d*epsilon_cRevPKZBrho*t272 & + + 0.3e1_dp*t268*t659*tau_wrho)) + scale_ex*(ex_unif*Fx - & + my_rho*pi*t1*t371*Fx/0.4e1_dp + t337* & + t490*(((0.2e1_dp*t445*t303*zrho - 0.4e1_dp*t450*t452* & + zrho)*p + t305*prho + 0.292e3_dp/0.2025e4_dp*tildeq_b* & + tildeq_brho - 0.73e2_dp/0.4050e4_dp*tildeq_brho*t313 - & + 0.73e2_dp/0.8100e4_dp*t464*(0.36e2_dp*z*zrho + 0.100e3_dp & + *p*prho) + 0.200e3_dp/0.6561e4_dp*t472*prho + 0.8e1_dp/ & + 0.45e2_dp*t475*zrho + 0.3e1_dp*t322*t310*prho)*t329 - & 0.2e1_dp*t485*t319*prho)) END IF tnorm_drho = t234*t7/0.2e1_dp - Hnorm_drho = gamma_var*(0.2e1_dp*t390*t391*tnorm_drho+ & - 0.2e1_dp*t187*t410*A*tnorm_drho*t249-t403*t406*( & - 0.2e1_dp*t396*tnorm_drho+0.4e1_dp*t411*tnorm_drho))*t419 + Hnorm_drho = gamma_var*(0.2e1_dp*t390*t391*tnorm_drho + & + 0.2e1_dp*t187*t410*A*tnorm_drho*t249 - t403*t406*( & + 0.2e1_dp*t396*tnorm_drho + 0.4e1_dp*t411*tnorm_drho))*t419 tau_wnorm_drho = my_ndrho*t7/0.4e1_dp pnorm_drho = my_ndrho*t1*t284/0.6e1_dp znorm_drho = tau_wnorm_drho*t286 - alphanorm_drho = 0.5e1_dp/0.3e1_dp*pnorm_drho*t288- & + alphanorm_drho = 0.5e1_dp/0.3e1_dp*pnorm_drho*t288 - & 0.5e1_dp/0.3e1_dp*t430*znorm_drho - tildeq_bnorm_drho = 0.9e1_dp/0.20e2_dp*alphanorm_drho*t295- & - 0.9e1_dp/0.40e2_dp*t437*(b*alphanorm_drho*t290+t291* & - alphanorm_drho)+0.2e1_dp/0.3e1_dp*pnorm_drho + tildeq_bnorm_drho = 0.9e1_dp/0.20e2_dp*alphanorm_drho*t295 - & + 0.9e1_dp/0.40e2_dp*t437*(b*alphanorm_drho*t290 + t291* & + alphanorm_drho) + 0.2e1_dp/0.3e1_dp*pnorm_drho t_s1norm_drho = t20*t22*t7/0.2e1_dp IF (t571) THEN manorm_drho = t196*(0.2e1_dp*t541*t542* & - t_s1norm_drho+0.2e1_dp*t187*t561*A_s1*t_s1norm_drho*t205 & - -t554*t557*(0.2e1_dp*t547*t_s1norm_drho+0.4e1_dp*t562 & - *t_s1norm_drho))*t569 + t_s1norm_drho + 0.2e1_dp*t187*t561*A_s1*t_s1norm_drho*t205 & + - t554*t557*(0.2e1_dp*t547*t_s1norm_drho + 0.4e1_dp*t562 & + *t_s1norm_drho))*t569 ELSE manorm_drho = Hnorm_drho END IF t_s2norm_drho = t27*t29*t7/0.2e1_dp IF (t639) THEN mbnorm_drho = t218*(0.2e1_dp*t609*t610* & - t_s2norm_drho+0.2e1_dp*t187*t629*A_s2*t_s2norm_drho*t227 & - -t622*t625*(0.2e1_dp*t615*t_s2norm_drho+0.4e1_dp*t630 & - *t_s2norm_drho))*t637 + t_s2norm_drho + 0.2e1_dp*t187*t629*A_s2*t_s2norm_drho*t227 & + - t622*t625*(0.2e1_dp*t615*t_s2norm_drho + 0.4e1_dp*t630 & + *t_s2norm_drho))*t637 ELSE mbnorm_drho = Hnorm_drho END IF - epsilon_cRevPKZBnorm_drho = Hnorm_drho+(0.53e0_dp*Hnorm_drho* & - t256+0.106e1_dp*t642*tau_wnorm_drho-0.306e1_dp*t645* & - tau_wnorm_drho-0.153e1_dp*t256*(manorm_drho/0.2e1_dp+ & - mbnorm_drho/0.2e1_dp))*t265 + epsilon_cRevPKZBnorm_drho = Hnorm_drho + (0.53e0_dp*Hnorm_drho* & + t256 + 0.106e1_dp*t642*tau_wnorm_drho - 0.306e1_dp*t645* & + tau_wnorm_drho - 0.153e1_dp*t256*(manorm_drho/0.2e1_dp + & + mbnorm_drho/0.2e1_dp))*t265 IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN - e_ndrho(ii) = e_ndrho(ii)+ & + e_ndrho(ii) = e_ndrho(ii) + & scale_ec*(my_rho*epsilon_cRevPKZBnorm_drho* & - t274+t267*(d*epsilon_cRevPKZBnorm_drho*t272+0.3e1_dp* & - t268*t659*tau_wnorm_drho))+scale_ex*t337*t490*((( & - 0.2e1_dp*t445*t303*znorm_drho-0.4e1_dp*t450*t452* & - znorm_drho)*p+t305*pnorm_drho+0.292e3_dp/0.2025e4_dp* & - tildeq_b*tildeq_bnorm_drho-0.73e2_dp/0.4050e4_dp* & - tildeq_bnorm_drho*t313-0.73e2_dp/0.8100e4_dp*t464*( & - 0.36e2_dp*z*znorm_drho+0.100e3_dp*p*pnorm_drho)+ & - 0.200e3_dp/0.6561e4_dp*t472*pnorm_drho+0.8e1_dp/0.45e2_dp & - *t475*znorm_drho+0.3e1_dp*t322*t310*pnorm_drho)*t329- & - 0.2e1_dp*t485*t319*pnorm_drho) + t274 + t267*(d*epsilon_cRevPKZBnorm_drho*t272 + 0.3e1_dp* & + t268*t659*tau_wnorm_drho)) + scale_ex*t337*t490*((( & + 0.2e1_dp*t445*t303*znorm_drho - 0.4e1_dp*t450*t452* & + znorm_drho)*p + t305*pnorm_drho + 0.292e3_dp/0.2025e4_dp* & + tildeq_b*tildeq_bnorm_drho - 0.73e2_dp/0.4050e4_dp* & + tildeq_bnorm_drho*t313 - 0.73e2_dp/0.8100e4_dp*t464*( & + 0.36e2_dp*z*znorm_drho + 0.100e3_dp*p*pnorm_drho) + & + 0.200e3_dp/0.6561e4_dp*t472*pnorm_drho + 0.8e1_dp/0.45e2_dp & + *t475*znorm_drho + 0.3e1_dp*t322*t310*pnorm_drho)*t329 - & + 0.2e1_dp*t485*t319*pnorm_drho) END IF epsilon_cRevPKZBtau = -0.2e1_dp*t263*t271 t799 = t264**2 ztau = -tau_w*t265 alphatau = -0.5e1_dp/0.3e1_dp*t430*ztau - tildeq_btau = 0.9e1_dp/0.20e2_dp*alphatau*t295-0.9e1_dp/ & - 0.40e2_dp*t437*(b*alphatau*t290+t291*alphatau) + tildeq_btau = 0.9e1_dp/0.20e2_dp*alphatau*t295 - 0.9e1_dp/ & + 0.40e2_dp*t437*(b*alphatau*t290 + t291*alphatau) IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN - e_tau(ii) = e_tau(ii)+ & - scale_ec*(my_rho*epsilon_cRevPKZBtau*t274+t267* & - (d*epsilon_cRevPKZBtau*t272-0.3e1_dp*t268*t269/t799))+ & - scale_ex*t337*t490*((0.2e1_dp*t445*t303*ztau-0.4e1_dp & - *t450*t452*ztau)*p+0.292e3_dp/0.2025e4_dp*tildeq_b* & - tildeq_btau-0.73e2_dp/0.4050e4_dp*tildeq_btau*t313- & - 0.73e2_dp/0.225e3_dp*t464*z*ztau+0.8e1_dp/0.45e2_dp* & + e_tau(ii) = e_tau(ii) + & + scale_ec*(my_rho*epsilon_cRevPKZBtau*t274 + t267* & + (d*epsilon_cRevPKZBtau*t272 - 0.3e1_dp*t268*t269/t799)) + & + scale_ex*t337*t490*((0.2e1_dp*t445*t303*ztau - 0.4e1_dp & + *t450*t452*ztau)*p + 0.292e3_dp/0.2025e4_dp*tildeq_b* & + tildeq_btau - 0.73e2_dp/0.4050e4_dp*tildeq_btau*t313 - & + 0.73e2_dp/0.225e3_dp*t464*z*ztau + 0.8e1_dp/0.45e2_dp* & t475*ztau)*t329 END IF END IF @@ -985,12 +985,12 @@ SUBROUTINE tpss_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, norm_drho, & kappa = 0.804e0_dp beta = 0.66725e-1_dp mu = 0.21951e0_dp - gamma_var = (0.1e1_dp-LOG(0.2e1_dp))/pi**2 + gamma_var = (0.1e1_dp - LOG(0.2e1_dp))/pi**2 b = 0.4e0_dp c = 0.159096e1_dp e_var = 0.1537e1_dp d = 0.28e1_dp - f_ii_0 = 0.8e1_dp/0.9e1_dp/(2._dp*2._dp**(0.1e1_dp/0.3e1_dp)-2._dp) + f_ii_0 = 0.8e1_dp/0.9e1_dp/(2._dp*2._dp**(0.1e1_dp/0.3e1_dp) - 2._dp) p_1 = 0.10e1_dp A_1 = 0.31091e-1_dp alpha_1_1 = 0.21370e0_dp @@ -1029,8 +1029,8 @@ SUBROUTINE tpss_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, norm_drho, & my_tau_b = MAX(0.0_dp, tau_b(ii)) my_rhoa = MAX(0.0_dp, rhoa(ii)) my_rhob = MAX(0.0_dp, rhob(ii)) - rho = my_rhoa+my_rhob - tau = my_tau_a+my_tau_b + rho = my_rhoa + my_rhob + tau = my_tau_a + my_tau_b IF (rho > epsilon_rho .AND. tau > epsilon_tau) THEN my_norm_drhoa = MAX(EPSILON(0.0_dp), norm_drhoa(ii)) my_norm_drhob = MAX(EPSILON(0.0_dp), norm_drhob(ii)) @@ -1045,26 +1045,26 @@ SUBROUTINE tpss_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, norm_drho, & t1 = my_norm_drhoa**2 mean_tmp = 8._dp*my_rhoa*my_tau_a IF (mean_tmp < t1) THEN - mean_tmp = 0.5_dp*(mean_tmp+t1) + mean_tmp = 0.5_dp*(mean_tmp + t1) t1 = mean_tmp my_norm_drhoa = SQRT(mean_tmp) my_tau_a = mean_tmp/(8._dp*my_rhoa) - non_coer = non_coer+1 + non_coer = non_coer + 1 END IF t5 = my_norm_drhob**2 mean_tmp = 8._dp*my_rhob*my_tau_b IF (mean_tmp < t5) THEN - mean_tmp = 0.5_dp*(mean_tmp+t5) + mean_tmp = 0.5_dp*(mean_tmp + t5) t5 = mean_tmp my_norm_drhob = SQRT(mean_tmp) my_tau_b = mean_tmp/(8._dp*my_rhob) - non_coer = non_coer+1 + non_coer = non_coer + 1 END IF - rho = my_rhoa+my_rhob - t9 = my_tau_a+my_tau_b + rho = my_rhoa + my_rhob + t9 = my_tau_a + my_tau_b tau = t9 - my_norm_drho = MIN(my_norm_drho, my_norm_drhoa+my_norm_drhob) + my_norm_drho = MIN(my_norm_drho, my_norm_drhoa + my_norm_drhob) t2 = 1._dp/my_rhoa t3 = t1*t2 @@ -1079,34 +1079,34 @@ SUBROUTINE tpss_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, norm_drho, & tau_w_sp1 = t3/0.4e1_dp t27 = 0.1e1_dp/my_tau_a z_sp1 = tau_w_sp1*t27/0.2e1_dp - t30 = 0.1e1_dp/z_sp1-0.1e1_dp + t30 = 0.1e1_dp/z_sp1 - 0.1e1_dp alpha_sp1 = 0.5e1_dp/0.3e1_dp*p_sp1*t30 - t32 = alpha_sp1-0.1e1_dp + t32 = alpha_sp1 - 0.1e1_dp t33 = b*alpha_sp1 - t35 = 0.1e1_dp+t33*t32 + t35 = 0.1e1_dp + t33*t32 t36 = SQRT(t35) t37 = 0.1e1_dp/t36 - tildeq_b_sp1 = 0.9e1_dp/0.20e2_dp*t32*t37+0.2e1_dp/ & + tildeq_b_sp1 = 0.9e1_dp/0.20e2_dp*t32*t37 + 0.2e1_dp/ & 0.3e1_dp*p_sp1 t41 = z_sp1**2 - t43 = 0.1e1_dp+t41 + t43 = 0.1e1_dp + t41 t44 = t43**2 t45 = 0.1e1_dp/t44 - t47 = 0.10e2_dp/0.81e2_dp+c*t41*t45 + t47 = 0.10e2_dp/0.81e2_dp + c*t41*t45 t49 = tildeq_b_sp1**2 t52 = p_sp1**2 - t55 = SQRT(0.18e2_dp*t41+0.50e2_dp*t52) + t55 = SQRT(0.18e2_dp*t41 + 0.50e2_dp*t52) t58 = 0.1e1_dp/kappa t61 = SQRT(e_var) t64 = e_var*mu - t67 = t47*p_sp1+0.146e3_dp/0.2025e4_dp*t49-0.73e2_dp/ & - 0.4050e4_dp*tildeq_b_sp1*t55+0.100e3_dp/0.6561e4_dp*t58* & - t52+0.4e1_dp/0.45e2_dp*t61*t41+t64*t52*p_sp1 - t69 = 0.1e1_dp+t61*p_sp1 + t67 = t47*p_sp1 + 0.146e3_dp/0.2025e4_dp*t49 - 0.73e2_dp/ & + 0.4050e4_dp*tildeq_b_sp1*t55 + 0.100e3_dp/0.6561e4_dp*t58* & + t52 + 0.4e1_dp/0.45e2_dp*t61*t41 + t64*t52*p_sp1 + t69 = 0.1e1_dp + t61*p_sp1 t70 = t69**2 t71 = 0.1e1_dp/t70 - t73 = 0.1e1_dp+t67*t71*t58 - Fx_sp1 = 0.1e1_dp+kappa-kappa/t73 + t73 = 0.1e1_dp + t67*t71*t58 + Fx_sp1 = 0.1e1_dp + kappa - kappa/t73 t76 = 1._dp/pi t77 = t76*t12 t79 = (t14*my_rhoa)**(0.1e1_dp/0.3e1_dp) @@ -1121,31 +1121,31 @@ SUBROUTINE tpss_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, norm_drho, & tau_w_sp2 = t7/0.4e1_dp t93 = 0.1e1_dp/my_tau_b z_sp2 = tau_w_sp2*t93/0.2e1_dp - t96 = 0.1e1_dp/z_sp2-0.1e1_dp + t96 = 0.1e1_dp/z_sp2 - 0.1e1_dp alpha_sp2 = 0.5e1_dp/0.3e1_dp*p_sp2*t96 - t98 = alpha_sp2-0.1e1_dp + t98 = alpha_sp2 - 0.1e1_dp t99 = b*alpha_sp2 - t101 = 0.1e1_dp+t99*t98 + t101 = 0.1e1_dp + t99*t98 t102 = SQRT(t101) t103 = 0.1e1_dp/t102 - tildeq_b_sp2 = 0.9e1_dp/0.20e2_dp*t98*t103+0.2e1_dp/ & + tildeq_b_sp2 = 0.9e1_dp/0.20e2_dp*t98*t103 + 0.2e1_dp/ & 0.3e1_dp*p_sp2 t107 = z_sp2**2 - t109 = 0.1e1_dp+t107 + t109 = 0.1e1_dp + t107 t110 = t109**2 t111 = 0.1e1_dp/t110 - t113 = 0.10e2_dp/0.81e2_dp+c*t107*t111 + t113 = 0.10e2_dp/0.81e2_dp + c*t107*t111 t115 = tildeq_b_sp2**2 t118 = p_sp2**2 - t121 = SQRT(0.18e2_dp*t107+0.50e2_dp*t118) - t130 = t113*p_sp2+0.146e3_dp/0.2025e4_dp*t115-0.73e2_dp & - /0.4050e4_dp*tildeq_b_sp2*t121+0.100e3_dp/0.6561e4_dp*t58 & - *t118+0.4e1_dp/0.45e2_dp*t61*t107+t64*t118*p_sp2 - t132 = 0.1e1_dp+t61*p_sp2 + t121 = SQRT(0.18e2_dp*t107 + 0.50e2_dp*t118) + t130 = t113*p_sp2 + 0.146e3_dp/0.2025e4_dp*t115 - 0.73e2_dp & + /0.4050e4_dp*tildeq_b_sp2*t121 + 0.100e3_dp/0.6561e4_dp*t58 & + *t118 + 0.4e1_dp/0.45e2_dp*t61*t107 + t64*t118*p_sp2 + t132 = 0.1e1_dp + t61*p_sp2 t133 = t132**2 t134 = 0.1e1_dp/t133 - t136 = 0.1e1_dp+t130*t134*t58 - Fx_sp2 = 0.1e1_dp+kappa-kappa/t136 + t136 = 0.1e1_dp + t130*t134*t58 + Fx_sp2 = 0.1e1_dp + kappa - kappa/t136 t140 = (t14*my_rhob)**(0.1e1_dp/0.3e1_dp) ex_unif_sp2 = -0.3e1_dp/0.4e1_dp*t77*t18*t140 t144 = my_rhob*ex_unif_sp2 @@ -1174,121 +1174,121 @@ SUBROUTINE tpss_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, norm_drho, & t173 = 0.1e1_dp/A_1 t174 = SQRT(rs_s2) t177 = t174*rs_s2 - t179 = p_1+0.1e1_dp + t179 = p_1 + 0.1e1_dp t180 = rs_s2**t179 - t187 = LOG(0.1e1_dp+t173/(beta_1_1*t174+beta_2_1*rs_s2+ & - beta_3_1*t177+beta_4_1*t180)/0.2e1_dp) + t187 = LOG(0.1e1_dp + t173/(beta_1_1*t174 + beta_2_1*rs_s2 + & + beta_3_1*t177 + beta_4_1*t180)/0.2e1_dp) t193 = SQRT(rs_s1) t196 = t193*rs_s1 t198 = rs_s1**t179 - t205 = LOG(0.1e1_dp+t173/(beta_1_1*t193+beta_2_1*rs_s1+ & - beta_3_1*t196+beta_4_1*t198)/0.2e1_dp) - t209 = 0.1e1_dp+alpha_1_2*rs_s2 + t205 = LOG(0.1e1_dp + t173/(beta_1_1*t193 + beta_2_1*rs_s1 + & + beta_3_1*t196 + beta_4_1*t198)/0.2e1_dp) + t209 = 0.1e1_dp + alpha_1_2*rs_s2 t211 = 0.1e1_dp/A_2 - t215 = p_2+0.1e1_dp + t215 = p_2 + 0.1e1_dp t216 = rs_s2**t215 t217 = beta_4_2*t216 - t218 = beta_1_2*t174+beta_2_2*rs_s2+beta_3_2*t177+t217 - t222 = 0.1e1_dp+t211/t218/0.2e1_dp + t218 = beta_1_2*t174 + beta_2_2*rs_s2 + beta_3_2*t177 + t217 + t222 = 0.1e1_dp + t211/t218/0.2e1_dp t223 = LOG(t222) e_c_u_1_s2 = -0.2e1_dp*A_2*t209*t223 - t227 = 0.1e1_dp+alpha_1_2*rs_s1 + t227 = 0.1e1_dp + alpha_1_2*rs_s1 t232 = rs_s1**t215 t233 = beta_4_2*t232 - t234 = beta_1_2*t193+beta_2_2*rs_s1+beta_3_2*t196+t233 - t238 = 0.1e1_dp+t211/t234/0.2e1_dp + t234 = beta_1_2*t193 + beta_2_2*rs_s1 + beta_3_2*t196 + t233 + t238 = 0.1e1_dp + t211/t234/0.2e1_dp t239 = LOG(t238) e_c_u_1_s1 = -0.2e1_dp*A_2*t227*t239 t245 = 0.1e1_dp/A_3 - t249 = p_3+0.1e1_dp + t249 = p_3 + 0.1e1_dp t250 = rs_s2**t249 - t257 = LOG(0.1e1_dp+t245/(beta_1_3*t174+beta_2_3*rs_s2+ & - beta_3_3*t177+beta_4_3*t250)/0.2e1_dp) + t257 = LOG(0.1e1_dp + t245/(beta_1_3*t174 + beta_2_3*rs_s2 + & + beta_3_3*t177 + beta_4_3*t250)/0.2e1_dp) t265 = rs_s1**t249 - t272 = LOG(0.1e1_dp+t245/(beta_1_3*t193+beta_2_3*rs_s1+ & - beta_3_3*t196+beta_4_3*t265)/0.2e1_dp) - t274 = my_rhoa-my_rhob + t272 = LOG(0.1e1_dp + t245/(beta_1_3*t193 + beta_2_3*rs_s1 + & + beta_3_3*t196 + beta_4_3*t265)/0.2e1_dp) + t274 = my_rhoa - my_rhob t275 = 0.1e1_dp/rho chi = t274*t275 t277 = (t76*t275)**(0.1e1_dp/0.3e1_dp) rs = t148*t277/0.4e1_dp - t280 = 0.1e1_dp+alpha_1_1*rs + t280 = 0.1e1_dp + alpha_1_1*rs t282 = SQRT(rs) t285 = t282*rs t287 = rs**t179 t288 = beta_4_1*t287 - t289 = beta_1_1*t282+beta_2_1*rs+beta_3_1*t285+t288 - t293 = 0.1e1_dp+t173/t289/0.2e1_dp + t289 = beta_1_1*t282 + beta_2_1*rs + beta_3_1*t285 + t288 + t293 = 0.1e1_dp + t173/t289/0.2e1_dp t294 = LOG(t293) e_c_u_0 = -0.2e1_dp*A_1*t280*t294 - t298 = 0.1e1_dp+alpha_1_2*rs + t298 = 0.1e1_dp + alpha_1_2*rs t303 = rs**t215 t304 = beta_4_2*t303 - t305 = beta_1_2*t282+beta_2_2*rs+beta_3_2*t285+t304 - t309 = 0.1e1_dp+t211/t305/0.2e1_dp + t305 = beta_1_2*t282 + beta_2_2*rs + beta_3_2*t285 + t304 + t309 = 0.1e1_dp + t211/t305/0.2e1_dp t310 = LOG(t309) - t314 = 0.1e1_dp+alpha_1_3*rs + t314 = 0.1e1_dp + alpha_1_3*rs t319 = rs**t249 t320 = beta_4_3*t319 - t321 = beta_1_3*t282+beta_2_3*rs+beta_3_3*t285+t320 - t325 = 0.1e1_dp+t245/t321/0.2e1_dp + t321 = beta_1_3*t282 + beta_2_3*rs + beta_3_3*t285 + t320 + t325 = 0.1e1_dp + t245/t321/0.2e1_dp t326 = LOG(t325) alpha_c = 0.2e1_dp*A_3*t314*t326 - t328 = 0.1e1_dp+chi + t328 = 0.1e1_dp + chi t329 = t328**(0.1e1_dp/0.3e1_dp) t330 = t329*t328 - t331 = 0.1e1_dp-chi + t331 = 0.1e1_dp - chi t332 = t331**(0.1e1_dp/0.3e1_dp) t333 = t332*t331 - t337 = 1._dp/(2*t18-2._dp) - f = (t330+t333-0.2e1_dp)*t337 + t337 = 1._dp/(2*t18 - 2._dp) + f = (t330 + t333 - 0.2e1_dp)*t337 t338 = alpha_c*f t339 = 0.1e1_dp/f_ii_0 t340 = chi**2 t341 = t340**2 - t343 = t339*(0.1e1_dp-t341) - t345 = -0.2e1_dp*A_2*t298*t310-e_c_u_0 + t343 = t339*(0.1e1_dp - t341) + t345 = -0.2e1_dp*A_2*t298*t310 - e_c_u_0 t346 = t345*f - epsilon_c_unif = e_c_u_0+t338*t343+t346*t341 + epsilon_c_unif = e_c_u_0 + t338*t343 + t346*t341 t348 = 0.1e1_dp/gamma_var t349 = beta*t348 t351 = phi_s1**2 t352 = t351*phi_s1 t353 = 0.1e1_dp/t352 t355 = EXP(-e_c_u_1_s1*t348*t353) - t356 = t355-0.1e1_dp + t356 = t355 - 0.1e1_dp A_s1 = t349/t356 t358 = gamma_var*t352 t359 = t_s1**2 t360 = A_s1*t359 - t361 = 0.1e1_dp+t360 + t361 = 0.1e1_dp + t360 t363 = A_s1**2 t364 = t359**2 - t366 = 0.1e1_dp+t360+t363*t364 + t366 = 0.1e1_dp + t360 + t363*t364 t367 = 0.1e1_dp/t366 - t370 = 0.1e1_dp+t349*t359*t361*t367 + t370 = 0.1e1_dp + t349*t359*t361*t367 t371 = LOG(t370) - epsilon_cGGA_1_0 = e_c_u_1_s1+t358*t371 + epsilon_cGGA_1_0 = e_c_u_1_s1 + t358*t371 t373 = phi_s2**2 t374 = t373*phi_s2 t375 = 0.1e1_dp/t374 t377 = EXP(-e_c_u_1_s2*t348*t375) - t378 = t377-0.1e1_dp + t378 = t377 - 0.1e1_dp A_s2 = t349/t378 t380 = gamma_var*t374 t381 = t_s2**2 t382 = A_s2*t381 - t383 = 0.1e1_dp+t382 + t383 = 0.1e1_dp + t382 t385 = A_s2**2 t386 = t381**2 - t388 = 0.1e1_dp+t382+t385*t386 + t388 = 0.1e1_dp + t382 + t385*t386 t389 = 0.1e1_dp/t388 - t392 = 0.1e1_dp+t349*t381*t383*t389 + t392 = 0.1e1_dp + t349*t381*t383*t389 t393 = LOG(t392) - epsilon_cGGA_0_1 = e_c_u_1_s2+t380*t393 + epsilon_cGGA_0_1 = e_c_u_1_s2 + t380*t393 t394 = t329**2 t395 = t332**2 - phi = t394/0.2e1_dp+t395/0.2e1_dp + phi = t394/0.2e1_dp + t395/0.2e1_dp t397 = t14*rho t398 = t397**(0.1e1_dp/0.3e1_dp) t400 = SQRT(t12*t398*t76) @@ -1303,23 +1303,23 @@ SUBROUTINE tpss_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, norm_drho, & t408 = t407*phi t409 = 0.1e1_dp/t408 t411 = EXP(-t406*t409) - t412 = t411-0.1e1_dp + t412 = t411 - 0.1e1_dp A = t349/t412 t414 = gamma_var*t408 t415 = t**2 t416 = A*t415 - t417 = 0.1e1_dp+t416 + t417 = 0.1e1_dp + t416 t419 = A**2 t420 = t415**2 - t422 = 0.1e1_dp+t416+t419*t420 + t422 = 0.1e1_dp + t416 + t419*t420 t423 = 0.1e1_dp/t422 - t426 = 0.1e1_dp+t349*t415*t417*t423 + t426 = 0.1e1_dp + t349*t415*t417*t423 t427 = LOG(t426) - epsilon_cGGA = epsilon_c_unif+t414*t427 + epsilon_cGGA = epsilon_c_unif + t414*t427 t430 = my_rhoa*my_rhob t431 = my_norm_drho**2 - t436a = t1*t86+t5*t20-t430*t431+t430* & - t1+t430*t5 + t436a = t1*t86 + t5*t20 - t430*t431 + t430* & + t1 + t430*t5 IF (t436a < 0._dp) THEN ! PRINT *, t436a t436 = 0._dp @@ -1332,12 +1332,12 @@ SUBROUTINE tpss_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, norm_drho, & t441 = 0.2e1_dp*t436*t438*t440 t442 = 0.1e1_dp/t398 eps = t441*t442/0.6e1_dp - C_chi = 0.53e0_dp+0.87e0_dp*t340+0.5e0_dp*t341+ & + C_chi = 0.53e0_dp + 0.87e0_dp*t340 + 0.5e0_dp*t341 + & 0.226e1_dp*t341*t340 tau_w = t431*t275/0.8e1_dp t449 = eps**2 - t452 = 0.1e1_dp/t330+0.1e1_dp/t333 - t455 = 0.1e1_dp+t449*t452/0.2e1_dp + t452 = 0.1e1_dp/t330 + 0.1e1_dp/t333 + t455 = 0.1e1_dp + t449*t452/0.2e1_dp t456 = t455**2 t457 = t456**2 t458 = 0.1e1_dp/t457 @@ -1346,25 +1346,25 @@ SUBROUTINE tpss_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, norm_drho, & mb = MAX(epsilon_cGGA_0_1, epsilon_cGGA) t459 = epsilon_cGGA*C_chi_eps t460 = tau_w**2 - t462 = 0.1e1_dp+C_chi_eps + t462 = 0.1e1_dp + C_chi_eps t463 = t462*t460 t464 = my_rhoa*t275 t466 = my_rhob*t275 - t468 = t464*ma+t466*mb - t470 = t459*t460-t463*t468 + t468 = t464*ma + t466*mb + t470 = t459*t460 - t463*t468 t471 = tau**2 t472 = 0.1e1_dp/t471 - epsilon_cRevPKZB = epsilon_cGGA+t470*t472 + epsilon_cRevPKZB = epsilon_cGGA + t470*t472 t474 = rho*epsilon_cRevPKZB t475 = d*epsilon_cRevPKZB t476 = t460*tau_w t478 = 0.1e1_dp/t471/tau t479 = t476*t478 - t481 = 0.1e1_dp+t475*t479 + t481 = 0.1e1_dp + t475*t479 IF (grad_deriv >= 0) THEN - e_0(ii) = e_0(ii)+ & - scale_ex*(t83*Fx_sp1+t144*Fx_sp2)+scale_ec* & + e_0(ii) = e_0(ii) + & + scale_ex*(t83*Fx_sp1 + t144*Fx_sp2) + scale_ec* & t474*t481 END IF @@ -1373,12 +1373,12 @@ SUBROUTINE tpss_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, norm_drho, & t492 = 0.1e1_dp/t20 z_sp1rhoa = -t1*t492*t27/0.8e1_dp t498 = p_sp1/t41 - alpha_sp1rhoa = 0.5e1_dp/0.3e1_dp*p_sp1rhoa*t30-0.5e1_dp/ & + alpha_sp1rhoa = 0.5e1_dp/0.3e1_dp*p_sp1rhoa*t30 - 0.5e1_dp/ & 0.3e1_dp*t498*z_sp1rhoa t505 = t32/t36/t35 - tildeq_b_sp1rhoa = 0.9e1_dp/0.20e2_dp*alpha_sp1rhoa*t37- & - 0.9e1_dp/0.40e2_dp*t505*(b*alpha_sp1rhoa*t32+t33* & - alpha_sp1rhoa)+0.2e1_dp/0.3e1_dp*p_sp1rhoa + tildeq_b_sp1rhoa = 0.9e1_dp/0.20e2_dp*alpha_sp1rhoa*t37 - & + 0.9e1_dp/0.40e2_dp*t505*(b*alpha_sp1rhoa*t32 + t33* & + alpha_sp1rhoa) + 0.2e1_dp/0.3e1_dp*p_sp1rhoa t513 = c*z_sp1 t518 = c*t41*z_sp1 t520 = 0.1e1_dp/t44/t43 @@ -1392,7 +1392,7 @@ SUBROUTINE tpss_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, norm_drho, & t560 = t79**2 t561 = 0.1e1_dp/t560 t570 = t274*t438 - chirhoa = t275-t570 + chirhoa = t275 - t570 t571 = t277**2 rsrhoa = -t148/t571*t76*t438/0.12e2_dp t577 = A_1*alpha_1_1 @@ -1403,9 +1403,9 @@ SUBROUTINE tpss_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, norm_drho, & t589 = beta_3_1*t282 t593 = 0.1e1_dp/rs t597 = 0.1e1_dp/t293 - e_c_u_0rhoa = -0.2e1_dp*t577*rsrhoa*t294+t583*(t585* & - rsrhoa/0.2e1_dp+beta_2_1*rsrhoa+0.3e1_dp/0.2e1_dp*t589* & - rsrhoa+t288*t179*rsrhoa*t593)*t597 + e_c_u_0rhoa = -0.2e1_dp*t577*rsrhoa*t294 + t583*(t585* & + rsrhoa/0.2e1_dp + beta_2_1*rsrhoa + 0.3e1_dp/0.2e1_dp*t589* & + rsrhoa + t288*t179*rsrhoa*t593)*t597 t600 = A_2*alpha_1_2 t604 = t305**2 t606 = t298/t604 @@ -1418,22 +1418,22 @@ SUBROUTINE tpss_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, norm_drho, & t628 = beta_1_3*t584 t632 = beta_3_3*t282 t639 = 0.1e1_dp/t325 - frhoa = (0.4e1_dp/0.3e1_dp*t329*chirhoa-0.4e1_dp/ & + frhoa = (0.4e1_dp/0.3e1_dp*t329*chirhoa - 0.4e1_dp/ & 0.3e1_dp*t332*chirhoa)*t337 t650 = t340*chi t651 = t339*t650 t660 = t650*chirhoa - epsilon_c_unifrhoa = e_c_u_0rhoa+(0.2e1_dp*t621*rsrhoa* & - t326-t627*(t628*rsrhoa/0.2e1_dp+beta_2_3*rsrhoa+ & - 0.3e1_dp/0.2e1_dp*t632*rsrhoa+t320*t249*rsrhoa*t593)* & - t639)*f*t343+alpha_c*frhoa*t343-0.4e1_dp*t338*t651 & - *chirhoa+(-0.2e1_dp*t600*rsrhoa*t310+t606*(t607* & - rsrhoa/0.2e1_dp+beta_2_2*rsrhoa+0.3e1_dp/0.2e1_dp*t611* & - rsrhoa+t304*t215*rsrhoa*t593)*t618-e_c_u_0rhoa)*f* & - t341+t345*frhoa*t341+0.4e1_dp*t346*t660 + epsilon_c_unifrhoa = e_c_u_0rhoa + (0.2e1_dp*t621*rsrhoa* & + t326 - t627*(t628*rsrhoa/0.2e1_dp + beta_2_3*rsrhoa + & + 0.3e1_dp/0.2e1_dp*t632*rsrhoa + t320*t249*rsrhoa*t593)* & + t639)*f*t343 + alpha_c*frhoa*t343 - 0.4e1_dp*t338*t651 & + *chirhoa + (-0.2e1_dp*t600*rsrhoa*t310 + t606*(t607* & + rsrhoa/0.2e1_dp + beta_2_2*rsrhoa + 0.3e1_dp/0.2e1_dp*t611* & + rsrhoa + t304*t215*rsrhoa*t593)*t618 - e_c_u_0rhoa)*f* & + t341 + t345*frhoa*t341 + 0.4e1_dp*t346*t660 t663 = 0.1e1_dp/t329 t665 = 0.1e1_dp/t332 - phirhoa = t663*chirhoa/0.3e1_dp-t665*chirhoa/0.3e1_dp + phirhoa = t663*chirhoa/0.3e1_dp - t665*chirhoa/0.3e1_dp t668 = t398**2 k_frhoa = t12/t668*t14/0.3e1_dp t672 = 0.1e1_dp/t400 @@ -1441,13 +1441,13 @@ SUBROUTINE tpss_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, norm_drho, & t678 = k_s**2 t680 = 0.1e1_dp/t678*t275 t684 = t402*t403*t438 - trhoa = -t675*t404*phirhoa/0.2e1_dp-t402*t680*t672* & - k_frhoa*t76/0.2e1_dp-t684/0.2e1_dp + trhoa = -t675*t404*phirhoa/0.2e1_dp - t402*t680*t672* & + k_frhoa*t76/0.2e1_dp - t684/0.2e1_dp t686 = t412**2 t687 = 0.1e1_dp/t686 t690 = t407**2 t691 = 0.1e1_dp/t690 - Arhoa = -t349*t687*(-epsilon_c_unifrhoa*t348*t409+ & + Arhoa = -t349*t687*(-epsilon_c_unifrhoa*t348*t409 + & 0.3e1_dp*t406*t691*phirhoa)*t411 t699 = gamma_var*t407 t703 = t349*t @@ -1462,10 +1462,10 @@ SUBROUTINE tpss_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, norm_drho, & t723 = t415*t t724 = t419*t723 t731 = 0.1e1_dp/t426 - epsilon_cGGArhoa = epsilon_c_unifrhoa+0.3e1_dp*t699*t427* & - phirhoa+t414*(0.2e1_dp*t703*t704*trhoa+t349*t415*( & - t708+t711)*t423-t716*t719*(t708+t711+0.2e1_dp*t720* & - Arhoa+0.4e1_dp*t724*trhoa))*t731 + epsilon_cGGArhoa = epsilon_c_unifrhoa + 0.3e1_dp*t699*t427* & + phirhoa + t414*(0.2e1_dp*t703*t704*trhoa + t349*t415*( & + t708 + t711)*t423 - t716*t719*(t708 + t711 + 0.2e1_dp*t720* & + Arhoa + 0.4e1_dp*t724*trhoa))*t731 t735 = 0.1e1_dp/MAX(EPSILON(0._dp), t436*t438) t736 = t5*my_rhoa t739 = my_rhob*t1 @@ -1479,12 +1479,12 @@ SUBROUTINE tpss_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, norm_drho, & t771 = 0.1e1_dp/t329/t769 t773 = t331**2 t775 = 0.1e1_dp/t332/t773 - C_chi_epsrhoa = (0.174e1_dp*chi*chirhoa+0.20e1_dp*t660+ & - 0.1356e2_dp*t758*chirhoa)*t458-0.4e1_dp*t766*(t767*(( & - t735*(0.2e1_dp*t736-my_rhob*t431+t739+my_rhob*t5)- & - t746)*t440*t442/0.6e1_dp-t754)+t449*(-0.4e1_dp/ & - 0.3e1_dp*t771*chirhoa+0.4e1_dp/0.3e1_dp*t775*chirhoa)/ & - 0.2e1_dp) + C_chi_epsrhoa = (0.174e1_dp*chi*chirhoa + 0.20e1_dp*t660 + & + 0.1356e2_dp*t758*chirhoa)*t458 - 0.4e1_dp*t766*(t767*(( & + t735*(0.2e1_dp*t736 - my_rhob*t431 + t739 + my_rhob*t5) - & + t746)*t440*t442/0.6e1_dp - t754) + t449*(-0.4e1_dp/ & + 0.3e1_dp*t771*chirhoa + 0.4e1_dp/0.3e1_dp*t775*chirhoa)/ & + 0.2e1_dp) t784 = epsilon_cGGA .LT. epsilon_cGGA_0_1 IF (t784) THEN mbrhoa = 0._dp @@ -1495,11 +1495,11 @@ SUBROUTINE tpss_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, norm_drho, & rs_s1rhoa = -t148/t785*t76*t492/0.12e2_dp t795 = k_s_s1**2 t_s1rhoa = -t156/t795*t2/t154*t12*t561*t14 & - *t76/0.6e1_dp-t156*t157*t492/0.2e1_dp + *t76/0.6e1_dp - t156*t157*t492/0.2e1_dp t806 = t234**2 - e_c_u_1_s1rhoa = -0.2e1_dp*t600*rs_s1rhoa*t239+t227/t806 & - *(beta_1_2/t193*rs_s1rhoa/0.2e1_dp+beta_2_2*rs_s1rhoa+ & - 0.3e1_dp/0.2e1_dp*beta_3_2*t193*rs_s1rhoa+t233*t215* & + e_c_u_1_s1rhoa = -0.2e1_dp*t600*rs_s1rhoa*t239 + t227/t806 & + *(beta_1_2/t193*rs_s1rhoa/0.2e1_dp + beta_2_2*rs_s1rhoa + & + 0.3e1_dp/0.2e1_dp*beta_3_2*t193*rs_s1rhoa + t233*t215* & rs_s1rhoa/rs_s1)/t238 t825 = gamma_var**2 t827 = beta/t825 @@ -1518,50 +1518,50 @@ SUBROUTINE tpss_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, norm_drho, & t861 = 0.1e1_dp/t370 t863 = epsilon_cGGA .LT. epsilon_cGGA_1_0 IF (t863) THEN - marhoa = e_c_u_1_s1rhoa+t358*(0.2e1_dp*t833* & - t834*t_s1rhoa+t349*t359*(t838+t841)*t367-t846*t849* & - (t838+t841+0.2e1_dp*A_s1*t364*A_s1rhoa+0.4e1_dp*t854 & - *t_s1rhoa))*t861 + marhoa = e_c_u_1_s1rhoa + t358*(0.2e1_dp*t833* & + t834*t_s1rhoa + t349*t359*(t838 + t841)*t367 - t846*t849* & + (t838 + t841 + 0.2e1_dp*A_s1*t364*A_s1rhoa + 0.4e1_dp*t854 & + *t_s1rhoa))*t861 ELSE marhoa = epsilon_cGGArhoa END IF t873 = t462*tau_w t879 = my_rhoa*t438*ma t882 = my_rhob*t438*mb - epsilon_cRevPKZBrhoa = epsilon_cGGArhoa+(epsilon_cGGArhoa* & - C_chi_eps*t460+epsilon_cGGA*C_chi_epsrhoa*t460+0.2e1_dp* & - t459*tau_w*tau_wrhoa-C_chi_epsrhoa*t460*t468-0.2e1_dp* & - t873*t468*tau_wrhoa-t463*(t275*ma-t879+t464*marhoa- & - t882+t466*mbrhoa))*t472 + epsilon_cRevPKZBrhoa = epsilon_cGGArhoa + (epsilon_cGGArhoa* & + C_chi_eps*t460 + epsilon_cGGA*C_chi_epsrhoa*t460 + 0.2e1_dp* & + t459*tau_w*tau_wrhoa - C_chi_epsrhoa*t460*t468 - 0.2e1_dp* & + t873*t468*tau_wrhoa - t463*(t275*ma - t879 + t464*marhoa - & + t882 + t466*mbrhoa))*t472 t888 = epsilon_cRevPKZB*t481 t893 = t460*t478 IF (grad_deriv == -1 .OR. grad_deriv >= 1) THEN - e_rhoa(ii) = e_rhoa(ii)+ & - scale_ex*(0.2e1_dp*ex_unif_sp1*Fx_sp1-my_rhoa* & - t559*t18*t561*Fx_sp1/0.2e1_dp+0.2e1_dp*t83* & - t558*(((0.2e1_dp*t513*t45*z_sp1rhoa-0.4e1_dp*t518* & - t520*z_sp1rhoa)*p_sp1+t47*p_sp1rhoa+0.292e3_dp/ & - 0.2025e4_dp*tildeq_b_sp1*tildeq_b_sp1rhoa-0.73e2_dp/ & - 0.4050e4_dp*tildeq_b_sp1rhoa*t55-0.73e2_dp/0.8100e4_dp* & - t532*(0.36e2_dp*z_sp1*z_sp1rhoa+0.100e3_dp*p_sp1* & - p_sp1rhoa)+0.200e3_dp/0.6561e4_dp*t540*p_sp1rhoa+0.8e1_dp & - /0.45e2_dp*t543*z_sp1rhoa+0.3e1_dp*t64*t52*p_sp1rhoa)* & - t71-0.2e1_dp*t553*t61*p_sp1rhoa))/0.2e1_dp+scale_ec*( & - t888+rho*epsilon_cRevPKZBrhoa*t481+t474*(d* & - epsilon_cRevPKZBrhoa*t479+0.3e1_dp*t475*t893*tau_wrhoa)) + e_rhoa(ii) = e_rhoa(ii) + & + scale_ex*(0.2e1_dp*ex_unif_sp1*Fx_sp1 - my_rhoa* & + t559*t18*t561*Fx_sp1/0.2e1_dp + 0.2e1_dp*t83* & + t558*(((0.2e1_dp*t513*t45*z_sp1rhoa - 0.4e1_dp*t518* & + t520*z_sp1rhoa)*p_sp1 + t47*p_sp1rhoa + 0.292e3_dp/ & + 0.2025e4_dp*tildeq_b_sp1*tildeq_b_sp1rhoa - 0.73e2_dp/ & + 0.4050e4_dp*tildeq_b_sp1rhoa*t55 - 0.73e2_dp/0.8100e4_dp* & + t532*(0.36e2_dp*z_sp1*z_sp1rhoa + 0.100e3_dp*p_sp1* & + p_sp1rhoa) + 0.200e3_dp/0.6561e4_dp*t540*p_sp1rhoa + 0.8e1_dp & + /0.45e2_dp*t543*z_sp1rhoa + 0.3e1_dp*t64*t52*p_sp1rhoa)* & + t71 - 0.2e1_dp*t553*t61*p_sp1rhoa))/0.2e1_dp + scale_ec*( & + t888 + rho*epsilon_cRevPKZBrhoa*t481 + t474*(d* & + epsilon_cRevPKZBrhoa*t479 + 0.3e1_dp*t475*t893*tau_wrhoa)) END IF p_sp2rhob = -t85*t19/t88/t86/my_rhob/0.9e1_dp t908 = 0.1e1_dp/t86 z_sp2rhob = -t5*t908*t93/0.8e1_dp t914 = p_sp2/t107 - alpha_sp2rhob = 0.5e1_dp/0.3e1_dp*p_sp2rhob*t96-0.5e1_dp/ & + alpha_sp2rhob = 0.5e1_dp/0.3e1_dp*p_sp2rhob*t96 - 0.5e1_dp/ & 0.3e1_dp*t914*z_sp2rhob t921 = t98/t102/t101 - tildeq_b_sp2rhob = 0.9e1_dp/0.20e2_dp*alpha_sp2rhob*t103- & - 0.9e1_dp/0.40e2_dp*t921*(b*alpha_sp2rhob*t98+t99* & - alpha_sp2rhob)+0.2e1_dp/0.3e1_dp*p_sp2rhob + tildeq_b_sp2rhob = 0.9e1_dp/0.20e2_dp*alpha_sp2rhob*t103 - & + 0.9e1_dp/0.40e2_dp*t921*(b*alpha_sp2rhob*t98 + t99* & + alpha_sp2rhob) + 0.2e1_dp/0.3e1_dp*p_sp2rhob t929 = c*z_sp2 t934 = c*t107*z_sp2 t936 = 0.1e1_dp/t110/t109 @@ -1573,40 +1573,40 @@ SUBROUTINE tpss_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, norm_drho, & t974 = 0.1e1_dp/t973 t975 = t140**2 t976 = 0.1e1_dp/t975 - chirhob = -t275-t570 + chirhob = -t275 - t570 rsrhob = rsrhoa - e_c_u_0rhob = -0.2e1_dp*t577*rsrhob*t294+t583*(t585* & - rsrhob/0.2e1_dp+beta_2_1*rsrhob+0.3e1_dp/0.2e1_dp*t589* & - rsrhob+t288*t179*rsrhob*t593)*t597 - frhob = (0.4e1_dp/0.3e1_dp*t329*chirhob-0.4e1_dp/ & + e_c_u_0rhob = -0.2e1_dp*t577*rsrhob*t294 + t583*(t585* & + rsrhob/0.2e1_dp + beta_2_1*rsrhob + 0.3e1_dp/0.2e1_dp*t589* & + rsrhob + t288*t179*rsrhob*t593)*t597 + frhob = (0.4e1_dp/0.3e1_dp*t329*chirhob - 0.4e1_dp/ & 0.3e1_dp*t332*chirhob)*t337 t1043 = t650*chirhob - epsilon_c_unifrhob = e_c_u_0rhob+(0.2e1_dp*t621*rsrhob* & - t326-t627*(t628*rsrhob/0.2e1_dp+beta_2_3*rsrhob+ & - 0.3e1_dp/0.2e1_dp*t632*rsrhob+t320*t249*rsrhob*t593)* & - t639)*f*t343+alpha_c*frhob*t343-0.4e1_dp*t338*t651 & - *chirhob+(-0.2e1_dp*t600*rsrhob*t310+t606*(t607* & - rsrhob/0.2e1_dp+beta_2_2*rsrhob+0.3e1_dp/0.2e1_dp*t611* & - rsrhob+t304*t215*rsrhob*t593)*t618-e_c_u_0rhob)*f* & - t341+t345*frhob*t341+0.4e1_dp*t346*t1043 - phirhob = t663*chirhob/0.3e1_dp-t665*chirhob/0.3e1_dp - trhob = -t675*t404*phirhob/0.2e1_dp-t402*t680*t672* & - k_frhoa*t76/0.2e1_dp-t684/0.2e1_dp - Arhob = -t349*t687*(-epsilon_c_unifrhob*t348*t409+ & + epsilon_c_unifrhob = e_c_u_0rhob + (0.2e1_dp*t621*rsrhob* & + t326 - t627*(t628*rsrhob/0.2e1_dp + beta_2_3*rsrhob + & + 0.3e1_dp/0.2e1_dp*t632*rsrhob + t320*t249*rsrhob*t593)* & + t639)*f*t343 + alpha_c*frhob*t343 - 0.4e1_dp*t338*t651 & + *chirhob + (-0.2e1_dp*t600*rsrhob*t310 + t606*(t607* & + rsrhob/0.2e1_dp + beta_2_2*rsrhob + 0.3e1_dp/0.2e1_dp*t611* & + rsrhob + t304*t215*rsrhob*t593)*t618 - e_c_u_0rhob)*f* & + t341 + t345*frhob*t341 + 0.4e1_dp*t346*t1043 + phirhob = t663*chirhob/0.3e1_dp - t665*chirhob/0.3e1_dp + trhob = -t675*t404*phirhob/0.2e1_dp - t402*t680*t672* & + k_frhoa*t76/0.2e1_dp - t684/0.2e1_dp + Arhob = -t349*t687*(-epsilon_c_unifrhob*t348*t409 + & 0.3e1_dp*t406*t691*phirhob)*t411 t1070 = Arhob*t415 t1072 = 0.2e1_dp*t709*trhob - epsilon_cGGArhob = epsilon_c_unifrhob+0.3e1_dp*t699*t427* & - phirhob+t414*(0.2e1_dp*t703*t704*trhob+t349*t415*( & - t1070+t1072)*t423-t716*t719*(t1070+t1072+0.2e1_dp* & - t720*Arhob+0.4e1_dp*t724*trhob))*t731 + epsilon_cGGArhob = epsilon_c_unifrhob + 0.3e1_dp*t699*t427* & + phirhob + t414*(0.2e1_dp*t703*t704*trhob + t349*t415*( & + t1070 + t1072)*t423 - t716*t719*(t1070 + t1072 + 0.2e1_dp* & + t720*Arhob + 0.4e1_dp*t724*trhob))*t731 tau_wrhob = tau_wrhoa - C_chi_epsrhob = (0.174e1_dp*chi*chirhob+0.20e1_dp*t1043+ & - 0.1356e2_dp*t758*chirhob)*t458-0.4e1_dp*t766*(t767*(( & - t735*(0.2e1_dp*t739-my_rhoa*t431+my_rhoa*t1+t736)- & - t746)*t440*t442/0.6e1_dp-t754)+t449*(-0.4e1_dp/ & - 0.3e1_dp*t771*chirhob+0.4e1_dp/0.3e1_dp*t775*chirhob)/ & - 0.2e1_dp) + C_chi_epsrhob = (0.174e1_dp*chi*chirhob + 0.20e1_dp*t1043 + & + 0.1356e2_dp*t758*chirhob)*t458 - 0.4e1_dp*t766*(t767*(( & + t735*(0.2e1_dp*t739 - my_rhoa*t431 + my_rhoa*t1 + t736) - & + t746)*t440*t442/0.6e1_dp - t754) + t449*(-0.4e1_dp/ & + 0.3e1_dp*t771*chirhob + 0.4e1_dp/0.3e1_dp*t775*chirhob)/ & + 0.2e1_dp) IF (t863) THEN marhob = 0._dp ELSE @@ -1616,11 +1616,11 @@ SUBROUTINE tpss_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, norm_drho, & rs_s2rhob = -t148/t1111*t76*t908/0.12e2_dp t1121 = k_s_s2**2 t_s2rhob = -t166/t1121*t6/t164*t12*t976* & - t14*t76/0.6e1_dp-t166*t167*t908/0.2e1_dp + t14*t76/0.6e1_dp - t166*t167*t908/0.2e1_dp t1132 = t218**2 - e_c_u_1_s2rhob = -0.2e1_dp*t600*rs_s2rhob*t223+t209/ & - t1132*(beta_1_2/t174*rs_s2rhob/0.2e1_dp+beta_2_2* & - rs_s2rhob+0.3e1_dp/0.2e1_dp*beta_3_2*t174*rs_s2rhob+t217 & + e_c_u_1_s2rhob = -0.2e1_dp*t600*rs_s2rhob*t223 + t209/ & + t1132*(beta_1_2/t174*rs_s2rhob/0.2e1_dp + beta_2_2* & + rs_s2rhob + 0.3e1_dp/0.2e1_dp*beta_3_2*t174*rs_s2rhob + t217 & *t215*rs_s2rhob/rs_s2)/t222 t1151 = t378**2 A_s2rhob = t827/t1151*e_c_u_1_s2rhob*t375*t377 @@ -1636,118 +1636,118 @@ SUBROUTINE tpss_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, norm_drho, & t1177 = t385*t1176 t1184 = 0.1e1_dp/t392 IF (t784) THEN - mbrhob = e_c_u_1_s2rhob+t380*(0.2e1_dp*t1156* & - t1157*t_s2rhob+t349*t381*(t1161+t1164)*t389-t1169* & - t1172*(t1161+t1164+0.2e1_dp*A_s2*t386*A_s2rhob+ & - 0.4e1_dp*t1177*t_s2rhob))*t1184 + mbrhob = e_c_u_1_s2rhob + t380*(0.2e1_dp*t1156* & + t1157*t_s2rhob + t349*t381*(t1161 + t1164)*t389 - t1169* & + t1172*(t1161 + t1164 + 0.2e1_dp*A_s2*t386*A_s2rhob + & + 0.4e1_dp*t1177*t_s2rhob))*t1184 ELSE mbrhob = epsilon_cGGArhob END IF - epsilon_cRevPKZBrhob = epsilon_cGGArhob+(epsilon_cGGArhob* & - C_chi_eps*t460+epsilon_cGGA*C_chi_epsrhob*t460+0.2e1_dp* & - t459*tau_w*tau_wrhob-C_chi_epsrhob*t460*t468-0.2e1_dp* & - t873*t468*tau_wrhob-t463*(-t879+t464*marhob+t275*mb & - -t882+t466*mbrhob))*t472 + epsilon_cRevPKZBrhob = epsilon_cGGArhob + (epsilon_cGGArhob* & + C_chi_eps*t460 + epsilon_cGGA*C_chi_epsrhob*t460 + 0.2e1_dp* & + t459*tau_w*tau_wrhob - C_chi_epsrhob*t460*t468 - 0.2e1_dp* & + t873*t468*tau_wrhob - t463*(-t879 + t464*marhob + t275*mb & + - t882 + t466*mbrhob))*t472 IF (grad_deriv == -1 .OR. grad_deriv >= 1) THEN - e_rhob(ii) = e_rhob(ii)+ & - scale_ex*(0.2e1_dp*ex_unif_sp2*Fx_sp2-my_rhob* & - t559*t18*t976*Fx_sp2/0.2e1_dp+0.2e1_dp*t144 & - *t974*(((0.2e1_dp*t929*t111*z_sp2rhob-0.4e1_dp*t934* & - t936*z_sp2rhob)*p_sp2+t113*p_sp2rhob+0.292e3_dp/ & - 0.2025e4_dp*tildeq_b_sp2*tildeq_b_sp2rhob-0.73e2_dp/ & - 0.4050e4_dp*tildeq_b_sp2rhob*t121-0.73e2_dp/0.8100e4_dp* & - t948*(0.36e2_dp*z_sp2*z_sp2rhob+0.100e3_dp*p_sp2* & - p_sp2rhob)+0.200e3_dp/0.6561e4_dp*t956*p_sp2rhob+0.8e1_dp & - /0.45e2_dp*t959*z_sp2rhob+0.3e1_dp*t64*t118*p_sp2rhob) & - *t134-0.2e1_dp*t969*t61*p_sp2rhob))/0.2e1_dp+scale_ec* & - (t888+rho*epsilon_cRevPKZBrhob*t481+t474*(d* & - epsilon_cRevPKZBrhob*t479+0.3e1_dp*t475*t893*tau_wrhob)) + e_rhob(ii) = e_rhob(ii) + & + scale_ex*(0.2e1_dp*ex_unif_sp2*Fx_sp2 - my_rhob* & + t559*t18*t976*Fx_sp2/0.2e1_dp + 0.2e1_dp*t144 & + *t974*(((0.2e1_dp*t929*t111*z_sp2rhob - 0.4e1_dp*t934* & + t936*z_sp2rhob)*p_sp2 + t113*p_sp2rhob + 0.292e3_dp/ & + 0.2025e4_dp*tildeq_b_sp2*tildeq_b_sp2rhob - 0.73e2_dp/ & + 0.4050e4_dp*tildeq_b_sp2rhob*t121 - 0.73e2_dp/0.8100e4_dp* & + t948*(0.36e2_dp*z_sp2*z_sp2rhob + 0.100e3_dp*p_sp2* & + p_sp2rhob) + 0.200e3_dp/0.6561e4_dp*t956*p_sp2rhob + 0.8e1_dp & + /0.45e2_dp*t959*z_sp2rhob + 0.3e1_dp*t64*t118*p_sp2rhob) & + *t134 - 0.2e1_dp*t969*t61*p_sp2rhob))/0.2e1_dp + scale_ec* & + (t888 + rho*epsilon_cRevPKZBrhob*t481 + t474*(d* & + epsilon_cRevPKZBrhob*t479 + 0.3e1_dp*t475*t893*tau_wrhob)) END IF p_sp1norm_drhoa = my_norm_drhoa*t12*t25/0.12e2_dp z_sp1norm_drhoa = my_norm_drhoa*t2*t27/0.4e1_dp alpha_sp1norm_drhoa = 0.5e1_dp/0.3e1_dp*p_sp1norm_drhoa*t30 & - -0.5e1_dp/0.3e1_dp*t498*z_sp1norm_drhoa + - 0.5e1_dp/0.3e1_dp*t498*z_sp1norm_drhoa tildeq_b_sp1norm_drhoa = 0.9e1_dp/0.20e2_dp* & - alpha_sp1norm_drhoa*t37-0.9e1_dp/0.40e2_dp*t505*(b* & - alpha_sp1norm_drhoa*t32+t33*alpha_sp1norm_drhoa)+0.2e1_dp/ & + alpha_sp1norm_drhoa*t37 - 0.9e1_dp/0.40e2_dp*t505*(b* & + alpha_sp1norm_drhoa*t32 + t33*alpha_sp1norm_drhoa) + 0.2e1_dp/ & 0.3e1_dp*p_sp1norm_drhoa t_s1norm_drhoa = t155*t157*t2/0.2e1_dp C_chi_epsnorm_drhoa = -0.2e1_dp/0.3e1_dp*t766*t767*t735* & - (0.2e1_dp*my_norm_drhoa*t86+0.2e1_dp*t430*my_norm_drhoa)* & + (0.2e1_dp*my_norm_drhoa*t86 + 0.2e1_dp*t430*my_norm_drhoa)* & t440*t442 IF (t863) THEN manorm_drhoa = t358*(0.2e1_dp*t833*t834* & - t_s1norm_drhoa+0.2e1_dp*t349*t853*A_s1*t_s1norm_drhoa* & - t367-t846*t849*(0.2e1_dp*t839*t_s1norm_drhoa+0.4e1_dp* & - t854*t_s1norm_drhoa))*t861 + t_s1norm_drhoa + 0.2e1_dp*t349*t853*A_s1*t_s1norm_drhoa* & + t367 - t846*t849*(0.2e1_dp*t839*t_s1norm_drhoa + 0.4e1_dp* & + t854*t_s1norm_drhoa))*t861 ELSE manorm_drhoa = 0._dp END IF epsilon_cRevPKZBnorm_drhoa = (epsilon_cGGA*C_chi_epsnorm_drhoa* & - t460-C_chi_epsnorm_drhoa*t460*t468-t463*t464* & + t460 - C_chi_epsnorm_drhoa*t460*t468 - t463*t464* & manorm_drhoa)*t472 t1303 = t474*d IF (grad_deriv == -1 .OR. grad_deriv >= 1) THEN - e_ndrhoa(ii) = e_ndrhoa(ii)+ & + e_ndrhoa(ii) = e_ndrhoa(ii) + & scale_ex*t83*t558*(((0.2e1_dp*t513* & - t45*z_sp1norm_drhoa-0.4e1_dp*t518*t520*z_sp1norm_drhoa)* & - p_sp1+t47*p_sp1norm_drhoa+0.292e3_dp/0.2025e4_dp* & - tildeq_b_sp1*tildeq_b_sp1norm_drhoa-0.73e2_dp/0.4050e4_dp* & - tildeq_b_sp1norm_drhoa*t55-0.73e2_dp/0.8100e4_dp*t532*( & - 0.36e2_dp*z_sp1*z_sp1norm_drhoa+0.100e3_dp*p_sp1* & - p_sp1norm_drhoa)+0.200e3_dp/0.6561e4_dp*t540*p_sp1norm_drhoa & - +0.8e1_dp/0.45e2_dp*t543*z_sp1norm_drhoa+0.3e1_dp*t64* & - t52*p_sp1norm_drhoa)*t71-0.2e1_dp*t553*t61* & - p_sp1norm_drhoa)+scale_ec*(rho*epsilon_cRevPKZBnorm_drhoa* & - t481+t1303*epsilon_cRevPKZBnorm_drhoa*t476*t478) + t45*z_sp1norm_drhoa - 0.4e1_dp*t518*t520*z_sp1norm_drhoa)* & + p_sp1 + t47*p_sp1norm_drhoa + 0.292e3_dp/0.2025e4_dp* & + tildeq_b_sp1*tildeq_b_sp1norm_drhoa - 0.73e2_dp/0.4050e4_dp* & + tildeq_b_sp1norm_drhoa*t55 - 0.73e2_dp/0.8100e4_dp*t532*( & + 0.36e2_dp*z_sp1*z_sp1norm_drhoa + 0.100e3_dp*p_sp1* & + p_sp1norm_drhoa) + 0.200e3_dp/0.6561e4_dp*t540*p_sp1norm_drhoa & + + 0.8e1_dp/0.45e2_dp*t543*z_sp1norm_drhoa + 0.3e1_dp*t64* & + t52*p_sp1norm_drhoa)*t71 - 0.2e1_dp*t553*t61* & + p_sp1norm_drhoa) + scale_ec*(rho*epsilon_cRevPKZBnorm_drhoa* & + t481 + t1303*epsilon_cRevPKZBnorm_drhoa*t476*t478) END IF p_sp2norm_drhob = my_norm_drhob*t12*t91/0.12e2_dp z_sp2norm_drhob = my_norm_drhob*t6*t93/0.4e1_dp alpha_sp2norm_drhob = 0.5e1_dp/0.3e1_dp*p_sp2norm_drhob*t96 & - -0.5e1_dp/0.3e1_dp*t914*z_sp2norm_drhob + - 0.5e1_dp/0.3e1_dp*t914*z_sp2norm_drhob tildeq_b_sp2norm_drhob = 0.9e1_dp/0.20e2_dp* & - alpha_sp2norm_drhob*t103-0.9e1_dp/0.40e2_dp*t921*(b* & - alpha_sp2norm_drhob*t98+t99*alpha_sp2norm_drhob)+0.2e1_dp/ & + alpha_sp2norm_drhob*t103 - 0.9e1_dp/0.40e2_dp*t921*(b* & + alpha_sp2norm_drhob*t98 + t99*alpha_sp2norm_drhob) + 0.2e1_dp/ & 0.3e1_dp*p_sp2norm_drhob t_s2norm_drhob = t165*t167*t6/0.2e1_dp C_chi_epsnorm_drhob = -0.2e1_dp/0.3e1_dp*t766*t767*t735* & - (0.2e1_dp*my_norm_drhob*t20+0.2e1_dp*t430*my_norm_drhob)* & + (0.2e1_dp*my_norm_drhob*t20 + 0.2e1_dp*t430*my_norm_drhob)* & t440*t442 IF (t784) THEN mbnorm_drhob = t380*(0.2e1_dp*t1156*t1157* & - t_s2norm_drhob+0.2e1_dp*t349*t1176*A_s2*t_s2norm_drhob* & - t389-t1169*t1172*(0.2e1_dp*t1162*t_s2norm_drhob+0.4e1_dp & - *t1177*t_s2norm_drhob))*t1184 + t_s2norm_drhob + 0.2e1_dp*t349*t1176*A_s2*t_s2norm_drhob* & + t389 - t1169*t1172*(0.2e1_dp*t1162*t_s2norm_drhob + 0.4e1_dp & + *t1177*t_s2norm_drhob))*t1184 ELSE mbnorm_drhob = 0._dp END IF epsilon_cRevPKZBnorm_drhob = (epsilon_cGGA*C_chi_epsnorm_drhob* & - t460-C_chi_epsnorm_drhob*t460*t468-t463*t466* & + t460 - C_chi_epsnorm_drhob*t460*t468 - t463*t466* & mbnorm_drhob)*t472 IF (grad_deriv == -1 .OR. grad_deriv >= 1) THEN - e_ndrhob(ii) = e_ndrhob(ii)+ & + e_ndrhob(ii) = e_ndrhob(ii) + & scale_ex*t144*t974*(((0.2e1_dp*t929* & - t111*z_sp2norm_drhob-0.4e1_dp*t934*t936*z_sp2norm_drhob)* & - p_sp2+t113*p_sp2norm_drhob+0.292e3_dp/0.2025e4_dp* & - tildeq_b_sp2*tildeq_b_sp2norm_drhob-0.73e2_dp/0.4050e4_dp* & - tildeq_b_sp2norm_drhob*t121-0.73e2_dp/0.8100e4_dp*t948*( & - 0.36e2_dp*z_sp2*z_sp2norm_drhob+0.100e3_dp*p_sp2* & - p_sp2norm_drhob)+0.200e3_dp/0.6561e4_dp*t956*p_sp2norm_drhob & - +0.8e1_dp/0.45e2_dp*t959*z_sp2norm_drhob+0.3e1_dp*t64* & - t118*p_sp2norm_drhob)*t134-0.2e1_dp*t969*t61* & - p_sp2norm_drhob)+scale_ec*(rho*epsilon_cRevPKZBnorm_drhob* & - t481+t1303*epsilon_cRevPKZBnorm_drhob*t476*t478) + t111*z_sp2norm_drhob - 0.4e1_dp*t934*t936*z_sp2norm_drhob)* & + p_sp2 + t113*p_sp2norm_drhob + 0.292e3_dp/0.2025e4_dp* & + tildeq_b_sp2*tildeq_b_sp2norm_drhob - 0.73e2_dp/0.4050e4_dp* & + tildeq_b_sp2norm_drhob*t121 - 0.73e2_dp/0.8100e4_dp*t948*( & + 0.36e2_dp*z_sp2*z_sp2norm_drhob + 0.100e3_dp*p_sp2* & + p_sp2norm_drhob) + 0.200e3_dp/0.6561e4_dp*t956*p_sp2norm_drhob & + + 0.8e1_dp/0.45e2_dp*t959*z_sp2norm_drhob + 0.3e1_dp*t64* & + t118*p_sp2norm_drhob)*t134 - 0.2e1_dp*t969*t61* & + p_sp2norm_drhob) + scale_ec*(rho*epsilon_cRevPKZBnorm_drhob* & + t481 + t1303*epsilon_cRevPKZBnorm_drhob*t476*t478) END IF tnorm_drho = t401*t403*t275/0.2e1_dp - Hnorm_drho = t414*(0.2e1_dp*t703*t704*tnorm_drho+ & - 0.2e1_dp*t349*t723*A*tnorm_drho*t423-t716*t719*( & - 0.2e1_dp*t709*tnorm_drho+0.4e1_dp*t724*tnorm_drho))*t731 + Hnorm_drho = t414*(0.2e1_dp*t703*t704*tnorm_drho + & + 0.2e1_dp*t349*t723*A*tnorm_drho*t423 - t716*t719*( & + 0.2e1_dp*t709*tnorm_drho + 0.4e1_dp*t724*tnorm_drho))*t731 tau_wnorm_drho = my_norm_drho*t275/0.4e1_dp C_chi_epsnorm_drho = 0.4e1_dp/0.3e1_dp*t766*t767*t735* & t430*my_norm_drho*t440*t442 @@ -1761,56 +1761,56 @@ SUBROUTINE tpss_lsd_calc(rhoa, rhob, norm_drhoa, norm_drhob, norm_drho, & ELSE mbnorm_drho = Hnorm_drho END IF - epsilon_cRevPKZBnorm_drho = Hnorm_drho+(Hnorm_drho*C_chi_eps* & - t460+epsilon_cGGA*C_chi_epsnorm_drho*t460+0.2e1_dp*t459* & - tau_w*tau_wnorm_drho-C_chi_epsnorm_drho*t460*t468- & - 0.2e1_dp*t873*t468*tau_wnorm_drho-t463*(t464*manorm_drho & - +t466*mbnorm_drho))*t472 + epsilon_cRevPKZBnorm_drho = Hnorm_drho + (Hnorm_drho*C_chi_eps* & + t460 + epsilon_cGGA*C_chi_epsnorm_drho*t460 + 0.2e1_dp*t459* & + tau_w*tau_wnorm_drho - C_chi_epsnorm_drho*t460*t468 - & + 0.2e1_dp*t873*t468*tau_wnorm_drho - t463*(t464*manorm_drho & + + t466*mbnorm_drho))*t472 IF (grad_deriv == -1 .OR. grad_deriv >= 1) THEN - e_ndrho(ii) = e_ndrho(ii)+ & + e_ndrho(ii) = e_ndrho(ii) + & scale_ec*(rho*epsilon_cRevPKZBnorm_drho* & - t481+t474*(d*epsilon_cRevPKZBnorm_drho*t479+0.3e1_dp* & - t475*t893*tau_wnorm_drho)) + t481 + t474*(d*epsilon_cRevPKZBnorm_drho*t479 + 0.3e1_dp* & + t475*t893*tau_wnorm_drho)) END IF t1457 = my_tau_a**2 z_sp1tau_a = -tau_w_sp1/t1457/0.2e1_dp alpha_sp1tau_a = -0.5e1_dp/0.3e1_dp*t498*z_sp1tau_a - tildeq_b_sp1tau_a = 0.9e1_dp/0.20e2_dp*alpha_sp1tau_a*t37- & - 0.9e1_dp/0.40e2_dp*t505*(b*alpha_sp1tau_a*t32+t33* & + tildeq_b_sp1tau_a = 0.9e1_dp/0.20e2_dp*alpha_sp1tau_a*t37 - & + 0.9e1_dp/0.40e2_dp*t505*(b*alpha_sp1tau_a*t32 + t33* & alpha_sp1tau_a) epsilon_cRevPKZBtau_a = -0.2e1_dp*t470*t478 t1496 = t471**2 t1500 = 0.3e1_dp*t475*t476/t1496 IF (grad_deriv == -1 .OR. grad_deriv >= 1) THEN - e_tau_a(ii) = e_tau_a(ii)+ & + e_tau_a(ii) = e_tau_a(ii) + & scale_ex*t83*t558*((0.2e1_dp*t513*t45* & - z_sp1tau_a-0.4e1_dp*t518*t520*z_sp1tau_a)*p_sp1+ & - 0.292e3_dp/0.2025e4_dp*tildeq_b_sp1*tildeq_b_sp1tau_a- & - 0.73e2_dp/0.4050e4_dp*tildeq_b_sp1tau_a*t55-0.73e2_dp/ & - 0.225e3_dp*t532*z_sp1*z_sp1tau_a+0.8e1_dp/0.45e2_dp*t543 & - *z_sp1tau_a)*t71+scale_ec*(rho*epsilon_cRevPKZBtau_a* & - t481+t474*(d*epsilon_cRevPKZBtau_a*t479-t1500)) + z_sp1tau_a - 0.4e1_dp*t518*t520*z_sp1tau_a)*p_sp1 + & + 0.292e3_dp/0.2025e4_dp*tildeq_b_sp1*tildeq_b_sp1tau_a - & + 0.73e2_dp/0.4050e4_dp*tildeq_b_sp1tau_a*t55 - 0.73e2_dp/ & + 0.225e3_dp*t532*z_sp1*z_sp1tau_a + 0.8e1_dp/0.45e2_dp*t543 & + *z_sp1tau_a)*t71 + scale_ec*(rho*epsilon_cRevPKZBtau_a* & + t481 + t474*(d*epsilon_cRevPKZBtau_a*t479 - t1500)) END IF t1506 = my_tau_b**2 z_sp2tau_b = -tau_w_sp2/t1506/0.2e1_dp alpha_sp2tau_b = -0.5e1_dp/0.3e1_dp*t914*z_sp2tau_b - tildeq_b_sp2tau_b = 0.9e1_dp/0.20e2_dp*alpha_sp2tau_b*t103- & - 0.9e1_dp/0.40e2_dp*t921*(b*alpha_sp2tau_b*t98+t99* & + tildeq_b_sp2tau_b = 0.9e1_dp/0.20e2_dp*alpha_sp2tau_b*t103 - & + 0.9e1_dp/0.40e2_dp*t921*(b*alpha_sp2tau_b*t98 + t99* & alpha_sp2tau_b) epsilon_cRevPKZBtau_b = epsilon_cRevPKZBtau_a IF (grad_deriv == -1 .OR. grad_deriv >= 1) THEN - e_tau_b(ii) = e_tau_b(ii)+ & + e_tau_b(ii) = e_tau_b(ii) + & scale_ex*t144*t974*((0.2e1_dp*t929*t111* & - z_sp2tau_b-0.4e1_dp*t934*t936*z_sp2tau_b)*p_sp2+ & - 0.292e3_dp/0.2025e4_dp*tildeq_b_sp2*tildeq_b_sp2tau_b- & - 0.73e2_dp/0.4050e4_dp*tildeq_b_sp2tau_b*t121-0.73e2_dp/ & - 0.225e3_dp*t948*z_sp2*z_sp2tau_b+0.8e1_dp/0.45e2_dp*t959 & - *z_sp2tau_b)*t134+scale_ec*(rho*epsilon_cRevPKZBtau_b* & - t481+t474*(d*epsilon_cRevPKZBtau_b*t479-t1500)) + z_sp2tau_b - 0.4e1_dp*t934*t936*z_sp2tau_b)*p_sp2 + & + 0.292e3_dp/0.2025e4_dp*tildeq_b_sp2*tildeq_b_sp2tau_b - & + 0.73e2_dp/0.4050e4_dp*tildeq_b_sp2tau_b*t121 - 0.73e2_dp/ & + 0.225e3_dp*t948*z_sp2*z_sp2tau_b + 0.8e1_dp/0.45e2_dp*t959 & + *z_sp2tau_b)*t134 + scale_ec*(rho*epsilon_cRevPKZBtau_b* & + t481 + t474*(d*epsilon_cRevPKZBtau_b*t479 - t1500)) END IF END IF END IF diff --git a/src/xc/xc_vwn.F b/src/xc/xc_vwn.F index 7044e9eb12..ef003911d6 100644 --- a/src/xc/xc_vwn.F +++ b/src/xc/xc_vwn.F @@ -160,7 +160,7 @@ SUBROUTINE vwn_lda_eval(rho_set, deriv_set, order, vwn_params) CPASSERT(deriv_set%ref_count > 0) CALL xc_rho_set_get(rho_set, rho=rho, & local_bounds=bo, rho_cutoff=epsilon_rho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) CALL vwn_init(epsilon_rho, vwn_params) ALLOCATE (x(npoints)) @@ -229,9 +229,9 @@ SUBROUTINE vwn_lda_0(rho, x, e_0, npoints, sc) INTEGER :: ip REAL(KIND=dp) :: at, dpx, ln1, ln2, px, px0, q, xb - q = SQRT(4.0_dp*c-b*b) - xb = 2.0_dp*x0+b - px0 = x0*x0+b*x0+c + q = SQRT(4.0_dp*c - b*b) + xb = 2.0_dp*x0 + b + px0 = x0*x0 + b*x0 + c !$OMP PARALLEL DO DEFAULT(NONE) & !$OMP SHARED (npoints, rho, eps_rho, x, c, b, e_0, sc) & @@ -241,12 +241,12 @@ SUBROUTINE vwn_lda_0(rho, x, e_0, npoints, sc) DO ip = 1, npoints IF (rho(ip) > eps_rho) THEN - px = x(ip)*x(ip)+b*x(ip)+c - dpx = 2.0_dp*x(ip)+b + px = x(ip)*x(ip) + b*x(ip) + c + dpx = 2.0_dp*x(ip) + b at = 2.0_dp/q*ATAN(q/dpx) ln1 = LOG(x(ip)*x(ip)/px) - ln2 = LOG((x(ip)-x0)**2/px) - e_0(ip) = e_0(ip)+a*(ln1+b*at-b*x0/px0*(ln2+xb*at))*rho(ip)*sc + ln2 = LOG((x(ip) - x0)**2/px) + e_0(ip) = e_0(ip) + a*(ln1 + b*at - b*x0/px0*(ln2 + xb*at))*rho(ip)*sc END IF END DO @@ -274,9 +274,9 @@ SUBROUTINE vwn_lda_1(rho, x, e_rho, npoints, sc) REAL(KIND=dp) :: at, dat, dex, dln1, dln2, dpx, ex, ln1, & ln2, pa, px, px0, q, xb - q = SQRT(4.0_dp*c-b*b) - xb = 2.0_dp*x0+b - px0 = x0*x0+b*x0+c + q = SQRT(4.0_dp*c - b*b) + xb = 2.0_dp*x0 + b + px0 = x0*x0 + b*x0 + c !$OMP PARALLEL DO DEFAULT(NONE) & !$OMP SHARED(npoints, rho, eps_rho, x, b, sc, e_rho) & @@ -286,18 +286,18 @@ SUBROUTINE vwn_lda_1(rho, x, e_rho, npoints, sc) DO ip = 1, npoints IF (rho(ip) > eps_rho) THEN - px = x(ip)*x(ip)+b*x(ip)+c - dpx = 2.0_dp*x(ip)+b + px = x(ip)*x(ip) + b*x(ip) + c + dpx = 2.0_dp*x(ip) + b at = 2.0_dp/q*ATAN(q/dpx) - pa = 4.0_dp*x(ip)*x(ip)+4.0_dp*b*x(ip)+b*b+q*q + pa = 4.0_dp*x(ip)*x(ip) + 4.0_dp*b*x(ip) + b*b + q*q dat = -4.0_dp/pa ln1 = LOG(x(ip)*x(ip)/px) - dln1 = (b*x(ip)+2.0_dp*c)/(x(ip)*px) - ln2 = LOG((x(ip)-x0)**2/px) - dln2 = (b*x(ip)+2.0_dp*c+2.0_dp*x0*x(ip)+x0*b)/((x(ip)-x0)*px) - ex = a*(ln1+b*at-b*x0/px0*(ln2+xb*at)) - dex = a*(dln1+b*dat-b*x0/px0*(dln2+xb*dat)) - e_rho(ip) = e_rho(ip)+(ex-x(ip)*dex/6.0_dp)*sc + dln1 = (b*x(ip) + 2.0_dp*c)/(x(ip)*px) + ln2 = LOG((x(ip) - x0)**2/px) + dln2 = (b*x(ip) + 2.0_dp*c + 2.0_dp*x0*x(ip) + x0*b)/((x(ip) - x0)*px) + ex = a*(ln1 + b*at - b*x0/px0*(ln2 + xb*at)) + dex = a*(dln1 + b*dat - b*x0/px0*(dln2 + xb*dat)) + e_rho(ip) = e_rho(ip) + (ex - x(ip)*dex/6.0_dp)*sc END IF END DO @@ -326,9 +326,9 @@ SUBROUTINE vwn_lda_01(rho, x, e_0, e_rho, npoints, sc) REAL(KIND=dp) :: at, dat, dex, dln1, dln2, dpx, ex, ln1, & ln2, pa, px, px0, q, xb - q = SQRT(4.0_dp*c-b*b) - xb = 2.0_dp*x0+b - px0 = x0*x0+b*x0+c + q = SQRT(4.0_dp*c - b*b) + xb = 2.0_dp*x0 + b + px0 = x0*x0 + b*x0 + c !$OMP PARALLEL DO DEFAULT(NONE) & !$OMP SHARED(npoints, rho, eps_rho, x, b, c, e_0, sc) & @@ -338,19 +338,19 @@ SUBROUTINE vwn_lda_01(rho, x, e_0, e_rho, npoints, sc) DO ip = 1, npoints IF (rho(ip) > eps_rho) THEN - px = x(ip)*x(ip)+b*x(ip)+c - dpx = 2.0_dp*x(ip)+b + px = x(ip)*x(ip) + b*x(ip) + c + dpx = 2.0_dp*x(ip) + b at = 2.0_dp/q*ATAN(q/dpx) - pa = 4.0_dp*x(ip)*x(ip)+4.0_dp*b*x(ip)+b*b+q*q + pa = 4.0_dp*x(ip)*x(ip) + 4.0_dp*b*x(ip) + b*b + q*q dat = -4.0_dp/pa ln1 = LOG(x(ip)*x(ip)/px) - dln1 = (b*x(ip)+2.0_dp*c)/(x(ip)*px) - ln2 = LOG((x(ip)-x0)**2/px) - dln2 = (x(ip)*(b+2.0_dp*x0)+2.0_dp*c+x0*b)/((x(ip)-x0)*px) - ex = a*(ln1+b*at-b*x0/px0*(ln2+xb*at)) - dex = a*(dln1+b*dat-b*x0/px0*(dln2+xb*dat)) - e_0(ip) = e_0(ip)+ex*rho(ip)*sc - e_rho(ip) = e_rho(ip)+(ex-x(ip)*dex/6.0_dp)*sc + dln1 = (b*x(ip) + 2.0_dp*c)/(x(ip)*px) + ln2 = LOG((x(ip) - x0)**2/px) + dln2 = (x(ip)*(b + 2.0_dp*x0) + 2.0_dp*c + x0*b)/((x(ip) - x0)*px) + ex = a*(ln1 + b*at - b*x0/px0*(ln2 + xb*at)) + dex = a*(dln1 + b*dat - b*x0/px0*(dln2 + xb*dat)) + e_0(ip) = e_0(ip) + ex*rho(ip)*sc + e_rho(ip) = e_rho(ip) + (ex - x(ip)*dex/6.0_dp)*sc END IF END DO @@ -379,9 +379,9 @@ SUBROUTINE vwn_lda_2(rho, x, e_rho_rho, npoints, sc) dln1, dln2, dpx, fp, ln1, ln2, pa, px, & px0, q, xb - q = SQRT(4.0_dp*c-b*b) - xb = 2.0_dp*x0+b - px0 = x0*x0+b*x0+c + q = SQRT(4.0_dp*c - b*b) + xb = 2.0_dp*x0 + b + px0 = x0*x0 + b*x0 + c fp = -b*x0/px0 !$OMP PARALLEL DO DEFAULT(NONE) & @@ -393,23 +393,23 @@ SUBROUTINE vwn_lda_2(rho, x, e_rho_rho, npoints, sc) DO ip = 1, npoints IF (rho(ip) > eps_rho) THEN - px = x(ip)*x(ip)+b*x(ip)+c - dpx = 2.0_dp*x(ip)+b + px = x(ip)*x(ip) + b*x(ip) + c + dpx = 2.0_dp*x(ip) + b at = 2.0_dp/q*ATAN(q/dpx) - pa = 4.0_dp*x(ip)*x(ip)+4.0_dp*b*x(ip)+b*b+q*q + pa = 4.0_dp*x(ip)*x(ip) + 4.0_dp*b*x(ip) + b*b + q*q dat = -4.0_dp/pa d2at = 16.0_dp*dpx/(pa*pa) ln1 = LOG(x(ip)*x(ip)/px) - dln1 = (b*x(ip)+2.0_dp*c)/(x(ip)*px) - d2ln1 = b/(x(ip)*px)-(b*x(ip)+2.0_dp*c)/(x(ip)*px)**2*(px+x(ip)*dpx) - ln2 = LOG((x(ip)-x0)**2/px) - dln2 = (x(ip)*xb+2.0_dp*c+x0*b)/((x(ip)-x0)*px) - d2ln2 = xb/((x(ip)-x0)*px)-(x(ip)*xb+2.0_dp*c+x0*b)/((x(ip)-x0)*px)**2 & - *(px+(x(ip)-x0)*dpx) - dex = a*(dln1+b*dat+fp*(dln2+xb*dat)) - d2ex = a*(d2ln1+b*d2at+fp*(d2ln2+xb*d2at)) + dln1 = (b*x(ip) + 2.0_dp*c)/(x(ip)*px) + d2ln1 = b/(x(ip)*px) - (b*x(ip) + 2.0_dp*c)/(x(ip)*px)**2*(px + x(ip)*dpx) + ln2 = LOG((x(ip) - x0)**2/px) + dln2 = (x(ip)*xb + 2.0_dp*c + x0*b)/((x(ip) - x0)*px) + d2ln2 = xb/((x(ip) - x0)*px) - (x(ip)*xb + 2.0_dp*c + x0*b)/((x(ip) - x0)*px)**2 & + *(px + (x(ip) - x0)*dpx) + dex = a*(dln1 + b*dat + fp*(dln2 + xb*dat)) + d2ex = a*(d2ln1 + b*d2at + fp*(d2ln2 + xb*d2at)) e_rho_rho(ip) = e_rho_rho(ip) & - +(x(ip)/(36.0_dp*rho(ip))*(x(ip)*d2ex-5.0_dp*dex))*sc + + (x(ip)/(36.0_dp*rho(ip))*(x(ip)*d2ex - 5.0_dp*dex))*sc END IF END DO @@ -439,9 +439,9 @@ SUBROUTINE vwn_lda_3(rho, x, e_rho_rho_rho, npoints, sc) dpx, dx, fp, ln1, ln2, pa, px, px0, q, & xb - q = SQRT(4.0_dp*c-b*b) - xb = 2.0_dp*x0+b - px0 = x0*x0+b*x0+c + q = SQRT(4.0_dp*c - b*b) + xb = 2.0_dp*x0 + b + px0 = x0*x0 + b*x0 + c fp = -b*x0/px0 !$OMP PARALLEL DO DEFAULT(NONE) & @@ -453,35 +453,35 @@ SUBROUTINE vwn_lda_3(rho, x, e_rho_rho_rho, npoints, sc) DO ip = 1, npoints IF (rho(ip) > eps_rho) THEN - px = x(ip)*x(ip)+b*x(ip)+c - dpx = 2.0_dp*x(ip)+b + px = x(ip)*x(ip) + b*x(ip) + c + dpx = 2.0_dp*x(ip) + b at = 2.0_dp/q*ATAN(q/dpx) - pa = 4.0_dp*x(ip)*x(ip)+4.0_dp*b*x(ip)+b*b+q*q + pa = 4.0_dp*x(ip)*x(ip) + 4.0_dp*b*x(ip) + b*b + q*q dat = -4.0_dp/pa d2at = 16.0_dp*dpx/(pa*pa) - d3at = 32.0_dp/(pa*pa)*(1.0_dp-4.0_dp*dpx*dpx/pa) + d3at = 32.0_dp/(pa*pa)*(1.0_dp - 4.0_dp*dpx*dpx/pa) ln1 = LOG(x(ip)*x(ip)/px) - ax = b*x(ip)+2.0_dp*c + ax = b*x(ip) + 2.0_dp*c bx = x(ip)*px - dbx = px+x(ip)*dpx - d2bx = 2.0_dp*(dpx+x(ip)) + dbx = px + x(ip)*dpx + d2bx = 2.0_dp*(dpx + x(ip)) dln1 = ax/bx - d2ln1 = (b*bx-ax*dbx)/(bx*bx) - d3ln1 = -ax*d2bx/(bx*bx)-2.0_dp*d2ln1*dbx/bx - ln2 = LOG((x(ip)-x0)**2/px) - cx = x(ip)*xb+2.0_dp*c+x0*b - dx = (x(ip)-x0)*px - ddx = px+(x(ip)-x0)*dpx - d2dx = 2.0_dp*(dpx+(x(ip)-x0)) + d2ln1 = (b*bx - ax*dbx)/(bx*bx) + d3ln1 = -ax*d2bx/(bx*bx) - 2.0_dp*d2ln1*dbx/bx + ln2 = LOG((x(ip) - x0)**2/px) + cx = x(ip)*xb + 2.0_dp*c + x0*b + dx = (x(ip) - x0)*px + ddx = px + (x(ip) - x0)*dpx + d2dx = 2.0_dp*(dpx + (x(ip) - x0)) dln2 = cx/dx - d2ln2 = (xb*dx-cx*ddx)/(dx*dx) - d3ln2 = -cx*d2dx/(dx*dx)-2.0_dp*d2ln2*ddx/dx - dex = a*(dln1+b*dat+fp*(dln2+xb*dat)) - d2ex = a*(d2ln1+b*d2at+fp*(d2ln2+xb*d2at)) - d3ex = a*(d3ln1+b*d3at+fp*(d3ln2+xb*d3at)) + d2ln2 = (xb*dx - cx*ddx)/(dx*dx) + d3ln2 = -cx*d2dx/(dx*dx) - 2.0_dp*d2ln2*ddx/dx + dex = a*(dln1 + b*dat + fp*(dln2 + xb*dat)) + d2ex = a*(d2ln1 + b*d2at + fp*(d2ln2 + xb*d2at)) + d3ex = a*(d3ln1 + b*d3at + fp*(d3ln2 + xb*d3at)) e_rho_rho_rho(ip) = e_rho_rho_rho(ip) & - -(7.0_dp*x(ip)/(216.0_dp*rho(ip)*rho(ip))*(x(ip)*d2ex-5.0_dp*dex)+ & - x(ip)*x(ip)/(216.0_dp*rho(ip)*rho(ip))*(x(ip)*d3ex-4.0_dp*d2ex))*sc + - (7.0_dp*x(ip)/(216.0_dp*rho(ip)*rho(ip))*(x(ip)*d2ex - 5.0_dp*dex) + & + x(ip)*x(ip)/(216.0_dp*rho(ip)*rho(ip))*(x(ip)*d3ex - 4.0_dp*d2ex))*sc END IF END DO @@ -523,7 +523,7 @@ SUBROUTINE vwn_lsd_eval(rho_set, deriv_set, order, vwn_params) CPASSERT(deriv_set%ref_count > 0) CALL xc_rho_set_get(rho_set, rhoa=rhoa, rhob=rhob, & local_bounds=bo, rho_cutoff=epsilon_rho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) CALL vwn_init(epsilon_rho, vwn_params) dummy => rhoa @@ -688,18 +688,18 @@ SUBROUTINE vwn3_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & ap = a bp = b x0p = x0 - Qp = SQRT(4.0_dp*cp-bp*bp) - Qf = SQRT(4.0_dp*cf-bf*bf) + Qp = SQRT(4.0_dp*cp - bp*bp) + Qf = SQRT(4.0_dp*cf - bf*bf) !$OMP DO DO ip = 1, npoints myrhoa = MAX(rhoa(ip), 0.0_dp) myrhob = MAX(rhob(ip), 0.0_dp) - myrho = myrhoa+myrhob + myrho = myrhoa + myrhob IF (myrho > eps_rho) THEN myrhoa = MAX(EPSILON(0.0_dp)*1.e4_dp, myrhoa) myrhob = MAX(EPSILON(0.0_dp)*1.e4_dp, myrhob) - myrho = myrhoa+myrhob + myrho = myrhoa + myrhob IF (order >= 0) THEN t1 = 0.1e1_dp/0.3141592654e1_dp @@ -709,48 +709,48 @@ SUBROUTINE vwn3_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t5 = t4**0.3333333332e0_dp t6 = 0.9085602964e0_dp*t5 t7 = t4**0.1666666666e0_dp - t10 = t6+0.9531842930e0_dp*bp*t7+cp + t10 = t6 + 0.9531842930e0_dp*bp*t7 + cp t11 = 0.1e1_dp/t10 t14 = LOG(0.9085602964e0_dp*t5*t11) t15 = 0.1906368586e1_dp*t7 - t16 = t15+bp + t16 = t15 + bp t19 = ATAN(Qp/t16) t21 = 0.1e1_dp/Qp t24 = bp*x0p t25 = 0.9531842930e0_dp*t7 - t26 = t25-x0p + t26 = t25 - x0p t27 = t26**0.20e1_dp t29 = LOG(t27*t11) - t32 = 0.20e1_dp*bp+0.40e1_dp*x0p + t32 = 0.20e1_dp*bp + 0.40e1_dp*x0p t36 = x0p**0.20e1_dp - t38 = 0.1e1_dp/(t36+t24+cp) - t42 = ap*(t14+0.20e1_dp*bp*t19*t21-t24*(t29+t32*t19 & - *t21)*t38) - t43 = myrhoa-myrhob + t38 = 0.1e1_dp/(t36 + t24 + cp) + t42 = ap*(t14 + 0.20e1_dp*bp*t19*t21 - t24*(t29 + t32*t19 & + *t21)*t38) + t43 = myrhoa - myrhob t44 = t43*t3 - t45 = 0.10e1_dp+t44 + t45 = 0.10e1_dp + t44 t46 = t45**0.1333333333e1_dp - t48 = 0.10e1_dp-t44 + t48 = 0.10e1_dp - t44 t49 = t48**0.1333333333e1_dp - t51 = 0.1923661050e1_dp*t46+0.1923661050e1_dp*t49-0.3847322100e1_dp - t54 = t6+0.9531842930e0_dp*bf*t7+cf + t51 = 0.1923661050e1_dp*t46 + 0.1923661050e1_dp*t49 - 0.3847322100e1_dp + t54 = t6 + 0.9531842930e0_dp*bf*t7 + cf t55 = 0.1e1_dp/t54 t58 = LOG(0.9085602964e0_dp*t5*t55) - t59 = t15+bf + t59 = t15 + bf t62 = ATAN(Qf/t59) t64 = 0.1e1_dp/Qf t67 = bf*x0f - t68 = t25-x0f + t68 = t25 - x0f t69 = t68**0.20e1_dp t71 = LOG(t69*t55) - t74 = 0.20e1_dp*bf+0.40e1_dp*x0f + t74 = 0.20e1_dp*bf + 0.40e1_dp*x0f t78 = x0f**0.20e1_dp - t80 = 0.1e1_dp/(t78+t67+cf) - t85 = af*(t58+0.20e1_dp*bf*t62*t64-t67*(t71+t74*t62 & - *t64)*t80)-t42 + t80 = 0.1e1_dp/(t78 + t67 + cf) + t85 = af*(t58 + 0.20e1_dp*bf*t62*t64 - t67*(t71 + t74*t62 & + *t64)*t80) - t42 t86 = t51*t85 - e_0(ip) = e_0(ip)+((t42+t86)*t2)*sc + e_0(ip) = e_0(ip) + ((t42 + t86)*t2)*sc END IF IF (order >= 1 .OR. order == -1) THEN @@ -766,8 +766,8 @@ SUBROUTINE vwn3_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t100 = 0.3028534320e0_dp*t98*t91 t101 = t4**(-0.8333333334e0_dp) t102 = bp*t101 - t105 = -t100-0.1588640488e0_dp*t102*t92 - t108 = -0.3028534320e0_dp*t89*t92-0.9085602964e0_dp*t97*t105 + t105 = -t100 - 0.1588640488e0_dp*t102*t92 + t108 = -0.3028534320e0_dp*t89*t92 - 0.9085602964e0_dp*t97*t105 t109 = t4**(-0.3333333332e0_dp) t110 = t108*t109 t113 = t16**2 @@ -775,7 +775,7 @@ SUBROUTINE vwn3_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t115 = bp*t114 t116 = t115*t101 t117 = Qp**2 - t119 = 0.1e1_dp+t117*t114 + t119 = 0.1e1_dp + t117*t114 t120 = 0.1e1_dp/t119 t121 = t92*t120 t124 = t26**0.10e1_dp @@ -783,57 +783,57 @@ SUBROUTINE vwn3_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t126 = t101*t1 t127 = t126*t91 t130 = t27*t96 - t132 = -0.3177280976e0_dp*t125*t127-t130*t105 + t132 = -0.3177280976e0_dp*t125*t127 - t130*t105 t133 = t26**(-0.20e1_dp) t134 = t132*t133 t136 = t32*t114 t137 = t136*t101 - t144 = ap*(0.1100642416e1_dp*t110*t10+0.6354561950e0_dp*t116* & - t121-t24*(t134*t10+0.3177280975e0_dp*t137*t121)*t38) + t144 = ap*(0.1100642416e1_dp*t110*t10 + 0.6354561950e0_dp*t116* & + t121 - t24*(t134*t10 + 0.3177280975e0_dp*t137*t121)*t38) t145 = t45**0.333333333e0_dp t146 = t43*t91 - t147 = t3-t146 + t147 = t3 - t146 t150 = t48**0.333333333e0_dp t151 = -t147 - t154 = 0.2564881399e1_dp*t145*t147+0.2564881399e1_dp*t150*t151 + t154 = 0.2564881399e1_dp*t145*t147 + 0.2564881399e1_dp*t150*t151 t155 = t154*t85 t156 = t88*t55 t159 = t54**2 t160 = 0.1e1_dp/t159 t161 = t5*t160 t162 = bf*t101 - t165 = -t100-0.1588640488e0_dp*t162*t92 - t168 = -0.3028534320e0_dp*t156*t92-0.9085602964e0_dp*t161*t165 + t165 = -t100 - 0.1588640488e0_dp*t162*t92 + t168 = -0.3028534320e0_dp*t156*t92 - 0.9085602964e0_dp*t161*t165 t169 = t168*t109 t172 = t59**2 t173 = 0.1e1_dp/t172 t174 = bf*t173 t175 = t174*t101 t176 = Qf**2 - t178 = 0.1e1_dp+t176*t173 + t178 = 0.1e1_dp + t176*t173 t179 = 0.1e1_dp/t178 t180 = t92*t179 t183 = t68**0.10e1_dp t184 = t183*t55 t187 = t69*t160 - t189 = -0.3177280976e0_dp*t184*t127-t187*t165 + t189 = -0.3177280976e0_dp*t184*t127 - t187*t165 t190 = t68**(-0.20e1_dp) t191 = t189*t190 t193 = t74*t173 t194 = t193*t101 - t202 = af*(0.1100642416e1_dp*t169*t54+0.6354561950e0_dp*t175* & - t180-t67*(t191*t54+0.3177280975e0_dp*t194*t180)*t80)- & + t202 = af*(0.1100642416e1_dp*t169*t54 + 0.6354561950e0_dp*t175* & + t180 - t67*(t191*t54 + 0.3177280975e0_dp*t194*t180)*t80) - & t144 t203 = t51*t202 - e_a(ip) = e_a(ip)+((t144+t155+t203)*t2+t42+t86)*sc + e_a(ip) = e_a(ip) + ((t144 + t155 + t203)*t2 + t42 + t86)*sc - t206 = -t3-t146 + t206 = -t3 - t146 t209 = -t206 - t212 = 0.2564881399e1_dp*t145*t206+0.2564881399e1_dp*t150*t209 + t212 = 0.2564881399e1_dp*t145*t206 + 0.2564881399e1_dp*t150*t209 t213 = t212*t85 - e_b(ip) = e_b(ip)+((t144+t213+t203)*t2+t42+t86)*sc + e_b(ip) = e_b(ip) + ((t144 + t213 + t203)*t2 + t42 + t86)*sc END IF IF (order >= 2 .OR. order == -2) THEN @@ -858,10 +858,10 @@ SUBROUTINE vwn3_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t244 = 0.6057068640e0_dp*t98*t230 t245 = t4**(-0.1833333333e1_dp) t246 = bp*t245 - t251 = -t242+t244-0.1323867073e0_dp*t246*t222+0.3177280976e0_dp & + t251 = -t242 + t244 - 0.1323867073e0_dp*t246*t222 + 0.3177280976e0_dp & *t102*t231 - t254 = -0.2019022880e0_dp*t223+0.6057068640e0_dp*t225*t226+0.6057068640e0_dp & - *t89*t231+0.1817120593e1_dp*t236*t237-0.9085602964e0_dp & + t254 = -0.2019022880e0_dp*t223 + 0.6057068640e0_dp*t225*t226 + 0.6057068640e0_dp & + *t89*t231 + 0.1817120593e1_dp*t236*t237 - 0.9085602964e0_dp & *t97*t251 t255 = t254*t109 t258 = t4**(-0.1333333333e1_dp) @@ -887,9 +887,9 @@ SUBROUTINE vwn3_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t296 = t295*t221 t299 = t126*t230 t302 = t27*t235 - t306 = 0.5047557200e-1_dp*t223+0.6354561952e0_dp*t292*t226-0.2647734147e0_dp & - *t125*t296+0.6354561952e0_dp*t125*t299+0.2e1_dp* & - t302*t237-t130*t251 + t306 = 0.5047557200e-1_dp*t223 + 0.6354561952e0_dp*t292*t226 - 0.2647734147e0_dp & + *t125*t296 + 0.6354561952e0_dp*t125*t299 + 0.2e1_dp* & + t302*t237 - t130*t251 t307 = t306*t133 t309 = t26**(-0.30e1_dp) t310 = t132*t309 @@ -899,22 +899,22 @@ SUBROUTINE vwn3_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t319 = t136*t245 t324 = t32*t281 t325 = t324*t216 - t332 = ap*(0.1100642416e1_dp*t255*t10+0.3668808052e0_dp*t259* & - t261+0.1100642416e1_dp*t110*t105+0.4038045758e0_dp*t269*t270 & - +0.5295468292e0_dp*t273*t270-0.1270912390e1_dp*t116*t276-0.4038045758e0_dp & - *t283*t287-t24*(t307*t10+0.3177280976e0_dp* & - t311*t127+t134*t105+0.2019022879e0_dp*t316*t270+0.2647734146e0_dp & - *t319*t270-0.6354561950e0_dp*t137*t276-0.2019022879e0_dp & - *t325*t287)*t38) + t332 = ap*(0.1100642416e1_dp*t255*t10 + 0.3668808052e0_dp*t259* & + t261 + 0.1100642416e1_dp*t110*t105 + 0.4038045758e0_dp*t269*t270 & + + 0.5295468292e0_dp*t273*t270 - 0.1270912390e1_dp*t116*t276 - 0.4038045758e0_dp & + *t283*t287 - t24*(t307*t10 + 0.3177280976e0_dp* & + t311*t127 + t134*t105 + 0.2019022879e0_dp*t316*t270 + 0.2647734146e0_dp & + *t319*t270 - 0.6354561950e0_dp*t137*t276 - 0.2019022879e0_dp & + *t325*t287)*t38) t333 = t45**(-0.666666667e0_dp) t334 = t147**2 t337 = t43*t230 - t339 = -0.2e1_dp*t91+0.2e1_dp*t337 + t339 = -0.2e1_dp*t91 + 0.2e1_dp*t337 t342 = t48**(-0.666666667e0_dp) t343 = t151**2 t346 = -t339 - t349 = 0.8549604655e0_dp*t333*t334+0.2564881399e1_dp*t145*t339 & - +0.8549604655e0_dp*t342*t343+0.2564881399e1_dp*t150*t346 + t349 = 0.8549604655e0_dp*t333*t334 + 0.2564881399e1_dp*t145*t339 & + + 0.8549604655e0_dp*t342*t343 + 0.2564881399e1_dp*t150*t346 t350 = t349*t85 t351 = t154*t202 t352 = 0.2e1_dp*t351 @@ -926,10 +926,10 @@ SUBROUTINE vwn3_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t364 = t5*t363 t365 = t165**2 t368 = bf*t245 - t373 = -t242+t244-0.1323867073e0_dp*t368*t222+0.3177280976e0_dp & + t373 = -t242 + t244 - 0.1323867073e0_dp*t368*t222 + 0.3177280976e0_dp & *t162*t231 - t376 = -0.2019022880e0_dp*t354+0.6057068640e0_dp*t356*t357+0.6057068640e0_dp & - *t156*t231+0.1817120593e1_dp*t364*t365-0.9085602964e0_dp & + t376 = -0.2019022880e0_dp*t354 + 0.6057068640e0_dp*t356*t357 + 0.6057068640e0_dp & + *t156*t231 + 0.1817120593e1_dp*t364*t365 - 0.9085602964e0_dp & *t161*t373 t377 = t376*t109 t380 = t168*t258 @@ -951,9 +951,9 @@ SUBROUTINE vwn3_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t412 = t183*t160 t413 = t412*t101 t420 = t69*t363 - t424 = 0.5047557200e-1_dp*t354+0.6354561952e0_dp*t413*t357-0.2647734147e0_dp & - *t184*t296+0.6354561952e0_dp*t184*t299+0.2e1_dp* & - t420*t365-t187*t373 + t424 = 0.5047557200e-1_dp*t354 + 0.6354561952e0_dp*t413*t357 - 0.2647734147e0_dp & + *t184*t296 + 0.6354561952e0_dp*t184*t299 + 0.2e1_dp* & + t420*t365 - t187*t373 t425 = t424*t190 t427 = t68**(-0.30e1_dp) t428 = t189*t427 @@ -963,40 +963,40 @@ SUBROUTINE vwn3_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t437 = t193*t245 t442 = t74*t402 t443 = t442*t216 - t451 = af*(0.1100642416e1_dp*t377*t54+0.3668808052e0_dp*t380* & - t382+0.1100642416e1_dp*t169*t165+0.4038045758e0_dp*t390*t391 & - +0.5295468292e0_dp*t394*t391-0.1270912390e1_dp*t175*t397-0.4038045758e0_dp & - *t404*t408-t67*(t425*t54+0.3177280976e0_dp* & - t429*t127+t191*t165+0.2019022879e0_dp*t434*t391+0.2647734146e0_dp & - *t437*t391-0.6354561950e0_dp*t194*t397-0.2019022879e0_dp & - *t443*t408)*t80)-t332 + t451 = af*(0.1100642416e1_dp*t377*t54 + 0.3668808052e0_dp*t380* & + t382 + 0.1100642416e1_dp*t169*t165 + 0.4038045758e0_dp*t390*t391 & + + 0.5295468292e0_dp*t394*t391 - 0.1270912390e1_dp*t175*t397 - 0.4038045758e0_dp & + *t404*t408 - t67*(t425*t54 + 0.3177280976e0_dp* & + t429*t127 + t191*t165 + 0.2019022879e0_dp*t434*t391 + 0.2647734146e0_dp & + *t437*t391 - 0.6354561950e0_dp*t194*t397 - 0.2019022879e0_dp & + *t443*t408)*t80) - t332 t452 = t51*t451 t455 = 0.2e1_dp*t144 t457 = 0.2e1_dp*t203 - e_aa(ip) = e_aa(ip)+((t332+t350+t352+t452)*t2+t455+0.2e1_dp*t155+t457)*sc + e_aa(ip) = e_aa(ip) + ((t332 + t350 + t352 + t452)*t2 + t455 + 0.2e1_dp*t155 + t457)*sc t458 = t333*t147 t461 = t145*t43 t464 = t342*t151 t467 = t150*t43 - t470 = 0.8549604655e0_dp*t458*t206+0.5129762798e1_dp*t461*t230 & - +0.8549604655e0_dp*t464*t209-0.5129762798e1_dp*t467*t230 + t470 = 0.8549604655e0_dp*t458*t206 + 0.5129762798e1_dp*t461*t230 & + + 0.8549604655e0_dp*t464*t209 - 0.5129762798e1_dp*t467*t230 t471 = t470*t85 t472 = t212*t202 - e_ab(ip) = e_ab(ip)+((t332+t471+t351+t472+t452)*t2+t455+t155+t457 & - +t213)*sc + e_ab(ip) = e_ab(ip) + ((t332 + t471 + t351 + t472 + t452)*t2 + t455 + t155 + t457 & + + t213)*sc t475 = t206**2 - t479 = 0.2e1_dp*t91+0.2e1_dp*t337 + t479 = 0.2e1_dp*t91 + 0.2e1_dp*t337 t482 = t209**2 t485 = -t479 - t488 = 0.8549604655e0_dp*t333*t475+0.2564881399e1_dp*t145*t479 & - +0.8549604655e0_dp*t342*t482+0.2564881399e1_dp*t150*t485 + t488 = 0.8549604655e0_dp*t333*t475 + 0.2564881399e1_dp*t145*t479 & + + 0.8549604655e0_dp*t342*t482 + 0.2564881399e1_dp*t150*t485 t489 = t488*t85 t490 = 0.2e1_dp*t472 - e_bb(ip) = e_bb(ip)+((t332+t489+t490+t452)*t2+t455+0.2e1_dp*t213+t457)*sc + e_bb(ip) = e_bb(ip) + ((t332 + t489 + t490 + t452)*t2 + t455 + 0.2e1_dp*t213 + t457)*sc END IF IF (order >= 3 .OR. order == -3) THEN @@ -1022,8 +1022,8 @@ SUBROUTINE vwn3_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t538 = 0.1211413728e1_dp*t240*t508 t540 = 0.1817120592e1_dp*t98*t221 t541 = t4**(-0.2833333333e1_dp) - t549 = -t536+t538-t540-0.2427089633e0_dp*bp*t541*t500+0.7943202439e0_dp & - *t246*t509-0.9531842928e0_dp*t102*t522 + t549 = -t536 + t538 - t540 - 0.2427089633e0_dp*bp*t541*t500 + 0.7943202439e0_dp & + *t246*t509 - 0.9531842928e0_dp*t102*t522 t559 = t500*t120 t563 = 0.1e1_dp/t279/t113 t565 = t4**(-0.2500000000e1_dp) @@ -1042,44 +1042,44 @@ SUBROUTINE vwn3_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t690 = t541*t497*t499 t693 = t295*t508 t696 = t126*t221 - t705 = 0.8412595335e-1_dp*t501-0.1514267160e0_dp*t505-0.3028534320e0_dp & - *t510-0.1906368585e1_dp*t124*t235*t101*t513+0.7943202441e0_dp & - *t291*t245*t504-0.1906368585e1_dp*t292*t516+0.9531842928e0_dp & - *t292*t519+0.4206297667e-1_dp*t11*t573*t500-0.4854179269e0_dp & - *t125*t690+0.1588640488e1_dp*t125*t693-0.1906368586e1_dp & - *t125*t696-0.6e1_dp*t27*t526*t528+0.6e1_dp*t302 & - *t531-t130*t549 - t710 = 0.6354561952e0_dp*t306*t309*t10*t127-0.1211413727e1_dp* & - t316*t570+0.1924500894e0_dp*t32*t625*t565*t559+0.3365038132e0_dp & - *t315*t494*t559-0.4490502088e0_dp*t32*t563*t565 & - *t567-0.1588640487e1_dp*t319*t570+0.1682519066e0_dp*t315*t573 & - *t559+0.4854179267e0_dp*t136*t541*t559-0.1682519066e0_dp* & - t324*t573*t567+0.1906368585e1_dp*t137*t583+0.1211413727e1_dp & - *t325*t589-0.3365038132e0_dp*t324*t494*t567+0.2566001193e0_dp & - *t32*t596*t565*t603+t134*t251+0.6354561952e0_dp*t310 & - *t105*t127-0.6354561952e0_dp*t311*t299+0.1514267160e0_dp & - *t132*t665*t10*t241+0.2647734147e0_dp*t311*t296+t705* & - t133*t10+0.2e1_dp*t307*t105 - t719 = 0.1100642416e1_dp*(-0.3365038134e0_dp*t501+0.6057068641e0_dp* & - t505+0.1211413728e1_dp*t510-0.1817120592e1_dp*t88*t235*t513 & - -0.1817120592e1_dp*t225*t516+0.9085602960e0_dp*t225*t519-0.1817120592e1_dp & - *t89*t522-0.5451361779e1_dp*t5*t526*t528+0.5451361779e1_dp & - *t236*t531-0.9085602964e0_dp*t97*t549)*t109* & - t10+0.2201284832e1_dp*t255*t105+0.6730076265e0_dp*t268*t494 & - *t559-0.8981004177e0_dp*bp*t563*t565*t567-0.3177280975e1_dp & - *t273*t570+0.3365038132e0_dp*t268*t573*t559+0.9708358534e0_dp & - *t115*t541*t559-0.3365038132e0_dp*t282*t573*t567+ & - 0.3812737170e1_dp*t116*t583+0.7337616104e0_dp*t254*t258*t261 & - +0.2422827454e1_dp*t283*t589-0.6730076265e0_dp*t282*t494*t567 & - +0.5132002385e0_dp*bp*t596*t565*t603+0.7337616104e0_dp* & - t259*t226+0.1100642416e1_dp*t110*t251-0.7337616104e0_dp*t259 & - *t260*t230+0.4891744068e0_dp*t108*t613*t10*t219*t221 & - -t24*t710*t38-0.2422827454e1_dp*t269*t570+0.3849001789e0_dp & + t705 = 0.8412595335e-1_dp*t501 - 0.1514267160e0_dp*t505 - 0.3028534320e0_dp & + *t510 - 0.1906368585e1_dp*t124*t235*t101*t513 + 0.7943202441e0_dp & + *t291*t245*t504 - 0.1906368585e1_dp*t292*t516 + 0.9531842928e0_dp & + *t292*t519 + 0.4206297667e-1_dp*t11*t573*t500 - 0.4854179269e0_dp & + *t125*t690 + 0.1588640488e1_dp*t125*t693 - 0.1906368586e1_dp & + *t125*t696 - 0.6e1_dp*t27*t526*t528 + 0.6e1_dp*t302 & + *t531 - t130*t549 + t710 = 0.6354561952e0_dp*t306*t309*t10*t127 - 0.1211413727e1_dp* & + t316*t570 + 0.1924500894e0_dp*t32*t625*t565*t559 + 0.3365038132e0_dp & + *t315*t494*t559 - 0.4490502088e0_dp*t32*t563*t565 & + *t567 - 0.1588640487e1_dp*t319*t570 + 0.1682519066e0_dp*t315*t573 & + *t559 + 0.4854179267e0_dp*t136*t541*t559 - 0.1682519066e0_dp* & + t324*t573*t567 + 0.1906368585e1_dp*t137*t583 + 0.1211413727e1_dp & + *t325*t589 - 0.3365038132e0_dp*t324*t494*t567 + 0.2566001193e0_dp & + *t32*t596*t565*t603 + t134*t251 + 0.6354561952e0_dp*t310 & + *t105*t127 - 0.6354561952e0_dp*t311*t299 + 0.1514267160e0_dp & + *t132*t665*t10*t241 + 0.2647734147e0_dp*t311*t296 + t705* & + t133*t10 + 0.2e1_dp*t307*t105 + t719 = 0.1100642416e1_dp*(-0.3365038134e0_dp*t501 + 0.6057068641e0_dp* & + t505 + 0.1211413728e1_dp*t510 - 0.1817120592e1_dp*t88*t235*t513 & + - 0.1817120592e1_dp*t225*t516 + 0.9085602960e0_dp*t225*t519 - 0.1817120592e1_dp & + *t89*t522 - 0.5451361779e1_dp*t5*t526*t528 + 0.5451361779e1_dp & + *t236*t531 - 0.9085602964e0_dp*t97*t549)*t109* & + t10 + 0.2201284832e1_dp*t255*t105 + 0.6730076265e0_dp*t268*t494 & + *t559 - 0.8981004177e0_dp*bp*t563*t565*t567 - 0.3177280975e1_dp & + *t273*t570 + 0.3365038132e0_dp*t268*t573*t559 + 0.9708358534e0_dp & + *t115*t541*t559 - 0.3365038132e0_dp*t282*t573*t567 + & + 0.3812737170e1_dp*t116*t583 + 0.7337616104e0_dp*t254*t258*t261 & + + 0.2422827454e1_dp*t283*t589 - 0.6730076265e0_dp*t282*t494*t567 & + + 0.5132002385e0_dp*bp*t596*t565*t603 + 0.7337616104e0_dp* & + t259*t226 + 0.1100642416e1_dp*t110*t251 - 0.7337616104e0_dp*t259 & + *t260*t230 + 0.4891744068e0_dp*t108*t613*t10*t219*t221 & + - t24*t710*t38 - 0.2422827454e1_dp*t269*t570 + 0.3849001789e0_dp & *bp*t625*t565*t559 t720 = ap*t719 t721 = t45**(-0.1666666667e1_dp) t727 = t43*t221 - t729 = 0.6e1_dp*t230-0.6e1_dp*t727 + t729 = 0.6e1_dp*t230 - 0.6e1_dp*t727 t732 = t48**(-0.1666666667e1_dp) t743 = t349*t202 t745 = t154*t451 @@ -1103,85 +1103,85 @@ SUBROUTINE vwn3_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t836 = 0.1e1_dp/t835 t838 = t365*t165 t841 = t165*t373 - t851 = -t536+t538-t540-0.2427089633e0_dp*bf*t541*t500+0.7943202439e0_dp & - *t368*t509-0.9531842928e0_dp*t162*t522 - t853 = 0.8412595335e-1_dp*t804-0.1514267160e0_dp*t808-0.3028534320e0_dp & - *t810-0.1906368585e1_dp*t183*t363*t101*t814+0.7943202441e0_dp & - *t412*t245*t807-0.1906368585e1_dp*t413*t820+0.9531842928e0_dp & - *t413*t823+0.4206297667e-1_dp*t55*t573*t500-0.4854179269e0_dp & - *t184*t690+0.1588640488e1_dp*t184*t693-0.1906368586e1_dp & - *t184*t696-0.6e1_dp*t69*t836*t838+0.6e1_dp*t420 & - *t841-t187*t851 + t851 = -t536 + t538 - t540 - 0.2427089633e0_dp*bf*t541*t500 + 0.7943202439e0_dp & + *t368*t509 - 0.9531842928e0_dp*t162*t522 + t853 = 0.8412595335e-1_dp*t804 - 0.1514267160e0_dp*t808 - 0.3028534320e0_dp & + *t810 - 0.1906368585e1_dp*t183*t363*t101*t814 + 0.7943202441e0_dp & + *t412*t245*t807 - 0.1906368585e1_dp*t413*t820 + 0.9531842928e0_dp & + *t413*t823 + 0.4206297667e-1_dp*t55*t573*t500 - 0.4854179269e0_dp & + *t184*t690 + 0.1588640488e1_dp*t184*t693 - 0.1906368586e1_dp & + *t184*t696 - 0.6e1_dp*t69*t836*t838 + 0.6e1_dp*t420 & + *t841 - t187*t851 t860 = t509*t179 t863 = 0.1e1_dp/t400 t872 = 0.1e1_dp/t400/t172 - t879 = 0.2e1_dp*t425*t165+t191*t373+0.6354561952e0_dp*t428* & - t165*t127-0.6354561952e0_dp*t429*t299+0.1514267160e0_dp*t189 & - *t769*t54*t241+0.2647734147e0_dp*t429*t296+0.1682519066e0_dp & - *t433*t573*t748+0.4854179267e0_dp*t193*t541*t748-0.1682519066e0_dp & - *t442*t573*t752+0.1906368585e1_dp*t194*t755+ & - 0.1211413727e1_dp*t443*t758-0.3365038132e0_dp*t442*t494*t752 & - +0.2566001193e0_dp*t74*t793*t565*t800+t853*t190*t54 & - +0.6354561952e0_dp*t424*t427*t54*t127-0.1211413727e1_dp*t434 & - *t860+0.1924500894e0_dp*t74*t863*t565*t748+0.3365038132e0_dp & - *t433*t494*t748-0.4490502088e0_dp*t74*t872*t565*t752 & - -0.1588640487e1_dp*t437*t860 - t947 = 0.9708358534e0_dp*t174*t541*t748-0.3365038132e0_dp*t403 & - *t573*t752+0.3812737170e1_dp*t175*t755+0.2422827454e1_dp*t404 & - *t758-t67*t879*t80-0.6730076265e0_dp*t403*t494*t752 & - +0.5132002385e0_dp*bf*t793*t565*t800+0.2201284832e1_dp*t377 & - *t165+0.1100642416e1_dp*(-0.3365038134e0_dp*t804+0.6057068641e0_dp & - *t808+0.1211413728e1_dp*t810-0.1817120592e1_dp*t88*t363* & - t814-0.1817120592e1_dp*t356*t820+0.9085602960e0_dp*t356*t823 & - -0.1817120592e1_dp*t156*t522-0.5451361779e1_dp*t5*t836*t838 & - +0.5451361779e1_dp*t364*t841-0.9085602964e0_dp*t161*t851)* & - t109*t54+0.7337616104e0_dp*t376*t258*t382+0.1100642416e1_dp & - *t169*t373+0.7337616104e0_dp*t380*t357-0.7337616104e0_dp*t380 & - *t381*t230+0.4891744068e0_dp*t168*t613*t54*t219*t221 & - -0.2422827454e1_dp*t390*t860+0.3849001789e0_dp*bf*t863*t565 & - *t748+0.6730076265e0_dp*t389*t494*t748-0.8981004177e0_dp & - *bf*t872*t565*t752-0.3177280975e1_dp*t394*t860+0.3365038132e0_dp & + t879 = 0.2e1_dp*t425*t165 + t191*t373 + 0.6354561952e0_dp*t428* & + t165*t127 - 0.6354561952e0_dp*t429*t299 + 0.1514267160e0_dp*t189 & + *t769*t54*t241 + 0.2647734147e0_dp*t429*t296 + 0.1682519066e0_dp & + *t433*t573*t748 + 0.4854179267e0_dp*t193*t541*t748 - 0.1682519066e0_dp & + *t442*t573*t752 + 0.1906368585e1_dp*t194*t755 + & + 0.1211413727e1_dp*t443*t758 - 0.3365038132e0_dp*t442*t494*t752 & + + 0.2566001193e0_dp*t74*t793*t565*t800 + t853*t190*t54 & + + 0.6354561952e0_dp*t424*t427*t54*t127 - 0.1211413727e1_dp*t434 & + *t860 + 0.1924500894e0_dp*t74*t863*t565*t748 + 0.3365038132e0_dp & + *t433*t494*t748 - 0.4490502088e0_dp*t74*t872*t565*t752 & + - 0.1588640487e1_dp*t437*t860 + t947 = 0.9708358534e0_dp*t174*t541*t748 - 0.3365038132e0_dp*t403 & + *t573*t752 + 0.3812737170e1_dp*t175*t755 + 0.2422827454e1_dp*t404 & + *t758 - t67*t879*t80 - 0.6730076265e0_dp*t403*t494*t752 & + + 0.5132002385e0_dp*bf*t793*t565*t800 + 0.2201284832e1_dp*t377 & + *t165 + 0.1100642416e1_dp*(-0.3365038134e0_dp*t804 + 0.6057068641e0_dp & + *t808 + 0.1211413728e1_dp*t810 - 0.1817120592e1_dp*t88*t363* & + t814 - 0.1817120592e1_dp*t356*t820 + 0.9085602960e0_dp*t356*t823 & + - 0.1817120592e1_dp*t156*t522 - 0.5451361779e1_dp*t5*t836*t838 & + + 0.5451361779e1_dp*t364*t841 - 0.9085602964e0_dp*t161*t851)* & + t109*t54 + 0.7337616104e0_dp*t376*t258*t382 + 0.1100642416e1_dp & + *t169*t373 + 0.7337616104e0_dp*t380*t357 - 0.7337616104e0_dp*t380 & + *t381*t230 + 0.4891744068e0_dp*t168*t613*t54*t219*t221 & + - 0.2422827454e1_dp*t390*t860 + 0.3849001789e0_dp*bf*t863*t565 & + *t748 + 0.6730076265e0_dp*t389*t494*t748 - 0.8981004177e0_dp & + *bf*t872*t565*t752 - 0.3177280975e1_dp*t394*t860 + 0.3365038132e0_dp & *t389*t573*t748 - t950 = t51*(af*t947-t720) + t950 = t51*(af*t947 - t720) t953 = 0.3e1_dp*t332 t956 = 0.3e1_dp*t452 - e_aaa(ip) = e_aaa(ip)+((t720+(-0.5699736440e0_dp*t721*t334*t147+0.2564881396e1_dp & - *t458*t339+0.2564881399e1_dp*t145*t729-0.5699736440e0_dp* & - t732*t343*t151+0.2564881396e1_dp*t464*t346-0.2564881399e1_dp & - *t150*t729)*t85+0.3e1_dp*t743+0.3e1_dp*t745+t950)*t2 & - +t953+0.3e1_dp*t350+0.6e1_dp*t351+t956)*sc + e_aaa(ip) = e_aaa(ip) + ((t720 + (-0.5699736440e0_dp*t721*t334*t147 + 0.2564881396e1_dp & + *t458*t339 + 0.2564881399e1_dp*t145*t729 - 0.5699736440e0_dp* & + t732*t343*t151 + 0.2564881396e1_dp*t464*t346 - 0.2564881399e1_dp & + *t150*t729)*t85 + 0.3e1_dp*t743 + 0.3e1_dp*t745 + t950)*t2 & + + t953 + 0.3e1_dp*t350 + 0.6e1_dp*t351 + t956)*sc - t967 = 0.2e1_dp*t230-0.6e1_dp*t727 + t967 = 0.2e1_dp*t230 - 0.6e1_dp*t727 t984 = 0.2e1_dp*t470*t202 t986 = t212*t451 t990 = 0.2e1_dp*t471 - e_aab(ip) = e_aab(ip)+((t720+(-0.5699736440e0_dp*t721*t334*t206+0.3419841862e1_dp & - *t458*t337+0.8549604655e0_dp*t333*t339*t206+0.2564881399e1_dp & - *t145*t967-0.5699736440e0_dp*t732*t343*t209-0.3419841862e1_dp & - *t464*t337+0.8549604655e0_dp*t342*t346*t209-0.2564881399e1_dp & - *t150*t967)*t85+t743+t984+0.2e1_dp*t745+t986 & - +t950)*t2+t953+t350+0.4e1_dp*t351+t956+t990+t490)*sc + e_aab(ip) = e_aab(ip) + ((t720 + (-0.5699736440e0_dp*t721*t334*t206 + 0.3419841862e1_dp & + *t458*t337 + 0.8549604655e0_dp*t333*t339*t206 + 0.2564881399e1_dp & + *t145*t967 - 0.5699736440e0_dp*t732*t343*t209 - 0.3419841862e1_dp & + *t464*t337 + 0.8549604655e0_dp*t342*t346*t209 - 0.2564881399e1_dp & + *t150*t967)*t85 + t743 + t984 + 0.2e1_dp*t745 + t986 & + + t950)*t2 + t953 + t350 + 0.4e1_dp*t351 + t956 + t990 + t490)*sc t1019 = t488*t202 - e_abb(ip) = e_abb(ip)+((t720+(-0.5699736440e0_dp*t721*t147*t475+0.3419841862e1_dp & - *t333*t43*t230*t206+0.8549604655e0_dp*t458*t479-0.5129762798e1_dp & - *t145*t230-0.1538928839e2_dp*t461*t221-0.5699736440e0_dp & - *t732*t151*t482-0.3419841862e1_dp*t342*t43*t230 & - *t209+0.8549604655e0_dp*t464*t485+0.5129762798e1_dp*t150*t230 & - +0.1538928839e2_dp*t467*t221)*t85+t984+t745+t1019+0.2e1_dp & - *t986+t950)*t2+t953+t990+t352+0.4e1_dp*t472+t956 & - +t489)*sc + e_abb(ip) = e_abb(ip) + ((t720 + (-0.5699736440e0_dp*t721*t147*t475 + 0.3419841862e1_dp & + *t333*t43*t230*t206 + 0.8549604655e0_dp*t458*t479 - 0.5129762798e1_dp & + *t145*t230 - 0.1538928839e2_dp*t461*t221 - 0.5699736440e0_dp & + *t732*t151*t482 - 0.3419841862e1_dp*t342*t43*t230 & + *t209 + 0.8549604655e0_dp*t464*t485 + 0.5129762798e1_dp*t150*t230 & + + 0.1538928839e2_dp*t467*t221)*t85 + t984 + t745 + t1019 + 0.2e1_dp & + *t986 + t950)*t2 + t953 + t990 + t352 + 0.4e1_dp*t472 + t956 & + + t489)*sc - t1031 = -0.6e1_dp*t230-0.6e1_dp*t727 + t1031 = -0.6e1_dp*t230 - 0.6e1_dp*t727 - e_bbb(ip) = e_bbb(ip)+((t720+(-0.5699736440e0_dp*t721*t475*t206+0.2564881396e1_dp & - *t333*t206*t479+0.2564881399e1_dp*t145*t1031-0.5699736440e0_dp & - *t732*t482*t209+0.2564881396e1_dp*t342*t209*t485 & - -0.2564881399e1_dp*t150*t1031)*t85+0.3e1_dp*t1019+0.3e1_dp*t986 & - +t950)*t2+t953+0.3e1_dp*t489+0.6e1_dp*t472+t956)*sc + e_bbb(ip) = e_bbb(ip) + ((t720 + (-0.5699736440e0_dp*t721*t475*t206 + 0.2564881396e1_dp & + *t333*t206*t479 + 0.2564881399e1_dp*t145*t1031 - 0.5699736440e0_dp & + *t732*t482*t209 + 0.2564881396e1_dp*t342*t209*t485 & + - 0.2564881399e1_dp*t150*t1031)*t85 + 0.3e1_dp*t1019 + 0.3e1_dp*t986 & + + t950)*t2 + t953 + 0.3e1_dp*t489 + 0.6e1_dp*t472 + t956)*sc END IF END IF @@ -1275,98 +1275,98 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & ap = a bp = b x0p = x0 - Qp = SQRT(4.0_dp*cp-bp*bp) - Qa = SQRT(4.0_dp*ca-ba*ba) - Qf = SQRT(4.0_dp*cf-bf*bf) - d2f0 = 4.0_dp/(9.0_dp*(2.0_dp**(1.0_dp/3.0_dp)-1.0_dp)) + Qp = SQRT(4.0_dp*cp - bp*bp) + Qa = SQRT(4.0_dp*ca - ba*ba) + Qf = SQRT(4.0_dp*cf - bf*bf) + d2f0 = 4.0_dp/(9.0_dp*(2.0_dp**(1.0_dp/3.0_dp) - 1.0_dp)) !$OMP DO DO ip = 1, npoints myrhoa = MAX(rhoa(ip), 0.0_dp) myrhob = MAX(rhob(ip), 0.0_dp) - myrho = myrhoa+myrhob + myrho = myrhoa + myrhob IF (myrho > eps_rho) THEN myrhoa = MAX(EPSILON(0.0_dp)*1.e4_dp, myrhoa) myrhob = MAX(EPSILON(0.0_dp)*1.e4_dp, myrhob) - myrho = myrhoa+myrhob + myrho = myrhoa + myrhob IF (order >= 0) THEN - t1 = myrhoa-myrhob + t1 = myrhoa - myrhob t2 = myrho t3 = 0.1e1_dp/t2 t4 = t1*t3 - t5 = 0.10e1_dp+t4 + t5 = 0.10e1_dp + t4 t6 = t5**0.1333333333e1_dp - t8 = 0.10e1_dp-t4 + t8 = 0.10e1_dp - t4 t9 = t8**0.1333333333e1_dp - t11 = 0.1923661050e1_dp*t6+0.1923661050e1_dp*t9-0.3847322100e1_dp + t11 = 0.1923661050e1_dp*t6 + 0.1923661050e1_dp*t9 - 0.3847322100e1_dp t12 = t4**0.40e1_dp t13 = t11*t12 - t15 = (0.10e1_dp-t13)*ap + t15 = (0.10e1_dp - t13)*ap t16 = 0.1e1_dp/0.3141592654e1_dp t17 = t16*t3 t18 = t17**0.3333333332e0_dp t19 = 0.9085602964e0_dp*t18 t20 = t17**0.1666666666e0_dp - t23 = t19+0.9531842930e0_dp*bp*t20+cp + t23 = t19 + 0.9531842930e0_dp*bp*t20 + cp t24 = 0.1e1_dp/t23 t27 = LOG(0.9085602964e0_dp*t18*t24) t28 = 0.1906368586e1_dp*t20 - t29 = t28+bp + t29 = t28 + bp t32 = ATAN(Qp/t29) t34 = 0.1e1_dp/Qp t37 = bp*x0p t38 = 0.9531842930e0_dp*t20 - t39 = t38-x0p + t39 = t38 - x0p t40 = t39**0.20e1_dp t42 = LOG(t40*t24) - t45 = 0.20e1_dp*bp+0.40e1_dp*x0p + t45 = 0.20e1_dp*bp + 0.40e1_dp*x0p t49 = x0p**0.20e1_dp - t51 = 0.1e1_dp/(t49+t37+cp) - t54 = t27+0.20e1_dp*bp*t32*t34-t37*(t42+t45*t32*t34) & + t51 = 0.1e1_dp/(t49 + t37 + cp) + t54 = t27 + 0.20e1_dp*bp*t32*t34 - t37*(t42 + t45*t32*t34) & *t51 t55 = t15*t54 - t56 = 0.10e1_dp-t12 + t56 = 0.10e1_dp - t12 t57 = t11*t56 - t60 = t19+0.9531842930e0_dp*ba*t20+ca + t60 = t19 + 0.9531842930e0_dp*ba*t20 + ca t61 = 0.1e1_dp/t60 t64 = LOG(0.9085602964e0_dp*t18*t61) - t65 = t28+ba + t65 = t28 + ba t68 = ATAN(Qa/t65) t70 = 0.1e1_dp/Qa t73 = ba*x0a - t74 = t38-x0a + t74 = t38 - x0a t75 = t74**0.20e1_dp t77 = LOG(t75*t61) - t80 = 0.20e1_dp*ba+0.40e1_dp*x0a + t80 = 0.20e1_dp*ba + 0.40e1_dp*x0a t84 = x0a**0.20e1_dp - t86 = 0.1e1_dp/(t84+t73+ca) - t89 = t64+0.20e1_dp*ba*t68*t70-t73*(t77+t80*t68*t70) & + t86 = 0.1e1_dp/(t84 + t73 + ca) + t89 = t64 + 0.20e1_dp*ba*t68*t70 - t73*(t77 + t80*t68*t70) & *t86 t90 = aa*t89 t91 = 0.1e1_dp/d2f0 t92 = t90*t91 t93 = t57*t92 - t96 = t19+0.9531842930e0_dp*bf*t20+cf + t96 = t19 + 0.9531842930e0_dp*bf*t20 + cf t97 = 0.1e1_dp/t96 t100 = LOG(0.9085602964e0_dp*t18*t97) - t101 = t28+bf + t101 = t28 + bf t104 = ATAN(Qf/t101) t106 = 0.1e1_dp/Qf t109 = bf*x0f - t110 = t38-x0f + t110 = t38 - x0f t111 = t110**0.20e1_dp t113 = LOG(t111*t97) - t116 = 0.20e1_dp*bf+0.40e1_dp*x0f + t116 = 0.20e1_dp*bf + 0.40e1_dp*x0f t120 = x0f**0.20e1_dp - t122 = 0.1e1_dp/(t120+t109+cf) - t125 = t100+0.20e1_dp*bf*t104*t106-t109*(t113+t116*t104 & - *t106)*t122 + t122 = 0.1e1_dp/(t120 + t109 + cf) + t125 = t100 + 0.20e1_dp*bf*t104*t106 - t109*(t113 + t116*t104 & + *t106)*t122 t126 = af*t125 t127 = t13*t126 - e_0(ip) = e_0(ip)+((t55+t93+t127)*t2)*sc + e_0(ip) = e_0(ip) + ((t55 + t93 + t127)*t2)*sc END IF IF (order >= 1 .OR. order == -1) THEN @@ -1374,15 +1374,15 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t130 = t2**2 t131 = 0.1e1_dp/t130 t132 = t1*t131 - t133 = t3-t132 + t133 = t3 - t132 t136 = t8**0.333333333e0_dp t137 = -t133 - t140 = 0.2564881399e1_dp*t129*t133+0.2564881399e1_dp*t136*t137 + t140 = 0.2564881399e1_dp*t129*t133 + 0.2564881399e1_dp*t136*t137 t141 = t140*t12 t142 = t4**0.30e1_dp t143 = t11*t142 t144 = t143*t133 - t147 = (-t141-0.40e1_dp*t144)*ap + t147 = (-t141 - 0.40e1_dp*t144)*ap t148 = t147*t54 t149 = t17**(-0.6666666668e0_dp) t150 = t149*t24 @@ -1394,8 +1394,8 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t159 = 0.3028534320e0_dp*t157*t131 t160 = t17**(-0.8333333334e0_dp) t161 = bp*t160 - t164 = -t159-0.1588640488e0_dp*t161*t151 - t167 = -0.3028534320e0_dp*t150*t151-0.9085602964e0_dp*t156*t164 + t164 = -t159 - 0.1588640488e0_dp*t161*t151 + t167 = -0.3028534320e0_dp*t150*t151 - 0.9085602964e0_dp*t156*t164 t168 = t17**(-0.3333333332e0_dp) t169 = t167*t168 t172 = t29**2 @@ -1403,7 +1403,7 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t174 = bp*t173 t175 = t174*t160 t176 = Qp**2 - t178 = 0.1e1_dp+t176*t173 + t178 = 0.1e1_dp + t176*t173 t179 = 0.1e1_dp/t178 t180 = t151*t179 t183 = t39**0.10e1_dp @@ -1411,13 +1411,13 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t185 = t160*t16 t186 = t185*t131 t189 = t40*t155 - t191 = -0.3177280976e0_dp*t184*t186-t189*t164 + t191 = -0.3177280976e0_dp*t184*t186 - t189*t164 t192 = t39**(-0.20e1_dp) t193 = t191*t192 t195 = t45*t173 t196 = t195*t160 - t202 = 0.1100642416e1_dp*t169*t23+0.6354561950e0_dp*t175*t180- & - t37*(t193*t23+0.3177280975e0_dp*t196*t180)*t51 + t202 = 0.1100642416e1_dp*t169*t23 + 0.6354561950e0_dp*t175*t180 - & + t37*(t193*t23 + 0.3177280975e0_dp*t196*t180)*t51 t203 = t15*t202 t204 = t140*t56 t205 = t204*t92 @@ -1428,27 +1428,27 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t212 = 0.1e1_dp/t211 t213 = t18*t212 t214 = ba*t160 - t217 = -t159-0.1588640488e0_dp*t214*t151 - t220 = -0.3028534320e0_dp*t208*t151-0.9085602964e0_dp*t213*t217 + t217 = -t159 - 0.1588640488e0_dp*t214*t151 + t220 = -0.3028534320e0_dp*t208*t151 - 0.9085602964e0_dp*t213*t217 t221 = t220*t168 t224 = t65**2 t225 = 0.1e1_dp/t224 t226 = ba*t225 t227 = t226*t160 t228 = Qa**2 - t230 = 0.1e1_dp+t228*t225 + t230 = 0.1e1_dp + t228*t225 t231 = 0.1e1_dp/t230 t232 = t151*t231 t235 = t74**0.10e1_dp t236 = t235*t61 t239 = t75*t212 - t241 = -0.3177280976e0_dp*t236*t186-t239*t217 + t241 = -0.3177280976e0_dp*t236*t186 - t239*t217 t242 = t74**(-0.20e1_dp) t243 = t241*t242 t245 = t80*t225 t246 = t245*t160 - t252 = 0.1100642416e1_dp*t221*t60+0.6354561950e0_dp*t227*t232- & - t73*(t243*t60+0.3177280975e0_dp*t246*t232)*t86 + t252 = 0.1100642416e1_dp*t221*t60 + 0.6354561950e0_dp*t227*t232 - & + t73*(t243*t60 + 0.3177280975e0_dp*t246*t232)*t86 t253 = aa*t252 t254 = t253*t91 t255 = t57*t254 @@ -1461,39 +1461,39 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t264 = 0.1e1_dp/t263 t265 = t18*t264 t266 = bf*t160 - t269 = -t159-0.1588640488e0_dp*t266*t151 - t272 = -0.3028534320e0_dp*t260*t151-0.9085602964e0_dp*t265*t269 + t269 = -t159 - 0.1588640488e0_dp*t266*t151 + t272 = -0.3028534320e0_dp*t260*t151 - 0.9085602964e0_dp*t265*t269 t273 = t272*t168 t276 = t101**2 t277 = 0.1e1_dp/t276 t278 = bf*t277 t279 = t278*t160 t280 = Qf**2 - t282 = 0.1e1_dp+t280*t277 + t282 = 0.1e1_dp + t280*t277 t283 = 0.1e1_dp/t282 t284 = t151*t283 t287 = t110**0.10e1_dp t288 = t287*t97 t291 = t111*t264 - t293 = -0.3177280976e0_dp*t288*t186-t291*t269 + t293 = -0.3177280976e0_dp*t288*t186 - t291*t269 t294 = t110**(-0.20e1_dp) t295 = t293*t294 t297 = t116*t277 t298 = t297*t160 - t304 = 0.1100642416e1_dp*t273*t96+0.6354561950e0_dp*t279*t284- & - t109*(t295*t96+0.3177280975e0_dp*t298*t284)*t122 + t304 = 0.1100642416e1_dp*t273*t96 + 0.6354561950e0_dp*t279*t284 - & + t109*(t295*t96 + 0.3177280975e0_dp*t298*t284)*t122 t305 = af*t304 t306 = t13*t305 - e_a(ip) = e_a(ip)+((t148+t203+t205-t207+t255+t256+t259+t306)*t2+ & - t55+t93+t127)*sc + e_a(ip) = e_a(ip) + ((t148 + t203 + t205 - t207 + t255 + t256 + t259 + t306)*t2 + & + t55 + t93 + t127)*sc - t309 = -t3-t132 + t309 = -t3 - t132 t312 = -t309 - t315 = 0.2564881399e1_dp*t129*t309+0.2564881399e1_dp*t136*t312 + t315 = 0.2564881399e1_dp*t129*t309 + 0.2564881399e1_dp*t136*t312 t316 = t315*t12 t317 = t143*t309 - t320 = (-t316-0.40e1_dp*t317)*ap + t320 = (-t316 - 0.40e1_dp*t317)*ap t321 = t320*t54 t322 = t315*t56 t323 = t322*t92 @@ -1504,8 +1504,8 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t328 = t143*t327 t329 = 0.40e1_dp*t328 - e_b(ip) = e_b(ip)+((t321+t203+t323-t325+t255+t326+t329+t306)*t2+ & - t55+t93+t127)*sc + e_b(ip) = e_b(ip) + ((t321 + t203 + t323 - t325 + t255 + t326 + t329 + t306)*t2 + & + t55 + t93 + t127)*sc END IF IF (order >= 2 .OR. order == -2) THEN @@ -1513,12 +1513,12 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t333 = t133**2 t337 = 0.1e1_dp/t130/t2 t338 = t1*t337 - t340 = -0.2e1_dp*t131+0.2e1_dp*t338 + t340 = -0.2e1_dp*t131 + 0.2e1_dp*t338 t343 = t8**(-0.666666667e0_dp) t344 = t137**2 t347 = -t340 - t350 = 0.8549604655e0_dp*t332*t333+0.2564881399e1_dp*t129*t340 & - +0.8549604655e0_dp*t343*t344+0.2564881399e1_dp*t136*t347 + t350 = 0.8549604655e0_dp*t332*t333 + 0.2564881399e1_dp*t129*t340 & + + 0.8549604655e0_dp*t343*t344 + 0.2564881399e1_dp*t136*t347 t351 = t350*t12 t352 = t140*t142 t353 = t352*t133 @@ -1526,7 +1526,7 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t356 = t11*t355 t357 = t356*t333 t359 = t143*t340 - t362 = (-t351-0.80e1_dp*t353-0.1200e2_dp*t357-0.40e1_dp*t359)* & + t362 = (-t351 - 0.80e1_dp*t353 - 0.1200e2_dp*t357 - 0.40e1_dp*t359)* & ap t363 = t362*t54 t364 = t147*t202 @@ -1551,10 +1551,10 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t392 = 0.6057068640e0_dp*t157*t337 t393 = t17**(-0.1833333333e1_dp) t394 = bp*t393 - t399 = -t390+t392-0.1323867073e0_dp*t394*t372+0.3177280976e0_dp & + t399 = -t390 + t392 - 0.1323867073e0_dp*t394*t372 + 0.3177280976e0_dp & *t161*t379 - t402 = -0.2019022880e0_dp*t373+0.6057068640e0_dp*t375*t376+0.6057068640e0_dp & - *t150*t379+0.1817120593e1_dp*t384*t385-0.9085602964e0_dp & + t402 = -0.2019022880e0_dp*t373 + 0.6057068640e0_dp*t375*t376 + 0.6057068640e0_dp & + *t150*t379 + 0.1817120593e1_dp*t384*t385 - 0.9085602964e0_dp & *t156*t399 t403 = t402*t168 t406 = t17**(-0.1333333333e1_dp) @@ -1580,9 +1580,9 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t444 = t443*t371 t447 = t185*t337 t450 = t40*t383 - t454 = 0.5047557200e-1_dp*t373+0.6354561952e0_dp*t440*t376-0.2647734147e0_dp & - *t184*t444+0.6354561952e0_dp*t184*t447+0.2e1_dp* & - t450*t385-t189*t399 + t454 = 0.5047557200e-1_dp*t373 + 0.6354561952e0_dp*t440*t376 - 0.2647734147e0_dp & + *t184*t444 + 0.6354561952e0_dp*t184*t447 + 0.2e1_dp* & + t450*t385 - t189*t399 t455 = t454*t192 t457 = t39**(-0.30e1_dp) t458 = t191*t457 @@ -1592,13 +1592,13 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t467 = t195*t393 t472 = t45*t429 t473 = t472*t366 - t479 = 0.1100642416e1_dp*t403*t23+0.3668808052e0_dp*t407*t409+ & - 0.1100642416e1_dp*t169*t164+0.4038045758e0_dp*t417*t418+0.5295468292e0_dp & - *t421*t418-0.1270912390e1_dp*t175*t424-0.4038045758e0_dp & - *t431*t435-t37*(t455*t23+0.3177280976e0_dp*t459 & - *t186+t193*t164+0.2019022879e0_dp*t464*t418+0.2647734146e0_dp & - *t467*t418-0.6354561950e0_dp*t196*t424-0.2019022879e0_dp* & - t473*t435)*t51 + t479 = 0.1100642416e1_dp*t403*t23 + 0.3668808052e0_dp*t407*t409 + & + 0.1100642416e1_dp*t169*t164 + 0.4038045758e0_dp*t417*t418 + 0.5295468292e0_dp & + *t421*t418 - 0.1270912390e1_dp*t175*t424 - 0.4038045758e0_dp & + *t431*t435 - t37*(t455*t23 + 0.3177280976e0_dp*t459 & + *t186 + t193*t164 + 0.2019022879e0_dp*t464*t418 + 0.2647734146e0_dp & + *t467*t418 - 0.6354561950e0_dp*t196*t424 - 0.2019022879e0_dp* & + t473*t435)*t51 t480 = t15*t479 t481 = t350*t56 t482 = t481*t92 @@ -1620,10 +1620,10 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t504 = t18*t503 t505 = t217**2 t508 = ba*t393 - t513 = -t390+t392-0.1323867073e0_dp*t508*t372+0.3177280976e0_dp & + t513 = -t390 + t392 - 0.1323867073e0_dp*t508*t372 + 0.3177280976e0_dp & *t214*t379 - t516 = -0.2019022880e0_dp*t494+0.6057068640e0_dp*t496*t497+0.6057068640e0_dp & - *t208*t379+0.1817120593e1_dp*t504*t505-0.9085602964e0_dp & + t516 = -0.2019022880e0_dp*t494 + 0.6057068640e0_dp*t496*t497 + 0.6057068640e0_dp & + *t208*t379 + 0.1817120593e1_dp*t504*t505 - 0.9085602964e0_dp & *t213*t513 t517 = t516*t168 t520 = t220*t406 @@ -1645,9 +1645,9 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t552 = t235*t212 t553 = t552*t160 t560 = t75*t503 - t564 = 0.5047557200e-1_dp*t494+0.6354561952e0_dp*t553*t497-0.2647734147e0_dp & - *t236*t444+0.6354561952e0_dp*t236*t447+0.2e1_dp* & - t560*t505-t239*t513 + t564 = 0.5047557200e-1_dp*t494 + 0.6354561952e0_dp*t553*t497 - 0.2647734147e0_dp & + *t236*t444 + 0.6354561952e0_dp*t236*t447 + 0.2e1_dp* & + t560*t505 - t239*t513 t565 = t564*t242 t567 = t74**(-0.30e1_dp) t568 = t241*t567 @@ -1657,13 +1657,13 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t577 = t245*t393 t582 = t80*t542 t583 = t582*t366 - t591 = aa*(0.1100642416e1_dp*t517*t60+0.3668808052e0_dp*t520* & - t522+0.1100642416e1_dp*t221*t217+0.4038045758e0_dp*t530*t531 & - +0.5295468292e0_dp*t534*t531-0.1270912390e1_dp*t227*t537-0.4038045758e0_dp & - *t544*t548-t73*(t565*t60+0.3177280976e0_dp* & - t569*t186+t243*t217+0.2019022879e0_dp*t574*t531+0.2647734146e0_dp & - *t577*t531-0.6354561950e0_dp*t246*t537-0.2019022879e0_dp & - *t583*t548)*t86)*t91 + t591 = aa*(0.1100642416e1_dp*t517*t60 + 0.3668808052e0_dp*t520* & + t522 + 0.1100642416e1_dp*t221*t217 + 0.4038045758e0_dp*t530*t531 & + + 0.5295468292e0_dp*t534*t531 - 0.1270912390e1_dp*t227*t537 - 0.4038045758e0_dp & + *t544*t548 - t73*(t565*t60 + 0.3177280976e0_dp* & + t569*t186 + t243*t217 + 0.2019022879e0_dp*t574*t531 + 0.2647734146e0_dp & + *t577*t531 - 0.6354561950e0_dp*t246*t537 - 0.2019022879e0_dp & + *t583*t548)*t86)*t91 t592 = t57*t591 t593 = t351*t126 t594 = t352*t257 @@ -1687,10 +1687,10 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t618 = t18*t617 t619 = t269**2 t622 = bf*t393 - t627 = -t390+t392-0.1323867073e0_dp*t622*t372+0.3177280976e0_dp & + t627 = -t390 + t392 - 0.1323867073e0_dp*t622*t372 + 0.3177280976e0_dp & *t266*t379 - t630 = -0.2019022880e0_dp*t608+0.6057068640e0_dp*t610*t611+0.6057068640e0_dp & - *t260*t379+0.1817120593e1_dp*t618*t619-0.9085602964e0_dp & + t630 = -0.2019022880e0_dp*t608 + 0.6057068640e0_dp*t610*t611 + 0.6057068640e0_dp & + *t260*t379 + 0.1817120593e1_dp*t618*t619 - 0.9085602964e0_dp & *t265*t627 t631 = t630*t168 t634 = t272*t406 @@ -1712,9 +1712,9 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t666 = t287*t264 t667 = t666*t160 t674 = t111*t617 - t678 = 0.5047557200e-1_dp*t608+0.6354561952e0_dp*t667*t611-0.2647734147e0_dp & - *t288*t444+0.6354561952e0_dp*t288*t447+0.2e1_dp* & - t674*t619-t291*t627 + t678 = 0.5047557200e-1_dp*t608 + 0.6354561952e0_dp*t667*t611 - 0.2647734147e0_dp & + *t288*t444 + 0.6354561952e0_dp*t288*t447 + 0.2e1_dp* & + t674*t619 - t291*t627 t679 = t678*t294 t681 = t110**(-0.30e1_dp) t682 = t293*t681 @@ -1724,36 +1724,36 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t691 = t297*t393 t696 = t116*t656 t697 = t696*t366 - t704 = af*(0.1100642416e1_dp*t631*t96+0.3668808052e0_dp*t634* & - t636+0.1100642416e1_dp*t273*t269+0.4038045758e0_dp*t644*t645 & - +0.5295468292e0_dp*t648*t645-0.1270912390e1_dp*t279*t651-0.4038045758e0_dp & - *t658*t662-t109*(t679*t96+0.3177280976e0_dp & - *t683*t186+t295*t269+0.2019022879e0_dp*t688*t645+0.2647734146e0_dp & - *t691*t645-0.6354561950e0_dp*t298*t651-0.2019022879e0_dp & - *t697*t662)*t122) + t704 = af*(0.1100642416e1_dp*t631*t96 + 0.3668808052e0_dp*t634* & + t636 + 0.1100642416e1_dp*t273*t269 + 0.4038045758e0_dp*t644*t645 & + + 0.5295468292e0_dp*t648*t645 - 0.1270912390e1_dp*t279*t651 - 0.4038045758e0_dp & + *t658*t662 - t109*(t679*t96 + 0.3177280976e0_dp & + *t683*t186 + t295*t269 + 0.2019022879e0_dp*t688*t645 + 0.2647734146e0_dp & + *t691*t645 - 0.6354561950e0_dp*t298*t651 - 0.2019022879e0_dp & + *t697*t662)*t122) t705 = t13*t704 - t706 = t363+t365+t480+t482-t484+t486-t488-t490-t492 & - +t592+t593+t595+t597+t600+t603+t606+t705 + t706 = t363 + t365 + t480 + t482 - t484 + t486 - t488 - t490 - t492 & + + t592 + t593 + t595 + t597 + t600 + t603 + t606 + t705 t709 = 0.2e1_dp*t203 t712 = 0.2e1_dp*t255 t715 = 0.2e1_dp*t306 - e_aa(ip) = e_aa(ip)+(t706*t2+0.2e1_dp*t148+t709+0.2e1_dp*t205-0.80e1_dp*t206 & - +t712+0.2e1_dp*t256+0.80e1_dp*t258+t715)*sc + e_aa(ip) = e_aa(ip) + (t706*t2 + 0.2e1_dp*t148 + t709 + 0.2e1_dp*t205 - 0.80e1_dp*t206 & + + t712 + 0.2e1_dp*t256 + 0.80e1_dp*t258 + t715)*sc t716 = t332*t133 t719 = t129*t1 t722 = t343*t137 t725 = t136*t1 - t728 = 0.8549604655e0_dp*t716*t309+0.5129762798e1_dp*t719*t337 & - +0.8549604655e0_dp*t722*t312-0.5129762798e1_dp*t725*t337 + t728 = 0.8549604655e0_dp*t716*t309 + 0.5129762798e1_dp*t719*t337 & + + 0.8549604655e0_dp*t722*t312 - 0.5129762798e1_dp*t725*t337 t729 = t728*t12 t730 = t352*t309 t732 = t315*t142 t733 = t732*t133 t735 = t133*t309 - t741 = (-t729-0.40e1_dp*t730-0.40e1_dp*t733-0.1200e2_dp*t356*t735 & - -0.80e1_dp*t143*t338)*ap + t741 = (-t729 - 0.40e1_dp*t730 - 0.40e1_dp*t733 - 0.1200e2_dp*t356*t735 & + - 0.80e1_dp*t143*t338)*ap t742 = t741*t54 t743 = t320*t202 t744 = t728*t56 @@ -1770,8 +1770,8 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t758 = t756*t757 t759 = t755*t758 t762 = t322*t254 - t763 = t742+t364+t743+t480+t745-0.40e1_dp*t746+t485-0.40e1_dp & - *t748-0.1200e2_dp*t753-0.80e1_dp*t759-0.40e1_dp*t491+t762 + t763 = t742 + t364 + t743 + t480 + t745 - 0.40e1_dp*t746 + t485 - 0.40e1_dp & + *t748 - 0.1200e2_dp*t753 - 0.80e1_dp*t759 - 0.40e1_dp*t491 + t762 t764 = t317*t254 t766 = t729*t126 t767 = t352*t327 @@ -1787,23 +1787,23 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t782 = t316*t305 t783 = t305*t309 t784 = t143*t783 - t786 = -0.40e1_dp*t764+t592+t766+0.40e1_dp*t767+t596+0.40e1_dp & - *t769+0.1200e2_dp*t774+0.40e1_dp*t602+0.80e1_dp*t780+t782+ & - 0.40e1_dp*t784+t705 + t786 = -0.40e1_dp*t764 + t592 + t766 + 0.40e1_dp*t767 + t596 + 0.40e1_dp & + *t769 + 0.1200e2_dp*t774 + 0.40e1_dp*t602 + 0.80e1_dp*t780 + t782 + & + 0.40e1_dp*t784 + t705 - e_ab(ip) = e_ab(ip)+((t763+t786)*t2+t148+t709+t205-t207+t712+t256 & - +t259+t715+t321+t323-t325+t326+t329)*sc + e_ab(ip) = e_ab(ip) + ((t763 + t786)*t2 + t148 + t709 + t205 - t207 + t712 + t256 & + + t259 + t715 + t321 + t323 - t325 + t326 + t329)*sc t789 = t309**2 - t793 = 0.2e1_dp*t131+0.2e1_dp*t338 + t793 = 0.2e1_dp*t131 + 0.2e1_dp*t338 t796 = t312**2 t799 = -t793 - t802 = 0.8549604655e0_dp*t332*t789+0.2564881399e1_dp*t129*t793 & - +0.8549604655e0_dp*t343*t796+0.2564881399e1_dp*t136*t799 + t802 = 0.8549604655e0_dp*t332*t789 + 0.2564881399e1_dp*t129*t793 & + + 0.8549604655e0_dp*t343*t796 + 0.2564881399e1_dp*t136*t799 t803 = t802*t12 t804 = t732*t309 t806 = t356*t789 t808 = t143*t793 - t811 = (-t803-0.80e1_dp*t804-0.1200e2_dp*t806-0.40e1_dp*t808)* & + t811 = (-t803 - 0.80e1_dp*t804 - 0.1200e2_dp*t806 - 0.40e1_dp*t808)* & ap t812 = t811*t54 t813 = 0.2e1_dp*t743 @@ -1828,11 +1828,11 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t832 = t126*t793 t833 = t143*t832 t834 = 0.40e1_dp*t833 - t835 = t812+t813+t480+t815-t817+t818-t820-t822-t823 & - +t592+t824+t826+t827+t830+t831+t834+t705 + t835 = t812 + t813 + t480 + t815 - t817 + t818 - t820 - t822 - t823 & + + t592 + t824 + t826 + t827 + t830 + t831 + t834 + t705 - e_bb(ip) = e_bb(ip)+(t835*t2+0.2e1_dp*t321+t709+0.2e1_dp*t323-0.80e1_dp*t324 & - +t712+0.2e1_dp*t326+0.80e1_dp*t328+t715)*sc + e_bb(ip) = e_bb(ip) + (t835*t2 + 0.2e1_dp*t321 + t709 + 0.2e1_dp*t323 - 0.80e1_dp*t324 & + + t712 + 0.2e1_dp*t326 + 0.80e1_dp*t328 + t715)*sc END IF IF (order >= 3 .OR. order == -3) THEN @@ -1861,19 +1861,19 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t903 = 0.1211413728e1_dp*t388*t873 t905 = 0.1817120592e1_dp*t157*t371 t906 = t17**(-0.2833333333e1_dp) - t914 = -t901+t903-t905-0.2427089633e0_dp*bp*t906*t865+0.7943202439e0_dp & - *t394*t874-0.9531842928e0_dp*t161*t887 + t914 = -t901 + t903 - t905 - 0.2427089633e0_dp*bp*t906*t865 + 0.7943202439e0_dp & + *t394*t874 - 0.9531842928e0_dp*t161*t887 t937 = t17**(-0.2666666666e1_dp) t942 = t906*t862*t864 t945 = t443*t873 t948 = t185*t371 - t957 = 0.8412595335e-1_dp*t866-0.1514267160e0_dp*t870-0.3028534320e0_dp & - *t875-0.1906368585e1_dp*t183*t383*t160*t878+0.7943202441e0_dp & - *t439*t393*t869-0.1906368585e1_dp*t440*t881+0.9531842928e0_dp & - *t440*t884+0.4206297667e-1_dp*t24*t937*t865-0.4854179269e0_dp & - *t184*t942+0.1588640488e1_dp*t184*t945-0.1906368586e1_dp & - *t184*t948-0.6e1_dp*t40*t891*t893+0.6e1_dp*t450 & - *t896-t189*t914 + t957 = 0.8412595335e-1_dp*t866 - 0.1514267160e0_dp*t870 - 0.3028534320e0_dp & + *t875 - 0.1906368585e1_dp*t183*t383*t160*t878 + 0.7943202441e0_dp & + *t439*t393*t869 - 0.1906368585e1_dp*t440*t881 + 0.9531842928e0_dp & + *t440*t884 + 0.4206297667e-1_dp*t24*t937*t865 - 0.4854179269e0_dp & + *t184*t942 + 0.1588640488e1_dp*t184*t945 - 0.1906368586e1_dp & + *t184*t948 - 0.6e1_dp*t40*t891*t893 + 0.6e1_dp*t450 & + *t896 - t189*t914 t972 = t39**(-0.40e1_dp) t979 = t874*t179 t982 = 0.1e1_dp/t427 @@ -1887,44 +1887,44 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t1020 = 0.1e1_dp/t1019 t1025 = t176**2 t1027 = t865/t432/t178*t1025 - t1030 = t957*t192*t23+0.2e1_dp*t455*t164+0.6354561952e0_dp* & - t454*t457*t23*t186+t193*t399+0.6354561952e0_dp*t458*t164 & - *t186-0.6354561952e0_dp*t459*t447+0.1514267160e0_dp*t191 & - *t972*t23*t389+0.2647734147e0_dp*t459*t444-0.1211413727e1_dp & - *t464*t979+0.1924500894e0_dp*t45*t982*t984*t986+0.3365038132e0_dp & - *t463*t859*t986-0.4490502088e0_dp*t45*t993*t984 & - *t996-0.1588640487e1_dp*t467*t979+0.1682519066e0_dp*t463* & - t937*t986+0.4854179267e0_dp*t195*t906*t986-0.1682519066e0_dp & - *t472*t937*t996+0.1906368585e1_dp*t196*t1010+0.1211413727e1_dp & - *t473*t1013-0.3365038132e0_dp*t472*t859*t996+0.2566001193e0_dp & + t1030 = t957*t192*t23 + 0.2e1_dp*t455*t164 + 0.6354561952e0_dp* & + t454*t457*t23*t186 + t193*t399 + 0.6354561952e0_dp*t458*t164 & + *t186 - 0.6354561952e0_dp*t459*t447 + 0.1514267160e0_dp*t191 & + *t972*t23*t389 + 0.2647734147e0_dp*t459*t444 - 0.1211413727e1_dp & + *t464*t979 + 0.1924500894e0_dp*t45*t982*t984*t986 + 0.3365038132e0_dp & + *t463*t859*t986 - 0.4490502088e0_dp*t45*t993*t984 & + *t996 - 0.1588640487e1_dp*t467*t979 + 0.1682519066e0_dp*t463* & + t937*t986 + 0.4854179267e0_dp*t195*t906*t986 - 0.1682519066e0_dp & + *t472*t937*t996 + 0.1906368585e1_dp*t196*t1010 + 0.1211413727e1_dp & + *t473*t1013 - 0.3365038132e0_dp*t472*t859*t996 + 0.2566001193e0_dp & *t45*t1020*t984*t1027 t1043 = t17**(-0.2333333333e1_dp) - t1084 = 0.1100642416e1_dp*(-0.3365038134e0_dp*t866+0.6057068641e0_dp* & - t870+0.1211413728e1_dp*t875-0.1817120592e1_dp*t149*t383*t878 & - -0.1817120592e1_dp*t375*t881+0.9085602960e0_dp*t375*t884- & - 0.1817120592e1_dp*t150*t887-0.5451361779e1_dp*t18*t891*t893 & - +0.5451361779e1_dp*t384*t896-0.9085602964e0_dp*t156*t914)*t168 & - *t23+0.2201284832e1_dp*t403*t164-t37*t1030*t51+0.7337616104e0_dp & - *t402*t406*t409+0.1100642416e1_dp*t169*t399+ & - 0.7337616104e0_dp*t407*t376-0.7337616104e0_dp*t407*t408*t337 & - +0.4891744068e0_dp*t167*t1043*t23*t369*t371-0.2422827454e1_dp & - *t417*t979+0.3849001789e0_dp*bp*t982*t984*t986+0.6730076265e0_dp & - *t416*t859*t986-0.8981004177e0_dp*bp*t993*t984 & - *t996-0.3177280975e1_dp*t421*t979+0.3365038132e0_dp*t416* & - t937*t986+0.9708358534e0_dp*t174*t906*t986-0.3365038132e0_dp & - *t430*t937*t996+0.3812737170e1_dp*t175*t1010+0.2422827454e1_dp & - *t431*t1013-0.6730076265e0_dp*t430*t859*t996+0.5132002385e0_dp & + t1084 = 0.1100642416e1_dp*(-0.3365038134e0_dp*t866 + 0.6057068641e0_dp* & + t870 + 0.1211413728e1_dp*t875 - 0.1817120592e1_dp*t149*t383*t878 & + - 0.1817120592e1_dp*t375*t881 + 0.9085602960e0_dp*t375*t884 - & + 0.1817120592e1_dp*t150*t887 - 0.5451361779e1_dp*t18*t891*t893 & + + 0.5451361779e1_dp*t384*t896 - 0.9085602964e0_dp*t156*t914)*t168 & + *t23 + 0.2201284832e1_dp*t403*t164 - t37*t1030*t51 + 0.7337616104e0_dp & + *t402*t406*t409 + 0.1100642416e1_dp*t169*t399 + & + 0.7337616104e0_dp*t407*t376 - 0.7337616104e0_dp*t407*t408*t337 & + + 0.4891744068e0_dp*t167*t1043*t23*t369*t371 - 0.2422827454e1_dp & + *t417*t979 + 0.3849001789e0_dp*bp*t982*t984*t986 + 0.6730076265e0_dp & + *t416*t859*t986 - 0.8981004177e0_dp*bp*t993*t984 & + *t996 - 0.3177280975e1_dp*t421*t979 + 0.3365038132e0_dp*t416* & + t937*t986 + 0.9708358534e0_dp*t174*t906*t986 - 0.3365038132e0_dp & + *t430*t937*t996 + 0.3812737170e1_dp*t175*t1010 + 0.2422827454e1_dp & + *t431*t1013 - 0.6730076265e0_dp*t430*t859*t996 + 0.5132002385e0_dp & *bp*t1020*t984*t1027 t1085 = t15*t1084 t1086 = t147*t479 t1088 = t5**(-0.1666666667e1_dp) t1089 = t333*t133 t1094 = t1*t371 - t1096 = 0.6e1_dp*t337-0.6e1_dp*t1094 + t1096 = 0.6e1_dp*t337 - 0.6e1_dp*t1094 t1099 = t8**(-0.1666666667e1_dp) - t1108 = -0.5699736440e0_dp*t1088*t1089+0.2564881396e1_dp*t716*t340 & - +0.2564881399e1_dp*t129*t1096-0.5699736440e0_dp*t1099*t344 & - *t137+0.2564881396e1_dp*t722*t347-0.2564881399e1_dp*t136* & + t1108 = -0.5699736440e0_dp*t1088*t1089 + 0.2564881396e1_dp*t716*t340 & + + 0.2564881399e1_dp*t129*t1096 - 0.5699736440e0_dp*t1099*t344 & + *t137 + 0.2564881396e1_dp*t722*t347 - 0.2564881399e1_dp*t136* & t1096 t1109 = t1108*t12 t1110 = t350*t142 @@ -1949,8 +1949,8 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t1166 = 0.1e1_dp/t1165 t1168 = t619*t269 t1171 = t269*t627 - t1181 = -t901+t903-t905-0.2427089633e0_dp*bf*t906*t865+0.7943202439e0_dp & - *t622*t874-0.9531842928e0_dp*t266*t887 + t1181 = -t901 + t903 - t905 - 0.2427089633e0_dp*bf*t906*t865 + 0.7943202439e0_dp & + *t622*t874 - 0.9531842928e0_dp*t266*t887 t1205 = t874*t283 t1208 = 0.1e1_dp/t654 t1211 = t865*t283 @@ -1962,50 +1962,50 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t1245 = 0.1e1_dp/t1244 t1250 = t280**2 t1252 = t865/t659/t282*t1250 - t1284 = 0.8412595335e-1_dp*t1145-0.1514267160e0_dp*t1149-0.3028534320e0_dp & - *t1151-0.1906368585e1_dp*t287*t617*t160*t1154+0.7943202441e0_dp & - *t666*t393*t1148-0.1906368585e1_dp*t667*t1157 & - +0.9531842928e0_dp*t667*t1160+0.4206297667e-1_dp*t97*t937*t865 & - -0.4854179269e0_dp*t288*t942+0.1588640488e1_dp*t288*t945 & - -0.1906368586e1_dp*t288*t948-0.6e1_dp*t111*t1166*t1168+0.6e1_dp & - *t674*t1171-t291*t1181 + t1284 = 0.8412595335e-1_dp*t1145 - 0.1514267160e0_dp*t1149 - 0.3028534320e0_dp & + *t1151 - 0.1906368585e1_dp*t287*t617*t160*t1154 + 0.7943202441e0_dp & + *t666*t393*t1148 - 0.1906368585e1_dp*t667*t1157 & + + 0.9531842928e0_dp*t667*t1160 + 0.4206297667e-1_dp*t97*t937*t865 & + - 0.4854179269e0_dp*t288*t942 + 0.1588640488e1_dp*t288*t945 & + - 0.1906368586e1_dp*t288*t948 - 0.6e1_dp*t111*t1166*t1168 + 0.6e1_dp & + *t674*t1171 - t291*t1181 t1299 = t110**(-0.40e1_dp) - t1341 = t1284*t294*t96+0.2e1_dp*t679*t269+0.6354561952e0_dp* & - t678*t681*t96*t186+t295*t627+0.6354561952e0_dp*t682* & - t269*t186-0.6354561952e0_dp*t683*t447+0.1514267160e0_dp*t293 & - *t1299*t96*t389+0.2647734147e0_dp*t683*t444-0.1211413727e1_dp & - *t688*t1205+0.1924500894e0_dp*t116*t1208*t984*t1211 & - +0.3365038132e0_dp*t687*t859*t1211-0.4490502088e0_dp*t116*t1218 & - *t984*t1221-0.1588640487e1_dp*t691*t1205+0.1682519066e0_dp & - *t687*t937*t1211+0.4854179267e0_dp*t297*t906*t1211- & - 0.1682519066e0_dp*t696*t937*t1221+0.1906368585e1_dp*t298*t1235 & - +0.1211413727e1_dp*t697*t1238-0.3365038132e0_dp*t696*t859 & - *t1221+0.2566001193e0_dp*t116*t1245*t984*t1252 - t1344 = 0.1100642416e1_dp*(-0.3365038134e0_dp*t1145+0.6057068641e0_dp & - *t1149+0.1211413728e1_dp*t1151-0.1817120592e1_dp*t149*t617* & - t1154-0.1817120592e1_dp*t610*t1157+0.9085602960e0_dp*t610*t1160 & - -0.1817120592e1_dp*t260*t887-0.5451361779e1_dp*t18*t1166 & - *t1168+0.5451361779e1_dp*t618*t1171-0.9085602964e0_dp*t265* & - t1181)*t168*t96+0.2201284832e1_dp*t631*t269+0.7337616104e0_dp & - *t630*t406*t636+0.1100642416e1_dp*t273*t627+0.7337616104e0_dp & - *t634*t611-0.7337616104e0_dp*t634*t635*t337+0.4891744068e0_dp & - *t272*t1043*t96*t369*t371-0.2422827454e1_dp*t644 & - *t1205+0.3849001789e0_dp*bf*t1208*t984*t1211+0.6730076265e0_dp & - *t643*t859*t1211-0.8981004177e0_dp*bf*t1218*t984* & - t1221-0.3177280975e1_dp*t648*t1205+0.3365038132e0_dp*t643*t937 & - *t1211+0.9708358534e0_dp*t278*t906*t1211-0.3365038132e0_dp & - *t657*t937*t1221+0.3812737170e1_dp*t279*t1235+0.2422827454e1_dp & - *t658*t1238-0.6730076265e0_dp*t657*t859*t1221+0.5132002385e0_dp & - *bf*t1245*t984*t1252-t109*t1341*t122 + t1341 = t1284*t294*t96 + 0.2e1_dp*t679*t269 + 0.6354561952e0_dp* & + t678*t681*t96*t186 + t295*t627 + 0.6354561952e0_dp*t682* & + t269*t186 - 0.6354561952e0_dp*t683*t447 + 0.1514267160e0_dp*t293 & + *t1299*t96*t389 + 0.2647734147e0_dp*t683*t444 - 0.1211413727e1_dp & + *t688*t1205 + 0.1924500894e0_dp*t116*t1208*t984*t1211 & + + 0.3365038132e0_dp*t687*t859*t1211 - 0.4490502088e0_dp*t116*t1218 & + *t984*t1221 - 0.1588640487e1_dp*t691*t1205 + 0.1682519066e0_dp & + *t687*t937*t1211 + 0.4854179267e0_dp*t297*t906*t1211 - & + 0.1682519066e0_dp*t696*t937*t1221 + 0.1906368585e1_dp*t298*t1235 & + + 0.1211413727e1_dp*t697*t1238 - 0.3365038132e0_dp*t696*t859 & + *t1221 + 0.2566001193e0_dp*t116*t1245*t984*t1252 + t1344 = 0.1100642416e1_dp*(-0.3365038134e0_dp*t1145 + 0.6057068641e0_dp & + *t1149 + 0.1211413728e1_dp*t1151 - 0.1817120592e1_dp*t149*t617* & + t1154 - 0.1817120592e1_dp*t610*t1157 + 0.9085602960e0_dp*t610*t1160 & + - 0.1817120592e1_dp*t260*t887 - 0.5451361779e1_dp*t18*t1166 & + *t1168 + 0.5451361779e1_dp*t618*t1171 - 0.9085602964e0_dp*t265* & + t1181)*t168*t96 + 0.2201284832e1_dp*t631*t269 + 0.7337616104e0_dp & + *t630*t406*t636 + 0.1100642416e1_dp*t273*t627 + 0.7337616104e0_dp & + *t634*t611 - 0.7337616104e0_dp*t634*t635*t337 + 0.4891744068e0_dp & + *t272*t1043*t96*t369*t371 - 0.2422827454e1_dp*t644 & + *t1205 + 0.3849001789e0_dp*bf*t1208*t984*t1211 + 0.6730076265e0_dp & + *t643*t859*t1211 - 0.8981004177e0_dp*bf*t1218*t984* & + t1221 - 0.3177280975e1_dp*t648*t1205 + 0.3365038132e0_dp*t643*t937 & + *t1211 + 0.9708358534e0_dp*t278*t906*t1211 - 0.3365038132e0_dp & + *t657*t937*t1221 + 0.3812737170e1_dp*t279*t1235 + 0.2422827454e1_dp & + *t658*t1238 - 0.6730076265e0_dp*t657*t859*t1221 + 0.5132002385e0_dp & + *bf*t1245*t984*t1252 - t109*t1341*t122 t1346 = t13*af*t1344 t1358 = t356*t305*t333 - t1360 = t1085+0.3e1_dp*t1086+(-t1109-0.120e2_dp*t1111-0.3600e2_dp & - *t1114-0.120e2_dp*t1116-0.24000e2_dp*t1120-0.3600e2_dp*t356 & - *t133*t340-0.40e1_dp*t1125)*ap*t54+t1109*t126-0.24000e2_dp & - *t1120*t92+0.120e2_dp*t1110*t257-0.120e2_dp*t1116*t92 & - +0.3e1_dp*t1137+0.3600e2_dp*t771*t772*t340+0.240e2_dp*t1142 & - +t1346-0.120e2_dp*t1111*t92-0.3600e2_dp*t1114*t92-0.3600e2_dp & - *t750*t90*t91*t340-0.40e1_dp*t1125*t92+0.3600e2_dp*t1358 + t1360 = t1085 + 0.3e1_dp*t1086 + (-t1109 - 0.120e2_dp*t1111 - 0.3600e2_dp & + *t1114 - 0.120e2_dp*t1116 - 0.24000e2_dp*t1120 - 0.3600e2_dp*t356 & + *t133*t340 - 0.40e1_dp*t1125)*ap*t54 + t1109*t126 - 0.24000e2_dp & + *t1120*t92 + 0.120e2_dp*t1110*t257 - 0.120e2_dp*t1116*t92 & + + 0.3e1_dp*t1137 + 0.3600e2_dp*t771*t772*t340 + 0.240e2_dp*t1142 & + + t1346 - 0.120e2_dp*t1111*t92 - 0.3600e2_dp*t1114*t92 - 0.3600e2_dp & + *t750*t90*t91*t340 - 0.40e1_dp*t1125*t92 + 0.3600e2_dp*t1358 t1361 = t362*t202 t1363 = t353*t254 t1365 = t144*t591 @@ -2020,15 +2020,15 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t1389 = 0.1e1_dp/t1388 t1391 = t505*t217 t1394 = t217*t513 - t1404 = -t901+t903-t905-0.2427089633e0_dp*ba*t906*t865+0.7943202439e0_dp & - *t508*t874-0.9531842928e0_dp*t214*t887 - t1455 = 0.8412595335e-1_dp*t1368-0.1514267160e0_dp*t1372-0.3028534320e0_dp & - *t1374-0.1906368585e1_dp*t235*t503*t160*t1377+0.7943202441e0_dp & - *t552*t393*t1371-0.1906368585e1_dp*t553*t1380 & - +0.9531842928e0_dp*t553*t1383+0.4206297667e-1_dp*t61*t937*t865 & - -0.4854179269e0_dp*t236*t942+0.1588640488e1_dp*t236*t945 & - -0.1906368586e1_dp*t236*t948-0.6e1_dp*t75*t1389*t1391+0.6e1_dp & - *t560*t1394-t239*t1404 + t1404 = -t901 + t903 - t905 - 0.2427089633e0_dp*ba*t906*t865 + 0.7943202439e0_dp & + *t508*t874 - 0.9531842928e0_dp*t214*t887 + t1455 = 0.8412595335e-1_dp*t1368 - 0.1514267160e0_dp*t1372 - 0.3028534320e0_dp & + *t1374 - 0.1906368585e1_dp*t235*t503*t160*t1377 + 0.7943202441e0_dp & + *t552*t393*t1371 - 0.1906368585e1_dp*t553*t1380 & + + 0.9531842928e0_dp*t553*t1383 + 0.4206297667e-1_dp*t61*t937*t865 & + - 0.4854179269e0_dp*t236*t942 + 0.1588640488e1_dp*t236*t945 & + - 0.1906368586e1_dp*t236*t948 - 0.6e1_dp*t75*t1389*t1391 + 0.6e1_dp & + *t560*t1394 - t239*t1404 t1469 = t74**(-0.40e1_dp) t1477 = t874*t231 t1480 = 0.1e1_dp/t540 @@ -2041,33 +2041,33 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t1517 = 0.1e1_dp/t1516 t1522 = t228**2 t1524 = t865/t545/t230*t1522 - t1527 = t1455*t242*t60+0.2e1_dp*t565*t217+0.6354561952e0_dp* & - t564*t567*t60*t186+0.6354561952e0_dp*t568*t217*t186- & - 0.6354561952e0_dp*t569*t447+0.1514267160e0_dp*t241*t1469*t60 & - *t389+0.2647734147e0_dp*t569*t444+t243*t513-0.1211413727e1_dp & - *t574*t1477+0.1924500894e0_dp*t80*t1480*t984*t1483+ & - 0.3365038132e0_dp*t573*t859*t1483-0.4490502088e0_dp*t80*t1490 & - *t984*t1493-0.1588640487e1_dp*t577*t1477+0.1682519066e0_dp & - *t573*t937*t1483+0.4854179267e0_dp*t245*t906*t1483-0.1682519066e0_dp & - *t582*t937*t1493+0.1906368585e1_dp*t246*t1507 & - +0.1211413727e1_dp*t583*t1510-0.3365038132e0_dp*t582*t859* & - t1493+0.2566001193e0_dp*t80*t1517*t984*t1524 - t1567 = 0.1100642416e1_dp*(-0.3365038134e0_dp*t1368+0.6057068641e0_dp & - *t1372+0.1211413728e1_dp*t1374-0.1817120592e1_dp*t149*t503* & - t1377-0.1817120592e1_dp*t496*t1380+0.9085602960e0_dp*t496*t1383 & - -0.1817120592e1_dp*t208*t887-0.5451361779e1_dp*t18*t1389 & - *t1391+0.5451361779e1_dp*t504*t1394-0.9085602964e0_dp*t213* & - t1404)*t168*t60+0.2201284832e1_dp*t517*t217+0.7337616104e0_dp & - *t516*t406*t522+0.7337616104e0_dp*t520*t497-0.7337616104e0_dp & - *t520*t521*t337+0.4891744068e0_dp*t220*t1043*t60* & - t369*t371-t73*t1527*t86+0.1100642416e1_dp*t221*t513-0.2422827454e1_dp & - *t530*t1477+0.3849001789e0_dp*ba*t1480*t984 & - *t1483+0.6730076265e0_dp*t529*t859*t1483-0.8981004177e0_dp* & - ba*t1490*t984*t1493-0.3177280975e1_dp*t534*t1477+0.3365038132e0_dp & - *t529*t937*t1483+0.9708358534e0_dp*t226*t906*t1483 & - -0.3365038132e0_dp*t543*t937*t1493+0.3812737170e1_dp*t227 & - *t1507+0.2422827454e1_dp*t544*t1510-0.6730076265e0_dp*t543* & - t859*t1493+0.5132002385e0_dp*ba*t1517*t984*t1524 + t1527 = t1455*t242*t60 + 0.2e1_dp*t565*t217 + 0.6354561952e0_dp* & + t564*t567*t60*t186 + 0.6354561952e0_dp*t568*t217*t186 - & + 0.6354561952e0_dp*t569*t447 + 0.1514267160e0_dp*t241*t1469*t60 & + *t389 + 0.2647734147e0_dp*t569*t444 + t243*t513 - 0.1211413727e1_dp & + *t574*t1477 + 0.1924500894e0_dp*t80*t1480*t984*t1483 + & + 0.3365038132e0_dp*t573*t859*t1483 - 0.4490502088e0_dp*t80*t1490 & + *t984*t1493 - 0.1588640487e1_dp*t577*t1477 + 0.1682519066e0_dp & + *t573*t937*t1483 + 0.4854179267e0_dp*t245*t906*t1483 - 0.1682519066e0_dp & + *t582*t937*t1493 + 0.1906368585e1_dp*t246*t1507 & + + 0.1211413727e1_dp*t583*t1510 - 0.3365038132e0_dp*t582*t859* & + t1493 + 0.2566001193e0_dp*t80*t1517*t984*t1524 + t1567 = 0.1100642416e1_dp*(-0.3365038134e0_dp*t1368 + 0.6057068641e0_dp & + *t1372 + 0.1211413728e1_dp*t1374 - 0.1817120592e1_dp*t149*t503* & + t1377 - 0.1817120592e1_dp*t496*t1380 + 0.9085602960e0_dp*t496*t1383 & + - 0.1817120592e1_dp*t208*t887 - 0.5451361779e1_dp*t18*t1389 & + *t1391 + 0.5451361779e1_dp*t504*t1394 - 0.9085602964e0_dp*t213* & + t1404)*t168*t60 + 0.2201284832e1_dp*t517*t217 + 0.7337616104e0_dp & + *t516*t406*t522 + 0.7337616104e0_dp*t520*t497 - 0.7337616104e0_dp & + *t520*t521*t337 + 0.4891744068e0_dp*t220*t1043*t60* & + t369*t371 - t73*t1527*t86 + 0.1100642416e1_dp*t221*t513 - 0.2422827454e1_dp & + *t530*t1477 + 0.3849001789e0_dp*ba*t1480*t984 & + *t1483 + 0.6730076265e0_dp*t529*t859*t1483 - 0.8981004177e0_dp* & + ba*t1490*t984*t1493 - 0.3177280975e1_dp*t534*t1477 + 0.3365038132e0_dp & + *t529*t937*t1483 + 0.9708358534e0_dp*t226*t906*t1483 & + - 0.3365038132e0_dp*t543*t937*t1493 + 0.3812737170e1_dp*t227 & + *t1507 + 0.2422827454e1_dp*t544*t1510 - 0.6730076265e0_dp*t543* & + t859*t1493 + 0.5132002385e0_dp*ba*t1517*t984*t1524 t1570 = t57*aa*t1567*t91 t1576 = t481*t254 t1578 = t357*t254 @@ -2076,17 +2076,17 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t1588 = t143*t305*t340 t1590 = t141*t704 t1593 = t143*t704*t133 - t1599 = 0.3e1_dp*t1361-0.240e2_dp*t1363-0.120e2_dp*t1365+t1570+ & - 0.40e1_dp*t143*t126*t1096+t1108*t56*t92+0.3e1_dp*t1576 & - -0.3600e2_dp*t1578+0.3e1_dp*t1580-0.120e2_dp*t1582+0.24000e2_dp* & - t1119*t126*t1089+0.120e2_dp*t1588+0.3e1_dp*t1590+0.120e2_dp & - *t1593+0.120e2_dp*t352*t604+0.3600e2_dp*t1113*t598 - - e_aaa(ip) = e_aaa(ip)+(t842+0.6e1_dp*t364+0.3e1_dp*t363+0.3e1_dp*t482+0.6e1_dp* & - t485-0.240e2_dp*t483-0.3600e2_dp*t487-0.120e2_dp*t489-0.240e2_dp & - *t491+t851+0.3e1_dp*t593+0.6e1_dp*t596+0.240e2_dp*t594+0.3600e2_dp & - *t599+0.240e2_dp*t602+t857+0.120e2_dp*t605+(t1360+ & - t1599)*t2)*sc + t1599 = 0.3e1_dp*t1361 - 0.240e2_dp*t1363 - 0.120e2_dp*t1365 + t1570 + & + 0.40e1_dp*t143*t126*t1096 + t1108*t56*t92 + 0.3e1_dp*t1576 & + - 0.3600e2_dp*t1578 + 0.3e1_dp*t1580 - 0.120e2_dp*t1582 + 0.24000e2_dp* & + t1119*t126*t1089 + 0.120e2_dp*t1588 + 0.3e1_dp*t1590 + 0.120e2_dp & + *t1593 + 0.120e2_dp*t352*t604 + 0.3600e2_dp*t1113*t598 + + e_aaa(ip) = e_aaa(ip) + (t842 + 0.6e1_dp*t364 + 0.3e1_dp*t363 + 0.3e1_dp*t482 + 0.6e1_dp* & + t485 - 0.240e2_dp*t483 - 0.3600e2_dp*t487 - 0.120e2_dp*t489 - 0.240e2_dp & + *t491 + t851 + 0.3e1_dp*t593 + 0.6e1_dp*t596 + 0.240e2_dp*t594 + 0.3600e2_dp & + *t599 + 0.240e2_dp*t602 + t857 + 0.120e2_dp*t605 + (t1360 + & + t1599)*t2)*sc t1602 = 0.2400e2_dp*t753 t1603 = 0.2e1_dp*t766 @@ -2094,26 +2094,26 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t1605 = 0.2e1_dp*t745 t1606 = 0.80e1_dp*t748 t1609 = 0.160e2_dp*t759 - t1610 = -t1602+t1603-t1604+t1605+t818-t490-t1606+t827 & - +t363-t488+t831+t813-t823-0.160e2_dp*t491+0.4e1_dp*t364 & - +t842-t1609 + t1610 = -t1602 + t1603 - t1604 + t1605 + t818 - t490 - t1606 + t827 & + + t363 - t488 + t831 + t813 - t823 - 0.160e2_dp*t491 + 0.4e1_dp*t364 & + + t842 - t1609 t1611 = 0.80e1_dp*t767 t1613 = t322*t591 t1615 = 0.80e1_dp*t732*t601 t1620 = 0.80e1_dp*t733*t254 t1622 = 0.80e1_dp*t352*t783 t1626 = t732*t340 - t1639 = 0.2e1_dp*t337-0.6e1_dp*t1094 - t1653 = -0.5699736440e0_dp*t1088*t333*t309+0.3419841862e1_dp*t716 & - *t338+0.8549604655e0_dp*t332*t340*t309+0.2564881399e1_dp* & - t129*t1639-0.5699736440e0_dp*t1099*t344*t312-0.3419841862e1_dp & - *t722*t338+0.8549604655e0_dp*t343*t347*t312-0.2564881399e1_dp & + t1639 = 0.2e1_dp*t337 - 0.6e1_dp*t1094 + t1653 = -0.5699736440e0_dp*t1088*t333*t309 + 0.3419841862e1_dp*t716 & + *t338 + 0.8549604655e0_dp*t332*t340*t309 + 0.2564881399e1_dp* & + t129*t1639 - 0.5699736440e0_dp*t1099*t344*t312 - 0.3419841862e1_dp & + *t722*t338 + 0.8549604655e0_dp*t343*t347*t312 - 0.2564881399e1_dp & *t136*t1639 t1654 = t1653*t12 t1657 = t143*t704*t309 - t1659 = t1085+0.2e1_dp*t1086+t1613+t1615-0.160e2_dp*t352*t1 & - *t758-t1620+t1622+0.40e1_dp*t1110*t327+t1137+0.80e1_dp* & - t1142-0.40e1_dp*t1626*t92+t1346+t1654*t126+0.40e1_dp*t1657 + t1659 = t1085 + 0.2e1_dp*t1086 + t1613 + t1615 - 0.160e2_dp*t352*t1 & + *t758 - t1620 + t1622 + 0.40e1_dp*t1110*t327 + t1137 + 0.80e1_dp* & + t1142 - 0.40e1_dp*t1626*t92 + t1346 + t1654*t126 + 0.40e1_dp*t1657 t1664 = 0.160e2_dp*t777*t304*t1*t337 t1666 = 0.80e1_dp*t730*t254 t1668 = t143*t1639 @@ -2121,71 +2121,71 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t1672 = t1671*t133 t1675 = t1110*t309 t1690 = 0.2400e2_dp*t771*t304*t133*t309 - t1694 = 0.1200e2_dp*t1358+t1664+t1361-t1666-0.80e1_dp*t1363- & - 0.40e1_dp*t1668*t92-0.80e1_dp*t1672*t92-0.40e1_dp*t1675*t92 & - -0.2400e2_dp*t1113*t133*t752-0.80e1_dp*t1365+t1570-0.4800e2_dp & - *t356*t133*aa*t757*t338+t1690+0.40e1_dp*t143*t126 & + t1694 = 0.1200e2_dp*t1358 + t1664 + t1361 - t1666 - 0.80e1_dp*t1363 - & + 0.40e1_dp*t1668*t92 - 0.80e1_dp*t1672*t92 - 0.40e1_dp*t1675*t92 & + - 0.2400e2_dp*t1113*t133*t752 - 0.80e1_dp*t1365 + t1570 - 0.4800e2_dp & + *t356*t133*aa*t757*t338 + t1690 + 0.40e1_dp*t143*t126 & *t1639 t1696 = t316*t704 t1697 = t315*t355 t1698 = t1697*t333 t1701 = t1119*af - t1726 = t1696-0.1200e2_dp*t1698*t92+0.24000e2_dp*t1701*t125* & - t333*t309+t1653*t56*t92+0.2400e2_dp*t1113*af*t773+ & - 0.4800e2_dp*t771*t772*t338+0.160e2_dp*t352*af*t779+0.40e1_dp & - *t732*t604+t1576-0.1200e2_dp*t1578+0.1200e2_dp*t1697*t598 & - +0.2e1_dp*t1580-0.40e1_dp*t1582+0.80e1_dp*t1671*t257 + t1726 = t1696 - 0.1200e2_dp*t1698*t92 + 0.24000e2_dp*t1701*t125* & + t333*t309 + t1653*t56*t92 + 0.2400e2_dp*t1113*af*t773 + & + 0.4800e2_dp*t771*t772*t338 + 0.160e2_dp*t352*af*t779 + 0.40e1_dp & + *t732*t604 + t1576 - 0.1200e2_dp*t1578 + 0.1200e2_dp*t1697*t598 & + + 0.2e1_dp*t1580 - 0.40e1_dp*t1582 + 0.80e1_dp*t1671*t257 t1730 = 0.160e2_dp*t755*t756*t252*t91 - t1750 = -t1654-0.40e1_dp*t1675-0.80e1_dp*t1672-0.2400e2_dp*t1113 & - *t735-0.160e2_dp*t352*t338-0.1200e2_dp*t1698-0.24000e2_dp*t1119 & - *t333*t309-0.4800e2_dp*t356*t133*t1*t337-0.40e1_dp* & - t1626-0.1200e2_dp*t356*t340*t309-0.40e1_dp*t1668 + t1750 = -t1654 - 0.40e1_dp*t1675 - 0.80e1_dp*t1672 - 0.2400e2_dp*t1113 & + *t735 - 0.160e2_dp*t352*t338 - 0.1200e2_dp*t1698 - 0.24000e2_dp*t1119 & + *t333*t309 - 0.4800e2_dp*t356*t133*t1*t337 - 0.40e1_dp* & + t1626 - 0.1200e2_dp*t356*t340*t309 - 0.40e1_dp*t1668 t1754 = 0.2e1_dp*t744*t254 t1764 = 0.2e1_dp*t741*t202 t1765 = t320*t479 t1768 = 0.2400e2_dp*t750*t253*t751 t1775 = 0.2e1_dp*t729*t305 t1776 = t317*t591 - t1778 = -t1730+t1750*ap*t54+t1754-0.24000e2_dp*t1119*t333 & - *t752+0.40e1_dp*t1588-0.1200e2_dp*t356*t340*t752+0.2e1_dp & - *t1590+t1764+t1765-t1768+0.80e1_dp*t1593+0.1200e2_dp*t771 & - *t125*t340*t309+t1775-0.40e1_dp*t1776 + t1778 = -t1730 + t1750*ap*t54 + t1754 - 0.24000e2_dp*t1119*t333 & + *t752 + 0.40e1_dp*t1588 - 0.1200e2_dp*t356*t340*t752 + 0.2e1_dp & + *t1590 + t1764 + t1765 - t1768 + 0.80e1_dp*t1593 + 0.1200e2_dp*t771 & + *t125*t340*t309 + t1775 - 0.40e1_dp*t1776 t1782 = 0.2e1_dp*t742 t1783 = 0.160e2_dp*t780 t1785 = 0.2400e2_dp*t774 t1786 = 0.80e1_dp*t769 - t1789 = t606+t1611+t600+t482+t851+t595+(t1659+t1694+ & - t1726+t1778)*t2+t1782+t1783+t593+0.4e1_dp*t596+t857 & - -t484+t1785+t1786+0.4e1_dp*t485+0.160e2_dp*t602 + t1789 = t606 + t1611 + t600 + t482 + t851 + t595 + (t1659 + t1694 + & + t1726 + t1778)*t2 + t1782 + t1783 + t593 + 0.4e1_dp*t596 + t857 & + - t484 + t1785 + t1786 + 0.4e1_dp*t485 + 0.160e2_dp*t602 - e_aab(ip) = e_aab(ip)+(t1610+t1789)*sc + e_aab(ip) = e_aab(ip) + (t1610 + t1789)*sc - t1795 = -t1602+t826+t812+t824+t834+t1603-t1604+t1605 & - +0.4e1_dp*t762-t1606+0.4e1_dp*t782+t830+0.160e2_dp*t784+0.4e1_dp & - *t743-0.160e2_dp*t764-t492+t365 + t1795 = -t1602 + t826 + t812 + t824 + t834 + t1603 - t1604 + t1605 & + + 0.4e1_dp*t762 - t1606 + 0.4e1_dp*t782 + t830 + 0.160e2_dp*t784 + 0.4e1_dp & + *t743 - 0.160e2_dp*t764 - t492 + t365 t1797 = t143*t305*t793 t1804 = t337*t309 - t1826 = -0.5699736440e0_dp*t1088*t133*t789+0.3419841862e1_dp*t332 & - *t1*t1804+0.8549604655e0_dp*t716*t793-0.5129762798e1_dp* & - t129*t337-0.1538928839e2_dp*t719*t371-0.5699736440e0_dp*t1099 & - *t137*t796-0.3419841862e1_dp*t343*t1*t337*t312+0.8549604655e0_dp & - *t722*t799+0.5129762798e1_dp*t136*t337+0.1538928839e2_dp & + t1826 = -0.5699736440e0_dp*t1088*t133*t789 + 0.3419841862e1_dp*t332 & + *t1*t1804 + 0.8549604655e0_dp*t716*t793 - 0.5129762798e1_dp* & + t129*t337 - 0.1538928839e2_dp*t719*t371 - 0.5699736440e0_dp*t1099 & + *t137*t796 - 0.3419841862e1_dp*t343*t1*t337*t312 + 0.8549604655e0_dp & + *t722*t799 + 0.5129762798e1_dp*t136*t337 + 0.1538928839e2_dp & *t725*t371 t1829 = t352*t793 t1832 = t814*t254 t1836 = t732*t783 t1838 = t811*t202 - t1839 = t1085+t1086+0.40e1_dp*t1797+0.2e1_dp*t1613+t1615+t1826 & - *t56*t92-0.40e1_dp*t1829*t92-t1620+t1832+t1622+0.24000e2_dp & - *t1701*t772*t789+0.80e1_dp*t1836+t1346+t1838 + t1839 = t1085 + t1086 + 0.40e1_dp*t1797 + 0.2e1_dp*t1613 + t1615 + t1826 & + *t56*t92 - 0.40e1_dp*t1829*t92 - t1620 + t1832 + t1622 + 0.24000e2_dp & + *t1701*t772*t789 + 0.80e1_dp*t1836 + t1346 + t1838 t1850 = t806*t254 t1853 = t356*t305*t789 t1858 = t802*t142 - t1868 = -0.80e1_dp*t143*t126*t337+0.240e2_dp*t755*t371*aa* & - t757-0.2400e2_dp*t1697*t133*t752-0.1200e2_dp*t1850+0.1200e2_dp & - *t1853+0.80e1_dp*t1657+t1664-t1666-0.40e1_dp*t1365+t1570 & - +t1690+0.2e1_dp*t1696+0.40e1_dp*t1858*t257-0.24000e2_dp*t1119 & - *t133*t90*t91*t789+0.80e1_dp*t1671*t327 + t1868 = -0.80e1_dp*t143*t126*t337 + 0.240e2_dp*t755*t371*aa* & + t757 - 0.2400e2_dp*t1697*t133*t752 - 0.1200e2_dp*t1850 + 0.1200e2_dp & + *t1853 + 0.80e1_dp*t1657 + t1664 - t1666 - 0.40e1_dp*t1365 + t1570 & + + t1690 + 0.2e1_dp*t1696 + 0.40e1_dp*t1858*t257 - 0.24000e2_dp*t1119 & + *t133*t90*t91*t789 + 0.80e1_dp*t1671*t327 t1870 = t804*t254 t1872 = t143*t337 t1884 = t1826*t12 @@ -2195,58 +2195,58 @@ SUBROUTINE vwn5_lsd_calc(rhoa, rhob, e_0, e_a, e_b, e_aa, e_bb, e_ab, & t1894 = t1113*t789 t1897 = t1858*t133 t1901 = t90*t91*t793 - t1904 = -0.80e1_dp*t1870+0.80e1_dp*t1872*t92-0.160e2_dp*t732*t1 & - *t758+0.1200e2_dp*t771*t772*t793+0.2400e2_dp*t1697*af* & - t773+t1884*t126-0.80e1_dp*t1886*t92+0.40e1_dp*t352*t832 & - -0.40e1_dp*t1891+t1893+t1580-0.1200e2_dp*t1894*t92-0.40e1_dp & - *t1897*t92-0.1200e2_dp*t750*t1901 - t1939 = -t1884-0.80e1_dp*t1886-0.1200e2_dp*t1894-0.40e1_dp*t1829 & - -0.40e1_dp*t1897-0.2400e2_dp*t1697*t735-0.160e2_dp*t732*t338 & - -0.24000e2_dp*t1119*t133*t789-0.4800e2_dp*t356*t338*t309 & - -0.1200e2_dp*t356*t133*t793+0.80e1_dp*t1872+0.240e2_dp*t143 & + t1904 = -0.80e1_dp*t1870 + 0.80e1_dp*t1872*t92 - 0.160e2_dp*t732*t1 & + *t758 + 0.1200e2_dp*t771*t772*t793 + 0.2400e2_dp*t1697*af* & + t773 + t1884*t126 - 0.80e1_dp*t1886*t92 + 0.40e1_dp*t352*t832 & + - 0.40e1_dp*t1891 + t1893 + t1580 - 0.1200e2_dp*t1894*t92 - 0.40e1_dp & + *t1897*t92 - 0.1200e2_dp*t750*t1901 + t1939 = -t1884 - 0.80e1_dp*t1886 - 0.1200e2_dp*t1894 - 0.40e1_dp*t1829 & + - 0.40e1_dp*t1897 - 0.2400e2_dp*t1697*t735 - 0.160e2_dp*t732*t338 & + - 0.24000e2_dp*t1119*t133*t789 - 0.4800e2_dp*t356*t338*t309 & + - 0.1200e2_dp*t356*t133*t793 + 0.80e1_dp*t1872 + 0.240e2_dp*t143 & *t1094 - t1945 = -t1730-0.240e2_dp*t777*t778*t371+t1754-0.4800e2_dp* & - t356*t338*t752+0.160e2_dp*t732*af*t779+t1590+t1764+ & - 0.2e1_dp*t1765-t1768+0.40e1_dp*t1593+0.4800e2_dp*t771*t778* & - t1804+t1939*ap*t54+0.1200e2_dp*t1113*t828+t1775-0.80e1_dp & + t1945 = -t1730 - 0.240e2_dp*t777*t778*t371 + t1754 - 0.4800e2_dp* & + t356*t338*t752 + 0.160e2_dp*t732*af*t779 + t1590 + t1764 + & + 0.2e1_dp*t1765 - t1768 + 0.40e1_dp*t1593 + 0.4800e2_dp*t771*t778* & + t1804 + t1939*ap*t54 + 0.1200e2_dp*t1113*t828 + t1775 - 0.80e1_dp & *t1776 - t1949 = t842-t1609+t815+t1611+t851+t1782+t1783+t597+ & - t857+(t1839+t1868+t1904+t1945)*t2-t817+t1785+t1786 & - -t820+t486+t603-t822 + t1949 = t842 - t1609 + t815 + t1611 + t851 + t1782 + t1783 + t597 + & + t857 + (t1839 + t1868 + t1904 + t1945)*t2 - t817 + t1785 + t1786 & + - t820 + t486 + t603 - t822 - e_abb(ip) = e_abb(ip)+(t1795+t1949)*sc + e_abb(ip) = e_abb(ip) + (t1795 + t1949)*sc t1975 = t1697*t789 t1979 = t789*t309 - t1986 = -0.6e1_dp*t337-0.6e1_dp*t1094 - t1998 = -0.5699736440e0_dp*t1088*t1979+0.2564881396e1_dp*t332*t309 & - *t793+0.2564881399e1_dp*t129*t1986-0.5699736440e0_dp*t1099 & - *t796*t312+0.2564881396e1_dp*t343*t312*t799-0.2564881399e1_dp & + t1986 = -0.6e1_dp*t337 - 0.6e1_dp*t1094 + t1998 = -0.5699736440e0_dp*t1088*t1979 + 0.2564881396e1_dp*t332*t309 & + *t793 + 0.2564881399e1_dp*t129*t1986 - 0.5699736440e0_dp*t1099 & + *t796*t312 + 0.2564881396e1_dp*t343*t312*t799 - 0.2564881399e1_dp & *t136*t1986 t1999 = t1998*t12 - t2010 = t1085+0.120e2_dp*t1797+0.3e1_dp*t1613-0.3600e2_dp*t356* & - t309*t1901+0.3600e2_dp*t771*t125*t309*t793+0.3e1_dp*t1832 & - +0.240e2_dp*t1836-0.3600e2_dp*t1975*t92+t1346+0.3e1_dp*t1838 & - +t1999*t126+0.40e1_dp*t143*t126*t1986-0.3600e2_dp*t1850 & - +0.3600e2_dp*t1853+0.120e2_dp*t1657+0.24000e2_dp*t1119*t126 & + t2010 = t1085 + 0.120e2_dp*t1797 + 0.3e1_dp*t1613 - 0.3600e2_dp*t356* & + t309*t1901 + 0.3600e2_dp*t771*t125*t309*t793 + 0.3e1_dp*t1832 & + + 0.240e2_dp*t1836 - 0.3600e2_dp*t1975*t92 + t1346 + 0.3e1_dp*t1838 & + + t1999*t126 + 0.40e1_dp*t143*t126*t1986 - 0.3600e2_dp*t1850 & + + 0.3600e2_dp*t1853 + 0.120e2_dp*t1657 + 0.24000e2_dp*t1119*t126 & *t1979 t2011 = t1858*t309 t2014 = t732*t793 t2019 = t143*t1986 t2025 = t1119*t1979 - t2048 = -0.120e2_dp*t2011*t92+t1570-0.120e2_dp*t2014*t92+0.3e1_dp & - *t1696-0.240e2_dp*t1870-0.40e1_dp*t2019*t92+(-t1999-0.120e2_dp & - *t2011-0.3600e2_dp*t1975-0.120e2_dp*t2014-0.24000e2_dp* & - t2025-0.3600e2_dp*t356*t309*t793-0.40e1_dp*t2019)*ap*t54 & - -0.24000e2_dp*t2025*t92-0.120e2_dp*t1891+0.3e1_dp*t1893+0.3600e2_dp & - *t1697*t828+0.120e2_dp*t732*t832+t1998*t56*t92+ & - 0.3e1_dp*t1765+0.120e2_dp*t1858*t327-0.120e2_dp*t1776 - - e_bbb(ip) = e_bbb(ip)+(0.3e1_dp*t812+0.6e1_dp*t743+t842+t851+t857+0.6e1_dp*t762 & - -0.240e2_dp*t764+0.6e1_dp*t782+0.240e2_dp*t784+0.3e1_dp*t815 & - -0.240e2_dp*t816-0.3600e2_dp*t819-0.120e2_dp*t821+0.3e1_dp*t824 & - +0.240e2_dp*t825+0.3600e2_dp*t829+0.120e2_dp*t833+(t2010+ & - t2048)*t2)*sc + t2048 = -0.120e2_dp*t2011*t92 + t1570 - 0.120e2_dp*t2014*t92 + 0.3e1_dp & + *t1696 - 0.240e2_dp*t1870 - 0.40e1_dp*t2019*t92 + (-t1999 - 0.120e2_dp & + *t2011 - 0.3600e2_dp*t1975 - 0.120e2_dp*t2014 - 0.24000e2_dp* & + t2025 - 0.3600e2_dp*t356*t309*t793 - 0.40e1_dp*t2019)*ap*t54 & + - 0.24000e2_dp*t2025*t92 - 0.120e2_dp*t1891 + 0.3e1_dp*t1893 + 0.3600e2_dp & + *t1697*t828 + 0.120e2_dp*t732*t832 + t1998*t56*t92 + & + 0.3e1_dp*t1765 + 0.120e2_dp*t1858*t327 - 0.120e2_dp*t1776 + + e_bbb(ip) = e_bbb(ip) + (0.3e1_dp*t812 + 0.6e1_dp*t743 + t842 + t851 + t857 + 0.6e1_dp*t762 & + - 0.240e2_dp*t764 + 0.6e1_dp*t782 + 0.240e2_dp*t784 + 0.3e1_dp*t815 & + - 0.240e2_dp*t816 - 0.3600e2_dp*t819 - 0.120e2_dp*t821 + 0.3e1_dp*t824 & + + 0.240e2_dp*t825 + 0.3600e2_dp*t829 + 0.120e2_dp*t833 + (t2010 + & + t2048)*t2)*sc END IF END IF diff --git a/src/xc/xc_xalpha.F b/src/xc/xc_xalpha.F index be597eb464..190d2c0c4b 100644 --- a/src/xc/xc_xalpha.F +++ b/src/xc/xc_xalpha.F @@ -105,8 +105,8 @@ SUBROUTINE xalpha_info(lsd, reference, shortform, needs, max_deriv, & "Dirac/Slater local exchange; parameter=", my_xparam END IF IF (.NOT. lsd) THEN - IF (LEN_TRIM(reference)+6 < LEN(reference)) THEN - reference(LEN_TRIM(reference):LEN_TRIM(reference)+6) = ' {LDA}' + IF (LEN_TRIM(reference) + 6 < LEN(reference)) THEN + reference(LEN_TRIM(reference):LEN_TRIM(reference) + 6) = ' {LDA}' END IF END IF END IF @@ -117,8 +117,8 @@ SUBROUTINE xalpha_info(lsd, reference, shortform, needs, max_deriv, & WRITE (shortform, '(A,F8.4)') "Dirac/Slater exchange", my_xparam END IF IF (.NOT. lsd) THEN - IF (LEN_TRIM(shortform)+6 < LEN(shortform)) THEN - shortform(LEN_TRIM(shortform):LEN_TRIM(shortform)+6) = ' {LDA}' + IF (LEN_TRIM(shortform) + 6 < LEN(shortform)) THEN + shortform(LEN_TRIM(shortform):LEN_TRIM(shortform) + 6) = ' {LDA}' END IF END IF END IF @@ -171,7 +171,7 @@ SUBROUTINE xalpha_lda_eval(rho_set, deriv_set, order, xa_params, xa_parameter) CPASSERT(deriv_set%ref_count > 0) CALL xc_rho_set_get(rho_set, rho_1_3=r13, rho=rho, & local_bounds=bo, rho_cutoff=epsilon_rho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) CALL xalpha_init(epsilon_rho, xa_parameter) IF (order >= 0) THEN @@ -252,7 +252,7 @@ SUBROUTINE xalpha_lsd_eval(rho_set, deriv_set, order, xa_params, xa_parameter) rhob_1_3=rho_1_3(2)%array, rhoa=rho(1)%array, & rhob=rho(2)%array, rho_cutoff=epsilon_rho, & local_bounds=bo) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) CALL xalpha_init(epsilon_rho, xa_parameter) DO ispin = 1, 2 @@ -320,7 +320,7 @@ SUBROUTINE xalpha_lda_0(n, rho, r13, pot, sx) DO ip = 1, n IF (rho(ip) > eps_rho) THEN - pot(ip) = pot(ip)+f*r13(ip)*rho(ip) + pot(ip) = pot(ip) + f*r13(ip)*rho(ip) END IF END DO @@ -349,7 +349,7 @@ SUBROUTINE xalpha_lda_1(n, rho, r13, pot, sx) !$OMP SHARED(n,rho,eps_rho,pot,f,r13) DO ip = 1, n IF (rho(ip) > eps_rho) THEN - pot(ip) = pot(ip)+f*r13(ip) + pot(ip) = pot(ip) + f*r13(ip) END IF END DO @@ -378,7 +378,7 @@ SUBROUTINE xalpha_lda_2(n, rho, r13, pot, sx) !$OMP SHARED(n,rho,eps_rho,pot,f,r13) DO ip = 1, n IF (rho(ip) > eps_rho) THEN - pot(ip) = pot(ip)+f*r13(ip)/rho(ip) + pot(ip) = pot(ip) + f*r13(ip)/rho(ip) END IF END DO @@ -407,7 +407,7 @@ SUBROUTINE xalpha_lda_3(n, rho, r13, pot, sx) !$OMP SHARED(n,rho,eps_rho,pot,f,r13) DO ip = 1, n IF (rho(ip) > eps_rho) THEN - pot(ip) = pot(ip)+f*r13(ip)/(rho(ip)*rho(ip)) + pot(ip) = pot(ip) + f*r13(ip)/(rho(ip)*rho(ip)) END IF END DO @@ -440,7 +440,7 @@ SUBROUTINE xalpha_lsd_0(n, rhoa, r13a, pot, sx) DO ip = 1, n IF (rhoa(ip) > eps_rho) THEN - pot(ip) = pot(ip)+f*r13a(ip)*rhoa(ip) + pot(ip) = pot(ip) + f*r13a(ip)*rhoa(ip) END IF END DO @@ -474,7 +474,7 @@ SUBROUTINE xalpha_lsd_1(n, rhoa, r13a, pota, sx) DO ip = 1, n IF (rhoa(ip) > eps_rho) THEN - pota(ip) = pota(ip)+f*r13a(ip) + pota(ip) = pota(ip) + f*r13a(ip) END IF END DO @@ -508,7 +508,7 @@ SUBROUTINE xalpha_lsd_2(n, rhoa, r13a, potaa, sx) DO ip = 1, n IF (rhoa(ip) > eps_rho) THEN - potaa(ip) = potaa(ip)+f*r13a(ip)/rhoa(ip) + potaa(ip) = potaa(ip) + f*r13a(ip)/rhoa(ip) END IF END DO @@ -542,7 +542,7 @@ SUBROUTINE xalpha_lsd_3(n, rhoa, r13a, potaaa, sx) DO ip = 1, n IF (rhoa(ip) > eps_rho) THEN - potaaa(ip) = potaaa(ip)+f*r13a(ip)/(rhoa(ip)*rhoa(ip)) + potaaa(ip) = potaaa(ip) + f*r13a(ip)/(rhoa(ip)*rhoa(ip)) END IF END DO diff --git a/src/xc/xc_xbecke88.F b/src/xc/xc_xbecke88.F index a0e69e1f71..895b0d5d51 100644 --- a/src/xc/xc_xbecke88.F +++ b/src/xc/xc_xbecke88.F @@ -145,7 +145,7 @@ SUBROUTINE xb88_lda_eval(rho_set, deriv_set, grad_deriv, xb88_params) CPASSERT(deriv_set%ref_count > 0) CALL xc_rho_set_get(rho_set, rho_1_3=rho_1_3, rho=rho, & norm_drho=norm_drho, local_bounds=bo, rho_cutoff=epsilon_rho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rho @@ -288,15 +288,15 @@ SUBROUTINE xb88_lda_calc(rho, rho_1_3, norm_drho, & t3 = my_rho_1_3*my_rho x = norm_drho(ii)/MAX(t3, epsilon_rho43) t6 = x**2 - t10 = t2*t6+0.1e1_dp + t10 = t2*t6 + 0.1e1_dp t11 = SQRT(t10) - t12 = t1*x+t11 + t12 = t1*x + t11 t13 = LOG(t12) - t17 = 0.1e1_dp+0.6e1_dp*t7*x*t13 + t17 = 0.1e1_dp + 0.6e1_dp*t7*x*t13 t18 = 0.1e1_dp/t17 - t21 = -c-t5*t6*t18 + t21 = -c - t5*t6*t18 - e_0(ii) = e_0(ii)+(t2*t3*t21/0.2e1_dp)*sx + e_0(ii) = e_0(ii) + (t2*t3*t21/0.2e1_dp)*sx END IF END DO @@ -314,31 +314,31 @@ SUBROUTINE xb88_lda_calc(rho, rho_1_3, norm_drho, & t3 = my_rho_1_3*my_rho x = norm_drho(ii)/t3 t6 = x**2 - t10 = t2*t6+0.1e1_dp + t10 = t2*t6 + 0.1e1_dp t11 = SQRT(t10) - t12 = t1*x+t11 + t12 = t1*x + t11 t13 = LOG(t12) - t17 = 0.1e1_dp+0.6e1_dp*t7*x*t13 + t17 = 0.1e1_dp + 0.6e1_dp*t7*x*t13 t18 = 0.1e1_dp/t17 - t21 = -c-t5*t6*t18 + t21 = -c - t5*t6*t18 - e_0(ii) = e_0(ii)+(t2*t3*t21/0.2e1_dp)*sx + e_0(ii) = e_0(ii) + (t2*t3*t21/0.2e1_dp)*sx t23 = t2*my_rho_1_3 t29 = 0.1e1_dp/t11 - t31 = t1+t2*x*t29 + t31 = t1 + t2*x*t29 t33 = 0.1e1_dp/t12 - t37 = 0.6e1_dp*t7*t13+0.6e1_dp*t7*x*t31*t33 + t37 = 0.6e1_dp*t7*t13 + 0.6e1_dp*t7*x*t31*t33 t39 = t17**2 t40 = 0.1e1_dp/t39 - t43 = -0.2e1_dp*t5*x*t18+t5*t6*t37*t40 + t43 = -0.2e1_dp*t5*x*t18 + t5*t6*t37*t40 t44 = t43*x e_rho(ii) = e_rho(ii) & - -(0.2e1_dp/0.3e1_dp*t23*t44-0.2e1_dp/0.3e1_dp* & - t23*t21)*sx + - (0.2e1_dp/0.3e1_dp*t23*t44 - 0.2e1_dp/0.3e1_dp* & + t23*t21)*sx e_ndrho(ii) = e_ndrho(ii) & - +(t2*t43/0.2e1_dp)*sx + + (t2*t43/0.2e1_dp)*sx END IF END DO @@ -357,29 +357,29 @@ SUBROUTINE xb88_lda_calc(rho, rho_1_3, norm_drho, & t3 = my_rho_1_3*my_rho x = norm_drho(ii)/t3 t6 = x**2 - t10 = t2*t6+0.1e1_dp + t10 = t2*t6 + 0.1e1_dp t11 = SQRT(t10) - t12 = t1*x+t11 + t12 = t1*x + t11 t13 = LOG(t12) - t17 = 0.1e1_dp+0.6e1_dp*t7*x*t13 + t17 = 0.1e1_dp + 0.6e1_dp*t7*x*t13 t18 = 0.1e1_dp/t17 - t21 = -c-t5*t6*t18 + t21 = -c - t5*t6*t18 t23 = t2*my_rho_1_3 t29 = 0.1e1_dp/t11 - t31 = t1+t2*x*t29 + t31 = t1 + t2*x*t29 t33 = 0.1e1_dp/t12 - t37 = 0.6e1_dp*t7*t13+0.6e1_dp*t7*x*t31*t33 + t37 = 0.6e1_dp*t7*t13 + 0.6e1_dp*t7*x*t31*t33 t39 = t17**2 t40 = 0.1e1_dp/t39 - t43 = -0.2e1_dp*t5*x*t18+t5*t6*t37*t40 + t43 = -0.2e1_dp*t5*x*t18 + t5*t6*t37*t40 t44 = t43*x e_rho(ii) = e_rho(ii) & - -(0.2e1_dp/0.3e1_dp*t23*t44-0.2e1_dp/0.3e1_dp* & - t23*t21)*sx + - (0.2e1_dp/0.3e1_dp*t23*t44 - 0.2e1_dp/0.3e1_dp* & + t23*t21)*sx e_ndrho(ii) = e_ndrho(ii) & - +(t2*t43/0.2e1_dp)*sx + + (t2*t43/0.2e1_dp)*sx END IF END DO @@ -397,46 +397,46 @@ SUBROUTINE xb88_lda_calc(rho, rho_1_3, norm_drho, & t3 = my_rho_1_3*my_rho x = norm_drho(ii)/t3 t6 = x**2 - t10 = t2*t6+0.1e1_dp + t10 = t2*t6 + 0.1e1_dp t11 = SQRT(t10) - t12 = t1*x+t11 + t12 = t1*x + t11 t13 = LOG(t12) - t17 = 0.1e1_dp+0.6e1_dp*t7*x*t13 + t17 = 0.1e1_dp + 0.6e1_dp*t7*x*t13 t18 = 0.1e1_dp/t17 - t21 = -c-t5*t6*t18 + t21 = -c - t5*t6*t18 - e_0(ii) = e_0(ii)+(t2*t3*t21/0.2e1_dp)*sx + e_0(ii) = e_0(ii) + (t2*t3*t21/0.2e1_dp)*sx t23 = t2*my_rho_1_3 t29 = 0.1e1_dp/t11 - t31 = t1+t2*x*t29 + t31 = t1 + t2*x*t29 t33 = 0.1e1_dp/t12 - t37 = 0.6e1_dp*t7*t13+0.6e1_dp*t7*x*t31*t33 + t37 = 0.6e1_dp*t7*t13 + 0.6e1_dp*t7*x*t31*t33 t39 = t17**2 t40 = 0.1e1_dp/t39 - t43 = -0.2e1_dp*t5*x*t18+t5*t6*t37*t40 + t43 = -0.2e1_dp*t5*x*t18 + t5*t6*t37*t40 t44 = t43*x e_rho(ii) = e_rho(ii) & - -(0.2e1_dp/0.3e1_dp*t23*t44-0.2e1_dp/0.3e1_dp* & - t23*t21)*sx + - (0.2e1_dp/0.3e1_dp*t23*t44 - 0.2e1_dp/0.3e1_dp* & + t23*t21)*sx e_ndrho(ii) = e_ndrho(ii) & - +(t2*t43/0.2e1_dp)*sx + + (t2*t43/0.2e1_dp)*sx t49 = my_rho_1_3**2 t51 = t2/t49 t54 = x*t40 t64 = 0.1e1_dp/t11/t10 - t67 = t2*t29-0.2e1_dp*t1*t6*t64 + t67 = t2*t29 - 0.2e1_dp*t1*t6*t64 t72 = t31**2 t74 = t12**2 t75 = 0.1e1_dp/t74 - t79 = 0.12e2_dp*t7*t31*t33+0.6e1_dp*t7*x*t67*t33 & - -0.6e1_dp*t7*x*t72*t75 + t79 = 0.12e2_dp*t7*t31*t33 + 0.6e1_dp*t7*x*t67*t33 & + - 0.6e1_dp*t7*x*t72*t75 t83 = t37**2 t86 = 0.1e1_dp/t39/t17 - t90 = -0.2e1_dp*t5*t18+0.4e1_dp*t5*t54*t37+t5*t6* & - t79*t40-0.2e1_dp*t5*t6*t83*t86 + t90 = -0.2e1_dp*t5*t18 + 0.4e1_dp*t5*t54*t37 + t5*t6* & + t79*t40 - 0.2e1_dp*t5*t6*t83*t86 t91 = t90*t6 t98 = 0.1e1_dp/my_rho t99 = t2*t98 @@ -444,12 +444,12 @@ SUBROUTINE xb88_lda_calc(rho, rho_1_3, norm_drho, & t104 = 0.1e1_dp/t3 e_rho_rho(ii) = e_rho_rho(ii) & - +(0.8e1_dp/0.9e1_dp*t51*t91-0.2e1_dp/0.9e1_dp* & - t51*t44+0.2e1_dp/0.9e1_dp*t51*t21)*sx + + (0.8e1_dp/0.9e1_dp*t51*t91 - 0.2e1_dp/0.9e1_dp* & + t51*t44 + 0.2e1_dp/0.9e1_dp*t51*t21)*sx e_ndrho_rho(ii) = e_ndrho_rho(ii) & - -(0.2e1_dp/0.3e1_dp*t99*t100)*sx + - (0.2e1_dp/0.3e1_dp*t99*t100)*sx e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii) & - +(t2*t90*t104/0.2e1_dp)*sx + + (t2*t90*t104/0.2e1_dp)*sx END IF END DO @@ -467,38 +467,38 @@ SUBROUTINE xb88_lda_calc(rho, rho_1_3, norm_drho, & t3 = my_rho_1_3*my_rho x = norm_drho(ii)/t3 t6 = x**2 - t10 = t2*t6+0.1e1_dp + t10 = t2*t6 + 0.1e1_dp t11 = SQRT(t10) - t12 = t1*x+t11 + t12 = t1*x + t11 t13 = LOG(t12) - t17 = 0.1e1_dp+0.6e1_dp*t7*x*t13 + t17 = 0.1e1_dp + 0.6e1_dp*t7*x*t13 t18 = 0.1e1_dp/t17 - t21 = -c-t5*t6*t18 + t21 = -c - t5*t6*t18 t23 = t2*my_rho_1_3 t29 = 0.1e1_dp/t11 - t31 = t1+t2*x*t29 + t31 = t1 + t2*x*t29 t33 = 0.1e1_dp/t12 - t37 = 0.6e1_dp*t7*t13+0.6e1_dp*t7*x*t31*t33 + t37 = 0.6e1_dp*t7*t13 + 0.6e1_dp*t7*x*t31*t33 t39 = t17**2 t40 = 0.1e1_dp/t39 - t43 = -0.2e1_dp*t5*x*t18+t5*t6*t37*t40 + t43 = -0.2e1_dp*t5*x*t18 + t5*t6*t37*t40 t44 = t43*x t49 = my_rho_1_3**2 t51 = t2/t49 t54 = x*t40 t64 = 0.1e1_dp/t11/t10 - t67 = t2*t29-0.2e1_dp*t1*t6*t64 + t67 = t2*t29 - 0.2e1_dp*t1*t6*t64 t72 = t31**2 t74 = t12**2 t75 = 0.1e1_dp/t74 - t79 = 0.12e2_dp*t7*t31*t33+0.6e1_dp*t7*x*t67*t33 & - -0.6e1_dp*t7*x*t72*t75 + t79 = 0.12e2_dp*t7*t31*t33 + 0.6e1_dp*t7*x*t67*t33 & + - 0.6e1_dp*t7*x*t72*t75 t83 = t37**2 t86 = 0.1e1_dp/t39/t17 - t90 = -0.2e1_dp*t5*t18+0.4e1_dp*t5*t54*t37+t5*t6* & - t79*t40-0.2e1_dp*t5*t6*t83*t86 + t90 = -0.2e1_dp*t5*t18 + 0.4e1_dp*t5*t54*t37 + t5*t6* & + t79*t40 - 0.2e1_dp*t5*t6*t83*t86 t91 = t90*t6 t98 = 0.1e1_dp/my_rho t99 = t2*t98 @@ -506,12 +506,12 @@ SUBROUTINE xb88_lda_calc(rho, rho_1_3, norm_drho, & t104 = 0.1e1_dp/t3 e_rho_rho(ii) = e_rho_rho(ii) & - +(0.8e1_dp/0.9e1_dp*t51*t91-0.2e1_dp/0.9e1_dp* & - t51*t44+0.2e1_dp/0.9e1_dp*t51*t21)*sx + + (0.8e1_dp/0.9e1_dp*t51*t91 - 0.2e1_dp/0.9e1_dp* & + t51*t44 + 0.2e1_dp/0.9e1_dp*t51*t21)*sx e_ndrho_rho(ii) = e_ndrho_rho(ii) & - -(0.2e1_dp/0.3e1_dp*t99*t100)*sx + - (0.2e1_dp/0.3e1_dp*t99*t100)*sx e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii) & - +(t2*t90*t104/0.2e1_dp)*sx + + (t2*t90*t104/0.2e1_dp)*sx END IF END DO @@ -529,50 +529,50 @@ SUBROUTINE xb88_lda_calc(rho, rho_1_3, norm_drho, & t3 = my_rho_1_3*my_rho x = norm_drho(ii)/t3 t6 = x**2 - t10 = t2*t6+0.1e1_dp + t10 = t2*t6 + 0.1e1_dp t11 = SQRT(t10) - t12 = t1*x+t11 + t12 = t1*x + t11 t13 = LOG(t12) - t17 = 0.1e1_dp+0.6e1_dp*t7*x*t13 + t17 = 0.1e1_dp + 0.6e1_dp*t7*x*t13 t18 = 0.1e1_dp/t17 - t21 = -c-t5*t6*t18 + t21 = -c - t5*t6*t18 IF (grad_deriv >= 0) THEN - e_0(ii) = e_0(ii)+(t2*t3*t21/0.2e1_dp)*sx + e_0(ii) = e_0(ii) + (t2*t3*t21/0.2e1_dp)*sx END IF t23 = t2*my_rho_1_3 t29 = 0.1e1_dp/t11 - t31 = t1+t2*x*t29 + t31 = t1 + t2*x*t29 t33 = 0.1e1_dp/t12 - t37 = 0.6e1_dp*t7*t13+0.6e1_dp*t7*x*t31*t33 + t37 = 0.6e1_dp*t7*t13 + 0.6e1_dp*t7*x*t31*t33 t39 = t17**2 t40 = 0.1e1_dp/t39 - t43 = -0.2e1_dp*t5*x*t18+t5*t6*t37*t40 + t43 = -0.2e1_dp*t5*x*t18 + t5*t6*t37*t40 t44 = t43*x IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN e_rho(ii) = e_rho(ii) & - -(0.2e1_dp/0.3e1_dp*t23*t44-0.2e1_dp/0.3e1_dp* & - t23*t21)*sx + - (0.2e1_dp/0.3e1_dp*t23*t44 - 0.2e1_dp/0.3e1_dp* & + t23*t21)*sx e_ndrho(ii) = e_ndrho(ii) & - +(t2*t43/0.2e1_dp)*sx + + (t2*t43/0.2e1_dp)*sx END IF t49 = my_rho_1_3**2 t51 = t2/t49 t54 = x*t40 t64 = 0.1e1_dp/t11/t10 - t67 = t2*t29-0.2e1_dp*t1*t6*t64 + t67 = t2*t29 - 0.2e1_dp*t1*t6*t64 t72 = t31**2 t74 = t12**2 t75 = 0.1e1_dp/t74 - t79 = 0.12e2_dp*t7*t31*t33+0.6e1_dp*t7*x*t67*t33 & - -0.6e1_dp*t7*x*t72*t75 + t79 = 0.12e2_dp*t7*t31*t33 + 0.6e1_dp*t7*x*t67*t33 & + - 0.6e1_dp*t7*x*t72*t75 t83 = t37**2 t86 = 0.1e1_dp/t39/t17 - t90 = -0.2e1_dp*t5*t18+0.4e1_dp*t5*t54*t37+t5*t6* & - t79*t40-0.2e1_dp*t5*t6*t83*t86 + t90 = -0.2e1_dp*t5*t18 + 0.4e1_dp*t5*t54*t37 + t5*t6* & + t79*t40 - 0.2e1_dp*t5*t6*t83*t86 t91 = t90*t6 t98 = 0.1e1_dp/my_rho t99 = t2*t98 @@ -581,40 +581,40 @@ SUBROUTINE xb88_lda_calc(rho, rho_1_3, norm_drho, & IF (grad_deriv >= 2 .OR. grad_deriv == -2) THEN e_rho_rho(ii) = e_rho_rho(ii) & - +(0.8e1_dp/0.9e1_dp*t51*t91-0.2e1_dp/0.9e1_dp* & - t51*t44+0.2e1_dp/0.9e1_dp*t51*t21)*sx + + (0.8e1_dp/0.9e1_dp*t51*t91 - 0.2e1_dp/0.9e1_dp* & + t51*t44 + 0.2e1_dp/0.9e1_dp*t51*t21)*sx e_ndrho_rho(ii) = e_ndrho_rho(ii) & - -(0.2e1_dp/0.3e1_dp*t99*t100)*sx + - (0.2e1_dp/0.3e1_dp*t99*t100)*sx e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii) & - +(t2*t90*t104/0.2e1_dp)*sx + + (t2*t90*t104/0.2e1_dp)*sx END IF t126 = t10**2 t159 = t39**2 - t164 = 0.6e1_dp*t5*t40*t37-0.12e2_dp*t5*x*t86*t83 & - +0.6e1_dp*t5*t54*t79+t5*t6*(0.18e2_dp*t7*t67 & - *t33-0.18e2_dp*t7*t72*t75+0.6e1_dp*t7*x* & - (-0.6e1_dp*t1*t64*x+0.12e2_dp*t6*x/t11/t126) & - *t33-0.18e2_dp*t7*x*t67*t75*t31+0.12e2_dp*t7 & - *x*t72*t31/t74/t12)*t40-0.6e1_dp*t5*t6*t79 & - *t86*t37+0.6e1_dp*t5*t6*t83*t37/t159 - t170 = 0.8e1_dp/0.9e1_dp*t51*t164*t6+0.14e2_dp/0.9e1_dp & + t164 = 0.6e1_dp*t5*t40*t37 - 0.12e2_dp*t5*x*t86*t83 & + + 0.6e1_dp*t5*t54*t79 + t5*t6*(0.18e2_dp*t7*t67 & + *t33 - 0.18e2_dp*t7*t72*t75 + 0.6e1_dp*t7*x* & + (-0.6e1_dp*t1*t64*x + 0.12e2_dp*t6*x/t11/t126) & + *t33 - 0.18e2_dp*t7*x*t67*t75*t31 + 0.12e2_dp*t7 & + *x*t72*t31/t74/t12)*t40 - 0.6e1_dp*t5*t6*t79 & + *t86*t37 + 0.6e1_dp*t5*t6*t83*t37/t159 + t170 = 0.8e1_dp/0.9e1_dp*t51*t164*t6 + 0.14e2_dp/0.9e1_dp & *t51*t100 t176 = t2/t49/my_rho t189 = my_rho**2 IF (grad_deriv == -3 .OR. grad_deriv >= 3) THEN e_rho_rho_rho(ii) = e_rho_rho_rho(ii) & - -(0.4e1_dp/0.3e1_dp*t170*x*t98+0.16e2_dp/0.27e2_dp & - *t176*t91-0.4e1_dp/0.27e2_dp*t176*t44+ & - 0.4e1_dp/0.27e2_dp*t176*t21)*sx + - (0.4e1_dp/0.3e1_dp*t170*x*t98 + 0.16e2_dp/0.27e2_dp & + *t176*t91 - 0.4e1_dp/0.27e2_dp*t176*t44 + & + 0.4e1_dp/0.27e2_dp*t176*t21)*sx e_ndrho_rho_rho(ii) = e_ndrho_rho_rho(ii) & - +(t170*t104)*sx + + (t170*t104)*sx e_ndrho_ndrho_rho(ii) = e_ndrho_ndrho_rho(ii) & - +((-0.2e1_dp/0.3e1_dp*t99*t164*x- & - 0.2e1_dp/0.3e1_dp*t99*t90)*t104)*sx + + ((-0.2e1_dp/0.3e1_dp*t99*t164*x - & + 0.2e1_dp/0.3e1_dp*t99*t90)*t104)*sx e_ndrho_ndrho_ndrho(ii) = e_ndrho_ndrho_ndrho(ii) & - +(t2*t164/t49/t189/0.2e1_dp)*sx + + (t2*t164/t49/t189/0.2e1_dp)*sx END IF END IF END DO @@ -672,7 +672,7 @@ SUBROUTINE xb88_lsd_eval(rho_set, deriv_set, grad_deriv, xb88_params) rhob=rho(2)%array, norm_drhoa=norm_drho(1)%array, & norm_drhob=norm_drho(2)%array, rho_cutoff=epsilon_rho, & local_bounds=bo) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rho(1)%array @@ -854,16 +854,16 @@ SUBROUTINE xb88_lsd_calc(rho_spin, rho_1_3_spin, norm_drho_spin, e_0, & t2 = x**2 t3 = beta*t2 t4 = beta*x - t5 = t2+0.1e1_dp + t5 = t2 + 0.1e1_dp t6 = SQRT(t5) - t7 = x+t6 + t7 = x + t6 t8 = LOG(t7) - t11 = 0.1e1_dp+0.6e1_dp*t4*t8 + t11 = 0.1e1_dp + 0.6e1_dp*t4*t8 t12 = 0.1e1_dp/t11 - t14 = -c-t3*t12 + t14 = -c - t3*t12 e_0(ii) = e_0(ii) & - +(t1*t14)*sx + + (t1*t14)*sx END IF END DO @@ -881,31 +881,31 @@ SUBROUTINE xb88_lsd_calc(rho_spin, rho_1_3_spin, norm_drho_spin, e_0, & t2 = x**2 t3 = beta*t2 t4 = beta*x - t5 = t2+0.1e1_dp + t5 = t2 + 0.1e1_dp t6 = SQRT(t5) - t7 = x+t6 + t7 = x + t6 t8 = LOG(t7) - t11 = 0.1e1_dp+0.6e1_dp*t4*t8 + t11 = 0.1e1_dp + 0.6e1_dp*t4*t8 t12 = 0.1e1_dp/t11 - t14 = -c-t3*t12 + t14 = -c - t3*t12 e_0(ii) = e_0(ii) & - +(t1*t14)*sx + + (t1*t14)*sx t17 = t11**2 t18 = 0.1e1_dp/t17 t20 = 0.1e1_dp/t6 - t22 = 0.1e1_dp+t20*x + t22 = 0.1e1_dp + t20*x t23 = 0.1e1_dp/t7 - t27 = 0.6e1_dp*beta*t8+0.6e1_dp*t4*t22*t23 + t27 = 0.6e1_dp*beta*t8 + 0.6e1_dp*t4*t22*t23 t28 = t18*t27 - t30 = -0.2e1_dp*t4*t12+t3*t28 + t30 = -0.2e1_dp*t4*t12 + t3*t28 e_rho_spin(ii) = e_rho_spin(ii) & - -(0.4e1_dp/0.3e1_dp*rho_1_3_spin(ii)*t30*x- & - 0.4e1_dp/0.3e1_dp*rho_1_3_spin(ii)*t14)*sx + - (0.4e1_dp/0.3e1_dp*rho_1_3_spin(ii)*t30*x - & + 0.4e1_dp/0.3e1_dp*rho_1_3_spin(ii)*t14)*sx e_ndrho_spin(ii) = e_ndrho_spin(ii) & - +(t30)*sx + + (t30)*sx END IF END DO @@ -923,34 +923,34 @@ SUBROUTINE xb88_lsd_calc(rho_spin, rho_1_3_spin, norm_drho_spin, e_0, & t2 = x**2 t3 = beta*t2 t4 = beta*x - t5 = t2+0.1e1_dp + t5 = t2 + 0.1e1_dp t6 = SQRT(t5) - t7 = x+t6 + t7 = x + t6 t8 = LOG(t7) - t11 = 0.1e1_dp+0.6e1_dp*t4*t8 + t11 = 0.1e1_dp + 0.6e1_dp*t4*t8 t12 = 0.1e1_dp/t11 - t14 = -c-t3*t12 + t14 = -c - t3*t12 IF (grad_deriv >= 0) THEN e_0(ii) = e_0(ii) & - +(t1*t14)*sx + + (t1*t14)*sx END IF t17 = t11**2 t18 = 0.1e1_dp/t17 t20 = 0.1e1_dp/t6 - t22 = 0.1e1_dp+t20*x + t22 = 0.1e1_dp + t20*x t23 = 0.1e1_dp/t7 - t27 = 0.6e1_dp*beta*t8+0.6e1_dp*t4*t22*t23 + t27 = 0.6e1_dp*beta*t8 + 0.6e1_dp*t4*t22*t23 t28 = t18*t27 - t30 = -0.2e1_dp*t4*t12+t3*t28 + t30 = -0.2e1_dp*t4*t12 + t3*t28 IF (grad_deriv == -1 .OR. grad_deriv >= 1) THEN e_rho_spin(ii) = e_rho_spin(ii) & - -(0.4e1_dp/0.3e1_dp*rho_1_3_spin(ii)*t30*x- & - 0.4e1_dp/0.3e1_dp*rho_1_3_spin(ii)*t14)*sx + - (0.4e1_dp/0.3e1_dp*rho_1_3_spin(ii)*t30*x - & + 0.4e1_dp/0.3e1_dp*rho_1_3_spin(ii)*t14)*sx e_ndrho_spin(ii) = e_ndrho_spin(ii) & - +(t30)*sx + + (t30)*sx END IF t35 = rho_1_3_spin(ii)**2 @@ -959,13 +959,13 @@ SUBROUTINE xb88_lsd_calc(rho_spin, rho_1_3_spin, norm_drho_spin, e_0, & t43 = t27**2 t44 = t42*t43 t51 = 0.1e1_dp/t6/t5 - t53 = -t51*t2+t20 + t53 = -t51*t2 + t20 t57 = t22**2 t58 = t7**2 t59 = 0.1e1_dp/t58 - t63 = 0.12e2_dp*beta*t22*t23+0.6e1_dp*t4*t53*t23-0.6e1_dp*t4*t57*t59 + t63 = 0.12e2_dp*beta*t22*t23 + 0.6e1_dp*t4*t53*t23 - 0.6e1_dp*t4*t57*t59 t64 = t18*t63 - t66 = -0.2e1_dp*beta*t12+0.4e1_dp*t4*t28-0.2e1_dp*t3*t44+t3*t64 + t66 = -0.2e1_dp*beta*t12 + 0.4e1_dp*t4*t28 - 0.2e1_dp*t3*t44 + t3*t64 t67 = t36*t66 t75 = 0.1e1_dp/my_rho t76 = t75*t66 @@ -973,39 +973,39 @@ SUBROUTINE xb88_lsd_calc(rho_spin, rho_1_3_spin, norm_drho_spin, e_0, & IF (grad_deriv == -2 .OR. grad_deriv >= 2) THEN e_rho_rho_spin(ii) = e_rho_rho_spin(ii) & - +(0.16e2_dp/0.9e1_dp*t67*t2-0.4e1_dp/0.9e1_dp & - *t36*t30*x+0.4e1_dp/0.9e1_dp*t36*t14)*sx + + (0.16e2_dp/0.9e1_dp*t67*t2 - 0.4e1_dp/0.9e1_dp & + *t36*t30*x + 0.4e1_dp/0.9e1_dp*t36*t14)*sx e_ndrho_rho_spin(ii) = e_ndrho_rho_spin(ii) & - -(0.4e1_dp/0.3e1_dp*t76*x)*sx - e_ndrho_ndrho_spin(ii) = e_ndrho_ndrho_spin(ii)+ & + - (0.4e1_dp/0.3e1_dp*t76*x)*sx + e_ndrho_ndrho_spin(ii) = e_ndrho_ndrho_spin(ii) + & (t66*t79)*sx END IF t87 = t17**2 t103 = t5**2 - t127 = 0.6e1_dp*beta*t18*t27-0.12e2_dp*t4*t44+0.6e1_dp & - *t4*t64+0.6e1_dp*t3/t87*t43*t27-0.6e1_dp*t3 & - *t42*t27*t63+t3*t18*(0.18e2_dp*beta*t53*t23 & - -0.18e2_dp*beta*t57*t59+0.6e1_dp*t4*(0.3e1_dp/ & - t6/t103*t2*x-0.3e1_dp*t51*x)*t23-0.18e2_dp* & - t4*t53*t59*t22+0.12e2_dp*t4*t57*t22/t58/t7) - t133 = 0.16e2_dp/0.9e1_dp*t36*t127*t2+0.28e2_dp/0.9e1_dp & + t127 = 0.6e1_dp*beta*t18*t27 - 0.12e2_dp*t4*t44 + 0.6e1_dp & + *t4*t64 + 0.6e1_dp*t3/t87*t43*t27 - 0.6e1_dp*t3 & + *t42*t27*t63 + t3*t18*(0.18e2_dp*beta*t53*t23 & + - 0.18e2_dp*beta*t57*t59 + 0.6e1_dp*t4*(0.3e1_dp/ & + t6/t103*t2*x - 0.3e1_dp*t51*x)*t23 - 0.18e2_dp* & + t4*t53*t59*t22 + 0.12e2_dp*t4*t57*t22/t58/t7) + t133 = 0.16e2_dp/0.9e1_dp*t36*t127*t2 + 0.28e2_dp/0.9e1_dp & *t67*x t138 = 0.1e1_dp/t35/my_rho t151 = my_rho**2 IF (grad_deriv == -3 .OR. grad_deriv >= 3) THEN e_rho_rho_rho_spin(ii) = e_rho_rho_rho_spin(ii) & - -(0.4e1_dp/0.3e1_dp*t133*x*t75+0.32e2_dp/0.27e2_dp & - *t138*t66*t2-0.8e1_dp/0.27e2_dp*t138*t30* & - x+0.8e1_dp/0.27e2_dp*t138*t14)*sx + - (0.4e1_dp/0.3e1_dp*t133*x*t75 + 0.32e2_dp/0.27e2_dp & + *t138*t66*t2 - 0.8e1_dp/0.27e2_dp*t138*t30* & + x + 0.8e1_dp/0.27e2_dp*t138*t14)*sx e_ndrho_rho_rho_spin(ii) = e_ndrho_rho_rho_spin(ii) & - +(t133*t79)*sx + + (t133*t79)*sx e_ndrho_ndrho_rho_spin(ii) = e_ndrho_ndrho_rho_spin(ii) & - +((-0.4e1_dp/0.3e1_dp*t75*t127*x- & - 0.4e1_dp/0.3e1_dp*t76)*t79)*sx + + ((-0.4e1_dp/0.3e1_dp*t75*t127*x - & + 0.4e1_dp/0.3e1_dp*t76)*t79)*sx e_ndrho_ndrho_ndrho_spin(ii) = e_ndrho_ndrho_ndrho_spin(ii) & - +(t127/t35/t151)*sx + + (t127/t35/t151)*sx END IF END IF END DO diff --git a/src/xc/xc_xbecke88_long_range.F b/src/xc/xc_xbecke88_long_range.F index 6780ff92dd..a1afdc84d6 100644 --- a/src/xc/xc_xbecke88_long_range.F +++ b/src/xc/xc_xbecke88_long_range.F @@ -148,7 +148,7 @@ SUBROUTINE xb88_lr_lda_eval(rho_set, deriv_set, grad_deriv, xb88_lr_params) CPASSERT(deriv_set%ref_count > 0) CALL xc_rho_set_get(rho_set, rho=rho, & norm_drho=norm_drho, local_bounds=bo, rho_cutoff=epsilon_rho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) ! meaningful default for the arrays we don't need: let us make compiler ! and debugger happy... @@ -315,11 +315,11 @@ SUBROUTINE xb88_lr_lda_calc(rho, norm_drho, & t8 = t1**2 t10 = 0.1e1_dp/t8/t7 t11 = beta*my_ndrho - t12 = LOG(xx+SQRT(xx**0.2e1_dp+0.1e1_dp)) - t16 = 0.10e1_dp+0.60e1_dp*t11*t3*t12 + t12 = LOG(xx + SQRT(xx**0.2e1_dp + 0.1e1_dp)) + t16 = 0.10e1_dp + 0.60e1_dp*t11*t3*t12 t17 = 0.1e1_dp/t16 t18 = t10*t17 - t21 = 0.20e1_dp*Cx+0.20e1_dp*t6*t18 + t21 = 0.20e1_dp*Cx + 0.20e1_dp*t6*t18 t22 = SQRT(t21) t23 = t22*t21 t24 = my_rho*t23 @@ -343,14 +343,14 @@ SUBROUTINE xb88_lr_lda_calc(rho, norm_drho, & t47 = t39*t21 t48 = 0.1e1_dp/pi t49 = 0.1e1_dp/t8 - t51 = t46-0.10e1_dp + t51 = t46 - 0.10e1_dp t52 = t48*t49*t51 - t55 = t46-0.15e1_dp-0.5555555558e-1_dp*t47*t52 - t59 = t26*t34+0.3333333334e0_dp*t36*t38*t55 + t55 = t46 - 0.15e1_dp - 0.5555555558e-1_dp*t47*t52 + t59 = t26*t34 + 0.3333333334e0_dp*t36*t38*t55 t60 = t27*t59 !! Multiply with 2.0 because it code comes from LSD - e_0(ii) = e_0(ii)-0.2222222224e0_dp*t24*omega*t60*sx*2.0_dp + e_0(ii) = e_0(ii) - 0.2222222224e0_dp*t24*omega*t60*sx*2.0_dp END IF IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN @@ -363,13 +363,13 @@ SUBROUTINE xb88_lr_lda_calc(rho, norm_drho, & t76 = 0.1e1_dp/t75 t77 = t10*t76 t79 = 0.1e1_dp/t1/t7 - t84 = 1+t5*t10 + t84 = 1 + t5*t10 t85 = SQRT(t84) t86 = 0.1e1_dp/t85 t87 = t71*t86 - t90 = -0.8000000000e1_dp*t11*t79*t12-0.8000000000e1_dp*t6*t87 + t90 = -0.8000000000e1_dp*t11*t79*t12 - 0.8000000000e1_dp*t6*t87 t91 = t77*t90 - t94 = -0.5333333333e1_dp*t6*t72-0.20e1_dp*t6*t91 + t94 = -0.5333333333e1_dp*t6*t72 - 0.20e1_dp*t6*t91 t95 = t60*t94 t98 = omega*t27 t99 = SQRT(0.3141592654e1_dp) @@ -379,7 +379,7 @@ SUBROUTINE xb88_lr_lda_calc(rho, norm_drho, & t104 = 0.1e1_dp/t23 t105 = t28*t104 t109 = t26*t49 - t112 = -0.1500000000e1_dp*t105*t31*t94+0.1000000000e1_dp*t30* & + t112 = -0.1500000000e1_dp*t105*t31*t94 + 0.1000000000e1_dp*t30* & t109 t113 = t103*t112 t116 = omega*t29 @@ -392,7 +392,7 @@ SUBROUTINE xb88_lr_lda_calc(rho, norm_drho, & t130 = t128*t43*t94 t132 = pi*t37 t133 = t42*t132 - t135 = 0.8999999998e1_dp*t130-0.5999999999e1_dp*t133 + t135 = 0.8999999998e1_dp*t130 - 0.5999999999e1_dp*t133 t136 = t135*t46 t137 = t39*t94 t140 = t8*my_rho @@ -401,31 +401,31 @@ SUBROUTINE xb88_lr_lda_calc(rho, norm_drho, & t146 = t47*t48 t147 = t49*t135 t148 = t147*t46 - t151 = t136-0.5555555558e-1_dp*t137*t52+0.3703703705e-1_dp*t47 & - *t143-0.5555555558e-1_dp*t146*t148 - t155 = REAL(2*t101*t113, KIND=dp)+0.1666666667e0_dp*t117*t118*t94- & - 0.1111111111e0_dp*t36*t122*t55+0.3333333334e0_dp*t36*t38* & + t151 = t136 - 0.5555555558e-1_dp*t137*t52 + 0.3703703705e-1_dp*t47 & + *t143 - 0.5555555558e-1_dp*t146*t148 + t155 = REAL(2*t101*t113, KIND=dp) + 0.1666666667e0_dp*t117*t118*t94 - & + 0.1111111111e0_dp*t36*t122*t55 + 0.3333333334e0_dp*t36*t38* & t151 - e_rho(ii) = e_rho(ii)+(-0.2222222224e0_dp*t64*t60-0.3333333336e0_dp*t68*t95- & - 0.2222222224e0_dp*t24*t98*t155)*sx + e_rho(ii) = e_rho(ii) + (-0.2222222224e0_dp*t64*t60 - 0.3333333336e0_dp*t68*t95 - & + 0.2222222224e0_dp*t24*t98*t155)*sx - t168 = 0.60e1_dp*beta*t3*t12+0.60e1_dp*t11*t10*t86 + t168 = 0.60e1_dp*beta*t3*t12 + 0.60e1_dp*t11*t10*t86 t169 = t77*t168 - t172 = 0.40e1_dp*t11*t18-0.20e1_dp*t6*t169 + t172 = 0.40e1_dp*t11*t18 - 0.20e1_dp*t6*t169 t173 = t60*t172 t176 = pi*t100 t177 = t176*t103 t185 = t128*pi t186 = t8*t172 t190 = t39*t172 - t196 = 0.8999999998e1_dp*t185*t186*t46-0.5555555558e-1_dp*t190 & - *t52-0.5000000001e0_dp*t41*t172*t46 - t200 = -0.3000000000e1_dp*t177*t105*t1*t172+0.1666666667e0_dp* & - t117*t118*t172+0.3333333334e0_dp*t36*t38*t196 + t196 = 0.8999999998e1_dp*t185*t186*t46 - 0.5555555558e-1_dp*t190 & + *t52 - 0.5000000001e0_dp*t41*t172*t46 + t200 = -0.3000000000e1_dp*t177*t105*t1*t172 + 0.1666666667e0_dp* & + t117*t118*t172 + 0.3333333334e0_dp*t36*t38*t196 - e_ndrho(ii) = e_ndrho(ii)+(-0.3333333336e0_dp*t68*t173-0.2222222224e0_dp*t24*t98 & - *t200)*sx + e_ndrho(ii) = e_ndrho(ii) + (-0.3333333336e0_dp*t68*t173 - 0.2222222224e0_dp*t24*t98 & + *t200)*sx END IF IF (grad_deriv >= 2 .OR. grad_deriv == -2) THEN @@ -449,19 +449,19 @@ SUBROUTINE xb88_lr_lda_calc(rho, norm_drho, & t245 = beta*t244 t250 = 0.1e1_dp/t85/t84 t251 = 0.1e1_dp/t1/t219/t69*t250 - t254 = 0.1866666667e2_dp*t11*t237*t12+0.4000000000e2_dp*t6*t241 & - -0.1066666667e2_dp*t245*t251 + t254 = 0.1866666667e2_dp*t11*t237*t12 + 0.4000000000e2_dp*t6*t241 & + - 0.1066666667e2_dp*t245*t251 t255 = t77*t254 - t258 = 0.1955555555e2_dp*t6*t222+0.1066666667e2_dp*t6*t226+0.40e1_dp & - *t6*t233-0.20e1_dp*t6*t255 + t258 = 0.1955555555e2_dp*t6*t222 + 0.1066666667e2_dp*t6*t226 + 0.40e1_dp & + *t6*t233 - 0.20e1_dp*t6*t255 t259 = t60*t258 - t264 = 0.9000000000e1_dp*t130-0.6000000000e1_dp*t133 + t264 = 0.9000000000e1_dp*t130 - 0.6000000000e1_dp*t133 t265 = t264*t103 t270 = 0.1e1_dp/t22/t126 t271 = t28*t270 t281 = t26*t141 - t284 = 0.2250000000e1_dp*t271*t31*t212-0.1000000000e1_dp*t105* & - t109*t94-0.1500000000e1_dp*t105*t31*t258-0.6666666667e0_dp & + t284 = 0.2250000000e1_dp*t271*t31*t212 - 0.1000000000e1_dp*t105* & + t109*t94 - 0.1500000000e1_dp*t105*t31*t258 - 0.6666666667e0_dp & *t30*t281 t285 = t103*t284 t289 = omega*t104*t27 @@ -476,7 +476,7 @@ SUBROUTINE xb88_lr_lda_calc(rho, norm_drho, & t321 = t128*t43*t258 t323 = pi*t3 t325 = 0.2000000000e1_dp*t42*t323 - t326 = -t316+t319+0.8999999998e1_dp*t321+t325 + t326 = -t316 + t319 + 0.8999999998e1_dp*t321 + t325 t328 = t135**2 t330 = t39*t258 t335 = t137*t48 @@ -485,19 +485,19 @@ SUBROUTINE xb88_lr_lda_calc(rho, norm_drho, & t346 = t49*t326 t347 = t346*t46 t351 = t49*t328*t46 - t354 = t326*t46+t328*t46-0.5555555558e-1_dp*t330*t52+0.7407407410e-1_dp & - *t137*t143-0.1111111112e0_dp*t335*t148-0.6172839508e-1_dp & - *t47*t339+0.7407407410e-1_dp*t146*t343-0.5555555558e-1_dp & - *t146*t347-0.5555555558e-1_dp*t146*t351 - t358 = REAL(2*t101*t265*t112, KIND=dp)+REAL(2*t101*t285, KIND=dp)-0.8333333335e-1_dp & - *t289*t118*t212-0.1111111111e0_dp*t117*t293*t94 & - +0.3333333334e0_dp*t117*t297*t94+0.1666666667e0_dp*t117* & - t118*t258+0.1481481481e0_dp*t36*t304*t55-0.2222222222e0_dp* & - t36*t122*t151+0.3333333334e0_dp*t36*t38*t354 - - e_rho_rho(ii) = e_rho_rho(ii)+(-0.6666666672e0_dp*t36*t95-0.4444444448e0_dp*t64*t207- & - 0.1666666668e0_dp*t211*t213-0.6666666672e0_dp*t68*t216-0.3333333336e0_dp & - *t68*t259-0.2222222224e0_dp*t24*t98*t358)*sx + t354 = t326*t46 + t328*t46 - 0.5555555558e-1_dp*t330*t52 + 0.7407407410e-1_dp & + *t137*t143 - 0.1111111112e0_dp*t335*t148 - 0.6172839508e-1_dp & + *t47*t339 + 0.7407407410e-1_dp*t146*t343 - 0.5555555558e-1_dp & + *t146*t347 - 0.5555555558e-1_dp*t146*t351 + t358 = REAL(2*t101*t265*t112, KIND=dp) + REAL(2*t101*t285, KIND=dp) - 0.8333333335e-1_dp & + *t289*t118*t212 - 0.1111111111e0_dp*t117*t293*t94 & + + 0.3333333334e0_dp*t117*t297*t94 + 0.1666666667e0_dp*t117* & + t118*t258 + 0.1481481481e0_dp*t36*t304*t55 - 0.2222222222e0_dp* & + t36*t122*t151 + 0.3333333334e0_dp*t36*t38*t354 + + e_rho_rho(ii) = e_rho_rho(ii) + (-0.6666666672e0_dp*t36*t95 - 0.4444444448e0_dp*t64*t207 - & + 0.1666666668e0_dp*t211*t213 - 0.6666666672e0_dp*t68*t216 - 0.3333333336e0_dp & + *t68*t259 - 0.2222222224e0_dp*t24*t98*t358)*sx t365 = t27*t200 t368 = t94*t172 @@ -508,19 +508,19 @@ SUBROUTINE xb88_lr_lda_calc(rho, norm_drho, & t384 = t383*t168 t393 = beta*t5*my_ndrho t397 = 0.1e1_dp/t1/t219/t7*t250 - t400 = -0.8000000000e1_dp*beta*t79*t12-0.2400000000e2_dp*t11* & - t87+0.8000000000e1_dp*t393*t397 + t400 = -0.8000000000e1_dp*beta*t79*t12 - 0.2400000000e2_dp*t11* & + t87 + 0.8000000000e1_dp*t393*t397 t401 = t77*t400 - t404 = -0.1066666667e2_dp*t11*t72+0.5333333333e1_dp*t6*t377-0.40e1_dp & - *t11*t91+0.40e1_dp*t382*t384-0.20e1_dp*t6*t401 + t404 = -0.1066666667e2_dp*t11*t72 + 0.5333333333e1_dp*t6*t377 - 0.40e1_dp & + *t11*t91 + 0.40e1_dp*t382*t384 - 0.20e1_dp*t6*t401 t405 = t60*t404 t408 = t207*t172 t412 = t26*pi*t100 t413 = t412*t128 t417 = t271*t26 t418 = t1*t94 - t428 = 0.2250000000e1_dp*t417*t418*t172-0.1500000000e1_dp*t105 & - *t31*t404-0.5000000000e0_dp*t105*t109*t172 + t428 = 0.2250000000e1_dp*t417*t418*t172 - 0.1500000000e1_dp*t105 & + *t31*t404 - 0.5000000000e0_dp*t105*t109*t172 t429 = t103*t428 t435 = t37*t196 t451 = t313*pi @@ -528,7 +528,7 @@ SUBROUTINE xb88_lr_lda_calc(rho, norm_drho, & t455 = 0.1800000000e2_dp*t451*t452*t172 t457 = t128*t43*t404 t460 = t128*t132*t172 - t462 = -t455+0.8999999998e1_dp*t457+0.5999999999e1_dp*t460 + t462 = -t455 + 0.8999999998e1_dp*t457 + 0.5999999999e1_dp*t460 t463 = t462*t46 t464 = t135*t40 t465 = t464*t127 @@ -541,20 +541,20 @@ SUBROUTINE xb88_lr_lda_calc(rho, norm_drho, & t482 = t190*t48 t486 = t49*t462*t46 t489 = t41*t135 - t492 = t463+0.8999999998e1_dp*t465*t467-0.5555555558e-1_dp*t470 & - *t52-0.5000000001e0_dp*t473*t466+0.3703703705e-1_dp*t190*t143 & - +0.3333333334e0_dp*t479*t466-0.5555555558e-1_dp*t482*t148 & - -0.5555555558e-1_dp*t146*t486-0.5000000001e0_dp*t489*t466 - t496 = 0.1800000000e2_dp*t413*t186*t113+REAL(2*t101*t429, KIND=dp) & - -0.8333333335e-1_dp*t289*t118*t368+0.1666666667e0_dp*t117*t435 & - *t94+0.1666666667e0_dp*t117*t118*t404-0.5555555555e-1_dp & - *t117*t293*t172-0.1111111111e0_dp*t36*t122*t196+0.1666666667e0_dp & - *t117*t297*t172+0.3333333334e0_dp*t36*t38*t492 - - e_ndrho_rho(ii) = e_ndrho_rho(ii)+(-0.3333333336e0_dp*t36*t173-0.2222222224e0_dp*t64*t365- & - 0.1666666668e0_dp*t211*t60*t368-0.3333333336e0_dp*t68*t372 & - -0.3333333336e0_dp*t68*t405-0.3333333336e0_dp*t68*t408-0.2222222224e0_dp & - *t24*t98*t496)*sx + t492 = t463 + 0.8999999998e1_dp*t465*t467 - 0.5555555558e-1_dp*t470 & + *t52 - 0.5000000001e0_dp*t473*t466 + 0.3703703705e-1_dp*t190*t143 & + + 0.3333333334e0_dp*t479*t466 - 0.5555555558e-1_dp*t482*t148 & + - 0.5555555558e-1_dp*t146*t486 - 0.5000000001e0_dp*t489*t466 + t496 = 0.1800000000e2_dp*t413*t186*t113 + REAL(2*t101*t429, KIND=dp) & + - 0.8333333335e-1_dp*t289*t118*t368 + 0.1666666667e0_dp*t117*t435 & + *t94 + 0.1666666667e0_dp*t117*t118*t404 - 0.5555555555e-1_dp & + *t117*t293*t172 - 0.1111111111e0_dp*t36*t122*t196 + 0.1666666667e0_dp & + *t117*t297*t172 + 0.3333333334e0_dp*t36*t38*t492 + + e_ndrho_rho(ii) = e_ndrho_rho(ii) + (-0.3333333336e0_dp*t36*t173 - 0.2222222224e0_dp*t64*t365 - & + 0.1666666668e0_dp*t211*t60*t368 - 0.3333333336e0_dp*t68*t372 & + - 0.3333333336e0_dp*t68*t405 - 0.3333333336e0_dp*t68*t408 - 0.2222222224e0_dp & + *t24*t98*t496)*sx t501 = t172**2 t502 = t60*t501 @@ -564,10 +564,10 @@ SUBROUTINE xb88_lr_lda_calc(rho, norm_drho, & t514 = t231*t513 t519 = t219*my_rho t521 = 0.1e1_dp/t1/t519 - t525 = 0.120e2_dp*t508*t86-0.60e1_dp*t6*t521*t250 + t525 = 0.120e2_dp*t508*t86 - 0.60e1_dp*t6*t521*t250 t526 = t77*t525 - t529 = 0.40e1_dp*t508*t17-0.80e1_dp*t11*t169+0.40e1_dp*t6*t514 & - -0.20e1_dp*t6*t526 + t529 = 0.40e1_dp*t508*t17 - 0.80e1_dp*t11*t169 + 0.40e1_dp*t6*t514 & + - 0.20e1_dp*t6*t526 t530 = t60*t529 t533 = pi**2 t534 = t533*t100 @@ -584,17 +584,17 @@ SUBROUTINE xb88_lr_lda_calc(rho, norm_drho, & t575 = t574*t533 t576 = t2*t501 t580 = t39*t529 - t586 = -0.2250000000e2_dp*t451*t562*t46+0.8999999998e1_dp*t185 & - *t566*t46+0.8099999996e2_dp*t575*t576*t46-0.5555555558e-1_dp & - *t580*t52-0.5000000001e0_dp*t41*t529*t46 - t590 = -0.2700000000e2_dp*t537*t539*my_rho*t501*t103+0.4500000000e1_dp & - *t177*t271*t1*t501-0.3000000000e1_dp*t177*t105* & - t1*t529-0.8333333335e-1_dp*t289*t118*t501+0.3333333334e0_dp & - *t117*t435*t172+0.1666666667e0_dp*t117*t118*t529+0.3333333334e0_dp & + t586 = -0.2250000000e2_dp*t451*t562*t46 + 0.8999999998e1_dp*t185 & + *t566*t46 + 0.8099999996e2_dp*t575*t576*t46 - 0.5555555558e-1_dp & + *t580*t52 - 0.5000000001e0_dp*t41*t529*t46 + t590 = -0.2700000000e2_dp*t537*t539*my_rho*t501*t103 + 0.4500000000e1_dp & + *t177*t271*t1*t501 - 0.3000000000e1_dp*t177*t105* & + t1*t529 - 0.8333333335e-1_dp*t289*t118*t501 + 0.3333333334e0_dp & + *t117*t435*t172 + 0.1666666667e0_dp*t117*t118*t529 + 0.3333333334e0_dp & *t36*t38*t586 - e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii)+(-0.1666666668e0_dp*t211*t502-0.6666666672e0_dp*t68*t505 & - -0.3333333336e0_dp*t68*t530-0.2222222224e0_dp*t24*t98*t590) & + e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii) + (-0.1666666668e0_dp*t211*t502 - 0.6666666672e0_dp*t68*t505 & + - 0.3333333336e0_dp*t68*t530 - 0.2222222224e0_dp*t24*t98*t590) & *sx END IF @@ -612,13 +612,13 @@ SUBROUTINE xb88_lr_lda_calc(rho, norm_drho, & t657 = t219**2 t667 = t84**2 t669 = 0.1e1_dp/t85/t667 - t677 = -0.9125925923e2_dp*t6*t624*t17-0.5866666667e2_dp*t6*t628 & - *t90-0.3200000001e2_dp*t6*t632*t232+0.1600000000e2_dp*t6 & - *t225*t254-0.120e2_dp*t6*t641*t232*t90+0.120e2_dp*t382 & - *t383*t254-0.20e1_dp*t6*t77*(-0.6222222223e2_dp*t11/t1/ & - t219*t12-0.2115555556e3_dp*t6*t624*t86+0.1315555556e3_dp* & - t245/t1/t657*t250-0.4266666668e2_dp*beta*t244*t5/t657 & - /t69*t669) + t677 = -0.9125925923e2_dp*t6*t624*t17 - 0.5866666667e2_dp*t6*t628 & + *t90 - 0.3200000001e2_dp*t6*t632*t232 + 0.1600000000e2_dp*t6 & + *t225*t254 - 0.120e2_dp*t6*t641*t232*t90 + 0.120e2_dp*t382 & + *t383*t254 - 0.20e1_dp*t6*t77*(-0.6222222223e2_dp*t11/t1/ & + t219*t12 - 0.2115555556e3_dp*t6*t624*t86 + 0.1315555556e3_dp* & + t245/t1/t657*t250 - 0.4266666668e2_dp*beta*t244*t5/t657 & + /t69*t669) t687 = t28*t539 t716 = t264**2 t722 = omega*t270*t27 @@ -626,202 +626,202 @@ SUBROUTINE xb88_lr_lda_calc(rho, norm_drho, & t739 = t3*t151 t746 = t37*t354 t769 = t40*t573 - t791 = 0.5400000000e2_dp*t769*t43*t606-0.3600000000e2_dp*t313* & - t132*t212-0.5400000000e2_dp*t451*t452*t258-0.6000000000e1_dp & - *t128*t323*t94+0.1800000000e2_dp*t128*t132*t258+0.8999999998e1_dp & - *t128*t43*t677-0.2666666667e1_dp*t42*pi*t79 + t791 = 0.5400000000e2_dp*t769*t43*t606 - 0.3600000000e2_dp*t313* & + t132*t212 - 0.5400000000e2_dp*t451*t452*t258 - 0.6000000000e1_dp & + *t128*t323*t94 + 0.1800000000e2_dp*t128*t132*t258 + 0.8999999998e1_dp & + *t128*t43*t677 - 0.2666666667e1_dp*t42*pi*t79 t793 = t328*t135 - t838 = REAL(3*t326*t135*t46, KIND=dp)+REAL(t791*t46, KIND=dp)+REAL(t793* & - t46, KIND=dp)-0.5555555558e-1_dp*t39*t677*t52+0.1111111112e0_dp*t330 & - *t143-0.1666666668e0_dp*t330*t48*t148-0.1851851853e0_dp*t137 & - *t339+0.2222222223e0_dp*t335*t343-0.1666666668e0_dp*t335* & - t347-0.1666666668e0_dp*t335*t351+0.1646090535e0_dp*t47*t48 & - *t71*t51-0.1851851853e0_dp*REAL(t146, KIND=dp)*REAL(t10, KIND=dp)*REAL(t135, KIND=dp) & - *REAL(t46, KIND=dp)+0.1111111112e0_dp*REAL(t146, KIND=dp)*REAL(t141, KIND=dp)*REAL(t326, KIND=dp) & - *REAL(t46, KIND=dp)+0.1111111112e0_dp*REAL(t146, KIND=dp)*REAL(t141, KIND=dp)*REAL(t328, KIND=dp) & - *REAL(t46, KIND=dp)-0.5555555558e-1_dp*REAL(t146, KIND=dp)*REAL(t49, KIND=dp)*REAL(t791, KIND=dp) & - *REAL(t46, KIND=dp)-0.1666666668e0_dp*REAL(t146, KIND=dp)*REAL(t346, KIND=dp)*REAL(t136, KIND=dp) & - -0.5555555558e-1_dp*REAL(t146, KIND=dp)*REAL(t49, KIND=dp)*REAL(t793, KIND=dp)* & + t838 = REAL(3*t326*t135*t46, KIND=dp) + REAL(t791*t46, KIND=dp) + REAL(t793* & + t46, KIND=dp) - 0.5555555558e-1_dp*t39*t677*t52 + 0.1111111112e0_dp*t330 & + *t143 - 0.1666666668e0_dp*t330*t48*t148 - 0.1851851853e0_dp*t137 & + *t339 + 0.2222222223e0_dp*t335*t343 - 0.1666666668e0_dp*t335* & + t347 - 0.1666666668e0_dp*t335*t351 + 0.1646090535e0_dp*t47*t48 & + *t71*t51 - 0.1851851853e0_dp*REAL(t146, KIND=dp)*REAL(t10, KIND=dp)*REAL(t135, KIND=dp) & + *REAL(t46, KIND=dp) + 0.1111111112e0_dp*REAL(t146, KIND=dp)*REAL(t141, KIND=dp)*REAL(t326, KIND=dp) & + *REAL(t46, KIND=dp) + 0.1111111112e0_dp*REAL(t146, KIND=dp)*REAL(t141, KIND=dp)*REAL(t328, KIND=dp) & + *REAL(t46, KIND=dp) - 0.5555555558e-1_dp*REAL(t146, KIND=dp)*REAL(t49, KIND=dp)*REAL(t791, KIND=dp) & + *REAL(t46, KIND=dp) - 0.1666666668e0_dp*REAL(t146, KIND=dp)*REAL(t346, KIND=dp)*REAL(t136, KIND=dp) & + - 0.5555555558e-1_dp*REAL(t146, KIND=dp)*REAL(t49, KIND=dp)*REAL(t793, KIND=dp)* & REAL(t46, KIND=dp) - t842 = 0.2e1_dp*t101*(-t316+t319+0.9000000000e1_dp*t321+t325) & - *t103*t112+0.2e1_dp*t101*t103*(-0.5625000000e1_dp*t687*t31 & - *t606+0.2250000000e1_dp*t271*t109*t212+0.6750000000e1_dp* & - t417*t418*t258+0.1000000000e1_dp*t105*t281*t94-0.1500000000e1_dp & - *t105*t109*t258-0.1500000000e1_dp*t105*t31*t677 & - +0.1111111111e1_dp*t30*t26*t10)+0.4e1_dp*t101*t265*t284+ & - 0.2e1_dp*t101*t716*t103*t112+0.1250000000e0_dp*t722*t118 & - *t606+0.8333333333e-1_dp*t289*t293*t212-0.2500000000e0_dp*t289 & - *t297*t212-0.2500000000e0_dp*t289*t118*t613+0.2222222222e0_dp & - *t117*t735*t94-0.3333333333e0_dp*t117*t739*t94- & - 0.1666666667e0_dp*t117*t293*t258+0.5000000001e0_dp*t117*t746 & - *t94+0.5000000001e0_dp*t117*t297*t258+0.1666666667e0_dp*t117 & - *t118*t677-0.3456790122e0_dp*t36*t27*t237*t55+0.4444444444e0_dp & - *t36*t304*t151-0.3333333333e0_dp*t36*t122*t354 & - +0.3333333334e0_dp*t36*t38*t838 - t846 = -0.5000000004e0_dp*t116*t213-0.2000000001e1_dp*t36*t216 & - -0.1000000001e1_dp*t36*t259-0.6666666672e0_dp*t64*t601+0.8333333340e-1_dp & - *t605*t60*t606-0.5000000004e0_dp*t211*t207*t212 & - -0.5000000004e0_dp*t211*t60*t613-0.1000000001e1_dp*t68* & - t601*t94-0.1000000001e1_dp*t68*t207*t258-0.3333333336e0_dp* & - t68*t60*t677-0.2222222224e0_dp*t24*t98*t842 - - e_rho_rho_rho(ii) = e_rho_rho_rho(ii)+t846*sx + t842 = 0.2e1_dp*t101*(-t316 + t319 + 0.9000000000e1_dp*t321 + t325) & + *t103*t112 + 0.2e1_dp*t101*t103*(-0.5625000000e1_dp*t687*t31 & + *t606 + 0.2250000000e1_dp*t271*t109*t212 + 0.6750000000e1_dp* & + t417*t418*t258 + 0.1000000000e1_dp*t105*t281*t94 - 0.1500000000e1_dp & + *t105*t109*t258 - 0.1500000000e1_dp*t105*t31*t677 & + + 0.1111111111e1_dp*t30*t26*t10) + 0.4e1_dp*t101*t265*t284 + & + 0.2e1_dp*t101*t716*t103*t112 + 0.1250000000e0_dp*t722*t118 & + *t606 + 0.8333333333e-1_dp*t289*t293*t212 - 0.2500000000e0_dp*t289 & + *t297*t212 - 0.2500000000e0_dp*t289*t118*t613 + 0.2222222222e0_dp & + *t117*t735*t94 - 0.3333333333e0_dp*t117*t739*t94 - & + 0.1666666667e0_dp*t117*t293*t258 + 0.5000000001e0_dp*t117*t746 & + *t94 + 0.5000000001e0_dp*t117*t297*t258 + 0.1666666667e0_dp*t117 & + *t118*t677 - 0.3456790122e0_dp*t36*t27*t237*t55 + 0.4444444444e0_dp & + *t36*t304*t151 - 0.3333333333e0_dp*t36*t122*t354 & + + 0.3333333334e0_dp*t36*t38*t838 + t846 = -0.5000000004e0_dp*t116*t213 - 0.2000000001e1_dp*t36*t216 & + - 0.1000000001e1_dp*t36*t259 - 0.6666666672e0_dp*t64*t601 + 0.8333333340e-1_dp & + *t605*t60*t606 - 0.5000000004e0_dp*t211*t207*t212 & + - 0.5000000004e0_dp*t211*t60*t613 - 0.1000000001e1_dp*t68* & + t601*t94 - 0.1000000001e1_dp*t68*t207*t258 - 0.3333333336e0_dp* & + t68*t60*t677 - 0.2222222224e0_dp*t24*t98*t842 + + e_rho_rho_rho(ii) = e_rho_rho_rho(ii) + t846*sx t857 = t27*t496 t860 = t212*t172 t867 = t94*t404 t880 = t258*t172 - t933 = 0.3911111110e2_dp*t11*t222-0.1955555555e2_dp*t6*t628*t168 & - +0.2133333334e2_dp*t11*t226-0.2133333334e2_dp*t6*t71*t384 & - +0.1066666667e2_dp*t6*t225*t400+0.80e1_dp*t11*t233-0.120e2_dp & - *t382*t640*t232*t168+0.80e1_dp*t382*t383*t400-0.40e1_dp & - *t11*t255+0.40e1_dp*t382*t230*t254*t168-0.20e1_dp* & - t6*t77*(0.1866666667e2_dp*beta*t237*t12+0.9866666667e2_dp* & - t11*t241-0.8266666668e2_dp*t393*t251+0.3200000001e2_dp*beta & + t933 = 0.3911111110e2_dp*t11*t222 - 0.1955555555e2_dp*t6*t628*t168 & + + 0.2133333334e2_dp*t11*t226 - 0.2133333334e2_dp*t6*t71*t384 & + + 0.1066666667e2_dp*t6*t225*t400 + 0.80e1_dp*t11*t233 - 0.120e2_dp & + *t382*t640*t232*t168 + 0.80e1_dp*t382*t383*t400 - 0.40e1_dp & + *t11*t255 + 0.40e1_dp*t382*t230*t254*t168 - 0.20e1_dp* & + t6*t77*(0.1866666667e2_dp*beta*t237*t12 + 0.9866666667e2_dp* & + t11*t241 - 0.8266666668e2_dp*t393*t251 + 0.3200000001e2_dp*beta & *t244*my_ndrho/t657/t7*t669) t961 = t687*t26 t1002 = t3*t196 - t1009 = 0.2e1_dp*t101*(-t455+0.9000000000e1_dp*t457+0.6000000000e1_dp & - *t460)*t103*t112+0.1800000000e2_dp*t412*t264*t40*t127 & - *t8*t172*t103*t112+0.2e1_dp*t101*t265*t428+0.1800000000e2_dp & - *t413*t186*t285+0.2e1_dp*t101*t103*(-0.5625000000e1_dp & - *t961*t1*t212*t172+0.4500000000e1_dp*t417*t418*t404 & - +0.1500000000e1_dp*t417*t49*t94*t172-0.1000000000e1_dp* & - t105*t109*t404+0.2250000000e1_dp*t417*t1*t258*t172-0.1500000000e1_dp & - *t105*t31*t933+0.3333333334e0_dp*t105*t281* & - t172)+0.1250000000e0_dp*t722*t118*t860-0.8333333335e-1_dp*t289 & - *t435*t212-0.1666666667e0_dp*t289*t118*t867+0.5555555555e-1_dp & - *t289*t293*t368-0.1111111111e0_dp*t117*t1002*t94 & - -0.1111111111e0_dp*t117*t293*t404 + t1009 = 0.2e1_dp*t101*(-t455 + 0.9000000000e1_dp*t457 + 0.6000000000e1_dp & + *t460)*t103*t112 + 0.1800000000e2_dp*t412*t264*t40*t127 & + *t8*t172*t103*t112 + 0.2e1_dp*t101*t265*t428 + 0.1800000000e2_dp & + *t413*t186*t285 + 0.2e1_dp*t101*t103*(-0.5625000000e1_dp & + *t961*t1*t212*t172 + 0.4500000000e1_dp*t417*t418*t404 & + + 0.1500000000e1_dp*t417*t49*t94*t172 - 0.1000000000e1_dp* & + t105*t109*t404 + 0.2250000000e1_dp*t417*t1*t258*t172 - 0.1500000000e1_dp & + *t105*t31*t933 + 0.3333333334e0_dp*t105*t281* & + t172) + 0.1250000000e0_dp*t722*t118*t860 - 0.8333333335e-1_dp*t289 & + *t435*t212 - 0.1666666667e0_dp*t289*t118*t867 + 0.5555555555e-1_dp & + *t289*t293*t368 - 0.1111111111e0_dp*t117*t1002*t94 & + - 0.1111111111e0_dp*t117*t293*t404 t1013 = t37*t492 t1044 = t769*pi - t1069 = 0.5400000000e2_dp*t1044*t8*t212*t172-0.3600000000e2_dp & - *t451*t452*t404-0.2400000000e2_dp*t451*t37*t94*t172+ & - 0.1200000000e2_dp*t128*t132*t404-0.1800000000e2_dp*t451*t8* & - t258*t172+0.8999999998e1_dp*t128*t43*t933-0.2000000000e1_dp & + t1069 = 0.5400000000e2_dp*t1044*t8*t212*t172 - 0.3600000000e2_dp & + *t451*t452*t404 - 0.2400000000e2_dp*t451*t37*t94*t172 + & + 0.1200000000e2_dp*t128*t132*t404 - 0.1800000000e2_dp*t451*t8* & + t258*t172 + 0.8999999998e1_dp*t128*t43*t933 - 0.2000000000e1_dp & *t128*t323*t172 t1091 = t127*t172*t46 - t1102 = t1069*t46+0.8999999998e1_dp*t326*t40*t127*t467+REAL(2 & - *t136*t462, KIND=dp)+0.8999999998e1_dp*t328*t40*t127*t467- & - 0.5555555558e-1_dp*t39*t933*t52-0.5000000001e0_dp*t258*t127 & - *t466+0.7407407410e-1_dp*t470*t143+0.6666666668e0_dp*t94*t478 & - *t1091-0.1111111112e0_dp*t470*t48*t148-0.1111111112e0_dp & - *t335*t486-0.1000000001e1_dp*t94*t135*t1091 - t1136 = -0.6172839508e-1_dp*t190*t339-0.5555555556e0_dp*t41/t7 & - *t466+0.7407407410e-1_dp*t482*t343+0.7407407410e-1_dp*t146* & - t141*t462*t46+0.6666666668e0_dp*t479*t135*t172*t46-0.5555555558e-1_dp & - *t482*t347-0.5555555558e-1_dp*t146*t49*t1069 & - *t46-0.5000000001e0_dp*t41*t326*t466-0.5555555558e-1_dp*t482 & - *t351-0.1111111112e0_dp*t146*t147*t463-0.5000000001e0_dp* & + t1102 = t1069*t46 + 0.8999999998e1_dp*t326*t40*t127*t467 + REAL(2 & + *t136*t462, KIND=dp) + 0.8999999998e1_dp*t328*t40*t127*t467 - & + 0.5555555558e-1_dp*t39*t933*t52 - 0.5000000001e0_dp*t258*t127 & + *t466 + 0.7407407410e-1_dp*t470*t143 + 0.6666666668e0_dp*t94*t478 & + *t1091 - 0.1111111112e0_dp*t470*t48*t148 - 0.1111111112e0_dp & + *t335*t486 - 0.1000000001e1_dp*t94*t135*t1091 + t1136 = -0.6172839508e-1_dp*t190*t339 - 0.5555555556e0_dp*t41/t7 & + *t466 + 0.7407407410e-1_dp*t482*t343 + 0.7407407410e-1_dp*t146* & + t141*t462*t46 + 0.6666666668e0_dp*t479*t135*t172*t46 - 0.5555555558e-1_dp & + *t482*t347 - 0.5555555558e-1_dp*t146*t49*t1069 & + *t46 - 0.5000000001e0_dp*t41*t326*t466 - 0.5555555558e-1_dp*t482 & + *t351 - 0.1111111112e0_dp*t146*t147*t463 - 0.5000000001e0_dp* & t41*t328*t466 - t1141 = -0.1666666667e0_dp*t289*t297*t368+0.3333333334e0_dp*t117 & - *t1013*t94+0.3333333334e0_dp*t117*t297*t404-0.8333333335e-1_dp & - *t289*t118*t880+0.1666666667e0_dp*t117*t435*t258+ & - 0.1666666667e0_dp*t117*t118*t933+0.7407407405e-1_dp*t117*t735 & - *t172+0.1481481481e0_dp*t36*t304*t196-0.1111111111e0_dp* & - t117*t739*t172-0.2222222222e0_dp*t36*t122*t492+0.1666666667e0_dp & - *t117*t746*t172+0.3333333334e0_dp*t36*t38*(t1102 & - +t1136) - t1146 = -0.3333333336e0_dp*t117*t59*t94*t172-0.6666666672e0_dp & - *t36*t372-0.6666666672e0_dp*t36*t405-0.6666666672e0_dp*t36 & - *t408-0.4444444448e0_dp*t64*t857+0.8333333340e-1_dp*t605*t60 & - *t860-0.1666666668e0_dp*t211*t365*t212-0.3333333336e0_dp* & - t211*t60*t867-0.3333333336e0_dp*t211*t207*t368-0.6666666672e0_dp & - *t68*t857*t94-0.6666666672e0_dp*t68*t207*t404-0.1666666668e0_dp & - *t211*t60*t880-0.3333333336e0_dp*t68*t365* & - t258-0.3333333336e0_dp*t68*t60*t933-0.3333333336e0_dp*t68* & - t601*t172-0.2222222224e0_dp*t24*t98*(t1009+t1141) - - e_ndrho_rho_rho(ii) = e_ndrho_rho_rho(ii)+t1146*sx + t1141 = -0.1666666667e0_dp*t289*t297*t368 + 0.3333333334e0_dp*t117 & + *t1013*t94 + 0.3333333334e0_dp*t117*t297*t404 - 0.8333333335e-1_dp & + *t289*t118*t880 + 0.1666666667e0_dp*t117*t435*t258 + & + 0.1666666667e0_dp*t117*t118*t933 + 0.7407407405e-1_dp*t117*t735 & + *t172 + 0.1481481481e0_dp*t36*t304*t196 - 0.1111111111e0_dp* & + t117*t739*t172 - 0.2222222222e0_dp*t36*t122*t492 + 0.1666666667e0_dp & + *t117*t746*t172 + 0.3333333334e0_dp*t36*t38*(t1102 & + + t1136) + t1146 = -0.3333333336e0_dp*t117*t59*t94*t172 - 0.6666666672e0_dp & + *t36*t372 - 0.6666666672e0_dp*t36*t405 - 0.6666666672e0_dp*t36 & + *t408 - 0.4444444448e0_dp*t64*t857 + 0.8333333340e-1_dp*t605*t60 & + *t860 - 0.1666666668e0_dp*t211*t365*t212 - 0.3333333336e0_dp* & + t211*t60*t867 - 0.3333333336e0_dp*t211*t207*t368 - 0.6666666672e0_dp & + *t68*t857*t94 - 0.6666666672e0_dp*t68*t207*t404 - 0.1666666668e0_dp & + *t211*t60*t880 - 0.3333333336e0_dp*t68*t365* & + t258 - 0.3333333336e0_dp*t68*t60*t933 - 0.3333333336e0_dp*t68* & + t601*t172 - 0.2222222224e0_dp*t24*t98*(t1009 + t1141) + + e_ndrho_rho_rho(ii) = e_ndrho_rho_rho(ii) + t1146*sx t1153 = t27*t590 t1156 = t94*t501 t1163 = t404*t172 t1167 = t94*t529 t1177 = beta*t71 - t1220 = -0.1066666667e2_dp*t1177*t17+0.2133333334e2_dp*t11*t377 & - -0.1066666667e2_dp*t6*t632*t513+0.5333333333e1_dp*t6*t225 & - *t525-0.40e1_dp*t508*t76*t90+0.160e2_dp*t11*t10*t384- & - 0.80e1_dp*t11*t401-0.120e2_dp*t382*t640*t90*t513+0.80e1_dp & - *t382*t230*t400*t168+0.40e1_dp*t382*t383*t525-0.20e1_dp & - *t6*t77*(-0.3200000000e2_dp*t1177*t86+0.4800000000e2_dp*t6 & - *t397-0.2400000000e2_dp*t245/t657/my_rho*t669) + t1220 = -0.1066666667e2_dp*t1177*t17 + 0.2133333334e2_dp*t11*t377 & + - 0.1066666667e2_dp*t6*t632*t513 + 0.5333333333e1_dp*t6*t225 & + *t525 - 0.40e1_dp*t508*t76*t90 + 0.160e2_dp*t11*t10*t384 - & + 0.80e1_dp*t11*t401 - 0.120e2_dp*t382*t640*t90*t513 + 0.80e1_dp & + *t382*t230*t400*t168 + 0.40e1_dp*t382*t383*t525 - 0.20e1_dp & + *t6*t77*(-0.3200000000e2_dp*t1177*t86 + 0.4800000000e2_dp*t6 & + *t397 - 0.2400000000e2_dp*t245/t657/my_rho*t669) t1284 = t37*t586 - t1334 = 0.5400000000e2_dp*t1044*t452*t501-0.3600000000e2_dp*t451 & - *t8*t404*t172-0.1800000000e2_dp*t451*t452*t529+0.8999999998e1_dp & - *t128*t43*t1220-0.1200000000e2_dp*t313*t132*t501 & - +0.5999999999e1_dp*t128*t132*t529 + t1334 = 0.5400000000e2_dp*t1044*t452*t501 - 0.3600000000e2_dp*t451 & + *t8*t404*t172 - 0.1800000000e2_dp*t451*t452*t529 + 0.8999999998e1_dp & + *t128*t43*t1220 - 0.1200000000e2_dp*t313*t132*t501 & + + 0.5999999999e1_dp*t128*t132*t529 t1341 = t501*t46 t1345 = t529*t46 t1370 = t40*pi - t1396 = t1334*t46+0.1800000000e2_dp*t462*t40*t127*t467-0.2250000000e2_dp & - *t464*t312*t43*t1341+0.8999999998e1_dp*t465 & - *t43*t1345-0.1000000000e1_dp*t404*t127*t466+0.8099999996e2_dp & - *t135*t571*t573*t533*t2*t1341-0.5555555558e-1_dp*t39 & - *t1220*t52-0.5000000001e0_dp*t473*t1345+0.3333333334e0_dp* & - t479*t1345+0.1000000000e1_dp*t94*t312*t1341-0.4500000000e1_dp & - *t94*t573*t501*t1370*t8*t46+0.3703703705e-1_dp*t580 & - *t143+0.3000000000e1_dp*t312*t37*t501*t1370*t46-0.5555555558e-1_dp & - *t580*t48*t148-0.1111111112e0_dp*t482*t486-0.5555555558e-1_dp & - *t146*t49*t1334*t46-0.1000000000e1_dp*t41* & - t462*t466-0.5000000001e0_dp*t489*t1345 - t1400 = -0.3600000000e2_dp*t412*t313*t562*t113+0.1800000000e2_dp & - *t413*t566*t113+0.3600000000e2_dp*t413*t186*t429+0.1620000000e3_dp & - *t26*t533*t100*t574*t576*t113+0.2e1_dp*t101 & - *t103*(-0.5625000000e1_dp*t961*t418*t501+0.4500000000e1_dp & - *t417*t1*t404*t172+0.2250000000e1_dp*t417*t418*t529- & - 0.1500000000e1_dp*t105*t31*t1220+0.7500000000e0_dp*t271*t109 & - *t501-0.5000000000e0_dp*t105*t109*t529)+0.1250000000e0_dp* & - t722*t118*t1156-0.1666666667e0_dp*t289*t435*t368-0.1666666667e0_dp & - *t289*t118*t1163-0.8333333335e-1_dp*t289*t118*t1167 & - +0.1666666667e0_dp*t117*t1284*t94+0.3333333334e0_dp*t117 & - *t435*t404+0.1666666667e0_dp*t117*t118*t1220+0.2777777778e-1_dp & - *t289*t293*t501-0.1111111111e0_dp*t117*t1002*t172 & - -0.5555555555e-1_dp*t117*t293*t529-0.1111111111e0_dp*t36*t122 & - *t586-0.8333333335e-1_dp*t289*t297*t501+0.3333333334e0_dp & - *t117*t1013*t172+0.1666666667e0_dp*t117*t297*t529+0.3333333334e0_dp & + t1396 = t1334*t46 + 0.1800000000e2_dp*t462*t40*t127*t467 - 0.2250000000e2_dp & + *t464*t312*t43*t1341 + 0.8999999998e1_dp*t465 & + *t43*t1345 - 0.1000000000e1_dp*t404*t127*t466 + 0.8099999996e2_dp & + *t135*t571*t573*t533*t2*t1341 - 0.5555555558e-1_dp*t39 & + *t1220*t52 - 0.5000000001e0_dp*t473*t1345 + 0.3333333334e0_dp* & + t479*t1345 + 0.1000000000e1_dp*t94*t312*t1341 - 0.4500000000e1_dp & + *t94*t573*t501*t1370*t8*t46 + 0.3703703705e-1_dp*t580 & + *t143 + 0.3000000000e1_dp*t312*t37*t501*t1370*t46 - 0.5555555558e-1_dp & + *t580*t48*t148 - 0.1111111112e0_dp*t482*t486 - 0.5555555558e-1_dp & + *t146*t49*t1334*t46 - 0.1000000000e1_dp*t41* & + t462*t466 - 0.5000000001e0_dp*t489*t1345 + t1400 = -0.3600000000e2_dp*t412*t313*t562*t113 + 0.1800000000e2_dp & + *t413*t566*t113 + 0.3600000000e2_dp*t413*t186*t429 + 0.1620000000e3_dp & + *t26*t533*t100*t574*t576*t113 + 0.2e1_dp*t101 & + *t103*(-0.5625000000e1_dp*t961*t418*t501 + 0.4500000000e1_dp & + *t417*t1*t404*t172 + 0.2250000000e1_dp*t417*t418*t529 - & + 0.1500000000e1_dp*t105*t31*t1220 + 0.7500000000e0_dp*t271*t109 & + *t501 - 0.5000000000e0_dp*t105*t109*t529) + 0.1250000000e0_dp* & + t722*t118*t1156 - 0.1666666667e0_dp*t289*t435*t368 - 0.1666666667e0_dp & + *t289*t118*t1163 - 0.8333333335e-1_dp*t289*t118*t1167 & + + 0.1666666667e0_dp*t117*t1284*t94 + 0.3333333334e0_dp*t117 & + *t435*t404 + 0.1666666667e0_dp*t117*t118*t1220 + 0.2777777778e-1_dp & + *t289*t293*t501 - 0.1111111111e0_dp*t117*t1002*t172 & + - 0.5555555555e-1_dp*t117*t293*t529 - 0.1111111111e0_dp*t36*t122 & + *t586 - 0.8333333335e-1_dp*t289*t297*t501 + 0.3333333334e0_dp & + *t117*t1013*t172 + 0.1666666667e0_dp*t117*t297*t529 + 0.3333333334e0_dp & *t36*t38*t1396 - t1404 = -0.1666666668e0_dp*t116*t502-0.6666666672e0_dp*t36*t505 & - -0.3333333336e0_dp*t36*t530-0.2222222224e0_dp*t64*t1153+0.8333333340e-1_dp & - *t605*t60*t1156-0.3333333336e0_dp*t211*t365 & - *t368-0.3333333336e0_dp*t211*t60*t1163-0.1666666668e0_dp*t211 & - *t60*t1167-0.3333333336e0_dp*t68*t1153*t94-0.6666666672e0_dp & - *t68*t365*t404-0.3333333336e0_dp*t68*t60*t1220-0.1666666668e0_dp & - *t211*t207*t501-0.6666666672e0_dp*t68*t857* & - t172-0.3333333336e0_dp*t68*t207*t529-0.2222222224e0_dp*t24* & + t1404 = -0.1666666668e0_dp*t116*t502 - 0.6666666672e0_dp*t36*t505 & + - 0.3333333336e0_dp*t36*t530 - 0.2222222224e0_dp*t64*t1153 + 0.8333333340e-1_dp & + *t605*t60*t1156 - 0.3333333336e0_dp*t211*t365 & + *t368 - 0.3333333336e0_dp*t211*t60*t1163 - 0.1666666668e0_dp*t211 & + *t60*t1167 - 0.3333333336e0_dp*t68*t1153*t94 - 0.6666666672e0_dp & + *t68*t365*t404 - 0.3333333336e0_dp*t68*t60*t1220 - 0.1666666668e0_dp & + *t211*t207*t501 - 0.6666666672e0_dp*t68*t857* & + t172 - 0.3333333336e0_dp*t68*t207*t529 - 0.2222222224e0_dp*t24* & t98*t1400 - e_ndrho_ndrho_rho(ii) = e_ndrho_ndrho_rho(ii)+t1404*sx + e_ndrho_ndrho_rho(ii) = e_ndrho_ndrho_rho(ii) + t1404*sx t1405 = t501*t172 t1412 = t172*t529 - t1449 = -0.120e2_dp*t508*t76*t168+0.240e2_dp*t11*t514-0.120e2_dp & - *t11*t526-0.120e2_dp*t6*t641*t513*t168+0.120e2_dp*t382 & - *t230*t168*t525-0.20e1_dp*t6*t77*(-0.240e2_dp*beta*t521 & - *t250*my_ndrho+0.180e2_dp*t393/t657*t669) + t1449 = -0.120e2_dp*t508*t76*t168 + 0.240e2_dp*t11*t514 - 0.120e2_dp & + *t11*t526 - 0.120e2_dp*t6*t641*t513*t168 + 0.120e2_dp*t382 & + *t230*t168*t525 - 0.20e1_dp*t6*t77*(-0.240e2_dp*beta*t521 & + *t250*my_ndrho + 0.180e2_dp*t393/t657*t669) t1456 = t1405*t103 t1467 = t533*pi t1472 = t572*t21 - t1553 = 0.1350000000e3_dp*t537/t22/t572*my_rho*t1456-0.8100000000e2_dp & - *t534*t536*t539*my_rho*t172*t103*t529-0.2430000000e3_dp & - *t1467*t100/t570/omega/t22/t1472*t140*t1456- & - 0.1125000000e2_dp*t177*t687*t1*t1405+0.1350000000e2_dp*t176 & - *t103*t28*t270*t1*t1412-0.3000000000e1_dp*t177*t105* & - t1*t1449+0.1250000000e0_dp*t722*t118*t1405-0.2500000000e0_dp & - *t289*t435*t501-0.2500000000e0_dp*t289*t118*t1412+0.5000000001e0_dp & - *t117*t1284*t172+0.5000000001e0_dp*t117*t435 & - *t529+0.1666666667e0_dp*t117*t118*t1449+0.3333333334e0_dp*t36 & - *t38*(0.6750000000e2_dp*t1044*t8*t1405*t46-0.6750000000e2_dp & - *t451*t186*t1345-0.5264999998e3_dp*t571/t1472*t533 & - *t2*t1405*t46+0.8999999998e1_dp*t185*t8*t1449*t46+0.2429999999e3_dp & - *t575*t2*t529*t466+0.7289999995e3_dp/t570/t39 & - /t572/t126*t1467*t7*t1405*t46-0.5555555558e-1_dp*t39 & - *t1449*t52-0.5000000001e0_dp*t41*t1449*t46) - - e_ndrho_ndrho_ndrho(ii) = e_ndrho_ndrho_ndrho(ii)+(0.8333333340e-1_dp*t605*t60*t1405- & - 0.5000000004e0_dp*t211*t365*t501-0.5000000004e0_dp*t211*t60*t1412-0.1000000001e1_dp & - *t68*t1153*t172-0.1000000001e1_dp*t68*t365*t529-0.3333333336e0_dp & - *t68*t60*t1449-0.2222222224e0_dp*t24*t98*t1553) & + t1553 = 0.1350000000e3_dp*t537/t22/t572*my_rho*t1456 - 0.8100000000e2_dp & + *t534*t536*t539*my_rho*t172*t103*t529 - 0.2430000000e3_dp & + *t1467*t100/t570/omega/t22/t1472*t140*t1456 - & + 0.1125000000e2_dp*t177*t687*t1*t1405 + 0.1350000000e2_dp*t176 & + *t103*t28*t270*t1*t1412 - 0.3000000000e1_dp*t177*t105* & + t1*t1449 + 0.1250000000e0_dp*t722*t118*t1405 - 0.2500000000e0_dp & + *t289*t435*t501 - 0.2500000000e0_dp*t289*t118*t1412 + 0.5000000001e0_dp & + *t117*t1284*t172 + 0.5000000001e0_dp*t117*t435 & + *t529 + 0.1666666667e0_dp*t117*t118*t1449 + 0.3333333334e0_dp*t36 & + *t38*(0.6750000000e2_dp*t1044*t8*t1405*t46 - 0.6750000000e2_dp & + *t451*t186*t1345 - 0.5264999998e3_dp*t571/t1472*t533 & + *t2*t1405*t46 + 0.8999999998e1_dp*t185*t8*t1449*t46 + 0.2429999999e3_dp & + *t575*t2*t529*t466 + 0.7289999995e3_dp/t570/t39 & + /t572/t126*t1467*t7*t1405*t46 - 0.5555555558e-1_dp*t39 & + *t1449*t52 - 0.5000000001e0_dp*t41*t1449*t46) + + e_ndrho_ndrho_ndrho(ii) = e_ndrho_ndrho_ndrho(ii) + (0.8333333340e-1_dp*t605*t60*t1405 - & + 0.5000000004e0_dp*t211*t365*t501 - 0.5000000004e0_dp*t211*t60*t1412 - 0.1000000001e1_dp & + *t68*t1153*t172 - 0.1000000001e1_dp*t68*t365*t529 - 0.3333333336e0_dp & + *t68*t60*t1449 - 0.2222222224e0_dp*t24*t98*t1553) & *sx END IF @@ -880,7 +880,7 @@ SUBROUTINE xb88_lr_lsd_eval(rho_set, deriv_set, grad_deriv, xb88_lr_params) rhob=rho(2)%array, norm_drhoa=norm_drho(1)%array, & norm_drhob=norm_drho(2)%array, rho_cutoff=epsilon_rho, & local_bounds=bo) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) ! meaningful default for the arrays we don't need: let us make compiler ! and debugger happy... @@ -1089,11 +1089,11 @@ SUBROUTINE xb88_lr_lsd_calc(rho_spin, norm_drho_spin, e_0, & t8 = t1**2 t10 = 0.1e1_dp/t8/t7 t11 = beta*ndrho - t12 = LOG(xx+SQRT(xx**0.2e1_dp+0.1e1_dp)) - t16 = 0.10e1_dp+0.60e1_dp*t11*t3*t12 + t12 = LOG(xx + SQRT(xx**0.2e1_dp + 0.1e1_dp)) + t16 = 0.10e1_dp + 0.60e1_dp*t11*t3*t12 t17 = 0.1e1_dp/t16 t18 = t10*t17 - t21 = 0.20e1_dp*Cx+0.20e1_dp*t6*t18 + t21 = 0.20e1_dp*Cx + 0.20e1_dp*t6*t18 t22 = SQRT(t21) t23 = t22*t21 t24 = rho*t23 @@ -1117,13 +1117,13 @@ SUBROUTINE xb88_lr_lsd_calc(rho_spin, norm_drho_spin, e_0, & t47 = t39*t21 t48 = 0.1e1_dp/pi t49 = 0.1e1_dp/t8 - t51 = t46-0.10e1_dp + t51 = t46 - 0.10e1_dp t52 = t48*t49*t51 - t55 = t46-0.15e1_dp-0.5555555558e-1_dp*t47*t52 - t59 = t26*t34+0.3333333334e0_dp*t36*t38*t55 + t55 = t46 - 0.15e1_dp - 0.5555555558e-1_dp*t47*t52 + t59 = t26*t34 + 0.3333333334e0_dp*t36*t38*t55 t60 = t27*t59 - e_0(ii) = e_0(ii)-0.2222222224e0_dp*t24*omega*t60*sx + e_0(ii) = e_0(ii) - 0.2222222224e0_dp*t24*omega*t60*sx END IF IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN @@ -1136,13 +1136,13 @@ SUBROUTINE xb88_lr_lsd_calc(rho_spin, norm_drho_spin, e_0, & t76 = 0.1e1_dp/t75 t77 = t10*t76 t79 = 0.1e1_dp/t1/t7 - t84 = 1+t5*t10 + t84 = 1 + t5*t10 t85 = SQRT(t84) t86 = 0.1e1_dp/t85 t87 = t71*t86 - t90 = -0.8000000000e1_dp*t11*t79*t12-0.8000000000e1_dp*t6*t87 + t90 = -0.8000000000e1_dp*t11*t79*t12 - 0.8000000000e1_dp*t6*t87 t91 = t77*t90 - t94 = -0.5333333333e1_dp*t6*t72-0.20e1_dp*t6*t91 + t94 = -0.5333333333e1_dp*t6*t72 - 0.20e1_dp*t6*t91 t95 = t60*t94 t98 = omega*t27 t99 = SQRT(0.3141592654e1_dp) @@ -1152,7 +1152,7 @@ SUBROUTINE xb88_lr_lsd_calc(rho_spin, norm_drho_spin, e_0, & t104 = 0.1e1_dp/t23 t105 = t28*t104 t109 = t26*t49 - t112 = -0.1500000000e1_dp*t105*t31*t94+0.1000000000e1_dp*t30* & + t112 = -0.1500000000e1_dp*t105*t31*t94 + 0.1000000000e1_dp*t30* & t109 t113 = t103*t112 t116 = omega*t29 @@ -1165,7 +1165,7 @@ SUBROUTINE xb88_lr_lsd_calc(rho_spin, norm_drho_spin, e_0, & t130 = t128*t43*t94 t132 = pi*t37 t133 = t42*t132 - t135 = 0.8999999998e1_dp*t130-0.5999999999e1_dp*t133 + t135 = 0.8999999998e1_dp*t130 - 0.5999999999e1_dp*t133 t136 = t135*t46 t137 = t39*t94 t140 = t8*rho @@ -1174,31 +1174,31 @@ SUBROUTINE xb88_lr_lsd_calc(rho_spin, norm_drho_spin, e_0, & t146 = t47*t48 t147 = t49*t135 t148 = t147*t46 - t151 = t136-0.5555555558e-1_dp*t137*t52+0.3703703705e-1_dp*t47 & - *t143-0.5555555558e-1_dp*t146*t148 - t155 = REAL(2*t101*t113, KIND=dp)+0.1666666667e0_dp*t117*t118*t94- & - 0.1111111111e0_dp*t36*t122*t55+0.3333333334e0_dp*t36*t38* & + t151 = t136 - 0.5555555558e-1_dp*t137*t52 + 0.3703703705e-1_dp*t47 & + *t143 - 0.5555555558e-1_dp*t146*t148 + t155 = REAL(2*t101*t113, KIND=dp) + 0.1666666667e0_dp*t117*t118*t94 - & + 0.1111111111e0_dp*t36*t122*t55 + 0.3333333334e0_dp*t36*t38* & t151 - e_rho_spin(ii) = e_rho_spin(ii)+(-0.2222222224e0_dp*t64*t60-0.3333333336e0_dp*t68*t95- & - 0.2222222224e0_dp*t24*t98*t155)*sx + e_rho_spin(ii) = e_rho_spin(ii) + (-0.2222222224e0_dp*t64*t60 - 0.3333333336e0_dp*t68*t95 - & + 0.2222222224e0_dp*t24*t98*t155)*sx - t168 = 0.60e1_dp*beta*t3*t12+0.60e1_dp*t11*t10*t86 + t168 = 0.60e1_dp*beta*t3*t12 + 0.60e1_dp*t11*t10*t86 t169 = t77*t168 - t172 = 0.40e1_dp*t11*t18-0.20e1_dp*t6*t169 + t172 = 0.40e1_dp*t11*t18 - 0.20e1_dp*t6*t169 t173 = t60*t172 t176 = pi*t100 t177 = t176*t103 t185 = t128*pi t186 = t8*t172 t190 = t39*t172 - t196 = 0.8999999998e1_dp*t185*t186*t46-0.5555555558e-1_dp*t190 & - *t52-0.5000000001e0_dp*t41*t172*t46 - t200 = -0.3000000000e1_dp*t177*t105*t1*t172+0.1666666667e0_dp* & - t117*t118*t172+0.3333333334e0_dp*t36*t38*t196 + t196 = 0.8999999998e1_dp*t185*t186*t46 - 0.5555555558e-1_dp*t190 & + *t52 - 0.5000000001e0_dp*t41*t172*t46 + t200 = -0.3000000000e1_dp*t177*t105*t1*t172 + 0.1666666667e0_dp* & + t117*t118*t172 + 0.3333333334e0_dp*t36*t38*t196 - e_ndrho_spin(ii) = e_ndrho_spin(ii)+(-0.3333333336e0_dp*t68*t173-0.2222222224e0_dp*t24*t98 & - *t200)*sx + e_ndrho_spin(ii) = e_ndrho_spin(ii) + (-0.3333333336e0_dp*t68*t173 - 0.2222222224e0_dp*t24*t98 & + *t200)*sx END IF IF (grad_deriv >= 2 .OR. grad_deriv == -2) THEN @@ -1222,19 +1222,19 @@ SUBROUTINE xb88_lr_lsd_calc(rho_spin, norm_drho_spin, e_0, & t245 = beta*t244 t250 = 0.1e1_dp/t85/t84 t251 = 0.1e1_dp/t1/t219/t69*t250 - t254 = 0.1866666667e2_dp*t11*t237*t12+0.4000000000e2_dp*t6*t241 & - -0.1066666667e2_dp*t245*t251 + t254 = 0.1866666667e2_dp*t11*t237*t12 + 0.4000000000e2_dp*t6*t241 & + - 0.1066666667e2_dp*t245*t251 t255 = t77*t254 - t258 = 0.1955555555e2_dp*t6*t222+0.1066666667e2_dp*t6*t226+0.40e1_dp & - *t6*t233-0.20e1_dp*t6*t255 + t258 = 0.1955555555e2_dp*t6*t222 + 0.1066666667e2_dp*t6*t226 + 0.40e1_dp & + *t6*t233 - 0.20e1_dp*t6*t255 t259 = t60*t258 - t264 = 0.9000000000e1_dp*t130-0.6000000000e1_dp*t133 + t264 = 0.9000000000e1_dp*t130 - 0.6000000000e1_dp*t133 t265 = t264*t103 t270 = 0.1e1_dp/t22/t126 t271 = t28*t270 t281 = t26*t141 - t284 = 0.2250000000e1_dp*t271*t31*t212-0.1000000000e1_dp*t105* & - t109*t94-0.1500000000e1_dp*t105*t31*t258-0.6666666667e0_dp & + t284 = 0.2250000000e1_dp*t271*t31*t212 - 0.1000000000e1_dp*t105* & + t109*t94 - 0.1500000000e1_dp*t105*t31*t258 - 0.6666666667e0_dp & *t30*t281 t285 = t103*t284 t289 = omega*t104*t27 @@ -1249,7 +1249,7 @@ SUBROUTINE xb88_lr_lsd_calc(rho_spin, norm_drho_spin, e_0, & t321 = t128*t43*t258 t323 = pi*t3 t325 = 0.2000000000e1_dp*t42*t323 - t326 = -t316+t319+0.8999999998e1_dp*t321+t325 + t326 = -t316 + t319 + 0.8999999998e1_dp*t321 + t325 t328 = t135**2 t330 = t39*t258 t335 = t137*t48 @@ -1258,19 +1258,19 @@ SUBROUTINE xb88_lr_lsd_calc(rho_spin, norm_drho_spin, e_0, & t346 = t49*t326 t347 = t346*t46 t351 = t49*t328*t46 - t354 = t326*t46+t328*t46-0.5555555558e-1_dp*t330*t52+0.7407407410e-1_dp & - *t137*t143-0.1111111112e0_dp*t335*t148-0.6172839508e-1_dp & - *t47*t339+0.7407407410e-1_dp*t146*t343-0.5555555558e-1_dp & - *t146*t347-0.5555555558e-1_dp*t146*t351 - t358 = REAL(2*t101*t265*t112, KIND=dp)+REAL(2*t101*t285, KIND=dp)-0.8333333335e-1_dp & - *t289*t118*t212-0.1111111111e0_dp*t117*t293*t94 & - +0.3333333334e0_dp*t117*t297*t94+0.1666666667e0_dp*t117* & - t118*t258+0.1481481481e0_dp*t36*t304*t55-0.2222222222e0_dp* & - t36*t122*t151+0.3333333334e0_dp*t36*t38*t354 - - e_rho_rho_spin(ii) = e_rho_rho_spin(ii)+(-0.6666666672e0_dp*t36*t95-0.4444444448e0_dp*t64*t207- & - 0.1666666668e0_dp*t211*t213-0.6666666672e0_dp*t68*t216-0.3333333336e0_dp & - *t68*t259-0.2222222224e0_dp*t24*t98*t358)*sx + t354 = t326*t46 + t328*t46 - 0.5555555558e-1_dp*t330*t52 + 0.7407407410e-1_dp & + *t137*t143 - 0.1111111112e0_dp*t335*t148 - 0.6172839508e-1_dp & + *t47*t339 + 0.7407407410e-1_dp*t146*t343 - 0.5555555558e-1_dp & + *t146*t347 - 0.5555555558e-1_dp*t146*t351 + t358 = REAL(2*t101*t265*t112, KIND=dp) + REAL(2*t101*t285, KIND=dp) - 0.8333333335e-1_dp & + *t289*t118*t212 - 0.1111111111e0_dp*t117*t293*t94 & + + 0.3333333334e0_dp*t117*t297*t94 + 0.1666666667e0_dp*t117* & + t118*t258 + 0.1481481481e0_dp*t36*t304*t55 - 0.2222222222e0_dp* & + t36*t122*t151 + 0.3333333334e0_dp*t36*t38*t354 + + e_rho_rho_spin(ii) = e_rho_rho_spin(ii) + (-0.6666666672e0_dp*t36*t95 - 0.4444444448e0_dp*t64*t207 - & + 0.1666666668e0_dp*t211*t213 - 0.6666666672e0_dp*t68*t216 - 0.3333333336e0_dp & + *t68*t259 - 0.2222222224e0_dp*t24*t98*t358)*sx t365 = t27*t200 t368 = t94*t172 @@ -1281,19 +1281,19 @@ SUBROUTINE xb88_lr_lsd_calc(rho_spin, norm_drho_spin, e_0, & t384 = t383*t168 t393 = beta*t5*ndrho t397 = 0.1e1_dp/t1/t219/t7*t250 - t400 = -0.8000000000e1_dp*beta*t79*t12-0.2400000000e2_dp*t11* & - t87+0.8000000000e1_dp*t393*t397 + t400 = -0.8000000000e1_dp*beta*t79*t12 - 0.2400000000e2_dp*t11* & + t87 + 0.8000000000e1_dp*t393*t397 t401 = t77*t400 - t404 = -0.1066666667e2_dp*t11*t72+0.5333333333e1_dp*t6*t377-0.40e1_dp & - *t11*t91+0.40e1_dp*t382*t384-0.20e1_dp*t6*t401 + t404 = -0.1066666667e2_dp*t11*t72 + 0.5333333333e1_dp*t6*t377 - 0.40e1_dp & + *t11*t91 + 0.40e1_dp*t382*t384 - 0.20e1_dp*t6*t401 t405 = t60*t404 t408 = t207*t172 t412 = t26*pi*t100 t413 = t412*t128 t417 = t271*t26 t418 = t1*t94 - t428 = 0.2250000000e1_dp*t417*t418*t172-0.1500000000e1_dp*t105 & - *t31*t404-0.5000000000e0_dp*t105*t109*t172 + t428 = 0.2250000000e1_dp*t417*t418*t172 - 0.1500000000e1_dp*t105 & + *t31*t404 - 0.5000000000e0_dp*t105*t109*t172 t429 = t103*t428 t435 = t37*t196 t451 = t313*pi @@ -1301,7 +1301,7 @@ SUBROUTINE xb88_lr_lsd_calc(rho_spin, norm_drho_spin, e_0, & t455 = 0.1800000000e2_dp*t451*t452*t172 t457 = t128*t43*t404 t460 = t128*t132*t172 - t462 = -t455+0.8999999998e1_dp*t457+0.5999999999e1_dp*t460 + t462 = -t455 + 0.8999999998e1_dp*t457 + 0.5999999999e1_dp*t460 t463 = t462*t46 t464 = t135*t40 t465 = t464*t127 @@ -1314,20 +1314,20 @@ SUBROUTINE xb88_lr_lsd_calc(rho_spin, norm_drho_spin, e_0, & t482 = t190*t48 t486 = t49*t462*t46 t489 = t41*t135 - t492 = t463+0.8999999998e1_dp*t465*t467-0.5555555558e-1_dp*t470 & - *t52-0.5000000001e0_dp*t473*t466+0.3703703705e-1_dp*t190*t143 & - +0.3333333334e0_dp*t479*t466-0.5555555558e-1_dp*t482*t148 & - -0.5555555558e-1_dp*t146*t486-0.5000000001e0_dp*t489*t466 - t496 = 0.1800000000e2_dp*t413*t186*t113+REAL(2*t101*t429, KIND=dp) & - -0.8333333335e-1_dp*t289*t118*t368+0.1666666667e0_dp*t117*t435 & - *t94+0.1666666667e0_dp*t117*t118*t404-0.5555555555e-1_dp & - *t117*t293*t172-0.1111111111e0_dp*t36*t122*t196+0.1666666667e0_dp & - *t117*t297*t172+0.3333333334e0_dp*t36*t38*t492 - - e_ndrho_rho_spin(ii) = e_ndrho_rho_spin(ii)+(-0.3333333336e0_dp*t36*t173-0.2222222224e0_dp*t64*t365- & - 0.1666666668e0_dp*t211*t60*t368-0.3333333336e0_dp*t68*t372 & - -0.3333333336e0_dp*t68*t405-0.3333333336e0_dp*t68*t408-0.2222222224e0_dp & - *t24*t98*t496)*sx + t492 = t463 + 0.8999999998e1_dp*t465*t467 - 0.5555555558e-1_dp*t470 & + *t52 - 0.5000000001e0_dp*t473*t466 + 0.3703703705e-1_dp*t190*t143 & + + 0.3333333334e0_dp*t479*t466 - 0.5555555558e-1_dp*t482*t148 & + - 0.5555555558e-1_dp*t146*t486 - 0.5000000001e0_dp*t489*t466 + t496 = 0.1800000000e2_dp*t413*t186*t113 + REAL(2*t101*t429, KIND=dp) & + - 0.8333333335e-1_dp*t289*t118*t368 + 0.1666666667e0_dp*t117*t435 & + *t94 + 0.1666666667e0_dp*t117*t118*t404 - 0.5555555555e-1_dp & + *t117*t293*t172 - 0.1111111111e0_dp*t36*t122*t196 + 0.1666666667e0_dp & + *t117*t297*t172 + 0.3333333334e0_dp*t36*t38*t492 + + e_ndrho_rho_spin(ii) = e_ndrho_rho_spin(ii) + (-0.3333333336e0_dp*t36*t173 - 0.2222222224e0_dp*t64*t365 - & + 0.1666666668e0_dp*t211*t60*t368 - 0.3333333336e0_dp*t68*t372 & + - 0.3333333336e0_dp*t68*t405 - 0.3333333336e0_dp*t68*t408 - 0.2222222224e0_dp & + *t24*t98*t496)*sx t501 = t172**2 t502 = t60*t501 @@ -1337,10 +1337,10 @@ SUBROUTINE xb88_lr_lsd_calc(rho_spin, norm_drho_spin, e_0, & t514 = t231*t513 t519 = t219*rho t521 = 0.1e1_dp/t1/t519 - t525 = 0.120e2_dp*t508*t86-0.60e1_dp*t6*t521*t250 + t525 = 0.120e2_dp*t508*t86 - 0.60e1_dp*t6*t521*t250 t526 = t77*t525 - t529 = 0.40e1_dp*t508*t17-0.80e1_dp*t11*t169+0.40e1_dp*t6*t514 & - -0.20e1_dp*t6*t526 + t529 = 0.40e1_dp*t508*t17 - 0.80e1_dp*t11*t169 + 0.40e1_dp*t6*t514 & + - 0.20e1_dp*t6*t526 t530 = t60*t529 t533 = pi**2 t534 = t533*t100 @@ -1357,17 +1357,17 @@ SUBROUTINE xb88_lr_lsd_calc(rho_spin, norm_drho_spin, e_0, & t575 = t574*t533 t576 = t2*t501 t580 = t39*t529 - t586 = -0.2250000000e2_dp*t451*t562*t46+0.8999999998e1_dp*t185 & - *t566*t46+0.8099999996e2_dp*t575*t576*t46-0.5555555558e-1_dp & - *t580*t52-0.5000000001e0_dp*t41*t529*t46 - t590 = -0.2700000000e2_dp*t537*t539*rho*t501*t103+0.4500000000e1_dp & - *t177*t271*t1*t501-0.3000000000e1_dp*t177*t105* & - t1*t529-0.8333333335e-1_dp*t289*t118*t501+0.3333333334e0_dp & - *t117*t435*t172+0.1666666667e0_dp*t117*t118*t529+0.3333333334e0_dp & + t586 = -0.2250000000e2_dp*t451*t562*t46 + 0.8999999998e1_dp*t185 & + *t566*t46 + 0.8099999996e2_dp*t575*t576*t46 - 0.5555555558e-1_dp & + *t580*t52 - 0.5000000001e0_dp*t41*t529*t46 + t590 = -0.2700000000e2_dp*t537*t539*rho*t501*t103 + 0.4500000000e1_dp & + *t177*t271*t1*t501 - 0.3000000000e1_dp*t177*t105* & + t1*t529 - 0.8333333335e-1_dp*t289*t118*t501 + 0.3333333334e0_dp & + *t117*t435*t172 + 0.1666666667e0_dp*t117*t118*t529 + 0.3333333334e0_dp & *t36*t38*t586 - e_ndrho_ndrho_spin(ii) = e_ndrho_ndrho_spin(ii)+(-0.1666666668e0_dp*t211*t502-0.6666666672e0_dp*t68*t505 & - -0.3333333336e0_dp*t68*t530-0.2222222224e0_dp*t24*t98*t590) & + e_ndrho_ndrho_spin(ii) = e_ndrho_ndrho_spin(ii) + (-0.1666666668e0_dp*t211*t502 - 0.6666666672e0_dp*t68*t505 & + - 0.3333333336e0_dp*t68*t530 - 0.2222222224e0_dp*t24*t98*t590) & *sx END IF @@ -1385,13 +1385,13 @@ SUBROUTINE xb88_lr_lsd_calc(rho_spin, norm_drho_spin, e_0, & t657 = t219**2 t667 = t84**2 t669 = 0.1e1_dp/t85/t667 - t677 = -0.9125925923e2_dp*t6*t624*t17-0.5866666667e2_dp*t6*t628 & - *t90-0.3200000001e2_dp*t6*t632*t232+0.1600000000e2_dp*t6 & - *t225*t254-0.120e2_dp*t6*t641*t232*t90+0.120e2_dp*t382 & - *t383*t254-0.20e1_dp*t6*t77*(-0.6222222223e2_dp*t11/t1/ & - t219*t12-0.2115555556e3_dp*t6*t624*t86+0.1315555556e3_dp* & - t245/t1/t657*t250-0.4266666668e2_dp*beta*t244*t5/t657 & - /t69*t669) + t677 = -0.9125925923e2_dp*t6*t624*t17 - 0.5866666667e2_dp*t6*t628 & + *t90 - 0.3200000001e2_dp*t6*t632*t232 + 0.1600000000e2_dp*t6 & + *t225*t254 - 0.120e2_dp*t6*t641*t232*t90 + 0.120e2_dp*t382 & + *t383*t254 - 0.20e1_dp*t6*t77*(-0.6222222223e2_dp*t11/t1/ & + t219*t12 - 0.2115555556e3_dp*t6*t624*t86 + 0.1315555556e3_dp* & + t245/t1/t657*t250 - 0.4266666668e2_dp*beta*t244*t5/t657 & + /t69*t669) t687 = t28*t539 t716 = t264**2 t722 = omega*t270*t27 @@ -1399,202 +1399,202 @@ SUBROUTINE xb88_lr_lsd_calc(rho_spin, norm_drho_spin, e_0, & t739 = t3*t151 t746 = t37*t354 t769 = t40*t573 - t791 = 0.5400000000e2_dp*t769*t43*t606-0.3600000000e2_dp*t313* & - t132*t212-0.5400000000e2_dp*t451*t452*t258-0.6000000000e1_dp & - *t128*t323*t94+0.1800000000e2_dp*t128*t132*t258+0.8999999998e1_dp & - *t128*t43*t677-0.2666666667e1_dp*t42*pi*t79 + t791 = 0.5400000000e2_dp*t769*t43*t606 - 0.3600000000e2_dp*t313* & + t132*t212 - 0.5400000000e2_dp*t451*t452*t258 - 0.6000000000e1_dp & + *t128*t323*t94 + 0.1800000000e2_dp*t128*t132*t258 + 0.8999999998e1_dp & + *t128*t43*t677 - 0.2666666667e1_dp*t42*pi*t79 t793 = t328*t135 - t838 = REAL(3*t326*t135*t46, KIND=dp)+REAL(t791*t46, KIND=dp)+REAL(t793* & - t46, KIND=dp)-0.5555555558e-1_dp*t39*t677*t52+0.1111111112e0_dp*t330 & - *t143-0.1666666668e0_dp*t330*t48*t148-0.1851851853e0_dp*t137 & - *t339+0.2222222223e0_dp*t335*t343-0.1666666668e0_dp*t335* & - t347-0.1666666668e0_dp*t335*t351+0.1646090535e0_dp*t47*t48 & - *t71*t51-0.1851851853e0_dp*REAL(t146, KIND=dp)*REAL(t10, KIND=dp)*REAL(t135, KIND=dp) & - *REAL(t46, KIND=dp)+0.1111111112e0_dp*REAL(t146, KIND=dp)*REAL(t141, KIND=dp)*REAL(t326, KIND=dp) & - *REAL(t46, KIND=dp)+0.1111111112e0_dp*REAL(t146, KIND=dp)*REAL(t141, KIND=dp)*REAL(t328, KIND=dp) & - *REAL(t46, KIND=dp)-0.5555555558e-1_dp*REAL(t146, KIND=dp)*REAL(t49, KIND=dp)*REAL(t791, KIND=dp) & - *REAL(t46, KIND=dp)-0.1666666668e0_dp*REAL(t146, KIND=dp)*REAL(t346, KIND=dp)*REAL(t136, KIND=dp) & - -0.5555555558e-1_dp*REAL(t146, KIND=dp)*REAL(t49, KIND=dp)*REAL(t793, KIND=dp)* & + t838 = REAL(3*t326*t135*t46, KIND=dp) + REAL(t791*t46, KIND=dp) + REAL(t793* & + t46, KIND=dp) - 0.5555555558e-1_dp*t39*t677*t52 + 0.1111111112e0_dp*t330 & + *t143 - 0.1666666668e0_dp*t330*t48*t148 - 0.1851851853e0_dp*t137 & + *t339 + 0.2222222223e0_dp*t335*t343 - 0.1666666668e0_dp*t335* & + t347 - 0.1666666668e0_dp*t335*t351 + 0.1646090535e0_dp*t47*t48 & + *t71*t51 - 0.1851851853e0_dp*REAL(t146, KIND=dp)*REAL(t10, KIND=dp)*REAL(t135, KIND=dp) & + *REAL(t46, KIND=dp) + 0.1111111112e0_dp*REAL(t146, KIND=dp)*REAL(t141, KIND=dp)*REAL(t326, KIND=dp) & + *REAL(t46, KIND=dp) + 0.1111111112e0_dp*REAL(t146, KIND=dp)*REAL(t141, KIND=dp)*REAL(t328, KIND=dp) & + *REAL(t46, KIND=dp) - 0.5555555558e-1_dp*REAL(t146, KIND=dp)*REAL(t49, KIND=dp)*REAL(t791, KIND=dp) & + *REAL(t46, KIND=dp) - 0.1666666668e0_dp*REAL(t146, KIND=dp)*REAL(t346, KIND=dp)*REAL(t136, KIND=dp) & + - 0.5555555558e-1_dp*REAL(t146, KIND=dp)*REAL(t49, KIND=dp)*REAL(t793, KIND=dp)* & REAL(t46, KIND=dp) - t842 = 0.2e1_dp*t101*(-t316+t319+0.9000000000e1_dp*t321+t325) & - *t103*t112+0.2e1_dp*t101*t103*(-0.5625000000e1_dp*t687*t31 & - *t606+0.2250000000e1_dp*t271*t109*t212+0.6750000000e1_dp* & - t417*t418*t258+0.1000000000e1_dp*t105*t281*t94-0.1500000000e1_dp & - *t105*t109*t258-0.1500000000e1_dp*t105*t31*t677 & - +0.1111111111e1_dp*t30*t26*t10)+0.4e1_dp*t101*t265*t284+ & - 0.2e1_dp*t101*t716*t103*t112+0.1250000000e0_dp*t722*t118 & - *t606+0.8333333333e-1_dp*t289*t293*t212-0.2500000000e0_dp*t289 & - *t297*t212-0.2500000000e0_dp*t289*t118*t613+0.2222222222e0_dp & - *t117*t735*t94-0.3333333333e0_dp*t117*t739*t94- & - 0.1666666667e0_dp*t117*t293*t258+0.5000000001e0_dp*t117*t746 & - *t94+0.5000000001e0_dp*t117*t297*t258+0.1666666667e0_dp*t117 & - *t118*t677-0.3456790122e0_dp*t36*t27*t237*t55+0.4444444444e0_dp & - *t36*t304*t151-0.3333333333e0_dp*t36*t122*t354 & - +0.3333333334e0_dp*t36*t38*t838 - t846 = -0.5000000004e0_dp*t116*t213-0.2000000001e1_dp*t36*t216 & - -0.1000000001e1_dp*t36*t259-0.6666666672e0_dp*t64*t601+0.8333333340e-1_dp & - *t605*t60*t606-0.5000000004e0_dp*t211*t207*t212 & - -0.5000000004e0_dp*t211*t60*t613-0.1000000001e1_dp*t68* & - t601*t94-0.1000000001e1_dp*t68*t207*t258-0.3333333336e0_dp* & - t68*t60*t677-0.2222222224e0_dp*t24*t98*t842 - - e_rho_rho_rho_spin(ii) = e_rho_rho_rho_spin(ii)+t846*sx + t842 = 0.2e1_dp*t101*(-t316 + t319 + 0.9000000000e1_dp*t321 + t325) & + *t103*t112 + 0.2e1_dp*t101*t103*(-0.5625000000e1_dp*t687*t31 & + *t606 + 0.2250000000e1_dp*t271*t109*t212 + 0.6750000000e1_dp* & + t417*t418*t258 + 0.1000000000e1_dp*t105*t281*t94 - 0.1500000000e1_dp & + *t105*t109*t258 - 0.1500000000e1_dp*t105*t31*t677 & + + 0.1111111111e1_dp*t30*t26*t10) + 0.4e1_dp*t101*t265*t284 + & + 0.2e1_dp*t101*t716*t103*t112 + 0.1250000000e0_dp*t722*t118 & + *t606 + 0.8333333333e-1_dp*t289*t293*t212 - 0.2500000000e0_dp*t289 & + *t297*t212 - 0.2500000000e0_dp*t289*t118*t613 + 0.2222222222e0_dp & + *t117*t735*t94 - 0.3333333333e0_dp*t117*t739*t94 - & + 0.1666666667e0_dp*t117*t293*t258 + 0.5000000001e0_dp*t117*t746 & + *t94 + 0.5000000001e0_dp*t117*t297*t258 + 0.1666666667e0_dp*t117 & + *t118*t677 - 0.3456790122e0_dp*t36*t27*t237*t55 + 0.4444444444e0_dp & + *t36*t304*t151 - 0.3333333333e0_dp*t36*t122*t354 & + + 0.3333333334e0_dp*t36*t38*t838 + t846 = -0.5000000004e0_dp*t116*t213 - 0.2000000001e1_dp*t36*t216 & + - 0.1000000001e1_dp*t36*t259 - 0.6666666672e0_dp*t64*t601 + 0.8333333340e-1_dp & + *t605*t60*t606 - 0.5000000004e0_dp*t211*t207*t212 & + - 0.5000000004e0_dp*t211*t60*t613 - 0.1000000001e1_dp*t68* & + t601*t94 - 0.1000000001e1_dp*t68*t207*t258 - 0.3333333336e0_dp* & + t68*t60*t677 - 0.2222222224e0_dp*t24*t98*t842 + + e_rho_rho_rho_spin(ii) = e_rho_rho_rho_spin(ii) + t846*sx t857 = t27*t496 t860 = t212*t172 t867 = t94*t404 t880 = t258*t172 - t933 = 0.3911111110e2_dp*t11*t222-0.1955555555e2_dp*t6*t628*t168 & - +0.2133333334e2_dp*t11*t226-0.2133333334e2_dp*t6*t71*t384 & - +0.1066666667e2_dp*t6*t225*t400+0.80e1_dp*t11*t233-0.120e2_dp & - *t382*t640*t232*t168+0.80e1_dp*t382*t383*t400-0.40e1_dp & - *t11*t255+0.40e1_dp*t382*t230*t254*t168-0.20e1_dp* & - t6*t77*(0.1866666667e2_dp*beta*t237*t12+0.9866666667e2_dp* & - t11*t241-0.8266666668e2_dp*t393*t251+0.3200000001e2_dp*beta & + t933 = 0.3911111110e2_dp*t11*t222 - 0.1955555555e2_dp*t6*t628*t168 & + + 0.2133333334e2_dp*t11*t226 - 0.2133333334e2_dp*t6*t71*t384 & + + 0.1066666667e2_dp*t6*t225*t400 + 0.80e1_dp*t11*t233 - 0.120e2_dp & + *t382*t640*t232*t168 + 0.80e1_dp*t382*t383*t400 - 0.40e1_dp & + *t11*t255 + 0.40e1_dp*t382*t230*t254*t168 - 0.20e1_dp* & + t6*t77*(0.1866666667e2_dp*beta*t237*t12 + 0.9866666667e2_dp* & + t11*t241 - 0.8266666668e2_dp*t393*t251 + 0.3200000001e2_dp*beta & *t244*ndrho/t657/t7*t669) t961 = t687*t26 t1002 = t3*t196 - t1009 = 0.2e1_dp*t101*(-t455+0.9000000000e1_dp*t457+0.6000000000e1_dp & - *t460)*t103*t112+0.1800000000e2_dp*t412*t264*t40*t127 & - *t8*t172*t103*t112+0.2e1_dp*t101*t265*t428+0.1800000000e2_dp & - *t413*t186*t285+0.2e1_dp*t101*t103*(-0.5625000000e1_dp & - *t961*t1*t212*t172+0.4500000000e1_dp*t417*t418*t404 & - +0.1500000000e1_dp*t417*t49*t94*t172-0.1000000000e1_dp* & - t105*t109*t404+0.2250000000e1_dp*t417*t1*t258*t172-0.1500000000e1_dp & - *t105*t31*t933+0.3333333334e0_dp*t105*t281* & - t172)+0.1250000000e0_dp*t722*t118*t860-0.8333333335e-1_dp*t289 & - *t435*t212-0.1666666667e0_dp*t289*t118*t867+0.5555555555e-1_dp & - *t289*t293*t368-0.1111111111e0_dp*t117*t1002*t94 & - -0.1111111111e0_dp*t117*t293*t404 + t1009 = 0.2e1_dp*t101*(-t455 + 0.9000000000e1_dp*t457 + 0.6000000000e1_dp & + *t460)*t103*t112 + 0.1800000000e2_dp*t412*t264*t40*t127 & + *t8*t172*t103*t112 + 0.2e1_dp*t101*t265*t428 + 0.1800000000e2_dp & + *t413*t186*t285 + 0.2e1_dp*t101*t103*(-0.5625000000e1_dp & + *t961*t1*t212*t172 + 0.4500000000e1_dp*t417*t418*t404 & + + 0.1500000000e1_dp*t417*t49*t94*t172 - 0.1000000000e1_dp* & + t105*t109*t404 + 0.2250000000e1_dp*t417*t1*t258*t172 - 0.1500000000e1_dp & + *t105*t31*t933 + 0.3333333334e0_dp*t105*t281* & + t172) + 0.1250000000e0_dp*t722*t118*t860 - 0.8333333335e-1_dp*t289 & + *t435*t212 - 0.1666666667e0_dp*t289*t118*t867 + 0.5555555555e-1_dp & + *t289*t293*t368 - 0.1111111111e0_dp*t117*t1002*t94 & + - 0.1111111111e0_dp*t117*t293*t404 t1013 = t37*t492 t1044 = t769*pi - t1069 = 0.5400000000e2_dp*t1044*t8*t212*t172-0.3600000000e2_dp & - *t451*t452*t404-0.2400000000e2_dp*t451*t37*t94*t172+ & - 0.1200000000e2_dp*t128*t132*t404-0.1800000000e2_dp*t451*t8* & - t258*t172+0.8999999998e1_dp*t128*t43*t933-0.2000000000e1_dp & + t1069 = 0.5400000000e2_dp*t1044*t8*t212*t172 - 0.3600000000e2_dp & + *t451*t452*t404 - 0.2400000000e2_dp*t451*t37*t94*t172 + & + 0.1200000000e2_dp*t128*t132*t404 - 0.1800000000e2_dp*t451*t8* & + t258*t172 + 0.8999999998e1_dp*t128*t43*t933 - 0.2000000000e1_dp & *t128*t323*t172 t1091 = t127*t172*t46 - t1102 = t1069*t46+0.8999999998e1_dp*t326*t40*t127*t467+REAL(2 & - *t136*t462, KIND=dp)+0.8999999998e1_dp*t328*t40*t127*t467- & - 0.5555555558e-1_dp*t39*t933*t52-0.5000000001e0_dp*t258*t127 & - *t466+0.7407407410e-1_dp*t470*t143+0.6666666668e0_dp*t94*t478 & - *t1091-0.1111111112e0_dp*t470*t48*t148-0.1111111112e0_dp & - *t335*t486-0.1000000001e1_dp*t94*t135*t1091 - t1136 = -0.6172839508e-1_dp*t190*t339-0.5555555556e0_dp*t41/t7 & - *t466+0.7407407410e-1_dp*t482*t343+0.7407407410e-1_dp*t146* & - t141*t462*t46+0.6666666668e0_dp*t479*t135*t172*t46-0.5555555558e-1_dp & - *t482*t347-0.5555555558e-1_dp*t146*t49*t1069 & - *t46-0.5000000001e0_dp*t41*t326*t466-0.5555555558e-1_dp*t482 & - *t351-0.1111111112e0_dp*t146*t147*t463-0.5000000001e0_dp* & + t1102 = t1069*t46 + 0.8999999998e1_dp*t326*t40*t127*t467 + REAL(2 & + *t136*t462, KIND=dp) + 0.8999999998e1_dp*t328*t40*t127*t467 - & + 0.5555555558e-1_dp*t39*t933*t52 - 0.5000000001e0_dp*t258*t127 & + *t466 + 0.7407407410e-1_dp*t470*t143 + 0.6666666668e0_dp*t94*t478 & + *t1091 - 0.1111111112e0_dp*t470*t48*t148 - 0.1111111112e0_dp & + *t335*t486 - 0.1000000001e1_dp*t94*t135*t1091 + t1136 = -0.6172839508e-1_dp*t190*t339 - 0.5555555556e0_dp*t41/t7 & + *t466 + 0.7407407410e-1_dp*t482*t343 + 0.7407407410e-1_dp*t146* & + t141*t462*t46 + 0.6666666668e0_dp*t479*t135*t172*t46 - 0.5555555558e-1_dp & + *t482*t347 - 0.5555555558e-1_dp*t146*t49*t1069 & + *t46 - 0.5000000001e0_dp*t41*t326*t466 - 0.5555555558e-1_dp*t482 & + *t351 - 0.1111111112e0_dp*t146*t147*t463 - 0.5000000001e0_dp* & t41*t328*t466 - t1141 = -0.1666666667e0_dp*t289*t297*t368+0.3333333334e0_dp*t117 & - *t1013*t94+0.3333333334e0_dp*t117*t297*t404-0.8333333335e-1_dp & - *t289*t118*t880+0.1666666667e0_dp*t117*t435*t258+ & - 0.1666666667e0_dp*t117*t118*t933+0.7407407405e-1_dp*t117*t735 & - *t172+0.1481481481e0_dp*t36*t304*t196-0.1111111111e0_dp* & - t117*t739*t172-0.2222222222e0_dp*t36*t122*t492+0.1666666667e0_dp & - *t117*t746*t172+0.3333333334e0_dp*t36*t38*(t1102 & - +t1136) - t1146 = -0.3333333336e0_dp*t117*t59*t94*t172-0.6666666672e0_dp & - *t36*t372-0.6666666672e0_dp*t36*t405-0.6666666672e0_dp*t36 & - *t408-0.4444444448e0_dp*t64*t857+0.8333333340e-1_dp*t605*t60 & - *t860-0.1666666668e0_dp*t211*t365*t212-0.3333333336e0_dp* & - t211*t60*t867-0.3333333336e0_dp*t211*t207*t368-0.6666666672e0_dp & - *t68*t857*t94-0.6666666672e0_dp*t68*t207*t404-0.1666666668e0_dp & - *t211*t60*t880-0.3333333336e0_dp*t68*t365* & - t258-0.3333333336e0_dp*t68*t60*t933-0.3333333336e0_dp*t68* & - t601*t172-0.2222222224e0_dp*t24*t98*(t1009+t1141) - - e_ndrho_rho_rho_spin(ii) = e_ndrho_rho_rho_spin(ii)+t1146*sx + t1141 = -0.1666666667e0_dp*t289*t297*t368 + 0.3333333334e0_dp*t117 & + *t1013*t94 + 0.3333333334e0_dp*t117*t297*t404 - 0.8333333335e-1_dp & + *t289*t118*t880 + 0.1666666667e0_dp*t117*t435*t258 + & + 0.1666666667e0_dp*t117*t118*t933 + 0.7407407405e-1_dp*t117*t735 & + *t172 + 0.1481481481e0_dp*t36*t304*t196 - 0.1111111111e0_dp* & + t117*t739*t172 - 0.2222222222e0_dp*t36*t122*t492 + 0.1666666667e0_dp & + *t117*t746*t172 + 0.3333333334e0_dp*t36*t38*(t1102 & + + t1136) + t1146 = -0.3333333336e0_dp*t117*t59*t94*t172 - 0.6666666672e0_dp & + *t36*t372 - 0.6666666672e0_dp*t36*t405 - 0.6666666672e0_dp*t36 & + *t408 - 0.4444444448e0_dp*t64*t857 + 0.8333333340e-1_dp*t605*t60 & + *t860 - 0.1666666668e0_dp*t211*t365*t212 - 0.3333333336e0_dp* & + t211*t60*t867 - 0.3333333336e0_dp*t211*t207*t368 - 0.6666666672e0_dp & + *t68*t857*t94 - 0.6666666672e0_dp*t68*t207*t404 - 0.1666666668e0_dp & + *t211*t60*t880 - 0.3333333336e0_dp*t68*t365* & + t258 - 0.3333333336e0_dp*t68*t60*t933 - 0.3333333336e0_dp*t68* & + t601*t172 - 0.2222222224e0_dp*t24*t98*(t1009 + t1141) + + e_ndrho_rho_rho_spin(ii) = e_ndrho_rho_rho_spin(ii) + t1146*sx t1153 = t27*t590 t1156 = t94*t501 t1163 = t404*t172 t1167 = t94*t529 t1177 = beta*t71 - t1220 = -0.1066666667e2_dp*t1177*t17+0.2133333334e2_dp*t11*t377 & - -0.1066666667e2_dp*t6*t632*t513+0.5333333333e1_dp*t6*t225 & - *t525-0.40e1_dp*t508*t76*t90+0.160e2_dp*t11*t10*t384- & - 0.80e1_dp*t11*t401-0.120e2_dp*t382*t640*t90*t513+0.80e1_dp & - *t382*t230*t400*t168+0.40e1_dp*t382*t383*t525-0.20e1_dp & - *t6*t77*(-0.3200000000e2_dp*t1177*t86+0.4800000000e2_dp*t6 & - *t397-0.2400000000e2_dp*t245/t657/rho*t669) + t1220 = -0.1066666667e2_dp*t1177*t17 + 0.2133333334e2_dp*t11*t377 & + - 0.1066666667e2_dp*t6*t632*t513 + 0.5333333333e1_dp*t6*t225 & + *t525 - 0.40e1_dp*t508*t76*t90 + 0.160e2_dp*t11*t10*t384 - & + 0.80e1_dp*t11*t401 - 0.120e2_dp*t382*t640*t90*t513 + 0.80e1_dp & + *t382*t230*t400*t168 + 0.40e1_dp*t382*t383*t525 - 0.20e1_dp & + *t6*t77*(-0.3200000000e2_dp*t1177*t86 + 0.4800000000e2_dp*t6 & + *t397 - 0.2400000000e2_dp*t245/t657/rho*t669) t1284 = t37*t586 - t1334 = 0.5400000000e2_dp*t1044*t452*t501-0.3600000000e2_dp*t451 & - *t8*t404*t172-0.1800000000e2_dp*t451*t452*t529+0.8999999998e1_dp & - *t128*t43*t1220-0.1200000000e2_dp*t313*t132*t501 & - +0.5999999999e1_dp*t128*t132*t529 + t1334 = 0.5400000000e2_dp*t1044*t452*t501 - 0.3600000000e2_dp*t451 & + *t8*t404*t172 - 0.1800000000e2_dp*t451*t452*t529 + 0.8999999998e1_dp & + *t128*t43*t1220 - 0.1200000000e2_dp*t313*t132*t501 & + + 0.5999999999e1_dp*t128*t132*t529 t1341 = t501*t46 t1345 = t529*t46 t1370 = t40*pi - t1396 = t1334*t46+0.1800000000e2_dp*t462*t40*t127*t467-0.2250000000e2_dp & - *t464*t312*t43*t1341+0.8999999998e1_dp*t465 & - *t43*t1345-0.1000000000e1_dp*t404*t127*t466+0.8099999996e2_dp & - *t135*t571*t573*t533*t2*t1341-0.5555555558e-1_dp*t39 & - *t1220*t52-0.5000000001e0_dp*t473*t1345+0.3333333334e0_dp* & - t479*t1345+0.1000000000e1_dp*t94*t312*t1341-0.4500000000e1_dp & - *t94*t573*t501*t1370*t8*t46+0.3703703705e-1_dp*t580 & - *t143+0.3000000000e1_dp*t312*t37*t501*t1370*t46-0.5555555558e-1_dp & - *t580*t48*t148-0.1111111112e0_dp*t482*t486-0.5555555558e-1_dp & - *t146*t49*t1334*t46-0.1000000000e1_dp*t41* & - t462*t466-0.5000000001e0_dp*t489*t1345 - t1400 = -0.3600000000e2_dp*t412*t313*t562*t113+0.1800000000e2_dp & - *t413*t566*t113+0.3600000000e2_dp*t413*t186*t429+0.1620000000e3_dp & - *t26*t533*t100*t574*t576*t113+0.2e1_dp*t101 & - *t103*(-0.5625000000e1_dp*t961*t418*t501+0.4500000000e1_dp & - *t417*t1*t404*t172+0.2250000000e1_dp*t417*t418*t529- & - 0.1500000000e1_dp*t105*t31*t1220+0.7500000000e0_dp*t271*t109 & - *t501-0.5000000000e0_dp*t105*t109*t529)+0.1250000000e0_dp* & - t722*t118*t1156-0.1666666667e0_dp*t289*t435*t368-0.1666666667e0_dp & - *t289*t118*t1163-0.8333333335e-1_dp*t289*t118*t1167 & - +0.1666666667e0_dp*t117*t1284*t94+0.3333333334e0_dp*t117 & - *t435*t404+0.1666666667e0_dp*t117*t118*t1220+0.2777777778e-1_dp & - *t289*t293*t501-0.1111111111e0_dp*t117*t1002*t172 & - -0.5555555555e-1_dp*t117*t293*t529-0.1111111111e0_dp*t36*t122 & - *t586-0.8333333335e-1_dp*t289*t297*t501+0.3333333334e0_dp & - *t117*t1013*t172+0.1666666667e0_dp*t117*t297*t529+0.3333333334e0_dp & + t1396 = t1334*t46 + 0.1800000000e2_dp*t462*t40*t127*t467 - 0.2250000000e2_dp & + *t464*t312*t43*t1341 + 0.8999999998e1_dp*t465 & + *t43*t1345 - 0.1000000000e1_dp*t404*t127*t466 + 0.8099999996e2_dp & + *t135*t571*t573*t533*t2*t1341 - 0.5555555558e-1_dp*t39 & + *t1220*t52 - 0.5000000001e0_dp*t473*t1345 + 0.3333333334e0_dp* & + t479*t1345 + 0.1000000000e1_dp*t94*t312*t1341 - 0.4500000000e1_dp & + *t94*t573*t501*t1370*t8*t46 + 0.3703703705e-1_dp*t580 & + *t143 + 0.3000000000e1_dp*t312*t37*t501*t1370*t46 - 0.5555555558e-1_dp & + *t580*t48*t148 - 0.1111111112e0_dp*t482*t486 - 0.5555555558e-1_dp & + *t146*t49*t1334*t46 - 0.1000000000e1_dp*t41* & + t462*t466 - 0.5000000001e0_dp*t489*t1345 + t1400 = -0.3600000000e2_dp*t412*t313*t562*t113 + 0.1800000000e2_dp & + *t413*t566*t113 + 0.3600000000e2_dp*t413*t186*t429 + 0.1620000000e3_dp & + *t26*t533*t100*t574*t576*t113 + 0.2e1_dp*t101 & + *t103*(-0.5625000000e1_dp*t961*t418*t501 + 0.4500000000e1_dp & + *t417*t1*t404*t172 + 0.2250000000e1_dp*t417*t418*t529 - & + 0.1500000000e1_dp*t105*t31*t1220 + 0.7500000000e0_dp*t271*t109 & + *t501 - 0.5000000000e0_dp*t105*t109*t529) + 0.1250000000e0_dp* & + t722*t118*t1156 - 0.1666666667e0_dp*t289*t435*t368 - 0.1666666667e0_dp & + *t289*t118*t1163 - 0.8333333335e-1_dp*t289*t118*t1167 & + + 0.1666666667e0_dp*t117*t1284*t94 + 0.3333333334e0_dp*t117 & + *t435*t404 + 0.1666666667e0_dp*t117*t118*t1220 + 0.2777777778e-1_dp & + *t289*t293*t501 - 0.1111111111e0_dp*t117*t1002*t172 & + - 0.5555555555e-1_dp*t117*t293*t529 - 0.1111111111e0_dp*t36*t122 & + *t586 - 0.8333333335e-1_dp*t289*t297*t501 + 0.3333333334e0_dp & + *t117*t1013*t172 + 0.1666666667e0_dp*t117*t297*t529 + 0.3333333334e0_dp & *t36*t38*t1396 - t1404 = -0.1666666668e0_dp*t116*t502-0.6666666672e0_dp*t36*t505 & - -0.3333333336e0_dp*t36*t530-0.2222222224e0_dp*t64*t1153+0.8333333340e-1_dp & - *t605*t60*t1156-0.3333333336e0_dp*t211*t365 & - *t368-0.3333333336e0_dp*t211*t60*t1163-0.1666666668e0_dp*t211 & - *t60*t1167-0.3333333336e0_dp*t68*t1153*t94-0.6666666672e0_dp & - *t68*t365*t404-0.3333333336e0_dp*t68*t60*t1220-0.1666666668e0_dp & - *t211*t207*t501-0.6666666672e0_dp*t68*t857* & - t172-0.3333333336e0_dp*t68*t207*t529-0.2222222224e0_dp*t24* & + t1404 = -0.1666666668e0_dp*t116*t502 - 0.6666666672e0_dp*t36*t505 & + - 0.3333333336e0_dp*t36*t530 - 0.2222222224e0_dp*t64*t1153 + 0.8333333340e-1_dp & + *t605*t60*t1156 - 0.3333333336e0_dp*t211*t365 & + *t368 - 0.3333333336e0_dp*t211*t60*t1163 - 0.1666666668e0_dp*t211 & + *t60*t1167 - 0.3333333336e0_dp*t68*t1153*t94 - 0.6666666672e0_dp & + *t68*t365*t404 - 0.3333333336e0_dp*t68*t60*t1220 - 0.1666666668e0_dp & + *t211*t207*t501 - 0.6666666672e0_dp*t68*t857* & + t172 - 0.3333333336e0_dp*t68*t207*t529 - 0.2222222224e0_dp*t24* & t98*t1400 - e_ndrho_ndrho_rho_spin(ii) = e_ndrho_ndrho_rho_spin(ii)+t1404*sx + e_ndrho_ndrho_rho_spin(ii) = e_ndrho_ndrho_rho_spin(ii) + t1404*sx t1405 = t501*t172 t1412 = t172*t529 - t1449 = -0.120e2_dp*t508*t76*t168+0.240e2_dp*t11*t514-0.120e2_dp & - *t11*t526-0.120e2_dp*t6*t641*t513*t168+0.120e2_dp*t382 & - *t230*t168*t525-0.20e1_dp*t6*t77*(-0.240e2_dp*beta*t521 & - *t250*ndrho+0.180e2_dp*t393/t657*t669) + t1449 = -0.120e2_dp*t508*t76*t168 + 0.240e2_dp*t11*t514 - 0.120e2_dp & + *t11*t526 - 0.120e2_dp*t6*t641*t513*t168 + 0.120e2_dp*t382 & + *t230*t168*t525 - 0.20e1_dp*t6*t77*(-0.240e2_dp*beta*t521 & + *t250*ndrho + 0.180e2_dp*t393/t657*t669) t1456 = t1405*t103 t1467 = t533*pi t1472 = t572*t21 - t1553 = 0.1350000000e3_dp*t537/t22/t572*rho*t1456-0.8100000000e2_dp & - *t534*t536*t539*rho*t172*t103*t529-0.2430000000e3_dp & - *t1467*t100/t570/omega/t22/t1472*t140*t1456- & - 0.1125000000e2_dp*t177*t687*t1*t1405+0.1350000000e2_dp*t176 & - *t103*t28*t270*t1*t1412-0.3000000000e1_dp*t177*t105* & - t1*t1449+0.1250000000e0_dp*t722*t118*t1405-0.2500000000e0_dp & - *t289*t435*t501-0.2500000000e0_dp*t289*t118*t1412+0.5000000001e0_dp & - *t117*t1284*t172+0.5000000001e0_dp*t117*t435 & - *t529+0.1666666667e0_dp*t117*t118*t1449+0.3333333334e0_dp*t36 & - *t38*(0.6750000000e2_dp*t1044*t8*t1405*t46-0.6750000000e2_dp & - *t451*t186*t1345-0.5264999998e3_dp*t571/t1472*t533 & - *t2*t1405*t46+0.8999999998e1_dp*t185*t8*t1449*t46+0.2429999999e3_dp & - *t575*t2*t529*t466+0.7289999995e3_dp/t570/t39 & - /t572/t126*t1467*t7*t1405*t46-0.5555555558e-1_dp*t39 & - *t1449*t52-0.5000000001e0_dp*t41*t1449*t46) - - e_ndrho_ndrho_ndrho_spin(ii) = e_ndrho_ndrho_ndrho_spin(ii)+(0.8333333340e-1_dp*t605*t60*t1405- & - 0.5000000004e0_dp*t211*t365*t501-0.5000000004e0_dp*t211*t60*t1412-0.1000000001e1_dp & - *t68*t1153*t172-0.1000000001e1_dp*t68*t365*t529-0.3333333336e0_dp & - *t68*t60*t1449-0.2222222224e0_dp*t24*t98*t1553) & + t1553 = 0.1350000000e3_dp*t537/t22/t572*rho*t1456 - 0.8100000000e2_dp & + *t534*t536*t539*rho*t172*t103*t529 - 0.2430000000e3_dp & + *t1467*t100/t570/omega/t22/t1472*t140*t1456 - & + 0.1125000000e2_dp*t177*t687*t1*t1405 + 0.1350000000e2_dp*t176 & + *t103*t28*t270*t1*t1412 - 0.3000000000e1_dp*t177*t105* & + t1*t1449 + 0.1250000000e0_dp*t722*t118*t1405 - 0.2500000000e0_dp & + *t289*t435*t501 - 0.2500000000e0_dp*t289*t118*t1412 + 0.5000000001e0_dp & + *t117*t1284*t172 + 0.5000000001e0_dp*t117*t435 & + *t529 + 0.1666666667e0_dp*t117*t118*t1449 + 0.3333333334e0_dp*t36 & + *t38*(0.6750000000e2_dp*t1044*t8*t1405*t46 - 0.6750000000e2_dp & + *t451*t186*t1345 - 0.5264999998e3_dp*t571/t1472*t533 & + *t2*t1405*t46 + 0.8999999998e1_dp*t185*t8*t1449*t46 + 0.2429999999e3_dp & + *t575*t2*t529*t466 + 0.7289999995e3_dp/t570/t39 & + /t572/t126*t1467*t7*t1405*t46 - 0.5555555558e-1_dp*t39 & + *t1449*t52 - 0.5000000001e0_dp*t41*t1449*t46) + + e_ndrho_ndrho_ndrho_spin(ii) = e_ndrho_ndrho_ndrho_spin(ii) + (0.8333333340e-1_dp*t605*t60*t1405 - & + 0.5000000004e0_dp*t211*t365*t501 - 0.5000000004e0_dp*t211*t60*t1412 - 0.1000000001e1_dp & + *t68*t1153*t172 - 0.1000000001e1_dp*t68*t365*t529 - 0.3333333336e0_dp & + *t68*t60*t1449 - 0.2222222224e0_dp*t24*t98*t1553) & *sx END IF diff --git a/src/xc/xc_xbecke88_lr_adiabatic.F b/src/xc/xc_xbecke88_lr_adiabatic.F index d0247c86b7..5863072d9a 100644 --- a/src/xc/xc_xbecke88_lr_adiabatic.F +++ b/src/xc/xc_xbecke88_lr_adiabatic.F @@ -156,7 +156,7 @@ SUBROUTINE xb88_lr_adiabatic_lda_eval(rho_set, deriv_set, grad_deriv, xb88_lr_ad CPASSERT(deriv_set%ref_count > 0) CALL xc_rho_set_get(rho_set, rho=rho, & norm_drho=norm_drho, local_bounds=bo, rho_cutoff=epsilon_rho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rho @@ -442,12 +442,12 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t25 = 0.1e1_dp/t9 t26 = t19*t18 t27 = 0.1e1_dp/t26 - t31 = LOG(my_ndrho*t25*t27+SQRT((my_ndrho*t25*t27)**0.2e1_dp+ & - 0.1e1_dp)) - t35 = 0.10e1_dp+0.60e1_dp*t24*t25*t27*t31 + t31 = LOG(my_ndrho*t25*t27 + SQRT((my_ndrho*t25*t27)**0.2e1_dp + & + 0.1e1_dp)) + t35 = 0.10e1_dp + 0.60e1_dp*t24*t25*t27*t31 t36 = 0.1e1_dp/t35 t37 = t23*t36 - t40 = 0.20e1_dp*Cx+0.20e1_dp*t7*t37 + t40 = 0.20e1_dp*Cx + 0.20e1_dp*t7*t37 t41 = SQRT(t40) t42 = t41*t40 t43 = t4*t42 @@ -473,10 +473,10 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t67 = 0.1e1_dp/pi t68 = 0.1e1_dp/t20 t69 = t67*t68 - t70 = t65-0.10e1_dp + t70 = t65 - 0.10e1_dp t71 = t69*t70 - t74 = t65-0.15e1_dp-0.5555555558e-1_dp*t66*t71 - t78 = t44*t53+0.3333333334e0_dp*t55*t57*t74 + t74 = t65 - 0.15e1_dp - 0.5555555558e-1_dp*t66*t71 + t78 = t44*t53 + 0.3333333334e0_dp*t55*t57*t74 t79 = t46*t78 t83 = my_rho*t41*omega t84 = t45*t78 @@ -505,15 +505,15 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t119 = t24*t25 t122 = my_ndrho*t11 t123 = t114*my_rho - t126 = -4*my_ndrho*t107*t27+4*t122*t123 - t130 = 1+t6*t11*t22 + t126 = -4*my_ndrho*t107*t27 + 4*t122*t123 + t130 = 1 + t6*t11*t22 t131 = SQRT(t130) t132 = 0.1e1_dp/t131 t133 = t27*t126*t132 - t136 = -0.240e2_dp*t24*t108*t31+0.240e2_dp*t112*t116+0.60e1_dp & + t136 = -0.240e2_dp*t24*t108*t31 + 0.240e2_dp*t112*t116 + 0.60e1_dp & *t119*t133 t137 = t105*t136 - t140 = -0.160e2_dp*t7*t88+0.160e2_dp*t93*t99-0.20e1_dp*t102* & + t140 = -0.160e2_dp*t7*t88 + 0.160e2_dp*t93*t99 - 0.20e1_dp*t102* & t137 t141 = t84*t140 t144 = my_rho*t42 @@ -525,7 +525,7 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t151 = t47*t150 t155 = t49*t44 t156 = t68*my_rho - t160 = -0.1500000000e1_dp*t151*t50*t140-0.3000000000e1_dp*t155 & + t160 = -0.1500000000e1_dp*t151*t50*t140 - 0.3000000000e1_dp*t155 & *t156*t25 t161 = t149*t160 t164 = omega*t48 @@ -539,7 +539,7 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t178 = t59*t177 t182 = t61*pi t183 = t56*my_rho - t187 = 0.8999999998e1_dp*t178*t62*t140+0.1800000000e2_dp*t182* & + t187 = 0.8999999998e1_dp*t178*t62*t140 + 0.1800000000e2_dp*t182* & t183*t25 t189 = t58*t140 t192 = t66*t67 @@ -548,15 +548,15 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t196 = t195*t172 t199 = t68*t187 t200 = t199*t65 - t203 = t187*t65-0.5555555558e-1_dp*t189*t71-0.1111111112e0_dp* & - t192*t196-0.5555555558e-1_dp*t192*t200 - t207 = (2*t147*t161)+0.1666666667e0_dp*t165*t166*t140 & - +0.3333333334e0_dp*t170*t171*t172+0.3333333334e0_dp*t55*t57 & + t203 = t187*t65 - 0.5555555558e-1_dp*t189*t71 - 0.1111111112e0_dp* & + t192*t196 - 0.5555555558e-1_dp*t192*t200 + t207 = (2*t147*t161) + 0.1666666667e0_dp*t165*t166*t140 & + + 0.3333333334e0_dp*t170*t171*t172 + 0.3333333334e0_dp*t55*t57 & *t203 !! Multiply with 2.0 because Code comes from LSD - e_0(ii) = e_0(ii)+(-0.4444444448e0_dp*t43*t79+t8*(-0.3333333336e0_dp*t83*t141 & - -0.2222222224e0_dp*t144*t46*t207))*sx*2.0_dp + e_0(ii) = e_0(ii) + (-0.4444444448e0_dp*t43*t79 + t8*(-0.3333333336e0_dp*t83*t141 & + - 0.2222222224e0_dp*t144*t46*t207))*sx*2.0_dp END IF IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN t214 = lambda*t42 @@ -568,27 +568,27 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t224 = t9*t16 t225 = 0.1e1_dp/t224 t230 = t220*t132 - t233 = -0.8000000000e1_dp*t24*t225*t114*t31-0.8000000000e1_dp* & + t233 = -0.8000000000e1_dp*t24*t225*t114*t31 - 0.8000000000e1_dp* & t7*t230 t234 = t105*t233 - t237 = -0.5333333333e1_dp*t7*t221-0.20e1_dp*t102*t234 + t237 = -0.5333333333e1_dp*t7*t221 - 0.20e1_dp*t102*t234 t245 = t44*t68 - t249 = -0.1500000000e1_dp*t151*t50*t237+0.1000000000e1_dp*t49* & + t249 = -0.1500000000e1_dp*t151*t50*t237 + 0.1000000000e1_dp*t49* & t245*t17 t250 = t149*t249 t260 = t178*t62*t237 t262 = pi*t56 t264 = t61*t262*t17 - t266 = 0.8999999998e1_dp*t260-0.5999999999e1_dp*t264 + t266 = 0.8999999998e1_dp*t260 - 0.5999999999e1_dp*t264 t267 = t266*t65 t268 = t58*t237 t271 = t195*t17 t274 = t68*t266 t275 = t274*t65 - t278 = t267-0.5555555558e-1_dp*t268*t71+0.3703703705e-1_dp*t192 & - *t271-0.5555555558e-1_dp*t192*t275 - t282 = (2*t147*t250)+0.1666666667e0_dp*t165*t166*t237 & - -0.1111111111e0_dp*t170*t171*t17+0.3333333334e0_dp*t55*t57 & + t278 = t267 - 0.5555555558e-1_dp*t268*t71 + 0.3703703705e-1_dp*t192 & + *t271 - 0.5555555558e-1_dp*t192*t275 + t282 = (2*t147*t250) + 0.1666666667e0_dp*t165*t166*t237 & + - 0.1111111111e0_dp*t170*t171*t17 + 0.3333333334e0_dp*t55*t57 & *t278 t283 = t46*t282 t289 = my_rho*t48*omega @@ -624,7 +624,7 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t352 = t114*t126*t132 t356 = my_ndrho*t219 t357 = t341*my_rho - t360 = 0.28e2_dp/0.3e1_dp*t122*t114-0.28e2_dp/0.3e1_dp*t356*t357 + t360 = 0.28e2_dp/0.3e1_dp*t122*t114 - 0.28e2_dp/0.3e1_dp*t356*t357 t362 = t27*t360*t132 t365 = t6*my_ndrho t366 = beta*t365 @@ -632,19 +632,19 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t368 = 0.1e1_dp/t367 t371 = 0.1e1_dp/t131/t130 t372 = t368*t126*t371 - t375 = 0.5600000000e2_dp*t24*t332*t31+0.3200000000e2_dp*t7*t336 & - -0.5600000000e2_dp*t339*t343-0.3200000000e2_dp*t307*t347- & - 0.8000000000e1_dp*t350*t352+0.60e1_dp*t119*t362+0.8000000000e1_dp & + t375 = 0.5600000000e2_dp*t24*t332*t31 + 0.3200000000e2_dp*t7*t336 & + - 0.5600000000e2_dp*t339*t343 - 0.3200000000e2_dp*t307*t347 - & + 0.8000000000e1_dp*t350*t352 + 0.60e1_dp*t119*t362 + 0.8000000000e1_dp & *t366*t372 t376 = t105*t375 - t379 = 0.5866666667e2_dp*t7*t299+0.160e2_dp*t302*t234-0.5866666667e2_dp & - *t307*t313-0.160e2_dp*t93*t318+0.5333333333e1_dp*t321 & - *t322+0.40e1_dp*t102*t329-0.20e1_dp*t102*t376 + t379 = 0.5866666667e2_dp*t7*t299 + 0.160e2_dp*t302*t234 - 0.5866666667e2_dp & + *t307*t313 - 0.160e2_dp*t93*t318 + 0.5333333333e1_dp*t321 & + *t322 + 0.40e1_dp*t102*t329 - 0.20e1_dp*t102*t376 t380 = t84*t379 t383 = t42*omega t384 = t45*t207 t387 = t384*t237 - t392 = 0.9000000000e1_dp*t260-0.6000000000e1_dp*t264 + t392 = 0.9000000000e1_dp*t260 - 0.6000000000e1_dp*t264 t393 = t392*t149 t394 = t393*t160 t398 = 0.1e1_dp/t41/t176 @@ -655,9 +655,9 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t406 = t68*t140 t413 = t25*t237 t417 = t194*my_rho - t424 = 0.2250000000e1_dp*t400*t401*t237-0.5000000000e0_dp*t405 & - *t406*t17-0.1500000000e1_dp*t151*t50*t379+0.1500000000e1_dp & - *t405*t156*t413+0.2000000000e1_dp*t155*t417*t225-0.3000000000e1_dp & + t424 = 0.2250000000e1_dp*t400*t401*t237 - 0.5000000000e0_dp*t405 & + *t406*t17 - 0.1500000000e1_dp*t151*t50*t379 + 0.1500000000e1_dp & + *t405*t156*t413 + 0.2000000000e1_dp*t155*t417*t225 - 0.3000000000e1_dp & *t49*t245*t25 t425 = t149*t424 t428 = omega*t150 @@ -680,9 +680,9 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t478 = t178*pi t479 = t56*t140 t489 = t27*my_rho - t496 = -0.1800000000e2_dp*t473*t474*t237+0.5999999999e1_dp*t478 & - *t479*t17+0.8999999998e1_dp*t178*t62*t379-0.1800000000e2_dp & - *t478*t183*t413-0.6000000000e1_dp*t182*t489*t225+0.1800000000e2_dp & + t496 = -0.1800000000e2_dp*t473*t474*t237 + 0.5999999999e1_dp*t478 & + *t479*t17 + 0.8999999998e1_dp*t178*t62*t379 - 0.1800000000e2_dp & + *t478*t183*t413 - 0.6000000000e1_dp*t182*t489*t225 + 0.1800000000e2_dp & *t61*t262*t25 t498 = t187*t266 t500 = t58*t379 @@ -699,40 +699,40 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t530 = t68*t496 t531 = t530*t65 t534 = t199*t267 - t537 = t496*t65+t498*t65-0.5555555558e-1_dp*t500*t71+0.3703703705e-1_dp & - *t503*t271-0.5555555558e-1_dp*t503*t275-0.1111111112e0_dp & - *t508*t196+0.1851851853e0_dp*t192*t512-0.1111111112e0_dp & - *t516*t517-0.1111111112e0_dp*t192*t520-0.5555555558e-1_dp & - *t508*t200+0.3703703705e-1_dp*t192*t527-0.5555555558e-1_dp & - *t192*t531-0.5555555558e-1_dp*t192*t534 - t541 = (2*t147*t394)+(2*t147*t425)-0.8333333335e-1_dp & - *t429*t166*t290-0.5555555557e-1_dp*t165*t171*t433+ & - 0.1666666667e0_dp*t165*t437*t140+0.1666666667e0_dp*t165*t166 & - *t379+0.1666666667e0_dp*t445*t446*t413-0.4444444445e0_dp*t170 & - *t450*t451+0.3333333334e0_dp*t170*t455*t172+0.3333333334e0_dp & - *t170*t171*t25+0.1666666667e0_dp*t165*t462*t237- & - 0.1111111111e0_dp*t170*t466*t17+0.3333333334e0_dp*t55*t57* & + t537 = t496*t65 + t498*t65 - 0.5555555558e-1_dp*t500*t71 + 0.3703703705e-1_dp & + *t503*t271 - 0.5555555558e-1_dp*t503*t275 - 0.1111111112e0_dp & + *t508*t196 + 0.1851851853e0_dp*t192*t512 - 0.1111111112e0_dp & + *t516*t517 - 0.1111111112e0_dp*t192*t520 - 0.5555555558e-1_dp & + *t508*t200 + 0.3703703705e-1_dp*t192*t527 - 0.5555555558e-1_dp & + *t192*t531 - 0.5555555558e-1_dp*t192*t534 + t541 = (2*t147*t394) + (2*t147*t425) - 0.8333333335e-1_dp & + *t429*t166*t290 - 0.5555555557e-1_dp*t165*t171*t433 + & + 0.1666666667e0_dp*t165*t437*t140 + 0.1666666667e0_dp*t165*t166 & + *t379 + 0.1666666667e0_dp*t445*t446*t413 - 0.4444444445e0_dp*t170 & + *t450*t451 + 0.3333333334e0_dp*t170*t455*t172 + 0.3333333334e0_dp & + *t170*t171*t25 + 0.1666666667e0_dp*t165*t462*t237 - & + 0.1111111111e0_dp*t170*t466*t17 + 0.3333333334e0_dp*t55*t57* & t537 - e_rho(ii) = e_rho(ii)+(-0.4444444448e0_dp*t214*t79-0.6666666672e0_dp*t217*t46 & - *t78*t237-0.4444444448e0_dp*t43*t283+t8*(-0.3333333336e0_dp & - *t55*t141-0.1666666668e0_dp*t289*t84*t290-0.3333333336e0_dp & - *t83*t295-0.3333333336e0_dp*t83*t380-0.2222222224e0_dp*t383 & - *t384-0.3333333336e0_dp*t83*t387-0.2222222224e0_dp*t144* & - t46*t541))*sx + e_rho(ii) = e_rho(ii) + (-0.4444444448e0_dp*t214*t79 - 0.6666666672e0_dp*t217*t46 & + *t78*t237 - 0.4444444448e0_dp*t43*t283 + t8*(-0.3333333336e0_dp & + *t55*t141 - 0.1666666668e0_dp*t289*t84*t290 - 0.3333333336e0_dp & + *t83*t295 - 0.3333333336e0_dp*t83*t380 - 0.2222222224e0_dp*t383 & + *t384 - 0.3333333336e0_dp*t83*t387 - 0.2222222224e0_dp*t144* & + t46*t541))*sx t550 = beta*t25 t551 = t27*t31 - t557 = 0.60e1_dp*t550*t551+0.60e1_dp*t24*t23*t132 + t557 = 0.60e1_dp*t550*t551 + 0.60e1_dp*t24*t23*t132 t558 = t105*t557 - t561 = 0.40e1_dp*t24*t37-0.20e1_dp*t102*t558 + t561 = 0.40e1_dp*t24*t37 - 0.20e1_dp*t102*t558 t566 = pi*t146 t567 = t566*t149 t569 = t151*t19*t561 t575 = t20*t561 t579 = t58*t561 - t585 = 0.8999999998e1_dp*t478*t575*t65-0.5555555558e-1_dp*t579 & - *t71-0.5000000001e0_dp*t60*t561*t65 - t589 = -0.3000000000e1_dp*t567*t569+0.1666666667e0_dp*t165*t166 & - *t561+0.3333333334e0_dp*t55*t57*t585 + t585 = 0.8999999998e1_dp*t478*t575*t65 - 0.5555555558e-1_dp*t579 & + *t71 - 0.5000000001e0_dp*t60*t561*t65 + t589 = -0.3000000000e1_dp*t567*t569 + 0.1666666667e0_dp*t165*t166 & + *t561 + 0.3333333334e0_dp*t55*t57*t585 t590 = t46*t589 t593 = t140*t561 t597 = t45*t589 @@ -745,28 +745,28 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t624 = beta*t11 t627 = t97*t132 t628 = t627*my_rho - t635 = -4*t108+4*t332*my_rho + t635 = -4*t108 + 4*t332*my_rho t637 = t27*t635*t132 t640 = 0.1e1_dp/t308 - t645 = -0.240e2_dp*beta*t107*t551-0.240e2_dp*t24*t87*t132+ & - 0.240e2_dp*t624*t116+0.240e2_dp*t605*t628+0.60e1_dp*t550*t133 & - +0.60e1_dp*t119*t637-0.60e1_dp*t7*t640*t126*t371 + t645 = -0.240e2_dp*beta*t107*t551 - 0.240e2_dp*t24*t87*t132 + & + 0.240e2_dp*t624*t116 + 0.240e2_dp*t605*t628 + 0.60e1_dp*t550*t133 & + + 0.60e1_dp*t119*t637 - 0.60e1_dp*t7*t640*t126*t371 t646 = t105*t645 - t649 = -0.320e2_dp*t24*t88+0.160e2_dp*t302*t558+0.320e2_dp*t605 & - *t99-0.160e2_dp*t93*t609-0.40e1_dp*t112*t137+0.40e1_dp*t102 & - *t615-0.20e1_dp*t102*t646 + t649 = -0.320e2_dp*t24*t88 + 0.160e2_dp*t302*t558 + 0.320e2_dp*t605 & + *t99 - 0.160e2_dp*t93*t609 - 0.40e1_dp*t112*t137 + 0.40e1_dp*t102 & + *t615 - 0.20e1_dp*t102*t646 t650 = t84*t649 t653 = t384*t561 t657 = t44*pi*t146 t658 = t657*t178 t668 = t25*t561 - t672 = 0.2250000000e1_dp*t400*t401*t561-0.1500000000e1_dp*t151 & - *t50*t649+0.1500000000e1_dp*t405*t156*t668 + t672 = 0.2250000000e1_dp*t400*t401*t561 - 0.1500000000e1_dp*t151 & + *t50*t649 + 0.1500000000e1_dp*t405*t156*t668 t673 = t149*t672 t679 = t56*t585 t689 = t27*t585 - t705 = -0.1800000000e2_dp*t473*t474*t561+0.8999999998e1_dp*t178 & - *t62*t649-0.1800000000e2_dp*t478*t183*t668 + t705 = -0.1800000000e2_dp*t473*t474*t561 + 0.8999999998e1_dp*t178 & + *t62*t649 - 0.1800000000e2_dp*t478*t183*t668 t707 = t187*t59 t708 = t707*t177 t709 = t561*t65 @@ -779,19 +779,19 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t728 = t68*t705 t729 = t728*t65 t732 = t60*t187 - t735 = t705*t65+0.8999999998e1_dp*t708*t710-0.5555555558e-1_dp & - *t713*t71-0.5000000001e0_dp*t716*t709-0.1111111112e0_dp*t719 & - *t196-0.1000000001e1_dp*t723*t709-0.5555555558e-1_dp*t719* & - t200-0.5555555558e-1_dp*t192*t729-0.5000000001e0_dp*t732*t709 - t739 = 0.1800000000e2_dp*t658*t575*t161+(2*t147*t673) & - -0.8333333335e-1_dp*t429*t166*t593+0.1666666667e0_dp*t165*t679 & - *t140+0.1666666667e0_dp*t165*t166*t649+0.1666666667e0_dp & - *t445*t446*t668+0.3333333334e0_dp*t170*t689*t172+0.1666666667e0_dp & - *t165*t462*t561+0.3333333334e0_dp*t55*t57*t735 - e_ndrho(ii) = e_ndrho(ii)+(-0.6666666672e0_dp*t217*t46*t78*t561-0.4444444448e0_dp & - *t43*t590+t8*(-0.1666666668e0_dp*t289*t84*t593-0.3333333336e0_dp & - *t83*t598-0.3333333336e0_dp*t83*t650-0.3333333336e0_dp & - *t83*t653-0.2222222224e0_dp*t144*t46*t739))*sx + t735 = t705*t65 + 0.8999999998e1_dp*t708*t710 - 0.5555555558e-1_dp & + *t713*t71 - 0.5000000001e0_dp*t716*t709 - 0.1111111112e0_dp*t719 & + *t196 - 0.1000000001e1_dp*t723*t709 - 0.5555555558e-1_dp*t719* & + t200 - 0.5555555558e-1_dp*t192*t729 - 0.5000000001e0_dp*t732*t709 + t739 = 0.1800000000e2_dp*t658*t575*t161 + (2*t147*t673) & + - 0.8333333335e-1_dp*t429*t166*t593 + 0.1666666667e0_dp*t165*t679 & + *t140 + 0.1666666667e0_dp*t165*t166*t649 + 0.1666666667e0_dp & + *t445*t446*t668 + 0.3333333334e0_dp*t170*t689*t172 + 0.1666666667e0_dp & + *t165*t462*t561 + 0.3333333334e0_dp*t55*t57*t735 + e_ndrho(ii) = e_ndrho(ii) + (-0.6666666672e0_dp*t217*t46*t78*t561 - 0.4444444448e0_dp & + *t43*t590 + t8*(-0.1666666668e0_dp*t289*t84*t593 - 0.3333333336e0_dp & + *t83*t598 - 0.3333333336e0_dp*t83*t650 - 0.3333333336e0_dp & + *t83*t653 - 0.2222222224e0_dp*t144*t46*t739))*sx END IF IF (grad_deriv >= 2 .OR. grad_deriv == -2) THEN @@ -815,15 +815,15 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t795 = 0.1e1_dp/t19/t790/t792 t796 = 0.1e1_dp/t787/t13*t795 t797 = t796*t371 - t800 = 0.1866666667e2_dp*t24*t777*t341*t31+0.4000000000e2_dp* & - t7*t782-0.1066666667e2_dp*t786*t797 + t800 = 0.1866666667e2_dp*t24*t777*t341*t31 + 0.4000000000e2_dp* & + t7*t782 - 0.1066666667e2_dp*t786*t797 t801 = t105*t800 - t804 = 0.1955555555e2_dp*t7*t766+0.1066666667e2_dp*t321*t769+ & - 0.40e1_dp*t102*t773-0.20e1_dp*t102*t801 + t804 = 0.1955555555e2_dp*t7*t766 + 0.1066666667e2_dp*t321*t769 + & + 0.40e1_dp*t102*t773 - 0.20e1_dp*t102*t801 t815 = t68*t237 t822 = t44*t194 - t826 = 0.2250000000e1_dp*t399*t50*t754-0.1000000000e1_dp*t405* & - t815*t17-0.1500000000e1_dp*t151*t50*t804-0.6666666667e0_dp & + t826 = 0.2250000000e1_dp*t399*t50*t754 - 0.1000000000e1_dp*t405* & + t815*t17 - 0.1500000000e1_dp*t151*t50*t804 - 0.6666666667e0_dp & *t49*t822*t14 t827 = t149*t826 t833 = t237*t17 @@ -833,7 +833,7 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t857 = t178*t62*t804 t859 = pi*t27 t862 = 0.2000000000e1_dp*t61*t859*t14 - t863 = -t851+t855+0.8999999998e1_dp*t857+t862 + t863 = -t851 + t855 + 0.8999999998e1_dp*t857 + t862 t864 = t863*t65 t865 = t266**2 t866 = t865*t65 @@ -844,15 +844,15 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t881 = t68*t863 t882 = t881*t65 t886 = t68*t865*t65 - t889 = t864+t866-0.5555555558e-1_dp*t867*t71+0.7407407410e-1_dp & - *t508*t271-0.1111111112e0_dp*t508*t275-0.6172839508e-1_dp* & - t192*t874+0.7407407410e-1_dp*t192*t878-0.5555555558e-1_dp*t192 & - *t882-0.5555555558e-1_dp*t192*t886 - t893 = (2*t147*t393*t249)+(2*t147*t827)-0.8333333335e-1_dp & - *t429*t166*t754-0.1111111111e0_dp*t165*t171*t833 & - +0.3333333334e0_dp*t165*t437*t237+0.1666666667e0_dp*t165 & - *t166*t804+0.1481481481e0_dp*t170*t450*t14-0.2222222222e0_dp & - *t170*t455*t17+0.3333333334e0_dp*t55*t57*t889 + t889 = t864 + t866 - 0.5555555558e-1_dp*t867*t71 + 0.7407407410e-1_dp & + *t508*t271 - 0.1111111112e0_dp*t508*t275 - 0.6172839508e-1_dp* & + t192*t874 + 0.7407407410e-1_dp*t192*t878 - 0.5555555558e-1_dp*t192 & + *t882 - 0.5555555558e-1_dp*t192*t886 + t893 = (2*t147*t393*t249) + (2*t147*t827) - 0.8333333335e-1_dp & + *t429*t166*t754 - 0.1111111111e0_dp*t165*t171*t833 & + + 0.3333333334e0_dp*t165*t437*t237 + 0.1666666667e0_dp*t165 & + *t166*t804 + 0.1481481481e0_dp*t170*t450*t14 - 0.2222222222e0_dp & + *t170*t455*t17 + 0.3333333334e0_dp*t55*t57*t889 t894 = t46*t893 t897 = t78*t140 t905 = my_rho*t150 @@ -909,7 +909,7 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t1034 = 0.1e1_dp/t1033 t1036 = t1034*t126*t371 t1040 = my_ndrho*t764 - t1044 = -0.280e3_dp/0.9e1_dp*t356*t341+0.280e3_dp/0.9e1_dp*t1040* & + t1044 = -0.280e3_dp/0.9e1_dp*t356*t341 + 0.280e3_dp/0.9e1_dp*t1040* & t1002*my_rho t1046 = t27*t1044*t132 t1050 = t368*t360*t371 @@ -919,19 +919,19 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t1058 = 0.1e1_dp/t131/t1056 t1059 = t126*t1058 t1060 = t1059*t220 - t1063 = -0.1866666667e3_dp*t24*t987*t31-0.2240000000e3_dp*t7* & - t991+0.4266666667e2_dp*t786*t997+0.1866666667e3_dp*t1000*t1004 & - +0.2240000000e3_dp*t941*t1008-0.4266666667e2_dp*t786*t1012 & - *t1021+0.1866666667e2_dp*t1024*t1026-0.1600000000e2_dp*t350 & - *t1030-0.5066666667e2_dp*t366*t1036+0.60e1_dp*t119*t1046+ & - 0.1600000000e2_dp*t366*t1050+0.3200000000e2_dp*t1055*t1060 + t1063 = -0.1866666667e3_dp*t24*t987*t31 - 0.2240000000e3_dp*t7* & + t991 + 0.4266666667e2_dp*t786*t997 + 0.1866666667e3_dp*t1000*t1004 & + + 0.2240000000e3_dp*t941*t1008 - 0.4266666667e2_dp*t786*t1012 & + *t1021 + 0.1866666667e2_dp*t1024*t1026 - 0.1600000000e2_dp*t350 & + *t1030 - 0.5066666667e2_dp*t366*t1036 + 0.60e1_dp*t119*t1046 + & + 0.1600000000e2_dp*t366*t1050 + 0.3200000000e2_dp*t1055*t1060 t1064 = t105*t1063 - t1067 = -0.2737777778e3_dp*t7*t930-0.1173333333e3_dp*t93*t769- & - 0.320e2_dp*t302*t773+0.160e2_dp*t302*t801+0.2737777778e3_dp* & - t941*t946+0.1173333333e3_dp*t307*t950+0.320e2_dp*t93*t955 & - -0.160e2_dp*t93*t959-0.1955555555e2_dp*t962*t963-0.2133333334e2_dp & - *t321*t966+0.1066666667e2_dp*t321*t969-0.120e2_dp*t102 & - *t976+0.80e1_dp*t102*t980+0.40e1_dp*t102*t984-0.20e1_dp*t102 & + t1067 = -0.2737777778e3_dp*t7*t930 - 0.1173333333e3_dp*t93*t769 - & + 0.320e2_dp*t302*t773 + 0.160e2_dp*t302*t801 + 0.2737777778e3_dp* & + t941*t946 + 0.1173333333e3_dp*t307*t950 + 0.320e2_dp*t93*t955 & + - 0.160e2_dp*t93*t959 - 0.1955555555e2_dp*t962*t963 - 0.2133333334e2_dp & + *t321*t966 + 0.1066666667e2_dp*t321*t969 - 0.120e2_dp*t102 & + *t976 + 0.80e1_dp*t102*t980 + 0.40e1_dp*t102*t984 - 0.20e1_dp*t102 & *t1064 t1068 = t84*t1067 t1071 = t45*t541 @@ -965,22 +965,22 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t1168 = t25*t754 t1172 = t225*t237 t1176 = t56*t25 - t1189 = 0.5400000000e2_dp*t1143*t474*t754-0.2400000000e2_dp*t473 & - *t479*t833-0.3600000000e2_dp*t473*t1150*t237-0.1800000000e2_dp & - *t473*t474*t804-0.2000000000e1_dp*t478*t1157*t14+ & - 0.1200000000e2_dp*t478*t1161*t17+0.8999999998e1_dp*t178*t62 & - *t1067+0.3600000000e2_dp*t473*t183*t1168+0.1200000000e2_dp* & - t478*t489*t1172-0.3600000000e2_dp*t478*t1176*t237-0.1800000000e2_dp & - *t478*t183*t1093+0.8000000000e1_dp*t182*t123* & - t777-0.1200000000e2_dp*t61*t859*t225 - t1191 = (t1097*t65)-0.4938271608e0_dp*t192*t1101-0.6172839508e-1_dp & - *t503*t874-0.1111111112e0_dp*t1106*t275+(t1109 & - *t65)+(2*t1111*t65)+0.3703703706e0_dp*t508*t512+ & - 0.7407407410e-1_dp*t503*t878+0.7407407410e-1_dp*t192*t1119-0.5555555558e-1_dp & - *t192*t1122-0.2222222224e0_dp*t192*t1126-0.1111111112e0_dp & - *t1129*t196-0.5555555558e-1_dp*t503*t882-0.1111111112e0_dp & - *t516*t1134-0.2222222224e0_dp*t1137*t517+(t1189 & - *t65) + t1189 = 0.5400000000e2_dp*t1143*t474*t754 - 0.2400000000e2_dp*t473 & + *t479*t833 - 0.3600000000e2_dp*t473*t1150*t237 - 0.1800000000e2_dp & + *t473*t474*t804 - 0.2000000000e1_dp*t478*t1157*t14 + & + 0.1200000000e2_dp*t478*t1161*t17 + 0.8999999998e1_dp*t178*t62 & + *t1067 + 0.3600000000e2_dp*t473*t183*t1168 + 0.1200000000e2_dp* & + t478*t489*t1172 - 0.3600000000e2_dp*t478*t1176*t237 - 0.1800000000e2_dp & + *t478*t183*t1093 + 0.8000000000e1_dp*t182*t123* & + t777 - 0.1200000000e2_dp*t61*t859*t225 + t1191 = (t1097*t65) - 0.4938271608e0_dp*t192*t1101 - 0.6172839508e-1_dp & + *t503*t874 - 0.1111111112e0_dp*t1106*t275 + (t1109 & + *t65) + (2*t1111*t65) + 0.3703703706e0_dp*t508*t512 + & + 0.7407407410e-1_dp*t503*t878 + 0.7407407410e-1_dp*t192*t1119 - 0.5555555558e-1_dp & + *t192*t1122 - 0.2222222224e0_dp*t192*t1126 - 0.1111111112e0_dp & + *t1129*t196 - 0.5555555558e-1_dp*t503*t882 - 0.1111111112e0_dp & + *t516*t1134 - 0.2222222224e0_dp*t1137*t517 + (t1189 & + *t65) t1192 = t67*t22 t1193 = t66*t1192 t1194 = t267*t451 @@ -994,33 +994,33 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t1221 = t498*t526 t1224 = t530*t267 t1235 = t199*t864 - t1238 = 0.3703703706e0_dp*t1193*t1194-0.5555555558e-1_dp*t503*t886 & - -0.6172839508e-1_dp*t192*t1201-0.5555555558e-1_dp*t1129*t200 & - -0.5555555558e-1_dp*t192*t1207-0.5555555558e-1_dp*t1210*t71 & - +0.3703703706e0_dp*t192*t1213-0.1111111112e0_dp*t516*t1216 & - -0.1111111112e0_dp*t508*t534+0.7407407410e-1_dp*t516*t1221- & - 0.1111111112e0_dp*t192*t1224+0.7407407410e-1_dp*t508*t527+0.7407407410e-1_dp & - *t1106*t271-0.1111111112e0_dp*t508*t531-0.2222222224e0_dp & - *t508*t520-0.5555555558e-1_dp*t192*t1235 - t1239 = t1191+t1238 + t1238 = 0.3703703706e0_dp*t1193*t1194 - 0.5555555558e-1_dp*t503*t886 & + - 0.6172839508e-1_dp*t192*t1201 - 0.5555555558e-1_dp*t1129*t200 & + - 0.5555555558e-1_dp*t192*t1207 - 0.5555555558e-1_dp*t1210*t71 & + + 0.3703703706e0_dp*t192*t1213 - 0.1111111112e0_dp*t516*t1216 & + - 0.1111111112e0_dp*t508*t534 + 0.7407407410e-1_dp*t516*t1221 - & + 0.1111111112e0_dp*t192*t1224 + 0.7407407410e-1_dp*t508*t527 + 0.7407407410e-1_dp & + *t1106*t271 - 0.1111111112e0_dp*t508*t531 - 0.2222222224e0_dp & + *t508*t520 - 0.5555555558e-1_dp*t192*t1235 + t1239 = t1191 + t1238 t1246 = t428*t444 t1247 = t74*t140 t1254 = t27*t889 t1264 = t27*t537 t1268 = t341*t74 t1275 = t56*t889 - t1283 = -t851+t855+0.9000000000e1_dp*t857+t862 + t1283 = -t851 + t855 + 0.9000000000e1_dp*t857 + t862 t1284 = t1283*t149 - t1288 = -0.1111111111e0_dp*t165*t171*t1085-0.8888888890e0_dp*t170 & - *t1089*t451+0.1666666667e0_dp*t445*t446*t1093+0.3333333334e0_dp & - *t55*t57*t1239-0.8333333335e-1_dp*t429*t462*t754 & - +0.5555555556e-1_dp*t1246*t1247*t833+(4*t147*t393* & - t424)+0.3333333334e0_dp*t170*t1254*t172-0.1111111111e0_dp*t165 & - *t466*t833+0.3333333334e0_dp*t165*t437*t379-0.2222222222e0_dp & - *t170*t1264*t17+0.1037037037e1_dp*t170*t1268*t1100 & - +0.1666666667e0_dp*t165*t166*t1067+0.1666666667e0_dp*t165* & - t1275*t140-0.8333333335e-1_dp*t1246*t446*t1168+(2* & - t147*t1284*t160) + t1288 = -0.1111111111e0_dp*t165*t171*t1085 - 0.8888888890e0_dp*t170 & + *t1089*t451 + 0.1666666667e0_dp*t445*t446*t1093 + 0.3333333334e0_dp & + *t55*t57*t1239 - 0.8333333335e-1_dp*t429*t462*t754 & + + 0.5555555556e-1_dp*t1246*t1247*t833 + (4*t147*t393* & + t424) + 0.3333333334e0_dp*t170*t1254*t172 - 0.1111111111e0_dp*t165 & + *t466*t833 + 0.3333333334e0_dp*t165*t437*t379 - 0.2222222222e0_dp & + *t170*t1264*t17 + 0.1037037037e1_dp*t170*t1268*t1100 & + + 0.1666666667e0_dp*t165*t166*t1067 + 0.1666666667e0_dp*t165* & + t1275*t140 - 0.8333333335e-1_dp*t1246*t446*t1168 + (2* & + t147*t1284*t160) t1292 = t278*my_rho t1300 = 0.1e1_dp/t41/t470 t1301 = t47*t1300 @@ -1030,14 +1030,14 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t1320 = t68*t379 t1333 = t68*t25 t1340 = t22*my_rho - t1347 = -0.5625000000e1_dp*t1302*t401*t754+0.1500000000e1_dp*t400 & - *t406*t833+0.4500000000e1_dp*t400*t1309*t237+0.2250000000e1_dp & - *t400*t401*t804+0.3333333333e0_dp*t405*t1316*t14 & - -0.1000000000e1_dp*t405*t1320*t17-0.1500000000e1_dp*t151*t50 & - *t1067-0.2250000000e1_dp*t400*t156*t1168-0.2000000000e1_dp & - *t405*t417*t1172+0.3000000000e1_dp*t405*t1333*t237+0.1500000000e1_dp & - *t405*t156*t1093-0.3333333333e1_dp*t155*t1340 & - *t777+0.4000000000e1_dp*t49*t822*t225 + t1347 = -0.5625000000e1_dp*t1302*t401*t754 + 0.1500000000e1_dp*t400 & + *t406*t833 + 0.4500000000e1_dp*t400*t1309*t237 + 0.2250000000e1_dp & + *t400*t401*t804 + 0.3333333333e0_dp*t405*t1316*t14 & + - 0.1000000000e1_dp*t405*t1320*t17 - 0.1500000000e1_dp*t151*t50 & + *t1067 - 0.2250000000e1_dp*t400*t156*t1168 - 0.2000000000e1_dp & + *t405*t417*t1172 + 0.3000000000e1_dp*t405*t1333*t237 + 0.1500000000e1_dp & + *t405*t156*t1093 - 0.3333333333e1_dp*t155*t1340 & + *t777 + 0.4000000000e1_dp*t49*t822*t225 t1348 = t149*t1347 t1360 = t140*t14 t1367 = omega*t398 @@ -1048,30 +1048,30 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t1387 = t392**2 t1388 = t1387*t149 t1392 = t56*t537 - t1396 = 0.6666666668e0_dp*t170*t455*t25+0.3333333334e0_dp*t445 & - *t1292*t413+0.1666666667e0_dp*t165*t462*t804+(2*t147 & - *t1348)-0.1111111111e0_dp*t165*t455*t433-0.8333333335e-1_dp & - *t429*t166*t918+0.3333333334e0_dp*t165*t171*t413+0.7407407409e-1_dp & - *t165*t450*t1360-0.1666666667e0_dp*t429*t437 & - *t290+0.1250000000e0_dp*t1368*t166*t907-0.4444444445e0_dp*t1373 & - *t446*t1172+0.1481481481e0_dp*t170*t1377*t14-0.8888888890e0_dp & - *t170*t450*t225-0.1666666667e0_dp*t429*t166*t914 & - +(2*t147*t1388*t160)+0.3333333334e0_dp*t165*t1392 & + t1396 = 0.6666666668e0_dp*t170*t455*t25 + 0.3333333334e0_dp*t445 & + *t1292*t413 + 0.1666666667e0_dp*t165*t462*t804 + (2*t147 & + *t1348) - 0.1111111111e0_dp*t165*t455*t433 - 0.8333333335e-1_dp & + *t429*t166*t918 + 0.3333333334e0_dp*t165*t171*t413 + 0.7407407409e-1_dp & + *t165*t450*t1360 - 0.1666666667e0_dp*t429*t437 & + *t290 + 0.1250000000e0_dp*t1368*t166*t907 - 0.4444444445e0_dp*t1373 & + *t446*t1172 + 0.1481481481e0_dp*t170*t1377*t14 - 0.8888888890e0_dp & + *t170*t450*t225 - 0.1666666667e0_dp*t429*t166*t914 & + + (2*t147*t1388*t160) + 0.3333333334e0_dp*t165*t1392 & *t237 - t1397 = t1288+t1396 - t1401 = -0.3333333336e0_dp*t165*t897*t237-0.6666666672e0_dp*t55 & - *t295-0.6666666672e0_dp*t55*t380+0.8333333340e-1_dp*t906*t84 & - *t907-0.3333333336e0_dp*t289*t294*t290-0.3333333336e0_dp* & - t289*t84*t914-0.1666666668e0_dp*t289*t84*t918-0.3333333336e0_dp & - *t83*t923-0.6666666672e0_dp*t83*t926-0.3333333336e0_dp & - *t83*t1068-0.4444444448e0_dp*t383*t1071-0.6666666672e0_dp* & - t55*t387-0.1666666668e0_dp*t289*t1076-0.6666666672e0_dp*t83 & - *t1079-0.3333333336e0_dp*t83*t1082-0.2222222224e0_dp*t144*t46 & + t1397 = t1288 + t1396 + t1401 = -0.3333333336e0_dp*t165*t897*t237 - 0.6666666672e0_dp*t55 & + *t295 - 0.6666666672e0_dp*t55*t380 + 0.8333333340e-1_dp*t906*t84 & + *t907 - 0.3333333336e0_dp*t289*t294*t290 - 0.3333333336e0_dp* & + t289*t84*t914 - 0.1666666668e0_dp*t289*t84*t918 - 0.3333333336e0_dp & + *t83*t923 - 0.6666666672e0_dp*t83*t926 - 0.3333333336e0_dp & + *t83*t1068 - 0.4444444448e0_dp*t383*t1071 - 0.6666666672e0_dp* & + t55*t387 - 0.1666666668e0_dp*t289*t1076 - 0.6666666672e0_dp*t83 & + *t1079 - 0.3333333336e0_dp*t83*t1082 - 0.2222222224e0_dp*t144*t46 & *t1397 - e_rho_rho(ii) = e_rho_rho(ii)+(-0.1333333334e1_dp*t747*t84*t237-0.8888888896e0_dp*t214 & - *t283-0.3333333336e0_dp*t753*t46*t78*t754-0.1333333334e1_dp & - *t217*t46*t282*t237-0.6666666672e0_dp*t217*t46*t78* & - t804-0.4444444448e0_dp*t43*t894+t8*t1401)*sx + e_rho_rho(ii) = e_rho_rho(ii) + (-0.1333333334e1_dp*t747*t84*t237 - 0.8888888896e0_dp*t214 & + *t283 - 0.3333333336e0_dp*t753*t46*t78*t754 - 0.1333333334e1_dp & + *t217*t46*t282*t237 - 0.6666666672e0_dp*t217*t46*t78* & + t804 - 0.4444444448e0_dp*t43*t894 + t8*t1401)*sx t1406 = 0.6666666672e0_dp*t747*t84*t561 t1408 = 0.4444444448e0_dp*t214*t590 t1409 = t4*t164 @@ -1087,18 +1087,18 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t1438 = 0.1e1_dp/t19/t1436 t1439 = 0.1e1_dp/t787/t16*t1438 t1440 = t1439*t371 - t1443 = -0.8000000000e1_dp*t1429*t115-0.2400000000e2_dp*t24*t230 & - +0.8000000000e1_dp*t366*t1440 + t1443 = -0.8000000000e1_dp*t1429*t115 - 0.2400000000e2_dp*t24*t230 & + + 0.8000000000e1_dp*t366*t1440 t1444 = t105*t1443 - t1447 = -0.1066666667e2_dp*t24*t221+0.5333333333e1_dp*t321*t1420 & - -0.40e1_dp*t112*t234+0.40e1_dp*t102*t1426-0.20e1_dp*t102* & + t1447 = -0.1066666667e2_dp*t24*t221 + 0.5333333333e1_dp*t321*t1420 & + - 0.40e1_dp*t112*t234 + 0.40e1_dp*t102*t1426 - 0.20e1_dp*t102* & t1444 t1451 = 0.6666666672e0_dp*t217*t46*t78*t1447 t1455 = 0.6666666672e0_dp*t217*t46*t282*t561 t1459 = t19*t237 t1466 = t68*t17 - t1470 = 0.2250000000e1_dp*t400*t1459*t561-0.1500000000e1_dp*t151 & - *t50*t1447-0.5000000000e0_dp*t405*t1466*t561 + t1470 = 0.2250000000e1_dp*t400*t1459*t561 - 0.1500000000e1_dp*t151 & + *t50*t1447 - 0.5000000000e0_dp*t405*t1466*t561 t1471 = t149*t1470 t1476 = 0.8333333335e-1_dp*t429*t166*t1410 t1479 = 0.1666666667e0_dp*t165*t679*t237 @@ -1112,7 +1112,7 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t1498 = t178*t62*t1447 t1500 = t56*t17 t1502 = t478*t1500*t561 - t1504 = -t1496+0.8999999998e1_dp*t1498+0.5999999999e1_dp*t1502 + t1504 = -t1496 + 0.8999999998e1_dp*t1498 + 0.5999999999e1_dp*t1502 t1505 = t1504*t65 t1506 = t266*t59 t1507 = t1506*t177 @@ -1128,11 +1128,11 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t1525 = t68*t1504*t65 t1528 = t60*t266 t1530 = 0.5000000001e0_dp*t1528*t709 - t1531 = t1505+t1509-t1512-t1515+t1517+0.3333333334e0_dp*t1519 & - *t709-t1523-0.5555555558e-1_dp*t192*t1525-t1530 - t1535 = 0.1800000000e2_dp*t658*t575*t250+(2*t147*t1471) & - -t1476+t1479+t1482-0.5555555555e-1_dp*t1485-t1489+t1492 & - +0.3333333334e0_dp*t55*t57*t1531 + t1531 = t1505 + t1509 - t1512 - t1515 + t1517 + 0.3333333334e0_dp*t1519 & + *t709 - t1523 - 0.5555555558e-1_dp*t192*t1525 - t1530 + t1535 = 0.1800000000e2_dp*t658*t575*t250 + (2*t147*t1471) & + - t1476 + t1479 + t1482 - 0.5555555555e-1_dp*t1485 - t1489 + t1492 & + + 0.3333333334e0_dp*t55*t57*t1531 t1536 = t46*t1535 t1541 = 0.1666666668e0_dp*t165*t897*t561 t1543 = 0.3333333336e0_dp*t55*t598 @@ -1207,7 +1207,7 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t1660 = 0.8000000000e1_dp*t350*t1658 t1662 = 0.3200000000e2_dp*t7*t372 t1664 = 0.60e1_dp*t550*t362 - t1667 = 0.28e2_dp/0.3e1_dp*t332-0.28e2_dp/0.3e1_dp*t987*my_rho + t1667 = 0.28e2_dp/0.3e1_dp*t332 - 0.28e2_dp/0.3e1_dp*t987*my_rho t1669 = t27*t1667*t132 t1671 = 0.60e1_dp*t119*t1669 t1675 = 0.60e1_dp*t7*t640*t360*t371 @@ -1215,13 +1215,13 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t1679 = 0.8000000000e1_dp*t366*t1677 t1680 = t786*t368 t1681 = t1059*t23 - t1684 = t1636+t1638-t1644-t1647-t1649+t1654-t1656-t1660 & - +t1662+t1664+t1671-t1675+t1679-0.2400000000e2_dp*t1680 & + t1684 = t1636 + t1638 - t1644 - t1647 - t1649 + t1654 - t1656 - t1660 & + + t1662 + t1664 + t1671 - t1675 + t1679 - 0.2400000000e2_dp*t1680 & *t1681 t1685 = t105*t1684 - t1688 = t1579-t1581+t1584-t1586+t1588-t1591+t1594-t1596 & - +t1601-t1605+t1607-t1610+t1613+t1615-t1620+t1624 & - +t1628-t1630+t1634-0.20e1_dp*t102*t1685 + t1688 = t1579 - t1581 + t1584 - t1586 + t1588 - t1591 + t1594 - t1596 & + + t1601 - t1605 + t1607 - t1610 + t1613 + t1615 - t1620 + t1624 & + + t1628 - t1630 + t1634 - 0.20e1_dp*t102*t1685 t1689 = t84*t1688 t1693 = 0.3333333336e0_dp*t55*t653 t1694 = t45*t739 @@ -1258,10 +1258,10 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t1754 = 0.5555555558e-1_dp*t1715*t275 t1755 = t1510*t67 t1757 = 0.1111111112e0_dp*t1755*t196 - t1758 = t1709*t65-t1714+t1717+t1719-t1724+t1728-t1730 & - -0.5555555558e-1_dp*t1731*t71+t1735+0.666666666e0_dp*t1519* & - t1737+t1743+0.3333333334e0_dp*t1519*t1745+0.3333333334e0_dp* & - t1748*t1722+t1752-t1754-t1757 + t1758 = t1709*t65 - t1714 + t1717 + t1719 - t1724 + t1728 - t1730 & + - 0.5555555558e-1_dp*t1731*t71 + t1735 + 0.666666666e0_dp*t1519* & + t1737 + t1743 + 0.3333333334e0_dp*t1519*t1745 + 0.3333333334e0_dp* & + t1748*t1722 + t1752 - t1754 - t1757 t1760 = 0.5555555558e-1_dp*t719*t534 t1762 = 0.5555555558e-1_dp*t1755*t200 t1763 = t237*t722 @@ -1299,15 +1299,15 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t1829 = t225*t561 t1832 = 0.6000000000e1_dp*t478*t489*t1829 t1835 = 0.1800000000e2_dp*t478*t1176*t561 - t1836 = t1800-t1804-t1807-t1810+t1814-t1817+0.8999999998e1_dp & - *t178*t62*t1688+t1824-t1828+t1832-t1835 + t1836 = t1800 - t1804 - t1807 - t1810 + t1814 - t1817 + 0.8999999998e1_dp & + *t178*t62*t1688 + t1824 - t1828 + t1832 - t1835 t1837 = t68*t1836 t1838 = t1837*t65 - t1842 = -t1760-t1762-t1765-t1768-0.5555555558e-1_dp*t192*t1769 & - -t1773-t1776-t1779-0.5555555558e-1_dp*t503*t1525-t1784 & - -t1787-t1789-0.1111111112e0_dp*t516*t1790-t1794+t1797 & - -0.5555555558e-1_dp*t192*t1838+t1836*t65 - t1843 = t1758+t1842 + t1842 = -t1760 - t1762 - t1765 - t1768 - 0.5555555558e-1_dp*t192*t1769 & + - t1773 - t1776 - t1779 - 0.5555555558e-1_dp*t503*t1525 - t1784 & + - t1787 - t1789 - 0.1111111112e0_dp*t516*t1790 - t1794 + t1797 & + - 0.5555555558e-1_dp*t192*t1838 + t1836*t65 + t1843 = t1758 + t1842 t1849 = 0.8333333335e-1_dp*t429*t166*t1571 t1852 = 0.8333333335e-1_dp*t429*t679*t290 t1854 = t165*t466*t1483 @@ -1321,7 +1321,7 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t1875 = t114*t585 t1878 = 0.4444444445e0_dp*t170*t1875*t451 t1881 = 0.1666666667e0_dp*t165*t437*t649 - t1884 = -t1496+0.9000000000e1_dp*t1498+0.6000000000e1_dp*t1502 + t1884 = -t1496 + 0.9000000000e1_dp*t1498 + 0.6000000000e1_dp*t1502 t1885 = t1884*t149 t1886 = t1885*t160 t1891 = 0.5625000000e1_dp*t1302*t401*t1410 @@ -1337,17 +1337,17 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t1917 = 0.1500000000e1_dp*t405*t156*t1825 t1920 = 0.1000000000e1_dp*t405*t417*t1829 t1923 = 0.1500000000e1_dp*t405*t1333*t561 - t1924 = -t1891+t1895+t1898+t1901-t1905+t1908-0.1500000000e1_dp & - *t151*t50*t1688-t1914+t1917-t1920+t1923 + t1924 = -t1891 + t1895 + t1898 + t1901 - t1905 + t1908 - 0.1500000000e1_dp & + *t151*t50*t1688 - t1914 + t1917 - t1920 + t1923 t1925 = t149*t1924 t1928 = t56*t1531 t1932 = t27*t1531 t1938 = 0.1666666667e0_dp*t165*t462*t1447 - t1939 = 0.3333333334e0_dp*t55*t57*t1843-t1849-t1852-0.5555555555e-1_dp & - *t1854+t1858+t1861+t1864-t1868+t1871+t1874 & - -t1878+t1881+(2*t147*t1886)+(2*t147*t1925) & - +0.1666666667e0_dp*t165*t1928*t140+0.3333333334e0_dp*t170*t1932 & - *t172+t1938 + t1939 = 0.3333333334e0_dp*t55*t57*t1843 - t1849 - t1852 - 0.5555555555e-1_dp & + *t1854 + t1858 + t1861 + t1864 - t1868 + t1871 + t1874 & + - t1878 + t1881 + (2*t147*t1886) + (2*t147*t1925) & + + 0.1666666667e0_dp*t165*t1928*t140 + 0.3333333334e0_dp*t170*t1932 & + *t172 + t1938 t1940 = t27*t735 t1943 = 0.1111111111e0_dp*t170*t1940*t17 t1946 = 0.1666666667e0_dp*t165*t1392*t561 @@ -1374,16 +1374,16 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t1994 = 0.8333333335e-1_dp*t429*t166*t1557 t1997 = 0.1666666667e0_dp*t165*t171*t668 t2000 = 0.8333333335e-1_dp*t429*t462*t1410 - t2001 = -t1943+t1946+0.1666666667e0_dp*t165*t166*t1688-t1952 & - -0.2222222222e0_dp*t1954-t1958+t1961+t1965+t1969+t1977 & - +t1980+t1984-t1987-t1991-t1994+t1997-t2000 - t2002 = t1939+t2001 - t2006 = -t1541-t1543-t1545+t1549-t1552-t1556-t1560-t1563 & - -0.3333333336e0_dp*t83*t1565-t1570-t1574-t1577-0.3333333336e0_dp & - *t83*t1689-t1693-t1696-t1699-t1702-t1705- & - t1708-0.2222222224e0_dp*t144*t46*t2002 - e_ndrho_rho(ii) = e_ndrho_rho(ii)+(-t1406-t1408-t1413-t1417-t1451-t1455-0.4444444448e0_dp & - *t43*t1536+t8*t2006)*sx + t2001 = -t1943 + t1946 + 0.1666666667e0_dp*t165*t166*t1688 - t1952 & + - 0.2222222222e0_dp*t1954 - t1958 + t1961 + t1965 + t1969 + t1977 & + + t1980 + t1984 - t1987 - t1991 - t1994 + t1997 - t2000 + t2002 = t1939 + t2001 + t2006 = -t1541 - t1543 - t1545 + t1549 - t1552 - t1556 - t1560 - t1563 & + - 0.3333333336e0_dp*t83*t1565 - t1570 - t1574 - t1577 - 0.3333333336e0_dp & + *t83*t1689 - t1693 - t1696 - t1699 - t1702 - t1705 - & + t1708 - 0.2222222224e0_dp*t144*t46*t2002 + e_ndrho_rho(ii) = e_ndrho_rho(ii) + (-t1406 - t1408 - t1413 - t1417 - t1451 - t1455 - 0.4444444448e0_dp & + *t43*t1536 + t8*t2006)*sx t2009 = t566*t393 t2013 = t566*t149*t47 t2014 = t398*t19 @@ -1394,66 +1394,66 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t2031 = t56*t561 t2032 = t2031*t526 t2035 = t20*t1447 - t2042 = -0.1800000000e2_dp*t473*t2028+0.5999999999e1_dp*t478*t2032 & - +0.8999999998e1_dp*t478*t2035*t65+t1509-t1512+t1517 & - -t1523+t1515-0.5000000001e0_dp*t60*t1447*t65-t1530 - t2046 = -0.3000000000e1_dp*t2009*t569+0.4500000000e1_dp*t2013*t2014 & - *t1410-0.1000000000e1_dp*t2013*t2018*t1483-0.3000000000e1_dp & - *t567*t151*t2022-t1476-0.5555555557e-1_dp*t1485+t1492 & - +t1482+t1479-t1489+0.3333333334e0_dp*t55*t57*t2042 + t2042 = -0.1800000000e2_dp*t473*t2028 + 0.5999999999e1_dp*t478*t2032 & + + 0.8999999998e1_dp*t478*t2035*t65 + t1509 - t1512 + t1517 & + - t1523 + t1515 - 0.5000000001e0_dp*t60*t1447*t65 - t1530 + t2046 = -0.3000000000e1_dp*t2009*t569 + 0.4500000000e1_dp*t2013*t2014 & + *t1410 - 0.1000000000e1_dp*t2013*t2018*t1483 - 0.3000000000e1_dp & + *t567*t151*t2022 - t1476 - 0.5555555557e-1_dp*t1485 + t1492 & + + t1482 + t1479 - t1489 + 0.3333333334e0_dp*t55*t57*t2042 t2050 = t45*t2046 t2054 = t786*t640 - t2057 = t1636+t1638-t1644-t1647-t1649+t1654-t1656+t1664 & - +t1662-t1660+t1671+t1679-t1675-0.240e2_dp*t2054*t1060 + t2057 = t1636 + t1638 - t1644 - t1647 - t1649 + t1654 - t1656 + t1664 & + + t1662 - t1660 + t1671 + t1679 - t1675 - 0.240e2_dp*t2054*t1060 t2058 = t105*t2057 - t2061 = t1579+t1584-t1581-t1586+t1588-t1591-t1596+t1594 & - +t1601-t1605+t1607+t1615-t1630-t1610-t1620+t1634 & - +t1628+t1613+t1624-0.20e1_dp*t102*t2058 - t2073 = -t1891+t1901+t1908+t1898+t1895-t1905-0.1500000000e1_dp & - *t151*t50*t2061-t1914-t1920+t1923+t1917 + t2061 = t1579 + t1584 - t1581 - t1586 + t1588 - t1591 - t1596 + t1594 & + + t1601 - t1605 + t1607 + t1615 - t1630 - t1610 - t1620 + t1634 & + + t1628 + t1613 + t1624 - 0.20e1_dp*t102*t2058 + t2073 = -t1891 + t1901 + t1908 + t1898 + t1895 - t1905 - 0.1500000000e1_dp & + *t151*t50*t2061 - t1914 - t1920 + t1923 + t1917 t2074 = t149*t2073 t2077 = t161*t17 t2081 = t657*t472 t2082 = t161*t237 - t2086 = -t1849-t1852-0.5555555557e-1_dp*t1854+t1858+t1861+ & - t1864-t1868+t1871+t1874+0.3333333334e0_dp*t170*t27*t2042 & - *t172-t1878+(2*t147*t2074)+t1881+t1938-t1943 & - +0.1200000000e2_dp*t658*t2031*t2077+t1946-0.3600000000e2_dp* & + t2086 = -t1849 - t1852 - 0.5555555557e-1_dp*t1854 + t1858 + t1861 + & + t1864 - t1868 + t1871 + t1874 + 0.3333333334e0_dp*t170*t27*t2042 & + *t172 - t1878 + (2*t147*t2074) + t1881 + t1938 - t1943 & + + 0.1200000000e2_dp*t658*t2031*t2077 + t1946 - 0.3600000000e2_dp* & t2081*t575*t2082 t2088 = t56*t2042 t2095 = t1447*t65 t2098 = t140*t471 t2099 = t709*t237 t2104 = t62*t2095 - t2107 = -t1714+t1717+t1719-t1724+t1728-0.5000000001e0_dp*t716 & - *t2095+0.1000000000e1_dp*t2098*t2099-0.1000000001e1_dp*t723 & - *t2095-t1730+t1735+t1743+0.8999999998e1_dp*t708*t2104 & - +t1752-t1754-t1757-t1760 + t2107 = -t1714 + t1717 + t1719 - t1724 + t1728 - 0.5000000001e0_dp*t716 & + *t2095 + 0.1000000000e1_dp*t2098*t2099 - 0.1000000001e1_dp*t723 & + *t2095 - t1730 + t1735 + t1743 + 0.8999999998e1_dp*t708*t2104 & + + t1752 - t1754 - t1757 - t1760 t2113 = t177*pi t2114 = t707*t2113 t2117 = t471*pi t2118 = t707*t2117 - t2124 = t1800-t1810-t1817-t1807-t1804+t1814+0.8999999998e1_dp & - *t178*t62*t2061+t1824+t1832-t1835-t1828 + t2124 = t1800 - t1810 - t1817 - t1807 - t1804 + t1814 + 0.8999999998e1_dp & + *t178*t62*t2061 + t1824 + t1832 - t1835 - t1828 t2126 = t68*t2124*t65 - t2130 = -0.5000000001e0_dp*t732*t2095-0.5555555558e-1_dp*t58*t2061 & - *t71-t1762+t1765+t1768+0.5999999999e1_dp*t2114*t2032 & - -t1773-t1776-0.1800000000e2_dp*t2118*t2028-0.5555555558e-1_dp & - *t192*t2126-t1779-t1784-t1787-t1789-t1794+t1797+ & + t2130 = -0.5000000001e0_dp*t732*t2095 - 0.5555555558e-1_dp*t58*t2061 & + *t71 - t1762 + t1765 + t1768 + 0.5999999999e1_dp*t2114*t2032 & + - t1773 - t1776 - 0.1800000000e2_dp*t2118*t2028 - 0.5555555558e-1_dp & + *t192*t2126 - t1779 - t1784 - t1787 - t1789 - t1794 + t1797 + & t2124*t65 - t2131 = t2107+t2130 - t2138 = -t1952-0.2222222223e0_dp*t1954-t1958+t1961+t1965+t1969 & - +t1977+t1980+0.1666666667e0_dp*t165*t2088*t140+0.1800000000e2_dp & - *t658*t2035*t161+0.3333333334e0_dp*t55*t57*t2131 & - +t1984+0.1666666667e0_dp*t165*t166*t2061-t1987-t1991 & - -t1994+t1997-t2000 - t2139 = t2086+t2138 - t2143 = -t1541+t1549-t1563-t1574-t1560-t1543-t1552-0.3333333336e0_dp & - *t83*t2050*t140-t1577-t1545-t1556-t1570 & - -0.3333333336e0_dp*t83*t84*t2061-t1693-t1699-t1708-t1705 & - -t1696-t1702-0.2222222224e0_dp*t144*t46*t2139 - e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii)+(-t1406-t1413-t1455-t1451-t1408-t1417-0.4444444448e0_dp & - *t43*t46*t2046+t8*t2143)*sx + t2131 = t2107 + t2130 + t2138 = -t1952 - 0.2222222223e0_dp*t1954 - t1958 + t1961 + t1965 + t1969 & + + t1977 + t1980 + 0.1666666667e0_dp*t165*t2088*t140 + 0.1800000000e2_dp & + *t658*t2035*t161 + 0.3333333334e0_dp*t55*t57*t2131 & + + t1984 + 0.1666666667e0_dp*t165*t166*t2061 - t1987 - t1991 & + - t1994 + t1997 - t2000 + t2139 = t2086 + t2138 + t2143 = -t1541 + t1549 - t1563 - t1574 - t1560 - t1543 - t1552 - 0.3333333336e0_dp & + *t83*t2050*t140 - t1577 - t1545 - t1556 - t1570 & + - 0.3333333336e0_dp*t83*t84*t2061 - t1693 - t1699 - t1708 - t1705 & + - t1696 - t1702 - 0.2222222224e0_dp*t144*t46*t2139 + e_ndrho_ndrho(ii) = e_ndrho_ndrho(ii) + (-t1406 - t1413 - t1455 - t1451 - t1408 - t1417 - 0.4444444448e0_dp & + *t43*t46*t2046 + t8*t2143)*sx t2147 = lambda*t48*omega t2160 = t754*t237 t2169 = t237*t804 @@ -1469,13 +1469,13 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t2204 = t10*t106 t2205 = 0.1e1_dp/t2204 t2220 = beta*t785*t6 - t2226 = -0.6222222223e2_dp*t24*t2205*t1002*t31-0.2115555556e3_dp & - *t7*t2183*t132+0.1315555556e3_dp*t786/t787/t85*t1019 & - *t371-0.4266666668e2_dp*t2220/t1014/t94*t1058 + t2226 = -0.6222222223e2_dp*t24*t2205*t1002*t31 - 0.2115555556e3_dp & + *t7*t2183*t132 + 0.1315555556e3_dp*t786/t787/t85*t1019 & + *t371 - 0.4266666668e2_dp*t2220/t1014/t94*t1058 t2227 = t105*t2226 - t2230 = -0.9125925923e2_dp*t7*t2183*t36-0.5866666667e2_dp*t962 & - *t2187-0.3200000001e2_dp*t321*t2190+0.1600000000e2_dp*t321* & - t2193-0.120e2_dp*t102*t2197+0.120e2_dp*t102*t2201-0.20e1_dp* & + t2230 = -0.9125925923e2_dp*t7*t2183*t36 - 0.5866666667e2_dp*t962 & + *t2187 - 0.3200000001e2_dp*t321*t2190 + 0.1600000000e2_dp*t321* & + t2193 - 0.120e2_dp*t102*t2197 + 0.120e2_dp*t102*t2201 - 0.20e1_dp* & t102*t2227 t2257 = 0.5400000000e2_dp*t1142*t62*t2160 t2261 = 0.3600000000e2_dp*t473*t56*t754*t17 @@ -1485,8 +1485,8 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t2274 = t178*t62*t2230 t2276 = pi*t114 t2279 = 0.2666666667e1_dp*t61*t2276*t86 - t2280 = t2257-t2261-t2264-t2268+t2272+0.8999999998e1_dp*t2274 & - -t2279 + t2280 = t2257 - t2261 - t2264 - t2268 + t2272 + 0.8999999998e1_dp*t2274 & + - t2279 t2281 = t2280*t65 t2282 = t881*t267 t2285 = t865*t266 @@ -1502,32 +1502,32 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t2311 = t194*t863 t2312 = t2311*t526 t2319 = t1099*t86 - t2326 = -0.1851851853e0_dp*t508*t874+t2281-0.1666666668e0_dp*t192 & - *t2282-0.5555555558e-1_dp*t192*t2287-0.1666666668e0_dp*t508 & - *t886+(3*t2292*t65)+t2295-0.5555555558e-1_dp*t2296 & - *t71+0.1111111112e0_dp*t192*t2300-0.5555555558e-1_dp*t192* & - t2304-0.1851851853e0_dp*t192*t2308+0.1111111112e0_dp*t192*t2312 & - +0.2222222223e0_dp*t508*t878-0.1666666668e0_dp*t508*t882 & - +0.1646090535e0_dp*t192*t2319-0.1666666668e0_dp*t1129*t275+ & + t2326 = -0.1851851853e0_dp*t508*t874 + t2281 - 0.1666666668e0_dp*t192 & + *t2282 - 0.5555555558e-1_dp*t192*t2287 - 0.1666666668e0_dp*t508 & + *t886 + (3*t2292*t65) + t2295 - 0.5555555558e-1_dp*t2296 & + *t71 + 0.1111111112e0_dp*t192*t2300 - 0.5555555558e-1_dp*t192* & + t2304 - 0.1851851853e0_dp*t192*t2308 + 0.1111111112e0_dp*t192*t2312 & + + 0.2222222223e0_dp*t508*t878 - 0.1666666668e0_dp*t508*t882 & + + 0.1646090535e0_dp*t192*t2319 - 0.1666666668e0_dp*t1129*t275 + & 0.1111111112e0_dp*t1129*t271 t2351 = t44*t22 t2368 = t237*t14 t2378 = t804*t17 t2382 = t754*t17 - t2392 = (2*t147*t1284*t249)+(2*t147*t1388*t249) & - -0.3456790122e0_dp*t170*t1268*t86+0.4444444444e0_dp*t170* & - t1089*t14+0.1666666667e0_dp*t165*t166*t2230+0.5000000001e0_dp & - *t165*t437*t804+0.3333333334e0_dp*t55*t57*t2326+0.2e1_dp & - *(t147)*t149*(-0.5625000000e1_dp*t1301*t50*t2160+ & - 0.2250000000e1_dp*t400*t68*t754*t17+0.6750000000e1_dp*t400* & - t1459*t804+0.1000000000e1_dp*t405*t194*t237*t14-0.1500000000e1_dp & - *t405*t68*t804*t17-0.1500000000e1_dp*t151*t50* & - t2230+0.1111111111e1_dp*t49*t2351*t86)-0.3333333333e0_dp*t170 & - *t1254*t17+(4*t147*t393*t826)+0.5000000001e0_dp* & - t165*t1275*t237+0.2222222222e0_dp*t165*t450*t2368-0.3333333333e0_dp & - *t165*t455*t833-0.2500000000e0_dp*t429*t166*t2169 & - -0.1666666667e0_dp*t165*t171*t2378+0.8333333333e-1_dp*t429 & - *t171*t2382-0.2500000000e0_dp*t429*t437*t754+0.1250000000e0_dp & + t2392 = (2*t147*t1284*t249) + (2*t147*t1388*t249) & + - 0.3456790122e0_dp*t170*t1268*t86 + 0.4444444444e0_dp*t170* & + t1089*t14 + 0.1666666667e0_dp*t165*t166*t2230 + 0.5000000001e0_dp & + *t165*t437*t804 + 0.3333333334e0_dp*t55*t57*t2326 + 0.2e1_dp & + *(t147)*t149*(-0.5625000000e1_dp*t1301*t50*t2160 + & + 0.2250000000e1_dp*t400*t68*t754*t17 + 0.6750000000e1_dp*t400* & + t1459*t804 + 0.1000000000e1_dp*t405*t194*t237*t14 - 0.1500000000e1_dp & + *t405*t68*t804*t17 - 0.1500000000e1_dp*t151*t50* & + t2230 + 0.1111111111e1_dp*t49*t2351*t86) - 0.3333333333e0_dp*t170 & + *t1254*t17 + (4*t147*t393*t826) + 0.5000000001e0_dp* & + t165*t1275*t237 + 0.2222222222e0_dp*t165*t450*t2368 - 0.3333333333e0_dp & + *t165*t455*t833 - 0.2500000000e0_dp*t429*t166*t2169 & + - 0.1666666667e0_dp*t165*t171*t2378 + 0.8333333333e-1_dp*t429 & + *t171*t2382 - 0.2500000000e0_dp*t429*t437*t754 + 0.1250000000e0_dp & *t1368*t166*t2160 t2404 = t45*t1397 t2418 = t379*t754 @@ -1542,217 +1542,217 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t2537 = t764*t1002 t2552 = t360*t1058 t2565 = t126/t131/t1056/t130 - t2569 = -0.8088888890e3_dp*t24*t2182*t2480*t31*my_rho-0.1518222222e4_dp & - *t2437*t2439*t132*my_rho+0.6542222223e3_dp*t786/t2204 & - /t19/t2492*t218*t371*my_rho-0.6222222223e2_dp*t24*t2205 & - *t1002*t126*t132+0.5600000000e2_dp*t1024*t341*t360 & - *t132+0.3288888889e3_dp*t366/t790*t126*t371-0.2400000000e2_dp & - *t350*t114*t1044*t132-0.1520000000e3_dp*t366*t1034* & - t360*t371-0.3626666667e3_dp*t1054*t1034*t1060+0.60e1_dp*t119 & - *t27*(0.3640e4_dp/0.27e2_dp*t1040*t1002-0.3640e4_dp/0.27e2_dp & - *my_ndrho*t2182*t2480*my_rho)*t132+0.8088888890e3_dp*t24*t2537 & - *t31+0.1518222222e4_dp*t7*t2451*t132-0.6542222223e3_dp* & - t786*t1012*t1019*t371+0.2400000000e2_dp*t366*t368*t1044 & - *t371+0.9600000000e2_dp*t1055*t2552*t220-0.1173333333e3_dp & - *t1055*t1059*t765+0.2133333333e3_dp*beta*t785*t365*t368 & + t2569 = -0.8088888890e3_dp*t24*t2182*t2480*t31*my_rho - 0.1518222222e4_dp & + *t2437*t2439*t132*my_rho + 0.6542222223e3_dp*t786/t2204 & + /t19/t2492*t218*t371*my_rho - 0.6222222223e2_dp*t24*t2205 & + *t1002*t126*t132 + 0.5600000000e2_dp*t1024*t341*t360 & + *t132 + 0.3288888889e3_dp*t366/t790*t126*t371 - 0.2400000000e2_dp & + *t350*t114*t1044*t132 - 0.1520000000e3_dp*t366*t1034* & + t360*t371 - 0.3626666667e3_dp*t1054*t1034*t1060 + 0.60e1_dp*t119 & + *t27*(0.3640e4_dp/0.27e2_dp*t1040*t1002 - 0.3640e4_dp/0.27e2_dp & + *my_ndrho*t2182*t2480*my_rho)*t132 + 0.8088888890e3_dp*t24*t2537 & + *t31 + 0.1518222222e4_dp*t7*t2451*t132 - 0.6542222223e3_dp* & + t786*t1012*t1019*t371 + 0.2400000000e2_dp*t366*t368*t1044 & + *t371 + 0.9600000000e2_dp*t1055*t2552*t220 - 0.1173333333e3_dp & + *t1055*t1059*t765 + 0.2133333333e3_dp*beta*t785*t365*t368 & *t2565*t796 - t2576 = 0.40e1_dp*t102*t327*t136*t2226+0.3519999999e3_dp*t93 & - *t2190-0.1551407408e4_dp*t2437*t2439*t36*my_rho+0.960e2_dp* & - t1597*t1598*t2200+0.120e2_dp*t102*t327*t375*t800+0.1551407408e4_dp & - *t7*t2451*t36-0.960e2_dp*t93*t2455*my_rho*t2196 & - +0.120e2_dp*t102*t327*t1063*t233+0.1600000000e2_dp*t321 & - *t316*t1063+0.9125925923e2_dp*t7*t2182*t2468*t136+0.1760000000e3_dp & - *t307*t949*t958-0.360e2_dp*t1616*t1617*t2200 & - -0.20e1_dp*t102*t105*t2569-0.6400000001e2_dp*t321*t953*t979 + t2576 = 0.40e1_dp*t102*t327*t136*t2226 + 0.3519999999e3_dp*t93 & + *t2190 - 0.1551407408e4_dp*t2437*t2439*t36*my_rho + 0.960e2_dp* & + t1597*t1598*t2200 + 0.120e2_dp*t102*t327*t375*t800 + 0.1551407408e4_dp & + *t7*t2451*t36 - 0.960e2_dp*t93*t2455*my_rho*t2196 & + + 0.120e2_dp*t102*t327*t1063*t233 + 0.1600000000e2_dp*t321 & + *t316*t1063 + 0.9125925923e2_dp*t7*t2182*t2468*t136 + 0.1760000000e3_dp & + *t307*t949*t958 - 0.360e2_dp*t1616*t1617*t2200 & + - 0.20e1_dp*t102*t105*t2569 - 0.6400000001e2_dp*t321*t953*t979 t2585 = 0.1e1_dp/t972/t35 t2611 = t311*t326 - t2621 = -0.3200000001e2_dp*t321*t953*t983-0.160e2_dp*t93*t316 & - *my_rho*t2226+0.480e2_dp*t102*t22*t2585*t136*t2196-0.1760000000e3_dp & - *t93*t2193+0.960e2_dp*t302*t2197+0.160e2_dp*t302 & - *t2227-0.960e2_dp*t302*t2201-0.8213333332e3_dp*t941*t2468 & - *t317+0.8213333332e3_dp*t307*t2187+0.9600000002e2_dp*t321* & - t2455*t975-0.360e2_dp*t102*t974*t375*t772-0.3519999999e3_dp & - *t307*t2611*t954+0.1173333334e3_dp*t962*t2611*t328- & + t2621 = -0.3200000001e2_dp*t321*t953*t983 - 0.160e2_dp*t93*t316 & + *my_rho*t2226 + 0.480e2_dp*t102*t22*t2585*t136*t2196 - 0.1760000000e3_dp & + *t93*t2193 + 0.960e2_dp*t302*t2197 + 0.160e2_dp*t302 & + *t2227 - 0.960e2_dp*t302*t2201 - 0.8213333332e3_dp*t941*t2468 & + *t317 + 0.8213333332e3_dp*t307*t2187 + 0.9600000002e2_dp*t321* & + t2455*t975 - 0.360e2_dp*t102*t974*t375*t772 - 0.3519999999e3_dp & + *t307*t2611*t954 + 0.1173333334e3_dp*t962*t2611*t328 - & 0.5866666667e2_dp*t962*t949*t375 - t2622 = t2576+t2621 + t2622 = t2576 + t2621 t2631 = t282*t140 - t2635 = -0.1000000001e1_dp*t55*t923-0.3333333336e0_dp*t83*t384 & - *t2230-0.5000000004e0_dp*t165*t897*t804-0.6666666672e0_dp*t383 & - *t2404-0.1000000001e1_dp*t83*t1071*t804-0.5000000004e0_dp & - *t164*t1076-0.1000000001e1_dp*t289*t294*t914-0.5000000004e0_dp & - *t289*t294*t918+0.2500000002e0_dp*t906*t84*t2418- & - 0.2000000001e1_dp*t55*t1079-0.5000000004e0_dp*t289*t84*t2424 & - +0.2500000002e0_dp*t1546*t897*t2169-0.3333333336e0_dp*t83* & - t84*t2622+0.2500000002e0_dp*t906*t294*t907-0.1000000001e1_dp & - *t55*t1082-0.1000000001e1_dp*t165*t2631*t237 + t2635 = -0.1000000001e1_dp*t55*t923 - 0.3333333336e0_dp*t83*t384 & + *t2230 - 0.5000000004e0_dp*t165*t897*t804 - 0.6666666672e0_dp*t383 & + *t2404 - 0.1000000001e1_dp*t83*t1071*t804 - 0.5000000004e0_dp & + *t164*t1076 - 0.1000000001e1_dp*t289*t294*t914 - 0.5000000004e0_dp & + *t289*t294*t918 + 0.2500000002e0_dp*t906*t84*t2418 - & + 0.2000000001e1_dp*t55*t1079 - 0.5000000004e0_dp*t289*t84*t2424 & + + 0.2500000002e0_dp*t1546*t897*t2169 - 0.3333333336e0_dp*t83* & + t84*t2622 + 0.2500000002e0_dp*t906*t294*t907 - 0.1000000001e1_dp & + *t55*t1082 - 0.1000000001e1_dp*t165*t2631*t237 t2636 = t78*t379 t2645 = t379*t804 t2655 = t140*t2230 t2707 = t74*t379 t2720 = t56*t1239 - t2724 = 0.5000000001e0_dp*t165*t1392*t804-0.1333333334e1_dp*t165 & - *t450*t1172-0.2666666667e1_dp*t170*t1089*t225+0.8333333333e-1_dp & - *t429*t466*t2382+0.1000000000e1_dp*t170*t1254*t25 & - +0.1666666667e0_dp*t165*t166*t2622+0.1666666667e0_dp*t165* & - t56*t2326*t140-0.2500000000e0_dp*t429*t166*t2424-0.3333333333e0_dp & - *t165*t455*t1085-0.1728395062e0_dp*t165*t1268* & - t140*t86-0.2500000000e0_dp*t1246*t446*t413*t804+0.1666666666e0_dp & - *t1246*t2707*t833+0.1250000000e0_dp*t1368*t462*t2160 & - -0.1666666667e0_dp*t165*t466*t2378+(6*t147*t1283 & - *t394)+0.5000000001e0_dp*t165*t2720*t237 + t2724 = 0.5000000001e0_dp*t165*t1392*t804 - 0.1333333334e1_dp*t165 & + *t450*t1172 - 0.2666666667e1_dp*t170*t1089*t225 + 0.8333333333e-1_dp & + *t429*t466*t2382 + 0.1000000000e1_dp*t170*t1254*t25 & + + 0.1666666667e0_dp*t165*t166*t2622 + 0.1666666667e0_dp*t165* & + t56*t2326*t140 - 0.2500000000e0_dp*t429*t166*t2424 - 0.3333333333e0_dp & + *t165*t455*t1085 - 0.1728395062e0_dp*t165*t1268* & + t140*t86 - 0.2500000000e0_dp*t1246*t446*t413*t804 + 0.1666666666e0_dp & + *t1246*t2707*t833 + 0.1250000000e0_dp*t1368*t462*t2160 & + - 0.1666666667e0_dp*t165*t466*t2378 + (6*t147*t1283 & + *t394) + 0.5000000001e0_dp*t165*t2720*t237 t2732 = my_rho*t2205 t2759 = t25*t2230 t2763 = t1367*t444 t2779 = t25*t2160 - t2783 = -0.2500000000e0_dp*t429*t1392*t754+(6*t147*t393 & - *t1347)-0.3456790123e1_dp*t170*t1002*t74*t2732+0.5000000001e0_dp & - *t165*t1275*t379-0.1333333334e1_dp*t170*t114*t889 & - *t451+0.3333333334e0_dp*t170*t27*t2326*t172-0.2500000000e0_dp & - *t429*t171*t1168+0.3750000000e0_dp*t1981*t1247*t2169 & - +0.5000000001e0_dp*t165*t171*t1093+0.8333333334e-1_dp*t1246 & - *t1247*t2378+0.1666666667e0_dp*t445*t446*t2759-0.1250000000e0_dp & - *t2763*t1247*t2382+0.5000000001e0_dp*t165*t437*t1067 & - +0.2222222222e0_dp*t165*t1089*t1360+0.1000000000e1_dp*t165 & - *t455*t413-0.2500000000e0_dp*t429*t462*t2169+0.1250000000e0_dp & + t2783 = -0.2500000000e0_dp*t429*t1392*t754 + (6*t147*t393 & + *t1347) - 0.3456790123e1_dp*t170*t1002*t74*t2732 + 0.5000000001e0_dp & + *t165*t1275*t379 - 0.1333333334e1_dp*t170*t114*t889 & + *t451 + 0.3333333334e0_dp*t170*t27*t2326*t172 - 0.2500000000e0_dp & + *t429*t171*t1168 + 0.3750000000e0_dp*t1981*t1247*t2169 & + + 0.5000000001e0_dp*t165*t171*t1093 + 0.8333333334e-1_dp*t1246 & + *t1247*t2378 + 0.1666666667e0_dp*t445*t446*t2759 - 0.1250000000e0_dp & + *t2763*t1247*t2382 + 0.5000000001e0_dp*t165*t437*t1067 & + + 0.2222222222e0_dp*t165*t1089*t1360 + 0.1000000000e1_dp*t165 & + *t455*t413 - 0.2500000000e0_dp*t429*t462*t2169 + 0.1250000000e0_dp & *t2763*t446*t2779 t2808 = t19*t1067 t2816 = t225*t754 t2821 = 0.1e1_dp/t41/t1140 t2823 = t47*t2821*t44 - t2833 = -0.1687500000e2_dp*t1302*t401*t2169+0.6750000000e1_dp*t400 & - *t1309*t804+0.4500000000e1_dp*t400*t1320*t833-0.1500000000e1_dp & - *t400*t1316*t2368+0.1000000000e1_dp*t405*t194*t379 & - *t14+0.8888888888e1_dp*t155*t97*my_rho*t2205+0.6750000000e1_dp & - *t400*t2808*t237-0.1500000000e1_dp*t405*t68*t1067 & - *t17+0.4500000000e1_dp*t400*t417*t2816+0.1968750000e2_dp*t2823 & - *t401*t2160+0.1500000000e1_dp*t405*t156*t2759+0.2250000000e1_dp & + t2833 = -0.1687500000e2_dp*t1302*t401*t2169 + 0.6750000000e1_dp*t400 & + *t1309*t804 + 0.4500000000e1_dp*t400*t1320*t833 - 0.1500000000e1_dp & + *t400*t1316*t2368 + 0.1000000000e1_dp*t405*t194*t379 & + *t14 + 0.8888888888e1_dp*t155*t97*my_rho*t2205 + 0.6750000000e1_dp & + *t400*t2808*t237 - 0.1500000000e1_dp*t405*t68*t1067 & + *t17 + 0.4500000000e1_dp*t400*t417*t2816 + 0.1968750000e2_dp*t2823 & + *t401*t2160 + 0.1500000000e1_dp*t405*t156*t2759 + 0.2250000000e1_dp & *t400*t401*t2230 t2843 = t777*t237 t2853 = t172*t2169 t2869 = t225*t804 t2873 = t194*t225 - t2877 = -0.1500000000e1_dp*t151*t50*t2622+0.5625000000e1_dp*t1302 & - *t156*t2779-0.6750000000e1_dp*t400*t1333*t754+0.4999999999e1_dp & - *t405*t1340*t2843-0.1000000000e2_dp*t49*t2351*t777 & - -0.5625000000e1_dp*t1302*t406*t2382-0.6750000000e1_dp*t1912 & - *t2853-0.5555555555e0_dp*t405*t22*t140*t86+0.4500000000e1_dp & - *t405*t1333*t804+0.2250000000e1_dp*t400*t406*t2378- & - 0.1687500000e2_dp*t1302*t1309*t754-0.3000000000e1_dp*t405*t417 & - *t2869-0.6000000000e1_dp*t405*t2873*t237 + t2877 = -0.1500000000e1_dp*t151*t50*t2622 + 0.5625000000e1_dp*t1302 & + *t156*t2779 - 0.6750000000e1_dp*t400*t1333*t754 + 0.4999999999e1_dp & + *t405*t1340*t2843 - 0.1000000000e2_dp*t49*t2351*t777 & + - 0.5625000000e1_dp*t1302*t406*t2382 - 0.6750000000e1_dp*t1912 & + *t2853 - 0.5555555555e0_dp*t405*t22*t140*t86 + 0.4500000000e1_dp & + *t405*t1333*t804 + 0.2250000000e1_dp*t400*t406*t2378 - & + 0.1687500000e2_dp*t1302*t1309*t754 - 0.3000000000e1_dp*t405*t417 & + *t2869 - 0.6000000000e1_dp*t405*t2873*t237 t2885 = t428*t1372 - t2935 = -0.2500000000e0_dp*t429*t166*t2645+(2*t147*t149 & - *(t2833+t2877))+0.5000000001e0_dp*t445*t1292*t1093+0.3333333333e0_dp & - *t2885*t446*t2816+0.2222222222e0_dp*t165*t1377 & - *t2368-0.3333333333e0_dp*t165*t1264*t833+0.2e1_dp*(t147) & - *(t2257-t2261-t2264-t2268+t2272+0.9000000000e1_dp*t2274 & - -t2279)*(t149)*t160-0.3333333333e0_dp*t170*t27*t1239 & - *t17-0.8333333335e-1_dp*t429*t166*t2655+(6*t147 & - *t1284*t424)+0.2e1_dp*(t147)*t1387*t392*(t149)* & - t160-0.2500000000e0_dp*t1246*t1292*t1168-0.1666666667e0_dp* & - t165*t1254*t433+(6*t147*t1388*t424)+0.1666666667e0_dp & - *t165*t462*t2230+0.2222222222e0_dp*t165*t450*t379*t14 & - -0.5000000001e0_dp*t429*t437*t914 + t2935 = -0.2500000000e0_dp*t429*t166*t2645 + (2*t147*t149 & + *(t2833 + t2877)) + 0.5000000001e0_dp*t445*t1292*t1093 + 0.3333333333e0_dp & + *t2885*t446*t2816 + 0.2222222222e0_dp*t165*t1377 & + *t2368 - 0.3333333333e0_dp*t165*t1264*t833 + 0.2e1_dp*(t147) & + *(t2257 - t2261 - t2264 - t2268 + t2272 + 0.9000000000e1_dp*t2274 & + - t2279)*(t149)*t160 - 0.3333333333e0_dp*t170*t27*t1239 & + *t17 - 0.8333333335e-1_dp*t429*t166*t2655 + (6*t147 & + *t1284*t424) + 0.2e1_dp*(t147)*t1387*t392*(t149)* & + t160 - 0.2500000000e0_dp*t1246*t1292*t1168 - 0.1666666667e0_dp* & + t165*t1254*t433 + (6*t147*t1388*t424) + 0.1666666667e0_dp & + *t165*t462*t2230 + 0.2222222222e0_dp*t165*t450*t379*t14 & + - 0.5000000001e0_dp*t429*t437*t914 t2937 = t164*t45*t341 t2992 = 0.1e1_dp/t1140/t40 t2994 = t59*t2992*pi t2998 = t27*t225 - t3026 = 0.1620000000e3_dp*t1143*t474*t2169+0.1080000000e3_dp*t1143 & - *t479*t2382-0.2160000000e3_dp*t2994*t474*t2160+0.3600000000e2_dp & - *t478*t2998*t237+0.1620000000e3_dp*t1143*t1150* & - t754+0.2666666667e1_dp*t478*t114*t140*t86-0.3600000000e2_dp & - *t473*t479*t2378+0.1080000000e3_dp*t1821*t2853-0.7200000000e2_dp & - *t473*t1161*t833-0.1800000000e2_dp*t473*t474*t2230 & - +0.8999999998e1_dp*t178*t62*t2622-0.5400000000e2_dp*t478* & + t3026 = 0.1620000000e3_dp*t1143*t474*t2169 + 0.1080000000e3_dp*t1143 & + *t479*t2382 - 0.2160000000e3_dp*t2994*t474*t2160 + 0.3600000000e2_dp & + *t478*t2998*t237 + 0.1620000000e3_dp*t1143*t1150* & + t754 + 0.2666666667e1_dp*t478*t114*t140*t86 - 0.3600000000e2_dp & + *t473*t479*t2378 + 0.1080000000e3_dp*t1821*t2853 - 0.7200000000e2_dp & + *t473*t1161*t833 - 0.1800000000e2_dp*t473*t474*t2230 & + + 0.8999999998e1_dp*t178*t62*t2622 - 0.5400000000e2_dp*t478* & t1176*t804 t3030 = t20*t1067 - t3069 = -0.1800000000e2_dp*t478*t183*t2759-0.5400000000e2_dp*t473 & - *t3030*t237-0.6000000000e1_dp*t478*t27*t379*t14-0.5400000000e2_dp & - *t473*t1150*t804+0.1800000000e2_dp*t478*t489* & - t2869+0.1080000000e3_dp*t473*t1176*t754+0.1800000000e2_dp*t478 & - *t56*t1067*t17-0.3600000000e2_dp*t473*t489*t2816-0.1866666667e2_dp & - *t182*t357*t2205+0.2400000000e2_dp*t61*t2276 & - *t777-0.2400000000e2_dp*t478*t123*t2843-0.1080000000e3_dp* & - t1143*t183*t2779+0.1200000000e2_dp*t473*t1157*t2368 - t3070 = t3026+t3069 + t3069 = -0.1800000000e2_dp*t478*t183*t2759 - 0.5400000000e2_dp*t473 & + *t3030*t237 - 0.6000000000e1_dp*t478*t27*t379*t14 - 0.5400000000e2_dp & + *t473*t1150*t804 + 0.1800000000e2_dp*t478*t489* & + t2869 + 0.1080000000e3_dp*t473*t1176*t754 + 0.1800000000e2_dp*t478 & + *t56*t1067*t17 - 0.3600000000e2_dp*t473*t489*t2816 - 0.1866666667e2_dp & + *t182*t357*t2205 + 0.2400000000e2_dp*t61*t2276 & + *t777 - 0.2400000000e2_dp*t478*t123*t2843 - 0.1080000000e3_dp* & + t1143*t183*t2779 + 0.1200000000e2_dp*t473*t1157*t2368 + t3070 = t3026 + t3069 t3085 = t1210*t67 - t3093 = (3*t496*t865*t65)+(3*t1189*t266*t65) & - +0.1111111112e1_dp*(t192)*(t2307)*(t65)*(t225) & - +(t187*t2280*t65)+(3*t496*t863*t65)+0.2222222223e0_dp & - *t516*t1111*t526+(t187*t2285*t65)+(t3070 & - *t65)-0.1851851853e0_dp*t1193*t498*t1200+0.2222222223e0_dp & - *t508*t1119+0.1111111112e0_dp*(t192)*t194*(t1189) & - *t526+0.2222222223e0_dp*t1137*t1221-0.1666666668e0_dp*t1129 & - *t534+0.1111111112e0_dp*t3085*t271-0.5555555558e-1_dp*(t192) & - *(t199)*(t2281)-0.1851851853e0_dp*t508*t1201 + t3093 = (3*t496*t865*t65) + (3*t1189*t266*t65) & + + 0.1111111112e1_dp*(t192)*(t2307)*(t65)*(t225) & + + (t187*t2280*t65) + (3*t496*t863*t65) + 0.2222222223e0_dp & + *t516*t1111*t526 + (t187*t2285*t65) + (t3070 & + *t65) - 0.1851851853e0_dp*t1193*t498*t1200 + 0.2222222223e0_dp & + *t508*t1119 + 0.1111111112e0_dp*(t192)*t194*(t1189) & + *t526 + 0.2222222223e0_dp*t1137*t1221 - 0.1666666668e0_dp*t1129 & + *t534 + 0.1111111112e0_dp*t3085*t271 - 0.5555555558e-1_dp*(t192) & + *(t199)*(t2281) - 0.1851851853e0_dp*t508*t1201 t3097 = t66*t69 t3098 = t1109*t267 t3129 = t2296*t67 - t3141 = -0.3333333336e0_dp*t192*t2299*t1125-0.1666666668e0_dp*t3097 & - *t3098+0.1111111112e0_dp*t503*t2300+0.1111111112e0_dp*t1129 & - *t527-0.1666666668e0_dp*t1129*t531-0.5555555558e-1_dp*t192 & - *t68*t3070*t65+0.1646090535e0_dp*t192*t97*t187*t65* & - t86+0.5555555559e0_dp*t1129*t512-0.1666666668e0_dp*t192*t530 & - *t864-0.1666666668e0_dp*t1106*t882-0.1666666668e0_dp*t192* & - t530*t866-0.1481481482e1_dp*t192*t1099*t777-0.1111111112e0_dp & - *t3129*t196+0.5555555559e0_dp*t1193*t866*t451-0.1666666668e0_dp & - *t503*t2282-0.1666666668e0_dp*t3085*t275+0.1111111112e0_dp & + t3141 = -0.3333333336e0_dp*t192*t2299*t1125 - 0.1666666668e0_dp*t3097 & + *t3098 + 0.1111111112e0_dp*t503*t2300 + 0.1111111112e0_dp*t1129 & + *t527 - 0.1666666668e0_dp*t1129*t531 - 0.5555555558e-1_dp*t192 & + *t68*t3070*t65 + 0.1646090535e0_dp*t192*t97*t187*t65* & + t86 + 0.5555555559e0_dp*t1129*t512 - 0.1666666668e0_dp*t192*t530 & + *t864 - 0.1666666668e0_dp*t1106*t882 - 0.1666666668e0_dp*t192* & + t530*t866 - 0.1481481482e1_dp*t192*t1099*t777 - 0.1111111112e0_dp & + *t3129*t196 + 0.5555555559e0_dp*t1193*t866*t451 - 0.1666666668e0_dp & + *t503*t2282 - 0.1666666668e0_dp*t3085*t275 + 0.1111111112e0_dp & *t503*t2312 - t3181 = -0.1851851853e0_dp*t1106*t874-0.1666666668e0_dp*t508*t1235 & - -0.3333333336e0_dp*t508*t1224-0.1111111112e0_dp*t516*t2281 & - *t172+0.1111111112e0_dp*t516*t1097*t526+0.2222222223e0_dp* & - t1106*t878-0.1851851853e0_dp*t503*t2308-0.3333333336e0_dp*t1137 & - *t1216+(3*t3098)+0.1111111112e0_dp*t516*t1109*t526 & - -0.5555555558e-1_dp*t503*t2287-0.3333333336e0_dp*t192*t2311 & - *t1125-0.6666666672e0_dp*t508*t1126+0.1646090535e0_dp*t503 & - *t2319-0.5555555558e-1_dp*t3129*t200-0.5555555558e-1_dp*t58 & - *t2622*t71-0.1666666668e0_dp*t1106*t886 - t3232 = -0.1666666668e0_dp*t192*t1206*t267-0.5555555558e-1_dp*t192 & - *t199*t2295-0.1666666668e0_dp*t508*t1122-0.3333333336e0_dp & - *t1129*t520-0.1111111112e0_dp*t516*t2295*t172-0.1481481482e1_dp & - *t66*t67*t97*t267*t1100-0.1851851853e0_dp*t192* & - t22*t496*t1200-0.3333333336e0_dp*t516*t2292*t65*my_rho* & - t25+0.1810699590e1_dp*t192*t311*t70*t2732-0.5555555558e-1_dp & - *t503*t2304-0.1481481482e1_dp*t508*t1101-0.3333333336e0_dp* & - t867*t515*t517+0.1111111112e1_dp*t268*t1192*t1194+0.5555555559e0_dp & - *t1193*t864*t451+0.1111111112e1_dp*t508*t1213- & - 0.1666666668e0_dp*t508*t1207-0.3333333336e0_dp*t1137*t1134 + t3181 = -0.1851851853e0_dp*t1106*t874 - 0.1666666668e0_dp*t508*t1235 & + - 0.3333333336e0_dp*t508*t1224 - 0.1111111112e0_dp*t516*t2281 & + *t172 + 0.1111111112e0_dp*t516*t1097*t526 + 0.2222222223e0_dp* & + t1106*t878 - 0.1851851853e0_dp*t503*t2308 - 0.3333333336e0_dp*t1137 & + *t1216 + (3*t3098) + 0.1111111112e0_dp*t516*t1109*t526 & + - 0.5555555558e-1_dp*t503*t2287 - 0.3333333336e0_dp*t192*t2311 & + *t1125 - 0.6666666672e0_dp*t508*t1126 + 0.1646090535e0_dp*t503 & + *t2319 - 0.5555555558e-1_dp*t3129*t200 - 0.5555555558e-1_dp*t58 & + *t2622*t71 - 0.1666666668e0_dp*t1106*t886 + t3232 = -0.1666666668e0_dp*t192*t1206*t267 - 0.5555555558e-1_dp*t192 & + *t199*t2295 - 0.1666666668e0_dp*t508*t1122 - 0.3333333336e0_dp & + *t1129*t520 - 0.1111111112e0_dp*t516*t2295*t172 - 0.1481481482e1_dp & + *t66*t67*t97*t267*t1100 - 0.1851851853e0_dp*t192* & + t22*t496*t1200 - 0.3333333336e0_dp*t516*t2292*t65*my_rho* & + t25 + 0.1810699590e1_dp*t192*t311*t70*t2732 - 0.5555555558e-1_dp & + *t503*t2304 - 0.1481481482e1_dp*t508*t1101 - 0.3333333336e0_dp* & + t867*t515*t517 + 0.1111111112e1_dp*t268*t1192*t1194 + 0.5555555559e0_dp & + *t1193*t864*t451 + 0.1111111112e1_dp*t508*t1213 - & + 0.1666666668e0_dp*t508*t1207 - 0.3333333336e0_dp*t1137*t1134 t3244 = t278*t140 t3248 = t889*my_rho t3262 = omega*t1300 t3264 = t140*t2160 - t3268 = 0.1555555556e1_dp*t2937*t446*t2843+0.3111111111e1_dp*t170 & - *t1268*t777-0.2500000000e0_dp*t429*t1275*t290-0.1333333334e1_dp & - *t1373*t1292*t1172+0.3111111111e1_dp*t170*t341*t278 & - *t1100-0.3456790122e0_dp*t170*t341*t203*t86+0.3750000000e0_dp & - *t1368*t166*t2418+0.4444444444e0_dp*t170*t114*t537 & - *t14+0.3333333334e0_dp*t55*t57*(t3093+t3141+t3181+t3232) & - -0.1111111111e0_dp*t2885*t1247*t2368-0.6666666668e0_dp*t1373 & - *t446*t2869+0.1666666667e0_dp*t1246*t3244*t833+0.5000000001e0_dp & - *t445*t3248*t413-0.1666666667e0_dp*t165*t171* & - t1067*t17-0.2500000000e0_dp*t429*t437*t918+0.3750000000e0_dp & - *t1368*t437*t907-0.3125000000e0_dp*t3262*t45*t166*t3264 + t3268 = 0.1555555556e1_dp*t2937*t446*t2843 + 0.3111111111e1_dp*t170 & + *t1268*t777 - 0.2500000000e0_dp*t429*t1275*t290 - 0.1333333334e1_dp & + *t1373*t1292*t1172 + 0.3111111111e1_dp*t170*t341*t278 & + *t1100 - 0.3456790122e0_dp*t170*t341*t203*t86 + 0.3750000000e0_dp & + *t1368*t166*t2418 + 0.4444444444e0_dp*t170*t114*t537 & + *t14 + 0.3333333334e0_dp*t55*t57*(t3093 + t3141 + t3181 + t3232) & + - 0.1111111111e0_dp*t2885*t1247*t2368 - 0.6666666668e0_dp*t1373 & + *t446*t2869 + 0.1666666667e0_dp*t1246*t3244*t833 + 0.5000000001e0_dp & + *t445*t3248*t413 - 0.1666666667e0_dp*t165*t171* & + t1067*t17 - 0.2500000000e0_dp*t429*t437*t918 + 0.3750000000e0_dp & + *t1368*t437*t907 - 0.3125000000e0_dp*t3262*t45*t166*t3264 t3278 = my_rho*t398 - t3288 = -0.1000000001e1_dp*t165*t2636*t237-0.2000000001e1_dp*t55 & - *t926-0.1000000001e1_dp*t83*t922*t379-0.5000000004e0_dp*t289 & - *t84*t2645+0.2500000002e0_dp*t429*t897*t754-0.1000000001e1_dp & - *t83*t294*t1067-0.1666666668e0_dp*t289*t84*t2655 & - -0.1000000001e1_dp*t83*t2404*t237-0.5000000004e0_dp*t289*t922 & - *t290-0.5000000004e0_dp*t289*t384*t2169-0.5000000004e0_dp & - *t289*t1071*t754-0.2222222224e0_dp*t144*t46*(t2724+t2783 & - +t2935+t3268)-0.3333333336e0_dp*t83*t45*t2392*t140- & - 0.1250000001e0_dp*t3278*omega*t84*t3264-0.1000000001e1_dp*t55 & - *t1068+0.8333333340e-1_dp*t906*t384*t2160 - t3291 = -0.1000000001e1_dp*t2147*t84*t754-0.4000000002e1_dp*t747 & - *t294*t237-0.2000000001e1_dp*t747*t84*t804-0.1333333334e1_dp & - *t214*t894+0.1666666668e0_dp*t4*t150*t46*t78*t2160 & - -0.1000000001e1_dp*t753*t46*t282*t754-0.1000000001e1_dp*t1409 & - *t84*t2169-0.2000000001e1_dp*t217*t46*t893*t237-0.2000000001e1_dp & - *t217*t46*t282*t804-0.6666666672e0_dp*t217* & - t46*t78*t2230-0.4444444448e0_dp*t43*t46*t2392+t8*(t2635 & - +t3288) + t3288 = -0.1000000001e1_dp*t165*t2636*t237 - 0.2000000001e1_dp*t55 & + *t926 - 0.1000000001e1_dp*t83*t922*t379 - 0.5000000004e0_dp*t289 & + *t84*t2645 + 0.2500000002e0_dp*t429*t897*t754 - 0.1000000001e1_dp & + *t83*t294*t1067 - 0.1666666668e0_dp*t289*t84*t2655 & + - 0.1000000001e1_dp*t83*t2404*t237 - 0.5000000004e0_dp*t289*t922 & + *t290 - 0.5000000004e0_dp*t289*t384*t2169 - 0.5000000004e0_dp & + *t289*t1071*t754 - 0.2222222224e0_dp*t144*t46*(t2724 + t2783 & + + t2935 + t3268) - 0.3333333336e0_dp*t83*t45*t2392*t140 - & + 0.1250000001e0_dp*t3278*omega*t84*t3264 - 0.1000000001e1_dp*t55 & + *t1068 + 0.8333333340e-1_dp*t906*t384*t2160 + t3291 = -0.1000000001e1_dp*t2147*t84*t754 - 0.4000000002e1_dp*t747 & + *t294*t237 - 0.2000000001e1_dp*t747*t84*t804 - 0.1333333334e1_dp & + *t214*t894 + 0.1666666668e0_dp*t4*t150*t46*t78*t2160 & + - 0.1000000001e1_dp*t753*t46*t282*t754 - 0.1000000001e1_dp*t1409 & + *t84*t2169 - 0.2000000001e1_dp*t217*t46*t893*t237 - 0.2000000001e1_dp & + *t217*t46*t282*t804 - 0.6666666672e0_dp*t217* & + t46*t78*t2230 - 0.4444444448e0_dp*t43*t46*t2392 + t8*(t2635 & + + t3288) END IF IF (grad_deriv >= 3 .OR. grad_deriv == -3) THEN - e_rho_rho_rho(ii) = e_rho_rho_rho(ii)+t3291*sx + e_rho_rho_rho(ii) = e_rho_rho_rho(ii) + t3291*sx t3305 = t4*t428 t3306 = t754*t561 t3314 = t237*t1447 @@ -1767,27 +1767,27 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t3362 = t800*t557 t3363 = t327*t3362 t3366 = beta*t777 - t3378 = 0.1866666667e2_dp*t3366*t342+0.9866666667e2_dp*t24*t782 & - -0.8266666668e2_dp*t366*t797+0.3200000001e2_dp*t1054/t1014/ & + t3378 = 0.1866666667e2_dp*t3366*t342 + 0.9866666667e2_dp*t24*t782 & + - 0.8266666668e2_dp*t366*t797 + 0.3200000001e2_dp*t1054/t1014/ & t12*t1058 t3379 = t105*t3378 - t3382 = 0.3911111110e2_dp*t24*t766-0.1955555555e2_dp*t962*t3339 & - +0.2133333334e2_dp*t339*t769-0.2133333334e2_dp*t321*t3344+ & - 0.1066666667e2_dp*t321*t3347+0.80e1_dp*t112*t773-0.120e2_dp*t102 & - *t3353+0.80e1_dp*t102*t3357-0.40e1_dp*t112*t801+0.40e1_dp & - *t102*t3363-0.20e1_dp*t102*t3379 + t3382 = 0.3911111110e2_dp*t24*t766 - 0.1955555555e2_dp*t962*t3339 & + + 0.2133333334e2_dp*t339*t769 - 0.2133333334e2_dp*t321*t3344 + & + 0.1066666667e2_dp*t321*t3347 + 0.80e1_dp*t112*t773 - 0.120e2_dp*t102 & + *t3353 + 0.80e1_dp*t102*t3357 - 0.40e1_dp*t112*t801 + 0.40e1_dp & + *t102*t3363 - 0.20e1_dp*t102*t3379 t3449 = t1447*t17 - t3453 = (2*t147*t1885*t249)+0.1800000000e2_dp*(t1971) & - *(t1972)*(t1973)*(t249)+(2*t147*t393 & - *t1470)+0.1800000000e2_dp*t658*t575*t827+0.2e1_dp*(t147) & - *t149*(-0.5625000000e1_dp*t1302*t19*t754*t561+0.4500000000e1_dp & - *t400*t1459*t1447+0.1500000000e1_dp*t400*t815*t1483 & - -0.1000000000e1_dp*t405*t68*t1447*t17+0.2250000000e1_dp* & - t400*t19*t804*t561-0.1500000000e1_dp*t151*t50*t3382+0.3333333334e0_dp & - *t405*t194*t14*t561)+0.1250000000e0_dp*t1368 & - *t166*t3306-0.8333333335e-1_dp*t429*t679*t754-0.1666666667e0_dp & - *t429*t166*t3314+0.5555555555e-1_dp*t1246*t74*t237 & - *t1483-0.1111111111e0_dp*t165*t689*t833-0.1111111111e0_dp* & + t3453 = (2*t147*t1885*t249) + 0.1800000000e2_dp*(t1971) & + *(t1972)*(t1973)*(t249) + (2*t147*t393 & + *t1470) + 0.1800000000e2_dp*t658*t575*t827 + 0.2e1_dp*(t147) & + *t149*(-0.5625000000e1_dp*t1302*t19*t754*t561 + 0.4500000000e1_dp & + *t400*t1459*t1447 + 0.1500000000e1_dp*t400*t815*t1483 & + - 0.1000000000e1_dp*t405*t68*t1447*t17 + 0.2250000000e1_dp* & + t400*t19*t804*t561 - 0.1500000000e1_dp*t151*t50*t3382 + 0.3333333334e0_dp & + *t405*t194*t14*t561) + 0.1250000000e0_dp*t1368 & + *t166*t3306 - 0.8333333335e-1_dp*t429*t679*t754 - 0.1666666667e0_dp & + *t429*t166*t3314 + 0.5555555555e-1_dp*t1246*t74*t237 & + *t1483 - 0.1111111111e0_dp*t165*t689*t833 - 0.1111111111e0_dp* & t165*t171*t3449 t3472 = t14*t561 t3491 = 0.5400000000e2_dp*t1143*t20*t754*t561 @@ -1797,16 +1797,16 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t3505 = 0.1800000000e2_dp*t473*t20*t804*t561 t3507 = t178*t62*t3382 t3512 = 0.2000000000e1_dp*t478*t27*t14*t561 - t3513 = t3491-t3494-t3497+t3501-t3505+0.8999999998e1_dp*t3507 & - -t3512 + t3513 = t3491 - t3494 - t3497 + t3501 - t3505 + 0.8999999998e1_dp*t3507 & + - t3512 t3514 = t3513*t65 t3525 = t58*t3382 t3533 = t237*t1518 - t3543 = t3514+0.8999999998e1_dp*t863*t59*t177*t710+(2 & - *t267*t1504)+0.8999999998e1_dp*t865*t59*t177*t710-0.5555555558e-1_dp & - *t3525*t71-0.5000000001e0_dp*t804*t177*t709+ & - 0.7407407410e-1_dp*t1755*t271+0.6666666668e0_dp*t3533*t1722- & - 0.1111111112e0_dp*t1755*t275-0.1111111112e0_dp*t508*t1525-0.1000000001e1_dp & + t3543 = t3514 + 0.8999999998e1_dp*t863*t59*t177*t710 + (2 & + *t267*t1504) + 0.8999999998e1_dp*t865*t59*t177*t710 - 0.5555555558e-1_dp & + *t3525*t71 - 0.5000000001e0_dp*t804*t177*t709 + & + 0.7407407410e-1_dp*t1755*t271 + 0.6666666668e0_dp*t3533*t1722 - & + 0.1111111112e0_dp*t1755*t275 - 0.1111111112e0_dp*t508*t1525 - 0.1000000001e1_dp & *t237*t266*t1722 t3546 = 0.1e1_dp/t12 t3547 = t60*t3546 @@ -1814,90 +1814,90 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t3553 = t3552*t526 t3561 = t68*t3513*t65 t3569 = t274*t1505 - t3575 = -0.6172839508e-1_dp*t719*t874-0.5555555556e0_dp*t3547*t709 & - +0.7407407410e-1_dp*t719*t878+0.7407407410e-1_dp*t192*t3553 & - +0.6666666668e0_dp*t1519*t1712-0.5555555558e-1_dp*t719*t882 & - -0.5555555558e-1_dp*t192*t3561-0.5000000001e0_dp*t60*t863* & - t709-0.5555555558e-1_dp*t719*t886-0.1111111112e0_dp*t192*t3569 & - -0.5000000001e0_dp*t60*t865*t709 - t3576 = t3543+t3575 - t3580 = -0.1666666667e0_dp*t429*t437*t1410+0.3333333334e0_dp*t165 & - *t1928*t237+0.3333333334e0_dp*t165*t437*t1447-0.8333333335e-1_dp & - *t429*t166*t3329+0.1666666667e0_dp*t165*t679*t804 & - +0.1666666667e0_dp*t165*t166*t3382+0.7407407405e-1_dp*t165 & - *t450*t3472+0.1481481481e0_dp*t170*t1875*t14-0.1111111111e0_dp & - *t165*t455*t1483-0.2222222222e0_dp*t170*t1932*t17+ & - 0.1666666667e0_dp*t165*t1275*t561+0.3333333334e0_dp*t55*t57 & + t3575 = -0.6172839508e-1_dp*t719*t874 - 0.5555555556e0_dp*t3547*t709 & + + 0.7407407410e-1_dp*t719*t878 + 0.7407407410e-1_dp*t192*t3553 & + + 0.6666666668e0_dp*t1519*t1712 - 0.5555555558e-1_dp*t719*t882 & + - 0.5555555558e-1_dp*t192*t3561 - 0.5000000001e0_dp*t60*t863* & + t709 - 0.5555555558e-1_dp*t719*t886 - 0.1111111112e0_dp*t192*t3569 & + - 0.5000000001e0_dp*t60*t865*t709 + t3576 = t3543 + t3575 + t3580 = -0.1666666667e0_dp*t429*t437*t1410 + 0.3333333334e0_dp*t165 & + *t1928*t237 + 0.3333333334e0_dp*t165*t437*t1447 - 0.8333333335e-1_dp & + *t429*t166*t3329 + 0.1666666667e0_dp*t165*t679*t804 & + + 0.1666666667e0_dp*t165*t166*t3382 + 0.7407407405e-1_dp*t165 & + *t450*t3472 + 0.1481481481e0_dp*t170*t1875*t14 - 0.1111111111e0_dp & + *t165*t455*t1483 - 0.2222222222e0_dp*t170*t1932*t17 + & + 0.1666666667e0_dp*t165*t1275*t561 + 0.3333333334e0_dp*t55*t57 & *t3576 - t3581 = t3453+t3580 + t3581 = t3453 + t3580 t3608 = t973*my_rho - t3618 = 0.640e2_dp*t1597*t1598*t3356-0.640e2_dp*t1582*t773- & - 0.1173333333e3_dp*t93*t3347-0.3911111110e2_dp*t1000*t963-0.320e2_dp & - *t605*t959+0.1173333333e3_dp*t307*t949*t1602+0.40e1_dp & - *t102*t327*t136*t3378-0.960e2_dp*t1597*t3608*t3352- & - 0.40e1_dp*t112*t1064+0.80e1_dp*t112*t984+0.2737777778e3_dp*t307 & + t3618 = 0.640e2_dp*t1597*t1598*t3356 - 0.640e2_dp*t1582*t773 - & + 0.1173333333e3_dp*t93*t3347 - 0.3911111110e2_dp*t1000*t963 - 0.320e2_dp & + *t605*t959 + 0.1173333333e3_dp*t307*t949*t1602 + 0.40e1_dp & + *t102*t327*t136*t3378 - 0.960e2_dp*t1597*t3608*t3352 - & + 0.40e1_dp*t112*t1064 + 0.80e1_dp*t112*t984 + 0.2737777778e3_dp*t307 & *t3339 t3668 = t2552*t23 t3673 = t635*t1058 t3674 = t3673*t220 - t3677 = -0.1866666667e3_dp*t1645*t342-0.6346666667e3_dp*t24*t991 & - +0.3946666667e3_dp*t366*t997+0.1866666667e3_dp*beta*t764* & - t1004+0.60e1_dp*t550*t1046+0.60e1_dp*t119*t27*(-0.280e3_dp/ & - 0.9e1_dp*t987+0.280e3_dp/0.9e1_dp*t2537*my_rho)*t132-0.60e1_dp*t7 & - *t640*t1044*t371+0.1600000000e2_dp*t366*t368*t1667*t371 & - -0.4800000000e2_dp*t1680*t3668+0.1600000000e3_dp*t1680*t1060 & - +0.3200000000e2_dp*t1055*t3674 + t3677 = -0.1866666667e3_dp*t1645*t342 - 0.6346666667e3_dp*t24*t991 & + + 0.3946666667e3_dp*t366*t997 + 0.1866666667e3_dp*beta*t764* & + t1004 + 0.60e1_dp*t550*t1046 + 0.60e1_dp*t119*t27*(-0.280e3_dp/ & + 0.9e1_dp*t987 + 0.280e3_dp/0.9e1_dp*t2537*my_rho)*t132 - 0.60e1_dp*t7 & + *t640*t1044*t371 + 0.1600000000e2_dp*t366*t368*t1667*t371 & + - 0.4800000000e2_dp*t1680*t3668 + 0.1600000000e3_dp*t1680*t1060 & + + 0.3200000000e2_dp*t1055*t3674 t3679 = t2565*t1439 t3682 = t24*t940 - t3711 = -0.1600000000e3_dp*t2220*t368*t3679+0.6346666667e3_dp*t3682 & - *t1008-0.3946666667e3_dp*t366*t1012*t1021+0.1866666667e2_dp & - *t3366*t1026+0.1866666667e2_dp*t1024*t341*t635*t132 & - -0.1706666667e3_dp*t7*t1036-0.1600000000e2_dp*t1429*t1030-0.1600000000e2_dp & - *t350*t114*t1667*t132+0.6400000000e2_dp*t7* & - t1050-0.5066666667e2_dp*t366*t1034*t635*t371+0.1520000000e3_dp & + t3711 = -0.1600000000e3_dp*t2220*t368*t3679 + 0.6346666667e3_dp*t3682 & + *t1008 - 0.3946666667e3_dp*t366*t1012*t1021 + 0.1866666667e2_dp & + *t3366*t1026 + 0.1866666667e2_dp*t1024*t341*t635*t132 & + - 0.1706666667e3_dp*t7*t1036 - 0.1600000000e2_dp*t1429*t1030 - 0.1600000000e2_dp & + *t350*t114*t1667*t132 + 0.6400000000e2_dp*t7* & + t1050 - 0.5066666667e2_dp*t366*t1034*t635*t371 + 0.1520000000e3_dp & *t786*t1034*t1681 - t3726 = -0.240e2_dp*t1616*t1617*t3356+0.160e2_dp*t302*t3379+ & - 0.40e1_dp*t102*t327*t1063*t557+0.960e2_dp*t302*t3353-0.320e2_dp & - *t302*t3363-0.2737777778e3_dp*t941*t2468*t608-0.120e2_dp & - *t102*t974*t645*t772-0.2133333334e2_dp*t321*t953*t1621 & - -0.20e1_dp*t102*t105*(t3677+t3711)+0.80e1_dp*t102*t327 & - *t375*t1443-0.120e2_dp*t1616*t1617*t3362-0.2133333334e2_dp & + t3726 = -0.240e2_dp*t1616*t1617*t3356 + 0.160e2_dp*t302*t3379 + & + 0.40e1_dp*t102*t327*t1063*t557 + 0.960e2_dp*t302*t3353 - 0.320e2_dp & + *t302*t3363 - 0.2737777778e3_dp*t941*t2468*t608 - 0.120e2_dp & + *t102*t974*t645*t772 - 0.2133333334e2_dp*t321*t953*t1621 & + - 0.20e1_dp*t102*t105*(t3677 + t3711) + 0.80e1_dp*t102*t327 & + *t375*t1443 - 0.120e2_dp*t1616*t1617*t3362 - 0.2133333334e2_dp & *t321*t953*t1625 t3750 = t2585*t136 - t3763 = 0.2346666666e3_dp*t1589*t950+0.80e1_dp*t102*t327*t1684 & - *t233+0.6400000002e2_dp*t7*t220*t1618-0.240e2_dp*t112*t976 & - -0.160e2_dp*t93*t316*my_rho*t3378+0.2346666666e3_dp*t93* & - t3344+0.3911111110e2_dp*t962*t2611*t614-0.5475555556e3_dp*t24 & - *t930+0.480e2_dp*t1616*t3750*t3352-0.1955555555e2_dp*t962 & - *t949*t645-0.240e2_dp*t1616*t973*t375*t1425+0.2133333334e2_dp & + t3763 = 0.2346666666e3_dp*t1589*t950 + 0.80e1_dp*t102*t327*t1684 & + *t233 + 0.6400000002e2_dp*t7*t220*t1618 - 0.240e2_dp*t112*t976 & + - 0.160e2_dp*t93*t316*my_rho*t3378 + 0.2346666666e3_dp*t93* & + t3344 + 0.3911111110e2_dp*t962*t2611*t614 - 0.5475555556e3_dp*t24 & + *t930 + 0.480e2_dp*t1616*t3750*t3352 - 0.1955555555e2_dp*t962 & + *t949*t645 - 0.240e2_dp*t1616*t973*t375*t1425 + 0.2133333334e2_dp & *t339*t969 - t3794 = -0.640e2_dp*t302*t3357-0.4266666668e2_dp*t339*t966+0.640e2_dp & - *t605*t955+0.40e1_dp*t102*t327*t645*t800+0.5475555556e3_dp & - *t3682*t946+0.1066666667e2_dp*t321*t316*t1684+0.160e2_dp & - *t112*t980-0.2346666666e3_dp*t7*t929*t1599+0.320e2_dp & - *t1597*t1598*t3362-0.2346666666e3_dp*t605*t769+0.320e2_dp & - *t1582*t801-0.2133333334e2_dp*t321*t953*t1631 - t3796 = t3618+t3726+t3763+t3794 - t3826 = 0.8333333340e-1_dp*t906*t597*t907+0.1666666668e0_dp*t429 & - *t1547-0.3333333336e0_dp*t83*t84*t3796-0.3333333336e0_dp* & - t83*t922*t649-0.3333333336e0_dp*t289*t294*t1571-0.3333333336e0_dp & - *t289*t1071*t1410-0.6666666672e0_dp*t83*t1564*t379 & - -0.6666666672e0_dp*t55*t1700-0.3333333336e0_dp*t165*t207* & - t237*t561-0.6666666672e0_dp*t55*t1689-0.3333333336e0_dp*t83 & - *t1694*t804+0.1666666668e0_dp*t1546*t897*t3314 + t3794 = -0.640e2_dp*t302*t3357 - 0.4266666668e2_dp*t339*t966 + 0.640e2_dp & + *t605*t955 + 0.40e1_dp*t102*t327*t645*t800 + 0.5475555556e3_dp & + *t3682*t946 + 0.1066666667e2_dp*t321*t316*t1684 + 0.160e2_dp & + *t112*t980 - 0.2346666666e3_dp*t7*t929*t1599 + 0.320e2_dp & + *t1597*t1598*t3362 - 0.2346666666e3_dp*t605*t769 + 0.320e2_dp & + *t1582*t801 - 0.2133333334e2_dp*t321*t953*t1631 + t3796 = t3618 + t3726 + t3763 + t3794 + t3826 = 0.8333333340e-1_dp*t906*t597*t907 + 0.1666666668e0_dp*t429 & + *t1547 - 0.3333333336e0_dp*t83*t84*t3796 - 0.3333333336e0_dp* & + t83*t922*t649 - 0.3333333336e0_dp*t289*t294*t1571 - 0.3333333336e0_dp & + *t289*t1071*t1410 - 0.6666666672e0_dp*t83*t1564*t379 & + - 0.6666666672e0_dp*t55*t1700 - 0.3333333336e0_dp*t165*t207* & + t237*t561 - 0.6666666672e0_dp*t55*t1689 - 0.3333333336e0_dp*t83 & + *t1694*t804 + 0.1666666668e0_dp*t1546*t897*t3314 t3827 = t649*t804 t3842 = t3278*t46 t3849 = t140*t3382 t3853 = t649*t754 t3861 = t78*t649 t3865 = t589*t140 - t3869 = -0.1666666668e0_dp*t289*t84*t3827-0.1666666668e0_dp*t289 & - *t922*t593+0.1666666668e0_dp*t1546*t2636*t1410-0.6666666672e0_dp & - *t55*t1703-0.3333333336e0_dp*t83*t597*t1067-0.1250000001e0_dp & - *t3842*t897*t3306-0.3333333336e0_dp*t83*t384* & - t3382-0.1666666668e0_dp*t289*t84*t3849+0.8333333340e-1_dp*t906 & - *t84*t3853-0.6666666672e0_dp*t55*t1568-0.6666666672e0_dp* & - t55*t1565-0.3333333336e0_dp*t165*t3861*t237-0.3333333336e0_dp & + t3869 = -0.1666666668e0_dp*t289*t84*t3827 - 0.1666666668e0_dp*t289 & + *t922*t593 + 0.1666666668e0_dp*t1546*t2636*t1410 - 0.6666666672e0_dp & + *t55*t1703 - 0.3333333336e0_dp*t83*t597*t1067 - 0.1250000001e0_dp & + *t3842*t897*t3306 - 0.3333333336e0_dp*t83*t384* & + t3382 - 0.1666666668e0_dp*t289*t84*t3849 + 0.8333333340e-1_dp*t906 & + *t84*t3853 - 0.6666666672e0_dp*t55*t1568 - 0.6666666672e0_dp* & + t55*t1565 - 0.3333333336e0_dp*t165*t3861*t237 - 0.3333333336e0_dp & *t165*t3865*t237 t3871 = t379*t1447 t3875 = t45*t2002 @@ -1907,204 +1907,204 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t3933 = t451*t1410 t3939 = t1301*t245 t3940 = t172*t3306 - t3965 = 0.1500000000e1_dp*t405*t156*t3918+0.1968750000e2_dp*t2823 & - *t401*t3306+0.1666666666e1_dp*t405*t1340*t3925+0.3000000000e1_dp & - *t405*t1333*t1447+0.3000000000e1_dp*t399*t822*t3933 & - +0.2250000000e1_dp*t400*t401*t3382+0.5625000000e1_dp*t3939 & - *t3940+0.3333333333e0_dp*t405*t194*t649*t14-0.1125000000e2_dp & - *t1302*t1309*t1410+0.2250000000e1_dp*t400*t1892*t804 & - -0.5625000000e1_dp*t1302*t401*t3329-0.5625000000e1_dp*t1302 & - *t1892*t754+0.2250000000e1_dp*t400*t2808*t561-0.4500000000e1_dp & + t3965 = 0.1500000000e1_dp*t405*t156*t3918 + 0.1968750000e2_dp*t2823 & + *t401*t3306 + 0.1666666666e1_dp*t405*t1340*t3925 + 0.3000000000e1_dp & + *t405*t1333*t1447 + 0.3000000000e1_dp*t399*t822*t3933 & + + 0.2250000000e1_dp*t400*t401*t3382 + 0.5625000000e1_dp*t3939 & + *t3940 + 0.3333333333e0_dp*t405*t194*t649*t14 - 0.1125000000e2_dp & + *t1302*t1309*t1410 + 0.2250000000e1_dp*t400*t1892*t804 & + - 0.5625000000e1_dp*t1302*t401*t3329 - 0.5625000000e1_dp*t1302 & + *t1892*t754 + 0.2250000000e1_dp*t400*t2808*t561 - 0.4500000000e1_dp & *t400*t1333*t1410 t3969 = t172*t3314 t3975 = t19*t1688 t3979 = t290*t1483 t3985 = t172*t3329 - t4010 = -0.1125000000e2_dp*t1302*t401*t3314-0.4500000000e1_dp*t1912 & - *t3969+0.4500000000e1_dp*t400*t1309*t1447+0.4500000000e1_dp & - *t400*t3975*t237-0.3750000000e1_dp*t3939*t3979-0.2000000000e1_dp & - *t405*t417*t3892-0.2250000000e1_dp*t1912*t3985- & - 0.2000000000e1_dp*t405*t2873*t561-0.5000000000e0_dp*t400*t1316 & - *t3472-0.1000000000e1_dp*t405*t68*t1688*t17+0.1500000000e1_dp & - *t400*t406*t3449-0.1500000000e1_dp*t151*t50*t3796 & - +0.1500000000e1_dp*t400*t1902*t833+0.1500000000e1_dp*t400* & + t4010 = -0.1125000000e2_dp*t1302*t401*t3314 - 0.4500000000e1_dp*t1912 & + *t3969 + 0.4500000000e1_dp*t400*t1309*t1447 + 0.4500000000e1_dp & + *t400*t3975*t237 - 0.3750000000e1_dp*t3939*t3979 - 0.2000000000e1_dp & + *t405*t417*t3892 - 0.2250000000e1_dp*t1912*t3985 - & + 0.2000000000e1_dp*t405*t2873*t561 - 0.5000000000e0_dp*t400*t1316 & + *t3472 - 0.1000000000e1_dp*t405*t68*t1688*t17 + 0.1500000000e1_dp & + *t400*t406*t3449 - 0.1500000000e1_dp*t151*t50*t3796 & + + 0.1500000000e1_dp*t400*t1902*t833 + 0.1500000000e1_dp*t400* & t1320*t1483 - t4018 = 0.2222222222e0_dp*t2885*t446*t1172*t561-0.1666666667e0_dp & - *t1246*t1292*t1865-0.4444444445e0_dp*t1373*t446*t3892 & - -0.1111111111e0_dp*t165*t171*t1688*t17+0.1666666667e0_dp*t165 & - *t56*t3576*t140+0.1250000000e0_dp*t2763*t446*t1168* & - t561+0.3333333334e0_dp*t165*t689*t413+0.1666666667e0_dp*t165 & - *t679*t1067-0.1666666667e0_dp*t1246*t446*t413*t1447+ & - (2*t147*t149*(t3965+t4010))-0.4444444445e0_dp*t1373* & + t4018 = 0.2222222222e0_dp*t2885*t446*t1172*t561 - 0.1666666667e0_dp & + *t1246*t1292*t1865 - 0.4444444445e0_dp*t1373*t446*t3892 & + - 0.1111111111e0_dp*t165*t171*t1688*t17 + 0.1666666667e0_dp*t165 & + *t56*t3576*t140 + 0.1250000000e0_dp*t2763*t446*t1168* & + t561 + 0.3333333334e0_dp*t165*t689*t413 + 0.1666666667e0_dp*t165 & + *t679*t1067 - 0.1666666667e0_dp*t1246*t446*t413*t1447 + & + (2*t147*t149*(t3965 + t4010)) - 0.4444444445e0_dp*t1373* & t1292*t1829 t4025 = t3262*t57 t4032 = t74*t649 t4070 = t3525*t67 - t4079 = -0.5555555558e-1_dp*t192*t199*t3514+(t705*t863* & - t65)+(2*t496*t1504*t65)+(t187*t3513*t65)- & - 0.5555555558e-1_dp*t192*t728*t864-0.5555555556e0_dp*t140*t3546 & - *t1722+(t705*t865*t65)-0.1111111112e0_dp*t1106*t1525 & - -0.1111111112e0_dp*t4070*t196+0.6666666668e0_dp*t1748*t266 & - *t1722+0.3703703706e0_dp*t1193*t1505*t451 + t4079 = -0.5555555558e-1_dp*t192*t199*t3514 + (t705*t863* & + t65) + (2*t496*t1504*t65) + (t187*t3513*t65) - & + 0.5555555558e-1_dp*t192*t728*t864 - 0.5555555556e0_dp*t140*t3546 & + *t1722 + (t705*t865*t65) - 0.1111111112e0_dp*t1106*t1525 & + - 0.1111111112e0_dp*t4070*t196 + 0.6666666668e0_dp*t1748*t266 & + *t1722 + 0.3703703706e0_dp*t1193*t1505*t451 t4101 = t498*t1505 - t4108 = -0.5000000001e0_dp*t60*t1189*t709+0.3703703706e0_dp*t1755 & - *t512-0.5555555558e-1_dp*t503*t3561-0.2222222224e0_dp*t516 & - *t267*t172*t1504-0.5555555558e-1_dp*t1715*t886-0.5555555558e-1_dp & - *t1715*t882-0.1111111112e0_dp*t516*t3514*t172-0.5000000001e0_dp & - *t1067*t177*t709+(2*t4101)-0.1111111112e0_dp & - *t508*t1769-0.1111111112e0_dp*t192*t1837*t267 - t4140 = -0.5555555558e-1_dp*t719*t1207-0.2000000001e1_dp*t1763* & - t266*t1722-0.1111111112e0_dp*t192*t530*t1505+0.1333333334e1_dp & - *t1519*t722*t1712+0.7407407410e-1_dp*t516*t1718*t526 & - +0.6666666668e0_dp*t379*t1518*t1722-0.5555555558e-1_dp*t192* & - t728*t866-0.2222222224e0_dp*t719*t1126+0.1800000000e2_dp*t1111 & - *t178*t710-0.1111111112e0_dp*t508*t1782-0.5555555558e-1_dp & + t4108 = -0.5000000001e0_dp*t60*t1189*t709 + 0.3703703706e0_dp*t1755 & + *t512 - 0.5555555558e-1_dp*t503*t3561 - 0.2222222224e0_dp*t516 & + *t267*t172*t1504 - 0.5555555558e-1_dp*t1715*t886 - 0.5555555558e-1_dp & + *t1715*t882 - 0.1111111112e0_dp*t516*t3514*t172 - 0.5000000001e0_dp & + *t1067*t177*t709 + (2*t4101) - 0.1111111112e0_dp & + *t508*t1769 - 0.1111111112e0_dp*t192*t1837*t267 + t4140 = -0.5555555558e-1_dp*t719*t1207 - 0.2000000001e1_dp*t1763* & + t266*t1722 - 0.1111111112e0_dp*t192*t530*t1505 + 0.1333333334e1_dp & + *t1519*t722*t1712 + 0.7407407410e-1_dp*t516*t1718*t526 & + + 0.6666666668e0_dp*t379*t1518*t1722 - 0.5555555558e-1_dp*t192* & + t728*t866 - 0.2222222224e0_dp*t719*t1126 + 0.1800000000e2_dp*t1111 & + *t178*t710 - 0.1111111112e0_dp*t508*t1782 - 0.5555555558e-1_dp & *t58*t3796*t71 t4156 = t865*t561*t65 t4201 = t20*t1688 - t4214 = -0.8000000000e1_dp*t478*t123*t3925-0.2400000000e2_dp*t473 & - *t479*t3449+0.1200000000e2_dp*t478*t489*t3892+0.1200000000e2_dp & - *t478*t2998*t561-0.2000000000e1_dp*t478*t27*t649 & - *t14+0.1200000000e2_dp*t478*t56*t1688*t17-0.2400000000e2_dp & - *t473*t1161*t1483+0.1080000000e3_dp*t1143*t474*t3314- & - 0.2160000000e3_dp*t2994*t474*t3306+0.7200000000e2_dp*t1821* & - t3969-0.3600000000e2_dp*t473*t4201*t237-0.1800000000e2_dp*t473 & - *t3030*t561-0.2400000000e2_dp*t473*t1811*t833-0.1800000000e2_dp & + t4214 = -0.8000000000e1_dp*t478*t123*t3925 - 0.2400000000e2_dp*t473 & + *t479*t3449 + 0.1200000000e2_dp*t478*t489*t3892 + 0.1200000000e2_dp & + *t478*t2998*t561 - 0.2000000000e1_dp*t478*t27*t649 & + *t14 + 0.1200000000e2_dp*t478*t56*t1688*t17 - 0.2400000000e2_dp & + *t473*t1161*t1483 + 0.1080000000e3_dp*t1143*t474*t3314 - & + 0.2160000000e3_dp*t2994*t474*t3306 + 0.7200000000e2_dp*t1821* & + t3969 - 0.3600000000e2_dp*t473*t4201*t237 - 0.1800000000e2_dp*t473 & + *t3030*t561 - 0.2400000000e2_dp*t473*t1811*t833 - 0.1800000000e2_dp & *t478*t183*t3918 t4230 = t1142*t262 - t4255 = 0.5400000000e2_dp*t1143*t474*t3329+0.5400000000e2_dp*t1143 & - *t1801*t754+0.7200000000e2_dp*t473*t1176*t1410+0.8999999998e1_dp & - *t178*t62*t3796-0.2400000000e2_dp*t472*t859*t3933 & - -0.1080000000e3_dp*t4230*t3940+0.4000000000e1_dp*t473*t1157 & - *t3472+0.1080000000e3_dp*t1143*t1150*t1410+0.3600000000e2_dp & - *t1821*t3985+0.7200000000e2_dp*t4230*t3979-0.1800000000e2_dp & - *t473*t1801*t804-0.3600000000e2_dp*t473*t1150*t1447- & - 0.3600000000e2_dp*t478*t1176*t1447-0.1800000000e2_dp*t473*t474 & + t4255 = 0.5400000000e2_dp*t1143*t474*t3329 + 0.5400000000e2_dp*t1143 & + *t1801*t754 + 0.7200000000e2_dp*t473*t1176*t1410 + 0.8999999998e1_dp & + *t178*t62*t3796 - 0.2400000000e2_dp*t472*t859*t3933 & + - 0.1080000000e3_dp*t4230*t3940 + 0.4000000000e1_dp*t473*t1157 & + *t3472 + 0.1080000000e3_dp*t1143*t1150*t1410 + 0.3600000000e2_dp & + *t1821*t3985 + 0.7200000000e2_dp*t4230*t3979 - 0.1800000000e2_dp & + *t473*t1801*t804 - 0.3600000000e2_dp*t473*t1150*t1447 - & + 0.3600000000e2_dp*t478*t1176*t1447 - 0.1800000000e2_dp*t473*t474 & *t3382 - t4256 = t4214+t4255 - t4261 = -0.2222222224e0_dp*t1510*t515*t517+0.3703703706e0_dp*t719 & - *t1213-0.1000000001e1_dp*t1766*t266*t1722-0.5555555558e-1_dp & - *t4070*t200+0.6666666668e0_dp*t1519*t496*t561*t65-0.5000000001e0_dp & - *t732*t4156-0.5000000001e0_dp*t140*t865*t1722 & - -0.5000000001e0_dp*t804*t187*t1722-0.4938271608e0_dp*t719* & - t1101+0.8999999998e1_dp*t1097*t178*t710-0.5555555558e-1_dp* & + t4256 = t4214 + t4255 + t4261 = -0.2222222224e0_dp*t1510*t515*t517 + 0.3703703706e0_dp*t719 & + *t1213 - 0.1000000001e1_dp*t1766*t266*t1722 - 0.5555555558e-1_dp & + *t4070*t200 + 0.6666666668e0_dp*t1519*t496*t561*t65 - 0.5000000001e0_dp & + *t732*t4156 - 0.5000000001e0_dp*t140*t865*t1722 & + - 0.5000000001e0_dp*t804*t187*t1722 - 0.4938271608e0_dp*t719* & + t1101 + 0.8999999998e1_dp*t1097*t178*t710 - 0.5555555558e-1_dp* & t192*t68*t4256*t65 t4272 = t863*t561*t65 - t4292 = (2*t1836*t266*t65)-0.1111111112e0_dp*t719*t1224 & - -0.2222222224e0_dp*t1137*t1790-0.1000000001e1_dp*t723*t4272 & - -0.1111111112e0_dp*t1785*t1134-0.6172839508e-1_dp*t192*t22* & - t705*t1200-0.5000000001e0_dp*t140*t863*t1722-0.1111111112e0_dp & - *t1755*t531-0.6172839508e-1_dp*t1715*t874-0.5555555558e-1_dp & - *t719*t1122+0.7407407410e-1_dp*t508*t1726 - t4317 = 0.7407407410e-1_dp*t1755*t527-0.6172839508e-1_dp*t719*t1201 & - -0.1111111112e0_dp*t508*t1838-0.2222222224e0_dp*t192*t3552 & - *t1125+0.7407407410e-1_dp*t1785*t1221-0.1111111111e1_dp*t3547 & - *t1737+0.6666666668e0_dp*t1519*t187*t1712+0.7407407410e-1_dp & - *t503*t3553-0.1111111112e0_dp*t1755*t534-0.1000000001e1_dp & - *t1774*t1712+0.7407407410e-1_dp*t719*t1119 - t4345 = -0.1000000001e1_dp*t379*t266*t1722-0.1000000001e1_dp*t804 & - *t722*t1722+0.8999999998e1_dp*t1109*t178*t710-0.5555555558e-1_dp & - *t1129*t729+t4256*t65-0.2222222224e0_dp*t1755*t520 & - -0.1111111112e0_dp*t503*t3569-0.1111111112e0_dp*t1785*t1216 & - -0.1111111112e0_dp*t3097*t4101-0.5000000001e0_dp*t732*t4272 & - +0.7407407410e-1_dp*t192*t194*t1836*t526 + t4292 = (2*t1836*t266*t65) - 0.1111111112e0_dp*t719*t1224 & + - 0.2222222224e0_dp*t1137*t1790 - 0.1000000001e1_dp*t723*t4272 & + - 0.1111111112e0_dp*t1785*t1134 - 0.6172839508e-1_dp*t192*t22* & + t705*t1200 - 0.5000000001e0_dp*t140*t863*t1722 - 0.1111111112e0_dp & + *t1755*t531 - 0.6172839508e-1_dp*t1715*t874 - 0.5555555558e-1_dp & + *t719*t1122 + 0.7407407410e-1_dp*t508*t1726 + t4317 = 0.7407407410e-1_dp*t1755*t527 - 0.6172839508e-1_dp*t719*t1201 & + - 0.1111111112e0_dp*t508*t1838 - 0.2222222224e0_dp*t192*t3552 & + *t1125 + 0.7407407410e-1_dp*t1785*t1221 - 0.1111111111e1_dp*t3547 & + *t1737 + 0.6666666668e0_dp*t1519*t187*t1712 + 0.7407407410e-1_dp & + *t503*t3553 - 0.1111111112e0_dp*t1755*t534 - 0.1000000001e1_dp & + *t1774*t1712 + 0.7407407410e-1_dp*t719*t1119 + t4345 = -0.1000000001e1_dp*t379*t266*t1722 - 0.1000000001e1_dp*t804 & + *t722*t1722 + 0.8999999998e1_dp*t1109*t178*t710 - 0.5555555558e-1_dp & + *t1129*t729 + t4256*t65 - 0.2222222224e0_dp*t1755*t520 & + - 0.1111111112e0_dp*t503*t3569 - 0.1111111112e0_dp*t1785*t1216 & + - 0.1111111112e0_dp*t3097*t4101 - 0.5000000001e0_dp*t732*t4272 & + + 0.7407407410e-1_dp*t192*t194*t1836*t526 t4352 = t1731*t67 - t4378 = 0.7407407410e-1_dp*t1715*t878+0.8999999998e1_dp*t1189*t59 & - *t177*t710+0.7407407410e-1_dp*t4352*t271-0.1111111112e0_dp & - *t4352*t275-0.5555555556e0_dp*t3547*t1745+0.7407407410e-1_dp & - *t516*t1709*t526+0.6666666668e0_dp*t3533*t187*t1722-0.1000000001e1_dp & - *t237*t496*t1722+0.3703703706e0_dp*t579*t1192 & - *t1194-0.1000000001e1_dp*t723*t4156+0.1333333334e1_dp*t3533 & - *t722*t1722-0.5555555558e-1_dp*t719*t1235 - t4392 = 0.3333333334e0_dp*t165*t171*t1825+0.1250000000e0_dp*t1981 & - *t1247*t3329-0.3125000000e0_dp*t4025*t1247*t3306+0.3333333334e0_dp & - *t165*t1392*t1447+0.5555555556e-1_dp*t1246*t4032 & - *t833-0.1666666667e0_dp*t1246*t74*t25*t1410+0.5555555556e-1_dp & - *t1246*t1247*t3449+0.1800000000e2_dp*t657*t1283*t59 & - *t1975-0.1666666667e0_dp*t429*t166*t3871+0.3333333334e0_dp & - *t55*t57*(t4079+t4108+t4140+t4261+t4292+t4317+t4345 & - +t4378)+0.1481481481e0_dp*t170*t114*t735*t14-0.1666666667e0_dp & + t4378 = 0.7407407410e-1_dp*t1715*t878 + 0.8999999998e1_dp*t1189*t59 & + *t177*t710 + 0.7407407410e-1_dp*t4352*t271 - 0.1111111112e0_dp & + *t4352*t275 - 0.5555555556e0_dp*t3547*t1745 + 0.7407407410e-1_dp & + *t516*t1709*t526 + 0.6666666668e0_dp*t3533*t187*t1722 - 0.1000000001e1_dp & + *t237*t496*t1722 + 0.3703703706e0_dp*t579*t1192 & + *t1194 - 0.1000000001e1_dp*t723*t4156 + 0.1333333334e1_dp*t3533 & + *t722*t1722 - 0.5555555558e-1_dp*t719*t1235 + t4392 = 0.3333333334e0_dp*t165*t171*t1825 + 0.1250000000e0_dp*t1981 & + *t1247*t3329 - 0.3125000000e0_dp*t4025*t1247*t3306 + 0.3333333334e0_dp & + *t165*t1392*t1447 + 0.5555555556e-1_dp*t1246*t4032 & + *t833 - 0.1666666667e0_dp*t1246*t74*t25*t1410 + 0.5555555556e-1_dp & + *t1246*t1247*t3449 + 0.1800000000e2_dp*t657*t1283*t59 & + *t1975 - 0.1666666667e0_dp*t429*t166*t3871 + 0.3333333334e0_dp & + *t55*t57*(t4079 + t4108 + t4140 + t4261 + t4292 + t4317 + t4345 & + + t4378) + 0.1481481481e0_dp*t170*t114*t735*t14 - 0.1666666667e0_dp & *t429*t1928*t290 - t4428 = -0.1111111111e0_dp*t165*t1264*t1483+0.1800000000e2_dp*t658 & - *t575*t1348-0.8333333335e-1_dp*t429*t679*t918-0.1111111111e0_dp & - *t165*t455*t1988+0.3333333334e0_dp*t170*t27*t3576 & - *t172-0.8333333335e-1_dp*t429*t1966*t754+0.1250000000e0_dp & - *t1368*t679*t907+0.1666666667e0_dp*t445*t446*t3918-0.4444444445e0_dp & - *t165*t450*t1829+0.2500000000e0_dp*t1981*t3244 & - *t1410-0.1666666667e0_dp*t429*t1392*t1410 - t4466 = -0.1666666667e0_dp*t429*t437*t1553-0.1111111111e0_dp*t165 & - *t689*t1085+0.1666666667e0_dp*t165*t1275*t649-0.2222222222e0_dp & - *t170*t27*t1843*t17-0.8333333335e-1_dp*t1246*t1962 & - *t1168+0.1666666667e0_dp*t165*t2720*t561+0.6666666668e0_dp & - *t170*t1932*t25+0.3333333334e0_dp*t445*t1292*t1825+0.1250000000e0_dp & - *t1368*t166*t3853-0.4444444445e0_dp*t1373*t1962 & - *t1172+0.7407407405e-1_dp*t165*t1377*t3472+0.5555555555e-1_dp & + t4428 = -0.1111111111e0_dp*t165*t1264*t1483 + 0.1800000000e2_dp*t658 & + *t575*t1348 - 0.8333333335e-1_dp*t429*t679*t918 - 0.1111111111e0_dp & + *t165*t455*t1988 + 0.3333333334e0_dp*t170*t27*t3576 & + *t172 - 0.8333333335e-1_dp*t429*t1966*t754 + 0.1250000000e0_dp & + *t1368*t679*t907 + 0.1666666667e0_dp*t445*t446*t3918 - 0.4444444445e0_dp & + *t165*t450*t1829 + 0.2500000000e0_dp*t1981*t3244 & + *t1410 - 0.1666666667e0_dp*t429*t1392*t1410 + t4466 = -0.1666666667e0_dp*t429*t437*t1553 - 0.1111111111e0_dp*t165 & + *t689*t1085 + 0.1666666667e0_dp*t165*t1275*t649 - 0.2222222222e0_dp & + *t170*t27*t1843*t17 - 0.8333333335e-1_dp*t1246*t1962 & + *t1168 + 0.1666666667e0_dp*t165*t2720*t561 + 0.6666666668e0_dp & + *t170*t1932*t25 + 0.3333333334e0_dp*t445*t1292*t1825 + 0.1250000000e0_dp & + *t1368*t166*t3853 - 0.4444444445e0_dp*t1373*t1962 & + *t1172 + 0.7407407405e-1_dp*t165*t1377*t3472 + 0.5555555555e-1_dp & *t1246*t3244*t1483 t4498 = t56*t1843 - t4505 = 0.1666666667e0_dp*t165*t166*t3796-0.8333333334e-1_dp*t2763 & - *t1247*t833*t561+(4*t147*t392*t1886)+(2 & - *t147*t1388*t672)-0.1111111111e0_dp*t165*t1940*t833+0.3333333334e0_dp & - *t165*t1928*t379+0.7407407409e-1_dp*t165*t450 & - *t649*t14-0.1666666667e0_dp*t429*t462*t3314-0.3703703704e-1_dp & - *t2885*t1247*t3472+0.3333333334e0_dp*t165*t4498*t237 & - +(2*t147*t1284*t672) + t4505 = 0.1666666667e0_dp*t165*t166*t3796 - 0.8333333334e-1_dp*t2763 & + *t1247*t833*t561 + (4*t147*t392*t1886) + (2 & + *t147*t1388*t672) - 0.1111111111e0_dp*t165*t1940*t833 + 0.3333333334e0_dp & + *t165*t1928*t379 + 0.7407407409e-1_dp*t165*t450 & + *t649*t14 - 0.1666666667e0_dp*t429*t462*t3314 - 0.3703703704e-1_dp & + *t2885*t1247*t3472 + 0.3333333334e0_dp*t165*t4498*t237 & + + (2*t147*t1284*t672) t4512 = t1531*my_rho - t4545 = (4*t147*t1885*t424)+0.1666666667e0_dp*t165*t462 & - *t3382+0.3333333334e0_dp*t445*t4512*t413+0.5185185185e0_dp & - *t2937*t446*t3925-0.8333333335e-1_dp*t429*t166*t3827-0.1666666667e0_dp & - *t429*t437*t1571+0.5555555555e-1_dp*t1246*t203 & - *t237*t1483+0.5555555555e-1_dp*t1246*t2707*t1483+0.7407407409e-1_dp & - *t165*t1875*t1360+(4*t147*t393*t1924) & - +0.3600000000e2_dp*(t1971)*(t1972)*(t1973)*(t424) & - +0.3333333334e0_dp*t165*t437*t1688 + t4545 = (4*t147*t1885*t424) + 0.1666666667e0_dp*t165*t462 & + *t3382 + 0.3333333334e0_dp*t445*t4512*t413 + 0.5185185185e0_dp & + *t2937*t446*t3925 - 0.8333333335e-1_dp*t429*t166*t3827 - 0.1666666667e0_dp & + *t429*t437*t1571 + 0.5555555555e-1_dp*t1246*t203 & + *t237*t1483 + 0.5555555555e-1_dp*t1246*t2707*t1483 + 0.7407407409e-1_dp & + *t165*t1875*t1360 + (4*t147*t393*t1924) & + + 0.3600000000e2_dp*(t1971)*(t1972)*(t1973)*(t424) & + + 0.3333333334e0_dp*t165*t437*t1688 t4553 = t585*t140 t4575 = t1067*t561 - t4585 = 0.1666666667e0_dp*t445*t3248*t668-0.1111111111e0_dp*t165 & - *t1932*t433+0.5555555556e-1_dp*t1246*t4553*t833-0.8333333335e-1_dp & - *t429*t1275*t593-0.8333333335e-1_dp*t429*t462* & - t3329+0.2500000000e0_dp*t1981*t1247*t3314+0.1666666667e0_dp* & - t445*t1962*t1093+0.3333333334e0_dp*t165*t455*t668-0.8333333335e-1_dp & - *t429*t166*t3849-0.8333333335e-1_dp*t429*t166* & - t4575+0.2e1_dp*t147*(t3491-t3494-t3497+t3501-t3505+0.9000000000e1_dp & - *t3507-t3512)*t149*t160 + t4585 = 0.1666666667e0_dp*t445*t3248*t668 - 0.1111111111e0_dp*t165 & + *t1932*t433 + 0.5555555556e-1_dp*t1246*t4553*t833 - 0.8333333335e-1_dp & + *t429*t1275*t593 - 0.8333333335e-1_dp*t429*t462* & + t3329 + 0.2500000000e0_dp*t1981*t1247*t3314 + 0.1666666667e0_dp* & + t445*t1962*t1093 + 0.3333333334e0_dp*t165*t455*t668 - 0.8333333335e-1_dp & + *t429*t166*t3849 - 0.8333333335e-1_dp*t429*t166* & + t4575 + 0.2e1_dp*t147*(t3491 - t3494 - t3497 + t3501 - t3505 + 0.9000000000e1_dp & + *t3507 - t3512)*t149*t160 t4607 = t1688*t237 - t4627 = 0.1666666667e0_dp*t165*t1966*t804-0.1666666667e0_dp*t429 & - *t437*t1557+0.1800000000e2_dp*t657*t1387*t59*t1975+0.1037037037e1_dp & - *t170*t341*t585*t1100-0.8888888890e0_dp*t170 & - *t114*t1531*t451-0.8888888890e0_dp*t170*t1875*t225-0.1666666667e0_dp & - *t429*t166*t4607-0.1111111111e0_dp*t165*t466 & - *t3449-0.1666666667e0_dp*t429*t679*t914-0.8333333335e-1_dp* & - t1246*t446*t1093*t561+0.1250000000e0_dp*t1368*t462*t3306 & - +0.2500000000e0_dp*t1981*t2707*t1410 - t4657 = -0.3333333336e0_dp*t289*t84*t3871-0.6666666672e0_dp*t83 & - *t3875*t237+0.8333333340e-1_dp*t906*t384*t3306-0.1666666668e0_dp & - *t289*t597*t918-0.2222222224e0_dp*t144*t46*(t4018 & - +t4392+t4428+t4466+t4505+t4545+t4585+t4627)-0.1666666668e0_dp & - *t289*t384*t3329-0.3333333336e0_dp*t165*t2636*t561 & - -0.3333333336e0_dp*t165*t897*t1447+0.8333333340e-1_dp*t1546 & - *t897*t3329-0.6666666672e0_dp*t83*t1071*t1447-0.3333333336e0_dp & - *t83*t2404*t561-0.4444444448e0_dp*t383*t3875-0.3333333336e0_dp & + t4627 = 0.1666666667e0_dp*t165*t1966*t804 - 0.1666666667e0_dp*t429 & + *t437*t1557 + 0.1800000000e2_dp*t657*t1387*t59*t1975 + 0.1037037037e1_dp & + *t170*t341*t585*t1100 - 0.8888888890e0_dp*t170 & + *t114*t1531*t451 - 0.8888888890e0_dp*t170*t1875*t225 - 0.1666666667e0_dp & + *t429*t166*t4607 - 0.1111111111e0_dp*t165*t466 & + *t3449 - 0.1666666667e0_dp*t429*t679*t914 - 0.8333333335e-1_dp* & + t1246*t446*t1093*t561 + 0.1250000000e0_dp*t1368*t462*t3306 & + + 0.2500000000e0_dp*t1981*t2707*t1410 + t4657 = -0.3333333336e0_dp*t289*t84*t3871 - 0.6666666672e0_dp*t83 & + *t3875*t237 + 0.8333333340e-1_dp*t906*t384*t3306 - 0.1666666668e0_dp & + *t289*t597*t918 - 0.2222222224e0_dp*t144*t46*(t4018 & + + t4392 + t4428 + t4466 + t4505 + t4545 + t4585 + t4627) - 0.1666666668e0_dp & + *t289*t384*t3329 - 0.3333333336e0_dp*t165*t2636*t561 & + - 0.3333333336e0_dp*t165*t897*t1447 + 0.8333333340e-1_dp*t1546 & + *t897*t3329 - 0.6666666672e0_dp*t83*t1071*t1447 - 0.3333333336e0_dp & + *t83*t2404*t561 - 0.4444444448e0_dp*t383*t3875 - 0.3333333336e0_dp & *t289*t294*t1553 - t4696 = -0.6666666672e0_dp*t55*t1575-0.3333333336e0_dp*t289*t597 & - *t914-0.3333333336e0_dp*t165*t2631*t561-0.6666666672e0_dp* & - t55*t1706-0.3333333336e0_dp*t289*t384*t3314-0.6666666672e0_dp & - *t83*t294*t1688+0.1666666668e0_dp*t1546*t2631*t1410- & - 0.3333333336e0_dp*t289*t1564*t290-0.1666666668e0_dp*t289*t84 & - *t4575-0.3333333336e0_dp*t289*t294*t1557-0.1666666668e0_dp & - *t289*t1694*t754-0.3333333336e0_dp*t289*t84*t4607-0.3333333336e0_dp & + t4696 = -0.6666666672e0_dp*t55*t1575 - 0.3333333336e0_dp*t289*t597 & + *t914 - 0.3333333336e0_dp*t165*t2631*t561 - 0.6666666672e0_dp* & + t55*t1706 - 0.3333333336e0_dp*t289*t384*t3314 - 0.6666666672e0_dp & + *t83*t294*t1688 + 0.1666666668e0_dp*t1546*t2631*t1410 - & + 0.3333333336e0_dp*t289*t1564*t290 - 0.1666666668e0_dp*t289*t84 & + *t4575 - 0.3333333336e0_dp*t289*t294*t1557 - 0.1666666668e0_dp & + *t289*t1694*t754 - 0.3333333336e0_dp*t289*t84*t4607 - 0.3333333336e0_dp & *t83*t45*t3581*t140 - t4700 = -0.6666666670e0_dp*t2147*t1411-0.1333333334e1_dp*t747*t597 & - *t237-0.1333333334e1_dp*t747*t84*t1447-0.1333333334e1_dp & - *t747*t294*t561-0.8888888896e0_dp*t214*t1536+0.1666666668e0_dp & - *t3305*t84*t3306-0.3333333336e0_dp*t753*t46*t589*t754 & - -0.6666666672e0_dp*t1409*t84*t3314-0.6666666670e0_dp*t1409 & - *t294*t1410-0.1333333334e1_dp*t217*t46*t1535*t237-0.1333333334e1_dp & - *t217*t46*t282*t1447-0.3333333336e0_dp*t1409 & - *t84*t3329-0.6666666672e0_dp*t217*t46*t589*t804-0.6666666672e0_dp & - *t217*t46*t78*t3382-0.6666666672e0_dp*t217*t46 & - *t893*t561-0.4444444448e0_dp*t43*t46*t3581+t8*(t3826+ & - t3869+t4657+t4696) - e_ndrho_rho_rho(ii) = e_ndrho_rho_rho(ii)+t4700*sx + t4700 = -0.6666666670e0_dp*t2147*t1411 - 0.1333333334e1_dp*t747*t597 & + *t237 - 0.1333333334e1_dp*t747*t84*t1447 - 0.1333333334e1_dp & + *t747*t294*t561 - 0.8888888896e0_dp*t214*t1536 + 0.1666666668e0_dp & + *t3305*t84*t3306 - 0.3333333336e0_dp*t753*t46*t589*t754 & + - 0.6666666672e0_dp*t1409*t84*t3314 - 0.6666666670e0_dp*t1409 & + *t294*t1410 - 0.1333333334e1_dp*t217*t46*t1535*t237 - 0.1333333334e1_dp & + *t217*t46*t282*t1447 - 0.3333333336e0_dp*t1409 & + *t84*t3329 - 0.6666666672e0_dp*t217*t46*t589*t804 - 0.6666666672e0_dp & + *t217*t46*t78*t3382 - 0.6666666672e0_dp*t217*t46 & + *t893*t561 - 0.4444444448e0_dp*t43*t46*t3581 + t8*(t3826 + & + t3869 + t4657 + t4696) + e_ndrho_rho_rho(ii) = e_ndrho_rho_rho(ii) + t4700*sx t4701 = t561**2 t4704 = 0.3333333336e0_dp*t2147*t84*t4701 t4707 = 0.1333333334e1_dp*t747*t597*t561 @@ -2113,10 +2113,10 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t4714 = t327*t4713 t4717 = t22*t132 t4721 = 0.1e1_dp/t787*t2480 - t4725 = 0.120e2_dp*t624*t4717-0.60e1_dp*t7*t4721*t371 + t4725 = 0.120e2_dp*t624*t4717 - 0.60e1_dp*t7*t4721*t371 t4726 = t105*t4725 - t4729 = 0.40e1_dp*t624*t4708-0.80e1_dp*t112*t558+0.40e1_dp*t102 & - *t4714-0.20e1_dp*t102*t4726 + t4729 = 0.40e1_dp*t624*t4708 - 0.80e1_dp*t112*t558 + 0.40e1_dp*t102 & + *t4714 - 0.20e1_dp*t102*t4726 t4732 = 0.6666666672e0_dp*t747*t84*t4729 t4733 = pi**2 t4734 = t4733*t146 @@ -2134,13 +2134,13 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t4771 = t4770*t4733 t4772 = t26*t4701 t4776 = t58*t4729 - t4782 = -0.2250000000e2_dp*t473*t4760*t65+0.8999999998e1_dp*t478 & - *t4764*t65+0.8099999996e2_dp*t4771*t4772*t65-0.5555555558e-1_dp & - *t4776*t71-0.5000000001e0_dp*t60*t4729*t65 - t4786 = -0.2700000000e2_dp*t4738*t18*t4739+0.4500000000e1_dp*t567 & - *t4744-0.3000000000e1_dp*t567*t4748-0.8333333335e-1_dp*t429 & - *t166*t4701+0.3333333334e0_dp*t165*t679*t561+0.1666666667e0_dp & - *t165*t166*t4729+0.3333333334e0_dp*t55*t57*t4782 + t4782 = -0.2250000000e2_dp*t473*t4760*t65 + 0.8999999998e1_dp*t478 & + *t4764*t65 + 0.8099999996e2_dp*t4771*t4772*t65 - 0.5555555558e-1_dp & + *t4776*t71 - 0.5000000001e0_dp*t60*t4729*t65 + t4786 = -0.2700000000e2_dp*t4738*t18*t4739 + 0.4500000000e1_dp*t567 & + *t4744 - 0.3000000000e1_dp*t567*t4748 - 0.8333333335e-1_dp*t429 & + *t166*t4701 + 0.3333333334e0_dp*t165*t679*t561 + 0.1666666667e0_dp & + *t165*t166*t4729 + 0.3333333334e0_dp*t55*t57*t4782 t4789 = 0.4444444448e0_dp*t214*t46*t4786 t4790 = t237*t4701 t4793 = 0.1666666668e0_dp*t3305*t84*t4790 @@ -2159,14 +2159,14 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t4834 = t327*t4833 t4837 = t233*t4725 t4838 = t327*t4837 - t4849 = -0.3200000000e2_dp*t1645*t627+0.4800000000e2_dp*t7*t1440 & - -0.2400000000e2_dp*t786/t2492*t1058 + t4849 = -0.3200000000e2_dp*t1645*t627 + 0.4800000000e2_dp*t7*t1440 & + - 0.2400000000e2_dp*t786/t2492*t1058 t4850 = t105*t4849 - t4853 = -0.1066666667e2_dp*t1645*t98+0.2133333334e2_dp*t339*t1420 & - -0.1066666667e2_dp*t321*t4817+0.5333333333e1_dp*t321*t4820 & - -0.40e1_dp*t624*t234+0.160e2_dp*t112*t1426-0.80e1_dp*t112* & - t1444-0.120e2_dp*t102*t4830+0.80e1_dp*t102*t4834+0.40e1_dp* & - t102*t4838-0.20e1_dp*t102*t4850 + t4853 = -0.1066666667e2_dp*t1645*t98 + 0.2133333334e2_dp*t339*t1420 & + - 0.1066666667e2_dp*t321*t4817 + 0.5333333333e1_dp*t321*t4820 & + - 0.40e1_dp*t624*t234 + 0.160e2_dp*t112*t1426 - 0.80e1_dp*t112* & + t1444 - 0.120e2_dp*t102*t4830 + 0.80e1_dp*t102*t4834 + 0.40e1_dp* & + t102*t4838 - 0.20e1_dp*t102*t4850 t4857 = 0.6666666672e0_dp*t217*t46*t78*t4853 t4861 = 0.3333333336e0_dp*t753*t46*t282*t4701 t4864 = t217*t46*t1535*t561 @@ -2180,7 +2180,7 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t4889 = t178*t62*t4853 t4893 = 0.1200000000e2_dp*t473*t1500*t4701 t4895 = t478*t1500*t4729 - t4897 = t4881-t4884-t4887+0.8999999998e1_dp*t4889-t4893+0.5999999999e1_dp & + t4897 = t4881 - t4884 - t4887 + 0.8999999998e1_dp*t4889 - t4893 + 0.5999999999e1_dp & *t4895 t4898 = t4897*t65 t4901 = t1504*t59*t177*t710 @@ -2207,11 +2207,11 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t4951 = 0.5555555558e-1_dp*t4943*t275 t4952 = t719*t1525 t4955 = t68*t4897*t65 - t4958 = t4898+0.1800000000e2_dp*t4901-t4907+t4911+t4917-t4920 & - -0.1000000000e1_dp*t4922-t4925+0.3333333334e0_dp*t1519*t4908 & - -0.1000000000e1_dp*t4929-t4932+t4935-0.4500000000e1_dp*t4941 & - +t4945+0.3000000000e1_dp*t4946*t4701*t4940-t4951-0.1111111112e0_dp & - *t4952-0.5555555558e-1_dp*t192*t4955 + t4958 = t4898 + 0.1800000000e2_dp*t4901 - t4907 + t4911 + t4917 - t4920 & + - 0.1000000000e1_dp*t4922 - t4925 + 0.3333333334e0_dp*t1519*t4908 & + - 0.1000000000e1_dp*t4929 - t4932 + t4935 - 0.4500000000e1_dp*t4941 & + + t4945 + 0.3000000000e1_dp*t4946*t4701*t4940 - t4951 - 0.1111111112e0_dp & + *t4952 - 0.5555555558e-1_dp*t192*t4955 t4994 = t44*t4733*t146 t4995 = t4994*t4770 t5001 = 0.1666666667e0_dp*t165*t166*t4853 @@ -2229,16 +2229,16 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t5029 = t56*t4782 t5032 = 0.1666666667e0_dp*t165*t5029*t237 t5035 = 0.3333333334e0_dp*t165*t679*t1447 - t5036 = -t4872+0.3333333334e0_dp*t4874+t4878+0.3333333334e0_dp* & - t55*t57*t4958+0.2e1_dp*t147*t149*(-0.5625000000e1_dp*t1302 & - *t1459*t4701+0.4500000000e1_dp*t400*t2022*t561+0.2250000000e1_dp & - *t400*t1459*t4729-0.1500000000e1_dp*t151*t50*t4853 & - +0.7500000000e0_dp*t400*t1466*t4701-0.5000000000e0_dp*t405 & - *t1466*t4729)-0.3600000000e2_dp*t2081*t4760*t250+0.1800000000e2_dp & - *t658*t4764*t250+0.3600000000e2_dp*t658*t575*t1471 & - +0.1620000000e3_dp*t4995*t4772*t250+t5001+t5005-t5008 & - -0.5555555555e-1_dp*t5011-t5016+t5019-t5022-t5025-t5028 & - +t5032+t5035 + t5036 = -t4872 + 0.3333333334e0_dp*t4874 + t4878 + 0.3333333334e0_dp* & + t55*t57*t4958 + 0.2e1_dp*t147*t149*(-0.5625000000e1_dp*t1302 & + *t1459*t4701 + 0.4500000000e1_dp*t400*t2022*t561 + 0.2250000000e1_dp & + *t400*t1459*t4729 - 0.1500000000e1_dp*t151*t50*t4853 & + + 0.7500000000e0_dp*t400*t1466*t4701 - 0.5000000000e0_dp*t405 & + *t1466*t4729) - 0.3600000000e2_dp*t2081*t4760*t250 + 0.1800000000e2_dp & + *t658*t4764*t250 + 0.3600000000e2_dp*t658*t575*t1471 & + + 0.1620000000e3_dp*t4995*t4772*t250 + t5001 + t5005 - t5008 & + - 0.5555555555e-1_dp*t5011 - t5016 + t5019 - t5022 - t5025 - t5028 & + + t5032 + t5035 t5040 = t379*t4729 t5043 = 0.1666666668e0_dp*t289*t84*t5040 t5044 = t140*t4853 @@ -2254,32 +2254,32 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t5106 = beta*t640 t5108 = t126*t371*my_ndrho t5115 = t366*t640 - t5118 = -0.480e2_dp*t5051*t4717+0.240e2_dp*t7*t2182*t2480*t371 & - +0.480e2_dp*t5060*t628-0.240e2_dp*t7*t1640*t1438*t371 & - *my_rho+0.120e2_dp*t550*t637-0.180e2_dp*t5106*t5108-0.120e2_dp & - *t7*t640*t635*t371+0.180e2_dp*t5115*t1681 - t5122 = -0.320e2_dp*t5051*t4708+0.640e2_dp*t1582*t558-0.320e2_dp & - *t302*t4714+0.160e2_dp*t302*t4726+0.320e2_dp*t5060*t99- & - 0.640e2_dp*t605*t609+0.320e2_dp*t93*t953*t5065-0.160e2_dp* & - t93*t316*t5069-0.40e1_dp*t624*t137+0.160e2_dp*t112*t615 & - -0.80e1_dp*t112*t646-0.120e2_dp*t102*t974*t5079+0.80e1_dp* & - t102*t327*t5083+0.40e1_dp*t102*t327*t5087-0.20e1_dp*t102 & + t5118 = -0.480e2_dp*t5051*t4717 + 0.240e2_dp*t7*t2182*t2480*t371 & + + 0.480e2_dp*t5060*t628 - 0.240e2_dp*t7*t1640*t1438*t371 & + *my_rho + 0.120e2_dp*t550*t637 - 0.180e2_dp*t5106*t5108 - 0.120e2_dp & + *t7*t640*t635*t371 + 0.180e2_dp*t5115*t1681 + t5122 = -0.320e2_dp*t5051*t4708 + 0.640e2_dp*t1582*t558 - 0.320e2_dp & + *t302*t4714 + 0.160e2_dp*t302*t4726 + 0.320e2_dp*t5060*t99 - & + 0.640e2_dp*t605*t609 + 0.320e2_dp*t93*t953*t5065 - 0.160e2_dp* & + t93*t316*t5069 - 0.40e1_dp*t624*t137 + 0.160e2_dp*t112*t615 & + - 0.80e1_dp*t112*t646 - 0.120e2_dp*t102*t974*t5079 + 0.80e1_dp* & + t102*t327*t5083 + 0.40e1_dp*t102*t327*t5087 - 0.20e1_dp*t102 & *t105*t5118 t5123 = t5122*t237 t5126 = 0.1666666668e0_dp*t289*t84*t5123 t5139 = t25*t4701 t5143 = t25*t4729 - t5147 = -0.5625000000e1_dp*t1302*t401*t4701+0.4500000000e1_dp*t400 & - *t1892*t561+0.2250000000e1_dp*t400*t401*t4729-0.1500000000e1_dp & - *t151*t50*t5122-0.2250000000e1_dp*t400*t156*t5139 & - +0.1500000000e1_dp*t405*t156*t5143 + t5147 = -0.5625000000e1_dp*t1302*t401*t4701 + 0.4500000000e1_dp*t400 & + *t1892*t561 + 0.2250000000e1_dp*t400*t401*t4729 - 0.1500000000e1_dp & + *t151*t50*t5122 - 0.2250000000e1_dp*t400*t156*t5139 & + + 0.1500000000e1_dp*t405*t156*t5143 t5163 = t140*t4701 t5170 = t649*t561 t5174 = t140*t4729 - t5226 = 0.5400000000e2_dp*t1143*t474*t4701-0.3600000000e2_dp*t473 & - *t1801*t561-0.1800000000e2_dp*t473*t474*t4729+0.8999999998e1_dp & - *t178*t62*t5122+0.3600000000e2_dp*t473*t183*t5139 & - -0.1800000000e2_dp*t478*t183*t5143 + t5226 = 0.5400000000e2_dp*t1143*t474*t4701 - 0.3600000000e2_dp*t473 & + *t1801*t561 - 0.1800000000e2_dp*t473*t474*t4729 + 0.8999999998e1_dp & + *t178*t62*t5122 + 0.3600000000e2_dp*t473*t183*t5139 & + - 0.1800000000e2_dp*t478*t183*t5143 t5228 = t705*t59 t5229 = t5228*t177 t5237 = t649*t177 @@ -2290,27 +2290,27 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t5262 = t471*t722 t5270 = t68*t5226 t5271 = t5270*t65 - t5276 = t5226*t65+0.1800000000e2_dp*t5229*t710-0.2250000000e2_dp & - *t707*t471*t4905+0.8999999998e1_dp*t708*t4909-0.1000000000e1_dp & - *t5237*t709-0.5000000001e0_dp*t716*t4908-0.1000000001e1_dp & - *t723*t4908-0.1000000000e1_dp*t5244*t709+0.8099999996e2_dp & - *t5247*t1141*t4915-0.5555555558e-1_dp*t5251*t71+0.1000000000e1_dp & - *t2098*t4904-0.4500000000e1_dp*t5256*t4701*t4940 & - -0.1111111112e0_dp*t4943*t196-0.9000000007e1_dp*t5262*t4701 & - *t4940-0.5555555558e-1_dp*t4943*t200-0.1111111112e0_dp*t719* & - t729-0.5555555558e-1_dp*t192*t5271-0.5000000001e0_dp*t732*t4908 - t5280 = (2*t147*t149*t5147)-0.3600000000e2_dp*t2081*t4760 & - *t161+0.1800000000e2_dp*t658*t4764*t161+0.3600000000e2_dp & - *t658*t575*t673+0.1620000000e3_dp*t4995*t4772*t161+0.1250000000e0_dp & - *t1368*t166*t5163-0.1666666667e0_dp*t429*t679 & - *t593-0.1666666667e0_dp*t429*t166*t5170-0.8333333335e-1_dp* & - t429*t166*t5174+0.1666666667e0_dp*t165*t5029*t140+0.3333333334e0_dp & - *t165*t679*t649+0.1666666667e0_dp*t165*t166*t5122 & - -0.8333333335e-1_dp*t1246*t446*t5139+0.3333333334e0_dp*t445 & - *t1962*t668+0.1666666667e0_dp*t445*t446*t5143+0.3333333334e0_dp & - *t170*t5013*t172-0.8333333335e-1_dp*t429*t462*t4701 & - +0.3333333334e0_dp*t165*t1966*t561+0.1666666667e0_dp*t165 & - *t462*t4729+0.3333333334e0_dp*t55*t57*t5276 + t5276 = t5226*t65 + 0.1800000000e2_dp*t5229*t710 - 0.2250000000e2_dp & + *t707*t471*t4905 + 0.8999999998e1_dp*t708*t4909 - 0.1000000000e1_dp & + *t5237*t709 - 0.5000000001e0_dp*t716*t4908 - 0.1000000001e1_dp & + *t723*t4908 - 0.1000000000e1_dp*t5244*t709 + 0.8099999996e2_dp & + *t5247*t1141*t4915 - 0.5555555558e-1_dp*t5251*t71 + 0.1000000000e1_dp & + *t2098*t4904 - 0.4500000000e1_dp*t5256*t4701*t4940 & + - 0.1111111112e0_dp*t4943*t196 - 0.9000000007e1_dp*t5262*t4701 & + *t4940 - 0.5555555558e-1_dp*t4943*t200 - 0.1111111112e0_dp*t719* & + t729 - 0.5555555558e-1_dp*t192*t5271 - 0.5000000001e0_dp*t732*t4908 + t5280 = (2*t147*t149*t5147) - 0.3600000000e2_dp*t2081*t4760 & + *t161 + 0.1800000000e2_dp*t658*t4764*t161 + 0.3600000000e2_dp & + *t658*t575*t673 + 0.1620000000e3_dp*t4995*t4772*t161 + 0.1250000000e0_dp & + *t1368*t166*t5163 - 0.1666666667e0_dp*t429*t679 & + *t593 - 0.1666666667e0_dp*t429*t166*t5170 - 0.8333333335e-1_dp* & + t429*t166*t5174 + 0.1666666667e0_dp*t165*t5029*t140 + 0.3333333334e0_dp & + *t165*t679*t649 + 0.1666666667e0_dp*t165*t166*t5122 & + - 0.8333333335e-1_dp*t1246*t446*t5139 + 0.3333333334e0_dp*t445 & + *t1962*t668 + 0.1666666667e0_dp*t445*t446*t5143 + 0.3333333334e0_dp & + *t170*t5013*t172 - 0.8333333335e-1_dp*t429*t462*t4701 & + + 0.3333333334e0_dp*t165*t1966*t561 + 0.1666666667e0_dp*t165 & + *t462*t4729 + 0.3333333334e0_dp*t55*t57*t5276 t5281 = t45*t5280 t5284 = 0.3333333336e0_dp*t83*t5281*t237 t5291 = 0.1666666668e0_dp*t289*t384*t4801 @@ -2319,8 +2319,8 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t5298 = 0.3333333336e0_dp*t83*t5295*t379 t5301 = 0.3333333336e0_dp*t55*t384*t4729 t5303 = t83*t1564*t649 - t5305 = -t5043-t5047-t5050-t5126-t5284-0.3333333336e0_dp*t83 & - *t45*t5036*t140-t5291+t5294-t5298-t5301-0.6666666672e0_dp & + t5305 = -t5043 - t5047 - t5050 - t5126 - t5284 - 0.3333333336e0_dp*t83 & + *t45*t5036*t140 - t5291 + t5294 - t5298 - t5301 - 0.6666666672e0_dp & *t5303 t5308 = 0.3333333336e0_dp*t289*t1694*t1410 t5311 = 0.1666666668e0_dp*t289*t1071*t4701 @@ -2336,8 +2336,8 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t5338 = 0.6666666672e0_dp*t55*t1694*t561 t5339 = t649*t1447 t5342 = 0.3333333336e0_dp*t289*t84*t5339 - t5343 = -t5308-t5311-t5314-t5317-t5320+t5323-t5326-t5329 & - +t5333-t5335-t5338-t5342 + t5343 = -t5308 - t5311 - t5314 - t5317 - t5320 + t5323 - t5326 - t5329 & + + t5333 - t5335 - t5338 - t5342 t5345 = t1688*t561 t5347 = t289*t84*t5345 t5351 = 0.1666666668e0_dp*t164*t384*t4701 @@ -2363,10 +2363,10 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t5415 = 0.1666666667e0_dp*t429*t462*t4797 t5418 = 2*t147*t393*t5147 t5421 = t657*t1884*t59*t1975 - t5423 = -t5363+t5367-t5370+0.1111111111e0_dp*t5373-0.5555555555e-1_dp & - *t5376+0.3333333334e0_dp*t5379-t5383-t5386-t5389+ & - 0.3333333334e0_dp*t170*t27*t4958*t172-t5397+t5400+0.3333333334e0_dp & - *t5402-t5406-t5409-t5412-t5415+t5418+0.3600000000e2_dp & + t5423 = -t5363 + t5367 - t5370 + 0.1111111111e0_dp*t5373 - 0.5555555555e-1_dp & + *t5376 + 0.3333333334e0_dp*t5379 - t5383 - t5386 - t5389 + & + 0.3333333334e0_dp*t170*t27*t4958*t172 - t5397 + t5400 + 0.3333333334e0_dp & + *t5402 - t5406 - t5409 - t5412 - t5415 + t5418 + 0.3600000000e2_dp & *t5421 t5426 = 0.8333333335e-1_dp*t1246*t1292*t5139 t5429 = 0.1666666667e0_dp*t445*t1292*t5143 @@ -2385,8 +2385,8 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t5462 = 0.1173333333e3_dp*t5460*t313 t5466 = 0.40e1_dp*t102*t327*t136*t4849 t5468 = 0.2346666666e3_dp*t605*t1420 - t5469 = t5440-t5443-t5446-t5449-t5451-t5454-t5456+t5459 & - -t5462+t5466-t5468 + t5469 = t5440 - t5443 - t5446 - t5449 - t5451 - t5454 - t5456 + t5459 & + - t5462 + t5466 - t5468 t5472 = 0.3200000001e2_dp*t321*t2455*t5079 t5474 = 0.4266666668e2_dp*t339*t1608 t5478 = 0.240e2_dp*t1616*t973*t645*t1425 @@ -2403,9 +2403,9 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t5507 = 0.120e2_dp*t7*t640*t1667*t371 t5509 = 0.180e2_dp*t5115*t3668 t5511 = t1680*t3673*t23 - t5516 = t5480-t5482-t5484+t5487-t5489+t5492+t5494-0.1920000000e3_dp & - *t5496+t5499-t5503-t5507+t5509-0.4800000000e2_dp & - *t5511+0.1200000000e3_dp*t1055*t2565*t4721 + t5516 = t5480 - t5482 - t5484 + t5487 - t5489 + t5492 + t5494 - 0.1920000000e3_dp & + *t5496 + t5499 - t5503 - t5507 + t5509 - 0.4800000000e2_dp & + *t5511 + 0.1200000000e3_dp*t1055*t2565*t4721 t5523 = 0.120e2_dp*t102*t974*t375*t4713 t5525 = 0.2133333334e2_dp*t339*t1611 t5528 = t102*t327*t1684*t557 @@ -2414,8 +2414,8 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t5535 = 0.640e2_dp*t1582*t1444 t5537 = 0.160e2_dp*t112*t1622 t5540 = 0.320e2_dp*t1597*t1598*t4837 - t5541 = t5472-t5474-t5478-0.20e1_dp*t102*t105*t5516-t5523 & - +t5525+0.80e1_dp*t5528+t5531+t5533+t5535+t5537+t5540 + t5541 = t5472 - t5474 - t5478 - 0.20e1_dp*t102*t105*t5516 - t5523 & + + t5525 + 0.80e1_dp*t5528 + t5531 + t5533 + t5535 + t5537 + t5540 t5545 = 0.480e2_dp*t1616*t3750*t4829 t5548 = 0.120e2_dp*t1616*t1617*t4837 t5551 = 0.1280e3_dp*t24*t298*t1599 @@ -2428,8 +2428,8 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t5568 = 0.1066666667e2_dp*t1645*t322 t5572 = 0.40e1_dp*t102*t327*t5118*t233 t5574 = 0.1173333333e3_dp*t93*t4817 - t5575 = t5545-t5548+t5551+t5553-t5558+t5560-t5562+t5564 & - -0.80e1_dp*t5565+t5568+t5572+t5574 + t5575 = t5545 - t5548 + t5551 + t5553 - t5558 + t5560 - t5562 + t5564 & + - 0.80e1_dp*t5565 + t5568 + t5572 + t5574 t5579 = 0.80e1_dp*t102*t327*t645*t1443 t5581 = 0.320e2_dp*t302*t4838 t5585 = 0.160e2_dp*t93*t316*my_rho*t4849 @@ -2442,9 +2442,9 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t5604 = 0.320e2_dp*t5051*t234 t5607 = 0.5866666667e2_dp*t307*t949*t5069 t5610 = 0.640e2_dp*t1597*t1598*t4833 - t5611 = t5579-t5581-t5585+t5590-t5593-t5595+t5597-t5600 & - -t5602+t5604+t5607+t5610 - t5613 = t5469+t5541+t5575+t5611 + t5611 = t5579 - t5581 - t5585 + t5590 - t5593 - t5595 + t5597 - t5600 & + - t5602 + t5604 + t5607 + t5610 + t5613 = t5469 + t5541 + t5575 + t5611 t5619 = 0.3333333334e0_dp*t170*t5013*t25 t5622 = 0.1666666667e0_dp*t165*t1392*t4729 t5625 = 0.1666666667e0_dp*t429*t166*t5339 @@ -2462,8 +2462,8 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t5660 = 0.1125000000e2_dp*t1302*t401*t4797 t5663 = 0.1500000000e1_dp*t400*t417*t5371 t5666 = 0.1125000000e2_dp*t1302*t1892*t1410 - t5667 = t5635-t5638+t5641+0.4500000000e1_dp*t5643-t5647-t5650 & - +t5653-t5657-t5660+t5663-t5666 + t5667 = t5635 - t5638 + t5641 + 0.4500000000e1_dp*t5643 - t5647 - t5650 & + + t5653 - t5657 - t5660 + t5663 - t5666 t5670 = 0.2250000000e1_dp*t400*t1309*t4729 t5671 = t172*t4801 t5673 = 0.2250000000e1_dp*t1912*t5671 @@ -2478,8 +2478,8 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t5698 = 0.5625000000e1_dp*t3939*t5696 t5699 = t172*t4797 t5701 = 0.4500000000e1_dp*t1912*t5699 - t5705 = t5670-t5673+t5676-t5679+t5682+t5686-t5689+t5692 & - +t5695+t5698-t5701-0.1500000000e1_dp*t151*t50*t5613 + t5705 = t5670 - t5673 + t5676 - t5679 + t5682 + t5686 - t5689 + t5692 & + + t5695 + t5698 - t5701 - 0.1500000000e1_dp*t151*t50*t5613 t5713 = t4739*t160 t5716 = 0.1620000000e3_dp*t4994*t392*t4769*t1141*t26*t5713 t5719 = 0.3333333334e0_dp*t165*t1966*t1447 @@ -2490,10 +2490,10 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t5734 = 0.1666666667e0_dp*t429*t679*t1553 t5738 = 0.4444444445e0_dp*t170*t114*t4782*t451 t5741 = 0.1666666667e0_dp*t165*t171*t5143 - t5742 = -t5426+t5429-0.2222222222e0_dp*t5432+t5436+0.1666666667e0_dp & - *t165*t166*t5613+t5619+t5622-t5625-t5628+t5631 & - +(2*t147*t149*(t5667+t5705))+t5716+t5719-t5722 & - -0.1666666667e0_dp*t5724+t5728+t5731-t5734-t5738+t5741 + t5742 = -t5426 + t5429 - 0.2222222222e0_dp*t5432 + t5436 + 0.1666666667e0_dp & + *t165*t166*t5613 + t5619 + t5622 - t5625 - t5628 + t5631 & + + (2*t147*t149*(t5667 + t5705)) + t5716 + t5719 - t5722 & + - 0.1666666667e0_dp*t5724 + t5728 + t5731 - t5734 - t5738 + t5741 t5745 = t165*t4498*t561 t5749 = 0.1666666667e0_dp*t429*t437*t5170 t5752 = 0.8333333335e-1_dp*t429*t462*t4801 @@ -2521,8 +2521,8 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t5825 = 0.1200000000e2_dp*t473*t479*t5009 t5828 = 0.3600000000e2_dp*t473*t1801*t1447 t5830 = 0.1080000000e3_dp*t4230*t5696 - t5831 = t5801-t5804-t5807+t5810-t5813+t5816-t5819-t5822 & - -t5825-t5828-t5830 + t5831 = t5801 - t5804 - t5807 + t5810 - t5813 + t5816 - t5819 - t5822 & + - t5825 - t5828 - t5830 t5833 = 0.7200000000e2_dp*t1821*t5699 t5835 = 0.3600000000e2_dp*t1821*t5671 t5838 = 0.1080000000e3_dp*t1143*t474*t4797 @@ -2534,10 +2534,10 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t5857 = 0.6000000000e1_dp*t478*t489*t5430 t5861 = 0.5999999999e1_dp*t478*t56*t5122*t17 t5864 = 0.1800000000e2_dp*t473*t1150*t4729 - t5868 = t5833+t5835+t5838+t5841-t5845+t5848-0.3600000000e2_dp & - *t5850-t5854+t5857+t5861-t5864+0.8999999998e1_dp*t178 & + t5868 = t5833 + t5835 + t5838 + t5841 - t5845 + t5848 - 0.3600000000e2_dp & + *t5850 - t5854 + t5857 + t5861 - t5864 + 0.8999999998e1_dp*t178 & *t62*t5613 - t5869 = t5831+t5868 + t5869 = t5831 + t5868 t5875 = t1447*t187*t1722 t5880 = 0.3703703705e-1_dp*t192*t194*t5226*t526 t5881 = t1141*t4701 @@ -2553,12 +2553,12 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t5918 = t140*t1504*t1722 t5922 = 0.1111111112e0_dp*t4776*t515*t517 t5925 = 0.8099999996e2_dp*t498*t4770*t4915 - t5926 = -0.5555555558e-1_dp*t192*t68*t5869*t65-0.1000000000e1_dp & - *t5875+t5880+0.3000000000e1_dp*t1748*t5881*t4940-0.1111111112e0_dp & - *t5885-0.1000000000e1_dp*t5888-t5891+t5869*t65+ & - 0.666666666e0_dp*t1519*t722*t4729*t65+(2*t5898)+t5902 & - -t5905+0.1800000000e2_dp*t5908-t5913-0.1111111112e0_dp*t516 & - *t4898*t172-0.1000000000e1_dp*t5918-t5922+t5925 + t5926 = -0.5555555558e-1_dp*t192*t68*t5869*t65 - 0.1000000000e1_dp & + *t5875 + t5880 + 0.3000000000e1_dp*t1748*t5881*t4940 - 0.1111111112e0_dp & + *t5885 - 0.1000000000e1_dp*t5888 - t5891 + t5869*t65 + & + 0.666666666e0_dp*t1519*t722*t4729*t65 + (2*t5898) + t5902 & + - t5905 + 0.1800000000e2_dp*t5908 - t5913 - 0.1111111112e0_dp*t516 & + *t4898*t172 - 0.1000000000e1_dp*t5918 - t5922 + t5925 t5929 = 0.2250000000e2_dp*t1740*t471*t4905 t5932 = 0.1000000000e1_dp*t649*t266*t1722 t5938 = t192*t728*t1505 @@ -2578,11 +2578,11 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t5973 = 0.5555555558e-1_dp*t4943*t531 t5975 = t5226*t266*t65 t5977 = 0.1111111112e0_dp*t1755*t729 - t5978 = -t5929-t5932+0.3333333334e0_dp*t1519*t187*t4729*t65 & - -0.1111111112e0_dp*t5938-t5942-0.2000000002e1_dp*t5944-0.5555555558e-1_dp & - *t503*t4955+t5949-t5952+t5954+t5958-t5960 & - +t5963-0.1111111112e0_dp*t5964-0.2222222224e0_dp*t5966-t5971 & - -t5973+t5975-t5977 + t5978 = -t5929 - t5932 + 0.3333333334e0_dp*t1519*t187*t4729*t65 & + - 0.1111111112e0_dp*t5938 - t5942 - 0.2000000002e1_dp*t5944 - 0.5555555558e-1_dp & + *t503*t4955 + t5949 - t5952 + t5954 + t5958 - t5960 & + + t5963 - 0.1111111112e0_dp*t5964 - 0.2222222224e0_dp*t5966 - t5971 & + - t5973 + t5975 - t5977 t5985 = 0.5000000001e0_dp*t1774*t4908 t5990 = t177*t4729*t65 t5994 = 0.5000000001e0_dp*t1766*t5990 @@ -2597,12 +2597,12 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t6021 = t649*t1518*t1722 t6023 = t5251*t67 t6025 = 0.3703703705e-1_dp*t6023*t271 - t6029 = 0.5999999993e1_dp*t4946*t722*t4701*t4940-t5985-0.5555555558e-1_dp & - *t192*t199*t4898+0.3333333334e0_dp*t1748*t5990 & - -t5994+t5996-t6000+t6002+0.1800000000e2_dp*t6004-0.1111111112e0_dp & - *t6006-t6009+0.3000000000e1_dp*t4946*t187*t4701 & - *t4940-0.6666666668e0_dp*t1748*t5956-t6017+t6019+0.6666666668e0_dp & - *t6021+t6025-0.5555555558e-1_dp*t58*t5613*t71 + t6029 = 0.5999999993e1_dp*t4946*t722*t4701*t4940 - t5985 - 0.5555555558e-1_dp & + *t192*t199*t4898 + 0.3333333334e0_dp*t1748*t5990 & + - t5994 + t5996 - t6000 + t6002 + 0.1800000000e2_dp*t6004 - 0.1111111112e0_dp & + *t6006 - t6009 + 0.3000000000e1_dp*t4946*t187*t4701 & + *t4940 - 0.6666666668e0_dp*t1748*t5956 - t6017 + t6019 + 0.6666666668e0_dp & + *t6021 + t6025 - 0.5555555558e-1_dp*t58*t5613*t71 t6031 = 0.5000000001e0_dp*t1720*t5990 t6033 = 0.1000000000e1_dp*t5244*t1712 t6036 = 0.2250000000e2_dp*t498*t472*t4905 @@ -2621,18 +2621,18 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t6074 = 0.8099999996e2_dp*t496*t4769*t1141*t4915 t6075 = t723*t6052 t6078 = 0.1111111112e0_dp*t719*t1782 - t6079 = -t6031-t6033-t6036+t187*t4897*t65-t6040-t6042 & - +t6044-t6047-0.1000000000e1_dp*t6049-0.1000000000e1_dp*t6053 & - -t6056-t6058-0.4500000000e1_dp*t6060+t6063+0.6666666668e0_dp & - *t6066-0.1000000000e1_dp*t237*t705*t1722+t6074-0.2000000002e1_dp & - *t6075-t6078 + t6079 = -t6031 - t6033 - t6036 + t187*t4897*t65 - t6040 - t6042 & + + t6044 - t6047 - 0.1000000000e1_dp*t6049 - 0.1000000000e1_dp*t6053 & + - t6056 - t6058 - 0.4500000000e1_dp*t6060 + t6063 + 0.6666666668e0_dp & + *t6066 - 0.1000000000e1_dp*t237*t705*t1722 + t6074 - 0.2000000002e1_dp & + *t6075 - t6078 t6087 = 0.1666666667e0_dp*t429*t1966*t1410 t6090 = 0.3125000000e0_dp*t4025*t1247*t4790 - t6091 = 0.3333333334e0_dp*t5745-t5749-t5752-t5756+t5760+0.1666666667e0_dp & - *t165*t56*t4958*t140+t5767+t5770+t5773+ & - t5776+t5780-t5783+t5786+t5789+t5792-t5795-0.4444444444e0_dp & - *t5797+0.3333333334e0_dp*t55*t57*(t5926+t5978+t6029 & - +t6079)-t6087-t6090 + t6091 = 0.3333333334e0_dp*t5745 - t5749 - t5752 - t5756 + t5760 + 0.1666666667e0_dp & + *t165*t56*t4958*t140 + t5767 + t5770 + t5773 + & + t5776 + t5780 - t5783 + t5786 + t5789 + t5792 - t5795 - 0.4444444444e0_dp & + *t5797 + 0.3333333334e0_dp*t55*t57*(t5926 + t5978 + t6029 & + + t6079) - t6087 - t6090 t6094 = 0.1250000000e0_dp*t1981*t1247*t4801 t6099 = 0.1800000000e2_dp*t1971*t1972*t4729*t149*t160 t6102 = 0.2500000000e0_dp*t1981*t4553*t1410 @@ -2652,21 +2652,21 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t6155 = 0.2500000000e0_dp*t1981*t4032*t1410 t6158 = 0.1666666667e0_dp*t429*t679*t1571 t6160 = t147*t1885*t672 - t6162 = t6094+t6099+t6102+t6106-t6109+t6112-t6116+t6119 & - -t6123+t6126-t6129+t6132-t6136-0.1666666667e0_dp*t6138 & - +0.3600000000e2_dp*t6141+0.3333333334e0_dp*t6144+0.2e1_dp*t147 & - *(t4881-t4884-t4887+0.9000000000e1_dp*t4889-t4893+0.6000000000e1_dp & - *t4895)*t149*t160+t6155-t6158+(4*t6160) + t6162 = t6094 + t6099 + t6102 + t6106 - t6109 + t6112 - t6116 + t6119 & + - t6123 + t6126 - t6129 + t6132 - t6136 - 0.1666666667e0_dp*t6138 & + + 0.3600000000e2_dp*t6141 + 0.3333333334e0_dp*t6144 + 0.2e1_dp*t147 & + *(t4881 - t4884 - t4887 + 0.9000000000e1_dp*t4889 - t4893 + 0.6000000000e1_dp & + *t4895)*t149*t160 + t6155 - t6158 + (4*t6160) t6170 = 0.3333333336e0_dp*t289*t597*t1571 t6173 = 0.3333333336e0_dp*t55*t5295*t140 t6175 = t83*t597*t1688 t6179 = 0.3333333336e0_dp*t165*t3865*t561 t6181 = t289*t1564*t593 t6185 = 0.3333333336e0_dp*t289*t597*t1553 - t6186 = -0.3333333336e0_dp*t5347-t5351-t5354-t5357-t5360-0.2222222224e0_dp & - *t144*t46*(t5423+t5742+t6091+t6162)-t6170 & - -t6173-0.6666666672e0_dp*t6175-t6179-0.3333333336e0_dp*t6181 & - -t6185 + t6186 = -0.3333333336e0_dp*t5347 - t5351 - t5354 - t5357 - t5360 - 0.2222222224e0_dp & + *t144*t46*(t5423 + t5742 + t6091 + t6162) - t6170 & + - t6173 - 0.6666666672e0_dp*t6175 - t6179 - 0.3333333336e0_dp*t6181 & + - t6185 t6189 = 0.8333333340e-1_dp*t906*t294*t5163 t6192 = 0.3333333336e0_dp*t83*t294*t5122 t6194 = t83*t3875*t561 @@ -2678,14 +2678,14 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t6216 = 0.8333333340e-1_dp*t429*t897*t4701 t6219 = 0.8333333340e-1_dp*t906*t384*t4790 t6222 = 0.8333333340e-1_dp*t1546*t897*t4801 - t6223 = t6189-t6192-0.6666666672e0_dp*t6194-t6198-t6201-0.3333333336e0_dp & - *t83*t84*t5613+t6207-t6210-t6213+t6216+ & - t6219+t6222 - t6227 = -t4704-t4707-t4732-t4789+t4793-t4796-t4800-t4804 & - -t4808-t4812-t4857-t4861-0.1333333334e1_dp*t4864-t4869 & - -0.4444444448e0_dp*t43*t46*t5036+t8*(t5305+t5343+t6186 & - +t6223) - e_ndrho_ndrho_rho(ii) = e_ndrho_ndrho_rho(ii)+t6227*sx + t6223 = t6189 - t6192 - 0.6666666672e0_dp*t6194 - t6198 - t6201 - 0.3333333336e0_dp & + *t83*t84*t5613 + t6207 - t6210 - t6213 + t6216 + & + t6219 + t6222 + t6227 = -t4704 - t4707 - t4732 - t4789 + t4793 - t4796 - t4800 - t4804 & + - t4808 - t4812 - t4857 - t4861 - 0.1333333334e1_dp*t4864 - t4869 & + - 0.4444444448e0_dp*t43*t46*t5036 + t8*(t5305 + t5343 + t6186 & + + t6223) + e_ndrho_ndrho_rho(ii) = e_ndrho_ndrho_rho(ii) + t6227*sx t6247 = t4769*t2992 t6249 = t4772*t2027 t6252 = t56*t4701 @@ -2697,145 +2697,145 @@ SUBROUTINE xb88_lr_adiabatic_lda_calc(rho, norm_drho, & t6267 = t26*t1447 t6268 = t6267*t709 t6271 = t4764*t2027 - t6281 = -0.1620000000e3_dp*t6247*t4733*t6249-0.1200000000e2_dp* & - t473*t6253+0.5999999999e1_dp*t478*t6257+0.5399999998e2_dp*t4771 & - *t6260+0.8999999998e1_dp*t478*t6263*t65+0.8099999996e2_dp & - *t4771*t6268-0.1800000000e2_dp*t473*t6271-0.4050000000e2_dp & - *t473*t575*t2095-0.5000000001e0_dp*t60*t4853*t65+0.8999999998e1_dp & - *t4901-t4907+t4911 + t6281 = -0.1620000000e3_dp*t6247*t4733*t6249 - 0.1200000000e2_dp* & + t473*t6253 + 0.5999999999e1_dp*t478*t6257 + 0.5399999998e2_dp*t4771 & + *t6260 + 0.8999999998e1_dp*t478*t6263*t65 + 0.8099999996e2_dp & + *t4771*t6268 - 0.1800000000e2_dp*t473*t6271 - 0.4050000000e2_dp & + *t473*t575*t2095 - 0.5000000001e0_dp*t60*t4853*t65 + 0.8999999998e1_dp & + *t4901 - t4907 + t4911 t6283 = t4701*t1518 - t6290 = t4917-t4920+0.5000000001e0_dp*t4922+t4925+0.3333333334e0_dp & - *t6283*t177*t65-0.5000000001e0_dp*t4929-t4932-t4935 & - +0.5850000000e2_dp*t4941+t4945-t4951-0.5555555558e-1_dp*t4952 - t6291 = t6281+t6290 + t6290 = t4917 - t4920 + 0.5000000001e0_dp*t4922 + t4925 + 0.3333333334e0_dp & + *t6283*t177*t65 - 0.5000000001e0_dp*t4929 - t4932 - t4935 & + + 0.5850000000e2_dp*t4941 + t4945 - t4951 - 0.5555555558e-1_dp*t4952 + t6291 = t6281 + t6290 t6308 = 0.4050000000e2_dp*t4734*t4736*t2821*t18*t4739*t237 & - -0.1125000000e2_dp*t2013*t1300*t19*t4790-t5028-t5022+ & - 0.1500000000e1_dp*t2013*t398*t68*t5002+0.3333333334e0_dp*t55 & - *t57*t6291+t5019-0.3000000000e1_dp*t566*t1885*t569-t5016 & - -0.9000000000e1_dp*t4734*t4736*t1300*t4701*t149*t17 & - +t5032+0.1666666667e0_dp*t165*t2088*t561-0.5555555557e-1_dp* & - t5011+t5001 - t6338 = 0.1666666667e0_dp*t4874-t5025-0.2700000000e2_dp*t4734*t392 & - *t4736*t1300*my_rho*t5002*t149-0.3000000000e1_dp*t2009 & - *t4748-0.2700000000e2_dp*t4738*t18*t1973*t1447-t5008- & - 0.3000000000e1_dp*t567*t151*t19*t4853+t5035-0.1000000000e1_dp & - *t2013*t2018*t5009+0.9000000000e1_dp*t2013*t2014*t4797 & - -t4872+0.4500000000e1_dp*t2013*t2014*t4801+t4878+t5005 & - +0.4500000000e1_dp*t2009*t4744 - t6339 = t6308+t6338 - t6344 = -t5043-t5047-t5050-t5126-t5284-t5291+t5294-t5298 & - -t5301-0.3333333336e0_dp*t5303-t5308-t5311-t5314 - t6352 = t5440-t5443-t5446-t5449-t5451-t5454+0.40e1_dp*t102 & - *t327*t2057*t557-t5456+t5459-t5462+t5466-t5468 - t6363 = t5480-t5482-t5484+t5487-t5489+t5492+t5494-0.9600000000e2_dp & - *t5496+t5499-t5503-t5507+t5509-0.2400000000e2_dp & - *t5511-0.960e2_dp*t5115*t1060-0.240e2_dp*t2054*t3674+0.1200e3_dp & + - 0.1125000000e2_dp*t2013*t1300*t19*t4790 - t5028 - t5022 + & + 0.1500000000e1_dp*t2013*t398*t68*t5002 + 0.3333333334e0_dp*t55 & + *t57*t6291 + t5019 - 0.3000000000e1_dp*t566*t1885*t569 - t5016 & + - 0.9000000000e1_dp*t4734*t4736*t1300*t4701*t149*t17 & + + t5032 + 0.1666666667e0_dp*t165*t2088*t561 - 0.5555555557e-1_dp* & + t5011 + t5001 + t6338 = 0.1666666667e0_dp*t4874 - t5025 - 0.2700000000e2_dp*t4734*t392 & + *t4736*t1300*my_rho*t5002*t149 - 0.3000000000e1_dp*t2009 & + *t4748 - 0.2700000000e2_dp*t4738*t18*t1973*t1447 - t5008 - & + 0.3000000000e1_dp*t567*t151*t19*t4853 + t5035 - 0.1000000000e1_dp & + *t2013*t2018*t5009 + 0.9000000000e1_dp*t2013*t2014*t4797 & + - t4872 + 0.4500000000e1_dp*t2013*t2014*t4801 + t4878 + t5005 & + + 0.4500000000e1_dp*t2009*t4744 + t6339 = t6308 + t6338 + t6344 = -t5043 - t5047 - t5050 - t5126 - t5284 - t5291 + t5294 - t5298 & + - t5301 - 0.3333333336e0_dp*t5303 - t5308 - t5311 - t5314 + t6352 = t5440 - t5443 - t5446 - t5449 - t5451 - t5454 + 0.40e1_dp*t102 & + *t327*t2057*t557 - t5456 + t5459 - t5462 + t5466 - t5468 + t6363 = t5480 - t5482 - t5484 + t5487 - t5489 + t5492 + t5494 - 0.9600000000e2_dp & + *t5496 + t5499 - t5503 - t5507 + t5509 - 0.2400000000e2_dp & + *t5511 - 0.960e2_dp*t5115*t1060 - 0.240e2_dp*t2054*t3674 + 0.1200e3_dp & *t1054*t640*t3679 - t6367 = t5472-t5474-t5478-t5523+t5525+0.40e1_dp*t5528+t5531 & - +t5533+t5535+t5537-0.20e1_dp*t102*t105*t6363+t5540 - t6370 = t5545-t5548+t5551+t5553-t5558+t5560-t5562+t5564 & - -0.40e1_dp*t5565+t5568+t5572+t5574 - t6373 = t5579-t5581-0.40e1_dp*t112*t2058-t5585+t5590-t5593 & - -t5595+t5597-t5600-t5602+t5604+t5607+t5610 - t6375 = t6352+t6367+t6370+t6373 - t6380 = -t5317-t5320+t5323-t5326-t5329-0.3333333336e0_dp*t83 & - *t597*t2061-0.3333333336e0_dp*t83*t84*t6375+t5333-t5335 & - -t5338-t5342-0.1666666668e0_dp*t5347-t5351 - t6389 = -t5354-t5357-0.3333333336e0_dp*t83*t45*t2139*t561 & - -t5360-t6170-t6173-0.3333333336e0_dp*t6175-t6179-0.1666666668e0_dp & - *t6181-t6185+t6189-t6192-0.3333333336e0_dp*t6194 + t6367 = t5472 - t5474 - t5478 - t5523 + t5525 + 0.40e1_dp*t5528 + t5531 & + + t5533 + t5535 + t5537 - 0.20e1_dp*t102*t105*t6363 + t5540 + t6370 = t5545 - t5548 + t5551 + t5553 - t5558 + t5560 - t5562 + t5564 & + - 0.40e1_dp*t5565 + t5568 + t5572 + t5574 + t6373 = t5579 - t5581 - 0.40e1_dp*t112*t2058 - t5585 + t5590 - t5593 & + - t5595 + t5597 - t5600 - t5602 + t5604 + t5607 + t5610 + t6375 = t6352 + t6367 + t6370 + t6373 + t6380 = -t5317 - t5320 + t5323 - t5326 - t5329 - 0.3333333336e0_dp*t83 & + *t597*t2061 - 0.3333333336e0_dp*t83*t84*t6375 + t5333 - t5335 & + - t5338 - t5342 - 0.1666666668e0_dp*t5347 - t5351 + t6389 = -t5354 - t5357 - 0.3333333336e0_dp*t83*t45*t2139*t561 & + - t5360 - t6170 - t6173 - 0.3333333336e0_dp*t6175 - t6179 - 0.1666666668e0_dp & + *t6181 - t6185 + t6189 - t6192 - 0.3333333336e0_dp*t6194 t6400 = t2061*t561 - t6415 = -t5363+t5367-t5370+0.1111111112e0_dp*t5373-0.5555555557e-1_dp & - *t5376+0.1666666667e0_dp*t5379-t5383-t5386-t5389+ & - 0.1200000000e2_dp*t658*t2031*t673*t17+0.3333333334e0_dp*t170 & - *t27*t6291*t172-t5397 - t6428 = t5635-t5638+t5641+0.2250000000e1_dp*t5643-t5647-0.1500000000e1_dp & - *t151*t50*t6375-t5650+t5653-t5657-t5660 & - +t5663-t5666 - t6433 = t5670-t5673+t5676-t5679+t5682+t5686-t5689+t5692 & - +t5695+0.2250000000e1_dp*t400*t19*t2061*t561+t5698- & + t6415 = -t5363 + t5367 - t5370 + 0.1111111112e0_dp*t5373 - 0.5555555557e-1_dp & + *t5376 + 0.1666666667e0_dp*t5379 - t5383 - t5386 - t5389 + & + 0.1200000000e2_dp*t658*t2031*t673*t17 + 0.3333333334e0_dp*t170 & + *t27*t6291*t172 - t5397 + t6428 = t5635 - t5638 + t5641 + 0.2250000000e1_dp*t5643 - t5647 - 0.1500000000e1_dp & + *t151*t50*t6375 - t5650 + t5653 - t5657 - t5660 & + + t5663 - t5666 + t6433 = t5670 - t5673 + t5676 - t5679 + t5682 + t5686 - t5689 + t5692 & + + t5695 + 0.2250000000e1_dp*t400*t19*t2061*t561 + t5698 - & t5701 - t6442 = t5400+0.1666666667e0_dp*t5402-t5406+0.1666666667e0_dp*t165 & - *t56*t2131*t561+0.1666666667e0_dp*t165*t679*t2061+ & - (2*t147*t149*(t6428+t6433))-t5409-t5412-t5415+ & - t5418+0.1800000000e2_dp*t658*t575*t2074+0.1800000000e2_dp*t5421 - t6451 = -t5426+t5429-0.2222222223e0_dp*t5432+t5436+0.1620000000e3_dp & - *t4995*t6267*t1974+0.1666666667e0_dp*t165*t2088*t649 & - +t5619+t5622-t5625-t5628+t5631+t5716 - t6461 = t5719-t5722-0.8333333335e-1_dp*t5724+0.1200000000e2_dp* & - t658*t6256*t2077-0.3240000000e3_dp*t4994*t6247*t4772*t2082 & - +t5728+t5731-t5734-t5738+t5741+0.1666666667e0_dp*t5745 & - -t5749 - t6479 = -t5752+0.1666666667e0_dp*t445*t2042*my_rho*t668-t5756 & - -0.3600000000e2_dp*t2081*t575*t673*t237+0.1800000000e2_dp* & - t658*t6263*t161+t5760+t5767+t5770-0.7200000000e2_dp*t2081 & - *t575*t161*t1447+t5773+t5776+t5780 - t6490 = -t5783-0.3600000000e2_dp*t2081*t4764*t2082-0.2400000000e2_dp & - *t2081*t6252*t2077+t5786+t5789+t5792-t5795-0.4444444445e0_dp & - *t5797-t6087-0.8333333335e-1_dp*t429*t166*t6400 & - -t6090+t6094 - t6499 = t6099+0.1666666667e0_dp*t165*t166*t6375+t6102+0.1666666667e0_dp & - *t165*t56*t6291*t140+t6106-t6109+t6112-t6116 & - +t6119-t6123+t6126-t6129 + t6442 = t5400 + 0.1666666667e0_dp*t5402 - t5406 + 0.1666666667e0_dp*t165 & + *t56*t2131*t561 + 0.1666666667e0_dp*t165*t679*t2061 + & + (2*t147*t149*(t6428 + t6433)) - t5409 - t5412 - t5415 + & + t5418 + 0.1800000000e2_dp*t658*t575*t2074 + 0.1800000000e2_dp*t5421 + t6451 = -t5426 + t5429 - 0.2222222223e0_dp*t5432 + t5436 + 0.1620000000e3_dp & + *t4995*t6267*t1974 + 0.1666666667e0_dp*t165*t2088*t649 & + + t5619 + t5622 - t5625 - t5628 + t5631 + t5716 + t6461 = t5719 - t5722 - 0.8333333335e-1_dp*t5724 + 0.1200000000e2_dp* & + t658*t6256*t2077 - 0.3240000000e3_dp*t4994*t6247*t4772*t2082 & + + t5728 + t5731 - t5734 - t5738 + t5741 + 0.1666666667e0_dp*t5745 & + - t5749 + t6479 = -t5752 + 0.1666666667e0_dp*t445*t2042*my_rho*t668 - t5756 & + - 0.3600000000e2_dp*t2081*t575*t673*t237 + 0.1800000000e2_dp* & + t658*t6263*t161 + t5760 + t5767 + t5770 - 0.7200000000e2_dp*t2081 & + *t575*t161*t1447 + t5773 + t5776 + t5780 + t6490 = -t5783 - 0.3600000000e2_dp*t2081*t4764*t2082 - 0.2400000000e2_dp & + *t2081*t6252*t2077 + t5786 + t5789 + t5792 - t5795 - 0.4444444445e0_dp & + *t5797 - t6087 - 0.8333333335e-1_dp*t429*t166*t6400 & + - t6090 + t6094 + t6499 = t6099 + 0.1666666667e0_dp*t165*t166*t6375 + t6102 + 0.1666666667e0_dp & + *t165*t56*t6291*t140 + t6106 - t6109 + t6112 - t6116 & + + t6119 - t6123 + t6126 - t6129 t6509 = t4853*t65 - t6529 = 0.4999999999e0_dp*t5875-0.5000000001e0_dp*t5244*t2095-0.5000000001e0_dp & - *t732*t6509+t5880+0.1000000000e1_dp*t649*t471 & - *t2099-0.1620000000e3_dp*t5247*t2992*t4733*t6249-0.5555555558e-1_dp & - *t5885+0.8999999998e1_dp*t140*t2992*t4701*t59* & - t62*t2027-0.5000000001e0_dp*t5888-t5891-0.1800000000e2_dp*t2118 & + t6529 = 0.4999999999e0_dp*t5875 - 0.5000000001e0_dp*t5244*t2095 - 0.5000000001e0_dp & + *t732*t6509 + t5880 + 0.1000000000e1_dp*t649*t471 & + *t2099 - 0.1620000000e3_dp*t5247*t2992*t4733*t6249 - 0.5555555558e-1_dp & + *t5885 + 0.8999999998e1_dp*t140*t2992*t4701*t59* & + t62*t2027 - 0.5000000001e0_dp*t5888 - t5891 - 0.1800000000e2_dp*t2118 & *t6271 - t6539 = t5898+t5902-t5905+0.8999999998e1_dp*t5908-t5913+0.2000000000e1_dp & - *t2098*t2095*t561-0.5000000001e0_dp*t5918-t5922 & - +0.3333333334e0_dp*t6283*t187*t177*t65+t5925-t5929 - t6554 = -t5932-0.5555555558e-1_dp*t5938+0.666666666e0_dp*t6283* & - t722*t177*t65-t5942+0.8999999998e1_dp*t2124*t59*t177* & - t710+0.1000000001e1_dp*t5944-0.5000000001e0_dp*t2061*t177*t709 & - +t5949+t5952+t5954-t5958 + t6539 = t5898 + t5902 - t5905 + 0.8999999998e1_dp*t5908 - t5913 + 0.2000000000e1_dp & + *t2098*t2095*t561 - 0.5000000001e0_dp*t5918 - t5922 & + + 0.3333333334e0_dp*t6283*t187*t177*t65 + t5925 - t5929 + t6554 = -t5932 - 0.5555555558e-1_dp*t5938 + 0.666666666e0_dp*t6283* & + t722*t177*t65 - t5942 + 0.8999999998e1_dp*t2124*t59*t177* & + t710 + 0.1000000001e1_dp*t5944 - 0.5000000001e0_dp*t2061*t177*t709 & + + t5949 + t5952 + t5954 - t5958 t6557 = t1447*t59 - t6569 = -t5960-0.5000000001e0_dp*t5237*t2095+t5963-0.4500000000e1_dp & - *t5256*t6557*t710-0.5555555558e-1_dp*t5964-0.1111111112e0_dp & - *t5966-t5971-0.1200000000e2_dp*t2118*t6253-0.5555555558e-1_dp & - *t719*t2126-t5973+t5975+0.5999999999e1_dp*t2114*t6257 - t6583 = -t5977-t5985+t5994-0.5000000001e0_dp*t716*t6509+t5996 & - -t6000+t6002+0.8999999998e1_dp*t6004+0.1000000000e1_dp*t2098 & - *t4908*t237-0.1000000001e1_dp*t723*t6509-0.1800000000e2_dp & + t6569 = -t5960 - 0.5000000001e0_dp*t5237*t2095 + t5963 - 0.4500000000e1_dp & + *t5256*t6557*t710 - 0.5555555558e-1_dp*t5964 - 0.1111111112e0_dp & + *t5966 - t5971 - 0.1200000000e2_dp*t2118*t6253 - 0.5555555558e-1_dp & + *t719*t2126 - t5973 + t5975 + 0.5999999999e1_dp*t2114*t6257 + t6583 = -t5977 - t5985 + t5994 - 0.5000000001e0_dp*t716*t6509 + t5996 & + - t6000 + t6002 + 0.8999999998e1_dp*t6004 + 0.1000000000e1_dp*t2098 & + *t4908*t237 - 0.1000000001e1_dp*t723*t6509 - 0.1800000000e2_dp & *t5228*t2117*t2028 t6596 = t5247*t1141*t4733 - t6603 = -0.5555555558e-1_dp*t6006-t6009-t6017-0.5555555558e-1_dp & - *t58*t6375*t71+t6019-0.9000000007e1_dp*t5262*t6557*t710 & - +0.8999999998e1_dp*t708*t62*t6509+0.3333333334e0_dp*t6021+ & - t6025+0.8099999996e2_dp*t6596*t6268+0.5399999998e2_dp*t6596* & - t6260+0.8999999998e1_dp*t5229*t2104 - t6611 = t5801-t5804-t5807+t5810-t5813+t5816-t5819-t5822 & - -t5825-t5828-t5830+t5833 - t6620 = t5835+t5838+t5841-t5845+t5848-0.1800000000e2_dp*t5850 & - -t5854+t5857+t5861-t5864-0.1800000000e2_dp*t473*t20 & - *t2061*t561+0.8999999998e1_dp*t178*t62*t6375 - t6621 = t6611+t6620 - t6630 = -0.3000000000e1_dp*t5256*t4904*t237+0.5999999999e1_dp*t5228 & - *t2113*t2032+t6621*t65-t6031-0.4050000000e2_dp*t471 & - *t187*t6557*t710-t6033-t6036-t6040+t6042-0.5000000001e0_dp & - *t60*t2124*t709-t6044 - t6640 = -t6047-0.5000000001e0_dp*t6049-0.5555555558e-1_dp*t192* & - t68*t6621*t65-0.5000000001e0_dp*t6053-t6056-t6058+0.5850000000e2_dp & - *t6060+t6063+0.3333333334e0_dp*t6066+t6074-0.1000000001e1_dp & - *t6075-t6078 - t6658 = 0.1800000000e2_dp*t658*t2035*t673-0.8333333335e-1_dp*t429 & - *t2088*t593+t6132+0.3333333334e0_dp*t55*t57*(t6529+ & - t6539+t6554+t6569+t6583+t6603+t6630+t6640)-t6136-0.8333333335e-1_dp & - *t6138+0.1800000000e2_dp*t6141+0.1080000000e3_dp* & - t4995*t4743*t2077+0.1080000000e3_dp*t657*t1142*t4760*t2082 & - +0.1666666667e0_dp*t6144+t6155-t6158+(2*t6160) - t6665 = -0.3333333336e0_dp*t83*t45*t6339*t140-t6198-0.3333333336e0_dp & - *t83*t2050*t649-t6201+t6207-t6210-t6213+t6216 & - +t6219-0.1666666668e0_dp*t289*t2050*t593-0.1666666668e0_dp & - *t289*t84*t6400+t6222-0.2222222224e0_dp*t144*t46*(t6415 & - +t6442+t6451+t6461+t6479+t6490+t6499+t6658) - t6669 = -t4704-t4707-t4732+t4793-t4796-t4800-t4804-t4861 & - -0.6666666672e0_dp*t4864-t4869-t4812-t4857-t4789-t4808 & - -0.6666666672e0_dp*t217*t46*t2046*t561-0.4444444448e0_dp* & - t43*t46*t6339+t8*(t6344+t6380+t6389+t6665) - e_ndrho_ndrho_ndrho(ii) = e_ndrho_ndrho_ndrho(ii)+t6669*sx + t6603 = -0.5555555558e-1_dp*t6006 - t6009 - t6017 - 0.5555555558e-1_dp & + *t58*t6375*t71 + t6019 - 0.9000000007e1_dp*t5262*t6557*t710 & + + 0.8999999998e1_dp*t708*t62*t6509 + 0.3333333334e0_dp*t6021 + & + t6025 + 0.8099999996e2_dp*t6596*t6268 + 0.5399999998e2_dp*t6596* & + t6260 + 0.8999999998e1_dp*t5229*t2104 + t6611 = t5801 - t5804 - t5807 + t5810 - t5813 + t5816 - t5819 - t5822 & + - t5825 - t5828 - t5830 + t5833 + t6620 = t5835 + t5838 + t5841 - t5845 + t5848 - 0.1800000000e2_dp*t5850 & + - t5854 + t5857 + t5861 - t5864 - 0.1800000000e2_dp*t473*t20 & + *t2061*t561 + 0.8999999998e1_dp*t178*t62*t6375 + t6621 = t6611 + t6620 + t6630 = -0.3000000000e1_dp*t5256*t4904*t237 + 0.5999999999e1_dp*t5228 & + *t2113*t2032 + t6621*t65 - t6031 - 0.4050000000e2_dp*t471 & + *t187*t6557*t710 - t6033 - t6036 - t6040 + t6042 - 0.5000000001e0_dp & + *t60*t2124*t709 - t6044 + t6640 = -t6047 - 0.5000000001e0_dp*t6049 - 0.5555555558e-1_dp*t192* & + t68*t6621*t65 - 0.5000000001e0_dp*t6053 - t6056 - t6058 + 0.5850000000e2_dp & + *t6060 + t6063 + 0.3333333334e0_dp*t6066 + t6074 - 0.1000000001e1_dp & + *t6075 - t6078 + t6658 = 0.1800000000e2_dp*t658*t2035*t673 - 0.8333333335e-1_dp*t429 & + *t2088*t593 + t6132 + 0.3333333334e0_dp*t55*t57*(t6529 + & + t6539 + t6554 + t6569 + t6583 + t6603 + t6630 + t6640) - t6136 - 0.8333333335e-1_dp & + *t6138 + 0.1800000000e2_dp*t6141 + 0.1080000000e3_dp* & + t4995*t4743*t2077 + 0.1080000000e3_dp*t657*t1142*t4760*t2082 & + + 0.1666666667e0_dp*t6144 + t6155 - t6158 + (2*t6160) + t6665 = -0.3333333336e0_dp*t83*t45*t6339*t140 - t6198 - 0.3333333336e0_dp & + *t83*t2050*t649 - t6201 + t6207 - t6210 - t6213 + t6216 & + + t6219 - 0.1666666668e0_dp*t289*t2050*t593 - 0.1666666668e0_dp & + *t289*t84*t6400 + t6222 - 0.2222222224e0_dp*t144*t46*(t6415 & + + t6442 + t6451 + t6461 + t6479 + t6490 + t6499 + t6658) + t6669 = -t4704 - t4707 - t4732 + t4793 - t4796 - t4800 - t4804 - t4861 & + - 0.6666666672e0_dp*t4864 - t4869 - t4812 - t4857 - t4789 - t4808 & + - 0.6666666672e0_dp*t217*t46*t2046*t561 - 0.4444444448e0_dp* & + t43*t46*t6339 + t8*(t6344 + t6380 + t6389 + t6665) + e_ndrho_ndrho_ndrho(ii) = e_ndrho_ndrho_ndrho(ii) + t6669*sx END IF END IF @@ -2893,7 +2893,7 @@ SUBROUTINE xb88_lr_adiabatic_lsd_eval(rho_set, deriv_set, grad_deriv, xb88_lr_ad rhob=rho(2)%array, norm_drhoa=norm_drho(1)%array, & norm_drhob=norm_drho(2)%array, rho_cutoff=epsilon_rho, & local_bounds=bo) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rho(1)%array @@ -3220,12 +3220,12 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t25 = 0.1e1_dp/t9 t26 = t19*t18 t27 = 0.1e1_dp/t26 - t31 = LOG(ndrho*t25*t27+SQRT((ndrho*t25*t27)**0.2e1_dp+ & - 0.1e1_dp)) - t35 = 0.10e1_dp+0.60e1_dp*t24*t25*t27*t31 + t31 = LOG(ndrho*t25*t27 + SQRT((ndrho*t25*t27)**0.2e1_dp + & + 0.1e1_dp)) + t35 = 0.10e1_dp + 0.60e1_dp*t24*t25*t27*t31 t36 = 0.1e1_dp/t35 t37 = t23*t36 - t40 = 0.20e1_dp*Cx+0.20e1_dp*t7*t37 + t40 = 0.20e1_dp*Cx + 0.20e1_dp*t7*t37 t41 = SQRT(t40) t42 = t41*t40 t43 = t4*t42 @@ -3251,10 +3251,10 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t67 = 0.1e1_dp/pi t68 = 0.1e1_dp/t20 t69 = t67*t68 - t70 = t65-0.10e1_dp + t70 = t65 - 0.10e1_dp t71 = t69*t70 - t74 = t65-0.15e1_dp-0.5555555558e-1_dp*t66*t71 - t78 = t44*t53+0.3333333334e0_dp*t55*t57*t74 + t74 = t65 - 0.15e1_dp - 0.5555555558e-1_dp*t66*t71 + t78 = t44*t53 + 0.3333333334e0_dp*t55*t57*t74 t79 = t46*t78 t83 = rho*t41*omega t84 = t45*t78 @@ -3283,15 +3283,15 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t119 = t24*t25 t122 = ndrho*t11 t123 = t114*rho - t126 = -4*ndrho*t107*t27+4*t122*t123 - t130 = 1+t6*t11*t22 + t126 = -4*ndrho*t107*t27 + 4*t122*t123 + t130 = 1 + t6*t11*t22 t131 = SQRT(t130) t132 = 0.1e1_dp/t131 t133 = t27*t126*t132 - t136 = -0.240e2_dp*t24*t108*t31+0.240e2_dp*t112*t116+0.60e1_dp & + t136 = -0.240e2_dp*t24*t108*t31 + 0.240e2_dp*t112*t116 + 0.60e1_dp & *t119*t133 t137 = t105*t136 - t140 = -0.160e2_dp*t7*t88+0.160e2_dp*t93*t99-0.20e1_dp*t102* & + t140 = -0.160e2_dp*t7*t88 + 0.160e2_dp*t93*t99 - 0.20e1_dp*t102* & t137 t141 = t84*t140 t144 = rho*t42 @@ -3303,7 +3303,7 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t151 = t47*t150 t155 = t49*t44 t156 = t68*rho - t160 = -0.1500000000e1_dp*t151*t50*t140-0.3000000000e1_dp*t155 & + t160 = -0.1500000000e1_dp*t151*t50*t140 - 0.3000000000e1_dp*t155 & *t156*t25 t161 = t149*t160 t164 = omega*t48 @@ -3317,7 +3317,7 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t178 = t59*t177 t182 = t61*pi t183 = t56*rho - t187 = 0.8999999998e1_dp*t178*t62*t140+0.1800000000e2_dp*t182* & + t187 = 0.8999999998e1_dp*t178*t62*t140 + 0.1800000000e2_dp*t182* & t183*t25 t189 = t58*t140 t192 = t66*t67 @@ -3326,13 +3326,13 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t196 = t195*t172 t199 = t68*t187 t200 = t199*t65 - t203 = t187*t65-0.5555555558e-1_dp*t189*t71-0.1111111112e0_dp* & - t192*t196-0.5555555558e-1_dp*t192*t200 - t207 = (2*t147*t161)+0.1666666667e0_dp*t165*t166*t140 & - +0.3333333334e0_dp*t170*t171*t172+0.3333333334e0_dp*t55*t57 & + t203 = t187*t65 - 0.5555555558e-1_dp*t189*t71 - 0.1111111112e0_dp* & + t192*t196 - 0.5555555558e-1_dp*t192*t200 + t207 = (2*t147*t161) + 0.1666666667e0_dp*t165*t166*t140 & + + 0.3333333334e0_dp*t170*t171*t172 + 0.3333333334e0_dp*t55*t57 & *t203 - e_0(ii) = e_0(ii)+(-0.4444444448e0_dp*t43*t79+t8*(-0.3333333336e0_dp*t83*t141 & - -0.2222222224e0_dp*t144*t46*t207))*sx + e_0(ii) = e_0(ii) + (-0.4444444448e0_dp*t43*t79 + t8*(-0.3333333336e0_dp*t83*t141 & + - 0.2222222224e0_dp*t144*t46*t207))*sx END IF IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN t214 = lambda*t42 @@ -3344,27 +3344,27 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t224 = t9*t16 t225 = 0.1e1_dp/t224 t230 = t220*t132 - t233 = -0.8000000000e1_dp*t24*t225*t114*t31-0.8000000000e1_dp* & + t233 = -0.8000000000e1_dp*t24*t225*t114*t31 - 0.8000000000e1_dp* & t7*t230 t234 = t105*t233 - t237 = -0.5333333333e1_dp*t7*t221-0.20e1_dp*t102*t234 + t237 = -0.5333333333e1_dp*t7*t221 - 0.20e1_dp*t102*t234 t245 = t44*t68 - t249 = -0.1500000000e1_dp*t151*t50*t237+0.1000000000e1_dp*t49* & + t249 = -0.1500000000e1_dp*t151*t50*t237 + 0.1000000000e1_dp*t49* & t245*t17 t250 = t149*t249 t260 = t178*t62*t237 t262 = pi*t56 t264 = t61*t262*t17 - t266 = 0.8999999998e1_dp*t260-0.5999999999e1_dp*t264 + t266 = 0.8999999998e1_dp*t260 - 0.5999999999e1_dp*t264 t267 = t266*t65 t268 = t58*t237 t271 = t195*t17 t274 = t68*t266 t275 = t274*t65 - t278 = t267-0.5555555558e-1_dp*t268*t71+0.3703703705e-1_dp*t192 & - *t271-0.5555555558e-1_dp*t192*t275 - t282 = (2*t147*t250)+0.1666666667e0_dp*t165*t166*t237 & - -0.1111111111e0_dp*t170*t171*t17+0.3333333334e0_dp*t55*t57 & + t278 = t267 - 0.5555555558e-1_dp*t268*t71 + 0.3703703705e-1_dp*t192 & + *t271 - 0.5555555558e-1_dp*t192*t275 + t282 = (2*t147*t250) + 0.1666666667e0_dp*t165*t166*t237 & + - 0.1111111111e0_dp*t170*t171*t17 + 0.3333333334e0_dp*t55*t57 & *t278 t283 = t46*t282 t289 = rho*t48*omega @@ -3400,7 +3400,7 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t352 = t114*t126*t132 t356 = ndrho*t219 t357 = t341*rho - t360 = 0.28e2_dp/0.3e1_dp*t122*t114-0.28e2_dp/0.3e1_dp*t356*t357 + t360 = 0.28e2_dp/0.3e1_dp*t122*t114 - 0.28e2_dp/0.3e1_dp*t356*t357 t362 = t27*t360*t132 t365 = t6*ndrho t366 = beta*t365 @@ -3408,19 +3408,19 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t368 = 0.1e1_dp/t367 t371 = 0.1e1_dp/t131/t130 t372 = t368*t126*t371 - t375 = 0.5600000000e2_dp*t24*t332*t31+0.3200000000e2_dp*t7*t336 & - -0.5600000000e2_dp*t339*t343-0.3200000000e2_dp*t307*t347- & - 0.8000000000e1_dp*t350*t352+0.60e1_dp*t119*t362+0.8000000000e1_dp & + t375 = 0.5600000000e2_dp*t24*t332*t31 + 0.3200000000e2_dp*t7*t336 & + - 0.5600000000e2_dp*t339*t343 - 0.3200000000e2_dp*t307*t347 - & + 0.8000000000e1_dp*t350*t352 + 0.60e1_dp*t119*t362 + 0.8000000000e1_dp & *t366*t372 t376 = t105*t375 - t379 = 0.5866666667e2_dp*t7*t299+0.160e2_dp*t302*t234-0.5866666667e2_dp & - *t307*t313-0.160e2_dp*t93*t318+0.5333333333e1_dp*t321 & - *t322+0.40e1_dp*t102*t329-0.20e1_dp*t102*t376 + t379 = 0.5866666667e2_dp*t7*t299 + 0.160e2_dp*t302*t234 - 0.5866666667e2_dp & + *t307*t313 - 0.160e2_dp*t93*t318 + 0.5333333333e1_dp*t321 & + *t322 + 0.40e1_dp*t102*t329 - 0.20e1_dp*t102*t376 t380 = t84*t379 t383 = t42*omega t384 = t45*t207 t387 = t384*t237 - t392 = 0.9000000000e1_dp*t260-0.6000000000e1_dp*t264 + t392 = 0.9000000000e1_dp*t260 - 0.6000000000e1_dp*t264 t393 = t392*t149 t394 = t393*t160 t398 = 0.1e1_dp/t41/t176 @@ -3431,9 +3431,9 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t406 = t68*t140 t413 = t25*t237 t417 = t194*rho - t424 = 0.2250000000e1_dp*t400*t401*t237-0.5000000000e0_dp*t405 & - *t406*t17-0.1500000000e1_dp*t151*t50*t379+0.1500000000e1_dp & - *t405*t156*t413+0.2000000000e1_dp*t155*t417*t225-0.3000000000e1_dp & + t424 = 0.2250000000e1_dp*t400*t401*t237 - 0.5000000000e0_dp*t405 & + *t406*t17 - 0.1500000000e1_dp*t151*t50*t379 + 0.1500000000e1_dp & + *t405*t156*t413 + 0.2000000000e1_dp*t155*t417*t225 - 0.3000000000e1_dp & *t49*t245*t25 t425 = t149*t424 t428 = omega*t150 @@ -3456,9 +3456,9 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t478 = t178*pi t479 = t56*t140 t489 = t27*rho - t496 = -0.1800000000e2_dp*t473*t474*t237+0.5999999999e1_dp*t478 & - *t479*t17+0.8999999998e1_dp*t178*t62*t379-0.1800000000e2_dp & - *t478*t183*t413-0.6000000000e1_dp*t182*t489*t225+0.1800000000e2_dp & + t496 = -0.1800000000e2_dp*t473*t474*t237 + 0.5999999999e1_dp*t478 & + *t479*t17 + 0.8999999998e1_dp*t178*t62*t379 - 0.1800000000e2_dp & + *t478*t183*t413 - 0.6000000000e1_dp*t182*t489*t225 + 0.1800000000e2_dp & *t61*t262*t25 t498 = t187*t266 t500 = t58*t379 @@ -3475,40 +3475,40 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t530 = t68*t496 t531 = t530*t65 t534 = t199*t267 - t537 = t496*t65+t498*t65-0.5555555558e-1_dp*t500*t71+0.3703703705e-1_dp & - *t503*t271-0.5555555558e-1_dp*t503*t275-0.1111111112e0_dp & - *t508*t196+0.1851851853e0_dp*t192*t512-0.1111111112e0_dp & - *t516*t517-0.1111111112e0_dp*t192*t520-0.5555555558e-1_dp & - *t508*t200+0.3703703705e-1_dp*t192*t527-0.5555555558e-1_dp & - *t192*t531-0.5555555558e-1_dp*t192*t534 - t541 = (2*t147*t394)+(2*t147*t425)-0.8333333335e-1_dp & - *t429*t166*t290-0.5555555557e-1_dp*t165*t171*t433+ & - 0.1666666667e0_dp*t165*t437*t140+0.1666666667e0_dp*t165*t166 & - *t379+0.1666666667e0_dp*t445*t446*t413-0.4444444445e0_dp*t170 & - *t450*t451+0.3333333334e0_dp*t170*t455*t172+0.3333333334e0_dp & - *t170*t171*t25+0.1666666667e0_dp*t165*t462*t237- & - 0.1111111111e0_dp*t170*t466*t17+0.3333333334e0_dp*t55*t57* & + t537 = t496*t65 + t498*t65 - 0.5555555558e-1_dp*t500*t71 + 0.3703703705e-1_dp & + *t503*t271 - 0.5555555558e-1_dp*t503*t275 - 0.1111111112e0_dp & + *t508*t196 + 0.1851851853e0_dp*t192*t512 - 0.1111111112e0_dp & + *t516*t517 - 0.1111111112e0_dp*t192*t520 - 0.5555555558e-1_dp & + *t508*t200 + 0.3703703705e-1_dp*t192*t527 - 0.5555555558e-1_dp & + *t192*t531 - 0.5555555558e-1_dp*t192*t534 + t541 = (2*t147*t394) + (2*t147*t425) - 0.8333333335e-1_dp & + *t429*t166*t290 - 0.5555555557e-1_dp*t165*t171*t433 + & + 0.1666666667e0_dp*t165*t437*t140 + 0.1666666667e0_dp*t165*t166 & + *t379 + 0.1666666667e0_dp*t445*t446*t413 - 0.4444444445e0_dp*t170 & + *t450*t451 + 0.3333333334e0_dp*t170*t455*t172 + 0.3333333334e0_dp & + *t170*t171*t25 + 0.1666666667e0_dp*t165*t462*t237 - & + 0.1111111111e0_dp*t170*t466*t17 + 0.3333333334e0_dp*t55*t57* & t537 - e_rho_spin(ii) = e_rho_spin(ii)+(-0.4444444448e0_dp*t214*t79-0.6666666672e0_dp*t217*t46 & - *t78*t237-0.4444444448e0_dp*t43*t283+t8*(-0.3333333336e0_dp & - *t55*t141-0.1666666668e0_dp*t289*t84*t290-0.3333333336e0_dp & - *t83*t295-0.3333333336e0_dp*t83*t380-0.2222222224e0_dp*t383 & - *t384-0.3333333336e0_dp*t83*t387-0.2222222224e0_dp*t144* & - t46*t541))*sx + e_rho_spin(ii) = e_rho_spin(ii) + (-0.4444444448e0_dp*t214*t79 - 0.6666666672e0_dp*t217*t46 & + *t78*t237 - 0.4444444448e0_dp*t43*t283 + t8*(-0.3333333336e0_dp & + *t55*t141 - 0.1666666668e0_dp*t289*t84*t290 - 0.3333333336e0_dp & + *t83*t295 - 0.3333333336e0_dp*t83*t380 - 0.2222222224e0_dp*t383 & + *t384 - 0.3333333336e0_dp*t83*t387 - 0.2222222224e0_dp*t144* & + t46*t541))*sx t550 = beta*t25 t551 = t27*t31 - t557 = 0.60e1_dp*t550*t551+0.60e1_dp*t24*t23*t132 + t557 = 0.60e1_dp*t550*t551 + 0.60e1_dp*t24*t23*t132 t558 = t105*t557 - t561 = 0.40e1_dp*t24*t37-0.20e1_dp*t102*t558 + t561 = 0.40e1_dp*t24*t37 - 0.20e1_dp*t102*t558 t566 = pi*t146 t567 = t566*t149 t569 = t151*t19*t561 t575 = t20*t561 t579 = t58*t561 - t585 = 0.8999999998e1_dp*t478*t575*t65-0.5555555558e-1_dp*t579 & - *t71-0.5000000001e0_dp*t60*t561*t65 - t589 = -0.3000000000e1_dp*t567*t569+0.1666666667e0_dp*t165*t166 & - *t561+0.3333333334e0_dp*t55*t57*t585 + t585 = 0.8999999998e1_dp*t478*t575*t65 - 0.5555555558e-1_dp*t579 & + *t71 - 0.5000000001e0_dp*t60*t561*t65 + t589 = -0.3000000000e1_dp*t567*t569 + 0.1666666667e0_dp*t165*t166 & + *t561 + 0.3333333334e0_dp*t55*t57*t585 t590 = t46*t589 t593 = t140*t561 t597 = t45*t589 @@ -3521,28 +3521,28 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t624 = beta*t11 t627 = t97*t132 t628 = t627*rho - t635 = -4*t108+4*t332*rho + t635 = -4*t108 + 4*t332*rho t637 = t27*t635*t132 t640 = 0.1e1_dp/t308 - t645 = -0.240e2_dp*beta*t107*t551-0.240e2_dp*t24*t87*t132+ & - 0.240e2_dp*t624*t116+0.240e2_dp*t605*t628+0.60e1_dp*t550*t133 & - +0.60e1_dp*t119*t637-0.60e1_dp*t7*t640*t126*t371 + t645 = -0.240e2_dp*beta*t107*t551 - 0.240e2_dp*t24*t87*t132 + & + 0.240e2_dp*t624*t116 + 0.240e2_dp*t605*t628 + 0.60e1_dp*t550*t133 & + + 0.60e1_dp*t119*t637 - 0.60e1_dp*t7*t640*t126*t371 t646 = t105*t645 - t649 = -0.320e2_dp*t24*t88+0.160e2_dp*t302*t558+0.320e2_dp*t605 & - *t99-0.160e2_dp*t93*t609-0.40e1_dp*t112*t137+0.40e1_dp*t102 & - *t615-0.20e1_dp*t102*t646 + t649 = -0.320e2_dp*t24*t88 + 0.160e2_dp*t302*t558 + 0.320e2_dp*t605 & + *t99 - 0.160e2_dp*t93*t609 - 0.40e1_dp*t112*t137 + 0.40e1_dp*t102 & + *t615 - 0.20e1_dp*t102*t646 t650 = t84*t649 t653 = t384*t561 t657 = t44*pi*t146 t658 = t657*t178 t668 = t25*t561 - t672 = 0.2250000000e1_dp*t400*t401*t561-0.1500000000e1_dp*t151 & - *t50*t649+0.1500000000e1_dp*t405*t156*t668 + t672 = 0.2250000000e1_dp*t400*t401*t561 - 0.1500000000e1_dp*t151 & + *t50*t649 + 0.1500000000e1_dp*t405*t156*t668 t673 = t149*t672 t679 = t56*t585 t689 = t27*t585 - t705 = -0.1800000000e2_dp*t473*t474*t561+0.8999999998e1_dp*t178 & - *t62*t649-0.1800000000e2_dp*t478*t183*t668 + t705 = -0.1800000000e2_dp*t473*t474*t561 + 0.8999999998e1_dp*t178 & + *t62*t649 - 0.1800000000e2_dp*t478*t183*t668 t707 = t187*t59 t708 = t707*t177 t709 = t561*t65 @@ -3555,19 +3555,19 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t728 = t68*t705 t729 = t728*t65 t732 = t60*t187 - t735 = t705*t65+0.8999999998e1_dp*t708*t710-0.5555555558e-1_dp & - *t713*t71-0.5000000001e0_dp*t716*t709-0.1111111112e0_dp*t719 & - *t196-0.1000000001e1_dp*t723*t709-0.5555555558e-1_dp*t719* & - t200-0.5555555558e-1_dp*t192*t729-0.5000000001e0_dp*t732*t709 - t739 = 0.1800000000e2_dp*t658*t575*t161+(2*t147*t673) & - -0.8333333335e-1_dp*t429*t166*t593+0.1666666667e0_dp*t165*t679 & - *t140+0.1666666667e0_dp*t165*t166*t649+0.1666666667e0_dp & - *t445*t446*t668+0.3333333334e0_dp*t170*t689*t172+0.1666666667e0_dp & - *t165*t462*t561+0.3333333334e0_dp*t55*t57*t735 - e_ndrho_spin(ii) = e_ndrho_spin(ii)+(-0.6666666672e0_dp*t217*t46*t78*t561-0.4444444448e0_dp & - *t43*t590+t8*(-0.1666666668e0_dp*t289*t84*t593-0.3333333336e0_dp & - *t83*t598-0.3333333336e0_dp*t83*t650-0.3333333336e0_dp & - *t83*t653-0.2222222224e0_dp*t144*t46*t739))*sx + t735 = t705*t65 + 0.8999999998e1_dp*t708*t710 - 0.5555555558e-1_dp & + *t713*t71 - 0.5000000001e0_dp*t716*t709 - 0.1111111112e0_dp*t719 & + *t196 - 0.1000000001e1_dp*t723*t709 - 0.5555555558e-1_dp*t719* & + t200 - 0.5555555558e-1_dp*t192*t729 - 0.5000000001e0_dp*t732*t709 + t739 = 0.1800000000e2_dp*t658*t575*t161 + (2*t147*t673) & + - 0.8333333335e-1_dp*t429*t166*t593 + 0.1666666667e0_dp*t165*t679 & + *t140 + 0.1666666667e0_dp*t165*t166*t649 + 0.1666666667e0_dp & + *t445*t446*t668 + 0.3333333334e0_dp*t170*t689*t172 + 0.1666666667e0_dp & + *t165*t462*t561 + 0.3333333334e0_dp*t55*t57*t735 + e_ndrho_spin(ii) = e_ndrho_spin(ii) + (-0.6666666672e0_dp*t217*t46*t78*t561 - 0.4444444448e0_dp & + *t43*t590 + t8*(-0.1666666668e0_dp*t289*t84*t593 - 0.3333333336e0_dp & + *t83*t598 - 0.3333333336e0_dp*t83*t650 - 0.3333333336e0_dp & + *t83*t653 - 0.2222222224e0_dp*t144*t46*t739))*sx END IF IF (grad_deriv >= 2 .OR. grad_deriv == -2) THEN @@ -3591,15 +3591,15 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t795 = 0.1e1_dp/t19/t790/t792 t796 = 0.1e1_dp/t787/t13*t795 t797 = t796*t371 - t800 = 0.1866666667e2_dp*t24*t777*t341*t31+0.4000000000e2_dp* & - t7*t782-0.1066666667e2_dp*t786*t797 + t800 = 0.1866666667e2_dp*t24*t777*t341*t31 + 0.4000000000e2_dp* & + t7*t782 - 0.1066666667e2_dp*t786*t797 t801 = t105*t800 - t804 = 0.1955555555e2_dp*t7*t766+0.1066666667e2_dp*t321*t769+ & - 0.40e1_dp*t102*t773-0.20e1_dp*t102*t801 + t804 = 0.1955555555e2_dp*t7*t766 + 0.1066666667e2_dp*t321*t769 + & + 0.40e1_dp*t102*t773 - 0.20e1_dp*t102*t801 t815 = t68*t237 t822 = t44*t194 - t826 = 0.2250000000e1_dp*t399*t50*t754-0.1000000000e1_dp*t405* & - t815*t17-0.1500000000e1_dp*t151*t50*t804-0.6666666667e0_dp & + t826 = 0.2250000000e1_dp*t399*t50*t754 - 0.1000000000e1_dp*t405* & + t815*t17 - 0.1500000000e1_dp*t151*t50*t804 - 0.6666666667e0_dp & *t49*t822*t14 t827 = t149*t826 t833 = t237*t17 @@ -3609,7 +3609,7 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t857 = t178*t62*t804 t859 = pi*t27 t862 = 0.2000000000e1_dp*t61*t859*t14 - t863 = -t851+t855+0.8999999998e1_dp*t857+t862 + t863 = -t851 + t855 + 0.8999999998e1_dp*t857 + t862 t864 = t863*t65 t865 = t266**2 t866 = t865*t65 @@ -3620,15 +3620,15 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t881 = t68*t863 t882 = t881*t65 t886 = t68*t865*t65 - t889 = t864+t866-0.5555555558e-1_dp*t867*t71+0.7407407410e-1_dp & - *t508*t271-0.1111111112e0_dp*t508*t275-0.6172839508e-1_dp* & - t192*t874+0.7407407410e-1_dp*t192*t878-0.5555555558e-1_dp*t192 & - *t882-0.5555555558e-1_dp*t192*t886 - t893 = (2*t147*t393*t249)+(2*t147*t827)-0.8333333335e-1_dp & - *t429*t166*t754-0.1111111111e0_dp*t165*t171*t833 & - +0.3333333334e0_dp*t165*t437*t237+0.1666666667e0_dp*t165 & - *t166*t804+0.1481481481e0_dp*t170*t450*t14-0.2222222222e0_dp & - *t170*t455*t17+0.3333333334e0_dp*t55*t57*t889 + t889 = t864 + t866 - 0.5555555558e-1_dp*t867*t71 + 0.7407407410e-1_dp & + *t508*t271 - 0.1111111112e0_dp*t508*t275 - 0.6172839508e-1_dp* & + t192*t874 + 0.7407407410e-1_dp*t192*t878 - 0.5555555558e-1_dp*t192 & + *t882 - 0.5555555558e-1_dp*t192*t886 + t893 = (2*t147*t393*t249) + (2*t147*t827) - 0.8333333335e-1_dp & + *t429*t166*t754 - 0.1111111111e0_dp*t165*t171*t833 & + + 0.3333333334e0_dp*t165*t437*t237 + 0.1666666667e0_dp*t165 & + *t166*t804 + 0.1481481481e0_dp*t170*t450*t14 - 0.2222222222e0_dp & + *t170*t455*t17 + 0.3333333334e0_dp*t55*t57*t889 t894 = t46*t893 t897 = t78*t140 t905 = rho*t150 @@ -3685,7 +3685,7 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t1034 = 0.1e1_dp/t1033 t1036 = t1034*t126*t371 t1040 = ndrho*t764 - t1044 = -0.280e3_dp/0.9e1_dp*t356*t341+0.280e3_dp/0.9e1_dp*t1040* & + t1044 = -0.280e3_dp/0.9e1_dp*t356*t341 + 0.280e3_dp/0.9e1_dp*t1040* & t1002*rho t1046 = t27*t1044*t132 t1050 = t368*t360*t371 @@ -3695,19 +3695,19 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t1058 = 0.1e1_dp/t131/t1056 t1059 = t126*t1058 t1060 = t1059*t220 - t1063 = -0.1866666667e3_dp*t24*t987*t31-0.2240000000e3_dp*t7* & - t991+0.4266666667e2_dp*t786*t997+0.1866666667e3_dp*t1000*t1004 & - +0.2240000000e3_dp*t941*t1008-0.4266666667e2_dp*t786*t1012 & - *t1021+0.1866666667e2_dp*t1024*t1026-0.1600000000e2_dp*t350 & - *t1030-0.5066666667e2_dp*t366*t1036+0.60e1_dp*t119*t1046+ & - 0.1600000000e2_dp*t366*t1050+0.3200000000e2_dp*t1055*t1060 + t1063 = -0.1866666667e3_dp*t24*t987*t31 - 0.2240000000e3_dp*t7* & + t991 + 0.4266666667e2_dp*t786*t997 + 0.1866666667e3_dp*t1000*t1004 & + + 0.2240000000e3_dp*t941*t1008 - 0.4266666667e2_dp*t786*t1012 & + *t1021 + 0.1866666667e2_dp*t1024*t1026 - 0.1600000000e2_dp*t350 & + *t1030 - 0.5066666667e2_dp*t366*t1036 + 0.60e1_dp*t119*t1046 + & + 0.1600000000e2_dp*t366*t1050 + 0.3200000000e2_dp*t1055*t1060 t1064 = t105*t1063 - t1067 = -0.2737777778e3_dp*t7*t930-0.1173333333e3_dp*t93*t769- & - 0.320e2_dp*t302*t773+0.160e2_dp*t302*t801+0.2737777778e3_dp* & - t941*t946+0.1173333333e3_dp*t307*t950+0.320e2_dp*t93*t955 & - -0.160e2_dp*t93*t959-0.1955555555e2_dp*t962*t963-0.2133333334e2_dp & - *t321*t966+0.1066666667e2_dp*t321*t969-0.120e2_dp*t102 & - *t976+0.80e1_dp*t102*t980+0.40e1_dp*t102*t984-0.20e1_dp*t102 & + t1067 = -0.2737777778e3_dp*t7*t930 - 0.1173333333e3_dp*t93*t769 - & + 0.320e2_dp*t302*t773 + 0.160e2_dp*t302*t801 + 0.2737777778e3_dp* & + t941*t946 + 0.1173333333e3_dp*t307*t950 + 0.320e2_dp*t93*t955 & + - 0.160e2_dp*t93*t959 - 0.1955555555e2_dp*t962*t963 - 0.2133333334e2_dp & + *t321*t966 + 0.1066666667e2_dp*t321*t969 - 0.120e2_dp*t102 & + *t976 + 0.80e1_dp*t102*t980 + 0.40e1_dp*t102*t984 - 0.20e1_dp*t102 & *t1064 t1068 = t84*t1067 t1071 = t45*t541 @@ -3741,22 +3741,22 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t1168 = t25*t754 t1172 = t225*t237 t1176 = t56*t25 - t1189 = 0.5400000000e2_dp*t1143*t474*t754-0.2400000000e2_dp*t473 & - *t479*t833-0.3600000000e2_dp*t473*t1150*t237-0.1800000000e2_dp & - *t473*t474*t804-0.2000000000e1_dp*t478*t1157*t14+ & - 0.1200000000e2_dp*t478*t1161*t17+0.8999999998e1_dp*t178*t62 & - *t1067+0.3600000000e2_dp*t473*t183*t1168+0.1200000000e2_dp* & - t478*t489*t1172-0.3600000000e2_dp*t478*t1176*t237-0.1800000000e2_dp & - *t478*t183*t1093+0.8000000000e1_dp*t182*t123* & - t777-0.1200000000e2_dp*t61*t859*t225 - t1191 = (t1097*t65)-0.4938271608e0_dp*t192*t1101-0.6172839508e-1_dp & - *t503*t874-0.1111111112e0_dp*t1106*t275+(t1109 & - *t65)+(2*t1111*t65)+0.3703703706e0_dp*t508*t512+ & - 0.7407407410e-1_dp*t503*t878+0.7407407410e-1_dp*t192*t1119-0.5555555558e-1_dp & - *t192*t1122-0.2222222224e0_dp*t192*t1126-0.1111111112e0_dp & - *t1129*t196-0.5555555558e-1_dp*t503*t882-0.1111111112e0_dp & - *t516*t1134-0.2222222224e0_dp*t1137*t517+(t1189 & - *t65) + t1189 = 0.5400000000e2_dp*t1143*t474*t754 - 0.2400000000e2_dp*t473 & + *t479*t833 - 0.3600000000e2_dp*t473*t1150*t237 - 0.1800000000e2_dp & + *t473*t474*t804 - 0.2000000000e1_dp*t478*t1157*t14 + & + 0.1200000000e2_dp*t478*t1161*t17 + 0.8999999998e1_dp*t178*t62 & + *t1067 + 0.3600000000e2_dp*t473*t183*t1168 + 0.1200000000e2_dp* & + t478*t489*t1172 - 0.3600000000e2_dp*t478*t1176*t237 - 0.1800000000e2_dp & + *t478*t183*t1093 + 0.8000000000e1_dp*t182*t123* & + t777 - 0.1200000000e2_dp*t61*t859*t225 + t1191 = (t1097*t65) - 0.4938271608e0_dp*t192*t1101 - 0.6172839508e-1_dp & + *t503*t874 - 0.1111111112e0_dp*t1106*t275 + (t1109 & + *t65) + (2*t1111*t65) + 0.3703703706e0_dp*t508*t512 + & + 0.7407407410e-1_dp*t503*t878 + 0.7407407410e-1_dp*t192*t1119 - 0.5555555558e-1_dp & + *t192*t1122 - 0.2222222224e0_dp*t192*t1126 - 0.1111111112e0_dp & + *t1129*t196 - 0.5555555558e-1_dp*t503*t882 - 0.1111111112e0_dp & + *t516*t1134 - 0.2222222224e0_dp*t1137*t517 + (t1189 & + *t65) t1192 = t67*t22 t1193 = t66*t1192 t1194 = t267*t451 @@ -3770,33 +3770,33 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t1221 = t498*t526 t1224 = t530*t267 t1235 = t199*t864 - t1238 = 0.3703703706e0_dp*t1193*t1194-0.5555555558e-1_dp*t503*t886 & - -0.6172839508e-1_dp*t192*t1201-0.5555555558e-1_dp*t1129*t200 & - -0.5555555558e-1_dp*t192*t1207-0.5555555558e-1_dp*t1210*t71 & - +0.3703703706e0_dp*t192*t1213-0.1111111112e0_dp*t516*t1216 & - -0.1111111112e0_dp*t508*t534+0.7407407410e-1_dp*t516*t1221- & - 0.1111111112e0_dp*t192*t1224+0.7407407410e-1_dp*t508*t527+0.7407407410e-1_dp & - *t1106*t271-0.1111111112e0_dp*t508*t531-0.2222222224e0_dp & - *t508*t520-0.5555555558e-1_dp*t192*t1235 - t1239 = t1191+t1238 + t1238 = 0.3703703706e0_dp*t1193*t1194 - 0.5555555558e-1_dp*t503*t886 & + - 0.6172839508e-1_dp*t192*t1201 - 0.5555555558e-1_dp*t1129*t200 & + - 0.5555555558e-1_dp*t192*t1207 - 0.5555555558e-1_dp*t1210*t71 & + + 0.3703703706e0_dp*t192*t1213 - 0.1111111112e0_dp*t516*t1216 & + - 0.1111111112e0_dp*t508*t534 + 0.7407407410e-1_dp*t516*t1221 - & + 0.1111111112e0_dp*t192*t1224 + 0.7407407410e-1_dp*t508*t527 + 0.7407407410e-1_dp & + *t1106*t271 - 0.1111111112e0_dp*t508*t531 - 0.2222222224e0_dp & + *t508*t520 - 0.5555555558e-1_dp*t192*t1235 + t1239 = t1191 + t1238 t1246 = t428*t444 t1247 = t74*t140 t1254 = t27*t889 t1264 = t27*t537 t1268 = t341*t74 t1275 = t56*t889 - t1283 = -t851+t855+0.9000000000e1_dp*t857+t862 + t1283 = -t851 + t855 + 0.9000000000e1_dp*t857 + t862 t1284 = t1283*t149 - t1288 = -0.1111111111e0_dp*t165*t171*t1085-0.8888888890e0_dp*t170 & - *t1089*t451+0.1666666667e0_dp*t445*t446*t1093+0.3333333334e0_dp & - *t55*t57*t1239-0.8333333335e-1_dp*t429*t462*t754 & - +0.5555555556e-1_dp*t1246*t1247*t833+(4*t147*t393* & - t424)+0.3333333334e0_dp*t170*t1254*t172-0.1111111111e0_dp*t165 & - *t466*t833+0.3333333334e0_dp*t165*t437*t379-0.2222222222e0_dp & - *t170*t1264*t17+0.1037037037e1_dp*t170*t1268*t1100 & - +0.1666666667e0_dp*t165*t166*t1067+0.1666666667e0_dp*t165* & - t1275*t140-0.8333333335e-1_dp*t1246*t446*t1168+(2* & - t147*t1284*t160) + t1288 = -0.1111111111e0_dp*t165*t171*t1085 - 0.8888888890e0_dp*t170 & + *t1089*t451 + 0.1666666667e0_dp*t445*t446*t1093 + 0.3333333334e0_dp & + *t55*t57*t1239 - 0.8333333335e-1_dp*t429*t462*t754 & + + 0.5555555556e-1_dp*t1246*t1247*t833 + (4*t147*t393* & + t424) + 0.3333333334e0_dp*t170*t1254*t172 - 0.1111111111e0_dp*t165 & + *t466*t833 + 0.3333333334e0_dp*t165*t437*t379 - 0.2222222222e0_dp & + *t170*t1264*t17 + 0.1037037037e1_dp*t170*t1268*t1100 & + + 0.1666666667e0_dp*t165*t166*t1067 + 0.1666666667e0_dp*t165* & + t1275*t140 - 0.8333333335e-1_dp*t1246*t446*t1168 + (2* & + t147*t1284*t160) t1292 = t278*rho t1300 = 0.1e1_dp/t41/t470 t1301 = t47*t1300 @@ -3806,14 +3806,14 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t1320 = t68*t379 t1333 = t68*t25 t1340 = t22*rho - t1347 = -0.5625000000e1_dp*t1302*t401*t754+0.1500000000e1_dp*t400 & - *t406*t833+0.4500000000e1_dp*t400*t1309*t237+0.2250000000e1_dp & - *t400*t401*t804+0.3333333333e0_dp*t405*t1316*t14 & - -0.1000000000e1_dp*t405*t1320*t17-0.1500000000e1_dp*t151*t50 & - *t1067-0.2250000000e1_dp*t400*t156*t1168-0.2000000000e1_dp & - *t405*t417*t1172+0.3000000000e1_dp*t405*t1333*t237+0.1500000000e1_dp & - *t405*t156*t1093-0.3333333333e1_dp*t155*t1340 & - *t777+0.4000000000e1_dp*t49*t822*t225 + t1347 = -0.5625000000e1_dp*t1302*t401*t754 + 0.1500000000e1_dp*t400 & + *t406*t833 + 0.4500000000e1_dp*t400*t1309*t237 + 0.2250000000e1_dp & + *t400*t401*t804 + 0.3333333333e0_dp*t405*t1316*t14 & + - 0.1000000000e1_dp*t405*t1320*t17 - 0.1500000000e1_dp*t151*t50 & + *t1067 - 0.2250000000e1_dp*t400*t156*t1168 - 0.2000000000e1_dp & + *t405*t417*t1172 + 0.3000000000e1_dp*t405*t1333*t237 + 0.1500000000e1_dp & + *t405*t156*t1093 - 0.3333333333e1_dp*t155*t1340 & + *t777 + 0.4000000000e1_dp*t49*t822*t225 t1348 = t149*t1347 t1360 = t140*t14 t1367 = omega*t398 @@ -3824,30 +3824,30 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t1387 = t392**2 t1388 = t1387*t149 t1392 = t56*t537 - t1396 = 0.6666666668e0_dp*t170*t455*t25+0.3333333334e0_dp*t445 & - *t1292*t413+0.1666666667e0_dp*t165*t462*t804+(2*t147 & - *t1348)-0.1111111111e0_dp*t165*t455*t433-0.8333333335e-1_dp & - *t429*t166*t918+0.3333333334e0_dp*t165*t171*t413+0.7407407409e-1_dp & - *t165*t450*t1360-0.1666666667e0_dp*t429*t437 & - *t290+0.1250000000e0_dp*t1368*t166*t907-0.4444444445e0_dp*t1373 & - *t446*t1172+0.1481481481e0_dp*t170*t1377*t14-0.8888888890e0_dp & - *t170*t450*t225-0.1666666667e0_dp*t429*t166*t914 & - +(2*t147*t1388*t160)+0.3333333334e0_dp*t165*t1392 & + t1396 = 0.6666666668e0_dp*t170*t455*t25 + 0.3333333334e0_dp*t445 & + *t1292*t413 + 0.1666666667e0_dp*t165*t462*t804 + (2*t147 & + *t1348) - 0.1111111111e0_dp*t165*t455*t433 - 0.8333333335e-1_dp & + *t429*t166*t918 + 0.3333333334e0_dp*t165*t171*t413 + 0.7407407409e-1_dp & + *t165*t450*t1360 - 0.1666666667e0_dp*t429*t437 & + *t290 + 0.1250000000e0_dp*t1368*t166*t907 - 0.4444444445e0_dp*t1373 & + *t446*t1172 + 0.1481481481e0_dp*t170*t1377*t14 - 0.8888888890e0_dp & + *t170*t450*t225 - 0.1666666667e0_dp*t429*t166*t914 & + + (2*t147*t1388*t160) + 0.3333333334e0_dp*t165*t1392 & *t237 - t1397 = t1288+t1396 - t1401 = -0.3333333336e0_dp*t165*t897*t237-0.6666666672e0_dp*t55 & - *t295-0.6666666672e0_dp*t55*t380+0.8333333340e-1_dp*t906*t84 & - *t907-0.3333333336e0_dp*t289*t294*t290-0.3333333336e0_dp* & - t289*t84*t914-0.1666666668e0_dp*t289*t84*t918-0.3333333336e0_dp & - *t83*t923-0.6666666672e0_dp*t83*t926-0.3333333336e0_dp & - *t83*t1068-0.4444444448e0_dp*t383*t1071-0.6666666672e0_dp* & - t55*t387-0.1666666668e0_dp*t289*t1076-0.6666666672e0_dp*t83 & - *t1079-0.3333333336e0_dp*t83*t1082-0.2222222224e0_dp*t144*t46 & + t1397 = t1288 + t1396 + t1401 = -0.3333333336e0_dp*t165*t897*t237 - 0.6666666672e0_dp*t55 & + *t295 - 0.6666666672e0_dp*t55*t380 + 0.8333333340e-1_dp*t906*t84 & + *t907 - 0.3333333336e0_dp*t289*t294*t290 - 0.3333333336e0_dp* & + t289*t84*t914 - 0.1666666668e0_dp*t289*t84*t918 - 0.3333333336e0_dp & + *t83*t923 - 0.6666666672e0_dp*t83*t926 - 0.3333333336e0_dp & + *t83*t1068 - 0.4444444448e0_dp*t383*t1071 - 0.6666666672e0_dp* & + t55*t387 - 0.1666666668e0_dp*t289*t1076 - 0.6666666672e0_dp*t83 & + *t1079 - 0.3333333336e0_dp*t83*t1082 - 0.2222222224e0_dp*t144*t46 & *t1397 - e_rho_rho_spin(ii) = e_rho_rho_spin(ii)+(-0.1333333334e1_dp*t747*t84*t237-0.8888888896e0_dp*t214 & - *t283-0.3333333336e0_dp*t753*t46*t78*t754-0.1333333334e1_dp & - *t217*t46*t282*t237-0.6666666672e0_dp*t217*t46*t78* & - t804-0.4444444448e0_dp*t43*t894+t8*t1401)*sx + e_rho_rho_spin(ii) = e_rho_rho_spin(ii) + (-0.1333333334e1_dp*t747*t84*t237 - 0.8888888896e0_dp*t214 & + *t283 - 0.3333333336e0_dp*t753*t46*t78*t754 - 0.1333333334e1_dp & + *t217*t46*t282*t237 - 0.6666666672e0_dp*t217*t46*t78* & + t804 - 0.4444444448e0_dp*t43*t894 + t8*t1401)*sx t1406 = 0.6666666672e0_dp*t747*t84*t561 t1408 = 0.4444444448e0_dp*t214*t590 t1409 = t4*t164 @@ -3863,18 +3863,18 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t1438 = 0.1e1_dp/t19/t1436 t1439 = 0.1e1_dp/t787/t16*t1438 t1440 = t1439*t371 - t1443 = -0.8000000000e1_dp*t1429*t115-0.2400000000e2_dp*t24*t230 & - +0.8000000000e1_dp*t366*t1440 + t1443 = -0.8000000000e1_dp*t1429*t115 - 0.2400000000e2_dp*t24*t230 & + + 0.8000000000e1_dp*t366*t1440 t1444 = t105*t1443 - t1447 = -0.1066666667e2_dp*t24*t221+0.5333333333e1_dp*t321*t1420 & - -0.40e1_dp*t112*t234+0.40e1_dp*t102*t1426-0.20e1_dp*t102* & + t1447 = -0.1066666667e2_dp*t24*t221 + 0.5333333333e1_dp*t321*t1420 & + - 0.40e1_dp*t112*t234 + 0.40e1_dp*t102*t1426 - 0.20e1_dp*t102* & t1444 t1451 = 0.6666666672e0_dp*t217*t46*t78*t1447 t1455 = 0.6666666672e0_dp*t217*t46*t282*t561 t1459 = t19*t237 t1466 = t68*t17 - t1470 = 0.2250000000e1_dp*t400*t1459*t561-0.1500000000e1_dp*t151 & - *t50*t1447-0.5000000000e0_dp*t405*t1466*t561 + t1470 = 0.2250000000e1_dp*t400*t1459*t561 - 0.1500000000e1_dp*t151 & + *t50*t1447 - 0.5000000000e0_dp*t405*t1466*t561 t1471 = t149*t1470 t1476 = 0.8333333335e-1_dp*t429*t166*t1410 t1479 = 0.1666666667e0_dp*t165*t679*t237 @@ -3888,7 +3888,7 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t1498 = t178*t62*t1447 t1500 = t56*t17 t1502 = t478*t1500*t561 - t1504 = -t1496+0.8999999998e1_dp*t1498+0.5999999999e1_dp*t1502 + t1504 = -t1496 + 0.8999999998e1_dp*t1498 + 0.5999999999e1_dp*t1502 t1505 = t1504*t65 t1506 = t266*t59 t1507 = t1506*t177 @@ -3904,11 +3904,11 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t1525 = t68*t1504*t65 t1528 = t60*t266 t1530 = 0.5000000001e0_dp*t1528*t709 - t1531 = t1505+t1509-t1512-t1515+t1517+0.3333333334e0_dp*t1519 & - *t709-t1523-0.5555555558e-1_dp*t192*t1525-t1530 - t1535 = 0.1800000000e2_dp*t658*t575*t250+(2*t147*t1471) & - -t1476+t1479+t1482-0.5555555555e-1_dp*t1485-t1489+t1492 & - +0.3333333334e0_dp*t55*t57*t1531 + t1531 = t1505 + t1509 - t1512 - t1515 + t1517 + 0.3333333334e0_dp*t1519 & + *t709 - t1523 - 0.5555555558e-1_dp*t192*t1525 - t1530 + t1535 = 0.1800000000e2_dp*t658*t575*t250 + (2*t147*t1471) & + - t1476 + t1479 + t1482 - 0.5555555555e-1_dp*t1485 - t1489 + t1492 & + + 0.3333333334e0_dp*t55*t57*t1531 t1536 = t46*t1535 t1541 = 0.1666666668e0_dp*t165*t897*t561 t1543 = 0.3333333336e0_dp*t55*t598 @@ -3983,7 +3983,7 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t1660 = 0.8000000000e1_dp*t350*t1658 t1662 = 0.3200000000e2_dp*t7*t372 t1664 = 0.60e1_dp*t550*t362 - t1667 = 0.28e2_dp/0.3e1_dp*t332-0.28e2_dp/0.3e1_dp*t987*rho + t1667 = 0.28e2_dp/0.3e1_dp*t332 - 0.28e2_dp/0.3e1_dp*t987*rho t1669 = t27*t1667*t132 t1671 = 0.60e1_dp*t119*t1669 t1675 = 0.60e1_dp*t7*t640*t360*t371 @@ -3991,13 +3991,13 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t1679 = 0.8000000000e1_dp*t366*t1677 t1680 = t786*t368 t1681 = t1059*t23 - t1684 = t1636+t1638-t1644-t1647-t1649+t1654-t1656-t1660 & - +t1662+t1664+t1671-t1675+t1679-0.2400000000e2_dp*t1680 & + t1684 = t1636 + t1638 - t1644 - t1647 - t1649 + t1654 - t1656 - t1660 & + + t1662 + t1664 + t1671 - t1675 + t1679 - 0.2400000000e2_dp*t1680 & *t1681 t1685 = t105*t1684 - t1688 = t1579-t1581+t1584-t1586+t1588-t1591+t1594-t1596 & - +t1601-t1605+t1607-t1610+t1613+t1615-t1620+t1624 & - +t1628-t1630+t1634-0.20e1_dp*t102*t1685 + t1688 = t1579 - t1581 + t1584 - t1586 + t1588 - t1591 + t1594 - t1596 & + + t1601 - t1605 + t1607 - t1610 + t1613 + t1615 - t1620 + t1624 & + + t1628 - t1630 + t1634 - 0.20e1_dp*t102*t1685 t1689 = t84*t1688 t1693 = 0.3333333336e0_dp*t55*t653 t1694 = t45*t739 @@ -4034,10 +4034,10 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t1754 = 0.5555555558e-1_dp*t1715*t275 t1755 = t1510*t67 t1757 = 0.1111111112e0_dp*t1755*t196 - t1758 = t1709*t65-t1714+t1717+t1719-t1724+t1728-t1730 & - -0.5555555558e-1_dp*t1731*t71+t1735+0.666666666e0_dp*t1519* & - t1737+t1743+0.3333333334e0_dp*t1519*t1745+0.3333333334e0_dp* & - t1748*t1722+t1752-t1754-t1757 + t1758 = t1709*t65 - t1714 + t1717 + t1719 - t1724 + t1728 - t1730 & + - 0.5555555558e-1_dp*t1731*t71 + t1735 + 0.666666666e0_dp*t1519* & + t1737 + t1743 + 0.3333333334e0_dp*t1519*t1745 + 0.3333333334e0_dp* & + t1748*t1722 + t1752 - t1754 - t1757 t1760 = 0.5555555558e-1_dp*t719*t534 t1762 = 0.5555555558e-1_dp*t1755*t200 t1763 = t237*t722 @@ -4075,15 +4075,15 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t1829 = t225*t561 t1832 = 0.6000000000e1_dp*t478*t489*t1829 t1835 = 0.1800000000e2_dp*t478*t1176*t561 - t1836 = t1800-t1804-t1807-t1810+t1814-t1817+0.8999999998e1_dp & - *t178*t62*t1688+t1824-t1828+t1832-t1835 + t1836 = t1800 - t1804 - t1807 - t1810 + t1814 - t1817 + 0.8999999998e1_dp & + *t178*t62*t1688 + t1824 - t1828 + t1832 - t1835 t1837 = t68*t1836 t1838 = t1837*t65 - t1842 = -t1760-t1762-t1765-t1768-0.5555555558e-1_dp*t192*t1769 & - -t1773-t1776-t1779-0.5555555558e-1_dp*t503*t1525-t1784 & - -t1787-t1789-0.1111111112e0_dp*t516*t1790-t1794+t1797 & - -0.5555555558e-1_dp*t192*t1838+t1836*t65 - t1843 = t1758+t1842 + t1842 = -t1760 - t1762 - t1765 - t1768 - 0.5555555558e-1_dp*t192*t1769 & + - t1773 - t1776 - t1779 - 0.5555555558e-1_dp*t503*t1525 - t1784 & + - t1787 - t1789 - 0.1111111112e0_dp*t516*t1790 - t1794 + t1797 & + - 0.5555555558e-1_dp*t192*t1838 + t1836*t65 + t1843 = t1758 + t1842 t1849 = 0.8333333335e-1_dp*t429*t166*t1571 t1852 = 0.8333333335e-1_dp*t429*t679*t290 t1854 = t165*t466*t1483 @@ -4097,7 +4097,7 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t1875 = t114*t585 t1878 = 0.4444444445e0_dp*t170*t1875*t451 t1881 = 0.1666666667e0_dp*t165*t437*t649 - t1884 = -t1496+0.9000000000e1_dp*t1498+0.6000000000e1_dp*t1502 + t1884 = -t1496 + 0.9000000000e1_dp*t1498 + 0.6000000000e1_dp*t1502 t1885 = t1884*t149 t1886 = t1885*t160 t1891 = 0.5625000000e1_dp*t1302*t401*t1410 @@ -4113,17 +4113,17 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t1917 = 0.1500000000e1_dp*t405*t156*t1825 t1920 = 0.1000000000e1_dp*t405*t417*t1829 t1923 = 0.1500000000e1_dp*t405*t1333*t561 - t1924 = -t1891+t1895+t1898+t1901-t1905+t1908-0.1500000000e1_dp & - *t151*t50*t1688-t1914+t1917-t1920+t1923 + t1924 = -t1891 + t1895 + t1898 + t1901 - t1905 + t1908 - 0.1500000000e1_dp & + *t151*t50*t1688 - t1914 + t1917 - t1920 + t1923 t1925 = t149*t1924 t1928 = t56*t1531 t1932 = t27*t1531 t1938 = 0.1666666667e0_dp*t165*t462*t1447 - t1939 = 0.3333333334e0_dp*t55*t57*t1843-t1849-t1852-0.5555555555e-1_dp & - *t1854+t1858+t1861+t1864-t1868+t1871+t1874 & - -t1878+t1881+(2*t147*t1886)+(2*t147*t1925) & - +0.1666666667e0_dp*t165*t1928*t140+0.3333333334e0_dp*t170*t1932 & - *t172+t1938 + t1939 = 0.3333333334e0_dp*t55*t57*t1843 - t1849 - t1852 - 0.5555555555e-1_dp & + *t1854 + t1858 + t1861 + t1864 - t1868 + t1871 + t1874 & + - t1878 + t1881 + (2*t147*t1886) + (2*t147*t1925) & + + 0.1666666667e0_dp*t165*t1928*t140 + 0.3333333334e0_dp*t170*t1932 & + *t172 + t1938 t1940 = t27*t735 t1943 = 0.1111111111e0_dp*t170*t1940*t17 t1946 = 0.1666666667e0_dp*t165*t1392*t561 @@ -4150,16 +4150,16 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t1994 = 0.8333333335e-1_dp*t429*t166*t1557 t1997 = 0.1666666667e0_dp*t165*t171*t668 t2000 = 0.8333333335e-1_dp*t429*t462*t1410 - t2001 = -t1943+t1946+0.1666666667e0_dp*t165*t166*t1688-t1952 & - -0.2222222222e0_dp*t1954-t1958+t1961+t1965+t1969+t1977 & - +t1980+t1984-t1987-t1991-t1994+t1997-t2000 - t2002 = t1939+t2001 - t2006 = -t1541-t1543-t1545+t1549-t1552-t1556-t1560-t1563 & - -0.3333333336e0_dp*t83*t1565-t1570-t1574-t1577-0.3333333336e0_dp & - *t83*t1689-t1693-t1696-t1699-t1702-t1705- & - t1708-0.2222222224e0_dp*t144*t46*t2002 - e_ndrho_rho_spin(ii) = e_ndrho_rho_spin(ii)+(-t1406-t1408-t1413-t1417-t1451-t1455-0.4444444448e0_dp & - *t43*t1536+t8*t2006)*sx + t2001 = -t1943 + t1946 + 0.1666666667e0_dp*t165*t166*t1688 - t1952 & + - 0.2222222222e0_dp*t1954 - t1958 + t1961 + t1965 + t1969 + t1977 & + + t1980 + t1984 - t1987 - t1991 - t1994 + t1997 - t2000 + t2002 = t1939 + t2001 + t2006 = -t1541 - t1543 - t1545 + t1549 - t1552 - t1556 - t1560 - t1563 & + - 0.3333333336e0_dp*t83*t1565 - t1570 - t1574 - t1577 - 0.3333333336e0_dp & + *t83*t1689 - t1693 - t1696 - t1699 - t1702 - t1705 - & + t1708 - 0.2222222224e0_dp*t144*t46*t2002 + e_ndrho_rho_spin(ii) = e_ndrho_rho_spin(ii) + (-t1406 - t1408 - t1413 - t1417 - t1451 - t1455 - 0.4444444448e0_dp & + *t43*t1536 + t8*t2006)*sx t2009 = t566*t393 t2013 = t566*t149*t47 t2014 = t398*t19 @@ -4170,66 +4170,66 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t2031 = t56*t561 t2032 = t2031*t526 t2035 = t20*t1447 - t2042 = -0.1800000000e2_dp*t473*t2028+0.5999999999e1_dp*t478*t2032 & - +0.8999999998e1_dp*t478*t2035*t65+t1509-t1512+t1517 & - -t1523+t1515-0.5000000001e0_dp*t60*t1447*t65-t1530 - t2046 = -0.3000000000e1_dp*t2009*t569+0.4500000000e1_dp*t2013*t2014 & - *t1410-0.1000000000e1_dp*t2013*t2018*t1483-0.3000000000e1_dp & - *t567*t151*t2022-t1476-0.5555555557e-1_dp*t1485+t1492 & - +t1482+t1479-t1489+0.3333333334e0_dp*t55*t57*t2042 + t2042 = -0.1800000000e2_dp*t473*t2028 + 0.5999999999e1_dp*t478*t2032 & + + 0.8999999998e1_dp*t478*t2035*t65 + t1509 - t1512 + t1517 & + - t1523 + t1515 - 0.5000000001e0_dp*t60*t1447*t65 - t1530 + t2046 = -0.3000000000e1_dp*t2009*t569 + 0.4500000000e1_dp*t2013*t2014 & + *t1410 - 0.1000000000e1_dp*t2013*t2018*t1483 - 0.3000000000e1_dp & + *t567*t151*t2022 - t1476 - 0.5555555557e-1_dp*t1485 + t1492 & + + t1482 + t1479 - t1489 + 0.3333333334e0_dp*t55*t57*t2042 t2050 = t45*t2046 t2054 = t786*t640 - t2057 = t1636+t1638-t1644-t1647-t1649+t1654-t1656+t1664 & - +t1662-t1660+t1671+t1679-t1675-0.240e2_dp*t2054*t1060 + t2057 = t1636 + t1638 - t1644 - t1647 - t1649 + t1654 - t1656 + t1664 & + + t1662 - t1660 + t1671 + t1679 - t1675 - 0.240e2_dp*t2054*t1060 t2058 = t105*t2057 - t2061 = t1579+t1584-t1581-t1586+t1588-t1591-t1596+t1594 & - +t1601-t1605+t1607+t1615-t1630-t1610-t1620+t1634 & - +t1628+t1613+t1624-0.20e1_dp*t102*t2058 - t2073 = -t1891+t1901+t1908+t1898+t1895-t1905-0.1500000000e1_dp & - *t151*t50*t2061-t1914-t1920+t1923+t1917 + t2061 = t1579 + t1584 - t1581 - t1586 + t1588 - t1591 - t1596 + t1594 & + + t1601 - t1605 + t1607 + t1615 - t1630 - t1610 - t1620 + t1634 & + + t1628 + t1613 + t1624 - 0.20e1_dp*t102*t2058 + t2073 = -t1891 + t1901 + t1908 + t1898 + t1895 - t1905 - 0.1500000000e1_dp & + *t151*t50*t2061 - t1914 - t1920 + t1923 + t1917 t2074 = t149*t2073 t2077 = t161*t17 t2081 = t657*t472 t2082 = t161*t237 - t2086 = -t1849-t1852-0.5555555557e-1_dp*t1854+t1858+t1861+ & - t1864-t1868+t1871+t1874+0.3333333334e0_dp*t170*t27*t2042 & - *t172-t1878+(2*t147*t2074)+t1881+t1938-t1943 & - +0.1200000000e2_dp*t658*t2031*t2077+t1946-0.3600000000e2_dp* & + t2086 = -t1849 - t1852 - 0.5555555557e-1_dp*t1854 + t1858 + t1861 + & + t1864 - t1868 + t1871 + t1874 + 0.3333333334e0_dp*t170*t27*t2042 & + *t172 - t1878 + (2*t147*t2074) + t1881 + t1938 - t1943 & + + 0.1200000000e2_dp*t658*t2031*t2077 + t1946 - 0.3600000000e2_dp* & t2081*t575*t2082 t2088 = t56*t2042 t2095 = t1447*t65 t2098 = t140*t471 t2099 = t709*t237 t2104 = t62*t2095 - t2107 = -t1714+t1717+t1719-t1724+t1728-0.5000000001e0_dp*t716 & - *t2095+0.1000000000e1_dp*t2098*t2099-0.1000000001e1_dp*t723 & - *t2095-t1730+t1735+t1743+0.8999999998e1_dp*t708*t2104 & - +t1752-t1754-t1757-t1760 + t2107 = -t1714 + t1717 + t1719 - t1724 + t1728 - 0.5000000001e0_dp*t716 & + *t2095 + 0.1000000000e1_dp*t2098*t2099 - 0.1000000001e1_dp*t723 & + *t2095 - t1730 + t1735 + t1743 + 0.8999999998e1_dp*t708*t2104 & + + t1752 - t1754 - t1757 - t1760 t2113 = t177*pi t2114 = t707*t2113 t2117 = t471*pi t2118 = t707*t2117 - t2124 = t1800-t1810-t1817-t1807-t1804+t1814+0.8999999998e1_dp & - *t178*t62*t2061+t1824+t1832-t1835-t1828 + t2124 = t1800 - t1810 - t1817 - t1807 - t1804 + t1814 + 0.8999999998e1_dp & + *t178*t62*t2061 + t1824 + t1832 - t1835 - t1828 t2126 = t68*t2124*t65 - t2130 = -0.5000000001e0_dp*t732*t2095-0.5555555558e-1_dp*t58*t2061 & - *t71-t1762+t1765+t1768+0.5999999999e1_dp*t2114*t2032 & - -t1773-t1776-0.1800000000e2_dp*t2118*t2028-0.5555555558e-1_dp & - *t192*t2126-t1779-t1784-t1787-t1789-t1794+t1797+ & + t2130 = -0.5000000001e0_dp*t732*t2095 - 0.5555555558e-1_dp*t58*t2061 & + *t71 - t1762 + t1765 + t1768 + 0.5999999999e1_dp*t2114*t2032 & + - t1773 - t1776 - 0.1800000000e2_dp*t2118*t2028 - 0.5555555558e-1_dp & + *t192*t2126 - t1779 - t1784 - t1787 - t1789 - t1794 + t1797 + & t2124*t65 - t2131 = t2107+t2130 - t2138 = -t1952-0.2222222223e0_dp*t1954-t1958+t1961+t1965+t1969 & - +t1977+t1980+0.1666666667e0_dp*t165*t2088*t140+0.1800000000e2_dp & - *t658*t2035*t161+0.3333333334e0_dp*t55*t57*t2131 & - +t1984+0.1666666667e0_dp*t165*t166*t2061-t1987-t1991 & - -t1994+t1997-t2000 - t2139 = t2086+t2138 - t2143 = -t1541+t1549-t1563-t1574-t1560-t1543-t1552-0.3333333336e0_dp & - *t83*t2050*t140-t1577-t1545-t1556-t1570 & - -0.3333333336e0_dp*t83*t84*t2061-t1693-t1699-t1708-t1705 & - -t1696-t1702-0.2222222224e0_dp*t144*t46*t2139 - e_ndrho_ndrho_spin(ii) = e_ndrho_ndrho_spin(ii)+(-t1406-t1413-t1455-t1451-t1408-t1417- & - 0.4444444448e0_dp*t43*t46*t2046+t8*t2143)*sx + t2131 = t2107 + t2130 + t2138 = -t1952 - 0.2222222223e0_dp*t1954 - t1958 + t1961 + t1965 + t1969 & + + t1977 + t1980 + 0.1666666667e0_dp*t165*t2088*t140 + 0.1800000000e2_dp & + *t658*t2035*t161 + 0.3333333334e0_dp*t55*t57*t2131 & + + t1984 + 0.1666666667e0_dp*t165*t166*t2061 - t1987 - t1991 & + - t1994 + t1997 - t2000 + t2139 = t2086 + t2138 + t2143 = -t1541 + t1549 - t1563 - t1574 - t1560 - t1543 - t1552 - 0.3333333336e0_dp & + *t83*t2050*t140 - t1577 - t1545 - t1556 - t1570 & + - 0.3333333336e0_dp*t83*t84*t2061 - t1693 - t1699 - t1708 - t1705 & + - t1696 - t1702 - 0.2222222224e0_dp*t144*t46*t2139 + e_ndrho_ndrho_spin(ii) = e_ndrho_ndrho_spin(ii) + (-t1406 - t1413 - t1455 - t1451 - t1408 - t1417 - & + 0.4444444448e0_dp*t43*t46*t2046 + t8*t2143)*sx t2147 = lambda*t48*omega t2160 = t754*t237 t2169 = t237*t804 @@ -4245,13 +4245,13 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t2204 = t10*t106 t2205 = 0.1e1_dp/t2204 t2220 = beta*t785*t6 - t2226 = -0.6222222223e2_dp*t24*t2205*t1002*t31-0.2115555556e3_dp & - *t7*t2183*t132+0.1315555556e3_dp*t786/t787/t85*t1019 & - *t371-0.4266666668e2_dp*t2220/t1014/t94*t1058 + t2226 = -0.6222222223e2_dp*t24*t2205*t1002*t31 - 0.2115555556e3_dp & + *t7*t2183*t132 + 0.1315555556e3_dp*t786/t787/t85*t1019 & + *t371 - 0.4266666668e2_dp*t2220/t1014/t94*t1058 t2227 = t105*t2226 - t2230 = -0.9125925923e2_dp*t7*t2183*t36-0.5866666667e2_dp*t962 & - *t2187-0.3200000001e2_dp*t321*t2190+0.1600000000e2_dp*t321* & - t2193-0.120e2_dp*t102*t2197+0.120e2_dp*t102*t2201-0.20e1_dp* & + t2230 = -0.9125925923e2_dp*t7*t2183*t36 - 0.5866666667e2_dp*t962 & + *t2187 - 0.3200000001e2_dp*t321*t2190 + 0.1600000000e2_dp*t321* & + t2193 - 0.120e2_dp*t102*t2197 + 0.120e2_dp*t102*t2201 - 0.20e1_dp* & t102*t2227 t2257 = 0.5400000000e2_dp*t1142*t62*t2160 t2261 = 0.3600000000e2_dp*t473*t56*t754*t17 @@ -4261,8 +4261,8 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t2274 = t178*t62*t2230 t2276 = pi*t114 t2279 = 0.2666666667e1_dp*t61*t2276*t86 - t2280 = t2257-t2261-t2264-t2268+t2272+0.8999999998e1_dp*t2274 & - -t2279 + t2280 = t2257 - t2261 - t2264 - t2268 + t2272 + 0.8999999998e1_dp*t2274 & + - t2279 t2281 = t2280*t65 t2282 = t881*t267 t2285 = t865*t266 @@ -4278,32 +4278,32 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t2311 = t194*t863 t2312 = t2311*t526 t2319 = t1099*t86 - t2326 = -0.1851851853e0_dp*t508*t874+t2281-0.1666666668e0_dp*t192 & - *t2282-0.5555555558e-1_dp*t192*t2287-0.1666666668e0_dp*t508 & - *t886+(3*t2292*t65)+t2295-0.5555555558e-1_dp*t2296 & - *t71+0.1111111112e0_dp*t192*t2300-0.5555555558e-1_dp*t192* & - t2304-0.1851851853e0_dp*t192*t2308+0.1111111112e0_dp*t192*t2312 & - +0.2222222223e0_dp*t508*t878-0.1666666668e0_dp*t508*t882 & - +0.1646090535e0_dp*t192*t2319-0.1666666668e0_dp*t1129*t275+ & + t2326 = -0.1851851853e0_dp*t508*t874 + t2281 - 0.1666666668e0_dp*t192 & + *t2282 - 0.5555555558e-1_dp*t192*t2287 - 0.1666666668e0_dp*t508 & + *t886 + (3*t2292*t65) + t2295 - 0.5555555558e-1_dp*t2296 & + *t71 + 0.1111111112e0_dp*t192*t2300 - 0.5555555558e-1_dp*t192* & + t2304 - 0.1851851853e0_dp*t192*t2308 + 0.1111111112e0_dp*t192*t2312 & + + 0.2222222223e0_dp*t508*t878 - 0.1666666668e0_dp*t508*t882 & + + 0.1646090535e0_dp*t192*t2319 - 0.1666666668e0_dp*t1129*t275 + & 0.1111111112e0_dp*t1129*t271 t2351 = t44*t22 t2368 = t237*t14 t2378 = t804*t17 t2382 = t754*t17 - t2392 = (2*t147*t1284*t249)+(2*t147*t1388*t249) & - -0.3456790122e0_dp*t170*t1268*t86+0.4444444444e0_dp*t170* & - t1089*t14+0.1666666667e0_dp*t165*t166*t2230+0.5000000001e0_dp & - *t165*t437*t804+0.3333333334e0_dp*t55*t57*t2326+0.2e1_dp & - *(t147)*t149*(-0.5625000000e1_dp*t1301*t50*t2160+ & - 0.2250000000e1_dp*t400*t68*t754*t17+0.6750000000e1_dp*t400* & - t1459*t804+0.1000000000e1_dp*t405*t194*t237*t14-0.1500000000e1_dp & - *t405*t68*t804*t17-0.1500000000e1_dp*t151*t50* & - t2230+0.1111111111e1_dp*t49*t2351*t86)-0.3333333333e0_dp*t170 & - *t1254*t17+(4*t147*t393*t826)+0.5000000001e0_dp* & - t165*t1275*t237+0.2222222222e0_dp*t165*t450*t2368-0.3333333333e0_dp & - *t165*t455*t833-0.2500000000e0_dp*t429*t166*t2169 & - -0.1666666667e0_dp*t165*t171*t2378+0.8333333333e-1_dp*t429 & - *t171*t2382-0.2500000000e0_dp*t429*t437*t754+0.1250000000e0_dp & + t2392 = (2*t147*t1284*t249) + (2*t147*t1388*t249) & + - 0.3456790122e0_dp*t170*t1268*t86 + 0.4444444444e0_dp*t170* & + t1089*t14 + 0.1666666667e0_dp*t165*t166*t2230 + 0.5000000001e0_dp & + *t165*t437*t804 + 0.3333333334e0_dp*t55*t57*t2326 + 0.2e1_dp & + *(t147)*t149*(-0.5625000000e1_dp*t1301*t50*t2160 + & + 0.2250000000e1_dp*t400*t68*t754*t17 + 0.6750000000e1_dp*t400* & + t1459*t804 + 0.1000000000e1_dp*t405*t194*t237*t14 - 0.1500000000e1_dp & + *t405*t68*t804*t17 - 0.1500000000e1_dp*t151*t50* & + t2230 + 0.1111111111e1_dp*t49*t2351*t86) - 0.3333333333e0_dp*t170 & + *t1254*t17 + (4*t147*t393*t826) + 0.5000000001e0_dp* & + t165*t1275*t237 + 0.2222222222e0_dp*t165*t450*t2368 - 0.3333333333e0_dp & + *t165*t455*t833 - 0.2500000000e0_dp*t429*t166*t2169 & + - 0.1666666667e0_dp*t165*t171*t2378 + 0.8333333333e-1_dp*t429 & + *t171*t2382 - 0.2500000000e0_dp*t429*t437*t754 + 0.1250000000e0_dp & *t1368*t166*t2160 t2404 = t45*t1397 t2418 = t379*t754 @@ -4318,217 +4318,217 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t2537 = t764*t1002 t2552 = t360*t1058 t2565 = t126/t131/t1056/t130 - t2569 = -0.8088888890e3_dp*t24*t2182*t2480*t31*rho-0.1518222222e4_dp & - *t2437*t2439*t132*rho+0.6542222223e3_dp*t786/t2204 & - /t19/t2492*t218*t371*rho-0.6222222223e2_dp*t24*t2205 & - *t1002*t126*t132+0.5600000000e2_dp*t1024*t341*t360 & - *t132+0.3288888889e3_dp*t366/t790*t126*t371-0.2400000000e2_dp & - *t350*t114*t1044*t132-0.1520000000e3_dp*t366*t1034* & - t360*t371-0.3626666667e3_dp*t1054*t1034*t1060+0.60e1_dp*t119 & - *t27*(0.3640e4_dp/0.27e2_dp*t1040*t1002-0.3640e4_dp/0.27e2_dp & - *ndrho*t2182*t2480*rho)*t132+0.8088888890e3_dp*t24*t2537 & - *t31+0.1518222222e4_dp*t7*t2451*t132-0.6542222223e3_dp* & - t786*t1012*t1019*t371+0.2400000000e2_dp*t366*t368*t1044 & - *t371+0.9600000000e2_dp*t1055*t2552*t220-0.1173333333e3_dp & - *t1055*t1059*t765+0.2133333333e3_dp*beta*t785*t365*t368 & + t2569 = -0.8088888890e3_dp*t24*t2182*t2480*t31*rho - 0.1518222222e4_dp & + *t2437*t2439*t132*rho + 0.6542222223e3_dp*t786/t2204 & + /t19/t2492*t218*t371*rho - 0.6222222223e2_dp*t24*t2205 & + *t1002*t126*t132 + 0.5600000000e2_dp*t1024*t341*t360 & + *t132 + 0.3288888889e3_dp*t366/t790*t126*t371 - 0.2400000000e2_dp & + *t350*t114*t1044*t132 - 0.1520000000e3_dp*t366*t1034* & + t360*t371 - 0.3626666667e3_dp*t1054*t1034*t1060 + 0.60e1_dp*t119 & + *t27*(0.3640e4_dp/0.27e2_dp*t1040*t1002 - 0.3640e4_dp/0.27e2_dp & + *ndrho*t2182*t2480*rho)*t132 + 0.8088888890e3_dp*t24*t2537 & + *t31 + 0.1518222222e4_dp*t7*t2451*t132 - 0.6542222223e3_dp* & + t786*t1012*t1019*t371 + 0.2400000000e2_dp*t366*t368*t1044 & + *t371 + 0.9600000000e2_dp*t1055*t2552*t220 - 0.1173333333e3_dp & + *t1055*t1059*t765 + 0.2133333333e3_dp*beta*t785*t365*t368 & *t2565*t796 - t2576 = 0.40e1_dp*t102*t327*t136*t2226+0.3519999999e3_dp*t93 & - *t2190-0.1551407408e4_dp*t2437*t2439*t36*rho+0.960e2_dp* & - t1597*t1598*t2200+0.120e2_dp*t102*t327*t375*t800+0.1551407408e4_dp & - *t7*t2451*t36-0.960e2_dp*t93*t2455*rho*t2196 & - +0.120e2_dp*t102*t327*t1063*t233+0.1600000000e2_dp*t321 & - *t316*t1063+0.9125925923e2_dp*t7*t2182*t2468*t136+0.1760000000e3_dp & - *t307*t949*t958-0.360e2_dp*t1616*t1617*t2200 & - -0.20e1_dp*t102*t105*t2569-0.6400000001e2_dp*t321*t953*t979 + t2576 = 0.40e1_dp*t102*t327*t136*t2226 + 0.3519999999e3_dp*t93 & + *t2190 - 0.1551407408e4_dp*t2437*t2439*t36*rho + 0.960e2_dp* & + t1597*t1598*t2200 + 0.120e2_dp*t102*t327*t375*t800 + 0.1551407408e4_dp & + *t7*t2451*t36 - 0.960e2_dp*t93*t2455*rho*t2196 & + + 0.120e2_dp*t102*t327*t1063*t233 + 0.1600000000e2_dp*t321 & + *t316*t1063 + 0.9125925923e2_dp*t7*t2182*t2468*t136 + 0.1760000000e3_dp & + *t307*t949*t958 - 0.360e2_dp*t1616*t1617*t2200 & + - 0.20e1_dp*t102*t105*t2569 - 0.6400000001e2_dp*t321*t953*t979 t2585 = 0.1e1_dp/t972/t35 t2611 = t311*t326 - t2621 = -0.3200000001e2_dp*t321*t953*t983-0.160e2_dp*t93*t316 & - *rho*t2226+0.480e2_dp*t102*t22*t2585*t136*t2196-0.1760000000e3_dp & - *t93*t2193+0.960e2_dp*t302*t2197+0.160e2_dp*t302 & - *t2227-0.960e2_dp*t302*t2201-0.8213333332e3_dp*t941*t2468 & - *t317+0.8213333332e3_dp*t307*t2187+0.9600000002e2_dp*t321* & - t2455*t975-0.360e2_dp*t102*t974*t375*t772-0.3519999999e3_dp & - *t307*t2611*t954+0.1173333334e3_dp*t962*t2611*t328- & + t2621 = -0.3200000001e2_dp*t321*t953*t983 - 0.160e2_dp*t93*t316 & + *rho*t2226 + 0.480e2_dp*t102*t22*t2585*t136*t2196 - 0.1760000000e3_dp & + *t93*t2193 + 0.960e2_dp*t302*t2197 + 0.160e2_dp*t302 & + *t2227 - 0.960e2_dp*t302*t2201 - 0.8213333332e3_dp*t941*t2468 & + *t317 + 0.8213333332e3_dp*t307*t2187 + 0.9600000002e2_dp*t321* & + t2455*t975 - 0.360e2_dp*t102*t974*t375*t772 - 0.3519999999e3_dp & + *t307*t2611*t954 + 0.1173333334e3_dp*t962*t2611*t328 - & 0.5866666667e2_dp*t962*t949*t375 - t2622 = t2576+t2621 + t2622 = t2576 + t2621 t2631 = t282*t140 - t2635 = -0.1000000001e1_dp*t55*t923-0.3333333336e0_dp*t83*t384 & - *t2230-0.5000000004e0_dp*t165*t897*t804-0.6666666672e0_dp*t383 & - *t2404-0.1000000001e1_dp*t83*t1071*t804-0.5000000004e0_dp & - *t164*t1076-0.1000000001e1_dp*t289*t294*t914-0.5000000004e0_dp & - *t289*t294*t918+0.2500000002e0_dp*t906*t84*t2418- & - 0.2000000001e1_dp*t55*t1079-0.5000000004e0_dp*t289*t84*t2424 & - +0.2500000002e0_dp*t1546*t897*t2169-0.3333333336e0_dp*t83* & - t84*t2622+0.2500000002e0_dp*t906*t294*t907-0.1000000001e1_dp & - *t55*t1082-0.1000000001e1_dp*t165*t2631*t237 + t2635 = -0.1000000001e1_dp*t55*t923 - 0.3333333336e0_dp*t83*t384 & + *t2230 - 0.5000000004e0_dp*t165*t897*t804 - 0.6666666672e0_dp*t383 & + *t2404 - 0.1000000001e1_dp*t83*t1071*t804 - 0.5000000004e0_dp & + *t164*t1076 - 0.1000000001e1_dp*t289*t294*t914 - 0.5000000004e0_dp & + *t289*t294*t918 + 0.2500000002e0_dp*t906*t84*t2418 - & + 0.2000000001e1_dp*t55*t1079 - 0.5000000004e0_dp*t289*t84*t2424 & + + 0.2500000002e0_dp*t1546*t897*t2169 - 0.3333333336e0_dp*t83* & + t84*t2622 + 0.2500000002e0_dp*t906*t294*t907 - 0.1000000001e1_dp & + *t55*t1082 - 0.1000000001e1_dp*t165*t2631*t237 t2636 = t78*t379 t2645 = t379*t804 t2655 = t140*t2230 t2707 = t74*t379 t2720 = t56*t1239 - t2724 = 0.5000000001e0_dp*t165*t1392*t804-0.1333333334e1_dp*t165 & - *t450*t1172-0.2666666667e1_dp*t170*t1089*t225+0.8333333333e-1_dp & - *t429*t466*t2382+0.1000000000e1_dp*t170*t1254*t25 & - +0.1666666667e0_dp*t165*t166*t2622+0.1666666667e0_dp*t165* & - t56*t2326*t140-0.2500000000e0_dp*t429*t166*t2424-0.3333333333e0_dp & - *t165*t455*t1085-0.1728395062e0_dp*t165*t1268* & - t140*t86-0.2500000000e0_dp*t1246*t446*t413*t804+0.1666666666e0_dp & - *t1246*t2707*t833+0.1250000000e0_dp*t1368*t462*t2160 & - -0.1666666667e0_dp*t165*t466*t2378+(6*t147*t1283 & - *t394)+0.5000000001e0_dp*t165*t2720*t237 + t2724 = 0.5000000001e0_dp*t165*t1392*t804 - 0.1333333334e1_dp*t165 & + *t450*t1172 - 0.2666666667e1_dp*t170*t1089*t225 + 0.8333333333e-1_dp & + *t429*t466*t2382 + 0.1000000000e1_dp*t170*t1254*t25 & + + 0.1666666667e0_dp*t165*t166*t2622 + 0.1666666667e0_dp*t165* & + t56*t2326*t140 - 0.2500000000e0_dp*t429*t166*t2424 - 0.3333333333e0_dp & + *t165*t455*t1085 - 0.1728395062e0_dp*t165*t1268* & + t140*t86 - 0.2500000000e0_dp*t1246*t446*t413*t804 + 0.1666666666e0_dp & + *t1246*t2707*t833 + 0.1250000000e0_dp*t1368*t462*t2160 & + - 0.1666666667e0_dp*t165*t466*t2378 + (6*t147*t1283 & + *t394) + 0.5000000001e0_dp*t165*t2720*t237 t2732 = rho*t2205 t2759 = t25*t2230 t2763 = t1367*t444 t2779 = t25*t2160 - t2783 = -0.2500000000e0_dp*t429*t1392*t754+(6*t147*t393 & - *t1347)-0.3456790123e1_dp*t170*t1002*t74*t2732+0.5000000001e0_dp & - *t165*t1275*t379-0.1333333334e1_dp*t170*t114*t889 & - *t451+0.3333333334e0_dp*t170*t27*t2326*t172-0.2500000000e0_dp & - *t429*t171*t1168+0.3750000000e0_dp*t1981*t1247*t2169 & - +0.5000000001e0_dp*t165*t171*t1093+0.8333333334e-1_dp*t1246 & - *t1247*t2378+0.1666666667e0_dp*t445*t446*t2759-0.1250000000e0_dp & - *t2763*t1247*t2382+0.5000000001e0_dp*t165*t437*t1067 & - +0.2222222222e0_dp*t165*t1089*t1360+0.1000000000e1_dp*t165 & - *t455*t413-0.2500000000e0_dp*t429*t462*t2169+0.1250000000e0_dp & + t2783 = -0.2500000000e0_dp*t429*t1392*t754 + (6*t147*t393 & + *t1347) - 0.3456790123e1_dp*t170*t1002*t74*t2732 + 0.5000000001e0_dp & + *t165*t1275*t379 - 0.1333333334e1_dp*t170*t114*t889 & + *t451 + 0.3333333334e0_dp*t170*t27*t2326*t172 - 0.2500000000e0_dp & + *t429*t171*t1168 + 0.3750000000e0_dp*t1981*t1247*t2169 & + + 0.5000000001e0_dp*t165*t171*t1093 + 0.8333333334e-1_dp*t1246 & + *t1247*t2378 + 0.1666666667e0_dp*t445*t446*t2759 - 0.1250000000e0_dp & + *t2763*t1247*t2382 + 0.5000000001e0_dp*t165*t437*t1067 & + + 0.2222222222e0_dp*t165*t1089*t1360 + 0.1000000000e1_dp*t165 & + *t455*t413 - 0.2500000000e0_dp*t429*t462*t2169 + 0.1250000000e0_dp & *t2763*t446*t2779 t2808 = t19*t1067 t2816 = t225*t754 t2821 = 0.1e1_dp/t41/t1140 t2823 = t47*t2821*t44 - t2833 = -0.1687500000e2_dp*t1302*t401*t2169+0.6750000000e1_dp*t400 & - *t1309*t804+0.4500000000e1_dp*t400*t1320*t833-0.1500000000e1_dp & - *t400*t1316*t2368+0.1000000000e1_dp*t405*t194*t379 & - *t14+0.8888888888e1_dp*t155*t97*rho*t2205+0.6750000000e1_dp & - *t400*t2808*t237-0.1500000000e1_dp*t405*t68*t1067 & - *t17+0.4500000000e1_dp*t400*t417*t2816+0.1968750000e2_dp*t2823 & - *t401*t2160+0.1500000000e1_dp*t405*t156*t2759+0.2250000000e1_dp & + t2833 = -0.1687500000e2_dp*t1302*t401*t2169 + 0.6750000000e1_dp*t400 & + *t1309*t804 + 0.4500000000e1_dp*t400*t1320*t833 - 0.1500000000e1_dp & + *t400*t1316*t2368 + 0.1000000000e1_dp*t405*t194*t379 & + *t14 + 0.8888888888e1_dp*t155*t97*rho*t2205 + 0.6750000000e1_dp & + *t400*t2808*t237 - 0.1500000000e1_dp*t405*t68*t1067 & + *t17 + 0.4500000000e1_dp*t400*t417*t2816 + 0.1968750000e2_dp*t2823 & + *t401*t2160 + 0.1500000000e1_dp*t405*t156*t2759 + 0.2250000000e1_dp & *t400*t401*t2230 t2843 = t777*t237 t2853 = t172*t2169 t2869 = t225*t804 t2873 = t194*t225 - t2877 = -0.1500000000e1_dp*t151*t50*t2622+0.5625000000e1_dp*t1302 & - *t156*t2779-0.6750000000e1_dp*t400*t1333*t754+0.4999999999e1_dp & - *t405*t1340*t2843-0.1000000000e2_dp*t49*t2351*t777 & - -0.5625000000e1_dp*t1302*t406*t2382-0.6750000000e1_dp*t1912 & - *t2853-0.5555555555e0_dp*t405*t22*t140*t86+0.4500000000e1_dp & - *t405*t1333*t804+0.2250000000e1_dp*t400*t406*t2378- & - 0.1687500000e2_dp*t1302*t1309*t754-0.3000000000e1_dp*t405*t417 & - *t2869-0.6000000000e1_dp*t405*t2873*t237 + t2877 = -0.1500000000e1_dp*t151*t50*t2622 + 0.5625000000e1_dp*t1302 & + *t156*t2779 - 0.6750000000e1_dp*t400*t1333*t754 + 0.4999999999e1_dp & + *t405*t1340*t2843 - 0.1000000000e2_dp*t49*t2351*t777 & + - 0.5625000000e1_dp*t1302*t406*t2382 - 0.6750000000e1_dp*t1912 & + *t2853 - 0.5555555555e0_dp*t405*t22*t140*t86 + 0.4500000000e1_dp & + *t405*t1333*t804 + 0.2250000000e1_dp*t400*t406*t2378 - & + 0.1687500000e2_dp*t1302*t1309*t754 - 0.3000000000e1_dp*t405*t417 & + *t2869 - 0.6000000000e1_dp*t405*t2873*t237 t2885 = t428*t1372 - t2935 = -0.2500000000e0_dp*t429*t166*t2645+(2*t147*t149 & - *(t2833+t2877))+0.5000000001e0_dp*t445*t1292*t1093+0.3333333333e0_dp & - *t2885*t446*t2816+0.2222222222e0_dp*t165*t1377 & - *t2368-0.3333333333e0_dp*t165*t1264*t833+0.2e1_dp*(t147) & - *(t2257-t2261-t2264-t2268+t2272+0.9000000000e1_dp*t2274 & - -t2279)*(t149)*t160-0.3333333333e0_dp*t170*t27*t1239 & - *t17-0.8333333335e-1_dp*t429*t166*t2655+(6*t147 & - *t1284*t424)+0.2e1_dp*(t147)*t1387*t392*(t149)* & - t160-0.2500000000e0_dp*t1246*t1292*t1168-0.1666666667e0_dp* & - t165*t1254*t433+(6*t147*t1388*t424)+0.1666666667e0_dp & - *t165*t462*t2230+0.2222222222e0_dp*t165*t450*t379*t14 & - -0.5000000001e0_dp*t429*t437*t914 + t2935 = -0.2500000000e0_dp*t429*t166*t2645 + (2*t147*t149 & + *(t2833 + t2877)) + 0.5000000001e0_dp*t445*t1292*t1093 + 0.3333333333e0_dp & + *t2885*t446*t2816 + 0.2222222222e0_dp*t165*t1377 & + *t2368 - 0.3333333333e0_dp*t165*t1264*t833 + 0.2e1_dp*(t147) & + *(t2257 - t2261 - t2264 - t2268 + t2272 + 0.9000000000e1_dp*t2274 & + - t2279)*(t149)*t160 - 0.3333333333e0_dp*t170*t27*t1239 & + *t17 - 0.8333333335e-1_dp*t429*t166*t2655 + (6*t147 & + *t1284*t424) + 0.2e1_dp*(t147)*t1387*t392*(t149)* & + t160 - 0.2500000000e0_dp*t1246*t1292*t1168 - 0.1666666667e0_dp* & + t165*t1254*t433 + (6*t147*t1388*t424) + 0.1666666667e0_dp & + *t165*t462*t2230 + 0.2222222222e0_dp*t165*t450*t379*t14 & + - 0.5000000001e0_dp*t429*t437*t914 t2937 = t164*t45*t341 t2992 = 0.1e1_dp/t1140/t40 t2994 = t59*t2992*pi t2998 = t27*t225 - t3026 = 0.1620000000e3_dp*t1143*t474*t2169+0.1080000000e3_dp*t1143 & - *t479*t2382-0.2160000000e3_dp*t2994*t474*t2160+0.3600000000e2_dp & - *t478*t2998*t237+0.1620000000e3_dp*t1143*t1150* & - t754+0.2666666667e1_dp*t478*t114*t140*t86-0.3600000000e2_dp & - *t473*t479*t2378+0.1080000000e3_dp*t1821*t2853-0.7200000000e2_dp & - *t473*t1161*t833-0.1800000000e2_dp*t473*t474*t2230 & - +0.8999999998e1_dp*t178*t62*t2622-0.5400000000e2_dp*t478* & + t3026 = 0.1620000000e3_dp*t1143*t474*t2169 + 0.1080000000e3_dp*t1143 & + *t479*t2382 - 0.2160000000e3_dp*t2994*t474*t2160 + 0.3600000000e2_dp & + *t478*t2998*t237 + 0.1620000000e3_dp*t1143*t1150* & + t754 + 0.2666666667e1_dp*t478*t114*t140*t86 - 0.3600000000e2_dp & + *t473*t479*t2378 + 0.1080000000e3_dp*t1821*t2853 - 0.7200000000e2_dp & + *t473*t1161*t833 - 0.1800000000e2_dp*t473*t474*t2230 & + + 0.8999999998e1_dp*t178*t62*t2622 - 0.5400000000e2_dp*t478* & t1176*t804 t3030 = t20*t1067 - t3069 = -0.1800000000e2_dp*t478*t183*t2759-0.5400000000e2_dp*t473 & - *t3030*t237-0.6000000000e1_dp*t478*t27*t379*t14-0.5400000000e2_dp & - *t473*t1150*t804+0.1800000000e2_dp*t478*t489* & - t2869+0.1080000000e3_dp*t473*t1176*t754+0.1800000000e2_dp*t478 & - *t56*t1067*t17-0.3600000000e2_dp*t473*t489*t2816-0.1866666667e2_dp & - *t182*t357*t2205+0.2400000000e2_dp*t61*t2276 & - *t777-0.2400000000e2_dp*t478*t123*t2843-0.1080000000e3_dp* & - t1143*t183*t2779+0.1200000000e2_dp*t473*t1157*t2368 - t3070 = t3026+t3069 + t3069 = -0.1800000000e2_dp*t478*t183*t2759 - 0.5400000000e2_dp*t473 & + *t3030*t237 - 0.6000000000e1_dp*t478*t27*t379*t14 - 0.5400000000e2_dp & + *t473*t1150*t804 + 0.1800000000e2_dp*t478*t489* & + t2869 + 0.1080000000e3_dp*t473*t1176*t754 + 0.1800000000e2_dp*t478 & + *t56*t1067*t17 - 0.3600000000e2_dp*t473*t489*t2816 - 0.1866666667e2_dp & + *t182*t357*t2205 + 0.2400000000e2_dp*t61*t2276 & + *t777 - 0.2400000000e2_dp*t478*t123*t2843 - 0.1080000000e3_dp* & + t1143*t183*t2779 + 0.1200000000e2_dp*t473*t1157*t2368 + t3070 = t3026 + t3069 t3085 = t1210*t67 - t3093 = (3*t496*t865*t65)+(3*t1189*t266*t65) & - +0.1111111112e1_dp*(t192)*(t2307)*(t65)*(t225) & - +(t187*t2280*t65)+(3*t496*t863*t65)+0.2222222223e0_dp & - *t516*t1111*t526+(t187*t2285*t65)+(t3070 & - *t65)-0.1851851853e0_dp*t1193*t498*t1200+0.2222222223e0_dp & - *t508*t1119+0.1111111112e0_dp*(t192)*t194*(t1189) & - *t526+0.2222222223e0_dp*t1137*t1221-0.1666666668e0_dp*t1129 & - *t534+0.1111111112e0_dp*t3085*t271-0.5555555558e-1_dp*(t192) & - *(t199)*(t2281)-0.1851851853e0_dp*t508*t1201 + t3093 = (3*t496*t865*t65) + (3*t1189*t266*t65) & + + 0.1111111112e1_dp*(t192)*(t2307)*(t65)*(t225) & + + (t187*t2280*t65) + (3*t496*t863*t65) + 0.2222222223e0_dp & + *t516*t1111*t526 + (t187*t2285*t65) + (t3070 & + *t65) - 0.1851851853e0_dp*t1193*t498*t1200 + 0.2222222223e0_dp & + *t508*t1119 + 0.1111111112e0_dp*(t192)*t194*(t1189) & + *t526 + 0.2222222223e0_dp*t1137*t1221 - 0.1666666668e0_dp*t1129 & + *t534 + 0.1111111112e0_dp*t3085*t271 - 0.5555555558e-1_dp*(t192) & + *(t199)*(t2281) - 0.1851851853e0_dp*t508*t1201 t3097 = t66*t69 t3098 = t1109*t267 t3129 = t2296*t67 - t3141 = -0.3333333336e0_dp*t192*t2299*t1125-0.1666666668e0_dp*t3097 & - *t3098+0.1111111112e0_dp*t503*t2300+0.1111111112e0_dp*t1129 & - *t527-0.1666666668e0_dp*t1129*t531-0.5555555558e-1_dp*t192 & - *t68*t3070*t65+0.1646090535e0_dp*t192*t97*t187*t65* & - t86+0.5555555559e0_dp*t1129*t512-0.1666666668e0_dp*t192*t530 & - *t864-0.1666666668e0_dp*t1106*t882-0.1666666668e0_dp*t192* & - t530*t866-0.1481481482e1_dp*t192*t1099*t777-0.1111111112e0_dp & - *t3129*t196+0.5555555559e0_dp*t1193*t866*t451-0.1666666668e0_dp & - *t503*t2282-0.1666666668e0_dp*t3085*t275+0.1111111112e0_dp & + t3141 = -0.3333333336e0_dp*t192*t2299*t1125 - 0.1666666668e0_dp*t3097 & + *t3098 + 0.1111111112e0_dp*t503*t2300 + 0.1111111112e0_dp*t1129 & + *t527 - 0.1666666668e0_dp*t1129*t531 - 0.5555555558e-1_dp*t192 & + *t68*t3070*t65 + 0.1646090535e0_dp*t192*t97*t187*t65* & + t86 + 0.5555555559e0_dp*t1129*t512 - 0.1666666668e0_dp*t192*t530 & + *t864 - 0.1666666668e0_dp*t1106*t882 - 0.1666666668e0_dp*t192* & + t530*t866 - 0.1481481482e1_dp*t192*t1099*t777 - 0.1111111112e0_dp & + *t3129*t196 + 0.5555555559e0_dp*t1193*t866*t451 - 0.1666666668e0_dp & + *t503*t2282 - 0.1666666668e0_dp*t3085*t275 + 0.1111111112e0_dp & *t503*t2312 - t3181 = -0.1851851853e0_dp*t1106*t874-0.1666666668e0_dp*t508*t1235 & - -0.3333333336e0_dp*t508*t1224-0.1111111112e0_dp*t516*t2281 & - *t172+0.1111111112e0_dp*t516*t1097*t526+0.2222222223e0_dp* & - t1106*t878-0.1851851853e0_dp*t503*t2308-0.3333333336e0_dp*t1137 & - *t1216+(3*t3098)+0.1111111112e0_dp*t516*t1109*t526 & - -0.5555555558e-1_dp*t503*t2287-0.3333333336e0_dp*t192*t2311 & - *t1125-0.6666666672e0_dp*t508*t1126+0.1646090535e0_dp*t503 & - *t2319-0.5555555558e-1_dp*t3129*t200-0.5555555558e-1_dp*t58 & - *t2622*t71-0.1666666668e0_dp*t1106*t886 - t3232 = -0.1666666668e0_dp*t192*t1206*t267-0.5555555558e-1_dp*t192 & - *t199*t2295-0.1666666668e0_dp*t508*t1122-0.3333333336e0_dp & - *t1129*t520-0.1111111112e0_dp*t516*t2295*t172-0.1481481482e1_dp & - *t66*t67*t97*t267*t1100-0.1851851853e0_dp*t192* & - t22*t496*t1200-0.3333333336e0_dp*t516*t2292*t65*rho* & - t25+0.1810699590e1_dp*t192*t311*t70*t2732-0.5555555558e-1_dp & - *t503*t2304-0.1481481482e1_dp*t508*t1101-0.3333333336e0_dp* & - t867*t515*t517+0.1111111112e1_dp*t268*t1192*t1194+0.5555555559e0_dp & - *t1193*t864*t451+0.1111111112e1_dp*t508*t1213- & - 0.1666666668e0_dp*t508*t1207-0.3333333336e0_dp*t1137*t1134 + t3181 = -0.1851851853e0_dp*t1106*t874 - 0.1666666668e0_dp*t508*t1235 & + - 0.3333333336e0_dp*t508*t1224 - 0.1111111112e0_dp*t516*t2281 & + *t172 + 0.1111111112e0_dp*t516*t1097*t526 + 0.2222222223e0_dp* & + t1106*t878 - 0.1851851853e0_dp*t503*t2308 - 0.3333333336e0_dp*t1137 & + *t1216 + (3*t3098) + 0.1111111112e0_dp*t516*t1109*t526 & + - 0.5555555558e-1_dp*t503*t2287 - 0.3333333336e0_dp*t192*t2311 & + *t1125 - 0.6666666672e0_dp*t508*t1126 + 0.1646090535e0_dp*t503 & + *t2319 - 0.5555555558e-1_dp*t3129*t200 - 0.5555555558e-1_dp*t58 & + *t2622*t71 - 0.1666666668e0_dp*t1106*t886 + t3232 = -0.1666666668e0_dp*t192*t1206*t267 - 0.5555555558e-1_dp*t192 & + *t199*t2295 - 0.1666666668e0_dp*t508*t1122 - 0.3333333336e0_dp & + *t1129*t520 - 0.1111111112e0_dp*t516*t2295*t172 - 0.1481481482e1_dp & + *t66*t67*t97*t267*t1100 - 0.1851851853e0_dp*t192* & + t22*t496*t1200 - 0.3333333336e0_dp*t516*t2292*t65*rho* & + t25 + 0.1810699590e1_dp*t192*t311*t70*t2732 - 0.5555555558e-1_dp & + *t503*t2304 - 0.1481481482e1_dp*t508*t1101 - 0.3333333336e0_dp* & + t867*t515*t517 + 0.1111111112e1_dp*t268*t1192*t1194 + 0.5555555559e0_dp & + *t1193*t864*t451 + 0.1111111112e1_dp*t508*t1213 - & + 0.1666666668e0_dp*t508*t1207 - 0.3333333336e0_dp*t1137*t1134 t3244 = t278*t140 t3248 = t889*rho t3262 = omega*t1300 t3264 = t140*t2160 - t3268 = 0.1555555556e1_dp*t2937*t446*t2843+0.3111111111e1_dp*t170 & - *t1268*t777-0.2500000000e0_dp*t429*t1275*t290-0.1333333334e1_dp & - *t1373*t1292*t1172+0.3111111111e1_dp*t170*t341*t278 & - *t1100-0.3456790122e0_dp*t170*t341*t203*t86+0.3750000000e0_dp & - *t1368*t166*t2418+0.4444444444e0_dp*t170*t114*t537 & - *t14+0.3333333334e0_dp*t55*t57*(t3093+t3141+t3181+t3232) & - -0.1111111111e0_dp*t2885*t1247*t2368-0.6666666668e0_dp*t1373 & - *t446*t2869+0.1666666667e0_dp*t1246*t3244*t833+0.5000000001e0_dp & - *t445*t3248*t413-0.1666666667e0_dp*t165*t171* & - t1067*t17-0.2500000000e0_dp*t429*t437*t918+0.3750000000e0_dp & - *t1368*t437*t907-0.3125000000e0_dp*t3262*t45*t166*t3264 + t3268 = 0.1555555556e1_dp*t2937*t446*t2843 + 0.3111111111e1_dp*t170 & + *t1268*t777 - 0.2500000000e0_dp*t429*t1275*t290 - 0.1333333334e1_dp & + *t1373*t1292*t1172 + 0.3111111111e1_dp*t170*t341*t278 & + *t1100 - 0.3456790122e0_dp*t170*t341*t203*t86 + 0.3750000000e0_dp & + *t1368*t166*t2418 + 0.4444444444e0_dp*t170*t114*t537 & + *t14 + 0.3333333334e0_dp*t55*t57*(t3093 + t3141 + t3181 + t3232) & + - 0.1111111111e0_dp*t2885*t1247*t2368 - 0.6666666668e0_dp*t1373 & + *t446*t2869 + 0.1666666667e0_dp*t1246*t3244*t833 + 0.5000000001e0_dp & + *t445*t3248*t413 - 0.1666666667e0_dp*t165*t171* & + t1067*t17 - 0.2500000000e0_dp*t429*t437*t918 + 0.3750000000e0_dp & + *t1368*t437*t907 - 0.3125000000e0_dp*t3262*t45*t166*t3264 t3278 = rho*t398 - t3288 = -0.1000000001e1_dp*t165*t2636*t237-0.2000000001e1_dp*t55 & - *t926-0.1000000001e1_dp*t83*t922*t379-0.5000000004e0_dp*t289 & - *t84*t2645+0.2500000002e0_dp*t429*t897*t754-0.1000000001e1_dp & - *t83*t294*t1067-0.1666666668e0_dp*t289*t84*t2655 & - -0.1000000001e1_dp*t83*t2404*t237-0.5000000004e0_dp*t289*t922 & - *t290-0.5000000004e0_dp*t289*t384*t2169-0.5000000004e0_dp & - *t289*t1071*t754-0.2222222224e0_dp*t144*t46*(t2724+t2783 & - +t2935+t3268)-0.3333333336e0_dp*t83*t45*t2392*t140- & - 0.1250000001e0_dp*t3278*omega*t84*t3264-0.1000000001e1_dp*t55 & - *t1068+0.8333333340e-1_dp*t906*t384*t2160 - t3291 = -0.1000000001e1_dp*t2147*t84*t754-0.4000000002e1_dp*t747 & - *t294*t237-0.2000000001e1_dp*t747*t84*t804-0.1333333334e1_dp & - *t214*t894+0.1666666668e0_dp*t4*t150*t46*t78*t2160 & - -0.1000000001e1_dp*t753*t46*t282*t754-0.1000000001e1_dp*t1409 & - *t84*t2169-0.2000000001e1_dp*t217*t46*t893*t237-0.2000000001e1_dp & - *t217*t46*t282*t804-0.6666666672e0_dp*t217* & - t46*t78*t2230-0.4444444448e0_dp*t43*t46*t2392+t8*(t2635 & - +t3288) + t3288 = -0.1000000001e1_dp*t165*t2636*t237 - 0.2000000001e1_dp*t55 & + *t926 - 0.1000000001e1_dp*t83*t922*t379 - 0.5000000004e0_dp*t289 & + *t84*t2645 + 0.2500000002e0_dp*t429*t897*t754 - 0.1000000001e1_dp & + *t83*t294*t1067 - 0.1666666668e0_dp*t289*t84*t2655 & + - 0.1000000001e1_dp*t83*t2404*t237 - 0.5000000004e0_dp*t289*t922 & + *t290 - 0.5000000004e0_dp*t289*t384*t2169 - 0.5000000004e0_dp & + *t289*t1071*t754 - 0.2222222224e0_dp*t144*t46*(t2724 + t2783 & + + t2935 + t3268) - 0.3333333336e0_dp*t83*t45*t2392*t140 - & + 0.1250000001e0_dp*t3278*omega*t84*t3264 - 0.1000000001e1_dp*t55 & + *t1068 + 0.8333333340e-1_dp*t906*t384*t2160 + t3291 = -0.1000000001e1_dp*t2147*t84*t754 - 0.4000000002e1_dp*t747 & + *t294*t237 - 0.2000000001e1_dp*t747*t84*t804 - 0.1333333334e1_dp & + *t214*t894 + 0.1666666668e0_dp*t4*t150*t46*t78*t2160 & + - 0.1000000001e1_dp*t753*t46*t282*t754 - 0.1000000001e1_dp*t1409 & + *t84*t2169 - 0.2000000001e1_dp*t217*t46*t893*t237 - 0.2000000001e1_dp & + *t217*t46*t282*t804 - 0.6666666672e0_dp*t217* & + t46*t78*t2230 - 0.4444444448e0_dp*t43*t46*t2392 + t8*(t2635 & + + t3288) END IF IF (grad_deriv >= 3 .OR. grad_deriv == -3) THEN - e_rho_rho_rho_spin(ii) = e_rho_rho_rho_spin(ii)+t3291*sx + e_rho_rho_rho_spin(ii) = e_rho_rho_rho_spin(ii) + t3291*sx t3305 = t4*t428 t3306 = t754*t561 t3314 = t237*t1447 @@ -4543,27 +4543,27 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t3362 = t800*t557 t3363 = t327*t3362 t3366 = beta*t777 - t3378 = 0.1866666667e2_dp*t3366*t342+0.9866666667e2_dp*t24*t782 & - -0.8266666668e2_dp*t366*t797+0.3200000001e2_dp*t1054/t1014/ & + t3378 = 0.1866666667e2_dp*t3366*t342 + 0.9866666667e2_dp*t24*t782 & + - 0.8266666668e2_dp*t366*t797 + 0.3200000001e2_dp*t1054/t1014/ & t12*t1058 t3379 = t105*t3378 - t3382 = 0.3911111110e2_dp*t24*t766-0.1955555555e2_dp*t962*t3339 & - +0.2133333334e2_dp*t339*t769-0.2133333334e2_dp*t321*t3344+ & - 0.1066666667e2_dp*t321*t3347+0.80e1_dp*t112*t773-0.120e2_dp*t102 & - *t3353+0.80e1_dp*t102*t3357-0.40e1_dp*t112*t801+0.40e1_dp & - *t102*t3363-0.20e1_dp*t102*t3379 + t3382 = 0.3911111110e2_dp*t24*t766 - 0.1955555555e2_dp*t962*t3339 & + + 0.2133333334e2_dp*t339*t769 - 0.2133333334e2_dp*t321*t3344 + & + 0.1066666667e2_dp*t321*t3347 + 0.80e1_dp*t112*t773 - 0.120e2_dp*t102 & + *t3353 + 0.80e1_dp*t102*t3357 - 0.40e1_dp*t112*t801 + 0.40e1_dp & + *t102*t3363 - 0.20e1_dp*t102*t3379 t3449 = t1447*t17 - t3453 = (2*t147*t1885*t249)+0.1800000000e2_dp*(t1971) & - *(t1972)*(t1973)*(t249)+(2*t147*t393 & - *t1470)+0.1800000000e2_dp*t658*t575*t827+0.2e1_dp*(t147) & - *t149*(-0.5625000000e1_dp*t1302*t19*t754*t561+0.4500000000e1_dp & - *t400*t1459*t1447+0.1500000000e1_dp*t400*t815*t1483 & - -0.1000000000e1_dp*t405*t68*t1447*t17+0.2250000000e1_dp* & - t400*t19*t804*t561-0.1500000000e1_dp*t151*t50*t3382+0.3333333334e0_dp & - *t405*t194*t14*t561)+0.1250000000e0_dp*t1368 & - *t166*t3306-0.8333333335e-1_dp*t429*t679*t754-0.1666666667e0_dp & - *t429*t166*t3314+0.5555555555e-1_dp*t1246*t74*t237 & - *t1483-0.1111111111e0_dp*t165*t689*t833-0.1111111111e0_dp* & + t3453 = (2*t147*t1885*t249) + 0.1800000000e2_dp*(t1971) & + *(t1972)*(t1973)*(t249) + (2*t147*t393 & + *t1470) + 0.1800000000e2_dp*t658*t575*t827 + 0.2e1_dp*(t147) & + *t149*(-0.5625000000e1_dp*t1302*t19*t754*t561 + 0.4500000000e1_dp & + *t400*t1459*t1447 + 0.1500000000e1_dp*t400*t815*t1483 & + - 0.1000000000e1_dp*t405*t68*t1447*t17 + 0.2250000000e1_dp* & + t400*t19*t804*t561 - 0.1500000000e1_dp*t151*t50*t3382 + 0.3333333334e0_dp & + *t405*t194*t14*t561) + 0.1250000000e0_dp*t1368 & + *t166*t3306 - 0.8333333335e-1_dp*t429*t679*t754 - 0.1666666667e0_dp & + *t429*t166*t3314 + 0.5555555555e-1_dp*t1246*t74*t237 & + *t1483 - 0.1111111111e0_dp*t165*t689*t833 - 0.1111111111e0_dp* & t165*t171*t3449 t3472 = t14*t561 t3491 = 0.5400000000e2_dp*t1143*t20*t754*t561 @@ -4573,16 +4573,16 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t3505 = 0.1800000000e2_dp*t473*t20*t804*t561 t3507 = t178*t62*t3382 t3512 = 0.2000000000e1_dp*t478*t27*t14*t561 - t3513 = t3491-t3494-t3497+t3501-t3505+0.8999999998e1_dp*t3507 & - -t3512 + t3513 = t3491 - t3494 - t3497 + t3501 - t3505 + 0.8999999998e1_dp*t3507 & + - t3512 t3514 = t3513*t65 t3525 = t58*t3382 t3533 = t237*t1518 - t3543 = t3514+0.8999999998e1_dp*t863*t59*t177*t710+(2 & - *t267*t1504)+0.8999999998e1_dp*t865*t59*t177*t710-0.5555555558e-1_dp & - *t3525*t71-0.5000000001e0_dp*t804*t177*t709+ & - 0.7407407410e-1_dp*t1755*t271+0.6666666668e0_dp*t3533*t1722- & - 0.1111111112e0_dp*t1755*t275-0.1111111112e0_dp*t508*t1525-0.1000000001e1_dp & + t3543 = t3514 + 0.8999999998e1_dp*t863*t59*t177*t710 + (2 & + *t267*t1504) + 0.8999999998e1_dp*t865*t59*t177*t710 - 0.5555555558e-1_dp & + *t3525*t71 - 0.5000000001e0_dp*t804*t177*t709 + & + 0.7407407410e-1_dp*t1755*t271 + 0.6666666668e0_dp*t3533*t1722 - & + 0.1111111112e0_dp*t1755*t275 - 0.1111111112e0_dp*t508*t1525 - 0.1000000001e1_dp & *t237*t266*t1722 t3546 = 0.1e1_dp/t12 t3547 = t60*t3546 @@ -4590,90 +4590,90 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t3553 = t3552*t526 t3561 = t68*t3513*t65 t3569 = t274*t1505 - t3575 = -0.6172839508e-1_dp*t719*t874-0.5555555556e0_dp*t3547*t709 & - +0.7407407410e-1_dp*t719*t878+0.7407407410e-1_dp*t192*t3553 & - +0.6666666668e0_dp*t1519*t1712-0.5555555558e-1_dp*t719*t882 & - -0.5555555558e-1_dp*t192*t3561-0.5000000001e0_dp*t60*t863* & - t709-0.5555555558e-1_dp*t719*t886-0.1111111112e0_dp*t192*t3569 & - -0.5000000001e0_dp*t60*t865*t709 - t3576 = t3543+t3575 - t3580 = -0.1666666667e0_dp*t429*t437*t1410+0.3333333334e0_dp*t165 & - *t1928*t237+0.3333333334e0_dp*t165*t437*t1447-0.8333333335e-1_dp & - *t429*t166*t3329+0.1666666667e0_dp*t165*t679*t804 & - +0.1666666667e0_dp*t165*t166*t3382+0.7407407405e-1_dp*t165 & - *t450*t3472+0.1481481481e0_dp*t170*t1875*t14-0.1111111111e0_dp & - *t165*t455*t1483-0.2222222222e0_dp*t170*t1932*t17+ & - 0.1666666667e0_dp*t165*t1275*t561+0.3333333334e0_dp*t55*t57 & + t3575 = -0.6172839508e-1_dp*t719*t874 - 0.5555555556e0_dp*t3547*t709 & + + 0.7407407410e-1_dp*t719*t878 + 0.7407407410e-1_dp*t192*t3553 & + + 0.6666666668e0_dp*t1519*t1712 - 0.5555555558e-1_dp*t719*t882 & + - 0.5555555558e-1_dp*t192*t3561 - 0.5000000001e0_dp*t60*t863* & + t709 - 0.5555555558e-1_dp*t719*t886 - 0.1111111112e0_dp*t192*t3569 & + - 0.5000000001e0_dp*t60*t865*t709 + t3576 = t3543 + t3575 + t3580 = -0.1666666667e0_dp*t429*t437*t1410 + 0.3333333334e0_dp*t165 & + *t1928*t237 + 0.3333333334e0_dp*t165*t437*t1447 - 0.8333333335e-1_dp & + *t429*t166*t3329 + 0.1666666667e0_dp*t165*t679*t804 & + + 0.1666666667e0_dp*t165*t166*t3382 + 0.7407407405e-1_dp*t165 & + *t450*t3472 + 0.1481481481e0_dp*t170*t1875*t14 - 0.1111111111e0_dp & + *t165*t455*t1483 - 0.2222222222e0_dp*t170*t1932*t17 + & + 0.1666666667e0_dp*t165*t1275*t561 + 0.3333333334e0_dp*t55*t57 & *t3576 - t3581 = t3453+t3580 + t3581 = t3453 + t3580 t3608 = t973*rho - t3618 = 0.640e2_dp*t1597*t1598*t3356-0.640e2_dp*t1582*t773- & - 0.1173333333e3_dp*t93*t3347-0.3911111110e2_dp*t1000*t963-0.320e2_dp & - *t605*t959+0.1173333333e3_dp*t307*t949*t1602+0.40e1_dp & - *t102*t327*t136*t3378-0.960e2_dp*t1597*t3608*t3352- & - 0.40e1_dp*t112*t1064+0.80e1_dp*t112*t984+0.2737777778e3_dp*t307 & + t3618 = 0.640e2_dp*t1597*t1598*t3356 - 0.640e2_dp*t1582*t773 - & + 0.1173333333e3_dp*t93*t3347 - 0.3911111110e2_dp*t1000*t963 - 0.320e2_dp & + *t605*t959 + 0.1173333333e3_dp*t307*t949*t1602 + 0.40e1_dp & + *t102*t327*t136*t3378 - 0.960e2_dp*t1597*t3608*t3352 - & + 0.40e1_dp*t112*t1064 + 0.80e1_dp*t112*t984 + 0.2737777778e3_dp*t307 & *t3339 t3668 = t2552*t23 t3673 = t635*t1058 t3674 = t3673*t220 - t3677 = -0.1866666667e3_dp*t1645*t342-0.6346666667e3_dp*t24*t991 & - +0.3946666667e3_dp*t366*t997+0.1866666667e3_dp*beta*t764* & - t1004+0.60e1_dp*t550*t1046+0.60e1_dp*t119*t27*(-0.280e3_dp/ & - 0.9e1_dp*t987+0.280e3_dp/0.9e1_dp*t2537*rho)*t132-0.60e1_dp*t7 & - *t640*t1044*t371+0.1600000000e2_dp*t366*t368*t1667*t371 & - -0.4800000000e2_dp*t1680*t3668+0.1600000000e3_dp*t1680*t1060 & - +0.3200000000e2_dp*t1055*t3674 + t3677 = -0.1866666667e3_dp*t1645*t342 - 0.6346666667e3_dp*t24*t991 & + + 0.3946666667e3_dp*t366*t997 + 0.1866666667e3_dp*beta*t764* & + t1004 + 0.60e1_dp*t550*t1046 + 0.60e1_dp*t119*t27*(-0.280e3_dp/ & + 0.9e1_dp*t987 + 0.280e3_dp/0.9e1_dp*t2537*rho)*t132 - 0.60e1_dp*t7 & + *t640*t1044*t371 + 0.1600000000e2_dp*t366*t368*t1667*t371 & + - 0.4800000000e2_dp*t1680*t3668 + 0.1600000000e3_dp*t1680*t1060 & + + 0.3200000000e2_dp*t1055*t3674 t3679 = t2565*t1439 t3682 = t24*t940 - t3711 = -0.1600000000e3_dp*t2220*t368*t3679+0.6346666667e3_dp*t3682 & - *t1008-0.3946666667e3_dp*t366*t1012*t1021+0.1866666667e2_dp & - *t3366*t1026+0.1866666667e2_dp*t1024*t341*t635*t132 & - -0.1706666667e3_dp*t7*t1036-0.1600000000e2_dp*t1429*t1030-0.1600000000e2_dp & - *t350*t114*t1667*t132+0.6400000000e2_dp*t7* & - t1050-0.5066666667e2_dp*t366*t1034*t635*t371+0.1520000000e3_dp & + t3711 = -0.1600000000e3_dp*t2220*t368*t3679 + 0.6346666667e3_dp*t3682 & + *t1008 - 0.3946666667e3_dp*t366*t1012*t1021 + 0.1866666667e2_dp & + *t3366*t1026 + 0.1866666667e2_dp*t1024*t341*t635*t132 & + - 0.1706666667e3_dp*t7*t1036 - 0.1600000000e2_dp*t1429*t1030 - 0.1600000000e2_dp & + *t350*t114*t1667*t132 + 0.6400000000e2_dp*t7* & + t1050 - 0.5066666667e2_dp*t366*t1034*t635*t371 + 0.1520000000e3_dp & *t786*t1034*t1681 - t3726 = -0.240e2_dp*t1616*t1617*t3356+0.160e2_dp*t302*t3379+ & - 0.40e1_dp*t102*t327*t1063*t557+0.960e2_dp*t302*t3353-0.320e2_dp & - *t302*t3363-0.2737777778e3_dp*t941*t2468*t608-0.120e2_dp & - *t102*t974*t645*t772-0.2133333334e2_dp*t321*t953*t1621 & - -0.20e1_dp*t102*t105*(t3677+t3711)+0.80e1_dp*t102*t327 & - *t375*t1443-0.120e2_dp*t1616*t1617*t3362-0.2133333334e2_dp & + t3726 = -0.240e2_dp*t1616*t1617*t3356 + 0.160e2_dp*t302*t3379 + & + 0.40e1_dp*t102*t327*t1063*t557 + 0.960e2_dp*t302*t3353 - 0.320e2_dp & + *t302*t3363 - 0.2737777778e3_dp*t941*t2468*t608 - 0.120e2_dp & + *t102*t974*t645*t772 - 0.2133333334e2_dp*t321*t953*t1621 & + - 0.20e1_dp*t102*t105*(t3677 + t3711) + 0.80e1_dp*t102*t327 & + *t375*t1443 - 0.120e2_dp*t1616*t1617*t3362 - 0.2133333334e2_dp & *t321*t953*t1625 t3750 = t2585*t136 - t3763 = 0.2346666666e3_dp*t1589*t950+0.80e1_dp*t102*t327*t1684 & - *t233+0.6400000002e2_dp*t7*t220*t1618-0.240e2_dp*t112*t976 & - -0.160e2_dp*t93*t316*rho*t3378+0.2346666666e3_dp*t93* & - t3344+0.3911111110e2_dp*t962*t2611*t614-0.5475555556e3_dp*t24 & - *t930+0.480e2_dp*t1616*t3750*t3352-0.1955555555e2_dp*t962 & - *t949*t645-0.240e2_dp*t1616*t973*t375*t1425+0.2133333334e2_dp & + t3763 = 0.2346666666e3_dp*t1589*t950 + 0.80e1_dp*t102*t327*t1684 & + *t233 + 0.6400000002e2_dp*t7*t220*t1618 - 0.240e2_dp*t112*t976 & + - 0.160e2_dp*t93*t316*rho*t3378 + 0.2346666666e3_dp*t93* & + t3344 + 0.3911111110e2_dp*t962*t2611*t614 - 0.5475555556e3_dp*t24 & + *t930 + 0.480e2_dp*t1616*t3750*t3352 - 0.1955555555e2_dp*t962 & + *t949*t645 - 0.240e2_dp*t1616*t973*t375*t1425 + 0.2133333334e2_dp & *t339*t969 - t3794 = -0.640e2_dp*t302*t3357-0.4266666668e2_dp*t339*t966+0.640e2_dp & - *t605*t955+0.40e1_dp*t102*t327*t645*t800+0.5475555556e3_dp & - *t3682*t946+0.1066666667e2_dp*t321*t316*t1684+0.160e2_dp & - *t112*t980-0.2346666666e3_dp*t7*t929*t1599+0.320e2_dp & - *t1597*t1598*t3362-0.2346666666e3_dp*t605*t769+0.320e2_dp & - *t1582*t801-0.2133333334e2_dp*t321*t953*t1631 - t3796 = t3618+t3726+t3763+t3794 - t3826 = 0.8333333340e-1_dp*t906*t597*t907+0.1666666668e0_dp*t429 & - *t1547-0.3333333336e0_dp*t83*t84*t3796-0.3333333336e0_dp* & - t83*t922*t649-0.3333333336e0_dp*t289*t294*t1571-0.3333333336e0_dp & - *t289*t1071*t1410-0.6666666672e0_dp*t83*t1564*t379 & - -0.6666666672e0_dp*t55*t1700-0.3333333336e0_dp*t165*t207* & - t237*t561-0.6666666672e0_dp*t55*t1689-0.3333333336e0_dp*t83 & - *t1694*t804+0.1666666668e0_dp*t1546*t897*t3314 + t3794 = -0.640e2_dp*t302*t3357 - 0.4266666668e2_dp*t339*t966 + 0.640e2_dp & + *t605*t955 + 0.40e1_dp*t102*t327*t645*t800 + 0.5475555556e3_dp & + *t3682*t946 + 0.1066666667e2_dp*t321*t316*t1684 + 0.160e2_dp & + *t112*t980 - 0.2346666666e3_dp*t7*t929*t1599 + 0.320e2_dp & + *t1597*t1598*t3362 - 0.2346666666e3_dp*t605*t769 + 0.320e2_dp & + *t1582*t801 - 0.2133333334e2_dp*t321*t953*t1631 + t3796 = t3618 + t3726 + t3763 + t3794 + t3826 = 0.8333333340e-1_dp*t906*t597*t907 + 0.1666666668e0_dp*t429 & + *t1547 - 0.3333333336e0_dp*t83*t84*t3796 - 0.3333333336e0_dp* & + t83*t922*t649 - 0.3333333336e0_dp*t289*t294*t1571 - 0.3333333336e0_dp & + *t289*t1071*t1410 - 0.6666666672e0_dp*t83*t1564*t379 & + - 0.6666666672e0_dp*t55*t1700 - 0.3333333336e0_dp*t165*t207* & + t237*t561 - 0.6666666672e0_dp*t55*t1689 - 0.3333333336e0_dp*t83 & + *t1694*t804 + 0.1666666668e0_dp*t1546*t897*t3314 t3827 = t649*t804 t3842 = t3278*t46 t3849 = t140*t3382 t3853 = t649*t754 t3861 = t78*t649 t3865 = t589*t140 - t3869 = -0.1666666668e0_dp*t289*t84*t3827-0.1666666668e0_dp*t289 & - *t922*t593+0.1666666668e0_dp*t1546*t2636*t1410-0.6666666672e0_dp & - *t55*t1703-0.3333333336e0_dp*t83*t597*t1067-0.1250000001e0_dp & - *t3842*t897*t3306-0.3333333336e0_dp*t83*t384* & - t3382-0.1666666668e0_dp*t289*t84*t3849+0.8333333340e-1_dp*t906 & - *t84*t3853-0.6666666672e0_dp*t55*t1568-0.6666666672e0_dp* & - t55*t1565-0.3333333336e0_dp*t165*t3861*t237-0.3333333336e0_dp & + t3869 = -0.1666666668e0_dp*t289*t84*t3827 - 0.1666666668e0_dp*t289 & + *t922*t593 + 0.1666666668e0_dp*t1546*t2636*t1410 - 0.6666666672e0_dp & + *t55*t1703 - 0.3333333336e0_dp*t83*t597*t1067 - 0.1250000001e0_dp & + *t3842*t897*t3306 - 0.3333333336e0_dp*t83*t384* & + t3382 - 0.1666666668e0_dp*t289*t84*t3849 + 0.8333333340e-1_dp*t906 & + *t84*t3853 - 0.6666666672e0_dp*t55*t1568 - 0.6666666672e0_dp* & + t55*t1565 - 0.3333333336e0_dp*t165*t3861*t237 - 0.3333333336e0_dp & *t165*t3865*t237 t3871 = t379*t1447 t3875 = t45*t2002 @@ -4683,204 +4683,204 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t3933 = t451*t1410 t3939 = t1301*t245 t3940 = t172*t3306 - t3965 = 0.1500000000e1_dp*t405*t156*t3918+0.1968750000e2_dp*t2823 & - *t401*t3306+0.1666666666e1_dp*t405*t1340*t3925+0.3000000000e1_dp & - *t405*t1333*t1447+0.3000000000e1_dp*t399*t822*t3933 & - +0.2250000000e1_dp*t400*t401*t3382+0.5625000000e1_dp*t3939 & - *t3940+0.3333333333e0_dp*t405*t194*t649*t14-0.1125000000e2_dp & - *t1302*t1309*t1410+0.2250000000e1_dp*t400*t1892*t804 & - -0.5625000000e1_dp*t1302*t401*t3329-0.5625000000e1_dp*t1302 & - *t1892*t754+0.2250000000e1_dp*t400*t2808*t561-0.4500000000e1_dp & + t3965 = 0.1500000000e1_dp*t405*t156*t3918 + 0.1968750000e2_dp*t2823 & + *t401*t3306 + 0.1666666666e1_dp*t405*t1340*t3925 + 0.3000000000e1_dp & + *t405*t1333*t1447 + 0.3000000000e1_dp*t399*t822*t3933 & + + 0.2250000000e1_dp*t400*t401*t3382 + 0.5625000000e1_dp*t3939 & + *t3940 + 0.3333333333e0_dp*t405*t194*t649*t14 - 0.1125000000e2_dp & + *t1302*t1309*t1410 + 0.2250000000e1_dp*t400*t1892*t804 & + - 0.5625000000e1_dp*t1302*t401*t3329 - 0.5625000000e1_dp*t1302 & + *t1892*t754 + 0.2250000000e1_dp*t400*t2808*t561 - 0.4500000000e1_dp & *t400*t1333*t1410 t3969 = t172*t3314 t3975 = t19*t1688 t3979 = t290*t1483 t3985 = t172*t3329 - t4010 = -0.1125000000e2_dp*t1302*t401*t3314-0.4500000000e1_dp*t1912 & - *t3969+0.4500000000e1_dp*t400*t1309*t1447+0.4500000000e1_dp & - *t400*t3975*t237-0.3750000000e1_dp*t3939*t3979-0.2000000000e1_dp & - *t405*t417*t3892-0.2250000000e1_dp*t1912*t3985- & - 0.2000000000e1_dp*t405*t2873*t561-0.5000000000e0_dp*t400*t1316 & - *t3472-0.1000000000e1_dp*t405*t68*t1688*t17+0.1500000000e1_dp & - *t400*t406*t3449-0.1500000000e1_dp*t151*t50*t3796 & - +0.1500000000e1_dp*t400*t1902*t833+0.1500000000e1_dp*t400* & + t4010 = -0.1125000000e2_dp*t1302*t401*t3314 - 0.4500000000e1_dp*t1912 & + *t3969 + 0.4500000000e1_dp*t400*t1309*t1447 + 0.4500000000e1_dp & + *t400*t3975*t237 - 0.3750000000e1_dp*t3939*t3979 - 0.2000000000e1_dp & + *t405*t417*t3892 - 0.2250000000e1_dp*t1912*t3985 - & + 0.2000000000e1_dp*t405*t2873*t561 - 0.5000000000e0_dp*t400*t1316 & + *t3472 - 0.1000000000e1_dp*t405*t68*t1688*t17 + 0.1500000000e1_dp & + *t400*t406*t3449 - 0.1500000000e1_dp*t151*t50*t3796 & + + 0.1500000000e1_dp*t400*t1902*t833 + 0.1500000000e1_dp*t400* & t1320*t1483 - t4018 = 0.2222222222e0_dp*t2885*t446*t1172*t561-0.1666666667e0_dp & - *t1246*t1292*t1865-0.4444444445e0_dp*t1373*t446*t3892 & - -0.1111111111e0_dp*t165*t171*t1688*t17+0.1666666667e0_dp*t165 & - *t56*t3576*t140+0.1250000000e0_dp*t2763*t446*t1168* & - t561+0.3333333334e0_dp*t165*t689*t413+0.1666666667e0_dp*t165 & - *t679*t1067-0.1666666667e0_dp*t1246*t446*t413*t1447+ & - (2*t147*t149*(t3965+t4010))-0.4444444445e0_dp*t1373* & + t4018 = 0.2222222222e0_dp*t2885*t446*t1172*t561 - 0.1666666667e0_dp & + *t1246*t1292*t1865 - 0.4444444445e0_dp*t1373*t446*t3892 & + - 0.1111111111e0_dp*t165*t171*t1688*t17 + 0.1666666667e0_dp*t165 & + *t56*t3576*t140 + 0.1250000000e0_dp*t2763*t446*t1168* & + t561 + 0.3333333334e0_dp*t165*t689*t413 + 0.1666666667e0_dp*t165 & + *t679*t1067 - 0.1666666667e0_dp*t1246*t446*t413*t1447 + & + (2*t147*t149*(t3965 + t4010)) - 0.4444444445e0_dp*t1373* & t1292*t1829 t4025 = t3262*t57 t4032 = t74*t649 t4070 = t3525*t67 - t4079 = -0.5555555558e-1_dp*t192*t199*t3514+(t705*t863* & - t65)+(2*t496*t1504*t65)+(t187*t3513*t65)- & - 0.5555555558e-1_dp*t192*t728*t864-0.5555555556e0_dp*t140*t3546 & - *t1722+(t705*t865*t65)-0.1111111112e0_dp*t1106*t1525 & - -0.1111111112e0_dp*t4070*t196+0.6666666668e0_dp*t1748*t266 & - *t1722+0.3703703706e0_dp*t1193*t1505*t451 + t4079 = -0.5555555558e-1_dp*t192*t199*t3514 + (t705*t863* & + t65) + (2*t496*t1504*t65) + (t187*t3513*t65) - & + 0.5555555558e-1_dp*t192*t728*t864 - 0.5555555556e0_dp*t140*t3546 & + *t1722 + (t705*t865*t65) - 0.1111111112e0_dp*t1106*t1525 & + - 0.1111111112e0_dp*t4070*t196 + 0.6666666668e0_dp*t1748*t266 & + *t1722 + 0.3703703706e0_dp*t1193*t1505*t451 t4101 = t498*t1505 - t4108 = -0.5000000001e0_dp*t60*t1189*t709+0.3703703706e0_dp*t1755 & - *t512-0.5555555558e-1_dp*t503*t3561-0.2222222224e0_dp*t516 & - *t267*t172*t1504-0.5555555558e-1_dp*t1715*t886-0.5555555558e-1_dp & - *t1715*t882-0.1111111112e0_dp*t516*t3514*t172-0.5000000001e0_dp & - *t1067*t177*t709+(2*t4101)-0.1111111112e0_dp & - *t508*t1769-0.1111111112e0_dp*t192*t1837*t267 - t4140 = -0.5555555558e-1_dp*t719*t1207-0.2000000001e1_dp*t1763* & - t266*t1722-0.1111111112e0_dp*t192*t530*t1505+0.1333333334e1_dp & - *t1519*t722*t1712+0.7407407410e-1_dp*t516*t1718*t526 & - +0.6666666668e0_dp*t379*t1518*t1722-0.5555555558e-1_dp*t192* & - t728*t866-0.2222222224e0_dp*t719*t1126+0.1800000000e2_dp*t1111 & - *t178*t710-0.1111111112e0_dp*t508*t1782-0.5555555558e-1_dp & + t4108 = -0.5000000001e0_dp*t60*t1189*t709 + 0.3703703706e0_dp*t1755 & + *t512 - 0.5555555558e-1_dp*t503*t3561 - 0.2222222224e0_dp*t516 & + *t267*t172*t1504 - 0.5555555558e-1_dp*t1715*t886 - 0.5555555558e-1_dp & + *t1715*t882 - 0.1111111112e0_dp*t516*t3514*t172 - 0.5000000001e0_dp & + *t1067*t177*t709 + (2*t4101) - 0.1111111112e0_dp & + *t508*t1769 - 0.1111111112e0_dp*t192*t1837*t267 + t4140 = -0.5555555558e-1_dp*t719*t1207 - 0.2000000001e1_dp*t1763* & + t266*t1722 - 0.1111111112e0_dp*t192*t530*t1505 + 0.1333333334e1_dp & + *t1519*t722*t1712 + 0.7407407410e-1_dp*t516*t1718*t526 & + + 0.6666666668e0_dp*t379*t1518*t1722 - 0.5555555558e-1_dp*t192* & + t728*t866 - 0.2222222224e0_dp*t719*t1126 + 0.1800000000e2_dp*t1111 & + *t178*t710 - 0.1111111112e0_dp*t508*t1782 - 0.5555555558e-1_dp & *t58*t3796*t71 t4156 = t865*t561*t65 t4201 = t20*t1688 - t4214 = -0.8000000000e1_dp*t478*t123*t3925-0.2400000000e2_dp*t473 & - *t479*t3449+0.1200000000e2_dp*t478*t489*t3892+0.1200000000e2_dp & - *t478*t2998*t561-0.2000000000e1_dp*t478*t27*t649 & - *t14+0.1200000000e2_dp*t478*t56*t1688*t17-0.2400000000e2_dp & - *t473*t1161*t1483+0.1080000000e3_dp*t1143*t474*t3314- & - 0.2160000000e3_dp*t2994*t474*t3306+0.7200000000e2_dp*t1821* & - t3969-0.3600000000e2_dp*t473*t4201*t237-0.1800000000e2_dp*t473 & - *t3030*t561-0.2400000000e2_dp*t473*t1811*t833-0.1800000000e2_dp & + t4214 = -0.8000000000e1_dp*t478*t123*t3925 - 0.2400000000e2_dp*t473 & + *t479*t3449 + 0.1200000000e2_dp*t478*t489*t3892 + 0.1200000000e2_dp & + *t478*t2998*t561 - 0.2000000000e1_dp*t478*t27*t649 & + *t14 + 0.1200000000e2_dp*t478*t56*t1688*t17 - 0.2400000000e2_dp & + *t473*t1161*t1483 + 0.1080000000e3_dp*t1143*t474*t3314 - & + 0.2160000000e3_dp*t2994*t474*t3306 + 0.7200000000e2_dp*t1821* & + t3969 - 0.3600000000e2_dp*t473*t4201*t237 - 0.1800000000e2_dp*t473 & + *t3030*t561 - 0.2400000000e2_dp*t473*t1811*t833 - 0.1800000000e2_dp & *t478*t183*t3918 t4230 = t1142*t262 - t4255 = 0.5400000000e2_dp*t1143*t474*t3329+0.5400000000e2_dp*t1143 & - *t1801*t754+0.7200000000e2_dp*t473*t1176*t1410+0.8999999998e1_dp & - *t178*t62*t3796-0.2400000000e2_dp*t472*t859*t3933 & - -0.1080000000e3_dp*t4230*t3940+0.4000000000e1_dp*t473*t1157 & - *t3472+0.1080000000e3_dp*t1143*t1150*t1410+0.3600000000e2_dp & - *t1821*t3985+0.7200000000e2_dp*t4230*t3979-0.1800000000e2_dp & - *t473*t1801*t804-0.3600000000e2_dp*t473*t1150*t1447- & - 0.3600000000e2_dp*t478*t1176*t1447-0.1800000000e2_dp*t473*t474 & + t4255 = 0.5400000000e2_dp*t1143*t474*t3329 + 0.5400000000e2_dp*t1143 & + *t1801*t754 + 0.7200000000e2_dp*t473*t1176*t1410 + 0.8999999998e1_dp & + *t178*t62*t3796 - 0.2400000000e2_dp*t472*t859*t3933 & + - 0.1080000000e3_dp*t4230*t3940 + 0.4000000000e1_dp*t473*t1157 & + *t3472 + 0.1080000000e3_dp*t1143*t1150*t1410 + 0.3600000000e2_dp & + *t1821*t3985 + 0.7200000000e2_dp*t4230*t3979 - 0.1800000000e2_dp & + *t473*t1801*t804 - 0.3600000000e2_dp*t473*t1150*t1447 - & + 0.3600000000e2_dp*t478*t1176*t1447 - 0.1800000000e2_dp*t473*t474 & *t3382 - t4256 = t4214+t4255 - t4261 = -0.2222222224e0_dp*t1510*t515*t517+0.3703703706e0_dp*t719 & - *t1213-0.1000000001e1_dp*t1766*t266*t1722-0.5555555558e-1_dp & - *t4070*t200+0.6666666668e0_dp*t1519*t496*t561*t65-0.5000000001e0_dp & - *t732*t4156-0.5000000001e0_dp*t140*t865*t1722 & - -0.5000000001e0_dp*t804*t187*t1722-0.4938271608e0_dp*t719* & - t1101+0.8999999998e1_dp*t1097*t178*t710-0.5555555558e-1_dp* & + t4256 = t4214 + t4255 + t4261 = -0.2222222224e0_dp*t1510*t515*t517 + 0.3703703706e0_dp*t719 & + *t1213 - 0.1000000001e1_dp*t1766*t266*t1722 - 0.5555555558e-1_dp & + *t4070*t200 + 0.6666666668e0_dp*t1519*t496*t561*t65 - 0.5000000001e0_dp & + *t732*t4156 - 0.5000000001e0_dp*t140*t865*t1722 & + - 0.5000000001e0_dp*t804*t187*t1722 - 0.4938271608e0_dp*t719* & + t1101 + 0.8999999998e1_dp*t1097*t178*t710 - 0.5555555558e-1_dp* & t192*t68*t4256*t65 t4272 = t863*t561*t65 - t4292 = (2*t1836*t266*t65)-0.1111111112e0_dp*t719*t1224 & - -0.2222222224e0_dp*t1137*t1790-0.1000000001e1_dp*t723*t4272 & - -0.1111111112e0_dp*t1785*t1134-0.6172839508e-1_dp*t192*t22* & - t705*t1200-0.5000000001e0_dp*t140*t863*t1722-0.1111111112e0_dp & - *t1755*t531-0.6172839508e-1_dp*t1715*t874-0.5555555558e-1_dp & - *t719*t1122+0.7407407410e-1_dp*t508*t1726 - t4317 = 0.7407407410e-1_dp*t1755*t527-0.6172839508e-1_dp*t719*t1201 & - -0.1111111112e0_dp*t508*t1838-0.2222222224e0_dp*t192*t3552 & - *t1125+0.7407407410e-1_dp*t1785*t1221-0.1111111111e1_dp*t3547 & - *t1737+0.6666666668e0_dp*t1519*t187*t1712+0.7407407410e-1_dp & - *t503*t3553-0.1111111112e0_dp*t1755*t534-0.1000000001e1_dp & - *t1774*t1712+0.7407407410e-1_dp*t719*t1119 - t4345 = -0.1000000001e1_dp*t379*t266*t1722-0.1000000001e1_dp*t804 & - *t722*t1722+0.8999999998e1_dp*t1109*t178*t710-0.5555555558e-1_dp & - *t1129*t729+t4256*t65-0.2222222224e0_dp*t1755*t520 & - -0.1111111112e0_dp*t503*t3569-0.1111111112e0_dp*t1785*t1216 & - -0.1111111112e0_dp*t3097*t4101-0.5000000001e0_dp*t732*t4272 & - +0.7407407410e-1_dp*t192*t194*t1836*t526 + t4292 = (2*t1836*t266*t65) - 0.1111111112e0_dp*t719*t1224 & + - 0.2222222224e0_dp*t1137*t1790 - 0.1000000001e1_dp*t723*t4272 & + - 0.1111111112e0_dp*t1785*t1134 - 0.6172839508e-1_dp*t192*t22* & + t705*t1200 - 0.5000000001e0_dp*t140*t863*t1722 - 0.1111111112e0_dp & + *t1755*t531 - 0.6172839508e-1_dp*t1715*t874 - 0.5555555558e-1_dp & + *t719*t1122 + 0.7407407410e-1_dp*t508*t1726 + t4317 = 0.7407407410e-1_dp*t1755*t527 - 0.6172839508e-1_dp*t719*t1201 & + - 0.1111111112e0_dp*t508*t1838 - 0.2222222224e0_dp*t192*t3552 & + *t1125 + 0.7407407410e-1_dp*t1785*t1221 - 0.1111111111e1_dp*t3547 & + *t1737 + 0.6666666668e0_dp*t1519*t187*t1712 + 0.7407407410e-1_dp & + *t503*t3553 - 0.1111111112e0_dp*t1755*t534 - 0.1000000001e1_dp & + *t1774*t1712 + 0.7407407410e-1_dp*t719*t1119 + t4345 = -0.1000000001e1_dp*t379*t266*t1722 - 0.1000000001e1_dp*t804 & + *t722*t1722 + 0.8999999998e1_dp*t1109*t178*t710 - 0.5555555558e-1_dp & + *t1129*t729 + t4256*t65 - 0.2222222224e0_dp*t1755*t520 & + - 0.1111111112e0_dp*t503*t3569 - 0.1111111112e0_dp*t1785*t1216 & + - 0.1111111112e0_dp*t3097*t4101 - 0.5000000001e0_dp*t732*t4272 & + + 0.7407407410e-1_dp*t192*t194*t1836*t526 t4352 = t1731*t67 - t4378 = 0.7407407410e-1_dp*t1715*t878+0.8999999998e1_dp*t1189*t59 & - *t177*t710+0.7407407410e-1_dp*t4352*t271-0.1111111112e0_dp & - *t4352*t275-0.5555555556e0_dp*t3547*t1745+0.7407407410e-1_dp & - *t516*t1709*t526+0.6666666668e0_dp*t3533*t187*t1722-0.1000000001e1_dp & - *t237*t496*t1722+0.3703703706e0_dp*t579*t1192 & - *t1194-0.1000000001e1_dp*t723*t4156+0.1333333334e1_dp*t3533 & - *t722*t1722-0.5555555558e-1_dp*t719*t1235 - t4392 = 0.3333333334e0_dp*t165*t171*t1825+0.1250000000e0_dp*t1981 & - *t1247*t3329-0.3125000000e0_dp*t4025*t1247*t3306+0.3333333334e0_dp & - *t165*t1392*t1447+0.5555555556e-1_dp*t1246*t4032 & - *t833-0.1666666667e0_dp*t1246*t74*t25*t1410+0.5555555556e-1_dp & - *t1246*t1247*t3449+0.1800000000e2_dp*t657*t1283*t59 & - *t1975-0.1666666667e0_dp*t429*t166*t3871+0.3333333334e0_dp & - *t55*t57*(t4079+t4108+t4140+t4261+t4292+t4317+t4345 & - +t4378)+0.1481481481e0_dp*t170*t114*t735*t14-0.1666666667e0_dp & + t4378 = 0.7407407410e-1_dp*t1715*t878 + 0.8999999998e1_dp*t1189*t59 & + *t177*t710 + 0.7407407410e-1_dp*t4352*t271 - 0.1111111112e0_dp & + *t4352*t275 - 0.5555555556e0_dp*t3547*t1745 + 0.7407407410e-1_dp & + *t516*t1709*t526 + 0.6666666668e0_dp*t3533*t187*t1722 - 0.1000000001e1_dp & + *t237*t496*t1722 + 0.3703703706e0_dp*t579*t1192 & + *t1194 - 0.1000000001e1_dp*t723*t4156 + 0.1333333334e1_dp*t3533 & + *t722*t1722 - 0.5555555558e-1_dp*t719*t1235 + t4392 = 0.3333333334e0_dp*t165*t171*t1825 + 0.1250000000e0_dp*t1981 & + *t1247*t3329 - 0.3125000000e0_dp*t4025*t1247*t3306 + 0.3333333334e0_dp & + *t165*t1392*t1447 + 0.5555555556e-1_dp*t1246*t4032 & + *t833 - 0.1666666667e0_dp*t1246*t74*t25*t1410 + 0.5555555556e-1_dp & + *t1246*t1247*t3449 + 0.1800000000e2_dp*t657*t1283*t59 & + *t1975 - 0.1666666667e0_dp*t429*t166*t3871 + 0.3333333334e0_dp & + *t55*t57*(t4079 + t4108 + t4140 + t4261 + t4292 + t4317 + t4345 & + + t4378) + 0.1481481481e0_dp*t170*t114*t735*t14 - 0.1666666667e0_dp & *t429*t1928*t290 - t4428 = -0.1111111111e0_dp*t165*t1264*t1483+0.1800000000e2_dp*t658 & - *t575*t1348-0.8333333335e-1_dp*t429*t679*t918-0.1111111111e0_dp & - *t165*t455*t1988+0.3333333334e0_dp*t170*t27*t3576 & - *t172-0.8333333335e-1_dp*t429*t1966*t754+0.1250000000e0_dp & - *t1368*t679*t907+0.1666666667e0_dp*t445*t446*t3918-0.4444444445e0_dp & - *t165*t450*t1829+0.2500000000e0_dp*t1981*t3244 & - *t1410-0.1666666667e0_dp*t429*t1392*t1410 - t4466 = -0.1666666667e0_dp*t429*t437*t1553-0.1111111111e0_dp*t165 & - *t689*t1085+0.1666666667e0_dp*t165*t1275*t649-0.2222222222e0_dp & - *t170*t27*t1843*t17-0.8333333335e-1_dp*t1246*t1962 & - *t1168+0.1666666667e0_dp*t165*t2720*t561+0.6666666668e0_dp & - *t170*t1932*t25+0.3333333334e0_dp*t445*t1292*t1825+0.1250000000e0_dp & - *t1368*t166*t3853-0.4444444445e0_dp*t1373*t1962 & - *t1172+0.7407407405e-1_dp*t165*t1377*t3472+0.5555555555e-1_dp & + t4428 = -0.1111111111e0_dp*t165*t1264*t1483 + 0.1800000000e2_dp*t658 & + *t575*t1348 - 0.8333333335e-1_dp*t429*t679*t918 - 0.1111111111e0_dp & + *t165*t455*t1988 + 0.3333333334e0_dp*t170*t27*t3576 & + *t172 - 0.8333333335e-1_dp*t429*t1966*t754 + 0.1250000000e0_dp & + *t1368*t679*t907 + 0.1666666667e0_dp*t445*t446*t3918 - 0.4444444445e0_dp & + *t165*t450*t1829 + 0.2500000000e0_dp*t1981*t3244 & + *t1410 - 0.1666666667e0_dp*t429*t1392*t1410 + t4466 = -0.1666666667e0_dp*t429*t437*t1553 - 0.1111111111e0_dp*t165 & + *t689*t1085 + 0.1666666667e0_dp*t165*t1275*t649 - 0.2222222222e0_dp & + *t170*t27*t1843*t17 - 0.8333333335e-1_dp*t1246*t1962 & + *t1168 + 0.1666666667e0_dp*t165*t2720*t561 + 0.6666666668e0_dp & + *t170*t1932*t25 + 0.3333333334e0_dp*t445*t1292*t1825 + 0.1250000000e0_dp & + *t1368*t166*t3853 - 0.4444444445e0_dp*t1373*t1962 & + *t1172 + 0.7407407405e-1_dp*t165*t1377*t3472 + 0.5555555555e-1_dp & *t1246*t3244*t1483 t4498 = t56*t1843 - t4505 = 0.1666666667e0_dp*t165*t166*t3796-0.8333333334e-1_dp*t2763 & - *t1247*t833*t561+(4*t147*t392*t1886)+(2 & - *t147*t1388*t672)-0.1111111111e0_dp*t165*t1940*t833+0.3333333334e0_dp & - *t165*t1928*t379+0.7407407409e-1_dp*t165*t450 & - *t649*t14-0.1666666667e0_dp*t429*t462*t3314-0.3703703704e-1_dp & - *t2885*t1247*t3472+0.3333333334e0_dp*t165*t4498*t237 & - +(2*t147*t1284*t672) + t4505 = 0.1666666667e0_dp*t165*t166*t3796 - 0.8333333334e-1_dp*t2763 & + *t1247*t833*t561 + (4*t147*t392*t1886) + (2 & + *t147*t1388*t672) - 0.1111111111e0_dp*t165*t1940*t833 + 0.3333333334e0_dp & + *t165*t1928*t379 + 0.7407407409e-1_dp*t165*t450 & + *t649*t14 - 0.1666666667e0_dp*t429*t462*t3314 - 0.3703703704e-1_dp & + *t2885*t1247*t3472 + 0.3333333334e0_dp*t165*t4498*t237 & + + (2*t147*t1284*t672) t4512 = t1531*rho - t4545 = (4*t147*t1885*t424)+0.1666666667e0_dp*t165*t462 & - *t3382+0.3333333334e0_dp*t445*t4512*t413+0.5185185185e0_dp & - *t2937*t446*t3925-0.8333333335e-1_dp*t429*t166*t3827-0.1666666667e0_dp & - *t429*t437*t1571+0.5555555555e-1_dp*t1246*t203 & - *t237*t1483+0.5555555555e-1_dp*t1246*t2707*t1483+0.7407407409e-1_dp & - *t165*t1875*t1360+(4*t147*t393*t1924) & - +0.3600000000e2_dp*(t1971)*(t1972)*(t1973)*(t424) & - +0.3333333334e0_dp*t165*t437*t1688 + t4545 = (4*t147*t1885*t424) + 0.1666666667e0_dp*t165*t462 & + *t3382 + 0.3333333334e0_dp*t445*t4512*t413 + 0.5185185185e0_dp & + *t2937*t446*t3925 - 0.8333333335e-1_dp*t429*t166*t3827 - 0.1666666667e0_dp & + *t429*t437*t1571 + 0.5555555555e-1_dp*t1246*t203 & + *t237*t1483 + 0.5555555555e-1_dp*t1246*t2707*t1483 + 0.7407407409e-1_dp & + *t165*t1875*t1360 + (4*t147*t393*t1924) & + + 0.3600000000e2_dp*(t1971)*(t1972)*(t1973)*(t424) & + + 0.3333333334e0_dp*t165*t437*t1688 t4553 = t585*t140 t4575 = t1067*t561 - t4585 = 0.1666666667e0_dp*t445*t3248*t668-0.1111111111e0_dp*t165 & - *t1932*t433+0.5555555556e-1_dp*t1246*t4553*t833-0.8333333335e-1_dp & - *t429*t1275*t593-0.8333333335e-1_dp*t429*t462* & - t3329+0.2500000000e0_dp*t1981*t1247*t3314+0.1666666667e0_dp* & - t445*t1962*t1093+0.3333333334e0_dp*t165*t455*t668-0.8333333335e-1_dp & - *t429*t166*t3849-0.8333333335e-1_dp*t429*t166* & - t4575+0.2e1_dp*t147*(t3491-t3494-t3497+t3501-t3505+0.9000000000e1_dp & - *t3507-t3512)*t149*t160 + t4585 = 0.1666666667e0_dp*t445*t3248*t668 - 0.1111111111e0_dp*t165 & + *t1932*t433 + 0.5555555556e-1_dp*t1246*t4553*t833 - 0.8333333335e-1_dp & + *t429*t1275*t593 - 0.8333333335e-1_dp*t429*t462* & + t3329 + 0.2500000000e0_dp*t1981*t1247*t3314 + 0.1666666667e0_dp* & + t445*t1962*t1093 + 0.3333333334e0_dp*t165*t455*t668 - 0.8333333335e-1_dp & + *t429*t166*t3849 - 0.8333333335e-1_dp*t429*t166* & + t4575 + 0.2e1_dp*t147*(t3491 - t3494 - t3497 + t3501 - t3505 + 0.9000000000e1_dp & + *t3507 - t3512)*t149*t160 t4607 = t1688*t237 - t4627 = 0.1666666667e0_dp*t165*t1966*t804-0.1666666667e0_dp*t429 & - *t437*t1557+0.1800000000e2_dp*t657*t1387*t59*t1975+0.1037037037e1_dp & - *t170*t341*t585*t1100-0.8888888890e0_dp*t170 & - *t114*t1531*t451-0.8888888890e0_dp*t170*t1875*t225-0.1666666667e0_dp & - *t429*t166*t4607-0.1111111111e0_dp*t165*t466 & - *t3449-0.1666666667e0_dp*t429*t679*t914-0.8333333335e-1_dp* & - t1246*t446*t1093*t561+0.1250000000e0_dp*t1368*t462*t3306 & - +0.2500000000e0_dp*t1981*t2707*t1410 - t4657 = -0.3333333336e0_dp*t289*t84*t3871-0.6666666672e0_dp*t83 & - *t3875*t237+0.8333333340e-1_dp*t906*t384*t3306-0.1666666668e0_dp & - *t289*t597*t918-0.2222222224e0_dp*t144*t46*(t4018 & - +t4392+t4428+t4466+t4505+t4545+t4585+t4627)-0.1666666668e0_dp & - *t289*t384*t3329-0.3333333336e0_dp*t165*t2636*t561 & - -0.3333333336e0_dp*t165*t897*t1447+0.8333333340e-1_dp*t1546 & - *t897*t3329-0.6666666672e0_dp*t83*t1071*t1447-0.3333333336e0_dp & - *t83*t2404*t561-0.4444444448e0_dp*t383*t3875-0.3333333336e0_dp & + t4627 = 0.1666666667e0_dp*t165*t1966*t804 - 0.1666666667e0_dp*t429 & + *t437*t1557 + 0.1800000000e2_dp*t657*t1387*t59*t1975 + 0.1037037037e1_dp & + *t170*t341*t585*t1100 - 0.8888888890e0_dp*t170 & + *t114*t1531*t451 - 0.8888888890e0_dp*t170*t1875*t225 - 0.1666666667e0_dp & + *t429*t166*t4607 - 0.1111111111e0_dp*t165*t466 & + *t3449 - 0.1666666667e0_dp*t429*t679*t914 - 0.8333333335e-1_dp* & + t1246*t446*t1093*t561 + 0.1250000000e0_dp*t1368*t462*t3306 & + + 0.2500000000e0_dp*t1981*t2707*t1410 + t4657 = -0.3333333336e0_dp*t289*t84*t3871 - 0.6666666672e0_dp*t83 & + *t3875*t237 + 0.8333333340e-1_dp*t906*t384*t3306 - 0.1666666668e0_dp & + *t289*t597*t918 - 0.2222222224e0_dp*t144*t46*(t4018 & + + t4392 + t4428 + t4466 + t4505 + t4545 + t4585 + t4627) - 0.1666666668e0_dp & + *t289*t384*t3329 - 0.3333333336e0_dp*t165*t2636*t561 & + - 0.3333333336e0_dp*t165*t897*t1447 + 0.8333333340e-1_dp*t1546 & + *t897*t3329 - 0.6666666672e0_dp*t83*t1071*t1447 - 0.3333333336e0_dp & + *t83*t2404*t561 - 0.4444444448e0_dp*t383*t3875 - 0.3333333336e0_dp & *t289*t294*t1553 - t4696 = -0.6666666672e0_dp*t55*t1575-0.3333333336e0_dp*t289*t597 & - *t914-0.3333333336e0_dp*t165*t2631*t561-0.6666666672e0_dp* & - t55*t1706-0.3333333336e0_dp*t289*t384*t3314-0.6666666672e0_dp & - *t83*t294*t1688+0.1666666668e0_dp*t1546*t2631*t1410- & - 0.3333333336e0_dp*t289*t1564*t290-0.1666666668e0_dp*t289*t84 & - *t4575-0.3333333336e0_dp*t289*t294*t1557-0.1666666668e0_dp & - *t289*t1694*t754-0.3333333336e0_dp*t289*t84*t4607-0.3333333336e0_dp & + t4696 = -0.6666666672e0_dp*t55*t1575 - 0.3333333336e0_dp*t289*t597 & + *t914 - 0.3333333336e0_dp*t165*t2631*t561 - 0.6666666672e0_dp* & + t55*t1706 - 0.3333333336e0_dp*t289*t384*t3314 - 0.6666666672e0_dp & + *t83*t294*t1688 + 0.1666666668e0_dp*t1546*t2631*t1410 - & + 0.3333333336e0_dp*t289*t1564*t290 - 0.1666666668e0_dp*t289*t84 & + *t4575 - 0.3333333336e0_dp*t289*t294*t1557 - 0.1666666668e0_dp & + *t289*t1694*t754 - 0.3333333336e0_dp*t289*t84*t4607 - 0.3333333336e0_dp & *t83*t45*t3581*t140 - t4700 = -0.6666666670e0_dp*t2147*t1411-0.1333333334e1_dp*t747*t597 & - *t237-0.1333333334e1_dp*t747*t84*t1447-0.1333333334e1_dp & - *t747*t294*t561-0.8888888896e0_dp*t214*t1536+0.1666666668e0_dp & - *t3305*t84*t3306-0.3333333336e0_dp*t753*t46*t589*t754 & - -0.6666666672e0_dp*t1409*t84*t3314-0.6666666670e0_dp*t1409 & - *t294*t1410-0.1333333334e1_dp*t217*t46*t1535*t237-0.1333333334e1_dp & - *t217*t46*t282*t1447-0.3333333336e0_dp*t1409 & - *t84*t3329-0.6666666672e0_dp*t217*t46*t589*t804-0.6666666672e0_dp & - *t217*t46*t78*t3382-0.6666666672e0_dp*t217*t46 & - *t893*t561-0.4444444448e0_dp*t43*t46*t3581+t8*(t3826+ & - t3869+t4657+t4696) - e_ndrho_rho_rho_spin(ii) = e_ndrho_rho_rho_spin(ii)+t4700*sx + t4700 = -0.6666666670e0_dp*t2147*t1411 - 0.1333333334e1_dp*t747*t597 & + *t237 - 0.1333333334e1_dp*t747*t84*t1447 - 0.1333333334e1_dp & + *t747*t294*t561 - 0.8888888896e0_dp*t214*t1536 + 0.1666666668e0_dp & + *t3305*t84*t3306 - 0.3333333336e0_dp*t753*t46*t589*t754 & + - 0.6666666672e0_dp*t1409*t84*t3314 - 0.6666666670e0_dp*t1409 & + *t294*t1410 - 0.1333333334e1_dp*t217*t46*t1535*t237 - 0.1333333334e1_dp & + *t217*t46*t282*t1447 - 0.3333333336e0_dp*t1409 & + *t84*t3329 - 0.6666666672e0_dp*t217*t46*t589*t804 - 0.6666666672e0_dp & + *t217*t46*t78*t3382 - 0.6666666672e0_dp*t217*t46 & + *t893*t561 - 0.4444444448e0_dp*t43*t46*t3581 + t8*(t3826 + & + t3869 + t4657 + t4696) + e_ndrho_rho_rho_spin(ii) = e_ndrho_rho_rho_spin(ii) + t4700*sx t4701 = t561**2 t4704 = 0.3333333336e0_dp*t2147*t84*t4701 t4707 = 0.1333333334e1_dp*t747*t597*t561 @@ -4889,10 +4889,10 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t4714 = t327*t4713 t4717 = t22*t132 t4721 = 0.1e1_dp/t787*t2480 - t4725 = 0.120e2_dp*t624*t4717-0.60e1_dp*t7*t4721*t371 + t4725 = 0.120e2_dp*t624*t4717 - 0.60e1_dp*t7*t4721*t371 t4726 = t105*t4725 - t4729 = 0.40e1_dp*t624*t4708-0.80e1_dp*t112*t558+0.40e1_dp*t102 & - *t4714-0.20e1_dp*t102*t4726 + t4729 = 0.40e1_dp*t624*t4708 - 0.80e1_dp*t112*t558 + 0.40e1_dp*t102 & + *t4714 - 0.20e1_dp*t102*t4726 t4732 = 0.6666666672e0_dp*t747*t84*t4729 t4733 = pi**2 t4734 = t4733*t146 @@ -4910,13 +4910,13 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t4771 = t4770*t4733 t4772 = t26*t4701 t4776 = t58*t4729 - t4782 = -0.2250000000e2_dp*t473*t4760*t65+0.8999999998e1_dp*t478 & - *t4764*t65+0.8099999996e2_dp*t4771*t4772*t65-0.5555555558e-1_dp & - *t4776*t71-0.5000000001e0_dp*t60*t4729*t65 - t4786 = -0.2700000000e2_dp*t4738*t18*t4739+0.4500000000e1_dp*t567 & - *t4744-0.3000000000e1_dp*t567*t4748-0.8333333335e-1_dp*t429 & - *t166*t4701+0.3333333334e0_dp*t165*t679*t561+0.1666666667e0_dp & - *t165*t166*t4729+0.3333333334e0_dp*t55*t57*t4782 + t4782 = -0.2250000000e2_dp*t473*t4760*t65 + 0.8999999998e1_dp*t478 & + *t4764*t65 + 0.8099999996e2_dp*t4771*t4772*t65 - 0.5555555558e-1_dp & + *t4776*t71 - 0.5000000001e0_dp*t60*t4729*t65 + t4786 = -0.2700000000e2_dp*t4738*t18*t4739 + 0.4500000000e1_dp*t567 & + *t4744 - 0.3000000000e1_dp*t567*t4748 - 0.8333333335e-1_dp*t429 & + *t166*t4701 + 0.3333333334e0_dp*t165*t679*t561 + 0.1666666667e0_dp & + *t165*t166*t4729 + 0.3333333334e0_dp*t55*t57*t4782 t4789 = 0.4444444448e0_dp*t214*t46*t4786 t4790 = t237*t4701 t4793 = 0.1666666668e0_dp*t3305*t84*t4790 @@ -4935,14 +4935,14 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t4834 = t327*t4833 t4837 = t233*t4725 t4838 = t327*t4837 - t4849 = -0.3200000000e2_dp*t1645*t627+0.4800000000e2_dp*t7*t1440 & - -0.2400000000e2_dp*t786/t2492*t1058 + t4849 = -0.3200000000e2_dp*t1645*t627 + 0.4800000000e2_dp*t7*t1440 & + - 0.2400000000e2_dp*t786/t2492*t1058 t4850 = t105*t4849 - t4853 = -0.1066666667e2_dp*t1645*t98+0.2133333334e2_dp*t339*t1420 & - -0.1066666667e2_dp*t321*t4817+0.5333333333e1_dp*t321*t4820 & - -0.40e1_dp*t624*t234+0.160e2_dp*t112*t1426-0.80e1_dp*t112* & - t1444-0.120e2_dp*t102*t4830+0.80e1_dp*t102*t4834+0.40e1_dp* & - t102*t4838-0.20e1_dp*t102*t4850 + t4853 = -0.1066666667e2_dp*t1645*t98 + 0.2133333334e2_dp*t339*t1420 & + - 0.1066666667e2_dp*t321*t4817 + 0.5333333333e1_dp*t321*t4820 & + - 0.40e1_dp*t624*t234 + 0.160e2_dp*t112*t1426 - 0.80e1_dp*t112* & + t1444 - 0.120e2_dp*t102*t4830 + 0.80e1_dp*t102*t4834 + 0.40e1_dp* & + t102*t4838 - 0.20e1_dp*t102*t4850 t4857 = 0.6666666672e0_dp*t217*t46*t78*t4853 t4861 = 0.3333333336e0_dp*t753*t46*t282*t4701 t4864 = t217*t46*t1535*t561 @@ -4956,7 +4956,7 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t4889 = t178*t62*t4853 t4893 = 0.1200000000e2_dp*t473*t1500*t4701 t4895 = t478*t1500*t4729 - t4897 = t4881-t4884-t4887+0.8999999998e1_dp*t4889-t4893+0.5999999999e1_dp & + t4897 = t4881 - t4884 - t4887 + 0.8999999998e1_dp*t4889 - t4893 + 0.5999999999e1_dp & *t4895 t4898 = t4897*t65 t4901 = t1504*t59*t177*t710 @@ -4983,11 +4983,11 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t4951 = 0.5555555558e-1_dp*t4943*t275 t4952 = t719*t1525 t4955 = t68*t4897*t65 - t4958 = t4898+0.1800000000e2_dp*t4901-t4907+t4911+t4917-t4920 & - -0.1000000000e1_dp*t4922-t4925+0.3333333334e0_dp*t1519*t4908 & - -0.1000000000e1_dp*t4929-t4932+t4935-0.4500000000e1_dp*t4941 & - +t4945+0.3000000000e1_dp*t4946*t4701*t4940-t4951-0.1111111112e0_dp & - *t4952-0.5555555558e-1_dp*t192*t4955 + t4958 = t4898 + 0.1800000000e2_dp*t4901 - t4907 + t4911 + t4917 - t4920 & + - 0.1000000000e1_dp*t4922 - t4925 + 0.3333333334e0_dp*t1519*t4908 & + - 0.1000000000e1_dp*t4929 - t4932 + t4935 - 0.4500000000e1_dp*t4941 & + + t4945 + 0.3000000000e1_dp*t4946*t4701*t4940 - t4951 - 0.1111111112e0_dp & + *t4952 - 0.5555555558e-1_dp*t192*t4955 t4994 = t44*t4733*t146 t4995 = t4994*t4770 t5001 = 0.1666666667e0_dp*t165*t166*t4853 @@ -5005,16 +5005,16 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t5029 = t56*t4782 t5032 = 0.1666666667e0_dp*t165*t5029*t237 t5035 = 0.3333333334e0_dp*t165*t679*t1447 - t5036 = -t4872+0.3333333334e0_dp*t4874+t4878+0.3333333334e0_dp* & - t55*t57*t4958+0.2e1_dp*t147*t149*(-0.5625000000e1_dp*t1302 & - *t1459*t4701+0.4500000000e1_dp*t400*t2022*t561+0.2250000000e1_dp & - *t400*t1459*t4729-0.1500000000e1_dp*t151*t50*t4853 & - +0.7500000000e0_dp*t400*t1466*t4701-0.5000000000e0_dp*t405 & - *t1466*t4729)-0.3600000000e2_dp*t2081*t4760*t250+0.1800000000e2_dp & - *t658*t4764*t250+0.3600000000e2_dp*t658*t575*t1471 & - +0.1620000000e3_dp*t4995*t4772*t250+t5001+t5005-t5008 & - -0.5555555555e-1_dp*t5011-t5016+t5019-t5022-t5025-t5028 & - +t5032+t5035 + t5036 = -t4872 + 0.3333333334e0_dp*t4874 + t4878 + 0.3333333334e0_dp* & + t55*t57*t4958 + 0.2e1_dp*t147*t149*(-0.5625000000e1_dp*t1302 & + *t1459*t4701 + 0.4500000000e1_dp*t400*t2022*t561 + 0.2250000000e1_dp & + *t400*t1459*t4729 - 0.1500000000e1_dp*t151*t50*t4853 & + + 0.7500000000e0_dp*t400*t1466*t4701 - 0.5000000000e0_dp*t405 & + *t1466*t4729) - 0.3600000000e2_dp*t2081*t4760*t250 + 0.1800000000e2_dp & + *t658*t4764*t250 + 0.3600000000e2_dp*t658*t575*t1471 & + + 0.1620000000e3_dp*t4995*t4772*t250 + t5001 + t5005 - t5008 & + - 0.5555555555e-1_dp*t5011 - t5016 + t5019 - t5022 - t5025 - t5028 & + + t5032 + t5035 t5040 = t379*t4729 t5043 = 0.1666666668e0_dp*t289*t84*t5040 t5044 = t140*t4853 @@ -5030,32 +5030,32 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t5106 = beta*t640 t5108 = t126*t371*ndrho t5115 = t366*t640 - t5118 = -0.480e2_dp*t5051*t4717+0.240e2_dp*t7*t2182*t2480*t371 & - +0.480e2_dp*t5060*t628-0.240e2_dp*t7*t1640*t1438*t371 & - *rho+0.120e2_dp*t550*t637-0.180e2_dp*t5106*t5108-0.120e2_dp & - *t7*t640*t635*t371+0.180e2_dp*t5115*t1681 - t5122 = -0.320e2_dp*t5051*t4708+0.640e2_dp*t1582*t558-0.320e2_dp & - *t302*t4714+0.160e2_dp*t302*t4726+0.320e2_dp*t5060*t99- & - 0.640e2_dp*t605*t609+0.320e2_dp*t93*t953*t5065-0.160e2_dp* & - t93*t316*t5069-0.40e1_dp*t624*t137+0.160e2_dp*t112*t615 & - -0.80e1_dp*t112*t646-0.120e2_dp*t102*t974*t5079+0.80e1_dp* & - t102*t327*t5083+0.40e1_dp*t102*t327*t5087-0.20e1_dp*t102 & + t5118 = -0.480e2_dp*t5051*t4717 + 0.240e2_dp*t7*t2182*t2480*t371 & + + 0.480e2_dp*t5060*t628 - 0.240e2_dp*t7*t1640*t1438*t371 & + *rho + 0.120e2_dp*t550*t637 - 0.180e2_dp*t5106*t5108 - 0.120e2_dp & + *t7*t640*t635*t371 + 0.180e2_dp*t5115*t1681 + t5122 = -0.320e2_dp*t5051*t4708 + 0.640e2_dp*t1582*t558 - 0.320e2_dp & + *t302*t4714 + 0.160e2_dp*t302*t4726 + 0.320e2_dp*t5060*t99 - & + 0.640e2_dp*t605*t609 + 0.320e2_dp*t93*t953*t5065 - 0.160e2_dp* & + t93*t316*t5069 - 0.40e1_dp*t624*t137 + 0.160e2_dp*t112*t615 & + - 0.80e1_dp*t112*t646 - 0.120e2_dp*t102*t974*t5079 + 0.80e1_dp* & + t102*t327*t5083 + 0.40e1_dp*t102*t327*t5087 - 0.20e1_dp*t102 & *t105*t5118 t5123 = t5122*t237 t5126 = 0.1666666668e0_dp*t289*t84*t5123 t5139 = t25*t4701 t5143 = t25*t4729 - t5147 = -0.5625000000e1_dp*t1302*t401*t4701+0.4500000000e1_dp*t400 & - *t1892*t561+0.2250000000e1_dp*t400*t401*t4729-0.1500000000e1_dp & - *t151*t50*t5122-0.2250000000e1_dp*t400*t156*t5139 & - +0.1500000000e1_dp*t405*t156*t5143 + t5147 = -0.5625000000e1_dp*t1302*t401*t4701 + 0.4500000000e1_dp*t400 & + *t1892*t561 + 0.2250000000e1_dp*t400*t401*t4729 - 0.1500000000e1_dp & + *t151*t50*t5122 - 0.2250000000e1_dp*t400*t156*t5139 & + + 0.1500000000e1_dp*t405*t156*t5143 t5163 = t140*t4701 t5170 = t649*t561 t5174 = t140*t4729 - t5226 = 0.5400000000e2_dp*t1143*t474*t4701-0.3600000000e2_dp*t473 & - *t1801*t561-0.1800000000e2_dp*t473*t474*t4729+0.8999999998e1_dp & - *t178*t62*t5122+0.3600000000e2_dp*t473*t183*t5139 & - -0.1800000000e2_dp*t478*t183*t5143 + t5226 = 0.5400000000e2_dp*t1143*t474*t4701 - 0.3600000000e2_dp*t473 & + *t1801*t561 - 0.1800000000e2_dp*t473*t474*t4729 + 0.8999999998e1_dp & + *t178*t62*t5122 + 0.3600000000e2_dp*t473*t183*t5139 & + - 0.1800000000e2_dp*t478*t183*t5143 t5228 = t705*t59 t5229 = t5228*t177 t5237 = t649*t177 @@ -5066,27 +5066,27 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t5262 = t471*t722 t5270 = t68*t5226 t5271 = t5270*t65 - t5276 = t5226*t65+0.1800000000e2_dp*t5229*t710-0.2250000000e2_dp & - *t707*t471*t4905+0.8999999998e1_dp*t708*t4909-0.1000000000e1_dp & - *t5237*t709-0.5000000001e0_dp*t716*t4908-0.1000000001e1_dp & - *t723*t4908-0.1000000000e1_dp*t5244*t709+0.8099999996e2_dp & - *t5247*t1141*t4915-0.5555555558e-1_dp*t5251*t71+0.1000000000e1_dp & - *t2098*t4904-0.4500000000e1_dp*t5256*t4701*t4940 & - -0.1111111112e0_dp*t4943*t196-0.9000000007e1_dp*t5262*t4701 & - *t4940-0.5555555558e-1_dp*t4943*t200-0.1111111112e0_dp*t719* & - t729-0.5555555558e-1_dp*t192*t5271-0.5000000001e0_dp*t732*t4908 - t5280 = (2*t147*t149*t5147)-0.3600000000e2_dp*t2081*t4760 & - *t161+0.1800000000e2_dp*t658*t4764*t161+0.3600000000e2_dp & - *t658*t575*t673+0.1620000000e3_dp*t4995*t4772*t161+0.1250000000e0_dp & - *t1368*t166*t5163-0.1666666667e0_dp*t429*t679 & - *t593-0.1666666667e0_dp*t429*t166*t5170-0.8333333335e-1_dp* & - t429*t166*t5174+0.1666666667e0_dp*t165*t5029*t140+0.3333333334e0_dp & - *t165*t679*t649+0.1666666667e0_dp*t165*t166*t5122 & - -0.8333333335e-1_dp*t1246*t446*t5139+0.3333333334e0_dp*t445 & - *t1962*t668+0.1666666667e0_dp*t445*t446*t5143+0.3333333334e0_dp & - *t170*t5013*t172-0.8333333335e-1_dp*t429*t462*t4701 & - +0.3333333334e0_dp*t165*t1966*t561+0.1666666667e0_dp*t165 & - *t462*t4729+0.3333333334e0_dp*t55*t57*t5276 + t5276 = t5226*t65 + 0.1800000000e2_dp*t5229*t710 - 0.2250000000e2_dp & + *t707*t471*t4905 + 0.8999999998e1_dp*t708*t4909 - 0.1000000000e1_dp & + *t5237*t709 - 0.5000000001e0_dp*t716*t4908 - 0.1000000001e1_dp & + *t723*t4908 - 0.1000000000e1_dp*t5244*t709 + 0.8099999996e2_dp & + *t5247*t1141*t4915 - 0.5555555558e-1_dp*t5251*t71 + 0.1000000000e1_dp & + *t2098*t4904 - 0.4500000000e1_dp*t5256*t4701*t4940 & + - 0.1111111112e0_dp*t4943*t196 - 0.9000000007e1_dp*t5262*t4701 & + *t4940 - 0.5555555558e-1_dp*t4943*t200 - 0.1111111112e0_dp*t719* & + t729 - 0.5555555558e-1_dp*t192*t5271 - 0.5000000001e0_dp*t732*t4908 + t5280 = (2*t147*t149*t5147) - 0.3600000000e2_dp*t2081*t4760 & + *t161 + 0.1800000000e2_dp*t658*t4764*t161 + 0.3600000000e2_dp & + *t658*t575*t673 + 0.1620000000e3_dp*t4995*t4772*t161 + 0.1250000000e0_dp & + *t1368*t166*t5163 - 0.1666666667e0_dp*t429*t679 & + *t593 - 0.1666666667e0_dp*t429*t166*t5170 - 0.8333333335e-1_dp* & + t429*t166*t5174 + 0.1666666667e0_dp*t165*t5029*t140 + 0.3333333334e0_dp & + *t165*t679*t649 + 0.1666666667e0_dp*t165*t166*t5122 & + - 0.8333333335e-1_dp*t1246*t446*t5139 + 0.3333333334e0_dp*t445 & + *t1962*t668 + 0.1666666667e0_dp*t445*t446*t5143 + 0.3333333334e0_dp & + *t170*t5013*t172 - 0.8333333335e-1_dp*t429*t462*t4701 & + + 0.3333333334e0_dp*t165*t1966*t561 + 0.1666666667e0_dp*t165 & + *t462*t4729 + 0.3333333334e0_dp*t55*t57*t5276 t5281 = t45*t5280 t5284 = 0.3333333336e0_dp*t83*t5281*t237 t5291 = 0.1666666668e0_dp*t289*t384*t4801 @@ -5095,8 +5095,8 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t5298 = 0.3333333336e0_dp*t83*t5295*t379 t5301 = 0.3333333336e0_dp*t55*t384*t4729 t5303 = t83*t1564*t649 - t5305 = -t5043-t5047-t5050-t5126-t5284-0.3333333336e0_dp*t83 & - *t45*t5036*t140-t5291+t5294-t5298-t5301-0.6666666672e0_dp & + t5305 = -t5043 - t5047 - t5050 - t5126 - t5284 - 0.3333333336e0_dp*t83 & + *t45*t5036*t140 - t5291 + t5294 - t5298 - t5301 - 0.6666666672e0_dp & *t5303 t5308 = 0.3333333336e0_dp*t289*t1694*t1410 t5311 = 0.1666666668e0_dp*t289*t1071*t4701 @@ -5112,8 +5112,8 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t5338 = 0.6666666672e0_dp*t55*t1694*t561 t5339 = t649*t1447 t5342 = 0.3333333336e0_dp*t289*t84*t5339 - t5343 = -t5308-t5311-t5314-t5317-t5320+t5323-t5326-t5329 & - +t5333-t5335-t5338-t5342 + t5343 = -t5308 - t5311 - t5314 - t5317 - t5320 + t5323 - t5326 - t5329 & + + t5333 - t5335 - t5338 - t5342 t5345 = t1688*t561 t5347 = t289*t84*t5345 t5351 = 0.1666666668e0_dp*t164*t384*t4701 @@ -5139,10 +5139,10 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t5415 = 0.1666666667e0_dp*t429*t462*t4797 t5418 = 2*t147*t393*t5147 t5421 = t657*t1884*t59*t1975 - t5423 = -t5363+t5367-t5370+0.1111111111e0_dp*t5373-0.5555555555e-1_dp & - *t5376+0.3333333334e0_dp*t5379-t5383-t5386-t5389+ & - 0.3333333334e0_dp*t170*t27*t4958*t172-t5397+t5400+0.3333333334e0_dp & - *t5402-t5406-t5409-t5412-t5415+t5418+0.3600000000e2_dp & + t5423 = -t5363 + t5367 - t5370 + 0.1111111111e0_dp*t5373 - 0.5555555555e-1_dp & + *t5376 + 0.3333333334e0_dp*t5379 - t5383 - t5386 - t5389 + & + 0.3333333334e0_dp*t170*t27*t4958*t172 - t5397 + t5400 + 0.3333333334e0_dp & + *t5402 - t5406 - t5409 - t5412 - t5415 + t5418 + 0.3600000000e2_dp & *t5421 t5426 = 0.8333333335e-1_dp*t1246*t1292*t5139 t5429 = 0.1666666667e0_dp*t445*t1292*t5143 @@ -5161,8 +5161,8 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t5462 = 0.1173333333e3_dp*t5460*t313 t5466 = 0.40e1_dp*t102*t327*t136*t4849 t5468 = 0.2346666666e3_dp*t605*t1420 - t5469 = t5440-t5443-t5446-t5449-t5451-t5454-t5456+t5459 & - -t5462+t5466-t5468 + t5469 = t5440 - t5443 - t5446 - t5449 - t5451 - t5454 - t5456 + t5459 & + - t5462 + t5466 - t5468 t5472 = 0.3200000001e2_dp*t321*t2455*t5079 t5474 = 0.4266666668e2_dp*t339*t1608 t5478 = 0.240e2_dp*t1616*t973*t645*t1425 @@ -5179,9 +5179,9 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t5507 = 0.120e2_dp*t7*t640*t1667*t371 t5509 = 0.180e2_dp*t5115*t3668 t5511 = t1680*t3673*t23 - t5516 = t5480-t5482-t5484+t5487-t5489+t5492+t5494-0.1920000000e3_dp & - *t5496+t5499-t5503-t5507+t5509-0.4800000000e2_dp & - *t5511+0.1200000000e3_dp*t1055*t2565*t4721 + t5516 = t5480 - t5482 - t5484 + t5487 - t5489 + t5492 + t5494 - 0.1920000000e3_dp & + *t5496 + t5499 - t5503 - t5507 + t5509 - 0.4800000000e2_dp & + *t5511 + 0.1200000000e3_dp*t1055*t2565*t4721 t5523 = 0.120e2_dp*t102*t974*t375*t4713 t5525 = 0.2133333334e2_dp*t339*t1611 t5528 = t102*t327*t1684*t557 @@ -5190,8 +5190,8 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t5535 = 0.640e2_dp*t1582*t1444 t5537 = 0.160e2_dp*t112*t1622 t5540 = 0.320e2_dp*t1597*t1598*t4837 - t5541 = t5472-t5474-t5478-0.20e1_dp*t102*t105*t5516-t5523 & - +t5525+0.80e1_dp*t5528+t5531+t5533+t5535+t5537+t5540 + t5541 = t5472 - t5474 - t5478 - 0.20e1_dp*t102*t105*t5516 - t5523 & + + t5525 + 0.80e1_dp*t5528 + t5531 + t5533 + t5535 + t5537 + t5540 t5545 = 0.480e2_dp*t1616*t3750*t4829 t5548 = 0.120e2_dp*t1616*t1617*t4837 t5551 = 0.1280e3_dp*t24*t298*t1599 @@ -5204,8 +5204,8 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t5568 = 0.1066666667e2_dp*t1645*t322 t5572 = 0.40e1_dp*t102*t327*t5118*t233 t5574 = 0.1173333333e3_dp*t93*t4817 - t5575 = t5545-t5548+t5551+t5553-t5558+t5560-t5562+t5564 & - -0.80e1_dp*t5565+t5568+t5572+t5574 + t5575 = t5545 - t5548 + t5551 + t5553 - t5558 + t5560 - t5562 + t5564 & + - 0.80e1_dp*t5565 + t5568 + t5572 + t5574 t5579 = 0.80e1_dp*t102*t327*t645*t1443 t5581 = 0.320e2_dp*t302*t4838 t5585 = 0.160e2_dp*t93*t316*rho*t4849 @@ -5218,9 +5218,9 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t5604 = 0.320e2_dp*t5051*t234 t5607 = 0.5866666667e2_dp*t307*t949*t5069 t5610 = 0.640e2_dp*t1597*t1598*t4833 - t5611 = t5579-t5581-t5585+t5590-t5593-t5595+t5597-t5600 & - -t5602+t5604+t5607+t5610 - t5613 = t5469+t5541+t5575+t5611 + t5611 = t5579 - t5581 - t5585 + t5590 - t5593 - t5595 + t5597 - t5600 & + - t5602 + t5604 + t5607 + t5610 + t5613 = t5469 + t5541 + t5575 + t5611 t5619 = 0.3333333334e0_dp*t170*t5013*t25 t5622 = 0.1666666667e0_dp*t165*t1392*t4729 t5625 = 0.1666666667e0_dp*t429*t166*t5339 @@ -5238,8 +5238,8 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t5660 = 0.1125000000e2_dp*t1302*t401*t4797 t5663 = 0.1500000000e1_dp*t400*t417*t5371 t5666 = 0.1125000000e2_dp*t1302*t1892*t1410 - t5667 = t5635-t5638+t5641+0.4500000000e1_dp*t5643-t5647-t5650 & - +t5653-t5657-t5660+t5663-t5666 + t5667 = t5635 - t5638 + t5641 + 0.4500000000e1_dp*t5643 - t5647 - t5650 & + + t5653 - t5657 - t5660 + t5663 - t5666 t5670 = 0.2250000000e1_dp*t400*t1309*t4729 t5671 = t172*t4801 t5673 = 0.2250000000e1_dp*t1912*t5671 @@ -5254,8 +5254,8 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t5698 = 0.5625000000e1_dp*t3939*t5696 t5699 = t172*t4797 t5701 = 0.4500000000e1_dp*t1912*t5699 - t5705 = t5670-t5673+t5676-t5679+t5682+t5686-t5689+t5692 & - +t5695+t5698-t5701-0.1500000000e1_dp*t151*t50*t5613 + t5705 = t5670 - t5673 + t5676 - t5679 + t5682 + t5686 - t5689 + t5692 & + + t5695 + t5698 - t5701 - 0.1500000000e1_dp*t151*t50*t5613 t5713 = t4739*t160 t5716 = 0.1620000000e3_dp*t4994*t392*t4769*t1141*t26*t5713 t5719 = 0.3333333334e0_dp*t165*t1966*t1447 @@ -5266,10 +5266,10 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t5734 = 0.1666666667e0_dp*t429*t679*t1553 t5738 = 0.4444444445e0_dp*t170*t114*t4782*t451 t5741 = 0.1666666667e0_dp*t165*t171*t5143 - t5742 = -t5426+t5429-0.2222222222e0_dp*t5432+t5436+0.1666666667e0_dp & - *t165*t166*t5613+t5619+t5622-t5625-t5628+t5631 & - +(2*t147*t149*(t5667+t5705))+t5716+t5719-t5722 & - -0.1666666667e0_dp*t5724+t5728+t5731-t5734-t5738+t5741 + t5742 = -t5426 + t5429 - 0.2222222222e0_dp*t5432 + t5436 + 0.1666666667e0_dp & + *t165*t166*t5613 + t5619 + t5622 - t5625 - t5628 + t5631 & + + (2*t147*t149*(t5667 + t5705)) + t5716 + t5719 - t5722 & + - 0.1666666667e0_dp*t5724 + t5728 + t5731 - t5734 - t5738 + t5741 t5745 = t165*t4498*t561 t5749 = 0.1666666667e0_dp*t429*t437*t5170 t5752 = 0.8333333335e-1_dp*t429*t462*t4801 @@ -5297,8 +5297,8 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t5825 = 0.1200000000e2_dp*t473*t479*t5009 t5828 = 0.3600000000e2_dp*t473*t1801*t1447 t5830 = 0.1080000000e3_dp*t4230*t5696 - t5831 = t5801-t5804-t5807+t5810-t5813+t5816-t5819-t5822 & - -t5825-t5828-t5830 + t5831 = t5801 - t5804 - t5807 + t5810 - t5813 + t5816 - t5819 - t5822 & + - t5825 - t5828 - t5830 t5833 = 0.7200000000e2_dp*t1821*t5699 t5835 = 0.3600000000e2_dp*t1821*t5671 t5838 = 0.1080000000e3_dp*t1143*t474*t4797 @@ -5310,10 +5310,10 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t5857 = 0.6000000000e1_dp*t478*t489*t5430 t5861 = 0.5999999999e1_dp*t478*t56*t5122*t17 t5864 = 0.1800000000e2_dp*t473*t1150*t4729 - t5868 = t5833+t5835+t5838+t5841-t5845+t5848-0.3600000000e2_dp & - *t5850-t5854+t5857+t5861-t5864+0.8999999998e1_dp*t178 & + t5868 = t5833 + t5835 + t5838 + t5841 - t5845 + t5848 - 0.3600000000e2_dp & + *t5850 - t5854 + t5857 + t5861 - t5864 + 0.8999999998e1_dp*t178 & *t62*t5613 - t5869 = t5831+t5868 + t5869 = t5831 + t5868 t5875 = t1447*t187*t1722 t5880 = 0.3703703705e-1_dp*t192*t194*t5226*t526 t5881 = t1141*t4701 @@ -5329,12 +5329,12 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t5918 = t140*t1504*t1722 t5922 = 0.1111111112e0_dp*t4776*t515*t517 t5925 = 0.8099999996e2_dp*t498*t4770*t4915 - t5926 = -0.5555555558e-1_dp*t192*t68*t5869*t65-0.1000000000e1_dp & - *t5875+t5880+0.3000000000e1_dp*t1748*t5881*t4940-0.1111111112e0_dp & - *t5885-0.1000000000e1_dp*t5888-t5891+t5869*t65+ & - 0.666666666e0_dp*t1519*t722*t4729*t65+(2*t5898)+t5902 & - -t5905+0.1800000000e2_dp*t5908-t5913-0.1111111112e0_dp*t516 & - *t4898*t172-0.1000000000e1_dp*t5918-t5922+t5925 + t5926 = -0.5555555558e-1_dp*t192*t68*t5869*t65 - 0.1000000000e1_dp & + *t5875 + t5880 + 0.3000000000e1_dp*t1748*t5881*t4940 - 0.1111111112e0_dp & + *t5885 - 0.1000000000e1_dp*t5888 - t5891 + t5869*t65 + & + 0.666666666e0_dp*t1519*t722*t4729*t65 + (2*t5898) + t5902 & + - t5905 + 0.1800000000e2_dp*t5908 - t5913 - 0.1111111112e0_dp*t516 & + *t4898*t172 - 0.1000000000e1_dp*t5918 - t5922 + t5925 t5929 = 0.2250000000e2_dp*t1740*t471*t4905 t5932 = 0.1000000000e1_dp*t649*t266*t1722 t5938 = t192*t728*t1505 @@ -5354,11 +5354,11 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t5973 = 0.5555555558e-1_dp*t4943*t531 t5975 = t5226*t266*t65 t5977 = 0.1111111112e0_dp*t1755*t729 - t5978 = -t5929-t5932+0.3333333334e0_dp*t1519*t187*t4729*t65 & - -0.1111111112e0_dp*t5938-t5942-0.2000000002e1_dp*t5944-0.5555555558e-1_dp & - *t503*t4955+t5949-t5952+t5954+t5958-t5960 & - +t5963-0.1111111112e0_dp*t5964-0.2222222224e0_dp*t5966-t5971 & - -t5973+t5975-t5977 + t5978 = -t5929 - t5932 + 0.3333333334e0_dp*t1519*t187*t4729*t65 & + - 0.1111111112e0_dp*t5938 - t5942 - 0.2000000002e1_dp*t5944 - 0.5555555558e-1_dp & + *t503*t4955 + t5949 - t5952 + t5954 + t5958 - t5960 & + + t5963 - 0.1111111112e0_dp*t5964 - 0.2222222224e0_dp*t5966 - t5971 & + - t5973 + t5975 - t5977 t5985 = 0.5000000001e0_dp*t1774*t4908 t5990 = t177*t4729*t65 t5994 = 0.5000000001e0_dp*t1766*t5990 @@ -5373,12 +5373,12 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t6021 = t649*t1518*t1722 t6023 = t5251*t67 t6025 = 0.3703703705e-1_dp*t6023*t271 - t6029 = 0.5999999993e1_dp*t4946*t722*t4701*t4940-t5985-0.5555555558e-1_dp & - *t192*t199*t4898+0.3333333334e0_dp*t1748*t5990 & - -t5994+t5996-t6000+t6002+0.1800000000e2_dp*t6004-0.1111111112e0_dp & - *t6006-t6009+0.3000000000e1_dp*t4946*t187*t4701 & - *t4940-0.6666666668e0_dp*t1748*t5956-t6017+t6019+0.6666666668e0_dp & - *t6021+t6025-0.5555555558e-1_dp*t58*t5613*t71 + t6029 = 0.5999999993e1_dp*t4946*t722*t4701*t4940 - t5985 - 0.5555555558e-1_dp & + *t192*t199*t4898 + 0.3333333334e0_dp*t1748*t5990 & + - t5994 + t5996 - t6000 + t6002 + 0.1800000000e2_dp*t6004 - 0.1111111112e0_dp & + *t6006 - t6009 + 0.3000000000e1_dp*t4946*t187*t4701 & + *t4940 - 0.6666666668e0_dp*t1748*t5956 - t6017 + t6019 + 0.6666666668e0_dp & + *t6021 + t6025 - 0.5555555558e-1_dp*t58*t5613*t71 t6031 = 0.5000000001e0_dp*t1720*t5990 t6033 = 0.1000000000e1_dp*t5244*t1712 t6036 = 0.2250000000e2_dp*t498*t472*t4905 @@ -5397,18 +5397,18 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t6074 = 0.8099999996e2_dp*t496*t4769*t1141*t4915 t6075 = t723*t6052 t6078 = 0.1111111112e0_dp*t719*t1782 - t6079 = -t6031-t6033-t6036+t187*t4897*t65-t6040-t6042 & - +t6044-t6047-0.1000000000e1_dp*t6049-0.1000000000e1_dp*t6053 & - -t6056-t6058-0.4500000000e1_dp*t6060+t6063+0.6666666668e0_dp & - *t6066-0.1000000000e1_dp*t237*t705*t1722+t6074-0.2000000002e1_dp & - *t6075-t6078 + t6079 = -t6031 - t6033 - t6036 + t187*t4897*t65 - t6040 - t6042 & + + t6044 - t6047 - 0.1000000000e1_dp*t6049 - 0.1000000000e1_dp*t6053 & + - t6056 - t6058 - 0.4500000000e1_dp*t6060 + t6063 + 0.6666666668e0_dp & + *t6066 - 0.1000000000e1_dp*t237*t705*t1722 + t6074 - 0.2000000002e1_dp & + *t6075 - t6078 t6087 = 0.1666666667e0_dp*t429*t1966*t1410 t6090 = 0.3125000000e0_dp*t4025*t1247*t4790 - t6091 = 0.3333333334e0_dp*t5745-t5749-t5752-t5756+t5760+0.1666666667e0_dp & - *t165*t56*t4958*t140+t5767+t5770+t5773+ & - t5776+t5780-t5783+t5786+t5789+t5792-t5795-0.4444444444e0_dp & - *t5797+0.3333333334e0_dp*t55*t57*(t5926+t5978+t6029 & - +t6079)-t6087-t6090 + t6091 = 0.3333333334e0_dp*t5745 - t5749 - t5752 - t5756 + t5760 + 0.1666666667e0_dp & + *t165*t56*t4958*t140 + t5767 + t5770 + t5773 + & + t5776 + t5780 - t5783 + t5786 + t5789 + t5792 - t5795 - 0.4444444444e0_dp & + *t5797 + 0.3333333334e0_dp*t55*t57*(t5926 + t5978 + t6029 & + + t6079) - t6087 - t6090 t6094 = 0.1250000000e0_dp*t1981*t1247*t4801 t6099 = 0.1800000000e2_dp*t1971*t1972*t4729*t149*t160 t6102 = 0.2500000000e0_dp*t1981*t4553*t1410 @@ -5428,21 +5428,21 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t6155 = 0.2500000000e0_dp*t1981*t4032*t1410 t6158 = 0.1666666667e0_dp*t429*t679*t1571 t6160 = t147*t1885*t672 - t6162 = t6094+t6099+t6102+t6106-t6109+t6112-t6116+t6119 & - -t6123+t6126-t6129+t6132-t6136-0.1666666667e0_dp*t6138 & - +0.3600000000e2_dp*t6141+0.3333333334e0_dp*t6144+0.2e1_dp*t147 & - *(t4881-t4884-t4887+0.9000000000e1_dp*t4889-t4893+0.6000000000e1_dp & - *t4895)*t149*t160+t6155-t6158+(4*t6160) + t6162 = t6094 + t6099 + t6102 + t6106 - t6109 + t6112 - t6116 + t6119 & + - t6123 + t6126 - t6129 + t6132 - t6136 - 0.1666666667e0_dp*t6138 & + + 0.3600000000e2_dp*t6141 + 0.3333333334e0_dp*t6144 + 0.2e1_dp*t147 & + *(t4881 - t4884 - t4887 + 0.9000000000e1_dp*t4889 - t4893 + 0.6000000000e1_dp & + *t4895)*t149*t160 + t6155 - t6158 + (4*t6160) t6170 = 0.3333333336e0_dp*t289*t597*t1571 t6173 = 0.3333333336e0_dp*t55*t5295*t140 t6175 = t83*t597*t1688 t6179 = 0.3333333336e0_dp*t165*t3865*t561 t6181 = t289*t1564*t593 t6185 = 0.3333333336e0_dp*t289*t597*t1553 - t6186 = -0.3333333336e0_dp*t5347-t5351-t5354-t5357-t5360-0.2222222224e0_dp & - *t144*t46*(t5423+t5742+t6091+t6162)-t6170 & - -t6173-0.6666666672e0_dp*t6175-t6179-0.3333333336e0_dp*t6181 & - -t6185 + t6186 = -0.3333333336e0_dp*t5347 - t5351 - t5354 - t5357 - t5360 - 0.2222222224e0_dp & + *t144*t46*(t5423 + t5742 + t6091 + t6162) - t6170 & + - t6173 - 0.6666666672e0_dp*t6175 - t6179 - 0.3333333336e0_dp*t6181 & + - t6185 t6189 = 0.8333333340e-1_dp*t906*t294*t5163 t6192 = 0.3333333336e0_dp*t83*t294*t5122 t6194 = t83*t3875*t561 @@ -5454,14 +5454,14 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t6216 = 0.8333333340e-1_dp*t429*t897*t4701 t6219 = 0.8333333340e-1_dp*t906*t384*t4790 t6222 = 0.8333333340e-1_dp*t1546*t897*t4801 - t6223 = t6189-t6192-0.6666666672e0_dp*t6194-t6198-t6201-0.3333333336e0_dp & - *t83*t84*t5613+t6207-t6210-t6213+t6216+ & - t6219+t6222 - t6227 = -t4704-t4707-t4732-t4789+t4793-t4796-t4800-t4804 & - -t4808-t4812-t4857-t4861-0.1333333334e1_dp*t4864-t4869 & - -0.4444444448e0_dp*t43*t46*t5036+t8*(t5305+t5343+t6186 & - +t6223) - e_ndrho_ndrho_rho_spin(ii) = e_ndrho_ndrho_rho_spin(ii)+t6227*sx + t6223 = t6189 - t6192 - 0.6666666672e0_dp*t6194 - t6198 - t6201 - 0.3333333336e0_dp & + *t83*t84*t5613 + t6207 - t6210 - t6213 + t6216 + & + t6219 + t6222 + t6227 = -t4704 - t4707 - t4732 - t4789 + t4793 - t4796 - t4800 - t4804 & + - t4808 - t4812 - t4857 - t4861 - 0.1333333334e1_dp*t4864 - t4869 & + - 0.4444444448e0_dp*t43*t46*t5036 + t8*(t5305 + t5343 + t6186 & + + t6223) + e_ndrho_ndrho_rho_spin(ii) = e_ndrho_ndrho_rho_spin(ii) + t6227*sx t6247 = t4769*t2992 t6249 = t4772*t2027 t6252 = t56*t4701 @@ -5473,145 +5473,145 @@ SUBROUTINE xb88_lr_adiabatic_lsd_calc(rho_spin, norm_drho_spin, e_0, & t6267 = t26*t1447 t6268 = t6267*t709 t6271 = t4764*t2027 - t6281 = -0.1620000000e3_dp*t6247*t4733*t6249-0.1200000000e2_dp* & - t473*t6253+0.5999999999e1_dp*t478*t6257+0.5399999998e2_dp*t4771 & - *t6260+0.8999999998e1_dp*t478*t6263*t65+0.8099999996e2_dp & - *t4771*t6268-0.1800000000e2_dp*t473*t6271-0.4050000000e2_dp & - *t473*t575*t2095-0.5000000001e0_dp*t60*t4853*t65+0.8999999998e1_dp & - *t4901-t4907+t4911 + t6281 = -0.1620000000e3_dp*t6247*t4733*t6249 - 0.1200000000e2_dp* & + t473*t6253 + 0.5999999999e1_dp*t478*t6257 + 0.5399999998e2_dp*t4771 & + *t6260 + 0.8999999998e1_dp*t478*t6263*t65 + 0.8099999996e2_dp & + *t4771*t6268 - 0.1800000000e2_dp*t473*t6271 - 0.4050000000e2_dp & + *t473*t575*t2095 - 0.5000000001e0_dp*t60*t4853*t65 + 0.8999999998e1_dp & + *t4901 - t4907 + t4911 t6283 = t4701*t1518 - t6290 = t4917-t4920+0.5000000001e0_dp*t4922+t4925+0.3333333334e0_dp & - *t6283*t177*t65-0.5000000001e0_dp*t4929-t4932-t4935 & - +0.5850000000e2_dp*t4941+t4945-t4951-0.5555555558e-1_dp*t4952 - t6291 = t6281+t6290 + t6290 = t4917 - t4920 + 0.5000000001e0_dp*t4922 + t4925 + 0.3333333334e0_dp & + *t6283*t177*t65 - 0.5000000001e0_dp*t4929 - t4932 - t4935 & + + 0.5850000000e2_dp*t4941 + t4945 - t4951 - 0.5555555558e-1_dp*t4952 + t6291 = t6281 + t6290 t6308 = 0.4050000000e2_dp*t4734*t4736*t2821*t18*t4739*t237 & - -0.1125000000e2_dp*t2013*t1300*t19*t4790-t5028-t5022+ & - 0.1500000000e1_dp*t2013*t398*t68*t5002+0.3333333334e0_dp*t55 & - *t57*t6291+t5019-0.3000000000e1_dp*t566*t1885*t569-t5016 & - -0.9000000000e1_dp*t4734*t4736*t1300*t4701*t149*t17 & - +t5032+0.1666666667e0_dp*t165*t2088*t561-0.5555555557e-1_dp* & - t5011+t5001 - t6338 = 0.1666666667e0_dp*t4874-t5025-0.2700000000e2_dp*t4734*t392 & - *t4736*t1300*rho*t5002*t149-0.3000000000e1_dp*t2009 & - *t4748-0.2700000000e2_dp*t4738*t18*t1973*t1447-t5008- & - 0.3000000000e1_dp*t567*t151*t19*t4853+t5035-0.1000000000e1_dp & - *t2013*t2018*t5009+0.9000000000e1_dp*t2013*t2014*t4797 & - -t4872+0.4500000000e1_dp*t2013*t2014*t4801+t4878+t5005 & - +0.4500000000e1_dp*t2009*t4744 - t6339 = t6308+t6338 - t6344 = -t5043-t5047-t5050-t5126-t5284-t5291+t5294-t5298 & - -t5301-0.3333333336e0_dp*t5303-t5308-t5311-t5314 - t6352 = t5440-t5443-t5446-t5449-t5451-t5454+0.40e1_dp*t102 & - *t327*t2057*t557-t5456+t5459-t5462+t5466-t5468 - t6363 = t5480-t5482-t5484+t5487-t5489+t5492+t5494-0.9600000000e2_dp & - *t5496+t5499-t5503-t5507+t5509-0.2400000000e2_dp & - *t5511-0.960e2_dp*t5115*t1060-0.240e2_dp*t2054*t3674+0.1200e3_dp & + - 0.1125000000e2_dp*t2013*t1300*t19*t4790 - t5028 - t5022 + & + 0.1500000000e1_dp*t2013*t398*t68*t5002 + 0.3333333334e0_dp*t55 & + *t57*t6291 + t5019 - 0.3000000000e1_dp*t566*t1885*t569 - t5016 & + - 0.9000000000e1_dp*t4734*t4736*t1300*t4701*t149*t17 & + + t5032 + 0.1666666667e0_dp*t165*t2088*t561 - 0.5555555557e-1_dp* & + t5011 + t5001 + t6338 = 0.1666666667e0_dp*t4874 - t5025 - 0.2700000000e2_dp*t4734*t392 & + *t4736*t1300*rho*t5002*t149 - 0.3000000000e1_dp*t2009 & + *t4748 - 0.2700000000e2_dp*t4738*t18*t1973*t1447 - t5008 - & + 0.3000000000e1_dp*t567*t151*t19*t4853 + t5035 - 0.1000000000e1_dp & + *t2013*t2018*t5009 + 0.9000000000e1_dp*t2013*t2014*t4797 & + - t4872 + 0.4500000000e1_dp*t2013*t2014*t4801 + t4878 + t5005 & + + 0.4500000000e1_dp*t2009*t4744 + t6339 = t6308 + t6338 + t6344 = -t5043 - t5047 - t5050 - t5126 - t5284 - t5291 + t5294 - t5298 & + - t5301 - 0.3333333336e0_dp*t5303 - t5308 - t5311 - t5314 + t6352 = t5440 - t5443 - t5446 - t5449 - t5451 - t5454 + 0.40e1_dp*t102 & + *t327*t2057*t557 - t5456 + t5459 - t5462 + t5466 - t5468 + t6363 = t5480 - t5482 - t5484 + t5487 - t5489 + t5492 + t5494 - 0.9600000000e2_dp & + *t5496 + t5499 - t5503 - t5507 + t5509 - 0.2400000000e2_dp & + *t5511 - 0.960e2_dp*t5115*t1060 - 0.240e2_dp*t2054*t3674 + 0.1200e3_dp & *t1054*t640*t3679 - t6367 = t5472-t5474-t5478-t5523+t5525+0.40e1_dp*t5528+t5531 & - +t5533+t5535+t5537-0.20e1_dp*t102*t105*t6363+t5540 - t6370 = t5545-t5548+t5551+t5553-t5558+t5560-t5562+t5564 & - -0.40e1_dp*t5565+t5568+t5572+t5574 - t6373 = t5579-t5581-0.40e1_dp*t112*t2058-t5585+t5590-t5593 & - -t5595+t5597-t5600-t5602+t5604+t5607+t5610 - t6375 = t6352+t6367+t6370+t6373 - t6380 = -t5317-t5320+t5323-t5326-t5329-0.3333333336e0_dp*t83 & - *t597*t2061-0.3333333336e0_dp*t83*t84*t6375+t5333-t5335 & - -t5338-t5342-0.1666666668e0_dp*t5347-t5351 - t6389 = -t5354-t5357-0.3333333336e0_dp*t83*t45*t2139*t561 & - -t5360-t6170-t6173-0.3333333336e0_dp*t6175-t6179-0.1666666668e0_dp & - *t6181-t6185+t6189-t6192-0.3333333336e0_dp*t6194 + t6367 = t5472 - t5474 - t5478 - t5523 + t5525 + 0.40e1_dp*t5528 + t5531 & + + t5533 + t5535 + t5537 - 0.20e1_dp*t102*t105*t6363 + t5540 + t6370 = t5545 - t5548 + t5551 + t5553 - t5558 + t5560 - t5562 + t5564 & + - 0.40e1_dp*t5565 + t5568 + t5572 + t5574 + t6373 = t5579 - t5581 - 0.40e1_dp*t112*t2058 - t5585 + t5590 - t5593 & + - t5595 + t5597 - t5600 - t5602 + t5604 + t5607 + t5610 + t6375 = t6352 + t6367 + t6370 + t6373 + t6380 = -t5317 - t5320 + t5323 - t5326 - t5329 - 0.3333333336e0_dp*t83 & + *t597*t2061 - 0.3333333336e0_dp*t83*t84*t6375 + t5333 - t5335 & + - t5338 - t5342 - 0.1666666668e0_dp*t5347 - t5351 + t6389 = -t5354 - t5357 - 0.3333333336e0_dp*t83*t45*t2139*t561 & + - t5360 - t6170 - t6173 - 0.3333333336e0_dp*t6175 - t6179 - 0.1666666668e0_dp & + *t6181 - t6185 + t6189 - t6192 - 0.3333333336e0_dp*t6194 t6400 = t2061*t561 - t6415 = -t5363+t5367-t5370+0.1111111112e0_dp*t5373-0.5555555557e-1_dp & - *t5376+0.1666666667e0_dp*t5379-t5383-t5386-t5389+ & - 0.1200000000e2_dp*t658*t2031*t673*t17+0.3333333334e0_dp*t170 & - *t27*t6291*t172-t5397 - t6428 = t5635-t5638+t5641+0.2250000000e1_dp*t5643-t5647-0.1500000000e1_dp & - *t151*t50*t6375-t5650+t5653-t5657-t5660 & - +t5663-t5666 - t6433 = t5670-t5673+t5676-t5679+t5682+t5686-t5689+t5692 & - +t5695+0.2250000000e1_dp*t400*t19*t2061*t561+t5698- & + t6415 = -t5363 + t5367 - t5370 + 0.1111111112e0_dp*t5373 - 0.5555555557e-1_dp & + *t5376 + 0.1666666667e0_dp*t5379 - t5383 - t5386 - t5389 + & + 0.1200000000e2_dp*t658*t2031*t673*t17 + 0.3333333334e0_dp*t170 & + *t27*t6291*t172 - t5397 + t6428 = t5635 - t5638 + t5641 + 0.2250000000e1_dp*t5643 - t5647 - 0.1500000000e1_dp & + *t151*t50*t6375 - t5650 + t5653 - t5657 - t5660 & + + t5663 - t5666 + t6433 = t5670 - t5673 + t5676 - t5679 + t5682 + t5686 - t5689 + t5692 & + + t5695 + 0.2250000000e1_dp*t400*t19*t2061*t561 + t5698 - & t5701 - t6442 = t5400+0.1666666667e0_dp*t5402-t5406+0.1666666667e0_dp*t165 & - *t56*t2131*t561+0.1666666667e0_dp*t165*t679*t2061+ & - (2*t147*t149*(t6428+t6433))-t5409-t5412-t5415+ & - t5418+0.1800000000e2_dp*t658*t575*t2074+0.1800000000e2_dp*t5421 - t6451 = -t5426+t5429-0.2222222223e0_dp*t5432+t5436+0.1620000000e3_dp & - *t4995*t6267*t1974+0.1666666667e0_dp*t165*t2088*t649 & - +t5619+t5622-t5625-t5628+t5631+t5716 - t6461 = t5719-t5722-0.8333333335e-1_dp*t5724+0.1200000000e2_dp* & - t658*t6256*t2077-0.3240000000e3_dp*t4994*t6247*t4772*t2082 & - +t5728+t5731-t5734-t5738+t5741+0.1666666667e0_dp*t5745 & - -t5749 - t6479 = -t5752+0.1666666667e0_dp*t445*t2042*rho*t668-t5756 & - -0.3600000000e2_dp*t2081*t575*t673*t237+0.1800000000e2_dp* & - t658*t6263*t161+t5760+t5767+t5770-0.7200000000e2_dp*t2081 & - *t575*t161*t1447+t5773+t5776+t5780 - t6490 = -t5783-0.3600000000e2_dp*t2081*t4764*t2082-0.2400000000e2_dp & - *t2081*t6252*t2077+t5786+t5789+t5792-t5795-0.4444444445e0_dp & - *t5797-t6087-0.8333333335e-1_dp*t429*t166*t6400 & - -t6090+t6094 - t6499 = t6099+0.1666666667e0_dp*t165*t166*t6375+t6102+0.1666666667e0_dp & - *t165*t56*t6291*t140+t6106-t6109+t6112-t6116 & - +t6119-t6123+t6126-t6129 + t6442 = t5400 + 0.1666666667e0_dp*t5402 - t5406 + 0.1666666667e0_dp*t165 & + *t56*t2131*t561 + 0.1666666667e0_dp*t165*t679*t2061 + & + (2*t147*t149*(t6428 + t6433)) - t5409 - t5412 - t5415 + & + t5418 + 0.1800000000e2_dp*t658*t575*t2074 + 0.1800000000e2_dp*t5421 + t6451 = -t5426 + t5429 - 0.2222222223e0_dp*t5432 + t5436 + 0.1620000000e3_dp & + *t4995*t6267*t1974 + 0.1666666667e0_dp*t165*t2088*t649 & + + t5619 + t5622 - t5625 - t5628 + t5631 + t5716 + t6461 = t5719 - t5722 - 0.8333333335e-1_dp*t5724 + 0.1200000000e2_dp* & + t658*t6256*t2077 - 0.3240000000e3_dp*t4994*t6247*t4772*t2082 & + + t5728 + t5731 - t5734 - t5738 + t5741 + 0.1666666667e0_dp*t5745 & + - t5749 + t6479 = -t5752 + 0.1666666667e0_dp*t445*t2042*rho*t668 - t5756 & + - 0.3600000000e2_dp*t2081*t575*t673*t237 + 0.1800000000e2_dp* & + t658*t6263*t161 + t5760 + t5767 + t5770 - 0.7200000000e2_dp*t2081 & + *t575*t161*t1447 + t5773 + t5776 + t5780 + t6490 = -t5783 - 0.3600000000e2_dp*t2081*t4764*t2082 - 0.2400000000e2_dp & + *t2081*t6252*t2077 + t5786 + t5789 + t5792 - t5795 - 0.4444444445e0_dp & + *t5797 - t6087 - 0.8333333335e-1_dp*t429*t166*t6400 & + - t6090 + t6094 + t6499 = t6099 + 0.1666666667e0_dp*t165*t166*t6375 + t6102 + 0.1666666667e0_dp & + *t165*t56*t6291*t140 + t6106 - t6109 + t6112 - t6116 & + + t6119 - t6123 + t6126 - t6129 t6509 = t4853*t65 - t6529 = 0.4999999999e0_dp*t5875-0.5000000001e0_dp*t5244*t2095-0.5000000001e0_dp & - *t732*t6509+t5880+0.1000000000e1_dp*t649*t471 & - *t2099-0.1620000000e3_dp*t5247*t2992*t4733*t6249-0.5555555558e-1_dp & - *t5885+0.8999999998e1_dp*t140*t2992*t4701*t59* & - t62*t2027-0.5000000001e0_dp*t5888-t5891-0.1800000000e2_dp*t2118 & + t6529 = 0.4999999999e0_dp*t5875 - 0.5000000001e0_dp*t5244*t2095 - 0.5000000001e0_dp & + *t732*t6509 + t5880 + 0.1000000000e1_dp*t649*t471 & + *t2099 - 0.1620000000e3_dp*t5247*t2992*t4733*t6249 - 0.5555555558e-1_dp & + *t5885 + 0.8999999998e1_dp*t140*t2992*t4701*t59* & + t62*t2027 - 0.5000000001e0_dp*t5888 - t5891 - 0.1800000000e2_dp*t2118 & *t6271 - t6539 = t5898+t5902-t5905+0.8999999998e1_dp*t5908-t5913+0.2000000000e1_dp & - *t2098*t2095*t561-0.5000000001e0_dp*t5918-t5922 & - +0.3333333334e0_dp*t6283*t187*t177*t65+t5925-t5929 - t6554 = -t5932-0.5555555558e-1_dp*t5938+0.666666666e0_dp*t6283* & - t722*t177*t65-t5942+0.8999999998e1_dp*t2124*t59*t177* & - t710+0.1000000001e1_dp*t5944-0.5000000001e0_dp*t2061*t177*t709 & - +t5949+t5952+t5954-t5958 + t6539 = t5898 + t5902 - t5905 + 0.8999999998e1_dp*t5908 - t5913 + 0.2000000000e1_dp & + *t2098*t2095*t561 - 0.5000000001e0_dp*t5918 - t5922 & + + 0.3333333334e0_dp*t6283*t187*t177*t65 + t5925 - t5929 + t6554 = -t5932 - 0.5555555558e-1_dp*t5938 + 0.666666666e0_dp*t6283* & + t722*t177*t65 - t5942 + 0.8999999998e1_dp*t2124*t59*t177* & + t710 + 0.1000000001e1_dp*t5944 - 0.5000000001e0_dp*t2061*t177*t709 & + + t5949 + t5952 + t5954 - t5958 t6557 = t1447*t59 - t6569 = -t5960-0.5000000001e0_dp*t5237*t2095+t5963-0.4500000000e1_dp & - *t5256*t6557*t710-0.5555555558e-1_dp*t5964-0.1111111112e0_dp & - *t5966-t5971-0.1200000000e2_dp*t2118*t6253-0.5555555558e-1_dp & - *t719*t2126-t5973+t5975+0.5999999999e1_dp*t2114*t6257 - t6583 = -t5977-t5985+t5994-0.5000000001e0_dp*t716*t6509+t5996 & - -t6000+t6002+0.8999999998e1_dp*t6004+0.1000000000e1_dp*t2098 & - *t4908*t237-0.1000000001e1_dp*t723*t6509-0.1800000000e2_dp & + t6569 = -t5960 - 0.5000000001e0_dp*t5237*t2095 + t5963 - 0.4500000000e1_dp & + *t5256*t6557*t710 - 0.5555555558e-1_dp*t5964 - 0.1111111112e0_dp & + *t5966 - t5971 - 0.1200000000e2_dp*t2118*t6253 - 0.5555555558e-1_dp & + *t719*t2126 - t5973 + t5975 + 0.5999999999e1_dp*t2114*t6257 + t6583 = -t5977 - t5985 + t5994 - 0.5000000001e0_dp*t716*t6509 + t5996 & + - t6000 + t6002 + 0.8999999998e1_dp*t6004 + 0.1000000000e1_dp*t2098 & + *t4908*t237 - 0.1000000001e1_dp*t723*t6509 - 0.1800000000e2_dp & *t5228*t2117*t2028 t6596 = t5247*t1141*t4733 - t6603 = -0.5555555558e-1_dp*t6006-t6009-t6017-0.5555555558e-1_dp & - *t58*t6375*t71+t6019-0.9000000007e1_dp*t5262*t6557*t710 & - +0.8999999998e1_dp*t708*t62*t6509+0.3333333334e0_dp*t6021+ & - t6025+0.8099999996e2_dp*t6596*t6268+0.5399999998e2_dp*t6596* & - t6260+0.8999999998e1_dp*t5229*t2104 - t6611 = t5801-t5804-t5807+t5810-t5813+t5816-t5819-t5822 & - -t5825-t5828-t5830+t5833 - t6620 = t5835+t5838+t5841-t5845+t5848-0.1800000000e2_dp*t5850 & - -t5854+t5857+t5861-t5864-0.1800000000e2_dp*t473*t20 & - *t2061*t561+0.8999999998e1_dp*t178*t62*t6375 - t6621 = t6611+t6620 - t6630 = -0.3000000000e1_dp*t5256*t4904*t237+0.5999999999e1_dp*t5228 & - *t2113*t2032+t6621*t65-t6031-0.4050000000e2_dp*t471 & - *t187*t6557*t710-t6033-t6036-t6040+t6042-0.5000000001e0_dp & - *t60*t2124*t709-t6044 - t6640 = -t6047-0.5000000001e0_dp*t6049-0.5555555558e-1_dp*t192* & - t68*t6621*t65-0.5000000001e0_dp*t6053-t6056-t6058+0.5850000000e2_dp & - *t6060+t6063+0.3333333334e0_dp*t6066+t6074-0.1000000001e1_dp & - *t6075-t6078 - t6658 = 0.1800000000e2_dp*t658*t2035*t673-0.8333333335e-1_dp*t429 & - *t2088*t593+t6132+0.3333333334e0_dp*t55*t57*(t6529+ & - t6539+t6554+t6569+t6583+t6603+t6630+t6640)-t6136-0.8333333335e-1_dp & - *t6138+0.1800000000e2_dp*t6141+0.1080000000e3_dp* & - t4995*t4743*t2077+0.1080000000e3_dp*t657*t1142*t4760*t2082 & - +0.1666666667e0_dp*t6144+t6155-t6158+(2*t6160) - t6665 = -0.3333333336e0_dp*t83*t45*t6339*t140-t6198-0.3333333336e0_dp & - *t83*t2050*t649-t6201+t6207-t6210-t6213+t6216 & - +t6219-0.1666666668e0_dp*t289*t2050*t593-0.1666666668e0_dp & - *t289*t84*t6400+t6222-0.2222222224e0_dp*t144*t46*(t6415 & - +t6442+t6451+t6461+t6479+t6490+t6499+t6658) - t6669 = -t4704-t4707-t4732+t4793-t4796-t4800-t4804-t4861 & - -0.6666666672e0_dp*t4864-t4869-t4812-t4857-t4789-t4808 & - -0.6666666672e0_dp*t217*t46*t2046*t561-0.4444444448e0_dp* & - t43*t46*t6339+t8*(t6344+t6380+t6389+t6665) - e_ndrho_ndrho_ndrho_spin(ii) = e_ndrho_ndrho_ndrho_spin(ii)+t6669*sx + t6603 = -0.5555555558e-1_dp*t6006 - t6009 - t6017 - 0.5555555558e-1_dp & + *t58*t6375*t71 + t6019 - 0.9000000007e1_dp*t5262*t6557*t710 & + + 0.8999999998e1_dp*t708*t62*t6509 + 0.3333333334e0_dp*t6021 + & + t6025 + 0.8099999996e2_dp*t6596*t6268 + 0.5399999998e2_dp*t6596* & + t6260 + 0.8999999998e1_dp*t5229*t2104 + t6611 = t5801 - t5804 - t5807 + t5810 - t5813 + t5816 - t5819 - t5822 & + - t5825 - t5828 - t5830 + t5833 + t6620 = t5835 + t5838 + t5841 - t5845 + t5848 - 0.1800000000e2_dp*t5850 & + - t5854 + t5857 + t5861 - t5864 - 0.1800000000e2_dp*t473*t20 & + *t2061*t561 + 0.8999999998e1_dp*t178*t62*t6375 + t6621 = t6611 + t6620 + t6630 = -0.3000000000e1_dp*t5256*t4904*t237 + 0.5999999999e1_dp*t5228 & + *t2113*t2032 + t6621*t65 - t6031 - 0.4050000000e2_dp*t471 & + *t187*t6557*t710 - t6033 - t6036 - t6040 + t6042 - 0.5000000001e0_dp & + *t60*t2124*t709 - t6044 + t6640 = -t6047 - 0.5000000001e0_dp*t6049 - 0.5555555558e-1_dp*t192* & + t68*t6621*t65 - 0.5000000001e0_dp*t6053 - t6056 - t6058 + 0.5850000000e2_dp & + *t6060 + t6063 + 0.3333333334e0_dp*t6066 + t6074 - 0.1000000001e1_dp & + *t6075 - t6078 + t6658 = 0.1800000000e2_dp*t658*t2035*t673 - 0.8333333335e-1_dp*t429 & + *t2088*t593 + t6132 + 0.3333333334e0_dp*t55*t57*(t6529 + & + t6539 + t6554 + t6569 + t6583 + t6603 + t6630 + t6640) - t6136 - 0.8333333335e-1_dp & + *t6138 + 0.1800000000e2_dp*t6141 + 0.1080000000e3_dp* & + t4995*t4743*t2077 + 0.1080000000e3_dp*t657*t1142*t4760*t2082 & + + 0.1666666667e0_dp*t6144 + t6155 - t6158 + (2*t6160) + t6665 = -0.3333333336e0_dp*t83*t45*t6339*t140 - t6198 - 0.3333333336e0_dp & + *t83*t2050*t649 - t6201 + t6207 - t6210 - t6213 + t6216 & + + t6219 - 0.1666666668e0_dp*t289*t2050*t593 - 0.1666666668e0_dp & + *t289*t84*t6400 + t6222 - 0.2222222224e0_dp*t144*t46*(t6415 & + + t6442 + t6451 + t6461 + t6479 + t6490 + t6499 + t6658) + t6669 = -t4704 - t4707 - t4732 + t4793 - t4796 - t4800 - t4804 - t4861 & + - 0.6666666672e0_dp*t4864 - t4869 - t4812 - t4857 - t4789 - t4808 & + - 0.6666666672e0_dp*t217*t46*t2046*t561 - 0.4444444448e0_dp* & + t43*t46*t6339 + t8*(t6344 + t6380 + t6389 + t6665) + e_ndrho_ndrho_ndrho_spin(ii) = e_ndrho_ndrho_ndrho_spin(ii) + t6669*sx END IF END IF END DO diff --git a/src/xc/xc_xbecke_roussel.F b/src/xc/xc_xbecke_roussel.F index e2c1df060a..d4f26f9baf 100644 --- a/src/xc/xc_xbecke_roussel.F +++ b/src/xc/xc_xbecke_roussel.F @@ -191,7 +191,7 @@ SUBROUTINE xbecke_roussel_lda_eval(rho_set, deriv_set, grad_deriv, br_params) CALL xc_rho_set_get(rho_set, rho=rho, norm_drho=norm_drho, & tau=tau, laplace_rho=laplace_rho, local_bounds=bo, & rho_cutoff=epsilon_rho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rho @@ -308,7 +308,7 @@ SUBROUTINE xbecke_roussel_lda_calc(rho, norm_drho, laplace_rho, tau, e_0, e_rho, t8 = my_ndrho**2 t9 = 0.1e1_dp/my_rho ! *** CP2K defines tau in a different way as compared to Becke !!! - t15 = my_laplace_rho/0.6e1_dp-gamma*(2.0_dp*my_tau-t8*t9/0.4e1_dp)/0.3e1_dp + t15 = my_laplace_rho/0.6e1_dp - gamma*(2.0_dp*my_tau - t8*t9/0.4e1_dp)/0.3e1_dp t16 = 0.1e1_dp/t15 yval = 0.2e1_dp/0.3e1_dp*t2*t5*t16 IF (R == 0.0_dp) THEN @@ -318,16 +318,16 @@ SUBROUTINE xbecke_roussel_lda_calc(rho, norm_drho, laplace_rho, tau, e_0, e_rho, e_rho(ip), e_ndrho(ip), e_tau(ip), e_laplace_rho(ip), & sx, gamma, grad_deriv) ! VERY UGLY HACK e_0 has to multiplied by the factor 2 - e_diff = e_0(ip)-e_old - e_0(ip) = e_0(ip)+e_diff + e_diff = e_0(ip) - e_old + e_0(ip) = e_0(ip) + e_diff ELSE e_old = e_0(ip) CALL x_br_lsd_y_gt_0(my_rho, my_ndrho, my_tau, my_laplace_rho, e_0(ip), & e_rho(ip), e_ndrho(ip), e_tau(ip), e_laplace_rho(ip), & sx, gamma, grad_deriv) ! VERY UGLY HACK e_0 has to multiplied by the factor 2 - e_diff = e_0(ip)-e_old - e_0(ip) = e_0(ip)+e_diff + e_diff = e_0(ip) - e_old + e_0(ip) = e_0(ip) + e_diff END IF ELSE IF (yval <= 0.0_dp) THEN @@ -336,16 +336,16 @@ SUBROUTINE xbecke_roussel_lda_calc(rho, norm_drho, laplace_rho, tau, e_0, e_rho, e_rho(ip), e_ndrho(ip), e_tau(ip), e_laplace_rho(ip), & sx, R, gamma, grad_deriv) ! VERY UGLY HACK e_0 has to multiplied by the factor 2 - e_diff = e_0(ip)-e_old - e_0(ip) = e_0(ip)+e_diff + e_diff = e_0(ip) - e_old + e_0(ip) = e_0(ip) + e_diff ELSE e_old = e_0(ip) CALL x_br_lsd_y_gt_0_cutoff(my_rho, my_ndrho, my_tau, my_laplace_rho, e_0(ip), & e_rho(ip), e_ndrho(ip), e_tau(ip), e_laplace_rho(ip), & sx, R, gamma, grad_deriv) ! VERY UGLY HACK e_0 has to multiplied by the factor 2 - e_diff = e_0(ip)-e_old - e_0(ip) = e_0(ip)+e_diff + e_diff = e_0(ip) - e_old + e_0(ip) = e_0(ip) + e_diff END IF END IF END IF @@ -398,7 +398,7 @@ SUBROUTINE xbecke_roussel_lsd_eval(rho_set, deriv_set, grad_deriv, br_params) norm_drhob=norm_drhob, tau_a=tau_a, tau_b=tau_b, laplace_rhoa=laplace_rhoa, & laplace_rhob=laplace_rhob, local_bounds=bo, & rho_cutoff=epsilon_rho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rhoa @@ -540,7 +540,7 @@ SUBROUTINE xbecke_roussel_lsd_calc(rho, norm_drho, laplace_rho, tau, e_0, e_rho, t8 = my_ndrho**2 t9 = 0.1e1_dp/my_rho ! *** CP2K defines tau in a different way as compared to Becke !!! - t15 = my_laplace_rho/0.6e1_dp-gamma*(2.0_dp*my_tau-t8*t9/0.4e1_dp)/0.3e1_dp + t15 = my_laplace_rho/0.6e1_dp - gamma*(2.0_dp*my_tau - t8*t9/0.4e1_dp)/0.3e1_dp t16 = 0.1e1_dp/t15 yval = 0.2e1_dp/0.3e1_dp*t2*t5*t16 IF (R == 0.0_dp) THEN @@ -619,7 +619,7 @@ SUBROUTINE x_br_lsd_y_lte_0(rho, ndrho, tau, laplace_rho, e_0, & t4 = t3**2 t5 = t4*rho t9 = ndrho**2 - t16 = laplace_rho/0.6e1_dp-gamma*(REAL(2*tau, KIND=dp)-t9/rho/0.4e1_dp)/0.3e1_dp + t16 = laplace_rho/0.6e1_dp - gamma*(REAL(2*tau, KIND=dp) - t9/rho/0.4e1_dp)/0.3e1_dp t17 = 0.1e1_dp/t16 yval = 0.2e1_dp/0.3e1_dp*t2*t5*t17 t19 = t3*rho @@ -627,9 +627,9 @@ SUBROUTINE x_br_lsd_y_lte_0(rho, ndrho, tau, laplace_rho, e_0, & t21 = t19*t20 t22 = br_a1*t2 t23 = t5*t17 - t26 = 0.2e1_dp/0.3e1_dp*t22*t23+br_a2 + t26 = 0.2e1_dp/0.3e1_dp*t22*t23 + br_a2 t27 = ATAN(t26) - t28 = -t27+br_a3 + t28 = -t27 + br_a3 t29 = br_c1*t2 t32 = t1*pi t33 = br_c2*t32 @@ -658,8 +658,8 @@ SUBROUTINE x_br_lsd_y_lte_0(rho, ndrho, tau, laplace_rho, e_0, & t64 = t3*t63 t66 = 0.1e1_dp/t55/t16 t67 = t64*t66 - t70 = br_c0+0.2e1_dp/0.3e1_dp*t29*t23+0.4e1_dp/0.9e1_dp*t33*t39 & - +0.8e1_dp/0.27e2_dp*t43*t48+0.16e2_dp/0.81e2_dp*t52*t57+0.32e2_dp & + t70 = br_c0 + 0.2e1_dp/0.3e1_dp*t29*t23 + 0.4e1_dp/0.9e1_dp*t33*t39 & + + 0.8e1_dp/0.27e2_dp*t43*t48 + 0.16e2_dp/0.81e2_dp*t52*t57 + 0.32e2_dp & /0.243e3_dp*t62*t67 t71 = t28*t70 t72 = br_b1*t2 @@ -667,8 +667,8 @@ SUBROUTINE x_br_lsd_y_lte_0(rho, ndrho, tau, laplace_rho, e_0, & t78 = br_b3*t42 t81 = br_b4*t51 t84 = br_b5*t61 - t87 = br_b0+0.2e1_dp/0.3e1_dp*t72*t23+0.4e1_dp/0.9e1_dp*t75*t39 & - +0.8e1_dp/0.27e2_dp*t78*t48+0.16e2_dp/0.81e2_dp*t81*t57+0.32e2_dp & + t87 = br_b0 + 0.2e1_dp/0.3e1_dp*t72*t23 + 0.4e1_dp/0.9e1_dp*t75*t39 & + + 0.8e1_dp/0.27e2_dp*t78*t48 + 0.16e2_dp/0.81e2_dp*t81*t57 + 0.32e2_dp & /0.243e3_dp*t84*t67 t88 = 0.1e1_dp/t87 t89 = t71*t88 @@ -679,19 +679,19 @@ SUBROUTINE x_br_lsd_y_lte_0(rho, ndrho, tau, laplace_rho, e_0, & t95 = t93*t94 t96 = EXP(-t89) t97 = t88*t96 - t100 = 0.1e1_dp-t96-t71*t97/0.2e1_dp + t100 = 0.1e1_dp - t96 - t71*t97/0.2e1_dp t101 = t87*t100 t102 = t95*t101 - e_0 = e_0+(-t92*t102)*sx + e_0 = e_0 + (-t92*t102)*sx END IF IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN t108 = t4*t17 t111 = 0.1e1_dp/t3 t113 = t38*gamma t114 = t113*t9 - t117 = 0.10e2_dp/0.9e1_dp*t22*t108+t22*t111*t114/0.18e2_dp + t117 = 0.10e2_dp/0.9e1_dp*t22*t108 + t22*t111*t114/0.18e2_dp t118 = t26**2 - t120 = 0.1e1_dp/(0.1e1_dp+t118) + t120 = 0.1e1_dp/(0.1e1_dp + t118) t121 = t117*t120 t122 = t70*t88 t129 = t3*t34 @@ -712,22 +712,22 @@ SUBROUTINE x_br_lsd_y_lte_0(rho, ndrho, tau, laplace_rho, e_0, & t164 = 0.1e1_dp/t55/t37 t165 = t164*gamma t166 = t165*t9 - t169 = 0.10e2_dp/0.9e1_dp*t29*t108+t29*t111*t114/0.18e2_dp+0.40e2_dp & - /0.27e2_dp*t33*t130+0.2e1_dp/0.27e2_dp*t33*t19*t135+ & - 0.40e2_dp/0.27e2_dp*t43*t138+0.2e1_dp/0.27e2_dp*t43*t35*t143+ & - 0.320e3_dp/0.243e3_dp*t52*t147+0.16e2_dp/0.243e3_dp*t52*t150* & - t153+0.800e3_dp/0.729e3_dp*t62*t158+0.40e2_dp/0.729e3_dp*t62*t161 & + t169 = 0.10e2_dp/0.9e1_dp*t29*t108 + t29*t111*t114/0.18e2_dp + 0.40e2_dp & + /0.27e2_dp*t33*t130 + 0.2e1_dp/0.27e2_dp*t33*t19*t135 + & + 0.40e2_dp/0.27e2_dp*t43*t138 + 0.2e1_dp/0.27e2_dp*t43*t35*t143 + & + 0.320e3_dp/0.243e3_dp*t52*t147 + 0.16e2_dp/0.243e3_dp*t52*t150* & + t153 + 0.800e3_dp/0.729e3_dp*t62*t158 + 0.40e2_dp/0.729e3_dp*t62*t161 & *t166 t170 = t28*t169 t172 = t87**2 t173 = 0.1e1_dp/t172 - t199 = 0.10e2_dp/0.9e1_dp*t72*t108+t72*t111*t114/0.18e2_dp+0.40e2_dp & - /0.27e2_dp*t75*t130+0.2e1_dp/0.27e2_dp*t75*t19*t135+ & - 0.40e2_dp/0.27e2_dp*t78*t138+0.2e1_dp/0.27e2_dp*t78*t35*t143+ & - 0.320e3_dp/0.243e3_dp*t81*t147+0.16e2_dp/0.243e3_dp*t81*t150* & - t153+0.800e3_dp/0.729e3_dp*t84*t158+0.40e2_dp/0.729e3_dp*t84*t161 & + t199 = 0.10e2_dp/0.9e1_dp*t72*t108 + t72*t111*t114/0.18e2_dp + 0.40e2_dp & + /0.27e2_dp*t75*t130 + 0.2e1_dp/0.27e2_dp*t75*t19*t135 + & + 0.40e2_dp/0.27e2_dp*t78*t138 + 0.2e1_dp/0.27e2_dp*t78*t35*t143 + & + 0.320e3_dp/0.243e3_dp*t81*t147 + 0.16e2_dp/0.243e3_dp*t81*t150* & + t153 + 0.800e3_dp/0.729e3_dp*t84*t158 + 0.40e2_dp/0.729e3_dp*t84*t161 & *t166 - t202 = -t121*t122+t170*t88-t71*t173*t199 + t202 = -t121*t122 + t170*t88 - t71*t173*t199 t207 = t28**2 t208 = 0.1e1_dp/t207 t209 = t91*t208 @@ -737,11 +737,11 @@ SUBROUTINE x_br_lsd_y_lte_0(rho, ndrho, tau, laplace_rho, e_0, & t227 = -t202 t229 = t122*t96 t234 = t173*t96 - e_rho = e_rho+(-0.4e1_dp/0.3e1_dp*t3*t20*t91*t102-t21*t202*t91* & - t102/0.3e1_dp-t21*t209*t94*t87*t100*t117*t120+t217 & - *t220*t100*t169-t92*t95*t199*t100-t92*t95*t87* & - (-t227*t96+t121*t229/0.2e1_dp-t170*t97/0.2e1_dp+t71*t234 & - *t199/0.2e1_dp-t71*t88*t227*t96/0.2e1_dp))*sx + e_rho = e_rho + (-0.4e1_dp/0.3e1_dp*t3*t20*t91*t102 - t21*t202*t91* & + t102/0.3e1_dp - t21*t209*t94*t87*t100*t117*t120 + t217 & + *t220*t100*t169 - t92*t95*t199*t100 - t92*t95*t87* & + (-t227*t96 + t121*t229/0.2e1_dp - t170*t97/0.2e1_dp + t71*t234 & + *t199/0.2e1_dp - t71*t88*t227*t96/0.2e1_dp))*sx t246 = t4*t38 t249 = t120*t70 t252 = t22*t246*gamma*ndrho*t249*t88 @@ -750,25 +750,25 @@ SUBROUTINE x_br_lsd_y_lte_0(rho, ndrho, tau, laplace_rho, e_0, & t263 = t142*ndrho t267 = t152*ndrho t271 = t165*ndrho - t274 = -t29*t4*t255/0.9e1_dp-0.4e1_dp/0.27e2_dp*t33*t129*t259 & - -0.4e1_dp/0.27e2_dp*t43*t44*t263-0.32e2_dp/0.243e3_dp*t52*t146 & - *t267-0.80e2_dp/0.729e3_dp*t62*t157*t271 + t274 = -t29*t4*t255/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t33*t129*t259 & + - 0.4e1_dp/0.27e2_dp*t43*t44*t263 - 0.32e2_dp/0.243e3_dp*t52*t146 & + *t267 - 0.80e2_dp/0.729e3_dp*t62*t157*t271 t275 = t28*t274 t276 = t275*t88 - t293 = -t72*t4*t255/0.9e1_dp-0.4e1_dp/0.27e2_dp*t75*t129*t259 & - -0.4e1_dp/0.27e2_dp*t78*t44*t263-0.32e2_dp/0.243e3_dp*t81*t146 & - *t267-0.80e2_dp/0.729e3_dp*t84*t157*t271 + t293 = -t72*t4*t255/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t75*t129*t259 & + - 0.4e1_dp/0.27e2_dp*t78*t44*t263 - 0.32e2_dp/0.243e3_dp*t81*t146 & + *t267 - 0.80e2_dp/0.729e3_dp*t84*t157*t271 t295 = t71*t173*t293 t304 = t208*t94*t87 t307 = t100*br_a1*t2 t308 = ndrho*t120 - t320 = -t252/0.9e1_dp-t276+t295 - e_ndrho = e_ndrho+(-t21*(t252/0.27e2_dp+t276/0.3e1_dp-t295/0.3e1_dp)*t91 & - *t102+t34*t20*t91*t304*t307*t113*t308/0.9e1_dp+t217 & - *t220*t100*t274-t92*t95*t293*t100-t92*t95*t87 & - *(-t320*t96-t22*t246*gamma*t308*t229/0.18e2_dp-t275 & - *t97/0.2e1_dp+t71*t234*t293/0.2e1_dp-t71*t88*t320*t96 & - /0.2e1_dp))*sx + t320 = -t252/0.9e1_dp - t276 + t295 + e_ndrho = e_ndrho + (-t21*(t252/0.27e2_dp + t276/0.3e1_dp - t295/0.3e1_dp)*t91 & + *t102 + t34*t20*t91*t304*t307*t113*t308/0.9e1_dp + t217 & + *t220*t100*t274 - t92*t95*t293*t100 - t92*t95*t87 & + *(-t320*t96 - t22*t246*gamma*t308*t229/0.18e2_dp - t275 & + *t97/0.2e1_dp + t71*t234*t293/0.2e1_dp - t71*t88*t320*t96 & + /0.2e1_dp))*sx t340 = t5*t38 t341 = t22*t340 t342 = gamma*t120 @@ -782,39 +782,39 @@ SUBROUTINE x_br_lsd_y_lte_0(rho, ndrho, tau, laplace_rho, e_0, & t358 = t357*gamma t361 = t64*t164 t362 = t361*gamma - t365 = 0.4e1_dp/0.9e1_dp*t29*t346+0.16e2_dp/0.27e2_dp*t33*t350+ & - 0.16e2_dp/0.27e2_dp*t43*t354+0.128e3_dp/0.243e3_dp*t52*t358+0.320e3_dp & + t365 = 0.4e1_dp/0.9e1_dp*t29*t346 + 0.16e2_dp/0.27e2_dp*t33*t350 + & + 0.16e2_dp/0.27e2_dp*t43*t354 + 0.128e3_dp/0.243e3_dp*t52*t358 + 0.320e3_dp & /0.729e3_dp*t62*t362 t366 = t28*t365 t367 = t366*t88 - t379 = 0.4e1_dp/0.9e1_dp*t72*t346+0.16e2_dp/0.27e2_dp*t75*t350+ & - 0.16e2_dp/0.27e2_dp*t78*t354+0.128e3_dp/0.243e3_dp*t81*t358+0.320e3_dp & + t379 = 0.4e1_dp/0.9e1_dp*t72*t346 + 0.16e2_dp/0.27e2_dp*t75*t350 + & + 0.16e2_dp/0.27e2_dp*t78*t354 + 0.128e3_dp/0.243e3_dp*t81*t358 + 0.320e3_dp & /0.729e3_dp*t84*t362 t381 = t71*t173*t379 t387 = t35*t20 - t401 = 0.4e1_dp/0.9e1_dp*t344-t367+t381 - e_tau = e_tau+(-t21*(-0.4e1_dp/0.27e2_dp*t344+t367/0.3e1_dp-t381/0.3e1_dp) & - *t91*t102-0.4e1_dp/0.9e1_dp*t387*t91*t304*t307*t113* & - t120+t217*t220*t100*t365-t92*t95*t379*t100-t92 & - *t95*t87*(-t401*t96+0.2e1_dp/0.9e1_dp*t341*t342*t229- & - t366*t97/0.2e1_dp+t71*t234*t379/0.2e1_dp-t71*t88*t401 & - *t96/0.2e1_dp))*sx + t401 = 0.4e1_dp/0.9e1_dp*t344 - t367 + t381 + e_tau = e_tau + (-t21*(-0.4e1_dp/0.27e2_dp*t344 + t367/0.3e1_dp - t381/0.3e1_dp) & + *t91*t102 - 0.4e1_dp/0.9e1_dp*t387*t91*t304*t307*t113* & + t120 + t217*t220*t100*t365 - t92*t95*t379*t100 - t92 & + *t95*t87*(-t401*t96 + 0.2e1_dp/0.9e1_dp*t341*t342*t229 - & + t366*t97/0.2e1_dp + t71*t234*t379/0.2e1_dp - t71*t88*t401 & + *t96/0.2e1_dp))*sx t422 = t22*t5*t38*t120*t122 - t434 = -t29*t340/0.9e1_dp-0.4e1_dp/0.27e2_dp*t33*t349-0.4e1_dp/ & - 0.27e2_dp*t43*t353-0.32e2_dp/0.243e3_dp*t52*t357-0.80e2_dp/0.729e3_dp & + t434 = -t29*t340/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t33*t349 - 0.4e1_dp/ & + 0.27e2_dp*t43*t353 - 0.32e2_dp/0.243e3_dp*t52*t357 - 0.80e2_dp/0.729e3_dp & *t62*t361 t435 = t28*t434 t436 = t435*t88 - t448 = -t72*t340/0.9e1_dp-0.4e1_dp/0.27e2_dp*t75*t349-0.4e1_dp/ & - 0.27e2_dp*t78*t353-0.32e2_dp/0.243e3_dp*t81*t357-0.80e2_dp/0.729e3_dp & + t448 = -t72*t340/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t75*t349 - 0.4e1_dp/ & + 0.27e2_dp*t78*t353 - 0.32e2_dp/0.243e3_dp*t81*t357 - 0.80e2_dp/0.729e3_dp & *t84*t361 t450 = t71*t173*t448 - t471 = -t422/0.9e1_dp-t436+t450 - e_laplace_rho = e_laplace_rho+(-t21*(t422/0.27e2_dp+t436/0.3e1_dp-t450/0.3e1_dp)*t91* & - t102+t387*t209*t94*t101*br_a1*t2*t38*t120/0.9e1_dp & - +t217*t220*t100*t434-t92*t95*t448*t100-t92*t95 & - *t87*(-t471*t96-t341*t249*t97/0.18e2_dp-t435*t97/0.2e1_dp & - +t71*t234*t448/0.2e1_dp-t71*t88*t471*t96/0.2e1_dp))*sx + t471 = -t422/0.9e1_dp - t436 + t450 + e_laplace_rho = e_laplace_rho + (-t21*(t422/0.27e2_dp + t436/0.3e1_dp - t450/0.3e1_dp)*t91* & + t102 + t387*t209*t94*t101*br_a1*t2*t38*t120/0.9e1_dp & + + t217*t220*t100*t434 - t92*t95*t448*t100 - t92*t95 & + *t87*(-t471*t96 - t341*t249*t97/0.18e2_dp - t435*t97/0.2e1_dp & + + t71*t234*t448/0.2e1_dp - t71*t88*t471*t96/0.2e1_dp))*sx END IF END SUBROUTINE x_br_lsd_y_lte_0 @@ -867,7 +867,7 @@ SUBROUTINE x_br_lsd_y_gt_0(rho, ndrho, tau, laplace_rho, e_0, & t5 = t4*rho t6 = t2*t5 t9 = ndrho**2 - t16 = laplace_rho/0.6e1_dp-gamma*(REAL(2*tau, KIND=dp)-t9/rho/0.4e1_dp)/0.3e1_dp + t16 = laplace_rho/0.6e1_dp - gamma*(REAL(2*tau, KIND=dp) - t9/rho/0.4e1_dp)/0.3e1_dp t17 = 0.1e1_dp/t16 yval = 0.2e1_dp/0.3e1_dp*t6*t17 t19 = t3*rho @@ -887,13 +887,13 @@ SUBROUTINE x_br_lsd_y_gt_0(rho, ndrho, tau, laplace_rho, e_0, & t35 = t16**2 t36 = 0.1e1_dp/t35 t37 = t34*t36 - t41 = SQRT(0.10e1_dp+0.4e1_dp/0.9e1_dp*t31*t37) + t41 = SQRT(0.10e1_dp + 0.4e1_dp/0.9e1_dp*t31*t37) t42 = t41*t22 t43 = t23*t25 - t47 = 0.1500000000000000e1_dp*t24*t26+0.3e1_dp/0.2e1_dp*t42*t43 & + t47 = 0.1500000000000000e1_dp*t24*t26 + 0.3e1_dp/0.2e1_dp*t42*t43 & *t16 t48 = LOG(t47) - t49 = t48+0.2e1_dp + t49 = t48 + 0.2e1_dp t50 = br_d1*t2 t51 = t5*t17 t54 = br_d2*t30 @@ -916,8 +916,8 @@ SUBROUTINE x_br_lsd_y_gt_0(rho, ndrho, tau, laplace_rho, e_0, & t79 = t3*t78 t81 = 0.1e1_dp/t70/t16 t82 = t79*t81 - t85 = br_d0+0.2e1_dp/0.3e1_dp*t50*t51+0.4e1_dp/0.9e1_dp*t54*t37 & - +0.8e1_dp/0.27e2_dp*t58*t63+0.16e2_dp/0.81e2_dp*t67*t72+0.32e2_dp & + t85 = br_d0 + 0.2e1_dp/0.3e1_dp*t50*t51 + 0.4e1_dp/0.9e1_dp*t54*t37 & + + 0.8e1_dp/0.27e2_dp*t58*t63 + 0.16e2_dp/0.81e2_dp*t67*t72 + 0.32e2_dp & /0.243e3_dp*t77*t82 t86 = t49*t85 t87 = br_e1*t2 @@ -925,8 +925,8 @@ SUBROUTINE x_br_lsd_y_gt_0(rho, ndrho, tau, laplace_rho, e_0, & t93 = br_e3*t57 t96 = br_e4*t66 t99 = br_e5*t76 - t102 = br_e0+0.2e1_dp/0.3e1_dp*t87*t51+0.4e1_dp/0.9e1_dp*t90*t37 & - +0.8e1_dp/0.27e2_dp*t93*t63+0.16e2_dp/0.81e2_dp*t96*t72+0.32e2_dp & + t102 = br_e0 + 0.2e1_dp/0.3e1_dp*t87*t51 + 0.4e1_dp/0.9e1_dp*t90*t37 & + + 0.8e1_dp/0.27e2_dp*t93*t63 + 0.16e2_dp/0.81e2_dp*t96*t72 + 0.32e2_dp & /0.243e3_dp*t99*t82 t103 = 0.1e1_dp/t102 t104 = t86*t103 @@ -937,9 +937,9 @@ SUBROUTINE x_br_lsd_y_gt_0(rho, ndrho, tau, laplace_rho, e_0, & t110 = t108*t109 t111 = EXP(-t104) t112 = t103*t111 - t115 = 0.1e1_dp-t111-t86*t112/0.2e1_dp + t115 = 0.1e1_dp - t111 - t86*t112/0.2e1_dp t117 = t110*t102*t115 - e_0 = e_0+(-t107*t117)*sx + e_0 = e_0 + (-t107*t117)*sx END IF IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN t124 = 0.1e1_dp/t4/t32 @@ -950,10 +950,10 @@ SUBROUTINE x_br_lsd_y_gt_0(rho, ndrho, tau, laplace_rho, e_0, & t142 = t62*gamma t143 = t142*t9 t154 = t42*t23 - t157 = -0.2500000000e1_dp*t24*t124*t16-0.1250000000e0_dp*t24* & - t131+0.3e1_dp/0.4e1_dp*t134*t22*t23*t26*(0.40e2_dp/0.27e2_dp* & - t31*t138+0.2e1_dp/0.27e2_dp*t31*t19*t143)-0.5e1_dp/0.2e1_dp* & - t42*t23*t124*t16-t154*t131/0.8e1_dp + t157 = -0.2500000000e1_dp*t24*t124*t16 - 0.1250000000e0_dp*t24* & + t131 + 0.3e1_dp/0.4e1_dp*t134*t22*t23*t26*(0.40e2_dp/0.27e2_dp* & + t31*t138 + 0.2e1_dp/0.27e2_dp*t31*t19*t143) - 0.5e1_dp/0.2e1_dp* & + t42*t23*t124*t16 - t154*t131/0.8e1_dp t158 = 0.1e1_dp/t47 t159 = t157*t158 t160 = t85*t103 @@ -975,22 +975,22 @@ SUBROUTINE x_br_lsd_y_gt_0(rho, ndrho, tau, laplace_rho, e_0, & t202 = 0.1e1_dp/t70/t35 t203 = t202*gamma t204 = t203*t9 - t207 = 0.10e2_dp/0.9e1_dp*t50*t162+t50*t165*t168/0.18e2_dp+0.40e2_dp & - /0.27e2_dp*t54*t138+0.2e1_dp/0.27e2_dp*t54*t19*t143+ & - 0.40e2_dp/0.27e2_dp*t58*t176+0.2e1_dp/0.27e2_dp*t58*t33*t181+ & - 0.320e3_dp/0.243e3_dp*t67*t185+0.16e2_dp/0.243e3_dp*t67*t188* & - t191+0.800e3_dp/0.729e3_dp*t77*t196+0.40e2_dp/0.729e3_dp*t77*t199 & + t207 = 0.10e2_dp/0.9e1_dp*t50*t162 + t50*t165*t168/0.18e2_dp + 0.40e2_dp & + /0.27e2_dp*t54*t138 + 0.2e1_dp/0.27e2_dp*t54*t19*t143 + & + 0.40e2_dp/0.27e2_dp*t58*t176 + 0.2e1_dp/0.27e2_dp*t58*t33*t181 + & + 0.320e3_dp/0.243e3_dp*t67*t185 + 0.16e2_dp/0.243e3_dp*t67*t188* & + t191 + 0.800e3_dp/0.729e3_dp*t77*t196 + 0.40e2_dp/0.729e3_dp*t77*t199 & *t204 t208 = t49*t207 t210 = t102**2 t211 = 0.1e1_dp/t210 - t237 = 0.10e2_dp/0.9e1_dp*t87*t162+t87*t165*t168/0.18e2_dp+0.40e2_dp & - /0.27e2_dp*t90*t138+0.2e1_dp/0.27e2_dp*t90*t19*t143+ & - 0.40e2_dp/0.27e2_dp*t93*t176+0.2e1_dp/0.27e2_dp*t93*t33*t181+ & - 0.320e3_dp/0.243e3_dp*t96*t185+0.16e2_dp/0.243e3_dp*t96*t188* & - t191+0.800e3_dp/0.729e3_dp*t99*t196+0.40e2_dp/0.729e3_dp*t99*t199 & + t237 = 0.10e2_dp/0.9e1_dp*t87*t162 + t87*t165*t168/0.18e2_dp + 0.40e2_dp & + /0.27e2_dp*t90*t138 + 0.2e1_dp/0.27e2_dp*t90*t19*t143 + & + 0.40e2_dp/0.27e2_dp*t93*t176 + 0.2e1_dp/0.27e2_dp*t93*t33*t181 + & + 0.320e3_dp/0.243e3_dp*t96*t185 + 0.16e2_dp/0.243e3_dp*t96*t188* & + t191 + 0.800e3_dp/0.729e3_dp*t99*t196 + 0.40e2_dp/0.729e3_dp*t99*t199 & *t204 - t240 = t159*t160+t208*t103-t86*t211*t237 + t240 = t159*t160 + t208*t103 - t86*t211*t237 t245 = t49**2 t248 = t21*t106/t245 t249 = t109*t102 @@ -1000,40 +1000,40 @@ SUBROUTINE x_br_lsd_y_gt_0(rho, ndrho, tau, laplace_rho, e_0, & t265 = -t240 t267 = t160*t111 t272 = t211*t111 - e_rho = e_rho+(-0.4e1_dp/0.3e1_dp*t3*t20*t106*t117-t21*t240*t106 & - *t117/0.3e1_dp+t248*t249*t115*t157*t158+t255*t258* & - t115*t207-t107*t110*t237*t115-t107*t110*t102*(-t265 & - *t111-t159*t267/0.2e1_dp-t208*t112/0.2e1_dp+t86*t272 & - *t237/0.2e1_dp-t86*t103*t265*t111/0.2e1_dp))*sx + e_rho = e_rho + (-0.4e1_dp/0.3e1_dp*t3*t20*t106*t117 - t21*t240*t106 & + *t117/0.3e1_dp + t248*t249*t115*t157*t158 + t255*t258* & + t115*t207 - t107*t110*t237*t115 - t107*t110*t102*(-t265 & + *t111 - t159*t267/0.2e1_dp - t208*t112/0.2e1_dp + t86*t272 & + *t237/0.2e1_dp - t86*t103*t265*t111/0.2e1_dp))*sx t285 = t124*gamma*ndrho t288 = t134*br_BB t289 = t288*t2 - t297 = 0.2500000000000000e0_dp*t24*t285-t289*t4*t36*gamma* & - ndrho/0.9e1_dp+t154*t285/0.4e1_dp + t297 = 0.2500000000000000e0_dp*t24*t285 - t289*t4*t36*gamma* & + ndrho/0.9e1_dp + t154*t285/0.4e1_dp t298 = t297*t158 t301 = t167*ndrho t305 = t142*ndrho t309 = t180*ndrho t313 = t190*ndrho t317 = t203*ndrho - t320 = -t50*t4*t301/0.9e1_dp-0.4e1_dp/0.27e2_dp*t54*t137*t305 & - -0.4e1_dp/0.27e2_dp*t58*t59*t309-0.32e2_dp/0.243e3_dp*t67*t184 & - *t313-0.80e2_dp/0.729e3_dp*t77*t195*t317 + t320 = -t50*t4*t301/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t54*t137*t305 & + - 0.4e1_dp/0.27e2_dp*t58*t59*t309 - 0.32e2_dp/0.243e3_dp*t67*t184 & + *t313 - 0.80e2_dp/0.729e3_dp*t77*t195*t317 t321 = t49*t320 - t338 = -t87*t4*t301/0.9e1_dp-0.4e1_dp/0.27e2_dp*t90*t137*t305 & - -0.4e1_dp/0.27e2_dp*t93*t59*t309-0.32e2_dp/0.243e3_dp*t96*t184 & - *t313-0.80e2_dp/0.729e3_dp*t99*t195*t317 - t341 = t298*t160+t321*t103-t86*t211*t338 + t338 = -t87*t4*t301/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t90*t137*t305 & + - 0.4e1_dp/0.27e2_dp*t93*t59*t309 - 0.32e2_dp/0.243e3_dp*t96*t184 & + *t313 - 0.80e2_dp/0.729e3_dp*t99*t195*t317 + t341 = t298*t160 + t321*t103 - t86*t211*t338 t356 = -t341 - e_ndrho = e_ndrho+(-t21*t341*t106*t117/0.3e1_dp+t248*t249*t115*t297 & - *t158+t255*t258*t115*t320-t107*t110*t338*t115 & - -t107*t110*t102*(-t356*t111-t298*t267/0.2e1_dp-t321 & - *t112/0.2e1_dp+t86*t272*t338/0.2e1_dp-t86*t103*t356* & - t111/0.2e1_dp))*sx + e_ndrho = e_ndrho + (-t21*t341*t106*t117/0.3e1_dp + t248*t249*t115*t297 & + *t158 + t255*t258*t115*t320 - t107*t110*t338*t115 & + - t107*t110*t102*(-t356*t111 - t298*t267/0.2e1_dp - t321 & + *t112/0.2e1_dp + t86*t272*t338/0.2e1_dp - t86*t103*t356* & + t111/0.2e1_dp))*sx t376 = t5*t36 t377 = t376*gamma - t382 = -0.1000000000e1_dp*t24*t25*gamma+0.4e1_dp/0.9e1_dp*t289*t377 & - -t42*t43*gamma + t382 = -0.1000000000e1_dp*t24*t25*gamma + 0.4e1_dp/0.9e1_dp*t289*t377 & + - t42*t43*gamma t383 = t382*t158 t387 = t34*t62 t388 = t387*gamma @@ -1043,37 +1043,37 @@ SUBROUTINE x_br_lsd_y_gt_0(rho, ndrho, tau, laplace_rho, e_0, & t396 = t395*gamma t399 = t79*t202 t400 = t399*gamma - t403 = 0.4e1_dp/0.9e1_dp*t50*t377+0.16e2_dp/0.27e2_dp*t54*t388+ & - 0.16e2_dp/0.27e2_dp*t58*t392+0.128e3_dp/0.243e3_dp*t67*t396+0.320e3_dp & + t403 = 0.4e1_dp/0.9e1_dp*t50*t377 + 0.16e2_dp/0.27e2_dp*t54*t388 + & + 0.16e2_dp/0.27e2_dp*t58*t392 + 0.128e3_dp/0.243e3_dp*t67*t396 + 0.320e3_dp & /0.729e3_dp*t77*t400 t404 = t49*t403 - t416 = 0.4e1_dp/0.9e1_dp*t87*t377+0.16e2_dp/0.27e2_dp*t90*t388+ & - 0.16e2_dp/0.27e2_dp*t93*t392+0.128e3_dp/0.243e3_dp*t96*t396+0.320e3_dp & + t416 = 0.4e1_dp/0.9e1_dp*t87*t377 + 0.16e2_dp/0.27e2_dp*t90*t388 + & + 0.16e2_dp/0.27e2_dp*t93*t392 + 0.128e3_dp/0.243e3_dp*t96*t396 + 0.320e3_dp & /0.729e3_dp*t99*t400 - t419 = t383*t160+t404*t103-t86*t211*t416 + t419 = t383*t160 + t404*t103 - t86*t211*t416 t434 = -t419 - e_tau = e_tau+(-t21*t419*t106*t117/0.3e1_dp+t248*t249*t115*t382 & - *t158+t255*t258*t115*t403-t107*t110*t416*t115- & - t107*t110*t102*(-t434*t111-t383*t267/0.2e1_dp-t404* & - t112/0.2e1_dp+t86*t272*t416/0.2e1_dp-t86*t103*t434*t111 & - /0.2e1_dp))*sx - t458 = 0.2500000000000000e0_dp*t24*t25-t288*t6*t36/0.9e1_dp+ & + e_tau = e_tau + (-t21*t419*t106*t117/0.3e1_dp + t248*t249*t115*t382 & + *t158 + t255*t258*t115*t403 - t107*t110*t416*t115 - & + t107*t110*t102*(-t434*t111 - t383*t267/0.2e1_dp - t404* & + t112/0.2e1_dp + t86*t272*t416/0.2e1_dp - t86*t103*t434*t111 & + /0.2e1_dp))*sx + t458 = 0.2500000000000000e0_dp*t24*t25 - t288*t6*t36/0.9e1_dp + & t42*t43/0.4e1_dp t459 = t458*t158 - t471 = -t50*t376/0.9e1_dp-0.4e1_dp/0.27e2_dp*t54*t387-0.4e1_dp/ & - 0.27e2_dp*t58*t391-0.32e2_dp/0.243e3_dp*t67*t395-0.80e2_dp/0.729e3_dp & + t471 = -t50*t376/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t54*t387 - 0.4e1_dp/ & + 0.27e2_dp*t58*t391 - 0.32e2_dp/0.243e3_dp*t67*t395 - 0.80e2_dp/0.729e3_dp & *t77*t399 t472 = t49*t471 - t484 = -t87*t376/0.9e1_dp-0.4e1_dp/0.27e2_dp*t90*t387-0.4e1_dp/ & - 0.27e2_dp*t93*t391-0.32e2_dp/0.243e3_dp*t96*t395-0.80e2_dp/0.729e3_dp & + t484 = -t87*t376/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t90*t387 - 0.4e1_dp/ & + 0.27e2_dp*t93*t391 - 0.32e2_dp/0.243e3_dp*t96*t395 - 0.80e2_dp/0.729e3_dp & *t99*t399 - t487 = t459*t160+t472*t103-t86*t211*t484 + t487 = t459*t160 + t472*t103 - t86*t211*t484 t502 = -t487 - e_laplace_rho = e_laplace_rho+(-t21*t487*t106*t117/0.3e1_dp+t248*t249*t115*t458 & - *t158+t255*t258*t115*t471-t107*t110*t484*t115- & - t107*t110*t102*(-t502*t111-t459*t267/0.2e1_dp-t472* & - t112/0.2e1_dp+t86*t272*t484/0.2e1_dp-t86*t103*t502*t111 & - /0.2e1_dp))*sx + e_laplace_rho = e_laplace_rho + (-t21*t487*t106*t117/0.3e1_dp + t248*t249*t115*t458 & + *t158 + t255*t258*t115*t471 - t107*t110*t484*t115 - & + t107*t110*t102*(-t502*t111 - t459*t267/0.2e1_dp - t472* & + t112/0.2e1_dp + t86*t272*t484/0.2e1_dp - t86*t103*t502*t111 & + /0.2e1_dp))*sx END IF END SUBROUTINE x_br_lsd_y_gt_0 @@ -1122,10 +1122,10 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff(rho, ndrho, tau, laplace_rho, e_0, & t7 = t6**2 t11 = ndrho**2 t12 = 0.1e1_dp/rho - t18 = laplace_rho/0.6e1_dp-gamma*(REAL(2*tau, KIND=dp)-t11*t12/0.4e1_dp)/0.3e1_dp + t18 = laplace_rho/0.6e1_dp - gamma*(REAL(2*tau, KIND=dp) - t11*t12/0.4e1_dp)/0.3e1_dp t20 = t7*rho/t18 - t24 = ATAN(0.2e1_dp/0.3e1_dp*br_a1*t4*t20+br_a2) - t25 = -t24+br_a3 + t24 = ATAN(0.2e1_dp/0.3e1_dp*br_a1*t4*t20 + br_a2) + t25 = -t24 + br_a3 t26 = t25**2 t31 = t3*pi t33 = rho**2 @@ -1140,13 +1140,13 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff(rho, ndrho, tau, laplace_rho, e_0, & t60 = t3*t41*pi t62 = t43**2 t66 = t6*t62/t54/t18 - t69 = br_c0+0.2e1_dp/0.3e1_dp*br_c1*t4*t20+0.4e1_dp/0.9e1_dp*br_c2 & - *t31*t38+0.8e1_dp/0.27e2_dp*br_c3*t41*t47+0.16e2_dp/0.81e2_dp & - *br_c4*t50*t56+0.32e2_dp/0.243e3_dp*br_c5*t60*t66 + t69 = br_c0 + 0.2e1_dp/0.3e1_dp*br_c1*t4*t20 + 0.4e1_dp/0.9e1_dp*br_c2 & + *t31*t38 + 0.8e1_dp/0.27e2_dp*br_c3*t41*t47 + 0.16e2_dp/0.81e2_dp & + *br_c4*t50*t56 + 0.32e2_dp/0.243e3_dp*br_c5*t60*t66 t70 = t69**2 - t88 = br_b0+0.2e1_dp/0.3e1_dp*br_b1*t4*t20+0.4e1_dp/0.9e1_dp*br_b2 & - *t31*t38+0.8e1_dp/0.27e2_dp*br_b3*t41*t47+0.16e2_dp/0.81e2_dp & - *br_b4*t50*t56+0.32e2_dp/0.243e3_dp*br_b5*t60*t66 + t88 = br_b0 + 0.2e1_dp/0.3e1_dp*br_b1*t4*t20 + 0.4e1_dp/0.9e1_dp*br_b2 & + *t31*t38 + 0.8e1_dp/0.27e2_dp*br_b3*t41*t47 + 0.16e2_dp/0.81e2_dp & + *br_b4*t50*t56 + 0.32e2_dp/0.243e3_dp*br_b5*t60*t66 t89 = t88**2 t96 = EXP(-t25*t69/t88) t101 = (t26*t25*t70*t69/t89/t88*t96/0.3141592654e1_dp* & @@ -1221,12 +1221,12 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_gt_b(rho, ndrho, tau, laplace_rho, e_0, & t6 = t5*rho t9 = ndrho**2 t10 = 0.1e1_dp/rho - t16 = laplace_rho/0.6e1_dp-gamma*(REAL(2*tau, KIND=dp)-t9*t10/0.4e1_dp)/0.3e1_dp + t16 = laplace_rho/0.6e1_dp - gamma*(REAL(2*tau, KIND=dp) - t9*t10/0.4e1_dp)/0.3e1_dp t17 = 0.1e1_dp/t16 t18 = t6*t17 - t21 = 0.2e1_dp/0.3e1_dp*t3*t18+br_a2 + t21 = 0.2e1_dp/0.3e1_dp*t3*t18 + br_a2 t22 = ATAN(t21) - t23 = -t22+br_a3 + t23 = -t22 + br_a3 t24 = br_c1*t2 t27 = t1*pi t28 = br_c2*t27 @@ -1255,8 +1255,8 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_gt_b(rho, ndrho, tau, laplace_rho, e_0, & t59 = t4*t58 t61 = 0.1e1_dp/t50/t16 t62 = t59*t61 - t65 = br_c0+0.2e1_dp/0.3e1_dp*t24*t18+0.4e1_dp/0.9e1_dp*t28*t34 & - +0.8e1_dp/0.27e2_dp*t38*t43+0.16e2_dp/0.81e2_dp*t47*t52+0.32e2_dp & + t65 = br_c0 + 0.2e1_dp/0.3e1_dp*t24*t18 + 0.4e1_dp/0.9e1_dp*t28*t34 & + + 0.8e1_dp/0.27e2_dp*t38*t43 + 0.16e2_dp/0.81e2_dp*t47*t52 + 0.32e2_dp & /0.243e3_dp*t57*t62 t66 = t23*t65 t67 = br_b1*t2 @@ -1264,8 +1264,8 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_gt_b(rho, ndrho, tau, laplace_rho, e_0, & t73 = br_b3*t37 t76 = br_b4*t46 t79 = br_b5*t56 - t82 = br_b0+0.2e1_dp/0.3e1_dp*t67*t18+0.4e1_dp/0.9e1_dp*t70*t34 & - +0.8e1_dp/0.27e2_dp*t73*t43+0.16e2_dp/0.81e2_dp*t76*t52+0.32e2_dp & + t82 = br_b0 + 0.2e1_dp/0.3e1_dp*t67*t18 + 0.4e1_dp/0.9e1_dp*t70*t34 & + + 0.8e1_dp/0.27e2_dp*t73*t43 + 0.16e2_dp/0.81e2_dp*t76*t52 + 0.32e2_dp & /0.243e3_dp*t79*t62 t83 = 0.1e1_dp/t82 t84 = t66*t83 @@ -1287,27 +1287,27 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_gt_b(rho, ndrho, tau, laplace_rho, e_0, & t102 = REAL(t85, KIND=dp)*t101 t103 = t102*R t104 = t84*t103 - t106 = EXP(t84-t104) + t106 = EXP(t84 - t104) t108 = t106*t23 t109 = t65*t83 t110 = t108*t109 t114 = t83*REAL(t85, KIND=dp)*t101*R - t117 = EXP(-t84-t104) + t117 = EXP(-t84 - t104) t119 = t117*t23 t120 = t119*t109 - t123 = -0.2e1_dp*t106+t110-t108*t65*t114+0.2e1_dp*t117+t120 & - +t119*t65*t114 + t123 = -0.2e1_dp*t106 + t110 - t108*t65*t114 + 0.2e1_dp*t117 + t120 & + + t119*t65*t114 t124 = rho*t123 - e_0 = e_0+(t124*t102/0.8e1_dp)*sx + e_0 = e_0 + (t124*t102/0.8e1_dp)*sx END IF IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN t129 = t5*t17 t132 = 0.1e1_dp/t4 t134 = t33*gamma t135 = t134*t9 - t138 = 0.10e2_dp/0.9e1_dp*t3*t129+t3*t132*t135/0.18e2_dp + t138 = 0.10e2_dp/0.9e1_dp*t3*t129 + t3*t132*t135/0.18e2_dp t139 = t21**2 - t141 = 0.1e1_dp/(0.1e1_dp+t139) + t141 = 0.1e1_dp/(0.1e1_dp + t139) t142 = t138*t141 t143 = t142*t109 t149 = t4*t29 @@ -1329,19 +1329,19 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_gt_b(rho, ndrho, tau, laplace_rho, e_0, & t185 = 0.1e1_dp/t50/t32 t186 = t185*gamma t187 = t186*t9 - t190 = 0.10e2_dp/0.9e1_dp*t24*t129+t24*t132*t135/0.18e2_dp+0.40e2_dp & - /0.27e2_dp*t28*t150+0.2e1_dp/0.27e2_dp*t28*t153*t156+ & - 0.40e2_dp/0.27e2_dp*t38*t159+0.2e1_dp/0.27e2_dp*t38*t30*t164 & - +0.320e3_dp/0.243e3_dp*t47*t168+0.16e2_dp/0.243e3_dp*t47*t171* & - t174+0.800e3_dp/0.729e3_dp*t57*t179+0.40e2_dp/0.729e3_dp*t57* & + t190 = 0.10e2_dp/0.9e1_dp*t24*t129 + t24*t132*t135/0.18e2_dp + 0.40e2_dp & + /0.27e2_dp*t28*t150 + 0.2e1_dp/0.27e2_dp*t28*t153*t156 + & + 0.40e2_dp/0.27e2_dp*t38*t159 + 0.2e1_dp/0.27e2_dp*t38*t30*t164 & + + 0.320e3_dp/0.243e3_dp*t47*t168 + 0.16e2_dp/0.243e3_dp*t47*t171* & + t174 + 0.800e3_dp/0.729e3_dp*t57*t179 + 0.40e2_dp/0.729e3_dp*t57* & t182*t187 t192 = t23*t190*t83 t193 = 0.1e1_dp/t91 - t219 = 0.10e2_dp/0.9e1_dp*t67*t129+t67*t132*t135/0.18e2_dp+0.40e2_dp & - /0.27e2_dp*t70*t150+0.2e1_dp/0.27e2_dp*t70*t153*t156+ & - 0.40e2_dp/0.27e2_dp*t73*t159+0.2e1_dp/0.27e2_dp*t73*t30*t164 & - +0.320e3_dp/0.243e3_dp*t76*t168+0.16e2_dp/0.243e3_dp*t76*t171* & - t174+0.800e3_dp/0.729e3_dp*t79*t179+0.40e2_dp/0.729e3_dp*t79* & + t219 = 0.10e2_dp/0.9e1_dp*t67*t129 + t67*t132*t135/0.18e2_dp + 0.40e2_dp & + /0.27e2_dp*t70*t150 + 0.2e1_dp/0.27e2_dp*t70*t153*t156 + & + 0.40e2_dp/0.27e2_dp*t73*t159 + 0.2e1_dp/0.27e2_dp*t73*t30*t164 & + + 0.320e3_dp/0.243e3_dp*t76*t168 + 0.16e2_dp/0.243e3_dp*t76*t171* & + t174 + 0.800e3_dp/0.729e3_dp*t79*t179 + 0.40e2_dp/0.729e3_dp*t79* & t182*t187 t221 = t66*t193*t219 t223 = t142*t65*t114 @@ -1356,12 +1356,12 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_gt_b(rho, ndrho, tau, laplace_rho, e_0, & t240 = t87*t88*t93 t245 = t91**2 t247 = t90/t245 - t259 = -0.3e1_dp*t232*t233*t235*t142+0.3e1_dp*t240*t97*t10 & - *t190-0.3e1_dp*t247*t97*t10*t219+t94*(t143-t192+ & - t221)*t95*t235-t94*t97/t29 + t259 = -0.3e1_dp*t232*t233*t235*t142 + 0.3e1_dp*t240*t97*t10 & + *t190 - 0.3e1_dp*t247*t97*t10*t219 + t94*(t143 - t192 + & + t221)*t95*t235 - t94*t97/t29 t261 = t231*R*t259 t263 = t84*t261/0.3e1_dp - t265 = (-t143+t192-t221+t223-t224+t228+t263)*t106 + t265 = (-t143 + t192 - t221 + t223 - t224 + t228 + t263)*t106 t268 = t106*t138 t269 = t141*t65 t270 = t269*t83 @@ -1369,17 +1369,17 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_gt_b(rho, ndrho, tau, laplace_rho, e_0, & t274 = t65*t193 t275 = t274*t219 t283 = t108*t274 - t288 = (t143-t192+t221+t223-t224+t228+t263)*t117 + t288 = (t143 - t192 + t221 + t223 - t224 + t228 + t263)*t117 t291 = t117*t138 t301 = t119*t274 - t305 = -0.2e1_dp*t265+t265*t84-t268*t270+t108*t272-t108 & - *t275-t265*t66*t114+t268*t269*t114-t108*t190* & - t114+t283*t227+t110*t261/0.3e1_dp+0.2e1_dp*t288+t288*t84 & - -t291*t270+t119*t272-t119*t275+t288*t66*t114- & - t291*t269*t114+t119*t190*t114-t301*t227-t120*t261 & + t305 = -0.2e1_dp*t265 + t265*t84 - t268*t270 + t108*t272 - t108 & + *t275 - t265*t66*t114 + t268*t269*t114 - t108*t190* & + t114 + t283*t227 + t110*t261/0.3e1_dp + 0.2e1_dp*t288 + t288*t84 & + - t291*t270 + t119*t272 - t119*t275 + t288*t66*t114 - & + t291*t269*t114 + t119*t190*t114 - t301*t227 - t120*t261 & /0.3e1_dp - e_rho = e_rho+(t123*REAL(t85, KIND=dp)*t101/0.8e1_dp+rho*t305*t102/0.8e1_dp & - -t124*t231*t259/0.24e2_dp)*sx + e_rho = e_rho + (t123*REAL(t85, KIND=dp)*t101/0.8e1_dp + rho*t305*t102/0.8e1_dp & + - t124*t231*t259/0.24e2_dp)*sx t312 = t5*t33 t314 = gamma*ndrho t315 = t314*t270 @@ -1389,13 +1389,13 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_gt_b(rho, ndrho, tau, laplace_rho, e_0, & t327 = t163*ndrho t331 = t173*ndrho t335 = t186*ndrho - t338 = -t24*t5*t319/0.9e1_dp-0.4e1_dp/0.27e2_dp*t28*t149*t323 & - -0.4e1_dp/0.27e2_dp*t38*t39*t327-0.32e2_dp/0.243e3_dp*t47*t167 & - *t331-0.80e2_dp/0.729e3_dp*t57*t178*t335 + t338 = -t24*t5*t319/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t28*t149*t323 & + - 0.4e1_dp/0.27e2_dp*t38*t39*t327 - 0.32e2_dp/0.243e3_dp*t47*t167 & + *t331 - 0.80e2_dp/0.729e3_dp*t57*t178*t335 t340 = t23*t338*t83 - t356 = -t67*t5*t319/0.9e1_dp-0.4e1_dp/0.27e2_dp*t70*t149*t323 & - -0.4e1_dp/0.27e2_dp*t73*t39*t327-0.32e2_dp/0.243e3_dp*t76*t167 & - *t331-0.80e2_dp/0.729e3_dp*t79*t178*t335 + t356 = -t67*t5*t319/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t70*t149*t323 & + - 0.4e1_dp/0.27e2_dp*t73*t39*t327 - 0.32e2_dp/0.243e3_dp*t76*t167 & + *t331 - 0.80e2_dp/0.729e3_dp*t79*t178*t335 t358 = t66*t193*t356 t359 = t3*t5 t361 = t270*t103 @@ -1403,12 +1403,12 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_gt_b(rho, ndrho, tau, laplace_rho, e_0, & t364 = t340*t103 t366 = t102*R*t356 t367 = t225*t366 - t388 = t232*t93*t97*t132*t3*t33*t314*t141/0.3e1_dp+0.3e1_dp & - *t240*t97*t10*t338-0.3e1_dp*t247*t97*t10*t356+ & - t94*(-t317-t340+t358)*t95*t235 + t388 = t232*t93*t97*t132*t3*t33*t314*t141/0.3e1_dp + 0.3e1_dp & + *t240*t97*t10*t338 - 0.3e1_dp*t247*t97*t10*t356 + & + t94*(-t317 - t340 + t358)*t95*t235 t390 = t231*R*t388 t392 = t84*t390/0.3e1_dp - t394 = (t317+t340-t358-t363-t364+t367+t392)*t106 + t394 = (t317 + t340 - t358 - t363 - t364 + t367 + t392)*t106 t397 = t106*br_a1 t399 = t2*t5*t33 t403 = t338*t83 @@ -1416,16 +1416,16 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_gt_b(rho, ndrho, tau, laplace_rho, e_0, & t409 = t397*t2 t410 = t312*gamma t414 = ndrho*t141*t65*t114 - t423 = (-t317-t340+t358-t363-t364+t367+t392)*t117 + t423 = (-t317 - t340 + t358 - t363 - t364 + t367 + t392)*t117 t426 = t117*br_a1 t434 = t426*t2 - t443 = -0.2e1_dp*t394+t394*t84+t397*t399*t315/0.9e1_dp+t108 & - *t403-t108*t405-t394*t66*t114-t409*t410*t414/ & - 0.9e1_dp-t108*t338*t114+t283*t366+t110*t390/0.3e1_dp+ & - 0.2e1_dp*t423+t423*t84+t426*t399*t315/0.9e1_dp+t119*t403 & - -t119*t405+t423*t66*t114+t434*t410*t414/0.9e1_dp & - +t119*t338*t114-t301*t366-t120*t390/0.3e1_dp - e_ndrho = e_ndrho+(rho*t443*t102/0.8e1_dp-t124*t231*t388/0.24e2_dp)*sx + t443 = -0.2e1_dp*t394 + t394*t84 + t397*t399*t315/0.9e1_dp + t108 & + *t403 - t108*t405 - t394*t66*t114 - t409*t410*t414/ & + 0.9e1_dp - t108*t338*t114 + t283*t366 + t110*t390/0.3e1_dp + & + 0.2e1_dp*t423 + t423*t84 + t426*t399*t315/0.9e1_dp + t119*t403 & + - t119*t405 + t423*t66*t114 + t434*t410*t414/0.9e1_dp & + + t119*t338*t114 - t301*t366 - t120*t390/0.3e1_dp + e_ndrho = e_ndrho + (rho*t443*t102/0.8e1_dp - t124*t231*t388/0.24e2_dp)*sx t450 = t6*t33 t455 = 0.4e1_dp/0.9e1_dp*t3*t450*gamma*t141*t109 t456 = t450*gamma @@ -1437,12 +1437,12 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_gt_b(rho, ndrho, tau, laplace_rho, e_0, & t468 = t467*gamma t471 = t59*t185 t472 = t471*gamma - t475 = 0.4e1_dp/0.9e1_dp*t24*t456+0.16e2_dp/0.27e2_dp*t28*t460+ & - 0.16e2_dp/0.27e2_dp*t38*t464+0.128e3_dp/0.243e3_dp*t47*t468+0.320e3_dp & + t475 = 0.4e1_dp/0.9e1_dp*t24*t456 + 0.16e2_dp/0.27e2_dp*t28*t460 + & + 0.16e2_dp/0.27e2_dp*t38*t464 + 0.128e3_dp/0.243e3_dp*t47*t468 + 0.320e3_dp & /0.729e3_dp*t57*t472 t477 = t23*t475*t83 - t488 = 0.4e1_dp/0.9e1_dp*t67*t456+0.16e2_dp/0.27e2_dp*t70*t460+ & - 0.16e2_dp/0.27e2_dp*t73*t464+0.128e3_dp/0.243e3_dp*t76*t468+0.320e3_dp & + t488 = 0.4e1_dp/0.9e1_dp*t67*t456 + 0.16e2_dp/0.27e2_dp*t70*t460 + & + 0.16e2_dp/0.27e2_dp*t73*t464 + 0.128e3_dp/0.243e3_dp*t76*t468 + 0.320e3_dp & /0.729e3_dp*t79*t472 t490 = t66*t193*t488 t493 = 0.4e1_dp/0.9e1_dp*t3*t456*t361 @@ -1450,58 +1450,58 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_gt_b(rho, ndrho, tau, laplace_rho, e_0, & t496 = t102*R*t488 t497 = t225*t496 t499 = t232*t233*t96 - t516 = -0.4e1_dp/0.3e1_dp*t499*t359*t134*t141+0.3e1_dp*t240* & - t97*t10*t475-0.3e1_dp*t247*t97*t10*t488+t94*(t455- & - t477+t490)*t95*t235 + t516 = -0.4e1_dp/0.3e1_dp*t499*t359*t134*t141 + 0.3e1_dp*t240* & + t97*t10*t475 - 0.3e1_dp*t247*t97*t10*t488 + t94*(t455 - & + t477 + t490)*t95*t235 t518 = t231*R*t516 t520 = t84*t518/0.3e1_dp - t522 = (-t455+t477-t490+t493-t494+t497+t520)*t106 + t522 = (-t455 + t477 - t490 + t493 - t494 + t497 + t520)*t106 t525 = t2*t6 t526 = t397*t525 t527 = t134*t270 t530 = t475*t83 t532 = t274*t488 - t545 = (t455-t477+t490+t493-t494+t497+t520)*t117 + t545 = (t455 - t477 + t490 + t493 - t494 + t497 + t520)*t117 t548 = t426*t525 - t563 = -0.2e1_dp*t522+t522*t84-0.4e1_dp/0.9e1_dp*t526*t527+t108 & - *t530-t108*t532-t522*t66*t114+0.4e1_dp/0.9e1_dp*t409 & - *t456*t361-t108*t475*t114+t283*t496+t110*t518/ & - 0.3e1_dp+0.2e1_dp*t545+t545*t84-0.4e1_dp/0.9e1_dp*t548*t527+ & - t119*t530-t119*t532+t545*t66*t114-0.4e1_dp/0.9e1_dp*t434 & - *t456*t361+t119*t475*t114-t301*t496-t120*t518 & + t563 = -0.2e1_dp*t522 + t522*t84 - 0.4e1_dp/0.9e1_dp*t526*t527 + t108 & + *t530 - t108*t532 - t522*t66*t114 + 0.4e1_dp/0.9e1_dp*t409 & + *t456*t361 - t108*t475*t114 + t283*t496 + t110*t518/ & + 0.3e1_dp + 0.2e1_dp*t545 + t545*t84 - 0.4e1_dp/0.9e1_dp*t548*t527 + & + t119*t530 - t119*t532 + t545*t66*t114 - 0.4e1_dp/0.9e1_dp*t434 & + *t456*t361 + t119*t475*t114 - t301*t496 - t120*t518 & /0.3e1_dp - e_tau = e_tau+(rho*t563*t102/0.8e1_dp-t124*t231*t516/0.24e2_dp)*sx + e_tau = e_tau + (rho*t563*t102/0.8e1_dp - t124*t231*t516/0.24e2_dp)*sx t572 = t33*t141*t109 t574 = t3*t6*t572/0.9e1_dp - t585 = -t24*t450/0.9e1_dp-0.4e1_dp/0.27e2_dp*t28*t459-0.4e1_dp/ & - 0.27e2_dp*t38*t463-0.32e2_dp/0.243e3_dp*t47*t467-0.80e2_dp/0.729e3_dp & + t585 = -t24*t450/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t28*t459 - 0.4e1_dp/ & + 0.27e2_dp*t38*t463 - 0.32e2_dp/0.243e3_dp*t47*t467 - 0.80e2_dp/0.729e3_dp & *t57*t471 t587 = t23*t585*t83 - t598 = -t67*t450/0.9e1_dp-0.4e1_dp/0.27e2_dp*t70*t459-0.4e1_dp/ & - 0.27e2_dp*t73*t463-0.32e2_dp/0.243e3_dp*t76*t467-0.80e2_dp/0.729e3_dp & + t598 = -t67*t450/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t70*t459 - 0.4e1_dp/ & + 0.27e2_dp*t73*t463 - 0.32e2_dp/0.243e3_dp*t76*t467 - 0.80e2_dp/0.729e3_dp & *t79*t471 t600 = t66*t193*t598 t605 = t3*t450*t141*t109*t103/0.9e1_dp t606 = t587*t103 t608 = t102*R*t598 t609 = t225*t608 - t628 = t499*t5*br_a1*t2*t33*t141/0.3e1_dp+0.3e1_dp*t240* & - t97*t10*t585-0.3e1_dp*t247*t97*t10*t598+t94*(-t574 & - -t587+t600)*t95*t235 + t628 = t499*t5*br_a1*t2*t33*t141/0.3e1_dp + 0.3e1_dp*t240* & + t97*t10*t585 - 0.3e1_dp*t247*t97*t10*t598 + t94*(-t574 & + - t587 + t600)*t95*t235 t630 = t231*R*t628 t632 = t84*t630/0.3e1_dp - t634 = (t574+t587-t600-t605-t606+t609+t632)*t106 + t634 = (t574 + t587 - t600 - t605 - t606 + t609 + t632)*t106 t639 = t585*t83 t641 = t274*t598 t645 = t525*t33 - t655 = (-t574-t587+t600-t605-t606+t609+t632)*t117 - t672 = -0.2e1_dp*t634+t634*t84+t526*t572/0.9e1_dp+t108*t639 & - -t108*t641-t634*t66*t114-t397*t645*t361/0.9e1_dp & - -t108*t585*t114+t283*t608+t110*t630/0.3e1_dp+0.2e1_dp* & - t655+t655*t84+t548*t572/0.9e1_dp+t119*t639-t119*t641 & - +t655*t66*t114+t426*t645*t361/0.9e1_dp+t119*t585 & - *t114-t301*t608-t120*t630/0.3e1_dp - e_laplace_rho = e_laplace_rho+(rho*t672*t102/0.8e1_dp-t124*t231*t628/0.24e2_dp)*sx + t655 = (-t574 - t587 + t600 - t605 - t606 + t609 + t632)*t117 + t672 = -0.2e1_dp*t634 + t634*t84 + t526*t572/0.9e1_dp + t108*t639 & + - t108*t641 - t634*t66*t114 - t397*t645*t361/0.9e1_dp & + - t108*t585*t114 + t283*t608 + t110*t630/0.3e1_dp + 0.2e1_dp* & + t655 + t655*t84 + t548*t572/0.9e1_dp + t119*t639 - t119*t641 & + + t655*t66*t114 + t426*t645*t361/0.9e1_dp + t119*t585 & + *t114 - t301*t608 - t120*t630/0.3e1_dp + e_laplace_rho = e_laplace_rho + (rho*t672*t102/0.8e1_dp - t124*t231*t628/0.24e2_dp)*sx END IF END SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_gt_b @@ -1562,12 +1562,12 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_lte_b(rho, ndrho, tau, laplace_rho, e_0, & t6 = t5*rho t9 = ndrho**2 t10 = 0.1e1_dp/rho - t16 = laplace_rho/0.6e1_dp-gamma*(REAL(2*tau, KIND=dp)-t9*t10/0.4e1_dp)/0.3e1_dp + t16 = laplace_rho/0.6e1_dp - gamma*(REAL(2*tau, KIND=dp) - t9*t10/0.4e1_dp)/0.3e1_dp t17 = 0.1e1_dp/t16 t18 = t6*t17 - t21 = 0.2e1_dp/0.3e1_dp*t3*t18+br_a2 + t21 = 0.2e1_dp/0.3e1_dp*t3*t18 + br_a2 t22 = ATAN(t21) - t23 = -t22+br_a3 + t23 = -t22 + br_a3 t24 = br_c1*t2 t27 = t1*pi t28 = br_c2*t27 @@ -1596,8 +1596,8 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_lte_b(rho, ndrho, tau, laplace_rho, e_0, & t59 = t4*t58 t61 = 0.1e1_dp/t50/t16 t62 = t59*t61 - t65 = br_c0+0.2e1_dp/0.3e1_dp*t24*t18+0.4e1_dp/0.9e1_dp*t28*t34 & - +0.8e1_dp/0.27e2_dp*t38*t43+0.16e2_dp/0.81e2_dp*t47*t52+0.32e2_dp & + t65 = br_c0 + 0.2e1_dp/0.3e1_dp*t24*t18 + 0.4e1_dp/0.9e1_dp*t28*t34 & + + 0.8e1_dp/0.27e2_dp*t38*t43 + 0.16e2_dp/0.81e2_dp*t47*t52 + 0.32e2_dp & /0.243e3_dp*t57*t62 t66 = t23*t65 t67 = br_b1*t2 @@ -1605,8 +1605,8 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_lte_b(rho, ndrho, tau, laplace_rho, e_0, & t73 = br_b3*t37 t76 = br_b4*t46 t79 = br_b5*t56 - t82 = br_b0+0.2e1_dp/0.3e1_dp*t67*t18+0.4e1_dp/0.9e1_dp*t70*t34 & - +0.8e1_dp/0.27e2_dp*t73*t43+0.16e2_dp/0.81e2_dp*t76*t52+0.32e2_dp & + t82 = br_b0 + 0.2e1_dp/0.3e1_dp*t67*t18 + 0.4e1_dp/0.9e1_dp*t70*t34 & + + 0.8e1_dp/0.27e2_dp*t73*t43 + 0.16e2_dp/0.81e2_dp*t76*t52 + 0.32e2_dp & /0.243e3_dp*t79*t62 t83 = 0.1e1_dp/t82 t84 = t66*t83 @@ -1634,23 +1634,23 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_lte_b(rho, ndrho, tau, laplace_rho, e_0, & t110 = t65*t83 t111 = t110*t102 t113 = t106*t23 - t115 = t84+t104 + t115 = t84 + t104 t116 = EXP(t115) - t118 = 0.2e1_dp*t106-t109*t111+t113*t110+0.2e1_dp+t84+t104 & - -0.4e1_dp*t116 + t118 = 0.2e1_dp*t106 - t109*t111 + t113*t110 + 0.2e1_dp + t84 + t104 & + - 0.4e1_dp*t116 t119 = rho*t118 t121 = EXP(-t115) t123 = t121*REAL(t85, KIND=dp)*t101 - e_0 = e_0+(t119*t123/0.8e1_dp)*sx + e_0 = e_0 + (t119*t123/0.8e1_dp)*sx END IF IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN t128 = t5*t17 t131 = 0.1e1_dp/t4 t133 = t33*gamma t134 = t133*t9 - t137 = 0.10e2_dp/0.9e1_dp*t3*t128+t3*t131*t134/0.18e2_dp + t137 = 0.10e2_dp/0.9e1_dp*t3*t128 + t3*t131*t134/0.18e2_dp t138 = t21**2 - t140 = 0.1e1_dp/(0.1e1_dp+t138) + t140 = 0.1e1_dp/(0.1e1_dp + t138) t141 = t137*t140 t143 = t83*REAL(t85, KIND=dp) t146 = t141*t65*t143*t101*R @@ -1673,21 +1673,21 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_lte_b(rho, ndrho, tau, laplace_rho, e_0, & t189 = 0.1e1_dp/t50/t32 t190 = t189*gamma t191 = t190*t9 - t194 = 0.10e2_dp/0.9e1_dp*t24*t128+t24*t131*t134/0.18e2_dp+0.40e2_dp & - /0.27e2_dp*t28*t154+0.2e1_dp/0.27e2_dp*t28*t157*t160+ & - 0.40e2_dp/0.27e2_dp*t38*t163+0.2e1_dp/0.27e2_dp*t38*t30*t168 & - +0.320e3_dp/0.243e3_dp*t47*t172+0.16e2_dp/0.243e3_dp*t47*t175* & - t178+0.800e3_dp/0.729e3_dp*t57*t183+0.40e2_dp/0.729e3_dp*t57* & + t194 = 0.10e2_dp/0.9e1_dp*t24*t128 + t24*t131*t134/0.18e2_dp + 0.40e2_dp & + /0.27e2_dp*t28*t154 + 0.2e1_dp/0.27e2_dp*t28*t157*t160 + & + 0.40e2_dp/0.27e2_dp*t38*t163 + 0.2e1_dp/0.27e2_dp*t38*t30*t168 & + + 0.320e3_dp/0.243e3_dp*t47*t172 + 0.16e2_dp/0.243e3_dp*t47*t175* & + t178 + 0.800e3_dp/0.729e3_dp*t57*t183 + 0.40e2_dp/0.729e3_dp*t57* & t186*t191 t196 = t23*t194*t83 t197 = t196*t103 t199 = 0.1e1_dp/t91 t200 = t66*t199 - t226 = 0.10e2_dp/0.9e1_dp*t67*t128+t67*t131*t134/0.18e2_dp+0.40e2_dp & - /0.27e2_dp*t70*t154+0.2e1_dp/0.27e2_dp*t70*t157*t160+ & - 0.40e2_dp/0.27e2_dp*t73*t163+0.2e1_dp/0.27e2_dp*t73*t30*t168 & - +0.320e3_dp/0.243e3_dp*t76*t172+0.16e2_dp/0.243e3_dp*t76*t175* & - t178+0.800e3_dp/0.729e3_dp*t79*t183+0.40e2_dp/0.729e3_dp*t79* & + t226 = 0.10e2_dp/0.9e1_dp*t67*t128 + t67*t131*t134/0.18e2_dp + 0.40e2_dp & + /0.27e2_dp*t70*t154 + 0.2e1_dp/0.27e2_dp*t70*t157*t160 + & + 0.40e2_dp/0.27e2_dp*t73*t163 + 0.2e1_dp/0.27e2_dp*t73*t30*t168 & + + 0.320e3_dp/0.243e3_dp*t76*t172 + 0.16e2_dp/0.243e3_dp*t76*t175* & + t178 + 0.800e3_dp/0.729e3_dp*t79*t183 + 0.40e2_dp/0.729e3_dp*t79* & t186*t191 t229 = t200*t102*R*t226 t232 = 0.1e1_dp/t100/t99 @@ -1700,11 +1700,11 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_lte_b(rho, ndrho, tau, laplace_rho, e_0, & t249 = t90/t247 t254 = t141*t110 t256 = t66*t199*t226 - t264 = -0.3e1_dp*t234*t235*t237*t141+0.3e1_dp*t242*t97*t10 & - *t194-0.3e1_dp*t249*t97*t10*t226+t94*(t254-t196+ & - t256)*t95*t237-t94*t97/t29 + t264 = -0.3e1_dp*t234*t235*t237*t141 + 0.3e1_dp*t242*t97*t10 & + *t194 - 0.3e1_dp*t249*t97*t10*t226 + t94*(t254 - t196 + & + t256)*t95*t237 - t94*t97/t29 t267 = t84*t233*R*t264 - t270 = (-0.2e1_dp*t146+0.2e1_dp*t197-0.2e1_dp*t229-0.2e1_dp/0.3e1_dp & + t270 = (-0.2e1_dp*t146 + 0.2e1_dp*t197 - 0.2e1_dp*t229 - 0.2e1_dp/0.3e1_dp & *t267)*t106 t272 = R*t23 t277 = t194*t83 @@ -1713,15 +1713,15 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_lte_b(rho, ndrho, tau, laplace_rho, e_0, & t292 = t140*t65*t83 t295 = t65*t199 t298 = t267/0.3e1_dp - t299 = -t254+t196-t256-t146+t197-t229-t298 - t302 = 0.2e1_dp*t270-t270*t272*t111+t108*t141*t111-t109 & - *t277*t102+t280*t281*t101*t226+t280*t143*t232* & - t264/0.3e1_dp+t270*t84-t106*t137*t292+t113*t277-t113 & - *t295*t226-t254+t196-t256-t146+t197-t229-t298 & - -0.4e1_dp*t299*t116 + t299 = -t254 + t196 - t256 - t146 + t197 - t229 - t298 + t302 = 0.2e1_dp*t270 - t270*t272*t111 + t108*t141*t111 - t109 & + *t277*t102 + t280*t281*t101*t226 + t280*t143*t232* & + t264/0.3e1_dp + t270*t84 - t106*t137*t292 + t113*t277 - t113 & + *t295*t226 - t254 + t196 - t256 - t146 + t197 - t229 - t298 & + - 0.4e1_dp*t299*t116 t310 = t119*t121 - e_rho = e_rho+(t118*t121*t102/0.8e1_dp+rho*t302*t123/0.8e1_dp-t119 & - *t299*t123/0.8e1_dp-t310*t233*t264/0.24e2_dp)*sx + e_rho = e_rho + (t118*t121*t102/0.8e1_dp + rho*t302*t123/0.8e1_dp - t119 & + *t299*t123/0.8e1_dp - t310*t233*t264/0.24e2_dp)*sx t314 = t3*t5 t315 = t133*ndrho t317 = t292*t103 @@ -1730,25 +1730,25 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_lte_b(rho, ndrho, tau, laplace_rho, e_0, & t328 = t167*ndrho t332 = t177*ndrho t336 = t190*ndrho - t339 = -t24*t5*t315/0.9e1_dp-0.4e1_dp/0.27e2_dp*t28*t153*t324 & - -0.4e1_dp/0.27e2_dp*t38*t39*t328-0.32e2_dp/0.243e3_dp*t47*t171 & - *t332-0.80e2_dp/0.729e3_dp*t57*t182*t336 + t339 = -t24*t5*t315/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t28*t153*t324 & + - 0.4e1_dp/0.27e2_dp*t38*t39*t328 - 0.32e2_dp/0.243e3_dp*t47*t171 & + *t332 - 0.80e2_dp/0.729e3_dp*t57*t182*t336 t341 = t23*t339*t83 t342 = t341*t103 - t359 = -t67*t5*t315/0.9e1_dp-0.4e1_dp/0.27e2_dp*t70*t153*t324 & - -0.4e1_dp/0.27e2_dp*t73*t39*t328-0.32e2_dp/0.243e3_dp*t76*t171 & - *t332-0.80e2_dp/0.729e3_dp*t79*t182*t336 + t359 = -t67*t5*t315/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t70*t153*t324 & + - 0.4e1_dp/0.27e2_dp*t73*t39*t328 - 0.32e2_dp/0.243e3_dp*t76*t171 & + *t332 - 0.80e2_dp/0.729e3_dp*t79*t182*t336 t362 = t200*t102*R*t359 t368 = gamma*ndrho t369 = t368*t140 t383 = t368*t292 t385 = t3*t5*t33*t383/0.9e1_dp t387 = t66*t199*t359 - t392 = t234*t93*t97*t131*t3*t33*t369/0.3e1_dp+0.3e1_dp* & - t242*t97*t10*t339-0.3e1_dp*t249*t97*t10*t359+t94* & - (-t385-t341+t387)*t95*t237 + t392 = t234*t93*t97*t131*t3*t33*t369/0.3e1_dp + 0.3e1_dp* & + t242*t97*t10*t339 - 0.3e1_dp*t249*t97*t10*t359 + t94* & + (-t385 - t341 + t387)*t95*t237 t395 = t84*t233*R*t392 - t398 = (0.2e1_dp/0.9e1_dp*t318+0.2e1_dp*t342-0.2e1_dp*t362-0.2e1_dp & + t398 = (0.2e1_dp/0.9e1_dp*t318 + 0.2e1_dp*t342 - 0.2e1_dp*t362 - 0.2e1_dp & /0.3e1_dp*t395)*t106 t402 = t108*br_a1 t404 = t2*t5*t33 @@ -1756,14 +1756,14 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_lte_b(rho, ndrho, tau, laplace_rho, e_0, & t420 = t106*br_a1 t427 = t318/0.9e1_dp t428 = t395/0.3e1_dp - t429 = t385+t341-t387+t427+t342-t362-t428 - t432 = 0.2e1_dp*t398-t398*t272*t111-t402*t404*t369*t111 & - /0.9e1_dp-t109*t409*t102+t280*t281*t101*t359+t280 & - *t143*t232*t392/0.3e1_dp+t398*t84+t420*t404*t383/0.9e1_dp & - +t113*t409-t113*t295*t359+t385+t341-t387+t427 & - +t342-t362-t428-0.4e1_dp*t429*t116 - e_ndrho = e_ndrho+(rho*t432*t123/0.8e1_dp-t119*t429*t123/0.8e1_dp-t310 & - *t233*t392/0.24e2_dp)*sx + t429 = t385 + t341 - t387 + t427 + t342 - t362 - t428 + t432 = 0.2e1_dp*t398 - t398*t272*t111 - t402*t404*t369*t111 & + /0.9e1_dp - t109*t409*t102 + t280*t281*t101*t359 + t280 & + *t143*t232*t392/0.3e1_dp + t398*t84 + t420*t404*t383/0.9e1_dp & + + t113*t409 - t113*t295*t359 + t385 + t341 - t387 + t427 & + + t342 - t362 - t428 - 0.4e1_dp*t429*t116 + e_ndrho = e_ndrho + (rho*t432*t123/0.8e1_dp - t119*t429*t123/0.8e1_dp - t310 & + *t233*t392/0.24e2_dp)*sx t443 = t6*t33 t444 = t443*gamma t446 = t3*t444*t317 @@ -1775,24 +1775,24 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_lte_b(rho, ndrho, tau, laplace_rho, e_0, & t459 = t458*gamma t462 = t59*t189 t463 = t462*gamma - t466 = 0.4e1_dp/0.9e1_dp*t24*t444+0.16e2_dp/0.27e2_dp*t28*t451+ & - 0.16e2_dp/0.27e2_dp*t38*t455+0.128e3_dp/0.243e3_dp*t47*t459+0.320e3_dp & + t466 = 0.4e1_dp/0.9e1_dp*t24*t444 + 0.16e2_dp/0.27e2_dp*t28*t451 + & + 0.16e2_dp/0.27e2_dp*t38*t455 + 0.128e3_dp/0.243e3_dp*t47*t459 + 0.320e3_dp & /0.729e3_dp*t57*t463 t468 = t23*t466*t83 t469 = t468*t103 - t481 = 0.4e1_dp/0.9e1_dp*t67*t444+0.16e2_dp/0.27e2_dp*t70*t451+ & - 0.16e2_dp/0.27e2_dp*t73*t455+0.128e3_dp/0.243e3_dp*t76*t459+0.320e3_dp & + t481 = 0.4e1_dp/0.9e1_dp*t67*t444 + 0.16e2_dp/0.27e2_dp*t70*t451 + & + 0.16e2_dp/0.27e2_dp*t73*t455 + 0.128e3_dp/0.243e3_dp*t76*t459 + 0.320e3_dp & /0.729e3_dp*t79*t463 t484 = t200*t102*R*t481 t487 = t234*t235*t96 t501 = gamma*t140 t504 = 0.4e1_dp/0.9e1_dp*t3*t443*t501*t110 t506 = t66*t199*t481 - t511 = -0.4e1_dp/0.3e1_dp*t487*t314*t133*t140+0.3e1_dp*t242* & - t97*t10*t466-0.3e1_dp*t249*t97*t10*t481+t94*(t504- & - t468+t506)*t95*t237 + t511 = -0.4e1_dp/0.3e1_dp*t487*t314*t133*t140 + 0.3e1_dp*t242* & + t97*t10*t466 - 0.3e1_dp*t249*t97*t10*t481 + t94*(t504 - & + t468 + t506)*t95*t237 t514 = t84*t233*R*t511 - t517 = (-0.8e1_dp/0.9e1_dp*t446+0.2e1_dp*t469-0.2e1_dp*t484-0.2e1_dp & + t517 = (-0.8e1_dp/0.9e1_dp*t446 + 0.2e1_dp*t469 - 0.2e1_dp*t484 - 0.2e1_dp & /0.3e1_dp*t514)*t106 t521 = t2*t6 t525 = t143*t101 @@ -1800,23 +1800,23 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_lte_b(rho, ndrho, tau, laplace_rho, e_0, & t540 = t420*t521 t547 = 0.4e1_dp/0.9e1_dp*t446 t548 = t514/0.3e1_dp - t549 = -t504+t468-t506-t547+t469-t484-t548 - t552 = 0.2e1_dp*t517-t517*t272*t111+0.4e1_dp/0.9e1_dp*t402*t521 & - *t33*t501*t65*t525-t109*t529*t102+t280*t281* & - t101*t481+t280*t143*t232*t511/0.3e1_dp+t517*t84-0.4e1_dp & - /0.9e1_dp*t540*t133*t292+t113*t529-t113*t295*t481 & - -t504+t468-t506-t547+t469-t484-t548-0.4e1_dp*t549 & + t549 = -t504 + t468 - t506 - t547 + t469 - t484 - t548 + t552 = 0.2e1_dp*t517 - t517*t272*t111 + 0.4e1_dp/0.9e1_dp*t402*t521 & + *t33*t501*t65*t525 - t109*t529*t102 + t280*t281* & + t101*t481 + t280*t143*t232*t511/0.3e1_dp + t517*t84 - 0.4e1_dp & + /0.9e1_dp*t540*t133*t292 + t113*t529 - t113*t295*t481 & + - t504 + t468 - t506 - t547 + t469 - t484 - t548 - 0.4e1_dp*t549 & *t116 - e_tau = e_tau+(rho*t552*t123/0.8e1_dp-t119*t549*t123/0.8e1_dp-t310 & - *t233*t511/0.24e2_dp)*sx + e_tau = e_tau + (rho*t552*t123/0.8e1_dp - t119*t549*t123/0.8e1_dp - t310 & + *t233*t511/0.24e2_dp)*sx t566 = t3*t443*t140*t110*t103 - t578 = -t24*t443/0.9e1_dp-0.4e1_dp/0.27e2_dp*t28*t450-0.4e1_dp/ & - 0.27e2_dp*t38*t454-0.32e2_dp/0.243e3_dp*t47*t458-0.80e2_dp/0.729e3_dp & + t578 = -t24*t443/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t28*t450 - 0.4e1_dp/ & + 0.27e2_dp*t38*t454 - 0.32e2_dp/0.243e3_dp*t47*t458 - 0.80e2_dp/0.729e3_dp & *t57*t462 t580 = t23*t578*t83 t581 = t580*t103 - t593 = -t67*t443/0.9e1_dp-0.4e1_dp/0.27e2_dp*t70*t450-0.4e1_dp/ & - 0.27e2_dp*t73*t454-0.32e2_dp/0.243e3_dp*t76*t458-0.80e2_dp/0.729e3_dp & + t593 = -t67*t443/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t70*t450 - 0.4e1_dp/ & + 0.27e2_dp*t73*t454 - 0.32e2_dp/0.243e3_dp*t76*t458 - 0.80e2_dp/0.729e3_dp & *t79*t462 t596 = t200*t102*R*t593 t612 = t3*t6 @@ -1824,23 +1824,23 @@ SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_lte_b(rho, ndrho, tau, laplace_rho, e_0, & t614 = t613*t110 t616 = t612*t614/0.9e1_dp t618 = t66*t199*t593 - t623 = t487*t5*br_a1*t2*t33*t140/0.3e1_dp+0.3e1_dp*t242* & - t97*t10*t578-0.3e1_dp*t249*t97*t10*t593+t94*(-t616 & - -t580+t618)*t95*t237 + t623 = t487*t5*br_a1*t2*t33*t140/0.3e1_dp + 0.3e1_dp*t242* & + t97*t10*t578 - 0.3e1_dp*t249*t97*t10*t593 + t94*(-t616 & + - t580 + t618)*t95*t237 t626 = t84*t233*R*t623 - t629 = (0.2e1_dp/0.9e1_dp*t566+0.2e1_dp*t581-0.2e1_dp*t596-0.2e1_dp & + t629 = (0.2e1_dp/0.9e1_dp*t566 + 0.2e1_dp*t581 - 0.2e1_dp*t596 - 0.2e1_dp & /0.3e1_dp*t626)*t106 t638 = t578*t83 t654 = t566/0.9e1_dp t655 = t626/0.3e1_dp - t656 = t616+t580-t618+t654+t581-t596-t655 - t659 = 0.2e1_dp*t629-t629*t272*t111-t108*t612*t613*t65 & - *t525/0.9e1_dp-t109*t638*t102+t280*t281*t101*t593+ & - t280*t143*t232*t623/0.3e1_dp+t629*t84+t540*t614/0.9e1_dp & - +t113*t638-t113*t295*t593+t616+t580-t618+t654 & - +t581-t596-t655-0.4e1_dp*t656*t116 - e_laplace_rho = e_laplace_rho+(rho*t659*t123/0.8e1_dp-t119*t656*t123/0.8e1_dp-t310 & - *t233*t623/0.24e2_dp)*sx + t656 = t616 + t580 - t618 + t654 + t581 - t596 - t655 + t659 = 0.2e1_dp*t629 - t629*t272*t111 - t108*t612*t613*t65 & + *t525/0.9e1_dp - t109*t638*t102 + t280*t281*t101*t593 + & + t280*t143*t232*t623/0.3e1_dp + t629*t84 + t540*t614/0.9e1_dp & + + t113*t638 - t113*t295*t593 + t616 + t580 - t618 + t654 & + + t581 - t596 - t655 - 0.4e1_dp*t656*t116 + e_laplace_rho = e_laplace_rho + (rho*t659*t123/0.8e1_dp - t119*t656*t123/0.8e1_dp - t310 & + *t233*t623/0.24e2_dp)*sx END IF END SUBROUTINE x_br_lsd_y_lte_0_cutoff_R_lte_b @@ -1891,16 +1891,16 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff(rho, ndrho, tau, laplace_rho, e_0, & t11 = 0.1e1_dp/t10 t14 = ndrho**2 t15 = 0.1e1_dp/rho - t21 = laplace_rho/0.6e1_dp-gamma*(REAL(2*tau, KIND=dp)-t14*t15/0.4e1_dp)/0.3e1_dp + t21 = laplace_rho/0.6e1_dp - gamma*(REAL(2*tau, KIND=dp) - t14*t15/0.4e1_dp)/0.3e1_dp t25 = br_BB**2 t26 = t4*pi t28 = rho**2 t31 = t21**2 t33 = t8*t28*rho/t31 - t37 = SQRT(0.10e1_dp+0.4e1_dp/0.9e1_dp*t25*t26*t33) - t44 = LOG(0.1500000000000000e1_dp*t3*t6*t11*t21+0.3e1_dp/0.2e1_dp & + t37 = SQRT(0.10e1_dp + 0.4e1_dp/0.9e1_dp*t25*t26*t33) + t44 = LOG(0.1500000000000000e1_dp*t3*t6*t11*t21 + 0.3e1_dp/0.2e1_dp & *t37*t3*t6*t11*t21) - t45 = t44+0.2e1_dp + t45 = t44 + 0.2e1_dp t46 = t45**2 t50 = t10/t21 t56 = pi**2 @@ -1912,13 +1912,13 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff(rho, ndrho, tau, laplace_rho, e_0, & t75 = t4*t56*pi t77 = t58**2 t81 = t8*t77/t69/t21 - t84 = br_d0+0.2e1_dp/0.3e1_dp*br_d1*t5*t50+0.4e1_dp/0.9e1_dp*br_d2 & - *t26*t33+0.8e1_dp/0.27e2_dp*br_d3*t56*t62+0.16e2_dp/0.81e2_dp & - *br_d4*t65*t71+0.32e2_dp/0.243e3_dp*br_d5*t75*t81 + t84 = br_d0 + 0.2e1_dp/0.3e1_dp*br_d1*t5*t50 + 0.4e1_dp/0.9e1_dp*br_d2 & + *t26*t33 + 0.8e1_dp/0.27e2_dp*br_d3*t56*t62 + 0.16e2_dp/0.81e2_dp & + *br_d4*t65*t71 + 0.32e2_dp/0.243e3_dp*br_d5*t75*t81 t85 = t84**2 - t103 = br_e0+0.2e1_dp/0.3e1_dp*br_e1*t5*t50+0.4e1_dp/0.9e1_dp*br_e2 & - *t26*t33+0.8e1_dp/0.27e2_dp*br_e3*t56*t62+0.16e2_dp/0.81e2_dp & - *br_e4*t65*t71+0.32e2_dp/0.243e3_dp*br_e5*t75*t81 + t103 = br_e0 + 0.2e1_dp/0.3e1_dp*br_e1*t5*t50 + 0.4e1_dp/0.9e1_dp*br_e2 & + *t26*t33 + 0.8e1_dp/0.27e2_dp*br_e3*t56*t62 + 0.16e2_dp/0.81e2_dp & + *br_e4*t65*t71 + 0.32e2_dp/0.243e3_dp*br_e5*t75*t81 t104 = t103**2 t111 = EXP(-t45*t84/t103) t116 = (t46*t45*t85*t84/t104/t103*t111/0.3141592654e1_dp & @@ -1997,7 +1997,7 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_gt_b(rho, ndrho, tau, laplace_rho, e_0, & t9 = 0.1e1_dp/t8 t12 = ndrho**2 t13 = 0.1e1_dp/rho - t19 = laplace_rho/0.6e1_dp-gamma*(REAL(2*tau, KIND=dp)-t12*t13/0.4e1_dp)/0.3e1_dp + t19 = laplace_rho/0.6e1_dp - gamma*(REAL(2*tau, KIND=dp) - t12*t13/0.4e1_dp)/0.3e1_dp t20 = t9*t19 t23 = br_BB**2 t24 = t2*pi @@ -2008,13 +2008,13 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_gt_b(rho, ndrho, tau, laplace_rho, e_0, & t29 = t19**2 t30 = 0.1e1_dp/t29 t31 = t28*t30 - t35 = SQRT(0.10e1_dp+0.4e1_dp/0.9e1_dp*t25*t31) + t35 = SQRT(0.10e1_dp + 0.4e1_dp/0.9e1_dp*t25*t31) t36 = t35*t1 t37 = t4*t9 - t41 = 0.1500000000000000e1_dp*t5*t20+0.3e1_dp/0.2e1_dp*t36*t37* & + t41 = 0.1500000000000000e1_dp*t5*t20 + 0.3e1_dp/0.2e1_dp*t36*t37* & t19 t42 = LOG(t41) - t43 = t42+0.2e1_dp + t43 = t42 + 0.2e1_dp t44 = br_d1*t3 t45 = 0.1e1_dp/t19 t46 = t8*t45 @@ -2038,8 +2038,8 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_gt_b(rho, ndrho, tau, laplace_rho, e_0, & t74 = t6*t73 t76 = 0.1e1_dp/t65/t19 t77 = t74*t76 - t80 = br_d0+0.2e1_dp/0.3e1_dp*t44*t46+0.4e1_dp/0.9e1_dp*t49*t31 & - +0.8e1_dp/0.27e2_dp*t53*t58+0.16e2_dp/0.81e2_dp*t62*t67+0.32e2_dp & + t80 = br_d0 + 0.2e1_dp/0.3e1_dp*t44*t46 + 0.4e1_dp/0.9e1_dp*t49*t31 & + + 0.8e1_dp/0.27e2_dp*t53*t58 + 0.16e2_dp/0.81e2_dp*t62*t67 + 0.32e2_dp & /0.243e3_dp*t72*t77 t81 = t43*t80 t82 = br_e1*t3 @@ -2047,8 +2047,8 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_gt_b(rho, ndrho, tau, laplace_rho, e_0, & t88 = br_e3*t52 t91 = br_e4*t61 t94 = br_e5*t71 - t97 = br_e0+0.2e1_dp/0.3e1_dp*t82*t46+0.4e1_dp/0.9e1_dp*t85*t31 & - +0.8e1_dp/0.27e2_dp*t88*t58+0.16e2_dp/0.81e2_dp*t91*t67+0.32e2_dp & + t97 = br_e0 + 0.2e1_dp/0.3e1_dp*t82*t46 + 0.4e1_dp/0.9e1_dp*t85*t31 & + + 0.8e1_dp/0.27e2_dp*t88*t58 + 0.16e2_dp/0.81e2_dp*t91*t67 + 0.32e2_dp & /0.243e3_dp*t94*t77 t98 = 0.1e1_dp/t97 t99 = t81*t98 @@ -2070,18 +2070,18 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_gt_b(rho, ndrho, tau, laplace_rho, e_0, & t117 = REAL(t100, KIND=dp)*t116 t118 = t117*R t119 = t99*t118 - t121 = EXP(t99-t119) + t121 = EXP(t99 - t119) t123 = t121*t43 t124 = t80*t98 t125 = t123*t124 t129 = t98*REAL(t100, KIND=dp)*t116*R - t132 = EXP(-t99-t119) + t132 = EXP(-t99 - t119) t134 = t132*t43 t135 = t134*t124 - t138 = -0.2e1_dp*t121+t125-t123*t80*t129+0.2e1_dp*t132+t135 & - +t134*t80*t129 + t138 = -0.2e1_dp*t121 + t125 - t123*t80*t129 + 0.2e1_dp*t132 + t135 & + + t134*t80*t129 t139 = rho*t138 - e_0 = e_0+(t139*t117/0.8e1_dp)*sx + e_0 = e_0 + (t139*t117/0.8e1_dp)*sx END IF IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN t145 = 0.1e1_dp/t7/t26 @@ -2093,10 +2093,10 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_gt_b(rho, ndrho, tau, laplace_rho, e_0, & t164 = t57*gamma t165 = t164*t12 t176 = t36*t4 - t179 = -0.2500000000e1_dp*t5*t145*t19-0.1250000000e0_dp*t5*t152 & - +0.3e1_dp/0.4e1_dp*t155*t1*t4*t20*(0.40e2_dp/0.27e2_dp*t25 & - *t159+0.2e1_dp/0.27e2_dp*t25*t162*t165)-0.5e1_dp/0.2e1_dp*t36 & - *t4*t145*t19-t176*t152/0.8e1_dp + t179 = -0.2500000000e1_dp*t5*t145*t19 - 0.1250000000e0_dp*t5*t152 & + + 0.3e1_dp/0.4e1_dp*t155*t1*t4*t20*(0.40e2_dp/0.27e2_dp*t25 & + *t159 + 0.2e1_dp/0.27e2_dp*t25*t162*t165) - 0.5e1_dp/0.2e1_dp*t36 & + *t4*t145*t19 - t176*t152/0.8e1_dp t180 = 0.1e1_dp/t41 t181 = t179*t180 t182 = t181*t124 @@ -2118,19 +2118,19 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_gt_b(rho, ndrho, tau, laplace_rho, e_0, & t223 = 0.1e1_dp/t65/t29 t224 = t223*gamma t225 = t224*t12 - t228 = 0.10e2_dp/0.9e1_dp*t44*t183+t44*t186*t189/0.18e2_dp+0.40e2_dp & - /0.27e2_dp*t49*t159+0.2e1_dp/0.27e2_dp*t49*t162*t165+ & - 0.40e2_dp/0.27e2_dp*t53*t197+0.2e1_dp/0.27e2_dp*t53*t27*t202 & - +0.320e3_dp/0.243e3_dp*t62*t206+0.16e2_dp/0.243e3_dp*t62*t209* & - t212+0.800e3_dp/0.729e3_dp*t72*t217+0.40e2_dp/0.729e3_dp*t72* & + t228 = 0.10e2_dp/0.9e1_dp*t44*t183 + t44*t186*t189/0.18e2_dp + 0.40e2_dp & + /0.27e2_dp*t49*t159 + 0.2e1_dp/0.27e2_dp*t49*t162*t165 + & + 0.40e2_dp/0.27e2_dp*t53*t197 + 0.2e1_dp/0.27e2_dp*t53*t27*t202 & + + 0.320e3_dp/0.243e3_dp*t62*t206 + 0.16e2_dp/0.243e3_dp*t62*t209* & + t212 + 0.800e3_dp/0.729e3_dp*t72*t217 + 0.40e2_dp/0.729e3_dp*t72* & t220*t225 t230 = t43*t228*t98 t231 = 0.1e1_dp/t106 - t257 = 0.10e2_dp/0.9e1_dp*t82*t183+t82*t186*t189/0.18e2_dp+0.40e2_dp & - /0.27e2_dp*t85*t159+0.2e1_dp/0.27e2_dp*t85*t162*t165+ & - 0.40e2_dp/0.27e2_dp*t88*t197+0.2e1_dp/0.27e2_dp*t88*t27*t202 & - +0.320e3_dp/0.243e3_dp*t91*t206+0.16e2_dp/0.243e3_dp*t91*t209* & - t212+0.800e3_dp/0.729e3_dp*t94*t217+0.40e2_dp/0.729e3_dp*t94* & + t257 = 0.10e2_dp/0.9e1_dp*t82*t183 + t82*t186*t189/0.18e2_dp + 0.40e2_dp & + /0.27e2_dp*t85*t159 + 0.2e1_dp/0.27e2_dp*t85*t162*t165 + & + 0.40e2_dp/0.27e2_dp*t88*t197 + 0.2e1_dp/0.27e2_dp*t88*t27*t202 & + + 0.320e3_dp/0.243e3_dp*t91*t206 + 0.16e2_dp/0.243e3_dp*t91*t209* & + t212 + 0.800e3_dp/0.729e3_dp*t94*t217 + 0.40e2_dp/0.729e3_dp*t94* & t220*t225 t259 = t81*t231*t257 t261 = t181*t80*t129 @@ -2144,12 +2144,12 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_gt_b(rho, ndrho, tau, laplace_rho, e_0, & t278 = t102*t103*t108 t283 = t106**2 t285 = t105/t283 - t297 = 0.3e1_dp*t272*t273*t181+0.3e1_dp*t278*t112*t13*t228 & - -0.3e1_dp*t285*t112*t13*t257+t109*(-t182-t230+t259) & - *t110*t273-t109*t112/t26 + t297 = 0.3e1_dp*t272*t273*t181 + 0.3e1_dp*t278*t112*t13*t228 & + - 0.3e1_dp*t285*t112*t13*t257 + t109*(-t182 - t230 + t259) & + *t110*t273 - t109*t112/t26 t299 = t269*R*t297 t301 = t99*t299/0.3e1_dp - t303 = (t182+t230-t259-t261-t262+t266+t301)*t121 + t303 = (t182 + t230 - t259 - t261 - t262 + t266 + t301)*t121 t306 = t121*t179 t307 = t180*t80 t308 = t307*t98 @@ -2157,22 +2157,22 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_gt_b(rho, ndrho, tau, laplace_rho, e_0, & t312 = t80*t231 t313 = t312*t257 t321 = t123*t312 - t326 = (-t182-t230+t259-t261-t262+t266+t301)*t132 + t326 = (-t182 - t230 + t259 - t261 - t262 + t266 + t301)*t132 t329 = t132*t179 t339 = t134*t312 - t343 = -0.2e1_dp*t303+t303*t99+t306*t308+t123*t310-t123 & - *t313-t303*t81*t129-t306*t307*t129-t123*t228* & - t129+t321*t265+t125*t299/0.3e1_dp+0.2e1_dp*t326+t326*t99 & - +t329*t308+t134*t310-t134*t313+t326*t81*t129+ & - t329*t307*t129+t134*t228*t129-t339*t265-t135*t299 & + t343 = -0.2e1_dp*t303 + t303*t99 + t306*t308 + t123*t310 - t123 & + *t313 - t303*t81*t129 - t306*t307*t129 - t123*t228* & + t129 + t321*t265 + t125*t299/0.3e1_dp + 0.2e1_dp*t326 + t326*t99 & + + t329*t308 + t134*t310 - t134*t313 + t326*t81*t129 + & + t329*t307*t129 + t134*t228*t129 - t339*t265 - t135*t299 & /0.3e1_dp - e_rho = e_rho+(t138*REAL(t100, KIND=dp)*t116/0.8e1_dp+rho*t343*t117/0.8e1_dp & - -t139*t269*t297/0.24e2_dp)*sx + e_rho = e_rho + (t138*REAL(t100, KIND=dp)*t116/0.8e1_dp + rho*t343*t117/0.8e1_dp & + - t139*t269*t297/0.24e2_dp)*sx t351 = t145*gamma*ndrho t354 = t155*br_BB t355 = t354*t3 - t363 = 0.2500000000000000e0_dp*t5*t351-t355*t7*t30*gamma*ndrho & - /0.9e1_dp+t176*t351/0.4e1_dp + t363 = 0.2500000000000000e0_dp*t5*t351 - t355*t7*t30*gamma*ndrho & + /0.9e1_dp + t176*t351/0.4e1_dp t364 = t363*t180 t365 = t364*t124 t367 = t188*ndrho @@ -2180,40 +2180,40 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_gt_b(rho, ndrho, tau, laplace_rho, e_0, & t375 = t201*ndrho t379 = t211*ndrho t383 = t224*ndrho - t386 = -t44*t7*t367/0.9e1_dp-0.4e1_dp/0.27e2_dp*t49*t158*t371 & - -0.4e1_dp/0.27e2_dp*t53*t54*t375-0.32e2_dp/0.243e3_dp*t62*t205 & - *t379-0.80e2_dp/0.729e3_dp*t72*t216*t383 + t386 = -t44*t7*t367/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t49*t158*t371 & + - 0.4e1_dp/0.27e2_dp*t53*t54*t375 - 0.32e2_dp/0.243e3_dp*t62*t205 & + *t379 - 0.80e2_dp/0.729e3_dp*t72*t216*t383 t388 = t43*t386*t98 - t404 = -t82*t7*t367/0.9e1_dp-0.4e1_dp/0.27e2_dp*t85*t158*t371 & - -0.4e1_dp/0.27e2_dp*t88*t54*t375-0.32e2_dp/0.243e3_dp*t91*t205 & - *t379-0.80e2_dp/0.729e3_dp*t94*t216*t383 + t404 = -t82*t7*t367/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t85*t158*t371 & + - 0.4e1_dp/0.27e2_dp*t88*t54*t375 - 0.32e2_dp/0.243e3_dp*t91*t205 & + *t379 - 0.80e2_dp/0.729e3_dp*t94*t216*t383 t406 = t81*t231*t404 t408 = t364*t80*t129 t409 = t388*t118 t411 = t117*R*t404 t412 = t263*t411 - t428 = 0.3e1_dp*t272*t273*t364+0.3e1_dp*t278*t112*t13*t386 & - -0.3e1_dp*t285*t112*t13*t404+t109*(-t365-t388+t406) & + t428 = 0.3e1_dp*t272*t273*t364 + 0.3e1_dp*t278*t112*t13*t386 & + - 0.3e1_dp*t285*t112*t13*t404 + t109*(-t365 - t388 + t406) & *t110*t273 t430 = t269*R*t428 t432 = t99*t430/0.3e1_dp - t434 = (t365+t388-t406-t408-t409+t412+t432)*t121 + t434 = (t365 + t388 - t406 - t408 - t409 + t412 + t432)*t121 t437 = t121*t363 t439 = t386*t98 t441 = t312*t404 - t453 = (-t365-t388+t406-t408-t409+t412+t432)*t132 + t453 = (-t365 - t388 + t406 - t408 - t409 + t412 + t432)*t132 t456 = t132*t363 - t469 = -0.2e1_dp*t434+t434*t99+t437*t308+t123*t439-t123 & - *t441-t434*t81*t129-t437*t307*t129-t123*t386* & - t129+t321*t411+t125*t430/0.3e1_dp+0.2e1_dp*t453+t453*t99 & - +t456*t308+t134*t439-t134*t441+t453*t81*t129+ & - t456*t307*t129+t134*t386*t129-t339*t411-t135*t430 & + t469 = -0.2e1_dp*t434 + t434*t99 + t437*t308 + t123*t439 - t123 & + *t441 - t434*t81*t129 - t437*t307*t129 - t123*t386* & + t129 + t321*t411 + t125*t430/0.3e1_dp + 0.2e1_dp*t453 + t453*t99 & + + t456*t308 + t134*t439 - t134*t441 + t453*t81*t129 + & + t456*t307*t129 + t134*t386*t129 - t339*t411 - t135*t430 & /0.3e1_dp - e_ndrho = e_ndrho+(rho*t469*t117/0.8e1_dp-t139*t269*t428/0.24e2_dp)*sx + e_ndrho = e_ndrho + (rho*t469*t117/0.8e1_dp - t139*t269*t428/0.24e2_dp)*sx t479 = t8*t30 t480 = t479*gamma - t485 = -0.1000000000e1_dp*t5*t9*gamma+0.4e1_dp/0.9e1_dp*t355*t480 & - -t36*t37*gamma + t485 = -0.1000000000e1_dp*t5*t9*gamma + 0.4e1_dp/0.9e1_dp*t355*t480 & + - t36*t37*gamma t486 = t485*t180 t487 = t486*t124 t490 = t28*t57 @@ -2224,70 +2224,70 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_gt_b(rho, ndrho, tau, laplace_rho, e_0, & t499 = t498*gamma t502 = t74*t223 t503 = t502*gamma - t506 = 0.4e1_dp/0.9e1_dp*t44*t480+0.16e2_dp/0.27e2_dp*t49*t491+ & - 0.16e2_dp/0.27e2_dp*t53*t495+0.128e3_dp/0.243e3_dp*t62*t499+0.320e3_dp & + t506 = 0.4e1_dp/0.9e1_dp*t44*t480 + 0.16e2_dp/0.27e2_dp*t49*t491 + & + 0.16e2_dp/0.27e2_dp*t53*t495 + 0.128e3_dp/0.243e3_dp*t62*t499 + 0.320e3_dp & /0.729e3_dp*t72*t503 t508 = t43*t506*t98 - t519 = 0.4e1_dp/0.9e1_dp*t82*t480+0.16e2_dp/0.27e2_dp*t85*t491+ & - 0.16e2_dp/0.27e2_dp*t88*t495+0.128e3_dp/0.243e3_dp*t91*t499+0.320e3_dp & + t519 = 0.4e1_dp/0.9e1_dp*t82*t480 + 0.16e2_dp/0.27e2_dp*t85*t491 + & + 0.16e2_dp/0.27e2_dp*t88*t495 + 0.128e3_dp/0.243e3_dp*t91*t499 + 0.320e3_dp & /0.729e3_dp*t94*t503 t521 = t81*t231*t519 t523 = t486*t80*t129 t524 = t508*t118 t526 = t117*R*t519 t527 = t263*t526 - t543 = 0.3e1_dp*t272*t273*t486+0.3e1_dp*t278*t112*t13*t506 & - -0.3e1_dp*t285*t112*t13*t519+t109*(-t487-t508+t521) & + t543 = 0.3e1_dp*t272*t273*t486 + 0.3e1_dp*t278*t112*t13*t506 & + - 0.3e1_dp*t285*t112*t13*t519 + t109*(-t487 - t508 + t521) & *t110*t273 t545 = t269*R*t543 t547 = t99*t545/0.3e1_dp - t549 = (t487+t508-t521-t523-t524+t527+t547)*t121 + t549 = (t487 + t508 - t521 - t523 - t524 + t527 + t547)*t121 t552 = t121*t485 t554 = t506*t98 t556 = t312*t519 - t568 = (-t487-t508+t521-t523-t524+t527+t547)*t132 + t568 = (-t487 - t508 + t521 - t523 - t524 + t527 + t547)*t132 t571 = t132*t485 - t584 = -0.2e1_dp*t549+t549*t99+t552*t308+t123*t554-t123 & - *t556-t549*t81*t129-t552*t307*t129-t123*t506* & - t129+t321*t526+t125*t545/0.3e1_dp+0.2e1_dp*t568+t568*t99 & - +t571*t308+t134*t554-t134*t556+t568*t81*t129+ & - t571*t307*t129+t134*t506*t129-t339*t526-t135*t545 & + t584 = -0.2e1_dp*t549 + t549*t99 + t552*t308 + t123*t554 - t123 & + *t556 - t549*t81*t129 - t552*t307*t129 - t123*t506* & + t129 + t321*t526 + t125*t545/0.3e1_dp + 0.2e1_dp*t568 + t568*t99 & + + t571*t308 + t134*t554 - t134*t556 + t568*t81*t129 + & + t571*t307*t129 + t134*t506*t129 - t339*t526 - t135*t545 & /0.3e1_dp - e_tau = e_tau+(rho*t584*t117/0.8e1_dp-t139*t269*t543/0.24e2_dp)*sx - t599 = 0.2500000000000000e0_dp*t5*t9-t354*t3*t8*t30/0.9e1_dp & - +t36*t37/0.4e1_dp + e_tau = e_tau + (rho*t584*t117/0.8e1_dp - t139*t269*t543/0.24e2_dp)*sx + t599 = 0.2500000000000000e0_dp*t5*t9 - t354*t3*t8*t30/0.9e1_dp & + + t36*t37/0.4e1_dp t600 = t599*t180 t601 = t600*t124 - t612 = -t44*t479/0.9e1_dp-0.4e1_dp/0.27e2_dp*t49*t490-0.4e1_dp/ & - 0.27e2_dp*t53*t494-0.32e2_dp/0.243e3_dp*t62*t498-0.80e2_dp/0.729e3_dp & + t612 = -t44*t479/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t49*t490 - 0.4e1_dp/ & + 0.27e2_dp*t53*t494 - 0.32e2_dp/0.243e3_dp*t62*t498 - 0.80e2_dp/0.729e3_dp & *t72*t502 t614 = t43*t612*t98 - t625 = -t82*t479/0.9e1_dp-0.4e1_dp/0.27e2_dp*t85*t490-0.4e1_dp/ & - 0.27e2_dp*t88*t494-0.32e2_dp/0.243e3_dp*t91*t498-0.80e2_dp/0.729e3_dp & + t625 = -t82*t479/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t85*t490 - 0.4e1_dp/ & + 0.27e2_dp*t88*t494 - 0.32e2_dp/0.243e3_dp*t91*t498 - 0.80e2_dp/0.729e3_dp & *t94*t502 t627 = t81*t231*t625 t629 = t600*t80*t129 t630 = t614*t118 t632 = t117*R*t625 t633 = t263*t632 - t649 = 0.3e1_dp*t272*t273*t600+0.3e1_dp*t278*t112*t13*t612 & - -0.3e1_dp*t285*t112*t13*t625+t109*(-t601-t614+t627) & + t649 = 0.3e1_dp*t272*t273*t600 + 0.3e1_dp*t278*t112*t13*t612 & + - 0.3e1_dp*t285*t112*t13*t625 + t109*(-t601 - t614 + t627) & *t110*t273 t651 = t269*R*t649 t653 = t99*t651/0.3e1_dp - t655 = (t601+t614-t627-t629-t630+t633+t653)*t121 + t655 = (t601 + t614 - t627 - t629 - t630 + t633 + t653)*t121 t658 = t121*t599 t660 = t612*t98 t662 = t312*t625 - t674 = (-t601-t614+t627-t629-t630+t633+t653)*t132 + t674 = (-t601 - t614 + t627 - t629 - t630 + t633 + t653)*t132 t677 = t132*t599 - t690 = -0.2e1_dp*t655+t655*t99+t658*t308+t123*t660-t123 & - *t662-t655*t81*t129-t658*t307*t129-t123*t612* & - t129+t321*t632+t125*t651/0.3e1_dp+0.2e1_dp*t674+t674*t99 & - +t677*t308+t134*t660-t134*t662+t674*t81*t129+ & - t677*t307*t129+t134*t612*t129-t339*t632-t135*t651 & + t690 = -0.2e1_dp*t655 + t655*t99 + t658*t308 + t123*t660 - t123 & + *t662 - t655*t81*t129 - t658*t307*t129 - t123*t612* & + t129 + t321*t632 + t125*t651/0.3e1_dp + 0.2e1_dp*t674 + t674*t99 & + + t677*t308 + t134*t660 - t134*t662 + t674*t81*t129 + & + t677*t307*t129 + t134*t612*t129 - t339*t632 - t135*t651 & /0.3e1_dp - e_laplace_rho = e_laplace_rho+(rho*t690*t117/0.8e1_dp-t139*t269*t649/0.24e2_dp)*sx + e_laplace_rho = e_laplace_rho + (rho*t690*t117/0.8e1_dp - t139*t269*t649/0.24e2_dp)*sx END IF END SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_gt_b @@ -2351,7 +2351,7 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_lte_b(rho, ndrho, tau, laplace_rho, e_0, & t9 = 0.1e1_dp/t8 t12 = ndrho**2 t13 = 0.1e1_dp/rho - t19 = laplace_rho/0.6e1_dp-gamma*(REAL(2*tau, KIND=dp)-t12*t13/0.4e1_dp)/0.3e1_dp + t19 = laplace_rho/0.6e1_dp - gamma*(REAL(2*tau, KIND=dp) - t12*t13/0.4e1_dp)/0.3e1_dp t20 = t9*t19 t23 = br_BB**2 t24 = t2*pi @@ -2362,13 +2362,13 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_lte_b(rho, ndrho, tau, laplace_rho, e_0, & t29 = t19**2 t30 = 0.1e1_dp/t29 t31 = t28*t30 - t35 = SQRT(0.10e1_dp+0.4e1_dp/0.9e1_dp*t25*t31) + t35 = SQRT(0.10e1_dp + 0.4e1_dp/0.9e1_dp*t25*t31) t36 = t35*t1 t37 = t4*t9 - t41 = 0.1500000000000000e1_dp*t5*t20+0.3e1_dp/0.2e1_dp*t36*t37* & + t41 = 0.1500000000000000e1_dp*t5*t20 + 0.3e1_dp/0.2e1_dp*t36*t37* & t19 t42 = LOG(t41) - t43 = t42+0.2e1_dp + t43 = t42 + 0.2e1_dp t44 = br_d1*t3 t45 = 0.1e1_dp/t19 t46 = t8*t45 @@ -2392,8 +2392,8 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_lte_b(rho, ndrho, tau, laplace_rho, e_0, & t74 = t6*t73 t76 = 0.1e1_dp/t65/t19 t77 = t74*t76 - t80 = br_d0+0.2e1_dp/0.3e1_dp*t44*t46+0.4e1_dp/0.9e1_dp*t49*t31 & - +0.8e1_dp/0.27e2_dp*t53*t58+0.16e2_dp/0.81e2_dp*t62*t67+0.32e2_dp & + t80 = br_d0 + 0.2e1_dp/0.3e1_dp*t44*t46 + 0.4e1_dp/0.9e1_dp*t49*t31 & + + 0.8e1_dp/0.27e2_dp*t53*t58 + 0.16e2_dp/0.81e2_dp*t62*t67 + 0.32e2_dp & /0.243e3_dp*t72*t77 t81 = t43*t80 t82 = br_e1*t3 @@ -2401,8 +2401,8 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_lte_b(rho, ndrho, tau, laplace_rho, e_0, & t88 = br_e3*t52 t91 = br_e4*t61 t94 = br_e5*t71 - t97 = br_e0+0.2e1_dp/0.3e1_dp*t82*t46+0.4e1_dp/0.9e1_dp*t85*t31 & - +0.8e1_dp/0.27e2_dp*t88*t58+0.16e2_dp/0.81e2_dp*t91*t67+0.32e2_dp & + t97 = br_e0 + 0.2e1_dp/0.3e1_dp*t82*t46 + 0.4e1_dp/0.9e1_dp*t85*t31 & + + 0.8e1_dp/0.27e2_dp*t88*t58 + 0.16e2_dp/0.81e2_dp*t91*t67 + 0.32e2_dp & /0.243e3_dp*t94*t77 t98 = 0.1e1_dp/t97 t99 = t81*t98 @@ -2430,14 +2430,14 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_lte_b(rho, ndrho, tau, laplace_rho, e_0, & t125 = t80*t98 t126 = t125*t117 t128 = t121*t43 - t130 = t99+t119 + t130 = t99 + t119 t131 = EXP(t130) - t133 = 0.2e1_dp*t121-t124*t126+t128*t125+0.2e1_dp+t99+t119 & - -0.4e1_dp*t131 + t133 = 0.2e1_dp*t121 - t124*t126 + t128*t125 + 0.2e1_dp + t99 + t119 & + - 0.4e1_dp*t131 t134 = rho*t133 t136 = EXP(-t130) t138 = t136*REAL(t100, KIND=dp)*t116 - e_0 = e_0+(t134*t138/0.8e1_dp)*sx + e_0 = e_0 + (t134*t138/0.8e1_dp)*sx END IF IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN t144 = 0.1e1_dp/t7/t26 @@ -2449,10 +2449,10 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_lte_b(rho, ndrho, tau, laplace_rho, e_0, & t163 = t57*gamma t164 = t163*t12 t175 = t36*t4 - t178 = -0.2500000000e1_dp*t5*t144*t19-0.1250000000e0_dp*t5*t151 & - +0.3e1_dp/0.4e1_dp*t154*t1*t4*t20*(0.40e2_dp/0.27e2_dp*t25 & - *t158+0.2e1_dp/0.27e2_dp*t25*t161*t164)-0.5e1_dp/0.2e1_dp*t36 & - *t4*t144*t19-t175*t151/0.8e1_dp + t178 = -0.2500000000e1_dp*t5*t144*t19 - 0.1250000000e0_dp*t5*t151 & + + 0.3e1_dp/0.4e1_dp*t154*t1*t4*t20*(0.40e2_dp/0.27e2_dp*t25 & + *t158 + 0.2e1_dp/0.27e2_dp*t25*t161*t164) - 0.5e1_dp/0.2e1_dp*t36 & + *t4*t144*t19 - t175*t151/0.8e1_dp t179 = 0.1e1_dp/t41 t180 = t178*t179 t182 = t98*REAL(t100, KIND=dp) @@ -2476,21 +2476,21 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_lte_b(rho, ndrho, tau, laplace_rho, e_0, & t227 = 0.1e1_dp/t65/t29 t228 = t227*gamma t229 = t228*t12 - t232 = 0.10e2_dp/0.9e1_dp*t44*t187+t44*t190*t193/0.18e2_dp+0.40e2_dp & - /0.27e2_dp*t49*t158+0.2e1_dp/0.27e2_dp*t49*t161*t164+ & - 0.40e2_dp/0.27e2_dp*t53*t201+0.2e1_dp/0.27e2_dp*t53*t27*t206 & - +0.320e3_dp/0.243e3_dp*t62*t210+0.16e2_dp/0.243e3_dp*t62*t213* & - t216+0.800e3_dp/0.729e3_dp*t72*t221+0.40e2_dp/0.729e3_dp*t72* & + t232 = 0.10e2_dp/0.9e1_dp*t44*t187 + t44*t190*t193/0.18e2_dp + 0.40e2_dp & + /0.27e2_dp*t49*t158 + 0.2e1_dp/0.27e2_dp*t49*t161*t164 + & + 0.40e2_dp/0.27e2_dp*t53*t201 + 0.2e1_dp/0.27e2_dp*t53*t27*t206 & + + 0.320e3_dp/0.243e3_dp*t62*t210 + 0.16e2_dp/0.243e3_dp*t62*t213* & + t216 + 0.800e3_dp/0.729e3_dp*t72*t221 + 0.40e2_dp/0.729e3_dp*t72* & t224*t229 t234 = t43*t232*t98 t235 = t234*t118 t237 = 0.1e1_dp/t106 t238 = t81*t237 - t264 = 0.10e2_dp/0.9e1_dp*t82*t187+t82*t190*t193/0.18e2_dp+0.40e2_dp & - /0.27e2_dp*t85*t158+0.2e1_dp/0.27e2_dp*t85*t161*t164+ & - 0.40e2_dp/0.27e2_dp*t88*t201+0.2e1_dp/0.27e2_dp*t88*t27*t206 & - +0.320e3_dp/0.243e3_dp*t91*t210+0.16e2_dp/0.243e3_dp*t91*t213* & - t216+0.800e3_dp/0.729e3_dp*t94*t221+0.40e2_dp/0.729e3_dp*t94* & + t264 = 0.10e2_dp/0.9e1_dp*t82*t187 + t82*t190*t193/0.18e2_dp + 0.40e2_dp & + /0.27e2_dp*t85*t158 + 0.2e1_dp/0.27e2_dp*t85*t161*t164 + & + 0.40e2_dp/0.27e2_dp*t88*t201 + 0.2e1_dp/0.27e2_dp*t88*t27*t206 & + + 0.320e3_dp/0.243e3_dp*t91*t210 + 0.16e2_dp/0.243e3_dp*t91*t213* & + t216 + 0.800e3_dp/0.729e3_dp*t94*t221 + 0.40e2_dp/0.729e3_dp*t94* & t224*t229 t267 = t238*t117*R*t264 t270 = 0.1e1_dp/t115/t114 @@ -2502,11 +2502,11 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_lte_b(rho, ndrho, tau, laplace_rho, e_0, & t287 = t105/t285 t292 = t180*t125 t294 = t81*t237*t264 - t302 = 0.3e1_dp*t274*t275*t180+0.3e1_dp*t280*t112*t13*t232 & - -0.3e1_dp*t287*t112*t13*t264+t109*(-t292-t234+t294) & - *t110*t275-t109*t112/t26 + t302 = 0.3e1_dp*t274*t275*t180 + 0.3e1_dp*t280*t112*t13*t232 & + - 0.3e1_dp*t287*t112*t13*t264 + t109*(-t292 - t234 + t294) & + *t110*t275 - t109*t112/t26 t305 = t99*t271*R*t302 - t308 = (0.2e1_dp*t185+0.2e1_dp*t235-0.2e1_dp*t267-0.2e1_dp/0.3e1_dp & + t308 = (0.2e1_dp*t185 + 0.2e1_dp*t235 - 0.2e1_dp*t267 - 0.2e1_dp/0.3e1_dp & *t305)*t121 t310 = R*t43 t315 = t232*t98 @@ -2515,20 +2515,20 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_lte_b(rho, ndrho, tau, laplace_rho, e_0, & t330 = t179*t80*t98 t333 = t80*t237 t336 = t305/0.3e1_dp - t337 = t292+t234-t294+t185+t235-t267-t336 - t340 = 0.2e1_dp*t308-t308*t310*t126-t123*t180*t126-t124 & - *t315*t117+t318*t319*t116*t264+t318*t182*t270* & - t302/0.3e1_dp+t308*t99+t121*t178*t330+t128*t315-t128 & - *t333*t264+t292+t234-t294+t185+t235-t267-t336 & - -0.4e1_dp*t337*t131 + t337 = t292 + t234 - t294 + t185 + t235 - t267 - t336 + t340 = 0.2e1_dp*t308 - t308*t310*t126 - t123*t180*t126 - t124 & + *t315*t117 + t318*t319*t116*t264 + t318*t182*t270* & + t302/0.3e1_dp + t308*t99 + t121*t178*t330 + t128*t315 - t128 & + *t333*t264 + t292 + t234 - t294 + t185 + t235 - t267 - t336 & + - 0.4e1_dp*t337*t131 t348 = t134*t136 - e_rho = e_rho+(t133*t136*t117/0.8e1_dp+rho*t340*t138/0.8e1_dp-t134 & - *t337*t138/0.8e1_dp-t348*t271*t302/0.24e2_dp)*sx + e_rho = e_rho + (t133*t136*t117/0.8e1_dp + rho*t340*t138/0.8e1_dp - t134 & + *t337*t138/0.8e1_dp - t348*t271*t302/0.24e2_dp)*sx t353 = t144*gamma*ndrho t356 = t154*br_BB t357 = t356*t3 - t365 = 0.2500000000000000e0_dp*t5*t353-t357*t7*t30*gamma*ndrho & - /0.9e1_dp+t175*t353/0.4e1_dp + t365 = 0.2500000000000000e0_dp*t5*t353 - t357*t7*t30*gamma*ndrho & + /0.9e1_dp + t175*t353/0.4e1_dp t366 = t365*t179 t368 = t366*t80*t184 t371 = t192*ndrho @@ -2536,37 +2536,37 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_lte_b(rho, ndrho, tau, laplace_rho, e_0, & t379 = t205*ndrho t383 = t215*ndrho t387 = t228*ndrho - t390 = -t44*t7*t371/0.9e1_dp-0.4e1_dp/0.27e2_dp*t49*t157*t375 & - -0.4e1_dp/0.27e2_dp*t53*t54*t379-0.32e2_dp/0.243e3_dp*t62*t209 & - *t383-0.80e2_dp/0.729e3_dp*t72*t220*t387 + t390 = -t44*t7*t371/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t49*t157*t375 & + - 0.4e1_dp/0.27e2_dp*t53*t54*t379 - 0.32e2_dp/0.243e3_dp*t62*t209 & + *t383 - 0.80e2_dp/0.729e3_dp*t72*t220*t387 t392 = t43*t390*t98 t393 = t392*t118 - t410 = -t82*t7*t371/0.9e1_dp-0.4e1_dp/0.27e2_dp*t85*t157*t375 & - -0.4e1_dp/0.27e2_dp*t88*t54*t379-0.32e2_dp/0.243e3_dp*t91*t209 & - *t383-0.80e2_dp/0.729e3_dp*t94*t220*t387 + t410 = -t82*t7*t371/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t85*t157*t375 & + - 0.4e1_dp/0.27e2_dp*t88*t54*t379 - 0.32e2_dp/0.243e3_dp*t91*t209 & + *t383 - 0.80e2_dp/0.729e3_dp*t94*t220*t387 t413 = t238*t117*R*t410 t426 = t366*t125 t428 = t81*t237*t410 - t433 = 0.3e1_dp*t274*t275*t366+0.3e1_dp*t280*t112*t13*t390 & - -0.3e1_dp*t287*t112*t13*t410+t109*(-t426-t392+t428) & + t433 = 0.3e1_dp*t274*t275*t366 + 0.3e1_dp*t280*t112*t13*t390 & + - 0.3e1_dp*t287*t112*t13*t410 + t109*(-t426 - t392 + t428) & *t110*t275 t436 = t99*t271*R*t433 - t439 = (0.2e1_dp*t368+0.2e1_dp*t393-0.2e1_dp*t413-0.2e1_dp/0.3e1_dp & + t439 = (0.2e1_dp*t368 + 0.2e1_dp*t393 - 0.2e1_dp*t413 - 0.2e1_dp/0.3e1_dp & *t436)*t121 t445 = t390*t98 t461 = t436/0.3e1_dp - t462 = t426+t392-t428+t368+t393-t413-t461 - t465 = 0.2e1_dp*t439-t439*t310*t126-t123*t366*t126-t124 & - *t445*t117+t318*t319*t116*t410+t318*t182*t270* & - t433/0.3e1_dp+t439*t99+t121*t365*t330+t128*t445-t128 & - *t333*t410+t426+t392-t428+t368+t393-t413-t461 & - -0.4e1_dp*t462*t131 - e_ndrho = e_ndrho+(rho*t465*t138/0.8e1_dp-t134*t462*t138/0.8e1_dp-t348 & - *t271*t433/0.24e2_dp)*sx + t462 = t426 + t392 - t428 + t368 + t393 - t413 - t461 + t465 = 0.2e1_dp*t439 - t439*t310*t126 - t123*t366*t126 - t124 & + *t445*t117 + t318*t319*t116*t410 + t318*t182*t270* & + t433/0.3e1_dp + t439*t99 + t121*t365*t330 + t128*t445 - t128 & + *t333*t410 + t426 + t392 - t428 + t368 + t393 - t413 - t461 & + - 0.4e1_dp*t462*t131 + e_ndrho = e_ndrho + (rho*t465*t138/0.8e1_dp - t134*t462*t138/0.8e1_dp - t348 & + *t271*t433/0.24e2_dp)*sx t479 = t8*t30 t480 = t479*gamma - t485 = -0.1000000000e1_dp*t5*t9*gamma+0.4e1_dp/0.9e1_dp*t357*t480 & - -t36*t37*gamma + t485 = -0.1000000000e1_dp*t5*t9*gamma + 0.4e1_dp/0.9e1_dp*t357*t480 & + - t36*t37*gamma t486 = t485*t179 t488 = t486*t80*t184 t492 = t28*t57 @@ -2577,64 +2577,64 @@ SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_lte_b(rho, ndrho, tau, laplace_rho, e_0, & t501 = t500*gamma t504 = t74*t227 t505 = t504*gamma - t508 = 0.4e1_dp/0.9e1_dp*t44*t480+0.16e2_dp/0.27e2_dp*t49*t493+ & - 0.16e2_dp/0.27e2_dp*t53*t497+0.128e3_dp/0.243e3_dp*t62*t501+0.320e3_dp & + t508 = 0.4e1_dp/0.9e1_dp*t44*t480 + 0.16e2_dp/0.27e2_dp*t49*t493 + & + 0.16e2_dp/0.27e2_dp*t53*t497 + 0.128e3_dp/0.243e3_dp*t62*t501 + 0.320e3_dp & /0.729e3_dp*t72*t505 t510 = t43*t508*t98 t511 = t510*t118 - t523 = 0.4e1_dp/0.9e1_dp*t82*t480+0.16e2_dp/0.27e2_dp*t85*t493+ & - 0.16e2_dp/0.27e2_dp*t88*t497+0.128e3_dp/0.243e3_dp*t91*t501+0.320e3_dp & + t523 = 0.4e1_dp/0.9e1_dp*t82*t480 + 0.16e2_dp/0.27e2_dp*t85*t493 + & + 0.16e2_dp/0.27e2_dp*t88*t497 + 0.128e3_dp/0.243e3_dp*t91*t501 + 0.320e3_dp & /0.729e3_dp*t94*t505 t526 = t238*t117*R*t523 t539 = t486*t125 t541 = t81*t237*t523 - t546 = 0.3e1_dp*t274*t275*t486+0.3e1_dp*t280*t112*t13*t508 & - -0.3e1_dp*t287*t112*t13*t523+t109*(-t539-t510+t541) & + t546 = 0.3e1_dp*t274*t275*t486 + 0.3e1_dp*t280*t112*t13*t508 & + - 0.3e1_dp*t287*t112*t13*t523 + t109*(-t539 - t510 + t541) & *t110*t275 t549 = t99*t271*R*t546 - t552 = (0.2e1_dp*t488+0.2e1_dp*t511-0.2e1_dp*t526-0.2e1_dp/0.3e1_dp & + t552 = (0.2e1_dp*t488 + 0.2e1_dp*t511 - 0.2e1_dp*t526 - 0.2e1_dp/0.3e1_dp & *t549)*t121 t558 = t508*t98 t574 = t549/0.3e1_dp - t575 = t539+t510-t541+t488+t511-t526-t574 - t578 = 0.2e1_dp*t552-t552*t310*t126-t123*t486*t126-t124 & - *t558*t117+t318*t319*t116*t523+t318*t182*t270* & - t546/0.3e1_dp+t552*t99+t121*t485*t330+t128*t558-t128 & - *t333*t523+t539+t510-t541+t488+t511-t526-t574 & - -0.4e1_dp*t575*t131 - e_tau = e_tau+(rho*t578*t138/0.8e1_dp-t134*t575*t138/0.8e1_dp-t348 & - *t271*t546/0.24e2_dp)*sx - t597 = 0.2500000000000000e0_dp*t5*t9-t356*t3*t8*t30/0.9e1_dp & - +t36*t37/0.4e1_dp + t575 = t539 + t510 - t541 + t488 + t511 - t526 - t574 + t578 = 0.2e1_dp*t552 - t552*t310*t126 - t123*t486*t126 - t124 & + *t558*t117 + t318*t319*t116*t523 + t318*t182*t270* & + t546/0.3e1_dp + t552*t99 + t121*t485*t330 + t128*t558 - t128 & + *t333*t523 + t539 + t510 - t541 + t488 + t511 - t526 - t574 & + - 0.4e1_dp*t575*t131 + e_tau = e_tau + (rho*t578*t138/0.8e1_dp - t134*t575*t138/0.8e1_dp - t348 & + *t271*t546/0.24e2_dp)*sx + t597 = 0.2500000000000000e0_dp*t5*t9 - t356*t3*t8*t30/0.9e1_dp & + + t36*t37/0.4e1_dp t598 = t597*t179 t600 = t598*t80*t184 - t612 = -t44*t479/0.9e1_dp-0.4e1_dp/0.27e2_dp*t49*t492-0.4e1_dp/ & - 0.27e2_dp*t53*t496-0.32e2_dp/0.243e3_dp*t62*t500-0.80e2_dp/0.729e3_dp & + t612 = -t44*t479/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t49*t492 - 0.4e1_dp/ & + 0.27e2_dp*t53*t496 - 0.32e2_dp/0.243e3_dp*t62*t500 - 0.80e2_dp/0.729e3_dp & *t72*t504 t614 = t43*t612*t98 t615 = t614*t118 - t627 = -t82*t479/0.9e1_dp-0.4e1_dp/0.27e2_dp*t85*t492-0.4e1_dp/ & - 0.27e2_dp*t88*t496-0.32e2_dp/0.243e3_dp*t91*t500-0.80e2_dp/0.729e3_dp & + t627 = -t82*t479/0.9e1_dp - 0.4e1_dp/0.27e2_dp*t85*t492 - 0.4e1_dp/ & + 0.27e2_dp*t88*t496 - 0.32e2_dp/0.243e3_dp*t91*t500 - 0.80e2_dp/0.729e3_dp & *t94*t504 t630 = t238*t117*R*t627 t643 = t598*t125 t645 = t81*t237*t627 - t650 = 0.3e1_dp*t274*t275*t598+0.3e1_dp*t280*t112*t13*t612 & - -0.3e1_dp*t287*t112*t13*t627+t109*(-t643-t614+t645) & + t650 = 0.3e1_dp*t274*t275*t598 + 0.3e1_dp*t280*t112*t13*t612 & + - 0.3e1_dp*t287*t112*t13*t627 + t109*(-t643 - t614 + t645) & *t110*t275 t653 = t99*t271*R*t650 - t656 = (0.2e1_dp*t600+0.2e1_dp*t615-0.2e1_dp*t630-0.2e1_dp/0.3e1_dp & + t656 = (0.2e1_dp*t600 + 0.2e1_dp*t615 - 0.2e1_dp*t630 - 0.2e1_dp/0.3e1_dp & *t653)*t121 t662 = t612*t98 t678 = t653/0.3e1_dp - t679 = t643+t614-t645+t600+t615-t630-t678 - t682 = 0.2e1_dp*t656-t656*t310*t126-t123*t598*t126-t124 & - *t662*t117+t318*t319*t116*t627+t318*t182*t270* & - t650/0.3e1_dp+t656*t99+t121*t597*t330+t128*t662-t128 & - *t333*t627+t643+t614-t645+t600+t615-t630-t678 & - -0.4e1_dp*t679*t131 - e_laplace_rho = e_laplace_rho+(rho*t682*t138/0.8e1_dp-t134*t679*t138/0.8e1_dp-t348 & - *t271*t650/0.24e2_dp)*sx + t679 = t643 + t614 - t645 + t600 + t615 - t630 - t678 + t682 = 0.2e1_dp*t656 - t656*t310*t126 - t123*t598*t126 - t124 & + *t662*t117 + t318*t319*t116*t627 + t318*t182*t270* & + t650/0.3e1_dp + t656*t99 + t121*t597*t330 + t128*t662 - t128 & + *t333*t627 + t643 + t614 - t645 + t600 + t615 - t630 - t678 & + - 0.4e1_dp*t679*t131 + e_laplace_rho = e_laplace_rho + (rho*t682*t138/0.8e1_dp - t134*t679*t138/0.8e1_dp - t348 & + *t271*t650/0.24e2_dp)*sx END IF END SUBROUTINE x_br_lsd_y_gt_0_cutoff_R_lte_b diff --git a/src/xc/xc_xbeef.F b/src/xc/xc_xbeef.F index 1a55b480e9..397b1c838c 100644 --- a/src/xc/xc_xbeef.F +++ b/src/xc/xc_xbeef.F @@ -157,7 +157,7 @@ SUBROUTINE xbeef_lda_eval(rho_set, deriv_set, grad_deriv, xbeef_params) CPASSERT(deriv_set%ref_count > 0) CALL xc_rho_set_get(rho_set, rho_1_3=rho_1_3, rho=rho, & norm_drho=norm_drho, local_bounds=bo, rho_cutoff=epsilon_rho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rho @@ -254,7 +254,7 @@ SUBROUTINE xbeef_lda_calc(rho, rho_1_3, norm_drho, & s = norm_drho(ii)/MAX(t3, epsilon_rho43) !reduced gradient finally s2 = s**2 - t = 2.0_dp*s2/(4.0_dp+s2)-1.0_dp + t = 2.0_dp*s2/(4.0_dp + s2) - 1.0_dp IF (grad_deriv >= 0) THEN !asking for pure e evaluation or also derivatives e_leg(0) = 1 !first legendre pol @@ -264,31 +264,31 @@ SUBROUTINE xbeef_lda_calc(rho, rho_1_3, norm_drho, & IF ((grad_deriv >= 1) .OR. (grad_deriv == -1)) THEN !asking for first derivative or higher de_leg(0) = 0 de_leg(1) = 1 - dt = 4.0_dp*s/(4.0_dp+s2)-4.0_dp*s*s2/(4.0_dp+s2)**2 + dt = 4.0_dp*s/(4.0_dp + s2) - 4.0_dp*s*s2/(4.0_dp + s2)**2 ds_rho = -(4.0_dp*s)/(3.0_dp*MAX(my_rho, epsilon_rho)) ds_ndrho = 1.0_dp/(MAX(t3, epsilon_rho43)) END IF - DO i = 2, m-1 !LEGENDRE PART - e_leg(i) = 2.*(t)*e_leg(i-1)-e_leg(i-2)-((t)*e_leg(i-1)-e_leg(i-2))/(REAL(i, KIND=dp)) + DO i = 2, m - 1 !LEGENDRE PART + e_leg(i) = 2.*(t)*e_leg(i - 1) - e_leg(i - 2) - ((t)*e_leg(i - 1) - e_leg(i - 2))/(REAL(i, KIND=dp)) !taken from quantum espresso beef library. IF (ABS(grad_deriv) >= 1) THEN !first derivative !the zero-derivatives need to be available for the first deriv. - de_leg(i) = e_leg(i-1)*i+de_leg(i-1)*(t) + de_leg(i) = e_leg(i - 1)*i + de_leg(i - 1)*(t) END IF END DO !NO DERIVATIVE IF (grad_deriv >= 0) THEN !add the scaled legendre linear combination to e_0 - e_0(ii) = e_0(ii)+SUM(e_leg*a)*e_ueg*sx + e_0(ii) = e_0(ii) + SUM(e_leg*a)*e_ueg*sx END IF !FIRST DERIVATIVE IF ((grad_deriv >= 1) .OR. (grad_deriv == -1)) THEN !asking for first derivative or higher - e_rho(ii) = e_rho(ii)+(SUM(e_leg*a)*e_ueg_drho+SUM(de_leg*a)*dt*ds_rho*e_ueg)*sx - e_ndrho(ii) = e_ndrho(ii)+(SUM(de_leg*a)*dt*ds_ndrho*e_ueg)*sx + e_rho(ii) = e_rho(ii) + (SUM(e_leg*a)*e_ueg_drho + SUM(de_leg*a)*dt*ds_rho*e_ueg)*sx + e_ndrho(ii) = e_ndrho(ii) + (SUM(de_leg*a)*dt*ds_ndrho*e_ueg)*sx END IF END IF @@ -342,7 +342,7 @@ SUBROUTINE xbeef_lsd_eval(rho_set, deriv_set, grad_deriv, xbeef_params) rhob=rho(2)%array, norm_drhoa=norm_drho(1)%array, & norm_drhob=norm_drho(2)%array, rho_cutoff=epsilon_rho, & local_bounds=bo) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rho(1)%array @@ -456,7 +456,7 @@ SUBROUTINE xbeef_lsd_calc(rho_spin, rho_1_3_spin, norm_drho_spin, e_0, & s = norm_drho_spin(ii)/MAX(t3, epsilon_rho43) !reduced gradient finally s2 = s**2 - t = 2.0_dp*s**2/(4.0_dp+s**2)-1.0_dp + t = 2.0_dp*s**2/(4.0_dp + s**2) - 1.0_dp IF (grad_deriv >= 0) THEN !asking for pure e evaluation or also derivatives e_leg(0) = 1 !first legendre pol @@ -466,18 +466,18 @@ SUBROUTINE xbeef_lsd_calc(rho_spin, rho_1_3_spin, norm_drho_spin, e_0, & IF ((grad_deriv >= 1) .OR. (grad_deriv == -1)) THEN !asking for first derivative or higher de_leg(0) = 0 de_leg(1) = 1 - dt = 4.0_dp*s/(4.0_dp+s2)-4.0_dp*s*s2/(4.0_dp+s2)**2 + dt = 4.0_dp*s/(4.0_dp + s2) - 4.0_dp*s*s2/(4.0_dp + s2)**2 ds_rho = -(4.0_dp*s)/(3.0_dp*MAX(my_rho, epsilon_rho)) ds_ndrho = 1.0_dp/(MAX(t3, epsilon_rho43)) END IF - DO i = 2, m-1 !LEGENDRE PART - e_leg(i) = 2.*(t)*e_leg(i-1)-e_leg(i-2)-((t)*e_leg(i-1)-e_leg(i-2))/(REAL(i, KIND=dp)) + DO i = 2, m - 1 !LEGENDRE PART + e_leg(i) = 2.*(t)*e_leg(i - 1) - e_leg(i - 2) - ((t)*e_leg(i - 1) - e_leg(i - 2))/(REAL(i, KIND=dp)) !taken from quantum espresso beef library. IF (ABS(grad_deriv) >= 1) THEN !first derivative !the zero-derivatives need to be available for the first deriv. - de_leg(i) = e_leg(i-1)*i+de_leg(i-1)*(t) + de_leg(i) = e_leg(i - 1)*i + de_leg(i - 1)*(t) END IF END DO @@ -485,13 +485,13 @@ SUBROUTINE xbeef_lsd_calc(rho_spin, rho_1_3_spin, norm_drho_spin, e_0, & !NO DERIVATIVE IF (grad_deriv >= 0) THEN !add the scaled legendre linear combination to e_0 - e_0(ii) = e_0(ii)+SUM(e_leg*a)*e_ueg*sx + e_0(ii) = e_0(ii) + SUM(e_leg*a)*e_ueg*sx END IF !FIRST DERIVATIVE IF ((grad_deriv >= 1) .OR. (grad_deriv == -1)) THEN !asking for first derivative or higher - e_rho_spin(ii) = e_rho_spin(ii)+(SUM(e_leg*a)*e_ueg_drho+SUM(de_leg*a)*dt*ds_rho*e_ueg)*sx - e_ndrho_spin(ii) = e_ndrho_spin(ii)+(SUM(de_leg*a)*dt*ds_ndrho*e_ueg)*sx + e_rho_spin(ii) = e_rho_spin(ii) + (SUM(e_leg*a)*e_ueg_drho + SUM(de_leg*a)*dt*ds_rho*e_ueg)*sx + e_ndrho_spin(ii) = e_ndrho_spin(ii) + (SUM(de_leg*a)*dt*ds_ndrho*e_ueg)*sx END IF END IF END DO diff --git a/src/xc/xc_xbr_pbe_lda_hole_t_c_lr.F b/src/xc/xc_xbr_pbe_lda_hole_t_c_lr.F index 902fec4ab7..1108c253a5 100644 --- a/src/xc/xc_xbr_pbe_lda_hole_t_c_lr.F +++ b/src/xc/xc_xbr_pbe_lda_hole_t_c_lr.F @@ -205,7 +205,7 @@ SUBROUTINE xbr_pbe_lda_hole_tc_lr_lda_eval(rho_set, deriv_set, grad_deriv, param CALL xc_rho_set_get(rho_set, rho=rho, norm_drho=norm_drho, & tau=tau, laplace_rho=laplace_rho, local_bounds=bo, & rho_cutoff=epsilon_rho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rho @@ -319,7 +319,7 @@ SUBROUTINE xbr_pbe_lda_hole_tc_lr_lda_calc(rho, norm_drho, laplace_rho, tau, e_0 t5 = t4*my_rho t8 = my_ndrho**2 t9 = 0.1e1_dp/my_rho - t15 = my_laplace_rho/0.6e1_dp-gamma*(2.0_dp*my_tau-t8*t9/0.4e1_dp)/0.3e1_dp + t15 = my_laplace_rho/0.6e1_dp - gamma*(2.0_dp*my_tau - t8*t9/0.4e1_dp)/0.3e1_dp t16 = 0.1e1_dp/t15 yval = 0.2e1_dp/0.3e1_dp*t2*t5*t16 @@ -376,7 +376,7 @@ SUBROUTINE xbr_pbe_lda_hole_tc_lr_lda_calc(rho, norm_drho, laplace_rho, tau, e_0 ss = 0.3466806371753173524216762e0_dp*t6*t8 IF (ss > scutoff) THEN ss2 = ss*ss - sscale = (smax*ss2-sconst)/(ss2*ss) + sscale = (smax*ss2 - sconst)/(ss2*ss) END IF e_0_pbe = 0.0_dp e_rho_pbe = 0.0_dp @@ -400,28 +400,28 @@ SUBROUTINE xbr_pbe_lda_hole_tc_lr_lda_calc(rho, norm_drho, laplace_rho, tau, e_0 Fx = e_0_br/e_0_lda - Fermi = alpha/(EXP((Fx-mu)/N)+1.0_dp) + Fermi = alpha/(EXP((Fx - mu)/N) + 1.0_dp) - dFermi_drho = -Fermi**2/alpha/N*(e_rho_br/e_0_lda-e_0_br*e_rho_lda/e_0_lda**2)*EXP((Fx-mu)/N) - dFermi_dndrho = -Fermi**2/alpha/N*(e_ndrho_br/e_0_lda)*EXP((Fx-mu)/N) - dFermi_dtau = -Fermi**2/alpha/N*(e_tau_br/e_0_lda)*EXP((Fx-mu)/N) - dFermi_dlaplace_rho = -Fermi**2/alpha/N*(e_laplace_rho_br/e_0_lda)*EXP((Fx-mu)/N) + dFermi_drho = -Fermi**2/alpha/N*(e_rho_br/e_0_lda - e_0_br*e_rho_lda/e_0_lda**2)*EXP((Fx - mu)/N) + dFermi_dndrho = -Fermi**2/alpha/N*(e_ndrho_br/e_0_lda)*EXP((Fx - mu)/N) + dFermi_dtau = -Fermi**2/alpha/N*(e_tau_br/e_0_lda)*EXP((Fx - mu)/N) + dFermi_dlaplace_rho = -Fermi**2/alpha/N*(e_laplace_rho_br/e_0_lda)*EXP((Fx - mu)/N) - e_0(ip) = e_0(ip)+(Fermi*e_0_pbe+(1.0_dp-Fermi)*e_0_br)*sx + e_0(ip) = e_0(ip) + (Fermi*e_0_pbe + (1.0_dp - Fermi)*e_0_br)*sx IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN - e_rho(ip) = e_rho(ip)+(Fermi*e_rho_pbe+dFermi_drho*e_0_pbe+ & - (1.0_dp-Fermi)*e_rho_br-dFermi_drho*e_0_br)*sx + e_rho(ip) = e_rho(ip) + (Fermi*e_rho_pbe + dFermi_drho*e_0_pbe + & + (1.0_dp - Fermi)*e_rho_br - dFermi_drho*e_0_br)*sx - e_ndrho(ip) = e_ndrho(ip)+(Fermi*e_ndrho_pbe+dFermi_dndrho*e_0_pbe+ & - (1.0_dp-Fermi)*e_ndrho_br-dFermi_dndrho*e_0_br)*sx + e_ndrho(ip) = e_ndrho(ip) + (Fermi*e_ndrho_pbe + dFermi_dndrho*e_0_pbe + & + (1.0_dp - Fermi)*e_ndrho_br - dFermi_dndrho*e_0_br)*sx - e_tau(ip) = e_tau(ip)+(dFermi_dtau*e_0_pbe+ & - (1.0_dp-Fermi)*e_tau_br-dFermi_dtau*e_0_br)*sx + e_tau(ip) = e_tau(ip) + (dFermi_dtau*e_0_pbe + & + (1.0_dp - Fermi)*e_tau_br - dFermi_dtau*e_0_br)*sx - e_laplace_rho(ip) = e_laplace_rho(ip)+(dFermi_dlaplace_rho*e_0_pbe+ & - (1.0_dp-Fermi)*e_laplace_rho_br-dFermi_dlaplace_rho*e_0_br)*sx + e_laplace_rho(ip) = e_laplace_rho(ip) + (dFermi_dlaplace_rho*e_0_pbe + & + (1.0_dp - Fermi)*e_laplace_rho_br - dFermi_dlaplace_rho*e_0_br)*sx END IF END IF @@ -472,7 +472,7 @@ SUBROUTINE xbr_pbe_lda_hole_tc_lr_lsd_eval(rho_set, deriv_set, grad_deriv, param norm_drhob=norm_drhob, tau_a=tau_a, tau_b=tau_b, laplace_rhoa=laplace_rhoa, & laplace_rhob=laplace_rhob, local_bounds=bo, & rho_cutoff=epsilon_rho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rhoa @@ -612,7 +612,7 @@ SUBROUTINE xbr_pbe_lda_hole_tc_lr_lsd_calc(rho, norm_drho, laplace_rho, tau, e_0 t5 = t4*my_rho t8 = my_ndrho**2 t9 = 0.1e1_dp/my_rho - t15 = my_laplace_rho/0.6e1_dp-gamma*(2.0_dp*my_tau-t8*t9/0.4e1_dp)/0.3e1_dp + t15 = my_laplace_rho/0.6e1_dp - gamma*(2.0_dp*my_tau - t8*t9/0.4e1_dp)/0.3e1_dp t16 = 0.1e1_dp/t15 yval = 0.2e1_dp/0.3e1_dp*t2*t5*t16 @@ -661,7 +661,7 @@ SUBROUTINE xbr_pbe_lda_hole_tc_lr_lsd_calc(rho, norm_drho, laplace_rho, tau, e_0 ss = 0.3466806371753173524216762e0_dp*t6*t8 IF (ss > scutoff) THEN ss2 = ss*ss - sscale = (smax*ss2-sconst)/(ss2*ss) + sscale = (smax*ss2 - sconst)/(ss2*ss) END IF e_0_pbe = 0.0_dp e_rho_pbe = 0.0_dp @@ -688,28 +688,28 @@ SUBROUTINE xbr_pbe_lda_hole_tc_lr_lsd_calc(rho, norm_drho, laplace_rho, tau, e_0 Fx = e_0_br/e_0_lda - Fermi = alpha/(EXP((Fx-mu)/N)+1.0_dp) + Fermi = alpha/(EXP((Fx - mu)/N) + 1.0_dp) - dFermi_drho = -Fermi**2/alpha/N*(e_rho_br/e_0_lda-e_0_br*e_rho_lda/e_0_lda**2)*EXP((Fx-mu)/N) - dFermi_dndrho = -Fermi**2/alpha/N*(e_ndrho_br/e_0_lda)*EXP((Fx-mu)/N) - dFermi_dtau = -Fermi**2/alpha/N*(e_tau_br/e_0_lda)*EXP((Fx-mu)/N) - dFermi_dlaplace_rho = -Fermi**2/alpha/N*(e_laplace_rho_br/e_0_lda)*EXP((Fx-mu)/N) + dFermi_drho = -Fermi**2/alpha/N*(e_rho_br/e_0_lda - e_0_br*e_rho_lda/e_0_lda**2)*EXP((Fx - mu)/N) + dFermi_dndrho = -Fermi**2/alpha/N*(e_ndrho_br/e_0_lda)*EXP((Fx - mu)/N) + dFermi_dtau = -Fermi**2/alpha/N*(e_tau_br/e_0_lda)*EXP((Fx - mu)/N) + dFermi_dlaplace_rho = -Fermi**2/alpha/N*(e_laplace_rho_br/e_0_lda)*EXP((Fx - mu)/N) - e_0(ip) = e_0(ip)+(Fermi*e_0_pbe+(1.0_dp-Fermi)*e_0_br)*sx + e_0(ip) = e_0(ip) + (Fermi*e_0_pbe + (1.0_dp - Fermi)*e_0_br)*sx IF (grad_deriv >= 1 .OR. grad_deriv == -1) THEN - e_rho(ip) = e_rho(ip)+(Fermi*e_rho_pbe+dFermi_drho*e_0_pbe+ & - (1.0_dp-Fermi)*e_rho_br-dFermi_drho*e_0_br)*sx + e_rho(ip) = e_rho(ip) + (Fermi*e_rho_pbe + dFermi_drho*e_0_pbe + & + (1.0_dp - Fermi)*e_rho_br - dFermi_drho*e_0_br)*sx - e_ndrho(ip) = e_ndrho(ip)+(Fermi*e_ndrho_pbe+dFermi_dndrho*e_0_pbe+ & - (1.0_dp-Fermi)*e_ndrho_br-dFermi_dndrho*e_0_br)*sx + e_ndrho(ip) = e_ndrho(ip) + (Fermi*e_ndrho_pbe + dFermi_dndrho*e_0_pbe + & + (1.0_dp - Fermi)*e_ndrho_br - dFermi_dndrho*e_0_br)*sx - e_tau(ip) = e_tau(ip)+(dFermi_dtau*e_0_pbe+ & - (1.0_dp-Fermi)*e_tau_br-dFermi_dtau*e_0_br)*sx + e_tau(ip) = e_tau(ip) + (dFermi_dtau*e_0_pbe + & + (1.0_dp - Fermi)*e_tau_br - dFermi_dtau*e_0_br)*sx - e_laplace_rho(ip) = e_laplace_rho(ip)+(dFermi_dlaplace_rho*e_0_pbe+ & - (1.0_dp-Fermi)*e_laplace_rho_br-dFermi_dlaplace_rho*e_0_br)*sx + e_laplace_rho(ip) = e_laplace_rho(ip) + (dFermi_dlaplace_rho*e_0_pbe + & + (1.0_dp - Fermi)*e_laplace_rho_br - dFermi_dlaplace_rho*e_0_br)*sx END IF END IF diff --git a/src/xc/xc_xlda_hole_t_c_lr.F b/src/xc/xc_xlda_hole_t_c_lr.F index 600951d0ac..ef5c105cec 100644 --- a/src/xc/xc_xlda_hole_t_c_lr.F +++ b/src/xc/xc_xlda_hole_t_c_lr.F @@ -148,7 +148,7 @@ SUBROUTINE xlda_hole_t_c_lr_lda_eval(rho_set, deriv_set, order, params) CALL xc_rho_set_get(rho_set, rho=rho, & local_bounds=bo, rho_cutoff=epsilon_rho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rho @@ -269,31 +269,31 @@ SUBROUTINE xlda_hole_t_c_lr_lda_calc_0(order, rho, e_0, e_rho, & t23 = t22*t7 t24 = D*t14*t23 t25 = EXP(-t24) - t32 = 9+4*A*t14*t23 + t32 = 9 + 4*A*t14*t23 t33 = LOG(t32) t36 = D**2 t41 = expint(1, t24) t46 = 0.1e1_dp/t36 t62 = LOG(0.2e1_dp) t64 = LOG(A) - t67 = A*t12+0.3e1_dp/0.2e1_dp*E*t15*t3*t6*t5*t19*t25 & - -A*t33/0.2e1_dp+E/t36/D*t25+A*t41/0.2e1_dp+E*t14 & - *t22*t7*t46*t25+B*t19*t25/0.2e1_dp+C*t46*t25/0.2e1_dp & - +C*t14*t22*t7*t19*t25/0.2e1_dp+A*t62+A*t64 & + t67 = A*t12 + 0.3e1_dp/0.2e1_dp*E*t15*t3*t6*t5*t19*t25 & + - A*t33/0.2e1_dp + E/t36/D*t25 + A*t41/0.2e1_dp + E*t14 & + *t22*t7*t46*t25 + B*t19*t25/0.2e1_dp + C*t46*t25/0.2e1_dp & + + C*t14*t22*t7*t19*t25/0.2e1_dp + A*t62 + A*t64 & /0.2e1_dp t68 = t9*t67 - e_0 = e_0+(0.2e1_dp/0.3e1_dp*t2*t68)*sx + e_0 = e_0 + (0.2e1_dp/0.3e1_dp*t2*t68)*sx END IF IF (order >= 1 .OR. order == -1) THEN t82 = A/rho t86 = t4**2 t91 = A**2 t95 = 0.1e1_dp/t6*t4 - e_rho = e_rho+(0.4e1_dp/0.3e1_dp*rho*pi*t68-0.4e1_dp/0.9e1_dp*t1*t4*pi & - *t3/t7/t5*t67+0.2e1_dp/0.3e1_dp*t2*t9*(t82/0.3e1_dp- & - 0.3e1_dp*E*t15*t14*t86*rho*t25-0.4e1_dp/0.3e1_dp*t91*t14 & - *t22*t95/t32-t82*t25/0.3e1_dp-B*t14*t22*t95*t25 & - /0.3e1_dp-C*t15*t3*t6*t4*t25))*sx + e_rho = e_rho + (0.4e1_dp/0.3e1_dp*rho*pi*t68 - 0.4e1_dp/0.9e1_dp*t1*t4*pi & + *t3/t7/t5*t67 + 0.2e1_dp/0.3e1_dp*t2*t9*(t82/0.3e1_dp - & + 0.3e1_dp*E*t15*t14*t86*rho*t25 - 0.4e1_dp/0.3e1_dp*t91*t14 & + *t22*t95/t32 - t82*t25/0.3e1_dp - B*t14*t22*t95*t25 & + /0.3e1_dp - C*t15*t3*t6*t4*t25))*sx END IF END SUBROUTINE xlda_hole_t_c_lr_lda_calc_0 @@ -342,7 +342,7 @@ SUBROUTINE xlda_hole_t_c_lr_lsd_eval(rho_set, deriv_set, order, params) CALL xc_rho_set_get(rho_set, rhoa=rhoa, rhob=rhob, & local_bounds=bo, rho_cutoff=epsilon_rho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rhoa @@ -424,7 +424,7 @@ SUBROUTINE xlda_hole_t_c_lr_lsd_calc(npoints, order, rho, e_0, e_rho, & e_tmp = 0.0_dp CALL xlda_hole_t_c_lr_lda_calc_0(order, my_rho, e_tmp, e_rho(ip), & sx, R) - e_0(ip) = e_0(ip)+0.5_dp*e_tmp + e_0(ip) = e_0(ip) + 0.5_dp*e_tmp END IF END DO diff --git a/src/xc/xc_xpbe_hole_t_c_lr.F b/src/xc/xc_xpbe_hole_t_c_lr.F index 26655e357b..52e357a817 100644 --- a/src/xc/xc_xpbe_hole_t_c_lr.F +++ b/src/xc/xc_xpbe_hole_t_c_lr.F @@ -173,7 +173,7 @@ SUBROUTINE xpbe_hole_t_c_lr_lda_eval(rho_set, deriv_set, order, params) CALL xc_rho_set_get(rho_set, rho=rho, & norm_drho=norm_drho, local_bounds=bo, rho_cutoff=epsilon_rho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rho @@ -270,7 +270,7 @@ SUBROUTINE xpbe_hole_t_c_lr_lda_calc(npoints, order, rho, norm_drho, e_0, e_rho, ss = 0.3466806371753173524216762e0_dp*t6*t8 IF (ss > scutoff) THEN ss2 = ss*ss - sscale = (smax*ss2-sconst)/(ss2*ss) + sscale = (smax*ss2 - sconst)/(ss2*ss) END IF IF (ss*sscale > gcutoff) THEN CALL xpbe_hole_t_c_lr_lda_calc_1(e_0(ip), e_rho(ip), e_ndrho(ip), & @@ -334,7 +334,7 @@ SUBROUTINE xpbe_hole_t_c_lr_lsd_eval(rho_set, deriv_set, order, params) CALL xc_rho_set_get(rho_set, rhoa=rhoa, rhob=rhob, & norm_drhoa=norm_drhoa, norm_drhob=norm_drhob, local_bounds=bo, rho_cutoff=epsilon_rho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rhoa @@ -442,7 +442,7 @@ SUBROUTINE xpbe_hole_t_c_lr_lsd_calc(npoints, order, rho, norm_drho, e_0, e_rho, ss = 0.3466806371753173524216762e0_dp*t6*t8 IF (ss > scutoff) THEN ss2 = ss*ss - sscale = (smax*ss2-sconst)/(ss2*ss) + sscale = (smax*ss2 - sconst)/(ss2*ss) END IF e_tmp = 0.0_dp IF (ss*sscale > gcutoff) THEN @@ -454,7 +454,7 @@ SUBROUTINE xpbe_hole_t_c_lr_lsd_calc(npoints, order, rho, norm_drho, e_0, e_rho, my_rho, & my_ndrho, sscale, sx, R, order) END IF - e_0(ip) = e_0(ip)+0.5_dp*e_tmp + e_0(ip) = e_0(ip) + 0.5_dp*e_tmp END IF END DO @@ -517,13 +517,13 @@ SUBROUTINE xpbe_hole_t_c_lr_lda_calc_1(e_0, e_rho, e_ndrho, & t14 = t12*t13 t17 = t12**2 t19 = t13**2 - t21 = a1*t12*t13+a2*t17*t19 + t21 = a1*t12*t13 + a2*t17*t19 t22 = t14*t21 t25 = t17*t11 t27 = t19*sscale t29 = t17*t12 t31 = t19*t13 - t33 = 1+a3*t17*t19+a4*t25*t27+a5*t29*t31 + t33 = 1 + a3*t17*t19 + a4*t25*t27 + a5*t29*t31 t34 = 0.1e1_dp/t33 t35 = R**2 t37 = t6**2 @@ -539,7 +539,7 @@ SUBROUTINE xpbe_hole_t_c_lr_lda_calc_1(e_0, e_rho, e_ndrho, & t46 = exei(P, Q) t48 = expint(1, q) t50 = t14*t40 - t51 = D+t50 + t51 = D + t50 t52 = t51*t35 t53 = t52*t38 t54 = expint(1, t53) @@ -552,9 +552,9 @@ SUBROUTINE xpbe_hole_t_c_lr_lda_calc_1(e_0, e_rho, e_ndrho, & t65 = t34*B t69 = SQRT(pi) t71 = F1*t21 - t73 = t71*t34+F2 - t77 = C*(1+t73*t12*t13) - t85 = t69*(15*E+6*t77*t51+4*B*t56+8*A*t57) + t73 = t71*t34 + F2 + t77 = C*(1 + t73*t12*t13) + t85 = t69*(15*E + 6*t77*t51 + 4*B*t56 + 8*A*t57) t86 = SQRT(t51) t87 = t86*t57 t88 = 0.1e1_dp/t87 @@ -564,8 +564,8 @@ SUBROUTINE xpbe_hole_t_c_lr_lda_calc_1(e_0, e_rho, e_ndrho, & t94 = t11*sscale t95 = SQRT(t42) t98 = erf(0.3e1_dp/0.2e1_dp*t94*t95) - t99 = 1-t98 - t103 = 0.3e1_dp/0.4e1_dp*pi+t85*t88/0.16e2_dp-0.3e1_dp/0.4e1_dp*t92 & + t99 = 1 - t98 + t103 = 0.3e1_dp/0.4e1_dp*pi + t85*t88/0.16e2_dp - 0.3e1_dp/0.4e1_dp*t92 & *t93*t99 t104 = 0.1e1_dp/t69 t105 = t103*t104 @@ -573,60 +573,60 @@ SUBROUTINE xpbe_hole_t_c_lr_lda_calc_1(e_0, e_rho, e_ndrho, & t107 = 0.1e1_dp/t13 t108 = t106*t107 t109 = t108*t87 - t113 = t40*C+REAL(2*t64*t65, KIND=dp)-0.32e2_dp/0.15e2_dp*t105*t109 & - +t60*t73 + t113 = t40*C + REAL(2*t64*t65, KIND=dp) - 0.32e2_dp/0.15e2_dp*t105*t109 & + + t60*t73 t115 = t17*t19 t116 = t21**2 t117 = t33**2 t118 = 0.1e1_dp/t117 t119 = t116*t118 t121 = C*t73 - t123 = t119*B+t40*t121 + t123 = t119*B + t40*t121 t125 = t35*t2 t126 = t61*C t129 = E*t21 t133 = D*t103*t104 t136 = t34*C - t140 = REAL(2*t129*t34, KIND=dp)-0.32e2_dp/0.15e2_dp*t133*t109+REAL(2 & - *t64*t136, KIND=dp)+t126*t73 + t140 = REAL(2*t129*t34, KIND=dp) - 0.32e2_dp/0.15e2_dp*t133*t109 + REAL(2 & + *t64*t136, KIND=dp) + t126*t73 t142 = t105*t106 t143 = t107*t87 t144 = t143*t40 t147 = t136*t73 t150 = C*t116 - t152 = -0.32e2_dp/0.15e2_dp*t142*t144+REAL(2*t64*t147, KIND=dp)+t150 & + t152 = -0.32e2_dp/0.15e2_dp*t142*t144 + REAL(2*t64*t147, KIND=dp) + t150 & *t118 t155 = t29*t31*C t156 = t73*t116 - t159 = t126+2*D*E+t14*t140+t115*t152+t155*t156* & + t159 = t126 + 2*D*E + t14*t140 + t115*t152 + t155*t156* & t118 t162 = t35**2 t163 = t162*t1 t164 = t6*t5 t167 = t61*t103*t104 t170 = t34*E - t173 = -0.16e2_dp/0.15e2_dp*t167*t109+REAL(2*t64*t170, KIND=dp) + t173 = -0.16e2_dp/0.15e2_dp*t167*t109 + REAL(2*t64*t170, KIND=dp) t175 = t34*t103 t176 = t64*t175 t177 = t104*t106 t178 = t177*t143 t181 = E*t116 - t183 = -0.32e2_dp/0.15e2_dp*t176*t178+t181*t118 + t183 = -0.32e2_dp/0.15e2_dp*t176*t178 + t181*t118 t187 = t104*t87*t119 - t190 = t61*E+t14*t173+t115*t183-0.16e2_dp/0.15e2_dp*t115 & + t190 = t61*E + t14*t173 + t115*t183 - 0.16e2_dp/0.15e2_dp*t115 & *t103*t187 - t194 = 2*E+t60+t61*B+t14*t113+t115*t123+t125*t37 & - *t159+3*t163*t164*t190 + t194 = 2*E + t60 + t61*B + t14*t113 + t115*t123 + t125*t37 & + *t159 + 3*t163*t164*t190 t195 = t58*t194 t196 = D*t35 - t199 = EXP(-t196*t38-q) - t202 = -0.4e1_dp/0.9e1_dp*A*t46+0.4e1_dp/0.9e1_dp*A*t48-0.4e1_dp/ & - 0.9e1_dp*A*t54-0.4e1_dp/0.9e1_dp*t195*t199 - e_0 = e_0+(t45*t202*Clda)*sx + t199 = EXP(-t196*t38 - q) + t202 = -0.4e1_dp/0.9e1_dp*A*t46 + 0.4e1_dp/0.9e1_dp*A*t48 - 0.4e1_dp/ & + 0.9e1_dp*A*t54 - 0.4e1_dp/0.9e1_dp*t195*t199 + e_0 = e_0 + (t45*t202*Clda)*sx END IF IF (order >= 1 .OR. order >= -1) THEN t209 = rho**2 - srho = -t3/t164*t8*t4/0.18e2_dp-t3*t7/t209/0.6e1_dp + srho = -t3/t164*t8*t4/0.18e2_dp - t3*t7/t209/0.6e1_dp t214 = t2*t7 sndrho = t214*t8/0.6e1_dp @@ -639,34 +639,34 @@ SUBROUTINE xpbe_hole_t_c_lr_lda_calc_1(e_0, e_rho, e_ndrho, & t227 = t12*t11 t228 = a2*t227 t229 = t19*t218 - t232 = 2*t223*t224+4*t228*t229 + t232 = 2*t223*t224 + 4*t228*t229 t234 = t14*t232*t39 t235 = t21*t118 t236 = t14*t235 t237 = a3*t227 t240 = a4*t17 t244 = a5*t25 - t248 = 4*t237*t229+5*t240*t27*t218+6*t244*t31*t218 + t248 = 4*t237*t229 + 5*t240*t27*t218 + 6*t244*t31*t218 t251 = t236*t125*t37*t248 t255 = 0.2e1_dp/0.3e1_dp*t50*t125*t7*t4 - qrho = t222+t234-t251+t255 + qrho = t222 + t234 - t251 + t255 t256 = t216*t21 t257 = t34*t41 t261 = t232*t34 t262 = t261*t41 t265 = t118*t41 - prho = 0.9e1_dp/0.2e1_dp*t256*t257*t218+0.9e1_dp/0.4e1_dp*t14*t262 & - -0.9e1_dp/0.4e1_dp*t22*t265*t248 + prho = 0.9e1_dp/0.2e1_dp*t256*t257*t218 + 0.9e1_dp/0.4e1_dp*t14*t262 & + - 0.9e1_dp/0.4e1_dp*t22*t265*t248 t269 = dsdndrho(rho) t273 = t13*t269 t276 = t19*t269 - t279 = 2*t223*t273+4*t228*t276 + t279 = 2*t223*t273 + 4*t228*t276 t280 = t279*t34 t281 = t280*t41 - t292 = 4*t237*t276+5*t240*t27*t269+6*t244*t31*t269 - pndrho = 0.9e1_dp/0.2e1_dp*t256*t257*t269+0.9e1_dp/0.4e1_dp*t14* & - t281-0.9e1_dp/0.4e1_dp*t22*t265*t292 - qndrho = 2*t217*t125*t37*t269+t14*t279*t39-t236*t125 & + t292 = 4*t237*t276 + 5*t240*t27*t269 + 6*t244*t31*t269 + pndrho = 0.9e1_dp/0.2e1_dp*t256*t257*t269 + 0.9e1_dp/0.4e1_dp*t14* & + t281 - 0.9e1_dp/0.4e1_dp*t22*t265*t292 + qndrho = 2*t217*t125*t37*t269 + t14*t279*t39 - t236*t125 & *t37*t292 t308 = dexeirho(P, Q, Prho, Qrho) t312 = EXP(-q) @@ -674,7 +674,7 @@ SUBROUTINE xpbe_hole_t_c_lr_lda_calc_1(e_0, e_rho, e_ndrho, & t318 = 0.1e1_dp/t35 t320 = 0.1e1_dp/t37 t322 = 0.1e1_dp/t21*t33*t318*t1*t320 - t331 = 2*t216*t40*t218+t14*t261-t14*t235*t248 + t331 = 2*t216*t40*t218 + t14*t261 - t14*t235*t248 t334 = t214*t4 t339 = EXP(-t53) t341 = 0.1e1_dp/t51 @@ -683,7 +683,7 @@ SUBROUTINE xpbe_hole_t_c_lr_lda_calc_1(e_0, e_rho, e_ndrho, & t359 = D*t232 t362 = t118*B t368 = t118*t248 - t370 = F1*t232*t34-t71*t368 + t370 = F1*t232*t34 - t71*t368 t373 = t73*t11 t382 = B*t51 t385 = A*t56 @@ -693,13 +693,13 @@ SUBROUTINE xpbe_hole_t_c_lr_lda_calc_1(e_0, e_rho, e_ndrho, & t404 = EXP(-p) t405 = 0.1e1_dp/t402*t404 t409 = 0.1e1_dp/t95 - t420 = REAL(t69*(6*C*(t370*t12*t13+2*t373*t224)*t51 & - +6*t77*t331+8*t382*t331+24*t385*t331)*t88, KIND=dp)/ & - 0.16e2_dp-0.7e1_dp/0.32e2_dp*REAL(t85, KIND=dp)*REAL(t393, KIND=dp)* & - REAL(t331, KIND=dp)-0.3e1_dp & - /0.4e1_dp*t92*prho*t93*t99+0.3e1_dp/0.2e1_dp*t401*t405 & - *(0.3e1_dp/0.2e1_dp*t218*sscale*t95+0.3e1_dp/0.4e1_dp*t94*t409 & - *(t262-t235*t41*t248)) + t420 = REAL(t69*(6*C*(t370*t12*t13 + 2*t373*t224)*t51 & + + 6*t77*t331 + 8*t382*t331 + 24*t385*t331)*t88, KIND=dp)/ & + 0.16e2_dp - 0.7e1_dp/0.32e2_dp*REAL(t85, KIND=dp)*REAL(t393, KIND=dp)* & + REAL(t331, KIND=dp) - 0.3e1_dp & + /0.4e1_dp*t92*prho*t93*t99 + 0.3e1_dp/0.2e1_dp*t401*t405 & + *(0.3e1_dp/0.2e1_dp*t218*sscale*t95 + 0.3e1_dp/0.4e1_dp*t94*t409 & + *(t262 - t235*t41*t248)) t421 = t420*t104 t424 = 0.1e1_dp/t227 t425 = t105*t424 @@ -733,56 +733,56 @@ SUBROUTINE xpbe_hole_t_c_lr_lda_calc_1(e_0, e_rho, e_ndrho, & t604 = t87*t116 t611 = t115*t105 t612 = t429*t116 - e_rho = e_rho+(0.4e1_dp/0.3e1_dp*t44*t202*Clda+t45*(-0.4e1_dp/0.9e1_dp* & - A*t308-0.4e1_dp/0.27e2_dp*A*qrho*t314*t322+0.4e1_dp/0.27e2_dp & - *A*(t331*t35*t38+0.2e1_dp/0.3e1_dp*t52*t334)*t339*t341 & - *t318*t1*t320+0.4e1_dp/0.3e1_dp*t349*t199*t331-0.4e1_dp & - /0.9e1_dp*t58*(REAL(2*t216*t113*t218, KIND=dp)+t14*(t261*C & - -t235*C*REAL(t248, KIND=dp)+REAL(2*t359*t65, KIND=dp)-REAL(2*t64*t362 & - *t248, KIND=dp)-0.32e2_dp/0.15e2_dp*t421*t109+0.64e2_dp/0.15e2_dp*t425 & - *t426-0.112e3_dp/0.15e2_dp*t142*t431+t60*t370)+REAL(4* & - t437*t123*t218, KIND=dp)+t115*(0.2e1_dp*t235*B*t232-0.2e1_dp*t446 & - *B*REAL(t248, KIND=dp)+t261*t121-t235*t451+t40*C*t370) & - +0.2e1_dp/0.3e1_dp*t125*t7*t159*t4+t125*t37*(REAL(2* & - t216*t140*t218, KIND=dp)+t14*(0.2e1_dp*E*t232*t34-REAL(2*t129 & - *t368, KIND=dp)-0.32e2_dp/0.15e2_dp*D*t420*t104*t109+0.64e2_dp/0.15e2_dp & - *t133*t475-0.112e3_dp/0.15e2_dp*t133*t479+REAL(2*t359 & - *t136, KIND=dp)-REAL(2*t64*t484*t248, KIND=dp)+t126*t370)+REAL(4* & - t437*t152*t218, KIND=dp)+t115*(-0.32e2_dp/0.15e2_dp*t421*t106*t144 & - +0.64e2_dp/0.15e2_dp*t497*t498*t34*REAL(t218, KIND=dp)-0.112e3_dp/0.15e2_dp & - *t503*t504*t34*t331-0.32e2_dp/0.15e2_dp*t142*t143* & - t261+0.32e2_dp/0.15e2_dp*t503*t498*REAL(t368, KIND=dp)+REAL(2*t359 & - *t147, KIND=dp)-0.2e1_dp*t517*t451+0.2e1_dp*REAL(t64, KIND=dp)*REAL(t136, KIND=dp)* & - t370+REAL(2*t523*t524, KIND=dp)-REAL(2*t150*t527, KIND=dp))+REAL(6*t533 & - *t156*t534, KIND=dp)+t155*t370*t116*t118+0.2e1_dp*t155*t541 & - *REAL(t524, KIND=dp)-0.2e1_dp*t155*REAL(t156, KIND=dp)*REAL(t527, KIND=dp))+0.4e1_dp & - *t163*t6*t190*t4+0.3e1_dp*t163*t164*(REAL(2*t216*t173 & - *t218, KIND=dp)+t14*(-0.16e2_dp/0.15e2_dp*t61*t420*t104*t109+ & - 0.32e2_dp/0.15e2_dp*t167*t475-0.56e2_dp/0.15e2_dp*t167*t479+REAL(2 & - *t359*t170, KIND=dp)-REAL(2*t64*t568*t248, KIND=dp))+REAL(4*t437 & - *t183*t218, KIND=dp)+t115*(-0.32e2_dp/0.15e2_dp*REAL(t359, KIND=dp)*REAL(t175, KIND=dp) & - *REAL(t178, KIND=dp)+0.32e2_dp/0.15e2_dp*t581*t177*t143*REAL(t248, KIND=dp) & - -0.32e2_dp/0.15e2_dp*REAL(t64, KIND=dp)*t34*t420*REAL(t178, KIND=dp)+0.64e2_dp & - /0.15e2_dp*t176*t590*t426-0.112e3_dp/0.15e2_dp*t176*t177* & - t431+REAL(2*t129*t524, KIND=dp)-REAL(2*t181*t527, KIND=dp))-0.64e2_dp/ & - 0.15e2_dp*REAL(t603, KIND=dp)*REAL(t604, KIND=dp)*REAL(t534, KIND=dp)-0.16e2_dp/0.15e2_dp* & - t115*t420*t187-0.56e2_dp/0.15e2_dp*t611*t612*t118*t331- & - 0.32e2_dp/0.15e2_dp*t611*t498*REAL(t524, KIND=dp)+0.32e2_dp/0.15e2_dp*t611 & - *REAL(t604, KIND=dp)*REAL(t527, KIND=dp)))*t199-0.4e1_dp/0.9e1_dp*t195*(-0.2e1_dp & - /0.3e1_dp*t196*t334-t222-t234+t251-t255)*t199)* & - Clda)*sx + e_rho = e_rho + (0.4e1_dp/0.3e1_dp*t44*t202*Clda + t45*(-0.4e1_dp/0.9e1_dp* & + A*t308 - 0.4e1_dp/0.27e2_dp*A*qrho*t314*t322 + 0.4e1_dp/0.27e2_dp & + *A*(t331*t35*t38 + 0.2e1_dp/0.3e1_dp*t52*t334)*t339*t341 & + *t318*t1*t320 + 0.4e1_dp/0.3e1_dp*t349*t199*t331 - 0.4e1_dp & + /0.9e1_dp*t58*(REAL(2*t216*t113*t218, KIND=dp) + t14*(t261*C & + - t235*C*REAL(t248, KIND=dp) + REAL(2*t359*t65, KIND=dp) - REAL(2*t64*t362 & + *t248, KIND=dp) - 0.32e2_dp/0.15e2_dp*t421*t109 + 0.64e2_dp/0.15e2_dp*t425 & + *t426 - 0.112e3_dp/0.15e2_dp*t142*t431 + t60*t370) + REAL(4* & + t437*t123*t218, KIND=dp) + t115*(0.2e1_dp*t235*B*t232 - 0.2e1_dp*t446 & + *B*REAL(t248, KIND=dp) + t261*t121 - t235*t451 + t40*C*t370) & + + 0.2e1_dp/0.3e1_dp*t125*t7*t159*t4 + t125*t37*(REAL(2* & + t216*t140*t218, KIND=dp) + t14*(0.2e1_dp*E*t232*t34 - REAL(2*t129 & + *t368, KIND=dp) - 0.32e2_dp/0.15e2_dp*D*t420*t104*t109 + 0.64e2_dp/0.15e2_dp & + *t133*t475 - 0.112e3_dp/0.15e2_dp*t133*t479 + REAL(2*t359 & + *t136, KIND=dp) - REAL(2*t64*t484*t248, KIND=dp) + t126*t370) + REAL(4* & + t437*t152*t218, KIND=dp) + t115*(-0.32e2_dp/0.15e2_dp*t421*t106*t144 & + + 0.64e2_dp/0.15e2_dp*t497*t498*t34*REAL(t218, KIND=dp) - 0.112e3_dp/0.15e2_dp & + *t503*t504*t34*t331 - 0.32e2_dp/0.15e2_dp*t142*t143* & + t261 + 0.32e2_dp/0.15e2_dp*t503*t498*REAL(t368, KIND=dp) + REAL(2*t359 & + *t147, KIND=dp) - 0.2e1_dp*t517*t451 + 0.2e1_dp*REAL(t64, KIND=dp)*REAL(t136, KIND=dp)* & + t370 + REAL(2*t523*t524, KIND=dp) - REAL(2*t150*t527, KIND=dp)) + REAL(6*t533 & + *t156*t534, KIND=dp) + t155*t370*t116*t118 + 0.2e1_dp*t155*t541 & + *REAL(t524, KIND=dp) - 0.2e1_dp*t155*REAL(t156, KIND=dp)*REAL(t527, KIND=dp)) + 0.4e1_dp & + *t163*t6*t190*t4 + 0.3e1_dp*t163*t164*(REAL(2*t216*t173 & + *t218, KIND=dp) + t14*(-0.16e2_dp/0.15e2_dp*t61*t420*t104*t109 + & + 0.32e2_dp/0.15e2_dp*t167*t475 - 0.56e2_dp/0.15e2_dp*t167*t479 + REAL(2 & + *t359*t170, KIND=dp) - REAL(2*t64*t568*t248, KIND=dp)) + REAL(4*t437 & + *t183*t218, KIND=dp) + t115*(-0.32e2_dp/0.15e2_dp*REAL(t359, KIND=dp)*REAL(t175, KIND=dp) & + *REAL(t178, KIND=dp) + 0.32e2_dp/0.15e2_dp*t581*t177*t143*REAL(t248, KIND=dp) & + - 0.32e2_dp/0.15e2_dp*REAL(t64, KIND=dp)*t34*t420*REAL(t178, KIND=dp) + 0.64e2_dp & + /0.15e2_dp*t176*t590*t426 - 0.112e3_dp/0.15e2_dp*t176*t177* & + t431 + REAL(2*t129*t524, KIND=dp) - REAL(2*t181*t527, KIND=dp)) - 0.64e2_dp/ & + 0.15e2_dp*REAL(t603, KIND=dp)*REAL(t604, KIND=dp)*REAL(t534, KIND=dp) - 0.16e2_dp/0.15e2_dp* & + t115*t420*t187 - 0.56e2_dp/0.15e2_dp*t611*t612*t118*t331 - & + 0.32e2_dp/0.15e2_dp*t611*t498*REAL(t524, KIND=dp) + 0.32e2_dp/0.15e2_dp*t611 & + *REAL(t604, KIND=dp)*REAL(t527, KIND=dp)))*t199 - 0.4e1_dp/0.9e1_dp*t195*(-0.2e1_dp & + /0.3e1_dp*t196*t334 - t222 - t234 + t251 - t255)*t199)* & + Clda)*sx t640 = dexeindrho(P, Q, Pndrho, Qndrho) - t653 = 2*t216*t40*t269+t14*t280-t14*t235*t292 + t653 = 2*t216*t40*t269 + t14*t280 - t14*t235*t292 t667 = D*t279 t675 = t118*t292 - t677 = F1*t279*t34-t71*t675 - t716 = REAL(t69*(6*C*(t677*t12*t13+2*t373*t273)*t51 & - +6*t77*t653+8*t382*t653+24*t385*t653)*t88, KIND=dp)/ & - 0.16e2_dp-0.7e1_dp/0.32e2_dp*REAL(t85, KIND=dp)*REAL(t393, KIND=dp)* & - REAL(t653, KIND=dp)-0.3e1_dp & - /0.4e1_dp*t92*pndrho*t93*t99+0.3e1_dp/0.2e1_dp*t401*t405 & - *(0.3e1_dp/0.2e1_dp*t269*sscale*t95+0.3e1_dp/0.4e1_dp*t94* & - t409*(t281-t235*t41*t292)) + t677 = F1*t279*t34 - t71*t675 + t716 = REAL(t69*(6*C*(t677*t12*t13 + 2*t373*t273)*t51 & + + 6*t77*t653 + 8*t382*t653 + 24*t385*t653)*t88, KIND=dp)/ & + 0.16e2_dp - 0.7e1_dp/0.32e2_dp*REAL(t85, KIND=dp)*REAL(t393, KIND=dp)* & + REAL(t653, KIND=dp) - 0.3e1_dp & + /0.4e1_dp*t92*pndrho*t93*t99 + 0.3e1_dp/0.2e1_dp*t401*t405 & + *(0.3e1_dp/0.2e1_dp*t269*sscale*t95 + 0.3e1_dp/0.4e1_dp*t94* & + t409*(t281 - t235*t41*t292)) t717 = t716*t104 t720 = t143*t269 t723 = t430*t653 @@ -792,40 +792,40 @@ SUBROUTINE xpbe_hole_t_c_lr_lda_calc_1(e_0, e_rho, e_ndrho, & t800 = t118*t279 t803 = t445*t292 t808 = t118*t269 - e_ndrho = e_ndrho+(t45*(-0.4e1_dp/0.9e1_dp*A*t640-0.4e1_dp/0.27e2_dp*A*qndrho & - *t314*t322+0.4e1_dp/0.9e1_dp*A*t653*t339*t341+0.4e1_dp & - /0.3e1_dp*t349*t199*t653-0.4e1_dp/0.9e1_dp*t58*(REAL(2*t216 & - *t113*t269, KIND=dp)+t14*(t280*C-t235*C*REAL(t292, KIND=dp)+REAL(2 & - *t667*t65, KIND=dp)-REAL(2*t64*t362*t292, KIND=dp)-0.32e2_dp/0.15e2_dp & - *t717*t109+0.64e2_dp/0.15e2_dp*t425*t720-0.112e3_dp/0.15e2_dp* & - t142*t723+t60*t677)+REAL(4*t437*t123*t269, KIND=dp)+t115* & - (0.2e1_dp*t235*B*t279-0.2e1_dp*t446*B*REAL(t292, KIND=dp)+t280* & - t121-t235*t739+t40*C*t677)+t125*t37*(REAL(2*t216 & - *t140*t269, KIND=dp)+t14*(0.2e1_dp*E*t279*t34-REAL(2*t129* & - t675, KIND=dp)-0.32e2_dp/0.15e2_dp*D*t716*t104*t109+0.64e2_dp/0.15e2_dp & - *t133*t758-0.112e3_dp/0.15e2_dp*t133*t762+REAL(2*t667* & - t136, KIND=dp)-REAL(2*t64*t484*t292, KIND=dp)+t126*t677)+REAL(4*t437 & - *t152*t269, KIND=dp)+t115*(-0.32e2_dp/0.15e2_dp*t717*t106*t144+ & - 0.64e2_dp/0.15e2_dp*t497*t498*t34*REAL(t269, KIND=dp)-0.112e3_dp/0.15e2_dp & - *t503*t504*t34*t653-0.32e2_dp/0.15e2_dp*t142*t143*t280 & - +0.32e2_dp/0.15e2_dp*t503*t498*REAL(t675, KIND=dp)+REAL(2*t667* & - t147, KIND=dp)-0.2e1_dp*t517*t739+0.2e1_dp*REAL(t64, KIND=dp)*REAL(t136, KIND=dp)*t677 & - +REAL(2*t523*t800, KIND=dp)-REAL(2*t150*t803, KIND=dp))+REAL(6*t533 & - *t156*t808, KIND=dp)+t155*t677*t116*t118+0.2e1_dp*t155*t541 & - *REAL(t800, KIND=dp)-0.2e1_dp*t155*REAL(t156, KIND=dp)*REAL(t803, KIND=dp))+0.3e1_dp*t163 & - *t164*(REAL(2*t216*t173*t269, KIND=dp)+t14*(-0.16e2_dp/0.15e2_dp & - *t61*t716*t104*t109+0.32e2_dp/0.15e2_dp*t167*t758-0.56e2_dp & - /0.15e2_dp*t167*t762+REAL(2*t667*t170, KIND=dp)-REAL(2*t64 & - *t568*t292, KIND=dp))+REAL(4*t437*t183*t269, KIND=dp)+t115*(-0.32e2_dp & - /0.15e2_dp*REAL(t667, KIND=dp)*REAL(t175, KIND=dp)*REAL(t178, KIND=dp)+0.32e2_dp/0.15e2_dp & - *t581*t177*t143*REAL(t292, KIND=dp)-0.32e2_dp/0.15e2_dp*REAL(t64, KIND=dp)* & - t34*t716*REAL(t178, KIND=dp)+0.64e2_dp/0.15e2_dp*t176*t590*t720-0.112e3_dp & - /0.15e2_dp*t176*t177*t723+REAL(2*t129*t800, KIND=dp)-REAL(2 & - *t181*t803, KIND=dp))-0.64e2_dp/0.15e2_dp*REAL(t603, KIND=dp)*REAL(t604, KIND=dp)* & - REAL(t808, KIND=dp)-0.16e2_dp/0.15e2_dp*t115*t716*t187-0.56e2_dp/0.15e2_dp & - *t611*t612*t118*t653-0.32e2_dp/0.15e2_dp*t611*t498*REAL(t800, KIND=dp) & - +0.32e2_dp/0.15e2_dp*t611*REAL(t604, KIND=dp)*REAL(t803, KIND=dp)))*t199 & - +0.4e1_dp/0.9e1_dp*t195*qndrho*t199)*Clda)*sx + e_ndrho = e_ndrho + (t45*(-0.4e1_dp/0.9e1_dp*A*t640 - 0.4e1_dp/0.27e2_dp*A*qndrho & + *t314*t322 + 0.4e1_dp/0.9e1_dp*A*t653*t339*t341 + 0.4e1_dp & + /0.3e1_dp*t349*t199*t653 - 0.4e1_dp/0.9e1_dp*t58*(REAL(2*t216 & + *t113*t269, KIND=dp) + t14*(t280*C - t235*C*REAL(t292, KIND=dp) + REAL(2 & + *t667*t65, KIND=dp) - REAL(2*t64*t362*t292, KIND=dp) - 0.32e2_dp/0.15e2_dp & + *t717*t109 + 0.64e2_dp/0.15e2_dp*t425*t720 - 0.112e3_dp/0.15e2_dp* & + t142*t723 + t60*t677) + REAL(4*t437*t123*t269, KIND=dp) + t115* & + (0.2e1_dp*t235*B*t279 - 0.2e1_dp*t446*B*REAL(t292, KIND=dp) + t280* & + t121 - t235*t739 + t40*C*t677) + t125*t37*(REAL(2*t216 & + *t140*t269, KIND=dp) + t14*(0.2e1_dp*E*t279*t34 - REAL(2*t129* & + t675, KIND=dp) - 0.32e2_dp/0.15e2_dp*D*t716*t104*t109 + 0.64e2_dp/0.15e2_dp & + *t133*t758 - 0.112e3_dp/0.15e2_dp*t133*t762 + REAL(2*t667* & + t136, KIND=dp) - REAL(2*t64*t484*t292, KIND=dp) + t126*t677) + REAL(4*t437 & + *t152*t269, KIND=dp) + t115*(-0.32e2_dp/0.15e2_dp*t717*t106*t144 + & + 0.64e2_dp/0.15e2_dp*t497*t498*t34*REAL(t269, KIND=dp) - 0.112e3_dp/0.15e2_dp & + *t503*t504*t34*t653 - 0.32e2_dp/0.15e2_dp*t142*t143*t280 & + + 0.32e2_dp/0.15e2_dp*t503*t498*REAL(t675, KIND=dp) + REAL(2*t667* & + t147, KIND=dp) - 0.2e1_dp*t517*t739 + 0.2e1_dp*REAL(t64, KIND=dp)*REAL(t136, KIND=dp)*t677 & + + REAL(2*t523*t800, KIND=dp) - REAL(2*t150*t803, KIND=dp)) + REAL(6*t533 & + *t156*t808, KIND=dp) + t155*t677*t116*t118 + 0.2e1_dp*t155*t541 & + *REAL(t800, KIND=dp) - 0.2e1_dp*t155*REAL(t156, KIND=dp)*REAL(t803, KIND=dp)) + 0.3e1_dp*t163 & + *t164*(REAL(2*t216*t173*t269, KIND=dp) + t14*(-0.16e2_dp/0.15e2_dp & + *t61*t716*t104*t109 + 0.32e2_dp/0.15e2_dp*t167*t758 - 0.56e2_dp & + /0.15e2_dp*t167*t762 + REAL(2*t667*t170, KIND=dp) - REAL(2*t64 & + *t568*t292, KIND=dp)) + REAL(4*t437*t183*t269, KIND=dp) + t115*(-0.32e2_dp & + /0.15e2_dp*REAL(t667, KIND=dp)*REAL(t175, KIND=dp)*REAL(t178, KIND=dp) + 0.32e2_dp/0.15e2_dp & + *t581*t177*t143*REAL(t292, KIND=dp) - 0.32e2_dp/0.15e2_dp*REAL(t64, KIND=dp)* & + t34*t716*REAL(t178, KIND=dp) + 0.64e2_dp/0.15e2_dp*t176*t590*t720 - 0.112e3_dp & + /0.15e2_dp*t176*t177*t723 + REAL(2*t129*t800, KIND=dp) - REAL(2 & + *t181*t803, KIND=dp)) - 0.64e2_dp/0.15e2_dp*REAL(t603, KIND=dp)*REAL(t604, KIND=dp)* & + REAL(t808, KIND=dp) - 0.16e2_dp/0.15e2_dp*t115*t716*t187 - 0.56e2_dp/0.15e2_dp & + *t611*t612*t118*t653 - 0.32e2_dp/0.15e2_dp*t611*t498*REAL(t800, KIND=dp) & + + 0.32e2_dp/0.15e2_dp*t611*REAL(t604, KIND=dp)*REAL(t803, KIND=dp)))*t199 & + + 0.4e1_dp/0.9e1_dp*t195*qndrho*t199)*Clda)*sx END IF END SUBROUTINE xpbe_hole_t_c_lr_lda_calc_1 @@ -881,13 +881,13 @@ SUBROUTINE xpbe_hole_t_c_lr_lda_calc_2(e_0, e_rho, e_ndrho, & t14 = t12*t13 t17 = t12**2 t19 = t13**2 - t21 = a1*t12*t13+a2*t17*t19 + t21 = a1*t12*t13 + a2*t17*t19 t22 = t14*t21 t25 = t17*t11 t27 = t19*sscale t29 = t17*t12 t31 = t19*t13 - t33 = 1+a3*t17*t19+a4*t25*t27+a5*t29*t31 + t33 = 1 + a3*t17*t19 + a4*t25*t27 + a5*t29*t31 t34 = 0.1e1_dp/t33 t35 = R**2 t37 = t6**2 @@ -902,7 +902,7 @@ SUBROUTINE xpbe_hole_t_c_lr_lda_calc_2(e_0, e_rho, e_ndrho, & t46 = exei(P, Q) t48 = expint(1, q) t50 = t14*t40 - t51 = D+t50 + t51 = D + t50 t52 = t51*t35 t53 = t52*t38 t54 = expint(1, t53) @@ -912,54 +912,54 @@ SUBROUTINE xpbe_hole_t_c_lr_lda_calc_2(e_0, e_rho, e_ndrho, & t61 = D**2 t64 = D*t21 t65 = t34*B - t74 = g1+g2*t12*t13+g3*t17*t19+g4*t25*t27 + t74 = g1 + g2*t12*t13 + g3*t17*t19 + g4*t25*t27 t75 = E*t74 t77 = F1*t21 - t79 = t77*t34+F2 - t81 = t40*C+2*t64*t65+2*t75+t60*t79 + t79 = t77*t34 + F2 + t81 = t40*C + 2*t64*t65 + 2*t75 + t60*t79 t83 = t17*t19 t84 = t21**2 t85 = t33**2 t86 = 0.1e1_dp/t85 t89 = C*t79 - t91 = t84*t86*B+t40*t89 + t91 = t84*t86*B + t40*t89 t93 = t35*t2 t94 = t61*C t95 = D*E t97 = E*t21 t102 = t34*C - t106 = 2*t97*t34+2*t95*t74+2*t64*t102+t94*t79 + t106 = 2*t97*t34 + 2*t95*t74 + 2*t64*t102 + t94*t79 t110 = t102*t79 t113 = C*t84 - t115 = 2*t75*t40+2*t64*t110+t113*t86 + t115 = 2*t75*t40 + 2*t64*t110 + t113*t86 t117 = t29*t31 t118 = t117*C t119 = t79*t84 - t122 = t94+2*t95+t14*t106+t83*t115+t118*t119*t86 + t122 = t94 + 2*t95 + t14*t106 + t83*t115 + t118*t119*t86 t125 = t35**2 t126 = t125*t1 t127 = t6*t5 t128 = t61*E t130 = t34*E - t133 = t128*t74+2*t64*t130 + t133 = t128*t74 + 2*t64*t130 t135 = t130*t74 t138 = E*t84 - t140 = 2*t64*t135+t138*t86 + t140 = 2*t64*t135 + t138*t86 t142 = t117*E t143 = t74*t84 - t146 = t128+t14*t133+t83*t140+t142*t143*t86 - t150 = 2*E+t60+t61*B+t14*t81+t83*t91+t93*t37* & - t122+3*t126*t127*t146 + t146 = t128 + t14*t133 + t83*t140 + t142*t143*t86 + t150 = 2*E + t60 + t61*B + t14*t81 + t83*t91 + t93*t37* & + t122 + 3*t126*t127*t146 t151 = t58*t150 t152 = D*t35 - t155 = EXP(-t152*t38-q) - t158 = -0.4e1_dp/0.9e1_dp*A*t46+0.4e1_dp/0.9e1_dp*A*t48-0.4e1_dp/ & - 0.9e1_dp*A*t54-0.4e1_dp/0.9e1_dp*t151*t155 - e_0 = e_0+(t45*t158*Clda)*sx + t155 = EXP(-t152*t38 - q) + t158 = -0.4e1_dp/0.9e1_dp*A*t46 + 0.4e1_dp/0.9e1_dp*A*t48 - 0.4e1_dp/ & + 0.9e1_dp*A*t54 - 0.4e1_dp/0.9e1_dp*t151*t155 + e_0 = e_0 + (t45*t158*Clda)*sx END IF IF (order >= 1 .OR. order == -1) THEN t165 = rho**2 - srho = -t3/t127*t8*t4/0.18e2_dp-t3*t7/t165/0.6e1_dp + srho = -t3/t127*t8*t4/0.18e2_dp - t3*t7/t165/0.6e1_dp t170 = t2*t7 sndrho = t170*t8/0.6e1_dp t172 = t11*t13 @@ -971,7 +971,7 @@ SUBROUTINE xpbe_hole_t_c_lr_lda_calc_2(e_0, e_rho, e_ndrho, & t183 = t12*t11 t184 = a2*t183 t185 = t19*t174 - t188 = 2*t179*t180+4*t184*t185 + t188 = 2*t179*t180 + 4*t184*t185 t190 = t14*t188*t39 t191 = t21*t86 t192 = t14*t191 @@ -979,26 +979,26 @@ SUBROUTINE xpbe_hole_t_c_lr_lda_calc_2(e_0, e_rho, e_ndrho, & t196 = a4*t17 t197 = t27*t174 t200 = a5*t25 - t204 = 4*t193*t185+5*t196*t197+6*t200*t31*t174 + t204 = 4*t193*t185 + 5*t196*t197 + 6*t200*t31*t174 t207 = t192*t93*t37*t204 t211 = 0.2e1_dp/0.3e1_dp*t50*t93*t7*t4 - qrho = t178+t190-t207+t211 + qrho = t178 + t190 - t207 + t211 t212 = t172*t21 t213 = t34*t41 t217 = t188*t34 t221 = t86*t41 - prho = 0.9e1_dp/0.2e1_dp*t212*t213*t174+0.9e1_dp/0.4e1_dp*t14*t217 & - *t41-0.9e1_dp/0.4e1_dp*t22*t221*t204 + prho = 0.9e1_dp/0.2e1_dp*t212*t213*t174 + 0.9e1_dp/0.4e1_dp*t14*t217 & + *t41 - 0.9e1_dp/0.4e1_dp*t22*t221*t204 t225 = dsdndrho(rho) t229 = t13*t225 t232 = t19*t225 - t235 = 2*t179*t229+4*t184*t232 + t235 = 2*t179*t229 + 4*t184*t232 t236 = t235*t34 t242 = t27*t225 - t248 = 4*t193*t232+5*t196*t242+6*t200*t31*t225 - pndrho = 0.9e1_dp/0.2e1_dp*t212*t213*t225+0.9e1_dp/0.4e1_dp*t14* & - t236*t41-0.9e1_dp/0.4e1_dp*t22*t221*t248 - qndrho = 2*t173*t93*t37*t225+t14*t235*t39-t192*t93 & + t248 = 4*t193*t232 + 5*t196*t242 + 6*t200*t31*t225 + pndrho = 0.9e1_dp/0.2e1_dp*t212*t213*t225 + 0.9e1_dp/0.4e1_dp*t14* & + t236*t41 - 0.9e1_dp/0.4e1_dp*t22*t221*t248 + qndrho = 2*t173*t93*t37*t225 + t14*t235*t39 - t192*t93 & *t37*t248 t264 = dexeirho(P, Q, Prho, Qrho) t268 = EXP(-q) @@ -1007,7 +1007,7 @@ SUBROUTINE xpbe_hole_t_c_lr_lda_calc_2(e_0, e_rho, e_ndrho, & t278 = 0.1e1_dp/t37 t280 = 0.1e1_dp/t21*t33*t276*t1*t278 t287 = t191*t204 - t289 = 2*t172*t40*t174+t14*t217-t14*t287 + t289 = 2*t172*t40*t174 + t14*t217 - t14*t287 t292 = t170*t4 t297 = EXP(-t53) t299 = 0.1e1_dp/t51 @@ -1018,10 +1018,10 @@ SUBROUTINE xpbe_hole_t_c_lr_lda_calc_2(e_0, e_rho, e_ndrho, & t324 = g2*t11 t327 = g3*t183 t330 = g4*t17 - t333 = 2*t324*t180+4*t327*t185+5*t330*t197 + t333 = 2*t324*t180 + 4*t327*t185 + 5*t330*t197 t334 = E*t333 t338 = t86*t204 - t340 = F1*t188*t34-t77*t338 + t340 = F1*t188*t34 - t77*t338 t344 = t183*t19 t352 = 0.1e1_dp/t85/t33 t353 = t84*t352 @@ -1038,62 +1038,62 @@ SUBROUTINE xpbe_hole_t_c_lr_lda_calc_2(e_0, e_rho, e_ndrho, & t435 = t86*E t454 = t406*E t461 = t74*t21 - e_rho = e_rho+(0.4e1_dp/0.3e1_dp*t44*t158*Clda+t45*(-0.4e1_dp/0.9e1_dp* & - A*t264-0.4e1_dp/0.27e2_dp*A*qrho*t272*t280+0.4e1_dp/0.27e2_dp & - *A*(t289*t35*t38+0.2e1_dp/0.3e1_dp*t52*t292)*t297*t299 & - *t276*t1*t278+0.4e1_dp/0.3e1_dp*t307*t155*t289-0.4e1_dp & - /0.9e1_dp*t58*(REAL(2*t172*t81*t174, KIND=dp)+REAL(t14*(t217 & - *C-t191*C*t204+2*t317*t65-2*t64*t320*t204+2 & - *t334+t60*t340), KIND=dp)+REAL(4*t344*t91*t174, KIND=dp)+REAL(t83* & - (2*t191*B*t188-2*t353*B*t204+t217*t89-t191*t358 & - +t40*C*t340), KIND=dp)+0.2e1_dp/0.3e1_dp*t93*t7*t122*t4+t93 & - *t37*REAL(2*t172*t106*t174+t14*(2*E*t188*t34 & - -2*t97*t338+2*t95*t333+2*t317*t102-2*t64*t380 & - *t204+t94*t340)+4*t344*t115*t174+t83*(2*t334 & - *t40+2*t75*t217-2*t75*t287+2*t317*t110-2*t394 & - *t358+2*t64*t102*t340+2*t398*t399-2*t113* & - t401)+6*t407*t119*t408+t118*t340*t84*t86+2*t118 & - *t415*t399-2*t118*t119*t401, KIND=dp)+0.4e1_dp*t126*t6*t146 & - *t4+0.3e1_dp*t126*t127*REAL(2*t172*t133*t174+t14 & - *(t128*t333+2*t317*t130-2*t64*t435*t204)+4*t344 & - *t140*t174+t83*(2*t317*t135-2*t394*t75*t204 & - +2*t64*t130*t333+2*t97*t399-2*t138*t401)+6* & - t454*t143*t408+t142*t333*t84*t86+2*t142*t461*t399 & - -2*t142*t143*t401, KIND=dp))*t155-0.4e1_dp/0.9e1_dp*t151*(-0.2e1_dp & - /0.3e1_dp*t152*t292-t178-t190+t207-t211)*t155)* & - Clda)*sx + e_rho = e_rho + (0.4e1_dp/0.3e1_dp*t44*t158*Clda + t45*(-0.4e1_dp/0.9e1_dp* & + A*t264 - 0.4e1_dp/0.27e2_dp*A*qrho*t272*t280 + 0.4e1_dp/0.27e2_dp & + *A*(t289*t35*t38 + 0.2e1_dp/0.3e1_dp*t52*t292)*t297*t299 & + *t276*t1*t278 + 0.4e1_dp/0.3e1_dp*t307*t155*t289 - 0.4e1_dp & + /0.9e1_dp*t58*(REAL(2*t172*t81*t174, KIND=dp) + REAL(t14*(t217 & + *C - t191*C*t204 + 2*t317*t65 - 2*t64*t320*t204 + 2 & + *t334 + t60*t340), KIND=dp) + REAL(4*t344*t91*t174, KIND=dp) + REAL(t83* & + (2*t191*B*t188 - 2*t353*B*t204 + t217*t89 - t191*t358 & + + t40*C*t340), KIND=dp) + 0.2e1_dp/0.3e1_dp*t93*t7*t122*t4 + t93 & + *t37*REAL(2*t172*t106*t174 + t14*(2*E*t188*t34 & + - 2*t97*t338 + 2*t95*t333 + 2*t317*t102 - 2*t64*t380 & + *t204 + t94*t340) + 4*t344*t115*t174 + t83*(2*t334 & + *t40 + 2*t75*t217 - 2*t75*t287 + 2*t317*t110 - 2*t394 & + *t358 + 2*t64*t102*t340 + 2*t398*t399 - 2*t113* & + t401) + 6*t407*t119*t408 + t118*t340*t84*t86 + 2*t118 & + *t415*t399 - 2*t118*t119*t401, KIND=dp) + 0.4e1_dp*t126*t6*t146 & + *t4 + 0.3e1_dp*t126*t127*REAL(2*t172*t133*t174 + t14 & + *(t128*t333 + 2*t317*t130 - 2*t64*t435*t204) + 4*t344 & + *t140*t174 + t83*(2*t317*t135 - 2*t394*t75*t204 & + + 2*t64*t130*t333 + 2*t97*t399 - 2*t138*t401) + 6* & + t454*t143*t408 + t142*t333*t84*t86 + 2*t142*t461*t399 & + - 2*t142*t143*t401, KIND=dp))*t155 - 0.4e1_dp/0.9e1_dp*t151*(-0.2e1_dp & + /0.3e1_dp*t152*t292 - t178 - t190 + t207 - t211)*t155)* & + Clda)*sx t485 = dexeindrho(P, Q, Pndrho, Qndrho) t496 = t191*t248 - t498 = 2*t172*t40*t225+t14*t236-t14*t496 + t498 = 2*t172*t40*t225 + t14*t236 - t14*t496 t512 = D*t235 - t524 = 2*t324*t229+4*t327*t232+5*t330*t242 + t524 = 2*t324*t229 + 4*t327*t232 + 5*t330*t242 t525 = E*t524 t529 = t86*t248 - t531 = F1*t235*t34-t77*t529 + t531 = F1*t235*t34 - t77*t529 t545 = t89*t248 t579 = t86*t235 t581 = t352*t248 t586 = t86*t225 - e_ndrho = e_ndrho+(t45*(-0.4e1_dp/0.9e1_dp*A*t485-0.4e1_dp/0.27e2_dp*A*qndrho & - *t272*t280+0.4e1_dp/0.9e1_dp*A*t498*t297*t299+0.4e1_dp & - /0.3e1_dp*t307*t155*t498-0.4e1_dp/0.9e1_dp*t58*REAL(2*t172 & - *t81*t225+t14*(t236*C-t191*C*t248+2*t512*t65 & - -2*t64*t320*t248+2*t525+t60*t531)+4*t344*t91 & - *t225+t83*(2*t191*B*t235-2*t353*B*t248+t236 & - *t89-t191*t545+t40*C*t531)+t93*t37*(2*t172* & - t106*t225+t14*(2*E*t235*t34-2*t97*t529+2*t95 & - *t524+2*t512*t102-2*t64*t380*t248+t94*t531)+ & - 4*t344*t115*t225+t83*(2*t525*t40+2*t75*t236- & - 2*t75*t496+2*t512*t110-2*t394*t545+2*t64*t102 & - *t531+2*t398*t579-2*t113*t581)+6*t407*t119* & - t586+t118*t531*t84*t86+2*t118*t415*t579-2*t118 & - *t119*t581)+3*t126*t127*(2*t172*t133*t225+t14 & - *(t128*t524+2*t512*t130-2*t64*t435*t248)+4*t344 & - *t140*t225+t83*(2*t512*t135-2*t394*t75*t248 & - +2*t64*t130*t524+2*t97*t579-2*t138*t581)+6* & - t454*t143*t586+t142*t524*t84*t86+2*t142*t461*t579 & - -2*t142*t143*t581), KIND=dp)*t155+0.4e1_dp/0.9e1_dp*t151*qndrho & - *t155)*Clda)*sx + e_ndrho = e_ndrho + (t45*(-0.4e1_dp/0.9e1_dp*A*t485 - 0.4e1_dp/0.27e2_dp*A*qndrho & + *t272*t280 + 0.4e1_dp/0.9e1_dp*A*t498*t297*t299 + 0.4e1_dp & + /0.3e1_dp*t307*t155*t498 - 0.4e1_dp/0.9e1_dp*t58*REAL(2*t172 & + *t81*t225 + t14*(t236*C - t191*C*t248 + 2*t512*t65 & + - 2*t64*t320*t248 + 2*t525 + t60*t531) + 4*t344*t91 & + *t225 + t83*(2*t191*B*t235 - 2*t353*B*t248 + t236 & + *t89 - t191*t545 + t40*C*t531) + t93*t37*(2*t172* & + t106*t225 + t14*(2*E*t235*t34 - 2*t97*t529 + 2*t95 & + *t524 + 2*t512*t102 - 2*t64*t380*t248 + t94*t531) + & + 4*t344*t115*t225 + t83*(2*t525*t40 + 2*t75*t236 - & + 2*t75*t496 + 2*t512*t110 - 2*t394*t545 + 2*t64*t102 & + *t531 + 2*t398*t579 - 2*t113*t581) + 6*t407*t119* & + t586 + t118*t531*t84*t86 + 2*t118*t415*t579 - 2*t118 & + *t119*t581) + 3*t126*t127*(2*t172*t133*t225 + t14 & + *(t128*t524 + 2*t512*t130 - 2*t64*t435*t248) + 4*t344 & + *t140*t225 + t83*(2*t512*t135 - 2*t394*t75*t248 & + + 2*t64*t130*t524 + 2*t97*t579 - 2*t138*t581) + 6* & + t454*t143*t586 + t142*t524*t84*t86 + 2*t142*t461*t579 & + - 2*t142*t143*t581), KIND=dp)*t155 + 0.4e1_dp/0.9e1_dp*t151*qndrho & + *t155)*Clda)*sx END IF END SUBROUTINE xpbe_hole_t_c_lr_lda_calc_2 @@ -1123,13 +1123,13 @@ FUNCTION exei(P, Q) exei = 0.0_dp IF (P < expcutoff) THEN !Use exact product - IF (P+Q < 0.5_dp) THEN - tmp = -euler-LOG(P+Q)+P+Q - tmp = tmp-0.25_dp*(P+Q)**2+1.0_dp/18.0_dp*(P+Q)**3-1.0_dp/96.0_dp*(P+Q)**4 - tmp = tmp+1.0_dp/600.0_dp*(P+Q)**5 + IF (P + Q < 0.5_dp) THEN + tmp = -euler - LOG(P + Q) + P + Q + tmp = tmp - 0.25_dp*(P + Q)**2 + 1.0_dp/18.0_dp*(P + Q)**3 - 1.0_dp/96.0_dp*(P + Q)**4 + tmp = tmp + 1.0_dp/600.0_dp*(P + Q)**5 exei = EXP(P)*tmp ELSE - exei = EXP(P)*expint(1, Q+P) + exei = EXP(P)*expint(1, Q + P) END IF ELSE !Use approximation @@ -1138,19 +1138,19 @@ FUNCTION exei(P, Q) exei = tmp ! *** 2nd order tmp = tmp/P - exei = exei-(Q+1.0_dp)*tmp + exei = exei - (Q + 1.0_dp)*tmp ! *** 3rd order tmp = tmp/P Q2 = Q*Q - exei = exei+(2.0_dp*Q+Q2+2.0_dp)*tmp + exei = exei + (2.0_dp*Q + Q2 + 2.0_dp)*tmp ! *** 4th order tmp = tmp/P Q3 = Q2*Q - exei = exei-(3.0_dp*Q2+6.0_dp*Q+Q3+6.0_dp)*tmp + exei = exei - (3.0_dp*Q2 + 6.0_dp*Q + Q3 + 6.0_dp)*tmp ! *** 5th order tmp = tmp/P Q4 = Q3*Q - exei = exei+(24.0_dp+4.0_dp*Q3+Q4+12.0_dp*Q2+24.0_dp*Q)*tmp + exei = exei + (24.0_dp + 4.0_dp*Q3 + Q4 + 12.0_dp*Q2 + 24.0_dp*Q)*tmp ! *** scaling factor exei = EXP(-Q)*exei @@ -1169,7 +1169,7 @@ FUNCTION dexeirho(P, Q, dPrho, dQrho) REAL(dp), INTENT(IN) :: P, Q, dPrho, dQrho REAL(dp) :: dexeirho - dexeirho = dPrho*exei(P, Q)-(dPrho+dQrho)/(P+Q)*EXP(-Q) + dexeirho = dPrho*exei(P, Q) - (dPrho + dQrho)/(P + Q)*EXP(-Q) END FUNCTION dexeirho ! ************************************************************************************************** @@ -1184,7 +1184,7 @@ FUNCTION dexeindrho(P, Q, dPndrho, dQndrho) REAL(dp), INTENT(IN) :: P, Q, dPndrho, dQndrho REAL(dp) :: dexeindrho - dexeindrho = dPndrho*exei(P, Q)-(dPndrho+dQndrho)/(P+Q)*EXP(-Q) + dexeindrho = dPndrho*exei(P, Q) - (dPndrho + dQndrho)/(P + Q)*EXP(-Q) END FUNCTION dexeindrho ! ************************************************************************************************** diff --git a/src/xc/xc_xwpbe.F b/src/xc/xc_xwpbe.F index 33476b2c71..2762b5e3e8 100644 --- a/src/xc/xc_xwpbe.F +++ b/src/xc/xc_xwpbe.F @@ -171,7 +171,7 @@ SUBROUTINE xwpbe_lda_eval(rho_set, deriv_set, order, xwpbe_params) CALL xc_rho_set_get(rho_set, rho=rho, & norm_drho=norm_drho, local_bounds=bo, rho_cutoff=epsilon_rho, & drho_cutoff=epsilon_norm_drho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rho @@ -289,7 +289,7 @@ SUBROUTINE xwpbe_lda_calc(npoints, order, rho, norm_drho, e_0, e_rho, e_ndrho, & ss = 0.3466806371753173524216762e0_dp*t6*t8 IF (ss > scutoff) THEN ss2 = ss*ss - sscale = (smax*ss2-sconst)/(ss2*ss) + sscale = (smax*ss2 - sconst)/(ss2*ss) END IF IF (sx0 /= 0.0_dp) THEN @@ -417,7 +417,7 @@ SUBROUTINE xwpbe_lda_calc_0(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t26 = 0.1e1_dp/t25 t28 = t15**2 t29 = t24*t26*t28 - t31 = t5*t16+t22*t29 + t31 = t5*t16 + t22*t29 t32 = f94*t31 t33 = a3*t18 t34 = t33*t21 @@ -437,7 +437,7 @@ SUBROUTINE xwpbe_lda_calc_0(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t59 = t25**2 t61 = t28*t15 t63 = t58/t59*t61 - t65 = r1+t34*t29+t40*t47+t53*t63 + t65 = r1 + t34*t29 + t40*t47 + t53*t63 t66 = 0.1e1_dp/t65 t67 = t66*t1 t68 = t32*t67 @@ -454,12 +454,12 @@ SUBROUTINE xwpbe_lda_calc_0(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t79 = t78*t11 t80 = t31*t66 t81 = t70*t80 - t83 = t79*t81+DD + t83 = t79*t81 + DD t84 = 0.1e1_dp/t83 t86 = F2*t31 - t88 = F1+t86*t66 + t88 = F1 + t86*t66 t89 = t70*t88 - t91 = t79*t89+r1 + t91 = t79*t89 + r1 t92 = f12*t91 t93 = t83**2 t94 = 0.1e1_dp/t93 @@ -470,7 +470,7 @@ SUBROUTINE xwpbe_lda_calc_0(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t103 = r4*B t105 = r8*A t106 = t93*t83 - t109 = t98*(r15*E+t100*t91*t83+t103*t93+t105*t106) + t109 = t98*(r15*E + t100*t91*t83 + t103*t93 + t105*t106) t110 = 0.1e1_dp/r16 t111 = SQRT(t83) t112 = t111*t106 @@ -488,11 +488,11 @@ SUBROUTINE xwpbe_lda_calc_0(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t127 = sscale*t126 t130 = erfc(t121*t122*t123*t127) t134 = 0.1e1_dp/f1516 - t135 = (t97+t109*t114-t97*t118*t130)*t134 + t135 = (t97 + t109*t114 - t97*t118*t130)*t134 t136 = 0.1e1_dp/t98 t138 = 0.1e1_dp/E t139 = t136*t112*t138 - t142 = (-t135*t139+r1)*E + t142 = (-t135*t139 + r1)*E t143 = 0.1e1_dp/t106 t145 = f12*A t146 = exei(Q) @@ -501,9 +501,9 @@ SUBROUTINE xwpbe_lda_calc_0(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t149 = t66*t84 t150 = t148*t149 t152 = LOG(t147*t150) - t156 = (t77*t84+t92*t95+t142*t143+t145*(t146+t152)) & + t156 = (t77*t84 + t92*t95 + t142*t143 + t145*(t146 + t152)) & *Clda - e_0 = e_0+(-t76*t156)*sx0 + e_0 = e_0 + (-t76*t156)*sx0 END IF IF (order >= 1 .OR. order == -1) THEN t158 = t4*t42 @@ -521,8 +521,8 @@ SUBROUTINE xwpbe_lda_calc_0(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t175 = t26*t28 t176 = t175*t7 t180 = t24*t44*t28 - t183 = -0.2e1_dp/0.3e1_dp*t159*t160-(2._dp*t5*t166)-0.4e1_dp/ & - 0.3e1_dp*t174*t176-(4._dp*t22*t180) + t183 = -0.2e1_dp/0.3e1_dp*t159*t160 - (2._dp*t5*t166) - 0.4e1_dp/ & + 0.3e1_dp*t174*t176 - (4._dp*t22*t180) t184 = f94*t183 t185 = t184*t67 t187 = t65**2 @@ -539,8 +539,8 @@ SUBROUTINE xwpbe_lda_calc_0(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t207 = 0.1e1_dp/t25/t12 t209 = t42*t207*t46 t215 = t58/t59/rho*t61 - t218 = -0.4e1_dp/0.3e1_dp*t193*t176-(4._dp*t34*t180)-0.5e1_dp & - /0.3e1_dp*t201*t203-(5._dp*t40*t209)-(8._dp*t53*t215) + t218 = -0.4e1_dp/0.3e1_dp*t193*t176 - (4._dp*t34*t180) - 0.5e1_dp & + /0.3e1_dp*t201*t203 - (5._dp*t40*t209) - (8._dp*t53*t215) t219 = t192*t218 t220 = t14*t219 t222 = t67*t4 @@ -551,14 +551,14 @@ SUBROUTINE xwpbe_lda_calc_0(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t228 = t225*t227 t231 = t164*t15 t233 = t69*t231*t71 - dQrho = t185*t73-t191*t220-0.2e1_dp/0.3e1_dp*t223*t228-(2._dp & - *t68*t233) + dQrho = t185*t73 - t191*t220 - 0.2e1_dp/0.3e1_dp*t223*t228 - (2._dp & + *t68*t233) t236 = a1*ndrho t237 = t236*t4 t240 = t1*ndrho t241 = a2*t240 t242 = t241*t21 - t245 = 2._dp*t237*t16+4._dp*t242*t29 + t245 = 2._dp*t237*t16 + 4._dp*t242*t29 t246 = f94*t245 t247 = t246*t67 t249 = a3*t240 @@ -566,12 +566,12 @@ SUBROUTINE xwpbe_lda_calc_0(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t253 = a4*t18 t254 = t253*t39 t258 = a5*t36*t52 - t261 = 4._dp*t250*t29+5._dp*t254*t47+6._dp*t258*t63 + t261 = 4._dp*t250*t29 + 5._dp*t254*t47 + 6._dp*t258*t63 t262 = t192*t261 t263 = t14*t262 t265 = t66*ndrho t266 = t32*t265 - dQndrho = t247*t73-t191*t263+2._dp*t266*t73 + dQndrho = t247*t73 - t191*t263 + 2._dp*t266*t73 t269 = t74*f89 t272 = t78*t224 t274 = t66*r3*t6 @@ -581,23 +581,23 @@ SUBROUTINE xwpbe_lda_calc_0(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t282 = t70*t281 t284 = t188*t218 t285 = t148*t284 - t287 = -0.2e1_dp/0.3e1_dp*t272*t275-(2._dp*t79*t278)+(t79 & - *t282)-t147*t285 + t287 = -0.2e1_dp/0.3e1_dp*t272*t275 - (2._dp*t79*t278) + (t79 & + *t282) - t147*t285 t288 = t94*t287 t290 = t15*t88 t291 = t290*t7 t294 = t231*t88 t297 = F2*t183 - t300 = t297*t66-t86*t284 + t300 = t297*t66 - t86*t284 t301 = t70*t300 - t303 = -0.2e1_dp/0.3e1_dp*t272*t291-(2._dp*t79*t294)+(t79 & - *t301) + t303 = -0.2e1_dp/0.3e1_dp*t272*t291 - (2._dp*t79*t294) + (t79 & + *t301) t304 = f12*t303 t306 = C*t143 t307 = t306*t287 t314 = t83*t287 - t321 = t98*(t100*t303*t83+t100*t91*t287+2._dp*t103*t314 & - +3._dp*t105*t93*t287) + t321 = t98*(t100*t303*t83 + t100*t91*t287 + 2._dp*t103*t314 & + + 3._dp*t105*t93*t287) t323 = t93**2 t326 = t110/t111/t323 t327 = t326*t287 @@ -619,18 +619,18 @@ SUBROUTINE xwpbe_lda_calc_0(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t357 = t281*t71 t358 = t31*t188 t359 = t71*t218 - t361 = t357-t358*t359 + t361 = t357 - t358*t359 t362 = t356*t361 t363 = t345*t362 - t367 = t342*(-t344*t345*t347/0.3e1_dp-t121*t122*t13*t127 & - +t355*t363/0.2e1_dp) + t367 = t342*(-t344*t345*t347/0.3e1_dp - t121*t122*t13*t127 & + + t355*t363/0.2e1_dp) t368 = t336*t367 - t372 = (t321*t114-0.7e1_dp/0.2e1_dp*t109*t327-(t330*dQrho & - *t117*t130)+(2._dp*t330*t368))*t134 + t372 = (t321*t114 - 0.7e1_dp/0.2e1_dp*t109*t327 - (t330*dQrho & + *t117*t130) + (2._dp*t330*t368))*t134 t374 = t135*t136 t376 = t111*t93*t138 t377 = t376*t287 - t381 = (-t372*t139-0.7e1_dp/0.2e1_dp*t374*t377)*E + t381 = (-t372*t139 - 0.7e1_dp/0.2e1_dp*t374*t377)*E t383 = 0.1e1_dp/t323 t384 = t383*t287 t387 = dexeirho(Q, dQrho) @@ -646,8 +646,8 @@ SUBROUTINE xwpbe_lda_calc_0(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t404 = t66*t94 t405 = t404*t287 t406 = t148*t405 - t408 = -0.2e1_dp/0.3e1_dp*t388*t391-(2._dp*t394*t150)+t147 & - *t398-t147*t402-t147*t406 + t408 = -0.2e1_dp/0.3e1_dp*t388*t391 - (2._dp*t394*t150) + t147 & + *t398 - t147*t402 - t147*t406 t409 = 0.1e1_dp/t1 t410 = t408*t409 t411 = t3*t10 @@ -658,38 +658,38 @@ SUBROUTINE xwpbe_lda_calc_0(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t416 = t415*t65 t417 = t416*t83 t418 = t414*t417 - t423 = (-t77*t288+t304*t95-2._dp*t92*t307+t381*t143-3._dp & - *t142*t384+t145*(t387+t412*t418))*Clda - e_rho = e_rho+(-0.4e1_dp/0.3e1_dp*t269*t156-t76*t423)*sx0 + t423 = (-t77*t288 + t304*t95 - 2._dp*t92*t307 + t381*t143 - 3._dp & + *t142*t384 + t145*(t387 + t412*t418))*Clda + e_rho = e_rho + (-0.4e1_dp/0.3e1_dp*t269*t156 - t76*t423)*sx0 t425 = ndrho*t4 t426 = t425*t11 t429 = t245*t66 t430 = t70*t429 t432 = t188*t261 t433 = t148*t432 - t435 = 2._dp*t426*t81+t79*t430-t147*t433 + t435 = 2._dp*t426*t81 + t79*t430 - t147*t433 t440 = F2*t245 - t443 = t440*t66-t86*t432 + t443 = t440*t66 - t86*t432 t444 = t70*t443 - t446 = 2._dp*t426*t89+t79*t444 + t446 = 2._dp*t426*t89 + t79*t444 t447 = f12*t446 t449 = t306*t435 - t463 = t98*(t100*t446*t83+t100*t91*t435+2._dp*t103*t83 & - *t435+3._dp*t105*t93*t435) + t463 = t98*(t100*t446*t83 + t100*t91*t435 + 2._dp*t103*t83 & + *t435 + 3._dp*t105*t93*t435) t465 = t326*t435 t471 = f32*t120 t472 = t471*t122 t475 = t429*t71 t476 = t71*t261 - t478 = t475-t358*t476 + t478 = t475 - t358*t476 t479 = t356*t478 t480 = t345*t479 - t484 = t342*(t472*t345*t126+t355*t480/0.2e1_dp) + t484 = t342*(t472*t345*t126 + t355*t480/0.2e1_dp) t485 = t336*t484 - t489 = (t463*t114-0.7e1_dp/0.2e1_dp*t109*t465-(t330*dQndrho & - *t117*t130)+(2._dp*t330*t485))*t134 + t489 = (t463*t114 - 0.7e1_dp/0.2e1_dp*t109*t465 - (t330*dQndrho & + *t117*t130) + (2._dp*t330*t485))*t134 t491 = t376*t435 - t495 = (-t489*t139-0.7e1_dp/0.2e1_dp*t374*t491)*E + t495 = (-t489*t139 - 0.7e1_dp/0.2e1_dp*t374*t491)*E t497 = t383*t435 t500 = dexeindrho(Q, dQndrho) t501 = t425*t14 @@ -699,12 +699,12 @@ SUBROUTINE xwpbe_lda_calc_0(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t508 = t148*t507 t510 = t404*t435 t511 = t148*t510 - t513 = 2._dp*t501*t150+t147*t505-t147*t508-t147*t511 + t513 = 2._dp*t501*t150 + t147*t505 - t147*t508 - t147*t511 t514 = t513*t409 t515 = t514*t411 - t520 = (-t77*t94*t435+t447*t95-2._dp*t92*t449+t495*t143 & - -3._dp*t142*t497+t145*(t500+t515*t418))*Clda - e_ndrho = e_ndrho+(-t76*t520)*sx0 + t520 = (-t77*t94*t435 + t447*t95 - 2._dp*t92*t449 + t495*t143 & + - 3._dp*t142*t497 + t145*(t500 + t515*t418))*Clda + e_ndrho = e_ndrho + (-t76*t520)*sx0 END IF IF (order >= 2 .OR. order == -2) THEN t530 = t11*t26 @@ -713,54 +713,54 @@ SUBROUTINE xwpbe_lda_calc_0(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t542 = t175*t169 t546 = t44*t28*t7 t550 = t24*t207*t28 - t553 = 0.10e2_dp/0.9e1_dp*t2*t4*t199*t70*t169+0.8e1_dp/0.3e1_dp & - *t159*t231*t7+(6._dp*t5*t530*t15)+0.28e2_dp/0.9e1_dp* & - t19*t540*t542+0.32e2_dp/0.3e1_dp*t174*t546+(20._dp*t22 & - *t550) + t553 = 0.10e2_dp/0.9e1_dp*t2*t4*t199*t70*t169 + 0.8e1_dp/0.3e1_dp & + *t159*t231*t7 + (6._dp*t5*t530*t15) + 0.28e2_dp/0.9e1_dp* & + t19*t540*t542 + 0.32e2_dp/0.3e1_dp*t174*t546 + (20._dp*t22 & + *t550) t557 = t184*t190 t566 = 0.1e1_dp/t187/t65 t569 = t32*t566*t1*t4 t570 = t218**2 t577 = t32*t188*t78*t42 t579 = t218*r3*t6 - t616 = 0.28e2_dp/0.9e1_dp*t33*t540*t542+0.32e2_dp/0.3e1_dp*t193* & - t546+(20._dp*t34*t550)+0.40e2_dp/0.9e1_dp*t37*t39/t10/ & - t537*t202*t169+0.50e2_dp/0.3e1_dp*t201*t207*t46*t7+0.30e2_dp & - *t40*t42/t25/t163*t46+(72._dp*t53*t58/t59/ & - t12*t61) + t616 = 0.28e2_dp/0.9e1_dp*t33*t540*t542 + 0.32e2_dp/0.3e1_dp*t193* & + t546 + (20._dp*t34*t550) + 0.40e2_dp/0.9e1_dp*t37*t39/t10/ & + t537*t202*t169 + 0.50e2_dp/0.3e1_dp*t201*t207*t46*t7 + 0.30e2_dp & + *t40*t42/t25/t163*t46 + (72._dp*t53*t58/t59/ & + t12*t61) t620 = t199*t13 t621 = t620*t15 t627 = t42*t164 t628 = t627*t15 t632 = t26*t15 - d2Qrhorho = f94*t553*t67*t73-(2._dp*t557*t220)-0.4e1_dp/0.3e1_dp & - *t184*t222*t228-(4._dp*t185*t233)+(2._dp*t569*t14 & - *t192*t570)+0.4e1_dp/0.3e1_dp*t577*t72*t579+(4._dp*t191 & - *t165*t219)-(t191*t14*t192*t616)+0.10e2_dp/0.9e1_dp & - *t223*t621*t71*t54*t56+0.8e1_dp/0.3e1_dp*t223*t628* & - t227+0.6e1_dp*t68*t69*t632*t71 - t647 = -0.4e1_dp/0.3e1_dp*t236*t158*t160-(4._dp*t237*t166) & - -0.16e2_dp/0.3e1_dp*t241*t173*t176-(16._dp*t242*t180) + d2Qrhorho = f94*t553*t67*t73 - (2._dp*t557*t220) - 0.4e1_dp/0.3e1_dp & + *t184*t222*t228 - (4._dp*t185*t233) + (2._dp*t569*t14 & + *t192*t570) + 0.4e1_dp/0.3e1_dp*t577*t72*t579 + (4._dp*t191 & + *t165*t219) - (t191*t14*t192*t616) + 0.10e2_dp/0.9e1_dp & + *t223*t621*t71*t54*t56 + 0.8e1_dp/0.3e1_dp*t223*t628* & + t227 + 0.6e1_dp*t68*t69*t632*t71 + t647 = -0.4e1_dp/0.3e1_dp*t236*t158*t160 - (4._dp*t237*t166) & + - 0.16e2_dp/0.3e1_dp*t241*t173*t176 - (16._dp*t242*t180) t655 = t246*t190 t657 = t359*t261 t663 = t32*t188*ndrho*t4 - t678 = -0.16e2_dp/0.3e1_dp*t249*t173*t176-(16._dp*t250*t180) & - -0.25e2_dp/0.3e1_dp*t253*t200*t203-(25._dp*t254*t209)- & + t678 = -0.16e2_dp/0.3e1_dp*t249*t173*t176 - (16._dp*t250*t180) & + - 0.25e2_dp/0.3e1_dp*t253*t200*t203 - (25._dp*t254*t209) - & (48._dp*t258*t215) t685 = t7*t261 - d2Qrhondrho = (f94*t647*t67*t73)-t557*t263+(2._dp*t184* & - t265*t73)-(t655*t220)+(2._dp*t569*t16*t657)-(2._dp & - *t663*t220)-(t191*t14*t192*t678)-0.2e1_dp/0.3e1_dp & - *t246*t222*t228+0.2e1_dp/0.3e1_dp*t577*t72*t685-0.4e1_dp & - /0.3e1_dp*t32*(t265)*t4*t228-(2._dp*t247*t233)+ & - (2._dp*t191*t165*t262)-(4._dp*t266*t233) - t707 = 2._dp*a1*t4*t16+12._dp*a2*t1*t21*t29 + d2Qrhondrho = (f94*t647*t67*t73) - t557*t263 + (2._dp*t184* & + t265*t73) - (t655*t220) + (2._dp*t569*t16*t657) - (2._dp & + *t663*t220) - (t191*t14*t192*t678) - 0.2e1_dp/0.3e1_dp & + *t246*t222*t228 + 0.2e1_dp/0.3e1_dp*t577*t72*t685 - 0.4e1_dp & + /0.3e1_dp*t32*(t265)*t4*t228 - (2._dp*t247*t233) + & + (2._dp*t191*t165*t262) - (4._dp*t266*t233) + t707 = 2._dp*a1*t4*t16 + 12._dp*a2*t1*t21*t29 t716 = t261**2 - t735 = 12._dp*a3*t1*t21*t29+20._dp*a4*t240*t39*t47+30._dp* & + t735 = 12._dp*a3*t1*t21*t29 + 20._dp*a4*t240*t39*t47 + 30._dp* & a5*t18*t52*t63 - d2Qndrhondrho = f94*t707*t67*t73-2._dp*t655*t263+4._dp*t246*t265* & - t73+2._dp*t569*t14*t192*t716-4._dp*t663*t263-t191*t14 & - *t192*t735+2._dp*t32*t66*t4*t14*t192 + d2Qndrhondrho = f94*t707*t67*t73 - 2._dp*t655*t263 + 4._dp*t246*t265* & + t73 + 2._dp*t569*t14*t192*t716 - 4._dp*t663*t263 - t191*t14 & + *t192*t735 + 2._dp*t32*t66*t4*t14*t192 t744 = t74**2 t751 = t287**2 t755 = t78*t620 @@ -768,16 +768,16 @@ SUBROUTINE xwpbe_lda_calc_0(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t778 = t553*t66 t784 = t566*t570 t788 = t188*t616 - t791 = 0.10e2_dp/0.9e1_dp*t755*t148*t66*t54*t56+0.8e1_dp/0.3e1_dp & - *t761*t275-0.4e1_dp/0.3e1_dp*t272*t397*t274+0.4e1_dp/0.3e1_dp & - *t388*t358*t579+(6._dp*t79*t632*t80)-(4._dp*t79 & - *t231*t281)+(4._dp*t394*t285)+(t79*t70*t778) & - -0.2e1_dp*t147*t397*t284+0.2e1_dp*t147*t148*t784-t147 & + t791 = 0.10e2_dp/0.9e1_dp*t755*t148*t66*t54*t56 + 0.8e1_dp/0.3e1_dp & + *t761*t275 - 0.4e1_dp/0.3e1_dp*t272*t397*t274 + 0.4e1_dp/0.3e1_dp & + *t388*t358*t579 + (6._dp*t79*t632*t80) - (4._dp*t79 & + *t231*t281) + (4._dp*t394*t285) + (t79*t70*t778) & + - 0.2e1_dp*t147*t397*t284 + 0.2e1_dp*t147*t148*t784 - t147 & *t148*t788 - t819 = 0.10e2_dp/0.9e1_dp*t755*t290*t169+0.8e1_dp/0.3e1_dp*t761* & - t291-0.4e1_dp/0.3e1_dp*t272*t15*t300*t7+(6._dp*t79*t632 & - *t88)-0.4e1_dp*(t79)*t231*t300+(t79*t70*(F2 & - *t553*t66-2._dp*t297*t284+2._dp*t86*t784-t86*t788)) + t819 = 0.10e2_dp/0.9e1_dp*t755*t290*t169 + 0.8e1_dp/0.3e1_dp*t761* & + t291 - 0.4e1_dp/0.3e1_dp*t272*t15*t300*t7 + (6._dp*t79*t632 & + *t88) - 0.4e1_dp*(t79)*t231*t300 + (t79*t70*(F2 & + *t553*t66 - 2._dp*t297*t284 + 2._dp*t86*t784 - t86*t788)) t824 = C*t383 t854 = t323*t83 t856 = 0.1e1_dp/t111/t854 @@ -806,147 +806,147 @@ SUBROUTINE xwpbe_lda_calc_0(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1018 = t566*t84 t1023 = t78*t16 t1024 = t94*t218 - t1037 = (6._dp*t78*t530*t150)-(4._dp*t394*t398)+(4._dp & - *t394*t402)+(2._dp*t147*t148*t983*t751)-(t147 & - *t148*t404*t791)+(t147*t15*t553*t149)-(2._dp* & - t147*t397*t401)-(2._dp*t147*t397*t405)-0.4e1_dp/0.3e1_dp & - *t388*t281*t390+0.4e1_dp/0.3e1_dp*t388*t1003*t579+0.4e1_dp & - /0.3e1_dp*t388*t1007*t7*t287+0.10e2_dp/0.9e1_dp*(t78) & - *(t621)*(t80)*(t84)*(t54)*(t56)+(2._dp & - *t147*t148*t1018*t570)+0.2e1_dp*t1023*t358*t1024 & - *t287-(t147*t148*t400*t616)+0.8e1_dp/0.3e1_dp*(t78) & - *(t628)*(t391)+(4._dp*t394*t406) + t1037 = (6._dp*t78*t530*t150) - (4._dp*t394*t398) + (4._dp & + *t394*t402) + (2._dp*t147*t148*t983*t751) - (t147 & + *t148*t404*t791) + (t147*t15*t553*t149) - (2._dp* & + t147*t397*t401) - (2._dp*t147*t397*t405) - 0.4e1_dp/0.3e1_dp & + *t388*t281*t390 + 0.4e1_dp/0.3e1_dp*t388*t1003*t579 + 0.4e1_dp & + /0.3e1_dp*t388*t1007*t7*t287 + 0.10e2_dp/0.9e1_dp*(t78) & + *(t621)*(t80)*(t84)*(t54)*(t56) + (2._dp & + *t147*t148*t1018*t570) + 0.2e1_dp*t1023*t358*t1024 & + *t287 - (t147*t148*t400*t616) + 0.8e1_dp/0.3e1_dp*(t78) & + *(t628)*(t391) + (4._dp*t394*t406) t1055 = t411*t12 t1056 = t410*t1055 t1057 = t31**2 t1059 = t413/t1057 t1060 = t65*t83 - t1073 = (2._dp*t77*t143*t751)-(t77*t94*t791)+(f12 & - *t819*t95)-(4._dp*t304*t307)+(6._dp*t92*t824* & - t751)-(2._dp*t92*t306*t791)+(-((t98*(t100*t819 & - *t83+2._dp*t100*t303*t287+t100*t91*t791+2._dp*t103*t751 & - +2._dp*t103*t83*t791+6._dp*t105*t83*t751+3._dp*t105*t93 & - *t791)*t114)-(7._dp*t321*t327)+0.63e2_dp/0.4e1_dp*(t109) & - *(t857)*(t751)-0.7e1_dp/0.2e1_dp*(t109)*(t326) & - *(t791)-t330*d2Qrhorho*t117*t130-t330*t867*t117 & - *t130+(4._dp*t872*t368)+0.2e1_dp*t875*t335*(0.2e1_dp/ & - 0.3e1_dp*t338*t158*t13*t878*t227+(2._dp*t339*t231* & - t125)-(t339*t70*t357)+t888*t148*t889*t218)*t367 & - +0.2e1_dp*t330*t336*t342*(0.4e1_dp/0.9e1_dp*t119*t120*t172 & - *t345*t126*t54*t56+0.2e1_dp/0.3e1_dp*t344*t905*t347 & - -t910*t911*t7*t361/0.3e1_dp+(2._dp*t121*t122*t164* & - t127)-t355*t905*t362-t355*t345*t923*t924/0.4e1_dp+t355 & - *t345*t356*(t778*t71-2._dp*t930*t359+2._dp*t933* & - t71*t570-t358*t71*t616)/0.2e1_dp))*t134*t139-(7._dp & - *t952*t377)-0.35e2_dp/0.4e1_dp*(t374)*(t956)*(t751) & - -0.7e1_dp/0.2e1_dp*(t374)*(t376)*(t791))*E* & - (t143)-(6._dp*t381*t384)+(12._dp*t142*t968*t751) & - -(3._dp*t142*t383*t791)+t145*(t975+t1037*t409*t411 & - *t418+0.2e1_dp/0.3e1_dp*(t410)*(t3)*(t122)* & - (t12)*(t413)*(t415)*(t65)*(t83)*(r3) & - *(t6)+(2._dp*t412*rho*t413*t417)-t1056*t1059 & - *t1060*t183+(t412)*t414*(t415)*t218*(t83) & - +(t412)*t414*t416*(t287)) - e_rho_rho = e_rho_rho+(-0.4e1_dp/0.9e1_dp/t744*f89*t156-0.8e1_dp/0.3e1_dp*t269*t423 & - -t76*t1073*Clda)*sx0 + t1073 = (2._dp*t77*t143*t751) - (t77*t94*t791) + (f12 & + *t819*t95) - (4._dp*t304*t307) + (6._dp*t92*t824* & + t751) - (2._dp*t92*t306*t791) + (-((t98*(t100*t819 & + *t83 + 2._dp*t100*t303*t287 + t100*t91*t791 + 2._dp*t103*t751 & + + 2._dp*t103*t83*t791 + 6._dp*t105*t83*t751 + 3._dp*t105*t93 & + *t791)*t114) - (7._dp*t321*t327) + 0.63e2_dp/0.4e1_dp*(t109) & + *(t857)*(t751) - 0.7e1_dp/0.2e1_dp*(t109)*(t326) & + *(t791) - t330*d2Qrhorho*t117*t130 - t330*t867*t117 & + *t130 + (4._dp*t872*t368) + 0.2e1_dp*t875*t335*(0.2e1_dp/ & + 0.3e1_dp*t338*t158*t13*t878*t227 + (2._dp*t339*t231* & + t125) - (t339*t70*t357) + t888*t148*t889*t218)*t367 & + + 0.2e1_dp*t330*t336*t342*(0.4e1_dp/0.9e1_dp*t119*t120*t172 & + *t345*t126*t54*t56 + 0.2e1_dp/0.3e1_dp*t344*t905*t347 & + - t910*t911*t7*t361/0.3e1_dp + (2._dp*t121*t122*t164* & + t127) - t355*t905*t362 - t355*t345*t923*t924/0.4e1_dp + t355 & + *t345*t356*(t778*t71 - 2._dp*t930*t359 + 2._dp*t933* & + t71*t570 - t358*t71*t616)/0.2e1_dp))*t134*t139 - (7._dp & + *t952*t377) - 0.35e2_dp/0.4e1_dp*(t374)*(t956)*(t751) & + - 0.7e1_dp/0.2e1_dp*(t374)*(t376)*(t791))*E* & + (t143) - (6._dp*t381*t384) + (12._dp*t142*t968*t751) & + - (3._dp*t142*t383*t791) + t145*(t975 + t1037*t409*t411 & + *t418 + 0.2e1_dp/0.3e1_dp*(t410)*(t3)*(t122)* & + (t12)*(t413)*(t415)*(t65)*(t83)*(r3) & + *(t6) + (2._dp*t412*rho*t413*t417) - t1056*t1059 & + *t1060*t183 + (t412)*t414*(t415)*t218*(t83) & + + (t412)*t414*t416*(t287)) + e_rho_rho = e_rho_rho + (-0.4e1_dp/0.9e1_dp/t744*f89*t156 - 0.8e1_dp/0.3e1_dp*t269*t423 & + - t76*t1073*Clda)*sx0 t1079 = t143*t287*t435 t1082 = t425*t224 t1100 = t647*t66 t1110 = t566*t218*t261 t1114 = t188*t678 - t1117 = -0.4e1_dp/0.3e1_dp*t1082*t275-0.2e1_dp/0.3e1_dp*t272*t504 & - *t274+0.2e1_dp/0.3e1_dp*t388*t358*t685-(4._dp*t426*t278) & - -(2._dp*t79*t231*t429)+(2._dp*t394*t433)+(2._dp & - *t426*t282)+(t79*t70*t1100)-t147*t397*t432-(2._dp & - *t501*t285)-t147*t504*t284+0.2e1_dp*t147*t148*t1110 & - -t147*t148*t1114 - t1143 = -0.4e1_dp/0.3e1_dp*t1082*t291-0.2e1_dp/0.3e1_dp*t272*t15 & - *t443*t7-(4._dp*t426*t294)-0.2e1_dp*t79*t231*t443+ & - (2._dp*t426*t301)+t79*t70*(F2*t647*t66-t297* & - t432-t440*t284+2._dp*t86*t1110-t86*t1114) + t1117 = -0.4e1_dp/0.3e1_dp*t1082*t275 - 0.2e1_dp/0.3e1_dp*t272*t504 & + *t274 + 0.2e1_dp/0.3e1_dp*t388*t358*t685 - (4._dp*t426*t278) & + - (2._dp*t79*t231*t429) + (2._dp*t394*t433) + (2._dp & + *t426*t282) + (t79*t70*t1100) - t147*t397*t432 - (2._dp & + *t501*t285) - t147*t504*t284 + 0.2e1_dp*t147*t148*t1110 & + - t147*t148*t1114 + t1143 = -0.4e1_dp/0.3e1_dp*t1082*t291 - 0.2e1_dp/0.3e1_dp*t272*t15 & + *t443*t7 - (4._dp*t426*t294) - 0.2e1_dp*t79*t231*t443 + & + (2._dp*t426*t301) + t79*t70*(F2*t647*t66 - t297* & + t432 - t440*t284 + 2._dp*t86*t1110 - t86*t1114) t1165 = t435*t287 t1202 = t97*t116*dQndrho - t1215 = t335*(-2._dp*t337*ndrho*t69*t340-t339*t70*t475 & - +t888*t148*t889*t261) + t1215 = t335*(-2._dp*t337*ndrho*t69*t340 - t339*t70*t475 & + + t888*t148*t889*t261) t1242 = t245*t188 - t1258 = (t98*(t100*t1143*t83+t100*t303*t435+t100 & - *t446*t287+t100*t91*t1117+2._dp*t103*t1165+2._dp*t103* & - t83*t1117+6._dp*t105*t314*t435+3._dp*t105*t93*t1117)* & - t114)-0.7e1_dp/0.2e1_dp*t321*t465-0.7e1_dp/0.2e1_dp*t463*t327 & - +0.63e2_dp/0.4e1_dp*(t109)*(t110)*(t856)*(t287) & - *(t435)-0.7e1_dp/0.2e1_dp*(t109)*(t326)*(t1117) & - -t330*d2Qrhondrho*t117*t130-t330*dQrho*dQndrho*t117*t130 & - +(2._dp*t872*t485)+(2._dp*t1202*t368)+(2._dp*t875 & - *t1215*t367)+0.2e1_dp*t330*t336*t342*(-t471*t24*t123 & - *t127*t7/0.3e1_dp-t910*t911*t7*t478/0.6e1_dp-t472*t905 & - *t126-t355*t905*t479/0.2e1_dp+t472*t363/0.2e1_dp-t355 & - *t345*t923*t361*t478/0.4e1_dp+t355*t345*t356*(t1100 & - *t71-t930*t476-t1242*t359+2._dp*t933*t657-t358 & + t1258 = (t98*(t100*t1143*t83 + t100*t303*t435 + t100 & + *t446*t287 + t100*t91*t1117 + 2._dp*t103*t1165 + 2._dp*t103* & + t83*t1117 + 6._dp*t105*t314*t435 + 3._dp*t105*t93*t1117)* & + t114) - 0.7e1_dp/0.2e1_dp*t321*t465 - 0.7e1_dp/0.2e1_dp*t463*t327 & + + 0.63e2_dp/0.4e1_dp*(t109)*(t110)*(t856)*(t287) & + *(t435) - 0.7e1_dp/0.2e1_dp*(t109)*(t326)*(t1117) & + - t330*d2Qrhondrho*t117*t130 - t330*dQrho*dQndrho*t117*t130 & + + (2._dp*t872*t485) + (2._dp*t1202*t368) + (2._dp*t875 & + *t1215*t367) + 0.2e1_dp*t330*t336*t342*(-t471*t24*t123 & + *t127*t7/0.3e1_dp - t910*t911*t7*t478/0.6e1_dp - t472*t905 & + *t126 - t355*t905*t479/0.2e1_dp + t472*t363/0.2e1_dp - t355 & + *t345*t923*t361*t478/0.4e1_dp + t355*t345*t356*(t1100 & + *t71 - t930*t476 - t1242*t359 + 2._dp*t933*t657 - t358 & *t71*t678)/0.2e1_dp) t1263 = t489*t136 t1286 = d2exeirhondrho(Q, dQrho, dQndrho, d2Qrhondrho) - t1316 = -0.4e1_dp/0.3e1_dp*t425*t225*t391-0.2e1_dp/0.3e1_dp*t388 & - *t429*t390+0.2e1_dp/0.3e1_dp*t388*t1003*t685+0.2e1_dp/0.3e1_dp & - *t388*t1007*t7*t435-0.4e1_dp*t425*t165*t150-(2._dp & - *t394*t505)+(2._dp*t394*t508)+(2._dp*t394*t511)+ & - (2._dp*t501*t398)+t147*t15*t647*t149-t147*t397*t507 - t1347 = -t147*t397*t510-2._dp*t501*t402-t147*t504*t401 & - +2._dp*t1023*t933*t84*t218*t261+t1023*t358*t1024*t435 & - -t147*t148*t400*t678-2._dp*t501*t406-t147*t504*t405 & - +t1023*t358*t288*t261+2._dp*t1023*t80*t1079-t147 & + t1316 = -0.4e1_dp/0.3e1_dp*t425*t225*t391 - 0.2e1_dp/0.3e1_dp*t388 & + *t429*t390 + 0.2e1_dp/0.3e1_dp*t388*t1003*t685 + 0.2e1_dp/0.3e1_dp & + *t388*t1007*t7*t435 - 0.4e1_dp*t425*t165*t150 - (2._dp & + *t394*t505) + (2._dp*t394*t508) + (2._dp*t394*t511) + & + (2._dp*t501*t398) + t147*t15*t647*t149 - t147*t397*t507 + t1347 = -t147*t397*t510 - 2._dp*t501*t402 - t147*t504*t401 & + + 2._dp*t1023*t933*t84*t218*t261 + t1023*t358*t1024*t435 & + - t147*t148*t400*t678 - 2._dp*t501*t406 - t147*t504*t405 & + + t1023*t358*t288*t261 + 2._dp*t1023*t80*t1079 - t147 & *t148*t404*t1117 t1352 = 0.1e1_dp/t240 t1358 = t1059*t1060*t245 t1362 = t414*t415*t261*t83 t1365 = t414*t416*t435 - t1369 = (2._dp*t77*t1079)-(t77*t94*t1117)+f12*t1143 & - *t95-(2._dp*t304*t449)-(2._dp*t447*t307)+(6._dp & - *t92*C*t384*t435)-(2._dp*t92*t306*t1117)+(-t1258 & - *t134*t139-0.7e1_dp/0.2e1_dp*t952*t491-0.7e1_dp/0.2e1_dp*t1263 & - *t377-0.35e2_dp/0.4e1_dp*t374*t956*t1165-0.7e1_dp/0.2e1_dp* & - t374*t376*(t1117))*E*t143-(3._dp*t381*t497)-(3._dp & - *t495*t384)+(12._dp*t142*t968*t287*t435)-(3._dp & - *t142*t383*t1117)+(t145*(t1286+(t1316+t1347)* & - t409*t411*t418-2._dp*t408*t1352*t411*t418-t1056*t1358 & - +t412*t1362+t412*t1365)) - e_ndrho_rho = e_ndrho_rho+(-0.4e1_dp/0.3e1_dp*t269*t520-t76*t1369*Clda)*sx0 + t1369 = (2._dp*t77*t1079) - (t77*t94*t1117) + f12*t1143 & + *t95 - (2._dp*t304*t449) - (2._dp*t447*t307) + (6._dp & + *t92*C*t384*t435) - (2._dp*t92*t306*t1117) + (-t1258 & + *t134*t139 - 0.7e1_dp/0.2e1_dp*t952*t491 - 0.7e1_dp/0.2e1_dp*t1263 & + *t377 - 0.35e2_dp/0.4e1_dp*t374*t956*t1165 - 0.7e1_dp/0.2e1_dp* & + t374*t376*(t1117))*E*t143 - (3._dp*t381*t497) - (3._dp & + *t495*t384) + (12._dp*t142*t968*t287*t435) - (3._dp & + *t142*t383*t1117) + (t145*(t1286 + (t1316 + t1347)* & + t409*t411*t418 - 2._dp*t408*t1352*t411*t418 - t1056*t1358 & + + t412*t1362 + t412*t1365)) + e_ndrho_rho = e_ndrho_rho + (-0.4e1_dp/0.3e1_dp*t269*t520 - t76*t1369*Clda)*sx0 t1372 = t435**2 t1382 = t707*t66 t1388 = t566*t716 t1392 = t188*t735 - t1395 = 2._dp*t887*t878+4._dp*t426*t430-4._dp*t501*t433+t79* & - t70*t1382-2._dp*t147*t504*t432+2._dp*t147*t148*t1388- & + t1395 = 2._dp*t887*t878 + 4._dp*t426*t430 - 4._dp*t501*t433 + t79* & + t70*t1382 - 2._dp*t147*t504*t432 + 2._dp*t147*t148*t1388 - & t147*t148*t1392 - t1412 = 2._dp*t69*t89+4._dp*t426*t444+t79*t70*(F2*t707* & - t66-2._dp*t440*t432+2._dp*t86*t1388-t86*t1392) + t1412 = 2._dp*t69*t89 + 4._dp*t426*t444 + t79*t70*(F2*t707* & + t66 - 2._dp*t440*t432 + 2._dp*t86*t1388 - t86*t1392) t1455 = dQndrho**2 t1465 = t478**2 t1510 = d2exeindrhondrho(Q, dQndrho, d2Qndrhondrho) - t1547 = 2._dp*t887*t150+4._dp*t501*t505-4._dp*t501*t508-4._dp*t501 & - *t511+t147*t15*t707*t149-2._dp*t147*t504*t507-2._dp & - *t147*t504*t510+2._dp*t147*t148*t1018*t716+2._dp*t1023 & - *t358*t94*t261*t435-t147*t148*t400*t735+2._dp*t147 & - *t148*t983*t1372-t147*t148*t404*t1395 - t1561 = (2._dp*t77*t143*t1372)-(t77*t94*t1395)+(f12 & - *t1412*t95)-(4._dp*t447*t449)+(6._dp*t92*t824 & - *t1372)-(2._dp*t92*t306*t1395)+(-((t98*(t100* & - t1412*t83+2._dp*t100*t446*t435+t100*t91*t1395+2._dp*t103 & - *t1372+2._dp*t103*t83*t1395+6._dp*t105*t83*t1372+3._dp* & - t105*t93*t1395)*t114)-(7._dp*t463*t465)+0.63e2_dp/0.4e1_dp & - *(t109)*(t857)*(t1372)-0.7e1_dp/0.2e1_dp*(t109) & - *(t326)*(t1395)-t330*d2Qndrhondrho*t117*t130-t330 & - *t1455*t117*t130+(4._dp*t1202*t485)+(2._dp*t875* & - t1215*t484)+0.2e1_dp*t330*t336*t342*(t472*t480-t355 & - *t345*t923*t1465/0.4e1_dp+t355*t345*t356*(t1382* & - t71-2._dp*t1242*t476+2._dp*t933*t71*t716-t358*t71*t735) & - /0.2e1_dp))*t134*t139-(7._dp*t1263*t491)-0.35e2_dp/0.4e1_dp & - *(t374)*(t956)*(t1372)-0.7e1_dp/0.2e1_dp*(t374) & - *(t376)*(t1395))*E*(t143)-(6._dp*t495 & - *t497)+(12._dp*t142*t968*t1372)-(3._dp*t142*t383* & - t1395)+(t145*(t1510+t1547*t409*t411*t418-2._dp*t513 & - *t1352*t411*t418-t514*t1055*t1358+t515*t1362+t515 & + t1547 = 2._dp*t887*t150 + 4._dp*t501*t505 - 4._dp*t501*t508 - 4._dp*t501 & + *t511 + t147*t15*t707*t149 - 2._dp*t147*t504*t507 - 2._dp & + *t147*t504*t510 + 2._dp*t147*t148*t1018*t716 + 2._dp*t1023 & + *t358*t94*t261*t435 - t147*t148*t400*t735 + 2._dp*t147 & + *t148*t983*t1372 - t147*t148*t404*t1395 + t1561 = (2._dp*t77*t143*t1372) - (t77*t94*t1395) + (f12 & + *t1412*t95) - (4._dp*t447*t449) + (6._dp*t92*t824 & + *t1372) - (2._dp*t92*t306*t1395) + (-((t98*(t100* & + t1412*t83 + 2._dp*t100*t446*t435 + t100*t91*t1395 + 2._dp*t103 & + *t1372 + 2._dp*t103*t83*t1395 + 6._dp*t105*t83*t1372 + 3._dp* & + t105*t93*t1395)*t114) - (7._dp*t463*t465) + 0.63e2_dp/0.4e1_dp & + *(t109)*(t857)*(t1372) - 0.7e1_dp/0.2e1_dp*(t109) & + *(t326)*(t1395) - t330*d2Qndrhondrho*t117*t130 - t330 & + *t1455*t117*t130 + (4._dp*t1202*t485) + (2._dp*t875* & + t1215*t484) + 0.2e1_dp*t330*t336*t342*(t472*t480 - t355 & + *t345*t923*t1465/0.4e1_dp + t355*t345*t356*(t1382* & + t71 - 2._dp*t1242*t476 + 2._dp*t933*t71*t716 - t358*t71*t735) & + /0.2e1_dp))*t134*t139 - (7._dp*t1263*t491) - 0.35e2_dp/0.4e1_dp & + *(t374)*(t956)*(t1372) - 0.7e1_dp/0.2e1_dp*(t374) & + *(t376)*(t1395))*E*(t143) - (6._dp*t495 & + *t497) + (12._dp*t142*t968*t1372) - (3._dp*t142*t383* & + t1395) + (t145*(t1510 + t1547*t409*t411*t418 - 2._dp*t513 & + *t1352*t411*t418 - t514*t1055*t1358 + t515*t1362 + t515 & *t1365)) - e_ndrho_ndrho = e_ndrho_ndrho+(-t76*t1561*Clda)*sx0 + e_ndrho_ndrho = e_ndrho_ndrho + (-t76*t1561*Clda)*sx0 END IF END SUBROUTINE xwpbe_lda_calc_0 @@ -1031,7 +1031,7 @@ SUBROUTINE xwpbe_lda_calc_01(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t26 = 0.1e1_dp/t25 t28 = t15**2 t29 = t24*t26*t28 - t31 = t5*t16+t22*t29 + t31 = t5*t16 + t22*t29 t32 = f94*t31 t33 = a3*t18 t34 = t33*t21 @@ -1051,7 +1051,7 @@ SUBROUTINE xwpbe_lda_calc_01(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t59 = t25**2 t61 = t28*t15 t63 = t58/t59*t61 - t65 = r1+t34*t29+t40*t47+t53*t63 + t65 = r1 + t34*t29 + t40*t47 + t53*t63 t66 = 0.1e1_dp/t65 t67 = t66*t1 t68 = t32*t67 @@ -1068,12 +1068,12 @@ SUBROUTINE xwpbe_lda_calc_01(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t79 = t78*t11 t80 = t31*t66 t81 = t70*t80 - t83 = t79*t81+DD + t83 = t79*t81 + DD t84 = 0.1e1_dp/t83 t86 = F2*t31 - t88 = F1+t86*t66 + t88 = F1 + t86*t66 t89 = t70*t88 - t92 = f12*(t79*t89+r1) + t92 = f12*(t79*t89 + r1) t93 = t83**2 t94 = 0.1e1_dp/t93 t95 = C*t94 @@ -1081,9 +1081,9 @@ SUBROUTINE xwpbe_lda_calc_01(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t98 = t97*t4 t100 = g3*t18 t101 = t100*t21 - t103 = g1+t98*t16+t101*t29 + t103 = g1 + t98*t16 + t101*t29 t104 = t70*t103 - t107 = (t79*t104+r1)*E + t107 = (t79*t104 + r1)*E t109 = 0.1e1_dp/t93/t83 t111 = f12*A t112 = exei(Q) @@ -1092,9 +1092,9 @@ SUBROUTINE xwpbe_lda_calc_01(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t115 = t66*t84 t116 = t114*t115 t118 = LOG(t113*t116) - t122 = (t77*t84+t92*t95+t107*t109+t111*(t112+t118)) & + t122 = (t77*t84 + t92*t95 + t107*t109 + t111*(t112 + t118)) & *Clda - e_0 = e_0+(-t76*t122)*sx0 + e_0 = e_0 + (-t76*t122)*sx0 END IF IF (order >= 1 .OR. order == -1) THEN t124 = t4*t42 @@ -1111,8 +1111,8 @@ SUBROUTINE xwpbe_lda_calc_01(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t141 = t26*t28 t142 = t141*t7 t146 = t24*t44*t28 - t149 = -0.2e1_dp/0.3e1_dp*t125*t126-(2._dp*t5*t132)-0.4e1_dp/ & - 0.3e1_dp*t140*t142-(4._dp*t22*t146) + t149 = -0.2e1_dp/0.3e1_dp*t125*t126 - (2._dp*t5*t132) - 0.4e1_dp/ & + 0.3e1_dp*t140*t142 - (4._dp*t22*t146) t150 = f94*t149 t151 = t150*t67 t153 = t65**2 @@ -1129,8 +1129,8 @@ SUBROUTINE xwpbe_lda_calc_01(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t173 = 0.1e1_dp/t25/t12 t175 = t42*t173*t46 t181 = t58/t59/rho*t61 - t184 = -0.4e1_dp/0.3e1_dp*t159*t142-(4._dp*t34*t146)-0.5e1_dp & - /0.3e1_dp*t167*t169-(5._dp*t40*t175)-(8._dp*t53*t181) + t184 = -0.4e1_dp/0.3e1_dp*t159*t142 - (4._dp*t34*t146) - 0.5e1_dp & + /0.3e1_dp*t167*t169 - (5._dp*t40*t175) - (8._dp*t53*t181) t185 = t158*t184 t186 = t14*t185 t188 = t67*t4 @@ -1141,14 +1141,14 @@ SUBROUTINE xwpbe_lda_calc_01(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t194 = t191*t193 t197 = t130*t15 t199 = t69*t197*t71 - dQrho = t151*t73-t157*t186-0.2e1_dp/0.3e1_dp*t189*t194-(2._dp & - *t68*t199) + dQrho = t151*t73 - t157*t186 - 0.2e1_dp/0.3e1_dp*t189*t194 - (2._dp & + *t68*t199) t202 = a1*ndrho t203 = t202*t4 t206 = t1*ndrho t207 = a2*t206 t208 = t207*t21 - t211 = 2._dp*t203*t16+4._dp*t208*t29 + t211 = 2._dp*t203*t16 + 4._dp*t208*t29 t212 = f94*t211 t213 = t212*t67 t215 = a3*t206 @@ -1156,12 +1156,12 @@ SUBROUTINE xwpbe_lda_calc_01(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t219 = a4*t18 t220 = t219*t39 t224 = a5*t36*t52 - t227 = 4._dp*t216*t29+5._dp*t220*t47+6._dp*t224*t63 + t227 = 4._dp*t216*t29 + 5._dp*t220*t47 + 6._dp*t224*t63 t228 = t158*t227 t229 = t14*t228 t231 = t66*ndrho t232 = t32*t231 - dQndrho = t213*t73-t157*t229+2._dp*t232*t73 + dQndrho = t213*t73 - t157*t229 + 2._dp*t232*t73 t235 = t74*f89 t238 = t78*t190 t240 = t66*r3*t6 @@ -1171,16 +1171,16 @@ SUBROUTINE xwpbe_lda_calc_01(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t248 = t70*t247 t250 = t154*t184 t251 = t114*t250 - t253 = -0.2e1_dp/0.3e1_dp*t238*t241-(2._dp*t79*t244)+(t79 & - *t248)-t113*t251 + t253 = -0.2e1_dp/0.3e1_dp*t238*t241 - (2._dp*t79*t244) + (t79 & + *t248) - t113*t251 t254 = t94*t253 t256 = t15*t88 t257 = t256*t7 t260 = t197*t88 t263 = F2*t149 - t266 = t263*t66-t86*t250 + t266 = t263*t66 - t86*t250 t267 = t70*t266 - t270 = f12*(-0.2e1_dp/0.3e1_dp*t238*t257-(2._dp*t79*t260)+ & + t270 = f12*(-0.2e1_dp/0.3e1_dp*t238*t257 - (2._dp*t79*t260) + & (t79*t267)) t272 = C*t109 t273 = t272*t253 @@ -1189,11 +1189,11 @@ SUBROUTINE xwpbe_lda_calc_01(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t280 = t197*t103 t283 = t97*t124 t288 = t100*t139 - t293 = -0.2e1_dp/0.3e1_dp*t283*t126-(2._dp*t98*t132)-0.4e1_dp & - /0.3e1_dp*t288*t142-(4._dp*t101*t146) + t293 = -0.2e1_dp/0.3e1_dp*t283*t126 - (2._dp*t98*t132) - 0.4e1_dp & + /0.3e1_dp*t288*t142 - (4._dp*t101*t146) t294 = t70*t293 - t297 = (-0.2e1_dp/0.3e1_dp*t238*t277-(2._dp*t79*t280)+(t79 & - *t294))*E + t297 = (-0.2e1_dp/0.3e1_dp*t238*t277 - (2._dp*t79*t280) + (t79 & + *t294))*E t299 = t93**2 t300 = 0.1e1_dp/t299 t301 = t300*t253 @@ -1210,8 +1210,8 @@ SUBROUTINE xwpbe_lda_calc_01(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t321 = t66*t94 t322 = t321*t253 t323 = t114*t322 - t325 = -0.2e1_dp/0.3e1_dp*t305*t308-(2._dp*t311*t116)+t113 & - *t315-t113*t319-t113*t323 + t325 = -0.2e1_dp/0.3e1_dp*t305*t308 - (2._dp*t311*t116) + t113 & + *t315 - t113*t319 - t113*t323 t326 = 0.1e1_dp/t1 t327 = t325*t326 t328 = t3*t10 @@ -1222,28 +1222,28 @@ SUBROUTINE xwpbe_lda_calc_01(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t333 = t332*t65 t334 = t333*t83 t335 = t331*t334 - t340 = (-t77*t254+t270*t95-2._dp*t92*t273+t297*t109-3._dp & - *t107*t301+t111*(t304+t329*t335))*Clda - e_rho = e_rho+(-0.4e1_dp/0.3e1_dp*t235*t122-t76*t340)*sx0 + t340 = (-t77*t254 + t270*t95 - 2._dp*t92*t273 + t297*t109 - 3._dp & + *t107*t301 + t111*(t304 + t329*t335))*Clda + e_rho = e_rho + (-0.4e1_dp/0.3e1_dp*t235*t122 - t76*t340)*sx0 t342 = ndrho*t4 t343 = t342*t11 t346 = t211*t66 t347 = t70*t346 t349 = t154*t227 t350 = t114*t349 - t352 = 2._dp*t343*t81+t79*t347-t113*t350 + t352 = 2._dp*t343*t81 + t79*t347 - t113*t350 t357 = F2*t211 - t360 = t357*t66-t86*t349 + t360 = t357*t66 - t86*t349 t361 = t70*t360 - t364 = f12*(2._dp*t343*t89+t79*t361) + t364 = f12*(2._dp*t343*t89 + t79*t361) t366 = t272*t352 t371 = g2*ndrho t372 = t371*t4 t375 = g3*t206 t376 = t375*t21 - t379 = 2._dp*t372*t16+4._dp*t376*t29 + t379 = 2._dp*t372*t16 + 4._dp*t376*t29 t380 = t70*t379 - t383 = (2._dp*t343*t104+t79*t380)*E + t383 = (2._dp*t343*t104 + t79*t380)*E t385 = t300*t352 t388 = dexeindrho(Q, dQndrho) t389 = t342*t14 @@ -1253,12 +1253,12 @@ SUBROUTINE xwpbe_lda_calc_01(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t396 = t114*t395 t398 = t321*t352 t399 = t114*t398 - t401 = 2._dp*t389*t116+t113*t393-t113*t396-t113*t399 + t401 = 2._dp*t389*t116 + t113*t393 - t113*t396 - t113*t399 t402 = t401*t326 t403 = t402*t328 - t408 = (-t77*t94*t352+t364*t95-2._dp*t92*t366+t383*t109 & - -3._dp*t107*t385+t111*(t388+t403*t335))*Clda - e_ndrho = e_ndrho+(-t76*t408)*sx0 + t408 = (-t77*t94*t352 + t364*t95 - 2._dp*t92*t366 + t383*t109 & + - 3._dp*t107*t385 + t111*(t388 + t403*t335))*Clda + e_ndrho = e_ndrho + (-t76*t408)*sx0 END IF IF (order >= 2 .OR. order == -2) THEN t410 = t4*t165 @@ -1271,52 +1271,52 @@ SUBROUTINE xwpbe_lda_calc_01(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t430 = t141*t135 t434 = t44*t28*t7 t438 = t24*t173*t28 - t441 = 0.10e2_dp/0.9e1_dp*t2*t410*t412+0.8e1_dp/0.3e1_dp*t125*t415 & - +(6._dp*t5*t419)+0.28e2_dp/0.9e1_dp*t19*t428*t430+0.32e2_dp & - /0.3e1_dp*t140*t434+(20._dp*t22*t438) + t441 = 0.10e2_dp/0.9e1_dp*t2*t410*t412 + 0.8e1_dp/0.3e1_dp*t125*t415 & + + (6._dp*t5*t419) + 0.28e2_dp/0.9e1_dp*t19*t428*t430 + 0.32e2_dp & + /0.3e1_dp*t140*t434 + (20._dp*t22*t438) t445 = t150*t156 t454 = 0.1e1_dp/t153/t65 t457 = t32*t454*t1*t4 t458 = t184**2 t465 = t32*t154*t78*t42 t467 = t184*r3*t6 - t504 = 0.28e2_dp/0.9e1_dp*t33*t428*t430+0.32e2_dp/0.3e1_dp*t159* & - t434+(20._dp*t34*t438)+0.40e2_dp/0.9e1_dp*t37*t39/t10/ & - t425*t168*t135+0.50e2_dp/0.3e1_dp*t167*t173*t46*t7+0.30e2_dp & - *t40*t42/t25/t129*t46+(72._dp*t53*t58/t59/ & - t12*t61) + t504 = 0.28e2_dp/0.9e1_dp*t33*t428*t430 + 0.32e2_dp/0.3e1_dp*t159* & + t434 + (20._dp*t34*t438) + 0.40e2_dp/0.9e1_dp*t37*t39/t10/ & + t425*t168*t135 + 0.50e2_dp/0.3e1_dp*t167*t173*t46*t7 + 0.30e2_dp & + *t40*t42/t25/t129*t46 + (72._dp*t53*t58/t59/ & + t12*t61) t508 = t165*t13 t509 = t508*t15 t515 = t42*t130 t516 = t515*t15 t520 = t26*t15 - d2Qrhorho = f94*t441*t67*t73-(2._dp*t445*t186)-0.4e1_dp/0.3e1_dp & - *t150*t188*t194-(4._dp*t151*t199)+(2._dp*t457*t14 & - *t158*t458)+0.4e1_dp/0.3e1_dp*t465*t72*t467+(4._dp*t157 & - *t131*t185)-(t157*t14*t158*t504)+0.10e2_dp/0.9e1_dp & - *t189*t509*t71*t54*t56+0.8e1_dp/0.3e1_dp*t189*t516* & - t193+0.6e1_dp*t68*t69*t520*t71 - t535 = -0.4e1_dp/0.3e1_dp*t202*t124*t126-(4._dp*t203*t132) & - -0.16e2_dp/0.3e1_dp*t207*t139*t142-(16._dp*t208*t146) + d2Qrhorho = f94*t441*t67*t73 - (2._dp*t445*t186) - 0.4e1_dp/0.3e1_dp & + *t150*t188*t194 - (4._dp*t151*t199) + (2._dp*t457*t14 & + *t158*t458) + 0.4e1_dp/0.3e1_dp*t465*t72*t467 + (4._dp*t157 & + *t131*t185) - (t157*t14*t158*t504) + 0.10e2_dp/0.9e1_dp & + *t189*t509*t71*t54*t56 + 0.8e1_dp/0.3e1_dp*t189*t516* & + t193 + 0.6e1_dp*t68*t69*t520*t71 + t535 = -0.4e1_dp/0.3e1_dp*t202*t124*t126 - (4._dp*t203*t132) & + - 0.16e2_dp/0.3e1_dp*t207*t139*t142 - (16._dp*t208*t146) t543 = t212*t156 t552 = t32*t154*ndrho*t4 - t567 = -0.16e2_dp/0.3e1_dp*t215*t139*t142-(16._dp*t216*t146) & - -0.25e2_dp/0.3e1_dp*t219*t166*t169-(25._dp*t220*t175)- & + t567 = -0.16e2_dp/0.3e1_dp*t215*t139*t142 - (16._dp*t216*t146) & + - 0.25e2_dp/0.3e1_dp*t219*t166*t169 - (25._dp*t220*t175) - & (48._dp*t224*t181) t574 = t7*t227 - d2Qrhondrho = (f94*t535*t67*t73)-t445*t229+(2._dp*t150* & - t231*t73)-(t543*t186)+(2._dp*t457*t16*t71*t184 & - *t227)-(2._dp*t552*t186)-(t157*t14*t158*t567) & - -0.2e1_dp/0.3e1_dp*t212*t188*t194+0.2e1_dp/0.3e1_dp*t465*t72 & - *t574-0.4e1_dp/0.3e1_dp*t32*(t231)*t4*t194-(2._dp*t213 & - *t199)+(2._dp*t157*t131*t228)-(4._dp*t232*t199) - t596 = 2._dp*a1*t4*t16+12._dp*a2*t1*t21*t29 + d2Qrhondrho = (f94*t535*t67*t73) - t445*t229 + (2._dp*t150* & + t231*t73) - (t543*t186) + (2._dp*t457*t16*t71*t184 & + *t227) - (2._dp*t552*t186) - (t157*t14*t158*t567) & + - 0.2e1_dp/0.3e1_dp*t212*t188*t194 + 0.2e1_dp/0.3e1_dp*t465*t72 & + *t574 - 0.4e1_dp/0.3e1_dp*t32*(t231)*t4*t194 - (2._dp*t213 & + *t199) + (2._dp*t157*t131*t228) - (4._dp*t232*t199) + t596 = 2._dp*a1*t4*t16 + 12._dp*a2*t1*t21*t29 t605 = t227**2 - t624 = 12._dp*a3*t1*t21*t29+20._dp*a4*t206*t39*t47+30._dp* & + t624 = 12._dp*a3*t1*t21*t29 + 20._dp*a4*t206*t39*t47 + 30._dp* & a5*t18*t52*t63 - d2Qndrhondrho = f94*t596*t67*t73-2._dp*t543*t229+4._dp*t212*t231* & - t73+2._dp*t457*t14*t158*t605-4._dp*t552*t229-t157*t14 & - *t158*t624+2._dp*t32*t66*t4*t14*t158 + d2Qndrhondrho = f94*t596*t67*t73 - 2._dp*t543*t229 + 4._dp*t212*t231* & + t73 + 2._dp*t457*t14*t158*t605 - 4._dp*t552*t229 - t157*t14 & + *t158*t624 + 2._dp*t32*t66*t4*t14*t158 t633 = t74**2 t640 = t253**2 t644 = t78*t508 @@ -1324,11 +1324,11 @@ SUBROUTINE xwpbe_lda_calc_01(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t656 = t31*t154 t674 = t454*t458 t678 = t154*t504 - t681 = 0.10e2_dp/0.9e1_dp*t644*t114*t66*t54*t56+0.8e1_dp/0.3e1_dp & - *t650*t241-0.4e1_dp/0.3e1_dp*t238*t314*t240+0.4e1_dp/0.3e1_dp & - *t305*t656*t467+(6._dp*t79*t520*t80)-(4._dp*t79 & - *t197*t247)+(4._dp*t311*t251)+(t79)*t70*t441 & - *t66-0.2e1_dp*t113*t314*t250+0.2e1_dp*t113*t114*t674- & + t681 = 0.10e2_dp/0.9e1_dp*t644*t114*t66*t54*t56 + 0.8e1_dp/0.3e1_dp & + *t650*t241 - 0.4e1_dp/0.3e1_dp*t238*t314*t240 + 0.4e1_dp/0.3e1_dp & + *t305*t656*t467 + (6._dp*t79*t520*t80) - (4._dp*t79 & + *t197*t247) + (4._dp*t311*t251) + (t79)*t70*t441 & + *t66 - 0.2e1_dp*t113*t314*t250 + 0.2e1_dp*t113*t114*t674 - & t113*t114*t678 t714 = C*t300 t759 = 0.1e1_dp/t299/t83 @@ -1339,104 +1339,104 @@ SUBROUTINE xwpbe_lda_calc_01(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t811 = t78*t16 t812 = t94*t184 t820 = t66*t109 - t828 = 0.8e1_dp/0.3e1_dp*t78*t516*t308-0.4e1_dp/0.3e1_dp*t305*t247 & - *t307+0.4e1_dp/0.3e1_dp*t305*t773*t467+0.4e1_dp/0.3e1_dp* & - t305*t777*t7*t253+0.10e2_dp/0.9e1_dp*t78*t509*t80*t84 & - *t54*t56+0.6e1_dp*t78*t418*t116-(4._dp*t311*t315)+ & - (4._dp*t311*t319)+(4._dp*t311*t323)+(t113*t15* & - t441*t115)-(2._dp*t113*t314*t318)-(2._dp*t113*t314 & - *t322)+(2._dp*t113*t114*t806*t458)+0.2e1_dp*t811*t656 & - *t812*t253-(t113*t114*t317*t504)+(2._dp*t113 & - *t114*t820*t640)-(t113*t114*t321*t681) + t828 = 0.8e1_dp/0.3e1_dp*t78*t516*t308 - 0.4e1_dp/0.3e1_dp*t305*t247 & + *t307 + 0.4e1_dp/0.3e1_dp*t305*t773*t467 + 0.4e1_dp/0.3e1_dp* & + t305*t777*t7*t253 + 0.10e2_dp/0.9e1_dp*t78*t509*t80*t84 & + *t54*t56 + 0.6e1_dp*t78*t418*t116 - (4._dp*t311*t315) + & + (4._dp*t311*t319) + (4._dp*t311*t323) + (t113*t15* & + t441*t115) - (2._dp*t113*t314*t318) - (2._dp*t113*t314 & + *t322) + (2._dp*t113*t114*t806*t458) + 0.2e1_dp*t811*t656 & + *t812*t253 - (t113*t114*t317*t504) + (2._dp*t113 & + *t114*t820*t640) - (t113*t114*t321*t681) t847 = t328*t12 t848 = t327*t847 t849 = t31**2 t851 = t330/t849 t852 = t65*t83 - t865 = (2._dp*t77*t109*t640)-(t77*t94*t681)+f12* & - (0.10e2_dp/0.9e1_dp*t644*t256*t135+0.8e1_dp/0.3e1_dp*t650*t257 & - -0.4e1_dp/0.3e1_dp*t238*t15*t266*t7+(6._dp*t79*t520* & - t88)-0.4e1_dp*(t79)*t197*t266+(t79*t70*(F2*t441 & - *t66-2._dp*t263*t250+2._dp*t86*t674-t86*t678)))*t95 & - -(4._dp*t270*t273)+(6._dp*t92*t714*t640)-(2._dp* & - t92*t272*t681)+(0.10e2_dp/0.9e1_dp*t644*t276*t135+0.8e1_dp & - /0.3e1_dp*t650*t277-0.4e1_dp/0.3e1_dp*t238*t15*t293*t7+(6._dp & - *t79*t520*t103)-0.4e1_dp*(t79)*t197*t293+(t79) & - *(t70)*(0.10e2_dp/0.9e1_dp*t97*t410*t412+0.8e1_dp/ & - 0.3e1_dp*t283*t415+(6._dp*t98*t419)+0.28e2_dp/0.9e1_dp*t100 & - *t428*t430+0.32e2_dp/0.3e1_dp*t288*t434+(20._dp*t101* & - t438)))*E*(t109)-(6._dp*t297*t301)+(12._dp*t107 & - *t759*t640)-(3._dp*t107*t300*t681)+t111*(t766+t828 & - *t326*t328*t335+0.2e1_dp/0.3e1_dp*t327*t3/t9*t12*t330 & - *t332*t65*t83*r3*t6+0.2e1_dp*t329*rho*t330*t334 & - -t848*t851*t852*t149+t329*t331*t332*t184*t83+t329 & + t865 = (2._dp*t77*t109*t640) - (t77*t94*t681) + f12* & + (0.10e2_dp/0.9e1_dp*t644*t256*t135 + 0.8e1_dp/0.3e1_dp*t650*t257 & + - 0.4e1_dp/0.3e1_dp*t238*t15*t266*t7 + (6._dp*t79*t520* & + t88) - 0.4e1_dp*(t79)*t197*t266 + (t79*t70*(F2*t441 & + *t66 - 2._dp*t263*t250 + 2._dp*t86*t674 - t86*t678)))*t95 & + - (4._dp*t270*t273) + (6._dp*t92*t714*t640) - (2._dp* & + t92*t272*t681) + (0.10e2_dp/0.9e1_dp*t644*t276*t135 + 0.8e1_dp & + /0.3e1_dp*t650*t277 - 0.4e1_dp/0.3e1_dp*t238*t15*t293*t7 + (6._dp & + *t79*t520*t103) - 0.4e1_dp*(t79)*t197*t293 + (t79) & + *(t70)*(0.10e2_dp/0.9e1_dp*t97*t410*t412 + 0.8e1_dp/ & + 0.3e1_dp*t283*t415 + (6._dp*t98*t419) + 0.28e2_dp/0.9e1_dp*t100 & + *t428*t430 + 0.32e2_dp/0.3e1_dp*t288*t434 + (20._dp*t101* & + t438)))*E*(t109) - (6._dp*t297*t301) + (12._dp*t107 & + *t759*t640) - (3._dp*t107*t300*t681) + t111*(t766 + t828 & + *t326*t328*t335 + 0.2e1_dp/0.3e1_dp*t327*t3/t9*t12*t330 & + *t332*t65*t83*r3*t6 + 0.2e1_dp*t329*rho*t330*t334 & + - t848*t851*t852*t149 + t329*t331*t332*t184*t83 + t329 & *t331*t333*t253) - e_rho_rho = e_rho_rho+(-0.4e1_dp/0.9e1_dp/t633*f89*t122-0.8e1_dp/0.3e1_dp*t235*t340 & - -t76*t865*Clda)*sx0 + e_rho_rho = e_rho_rho + (-0.4e1_dp/0.9e1_dp/t633*f89*t122 - 0.8e1_dp/0.3e1_dp*t235*t340 & + - t76*t865*Clda)*sx0 t871 = t109*t253*t352 t874 = t342*t190 t902 = t454*t184*t227 t906 = t154*t567 - t909 = -0.4e1_dp/0.3e1_dp*t874*t241-0.2e1_dp/0.3e1_dp*t238*t392* & - t240+0.2e1_dp/0.3e1_dp*t305*t656*t574-(4._dp*t343*t244) & - -(2._dp*t79*t197*t346)+(2._dp*t311*t350)+(2._dp* & - t343*t248)+(t79*t70*t535*t66)-t113*t314*t349- & - (2._dp*t389*t251)-t113*t392*t250+0.2e1_dp*t113*t114 & - *t902-t113*t114*t906 + t909 = -0.4e1_dp/0.3e1_dp*t874*t241 - 0.2e1_dp/0.3e1_dp*t238*t392* & + t240 + 0.2e1_dp/0.3e1_dp*t305*t656*t574 - (4._dp*t343*t244) & + - (2._dp*t79*t197*t346) + (2._dp*t311*t350) + (2._dp* & + t343*t248) + (t79*t70*t535*t66) - t113*t314*t349 - & + (2._dp*t389*t251) - t113*t392*t250 + 0.2e1_dp*t113*t114 & + *t902 - t113*t114*t906 t989 = d2exeirhondrho(Q, dQrho, dQndrho, d2Qrhondrho) - t1019 = -0.4e1_dp/0.3e1_dp*t342*t191*t308-0.2e1_dp/0.3e1_dp*t305 & - *t346*t307+0.2e1_dp/0.3e1_dp*t305*t773*t574+0.2e1_dp/0.3e1_dp & - *t305*t777*t7*t352-0.4e1_dp*t342*t131*t116-(2._dp* & - t311*t393)+(2._dp*t311*t396)+(2._dp*t311*t399)+(2._dp & - *t389*t315)+t113*t15*t535*t115-t113*t314*t395 - t1051 = -t113*t314*t398-2._dp*t389*t319-t113*t392*t318 & - +2._dp*t811*t31*t454*t84*t184*t227+t811*t656*t812* & - t352-t113*t114*t317*t567-2._dp*t389*t323-t113*t392 & - *t322+t811*t656*t254*t227+2._dp*t811*t80*t871-t113 & + t1019 = -0.4e1_dp/0.3e1_dp*t342*t191*t308 - 0.2e1_dp/0.3e1_dp*t305 & + *t346*t307 + 0.2e1_dp/0.3e1_dp*t305*t773*t574 + 0.2e1_dp/0.3e1_dp & + *t305*t777*t7*t352 - 0.4e1_dp*t342*t131*t116 - (2._dp* & + t311*t393) + (2._dp*t311*t396) + (2._dp*t311*t399) + (2._dp & + *t389*t315) + t113*t15*t535*t115 - t113*t314*t395 + t1051 = -t113*t314*t398 - 2._dp*t389*t319 - t113*t392*t318 & + + 2._dp*t811*t31*t454*t84*t184*t227 + t811*t656*t812* & + t352 - t113*t114*t317*t567 - 2._dp*t389*t323 - t113*t392 & + *t322 + t811*t656*t254*t227 + 2._dp*t811*t80*t871 - t113 & *t114*t321*t909 t1056 = 0.1e1_dp/t206 t1062 = t851*t852*t211 t1066 = t331*t332*t227*t83 t1069 = t331*t333*t352 - t1073 = (2._dp*t77*t871)-(t77*t94*t909)+f12*(-0.4e1_dp & - /0.3e1_dp*t874*t257-0.2e1_dp/0.3e1_dp*t238*t15*t360*t7 & - -(4._dp*t343*t260)-0.2e1_dp*t79*t197*t360+(2._dp*t343 & - *t267)+t79*t70*(F2*t535*t66-t263*t349-t357 & - *t250+2._dp*t86*t902-t86*t906))*t95-(2._dp*t270*t366) & - -(2._dp*t364*t273)+(6._dp*t92*C*t301*t352)-(2._dp & - *t92*t272*t909)+(-0.4e1_dp/0.3e1_dp*t874*t277-0.2e1_dp/ & - 0.3e1_dp*t238*t15*t379*t7-(4._dp*t343*t280)-0.2e1_dp* & - t79*t197*t379+(2._dp*t343*t294)+t79*t70*(-0.4e1_dp/ & - 0.3e1_dp*t371*t124*t126-(4._dp*t372*t132)-0.16e2_dp/0.3e1_dp & - *t375*t139*t142-(16._dp*t376*t146)))*E*t109-(3._dp & - *t297*t385)-(3._dp*t383*t301)+(12._dp*t107*t759 & - *t253*t352)-(3._dp*t107*t300*t909)+(t111*(t989 & - +(t1019+t1051)*t326*t328*t335-2._dp*t325*t1056*t328 & - *t335-t848*t1062+t329*t1066+t329*t1069)) - e_ndrho_rho = e_ndrho_rho+(-0.4e1_dp/0.3e1_dp*t235*t408-t76*t1073*Clda)*sx0 + t1073 = (2._dp*t77*t871) - (t77*t94*t909) + f12*(-0.4e1_dp & + /0.3e1_dp*t874*t257 - 0.2e1_dp/0.3e1_dp*t238*t15*t360*t7 & + - (4._dp*t343*t260) - 0.2e1_dp*t79*t197*t360 + (2._dp*t343 & + *t267) + t79*t70*(F2*t535*t66 - t263*t349 - t357 & + *t250 + 2._dp*t86*t902 - t86*t906))*t95 - (2._dp*t270*t366) & + - (2._dp*t364*t273) + (6._dp*t92*C*t301*t352) - (2._dp & + *t92*t272*t909) + (-0.4e1_dp/0.3e1_dp*t874*t277 - 0.2e1_dp/ & + 0.3e1_dp*t238*t15*t379*t7 - (4._dp*t343*t280) - 0.2e1_dp* & + t79*t197*t379 + (2._dp*t343*t294) + t79*t70*(-0.4e1_dp/ & + 0.3e1_dp*t371*t124*t126 - (4._dp*t372*t132) - 0.16e2_dp/0.3e1_dp & + *t375*t139*t142 - (16._dp*t376*t146)))*E*t109 - (3._dp & + *t297*t385) - (3._dp*t383*t301) + (12._dp*t107*t759 & + *t253*t352) - (3._dp*t107*t300*t909) + (t111*(t989 & + + (t1019 + t1051)*t326*t328*t335 - 2._dp*t325*t1056*t328 & + *t335 - t848*t1062 + t329*t1066 + t329*t1069)) + e_ndrho_rho = e_ndrho_rho + (-0.4e1_dp/0.3e1_dp*t235*t408 - t76*t1073*Clda)*sx0 t1076 = t352**2 t1080 = t69*t13 t1094 = t454*t605 t1098 = t154*t624 - t1101 = 2._dp*t1080*t114*t66+4._dp*t343*t347-4._dp*t389*t350 & - +t79*t70*t596*t66-2._dp*t113*t392*t349+2._dp*t113*t114 & - *t1094-t113*t114*t1098 + t1101 = 2._dp*t1080*t114*t66 + 4._dp*t343*t347 - 4._dp*t389*t350 & + + t79*t70*t596*t66 - 2._dp*t113*t392*t349 + 2._dp*t113*t114 & + *t1094 - t113*t114*t1098 t1154 = d2exeindrhondrho(Q, dQndrho, d2Qndrhondrho) - t1191 = 2._dp*t1080*t116+4._dp*t389*t393-4._dp*t389*t396-4._dp* & - t389*t399+t113*t15*t596*t115-2._dp*t113*t392*t395- & - 2._dp*t113*t392*t398+2._dp*t113*t114*t806*t605+2._dp*t811 & - *t656*t94*t227*t352-t113*t114*t317*t624+2._dp*t113 & - *t114*t820*t1076-t113*t114*t321*t1101 - t1205 = 2._dp*t77*t109*t1076-t77*t94*t1101+f12*(2._dp*t69 & - *t89+4._dp*t343*t361+t79*t70*(F2*t596*t66-2._dp*t357 & - *t349+2._dp*t86*t1094-t86*t1098))*t95-4._dp*t364*t366 & - +6._dp*t92*t714*t1076-2._dp*t92*t272*t1101+(2._dp*t69*t104 & - +4._dp*t343*t380+t79*t70*(2._dp*g2*t4*t16+12._dp*g3*t1 & - *t21*t29))*E*t109-6._dp*t383*t385+12._dp*t107*t759* & - t1076-3._dp*t107*t300*t1101+t111*(t1154+t1191*t326*t328 & - *t335-2._dp*t401*t1056*t328*t335-t402*t847*t1062 & - +t403*t1066+t403*t1069) - e_ndrho_ndrho = e_ndrho_ndrho+(-t76*t1205*Clda)*sx0 + t1191 = 2._dp*t1080*t116 + 4._dp*t389*t393 - 4._dp*t389*t396 - 4._dp* & + t389*t399 + t113*t15*t596*t115 - 2._dp*t113*t392*t395 - & + 2._dp*t113*t392*t398 + 2._dp*t113*t114*t806*t605 + 2._dp*t811 & + *t656*t94*t227*t352 - t113*t114*t317*t624 + 2._dp*t113 & + *t114*t820*t1076 - t113*t114*t321*t1101 + t1205 = 2._dp*t77*t109*t1076 - t77*t94*t1101 + f12*(2._dp*t69 & + *t89 + 4._dp*t343*t361 + t79*t70*(F2*t596*t66 - 2._dp*t357 & + *t349 + 2._dp*t86*t1094 - t86*t1098))*t95 - 4._dp*t364*t366 & + + 6._dp*t92*t714*t1076 - 2._dp*t92*t272*t1101 + (2._dp*t69*t104 & + + 4._dp*t343*t380 + t79*t70*(2._dp*g2*t4*t16 + 12._dp*g3*t1 & + *t21*t29))*E*t109 - 6._dp*t383*t385 + 12._dp*t107*t759* & + t1076 - 3._dp*t107*t300*t1101 + t111*(t1154 + t1191*t326*t328 & + *t335 - 2._dp*t401*t1056*t328*t335 - t402*t847*t1062 & + + t403*t1066 + t403*t1069) + e_ndrho_ndrho = e_ndrho_ndrho + (-t76*t1205*Clda)*sx0 END IF END SUBROUTINE xwpbe_lda_calc_01 @@ -1557,7 +1557,7 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t29 = 0.1e1_dp/t28 t31 = t14**2 t32 = t27*t29*t31 - t34 = t17*t19+t25*t32 + t34 = t17*t19 + t25*t32 t35 = a3*t21 t36 = t35*t24 t38 = t21*ndrho @@ -1576,7 +1576,7 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t61 = t28**2 t63 = t31*t14 t65 = t60/t61*t63 - t67 = r1+t36*t32+t42*t49+t55*t65 + t67 = r1 + t36*t32 + t42*t49 + t55*t65 t68 = 0.1e1_dp/t67 t69 = t34*t68 t70 = t15*t69 @@ -1584,19 +1584,19 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t72 = omega**2 t73 = beta*t72 t74 = t73*t10 - t75 = t71+t74 + t75 = t71 + t74 t77 = 0.1e1_dp/A Q = f94*t75*t77 t78 = rho**(0.1e1_dp/0.3e1_dp) t80 = t78*rho*f89 t81 = B*f12 - t82 = t71+DD + t82 = t71 + DD t83 = 0.1e1_dp/t82 t84 = t81*t83 t85 = F2*t34 - t87 = F1+t85*t68 + t87 = F1 + t85*t68 t88 = t15*t87 - t90 = t11*t88+r1 + t90 = t11*t88 + r1 t91 = f12*t90 t92 = t82**2 t93 = 0.1e1_dp/t92 @@ -1608,7 +1608,7 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t102 = r4*B t104 = r8*A t105 = t92*t82 - t108 = t97*(r15*E+t99*t90*t82+t102*t92+t104*t105) + t108 = t97*(r15*E + t99*t90*t82 + t102*t92 + t104*t105) t109 = 0.1e1_dp/r16 t110 = SQRT(t82) t111 = t110*t105 @@ -1632,18 +1632,18 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t133 = sscale*t132 t136 = erfc(t127*t128*t129*t133) t140 = 0.1e1_dp/f1516 - t141 = (t96+t108*t113-t96*t124*t136)*t140 + t141 = (t96 + t108*t113 - t96*t124*t136)*t140 t142 = 0.1e1_dp/t97 t144 = 0.1e1_dp/E t145 = t142*t111*t144 - t147 = -t141*t145+r1 + t147 = -t141*t145 + r1 t148 = t147*E t149 = 0.1e1_dp/t105 t150 = t148*t149 t151 = f158*E t152 = t147*t83 t153 = t72*t10 - t154 = t71+DD+t153 + t154 = t71 + DD + t153 t155 = t154**2 t156 = t155**2 t157 = t156*t154 @@ -1656,14 +1656,14 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t168 = t155*t154 t169 = SQRT(t168) t170 = 0.1e1_dp/t169 - t174 = (-t151*t152*t159-t81*t83*t163-t166*t167*t170) & + t174 = (-t151*t152*t159 - t81*t83*t163 - t166*t167*t170) & *omega t176 = f52*E t177 = t147*t93 t180 = f12*C t181 = t90*t93 t185 = t72*omega - t186 = (-t176*t177*t159-t180*t181*t170)*t185 + t186 = (-t176*t177*t159 - t180*t181*t170)*t185 t189 = 0.1e1_dp/r3/t5 t190 = t189*t129 t192 = t72**2 @@ -1672,15 +1672,15 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t195 = t194*t44 t197 = f12*A t198 = exei(Q) - t199 = t71+DD+t74 + t199 = t71 + DD + t74 t200 = 0.1e1_dp/t199 t202 = LOG(t75*t200) t205 = SQRT(t199) t209 = t115*f34 t210 = exer(Q) - t213 = (t197*t97/t205-t209*t210)*alpha1 + t213 = (t197*t97/t205 - t209*t210)*alpha1 t214 = omega*t128 - t219 = (t197*t200-f98*t198)*alpha2 + t219 = (t197*t200 - f98*t198)*alpha2 t221 = A*f14 t222 = t199**2 t223 = t222*t199 @@ -1688,12 +1688,12 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t227 = SQRT(t75) t228 = 0.1e1_dp/t227 t233 = 0.1e1_dp/t115 - t237 = (t97*(t221/t224-f98*t228)+f2716*t210*t233)*alpha3 & + t237 = (t97*(t221/t224 - f98*t228) + f2716*t210*t233)*alpha3 & *t185 t239 = 0.1e1_dp/t75 t241 = 0.1e1_dp/t222 t243 = f8132*t77 - t246 = (-f98*t239+t197*t241+t243*t198)*alpha4 + t246 = (-f98*t239 + t197*t241 + t243*t198)*alpha4 t247 = t192*t27 t250 = t75**2 t251 = t250*t75 @@ -1707,7 +1707,7 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t264 = t263*A t265 = SQRT(t264) t267 = f24364/t265 - t270 = (t97*(t243*t228-f916*t253+t255/t258)-t267*t210) & + t270 = (t97*(t243*t228 - f916*t253 + t255/t258) - t267*t210) & *alpha5 t271 = t193*t44 t273 = 0.1e1_dp/t223 @@ -1715,7 +1715,7 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t276 = f98*t275 t280 = f729128/t263 t284 = t192*t72 - t285 = (A*t273-t276+t243*r1*t239-t280*t198)*alpha6 & + t285 = (A*t273 - t276 + t243*r1*t239 - t280*t198)*alpha6 & *t284 t286 = t60*t13 t288 = f1516*A @@ -1728,8 +1728,8 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t303 = t263**2 t305 = SQRT(t303*A) t307 = f2187256/t305 - t310 = (t97*(t288/t290-f2732/t295+t298*t253-t280*t228) & - +t307*t210)*alpha7 + t310 = (t97*(t288/t290 - f2732/t295 + t298*t253 - t280*t228) & + + t307*t210)*alpha7 t311 = t192*t185 t312 = t56*t58 t313 = t312*t12 @@ -1739,16 +1739,16 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t319 = 0.1e1_dp/t256 t321 = 0.1e1_dp/t251 t326 = f6561512/t264 - t329 = (t318*t319-f94*t321+t243*t275-t280*t239+t326 & + t329 = (t318*t319 - f94*t321 + t243*t275 - t280*t239 + t326 & *t198)*alpha8 t330 = t192**2 t332 = 0.1e1_dp/t9/t313 t333 = t330*t332 - t335 = t84+t95+t150+t174*t128+t186*t190-t150*t195+ & - t197*(t198+t202)+t213*t214+t219*t153+t237*t190+ & - t246*t247+t270*t271+t285*t286+t310*t316+t329*t333 + t335 = t84 + t95 + t150 + t174*t128 + t186*t190 - t150*t195 + & + t197*(t198 + t202) + t213*t214 + t219*t153 + t237*t190 + & + t246*t247 + t270*t271 + t285*t286 + t310*t316 + t329*t333 t336 = t335*Clda - e_0 = e_0+(-t80*t336)*sx + e_0 = e_0 + (-t80*t336)*sx END IF IF (order >= 1 .OR. order == -1) THEN t338 = t44*t13 @@ -1772,8 +1772,8 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t363 = t29*t31 t364 = t363*t6 t368 = t27*t46*t31 - t371 = -0.2e1_dp/0.3e1_dp*t353*t354-(2._dp*t17*t358)-0.4e1_dp & - /0.3e1_dp*t362*t364-(4._dp*t25*t368) + t371 = -0.2e1_dp/0.3e1_dp*t353*t354 - (2._dp*t17*t358) - 0.4e1_dp & + /0.3e1_dp*t362*t364 - (4._dp*t25*t368) t372 = t371*t68 t373 = t15*t372 t374 = t11*t373 @@ -1788,13 +1788,13 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t390 = 0.1e1_dp/t28/t12 t392 = t44*t390*t48 t398 = t60/t61/rho*t63 - t401 = -0.4e1_dp/0.3e1_dp*t378*t364-(4._dp*t36*t368)-0.5e1_dp & - /0.3e1_dp*t384*t386-(5._dp*t42*t392)-(8._dp*t55*t398) + t401 = -0.4e1_dp/0.3e1_dp*t378*t364 - (4._dp*t36*t368) - 0.5e1_dp & + /0.3e1_dp*t384*t386 - (5._dp*t42*t392) - (8._dp*t55*t398) t402 = t377*t401 t403 = t340*t402 t404 = t375*t403 t406 = t44*r3*t5 - t409 = -t345-t351+t374-t404-0.2e1_dp/0.3e1_dp*t73*t406 + t409 = -t345 - t351 + t374 - t404 - 0.2e1_dp/0.3e1_dp*t73*t406 dQrho = f94*t409*t77 t411 = ndrho*t3 t412 = t411*t10 @@ -1803,7 +1803,7 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t419 = t1*ndrho t420 = a2*t419 t421 = t420*t24 - t424 = 2._dp*t416*t19+4._dp*t421*t32 + t424 = 2._dp*t416*t19 + 4._dp*t421*t32 t425 = t424*t68 t426 = t15*t425 t428 = a3*t419 @@ -1811,15 +1811,15 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t432 = a4*t21 t433 = t432*t41 t437 = a5*t38*t54 - t440 = 4._dp*t429*t32+5._dp*t433*t49+6._dp*t437*t65 + t440 = 4._dp*t429*t32 + 5._dp*t433*t49 + 6._dp*t437*t65 t441 = t377*t440 t442 = t340*t441 - t444 = 2._dp*t412*t70+t11*t426-t375*t442 + t444 = 2._dp*t412*t70 + t11*t426 - t375*t442 dQndrho = f94*t444*t77 t446 = t78*f89 t449 = t60*t347 t452 = C*t149 - t453 = -t345-t351+t374-t404 + t453 = -t345 - t351 + t374 - t404 t454 = t452*t453 t457 = t329*t330 t461 = t56*r3*t58*t5*t346 @@ -1829,13 +1829,13 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t469 = t468*t6 t472 = t348*t87 t475 = F2*t371 - t478 = t475*t68-t85*t402 + t478 = t475*t68 - t85*t402 t479 = t15*t478 - t481 = -0.2e1_dp/0.3e1_dp*t339*t469-(2._dp*t11*t472)+(t11 & - *t479) + t481 = -0.2e1_dp/0.3e1_dp*t339*t469 - (2._dp*t11*t472) + (t11 & + *t479) t486 = t82*t453 - t493 = t97*(t99*t481*t82+t99*t90*t453+2._dp*t102*t486 & - +3._dp*t104*t92*t453) + t493 = t97*(t99*t481*t82 + t99*t90*t453 + 2._dp*t102*t486 & + + 3._dp*t104*t92*t453) t495 = t92**2 t498 = t109/t110/t495 t499 = t498*t453 @@ -1853,8 +1853,8 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t517 = t77*r3*t5 t518 = t515*t517 t522 = t119*t348*t77 - t525 = t504*t121-t508*t511-0.2e1_dp/0.3e1_dp*t514*t518-(2._dp & - *t118*t522) + t525 = t504*t121 - t508*t511 - 0.2e1_dp/0.3e1_dp*t514*t518 - (2._dp & + *t118*t522) t529 = rootpi t530 = 0.1e1_dp/t529 t531 = t123*t530 @@ -1872,25 +1872,25 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t552 = t372*t77 t553 = t34*t377 t554 = t77*t401 - t556 = t552-t553*t554 + t556 = t552 - t553*t554 t557 = t551*t556 t558 = t540*t557 - t562 = t537*(-t539*t540*t542/0.3e1_dp-t127*t128*t13*t133 & - +t550*t558/0.2e1_dp) + t562 = t537*(-t539*t540*t542/0.3e1_dp - t127*t128*t13*t133 & + + t550*t558/0.2e1_dp) t563 = t531*t562 - t567 = (t493*t113-0.7e1_dp/0.2e1_dp*t108*t499-(t502*t525 & - *t123*t136)+(2._dp*t502*t563))*t140 + t567 = (t493*t113 - 0.7e1_dp/0.2e1_dp*t108*t499 - (t502*t525 & + *t123*t136) + (2._dp*t502*t563))*t140 t569 = t141*t142 t571 = t110*t92*t144 t572 = t571*t453 - t575 = -t567*t145-0.7e1_dp/0.2e1_dp*t569*t572 + t575 = -t567*t145 - 0.7e1_dp/0.2e1_dp*t569*t572 t576 = t575*E t577 = t576*t149 t578 = t189*t13 t581 = 0.1e1_dp/t158/t157 t582 = t149*t581 t583 = t148*t582 - t587 = -t345-t351+t374-t404-0.2e1_dp/0.3e1_dp*t72*t44*t6 + t587 = -t345 - t351 + t374 - t404 - 0.2e1_dp/0.3e1_dp*t72*t44*t6 t588 = t156*t587 t589 = t271*t588 t592 = t219*t72 @@ -1899,8 +1899,8 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t602 = 0.1e1_dp/t227/t75 t603 = f98*t602 t608 = dexerrho(Q, dQrho) - t613 = (t97*(-0.3e1_dp/0.2e1_dp*t221*t597*t409+t603*t409/ & - 0.2e1_dp)+f2716*t608*t233)*alpha3*t185 + t613 = (t97*(-0.3e1_dp/0.2e1_dp*t221*t597*t409 + t603*t409/ & + 0.2e1_dp) + f2716*t608*t233)*alpha3*t185 t617 = f12*t481 t620 = 0.1e1_dp/t495 t621 = t620*t453 @@ -1913,39 +1913,39 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t639 = f916*t638 t644 = 0.1e1_dp/t258/t257 t645 = t644*t256 - t653 = (t97*(-t243*t634/0.2e1_dp+0.3e1_dp/0.2e1_dp*t639*t250* & - t409-0.5e1_dp/0.2e1_dp*t255*t645*t409)-t267*t608)*alpha5 - t655 = -(2._dp*t285*t449)-(2._dp*t91*t454)-0.8e1_dp/0.3e1_dp & - *t457*t465+t577-t186*t578+0.5e1_dp/0.2e1_dp*t583*t589 & - -0.2e1_dp/0.3e1_dp*t592*t406+t613*t190-t81*t93*t453+ & - t617*t94-t237*t578-(3._dp*t148*t621)-t624*t626/0.3e1_dp & - -0.4e1_dp/0.3e1_dp*t629*t631+t653*t271 + t653 = (t97*(-t243*t634/0.2e1_dp + 0.3e1_dp/0.2e1_dp*t639*t250* & + t409 - 0.5e1_dp/0.2e1_dp*t255*t645*t409) - t267*t608)*alpha5 + t655 = -(2._dp*t285*t449) - (2._dp*t91*t454) - 0.8e1_dp/0.3e1_dp & + *t457*t465 + t577 - t186*t578 + 0.5e1_dp/0.2e1_dp*t583*t589 & + - 0.2e1_dp/0.3e1_dp*t592*t406 + t613*t190 - t81*t93*t453 + & + t617*t94 - t237*t578 - (3._dp*t148*t621) - t624*t626/0.3e1_dp & + - 0.4e1_dp/0.3e1_dp*t629*t631 + t653*t271 t656 = t149*t159 t657 = t148*t656 t658 = t193*t332 t659 = t658*t6 t663 = t273*t409 t666 = dexeirho(Q, dQrho) - t669 = (t276*t409-2._dp*t197*t663+t243*t666)*alpha4 + t669 = (t276*t409 - 2._dp*t197*t663 + t243*t666)*alpha4 t673 = t97/t205/t199 - t679 = (-t197*t673*t409/0.2e1_dp-t209*t608)*alpha1 + t679 = (-t197*t673*t409/0.2e1_dp - t209*t608)*alpha1 t681 = t241*t409 - t685 = (-t197*t681-f98*t666)*alpha2 + t685 = (-t197*t681 - f98*t666)*alpha2 t689 = 0.1e1_dp/t290/t289 t690 = t256*t222 t691 = t689*t690 t697 = f2732/t295/t294 t698 = t293*t409 t701 = t638*t250 - t711 = (t97*(-0.7e1_dp/0.2e1_dp*t288*t691*t409+0.5e1_dp/0.2e1_dp & - *t697*t698-0.3e1_dp/0.2e1_dp*t298*t701*t409+t280*t634/ & - 0.2e1_dp)+t307*t608)*alpha7 + t711 = (t97*(-0.7e1_dp/0.2e1_dp*t288*t691*t409 + 0.5e1_dp/0.2e1_dp & + *t697*t698 - 0.3e1_dp/0.2e1_dp*t298*t701*t409 + t280*t634/ & + 0.2e1_dp) + t307*t608)*alpha7 t713 = 0.1e1_dp/t257 t717 = 0.1e1_dp/t293 t718 = f94*t717 t721 = t321*t409 - t728 = (-4._dp*t318*t713*t409+3._dp*t718*t409-2._dp*t243*t721 & - +t280*t275*t409+t326*t666)*alpha8 + t728 = (-4._dp*t318*t713*t409 + 3._dp*t718*t409 - 2._dp*t243*t721 & + + t280*t275*t409 + t326*t666)*alpha8 t735 = t176*t147 t736 = t656*t453 t739 = t93*t581 @@ -1957,14 +1957,14 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t753 = t93*t752 t754 = t155*t587 t755 = t753*t754 - t759 = (-t176*t575*t93*t159+(2._dp*t735*t736)+0.5e1_dp/ & - 0.2e1_dp*(t735)*(t740)-t180*t481*t93*t170+(2._dp & - *t746*t748)+0.3e1_dp/0.2e1_dp*(t746)*(t755))*t185 + t759 = (-t176*t575*t93*t159 + (2._dp*t735*t736) + 0.5e1_dp/ & + 0.2e1_dp*(t735)*(t740) - t180*t481*t93*t170 + (2._dp & + *t746*t748) + 0.3e1_dp/0.2e1_dp*(t746)*(t755))*t185 t761 = t310*t311 t763 = 0.1e1_dp/t8/t461 t765 = t763*r3*t5 t769 = t75*t241 - t771 = t409*t200-t769*t409 + t771 = t409*t200 - t769*t409 t772 = t771*t239 t779 = t151*t147 t780 = t93*t159 @@ -1979,9 +1979,9 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t801 = t800*t453 t803 = t83*t752 t804 = t803*t754 - t808 = (-t151*t575*t83*t159+t779*t781+0.5e1_dp/0.2e1_dp*t779 & - *t784+t81*t787*t453+t81*t792*t587/0.2e1_dp-t166 & - *t481*t83*t170+t799*t801+0.3e1_dp/0.2e1_dp*t799*t804)* & + t808 = (-t151*t575*t83*t159 + t779*t781 + 0.5e1_dp/0.2e1_dp*t779 & + *t784 + t81*t787*t453 + t81*t792*t587/0.2e1_dp - t166 & + *t481*t83*t170 + t799*t801 + 0.3e1_dp/0.2e1_dp*t799*t804)* & omega t810 = t148*t620 t812 = t194*t44*t453 @@ -1991,23 +1991,23 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t820 = A*t319 t823 = f98*t321 t826 = r1*t275 - t832 = (-3._dp*t820*t409+2._dp*t823*t409-t243*t826*t409-t280 & + t832 = (-3._dp*t820*t409 + 2._dp*t823*t409 - t243*t826*t409 - t280 & *t666)*alpha6*t284 - t834 = 0.5e1_dp/0.3e1_dp*t657*t659+t669*t247+t679*t214+t685 & - *t153-t577*t195+t711*t316+t728*t333-t174*t626 & - /0.3e1_dp+t759*t190-0.7e1_dp/0.3e1_dp*t761*t765+t197*(t666 & - +t772*t199)+t808*t128+(3._dp*t810*t812)-0.5e1_dp/0.3e1_dp & - *t815*t817+t832*t286 - t836 = (t655+t834)*Clda - e_rho = e_rho+(-0.4e1_dp/0.3e1_dp*t446*t336-t80*t836)*sx + t834 = 0.5e1_dp/0.3e1_dp*t657*t659 + t669*t247 + t679*t214 + t685 & + *t153 - t577*t195 + t711*t316 + t728*t333 - t174*t626 & + /0.3e1_dp + t759*t190 - 0.7e1_dp/0.3e1_dp*t761*t765 + t197*(t666 & + + t772*t199) + t808*t128 + (3._dp*t810*t812) - 0.5e1_dp/0.3e1_dp & + *t815*t817 + t832*t286 + t836 = (t655 + t834)*Clda + e_rho = e_rho + (-0.4e1_dp/0.3e1_dp*t446*t336 - t80*t836)*sx t842 = F2*t424 - t845 = t842*t68-t85*t441 + t845 = t842*t68 - t85*t441 t846 = t15*t845 - t848 = 2._dp*t412*t88+t11*t846 + t848 = 2._dp*t412*t88 + t11*t846 t849 = f12*t848 t851 = t452*t444 - t865 = t97*(t99*t848*t82+t99*t90*t444+2._dp*t102*t82 & - *t444+3._dp*t104*t92*t444) + t865 = t97*(t99*t848*t82 + t99*t90*t444 + 2._dp*t102*t82 & + *t444 + 3._dp*t104*t92*t444) t867 = t498*t444 t870 = f94*t424 t871 = t870*t117 @@ -2015,20 +2015,20 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t874 = t18*t873 t876 = t68*ndrho t877 = t116*t876 - t880 = t871*t121-t508*t874+2._dp*t877*t121 + t880 = t871*t121 - t508*t874 + 2._dp*t877*t121 t884 = f32*t126 t885 = t884*t128 t888 = t425*t77 t889 = t77*t440 - t891 = t888-t553*t889 + t891 = t888 - t553*t889 t892 = t551*t891 t893 = t540*t892 - t897 = t537*(t885*t540*t132+t550*t893/0.2e1_dp) + t897 = t537*(t885*t540*t132 + t550*t893/0.2e1_dp) t898 = t531*t897 - t902 = (t865*t113-0.7e1_dp/0.2e1_dp*t108*t867-(t502*t880 & - *t123*t136)+(2._dp*t502*t898))*t140 + t902 = (t865*t113 - 0.7e1_dp/0.2e1_dp*t108*t867 - (t502*t880 & + *t123*t136) + (2._dp*t502*t898))*t140 t904 = t571*t444 - t907 = -t902*t145-0.7e1_dp/0.2e1_dp*t569*t904 + t907 = -t902*t145 - 0.7e1_dp/0.2e1_dp*t569*t904 t908 = t907*E t909 = t908*t149 t910 = t620*t444 @@ -2038,46 +2038,46 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t930 = t800*t444 t932 = t155*t444 t933 = t803*t932 - t937 = (-t151*t907*t83*t159+t779*t916+0.5e1_dp/0.2e1_dp*t779 & - *t919+t81*t787*t444+t81*t792*t444/0.2e1_dp-t166 & - *t848*t83*t170+t799*t930+0.3e1_dp/0.2e1_dp*t799*t933)* & + t937 = (-t151*t907*t83*t159 + t779*t916 + 0.5e1_dp/0.2e1_dp*t779 & + *t919 + t81*t787*t444 + t81*t792*t444/0.2e1_dp - t166 & + *t848*t83*t170 + t799*t930 + 0.3e1_dp/0.2e1_dp*t799*t933)* & omega t942 = t656*t444 t945 = t739*t918 t951 = t747*t444 t954 = t753*t932 - t958 = (-t176*t907*t93*t159+(2._dp*t735*t942)+0.5e1_dp/ & - 0.2e1_dp*(t735)*(t945)-t180*t848*t93*t170+(2._dp & - *t746*t951)+0.3e1_dp/0.2e1_dp*(t746)*(t954))*t185 + t958 = (-t176*t907*t93*t159 + (2._dp*t735*t942) + 0.5e1_dp/ & + 0.2e1_dp*(t735)*(t945) - t180*t848*t93*t170 + (2._dp & + *t746*t951) + 0.3e1_dp/0.2e1_dp*(t746)*(t954))*t185 t962 = t194*t44*t444 t965 = t271*t918 t968 = dexeindrho(Q, dQndrho) - t971 = t444*t200-t769*t444 + t971 = t444*t200 - t769*t444 t972 = t971*t239 t979 = dexerndrho(Q, dQndrho) - t982 = (-t197*t673*t444/0.2e1_dp-t209*t979)*alpha1 - t988 = (-t197*t241*t444-f98*t968)*alpha2 - t1001 = (t97*(-0.3e1_dp/0.2e1_dp*t221*t597*t444+t603*t444/ & - 0.2e1_dp)+f2716*t979*t233)*alpha3*t185 - t1009 = (t276*t444-2._dp*t197*t273*t444+t243*t968)*alpha4 + t982 = (-t197*t673*t444/0.2e1_dp - t209*t979)*alpha1 + t988 = (-t197*t241*t444 - f98*t968)*alpha2 + t1001 = (t97*(-0.3e1_dp/0.2e1_dp*t221*t597*t444 + t603*t444/ & + 0.2e1_dp) + f2716*t979*t233)*alpha3*t185 + t1009 = (t276*t444 - 2._dp*t197*t273*t444 + t243*t968)*alpha4 t1011 = t602*t444 - t1024 = (t97*(-t243*t1011/0.2e1_dp+0.3e1_dp/0.2e1_dp*t639*t250 & - *t444-0.5e1_dp/0.2e1_dp*t255*t645*t444)-t267*t979)*alpha5 - t1035 = (-3._dp*t820*t444+2._dp*t823*t444-t243*t826*t444- & + t1024 = (t97*(-t243*t1011/0.2e1_dp + 0.3e1_dp/0.2e1_dp*t639*t250 & + *t444 - 0.5e1_dp/0.2e1_dp*t255*t645*t444) - t267*t979)*alpha5 + t1035 = (-3._dp*t820*t444 + 2._dp*t823*t444 - t243*t826*t444 - & t280*t968)*alpha6*t284 - t1052 = (t97*(-0.7e1_dp/0.2e1_dp*t288*t691*t444+0.5e1_dp/0.2e1_dp & - *t697*t293*t444-0.3e1_dp/0.2e1_dp*t298*t701*t444+t280 & - *t1011/0.2e1_dp)+t307*t979)*alpha7 - t1066 = (-4._dp*t318*t713*t444+3._dp*t718*t444-2._dp*t243*t321 & - *t444+t280*t275*t444+t326*t968)*alpha8 - t1068 = -t81*t93*t444+t849*t94-(2._dp*t91*t851)+t909 & - -(3._dp*t148*t910)+t937*t128+t958*t190-t909*t195 & - +(3._dp*t810*t962)+0.5e1_dp/0.2e1_dp*t583*t965+t197*(t968 & - +t972*t199)+t982*t214+t988*t153+t1001*t190+t1009 & - *t247+t1024*t271+t1035*t286+t1052*t316+t1066* & + t1052 = (t97*(-0.7e1_dp/0.2e1_dp*t288*t691*t444 + 0.5e1_dp/0.2e1_dp & + *t697*t293*t444 - 0.3e1_dp/0.2e1_dp*t298*t701*t444 + t280 & + *t1011/0.2e1_dp) + t307*t979)*alpha7 + t1066 = (-4._dp*t318*t713*t444 + 3._dp*t718*t444 - 2._dp*t243*t321 & + *t444 + t280*t275*t444 + t326*t968)*alpha8 + t1068 = -t81*t93*t444 + t849*t94 - (2._dp*t91*t851) + t909 & + - (3._dp*t148*t910) + t937*t128 + t958*t190 - t909*t195 & + + (3._dp*t810*t962) + 0.5e1_dp/0.2e1_dp*t583*t965 + t197*(t968 & + + t972*t199) + t982*t214 + t988*t153 + t1001*t190 + t1009 & + *t247 + t1024*t271 + t1035*t286 + t1052*t316 + t1066* & t333 t1069 = t1068*Clda - e_ndrho = e_ndrho+(-t80*t1069)*sx + e_ndrho = e_ndrho + (-t80*t1069)*sx END IF IF (order >= 2 .OR. order == -2) THEN t1071 = t332*t13 @@ -2100,10 +2100,10 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1115 = t363*t312 t1119 = t46*t31*t6 t1123 = t27*t390*t31 - t1126 = 0.10e2_dp/0.9e1_dp*t16*t3*t332*t15*t312+0.8e1_dp/0.3e1_dp & - *t353*t348*t6+(6._dp*t17*t10*t29*t14)+0.28e2_dp/ & - 0.9e1_dp*t22*t1113*t1115+0.32e2_dp/0.3e1_dp*t362*t1119+(20._dp & - *t25*t1123) + t1126 = 0.10e2_dp/0.9e1_dp*t16*t3*t332*t15*t312 + 0.8e1_dp/0.3e1_dp & + *t353*t348*t6 + (6._dp*t17*t10*t29*t14) + 0.28e2_dp/ & + 0.9e1_dp*t22*t1113*t1115 + 0.32e2_dp/0.3e1_dp*t362*t1119 + (20._dp & + *t25*t1123) t1127 = t1126*t68 t1129 = t11*t15*t1127 t1132 = 2._dp*t375*t1082*t402 @@ -2111,81 +2111,81 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1135 = t401**2 t1136 = t1134*t1135 t1139 = 2._dp*t375*t340*t1136 - t1168 = 0.28e2_dp/0.9e1_dp*t35*t1113*t1115+0.32e2_dp/0.3e1_dp*t378 & - *t1119+(20._dp*t36*t1123)+0.40e2_dp/0.9e1_dp*t39*t41* & - t463*t385*t312+0.50e2_dp/0.3e1_dp*t384*t390*t48*t6+0.30e2_dp & - *t42*t44/t28/t346*t48+(72._dp*t55*t60/t61/t12 & - *t63) + t1168 = 0.28e2_dp/0.9e1_dp*t35*t1113*t1115 + 0.32e2_dp/0.3e1_dp*t378 & + *t1119 + (20._dp*t36*t1123) + 0.40e2_dp/0.9e1_dp*t39*t41* & + t463*t385*t312 + 0.50e2_dp/0.3e1_dp*t384*t390*t48*t6 + 0.30e2_dp & + *t42*t44/t28/t346*t48 + (72._dp*t55*t60/t61/t12 & + *t63) t1169 = t377*t1168 t1171 = t375*t340*t1169 t1173 = t332*t56*t58 - t1176 = t1077+t1081-t1085+t1090+t1094-t1097+t1100+t1129 & - -t1132+t1139-t1171+0.10e2_dp/0.9e1_dp*t73*t1173 + t1176 = t1077 + t1081 - t1085 + t1090 + t1094 - t1097 + t1100 + t1129 & + - t1132 + t1139 - t1171 + 0.10e2_dp/0.9e1_dp*t73*t1173 d2Qrhorho = f94*t1176*t77 t1178 = t411*t338 t1181 = t14*t424 t1185 = t6*t440 - t1208 = -0.4e1_dp/0.3e1_dp*t415*t352*t354-(4._dp*t416*t358) & - -0.16e2_dp/0.3e1_dp*t420*t361*t364-(16._dp*t421*t368) + t1208 = -0.4e1_dp/0.3e1_dp*t415*t352*t354 - (4._dp*t416*t358) & + - 0.16e2_dp/0.3e1_dp*t420*t361*t364 - (16._dp*t421*t368) t1209 = t1208*t68 t1214 = t411*t18 t1220 = t1134*t401*t440 - t1236 = -0.16e2_dp/0.3e1_dp*t428*t361*t364-(16._dp*t429*t368) & - -0.25e2_dp/0.3e1_dp*t432*t383*t386-(25._dp*t433*t392) & - -(48._dp*t437*t398) + t1236 = -0.16e2_dp/0.3e1_dp*t428*t361*t364 - (16._dp*t429*t368) & + - 0.25e2_dp/0.3e1_dp*t432*t383*t386 - (25._dp*t433*t392) & + - (48._dp*t437*t398) t1237 = t377*t1236 - t1240 = -0.4e1_dp/0.3e1_dp*t1178*t343-0.2e1_dp/0.3e1_dp*t339*t1181 & - *t342+0.2e1_dp/0.3e1_dp*t1086*t553*t1185-(4._dp*t412* & - t349)-(2._dp*t11*t348*t425)+(2._dp*t1098*t442)+(2._dp & - *t412*t373)+(t11*t15*t1209)-t375*t1082*t441 & - -(2._dp*t1214*t403)-t375*t1181*t402+0.2e1_dp*t375*t340 & - *t1220-t375*t340*t1237 + t1240 = -0.4e1_dp/0.3e1_dp*t1178*t343 - 0.2e1_dp/0.3e1_dp*t339*t1181 & + *t342 + 0.2e1_dp/0.3e1_dp*t1086*t553*t1185 - (4._dp*t412* & + t349) - (2._dp*t11*t348*t425) + (2._dp*t1098*t442) + (2._dp & + *t412*t373) + (t11*t15*t1209) - t375*t1082*t441 & + - (2._dp*t1214*t403) - t375*t1181*t402 + 0.2e1_dp*t375*t340 & + *t1220 - t375*t340*t1237 d2Qrhondrho = f94*t1240*t77 t1242 = t119*t13 t1243 = t340*t68 - t1257 = 2._dp*a1*t3*t19+12._dp*a2*t1*t24*t32 + t1257 = 2._dp*a1*t3*t19 + 12._dp*a2*t1*t24*t32 t1258 = t1257*t68 t1264 = t440**2 t1265 = t1134*t1264 - t1281 = 12._dp*a3*t1*t24*t32+20._dp*a4*t419*t41*t49+30._dp & + t1281 = 12._dp*a3*t1*t24*t32 + 20._dp*a4*t419*t41*t49 + 30._dp & *a5*t21*t54*t65 t1282 = t377*t1281 - t1285 = 2._dp*t1242*t1243+4._dp*t412*t426-4._dp*t1214*t442+t11 & - *t15*t1258-2._dp*t375*t1181*t441+2._dp*t375*t340*t1265 & - -t375*t340*t1282 + t1285 = 2._dp*t1242*t1243 + 4._dp*t412*t426 - 4._dp*t1214*t442 + t11 & + *t15*t1258 - 2._dp*t375*t1181*t441 + 2._dp*t375*t340*t1265 & + - t375*t340*t1282 d2Qndrhondrho = f94*t1285*t77 t1287 = t78**2 t1294 = t166*t481 t1297 = t453**2 - t1301 = t1077+t1081-t1085+t1090+t1094-t1097+t1100+t1129 & - -t1132+t1139-t1171 + t1301 = t1077 + t1081 - t1085 + t1090 + t1094 - t1097 + t1100 + t1129 & + - t1132 + t1139 - t1171 t1304 = t166*t181 t1305 = t752*t453 t1306 = t1305*t754 t1309 = t587**2 t1310 = t154*t1309 - t1317 = t1077+t1081-t1085+t1090+t1094-t1097+t1100+t1129 & - -t1132+t1139-t1171+0.10e2_dp/0.9e1_dp*t72*t332*t312 + t1317 = t1077 + t1081 - t1085 + t1090 + t1094 - t1097 + t1100 + t1129 & + - t1132 + t1139 - t1171 + 0.10e2_dp/0.9e1_dp*t72*t332*t312 t1318 = t155*t1317 t1324 = 0.1e1_dp/t169/t156/t155 t1325 = t83*t1324 t1326 = t156*t1309 - t1355 = 0.10e2_dp/0.9e1_dp*t1072*t468*t312+0.8e1_dp/0.3e1_dp*t1079 & - *t469-0.4e1_dp/0.3e1_dp*t339*t14*t478*t6+(6._dp*t11* & - t1091*t87)-0.4e1_dp*(t11)*t348*t478+(t11*t15* & - (F2*t1126*t68-2._dp*t475*t402+2._dp*t85*t1136-t85*t1169)) + t1355 = 0.10e2_dp/0.9e1_dp*t1072*t468*t312 + 0.8e1_dp/0.3e1_dp*t1079 & + *t469 - 0.4e1_dp/0.3e1_dp*t339*t14*t478*t6 + (6._dp*t11* & + t1091*t87) - 0.4e1_dp*(t11)*t348*t478 + (t11*t15* & + (F2*t1126*t68 - 2._dp*t475*t402 + 2._dp*t85*t1136 - t85*t1169)) t1379 = t495*t82 t1381 = 0.1e1_dp/t110/t1379 t1382 = t109*t1381 t1392 = t503*t507 t1402 = t116*t1134*t1*t3 t1409 = t116*t377*t4*t44 - t1433 = f94*t1126*t117*t121-(2._dp*t1392*t511)-0.4e1_dp & - /0.3e1_dp*t503*t513*t518-(4._dp*t504*t522)+(2._dp*t1402 & - *t18*t509*t1135)+0.4e1_dp/0.3e1_dp*t1409*t120*t1087+ & - (4._dp*t508*t357*t510)-(t508*t18*t509*t1168)+ & - 0.10e2_dp/0.9e1_dp*t514*t1071*t14*t77*t56*t58+0.8e1_dp/0.3e1_dp & - *t514*t1078*t14*t517+0.6e1_dp*t118*t119*t1091*t77 + t1433 = f94*t1126*t117*t121 - (2._dp*t1392*t511) - 0.4e1_dp & + /0.3e1_dp*t503*t513*t518 - (4._dp*t504*t522) + (2._dp*t1402 & + *t18*t509*t1135) + 0.4e1_dp/0.3e1_dp*t1409*t120*t1087 + & + (4._dp*t508*t357*t510) - (t508*t18*t509*t1168) + & + 0.10e2_dp/0.9e1_dp*t514*t1071*t14*t77*t56*t58 + 0.8e1_dp/0.3e1_dp & + *t514*t1078*t14*t517 + 0.6e1_dp*t118*t119*t1091*t77 t1437 = t525**2 t1442 = t96*t115*t525 t1445 = t96*t124 @@ -2200,30 +2200,30 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1501 = t34*t1134 t1520 = t567*t142 t1524 = t110*t82*t144 - t1531 = -((t97*(t99*t1355*t82+2._dp*t99*t481*t453+t99 & - *t90*t1301+2._dp*t102*t1297+2._dp*t102*t82*t1301+6._dp* & - t104*t82*t1297+3._dp*t104*t92*t1301)*t113)-(7._dp*t493 & - *t499)+0.63e2_dp/0.4e1_dp*(t108)*(t1382)*(t1297) & - -0.7e1_dp/0.2e1_dp*(t108)*(t498)*(t1301)-t502 & - *t1433*t123*t136-t502*t1437*t123*t136+(4._dp*t1442 & - *t563)+0.2e1_dp*t1445*t530*(0.2e1_dp/0.3e1_dp*t533*t352* & - t13*t1243*t517+(2._dp*t534*t348*t131)-(t534*t15 & - *t552)+t1456*t340*t1457*t401)*t562+0.2e1_dp*t502* & + t1531 = -((t97*(t99*t1355*t82 + 2._dp*t99*t481*t453 + t99 & + *t90*t1301 + 2._dp*t102*t1297 + 2._dp*t102*t82*t1301 + 6._dp* & + t104*t82*t1297 + 3._dp*t104*t92*t1301)*t113) - (7._dp*t493 & + *t499) + 0.63e2_dp/0.4e1_dp*(t108)*(t1382)*(t1297) & + - 0.7e1_dp/0.2e1_dp*(t108)*(t498)*(t1301) - t502 & + *t1433*t123*t136 - t502*t1437*t123*t136 + (4._dp*t1442 & + *t563) + 0.2e1_dp*t1445*t530*(0.2e1_dp/0.3e1_dp*t533*t352* & + t13*t1243*t517 + (2._dp*t534*t348*t131) - (t534*t15 & + *t552) + t1456*t340*t1457*t401)*t562 + 0.2e1_dp*t502* & t531*t537*(0.4e1_dp/0.9e1_dp*t125*t126*t315*t540*t132* & - t56*t58+0.2e1_dp/0.3e1_dp*t539*t1473*t542-t1478*t1479* & - t6*t556/0.3e1_dp+(2._dp*t127*t128*t347*t133)-t550*t1473 & - *t557-t550*t540*t1491*t1492/0.4e1_dp+t550*t540* & - t551*(t1127*t77-2._dp*t1498*t554+2._dp*t1501*t77*t1135 & - -t553*t77*t1168)/0.2e1_dp))*t140*t145-(7._dp*t1520 & - *t572)-0.35e2_dp/0.4e1_dp*(t569)*(t1524)*(t1297) & - -0.7e1_dp/0.2e1_dp*(t569)*(t571)*(t1301) + t56*t58 + 0.2e1_dp/0.3e1_dp*t539*t1473*t542 - t1478*t1479* & + t6*t556/0.3e1_dp + (2._dp*t127*t128*t347*t133) - t550*t1473 & + *t557 - t550*t540*t1491*t1492/0.4e1_dp + t550*t540* & + t551*(t1127*t77 - 2._dp*t1498*t554 + 2._dp*t1501*t77*t1135 & + - t553*t77*t1168)/0.2e1_dp))*t140*t145 - (7._dp*t1520 & + *t572) - 0.35e2_dp/0.4e1_dp*(t569)*(t1524)*(t1297) & + - 0.7e1_dp/0.2e1_dp*(t569)*(t571)*(t1301) t1535 = t151*t575 - t1543 = (3._dp*t1294*t804)-(2._dp*t799*t747*t1297)+(t799 & - *t800*t1301)-(3._dp*t1304*t1306)+(3._dp*t799 & - *t803*t1310)+0.3e1_dp/0.2e1_dp*(t799)*(t803)*(t1318) & - -0.27e2_dp/0.4e1_dp*(t799)*(t1325)*(t1326)- & - t151*t1531*t83*t159+(2._dp*t1535*t781)+(5._dp*t1535 & - *t784)-(2._dp*t779*t656*t1297) + t1543 = (3._dp*t1294*t804) - (2._dp*t799*t747*t1297) + (t799 & + *t800*t1301) - (3._dp*t1304*t1306) + (3._dp*t799 & + *t803*t1310) + 0.3e1_dp/0.2e1_dp*(t799)*(t803)*(t1318) & + - 0.27e2_dp/0.4e1_dp*(t799)*(t1325)*(t1326) - & + t151*t1531*t83*t159 + (2._dp*t1535*t781) + (5._dp*t1535 & + *t784) - (2._dp*t779*t656*t1297) t1546 = t151*t177 t1547 = t581*t453 t1548 = t1547*t588 @@ -2238,12 +2238,12 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1573 = t791*t453 t1579 = 0.1e1_dp/t162/t155 t1580 = t83*t1579 - t1592 = t779*t780*(t1301)-(5._dp*t1546*t1548)+0.5e1_dp & - /0.2e1_dp*t779*t783*t1551+0.10e2_dp*t779*t783*t1555-0.75e2_dp & - /0.4e1_dp*t779*t1563*t1564-(2._dp*t81*t1568*t1297) & - -t1572*t1573*t587+(t81*t787*t1301)-0.3e1_dp/0.4e1_dp & - *(t81)*(t1580)*(t1309)+(t81*t792*t1317) & - /0.2e1_dp-t166*t1355*t83*t170+(2._dp*t1294*t801) + t1592 = t779*t780*(t1301) - (5._dp*t1546*t1548) + 0.5e1_dp & + /0.2e1_dp*t779*t783*t1551 + 0.10e2_dp*t779*t783*t1555 - 0.75e2_dp & + /0.4e1_dp*t779*t1563*t1564 - (2._dp*t81*t1568*t1297) & + - t1572*t1573*t587 + (t81*t787*t1301) - 0.3e1_dp/0.4e1_dp & + *(t81)*(t1580)*(t1309) + (t81*t792*t1317) & + /0.2e1_dp - t166*t1355*t83*t170 + (2._dp*t1294*t801) t1599 = t576*t582 t1602 = 0.1e1_dp/t1379 t1609 = t315*t56*t58 @@ -2253,16 +2253,16 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1633 = f94/t294 t1649 = d2exeirhorho(Q, dQrho, d2Qrhorho) t1658 = t148*t620*t581 - t1663 = (t1543+t1592)*omega*t128+(10._dp*t583*t271*t1555) & - +(5._dp*t1599*t589)+(12._dp*t148*t1602*t1297)- & - (2._dp*t613*t578)+0.4e1_dp/0.9e1_dp*t624*t1609-0.8e1_dp/0.3e1_dp & - *t669*t192*t631+(2._dp*t186*t1615)+0.10e2_dp/0.3e1_dp & - *t576*t656*t659+0.5e1_dp/0.2e1_dp*(t583)*(t271)*(t1551) & - +((20._dp*t318*t1624*t1625-4._dp*t318*t713*t1176 & - -12._dp*t1633*t1625+3._dp*t718*t1176+6._dp*t243*t717*t1625 & - -2._dp*t243*t321*t1176-2._dp*t280*t321*t1625+t280* & - t275*t1176+t326*t1649)*alpha8*t333)-(3._dp*t148*t620 & - *t1301)-(15._dp*t1658*t271*t588*t453) + t1663 = (t1543 + t1592)*omega*t128 + (10._dp*t583*t271*t1555) & + + (5._dp*t1599*t589) + (12._dp*t148*t1602*t1297) - & + (2._dp*t613*t578) + 0.4e1_dp/0.9e1_dp*t624*t1609 - 0.8e1_dp/0.3e1_dp & + *t669*t192*t631 + (2._dp*t186*t1615) + 0.10e2_dp/0.3e1_dp & + *t576*t656*t659 + 0.5e1_dp/0.2e1_dp*(t583)*(t271)*(t1551) & + + ((20._dp*t318*t1624*t1625 - 4._dp*t318*t713*t1176 & + - 12._dp*t1633*t1625 + 3._dp*t718*t1176 + 6._dp*t243*t717*t1625 & + - 2._dp*t243*t321*t1176 - 2._dp*t280*t321*t1625 + t280* & + t275*t1176 + t326*t1649)*alpha8*t333) - (3._dp*t148*t620 & + *t1301) - (15._dp*t1658*t271*t588*t453) t1677 = t256**2 t1680 = 0.1e1_dp/t290/t1677/t690 t1681 = t1677*t256 @@ -2276,12 +2276,12 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1722 = 0.1e1_dp/t227/t250 t1723 = t1722*t1625 t1726 = t602*t1176 - t1729 = 0.147e3_dp/0.4e1_dp*t288*t1682*t1625-0.21e2_dp*t288*t1686 & - *t1625-0.7e1_dp/0.2e1_dp*t288*t691*t1176-0.75e2_dp/0.4e1_dp & - *t1697*t1693*t1625+0.10e2_dp*t697*t251*t1625+0.5e1_dp/ & - 0.2e1_dp*t697*t293*t1176+0.27e2_dp/0.4e1_dp*t298*t1710*t1625 & - -0.3e1_dp*t298*t1714*t1625-0.3e1_dp/0.2e1_dp*t298*t701*t1176 & - -0.3e1_dp/0.4e1_dp*t280*t1723+t280*t1726/0.2e1_dp + t1729 = 0.147e3_dp/0.4e1_dp*t288*t1682*t1625 - 0.21e2_dp*t288*t1686 & + *t1625 - 0.7e1_dp/0.2e1_dp*t288*t691*t1176 - 0.75e2_dp/0.4e1_dp & + *t1697*t1693*t1625 + 0.10e2_dp*t697*t251*t1625 + 0.5e1_dp/ & + 0.2e1_dp*t697*t293*t1176 + 0.27e2_dp/0.4e1_dp*t298*t1710*t1625 & + - 0.3e1_dp*t298*t1714*t1625 - 0.3e1_dp/0.2e1_dp*t298*t701*t1176 & + - 0.3e1_dp/0.4e1_dp*t280*t1723 + t280*t1726/0.2e1_dp t1731 = d2exerrhorho(Q, dQrho, d2Qrhorho) t1740 = t148*t1602 t1767 = t56**2 @@ -2290,18 +2290,18 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1781 = A*t713 t1786 = f98*t717 t1791 = r1*t321 - t1802 = ((-2._dp*t823*t1625+t276*t1176+6._dp*t197*t319* & - t1625-2._dp*t197*t273*t1176+t243*t1649)*alpha4*t247)+ & - (t97*t1729+t307*t1731)*alpha7*t316-0.40e2_dp/0.9e1_dp*t657 & - *t193*t463*t312-(12._dp*t1740*t194*t44*t1297)+ & - (6._dp*t285*t60*t29)+((2._dp*t197*t273*t1625-t197 & - *t241*t1176-f98*t1649)*alpha2*t153)-(4._dp*t832* & - t449)-(2._dp*t759*t578)+(2._dp*t237*t1615)-(6._dp* & - t576*t621)+f12*t1355*t94+0.70e2_dp/0.9e1_dp*t761/t8/t1770 & - *t56*t58+0.40e2_dp/0.9e1_dp*t815*t463*t56*t58+((12._dp & - *t1781*t1625-3._dp*t820*t1176-6._dp*t1786*t1625+2._dp*t823 & - *t1176+2._dp*t243*t1791*t1625-t243*t826*t1176-t280 & - *t1649)*alpha6*t284*t286) + t1802 = ((-2._dp*t823*t1625 + t276*t1176 + 6._dp*t197*t319* & + t1625 - 2._dp*t197*t273*t1176 + t243*t1649)*alpha4*t247) + & + (t97*t1729 + t307*t1731)*alpha7*t316 - 0.40e2_dp/0.9e1_dp*t657 & + *t193*t463*t312 - (12._dp*t1740*t194*t44*t1297) + & + (6._dp*t285*t60*t29) + ((2._dp*t197*t273*t1625 - t197 & + *t241*t1176 - f98*t1649)*alpha2*t153) - (4._dp*t832* & + t449) - (2._dp*t759*t578) + (2._dp*t237*t1615) - (6._dp* & + t576*t621) + f12*t1355*t94 + 0.70e2_dp/0.9e1_dp*t761/t8/t1770 & + *t56*t58 + 0.40e2_dp/0.9e1_dp*t815*t463*t56*t58 + ((12._dp & + *t1781*t1625 - 3._dp*t820*t1176 - 6._dp*t1786*t1625 + 2._dp*t823 & + *t1176 + 2._dp*t243*t1791*t1625 - t243*t826*t1176 - t280 & + *t1649)*alpha6*t284*t286) t1804 = t620*t159 t1805 = t148*t1804 t1816 = t576*t620 @@ -2316,20 +2316,20 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1880 = 0.1e1_dp/t258/t1677/t222 t1881 = t1880*t1677 t1885 = t644*t223 - t1898 = -(10._dp*t1805*t658*t6*t453)-0.14e2_dp/0.3e1_dp*t711 & - *t311*t765-0.16e2_dp/0.3e1_dp*t728*t330*t465+(6._dp*t1816 & - *t812)+(2._dp*t81*t149*t1297)+0.28e2_dp/0.9e1_dp*t629 & - *t763*t56*t58-0.25e2_dp/0.3e1_dp*t1827*t332*t156*t587 & - *r3*t5-0.75e2_dp/0.4e1_dp*t1835*t271*t1564+(6._dp*t91 & - *t1839*t1297)+(t197*(t1649+(t1176*t200-2._dp*t1625 & - *t241+2._dp*t1846*t1625-t769*t1176)*t239*t199-t1853* & - t1854+t772*t409))-t1860*t195-(t81*t93*t1301)+ & - (t97*(0.3e1_dp/0.4e1_dp*t243*t1723-t243*t1726/0.2e1_dp-0.27e2_dp & - /0.4e1_dp*(t1868)*(t293)*(t1625)+(3._dp*t639 & - *t75*t1625)+0.3e1_dp/0.2e1_dp*(t639)*(t250)*(t1176) & - +0.75e2_dp/0.4e1_dp*(t255)*(t1881)*(t1625)- & - (10._dp*t255*t1885*t1625)-0.5e1_dp/0.2e1_dp*(t255)*(t645) & - *(t1176))-t267*t1731)*alpha5*t271 + t1898 = -(10._dp*t1805*t658*t6*t453) - 0.14e2_dp/0.3e1_dp*t711 & + *t311*t765 - 0.16e2_dp/0.3e1_dp*t728*t330*t465 + (6._dp*t1816 & + *t812) + (2._dp*t81*t149*t1297) + 0.28e2_dp/0.9e1_dp*t629 & + *t763*t56*t58 - 0.25e2_dp/0.3e1_dp*t1827*t332*t156*t587 & + *r3*t5 - 0.75e2_dp/0.4e1_dp*t1835*t271*t1564 + (6._dp*t91 & + *t1839*t1297) + (t197*(t1649 + (t1176*t200 - 2._dp*t1625 & + *t241 + 2._dp*t1846*t1625 - t769*t1176)*t239*t199 - t1853* & + t1854 + t772*t409)) - t1860*t195 - (t81*t93*t1301) + & + (t97*(0.3e1_dp/0.4e1_dp*t243*t1723 - t243*t1726/0.2e1_dp - 0.27e2_dp & + /0.4e1_dp*(t1868)*(t293)*(t1625) + (3._dp*t639 & + *t75*t1625) + 0.3e1_dp/0.2e1_dp*(t639)*(t250)*(t1176) & + + 0.75e2_dp/0.4e1_dp*(t255)*(t1881)*(t1625) - & + (10._dp*t255*t1885*t1625) - 0.5e1_dp/0.2e1_dp*(t255)*(t645) & + *(t1176)) - t267*t1731)*alpha5*t271 t1906 = 0.1e1_dp/t205/t222 t1907 = t97*t1906 t1923 = t176*t575 @@ -2339,83 +2339,83 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1956 = t620*t170 t1961 = t180*t90*t149 t1967 = t93*t1324 - t1977 = -t176*t1531*t93*t159+(4._dp*t1923*t736)+(5._dp & - *t1923*t740)-(6._dp*t735*t1804*t1297)-(10._dp*t1932 & - *t1548)+(2._dp*t735*t656*t1301)-0.75e2_dp/0.4e1_dp*(t735) & - *(t1938)*(t1564)+(10._dp*t735*t739*t1555) & - +0.5e1_dp/0.2e1_dp*(t735)*(t739)*(t1551)-t180 & - *t1355*t93*t170+(4._dp*t1951*t748)+(3._dp*t1951*t755) & - -(6._dp*t746*t1956*t1297)-(6._dp*t1961*t1306)+ & - (2._dp*t746*t747*t1301)-0.27e2_dp/0.4e1_dp*(t746)*(t1967) & - *(t1326)+(3._dp*t746*t753*t1310)+0.3e1_dp/0.2e1_dp & + t1977 = -t176*t1531*t93*t159 + (4._dp*t1923*t736) + (5._dp & + *t1923*t740) - (6._dp*t735*t1804*t1297) - (10._dp*t1932 & + *t1548) + (2._dp*t735*t656*t1301) - 0.75e2_dp/0.4e1_dp*(t735) & + *(t1938)*(t1564) + (10._dp*t735*t739*t1555) & + + 0.5e1_dp/0.2e1_dp*(t735)*(t739)*(t1551) - t180 & + *t1355*t93*t170 + (4._dp*t1951*t748) + (3._dp*t1951*t755) & + - (6._dp*t746*t1956*t1297) - (6._dp*t1961*t1306) + & + (2._dp*t746*t747*t1301) - 0.27e2_dp/0.4e1_dp*(t746)*(t1967) & + *(t1326) + (3._dp*t746*t753*t1310) + 0.3e1_dp/0.2e1_dp & *(t746)*(t753)*(t1318) t1983 = 0.1e1_dp/t224/t690 t1984 = t1983*t256 t1988 = t596*t199 t1995 = f98*t1722 - t2028 = -0.4e1_dp/0.3e1_dp*t685*t72*t406-0.2e1_dp/0.3e1_dp*t679* & - omega*t626+(0.3e1_dp/0.4e1_dp*t197*t1907*t1625-t197*t673 & - *t1176/0.2e1_dp-t209*t1731)*alpha1*t214+0.4e1_dp/0.9e1_dp & - *t174*t1609+t1977*t185*t190+0.10e2_dp/0.9e1_dp*t592*t1173 & - +(t97*(0.27e2_dp/0.4e1_dp*t221*t1984*t1625-0.3e1_dp*t221 & - *t1988*t1625-0.3e1_dp/0.2e1_dp*t221*t597*t1176-0.3e1_dp/0.4e1_dp & - *t1995*t1625+t603*t1176/0.2e1_dp)+f2716*t1731*t233) & - *alpha3*t185*t190+(3._dp*t810*t194*t44*t1301)-(2._dp & - *t91*t452*t1301)-0.2e1_dp/0.3e1_dp*t808*t626-0.10e2_dp & - /0.3e1_dp*t653*t193*t817+t1860-(4._dp*t617*t454)+0.88e2_dp & + t2028 = -0.4e1_dp/0.3e1_dp*t685*t72*t406 - 0.2e1_dp/0.3e1_dp*t679* & + omega*t626 + (0.3e1_dp/0.4e1_dp*t197*t1907*t1625 - t197*t673 & + *t1176/0.2e1_dp - t209*t1731)*alpha1*t214 + 0.4e1_dp/0.9e1_dp & + *t174*t1609 + t1977*t185*t190 + 0.10e2_dp/0.9e1_dp*t592*t1173 & + + (t97*(0.27e2_dp/0.4e1_dp*t221*t1984*t1625 - 0.3e1_dp*t221 & + *t1988*t1625 - 0.3e1_dp/0.2e1_dp*t221*t597*t1176 - 0.3e1_dp/0.4e1_dp & + *t1995*t1625 + t603*t1176/0.2e1_dp) + f2716*t1731*t233) & + *alpha3*t185*t190 + (3._dp*t810*t194*t44*t1301) - (2._dp & + *t91*t452*t1301) - 0.2e1_dp/0.3e1_dp*t808*t626 - 0.10e2_dp & + /0.3e1_dp*t653*t193*t817 + t1860 - (4._dp*t617*t454) + 0.88e2_dp & /0.9e1_dp*t457/t9/t1770*t56*t58 - e_rho_rho = e_rho_rho-0.4e1_dp/0.9e1_dp/t1287*f89*t336-0.8e1_dp/0.3e1_dp*t446* & - t836-t80*(t1663+t1802+t1898+t2028)*Clda + e_rho_rho = e_rho_rho - 0.4e1_dp/0.9e1_dp/t1287*f89*t336 - 0.8e1_dp/0.3e1_dp*t446* & + t836 - t80*(t1663 + t1802 + t1898 + t2028)*Clda t2059 = t156*t1240 t2072 = t587*t444 t2073 = t581*t156*t2072 - t2099 = -0.4e1_dp/0.3e1_dp*t1178*t469-0.2e1_dp/0.3e1_dp*t339*t14 & - *t845*t6-(4._dp*t412*t472)-0.2e1_dp*t11*t348*t845+ & - (2._dp*t412*t479)+t11*t15*(F2*t1208*t68-t475* & - t441-t842*t402+2._dp*t85*t1220-t85*t1237) + t2099 = -0.4e1_dp/0.3e1_dp*t1178*t469 - 0.2e1_dp/0.3e1_dp*t339*t14 & + *t845*t6 - (4._dp*t412*t472) - 0.2e1_dp*t11*t348*t845 + & + (2._dp*t412*t479) + t11*t15*(F2*t1208*t68 - t475* & + t441 - t842*t402 + 2._dp*t85*t1220 - t85*t1237) t2108 = t444*t453 t2142 = t870*t507 t2144 = t554*t440 t2150 = t116*t377*ndrho*t3 - t2173 = (f94*t1208*t117*t121)-t1392*t874+(2._dp*t503 & - *t876*t121)-(t2142*t511)+(2._dp*t1402*t19*t2144) & - -(2._dp*t2150*t511)-(t508*t18*t509*t1236)- & - 0.2e1_dp/0.3e1_dp*t870*t513*t518+0.2e1_dp/0.3e1_dp*t1409*t120 & - *t1185-0.4e1_dp/0.3e1_dp*t116*(t876)*t3*t518-(2._dp & - *t871*t522)+(2._dp*t508*t357*t873)-(4._dp*t877*t522) + t2173 = (f94*t1208*t117*t121) - t1392*t874 + (2._dp*t503 & + *t876*t121) - (t2142*t511) + (2._dp*t1402*t19*t2144) & + - (2._dp*t2150*t511) - (t508*t18*t509*t1236) - & + 0.2e1_dp/0.3e1_dp*t870*t513*t518 + 0.2e1_dp/0.3e1_dp*t1409*t120 & + *t1185 - 0.4e1_dp/0.3e1_dp*t116*(t876)*t3*t518 - (2._dp & + *t871*t522) + (2._dp*t508*t357*t873) - (4._dp*t877*t522) t2184 = t96*t115*t880 - t2197 = t530*(-2._dp*t532*ndrho*t119*t535-t534*t15*t888 & - +t1456*t340*t1457*t440) + t2197 = t530*(-2._dp*t532*ndrho*t119*t535 - t534*t15*t888 & + + t1456*t340*t1457*t440) t2224 = t424*t377 - t2240 = (t97*(t99*t2099*t82+t99*t481*t444+t99*t848 & - *t453+t99*t90*t1240+2._dp*t102*t2108+2._dp*t102*t82 & - *t1240+6._dp*t104*t486*t444+3._dp*t104*t92*t1240)*t113) & - -0.7e1_dp/0.2e1_dp*t493*t867-0.7e1_dp/0.2e1_dp*t865*t499+0.63e2_dp & + t2240 = (t97*(t99*t2099*t82 + t99*t481*t444 + t99*t848 & + *t453 + t99*t90*t1240 + 2._dp*t102*t2108 + 2._dp*t102*t82 & + *t1240 + 6._dp*t104*t486*t444 + 3._dp*t104*t92*t1240)*t113) & + - 0.7e1_dp/0.2e1_dp*t493*t867 - 0.7e1_dp/0.2e1_dp*t865*t499 + 0.63e2_dp & /0.4e1_dp*(t108)*(t109)*(t1381)*(t453) & - *(t444)-0.7e1_dp/0.2e1_dp*(t108)*(t498)*(t1240) & - -t502*t2173*t123*t136-t502*t525*t880*t123*t136 & - +(2._dp*t1442*t898)+(2._dp*t2184*t563)+(2._dp*t1445 & - *t2197*t562)+0.2e1_dp*t502*t531*t537*(-t884*t27*t129 & - *t133*t6/0.3e1_dp-t1478*t1479*t6*t891/0.6e1_dp-t885 & - *t1473*t132-t550*t1473*t892/0.2e1_dp+t885*t558/0.2e1_dp & - -t550*t540*t1491*t556*t891/0.4e1_dp+t550*t540*t551 & - *(t1209*t77-t1498*t889-t2224*t554+2._dp*t1501*t2144 & - -t553*t77*t1236)/0.2e1_dp) + *(t444) - 0.7e1_dp/0.2e1_dp*(t108)*(t498)*(t1240) & + - t502*t2173*t123*t136 - t502*t525*t880*t123*t136 & + + (2._dp*t1442*t898) + (2._dp*t2184*t563) + (2._dp*t1445 & + *t2197*t562) + 0.2e1_dp*t502*t531*t537*(-t884*t27*t129 & + *t133*t6/0.3e1_dp - t1478*t1479*t6*t891/0.6e1_dp - t885 & + *t1473*t132 - t550*t1473*t892/0.2e1_dp + t885*t558/0.2e1_dp & + - t550*t540*t1491*t556*t891/0.4e1_dp + t550*t540*t551 & + *(t1209*t77 - t1498*t889 - t2224*t554 + 2._dp*t1501*t2144 & + - t553*t77*t1236)/0.2e1_dp) t2245 = t902*t142 - t2254 = -t2240*t140*t145-0.7e1_dp/0.2e1_dp*t1520*t904-0.7e1_dp & - /0.2e1_dp*t2245*t572-0.35e2_dp/0.4e1_dp*t569*t1524*t2108- & + t2254 = -t2240*t140*t145 - 0.7e1_dp/0.2e1_dp*t1520*t904 - 0.7e1_dp & + /0.2e1_dp*t2245*t572 - 0.35e2_dp/0.4e1_dp*t569*t1524*t2108 - & 0.7e1_dp/0.2e1_dp*t569*t571*t1240 t2258 = t1547*t918 t2267 = t151*t907 t2269 = t166*t167 t2271 = t752*t154*t2072 - t2274 = t81*t792*t1240/0.2e1_dp-t1572*t1573*t444/0.2e1_dp+ & - t81*t787*t1240+0.5e1_dp/0.2e1_dp*t779*t783*t2059-0.2e1_dp & - *t81*t149*t163*t453*t444+t1294*t930+0.5e1_dp/0.2e1_dp* & - t1535*t919-0.5e1_dp/0.2e1_dp*t1546*t2073-t151*t2254*t83 & - *t159-0.5e1_dp/0.2e1_dp*t1546*t2258+t1535*t916-0.2e1_dp*t779 & - *t656*t2108+t779*t780*t1240+t2267*t781+(3._dp* & - t2269*t2271) + t2274 = t81*t792*t1240/0.2e1_dp - t1572*t1573*t444/0.2e1_dp + & + t81*t787*t1240 + 0.5e1_dp/0.2e1_dp*t779*t783*t2059 - 0.2e1_dp & + *t81*t149*t163*t453*t444 + t1294*t930 + 0.5e1_dp/0.2e1_dp* & + t1535*t919 - 0.5e1_dp/0.2e1_dp*t1546*t2073 - t151*t2254*t83 & + *t159 - 0.5e1_dp/0.2e1_dp*t1546*t2258 + t1535*t916 - 0.2e1_dp*t779 & + *t656*t2108 + t779*t780*t1240 + t2267*t781 + (3._dp* & + t2269*t2271) t2280 = t151*t152 t2282 = t1562*t1559*t2072 t2285 = t166*t848 @@ -2424,192 +2424,192 @@ SUBROUTINE xwpbe_lda_calc_1(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t2305 = t581*t168*t2072 t2311 = t155*t1240 t2316 = t1324*t156*t2072 - t2323 = -(2._dp*t799*t747*t2108)+(t799*t800*t1240) & - -0.75e2_dp/0.4e1_dp*t2280*t2282+0.3e1_dp/0.2e1_dp*t2285*t804+ & - 0.5e1_dp/0.2e1_dp*t2267*t784-0.3e1_dp/0.2e1_dp*t1304*t2291-t166 & - *t2099*t83*t170-0.3e1_dp/0.2e1_dp*t1304*t2297-t1572*t791 & - *t587*t444/0.2e1_dp+0.10e2_dp*t2280*t2305+0.3e1_dp/0.2e1_dp & - *t1294*t933+t2285*t801+0.3e1_dp/0.2e1_dp*(t799)*(t803) & - *(t2311)-0.27e2_dp/0.4e1_dp*t2269*t2316-0.3e1_dp/0.4e1_dp & + t2323 = -(2._dp*t799*t747*t2108) + (t799*t800*t1240) & + - 0.75e2_dp/0.4e1_dp*t2280*t2282 + 0.3e1_dp/0.2e1_dp*t2285*t804 + & + 0.5e1_dp/0.2e1_dp*t2267*t784 - 0.3e1_dp/0.2e1_dp*t1304*t2291 - t166 & + *t2099*t83*t170 - 0.3e1_dp/0.2e1_dp*t1304*t2297 - t1572*t791 & + *t587*t444/0.2e1_dp + 0.10e2_dp*t2280*t2305 + 0.3e1_dp/0.2e1_dp & + *t1294*t933 + t2285*t801 + 0.3e1_dp/0.2e1_dp*(t799)*(t803) & + *(t2311) - 0.27e2_dp/0.4e1_dp*t2269*t2316 - 0.3e1_dp/0.4e1_dp & *t84*t1579*t587*t444 t2329 = t908*t582 t2348 = t176*t907 t2363 = t176*t177 - t2371 = -t176*t2254*t93*t159+(2._dp*t1923*t942)+0.5e1_dp & - /0.2e1_dp*(t1923)*(t945)+(2._dp*t2348*t736)-(6._dp & - *t735*t1804*t2108)-(5._dp*t1932*t2258)+(2._dp*t735 & - *t656*t1240)+0.5e1_dp/0.2e1_dp*(t2348)*(t740)-(5._dp & - *t1932*t2073)-0.75e2_dp/0.4e1_dp*t2363*t2282+0.10e2_dp* & - t2363*t2305+0.5e1_dp/0.2e1_dp*(t735)*(t739)*(t2059) + t2371 = -t176*t2254*t93*t159 + (2._dp*t1923*t942) + 0.5e1_dp & + /0.2e1_dp*(t1923)*(t945) + (2._dp*t2348*t736) - (6._dp & + *t735*t1804*t2108) - (5._dp*t1932*t2258) + (2._dp*t735 & + *t656*t1240) + 0.5e1_dp/0.2e1_dp*(t2348)*(t740) - (5._dp & + *t1932*t2073) - 0.75e2_dp/0.4e1_dp*t2363*t2282 + 0.10e2_dp* & + t2363*t2305 + 0.5e1_dp/0.2e1_dp*(t735)*(t739)*(t2059) t2379 = t180*t848 - t2401 = -t180*t2099*t93*t170+(2._dp*t1951*t951)+0.3e1_dp & - /0.2e1_dp*(t1951)*(t954)+(2._dp*t2379*t748)-(6._dp & - *t746*t1956*t2108)-(3._dp*t1961*t2297)+(2._dp*t746 & - *t747*t1240)+0.3e1_dp/0.2e1_dp*(t2379)*(t755)-(3._dp & - *t1961*t2291)-0.27e2_dp/0.4e1_dp*t95*t2316+0.3e1_dp*t95 & - *t2271+0.3e1_dp/0.2e1_dp*(t746)*(t753)*(t2311) - t2405 = -0.25e2_dp/0.6e1_dp*t1827*t816*t5*t156*t444+0.12e2_dp & - *t148*t1602*t453*t444-0.5e1_dp*t1805*t658*t6*t444+ & - 0.6e1_dp*t746*t621*t444+(t2274+t2323)*omega*t128-(2._dp & - *t1035*t449)+0.5e1_dp/0.2e1_dp*t2329*t589+0.5e1_dp/0.2e1_dp & - *t1599*t965-t81*t93*t1240-0.7e1_dp/0.3e1_dp*t1052*t311 & - *t765-t937*t626/0.3e1_dp+(t2371+t2401)*t185*t190 + t2401 = -t180*t2099*t93*t170 + (2._dp*t1951*t951) + 0.3e1_dp & + /0.2e1_dp*(t1951)*(t954) + (2._dp*t2379*t748) - (6._dp & + *t746*t1956*t2108) - (3._dp*t1961*t2297) + (2._dp*t746 & + *t747*t1240) + 0.3e1_dp/0.2e1_dp*(t2379)*(t755) - (3._dp & + *t1961*t2291) - 0.27e2_dp/0.4e1_dp*t95*t2316 + 0.3e1_dp*t95 & + *t2271 + 0.3e1_dp/0.2e1_dp*(t746)*(t753)*(t2311) + t2405 = -0.25e2_dp/0.6e1_dp*t1827*t816*t5*t156*t444 + 0.12e2_dp & + *t148*t1602*t453*t444 - 0.5e1_dp*t1805*t658*t6*t444 + & + 0.6e1_dp*t746*t621*t444 + (t2274 + t2323)*omega*t128 - (2._dp & + *t1035*t449) + 0.5e1_dp/0.2e1_dp*t2329*t589 + 0.5e1_dp/0.2e1_dp & + *t1599*t965 - t81*t93*t1240 - 0.7e1_dp/0.3e1_dp*t1052*t311 & + *t765 - t937*t626/0.3e1_dp + (t2371 + t2401)*t185*t190 t2410 = t2254*E*t149 t2437 = t698*t444 t2442 = t75*t409*t444 t2449 = t1722*t409*t444 t2452 = t602*t1240 - t2455 = 0.147e3_dp/0.4e1_dp*t288*t1680*t1681*t409*t444-0.21e2_dp & - *t288*t689*t257*t409*t444-0.7e1_dp/0.2e1_dp*t288*t691 & - *t1240-0.75e2_dp/0.4e1_dp*t1697*t1693*t409*t444+0.10e2_dp & - *t697*t251*t409*t444+0.5e1_dp/0.2e1_dp*t697*t293*t1240 & - +0.27e2_dp/0.4e1_dp*t298*t1709*t2437-0.3e1_dp*t298*t638*t2442 & - -0.3e1_dp/0.2e1_dp*t298*t701*t1240-0.3e1_dp/0.4e1_dp*t280* & - t2449+t280*t2452/0.2e1_dp + t2455 = 0.147e3_dp/0.4e1_dp*t288*t1680*t1681*t409*t444 - 0.21e2_dp & + *t288*t689*t257*t409*t444 - 0.7e1_dp/0.2e1_dp*t288*t691 & + *t1240 - 0.75e2_dp/0.4e1_dp*t1697*t1693*t409*t444 + 0.10e2_dp & + *t697*t251*t409*t444 + 0.5e1_dp/0.2e1_dp*t697*t293*t1240 & + + 0.27e2_dp/0.4e1_dp*t298*t1709*t2437 - 0.3e1_dp*t298*t638*t2442 & + - 0.3e1_dp/0.2e1_dp*t298*t701*t1240 - 0.3e1_dp/0.4e1_dp*t280* & + t2449 + t280*t2452/0.2e1_dp t2457 = d2exerrhondrho(Q, dQrho, dQndrho, d2Qrhondrho) t2473 = t409*t444 t2484 = d2exeirhondrho(Q, dQrho, dQndrho, d2Qrhondrho) - t2499 = -(3._dp*t908*t621)-t1001*t578-t2410*t195+t2410 & - +(t97*t2455+t307*t2457)*alpha7*t316+0.5e1_dp/0.2e1_dp* & - t583*t271*t2059-0.12e2_dp*t148*t1602*t159*t271*t2108 & - -t982*omega*t626/0.3e1_dp+((-2._dp*t823*t2473+t276* & - t1240+6._dp*t197*t319*t409*t444-2._dp*t197*t273*t1240+ & - t243*t2484)*alpha4*t247)-0.15e2_dp/0.2e1_dp*t1658*t271*t588 & - *(t444)-0.4e1_dp/0.3e1_dp*t1009*t192*t631-0.3e1_dp*t148 & + t2499 = -(3._dp*t908*t621) - t1001*t578 - t2410*t195 + t2410 & + + (t97*t2455 + t307*t2457)*alpha7*t316 + 0.5e1_dp/0.2e1_dp* & + t583*t271*t2059 - 0.12e2_dp*t148*t1602*t159*t271*t2108 & + - t982*omega*t626/0.3e1_dp + ((-2._dp*t823*t2473 + t276* & + t1240 + 6._dp*t197*t319*t409*t444 - 2._dp*t197*t273*t1240 + & + t243*t2484)*alpha4*t247) - 0.15e2_dp/0.2e1_dp*t1658*t271*t588 & + *(t444) - 0.4e1_dp/0.3e1_dp*t1009*t192*t631 - 0.3e1_dp*t148 & *t620*(t1240) t2512 = t199*t444 t2529 = t721*t444 t2543 = t908*t620 - t2573 = (3._dp*t1816*t962)+(t197*(t2484+(t1240*t200 & - -2._dp*t681*t444+2._dp*t1846*t2473-t769*t1240)*t239*t199 & - -t1853*t2512+t772*t444))-0.5e1_dp/0.3e1_dp*t1024*t193 & - *t817+((12._dp*t1781*t2473-3._dp*t820*t1240-6._dp*t1786* & - t2473+2._dp*t823*t1240+2._dp*t243*r1*t2529-t243*t826* & - t1240-t280*t2484)*alpha6*t284*t286)+(2._dp*t81*t149 & - *t453*t444)+(3._dp*t2543*t812)+f12*t2099*t94+(10._dp & - *t583*t271*t168*t587*t444)+((2._dp*t197*t663 & - *t444-t197*t241*t1240-f98*t2484)*alpha2*t153)-0.8e1_dp & - /0.3e1_dp*t1066*t330*t465-0.2e1_dp/0.3e1_dp*t988*t72*t406 & - -0.75e2_dp/0.4e1_dp*(t1835)*(t271)*(t1559)*(t587) & + t2573 = (3._dp*t1816*t962) + (t197*(t2484 + (t1240*t200 & + - 2._dp*t681*t444 + 2._dp*t1846*t2473 - t769*t1240)*t239*t199 & + - t1853*t2512 + t772*t444)) - 0.5e1_dp/0.3e1_dp*t1024*t193 & + *t817 + ((12._dp*t1781*t2473 - 3._dp*t820*t1240 - 6._dp*t1786* & + t2473 + 2._dp*t823*t1240 + 2._dp*t243*r1*t2529 - t243*t826* & + t1240 - t280*t2484)*alpha6*t284*t286) + (2._dp*t81*t149 & + *t453*t444) + (3._dp*t2543*t812) + f12*t2099*t94 + (10._dp & + *t583*t271*t168*t587*t444) + ((2._dp*t197*t663 & + *t444 - t197*t241*t1240 - f98*t2484)*alpha2*t153) - 0.8e1_dp & + /0.3e1_dp*t1066*t330*t465 - 0.2e1_dp/0.3e1_dp*t988*t72*t406 & + - 0.75e2_dp/0.4e1_dp*(t1835)*(t271)*(t1559)*(t587) & *(t444) - t2688 = -(2._dp*t91*t452*t1240)-(2._dp*t617*t851)+(t97 & - *(0.3e1_dp/0.4e1_dp*t243*t2449-t243*t2452/0.2e1_dp-0.27e2_dp & - /0.4e1_dp*t1868*t2437+(3._dp*t639*t2442)+0.3e1_dp/0.2e1_dp* & - (t639)*(t250)*(t1240)+0.75e2_dp/0.4e1_dp*t255*t1880 & - *t1677*t409*t444-0.10e2_dp*t255*t644*t223*t409* & - t444-0.5e1_dp/0.2e1_dp*t255*t645*(t1240))-t267*t2457) & - *alpha5*t271-(3._dp*t576*t910)-(2._dp*t849*t454)- & - t958*t578+(0.20e2_dp*t318*t1624*t409*t444-0.4e1_dp*t318 & - *t713*(t1240)-(12._dp*t1633*t2473)+(3._dp*t718* & - t1240)+0.6e1_dp*t243*t717*t409*t444-0.2e1_dp*t243*t321* & - (t1240)-(2._dp*t280*t2529)+(t280*t275*t1240) & - +t326*t2484)*alpha8*t333+(3._dp*t810*t194*t44*t1240) & - +(0.3e1_dp/0.4e1_dp*t197*t97*t1906*t409*t444-t197*t673 & - *(t1240)/0.2e1_dp-t209*t2457)*alpha1*t214+0.5e1_dp & - /0.3e1_dp*t908*t656*t659+(t97*(0.27e2_dp/0.4e1_dp*t221*t1983 & - *t256*t409*t444-0.3e1_dp*t221*t596*t1854*t444-0.3e1_dp & - /0.2e1_dp*t221*t597*(t1240)-0.3e1_dp/0.4e1_dp*(t1995) & - *(t2473)+(t603*t1240)/0.2e1_dp)+f2716*t2457*t233) & - *alpha3*t185*t190-0.15e2_dp/0.2e1_dp*t1658*t271*t453 & + t2688 = -(2._dp*t91*t452*t1240) - (2._dp*t617*t851) + (t97 & + *(0.3e1_dp/0.4e1_dp*t243*t2449 - t243*t2452/0.2e1_dp - 0.27e2_dp & + /0.4e1_dp*t1868*t2437 + (3._dp*t639*t2442) + 0.3e1_dp/0.2e1_dp* & + (t639)*(t250)*(t1240) + 0.75e2_dp/0.4e1_dp*t255*t1880 & + *t1677*t409*t444 - 0.10e2_dp*t255*t644*t223*t409* & + t444 - 0.5e1_dp/0.2e1_dp*t255*t645*(t1240)) - t267*t2457) & + *alpha5*t271 - (3._dp*t576*t910) - (2._dp*t849*t454) - & + t958*t578 + (0.20e2_dp*t318*t1624*t409*t444 - 0.4e1_dp*t318 & + *t713*(t1240) - (12._dp*t1633*t2473) + (3._dp*t718* & + t1240) + 0.6e1_dp*t243*t717*t409*t444 - 0.2e1_dp*t243*t321* & + (t1240) - (2._dp*t280*t2529) + (t280*t275*t1240) & + + t326*t2484)*alpha8*t333 + (3._dp*t810*t194*t44*t1240) & + + (0.3e1_dp/0.4e1_dp*t197*t97*t1906*t409*t444 - t197*t673 & + *(t1240)/0.2e1_dp - t209*t2457)*alpha1*t214 + 0.5e1_dp & + /0.3e1_dp*t908*t656*t659 + (t97*(0.27e2_dp/0.4e1_dp*t221*t1983 & + *t256*t409*t444 - 0.3e1_dp*t221*t596*t1854*t444 - 0.3e1_dp & + /0.2e1_dp*t221*t597*(t1240) - 0.3e1_dp/0.4e1_dp*(t1995) & + *(t2473) + (t603*t1240)/0.2e1_dp) + f2716*t2457*t233) & + *alpha3*t185*t190 - 0.15e2_dp/0.2e1_dp*t1658*t271*t453 & *t156*t444 - e_ndrho_rho = e_ndrho_rho-0.4e1_dp/0.3e1_dp*t446*t1069-t80*(t2405+t2499+t2573 & - +t2688)*Clda - t2707 = 2._dp*t119*t88+4._dp*t412*t846+t11*t15*(F2*t1257 & - *t68-2._dp*t842*t441+2._dp*t85*t1265-t85*t1282) + e_ndrho_rho = e_ndrho_rho - 0.4e1_dp/0.3e1_dp*t446*t1069 - t80*(t2405 + t2499 + t2573 & + + t2688)*Clda + t2707 = 2._dp*t119*t88 + 4._dp*t412*t846 + t11*t15*(F2*t1257 & + *t68 - 2._dp*t842*t441 + 2._dp*t85*t1265 - t85*t1282) t2715 = t444**2 t2764 = t880**2 t2774 = t891**2 - t2808 = -((t97*(t99*t2707*t82+2._dp*t99*t848*t444+t99 & - *t90*t1285+2._dp*t102*t2715+2._dp*t102*t82*t1285+6._dp* & - t104*t82*t2715+3._dp*t104*t92*t1285)*t113)-(7._dp*t865 & - *t867)+0.63e2_dp/0.4e1_dp*(t108)*(t1382)*(t2715) & - -0.7e1_dp/0.2e1_dp*(t108)*(t498)*(t1285)-(t502 & - *(f94*t1257*t117*t121-2._dp*t2142*t874+4._dp*t870* & - t876*t121+2._dp*t1402*t18*t509*t1264-4._dp*t2150*t874- & - t508*t18*t509*t1281+2._dp*t116*t68*t3*t18*t509)*t123 & - *t136)-(t502*t2764*t123*t136)+(4._dp*t2184* & - t898)+(2._dp*t1445*t2197*t897)+0.2e1_dp*(t502)*t531 & - *t537*(t885*t893-t550*t540*t1491*t2774/0.4e1_dp+t550 & - *t540*t551*(t1258*t77-2._dp*t2224*t889+2._dp*t1501 & - *t77*t1264-t553*t77*t1281)/0.2e1_dp))*t140*t145-(7._dp & - *t2245*t904)-0.35e2_dp/0.4e1_dp*(t569)*(t1524)*(t2715) & - -0.7e1_dp/0.2e1_dp*(t569)*(t571)*(t1285) + t2808 = -((t97*(t99*t2707*t82 + 2._dp*t99*t848*t444 + t99 & + *t90*t1285 + 2._dp*t102*t2715 + 2._dp*t102*t82*t1285 + 6._dp* & + t104*t82*t2715 + 3._dp*t104*t92*t1285)*t113) - (7._dp*t865 & + *t867) + 0.63e2_dp/0.4e1_dp*(t108)*(t1382)*(t2715) & + - 0.7e1_dp/0.2e1_dp*(t108)*(t498)*(t1285) - (t502 & + *(f94*t1257*t117*t121 - 2._dp*t2142*t874 + 4._dp*t870* & + t876*t121 + 2._dp*t1402*t18*t509*t1264 - 4._dp*t2150*t874 - & + t508*t18*t509*t1281 + 2._dp*t116*t68*t3*t18*t509)*t123 & + *t136) - (t502*t2764*t123*t136) + (4._dp*t2184* & + t898) + (2._dp*t1445*t2197*t897) + 0.2e1_dp*(t502)*t531 & + *t537*(t885*t893 - t550*t540*t1491*t2774/0.4e1_dp + t550 & + *t540*t551*(t1258*t77 - 2._dp*t2224*t889 + 2._dp*t1501 & + *t77*t1264 - t553*t77*t1281)/0.2e1_dp))*t140*t145 - (7._dp & + *t2245*t904) - 0.35e2_dp/0.4e1_dp*(t569)*(t1524)*(t2715) & + - 0.7e1_dp/0.2e1_dp*(t569)*(t571)*(t1285) t2810 = t2808*E*t149 t2838 = t1722*t2715 t2841 = t602*t1285 - t2844 = 0.147e3_dp/0.4e1_dp*t288*t1682*t2715-0.21e2_dp*t288*t1686 & - *t2715-0.7e1_dp/0.2e1_dp*t288*t691*t1285-0.75e2_dp/0.4e1_dp & - *t1697*t1693*t2715+0.10e2_dp*t697*t251*t2715+0.5e1_dp/ & - 0.2e1_dp*t697*t293*t1285+0.27e2_dp/0.4e1_dp*t298*t1710*t2715 & - -0.3e1_dp*t298*t1714*t2715-0.3e1_dp/0.2e1_dp*t298*t701*t1285 & - -0.3e1_dp/0.4e1_dp*t280*t2838+t280*t2841/0.2e1_dp + t2844 = 0.147e3_dp/0.4e1_dp*t288*t1682*t2715 - 0.21e2_dp*t288*t1686 & + *t2715 - 0.7e1_dp/0.2e1_dp*t288*t691*t1285 - 0.75e2_dp/0.4e1_dp & + *t1697*t1693*t2715 + 0.10e2_dp*t697*t251*t2715 + 0.5e1_dp/ & + 0.2e1_dp*t697*t293*t1285 + 0.27e2_dp/0.4e1_dp*t298*t1710*t2715 & + - 0.3e1_dp*t298*t1714*t2715 - 0.3e1_dp/0.2e1_dp*t298*t701*t1285 & + - 0.3e1_dp/0.4e1_dp*t280*t2838 + t280*t2841/0.2e1_dp t2846 = d2exerndrhondrho(Q, dQndrho, d2Qndrhondrho) t2875 = d2exeindrhondrho(Q, dQndrho, d2Qndrhondrho) t2880 = t2715*t156 t2884 = t1559*t2715 t2927 = t156*t1285 - t2963 = t2810+(t97*t2844+t307*t2846)*alpha7*t316+(3._dp & - *t810*t194*t44*t1285)-(6._dp*t908*t910)-(3._dp* & - t148*t620*t1285)+(0.3e1_dp/0.4e1_dp*t197*t1907*t2715-t197 & - *t673*(t1285)/0.2e1_dp-t209*t2846)*alpha1*t214+ & - (0.2e1_dp*t197*t273*t2715-t197*t241*(t1285)-f98*t2875) & - *alpha2*t153-(15._dp*t1658*t271*t2880)-0.75e2_dp/ & - 0.4e1_dp*(t1835)*(t271)*(t2884)+(0.20e2_dp*t318* & - t1624*t2715-0.4e1_dp*t318*t713*(t1285)-0.12e2_dp*t1633 & - *t2715+(3._dp*t718*t1285)+0.6e1_dp*t243*t717*t2715- & - 0.2e1_dp*t243*t321*(t1285)-0.2e1_dp*t280*t321*t2715+ & - t280*t275*(t1285)+t326*t2875)*alpha8*t333+t197 & - *(t2875+((t1285*t200)-0.2e1_dp*t2715*t241+0.2e1_dp*t1846 & - *t2715-(t769*t1285))*t239*t199-t971*t275*t2512 & - +t972*t444)+0.5e1_dp/0.2e1_dp*(t583)*(t271)*(t2927) & - +(t97*(0.3e1_dp/0.4e1_dp*t243*t2838-t243*t2841/0.2e1_dp & - -0.27e2_dp/0.4e1_dp*t1868*t293*t2715+0.3e1_dp*t639*t75 & - *t2715+0.3e1_dp/0.2e1_dp*t639*t250*(t1285)+0.75e2_dp/0.4e1_dp & - *t255*t1881*t2715-0.10e2_dp*t255*t1885*t2715-0.5e1_dp & - /0.2e1_dp*t255*t645*(t1285))-t267*t2846)*alpha5*(t271) & - +(5._dp*t2329*t965)-(t81*t93*t1285) + t2963 = t2810 + (t97*t2844 + t307*t2846)*alpha7*t316 + (3._dp & + *t810*t194*t44*t1285) - (6._dp*t908*t910) - (3._dp* & + t148*t620*t1285) + (0.3e1_dp/0.4e1_dp*t197*t1907*t2715 - t197 & + *t673*(t1285)/0.2e1_dp - t209*t2846)*alpha1*t214 + & + (0.2e1_dp*t197*t273*t2715 - t197*t241*(t1285) - f98*t2875) & + *alpha2*t153 - (15._dp*t1658*t271*t2880) - 0.75e2_dp/ & + 0.4e1_dp*(t1835)*(t271)*(t2884) + (0.20e2_dp*t318* & + t1624*t2715 - 0.4e1_dp*t318*t713*(t1285) - 0.12e2_dp*t1633 & + *t2715 + (3._dp*t718*t1285) + 0.6e1_dp*t243*t717*t2715 - & + 0.2e1_dp*t243*t321*(t1285) - 0.2e1_dp*t280*t321*t2715 + & + t280*t275*(t1285) + t326*t2875)*alpha8*t333 + t197 & + *(t2875 + ((t1285*t200) - 0.2e1_dp*t2715*t241 + 0.2e1_dp*t1846 & + *t2715 - (t769*t1285))*t239*t199 - t971*t275*t2512 & + + t972*t444) + 0.5e1_dp/0.2e1_dp*(t583)*(t271)*(t2927) & + + (t97*(0.3e1_dp/0.4e1_dp*t243*t2838 - t243*t2841/0.2e1_dp & + - 0.27e2_dp/0.4e1_dp*t1868*t293*t2715 + 0.3e1_dp*t639*t75 & + *t2715 + 0.3e1_dp/0.2e1_dp*t639*t250*(t1285) + 0.75e2_dp/0.4e1_dp & + *t255*t1881*t2715 - 0.10e2_dp*t255*t1885*t2715 - 0.5e1_dp & + /0.2e1_dp*t255*t645*(t1285)) - t267*t2846)*alpha5*(t271) & + + (5._dp*t2329*t965) - (t81*t93*t1285) t2971 = t2715*t155 t2975 = t154*t2715 t2979 = t155*t1285 t2994 = t168*t2715 - t3001 = -(2._dp*t799*t747*t2715)+(t799*t800*t1285) & - -(3._dp*t799*t753*t2971)+(3._dp*t799*t803*t2975)+ & - 0.3e1_dp/0.2e1_dp*(t799)*(t803)*(t2979)-0.27e2_dp/0.4e1_dp & - *(t799)*(t1325)*(t2880)-(2._dp*t779*t656 & - *t2715)+(t779*t780*t1285)-(5._dp*t779*t739*t2880) & - +(10._dp*t779*t783*t2994)+0.5e1_dp/0.2e1_dp*(t779) & + t3001 = -(2._dp*t799*t747*t2715) + (t799*t800*t1285) & + - (3._dp*t799*t753*t2971) + (3._dp*t799*t803*t2975) + & + 0.3e1_dp/0.2e1_dp*(t799)*(t803)*(t2979) - 0.27e2_dp/0.4e1_dp & + *(t799)*(t1325)*(t2880) - (2._dp*t779*t656 & + *t2715) + (t779*t780*t1285) - (5._dp*t779*t739*t2880) & + + (10._dp*t779*t783*t2994) + 0.5e1_dp/0.2e1_dp*(t779) & *(t783)*(t2927) - t3033 = -0.75e2_dp/0.4e1_dp*t779*t1563*t2884-(2._dp*t81*t1568 & - *t2715)-(t81*t93*t791*t2715)+(t81*t787*t1285) & - -0.3e1_dp/0.4e1_dp*(t81)*(t1580)*(t2715)+(t81 & - *t792*t1285)/0.2e1_dp-t166*t2707*t83*t170+(2._dp & - *t2285*t930)+(3._dp*t2285*t933)-t151*t2808*t83* & - t159+(2._dp*t2267*t916)+(5._dp*t2267*t919) - t3139 = -t176*t2808*t93*t159+(4._dp*t2348*t942)+(5._dp & - *t2348*t945)-(6._dp*t735*t1804*t2715)-(10._dp*t735 & - *t582*t2880)+(2._dp*t735*t656*t1285)-0.75e2_dp/0.4e1_dp & - *(t735)*(t1938)*(t2884)+(10._dp*t735*t739 & - *t2994)+0.5e1_dp/0.2e1_dp*(t735)*(t739)*(t2927)- & - t180*t2707*t93*t170+(4._dp*t2379*t951)+(3._dp*t2379 & - *t954)-(6._dp*t746*t1956*t2715)-(6._dp*t746*t149 & - *t752*t2971)+(2._dp*t746*t747*t1285)-0.27e2_dp/0.4e1_dp & - *(t746)*(t1967)*(t2880)+(3._dp*t746*t753* & - t2975)+0.3e1_dp/0.2e1_dp*(t746)*(t753)*(t2979) - t3167 = f12*t2707*t94+(t3001+t3033)*omega*t128+(2._dp & - *t81*t149*t2715)+(6._dp*t2543*t962)-t2810*t195+(10._dp & - *t583*t271*t2994)+(12._dp*t148*t1602*t2715)+ & - (t97*(0.27e2_dp/0.4e1_dp*(t221)*(t1984)*(t2715)- & - (3._dp*t221*t1988*t2715)-0.3e1_dp/0.2e1_dp*(t221)*(t597) & - *(t1285)-0.3e1_dp/0.4e1_dp*(t1995)*(t2715)+ & - (t603*t1285)/0.2e1_dp)+f2716*t2846*t233)*alpha3*t185 & - *t190+((-2._dp*t823*t2715+t276*t1285+6._dp*t197*t319 & - *t2715-2._dp*t197*t273*t1285+t243*t2875)*alpha4*t247) & - -(2._dp*t91*t452*t1285)-(4._dp*t849*t851)+t3139 & - *t185*t190+(6._dp*t91*t1839*t2715)+((12._dp*t1781 & - *t2715-3._dp*t820*t1285-6._dp*t1786*t2715+2._dp*t823*t1285 & - +2._dp*t243*t1791*t2715-t243*t826*t1285-t280*t2875)* & - alpha6*t284*t286)-(12._dp*t1740*t194*t44*t2715) - e_ndrho_ndrho = e_ndrho_ndrho-t80*(t2963+t3167)*Clda + t3033 = -0.75e2_dp/0.4e1_dp*t779*t1563*t2884 - (2._dp*t81*t1568 & + *t2715) - (t81*t93*t791*t2715) + (t81*t787*t1285) & + - 0.3e1_dp/0.4e1_dp*(t81)*(t1580)*(t2715) + (t81 & + *t792*t1285)/0.2e1_dp - t166*t2707*t83*t170 + (2._dp & + *t2285*t930) + (3._dp*t2285*t933) - t151*t2808*t83* & + t159 + (2._dp*t2267*t916) + (5._dp*t2267*t919) + t3139 = -t176*t2808*t93*t159 + (4._dp*t2348*t942) + (5._dp & + *t2348*t945) - (6._dp*t735*t1804*t2715) - (10._dp*t735 & + *t582*t2880) + (2._dp*t735*t656*t1285) - 0.75e2_dp/0.4e1_dp & + *(t735)*(t1938)*(t2884) + (10._dp*t735*t739 & + *t2994) + 0.5e1_dp/0.2e1_dp*(t735)*(t739)*(t2927) - & + t180*t2707*t93*t170 + (4._dp*t2379*t951) + (3._dp*t2379 & + *t954) - (6._dp*t746*t1956*t2715) - (6._dp*t746*t149 & + *t752*t2971) + (2._dp*t746*t747*t1285) - 0.27e2_dp/0.4e1_dp & + *(t746)*(t1967)*(t2880) + (3._dp*t746*t753* & + t2975) + 0.3e1_dp/0.2e1_dp*(t746)*(t753)*(t2979) + t3167 = f12*t2707*t94 + (t3001 + t3033)*omega*t128 + (2._dp & + *t81*t149*t2715) + (6._dp*t2543*t962) - t2810*t195 + (10._dp & + *t583*t271*t2994) + (12._dp*t148*t1602*t2715) + & + (t97*(0.27e2_dp/0.4e1_dp*(t221)*(t1984)*(t2715) - & + (3._dp*t221*t1988*t2715) - 0.3e1_dp/0.2e1_dp*(t221)*(t597) & + *(t1285) - 0.3e1_dp/0.4e1_dp*(t1995)*(t2715) + & + (t603*t1285)/0.2e1_dp) + f2716*t2846*t233)*alpha3*t185 & + *t190 + ((-2._dp*t823*t2715 + t276*t1285 + 6._dp*t197*t319 & + *t2715 - 2._dp*t197*t273*t1285 + t243*t2875)*alpha4*t247) & + - (2._dp*t91*t452*t1285) - (4._dp*t849*t851) + t3139 & + *t185*t190 + (6._dp*t91*t1839*t2715) + ((12._dp*t1781 & + *t2715 - 3._dp*t820*t1285 - 6._dp*t1786*t2715 + 2._dp*t823*t1285 & + + 2._dp*t243*t1791*t2715 - t243*t826*t1285 - t280*t2875)* & + alpha6*t284*t286) - (12._dp*t1740*t194*t44*t2715) + e_ndrho_ndrho = e_ndrho_ndrho - t80*(t2963 + t3167)*Clda END IF END SUBROUTINE xwpbe_lda_calc_1 @@ -2722,7 +2722,7 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t29 = 0.1e1_dp/t28 t31 = t14**2 t32 = t27*t29*t31 - t34 = t17*t19+t25*t32 + t34 = t17*t19 + t25*t32 t35 = a3*t21 t36 = t35*t24 t38 = t21*ndrho @@ -2741,7 +2741,7 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t61 = t28**2 t63 = t31*t14 t65 = t60/t61*t63 - t67 = r1+t36*t32+t42*t49+t55*t65 + t67 = r1 + t36*t32 + t42*t49 + t55*t65 t68 = 0.1e1_dp/t67 t69 = t34*t68 t70 = t15*t69 @@ -2749,19 +2749,19 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t72 = omega**2 t73 = beta*t72 t74 = t73*t10 - t75 = t71+t74 + t75 = t71 + t74 t77 = 0.1e1_dp/A Q = f94*t75*t77 t78 = rho**(0.1e1_dp/0.3e1_dp) t80 = t78*rho*f89 t81 = B*f12 - t82 = t71+DD + t82 = t71 + DD t83 = 0.1e1_dp/t82 t84 = t81*t83 t85 = F2*t34 - t87 = F1+t85*t68 + t87 = F1 + t85*t68 t88 = t15*t87 - t90 = t11*t88+r1 + t90 = t11*t88 + r1 t91 = f12*t90 t92 = t82**2 t93 = 0.1e1_dp/t92 @@ -2771,16 +2771,16 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t97 = t96*t3 t99 = g3*t21 t100 = t99*t24 - t102 = g1+t97*t19+t100*t32 + t102 = g1 + t97*t19 + t100*t32 t103 = t15*t102 - t105 = t11*t103+r1 + t105 = t11*t103 + r1 t106 = t105*E t108 = 0.1e1_dp/t92/t82 t109 = t106*t108 t110 = f158*E t111 = t105*t83 t112 = t72*t10 - t113 = t71+DD+t112 + t113 = t71 + DD + t112 t114 = t113**2 t115 = t114**2 t116 = t115*t113 @@ -2793,7 +2793,7 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t127 = t114*t113 t128 = SQRT(t127) t129 = 0.1e1_dp/t128 - t133 = (-t110*t111*t118-t81*t83*t122-t125*t126*t129) & + t133 = (-t110*t111*t118 - t81*t83*t122 - t125*t126*t129) & *omega t134 = 0.1e1_dp/t8 t136 = f52*E @@ -2801,7 +2801,7 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t140 = f12*C t141 = t90*t93 t145 = t72*omega - t146 = (-t136*t137*t118-t140*t141*t129)*t145 + t146 = (-t136*t137*t118 - t140*t141*t129)*t145 t149 = 0.1e1_dp/r3/t5 t151 = t149/rho t153 = t72**2 @@ -2810,7 +2810,7 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t156 = t155*t44 t158 = f12*A t159 = exei(Q) - t160 = t71+DD+t74 + t160 = t71 + DD + t74 t161 = 0.1e1_dp/t160 t163 = LOG(t75*t161) t166 = rootpi @@ -2818,9 +2818,9 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t171 = SQRT(A) t172 = t171*f34 t173 = exer(Q) - t176 = (t158*t166/t167-t172*t173)*alpha1 + t176 = (t158*t166/t167 - t172*t173)*alpha1 t177 = omega*t134 - t182 = (t158*t161-f98*t159)*alpha2 + t182 = (t158*t161 - f98*t159)*alpha2 t184 = A*f14 t185 = t160**2 t186 = t185*t160 @@ -2828,12 +2828,12 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t190 = SQRT(t75) t191 = 0.1e1_dp/t190 t196 = 0.1e1_dp/t171 - t200 = (t166*(t184/t187-f98*t191)+f2716*t173*t196)* & + t200 = (t166*(t184/t187 - f98*t191) + f2716*t173*t196)* & alpha3*t145 t202 = 0.1e1_dp/t75 t204 = 0.1e1_dp/t185 t206 = f8132*t77 - t209 = (-f98*t202+t158*t204+t206*t159)*alpha4 + t209 = (-f98*t202 + t158*t204 + t206*t159)*alpha4 t210 = t153*t27 t213 = t75**2 t214 = t213*t75 @@ -2847,7 +2847,7 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t227 = t226*A t228 = SQRT(t227) t230 = f24364/t228 - t233 = (t166*(t206*t191-f916*t216+t218/t221)-t230*t173) & + t233 = (t166*(t206*t191 - f916*t216 + t218/t221) - t230*t173) & *alpha5 t234 = t154*t44 t236 = 0.1e1_dp/t186 @@ -2855,7 +2855,7 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t239 = f98*t238 t243 = f729128/t226 t247 = t153*t72 - t248 = (A*t236-t239+t206*r1*t202-t243*t159)*alpha6 & + t248 = (A*t236 - t239 + t206*r1*t202 - t243*t159)*alpha6 & *t247 t249 = t60*t13 t251 = f1516*A @@ -2868,8 +2868,8 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t266 = t226**2 t268 = SQRT(t266*A) t270 = f2187256/t268 - t273 = (t166*(t251/t253-f2732/t258+t261*t216-t243*t191) & - +t270*t173)*alpha7 + t273 = (t166*(t251/t253 - f2732/t258 + t261*t216 - t243*t191) & + + t270*t173)*alpha7 t274 = t153*t145 t275 = t56*t58 t276 = t275*t12 @@ -2879,16 +2879,16 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t282 = 0.1e1_dp/t219 t284 = 0.1e1_dp/t214 t289 = f6561512/t227 - t292 = (t281*t282-f94*t284+t206*t238-t243*t202+t289 & + t292 = (t281*t282 - f94*t284 + t206*t238 - t243*t202 + t289 & *t159)*alpha8 t293 = t153**2 t295 = 0.1e1_dp/t9/t276 t296 = t293*t295 - t298 = t84+t95+t109+t133*t134+t146*t151-t109*t156+ & - t158*(t159+t163)+t176*t177+t182*t112+t200*t151+ & - t209*t210+t233*t234+t248*t249+t273*t279+t292*t296 + t298 = t84 + t95 + t109 + t133*t134 + t146*t151 - t109*t156 + & + t158*(t159 + t163) + t176*t177 + t182*t112 + t200*t151 + & + t209*t210 + t233*t234 + t248*t249 + t273*t279 + t292*t296 t299 = t298*Clda - e_0 = e_0+(-t80*t299)*sx + e_0 = e_0 + (-t80*t299)*sx END IF IF (order >= 1 .OR. order == -1) THEN t301 = t44*t13 @@ -2912,8 +2912,8 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t326 = t29*t31 t327 = t326*t6 t331 = t27*t46*t31 - t334 = -0.2e1_dp/0.3e1_dp*t316*t317-(2._dp*t17*t321)-0.4e1_dp & - /0.3e1_dp*t325*t327-(4._dp*t25*t331) + t334 = -0.2e1_dp/0.3e1_dp*t316*t317 - (2._dp*t17*t321) - 0.4e1_dp & + /0.3e1_dp*t325*t327 - (4._dp*t25*t331) t335 = t334*t68 t336 = t15*t335 t337 = t11*t336 @@ -2928,13 +2928,13 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t353 = 0.1e1_dp/t28/t12 t355 = t44*t353*t48 t361 = t60/t61/rho*t63 - t364 = -0.4e1_dp/0.3e1_dp*t341*t327-(4._dp*t36*t331)-0.5e1_dp & - /0.3e1_dp*t347*t349-(5._dp*t42*t355)-(8._dp*t55*t361) + t364 = -0.4e1_dp/0.3e1_dp*t341*t327 - (4._dp*t36*t331) - 0.5e1_dp & + /0.3e1_dp*t347*t349 - (5._dp*t42*t355) - (8._dp*t55*t361) t365 = t340*t364 t366 = t303*t365 t367 = t338*t366 t369 = t44*r3*t5 - t372 = -t308-t314+t337-t367-0.2e1_dp/0.3e1_dp*t73*t369 + t372 = -t308 - t314 + t337 - t367 - 0.2e1_dp/0.3e1_dp*t73*t369 dQrho = f94*t372*t77 t374 = ndrho*t3 t375 = t374*t10 @@ -2943,7 +2943,7 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t382 = t1*ndrho t383 = a2*t382 t384 = t383*t24 - t387 = 2._dp*t379*t19+4._dp*t384*t32 + t387 = 2._dp*t379*t19 + 4._dp*t384*t32 t388 = t387*t68 t389 = t15*t388 t391 = a3*t382 @@ -2951,10 +2951,10 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t395 = a4*t21 t396 = t395*t41 t400 = a5*t38*t54 - t403 = 4._dp*t392*t32+5._dp*t396*t49+6._dp*t400*t65 + t403 = 4._dp*t392*t32 + 5._dp*t396*t49 + 6._dp*t400*t65 t404 = t340*t403 t405 = t303*t404 - t407 = 2._dp*t375*t70+t11*t389-t338*t405 + t407 = 2._dp*t375*t70 + t11*t389 - t338*t405 dQndrho = f94*t407*t77 t409 = t78*f89 t413 = t27*r3*t5 @@ -2963,28 +2963,28 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t420 = t311*t102 t423 = t96*t315 t428 = t99*t324 - t433 = -0.2e1_dp/0.3e1_dp*t423*t317-(2._dp*t97*t321)-0.4e1_dp & - /0.3e1_dp*t428*t327-(4._dp*t100*t331) + t433 = -0.2e1_dp/0.3e1_dp*t423*t317 - (2._dp*t97*t321) - 0.4e1_dp & + /0.3e1_dp*t428*t327 - (4._dp*t100*t331) t434 = t15*t433 - t436 = -0.2e1_dp/0.3e1_dp*t302*t417-(2._dp*t11*t420)+(t11 & - *t434) + t436 = -0.2e1_dp/0.3e1_dp*t302*t417 - (2._dp*t11*t420) + (t11 & + *t434) t440 = t136*t105 t441 = t108*t118 - t442 = -t308-t314+t337-t367 + t442 = -t308 - t314 + t337 - t367 t443 = t441*t442 t447 = 0.1e1_dp/t117/t116 t448 = t93*t447 - t452 = -t308-t314+t337-t367-0.2e1_dp/0.3e1_dp*t72*t44*t6 + t452 = -t308 - t314 + t337 - t367 - 0.2e1_dp/0.3e1_dp*t72*t44*t6 t453 = t115*t452 t454 = t448*t453 t457 = t14*t87 t458 = t457*t6 t461 = t311*t87 t464 = F2*t334 - t467 = t464*t68-t85*t365 + t467 = t464*t68 - t85*t365 t468 = t15*t467 - t470 = -0.2e1_dp/0.3e1_dp*t302*t458-(2._dp*t11*t461)+(t11 & - *t468) + t470 = -0.2e1_dp/0.3e1_dp*t302*t458 - (2._dp*t11*t461) + (t11 & + *t468) t474 = t140*t90 t475 = t108*t129 t476 = t475*t442 @@ -2992,14 +2992,14 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t481 = t93*t480 t482 = t114*t452 t483 = t481*t482 - t487 = (-t136*t436*t93*t118+(2._dp*t440*t443)+0.5e1_dp/ & - 0.2e1_dp*(t440)*(t454)-t140*t470*t93*t129+(2._dp & - *t474*t476)+0.3e1_dp/0.2e1_dp*(t474)*(t483))*t145 + t487 = (-t136*t436*t93*t118 + (2._dp*t440*t443) + 0.5e1_dp/ & + 0.2e1_dp*(t440)*(t454) - t140*t470*t93*t129 + (2._dp & + *t474*t476) + 0.3e1_dp/0.2e1_dp*(t474)*(t483))*t145 t489 = t209*t153 t491 = t278*r3*t5 t496 = t166/t167/t160 t500 = dexerrho(Q, dQrho) - t503 = (-t158*t496*t372/0.2e1_dp-t172*t500)*alpha1 + t503 = (-t158*t496*t372/0.2e1_dp - t172*t500)*alpha1 t505 = t106*t441 t506 = t154*t295 t507 = t506*t6 @@ -3018,9 +3018,9 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t536 = t535*t213 t541 = 0.1e1_dp/t190/t75 t542 = t541*t372 - t549 = (t166*(-0.7e1_dp/0.2e1_dp*t251*t524*t372+0.5e1_dp/0.2e1_dp & - *t530*t531-0.3e1_dp/0.2e1_dp*t261*t536*t372+t243*t542 & - /0.2e1_dp)+t270*t500)*alpha7 + t549 = (t166*(-0.7e1_dp/0.2e1_dp*t251*t524*t372 + 0.5e1_dp/0.2e1_dp & + *t530*t531 - 0.3e1_dp/0.2e1_dp*t261*t536*t372 + t243*t542 & + /0.2e1_dp) + t270*t500)*alpha7 t551 = C*t108 t552 = t551*t442 t558 = t436*E @@ -3030,13 +3030,13 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t566 = f94*t565 t569 = t284*t372 t574 = dexeirho(Q, dQrho) - t577 = (-4._dp*t281*t561*t372+3._dp*t566*t372-2._dp*t206*t569 & - +t243*t238*t372+t289*t574)*alpha8 - t579 = -t133*t413/0.3e1_dp+t487*t151-0.4e1_dp/0.3e1_dp*t489* & - t491+t503*t177+0.5e1_dp/0.3e1_dp*t505*t507+t510*t94+(3._dp & - *t514*t516)-t146*t519+t549*t279-(2._dp*t91*t552) & - -t81*t93*t442-t200*t519-t559*t156+t577*t296 & - +t559 + t577 = (-4._dp*t281*t561*t372 + 3._dp*t566*t372 - 2._dp*t206*t569 & + + t243*t238*t372 + t289*t574)*alpha8 + t579 = -t133*t413/0.3e1_dp + t487*t151 - 0.4e1_dp/0.3e1_dp*t489* & + t491 + t503*t177 + 0.5e1_dp/0.3e1_dp*t505*t507 + t510*t94 + (3._dp & + *t514*t516) - t146*t519 + t549*t279 - (2._dp*t91*t552) & + - t81*t93*t442 - t200*t519 - t559*t156 + t577*t296 & + + t559 t583 = t110*t105 t584 = t93*t118 t585 = t584*t442 @@ -3050,15 +3050,15 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t605 = t604*t442 t607 = t83*t480 t608 = t607*t482 - t612 = (-t110*t436*t83*t118+t583*t585+0.5e1_dp/0.2e1_dp*t583 & - *t588+t81*t591*t442+t81*t596*t452/0.2e1_dp-t125 & - *t470*t83*t129+t603*t605+0.3e1_dp/0.2e1_dp*t603*t608)* & + t612 = (-t110*t436*t83*t118 + t583*t585 + 0.5e1_dp/0.2e1_dp*t583 & + *t588 + t81*t591*t442 + t81*t596*t452/0.2e1_dp - t125 & + *t470*t83*t129 + t603*t605 + 0.3e1_dp/0.2e1_dp*t603*t608)* & omega t615 = t236*t372 - t620 = (t239*t372-2._dp*t158*t615+t206*t574)*alpha4 + t620 = (t239*t372 - 2._dp*t158*t615 + t206*t574)*alpha4 t622 = t513*t442 t626 = t75*t204 - t628 = t372*t161-t626*t372 + t628 = t372*t161 - t626*t372 t629 = t628*t202 t633 = t233*t154 t634 = t295*r3 @@ -3066,18 +3066,18 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t638 = A*t282 t641 = f98*t284 t644 = r1*t238 - t650 = (-3._dp*t638*t372+2._dp*t641*t372-t206*t644*t372-t243 & + t650 = (-3._dp*t638*t372 + 2._dp*t641*t372 - t206*t644*t372 - t243 & *t574)*alpha6*t247 t652 = t204*t372 - t656 = (-t158*t652-f98*t574)*alpha2 + t656 = (-t158*t652 - f98*t574)*alpha2 t658 = t108*t447 t659 = t106*t658 t660 = t234*t453 t665 = f916*t535 t670 = 0.1e1_dp/t221/t220 t671 = t670*t219 - t679 = (t166*(-t206*t542/0.2e1_dp+0.3e1_dp/0.2e1_dp*t665*t213 & - *t372-0.5e1_dp/0.2e1_dp*t218*t671*t372)-t230*t500)*alpha5 + t679 = (t166*(-t206*t542/0.2e1_dp + 0.3e1_dp/0.2e1_dp*t665*t213 & + *t372 - 0.5e1_dp/0.2e1_dp*t218*t671*t372) - t230*t500)*alpha5 t681 = t292*t293 t685 = t56*r3*t58*t5*t309 t687 = 0.1e1_dp/t9/t685 @@ -3091,29 +3091,29 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t709 = 0.1e1_dp/t187/t186 t710 = t709*t185 t714 = f98*t541 - t723 = (t166*(-0.3e1_dp/0.2e1_dp*t184*t710*t372+t714*t372/ & - 0.2e1_dp)+f2716*t500*t196)*alpha3*t145 - t725 = t612*t134+t620*t210-(3._dp*t106*t622)+t158*(t574 & - +t629*t160)-0.5e1_dp/0.3e1_dp*t633*t635+t650*t249+ & - t656*t112+0.5e1_dp/0.2e1_dp*t659*t660+t679*t234-0.8e1_dp/ & - 0.3e1_dp*t681*t689-(2._dp*t248*t692)-0.7e1_dp/0.3e1_dp*t695 & - *t699-t702*t413/0.3e1_dp-0.2e1_dp/0.3e1_dp*t705*t369+t723 & + t723 = (t166*(-0.3e1_dp/0.2e1_dp*t184*t710*t372 + t714*t372/ & + 0.2e1_dp) + f2716*t500*t196)*alpha3*t145 + t725 = t612*t134 + t620*t210 - (3._dp*t106*t622) + t158*(t574 & + + t629*t160) - 0.5e1_dp/0.3e1_dp*t633*t635 + t650*t249 + & + t656*t112 + 0.5e1_dp/0.2e1_dp*t659*t660 + t679*t234 - 0.8e1_dp/ & + 0.3e1_dp*t681*t689 - (2._dp*t248*t692) - 0.7e1_dp/0.3e1_dp*t695 & + *t699 - t702*t413/0.3e1_dp - 0.2e1_dp/0.3e1_dp*t705*t369 + t723 & *t151 - t727 = (t579+t725)*Clda - e_rho = e_rho+(-0.4e1_dp/0.3e1_dp*t409*t299-t80*t727)*sx + t727 = (t579 + t725)*Clda + e_rho = e_rho + (-0.4e1_dp/0.3e1_dp*t409*t299 - t80*t727)*sx t733 = F2*t387 - t736 = t733*t68-t85*t404 + t736 = t733*t68 - t85*t404 t737 = t15*t736 - t739 = 2._dp*t375*t88+t11*t737 + t739 = 2._dp*t375*t88 + t11*t737 t740 = f12*t739 t742 = t551*t407 t747 = g2*ndrho t748 = t747*t3 t751 = g3*t382 t752 = t751*t24 - t755 = 2._dp*t748*t19+4._dp*t752*t32 + t755 = 2._dp*t748*t19 + 4._dp*t752*t32 t756 = t15*t755 - t758 = 2._dp*t375*t103+t11*t756 + t758 = 2._dp*t375*t103 + t11*t756 t759 = t758*E t760 = t759*t108 t761 = t513*t407 @@ -3123,45 +3123,45 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t781 = t604*t407 t783 = t114*t407 t784 = t607*t783 - t788 = (-t110*t758*t83*t118+t583*t767+0.5e1_dp/0.2e1_dp*t583 & - *t770+t81*t591*t407+t81*t596*t407/0.2e1_dp-t125 & - *t739*t83*t129+t603*t781+0.3e1_dp/0.2e1_dp*t603*t784)* & + t788 = (-t110*t758*t83*t118 + t583*t767 + 0.5e1_dp/0.2e1_dp*t583 & + *t770 + t81*t591*t407 + t81*t596*t407/0.2e1_dp - t125 & + *t739*t83*t129 + t603*t781 + 0.3e1_dp/0.2e1_dp*t603*t784)* & omega t793 = t441*t407 t796 = t448*t769 t802 = t475*t407 t805 = t481*t783 - t809 = (-t136*t758*t93*t118+(2._dp*t440*t793)+0.5e1_dp/ & - 0.2e1_dp*(t440)*(t796)-t140*t739*t93*t129+(2._dp & - *t474*t802)+0.3e1_dp/0.2e1_dp*(t474)*(t805))*t145 + t809 = (-t136*t758*t93*t118 + (2._dp*t440*t793) + 0.5e1_dp/ & + 0.2e1_dp*(t440)*(t796) - t140*t739*t93*t129 + (2._dp & + *t474*t802) + 0.3e1_dp/0.2e1_dp*(t474)*(t805))*t145 t813 = t155*t44*t407 t816 = t234*t769 t819 = dexeindrho(Q, dQndrho) - t822 = t407*t161-t626*t407 + t822 = t407*t161 - t626*t407 t823 = t822*t202 t830 = dexerndrho(Q, dQndrho) - t833 = (-t158*t496*t407/0.2e1_dp-t172*t830)*alpha1 - t839 = (-t158*t204*t407-f98*t819)*alpha2 - t852 = (t166*(-0.3e1_dp/0.2e1_dp*t184*t710*t407+t714*t407/ & - 0.2e1_dp)+f2716*t830*t196)*alpha3*t145 - t860 = (t239*t407-2._dp*t158*t236*t407+t206*t819)*alpha4 + t833 = (-t158*t496*t407/0.2e1_dp - t172*t830)*alpha1 + t839 = (-t158*t204*t407 - f98*t819)*alpha2 + t852 = (t166*(-0.3e1_dp/0.2e1_dp*t184*t710*t407 + t714*t407/ & + 0.2e1_dp) + f2716*t830*t196)*alpha3*t145 + t860 = (t239*t407 - 2._dp*t158*t236*t407 + t206*t819)*alpha4 t862 = t541*t407 - t875 = (t166*(-t206*t862/0.2e1_dp+0.3e1_dp/0.2e1_dp*t665*t213 & - *t407-0.5e1_dp/0.2e1_dp*t218*t671*t407)-t230*t830)*alpha5 - t886 = (-3._dp*t638*t407+2._dp*t641*t407-t206*t644*t407-t243 & + t875 = (t166*(-t206*t862/0.2e1_dp + 0.3e1_dp/0.2e1_dp*t665*t213 & + *t407 - 0.5e1_dp/0.2e1_dp*t218*t671*t407) - t230*t830)*alpha5 + t886 = (-3._dp*t638*t407 + 2._dp*t641*t407 - t206*t644*t407 - t243 & *t819)*alpha6*t247 - t903 = (t166*(-0.7e1_dp/0.2e1_dp*t251*t524*t407+0.5e1_dp/0.2e1_dp & - *t530*t256*t407-0.3e1_dp/0.2e1_dp*t261*t536*t407+t243 & - *t862/0.2e1_dp)+t270*t830)*alpha7 - t917 = (-4._dp*t281*t561*t407+3._dp*t566*t407-2._dp*t206*t284 & - *t407+t243*t238*t407+t289*t819)*alpha8 - t919 = -t81*t93*t407+t740*t94-(2._dp*t91*t742)+t760 & - -(3._dp*t106*t761)+t788*t134+t809*t151-t760*t156 & - +(3._dp*t514*t813)+0.5e1_dp/0.2e1_dp*t659*t816+t158*(t819 & - +t823*t160)+t833*t177+t839*t112+t852*t151+t860 & - *t210+t875*t234+t886*t249+t903*t279+t917*t296 + t903 = (t166*(-0.7e1_dp/0.2e1_dp*t251*t524*t407 + 0.5e1_dp/0.2e1_dp & + *t530*t256*t407 - 0.3e1_dp/0.2e1_dp*t261*t536*t407 + t243 & + *t862/0.2e1_dp) + t270*t830)*alpha7 + t917 = (-4._dp*t281*t561*t407 + 3._dp*t566*t407 - 2._dp*t206*t284 & + *t407 + t243*t238*t407 + t289*t819)*alpha8 + t919 = -t81*t93*t407 + t740*t94 - (2._dp*t91*t742) + t760 & + - (3._dp*t106*t761) + t788*t134 + t809*t151 - t760*t156 & + + (3._dp*t514*t813) + 0.5e1_dp/0.2e1_dp*t659*t816 + t158*(t819 & + + t823*t160) + t833*t177 + t839*t112 + t852*t151 + t860 & + *t210 + t875*t234 + t886*t249 + t903*t279 + t917*t296 t920 = t919*Clda - e_ndrho = e_ndrho+(-t80*t920)*sx + e_ndrho = e_ndrho + (-t80*t920)*sx END IF IF (order >= 2 .OR. order == -2) THEN t923 = t4*t295*t13 @@ -3186,50 +3186,50 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t968 = t326*t275 t972 = t46*t31*t6 t976 = t27*t353*t31 - t979 = 0.10e2_dp/0.9e1_dp*t16*t954*t956+0.8e1_dp/0.3e1_dp*t316* & - t959+(6._dp*t17*t963)+0.28e2_dp/0.9e1_dp*t22*t966*t968+ & - 0.32e2_dp/0.3e1_dp*t325*t972+(20._dp*t25*t976) + t979 = 0.10e2_dp/0.9e1_dp*t16*t954*t956 + 0.8e1_dp/0.3e1_dp*t316* & + t959 + (6._dp*t17*t963) + 0.28e2_dp/0.9e1_dp*t22*t966*t968 + & + 0.32e2_dp/0.3e1_dp*t325*t972 + (20._dp*t25*t976) t982 = t11*t15*t979*t68 t985 = 2._dp*t338*t933*t365 t987 = 0.1e1_dp/t339/t67 t988 = t364**2 t989 = t987*t988 t992 = 2._dp*t338*t303*t989 - t1022 = t340*(0.28e2_dp/0.9e1_dp*t35*t966*t968+0.32e2_dp/0.3e1_dp & - *t341*t972+(20._dp*t36*t976)+0.40e2_dp/0.9e1_dp*t39*t41 & - *t687*t348*t275+0.50e2_dp/0.3e1_dp*t347*t353*t48*t6+ & - 0.30e2_dp*t42*t44/t28/t309*t48+(72._dp*t55*t60/t61 & - /t12*t63)) + t1022 = t340*(0.28e2_dp/0.9e1_dp*t35*t966*t968 + 0.32e2_dp/0.3e1_dp & + *t341*t972 + (20._dp*t36*t976) + 0.40e2_dp/0.9e1_dp*t39*t41 & + *t687*t348*t275 + 0.50e2_dp/0.3e1_dp*t347*t353*t48*t6 + & + 0.30e2_dp*t42*t44/t28/t309*t48 + (72._dp*t55*t60/t61 & + /t12*t63)) t1024 = t338*t303*t1022 t1026 = t295*t56*t58 - t1029 = t928+t932-t936+t943+t947-t950+t953+t982-t985 & - +t992-t1024+0.10e2_dp/0.9e1_dp*t73*t1026 + t1029 = t928 + t932 - t936 + t943 + t947 - t950 + t953 + t982 - t985 & + + t992 - t1024 + 0.10e2_dp/0.9e1_dp*t73*t1026 d2Qrhorho = f94*t1029*t77 t1031 = t374*t301 t1034 = t14*t387 - t1061 = -0.4e1_dp/0.3e1_dp*t378*t315*t317-(4._dp*t379*t321) & - -0.16e2_dp/0.3e1_dp*t383*t324*t327-(16._dp*t384*t331) + t1061 = -0.4e1_dp/0.3e1_dp*t378*t315*t317 - (4._dp*t379*t321) & + - 0.16e2_dp/0.3e1_dp*t383*t324*t327 - (16._dp*t384*t331) t1067 = t374*t18 t1073 = t987*t364*t403 - t1090 = t340*(-0.16e2_dp/0.3e1_dp*t391*t324*t327-(16._dp*t392 & - *t331)-0.25e2_dp/0.3e1_dp*t395*t346*t349-(25._dp*t396 & - *t355)-(48._dp*t400*t361)) - t1093 = -0.4e1_dp/0.3e1_dp*t1031*t306-0.2e1_dp/0.3e1_dp*t302*t1034 & - *t305+0.2e1_dp/0.3e1_dp*t938*t939*t6*t403-(4._dp*t375 & - *t312)-(2._dp*t11*t311*t388)+(2._dp*t951*t405)+(2._dp & - *t375*t336)+(t11*t15*t1061*t68)-t338*t933 & - *t404-(2._dp*t1067*t366)-t338*t1034*t365+0.2e1_dp*t338 & - *t303*t1073-t338*t303*t1090 + t1090 = t340*(-0.16e2_dp/0.3e1_dp*t391*t324*t327 - (16._dp*t392 & + *t331) - 0.25e2_dp/0.3e1_dp*t395*t346*t349 - (25._dp*t396 & + *t355) - (48._dp*t400*t361)) + t1093 = -0.4e1_dp/0.3e1_dp*t1031*t306 - 0.2e1_dp/0.3e1_dp*t302*t1034 & + *t305 + 0.2e1_dp/0.3e1_dp*t938*t939*t6*t403 - (4._dp*t375 & + *t312) - (2._dp*t11*t311*t388) + (2._dp*t951*t405) + (2._dp & + *t375*t336) + (t11*t15*t1061*t68) - t338*t933 & + *t404 - (2._dp*t1067*t366) - t338*t1034*t365 + 0.2e1_dp*t338 & + *t303*t1073 - t338*t303*t1090 d2Qrhondrho = f94*t1093*t77 t1095 = t3*t10 - t1111 = 2._dp*a1*t3*t19+12._dp*a2*t1*t24*t32 + t1111 = 2._dp*a1*t3*t19 + 12._dp*a2*t1*t24*t32 t1118 = t403**2 t1119 = t987*t1118 - t1136 = t340*(12._dp*a3*t1*t24*t32+20._dp*a4*t382*t41*t49 & - +30._dp*a5*t21*t54*t65) - t1139 = 2._dp*t1095*t13*t303*t68+4._dp*t375*t389-4._dp*t1067 & - *t405+t11*t15*t1111*t68-2._dp*t338*t1034*t404+2._dp*t338 & - *t303*t1119-t338*t303*t1136 + t1136 = t340*(12._dp*a3*t1*t24*t32 + 20._dp*a4*t382*t41*t49 & + + 30._dp*a5*t21*t54*t65) + t1139 = 2._dp*t1095*t13*t303*t68 + 4._dp*t375*t389 - 4._dp*t1067 & + *t405 + t11*t15*t1111*t68 - 2._dp*t338*t1034*t404 + 2._dp*t338 & + *t303*t1119 - t338*t303*t1136 d2Qndrhondrho = f94*t1139*t77 t1141 = t78**2 t1149 = 0.1e1_dp/t512/t82 @@ -3246,12 +3246,12 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1182 = t1181*t1178 t1186 = t670*t186 t1195 = d2exerrhorho(Q, dQrho, d2Qrhorho) - t1239 = 0.10e2_dp/0.9e1_dp*t923*t416*t275+0.8e1_dp/0.3e1_dp*t930 & - *t417-0.4e1_dp/0.3e1_dp*t302*t14*t433*t6+(6._dp*t11*t944 & - *t102)-0.4e1_dp*(t11)*t311*t433+(t11)*t15* & - (0.10e2_dp/0.9e1_dp*t96*t954*t956+0.8e1_dp/0.3e1_dp*t423*t959 & - +(6._dp*t97*t963)+0.28e2_dp/0.9e1_dp*t99*t966*t968+0.32e2_dp & - /0.3e1_dp*t428*t972+(20._dp*t100*t976)) + t1239 = 0.10e2_dp/0.9e1_dp*t923*t416*t275 + 0.8e1_dp/0.3e1_dp*t930 & + *t417 - 0.4e1_dp/0.3e1_dp*t302*t14*t433*t6 + (6._dp*t11*t944 & + *t102) - 0.4e1_dp*(t11)*t311*t433 + (t11)*t15* & + (0.10e2_dp/0.9e1_dp*t96*t954*t956 + 0.8e1_dp/0.3e1_dp*t423*t959 & + + (6._dp*t97*t963) + 0.28e2_dp/0.9e1_dp*t99*t966*t968 + 0.32e2_dp & + /0.3e1_dp*t428*t972 + (20._dp*t100*t976)) t1241 = t1239*E*t108 t1243 = t278*t56*t58 t1251 = t136*t436 @@ -3259,21 +3259,21 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1261 = t136*t105*t108 t1262 = t447*t442 t1263 = t1262*t453 - t1266 = t928+t932-t936+t943+t947-t950+t953+t982-t985 & - +t992-t1024 + t1266 = t928 + t932 - t936 + t943 + t947 - t950 + t953 + t982 - t985 & + + t992 - t1024 t1270 = t115**2 t1273 = 0.1e1_dp/t117/t1270/t114 t1274 = t93*t1273 t1275 = t452**2 t1276 = t1270*t1275 t1280 = t127*t1275 - t1287 = t928+t932-t936+t943+t947-t950+t953+t982-t985 & - +t992-t1024+0.10e2_dp/0.9e1_dp*t72*t295*t275 + t1287 = t928 + t932 - t936 + t943 + t947 - t950 + t953 + t982 - t985 & + + t992 - t1024 + 0.10e2_dp/0.9e1_dp*t72*t295*t275 t1288 = t115*t1287 - t1317 = 0.10e2_dp/0.9e1_dp*t923*t457*t275+0.8e1_dp/0.3e1_dp*t930 & - *t458-0.4e1_dp/0.3e1_dp*t302*t14*t467*t6+(6._dp*t11*t944 & - *t87)-0.4e1_dp*(t11)*t311*t467+(t11*t15*(F2 & - *t979*t68-2._dp*t464*t365+2._dp*t85*t989-t85*t1022)) + t1317 = 0.10e2_dp/0.9e1_dp*t923*t457*t275 + 0.8e1_dp/0.3e1_dp*t930 & + *t458 - 0.4e1_dp/0.3e1_dp*t302*t14*t467*t6 + (6._dp*t11*t944 & + *t87) - 0.4e1_dp*(t11)*t311*t467 + (t11*t15*(F2 & + *t979*t68 - 2._dp*t464*t365 + 2._dp*t85*t989 - t85*t1022)) t1321 = t140*t470 t1326 = t513*t129 t1331 = t140*t90*t108 @@ -3284,15 +3284,15 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1343 = t115*t1275 t1347 = t113*t1275 t1351 = t114*t1287 - t1355 = -t136*t1239*t93*t118+(4._dp*t1251*t443)+(5._dp & - *t1251*t454)-(6._dp*t440*t1256*t1151)-(10._dp*t1261 & - *t1263)+(2._dp*t440*t441*t1266)-0.75e2_dp/0.4e1_dp*(t440) & - *(t1274)*(t1276)+(10._dp*t440*t448*t1280) & - +0.5e1_dp/0.2e1_dp*(t440)*(t448)*(t1288)-t140 & - *t1317*t93*t129+(4._dp*t1321*t476)+(3._dp*t1321*t483) & - -(6._dp*t474*t1326*t1151)-(6._dp*t1331*t1333)+ & - (2._dp*t474*t475*t1266)-0.27e2_dp/0.4e1_dp*(t474)*(t1342) & - *(t1343)+(3._dp*t474*t481*t1347)+0.3e1_dp/0.2e1_dp & + t1355 = -t136*t1239*t93*t118 + (4._dp*t1251*t443) + (5._dp & + *t1251*t454) - (6._dp*t440*t1256*t1151) - (10._dp*t1261 & + *t1263) + (2._dp*t440*t441*t1266) - 0.75e2_dp/0.4e1_dp*(t440) & + *(t1274)*(t1276) + (10._dp*t440*t448*t1280) & + + 0.5e1_dp/0.2e1_dp*(t440)*(t448)*(t1288) - t140 & + *t1317*t93*t129 + (4._dp*t1321*t476) + (3._dp*t1321*t483) & + - (6._dp*t474*t1326*t1151) - (6._dp*t1331*t1333) + & + (2._dp*t474*t475*t1266) - 0.27e2_dp/0.4e1_dp*(t474)*(t1342) & + *(t1343) + (3._dp*t474*t481*t1347) + 0.3e1_dp/0.2e1_dp & *(t474)*(t481)*(t1351) t1362 = t106*t658*t154 t1374 = d2exeirhorho(Q, dQrho, d2Qrhorho) @@ -3300,18 +3300,18 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1382 = t56**2 t1383 = t58**2 t1385 = t1382*t1383*t28 - t1392 = -(12._dp*t1150*t155*t44*t1151)+(t166*(0.3e1_dp/0.4e1_dp & - *t206*t1159-t206*t1162/0.2e1_dp-0.27e2_dp/0.4e1_dp*t1168 & - *t256*t1158+0.3e1_dp*t665*t75*t1158+0.3e1_dp/0.2e1_dp*t665 & - *t213*t1029+0.75e2_dp/0.4e1_dp*t218*t1182*t1158-0.10e2_dp & - *t218*t1186*t1158-0.5e1_dp/0.2e1_dp*t218*t671*t1029)-t230 & - *t1195)*alpha5*t234+0.28e2_dp/0.9e1_dp*t489*t697*t56 & - *t58+0.10e2_dp/0.3e1_dp*t558*t441*t507+t1241+0.4e1_dp/0.9e1_dp & - *t702*t1243+0.4e1_dp/0.9e1_dp*t133*t1243+t1355*t145*t151 & - -(2._dp*t91*t551*t1266)-0.25e2_dp/0.3e1_dp*t1362*t295 & - *t115*t452*r3*t5+(0.2e1_dp*t158*t236*t1158-t158*t204 & - *t1029-f98*t1374)*alpha2*t112+(5._dp*t1379*t660) & - +0.70e2_dp/0.9e1_dp*t695/t8/t1385*t56*t58 + t1392 = -(12._dp*t1150*t155*t44*t1151) + (t166*(0.3e1_dp/0.4e1_dp & + *t206*t1159 - t206*t1162/0.2e1_dp - 0.27e2_dp/0.4e1_dp*t1168 & + *t256*t1158 + 0.3e1_dp*t665*t75*t1158 + 0.3e1_dp/0.2e1_dp*t665 & + *t213*t1029 + 0.75e2_dp/0.4e1_dp*t218*t1182*t1158 - 0.10e2_dp & + *t218*t1186*t1158 - 0.5e1_dp/0.2e1_dp*t218*t671*t1029) - t230 & + *t1195)*alpha5*t234 + 0.28e2_dp/0.9e1_dp*t489*t697*t56 & + *t58 + 0.10e2_dp/0.3e1_dp*t558*t441*t507 + t1241 + 0.4e1_dp/0.9e1_dp & + *t702*t1243 + 0.4e1_dp/0.9e1_dp*t133*t1243 + t1355*t145*t151 & + - (2._dp*t91*t551*t1266) - 0.25e2_dp/0.3e1_dp*t1362*t295 & + *t115*t452*r3*t5 + (0.2e1_dp*t158*t236*t1158 - t158*t204 & + *t1029 - f98*t1374)*alpha2*t112 + (5._dp*t1379*t660) & + + 0.70e2_dp/0.9e1_dp*t695/t8/t1385*t56*t58 t1397 = t106*t108*t1273 t1407 = t110*t436 t1417 = t110*t137 @@ -3319,32 +3319,32 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1430 = t108*t122 t1434 = t81*t93 t1435 = t595*t442 - t1438 = -t110*t1239*t83*t118+(2._dp*t1407*t585)+(5._dp & - *t1407*t588)-(2._dp*t583*t441*t1151)+(t583*t584 & - *t1266)-(5._dp*t1417*t1263)+(10._dp*t583*t587*t1280) & - +0.5e1_dp/0.2e1_dp*(t583)*(t587)*(t1288)-0.75e2_dp & - /0.4e1_dp*(t583)*(t1426)*(t1276)-(2._dp*t81 & - *t1430*t1151)-t1434*t1435*t452 + t1438 = -t110*t1239*t83*t118 + (2._dp*t1407*t585) + (5._dp & + *t1407*t588) - (2._dp*t583*t441*t1151) + (t583*t584 & + *t1266) - (5._dp*t1417*t1263) + (10._dp*t583*t587*t1280) & + + 0.5e1_dp/0.2e1_dp*(t583)*(t587)*(t1288) - 0.75e2_dp & + /0.4e1_dp*(t583)*(t1426)*(t1276) - (2._dp*t81 & + *t1430*t1151) - t1434*t1435*t452 t1442 = 0.1e1_dp/t121/t114 t1443 = t83*t1442 t1453 = t125*t470 t1469 = t83*t1341 t1473 = t125*t141 - t1476 = t81*t591*(t1266)-0.3e1_dp/0.4e1_dp*t81*t1443*t1275 & - +t81*t596*t1287/0.2e1_dp-t125*t1317*t83*t129+(2._dp & - *t1453*t605)+(3._dp*t1453*t608)-(2._dp*t603*t475 & - *t1151)+(t603*t604*t1266)+(3._dp*t603*t607*t1347) & - +0.3e1_dp/0.2e1_dp*(t603)*(t607)*(t1351)-0.27e2_dp & - /0.4e1_dp*(t603)*(t1469)*(t1343)-(3._dp*t1473 & - *t1333) - t1517 = -0.16e2_dp/0.3e1_dp*t577*t293*t689-0.75e2_dp/0.4e1_dp*t1397 & - *t234*t1276+0.5e1_dp/0.2e1_dp*t659*t234*t1288+(t1438+ & - t1476)*omega*t134+f12*t1317*t94-(4._dp*t650*t692) & - -0.14e2_dp/0.3e1_dp*t549*t274*t699+(12._dp*t106*t1149* & - t1151)-(3._dp*t106*t513*t1266)-0.40e2_dp/0.9e1_dp*t505*t154 & - *t687*t275+((-2._dp*t641*t1158+t239*t1029+6._dp*t158 & - *t282*t1158-2._dp*t158*t236*t1029+t206*t1374)*alpha4 & - *t210)-(6._dp*t558*t622)+(6._dp*t248*t60*t29)- & + t1476 = t81*t591*(t1266) - 0.3e1_dp/0.4e1_dp*t81*t1443*t1275 & + + t81*t596*t1287/0.2e1_dp - t125*t1317*t83*t129 + (2._dp & + *t1453*t605) + (3._dp*t1453*t608) - (2._dp*t603*t475 & + *t1151) + (t603*t604*t1266) + (3._dp*t603*t607*t1347) & + + 0.3e1_dp/0.2e1_dp*(t603)*(t607)*(t1351) - 0.27e2_dp & + /0.4e1_dp*(t603)*(t1469)*(t1343) - (3._dp*t1473 & + *t1333) + t1517 = -0.16e2_dp/0.3e1_dp*t577*t293*t689 - 0.75e2_dp/0.4e1_dp*t1397 & + *t234*t1276 + 0.5e1_dp/0.2e1_dp*t659*t234*t1288 + (t1438 + & + t1476)*omega*t134 + f12*t1317*t94 - (4._dp*t650*t692) & + - 0.14e2_dp/0.3e1_dp*t549*t274*t699 + (12._dp*t106*t1149* & + t1151) - (3._dp*t106*t513*t1266) - 0.40e2_dp/0.9e1_dp*t505*t154 & + *t687*t275 + ((-2._dp*t641*t1158 + t239*t1029 + 6._dp*t158 & + *t282*t1158 - 2._dp*t158*t236*t1029 + t206*t1374)*alpha4 & + *t210) - (6._dp*t558*t622) + (6._dp*t248*t60*t29) - & (4._dp*t510*t552) t1519 = t149*t310 t1538 = t75*t236 @@ -3352,15 +3352,15 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1546 = t160*t372 t1552 = 0.1e1_dp/t167/t185 t1553 = t166*t1552 - t1577 = (2._dp*t146*t1519)-(2._dp*t723*t519)+0.10e2_dp/0.9e1_dp & - *t705*t1026-t1241*t156-0.10e2_dp/0.3e1_dp*t679*t154 & - *t635-0.2e1_dp/0.3e1_dp*t503*omega*t413+(2._dp*t200*t1519) & - +(t158*(t1374+(t1029*t161-2._dp*t1158*t204+2._dp* & - t1538*t1158-t626*t1029)*t202*t160-t1545*t1546+t629 & - *t372))+(0.3e1_dp/0.4e1_dp*(t158)*(t1553)*(t1158) & - -(t158*t496*t1029)/0.2e1_dp-t172*t1195)*alpha1*t177 & - -0.8e1_dp/0.3e1_dp*t620*t153*t491-t81*t93*t1266-0.2e1_dp & - /0.3e1_dp*t612*t413+0.88e2_dp/0.9e1_dp*t681/t9/t1385*t56 & + t1577 = (2._dp*t146*t1519) - (2._dp*t723*t519) + 0.10e2_dp/0.9e1_dp & + *t705*t1026 - t1241*t156 - 0.10e2_dp/0.3e1_dp*t679*t154 & + *t635 - 0.2e1_dp/0.3e1_dp*t503*omega*t413 + (2._dp*t200*t1519) & + + (t158*(t1374 + (t1029*t161 - 2._dp*t1158*t204 + 2._dp* & + t1538*t1158 - t626*t1029)*t202*t160 - t1545*t1546 + t629 & + *t372)) + (0.3e1_dp/0.4e1_dp*(t158)*(t1553)*(t1158) & + - (t158*t496*t1029)/0.2e1_dp - t172*t1195)*alpha1*t177 & + - 0.8e1_dp/0.3e1_dp*t620*t153*t491 - t81*t93*t1266 - 0.2e1_dp & + /0.3e1_dp*t612*t413 + 0.88e2_dp/0.9e1_dp*t681/t9/t1385*t56 & *t58 t1584 = A*t561 t1589 = f98*t565 @@ -3373,12 +3373,12 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1630 = f2732/t258/t1626/t213 t1640 = t1167*t256 t1644 = t535*t75 - t1655 = 0.147e3_dp/0.4e1_dp*t251*t1615*t1158-0.21e2_dp*t251*t1619 & - *t1158-0.7e1_dp/0.2e1_dp*t251*t524*t1029-0.75e2_dp/0.4e1_dp & - *t1630*t1626*t1158+0.10e2_dp*t530*t214*t1158+0.5e1_dp/ & - 0.2e1_dp*t530*t256*t1029+0.27e2_dp/0.4e1_dp*t261*t1640*t1158 & - -0.3e1_dp*t261*t1644*t1158-0.3e1_dp/0.2e1_dp*t261*t536*t1029 & - -0.3e1_dp/0.4e1_dp*t243*t1159+t243*t1162/0.2e1_dp + t1655 = 0.147e3_dp/0.4e1_dp*t251*t1615*t1158 - 0.21e2_dp*t251*t1619 & + *t1158 - 0.7e1_dp/0.2e1_dp*t251*t524*t1029 - 0.75e2_dp/0.4e1_dp & + *t1630*t1626*t1158 + 0.10e2_dp*t530*t214*t1158 + 0.5e1_dp/ & + 0.2e1_dp*t530*t256*t1029 + 0.27e2_dp/0.4e1_dp*t261*t1640*t1158 & + - 0.3e1_dp*t261*t1644*t1158 - 0.3e1_dp/0.2e1_dp*t261*t536*t1029 & + - 0.3e1_dp/0.4e1_dp*t243*t1159 + t243*t1162/0.2e1_dp t1661 = C*t513 t1666 = 0.1e1_dp/t187/t523 t1667 = t1666*t219 @@ -3390,25 +3390,25 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1732 = t558*t513 t1736 = t106*t513*t447 t1737 = t442*t115 - t1742 = -(2._dp*t487*t519)+0.40e2_dp/0.9e1_dp*t633*t687*t56 & - *t58+((12._dp*t1584*t1158-3._dp*t638*t1029-6._dp*t1589* & - t1158+2._dp*t641*t1029+2._dp*t206*t1594*t1158-t206*t644 & - *t1029-t243*t1374)*alpha6*t247*t249)-0.4e1_dp/0.3e1_dp* & - t656*t72*t369+(2._dp*t81*t108*t1151)+(t166*t1655 & - +t270*t1195)*alpha7*t279+(6._dp*t91*t1661*t1151)+ & - (t166*(0.27e2_dp/0.4e1_dp*(t184)*(t1667)*(t1158)- & - (3._dp*t184*t1671*t1158)-0.3e1_dp/0.2e1_dp*(t184)*(t710) & - *(t1029)-0.3e1_dp/0.4e1_dp*(t1678)*(t1158) & - +(t714*t1029)/0.2e1_dp)+f2716*t1195*t196)*alpha3*t145 & - *t151+((20._dp*t281*t1691*t1158-4._dp*t281*t561*t1029 & - -12._dp*t1699*t1158+3._dp*t566*t1029+6._dp*t206*t565*t1158 & - -2._dp*t206*t284*t1029-2._dp*t243*t284*t1158+t243* & - t238*t1029+t289*t1374)*alpha8*t296)+(10._dp*t659*t234 & - *t1280)+(3._dp*t514*t155*t44*t1266)-(10._dp*t1726 & - *t506*t442*r3*t5)+(6._dp*t1732*t516)-(15._dp*t1736 & + t1742 = -(2._dp*t487*t519) + 0.40e2_dp/0.9e1_dp*t633*t687*t56 & + *t58 + ((12._dp*t1584*t1158 - 3._dp*t638*t1029 - 6._dp*t1589* & + t1158 + 2._dp*t641*t1029 + 2._dp*t206*t1594*t1158 - t206*t644 & + *t1029 - t243*t1374)*alpha6*t247*t249) - 0.4e1_dp/0.3e1_dp* & + t656*t72*t369 + (2._dp*t81*t108*t1151) + (t166*t1655 & + + t270*t1195)*alpha7*t279 + (6._dp*t91*t1661*t1151) + & + (t166*(0.27e2_dp/0.4e1_dp*(t184)*(t1667)*(t1158) - & + (3._dp*t184*t1671*t1158) - 0.3e1_dp/0.2e1_dp*(t184)*(t710) & + *(t1029) - 0.3e1_dp/0.4e1_dp*(t1678)*(t1158) & + + (t714*t1029)/0.2e1_dp) + f2716*t1195*t196)*alpha3*t145 & + *t151 + ((20._dp*t281*t1691*t1158 - 4._dp*t281*t561*t1029 & + - 12._dp*t1699*t1158 + 3._dp*t566*t1029 + 6._dp*t206*t565*t1158 & + - 2._dp*t206*t284*t1029 - 2._dp*t243*t284*t1158 + t243* & + t238*t1029 + t289*t1374)*alpha8*t296) + (10._dp*t659*t234 & + *t1280) + (3._dp*t514*t155*t44*t1266) - (10._dp*t1726 & + *t506*t442*r3*t5) + (6._dp*t1732*t516) - (15._dp*t1736 & *t234*t1737*t452) - e_rho_rho = e_rho_rho+(-0.4e1_dp/0.9e1_dp/t1141*f89*t299-0.8e1_dp/0.3e1_dp*t409* & - t727-t80*(t1392+t1517+t1577+t1742)*Clda)*sx + e_rho_rho = e_rho_rho + (-0.4e1_dp/0.9e1_dp/t1141*f89*t299 - 0.8e1_dp/0.3e1_dp*t409* & + t727 - t80*(t1392 + t1517 + t1577 + t1742)*Clda)*sx t1756 = t372*t407 t1768 = t569*t407 t1773 = d2exeirhondrho(Q, dQrho, dQndrho, d2Qrhondrho) @@ -3419,61 +3419,61 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1816 = d2exerrhondrho(Q, dQrho, dQndrho, d2Qrhondrho) t1824 = t759*t658 t1841 = t442*t407 - t1850 = ((20._dp*t281*t1691*t372*t407-4._dp*t281*t561*t1093 & - -12._dp*t1699*t1756+3._dp*t566*t1093+6._dp*t206*t565*t372 & - *t407-2._dp*t206*t284*t1093-2._dp*t243*t1768+t243*t238 & - *t1093+t289*t1773)*alpha8*t296)-t833*omega*t413 & - /0.3e1_dp-0.2e1_dp/0.3e1_dp*t839*t72*t369+(t166*(0.3e1_dp/0.4e1_dp & - *(t206)*(t1785)-(t206*t1788)/0.2e1_dp-0.27e2_dp & - /0.4e1_dp*t1168*t1791+(3._dp*t665*t1795)+0.3e1_dp/0.2e1_dp & - *(t665)*(t213)*(t1093)+0.75e2_dp/0.4e1_dp*(t218) & - *(t1181)*(t1178)*(t372)*(t407)-(10._dp & - *t218*t670*t186*t372*t407)-0.5e1_dp/0.2e1_dp*(t218) & - *(t671)*(t1093))-t230*t1816)*alpha5*t234-(3._dp & - *t106*t513*t1093)+0.5e1_dp/0.2e1_dp*t1824*t660-(2._dp & - *t740*t552)-0.8e1_dp/0.3e1_dp*t917*t293*t689-0.7e1_dp/0.3e1_dp & - *t903*t274*t699-0.15e2_dp/0.2e1_dp*t1736*t234*t453* & - (t407)-0.12e2_dp*(t106)*t1149*t118*t234*t1841+ & + t1850 = ((20._dp*t281*t1691*t372*t407 - 4._dp*t281*t561*t1093 & + - 12._dp*t1699*t1756 + 3._dp*t566*t1093 + 6._dp*t206*t565*t372 & + *t407 - 2._dp*t206*t284*t1093 - 2._dp*t243*t1768 + t243*t238 & + *t1093 + t289*t1773)*alpha8*t296) - t833*omega*t413 & + /0.3e1_dp - 0.2e1_dp/0.3e1_dp*t839*t72*t369 + (t166*(0.3e1_dp/0.4e1_dp & + *(t206)*(t1785) - (t206*t1788)/0.2e1_dp - 0.27e2_dp & + /0.4e1_dp*t1168*t1791 + (3._dp*t665*t1795) + 0.3e1_dp/0.2e1_dp & + *(t665)*(t213)*(t1093) + 0.75e2_dp/0.4e1_dp*(t218) & + *(t1181)*(t1178)*(t372)*(t407) - (10._dp & + *t218*t670*t186*t372*t407) - 0.5e1_dp/0.2e1_dp*(t218) & + *(t671)*(t1093)) - t230*t1816)*alpha5*t234 - (3._dp & + *t106*t513*t1093) + 0.5e1_dp/0.2e1_dp*t1824*t660 - (2._dp & + *t740*t552) - 0.8e1_dp/0.3e1_dp*t917*t293*t689 - 0.7e1_dp/0.3e1_dp & + *t903*t274*t699 - 0.15e2_dp/0.2e1_dp*t1736*t234*t453* & + (t407) - 0.12e2_dp*(t106)*t1149*t118*t234*t1841 + & 0.10e2_dp*t659*t234*t127*t452*(t407) t1885 = t160*t407 - t1938 = -0.5e1_dp/0.3e1_dp*t875*t154*t635+((12._dp*t1584*t1756 & - -3._dp*t638*t1093-6._dp*t1589*t1756+2._dp*t641*t1093+2._dp & - *t206*r1*t1768-t206*t644*t1093-t243*t1773)*alpha6 & - *t247*t249)-(2._dp*t510*t742)-(t81*t93*t1093) & - +(t158*(t1773+(t1093*t161-2._dp*t652*t407+2._dp*t1538 & - *t1756-t626*t1093)*t202*t160-t1545*t1885+t629*t407)) & - +(0.3e1_dp/0.4e1_dp*(t158)*(t166)*(t1552)*(t372) & - *(t407)-(t158*t496*t1093)/0.2e1_dp-t172* & - t1816)*alpha1*t177-(3._dp*t759*t622)-0.15e2_dp/0.2e1_dp* & - (t1736)*(t234)*(t1737)*(t407)+(3._dp*t514 & - *t155*t44*t1093)+((2._dp*t158*t615*t407-t158*t204 & - *t1093-f98*t1773)*alpha2*t112)+((-2._dp*t641*t1756 & - +t239*t1093+6._dp*t158*t282*t372*t407-2._dp*t158*t236 & - *t1093+t206*t1773)*alpha4*t210)+(6._dp*t474*t622 & + t1938 = -0.5e1_dp/0.3e1_dp*t875*t154*t635 + ((12._dp*t1584*t1756 & + - 3._dp*t638*t1093 - 6._dp*t1589*t1756 + 2._dp*t641*t1093 + 2._dp & + *t206*r1*t1768 - t206*t644*t1093 - t243*t1773)*alpha6 & + *t247*t249) - (2._dp*t510*t742) - (t81*t93*t1093) & + + (t158*(t1773 + (t1093*t161 - 2._dp*t652*t407 + 2._dp*t1538 & + *t1756 - t626*t1093)*t202*t160 - t1545*t1885 + t629*t407)) & + + (0.3e1_dp/0.4e1_dp*(t158)*(t166)*(t1552)*(t372) & + *(t407) - (t158*t496*t1093)/0.2e1_dp - t172* & + t1816)*alpha1*t177 - (3._dp*t759*t622) - 0.15e2_dp/0.2e1_dp* & + (t1736)*(t234)*(t1737)*(t407) + (3._dp*t514 & + *t155*t44*t1093) + ((2._dp*t158*t615*t407 - t158*t204 & + *t1093 - f98*t1773)*alpha2*t112) + ((-2._dp*t641*t1756 & + + t239*t1093 + 6._dp*t158*t282*t372*t407 - 2._dp*t158*t236 & + *t1093 + t206*t1773)*alpha4*t210) + (6._dp*t474*t622 & *t407) t1946 = t115*t1093 - t1976 = -0.4e1_dp/0.3e1_dp*t1031*t417-0.2e1_dp/0.3e1_dp*t302*t14 & - *t755*t6-(4._dp*t375*t420)-0.2e1_dp*t11*t311*t755+ & - (2._dp*t375*t434)+t11*t15*(-0.4e1_dp/0.3e1_dp*t747*t315 & - *t317-(4._dp*t748*t321)-0.16e2_dp/0.3e1_dp*t751*t324*t327 & - -(16._dp*t752*t331)) + t1976 = -0.4e1_dp/0.3e1_dp*t1031*t417 - 0.2e1_dp/0.3e1_dp*t302*t14 & + *t755*t6 - (4._dp*t375*t420) - 0.2e1_dp*t11*t311*t755 + & + (2._dp*t375*t434) + t11*t15*(-0.4e1_dp/0.3e1_dp*t747*t315 & + *t317 - (4._dp*t748*t321) - 0.16e2_dp/0.3e1_dp*t751*t324*t327 & + - (16._dp*t752*t331)) t1978 = t1976*E*t108 - t2018 = 0.147e3_dp/0.4e1_dp*t251*t1613*t1614*t372*t407-0.21e2_dp & - *t251*t522*t220*t372*t407-0.7e1_dp/0.2e1_dp*t251*t524 & - *t1093-0.75e2_dp/0.4e1_dp*t1630*t1626*t372*t407+0.10e2_dp & - *t530*t214*t372*t407+0.5e1_dp/0.2e1_dp*t530*t256*t1093 & - +0.27e2_dp/0.4e1_dp*t261*t1167*t1791-0.3e1_dp*t261*t535*t1795 & - -0.3e1_dp/0.2e1_dp*t261*t536*t1093-0.3e1_dp/0.4e1_dp*t243* & - t1785+t243*t1788/0.2e1_dp - t2053 = -0.4e1_dp/0.3e1_dp*t1031*t458-0.2e1_dp/0.3e1_dp*t302*t14 & - *t736*t6-(4._dp*t375*t461)-0.2e1_dp*t11*t311*t736+ & - (2._dp*t375*t468)+t11*t15*(F2*t1061*t68-t464* & - t404-t733*t365+2._dp*t85*t1073-t85*t1090) - t2056 = -(3._dp*t558*t761)-(2._dp*t91*t551*t1093)-t809 & - *t519+0.5e1_dp/0.2e1_dp*t659*t234*t1946+t1978+0.5e1_dp/0.2e1_dp & - *t1379*t816+(t166*t2018+t270*t1816)*alpha7*t279 & - -(2._dp*t886*t692)+(3._dp*t1732*t813)-t1978*t156 & - -t852*t519+f12*t2053*t94 + t2018 = 0.147e3_dp/0.4e1_dp*t251*t1613*t1614*t372*t407 - 0.21e2_dp & + *t251*t522*t220*t372*t407 - 0.7e1_dp/0.2e1_dp*t251*t524 & + *t1093 - 0.75e2_dp/0.4e1_dp*t1630*t1626*t372*t407 + 0.10e2_dp & + *t530*t214*t372*t407 + 0.5e1_dp/0.2e1_dp*t530*t256*t1093 & + + 0.27e2_dp/0.4e1_dp*t261*t1167*t1791 - 0.3e1_dp*t261*t535*t1795 & + - 0.3e1_dp/0.2e1_dp*t261*t536*t1093 - 0.3e1_dp/0.4e1_dp*t243* & + t1785 + t243*t1788/0.2e1_dp + t2053 = -0.4e1_dp/0.3e1_dp*t1031*t458 - 0.2e1_dp/0.3e1_dp*t302*t14 & + *t736*t6 - (4._dp*t375*t461) - 0.2e1_dp*t11*t311*t736 + & + (2._dp*t375*t468) + t11*t15*(F2*t1061*t68 - t464* & + t404 - t733*t365 + 2._dp*t85*t1073 - t85*t1090) + t2056 = -(3._dp*t558*t761) - (2._dp*t91*t551*t1093) - t809 & + *t519 + 0.5e1_dp/0.2e1_dp*t659*t234*t1946 + t1978 + 0.5e1_dp/0.2e1_dp & + *t1379*t816 + (t166*t2018 + t270*t1816)*alpha7*t279 & + - (2._dp*t886*t692) + (3._dp*t1732*t813) - t1978*t156 & + - t852*t519 + f12*t2053*t94 t2060 = t759*t513 t2066 = t1262*t769 t2069 = t125*t126 @@ -3486,53 +3486,53 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t2099 = t447*t127*t2071 t2105 = t125*t739 t2111 = t114*t1093 - t2115 = -0.5e1_dp/0.2e1_dp*t1417*t2066+(3._dp*t2069*t2072)- & - 0.5e1_dp/0.2e1_dp*t1417*t2076-(2._dp*t603*t475*t1841)+(t603 & - *t604*t1093)-0.75e2_dp/0.4e1_dp*t2084*t2086-0.3e1_dp/ & - 0.2e1_dp*t1473*t2090-(2._dp*t583*t441*t1841)+(t583 & - *t584*t1093)+0.10e2_dp*t2084*t2099+0.5e1_dp/0.2e1_dp*(t583) & - *(t587)*(t1946)+0.3e1_dp/0.2e1_dp*t2105*t608+0.3e1_dp & - /0.2e1_dp*t1453*t784+t2105*t605+0.3e1_dp/0.2e1_dp*(t603) & + t2115 = -0.5e1_dp/0.2e1_dp*t1417*t2066 + (3._dp*t2069*t2072) - & + 0.5e1_dp/0.2e1_dp*t1417*t2076 - (2._dp*t603*t475*t1841) + (t603 & + *t604*t1093) - 0.75e2_dp/0.4e1_dp*t2084*t2086 - 0.3e1_dp/ & + 0.2e1_dp*t1473*t2090 - (2._dp*t583*t441*t1841) + (t583 & + *t584*t1093) + 0.10e2_dp*t2084*t2099 + 0.5e1_dp/0.2e1_dp*(t583) & + *(t587)*(t1946) + 0.3e1_dp/0.2e1_dp*t2105*t608 + 0.3e1_dp & + /0.2e1_dp*t1453*t784 + t2105*t605 + 0.3e1_dp/0.2e1_dp*(t603) & *(t607)*(t2111) t2133 = t110*t758 t2136 = t1332*t783 t2155 = t1341*t115*t2071 - t2158 = -t1434*t595*t452*t407/0.2e1_dp-t110*t1976*t83* & - t118+t1407*t767-0.2e1_dp*t81*t108*t122*t442*t407-t125 & - *t2053*t83*t129+t1453*t781+0.5e1_dp/0.2e1_dp*t2133*t588 & - -0.3e1_dp/0.2e1_dp*t1473*t2136-t1434*t1435*t407/0.2e1_dp & - +t81*t591*t1093+t81*t596*t1093/0.2e1_dp-0.3e1_dp/0.4e1_dp & - *t84*t1442*t452*t407+0.5e1_dp/0.2e1_dp*t1407*t770+t2133 & - *t585-0.27e2_dp/0.4e1_dp*t2069*t2155 + t2158 = -t1434*t595*t452*t407/0.2e1_dp - t110*t1976*t83* & + t118 + t1407*t767 - 0.2e1_dp*t81*t108*t122*t442*t407 - t125 & + *t2053*t83*t129 + t1453*t781 + 0.5e1_dp/0.2e1_dp*t2133*t588 & + - 0.3e1_dp/0.2e1_dp*t1473*t2136 - t1434*t1435*t407/0.2e1_dp & + + t81*t591*t1093 + t81*t596*t1093/0.2e1_dp - 0.3e1_dp/0.4e1_dp & + *t84*t1442*t452*t407 + 0.5e1_dp/0.2e1_dp*t1407*t770 + t2133 & + *t585 - 0.27e2_dp/0.4e1_dp*t2069*t2155 t2180 = t136*t758 t2195 = t136*t137 - t2203 = -t136*t1976*t93*t118+(2._dp*t1251*t793)+0.5e1_dp & - /0.2e1_dp*(t1251)*(t796)+(2._dp*t2180*t443)-(6._dp & - *t440*t1256*t1841)-(5._dp*t1261*t2066)+(2._dp*t440 & - *t441*t1093)+0.5e1_dp/0.2e1_dp*(t2180)*(t454)-(5._dp & - *t1261*t2076)-0.75e2_dp/0.4e1_dp*t2195*t2086+0.10e2_dp* & - t2195*t2099+0.5e1_dp/0.2e1_dp*(t440)*(t448)*(t1946) + t2203 = -t136*t1976*t93*t118 + (2._dp*t1251*t793) + 0.5e1_dp & + /0.2e1_dp*(t1251)*(t796) + (2._dp*t2180*t443) - (6._dp & + *t440*t1256*t1841) - (5._dp*t1261*t2066) + (2._dp*t440 & + *t441*t1093) + 0.5e1_dp/0.2e1_dp*(t2180)*(t454) - (5._dp & + *t1261*t2076) - 0.75e2_dp/0.4e1_dp*t2195*t2086 + 0.10e2_dp* & + t2195*t2099 + 0.5e1_dp/0.2e1_dp*(t440)*(t448)*(t1946) t2211 = t140*t739 - t2233 = -t140*t2053*t93*t129+(2._dp*t1321*t802)+0.3e1_dp & - /0.2e1_dp*(t1321)*(t805)+(2._dp*t2211*t476)-(6._dp & - *t474*t1326*t1841)-(3._dp*t1331*t2136)+(2._dp*t474 & - *t475*t1093)+0.3e1_dp/0.2e1_dp*(t2211)*(t483)-(3._dp & - *t1331*t2090)-0.27e2_dp/0.4e1_dp*t95*t2155+0.3e1_dp*t95 & - *t2072+0.3e1_dp/0.2e1_dp*(t474)*(t481)*(t2111) - t2274 = -0.4e1_dp/0.3e1_dp*t860*t153*t491+(3._dp*t2060*t516) & - +0.5e1_dp/0.3e1_dp*t759*t441*t507+(t2115+t2158)*omega* & - t134+(12._dp*t106*t1149*t442*t407)-0.75e2_dp/0.4e1_dp*(t1397) & - *(t234)*(t1270)*(t452)*(t407)- & - t788*t413/0.3e1_dp+(t2203+t2233)*t145*t151+(t166*(0.27e2_dp & - /0.4e1_dp*(t184)*(t1666)*(t219)*(t372)* & - (t407)-(3._dp*t184*t709*t1546*t407)-0.3e1_dp/0.2e1_dp & - *(t184)*(t710)*(t1093)-0.3e1_dp/0.4e1_dp*t1678* & - t1756+(t714*t1093)/0.2e1_dp)+f2716*t1816*t196)*alpha3 & - *t145*t151-0.25e2_dp/0.6e1_dp*(t1362)*(t634)*(t5) & - *(t115)*(t407)+(2._dp*t81*t108*t442*t407) & - -(5._dp*t1726*t506*t6*t407) - e_ndrho_rho = e_ndrho_rho+(-0.4e1_dp/0.3e1_dp*t409*t920-t80*(t1850+t1938+t2056+ & - t2274)*Clda)*sx + t2233 = -t140*t2053*t93*t129 + (2._dp*t1321*t802) + 0.3e1_dp & + /0.2e1_dp*(t1321)*(t805) + (2._dp*t2211*t476) - (6._dp & + *t474*t1326*t1841) - (3._dp*t1331*t2136) + (2._dp*t474 & + *t475*t1093) + 0.3e1_dp/0.2e1_dp*(t2211)*(t483) - (3._dp & + *t1331*t2090) - 0.27e2_dp/0.4e1_dp*t95*t2155 + 0.3e1_dp*t95 & + *t2072 + 0.3e1_dp/0.2e1_dp*(t474)*(t481)*(t2111) + t2274 = -0.4e1_dp/0.3e1_dp*t860*t153*t491 + (3._dp*t2060*t516) & + + 0.5e1_dp/0.3e1_dp*t759*t441*t507 + (t2115 + t2158)*omega* & + t134 + (12._dp*t106*t1149*t442*t407) - 0.75e2_dp/0.4e1_dp*(t1397) & + *(t234)*(t1270)*(t452)*(t407) - & + t788*t413/0.3e1_dp + (t2203 + t2233)*t145*t151 + (t166*(0.27e2_dp & + /0.4e1_dp*(t184)*(t1666)*(t219)*(t372)* & + (t407) - (3._dp*t184*t709*t1546*t407) - 0.3e1_dp/0.2e1_dp & + *(t184)*(t710)*(t1093) - 0.3e1_dp/0.4e1_dp*t1678* & + t1756 + (t714*t1093)/0.2e1_dp) + f2716*t1816*t196)*alpha3 & + *t145*t151 - 0.25e2_dp/0.6e1_dp*(t1362)*(t634)*(t5) & + *(t115)*(t407) + (2._dp*t81*t108*t442*t407) & + - (5._dp*t1726*t506*t6*t407) + e_ndrho_rho = e_ndrho_rho + (-0.4e1_dp/0.3e1_dp*t409*t920 - t80*(t1850 + t1938 + t2056 + & + t2274)*Clda)*sx t2279 = t407**2 t2280 = t1157*t2279 t2283 = t541*t1139 @@ -3540,78 +3540,78 @@ SUBROUTINE xwpbe_lda_calc_2(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t2316 = t127*t2279 t2323 = t1270*t2279 t2336 = d2exeindrhondrho(Q, dQndrho, d2Qndrhondrho) - t2365 = 2._dp*t1095*t88+4._dp*t375*t737+t11*t15*(F2*t1111 & - *t68-2._dp*t733*t404+2._dp*t85*t1119-t85*t1136) - t2391 = (t166*(0.3e1_dp/0.4e1_dp*t206*t2280-t206*t2283/0.2e1_dp & - -0.27e2_dp/0.4e1_dp*t1168*t256*t2279+0.3e1_dp*t665*t75*t2279 & - +0.3e1_dp/0.2e1_dp*t665*t213*t1139+0.75e2_dp/0.4e1_dp*t218 & - *t1182*t2279-0.10e2_dp*t218*t1186*t2279-0.5e1_dp/0.2e1_dp* & - t218*t671*t1139)-t230*t2306)*alpha5*t234+(6._dp*t2060 & - *t813)-0.2e1_dp*t91*t551*t1139+0.10e2_dp*t659*t234* & - t2316+0.6e1_dp*t91*t1661*t2279-0.75e2_dp/0.4e1_dp*t1397*t234 & - *t2323+(-0.2e1_dp*t641*t2279+t239*t1139+0.6e1_dp*t158 & - *t282*t2279-0.2e1_dp*t158*t236*t1139+t206*t2336)*alpha4 & - *t210+0.3e1_dp*t514*t155*t44*t1139+(5._dp*t1824* & - t816)-(4._dp*t740*t742)-t81*t93*t1139+f12*t2365* & - t94-(6._dp*t759*t761)+0.2e1_dp*t81*t108*t2279+(0.12e2_dp & - *t1584*t2279-0.3e1_dp*t638*t1139-0.6e1_dp*t1589*t2279+ & - 0.2e1_dp*t641*t1139+0.2e1_dp*t206*t1594*t2279-t206*t644 & - *t1139-t243*t2336)*alpha6*t247*t249 - t2432 = 0.147e3_dp/0.4e1_dp*t251*t1615*t2279-0.21e2_dp*t251*t1619 & - *t2279-0.7e1_dp/0.2e1_dp*t251*t524*t1139-0.75e2_dp/0.4e1_dp & - *t1630*t1626*t2279+0.10e2_dp*t530*t214*t2279+0.5e1_dp/ & - 0.2e1_dp*t530*t256*t1139+0.27e2_dp/0.4e1_dp*t261*t1640*t2279 & - -0.3e1_dp*t261*t1644*t2279-0.3e1_dp/0.2e1_dp*t261*t536*t1139 & - -0.3e1_dp/0.4e1_dp*t243*t2280+t243*t2283/0.2e1_dp - t2452 = 2._dp*t1095*t103+4._dp*t375*t756+t11*t15*(2._dp*g2* & - t3*t19+12._dp*g3*t1*t24*t32) + t2365 = 2._dp*t1095*t88 + 4._dp*t375*t737 + t11*t15*(F2*t1111 & + *t68 - 2._dp*t733*t404 + 2._dp*t85*t1119 - t85*t1136) + t2391 = (t166*(0.3e1_dp/0.4e1_dp*t206*t2280 - t206*t2283/0.2e1_dp & + - 0.27e2_dp/0.4e1_dp*t1168*t256*t2279 + 0.3e1_dp*t665*t75*t2279 & + + 0.3e1_dp/0.2e1_dp*t665*t213*t1139 + 0.75e2_dp/0.4e1_dp*t218 & + *t1182*t2279 - 0.10e2_dp*t218*t1186*t2279 - 0.5e1_dp/0.2e1_dp* & + t218*t671*t1139) - t230*t2306)*alpha5*t234 + (6._dp*t2060 & + *t813) - 0.2e1_dp*t91*t551*t1139 + 0.10e2_dp*t659*t234* & + t2316 + 0.6e1_dp*t91*t1661*t2279 - 0.75e2_dp/0.4e1_dp*t1397*t234 & + *t2323 + (-0.2e1_dp*t641*t2279 + t239*t1139 + 0.6e1_dp*t158 & + *t282*t2279 - 0.2e1_dp*t158*t236*t1139 + t206*t2336)*alpha4 & + *t210 + 0.3e1_dp*t514*t155*t44*t1139 + (5._dp*t1824* & + t816) - (4._dp*t740*t742) - t81*t93*t1139 + f12*t2365* & + t94 - (6._dp*t759*t761) + 0.2e1_dp*t81*t108*t2279 + (0.12e2_dp & + *t1584*t2279 - 0.3e1_dp*t638*t1139 - 0.6e1_dp*t1589*t2279 + & + 0.2e1_dp*t641*t1139 + 0.2e1_dp*t206*t1594*t2279 - t206*t644 & + *t1139 - t243*t2336)*alpha6*t247*t249 + t2432 = 0.147e3_dp/0.4e1_dp*t251*t1615*t2279 - 0.21e2_dp*t251*t1619 & + *t2279 - 0.7e1_dp/0.2e1_dp*t251*t524*t1139 - 0.75e2_dp/0.4e1_dp & + *t1630*t1626*t2279 + 0.10e2_dp*t530*t214*t2279 + 0.5e1_dp/ & + 0.2e1_dp*t530*t256*t1139 + 0.27e2_dp/0.4e1_dp*t261*t1640*t2279 & + - 0.3e1_dp*t261*t1644*t2279 - 0.3e1_dp/0.2e1_dp*t261*t536*t1139 & + - 0.3e1_dp/0.4e1_dp*t243*t2280 + t243*t2283/0.2e1_dp + t2452 = 2._dp*t1095*t103 + 4._dp*t375*t756 + t11*t15*(2._dp*g2* & + t3*t19 + 12._dp*g3*t1*t24*t32) t2454 = t2452*E*t108 t2473 = t2279*t115 t2486 = t115*t1139 t2501 = t2279*t114 t2511 = t113*t2279 t2515 = t114*t1139 - t2519 = -t136*t2452*t93*t118+(4._dp*t2180*t793)+(5._dp & - *t2180*t796)-(6._dp*t440*t1256*t2279)-(10._dp*t440 & - *t658*t2473)+(2._dp*t440*t441*t1139)-0.75e2_dp/0.4e1_dp & - *(t440)*(t1274)*(t2323)+(10._dp*t440*t448 & - *t2316)+0.5e1_dp/0.2e1_dp*(t440)*(t448)*(t2486)- & - t140*t2365*t93*t129+(4._dp*t2211*t802)+(3._dp*t2211 & - *t805)-(6._dp*t474*t1326*t2279)-(6._dp*t474*t108 & - *t480*t2501)+(2._dp*t474*t475*t1139)-0.27e2_dp/0.4e1_dp & - *(t474)*(t1342)*(t2473)+(3._dp*t474*t481* & - t2511)+0.3e1_dp/0.2e1_dp*(t474)*(t481)*(t2515) - t2571 = -t110*t2452*t83*t118+(2._dp*t2133*t767)+(5._dp & - *t2133*t770)-(2._dp*t583*t441*t2279)+(t583*t584 & - *t1139)-(5._dp*t583*t448*t2473)+(10._dp*t583*t587 & - *t2316)+0.5e1_dp/0.2e1_dp*(t583)*(t587)*(t2486) & - -0.75e2_dp/0.4e1_dp*(t583)*(t1426)*(t2323)-(2._dp & - *t81*t1430*t2279)-(t81*t93*t595*t2279) - t2604 = t81*t591*t1139-0.3e1_dp/0.4e1_dp*t81*t1443*t2279+ & - t81*t596*t1139/0.2e1_dp-t125*t2365*t83*t129+(2._dp* & - t2105*t781)+(3._dp*t2105*t784)-0.2e1_dp*t603*t475*t2279 & - +t603*t604*t1139-0.3e1_dp*t603*t481*t2501+0.3e1_dp*t603 & - *t607*t2511+0.3e1_dp/0.2e1_dp*t603*t607*t2515-0.27e2_dp & + t2519 = -t136*t2452*t93*t118 + (4._dp*t2180*t793) + (5._dp & + *t2180*t796) - (6._dp*t440*t1256*t2279) - (10._dp*t440 & + *t658*t2473) + (2._dp*t440*t441*t1139) - 0.75e2_dp/0.4e1_dp & + *(t440)*(t1274)*(t2323) + (10._dp*t440*t448 & + *t2316) + 0.5e1_dp/0.2e1_dp*(t440)*(t448)*(t2486) - & + t140*t2365*t93*t129 + (4._dp*t2211*t802) + (3._dp*t2211 & + *t805) - (6._dp*t474*t1326*t2279) - (6._dp*t474*t108 & + *t480*t2501) + (2._dp*t474*t475*t1139) - 0.27e2_dp/0.4e1_dp & + *(t474)*(t1342)*(t2473) + (3._dp*t474*t481* & + t2511) + 0.3e1_dp/0.2e1_dp*(t474)*(t481)*(t2515) + t2571 = -t110*t2452*t83*t118 + (2._dp*t2133*t767) + (5._dp & + *t2133*t770) - (2._dp*t583*t441*t2279) + (t583*t584 & + *t1139) - (5._dp*t583*t448*t2473) + (10._dp*t583*t587 & + *t2316) + 0.5e1_dp/0.2e1_dp*(t583)*(t587)*(t2486) & + - 0.75e2_dp/0.4e1_dp*(t583)*(t1426)*(t2323) - (2._dp & + *t81*t1430*t2279) - (t81*t93*t595*t2279) + t2604 = t81*t591*t1139 - 0.3e1_dp/0.4e1_dp*t81*t1443*t2279 + & + t81*t596*t1139/0.2e1_dp - t125*t2365*t83*t129 + (2._dp* & + t2105*t781) + (3._dp*t2105*t784) - 0.2e1_dp*t603*t475*t2279 & + + t603*t604*t1139 - 0.3e1_dp*t603*t481*t2501 + 0.3e1_dp*t603 & + *t607*t2511 + 0.3e1_dp/0.2e1_dp*t603*t607*t2515 - 0.27e2_dp & /0.4e1_dp*t603*t1469*t2473 - t2668 = ((2._dp*t158*t236*t2279-t158*t204*t1139-f98* & - t2336)*alpha2*t112)+(t166*t2432+t270*t2306)*alpha7 & - *t279-t2454*t156-(12._dp*t1150*t155*t44*t2279)+(12._dp & - *t106*t1149*t2279)+t2519*t145*t151+0.5e1_dp/0.2e1_dp & - *t659*t234*t2486-0.15e2_dp*t1736*t234*t2473-(3._dp* & - t106*t513*t1139)+(0.3e1_dp/0.4e1_dp*(t158)*(t1553) & - *(t2279)-(t158*t496*t1139)/0.2e1_dp-t172*t2306) & - *alpha1*t177+t2454+(t2571+t2604)*omega*t134+(t166* & - (0.27e2_dp/0.4e1_dp*(t184)*(t1667)*(t2279)-(3._dp & - *t184*t1671*t2279)-0.3e1_dp/0.2e1_dp*(t184)*(t710) & - *(t1139)-0.3e1_dp/0.4e1_dp*(t1678)*(t2279)+(t714 & - *t1139)/0.2e1_dp)+f2716*t2306*t196)*alpha3*t145*t151 & - +(t158*(t2336+(t1139*t161-2._dp*t2279*t204+2._dp* & - t1538*t2279-t626*t1139)*t202*t160-t822*t238*t1885 & - +t823*t407))+((20._dp*t281*t1691*t2279-4._dp*t281*t561 & - *t1139-12._dp*t1699*t2279+3._dp*t566*t1139+6._dp*t206*t565 & - *t2279-2._dp*t206*t284*t1139-2._dp*t243*t284*t2279+t243 & - *t238*t1139+t289*t2336)*alpha8*t296) - e_ndrho_ndrho = e_ndrho_ndrho+(-t80*(t2391+t2668)*Clda)*sx + t2668 = ((2._dp*t158*t236*t2279 - t158*t204*t1139 - f98* & + t2336)*alpha2*t112) + (t166*t2432 + t270*t2306)*alpha7 & + *t279 - t2454*t156 - (12._dp*t1150*t155*t44*t2279) + (12._dp & + *t106*t1149*t2279) + t2519*t145*t151 + 0.5e1_dp/0.2e1_dp & + *t659*t234*t2486 - 0.15e2_dp*t1736*t234*t2473 - (3._dp* & + t106*t513*t1139) + (0.3e1_dp/0.4e1_dp*(t158)*(t1553) & + *(t2279) - (t158*t496*t1139)/0.2e1_dp - t172*t2306) & + *alpha1*t177 + t2454 + (t2571 + t2604)*omega*t134 + (t166* & + (0.27e2_dp/0.4e1_dp*(t184)*(t1667)*(t2279) - (3._dp & + *t184*t1671*t2279) - 0.3e1_dp/0.2e1_dp*(t184)*(t710) & + *(t1139) - 0.3e1_dp/0.4e1_dp*(t1678)*(t2279) + (t714 & + *t1139)/0.2e1_dp) + f2716*t2306*t196)*alpha3*t145*t151 & + + (t158*(t2336 + (t1139*t161 - 2._dp*t2279*t204 + 2._dp* & + t1538*t2279 - t626*t1139)*t202*t160 - t822*t238*t1885 & + + t823*t407)) + ((20._dp*t281*t1691*t2279 - 4._dp*t281*t561 & + *t1139 - 12._dp*t1699*t2279 + 3._dp*t566*t1139 + 6._dp*t206*t565 & + *t2279 - 2._dp*t206*t284*t1139 - 2._dp*t243*t284*t2279 + t243 & + *t238*t1139 + t289*t2336)*alpha8*t296) + e_ndrho_ndrho = e_ndrho_ndrho + (-t80*(t2391 + t2668)*Clda)*sx END IF END SUBROUTINE xwpbe_lda_calc_2 @@ -3720,7 +3720,7 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t29 = 0.1e1_dp/t28 t31 = t14**2 t32 = t27*t29*t31 - t34 = t17*t19+t25*t32 + t34 = t17*t19 + t25*t32 t35 = a3*t21 t36 = t35*t24 t38 = t21*ndrho @@ -3739,7 +3739,7 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t61 = t28**2 t63 = t31*t14 t65 = t60/t61*t63 - t67 = r1+t36*t32+t42*t49+t55*t65 + t67 = r1 + t36*t32 + t42*t49 + t55*t65 t68 = 0.1e1_dp/t67 t69 = t34*t68 t70 = t15*t69 @@ -3747,19 +3747,19 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t72 = omega**2 t73 = beta2*t72 t74 = t73*t10 - t75 = t71+t74 + t75 = t71 + t74 t77 = 0.1e1_dp/A Q = f94*t75*t77 t78 = rho**(0.1e1_dp/0.3e1_dp) t80 = t78*rho*f89 t81 = B*f12 - t82 = t71+DD + t82 = t71 + DD t83 = 0.1e1_dp/t82 t84 = t81*t83 t85 = F2*t34 - t87 = F1+t85*t68 + t87 = F1 + t85*t68 t88 = t15*t87 - t90 = t11*t88+r1 + t90 = t11*t88 + r1 t91 = f12*t90 t92 = t82**2 t93 = 0.1e1_dp/t92 @@ -3771,7 +3771,7 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t102 = r4*B t104 = r8*A t105 = t92*t82 - t108 = t97*(r15*E+t99*t90*t82+t102*t92+t104*t105) + t108 = t97*(r15*E + t99*t90*t82 + t102*t92 + t104*t105) t109 = 0.1e1_dp/r16 t110 = SQRT(t82) t111 = t110*t105 @@ -3795,17 +3795,17 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t133 = sscale*t132 t136 = erfc(t127*t128*t129*t133) t140 = 0.1e1_dp/f1516 - t141 = (t96+t108*t113-t96*t124*t136)*t140 + t141 = (t96 + t108*t113 - t96*t124*t136)*t140 t142 = 0.1e1_dp/t97 t144 = 0.1e1_dp/E t145 = t142*t111*t144 - t147 = -t141*t145+r1 + t147 = -t141*t145 + r1 t148 = t147*E t149 = 0.1e1_dp/t105 t150 = t148*t149 t151 = f158*E t152 = t147*t83 - t154 = t71+DD+t72*t10 + t154 = t71 + DD + t72*t10 t155 = t154**2 t156 = t155**2 t157 = t156*t154 @@ -3818,14 +3818,14 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t168 = t155*t154 t169 = SQRT(t168) t170 = 0.1e1_dp/t169 - t174 = (-t151*t152*t159-t81*t83*t163-t166*t167*t170) & + t174 = (-t151*t152*t159 - t81*t83*t163 - t166*t167*t170) & *omega t176 = f52*E t177 = t147*t93 t180 = f12*C t181 = t90*t93 t185 = t72*omega - t186 = (-t176*t177*t159-t180*t181*t170)*t185 + t186 = (-t176*t177*t159 - t180*t181*t170)*t185 t189 = 0.1e1_dp/r3/t5 t190 = t189*t129 t192 = t72**2 @@ -3834,12 +3834,12 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t195 = t194*t44 t197 = f12*A t198 = exei(Q) - t199 = t71+DD+t74 + t199 = t71 + DD + t74 t200 = 0.1e1_dp/t199 t202 = LOG(t75*t200) - t206 = (t84+t95+t150+t174*t128+t186*t190-t150*t195 & - +t197*(t198+t202))*Clda - e_0 = e_0+(-t80*t206)*sx + t206 = (t84 + t95 + t150 + t174*t128 + t186*t190 - t150*t195 & + + t197*(t198 + t202))*Clda + e_0 = e_0 + (-t80*t206)*sx END IF IF (order >= 1 .OR. order == -1) THEN t208 = t44*t13 @@ -3866,8 +3866,8 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t237 = t29*t31 t238 = t237*t6 t242 = t27*t46*t31 - t245 = -0.2e1_dp/0.3e1_dp*t223*t224-(2._dp*t17*t228)-0.4e1_dp & - /0.3e1_dp*t236*t238-(4._dp*t25*t242) + t245 = -0.2e1_dp/0.3e1_dp*t223*t224 - (2._dp*t17*t228) - 0.4e1_dp & + /0.3e1_dp*t236*t238 - (4._dp*t25*t242) t246 = t245*t68 t247 = t15*t246 t248 = t11*t247 @@ -3883,12 +3883,12 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t266 = 0.1e1_dp/t28/t12 t268 = t44*t266*t48 t274 = t60/t61/rho*t63 - t277 = -0.4e1_dp/0.3e1_dp*t252*t238-(4._dp*t36*t242)-0.5e1_dp & - /0.3e1_dp*t260*t262-(5._dp*t42*t268)-(8._dp*t55*t274) + t277 = -0.4e1_dp/0.3e1_dp*t252*t238 - (4._dp*t36*t242) - 0.5e1_dp & + /0.3e1_dp*t260*t262 - (5._dp*t42*t268) - (8._dp*t55*t274) t278 = t251*t277 t279 = t210*t278 t280 = t249*t279 - t285 = -t215-t221+t248-t280-0.2e1_dp/0.3e1_dp*t73*t44*r3 & + t285 = -t215 - t221 + t248 - t280 - 0.2e1_dp/0.3e1_dp*t73*t44*r3 & *t5 dQrho = f94*t285*t77 t287 = ndrho*t3 @@ -3898,7 +3898,7 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t295 = t1*ndrho t296 = a2*t295 t297 = t296*t24 - t300 = 2._dp*t292*t19+4._dp*t297*t32 + t300 = 2._dp*t292*t19 + 4._dp*t297*t32 t301 = t300*t68 t302 = t15*t301 t304 = a3*t295 @@ -3906,27 +3906,27 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t308 = a4*t21 t309 = t308*t41 t313 = a5*t38*t54 - t316 = 4._dp*t305*t32+5._dp*t309*t49+6._dp*t313*t65 + t316 = 4._dp*t305*t32 + 5._dp*t309*t49 + 6._dp*t313*t65 t317 = t251*t316 t318 = t210*t317 - t320 = 2._dp*t288*t70+t11*t302-t249*t318 + t320 = 2._dp*t288*t70 + t11*t302 - t249*t318 dQndrho = f94*t320*t77 t322 = t78*f89 - t325 = -t215-t221+t248-t280 + t325 = -t215 - t221 + t248 - t280 t328 = t14*t87 t329 = t328*t6 t332 = t218*t87 t335 = F2*t245 - t338 = t335*t68-t85*t278 + t338 = t335*t68 - t85*t278 t339 = t15*t338 - t341 = -0.2e1_dp/0.3e1_dp*t209*t329-(2._dp*t11*t332)+(t11 & - *t339) + t341 = -0.2e1_dp/0.3e1_dp*t209*t329 - (2._dp*t11*t332) + (t11 & + *t339) t342 = f12*t341 t344 = C*t149 t345 = t344*t325 t352 = t82*t325 - t359 = t97*(t99*t341*t82+t99*t90*t325+2._dp*t102*t352 & - +3._dp*t104*t92*t325) + t359 = t97*(t99*t341*t82 + t99*t90*t325 + 2._dp*t102*t352 & + + 3._dp*t104*t92*t325) t361 = t92**2 t364 = t109/t110/t361 t365 = t364*t325 @@ -3944,8 +3944,8 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t383 = t77*r3*t5 t384 = t381*t383 t388 = t119*t218*t77 - t391 = t370*t121-t374*t377-0.2e1_dp/0.3e1_dp*t380*t384-(2._dp & - *t118*t388) + t391 = t370*t121 - t374*t377 - 0.2e1_dp/0.3e1_dp*t380*t384 - (2._dp & + *t118*t388) t395 = rootpi t396 = 0.1e1_dp/t395 t397 = t123*t396 @@ -3963,18 +3963,18 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t418 = t246*t77 t419 = t34*t251 t420 = t77*t277 - t422 = t418-t419*t420 + t422 = t418 - t419*t420 t423 = t417*t422 t424 = t406*t423 - t428 = t403*(-t405*t406*t408/0.3e1_dp-t127*t128*t13*t133 & - +t416*t424/0.2e1_dp) + t428 = t403*(-t405*t406*t408/0.3e1_dp - t127*t128*t13*t133 & + + t416*t424/0.2e1_dp) t429 = t397*t428 - t433 = (t359*t113-0.7e1_dp/0.2e1_dp*t108*t365-(t368*t391 & - *t123*t136)+(2._dp*t368*t429))*t140 + t433 = (t359*t113 - 0.7e1_dp/0.2e1_dp*t108*t365 - (t368*t391 & + *t123*t136) + (2._dp*t368*t429))*t140 t435 = t141*t142 t437 = t110*t92*t144 t438 = t437*t325 - t441 = -t433*t145-0.7e1_dp/0.2e1_dp*t435*t438 + t441 = -t433*t145 - 0.7e1_dp/0.2e1_dp*t435*t438 t442 = t441*E t443 = t442*t149 t444 = 0.1e1_dp/t361 @@ -3984,7 +3984,7 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t453 = t452*t325 t456 = 0.1e1_dp/t158/t157 t457 = t83*t456 - t461 = -t215-t221+t248-t280-0.2e1_dp/0.3e1_dp*t72*t44*t6 + t461 = -t215 - t221 + t248 - t280 - 0.2e1_dp/0.3e1_dp*t72*t44*t6 t462 = t156*t461 t463 = t457*t462 t466 = t93*t163 @@ -3997,9 +3997,9 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t484 = t83*t483 t485 = t155*t461 t486 = t484*t485 - t490 = (-t151*t441*t83*t159+t451*t453+0.5e1_dp/0.2e1_dp*t451 & - *t463+t81*t466*t325+t81*t471*t461/0.2e1_dp-t166 & - *t341*t83*t170+t478*t480+0.3e1_dp/0.2e1_dp*t478*t486)* & + t490 = (-t151*t441*t83*t159 + t451*t453 + 0.5e1_dp/0.2e1_dp*t451 & + *t463 + t81*t466*t325 + t81*t471*t461/0.2e1_dp - t166 & + *t341*t83*t170 + t478*t480 + 0.3e1_dp/0.2e1_dp*t478*t486)* & omega t493 = t27*r3*t5 t499 = t176*t147 @@ -4012,9 +4012,9 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t513 = t512*t325 t516 = t93*t483 t517 = t516*t485 - t521 = (-t176*t441*t93*t159+(2._dp*t499*t501)+0.5e1_dp/ & - 0.2e1_dp*(t499)*(t505)-t180*t341*t93*t170+(2._dp & - *t511*t513)+0.3e1_dp/0.2e1_dp*(t511)*(t517))*t185 + t521 = (-t176*t441*t93*t159 + (2._dp*t499*t501) + 0.5e1_dp/ & + 0.2e1_dp*(t499)*(t505) - t180*t341*t93*t170 + (2._dp & + *t511*t513) + 0.3e1_dp/0.2e1_dp*(t511)*(t517))*t185 t523 = t189*t13 t526 = t148*t444 t528 = t194*t44*t325 @@ -4029,24 +4029,24 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t544 = t199**2 t545 = 0.1e1_dp/t544 t546 = t75*t545 - t548 = t285*t200-t546*t285 + t548 = t285*t200 - t546*t285 t549 = 0.1e1_dp/t75 t550 = t548*t549 - t554 = -t81*t93*t325+t342*t94-(2._dp*t91*t345)+t443 & - -(3._dp*t148*t445)+t490*t128-t174*t493/0.3e1_dp+t521 & - *t190-t186*t523-t443*t195+(3._dp*t526*t528)+0.5e1_dp & - /0.2e1_dp*t532*t534+0.5e1_dp/0.3e1_dp*t537*t539+t197*(t542 & - +t550*t199) + t554 = -t81*t93*t325 + t342*t94 - (2._dp*t91*t345) + t443 & + - (3._dp*t148*t445) + t490*t128 - t174*t493/0.3e1_dp + t521 & + *t190 - t186*t523 - t443*t195 + (3._dp*t526*t528) + 0.5e1_dp & + /0.2e1_dp*t532*t534 + 0.5e1_dp/0.3e1_dp*t537*t539 + t197*(t542 & + + t550*t199) t555 = t554*Clda - e_rho = e_rho+(-0.4e1_dp/0.3e1_dp*t322*t206-t80*t555)*sx + e_rho = e_rho + (-0.4e1_dp/0.3e1_dp*t322*t206 - t80*t555)*sx t561 = F2*t300 - t564 = t561*t68-t85*t317 + t564 = t561*t68 - t85*t317 t565 = t15*t564 - t567 = 2._dp*t288*t88+t11*t565 + t567 = 2._dp*t288*t88 + t11*t565 t568 = f12*t567 t570 = t344*t320 - t584 = t97*(t99*t567*t82+t99*t90*t320+2._dp*t102*t82 & - *t320+3._dp*t104*t92*t320) + t584 = t97*(t99*t567*t82 + t99*t90*t320 + 2._dp*t102*t82 & + *t320 + 3._dp*t104*t92*t320) t586 = t364*t320 t589 = f94*t300 t590 = t589*t117 @@ -4054,20 +4054,20 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t593 = t18*t592 t595 = t68*ndrho t596 = t116*t595 - t599 = t590*t121-t374*t593+2._dp*t596*t121 + t599 = t590*t121 - t374*t593 + 2._dp*t596*t121 t603 = f32*t126 t604 = t603*t128 t607 = t301*t77 t608 = t77*t316 - t610 = t607-t419*t608 + t610 = t607 - t419*t608 t611 = t417*t610 t612 = t406*t611 - t616 = t403*(t604*t406*t132+t416*t612/0.2e1_dp) + t616 = t403*(t604*t406*t132 + t416*t612/0.2e1_dp) t617 = t397*t616 - t621 = (t584*t113-0.7e1_dp/0.2e1_dp*t108*t586-(t368*t599 & - *t123*t136)+(2._dp*t368*t617))*t140 + t621 = (t584*t113 - 0.7e1_dp/0.2e1_dp*t108*t586 - (t368*t599 & + *t123*t136) + (2._dp*t368*t617))*t140 t623 = t437*t320 - t626 = -t621*t145-0.7e1_dp/0.2e1_dp*t435*t623 + t626 = -t621*t145 - 0.7e1_dp/0.2e1_dp*t435*t623 t627 = t626*E t628 = t627*t149 t629 = t444*t320 @@ -4077,28 +4077,28 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t649 = t479*t320 t651 = t155*t320 t652 = t484*t651 - t656 = (-t151*t626*t83*t159+t451*t635+0.5e1_dp/0.2e1_dp*t451 & - *t638+t81*t466*t320+t81*t471*t320/0.2e1_dp-t166 & - *t567*t83*t170+t478*t649+0.3e1_dp/0.2e1_dp*t478*t652)* & + t656 = (-t151*t626*t83*t159 + t451*t635 + 0.5e1_dp/0.2e1_dp*t451 & + *t638 + t81*t466*t320 + t81*t471*t320/0.2e1_dp - t166 & + *t567*t83*t170 + t478*t649 + 0.3e1_dp/0.2e1_dp*t478*t652)* & omega t661 = t500*t320 t664 = t504*t637 t670 = t512*t320 t673 = t516*t651 - t677 = (-t176*t626*t93*t159+(2._dp*t499*t661)+0.5e1_dp/ & - 0.2e1_dp*(t499)*(t664)-t180*t567*t93*t170+(2._dp & - *t511*t670)+0.3e1_dp/0.2e1_dp*(t511)*(t673))*t185 + t677 = (-t176*t626*t93*t159 + (2._dp*t499*t661) + 0.5e1_dp/ & + 0.2e1_dp*(t499)*(t664) - t180*t567*t93*t170 + (2._dp & + *t511*t670) + 0.3e1_dp/0.2e1_dp*(t511)*(t673))*t185 t681 = t194*t44*t320 t684 = t533*t637 t687 = dexeindrho(Q, dQndrho) - t690 = t320*t200-t546*t320 + t690 = t320*t200 - t546*t320 t691 = t690*t549 - t695 = -t81*t93*t320+t568*t94-(2._dp*t91*t570)+t628 & - -(3._dp*t148*t629)+t656*t128+t677*t190-t628*t195 & - +(3._dp*t526*t681)+0.5e1_dp/0.2e1_dp*t532*t684+t197*(t687 & - +t691*t199) + t695 = -t81*t93*t320 + t568*t94 - (2._dp*t91*t570) + t628 & + - (3._dp*t148*t629) + t656*t128 + t677*t190 - t628*t195 & + + (3._dp*t526*t681) + 0.5e1_dp/0.2e1_dp*t532*t684 + t197*(t687 & + + t691*t199) t696 = t695*Clda - e_ndrho = e_ndrho+(-t80*t696)*sx + e_ndrho = e_ndrho + (-t80*t696)*sx END IF IF (order >= 2 .OR. order == -2) THEN t698 = t258*t13 @@ -4122,10 +4122,10 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t748 = t237*t231 t752 = t46*t31*t6 t756 = t27*t266*t31 - t759 = 0.10e2_dp/0.9e1_dp*t16*t3*t258*t15*t231+0.8e1_dp/0.3e1_dp & - *t223*t218*t6+(6._dp*t17*t10*t29*t14)+0.28e2_dp/ & - 0.9e1_dp*t22*t746*t748+0.32e2_dp/0.3e1_dp*t236*t752+(20._dp & - *t25*t756) + t759 = 0.10e2_dp/0.9e1_dp*t16*t3*t258*t15*t231 + 0.8e1_dp/0.3e1_dp & + *t223*t218*t6 + (6._dp*t17*t10*t29*t14) + 0.28e2_dp/ & + 0.9e1_dp*t22*t746*t748 + 0.32e2_dp/0.3e1_dp*t236*t752 + (20._dp & + *t25*t756) t760 = t759*t68 t762 = t11*t15*t760 t765 = 2._dp*t249*t709*t278 @@ -4134,73 +4134,73 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t769 = t767*t768 t772 = 2._dp*t249*t210*t769 t781 = 0.1e1_dp/t9/t743 - t803 = 0.28e2_dp/0.9e1_dp*t35*t746*t748+0.32e2_dp/0.3e1_dp*t252* & - t752+(20._dp*t36*t756)+0.40e2_dp/0.9e1_dp*t39*t41*t781 & - *t261*t231+0.50e2_dp/0.3e1_dp*t260*t266*t48*t6+0.30e2_dp* & - t42*t44/t28/t216*t48+(72._dp*t55*t60/t61/t12* & - t63) + t803 = 0.28e2_dp/0.9e1_dp*t35*t746*t748 + 0.32e2_dp/0.3e1_dp*t252* & + t752 + (20._dp*t36*t756) + 0.40e2_dp/0.9e1_dp*t39*t41*t781 & + *t261*t231 + 0.50e2_dp/0.3e1_dp*t260*t266*t48*t6 + 0.30e2_dp* & + t42*t44/t28/t216*t48 + (72._dp*t55*t60/t61/t12* & + t63) t804 = t251*t803 t806 = t249*t210*t804 - t811 = t704+t708-t712+t717+t721-t724+t727+t762-t765 & - +t772-t806+0.10e2_dp/0.9e1_dp*t73*t258*t56*t58 + t811 = t704 + t708 - t712 + t717 + t721 - t724 + t727 + t762 - t765 & + + t772 - t806 + 0.10e2_dp/0.9e1_dp*t73*t258*t56*t58 d2Qrhorho = f94*t811*t77 t813 = t287*t208 t816 = t14*t300 t820 = t6*t316 - t843 = -0.4e1_dp/0.3e1_dp*t291*t222*t224-(4._dp*t292*t228) & - -0.16e2_dp/0.3e1_dp*t296*t235*t238-(16._dp*t297*t242) + t843 = -0.4e1_dp/0.3e1_dp*t291*t222*t224 - (4._dp*t292*t228) & + - 0.16e2_dp/0.3e1_dp*t296*t235*t238 - (16._dp*t297*t242) t844 = t843*t68 t849 = t287*t18 t855 = t767*t277*t316 - t871 = -0.16e2_dp/0.3e1_dp*t304*t235*t238-(16._dp*t305*t242) & - -0.25e2_dp/0.3e1_dp*t308*t259*t262-(25._dp*t309*t268)- & + t871 = -0.16e2_dp/0.3e1_dp*t304*t235*t238 - (16._dp*t305*t242) & + - 0.25e2_dp/0.3e1_dp*t308*t259*t262 - (25._dp*t309*t268) - & (48._dp*t313*t274) t872 = t251*t871 - t875 = -0.4e1_dp/0.3e1_dp*t813*t213-0.2e1_dp/0.3e1_dp*t209*t816* & - t212+0.2e1_dp/0.3e1_dp*t713*t419*t820-(4._dp*t288*t219) & - -(2._dp*t11*t218*t301)+(2._dp*t725*t318)+(2._dp* & - t288*t247)+(t11*t15*t844)-t249*t709*t317-(2._dp & - *t849*t279)-t249*t816*t278+0.2e1_dp*t249*t210*t855 & - -t249*t210*t872 + t875 = -0.4e1_dp/0.3e1_dp*t813*t213 - 0.2e1_dp/0.3e1_dp*t209*t816* & + t212 + 0.2e1_dp/0.3e1_dp*t713*t419*t820 - (4._dp*t288*t219) & + - (2._dp*t11*t218*t301) + (2._dp*t725*t318) + (2._dp* & + t288*t247) + (t11*t15*t844) - t249*t709*t317 - (2._dp & + *t849*t279) - t249*t816*t278 + 0.2e1_dp*t249*t210*t855 & + - t249*t210*t872 d2Qrhondrho = f94*t875*t77 t877 = t119*t13 t878 = t210*t68 - t892 = 2._dp*a1*t3*t19+12._dp*a2*t1*t24*t32 + t892 = 2._dp*a1*t3*t19 + 12._dp*a2*t1*t24*t32 t893 = t892*t68 t899 = t316**2 t900 = t767*t899 - t916 = 12._dp*a3*t1*t24*t32+20._dp*a4*t295*t41*t49+30._dp* & + t916 = 12._dp*a3*t1*t24*t32 + 20._dp*a4*t295*t41*t49 + 30._dp* & a5*t21*t54*t65 t917 = t251*t916 - t920 = 2._dp*t877*t878+4._dp*t288*t302-4._dp*t849*t318+t11* & - t15*t893-2._dp*t249*t816*t317+2._dp*t249*t210*t900-t249 & + t920 = 2._dp*t877*t878 + 4._dp*t288*t302 - 4._dp*t849*t318 + t11* & + t15*t893 - 2._dp*t249*t816*t317 + 2._dp*t249*t210*t900 - t249 & *t210*t917 d2Qndrhondrho = f94*t920*t77 t922 = t78**2 - t932 = t704+t708-t712+t717+t721-t724+t727+t762-t765 & - +t772-t806+0.10e2_dp/0.9e1_dp*t72*t258*t231 + t932 = t704 + t708 - t712 + t717 + t721 - t724 + t727 + t762 - t765 & + + t772 - t806 + 0.10e2_dp/0.9e1_dp*t72*t258*t231 t933 = t156*t932 - t964 = 0.10e2_dp/0.9e1_dp*t699*t328*t231+0.8e1_dp/0.3e1_dp*t706* & - t329-0.4e1_dp/0.3e1_dp*t209*t14*t338*t6+(6._dp*t11*t718 & - *t87)-0.4e1_dp*(t11)*t218*t338+(t11*t15*(F2 & - *t759*t68-2._dp*t335*t278+2._dp*t85*t769-t85*t804)) + t964 = 0.10e2_dp/0.9e1_dp*t699*t328*t231 + 0.8e1_dp/0.3e1_dp*t706* & + t329 - 0.4e1_dp/0.3e1_dp*t209*t14*t338*t6 + (6._dp*t11*t718 & + *t87) - 0.4e1_dp*(t11)*t218*t338 + (t11*t15*(F2 & + *t759*t68 - 2._dp*t335*t278 + 2._dp*t85*t769 - t85*t804)) t967 = t361*t82 t968 = 0.1e1_dp/t967 t969 = t325**2 t973 = t442*t444 - t976 = t704+t708-t712+t717+t721-t724+t727+t762-t765 & - +t772-t806 + t976 = t704 + t708 - t712 + t717 + t721 - t724 + t727 + t762 - t765 & + + t772 - t806 t1004 = 0.1e1_dp/t110/t967 t1005 = t109*t1004 t1015 = t369*t373 t1025 = t116*t767*t1*t3 t1032 = t116*t251*t4*t44 - t1056 = f94*t759*t117*t121-(2._dp*t1015*t377)-0.4e1_dp/ & - 0.3e1_dp*t369*t379*t384-(4._dp*t370*t388)+(2._dp*t1025 & - *t18*t375*t768)+0.4e1_dp/0.3e1_dp*t1032*t120*t714+(4._dp & - *t374*t227*t376)-(t374*t18*t375*t803)+0.10e2_dp & - /0.9e1_dp*t380*t698*t14*t77*t56*t58+0.8e1_dp/0.3e1_dp* & - t380*t705*t14*t383+0.6e1_dp*t118*t119*t718*t77 + t1056 = f94*t759*t117*t121 - (2._dp*t1015*t377) - 0.4e1_dp/ & + 0.3e1_dp*t369*t379*t384 - (4._dp*t370*t388) + (2._dp*t1025 & + *t18*t375*t768) + 0.4e1_dp/0.3e1_dp*t1032*t120*t714 + (4._dp & + *t374*t227*t376) - (t374*t18*t375*t803) + 0.10e2_dp & + /0.9e1_dp*t380*t698*t14*t77*t56*t58 + 0.8e1_dp/0.3e1_dp* & + t380*t705*t14*t383 + 0.6e1_dp*t118*t119*t718*t77 t1060 = t391**2 t1065 = t96*t115*t391 t1068 = t96*t124 @@ -4215,22 +4215,22 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1124 = t34*t767 t1143 = t433*t142 t1147 = t110*t82*t144 - t1154 = -((t97*(t99*t964*t82+2._dp*t99*t341*t325+t99 & - *t90*t976+2._dp*t102*t969+2._dp*t102*t82*t976+6._dp*t104 & - *t82*t969+3._dp*t104*t92*t976)*t113)-(7._dp*t359* & - t365)+0.63e2_dp/0.4e1_dp*(t108)*(t1005)*(t969)-0.7e1_dp & - /0.2e1_dp*(t108)*(t364)*(t976)-t368*t1056 & - *t123*t136-t368*t1060*t123*t136+(4._dp*t1065*t429) & - +0.2e1_dp*t1068*t396*(0.2e1_dp/0.3e1_dp*t399*t222*t13*t878 & - *t383+(2._dp*t400*t218*t131)-(t400*t15*t418) & - +t1079*t210*t1080*t277)*t428+0.2e1_dp*t368*t397*t403 & + t1154 = -((t97*(t99*t964*t82 + 2._dp*t99*t341*t325 + t99 & + *t90*t976 + 2._dp*t102*t969 + 2._dp*t102*t82*t976 + 6._dp*t104 & + *t82*t969 + 3._dp*t104*t92*t976)*t113) - (7._dp*t359* & + t365) + 0.63e2_dp/0.4e1_dp*(t108)*(t1005)*(t969) - 0.7e1_dp & + /0.2e1_dp*(t108)*(t364)*(t976) - t368*t1056 & + *t123*t136 - t368*t1060*t123*t136 + (4._dp*t1065*t429) & + + 0.2e1_dp*t1068*t396*(0.2e1_dp/0.3e1_dp*t399*t222*t13*t878 & + *t383 + (2._dp*t400*t218*t131) - (t400*t15*t418) & + + t1079*t210*t1080*t277)*t428 + 0.2e1_dp*t368*t397*t403 & *(0.4e1_dp/0.9e1_dp*t125*t126*t234*t406*t132*t56*t58 & - +0.2e1_dp/0.3e1_dp*t405*t1096*t408-t1101*t1102*t6*t422 & - /0.3e1_dp+(2._dp*t127*t128*t217*t133)-t416*t1096*t423 & - -t416*t406*t1114*t1115/0.4e1_dp+t416*t406*t417*(t760 & - *t77-2._dp*t1121*t420+2._dp*t1124*t77*t768-t419* & - t77*t803)/0.2e1_dp))*t140*t145-(7._dp*t1143*t438)-0.35e2_dp & - /0.4e1_dp*(t435)*(t1147)*(t969)-0.7e1_dp/0.2e1_dp & + + 0.2e1_dp/0.3e1_dp*t405*t1096*t408 - t1101*t1102*t6*t422 & + /0.3e1_dp + (2._dp*t127*t128*t217*t133) - t416*t1096*t423 & + - t416*t406*t1114*t1115/0.4e1_dp + t416*t406*t417*(t760 & + *t77 - 2._dp*t1121*t420 + 2._dp*t1124*t77*t768 - t419* & + t77*t803)/0.2e1_dp))*t140*t145 - (7._dp*t1143*t438) - 0.35e2_dp & + /0.4e1_dp*(t435)*(t1147)*(t969) - 0.7e1_dp/0.2e1_dp & *(t435)*(t437)*(t976) t1156 = t1154*E*t149 t1162 = t442*t531 @@ -4238,13 +4238,13 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1170 = t325*t156 t1178 = t444*t159 t1179 = t148*t1178 - t1189 = 0.5e1_dp/0.2e1_dp*t532*t533*t933-(6._dp*t442*t445) & - +f12*t964*t94+(12._dp*t148*t968*t969)+(6._dp*t973 & - *t528)-(3._dp*t148*t444*t976)+t1156-(t81*t93* & - t976)+(2._dp*t81*t149*t969)+(5._dp*t1162*t534)+0.10e2_dp & - /0.3e1_dp*(t442)*(t500)*(t539)-0.15e2_dp*t1169 & - *t533*t1170*t461-(2._dp*t91*t344*t976)-(10._dp* & - t1179*t538*t325*r3*t5)+0.4e1_dp/0.9e1_dp*t174*t234*t56 & + t1189 = 0.5e1_dp/0.2e1_dp*t532*t533*t933 - (6._dp*t442*t445) & + + f12*t964*t94 + (12._dp*t148*t968*t969) + (6._dp*t973 & + *t528) - (3._dp*t148*t444*t976) + t1156 - (t81*t93* & + t976) + (2._dp*t81*t149*t969) + (5._dp*t1162*t534) + 0.10e2_dp & + /0.3e1_dp*(t442)*(t500)*(t539) - 0.15e2_dp*t1169 & + *t533*t1170*t461 - (2._dp*t91*t344*t976) - (10._dp* & + t1179*t538*t325*r3*t5) + 0.4e1_dp/0.9e1_dp*t174*t234*t56 & *t58 t1193 = t176*t441 t1202 = t176*t147*t149 @@ -4266,15 +4266,15 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1252 = t156*t1215 t1256 = t154*t1215 t1260 = t155*t932 - t1264 = -t176*t1154*t93*t159+(4._dp*t1193*t501)+(5._dp & - *t1193*t505)-(6._dp*t499*t1178*t969)-(10._dp*t1202 & - *t1204)+(2._dp*t499*t500*t976)-0.75e2_dp/0.4e1_dp*(t499) & - *(t1214)*(t1216)+(10._dp*t499*t504*t1220) & - +0.5e1_dp/0.2e1_dp*(t499)*(t504)*(t933)-t180*t964 & - *t93*t170+(4._dp*t1230*t513)+(3._dp*t1230*t517) & - -(6._dp*t511*t1235*t969)-(6._dp*t1240*t1242)+(2._dp & - *t511*t512*t976)-0.27e2_dp/0.4e1_dp*(t511)*(t1251) & - *(t1252)+(3._dp*t511*t516*t1256)+0.3e1_dp/0.2e1_dp* & + t1264 = -t176*t1154*t93*t159 + (4._dp*t1193*t501) + (5._dp & + *t1193*t505) - (6._dp*t499*t1178*t969) - (10._dp*t1202 & + *t1204) + (2._dp*t499*t500*t976) - 0.75e2_dp/0.4e1_dp*(t499) & + *(t1214)*(t1216) + (10._dp*t499*t504*t1220) & + + 0.5e1_dp/0.2e1_dp*(t499)*(t504)*(t933) - t180*t964 & + *t93*t170 + (4._dp*t1230*t513) + (3._dp*t1230*t517) & + - (6._dp*t511*t1235*t969) - (6._dp*t1240*t1242) + (2._dp & + *t511*t512*t976) - 0.27e2_dp/0.4e1_dp*(t511)*(t1251) & + *(t1252) + (3._dp*t511*t516*t1256) + 0.3e1_dp/0.2e1_dp* & (t511)*(t516)*(t1260) t1273 = t148*t149*t1213 t1288 = t148*t531*t193 @@ -4287,21 +4287,21 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1316 = t83*t1315 t1326 = t166*t341 t1331 = t166*t181 - t1337 = -0.75e2_dp/0.4e1_dp*t451*t1300*t1216-(2._dp*t81*t1304 & - *t969)-t1308*t1309*t461+(t81*t466*t976)-0.3e1_dp & - /0.4e1_dp*(t81)*(t1316)*(t1215)+(t81*t471 & - *t932)/0.2e1_dp-t166*t964*t83*t170+(2._dp*t1326*t480) & - +(3._dp*t1326*t486)-(3._dp*t1331*t1242)-(2._dp* & - t478*t512*t969) + t1337 = -0.75e2_dp/0.4e1_dp*t451*t1300*t1216 - (2._dp*t81*t1304 & + *t969) - t1308*t1309*t461 + (t81*t466*t976) - 0.3e1_dp & + /0.4e1_dp*(t81)*(t1316)*(t1215) + (t81*t471 & + *t932)/0.2e1_dp - t166*t964*t83*t170 + (2._dp*t1326*t480) & + + (3._dp*t1326*t486) - (3._dp*t1331*t1242) - (2._dp* & + t478*t512*t969) t1346 = t83*t1250 t1350 = t151*t441 t1363 = t151*t177 - t1372 = (t478*t479*t976)+(3._dp*t478*t484*t1256)+ & - 0.3e1_dp/0.2e1_dp*(t478)*(t484)*(t1260)-0.27e2_dp/0.4e1_dp & - *(t478)*(t1346)*(t1252)+(2._dp*t1350*t453) & - -t151*t1154*t83*t159+(5._dp*t1350*t463)-(2._dp & - *t451*t500*t969)+(t451*t452*t976)-(5._dp*t1363 & - *t1204)+(10._dp*t451*t457*t1220)+0.5e1_dp/0.2e1_dp*(t451) & + t1372 = (t478*t479*t976) + (3._dp*t478*t484*t1256) + & + 0.3e1_dp/0.2e1_dp*(t478)*(t484)*(t1260) - 0.27e2_dp/0.4e1_dp & + *(t478)*(t1346)*(t1252) + (2._dp*t1350*t453) & + - t151*t1154*t83*t159 + (5._dp*t1350*t463) - (2._dp & + *t451*t500*t969) + (t451*t452*t976) - (5._dp*t1363 & + *t1204) + (10._dp*t451*t457*t1220) + 0.5e1_dp/0.2e1_dp*(t451) & *(t457)*(t933) t1382 = C*t444 t1386 = d2exeirhorho(Q, dQrho, d2Qrhorho) @@ -4310,53 +4310,53 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1400 = t75**2 t1401 = 0.1e1_dp/t1400 t1402 = t548*t1401 - t1408 = t1264*t185*t190+(10._dp*t532*t533*t1220)-(2._dp & - *t521*t523)-0.75e2_dp/0.4e1_dp*(t1273)*(t533)*(t1216) & - +(3._dp*t526*t194*t44*t976)-t1156*t195-0.2e1_dp & - /0.3e1_dp*t490*t493+(2._dp*t186*t189*t217)-0.25e2_dp & - /0.3e1_dp*t1288*t258*t156*t461*r3*t5-(12._dp*t1295* & - t194*t44*t969)+(t1337+t1372)*omega*t128-0.40e2_dp/0.9e1_dp & - *t537*t193*t781*t231-(4._dp*t342*t345)+(6._dp* & - t91*t1382*t969)+(t197*(t1386+(t811*t200-2._dp*t1388 & - *t545+2._dp*t1393*t1388-t546*t811)*t549*t199-t1402 & - *t199*t285+t550*t285)) - e_rho_rho = e_rho_rho+(-0.4e1_dp/0.9e1_dp/t922*f89*t206-0.8e1_dp/0.3e1_dp*t322*t555 & - -t80*(t1189+t1408)*Clda)*sx - t1437 = -0.4e1_dp/0.3e1_dp*t813*t329-0.2e1_dp/0.3e1_dp*t209*t14* & - t564*t6-(4._dp*t288*t332)-0.2e1_dp*t11*t218*t564+(2._dp & - *t288*t339)+t11*t15*(F2*t843*t68-t335*t317 & - -t561*t278+2._dp*t85*t855-t85*t872) + t1408 = t1264*t185*t190 + (10._dp*t532*t533*t1220) - (2._dp & + *t521*t523) - 0.75e2_dp/0.4e1_dp*(t1273)*(t533)*(t1216) & + + (3._dp*t526*t194*t44*t976) - t1156*t195 - 0.2e1_dp & + /0.3e1_dp*t490*t493 + (2._dp*t186*t189*t217) - 0.25e2_dp & + /0.3e1_dp*t1288*t258*t156*t461*r3*t5 - (12._dp*t1295* & + t194*t44*t969) + (t1337 + t1372)*omega*t128 - 0.40e2_dp/0.9e1_dp & + *t537*t193*t781*t231 - (4._dp*t342*t345) + (6._dp* & + t91*t1382*t969) + (t197*(t1386 + (t811*t200 - 2._dp*t1388 & + *t545 + 2._dp*t1393*t1388 - t546*t811)*t549*t199 - t1402 & + *t199*t285 + t550*t285)) + e_rho_rho = e_rho_rho + (-0.4e1_dp/0.9e1_dp/t922*f89*t206 - 0.8e1_dp/0.3e1_dp*t322*t555 & + - t80*(t1189 + t1408)*Clda)*sx + t1437 = -0.4e1_dp/0.3e1_dp*t813*t329 - 0.2e1_dp/0.3e1_dp*t209*t14* & + t564*t6 - (4._dp*t288*t332) - 0.2e1_dp*t11*t218*t564 + (2._dp & + *t288*t339) + t11*t15*(F2*t843*t68 - t335*t317 & + - t561*t278 + 2._dp*t85*t855 - t85*t872) t1446 = t320*t325 t1480 = t589*t373 t1482 = t420*t316 t1488 = t116*t251*ndrho*t3 - t1511 = (f94*t843*t117*t121)-t1015*t593+(2._dp*t369 & - *t595*t121)-(t1480*t377)+(2._dp*t1025*t19*t1482) & - -(2._dp*t1488*t377)-(t374*t18*t375*t871)-0.2e1_dp & - /0.3e1_dp*t589*t379*t384+0.2e1_dp/0.3e1_dp*t1032*t120* & - t820-0.4e1_dp/0.3e1_dp*t116*(t595)*t3*t384-(2._dp*t590 & - *t388)+(2._dp*t374*t227*t592)-(4._dp*t596*t388) + t1511 = (f94*t843*t117*t121) - t1015*t593 + (2._dp*t369 & + *t595*t121) - (t1480*t377) + (2._dp*t1025*t19*t1482) & + - (2._dp*t1488*t377) - (t374*t18*t375*t871) - 0.2e1_dp & + /0.3e1_dp*t589*t379*t384 + 0.2e1_dp/0.3e1_dp*t1032*t120* & + t820 - 0.4e1_dp/0.3e1_dp*t116*(t595)*t3*t384 - (2._dp*t590 & + *t388) + (2._dp*t374*t227*t592) - (4._dp*t596*t388) t1522 = t96*t115*t599 - t1535 = t396*(-2._dp*t398*ndrho*t119*t401-t400*t15*t607 & - +t1079*t210*t1080*t316) + t1535 = t396*(-2._dp*t398*ndrho*t119*t401 - t400*t15*t607 & + + t1079*t210*t1080*t316) t1562 = t300*t251 - t1578 = (t97*(t99*t1437*t82+t99*t341*t320+t99*t567 & - *t325+t99*t90*t875+2._dp*t102*t1446+2._dp*t102*t82 & - *t875+6._dp*t104*t352*t320+3._dp*t104*t92*t875)*t113)- & - 0.7e1_dp/0.2e1_dp*t359*t586-0.7e1_dp/0.2e1_dp*t584*t365+0.63e2_dp & + t1578 = (t97*(t99*t1437*t82 + t99*t341*t320 + t99*t567 & + *t325 + t99*t90*t875 + 2._dp*t102*t1446 + 2._dp*t102*t82 & + *t875 + 6._dp*t104*t352*t320 + 3._dp*t104*t92*t875)*t113) - & + 0.7e1_dp/0.2e1_dp*t359*t586 - 0.7e1_dp/0.2e1_dp*t584*t365 + 0.63e2_dp & /0.4e1_dp*(t108)*(t109)*(t1004)*(t325)*(t320) & - -0.7e1_dp/0.2e1_dp*(t108)*(t364)*(t875)- & - t368*t1511*t123*t136-t368*t391*t599*t123*t136+(2._dp & - *t1065*t617)+(2._dp*t1522*t429)+(2._dp*t1068* & - t1535*t428)+0.2e1_dp*t368*t397*t403*(-t603*t27*t129* & - t133*t6/0.3e1_dp-t1101*t1102*t6*t610/0.6e1_dp-t604*t1096 & - *t132-t416*t1096*t611/0.2e1_dp+t604*t424/0.2e1_dp-t416 & - *t406*t1114*t422*t610/0.4e1_dp+t416*t406*t417*(t844 & - *t77-t1121*t608-t1562*t420+2._dp*t1124*t1482- & + - 0.7e1_dp/0.2e1_dp*(t108)*(t364)*(t875) - & + t368*t1511*t123*t136 - t368*t391*t599*t123*t136 + (2._dp & + *t1065*t617) + (2._dp*t1522*t429) + (2._dp*t1068* & + t1535*t428) + 0.2e1_dp*t368*t397*t403*(-t603*t27*t129* & + t133*t6/0.3e1_dp - t1101*t1102*t6*t610/0.6e1_dp - t604*t1096 & + *t132 - t416*t1096*t611/0.2e1_dp + t604*t424/0.2e1_dp - t416 & + *t406*t1114*t422*t610/0.4e1_dp + t416*t406*t417*(t844 & + *t77 - t1121*t608 - t1562*t420 + 2._dp*t1124*t1482 - & t419*t77*t871)/0.2e1_dp) t1583 = t621*t142 - t1592 = -t1578*t140*t145-0.7e1_dp/0.2e1_dp*t1143*t623-0.7e1_dp & - /0.2e1_dp*t1583*t438-0.35e2_dp/0.4e1_dp*t435*t1147*t1446- & + t1592 = -t1578*t140*t145 - 0.7e1_dp/0.2e1_dp*t1143*t623 - 0.7e1_dp & + /0.2e1_dp*t1583*t438 - 0.35e2_dp/0.4e1_dp*t435*t1147*t1446 - & 0.7e1_dp/0.2e1_dp*t435*t437*t875 t1594 = t1592*E*t149 t1608 = d2exeirhondrho(Q, dQrho, dQndrho, d2Qrhondrho) @@ -4364,15 +4364,15 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1627 = t627*t444 t1632 = t156*t875 t1645 = t627*t531 - t1652 = -t1594*t195-t656*t493/0.3e1_dp-(3._dp*t442*t629) & - -0.25e2_dp/0.6e1_dp*t1288*t258*r3*t5*t156*t320-(3._dp & - *t627*t445)+t197*(t1608+(t875*t200-0.2e1_dp*t285*t545 & - *t320+0.2e1_dp*t1393*t285*t320-t546*t875)*t549*t199 & - -t1402*t1620+t550*t320)+0.5e1_dp/0.2e1_dp*t1162*t684+ & - (3._dp*t1627*t528)+(3._dp*t973*t681)+t1594+0.5e1_dp/0.2e1_dp & - *t532*t533*t1632-t677*t523+0.5e1_dp/0.3e1_dp*(t627) & - *(t500)*(t539)-0.12e2_dp*t148*t968*t159*t533 & - *t1446+0.5e1_dp/0.2e1_dp*t1645*t534+0.2e1_dp*t81*t149*t325 & + t1652 = -t1594*t195 - t656*t493/0.3e1_dp - (3._dp*t442*t629) & + - 0.25e2_dp/0.6e1_dp*t1288*t258*r3*t5*t156*t320 - (3._dp & + *t627*t445) + t197*(t1608 + (t875*t200 - 0.2e1_dp*t285*t545 & + *t320 + 0.2e1_dp*t1393*t285*t320 - t546*t875)*t549*t199 & + - t1402*t1620 + t550*t320) + 0.5e1_dp/0.2e1_dp*t1162*t684 + & + (3._dp*t1627*t528) + (3._dp*t973*t681) + t1594 + 0.5e1_dp/0.2e1_dp & + *t532*t533*t1632 - t677*t523 + 0.5e1_dp/0.3e1_dp*(t627) & + *(t500)*(t539) - 0.12e2_dp*t148*t968*t159*t533 & + *t1446 + 0.5e1_dp/0.2e1_dp*t1645*t534 + 0.2e1_dp*t81*t149*t325 & *t320 t1675 = t1241*t651 t1678 = t151*t626 @@ -4382,117 +4382,117 @@ SUBROUTINE xwpbe_lda_calc_3(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1692 = t483*t155*t1687 t1695 = t1203*t637 t1712 = t155*t875 - t1719 = 0.3e1_dp/0.2e1_dp*t1326*t652-0.3e1_dp/0.2e1_dp*t1331*t1675 & - +t1678*t453-(2._dp*t451*t500*t1446)+(t451*t452 & - *t875)-0.75e2_dp/0.4e1_dp*t1685*t1688-0.3e1_dp/0.2e1_dp*t1331 & - *t1692-0.5e1_dp/0.2e1_dp*t1363*t1695+t1350*t635-0.3e1_dp/ & - 0.4e1_dp*t84*t1315*t461*t320+0.5e1_dp/0.2e1_dp*t1678*t463- & - t1308*t470*t461*t320/0.2e1_dp-t1308*t1309*t320/0.2e1_dp & - +0.3e1_dp/0.2e1_dp*t478*t484*t1712-0.2e1_dp*t478*t512*(t1446) + t1719 = 0.3e1_dp/0.2e1_dp*t1326*t652 - 0.3e1_dp/0.2e1_dp*t1331*t1675 & + + t1678*t453 - (2._dp*t451*t500*t1446) + (t451*t452 & + *t875) - 0.75e2_dp/0.4e1_dp*t1685*t1688 - 0.3e1_dp/0.2e1_dp*t1331 & + *t1692 - 0.5e1_dp/0.2e1_dp*t1363*t1695 + t1350*t635 - 0.3e1_dp/ & + 0.4e1_dp*t84*t1315*t461*t320 + 0.5e1_dp/0.2e1_dp*t1678*t463 - & + t1308*t470*t461*t320/0.2e1_dp - t1308*t1309*t320/0.2e1_dp & + + 0.3e1_dp/0.2e1_dp*t478*t484*t1712 - 0.2e1_dp*t478*t512*(t1446) t1731 = t166*t567 t1737 = t166*t167 t1739 = t483*t154*t1687 t1747 = t1250*t156*t1687 t1753 = t456*t156*t1687 t1762 = t456*t168*t1687 - t1765 = (t478*t479*t875)-t166*t1437*t83*t170+t1326 & - *t649-(2._dp*t81*t149*t163*t325*t320)+0.3e1_dp/0.2e1_dp & - *t1731*t486+0.5e1_dp/0.2e1_dp*t451*t457*t1632+(3._dp* & - t1737*t1739)-t151*t1592*t83*t159+t1731*t480-0.27e2_dp & - /0.4e1_dp*(t1737)*(t1747)+(t81*t466*t875)- & - 0.5e1_dp/0.2e1_dp*t1363*t1753+0.5e1_dp/0.2e1_dp*t1350*t638+(t81 & - *t471*t875)/0.2e1_dp+(10._dp*t1685*t1762) + t1765 = (t478*t479*t875) - t166*t1437*t83*t170 + t1326 & + *t649 - (2._dp*t81*t149*t163*t325*t320) + 0.3e1_dp/0.2e1_dp & + *t1731*t486 + 0.5e1_dp/0.2e1_dp*t451*t457*t1632 + (3._dp* & + t1737*t1739) - t151*t1592*t83*t159 + t1731*t480 - 0.27e2_dp & + /0.4e1_dp*(t1737)*(t1747) + (t81*t466*t875) - & + 0.5e1_dp/0.2e1_dp*t1363*t1753 + 0.5e1_dp/0.2e1_dp*t1350*t638 + (t81 & + *t471*t875)/0.2e1_dp + (10._dp*t1685*t1762) t1781 = t176*t626 t1796 = t176*t177 - t1804 = -t176*t1592*t93*t159+(2._dp*t1193*t661)+0.5e1_dp & - /0.2e1_dp*(t1193)*(t664)+(2._dp*t1781*t501)-(6._dp & - *t499*t1178*t1446)-(5._dp*t1202*t1695)+(2._dp*t499 & - *t500*t875)+0.5e1_dp/0.2e1_dp*(t1781)*(t505)-(5._dp & - *t1202*t1753)-0.75e2_dp/0.4e1_dp*t1796*t1688+0.10e2_dp* & - t1796*t1762+0.5e1_dp/0.2e1_dp*(t499)*(t504)*(t1632) + t1804 = -t176*t1592*t93*t159 + (2._dp*t1193*t661) + 0.5e1_dp & + /0.2e1_dp*(t1193)*(t664) + (2._dp*t1781*t501) - (6._dp & + *t499*t1178*t1446) - (5._dp*t1202*t1695) + (2._dp*t499 & + *t500*t875) + 0.5e1_dp/0.2e1_dp*(t1781)*(t505) - (5._dp & + *t1202*t1753) - 0.75e2_dp/0.4e1_dp*t1796*t1688 + 0.10e2_dp* & + t1796*t1762 + 0.5e1_dp/0.2e1_dp*(t499)*(t504)*(t1632) t1812 = t180*t567 - t1834 = -t180*t1437*t93*t170+(2._dp*t1230*t670)+0.3e1_dp & - /0.2e1_dp*(t1230)*(t673)+(2._dp*t1812*t513)-(6._dp & - *t511*t1235*t1446)-(3._dp*t1240*t1675)+(2._dp*t511 & - *t512*t875)+0.3e1_dp/0.2e1_dp*(t1812)*(t517)-(3._dp & - *t1240*t1692)-0.27e2_dp/0.4e1_dp*t95*t1747+0.3e1_dp*t95 & - *t1739+0.3e1_dp/0.2e1_dp*(t511)*(t516)*(t1712) - t1860 = (6._dp*t511*t445*t320)+(3._dp*t526*t194*t44* & - t875)-(t81*t93*t875)-(3._dp*t148*t444*t875)-(2._dp & - *t568*t345)+f12*t1437*t94-(5._dp*t1179*t538* & - t6*t320)+(t1719+t1765)*omega*t128-0.75e2_dp/0.4e1_dp*(t1273) & - *(t533)*(t1210)*(t461)*(t320)+(t1804 & - +t1834)*t185*t190-0.15e2_dp/0.2e1_dp*(t1169)*(t533) & - *(t462)*(t320)+(12._dp*t148*t968*t325* & - t320)-(2._dp*t342*t570)-0.15e2_dp/0.2e1_dp*(t1169)*(t533) & - *(t1170)*(t320)+(10._dp*t532*t533*t168 & - *t461*t320)-(2._dp*t91*t344*t875) - e_ndrho_rho = e_ndrho_rho+(-0.4e1_dp/0.3e1_dp*t322*t696-t80*(t1652+t1860)*Clda)*sx - t1878 = 2._dp*t119*t88+4._dp*t288*t565+t11*t15*(F2*t892* & - t68-2._dp*t561*t317+2._dp*t85*t900-t85*t917) + t1834 = -t180*t1437*t93*t170 + (2._dp*t1230*t670) + 0.3e1_dp & + /0.2e1_dp*(t1230)*(t673) + (2._dp*t1812*t513) - (6._dp & + *t511*t1235*t1446) - (3._dp*t1240*t1675) + (2._dp*t511 & + *t512*t875) + 0.3e1_dp/0.2e1_dp*(t1812)*(t517) - (3._dp & + *t1240*t1692) - 0.27e2_dp/0.4e1_dp*t95*t1747 + 0.3e1_dp*t95 & + *t1739 + 0.3e1_dp/0.2e1_dp*(t511)*(t516)*(t1712) + t1860 = (6._dp*t511*t445*t320) + (3._dp*t526*t194*t44* & + t875) - (t81*t93*t875) - (3._dp*t148*t444*t875) - (2._dp & + *t568*t345) + f12*t1437*t94 - (5._dp*t1179*t538* & + t6*t320) + (t1719 + t1765)*omega*t128 - 0.75e2_dp/0.4e1_dp*(t1273) & + *(t533)*(t1210)*(t461)*(t320) + (t1804 & + + t1834)*t185*t190 - 0.15e2_dp/0.2e1_dp*(t1169)*(t533) & + *(t462)*(t320) + (12._dp*t148*t968*t325* & + t320) - (2._dp*t342*t570) - 0.15e2_dp/0.2e1_dp*(t1169)*(t533) & + *(t1170)*(t320) + (10._dp*t532*t533*t168 & + *t461*t320) - (2._dp*t91*t344*t875) + e_ndrho_rho = e_ndrho_rho + (-0.4e1_dp/0.3e1_dp*t322*t696 - t80*(t1652 + t1860)*Clda)*sx + t1878 = 2._dp*t119*t88 + 4._dp*t288*t565 + t11*t15*(F2*t892* & + t68 - 2._dp*t561*t317 + 2._dp*t85*t900 - t85*t917) t1886 = t320**2 t1935 = t599**2 t1945 = t610**2 - t1979 = -((t97*(t99*t1878*t82+2._dp*t99*t567*t320+t99 & - *t90*t920+2._dp*t102*t1886+2._dp*t102*t82*t920+6._dp*t104 & - *t82*t1886+3._dp*t104*t92*t920)*t113)-(7._dp*t584 & - *t586)+0.63e2_dp/0.4e1_dp*(t108)*(t1005)*(t1886) & - -0.7e1_dp/0.2e1_dp*(t108)*(t364)*(t920)-(t368 & - *(f94*t892*t117*t121-2._dp*t1480*t593+4._dp*t589*t595 & - *t121+2._dp*t1025*t18*t375*t899-4._dp*t1488*t593-t374 & - *t18*t375*t916+2._dp*t116*t68*t3*t18*t375)*t123*t136) & - -(t368*t1935*t123*t136)+(4._dp*t1522*t617)+ & - (2._dp*t1068*t1535*t616)+0.2e1_dp*(t368)*t397*t403 & - *(t604*t612-t416*t406*t1114*t1945/0.4e1_dp+t416*t406 & - *t417*(t893*t77-2._dp*t1562*t608+2._dp*t1124*t77* & - t899-t419*t77*t916)/0.2e1_dp))*t140*t145-(7._dp*t1583 & - *t623)-0.35e2_dp/0.4e1_dp*(t435)*(t1147)*(t1886) & - -0.7e1_dp/0.2e1_dp*(t435)*(t437)*(t920) + t1979 = -((t97*(t99*t1878*t82 + 2._dp*t99*t567*t320 + t99 & + *t90*t920 + 2._dp*t102*t1886 + 2._dp*t102*t82*t920 + 6._dp*t104 & + *t82*t1886 + 3._dp*t104*t92*t920)*t113) - (7._dp*t584 & + *t586) + 0.63e2_dp/0.4e1_dp*(t108)*(t1005)*(t1886) & + - 0.7e1_dp/0.2e1_dp*(t108)*(t364)*(t920) - (t368 & + *(f94*t892*t117*t121 - 2._dp*t1480*t593 + 4._dp*t589*t595 & + *t121 + 2._dp*t1025*t18*t375*t899 - 4._dp*t1488*t593 - t374 & + *t18*t375*t916 + 2._dp*t116*t68*t3*t18*t375)*t123*t136) & + - (t368*t1935*t123*t136) + (4._dp*t1522*t617) + & + (2._dp*t1068*t1535*t616) + 0.2e1_dp*(t368)*t397*t403 & + *(t604*t612 - t416*t406*t1114*t1945/0.4e1_dp + t416*t406 & + *t417*(t893*t77 - 2._dp*t1562*t608 + 2._dp*t1124*t77* & + t899 - t419*t77*t916)/0.2e1_dp))*t140*t145 - (7._dp*t1583 & + *t623) - 0.35e2_dp/0.4e1_dp*(t435)*(t1147)*(t1886) & + - 0.7e1_dp/0.2e1_dp*(t435)*(t437)*(t920) t1981 = t1979*E*t149 t1989 = t1886*t156 t1999 = t168*t1886 t2003 = t156*t920 t2007 = t1210*t1886 - t2013 = -t1981*t195+t1981+(6._dp*t1627*t681)+(3._dp*t526 & - *t194*t44*t920)-(15._dp*t1169*t533*t1989)+(5._dp & - *t1645*t684)-(12._dp*t1295*t194*t44*t1886)+(10._dp & - *t532*t533*t1999)+0.5e1_dp/0.2e1_dp*(t532)*(t533) & - *(t2003)-0.75e2_dp/0.4e1_dp*(t1273)*(t533)*(t2007) & - -(4._dp*t568*t570) + t2013 = -t1981*t195 + t1981 + (6._dp*t1627*t681) + (3._dp*t526 & + *t194*t44*t920) - (15._dp*t1169*t533*t1989) + (5._dp & + *t1645*t684) - (12._dp*t1295*t194*t44*t1886) + (10._dp & + *t532*t533*t1999) + 0.5e1_dp/0.2e1_dp*(t532)*(t533) & + *(t2003) - 0.75e2_dp/0.4e1_dp*(t1273)*(t533)*(t2007) & + - (4._dp*t568*t570) t2050 = t1886*t155 t2060 = t154*t1886 t2064 = t155*t920 - t2068 = -t176*t1979*t93*t159+(4._dp*t1781*t661)+(5._dp & - *t1781*t664)-(6._dp*t499*t1178*t1886)-(10._dp*t499 & - *t531*t1989)+(2._dp*t499*t500*t920)-0.75e2_dp/0.4e1_dp & - *(t499)*(t1214)*(t2007)+(10._dp*t499*t504* & - t1999)+0.5e1_dp/0.2e1_dp*(t499)*(t504)*(t2003)- & - t180*t1878*t93*t170+(4._dp*t1812*t670)+(3._dp*t1812 & - *t673)-(6._dp*t511*t1235*t1886)-(6._dp*t511*t149 & - *t483*t2050)+(2._dp*t511*t512*t920)-0.27e2_dp/0.4e1_dp* & - (t511)*(t1251)*(t1989)+(3._dp*t511*t516*t2060) & - +0.3e1_dp/0.2e1_dp*(t511)*(t516)*(t2064) - t2107 = -(2._dp*t451*t500*t1886)+(t451*t452*t920)- & - (5._dp*t451*t504*t1989)+(5._dp*t1678*t638)+(10._dp & - *t451*t457*t1999)+0.5e1_dp/0.2e1_dp*(t451)*(t457)* & - (t2003)-0.75e2_dp/0.4e1_dp*(t451)*(t1300)*(t2007) & - -(2._dp*t81*t1304*t1886)-(t81*t93*t470*t1886) & - +(t81*t466*t920)-0.3e1_dp/0.4e1_dp*(t81)*(t1316) & + t2068 = -t176*t1979*t93*t159 + (4._dp*t1781*t661) + (5._dp & + *t1781*t664) - (6._dp*t499*t1178*t1886) - (10._dp*t499 & + *t531*t1989) + (2._dp*t499*t500*t920) - 0.75e2_dp/0.4e1_dp & + *(t499)*(t1214)*(t2007) + (10._dp*t499*t504* & + t1999) + 0.5e1_dp/0.2e1_dp*(t499)*(t504)*(t2003) - & + t180*t1878*t93*t170 + (4._dp*t1812*t670) + (3._dp*t1812 & + *t673) - (6._dp*t511*t1235*t1886) - (6._dp*t511*t149 & + *t483*t2050) + (2._dp*t511*t512*t920) - 0.27e2_dp/0.4e1_dp* & + (t511)*(t1251)*(t1989) + (3._dp*t511*t516*t2060) & + + 0.3e1_dp/0.2e1_dp*(t511)*(t516)*(t2064) + t2107 = -(2._dp*t451*t500*t1886) + (t451*t452*t920) - & + (5._dp*t451*t504*t1989) + (5._dp*t1678*t638) + (10._dp & + *t451*t457*t1999) + 0.5e1_dp/0.2e1_dp*(t451)*(t457)* & + (t2003) - 0.75e2_dp/0.4e1_dp*(t451)*(t1300)*(t2007) & + - (2._dp*t81*t1304*t1886) - (t81*t93*t470*t1886) & + + (t81*t466*t920) - 0.3e1_dp/0.4e1_dp*(t81)*(t1316) & *(t1886) - t2140 = t81*t471*t920/0.2e1_dp-t166*t1878*t83*t170+(2._dp & - *t1731*t649)+(3._dp*t1731*t652)-(2._dp*t478*t512 & - *t1886)+(t478)*t479*t920-(3._dp*t478*t516*t2050) & - +(3._dp*t478*t484*t2060)+0.3e1_dp/0.2e1_dp*(t478)* & - (t484)*(t2064)-0.27e2_dp/0.4e1_dp*(t478)*(t1346) & - *(t1989)-t151*t1979*t83*t159+(2._dp*t1678*t635) + t2140 = t81*t471*t920/0.2e1_dp - t166*t1878*t83*t170 + (2._dp & + *t1731*t649) + (3._dp*t1731*t652) - (2._dp*t478*t512 & + *t1886) + (t478)*t479*t920 - (3._dp*t478*t516*t2050) & + + (3._dp*t478*t484*t2060) + 0.3e1_dp/0.2e1_dp*(t478)* & + (t484)*(t2064) - 0.27e2_dp/0.4e1_dp*(t478)*(t1346) & + *(t1989) - t151*t1979*t83*t159 + (2._dp*t1678*t635) t2159 = d2exeindrhondrho(Q, dQndrho, d2Qndrhondrho) - t2174 = t2068*t185*t190+6._dp*t91*t1382*t1886-2._dp*t91*t344 & - *t920+(t2107+t2140)*omega*t128+f12*t1878*t94- & - t81*t93*t920-6._dp*t627*t629-3._dp*t148*t444*t920+2._dp* & - t81*t149*t1886+12._dp*t148*t968*t1886+t197*(t2159+(t920 & - *t200-2._dp*t1886*t545+2._dp*t1393*t1886-t546*t920)* & - t549*t199-t690*t1401*t1620+t691*t320) - e_ndrho_ndrho = e_ndrho_ndrho+(-t80*(t2013+t2174)*Clda)*sx + t2174 = t2068*t185*t190 + 6._dp*t91*t1382*t1886 - 2._dp*t91*t344 & + *t920 + (t2107 + t2140)*omega*t128 + f12*t1878*t94 - & + t81*t93*t920 - 6._dp*t627*t629 - 3._dp*t148*t444*t920 + 2._dp* & + t81*t149*t1886 + 12._dp*t148*t968*t1886 + t197*(t2159 + (t920 & + *t200 - 2._dp*t1886*t545 + 2._dp*t1393*t1886 - t546*t920)* & + t549*t199 - t690*t1401*t1620 + t691*t320) + e_ndrho_ndrho = e_ndrho_ndrho + (-t80*(t2013 + t2174)*Clda)*sx END IF END SUBROUTINE xwpbe_lda_calc_3 @@ -4592,7 +4592,7 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t29 = 0.1e1_dp/t28 t31 = t14**2 t32 = t27*t29*t31 - t34 = t17*t19+t25*t32 + t34 = t17*t19 + t25*t32 t35 = a3*t21 t36 = t35*t24 t38 = t21*ndrho @@ -4611,7 +4611,7 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t61 = t28**2 t63 = t31*t14 t65 = t60/t61*t63 - t67 = r1+t36*t32+t42*t49+t55*t65 + t67 = r1 + t36*t32 + t42*t49 + t55*t65 t68 = 0.1e1_dp/t67 t69 = t34*t68 t70 = t15*t69 @@ -4619,19 +4619,19 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t72 = omega**2 t73 = beta2*t72 t74 = t73*t10 - t75 = t71+t74 + t75 = t71 + t74 t77 = 0.1e1_dp/A Q = f94*t75*t77 t78 = rho**(0.1e1_dp/0.3e1_dp) t80 = t78*rho*f89 t81 = B*f12 - t82 = t71+DD + t82 = t71 + DD t83 = 0.1e1_dp/t82 t84 = t81*t83 t85 = F2*t34 - t87 = F1+t85*t68 + t87 = F1 + t85*t68 t88 = t15*t87 - t90 = t11*t88+r1 + t90 = t11*t88 + r1 t91 = f12*t90 t92 = t82**2 t93 = 0.1e1_dp/t92 @@ -4641,15 +4641,15 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t97 = t96*t3 t99 = g3*t21 t100 = t99*t24 - t102 = g1+t97*t19+t100*t32 + t102 = g1 + t97*t19 + t100*t32 t103 = t15*t102 - t105 = t11*t103+r1 + t105 = t11*t103 + r1 t106 = t105*E t108 = 0.1e1_dp/t92/t82 t109 = t106*t108 t110 = f158*E t111 = t105*t83 - t113 = t71+DD+t72*t10 + t113 = t71 + DD + t72*t10 t114 = t113**2 t115 = t114**2 t116 = t115*t113 @@ -4662,7 +4662,7 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t127 = t114*t113 t128 = SQRT(t127) t129 = 0.1e1_dp/t128 - t133 = (-t110*t111*t118-t81*t83*t122-t125*t126*t129) & + t133 = (-t110*t111*t118 - t81*t83*t122 - t125*t126*t129) & *omega t134 = 0.1e1_dp/t8 t136 = f52*E @@ -4670,7 +4670,7 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t140 = f12*C t141 = t90*t93 t145 = t72*omega - t146 = (-t136*t137*t118-t140*t141*t129)*t145 + t146 = (-t136*t137*t118 - t140*t141*t129)*t145 t149 = 0.1e1_dp/r3/t5 t151 = t149/rho t153 = t72**2 @@ -4679,12 +4679,12 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t156 = t155*t44 t158 = f12*A t159 = exei(Q) - t160 = t71+DD+t74 + t160 = t71 + DD + t74 t161 = 0.1e1_dp/t160 t163 = LOG(t75*t161) - t167 = (t84+t95+t109+t133*t134+t146*t151-t109*t156 & - +t158*(t159+t163))*Clda - e_0 = e_0+(-t80*t167)*sx + t167 = (t84 + t95 + t109 + t133*t134 + t146*t151 - t109*t156 & + + t158*(t159 + t163))*Clda + e_0 = e_0 + (-t80*t167)*sx END IF IF (order >= 1 .OR. order == -1) THEN t169 = t44*t13 @@ -4711,8 +4711,8 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t198 = t29*t31 t199 = t198*t6 t203 = t27*t46*t31 - t206 = -0.2e1_dp/0.3e1_dp*t184*t185-(2._dp*t17*t189)-0.4e1_dp & - /0.3e1_dp*t197*t199-(4._dp*t25*t203) + t206 = -0.2e1_dp/0.3e1_dp*t184*t185 - (2._dp*t17*t189) - 0.4e1_dp & + /0.3e1_dp*t197*t199 - (4._dp*t25*t203) t207 = t206*t68 t208 = t15*t207 t209 = t11*t208 @@ -4728,12 +4728,12 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t227 = 0.1e1_dp/t28/t12 t229 = t44*t227*t48 t235 = t60/t61/rho*t63 - t238 = -0.4e1_dp/0.3e1_dp*t213*t199-(4._dp*t36*t203)-0.5e1_dp & - /0.3e1_dp*t221*t223-(5._dp*t42*t229)-(8._dp*t55*t235) + t238 = -0.4e1_dp/0.3e1_dp*t213*t199 - (4._dp*t36*t203) - 0.5e1_dp & + /0.3e1_dp*t221*t223 - (5._dp*t42*t229) - (8._dp*t55*t235) t239 = t212*t238 t240 = t171*t239 t241 = t210*t240 - t246 = -t176-t182+t209-t241-0.2e1_dp/0.3e1_dp*t73*t44*r3 & + t246 = -t176 - t182 + t209 - t241 - 0.2e1_dp/0.3e1_dp*t73*t44*r3 & *t5 dQrho = f94*t246*t77 t248 = ndrho*t3 @@ -4743,7 +4743,7 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t256 = t1*ndrho t257 = a2*t256 t258 = t257*t24 - t261 = 2._dp*t253*t19+4._dp*t258*t32 + t261 = 2._dp*t253*t19 + 4._dp*t258*t32 t262 = t261*t68 t263 = t15*t262 t265 = a3*t256 @@ -4751,21 +4751,21 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t269 = a4*t21 t270 = t269*t41 t274 = a5*t38*t54 - t277 = 4._dp*t266*t32+5._dp*t270*t49+6._dp*t274*t65 + t277 = 4._dp*t266*t32 + 5._dp*t270*t49 + 6._dp*t274*t65 t278 = t212*t277 t279 = t171*t278 - t281 = 2._dp*t249*t70+t11*t263-t210*t279 + t281 = 2._dp*t249*t70 + t11*t263 - t210*t279 dQndrho = f94*t281*t77 t283 = t78*f89 - t286 = -t176-t182+t209-t241 + t286 = -t176 - t182 + t209 - t241 t289 = t14*t87 t290 = t289*t6 t293 = t179*t87 t296 = F2*t206 - t299 = t296*t68-t85*t239 + t299 = t296*t68 - t85*t239 t300 = t15*t299 - t302 = -0.2e1_dp/0.3e1_dp*t170*t290-(2._dp*t11*t293)+(t11 & - *t300) + t302 = -0.2e1_dp/0.3e1_dp*t170*t290 - (2._dp*t11*t293) + (t11 & + *t300) t303 = f12*t302 t305 = C*t108 t306 = t305*t286 @@ -4774,11 +4774,11 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t313 = t179*t102 t316 = t96*t183 t321 = t99*t196 - t326 = -0.2e1_dp/0.3e1_dp*t316*t185-(2._dp*t97*t189)-0.4e1_dp & - /0.3e1_dp*t321*t199-(4._dp*t100*t203) + t326 = -0.2e1_dp/0.3e1_dp*t316*t185 - (2._dp*t97*t189) - 0.4e1_dp & + /0.3e1_dp*t321*t199 - (4._dp*t100*t203) t327 = t15*t326 - t329 = -0.2e1_dp/0.3e1_dp*t170*t310-(2._dp*t11*t313)+(t11 & - *t327) + t329 = -0.2e1_dp/0.3e1_dp*t170*t310 - (2._dp*t11*t313) + (t11 & + *t327) t330 = t329*E t331 = t330*t108 t332 = t92**2 @@ -4789,7 +4789,7 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t342 = t341*t286 t345 = 0.1e1_dp/t117/t116 t346 = t83*t345 - t350 = -t176-t182+t209-t241-0.2e1_dp/0.3e1_dp*t72*t44*t6 + t350 = -t176 - t182 + t209 - t241 - 0.2e1_dp/0.3e1_dp*t72*t44*t6 t351 = t115*t350 t352 = t346*t351 t355 = t93*t122 @@ -4802,9 +4802,9 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t373 = t83*t372 t374 = t114*t350 t375 = t373*t374 - t379 = (-t110*t329*t83*t118+t340*t342+0.5e1_dp/0.2e1_dp*t340 & - *t352+t81*t355*t286+t81*t360*t350/0.2e1_dp-t125 & - *t302*t83*t129+t367*t369+0.3e1_dp/0.2e1_dp*t367*t375)* & + t379 = (-t110*t329*t83*t118 + t340*t342 + 0.5e1_dp/0.2e1_dp*t340 & + *t352 + t81*t355*t286 + t81*t360*t350/0.2e1_dp - t125 & + *t302*t83*t129 + t367*t369 + 0.3e1_dp/0.2e1_dp*t367*t375)* & omega t382 = t27*r3*t5 t388 = t136*t105 @@ -4817,9 +4817,9 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t402 = t401*t286 t405 = t93*t372 t406 = t405*t374 - t410 = (-t136*t329*t93*t118+(2._dp*t388*t390)+0.5e1_dp/ & - 0.2e1_dp*(t388)*(t394)-t140*t302*t93*t129+(2._dp & - *t400*t402)+0.3e1_dp/0.2e1_dp*(t400)*(t406))*t145 + t410 = (-t136*t329*t93*t118 + (2._dp*t388*t390) + 0.5e1_dp/ & + 0.2e1_dp*(t388)*(t394) - t140*t302*t93*t129 + (2._dp & + *t400*t402) + 0.3e1_dp/0.2e1_dp*(t400)*(t406))*t145 t412 = t149*t13 t415 = t106*t333 t417 = t155*t44*t286 @@ -4834,29 +4834,29 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t433 = t160**2 t434 = 0.1e1_dp/t433 t435 = t75*t434 - t437 = t246*t161-t435*t246 + t437 = t246*t161 - t435*t246 t438 = 0.1e1_dp/t75 t439 = t437*t438 - t443 = -t81*t93*t286+t303*t94-(2._dp*t91*t306)+t331 & - -(3._dp*t106*t334)+t379*t134-t133*t382/0.3e1_dp+t410 & - *t151-t146*t412-t331*t156+(3._dp*t415*t417)+0.5e1_dp & - /0.2e1_dp*t421*t423+0.5e1_dp/0.3e1_dp*t426*t428+t158*(t431 & - +t439*t160) + t443 = -t81*t93*t286 + t303*t94 - (2._dp*t91*t306) + t331 & + - (3._dp*t106*t334) + t379*t134 - t133*t382/0.3e1_dp + t410 & + *t151 - t146*t412 - t331*t156 + (3._dp*t415*t417) + 0.5e1_dp & + /0.2e1_dp*t421*t423 + 0.5e1_dp/0.3e1_dp*t426*t428 + t158*(t431 & + + t439*t160) t444 = t443*Clda - e_rho = e_rho+(-0.4e1_dp/0.3e1_dp*t283*t167-t80*t444)*sx + e_rho = e_rho + (-0.4e1_dp/0.3e1_dp*t283*t167 - t80*t444)*sx t450 = F2*t261 - t453 = t450*t68-t85*t278 + t453 = t450*t68 - t85*t278 t454 = t15*t453 - t456 = 2._dp*t249*t88+t11*t454 + t456 = 2._dp*t249*t88 + t11*t454 t457 = f12*t456 t459 = t305*t281 t464 = g2*ndrho t465 = t464*t3 t468 = g3*t256 t469 = t468*t24 - t472 = 2._dp*t465*t19+4._dp*t469*t32 + t472 = 2._dp*t465*t19 + 4._dp*t469*t32 t473 = t15*t472 - t475 = 2._dp*t249*t103+t11*t473 + t475 = 2._dp*t249*t103 + t11*t473 t476 = t475*E t477 = t476*t108 t478 = t333*t281 @@ -4866,28 +4866,28 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t498 = t368*t281 t500 = t114*t281 t501 = t373*t500 - t505 = (-t110*t475*t83*t118+t340*t484+0.5e1_dp/0.2e1_dp*t340 & - *t487+t81*t355*t281+t81*t360*t281/0.2e1_dp-t125 & - *t456*t83*t129+t367*t498+0.3e1_dp/0.2e1_dp*t367*t501)* & + t505 = (-t110*t475*t83*t118 + t340*t484 + 0.5e1_dp/0.2e1_dp*t340 & + *t487 + t81*t355*t281 + t81*t360*t281/0.2e1_dp - t125 & + *t456*t83*t129 + t367*t498 + 0.3e1_dp/0.2e1_dp*t367*t501)* & omega t510 = t389*t281 t513 = t393*t486 t519 = t401*t281 t522 = t405*t500 - t526 = (-t136*t475*t93*t118+(2._dp*t388*t510)+0.5e1_dp/ & - 0.2e1_dp*(t388)*(t513)-t140*t456*t93*t129+(2._dp & - *t400*t519)+0.3e1_dp/0.2e1_dp*(t400)*(t522))*t145 + t526 = (-t136*t475*t93*t118 + (2._dp*t388*t510) + 0.5e1_dp/ & + 0.2e1_dp*(t388)*(t513) - t140*t456*t93*t129 + (2._dp & + *t400*t519) + 0.3e1_dp/0.2e1_dp*(t400)*(t522))*t145 t530 = t155*t44*t281 t533 = t422*t486 t536 = dexeindrho(Q, dQndrho) - t539 = t281*t161-t435*t281 + t539 = t281*t161 - t435*t281 t540 = t539*t438 - t544 = -t81*t93*t281+t457*t94-(2._dp*t91*t459)+t477 & - -(3._dp*t106*t478)+t505*t134+t526*t151-t477*t156 & - +(3._dp*t415*t530)+0.5e1_dp/0.2e1_dp*t421*t533+t158*(t536 & - +t540*t160) + t544 = -t81*t93*t281 + t457*t94 - (2._dp*t91*t459) + t477 & + - (3._dp*t106*t478) + t505*t134 + t526*t151 - t477*t156 & + + (3._dp*t415*t530) + 0.5e1_dp/0.2e1_dp*t421*t533 + t158*(t536 & + + t540*t160) t545 = t544*Clda - e_ndrho = e_ndrho+(-t80*t545)*sx + e_ndrho = e_ndrho + (-t80*t545)*sx END IF IF (order >= 2 .OR. order == -2) THEN t548 = t4*t219*t13 @@ -4913,9 +4913,9 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t599 = t198*t192 t603 = t46*t31*t6 t607 = t27*t227*t31 - t610 = 0.10e2_dp/0.9e1_dp*t16*t579*t581+0.8e1_dp/0.3e1_dp*t184* & - t584+(6._dp*t17*t588)+0.28e2_dp/0.9e1_dp*t22*t597*t599+ & - 0.32e2_dp/0.3e1_dp*t197*t603+(20._dp*t25*t607) + t610 = 0.10e2_dp/0.9e1_dp*t16*t579*t581 + 0.8e1_dp/0.3e1_dp*t184* & + t584 + (6._dp*t17*t588) + 0.28e2_dp/0.9e1_dp*t22*t597*t599 + & + 0.32e2_dp/0.3e1_dp*t197*t603 + (20._dp*t25*t607) t613 = t11*t15*t610*t68 t616 = 2._dp*t210*t558*t239 t618 = 0.1e1_dp/t211/t67 @@ -4923,40 +4923,40 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t620 = t618*t619 t623 = 2._dp*t210*t171*t620 t632 = 0.1e1_dp/t9/t594 - t655 = t212*(0.28e2_dp/0.9e1_dp*t35*t597*t599+0.32e2_dp/0.3e1_dp & - *t213*t603+(20._dp*t36*t607)+0.40e2_dp/0.9e1_dp*t39*t41 & - *t632*t222*t192+0.50e2_dp/0.3e1_dp*t221*t227*t48*t6+ & - 0.30e2_dp*t42*t44/t28/t177*t48+(72._dp*t55*t60/t61 & - /t12*t63)) + t655 = t212*(0.28e2_dp/0.9e1_dp*t35*t597*t599 + 0.32e2_dp/0.3e1_dp & + *t213*t603 + (20._dp*t36*t607) + 0.40e2_dp/0.9e1_dp*t39*t41 & + *t632*t222*t192 + 0.50e2_dp/0.3e1_dp*t221*t227*t48*t6 + & + 0.30e2_dp*t42*t44/t28/t177*t48 + (72._dp*t55*t60/t61 & + /t12*t63)) t657 = t210*t171*t655 - t662 = t553+t557-t561+t568+t572-t575+t578+t613-t616 & - +t623-t657+0.10e2_dp/0.9e1_dp*t73*t219*t56*t58 + t662 = t553 + t557 - t561 + t568 + t572 - t575 + t578 + t613 - t616 & + + t623 - t657 + 0.10e2_dp/0.9e1_dp*t73*t219*t56*t58 d2Qrhorho = f94*t662*t77 t664 = t248*t169 t667 = t14*t261 - t694 = -0.4e1_dp/0.3e1_dp*t252*t183*t185-(4._dp*t253*t189) & - -0.16e2_dp/0.3e1_dp*t257*t196*t199-(16._dp*t258*t203) + t694 = -0.4e1_dp/0.3e1_dp*t252*t183*t185 - (4._dp*t253*t189) & + - 0.16e2_dp/0.3e1_dp*t257*t196*t199 - (16._dp*t258*t203) t700 = t248*t18 t706 = t618*t238*t277 - t723 = t212*(-0.16e2_dp/0.3e1_dp*t265*t196*t199-(16._dp*t266 & - *t203)-0.25e2_dp/0.3e1_dp*t269*t220*t223-(25._dp*t270* & - t229)-(48._dp*t274*t235)) - t726 = -0.4e1_dp/0.3e1_dp*t664*t174-0.2e1_dp/0.3e1_dp*t170*t667* & - t173+0.2e1_dp/0.3e1_dp*t563*t564*t6*t277-(4._dp*t249* & - t180)-(2._dp*t11*t179*t262)+(2._dp*t576*t279)+(2._dp & - *t249*t208)+(t11*t15*t694*t68)-t210*t558*t278 & - -(2._dp*t700*t240)-t210*t667*t239+0.2e1_dp*t210* & - t171*t706-t210*t171*t723 + t723 = t212*(-0.16e2_dp/0.3e1_dp*t265*t196*t199 - (16._dp*t266 & + *t203) - 0.25e2_dp/0.3e1_dp*t269*t220*t223 - (25._dp*t270* & + t229) - (48._dp*t274*t235)) + t726 = -0.4e1_dp/0.3e1_dp*t664*t174 - 0.2e1_dp/0.3e1_dp*t170*t667* & + t173 + 0.2e1_dp/0.3e1_dp*t563*t564*t6*t277 - (4._dp*t249* & + t180) - (2._dp*t11*t179*t262) + (2._dp*t576*t279) + (2._dp & + *t249*t208) + (t11*t15*t694*t68) - t210*t558*t278 & + - (2._dp*t700*t240) - t210*t667*t239 + 0.2e1_dp*t210* & + t171*t706 - t210*t171*t723 d2Qrhondrho = f94*t726*t77 t728 = t3*t10 - t744 = 2._dp*a1*t3*t19+12._dp*a2*t1*t24*t32 + t744 = 2._dp*a1*t3*t19 + 12._dp*a2*t1*t24*t32 t751 = t277**2 t752 = t618*t751 - t769 = t212*(12._dp*a3*t1*t24*t32+20._dp*a4*t256*t41*t49 & - +30._dp*a5*t21*t54*t65) - t772 = 2._dp*t728*t13*t171*t68+4._dp*t249*t263-4._dp*t700*t279 & - +t11*t15*t744*t68-2._dp*t210*t667*t278+2._dp*t210* & - t171*t752-t210*t171*t769 + t769 = t212*(12._dp*a3*t1*t24*t32 + 20._dp*a4*t256*t41*t49 & + + 30._dp*a5*t21*t54*t65) + t772 = 2._dp*t728*t13*t171*t68 + 4._dp*t249*t263 - 4._dp*t700*t279 & + + t11*t15*t744*t68 - 2._dp*t210*t667*t278 + 2._dp*t210* & + t171*t752 - t210*t171*t769 d2Qndrhondrho = f94*t772*t77 t774 = t78**2 t782 = 0.1e1_dp/t332/t82 @@ -4970,23 +4970,23 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t799 = t108*t122 t803 = t81*t93 t804 = t359*t286 - t807 = t553+t557-t561+t568+t572-t575+t578+t613-t616 & - +t623-t657 + t807 = t553 + t557 - t561 + t568 + t572 - t575 + t578 + t613 - t616 & + + t623 - t657 t811 = 0.1e1_dp/t121/t114 t812 = t83*t811 - t819 = t553+t557-t561+t568+t572-t575+t578+t613-t616 & - +t623-t657+0.10e2_dp/0.9e1_dp*t72*t219*t192 - t848 = 0.10e2_dp/0.9e1_dp*t548*t289*t192+0.8e1_dp/0.3e1_dp*t555* & - t290-0.4e1_dp/0.3e1_dp*t170*t14*t299*t6+(6._dp*t11*t569 & - *t87)-0.4e1_dp*(t11)*t179*t299+(t11*t15*(F2 & - *t610*t68-2._dp*t296*t239+2._dp*t85*t620-t85*t655)) + t819 = t553 + t557 - t561 + t568 + t572 - t575 + t578 + t613 - t616 & + + t623 - t657 + 0.10e2_dp/0.9e1_dp*t72*t219*t192 + t848 = 0.10e2_dp/0.9e1_dp*t548*t289*t192 + 0.8e1_dp/0.3e1_dp*t555* & + t290 - 0.4e1_dp/0.3e1_dp*t170*t14*t299*t6 + (6._dp*t11*t569 & + *t87) - 0.4e1_dp*(t11)*t179*t299 + (t11*t15*(F2 & + *t610*t68 - 2._dp*t296*t239 + 2._dp*t85*t620 - t85*t655)) t852 = t125*t302 - t862 = -0.75e2_dp/0.4e1_dp*t340*t793*t795-(2._dp*t81*t799* & - t784)-t803*t804*t350+(t81*t355*t807)-0.3e1_dp/0.4e1_dp & - *(t81)*(t812)*(t794)+(t81*t360*t819) & - /0.2e1_dp-t125*t848*t83*t129+(2._dp*t852*t369)+(3._dp & - *t852*t375)-(2._dp*t367*t401*t784)+(t367*t368 & - *t807) + t862 = -0.75e2_dp/0.4e1_dp*t340*t793*t795 - (2._dp*t81*t799* & + t784) - t803*t804*t350 + (t81*t355*t807) - 0.3e1_dp/0.4e1_dp & + *(t81)*(t812)*(t794) + (t81*t360*t819) & + /0.2e1_dp - t125*t848*t83*t129 + (2._dp*t852*t369) + (3._dp & + *t852*t375) - (2._dp*t367*t401*t784) + (t367*t368 & + *t807) t863 = t125*t141 t864 = t372*t286 t865 = t864*t374 @@ -4995,24 +4995,24 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t878 = 0.1e1_dp/t128/t115/t114 t879 = t83*t878 t880 = t115*t794 - t916 = 0.10e2_dp/0.9e1_dp*t548*t309*t192+0.8e1_dp/0.3e1_dp*t555* & - t310-0.4e1_dp/0.3e1_dp*t170*t14*t326*t6+(6._dp*t11*t569 & - *t102)-0.4e1_dp*(t11)*t179*t326+(t11)*t15*(0.10e2_dp & - /0.9e1_dp*t96*t579*t581+0.8e1_dp/0.3e1_dp*t316*t584+ & - (6._dp*t97*t588)+0.28e2_dp/0.9e1_dp*t99*t597*t599+0.32e2_dp & - /0.3e1_dp*t321*t603+(20._dp*t100*t607)) + t916 = 0.10e2_dp/0.9e1_dp*t548*t309*t192 + 0.8e1_dp/0.3e1_dp*t555* & + t310 - 0.4e1_dp/0.3e1_dp*t170*t14*t326*t6 + (6._dp*t11*t569 & + *t102) - 0.4e1_dp*(t11)*t179*t326 + (t11)*t15*(0.10e2_dp & + /0.9e1_dp*t96*t579*t581 + 0.8e1_dp/0.3e1_dp*t316*t584 + & + (6._dp*t97*t588) + 0.28e2_dp/0.9e1_dp*t99*t597*t599 + 0.32e2_dp & + /0.3e1_dp*t321*t603 + (20._dp*t100*t607)) t920 = t110*t329 t930 = t110*t137 t931 = t345*t286 t932 = t931*t351 t935 = t127*t794 t939 = t115*t819 - t943 = -(3._dp*t863*t865)+(3._dp*t367*t373*t868)+0.3e1_dp & - /0.2e1_dp*(t367)*(t373)*(t872)-0.27e2_dp/0.4e1_dp & - *(t367)*(t879)*(t880)-t110*t916*t83*t118 & - +(2._dp*t920*t342)+(5._dp*t920*t352)-(2._dp*t340* & - t389*t784)+(t340*t341*t807)-(5._dp*t930*t932)+ & - (10._dp*t340*t346*t935)+0.5e1_dp/0.2e1_dp*(t340)*(t346) & + t943 = -(3._dp*t863*t865) + (3._dp*t367*t373*t868) + 0.3e1_dp & + /0.2e1_dp*(t367)*(t373)*(t872) - 0.27e2_dp/0.4e1_dp & + *(t367)*(t879)*(t880) - t110*t916*t83*t118 & + + (2._dp*t920*t342) + (5._dp*t920*t352) - (2._dp*t340* & + t389*t784) + (t340*t341*t807) - (5._dp*t930*t932) + & + (10._dp*t340*t346*t935) + 0.5e1_dp/0.2e1_dp*(t340)*(t346) & *(t939) t956 = t136*t329 t961 = t333*t118 @@ -5022,15 +5022,15 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t990 = t333*t129 t995 = t140*t90*t108 t1001 = t93*t878 - t1011 = -t136*t916*t93*t118+(4._dp*t956*t390)+(5._dp & - *t956*t394)-(6._dp*t388*t961*t784)-(10._dp*t966*t932) & - +(2._dp*t388*t389*t807)-0.75e2_dp/0.4e1_dp*(t388) & - *(t972)*(t795)+(10._dp*t388*t393*t935)+0.5e1_dp & - /0.2e1_dp*(t388)*(t393)*(t939)-t140*t848*t93 & - *t129+(4._dp*t985*t402)+(3._dp*t985*t406)-(6._dp* & - t400*t990*t784)-(6._dp*t995*t865)+(2._dp*t400*t401 & - *t807)-0.27e2_dp/0.4e1_dp*(t400)*(t1001)*(t880) & - +(3._dp*t400*t405*t868)+0.3e1_dp/0.2e1_dp*(t400)*(t405) & + t1011 = -t136*t916*t93*t118 + (4._dp*t956*t390) + (5._dp & + *t956*t394) - (6._dp*t388*t961*t784) - (10._dp*t966*t932) & + + (2._dp*t388*t389*t807) - 0.75e2_dp/0.4e1_dp*(t388) & + *(t972)*(t795) + (10._dp*t388*t393*t935) + 0.5e1_dp & + /0.2e1_dp*(t388)*(t393)*(t939) - t140*t848*t93 & + *t129 + (4._dp*t985*t402) + (3._dp*t985*t406) - (6._dp* & + t400*t990*t784) - (6._dp*t995*t865) + (2._dp*t400*t401 & + *t807) - 0.27e2_dp/0.4e1_dp*(t400)*(t1001)*(t880) & + + (3._dp*t400*t405*t868) + 0.3e1_dp/0.2e1_dp*(t400)*(t405) & *(t872) t1017 = t106*t961 t1026 = t106*t420*t154 @@ -5043,34 +5043,34 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1065 = t106*t333*t345 t1066 = t286*t115 t1071 = t330*t420 - t1074 = -(12._dp*t783*t155*t44*t784)+(t862+t943)*omega & - *t134+f12*t848*t94+0.4e1_dp/0.9e1_dp*t133*t195*t56* & - t58+t1011*t145*t151+(12._dp*t106*t782*t784)-(10._dp & - *t1017*t427*t286*r3*t5)-(t81*t93*t807)-0.25e2_dp & + t1074 = -(12._dp*t783*t155*t44*t784) + (t862 + t943)*omega & + *t134 + f12*t848*t94 + 0.4e1_dp/0.9e1_dp*t133*t195*t56* & + t58 + t1011*t145*t151 + (12._dp*t106*t782*t784) - (10._dp & + *t1017*t427*t286*r3*t5) - (t81*t93*t807) - 0.25e2_dp & /0.3e1_dp*(t1026)*(t219)*(t115)*(t350)* & - (r3)*(t5)+(t158*(t1033+(t662*t161-2._dp*t1035 & - *t434+2._dp*t1040*t1035-t435*t662)*t438*t160-t1049 & - *t160*t246+t439*t246))+(3._dp*t415*t155*t44*t807) & - +(2._dp*t81*t108*t784)-(4._dp*t303*t306)-(15._dp* & - t1065*t422*t1066*t350)+(5._dp*t1071*t423) + (r3)*(t5) + (t158*(t1033 + (t662*t161 - 2._dp*t1035 & + *t434 + 2._dp*t1040*t1035 - t435*t662)*t438*t160 - t1049 & + *t160*t246 + t439*t246)) + (3._dp*t415*t155*t44*t807) & + + (2._dp*t81*t108*t784) - (4._dp*t303*t306) - (15._dp* & + t1065*t422*t1066*t350) + (5._dp*t1071*t423) t1082 = t106*t108*t792 t1089 = t330*t333 t1098 = t916*E*t108 t1111 = C*t333 - t1118 = 0.5e1_dp/0.2e1_dp*t421*t422*t939+(2._dp*t146*t149* & - t178)-0.75e2_dp/0.4e1_dp*t1082*t422*t795-(3._dp*t106*t333 & - *t807)+(6._dp*t1089*t417)+0.10e2_dp*t421*t422*t935 & - -0.2e1_dp/0.3e1_dp*t379*t382+t1098-0.40e2_dp/0.9e1_dp*t426*t154 & - *t632*t192-(2._dp*t410*t412)-(2._dp*t91*t305*t807) & - -(6._dp*t330*t334)-t1098*t156+(6._dp*t91*t1111 & - *t784)+0.10e2_dp/0.3e1_dp*(t330)*(t389)*(t428) - e_rho_rho = e_rho_rho+(-0.4e1_dp/0.9e1_dp/t774*f89*t167-0.8e1_dp/0.3e1_dp*t283*t444 & - -t80*(t1074+t1118)*Clda)*sx - t1155 = -0.4e1_dp/0.3e1_dp*t664*t310-0.2e1_dp/0.3e1_dp*t170*t14* & - t472*t6-(4._dp*t249*t313)-0.2e1_dp*t11*t179*t472+(2._dp & - *t249*t327)+t11*t15*(-0.4e1_dp/0.3e1_dp*t464*t183* & - t185-(4._dp*t465*t189)-0.16e2_dp/0.3e1_dp*t468*t196*t199 & - -(16._dp*t469*t203)) + t1118 = 0.5e1_dp/0.2e1_dp*t421*t422*t939 + (2._dp*t146*t149* & + t178) - 0.75e2_dp/0.4e1_dp*t1082*t422*t795 - (3._dp*t106*t333 & + *t807) + (6._dp*t1089*t417) + 0.10e2_dp*t421*t422*t935 & + - 0.2e1_dp/0.3e1_dp*t379*t382 + t1098 - 0.40e2_dp/0.9e1_dp*t426*t154 & + *t632*t192 - (2._dp*t410*t412) - (2._dp*t91*t305*t807) & + - (6._dp*t330*t334) - t1098*t156 + (6._dp*t91*t1111 & + *t784) + 0.10e2_dp/0.3e1_dp*(t330)*(t389)*(t428) + e_rho_rho = e_rho_rho + (-0.4e1_dp/0.9e1_dp/t774*f89*t167 - 0.8e1_dp/0.3e1_dp*t283*t444 & + - t80*(t1074 + t1118)*Clda)*sx + t1155 = -0.4e1_dp/0.3e1_dp*t664*t310 - 0.2e1_dp/0.3e1_dp*t170*t14* & + t472*t6 - (4._dp*t249*t313) - 0.2e1_dp*t11*t179*t472 + (2._dp & + *t249*t327) + t11*t15*(-0.4e1_dp/0.3e1_dp*t464*t183* & + t185 - (4._dp*t465*t189) - 0.16e2_dp/0.3e1_dp*t468*t196*t199 & + - (16._dp*t469*t203)) t1157 = t1155*E*t108 t1174 = t476*t333 t1181 = t931*t486 @@ -5083,117 +5083,117 @@ SUBROUTINE xwpbe_lda_calc_4(e_0, e_rho, e_ndrho, e_rho_rho, e_ndrho_rho, & t1210 = t792*t789*t1189 t1218 = t286*t281 t1224 = t125*t456 - t1231 = -0.5e1_dp/0.2e1_dp*t930*t1181+0.3e1_dp/0.2e1_dp*t367*t373 & - *t1184-0.3e1_dp/0.2e1_dp*t863*t1190-t803*t804*t281/0.2e1_dp & - +t81*t355*t726+0.5e1_dp/0.2e1_dp*t340*t346*t1198+t81 & - *t360*t726/0.2e1_dp+0.5e1_dp/0.2e1_dp*t1205*t352-0.75e2_dp/0.4e1_dp & - *t1208*t1210-0.2e1_dp*t81*t108*t122*t286*t281-0.2e1_dp & - *t340*t389*t1218+t340*t341*t726+0.3e1_dp/0.2e1_dp* & - t1224*t375-t110*t1155*t83*t118+t920*t484 - t1255 = -0.4e1_dp/0.3e1_dp*t664*t290-0.2e1_dp/0.3e1_dp*t170*t14* & - t453*t6-(4._dp*t249*t293)-0.2e1_dp*t11*t179*t453+(2._dp & - *t249*t300)+t11*t15*(F2*t694*t68-t296*t278 & - -t450*t239+2._dp*t85*t706-t85*t723) + t1231 = -0.5e1_dp/0.2e1_dp*t930*t1181 + 0.3e1_dp/0.2e1_dp*t367*t373 & + *t1184 - 0.3e1_dp/0.2e1_dp*t863*t1190 - t803*t804*t281/0.2e1_dp & + + t81*t355*t726 + 0.5e1_dp/0.2e1_dp*t340*t346*t1198 + t81 & + *t360*t726/0.2e1_dp + 0.5e1_dp/0.2e1_dp*t1205*t352 - 0.75e2_dp/0.4e1_dp & + *t1208*t1210 - 0.2e1_dp*t81*t108*t122*t286*t281 - 0.2e1_dp & + *t340*t389*t1218 + t340*t341*t726 + 0.3e1_dp/0.2e1_dp* & + t1224*t375 - t110*t1155*t83*t118 + t920*t484 + t1255 = -0.4e1_dp/0.3e1_dp*t664*t290 - 0.2e1_dp/0.3e1_dp*t170*t14* & + t453*t6 - (4._dp*t249*t293) - 0.2e1_dp*t11*t179*t453 + (2._dp & + *t249*t300) + t11*t15*(F2*t694*t68 - t296*t278 & + - t450*t239 + 2._dp*t85*t706 - t85*t723) t1261 = t345*t115*t1189 t1264 = t125*t126 t1266 = t878*t115*t1189 t1270 = t345*t127*t1189 t1277 = t372*t113*t1189 t1288 = t864*t500 - t1299 = -t125*t1255*t83*t129+t852*t498-0.5e1_dp/0.2e1_dp* & - t930*t1261-0.27e2_dp/0.4e1_dp*t1264*t1266+(10._dp*t1208* & - t1270)+0.3e1_dp/0.2e1_dp*t852*t501+t1224*t369+0.3e1_dp*t1264 & - *t1277-0.3e1_dp/0.4e1_dp*t84*t811*t350*t281-t803*t359 & - *t350*t281/0.2e1_dp-0.3e1_dp/0.2e1_dp*t863*t1288-(2._dp*t367 & - *t401*t1218)+(t367*t368*t726)+0.5e1_dp/0.2e1_dp*t920 & - *t487+t1205*t342 - t1319 = -0.75e2_dp/0.4e1_dp*t1082*t422*t789*t350*t281-t1157 & - *t156-0.15e2_dp/0.2e1_dp*t1065*t422*t1066*t281+t1157-(2._dp & - *t303*t459)+0.5e1_dp/0.3e1_dp*t476*t389*t428-0.25e2_dp & - /0.6e1_dp*t1026*t219*r3*t5*t115*t281+(3._dp*t1174* & - t417)-t526*t412-(2._dp*t91*t305*t726)+(t1231+t1299) & - *omega*t134+0.6e1_dp*t400*t334*t281-0.5e1_dp*t1017*t427 & - *t6*t281+0.10e2_dp*t421*t422*t127*t350*t281-(2._dp & - *t457*t306)+0.5e1_dp/0.2e1_dp*t1071*t533 + t1299 = -t125*t1255*t83*t129 + t852*t498 - 0.5e1_dp/0.2e1_dp* & + t930*t1261 - 0.27e2_dp/0.4e1_dp*t1264*t1266 + (10._dp*t1208* & + t1270) + 0.3e1_dp/0.2e1_dp*t852*t501 + t1224*t369 + 0.3e1_dp*t1264 & + *t1277 - 0.3e1_dp/0.4e1_dp*t84*t811*t350*t281 - t803*t359 & + *t350*t281/0.2e1_dp - 0.3e1_dp/0.2e1_dp*t863*t1288 - (2._dp*t367 & + *t401*t1218) + (t367*t368*t726) + 0.5e1_dp/0.2e1_dp*t920 & + *t487 + t1205*t342 + t1319 = -0.75e2_dp/0.4e1_dp*t1082*t422*t789*t350*t281 - t1157 & + *t156 - 0.15e2_dp/0.2e1_dp*t1065*t422*t1066*t281 + t1157 - (2._dp & + *t303*t459) + 0.5e1_dp/0.3e1_dp*t476*t389*t428 - 0.25e2_dp & + /0.6e1_dp*t1026*t219*r3*t5*t115*t281 + (3._dp*t1174* & + t417) - t526*t412 - (2._dp*t91*t305*t726) + (t1231 + t1299) & + *omega*t134 + 0.6e1_dp*t400*t334*t281 - 0.5e1_dp*t1017*t427 & + *t6*t281 + 0.10e2_dp*t421*t422*t127*t350*t281 - (2._dp & + *t457*t306) + 0.5e1_dp/0.2e1_dp*t1071*t533 t1324 = d2exeirhondrho(Q, dQrho, dQndrho, d2Qrhondrho) t1336 = t160*t281 t1351 = t476*t420 t1382 = t136*t475 t1397 = t136*t137 - t1405 = -t136*t1155*t93*t118+(2._dp*t956*t510)+0.5e1_dp & - /0.2e1_dp*(t956)*(t513)+(2._dp*t1382*t390)-(6._dp & - *t388*t961*t1218)-(5._dp*t966*t1181)+(2._dp*t388 & - *t389*t726)+0.5e1_dp/0.2e1_dp*(t1382)*(t394)-(5._dp & - *t966*t1261)-0.75e2_dp/0.4e1_dp*t1397*t1210+0.10e2_dp*t1397 & - *t1270+0.5e1_dp/0.2e1_dp*(t388)*(t393)*(t1198) + t1405 = -t136*t1155*t93*t118 + (2._dp*t956*t510) + 0.5e1_dp & + /0.2e1_dp*(t956)*(t513) + (2._dp*t1382*t390) - (6._dp & + *t388*t961*t1218) - (5._dp*t966*t1181) + (2._dp*t388 & + *t389*t726) + 0.5e1_dp/0.2e1_dp*(t1382)*(t394) - (5._dp & + *t966*t1261) - 0.75e2_dp/0.4e1_dp*t1397*t1210 + 0.10e2_dp*t1397 & + *t1270 + 0.5e1_dp/0.2e1_dp*(t388)*(t393)*(t1198) t1413 = t140*t456 - t1435 = -t140*t1255*t93*t129+(2._dp*t985*t519)+0.3e1_dp & - /0.2e1_dp*(t985)*(t522)+(2._dp*t1413*t402)-(6._dp & - *t400*t990*t1218)-(3._dp*t995*t1288)+(2._dp*t400 & - *t401*t726)+0.3e1_dp/0.2e1_dp*(t1413)*(t406)-(3._dp & - *t995*t1190)-0.27e2_dp/0.4e1_dp*t95*t1266+0.3e1_dp*t95*t1277 & - +0.3e1_dp/0.2e1_dp*(t400)*(t405)*(t1184) - t1443 = -0.15e2_dp/0.2e1_dp*t1065*t422*t351*t281+t158*(t1324 & - +(t726*t161-0.2e1_dp*t246*t434*t281+0.2e1_dp*t1040*t246 & - *t281-t435*t726)*t438*t160-t1049*t1336+t439*t281) & - -0.12e2_dp*t106*t782*t118*t422*t1218+0.5e1_dp/0.2e1_dp* & - t421*t422*t1198-(3._dp*t330*t478)+0.5e1_dp/0.2e1_dp*t1351 & - *t423+0.12e2_dp*t106*t782*t286*t281-0.3e1_dp*t106*t333 & - *t726-t81*t93*t726+f12*t1255*t94+(3._dp*t1089 & - *t530)-(3._dp*t476*t334)+0.2e1_dp*t81*t108*t286*t281 & - -t505*t382/0.3e1_dp+(t1405+t1435)*t145*t151+0.3e1_dp*t415 & + t1435 = -t140*t1255*t93*t129 + (2._dp*t985*t519) + 0.3e1_dp & + /0.2e1_dp*(t985)*(t522) + (2._dp*t1413*t402) - (6._dp & + *t400*t990*t1218) - (3._dp*t995*t1288) + (2._dp*t400 & + *t401*t726) + 0.3e1_dp/0.2e1_dp*(t1413)*(t406) - (3._dp & + *t995*t1190) - 0.27e2_dp/0.4e1_dp*t95*t1266 + 0.3e1_dp*t95*t1277 & + + 0.3e1_dp/0.2e1_dp*(t400)*(t405)*(t1184) + t1443 = -0.15e2_dp/0.2e1_dp*t1065*t422*t351*t281 + t158*(t1324 & + + (t726*t161 - 0.2e1_dp*t246*t434*t281 + 0.2e1_dp*t1040*t246 & + *t281 - t435*t726)*t438*t160 - t1049*t1336 + t439*t281) & + - 0.12e2_dp*t106*t782*t118*t422*t1218 + 0.5e1_dp/0.2e1_dp* & + t421*t422*t1198 - (3._dp*t330*t478) + 0.5e1_dp/0.2e1_dp*t1351 & + *t423 + 0.12e2_dp*t106*t782*t286*t281 - 0.3e1_dp*t106*t333 & + *t726 - t81*t93*t726 + f12*t1255*t94 + (3._dp*t1089 & + *t530) - (3._dp*t476*t334) + 0.2e1_dp*t81*t108*t286*t281 & + - t505*t382/0.3e1_dp + (t1405 + t1435)*t145*t151 + 0.3e1_dp*t415 & *t155*t44*t726 - e_ndrho_rho = e_ndrho_rho+(-0.4e1_dp/0.3e1_dp*t283*t545-t80*(t1319+t1443)*Clda)*sx + e_ndrho_rho = e_ndrho_rho + (-0.4e1_dp/0.3e1_dp*t283*t545 - t80*(t1319 + t1443)*Clda)*sx t1447 = t281**2 t1448 = t1447*t115 t1452 = d2exeindrhondrho(Q, dQndrho, d2Qndrhondrho) - t1481 = 2._dp*t728*t103+4._dp*t249*t473+t11*t15*(2._dp*g2*t3 & - *t19+12._dp*g3*t1*t24*t32) + t1481 = 2._dp*t728*t103 + 4._dp*t249*t473 + t11*t15*(2._dp*g2*t3 & + *t19 + 12._dp*g3*t1*t24*t32) t1483 = t1481*E*t108 - t1500 = 2._dp*t728*t88+4._dp*t249*t454+t11*t15*(F2*t744* & - t68-2._dp*t450*t278+2._dp*t85*t752-t85*t769) + t1500 = 2._dp*t728*t88 + 4._dp*t249*t454 + t11*t15*(F2*t744* & + t68 - 2._dp*t450*t278 + 2._dp*t85*t752 - t85*t769) t1529 = t789*t1447 t1533 = t127*t1447 t1537 = t115*t772 t1552 = t1447*t114 t1562 = t113*t1447 t1566 = t114*t772 - t1570 = -t136*t1481*t93*t118+(4._dp*t1382*t510)+(5._dp & - *t1382*t513)-(6._dp*t388*t961*t1447)-(10._dp*t388 & - *t420*t1448)+(2._dp*t388*t389*t772)-0.75e2_dp/0.4e1_dp* & - (t388)*(t972)*(t1529)+(10._dp*t388*t393*t1533) & - +0.5e1_dp/0.2e1_dp*(t388)*(t393)*(t1537)-t140 & - *t1500*t93*t129+(4._dp*t1413*t519)+(3._dp*t1413 & - *t522)-(6._dp*t400*t990*t1447)-(6._dp*t400*t108*t372 & - *t1552)+(2._dp*t400*t401*t772)-0.27e2_dp/0.4e1_dp*(t400) & - *(t1001)*(t1448)+(3._dp*t400*t405*t1562) & - +0.3e1_dp/0.2e1_dp*(t400)*(t405)*(t1566) - t1576 = -15._dp*t1065*t422*t1448+t158*(t1452+(t772*t161- & - 2._dp*t1447*t434+2._dp*t1040*t1447-t435*t772)*t438*t160 & - -t539*t1048*t1336+t540*t281)+t1483-t81*t93*t772 & - +f12*t1500*t94+2._dp*t81*t108*t1447-6._dp*t476*t478-3._dp & - *t106*t333*t772-4._dp*t457*t459+t1570*t145*t151+10._dp & + t1570 = -t136*t1481*t93*t118 + (4._dp*t1382*t510) + (5._dp & + *t1382*t513) - (6._dp*t388*t961*t1447) - (10._dp*t388 & + *t420*t1448) + (2._dp*t388*t389*t772) - 0.75e2_dp/0.4e1_dp* & + (t388)*(t972)*(t1529) + (10._dp*t388*t393*t1533) & + + 0.5e1_dp/0.2e1_dp*(t388)*(t393)*(t1537) - t140 & + *t1500*t93*t129 + (4._dp*t1413*t519) + (3._dp*t1413 & + *t522) - (6._dp*t400*t990*t1447) - (6._dp*t400*t108*t372 & + *t1552) + (2._dp*t400*t401*t772) - 0.27e2_dp/0.4e1_dp*(t400) & + *(t1001)*(t1448) + (3._dp*t400*t405*t1562) & + + 0.3e1_dp/0.2e1_dp*(t400)*(t405)*(t1566) + t1576 = -15._dp*t1065*t422*t1448 + t158*(t1452 + (t772*t161 - & + 2._dp*t1447*t434 + 2._dp*t1040*t1447 - t435*t772)*t438*t160 & + - t539*t1048*t1336 + t540*t281) + t1483 - t81*t93*t772 & + + f12*t1500*t94 + 2._dp*t81*t108*t1447 - 6._dp*t476*t478 - 3._dp & + *t106*t333*t772 - 4._dp*t457*t459 + t1570*t145*t151 + 10._dp & *t421*t422*t1533 - t1618 = -(2._dp*t81*t799*t1447)-(t81*t93*t359*t1447) & - +(t81*t355*t772)-0.3e1_dp/0.4e1_dp*(t81)*(t812) & - *(t1447)+(t81*t360*t772)/0.2e1_dp-t125*t1500 & - *t83*t129+(2._dp*t1224*t498)+(3._dp*t1224*t501)- & - (2._dp*t367*t401*t1447)+(t367*t368*t772)-(3._dp & - *t367*t405*t1552) - t1652 = (3._dp*t367*t373*t1562)+0.3e1_dp/0.2e1_dp*(t367) & - *(t373)*(t1566)-0.27e2_dp/0.4e1_dp*(t367)*(t879) & - *(t1448)-t110*t1481*t83*t118+(2._dp*t1205*t484) & - +(5._dp*t1205*t487)-(2._dp*t340*t389*t1447)+(t340 & - *t341*t772)-(5._dp*t340*t393*t1448)+(10._dp* & - t340*t346*t1533)+0.5e1_dp/0.2e1_dp*(t340)*(t346)* & - (t1537)-0.75e2_dp/0.4e1_dp*(t340)*(t793)*(t1529) - t1672 = 0.5e1_dp/0.2e1_dp*t421*t422*t1537-0.75e2_dp/0.4e1_dp*t1082 & - *t422*t1529+(6._dp*t91*t1111*t1447)-(2._dp*t91* & - t305*t772)+(t1618+t1652)*omega*t134+(12._dp*t106*t782 & - *t1447)-t1483*t156+(6._dp*t1174*t530)+(5._dp*t1351 & - *t533)-(12._dp*t783*t155*t44*t1447)+(3._dp*t415 & + t1618 = -(2._dp*t81*t799*t1447) - (t81*t93*t359*t1447) & + + (t81*t355*t772) - 0.3e1_dp/0.4e1_dp*(t81)*(t812) & + *(t1447) + (t81*t360*t772)/0.2e1_dp - t125*t1500 & + *t83*t129 + (2._dp*t1224*t498) + (3._dp*t1224*t501) - & + (2._dp*t367*t401*t1447) + (t367*t368*t772) - (3._dp & + *t367*t405*t1552) + t1652 = (3._dp*t367*t373*t1562) + 0.3e1_dp/0.2e1_dp*(t367) & + *(t373)*(t1566) - 0.27e2_dp/0.4e1_dp*(t367)*(t879) & + *(t1448) - t110*t1481*t83*t118 + (2._dp*t1205*t484) & + + (5._dp*t1205*t487) - (2._dp*t340*t389*t1447) + (t340 & + *t341*t772) - (5._dp*t340*t393*t1448) + (10._dp* & + t340*t346*t1533) + 0.5e1_dp/0.2e1_dp*(t340)*(t346)* & + (t1537) - 0.75e2_dp/0.4e1_dp*(t340)*(t793)*(t1529) + t1672 = 0.5e1_dp/0.2e1_dp*t421*t422*t1537 - 0.75e2_dp/0.4e1_dp*t1082 & + *t422*t1529 + (6._dp*t91*t1111*t1447) - (2._dp*t91* & + t305*t772) + (t1618 + t1652)*omega*t134 + (12._dp*t106*t782 & + *t1447) - t1483*t156 + (6._dp*t1174*t530) + (5._dp*t1351 & + *t533) - (12._dp*t783*t155*t44*t1447) + (3._dp*t415 & *t155*t44*t772) - e_ndrho_ndrho = e_ndrho_ndrho+(-t80*(t1576+t1672)*Clda)*sx + e_ndrho_ndrho = e_ndrho_ndrho + (-t80*(t1576 + t1672)*Clda)*sx END IF END SUBROUTINE xwpbe_lda_calc_4 @@ -5280,7 +5280,7 @@ SUBROUTINE xwpbe_lsd_eval(rho_set, deriv_set, order, xwpbe_params) CALL xc_rho_set_get(rho_set, rhoa=rhoa, rhob=rhob, norm_drhoa=norm_drhoa, & norm_drhob=norm_drhob, local_bounds=bo, rho_cutoff=epsilon_rho, & drho_cutoff=epsilon_norm_drho) - npoints = (bo(2, 1)-bo(1, 1)+1)*(bo(2, 2)-bo(1, 2)+1)*(bo(2, 3)-bo(1, 3)+1) + npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1) dummy => rhoa @@ -5434,7 +5434,7 @@ SUBROUTINE xwpbe_lsd_calc(npoints, order, rho, norm_drho, e_0, e_rho, e_ndrho, & ss = 0.3466806371753173524216762e0_dp*t6*t8 IF (ss > scutoff) THEN ss2 = ss*ss - sscale = ((smax)*ss2-(sconst))/(ss2*ss) + sscale = ((smax)*ss2 - (sconst))/(ss2*ss) END IF e_0_temp = 0.0_dp IF (sx0 /= 0.0_dp) THEN @@ -5449,7 +5449,7 @@ SUBROUTINE xwpbe_lsd_calc(npoints, order, rho, norm_drho, e_0, e_rho, e_ndrho, & my_ndrho, sscale, sx0, order) END IF !According to spin-scaling relation, we need only half of the energy - e_0(ip) = e_0(ip)+0.5_dp*e_0_temp + e_0(ip) = e_0(ip) + 0.5_dp*e_0_temp END IF e_0_temp = 0.0_dp IF (sx /= 0.0_dp) THEN @@ -5472,7 +5472,7 @@ SUBROUTINE xwpbe_lsd_calc(npoints, order, rho, norm_drho, e_0, e_rho, e_ndrho, & END IF !According to spin-scaling relation, we need only half of the energy END IF - e_0(ip) = e_0(ip)+0.5_dp*e_0_temp + e_0(ip) = e_0(ip) + 0.5_dp*e_0_temp END IF END DO @@ -5507,7 +5507,7 @@ FUNCTION exei(Q) exei = EXP(Q)*expint(1, Q) ELSE !Use approximation - exei = (1._dp/Q)*(Q*Q+exei1*Q+exei2)/(Q*Q+exei3*Q+exei4) + exei = (1._dp/Q)*(Q*Q + exei1*Q + exei2)/(Q*Q + exei3*Q + exei4) END IF END FUNCTION exei @@ -5530,7 +5530,7 @@ FUNCTION exer(Q) !Use approximation Q3 = Q*Q*Q Q5 = Q3*Q*Q - exer = pi*(1.0_dp/SQRT(Q*pi)-1.0_dp/(2.0_dp*SQRT(pi*Q3))+3.0_dp/(4.0_dp*(SQRT(pi*Q5)))) + exer = pi*(1.0_dp/SQRT(Q*pi) - 1.0_dp/(2.0_dp*SQRT(pi*Q3)) + 3.0_dp/(4.0_dp*(SQRT(pi*Q5)))) END IF END FUNCTION exer @@ -5544,7 +5544,7 @@ FUNCTION dexeirho(Q, dQrho) REAL(dp), INTENT(IN) :: Q, dQrho REAL(dp) :: dexeirho - dexeirho = dQrho*(exei(Q)-1.0_dp/Q) + dexeirho = dQrho*(exei(Q) - 1.0_dp/Q) END FUNCTION dexeirho ! ************************************************************************************************** @@ -5557,7 +5557,7 @@ FUNCTION dexeindrho(Q, dQndrho) REAL(dp), INTENT(IN) :: Q, dQndrho REAL(dp) :: dexeindrho - dexeindrho = dQndrho*(exei(Q)-1.0_dp/Q) + dexeindrho = dQndrho*(exei(Q) - 1.0_dp/Q) END FUNCTION dexeindrho ! ************************************************************************************************** @@ -5570,7 +5570,7 @@ FUNCTION dexerrho(Q, dQrho) REAL(dp), INTENT(IN) :: Q, dQrho REAL(dp) :: dexerrho - dexerrho = dQrho*exer(Q)-dQrho*rootpi/SQRT(Q) + dexerrho = dQrho*exer(Q) - dQrho*rootpi/SQRT(Q) END FUNCTION dexerrho ! ************************************************************************************************** @@ -5583,7 +5583,7 @@ FUNCTION dexerndrho(Q, dQndrho) REAL(dp), INTENT(IN) :: Q, dQndrho REAL(dp) :: dexerndrho - dexerndrho = dQndrho*exer(Q)-dQndrho*rootpi/SQRT(Q) + dexerndrho = dQndrho*exer(Q) - dQndrho*rootpi/SQRT(Q) END FUNCTION dexerndrho ! ************************************************************************************************** @@ -5597,8 +5597,8 @@ FUNCTION d2exeirhorho(Q, dQrho, d2Qrhorho) REAL(dp), INTENT(IN) :: Q, dQrho, d2Qrhorho REAL(dp) :: d2exeirhorho - d2exeirhorho = exei(Q)*(d2Qrhorho+dQrho*dQrho)+ & - 1.0_dp/(Q*Q)*(-Q*dQrho*dQrho-Q*d2Qrhorho+dQrho*dQrho) + d2exeirhorho = exei(Q)*(d2Qrhorho + dQrho*dQrho) + & + 1.0_dp/(Q*Q)*(-Q*dQrho*dQrho - Q*d2Qrhorho + dQrho*dQrho) END FUNCTION d2exeirhorho ! ************************************************************************************************** @@ -5617,8 +5617,8 @@ FUNCTION d2exerrhorho(Q, dQrho, d2Qrhorho) Q12 = SQRT(Q) pi12 = rootpi - d2exerrhorho = exer(Q)*(d2Qrhorho+dQrho*dQrho)-dQrho*dQrho/(pi12*Q12)+ & - 0.5_dp*dQrho*dQrho/(pi12*Q*Q12)-d2Qrhorho/(pi12*Q12) + d2exerrhorho = exer(Q)*(d2Qrhorho + dQrho*dQrho) - dQrho*dQrho/(pi12*Q12) + & + 0.5_dp*dQrho*dQrho/(pi12*Q*Q12) - d2Qrhorho/(pi12*Q12) END FUNCTION d2exerrhorho ! ************************************************************************************************** @@ -5633,8 +5633,8 @@ FUNCTION d2exeirhondrho(Q, dQrho, dQndrho, d2Qrhondrho) REAL(dp), INTENT(IN) :: Q, dQrho, dQndrho, d2Qrhondrho REAL(dp) :: d2exeirhondrho - d2exeirhondrho = exei(Q)*(d2Qrhondrho+dQrho*dQndrho)- & - 1.0_dp/Q*(dQrho*dQndrho+d2Qrhondrho)+1.0_dp/(Q*Q)*dQrho*dQndrho + d2exeirhondrho = exei(Q)*(d2Qrhondrho + dQrho*dQndrho) - & + 1.0_dp/Q*(dQrho*dQndrho + d2Qrhondrho) + 1.0_dp/(Q*Q)*dQrho*dQndrho END FUNCTION d2exeirhondrho ! ************************************************************************************************** @@ -5654,8 +5654,8 @@ FUNCTION d2exerrhondrho(Q, dQrho, dQndrho, d2Qrhondrho) Q12 = SQRT(Q) pi12 = rootpi - d2exerrhondrho = exer(Q)*(d2Qrhondrho+dQrho*dQndrho)-1.0_dp/(pi12*Q12)*dQrho*dQndrho & - +0.5_dp/(pi12*Q12*Q)*dQrho*dQndrho-1.0_dp/(pi12*Q12)*d2Qrhondrho + d2exerrhondrho = exer(Q)*(d2Qrhondrho + dQrho*dQndrho) - 1.0_dp/(pi12*Q12)*dQrho*dQndrho & + + 0.5_dp/(pi12*Q12*Q)*dQrho*dQndrho - 1.0_dp/(pi12*Q12)*d2Qrhondrho END FUNCTION d2exerrhondrho ! ************************************************************************************************** @@ -5669,8 +5669,8 @@ FUNCTION d2exeindrhondrho(Q, dQndrho, d2Qndrhondrho) REAL(dp), INTENT(IN) :: Q, dQndrho, d2Qndrhondrho REAL(dp) :: d2exeindrhondrho - d2exeindrhondrho = exei(Q)*(d2Qndrhondrho+dQndrho*dQndrho)+ & - 1.0_dp/(Q*Q)*(-Q*dQndrho*dQndrho-Q*d2Qndrhondrho+dQndrho*dQndrho) + d2exeindrhondrho = exei(Q)*(d2Qndrhondrho + dQndrho*dQndrho) + & + 1.0_dp/(Q*Q)*(-Q*dQndrho*dQndrho - Q*d2Qndrhondrho + dQndrho*dQndrho) END FUNCTION d2exeindrhondrho ! ************************************************************************************************** @@ -5689,8 +5689,8 @@ FUNCTION d2exerndrhondrho(Q, dQndrho, d2Qndrhondrho) Q12 = SQRT(Q) pi12 = rootpi - d2exerndrhondrho = exer(Q)*(d2Qndrhondrho+dQndrho*dQndrho)-dQndrho*dQndrho/(pi12*Q12) & - +0.5_dp*dQndrho*dQndrho/(pi12*Q*Q12)-d2Qndrhondrho/(pi12*Q12) + d2exerndrhondrho = exer(Q)*(d2Qndrhondrho + dQndrho*dQndrho) - dQndrho*dQndrho/(pi12*Q12) & + + 0.5_dp*dQndrho*dQndrho/(pi12*Q*Q12) - d2Qndrhondrho/(pi12*Q12) END FUNCTION d2exerndrhondrho END MODULE xc_xwpbe diff --git a/src/xc_adiabatic_methods.F b/src/xc_adiabatic_methods.F index cc52681bc5..4f2cf91cda 100644 --- a/src/xc_adiabatic_methods.F +++ b/src/xc_adiabatic_methods.F @@ -90,15 +90,15 @@ SUBROUTINE rescale_MCY3_pade(qs_env, hf_energy, energy, adiabatic_lambda, & ELSE nelec_b = 0 END IF - nelectron = nelec_a+nelec_b - dfa_energy = energy%exc+energy%exc1 + nelectron = nelec_a + nelec_b + dfa_energy = energy%exc + energy%exc1 a = hf_energy(1) b = -c1*2.0_dp*adiabatic_omega*oorootpi*nelectron !-0.23163_dp*2.0_dp*0.2_dp*oorootpi*nelectron - c = -1.0_dp/adiabatic_lambda-b/(hf_energy(1)-dfa_energy-hf_energy(2)) + c = -1.0_dp/adiabatic_lambda - b/(hf_energy(1) - dfa_energy - hf_energy(2)) dExc_da = 1.0_dp - dExc_db = 1.0_dp/c-(LOG(ABS(1.0_dp+c))/(c*c)) - dExc_dc = -b/(c*c*c*(1.0_dp+c))*(2.0_dp*c+c*c-2.0_dp*LOG(ABS(1.0_dp+c))-2.0_dp*LOG(ABS(1.0_dp+c))*c) + dExc_db = 1.0_dp/c - (LOG(ABS(1.0_dp + c))/(c*c)) + dExc_dc = -b/(c*c*c*(1.0_dp + c))*(2.0_dp*c + c*c - 2.0_dp*LOG(ABS(1.0_dp + c)) - 2.0_dp*LOG(ABS(1.0_dp + c))*c) da_dEx1 = 1.0_dp da_ddW0 = 0.0_dp @@ -110,17 +110,17 @@ SUBROUTINE rescale_MCY3_pade(qs_env, hf_energy, energy, adiabatic_lambda, & db_dDFA = 0.0_dp db_dEx2 = 0.0_dp - dc_dEx1 = b/(hf_energy(1)-dfa_energy-hf_energy(2))**2 - dc_ddW0 = -1.0_dp/(hf_energy(1)-dfa_energy-hf_energy(2)) + dc_dEx1 = b/(hf_energy(1) - dfa_energy - hf_energy(2))**2 + dc_ddW0 = -1.0_dp/(hf_energy(1) - dfa_energy - hf_energy(2)) dc_dDFA = -dc_dEx1 dc_dEx2 = -dc_dEx1 - scale_dEx1 = dExc_da*da_dEx1+dExc_db*db_dEx1+dExc_dc*dc_dEx1 - scale_ddW0 = dExc_da*da_ddW0+dExc_db*db_ddW0+dExc_dc*dc_ddW0 - scale_dDFA = dExc_da*da_dDFA+dExc_db*db_dDFA+dExc_dc*dc_dDFA - scale_dEx2 = dExc_da*da_dEx2+dExc_db*db_dEx2+dExc_dc*dc_dEx2 + scale_dEx1 = dExc_da*da_dEx1 + dExc_db*db_dEx1 + dExc_dc*dc_dEx1 + scale_ddW0 = dExc_da*da_ddW0 + dExc_db*db_ddW0 + dExc_dc*dc_ddW0 + scale_dDFA = dExc_da*da_dDFA + dExc_db*db_dDFA + dExc_dc*dc_dDFA + scale_dEx2 = dExc_da*da_dEx2 + dExc_db*db_dEx2 + dExc_dc*dc_dEx2 - total_energy_xc = a+b/(c*c)*(c-LOG(ABS(1.0_dp+c))) + total_energy_xc = a + b/(c*c)*(c - LOG(ABS(1.0_dp + c))) IF (do_swap_hf) THEN swap_value = scale_dEx1 scale_dEx1 = scale_dEx2 diff --git a/src/xc_pot_saop.F b/src/xc_pot_saop.F index ab7d32dd1c..344c07f5d7 100644 --- a/src/xc_pot_saop.F +++ b/src/xc_pot_saop.F @@ -328,9 +328,9 @@ SUBROUTINE add_saop_pot(ks_matrix, qs_env, oe_corr) CALL pw_zero(vxc_tmp(ispin)%pw) - DO orb = 1, homo-1 + DO orb = 1, homo - 1 - efac = K_rho*SQRT(mo_eigenvalues(homo)-mo_eigenvalues(orb)) + efac = K_rho*SQRT(mo_eigenvalues(homo) - mo_eigenvalues(orb)) IF (.NOT. lsd) efac = 2.0_dp*efac CALL cp_fm_set_all(single_mo_coeff(ispin)%matrix, 0.0_dp) @@ -392,8 +392,8 @@ SUBROUTINE add_saop_pot(ks_matrix, qs_env, oe_corr) DO orb = 1, homo - we_LB = EXP(-2.0_dp*(mo_eigenvalues(homo)-mo_eigenvalues(orb))**2) - we_GLLB = 1.0_dp-we_LB + we_LB = EXP(-2.0_dp*(mo_eigenvalues(homo) - mo_eigenvalues(orb))**2) + we_GLLB = 1.0_dp - we_LB IF (.NOT. lsd) THEN we_LB = 2.0_dp*we_LB we_GLLB = 2.0_dp*we_GLLB @@ -728,11 +728,11 @@ SUBROUTINE gapw_add_atomic_saop_pot(qs_env, oe_corr) CALL xc_dset_zero_all(deriv_set) CALL vxc_of_r_new(xc_fun_section_tmp, rho_set_h, deriv_set, 1, needs, & weight, lsd, na, nr, exc, vxc_LB_h, vxg, vtau) - vxc_LB_h = vxc_LB_h+alpha*vxc_tmp_h + vxc_LB_h = vxc_LB_h + alpha*vxc_tmp_h DO ispin = 1, nspins dummy => vxc_tmp_h(:, :, ispin:ispin) CALL add_lb_pot(dummy, rho_set_h, lsd, ispin) - vxc_LB_h(:, :, ispin) = vxc_LB_h(:, :, ispin)-weight(:, :)*vxc_tmp_h(:, :, ispin) + vxc_LB_h(:, :, ispin) = vxc_LB_h(:, :, ispin) - weight(:, :)*vxc_tmp_h(:, :, ispin) END DO NULLIFY (dummy) @@ -754,11 +754,11 @@ SUBROUTINE gapw_add_atomic_saop_pot(qs_env, oe_corr) CALL vxc_of_r_new(xc_fun_section_tmp, rho_set_s, deriv_set, 1, needs, & weight, lsd, na, nr, exc, vxc_LB_s, vxg, vtau) - vxc_LB_s = vxc_LB_s+alpha*vxc_tmp_s + vxc_LB_s = vxc_LB_s + alpha*vxc_tmp_s DO ispin = 1, nspins dummy => vxc_tmp_s(:, :, ispin:ispin) CALL add_lb_pot(dummy, rho_set_s, lsd, ispin) - vxc_LB_s(:, :, ispin) = vxc_LB_s(:, :, ispin)-weight(:, :)*vxc_tmp_s(:, :, ispin) + vxc_LB_s(:, :, ispin) = vxc_LB_s(:, :, ispin) - weight(:, :)*vxc_tmp_s(:, :, ispin) END DO NULLIFY (dummy) @@ -780,11 +780,11 @@ SUBROUTINE gapw_add_atomic_saop_pot(qs_env, oe_corr) DO ispin = 1, nspins - DO orb = 1, homo(ispin)-1 + DO orb = 1, homo(ispin) - 1 ALLOCATE (coeff_col(nrow(ispin), 1)) - efac = K_rho*SQRT(mo_eigenvalues(ispin)%array(homo(ispin))- & + efac = K_rho*SQRT(mo_eigenvalues(ispin)%array(homo(ispin)) - & mo_eigenvalues(ispin)%array(orb)) IF (.NOT. lsd) efac = 2.0_dp*efac @@ -826,15 +826,15 @@ SUBROUTINE gapw_add_atomic_saop_pot(qs_env, oe_corr) IF (lsd) THEN IF (ispin == 1) THEN - vxc_tmp_h(:, :, 1) = vxc_tmp_h(:, :, 1)+efac*orb_rho_set_h%rhoa(:, :, 1) - vxc_tmp_s(:, :, 1) = vxc_tmp_s(:, :, 1)+efac*orb_rho_set_s%rhoa(:, :, 1) + vxc_tmp_h(:, :, 1) = vxc_tmp_h(:, :, 1) + efac*orb_rho_set_h%rhoa(:, :, 1) + vxc_tmp_s(:, :, 1) = vxc_tmp_s(:, :, 1) + efac*orb_rho_set_s%rhoa(:, :, 1) ELSE - vxc_tmp_h(:, :, 2) = vxc_tmp_h(:, :, 2)+efac*orb_rho_set_h%rhob(:, :, 1) - vxc_tmp_s(:, :, 2) = vxc_tmp_s(:, :, 2)+efac*orb_rho_set_s%rhob(:, :, 1) + vxc_tmp_h(:, :, 2) = vxc_tmp_h(:, :, 2) + efac*orb_rho_set_h%rhob(:, :, 1) + vxc_tmp_s(:, :, 2) = vxc_tmp_s(:, :, 2) + efac*orb_rho_set_s%rhob(:, :, 1) END IF ELSE - vxc_tmp_h(:, :, 1) = vxc_tmp_h(:, :, 1)+efac*orb_rho_set_h%rho(:, :, 1) - vxc_tmp_s(:, :, 1) = vxc_tmp_s(:, :, 1)+efac*orb_rho_set_s%rho(:, :, 1) + vxc_tmp_h(:, :, 1) = vxc_tmp_h(:, :, 1) + efac*orb_rho_set_h%rho(:, :, 1) + vxc_tmp_s(:, :, 1) = vxc_tmp_s(:, :, 1) + efac*orb_rho_set_s%rho(:, :, 1) END IF END DO ! orb @@ -845,16 +845,16 @@ SUBROUTINE gapw_add_atomic_saop_pot(qs_env, oe_corr) DO ir = 1, nr DO ia = 1, na IF (rho_set_h%rhoa(ia, ir, 1) > rho_set_h%rho_cutoff) & - vxc_GLLB_h(ia, ir, 1) = vxc_GLLB_h(ia, ir, 1)+ & + vxc_GLLB_h(ia, ir, 1) = vxc_GLLB_h(ia, ir, 1) + & weight(ia, ir)*vxc_tmp_h(ia, ir, 1)/rho_set_h%rhoa(ia, ir, 1) IF (rho_set_h%rhob(ia, ir, 1) > rho_set_h%rho_cutoff) & - vxc_GLLB_h(ia, ir, 2) = vxc_GLLB_h(ia, ir, 2)+ & + vxc_GLLB_h(ia, ir, 2) = vxc_GLLB_h(ia, ir, 2) + & weight(ia, ir)*vxc_tmp_h(ia, ir, 2)/rho_set_h%rhob(ia, ir, 1) IF (rho_set_s%rhoa(ia, ir, 1) > rho_set_s%rho_cutoff) & - vxc_GLLB_s(ia, ir, 1) = vxc_GLLB_s(ia, ir, 1)+ & + vxc_GLLB_s(ia, ir, 1) = vxc_GLLB_s(ia, ir, 1) + & weight(ia, ir)*vxc_tmp_s(ia, ir, 1)/rho_set_s%rhoa(ia, ir, 1) IF (rho_set_s%rhob(ia, ir, 1) > rho_set_s%rho_cutoff) & - vxc_GLLB_s(ia, ir, 2) = vxc_GLLB_s(ia, ir, 2)+ & + vxc_GLLB_s(ia, ir, 2) = vxc_GLLB_s(ia, ir, 2) + & weight(ia, ir)*vxc_tmp_s(ia, ir, 2)/rho_set_s%rhob(ia, ir, 1) END DO END DO @@ -862,10 +862,10 @@ SUBROUTINE gapw_add_atomic_saop_pot(qs_env, oe_corr) DO ir = 1, nr DO ia = 1, na IF (rho_set_h%rho(ia, ir, 1) > rho_set_h%rho_cutoff) & - vxc_GLLB_h(ia, ir, 1) = vxc_GLLB_h(ia, ir, 1)+ & + vxc_GLLB_h(ia, ir, 1) = vxc_GLLB_h(ia, ir, 1) + & weight(ia, ir)*vxc_tmp_h(ia, ir, 1)/rho_set_h%rho(ia, ir, 1) IF (rho_set_s%rho(ia, ir, 1) > rho_set_s%rho_cutoff) & - vxc_GLLB_s(ia, ir, 1) = vxc_GLLB_s(ia, ir, 1)+ & + vxc_GLLB_s(ia, ir, 1) = vxc_GLLB_s(ia, ir, 1) + & weight(ia, ir)*vxc_tmp_s(ia, ir, 1)/rho_set_s%rho(ia, ir, 1) END DO END DO @@ -879,17 +879,17 @@ SUBROUTINE gapw_add_atomic_saop_pot(qs_env, oe_corr) ALLOCATE (coeff_col(nrow(ispin), 1)) - we_LB = EXP(-2.0_dp*(mo_eigenvalues(ispin)%array(homo(ispin))- & + we_LB = EXP(-2.0_dp*(mo_eigenvalues(ispin)%array(homo(ispin)) - & mo_eigenvalues(ispin)%array(orb))**2) - we_GLLB = 1.0_dp-we_LB + we_GLLB = 1.0_dp - we_LB IF (.NOT. lsd) THEN we_LB = 2.0_dp*we_LB we_GLLB = 2.0_dp*we_GLLB END IF - vxc_tmp_h(:, :, ispin) = we_LB*vxc_LB_h(:, :, ispin)+ & + vxc_tmp_h(:, :, ispin) = we_LB*vxc_LB_h(:, :, ispin) + & we_GLLB*vxc_GLLB_h(:, :, ispin) - vxc_tmp_s(:, :, ispin) = we_LB*vxc_LB_s(:, :, ispin)+ & + vxc_tmp_s(:, :, ispin) = we_LB*vxc_LB_s(:, :, ispin) + & we_GLLB*vxc_GLLB_s(:, :, ispin) CALL cp_fm_set_all(single_mo_coeff(ispin)%matrix, 0.0_dp) @@ -930,15 +930,15 @@ SUBROUTINE gapw_add_atomic_saop_pot(qs_env, oe_corr) IF (lsd) THEN IF (ispin == 1) THEN - vxc_SAOP_h(:, :, 1) = vxc_SAOP_h(:, :, 1)+vxc_tmp_h(:, :, 1)*orb_rho_set_h%rhoa(:, :, 1) - vxc_SAOP_s(:, :, 1) = vxc_SAOP_s(:, :, 1)+vxc_tmp_s(:, :, 1)*orb_rho_set_s%rhoa(:, :, 1) + vxc_SAOP_h(:, :, 1) = vxc_SAOP_h(:, :, 1) + vxc_tmp_h(:, :, 1)*orb_rho_set_h%rhoa(:, :, 1) + vxc_SAOP_s(:, :, 1) = vxc_SAOP_s(:, :, 1) + vxc_tmp_s(:, :, 1)*orb_rho_set_s%rhoa(:, :, 1) ELSE - vxc_SAOP_h(:, :, 2) = vxc_SAOP_h(:, :, 2)+vxc_tmp_h(:, :, 2)*orb_rho_set_h%rhob(:, :, 1) - vxc_SAOP_s(:, :, 2) = vxc_SAOP_s(:, :, 2)+vxc_tmp_s(:, :, 2)*orb_rho_set_s%rhob(:, :, 1) + vxc_SAOP_h(:, :, 2) = vxc_SAOP_h(:, :, 2) + vxc_tmp_h(:, :, 2)*orb_rho_set_h%rhob(:, :, 1) + vxc_SAOP_s(:, :, 2) = vxc_SAOP_s(:, :, 2) + vxc_tmp_s(:, :, 2)*orb_rho_set_s%rhob(:, :, 1) END IF ELSE - vxc_SAOP_h(:, :, 1) = vxc_SAOP_h(:, :, 1)+vxc_tmp_h(:, :, 1)*orb_rho_set_h%rho(:, :, 1) - vxc_SAOP_s(:, :, 1) = vxc_SAOP_s(:, :, 1)+vxc_tmp_s(:, :, 1)*orb_rho_set_s%rho(:, :, 1) + vxc_SAOP_h(:, :, 1) = vxc_SAOP_h(:, :, 1) + vxc_tmp_h(:, :, 1)*orb_rho_set_h%rho(:, :, 1) + vxc_SAOP_s(:, :, 1) = vxc_SAOP_s(:, :, 1) + vxc_tmp_s(:, :, 1)*orb_rho_set_s%rho(:, :, 1) END IF END DO ! orb @@ -1071,7 +1071,7 @@ SUBROUTINE add_lb_pot(pot, rho_set, lsd, spin) n_13 = n**ob3 x = (rho_set%norm_drho(i, j, k)/2.0_dp)/(n*n_13) x2 = x*x - pot(i, j, k) = beta*x2*n_13/(1.0_dp+3.0_dp*beta*x*LOG(x+SQRT(x2+1.0_dp))) + pot(i, j, k) = beta*x2*n_13/(1.0_dp + 3.0_dp*beta*x*LOG(x + SQRT(x2 + 1.0_dp))) END IF ELSE IF (spin == 1) THEN @@ -1079,14 +1079,14 @@ SUBROUTINE add_lb_pot(pot, rho_set, lsd, spin) n_13 = rho_set%rhoa_1_3(i, j, k) x = rho_set%norm_drhoa(i, j, k)/(rho_set%rhoa(i, j, k)*n_13) x2 = x*x - pot(i, j, k) = beta*x2*n_13/(1.0_dp+3.0_dp*beta*x*LOG(SQRT(x2+1.0_dp)+x)) + pot(i, j, k) = beta*x2*n_13/(1.0_dp + 3.0_dp*beta*x*LOG(SQRT(x2 + 1.0_dp) + x)) END IF ELSE IF (spin == 2) THEN IF (rho_set%rhob(i, j, k) > rho_set%rho_cutoff) THEN n_13 = rho_set%rhob_1_3(i, j, k) x = rho_set%norm_drhob(i, j, k)/(rho_set%rhob(i, j, k)*n_13) x2 = x*x - pot(i, j, k) = beta*x2*n_13/(1.0_dp+3.0_dp*beta*x*LOG(SQRT(x2+1.0_dp)+x)) + pot(i, j, k) = beta*x2*n_13/(1.0_dp + 3.0_dp*beta*x*LOG(SQRT(x2 + 1.0_dp) + x)) END IF END IF END IF @@ -1128,12 +1128,12 @@ SUBROUTINE calc_2excpbe(pot, rho_set, e_uniform, lsd) pot(i, j, k) = & 2.0_dp* & calc_ecpbe_r(rho_set%rho(i, j, k), rho_set%norm_drho(i, j, k), & - e_unif, rho_set%rho_cutoff, rho_set%drho_cutoff)+ & + e_unif, rho_set%rho_cutoff, rho_set%drho_cutoff) + & 2.0_dp* & calc_expbe_r(rho_set%rho(i, j, k), rho_set%norm_drho(i, j, k), & rho_set%rho_cutoff, rho_set%drho_cutoff) ELSE - rho = rho_set%rhoa(i, j, k)+rho_set%rhob(i, j, k) + rho = rho_set%rhoa(i, j, k) + rho_set%rhob(i, j, k) IF (rho > rho_set%rho_cutoff) THEN e_unif = e_uniform(i, j, k)/rho ELSE @@ -1143,7 +1143,7 @@ SUBROUTINE calc_2excpbe(pot, rho_set, e_uniform, lsd) 2.0_dp* & calc_ecpbe_u(rho_set%rhoa(i, j, k), rho_set%rhob(i, j, k), rho_set%norm_drho(i, j, k), & e_unif, & - rho_set%rho_cutoff, rho_set%drho_cutoff)+ & + rho_set%rho_cutoff, rho_set%drho_cutoff) + & 2.0_dp* & calc_expbe_u(rho_set%rhoa(i, j, k), rho_set%rhob(i, j, k), rho_set%norm_drho(i, j, k), & rho_set%rho_cutoff, rho_set%drho_cutoff) @@ -1174,23 +1174,23 @@ FUNCTION calc_ecpbe_u(ra, rb, ngr, ec_unif, rc, ngrc) RESULT(res) REAL(kind=dp) :: A, At2, H, kf, kl, ks, phi, phi3, r, t2, & zeta - r = ra+rb + r = ra + rb H = 0.0_dp IF (r > rc .AND. ngr > ngrc) THEN - zeta = (ra-rb)/r + zeta = (ra - rb)/r IF (zeta > 1.0_dp) zeta = 1.0_dp ! machine precision problem IF (zeta < -1.0_dp) zeta = -1.0_dp ! machine precision problem - phi = ((1.0_dp+zeta)**tb3+(1.0_dp-zeta)**tb3)/2.0_dp + phi = ((1.0_dp + zeta)**tb3 + (1.0_dp - zeta)**tb3)/2.0_dp phi3 = phi*phi*phi kf = (3.0_dp*r*pi*pi)**ob3 ks = SQRT(4.0_dp*kf/pi) t2 = (ngr/(2.0_dp*phi*ks*r))**2 - A = beta_ec/gamma_saop/(EXP(-ec_unif/(gamma_saop*phi3))-1.0_dp) + A = beta_ec/gamma_saop/(EXP(-ec_unif/(gamma_saop*phi3)) - 1.0_dp) At2 = A*t2 - kl = (1.0_dp+At2)/(1.0_dp+At2+At2*At2) - H = gamma_saop*LOG(1.0_dp+beta_ec/gamma_saop*t2*kl) + kl = (1.0_dp + At2)/(1.0_dp + At2 + At2*At2) + H = gamma_saop*LOG(1.0_dp + beta_ec/gamma_saop*t2*kl) END IF - res = ec_unif+H + res = ec_unif + H END FUNCTION calc_ecpbe_u @@ -1215,12 +1215,12 @@ FUNCTION calc_ecpbe_r(r, ngr, ec_unif, rc, ngrc) RESULT(res) kf = (3.0_dp*r*pi*pi)**(1.0_dp/3.0_dp) ks = SQRT(4.0_dp*kf/pi) t2 = (ngr/(2.0_dp*ks*r))**2 - A = beta_ec/gamma_saop/(EXP(-ec_unif/gamma_saop)-1.0_dp) + A = beta_ec/gamma_saop/(EXP(-ec_unif/gamma_saop) - 1.0_dp) At2 = A*t2 - kl = (1.0_dp+At2)/(1.0_dp+At2+At2*At2) - H = gamma_saop*LOG(1.0_dp+beta_ec/gamma_saop*t2*kl) + kl = (1.0_dp + At2)/(1.0_dp + At2 + At2*At2) + H = gamma_saop*LOG(1.0_dp + beta_ec/gamma_saop*t2*kl) END IF - res = ec_unif+H + res = ec_unif + H END FUNCTION calc_ecpbe_r @@ -1240,7 +1240,7 @@ FUNCTION calc_expbe_u(ra, rb, ngr, rc, ngrc) RESULT(res) REAL(kind=dp) :: r - r = ra+rb + r = ra + rb res = calc_expbe_r(r, ngr, rc, ngrc) END FUNCTION calc_expbe_u @@ -1266,7 +1266,7 @@ FUNCTION calc_expbe_r(r, ngr, rc, ngrc) RESULT(res) fx = 1.0_dp IF (ngr > ngrc) THEN s = ngr/(2.0_dp*kf*r) - fx = fx+kappa-kappa/(1.0_dp+mu*s*s/kappa) + fx = fx + kappa - kappa/(1.0_dp + mu*s*s/kappa) END IF res = ex_unif*fx ELSE diff --git a/src/xc_write_output.F b/src/xc_write_output.F index 14c2c8bf27..e88b0ce13d 100644 --- a/src/xc_write_output.F +++ b/src/xc_write_output.F @@ -64,7 +64,7 @@ SUBROUTINE xc_write(output_unit, xc_section, lsd) CALL xc_functionals_expand(xc_fun_section, xc_section) ifun = 0 DO - ifun = ifun+1 + ifun = ifun + 1 xc_fun => section_vals_get_subs_vals2(xc_fun_section, i_section=ifun) IF (.NOT. ASSOCIATED(xc_fun)) EXIT IF (TRIM(xc_fun%section%name) /= "LIBXC") THEN diff --git a/src/xray_diffraction.F b/src/xray_diffraction.F index b82159df5c..46cb6fab8d 100644 --- a/src/xray_diffraction.F +++ b/src/xray_diffraction.F @@ -192,7 +192,7 @@ SUBROUTINE xray_diffraction_spectrum(qs_env, unit_number, q_max) rho_hard=rho_hard, & rho_soft=rho_soft) - rho_total = rho_hard+rho_soft + rho_total = rho_hard + rho_soft ! Calculate the coherent X-ray spectrum @@ -213,22 +213,22 @@ SUBROUTINE xray_diffraction_spectrum(qs_env, unit_number, q_max) DO ig = 2, ng CPASSERT(gsq(ig) >= gsq(jg)) - IF (ABS(gsq(ig)-gsq(jg)) > 1.0E-12_dp) THEN - nshell = nshell+1 + IF (ABS(gsq(ig) - gsq(jg)) > 1.0E-12_dp) THEN + nshell = nshell + 1 IF (nshell > SIZE(q_shell)) THEN - CALL reallocate(q_shell, 1, SIZE(q_shell)+nblock) - CALL reallocate(ng_shell, 1, SIZE(ng_shell)+nblock) + CALL reallocate(q_shell, 1, SIZE(q_shell) + nblock) + CALL reallocate(ng_shell, 1, SIZE(ng_shell) + nblock) END IF q = SQRT(gsq(ig)) IF (q > q_max) THEN - nshell = nshell-1 + nshell = nshell - 1 EXIT END IF q_shell(nshell) = q ng_shell(nshell) = 1 jg = ig ELSE - ng_shell(nshell) = ng_shell(nshell)+1 + ng_shell(nshell) = ng_shell(nshell) + 1 END IF END DO @@ -248,19 +248,19 @@ SUBROUTINE xray_diffraction_spectrum(qs_env, unit_number, q_max) f2sum(ishell) = 0.0_dp f4sum(ishell) = 0.0_dp DO ig_shell = 1, ng_shell(ishell) - f = ABS(rhotot_elec_gspace%pw%cc(ig+ig_shell)) + f = ABS(rhotot_elec_gspace%pw%cc(ig + ig_shell)) fmin(ishell) = MIN(fmin(ishell), f) fmax(ishell) = MAX(fmax(ishell), f) - fsum(ishell) = fsum(ishell)+f + fsum(ishell) = fsum(ishell) + f f2 = f*f - f2sum(ishell) = f2sum(ishell)+f2 - f4sum(ishell) = f4sum(ishell)+f2*f2 + f2sum(ishell) = f2sum(ishell) + f2 + f4sum(ishell) = f4sum(ishell) + f2*f2 END DO - ig = ig+ng_shell(ishell) + ig = ig + ng_shell(ishell) END DO - CALL reallocate(nshell_pe, 0, npe-1) - CALL reallocate(offset_pe, 0, npe-1) + CALL reallocate(nshell_pe, 0, npe - 1) + CALL reallocate(offset_pe, 0, npe - 1) ! Root (source) process gathers the number of shell of each process @@ -272,8 +272,8 @@ SUBROUTINE xray_diffraction_spectrum(qs_env, unit_number, q_max) IF (unit_number > 0) THEN nshell_gather = SUM(nshell_pe) offset_pe(0) = 0 - DO ipe = 1, npe-1 - offset_pe(ipe) = offset_pe(ipe-1)+nshell_pe(ipe-1) + DO ipe = 1, npe - 1 + offset_pe(ipe) = offset_pe(ipe - 1) + nshell_pe(ipe - 1) END DO ELSE nshell_gather = 1 ! dummy value for the non-root processes @@ -337,8 +337,8 @@ SUBROUTINE xray_diffraction_spectrum(qs_env, unit_number, q_max) DO ig = 2, nshell_gather i = aux_index(ig) - IF (ABS(q_shell_gather(ig)-q_shell_gather(jg)) > 1.0E-12_dp) THEN - nshell = nshell+1 + IF (ABS(q_shell_gather(ig) - q_shell_gather(jg)) > 1.0E-12_dp) THEN + nshell = nshell + 1 q_shell(nshell) = q_shell_gather(ig) ng_shell(nshell) = ng_shell_gather(i) fmin(nshell) = fmin_gather(i) @@ -348,12 +348,12 @@ SUBROUTINE xray_diffraction_spectrum(qs_env, unit_number, q_max) f4sum(nshell) = f4sum_gather(i) jg = ig ELSE - ng_shell(nshell) = ng_shell(nshell)+ng_shell_gather(i) + ng_shell(nshell) = ng_shell(nshell) + ng_shell_gather(i) fmin(nshell) = MIN(fmin(nshell), fmin_gather(i)) fmax(nshell) = MAX(fmax(nshell), fmax_gather(i)) - fsum(nshell) = fsum(nshell)+fsum_gather(i) - f2sum(nshell) = f2sum(nshell)+f2sum_gather(i) - f4sum(nshell) = f4sum(nshell)+f4sum_gather(i) + fsum(nshell) = fsum(nshell) + fsum_gather(i) + f2sum(nshell) = f2sum(nshell) + f2sum_gather(i) + f4sum(nshell) = f4sum(nshell) + f4sum_gather(i) END IF END DO @@ -659,35 +659,35 @@ SUBROUTINE calculate_rhotot_elec_gspace(qs_env, auxbas_pw_pool, & ELSE alpha = 1.0_dp END IF - delta_cpc = delta_cpc+alpha*(cpc_h(ispin)%r_coef-cpc_s(ispin)%r_coef) + delta_cpc = delta_cpc + alpha*(cpc_h(ispin)%r_coef - cpc_s(ispin)%r_coef) END DO scale = 1.0_dp DO iset = 1, nset - ico1_set = (iset-1)*maxco+1 - iso1_set = (iset-1)*maxso+1 + ico1_set = (iset - 1)*maxco + 1 + iso1_set = (iset - 1)*maxso + 1 ncoa = ncoset(lmax(iset)) nsoa = nsoset(lmax(iset)) DO jset = 1, nset - jco1_set = (jset-1)*maxco+1 - jso1_set = (jset-1)*maxso+1 + jco1_set = (jset - 1)*maxco + 1 + jso1_set = (jset - 1)*maxso + 1 ncob = ncoset(lmax(jset)) nsob = nsoset(lmax(jset)) DO ipgf = 1, npgf(iset) - ico1_pgf = ico1_set+(ipgf-1)*ncoa - iso1_pgf = iso1_set+(ipgf-1)*nsoa + ico1_pgf = ico1_set + (ipgf - 1)*ncoa + iso1_pgf = iso1_set + (ipgf - 1)*nsoa DO jpgf = 1, npgf(jset) - jco1_pgf = jco1_set+(jpgf-1)*ncob - jso1_pgf = jso1_set+(jpgf-1)*nsob - ico = ico1_pgf+ncoset(lmin(iset)-1) - iso = iso1_pgf+nsoset(lmin(iset)-1) + jco1_pgf = jco1_set + (jpgf - 1)*ncob + jso1_pgf = jso1_set + (jpgf - 1)*nsob + ico = ico1_pgf + ncoset(lmin(iset) - 1) + iso = iso1_pgf + nsoset(lmin(iset) - 1) ! Transformation spherical to Cartesian DO la = lmin(iset), lmax(iset) - jco = jco1_pgf+ncoset(lmin(jset)-1) - jso = jso1_pgf+nsoset(lmin(jset)-1) + jco = jco1_pgf + ncoset(lmin(jset) - 1) + jso = jso1_pgf + nsoset(lmin(jset) - 1) DO lb = lmin(jset), lmax(jset) ison = o2nindex(iso) json = o2nindex(jso) @@ -698,17 +698,17 @@ SUBROUTINE calculate_rhotot_elec_gspace(qs_env, auxbas_pw_pool, & CALL dgemm("T", "N", nco(la), nco(lb), nso(la), 1.0_dp, & orbtramat(la)%slm, nso(la), work, maxso, & 0.0_dp, pab(ico, jco), SIZE(pab, 1)) - jco = jco+nco(lb) - jso = jso+nso(lb) + jco = jco + nco(lb) + jso = jso + nso(lb) END DO ! next lb - ico = ico+nco(la) - iso = iso+nso(la) + ico = ico + nco(la) + iso = iso + nso(la) END DO ! next la ! Collocate current product of primitive Cartesian functions - na = ico1_pgf-1 - nb = jco1_pgf-1 + na = ico1_pgf - 1 + nb = jco1_pgf - 1 CALL collocate_pgf_product_gspace( & la_max=lmax(iset), & @@ -737,7 +737,7 @@ SUBROUTINE calculate_rhotot_elec_gspace(qs_env, auxbas_pw_pool, & rho_total = pw_integrate_function(rhotot_elec_gspace%pw, isign=-1)/volume - rho_hard = rho_total-rho_soft + rho_hard = rho_total - rho_soft ! Release work storage diff --git a/src/xtb_coulomb.F b/src/xtb_coulomb.F index 56fd37e289..f0fbc0b26e 100644 --- a/src/xtb_coulomb.F +++ b/src/xtb_coulomb.F @@ -212,25 +212,25 @@ SUBROUTINE build_xtb_coulomb(qs_env, ks_matrix, rho, charges, mcharge, energy, & CALL get_xtb_atom_param(xtb_atom_a, eta=etaa, lmax=lmaxa, kappa=kappaa, rcut=rcuta) CALL get_xtb_atom_param(xtb_atom_b, eta=etab, lmax=lmaxb, kappa=kappab, rcut=rcutb) ! gamma matrix - ni = lmaxa+1 - nj = lmaxb+1 + ni = lmaxa + 1 + nj = lmaxb + 1 ALLOCATE (gammab(ni, nj)) - rcut = rcuta+rcutb + rcut = rcuta + rcutb dr = SQRT(SUM(rij(:)**2)) CALL gamma_rab_sr(gammab, dr, ni, kappaa, etaa, nj, kappab, etab, kg, rcut) - gchrg(iatom, 1:ni, 1) = gchrg(iatom, 1:ni, 1)+MATMUL(gammab, charges(jatom, 1:nj)) + gchrg(iatom, 1:ni, 1) = gchrg(iatom, 1:ni, 1) + MATMUL(gammab, charges(jatom, 1:nj)) IF (iatom /= jatom) THEN - gchrg(jatom, 1:nj, 1) = gchrg(jatom, 1:nj, 1)+MATMUL(charges(iatom, 1:ni), gammab) + gchrg(jatom, 1:nj, 1) = gchrg(jatom, 1:nj, 1) + MATMUL(charges(iatom, 1:ni), gammab) END IF IF (calculate_forces) THEN IF (dr > 1.e-6_dp) THEN CALL dgamma_rab_sr(gammab, dr, ni, kappaa, etaa, nj, kappab, etab, kg, rcut) DO i = 1, 3 - gchrg(iatom, 1:ni, i+1) = gchrg(iatom, 1:ni, i+1) & - +MATMUL(gammab, charges(jatom, 1:nj))*rij(i)/dr + gchrg(iatom, 1:ni, i + 1) = gchrg(iatom, 1:ni, i + 1) & + + MATMUL(gammab, charges(jatom, 1:nj))*rij(i)/dr IF (iatom /= jatom) THEN - gchrg(jatom, 1:nj, i+1) = gchrg(jatom, 1:nj, i+1) & - -MATMUL(charges(iatom, 1:ni), gammab)*rij(i)/dr + gchrg(jatom, 1:nj, i + 1) = gchrg(jatom, 1:nj, i + 1) & + - MATMUL(charges(iatom, 1:ni), gammab)*rij(i)/dr END IF END DO IF (use_virial) THEN @@ -284,16 +284,16 @@ SUBROUTINE build_xtb_coulomb(qs_env, ks_matrix, rho, charges, mcharge, energy, & DO ikind = 1, SIZE(local_particles%n_el) DO ia = 1, local_particles%n_el(ikind) iatom = local_particles%list(ikind)%array(ia) - DO jatom = 1, iatom-1 - rij = particle_set(iatom)%r-particle_set(jatom)%r + DO jatom = 1, iatom - 1 + rij = particle_set(iatom)%r - particle_set(jatom)%r rij = pbc(rij, cell) dr = SQRT(SUM(rij(:)**2)) IF (dr > 1.e-6_dp) THEN - gmcharge(iatom, 1) = gmcharge(iatom, 1)+mcharge(jatom)/dr - gmcharge(jatom, 1) = gmcharge(jatom, 1)+mcharge(iatom)/dr + gmcharge(iatom, 1) = gmcharge(iatom, 1) + mcharge(jatom)/dr + gmcharge(jatom, 1) = gmcharge(jatom, 1) + mcharge(iatom)/dr DO i = 2, nmat - gmcharge(iatom, i) = gmcharge(iatom, i)+rij(i-1)*mcharge(jatom)/dr**3 - gmcharge(jatom, i) = gmcharge(jatom, i)-rij(i-1)*mcharge(iatom)/dr**3 + gmcharge(iatom, i) = gmcharge(iatom, i) + rij(i - 1)*mcharge(jatom)/dr**3 + gmcharge(jatom, i) = gmcharge(jatom, i) - rij(i - 1)*mcharge(iatom)/dr**3 END DO END IF END DO @@ -311,9 +311,9 @@ SUBROUTINE build_xtb_coulomb(qs_env, ks_matrix, rho, charges, mcharge, energy, & IF (do_ewald) THEN ! add self charge interaction and background charge contribution - gmcharge(:, 1) = gmcharge(:, 1)-2._dp*alpha*oorootpi*mcharge(:) + gmcharge(:, 1) = gmcharge(:, 1) - 2._dp*alpha*oorootpi*mcharge(:) IF (ANY(periodic(:) == 1)) THEN - gmcharge(:, 1) = gmcharge(:, 1)-pi/alpha**2/deth + gmcharge(:, 1) = gmcharge(:, 1) - pi/alpha**2/deth END IF END IF @@ -327,25 +327,25 @@ SUBROUTINE build_xtb_coulomb(qs_env, ks_matrix, rho, charges, mcharge, energy, & ikind = kind_of(iatom) CALL get_qs_kind(qs_kind_set(ikind), xtb_parameter=xtb_kind) CALL get_xtb_atom_param(xtb_kind, lmax=ni) - ni = ni+1 - ecsr = ecsr+SUM(charges(iatom, 1:ni)*gchrg(iatom, 1:ni, 1)) + ni = ni + 1 + ecsr = ecsr + SUM(charges(iatom, 1:ni)*gchrg(iatom, 1:ni, 1)) END DO - energy%hartree = energy%hartree+0.5_dp*ecsr - energy%hartree = energy%hartree+0.5_dp*SUM(mcharge(:)*gmcharge(:, 1)) + energy%hartree = energy%hartree + 0.5_dp*ecsr + energy%hartree = energy%hartree + 0.5_dp*SUM(mcharge(:)*gmcharge(:, 1)) IF (atprop%energy) THEN CALL get_qs_env(qs_env=qs_env, local_particles=local_particles) DO ikind = 1, SIZE(local_particles%n_el) CALL get_qs_kind(qs_kind_set(ikind), xtb_parameter=xtb_kind) CALL get_xtb_atom_param(xtb_kind, lmax=ni, occupation=occ) - ni = ni+1 + ni = ni + 1 zeff = SUM(REAL(occ, KIND=dp)) DO ia = 1, local_particles%n_el(ikind) iatom = local_particles%list(ikind)%array(ia) - atprop%atecoul(iatom) = atprop%atecoul(iatom)+ & + atprop%atecoul(iatom) = atprop%atecoul(iatom) + & 0.5_dp*SUM(REAL(occ(1:ni), KIND=dp)*gchrg(iatom, 1:ni, 1)) - atprop%atecoul(iatom) = atprop%atecoul(iatom)+ & + atprop%atecoul(iatom) = atprop%atecoul(iatom) + & 0.5_dp*zeff*gmcharge(iatom, 1) END DO END DO @@ -358,20 +358,20 @@ SUBROUTINE build_xtb_coulomb(qs_env, ks_matrix, rho, charges, mcharge, energy, & CALL get_qs_kind(qs_kind_set(ikind), xtb_parameter=xtb_kind) CALL get_xtb_atom_param(xtb_kind, lmax=ni) ! short range - ni = ni+1 + ni = ni + 1 DO i = 1, 3 - fij(i) = SUM(charges(iatom, 1:ni)*gchrg(iatom, 1:ni, i+1)) + fij(i) = SUM(charges(iatom, 1:ni)*gchrg(iatom, 1:ni, i + 1)) END DO - force(ikind)%rho_elec(1, atom_i) = force(ikind)%rho_elec(1, atom_i)-fij(1) - force(ikind)%rho_elec(2, atom_i) = force(ikind)%rho_elec(2, atom_i)-fij(2) - force(ikind)%rho_elec(3, atom_i) = force(ikind)%rho_elec(3, atom_i)-fij(3) + force(ikind)%rho_elec(1, atom_i) = force(ikind)%rho_elec(1, atom_i) - fij(1) + force(ikind)%rho_elec(2, atom_i) = force(ikind)%rho_elec(2, atom_i) - fij(2) + force(ikind)%rho_elec(3, atom_i) = force(ikind)%rho_elec(3, atom_i) - fij(3) ! long range DO i = 1, 3 - fij(i) = gmcharge(iatom, i+1)*mcharge(iatom) + fij(i) = gmcharge(iatom, i + 1)*mcharge(iatom) END DO - force(ikind)%rho_elec(1, atom_i) = force(ikind)%rho_elec(1, atom_i)-fij(1) - force(ikind)%rho_elec(2, atom_i) = force(ikind)%rho_elec(2, atom_i)-fij(2) - force(ikind)%rho_elec(3, atom_i) = force(ikind)%rho_elec(3, atom_i)-fij(3) + force(ikind)%rho_elec(1, atom_i) = force(ikind)%rho_elec(1, atom_i) - fij(1) + force(ikind)%rho_elec(2, atom_i) = force(ikind)%rho_elec(2, atom_i) - fij(2) + force(ikind)%rho_elec(3, atom_i) = force(ikind)%rho_elec(3, atom_i) - fij(3) END DO END IF @@ -419,19 +419,19 @@ SUBROUTINE build_xtb_coulomb(qs_env, ks_matrix, rho, charges, mcharge, energy, & ALLOCATE (gcij(ni, nj)) DO i = 1, ni DO j = 1, nj - la = laoa(i)+1 - lb = laob(j)+1 - gcij(i, j) = 0.5_dp*(gchrg(irow, la, 1)+gchrg(icol, lb, 1)) + la = laoa(i) + 1 + lb = laob(j) + 1 + gcij(i, j) = 0.5_dp*(gchrg(irow, la, 1) + gchrg(icol, lb, 1)) END DO END DO - gmij = 0.5_dp*(gmcharge(irow, 1)+gmcharge(icol, 1)) + gmij = 0.5_dp*(gmcharge(irow, 1) + gmcharge(icol, 1)) DO is = 1, SIZE(ks_matrix, 1) NULLIFY (ksblock) CALL dbcsr_get_block_p(matrix=ks_matrix(is, 1)%matrix, & row=irow, col=icol, block=ksblock, found=found) CPASSERT(found) - ksblock = ksblock-gcij*sblock - ksblock = ksblock-gmij*sblock + ksblock = ksblock - gcij*sblock + ksblock = ksblock - gmij*sblock END DO IF (calculate_forces) THEN atom_i = atom_of_kind(irow) @@ -442,20 +442,20 @@ SUBROUTINE build_xtb_coulomb(qs_env, ks_matrix, rho, charges, mcharge, energy, & CPASSERT(found) DO i = 1, 3 NULLIFY (dsblock) - CALL dbcsr_get_block_p(matrix=matrix_s(1+i, 1)%matrix, & + CALL dbcsr_get_block_p(matrix=matrix_s(1 + i, 1)%matrix, & row=irow, col=icol, block=dsblock, found=found) CPASSERT(found) fij(i) = 0.0_dp ! short range fi = -2.0_dp*SUM(pblock*dsblock*gcij) - force(ikind)%rho_elec(i, atom_i) = force(ikind)%rho_elec(i, atom_i)+fi - force(jkind)%rho_elec(i, atom_j) = force(jkind)%rho_elec(i, atom_j)-fi - fij(i) = fij(i)+fi + force(ikind)%rho_elec(i, atom_i) = force(ikind)%rho_elec(i, atom_i) + fi + force(jkind)%rho_elec(i, atom_j) = force(jkind)%rho_elec(i, atom_j) - fi + fij(i) = fij(i) + fi ! long range fi = -2.0_dp*gmij*SUM(pblock*dsblock) - force(ikind)%rho_elec(i, atom_i) = force(ikind)%rho_elec(i, atom_i)+fi - force(jkind)%rho_elec(i, atom_j) = force(jkind)%rho_elec(i, atom_j)-fi - fij(i) = fij(i)+fi + force(ikind)%rho_elec(i, atom_i) = force(ikind)%rho_elec(i, atom_i) + fi + force(jkind)%rho_elec(i, atom_j) = force(jkind)%rho_elec(i, atom_j) - fi + fij(i) = fij(i) + fi END DO END IF DEALLOCATE (gcij) @@ -465,7 +465,7 @@ SUBROUTINE build_xtb_coulomb(qs_env, ks_matrix, rho, charges, mcharge, energy, & IF (do_gamma_stress) THEN DO ikind = 1, nkind DO jkind = 1, nkind - iac = ikind+nkind*(jkind-1) + iac = ikind + nkind*(jkind - 1) IF (.NOT. ASSOCIATED(sap_int(iac)%alist)) CYCLE ! atomic parameters CALL get_qs_kind(qs_kind_set(ikind), xtb_parameter=xtb_atom_a) @@ -484,12 +484,12 @@ SUBROUTINE build_xtb_coulomb(qs_env, ks_matrix, rho, charges, mcharge, energy, & ALLOCATE (gcij(ni, nj)) DO i = 1, ni DO j = 1, nj - la = laoa(i)+1 - lb = laob(j)+1 - gcij(i, j) = 0.5_dp*(gchrg(iatom, la, 1)+gchrg(jatom, lb, 1)) + la = laoa(i) + 1 + lb = laob(j) + 1 + gcij(i, j) = 0.5_dp*(gchrg(iatom, la, 1) + gchrg(jatom, lb, 1)) END DO END DO - gmij = 0.5_dp*(gmcharge(iatom, 1)+gmcharge(jatom, 1)) + gmij = 0.5_dp*(gmcharge(iatom, 1) + gmcharge(jatom, 1)) icol = MAX(iatom, jatom) irow = MIN(iatom, jatom) NULLIFY (pblock) @@ -506,7 +506,7 @@ SUBROUTINE build_xtb_coulomb(qs_env, ks_matrix, rho, charges, mcharge, energy, & f1 = -2.0_dp*SUM(TRANSPOSE(pblock)*dsint(:, :, i)*gcij) f2 = -2.0_dp*gmij*SUM(TRANSPOSE(pblock)*dsint(:, :, i)) END IF - fij(i) = f1+f2 + fij(i) = f1 + f2 END DO DEALLOCATE (gcij) fi = 1.0_dp @@ -553,24 +553,24 @@ SUBROUTINE build_xtb_coulomb(qs_env, ks_matrix, rho, charges, mcharge, energy, & DO i = 1, ni DO j = 1, nj IF (irow == iatom) THEN - la = laoa(i)+1 - lb = laob(j)+1 - gcij(i, j) = 0.5_dp*(gchrg(iatom, la, 1)+gchrg(jatom, lb, 1)) + la = laoa(i) + 1 + lb = laob(j) + 1 + gcij(i, j) = 0.5_dp*(gchrg(iatom, la, 1) + gchrg(jatom, lb, 1)) ELSE - la = laoa(j)+1 - lb = laob(i)+1 - gcij(i, j) = 0.5_dp*(gchrg(iatom, la, 1)+gchrg(jatom, lb, 1)) + la = laoa(j) + 1 + lb = laob(i) + 1 + gcij(i, j) = 0.5_dp*(gchrg(iatom, la, 1) + gchrg(jatom, lb, 1)) END IF END DO END DO - gmij = 0.5_dp*(gmcharge(iatom, 1)+gmcharge(jatom, 1)) + gmij = 0.5_dp*(gmcharge(iatom, 1) + gmcharge(jatom, 1)) DO is = 1, SIZE(ks_matrix, 1) NULLIFY (ksblock) CALL dbcsr_get_block_p(matrix=ks_matrix(is, ic)%matrix, & row=irow, col=icol, block=ksblock, found=found) CPASSERT(found) - ksblock = ksblock-gcij*sblock - ksblock = ksblock-gmij*sblock + ksblock = ksblock - gcij*sblock + ksblock = ksblock - gmij*sblock END DO IF (calculate_forces) THEN @@ -586,20 +586,20 @@ SUBROUTINE build_xtb_coulomb(qs_env, ks_matrix, rho, charges, mcharge, energy, & CPASSERT(found) DO i = 1, 3 NULLIFY (dsblock) - CALL dbcsr_get_block_p(matrix=matrix_s(1+i, ic)%matrix, & + CALL dbcsr_get_block_p(matrix=matrix_s(1 + i, ic)%matrix, & row=irow, col=icol, block=dsblock, found=found) CPASSERT(found) fij(i) = 0.0_dp ! short range fi = -2.0_dp*SUM(pblock*dsblock*gcij) - force(ikind)%rho_elec(i, atom_i) = force(ikind)%rho_elec(i, atom_i)+fi - force(jkind)%rho_elec(i, atom_j) = force(jkind)%rho_elec(i, atom_j)-fi - fij(i) = fij(i)+fi + force(ikind)%rho_elec(i, atom_i) = force(ikind)%rho_elec(i, atom_i) + fi + force(jkind)%rho_elec(i, atom_j) = force(jkind)%rho_elec(i, atom_j) - fi + fij(i) = fij(i) + fi ! long range fi = -2.0_dp*gmij*SUM(pblock*dsblock) - force(ikind)%rho_elec(i, atom_i) = force(ikind)%rho_elec(i, atom_i)+fi - force(jkind)%rho_elec(i, atom_j) = force(jkind)%rho_elec(i, atom_j)-fi - fij(i) = fij(i)+fi + force(ikind)%rho_elec(i, atom_i) = force(ikind)%rho_elec(i, atom_i) + fi + force(jkind)%rho_elec(i, atom_j) = force(jkind)%rho_elec(i, atom_j) - fi + fij(i) = fij(i) + fi END DO IF (use_virial) THEN dr = SQRT(SUM(rij(:)**2)) @@ -700,7 +700,7 @@ SUBROUTINE gamma_rab_sr(gmat, rab, nla, kappaa, etaa, nlb, kappab, etab, kg, rcu DO j = 1, nlb DO i = 1, nla - eta(i, j) = 1._dp/(etaa*(1._dp+kappaa(i)))+1._dp/(etab*(1._dp+kappab(j))) + eta(i, j) = 1._dp/(etaa*(1._dp + kappaa(i))) + 1._dp/(etab*(1._dp + kappab(j))) eta(i, j) = 2._dp/eta(i, j) END DO END DO @@ -714,14 +714,14 @@ SUBROUTINE gamma_rab_sr(gmat, rab, nla, kappaa, etaa, nlb, kappab, etab, kg, rcu ELSE rk = rab**kg eta = eta**(-kg) - IF (rab < rcut-rsmooth) THEN + IF (rab < rcut - rsmooth) THEN fcut = 1.0_dp ELSE - r = rab-(rcut-rsmooth) + r = rab - (rcut - rsmooth) x = r/rsmooth - fcut = -6._dp*x**5+15._dp*x**4-10._dp*x**3+1._dp + fcut = -6._dp*x**5 + 15._dp*x**4 - 10._dp*x**3 + 1._dp END IF - gmat(:, :) = fcut*(1._dp/(rk+eta(:, :)))**(1._dp/kg)-fcut/rab + gmat(:, :) = fcut*(1._dp/(rk + eta(:, :)))**(1._dp/kg) - fcut/rab END IF DEALLOCATE (eta) @@ -770,7 +770,7 @@ SUBROUTINE dgamma_rab_sr(dgmat, rab, nla, kappaa, etaa, nlb, kappab, etab, kg, r DO j = 1, nlb DO i = 1, nla - eta(i, j) = 1._dp/(etaa*(1._dp+kappaa(i)))+1._dp/(etab*(1._dp+kappab(j))) + eta(i, j) = 1._dp/(etaa*(1._dp + kappaa(i))) + 1._dp/(etab*(1._dp + kappab(j))) eta(i, j) = 2._dp/eta(i, j) END DO END DO @@ -783,19 +783,19 @@ SUBROUTINE dgamma_rab_sr(dgmat, rab, nla, kappaa, etaa, nlb, kappab, etab, kg, r ELSE eta = eta**(-kg) rk = rab**kg - IF (rab < rcut-rsmooth) THEN + IF (rab < rcut - rsmooth) THEN fcut = 1.0_dp dfcut = 0.0_dp ELSE - r = rab-(rcut-rsmooth) + r = rab - (rcut - rsmooth) x = r/rsmooth - fcut = -6._dp*x**5+15._dp*x**4-10._dp*x**3+1._dp - dfcut = -30._dp*x**4+60._dp*x**3-30._dp*x**2 + fcut = -6._dp*x**5 + 15._dp*x**4 - 10._dp*x**3 + 1._dp + dfcut = -30._dp*x**4 + 60._dp*x**3 - 30._dp*x**2 dfcut = dfcut/rsmooth END IF - dgmat(:, :) = dfcut*(1._dp/(rk+eta(:, :)))**(1._dp/kg) - dgmat(:, :) = dgmat(:, :)-dfcut/rab+fcut/rab**2 - dgmat(:, :) = dgmat(:, :)-fcut/(rk+eta(:, :))*(1._dp/(rk+eta(:, :)))**(1._dp/kg)*rk/rab + dgmat(:, :) = dfcut*(1._dp/(rk + eta(:, :)))**(1._dp/kg) + dgmat(:, :) = dgmat(:, :) - dfcut/rab + fcut/rab**2 + dgmat(:, :) = dgmat(:, :) - fcut/(rk + eta(:, :))*(1._dp/(rk + eta(:, :)))**(1._dp/kg)*rk/rab END IF DEALLOCATE (eta) @@ -863,7 +863,7 @@ SUBROUTINE xtb_dsint_list(qs_env, sap_int) CALL get_iterator_info(nl_iterator, ikind=ikind, jkind=jkind, iatom=iatom, & jatom=jatom, nlist=nlist, ilist=ilist, nnode=nneighbor, & inode=jneighbor, cell=cell, r=rij) - iac = ikind+nkind*(jkind-1) + iac = ikind + nkind*(jkind - 1) ! CALL get_qs_kind(qs_kind_set(ikind), xtb_parameter=xtb_atom_a) CALL get_xtb_atom_param(xtb_atom_a, defined=defined, natorb=natorb_a) @@ -939,12 +939,12 @@ SUBROUTINE xtb_dsint_list(qs_env, sap_int) DO iset = 1, nseta ncoa = npgfa(iset)*ncoset(la_max(iset)) - n1 = npgfa(iset)*(ncoset(la_max(iset))-ncoset(la_min(iset)-1)) + n1 = npgfa(iset)*(ncoset(la_max(iset)) - ncoset(la_min(iset) - 1)) sgfa = first_sgfa(1, iset) DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dr) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dr) CYCLE ncob = npgfb(jset)*ncoset(lb_max(jset)) - n2 = npgfb(jset)*(ncoset(lb_max(jset))-ncoset(lb_min(jset)-1)) + n2 = npgfb(jset)*(ncoset(lb_max(jset)) - ncoset(lb_min(jset) - 1)) sgfb = first_sgfb(1, jset) CALL overlap_ab(la_max(iset), la_min(iset), npgfa(iset), rpgfa(:, iset), zeta(:, iset), & lb_max(jset), lb_min(jset), npgfb(jset), rpgfb(:, jset), zetb(:, jset), & diff --git a/src/xtb_ehess.F b/src/xtb_ehess.F index d56d3515e0..892d792900 100644 --- a/src/xtb_ehess.F +++ b/src/xtb_ehess.F @@ -154,15 +154,15 @@ SUBROUTINE xtb_coulomb_hessian(qs_env, ks_matrix, charges1, mcharge1, mcharge) CALL get_xtb_atom_param(xtb_atom_a, eta=etaa, lmax=lmaxa, kappa=kappaa, rcut=rcuta) CALL get_xtb_atom_param(xtb_atom_b, eta=etab, lmax=lmaxb, kappa=kappab, rcut=rcutb) ! gamma matrix - ni = lmaxa+1 - nj = lmaxb+1 + ni = lmaxa + 1 + nj = lmaxb + 1 ALLOCATE (gammab(ni, nj)) - rcut = rcuta+rcutb + rcut = rcuta + rcutb dr = SQRT(SUM(rij(:)**2)) CALL gamma_rab_sr(gammab, dr, ni, kappaa, etaa, nj, kappab, etab, kg, rcut) - gchrg(iatom, 1:ni, 1) = gchrg(iatom, 1:ni, 1)+MATMUL(gammab, charges1(jatom, 1:nj)) + gchrg(iatom, 1:ni, 1) = gchrg(iatom, 1:ni, 1) + MATMUL(gammab, charges1(jatom, 1:nj)) IF (iatom /= jatom) THEN - gchrg(jatom, 1:nj, 1) = gchrg(jatom, 1:nj, 1)+MATMUL(charges1(iatom, 1:ni), gammab) + gchrg(jatom, 1:nj, 1) = gchrg(jatom, 1:nj, 1) + MATMUL(charges1(iatom, 1:ni), gammab) END IF DEALLOCATE (gammab) END DO @@ -201,13 +201,13 @@ SUBROUTINE xtb_coulomb_hessian(qs_env, ks_matrix, charges1, mcharge1, mcharge) DO ikind = 1, SIZE(local_particles%n_el) DO ia = 1, local_particles%n_el(ikind) iatom = local_particles%list(ikind)%array(ia) - DO jatom = 1, iatom-1 - rij = particle_set(iatom)%r-particle_set(jatom)%r + DO jatom = 1, iatom - 1 + rij = particle_set(iatom)%r - particle_set(jatom)%r rij = pbc(rij, cell) dr = SQRT(SUM(rij(:)**2)) IF (dr > 1.e-6_dp) THEN - gmcharge(iatom, 1) = gmcharge(iatom, 1)+mcharge1(jatom)/dr - gmcharge(jatom, 1) = gmcharge(jatom, 1)+mcharge1(iatom)/dr + gmcharge(iatom, 1) = gmcharge(iatom, 1) + mcharge1(jatom)/dr + gmcharge(jatom, 1) = gmcharge(jatom, 1) + mcharge1(iatom)/dr END IF END DO END DO @@ -221,9 +221,9 @@ SUBROUTINE xtb_coulomb_hessian(qs_env, ks_matrix, charges1, mcharge1, mcharge) IF (do_ewald) THEN ! add self charge interaction and background charge contribution - gmcharge(:, 1) = gmcharge(:, 1)-2._dp*alpha*oorootpi*mcharge(:) + gmcharge(:, 1) = gmcharge(:, 1) - 2._dp*alpha*oorootpi*mcharge(:) IF (ANY(periodic(:) == 1)) THEN - gmcharge(:, 1) = gmcharge(:, 1)-pi/alpha**2/deth + gmcharge(:, 1) = gmcharge(:, 1) - pi/alpha**2/deth END IF END IF @@ -249,19 +249,19 @@ SUBROUTINE xtb_coulomb_hessian(qs_env, ks_matrix, charges1, mcharge1, mcharge) ALLOCATE (gcij(ni, nj)) DO i = 1, ni DO j = 1, nj - la = laoa(i)+1 - lb = laob(j)+1 - gcij(i, j) = 0.5_dp*(gchrg(irow, la, 1)+gchrg(icol, lb, 1)) + la = laoa(i) + 1 + lb = laob(j) + 1 + gcij(i, j) = 0.5_dp*(gchrg(irow, la, 1) + gchrg(icol, lb, 1)) END DO END DO - gmij = 0.5_dp*(gmcharge(irow, 1)+gmcharge(icol, 1)) + gmij = 0.5_dp*(gmcharge(irow, 1) + gmcharge(icol, 1)) DO is = 1, SIZE(ks_matrix) NULLIFY (ksblock) CALL dbcsr_get_block_p(matrix=ks_matrix(is)%matrix, & row=irow, col=icol, block=ksblock, found=found) CPASSERT(found) - ksblock = ksblock-gcij*sblock - ksblock = ksblock-gmij*sblock + ksblock = ksblock - gcij*sblock + ksblock = ksblock - gmij*sblock END DO DEALLOCATE (gcij) ENDDO @@ -331,13 +331,13 @@ SUBROUTINE dftb3_diagonal_hessian(qs_env, ks_matrix, mcharge, mcharge1, xgamma) ui = xgamma(ikind) jkind = kind_of(icol) uj = xgamma(jkind) - gmij = ui*mcharge(irow)*mcharge1(irow)+uj*mcharge(icol)*mcharge1(icol) + gmij = ui*mcharge(irow)*mcharge1(irow) + uj*mcharge(icol)*mcharge1(icol) DO is = 1, SIZE(ks_matrix) NULLIFY (ksblock) CALL dbcsr_get_block_p(matrix=ks_matrix(is)%matrix, & row=irow, col=icol, block=ksblock, found=found) CPASSERT(found) - ksblock = ksblock+0.5_dp*gmij*sblock + ksblock = ksblock + 0.5_dp*gmij*sblock END DO ENDDO CALL dbcsr_iterator_stop(iter) diff --git a/src/xtb_matrices.F b/src/xtb_matrices.F index fc77017153..51e30c83d6 100644 --- a/src/xtb_matrices.F +++ b/src/xtb_matrices.F @@ -336,7 +336,7 @@ SUBROUTINE build_xtb_matrices(qs_env, para_env, calculate_forces) CALL get_xtb_atom_param(xtb_atom_a, nshell=nshell, lval=lval, hen=hena) huckel(:, iatom) = 0.0_dp DO i = 1, nshell - huckel(i, iatom) = hena(i)*(1._dp+kcnlk(lval(i), ikind)*cnumbers(iatom)) + huckel(i, iatom) = hena(i)*(1._dp + kcnlk(lval(i), ikind)*cnumbers(iatom)) END DO END DO @@ -358,7 +358,7 @@ SUBROUTINE build_xtb_matrices(qs_env, para_env, calculate_forces) IF (.NOT. defined .OR. natorb_b < 1) CYCLE CALL get_xtb_atom_param(xtb_atom_b, z=zb, nao=naob, lao=laob, electronegativity=enb) ! get Fen = (1+ken*deltaEN^2) - fen = 1.0_dp+ken*(ena-enb)**2 + fen = 1.0_dp + ken*(ena - enb)**2 ! Kab kab = xtb_set_kab(za, zb) DO j = 1, natorb_b @@ -372,12 +372,12 @@ SUBROUTINE build_xtb_matrices(qs_env, para_env, calculate_forces) IF (zb == 1 .AND. nb == 2) kjb = k2sh IF (za == 1 .AND. na == 2) kia = k2sh IF ((zb == 1 .AND. nb == 2) .OR. (za == 1 .AND. na == 2)) THEN - kijab(i, j, ikind, jkind) = 0.5_dp*(kia+kjb) + kijab(i, j, ikind, jkind) = 0.5_dp*(kia + kjb) ELSE IF ((la == 0 .AND. lb == 1) .OR. (la == 1 .AND. lb == 0)) THEN kijab(i, j, ikind, jkind) = ksp*kab*fen ELSE - kijab(i, j, ikind, jkind) = 0.5_dp*(kia+kjb)*kab*fen + kijab(i, j, ikind, jkind) = 0.5_dp*(kia + kjb)*kab*fen END IF END IF END DO @@ -416,7 +416,7 @@ SUBROUTINE build_xtb_matrices(qs_env, para_env, calculate_forces) DO jkind = 1, nkind CALL get_qs_kind(qs_kind_set(jkind), xtb_parameter=xtb_atom_b) CALL get_xtb_atom_param(xtb_atom_b, rcov=rcovb) - rcab(ikind, jkind) = kxr*(rcova+rcovb) + rcab(ikind, jkind) = kxr*(rcova + rcovb) END DO END DO ! @@ -539,12 +539,12 @@ SUBROUTINE build_xtb_matrices(qs_env, para_env, calculate_forces) DO iset = 1, nseta ncoa = npgfa(iset)*ncoset(la_max(iset)) - n1 = npgfa(iset)*(ncoset(la_max(iset))-ncoset(la_min(iset)-1)) + n1 = npgfa(iset)*(ncoset(la_max(iset)) - ncoset(la_min(iset) - 1)) sgfa = first_sgfa(1, iset) DO jset = 1, nsetb - IF (set_radius_a(iset)+set_radius_b(jset) < dr) CYCLE + IF (set_radius_a(iset) + set_radius_b(jset) < dr) CYCLE ncob = npgfb(jset)*ncoset(lb_max(jset)) - n2 = npgfb(jset)*(ncoset(lb_max(jset))-ncoset(lb_min(jset)-1)) + n2 = npgfb(jset)*(ncoset(lb_max(jset)) - ncoset(lb_min(jset) - 1)) sgfb = first_sgfb(1, jset) IF (calculate_forces) THEN CALL overlap_ab(la_max(iset), la_min(iset), npgfa(iset), rpgfa(:, iset), zeta(:, iset), & @@ -572,14 +572,14 @@ SUBROUTINE build_xtb_matrices(qs_env, para_env, calculate_forces) IF (calculate_forces) THEN DO i = 1, 3 IF (iatom <= jatom) THEN - force_ab(i) = SUM(sint(:, :, i+1)*wblock(:, :)) + force_ab(i) = SUM(sint(:, :, i + 1)*wblock(:, :)) ELSE - force_ab(i) = SUM(sint(:, :, i+1)*TRANSPOSE(wblock(:, :))) + force_ab(i) = SUM(sint(:, :, i + 1)*TRANSPOSE(wblock(:, :))) END IF END DO f1 = 2.0_dp - force(ikind)%overlap(:, atom_a) = force(ikind)%overlap(:, atom_a)-f1*force_ab(:) - force(jkind)%overlap(:, atom_b) = force(jkind)%overlap(:, atom_b)+f1*force_ab(:) + force(ikind)%overlap(:, atom_a) = force(ikind)%overlap(:, atom_a) - f1*force_ab(:) + force(jkind)%overlap(:, atom_b) = force(jkind)%overlap(:, atom_b) + f1*force_ab(:) IF (use_virial .AND. dr > 1.e-3_dp) THEN IF (iatom == jatom) f1 = 1.0_dp CALL virial_pair_force(virial%pv_virial, -f1, force_ab, rij) @@ -591,28 +591,28 @@ SUBROUTINE build_xtb_matrices(qs_env, para_env, calculate_forces) END IF ! update S matrix IF (iatom <= jatom) THEN - sblock(:, :) = sblock(:, :)+sint(:, :, 1) + sblock(:, :) = sblock(:, :) + sint(:, :, 1) ELSE - sblock(:, :) = sblock(:, :)+TRANSPOSE(sint(:, :, 1)) + sblock(:, :) = sblock(:, :) + TRANSPOSE(sint(:, :, 1)) END IF IF (calculate_forces) THEN DO i = 2, 4 IF (iatom <= jatom) THEN - dsblocks(i)%block(:, :) = dsblocks(i)%block(:, :)+sint(:, :, i) + dsblocks(i)%block(:, :) = dsblocks(i)%block(:, :) + sint(:, :, i) ELSE - dsblocks(i)%block(:, :) = dsblocks(i)%block(:, :)-TRANSPOSE(sint(:, :, i)) + dsblocks(i)%block(:, :) = dsblocks(i)%block(:, :) - TRANSPOSE(sint(:, :, i)) END IF END DO END IF ! Calculate Pi = Pia * Pib (Eq. 11) - rcovab = rcova+rcovb + rcovab = rcova + rcovb rrab = SQRT(dr/rcovab) DO i = 1, nsa - pia(i) = 1._dp+kpolya(i)*rrab + pia(i) = 1._dp + kpolya(i)*rrab END DO DO i = 1, nsb - pib(i) = 1._dp+kpolyb(i)*rrab + pib(i) = 1._dp + kpolyb(i)*rrab END DO IF (calculate_forces) THEN IF (dr > 1.e-6_dp) THEN @@ -633,18 +633,18 @@ SUBROUTINE build_xtb_matrices(qs_env, para_env, calculate_forces) IF (diagblock) THEN DO i = 1, natorb_a na = naoa(i) - fblock(i, i) = fblock(i, i)+huckel(na, iatom) + fblock(i, i) = fblock(i, i) + huckel(na, iatom) END DO ELSE DO j = 1, natorb_b nb = naob(j) DO i = 1, natorb_a na = naoa(i) - hij = 0.5_dp*(huckel(na, iatom)+huckel(nb, jatom))*pia(na)*pib(nb) + hij = 0.5_dp*(huckel(na, iatom) + huckel(nb, jatom))*pia(na)*pib(nb) IF (iatom <= jatom) THEN - fblock(i, j) = fblock(i, j)+hij*sint(i, j, 1)*kijab(i, j, ikind, jkind) + fblock(i, j) = fblock(i, j) + hij*sint(i, j, 1)*kijab(i, j, ikind, jkind) ELSE - fblock(j, i) = fblock(j, i)+hij*sint(i, j, 1)*kijab(i, j, ikind, jkind) + fblock(j, i) = fblock(j, i) + hij*sint(i, j, 1)*kijab(i, j, ikind, jkind) END IF END DO END DO @@ -660,7 +660,7 @@ SUBROUTINE build_xtb_matrices(qs_env, para_env, calculate_forces) DO i = 1, natorb_a la = laoa(i) na = naoa(i) - fhud = fhud+pblock(i, i)*kcnlk(la, ikind)*hena(na) + fhud = fhud + pblock(i, i)*kcnlk(la, ikind)*hena(na) END DO ELSE DO j = 1, natorb_b @@ -671,11 +671,11 @@ SUBROUTINE build_xtb_matrices(qs_env, para_env, calculate_forces) na = naoa(i) hij = 0.5_dp*pia(na)*pib(nb) IF (iatom <= jatom) THEN - fhua = fhua+hij*kijab(i, j, ikind, jkind)*sint(i, j, 1)*pblock(i, j)*kcnlk(la, ikind)*hena(na) - fhub = fhub+hij*kijab(i, j, ikind, jkind)*sint(i, j, 1)*pblock(i, j)*kcnlk(lb, jkind)*henb(nb) + fhua = fhua + hij*kijab(i, j, ikind, jkind)*sint(i, j, 1)*pblock(i, j)*kcnlk(la, ikind)*hena(na) + fhub = fhub + hij*kijab(i, j, ikind, jkind)*sint(i, j, 1)*pblock(i, j)*kcnlk(lb, jkind)*henb(nb) ELSE - fhua = fhua+hij*kijab(i, j, ikind, jkind)*sint(i, j, 1)*pblock(j, i)*kcnlk(la, ikind)*hena(na) - fhub = fhub+hij*kijab(i, j, ikind, jkind)*sint(i, j, 1)*pblock(j, i)*kcnlk(lb, jkind)*henb(nb) + fhua = fhua + hij*kijab(i, j, ikind, jkind)*sint(i, j, 1)*pblock(j, i)*kcnlk(la, ikind)*hena(na) + fhub = fhub + hij*kijab(i, j, ikind, jkind)*sint(i, j, 1)*pblock(j, i)*kcnlk(lb, jkind)*henb(nb) END IF END DO END DO @@ -694,13 +694,13 @@ SUBROUTINE build_xtb_matrices(qs_env, para_env, calculate_forces) drk = SQRT(SUM(rik(:)**2)) IF (drk > 1.e-3_dp) THEN fdika(:) = fhua*dcnum(iatom)%dvals(i)*rik(:)/drk - force(ikind)%all_potential(:, atom_a) = force(ikind)%all_potential(:, atom_a)-fdika(:) - force(kkind)%all_potential(:, atom_c) = force(kkind)%all_potential(:, atom_c)+fdika(:) + force(ikind)%all_potential(:, atom_a) = force(ikind)%all_potential(:, atom_a) - fdika(:) + force(kkind)%all_potential(:, atom_c) = force(kkind)%all_potential(:, atom_c) + fdika(:) fdikb(:) = fhud*dcnum(iatom)%dvals(i)*rik(:)/drk - force(ikind)%all_potential(:, atom_a) = force(ikind)%all_potential(:, atom_a)-fdikb(:) - force(kkind)%all_potential(:, atom_c) = force(kkind)%all_potential(:, atom_c)+fdikb(:) + force(ikind)%all_potential(:, atom_a) = force(ikind)%all_potential(:, atom_a) - fdikb(:) + force(kkind)%all_potential(:, atom_c) = force(kkind)%all_potential(:, atom_c) + fdikb(:) IF (use_virial) THEN - fdik = fdika+fdikb + fdik = fdika + fdikb CALL virial_pair_force(virial%pv_virial, -1._dp, fdik, rik) IF (atprop%stress) THEN CALL virial_pair_force(atprop%atstress(:, :, iatom), -0.5_dp, fdik, rik) @@ -719,8 +719,8 @@ SUBROUTINE build_xtb_matrices(qs_env, para_env, calculate_forces) drk = SQRT(SUM(rik(:)**2)) IF (drk > 1.e-3_dp) THEN fdik(:) = fhub*dcnum(jatom)%dvals(i)*rik(:)/drk - force(jkind)%all_potential(:, atom_b) = force(jkind)%all_potential(:, atom_b)-fdik(:) - force(kkind)%all_potential(:, atom_c) = force(kkind)%all_potential(:, atom_c)+fdik(:) + force(jkind)%all_potential(:, atom_b) = force(jkind)%all_potential(:, atom_b) - fdik(:) + force(kkind)%all_potential(:, atom_c) = force(kkind)%all_potential(:, atom_c) + fdik(:) IF (use_virial) THEN CALL virial_pair_force(virial%pv_virial, -1._dp, fdik, rik) IF (atprop%stress) THEN @@ -744,11 +744,11 @@ SUBROUTINE build_xtb_matrices(qs_env, para_env, calculate_forces) DO i = 1, natorb_a la = laoa(i) na = naoa(i) - dhij = 0.5_dp*(huckel(na, iatom)+huckel(nb, jatom))*(dpia(na)*pib(nb)+pia(na)*dpib(nb)) + dhij = 0.5_dp*(huckel(na, iatom) + huckel(nb, jatom))*(dpia(na)*pib(nb) + pia(na)*dpib(nb)) IF (iatom <= jatom) THEN - dfblock(i, j) = dfblock(i, j)+dhij*sint(i, j, 1)*kijab(i, j, ikind, jkind) + dfblock(i, j) = dfblock(i, j) + dhij*sint(i, j, 1)*kijab(i, j, ikind, jkind) ELSE - dfblock(j, i) = dfblock(j, i)+dhij*sint(i, j, 1)*kijab(i, j, ikind, jkind) + dfblock(j, i) = dfblock(j, i) + dhij*sint(i, j, 1)*kijab(i, j, ikind, jkind) END IF END DO END DO @@ -762,11 +762,11 @@ SUBROUTINE build_xtb_matrices(qs_env, para_env, calculate_forces) DO i = 1, natorb_a la = laoa(i) na = naoa(i) - hij = 0.5_dp*(huckel(na, iatom)+huckel(nb, jatom))*pia(na)*pib(nb) + hij = 0.5_dp*(huckel(na, iatom) + huckel(nb, jatom))*pia(na)*pib(nb) IF (iatom <= jatom) THEN - foab = foab+2.0_dp*hij*sint(i, j, ir+1)*pblock(i, j)*kijab(i, j, ikind, jkind) + foab = foab + 2.0_dp*hij*sint(i, j, ir + 1)*pblock(i, j)*kijab(i, j, ikind, jkind) ELSE - foab = foab-2.0_dp*hij*sint(i, j, ir+1)*pblock(j, i)*kijab(i, j, ikind, jkind) + foab = foab - 2.0_dp*hij*sint(i, j, ir + 1)*pblock(j, i)*kijab(i, j, ikind, jkind) END IF END DO END DO @@ -780,8 +780,8 @@ SUBROUTINE build_xtb_matrices(qs_env, para_env, calculate_forces) atom_a = atom_of_kind(iatom) atom_b = atom_of_kind(jatom) IF (irow == iatom) force_ab = -force_ab - force(ikind)%all_potential(:, atom_a) = force(ikind)%all_potential(:, atom_a)-force_ab(:) - force(jkind)%all_potential(:, atom_b) = force(jkind)%all_potential(:, atom_b)+force_ab(:) + force(ikind)%all_potential(:, atom_a) = force(ikind)%all_potential(:, atom_a) - force_ab(:) + force(jkind)%all_potential(:, atom_b) = force(jkind)%all_potential(:, atom_b) + force_ab(:) IF (use_virial) THEN f1 = 1.0_dp IF (iatom == jatom) f1 = 0.5_dp @@ -798,20 +798,20 @@ SUBROUTINE build_xtb_matrices(qs_env, para_env, calculate_forces) ! repulsive potential IF (dr > 0.001_dp) THEN erepij = zneffa*zneffb/dr*EXP(-SQRT(alphaa*alphab)*dr**kf) - erep = erep+erepij + erep = erep + erepij IF (atprop%energy) THEN - atprop%atecc(iatom) = atprop%atecc(iatom)+0.5_dp*erepij - atprop%atecc(jatom) = atprop%atecc(jatom)+0.5_dp*erepij + atprop%atecc(iatom) = atprop%atecc(iatom) + 0.5_dp*erepij + atprop%atecc(jatom) = atprop%atecc(jatom) + 0.5_dp*erepij END IF IF (calculate_forces .AND. (iatom /= jatom .OR. dr > 0.001_dp)) THEN - derepij = -(1.0_dp/dr+SQRT(alphaa*alphab)*kf*dr**(kf-1.0_dp))*erepij + derepij = -(1.0_dp/dr + SQRT(alphaa*alphab)*kf*dr**(kf - 1.0_dp))*erepij force_rr(1) = derepij*rij(1)/dr force_rr(2) = derepij*rij(2)/dr force_rr(3) = derepij*rij(3)/dr atom_a = atom_of_kind(iatom) atom_b = atom_of_kind(jatom) - force(ikind)%repulsive(:, atom_a) = force(ikind)%repulsive(:, atom_a)-force_rr(:) - force(jkind)%repulsive(:, atom_b) = force(jkind)%repulsive(:, atom_b)+force_rr(:) + force(ikind)%repulsive(:, atom_a) = force(ikind)%repulsive(:, atom_a) - force_rr(:) + force(jkind)%repulsive(:, atom_b) = force(jkind)%repulsive(:, atom_b) + force_rr(:) IF (use_virial) THEN f1 = 1.0_dp IF (iatom == jatom) f1 = 0.5_dp @@ -841,7 +841,7 @@ SUBROUTINE build_xtb_matrices(qs_env, para_env, calculate_forces) calculate_forces, use_virial, force, virial, atprop) END IF ! set repulsive energy - erep = erep+exb + erep = erep + exb CALL mp_sum(erep, para_env%group) energy%repulsive = erep @@ -1041,8 +1041,8 @@ SUBROUTINE build_xtb_ks_matrix(qs_env, calculate_forces, just_energy) atom_a = atomic_kind_set(ikind)%atom_list(iatom) charges(atom_a, :) = REAL(occ(:), KIND=dp) DO is = 1, natorb - ns = lao(is)+1 - charges(atom_a, ns) = charges(atom_a, ns)-aocg(is, atom_a) + ns = lao(is) + 1 + charges(atom_a, ns) = charges(atom_a, ns) - aocg(is, atom_a) END DO END DO END DO @@ -1105,14 +1105,14 @@ SUBROUTINE build_xtb_ks_matrix(qs_env, calculate_forces, just_energy) ! Compute QM/MM Energy CALL dbcsr_dot(qs_env%ks_qmmm_env%matrix_h(1)%matrix, & matrix_p1(ispin)%matrix, qmmm_el) - energy%qmmm_el = energy%qmmm_el+qmmm_el + energy%qmmm_el = energy%qmmm_el + qmmm_el END DO pc_ener = qs_env%ks_qmmm_env%pc_ener - energy%qmmm_el = energy%qmmm_el+pc_ener + energy%qmmm_el = energy%qmmm_el + pc_ener END IF - energy%total = energy%core+energy%hartree+energy%efield+energy%qmmm_el+ & - energy%repulsive+energy%dispersion+energy%dftb3 + energy%total = energy%core + energy%hartree + energy%efield + energy%qmmm_el + & + energy%repulsive + energy%dispersion + energy%dftb3 iounit = cp_print_key_unit_nr(logger, scf_section, "PRINT%DETAILED_ENERGY", & extension=".scfLog") @@ -1181,14 +1181,14 @@ SUBROUTINE xb_neighbors(neighbor_atoms, para_env) ALLOCATE (dmloc(2*natom), matom(natom), coord(3, natom)) dmloc = 0.0_dp DO iatom = 1, natom - dmloc(2*iatom-1) = neighbor_atoms(ikind)%rab(iatom) + dmloc(2*iatom - 1) = neighbor_atoms(ikind)%rab(iatom) dmloc(2*iatom) = REAL(para_env%mepos, KIND=dp) END DO CALL mp_minloc(dmloc, para_env%group) coord = 0.0_dp matom = 0 DO iatom = 1, natom - neighbor_atoms(ikind)%rab(iatom) = dmloc(2*iatom-1) + neighbor_atoms(ikind)%rab(iatom) = dmloc(2*iatom - 1) IF (NINT(dmloc(2*iatom)) == para_env%mepos) THEN coord(1:3, iatom) = neighbor_atoms(ikind)%coord(1:3, iatom) matom(iatom) = neighbor_atoms(ikind)%katom(iatom) @@ -1263,26 +1263,26 @@ SUBROUTINE xb_interaction(exb, neighbor_atoms, atom_of_kind, kind_of, sab_xb, kx atom_a = atom_of_kind(iatom) katom = neighbor_atoms(ikind)%katom(atom_a) IF (katom == 0) CYCLE - dr = SQRT(rij(1)**2+rij(2)**2+rij(3)**2) + dr = SQRT(rij(1)**2 + rij(2)**2 + rij(3)**2) ddr = rcab(ikind, jkind)/dr ddr6 = ddr**6 ddr12 = ddr6*ddr6 - eval = kx(ikind)*(ddr12-kx2*ddr6)/(1.0_dp+ddr12) + eval = kx(ikind)*(ddr12 - kx2*ddr6)/(1.0_dp + ddr12) ! angle ria(1:3) = neighbor_atoms(ikind)%coord(1:3, atom_a) - rja(1:3) = rij(1:3)-ria(1:3) - drax = ria(1)**2+ria(2)**2+ria(3)**2 + rja(1:3) = rij(1:3) - ria(1:3) + drax = ria(1)**2 + ria(2)**2 + ria(3)**2 drbx = dr*dr - drab = rja(1)**2+rja(2)**2+rja(3)**2 + drab = rja(1)**2 + rja(2)**2 + rja(3)**2 xy = SQRT(drbx*drax) ! cos angle B-X-A - cosa = (drbx+drax-drab)/xy - aterm = (0.5_dp-0.25_dp*cosa)**alp + cosa = (drbx + drax - drab)/xy + aterm = (0.5_dp - 0.25_dp*cosa)**alp ! - exb = exb+aterm*eval + exb = exb + aterm*eval IF (atprop%energy) THEN - atprop%atecc(iatom) = atprop%atecc(iatom)+0.5_dp*aterm*eval - atprop%atecc(jatom) = atprop%atecc(jatom)+0.5_dp*aterm*eval + atprop%atecc(iatom) = atprop%atecc(iatom) + 0.5_dp*aterm*eval + atprop%atecc(jatom) = atprop%atecc(jatom) + 0.5_dp*aterm*eval END IF ! IF (calculate_forces) THEN @@ -1290,11 +1290,11 @@ SUBROUTINE xb_interaction(exb, neighbor_atoms, atom_of_kind, kind_of, sab_xb, kx atom_b = atom_of_kind(jatom) atom_c = atom_of_kind(katom) ! - deval = 6.0_dp*kx(ikind)*ddr6*(kx2*ddr12+2.0_dp*ddr6-kx2)/(1.0_dp+ddr12)**2 + deval = 6.0_dp*kx(ikind)*ddr6*(kx2*ddr12 + 2.0_dp*ddr6 - kx2)/(1.0_dp + ddr12)**2 deval = -rcab(ikind, jkind)*deval/(dr*dr)/ddr fij(1:3) = aterm*deval*rij(1:3)/dr - force(ikind)%repulsive(:, atom_a) = force(ikind)%repulsive(:, atom_a)-fij(:) - force(jkind)%repulsive(:, atom_b) = force(jkind)%repulsive(:, atom_b)+fij(:) + force(ikind)%repulsive(:, atom_a) = force(ikind)%repulsive(:, atom_a) - fij(:) + force(jkind)%repulsive(:, atom_b) = force(jkind)%repulsive(:, atom_b) + fij(:) IF (use_virial) THEN CALL virial_pair_force(virial%pv_virial, -1._dp, fij, rij) IF (atprop%stress) THEN @@ -1306,16 +1306,16 @@ SUBROUTINE xb_interaction(exb, neighbor_atoms, atom_of_kind, kind_of, sab_xb, kx fij(1:3) = 0.0_dp fia(1:3) = 0.0_dp fja(1:3) = 0.0_dp - daterm = -0.25_dp*alp*(0.5_dp-0.25_dp*cosa)**(alp-1.0_dp) - ddbx = 0.5_dp*(drab-drax+drbx)/xy/drbx - ddax = 0.5_dp*(drab+drax-drbx)/xy/drax + daterm = -0.25_dp*alp*(0.5_dp - 0.25_dp*cosa)**(alp - 1.0_dp) + ddbx = 0.5_dp*(drab - drax + drbx)/xy/drbx + ddax = 0.5_dp*(drab + drax - drbx)/xy/drax ddab = -1._dp/xy fij(1:3) = 2.0_dp*daterm*ddbx*rij(1:3)*eval fia(1:3) = 2.0_dp*daterm*ddax*ria(1:3)*eval fja(1:3) = 2.0_dp*daterm*ddab*rja(1:3)*eval - force(ikind)%repulsive(:, atom_a) = force(ikind)%repulsive(:, atom_a)-fij(:)-fia(:) - force(jkind)%repulsive(:, atom_b) = force(jkind)%repulsive(:, atom_b)+fij(:)+fja(:) - force(kkind)%repulsive(:, atom_c) = force(kkind)%repulsive(:, atom_c)+fia(:)-fja(:) + force(ikind)%repulsive(:, atom_a) = force(ikind)%repulsive(:, atom_a) - fij(:) - fia(:) + force(jkind)%repulsive(:, atom_b) = force(jkind)%repulsive(:, atom_b) + fij(:) + fja(:) + force(kkind)%repulsive(:, atom_c) = force(kkind)%repulsive(:, atom_c) + fia(:) - fja(:) IF (use_virial) THEN CALL virial_pair_force(virial%pv_virial, -1._dp, fij, rij) CALL virial_pair_force(virial%pv_virial, -1._dp, fia, ria) diff --git a/src/xtb_parameters.F b/src/xtb_parameters.F index 323e481f71..a8a97a21f8 100644 --- a/src/xtb_parameters.F +++ b/src/xtb_parameters.F @@ -222,8 +222,8 @@ SUBROUTINE xtb_parameters_init(param, element_symbol, parameter_file_path, param CALL parser_get_object(parser, param%hen(i)) CALL parser_get_object(parser, param%zeta(i)) param%nshell = i - param%nval(i) = ia-48 - SELECT CASE (aname (2:2)) + param%nval(i) = ia - 48 + SELECT CASE (aname(2:2)) CASE ("s", "S") param%lval(i) = 0 CASE ("p", "P") @@ -255,7 +255,7 @@ SUBROUTINE xtb_parameters_init(param, element_symbol, parameter_file_path, param param%natorb = 0 DO i = 1, param%nshell l = param%lval(i) - param%natorb = param%natorb+(2*l+1) + param%natorb = param%natorb + (2*l + 1) END DO param%zeff = zval(ia) ELSE @@ -309,10 +309,10 @@ SUBROUTINE xtb_parameters_read(param, element_symbol, xtb_section) CALL remove_word(line_att) ia = ICHAR(label(1:1)) IF (ia >= 49 .AND. ia <= 57) THEN - nshell = nshell+1 + nshell = nshell + 1 k = nshell - param%nval(k) = ia-48 - SELECT CASE (label (2:2)) + param%nval(k) = ia - 48 + SELECT CASE (label(2:2)) CASE ("s", "S") param%lval(k) = 0 CASE ("p", "P") @@ -341,7 +341,7 @@ SUBROUTINE xtb_parameters_read(param, element_symbol, xtb_section) CALL remove_word(line_att) IF (label == element_symbol) THEN found = .TRUE. - nshell = nshell+1 + nshell = nshell + 1 k = nshell READ (line_att, *) param%eta CALL remove_word(line_att) @@ -355,8 +355,8 @@ SUBROUTINE xtb_parameters_read(param, element_symbol, xtb_section) CALL remove_word(line_att) ia = ICHAR(label(1:1)) CPASSERT((ia >= 49 .AND. ia <= 57)) - param%nval(k) = ia-48 - SELECT CASE (label (2:2)) + param%nval(k) = ia - 48 + SELECT CASE (label(2:2)) CASE ("s", "S") param%lval(k) = 0 CASE ("p", "P") @@ -392,7 +392,7 @@ SUBROUTINE xtb_parameters_read(param, element_symbol, xtb_section) param%nshell = nshell DO i = 1, param%nshell l = param%lval(i) - param%natorb = param%natorb+(2*l+1) + param%natorb = param%natorb + (2*l + 1) END DO param%zeff = zval(ia) END IF @@ -420,8 +420,8 @@ SUBROUTINE xtb_parameters_set(param) na = 0 DO is = 1, param%nshell l = param%lval(is) - DO i = 1, 2*l+1 - na = na+1 + DO i = 1, 2*l + 1 + na = na + 1 param%nao(na) = is param%lao(na) = l END DO @@ -435,7 +435,7 @@ SUBROUTINE xtb_parameters_set(param) ! shell occupances param%occupation(:) = occupation(:, i) ! check for consistency - IF (ABS(param%zeff-SUM(param%occupation)) > 1.E-10_dp) THEN + IF (ABS(param%zeff - SUM(param%occupation)) > 1.E-10_dp) THEN CALL cp_abort(__LOCATION__, "Element <"//TRIM(param%aname)//"> has inconsistent shell occupations") END IF ! orbital energies [evolt] -> [a.u.] @@ -451,10 +451,10 @@ SUBROUTINE xtb_parameters_set(param) param%kappa(:) = 0.0_dp DO is = 1, param%nshell l = param%lval(is) - IF (param%kappa(l+1) == 0.0_dp) THEN - param%kappa(l+1) = kp(is) + IF (param%kappa(l + 1) == 0.0_dp) THEN + param%kappa(l + 1) = kp(is) ELSE - CPASSERT(ABS(param%kappa(l+1)-kp(is)) < 1.e-10_dp) + CPASSERT(ABS(param%kappa(l + 1) - kp(is)) < 1.e-10_dp) END IF END DO ! kx @@ -505,7 +505,7 @@ SUBROUTINE init_xtb_basis(param, gto_basis_set, ngauss) ALLOCATE (symbol(1:nshell)) symbol = "" DO i = 1, nshell - SELECT CASE (param%lval (i)) + SELECT CASE (param%lval(i)) CASE (0) WRITE (symbol(i), '(I1,A1)') param%nval(i), "S" CASE (1) @@ -557,7 +557,7 @@ FUNCTION xtb_set_kab(za, zb) RESULT(kab) kab = 1.0_dp IF (za == 1 .OR. zb == 1) THEN ! hydrogen - z = za+zb-1 + z = za + zb - 1 SELECT CASE (z) CASE (1) kab = 0.96_dp @@ -574,14 +574,14 @@ FUNCTION xtb_set_kab(za, zb) RESULT(kab) END SELECT ELSEIF (za == 5 .OR. zb == 5) THEN ! Boron - z = za+zb-5 + z = za + zb - 5 SELECT CASE (z) CASE (15) kab = 0.97_dp END SELECT ELSEIF (za == 7 .OR. zb == 7) THEN ! Nitrogen - z = za+zb-7 + z = za + zb - 7 SELECT CASE (z) CASE (14) !xtb orig code parameter file @@ -595,13 +595,13 @@ FUNCTION xtb_set_kab(za, zb) RESULT(kab) kab = 1.10_dp ELSEIF ((zb > 38 .AND. zb < 48) .OR. (zb > 56 .AND. zb < 80)) THEN ! 4d/5d/4f - kab = 0.50_dp*(1.20_dp+1.10_dp) + kab = 0.50_dp*(1.20_dp + 1.10_dp) END IF ELSEIF ((za > 38 .AND. za < 48) .OR. (za > 56 .AND. za < 80)) THEN ! 4d/5d/4f IF (zb > 20 .AND. zb < 30) THEN ! 3d - kab = 0.50_dp*(1.20_dp+1.10_dp) + kab = 0.50_dp*(1.20_dp + 1.10_dp) ELSEIF ((zb > 38 .AND. zb < 48) .OR. (zb > 56 .AND. zb < 80)) THEN ! 4d/5d/4f kab = 1.20_dp diff --git a/src/xtb_types.F b/src/xtb_types.F index 1fc302a116..687a3ae093 100644 --- a/src/xtb_types.F +++ b/src/xtb_types.F @@ -354,7 +354,7 @@ SUBROUTINE write_xtb_atom_param(xtb_parameter, subsys_section) bb = " " WRITE (UNIT=io_unit, FMT="(/,A,T67,A14)") " xTB parameters: ", TRIM(aname) IF (defined) THEN - m = 5-nshell + m = 5 - nshell WRITE (UNIT=io_unit, FMT="(T16,A,T71,F10.2)") "Effective core charge:", zeff WRITE (UNIT=io_unit, FMT="(T16,A,T71,I10)") "Number of orbitals:", natorb WRITE (UNIT=io_unit, FMT="(T16,A,T41,A,5(A4,I1,I2,A1))") "Basis set [nl]", bb(1:8*m), &